From 6933777238ca175987e62b3495df987ecccc1168 Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 17 May 1999 09:41:59 +0000 Subject: [PATCH] This commit was manufactured by cvs2svn to create branch 'chise-r21-4-19'. --- CHANGES-beta | 114 - ChangeLog | 3378 ------ INSTALL | 780 -- Makefile.in.in | 641 -- PROBLEMS | 1581 --- README | 63 - README.packages | 227 - aclocal.m4 | 598 -- config.guess | 951 -- config.sub | 955 -- configure |13757 ------------------------ configure.in | 4237 -------- configure.usage | 250 - dynodump/_dynodump.h | 65 - dynodump/dynodump.c | 560 - dynodump/i386/_relocate.c | 118 - dynodump/i386/machdep.h | 93 - dynodump/ppc/_relocate.c | 269 - dynodump/ppc/machdep.h | 88 - dynodump/sparc/_relocate.c | 294 - dynodump/sparc/machdep.h | 91 - dynodump/syms.c | 73 - etc/BETA | 370 - etc/CHARSETS | 57 - etc/DISTRIB | 136 - etc/Emacs.ad | 284 - etc/FTP | 282 - etc/HELLO | 38 - etc/MACHINES | 1261 --- etc/MAILINGLISTS | 1206 --- etc/NEWS | 606 -- etc/OONEWS | 5526 ---------- etc/PACKAGES | 321 - etc/README | 80 - etc/README.HYPERBOLE | 6 - etc/README.OO-BROWSER | 6 - etc/SERVICE | 935 -- etc/TUTORIAL | 1114 -- etc/TUTORIAL.de | 1159 -- etc/TUTORIAL.fr | 1085 -- etc/TUTORIAL.ja | 741 -- etc/TUTORIAL.ru | 1082 -- etc/TUTORIAL.th | 696 -- etc/aliases.ksh | 60 - etc/editclient.sh | 13 - etc/etags.1 | 227 - etc/gnuserv.1 | 294 - etc/package-index.LATEST.pgp | 1763 --- etc/photos/hniksic.png | Bin 7771 -> 0 bytes etc/photos/hniksicm.png | Bin 6858 -> 0 bytes etc/photos/jwz.png | Bin 8056 -> 0 bytes etc/photos/jwzm.png | Bin 1161 -> 0 bytes etc/sample.Xdefaults | 288 - etc/xemacs-fe.sh | 316 - etc/xemacs-ja.1 | 776 -- etc/xemacs.1 | 791 -- info/dir | 60 - lib-src/ChangeLog | 658 -- lib-src/Makefile.in.in | 390 - lib-src/add-big-package.sh | 64 - lib-src/b2m.c | 263 - lib-src/config.values.in | 136 - lib-src/config.values.sh | 76 - lib-src/cvtmail.c | 165 - lib-src/digest-doc.c | 52 - lib-src/ellcc.c | 681 -- lib-src/etags.c | 5084 --------- lib-src/fakemail.c | 680 -- lib-src/getopt.c | 1032 -- lib-src/getopt.h | 133 - lib-src/getopt1.c | 171 - lib-src/gnuclient.c | 687 -- lib-src/gnuserv.c | 913 -- lib-src/gnuserv.h | 225 - lib-src/gnuslib.c | 456 - lib-src/gzip-el.sh | 37 - lib-src/hexl.c | 252 - lib-src/installexe.sh | 21 - lib-src/make-docfile.c | 1097 -- lib-src/make-msgfile.c | 480 - lib-src/make-msgfile.lex | 681 -- lib-src/make-path.c | 91 - lib-src/make-po.c | 301 - lib-src/mmencode.c | 522 - lib-src/movemail.c | 893 -- lib-src/ootags.c | 5432 ---------- lib-src/pop.c | 1512 --- lib-src/profile.c | 96 - lib-src/qsort.c | 237 - lib-src/rcs2log | 650 -- lib-src/sorted-doc.c | 270 - lib-src/update-autoloads.sh | 137 - lib-src/wakeup.c | 63 - lib-src/yow.c | 178 - lisp/ChangeLog | 4278 -------- lisp/ChangeLog.1 | 8056 -------------- lisp/abbrev.el | 544 - lisp/about.el | 1517 --- lisp/alist.el | 101 - lisp/apropos.el | 690 -- lisp/auto-autoloads.el | 1679 --- lisp/auto-save.el | 554 - lisp/auto-show.el | 202 - lisp/autoload.el | 566 - lisp/backquote.el | 304 - lisp/buff-menu.el | 639 -- lisp/buffer.el | 112 - lisp/build-report.el | 295 - lisp/byte-optimize.el | 1991 ---- lisp/bytecomp-runtime.el | 241 - lisp/bytecomp.el | 4167 ------- lisp/check-features.el | 58 - lisp/cl-compat.el | 194 - lisp/cl-extra.el | 847 -- lisp/cl-macs.el | 2809 ----- lisp/cl-seq.el | 938 -- lisp/cl.el | 760 -- lisp/cmdloop.el | 570 - lisp/code-files.el | 558 - lisp/code-process.el | 250 - lisp/coding.el | 214 - lisp/config.el | 70 - lisp/cus-dep.el | 186 - lisp/cus-edit.el | 3269 ------ lisp/cus-face.el | 275 - lisp/cus-load.el | 63 - lisp/cus-start.el | 194 - lisp/custom-load.el | 86 - lisp/custom.el | 404 - lisp/derived.el | 363 - lisp/device.el | 113 - lisp/dialog.el | 157 - lisp/disass.el | 266 - lisp/dragdrop.el | 424 - lisp/dump-paths.el | 86 - lisp/dumped-lisp.el | 220 - lisp/easymenu.el | 272 - lisp/etags.el | 1208 --- lisp/extents.el | 102 - lisp/faces.el | 1735 --- lisp/files-nomule.el | 96 - lisp/files.el | 3253 ------ lisp/fill.el | 1078 -- lisp/find-paths.el | 302 - lisp/finder.el | 403 - lisp/float-sup.el | 67 - lisp/font-lock.el | 2583 ----- lisp/font.el | 1390 --- lisp/format.el | 987 -- lisp/frame.el | 1290 --- lisp/glyphs.el | 699 -- lisp/gnuserv.el | 784 -- lisp/gui.el | 122 - lisp/help-macro.el | 174 - lisp/help-nomule.el | 106 - lisp/help.el | 1432 --- lisp/hyper-apropos.el | 1311 --- lisp/indent.el | 480 - lisp/info.el | 3099 ------ lisp/isearch-mode.el | 1627 --- lisp/iso8859-1.el | 206 - lisp/itimer.el | 872 -- lisp/keydefs.el | 637 -- lisp/keymap.el | 493 - lisp/ldap.el | 173 - lisp/lib-complete.el | 339 - lisp/lisp-mnt.el | 577 - lisp/lisp-mode.el | 1030 -- lisp/lisp.el | 357 - lisp/list-mode.el | 595 - lisp/loaddefs.el | 177 - lisp/loadhist.el | 146 - lisp/loadup.el | 215 - lisp/make-docfile.el | 195 - lisp/map-ynp.el | 290 - lisp/menubar-items.el | 1498 --- lisp/menubar.el | 542 - lisp/minibuf.el | 2154 ---- lisp/modeline.el | 622 -- lisp/mouse.el | 1529 --- lisp/msw-faces.el | 178 - lisp/msw-glyphs.el | 90 - lisp/msw-init.el | 73 - lisp/msw-select.el | 107 - lisp/mule/chinese.el | 268 - lisp/mule/cyrillic.el | 294 - lisp/mule/english.el | 125 - lisp/mule/european.el | 386 - lisp/mule/greek.el | 84 - lisp/mule/hebrew.el | 93 - lisp/mule/japanese.el | 232 - lisp/mule/kinsoku.el | 285 - lisp/mule/korean.el | 149 - lisp/mule/misc-lang.el | 52 - lisp/mule/mule-category.el | 286 - lisp/mule/mule-ccl.el | 1110 -- lisp/mule/mule-charset.el | 142 - lisp/mule/mule-cmds.el | 706 -- lisp/mule/mule-coding.el | 188 - lisp/mule/mule-help.el | 86 - lisp/mule/mule-init.el | 132 - lisp/mule/mule-misc.el | 295 - lisp/mule/mule-x-init.el | 126 - lisp/multicast.el | 81 - lisp/mwheel.el | 117 - lisp/objects.el | 149 - lisp/obsolete.el | 381 - lisp/package-admin.el | 507 - lisp/package-get.el | 1057 -- lisp/package-info.el | 128 - lisp/package-ui.el | 708 -- lisp/packages.el | 551 - lisp/page.el | 157 - lisp/paragraphs.el | 411 - lisp/paths.el | 278 - lisp/picture.el | 664 -- lisp/process.el | 344 - lisp/rect.el | 256 - lisp/replace.el | 876 -- lisp/scrollbar.el | 138 - lisp/select.el | 294 - lisp/setup-paths.el | 192 - lisp/shadow.el | 235 - lisp/simple.el | 4096 ------- lisp/site-load.el | 62 - lisp/sound.el | 191 - lisp/specifier.el | 524 - lisp/startup.el | 1182 -- lisp/subr.el | 672 -- lisp/symbols.el | 177 - lisp/syntax.el | 418 - lisp/term/bg-mouse.el | 312 - lisp/term/pc-win.el | 204 - lisp/term/scoansi.el | 148 - lisp/term/sun-mouse.el | 673 -- lisp/term/sun.el | 279 - lisp/text-props.el | 401 - lisp/toolbar-items.el | 598 -- lisp/toolbar.el | 201 - lisp/update-elc.el | 147 - lisp/userlock.el | 241 - lisp/version.el | 137 - lisp/very-early-lisp.el | 72 - lisp/view-less.el | 404 - lisp/wid-edit.el | 3716 ------- lisp/widget.el | 76 - lisp/window-xemacs.el | 613 -- lisp/window.el | 355 - lisp/x-compose.el | 708 -- lisp/x-faces.el | 742 -- lisp/x-font-menu.el | 576 - lisp/x-init.el | 377 - lisp/x-iso8859-1.el | 273 - lisp/x-misc.el | 86 - lisp/x-mouse.el | 182 - lisp/x-scrollbar.el | 104 - lisp/x-select.el | 502 - lisp/x-win-sun.el | 254 - lwlib/.cvsignore | 4 - lwlib/Makefile.in.in | 105 - lwlib/config.h.in | 32 - lwlib/lwlib-Xaw.c | 625 -- lwlib/lwlib-Xaw.h | 31 - lwlib/lwlib-Xlw.c | 407 - lwlib/lwlib-Xlw.h | 29 - lwlib/lwlib-Xm.c | 1943 ---- lwlib/lwlib-Xm.h | 36 - lwlib/lwlib-config.c | 90 - lwlib/lwlib-internal.h | 59 - lwlib/lwlib-utils.c | 166 - lwlib/lwlib-utils.h | 23 - lwlib/lwlib.c | 1302 --- lwlib/lwlib.h | 217 - lwlib/xlwmenu.c | 3628 ------- lwlib/xlwmenu.h | 93 - lwlib/xlwmenuP.h | 120 - lwlib/xlwscrollbar.c | 1919 ---- lwlib/xlwscrollbar.h | 143 - man/ChangeLog | 834 -- man/Makefile | 156 - man/cl.texi | 5754 ---------- man/custom.texi | 423 - man/emodules.texi | 1006 -- man/external-widget.texi | 123 - man/info.texi | 911 -- man/internals/internals.texi | 7932 -------------- man/lispref/abbrevs.texi | 340 - man/lispref/annotations.texi | 340 - man/lispref/backups.texi | 648 -- man/lispref/buffers.texi | 958 -- man/lispref/building.texi | 492 - man/lispref/commands.texi | 2422 ----- man/lispref/compile.texi | 780 -- man/lispref/consoles-devices.texi | 272 - man/lispref/control.texi | 1148 -- man/lispref/customize.texi | 750 -- man/lispref/databases.texi | 92 - man/lispref/debugging.texi | 753 -- man/lispref/dialog.texi | 67 - man/lispref/display.texi | 1193 --- man/lispref/dragndrop.texi | 128 - man/lispref/edebug-inc.texi | 1699 --- man/lispref/edebug.texi | 310 - man/lispref/errors.texi | 194 - man/lispref/eval.texi | 709 -- man/lispref/extents.texi | 933 -- man/lispref/faces.texi | 686 -- man/lispref/files.texi | 2357 ---- man/lispref/frames.texi | 946 -- man/lispref/functions.texi | 1142 -- man/lispref/glyphs.texi | 1054 -- man/lispref/hash-tables.texi | 224 - man/lispref/help.texi | 734 -- man/lispref/hooks.texi | 281 - man/lispref/internationalization.texi | 197 - man/lispref/intro.texi | 876 -- man/lispref/keymaps.texi | 1577 --- man/lispref/ldap.texi | 299 - man/lispref/lispref.texi | 1225 --- man/lispref/lists.texi | 1819 ---- man/lispref/loading.texi | 779 -- man/lispref/locals.texi | 153 - man/lispref/macros.texi | 579 - man/lispref/maps.texi | 183 - man/lispref/markers.texi | 784 -- man/lispref/menus.texi | 754 -- man/lispref/minibuf.texi | 1479 --- man/lispref/modes.texi | 1431 --- man/lispref/mouse.texi | 107 - man/lispref/mule.texi | 1198 --- man/lispref/numbers.texi | 1086 -- man/lispref/objects.texi | 2367 ---- man/lispref/os.texi | 1705 --- man/lispref/positions.texi | 965 -- man/lispref/processes.texi | 1265 --- man/lispref/range-tables.texi | 72 - man/lispref/scrollbars.texi | 10 - man/lispref/searching.texi | 1465 --- man/lispref/sequences.texi | 673 -- man/lispref/specifiers.texi | 1103 -- man/lispref/streams.texi | 799 -- man/lispref/strings.texi | 1247 --- man/lispref/symbols.texi | 555 - man/lispref/syntax.texi | 750 -- man/lispref/text.texi | 2807 ----- man/lispref/tips.texi | 658 -- man/lispref/toolbar.texi | 363 - man/lispref/tooltalk.texi | 366 - man/lispref/variables.texi | 1348 --- man/lispref/windows.texi | 1881 ---- man/lispref/x-windows.texi | 370 - man/make-stds.texi | 722 -- man/new-users-guide/custom1.texi | 330 - man/new-users-guide/custom2.texi | 441 - man/new-users-guide/edit.texi | 301 - man/new-users-guide/files.texi | 254 - man/new-users-guide/help.texi | 187 - man/new-users-guide/modes.texi | 250 - man/new-users-guide/new-users-guide.texi | 284 - man/new-users-guide/region.texi | 258 - man/new-users-guide/search.texi | 118 - man/new-users-guide/xmenu.texi | 472 - man/standards.texi | 2802 ----- man/term.texi | 395 - man/termcap.texi | 3412 ------ man/texinfo.tex | 4977 --------- man/texinfo.texi |17293 ------------------------------ man/widget.texi | 1622 --- man/xemacs-faq.texi | 6225 ----------- man/xemacs/abbrevs.texi | 306 - man/xemacs/basic.texi | 550 - man/xemacs/buffers.texi | 311 - man/xemacs/building.texi | 613 -- man/xemacs/calendar.texi | 2304 ---- man/xemacs/cmdargs.texi | 278 - man/xemacs/custom.texi | 2506 ----- man/xemacs/entering.texi | 100 - man/xemacs/files.texi | 1757 --- man/xemacs/frame.texi | 345 - man/xemacs/glossary.texi | 765 -- man/xemacs/gnu.texi | 478 - man/xemacs/help.texi | 265 - man/xemacs/keystrokes.texi | 516 - man/xemacs/major.texi | 113 - man/xemacs/mark.texi | 240 - man/xemacs/menus.texi | 549 - man/xemacs/mini.texi | 383 - man/xemacs/misc.texi | 784 -- man/xemacs/mule.texi | 540 - man/xemacs/new.texi | 367 - man/xemacs/packages.texi | 379 - man/xemacs/programs.texi | 1940 ---- man/xemacs/reading.texi | 32 - man/xemacs/regs.texi | 110 - man/xemacs/search.texi | 883 -- man/xemacs/sending.texi | 350 - man/xemacs/startup.texi | 204 - man/xemacs/text.texi | 1126 -- man/xemacs/trouble.texi | 406 - man/xemacs/windows.texi | 287 - man/xemacs/xemacs.texi | 1121 -- modules/base64/Makefile | 39 - modules/base64/base64.c | 421 - modules/ldap/Makefile | 39 - modules/sample/Makefile | 39 - modules/sample/sample.c | 92 - modules/zlib/Makefile | 39 - nt/ChangeLog | 620 -- nt/Emacs.ad.h | 83 - nt/PROBLEMS | 177 - nt/README | 156 - nt/config.h | 626 -- nt/minitar.c | 211 - nt/minitar.mak | 10 - nt/xemacs.mak | 1082 -- nt/xemacs.rc | 3 - nt/xpm.mak | 47 - src/.cvsignore | 11 - src/ChangeLog | 4123 ------- src/ChangeLog.1 | 8315 -------------- src/EmacsFrame.c | 644 -- src/EmacsFrame.h | 350 - src/EmacsFrameP.h | 114 - src/EmacsManager.c | 249 - src/EmacsManager.h | 62 - src/EmacsManagerP.h | 68 - src/EmacsShell-sub.c | 381 - src/EmacsShell.c | 164 - src/EmacsShell.h | 71 - src/EmacsShellP.h | 102 - src/ExternalClient.c | 617 -- src/ExternalClient.h | 74 - src/ExternalClientP.h | 66 - src/ExternalShell.c | 717 -- src/ExternalShell.h | 57 - src/ExternalShellP.h | 59 - src/Makefile.in.in | 748 -- src/README | 93 - src/abbrev.c | 463 - src/alloc.c | 5088 --------- src/alloca.c | 513 - src/backtrace.h | 326 - src/balloon-x.c | 163 - src/balloon_help.c | 606 -- src/balloon_help.h | 36 - src/bitmaps.h | 167 - src/blocktype.h | 45 - src/broken-sun.h | 167 - src/buffer.c | 2766 ----- src/buffer.h | 1789 ---- src/bufslots.h | 243 - src/bytecode.c | 2465 ----- src/bytecode.h | 124 - src/callint.c | 1058 -- src/callproc.c | 900 -- src/casefiddle.c | 342 - src/casetab.c | 349 - src/chartab.c | 1779 --- src/chartab.h | 233 - src/cm.c | 494 - src/cm.h | 184 - src/cmdloop.c | 653 -- src/cmds.c | 501 - src/commands.h | 128 - src/config.h.in | 816 -- src/conslots.h | 96 - src/console-msw.c | 141 - src/console-msw.h | 261 - src/console-stream.c | 353 - src/console-stream.h | 49 - src/console-tty.c | 373 - src/console-tty.h | 298 - src/console-x.c | 282 - src/console-x.h | 496 - src/console.c | 1350 --- src/console.h | 556 - src/data.c | 2246 ---- src/database.c | 806 -- src/database.h | 29 - src/debug.c | 216 - src/debug.h | 81 - src/depend | 213 - src/device-msw.c | 332 - src/device-tty.c | 228 - src/device-x.c | 1822 ---- src/device.c | 1329 --- src/device.h | 408 - src/dgif_lib.c | 965 -- src/dialog-msw.c | 421 - src/dialog-x.c | 274 - src/dialog.c | 92 - src/dired-msw.c | 665 -- src/dired.c | 964 -- src/doc.c | 1006 -- src/doprnt.c | 890 -- src/dragdrop.c | 142 - src/dragdrop.h | 40 - src/dynarr.c | 236 - src/editfns.c | 2541 ----- src/eldap.c | 587 - src/eldap.h | 74 - src/elhash.c | 1384 --- src/elhash.h | 86 - src/emacs.c | 3138 ------ src/emodules.c | 579 - src/emodules.h | 86 - src/eval.c | 5192 --------- src/event-Xt.c | 3011 ------ src/event-msw.c | 2971 ----- src/event-stream.c | 5528 ---------- src/event-tty.c | 270 - src/event-unixoid.c | 364 - src/events-mod.h | 8 - src/events.c | 2264 ---- src/events.h | 641 -- src/extents.c | 6852 ------------ src/extents.h | 403 - src/extw-Xlib.h | 51 - src/extw-Xt.c | 243 - src/extw-Xt.h | 44 - src/faces.c | 2029 ---- src/faces.h | 372 - src/file-coding.c | 4875 --------- src/file-coding.h | 516 - src/fileio.c | 4342 -------- src/filelock.c | 476 - src/filemode.c | 183 - src/floatfns.c | 1065 -- src/fns.c | 3974 ------- src/font-lock.c | 776 -- src/frame-msw.c | 794 -- src/frame-tty.c | 254 - src/frame-x.c | 2855 ----- src/frame.c | 3337 ------ src/frame.h | 740 -- src/frameslots.h | 151 - src/free-hook.c | 594 - src/general.c | 342 - src/getloadavg.c | 1009 -- src/getpagesize.h | 66 - src/gif_io.c | 259 - src/gifrlib.h | 268 - src/glyphs-eimage.c | 1364 --- src/glyphs-msw.c | 2631 ----- src/glyphs-msw.h | 82 - src/glyphs-widget.c | 557 - src/glyphs-x.c | 2184 ---- src/glyphs-x.h | 101 - src/glyphs.c | 4276 -------- src/glyphs.h | 751 -- src/gmalloc.c | 1389 --- src/gpmevent.c | 114 - src/gpmevent.h | 7 - src/gui-msw.c | 57 - src/gui-x.c | 632 -- src/gui-x.h | 82 - src/gui.c | 434 - src/gui.h | 95 - src/hash.c | 454 - src/hash.h | 93 - src/hpplay.c | 294 - src/imgproc.c | 564 - src/imgproc.h | 62 - src/indent.c | 892 -- src/inline.c | 89 - src/input-method-motif.c | 189 - src/input-method-xlib.c | 943 -- src/insdel.c | 3332 ------ src/insdel.h | 162 - src/intl.c | 333 - src/iso-wide.h | 49 - src/keymap.c | 4344 -------- src/keymap.h | 62 - src/lastfile.c | 43 - src/libsst.c | 509 - src/libsst.h | 48 - src/libst.h | 67 - src/line-number.c | 315 - src/line-number.h | 27 - src/linuxplay.c | 1094 -- src/lisp-disunion.h | 165 - src/lisp-union.h | 190 - src/lisp.h | 3063 ------ src/lread.c | 3201 ------ src/lrecord.h | 439 - src/lstream.c | 1685 --- src/lstream.h | 359 - src/m/7300.h | 85 - src/m/acorn.h | 175 - src/m/alliant-2800.h | 120 - src/m/alliant.h | 119 - src/m/alpha.h | 36 - src/m/altos.h | 55 - src/m/amdahl.h | 143 - src/m/apollo.h | 91 - src/m/arm.h | 135 - src/m/att3b.h | 145 - src/m/aviion.h | 114 - src/m/celerity.h | 51 - src/m/clipper.h | 90 - src/m/cnvrgnt.h | 93 - src/m/convex.h | 165 - src/m/cydra5.h | 111 - src/m/delta.h | 173 - src/m/delta88k.h | 141 - src/m/dpx2.h | 189 - src/m/dual.h | 62 - src/m/elxsi.h | 126 - src/m/ews4800r.h | 101 - src/m/gould-np1.h | 86 - src/m/gould.h | 174 - src/m/hp300bsd.h | 44 - src/m/hp800.h | 149 - src/m/hp9000s300.h | 177 - src/m/i860.h | 93 - src/m/ibmps2-aix.h | 184 - src/m/ibmrs6000.h | 138 - src/m/ibmrt-aix.h | 142 - src/m/ibmrt.h | 124 - src/m/intel386.h | 199 - src/m/iris4d.h | 153 - src/m/iris5d.h | 159 - src/m/irist.h | 128 - src/m/isi-ov.h | 85 - src/m/luna88k.h | 95 - src/m/m68k.h | 75 - src/m/masscomp.h | 116 - src/m/mega68.h | 41 - src/m/mg1.h | 99 - src/m/mips-nec.h | 145 - src/m/mips-siemens.h | 149 - src/m/mips.h | 170 - src/m/next.h | 100 - src/m/nh3000.h | 107 - src/m/nh4000.h | 110 - src/m/ns32000.h | 97 - src/m/nu.h | 59 - src/m/orion.h | 57 - src/m/orion105.h | 51 - src/m/pfa50.h | 80 - src/m/plexus.h | 101 - src/m/pmax.h | 99 - src/m/powerpc.h | 134 - src/m/pyramid.h | 48 - src/m/sequent-ptx.h | 134 - src/m/sequent.h | 161 - src/m/sgi-challenge.h | 173 - src/m/sparc.h | 74 - src/m/sps7.h | 92 - src/m/stride.h | 93 - src/m/sun1.h | 68 - src/m/sun2.h | 89 - src/m/sun386.h | 90 - src/m/tad68k.h | 102 - src/m/tahoe.h | 64 - src/m/targon31.h | 90 - src/m/tek4300.h | 88 - src/m/tekxd88.h | 106 - src/m/template.h | 107 - src/m/tower32.h | 107 - src/m/tower32v3.h | 105 - src/m/ustation.h | 123 - src/m/wicat.h | 128 - src/m/windowsnt.h | 126 - src/m/xps100.h | 91 - src/macros.c | 332 - src/macros.h | 38 - src/make-src-depend | 138 - src/malloc.c | 829 -- src/marker.c | 545 - src/md5.c | 618 -- src/mem-limits.h | 228 - src/menubar-msw.c | 836 -- src/menubar-msw.h | 43 - src/menubar-x.c | 866 -- src/menubar.c | 602 -- src/menubar.h | 40 - src/minibuf.c | 981 -- src/mule-canna.c | 1909 ---- src/mule-ccl.c | 1122 -- src/mule-ccl.h | 53 - src/mule-charset.c | 1419 --- src/mule-charset.h | 769 -- src/mule-wnnfns.c | 2143 ---- src/mule.c | 123 - src/nas.c | 1005 -- src/ndir.h | 57 - src/nt.c | 1931 ---- src/nt.h | 150 - src/ntheap.c | 329 - src/ntheap.h | 114 - src/ntplay.c | 107 - src/ntproc.c | 1404 --- src/objects-msw.c | 1526 --- src/objects-msw.h | 51 - src/objects-tty.c | 391 - src/objects-tty.h | 52 - src/objects-x.c | 1033 -- src/objects-x.h | 67 - src/objects.c | 1089 -- src/objects.h | 189 - src/offix-types.h | 34 - src/offix.h | 68 - src/opaque.c | 261 - src/opaque.h | 103 - src/paths.h.in | 110 - src/print.c | 1788 --- src/process-nt.c | 954 -- src/process-unix.c | 1752 --- src/process.c | 2089 ---- src/process.h | 137 - src/procimpl.h | 188 - src/profile.c | 361 - src/ralloc.c | 2075 ---- src/rangetab.c | 702 -- src/rangetab.h | 56 - src/realpath.c | 249 - src/redisplay-msw.c | 1503 --- src/redisplay-output.c | 1605 --- src/redisplay-tty.c | 1552 --- src/redisplay-x.c | 2277 ---- src/redisplay.c | 8579 --------------- src/redisplay.h | 583 - src/regex.c | 6261 ----------- src/regex.h | 485 - src/s/aix3-1.h | 144 - src/s/aix3-2.h | 58 - src/s/aix4.h | 13 - src/s/bsd386.h | 31 - src/s/cygwin32.h | 278 - src/s/decosf1-3.h | 23 - src/s/decosf4-0.h | 42 - src/s/freebsd.h | 108 - src/s/gnu.h | 52 - src/s/irix4-0.h | 53 - src/s/irix5-0.h | 91 - src/s/irix6-0.h | 6 - src/s/linux.h | 203 - src/s/netbsd.h | 71 - src/s/ptx.h | 135 - src/s/sco5.h | 132 - src/s/sol2.h | 154 - src/s/usg5-4.h | 161 - src/s/windowsnt.h | 372 - src/scrollbar-msw.c | 341 - src/scrollbar-msw.h | 62 - src/scrollbar-x.c | 758 -- src/scrollbar-x.h | 75 - src/scrollbar.c | 1047 -- src/scrollbar.h | 84 - src/search.c | 2569 ----- src/select-msw.c | 180 - src/sgiplay.c | 730 -- src/sheap.c | 122 - src/signal.c | 802 -- src/sound.c | 609 -- src/specifier.c | 3166 ------ src/specifier.h | 467 - src/src-headers | 236 - src/strcat.c | 61 - src/strcmp.c | 151 - src/strcpy.c | 89 - src/strftime.c | 461 - src/sunOS-fix.c | 65 - src/sunplay.c | 329 - src/symbols.c | 3391 ------ src/symeval.h | 338 - src/symsinit.h | 384 - src/syntax.c | 1723 --- src/syntax.h | 254 - src/sysdep.c | 3969 ------- src/sysdep.h | 181 - src/sysdir.h | 131 - src/sysdll.c | 293 - src/sysdll.h | 53 - src/sysfile.h | 472 - src/sysfloat.h | 88 - src/sysproc.h | 105 - src/syspwd.h | 23 - src/syssignal.h | 247 - src/systime.h | 245 - src/systty.h | 448 - src/syswait.h | 54 - src/termcap.c | 672 -- src/terminfo.c | 89 - src/toolbar-msw.c | 639 -- src/toolbar-x.c | 797 -- src/toolbar.c | 1905 ---- src/toolbar.h | 114 - src/tooltalk.c | 1481 --- src/tooltalk.doc | 330 - src/tooltalk.h | 64 - src/tparam.c | 293 - src/undo.c | 557 - src/unexaix.c | 675 -- src/unexalpha.c | 451 - src/unexcw.c | 501 - src/unexec.c | 1270 --- src/unexelf.c | 939 -- src/unexelfsgi.c | 1014 -- src/unexfreebsd.c | 719 -- src/unexhp9k3.c | 525 - src/unexhp9k800.c | 355 - src/unexmips.c | 356 - src/unexnt.c | 662 -- src/unexsol2.c | 60 - src/unexsunos4.c | 657 -- src/vm-limit.c | 135 - src/widget.c | 117 - src/window.c | 5720 ---------- src/window.h | 419 - src/winslots.h | 116 - src/xgccache.c | 331 - src/xgccache.h | 34 - src/xintrinsic.h | 30 - src/xintrinsicp.h | 32 - src/xmmanagerp.h | 31 - src/xmprimitivep.h | 31 - src/xmu.c | 551 - src/xmu.h | 31 - tests/ChangeLog | 23 - tests/DLL/dltest.c | 40 - tests/Dnd/droptest.sh | 102 - tests/automated/byte-compiler-tests.el | 93 - tests/automated/database-tests.el | 60 - tests/automated/hash-table-tests.el | 269 - tests/automated/lisp-tests.el | 787 -- tests/automated/md5-tests.el | 96 - tests/automated/test-harness.el | 367 - tests/glyph-test.el | 92 - version.sh | 8 - 831 files changed, 612572 deletions(-) delete mode 100644 CHANGES-beta delete mode 100644 ChangeLog delete mode 100644 INSTALL delete mode 100644 Makefile.in.in delete mode 100644 PROBLEMS delete mode 100644 README delete mode 100644 README.packages delete mode 100644 aclocal.m4 delete mode 100755 config.guess delete mode 100755 config.sub delete mode 100755 configure delete mode 100644 configure.in delete mode 100644 configure.usage delete mode 100644 dynodump/_dynodump.h delete mode 100644 dynodump/dynodump.c delete mode 100644 dynodump/i386/_relocate.c delete mode 100644 dynodump/i386/machdep.h delete mode 100644 dynodump/ppc/_relocate.c delete mode 100644 dynodump/ppc/machdep.h delete mode 100644 dynodump/sparc/_relocate.c delete mode 100644 dynodump/sparc/machdep.h delete mode 100644 dynodump/syms.c delete mode 100644 etc/BETA delete mode 100644 etc/CHARSETS delete mode 100644 etc/DISTRIB delete mode 100644 etc/Emacs.ad delete mode 100644 etc/FTP delete mode 100644 etc/HELLO delete mode 100644 etc/MACHINES delete mode 100644 etc/MAILINGLISTS delete mode 100644 etc/NEWS delete mode 100644 etc/OONEWS delete mode 100644 etc/PACKAGES delete mode 100644 etc/README delete mode 100644 etc/README.HYPERBOLE delete mode 100644 etc/README.OO-BROWSER delete mode 100644 etc/SERVICE delete mode 100644 etc/TUTORIAL delete mode 100644 etc/TUTORIAL.de delete mode 100644 etc/TUTORIAL.fr delete mode 100644 etc/TUTORIAL.ja delete mode 100644 etc/TUTORIAL.ru delete mode 100644 etc/TUTORIAL.th delete mode 100755 etc/aliases.ksh delete mode 100644 etc/editclient.sh delete mode 100644 etc/etags.1 delete mode 100644 etc/gnuserv.1 delete mode 100644 etc/package-index.LATEST.pgp delete mode 100644 etc/photos/hniksic.png delete mode 100644 etc/photos/hniksicm.png delete mode 100644 etc/photos/jwz.png delete mode 100644 etc/photos/jwzm.png delete mode 100644 etc/sample.Xdefaults delete mode 100755 etc/xemacs-fe.sh delete mode 100644 etc/xemacs-ja.1 delete mode 100644 etc/xemacs.1 delete mode 100644 info/dir delete mode 100644 lib-src/ChangeLog delete mode 100644 lib-src/Makefile.in.in delete mode 100755 lib-src/add-big-package.sh delete mode 100644 lib-src/b2m.c delete mode 100644 lib-src/config.values.in delete mode 100644 lib-src/config.values.sh delete mode 100644 lib-src/cvtmail.c delete mode 100644 lib-src/digest-doc.c delete mode 100644 lib-src/ellcc.c delete mode 100644 lib-src/etags.c delete mode 100644 lib-src/fakemail.c delete mode 100644 lib-src/getopt.c delete mode 100644 lib-src/getopt.h delete mode 100644 lib-src/getopt1.c delete mode 100644 lib-src/gnuclient.c delete mode 100644 lib-src/gnuserv.c delete mode 100644 lib-src/gnuserv.h delete mode 100644 lib-src/gnuslib.c delete mode 100755 lib-src/gzip-el.sh delete mode 100644 lib-src/hexl.c delete mode 100644 lib-src/installexe.sh delete mode 100644 lib-src/make-docfile.c delete mode 100644 lib-src/make-msgfile.c delete mode 100644 lib-src/make-msgfile.lex delete mode 100644 lib-src/make-path.c delete mode 100644 lib-src/make-po.c delete mode 100644 lib-src/mmencode.c delete mode 100644 lib-src/movemail.c delete mode 100644 lib-src/ootags.c delete mode 100644 lib-src/pop.c delete mode 100644 lib-src/profile.c delete mode 100644 lib-src/qsort.c delete mode 100755 lib-src/rcs2log delete mode 100644 lib-src/sorted-doc.c delete mode 100644 lib-src/update-autoloads.sh delete mode 100644 lib-src/wakeup.c delete mode 100644 lib-src/yow.c delete mode 100644 lisp/ChangeLog delete mode 100644 lisp/ChangeLog.1 delete mode 100644 lisp/abbrev.el delete mode 100644 lisp/about.el delete mode 100644 lisp/alist.el delete mode 100644 lisp/apropos.el delete mode 100644 lisp/auto-autoloads.el delete mode 100644 lisp/auto-save.el delete mode 100644 lisp/auto-show.el delete mode 100644 lisp/autoload.el delete mode 100644 lisp/backquote.el delete mode 100644 lisp/buff-menu.el delete mode 100644 lisp/buffer.el delete mode 100644 lisp/build-report.el delete mode 100644 lisp/byte-optimize.el delete mode 100644 lisp/bytecomp-runtime.el delete mode 100644 lisp/bytecomp.el delete mode 100644 lisp/check-features.el delete mode 100644 lisp/cl-compat.el delete mode 100644 lisp/cl-extra.el delete mode 100644 lisp/cl-macs.el delete mode 100644 lisp/cl-seq.el delete mode 100644 lisp/cl.el delete mode 100644 lisp/cmdloop.el delete mode 100644 lisp/code-files.el delete mode 100644 lisp/code-process.el delete mode 100644 lisp/coding.el delete mode 100644 lisp/config.el delete mode 100644 lisp/cus-dep.el delete mode 100644 lisp/cus-edit.el delete mode 100644 lisp/cus-face.el delete mode 100644 lisp/cus-load.el delete mode 100644 lisp/cus-start.el delete mode 100644 lisp/custom-load.el delete mode 100644 lisp/custom.el delete mode 100644 lisp/derived.el delete mode 100644 lisp/device.el delete mode 100644 lisp/dialog.el delete mode 100644 lisp/disass.el delete mode 100644 lisp/dragdrop.el delete mode 100644 lisp/dump-paths.el delete mode 100644 lisp/dumped-lisp.el delete mode 100644 lisp/easymenu.el delete mode 100644 lisp/etags.el delete mode 100644 lisp/extents.el delete mode 100644 lisp/faces.el delete mode 100644 lisp/files-nomule.el delete mode 100644 lisp/files.el delete mode 100644 lisp/fill.el delete mode 100644 lisp/find-paths.el delete mode 100644 lisp/finder.el delete mode 100644 lisp/float-sup.el delete mode 100644 lisp/font-lock.el delete mode 100644 lisp/font.el delete mode 100644 lisp/format.el delete mode 100644 lisp/frame.el delete mode 100644 lisp/glyphs.el delete mode 100644 lisp/gnuserv.el delete mode 100644 lisp/gui.el delete mode 100644 lisp/help-macro.el delete mode 100644 lisp/help-nomule.el delete mode 100644 lisp/help.el delete mode 100644 lisp/hyper-apropos.el delete mode 100644 lisp/indent.el delete mode 100644 lisp/info.el delete mode 100644 lisp/isearch-mode.el delete mode 100644 lisp/iso8859-1.el delete mode 100644 lisp/itimer.el delete mode 100644 lisp/keydefs.el delete mode 100644 lisp/keymap.el delete mode 100644 lisp/ldap.el delete mode 100644 lisp/lib-complete.el delete mode 100644 lisp/lisp-mnt.el delete mode 100644 lisp/lisp-mode.el delete mode 100644 lisp/lisp.el delete mode 100644 lisp/list-mode.el delete mode 100644 lisp/loaddefs.el delete mode 100644 lisp/loadhist.el delete mode 100644 lisp/loadup.el delete mode 100644 lisp/make-docfile.el delete mode 100644 lisp/map-ynp.el delete mode 100644 lisp/menubar-items.el delete mode 100644 lisp/menubar.el delete mode 100644 lisp/minibuf.el delete mode 100644 lisp/modeline.el delete mode 100644 lisp/mouse.el delete mode 100644 lisp/msw-faces.el delete mode 100644 lisp/msw-glyphs.el delete mode 100644 lisp/msw-init.el delete mode 100644 lisp/msw-select.el delete mode 100644 lisp/mule/chinese.el delete mode 100644 lisp/mule/cyrillic.el delete mode 100644 lisp/mule/english.el delete mode 100644 lisp/mule/european.el delete mode 100644 lisp/mule/greek.el delete mode 100644 lisp/mule/hebrew.el delete mode 100644 lisp/mule/japanese.el delete mode 100644 lisp/mule/kinsoku.el delete mode 100644 lisp/mule/korean.el delete mode 100644 lisp/mule/misc-lang.el delete mode 100644 lisp/mule/mule-category.el delete mode 100644 lisp/mule/mule-ccl.el delete mode 100644 lisp/mule/mule-charset.el delete mode 100644 lisp/mule/mule-cmds.el delete mode 100644 lisp/mule/mule-coding.el delete mode 100644 lisp/mule/mule-help.el delete mode 100644 lisp/mule/mule-init.el delete mode 100644 lisp/mule/mule-misc.el delete mode 100644 lisp/mule/mule-x-init.el delete mode 100644 lisp/multicast.el delete mode 100644 lisp/mwheel.el delete mode 100644 lisp/objects.el delete mode 100644 lisp/obsolete.el delete mode 100644 lisp/package-admin.el delete mode 100644 lisp/package-get.el delete mode 100644 lisp/package-info.el delete mode 100644 lisp/package-ui.el delete mode 100644 lisp/packages.el delete mode 100644 lisp/page.el delete mode 100644 lisp/paragraphs.el delete mode 100644 lisp/paths.el delete mode 100644 lisp/picture.el delete mode 100644 lisp/process.el delete mode 100644 lisp/rect.el delete mode 100644 lisp/replace.el delete mode 100644 lisp/scrollbar.el delete mode 100644 lisp/select.el delete mode 100644 lisp/setup-paths.el delete mode 100644 lisp/shadow.el delete mode 100644 lisp/simple.el delete mode 100644 lisp/site-load.el delete mode 100644 lisp/sound.el delete mode 100644 lisp/specifier.el delete mode 100644 lisp/startup.el delete mode 100644 lisp/subr.el delete mode 100644 lisp/symbols.el delete mode 100644 lisp/syntax.el delete mode 100644 lisp/term/bg-mouse.el delete mode 100644 lisp/term/pc-win.el delete mode 100644 lisp/term/scoansi.el delete mode 100644 lisp/term/sun-mouse.el delete mode 100644 lisp/term/sun.el delete mode 100644 lisp/text-props.el delete mode 100644 lisp/toolbar-items.el delete mode 100644 lisp/toolbar.el delete mode 100644 lisp/update-elc.el delete mode 100644 lisp/userlock.el delete mode 100644 lisp/version.el delete mode 100644 lisp/very-early-lisp.el delete mode 100644 lisp/view-less.el delete mode 100644 lisp/wid-edit.el delete mode 100644 lisp/widget.el delete mode 100644 lisp/window-xemacs.el delete mode 100644 lisp/window.el delete mode 100644 lisp/x-compose.el delete mode 100644 lisp/x-faces.el delete mode 100644 lisp/x-font-menu.el delete mode 100644 lisp/x-init.el delete mode 100644 lisp/x-iso8859-1.el delete mode 100644 lisp/x-misc.el delete mode 100644 lisp/x-mouse.el delete mode 100644 lisp/x-scrollbar.el delete mode 100644 lisp/x-select.el delete mode 100644 lisp/x-win-sun.el delete mode 100644 lwlib/.cvsignore delete mode 100644 lwlib/Makefile.in.in delete mode 100644 lwlib/config.h.in delete mode 100644 lwlib/lwlib-Xaw.c delete mode 100644 lwlib/lwlib-Xaw.h delete mode 100644 lwlib/lwlib-Xlw.c delete mode 100644 lwlib/lwlib-Xlw.h delete mode 100644 lwlib/lwlib-Xm.c delete mode 100644 lwlib/lwlib-Xm.h delete mode 100644 lwlib/lwlib-config.c delete mode 100644 lwlib/lwlib-internal.h delete mode 100644 lwlib/lwlib-utils.c delete mode 100644 lwlib/lwlib-utils.h delete mode 100644 lwlib/lwlib.c delete mode 100644 lwlib/lwlib.h delete mode 100644 lwlib/xlwmenu.c delete mode 100644 lwlib/xlwmenu.h delete mode 100644 lwlib/xlwmenuP.h delete mode 100644 lwlib/xlwscrollbar.c delete mode 100644 lwlib/xlwscrollbar.h delete mode 100644 man/ChangeLog delete mode 100644 man/Makefile delete mode 100644 man/cl.texi delete mode 100644 man/custom.texi delete mode 100644 man/emodules.texi delete mode 100644 man/external-widget.texi delete mode 100644 man/info.texi delete mode 100644 man/internals/internals.texi delete mode 100644 man/lispref/abbrevs.texi delete mode 100644 man/lispref/annotations.texi delete mode 100644 man/lispref/backups.texi delete mode 100644 man/lispref/buffers.texi delete mode 100644 man/lispref/building.texi delete mode 100644 man/lispref/commands.texi delete mode 100644 man/lispref/compile.texi delete mode 100644 man/lispref/consoles-devices.texi delete mode 100644 man/lispref/control.texi delete mode 100644 man/lispref/customize.texi delete mode 100644 man/lispref/databases.texi delete mode 100644 man/lispref/debugging.texi delete mode 100644 man/lispref/dialog.texi delete mode 100644 man/lispref/display.texi delete mode 100644 man/lispref/dragndrop.texi delete mode 100644 man/lispref/edebug-inc.texi delete mode 100644 man/lispref/edebug.texi delete mode 100644 man/lispref/errors.texi delete mode 100644 man/lispref/eval.texi delete mode 100644 man/lispref/extents.texi delete mode 100644 man/lispref/faces.texi delete mode 100644 man/lispref/files.texi delete mode 100644 man/lispref/frames.texi delete mode 100644 man/lispref/functions.texi delete mode 100644 man/lispref/glyphs.texi delete mode 100644 man/lispref/hash-tables.texi delete mode 100644 man/lispref/help.texi delete mode 100644 man/lispref/hooks.texi delete mode 100644 man/lispref/internationalization.texi delete mode 100644 man/lispref/intro.texi delete mode 100644 man/lispref/keymaps.texi delete mode 100644 man/lispref/ldap.texi delete mode 100644 man/lispref/lispref.texi delete mode 100644 man/lispref/lists.texi delete mode 100644 man/lispref/loading.texi delete mode 100644 man/lispref/locals.texi delete mode 100644 man/lispref/macros.texi delete mode 100644 man/lispref/maps.texi delete mode 100644 man/lispref/markers.texi delete mode 100644 man/lispref/menus.texi delete mode 100644 man/lispref/minibuf.texi delete mode 100644 man/lispref/modes.texi delete mode 100644 man/lispref/mouse.texi delete mode 100644 man/lispref/mule.texi delete mode 100644 man/lispref/numbers.texi delete mode 100644 man/lispref/objects.texi delete mode 100644 man/lispref/os.texi delete mode 100644 man/lispref/positions.texi delete mode 100644 man/lispref/processes.texi delete mode 100644 man/lispref/range-tables.texi delete mode 100644 man/lispref/scrollbars.texi delete mode 100644 man/lispref/searching.texi delete mode 100644 man/lispref/sequences.texi delete mode 100644 man/lispref/specifiers.texi delete mode 100644 man/lispref/streams.texi delete mode 100644 man/lispref/strings.texi delete mode 100644 man/lispref/symbols.texi delete mode 100644 man/lispref/syntax.texi delete mode 100644 man/lispref/text.texi delete mode 100644 man/lispref/tips.texi delete mode 100644 man/lispref/toolbar.texi delete mode 100644 man/lispref/tooltalk.texi delete mode 100644 man/lispref/variables.texi delete mode 100644 man/lispref/windows.texi delete mode 100644 man/lispref/x-windows.texi delete mode 100644 man/make-stds.texi delete mode 100644 man/new-users-guide/custom1.texi delete mode 100644 man/new-users-guide/custom2.texi delete mode 100644 man/new-users-guide/edit.texi delete mode 100644 man/new-users-guide/files.texi delete mode 100644 man/new-users-guide/help.texi delete mode 100644 man/new-users-guide/modes.texi delete mode 100644 man/new-users-guide/new-users-guide.texi delete mode 100644 man/new-users-guide/region.texi delete mode 100644 man/new-users-guide/search.texi delete mode 100644 man/new-users-guide/xmenu.texi delete mode 100644 man/standards.texi delete mode 100644 man/term.texi delete mode 100644 man/termcap.texi delete mode 100644 man/texinfo.tex delete mode 100644 man/texinfo.texi delete mode 100644 man/widget.texi delete mode 100644 man/xemacs-faq.texi delete mode 100644 man/xemacs/abbrevs.texi delete mode 100644 man/xemacs/basic.texi delete mode 100644 man/xemacs/buffers.texi delete mode 100644 man/xemacs/building.texi delete mode 100644 man/xemacs/calendar.texi delete mode 100644 man/xemacs/cmdargs.texi delete mode 100644 man/xemacs/custom.texi delete mode 100644 man/xemacs/entering.texi delete mode 100644 man/xemacs/files.texi delete mode 100644 man/xemacs/frame.texi delete mode 100644 man/xemacs/glossary.texi delete mode 100644 man/xemacs/gnu.texi delete mode 100644 man/xemacs/help.texi delete mode 100644 man/xemacs/keystrokes.texi delete mode 100644 man/xemacs/major.texi delete mode 100644 man/xemacs/mark.texi delete mode 100644 man/xemacs/menus.texi delete mode 100644 man/xemacs/mini.texi delete mode 100644 man/xemacs/misc.texi delete mode 100644 man/xemacs/mule.texi delete mode 100644 man/xemacs/new.texi delete mode 100644 man/xemacs/packages.texi delete mode 100644 man/xemacs/programs.texi delete mode 100644 man/xemacs/reading.texi delete mode 100644 man/xemacs/regs.texi delete mode 100644 man/xemacs/search.texi delete mode 100644 man/xemacs/sending.texi delete mode 100644 man/xemacs/startup.texi delete mode 100644 man/xemacs/text.texi delete mode 100644 man/xemacs/trouble.texi delete mode 100644 man/xemacs/windows.texi delete mode 100644 man/xemacs/xemacs.texi delete mode 100644 modules/base64/Makefile delete mode 100644 modules/base64/base64.c delete mode 100644 modules/ldap/Makefile delete mode 100644 modules/sample/Makefile delete mode 100644 modules/sample/sample.c delete mode 100644 modules/zlib/Makefile delete mode 100644 nt/ChangeLog delete mode 100644 nt/Emacs.ad.h delete mode 100644 nt/PROBLEMS delete mode 100644 nt/README delete mode 100644 nt/config.h delete mode 100644 nt/minitar.c delete mode 100644 nt/minitar.mak delete mode 100644 nt/xemacs.mak delete mode 100644 nt/xemacs.rc delete mode 100644 nt/xpm.mak delete mode 100644 src/.cvsignore delete mode 100644 src/ChangeLog delete mode 100644 src/ChangeLog.1 delete mode 100644 src/EmacsFrame.c delete mode 100644 src/EmacsFrame.h delete mode 100644 src/EmacsFrameP.h delete mode 100644 src/EmacsManager.c delete mode 100644 src/EmacsManager.h delete mode 100644 src/EmacsManagerP.h delete mode 100644 src/EmacsShell-sub.c delete mode 100644 src/EmacsShell.c delete mode 100644 src/EmacsShell.h delete mode 100644 src/EmacsShellP.h delete mode 100644 src/ExternalClient.c delete mode 100644 src/ExternalClient.h delete mode 100644 src/ExternalClientP.h delete mode 100644 src/ExternalShell.c delete mode 100644 src/ExternalShell.h delete mode 100644 src/ExternalShellP.h delete mode 100644 src/Makefile.in.in delete mode 100644 src/README delete mode 100644 src/abbrev.c delete mode 100644 src/alloc.c delete mode 100644 src/alloca.c delete mode 100644 src/backtrace.h delete mode 100644 src/balloon-x.c delete mode 100644 src/balloon_help.c delete mode 100644 src/balloon_help.h delete mode 100644 src/bitmaps.h delete mode 100644 src/blocktype.h delete mode 100644 src/broken-sun.h delete mode 100644 src/buffer.c delete mode 100644 src/buffer.h delete mode 100644 src/bufslots.h delete mode 100644 src/bytecode.c delete mode 100644 src/bytecode.h delete mode 100644 src/callint.c delete mode 100644 src/callproc.c delete mode 100644 src/casefiddle.c delete mode 100644 src/casetab.c delete mode 100644 src/chartab.c delete mode 100644 src/chartab.h delete mode 100644 src/cm.c delete mode 100644 src/cm.h delete mode 100644 src/cmdloop.c delete mode 100644 src/cmds.c delete mode 100644 src/commands.h delete mode 100644 src/config.h.in delete mode 100644 src/conslots.h delete mode 100644 src/console-msw.c delete mode 100644 src/console-msw.h delete mode 100644 src/console-stream.c delete mode 100644 src/console-stream.h delete mode 100644 src/console-tty.c delete mode 100644 src/console-tty.h delete mode 100644 src/console-x.c delete mode 100644 src/console-x.h delete mode 100644 src/console.c delete mode 100644 src/console.h delete mode 100644 src/data.c delete mode 100644 src/database.c delete mode 100644 src/database.h delete mode 100644 src/debug.c delete mode 100644 src/debug.h delete mode 100644 src/depend delete mode 100644 src/device-msw.c delete mode 100644 src/device-tty.c delete mode 100644 src/device-x.c delete mode 100644 src/device.c delete mode 100644 src/device.h delete mode 100644 src/dgif_lib.c delete mode 100644 src/dialog-msw.c delete mode 100644 src/dialog-x.c delete mode 100644 src/dialog.c delete mode 100644 src/dired-msw.c delete mode 100644 src/dired.c delete mode 100644 src/doc.c delete mode 100644 src/doprnt.c delete mode 100644 src/dragdrop.c delete mode 100644 src/dragdrop.h delete mode 100644 src/dynarr.c delete mode 100644 src/editfns.c delete mode 100644 src/eldap.c delete mode 100644 src/eldap.h delete mode 100644 src/elhash.c delete mode 100644 src/elhash.h delete mode 100644 src/emacs.c delete mode 100644 src/emodules.c delete mode 100644 src/emodules.h delete mode 100644 src/eval.c delete mode 100644 src/event-Xt.c delete mode 100644 src/event-msw.c delete mode 100644 src/event-stream.c delete mode 100644 src/event-tty.c delete mode 100644 src/event-unixoid.c delete mode 100644 src/events-mod.h delete mode 100644 src/events.c delete mode 100644 src/events.h delete mode 100644 src/extents.c delete mode 100644 src/extents.h delete mode 100644 src/extw-Xlib.h delete mode 100644 src/extw-Xt.c delete mode 100644 src/extw-Xt.h delete mode 100644 src/faces.c delete mode 100644 src/faces.h delete mode 100644 src/file-coding.c delete mode 100644 src/file-coding.h delete mode 100644 src/fileio.c delete mode 100644 src/filelock.c delete mode 100644 src/filemode.c delete mode 100644 src/floatfns.c delete mode 100644 src/fns.c delete mode 100644 src/font-lock.c delete mode 100644 src/frame-msw.c delete mode 100644 src/frame-tty.c delete mode 100644 src/frame-x.c delete mode 100644 src/frame.c delete mode 100644 src/frame.h delete mode 100644 src/frameslots.h delete mode 100644 src/free-hook.c delete mode 100644 src/general.c delete mode 100644 src/getloadavg.c delete mode 100644 src/getpagesize.h delete mode 100644 src/gif_io.c delete mode 100644 src/gifrlib.h delete mode 100644 src/glyphs-eimage.c delete mode 100644 src/glyphs-msw.c delete mode 100644 src/glyphs-msw.h delete mode 100644 src/glyphs-widget.c delete mode 100644 src/glyphs-x.c delete mode 100644 src/glyphs-x.h delete mode 100644 src/glyphs.c delete mode 100644 src/glyphs.h delete mode 100644 src/gmalloc.c delete mode 100644 src/gpmevent.c delete mode 100644 src/gpmevent.h delete mode 100644 src/gui-msw.c delete mode 100644 src/gui-x.c delete mode 100644 src/gui-x.h delete mode 100644 src/gui.c delete mode 100644 src/gui.h delete mode 100644 src/hash.c delete mode 100644 src/hash.h delete mode 100644 src/hpplay.c delete mode 100644 src/imgproc.c delete mode 100644 src/imgproc.h delete mode 100644 src/indent.c delete mode 100644 src/inline.c delete mode 100644 src/input-method-motif.c delete mode 100644 src/input-method-xlib.c delete mode 100644 src/insdel.c delete mode 100644 src/insdel.h delete mode 100644 src/intl.c delete mode 100644 src/iso-wide.h delete mode 100644 src/keymap.c delete mode 100644 src/keymap.h delete mode 100644 src/lastfile.c delete mode 100644 src/libsst.c delete mode 100644 src/libsst.h delete mode 100644 src/libst.h delete mode 100644 src/line-number.c delete mode 100644 src/line-number.h delete mode 100644 src/linuxplay.c delete mode 100644 src/lisp-disunion.h delete mode 100644 src/lisp-union.h delete mode 100644 src/lisp.h delete mode 100644 src/lread.c delete mode 100644 src/lrecord.h delete mode 100644 src/lstream.c delete mode 100644 src/lstream.h delete mode 100644 src/m/7300.h delete mode 100644 src/m/acorn.h delete mode 100644 src/m/alliant-2800.h delete mode 100644 src/m/alliant.h delete mode 100644 src/m/alpha.h delete mode 100644 src/m/altos.h delete mode 100644 src/m/amdahl.h delete mode 100644 src/m/apollo.h delete mode 100644 src/m/arm.h delete mode 100644 src/m/att3b.h delete mode 100644 src/m/aviion.h delete mode 100644 src/m/celerity.h delete mode 100644 src/m/clipper.h delete mode 100644 src/m/cnvrgnt.h delete mode 100644 src/m/convex.h delete mode 100644 src/m/cydra5.h delete mode 100644 src/m/delta.h delete mode 100644 src/m/delta88k.h delete mode 100644 src/m/dpx2.h delete mode 100644 src/m/dual.h delete mode 100644 src/m/elxsi.h delete mode 100644 src/m/ews4800r.h delete mode 100644 src/m/gould-np1.h delete mode 100644 src/m/gould.h delete mode 100644 src/m/hp300bsd.h delete mode 100644 src/m/hp800.h delete mode 100644 src/m/hp9000s300.h delete mode 100644 src/m/i860.h delete mode 100644 src/m/ibmps2-aix.h delete mode 100644 src/m/ibmrs6000.h delete mode 100644 src/m/ibmrt-aix.h delete mode 100644 src/m/ibmrt.h delete mode 100644 src/m/intel386.h delete mode 100644 src/m/iris4d.h delete mode 100644 src/m/iris5d.h delete mode 100644 src/m/irist.h delete mode 100644 src/m/isi-ov.h delete mode 100644 src/m/luna88k.h delete mode 100644 src/m/m68k.h delete mode 100644 src/m/masscomp.h delete mode 100644 src/m/mega68.h delete mode 100644 src/m/mg1.h delete mode 100644 src/m/mips-nec.h delete mode 100644 src/m/mips-siemens.h delete mode 100644 src/m/mips.h delete mode 100644 src/m/next.h delete mode 100644 src/m/nh3000.h delete mode 100644 src/m/nh4000.h delete mode 100644 src/m/ns32000.h delete mode 100644 src/m/nu.h delete mode 100644 src/m/orion.h delete mode 100644 src/m/orion105.h delete mode 100644 src/m/pfa50.h delete mode 100644 src/m/plexus.h delete mode 100644 src/m/pmax.h delete mode 100644 src/m/powerpc.h delete mode 100644 src/m/pyramid.h delete mode 100644 src/m/sequent-ptx.h delete mode 100644 src/m/sequent.h delete mode 100644 src/m/sgi-challenge.h delete mode 100644 src/m/sparc.h delete mode 100644 src/m/sps7.h delete mode 100644 src/m/stride.h delete mode 100644 src/m/sun1.h delete mode 100644 src/m/sun2.h delete mode 100644 src/m/sun386.h delete mode 100644 src/m/tad68k.h delete mode 100644 src/m/tahoe.h delete mode 100644 src/m/targon31.h delete mode 100644 src/m/tek4300.h delete mode 100644 src/m/tekxd88.h delete mode 100644 src/m/template.h delete mode 100644 src/m/tower32.h delete mode 100644 src/m/tower32v3.h delete mode 100644 src/m/ustation.h delete mode 100644 src/m/wicat.h delete mode 100644 src/m/windowsnt.h delete mode 100644 src/m/xps100.h delete mode 100644 src/macros.c delete mode 100644 src/macros.h delete mode 100644 src/make-src-depend delete mode 100644 src/malloc.c delete mode 100644 src/marker.c delete mode 100644 src/md5.c delete mode 100644 src/mem-limits.h delete mode 100644 src/menubar-msw.c delete mode 100644 src/menubar-msw.h delete mode 100644 src/menubar-x.c delete mode 100644 src/menubar.c delete mode 100644 src/menubar.h delete mode 100644 src/minibuf.c delete mode 100644 src/mule-canna.c delete mode 100644 src/mule-ccl.c delete mode 100644 src/mule-ccl.h delete mode 100644 src/mule-charset.c delete mode 100644 src/mule-charset.h delete mode 100644 src/mule-wnnfns.c delete mode 100644 src/mule.c delete mode 100644 src/nas.c delete mode 100644 src/ndir.h delete mode 100644 src/nt.c delete mode 100644 src/nt.h delete mode 100644 src/ntheap.c delete mode 100644 src/ntheap.h delete mode 100644 src/ntplay.c delete mode 100644 src/ntproc.c delete mode 100644 src/objects-msw.c delete mode 100644 src/objects-msw.h delete mode 100644 src/objects-tty.c delete mode 100644 src/objects-tty.h delete mode 100644 src/objects-x.c delete mode 100644 src/objects-x.h delete mode 100644 src/objects.c delete mode 100644 src/objects.h delete mode 100644 src/offix-types.h delete mode 100644 src/offix.h delete mode 100644 src/opaque.c delete mode 100644 src/opaque.h delete mode 100644 src/paths.h.in delete mode 100644 src/print.c delete mode 100644 src/process-nt.c delete mode 100644 src/process-unix.c delete mode 100644 src/process.c delete mode 100644 src/process.h delete mode 100644 src/procimpl.h delete mode 100644 src/profile.c delete mode 100644 src/ralloc.c delete mode 100644 src/rangetab.c delete mode 100644 src/rangetab.h delete mode 100644 src/realpath.c delete mode 100644 src/redisplay-msw.c delete mode 100644 src/redisplay-output.c delete mode 100644 src/redisplay-tty.c delete mode 100644 src/redisplay-x.c delete mode 100644 src/redisplay.c delete mode 100644 src/redisplay.h delete mode 100644 src/regex.c delete mode 100644 src/regex.h delete mode 100644 src/s/aix3-1.h delete mode 100644 src/s/aix3-2.h delete mode 100644 src/s/aix4.h delete mode 100644 src/s/bsd386.h delete mode 100644 src/s/cygwin32.h delete mode 100644 src/s/decosf1-3.h delete mode 100644 src/s/decosf4-0.h delete mode 100644 src/s/freebsd.h delete mode 100644 src/s/gnu.h delete mode 100644 src/s/irix4-0.h delete mode 100644 src/s/irix5-0.h delete mode 100644 src/s/irix6-0.h delete mode 100644 src/s/linux.h delete mode 100644 src/s/netbsd.h delete mode 100644 src/s/ptx.h delete mode 100644 src/s/sco5.h delete mode 100644 src/s/sol2.h delete mode 100644 src/s/usg5-4.h delete mode 100644 src/s/windowsnt.h delete mode 100644 src/scrollbar-msw.c delete mode 100644 src/scrollbar-msw.h delete mode 100644 src/scrollbar-x.c delete mode 100644 src/scrollbar-x.h delete mode 100644 src/scrollbar.c delete mode 100644 src/scrollbar.h delete mode 100644 src/search.c delete mode 100644 src/select-msw.c delete mode 100644 src/sgiplay.c delete mode 100644 src/sheap.c delete mode 100644 src/signal.c delete mode 100644 src/sound.c delete mode 100644 src/specifier.c delete mode 100644 src/specifier.h delete mode 100644 src/src-headers delete mode 100644 src/strcat.c delete mode 100644 src/strcmp.c delete mode 100644 src/strcpy.c delete mode 100644 src/strftime.c delete mode 100644 src/sunOS-fix.c delete mode 100644 src/sunplay.c delete mode 100644 src/symbols.c delete mode 100644 src/symeval.h delete mode 100644 src/symsinit.h delete mode 100644 src/syntax.c delete mode 100644 src/syntax.h delete mode 100644 src/sysdep.c delete mode 100644 src/sysdep.h delete mode 100644 src/sysdir.h delete mode 100644 src/sysdll.c delete mode 100644 src/sysdll.h delete mode 100644 src/sysfile.h delete mode 100644 src/sysfloat.h delete mode 100644 src/sysproc.h delete mode 100644 src/syspwd.h delete mode 100644 src/syssignal.h delete mode 100644 src/systime.h delete mode 100644 src/systty.h delete mode 100644 src/syswait.h delete mode 100644 src/termcap.c delete mode 100644 src/terminfo.c delete mode 100644 src/toolbar-msw.c delete mode 100644 src/toolbar-x.c delete mode 100644 src/toolbar.c delete mode 100644 src/toolbar.h delete mode 100644 src/tooltalk.c delete mode 100644 src/tooltalk.doc delete mode 100644 src/tooltalk.h delete mode 100644 src/tparam.c delete mode 100644 src/undo.c delete mode 100644 src/unexaix.c delete mode 100644 src/unexalpha.c delete mode 100644 src/unexcw.c delete mode 100644 src/unexec.c delete mode 100644 src/unexelf.c delete mode 100644 src/unexelfsgi.c delete mode 100644 src/unexfreebsd.c delete mode 100644 src/unexhp9k3.c delete mode 100644 src/unexhp9k800.c delete mode 100644 src/unexmips.c delete mode 100644 src/unexnt.c delete mode 100644 src/unexsol2.c delete mode 100644 src/unexsunos4.c delete mode 100644 src/vm-limit.c delete mode 100644 src/widget.c delete mode 100644 src/window.c delete mode 100644 src/window.h delete mode 100644 src/winslots.h delete mode 100644 src/xgccache.c delete mode 100644 src/xgccache.h delete mode 100644 src/xintrinsic.h delete mode 100644 src/xintrinsicp.h delete mode 100644 src/xmmanagerp.h delete mode 100644 src/xmprimitivep.h delete mode 100644 src/xmu.c delete mode 100644 src/xmu.h delete mode 100644 tests/ChangeLog delete mode 100644 tests/DLL/dltest.c delete mode 100644 tests/Dnd/droptest.sh delete mode 100644 tests/automated/byte-compiler-tests.el delete mode 100644 tests/automated/database-tests.el delete mode 100644 tests/automated/hash-table-tests.el delete mode 100644 tests/automated/lisp-tests.el delete mode 100644 tests/automated/md5-tests.el delete mode 100644 tests/automated/test-harness.el delete mode 100644 tests/glyph-test.el delete mode 100644 version.sh diff --git a/CHANGES-beta b/CHANGES-beta deleted file mode 100644 index 4e0c83b..0000000 --- a/CHANGES-beta +++ /dev/null @@ -1,114 +0,0 @@ - -*- indented-text -*- -to 21.2 beta11 "Calliope" --- Dialog box fix from Jan Vroonhof --- unified mswindows and tty event loops from Andy Piper --- miscellaneous patches from Gleb Arshinov --- miscellaneous patches from Charles Waldman and Adrian Aichner --- Mule dump time files remerged from mule-base package --- Documentation fixes from Jan Vroonhof --- 24bit color image fix from Kazuo OISHI --- various build fixes from Martin Buchholz - -to 21.2 beta10 "Boreas" --- package UI fix from Jan Vroonhof --- MS Windows NT process fix from Gleb Arshinov - -to 21.2 beta9 "Athena" --- parameterize replace-match function from Didier Verna --- X-Face support under mswindows from Andy Piper --- doc fixes from Adrian Aichner --- about patchlet from Marcus Thiessel --- isearch doc fixes from Didier Verna --- interlaced gif fix from Gunnar Evermann --- isearch improvements from Didier Verna --- eldap connection fix from William Perry --- package-get site fix from Robert Pluim --- loadable modules fix from Damon Lipparelli --- ldap fixes from Oscar Figueiredo --- loadable modules from J. Kean Johnston --- runwhatever from Charles Wilson --- redisplay fixes for glyphs from Andy Piper --- progress gauge widgets implentation from Andy Piper --- W3 works again due to font.el being fixed --- Another mule xemacs crash fixed --- Images in widgets, warning fixes and gui_item cleanup from Andy Piper --- package admin fixes under mswindows from Charles Waldman --- miscellaneous mswindows build fixes from Jonathan Harris --- help-echo fix from Hrvoje Niksic --- x font path support from Jim Radford --- MSVC compile fixes from Damon Lipparelli - -to 21.2 beta8 "Artemis" --- A bunch of Mule fixes from Martin Buchholz - -to 21.2 beta7 "Ares" --- mswindows modeline crash fix from Jonathan Harris --- picon glyph fix from Gunnar Evermann --- widgets-in-buffers and subwindow support from Andy Piper --- movemail pop support under mswindows from Fabrice Popineau --- ldap fixes from Oscar Figueiredo --- fns cleanup from Hrvoje Niksic --- menubar fixes from Didier Verna --- mswindows accelerator fix from Jonathan Harris --- dired mule fix from Didier Verna --- sound doc cleanup from Charles Waldman --- new display table functionality from Hrvoje Niksic --- minor cleanups --- package fixes from Jan Vroonhof --- subwindow support fixes from Martin Buchholz - -to 21.2 beta6 "Apollo" --- mswindows compile fixes from Martin Buchholz, Andy Piper, Greg - Klanderman and Adrian Aichner --- Synch with XEmacs 21.0.60 --- mega-patch fixes from Martin Buchholz --- md5 fixes and testsuite from Hrvoje Niksic --- database fix from Hrvoje Niksic - -to 21.2 beta5 "Aphrodite" --- synch with XEmacs 21.0.58 --- bytecode interpreter rewritten --- byte compiler fixes --- hash table implementation rewritten --- basic lisp functions rewritten --- spelling fixes --- garbage collector tuned a little --- various global code changes for consistency --- automated test suite --- major internals manual updates --- lisp reference updates - -to 21.2 beta4 "Aglaophonos" --- isearch keymap fix from Katsumi Yamaoka --- directory_files cleanup from Hrvoje Niksic --- C implementation of base64 from Hrvoje Niksic --- C implementation of `buffer-substring-no-properties' from Hrvoje Niksic --- Experimental fix for spurious `file has changed on disk' message from - Charles Waldman --- Fix for etags.el hook calling from Malcolm Box --- User-name-completion fix for MS Windows NT from Greg Klanderman - -to 21.2 beta3 "Aglaia" --- case sensitiveness improvements from Didier Verna --- Bug fixes from 21.0 --- Word selection on mouse click on quotes from Hrvoje Niksic --- WAVE support for NAS from Raymond Toy - -to 21.2 beta2 "Aether" --- Synched with 21.0-pre14 "Poitou" --- isearch improvements from Hrvoje Niksic --- bytecompiler fix from Martin Buccholz --- shadow.el speedup from Martin Buchholz --- clash detection update from Jan Vroonhof --- Indirect buffers from Hrvoje Niksic --- ~user completion cleanup from Greg Klanderman --- New face property from Didier Verna --- ~user completion and fixes from Greg Klanderman --- casefiddle.c speedup from Martin Buchholz - -to 21.2 beta1 "Aeolus" --- Synch with 21.0-pre6 --- Removal of ancient obsolete symbols courtesy of Altrasoft --- Fix version numbers - -Fork at 21.0 pre5 "Zhong Wei" diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 index d840e5b..0000000 --- a/ChangeLog +++ /dev/null @@ -1,3378 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-16 Andy Piper - - * PROBLEMS: add entries for building under Cygwin. - -1999-02-14 Jan Vroonhof - - * README.packages: Clear up that mule-sumo packages is used _in - addition_ to the normal sumo. - -1999-02-16 Martin Buchholz - - * configure.usage: Move quantify/purify into debug flags section - -1999-02-10 Martin Buchholz - - * configure.in: - - Fixup xfs comments and redundant option checking - - * configure.in: - * INSTALL: - * lisp/paths.el: - - improved automounter tmp directory support. - - support 4 (!) empirically discovered automounter conventions - -1999-02-10 Martin Buchholz - - * lwlib/lwlib.h: - - redo CONST hacking to deal with X11 R4, which was - broken in a previous patch. - -1999-02-10 Martin Buchholz - - * configure.in: - - irix uses -rpath - -1999-02-10 Martin Buchholz - - * configure.in: - - Check for XOpenIM before using xim=xlib - - only use XmIm if $have_motif = yes - -1999-02-10 Martin Buchholz - - * configure.in. Port to BSDI BSD/OS 4.0. - -1999-01-07 Michael Sperber [Mr. Preprocessor] - - * configure.in: Warn if using Motif dialog boxes on AIX 4.3. - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-02-01 Glynn Clements - - * etc/recycle.xpm: Fix colours so that they work on TrueColor - and DirectColor displays - -1999-01-21 Andy Piper - - * configure.in: make xface detection specifc to a window system in - general rather than just X. - -1999-18-10 Andy Piper - - * configure.in: remove -O3 prevention on cygwin - current versions - cope ok now. remove dll prevention on cygwin - the new module - code checks correctly. - -1999-01-10 J. Kean Johnston - - * configure.in: Added moduledir as the path where loadable modules - are stored. Added --with-site-modules and --moduledir options. - - Ensure the SCO OpenServer compiles with --dynamic by default - - Check for dlfcn.h for dynamic loader - - Renamed dll.o to emodules.o and changed dynamic loader tests - - Renabled code that deals with site-lisp so that it is handled - correctly when a user specifies --with-site-lisp. - - * aclocal.m4: Replaced entire file with more complete DLL tests - by way of libtool. - - * config.usage: Removed TAB characters which caused it to be - displayed incorrectly on terminals where TAB != 8. - - Added help text to describe --with-site-modules and --moduledir. - - * INSTALL: Updated documentation to describe module directories - - * Makefile.in.in: Added moduledir, sitemoduledir macros. - - Make those directories at install time. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-28 Martin Buchholz - - * PROBLEMS: Document Linux GNU Libc 2.0 I18N crashes. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-20 Martin Buchholz - - * configure.in: Redo DBM support - - die if dbm support requested, but not provided. - - properly check for libgdbm, then libc, then libdbm - - properly check for ndbm.h - - comments improved - - XE_DIE should always prefix messages with Error: for clarity - -1998-12-07 Martin Buchholz - - * xemacs.mak (TEMACS_OBJS): - (DOC_SRC4): - - Remove pure.c, pure.obj - -1998-12-06 Martin Buchholz - - * Makefile.in.in (distclean): - * dynodump/Makefile.in.in (distclean): - * src/Makefile.in.in (distclean): - * lib-src/Makefile.in.in (distclean): - * lwlib/Makefile.in.in (distclean): - - Make sure GNUmakefile is deleted. - -1998-12-17 Andy Piper - - * configure.in (all_widgets): remove gui.o addition - its always - in the makefile now. - - * configure.in: add gui-msw.o to msw objects. - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-11-27 SL Baur - - * configure.in: Linux/Arm Support. - From James LewisMoss - -1998-11-27 Takeshi Hagiwara - - * configure.in: - Fix the realpath() problem of UnixWare2.1.3. - Patches for NEC's sysv4.2 machine. - -1998-11-09 Kazuyuki IENAGA - - * configure.in: Check if there's wnn4.2 or wnn6 specific library - installed. The Wnn library will be checked if the --with-wnn - and/or --with-wnn6 was specified compulsory. - -1998-07-28 Jan Vroonhof - - * configure.in (CPP): Too many spaces im run-patch flag detection. - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-10-13 Andy Piper - - * configure.in: enable drag and drop support by default if mswindows is - detected. - -1998-10-09 Kevin Oberman - - * config.sub: Fix for Alpha architecture - -1998-10-05 Andy Piper - - * configure.in: don't enable shared lib support for cygwin unless - explititly told to. - -1998-10-02 Andreas Jaeger - - * etc/xemacs.1: Remove misplace "\". - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-09-09 Gunnar Evermann - - * lwlib/xlwmenu.c: - * lwlib/xlwscrollbar: fix for Motif >=2.0 - Patch provided by Glenn Barry - - * PROBLEMS: XEmacs 21.0 now works on HP-UX 11.0 - -1998-09-02 Andy Piper - - * configure.in: check for cygwin32/version.h. - -1998-08-31 Michael Sperber [Mr. Preprocessor] - - * PROBLEMS: Added AIX 4.3 note. - - * configure.in: Better detection of AIX 4.3. - AIX xlc can do -g and -Ox at the same time. - -1998-09-05 SL Baur - - * etc/check_cygwin_setup.sh: grammar fix. - -1998-09-02 Andy Piper - - * etc/check_cygwin_setup.sh: fix a couple of buglets. - -1998-08-23 Adrian Aichner - - * etc/sample.emacs: Enable sound support on mswindows devices. - -1998-08-17 P. E. Jareth Hein - - * configure.in: Alter configure so that it checks for mismatched PNG - header/libs, screams a little louder on old/mismatched library - conditions for both PNG and XPM, stop screaming if png is not found and - no window-system is selected, and fixed a bug in the XPM checking. - -1998-08-06 Adrian Aichner - - * etc/TUTORIAL.de: Fixing typos and grammatical errors. Fixing - inconsistent usage of RET, , and (only using - now). Changing TUTORIAL to TUTORIAL.de throughout - itself. Adding english equivalent to german translation of all - concepts used in TUTORIAL.de. - -1998-08-07 P. E. Jareth Hein - - * configure.usage (--without-gif): Modify text to reflect status - of GIF support - -1998-08-04 P. E. Jareth Hein - - * configure.in: add back in the support for the in-core GIF - code, change the required PNG library version to 1.0.2, and add - a warning if PNG not found, since PNG images are now distributed - as part of the core. Also minor wording changes in things reported - to the user. - -1998-07-28 Kai Haberzettl - - * BETA: Update mailing-list address for build-reports - -1998-08-01 SL Baur - - * Makefile.in (TAGS tags): Add variable `tagslisp' so a TAGS file - can built that includes package lisp. - -1998-07-23 Martin Buchholz - - * configure.in: - - support multiple flavors of alpha, (XEmacs treats them identically) - - Fix AC_TRY_RUN so that actions have access to $? - - Identify DEC C compilers. Add default optimization CFLAGS and - always use -std. - - Use an extensible method for adding support for future compilers. - - Have SunPro C use that same extensible method. - - Make sol2 always use `-R', Linux and DEC OSF always use `-rpath' - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-18 SL Baur - - * config.guess: Synched with latest FSF version. - -1998-07-12 Björn Torkelsson - - * Makefile.in: added LDFLAGS. - -1998-07-12 SL Baur - - * etc/GOATS: Removed. - - * README: Bump version numbers. - * info/dir: Ditto. - * etc/README: Ditto. - * etc/NEWS: Ditto and purge pre-21.0 stuff. - * version.sh: Ditto. - - * XEmacs 21.0-pre5 is released. - -1998-07-10 SL Baur - - * configure.in (with_offix): Default --with-offix to off. - -1998-07-09 SL Baur - - * configure.in: Handle multiple database libraries. - From Gregory Neil Shapiro - - * XEmacs 21.0-pre4 is released. - - * configure.in: Fix test for InfoDock sources. - - * etc/BETA (writing): Update patch creation instructions. - - * etc/FTP: Update FTP mirror list. - - * etc/DISTRIB: Remove duplicated FTP mirror list. - * etc/xemacs.1 (ftp): Ditto. - -1998-07-09 Oliver Graf - - * configure.usage: added warning to --with-offix - -1998-06-29 SL Baur - - * etc/gnuserv.1 (this): Email address for Ben Wing is ben@xemacs.org. - * etc/gnuserv.README (README): Ditto. - * etc/xemacs-ja.1: Ditto. - -1998-06-28 SL Baur - - * configure.in: Berkeley DB autodetection fixes - From Martin Buchholz - - * etc/BABYL: Moved to rmail package - - * etc/enriched.doc: Moved to xemacs-base package - - * etc/MSDOS: - * etc/GNUS-NEWS: deleted - -1998-06-21 Michael Sperber [Mr. Preprocessor] - - * etc/NEWS: Added references to documentation about packages and - path setup. - - * etc/README: Synched. - -1998-06-19 SL Baur - - * XEmacs 21.0-pre3 is released. - -1998-06-20 Michael Sperber [Mr. Preprocessor] - - * etc/PACKAGES: - * etc/BETA: Moved some package stuff into Texinfo docs. Other nitpicks - -1998-06-20 Kazuyuki IENAGA - - * configure.in: Added check if the berkdb has db_open or not. - (With fixes from Martin Buchholz) - -1998-06-19 SL Baur - - * XEmacs 21.0-pre2 is released. - -1998-06-18 Michael Sperber [Mr. Preprocessor] - - * configure.in: Added -lC for static linking under AIX 4.2. - -1998-06-14 SL Baur - - * XEmacs 21.0-pre1 is released. - -1998-06-14 Oscar Figueiredo - - * etc/NEWS: Updated information about customization of the - automatic info dir file generation using - `Info-auto-generate-directory' and `Info-save-auto-generated-dir' - -1998-06-11 SL Baur - - * XEmacs 21.0-beta43 is released. - -1998-06-04 Oliver Graf - - * tests/Dnd/README: a step-by-step test run - * tests/Dnd/droptest.el: some clarifications - * tests/Dnd/droptest.sh: created, creates test files - -1998-06-01 Oliver Graf - - * configure.in (summary): added experimental to dragndrop option - * configure.usage: added experimental note to --with-dragndrop - * tests/Dnd/droptest.el: extra start-drag-region function - changed the experimental- stuff - -1998-06-02 Andy Piper - - * etc/check_cygwin_setup.sh: set more intelligent defaults for - windows 95. - -1998-06-07 SL Baur - - * lwlib/xlwmenu.c: Add room for the 0 byte sentinel. - -1998-06-05 Colin Rafferty - - * lwlib/xlwmenu.c: Made newchars be as large as it needs to be. - -1998-06-01 SL Baur - - * XEmacs 21.0-beta42 is released. - - * etc/sounds: Removed, now in the sounds-au package. - -1998-05-29 Andy Piper - - * configure.in: don't use -O3 for cygwin. - - * etc/check_cygwin_setup.sh: new file to check that cygwin is setup - correctly for XEmacs operation. - -1998-05-28 P. E. Jareth Hein - - * configure.in: Switch from giflib to gifreader for - our GIF image support (no other mods needed) - -1998-05-28 Oliver Graf - - * configure.in: only one DnD protocol, CDE has priority over OffiX - - * tests/Dnd/README: some changes reflecting recent modifications - * tests/Dnd/dragtest.el: removed - * tests/Dnd/droptest.el: cosmetics and comments - -1998-05-26 Oliver Graf - - * tests/Dnd/droptest.el: adapted to CDE extensions - -1998-05-25 Hans Guenter Weigand - - * configure.in: - * config.sub: add initial OpenBSD support - -1998-05-21 Andy Piper - - * configure.in: check for msw dialogs. - -1998-05-23 SL Baur - - * XEmacs 21.0-beta41 is released. - -1998-05-17 SL Baur - - * configure.in (CPP): Change -O2 to -O3. - Suggested by Martin Buchholz - -1998-05-15 SL Baur - - * XEmacs 21.0-beta40 is released. - -1998-05-13 SL Baur - - * configure.in (ZSH_VERSION): zsh-3.1.2 (and zsh-3.0.4) drops core - on the `unset CDPATH' if running as sh. - -1998-05-12 Oliver Graf - - * tests/Dnd/droptest.el: some CDE adaptions (untested) - -1998-05-11 Martin Buchholz - - * configure.in: - Add some more comments. - If using bash, use Posix mode and unset CDPATH. - Be more careful checking feature dependencies. - Introduce XE_CHECK_FEATURE_DEPENDENCY. - Undo the gross hack of multiple `echo >> $tempcname' - by using here documents instead. (Might break mswindows, tho...) - Be more careful autodetecting tooltalk. - - * PROBLEMS: - Document problems with Solaris 2.6 + XSUNTRANSPORT - - * Makefile.in: - * lwlib/Makefile.in.in: - * modules/Makefile.in: - - Adjust for luser's CDPATH being set to something weird. - - Take into account bash 2.02's tendency to print the cwd when - using CDPATH. Always use `cd ./foo' instead of `cd foo'. - - fix the run-temacs target to use $(DUMPENV) - - fix the run-puremacs target to use $(DUMPENV) - - fix the `depend' target to properly $(RM) the right files - - Generate a better TAGS file for XEmacs' lisp code using - hand-crafted regexps. - - Use standard coding conventions for modules/Makefile.in - -1998-05-12 Kazuyuki IENAGA - - * configure.in: some people claimed that they can't stop - linking wnn6 library if they set --with-wnn6=no. - -1998-05-11 Oliver Graf - - * tests/Dnd/droptest.el: adapted to new calling conventions - also showing the new possibilities - * tests/Dnd/README: changed to new protocol - -1998-05-11 SAKIYAMA Nobuo - - * Fix for HAVE_MULTICAST check. - -1998-05-09 SL Baur - - * XEmacs 21.0-beta39 is released. - -1998-05-06 Oliver Graf - - * configure.in: added autodetection for the Drag'n'Drop API - if some DnD protocol is found, HAVE_DRAGNDROP will be defined - and dragdrop.o is added to extra_objs - * configure.usage: added with-dragndrop, added (*) to with-offix - * tests/Dnd/droptest.el: complete overhaul, no it's a real test - -1998-05-04 Oliver Graf - - * tests/Dnd/droptest.el: changed to test new protocol - * tests/Dnd/README.OffiX: removed - * tests/Dnd/README: created, info about new protocol - * tests/Dnd/dragtest.el: comment change - -1998-05-07 SL Baur - - * etc/altrasoft-logo.xpm: Removed. - -1998-05-02 SL Baur - - * XEmacs 21.0-beta38 is released. - -1998-04-29 SL Baur - - * configure.in: Use `PROGNAME' for all generated paths. - - * Makefile.in: Change `progname' to `PROGNAME' for consistency. - -1998-04-27 SL Baur - - * configure.in (progname): Parameterize program name on `progname' - and add --with-infodock. - -1998-04-26 SL Baur - - * Makefile.in: Religiously use ${progname} instead of hardcoded - `xemacs'. - CPPFLAGS was being set correctly in ${subdir}/Makefiles and - overridden by the empty one set in the toplevel Makefile. - -1998-04-26 Jason R Mastaler - - * etc/BETA: Replaced SmartList references in favor of - Majordomo. - -1998-04-25 SL Baur - - * XEmacs-21.0-beta37 is released. - -1998-04-25 Michael Sperber [Mr. Preprocessor] - - * configure.in: Sychronized ..._USER_DEFINED variables with - datadir setting. - - * Makefile.in (mkdir): No longer create sitelispdir. - -Sat Apr 24 1998 Andy Piper - - * configure.in: make graphic libraries tests be dependant on a - window system not X11 only. - -Fri Apr 24 19:38:19 1998 Andy Piper - - * configure.in: check for our special select in msw. - -1998-04-22 Marcus Thiessel - - * PROBLEMS: add answers to some FAQ concerning hpux. - -Wed Apr 22 12:59:35 1998 Andy Piper - - * configure.in: enable checking for special mswindows select() - -1998-04-21 Martin Buchholz - - * configure.in: Isolate incomprehensible cma_open/pthreads checking - to decosf* - -1998-04-21 Marcus Thiessel - - * configure.in: /usr/{include,lib}/Motif2.1 added to search path for X11 - libs and includes. - -1998-04-22 Itay Ben-Yaacov - - * configure.in: check for xpm does not depend anymore on having X. - if libXpm exists, and is of the FOR_MSW flavor, define FOR_MSW. - -1998-04-19 Oscar Figueiredo - - * etc/NEWS: Documented info dir rebuilding and LDAP support. - - * info/dir: Fixed the explanatory notes for - `Info-default-directory-list' removal and the new automatic dir - rebuilding facility. Reindented the menu. Added an entry for - term.info - -1998-04-20 SL Baur - - * configure.in (LISPDIR): Removed configuration option for - site-lisp. - -1998-04-19 SL Baur - - * configure.in (version): snarf InfoDock version number. - -1998-04-18 SL Baur - - * XEmacs-21.0-beta36 is released. - -Fri Apr 17 12:59:35 1998 Andy Piper - - * configure.in: enable install pre-processing for mswindows - -Fri Apr 17 12:59:35 1998 Andy Piper - - * Makefile.in.in: add install_pp to install incantation. - - * installexe.sh: new file. Add .exe to install targets if the - result is executable. - -Fri Apr 17 12:59:35 1998 Andy Piper - - * Makefile.in: add install_pp to install incantation. - -1998-04-14 Itay Ben-Yaacov - - * configure.in: Large echo split into a few smaller ones, - so the cygnus sh.exe does not crash. - -Thu Apr 16 12:59:35 1998 Andy Piper - - * configure.in: enable toolbar checking for mswindows build - -1998-04-06 Martin Buchholz - - * config.h.in: Add _SVID_SOURCE to list of xmkmf #defines. - Used (at least) by RedHat 4.2. - -1998-04-11 Michael Sperber [Mr. Preprocessor] - - * etc/xemacs.1: -no-packages -> -no-early-packages. - - * etc/NEWS: Clarified site-lisp status. - - * configure.in: Re-instated src/paths.h generation from - src/paths.h.in. - - * Makefile.in (top_distclean): Remove site-lisp on `make - distclean'. - -1998-04-10 SL Baur - - * XEmacs 21.0-beta35 is released. - -1998-04-10 Michael Sperber [Mr. Preprocessor] - - * etc/NEWS: Documented that Info-default-directory-list and - site-directory are gone. - - * configure.usage: Clarified --package-path documentation. - -1998-04-07 Michael Sperber [Mr. Preprocessor] - - * configure.in: Now generates src/paths.h from src/paths.h.in.in. - Removed defaults for infopath and package-path. - - * Makefile.in (src/paths.h): ... is now generated from - src/paths.h.in.in. Moved generation of paths.h to configure. - - * paths.h.in: Removed. - - * paths.h.in.in: Created. - -1998-04-06 Martin Buchholz - - * configure.in: png was still being used if png_version < 0.96 - - * configure.in: Fixed magic to handle AIX, X11R6, and gcc. - -1998-04-05 Amir J. Katz - - * INSTALL (Rationale): Offix support comment is wrong. To disable, - one must use --with-offix=no and not --without-offix - -1998-04-05 SL Baur - - * configure.in (CPP): ppc.ldscript sits in $srcdir/src not $srcdir. - -1998-04-04 SL Baur - - * XEmacs 21.0-beta34 is released. - -1998-04-03 Martin Buchholz - - * configure.in: - checking whether gettimeofday accepts one or two arguments... two - -1998-04-03 Michael Sperber [Mr. Preprocessor] - - * configure.in: Fixed magic to handle AIX and MIT X11R6. - -1998-04-02 Martin Buchholz - - * configure.in: Add magic -T $srcdir/ppc.ldscript on Linux powerpc - -1998-04-01 Martin Buchholz - - * tests/database.el (test-database): Temporary files (the databases - that were created) should be deleted. - - * Makefile.in (testdir): Remove gnumake-specific syntax. - (src/Makefile): src/Makefile depends on src/depend. - -1998-03-29 Martin Buchholz - - * configure.in: Check for -lz, -lgz unconditionally. Too many - system linkers don't properly die when there are cascaded link - dependencies, so we can't rely on the linker for that. The only - downside is that we might link with an extra unneeded library. If - you really really care about this, you can go fix it. - - * configure.in: Enhance PANIC msg to make it clear that - --with-FEATURE is going to die if FEATURE is not installed. - -1998-03-27 Martin Buchholz - - * configure.in: $debug was not properly dependent on $beta - - * configure.in: Move offix configuration out of src/Makefile.in.in - into configure.in. - - * configure.in: Reorganize xpm detection code. - - * configure.in: XIM default to ON if Motif which is not Lesstif is - found. - - * configure.in: Keep auto-generated makefile dependencies out of - src/Makefile.in.in by using AC_OUTPUT file concatenation support. - -1998-03-26 Martin Buchholz - - * configure.in: Fix up cflags handling. Specifically, configure - --cflags='' would fail to be recognized. - - * configure.in: Fix up png detection. Link with png_read_image to - make sure -lz is required. Test for png >- 0.96 via header file. - -1998-03-21 Martin Buchholz - - * configure.in (XE_GCC_WRAP_LDFLAGS) - Rename to XE_PROTECT_LINKER_FLAGS. Rewrite. - - * configure.in: Make sure BSD always links in libz.a - BSD's stupid linker can't detect cascaded lib dependencies - - * configure.in: Autodetect lesstif. define have_lesstif. - Don't use motif-xim with lesstif, at least by default. - -1998-03-30 SL Baur - - * version.sh: Add InfoDock version number variables. - -1998-03-30 Amir J. Katz - - * info/dir: Replaced string '20.5' with '21.0' - -1998-03-24 SL Baur - - * XEmacs 21.0-beta33 is released. - -1998-03-26 Didier Verna - - * configure.in, Makefile.in: Removed infopath_user_defined---we - always want to propagate it. - - * configure.usage: Synched with configure.in. - -1998-03-25 Michael Sperber [Mr. Preprocessor] - - * configure.usage, INSTALL: Synched with the new path layout. - - * Makefile.in (src/paths.h): Replaced packagepath with - package_path to make configure happy. - - * configure.in: Made default setting for packagepath conform to - what packages.el builds at run-time: XEmacs-version-specific paths - before site-specific ones. - Added default setting for pkgdir. - Changed --packagepath back to --package-path. - -1998-03-24 SL Baur - - * XEmacs 21.0-beta32 is released. - -1998-03-23 Michael Sperber [Mr. Preprocessor] - - * configure.in: Extended package path by version-specific - hierarchies. Changed allow-site-lisp to inhibit-site-lisp. - -1998-03-22 SL Baur - - * Makefile.in (distclean): Remove packages and mule-packages if they - have been linked into place. - -1998-03-22 Michael Sperber [Mr. Preprocessor] - - * : The Big Path Searching Overhaul. - - * Makefile.in, configure.in: Now pass all configure-specified paths - into the binary in a uniform way. - -1998-03-20 SL Baur - - * configure.in (have_libmcheck): Add test for glibc's malloc - checker. - - Fix HP/UX dynamic linking flag. - -1998-03-19 SL Baur - - * configure.in (quoted_arguments): Fix unquoted variable in - error-checking test. - - fix bogus substitution. - -1998-03-17 SL Baur - - * configure.in: In -lpng test, look for png_set_strip_alpha. - Suggested by William M. Perry - -1998-03-16 SL Baur - - * XEmacs 21.0 beta31 is released. - -1998-03-16 P. E. Jareth Hein - - * configure.usage (Usage): Correct information about gif, tiff - and WNN entries - -1998-03-13 SL Baur - - * configure.in: typo fix in sed command. - From P. E. Jareth Hein - - * configure.in (all_widgets): Check for snprintf(). - -1998-03-11 P. E. Jareth Hein - - * configure.in: New gif support - -1998-03-10 SL Baur - - * configure.in (have_glibc): Don't define _GNU_SOURCE for glibc. - -Mon Mar 09 13:00:55 1998 Andy Piper - - * configure.in: don't add libc to link list for dlopen ordinary - link takes care of this. check for dlfcn.h - -1998-03-10 SL Baur - - * configure.in: Examine each directory of X11 include path for - inclusion into BITMAPDIR. - -1998-03-09 SL Baur - - * aclocal.m4: Add legalese. - -Mon Mar 09 13:00:55 1998 Andy Piper - - * configure.in: make sure we have ndbm.h as well as libgdbm.a for - database support. - - * configure.in: move msw checking after x checking so that - auto-detection works. - -1998-03-09 SL Baur - - * configure.in: New DLL support. - * aclocal.m4: New file. - From William M. Perry - -1998-03-08 SL Baur - - * configure.in (xemacs_betaname): Align messages for minimal - tagbits and indexed lrecords. - Suggested by Andreas Jaeger - -1998-03-09 Kyle Jones - - * etc/Emacs.ad: Example using leading dot resources to - initalize faces changes to use Emacs.foo since the - leading dot syntax doesn't work. Initialization of - text-cursor face moved to faces.el. - -1998-03-07 SL Baur - - * XEmacs 20.5-beta30 is released. - -1998-03-05 SL Baur - - * PROBLEMS: Update wording of x86 GCC 2.7 problems. - -Wed Mar 04 08:55:12 1998 Andy Piper - - * configure.in: add a --with-msw option. Make X and msw work - together if the user asks. - -1998-03-02 SL Baur - - * PROBLEMS: Update documentation of gcc bugs that impact XEmacs. - -1998-03-01 SL Baur - - * configure.in: Add substitutable variable ld_dynamic_link_flags - for special required linker flags for building DLL capable - binaries. - - * etc/Emacs.ad: Remove explicit `Emacs' application resource - name. - -1998-02-28 SL Baur - - * Makefile.in (top_distclean): Remove Installation.el. - (xemacs): New target. Formerly it was `all:'. - (all): New default, dist: is now superfluous. - -1998-02-27 SL Baur - - * configure.in (GNU_MALLOC): add --with-dlmalloc to allow - selective use of Doug Lea malloc in Linux C Library and GNU C Library. - (Installation): Add XEmacs version and generate `Installation.el'. - -1998-02-26 SL Baur - - * configure.in (with_ldap: Fix -lldap autodection. - Suggested by Oscar Figueiredo - (Installation): Only keep the last configuration. - -1998-02-25 SL Baur - - * XEmacs 20.5-beta28 is released. - - * configure.in (with_session): Fix reporting of the setting. - (with_database_gnudbm): Correctly report setting. - -1998-02-24 SL Baur - - * configure.usage: Restore documentation of graphics library - flags. - From Karl M. Hegbloom - -1998-02-19 Karl M. Hegbloom - - * PROBLEMS: Tell of the `gpm' SIGTSTP bug and `C-z' on the Linux - console. - -1998-02-23 SL Baur - - * XEmacs 20.4 is released to the beta testers. - -1998-02-21 SL Baur - - * configure.in (after_morecore_hook_exists): Modify dlmalloc tests - to also test for Linux libc5. - -1998-02-19 SL Baur - - * XEmacs 20.5-beta27 is released. - * XEmacs-20.4-pre4 is released. - - * configure.in (doug_lea_malloc): Requires USE_MINIMAL_TAGBITS. - (--with-gung): Implement it. - - * configure.usage (--with-gung): Document. Turns on - USE_MINIMAL_TAGBITS and USE_INDEXED_LRECORD_IMPLEMENTATION. - (--with-term): Remove. - - * XEmacs-20.5-beta26 is released. - -1998-02-18 SL Baur - - * XEmacs-20.4-pre3 is released. - - * Makefile.in: use better feedback while rebuilding finder database. - Suggested by Stephen J. Turnbull - -1998-02-15 SL Baur - - * configure.in (doug_lea_malloc): Add checking for Doug Lea - Malloc. - -1998-02-14 SL Baur - - * configure.in (OFFIX_O): Don't use OffiX if no real Xmu support. - Suggested by Pekka Marjola - - * XEmacs-20.4-pre2 is released. - * XEmacs-20.5-beta25 is released. - -1998-02-13 SL Baur - - * INSTALL: Update for Cygwin and Microsoft Windows. - - * README: Update for Microsoft Windows. - -1998-02-09 SL Baur - - * XEmacs 20.4-pre1 is released. - * XEmacs 20.5-beta24 is released. - -Wed Jan 28 13:41:22 1998 Andy Piper - - * configure.in: add mule-coding target which defines MULE_CODING, - nothing uses it as yet. add gif objects to msw support. define - const_is_losing=no for msw. make msw not selected if tty selected. - add -lshell32 for dnd support. check for a.out.h rather than - coff.h - - * lib-src/make-docfile.c: add cygwin support and generalise the - remaining open calls. IMHO this should really include sysfile.h. - -1998-02-03 SL Baur - - * XEmacs 20.5-beta23 is released. - -1998-02-01 SL Baur - - * etc/aliases.ksh: igrep from the shell command line. - From Karl M. Hegbloom - -1998-01-31 SL Baur - - * etc/aliases.ksh: Add `mak' function to create beta.err for - build-report. - From Adrian Aichner - Suggested by Karl M. Hegbloom - -1998-01-27 SL Baur - - * XEmacs 20.5-beta22 is released. - -1998-01-26 SL Baur - - * etc/aliases.ksh: New file. Start tracking useful Maintainer - XEmacs commands. - -1998-01-25 SL Baur - - * XEmacs 20.5-beta21 is released. - -Wed Jan 21 10:49:47 1998 Andy Piper - - * configure.in: check for coff.h - -1998-01-21 Hrvoje Niksic - - * configure.in: Added support for `--with-shlib'. - -1998-01-18 SL Baur - - * XEmacs 20.5-beta20 is released. - -1998-01-13 Martin Buchholz - - * configure.usage: - * etc/NEWS: - Remove doc for configure-time INFOPATH, no longer used. - - * etc/BETA: Update ftp addresses. - * etc/INSTALL: Update ftp addresses. - * etc/MAILINGLISTS: Sync with Emacs 20.2. Update ftp addresses. - - * configure.in: - * src/config.h.in: - Define HAVE_INVERSE_HYPERBOLIC using 1 configure test, not 3. - - * lwlib/lwlib.h: - * lwlib/lwlib.c: - * lwlib/lwlib-config.c: - * lwlib/lwlib-Xm.c: - * lwlib/lwlib-Xaw.c: - * lwlib/lwlib-Xlw.c: - * lwlib/config.h.in: - * src/menubar-x.c: - Prepend LWLIB_ to (SCROLLBARS|MENUBARS|DIALOGS)_(MOTIF|LUCID|ATHENA). - Maintain only one set of variables. - - * etc/xemacs.1: Update author list. - - * Makefile.in (install-arch-dep): Simplify. - Replace construct `test -d $dir && foo' with - `if test -d $dir; then foo; fi' - - * lwlib/xlwmenu.c: - * lwlib/xlwscrollbar.c: - * lwlib/lwlib-Xlw.c: - * lwlib/lwlib-Xm.c: - Always assume presence of limits.h (ANSI). - -1998-01-12 SL Baur - - * INSTALL: Updated for recent Mule/package changes. - - * XEmacs 20.5-beta19 is released. - -1998-01-12 Damon Lipparelli - - * Makefile.in: Yow! Fixed paths to install dirs when --prefix != - --exec-prefix. - -1998-01-10 SL Baur - - * XEmacs 20.5-beta18 is released. - - * etc/FTP: Update address of what was formerly ftp.ibp.fr. - -1998-01-08 Didier Verna - - * configure.in: Get rid of INFOPATH for configure time. - * configure.usage (Usage): Ditto. - -1998-01-09 SL Baur - - * Makefine.in: Correct reported amount of disk savings from - compression. - From Markus Linnala - -Thu Jan 08 09:42:36 1998 - - * configure.in: detect and set scrollbars and menubars with - MS-Windows more appropriately. Check for sys/un.h to use in - gnuserv. - -1998-01-07 SL Baur - - * Makefile.in (progname): Cleanly parameterize XEmacs-specific - naming. - -1998-01-05 Glynn Clements - - * lwlib/xlwmenu.c (push_button_draw): use inactive_gc instead of - inactive_button_gc for menu entries. - (remap_menubar): ignore the enabled status - -1998-01-04 SL Baur - - * XEmacs 20.5-beta17 is released. - - * Makefile.in (finder): Use -vanilla. - (lisp/finder-inf.el): Ditto. - (check-features): New target. Do a sanity check prior to - installation. - -1997-01-03 SL Baur - - * XEmacs 20.5-beta16 is released. - -1997-12-30 SL Baur - - * XEmacs 20.5-beta15 is released. - -1997-12-29 SL Baur - - * Makefile.in (${SUBDIR}): Remove bogus .RECURSIVE dependency. - -1997-12-27 SL Baur - - * XEmacs 20.5-beta14 is released. - -1997-12-23 Andy Piper - - * configure.in: support for *-pc-cygwin32 config - -1997-12-25 SL Baur - - * XEmacs 20.5-beta13 is released. - -1997-12-21 SL Baur - - * etc/BETA (Prerequisite): Add cookbook procedures for maintaining - package lisp directories. - -1997-12-20 SL Baur - - * XEmacs 20.5-beta 12 is released. - -1997-12-19 SL Baur - - * configure.in (bitmapdir): Reenable --with-session by default for - testing. - -1997-12-18 Kyle Jones - - * etc/Emacs.ad: Don't specify a default toolbar specific - background color. - -1997-12-18 Kyle Jones - - * etc/toolbar: Added support for foregroundToolBarColor - symbol to most icons. - -1997-12-17 SL Baur - - * info/dir (File): Skk and Gnats are packaged. - - * PROBLEMS (Note): Update version numbers. - - * etc/BETA: Update version numbers. - - * etc/NEWS: Update version number. - - * info/dir (File): Update version number. - -1997-12-16 SL Baur - - * XEmacs 20.5-beta11 is released. - -1997-12-14 SL Baur - - * configure.in: Don't bypass graphics library detection - if the `--with-imagick' option is given to configure. - : Print autodetected graphics libraries to be linked with Imagick. - - * Makefile.in (lisp/finder-inf.el): Reverse previous change. - -1997-12-14 Olivier Galibert - - * Makefile.in (install-arch-indep): Build info files if needed. - -1997-12-13 SL Baur - - * Makefile.in (lisp/finder-inf.el): Add dependency on src/. - - * XEmacs 20.5-beta10 is released. - -1997-12-12 SL Baur - - * configure.in (CPP): Don't add special CFLAGS for ix86/Linux. - -1997-12-10 Karl M. Hegbloom - - * configure.in (autodetect ImageMagick): also look for - "X11/magick/magick.h", and if present, define - MAGICK_HEADERS_ARE_UNDER_X11 - -1997-12-11 SL Baur - - * configure.in (imagick_libs): Add autodetection for freetype - -lttf library. - -1997-12-09 SL Baur - - * XEmacs 20.5-beta9 is released. - -1997-12-06 SL Baur - - * XEmacs 20.5-beta8 is released. - - * info/dir: update for further packaging. - * configure.in: remove `tree-x' from XEmacs build. - -1997-11-29 Jeff Miller - - * configure.in: motif menubars need xlwmenu.o - - * updated files in src/ to allow an XEmacs configured for - motif menubars to at least compile. Motif menubars are still - very broken. - -1997-12-05 Aki Vehtari - - * etc/refcard.tex: Updated for 20.3 - -1997-12-02 P E Jareth Hein - - * lwlib/xlwscrollbar.c: fixed colormap/visual handling to work - properly with the information in the core. - - * lwlib/xlwmenu.c: fixed colormap/visual handling to work properly with - the information in the core, and fixed a potental problem with - parentage. - -1997-12-02 SL Baur - - * etc/skk/SKK.tut.E (Hint): Fix typos. - -1997-12-01 SL Baur - - * configure.in (with_session): Properly display flag in configure - status report. - -1997-11-29 SL Baur - - * configure.usage: Remove documentation of obsolete option - --with-gif. - -1997-11-27 SL Baur - - * XEmacs 20.5-beta7 is released. - - * configure.in: When testing for -ltiff, fall back on the extra - libraries -ljpeg, and -lz since some -ltiff's need them. - -1997-11-26 SL Baur - - * lwlib/xlwmenu.c (display_menu): Defer incremental menus properly. - From Glynn Clements - -1997-11-25 Kazuyuki IENAGA - - * configure.in: Improve auto detect of libraries ImageMagick rely - on. - -1997-11-23 Jeff Miller - - * Energize is dead. Removed ENERGIZE ifdef's from code in lwlib - and src. Configure.in modified. --with-energize is no longer a - valid configure option. - - * lwlib/Makefile.in.in removed energize support - * lwlib/lwlib-Xm.c removed energize support - * lwlib/lwlib-config.c removed energize support - - * lwlib/energize/* removed - -1997-11-23 SL Baur - - * Makefile.in: Change references of lisp/utils/finder-inf.el to - lisp/finder-inf.el. - -1997-11-20 SL Baur - - * XEmacs 20.5-beta6 is released. - -1997-11-21 Stephen Turnbull - - * configure.usage: Use `--' convention in "usage:" line. - -1997-11-20 Stephen Turnbull - - * configure.in: added `with_xfs' to list of boolean features. - -1997-11-20 SL Baur - - * XEmacs 20.3 is released for binary kit building. - -1997-11-19 Tor Arntsen - - * PROBLEMS: Removed IRIX entry about xemacs core dumps when using - xemacs dumped on one machine on another. Problem was fixed by 20.3. - -1997-11-19 SL Baur - - * etc/xemacs.1: Document -no-packages, -vanilla. - Document -h. - -1997-11-18 SL Baur - - * configure.usage: New file. - - * configure.in: Use it instead of monster 10k shell variable. - -1997-11-17 SL Baur - - * XEmacs 20.3-pre4 is released. - -1997-11-17 Jens-Ulrik Holger Petersen - - * configure.in (infopath): List "/usr/local/" dirs before "/usr/" - dirs. - -1997-11-17 SL Baur - - * configure.in: Initialize infodir off of datadir. - - * Makefile.in: Force LANG = C for building. - -1997-11-15 SL Baur - - * XEmacs 20.3-pre3 is released. - * XEmacs 20.5-beta5 is released. - -1997-11-13 Marc Paquette - - * nt/Todo: added a task for support of lisp packages through - the registry. - -1997-11-13 Jonathan Harris - - * Renamed files *w32* to *msw* - - * Changed 'w32' and 'win32' to 'mswindows', and HAVE_W32GUI to - HAVE_MS_WINDOWS. Changed files: - cus-edit.el, device.el, faces.el, frame.el, msw-faces.el, - msw.init.el, igrep.el, dumped-lisp.el, font.el, hippie-exp.el, - sysdep.el, console-msw.c, console-msw.h, console.c, - device-msw.c, emacs.c, event-msw.c, event-msw.h, event-stream.c, - events.c, events.h, faces.c, frame-msw.c, frame.c, general.c, - msw-proc.c, objects-msw.c, objects-msw.h, redisplay-msw.c, - redisplay.c, symsinit.h, - - * Didn't change 'win32' in nt.c, nt.h, ntproc.c - - * Deleted w32 build directory since nt build directory now handles - X and native mswindows builds. - -1997-11-11 SL Baur - - * XEmacs 20.5-beta4 is released. - -1997-11-10 SL Baur - - * info/dir: remove packaged entries. - From Glynn Clements - - * configure.in: Puke and die if NAS sound is selected without X. - -1997-11-08 SL Baur - - * XEmacs 20.5-beta3 is released. - * XEmacs 20.3-pre2 is released. - -Wed November 05 23:40:00 1997 - - * w32/xemacs.mak: moved building the DOC file to after the .elcs. - -Sun November 01 12:00:00 1997 - - * Files split from nt to new w32 directory: - ChangeLog, README, Todo, paths.h, config.h, inc/*, runemacs.c, - xemacs.mak. - -1997-11-05 Didier Verna - - * configure.in: Added the --site-prefixes options for the configure - script. You give a colon or space separated list of prefixes, and - subdirectories include/ and lib/ will be added with -I and -L. - -1997-11-05 Martin Buchholz > - - * configure.in: AIX + gcc fixes. - - Don't wrap -B. aixflags changed to start_flags. - -1997-11-04 SL Baur - - * lwlib/lwlib-Xm.c(update_one_menu_entry): Add missing variable. - From Skip Montanaro - -1997-11-04 Adrian Aichner - - * etc/TUTORIAL.de: - Updated copyright information. Translated most of the COPYING - section. Translated the <<.*>> didactic line. - -1997-10-22 Adrian Aichner - - * etc/TUTORIAL.de: Fixed two issues reported by - Achim Oppelt - - * etc/TUTORIAL.de: - Manually applied rejected patch hunks from Marc Aurel's patch. - Some more fixes. - - * etc/TUTORIAL.de: - Applied patches supplied by Marc Aurel <4-tea-2@bong.saar.de>. - They fix yet more typos and quite a few awkward sentences. - -1997-10-21 Adrian Aichner - - * etc/TUTORIAL.de: Manually merged a few more corrections by - Carsten Leonhardt - -1997-10-20 Adrian Aichner - - * etc/TUTORIAL.de: - Applied patches from Andreas Jaeger to 1.2, - then merged them with 1.3 via ediff-buffers. - Andreas found some quite nasty typos still and added many missing commas. - - * etc/TUTORIAL.de: Re-fill-ed paragraphs after patching. - - * etc/TUTORIAL.de: Applied the excellent patches courtesy of - Carsten Leonhardt . - -1997-11-03 MORIOKA Tomohiko - - * Delete etc/TUTORIAL.th because Thai is not supported yet. - -1997-11-02 MORIOKA Tomohiko - - * etc/TUTORIAL.ko: Renamed from etc/TUTORIAL.kr to fit with ISO - 639 (two letter language code). - - * etc/TUTORIAL.ja: Renamed from etc/TUTORIAL.jp to fit with ISO - 639 (two letter language code). - -1997-11-02 SL Baur - - * etc/CHARSETS: New file imported from Emacs 20.1. - -1997-11-02 Kyle Jones - - * lwlib/lwlib-Xaw.c (xaw_pop_instance): Don't use parent - window's coordinates and dimensions to center the - dialog box unless its mapped_when_managed property is - true. This should avoid the top level widget that the - HAVE_SESSION code creates, which is unmapped and - useless for this purpose. - -1997-11-01 SL Baur - - * XEmacs 20.3-pre1 is released. - -1997-10-31 SL Baur - - * XEmacs 19.16 is released. - -1997-10-31 SL Baur - - * XEmacs 20.5-beta2 is released. - -1997-10-30 SL Baur - - * configure.in (xetest): Eliminate tests for PNG, JPEG, - TIFF(broken) and replace with test for ImageMagick. - -1997-10-30 Kyle Jones - - * etc/Emacs.ad: Added *XlwMenu*highlightForeground entry. - Added *XlwMenu*titleForeground entry. - - * lwlib/xlwmenu.h: Added string macro declarations for - titleForeground and highlightForeground properties. - - * lwlib/xlwmenuP.h: Added struct fields for title and - highlight colors. - - * lwlib/xlwmenu.c: Added initialization and usage code - for the new titleForeground and highlightForeground - properties. - -1997-10-29 MORIOKA Tomohiko - - * etc/HELLO: Add Czech. - - * etc/HELLO: Delete Amharic, Thai and Tigrigna. - -1997-10-28 SL Baur - - * XEmacs 20.3-beta94 is released. - -1997-10-28 Andreas Jaeger - - * configure.in: Correct last patch for berkdb. - -1997-10-28 SL Baur - - * XEmacs 20.3-beta93 is released. - -1997-10-27 Martin Buchholz - - * lib-src/make-path.c: - * lib-src/digest-doc.c: - * lib-src/gnuslib.c: Always include config.h before system headers - * configure.in: Improve AIX configure support - - NON_GNU_CC defaults to `xlc' - - CFLAGS defaults to "-O3 -qstrict -qlibansi -qinfo -qro - -qmaxmem=20000" - - check for sin instead of sqrt in -lm to avoid xlc internal error - - Detect -li18n for use with Motif - - Move weird AIX static linking flags from s&m files to configure.in - - use #pragma instead of -ma flag to avoid compiler warnings - -1997-10-25 Kyle Jones - - * lwlib/xlwmenu.c: Use XtRDimension in place of - XmRHorizontalDimension in shadowThickness resource - declaration. - - * lwlib/xlwmenu.c (label_button_draw): Use the button_gc - color as the foreground for selected entries. - - * lwlib/xlwmenu.c (push_button_draw): Use the button_gc - color as the foreground for selected entries. - - * lwlib/xlwmenu.c (toggle_decoration_height): Force - height to be minimum of 2x the shadow thickness. - -1997-10-24 Andreas Jaeger - - * configure.in: Don't choke on Berkeley DB 2.x. - -1997-10-24 SL Baur - - * XEmacs 20.3-beta92 is released. - -1997-10-21 SL Baur - - * Makefile.in (lisp/utils/finder-inf.el): Don't force rebuild if - it already exists (use `make finder' to force rebuild). - -1997-10-18 SL Baur - - * XEmacs 20.3-beta91 is released. - -1997-10-16 Hrvoje Niksic - - * etc/NEWS: document changed package load semantics. - -1997-10-15 Olivier Galibert - - * configure.in: Removed -Olimit=2000 from cc for IRIX. - -1997-10-12 Karl M. Hegbloom - - * configure.in (null_string): Added AC_SUBST(infodir_user_defined) - and removed backquoted echo statement from the infopath report line. - -1997-10-15 Olivier Galibert - - * configure.in: Added detection of the declaration of the timezone - variable in system files. Defines HAVE_TIMEZONE_DECL if yes. - - -1997-10-15 Olivier Galibert - - * config.h.in: Add HAVE_TIMEZONE_DECL for detection of declaration - of the timezone variable in system headers. - - * systime.h: Use HAVE_TIMEZONE_DECL. - -1997-10-14 SL Baur - - * configure.in (all_widgets): Don't allow configuration of - --with-mule if Mule lisp hasn't been installed. - -1997-10-13 SL Baur - - * configure.in: Remove `site-lisp' from list of directories to - make symbolic links for. - - * XEmacs 20.3-beta90 is released. - -1997-10-12 Glynn Clements - - * info/dir: Cosmetic changes to info/dir - -1997-10-13 Hrvoje Niksic - - * etc/NEWS: Updates - -1997-10-12 SL Baur - - * XEmacs 20.5-beta1 is released. - - * XEmacs 19.16-pre9 is released. - - * XEmacs 19.16-pre8 is released. - -1997-10-11 SL Baur - - * XEmacs 20.3-beta28 is released. - - * Makefile.in (src/paths.h): Update PATH_INFOPATH - (infopath): New shell variable. - (infopath_user_defined): Ditto. - - * configure.in (infodir_user_defined): Spelling fixes. - -1997-10-10 Karl M. Hegbloom - - * configure.in: added options and option help docs for infopath - and lockdir - * '' added a line to the report for infopath and lockdir - - * etc/NEWS: Draft entry for the info changes. - -1997-10-10 Karl M. Hegbloom - - * Makefile.in.in (INFOPATH): Added variable and put it into - DUMPENV. - -1997-10-11 SL Baur - - * packages/info/localdir: New directory and file. - - * packages/README: New directory & file. - -1997-10-10 Martin Buchholz - - * Makefile.in: Add `make configure' target - - * etc/BETA: - - remove Chuck as contact name - - random small improvements - - remove I/me references - the message should be that XEmacs - maintenance is an inclusive community effort. - -1997-10-10 SL Baur - - * etc/BETA (Prerequisite): Add further documentation for - package installation. - -1997-10-07 SL Baur - - * XEmacs 19.16-pre7 is released. - -1997-10-05 Damon Lipparelli - - * Makefile.in (install-arch-dep, install-arch-indep): Move the - commands for symlink'ing the system-independent bits into the - system-dependent directory structure from "install-arch-indep" to - "install-arch-dep". - -1997-10-06 Jens-Ulrik Holger Petersen - - * Makefile.in (blddir): variable from "configure". - (finder): use it. - -1997-10-05 SL Baur - - * Makefile.in (GENERATED_LISP): New variable. - (all): Force dependency on finder-inf.el. - (lisp/utils/finder-inf.el): new rule. - -1997-10-04 SL Baur - - * XEmacs 19.16-pre6 is released. - -1997-10-04 SL Baur - - * XEmacs 20.3-beta27 is released. - -1997-10-03 Damon Lipparelli - - * Makefile.in (install-arch-indep): When --prefix != - --exec-prefix, symlink the system-independent bits into the - system-dependent directory structure (rather than the other way - around). - -1997-10-03 Martin Buchholz - - * lib-src/etags.c: etags 12.28 + prototypization - * INSTALL: Better document --site-runtime-libraries - * src/scrollbar-x.c (x_update_scrollbar_instance_status): - FIX: M-x scroll-left; horizontal scrollbar appears; drag it - left; scrollbar disappears; keyboard inoperative. - * configure.in: Remove left-over references to *_switch_x_* - - NAS libaudio is part of $libs_x, not $LIBS - -1997-10-02 SL Baur - - * XEmacs 20.3-beta26 is released. - -1997-09-30 SL Baur - - * XEmacs 20.3-beta25 is released. - - * Makefile.in (install-arch-dep): Install the `Installation' for - future reference. - - * etc/BETA: Document existence of `Installation' file. - - Document requirement of rebuilding finder-inf.el when building - from the full tarball. - - * Makefile.in (top_distclean): Remove finder-inf.el*. - - * configure.in (use_union_type): Default to "yes". - -1997-09-29 Martin Buchholz - - * configure.in: Add tiff autodetection - -1997-09-29 SL Baur - - * lwlib/xlwmenu.c: Add bounds checking. - Check error return on XmStringGetLtoR. - -1997-09-27 SL Baur - - * XEmacs 20.3-beta24 is released. - -1997-09-27 Hrvoje Niksic - - * Makefile.in (custom-loads): New target. - -1997-09-24 SL Baur - - * etc/BETA (XEmacs 20.3 packages): Added explanation of package - hierarchy. - -1997-09-23 SL Baur - - * lwlib/xlwmenu.c: Fix compilation problem with USE_XFONTSET. - From Kazuyuki IENAGA - -1997-09-22 SL Baur - - * XEmacs 19.16-pre4 is released. - -1997-09-20 SL Baur - - * XEmacs 20.3-beta23 is released. - -1997-09-19 SL Baur - - * XEmacs 19.16-pre3 is released. - -1997-09-18 Colin Rafferty - - * etc/NEWS: Various spelling corrections and some grammar - corrections (which/that). - -1997-09-19 Martin Buchholz - - * src/redisplay-tty.c: Fix crashes with non-7bit tty escape - sequences (needs more testing). - * */Makefile*: - - Cleanup man/*/Makefile for consistency. - - use $(MAKEFINFO), $(TEXI2DVI), etc... - - Make combination --with-srcdir + Sun make work properly. - - Change construct: test -d $${dir} || mkdir $${dir} - --> if test ! -d $${dir}; then mkdir $${dir}; fi - * lisp/x11/x-win-sun.el: Fix remaining glitches with - re-mappings of Sun function keys. - * configure.in: Detect libXaw AFTER libXpm to support libXawXpm. - * man/internals/internals.texi: Fix makeinfo compilation error. - -1997-09-17 SL Baur - - * XEmacs 20.3-beta22 is released. - -1997-09-16 SL Baur - - * XEmacs 20.3-beta21 is released. - - * XEmacs 19.16-pre2 is released. - -1997-09-13 SL Baur - - * XEmacs 20.3-beta20 is released. - -1997-09-11 Martin Buchholz - - * configure.in: Use `PATH' for options that take multiple dirs. - - Fix test for $PWD == `pwd` - - Prefer autodetected X11R6 to X11 so that broken HP and Linux - systems can work. (untested) - - * lisp/cl/cl.el: Fix `loop' indentation to be same as `defun'. - * lisp/prim/dumped-lisp.el: cl-extra and cl-seq always end up - being autoloaded - let's make them part of the core. - - * lisp/x11/x-compose.el: - * lisp/x11/x-init.el: - * lisp/x11/x-win-sun.el: - * lisp/x11/x-winxfree86.el: - * src/device-x.c: - * src/event-Xt.c: - - Yet another rewrite of key handling (not the last, though) - - x-keysym-on-keyboard-p is much faster. - - x-keysym-on-keyboard-sans-modifiers-p introduced. - - x-keysym-hashtable introduced. - - allow X11R4 libs to guess keysyms on X11R5 servers. - - A better workaround for the bug that some Xlibs generate - Multi_key a adiaeresis when pressing Multi_key a " - - * src/dgif_lib.c: Make sure size_t is defined before using it. - -1997-09-12 SL Baur - - XEmacs 19.16-pre1 "Queens" is released. - -1997-09-08 SL Baur - - * configure.in: Reverse package-path. - From Colin Rafferty - -1997-09-02 SL Baur - - * XEmacs 20.3-beta19 is released. - - * Makefile.in (finder): New target. - -1997-08-29 SL Baur - - * XEmacs 19.16-beta91 is released. - -1997-08-25 MORIOKA Tomohiko - - * lisp/apel/emu-x20.el (mime-charset-coding-system-alist): - iso-2022-jp-2 is defined as coding-system. - - * lisp/mule/mule-coding.el: Rename `iso-2022-ss2-{7|8}' -> - `iso-2022-{7|8}bit-ss2' to sync with Emacs 20.0.96. - - (iso-2022-jp-2): New coding system. - -1997-08-23 MORIOKA Tomohiko - - * lisp/prim/about.el (about-maintainer-glyph): Fix problem with - jka-compr.el. - -1997-08-20 SL Baur - - * XEmacs 19.16-beta90 is released. - -1997-08-16 SL Baur - - * XEmacs 20.3-beta18 is released. - -1997-08-11 Karl M. Hegbloom - - * etc/NEWS: add a section telling about the Info changes. - -1997-08-09 SL Baur - - * XEmacs 20.3-beta17 is released. - -1997-08-07 Jan Vroonhof - - * etc/gnuserv.1: Described Hrvoje's mods in manpage - -1997-08-09 Martin Buchholz - - * configure.in: - - use-system-malloc renamed to with-system-malloc. - - config.el reimplemented for improved accuracy. - - new variable `blddir' introduced for informational purposes. - * lib-src/config.values.in: new config.el implementation - * lib-src/config.values.sh: new config.el implementation - * lisp/modes/pascal.el: Sync with GNU Emacs, fix infloop problem - (thanks to Espen Skoglund, pascal.el maintainer) - * src/chartab.c: maintainability improvements. - * src/mule-coding.c: FIX for: editing DOS files with ISO2022* - coding systems results in extra CR's inserted into file on saving. - -1997-08-06 SL Baur - - * configure.in: Crash & burn if db-2 is detected. - From Soren Dayton - -1997-07-31 SL Baur - - * XEmacs 20.3-beta16 is released. - -1997-07-31 Martin Buchholz - - * configure.in: --with-x11=no --> --with-xface=no - * lisp/efs/dired-xemacs.el: Rationalize mouse file functions - * src/input-method-xlib.c: Allow xemacs to connect to kinput2 - * event-Xt.c: Fix crashes when no input context available. - * src/mule-coding.c: Use enum eol_type instead of int consistently - * regex.c: Use (void *) 0 instead of NULL in varargs function calls - * src/s/freebsd.h: Wrap #include X11/Xlocale.h inside #ifndef - NOT_C_CODE - -1997-07-27 SL Baur - - * etc/BETA: Update patching instructions. - -1997-07-26 SL Baur - - * XEmacs 20.3-beta15 is released. - -1997-07-25 SL Baur - - * lwlib/xlwscrollbar.c: Add debug malloc support. - * lwlib/xlwmenu.c: Ditto. - * lwlib/lwlib-utils.h: Ditto. - - * configure.in (null_string): Add --use-debug-malloc option. - -1997-07-21 SL Baur - - * info/dir (Packages): Remove AUCTeX, Gnus and Message manuals. - -1997-07-20 SL Baur - - * Makefile.in (install-arch-indep): Create required links when - prefixdir != execdir. - -1997-07-19 SL Baur - - * XEmacs 20.3-beta14 is released. - -1997-07-19 Martin Buchholz - - * src/fns.c (require): Print messages when loading a file as a - result of require. - - * configure.in: - * lisp/utils/config.el: - * lib-src/config.values: - - new file created and installed by building. - - Allow configuration time values to be queried by the lisp code. - - * configure.in: - - check for alloca in libPW on hpux. - - Redo --with-clash-detection - - need to check for termios and friends even if with-tty=no. - - Always define SIGNALS_VIA_CHARACTERS if HAVE_TERMIOS - - better quoting for AIX_SMT_EXP (untested) - - gcc flags now default to "-g -O2 -Wall -Wno-switch" - - * *.[ch]: more warning elimination - - * src/input-method*.c: - * src/s/freebsd.h: - - remove freebsd ifdefs from C code. - - * src/specifier.c: - - fix Fdisplay-table-specifier-p - -1997-07-13 Steven L Baur - - * XEmacs 20.3-beta13 is released. - - * info/dir (Packages): Integrate texinfo manual for PH. - -1997-07-10 Hrvoje Niksic - - * extents.c (print_extent): Print correctly. - -1997-07-13 Steven L Baur - - * configure.in (CPP): Add -Wall to default gcc CFLAGS. - -1997-07-11 Martin Buchholz - - * *Makefile*: More cleanup. - - MAKE CFLAGS=-foo now works with recursive invocations on old makes - - Nuke ld_call_shared from s&m files - - Nuke src/s/*-static.h - - Nuke Solaris and DEC OSF static build support. - - Nuke SHORTNAMES - - Nuke libmld - - CLASH_DETECTION configurable, off by default. - - * *.[ch]: Warning elimination, code cleanup, some 64-bit - safeguarding. - - * sol2.h: More bullet-proofing for Sun bugs in header files. - - * lib-src/etags.c: etags version 12.19. - - * lisp/x11/x-select.el: - * src/xselect.c: Try STRING if selection owner couldn't convert - COMPOUND_TEXT. - - * src/*.c: Change defalt to default_, and in general allow - doc-snarfing functions to recognize and ignore trailing `_' - - * src/*.[ch]: Introduce XVECTOR_DATA and XVECTOR_LENGTH macros and - convert source code to use them consistently. - -1997-07-08 Steven L Baur - - * XEmacs 20.3-beta12 is released. - -1997-07-08 Martin Buchholz - - * configure.in: Set options differently, depending on beta-ness of - build tree. - * *Makefile*: Clean up *clean: targets, esp. Steven's beloved - distclean. - -1997-07-08 Steven L Baur - - * pkg-src/tree-x/Makefile.in.in (xoobr): Pass CFLAGS to the - linker. - From Olivier Galibert - -1997-07-07 Steven L Baur - - * pkg-src/tree-x/Makefile.in.in (distclean): Add target. - -1997-07-06 Steven L Baur - - * lwlib/lwlib-Xm.c (xm_update_one_value): Hand application of mrb - fix. Restoration of lossage from beta10->beta11 upgrade. - - * XEmacs 20.3-beta11 is released. - -1997-07-08 MORIOKA Tomohiko - - * lisp/language/english.el: Add quail-british for British. - - * lisp/language/european.el: Register input-method for various non - quail-latin-1 methods. - -1997-07-05 Martin Buchholz - - * lib-src/getopt*.c: Don't redefine const - let configure do that. - - * configure.in: Better behavior for `configure --with-gcc=no' - - Autodetect ulimit.h - - Remove broken SunOS4 kludge for libXmu - - Autodetect usleep - - * src/s/sol2.h: Support gcc on various Solaris releases. - - * lib-src/*.c: Ansify prototypes. - - * lisp/prim/files.el: Optimize auto-mode-alist. - - * pkg-src/tree-x/Makefile.in.in: `make distclean' now works - - `make install' now works. - - dependencies updated. - - * pkg-src/tree-x/*.[ch]: Fix compile warnings. - - Replace uses of XtVa* with non-varargs variants. - -1997-07-01 MORIOKA Tomohiko - - * lisp/modes/image-mode.el: Add `image-maybe-restore' to - `change-major-mode-hook'. - - * lisp/modes/image-mode.el (image-maybe-restore): New function. - - * src/glyphs.c (make_string_from_file): must protect from - `format-alist'. - -1997-06-30 Steven L Baur - - * pkg-src/tree-x/Makefile.in.in (INSTALL): Add configure written - variable. - -1997-06-29 Steven L Baur - - * configure.in (CPP): Correct typo `print-lib-gcc-file-name' - should be `print-libgcc-file-name' - From Katsumi Yamaoka - - * XEmacs 20.3-beta10 is released. - -1997-06-29 MORIOKA Tomohiko - - * lisp/language/chinese.el: Add chinese-isoir165 (CCITT Extended - GB). - - * lisp/language/chinese.el: Modify charset DOC-strings for CNS - 11643 to be more detailed. - - * lisp/language/arabic.el: Rename `arabic-0', `arabic-1' and - `arabic-2' to `arabic-digit', `arabic-1-column' and - `arabic-2-column' to sync with Emacs/mule-19.34.94-zeta. - - * src/mule-charset.c: Modify charset DOC-strings to be more - detailed. - - Use BOX DRAWINGS characters of JIS X0208. - -1997-06-28 MORIOKA Tomohiko - - * lisp/apel/richtext.el: Add autoload comments for - `richtext-encode' and `richtext-decode'. - - * lisp/prim/format.el (format-alist): Add `text/richtext'. - - * lisp/tl/chartblxmas.el: New file. - - * lisp/x11/x-menubar.el (default-menubar): Add "Show character - table" for MULE menu. - - * lisp/apel/emu.el: Check richtext.el is bundled. - - * lisp/tl/char-table.el (view-charset): New command. - - * lisp/tl/char-table.el: Rename some functions. - - * lisp/packages/hexl.el (hexl-mode-exit): Run - `hexl-mode-exit-hook'. - - * lisp/x11/x-menubar.el (default-menubar): Fix "Describe language - support" and "Set language environment" of mule menu. - - * lisp/apel/file-detect.el: Add autoload comments for function - `add-path', `add-latest-path', `get-latest-path', - `file-installed-p', `exec-installed-p', `module-installed-p' and - variable `exec-suffix-list'. - - * lisp/prim/format.el (format-alist): Add image/jpeg, image/gif, - image/png and image/x-xpm. - - * lisp/modes/image-mode.el: New file. - -1997-06-27 MORIOKA Tomohiko - - * lisp/tm/tm-ew-e.el (tm-eword::encode-string-1): avoid infinite - loop caused by long non-encoded-word element. (cf. [tm-en:1356]) - - (mime/field-encoding-method-alist): Add "Message-ID" as ignored. - -1997-06-25 Steven L Baur - - * XEmacs 20.3-beta9 is released. - - * Makefile.in (dist): Make `make dist' work for me. - -1997-06-25 Martin Buchholz - - * configure.in: - - Change "t" to tabs in sed commands - - Add /g to sed substitition commands when appropriate - - Change XtVa[SG]etValue to Xt[SG]etValue - - Make version variables into Lisp_Objects. - -1997-06-19 Martin Buchholz - - * src/config.h.in: - * configure.in: - - Autodetect X defines using xmkmf. - - Compute rpath on *bsd* systems as well. - - rewrite PRINT_VAR m4 macro. - - detect sizes of void* and long long for future use by unex*.c - * regex.c: _GNU_SOURCE may be defined by config.h; don't redefine. - -1997-06-24 MORIOKA Tomohiko - - * lisp/language/arabic.el: moved from lisp/mule/arabic-hooks.el. - - * lisp/mh-e/mh-e.el (mh-get-new-mail): Decode output as - `mh-folder-coding-system'. - -1997-06-24 MORIOKA Tomohiko - - * lisp/language/ethio-util.el: imported from - Emacs/mule-19.34.94-zeta. - - * lisp/language/arabic-util.el: moved from lisp/mule/arabic.el; - repair Arabic characters. - -1997-06-24 MORIOKA Tomohiko - - * lib-src/update-autoloads.sh: Search lisp/mule/. - - * etc/HELLO: final byte for ethiopic was changed to sync with - Emacs/mule-19.34.94-zeta. - - * lisp/x11/x-menubar.el: Fix "Describe language support" and "Set - language environment" of Mule menu. - - * lisp/language/visual-mode.el: moved from mule/. - - * lisp/language/ethiopic.el: Modify for XEmacs. - - * lisp/language/cyrillic.el: Modify DOC-string of koi8-r; Fixed - problem of setting for `language-info-alist' about koi8-r. - - * lisp/mule/auto-autoloads.el: Enable auto-autoloads.el for mule/. - - * lisp/mule/mule-util.el: New file (imported from - Emacs/mule-19.34.94-zeta). - - * lisp/mule/mule-misc.el: Function `truncate-string-to-width' was - moved to mule-util.el. - - * lisp/prim/dumped-lisp.el, lisp/mule/mule-load.el: - lisp/mule/arabic-hooks.el was moved to lisp/language/arabic.el; - lisp/mule/arabic.el was moved to lisp/language/arabic-util.el; Use - lisp/language/ethiopic.el instead of lisp/mule/ethiopic-hooks.el; - Use lisp/language/ethio-util.el instead of lisp/mule/ethiopic.el. - - * lisp/mule/mule-coding.el (coding-system-docstring): New alias to - emulate Emacs/mule-19.34.94-zeta function. - - * lisp/mule/mule-cmds.el: modified to sync with - Emacs/mule-19.34.94-zeta (mule-prefix was changed to "C-x C-m") - - (set-language-info): Add to "Describe Language Support" and "Set - Language Environment" menu. - - * lisp/mule/mule-charset.el: Function `compose-region' and - `decompose-region' were moved to mule-util.el. - - * lisp/leim/quail.el: modify to sync with latest quail.el of - Emacs/mule in ETL. - - (quail-toggle-mode-temporarily): check `quail-conv-overlay'. - - (quail-map-p): Use `characterp' instead of `integerp'. - -1997-06-23 Steven L Baur - - * etc/NEWS (Commands): Various updates by Hrvoje Niksic. - -1997-06-21 Steven L Baur - - * Makefile.in: Missing FRC.info. - (install-arch-dep): Add missing backslash. - From Glynn Clements - - * XEmacs 20.3-beta8 is released. - -1997-06-20 Olivier Galibert - - * lwlib/lwlib-Xaw.c, lwlib/lwlib-Xlw.c, lwlib/lwlib-Xm.c, - lwlib/lwlib.c: Make 64 bit clean. - -1997-06-20 Steven L Baur - - * etc/gnuserv.1: Updates and cleanup. - From Hrvoje Niksic - -1997-06-19 Martin Buchholz - - * configure.in: - - Autodetect X defines using xmkmf. - - Compute rpath on *bsd* systems as well. - - rewrite PRINT_VAR m4 macro. - - detect sizes of void* and long long for future use by unex*.c - -1997-06-18 Martin Buchholz - - * */Makefile.in.in: Another rewrite - Make makefiles immune from being mangled by various cpp - implementations by quoting non-preprocessor directive lines. - - random cleanup - - Use $(RM) and $(pwd) macros consistently - - Add dependencies for balloon-help source files - - Use getcwd by default instead of getwd. - * lwlib/config.h: Now includes src/config.h - * lwlib/*.c: Use config.h, but DON'T use Xos.h - * lib-src/*.c: Fix compiler warnings - * lisp/version.el: - - Put version information in version.sh instead of version.el - -Wed Jun 18 16:41:43 1997 Steven L Baur - - * configure.in (CPP): Remove hardcoding of -L/usr/local/lib - -I/usr/local/include. - -1997-06-14 Steven L Baur - - * XEmacs 20.3-beta7 is released. - -1997-06-12 Steven L Baur - - * etc/TUTORIAL (things): Synched by Hrvoje Niksic with previous - XEmacs version. - -1997-06-13 MORIOKA Tomohiko - - * lisp/gnus/smiley.el (smiley-deformed-regexp-alist): Modify - regexp for horizontal smiley faces. - (smiley-nosey-regexp-alist): Add horizontal smiley faces. - - * lisp/leim/quail.el (quail-get-translation): Don't use - `string-to-vector' for XEmacs. - -1997-06-13 Gary D. Foster - - * lisp/modes/*.el: Removed all "\177" bindings that were - previously commented out and normalized everything vis a vis - 'backspace and 'delete keysyms. - * lisp/packages/*.el: Normalized all the "\177" bindings - * lisp/modes/cperl-mode.el: Created cperl-electric-delete function - which is a "smart" version of the cperl-electric-backspace - function (it honors the desired delete direction). Bound it to - 'delete and the electric-backspace to 'backspace. - * lisp/packages/pending-del.el: Added cperl-electric-backspace and - cperl-electric-delete to the 'supersede list. - -1997-06-11 Steven L Baur - - * XEmacs 20.3-b6 is released. - - * configure.in (GNU_MALLOC): Check for (-l)PW instead of (-l)-lPW. - Suggested by Martin Buchholz - -1997-06-11 Martin Buchholz - - * src/Makefile.in: - * lwlib/Makefile.in: - * lib-src/Makefile.in: - * Makefile.in: More Makefile cleanup - - add .PHONY targets where necessary - - remove most builtin rules using .SUFFIXES - - -lXau only gets used for linking gnuserv binaries - - No VPATH for root Makefile - - remove gcc v1 support - * configure.in: - - A new test to autodetect need to define NARROWPROTO, - needed by XFree86 - - Consistently use idiom foo=`echo '' $foo | sed -s 's:^ ::' -e ...` - - Immediately exit if SIZEOF_* tests fail. - - Check for libPW - - Use more sophisticated Xpm test that confirms xpm.h and libXpm - are in sync. - * src/s/linux.h: - * src/m/intel386.h: Yet another attempt to clean up linux defines. - -1997-06-10 Steven L Baur - - * lib-src/pop.c: Correct incantation for pop.h. - From Martin Buchholz - -Tue Jun 10 15:11:16 1997 Steven L Baur - - * configure.in (beta): Correct test looking for Beta number. - -1997-06-11 MORIOKA Tomohiko - - * src/Makefile.in.in, mule/language/misc-lang.el, - mule/mule-load.el, mule/ipa-hooks.el: Use - lisp/mule/language/misc-lang.el instead of lisp/mule/ipa-hooks.el; - mule/ipa-hooks.el was deleted. - -1997-06-10 MORIOKA Tomohiko - - * Use lisp/mule/language/thai-util.el instead of - lisp/mule/thai.el. - - * lisp/custom/wid-edit.el: Add widget `coding-system' for mule. - - * lisp/mule/thai-hooks.el, lisp/mule/mule-load.el: Use - lisp/mule/language/thai.el instead of lisp/mule/thai-hooks.el. - - * lisp/mule/language/thai.el: modified for XEmacs. - -1997-06-09 MORIOKA Tomohiko - - * lisp/mule/mule-load.el, src/Makefile.in.in: Use - lisp/mule/language/chinese.el, lisp/mule/language/cyrillic.el, - lisp/mule/language/european.el, lisp/mule/language/greek.el, - lisp/mule/language/japanese.el and lisp/mule/language/korean.el - instead of lisp/mule/chinese-hooks.el, - lisp/mule/cyrillic-hooks.el, lisp/mule/european-hooks.el, - lisp/mule/greek-hooks.el, lisp/mule/japanese-hooks.el and - lisp/mule/korean-hooks.el. - - * lisp/mule/language/*.el was imported from - Emacs/mule-19.34.94-zeta. - - * Use lisp/mule/language/china-util.el instead of - lisp/mule/chinese.el. - -1997-06-08 MORIOKA Tomohiko - - * lisp/apel/emu-x20.el (mime-charset-coding-system-alist): - iso-8859-1, hz-gb-2312, cn-gb-2312, gb2312, cn-big5 and koi8-r - were defined as coding-system. - -1997-06-08 MORIOKA Tomohiko - - * etc/smilies/Face_smile.xbm, etc/smilies/Face_weep.xbm, - etc/smilies/Face_ase2.xbm, etc/smilies/Face_ase3.xbm, - etc/smilies/Face_ase.xbm: Add Japanese smiley faces. - -1997-06-07 MORIOKA Tomohiko - - * lisp/gnus/smiley.el (smiley-deformed-regexp-alist): Add Japanese - smiley faces. - -1997-06-10 Gary D. Foster - - * lisp/modes/view-less.el: Changed \177 bindings to 'delete - * lisp/modes/help.el: Changed \177 bindings to 'delete - -1997-06-10 Gary D. Foster - - * lisp/prim/keydefs.el: Changed all 'delete key bindings to point to - the `backward-or-forward-foo' functions. - * lisp/prim/simple.el: - - Renamed `delete-erases-forward' to `delete-key-deletes-forward'. - - Removed `backspace-or-delete-hook' - - Renamed `backspace-or-delete' to `backward-or-forward-delete-char' - - Added functions: `backward-or-forward-kill-word' - `backward-or-forward-kill-sentence' - `backward-or-forward-kill-sexp' - - Removed the zmacs hacks from all the `b-or-f-foo' functions and - began playing nicely with pending-del. - * lisp/modes/cc-mode.el: - * lisp/modes/cperl-mode.el: Fixed references to delete functions - to use the new names. - -1997-06-09 Steven L Baur - - * XEmacs 20.3-b5 is released. - -1997-06-08 Steven L Baur - - * etc/NEWS: Updates for early beta20.3 stuffs. - From Hrvoje Niksic - -1997-06-05 Steven L Baur - - * XEmacs 20.3-b4 is released. - -1997-06-04 Martin Buchholz - - * src/*/*.h: Remove definitions of HAVE_UNION_WAIT, in accordance - with new Autoconf 2 mechanisms. - * src/syswait.h: - * src/sysdep.c: - * src/process.c: Use only Posix.1 sys/wait.h-defined symbols - - * src/s/netbsd.h: complete rewrite, use ORDINARY_LINK, #ifdef out - old cruft that can be obtained from system header files. - * lib-src/getopt*: Synch with FSF, remove compiler warnings. - - * lib-src/b2m.c: - * src/gifalloc.c: - * lib-src/gnuslib.c: - * lib-src/profile.c: - * lib-src/movemail.c: Fix compiler warnings - - * lib-src/Makefile.in.in: Remove unused -DCONFIG_BROKETS flag - - Fix up compile flags for new etags version - - * etc/NEWS: - * etc/etags.1: - * man/xemacs/programs.texi: - * lib-src/etags.c: Upgraded to etags 12.11 - - * src/config.h.in: Fix inline keyword support - - * configure.in: Use a different mechanism for removing extra white - space. Avoid using foo=`echo $bar`, which loses with various echos. - - new M4 macro XE_SPACE(var, words...) - - Use autoconf 2's AC_HEADER_SYS_WAIT - - Check for Xpm-XpmFree instead of Xpm-XpmReadFileToData to avoid - linking with losing Xpm implementations - - Check for correct wnn4 lib symbols - - Only link with inline.o when using gcc - - Support inline keywords inline, __inline, __inline__ - - Ultrix now implies have_mmap=no - - Sun sound in non-standard dirs now works - - --native-sound-lib no longer ignored on HP & SGI - - gpm configure tests moved after curses configure tests - -1997-06-04 Gary D. Foster - - * lisp/modes/cc-mode.el: Modified `c-electric-delete' to honor the - desired delete direction in both normal and "hungry" modes. - * lisp/modes/cperl-mode.el: Modified `cperl-electric-backspace' to - honor the desired delete direction. - -1997-05-30 Martin Buchholz - - * configure.in: Automagically compute -R path for gcc - -1997-05-30 Gary D. Foster - - * lisp/vm/vm-vars.el: Fixed delete key binding to call - `vm-scroll-down' - -Thu May 29 15:35:07 1997 Martin Buchholz - - * configure.in: Add support for Solaris2.6 -z ignore linker flags - -1997-05-29 Martin Buchholz - - * configure.in: Replace standard Autoconf MMAP test with Neal - Becker's replacement, hacked somewhat. - -1997-05-16 Gary D. Foster - - * lisp/prim/simple.el: Created `backspace-or-delete' function and - `backspace-or-delete-hook' - * lisp/prim/keydefs.el: Changed \177 bindings to point to new - delete function. - * lisp/modes/*.el: Removed conflicting \177 bindings. - * lisp/modes/cc-mode.el: Modified `c-electric-delete' to use new - delete bindings. - * lisp/modes/cperl-mode.el: Modified `cperl-electric-backspace' to - use new delete bindings. - -1997-06-03 MORIOKA Tomohiko - - * lisp/x11/x-menubar.el (default-menubar): Add menu for Mule. - - * lisp/mule/mule-cmds.el: Menu for XEmacs were moved to - x11/x-menubar.el. - -1997-06-03 MORIOKA Tomohiko - - * lisp/leim/quail.el: to avoid compiling warnings about - overlay.el. - -1997-06-03 MORIOKA Tomohiko - - * lisp/leim/quail.el: to sync with quail.el of - Emacs-19.34.94-zeta. - - * lisp/leim/quail/ziranma.el, lisp/leim/quail/tonepy.el, - lisp/leim/quail/py.el, lisp/leim/quail/qj.el, - lisp/leim/quail/sw.el, lisp/leim/quail/ccdospy.el, - lisp/leim/quail/punct.el, lisp/leim/quail/4corner.el, - lisp/leim/quail/symbol-ksc.el, lisp/leim/quail/ethiopic.el, - lisp/leim/quail/hanja.el, lisp/leim/quail/quick-cns.el, - lisp/leim/quail/tsangchi-cns.el, lisp/leim/quail/lrt.el, - lisp/leim/quail/tsangchi-b5.el, lisp/leim/quail/devanagari.el, - lisp/leim/quail/japanese.el, lisp/leim/quail/quick-b5.el, - lisp/leim/quail/punct-b5.el, lisp/leim/quail/qj-b5.el, - lisp/leim/quail/py-b5.el, lisp/leim/quail/ctlau.el, - lisp/leim/quail/ctlaub.el, lisp/leim/quail/ecdict.el, - lisp/leim/quail/array30.el, lisp/leim/quail/hangul3.el, - lisp/leim/quail/hanja-jis.el, lisp/leim/quail/cyrillic.el, - lisp/leim/quail/etzy.el, lisp/leim/quail/greek.el, - lisp/leim/quail/ipa.el, lisp/leim/quail/lao.el, - lisp/leim/quail/zozy.el, lisp/leim/quail/viqr.el, - lisp/leim/quail/latin.el, lisp/leim/quail/thai.el, - lisp/leim/quail/hangul.el: quail of LEIM for Emacs-19.34.94-zeta. - -1997-06-02 MORIOKA Tomohiko - - * mule/korean.el was abolished because it seems not to be used. - - * mule/japanese.el was abolished because it seems not to be used. - -1997-06-01 MORIOKA Tomohiko - - * lisp/tm/gnus-mime-old.el was abolished because XEmacs 20.3 has - Gnus 5.4. - - * lisp/tm/tm-edit.el: updated to 7.108. - - * lisp/tm/tm-view.el: updated to 7.83. - - * lisp/leim/quail.el: modified for XEmacs. - - * lisp/mule/mule-load.el, lisp/mule/mule-process.el: delete - mule-process.el because it is not used. - - * lisp/mule/european.el was abolished because it seems not to be - used. - - * lisp/mule/mule-load.el: must load mule-cmds before setting for - language-environment. - - * lisp/mule/european-hooks.el: Modified for LEIM. - - * lisp/mule/mule-cmds.el: Uncomment key definition for - `toggle-input-method'. - - * lisp/mule/mule-init.el: Comment out about `mule-keymap' (moved - to mule-cmds.el). - - * lisp/mule/mule-cmds.el: Uncomment about `mule-keymap' (moved - from mule-init.el). - - * lisp/tl/tl-atype.el: Don't require tl-str. - - * lisp/tl/tl-atype.el: Use atype.el of APEL. - - * lisp/tl/tl-list.el: Use alist.el of APEL. - -1997-05-31 MORIOKA Tomohiko - - * lisp/tl/richtext.el, lisp/tl/emu-x20.el, lisp/tl/emu-xemacs.el, - lisp/tl/emu.el, lisp/tl/emu-e19.el: moved to apel/. - - * lisp/tl/file-detect.el, lisp/tl/filename.el: replaced by APEL's. - - * lisp/mu/std11-parse.el, lisp/mu/std11.el: moved to apel/. - - * lisp/leim/quail.el: Add new quail.el (imported from Emacs - 19.34.94-epsilon). - - * lisp/leim/skk/skkdic.el: delete skkdic.el temporary because - XEmacs can not compile it. - - * lisp/leim/skk/skkdic.el, lisp/leim/quail/zozy.el, - lisp/leim/quail/ziranma.el, lisp/leim/quail/viqr.el, - lisp/leim/quail/tsangchi-cns.el, lisp/leim/quail/tsangchi-b5.el, - lisp/leim/quail/symbol-ksc.el, lisp/leim/quail/thai.el, - lisp/leim/quail/tonepy.el, lisp/leim/quail/quick-cns.el, - lisp/leim/quail/sw.el, lisp/leim/quail/qj-b5.el, - lisp/leim/quail/qj.el, lisp/leim/quail/quick-b5.el, - lisp/leim/quail/py-b5.el, lisp/leim/quail/py.el, - lisp/leim/quail/lao.el, lisp/leim/quail/latin.el, - lisp/leim/quail/lrt.el, lisp/leim/quail/punct-b5.el, - lisp/leim/quail/punct.el, lisp/leim/quail/hanja-jis.el, - lisp/leim/quail/hanja.el, lisp/leim/quail/ipa.el, - lisp/leim/quail/japanese.el, lisp/leim/quail/hangul3.el, - lisp/leim/quail/etzy.el, lisp/leim/quail/greek.el, - lisp/leim/quail/hangul.el, lisp/leim/quail/ethiopic.el, - lisp/leim/quail/devanagari.el, lisp/leim/quail/ecdict.el, - lisp/leim/quail/ctlau.el, lisp/leim/quail/ctlaub.el, - lisp/leim/quail/cyrillic.el, lisp/leim/quail/array30.el, - lisp/leim/quail/ccdospy.el, lisp/leim/quail/4corner.el: Add LEIM - elisp files; old lisp/quail was abolished. - - * src/Makefile.in.in: Add mule-cmds.elc. - - * lisp/mule/mule-load.el, lisp/mule/mule-cmds.el: Add mule-cmds.el - (imported from Emacs-19.34.94-epsilon and comment out a lot to - avoid conflict with mule-init.el or other XEmacs/mule files). - - * lisp/prim/simple.el (assoc-ignore-case): New function; imported - from Emacs-19.34.94-epsilon. - -1997-05-29 Steven L Baur - - * XEmacs 20.3-beta3 is released. - - * INSTALL: Delete documentation of mocklisp support. - - * configure.in: Delete mocklisp support. - - * etc/FTP: Update mirror info. - - * etc/DISTRIB: Update mirror info. - -1997-05-29 Martin Buchholz - - * configure.in: Replace standard Autoconf MMAP test with Neal - Becker's replacement, hacked somewhat. - -1997-05-28 Martin Buchholz - - * lisp/prim/files.el (auto-mode-alist): Reorg auto-mode-alist again. - - * lib-src/etags.c: Version 12.7 from Francesco. - - * configure.in: Juggle link order of X libraries. - Add support for using zsh to run configure. - Document --with-tty=no. - Fix -no-recursion option. - Recognize and ignore --cache-file option. - Recognize null values for preprocessor symbols converted to shell - variables. This maybe fixes the "-ltermcap" problem. - Remove spurious blanks from various SUBST-ituted variables. - Fix conditional creation of gdbinit. - Conditionally create .sbinit for Sunpro C. - -1997-05-26 Steven L Baur - - * etc/FTP: Correct typo in ftp.cenatls.cena.dgac.fr. - - * etc/DISTRIB: Ditto. - -1997-05-22 Steven L Baur - - * XEmacs 20.3-beta2 is released. - -Thu May 22 04:19:09 1997 Martin Buchholz - - * configure.in: Try to fix all reported bugs with 20.3-b1. - Change HAVE_WNN6 to WNN6. WNN6 correctly autodetected. - extra-verbose now default on beta builds. - extra-verbose now much more verbose. - Don't set libs_termcap to " ". - Detect -lXm AFTER detecting -lXpm. - Use runtime paths before running tests, since AC_TRY_RUN may - depend on it. - with-xim=motif only default on Solaris. - realpath moved from s&m to configure.in. - xemacs-version.h removed. main_1 now contains $canonical as well, - for even more useful backtraces. - termcap handling rewritten. - Create .sbinit for Sun's source browser. - Warn user if no XPM support present. - Warn user if compiling in error checking. - - * Makefile.in: use MAKE_SUBDIR consistently. Remove references to - dynodump. Remove core when cleaning. Remove config.log. - make distclean now functional. - -Tue Jun 4 10:15:54 1996 Per Bothner - - * etc/e/eterm.ti: Add kcub1, kcuf1, kcuu1, kcud1 capabilities. - -Sun May 18 13:03:20 1997 Steven L Baur - - * lwlib/Makefile.in.in (distclean): Clean up config.h. - - * Makefile.in (distclean): Remve config.log. - remove broken dynodump stuffs. - -Sat May 17 20:30:54 1997 Steven L Baur - - * XEmacs 20.3-b1 is released. - -Fri May 16 20:38:19 1997 Steven L Baur - - * info/dir (Packages): Update minor version number. - - * etc/README: Update minor version number. - - * README: Update minor version number. - -Tue May 13 20:35:52 1997 Steven L Baur - - * XEmacs-20.2 is released. - -Sat May 10 16:14:30 1997 Steven L Baur - - * XEmacs 20.2-b6 is released. - -Thu May 8 20:22:34 1997 Steven L Baur - - * XEmacs 20.2-b5 is released. - -Fri May 2 16:50:02 1997 Steven L Baur - - * XEmacs 20.2-b4 is released. - -Thu May 1 18:13:38 1997 Steven L Baur - - * configure.in (--with-xim): Don't default it to Motif since it - causes crashes at startup on some systems. - -Sun Apr 27 12:25:55 1997 Steven L Baur - - * XEmacs 20.2-b3 is released. - -Wed Apr 23 10:33:58 1997 Steven L Baur - - * XEmacs 20.2-b2 is released. - - * configure.in (beta): OPENWINHOME misspelled. - -Mon Apr 21 14:48:29 1997 Steven L Baur - - * etc/BETA (writing): Update with information about how to create - patches. - -Sat Apr 19 16:13:16 1997 Steven L Baur - - * XEmacs 20.2-b1 is released. - -Thu Apr 17 21:33:59 1997 Steven L Baur - - * configure.in (beta): SONY NEWS-OS has /etc/osversion and not - uname. - -Wed Apr 16 17:44:05 1997 Steven L Baur - - * XEmacs 20.1 is re-released. - -Tue Apr 15 21:03:22 1997 Steven L Baur - - * XEmacs 20.1 is released. - -Sat Apr 12 20:11:08 1997 Steven L Baur - - * XEmacs 20.1-b15 is released. - -Sat Apr 12 09:01:32 1997 Hrvoje Niksic - * PROBLEMS: I have cleaned up a bit the PROBLEMS file, by: - 1) changing it into sections -- there is now a section for building, - running and compatibility problems - - 2) removing some obviously obsolete entries -- e.g. those pertaining - to Emacs 18, etc. --> size is off by 20K - - 3) Rearranging the entries by relevance. I have tried to put the most - relevant entries in front. - -Thu Apr 10 19:07:26 1997 Steven L Baur - - * XEmacs 20.1-b14 is released. (Beta 13 was skipped). - -Wed Apr 9 22:52:06 1997 Steven L Baur - - * XEmacs 20.1-b12 is released. - -Sun Apr 6 22:31:00 1997 Tatsuya Ichikawa - - * configure.in: Cosmetic change to summary print of POP/Kerberos/ - Hesiod options. - -Sat Apr 5 09:11:36 1997 Steven L Baur - - * XEmacs 20.1-b11 is released. - -Wed Apr 2 15:27:35 1997 Steven L Baur - - * Makefile.in (install-only): New target. Functionality suggested - by Larry Schwimmer, correct way of doing it suggested by Chuck - Thompson. - - * configure.in: Default to "-Olimit 2000" as suggested by Jamie - Zawinski for SGI cc and Irix 6. - -Tue Apr 1 12:23:13 1997 Steven L Baur - - * configure.in: Add configuration parameters for Emacs 19.34 - movemail.c (--with-pop, --with-kerberos, --with-hesiod). - -Fri Mar 28 19:58:41 1997 Steven L Baur - - * configure.in: Remove garbage if [ ... ] constructs and a - mispatch. - -Thu Mar 27 18:24:19 1997 Steven L Baur - - * XEmacs 20.1-b10 is released. - -Wed Mar 26 22:31:10 1997 Steven L Baur - - * Remove vms top-level directory. - - * XEmacs 19.15 final released to beta testers. - -Tue Mar 25 19:13:27 1997 Steven L Baur - - * XEmacs 19.15 prefinal released to beta testers. - -Mon Mar 24 12:28:17 1997 Steven L Baur - - * configure.in (--debug): Correct documentation. - -Sun Mar 23 17:24:38 1997 Steven L Baur - - * XEmacs 19.15-b104 is released. - -Sat Mar 22 19:56:36 1997 Steven L Baur - - * etc/sgml/CATALOG: Default to html-3.2final. - -Sat Mar 22 17:55:15 1997 Darrell Kindred - - * configure.in (beta): Add configure support for the -rpath flag - for IRIX analogous to the Solaris "-R". - -Sat Mar 22 16:47:08 1997 Steven L Baur - - * info/dir (Packages): Add HM-HTML-Mode to menu. - -Sat Mar 22 21:27:41 1997 Tomasz J. Cholewo - - * configure.in: Echo only current configuration using 'tee -a'. - -Fri Mar 21 21:26:01 1997 Steven L Baur - - * XEmacs-19.15-b103 is released. - * XEmacs-20.0-b9 is released. - - * Makefile.in (top_distclean): Add `Installation' to distclean - rule. - -Fri Mar 21 20:05:29 1997 Darrell Kindred - - * Makefile.in (autoloads): Pass $(MAKE) to update-elc.sh and - update-autoloads.sh. - -Thu Mar 20 20:14:16 1997 Steven L Baur - - * XEmacs-19.15-b102 is released. - -Tue Mar 18 21:52:36 1997 Steven L Baur - - * XEmacs-19.15-b101 is released. - -Mon Mar 17 19:09:29 1997 Steven L Baur - - * XEmacs-20.1-b8 is released. - * XEmacs-19.15-b100 is released. - -Sat Mar 15 17:15:18 1997 Steven L Baur - - * XEmacs-20.1-b7 is released. - * XEmacs-19.15-b99 is released. - - * etc/sgml/CATALOG: Added IE3 DTDs and htmlpro DTD. - -Thu Mar 13 10:40:11 1997 Steven L Baur - - * configure.in: Add sunos4-1-4 header files. - -Wed Mar 12 18:53:08 1997 Steven L Baur - - * configure.in: Use new file bsdos3.h with BSDI 3.0. - -Sat Mar 8 15:19:33 1997 Steven L Baur - - * XEmacs-20.1-b6 is released. - * XEmacs-19.15-b98 is released. - -Wed Mar 5 18:55:36 1997 Steven L Baur - - * Makefile.in (install-arch-indep): Offer to compress lisp sources. - (gzip-el): New targe for compressed installed lisp sources. - -Tue Mar 4 23:28:37 1997 Martin Buchholz - - * lib-src/update-elc.sh: VM is compiled after the byte-compiler, - but before anything else. More flexible about finding an xemacs - to use for byte-compilation (default src/xemacs). Other minor fixes. - -Mon Mar 3 23:57:56 1997 Steven L Baur - - * XEmacs 20.1-b5 is released. - -Mon Mar 3 18:09:17 1997 Steven L Baur - - * XEmacs 20.1-b4 is released. - -Sat Mar 1 15:38:30 1997 Steven L Baur - - * Makefile.in (distclean): Correct typos. - - * XEmacs 19.15-b96 is released. - - * configure.in: Symlink site-lisp when using --srcdir. - Add special handling of lisp directory to allow for multiple - site-packages files. - -Fri Feb 28 20:38:46 1997 Steven L Baur - - * Makefile.in (distclean): Create lock and site-lisp directories - when they don't exist (after being pruned by CVS). - -Tue Mar 4 00:41:38 1997 Hrvoje Niksic - - * etc/sample.Xdefaults: Added customization of foreground and - background colors for the `default' face. - -Wed Feb 26 22:12:12 1997 Steven L Baur - - * Makefile.in (top_distclean): Reset src/PURESIZE.h for - distribution. - - * XEmacs 20.1-b3 is released. - -Sun Feb 23 17:10:09 1997 Steven L Baur - - * XEmacs 20.1-b2 is released. - -Sat Feb 22 14:29:44 1997 Steven L Baur - - * XEmacs 19-15-b'95 is released. - -Fri Feb 21 22:29:51 1997 Martin Buchholz - - * etc/toolbar/workshop-cap-up.xpm: Moved caption up one pixel. - - * lwlib/xlwscrollbar.c : Fix many scrollbar bugs: - - "knob" renamed to "slider" - - leftmost pixel wasn't sensitive to button clicks, while righmost - pixel was. - - many glitches fixed if Emacs*XlwScrollBar.ArrowPosition:same: - - goobers on top of up-arrow removed. - - up-arrow would not always be redrawn when necessary - - slider drag would be `off' by size of up-arrow - - horizontal and vertical scrollbars didn't use exactly the same - dimensions. - - slider was never drawn if XlwScrollBar.shadowThickness was 0. - - Now up- and down-arrows actually work near beginning/end of buffer! - -Thu Feb 20 12:40:57 1997 Jan Vroonhof - - * configure.in (with_xauth): Attempted correction of test for - libXmu on SunOS. - -Sat Feb 15 14:11:03 1997 Steven L Baur - - * XEmacs 20.1-b1 is released. - * XEmacs 19.15-b94 is released. - -Fri Feb 14 23:23:03 1997 Steven L Baur - - * README: ``This directory tree holds version 19.13 ...'' ??? - -Sun Feb 9 16:15:55 1997 Steven L Baur - - * XEmacs 19.15-b93 is released. - XEmacs 20.0 is released to the 'net. - -Fri Feb 7 19:21:34 1997 Steven L Baur - - * XEmacs 20.0try3 is released. - -Wed Feb 5 18:03:06 1997 Steven L Baur - - * XEmacs 20.0try2 is released. - -Mon Feb 3 19:39:08 1997 Steven L Baur - - * XEmacs 19.15-b92 is released. - -Sat Feb 1 18:17:38 1997 Steven L Baur - - * XEmacs 20.0try1 is released. - * XEmacs 19.15-b91 AKA XEmacs '97 NOT! is released. - -Sat Feb 1 00:00:48 1997 Steven L Baur - - * PROBLEMS: Updated from beta test bug reports. - Put in outline-mode/outl-mouse-minor-mode by default. - -Wed Jan 29 19:59:41 1997 Steven L Baur - - * CHANGES-beta: XEmacs 20.0-b93 is released. - -Sat Jan 25 15:43:59 1997 Steven L Baur - - * CHANGES-beta: XEmacs 20.0-b92 is released. - -Fri Jan 24 09:54:01 1997 Steven L Baur - - * lwlib/xlwmenu.c (massage_resource_name): Changed comparison of - char and pointer. - -Thu Jan 23 10:39:34 1997 Martin Buchholz - - * lib-src/update-elc.sh (ignore_dirs): Quoting portability. - -Wed Jan 22 21:07:17 1997 Steven L Baur - * XEmacs 20.0-b91 (prerelease 2) is released. - - * configure.in (--with-scrollbars): Add Athena3d as a toolkit - type. - - * lwlib/lwlib-Xaw.c (xaw_update_one_widget): Let Athena 3d have 0 - borderwidth. - (xaw_scrollbar_scroll): Use SCROLLBAR_LINE_UP and - SCROLLBAR_LINE_DOWN since that's current the only to get to the - bottom of the buffer. :-( - -Tue Jan 21 20:01:19 1997 Steven L. Baur - - * configure.in (beta): Add LWLIB_USES_ATHENA for odd - configurations that use both Motif and Athena. - - * etc/sgml/HTML32.dtd: html-3.2 final dtd added. - -Wed Jan 15 12:55:19 1997 Steven L Baur - - * info/dir (Gnus): Updated spelling and info. - -Mon Jan 13 13:37:27 1997 Steven L Baur - - * configure.in: Remove assignment of NON_GNU_CPP for irix-6.0. - -Mon Jan 13 00:36:01 1997 Martin Buchholz - - * lib-src/make-docfile.c (scan_lisp_file): eliminate doc-string - warnings for ccl-read-* - -Sat Jan 11 12:05:31 1997 Steven L Baur - - * etc/sample.emacs: Remove code snippet that wipes out the cycle - buffer modeline feature. - - * XEmacs 20.0 beta90 (prerelease 1) is released. - * XEmacs 19.15 beta90 (prerelease 1) is released. - -Tue Jan 7 08:45:16 1997 Steven L Baur - - * configure.in (LIBS): Revise test for XFree86 (look for XF86Config). - -Sat Jan 4 14:52:57 1997 Steven L Baur - * XEmacs 20.0 beta 34 is released. - * XEmacs 19.15 beta 7 is released. - -Fri Jan 3 15:18:59 1997 Jeff Miller - - * lwlib/Makefile.in.in: lwlib is required if X11 is used. - -Wed Jan 1 08:30:48 1997 Martin Buchholz - - * src/emacs.c: Make sure - `./temacs -batch -l loadup.el run-temacs ' - works properly - - * src/Makefile.in.in (rtcmacs): Add support for RTC, Sun's - competitor to Purify. - - * man/lispref/symbols.texi: Fix up bit vector documentation - * man/lispref/sequences.texi: Fix up bit vector documentation - - * lisp/sunpro/sunpro-load.el: Only preload mime-setup for Sun. - - * lisp/prim/update-elc.el: Don't rely on autoloads. - -Tue Dec 31 09:46:13 1996 Martin Buchholz - - * lisp/prim/auto-autoloads.el: New, completely program-generated, file - * lib-src/update-autoloads.sh: Rewritten to use auto-autoloads.el. - * lisp/utils/autoload.el: Reorganization of autoload mechanism: - Errors during autoload generation are just that - errors. - - Generated autoloads are now in a separate file of their own. - - Reliability of autoload generation greatly increased. - - Distribution smaller by about 100k. - - `make autoloads' is still the preferred mechanism for update. - - Autoloads are always regenerated completely from scratch. This - avoids errors with obsolete or corrupted autoload entries. - - Caching of autoload entries using timestamps has been eliminated. - - Files that have no autoloads no longer have a comment placed into - the generated autoloads file. - - There was a bug where autoload entries would sometimes end up - being inserted into the *middle* of other autoload entries, - thereby corrupting them. - - * src/event-Xt.c: Remove SUNOS_GCC_L0_BUG kludge. - -Sun Dec 29 05:37:43 1996 Martin Buchholz - - * lib-src/update-autoloads.sh: Make sure that `make autoloads' - doesn't use the autoload facility to load `autoload'; - load it explicity instead. - - * lib-src/update-elc.sh (ignore_dirs): ignore SCCS, CVS, RCS dirs - - * man/Makefile: Reinstate hyperbole & oo-browser manuals - - * lisp/modes/mail-abbrevs.el: Apply patch originated from Noah Friedman - - * src/mule-charset.c: Use lower case for charset registry, to - match XLFD. - - * Makefile.in: replace list of info files with *.info* - one less - maintenance headache - - * etc/sample.emacs: Add sample code to highlight continuation glyph - - * man/oo-browser.texi: Fix TeXability - - * man/hyperbole.texi: Fix TeXability - - * man/vhdl-mode.texi: Fix TeXability - - * lisp/prim/loaddefs.el: Wholesale housecleaning - `make autoloads' should finally work. - - * lib-src/emacsclient.c (main): ANSIfication, compiler warning removal - - * lisp/mule/mule-files.el: Add support for multi-lingual info files. - - * lib-src/update-elc.sh: `make all-elc' was updating files in - `special' directories without using the Makefiles - designed for that purpose. - - make sure ilisp isn't remade every time through `make all-elc'. - - * info/dir (Packages): Add Japanese TM info files - - * src/inline.c: Allow compilation with `gcc -g' - - * src/syntax.c (word_constituent_p): Allow compilation with `gcc -g' - - * src/lread.c: Don't put `...' immediately after a filename, so - that various tools can recognize the filename as such. - - * src/event-Xt.c (x_to_emacs_keysym): Fix crash when - --with-xim=xlib and key event on window frame. - Change return foo to return (foo) when return is a macro. - - * src/editfns.c (Ffollowing_char): docstring fixes. - - * man/tm/Makefile: Add support for Japanese TM info (but not dvi) files. - This Makefile is no longer officially broken. - - * info/dir: Add Japanese tm documents. - - * man/tm/tm-vm-en.texi: Make document TeX-friendly. - - * lib-src/update-autoloads.sh (EMACS): Don't rely on non-portable - xargs -i flag. - - * lisp/mule/mule-files.el (file-coding-system-alist): Make sure - the `binary' coding system is used for .gz and .Z extensions. - - * man/viper.texi: Viper version 2.90 - - * man/ediff.texi: Ediff Version 2.62 - - * lisp/packages/ispell.el (ispell-word): Avoid using strings with - define-key, for compatibility with loaddefs.el - - * lisp/modes/eiffel3.el: Make compatible with update-autoloads. - - * lisp/ilisp/Makefile (elc): Add target to avoid re-compilation. - - * lib-src/update-elc.sh: XEmacs sometimes re-byte-compiled elisp - files in dirs that have their own Makefiles. - - - -Sun Dec 29 17:02:49 1996 Steven L Baur - - * Makefile.in (install-arch-indep): Force compression with `gzip -f'. - - * lib-src/update-elc.sh (NUMTOCOMPILE): Ignore CVS directories. - - * Makefile.in (install-arch-indep): Catch .info-[0-9]* files for - installation. - -Sat Dec 28 15:33:27 1996 Steven L Baur - - * XEmacs 20.0 beta 33 is released. - * XEmacs 19.15 beta 6 is released. - -Fri Dec 27 20:34:58 1996 Richard Mlynarik - - * etc/yow.lines: 20k of new zippy quotes. - -Fri Dec 27 01:02:41 1996 Martin Buchholz - - * Makefile.in (install-arch-indep): Simplify installation of info - pages. - -Sat Dec 21 15:20:20 1996 Steven L Baur - * XEmacs 20.0-b32 released. - - * XEmacs 19.15-b5 released. - -Wed Dec 18 20:22:08 1996 Martin Buchholz - - * configure.in: Reformat. Fix shared include file rename - problem. - - * configure: Reformat. Fix shared include file rename problem. - - * dynodump/dynodump.c (__EXTENSIONS__): Define it. - -Thu Dec 12 13:19:00 1996 Joseph J Nuspl - - * Makefile.in (install-arch-indep): Install infofiles gzipped by - default. - -Tue Dec 10 19:25:25 1996 Steven L Baur - - * CHANGES-beta: XEmacs 20.0-b31 is released. - -Tue Dec 10 18:33:19 1996 Rod Whitby - - * info/vhdl-mode.info: New file. - - * info/dir (Packages): Add vhdl-mode documentation. - -Tue Dec 10 18:27:02 1996 Martin Buchholz - - * configure: Make shared/dynamic flags work much more logically. - -Tue Dec 10 09:17:22 1996 David Worenklein - - * configure.in (machine): Patch to make newly renamed shared - link include files work. - -Sat Dec 7 16:28:10 1996 Martin Buchholz - - * configure.in: Configure for POSIX getcwd if available. - -Thu Dec 5 20:42:35 1996 Steven L Baur - - * etc/edt-user.doc (File): New file from Emacs 19.34. - -Thu Dec 5 11:56:05 1996 Joseph J Nuspl - - * configure.in (LIBS): Fix typo in dialog box test. - - diff --git a/INSTALL b/INSTALL deleted file mode 100644 index 88a377f..0000000 --- a/INSTALL +++ /dev/null @@ -1,780 +0,0 @@ -XEmacs Installation Guide -Copyright (c) 1994, 1995, 1996 Board of Trustees, University of Illinois -Copyright (c) 1994 Free Software Foundation, Inc. - -Synched up with: FSF 19.30. - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and permission notice are preserved, - and that the distributor grants the recipient permission - for further redistribution as permitted by this notice. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last changed them, - and that any new or changed statements about the activities - of the Free Software Foundation are approved by the Foundation. - - -BUILDING AND INSTALLATION (Unix and Cygwin, see the file nt/README -for instructions on building under Microsoft Windows): - -1) Make sure your system has enough swapping space allocated to handle - a program whose pure code is 900k bytes and whose data area is at - least 400k and can reach 8Mb or more. If the swapping space is - insufficient, you will get an error in the command `temacs -batch - -l loadup dump', found in `./src/Makefile.in.in', or possibly when - running the final dumped XEmacs. - -Building XEmacs requires about 41 Mb of disk space (including the -XEmacs sources). Once installed, XEmacs occupies about 16 Mb in the -file system where it is installed; this includes the executable files, -Lisp libraries, miscellaneous data files, and on-line documentation. -The amount of storage of the Lisp directories may be reduced by -compressing the .el files. If the building and installation take place -in different directories, then the installation procedure temporarily -requires 41+16 Mb. Adjust this value upwards depending upon what -additional Lisp support is installed. - -XEmacs requires an ANSI C compiler, such as GCC. If you wish to build -the documentation yourself, you will need at least version 1.68 of -makeinfo (GNU texinfo-3.11). - - -2) Decide on what other software packages you would like to use with -XEmacs, but are not yet available on your system. On some systems, -Motif and CDE are optional additions. On Solaris, the SUNWaudmo -package enables native sound support. There are also a number of free -software packages that XEmacs can use. If these are not yet available -on your system, obtain, build and install those external packages -before building XEmacs. The packages XEmacs can use are: - - Xaw3d, XPM, JPEG, compface, PNG, zlib, GNU DBM, Berkeley DB, socks, - term, NAS, Canna, Kinput2, SJ3, Wnn. - -You can get (most of) them from the XEmacs ftp site at -ftp://ftp.xemacs.org/pub/xemacs/aux - -If you want users on other systems to be able to use the XEmacs you -have built, try to build those packages so that the generated -libraries are statically linked. - -Use the --site-includes and --site-libraries options when building -XEmacs to allow configure to find the external software packages. -If you link with dynamic (``.so'') external package libraries, which -is not recommended, you will also need to add the library directories -to the --site-runtime-libraries option. - - -3) Decide what Initial Lisp you need with XEmacs. XEmacs is -distributed separately from most of its runtime environment. This is -done to make it easier for administrators to tune an installation for -what the local users need. See the file etc/PACKAGES for an overview -of what is available and which packages need to be installed prior to -building XEmacs. At this point you only need a minimum to get started -at which point you may install what you wish without further changes -to the XEmacs binary. A sample minimum configuration for a Linux -system using Mule and Wnn6 from OMRON corporation would be the -packages `mule-base' and `egg-its'. By default, packages will be -searched for in the path - -~/.xemacs::$prefix/lib/xemacs-${version}/mule-packages:$prefix/lib/xemacs/mule-packages:$prefix/lib/xemacs-${version}/xemacs-packages:$prefix/lib/xemacs/xemacs-packages - -This may be changed by specifying a different value with the ---package-path configuration option. - -4) In the top level directory of the XEmacs distribution, run the - program `configure' as follows: - - ./configure [CONFIGURATION-NAME] [--OPTION[=VALUE]] ... - -Almost always, you should let `configure' (actually the shell script -`config.guess') guess your host type, by omitting the -CONFIGURATION-NAME argument. If you like to experiment, specify a -configuration name in the form MACHINE-VENDOR-OPSYS, for example: - -sparc-sun-solaris2.6 - -See config.guess and configure.in for valid values for MACHINE, -VENDOR, and OPSYS. Also check `./etc/MACHINES' for advice on building -on particular machines. - -If you don't want X support, specify `--without-x'. If you omit this -option, `configure' will try to autodetect whether your system has X, -and arrange to use it if present. - -The `--x-includes=DIR' and `--x-libraries=DIR' options tell the build -process where the compiler should look for the include files and -object libraries used with the X Window System. Normally, `configure' -is able to find them; these options are necessary if you have your X -Window System files installed in unusual places. - -The `--site-includes=DIR' and `--site-libraries=DIR' options allow you -to specify additional places the compiler should look for include -files and object libraries. You may specify multiple DIR's by -enclosing the list in quotes. All the external packages you want to -use with XEmacs (e.g. xpm, wnn, ...) described later should have their -include and library directories defined using these options. - -The `--site-runtime-libraries=DIR' option specifies directories to -search for shared libraries at run time. This may be necessary if you -link with dynamic libraries that are installed in non-standard -directories, or if you expect some of the libraries used to build -XEmacs to be in a different directory at run time than at build time. -Usually this will add a `-R' to each directory specified and use that -when linking XEmacs. If you use this option, you must specify ALL of -the directories containing shared libraries at run time, including -system directories. - -Rationale: Some people think that directories in --site-libraries -should be automatically used to update --site-runtime-libraries. -Here's a real-life scenario that explains why this is not done: You -build binaries for your company using static libs in -/net/toy/hack/lib. XEmacs adds /net/toy/hack/lib to the runpath of -the executable you've built. Since there are only static libs there, -the system runtime loader will look in this dir, and ignore it, -causing only a .01 second delay in starting XEmacs. You leave the -company for a job at a small Silicon Valley startup. Time passes. -The next guy who inherits your machine objects to working on a machine -named `toy', and gets the sysadmin to rename the machine `godzilla'. -The SA forgets to remove the old entry for `toy' from the hosts file. -Now the system loader will still try to access /net/toy/, and the -automounter will hang trying to access /net/toy. XEmacs suddenly -takes 30 seconds longer to start up, no one can figure out why, and -everyone at your old company curses your name, thinking that you've -put a time bomb into XEmacs. And they're right! - -The `--with-gcc' option specifies that the build process should -compile XEmacs using GCC. The `--compiler' option allows you to -specify some other compiler to be used to compile XEmacs. If neither -option is specified, the environment variable CC is used instead. -Otherwise the compiler will then default to 'cc'. - -The `--cflags' option specifies the CFLAGS the build process should -use when compiling XEmacs. Otherwise the value of the environment -variable CFLAGS is consulted. If that is also undefined, CFLAGS -defaults to "-g -O" for gcc and "-g" for all other compilers. - -The `--dynamic' option specifies that configure should try to link -emacs dynamically rather than statically. - -The `--const-is-losing' option is for use if you have trouble -compiling due to the `const' storage class in C. This is defined by -default. Most users should have no need to change this. - -You can build XEmacs for several different machine types from a single -source directory. To do this, you must use a version of `make' that -supports the `VPATH' variable, such as GNU `make'. Make separate -build directories for the different configuration types, and in each -one, run the XEmacs `configure' script. `configure' looks for the -Emacs source code in the directory that `configure' is in. - -The `--prefix=PREFIXDIR' option specifies where the installation process -should put XEmacs and its data files. This defaults to `/usr/local'. -- XEmacs (and the other utilities users run) go in PREFIXDIR/bin - (unless the `--exec-prefix' option says otherwise). -- The architecture-independent files go in PREFIXDIR/lib/xemacs-VERSION - (where VERSION is the version number of XEmacs, like `21.0'). -- The architecture-dependent files go in - PREFIXDIR/lib/xemacs-VERSION/CONFIGURATION-NAME - (where CONFIGURATION-NAME is the host type, like mips-dec-ultrix4.2), - unless the `--exec-prefix' option says otherwise. - -The `--exec-prefix=EXECDIR' option allows you to specify a separate -portion of the directory tree for installing architecture-specific -files, like executables and utility programs. If specified, -- XEmacs (and the other utilities users run) go in EXECDIR/bin, and -- The architecture-dependent files go in - EXECDIR/lib/xemacs-VERSION/CONFIGURATION-NAME. -EXECDIR/bin should be a directory that is normally in users' PATHs. - -For example, the command - - ./configure mips-dec-ultrix --with-x11=yes - -configures XEmacs to build for a DECstation running Ultrix, with -support for the X11 window system. - -The `--with-menubars=TYPE' option allows you to specify which X -toolkit you wish to use for the menubar. The valid options are -`lucid', `motif' and `no'. The default is `lucid' which is a -Motif-lookalike menubar. We highly recommend its usage over the real -Motif menubar. (In fact, the Motif menubar is currently broken.) If -`no' is specified then support for menubars will not be compiled in. - -The `--with-scrollbars=TYPE' option allows you to specify which X -toolkit you wish to use for the scrollbars. The valid options are -`lucid', `motif', `athena', `athena3d', and `no'. The default is -`lucid' which is a Motif-lookalike scrollbar. If `no' is specified -then support for scrollbars will not be compiled in. - -The `--with-dialogs=TYPE' option allows you to specify which X toolkit -you wish to use for the dialog boxes. The valid options are `athena', -`athena3d', `motif, and `no. The `lucid' option is accepted and will -result in the `athena' toolkit being used. If the Motif toolkit can be -found the default is `motif'. Otherwise, the default is `athena'. If -`no' is specified then support for dialog boxes will not be compiled -in. - -The `--with-toolbars' option allows you to enable or disable toolbar -support. The default is `yes' as long as support for a windowing -system is included. - -The `--with-xpm' option specifies that XEmacs should support X11 -Pixmaps. `configure' will attempt to detect if you have the Xpm -libraries and define `--with-xpm' for you. - -The `--with-xface' option specifies that XEmacs should support -X-Faces. `configure' will attempt to detect if you have the compface -library and define `--with-xface' for you. - -The `--with-database' option specifies that XEmacs should be built -with additional database support. The valid options are `no' or a -comma-separated list of one or more of `dbm', `gnudbm' or `berkdb'. -`configure' will attempt to detect the necessary libraries and header -files and define `--with-database' for you. - -The `--with-socks' option specifies that XEmacs should be built with -SOCKS support. This requires the libsocks library. - -The `--with-tooltalk' option specifies that XEmacs should be built -with ToolTalk support for interconnecting with other applications. -ToolTalk is not yet supported on all architectures. If you use this -option, you should have the tooltalk package (see etc/PACKAGES) -installed prior to building XEmacs. - -The `--with-sparcworks' option specifies that XEmacs should be built -with support for Sun Sparcworks 3.0.1 and up (including Sun WorkShop). -This functionality is only of use on SunOS 4.1.x and Solaris 2.x -systems. If you use this option, you should have the Sun package (see -etc/PACKAGES) installed prior to building XEmacs. - -The `--with-cde' option allows you to enable or disable CDE drag and -drop support. `configure' will attempt to detect this option and -define `--with-cde' for you. - -The `--with-offix' option allows you to enable or disable OffiX drag -and drop support. This requires no external library support, so if -X11 support is available, then this option defaults to `yes'. OffiX -support can be explicitly disabled via the `--with-offix=no' option. - -The `--external-widget' option specifies that XEmacs should be built -with support for being used as a widget by other X11 applications. -This functionality should be considered beta. - -The `--without-xmu' option can be used if your vendor doesn't ship -the Xmu library. - -The `--puresize' option can be used to change the amount of purespace -allocated for the dumped XEmacs. As of XEmacs 20.1 usage of this -parameter is deprecated and will be ignored. - -The `--with-sound=TYPE' option specifies that XEmacs should be built -with sound support. Native (`--with-sound=native') sound support is -currently available only on Sun SparcStations, SGI's, HP9000s, and -systems (such as Linux) with soundcard.h. Network Audio Support (NAS) -(`--with-sound=nas' or `--with-sound=both') is an extension to X that -you may or may not have for your system. For NAS, you will probably -need to provide the paths to the nas include and library directories -to configure. If `--with-sound' is not specified, `configure' will -attempt to determine if your configuration supports native sound and -define --with-sound for you. If your native sound library is not in a -standard location you can specify it with the `--native-sound-lib=LIB' -flag. For Linux, `/dev/audio' is required for SunAudio files and -`/dev/dsp' is required for raw data and WAVE format files. - -The `--rel-alloc' option can be used to either enable or disable use -of the relocating allocator. Turning on --rel-alloc will allow XEmacs -to return unused memory to the operating system, thereby reducing its -memory footprint. However, it may make XEmacs runs more slowly, -especially if your system's `mmap' implemntation is missing or -inefficient. Generally, it's best to go with the default -configuration for your system. You can tweak this based on how you -use XEmacs, and the memory and cpu resources available on your system. - -The `--use-system-malloc' option can be use to either enable or -disable use of the system malloc. Generally, it's best to go with the -default configuration for your system. Note that on many systems -using the system malloc disables the use of the relocating allocator. - -The `--use-debug-malloc' option can be used to link a special debugging -version of malloc. Debug Malloc is not included with XEmacs, is -intended for use only by the developers and may be obtained from -. - -The `--debug' and `--error-checking' options are intended for use only -by the developers. `--debug' adds code to be compiled in for -performing various tests. `--error-checking' adds additional tests to -many of the commonly used macros. - -The `--verbose' and `--extra-verbose' options are intended for use -only by the developers. `--verbose' causes the results of all -configure tests to be displayed. `--extra-verbose' displays -additional information, useful for debugging. Another help for -determining configure failures is the file `config.log', which -contains the results of the compile and link tests used by configure. - -The `--with-mule' option enables (MUlti-Lingual Emacs) support, needed -to suport non-Latin-1 (including Asian) languages. The Mule support -is not yet as stable or efficient as the `Latin1' support. Enabling -Mule support requires the mule-base package installed prior to -building XEmacs. The following options require Mule support: - -The `--with-xim' option enables use of the X11 XIM mechanism to allow -an input method to input text into XEmacs. The input method is shared -among all the X applications sharing an X display and using the same -language. The XIM support comes in two flavors: `motif' and `xlib'. -The Motif support (the XmIm* functions) is preferred when available. -The xlib XIM support works reasonably well so long as the X11 libraries -are recent enough. It has been fairly well tested on Linux with glibc -2.0.5 and 2.0.6 and Kinput2 as an XIM server. In this configuration -X11 must be recompiled with X_LOCALE defined because glibc is lacking -localization for Japanese. The XIM support defaults to `no' except -when Motif is detected where it is stable with OSF libraries. The XIM -support in Lesstif (a Free Motif replacement) does not work as of -v0.82. If you enable this option, you will probably wish to install -the `locale' package which contains localized Splash screens and -Menubars. - -The `--with-xfs' option enables use of a multilingual Menubar. At the -present time, only Japanese and French locales are supported. In -order to use a multilingual Menubar you must have the `locale' package -installed. The `locale' package does not have to be installed when -building XEmacs. - -The `--with-canna' option enables the use of the Canna Japanese input -method. This is stable code and fairly well tested. In order to use -it, you will have to have the Canna server installed and running. -Canna versions 3.2pl2 and 3.5b2 are known to work. Version 3.2pl2 is -considered most stable than version 3.5b2. If Canna is already -installed, configure will autodetect it, so you never need to -explicitly use this option unless your Canna libraries are somewhere -strange. Canna run time support is currently bundled with the -`mule-base' package so there is nothing additional to install in order -to use it. - -The `--with-wnn' and `--with-wnn6' options are for compiling with the Wnn -multi-language input method. `--with-wnn' is for compiling with Wnn-4.2, -the Free version of WNN. `--with-wnn6' is for compiling against WNN6, -the commercial version of WNN available from OMRON Corporation. This is -stable code and fairly well tested. In order to build with this -option, you will need to have the `egg-its' lisp package already -installed. - -Please note that it is safe to build with as many of the options -`--with-xim', `--with-canna' and `--with-wnn' as your system -supports. - -`configure' doesn't do any compilation or installation itself. It -just creates the files that influence those things: `./src/config.h', -and all the Makefile's in the build tree. - -The `--with-pop', `--with-hesiod', and `--with-kerberos' options are used -in conjunction with movemail. As of XEmacs 20.1, movemail is identical -to the one used in Emacs. - -When it is done, `configure' prints a description of what it did and -creates a shell script `config.status' which, when run, recreates the -same configuration. If `configure' exits with an error after -disturbing the status quo, it removes `config.status'. - -4) Look at `./lisp/paths.el'; if some of those values are not right -for your system, set up the file `./lisp/site-init.el' with XEmacs -Lisp code to override them; it is not a good idea to edit paths.el -itself. YOU MUST USE THE LISP FUNCTION `setq' TO ASSIGN VALUES, -rather than `defvar', as used by `./lisp/paths.el'. For example, - - (setq news-inews-program "/usr/bin/inews") - -is how you would override the default value of the variable -news-inews-program (which is "/usr/local/inews"). - -Before you override a variable this way, *look at the value* that the -variable gets by default! Make sure you know what kind of value the -variable should have. If you don't pay attention to what you are -doing, you'll make a mistake. - -Things may malfunction if the variable `directory-abbrev-alist' is not -set up to translate "temporary" automounter mount points into the -canonical form. XEmacs tries to detect how your automounter is -configured. If you have an unusual automounter configuration that -XEmacs cannot detect, you may need to change the value of -`directory-abbrev-alist'. - -5) Put into `./lisp/site-init.el' or `./lisp/site-load.el' any Emacs -Lisp code you want XEmacs to load before it is dumped out. Use -site-load.el for additional libraries if you arrange for their -documentation strings to be in the lib-src/DOC file (see -src/Makefile.in.in if you wish to figure out how to do that). For all -else, use site-init.el. - -If you set load-path to a different value in site-init.el or -site-load.el, XEmacs will use *precisely* that value when it starts up -again. If you do this, you are on your own! - -Note that, on some systems, the code you place in site-init.el must -not use expand-file-name or any other function which may look -something up in the system's password and user information database. -See `./PROBLEMS' for more details on which systems this affects. - -The `site-*.el' files are nonexistent in the distribution. You do not -need to create them if you have nothing to put in them. - -6) Refer to the file `./etc/TERMS' for information on fields you may -wish to add to various termcap entries. The files `./etc/termcap.ucb' -and `./etc/termcap.dat' may already contain appropriately-modified -entries. - -7) Run `make' in the top directory of the XEmacs distribution to finish -building XEmacs in the standard way. The final executable file is -named `src/emacs'. You can execute this file "in place" without -copying it, if you wish; then it automatically uses the sibling -directories ../lisp, ../lib-src, ../info. - -Or you can "install" the executable and the other XEmacs into their -installed locations, with `make install'. By default, XEmacs's files -are installed in the following directories: - -By default, XEmacs installs its files in the following directories: - -`/usr/local/bin' holds the executable programs users normally run - - `xemacs', `etags', `ctags', `b2m', `emacsclient', `ellcc', - `gnuclient', `gnudoit', `gnuattach', and `rcs-checkin'. - -`/usr/local/lib/xemacs-VERSION/lisp' holds the Emacs Lisp libraries; - `VERSION' stands for the number of the XEmacs version - you are installing, like `18.59' or `19.14'. Since - the lisp libraries change from one version of XEmacs to - another, including the version number in the path - allows you to have several versions of XEmacs installed - at the same time; this means that you don't have to - make XEmacs unavailable while installing a new version. - - XEmacs searches for its lisp files in these - directories, and then in - `/usr/local/lib/xemacs/site-lisp/*'. - -`/usr/local/lib/xemacs-VERSION/etc' holds the XEmacs tutorial, the - `yow' database, and other architecture-independent - files XEmacs might need while running. VERSION is as - specified for `.../lisp'. - -`/usr/local/lib/xemacs/lock' contains files indicating who is - editing what, so XEmacs can detect editing clashes - between users. - -`/usr/local/lib/xemacs-VERSION/CONFIGURATION-NAME' contains executable - programs used by XEmacs that users are not expected to - run themselves, and the DOC file. `VERSION' is the - number of the XEmacs version you are installing, and - `CONFIGURATION-NAME' is the host type of your system. - Since these files are specific to the version of - XEmacs, operating system, and architecture in use, - including the configuration name in the path allows - you to have several versions of XEmacs for any mix of - machines and operating systems installed at the same - time; this is useful for sites at which different - kinds of machines share the file system XEmacs is - installed on. - -`/usr/local/lib/xemacs-VERSION/CONFIGURATION-NAME/modules' holds the Emacs - dynamically loadable modules. These are special programs - typically written in C that can be loaded in much the same - way that Lisp packages are. Not all systems support - dynamic modules, so do not be alarmed if this directory - does not exist or is empty. - - XEmacs searches for modules in this directory, or any - sub-directory of it, and then in - `/usr/local/lib/xemacs/site-modules/*'. - -`/usr/local/lib/xemacs-VERSION/info' holds the on-line documentation - for XEmacs, known as "info files". - -`/usr/local/man/man1' holds the man pages for the programs installed - in `/usr/local/bin'. - -If these directories are not what you want, you can specify where to -install XEmacs's libraries and data files or where XEmacs should search -for its lisp files by giving values for `make' variables as part of -the command. See the section below called `MAKE VARIABLES' for more -information on this. - -Using GNU Make allows for simultaneous builds with and without the ---srcdir option. - -8) If your system uses lock files to interlock access to mailer inbox files, -then you might need to make the movemail program setuid or setgid -to enable it to write the lock files. We believe this is safe. -The setuid/setgid bits need not be set on any other XEmacs-related -executables. - -9) You are done with the hard part! You can remove executables and -object files from the build directory by typing `make clean'. To also -remove the files that `configure' created (so you can compile XEmacs -for a different configuration), type `make distclean'. - -10) You should now go to the XEmacs web page at http://www.xemacs.org/ -and decide what additional Lisp support you wish to have. - -MAKE VARIABLES - -You can change where the build process installs XEmacs and its data -files by specifying values for `make' variables as part of the `make' -command line. For example, if you type - - make install bindir=/usr/local/gnubin - -the `bindir=/usr/local/gnubin' argument indicates that the XEmacs -executable files should go in `/usr/local/gnubin', not -`/usr/local/bin'. - -Here is a complete list of the variables you may want to set. - -`bindir' indicates where to put executable programs that users can - run. This defaults to /usr/local/bin. - -`datadir' indicates where to put the architecture-independent - read-only data files that XEmacs refers to while it runs; it - defaults to /usr/local/lib. We create the following - subdirectories under `datadir': - - `xemacs-VERSION/lisp', containing the XEmacs lisp libraries, and - - - `xemacs-VERSION/etc', containing the XEmacs tutorial and the - `yow' database. - `VERSION' is the number of the XEmacs version you are installing, - like `18.59' or `19.14'. Since these files vary from one version - of XEmacs to another, including the version number in the path - allows you to have several versions of XEmacs installed at the - same time; this means that you don't have to make XEmacs - unavailable while installing a new version. - -`statedir' indicates where to put architecture-independent data files - that XEmacs modifies while it runs; it defaults to - /usr/local/lib as well. We create the following - subdirectories under `statedir': - - `xemacs/lock', containing files indicating who is editing - what, so XEmacs can detect editing clashes between - users. - -`libdir' indicates where to put architecture-specific data files that - XEmacs refers to as it runs; it too defaults to `/usr/local/lib'. - We create the following subdirectories under `libdir': - - `xemacs-VERSION/CONFIGURATION-NAME', containing executable - programs used by XEmacs that users are not expected to run - themselves and the DOC file. - `VERSION' is the number of the XEmacs version you are installing, - and `CONFIGURATION-NAME' is the host type of your system. - Since these files are specific to the version of XEmacs, - operating system, and architecture in use, including the - configuration name in the path allows you to have several - versions of XEmacs for any mix of machines and operating - systems installed at the same time; this is useful for sites - at which different kinds of machines share the file system - XEmacs is installed on. - -`infodir' indicates where to put the info files distributed with - XEmacs; it defaults to `/usr/local/lib/xemacs-VERSION/info'. - -`mandir' indicates where to put the man pages for XEmacs and its - utilities (like `etags'); it defaults to - `/usr/local/man/man1'. - -`prefix' doesn't give a path for any specific part of XEmacs; instead, - its value is used to determine the defaults for all the - architecture-independent path variables - `datadir', - `statedir', `infodir', and `mandir'. Its default value is - `/usr/local'; the other variables add on `lib' or `man' to it - by default. - - For example, suppose your site generally places GNU software - under `/usr/users/software/gnusoft' instead of `/usr/local'. - By including - `prefix=/usr/users/software/gnusoft' - in the arguments to `make', you can instruct the build process - to place all of the XEmacs data files in the appropriate - directories under that path. - -`exec_prefix' serves the same purpose as `prefix', but instead - determines the default values for the architecture-dependent - path variables - `bindir' and `libdir'. - -The above variables serve analogous purposes in the makefiles for all -GNU software; here are some variables specific to XEmacs. - -`lispdir' indicates where XEmacs installs and expects its lisp - libraries. Its default value, based on `datadir' (see above), - is `/usr/local/lib/xemacs-VERSION/lisp' (where `VERSION' is as - described above). - -`sitelispdir' indicates where XEmacs should search for lisp libraries - specific to your site. XEmacs checks them in order before - checking `lispdir'. Its default value, based on `datadir' - (see above), is `/usr/local/lib/xemacs/site-lisp'. - -`etcdir' indicates where XEmacs should install and expect the rest of - its architecture-independent data, like the tutorial and yow - database. Its default value, based on `datadir' - (see above), is `/usr/local/lib/xemacs-VERSION/etc' (where - `VERSION' is as described above). - -`lockdir' indicates the directory where XEmacs keeps track of its - locking information. Its default value, based on `statedir' - (see above), is `/usr/local/lib/xemacs/lock'. - -`archlibdir' indicates where XEmacs installs and expects the - executable files and other architecture-dependent data it uses - while running. Its default value, based on `libdir' (see - above), is `/usr/local/lib/xemacs-VERSION/CONFIGURATION-NAME' - (where VERSION and CONFIGURATION-NAME are as described above). - -`moduledir' indicates where XEmacs installs and expects to find - any dynamic modules. Its default value, based on - `archlibdir' (see above) is - `/usr/local/lib/xemacs-VERSION/CONFIGURATION-NAME/modules' - (where VERSION and CONFIGURATION-NAME are as described above). - By their very nature, dynamic loadable modules are architecture- - dependant, and care should be taken not to set this directory - to a system- or architecture-independant directory. - -Remember that you must specify any variable values you need each time -you run `make' in the top directory. If you run `make' once to build -xemacs, test it, and then run `make' again to install the files, you -must provide the same variable settings each time. To make the -settings persist, you can edit them into the `Makefile' in the top -directory, but be aware that running the `configure' program erases -`Makefile' and rebuilds it from `Makefile.in'. - -The top-level Makefile stores the variable settings it used in the -Makefiles for the subdirectories, so you don't have to specify them -when running make in the subdirectories. - - -CONFIGURATION BY HAND - -Instead of running the `configure' program, you have to perform the -following steps. - -1) Copy `./src/config.h.in' to `./src/config.h'. - -2) Consult `./etc/MACHINES' to see what configuration name you should -use for your system. Look at the code of the `configure' script to -see which operating system and architecture description files from -`src/s' and `src/m' should be used for that configuration name. Edit -`src/config.h', and change the two `#include' directives to include -the appropriate system and architecture description files. - -2) Edit `./src/config.h' to set the right options for your system. If -you need to override any of the definitions in the s/*.h and m/*.h -files for your system and machine, do so by editing config.h, not by -changing the s/*.h and m/*.h files. Occasionally you may need to -redefine parameters used in `./lib-src/movemail.c'. - -3) If you're going to use the make utility to build XEmacs, you will -still need to run `configure' first, giving the appropriate values for -the variables in the sections entitled "Things `configure' Might Edit" -and "Where To Install Things." Note that you may only need to change -the variables `prefix' and `exec_prefix', since the rest of the -variables have reasonable defaults based on them. For each Makefile -variable of this type, there is a corresponding configure option; for -example, to change the location of the lock directory, you might use - - ./configure --lockdir=/nfs/xemacslock - -The `configure' script is built from `configure.in' by the `autoconf' -program. However, since XEmacs has configuration requirements that -autoconf can't meet, `configure.in' uses a marriage of custom-baked -configuration code and autoconf macros. New versions of autoconf -could very well break this arrangement, so it may be wise to avoid -rebuilding `configure' from `configure.in' when possible. - - -BUILDING XEMACS BY HAND - -Once XEmacs is configured, running `make' in the top directory performs -the following steps. - -1) Run `make src/paths.h' in the top directory. This produces -`./src/paths.h' from the template file `./src/paths.h.in', changing -the paths to the values specified in `./Makefile'. - -2) Cd to `./lib-src' and run `make'. This creates executables named -`ctags' and `etags' and `wakeup' and `make-docfile' and `digest-doc' -and `test-distrib'. And others. - -3) Cd to `./src' and Run `make'. This refers to files in the `./lisp' -and `./lib-src' subdirectories using names `../lisp' and -`../lib-src'. - -This creates a file `./src/xemacs' which is the runnable XEmacs, -assigning it a new build version number by incrementing the build -version stored in `./lisp/version.el'. - -It also creates a file in `./lib-src' whose name is `DOC' followed by -the current XEmacs version. This file contains documentation strings -for all the functions in XEmacs. Each time you run make to make a new -xemacs, a new DOC file with a new name is made. You must keep the DOC -file for an XEmacs version as long as you keep using that XEmacs -version. - - -INSTALLATION BY HAND - -The steps below are done by running `make install' in the main -directory of the XEmacs distribution. - -1) Copy `./lisp' and its subdirectories, `./etc', and the executables -in `./lib-src' to their final destinations, as selected in `./src/paths.h'. - -Strictly speaking, not all of the executables in `./lib-src' need be copied. -- The programs `cvtmail', `emacsserver', `env', `fakemail', `hexl', - `movemail', `timer', `vcdiff', `wakeup', and `yow' are used by - XEmacs; they do need to be copied. -- The programs `etags', `ctags', `emacsclient', `b2m', `rcs2log', - `gnuclient', `gnudoit', and `gnuattach' are intended to be run - by users; they are handled below. -- The programs `make-docfile' and `test-distrib' were - used in building XEmacs, and are not needed any more. -- The programs `digest-doc' and `sorted-doc' convert a `DOC' file into - a file for users to read. There is no important reason to move them. - -2) Copy the files in `./info' to the place specified in -`./lisp/site-init.el' or `./lisp/paths.el'. Note that if the -destination directory already contains a file named `dir', you -probably don't want to replace it with the `dir' file in the XEmacs -distribution. Instead, you should make sure that the existing `dir' -file contains an appropriate menu entry for the XEmacs info. - -3) Create a directory for XEmacs to use for clash detection, named as -indicated by the PATH_LOCK macro in `./src/paths.h'. - -4) Copy `./src/xemacs' to `/usr/local/bin', or to some other directory -in users' search paths. `./src/xemacs' has an alternate name -`./src/emacs-EMACSVERSION'; you may wish to make a symbolic link named -`/usr/local/bin/xemacs' pointing to that alternate name, as an easy way -of installing different versions. - -You can delete `./src/temacs'. - -5) Copy the programs `b2m', `emacsclient', `ctags', `etags', `rcs2log', -`gnuclient', `gnudoit', and `gnuattach' from `./lib-src' to -`/usr/local/bin'. These programs are intended for users to run. - -6) Copy the man pages in `./etc' for xemacs, ctags, etags, and gnuserv -into the appropriate man directories. - -7) The files in the `./src' subdirectory, except for `xemacs', are not -used by XEmacs once it is built. The source would be handy for -debugging. - - -PROBLEMS - -See the file PROBLEMS in this directory for a list of various -problems sometimes encountered, and what to do about them. - - -If all else fails, please see etc/InstallGuide courtesy -of Jonathan Seth Hayward. diff --git a/Makefile.in.in b/Makefile.in.in deleted file mode 100644 index 4daf94e..0000000 --- a/Makefile.in.in +++ /dev/null @@ -1,641 +0,0 @@ -## DIST: This is the distribution Makefile for XEmacs. configure can -## DIST: make most of the changes to this file you might want, so try -## DIST: that first. - -## 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. - -## make all to compile and build XEmacs. -## make install to build and install it. -## make install-only to install after a previous complete build -## make TAGS to update tags tables. - -## make clean or make mostlyclean -## Delete all files from the current directory that are normally -## created by building the program. Don't delete the files that -## record the configuration. Also preserve files that could be made -## by building, but normally aren't because the distribution comes -## with them. - -## Delete `.dvi' files here if they are not part of the distribution. - -## make distclean -## Delete all files from the current directory that are created by -## configuring or building the program. If you have unpacked the -## source and built the program without creating any other files, -## `make distclean' should leave only the files that were in the -## distribution. - -## make realclean -## Delete everything from the current directory that can be -## reconstructed with this Makefile. This typically includes -## everything deleted by distclean, plus more: C source files -## produced by Bison, tags tables, info files, and so on. - -## make extraclean -## Still more severe - delete backup and autosave files, too. - -#ifdef USE_GNU_MAKE -RECURSIVE_MAKE=$(MAKE) -#else -@SET_MAKE@ -RECURSIVE_MAKE=@RECURSIVE_MAKE@ -#endif - -SHELL = /bin/sh -LANG = C -RM = rm -f -pwd = /bin/pwd - -## ==================== Things `configure' Might Edit ==================== - -CC=@CC@ -CPP=@CPP@ -LN_S=@LN_S@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ - -## These help us choose version- and architecture-specific directories -## to install files in. - -## This should be the number of the XEmacs version we're building, -## like `19.12' or `19.13'. -version=@version@ - -## This should be the name of the configuration we're building XEmacs -## for, like `mips-dec-ultrix' or `sparc-sun-sunos'. -configuration=@configuration@ - -## This will be the name of the generated binary and is set automatically -## by configure. -PROGNAME=@PROGNAME@ - -## ==================== Where To Install Things ==================== - -## The default location for installation. Everything is placed in -## subdirectories of this directory. The default values for many of -## the variables below are expressed in terms of this one, so you may -## not need to change them. This defaults to /usr/local. -prefix=@prefix@ - -## Like `prefix', but used for architecture-specific files. -exec_prefix=@exec_prefix@ - -## Where to install XEmacs and other binaries that people will want to -## run directly (like etags). -bindir=@bindir@ - -## Where to install architecture-independent data files. -## ${lispdir} and ${etcdir} are subdirectories of this. -datadir=@datadir@ - -## Where to find XEmacs packages. -pkgdir=@pkgdir@ - -## Where to install and expect the files that XEmacs modifies as it runs. -## These files are all architecture-independent. Right now, the -## only such data is the locking directory; -## ${lockdir} is a subdirectory of this. -statedir=@statedir@ - -## Where to install and expect executable files to be run by XEmacs -## rather than directly by users, and other architecture-dependent data -## ${archlibdir} is a subdirectory of this. -libdir=@libdir@ - -## Where to install XEmacs's man pages, and what extension they should have. -mandir=@mandir@ -manext=.1 - -## Where to install and expect the info files describing XEmacs. In the -## past, this defaulted to a subdirectory of ${prefix}/lib/xemacs, but -## since there are now many packages documented with the texinfo -## system, it is inappropriate to imply that it is part of XEmacs. -infodir=@infodir@ - -## Document me. -## See callproc.c for code which references this. -infopath=@infopath@ - -## Where to find the source code. The source code for XEmacs's C kernel is -## expected to be in ${srcdir}/src, and the source code for XEmacs's -## utility programs is expected to be in ${srcdir}/lib-src. This is -## set by the configure script's `--srcdir' option. -srcdir=@srcdir@ - -## Where the build is done. -blddir=@blddir@ - -## ==================== XEmacs-specific directories ==================== - -## These variables hold the values XEmacs will actually use. They are -## based on the values of the standard Make variables above. - -## Where to install the lisp files distributed with -## XEmacs. This includes the XEmacs version, so that the -## lisp files for different versions of XEmacs will install -## themselves in separate directories. -lispdir=@lispdir@ - -## Where to install the module files distributed with -## XEmacs. This includes the XEmacs version, so that the -## module files for different versions of XEmacs will install -## themselves in separate directories. -moduledir=@moduledir@ - -## Directory XEmacs should search for lisp files specific -## to this site (i.e. customizations), before consulting -## ${lispdir}. -sitelispdir=@sitelispdir@ - -## Directory XEmacs should search for module files specific -## to this site (i.e. customizations), before consulting -## ${moduledir}. -sitemoduledir=@sitemoduledir@ - -## Where XEmacs will search for its lisp files while -## building. This is only used during the process of -## compiling XEmacs, to help XEmacs find its lisp files -## before they've been installed in their final location. -## It's usually identical to lispdir, except that the -## entry for the directory containing the installed lisp -## files has been replaced with ../lisp. This should be a -## colon-separated list of directories. -buildlispdir=${srcdir}/lisp - -## Where to install the other architecture-independent -## data files distributed with XEmacs (like the tutorial, -## the cookie recipes and the Zippy database). This path -## usually contains the XEmacs version number, so the data -## files for multiple versions of XEmacs may be installed -## at once. -etcdir=@etcdir@ - -## Where to create and expect the locking directory, where -## the XEmacs locking code keeps track of which files are -## currently being edited. -lockdir=@lockdir@ - -## Where to put executables to be run by XEmacs rather than -## the user. This path usually includes the XEmacs version -## and configuration name, so that multiple configurations -## for multiple versions of XEmacs may be installed at -## once. -archlibdir=@archlibdir@ - -## ==================== Utility Programs for the Build ==================== - -## Allow the user to specify the install program. -INSTALL = @install_pp@ @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ - -## ============================= Targets ============================== - -## Subdirectories to make recursively. `lisp' is not included -## because the compiled lisp files are part of the distribution -## and you cannot remake them without installing XEmacs first. -MAKE_SUBDIR = @MAKE_SUBDIR@ - -## Subdirectories that can be made recursively. -SUBDIR = ${MAKE_SUBDIR} man - -## The makefiles of the directories in ${MAKE_SUBDIR}. -SUBDIR_MAKEFILES = @SUBDIR_MAKEFILES@ - -## Subdirectories to `make install-arch-dep' recursively -INSTALL_ARCH_DEP_SUBDIR = @INSTALL_ARCH_DEP_SUBDIR@ - -## Subdirectories to install, and where they'll go. -## lib-src's makefile knows how to install it, so we don't do that here. -## When installing the info files, we need to do special things to -## avoid nuking an existing dir file, so we don't do that here; -## instead, we have written out explicit code in the `install' targets. -COPYDIR = ${srcdir}/etc ${srcdir}/lisp -COPYDESTS = ${etcdir} ${lispdir} -GENERATED_HEADERS = src/paths.h src/Emacs.ad.h src/puresize-adjust.h src/config.h lwlib/config.h src/sheap-adjust.h -GENERATED_LISP = lisp/finder-inf.el - -all: ${PROGNAME} all-elc info - -${PROGNAME}: ${GENERATED_HEADERS} ${MAKE_SUBDIR} ${GENERATED_LISP} - -## For performance and consistency, no built-in rules -.SUFFIXES: - -.NO_PARALLEL: ${GENERATED_HEADERS} ${MAKE_SUBDIR} dump-elcs -.PHONY: ${SUBDIR} all beta all-elc all-elcs dump-elc dump-elcs autoloads finder - -## Convenience target for XEmacs beta testers -beta: clean all-elc finder - -## Convenience target for XEmacs maintainers -## This would run `make-xemacsdist' if I were really confident that everything -## was turnkey. -dist: all-elc info - -## Convenience target for XEmacs maintainers -## Updates some rarely generated files: -## - configure from configure.in -## - config.values.in from configure -## - src/depend from src/*.[ch] -.PHONY: config configure depend -config: configure depend -configure: ${srcdir}/configure -${srcdir}/configure: ${srcdir}/configure.in - cd ${srcdir} && autoconf - cd ${srcdir} && /bin/sh lib-src/config.values.sh - -depend ${srcdir}/src/depend: - cd ${srcdir}/src && \ - perl ./make-src-depend > depend.tmp && \ - $(RM) depend && mv depend.tmp depend - -## Build XEmacs and recompile out-of-date and missing .elc files along -## the way. -all-elc all-elcs: lib-src lwlib dump-elcs src - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-elc.sh - -## Sub-target for all-elc. -dump-elc dump-elcs: ${GENERATED_HEADERS} FRC.dump-elcs - cd ./src && $(RECURSIVE_MAKE) dump-elcs - -autoloads: src - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-autoloads.sh - -custom-loads: - MAKE='$(MAKE)' EMACS='./src/$(PROGNAME)' sh ${srcdir}/lib-src/update-custom.sh - -finder: src - @echo "Building finder database ..." - @(cd ./lisp; \ - ${blddir}/src/${PROGNAME} -batch -vanilla \ - -eval '(setq finder-compile-keywords-quiet t)' \ - -l finder -f finder-compile-keywords ) - @echo "Building finder database ...(done)" - -lisp/finder-inf.el: - @echo "Building finder database ..." - @(cd ./lisp; \ - ${blddir}/src/${PROGNAME} -batch -vanilla \ - -eval '(setq finder-compile-keywords-quiet t)' \ - -l finder -f finder-compile-keywords ) - @echo "Building finder database ...(done)" - -## We have to force the building of Emacs.ad.h as well in order to get it -## updated correctly when VPATH is being used. Since we use move-if-change, -## it will only actually change if the user modified ${etcdir}/Emacs.ad. -src/Emacs.ad.h: ${srcdir}/etc/Emacs.ad - @echo "Producing \`src/Emacs.ad.h' from \`etc/Emacs.ad'." - @$(RM) src/Emacs.ad.h - @(echo "/* Do not edit this file!" ; \ - echo " Automatically generated from ${srcdir}/etc/Emacs.ad" ; \ - echo " */" ; \ - /bin/sh ${srcdir}/lib-src/ad2c ${srcdir}/etc/Emacs.ad ) > \ - src/Emacs.ad.h - -src/puresize-adjust.h: ${srcdir}/src/puresize.h - @echo "Resetting \`src/puresize-adjust.h'."; \ - (echo "/* Do not edit this file!" ; \ - echo " Automatically generated by XEmacs */" ; \ - echo "#define PURESIZE_ADJUSTMENT 0") > $@ - -src/sheap-adjust.h: - @echo "Resetting \`src/sheap-adjust.h'."; \ - (echo "/* Do not edit this file!" ; \ - echo " Automatically generated by XEmacs */" ; \ - echo "#define SHEAP_ADJUSTMENT 0") > $@ - -src: @SRC_SUBDIR_DEPS@ FRC.src -pkg-src/tree-x: pkg-src/FRC.tree-x -lib-src: FRC.lib-src -lwlib: FRC.lwlib -dynodump: FRC.dynodump -FRC.src FRC.lib-src FRC.lwlib FRC.dynodump pkg-src/FRC.tree-x: -FRC.lisp.finder-inf.el: - -${SUBDIR}: ${SUBDIR_MAKEFILES} ${GENERATED_HEADERS} FRC - cd ./$@ && $(RECURSIVE_MAKE) all - -Makefile: ${srcdir}/Makefile.in config.status - ./config.status - -src/Makefile: ${srcdir}/src/Makefile.in.in ${srcdir}/src/depend config.status - ./config.status - -lib-src/Makefile: ${srcdir}/lib-src/Makefile.in.in config.status - ./config.status - -lwlib/Makefile: ${srcdir}/lwlib/Makefile.in.in config.status - ./config.status - -pkg-src/tree-x/Makefile: ${srcdir}/pkg-src/tree-x/Makefile.in.in config.status - ./config.status - -src/config.h: ${srcdir}/src/config.h.in - ./config.status && touch $@ - -src/paths.h: ${srcdir}/src/paths.h.in - ./config.status && touch $@ - -lwlib/config.h: ${srcdir}/lwlib/config.h.in - ./config.status && touch $@ - -## ==================== Installation ==================== - -## If we let lib-src do its own installation, that means we -## don't have to duplicate the list of utilities to install in -## this Makefile as well. - -## On AIX, use tar xBf. -## On Xenix, use tar xpf. - -.PHONY: install-only install install-arch-dep install-arch-indep gzip.el mkdir -.PHONY: check-features - -## We delete each directory in ${COPYDESTS} before we copy into it; -## that way, we can reinstall over directories that have been put in -## place with their files read-only (perhaps because they are checked -## into RCS). In order to make this safe, we make sure that the -## source exists and is distinct from the destination. - -## FSF doesn't depend on `all', but rather on ${MAKE_SUBDIR}, so that -## they "won't ever modify src/paths.h". But that means you can't do -## 'make install' right off the bat because src/paths.h won't exist. -## And, in XEmacs case, src/Emacs.ad.h won't exist either. I also -## don't see the point in avoiding modifying paths.h. It creates an -## inconsistency in the build process. So we go ahead and depend on -## all. --cet - -check-features: all - ${blddir}/src/${PROGNAME} -batch -l check-features.el - -install-only: ${MAKE_SUBDIR} check-features install-arch-dep install-arch-indep - -install: all check-features install-arch-dep install-arch-indep - -install-arch-dep: mkdir - for subdir in ${INSTALL_ARCH_DEP_SUBDIR}; do \ - (cd ./$${subdir} && $(RECURSIVE_MAKE) install prefix=${prefix} \ - exec_prefix=${exec_prefix} bindir=${bindir} libdir=${libdir} \ - archlibdir=${archlibdir}) ; done - if test "`(cd ${archlibdir} && $(pwd))`" != \ - "`(cd ./lib-src && $(pwd))`"; then \ - if test -f ../Installation; then \ - ${INSTALL_DATA} ../Installation ${archlibdir}/Installation; \ - fi; \ - for f in DOC config.values; do \ - ${INSTALL_DATA} lib-src/$${f} ${archlibdir}/$${f}; \ - done ; \ - for subdir in `find ${archlibdir} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; \ - do (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; done ; \ - else true; fi - ${INSTALL_PROGRAM} src/${PROGNAME} ${bindir}/${PROGNAME}-${version} - -chmod 0755 ${bindir}/${PROGNAME}-${version} - cd ${bindir} && $(RM) ./${PROGNAME} && ${LN_S} ${PROGNAME}-${version} ./${PROGNAME} - if test "${prefix}" != "${exec_prefix}"; then \ - for dir in \ - lib/${PROGNAME} \ - lib/${PROGNAME}-${version}/etc \ - lib/${PROGNAME}-${version}/info \ - lib/${PROGNAME}-${version}/lisp; do \ - if test ! -d ${exec_prefix}/$${dir}; then \ - $(LN_S) ${prefix}/$${dir} ${exec_prefix}/$${dir}; fi; \ - done; \ - fi - -install-arch-indep: mkdir info - -@set ${COPYDESTS} ; \ - for dir in ${COPYDIR} ; do \ - if test "`(cd $$1 && $(pwd))`" != \ - "`(cd $${dir} && $(pwd))`"; then \ - : do nothing - echo "rm -rf $$1" ; \ - fi ; \ - shift ; \ - done - -set ${COPYDESTS} ; \ - for dir in ${COPYDESTS} ; do \ - if test ! -d $${dir} ; then mkdir $${dir} ; fi ; \ - done ; \ - for dir in ${COPYDIR} ; do \ - dest=$$1 ; shift ; \ - test -d $${dir} \ - -a "`(cd $${dir} && $(pwd))`" != \ - "`(cd $${dest} && $(pwd))`" \ - && (echo "Copying $${dir}..." ; \ - (cd $${dir} && tar -cf - . ) | \ - (cd $${dest} && umask 022 && tar -xf - );\ - chmod 0755 $${dest}; \ - for subdir in `find $${dest} -type d ! -name RCS ! -name SCCS ! -name CVS -print` ; do \ - (cd $${subdir} && $(RM) -r RCS CVS SCCS \#* *~) ; \ - done) ; \ - done - if test "`(cd ${srcdir}/info && $(pwd))`" != \ - "`(cd ${infodir} && $(pwd))`" && cd ${srcdir}/info; then \ - if test ! -f ${infodir}/dir -a -f dir ; then \ - ${INSTALL_DATA} ${srcdir}/info/dir ${infodir}/dir ; \ - fi ; \ - for file in *.info* ; do \ - ${INSTALL_DATA} $${file} ${infodir}/$${file} ; \ - chmod 0644 ${infodir}/$${file}; \ - done ; \ - fi - ## Note it's `xemacs' not ${PROGNAME} - cd ${srcdir}/etc && \ - for page in xemacs etags ctags gnuserv gnuclient gnuattach gnudoit; do \ - ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ - chmod 0644 ${mandir}/$${page}${manext} ; \ - done - @echo "If you would like to save approximately 2M of disk space, do" - @echo "make gzip-el" - @echo "or you may run " - @echo ${srcdir}/lib-src/gzip-el.sh lispdir " from the command line." - @echo "Where lispdir is where the lisp files were installed, i.e.," - @echo "${lispdir}" - -gzip-el: - ${srcdir}/lib-src/gzip-el.sh ${lispdir} - -MAKEPATH=./lib-src/make-path -## Build all the directories to install XEmacs in. -## Since we may be creating several layers of directories, -## (e.g. /usr/local/lib/${PROGNAME}-20.5/sparc-sun-solaris2.6), we use -## make-path instead of mkdir. Not all mkdirs have the `-p' flag. -mkdir: FRC.mkdir - ${MAKEPATH} ${COPYDESTS} ${lockdir} ${infodir} ${archlibdir} \ - ${mandir} ${bindir} ${datadir} ${libdir} ${pkgdir} \ - ${sitelispdir} ${moduledir} ${sitemoduledir} - -chmod 0777 ${lockdir} - -## Delete all the installed files that the `install' target would -## create (but not the noninstalled files such as `make all' would -## create). - -#### Don't delete the lisp and etc directories if they're in the source tree. -#### This target has not been updated in sometime and until it is it -#### would be extremely dangerous for anyone to use it. -##uninstall: -## (cd ./lib-src; \ -## $(RECURSIVE_MAKE) uninstall \ -## prefix=${prefix} exec_prefix=${exec_prefix} \ -## bindir=${bindir} libdir=${libdir} archlibdir=${archlibdir}) -## for dir in ${lispdir} ${etcdir} ; do \ -## case `(cd $${dir} ; $(pwd))` in \ -## `(cd ${srcdir} ; $(pwd))`* ) ;; \ -## * ) $(RM) $${dir} ;; \ -## esac ; \ -## case $${dir} in \ -## ${datadir}/${PROGNAME}/${version}/* ) \ -## $(RM) -r ${datadir}/${PROGNAME}/${version} \ -## ;; \ -## esac ; \ -## done -## cd ${infodir} && $(RM) cl* ${PROGNAME}* forms* info* vip* -## cd ${mandir} && $(RM) xemacs.1 etags.1 ctags.1 gnuserv.1 -## cd ${bindir} && $(RM) ${PROGNAME}-${version} ${PROGNAME} - - -## Some makes seem to remember that they've built something called FRC, -## so you can only use a given FRC once per makefile. -FRC FRC.src.paths.h FRC.mkdir FRC.dump-elcs FRC.info: -FRC.mostlyclean FRC.clean FRC.distclean FRC.realclean FRC.tags: - -## ==================== Cleaning up and miscellanea ==================== - -.PHONY: mostlyclean clean distclean realclean extraclean - -## `mostlyclean' -## Like `clean', but may refrain from deleting a few files that people -## normally don't want to recompile. For example, the `mostlyclean' -## target for GCC does not delete `libgcc.a', because recompiling it -## is rarely necessary and takes a lot of time. -mostlyclean: FRC.mostlyclean - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - -## `clean' -## Delete all files from the current directory that are normally -## created by building the program. Don't delete the files that -## record the configuration. Also preserve files that could be made -## by building, but normally aren't because the distribution comes -## with them. - -## Delete `.dvi' files here if they are not part of the distribution. -clean: FRC.clean - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - $(RM) core - -## `distclean' -## Delete all files from the current directory that are created by -## configuring or building the program. If you have unpacked the -## source and built the program without creating any other files, -## `make distclean' should leave only the files that were in the -## distribution. -top_distclean=\ - $(RM) config.status config.log config-tmp-* build-install Installation ; \ - $(RM) core .sbinit lock/* GNUmakefile Makefile Makefile.in ; \ - $(RM) lisp/finder-inf.el* Installation.el Installation.elc ; \ - $(RM) packages mule-packages site-lisp - -distclean: FRC.distclean - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - -${top_distclean} - -## `realclean' -## Delete everything from the current directory that can be -## reconstructed with this Makefile. This typically includes -## everything deleted by distclean, plus more: C source files -## produced by Bison, tags tables, info files, and so on. - -## One exception, however: `make realclean' should not delete -## `configure' even if `configure' can be remade using a rule in the -## Makefile. More generally, `make realclean' should not delete -## anything that needs to exist in order to run `configure' and then -## begin to build the program. -realclean: FRC.realclean - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - -${top_distclean} - $(RM) TAGS - -## This doesn't actually appear in the coding standards, but Karl -## says GCC supports it, and that's where the configuration part of -## the coding standards seem to come from. It's like distclean, but -## it deletes backup and autosave files too. -extraclean: - for d in $(SUBDIR); do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - $(RM) *~ \#* - -${top_distclean} - -## Unlocking and relocking. The idea of these productions is to reduce -## hassles when installing an incremental tar of XEmacs. Do `make unlock' -## before unlocking the file to take the write locks off all sources so -## that tar xvof will overwrite them without fuss. Then do `make relock' -## afterward so that VC mode will know which files should be checked in -## if you want to mung them. - -## Note: it's no disaster if these productions miss a file or two; tar -## and VC will swiftly let you know if this happens, and it is easily -## corrected. -SOURCES = ChangeLog GETTING.GNU.SOFTWARE INSTALL Makefile.in PROBLEMS \ - README build-install.in configure make-dist move-if-change - -.PHONY: unlock relock TAGS tags check dist info dvi mcs - -unlock: - chmod u+w $(SOURCES) cpp/* - -cd ./elisp && chmod u+w Makefile README *.texi - for d in src etc lib-src lisp; do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - cd ./lisp/term && chmod u+w README *.el - cd ./man && chmod u+w *texi* ChangeLog split-man - cd ./lwlib && chmod u+w *.[ch] Makefile.in.in - -relock: - chmod u-w $(SOURCES) cpp/* - -cd ./elisp && chmod u-w Makefile README *.texi - for d in src etc lib-src lisp; do (cd ./$$d && $(RECURSIVE_MAKE) $@); done - cd ./lisp/term && chmod u+w README *.el - cd ./man && chmod u+w *texi* ChangeLog split-man - cd ./lwlib && chmod u+w *.[ch] Makefile.in.in - -PRUNE_VC = -name SCCS -prune -o -name RCS -prune -o -name CVS -prune -o -tagslisp = lisp -TAGS tags: FRC.tags - @echo "If you don't have a copy of etags around, then do 'make lib-src' first." - $(RM) ${srcdir}/TAGS - @PATH=`$(pwd)`/lib-src:$$PATH HOME=/-=-; export PATH HOME; \ - echo "Using etags from `which etags`." - PATH=`$(pwd)`/lib-src:$$PATH ; export PATH; cd ${srcdir} && \ - find src lwlib lib-src ${PRUNE_VC} -name '*.[ch]' -print | \ - xargs etags -a -r '/[ ]*DEF\(VAR\|INE\)_[A-Z_]+[ ]*([ ]*"\([^"]+\)"/\2/'; \ - find ${tagslisp} ${PRUNE_VC} -name '*.el' ! -name 'auto-autoloads.el' -print | \ - xargs etags -a -l none -r "/^(def\\(var\\|un\\|alias\\|const\\|macro\\|subst\\|struct\\|face\\|group\\|custom\\|ine-\\(function\\|compiler-macro\\|[a-z-]+alias\\)\\)[ ]+'?\\([^ ]+\\)/\\3/" - -check: - cd ./src && $(RECURSIVE_MAKE) $@ - -info: FRC.info - cd ${srcdir}/man && $(RECURSIVE_MAKE) $@ - -dvi: - cd ${srcdir}/man && $(RECURSIVE_MAKE) $@ - -## Fix up version information in executables (Solaris-only) -mcs: - date=`LANG=C LC_ALL=C date -u '+%e %b %Y'`; \ - ident="@(#)RELEASE VERSION XEmacs ${version} $${date}"; \ - for f in `file lib-src/* src/${PROGNAME} | grep ELF | sed -e 's/:.*//'`; do \ - mcs -da "$${ident} `echo $${f} | sed 's/.*\///'`" $${f}; \ - done diff --git a/PROBLEMS b/PROBLEMS deleted file mode 100644 index 127ee47..0000000 --- a/PROBLEMS +++ /dev/null @@ -1,1581 +0,0 @@ - -*- mode:outline -*- - -This file describes various problems that have been encountered -in compiling, installing and running XEmacs. It has been updated for -XEmacs 21.0. - -This file is rather large, but we have tried to sort the entries by -their respective relevance for XEmacs, but may have not succeeded -completely in that task. The file is divided into four parts: - - - Problems with building XEmacs - - Problems with running XEmacs - - Compatibility problems - - Mule issues - -Use `C-c C-f' to move to the next equal level of outline, and -`C-c C-b' to move to previous equal level. `C-h m' will give more -info about the Outline mode. - -Also, Try finding the things you need using one of the search commands -XEmacs provides (e.g. `C-s'). - -A general advice: - WATCH OUT for .emacs file! ~/.emacs is your Emacs init file. If - you observe strange problems, invoke XEmacs with the `-q' option - and see if you can repeat the problem. - - -* Problems with building XEmacs -=============================== - -** General -*** egcs-1.1 - -There have been reports of egcs-1.1 not compiling XEmacs correctly on -Alpha Linux. There have also been reports that egcs-1.0.3a is O.K. - -*** Don't use -O2 with gcc 2.7.2 under Intel/XXX without also using -`-fno-strength-reduce'. - -gcc will generate incorrect code otherwise. This bug is present in at -least 2.6.x and 2.7.[0-2]. This bug has been fixed in GCC 2.7.2.1 and -later. This bug is O/S independent, but is limited to x86 architectures. - -This problem is known to be fixed in egcs (or pgcc) 1.0 or later. - -*** Don't use -O2 with gcc 2.7.2 under Intel architectures without also -using `-fno-caller-saves'. - -gcc will generate incorrect code otherwise. This bug is still -present in gcc 2.7.2.3. There have been no reports to indicate the -bug is present in egcs 1.0 (or pgcc 1.0) or later. This bug is O/S -independent, but limited to x86 architectures. - -This problem is known to be fixed in egcs (or pgcc) 1.0 or later. - -*** When using gcc, you get the error message "undefined symbol __fixunsdfsi". -When using gcc, you get the error message "undefined symbol __main". - -This means that you need to link with the gcc library. It may be called -"gcc-gnulib" or "libgcc.a"; figure out where it is, and define LIB_GCC in -config.h to point to it. - -It may also work to use the GCC version of `ld' instead of the standard one. - -*** Excessive optimization with pgcc can break XEmacs - -It has been reported on some systems that compiling with -O6 can lead -to XEmacs failures. The workaround is to use a lower optimization -level. -O2 and -O4 have been tested extensively. - -All of this depends heavily on the version of pgcc and the version -of libc. Snapshots near the release of pgcc-1.0 have been tested -extensively and no sign of breakage has been seen on systems using -glibc-2. - -*** src/Makefile and lib-src/Makefile are truncated--most of the file missing. - -This can happen if configure uses GNU sed version 2.03. That version -had a bug. GNU sed version 2.05 works properly. - -*** When compiling with X11, you get "undefined symbol _XtStrings". - -This means that you are trying to link emacs against the X11r4 version of -libXt.a, but you have compiled either Emacs or the code in the lwlib -subdirectory with the X11r5 header files. That doesn't work. - -Remember, you can't compile lwlib for r4 and emacs for r5, or vice versa. -They must be in sync. - -*** test-distrib says that the distribution has been clobbered -or, temacs prints "Command key out of range 0-127" -or, temacs runs and dumps xemacs, but xemacs totally fails to work. -or, temacs gets errors dumping xemacs - -This can be because the .elc files have been garbled. Do not be -fooled by the fact that most of a .elc file is text: these are binary -files and can contain all 256 byte values. - -In particular `shar' cannot be used for transmitting GNU Emacs. It -typically truncates "lines". (this does not apply to GNU shar, which -uses uuencode to encode binary files.) - -If you have a copy of Emacs that has been damaged in its nonprinting -characters, you can fix them by running: - - make all-elc - -This will rebuild all the needed .elc files. - -*** `compress' and `uncompress' not found and XFree86 - -XFree86 installs a very old version of libz.a by default ahead of where -more modern version of libz might be installed. This will cause problems -when attempting to link against libMagick. The fix is to remove the old -libz.a in the X11 binary directory. - - -** AIX -*** On AIX 4.3, you must specify --with-dialogs=athena with configure - -*** The libXt shipped with AIX 4.3 is broken. This causes xemacs -nw - to fail in various ways. The solution is to build against stock - X11R6. - -*** On AIX, you get this compiler error message: - - Processing include file ./XMenuInt.h - 1501-106: (S) Include file X11/Xlib.h not found. - -This means your system was installed with only the X11 runtime i.d -libraries. You have to find your sipo (bootable tape) and install -X11Dev... with smit. - -*** On AIX 4.1.2, linker error messages such as - ld: 0711-212 SEVERE ERROR: Symbol .__quous, found in the global symbol table - of archive /usr/lib/libIM.a, was not defined in archive member shr.o. - -This is a problem in libIM.a. You can work around it by executing -these shell commands in the src subdirectory of the directory where -you build Emacs: - - cp /usr/lib/libIM.a . - chmod 664 libIM.a - ranlib libIM.a - -Then change -lIM to ./libIM.a in the command to link temacs (in -Makefile). - -*** Excessive optimization on AIX 4.2 can lead to compiler failure. - -Valdis.Kletnieks@vt.edu writes: - At least at the b34 level, and the latest-and-greatest IBM xlc - (3.1.4.4), there are problems with -O3. I haven't investigated - further. - - -** SunOS/Solaris -*** Link failure when using acc on a Sun. - -To use acc, you need additional options just before the libraries, such as - - /usr/lang/SC2.0.1/values-Xt.o -L/usr/lang/SC2.0.1/cg87 -L/usr/lang/SC2.0.1 - -and you need to add -lansi just before -lc. - -The precise file names depend on the compiler version, so we -cannot easily arrange to supply them. - -*** Problems finding X11 libraries on Solaris with Openwindows - -Some users have reported problems in this area. The reported solution -is to define the environment variable OPENWINHOME, even if you must set -it to `/usr/openwin'. - -*** Sed problems on Solaris 2.5 - -There have been reports of Sun sed truncating very lines in the -Makefile during configuration. The workaround is to use GNU sed or, -even better, think of a better way to generate Makefile, and send us a -patch. :-) - -*** On Solaris 2 I get undefined symbols from libcurses.a. - -You probably have /usr/ucblib/ on your LD_LIBRARY_PATH. Do the link with -LD_LIBRARY_PATH unset. Generally, avoid using any ucb* stuff when -building XEmacs. - -*** On Solaris 2 I cannot make alloc.o, glyphs.o or process.o. - -The SparcWorks C compiler may have difficulty building those modules -with optimization level -xO4. Try using only "-fast" optimization -for just those modules. (Or use gcc). - -*** Solaris 2.3 /bin/sh coredumps during configuration. - -This only occurs if you have LANG != C. This is a known bug with -/bin/sh fixed by installing Patch-ID# 101613-01. Or, you can use -bash, as a workaround. - -*** On SunOS, you get linker errors - ld: Undefined symbol - _get_wmShellWidgetClass - _get_applicationShellWidgetClass - -The fix to this is to install patch 100573 for OpenWindows 3.0 -or link libXmu statically. - -*** On Sunos 4, you get the error ld: Undefined symbol __lib_version. - -This is the result of using cc or gcc with the shared library meant -for acc (the Sunpro compiler). Check your LD_LIBRARY_PATH and delete -/usr/lang/SC2.0.1 or some similar directory. - -*** Undefined symbols when linking on Sunos 4.1. - -If you get the undefined symbols _atowc _wcslen, _iswprint, _iswspace, -_iswcntrl, _wcscpy, and _wcsncpy, then you need to add -lXwchar after --lXaw in the command that links temacs. - -This problem seems to arise only when the international language -extensions to X11R5 are installed. - -*** On a Sun running SunOS 4.1.1, you get this error message from GNU ld: - - /lib/libc.a(_Q_sub.o): Undefined symbol __Q_get_rp_rd referenced from text segment - -The problem is in the Sun shared C library, not in GNU ld. - -The solution is to install Patch-ID# 100267-03 from Sun. - -*** SunOS 4.1.2: undefined symbol _get_wmShellWidgetClass - - Apparently the version of libXmu.so.a that Sun ships is hosed: it's missing - some stuff that is in libXmu.a (the static version). Sun has a patch for - this, but a workaround is to use the static version of libXmu, by changing - the link command from "-lXmu" to "-Bstatic -lXmu -Bdynamic". If you have - OpenWindows 3.0, ask Sun for these patches: - 100512-02 4.1.x OpenWindows 3.0 libXt Jumbo patch - 100573-03 4.1.x OpenWindows 3.0 undefined symbols with shared libXmu - -*** Random other SunOS 4.1.[12] link errors. - - The X headers and libraries that Sun ships in /usr/{include,lib}/X11 are - broken. Use the ones in /usr/openwin/{include,lib} instead. - -** Linux -*** Under Linux, you get "too many arguments to function `getpgrp'". - -You have probably installed LessTiff under `/usr/local' and `libXm.so' -could not be found when linking `getpgrp()' test program, making XEmacs -think that `getpgrp()' takes an argument. Try adding `/usr/local/lib' -in `/etc/ld.so.conf' and run `ldconfig'. Then run XEmacs's `configure' -again. As with all problems of this type, reading the config.log file -generated from configure and seeing the log of how the test failed can -prove enlightening. - -*** `Error: No ExtNode to pop!' on Linux systems with Lesstif. - -This error message has been observed with lesstif-0.75a. It does not -appear to cause any harm. - -*** xemacs: can't resolve symbol '__malloc_hook' - -This is a Linux problem where you've compiled the XEmacs binary on a libc -5.4 with version higher than 5.4.19 and attempted to run the binary against -an earlier version. The solution is to upgrade your old library. - -** IRIX -*** Linking with -rpath on IRIX. - -Darrell Kindred writes: -There are a couple of problems [with use of -rpath with Irix ld], though: - - 1. The ld in IRIX 5.3 ignores all but the last -rpath - spec, so the patched configure spits out a warning - if --x-libraries or --site-runtime-libraries are - specified under irix 5.x, and it only adds -rpath - entries for the --site-runtime-libraries. This bug was - fixed sometime between 5.3 and 6.2. - - 2. IRIX gcc 2.7.2 doesn't accept -rpath directly, so - it would have to be prefixed by -Xlinker or "-Wl,". - This would be fine, except that configure compiles with - ${CC-cc} $CFLAGS $LDFLAGS ... - rather than quoting $LDFLAGS with prefix-args, like - src/Makefile does. So if you specify --x-libraries - or --site-runtime-libraries, you must use --use-gcc=no, - or configure will fail. - -*** On Irix 6.3, the SGI ld quits with segmentation fault when linking temacs - -This occurs if you use the SGI linker version 7.1. Installing the -patch SG0001872 fixes this problem. - -*** On Irix 6.0, make tries (and fails) to build a program named unexelfsgi - -A compiler bug inserts spaces into the string "unexelfsgi . o" -in src/Makefile. Edit src/Makefile, after configure is run, -find that string, and take out the spaces. - -Compiler fixes in Irix 6.0.1 should eliminate this problem. - -*** On Irix 5.2, unexelfsgi.c can't find cmplrs/stsupport.h. - -The file cmplrs/stsupport.h was included in the wrong file set in the -Irix 5.2 distribution. You can find it in the optional fileset -compiler_dev, or copy it from some other Irix 5.2 system. A kludgy -workaround is to change unexelfsgi.c to include sym.h instead of -syms.h. - -*** Coredumping in Irix 6.2 - -Pete Forman writes: -A problem noted by myself and others (I've lost the references) was -that XEmacs coredumped when the cut or copy toolbar buttons were -pressed. This has been fixed by loading the SGI patchset (Feb 98) -without having to recompile XEmacs. - -My versions are XEmacs 20.3 (problem first noted in 19.15) and IRIX -6.2, compiled using -n32. I'd guess that the relevant individual -patch was "SG0002580: multiple fixes for X libraries". SGI recommends -that the complete patch set be installed rather than parts of it. - -** Digital UNIX/OSF/VMS -*** On Digital UNIX, the DEC C compiler might have a problem compiling -some files. - -In particular, src/extents.c and src/faces.c might cause the DEC C -compiler to abort. When this happens: cd src, compile the files by -hand, cd .., and redo the "make" command. When recompiling the files by -hand, use the old C compiler for the following versions of Digital UNIX: - - V3.n: Remove "-migrate" from the compile command. - - V4.n: Add "-oldc" to the compile command. - -A related compiler bug has been fixed by the DEC compiler team. The -new versions of the compiler should run fine. - -*** Under some versions of OSF XEmacs runs fine if built without -optimization but will crash randomly if built with optimization. - -Using 'cc -g' is not sufficient to eliminate all optimization. Try -'cc -g -O0' instead. - -*** Compilation errors on VMS. - -Sorry, XEmacs does not work under VMS. You might consider working on -the port if you really want to have XEmacs work under VMS. - -** HP-UX -*** On HPUX, the HP C compiler might have a problem compiling some files -with optimization. - -Richard Cognot writes: - - Had to drop once again to level 2 optimization, at least to - compile lstream.c. Otherwise, I get a "variable is void: \if" - problem while dumping (this is a problem I already reported - with vanilla hpux 10.01 and 9.07, which went away after - applying patches for the C compiler). Trouble is I still - haven't found the same patch for hpux 10.10, and I don't - remember the patch numbers. I think potential XEmacs builders - on HP should be warned about this. - -*** I don't have `xmkmf' and `imake' on my HP. - - You can get these standard X tools by anonymous FTP to - hpcvaaz.cv.hp.com. Essentially all X programs need these. - -*** On HP-UX, problems with make - -Marcus Thiessel - - Some releases of XEmacs (e.g. 20.4) require GNU make to build - successfully. You don't need GNU make when building 21.x. - -*** On HP-UX 9.05 XEmacs won't compile or coredump during the build. - -Marcus Thiessel - - This might be a sed problem. For your own safety make sure to use - GNU sed while dumping XEmacs. - -*** On HP-UX 11.0 XEmacs causes excessive X11 errors when running. - -Marcus Thiessel - - Unfortunately, XEmacs releases <21.0 don't work with Motif2.1. It - will compile but you will get excessive X11 errors like - - xemacs: X Error of failed request: BadGC (invalid GC parameter) - - and finally XEmacs gets killed. A workaround is to use the - Motif1.2_R6 libraries. You can the following line to your call to - configure: - - --x-libraries="/usr/lib/Motif1.2_R6 -L/usr/lib/X11R6" - - Make sure /usr/lib/Motif1.2_R6/libXm.sl is a link to - /usr/lib/Motif1.2_R6/libXm.3. - -** SCO OpenServer -*** Native cc on SCO OpenServer 5 is now OK. Icc may still throw you -a curve. Here is what Robert Lipe says: - -Unlike XEmacs 19.13, building with the native cc on SCO OpenServer 5 -now produces a functional binary. I will typically build this -configuration for COFF with: - - /path_to_xemacs_source/configure --with-gcc=no \ - --site-includes=/usr/local/include --site-libraries=/usr/local/lib \ - --with-xpm --with-xface --with-sound=nas - -This version now supports ELF builds. I highly recommend this to -reduce the in-core footprint of XEmacs. This is now how I compile -all my test releases. Build it like this: - - /path_to_XEmacs_source/configure --with-gcc=no \ - --site-includes=/usr/local/include --site-libraries=/usr/local/lib \ - --with-xpm --with-xface --with-sound=nas --dynamic - -The compiler known as icc [ supplied with the OpenServer 5 Development -System ] generates a working binary, but it takes forever to generate -XEmacs. ICC also whines more about the code than /bin/cc does. I do -believe all its whining is legitimate, however. Note that you do -have to 'cd src ; make LD=icc' to avoid linker errors. - -The way I handle the build procedure is: - - /path_to_XEmacs_source/configure --with-gcc=no \ - --site-includes=/usr/local/include --site-libraries=/usr/local/lib \ - --with-xpm --with-xface --with-sound=nas --dynamic --compiler="icc" - -NOTE I have the xpm, xface, and audio libraries and includes in - /usr/local/lib, /usr/local/include. If you don't have these, - don't include the "--with-*" arguments in any of my examples. - -In previous versions of XEmacs, you had to override the defaults while -compiling font-lock.o and extents.o when building with icc. This seems -to no longer be true, but I'm including this old information in case it -resurfaces. The process I used was: - - make -k - [ procure pizza, beer, repeat ] - cd src - make CC="icc -W0,-mP1COPT_max_tree_size=3000" font-lock.o extents.o - make LD=icc - -If you want sound support, get the tls566 supplement from -ftp.sco.com:/TLS or any of its mirrors. It works just groovy -with XEmacs. - -The M-x manual-entry is known not to work. If you know Lisp and would -like help in making it work, e-mail me at . -(UNCHECKED for 19.15 -- it might work). - -In earlier releases, gnuserv/gnuclient/gnudoit would open a frame -just fine, but the client would lock up and the server would -terminate when you used C-x # to close the frame. This is now -fixed in XEmacs. - -In etc/ there are two files of note. emacskeys.sco and emacsstrs.sco. -The comments at the top of emacskeys.sco describe its function, and -the emacstrs.sco is a suitable candidate for /usr/lib/keyboard/strings -to take advantage of the keyboard map in emacskeys.sco. - -Note: Much of the above entry is probably not valid for XEmacs 21.0 -and later. - -** Cygwin -*** In general use etc/check_cygwin_setup.sh to trap environment problems. - -The script etc/check_cygwin_setup.sh will attempt to detect whether -you have a suitable environment for building. This script may not work -correctly if you are using ash instead of bash (see below). - -*** X11 not detected. - -This is usually because xmkmf is not in your path or because you are -using the default cygwin shell. The default cygwin shell (/bin/sh.exe) -is ash which appears to work in most circumstances but has some wierd -failure modes. I recommend replacing sh.exe with bash.exe, this will -mean configure is slower but more reliable. - -*** Subprocesses do not work. - -You do not have "tty" in your CYGWIN32 (for b19) or CYGWIN (for b20) -environment variable. This must be set in your autoexec.bat (win95) or -the system properties (winnt) as it must be read before the cygwin dll -initializes. - -*** ^G does not work on hung subprocesses. - -This is a known problem. It can be remedied with cygwin b20 or greater -by defining BROKEN_SIGIO in src/s/cygwin32.h, however this currently -leads to instability in XEmacs. - -*** The XEmacs executable crashes at startup. - -This can be caused by many things. - -If you are running with X11 you need to have cygwin b19 or cygwin -b20.1 or greater, cygwin b20 will not work. - -If you are running with cygwin b19 make sure you are using egcs 1.0.2 -rather than vanilla gcc. XEmacs builds by default with -O3 which does -not work with the gcc that ships with b19. Alternatively use -O2. - -*** The info files will not build. - -makeinfo that ships with cygwin (all versions) is a noop. You need to -obtain makeinfo from somewhere or build it yourself. - -*** I have no graphics. - -You need to obtain the various graphics libraries. Pre-built versions -of these and the X libraries are located on the XEmacs website in -ftp://ftp.xemacs.org/pub/aux/cygwin*. - -*** There are no images in the toolbar buttons. - -You need version 4.71 of commctrl.dll which does not ship with windows -95. You can get this by installing IE 4.0 or downloading it from the -microsoft website. - - -* Problems with running XEmacs -============================== -** General -*** C-z just refreshes the screen instead of suspending Emacs. - -You are probably using a shell that doesn't support job control, even -though the system itself is capable of it. Try using a different -shell. - -*** You type Control-H (Backspace) expecting to delete characters. - -Emacs has traditionally used Control-H for help; unfortunately this -interferes with its use as Backspace on TTY's. One way to solve this -problem is to put this in your .emacs: - - (when (eq tty-erase-char ?\C-h) - (keyboard-translate ?\C-h ?\C-?) - (global-set-key "\M-?" 'help-command)) - -This checks whether the TTY erase char is C-h, and if it is, makes -Control-H (Backspace) work sensibly, and moves help to Meta-? (ESC ?). - -Note that you can probably also access help using F1. - -*** Mail agents (VM, Gnus, rmail) cannot get new mail - -rmail and VM get new mail from /usr/spool/mail/$USER using a program -called `movemail'. This program interlocks with /bin/mail using the -protocol defined by /bin/mail. - -There are two different protocols in general use. One of them uses -the `flock' system call. The other involves creating a lock file; -`movemail' must be able to write in /usr/spool/mail in order to do -this. You control which one is used by defining, or not defining, the -macro MAIL_USE_FLOCK in config.h or the m- or s- file it includes. IF -YOU DON'T USE THE FORM OF INTERLOCKING THAT IS NORMAL ON YOUR SYSTEM, -YOU CAN LOSE MAIL! - -If your system uses the lock file protocol, and fascist restrictions -prevent ordinary users from writing the lock files in /usr/spool/mail, -you may need to make `movemail' setgid to a suitable group such as -`mail'. To do this, use the following commands (as root) after doing -the make install. - - chgrp mail movemail - chmod 2755 movemail - -Installation normally copies movemail from the build directory to an -installation directory which is usually under /usr/local/lib. The -installed copy of movemail is usually in the directory -/usr/local/lib/emacs/VERSION/TARGET. You must change the group and -mode of the installed copy; changing the group and mode of the build -directory copy is ineffective. - -*** VM appears to hang in large folders. - -This is normal (trust us) when upgrading to VM-6.22 from earlier -versions. Let VM finish what it is doing and all will be well. - -*** Changes made to .el files do not take effect. - -You may have forgotten to recompile them into .elc files. Then the -old .elc files will be loaded, and your changes will not be seen. To -fix this, do `M-x byte-recompile-directory' and specify the directory -that contains the Lisp files. - -Note that you will get a warning when loading a .elc file that is -older than the corresponding .el file. - -*** Things which should be bold or italic (such as the initial -copyright notice) are not. - -The fonts of the "bold" and "italic" faces are generated from the font -of the "default" face; in this way, your bold and italic fonts will -have the appropriate size and family. However, emacs can only be -clever in this way if you have specified the default font using the -XLFD (X Logical Font Description) format, which looks like - - *-courier-medium-r-*-*-*-120-*-*-*-*-*-* - -if you use any of the other, less strict font name formats, some of -which look like: - - lucidasanstypewriter-12 -and fixed -and 9x13 - -then emacs won't be able to guess the names of the "bold" and "italic" -versions. All X fonts can be referred to via XLFD-style names, so you -should use those forms. See the man pages for X(1), xlsfonts(1), and -xfontsel(1). - -*** The dumped Emacs crashes when run, trying to write pure data. - -Two causes have been seen for such problems. - -1) On a system where getpagesize is not a system call, it is defined -as a macro. If the definition (in both unexec.c and malloc.c) is wrong, -it can cause problems like this. You might be able to find the correct -value in the man page for a.out (5). - -2) Some systems allocate variables declared static among the -initialized variables. Emacs makes all initialized variables in most -of its files pure after dumping, but the variables declared static and -not initialized are not supposed to be pure. On these systems you -may need to add "#define static" to the m- or the s- file. - -*** Reading and writing files is very very slow. - -Try evaluating the form (setq lock-directory nil) and see if that helps. -There is a problem with file-locking on some systems (possibly related -to NFS) that I don't understand. Please send mail to the address -xemacs@xemacs.org if you figure this one out. - -*** When emacs starts up, I get lots of warnings about unknown keysyms. - -If you are running the prebuilt binaries, the Motif library expects to find -certain thing in the XKeysymDB file. This file is normally in /usr/lib/X11/ -or in /usr/openwin/lib/. If you keep yours in a different place, set the -environment variable $XKEYSYMDB to point to it before starting emacs. If -you still have the problem after doing that, perhaps your version of X is -too old. There is a copy of the MIT X11R5 XKeysymDB file in the emacs `etc' -directory. Try using that one. - -*** My X resources used to work, and now some of them are being ignored. - -Check the resources in .../etc/Emacs.ad (which is the same as the file -sample.Xdefaults). Perhaps some of the default resources built in to -emacs are now overriding your existing resources. Copy and edit the -resources in Emacs.ad as necessary. - -*** I have focus problems when I use `M-o' to switch to another screen -without using the mouse. - -The focus issues with a program like XEmacs, which has multiple -homogeneous top-level windows, are very complicated, and as a result, -most window managers don't implement them correctly. - -The R4/R5 version of twm (and all of its descendants) had buggy focus -handling. Sufficiently recent versions of tvtwm have been fixed. In -addition, if you're using twm, make sure you have not specified -"NoTitleFocus" in your .tvtwmrc file. The very nature of this option -makes twm do some illegal focus tricks, even with the patch. - -It is known that olwm and olvwm are buggy, and in different ways. If -you're using click-to-type mode, try using point-to-type, or vice -versa. - -In older versions of NCDwm, one could not even type at XEmacs windows. -This has been fixed in newer versions (2.4.3, and possibly earlier). - -(Many people suggest that XEmacs should warp the mouse when focusing -on another screen in point-to-type mode. This is not ICCCM-compliant -behavior. Implementing such policy is the responsibility of the -window manager itself, it is not legal for a client to do this.) - -*** Emacs spontaneously displays "I-search: " at the bottom of the screen. - -This means that Control-S/Control-Q (XON/XOFF) "flow control" is being -used. C-s/C-q flow control is bad for Emacs editors because it takes -away C-s and C-q as user commands. Since editors do not output long -streams of text without user commands, there is no need for a -user-issuable "stop output" command in an editor; therefore, a -properly designed flow control mechanism would transmit all possible -input characters without interference. Designing such a mechanism is -easy, for a person with at least half a brain. - -There are three possible reasons why flow control could be taking place: - - 1) Terminal has not been told to disable flow control - 2) Insufficient padding for the terminal in use - 3) Some sort of terminal concentrator or line switch is responsible - -First of all, many terminals have a set-up mode which controls whether -they generate XON/XOFF flow control characters. This must be set to -"no XON/XOFF" in order for Emacs to work. Sometimes there is an -escape sequence that the computer can send to turn flow control off -and on. If so, perhaps the termcap `ti' string should turn flow -control off, and the `te' string should turn it on. - -Once the terminal has been told "no flow control", you may find it -needs more padding. The amount of padding Emacs sends is controlled -by the termcap entry for the terminal in use, and by the output baud -rate as known by the kernel. The shell command `stty' will print -your output baud rate; `stty' with suitable arguments will set it if -it is wrong. Setting to a higher speed causes increased padding. If -the results are wrong for the correct speed, there is probably a -problem in the termcap entry. You must speak to a local Unix wizard -to fix this. Perhaps you are just using the wrong terminal type. - -For terminals that lack a "no flow control" mode, sometimes just -giving lots of padding will prevent actual generation of flow control -codes. You might as well try it. - -If you are really unlucky, your terminal is connected to the computer -through a concentrator which sends XON/XOFF flow control to the -computer, or it insists on sending flow control itself no matter how -much padding you give it. Unless you can figure out how to turn flow -control off on this concentrator (again, refer to your local wizard), -you are screwed! You should have the terminal or concentrator -replaced with a properly designed one. In the mean time, some drastic -measures can make Emacs semi-work. - -You can make Emacs ignore C-s and C-q and let the operating system -handle them. To do this on a per-session basis, just type M-x -enable-flow-control RET. You will see a message that C-\ and C-^ are -now translated to C-s and C-q. (Use the same command M-x -enable-flow-control to turn *off* this special mode. It toggles flow -control handling.) - -If C-\ and C-^ are inconvenient for you (for example, if one of them -is the escape character of your terminal concentrator), you can choose -other characters by setting the variables flow-control-c-s-replacement -and flow-control-c-q-replacement. But choose carefully, since all -other control characters are already used by emacs. - -IMPORTANT: if you type C-s by accident while flow control is enabled, -Emacs output will freeze, and you will have to remember to type C-q in -order to continue. - -If you work in an environment where a majority of terminals of a -certain type are flow control hobbled, you can use the function -`enable-flow-control-on' to turn on this flow control avoidance scheme -automatically. Here is an example: - -(enable-flow-control-on "vt200" "vt300" "vt101" "vt131") - -If this isn't quite correct (e.g. you have a mixture of flow-control hobbled -and good vt200 terminals), you can still run enable-flow-control -manually. - -I have no intention of ever redesigning the Emacs command set for the -assumption that terminals use C-s/C-q flow control. XON/XOFF flow -control technique is a bad design, and terminals that need it are bad -merchandise and should not be purchased. Now that X is becoming -widespread, XON/XOFF seems to be on the way out. If you can get some -use out of GNU Emacs on inferior terminals, more power to you, but I -will not make Emacs worse for properly designed systems for the sake -of inferior systems. - -*** Control-S and Control-Q commands are ignored completely. - -For some reason, your system is using brain-damaged C-s/C-q flow -control despite Emacs's attempts to turn it off. Perhaps your -terminal is connected to the computer through a concentrator -that wants to use flow control. - -You should first try to tell the concentrator not to use flow control. -If you succeed in this, try making the terminal work without -flow control, as described in the preceding section. - -If that line of approach is not successful, map some other characters -into C-s and C-q using keyboard-translate-table. The example above -shows how to do this with C-^ and C-\. - -*** Control-S and Control-Q commands are ignored completely on a net -connection. - -Some versions of rlogin (and possibly telnet) do not pass flow -control characters to the remote system to which they connect. -On such systems, emacs on the remote system cannot disable flow -control on the local system. - -One way to cure this is to disable flow control on the local host -(the one running rlogin, not the one running rlogind) using the -stty command, before starting the rlogin process. On many systems, -`stty start u stop u' will do this. - -Some versions of tcsh will prevent even this from working. One way -around this is to start another shell before starting rlogin, and -issue the stty command to disable flow control from that shell. - -If none of these methods work, the best solution is to type -`M-x enable-flow-control' at the beginning of your emacs session, or -if you expect the problem to continue, add a line such as the -following to your .emacs (on the host running rlogind): - -(enable-flow-control-on "vt200" "vt300" "vt101" "vt131") - -See the entry about spontaneous display of I-search (above) for more -info. - -*** TTY redisplay is slow. - -XEmacs has fairly new TTY redisplay support (beginning from 19.12), -which doesn't include some basic TTY optimizations -- like using -scrolling regions to move around blocks of text. This is why -redisplay on the traditional terminals, or over slow lines can be very -slow. - -If you are interested in fixing this, please let us know at -. - -*** Screen is updated wrong, but only on one kind of terminal. - -This could mean that the termcap entry you are using for that terminal -is wrong, or it could mean that Emacs has a bug handing the -combination of features specified for that terminal. - -The first step in tracking this down is to record what characters -Emacs is sending to the terminal. Execute the Lisp expression -(open-termscript "./emacs-script") to make Emacs write all terminal -output into the file ~/emacs-script as well; then do what makes the -screen update wrong, and look at the file and decode the characters -using the manual for the terminal. There are several possibilities: - -1) The characters sent are correct, according to the terminal manual. - -In this case, there is no obvious bug in Emacs, and most likely you -need more padding, or possibly the terminal manual is wrong. - -2) The characters sent are incorrect, due to an obscure aspect of the - terminal behavior not described in an obvious way by termcap. - -This case is hard. It will be necessary to think of a way for Emacs -to distinguish between terminals with this kind of behavior and other -terminals that behave subtly differently but are classified the same -by termcap; or else find an algorithm for Emacs to use that avoids the -difference. Such changes must be tested on many kinds of terminals. - -3) The termcap entry is wrong. - -See the file etc/TERMS for information on changes that are known to be -needed in commonly used termcap entries for certain terminals. - -4) The characters sent are incorrect, and clearly cannot be right for - any terminal with the termcap entry you were using. - -This is unambiguously an Emacs bug, and can probably be fixed in -termcap.c, terminfo.c, tparam.c, cm.c, redisplay-tty.c, -redisplay-output.c, or redisplay.c. - -*** My buffers are full of \000 characters or otherwise corrupt. - -Some compilers have trouble with gmalloc.c and ralloc.c; try recompiling -without optimization. If that doesn't work, try recompiling with -SYSTEM_MALLOC defined, and/or with REL_ALLOC undefined. - -*** A position you specified in .Xdefaults is ignored, using twm. - -twm normally ignores "program-specified" positions. -You can tell it to obey them with this command in your `.twmrc' file: - - UsePPosition "on" #allow clents to request a position - -*** With M-x enable-flow-control, you need to type C-\ twice to do -incremental search--a single C-\ gets no response. - -This has been traced to communicating with your machine via kermit, -with C-\ as the kermit escape character. One solution is to use -another escape character in kermit. One user did - - set escape-character 17 - -in his .kermrc file, to make C-q the kermit escape character. - -*** The Motif version of Emacs paints the screen a solid color. - -This has been observed to result from the following X resource: - - Emacs*default.attributeFont: -*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-* - -That the resource has this effect indicates a bug in something, but we -do not yet know what. If it is an Emacs bug, we hope someone can -explain what the bug is so we can fix it. In the mean time, removing -the resource prevents the problem. - -*** After running emacs once, subsequent invocations crash. - -Some versions of SVR4 have a serious bug in the implementation of the -mmap () system call in the kernel; this causes emacs to run correctly -the first time, and then crash when run a second time. - -Contact your vendor and ask for the mmap bug fix; in the mean time, -you may be able to work around the problem by adding a line to your -operating system description file (whose name is reported by the -configure script) that reads: -#define SYSTEM_MALLOC -This makes Emacs use memory less efficiently, but seems to work around -the kernel bug. - -*** Inability to send an Alt-modified key, when Emacs is communicating -directly with an X server. - -If you have tried to bind an Alt-modified key as a command, and it -does not work to type the command, the first thing you should check is -whether the key is getting through to Emacs. To do this, type C-h c -followed by the Alt-modified key. C-h c should say what kind of event -it read. If it says it read an Alt-modified key, then make sure you -have made the key binding correctly. - -If C-h c reports an event that doesn't have the Alt modifier, it may -be because your X server has no key for the Alt modifier. The X -server that comes from MIT does not set up the Alt modifier by -default. - -If your keyboard has keys named Alt, you can enable them as follows: - - xmodmap -e 'add mod2 = Alt_L' - xmodmap -e 'add mod2 = Alt_R' - -If the keyboard has just one key named Alt, then only one of those -commands is needed. The modifier `mod2' is a reasonable choice if you -are using an unmodified MIT version of X. Otherwise, choose any -modifier bit not otherwise used. - -If your keyboard does not have keys named Alt, you can use some other -keys. Use the keysym command in xmodmap to turn a function key (or -some other 'spare' key) into Alt_L or into Alt_R, and then use the -commands show above to make them modifier keys. - -Note that if you have Alt keys but no Meta keys, Emacs translates Alt -into Meta. This is because of the great importance of Meta in Emacs. - -*** In Shell mode, you get a ^M at the end of every line. - -This happens to people who use tcsh, because it is trying to be too -smart. It sees that the Shell uses terminal type `unknown' and turns -on the flag to output ^M at the end of each line. You can fix the -problem by adding this to your .cshrc file: - - if ($?EMACS) then - if ($EMACS == "t") then - unset edit - stty -icrnl -onlcr -echo susp ^Z - endif - endif - -*** An error message such as `X protocol error: BadMatch (invalid -parameter attributes) on protocol request 93'. - -This comes from having an invalid X resource, such as - emacs*Cursor: black -(which is invalid because it specifies a color name for something -that isn't a color.) - -The fix is to correct your X resources. - -*** Once you pull down a menu from the menubar, it won't go away. - -It has been claimed that this is caused by a bug in certain very old -(1990?) versions of the twm window manager. It doesn't happen with -recent vintages, or with other window managers. - -*** Emacs ignores the "help" key when running OLWM. - -OLWM grabs the help key, and retransmits it to the appropriate client -using XSendEvent. Allowing emacs to react to synthetic events is a -security hole, so this is turned off by default. You can enable it by -setting the variable x-allow-sendevents to t. You can also cause fix -this by telling OLWM to not grab the help key, with the null binding -"OpenWindows.KeyboardCommand.Help:". - -*** Programs running under terminal emulator do not recognize `emacs' -terminal type. - -The cause of this is a shell startup file that sets the TERMCAP -environment variable. The terminal emulator uses that variable to -provide the information on the special terminal type that Emacs -emulates. - -Rewrite your shell startup file so that it does not change TERMCAP -in such a case. You could use the following conditional which sets -it only if it is undefined. - - if ( ! ${?TERMCAP} ) setenv TERMCAP ~/my-termcap-file - -Or you could set TERMCAP only when you set TERM--which should not -happen in a non-login shell. - -*** The popup menu appears at the buttom/right of my screen. - -You probably have something like the following in your ~/.Xdefaults - - Emacs.geometry: 81x56--9--1 - -Use the following instead - - Emacs*EmacsFrame.geometry: 81x56--9--1 - - -** AIX -*** Your Delete key sends a Backspace to the terminal, using an AIXterm. - -The solution is to include in your .Xdefaults the lines: - - *aixterm.Translations: #override BackSpace: string(0x7f) - aixterm*ttyModes: erase ^? - -This makes your Backspace key send DEL (ASCII 127). - -*** On AIX 4, some programs fail when run in a Shell buffer -with an error message like No terminfo entry for "unknown". - -On AIX, many terminal type definitions are not installed by default. -`unknown' is one of them. Install the "Special Generic Terminal -Definitions" to make them defined. - -*** On AIX, you get this message when running Emacs: - - Could not load program emacs - Symbol smtcheckinit in csh is undefined - Error was: Exec format error - -or this one: - - Could not load program .emacs - Symbol _system_con in csh is undefined - Symbol _fp_trapsta in csh is undefined - Error was: Exec format error - -These can happen when you try to run on AIX 3.2.5 a program that was -compiled with 3.2.4. The fix is to recompile. - -*** Trouble using ptys on AIX. - -People often install the pty devices on AIX incorrectly. -Use `smit pty' to reinstall them properly. - - -** SunOS/Solaris -*** The Emacs window disappears when you type M-q. - -Some versions of the Open Look window manager interpret M-q as a quit -command for whatever window you are typing at. If you want to use -Emacs with that window manager, you should try to configure the window -manager to use some other command. You can disable the -shortcut keys entirely by adding this line to ~/.OWdefaults: - - OpenWindows.WindowMenuAccelerators: False - -*** When Emacs tries to ring the bell, you get an error like - - audio: sst_open: SETQSIZE" Invalid argument - audio: sst_close: SETREG MMR2, Invalid argument - -you have probably compiled using an ANSI C compiler, but with non-ANSI -include files. In particular, on Suns, the file -/usr/include/sun/audioio.h uses the _IOW macro to define the constant -AUDIOSETQSIZE. _IOW in turn uses a K&R preprocessor feature that is -now explicitly forbidden in ANSI preprocessors, namely substitution -inside character constants. All ANSI C compilers must provide a -workaround for this problem. Lucid's C compiler is shipped with a new -set of system include files. If you are using GCC, there is a script -called fixincludes that creates new versions of some system include -files that use this obsolete feature. - -*** On Solaris 2.6, XEmacs dumps core when exiting. - -This happens if you're XEmacs is running on the same machine as the X -server, and the optimized memory transport has been turned on by -setting the environment variable XSUNTRANSPORT. The crash occurs -during the call to XCloseDisplay. - -If this describes your situation, you need to undefine the -XSUNTRANSPORT environment variable. - -*** On Solaris, C-x doesn't get through to Emacs when you use the console. - -This is a Solaris feature (at least on Intel x86 cpus). Type C-r -C-r C-t, to toggle whether C-x gets through to Emacs. - -*** On Solaris 2.4, Dired hangs and C-g does not work. Or Emacs hangs -forever waiting for termination of a subprocess that is a zombie. - -casper@fwi.uva.nl says the problem is in X11R6. Rebuild libX11.so -after changing the file xc/config/cf/sunLib.tmpl. Change the lines - - #if ThreadedX - #define SharedX11Reqs -lthread - #endif - -to: - - #if OSMinorVersion < 4 - #if ThreadedX - #define SharedX11Reqs -lthread - #endif - #endif - -Be sure also to edit x/config/cf/sun.cf so that OSMinorVersion is 4 -(as it should be for Solaris 2.4). The file has three definitions for -OSMinorVersion: the first is for x86, the second for SPARC under -Solaris, and the third for SunOS 4. Make sure to update the -definition for your type of machine and system. - -Then do `make Everything' in the top directory of X11R6, to rebuild -the makefiles and rebuild X. The X built this way work only on -Solaris 2.4, not on 2.3. - -For multithreaded X to work it necessary to install patch -101925-02 to fix problems in header files [2.4]. You need -to reinstall gcc or re-run just-fixinc after installing that -patch. - -However, Frank Rust used a simpler solution: -he changed - #define ThreadedX YES -to - #define ThreadedX NO -in sun.cf and did `make World' to rebuild X11R6. Removing all -`-DXTHREAD*' flags and `-lthread' entries from lib/X11/Makefile and -typing 'make install' in that directory also seemed to work. - -*** On SunOS 4.1.3, Emacs unpredictably crashes in _yp_dobind_soft. - -This happens if you configure Emacs specifying just `sparc-sun-sunos4' -on a system that is version 4.1.3. You must specify the precise -version number (or let configure figure out the configuration, which -it can do perfectly well for SunOS). - -*** Mail is lost when sent to local aliases. - -Many emacs mail user agents (VM and rmail, for instance) use the -sendmail.el library. This library can arrange for mail to be -delivered by passing messages to the /usr/lib/sendmail (usually) -program . In doing so, it passes the '-t' flag to sendmail, which -means that the name of the recipient of the message is not on the -command line and, therefore, that sendmail must parse the message to -obtain the destination address. - -There is a bug in the SunOS4.1.1 and SunOS4.1.3 versions of sendmail. -In short, when given the -t flag, the SunOS sendmail won't recognize -non-local (i.e. NIS) aliases. It has been reported that the Solaris -2.x versions of sendmail do not have this bug. For those using SunOS -4.1, the best fix is to install sendmail V8 or IDA sendmail (which -have other advantages over the regular sendmail as well). At the time -of this writing, these official versions are available: - - Sendmail V8 on ftp.cs.berkeley.edu in /ucb/sendmail: - sendmail.8.6.9.base.tar.Z (the base system source & documentation) - sendmail.8.6.9.cf.tar.Z (configuration files) - sendmail.8.6.9.misc.tar.Z (miscellaneous support programs) - sendmail.8.6.9.xdoc.tar.Z (extended documentation, with postscript) - - IDA sendmail on vixen.cso.uiuc.edu in /pub: - sendmail-5.67b+IDA-1.5.tar.gz - -*** Emacs fails to understand most Internet host names, even though -the names work properly with other programs on the same system. - Emacs won't work with X-windows if the value of DISPLAY is HOSTNAME:0. - Gnus can't make contact with the specified host for nntp. - -This typically happens on Suns and other systems that use shared -libraries. The cause is that the site has installed a version of the -shared library which uses a name server--but has not installed a -similar version of the unshared library which Emacs uses. - -The result is that most programs, using the shared library, work with -the nameserver, but Emacs does not. - -The fix is to install an unshared library that corresponds to what you -installed in the shared library, and then relink Emacs. - -On SunOS 4.1, simply define HAVE_RES_INIT. - -If you have already installed the name resolver in the file libresolv.a, -then you need to compile Emacs to use that library. The easiest way to -do this is to add to config.h a definition of LIBS_SYSTEM, LIBS_MACHINE -or LIB_STANDARD which uses -lresolv. Watch out! If you redefine a macro -that is already in use in your configuration to supply some other libraries, -be careful not to lose the others. - -Thus, you could start by adding this to config.h: - -#define LIBS_SYSTEM -lresolv - -Then if this gives you an error for redefining a macro, and you see that -the s- file defines LIBS_SYSTEM as -lfoo -lbar, you could change config.h -again to say this: - -#define LIBS_SYSTEM -lresolv -lfoo -lbar - -*** With process-connection-type set to t, each line of subprocess -output is terminated with a ^M, making ange-ftp and GNUS not work. - -On SunOS systems, this problem has been seen to be a result of an -incomplete installation of gcc 2.2 which allowed some non-ANSI -compatible include files into the compilation. In particular this -affected virtually all ioctl() calls. - - -** Linux -*** You get crashes in a non-C locale with Linux GNU Libc 2.0. - -Internationalization was not the top priority for GNU Libc 2.0. -As of this writing (1998-12-28) you may get crashes while running -XEmacs in a non-C locale. For example, `LC_ALL=en_US xemacs' crashes -while `LC_ALL=C xemacs' runs fine. This happens for example with GNU -libc 2.0.7. Installing libintl.a and libintl.h built from gettext -0.10.35 and re-building XEmacs solves the crashes. Presumably soon -everyone will upgrade to GNU Libc 2.1 and this problem will go away. - -*** `C-z', or `M-x suspend-emacs' hangs instead of suspending. - -If you build with `gpm' support on Linux, you cannot suspend XEmacs -because gpm installs a buggy SIGTSTP handler. Either compile with -`--with-gpm=no', or don't suspend XEmacs on the Linux console until -this bug is fixed. - -*** With certain fonts, when the cursor appears on a character, the -character doesn't appear--you get a solid box instead. - -One user on a Linux system reported that this problem went away with -installation of a new X server. The failing server was XFree86 3.1.1. -XFree86 3.1.2 works. - -*** Slow startup on Linux. - -People using systems based on the Linux kernel sometimes report that -startup takes 10 to 15 seconds longer than `usual'. - -This is because Emacs looks up the host name when it starts. -Normally, this takes negligible time; the extra delay is due to -improper system configuration. This problem can occur for both -networked and non-networked machines. - -Here is how to fix the configuration. It requires being root. - -**** Networked Case - -First, make sure the files `/etc/hosts' and `/etc/host.conf' both -exist. The first line in the `/etc/hosts' file should look like this -(replace HOSTNAME with your host name): - - 127.0.0.1 localhost HOSTNAME - -Also make sure that the `/etc/host.conf' files contains the following -lines: - - order hosts, bind - multi on - -Any changes, permanent and temporary, to the host name should be -indicated in the `/etc/hosts' file, since it acts a limited local -database of addresses and names (e.g., some SLIP connections -dynamically allocate ip addresses). - -**** Non-Networked Case - -The solution described in the networked case applies here as well. -However, if you never intend to network your machine, you can use a -simpler solution: create an empty `/etc/host.conf' file. The command -`touch /etc/host.conf' suffices to create the file. The `/etc/hosts' -file is not necessary with this approach. - - -** IRIX -*** On Irix, I don't see the toolbar icons and I'm getting lots of -entries in the warnings buffer. - -SGI ships a really old Xpm library in /usr/lib which does not work at -all well with XEmacs. The solution is to install your own copy of the -latest version of Xpm somewhere and then use the --site-includes and ---site-libraries flags to tell configure where to find it. - -*** Trouble using ptys on IRIX, or running out of ptys. - -The program mkpts (which may be in `/usr/adm' or `/usr/sbin') needs to -be set-UID to root, or non-root programs like Emacs will not be able -to allocate ptys reliably. - -*** Motif dialog boxes lose on Irix. - -Larry Auton writes: -Beware of not specifying - - --with-dialogs=athena - -if it builds with the motif dialogs [boom!] you're a dead man. - -*** Beware of the default image & graphics library on Irix - -Richard Cognot writes: - -You *have* to compile your own jpeg lib. The one delivered with SGI -systems is a C++ lib, which apparently XEmacs cannot cope with. - - -** Digital UNIX/OSF/VMS/Ultrix -*** XEmacs crashes on Digital Unix within font-lock, or when dealing -with large compilation buffers. - -The default stack size under Digital Unix is rather small (2M as -opposed to Solaris 8M), hosing the regexp code, which uses alloca() -extensively, overflowing the stack when complex regexps are used. -Workarounds: - -1) Increase your stack size, using `ulimit -s 8192' or a (t)csh - equivalent; - -2) Recompile regex.c with REGEX_MALLOC defined. - -*** The `Alt' key doesn't behave as `Meta' when running DECwindows. - -The default DEC keyboard mapping has the Alt keys set up to generate the -keysym `Multi_key', which has a meaning to xemacs which is distinct from that -of the `Meta_L' and `Meta-R' keysyms. A second problem is that certain keys -have the Mod2 modifier attached to them for no adequately explored reason. -The correct fix is to pass this file to xmodmap upon starting X: - - clear mod2 - keysym Multi_key = Alt_L - add mod1 = Alt_L - add mod1 = Alt_R - -*** The Compose key on a DEC keyboard does not work as Meta key. - -This shell command should fix it: - - xmodmap -e 'keycode 0xb1 = Meta_L' - -*** `expand-file-name' fails to work on any but the machine you dumped -Emacs on. - -On Ultrix, if you use any of the functions which look up information -in the passwd database before dumping Emacs (say, by using -expand-file-name in site-init.el), then those functions will not work -in the dumped Emacs on any host but the one Emacs was dumped on. - -The solution? Don't use expand-file-name in site-init.el, or in -anything it loads. Yuck - some solution. - -I'm not sure why this happens; if you can find out exactly what is -going on, and perhaps find a fix or a workaround, please let us know. -Perhaps the YP functions cache some information, the cache is included -in the dumped Emacs, and is then inaccurate on any other host. - - -** HP-UX -*** I get complaints about the mapping of my HP keyboard at startup, -but I haven't changed anything. - -The default HP keymap is set up to have Mod1 assigned to two different keys: -Meta_L and Mode_switch (even though there is not actually a Mode_switch key on -the keyboard -- it uses an "imaginary" keycode.) There actually is a reason -for this, but it's not a good one. The correct fix is to execute this command -upon starting X: - - xmodmap -e 'remove mod1 = Mode_switch' - -*** On HP-UX, you get "poll: Interrupted system call" message in the -window where XEmacs was launched. - -Richard Cognot writes: - - I get a very strange problem when linking libc.a dynamically: every - event (mouse, keyboard, expose...) results in a "poll: Interrupted - system call" message in the window where XEmacs was - launched. Forcing a static link of libc.a alone by adding - /usr/lib/libc.a at the end of the link line solves this. Note that - my 9.07 build of 19.14b17 and my (old) build of 19.13 both exhibit - the same behaviour. I've tried various hpux patches to no avail. If - this problem cannot be solved before the release date, binary kits - for HP *must* be linked statically against libc, otherwise this - problem will show up. (This is directed at whoever will volunteer - for this kit, as I won't be available to do it, unless 19.14 gets - delayed until mid-june ;-). I think this problem will be an FAQ soon - after the release otherwise. - -Note: The above entry is probably not valid for XEmacs 21.0 and -later. - -*** The right Alt key works wrong on German HP keyboards (and perhaps - other non-English HP keyboards too). - -This is because HP-UX defines the modifiers wrong in X. Here is a -shell script to fix the problem; be sure that it is run after VUE -configures the X server. - - xmodmap 2> /dev/null - << EOF - keysym Alt_L = Meta_L - keysym Alt_R = Meta_R - EOF - - xmodmap - << EOF - clear mod1 - keysym Mode_switch = NoSymbol - add mod1 = Meta_L - keysym Meta_R = Mode_switch - add mod2 = Mode_switch - EOF - -*** `Pid xxx killed due to text modification or page I/O error' - -On HP-UX, you can get that error when the Emacs executable is on an NFS -file system. HP-UX responds this way if it tries to swap in a page and -does not get a response from the server within a timeout whose default -value is just ten seconds. - -If this happens to you, extend the timeout period. - -*** Shell mode on HP-UX gives the message, "`tty`: Ambiguous". - -christos@theory.tn.cornell.edu says: - -The problem is that in your .cshrc you have something that tries to -execute `tty`. If you are not running the shell on a real tty then tty -will print "not a tty". Csh expects one word in some places, but tty -is giving it back 3. - -The solution is to add a pair of quotes around `tty` to make it a -single word: - -if (`tty` == "/dev/console") - -should be changed to: - -if ("`tty`" == "/dev/console") - -Even better, move things that set up terminal sections out of .cshrc -and into .login. - - -** SCO -*** Regular expressions matching bugs on SCO systems. - -On SCO, there are problems in regexp matching when Emacs is compiled -with the system compiler. The compiler version is "Microsoft C -version 6", SCO 4.2.0h Dev Sys Maintenance Supplement 01/06/93; Quick -C Compiler Version 1.00.46 (Beta). The solution is to compile with -GCC. - - -** Windows -*** Emacs exits with "X protocol error" when run with an X server for -Windows. - -A certain X server for Windows had a bug which caused this. -Supposedly the newer 32-bit version of this server doesn't have the -problem. - - - -* Compatibility problems (with Emacs 18, GNU Emacs, or previous XEmacs/lemacs) -============================================================================== - -*** "Symbol's value as variable is void: unread-command-char". - "Wrong type argument: arrayp, #" - "Wrong type argument: stringp, [#]" - -There are a few incompatible changes in XEmacs, and these are the -symptoms. Some of the emacs-lisp code you are running needs to be -updated to be compatible with XEmacs. - -The code should not treat keymaps as arrays (use `define-key', etc.), -should not use obsolete variables like `unread-command-char' (use -`unread-command-events'). Many (most) of the new ways of doing things -are compatible in GNU Emacs and XEmacs. - -Modern Emacs packages (Gnus, VM, W3, efs, etc) are written to support -GNU Emacs and XEmacs. We have provided modified versions of several -popular emacs packages (dired, etc) which are compatible with this -version of emacs. Check to make sure you have not set your load-path -so that your private copies of these packages are being found before -the versions in the lisp directory. - -Make sure that your load-path and your $EMACSLOADPATH environment -variable are not pointing at an Emacs18 lisp directory. This will -cripple emacs. - -** Some packages that worked before now cause the error -Wrong type argument: arrayp, # - -Code which uses the `face' accessor functions must be recompiled with -xemacs 19.9 or later. The functions whose callers must be recompiled -are: face-font, face-foreground, face-background, -face-background-pixmap, and face-underline-p. The .elc files -generated by version 19.9 will work in 19.6 and 19.8, but older .elc -files which contain calls to these functions will not work in 19.9. - -** Signaling: (error "Byte code stack underflow (byte compiler bug), pc 38") - -This error is given when XEmacs 20 is compiled without MULE support -but is attempting to load a .elc which requires MULE support. The fix -is to rebytecompile the offending file. - -** Signaling: (wrong-type-argument ...) when loading mail-abbrevs - -The is seen when installing the Insidious Big Brother Data Base (bbdb) -which includes an outdated copy of mail-abbrevs.el. Remove the copy -that comes with bbdb and use the one that comes with XEmacs. - - -* MULE issues -============= - -** A reminder: XEmacs/Mule work does not currently receive *any* -funding, and all work is done by volunteers. If you think you can -help, please contact the XEmacs maintainers. - -** XEmacs/Mule doesn't support TTY's satisfactorily. - -This is a major problem, which we plan to address in a future release -of XEmacs. Basically, XEmacs should have primitives to be told -whether the terminal can handle international output, and which -locale. Also, it should be able to do approximations of characters to -the nearest supported by the locale. - -** Internationalized (Asian) Isearch doesn't work. - -Currently, Isearch doesn't directly support any of the input methods -that are not XIM based (like egg, canna and quail) (and there are -potential problems with XIM version too...). If you're using egg -there is a workaround. Hitting right after C-s to invoke -Isearch will put Isearch in string mode, where a complete string can -be typed into the minibuffer and then processed by Isearch afterwards. -Since egg is now supported in the minibuffer using string mode you can -now use egg to input your Japanese, Korean or Chinese string, then hit -return to send that to Isearch and then use standard Isearch commands -from there. - -** Using egg and mousing around while in 'fence' mode screws up my -buffer. - -Don't do this. The fence modes of egg and canna are currently very -modal, and messing with where they expect point to be and what they -think is the current buffer is just asking for trouble. If you're -lucky they will realize that something is awry, and simply delete the -fence, but worst case can trash other buffers too. We've tried to -protect against this where we can, but there still are many ways to -shoot yourself in the foot. So just finish what you are typing into -the fence before reaching for the mouse. - -** Not all languages in Quail are supported like Devanagari and Indian -languages, Lao and Tibetan. - -Quail requires more work and testing. Although it has been ported to -XEmacs, it works really well for Japanese and for the European -languages. - -** Right-to-left mode is not yet implemented, so languages like -Arabic, Hebrew and Thai don't work. - -Getting this right requires more work. It may be implemented in a -future XEmacs version, but don't hold your breath. If you know -someone who is ready to implement this, please let us know. - -** We need more developers and native language testers. It's extremely -difficult (and not particularly productive) to address languages that -nobody is using and testing. - -** The kWnn and cWnn support for Chinese and Korean needs developers -and testers. It probably doesn't work. - -** There are no `native XEmacs' TUTORIALs for any Asian languages, -including Japanese. FSF Emacs and XEmacs tutorials are quite similar, -so it should be sufficient to skim through the differences and apply -them to the Japanese version. - -** We only have localized menus translated for Japanese, and the -Japanese menus are developing bitrot (the Mule menu appears in -English). - -** XIM is untested for any language other than Japanese. diff --git a/README b/README deleted file mode 100644 index 3715e1c..0000000 --- a/README +++ /dev/null @@ -1,63 +0,0 @@ -This directory tree holds version 21.2 of XEmacs, the extensible, -customizable, self-documenting real-time display editor. This version -of XEmacs also runs on various Microsoft Windows platforms including -MS Windows '95 and MS Windows NT and Cygwin. - -See the file `etc/NEWS' for information on new features and other -user-visible changes since the last version of XEmacs. - -The file `INSTALL' in this directory says how to bring up XEmacs on -Unix and Cygwin, once you have loaded the entire subtree of this -directory. - -The file `PROBLEMS' contains information on many common problems that -occur in building, installing and running XEmacs. - -See the file `nt/README' for instructions on building XEmacs for -Microsoft Windows. - -Reports of bugs in XEmacs should be posted to the newsgroup -comp.emacs.xemacs or sent to the mailing list xemacs@xemacs.org. See -the "Bugs" section of the XEmacs manual for more information on how to -report bugs. (The file `BUGS' in this directory explains how you can -find and read that section using the Info files that come with -XEmacs.) See `etc/MAILINGLISTS' for more information on mailing lists -relating to XEmacs and other GNU products. - -The file `configure' is a shell script to acclimate XEmacs to the -oddities of your processor and operating system. It will create a -file named `Makefile' (a script for the `make' program), which helps -automate the process of building and installing emacs. See INSTALL -for more detailed information. - -The file `configure.in' is the input used by the autoconf program to -construct the `configure' script. Since XEmacs has configuration -requirements that autoconf can't meet, `configure.in' uses an unholy -marriage of custom-baked configuration code and autoconf macros; it -may be wise to avoid rebuilding `configure' from `configure.in' when -possible. - -The file `Makefile.in' is a template used by `configure' to create -`Makefile'. - -There are several subdirectories: - -`src' holds the C code for Emacs (the XEmacs Lisp interpreter and its - primitives, the redisplay code, and some basic editing functions). -`lisp' holds the Emacs Lisp code for XEmacs (most everything else). -`lib-src' holds the source code for some utility programs for use by - or with XEmacs, like movemail and etags. -`etc' holds miscellaneous architecture-independent data files - XEmacs uses, like the tutorial text and the Zippy the Pinhead quote - database. The contents of the `lisp', `info' and `man' - subdirectories are architecture-independent too. -`lwlib' holds the C code for the toolkit objects used by XEmacs. - -`info' holds the Info documentation tree for XEmacs. -`man' holds the source code for the XEmacs info documentation tree. - -`msdos' holds configuration files for compiling XEmacs under MSDOG. - See the file etc/MSDOS for more information. - -`nt' holds configuration files for compiling XEmacs under Microsoft Windows - NT. The support for NT is very tentative right now. diff --git a/README.packages b/README.packages deleted file mode 100644 index 014eb00..0000000 --- a/README.packages +++ /dev/null @@ -1,227 +0,0 @@ -The XEmacs Packages Quick Start Guide -------------------------------------- - -This text is intended to help you get started installing a new XEmacs -and its packages from start. For details see the 'Startup Paths' and -'Packages' sections of the XEmacs info manual. - -Real Real Quickstart FAQ ------------------------- - -Q. Do I need to have the packages to compile XEmacs? -A. If you want to compile with MULE, you need the mule-base package installed. - Otherwise, no package is required before compilation. - -Q. I really liked the old way that packages were bundled and do not - want to mess with packages at all. -A. You can grab all the packages at once like you used to with old - XEmacs versions, skip to the 'Sumo Tarball' section below. - -A note of caution ------------------ - -The XEmacs package system is still in its infancy. Please expect a few -minor hurdles on the way. Also neither the interface nor the structure is -set in stone. The XEmacs maintainers reserve the right to sacrifice -backwards compatibility as quirks are worked out over the coming -releases. - -Some Package Theory -------------------- - -In order to reduce the size and increase the maintainability of XEmacs, -the majority of the Elisp packages that came with previous releases -have been unbundled. They have been replaced by the package system. -Each elisp add-on (or groups of them when they are small) now comes -in its own tarball that contains a small search hierarchy. - -You select just the ones you need. Install them by untarring them into -the right place. On startup XEmacs will find them, set up the load -path correctly, install autoloads, etc, etc. - -Package hierarchies -------------------- - -On Startup XEmacs looks for packages in so called package hierarchies. -These can be specified by the 'package-path' parameter to the -'configure' script. However by default there are three system wide -hierarchies. - -$prefix/lib/xemacs/site-packages - Local and 3rd party packages go here. - -$prefix/lib/xemacs/mule-packages - Only searched by MULE-enabled XEmacsen. - -$prefix/lib/xemacs/xemacs-packages - Normal packages go here. - -Where to get the packages -------------------------- - -Packages are available from ftp://ftp.xemacs.org/pub/xemacs/packages -and its mirror. - -How to install the packages ---------------------------- - -1. All at once, using the 'Sumo Tarball'. -2. By hand. -3. Automatically, using the package tools from XEmacs. - -The Sumo Tarball ----------------- - -Those with little time, cheap connections and plenty of disk space can -install all packages at once using the sumo tarballs. -Download the file - -xemacs-sumo-.tar.gz - -For an XEmacs compiled with Mule you also need - -xemacs-mule-sumo-.tar.gz - -N.B. They are called 'Sumo Tarballs' for good reason. They are -currently about 15MB and 2.3MB (gzipped) respectively. - -Install them by - -cd $prefix/lib/xemacs ; gunzip -c | tar xf - - -As the Sumo tarballs are not regenerated as often as the individual -packages, it is recommended that you use the automatic package tools -afterwards to pick up any recent updates. - -Installing by Hand ------------------- - -Fetch the packages from the ftp site, CDROM whatever. The filenames -have the form name--pkg.tar.gz and are gzipped tar files. For -a fresh install it is sufficient to untar the file at the top of the -package hierarchy. For example if we are installing the 'xemacs-base' -package in version 1.27: - -mkdir $prefix/lib/xemacs/xemacs-packages # if it does not exist yet -cd $prefix/lib/xemacs/xemacs-packages -gunzip -c ...../xemacs-base-1.27-pkg.tar.gz | tar xf - - -For MULE related packages, it is best to untar in the mule-packages -hierarchy, i.e. for the mule-base package, version 1.25 - -mkdir $prefix/lib/xemacs/mule-packages # if it does not exist yet -cd $prefix/lib/xemacs/mule-packages -gunzip -c ...../mule-base-1.25-pkg.tar.gz | tar xf - - -Installing automatically ------------------------- - -XEmacs comes with some tools to make the periodic updating and -installing easier. It will notice if new packages or versions are -available and will fetch them from the ftp site. - -Unfortunately this requires that a few packages are already in place. -You will have to install them by hand as above or use a SUMO tarball. -This requirement will hopefully go away in the future. The packages -you need are: - - efs - To fetch the files from the ftp site or mirrors. - xemacs-base - Needed by efs. - -and optionally: - - mailcrypt - If you have PGP installed and want to verify the - signature of the index file. - mule-base - Needed if you want to compile XEmacs with MULE. - -After installing these by hand, you can start XEmacs. (It is a good -idea to use 'xemacs -vanilla' here as your startup files might need -things now moved to packages.) - - - First you need to specify an FTP site to use. - Use Options->Manage Packages->Add Download Site - or M-x customize-variable RET package-get-remote RET - - Alternatively, if you already have the packages on a local disk - then you can specify this directly using 'M-x - pui-add-install-directory'. Please make sure you also have a - corresponding copy of the package index there. - - - Invoke Options->Manage Packages->List & Install - or M-x pui-list-packages RET - XEmacs will now first try to fetch a new version of the package - index from the FTP site. Depending on whether you are using - 'mailcrypt/PGP', you will get some question about keys to fetch or - whether to use the index without verifying the signature. If the - new index was different from the one already on disk, XEmacs will - offer you to overwrite the old index. - -- XEmacs will show you a buffer named "*Packages*" with an overview - of available and installed packages, including a short description. - In this buffer you can select which packages you want using the - mouse or using RET. - -- When you are finished choosing packages, invoke - 'Packages->Install/Remove Select' from the menu or type 'x' to - begin installing packages. - -After Installation ------------------- - -New packages can only be used by XEmacs after a restart. - -Note to MULE users ------------------- - -Unlike all other packages the mule-base package is used at build/dump -time. This means that you need this available before compiling XEmacs -with MULE. Also it is a good idea to keep packages that are -MULE-only separate by putting them in the mule-packages hierarchy. - -Which Packages to install? --------------------------- - -This is difficult to say. When in doubt install a package. If you -administrate a big site it might be a good idea to just install -everything. A good minimal set of packages for XEmacs-latin1 would be - -xemacs-base, xemacs-devel, c-support, cc-mode, debug, dired, efs, -edit-utils, fsf-compat, mail-lib, net-utils, os-utils, prog-modes, -text-modes, time - -Unfortunately the package system currently provides neither -dependencies nor conflicts. This will be a future enhancement. The -above set includes most packages that are used by others. - -See also '.../etc/PACKAGES' for further descriptions of the individual -packages (currently outdated). - -Upgrading/Removing Packages ---------------------------- - -As the exact files and their locations contained in a package may -change it is recommend to remove a package first before installing a -new version. In order to facilitate removal each package contains an -pgkinfo/MANIFEST.pkgname file which list all the files belong to the -package. M-x package-admin-delete-binary-package RET can be used to -remove a package using this file. - -Note that the interactive package tools included with XEmacs already do -this for you. - -User Package directories ------------------------- - -In addition to the system wide packages, each user can have his own -packages installed in "./xemacs" (Note that this will most likely -change to "./xemacs/packages" in the near future). If you want to -install packages there using the interactive tools, you need to set -'pui-package-install-dest-dir' to "/xemacs" - -Site lisp/Site start --------------------- - -The site-packages hierarchy replaces the old 'site-lisp' directory. -XEmacs no longer looks into a 'site-lisp' directly by default. -A good place to put 'site-start.el' would be in -$prefix/lib/xemacs/site-packages/lisp/ diff --git a/aclocal.m4 b/aclocal.m4 deleted file mode 100644 index 1348285..0000000 --- a/aclocal.m4 +++ /dev/null @@ -1,598 +0,0 @@ -dnl aclocal.m4 --- Dynamically linked library support for XEmacs -dnl Copyright (C) 1998, 1999 J. Kean Johnston. -dnl Author: J. Kean Johnston , based on work in libtool. -dnl This file is part of XEmacs. - -dnl -dnl There are several things we care about here. First, we need to find -dnl out how we create an executable that has its symbols exported, so -dnl that dynamically loaded modules have access to the internal XEmacs -dnl symbols. This is stored in ``ld_dynamic_link_flags'' and is used -dnl in the main Makefile. -dnl Next, we need to know how we compile actual shared libraries, and -dnl the objects in them. For these purposes, we need to determine the -dnl C compiler flags used to produce shared objects (``dll_cflags''), -dnl what linker to use to create the final shared object that will be -dnl loaded (``dll_ld'') and the flags to pass to that linker -dnl (``dll_ldflags''). This information is used by ellcc to build up -dnl the command line when compiling modules. We build up two other commands -dnl for extremely weird systems where special things need to be done. -dnl The first is ``dll_ldo'', which is the flag used to specify the output -dnl file name, and the second is ``dll_post'' which is inserted after the -dnl list of objects. -dnl After all of this, we should be able to: -dnl $(CC) $(CFLAGS) $(dll_cflags) -c module.c -dnl to produce a single shared object -dnl And then: -dnl $(dll_ld) $(dll_ldflags) $(dll_ldo) module.ell module.o $(dll_post) -dnl to create the loadable shared library. -dnl -dnl NOTE: In the code below, where I have modified things to work with -dnl XEmacs, we use $canonical instead of libtool's $host, and we use -dnl $internal_configuration instead of $host_alias. To make typing -dnl shorter we assign these to $xehost and $xealias - -AC_DEFUN(XE_SHLIB_STUFF,[ -dll_ld= -dll_ldflags= -dll_cflags= -dll_post= -dll_ldo="-o" -ld_dynamic_link_flags= -xehost=$canonical -xealias=$internal_configuration - -AC_CHECKING([how to build dynamic libraries for ${xehost}]) -# Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts. -case "$xehost" in -*-*-linux-gnu*) ;; -*-*-linux*) xehost=`echo $xehost | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'` -esac - -changequote(<<, >>)dnl -xehost_cpu=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -xehost_vendor=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -xehost_os=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` -changequote([, ])dnl - -case "$xehost_os" in -aix3*) - # AIX sometimes has problems with the GCC collect2 program. For some - # reason, if we set the COLLECT_NAMES environment variable, the problems - # vanish in a puff of smoke. - if test "${COLLECT_NAMES+set}" != set; then - COLLECT_NAMES= - export COLLECT_NAMES - fi - ;; -esac - -# Now see if the compiler is really GCC. -if test "$GCC" = "yes"; then - XEGCC=yes -else - AC_MSG_CHECKING(checking whether we are using GNU C) - AC_EGREP_CPP(yes,[ -#ifdef __GNUC__ - yes; -#endif -],XEGCC=yes, XEGCC=no) - AC_MSG_RESULT([${XEGCC}]) -fi - -AC_MSG_CHECKING(how to produce PIC code) -wl= - -can_build_shared=yes -if test "$XEGCC" = yes; then - wl='-Wl,' - - case "$xehost_os" in - aix3* | aix4* | irix5* | irix6* | osf3* | osf4*) - # PIC is the default for these OSes. - ;; - - os2*) - # We can build DLLs from non-PIC. - ;; - amigaos*) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the `-m68020' flag to GCC prevents building anything better, - # like `-m68040'. - dll_cflags='-m68020 -resident32 -malways-restore-a4' - ;; - *) - dll_cflags='-fPIC' - ;; - esac -else - # PORTME Check for PIC flags for the system compiler. - case "$xehost_os" in - hpux9* | hpux10*) - # Is there a better link_static_flag that works with the bundled CC? - wl='-Wl,' - dll_cflags='+Z' - ;; - - irix5* | irix6*) - wl='-Wl,' - # PIC (with -KPIC) is the default. - ;; - - os2*) - # We can build DLLs from non-PIC. - ;; - - osf3* | osf4*) - # All OSF/1 code is PIC. - wl='-Wl,' - ;; - - sco3.2v5*) - dll_cflags='-belf -Kpic' - wl='-Wl,' - ;; - - unixware*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - sysv4*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - sysv5*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - solaris2*) - dll_cflags='-KPIC' - wl='-Wl,' - ;; - - sunos4*) - dll_cflags='-PIC' - wl='-Qoption ld ' - ;; - - uts4*) - dll_cflags='-pic' - ;; - - *) - can_build_shared=no - ;; - esac -fi - -if test -n "$dll_cflags"; then - AC_MSG_RESULT([${dll_cflags}]) - - # Check to make sure the dll_cflags actually works. - AC_MSG_CHECKING([if PIC flag ${dll_cflags} really works]) - save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS $dll_cflags -DPIC" - AC_TRY_COMPILE(,[int x=0;],[ - # On HP-UX, the stripped-down bundled CC doesn't accept +Z, but also - # reports no error. So, we need to grep stderr for (Bundled). - if grep '(Bundled)' config.log >/dev/null; then - AC_MSG_RESULT(no) - can_build_shared=no - dll_cflags= - else - AC_MSG_RESULT(yes) - fi], [AC_MSG_RESULT(no) - can_build_shared=no - dll_cflags=]) - CFLAGS="$save_CFLAGS" -else - AC_MSG_RESULT(none) -fi - -dnl -dnl Now comes the LD trickery. We do things differently to libtool here. -dnl I believe that libtool is incorrect in trying to drive the linker -dnl directly. This can cause considerable problems if the module you are -dnl compiling has C++ or other static initializers. If we use ld directly, -dnl we dont end up with the crt stuff being linked in, and we dont end up -dnl with any .init or .fini sections (or the moral equivalent thereof). -dnl gcc takes great care to do this propperly when invoked in -shared -dnl mode, and we really do want this behaviour. Perhaps the libtool folks -dnl are not aware that any SVR4 based dynamic loader will automatically -dnl execute code in the .init section before dlopen() returns. This is -dnl vital, as the module may have been compiled to rely on that behaviour. -dnl -dnl So, having said all of that, we diverge from libtool significantly -dnl here. We want to try and use the C compiler as much as possible. Only -dnl if the C compiler itself cannot create shared libraries to we try to -dnl find the linker. -dnl -dnl The other advantage to my scheme is that it removes the dependancy -dnl on a given compiler version remaining static with relation to the -dnl version of XEmacs. With the libtool way, it picks up the linker that -dnl gcc uses, which can be the internal collect2 that comes with gcc. -dnl If the user ever changes their compiler version, the paths will no -dnl longer be correct, and ellcc will break. This is clearly unacceptable. -dnl By using the compiler driver on the path, we dont have this problem. -dnl If that is not clear, consider that gcc -print-prog-name=ld can -dnl produce something along the lines of: -dnl /usr/local/lib/gcc-lib/OS-NAME/GCC-VERSION/ld -dnl If you ever change GCC versions, then that path no longer exists. -dnl -dnl So, we change the check order here. We first check to see if we are -dnl using GCC, and if so, we see if -shared works. If it does, great. -dnl If we are not using gcc, but the system C compiler can produce -dnl shared objects, we try that. Only if all of that fails do we revert -dnl back to the libtool ld trickery. -dnl -dnl We dont do ANY of this if we can't produce shared objects. -dnl -if test "$can_build_shared" = "yes"; then -cc_produces_so=no -xldf= -xcldf= -AC_MSG_CHECKING(if C compiler can produce shared libraries) -if test "$XEGCC" = yes; then - xcldf="-shared" - xldf="-shared" -else # Not using GCC - case "$xehost_os" in - aix3* | aix4*) - xldf="-bE:ELLSONAME.exp -H512 -T512 -bhalt:4 -bM:SRE -bnoentry -lc" - xcldf="${wl}-bE:ELLSONAME.exp ${wl}-H512 ${wl}-T512 ${wl}-bhalt:4 ${wl}-bM:SRE ${wl}-bnoentry ${wl}-lc" - ;; - - freebsd2* | netbsd* | openbsd*) - xldf="-Bshareable" - xcldf="${wl}-Bshareable" - ;; - - freebsd3*) - xcldf="-shared" - ;; - - hpux*) - xldf="-b +s" - xcldf="${wl}-b ${wl}+s" - ;; - - irix5* | irix6* | osf3* | osf4*) - xcldf="${wl}-shared" - xldf="-shared" - ;; - - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7* | uts4*) - xcldf="-G" - xldf="-G" - ;; - - sunos4*) - xcldf="${wl}-assert ${wl}pure-text ${wl}-Bstatic" - xldf="-assert pure-text -Bstatic" - ;; - esac -fi # End if if we are using gcc - -if test -n "$xcldf"; then - save_LDFLAGS=$LDFLAGS - save_LIBS=$LIBS - save_xe_libs=$xe_libs - LDFLAGS="$xcldf $LDFLAGS" - LIBS= - xe_libs= - ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&AC_FD_CC' - AC_TRY_LINK(,[int x=0;],cc_produces_so=yes,cc_produces_so=no) - LDFLAGS=$save_LDFLAGS - LIBS=$save_LIBS - xe_libs=$save_xe_libs - ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&AC_FD_CC' -else - cc_produces_so=no -fi -AC_MSG_RESULT([${cc_produces_so}]) - -LTLD=$LD -if test -z "$LTLD"; then - ac_prog=ld - if test "$XEGCC" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - AC_MSG_CHECKING(for ld used by GCC) - ac_prog=`($CC -print-prog-name=ld) 2>&5` - case "$ac_prog" in - # Accept absolute paths. - /*) - if test -z "$LTLD"; then - case "$ac_prog" in - *gcc-lib*) LTLD="$CC" - ;; - *) LTLD="$ac_prog" - ;; - esac - fi - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac - else - AC_MSG_CHECKING(for GNU ld) - fi - - if test -z "$LTLD"; then - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog"; then - LTLD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some GNU ld's only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - if "$LTLD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then - xe_gnu_ld=yes - else - xe_gnu_ld=no - fi - fi - done - IFS="$ac_save_ifs" - fi - - if test -n "$LTLD"; then - AC_MSG_RESULT([${LTLD}]) - else - AC_MSG_RESULT(no) - fi - - if test -z "$LTLD" -a "$cc_produces_so" = no; then - AC_MSG_ERROR(no acceptable linker found in \$PATH) - exit 1 - fi -fi - -dnl -dnl Order of the tests changed somewhat to prevent repetition -dnl -ld_dynamic_link_flags= - -# Check to see if it really is or isn't GNU ld. -AC_MSG_CHECKING(if the linker is GNU ld) -# I'd rather use --version here, but apparently some GNU ld's only accept -v. -if $LTLD -v 2>&1 &5; then - xe_gnu_ld=yes -else - xe_gnu_ld=no -fi -AC_MSG_RESULT([${xe_gnu_ld}]) - -case "$xehost_os" in - amigaos* | sunos4*) - # On these operating systems, we should treat GNU ld like the system ld. - gnu_ld_acts_native=yes - ;; - *) - gnu_ld_acts_native=no - ;; -esac - -if test "$cc_produces_so" = "yes"; then - dll_ld=$CC - dll_ldflags=$xcldf - can_build_shared=yes -else - # OK - only NOW do we futz about with ld. - # See if the linker supports building shared libraries. - AC_MSG_CHECKING(whether the linker supports shared libraries) - dll_ld=$CC - dll_ldflags=$LDFLAGS - ld_shlibs=yes - can_build_shared=yes - if test "$xe_gnu_ld" = yes && test "$gnu_ld_acts_native" != yes; then - # See if GNU ld supports shared libraries. - if $LTLD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - dll_ld=$CC - dll_ldflags="-shared" - ld_shlibs=yes - else - ld_shlibs=no - fi - else - # PORTME fill in a description of your system's linker (not GNU ld) - case "$xehost_os" in - aix3*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - aix4*) - dll_ldflags=$xcldf - ;; - - # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor - # support. Future versions do this automatically, but an explicit c++rt0.o - # doesn't break anything, and helps significantly (at the cost of a little - # extra space). - freebsd2.2*) - dll_ld=$LTLD - dll_ldflags=$xldf - dll_post="/usr/lib/c++rt0.o" - ;; - - # Unfortunately, older versions of FreeBSD 2 don't have this feature. - freebsd2*) - dll_ld=$LTLD - dll_ldflags="-Bshareable" - ;; - - # FreeBSD 3, at last, uses gcc -shared to do shared libraries. - freebsd3*) - dll_ldflags="-shared" - ;; - - hpux*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - irix5* | irix6*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - netbsd*) - # Tested with NetBSD 1.2 ld - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - openbsd*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - osf3* | osf4*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - # For both SCO and Solaris we MAY want to have LDFLAGS include -z text - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) - dll_ld=$LTLD - case "$dll_ld" in - *gcc*) dll_ldflags="-shared" - dll_ld=$CC - ;; - *) dll_ldflags="-G" - ;; - esac - ;; - - sunos4*) - if test "$XEGCC" = yes; then - dll_ld=$CC - else - dll_ld=$LTLD - fi - dll_ldflags=$xldf - ;; - - uts4*) - dll_ld=$LTLD - dll_ldflags="-G" - ;; - - bsdi*) - dll_ldflags="-r" - dll_ld="shlicc2" - ;; - - *) - ld_shlibs=no - can_build_shared=no - ;; - esac - fi - AC_MSG_RESULT([${ld_shlibs}]) - if test "$ld_shlibs" = "no"; then - can_build_shared=no - fi -fi # End of if cc_produces_so = no - -dnl -dnl Last thing, check how to get a linked executable to have its symbols -dnl exported, so that the modules have access to them. -dnl -dnl XEmacs FIXME - we need to set ld_dynamic_link_flags propperly for -dnl most of these systems, which was missing from libtool. I know they -dnl all have a way of doing this, but someone needs to look at this -dnl for each OS and make sure it is correct. Remember that the arguments -dnl are passed when temacs is linked, this is NOT for modules. The sole -dnl purpose of the argument is to get the internal XEmacs symbols exposed -dnl for modules to use. This means that the COMPILER (and NOT the linker) -dnl is most often used to create temacs, so arguments to the linker will -dnl usually need to be prefix with ${wl} or some other such thing. -dnl - -if test "$xe_gnu_ld" = yes; then - if test "$ld_shlibs" = yes; then - ld_dynamic_link_flags="${wl}-export-dynamic" - fi -fi - -if test -z "$ld_dynamic_link_flags"; then - case "$xehost_os" in - aix3*) - ld_dynamic_link_flags= - ;; - - aix4*) - ld_dynamic_link_flags= - ;; - - freebsd2.2*) - ld_dynamic_link_flags= - ;; - - freebsd2*) - ld_dynamic_link_flags= - ;; - - freebsd3*) - ld_dynamic_link_flags= - ;; - - hpux*) - ld_dynamic_link_flags="${wl}-E" - ;; - - irix5* | irix6*) - ld_dynamic_link_flags= - ;; - - netbsd*) - ld_dynamic_link_flags= - ;; - - openbsd*) - ld_dynamic_link_flags= - ;; - - osf3* | osf4*) - ld_dynamic_link_flags= - ;; - - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) - ld_dynamic_link_flags="${wl}-Bexport" - ;; - - sunos4*) - ld_dynamic_link_flags= - ;; - - uts4*) - ld_dynamic_link_flags= - ;; - - bsdi*) - ld_dynamic_link_flags= - ;; - - esac -fi # End of if -z ld_dynamic_link_flags -fi # End of if test "$can_build_shared" = "yes" - -AC_SUBST(dll_ld) -AC_SUBST(dll_cflags) -AC_SUBST(dll_ldflags) -AC_SUBST(dll_post) -AC_SUBST(dll_ldo) -AC_SUBST(ld_dynamic_link_flags) -])dnl - diff --git a/config.guess b/config.guess deleted file mode 100755 index 6e82336..0000000 --- a/config.guess +++ /dev/null @@ -1,951 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright (C) 1992, 93, 94, 95, 96, 97, 1998 Free Software Foundation, Inc. -# -# 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 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. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Written by Per Bothner . -# The master version of this file is at the FSF in /home/gd/gnu/lib. -# -# This script attempts to guess a canonical system name similar to -# config.sub. If it succeeds, it prints the system name on stdout, and -# exits with 0. Otherwise, it exits with 1. -# -# The plan is that this can be called by configure scripts if you -# don't specify an explicit system type (host/target name). -# -# Only a few systems have been added to this list; please add others -# (but try to keep the structure clean). -# - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 8/24/94.) -if (test -f /.attbin/uname) >/dev/null 2>&1 ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15 - -# Note: order is significant - the case branches are not exclusive. - -case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - alpha:OSF1:*:*) - if test $UNAME_RELEASE = "V4.0"; then - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - fi - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - cat <dummy.s - .globl main - .ent main -main: - .frame \$30,0,\$26,0 - .prologue 0 - .long 0x47e03d80 # implver $0 - lda \$2,259 - .long 0x47e20c21 # amask $2,$1 - srl \$1,8,\$2 - sll \$2,2,\$2 - sll \$0,3,\$0 - addl \$1,\$0,\$0 - addl \$2,\$0,\$0 - ret \$31,(\$26),1 - .end main -EOF - ${CC-cc} dummy.s -o dummy 2>/dev/null - if test "$?" = 0 ; then - ./dummy - case "$?" in - 7) - UNAME_MACHINE="alpha" - ;; - 15) - UNAME_MACHINE="alphaev5" - ;; - 14) - UNAME_MACHINE="alphaev56" - ;; - 10) - UNAME_MACHINE="alphapca56" - ;; - 16) - UNAME_MACHINE="alphaev6" - ;; - esac - fi - rm -f dummy.s dummy - echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr [[A-Z]] [[a-z]]` - exit 0 ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit 0 ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-cbm-sysv4 - exit 0;; - amiga:NetBSD:*:*) - echo m68k-cbm-netbsd${UNAME_RELEASE} - exit 0 ;; - amiga:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo ${UNAME_MACHINE}-unknown-amigaos - exit 0 ;; - arc64:OpenBSD:*:*) - echo mips64el-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - hkmips:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - pmax:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sgi:OpenBSD:*:*) - echo mips-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - wgrisc:OpenBSD:*:*) - echo mipsel-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix${UNAME_RELEASE} - exit 0;; - arm32:NetBSD:*:*) - echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - SR2?01:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit 0;; - Pyramid*:OSx*:*:*|MIS*:OSx*:*:*|MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit 0 ;; - NILE:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit 0 ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - i86pc:SunOS:5.*:*) - echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` - exit 0 ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos${UNAME_RELEASE} - exit 0 ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(head -1 /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos${UNAME_RELEASE} - ;; - sun4) - echo sparc-sun-sunos${UNAME_RELEASE} - ;; - esac - exit 0 ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos${UNAME_RELEASE} - exit 0 ;; - atari*:NetBSD:*:*) - echo m68k-atari-netbsd${UNAME_RELEASE} - exit 0 ;; - atari*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sun3*:NetBSD:*:*) - echo m68k-sun-netbsd${UNAME_RELEASE} - exit 0 ;; - sun3*:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:NetBSD:*:*) - echo m68k-apple-netbsd${UNAME_RELEASE} - exit 0 ;; - mac68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme68k:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - mvme88k:OpenBSD:*:*) - echo m88k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - powerpc:machten:*:*) - echo powerpc-apple-machten${UNAME_RELEASE} - exit 0 ;; - macppc:NetBSD:*:*) - echo powerpc-apple-netbsd${UNAME_RELEASE} - exit 0 ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit 0 ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix${UNAME_RELEASE} - exit 0 ;; - 2020:CLIX:*:*) - echo clipper-intergraph-clix${UNAME_RELEASE} - exit 0 ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - sed 's/^ //' << EOF >dummy.c - int main (argc, argv) int argc; char **argv; { - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - ${CC-cc} dummy.c -o dummy \ - && ./dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \ - && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo mips-mips-riscos${UNAME_RELEASE} - exit 0 ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit 0 ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit 0 ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit 0 ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit 0 ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then - if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ - -o ${TARGET_BINARY_INTERFACE}x = x ] ; then - echo m88k-dg-dgux${UNAME_RELEASE} - else - echo m88k-dg-dguxbcs${UNAME_RELEASE} - fi - else echo i586-dg-dgux${UNAME_RELEASE} - fi - exit 0 ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit 0 ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit 0 ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit 0 ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit 0 ;; - *:IRIX*:*:*) - echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` - exit 0 ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i?86:AIX:*:*) - echo i386-ibm-aix - exit 0 ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - sed 's/^ //' << EOF >dummy.c - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo rs6000-ibm-aix3.2.5 - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit 0 ;; - *:AIX:*:4) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | head -1 | awk '{ print $1 }'` - if /usr/sbin/lsattr -EHl ${IBM_CPU_ID} | grep POWER >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV=4.${UNAME_RELEASE} - fi - echo ${IBM_ARCH}-ibm-aix${IBM_REV} - exit 0 ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit 0 ;; - ibmrt:4.4BSD:*|romp-ibm:BSD:*) - echo romp-ibm-bsd4.4 - exit 0 ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and - echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to - exit 0 ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit 0 ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit 0 ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit 0 ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit 0 ;; - 9000/[34678]??:HP-UX:*:*) - case "${UNAME_MACHINE}" in - 9000/31? ) HP_ARCH=m68000 ;; - 9000/[34]?? ) HP_ARCH=m68k ;; - 9000/6?? | 9000/7?? | 9000/80[24] | 9000/8?[13679] | 9000/892 ) - sed 's/^ //' << EOF >dummy.c - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - ${CC-cc} dummy.c -o dummy && HP_ARCH=`./dummy` - rm -f dummy.c dummy - esac - HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` - echo ${HP_ARCH}-hp-hpux${HPUX_REV} - exit 0 ;; - 3050*:HI-UX:*:*) - sed 's/^ //' << EOF >dummy.c - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - echo unknown-hitachi-hiuxwe2 - exit 0 ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) - echo hppa1.1-hp-bsd - exit 0 ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit 0 ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) - echo hppa1.1-hp-osf - exit 0 ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit 0 ;; - i?86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo ${UNAME_MACHINE}-unknown-osf1mk - else - echo ${UNAME_MACHINE}-unknown-osf1 - fi - exit 0 ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit 0 ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit 0 ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit 0 ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit 0 ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit 0 ;; - CRAY*X-MP:*:*:*) - echo xmp-cray-unicos - exit 0 ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos${UNAME_RELEASE} - exit 0 ;; - CRAY*[A-Z]90:*:*:*) - echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ - exit 0 ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos${UNAME_RELEASE} - exit 0 ;; - CRAY-2:*:*:*) - echo cray2-cray-unicos - exit 0 ;; - F300:UNIX_System_V:*:*) - FUJITSU_SYS=`uname -p | tr [A-Z] [a-z] | sed -e 's/\///'` - FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` - echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit 0 ;; - F301:UNIX_System_V:*:*) - echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'` - exit 0 ;; - hp3[0-9][05]:NetBSD:*:*) - echo m68k-hp-netbsd${UNAME_RELEASE} - exit 0 ;; - hp300:OpenBSD:*:*) - echo m68k-unknown-openbsd${UNAME_RELEASE} - exit 0 ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi${UNAME_RELEASE} - exit 0 ;; - i?86:BSD/386:*:* | *:BSD/OS:*:*) - echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} - exit 0 ;; - *:FreeBSD:*:*) - echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` - exit 0 ;; - *:NetBSD:*:*) - echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - *:OpenBSD:*:*) - echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` - exit 0 ;; - i*:CYGWIN*:*) - echo ${UNAME_MACHINE}-pc-cygwin32 - exit 0 ;; - i*:MINGW*:*) - echo ${UNAME_MACHINE}-pc-mingw32 - exit 0 ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin32 - exit 0 ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` - exit 0 ;; - *:GNU:*:*) - echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` - exit 0 ;; - *:Linux:*:*) - # uname on the ARM produces all sorts of strangeness, and we need to - # filter it out. - case "$UNAME_MACHINE" in - arm* | sa110*) UNAME_MACHINE="arm" ;; - esac - - # The BFD linker knows what the default object file format is, so - # first see if it will tell us. - ld_help_string=`ld --help 2>&1` - ld_supported_emulations=`echo $ld_help_string \ - | sed -ne '/supported emulations:/!d - s/[ ][ ]*/ /g - s/.*supported emulations: *// - s/ .*// - p'` - case "$ld_supported_emulations" in - i?86linux) echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 ;; - i?86coff) echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 ;; - sparclinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - armlinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - m68klinux) echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 ;; - elf32ppc) echo "powerpc-unknown-linux-gnu" ; exit 0 ;; - esac - - if test "${UNAME_MACHINE}" = "alpha" ; then - sed 's/^ //' <dummy.s - .globl main - .ent main - main: - .frame \$30,0,\$26,0 - .prologue 0 - .long 0x47e03d80 # implver $0 - lda \$2,259 - .long 0x47e20c21 # amask $2,$1 - srl \$1,8,\$2 - sll \$2,2,\$2 - sll \$0,3,\$0 - addl \$1,\$0,\$0 - addl \$2,\$0,\$0 - ret \$31,(\$26),1 - .end main -EOF - LIBC="" - ${CC-cc} dummy.s -o dummy 2>/dev/null - if test "$?" = 0 ; then - ./dummy - case "$?" in - 7) - UNAME_MACHINE="alpha" - ;; - 15) - UNAME_MACHINE="alphaev5" - ;; - 14) - UNAME_MACHINE="alphaev56" - ;; - 10) - UNAME_MACHINE="alphapca56" - ;; - 16) - UNAME_MACHINE="alphaev6" - ;; - esac - - objdump --private-headers dummy | \ - grep ld.so.1 > /dev/null - if test "$?" = 0 ; then - LIBC="libc1" - fi - fi - rm -f dummy.s dummy - echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0 - elif test "${UNAME_MACHINE}" = "mips" ; then - cat >dummy.c </dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - else - # Either a pre-BFD a.out linker (linux-gnuoldld) - # or one that does not give us useful --help. - # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout. - # If ld does not provide *any* "supported emulations:" - # that means it is gnuoldld. - echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:" - test $? != 0 && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0 - - case "${UNAME_MACHINE}" in - i?86) - VENDOR=pc; - ;; - *) - VENDOR=unknown; - ;; - esac - # Determine whether the default compiler is a.out or elf - cat >dummy.c < -main(argc, argv) - int argc; - char *argv[]; -{ -#ifdef __ELF__ -# ifdef __GLIBC__ -# if __GLIBC__ >= 2 - printf ("%s-${VENDOR}-linux-gnu\n", argv[1]); -# else - printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); -# endif -# else - printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]); -# endif -#else - printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]); -#endif - return 0; -} -EOF - ${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy "${UNAME_MACHINE}" && rm dummy.c dummy && exit 0 - rm -f dummy.c dummy - fi ;; -# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions -# are messed up and put the nodename in both sysname and nodename. - i?86:DYNIX/ptx:4*:*) - echo i386-sequent-sysv4 - exit 0 ;; - i?86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} - exit 0 ;; - i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*) - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} - else - echo ${UNAME_MACHINE}-pc-sysv${UNAME_RELEASE} - fi - exit 0 ;; - i?86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` - (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - echo ${UNAME_MACHINE}-pc-sco$UNAME_REL - else - echo ${UNAME_MACHINE}-pc-sysv32 - fi - exit 0 ;; - i?86:UnixWare:*:*) - if /bin/uname -X 2>/dev/null >/dev/null ; then - (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - fi - echo ${UNAME_MACHINE}-unixware-${UNAME_RELEASE}-${UNAME_VERSION} - exit 0 ;; - pc:*:*:*) - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i386. - echo i386-pc-msdosdjgpp - exit 0 ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit 0 ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit 0 ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 - fi - exit 0 ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit 0 ;; - M68*:*:R3V[567]*:*) - test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; - 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4.3${OS_REL} && exit 0 - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && echo i486-ncr-sysv4 && exit 0 ;; - m68*:LynxOS:2.*:*) - echo m68k-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit 0 ;; - i?86:LynxOS:2.*:*) - echo i386-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*) - echo rs6000-unknown-lynxos${UNAME_RELEASE} - exit 0 ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv${UNAME_RELEASE} - exit 0 ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit 0 ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo ${UNAME_MACHINE}-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit 0 ;; - PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit 0 ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit 0 ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit 0 ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux${UNAME_RELEASE} - exit 0 ;; - news*:NEWS-OS:*:6*) - echo mips-sony-newsos6 - exit 0 ;; - R3000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R4000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv${UNAME_RELEASE} - else - echo mips-unknown-sysv${UNAME_RELEASE} - fi - exit 0 ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit 0 ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit 0 ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit 0 ;; -esac - -#echo '(No uname command or uname output not recognized.)' 1>&2 -#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 - -cat >dummy.c < -# include -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (__arm) && defined (__acorn) && defined (__unix) - printf ("arm-acorn-riscix"); exit (0); -#endif - -#if defined (hp300) && !defined (hpux) - printf ("m68k-hp-bsd\n"); exit (0); -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); - -#endif - -#if defined (vax) -#if !defined (ultrix) - printf ("vax-dec-bsd\n"); exit (0); -#else - printf ("vax-dec-ultrix\n"); exit (0); -#endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0 -rm -f dummy.c dummy - -# Apollos put the system type in the environment. - -test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; } - -# Convex versions that predate uname can use getsysinfo(1) - -if [ -x /usr/convex/getsysinfo ] -then - case `getsysinfo -f cpu_type` in - c1*) - echo c1-convex-bsd - exit 0 ;; - c2*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit 0 ;; - c34*) - echo c34-convex-bsd - exit 0 ;; - c38*) - echo c38-convex-bsd - exit 0 ;; - c4*) - echo c4-convex-bsd - exit 0 ;; - esac -fi - -#echo '(Unable to guess system type)' 1>&2 - -exit 1 diff --git a/config.sub b/config.sub deleted file mode 100755 index f791166..0000000 --- a/config.sub +++ /dev/null @@ -1,955 +0,0 @@ -#! /bin/sh -# Configuration validation subroutine script, version 1.1. -# Copyright (C) 1991, 92-97, 1998 Free Software Foundation, Inc. -# This file is (in principle) common to ALL GNU software. -# The presence of a machine in this file suggests that SOME GNU software -# can handle that machine. It does not imply ALL GNU software can. -# -# 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 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. - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -if [ x$1 = x ] -then - echo Configuration name missing. 1>&2 - echo "Usage: $0 CPU-MFR-OPSYS" 1>&2 - echo "or $0 ALIAS" 1>&2 - echo where ALIAS is a recognized configuration type. 1>&2 - exit 1 -fi - -# First pass through any local machine types. -case $1 in - *local*) - echo $1 - exit 0 - ;; - *) - ;; -esac - -# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). -# Here we must recognize all the valid KERNEL-OS combinations. -maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` -case $maybe_os in - linux-gnu*) - os=-$maybe_os - basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` - ;; - *) - basic_machine=`echo $1 | sed 's/-[^-]*$//'` - if [ $basic_machine != $1 ] - then os=`echo $1 | sed 's/.*-/-/'` - else os=; fi - ;; -esac - -### Let's recognize common machines as not being operating systems so -### that things like config.sub decstation-3100 work. We also -### recognize some manufacturers as not being operating systems, so we -### can provide default operating systems below. -case $os in - -sun*os*) - # Prevent following clause from handling this invalid input. - ;; - -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ - -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ - -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ - -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ - -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ - -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ - -apple) - os= - basic_machine=$1 - ;; - -hiux*) - os=-hiuxwe2 - ;; - -sco5) - os=sco3.2v5 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco4) - os=-sco3.2v4 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco3.2v[4-9]*) - # Don't forget version if it is 3.2v4 or newer. - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -sco*) - os=-sco3.2v2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -isc) - os=-isc2.2 - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -clix*) - basic_machine=clipper-intergraph - ;; - -isc*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` - ;; - -lynx*) - os=-lynxos - ;; - -ptx*) - basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` - ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; - -psos*) - os=-psos - ;; -esac - -# Decode aliases for certain CPU-COMPANY combinations. -case $basic_machine in - # Recognize the basic CPU types without company name. - # Some are omitted here because they have special meanings below. - tahoe | i860 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \ - | arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \ - | 580 | i960 | h8300 | hppa | hppa1.0 | hppa1.1 | hppa2.0 \ - | alpha | alphaev5 | alphaev56 | we32k | ns16k | clipper \ - | i370 | sh | powerpc | powerpcle | 1750a | dsp16xx | pdp11 \ - | mips64 | mipsel | mips64el | mips64orion | mips64orionel \ - | mipstx39 | mipstx39el \ - | sparc | sparclet | sparclite | sparc64 | v850) - basic_machine=$basic_machine-unknown - ;; - # We use `pc' rather than `unknown' - # because (1) that's what they normally are, and - # (2) the word "unknown" tends to confuse beginning users. - i[34567]86) - basic_machine=$basic_machine-pc - ;; - # Object if more than one company name word. - *-*-*) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; - # Recognize the basic CPU types with company name. - vax-* | tahoe-* | i[34567]86-* | i860-* | m32r-* | m68k-* | m68000-* \ - | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \ - | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \ - | power-* | none-* | 580-* | cray2-* | h8300-* | i960-* \ - | xmp-* | ymp-* | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* \ - | alpha-* | alphaev5-* | alphaev56-* | we32k-* | cydra-* \ - | ns16k-* | pn-* | np1-* | xps100-* | clipper-* | orion-* \ - | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \ - | sparc64-* | mips64-* | mipsel-* \ - | mips64el-* | mips64orion-* | mips64orionel-* \ - | mipstx39-* | mipstx39el-* \ - | f301-*) - ;; - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - basic_machine=m68000-att - ;; - 3b*) - basic_machine=we32k-att - ;; - alliant | fx80) - basic_machine=fx80-alliant - ;; - altos | altos3068) - basic_machine=m68k-altos - ;; - am29k) - basic_machine=a29k-none - os=-bsd - ;; - amdahl) - basic_machine=580-amdahl - os=-sysv - ;; - amiga | amiga-*) - basic_machine=m68k-cbm - ;; - amigaos | amigados) - basic_machine=m68k-cbm - os=-amigaos - ;; - amigaunix | amix) - basic_machine=m68k-cbm - os=-sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=-sysv - ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; - balance) - basic_machine=ns32k-sequent - os=-dynix - ;; - convex-c1) - basic_machine=c1-convex - os=-bsd - ;; - convex-c2) - basic_machine=c2-convex - os=-bsd - ;; - convex-c32) - basic_machine=c32-convex - os=-bsd - ;; - convex-c34) - basic_machine=c34-convex - os=-bsd - ;; - convex-c38) - basic_machine=c38-convex - os=-bsd - ;; - cray | ymp) - basic_machine=ymp-cray - os=-unicos - ;; - cray2) - basic_machine=cray2-cray - os=-unicos - ;; - [ctj]90-cray) - basic_machine=c90-cray - os=-unicos - ;; - crds | unos) - basic_machine=m68k-crds - ;; - da30 | da30-*) - basic_machine=m68k-da30 - ;; - decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) - basic_machine=mips-dec - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - basic_machine=m68k-motorola - ;; - delta88) - basic_machine=m88k-motorola - os=-sysv3 - ;; - dpx20 | dpx20-*) - basic_machine=rs6000-bull - os=-bosx - ;; - dpx2* | dpx2*-bull) - basic_machine=m68k-bull - os=-sysv3 - ;; - ebmon29k) - basic_machine=a29k-amd - os=-ebmon - ;; - elxsi) - basic_machine=elxsi-elxsi - os=-bsd - ;; - encore | umax | mmax) - basic_machine=ns32k-encore - ;; - fx2800) - basic_machine=i860-alliant - ;; - genix) - basic_machine=ns32k-ns - ;; - gmicro) - basic_machine=tron-gmicro - os=-sysv - ;; - h3050r* | hiux*) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=-hms - ;; - harris) - basic_machine=m88k-harris - os=-sysv3 - ;; - hp300-*) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=-bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=-hpux - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - basic_machine=m68000-hp - ;; - hp9k3[2-9][0-9]) - basic_machine=m68k-hp - ;; - hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7) - basic_machine=hppa1.1-hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - basic_machine=hppa1.0-hp - ;; - hppa-next) - os=-nextstep3 - ;; - i370-ibm* | ibm*) - basic_machine=i370-ibm - os=-mvs - ;; -# I'm not sure what "Sysv32" means. Should this be sysv3.2? - i[34567]86v32) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv32 - ;; - i[34567]86v4*) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv4 - ;; - i[34567]86v) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-sysv - ;; - i[34567]86sol2) - basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` - os=-solaris2 - ;; - iris | iris4d) - basic_machine=mips-sgi - case $os in - -irix*) - ;; - *) - os=-irix4 - ;; - esac - ;; - isi68 | isi) - basic_machine=m68k-isi - os=-sysv - ;; - m88k-omron*) - basic_machine=m88k-omron - ;; - magnum | m3230) - basic_machine=mips-mips - os=-sysv - ;; - merlin) - basic_machine=ns32k-utek - os=-sysv - ;; - miniframe) - basic_machine=m68000-convergent - ;; - mipsel*-linux*) - basic_machine=mipsel-unknown - os=-linux-gnu - ;; - mips*-linux*) - basic_machine=mips-unknown - os=-linux-gnu - ;; - mips3*-*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` - ;; - mips3*) - basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown - ;; - ncr3000) - basic_machine=i486-ncr - os=-sysv4 - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=-newsos - ;; - news1000) - basic_machine=m68030-sony - os=-newsos - ;; - news-3600 | risc-news) - basic_machine=mips-sony - os=-newsos - ;; - next | m*-next ) - basic_machine=m68k-next - case $os in - -nextstep* ) - ;; - -ns2*) - os=-nextstep2 - ;; - *) - os=-nextstep3 - ;; - esac - ;; - nh3000) - basic_machine=m68k-harris - os=-cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=-cxux - ;; - nindy960) - basic_machine=i960-intel - os=-nindy - ;; - np1) - basic_machine=np1-gould - ;; - pa-hitachi) - basic_machine=hppa1.1-hitachi - os=-hiuxwe2 - ;; - paragon) - basic_machine=i860-intel - os=-osf - ;; - pbd) - basic_machine=sparc-tti - ;; - pbb) - basic_machine=m68k-tti - ;; - pc532 | pc532-*) - basic_machine=ns32k-pc532 - ;; - pentium | p5 | k5 | nexen) - basic_machine=i586-pc - ;; - pentiumpro | p6 | k6 | 6x86) - basic_machine=i686-pc - ;; - pentiumii | pentium2) - basic_machine=i786-pc - ;; - pentium-* | p5-* | k5-* | nexen-*) - basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumpro-* | p6-* | k6-* | 6x86-*) - basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pentiumii-* | pentium2-*) - basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - pn) - basic_machine=pn-gould - ;; - power) basic_machine=rs6000-ibm - ;; - ppc) basic_machine=powerpc-unknown - ;; - ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ppcle | powerpclittle | ppc-le | powerpc-little) - basic_machine=powerpcle-unknown - ;; - ppcle-* | powerpclittle-*) - basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` - ;; - ps2) - basic_machine=i386-ibm - ;; - rm[46]00) - basic_machine=mips-siemens - ;; - rtpc | rtpc-*) - basic_machine=romp-ibm - ;; - sequent) - basic_machine=i386-sequent - ;; - sh) - basic_machine=sh-hitachi - os=-hms - ;; - sps7) - basic_machine=m68k-bull - os=-sysv2 - ;; - spur) - basic_machine=spur-unknown - ;; - sun2) - basic_machine=m68000-sun - ;; - sun2os3) - basic_machine=m68000-sun - os=-sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=-sunos4 - ;; - sun3os3) - basic_machine=m68k-sun - os=-sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=-sunos4 - ;; - sun4os3) - basic_machine=sparc-sun - os=-sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=-sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=-solaris2 - ;; - sun3 | sun3-*) - basic_machine=m68k-sun - ;; - sun4) - basic_machine=sparc-sun - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - ;; - symmetry) - basic_machine=i386-sequent - os=-dynix - ;; - tx39) - basic_machine=mipstx39-unknown - ;; - tx39el) - basic_machine=mipstx39el-unknown - ;; - tower | tower-32) - basic_machine=m68k-ncr - ;; - udi29k) - basic_machine=a29k-amd - os=-udi - ;; - ultra3) - basic_machine=a29k-nyu - os=-sym1 - ;; - vaxv) - basic_machine=vax-dec - os=-sysv - ;; - vms) - basic_machine=vax-dec - os=-vms - ;; - vpp*|vx|vx-*) - basic_machine=f301-fujitsu - ;; - vxworks960) - basic_machine=i960-wrs - os=-vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=-vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=-vxworks - ;; - xmp) - basic_machine=xmp-cray - os=-unicos - ;; - xps | xps100) - basic_machine=xps100-honeywell - ;; - none) - basic_machine=none-none - os=-none - ;; - -# Here we handle the default manufacturer of certain CPU types. It is in -# some cases the only manufacturer, in others, it is the most popular. - mips) - if [ x$os = x-linux-gnu ]; then - basic_machine=mips-unknown - else - basic_machine=mips-mips - fi - ;; - romp) - basic_machine=romp-ibm - ;; - rs6000) - basic_machine=rs6000-ibm - ;; - vax) - basic_machine=vax-dec - ;; - pdp11) - basic_machine=pdp11-dec - ;; - we32k) - basic_machine=we32k-att - ;; - sparc) - basic_machine=sparc-sun - ;; - cydra) - basic_machine=cydra-cydrome - ;; - orion) - basic_machine=orion-highlevel - ;; - orion105) - basic_machine=clipper-highlevel - ;; - *) - echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 - exit 1 - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $basic_machine in - *-digital*) - basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` - ;; - *-commodore*) - basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x"$os" != x"" ] -then -case $os in - # First match some system type aliases - # that might get confused with valid system types. - # -solaris* is a basic system type, with this one exception. - -solaris1 | -solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - -solaris) - os=-solaris2 - ;; - -svr4*) - os=-sysv4 - ;; - -unixware*) - os=-sysv4.2uw - ;; - -gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # First accept the basic system types. - # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. - # -sysv* is not here because it comes later, after sysvr4. - -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ - | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ - | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ - | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ - | -aos* \ - | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ - | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ - | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \ - | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ - | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ - | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ - | -cygwin32* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ - | -mingw32* | -linux-gnu* | -uxpv* | -beos*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - -linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - -sunos5*) - os=`echo $os | sed -e 's|sunos5|solaris2|'` - ;; - -sunos6*) - os=`echo $os | sed -e 's|sunos6|solaris3|'` - ;; - -osfrose*) - os=-osfrose - ;; - -osf*) - os=-osf - ;; - -utek*) - os=-bsd - ;; - -dynix*) - os=-bsd - ;; - -acis*) - os=-aos - ;; - -ctix* | -uts*) - os=-sysv - ;; - -ns2 ) - os=-nextstep2 - ;; - # Preserve the version number of sinix5. - -sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - -sinix*) - os=-sysv4 - ;; - -triton*) - os=-sysv3 - ;; - -oss*) - os=-sysv3 - ;; - -svr4) - os=-sysv4 - ;; - -svr3) - os=-sysv3 - ;; - -sysvr4) - os=-sysv4 - ;; - # This must come after -sysvr4. - -sysv*) - ;; - -xenix) - os=-xenix - ;; - -none) - ;; - *) - # Get rid of the `-' at the beginning of $os. - os=`echo $os | sed 's/[^-]*-//'` - echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $basic_machine in - *-acorn) - os=-riscix1.2 - ;; - arm*-semi) - os=-aout - ;; - pdp11-*) - os=-none - ;; - *-dec | vax-*) - os=-ultrix4.2 - ;; - m68*-apollo) - os=-domain - ;; - i386-sun) - os=-sunos4.0.2 - ;; - m68000-sun) - os=-sunos3 - # This also exists in the configure program, but was not the - # default. - # os=-sunos4 - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=-sysv3 - ;; - sparc-* | *-sun) - os=-sunos4.1.1 - ;; - *-be) - os=-beos - ;; - *-ibm) - os=-aix - ;; - *-hp) - os=-hpux - ;; - *-hitachi) - os=-hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=-sysv - ;; - *-cbm) - os=-amigaos - ;; - *-dg) - os=-dgux - ;; - *-dolphin) - os=-sysv3 - ;; - m68k-ccur) - os=-rtu - ;; - m88k-omron*) - os=-luna - ;; - *-next ) - os=-nextstep - ;; - *-sequent) - os=-ptx - ;; - *-crds) - os=-unos - ;; - *-ns) - os=-genix - ;; - i370-*) - os=-mvs - ;; - *-next) - os=-nextstep3 - ;; - *-gould) - os=-sysv - ;; - *-highlevel) - os=-bsd - ;; - *-encore) - os=-bsd - ;; - *-sgi) - os=-irix - ;; - *-siemens) - os=-sysv4 - ;; - *-masscomp) - os=-rtu - ;; - f301-fujitsu) - os=-uxpv - ;; - *) - os=-none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -vendor=unknown -case $basic_machine in - *-unknown) - case $os in - -riscix*) - vendor=acorn - ;; - -sunos*) - vendor=sun - ;; - -aix*) - vendor=ibm - ;; - -hpux*) - vendor=hp - ;; - -hiux*) - vendor=hitachi - ;; - -unos*) - vendor=crds - ;; - -dgux*) - vendor=dg - ;; - -luna*) - vendor=omron - ;; - -genix*) - vendor=ns - ;; - -mvs*) - vendor=ibm - ;; - -ptx*) - vendor=sequent - ;; - -vxsim* | -vxworks*) - vendor=wrs - ;; - -aux*) - vendor=apple - ;; - esac - basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; -esac - -echo $basic_machine$os diff --git a/configure b/configure deleted file mode 100755 index 6818c5f..0000000 --- a/configure +++ /dev/null @@ -1,13757 +0,0 @@ -#! /bin/sh - -#### Configuration script for XEmacs. Largely divergent from FSF. -#### Guess values for system-dependent variables and create Makefiles. -#### Generated automatically using autoconf version 2.13 -#### Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. -#### Copyright (C) 1993-1995 Board of Trustees, University of Illinois. -#### Copyright (C) 1996, 1997 Sun Microsystems, Inc. -#### Copyright (C) 1995, 1996 Ben Wing. -#### Copyright (C) 1998, 1999 J. Kean Johnston. - -### Don't edit this script! -### This script was automatically generated by the `autoconf' program -### from the file `./configure.in'. -### To rebuild it, execute the command -### autoconf -### in the this directory. You must have autoconf version 2.12 or later. - -### 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. - -### For usage, run `./configure --help' -### For more detailed information on building and installing XEmacs, -### read the file `INSTALL'. -### -### If configure succeeds, it leaves its status in config.status. -### A log of configuration tests can be found in config.log. -### If configure fails after disturbing the status quo, -### config.status is removed. - -ac_help="$ac_help - --with-x use the X Window System" - - - -if test -n "$ZSH_VERSION"; then - setopt NO_BAD_PATTERN NO_BANG_HIST NO_BG_NICE NO_EQUALS NO_FUNCTION_ARGZERO - setopt GLOB_SUBST NO_HUP INTERACTIVE_COMMENTS KSH_ARRAYS NO_MULTIOS NO_NOMATCH - setopt RM_STAR_SILENT POSIX_BUILTINS SH_FILE_EXPANSION SH_GLOB SH_OPTION_LETTERS - setopt SH_WORD_SPLIT BSD_ECHO IGNORE_BRACES - if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi -elif test -n "$BASH_VERSION"; then - set -o posix - unset CDPATH -else - if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi -fi - -exec_prefix=NONE -host=NONE -no_create= -nonopt=NONE -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -target=NONE -verbose= -x_includes=NONE -x_libraries=NONE - -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/share' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -libdir='${{exec_prefix}}/lib' -includedir='${prefix}/include' -oldincludedir='/usr/include' -infodir='${prefix}/info' -mandir='${prefix}/man' - -subdirs= -MFLAGS= MAKEFLAGS= -ac_max_here_lines=12 - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -# File descriptor usage: -# 0 standard input -# 1 file creation -# 2 errors and warnings -# 3 some systems may open it to /dev/tty -# 4 used on the Kubota Titan -# 6 checking for... messages and results -# 5 compiler messages saved in config.log -if test "$silent" = yes; then - exec 6>/dev/null -else - exec 6>&1 -fi -exec 5>./config.log - -echo "\ -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. -" 1>&5 - -# Strip out --no-create and --no-recursion so they do not pile up. -# Also quote any args containing shell metacharacters. -ac_configure_args= -for ac_arg -do - case "$ac_arg" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) - ac_configure_args="$ac_configure_args '$ac_arg'" ;; - *) ac_configure_args="$ac_configure_args $ac_arg" ;; - esac -done - -# NLS nuisances. -# Only set these to C if already set. These must not be set unconditionally -# because not all systems understand e.g. LANG=C (notably SCO). -# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! -# Non-C LC_CTYPE values break the ctype check. -if test "${LANG+set}" = set; then LANG=C; export LANG; fi -if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi -if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi -if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi - -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -rf conftest* confdefs.h -# AIX cpp loses on an empty file, so make sure it contains at least a newline. -echo > confdefs.h - -# A filename unique to this package, relative to the directory that -# configure is in, which we can look for to find out if srcdir is correct. -ac_unique_file=src/lisp.h - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - ac_srcdir_defaulted=yes - # Try the directory containing this script, then its parent. - ac_prog=$0 - ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` - test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. - srcdir=$ac_confdir - if test ! -r $srcdir/$ac_unique_file; then - srcdir=.. - fi -else - ac_srcdir_defaulted=no -fi -if test ! -r $srcdir/$ac_unique_file; then - if test "$ac_srcdir_defaulted" = yes; then - { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } - else - { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } - fi -fi -srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` - -# Prefer explicitly selected file to automatically selected ones. -if test -z "$CONFIG_SITE"; then - if test "x$prefix" != xNONE; then - CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" - else - CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" - fi -fi -for ac_site_file in $CONFIG_SITE; do - if test -r "$ac_site_file"; then - echo "loading site script $ac_site_file" - . "$ac_site_file" - fi -done - - -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -ac_exeext= -ac_objext=o -if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then - # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. - if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then - ac_n= ac_c=' -' ac_t=' ' - else - ac_n=-n ac_c= ac_t= - fi -else - ac_n= ac_c='\c' ac_t= -fi - - -progname="`echo $0 | sed 's:^\./\./:\./:'`" - - -MAKE_SUBDIR="$MAKE_SUBDIR lib-src" && if test "$extra_verbose" = "yes"; then echo " Appending \"lib-src\" to \$MAKE_SUBDIR"; fi -INSTALL_ARCH_DEP_SUBDIR="$INSTALL_ARCH_DEP_SUBDIR lib-src" && if test "$extra_verbose" = "yes"; then echo " Appending \"lib-src\" to \$INSTALL_ARCH_DEP_SUBDIR"; fi - -prefix='/usr/local' -exec_prefix='${prefix}' -bindir='${exec_prefix}/bin' -datadir='${prefix}/lib' -statedir='${prefix}/lib' -libdir='${exec_prefix}/lib' -mandir='${prefix}/man/man1' -infodir='${datadir}/${PROGNAME}-${version}/info' -infopath='' -install_pp='' -lispdir='${datadir}/${PROGNAME}-${version}/lisp' -moduledir='${datadir}/${PROGNAME}-${version}/${configuration}/modules' -sitelispdir='${datadir}/xemacs/site-lisp' -sitemoduledir='${datadir}/xemacs/site-modules' -pkgdir='${datadir}/${PROGNAME}-${version}/lisp' -package_path='' -etcdir='${datadir}/${PROGNAME}-${version}/etc' -lockdir='${statedir}/${PROGNAME}/lock' -archlibdir='${datadir}/${PROGNAME}-${version}/${configuration}' -with_site_lisp='no' -with_site_modules='yes' -with_menubars='' -with_scrollbars='' -with_dialogs='' -with_file_coding='' -puresize='' -cpp='' cppflags='' libs='' ldflags='' -dynamic='' -with_x11='' -with_msw='' -rel_alloc='default' -with_system_malloc='default' -with_dlmalloc='default' -native_sound_lib='' -use_assertions="yes" -with_toolbars="" -with_tty="" -use_union_type="no" -with_dnet="" - - - - -arguments="$@" - -quoted_sed_magic=s/"'"/"'"'"'"'"'"'"'"/g -quoted_arguments= -for i in "$@"; do - case "$i" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *) - quoted_i="`echo '' $i | sed -e 's:^ ::' -e $quoted_sed_magic`" - quoted_arguments="$quoted_arguments '$quoted_i'" ;; - esac -done - -while test $# != 0; do - arg="$1"; shift - case "$arg" in - --no-create|--no-recursion) ;; - -* ) - case "$arg" in - -*=*) - opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\([^=]*\)=.*$:\1:'` - val=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*[^=]*=\(.*\)$:\1:'` - valomitted=no - ;; - -*) - opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\(.*\)$:\1:'` - val="yes" valomitted=yes - ;; - esac - - optname="$opt" - opt="`echo '' $opt | sed -e 's:^ ::' | tr - _`" - - case "${valomitted}-${opt}" in yes-without_* ) - opt=`echo $opt | sed 's/without/with/'` - valomitted="no" val="no" ;; - esac - - case "$opt" in - - with_site_lisp | \ - with_site_modules | \ - with_x | \ - with_x11 | \ - with_msw | \ - with_gcc | \ - dynamic | \ - with_ncurses | \ - with_dnet | \ - with_socks | \ - with_dragndrop | \ - with_cde | \ - with_offix | \ - with_gpm | \ - with_xpm | \ - with_xface | \ - with_gif | \ - with_jpeg | \ - with_png | \ - with_tiff | \ - with_session | \ - with_xmu | \ - with_purify | \ - with_quantify | \ - with_toolbars | \ - with_tty | \ - with_xfs | \ - with_i18n3 | \ - with_mule | \ - with_file_coding| \ - with_canna | \ - with_wnn | \ - with_wnn6 | \ - with_workshop | \ - with_sparcworks | \ - with_tooltalk | \ - with_ldap | \ - with_pop | \ - with_kerberos | \ - with_hesiod | \ - with_dnet | \ - with_infodock | \ - external_widget | \ - verbose | \ - extra_verbose | \ - const_is_losing | \ - usage_tracking | \ - use_union_type | \ - debug | \ - use_assertions | \ - gung_ho | \ - use_minimal_tagbits | \ - use_indexed_lrecord_implementation | \ - memory_usage_stats | \ - with_clash_detection | \ - with_shlib | \ - no_doc_file ) - case "$val" in - y | ye | yes ) val=yes ;; - n | no ) val=no ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option requires a boolean value: \`yes' or \`no'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - eval "$opt=\"$val\"" ;; - - - srcdir | \ - compiler | \ - cflags | \ - cpp | \ - cppflags | \ - libs | \ - ldflags | \ - puresize | \ - cache_file | \ - native_sound_lib| \ - site_lisp | \ - x_includes | \ - x_libraries | \ - site_includes | \ - site_libraries | \ - site_prefixes | \ - site_runtime_libraries ) - if test "$valomitted" = "yes" ; then - if test "$#" = 0 ; then - (echo "$progname: Usage error:" -echo " " "The \`--$optname' option requires a value." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1; - fi - val="$1"; shift - fi - eval "$opt=\"$val\"" - ;; - - rel_alloc | \ - with_dlmalloc | \ - with_debug_malloc | use_debug_malloc | \ - with_system_malloc | use_system_malloc ) - case "$val" in - y | ye | yes ) val=yes ;; - n | no ) val=no ;; - d | de | def | defa | defau | defaul | default ) val=default ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option requires one of these values: - \`yes', \`no', or \`default'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - case "$opt" in use_* ) opt="`echo $opt | sed s/use/with/`" ;; esac - eval "$opt=\"$val\"" - ;; - - "with_database" ) - with_database_berkdb=no - with_database_dbm=no - with_database_gnudbm=no - for x in `echo "$val" | sed -e 's/,/ /g'` ; do - case "$x" in - no ) ;; - b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; - d | db | dbm ) with_database_dbm=yes ;; - g | gn | gnu | gnud | gnudb | gnudbm ) with_database_gnudbm=yes ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option value - must be either \`no' or a comma-separated list - of one or more of \`berkdb' and either \`dbm' or \`gnudbm'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - done - if test "$with_database_dbm" = "yes" -a \ - "$with_database_gnudbm" = "yes"; then - (echo "$progname: Usage error:" -echo " " "Only one of \`dbm' and \`gnudbm' may be specified - with the \`--$optname' option." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi - ;; - - "with_sound" ) - case "$val" in - y | ye | yes ) val=native ;; - n | no | non | none ) val=no;; - na | nat | nati | nativ | native ) val=native ;; - ne | net | neta | netau | netaud | netaudi | netaudio | nas ) val=nas ;; - b | bo | bot | both ) val=both;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option must have one of these values: - \`native', \`nas', \`both', or \`none'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - eval "$opt=\"$val\"" - ;; - - "with_xim" ) - case "$val" in - y | ye | yes ) val=yes ;; - n | no | non | none ) val=no ;; - x | xl | xli | xlib ) val=xlib ;; - m | mo | mot | moti | motif ) val=motif ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option must have one of these values: - \`motif', \`xlib', \`yes', or \`no'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - eval "$opt=\"$val\"" - ;; - - "mail_locking" ) - case "$val" in - lockf ) val=lockf ;; - flock ) val=flock ;; - file ) val=file ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option must have one of these values: - \`lockf', \`flock', or \`file'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - eval "$opt=\"$val\"" - ;; - - "error_checking" ) - - for x in `echo "$val" | sed -e 's/,/ /g'` ; do - case "$x" in - n | no | non | none ) new_default=no ;; - a | al | all ) new_default=yes ;; - - extents ) error_check_extents=yes ;; - noextents ) error_check_extents=no ;; - - typecheck ) error_check_typecheck=yes ;; - notypecheck ) error_check_typecheck=no ;; - - bufpos ) error_check_bufpos=yes ;; - nobufpos ) error_check_bufpos=no ;; - - gc ) error_check_gc=yes ;; - nogc ) error_check_gc=no ;; - - malloc ) error_check_malloc=yes ;; - nomalloc ) error_check_malloc=no ;; - - * ) bogus_error_check=yes ;; - esac - if test "$bogus_error_check" -o \ - \( -n "$new_default" -a -n "$echeck_notfirst" \) ; then - if test "$error_check_default" = yes ; then - types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', and \`nomalloc'." - else - types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'." - fi - (echo "$progname: Usage error:" -echo " " "Valid types for the \`--$optname' option are: - $types." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - elif test -n "$new_default" ; then - error_check_extents=$new_default - error_check_typecheck=$new_default - error_check_bufpos=$new_default - error_check_gc=$new_default - error_check_malloc=$new_default - new_default= # reset this - fi - echeck_notfirst=true - done - ;; - - - prefix | exec_prefix | bindir | datadir | statedir | libdir | \ - mandir | infodir | infopath | lispdir | etcdir | lockdir | pkgdir | \ - archlibdir | docdir | package_path ) - if test "$valomitted" = "yes"; then - if test "$#" = 0; then - (echo "$progname: Usage error:" -echo " " "The \`--$optname' option requires a value." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1; - fi - val="$1"; shift - fi - eval "$opt=\"$val\"" - - case "$opt" in - lispdir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining LISPDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define LISPDIR_USER_DEFINED 1 -EOF -} - ;; - sitelispdir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining SITELISPDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define SITELISPDIR_USER_DEFINED 1 -EOF -} - ;; - moduledir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining MODULEDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define MODULEDIR_USER_DEFINED 1 -EOF -} - ;; - etcdir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining ETCDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define ETCDIR_USER_DEFINED 1 -EOF -} - ;; - infodir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining INFODIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define INFODIR_USER_DEFINED 1 -EOF -} - ;; - infopath ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining INFOPATH_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define INFOPATH_USER_DEFINED 1 -EOF -} - ;; - package_path ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining PACKAGE_PATH_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define PACKAGE_PATH_USER_DEFINED 1 -EOF -} - ;; - datadir ) - { test "$extra_verbose" = "yes" && cat << \EOF - Defining INFODIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define INFODIR_USER_DEFINED 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining LISPDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define LISPDIR_USER_DEFINED 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining MODULEDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define MODULEDIR_USER_DEFINED 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining ETCDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define ETCDIR_USER_DEFINED 1 -EOF -} - ;; - statedir | lockdir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining LOCKDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define LOCKDIR_USER_DEFINED 1 -EOF -} - ;; - exec_prefix | libdir | archlibdir ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining ARCHLIBDIR_USER_DEFINED -EOF -cat >> confdefs.h <<\EOF -#define ARCHLIBDIR_USER_DEFINED 1 -EOF -} - ;; - esac - ;; - - "no_create" ) ;; - - "usage" | "help" ) ${PAGER-more} ${srcdir}/configure.usage; exit 0 ;; - - "with_menubars" | \ - "with_scrollbars" | \ - "with_dialogs" ) - case "$val" in - l | lu | luc | luci | lucid ) val=lucid ;; - m | mo | mot | moti | motif ) val=motif ;; - athena3d | athena-3d ) val=athena3d ;; - a | at | ath | athe | athen | athena ) val=athena ;; - n | no | non | none ) val=no ;; - * ) (echo "$progname: Usage error:" -echo " " "The \`--$optname' option must have one of these values: - \`lucid', \`motif', \`athena', \`athena3d', or \`no'." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - esac - eval "$opt=\"$val\"" - ;; - - "run_in_place" | \ - "with_gnu_make" ) - echo "configure: warning: Obsolete option \`--$optname' ignored." 1>&2 - ;; - - * ) (echo "$progname: Usage error:" -echo " " "Unrecognized option: $arg" -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - - esac - ;; - - *-*-*) configuration="$arg" ;; - - *) (echo "$progname: Usage error:" -echo " " "Unrecognized argument: $arg" -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; - - esac -done - - -test -n "$cpp" && CPP="$cpp" -test -n "$cppflags" && CPPFLAGS="$cppflags" -test -n "$libs" && LIBS="$libs" -test -n "$ldflags" && LDFLAGS="$ldflags" - -eval set x "$quoted_arguments"; shift - -test "$extra_verbose" = "yes" && verbose=yes - -test -n "$with_x" && with_x11="$with_x" - -if test "$with_purify" = "yes" -o "$with_quantify" = "yes"; then - test "$with_system_malloc" = "default" && with_system_malloc=yes -fi - -if test -n "$gung_ho"; then - test -z "$use_minimal_tagbits" && use_minimal_tagbits="$gung_ho" - test -z "$use_indexed_lrecord_implementation" && \ - use_indexed_lrecord_implementation="$gung_ho" -fi -if test "$use_minimal_tagbits" = "no"; then - test "$with_dlmalloc" = "yes" && \ - (echo "$progname: Usage error:" -echo " " "--with-dlmalloc requires --use-minimal-tagbits" -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - with_dlmalloc=no -fi - - - -if test "$with_cde $with_tooltalk" = "yes no"; then - (echo "$progname: Usage error:" -echo " " "--with-cde requires --with-tooltalk" -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 -elif test "$with_tooltalk" = "no" ; then with_cde=no -elif test "$with_cde" = "yes"; then with_tooltalk=yes -fi - - -case "$srcdir" in - - "" ) - for dir in "`echo $0 | sed 's|//|/|' | sed 's|/[^/]*$||'`" "." ".." ; do - if test -f "$dir/src/lisp.h" -a \ - -f "$dir/lisp/version.el" ; then - srcdir="$dir" - break - fi - done - if test -z "$srcdir" ; then - (echo "$progname: Usage error:" -echo " " "Neither the current directory nor its parent seem to - contain the XEmacs sources. If you do not want to build XEmacs in its - source tree, you should run \`$progname' in the directory in which - you wish to build XEmacs, using the \`--srcdir' option to say where the - sources may be found." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi - ;; - - * ) - if test ! -f "$srcdir/src/lisp.h" -o \ - ! -f "$srcdir/lisp/version.el" ; then - (echo "$progname: Usage error:" -echo " " "The directory specified with the \`--srcdir' option, - \`$srcdir', doesn't seem to contain the XEmacs sources. You should - either run the \`$progname' script at the top of the XEmacs source - tree, or use the \`--srcdir' option to specify the XEmacs source directory." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi - ;; -esac - -if test -z "$configuration"; then - configuration=`${CONFIG_SHELL-/bin/sh} $srcdir/config.guess` - if test -z "$configuration"; then - (echo "$progname: Usage error:" -echo " " "XEmacs has not been ported to this host type. -Try explicitly specifying the CONFIGURATION when rerunning configure." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi -fi - -echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 -echo "configure:787: checking whether ln -s works" >&5 - -rm -f conftestdata -if ln -s X conftestdata 2>/dev/null -then - rm -f conftestdata - ac_cv_prog_LN_S="ln -s" -else - ac_cv_prog_LN_S=ln -fi -LN_S="$ac_cv_prog_LN_S" -if test "$ac_cv_prog_LN_S" = "ln -s"; then - echo "$ac_t""yes" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - -for dir in lisp etc man info; do - if test ! -d "$dir" ; then - echo Making symbolic link to "$srcdir/$dir" - ${LN_S} "$srcdir/$dir" "$dir" - fi -done - - -absolute_pwd="`pwd`"; -if test -n "$PWD" -a "`cd $PWD && pwd`" = "$absolute_pwd" -then blddir="$PWD" -else blddir="$absolute_pwd"; if test -d "/net"; then - if test -d "/tmp_mnt/net"; then tdir="tmp_mnt/net"; else tdir="tmp_mnt"; fi - blddir=`echo "$blddir" | \ - sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` -fi -fi - - -case "$srcdir" in - /* ) ;; - . ) srcdir="$blddir" ;; - * ) srcdir="`cd $srcdir && pwd`"; if test -d "/net"; then - if test -d "/tmp_mnt/net"; then tdir="tmp_mnt/net"; else tdir="tmp_mnt"; fi - srcdir=`echo "$srcdir" | \ - sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` -fi ;; -esac - -if test `pwd` != `sh -c cd $srcdir && pwd` \ - && test -f "$srcdir/src/config.h"; then - (echo "$progname: WARNING: The directory tree \`$srcdir' is being used" - echo " as a build directory right now; it has been configured in its own" - echo " right. To configure in another directory as well, you MUST" - echo " use GNU make. If you do not have GNU make, then you must" - echo " now do \`make distclean' in $srcdir," - echo " and then run $progname again.") >&2 - extrasub='/^VPATH[ ]*=/c\ -vpath %.c $(srcdir)\ -vpath %.h $(srcdir)\ -vpath %.y $(srcdir)\ -vpath %.l $(srcdir)\ -vpath %.s $(srcdir)\ -vpath %.in $(srcdir)' -fi - -. "$srcdir/version.sh" || exit 1; -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi -: "${extra_verbose=$beta}" -version="${emacs_major_version}.${emacs_minor_version}" -{ test "$extra_verbose" = "yes" && cat << EOF - Defining EMACS_MAJOR_VERSION = $emacs_major_version -EOF -cat >> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <<\EOF -#define ERROR_CHECK_EXTENTS 1 -EOF -} - -test "${error_check_typecheck=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF - Defining ERROR_CHECK_TYPECHECK -EOF -cat >> confdefs.h <<\EOF -#define ERROR_CHECK_TYPECHECK 1 -EOF -} - -test "${error_check_bufpos=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF - Defining ERROR_CHECK_BUFPOS -EOF -cat >> confdefs.h <<\EOF -#define ERROR_CHECK_BUFPOS 1 -EOF -} - -test "${error_check_gc=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF - Defining ERROR_CHECK_GC -EOF -cat >> confdefs.h <<\EOF -#define ERROR_CHECK_GC 1 -EOF -} - -test "${error_check_malloc=$beta}" = yes && { test "$extra_verbose" = "yes" && cat << \EOF - Defining ERROR_CHECK_MALLOC -EOF -cat >> confdefs.h <<\EOF -#define ERROR_CHECK_MALLOC 1 -EOF -} - -if test "${debug:=$beta}" = "yes"; then - use_assertions=yes memory_usage_stats=yes - extra_objs="$extra_objs debug.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"debug.o\"" - fi - { test "$extra_verbose" = "yes" && cat << \EOF - Defining DEBUG_XEMACS -EOF -cat >> confdefs.h <<\EOF -#define DEBUG_XEMACS 1 -EOF -} - -fi -test "$use_assertions" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_ASSERTIONS -EOF -cat >> confdefs.h <<\EOF -#define USE_ASSERTIONS 1 -EOF -} - -test "$memory_usage_stats" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining MEMORY_USAGE_STATS -EOF -cat >> confdefs.h <<\EOF -#define MEMORY_USAGE_STATS 1 -EOF -} - - - -echo $ac_n "checking "host system type"""... $ac_c" 1>&6 -echo "configure:1012: checking "host system type"" >&5 -internal_configuration=`echo $configuration | sed 's/-\(workshop\)//'` -canonical=`${CONFIG_SHELL-/bin/sh} $srcdir/config.sub "$internal_configuration"` -configuration=`echo "$configuration" | sed 's/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/'` -canonical=`echo "$canonical" | sed 's/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/'` -echo "$ac_t""$configuration" 1>&6 - - - - - -machine='' opsys='' - -case "$canonical" in - sparc-*-* ) machine=sparc ;; - alpha*-*-* ) machine=alpha ;; - vax-*-* ) machine=vax ;; - mips-dec-* ) machine=pmax ;; - mips-sgi-* ) machine=iris4d ;; - romp-ibm-* ) machine=ibmrt ;; - rs6000-ibm-aix* ) machine=ibmrs6000 ;; - powerpc-ibm-aix* ) machine=ibmrs6000 ;; - powerpc*-* ) machine=powerpc ;; - hppa-*-* ) machine=hp800 ;; - m88k-dg-* ) machine=aviion ;; - m68*-sony-* ) machine=news ;; - mips-sony-* ) machine=news-risc ;; - clipper-* ) machine=clipper ;; - arm-* ) machine=arm ;; - ns32k-* ) machine=ns32000 ;; -esac - -case "$canonical" in - *-*-linux* ) opsys=linux ;; - *-*-netbsd* ) opsys=netbsd ;; - *-*-openbsd* ) opsys=openbsd ;; - *-*-nextstep* ) opsys=nextstep ;; - *-*-vms ) opsys=vms ;; - - *-dec-osf1.3 | *-dec-osf2* ) opsys=decosf1-3 ;; - *-dec-osf1.2 | *-dec-osf1* ) opsys=decosf1-2 ;; - *-dec-osf3.[2-9] ) opsys=decosf3-2 ;; - *-dec-osf3* ) opsys=decosf3-1 ;; - *-dec-osf4* ) opsys=decosf4-0 ;; - - *-*-ultrix[0-3].* | *-*-ultrix4.0* ) opsys=bsd4-2 ;; - *-*-ultrix4.[12]* ) opsys=bsd4-3 ;; - *-*-ultrix* ) opsys=ultrix4-3 ;; - - *-*-aix3.1* ) opsys=aix3-1 ;; - *-*-aix3.2.5 ) opsys=aix3-2-5 ;; - *-*-aix3* ) opsys=aix3-2 ;; - *-*-aix4.0* ) opsys=aix4 ;; - *-*-aix4.1* ) opsys=aix4-1 ;; - *-*-aix4* ) opsys=aix4-2 ;; - - *-gnu* ) opsys=gnu ;; - *-*-bsd4.[01] ) opsys=bsd4-1 ;; - *-*-bsd4.2 ) opsys=bsd4-2 ;; - *-*-bsd4.3 ) opsys=bsd4-3 ;; - *-*-aos4.2 ) opsys=bsd4-2 ;; - *-*-aos* ) opsys=bsd4-3 ;; - *-*-sysv0 | *-*-sysvr0 ) opsys=usg5-0 ;; - *-*-sysv2 | *-*-sysvr2 ) opsys=usg5-2 ;; - *-*-sysv2.2 | *-*-sysvr2.2 ) opsys=usg5-2-2 ;; - *-*-sysv3* | *-*-sysvr3* ) opsys=usg5-3 ;; - *-*-sysv4.1* | *-*-sysvr4.1* )opsys=usg5-4 NON_GNU_CPP=/usr/lib/cpp ;; - *-*-sysv4.[2-9]* | *-sysvr4.[2-9]* ) - if test -z "$NON_GNU_CPP" ; then - for prog in "/usr/ccs/lib/cpp" "/lib/cpp"; do - if test -f "$prog"; then NON_GNU_CPP="$prog"; break; fi - done - fi - opsys=usg5-4-2 ;; - *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; - *-*-mach_bsd4.3* ) opsys=mach-bsd4-3 ;; -esac - -case "$canonical" in - - *-*-netbsd* ) - case "$canonical" in - i[3-9]86-*-netbsd*) machine=intel386 ;; - hp300-*-netbsd* | amiga-*-netbsd* | sun3-*-netbsd* | mac68k-*-netbsd* | da30-*-netbsd* | m68k-*-netbsd* ) - machine=hp9000s300 ;; - pc532-*-netbsd* | ns32k-*-netbsd* ) machine=ns32000 ;; - pmax-*-netbsd* | mips-*-netbsd* ) machine=pmax ;; - esac - ;; - - *-*-openbsd* ) - case "${canonical}" in - i386-*-openbsd*) machine=intel386 ;; - m68k-*-openbsd*) machine=hp9000s300 ;; - mipsel-*-openbsd*) machine=pmax ;; - esac - ;; - - arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;; - arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;; - - fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;; - i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;; - - m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; - - 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; - - m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;; - - we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;; - - m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;; - - rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; # dpx20 - m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; # dpx2 - m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; # sps7 - - - celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;; - - *-convex-bsd* | *-convex-convexos* ) - machine=convex opsys=bsd4-3 - NON_GNU_CPP="cc -E -P" - ;; - - i[3-9]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; - - i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;; - m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) opsys=dgux5-4r3 ;; - m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) opsys=dgux5-4r2 ;; - m88k-dg-dgux* ) opsys=dgux ;; - - m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 ;; - m88k-motorola-sysv4* ) - machine=delta88k opsys=usg5-4-2 - ;; - m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;; - - m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;; - m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;; - - ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;; - - pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;; - pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;; - np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;; - - m88k-harris-cxux* ) - case "`uname -r`" in - [56].[0-9] ) machine=nh4000 opsys=cxux ;; - [7].[0-9] ) machine=nh4000 opsys=cxux7 ;; - esac - NON_GNU_CPP="/lib/cpp" - ;; - m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;; - powerpc-harris-powerunix ) machine=nh6000 opsys=powerunix NON_GNU_CPP="cc -Xo -E -P" ;; - - xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; - - m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; - - *-hp-hpux* ) - case "$canonical" in - m68* ) machine=hp9000s300 ;; - hppa* ) machine=hp800 ;; - esac - - case "$canonical" in - *-hp-hpux7* ) opsys=hpux ;; - *-hp-hpux8* ) opsys=hpux8 ;; - *-hp-hpux9* ) opsys=hpux9 ;; - *-hp-hpux10* ) opsys=hpux10 ;; - *-hp-hpux11* ) opsys=hpux11 ;; - * ) opsys=hpux ;; - esac - - case "$opsys" in hpux9 | hpux10 ) extra_objs="$extra_objs strcat.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"strcat.o\"" - fi ;; esac - - if test "$opsys" = "hpux10" -o "$opsys" = "hpux11"; then \ - ansi_flag="-Ae"; else ansi_flag="-Aa"; fi - NON_GNU_CC="cc $ansi_flag" NON_GNU_CPP="cc $ansi_flag -E" - - case "$canonical" in *-hp-hpux*shr* ) opsys="${opsys}-shr" ;; esac - ;; - - orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; - clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; - - i[3-9]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; - i[3-9]86-ibm-aix1.[23]* | i[3-9]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; - i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; - romp-ibm-aos* ) opsys=bsd4-3 ;; - romp-ibm-bsd* ) opsys=bsd4-3 ;; - romp-ibm-mach* ) opsys=mach-bsd4-3 ;; - - m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;; - m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;; - - i[3-9]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; - - i[3-9]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; - - i[3-9]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; - - i[3-9]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; - - i[3-9]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; - - i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;; - - i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" NON_GNU_CPP="/usr/ccs/lib/cpp" ;; - - m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;; - - m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;; - - mips-mips-usg* ) machine=mips4 ;; - mips-mips-riscos4 ) - machine=mips4 - NON_GNU_CC="cc -systype bsd43" - NON_GNU_CPP="cc -systype bsd43 -E" - case "$canonical" in - mips-mips-riscos4* ) opsys=bsd4-3 ;; - mips-mips-riscos5* ) opsys=riscos5 ;; - esac - ;; - mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; - mips-mips-* ) machine=mips opsys=usg5-2-2 ;; - - m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;; - - ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;; - - m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;; - m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;; - - m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;; - - m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;; - - m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;; - - pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;; - - ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;; - ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;; - - mips-siemens-sysv* | mips-sni-sysv*) - machine=mips-siemens opsys=usg5-4 - NON_GNU_CC=/usr/ccs/bin/cc - NON_GNU_CPP=/usr/ccs/lib/cpp - ;; - - mips-nec-sysv*) - machine=mips-nec - NON_GNU_CC=/usr/ccs/bin/cc - NON_GNU_CPP=/usr/ccs/lib/cpp - ;; - - m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;; - m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;; - mips-sgi-irix3.* ) opsys=irix3-3 ;; - mips-sgi-irix4.* ) opsys=irix4-0 ;; - mips-sgi-irix6* ) opsys=irix6-0 ;; - mips-sgi-irix5.1* ) opsys=irix5-1 ;; - mips-sgi-irix5.2* ) opsys=irix5-2 ;; - mips-sgi-irix5.* ) opsys=irix5-3 ;; - mips-sgi-irix* ) opsys=irix5-0 ;; - - *-sony-newsos[34]* | *-sony-news[34]* ) opsys=bsd4-3 ;; - *-sony-news* ) opsys=newsos5 ;; - - m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; - - *-*-solaris* | *-*-sunos* | *-sun-mach* | *-sun-bsd* ) - case "$canonical" in - m68*-sunos1* ) machine=sun1 ;; - m68*-sunos2* ) machine=sun2 ;; - m68* ) machine=sun3 ;; - i*86*-sun-sunos[34]* ) machine=sun386 ;; - i*86-*-* ) machine=intel386 ;; - rs6000* ) machine=rs6000 ;; - esac - - case "$canonical" in *-sunos5*) - canonical=`echo $canonical | sed -e s/sunos5/solaris2/`;; - esac - - case "$canonical" in - *-sunos4* ) - #test -f /usr/lib/cpp && NON_GNU_CPP=/usr/lib/cpp ;; - : ;; - *-solaris2* ) - #test -f /usr/ccs/lib/cpp && NON_GNU_CPP=/usr/ccs/lib/cpp - RANLIB=':' ;; - esac - - case "$canonical" in - *-solaris* ) - opsys=sol2 - os_release=`uname -r | sed -e 's/^\([0-9]\)\.\([0-9]\).*/\1\2/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining OS_RELEASE = $os_release -EOF -cat >> confdefs.h <&2 - exit 1 -fi - -if test -z "$dynamic"; then - case "$opsys" in - hpux* | sunos4* ) dynamic=no ;; - *) dynamic=yes ;; - esac -fi -if test "$dynamic" = "yes"; then - case "$opsys" in - hpux* | sunos4* | sco5 ) opsys="${opsys}-shr" ;; - decosf* ) ld_call_shared="-call_shared" ;; - esac -else case "$opsys" in - sol2 ) - echo "Static linking is not supported on Solaris 2." - echo "Rerun configure without specifying --dynamic=no." - exit 1 ;; - linux ) ld_call_shared="-Bstatic" ;; - decosf* ) ld_call_shared="-non_shared" ;; - esac -fi - -case "$opsys" in aix*) NON_GNU_CC=xlc ;; esac - -stack_trace_eye_catcher=`echo ${PROGNAME}_${version}_${canonical} | sed 'y/.-/__/'` -{ test "$extra_verbose" = "yes" && cat << EOF - Defining STACK_TRACE_EYE_CATCHER = $stack_trace_eye_catcher -EOF -cat >> confdefs.h <&2 && exit 1 -elif test "$with_tooltalk" = "no" ; then with_workshop=no -elif test "$with_workshop" = "yes"; then with_tooltalk=yes -fi - -if test "$with_workshop" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining SUNPRO -EOF -cat >> confdefs.h <<\EOF -#define SUNPRO 1 -EOF -} - - extra_objs="$extra_objs sunpro.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sunpro.o\"" - fi -fi - -if test "$with_clash_detection" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining CLASH_DETECTION -EOF -cat >> confdefs.h <<\EOF -#define CLASH_DETECTION 1 -EOF -} - - extra_objs="$extra_objs filelock.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"filelock.o\"" - fi -fi - -test -n "$compiler" && CC="$compiler" -if test "$with_gcc" = "no"; then case "$CC" in "" | *gcc* ) CC="${NON_GNU_CC-cc}" ;; esac -fi - -test "${cflags-unset}" != unset && CFLAGS="$cflags" -if test "${CFLAGS-unset}" != unset - then cflags_specified=yes; - else cflags_specified=no; -fi - -xe_save_CFLAGS="$CFLAGS" - -# Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1502: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1529: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_prog_rejected=no - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" - fi -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - if test -z "$CC"; then - case "`uname -s`" in - *win32* | *WIN32*) - # Extract the first word of "cl", so it can be a program name with args. -set dummy cl; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1577: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="cl" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - ;; - esac - fi - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } -fi - -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1606: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 - -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -cat > conftest.$ac_ext << EOF - -#line 1619 "configure" -#include "confdefs.h" - -main(){return(0);} -EOF -if { (eval echo configure:1624: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - ac_cv_prog_cc_works=yes - # If we can't run a trivial program, we are probably using a cross compiler. - if (./conftest; exit) 2>/dev/null; then - ac_cv_prog_cc_cross=no - else - ac_cv_prog_cc_cross=yes - fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - ac_cv_prog_cc_works=no -fi -rm -fr conftest* -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1652: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 -echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 -cross_compiling=$ac_cv_prog_cc_cross - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1657: checking whether we are using GNU C" >&5 - -cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes -else - ac_cv_prog_gcc=no -fi - -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 - -if test $ac_cv_prog_gcc = yes; then - GCC=yes -else - GCC= -fi - -ac_test_CFLAGS="${CFLAGS+set}" -ac_save_CFLAGS="$CFLAGS" -CFLAGS= -echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1682: checking whether ${CC-cc} accepts -g" >&5 - -echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_cc_g=yes -else - ac_cv_prog_cc_g=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 -if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi - -if test "$with_gcc" = "no" -a "$GCC" = "yes"; then - CC=${NON_GNU_CC-cc} - # Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1715: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1742: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_prog_rejected=no - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" - fi -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - if test -z "$CC"; then - case "`uname -s`" in - *win32* | *WIN32*) - # Extract the first word of "cl", so it can be a program name with args. -set dummy cl; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1790: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="cl" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - ;; - esac - fi - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } -fi - -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1819: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 - -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -cat > conftest.$ac_ext << EOF - -#line 1832 "configure" -#include "confdefs.h" - -main(){return(0);} -EOF -if { (eval echo configure:1837: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - ac_cv_prog_cc_works=yes - # If we can't run a trivial program, we are probably using a cross compiler. - if (./conftest; exit) 2>/dev/null; then - ac_cv_prog_cc_cross=no - else - ac_cv_prog_cc_cross=yes - fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - ac_cv_prog_cc_works=no -fi -rm -fr conftest* -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1865: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 -echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 -cross_compiling=$ac_cv_prog_cc_cross - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1870: checking whether we are using GNU C" >&5 - -cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes -else - ac_cv_prog_gcc=no -fi - -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 - -if test $ac_cv_prog_gcc = yes; then - GCC=yes -else - GCC= -fi - -ac_test_CFLAGS="${CFLAGS+set}" -ac_save_CFLAGS="$CFLAGS" -CFLAGS= -echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1895: checking whether ${CC-cc} accepts -g" >&5 - -echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_cc_g=yes -else - ac_cv_prog_cc_g=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 -if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi - -elif test "$with_gcc" = "yes" -a "$GCC" != "yes" ; then - CC=gcc - # Extract the first word of "gcc", so it can be a program name with args. -set dummy gcc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1928: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="gcc" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -if test -z "$CC"; then - # Extract the first word of "cc", so it can be a program name with args. -set dummy cc; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1955: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_prog_rejected=no - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then - ac_prog_rejected=yes - continue - fi - ac_cv_prog_CC="cc" - break - fi - done - IFS="$ac_save_ifs" -if test $ac_prog_rejected = yes; then - # We found a bogon in the path, so make sure we never use it. - set dummy $ac_cv_prog_CC - shift - if test $# -gt 0; then - # We chose a different compiler from the bogus one. - # However, it has the same basename, so the bogon will be chosen - # first if we set CC to just the basename; use the full file name. - shift - set dummy "$ac_dir/$ac_word" "$@" - shift - ac_cv_prog_CC="$@" - fi -fi -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - - if test -z "$CC"; then - case "`uname -s`" in - *win32* | *WIN32*) - # Extract the first word of "cl", so it can be a program name with args. -set dummy cl; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2003: checking for $ac_word" >&5 - -if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_CC="cl" - break - fi - done - IFS="$ac_save_ifs" -fi -CC="$ac_cv_prog_CC" -if test -n "$CC"; then - echo "$ac_t""$CC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - ;; - esac - fi - test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; } -fi - -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:2032: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 - -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -cat > conftest.$ac_ext << EOF - -#line 2045 "configure" -#include "confdefs.h" - -main(){return(0);} -EOF -if { (eval echo configure:2050: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - ac_cv_prog_cc_works=yes - # If we can't run a trivial program, we are probably using a cross compiler. - if (./conftest; exit) 2>/dev/null; then - ac_cv_prog_cc_cross=no - else - ac_cv_prog_cc_cross=yes - fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - ac_cv_prog_cc_works=no -fi -rm -fr conftest* -ac_ext=c -xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' -xe_ldflags='$LDFLAGS $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_x_site $ld_switch_run' -xe_libs='$ld_call_shared $xe_check_libs $X_EXTRA_LIBS $libs_x $X_PRE_LIBS $LIBS $libs_machine $libs_system $libs_standard' -ac_cpp='$CPP '"$xe_cppflags" -ac_compile='${CC-cc} -c $CFLAGS '"$xe_cppflags"' conftest.$ac_ext 1>&5' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -cross_compiling=no - -echo "$ac_t""$ac_cv_prog_cc_works" 1>&6 -if test $ac_cv_prog_cc_works = no; then - { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } -fi -echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:2078: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 -echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 -cross_compiling=$ac_cv_prog_cc_cross - -echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:2083: checking whether we are using GNU C" >&5 - -cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then - ac_cv_prog_gcc=yes -else - ac_cv_prog_gcc=no -fi - -echo "$ac_t""$ac_cv_prog_gcc" 1>&6 - -if test $ac_cv_prog_gcc = yes; then - GCC=yes -else - GCC= -fi - -ac_test_CFLAGS="${CFLAGS+set}" -ac_save_CFLAGS="$CFLAGS" -CFLAGS= -echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:2108: checking whether ${CC-cc} accepts -g" >&5 - -echo 'void f(){}' > conftest.c -if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then - ac_cv_prog_cc_g=yes -else - ac_cv_prog_cc_g=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_prog_cc_g" 1>&6 -if test "$ac_test_CFLAGS" = set; then - CFLAGS="$ac_save_CFLAGS" -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi - -fi -CFLAGS="$xe_save_CFLAGS" - - -test -n "$CPP" -a -d "$CPP" && CPP= - -test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" - -echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:2145: checking how to run the C preprocessor" >&5 -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then - - # This must be in double quotes, not single quotes, because CPP may get - # substituted into the Makefile and "${CC-cc}" will confuse make. - CPP="${CC-cc} -E" - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. - cat > conftest.$ac_ext < -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2164: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP="${CC-cc} -E -traditional-cpp" - cat > conftest.$ac_ext < -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP="${CC-cc} -nologo -E" - cat > conftest.$ac_ext < -Syntax Error -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2198: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - : -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - CPP=/lib/cpp -fi -rm -f conftest* -fi -rm -f conftest* -fi -rm -f conftest* - ac_cv_prog_CPP="$CPP" - CPP="$ac_cv_prog_CPP" -else - ac_cv_prog_CPP="$CPP" -fi -echo "$ac_t""$CPP" 1>&6 - - -echo $ac_n "checking for AIX""... $ac_c" 1>&6 -echo "configure:2223: checking for AIX" >&5 -cat > conftest.$ac_ext <&5 | - egrep "yes" >/dev/null 2>&1; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF - Defining _ALL_SOURCE -EOF -cat >> confdefs.h <<\EOF -#define _ALL_SOURCE 1 -EOF -} - -else - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - - - -echo $ac_n "checking for GNU libc""... $ac_c" 1>&6 -echo "configure:2252: checking for GNU libc" >&5 -cat > conftest.$ac_ext < -int main() { - -#if ! (defined __GLIBC__ || defined __GNU_LIBRARY__) -#error Not a GNU libc system :-( -******* ======= ******** &&&&&&&& -#endif - -; return 0; } -EOF -if { (eval echo configure:2266: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - have_glibc=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - have_glibc=no -fi -rm -f conftest* -echo "$ac_t""$have_glibc" 1>&6 -test "$have_glibc" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining _GNU_SOURCE -EOF -cat >> confdefs.h <<\EOF -#define _GNU_SOURCE 1 -EOF -} - - - -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - : -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - case "$conftest_rc" in - 11) echo "You appear to be using the SunPro C compiler."; __SUNPRO_C=yes ;; - 12) echo "You appear to be using the DEC C compiler." ; __DECC=yes ;; -esac -fi -rm -fr conftest* - - - - -echo "Extracting information from the machine- and system-dependent headers..." - -tempcname="conftest.c" - - - -cat > $tempcname <&6 -echo "configure:2568: checking for dynodump" >&5 -if test "$unexec" != "unexsol2.o"; then - echo "$ac_t""no" 1>&6 -else - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining DYNODUMP -EOF -cat >> confdefs.h <<\EOF -#define DYNODUMP 1 -EOF -} - - MAKE_SUBDIR="$MAKE_SUBDIR dynodump" && if test "$extra_verbose" = "yes"; then echo " Appending \"dynodump\" to \$MAKE_SUBDIR"; fi - SRC_SUBDIR_DEPS="$SRC_SUBDIR_DEPS dynodump" && if test "$extra_verbose" = "yes"; then echo " Appending \"dynodump\" to \$SRC_SUBDIR_DEPS"; fi - case "$machine" in - sparc ) dynodump_arch=sparc ;; - *86* ) dynodump_arch=i386 ;; - powerpc ) dynodump_arch=ppc ;; - esac - test "$GCC" = "yes" && ld_switch_site="$ld_switch_site -fno-gnu-linker" && if test "$extra_verbose" = "yes"; then echo " Appending \"-fno-gnu-linker\" to \$ld_switch_site"; fi -fi - - -test "$machine$opsys" = "powerpclinux" && start_flags="-T $srcdir/src/ppc.ldscript" - -if test "$unexec" = "unexaix.o"; then - if test "$dynamic" = "no"; then - start_flags="-Wl,-bnso,-bnodelcsect" - test "$GCC" = "yes" && start_flags="-B/bin/ ${start_flags}" - for f in "/lib/syscalls.exp" "/lib/threads.exp"; do - if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; fi - done - for f in "/usr/lpp/X11/bin/smt.exp" "/usr/bin/X11/smt.exp"; do - if test -r "$f"; then start_flags="${start_flags},-bI:${f}"; break; fi - done - -echo $ac_n "checking for terminateAndUnload in -lC""... $ac_c" 1>&6 -echo "configure:2606: checking for terminateAndUnload in -lC" >&5 -ac_lib_var=`echo C'_'terminateAndUnload | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lC " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_system="$libs_system -lC" && if test "$extra_verbose" = "yes"; then echo " Appending \"-lC\" to \$libs_system"; fi -else - echo "$ac_t""no" 1>&6 -fi - - - fi -elif test -n "$ld_text_start_addr"; then - start_flags="-T $ld_text_start_addr -e __start" -fi - - - - -if test "$ordinary_link" = "no" -a "$GCC" = "yes"; then - test -z "$linker" && linker='$(CC) -nostdlib' - test -z "$lib_gcc" && lib_gcc='`$(CC) -print-libgcc-file-name`' -fi -test "$GCC" != "yes" && lib_gcc= - - - - - -case "$site_libraries" in *:* ) site_libraries="`echo '' $site_libraries | sed -e 's/^ //' -e 's/:/ /g'`";; esac -if test -n "$site_libraries"; then - for arg in $site_libraries; do - case "$arg" in - -* ) ;; - * ) test -d "$arg" || \ - { echo "Error:" "Invalid site library \`$arg': no such directory" >&2; exit 1; } - arg="-L${arg}" ;; - esac - ld_switch_site="$ld_switch_site $arg" && if test "$extra_verbose" = "yes"; then echo " Appending \"$arg\" to \$ld_switch_site"; fi - done -fi - -case "$site_includes" in *:* ) site_includes="`echo '' $site_includes | sed -e 's/^ //' -e 's/:/ /g'`";; esac -if test -n "$site_includes"; then - for arg in $site_includes; do - case "$arg" in - -* ) ;; - * ) test -d "$arg" || \ - { echo "Error:" "Invalid site include \`$arg': no such directory" >&2; exit 1; } - arg="-I${arg}" ;; - esac - c_switch_site="$c_switch_site $arg" && if test "$extra_verbose" = "yes"; then echo " Appending \"$arg\" to \$c_switch_site"; fi - done -fi - -case "$site_prefixes" in *:* ) site_prefixes="`echo '' $site_prefixes | sed -e 's/^ //' -e 's/:/ /g'`";; esac -if test -n "$site_prefixes"; then - for dir in $site_prefixes; do - inc_dir="${dir}/include" - lib_dir="${dir}/lib" - if test ! -d "$dir"; then - { echo "Error:" "Invalid site prefix \`$dir': no such directory" >&2; exit 1; } - elif test ! -d "$inc_dir"; then - { echo "Error:" "Invalid site prefix \`$dir': no such directory \`$inc_dir'" >&2; exit 1; } - elif test ! -d "$lib_dir"; then - { echo "Error:" "Invalid site prefix \`$dir': no such directory \`$lib_dir'" >&2; exit 1; } - else - c_switch_site="$c_switch_site "-I$inc_dir"" && if test "$extra_verbose" = "yes"; then echo " Appending \""-I$inc_dir"\" to \$c_switch_site"; fi - ld_switch_site="$ld_switch_site "-L$lib_dir"" && if test "$extra_verbose" = "yes"; then echo " Appending \""-L$lib_dir"\" to \$ld_switch_site"; fi - fi - done -fi - - -for dir in "/usr/ccs/lib"; do - test -d "$dir" && ld_switch_site="$ld_switch_site -L${dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L${dir}\" to \$ld_switch_site"; fi -done - -case "$site_runtime_libraries" in *:* ) site_runtime_libraries="`echo '' $site_runtime_libraries | sed -e 's/^ //' -e 's/:/ /g'`";; esac -if test -n "$site_runtime_libraries"; then - LD_RUN_PATH="`echo $site_runtime_libraries | sed -e 's/ */:/g'`" - export LD_RUN_PATH -fi - - -if test "$dynamic" = "no"; then add_runtime_path=no -elif test -n "$LD_RUN_PATH"; then add_runtime_path=yes -else case "$opsys" in - sol2 | irix* | *bsd* | decosf* ) add_runtime_path=yes ;; - * ) add_runtime_path=no ;; - esac -fi - -if test "$add_runtime_path" = "yes"; then - echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2726: checking "for runtime libraries flag"" >&5 - case "$opsys" in - sol2 ) dash_r="-R" ;; - decosf* | linux* | irix*) dash_r="-rpath " ;; - *) - dash_r="" - for try_dash_r in "-R" "-R " "-rpath "; do - xe_check_libs="${try_dash_r}/no/such/file-or-directory" - -if test "$GCC" = "yes"; then - set x $xe_check_libs; shift; xe_check_libs="" - while test -n "$1"; do - case $1 in - -L | -l | -u ) xe_check_libs="$xe_check_libs $1 $2"; shift ;; - -L* | -l* | -u* | -Wl* | -pg ) xe_check_libs="$xe_check_libs $1" ;; - -Xlinker* ) ;; - * ) xe_check_libs="$xe_check_libs -Xlinker $1" ;; - esac - shift - done -fi - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - dash_r="$try_dash_r" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* - xe_check_libs="" - test -n "$dash_r" && break - done ;; - esac - if test -n "$dash_r"; - then echo "$ac_t"""\"${dash_r}\""" 1>&6 - else echo "$ac_t""NONE" 1>&6 - fi -fi - -xe_add_unique_runpath_dir=' - xe_add_p=yes - for xe_dir in $runpath_dirs; do test "$xe_dir" = "$xe_runpath_dir" && xe_add_p=no - done - if test "$xe_add_p" = "yes"; then - test -n "$runpath" && runpath="${runpath}:" - runpath="${runpath}${xe_runpath_dir}" - runpath_dirs="$runpath_dirs $xe_runpath_dir" - fi' - - - - -if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - - runpath="" runpath_dirs="" - if test -n "$LD_RUN_PATH"; then - runpath="$LD_RUN_PATH" - elif test "$GCC" = "yes"; then - ld_switch_run_save="$ld_switch_run"; ld_switch_run="" - echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c - xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null' - for arg in `eval "$xe_runpath_link" | grep ' -L'`; do - case "$arg" in P,* | -L* | -R* ) - for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do - { -xe_runpath_dir="$dir" - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -} - done ;; - esac - done - ld_switch_run="$ld_switch_run_save" - rm -f conftest* - else - for arg in $ld_switch_site $ld_switch_x_site; do - case "$arg" in -L*) { -xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'` - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -};; esac - done - if test "$opsys $need_motif" = "sol2 yes"; then - xe_runpath_dir="/opt/SUNWdt/lib"; - eval "$xe_add_unique_runpath_dir"; - fi - fi - if test -n "$runpath"; then - ld_switch_run="${dash_r}${runpath}" - -if test "$GCC" = "yes"; then - set x $ld_switch_run; shift; ld_switch_run="" - while test -n "$1"; do - case $1 in - -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;; - -L* | -l* | -u* | -Wl* | -pg ) ld_switch_run="$ld_switch_run $1" ;; - -Xlinker* ) ;; - * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;; - esac - shift - done -fi - test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath" - fi -fi - - - - -GNU_MALLOC=yes -if test "$with_dlmalloc" != "no"; then - doug_lea_malloc=yes -else - doug_lea_malloc=no -fi -after_morecore_hook_exists=yes -echo $ac_n "checking for malloc_get_state""... $ac_c" 1>&6 -echo "configure:2857: checking for malloc_get_state" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char malloc_get_state(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_malloc_get_state) || defined (__stub___malloc_get_state) -choke me -#else -malloc_get_state(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2883: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_malloc_get_state=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_malloc_get_state=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'malloc_get_state`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -doug_lea_malloc=no -fi - -echo $ac_n "checking for malloc_set_state""... $ac_c" 1>&6 -echo "configure:2903: checking for malloc_set_state" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char malloc_set_state(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_malloc_set_state) || defined (__stub___malloc_set_state) -choke me -#else -malloc_set_state(); -#endif - -; return 0; } -EOF -if { (eval echo configure:2929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_malloc_set_state=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_malloc_set_state=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'malloc_set_state`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -doug_lea_malloc=no -fi - -echo $ac_n "checking whether __after_morecore_hook exists""... $ac_c" 1>&6 -echo "configure:2949: checking whether __after_morecore_hook exists" >&5 -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 - after_morecore_hook_exists=no -fi -rm -f conftest* -if test "$system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (The GNU allocators don't work with this system configuration)." -elif test "$with_system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (User chose not to use GNU allocators)." -elif test "$with_debug_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (User chose to use Debugging Malloc)." -fi - -if test "$doug_lea_malloc" = "yes" ; then - if test "$GNU_MALLOC" = yes ; then - GNU_MALLOC_reason=" - (Using Doug Lea's new malloc from the GNU C Library.)" - fi - { test "$extra_verbose" = "yes" && cat << \EOF - Defining DOUG_LEA_MALLOC -EOF -cat >> confdefs.h <<\EOF -#define DOUG_LEA_MALLOC 1 -EOF -} - - if test "$after_morecore_hook_exists" = "no" ; then - GNU_MALLOC_reason=" - (Using Doug Lea's new malloc from the Linux C Library.)" - { test "$extra_verbose" = "yes" && cat << \EOF - Defining _NO_MALLOC_WARNING_ -EOF -cat >> confdefs.h <<\EOF -#define _NO_MALLOC_WARNING_ 1 -EOF -} - - fi - use_minimal_tagbits=yes -fi - - - - -# Extract the first word of "ranlib", so it can be a program name with args. -set dummy ranlib; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3017: checking for $ac_word" >&5 - -if test -n "$RANLIB"; then - ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_RANLIB="ranlib" - break - fi - done - IFS="$ac_save_ifs" - test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":" -fi -RANLIB="$ac_cv_prog_RANLIB" -if test -n "$RANLIB"; then - echo "$ac_t""$RANLIB" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -ac_aux_dir= -for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do - if test -f $ac_dir/install-sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install-sh -c" - break - elif test -f $ac_dir/install.sh; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install.sh -c" - break - fi -done -if test -z "$ac_aux_dir"; then - { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } -fi -ac_config_guess=$ac_aux_dir/config.guess -ac_config_sub=$ac_aux_dir/config.sub -ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. - -# Find a good install program. We prefer a C program (faster), -# so one script is as good as another. But avoid the broken or -# incompatible versions: -# SysV /etc/install, /usr/sbin/install -# SunOS /usr/etc/install -# IRIX /sbin/install -# AIX /bin/install -# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag -# AFS /usr/afsws/bin/install, which mishandles nonexistent args -# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" -# ./install, which can be erroneously created by make from ./install.sh. -echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:3072: checking for a BSD compatible install" >&5 -if test -z "$INSTALL"; then - - IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" - for ac_dir in $PATH; do - # Account for people who put trailing slashes in PATH elements. - case "$ac_dir/" in - /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; - *) - # OSF1 and SCO ODT 3.0 have their own names for install. - # Don't use installbsd from OSF since it installs stuff as root - # by default. - for ac_prog in ginstall scoinst install; do - if test -f $ac_dir/$ac_prog; then - if test $ac_prog = install && - grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then - # AIX install. It has an incompatible calling convention. - : - else - ac_cv_path_install="$ac_dir/$ac_prog -c" - break 2 - fi - fi - done - ;; - esac - done - IFS="$ac_save_IFS" - - if test "${ac_cv_path_install+set}" = set; then - INSTALL="$ac_cv_path_install" - else - # As a last resort, use the slow shell script. We don't cache a - # path for INSTALL within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the path is relative. - INSTALL="$ac_install_sh" - fi -fi -echo "$ac_t""$INSTALL" 1>&6 - -# Use test -z because SunOS4 sh mishandles braces in ${var-val}. -# It thinks the first close brace ends the variable substitution. -test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' - -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' - -test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' - -for ac_prog in 'bison -y' byacc -do -# Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:3126: checking for $ac_word" >&5 - -if test -n "$YACC"; then - ac_cv_prog_YACC="$YACC" # Let the user override the test. -else - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" - ac_dummy="$PATH" - for ac_dir in $ac_dummy; do - test -z "$ac_dir" && ac_dir=. - if test -f $ac_dir/$ac_word; then - ac_cv_prog_YACC="$ac_prog" - break - fi - done - IFS="$ac_save_ifs" -fi -YACC="$ac_cv_prog_YACC" -if test -n "$YACC"; then - echo "$ac_t""$YACC" 1>&6 -else - echo "$ac_t""no" 1>&6 -fi - -test -n "$YACC" && break -done -test -n "$YACC" || YACC="yacc" - - -for ac_hdr in mach/mach.h sys/stropts.h sys/timeb.h sys/time.h unistd.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3158: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3166: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - -for ac_hdr in utime.h locale.h libgen.h fcntl.h ulimit.h cygwin/version.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3199: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3207: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - -for ac_hdr in kstat.h sys/pstat.h inttypes.h sys/un.h a.out.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:3240: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3248: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - -echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:3278: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext < -#include -#ifndef WEXITSTATUS -#define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8) -#endif -#ifndef WIFEXITED -#define WIFEXITED(stat_val) (((stat_val) & 255) == 0) -#endif -int main() { -int s; -wait (&s); -s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; -; return 0; } -EOF -if { (eval echo configure:3297: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_header_sys_wait_h=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_sys_wait_h=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_header_sys_wait_h" 1>&6 -if test $ac_cv_header_sys_wait_h = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SYS_WAIT_H -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SYS_WAIT_H 1 -EOF -} - -fi - -echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:3321: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext < -#include -#include -#include -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:3332: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - ac_cv_header_stdc=yes -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. -cat > conftest.$ac_ext < -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "memchr" >/dev/null 2>&1; then - : -else - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. -cat > conftest.$ac_ext < -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "free" >/dev/null 2>&1; then - : -else - rm -rf conftest* - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. -cat > conftest.$ac_ext < -#define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int main () { int i; for (i = 0; i < 256; i++) -if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2); -exit (0); } - -EOF -if { (eval echo configure:3396: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - : -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_header_stdc=no -fi -rm -fr conftest* -fi - -echo "$ac_t""$ac_cv_header_stdc" 1>&6 -if test $ac_cv_header_stdc = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining STDC_HEADERS -EOF -cat >> confdefs.h <<\EOF -#define STDC_HEADERS 1 -EOF -} - -fi - -echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:3422: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext < -#include -#include -int main() { -struct tm *tp; -; return 0; } -EOF -if { (eval echo configure:3434: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_header_time=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_time=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_header_time" 1>&6 -if test $ac_cv_header_time = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining TIME_WITH_SYS_TIME -EOF -cat >> confdefs.h <<\EOF -#define TIME_WITH_SYS_TIME 1 -EOF -} - -fi - -echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:3458: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext < -#include -/* NetBSD declares sys_siglist in unistd.h. */ -#ifdef HAVE_UNISTD_H -#include -#endif -int main() { -char *msg = *(sys_siglist + 1); -; return 0; } -EOF -if { (eval echo configure:3473: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_decl_sys_siglist=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_decl_sys_siglist=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_decl_sys_siglist" 1>&6 -if test $ac_cv_decl_sys_siglist = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining SYS_SIGLIST_DECLARED -EOF -cat >> confdefs.h <<\EOF -#define SYS_SIGLIST_DECLARED 1 -EOF -} - -fi - - -echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:3498: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext < -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif -#ifdef HAVE_UTIME_H -#include -#endif -int main() { -static struct utimbuf x; x.actime = x.modtime; -; return 0; } -EOF -if { (eval echo configure:3519: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_STRUCT_UTIMBUF -EOF -cat >> confdefs.h <<\EOF -#define HAVE_STRUCT_UTIMBUF 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - -echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:3539: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext < -#include -#ifdef signal -#undef signal -#endif -#ifdef __cplusplus -extern "C" void (*signal (int, void (*)(int)))(int); -#else -void (*signal ()) (); -#endif - -int main() { -int i; -; return 0; } -EOF -if { (eval echo configure:3559: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_type_signal=void -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_type_signal=int -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_type_signal" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining RETSIGTYPE = $ac_cv_type_signal -EOF -cat >> confdefs.h <&6 -echo "configure:3581: checking for size_t" >&5 - -cat > conftest.$ac_ext < -#if STDC_HEADERS -#include -#include -#endif -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_size_t=yes -else - rm -rf conftest* - ac_cv_type_size_t=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_type_size_t" 1>&6 -if test $ac_cv_type_size_t = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining size_t = unsigned -EOF -cat >> confdefs.h <<\EOF -#define size_t unsigned -EOF -} - -fi - -echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3615: checking for pid_t" >&5 - -cat > conftest.$ac_ext < -#if STDC_HEADERS -#include -#include -#endif -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_pid_t=yes -else - rm -rf conftest* - ac_cv_type_pid_t=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_type_pid_t" 1>&6 -if test $ac_cv_type_pid_t = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining pid_t = int -EOF -cat >> confdefs.h <<\EOF -#define pid_t int -EOF -} - -fi - -echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3649: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext < -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "uid_t" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_uid_t=yes -else - rm -rf conftest* - ac_cv_type_uid_t=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_type_uid_t" 1>&6 -if test $ac_cv_type_uid_t = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining uid_t = int -EOF -cat >> confdefs.h <<\EOF -#define uid_t int -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining gid_t = int -EOF -cat >> confdefs.h <<\EOF -#define gid_t int -EOF -} - -fi - -echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3688: checking for mode_t" >&5 - -cat > conftest.$ac_ext < -#if STDC_HEADERS -#include -#include -#endif -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_mode_t=yes -else - rm -rf conftest* - ac_cv_type_mode_t=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_type_mode_t" 1>&6 -if test $ac_cv_type_mode_t = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining mode_t = int -EOF -cat >> confdefs.h <<\EOF -#define mode_t int -EOF -} - -fi - -echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3722: checking for off_t" >&5 - -cat > conftest.$ac_ext < -#if STDC_HEADERS -#include -#include -#endif -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "(^|[^a-zA-Z_0-9])off_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_type_off_t=yes -else - rm -rf conftest* - ac_cv_type_off_t=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_type_off_t" 1>&6 -if test $ac_cv_type_off_t = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining off_t = long -EOF -cat >> confdefs.h <<\EOF -#define off_t long -EOF -} - -fi - - -echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3757: checking for struct timeval" >&5 -cat > conftest.$ac_ext < -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif -int main() { -static struct timeval x; x.tv_sec = x.tv_usec; -; return 0; } -EOF -if { (eval echo configure:3775: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 - HAVE_TIMEVAL=yes - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TIMEVAL -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TIMEVAL 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 - HAVE_TIMEVAL=no -fi -rm -f conftest* - -echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3797: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext < -#include -int main() { -struct tm *tp; tp->tm_sec; -; return 0; } -EOF -if { (eval echo configure:3808: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_tm=time.h -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_tm=sys/time.h -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_struct_tm" 1>&6 -if test $ac_cv_struct_tm = sys/time.h; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining TM_IN_SYS_TIME -EOF -cat >> confdefs.h <<\EOF -#define TM_IN_SYS_TIME 1 -EOF -} - -fi - -echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3832: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext < -#include <$ac_cv_struct_tm> -int main() { -struct tm tm; tm.tm_zone; -; return 0; } -EOF -if { (eval echo configure:3843: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_struct_tm_zone=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_struct_tm_zone=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_struct_tm_zone" 1>&6 -if test "$ac_cv_struct_tm_zone" = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TM_ZONE -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TM_ZONE 1 -EOF -} - -else - echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3866: checking for tzname" >&5 - -cat > conftest.$ac_ext < -#ifndef tzname /* For SGI. */ -extern char *tzname[]; /* RS6000 and others reject char **tzname. */ -#endif -int main() { -atoi(*tzname); -; return 0; } -EOF -if { (eval echo configure:3879: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - ac_cv_var_tzname=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_var_tzname=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_var_tzname" 1>&6 - if test $ac_cv_var_tzname = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TZNAME -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TZNAME 1 -EOF -} - - fi -fi - - -echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3905: checking for working const" >&5 - -cat > conftest.$ac_ext <j = 5; -} -{ /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ - const int foo = 10; -} - -; return 0; } -EOF -if { (eval echo configure:3957: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_c_const=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_c_const=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_c_const" 1>&6 -if test $ac_cv_c_const = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining const = -EOF -cat >> confdefs.h <<\EOF -#define const -EOF -} - -fi - - -echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3982: checking whether ${MAKE-make} sets \${MAKE}" >&5 -set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` - -cat > conftestmake <<\EOF -all: - @echo 'ac_maketemp="${MAKE}"' -EOF -# GNU make sometimes prints "make[1]: Entering...", which would confuse us. -eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` -if test -n "$ac_maketemp"; then - eval ac_cv_prog_make_${ac_make}_set=yes -else - eval ac_cv_prog_make_${ac_make}_set=no -fi -rm -f conftestmake -if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then - echo "$ac_t""yes" 1>&6 - SET_MAKE= -else - echo "$ac_t""no" 1>&6 - SET_MAKE="MAKE=${MAKE-make}" -fi - - -echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:4007: checking whether byte ordering is bigendian" >&5 - -ac_cv_c_bigendian=unknown -# See if sys/param.h defines the BYTE_ORDER macro. -cat > conftest.$ac_ext < -#include -int main() { - -#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN - bogus endian macros -#endif -; return 0; } -EOF -if { (eval echo configure:4023: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - # It does; now see whether it defined to BIG_ENDIAN or not. -cat > conftest.$ac_ext < -#include -int main() { - -#if BYTE_ORDER != BIG_ENDIAN - not big endian -#endif -; return 0; } -EOF -if { (eval echo configure:4038: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_c_bigendian=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_c_bigendian=no -fi -rm -f conftest* -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* -if test $ac_cv_c_bigendian = unknown; then -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_c_bigendian=no -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_c_bigendian=yes -fi -rm -fr conftest* -fi - -echo "$ac_t""$ac_cv_c_bigendian" 1>&6 -if test $ac_cv_c_bigendian = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining WORDS_BIGENDIAN -EOF -cat >> confdefs.h <<\EOF -#define WORDS_BIGENDIAN 1 -EOF -} - -fi - - -echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:4095: checking size of short" >&5 - -cat > conftest.$ac_ext < -main() -{ - FILE *f=fopen("conftestval", "w"); - if (!f) exit(1); - fprintf(f, "%d\n", sizeof(short)); - exit(0); -} -EOF -if { (eval echo configure:4109: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_sizeof_short=`cat conftestval` -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_sizeof_short=0 -fi -rm -fr conftest* -echo "$ac_t""$ac_cv_sizeof_short" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining SIZEOF_SHORT = $ac_cv_sizeof_short -EOF -cat >> confdefs.h <&6 -echo "configure:4137: checking size of int" >&5 - -cat > conftest.$ac_ext < -main() -{ - FILE *f=fopen("conftestval", "w"); - if (!f) exit(1); - fprintf(f, "%d\n", sizeof(int)); - exit(0); -} -EOF -if { (eval echo configure:4151: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_sizeof_int=`cat conftestval` -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_sizeof_int=0 -fi -rm -fr conftest* -echo "$ac_t""$ac_cv_sizeof_int" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining SIZEOF_INT = $ac_cv_sizeof_int -EOF -cat >> confdefs.h <&6 -echo "configure:4173: checking size of long" >&5 - -cat > conftest.$ac_ext < -main() -{ - FILE *f=fopen("conftestval", "w"); - if (!f) exit(1); - fprintf(f, "%d\n", sizeof(long)); - exit(0); -} -EOF -if { (eval echo configure:4187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_sizeof_long=`cat conftestval` -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_sizeof_long=0 -fi -rm -fr conftest* -echo "$ac_t""$ac_cv_sizeof_long" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining SIZEOF_LONG = $ac_cv_sizeof_long -EOF -cat >> confdefs.h <&6 -echo "configure:4209: checking size of long long" >&5 - -cat > conftest.$ac_ext < -main() -{ - FILE *f=fopen("conftestval", "w"); - if (!f) exit(1); - fprintf(f, "%d\n", sizeof(long long)); - exit(0); -} -EOF -if { (eval echo configure:4223: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_sizeof_long_long=`cat conftestval` -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_sizeof_long_long=0 -fi -rm -fr conftest* -echo "$ac_t""$ac_cv_sizeof_long_long" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining SIZEOF_LONG_LONG = $ac_cv_sizeof_long_long -EOF -cat >> confdefs.h <&6 -echo "configure:4245: checking size of void *" >&5 - -cat > conftest.$ac_ext < -main() -{ - FILE *f=fopen("conftestval", "w"); - if (!f) exit(1); - fprintf(f, "%d\n", sizeof(void *)); - exit(0); -} -EOF -if { (eval echo configure:4259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_sizeof_void_p=`cat conftestval` -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_sizeof_void_p=0 -fi -rm -fr conftest* -echo "$ac_t""$ac_cv_sizeof_void_p" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining SIZEOF_VOID_P = $ac_cv_sizeof_void_p -EOF -cat >> confdefs.h <&6 -echo "configure:4282: checking for long file names" >&5 - -ac_cv_sys_long_file_names=yes -# Test for long file names in all the places we know might matter: -# . the current directory, where building will happen -# $prefix/lib where we will be installing things -# $exec_prefix/lib likewise -# eval it to expand exec_prefix. -# $TMPDIR if set, where it might want to write temporary files -# if $TMPDIR is not set: -# /tmp where it might want to write temporary files -# /var/tmp likewise -# /usr/tmp likewise -if test -n "$TMPDIR" && test -d "$TMPDIR" && test -w "$TMPDIR"; then - ac_tmpdirs="$TMPDIR" -else - ac_tmpdirs='/tmp /var/tmp /usr/tmp' -fi -for ac_dir in . $ac_tmpdirs `eval echo $prefix/lib $exec_prefix/lib` ; do - test -d $ac_dir || continue - test -w $ac_dir || continue # It is less confusing to not echo anything here. - (echo 1 > $ac_dir/conftest9012345) 2>/dev/null - (echo 2 > $ac_dir/conftest9012346) 2>/dev/null - val=`cat $ac_dir/conftest9012345 2>/dev/null` - if test ! -f $ac_dir/conftest9012345 || test "$val" != 1; then - ac_cv_sys_long_file_names=no - rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null - break - fi - rm -f $ac_dir/conftest9012345 $ac_dir/conftest9012346 2>/dev/null -done - -echo "$ac_t""$ac_cv_sys_long_file_names" 1>&6 -if test $ac_cv_sys_long_file_names = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_LONG_FILE_NAMES -EOF -cat >> confdefs.h <<\EOF -#define HAVE_LONG_FILE_NAMES 1 -EOF -} - -fi - - - -echo $ac_n "checking for sin in -lm""... $ac_c" 1>&6 -echo "configure:4329: checking for sin in -lm" >&5 -ac_lib_var=`echo m'_'sin | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo m | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - -{ test "$extra_verbose" = "yes" && cat << \EOF - Defining LISP_FLOAT_TYPE -EOF -cat >> confdefs.h <<\EOF -#define LISP_FLOAT_TYPE 1 -EOF -} - - -cat > conftest.$ac_ext < -int main() { -return atanh(1.0) + asinh(1.0) + acosh(1.0); -; return 0; } -EOF -if { (eval echo configure:4394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_INVERSE_HYPERBOLIC -EOF -cat >> confdefs.h <<\EOF -#define HAVE_INVERSE_HYPERBOLIC 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* - -echo "checking type of mail spool file locking" 1>&6 -echo "configure:4411: checking type of mail spool file locking" >&5 -test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock -test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf -if test "$mail_locking" = "lockf"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining REAL_MAIL_USE_LOCKF -EOF -cat >> confdefs.h <<\EOF -#define REAL_MAIL_USE_LOCKF 1 -EOF -} - -elif test "$mail_locking" = "flock"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining REAL_MAIL_USE_FLOCK -EOF -cat >> confdefs.h <<\EOF -#define REAL_MAIL_USE_FLOCK 1 -EOF -} - -else mail_locking="dot-locking" -fi - - -echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:4435: checking for kstat_open in -lkstat" >&5 -ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lkstat " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo kstat | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - - -echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:4485: checking for kvm_read in -lkvm" >&5 -ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lkvm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo kvm | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - -case "$opsys" in decosf*) - -echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:4536: checking for cma_open in -lpthreads" >&5 -ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lpthreads " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo pthreads | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - test "$ac_cv_lib_pthreads_cma_open" = "yes" && \ - c_switch_site="$c_switch_site -threads" ;; -esac - -echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:4588: checking whether the -xildoff compiler flag is required" >&5 -if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then - if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; - then echo "$ac_t""no" 1>&6; - else echo "$ac_t""yes" 1>&6; ld_switch_site="$ld_switch_site -xildoff" && if test "$extra_verbose" = "yes"; then echo " Appending \"-xildoff\" to \$ld_switch_site"; fi - fi - else echo "$ac_t""no" 1>&6 -fi - -if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then - echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6 -echo "configure:4599: checking for \"-z ignore\" linker flag" >&5 - case "`ld -h 2>&1`" in - *-z\ ignore\|record* ) echo "$ac_t""yes" 1>&6 - ld_switch_site="-z ignore $ld_switch_site" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-z ignore\" to \$ld_switch_site"; fi ;; - *) echo "$ac_t""no" 1>&6 ;; - esac -fi - - -echo "checking "for specified window system"" 1>&6 -echo "configure:4609: checking "for specified window system"" >&5 - -if test "$with_x11" != "no"; then - test "$x_includes $x_libraries" != "NONE NONE" && \ - window_system=x11 with_x11=yes - - - if test "$x_includes $x_libraries" = "NONE NONE" \ - -a -n "$OPENWINHOME" \ - -a "$OPENWINHOME" != "/usr/openwin" \ - -a -d "$OPENWINHOME"; then - test -d "$OPENWINHOME/lib" && x_libraries="$OPENWINHOME/lib" - test -d "$OPENWINHOME/include" && x_includes="$OPENWINHOME/include" - test -d "$OPENWINHOME/share/include" && x_includes="$OPENWINHOME/share/include" - fi - - if test "$x_includes" = "NONE"; then - for dir in "/usr/X11" "/usr/X11R6"; do - if test -d "$dir/include/X11"; then x_includes="$dir/include"; break; fi - done - fi - - if test "$x_libraries" = "NONE"; then - for dir in "/usr/X11/lib" "/usr/X11R6/lib" "/usr/lib/X11R6"; do - if test -r "$dir/libX11.a"; then x_libraries="$dir"; break; fi - done - fi - - # If we find X, set shell vars x_includes and x_libraries to the -# paths, otherwise set no_x=yes. -# Uses ac_ vars as temps to allow command line to override cache and checks. -# --without-x overrides everything else, but does not touch the cache. -echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:4642: checking for X" >&5 - -# Check whether --with-x or --without-x was given. -if test "${with_x+set}" = set; then - withval="$with_x" - : -fi - -# $have_x is `yes', `no', `disabled', or empty when we do not yet know. -if test "x$with_x" = xno; then - # The user explicitly disabled X. - have_x=disabled -else - if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then - # Both variables are already set. - have_x=yes - else - -# One or both of the vars are not set, and there is no cached value. -ac_x_includes=NO ac_x_libraries=NO -rm -fr conftestdir -if mkdir conftestdir; then - cd conftestdir - # Make sure to not put "make" in the Imakefile rules, since we grep it out. - cat > Imakefile <<'EOF' -acfindx: - @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"' -EOF - if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. - eval `${MAKE-make} acfindx 2>/dev/null | grep -v make` - # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. - for ac_extension in a so sl; do - if test ! -f $ac_im_usrlibdir/libX11.$ac_extension && - test -f $ac_im_libdir/libX11.$ac_extension; then - ac_im_usrlibdir=$ac_im_libdir; break - fi - done - # Screen out bogus values from the imake configuration. They are - # bogus both because they are the default anyway, and because - # using them would break gcc on systems where it needs fixed includes. - case "$ac_im_incroot" in - /usr/include) ;; - *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;; - esac - case "$ac_im_usrlibdir" in - /usr/lib | /lib) ;; - *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;; - esac - fi - cd .. - rm -fr conftestdir -fi - -if test "$ac_x_includes" = NO; then - # Guess where to find include files, by looking for this one X11 .h file. - test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h - - # First, try using that file with no special directory specified. -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4707: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - # We can compile using X headers with no special include directory. -ac_x_includes= -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - # Look for the header file in a standard set of common directories. -# Check X11 before X11Rn because it is often a symlink to the current release. - for ac_dir in \ - /usr/X11/include \ - /usr/X11R6/include \ - /usr/X11R5/include \ - /usr/X11R4/include \ - \ - /usr/include/X11 \ - /usr/include/X11R6 \ - /usr/include/X11R5 \ - /usr/include/X11R4 \ - \ - /usr/local/X11/include \ - /usr/local/X11R6/include \ - /usr/local/X11R5/include \ - /usr/local/X11R4/include \ - \ - /usr/local/include/X11 \ - /usr/local/include/X11R6 \ - /usr/local/include/X11R5 \ - /usr/local/include/X11R4 \ - \ - /usr/X386/include \ - /usr/x386/include \ - /usr/XFree86/include/X11 \ - \ - /usr/include \ - /usr/local/include \ - /usr/unsupported/include \ - /usr/athena/include \ - /usr/local/x11r5/include \ - /usr/lpp/Xamples/include \ - \ - /usr/openwin/include \ - /usr/openwin/share/include \ - ; \ - do - if test -r "$ac_dir/$x_direct_test_include"; then - ac_x_includes=$ac_dir - break - fi - done -fi -rm -f conftest* -fi # $ac_x_includes = NO - -if test "$ac_x_libraries" = NO; then - # Check for the libraries. - - test -z "$x_direct_test_library" && x_direct_test_library=Xt - test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc - - # See if we find them without any special options. - # Don't add to $LIBS permanently. - ac_save_LIBS="$LIBS" - LIBS="-l$x_direct_test_library $LIBS" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - LIBS="$ac_save_LIBS" -# We can link X programs with no special library path. -ac_x_libraries= -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - LIBS="$ac_save_LIBS" -# First see if replacing the include by lib works. -# Check X11 before X11Rn because it is often a symlink to the current release. -for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \ - /usr/X11/lib \ - /usr/X11R6/lib \ - /usr/X11R5/lib \ - /usr/X11R4/lib \ - \ - /usr/lib/X11 \ - /usr/lib/X11R6 \ - /usr/lib/X11R5 \ - /usr/lib/X11R4 \ - \ - /usr/local/X11/lib \ - /usr/local/X11R6/lib \ - /usr/local/X11R5/lib \ - /usr/local/X11R4/lib \ - \ - /usr/local/lib/X11 \ - /usr/local/lib/X11R6 \ - /usr/local/lib/X11R5 \ - /usr/local/lib/X11R4 \ - \ - /usr/X386/lib \ - /usr/x386/lib \ - /usr/XFree86/lib/X11 \ - \ - /usr/lib \ - /usr/local/lib \ - /usr/unsupported/lib \ - /usr/athena/lib \ - /usr/local/x11r5/lib \ - /usr/lpp/Xamples/lib \ - /lib/usr/lib/X11 \ - \ - /usr/openwin/lib \ - /usr/openwin/share/lib \ - ; \ -do - for ac_extension in a so sl; do - if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then - ac_x_libraries=$ac_dir - break 2 - fi - done -done -fi -rm -f conftest* -fi # $ac_x_libraries = NO - -if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then - # Didn't find X anywhere. Cache the known absence of X. - ac_cv_have_x="have_x=no" -else - # Record where we found X for the cache. - ac_cv_have_x="have_x=yes \ - ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries" -fi - fi - eval "$ac_cv_have_x" -fi # $with_x != no - -if test "$have_x" != yes; then - echo "$ac_t""$have_x" 1>&6 - no_x=yes -else - # If each of the values was on the command line, it overrides each guess. - test "x$x_includes" = xNONE && x_includes=$ac_x_includes - test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries - # Update the cache value to reflect the command line values. - ac_cv_have_x="have_x=yes \ - ac_x_includes=$x_includes ac_x_libraries=$x_libraries" - echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6 -fi - -if test "$no_x" = yes; then - # Not all programs may use this symbol, but it does not hurt to define it. - { test "$extra_verbose" = "yes" && cat << \EOF - Defining X_DISPLAY_MISSING -EOF -cat >> confdefs.h <<\EOF -#define X_DISPLAY_MISSING 1 -EOF -} - - X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS= -else - if test -n "$x_includes"; then - X_CFLAGS="$X_CFLAGS -I$x_includes" - fi - - # It would also be nice to do this for all -L options, not just this one. - if test -n "$x_libraries"; then - X_LIBS="$X_LIBS -L$x_libraries" - # For Solaris; some versions of Sun CC require a space after -R and - # others require no space. Words are not sufficient . . . . - case "`(uname -sr) 2>/dev/null`" in - "SunOS 5"*) - echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 -echo "configure:4892: checking whether -R must be followed by a space" >&5 - ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - ac_R_nospace=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_R_nospace=no -fi -rm -f conftest* - if test $ac_R_nospace = yes; then - echo "$ac_t""no" 1>&6 - X_LIBS="$X_LIBS -R$x_libraries" - else - LIBS="$ac_xsave_LIBS -R $x_libraries" - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - ac_R_space=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_R_space=no -fi -rm -f conftest* - if test $ac_R_space = yes; then - echo "$ac_t""yes" 1>&6 - X_LIBS="$X_LIBS -R $x_libraries" - else - echo "$ac_t""neither works" 1>&6 - fi - fi - LIBS="$ac_xsave_LIBS" - esac - fi - - # Check for system-dependent libraries X programs must link with. - # Do this before checking for the system-independent R6 libraries - # (-lICE), since we may need -lsocket or whatever for X linking. - - if test "$ISC" = yes; then - X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet" - else - # Martyn.Johnson@cl.cam.ac.uk says this is needed for Ultrix, if the X - # libraries were built with DECnet support. And karl@cs.umb.edu says - # the Alpha needs dnet_stub (dnet does not exist). - if test "$with_dnet" = "no" ; then -ac_cv_lib_dnet_dnet_ntoa=no -else - -echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4961: checking for dnet_ntoa in -ldnet" >&5 -ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldnet " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet" -else - echo "$ac_t""no" 1>&6 -fi - -fi - - if test $ac_cv_lib_dnet_dnet_ntoa = no; then - -echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 -echo "configure:5001: checking for dnet_ntoa in -ldnet_stub" >&5 -ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldnet_stub " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - - # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT, - # to get the SysV transport functions. - # chad@anasazi.com says the Pyramis MIS-ES running DC/OSx (SVR4) - # needs -lnsl. - # The nsl library prevents programs from opening the X display - # on Irix 5.2, according to dickey@clark.net. - echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:5046: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char gethostbyname(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname) -choke me -#else -gethostbyname(); -#endif - -; return 0; } -EOF -if { (eval echo configure:5072: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_gethostbyname=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_gethostbyname=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -fi - - if test $ac_cv_func_gethostbyname = no; then - -echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:5093: checking for gethostbyname in -lnsl" >&5 -ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lnsl " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - - # lieder@skyler.mavd.honeywell.com says without -lsocket, - # socket/setsockopt and other routines are undefined under SCO ODT - # 2.0. But -lsocket is broken on IRIX 5.2 (and is not necessary - # on later versions), says simon@lia.di.epfl.ch: it contains - # gethostby* variants that don't use the nameserver (or something). - # -lsocket must be given before -lnsl if both are needed. - # We assume that if connect needs -lnsl, so does gethostbyname. - echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:5139: checking for connect" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char connect(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_connect) || defined (__stub___connect) -choke me -#else -connect(); -#endif - -; return 0; } -EOF -if { (eval echo configure:5165: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_connect=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_connect=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -fi - - if test $ac_cv_func_connect = no; then - -xe_msg_checking="for connect in -lsocket" -test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" -echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5188: checking "$xe_msg_checking"" >&5 -ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lsocket $X_EXTRA_LIBS" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - - # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. - echo $ac_n "checking for remove""... $ac_c" 1>&6 -echo "configure:5228: checking for remove" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char remove(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_remove) || defined (__stub___remove) -choke me -#else -remove(); -#endif - -; return 0; } -EOF -if { (eval echo configure:5254: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_remove=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_remove=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'remove`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -fi - - if test $ac_cv_func_remove = no; then - -echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:5275: checking for remove in -lposix" >&5 -ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lposix " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - - # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. - echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:5315: checking for shmat" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char shmat(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_shmat) || defined (__stub___shmat) -choke me -#else -shmat(); -#endif - -; return 0; } -EOF -if { (eval echo configure:5341: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_shmat=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_shmat=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'shmat`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -fi - - if test $ac_cv_func_shmat = no; then - -echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:5362: checking for shmat in -lipc" >&5 -ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lipc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - fi - - # Check for libraries that X11R6 Xt/Xaw programs need. - ac_save_LDFLAGS="$LDFLAGS" - test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries" - # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to - # check for ICE first), but we must link in the order -lSM -lICE or - # we get undefined symbols. So assume we have SM if we have ICE. - # These have to be linked with before -lX11, unlike the other - # libraries we check for below, so use a different variable. - # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. - -xe_msg_checking="for IceConnectionNumber in -lICE" -test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" -echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5414: checking "$xe_msg_checking"" >&5 -ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lICE $X_EXTRA_LIBS" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE" -else - echo "$ac_t""no" 1>&6 -fi - - - LDFLAGS="$ac_save_LDFLAGS" - -fi - # Autoconf claims to find X library and include dirs for us. - if test "$no_x" = "yes" - then with_x11=no window_system=none HAVE_X_WINDOWS=no - else with_x11=yes window_system=x11 HAVE_X_WINDOWS=yes - fi -fi - -case "$with_x11" in - yes ) window_system=x11 HAVE_X_WINDOWS=yes ;; - no ) window_system=none HAVE_X_WINDOWS=no ;; -esac - -if test "$with_x11" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_X_WINDOWS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_X_WINDOWS 1 -EOF -} - - MAKE_SUBDIR="$MAKE_SUBDIR lwlib" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib\" to \$MAKE_SUBDIR"; fi - SRC_SUBDIR_DEPS="$SRC_SUBDIR_DEPS lwlib" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib\" to \$SRC_SUBDIR_DEPS"; fi - - for lib_dir in "/usr/dt/lib" "/usr/lib/Motif2.1" "/usr/lib/Motif1.2" "/usr/lib/Motif1.1"; do - inc_dir=`echo $lib_dir | sed -e 's/lib/include/'` - if test -d "$lib_dir" -a -d "$inc_dir"; then - case "$x_libraries" in *"$lib_dir"* ) ;; *) - x_libraries="$lib_dir $x_libraries" - X_LIBS="-L${lib_dir} $X_LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-L${lib_dir}\" to \$X_LIBS"; fi ;; - esac - case "$x_includes" in "$inc_dir"* ) ;; *) - x_includes="$inc_dir $x_includes" - X_CFLAGS="-I${inc_dir} $X_CFLAGS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-I${inc_dir}\" to \$X_CFLAGS"; fi ;; - esac - break; fi - done - - for rel in "X11R6" "X11R5" "X11R4"; do - lib_dir="/usr/contrib/$rel/lib" inc_dir="/usr/contrib/$rel/include" - if test -d "$lib_dir" -a -d "$inc_dir"; then - case "$x_libraries" in *"$lib_dir"* ) ;; *) - x_libraries="$x_libraries $lib_dir" - X_LIBS="$X_LIBS -L${lib_dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L${lib_dir}\" to \$X_LIBS"; fi - esac - case "$x_includes" in "$inc_dir"* ) ;; *) - x_includes="$x_includes $inc_dir" - X_CFLAGS="$X_CFLAGS -I${inc_dir}" && if test "$extra_verbose" = "yes"; then echo " Appending \"-I${inc_dir}\" to \$X_CFLAGS"; fi - esac - break; fi - done - - if test "$GCC" = yes -a -d /usr/shlib; then X_LIBS="$X_LIBS -L/usr/shlib" && if test "$extra_verbose" = "yes"; then echo " Appending \"-L/usr/shlib\" to \$X_LIBS"; fi; fi - - ld_switch_x_site="$X_LIBS" - - -if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - - runpath="" runpath_dirs="" - if test -n "$LD_RUN_PATH"; then - runpath="$LD_RUN_PATH" - elif test "$GCC" = "yes"; then - ld_switch_run_save="$ld_switch_run"; ld_switch_run="" - echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c - xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null' - for arg in `eval "$xe_runpath_link" | grep ' -L'`; do - case "$arg" in P,* | -L* | -R* ) - for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do - { -xe_runpath_dir="$dir" - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -} - done ;; - esac - done - ld_switch_run="$ld_switch_run_save" - rm -f conftest* - else - for arg in $ld_switch_site $ld_switch_x_site; do - case "$arg" in -L*) { -xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'` - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -};; esac - done - if test "$opsys $need_motif" = "sol2 yes"; then - xe_runpath_dir="/opt/SUNWdt/lib"; - eval "$xe_add_unique_runpath_dir"; - fi - fi - if test -n "$runpath"; then - ld_switch_run="${dash_r}${runpath}" - -if test "$GCC" = "yes"; then - set x $ld_switch_run; shift; ld_switch_run="" - while test -n "$1"; do - case $1 in - -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;; - -L* | -l* | -u* | -Wl* | -pg ) ld_switch_run="$ld_switch_run $1" ;; - -Xlinker* ) ;; - * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;; - esac - shift - done -fi - test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath" - fi -fi - - - if test "$extra_verbose" = "yes"; then - echo; echo "X11 compilation variables:" - for var in x_libraries x_includes X_CFLAGS X_LIBS X_PRE_LIBS X_EXTRA_LIBS; do eval "echo \"$var = '\$$var'\""; done - echo - fi - - bitmapdirs= - if test "$x_includes" != NONE; then - for i in $x_includes; do - if test -d "$i/bitmaps"; then - bitmapdirs="$i/bitmaps:$bitmapdirs" - fi - if test -d "$i/X11/bitmaps"; then - bitmapdirs="$i/X11/bitmaps:$bitmapdirs" - fi - done - bitmapdirs=`echo "$bitmapdirs" | sed s/.$//` - fi - test ! -z "$bitmapdirs" && { test "$extra_verbose" = "yes" && cat << EOF - Defining BITMAPDIR = "$bitmapdirs" -EOF -cat >> confdefs.h <&6 -echo "configure:5599: checking for X defines extracted by xmkmf" >&5 - rm -fr conftestdir - if mkdir conftestdir; then - cd conftestdir - cat > Imakefile <<'EOF' -xetest: - @echo ${PROTO_DEFINES} ${STD_DEFINES} -EOF - if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. - xmkmf_defines=`${MAKE-make} xetest 2>/dev/null | grep -v make` - fi - cd .. - rm -fr conftestdir - for word in $xmkmf_defines; do - case "$word" in - -D*=* ) ;; - -D* ) word=`echo '' $word | sed -e 's:^ *-D::'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $word -EOF -cat >> confdefs.h <&6 -echo "configure:5631: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5639: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -{ echo "configure: error: "Unable to find X11 header files."" 1>&2; exit 1; } -fi - - - -echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:5663: checking for XOpenDisplay in -lX11" >&5 -ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lX11 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - have_lib_x11=yes -else - echo "$ac_t""no" 1>&6 -fi - - - if test "$have_lib_x11" != "yes"; then - -xe_msg_checking="for XGetFontProperty in -lX11" -test -n "-b i486-linuxaout" && xe_msg_checking="$xe_msg_checking using extra libs -b i486-linuxaout" -echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5704: checking "$xe_msg_checking"" >&5 -ac_lib_var=`echo X11'_'XGetFontProperty | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lX11 -b i486-linuxaout" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site" -else - echo "$ac_t""no" 1>&6 -{ echo "configure: error: "Unable to find X11 libraries."" 1>&2; exit 1; } -fi - - - fi - libs_x="-lX11" - test "$extra_verbose" = "yes" && echo " Setting libs_x to \"-lX11\"" - - -echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5747: checking for XShapeSelectInput in -lXext" >&5 -ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXext " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-lXext $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXext\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 -fi - - - - -echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5786: checking for XtOpenDisplay in -lXt" >&5 -ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXt " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-lXt $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXt\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 -{ echo "configure: error: "Unable to find X11 libraries."" 1>&2; exit 1; } -fi - - - - echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5825: checking the version of X11 being used" >&5 - cat > conftest.$ac_ext < - int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; } -EOF -if { (eval echo configure:5832: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ./conftest foobar; x11_release=$? -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - x11_release=4 -fi -rm -fr conftest* - echo "$ac_t""R${x11_release}" 1>&6 - { test "$extra_verbose" = "yes" && cat << EOF - Defining THIS_IS_X11R${x11_release} -EOF -cat >> confdefs.h <&6 -echo "configure:5857: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5865: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - - - echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5896: checking for XFree86" >&5 - if test -d "/usr/X386/include" -o \ - -f "/etc/XF86Config" -o \ - -f "/etc/X11/XF86Config" -o \ - -f "/usr/X11R6/lib/X11/XF86Config"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XFREE386 -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XFREE386 1 -EOF -} - - else - echo "$ac_t""no" 1>&6 - fi - - test -z "$with_xmu" && { -echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6 -echo "configure:5916: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 -ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXmu " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_xmu=yes -else - echo "$ac_t""no" 1>&6 -with_xmu=no -fi - - } - if test "$with_xmu" = "no"; then - extra_objs="$extra_objs xmu.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"xmu.o\"" - fi - else - libs_x="-lXmu $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXmu\" to \$libs_x"; fi - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XMU -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XMU 1 -EOF -} - - fi - - -echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5971: checking for main in -lXbsd" >&5 -ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXbsd " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-lXbsd $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXbsd\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 -fi - - - - if test "$unexec" = "unexaix.o" -a "$x11_release" = "6"; then - if test "$GCC" = "yes"; then - X_CFLAGS="-mthreads $X_CFLAGS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-mthreads\" to \$X_CFLAGS"; fi - libs_x="-mthreads $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-mthreads\" to \$libs_x"; fi - else - case "$CC" in - "xlc" ) CC="xlc_r" ;; - "xlC" ) CC="xlC_r" ;; - "cc" ) CC="cc_r" ;; - esac - fi - fi - -fi -if test "$with_msw" != "no"; then - echo "checking for MS-Windows" 1>&6 -echo "configure:6020: checking for MS-Windows" >&5 - -echo $ac_n "checking for main in -lgdi32""... $ac_c" 1>&6 -echo "configure:6023: checking for main in -lgdi32" >&5 -ac_lib_var=`echo gdi32'_'main | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lgdi32 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_msw=yes -else - echo "$ac_t""no" 1>&6 -fi - - - if test "$with_msw" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MS_WINDOWS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MS_WINDOWS 1 -EOF -} - - install_pp="$blddir/lib-src/installexe.sh" - libs_system="$libs_system -lshell32 -lgdi32 -luser32 -lcomctl32" && if test "$extra_verbose" = "yes"; then echo " Appending \"-lshell32 -lgdi32 -luser32 -lcomctl32\" to \$libs_system"; fi - test "$with_dragndrop" != no && dragndrop_proto="$dragndrop_proto msw" && if test "$extra_verbose" = "yes"; then echo " Appending \"msw\" to \$dragndrop_proto"; fi - if test "$window_system" != x11; then - window_system=msw - test "$with_scrollbars" != "no" && with_scrollbars=msw \ - && extra_objs="$extra_objs scrollbar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"scrollbar-msw.o\"" - fi - test "$with_menubars" != "no" && with_menubars=msw \ - && extra_objs="$extra_objs menubar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"menubar-msw.o\"" - fi - test "$with_toolbars" != "no" && with_toolbars=msw \ - && extra_objs="$extra_objs toolbar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"toolbar-msw.o\"" - fi - test "$with_dialogs" != "no" && with_dialogs=msw \ - && extra_objs="$extra_objs dialog-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"dialog-msw.o\"" - fi - else - test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"scrollbar-msw.o\"" - fi - test "$with_menubars" != "no" && extra_objs="$extra_objs menubar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"menubar-msw.o\"" - fi - test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"toolbar-msw.o\"" - fi - test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"dialog-msw.o\"" - fi - fi - cat > conftest.$ac_ext < - int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; } -EOF -if { (eval echo configure:6105: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MSG_SELECT -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MSG_SELECT 1 -EOF -} - -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -fr conftest* - const_is_losing=no - with_file_coding=yes - use_minimal_tagbits=yes - use_indexed_lrecord_implementation=yes - extra_objs="$extra_objs console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o\"" - fi - fi -fi - - - -test -z "$window_system" && window_system="none" - -if test "$window_system" = "none"; then - for feature in menubars scrollbars toolbars dialogs dragndrop xface - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - echo "configure: warning: --with-$feature ignored: Not valid without window system support" 1>&2 - fi - eval "with_${feature}=no" - done -else - test -z "$with_toolbars" && with_toolbars=yes -fi - -if test "$with_msw" != "yes"; then - for feature in MARTIN_IS_CLUELESS_ABOUT_MSW_FEATURES - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - echo "configure: warning: --with-$feature ignored: Not valid without MS-Windows support" 1>&2 - fi - eval "with_${feature}=no" - done -else - : -fi - -if test "$with_x11" != "yes"; then - for feature in tooltalk cde offix session xim xmu - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - echo "configure: warning: --with-$feature ignored: Not valid without X support" 1>&2 - fi - eval "with_${feature}=no" - done -fi - -bitmapdir= - -case "$window_system" in - x11 ) HAVE_X_WINDOWS=yes; echo " Using X11." ;; - msw ) HAVE_X_WINDOWS=no ; echo " Using MS-Windows." ;; - none ) HAVE_X_WINDOWS=no ; echo " Using no window system." ;; -esac - -case "$x_libraries" in *X11R4* ) - test "$opsys" = "hpux9" && opsysfile="s/hpux9-x11r4.h" - test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" -esac - -echo "checking for session-management option" 1>&6 -echo "configure:6183: checking for session-management option" >&5; -if test "$with_session" != "no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SESSION -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SESSION 1 -EOF -} - -fi - -test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no -test -z "$with_xauth" && { ac_safe=`echo "X11/Xauth.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for X11/Xauth.h""... $ac_c" 1>&6 -echo "configure:6198: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6206: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_xauth=no -fi - } -test -z "$with_xauth" && { -echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:6229: checking for XauGetAuthByAddr in -lXau" >&5 -ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXau " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_xauth=no -fi - - } -test -z "$with_xauth" && with_xauth=yes -if test "$with_xauth" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XAUTH -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XAUTH 1 -EOF -} - - -T="" -for W in $X_EXTRA_LIBS -lXau $libs_x $X_PRE_LIBS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -libs_xauth="$T" - -fi - - - - -if test "$with_tooltalk" != "no" ; then - for dir in "" "Tt/" "desktop/" ; do - ac_safe=`echo "${dir}tt_c.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ${dir}tt_c.h""... $ac_c" 1>&6 -echo "configure:6290: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6298: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - tt_c_h_path="${dir}tt_c.h"; break -else - echo "$ac_t""no" 1>&6 -fi - - done - if test -z "$tt_c_h_path"; then - if test "$with_tooltalk" = "yes"; then - (echo "$progname: Usage error:" -echo " " "Unable to find required tooltalk header files." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi - with_tooltalk=no - fi -fi -if test "$with_tooltalk" != "no" ; then - for extra_libs in "" "-lI18N -lce" "-lcxx"; do - -xe_msg_checking="for tt_message_create in -ltt" -test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" -echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6334: checking "$xe_msg_checking"" >&5 -ac_lib_var=`echo tt'_'tt_message_create | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ltt $extra_libs" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - tt_libs="-ltt $extra_libs"; break -else - echo "$ac_t""no" 1>&6 -: -fi - - - done - if test -z "$tt_libs"; then - if test "$with_tooltalk" = "yes"; then - (echo "$progname: Usage error:" -echo " " "Unable to find required tooltalk libraries." -echo " Use \`$progname --help' to show usage.") >&2 && exit 1 - fi - with_tooltalk=no - fi -fi -test -z "$with_tooltalk" && with_tooltalk=yes -if test "$with_tooltalk" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining TOOLTALK -EOF -cat >> confdefs.h <<\EOF -#define TOOLTALK 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << EOF - Defining TT_C_H_PATH = "$tt_c_h_path" -EOF -cat >> confdefs.h <&6 -echo "configure:6407: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6415: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_cde=no -fi - } -test -z "$with_cde" && { -echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:6438: checking for DtDndDragStart in -lDtSvc" >&5 -ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lDtSvc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_cde=no -fi - - } -test -z "$with_cde" && with_cde=yes -if test "$with_dragndrop" = no; then - echo "configure: warning: No CDE without generic Drag'n'Drop support" 1>&2 - with_cde=no -fi -if test "$with_cde" = "yes" ; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_CDE -EOF -cat >> confdefs.h <<\EOF -#define HAVE_CDE 1 -EOF -} - - libs_x="-lDtSvc $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lDtSvc\" to \$libs_x"; fi - dragndrop_proto="$dragndrop_proto CDE" && if test "$extra_verbose" = "yes"; then echo " Appending \"CDE\" to \$dragndrop_proto"; fi - with_tooltalk=yes # CDE requires Tooltalk - need_motif=yes # CDE requires Motif -fi - -test "$window_system" != "x11" && with_offix=no -if test "$with_xmu" != yes -a "$with_x11" = yes; then - echo "configure: warning: No OffiX without real Xmu support" 1>&2 - with_offix=no -fi -if test "$with_dragndrop" = no; then - echo "configure: warning: No OffiX without generic Drag'n'Drop support" 1>&2 - with_offix=no -fi -if test "$with_cde" = yes; then - echo "configure: warning: CDE already found, disabling OffiX support" 1>&2 - with_offix=no -fi -test -z "$with_offix" && with_offix=no -if test "$with_offix" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_OFFIX_DND -EOF -cat >> confdefs.h <<\EOF -#define HAVE_OFFIX_DND 1 -EOF -} - - dnd_objs="$dnd_objs offix.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"offix.o\" to \$dnd_objs"; fi - dragndrop_proto="$dragndrop_proto OffiX" && if test "$extra_verbose" = "yes"; then echo " Appending \"OffiX\" to \$dragndrop_proto"; fi -fi - -echo $ac_n "checking if drag and drop API is needed""... $ac_c" 1>&6 -echo "configure:6523: checking if drag and drop API is needed" >&5 -if test "$with_dragndrop" != "no" ; then - if test -n "$dragndrop_proto" ; then - with_dragndrop=yes - echo "$ac_t""yes (${dragndrop_proto} )" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DRAGNDROP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DRAGNDROP 1 -EOF -} - - extra_objs="$extra_objs dragdrop.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"dragdrop.o\" to \$extra_objs"; fi - else - with_dragndrop=no - echo "$ac_t""no" 1>&6 - fi -fi - -echo "checking for LDAP" 1>&6 -echo "configure:6544: checking for LDAP" >&5 -test -z "$with_ldap" && { ac_safe=`echo "ldap.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ldap.h""... $ac_c" 1>&6 -echo "configure:6547: checking for ldap.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6555: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_ldap=no -fi - } -test -z "$with_ldap" && { ac_safe=`echo "lber.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for lber.h""... $ac_c" 1>&6 -echo "configure:6578: checking for lber.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6586: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_ldap=no -fi - } -if test "$with_ldap" != "no"; then - test -z "$with_umich_ldap" && { -xe_msg_checking="for ldap_open in -lldap" -test -n "-llber" && xe_msg_checking="$xe_msg_checking using extra libs -llber" -echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6612: checking "$xe_msg_checking"" >&5 -ac_lib_var=`echo ldap'_'ldap_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lldap -llber" -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_umich_ldap=yes -else - echo "$ac_t""no" 1>&6 -with_umich_ldap=no -fi - - } - test "$with_umich_ldap" = "no" && { -echo $ac_n "checking for ldap_set_option in -lldap10""... $ac_c" 1>&6 -echo "configure:6651: checking for ldap_set_option in -lldap10" >&5 -ac_lib_var=`echo ldap10'_'ldap_set_option | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lldap10 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_ns_ldap=yes -else - echo "$ac_t""no" 1>&6 -with_ns_ldap=no -fi - - } - test -z "$with_ldap" -a \( "$with_umich_ldap" = "yes" -o "$with_ns_ldap" = "yes" \) && with_ldap=yes -fi -if test "$with_ldap" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_LDAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_LDAP 1 -EOF -} - - extra_objs="$extra_objs eldap.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"eldap.o\"" - fi - if test "$with_umich_ldap" = "yes" ; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_UMICH_LDAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_UMICH_LDAP 1 -EOF -} - - LIBS="-llber $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-llber\" to \$LIBS"; fi - LIBS="-lldap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap\" to \$LIBS"; fi - elif test "$with_ldap" = "yes" -a "$with_ns_ldap" = "yes" ; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_NS_LDAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_NS_LDAP 1 -EOF -} - - LIBS="-lldap10 $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap10\" to \$LIBS"; fi - elif test "$with_ldap" = "yes" ; then - LIBS="-lldap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lldap\" to \$LIBS"; fi - fi -fi - - -if test "$window_system" != "none"; then - echo "checking for graphics libraries" 1>&6 -echo "configure:6731: checking for graphics libraries" >&5 - - xpm_problem="" - if test -z "$with_xpm"; then - echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:6736: checking for Xpm - no older than 3.4f" >&5 - xe_check_libs=-lXpm - cat > conftest.$ac_ext < - int main(int c, char **v) { - return c == 1 ? 0 : - XpmIncludeVersion != XpmLibraryVersion() ? 1 : - XpmIncludeVersion < 30406 ? 2 : 0 ;} -EOF -if { (eval echo configure:6747: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ./conftest dummy_arg; xpm_status=$?; - if test "$xpm_status" = "0"; then - with_xpm=yes; - else - with_xpm=no; - if test "$xpm_status" = "1"; then - xpm_problem="Xpm library version and header file version don't match!" - elif test "$xpm_status" = "2"; then - xpm_problem="Xpm library version is too old!" - else - xpm_problem="Internal xpm detection logic error!" - fi - echo " -*** WARNING *** $xpm_problem - I'm not touching that with a 10-foot pole! - If you really want to use the installed version of Xpm, rerun - configure and add '--with-xpm=yes', but don't blame me if XEmacs crashes!" - fi -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - with_xpm=no -fi -rm -fr conftest* - xe_check_libs= - echo "$ac_t""$with_xpm" 1>&6 - fi - if test "$with_xpm" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XPM -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XPM 1 -EOF -} - - libs_x="-lXpm $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXpm\" to \$libs_x"; fi - echo $ac_n "checking for \"FOR_MSW\" xpm""... $ac_c" 1>&6 -echo "configure:6789: checking for \"FOR_MSW\" xpm" >&5 - xe_check_libs=-lXpm - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - xpm_for_msw=no -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - xpm_for_msw=yes -fi -rm -f conftest* - xe_check_libs= - echo "$ac_t""$xpm_for_msw" 1>&6 - if test "$xpm_for_msw" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining FOR_MSW -EOF -cat >> confdefs.h <<\EOF -#define FOR_MSW 1 -EOF -} - - fi - fi - - test -z "$with_xface" && { ac_safe=`echo "compface.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for compface.h""... $ac_c" 1>&6 -echo "configure:6825: checking for compface.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6833: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_xface=no -fi - } - test -z "$with_xface" && { -echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:6856: checking for UnGenFace in -lcompface" >&5 -ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lcompface " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_xface=no -fi - - } - test -z "$with_xface" && with_xface=yes - if test "$with_xface" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XFACE -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XFACE 1 -EOF -} - - libs_x="-lcompface $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcompface\" to \$libs_x"; fi - fi - - if test "$with_gif" != "no"; then - with_gif="yes" - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_GIF -EOF -cat >> confdefs.h <<\EOF -#define HAVE_GIF 1 -EOF -} - - extra_objs="$extra_objs dgif_lib.o gif_io.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"dgif_lib.o gif_io.o\"" - fi - fi - - if test "$with_png $with_tiff" != "no no"; then - -echo $ac_n "checking for inflate in -lc""... $ac_c" 1>&6 -echo "configure:6924: checking for inflate in -lc" >&5 -ac_lib_var=`echo c'_'inflate | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 - -echo $ac_n "checking for inflate in -lz""... $ac_c" 1>&6 -echo "configure:6959: checking for inflate in -lz" >&5 -ac_lib_var=`echo z'_'inflate | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lz " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-lz $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lz\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 - -echo $ac_n "checking for inflate in -lgz""... $ac_c" 1>&6 -echo "configure:6994: checking for inflate in -lgz" >&5 -ac_lib_var=`echo gz'_'inflate | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lgz " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-lgz $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgz\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 -fi - - -fi - - -fi - - - fi - - test -z "$with_jpeg" && { ac_safe=`echo "jpeglib.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for jpeglib.h""... $ac_c" 1>&6 -echo "configure:7040: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7048: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_jpeg=no -fi - } - test -z "$with_jpeg" && { -echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:7071: checking for jpeg_destroy_decompress in -ljpeg" >&5 -ac_lib_var=`echo jpeg'_'jpeg_destroy_decompress | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ljpeg " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_jpeg=no -fi - - } - test -z "$with_jpeg" && with_jpeg=yes - if test "$with_jpeg" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_JPEG -EOF -cat >> confdefs.h <<\EOF -#define HAVE_JPEG 1 -EOF -} - - libs_x="-ljpeg $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ljpeg\" to \$libs_x"; fi - fi - - png_problem="" - test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:7123: checking for pow" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char pow(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_pow) || defined (__stub___pow) -choke me -#else -pow(); -#endif - -; return 0; } -EOF -if { (eval echo configure:7149: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_pow=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_pow=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'pow`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_png=no -fi - } - test -z "$with_png" && { ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for png.h""... $ac_c" 1>&6 -echo "configure:7170: checking for png.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7178: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_png=no -fi - } - test -z "$with_png" && { -echo $ac_n "checking for png_read_image in -lpng""... $ac_c" 1>&6 -echo "configure:7201: checking for png_read_image in -lpng" >&5 -ac_lib_var=`echo png'_'png_read_image | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lpng " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_png=no -fi - - } - if test -z "$with_png"; then - echo $ac_n "checking for workable png version information""... $ac_c" 1>&6 -echo "configure:7240: checking for workable png version information" >&5 - xe_check_libs="-lpng -lz" - cat > conftest.$ac_ext < - int main(int c, char **v) { - if (c == 1) return 0; - if (strcmp(png_libpng_ver, PNG_LIBPNG_VER_STRING) != 0) return 1; - return (PNG_LIBPNG_VER < 10002) ? 2 : 0 ;} -EOF -if { (eval echo configure:7251: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ./conftest dummy_arg; png_status=$?; - if test "$png_status" = "0"; then - with_png=yes; - else - with_png=no; - if test "$png_status" = "1"; then - png_problem="PNG library version and header file don't match!" - elif test "$png_status" = "2"; then - png_problem="PNG library version too old (pre 1.0.2)!" - fi - echo " -*** WARNING *** $png_problem - I'm not touching that with a 10-foot pole! - If you really want to use the installed version of libPNG, rerun - configure and add '--with-png=yes', but don't blame me if XEmacs crashes!" - fi -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - with_png=no -fi -rm -fr conftest* - xe_check_libs= - echo "$ac_t""$with_png" 1>&6 - fi - if test "$with_png" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_PNG -EOF -cat >> confdefs.h <<\EOF -#define HAVE_PNG 1 -EOF -} - - libs_x="-lpng $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lpng\" to \$libs_x"; fi - fi - - test -z "$with_tiff" && { ac_safe=`echo "tiffio.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for tiffio.h""... $ac_c" 1>&6 -echo "configure:7294: checking for tiffio.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7302: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_tiff=no -fi - } - test -z "$with_tiff" && { -echo $ac_n "checking for TIFFClientOpen in -ltiff""... $ac_c" 1>&6 -echo "configure:7325: checking for TIFFClientOpen in -ltiff" >&5 -ac_lib_var=`echo tiff'_'TIFFClientOpen | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ltiff " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_tiff=no -fi - - } - test -z "$with_tiff" && with_tiff=yes - if test "$with_tiff" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TIFF -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TIFF 1 -EOF -} - - libs_x="-ltiff $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ltiff\" to \$libs_x"; fi - fi -fi - - -if test "$with_x11" = "yes"; then - - echo "checking for X11 graphics libraries" 1>&6 -echo "configure:7380: checking for X11 graphics libraries" >&5 - - -echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:7384: checking for XawScrollbarSetThumb in -lXaw" >&5 -ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXaw " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - have_xaw=yes -else - echo "$ac_t""no" 1>&6 -have_xaw=no -fi - - - - ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:7424: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7432: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - -echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:7449: checking for XmStringFree in -lXm" >&5 -ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - have_motif=yes -else - echo "$ac_t""no" 1>&6 -have_motif=no -fi - - -else - echo "$ac_t""no" 1>&6 -have_motif=no -fi - - - if test "$have_motif" = "yes"; then - echo $ac_n "checking for Lesstif""... $ac_c" 1>&6 -echo "configure:7494: checking for Lesstif" >&5 - cat > conftest.$ac_ext < -#ifdef LESSTIF_VERSION -yes -#endif - -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "yes" >/dev/null 2>&1; then - rm -rf conftest* - have_lesstif=yes -else - rm -rf conftest* - have_lesstif=no -fi -rm -f conftest* - - echo "$ac_t""$have_lesstif" 1>&6 - fi - -fi - -case "$with_menubars" in "" | "yes" | "athena" | "athena3d" ) - with_menubars="lucid" ;; -esac -case "$with_dialogs" in "" | "yes" | "lucid" ) - if test "$have_motif" = "yes"; then with_dialogs="motif" - elif test "$have_xaw" = "yes"; then with_dialogs="athena" - else with_dialogs=no - fi ;; -esac -case "$with_scrollbars" in "" | "yes" ) - with_scrollbars="lucid" ;; -esac - -all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars" - -case "$all_widgets" in *athena* ) - { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_USES_ATHENA -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_USES_ATHENA 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NEED_ATHENA -EOF -cat >> confdefs.h <<\EOF -#define NEED_ATHENA 1 -EOF -} - - lwlib_objs="$lwlib_objs lwlib-Xaw.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xaw.o\" to \$lwlib_objs"; fi - libs_x="-lXaw $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXaw\" to \$libs_x"; fi ;; -esac - -case "$all_widgets" in *motif* ) - { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_USES_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_USES_MOTIF 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NEED_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define NEED_MOTIF 1 -EOF -} - - lwlib_objs="$lwlib_objs lwlib-Xm.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xm.o\" to \$lwlib_objs"; fi - need_motif=yes ;; -esac - -test "$with_menubars" = "lucid" && lwlib_objs="$lwlib_objs xlwmenu.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwmenu.o\" to \$lwlib_objs"; fi -test "$with_menubars" = "motif" && lwlib_objs="$lwlib_objs xlwmenu.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwmenu.o\" to \$lwlib_objs"; fi -test "$with_scrollbars" = "lucid" && lwlib_objs="$lwlib_objs xlwscrollbar.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"xlwscrollbar.o\" to \$lwlib_objs"; fi -case "$all_widgets" in *lucid* ) - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NEED_LUCID -EOF -cat >> confdefs.h <<\EOF -#define NEED_LUCID 1 -EOF -} - - lwlib_objs="$lwlib_objs lwlib-Xlw.o" && if test "$extra_verbose" = "yes"; then echo " Appending \"lwlib-Xlw.o\" to \$lwlib_objs"; fi ;; -esac - - - -case "$with_scrollbars" in athena* ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_SCROLLBARS_ATHENA -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_SCROLLBARS_ATHENA 1 -EOF -} -;; esac -case "$with_dialogs" in athena* ) { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_DIALOGS_ATHENA -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_DIALOGS_ATHENA 1 -EOF -} - ;; esac -test "$with_scrollbars" = "athena3d" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_SCROLLBARS_ATHENA3D -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_SCROLLBARS_ATHENA3D 1 -EOF -} - -test "$with_dialogs" = "athena3d" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_DIALOGS_ATHENA3D -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_DIALOGS_ATHENA3D 1 -EOF -} - - -test "$with_menubars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MENUBARS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MENUBARS 1 -EOF -} - -test "$with_scrollbars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SCROLLBARS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SCROLLBARS 1 -EOF -} - -test "$with_dialogs" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DIALOGS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DIALOGS 1 -EOF -} - -test "$with_toolbars" != "no" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TOOLBARS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TOOLBARS 1 -EOF -} - - -test "$with_menubars" = "lucid" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_MENUBARS_LUCID -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_MENUBARS_LUCID 1 -EOF -} - -test "$with_scrollbars" = "lucid" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_SCROLLBARS_LUCID -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_SCROLLBARS_LUCID 1 -EOF -} - - -test "$with_menubars" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_MENUBARS_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_MENUBARS_MOTIF 1 -EOF -} - -test "$with_scrollbars" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_SCROLLBARS_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_SCROLLBARS_MOTIF 1 -EOF -} - -test "$with_dialogs" = "motif" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining LWLIB_DIALOGS_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define LWLIB_DIALOGS_MOTIF 1 -EOF -} - - -test "$with_menubars" != "no" && extra_objs="$extra_objs menubar.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"menubar.o\"" - fi -test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"scrollbar.o\"" - fi -test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"dialog.o\"" - fi -test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"toolbar.o\"" - fi - -if test "$with_x11" = "yes"; then - test "$with_menubars" != "no" && extra_objs="$extra_objs menubar-x.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"menubar-x.o\"" - fi - test "$with_scrollbars" != "no" && extra_objs="$extra_objs scrollbar-x.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"scrollbar-x.o\"" - fi - test "$with_dialogs" != "no" && extra_objs="$extra_objs dialog-x.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"dialog-x.o\"" - fi - test "$with_toolbars" != "no" && extra_objs="$extra_objs toolbar-x.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"toolbar-x.o\"" - fi - test "$all_widgets" != "no no no no" && extra_objs="$extra_objs gui-x.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"gui-x.o\"" - fi -else - if test \( "$with_sound" = "nas" \) -o \( "$with_sound" = "both" \); then - echo "Attempt to Build NAS sound without X" - echo "Please remove NAS configuration or build with X" - exit 1 - fi -fi - -test "$use_minimal_tagbits" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_MINIMAL_TAGBITS -EOF -cat >> confdefs.h <<\EOF -#define USE_MINIMAL_TAGBITS 1 -EOF -} - -test "$use_indexed_lrecord_implementation" = "yes" && \ - { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_INDEXED_LRECORD_IMPLEMENTATION -EOF -cat >> confdefs.h <<\EOF -#define USE_INDEXED_LRECORD_IMPLEMENTATION 1 -EOF -} - - - -test -z "$with_mule" && with_mule=no -test -z "$with_file_coding" && with_file_coding=no - - -if test "$with_file_coding" = "yes" && test "$with_mule" = "no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining FILE_CODING -EOF -cat >> confdefs.h <<\EOF -#define FILE_CODING 1 -EOF -} - - extra_objs="$extra_objs file-coding.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"file-coding.o\"" - fi -fi - -if test "$with_mule" = "yes" ; then - echo "checking for Mule-related features" 1>&6 -echo "configure:7777: checking for Mule-related features" >&5 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining MULE -EOF -cat >> confdefs.h <<\EOF -#define MULE 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining FILE_CODING -EOF -cat >> confdefs.h <<\EOF -#define FILE_CODING 1 -EOF -} - - extra_objs="$extra_objs mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o\"" - fi - - for ac_hdr in libintl.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:7802: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7810: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - - -echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:7841: checking for strerror in -lintl" >&5 -ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lintl " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo intl | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - - echo "checking for Mule input methods" 1>&6 -echo "configure:7890: checking for Mule input methods" >&5 - case "$with_xim" in "" | "yes" ) - echo "checking for XIM" 1>&6 -echo "configure:7893: checking for XIM" >&5 - -echo $ac_n "checking for XOpenIM in -lX11""... $ac_c" 1>&6 -echo "configure:7896: checking for XOpenIM in -lX11" >&5 -ac_lib_var=`echo X11'_'XOpenIM | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lX11 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_xim=xlib -else - echo "$ac_t""no" 1>&6 -with_xim=no -fi - - - if test "$have_motif $have_lesstif" = "yes no"; then - -echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:7936: checking for XmImMbLookupString in -lXm" >&5 -ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lXm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_xim=motif -else - echo "$ac_t""no" 1>&6 -fi - - - fi ;; - esac - if test "$with_xim" != "no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_XIM -EOF -cat >> confdefs.h <<\EOF -#define HAVE_XIM 1 -EOF -} - - if test "$with_xim" = "xlib"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining XIM_XLIB -EOF -cat >> confdefs.h <<\EOF -#define XIM_XLIB 1 -EOF -} - - extra_objs="$extra_objs input-method-xlib.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"input-method-xlib.o\"" - fi - fi - if test "$with_xim" = "motif"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining XIM_MOTIF -EOF -cat >> confdefs.h <<\EOF -#define XIM_MOTIF 1 -EOF -} - - need_motif=yes - extra_objs="$extra_objs input-method-motif.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"input-method-motif.o\"" - fi - fi - if test "$with_xim" = "motif"; then - with_xfs=no - fi - fi - - if test "$with_xfs" = "yes" ; then - echo "checking for XFontSet" 1>&6 -echo "configure:8017: checking for XFontSet" >&5 - -echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6 -echo "configure:8020: checking for XmbDrawString in -lX11" >&5 -ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lX11 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_xfs=no -fi - - - if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_XFONTSET -EOF -cat >> confdefs.h <<\EOF -#define USE_XFONTSET 1 -EOF -} - - if test "$with_xim" = "no" ; then - extra_objs="$extra_objs input-method-xfs.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"input-method-xfs.o\"" - fi - fi - fi - fi - test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support - test -z "$with_wnn" && { ac_safe=`echo "wnn/jllib.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for wnn/jllib.h""... $ac_c" 1>&6 -echo "configure:8076: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8084: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_wnn=no -fi - } - if test "$with_wnn" != "no"; then - for ac_func in crypt -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8109: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:8135: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - - test "$ac_cv_func_crypt" != "yes" && { -echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6 -echo "configure:8164: checking for crypt in -lcrypt" >&5 -ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lcrypt " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo crypt | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - } - fi - if test -z "$with_wnn" -o "$with_wnn" = "yes"; then - -echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:8215: checking for jl_dic_list_e in -lwnn" >&5 -ac_lib_var=`echo wnn'_'jl_dic_list_e | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lwnn " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libwnn=wnn -else - echo "$ac_t""no" 1>&6 -echo $ac_n "checking for jl_dic_list_e in -lwnn4""... $ac_c" 1>&6 -echo "configure:8249: checking for jl_dic_list_e in -lwnn4" >&5 -ac_lib_var=`echo wnn4'_'jl_dic_list_e | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lwnn4 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libwnn=wnn4 -else - echo "$ac_t""no" 1>&6 -echo $ac_n "checking for jl_dic_list_e in -lwnn6""... $ac_c" 1>&6 -echo "configure:8283: checking for jl_dic_list_e in -lwnn6" >&5 -ac_lib_var=`echo wnn6'_'jl_dic_list_e | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lwnn6 " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libwnn=wnn6 -else - echo "$ac_t""no" 1>&6 -echo $ac_n "checking for dic_list_e in -lwnn6_fromsrc""... $ac_c" 1>&6 -echo "configure:8317: checking for dic_list_e in -lwnn6_fromsrc" >&5 -ac_lib_var=`echo wnn6_fromsrc'_'dic_list_e | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lwnn6_fromsrc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libwnn=wnn6_fromsrc -else - echo "$ac_t""no" 1>&6 -with_wnn=no -fi - - -fi - - -fi - - -fi - - - fi - test -z "$with_wnn" && with_wnn=yes - if test "$with_wnn" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_WNN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_WNN 1 -EOF -} - - libs_x="-l$libwnn $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l$libwnn\" to \$libs_x"; fi - extra_objs="$extra_objs mule-wnnfns.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"mule-wnnfns.o\"" - fi - if test "$with_wnn6" != "no"; then - -echo $ac_n "checking for jl_fi_dic_list in -l$libwnn""... $ac_c" 1>&6 -echo "configure:8381: checking for jl_fi_dic_list in -l$libwnn" >&5 -ac_lib_var=`echo $libwnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'` - -xe_check_libs=" -l$libwnn " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_wnn6=yes -else - echo "$ac_t""no" 1>&6 -fi - - - test "$with_wnn6" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining WNN6 -EOF -cat >> confdefs.h <<\EOF -#define WNN6 1 -EOF -} - - fi - fi - - canna_includes_found=no - if test "$with_canna" != "no"; then - ac_safe=`echo "canna/jrkanji.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for canna/jrkanji.h""... $ac_c" 1>&6 -echo "configure:8432: checking for canna/jrkanji.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8440: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - canna_includes_found=yes -else - echo "$ac_t""no" 1>&6 -fi - - fi - if test "$canna_includes_found" = "no" -a "$with_canna" != "no" -a \ - -d "/usr/local/canna/include"; then - save_c_switch_site="$c_switch_site" - c_switch_site="$c_switch_site -I/usr/local/canna/include" - ac_safe=`echo "canna/jrkanji.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for canna/jrkanji.h""... $ac_c" 1>&6 -echo "configure:8467: checking for canna/jrkanji.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8475: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - canna_includes_found=yes -else - echo "$ac_t""no" 1>&6 -fi - - if test "$canna_includes_found" != "yes"; then - c_switch_site="$save_c_switch_site" - with_canna="no" - fi - fi - - test -z "$with_canna" && { ac_safe=`echo "canna/RK.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for canna/RK.h""... $ac_c" 1>&6 -echo "configure:8503: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:8511: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_canna=no -fi - } - test -z "$with_canna" && { -echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:8534: checking for RkBgnBun in -lRKC" >&5 -ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lRKC " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_canna=no -fi - - } - test -z "$with_canna" && { -echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:8573: checking for jrKanjiControl in -lcanna" >&5 -ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lcanna " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_canna=no -fi - - } - test -z "$with_canna" && with_canna=yes - if test "$with_canna" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_CANNA -EOF -cat >> confdefs.h <<\EOF -#define HAVE_CANNA 1 -EOF -} - - libs_x="-lcanna -lRKC $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcanna -lRKC\" to \$libs_x"; fi - extra_objs="$extra_objs mule-canna.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"mule-canna.o\"" - fi - fi - -else for feature in xim canna wnn; do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - echo "configure: warning: "--with-${feature} ignored: Not valid without Mule support"" 1>&2 - fi - eval "with_${feature}=no" - done -fi - -if test "$need_motif" = "yes" ; then - libs_x="-lXm $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lXm\" to \$libs_x"; fi - -echo $ac_n "checking for layout_object_getvalue in -li18n""... $ac_c" 1>&6 -echo "configure:8638: checking for layout_object_getvalue in -li18n" >&5 -ac_lib_var=`echo i18n'_'layout_object_getvalue | sed 'y%./+-%__p_%'` - -xe_check_libs=" -li18n " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - libs_x="-li18n $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-li18n\" to \$libs_x"; fi -else - echo "$ac_t""no" 1>&6 -fi - - - -if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[^ ]*//g"` - - runpath="" runpath_dirs="" - if test -n "$LD_RUN_PATH"; then - runpath="$LD_RUN_PATH" - elif test "$GCC" = "yes"; then - ld_switch_run_save="$ld_switch_run"; ld_switch_run="" - echo "int main(int argc, char *argv[]) {return 0;}" > conftest.c - xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null' - for arg in `eval "$xe_runpath_link" | grep ' -L'`; do - case "$arg" in P,* | -L* | -R* ) - for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do - { -xe_runpath_dir="$dir" - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -} - done ;; - esac - done - ld_switch_run="$ld_switch_run_save" - rm -f conftest* - else - for arg in $ld_switch_site $ld_switch_x_site; do - case "$arg" in -L*) { -xe_runpath_dir=`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'` - test "$xe_runpath_dir" != "/lib" -a \ - "$xe_runpath_dir" != "/usr/lib" -a \ - -n "`ls ${xe_runpath_dir}/*.s[ol] 2>/dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -};; esac - done - if test "$opsys $need_motif" = "sol2 yes"; then - xe_runpath_dir="/opt/SUNWdt/lib"; - eval "$xe_add_unique_runpath_dir"; - fi - fi - if test -n "$runpath"; then - ld_switch_run="${dash_r}${runpath}" - -if test "$GCC" = "yes"; then - set x $ld_switch_run; shift; ld_switch_run="" - while test -n "$1"; do - case $1 in - -L | -l | -u ) ld_switch_run="$ld_switch_run $1 $2"; shift ;; - -L* | -l* | -u* | -Wl* | -pg ) ld_switch_run="$ld_switch_run $1" ;; - -Xlinker* ) ;; - * ) ld_switch_run="$ld_switch_run -Xlinker $1" ;; - esac - shift - done -fi - test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath" - fi -fi - -fi - -for ac_func in cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8740: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:8766: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - - - -case "$opsys" in - linuxaout* | bsdos3* | freebsd* | decosf4-0* | aix4* ) extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - * ) - case "$canonical" in - *-*-sysv4.2uw2* ) extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - * ) for ac_func in realpath -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:8807: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:8833: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - - test "$ac_cv_func_realpath" != "yes" && extra_objs="$extra_objs realpath.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"realpath.o\"" - fi ;; - esac ;; -esac - -echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:8867: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext < -int main() { -return h_errno; -; return 0; } -EOF -if { (eval echo configure:8876: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_H_ERRNO -EOF -cat >> confdefs.h <<\EOF -#define HAVE_H_ERRNO 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - -echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:8896: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext < -int main() { -sigjmp_buf bar; sigsetjmp (bar, 0); -; return 0; } -EOF -if { (eval echo configure:8905: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SIGSETJMP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SIGSETJMP 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - -echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:8925: checking whether localtime caches TZ" >&5 - -if test "$ac_cv_func_tzset" = "yes"; then -cat > conftest.$ac_ext < -#if STDC_HEADERS -# include -#endif -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} -char TZ_GMT0[] = "TZ=GMT0"; -char TZ_PST8[] = "TZ=PST8"; -main() -{ - time_t now = time ((time_t *) 0); - int hour_GMT0, hour_unset; - if (putenv (TZ_GMT0) != 0) - exit (1); - hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); - hour_unset = localtime (&now)->tm_hour; - if (putenv (TZ_PST8) != 0) - exit (1); - if (localtime (&now)->tm_hour == hour_GMT0) - exit (1); - unset_TZ (); - if (localtime (&now)->tm_hour != hour_unset) - exit (1); - exit (0); -} -EOF -if { (eval echo configure:8964: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - emacs_cv_localtime_cache=no -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - emacs_cv_localtime_cache=yes -fi -rm -fr conftest* -else - # If we lack tzset, report that localtime does not cache TZ, - # since we can't invalidate the cache if we don't have tzset. - emacs_cv_localtime_cache=no -fi -echo "$ac_t""$emacs_cv_localtime_cache" 1>&6 -if test $emacs_cv_localtime_cache = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining LOCALTIME_CACHE -EOF -cat >> confdefs.h <<\EOF -#define LOCALTIME_CACHE 1 -EOF -} - -fi - -if test "$HAVE_TIMEVAL" = "yes"; then -echo $ac_n "checking whether gettimeofday accepts one or two arguments""... $ac_c" 1>&6 -echo "configure:8994: checking whether gettimeofday accepts one or two arguments" >&5 -cat > conftest.$ac_ext < -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif - -int main() { - - struct timeval time; - struct timezone dummy; - gettimeofday (&time, &dummy); - -; return 0; } -EOF -if { (eval echo configure:9018: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - echo "$ac_t""two" 1>&6 -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""one" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining GETTIMEOFDAY_ONE_ARGUMENT -EOF -cat >> confdefs.h <<\EOF -#define GETTIMEOFDAY_ONE_ARGUMENT 1 -EOF -} - -fi -rm -f conftest* -fi - - -echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:9040: checking for inline" >&5 - -ac_cv_c_inline=no -for ac_kw in inline __inline__ __inline; do - cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - ac_cv_c_inline=$ac_kw; break -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* -done - - -echo "$ac_t""$ac_cv_c_inline" 1>&6 -case "$ac_cv_c_inline" in - inline | yes) ;; - no) { test "$extra_verbose" = "yes" && cat << \EOF - Defining inline = -EOF -cat >> confdefs.h <<\EOF -#define inline -EOF -} - ;; - *) { test "$extra_verbose" = "yes" && cat << EOF - Defining inline = $ac_cv_c_inline -EOF -cat >> confdefs.h <> confdefs.h <<\EOF -#define HAVE_INLINE 1 -EOF -} - - test "$GCC" = "yes" && extra_objs="$extra_objs inline.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"inline.o\"" - fi -fi - - -# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works -# for constant arguments. Useless! -echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6 -echo "configure:9102: checking for working alloca.h" >&5 - -cat > conftest.$ac_ext < -int main() { -char *p = alloca(2 * sizeof(int)); -; return 0; } -EOF -if { (eval echo configure:9112: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - ac_cv_header_alloca_h=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_header_alloca_h=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_header_alloca_h" 1>&6 -if test $ac_cv_header_alloca_h = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_ALLOCA_H -EOF -cat >> confdefs.h <<\EOF -#define HAVE_ALLOCA_H 1 -EOF -} - -fi - -echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:9136: checking for alloca" >&5 - -cat > conftest.$ac_ext < -# define alloca _alloca -# else -# if HAVE_ALLOCA_H -# include -# else -# ifdef _AIX - #pragma alloca -# else -# ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); -# endif -# endif -# endif -# endif -#endif - -int main() { -char *p = (char *) alloca(1); -; return 0; } -EOF -if { (eval echo configure:9167: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - ac_cv_func_alloca_works=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - ac_cv_func_alloca_works=no -fi -rm -f conftest* - -echo "$ac_t""$ac_cv_func_alloca_works" 1>&6 -if test $ac_cv_func_alloca_works = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_ALLOCA -EOF -cat >> confdefs.h <<\EOF -#define HAVE_ALLOCA 1 -EOF -} - -fi - -if test $ac_cv_func_alloca_works = no; then - # The SVR3 libPW and SVR4 libucb both contain incompatible functions - # that cause trouble. Some versions do not even contain alloca or - # contain a buggy version. If you still want to use their alloca, - # use ar to extract alloca.o from them instead of compiling alloca.c. - ALLOCA=alloca.${ac_objext} - { test "$extra_verbose" = "yes" && cat << \EOF - Defining C_ALLOCA -EOF -cat >> confdefs.h <<\EOF -#define C_ALLOCA 1 -EOF -} - - -echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6 -echo "configure:9206: checking whether alloca needs Cray hooks" >&5 - -cat > conftest.$ac_ext <&5 | - egrep "webecray" >/dev/null 2>&1; then - rm -rf conftest* - ac_cv_os_cray=yes -else - rm -rf conftest* - ac_cv_os_cray=no -fi -rm -f conftest* - - -echo "$ac_t""$ac_cv_os_cray" 1>&6 -if test $ac_cv_os_cray = yes; then -for ac_func in _getb67 GETB67 getb67; do - echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:9233: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:9259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << EOF - Defining CRAY_STACKSEG_END = $ac_func -EOF -cat >> confdefs.h <&6 -fi - -done -fi - -echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6 -echo "configure:9289: checking stack direction for C alloca" >&5 - -cat > conftest.$ac_ext < addr) ? 1 : -1; -} -main () -{ - exit (find_stack_direction() < 0); -} -EOF -if { (eval echo configure:9311: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_c_stack_direction=1 -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_c_stack_direction=-1 -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_c_stack_direction" 1>&6 -{ test "$extra_verbose" = "yes" && cat << EOF - Defining STACK_DIRECTION = $ac_cv_c_stack_direction -EOF -cat >> confdefs.h <&6 -echo "configure:9340: checking for vfork.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9348: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_VFORK_H -EOF -cat >> confdefs.h <<\EOF -#define HAVE_VFORK_H 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi - -echo $ac_n "checking for working vfork""... $ac_c" 1>&6 -echo "configure:9376: checking for working vfork" >&5 - -cat > conftest.$ac_ext < -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_VFORK_H -#include -#endif -/* On some sparc systems, changes by the child to local and incoming - argument registers are propagated back to the parent. - The compiler is told about this with #include , - but some compilers (e.g. gcc -O) don't grok . - Test for this by using a static variable whose address - is put into a register that is clobbered by the vfork. */ -static -#ifdef __cplusplus -sparc_address_test (int arg) -#else -sparc_address_test (arg) int arg; -#endif -{ - static pid_t child; - if (!child) { - child = vfork (); - if (child < 0) { - perror ("vfork"); - _exit(2); - } - if (!child) { - arg = getpid(); - write(-1, "", 0); - _exit (arg); - } - } -} -main() { - pid_t parent = getpid (); - pid_t child; - - sparc_address_test (); - - child = vfork (); - - if (child == 0) { - /* Here is another test for sparc vfork register problems. - This test uses lots of local variables, at least - as many local variables as main has allocated so far - including compiler temporaries. 4 locals are enough for - gcc 1.40.3 on a Solaris 4.1.3 sparc, but we use 8 to be safe. - A buggy compiler should reuse the register of parent - for one of the local variables, since it will think that - parent can't possibly be used any more in this routine. - Assigning to the local variable will thus munge parent - in the parent process. */ - pid_t - p = getpid(), p1 = getpid(), p2 = getpid(), p3 = getpid(), - p4 = getpid(), p5 = getpid(), p6 = getpid(), p7 = getpid(); - /* Convince the compiler that p..p7 are live; otherwise, it might - use the same hardware register for all 8 local variables. */ - if (p != p1 || p != p2 || p != p3 || p != p4 - || p != p5 || p != p6 || p != p7) - _exit(1); - - /* On some systems (e.g. IRIX 3.3), - vfork doesn't separate parent from child file descriptors. - If the child closes a descriptor before it execs or exits, - this munges the parent's descriptor as well. - Test for this by closing stdout in the child. */ - _exit(close(fileno(stdout)) != 0); - } else { - int status; - struct stat st; - - while (wait(&status) != child) - ; - exit( - /* Was there some problem with vforking? */ - child < 0 - - /* Did the child fail? (This shouldn't happen.) */ - || status - - /* Did the vfork/compiler bug occur? */ - || parent != getpid() - - /* Did the file descriptor bug occur? */ - || fstat(fileno(stdout), &st) != 0 - ); - } -} -EOF -if { (eval echo configure:9474: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_func_vfork_works=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_func_vfork_works=no -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_func_vfork_works" 1>&6 -if test $ac_cv_func_vfork_works = no; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining vfork = fork -EOF -cat >> confdefs.h <<\EOF -#define vfork fork -EOF -} - -fi - - -echo $ac_n "checking for working strcoll""... $ac_c" 1>&6 -echo "configure:9500: checking for working strcoll" >&5 - -cat > conftest.$ac_ext < -main () -{ - exit (strcoll ("abc", "def") >= 0 || - strcoll ("ABC", "DEF") >= 0 || - strcoll ("123", "456") >= 0); -} -EOF -if { (eval echo configure:9513: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_func_strcoll_works=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_func_strcoll_works=no -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_func_strcoll_works" 1>&6 -if test $ac_cv_func_strcoll_works = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_STRCOLL -EOF -cat >> confdefs.h <<\EOF -#define HAVE_STRCOLL 1 -EOF -} - -fi - - -for ac_func in getpgrp -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:9541: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:9567: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - -echo $ac_n "checking whether getpgrp takes no argument""... $ac_c" 1>&6 -echo "configure:9595: checking whether getpgrp takes no argument" >&5 - -cat > conftest.$ac_ext < -#include - -int pid; -int pg1, pg2, pg3, pg4; -int ng, np, s, child; - -main() -{ - pid = getpid(); - pg1 = getpgrp(0); - pg2 = getpgrp(); - pg3 = getpgrp(pid); - pg4 = getpgrp(1); - - /* - * If all of these values are the same, it's pretty sure that - * we're on a system that ignores getpgrp's first argument. - */ - if (pg2 == pg4 && pg1 == pg3 && pg2 == pg3) - exit(0); - - child = fork(); - if (child < 0) - exit(1); - else if (child == 0) { - np = getpid(); - /* - * If this is Sys V, this will not work; pgrp will be - * set to np because setpgrp just changes a pgrp to be - * the same as the pid. - */ - setpgrp(np, pg1); - ng = getpgrp(0); /* Same result for Sys V and BSD */ - if (ng == pg1) { - exit(1); - } else { - exit(0); - } - } else { - wait(&s); - exit(s>>8); - } -} - -EOF -if { (eval echo configure:9653: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_func_getpgrp_void=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_func_getpgrp_void=no -fi -rm -fr conftest* - - -echo "$ac_t""$ac_cv_func_getpgrp_void" 1>&6 -if test $ac_cv_func_getpgrp_void = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining GETPGRP_VOID -EOF -cat >> confdefs.h <<\EOF -#define GETPGRP_VOID 1 -EOF -} - -fi - - -echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:9680: checking for working mmap" >&5 -case "$opsys" in ultrix* ) have_mmap=no ;; *) -cat > conftest.$ac_ext < -#include -#include -#include - -#ifndef MAP_VARIABLE -#define MAP_VARIABLE 0 -#endif - -#ifndef MAP_FAILED -#define MAP_FAILED -1 -#endif - -int main (int argc, char *argv[]) -{ - int fd = -1; - caddr_t p; -#ifndef MAP_ANONYMOUS - fd = open ("/dev/zero", O_RDWR); - if (fd < 0) - return 1; -#define MAP_ANONYMOUS 0 -#endif - if (mmap(0, 1024, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_VARIABLE | MAP_ANONYMOUS, - fd, 0) != (void *) MAP_FAILED) - return 0; - perror ("conftest: mmap failed"); - return 1; -} -EOF -if { (eval echo configure:9716: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - have_mmap=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - have_mmap=no -fi -rm -fr conftest* ;; -esac -echo "$ac_t""$have_mmap" 1>&6 -test "$have_mmap" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MMAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MMAP 1 -EOF -} - -for ac_hdr in unistd.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:9741: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:9749: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <&6 -fi -done - -for ac_func in getpagesize -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:9781: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:9807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - -echo $ac_n "checking for working mmap""... $ac_c" 1>&6 -echo "configure:9835: checking for working mmap" >&5 - -cat > conftest.$ac_ext < -#include -#include - -/* This mess was copied from the GNU getpagesize.h. */ -#ifndef HAVE_GETPAGESIZE -# ifdef HAVE_UNISTD_H -# include -# endif - -/* Assume that all systems that can run configure have sys/param.h. */ -# ifndef HAVE_SYS_PARAM_H -# define HAVE_SYS_PARAM_H 1 -# endif - -# ifdef _SC_PAGESIZE -# define getpagesize() sysconf(_SC_PAGESIZE) -# else /* no _SC_PAGESIZE */ -# ifdef HAVE_SYS_PARAM_H -# include -# ifdef EXEC_PAGESIZE -# define getpagesize() EXEC_PAGESIZE -# else /* no EXEC_PAGESIZE */ -# ifdef NBPG -# define getpagesize() NBPG * CLSIZE -# ifndef CLSIZE -# define CLSIZE 1 -# endif /* no CLSIZE */ -# else /* no NBPG */ -# ifdef NBPC -# define getpagesize() NBPC -# else /* no NBPC */ -# ifdef PAGESIZE -# define getpagesize() PAGESIZE -# endif /* PAGESIZE */ -# endif /* no NBPC */ -# endif /* no NBPG */ -# endif /* no EXEC_PAGESIZE */ -# else /* no HAVE_SYS_PARAM_H */ -# define getpagesize() 8192 /* punt totally */ -# endif /* no HAVE_SYS_PARAM_H */ -# endif /* no _SC_PAGESIZE */ - -#endif /* no HAVE_GETPAGESIZE */ - -#ifdef __cplusplus -extern "C" { void *malloc(unsigned); } -#else -char *malloc(); -#endif - -int -main() -{ - char *data, *data2, *data3; - int i, pagesize; - int fd; - - pagesize = getpagesize(); - - /* - * First, make a file with some known garbage in it. - */ - data = malloc(pagesize); - if (!data) - exit(1); - for (i = 0; i < pagesize; ++i) - *(data + i) = rand(); - umask(0); - fd = creat("conftestmmap", 0600); - if (fd < 0) - exit(1); - if (write(fd, data, pagesize) != pagesize) - exit(1); - close(fd); - - /* - * Next, try to mmap the file at a fixed address which - * already has something else allocated at it. If we can, - * also make sure that we see the same garbage. - */ - fd = open("conftestmmap", O_RDWR); - if (fd < 0) - exit(1); - data2 = malloc(2 * pagesize); - if (!data2) - exit(1); - data2 += (pagesize - ((int) data2 & (pagesize - 1))) & (pagesize - 1); - if (data2 != mmap(data2, pagesize, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_FIXED, fd, 0L)) - exit(1); - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data2 + i)) - exit(1); - - /* - * Finally, make sure that changes to the mapped area - * do not percolate back to the file as seen by read(). - * (This is a bug on some variants of i386 svr4.0.) - */ - for (i = 0; i < pagesize; ++i) - *(data2 + i) = *(data2 + i) + 1; - data3 = malloc(pagesize); - if (!data3) - exit(1); - if (read(fd, data3, pagesize) != pagesize) - exit(1); - for (i = 0; i < pagesize; ++i) - if (*(data + i) != *(data3 + i)) - exit(1); - close(fd); - unlink("conftestmmap"); - exit(0); -} - -EOF -if { (eval echo configure:9978: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - ac_cv_func_mmap_fixed_mapped=yes -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - ac_cv_func_mmap_fixed_mapped=no -fi -rm -fr conftest* - -echo "$ac_t""$ac_cv_func_mmap_fixed_mapped" 1>&6 -if test $ac_cv_func_mmap_fixed_mapped = yes; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MMAP -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MMAP 1 -EOF -} - -fi - - -test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no -test "$rel_alloc" = "default" -a "$have_mmap" = "yes" && rel_alloc=yes -test "$rel_alloc" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining REL_ALLOC -EOF -cat >> confdefs.h <<\EOF -#define REL_ALLOC 1 -EOF -} - - -ac_safe=`echo "termios.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for termios.h""... $ac_c" 1>&6 -echo "configure:10016: checking for termios.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10024: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TERMIOS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TERMIOS 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining SIGNALS_VIA_CHARACTERS -EOF -cat >> confdefs.h <<\EOF -#define SIGNALS_VIA_CHARACTERS 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NO_TERMIO -EOF -cat >> confdefs.h <<\EOF -#define NO_TERMIO 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -ac_safe=`echo "termio.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for termio.h""... $ac_c" 1>&6 -echo "configure:10067: checking for termio.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TERMIO -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TERMIO 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi - -fi - - - -echo $ac_n "checking for socket""... $ac_c" 1>&6 -echo "configure:10107: checking for socket" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char socket(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_socket) || defined (__stub___socket) -choke me -#else -socket(); -#endif - -; return 0; } -EOF -if { (eval echo configure:10133: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_socket=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_socket=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'socket`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_safe=`echo "netinet/in.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for netinet/in.h""... $ac_c" 1>&6 -echo "configure:10148: checking for netinet/in.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10156: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_safe=`echo "arpa/inet.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for arpa/inet.h""... $ac_c" 1>&6 -echo "configure:10173: checking for arpa/inet.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SOCKETS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SOCKETS 1 -EOF -} - - echo $ac_n "checking "for sun_len member in struct sockaddr_un"""... $ac_c" 1>&6 -echo "configure:10206: checking "for sun_len member in struct sockaddr_un"" >&5 - cat > conftest.$ac_ext < -#include -#include - -int main() { -static struct sockaddr_un x; x.sun_len = 1; -; return 0; } -EOF -if { (eval echo configure:10219: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SOCKADDR_SUN_LEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SOCKADDR_SUN_LEN 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* - echo $ac_n "checking "for ip_mreq struct in netinet/in.h"""... $ac_c" 1>&6 -echo "configure:10237: checking "for ip_mreq struct in netinet/in.h"" >&5 - cat > conftest.$ac_ext < -#include - -int main() { -static struct ip_mreq x; -; return 0; } -EOF -if { (eval echo configure:10249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - echo "$ac_t""yes" 1>&6; { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_MULTICAST -EOF -cat >> confdefs.h <<\EOF -#define HAVE_MULTICAST 1 -EOF -} - -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 -fi -rm -f conftest* -else - echo "$ac_t""no" 1>&6 -fi - -else - echo "$ac_t""no" 1>&6 -fi - -else - echo "$ac_t""no" 1>&6 -fi - - -echo $ac_n "checking for msgget""... $ac_c" 1>&6 -echo "configure:10280: checking for msgget" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char msgget(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_msgget) || defined (__stub___msgget) -choke me -#else -msgget(); -#endif - -; return 0; } -EOF -if { (eval echo configure:10306: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_msgget=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_msgget=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'msgget`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_safe=`echo "sys/ipc.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for sys/ipc.h""... $ac_c" 1>&6 -echo "configure:10321: checking for sys/ipc.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10329: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_safe=`echo "sys/msg.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for sys/msg.h""... $ac_c" 1>&6 -echo "configure:10346: checking for sys/msg.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10354: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SYSVIPC -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SYSVIPC 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi - -else - echo "$ac_t""no" 1>&6 -fi - -else - echo "$ac_t""no" 1>&6 -fi - - -ac_safe=`echo "dirent.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for dirent.h""... $ac_c" 1>&6 -echo "configure:10392: checking for dirent.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10400: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining SYSV_SYSTEM_DIR -EOF -cat >> confdefs.h <<\EOF -#define SYSV_SYSTEM_DIR 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -ac_safe=`echo "sys/dir.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for sys/dir.h""... $ac_c" 1>&6 -echo "configure:10427: checking for sys/dir.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10435: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -{ test "$extra_verbose" = "yes" && cat << \EOF - Defining NONSYSTEM_DIR_LIBRARY -EOF -cat >> confdefs.h <<\EOF -#define NONSYSTEM_DIR_LIBRARY 1 -EOF -} - -fi - -fi - - -ac_safe=`echo "nlist.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for nlist.h""... $ac_c" 1>&6 -echo "configure:10468: checking for nlist.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10476: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NLIST_STRUCT -EOF -cat >> confdefs.h <<\EOF -#define NLIST_STRUCT 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi - - - -echo "checking "for sound support"" 1>&6 -echo "configure:10506: checking "for sound support"" >&5 -case "$with_sound" in - native | both ) with_native_sound=yes;; - nas | no ) with_native_sound=no;; -esac -test -z "$with_native_sound" -a -n "$native_sound_lib" && with_native_sound=yes - -if test "$with_native_sound" != "no"; then - if test -n "$native_sound_lib"; then - ac_safe=`echo "multimedia/audio_device.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for multimedia/audio_device.h""... $ac_c" 1>&6 -echo "configure:10517: checking for multimedia/audio_device.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10525: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - sound_found=yes sound_cflags="" - extra_objs="$extra_objs sunplay.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sunplay.o\"" - fi -else - echo "$ac_t""no" 1>&6 -fi - - fi - - if test -z "$sound_found" -a -d "/usr/demo/SOUND"; then - sound_found=yes - extra_objs="$extra_objs sunplay.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sunplay.o\"" - fi - if test -d "/usr/demo/SOUND/include" - then sound_cflags="-I/usr/demo/SOUND/include" - else sound_cflags="-I/usr/demo/SOUND" - fi - if test -z "$native_sound_lib" ; then - if test -r "/usr/demo/SOUND/lib/libaudio.a" - then native_sound_lib="/usr/demo/SOUND/lib/libaudio.a" - else native_sound_lib="/usr/demo/SOUND/libaudio.a" - fi - fi - fi - - if test -z "$sound_found"; then - case "$canonical" in - *-sgi-* ) - if test -z "$native_sound_lib"; then - -echo $ac_n "checking for ALopenport in -laudio""... $ac_c" 1>&6 -echo "configure:10573: checking for ALopenport in -laudio" >&5 -ac_lib_var=`echo audio'_'ALopenport | sed 'y%./+-%__p_%'` - -xe_check_libs=" -laudio " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - native_sound_lib="-laudio" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - if test -n "$native_sound_lib"; then - sound_found=yes sound_cflags="" - extra_objs="$extra_objs sgiplay.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sgiplay.o\"" - fi - fi ;; - hppa*-hp-hpux* ) - if test -z "$native_sound_lib"; then - -echo $ac_n "checking for AOpenAudio in -lAlib""... $ac_c" 1>&6 -echo "configure:10620: checking for AOpenAudio in -lAlib" >&5 -ac_lib_var=`echo Alib'_'AOpenAudio | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lAlib " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - native_sound_lib="-lAlib" -else - echo "$ac_t""no" 1>&6 -fi - - - fi - if test -n "$native_sound_lib"; then - sound_found=yes - extra_objs="$extra_objs hpplay.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"hpplay.o\"" - fi - if test "$GCC" = "yes" # Kludge city - then sound_cflags="-Dconst= -Dvolatile= -I/usr/audio/examples" - else sound_cflags="+e -I/usr/audio/examples" - fi - fi ;; - esac - fi - - if test -z "$sound_found"; then - for dir in "machine" "sys" "linux"; do - ac_safe=`echo "${dir}/soundcard.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ${dir}/soundcard.h""... $ac_c" 1>&6 -echo "configure:10674: checking for ${dir}/soundcard.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10682: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - sound_found=yes - extra_objs="$extra_objs linuxplay.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"linuxplay.o\"" - fi - { test "$extra_verbose" = "yes" && cat << EOF - Defining SOUNDCARD_H_PATH = "${dir}/soundcard.h" -EOF -cat >> confdefs.h <&6 -fi - - done - fi - - test "$sound_found" = "yes" && with_native_sound=yes -fi - -if test -z "$with_sound"; then - if test "$with_native_sound" = "yes" -o -n "$native_sound_lib"; then - with_sound=native - fi -fi - -if test "$with_native_sound" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_NATIVE_SOUND -EOF -cat >> confdefs.h <<\EOF -#define HAVE_NATIVE_SOUND 1 -EOF -} - - test -n "$native_sound_lib" && LIBS="$native_sound_lib $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$native_sound_lib\" to \$LIBS"; fi -fi - -case "$with_sound" in both | nas ) - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_NAS_SOUND -EOF -cat >> confdefs.h <<\EOF -#define HAVE_NAS_SOUND 1 -EOF -} - - extra_objs="$extra_objs nas.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"nas.o\"" - fi - libs_x="-laudio $libs_x" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-laudio\" to \$libs_x"; fi - cat > conftest.$ac_ext < -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "AuXtErrorJump" >/dev/null 2>&1; then - : -else - rm -rf conftest* - { test "$extra_verbose" = "yes" && cat << \EOF - Defining NAS_NO_ERROR_JUMP -EOF -cat >> confdefs.h <<\EOF -#define NAS_NO_ERROR_JUMP 1 -EOF -} - -fi -rm -f conftest* - -esac - - -test -z "$with_tty" && with_tty=yes - -if test "$with_tty" = "yes" ; then - echo "checking for TTY-related features" 1>&6 -echo "configure:10779: checking for TTY-related features" >&5 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_TTY -EOF -cat >> confdefs.h <<\EOF -#define HAVE_TTY 1 -EOF -} - - extra_objs="$extra_objs console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o\"" - fi - - if test -z "$with_ncurses"; then - -echo $ac_n "checking for tgetent in -lncurses""... $ac_c" 1>&6 -echo "configure:10795: checking for tgetent in -lncurses" >&5 -ac_lib_var=`echo ncurses'_'tgetent | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lncurses " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_ncurses=yes -else - echo "$ac_t""no" 1>&6 -with_ncurses=no -fi - - - fi - if test "$with_ncurses" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_NCURSES -EOF -cat >> confdefs.h <<\EOF -#define HAVE_NCURSES 1 -EOF -} - - ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:10844: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10852: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - curses_h_path=ncurses/curses.h -else - echo "$ac_t""no" 1>&6 -fi - - ac_safe=`echo "ncurses/term.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ncurses/term.h""... $ac_c" 1>&6 -echo "configure:10874: checking for ncurses/term.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10882: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - term_h_path=ncurses/term.h -else - echo "$ac_t""no" 1>&6 -fi - - extra_objs="$extra_objs terminfo.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"terminfo.o\"" - fi - LIBS="-lncurses $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lncurses\" to \$LIBS"; fi - - if test "$ac_cv_header_ncurses_curses_h" != "yes" ; then - save_c_switch_site="$c_switch_site" - c_switch_site="$c_switch_site -I/usr/include/ncurses" - ac_safe=`echo "ncurses/curses.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ncurses/curses.h""... $ac_c" 1>&6 -echo "configure:10912: checking for ncurses/curses.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:10920: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - curses_h_path=ncurses/curses.h -else - echo "$ac_t""no" 1>&6 -fi - - if test "$ac_cv_header_ncurses_curses_h" = "yes" - then echo "configure: warning: "Your system has the bogus ncurses include bug."" 1>&2 - else c_switch_site="$save_c_switch_site" - fi - fi - else if test "$have_terminfo" = "yes"; then - extra_objs="$extra_objs terminfo.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"terminfo.o\"" - fi - if test -n "$libs_termcap"; then - LIBS="$libs_termcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$libs_termcap\" to \$LIBS"; fi - else - for lib in curses termlib termcap; do - -echo $ac_n "checking for tgetent in -l$lib""... $ac_c" 1>&6 -echo "configure:10955: checking for tgetent in -l$lib" >&5 -ac_lib_var=`echo $lib'_'tgetent | sed 'y%./+-%__p_%'` - -xe_check_libs=" -l$lib " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - LIBS="-l${lib} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${lib}\" to \$LIBS"; fi; break -else - echo "$ac_t""no" 1>&6 -fi - - - done - fi - else extra_objs="$extra_objs tparam.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"tparam.o\"" - fi - case "$opsys" in *-hp-hpux* ) libs_termcap="-ltermcap" ;; esac - if test -n "$libs_termcap"; then - LIBS="$libs_termcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"$libs_termcap\" to \$LIBS"; fi - else - -echo $ac_n "checking for tgetent in -lcurses""... $ac_c" 1>&6 -echo "configure:11002: checking for tgetent in -lcurses" >&5 -ac_lib_var=`echo curses'_'tgetent | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lcurses " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - LIBS="-lcurses $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lcurses\" to \$LIBS"; fi -else - echo "$ac_t""no" 1>&6 -echo $ac_n "checking for tgetent in -ltermcap""... $ac_c" 1>&6 -echo "configure:11036: checking for tgetent in -ltermcap" >&5 -ac_lib_var=`echo termcap'_'tgetent | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ltermcap " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - LIBS="-ltermcap $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ltermcap\" to \$LIBS"; fi -else - echo "$ac_t""no" 1>&6 -extra_objs="$extra_objs termcap.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"termcap.o\"" - fi -fi - - -fi - - - fi - fi - fi - { test "$extra_verbose" = "yes" && cat << EOF - Defining CURSES_H_PATH = "${curses_h_path-curses.h}" -EOF -cat >> confdefs.h <> confdefs.h <&6 -echo "configure:11100: checking for gpm.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11108: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 -with_gpm=no -fi - } - test -z "$with_gpm" && { -echo $ac_n "checking for Gpm_Open in -lgpm""... $ac_c" 1>&6 -echo "configure:11131: checking for Gpm_Open in -lgpm" >&5 -ac_lib_var=`echo gpm'_'Gpm_Open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lgpm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_gpm=yes -else - echo "$ac_t""no" 1>&6 -with_gpm=no -fi - - } - if test "$with_gpm" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_GPM -EOF -cat >> confdefs.h <<\EOF -#define HAVE_GPM 1 -EOF -} - - extra_objs="$extra_objs gpmevent.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"gpmevent.o\"" - fi - LIBS="-lgpm $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-lgpm\" to \$LIBS"; fi - fi - -else for feature in ncurses gpm; do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - echo "configure: warning: "--with-${feature} ignored: Not valid without TTY support"" 1>&2 - fi - eval "with_${feature}=no" - done -fi -test "$with_x11" = "yes" -o "$with_tty" = "yes" && extra_objs="$extra_objs event-unixoid.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"event-unixoid.o\"" - fi - - -test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ - != "no no no" && echo "checking for database support" 1>&6 -echo "configure:11197: checking for database support" >&5 - -if test "$with_database_gnudbm $with_database_dbm" != "no no"; then - ac_safe=`echo "ndbm.h" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for ndbm.h""... $ac_c" 1>&6 -echo "configure:11202: checking for ndbm.h" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11210: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 - - test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ - { echo "Error:" "Required DBM support cannot be provided." >&2; exit 1; } - with_database_gnudbm=no with_database_dbm=no -fi - -fi - -if test "$with_database_gnudbm" != "no"; then - -echo $ac_n "checking for dbm_open in -lgdbm""... $ac_c" 1>&6 -echo "configure:11240: checking for dbm_open in -lgdbm" >&5 -ac_lib_var=`echo gdbm'_'dbm_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lgdbm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_database_gnudbm=yes with_database_dbm=no libdbm=-lgdbm -else - echo "$ac_t""no" 1>&6 -if test "$with_database_gnudbm" = "yes"; then - { echo "Error:" "Required GNU DBM support cannot be provided." >&2; exit 1; } - fi - with_database_gnudbm=no -fi - - -fi - -if test "$with_database_dbm" != "no"; then - echo $ac_n "checking for dbm_open""... $ac_c" 1>&6 -echo "configure:11284: checking for dbm_open" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char dbm_open(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_dbm_open) || defined (__stub___dbm_open) -choke me -#else -dbm_open(); -#endif - -; return 0; } -EOF -if { (eval echo configure:11310: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_dbm_open=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_dbm_open=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'dbm_open`\" = yes"; then - echo "$ac_t""yes" 1>&6 - with_database_dbm=yes libdbm= -else - echo "$ac_t""no" 1>&6 - - -echo $ac_n "checking for dbm_open in -ldbm""... $ac_c" 1>&6 -echo "configure:11329: checking for dbm_open in -ldbm" >&5 -ac_lib_var=`echo dbm'_'dbm_open | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldbm " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_database_dbm=yes libdbm=-ldbm -else - echo "$ac_t""no" 1>&6 -test "$with_database_dbm" = "yes" && \ - { echo "Error:" "Required DBM support cannot be provided." >&2; exit 1; } - with_database_dbm=no -fi - - -fi - -fi - -test -n "$libdbm" && LIBS=""$libdbm" $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \""$libdbm"\" to \$LIBS"; fi -test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DBM -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DBM 1 -EOF -} - - -if test "$with_database_berkdb" != "no"; then - echo $ac_n "checking for Berkeley db.h""... $ac_c" 1>&6 -echo "configure:11386: checking for Berkeley db.h" >&5 - for path in "db/db.h" "db.h"; do - cat > conftest.$ac_ext < -typedef uint8_t u_int8_t; -typedef uint16_t u_int16_t; -typedef uint32_t u_int32_t; -#ifdef WE_DONT_NEED_QUADS -typedef uint64_t u_int64_t; -#endif -#endif -#include <$path> - -int main() { - -; return 0; } -EOF -if { (eval echo configure:11407: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - db_h_path="$path"; break -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 -fi -rm -f conftest* - done - if test -z "$db_h_path" - then echo "$ac_t""no" 1>&6; with_database_berkdb=no - else echo "$ac_t""$db_h_path" 1>&6 - fi - - if test "$with_database_berkdb" != "no"; then - echo $ac_n "checking for Berkeley DB version""... $ac_c" 1>&6 -echo "configure:11423: checking for Berkeley DB version" >&5 - cat > conftest.$ac_ext < -#if DB_VERSION_MAJOR > 1 -yes -#endif - -EOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - egrep "yes" >/dev/null 2>&1; then - rm -rf conftest* - echo "$ac_t""2" 1>&6; dbfunc=db_open -else - rm -rf conftest* - echo "$ac_t""1" 1>&6; dbfunc=dbopen -fi -rm -f conftest* - - echo $ac_n "checking for $dbfunc""... $ac_c" 1>&6 -echo "configure:11444: checking for $dbfunc" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $dbfunc(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$dbfunc) || defined (__stub___$dbfunc) -choke me -#else -$dbfunc(); -#endif - -; return 0; } -EOF -if { (eval echo configure:11470: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$dbfunc=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$dbfunc=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$dbfunc`\" = yes"; then - echo "$ac_t""yes" 1>&6 - with_database_berkdb=yes need_libdb=no -else - echo "$ac_t""no" 1>&6 - - -echo $ac_n "checking for $dbfunc in -ldb""... $ac_c" 1>&6 -echo "configure:11489: checking for $dbfunc in -ldb" >&5 -ac_lib_var=`echo db'_'$dbfunc | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldb " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - with_database_berkdb=yes need_libdb=yes -else - echo "$ac_t""no" 1>&6 -fi - - -fi - - fi - - if test "$with_database_berkdb" = "yes"; then - { test "$extra_verbose" = "yes" && cat << EOF - Defining DB_H_PATH = "$db_h_path" -EOF -cat >> confdefs.h <> confdefs.h <<\EOF -#define HAVE_BERKELEY_DB 1 -EOF -} - - test "$need_libdb" = "yes" && LIBS="-ldb $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-ldb\" to \$LIBS"; fi - else with_database_berkdb=no - fi -fi - -if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ - != "no no no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DATABASE -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DATABASE 1 -EOF -} - - extra_objs="$extra_objs database.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"database.o\"" - fi -fi - -if test "$with_socks" = "yes"; then - -echo $ac_n "checking for SOCKSinit in -lsocks""... $ac_c" 1>&6 -echo "configure:11569: checking for SOCKSinit in -lsocks" >&5 -ac_lib_var=`echo socks'_'SOCKSinit | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lsocks " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo socks | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - - test -n "$ac_cv_lib_socks_SOCKSinit" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SOCKS -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SOCKS 1 -EOF -} - -fi - -if test "$usage_tracking" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining USAGE_TRACKING -EOF -cat >> confdefs.h <<\EOF -#define USAGE_TRACKING 1 -EOF -} - - LIBS="-Bstatic -lut -Bdynamic $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-Bstatic -lut -Bdynamic\" to \$LIBS"; fi -fi - -for ac_hdr in dlfcn.h -do -ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` -echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:11642: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext < -EOF -ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:11650: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } -ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"` -if test -z "$ac_err"; then - rm -rf conftest* - eval "ac_cv_header_$ac_safe=yes" -else - echo "$ac_err" >&5 - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_header_$ac_safe=no" -fi -rm -f conftest* -if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_hdr -EOF -cat >> confdefs.h <> confdefs.h <<\EOF -#define HAVE_DLFCN_H 1 -EOF -} - -else - echo "$ac_t""no" 1>&6 -fi -done - -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { -echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6 -echo "configure:11689: checking for dlopen in -ldl" >&5 -ac_lib_var=`echo dl'_'dlopen | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldl " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLOPEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLOPEN 1 -EOF -} - DLL_LIB=dl; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { -echo $ac_n "checking for _dlopen in -lc""... $ac_c" 1>&6 -echo "configure:11734: checking for _dlopen in -lc" >&5 -ac_lib_var=`echo c'_'_dlopen | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLOPEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLOPEN 1 -EOF -} - DLL_LIB=; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { -echo $ac_n "checking for dlopen in -lc""... $ac_c" 1>&6 -echo "configure:11779: checking for dlopen in -lc" >&5 -ac_lib_var=`echo c'_'dlopen | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lc " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLOPEN -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLOPEN 1 -EOF -} - DLL_LIB=; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && { -echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6 -echo "configure:11824: checking for shl_load in -ldld" >&5 -ac_lib_var=`echo dld'_'shl_load | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldld " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SHL_LOAD -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SHL_LOAD 1 -EOF -} - DLL_LIB=dld; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -test -z "$with_shlib" && { -echo $ac_n "checking for dld_init in -ldld""... $ac_c" 1>&6 -echo "configure:11869: checking for dld_init in -ldld" >&5 -ac_lib_var=`echo dld'_'dld_init | sed 'y%./+-%__p_%'` - -xe_check_libs=" -ldld " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_DLD_INIT -EOF -cat >> confdefs.h <<\EOF -#define HAVE_DLD_INIT 1 -EOF -} - DLL_LIB=dld; with_shlib=yes -else - echo "$ac_t""no" 1>&6 -fi - - } -if test "$with_shlib" = "yes"; then - -dll_ld= -dll_ldflags= -dll_cflags= -dll_post= -dll_ldo="-o" -ld_dynamic_link_flags= -xehost=$canonical -xealias=$internal_configuration - -echo "checking how to build dynamic libraries for ${xehost}" 1>&6 -echo "configure:11924: checking how to build dynamic libraries for ${xehost}" >&5 -# Transform *-*-linux* to *-*-linux-gnu*, to support old configure scripts. -case "$xehost" in -*-*-linux-gnu*) ;; -*-*-linux*) xehost=`echo $xehost | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'` -esac - -xehost_cpu=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -xehost_vendor=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -xehost_os=`echo $xehost | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` - -case "$xehost_os" in -aix3*) - # AIX sometimes has problems with the GCC collect2 program. For some - # reason, if we set the COLLECT_NAMES environment variable, the problems - # vanish in a puff of smoke. - if test "${COLLECT_NAMES+set}" != set; then - COLLECT_NAMES= - export COLLECT_NAMES - fi - ;; -esac - -# Now see if the compiler is really GCC. -if test "$GCC" = "yes"; then - XEGCC=yes -else - echo $ac_n "checking checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:11952: checking checking whether we are using GNU C" >&5 - cat > conftest.$ac_ext <&5 | - egrep "yes" >/dev/null 2>&1; then - rm -rf conftest* - XEGCC=yes -else - rm -rf conftest* - XEGCC=no -fi -rm -f conftest* - - echo "$ac_t""${XEGCC}" 1>&6 -fi - -echo $ac_n "checking how to produce PIC code""... $ac_c" 1>&6 -echo "configure:11976: checking how to produce PIC code" >&5 -wl= - -can_build_shared=yes -if test "$XEGCC" = yes; then - wl='-Wl,' - - case "$xehost_os" in - aix3* | aix4* | irix5* | irix6* | osf3* | osf4*) - # PIC is the default for these OSes. - ;; - - os2*) - # We can build DLLs from non-PIC. - ;; - amigaos*) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the `-m68020' flag to GCC prevents building anything better, - # like `-m68040'. - dll_cflags='-m68020 -resident32 -malways-restore-a4' - ;; - *) - dll_cflags='-fPIC' - ;; - esac -else - # PORTME Check for PIC flags for the system compiler. - case "$xehost_os" in - hpux9* | hpux10*) - # Is there a better link_static_flag that works with the bundled CC? - wl='-Wl,' - dll_cflags='+Z' - ;; - - irix5* | irix6*) - wl='-Wl,' - # PIC (with -KPIC) is the default. - ;; - - os2*) - # We can build DLLs from non-PIC. - ;; - - osf3* | osf4*) - # All OSF/1 code is PIC. - wl='-Wl,' - ;; - - sco3.2v5*) - dll_cflags='-belf -Kpic' - wl='-Wl,' - ;; - - unixware*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - sysv4*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - sysv5*) - dll_cflags="-KPIC" - wl="-Wl," - ;; - - solaris2*) - dll_cflags='-KPIC' - wl='-Wl,' - ;; - - sunos4*) - dll_cflags='-PIC' - wl='-Qoption ld ' - ;; - - uts4*) - dll_cflags='-pic' - ;; - - *) - can_build_shared=no - ;; - esac -fi - -if test -n "$dll_cflags"; then - echo "$ac_t""${dll_cflags}" 1>&6 - - # Check to make sure the dll_cflags actually works. - echo $ac_n "checking if PIC flag ${dll_cflags} really works""... $ac_c" 1>&6 -echo "configure:12069: checking if PIC flag ${dll_cflags} really works" >&5 - save_CFLAGS="$CFLAGS" - CFLAGS="$CFLAGS $dll_cflags -DPIC" - cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then - rm -rf conftest* - - # On HP-UX, the stripped-down bundled CC doesn't accept +Z, but also - # reports no error. So, we need to grep stderr for (Bundled). - if grep '(Bundled)' config.log >/dev/null; then - echo "$ac_t""no" 1>&6 - can_build_shared=no - dll_cflags= - else - echo "$ac_t""yes" 1>&6 - fi -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - echo "$ac_t""no" 1>&6 - can_build_shared=no - dll_cflags= -fi -rm -f conftest* - CFLAGS="$save_CFLAGS" -else - echo "$ac_t""none" 1>&6 -fi - -if test "$can_build_shared" = "yes"; then -cc_produces_so=no -xldf= -xcldf= -echo $ac_n "checking if C compiler can produce shared libraries""... $ac_c" 1>&6 -echo "configure:12111: checking if C compiler can produce shared libraries" >&5 -if test "$XEGCC" = yes; then - xcldf="-shared" - xldf="-shared" -else # Not using GCC - case "$xehost_os" in - aix3* | aix4*) - xldf="-bE:ELLSONAME.exp -H512 -T512 -bhalt:4 -bM:SRE -bnoentry -lc" - xcldf="${wl}-bE:ELLSONAME.exp ${wl}-H512 ${wl}-T512 ${wl}-bhalt:4 ${wl}-bM:SRE ${wl}-bnoentry ${wl}-lc" - ;; - - freebsd2* | netbsd* | openbsd*) - xldf="-Bshareable" - xcldf="${wl}-Bshareable" - ;; - - freebsd3*) - xcldf="-shared" - ;; - - hpux*) - xldf="-b +s" - xcldf="${wl}-b ${wl}+s" - ;; - - irix5* | irix6* | osf3* | osf4*) - xcldf="${wl}-shared" - xldf="-shared" - ;; - - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7* | uts4*) - xcldf="-G" - xldf="-G" - ;; - - sunos4*) - xcldf="${wl}-assert ${wl}pure-text ${wl}-Bstatic" - xldf="-assert pure-text -Bstatic" - ;; - esac -fi # End if if we are using gcc - -if test -n "$xcldf"; then - save_LDFLAGS=$LDFLAGS - save_LIBS=$LIBS - save_xe_libs=$xe_libs - LDFLAGS="$xcldf $LDFLAGS" - LIBS= - xe_libs= - ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' - cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - cc_produces_so=yes -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - cc_produces_so=no -fi -rm -f conftest* - LDFLAGS=$save_LDFLAGS - LIBS=$save_LIBS - xe_libs=$save_xe_libs - ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&5' -else - cc_produces_so=no -fi -echo "$ac_t""${cc_produces_so}" 1>&6 - -LTLD=$LD -if test -z "$LTLD"; then - ac_prog=ld - if test "$XEGCC" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - echo $ac_n "checking for ld used by GCC""... $ac_c" 1>&6 -echo "configure:12194: checking for ld used by GCC" >&5 - ac_prog=`($CC -print-prog-name=ld) 2>&5` - case "$ac_prog" in - # Accept absolute paths. - /*) - if test -z "$LTLD"; then - case "$ac_prog" in - *gcc-lib*) LTLD="$CC" - ;; - *) LTLD="$ac_prog" - ;; - esac - fi - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac - else - echo $ac_n "checking for GNU ld""... $ac_c" 1>&6 -echo "configure:12219: checking for GNU ld" >&5 - fi - - if test -z "$LTLD"; then - IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:" - for ac_dir in $PATH; do - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog"; then - LTLD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some GNU ld's only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - if "$LTLD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then - xe_gnu_ld=yes - else - xe_gnu_ld=no - fi - fi - done - IFS="$ac_save_ifs" - fi - - if test -n "$LTLD"; then - echo "$ac_t""${LTLD}" 1>&6 - else - echo "$ac_t""no" 1>&6 - fi - - if test -z "$LTLD" -a "$cc_produces_so" = no; then - { echo "configure: error: no acceptable linker found in \$PATH" 1>&2; exit 1; } - exit 1 - fi -fi - -ld_dynamic_link_flags= - -# Check to see if it really is or isn't GNU ld. -echo $ac_n "checking if the linker is GNU ld""... $ac_c" 1>&6 -echo "configure:12257: checking if the linker is GNU ld" >&5 -# I'd rather use --version here, but apparently some GNU ld's only accept -v. -if $LTLD -v 2>&1 &5; then - xe_gnu_ld=yes -else - xe_gnu_ld=no -fi -echo "$ac_t""${xe_gnu_ld}" 1>&6 - -case "$xehost_os" in - amigaos* | sunos4*) - # On these operating systems, we should treat GNU ld like the system ld. - gnu_ld_acts_native=yes - ;; - *) - gnu_ld_acts_native=no - ;; -esac - -if test "$cc_produces_so" = "yes"; then - dll_ld=$CC - dll_ldflags=$xcldf - can_build_shared=yes -else - # OK - only NOW do we futz about with ld. - # See if the linker supports building shared libraries. - echo $ac_n "checking whether the linker supports shared libraries""... $ac_c" 1>&6 -echo "configure:12284: checking whether the linker supports shared libraries" >&5 - dll_ld=$CC - dll_ldflags=$LDFLAGS - ld_shlibs=yes - can_build_shared=yes - if test "$xe_gnu_ld" = yes && test "$gnu_ld_acts_native" != yes; then - # See if GNU ld supports shared libraries. - if $LTLD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then - dll_ld=$CC - dll_ldflags="-shared" - ld_shlibs=yes - else - ld_shlibs=no - fi - else - # PORTME fill in a description of your system's linker (not GNU ld) - case "$xehost_os" in - aix3*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - aix4*) - dll_ldflags=$xcldf - ;; - - # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor - # support. Future versions do this automatically, but an explicit c++rt0.o - # doesn't break anything, and helps significantly (at the cost of a little - # extra space). - freebsd2.2*) - dll_ld=$LTLD - dll_ldflags=$xldf - dll_post="/usr/lib/c++rt0.o" - ;; - - # Unfortunately, older versions of FreeBSD 2 don't have this feature. - freebsd2*) - dll_ld=$LTLD - dll_ldflags="-Bshareable" - ;; - - # FreeBSD 3, at last, uses gcc -shared to do shared libraries. - freebsd3*) - dll_ldflags="-shared" - ;; - - hpux*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - irix5* | irix6*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - netbsd*) - # Tested with NetBSD 1.2 ld - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - openbsd*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - osf3* | osf4*) - dll_ld=$LTLD - dll_ldflags=$xldf - ;; - - # For both SCO and Solaris we MAY want to have LDFLAGS include -z text - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) - dll_ld=$LTLD - case "$dll_ld" in - *gcc*) dll_ldflags="-shared" - dll_ld=$CC - ;; - *) dll_ldflags="-G" - ;; - esac - ;; - - sunos4*) - if test "$XEGCC" = yes; then - dll_ld=$CC - else - dll_ld=$LTLD - fi - dll_ldflags=$xldf - ;; - - uts4*) - dll_ld=$LTLD - dll_ldflags="-G" - ;; - - bsdi*) - dll_ldflags="-r" - dll_ld="shlicc2" - ;; - - *) - ld_shlibs=no - can_build_shared=no - ;; - esac - fi - echo "$ac_t""${ld_shlibs}" 1>&6 - if test "$ld_shlibs" = "no"; then - can_build_shared=no - fi -fi # End of if cc_produces_so = no - - -if test "$xe_gnu_ld" = yes; then - if test "$ld_shlibs" = yes; then - ld_dynamic_link_flags="${wl}-export-dynamic" - fi -fi - -if test -z "$ld_dynamic_link_flags"; then - case "$xehost_os" in - aix3*) - ld_dynamic_link_flags= - ;; - - aix4*) - ld_dynamic_link_flags= - ;; - - freebsd2.2*) - ld_dynamic_link_flags= - ;; - - freebsd2*) - ld_dynamic_link_flags= - ;; - - freebsd3*) - ld_dynamic_link_flags= - ;; - - hpux*) - ld_dynamic_link_flags="${wl}-E" - ;; - - irix5* | irix6*) - ld_dynamic_link_flags= - ;; - - netbsd*) - ld_dynamic_link_flags= - ;; - - openbsd*) - ld_dynamic_link_flags= - ;; - - osf3* | osf4*) - ld_dynamic_link_flags= - ;; - - sco3.2v5* | unixware* | sysv5* | sysv4* | solaris2* | solaris7*) - ld_dynamic_link_flags="${wl}-Bexport" - ;; - - sunos4*) - ld_dynamic_link_flags= - ;; - - uts4*) - ld_dynamic_link_flags= - ;; - - bsdi*) - ld_dynamic_link_flags= - ;; - - esac -fi # End of if -z ld_dynamic_link_flags -fi # End of if test "$can_build_shared" = "yes" - - - - - - - - - if test "$can_build_shared" = "yes"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_SHLIB -EOF -cat >> confdefs.h <<\EOF -#define HAVE_SHLIB 1 -EOF -} - - extra_objs="$extra_objs sysdll.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"sysdll.o\"" - fi - extra_objs="$extra_objs emodules.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"emodules.o\"" - fi - INSTALL_ARCH_DEP_SUBDIR="$INSTALL_ARCH_DEP_SUBDIR src" && if test "$extra_verbose" = "yes"; then echo " Appending \"src\" to \$INSTALL_ARCH_DEP_SUBDIR"; fi - test ! -z "$DLL_LIB" && LIBS="-l${DLL_LIB} $LIBS" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-l${DLL_LIB}\" to \$LIBS"; fi - for ac_func in dlerror _dlerror -do -echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:12496: checking for $ac_func" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char $ac_func(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_$ac_func) || defined (__stub___$ac_func) -choke me -#else -$ac_func(); -#endif - -; return 0; } -EOF -if { (eval echo configure:12522: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then - rm -rf conftest* - eval "ac_cv_func_$ac_func=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_$ac_func=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then - echo "$ac_t""yes" 1>&6 - ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_func -EOF -cat >> confdefs.h <&6 -fi -done - - else - echo "configure: warning: disabling shared library support" 1>&2 - with_shlib=no - fi -fi - -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit $?) 2>&5 -then - : -else - conftest_rc="$?" - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -fr conftest* - - echo "" - echo "*** PANIC *** The C compiler can no longer build working executables." - echo "*** PANIC *** Please examine the tail of config.log for runtime errors." - echo "*** PANIC *** The most likely reason for this problem is that configure" - echo "*** PANIC *** links with shared libraries, but those libraries cannot be" - echo "*** PANIC *** found at run time." - echo "*** PANIC ***" - echo "*** PANIC *** On a Linux system, edit /etc/ld.so.conf and re-run ldconfig." - echo "*** PANIC *** On other systems, try telling configure where to find the" - echo "*** PANIC *** shared libraries using the --site-runtime-libraries option" - echo "*** PANIC ***" - echo "*** PANIC *** Another way to shoot yourself in the foot is to specify" - echo "*** PANIC *** --with-FEATURE when FEATURE is not actually installed" - echo "*** PANIC *** on your system. Don't do that." - exit 1 -fi -rm -fr conftest* - - -{ test "$extra_verbose" = "yes" && cat << \EOF - Defining HAVE_UNIX_PROCESSES -EOF -cat >> confdefs.h <<\EOF -#define HAVE_UNIX_PROCESSES 1 -EOF -} - -extra_objs="$extra_objs process-unix.o" && if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"process-unix.o\"" - fi - - - -T="" -for W in $CFLAGS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -CFLAGS="$T" - - -T="" -for W in $extra_objs; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -extra_objs="$T" - - -T="" -for W in -DHAVE_CONFIG_H $c_switch_site $c_switch_machine $c_switch_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -c_switch_general="$T" - - -T="" -for W in $c_switch_x_site $X_CFLAGS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -c_switch_window_system="$T" - - -T="" -for W in $c_switch_general $c_switch_window_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -c_switch_all="$T" - - -T="" -for W in $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_run; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_switch_general="$T" - - -T="" -for W in $ld_switch_x_site; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_switch_window_system="$T" - - -T="" -for W in $ld_switch_general $ld_switch_window_system; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_switch_all="$T" - - -T="" -for W in $LIBS $libs_machine $libs_system $libs_standard; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_libs_general="$T" - - -T="" -for W in $X_EXTRA_LIBS $libs_x $X_PRE_LIBS; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_libs_window_system="$T" - - -T="" -for W in $ld_libs_window_system $ld_libs_general; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ld_libs_all="$T" - - - -MAKE_SUBDIR="$MAKE_SUBDIR src" && if test "$extra_verbose" = "yes"; then echo " Appending \"src\" to \$MAKE_SUBDIR"; fi -internal_makefile_list="Makefile.in" -SUBDIR_MAKEFILES='' -test -d lock || mkdir lock -for dir in $MAKE_SUBDIR; do - case "$dir" in */* ) ( for d in `echo $dir | sed 's:/: :g'` ; do - test -d "$d" || mkdir "$d"; cd "$d" - done ) ;; - * ) test -d "$dir" || mkdir "$dir" ;; - esac - -T="" -for W in $SUBDIR_MAKEFILES $dir/Makefile $dir/GNUmakefile; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -SUBDIR_MAKEFILES="$T" - - -T="" -for W in $internal_makefile_list $dir/Makefile.in; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -internal_makefile_list="$T" - -done - - - - -for dir in src/s src/m; do - if test ! -d "$dir" ; then - echo Making symbolic link to "$srcdir/$dir" - ${LN_S} "$srcdir/$dir" "$dir" - fi -done - -if test "$extra_verbose" = "yes"; then - echo "" - for var in extra_objs c_switch_general c_switch_window_system c_switch_all ld_switch_general ld_switch_window_system ld_switch_all ld_libs_general ld_libs_window_system ld_libs_all; do eval "echo \"$var = '\$$var'\""; done - echo "" -fi - -if test -f $srcdir/src/gdbinit -a ! -f src/gdbinit ; then - echo "creating src/gdbinit"; echo "" - echo "source $srcdir/src/gdbinit" > src/gdbinit -fi - -if test "$__SUNPRO_C" = "yes"; then - echo "creating .sbinit"; echo "" - ( echo "# For use with Sun WorkShop's Source browser." - echo "# See sbquery(1) and sbinit(4) for more information" - for dir in $MAKE_SUBDIR; do echo "import $dir"; done - ) > .sbinit -fi - -rm -f core - - - - - - - - - - - - - - - - -PREFIX=$prefix -while true; do - case "$PREFIX" in - *\$* ) eval "PREFIX=$PREFIX" ;; - *) break ;; - esac -done - - - -EXEC_PREFIX=$exec_prefix -while true; do - case "$EXEC_PREFIX" in - *\$* ) eval "EXEC_PREFIX=$EXEC_PREFIX" ;; - *) break ;; - esac -done - - - - -INFODIR=$infodir -while true; do - case "$INFODIR" in - *\$* ) eval "INFODIR=$INFODIR" ;; - *) break ;; - esac -done - - - - -INFOPATH=$infopath -while true; do - case "$INFOPATH" in - *\$* ) eval "INFOPATH=$INFOPATH" ;; - *) break ;; - esac -done - - - - -PACKAGE_PATH=$package_path -while true; do - case "$PACKAGE_PATH" in - *\$* ) eval "PACKAGE_PATH=$PACKAGE_PATH" ;; - *) break ;; - esac -done - - - - -LISPDIR=$lispdir -while true; do - case "$LISPDIR" in - *\$* ) eval "LISPDIR=$LISPDIR" ;; - *) break ;; - esac -done - - - - -MODULEDIR=$moduledir -while true; do - case "$MODULEDIR" in - *\$* ) eval "MODULEDIR=$MODULEDIR" ;; - *) break ;; - esac -done - - - - -SITELISPDIR=$sitelispdir -while true; do - case "$SITELISPDIR" in - *\$* ) eval "SITELISPDIR=$SITELISPDIR" ;; - *) break ;; - esac -done - - - - -SITEMODULEDIR=$sitemoduledir -while true; do - case "$SITEMODULEDIR" in - *\$* ) eval "SITEMODULEDIR=$SITEMODULEDIR" ;; - *) break ;; - esac -done - - - - -ETCDIR=$etcdir -while true; do - case "$ETCDIR" in - *\$* ) eval "ETCDIR=$ETCDIR" ;; - *) break ;; - esac -done - - - - -LOCKDIR=$lockdir -while true; do - case "$LOCKDIR" in - *\$* ) eval "LOCKDIR=$LOCKDIR" ;; - *) break ;; - esac -done - - - - -ARCHLIBDIR=$archlibdir -while true; do - case "$ARCHLIBDIR" in - *\$* ) eval "ARCHLIBDIR=$ARCHLIBDIR" ;; - *) break ;; - esac -done - - - - - - - - - - - - - - - - - - - - -RECURSIVE_MAKE="\$(MAKE) \$(MFLAGS) CC='\$(CC)' CFLAGS='\$(CFLAGS)' LDFLAGS='\$(LDFLAGS)' CPPFLAGS='\$(CPPFLAGS)'" - - - - - - - -: ${XEMACS_CC:=$CC} - - - -if test "$with_site_lisp" = "no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining INHIBIT_SITE_LISP -EOF -cat >> confdefs.h <<\EOF -#define INHIBIT_SITE_LISP 1 -EOF -} - -fi -if test "$with_site_modules" = "no"; then - { test "$extra_verbose" = "yes" && cat << \EOF - Defining INHIBIT_SITE_MODULES -EOF -cat >> confdefs.h <<\EOF -#define INHIBIT_SITE_MODULES 1 -EOF -} - -fi - - -T="" -for W in $ac_configure_args; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -ac_configure_args="$T" - -{ test "$extra_verbose" = "yes" && cat << EOF - Defining EMACS_CONFIGURATION = "$canonical" -EOF -cat >> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <> confdefs.h <<\EOF -#define GNU_MALLOC 1 -EOF -} - -elif test "$with_system_malloc" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_SYSTEM_MALLOC -EOF -cat >> confdefs.h <<\EOF -#define USE_SYSTEM_MALLOC 1 -EOF -} - -elif test "$with_debug_malloc" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_DEBUG_MALLOC -EOF -cat >> confdefs.h <<\EOF -#define USE_DEBUG_MALLOC 1 -EOF -} - - { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_SYSTEM_MALLOC -EOF -cat >> confdefs.h <<\EOF -#define USE_SYSTEM_MALLOC 1 -EOF -} - -fi -test "$with_i18n3" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining I18N3 -EOF -cat >> confdefs.h <<\EOF -#define I18N3 1 -EOF -} - -test "$GCC" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_GCC -EOF -cat >> confdefs.h <<\EOF -#define USE_GCC 1 -EOF -} - -test "$external_widget" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining EXTERNAL_WIDGET -EOF -cat >> confdefs.h <<\EOF -#define EXTERNAL_WIDGET 1 -EOF -} - -test "$no_doc_file" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining NO_DOC_FILE -EOF -cat >> confdefs.h <<\EOF -#define NO_DOC_FILE 1 -EOF -} - -test "$with_purify" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining PURIFY -EOF -cat >> confdefs.h <<\EOF -#define PURIFY 1 -EOF -} - -test "$with_quantify" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining QUANTIFY -EOF -cat >> confdefs.h <<\EOF -#define QUANTIFY 1 -EOF -} - -test "$with_pop" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining MAIL_USE_POP -EOF -cat >> confdefs.h <<\EOF -#define MAIL_USE_POP 1 -EOF -} - -test "$with_kerberos" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining KERBEROS -EOF -cat >> confdefs.h <<\EOF -#define KERBEROS 1 -EOF -} - -test "$with_hesiod" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining HESIOD -EOF -cat >> confdefs.h <<\EOF -#define HESIOD 1 -EOF -} - -test "$use_union_type" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF - Defining USE_UNION_TYPE -EOF -cat >> confdefs.h <<\EOF -#define USE_UNION_TYPE 1 -EOF -} - - - -( -if test -f /etc/osversion; then echo "osversion: `cat /etc/osversion`" -else - echo "uname -a: `uname -a`" -fi -echo "" -echo "$0 $quoted_arguments" -) > Installation - -xemacs_betaname="" -test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}" - -( -echo " - -XEmacs ${emacs_major_version}.${emacs_minor_version}${xemacs_betaname} \"$xemacs_codename\" configured for \`$canonical'. - - Where should the build process find the source code? $srcdir - What installation prefix should install use? $prefix - What operating system and machine description files should XEmacs use? - \`$opsysfile' and \`$machfile' - What compiler should XEmacs be built with? $CC $CFLAGS - Should XEmacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} - Should XEmacs use the relocating allocator for buffers? $rel_alloc - What window system should XEmacs use? ${window_system}" -if test "$with_x11" = "yes"; then - echo " Where do we find X Windows header files? $x_includes" - echo " Where do we find X Windows libraries? $x_libraries" -fi -if test -n "$site_includes"; then - echo " Additional header files: $site_includes" -fi -if test -n "$site_libraries"; then - echo " Additional libraries: $site_libraries" -fi -if test -n "$site_prefixes"; then - echo " Additional prefixes: $site_prefixes" -fi -if test -n "$runpath"; then - echo " Runtime library search path: $runpath" -fi -test "$with_dnet" = yes && echo " Compiling in support for DNET." -test "$with_socks" = yes && echo " Compiling in support for SOCKS." -test "$with_xauth" = yes && echo " Compiling in support for XAUTH." -if test "$with_xmu" != yes -a "$with_x11" = yes; then - echo " No Xmu; substituting equivalent routines." -fi - -if test "$with_xpm" = yes; then - echo " Compiling in support for XPM images." -elif test "$with_x11" = yes; then - echo " --------------------------------------------------------------------" - echo " WARNING: Compiling without XPM support." - if test "$xpm_problem" != ""; then - echo " Reason: $xpm_problem" - fi - echo " WARNING: You should strongly consider installing XPM." - echo " WARNING: Otherwise toolbars and other graphics will look suboptimal." - echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" - echo " --------------------------------------------------------------------" -fi -if test "$with_png" = yes; then - echo " Compiling in support for PNG image handling." -elif test "$window_system" != "none"; then - echo " --------------------------------------------------------------------" - echo " WARNING: Compiling without PNG image support." - if test "$png_problem" != ""; then - echo " Reason: $png_problem" - fi - echo " WARNING: You should strongly consider installing the PNG libraries." - echo " WARNING: Otherwise certain images and glyphs may not display." - echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" - echo " --------------------------------------------------------------------" -fi -test "$with_gif" = yes && echo " Compiling in support for (builtin) GIF image handling." -test "$with_jpeg" = yes && echo " Compiling in support for JPEG image handling." -test "$with_tiff" = yes && echo " Compiling in support for TIFF image handling." -test "$with_xface" = yes && echo " Compiling in support for X-Face message headers." -case "$with_sound" in - nas ) echo " Compiling in network sound (NAS) support." ;; - native ) echo " Compiling in native sound support." ;; - both ) echo " Compiling in both network and native sound support." ;; -esac -test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." - -test "$with_database_berkdb" = yes && echo " Compiling in support for Berkeley DB." -test "$with_database_dbm" = yes && echo " Compiling in support for DBM." -test "$with_database_gnudbm" = yes && echo " Compiling in support for GNU DBM." - -test "$with_umich_ldap" = yes && echo " Compiling in support for LDAP (UMich libs)." -test "$with_ns_ldap" = yes && echo " Compiling in support for LDAP (Netscape SDK)." -test "$with_ldap" = yes -a "$with_umich_ldap" = no -a "$with_ns_ldap" = no && echo " Compiling in support for LDAP (Generic)." - -test "$with_ncurses" = yes && echo " Compiling in support for ncurses." -test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)." - -test "$with_mule" = yes && echo " Compiling in Mule (multi-lingual) support." -test "$with_file_coding" = yes && echo " Compiling in File coding support." -test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support." -test "$with_xim" = motif && echo " Using Motif to provide XIM support." -test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support." -test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar." -test "$with_canna" = yes && echo " Compiling in support for Canna on Mule." -if test "$with_wnn" = yes; then - echo " Compiling in support for the WNN input method on Mule." - test "$with_wnn6" = yes && echo " Using WNN version 6." -fi -test "$with_i18n3" = yes && echo " Compiling in I18N support, level 3 (doesn't currently work)." - -test "$with_cde" = yes && echo " Compiling in support for CDE." -test "$with_tooltalk" = yes && echo " Compiling in support for ToolTalk." -test "$with_offix" = yes && echo " Compiling in support for OffiX." -test "$with_dragndrop" = yes && echo " Compiling in EXPERIMENTAL support for Drag'n'Drop ($dragndrop_proto )." -test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." -test "$with_session" != no && echo " Compiling in support for proper session-management." -case "$with_menubars" in - lucid ) echo " Using Lucid menubars." ;; - motif ) echo " Using Motif menubars." - echo " *WARNING* The Motif menubar implementation is currently buggy." - echo " We recommend using the Lucid menubar instead." - echo " Re-run configure with --with-menubars='lucid'." ;; -esac -case "$with_scrollbars" in - lucid ) echo " Using Lucid scrollbars." ;; - motif ) echo " Using Motif scrollbars." ;; - athena ) echo " Using Athena scrollbars." ;; - athena3d ) echo " Using Athena-3d scrollbars." ;; -esac -case "$with_dialogs" in - motif ) - echo " Using Motif dialog boxes." - if test "$unexec" = "unexaix.o" -a `uname -v` = 4 -a `uname -r` -ge 3; then - echo " *WARNING* The Motif dialog boxes cause problems on AIX 4.3 and higher." - echo " We recommend using the Athena dialog boxes instead." - echo " Install libXaw and re-run configure with --with-dialogs='athena'." - echo " Read the PROBLEMS file for more information." - fi - ;; - athena ) echo " Using Athena dialog boxes." ;; - athena3d ) echo " Using Athena-3d dialog boxes." ;; -esac -test "$with_shlib" = "yes" && echo " Compiling in DLL support." -test "$with_clash_detection" = yes && \ - echo " Clash detection will use \"$lockdir\" for locking files." -echo " movemail will use \"$mail_locking\" for locking mail spool files." -test "$with_pop" = yes && echo " Using POP for mail access." -test "$with_kerberos" = yes && echo " Using Kerberos for POP authentication." -test "$with_hesiod" = yes && echo " Using Hesiod to get POP server host." -test "$use_union_type" = yes && echo " Using the union type for Lisp_Objects." -test "$use_minimal_tagbits" = yes && echo " Using Lisp_Objects with minimal tagbits." -test "$use_indexed_lrecord_implementation" = yes && echo " Using indexed lrecord implementation." -test "$debug" = yes && echo " Compiling in extra code for debugging." -test "$memory_usage_stats" = yes && echo " Compiling in code for checking XEmacs memory usage." -test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." -if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc" \ - != "no no no no no"; then - echo " WARNING: ---------------------------------------------------------" - echo " WARNING: Compiling in support for runtime error checking." - echo " WARNING: XEmacs will run noticeably more slowly as a result." - echo " WARNING: Error checking is on by default for XEmacs beta releases." - echo " WARNING: ---------------------------------------------------------" -fi -echo "" -) | tee -a Installation -echo "" - -echo '(setq Installation-string "' > Installation.el -sed 's/"/\\"/g' Installation >> Installation.el -echo '")' >> Installation.el - - -# Remove any trailing slashes in these variables. -test -n "$prefix" && - prefix=`echo '' "$prefix" | sed -e 's:^ ::' -e 's,\([^/]\)/*$,\1,'` -test -n "$exec_prefix" && - exec_prefix=`echo '' "$exec_prefix" | sed -e 's:^ ::' -e 's,\([^/]\)/*$,\1,'` - - -for file in $internal_makefile_list; do - test "$file" = src/Makefile.in && \ - file="src/Makefile.in:src/Makefile.in.in:src/depend" - ac_output_files="${ac_output_files+$ac_output_files }$file" -done -ac_output_files="$ac_output_files src/paths.h lib-src/config.values" -if test "$with_shlib" = "yes"; then - ac_output_files="$ac_output_files lib-src/ellcc.h" -fi - -trap '' 1 2 15 - -trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 - -test "x$prefix" = xNONE && prefix=$ac_default_prefix -# Let make expand exec_prefix. -test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' - -# Any assignment to VPATH causes Sun make to only execute -# the first set of double-colon rules, so remove it if not needed. -# If there is a colon in the path, we need to keep it. -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' -fi - -trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 - -DEFS=-DHAVE_CONFIG_H - -# Without the "./", some shells look in PATH for config.status. -: ${CONFIG_STATUS=./config.status} - -echo creating $CONFIG_STATUS -rm -f $CONFIG_STATUS -cat > $CONFIG_STATUS </dev/null | sed 1q`: -# -# $0 $ac_configure_args -# -# Compiler output produced by configure, useful for debugging -# configure, is in ./config.log if it exists. - -ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" -for ac_option -do - case "\$ac_option" in - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" - exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; - -version | --version | --versio | --versi | --vers | --ver | --ve | --v) - echo "$CONFIG_STATUS generated by autoconf version 2.13" - exit 0 ;; - -help | --help | --hel | --he | --h) - echo "\$ac_cs_usage"; exit 0 ;; - *) echo "\$ac_cs_usage"; exit 1 ;; - esac -done - -ac_given_srcdir=$srcdir -ac_given_INSTALL="$INSTALL" - -trap 'rm -fr `echo "$ac_output_files src/config.h lwlib/config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 -EOF -cat >> $CONFIG_STATUS < conftest.subs <<\\CEOF -$ac_vpsub -$extrasub -s%@SHELL@%$SHELL%g -s%@CFLAGS@%$CFLAGS%g -s%@CPPFLAGS@%$CPPFLAGS%g -s%@CXXFLAGS@%$CXXFLAGS%g -s%@FFLAGS@%$FFLAGS%g -s%@DEFS@%$DEFS%g -s%@LDFLAGS@%$LDFLAGS%g -s%@LIBS@%$LIBS%g -s%@exec_prefix@%$exec_prefix%g -s%@prefix@%$prefix%g -s%@program_transform_name@%$program_transform_name%g -s%@bindir@%$bindir%g -s%@sbindir@%$sbindir%g -s%@libexecdir@%$libexecdir%g -s%@datadir@%$datadir%g -s%@sysconfdir@%$sysconfdir%g -s%@sharedstatedir@%$sharedstatedir%g -s%@localstatedir@%$localstatedir%g -s%@libdir@%$libdir%g -s%@includedir@%$includedir%g -s%@oldincludedir@%$oldincludedir%g -s%@infodir@%$infodir%g -s%@mandir@%$mandir%g -s%@LN_S@%$LN_S%g -s%@blddir@%$blddir%g -s%@CC@%$CC%g -s%@CPP@%$CPP%g -s%@start_flags@%$start_flags%g -s%@ld_switch_shared@%$ld_switch_shared%g -s%@start_files@%$start_files%g -s%@ld@%$ld%g -s%@lib_gcc@%$lib_gcc%g -s%@RANLIB@%$RANLIB%g -s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g -s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g -s%@INSTALL_DATA@%$INSTALL_DATA%g -s%@YACC@%$YACC%g -s%@SET_MAKE@%$SET_MAKE%g -s%@X_CFLAGS@%$X_CFLAGS%g -s%@X_PRE_LIBS@%$X_PRE_LIBS%g -s%@X_LIBS@%$X_LIBS%g -s%@X_EXTRA_LIBS@%$X_EXTRA_LIBS%g -s%@install_pp@%$install_pp%g -s%@libs_xauth@%$libs_xauth%g -s%@dnd_objs@%$dnd_objs%g -s%@lwlib_objs@%$lwlib_objs%g -s%@ALLOCA@%$ALLOCA%g -s%@dll_ld@%$dll_ld%g -s%@dll_cflags@%$dll_cflags%g -s%@dll_ldflags@%$dll_ldflags%g -s%@dll_post@%$dll_post%g -s%@dll_ldo@%$dll_ldo%g -s%@ld_dynamic_link_flags@%$ld_dynamic_link_flags%g -s%@SRC_SUBDIR_DEPS@%$SRC_SUBDIR_DEPS%g -s%@INSTALL_ARCH_DEP_SUBDIR@%$INSTALL_ARCH_DEP_SUBDIR%g -s%@MAKE_SUBDIR@%$MAKE_SUBDIR%g -s%@SUBDIR_MAKEFILES@%$SUBDIR_MAKEFILES%g -s%@PROGNAME@%$PROGNAME%g -s%@version@%$version%g -s%@configuration@%$configuration%g -s%@canonical@%$canonical%g -s%@srcdir@%$srcdir%g -s%@pkgdir@%$pkgdir%g -s%@statedir@%$statedir%g -s%@PREFIX@%$PREFIX%g -s%@EXEC_PREFIX@%$EXEC_PREFIX%g -s%@INFODIR_USER_DEFINED@%$INFODIR_USER_DEFINED%g -s%@INFODIR@%$INFODIR%g -s%@infopath@%$infopath%g -s%@INFOPATH_USER_DEFINED@%$INFOPATH_USER_DEFINED%g -s%@INFOPATH@%$INFOPATH%g -s%@package_path@%$package_path%g -s%@PACKAGE_PATH_USER_DEFINED@%$PACKAGE_PATH_USER_DEFINED%g -s%@PACKAGE_PATH@%$PACKAGE_PATH%g -s%@lispdir@%$lispdir%g -s%@LISPDIR_USER_DEFINED@%$LISPDIR_USER_DEFINED%g -s%@LISPDIR@%$LISPDIR%g -s%@moduledir@%$moduledir%g -s%@MODULEDIR_USER_DEFINED@%$MODULEDIR_USER_DEFINED%g -s%@MODULEDIR@%$MODULEDIR%g -s%@sitelispdir@%$sitelispdir%g -s%@SITELISPDIR_USER_DEFINED@%$SITELISPDIR_USER_DEFINED%g -s%@SITELISPDIR@%$SITELISPDIR%g -s%@sitemoduledir@%$sitemoduledir%g -s%@SITEMODULEDIR_USER_DEFINED@%$SITEMODULEDIR_USER_DEFINED%g -s%@SITEMODULEDIR@%$SITEMODULEDIR%g -s%@etcdir@%$etcdir%g -s%@ETCDIR_USER_DEFINED@%$ETCDIR_USER_DEFINED%g -s%@ETCDIR@%$ETCDIR%g -s%@lockdir@%$lockdir%g -s%@LOCKDIR_USER_DEFINED@%$LOCKDIR_USER_DEFINED%g -s%@LOCKDIR@%$LOCKDIR%g -s%@archlibdir@%$archlibdir%g -s%@ARCHLIBDIR_USER_DEFINED@%$ARCHLIBDIR_USER_DEFINED%g -s%@ARCHLIBDIR@%$ARCHLIBDIR%g -s%@docdir@%$docdir%g -s%@bitmapdir@%$bitmapdir%g -s%@extra_objs@%$extra_objs%g -s%@machfile@%$machfile%g -s%@opsysfile@%$opsysfile%g -s%@c_switch_general@%$c_switch_general%g -s%@c_switch_window_system@%$c_switch_window_system%g -s%@c_switch_all@%$c_switch_all%g -s%@ld_switch_general@%$ld_switch_general%g -s%@ld_switch_window_system@%$ld_switch_window_system%g -s%@ld_switch_all@%$ld_switch_all%g -s%@ld_libs_general@%$ld_libs_general%g -s%@ld_libs_window_system@%$ld_libs_window_system%g -s%@ld_libs_all@%$ld_libs_all%g -s%@RECURSIVE_MAKE@%$RECURSIVE_MAKE%g -s%@native_sound_lib@%$native_sound_lib%g -s%@sound_cflags@%$sound_cflags%g -s%@dynodump_arch@%$dynodump_arch%g -s%@XEMACS_CC@%$XEMACS_CC%g -s%@internal_makefile_list@%$internal_makefile_list%g - -CEOF -EOF - -cat >> $CONFIG_STATUS <<\EOF - -# Split the substitutions into bite-sized pieces for seds with -# small command number limits, like on Digital OSF/1 and HP-UX. -ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. -ac_file=1 # Number of current file. -ac_beg=1 # First line for current file. -ac_end=$ac_max_sed_cmds # Line after last line for current file. -ac_more_lines=: -ac_sed_cmds="" -while $ac_more_lines; do - if test $ac_beg -gt 1; then - sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file - else - sed "${ac_end}q" conftest.subs > conftest.s$ac_file - fi - if test ! -s conftest.s$ac_file; then - ac_more_lines=false - rm -f conftest.s$ac_file - else - if test -z "$ac_sed_cmds"; then - ac_sed_cmds="sed -f conftest.s$ac_file" - else - ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" - fi - ac_file=`expr $ac_file + 1` - ac_beg=$ac_end - ac_end=`expr $ac_end + $ac_max_sed_cmds` - fi -done -if test -z "$ac_sed_cmds"; then - ac_sed_cmds=cat -fi -EOF - -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF -for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; - esac - - # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. - - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" - # A "../" for each directory in $ac_dir_suffix. - ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` - else - ac_dir_suffix= ac_dots= - fi - - case "$ac_given_srcdir" in - .) srcdir=. - if test -z "$ac_dots"; then top_srcdir=. - else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; - /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; - *) # Relative path. - srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" - top_srcdir="$ac_dots$ac_given_srcdir" ;; - esac - - case "$ac_given_INSTALL" in - [/$]*) INSTALL="$ac_given_INSTALL" ;; - *) INSTALL="$ac_dots$ac_given_INSTALL" ;; - esac - - echo creating "$ac_file" - rm -f "$ac_file" - configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." - case "$ac_file" in - *Makefile*) ac_comsub="1i\\ -# $configure_input" ;; - *) ac_comsub= ;; - esac - - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - sed -e "$ac_comsub -s%@configure_input@%$configure_input%g -s%@srcdir@%$srcdir%g -s%@top_srcdir@%$top_srcdir%g -s%@INSTALL@%$INSTALL%g -" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file -fi; done -rm -f conftest.s* - -# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where -# NAME is the cpp macro being defined and VALUE is the value it is being given. -# -# ac_d sets the value in "#define NAME VALUE" lines. -ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)' -ac_dB='\([ ][ ]*\)[^ ]*%\1#\2' -ac_dC='\3' -ac_dD='%g' -# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE". -ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -ac_uB='\([ ]\)%\1#\2define\3' -ac_uC=' ' -ac_uD='\4%g' -# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE". -ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' -ac_eB='$%\1#\2define\3' -ac_eC=' ' -ac_eD='%g' - -if test "${CONFIG_HEADERS+set}" != set; then -EOF -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF -fi -for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then - # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". - case "$ac_file" in - *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` - ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - *) ac_file_in="${ac_file}.in" ;; - esac - - echo creating $ac_file - - rm -f conftest.frag conftest.in conftest.out - ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` - cat $ac_file_inputs > conftest.in - -EOF - -# Transform confdefs.h into a sed script conftest.vals that substitutes -# the proper values into config.h.in to produce config.h. And first: -# Protect against being on the right side of a sed subst in config.status. -# Protect against being in an unquoted here document in config.status. -rm -f conftest.vals -cat > conftest.hdr <<\EOF -s/[\\&%]/\\&/g -s%[\\$`]%\\&%g -s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp -s%ac_d%ac_u%gp -s%ac_u%ac_e%gp -EOF -sed -n -f conftest.hdr confdefs.h > conftest.vals -rm -f conftest.hdr - -# This sed command replaces #undef with comments. This is necessary, for -# example, in the case of _POSIX_SOURCE, which is predefined and required -# on some systems where configure will not decide to define it. -cat >> conftest.vals <<\EOF -s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */% -EOF - -# Break up conftest.vals because some shells have a limit on -# the size of here documents, and old seds have small limits too. - -rm -f conftest.tail -while : -do - ac_lines=`grep -c . conftest.vals` - # grep -c gives empty output for an empty file on some AIX systems. - if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi - # Write a limited-size here document to conftest.frag. - echo ' cat > conftest.frag <> $CONFIG_STATUS - sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS - echo 'CEOF - sed -f conftest.frag conftest.in > conftest.out - rm -f conftest.in - mv conftest.out conftest.in -' >> $CONFIG_STATUS - sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail - rm -f conftest.vals - mv conftest.tail conftest.vals -done -rm -f conftest.vals - -cat >> $CONFIG_STATUS <<\EOF - rm -f conftest.frag conftest.h - echo "/* $ac_file. Generated automatically by configure. */" > conftest.h - cat conftest.in >> conftest.h - rm -f conftest.in - if cmp -s $ac_file conftest.h 2>/dev/null; then - echo "$ac_file is unchanged" - rm -f conftest.h - else - # Remove last slash and all that follows it. Not all systems have dirname. - ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` - if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then - # The file is in a subdirectory. - test ! -d "$ac_dir" && mkdir "$ac_dir" - fi - rm -f $ac_file - mv conftest.h $ac_file - fi -fi; done - -EOF -cat >> $CONFIG_STATUS <> $CONFIG_STATUS <<\EOF -for dir in . $MAKE_SUBDIR; do - ( - cd $dir - rm -f junk.c - < Makefile.in \ - sed -e '/^# Generated/d' \ - -e 's%/\*\*/#.*%%' \ - -e 's/^ *# */#/' \ - -e '/^##/d' \ - -e '/^#/ { -p -d -}' \ - -e '/./ { -s/\([\"]\)/\\\1/g -s/^/"/ -s/$/"/ -}' > junk.c; - - - - echo creating $dir/Makefile -$CPP -I. -I${top_srcdir}/src junk.c \ - | sed -e 's/^\#.*//' \ - -e 's/^[ ][ ]*$//'\ - -e 's/^ / /' \ - | sed -n -e '/^..*$/p' \ - | sed '/^\"/ { - s/\\\([\"]\)/\1/g - s/^[ ]*\"// - s/\"[ ]*$// -}' > Makefile.new - chmod 444 Makefile.new - mv -f Makefile.new Makefile - - echo creating $dir/GNUmakefile -$CPP -I. -I${top_srcdir}/src -DUSE_GNU_MAKE junk.c \ - | sed -e 's/^\#.*//' \ - -e 's/^[ ][ ]*$//'\ - -e 's/^ / /' \ - | sed -n -e '/^..*$/p' \ - | sed '/^\"/ { - s/\\\([\"]\)/\1/g - s/^[ ]*\"// - s/\"[ ]*$// -}' > Makefile.new - chmod 444 Makefile.new - mv -f Makefile.new GNUmakefile - - rm -f junk.c - ) -done - -sed < config.status >> lib-src/config.values \ - -e '/{ac_dA}.*{ac_dB}.*{ac_dC}.*{ac_dD}$/!d' \ - -e 's/\${ac_dA}\(.*\)\${ac_dB}.*\${ac_dC}\(.*\)\${ac_dD}/\1 \2/' \ - -e 's/^\([^ ]*\) $/\1 ""/' \ - -e 's/ 1$/ t/' - - -exit 0 -EOF -chmod +x $CONFIG_STATUS -rm -fr confdefs* $ac_clean_files -test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 diff --git a/configure.in b/configure.in deleted file mode 100644 index f44e169..0000000 --- a/configure.in +++ /dev/null @@ -1,4237 +0,0 @@ -dnl Define our own header notice with own copyright -define([AC_INIT_NOTICE], -[#### Configuration script for XEmacs. Largely divergent from FSF. -#### Guess values for system-dependent variables and create Makefiles. -#### Generated automatically using autoconf version] AC_ACVERSION [ -#### Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. -#### Copyright (C) 1993-1995 Board of Trustees, University of Illinois. -#### Copyright (C) 1996, 1997 Sun Microsystems, Inc. -#### Copyright (C) 1995, 1996 Ben Wing. -#### Copyright (C) 1998, 1999 J. Kean Johnston. - -### Don't edit this script! -### This script was automatically generated by the `autoconf' program -### from the file `./configure.in'. -### To rebuild it, execute the command -### autoconf -### in the this directory. You must have autoconf version 2.12 or later. - -### 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. - -### For usage, run `./configure --help' -### For more detailed information on building and installing XEmacs, -### read the file `INSTALL'. -### -### If configure succeeds, it leaves its status in config.status. -### A log of configuration tests can be found in config.log. -### If configure fails after disturbing the status quo, -### config.status is removed. -]) - -dnl Since XEmacs has configuration requirements that autoconf cannot -dnl meet, this file is an unholy marriage of custom-baked -dnl configuration code and autoconf macros. - -dnl We use the m4 quoting characters [ ] (as established by the -dnl autoconf system), so quote them like this: [[foo]] - -AC_PREREQ(2.12)dnl -dnl Redefine some standard autoconf macros -dnl here is how XEmacs is different: -dnl - no cache file -dnl - non-standard options -dnl - suport for extra-verbosity -dnl - ordinary libs are handled separately from X libs (might be a mistake) -dnl - various random kludges (e.g. -with-dnet=no - -dnl PRINT_VAR(var var ...) prints values of shell variables -define([PRINT_VAR],[for var in patsubst([$1],[[ -]+],[ ]); do eval "echo \"$var = '\$$var'\""; done]) - -dnl Disable cache files: -dnl This is controversial, but I am convinced this is the right way to go, -dnl at least by default. Otherwise there are too many surprises. -define([AC_CACHE_LOAD], )dnl -define([AC_CACHE_SAVE], )dnl -define([AC_CACHE_VAL], [ -$2 -])dnl - -dnl Redefine AC_TRY_RUN_NATIVE to not throw away stderr while running -dnl AC_TRY_RUN_NATIVE(PROGRAM, [ACTION-IF-TRUE [, ACTION-IF-FALSE]]) -define([AC_TRY_RUN_NATIVE], -[cat > conftest.$ac_ext <&AC_FD_CC -then -dnl Do not remove the temporary files here, so they can be examined. - ifelse([$2], , :, [$2]) -else - conftest_rc="$?" - echo "configure: failed program was:" >&AC_FD_CC - cat conftest.$ac_ext >&AC_FD_CC -ifelse([$3], , , [ rm -fr conftest* - $3 -])dnl -fi -rm -fr conftest*])dnl AC_TRY_RUN_NATIVE - - -dnl Avoid spurious cross-compiling warnings from AC_TRY_RUN -dnl XEmacs is unlikely to ever cross-compile -define([AC_TRY_RUN],[AC_TRY_RUN_NATIVE([$1], [$2], [$3])])dnl - -dnl Redefine AC_DEFINE* to provide more output if extra_verbose -dnl Set VARIABLE to VALUE, verbatim, or 1. -dnl AC_DEFINE(VARIABLE [, VALUE]) -define([AC_DEFINE], -[{ test "$extra_verbose" = "yes" && cat << \EOF - Defining $1[]ifelse($#, 2, [ = $2],) -EOF -cat >> confdefs.h <<\EOF -[#define] $1 ifelse($#, 2, [$2], 1) -EOF -} -])dnl AC_DEFINE - -define([AC_DEFINE_UNQUOTED], -[{ test "$extra_verbose" = "yes" && cat << EOF - Defining $1[]ifelse($#, 2, [ = $2],) -EOF -cat >> confdefs.h <&AC_FD_CC' -ac_link='${CC-cc} -o conftest $CFLAGS '"$xe_cppflags $xe_ldflags"' conftest.$ac_ext '"$xe_libs"' 1>&AC_FD_CC' -cross_compiling=no -]) dnl AC_LANG_C - -dnl The construct foo=`echo $w1 $w2 $w3` fails on some systems if $w1 = -e or -n -dnl So we use the following instead. -dnl XE_SPACE(var, words) -define([XE_SPACE],[ -T="" -for W in $2; do if test -z "$T"; then T="$W"; else T="$T $W"; fi; done -$1="$T" -])dnl XE_SPACE - -dnl XE_ADD_OBJS(foo.o ...) -define([XE_ADD_OBJS], -[extra_objs="$extra_objs [$1]" && dnl - if test "$extra_verbose" = "yes"; then - echo " xemacs will be linked with \"[$1]\"" - fi])dnl XE_ADD_OBJS - -dnl XE_APPEND(value, varname) -define([XE_APPEND], -[[$2]="$[$2] [$1]" && dnl - if test "$extra_verbose" = "yes"; then echo " Appending \"[$1]\" to \$[$2]"; fi]) - -dnl XE_PREPEND(value, varname) -define([XE_PREPEND], -[[$2]="[$1] $[$2]" && dnl - if test "$extra_verbose" = "yes"; then echo " Prepending \"[$1]\" to \$[$2]"; fi]) - -dnl XE_DIE(message) -define([XE_DIE], [{ echo "Error:" $1 >&2; exit 1; }]) - -dnl XE_STRIP_4TH_COMPONENT(var) -dnl Changes i986-pc-linux-gnu to i986-pc-linux, as God (not RMS) intended. -define([XE_STRIP_4TH_COMPONENT], -[$1=`echo "$$1" | sed '[s/^\([^-][^-]*-[^-][^-]*-[^-][^-]*\)-.*$/\1/]'`]) - -dnl Initialize some variables set by options. -dnl The variables have the same names as the options, with -dnl dashes changed to underlines. - -define([AC_INIT_PARSE_ARGS],[ - -dnl Get sane consistent behavior from various shells -dnl Avoid losing with weird user CDPATHs - -if test -n "$ZSH_VERSION"; then - dnl zsh's Bourne shell emulation options - setopt NO_BAD_PATTERN NO_BANG_HIST NO_BG_NICE NO_EQUALS NO_FUNCTION_ARGZERO - setopt GLOB_SUBST NO_HUP INTERACTIVE_COMMENTS KSH_ARRAYS NO_MULTIOS NO_NOMATCH - setopt RM_STAR_SILENT POSIX_BUILTINS SH_FILE_EXPANSION SH_GLOB SH_OPTION_LETTERS - setopt SH_WORD_SPLIT BSD_ECHO IGNORE_BRACES - dnl zsh-3.1-beta drops core on the following - dnl unset CDPATH - if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi -elif test -n "$BASH_VERSION"; then - dnl Use Posix mode with bash - set -o posix - unset CDPATH -else - if test -n "$CDPATH"; then CDPATH="."; export CDPATH; fi -fi - -dnl Initialize some variables set by options. -dnl The variables have the same names as the options, with -dnl dashes changed to underlines. -exec_prefix=NONE -host=NONE -no_create= -nonopt=NONE -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -target=NONE -verbose= -x_includes=NONE -x_libraries=NONE - -dnl Installation directory options. -dnl These are left unexpanded so users can "make install exec_prefix=/foo" -dnl and all the variables that are supposed to be based on exec_prefix -dnl by default will actually change. -dnl Use braces instead of parens because sh, perl, etc. also accept them. -dnl If you change these, you need to synchronize with the settings of the -dnl various ..._USER_DEFINED variables further down. -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/share' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -libdir='${{exec_prefix}}/lib' -includedir='${prefix}/include' -oldincludedir='/usr/include' -infodir='${prefix}/info' -mandir='${prefix}/man' - -dnl Initialize some other variables. -subdirs= -MFLAGS= MAKEFLAGS= -dnl Maximum number of lines to put in a shell here document. -ac_max_here_lines=12 -])dnl AC_INIT_PARSE_ARGS - -AC_INIT(src/lisp.h)dnl -AC_CONFIG_HEADER(src/config.h lwlib/config.h) -dnl Remove any more than one leading "." element from the path name. -dnl If we do not remove them, then another "./" will be prepended to -dnl the file name each time we use config.status, and the program name -dnl will get larger and larger. This would not be a problem, except -dnl that since progname gets recorded in all the Makefiles this script -dnl produces, move-if-change thinks they're different when they're -dnl not. -dnl -dnl It would be nice if we could put the ./ in a \( \) group and then -dnl apply the * operator to that, so we remove as many leading './././'s -dnl as are present, but some seds (like Ultrix's sed) don't allow you to -dnl apply * to a \( \) group. Bleah. -progname="`echo $0 | sed 's:^\./\./:\./:'`" - -dnl ----------------------------- -dnl Establish some default values -dnl ----------------------------- - -XE_APPEND(lib-src, MAKE_SUBDIR) -XE_APPEND(lib-src, INSTALL_ARCH_DEP_SUBDIR) - -prefix='/usr/local' -exec_prefix='${prefix}' -bindir='${exec_prefix}/bin' -dnl FSF 19.29 changes to: -dnl datadir='${prefix}/share' -dnl sharedstatedir='${prefix}/com' -dnl libexecdir='${exec_prefix}/libexec' -datadir='${prefix}/lib' -statedir='${prefix}/lib' -libdir='${exec_prefix}/lib' -mandir='${prefix}/man/man1' -infodir='${datadir}/${PROGNAME}-${version}/info' -infopath='' -install_pp='' -lispdir='${datadir}/${PROGNAME}-${version}/lisp' -moduledir='${datadir}/${PROGNAME}-${version}/${configuration}/modules' -sitelispdir='${datadir}/xemacs/site-lisp' -sitemoduledir='${datadir}/xemacs/site-modules' -pkgdir='${datadir}/${PROGNAME}-${version}/lisp' -package_path='' -etcdir='${datadir}/${PROGNAME}-${version}/etc' -lockdir='${statedir}/${PROGNAME}/lock' -archlibdir='${datadir}/${PROGNAME}-${version}/${configuration}' -with_site_lisp='no' -with_site_modules='yes' -with_menubars='' -with_scrollbars='' -with_dialogs='' -with_file_coding='' -dnl const_is_losing is removed - we rely on AC_C_CONST instead. -dnl We accept (and ignore) the --const-is-losing option for compatibility. -dnl const_is_losing='yes' -puresize='' -cpp='' cppflags='' libs='' ldflags='' -dynamic='' -with_x11='' -with_msw='' -rel_alloc='default' -with_system_malloc='default' -with_dlmalloc='default' -native_sound_lib='' -dnl use_assertions should be 'yes' by default. Too many people in this -dnl world have core dumps turned off by default or \"cannot find where the -dnl core file went\". At least we should get some useful output ... -use_assertions="yes" -dnl the following is set to yes or no later. -with_toolbars="" -with_tty="" -use_union_type="no" -with_dnet="" - -dnl ------------------ -dnl Options Processing -dnl ------------------ - -define([USAGE_ERROR], -[(echo "$progname: Usage error:" -echo " " $1 -echo " Use \`$progname --help' to show usage.") >&2 && exit 1]) - -dnl Record all the arguments, so we can save them in config.status. -arguments="$@" - -dnl Shell Magic: Quote the quoted arguments in ARGUMENTS. At a later date, -dnl in order to get the arguments back in $@, we have to do an -dnl 'eval set x "$quoted_arguments"; shift' -dnl # We use sed to turn embedded ' into '"'"'. I truly hate sh quoting. -quoted_sed_magic=s/"'"/"'"'"'"'"'"'"'"/g -quoted_arguments= -for i in "$@"; do - case "$i" in - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c) ;; - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; - *) - quoted_i="`echo '' $i | sed -e 's:^ ::' -e $quoted_sed_magic`" - quoted_arguments="$quoted_arguments '$quoted_i'" ;; - esac -done - -dnl Do not use shift -- that destroys the argument list, which autoconf needs -dnl to produce config.status. It turns out that "set - $arguments" does not -dnl work portably. -dnl However, it also turns out that many shells cannot expand ${10} at all. -dnl So using an index variable does not work either. It is possible to use -dnl some shell magic to make 'set x "$arguments"; shift' work portably. -while test $# != 0; do - arg="$1"; shift - case "$arg" in - --no-create|--no-recursion) ;; - dnl Anything starting with a hyphen we assume is an option. - -* ) - dnl Separate the switch name from the value it is being given. - case "$arg" in - -*=*) - opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\([[^=]]*\)=.*$:\1:'` - val=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*[[^=]]*=\(.*\)$:\1:'` - valomitted=no - ;; - dnl special case these strings since echo may silently eat them: - dnl --help ) opt=help val=yes valomitted=yes ;; - dnl --version ) opt=version val=yes valomitted=yes ;; - dnl -e ) opt=e val=yes valomitted=yes ;; - dnl -E ) opt=E val=yes valomitted=yes ;; - dnl -n ) opt=n val=yes valomitted=yes ;; - -*) - dnl If FOO is a boolean argument, --FOO is equivalent to - dnl --FOO=yes. Otherwise, the value comes from the next - dnl argument - see below. - opt=`echo '' $arg | sed -e 's:^ ::' -e 's:^-*\(.*\)$:\1:'` - val="yes" valomitted=yes - ;; - esac - - dnl translate "-" in option string to "_" - optname="$opt" - opt="`echo '' $opt | sed -e 's:^ ::' | tr - _`" - - dnl Support --without-FOO as a synonym for --with-FOO=no - case "${valomitted}-${opt}" in yes-without_* ) - opt=`echo $opt | sed 's/without/with/'` - valomitted="no" val="no" ;; - esac - - dnl Process the option. - case "$opt" in - - dnl Process (many) boolean options - with_site_lisp | \ - with_site_modules | \ - with_x | \ - with_x11 | \ - with_msw | \ - with_gcc | \ - dynamic | \ - with_ncurses | \ - with_dnet | \ - with_socks | \ - with_dragndrop | \ - with_cde | \ - with_offix | \ - with_gpm | \ - with_xpm | \ - with_xface | \ - with_gif | \ - with_jpeg | \ - with_png | \ - with_tiff | \ - with_session | \ - with_xmu | \ - with_purify | \ - with_quantify | \ - with_toolbars | \ - with_tty | \ - with_xfs | \ - with_i18n3 | \ - with_mule | \ - with_file_coding| \ - with_canna | \ - with_wnn | \ - with_wnn6 | \ - with_workshop | \ - with_sparcworks | \ - with_tooltalk | \ - with_ldap | \ - with_pop | \ - with_kerberos | \ - with_hesiod | \ - with_dnet | \ - with_infodock | \ - external_widget | \ - verbose | \ - extra_verbose | \ - const_is_losing | \ - usage_tracking | \ - use_union_type | \ - debug | \ - use_assertions | \ - gung_ho | \ - use_minimal_tagbits | \ - use_indexed_lrecord_implementation | \ - memory_usage_stats | \ - with_clash_detection | \ - with_shlib | \ - no_doc_file ) - dnl Make sure the value given was either "yes" or "no". - case "$val" in - y | ye | yes ) val=yes ;; - n | no ) val=no ;; - * ) USAGE_ERROR("The \`--$optname' option requires a boolean value: \`yes' or \`no'.") ;; - esac - eval "$opt=\"$val\"" ;; - - - dnl Options that take a user-supplied value, as in --puresize=8000000 - dnl The cache-file option is ignored (for compatibility with other configures) - srcdir | \ - compiler | \ - cflags | \ - cpp | \ - cppflags | \ - libs | \ - ldflags | \ - puresize | \ - cache_file | \ - native_sound_lib| \ - site_lisp | \ - x_includes | \ - x_libraries | \ - site_includes | \ - site_libraries | \ - site_prefixes | \ - site_runtime_libraries ) - dnl If the value was omitted, get it from the next argument. - if test "$valomitted" = "yes" ; then - dnl Get the next argument from the argument list, if there is one. - if test "$#" = 0 ; then - USAGE_ERROR("The \`--$optname' option requires a value."); - fi - val="$1"; shift - fi - eval "$opt=\"$val\"" - ;; - - dnl Options that take "yes", "no", or "default" values - rel_alloc | \ - with_dlmalloc | \ - with_debug_malloc | use_debug_malloc | \ - with_system_malloc | use_system_malloc ) - case "$val" in - y | ye | yes ) val=yes ;; - n | no ) val=no ;; - d | de | def | defa | defau | defaul | default ) val=default ;; - * ) USAGE_ERROR(["The \`--$optname' option requires one of these values: - \`yes', \`no', or \`default'."]) ;; - esac - case "$opt" in use_* ) opt="`echo $opt | sed s/use/with/`" ;; esac - eval "$opt=\"$val\"" - ;; - - dnl Has the user requested database support? - "with_database" ) - with_database_berkdb=no - with_database_dbm=no - with_database_gnudbm=no - for x in `echo "$val" | sed -e 's/,/ /g'` ; do - case "$x" in - no ) ;; - b | be | ber | berk | berkd | berkdb ) with_database_berkdb=yes ;; - d | db | dbm ) with_database_dbm=yes ;; - g | gn | gnu | gnud | gnudb | gnudbm ) with_database_gnudbm=yes ;; - * ) USAGE_ERROR(["The \`--$optname' option value - must be either \`no' or a comma-separated list - of one or more of \`berkdb' and either \`dbm' or \`gnudbm'."]) ;; - esac - done - if test "$with_database_dbm" = "yes" -a \ - "$with_database_gnudbm" = "yes"; then - USAGE_ERROR("Only one of \`dbm' and \`gnudbm' may be specified - with the \`--$optname' option.") - fi - ;; - - dnl Has the user requested sound support? - "with_sound" ) - dnl value can be native, nas or both. yes is allowed - dnl as a backwards compatible synonym for native - case "$val" in - y | ye | yes ) val=native ;; - n | no | non | none ) val=no;; - na | nat | nati | nativ | native ) val=native ;; - ne | net | neta | netau | netaud | netaudi | netaudio | nas ) val=nas ;; - b | bo | bot | both ) val=both;; - * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`native', \`nas', \`both', or \`none'."]) ;; - esac - eval "$opt=\"$val\"" - ;; - - dnl Has the user requested XIM support? - "with_xim" ) - case "$val" in - y | ye | yes ) val=yes ;; - n | no | non | none ) val=no ;; - x | xl | xli | xlib ) val=xlib ;; - m | mo | mot | moti | motif ) val=motif ;; - * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`motif', \`xlib', \`yes', or \`no'."]) ;; - esac - eval "$opt=\"$val\"" - ;; - - dnl Mail locking specification - "mail_locking" ) - case "$val" in - lockf ) val=lockf ;; - flock ) val=flock ;; - file ) val=file ;; - * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`lockf', \`flock', or \`file'."]) ;; - esac - eval "$opt=\"$val\"" - ;; - - dnl Has the user requested error-checking? - "error_checking" ) - dnl value can be all, none, and/or a list of categories to check. - dnl Example: --error-checking=all,noextents,nobufpos - dnl Example: --error-checking=none,malloc,gc - - for x in `echo "$val" | sed -e 's/,/ /g'` ; do - case "$x" in - dnl all and none are only permitted as the first in the list. - n | no | non | none ) new_default=no ;; - a | al | all ) new_default=yes ;; - - extents ) error_check_extents=yes ;; - noextents ) error_check_extents=no ;; - - typecheck ) error_check_typecheck=yes ;; - notypecheck ) error_check_typecheck=no ;; - - bufpos ) error_check_bufpos=yes ;; - nobufpos ) error_check_bufpos=no ;; - - gc ) error_check_gc=yes ;; - nogc ) error_check_gc=no ;; - - malloc ) error_check_malloc=yes ;; - nomalloc ) error_check_malloc=no ;; - - * ) bogus_error_check=yes ;; - esac - if test "$bogus_error_check" -o \ - \( -n "$new_default" -a -n "$echeck_notfirst" \) ; then - if test "$error_check_default" = yes ; then - types="\`all' (default), \`none', \`noextents', \`notypecheck', \`nobufpos', \`nogc', and \`nomalloc'." - else - types="\`all', \`none' (default), \`extents', \`typecheck', \`bufpos', \`gc', and \`malloc'." - fi - USAGE_ERROR(["Valid types for the \`--$optname' option are: - $types."]) - elif test -n "$new_default" ; then - error_check_extents=$new_default - error_check_typecheck=$new_default - error_check_bufpos=$new_default - error_check_gc=$new_default - error_check_malloc=$new_default - new_default= # reset this - fi - echeck_notfirst=true - done - ;; - - dnl Has the user tried to tell us where the X files are? - dnl I think these are dopey, but no less than three alpha - dnl testers, at large sites, have said they have their X files - dnl installed in odd places. - - dnl Has the user specified one of the path options? - prefix | exec_prefix | bindir | datadir | statedir | libdir | \ - mandir | infodir | infopath | lispdir | etcdir | lockdir | pkgdir | \ - archlibdir | docdir | package_path ) - dnl If the value was omitted, get it from the next argument. - if test "$valomitted" = "yes"; then - if test "$#" = 0; then - USAGE_ERROR("The \`--$optname' option requires a value."); - fi - val="$1"; shift - fi - eval "$opt=\"$val\"" - - dnl You need to synchronize this with the way the - dnl default values are built. - case "$opt" in - lispdir ) AC_DEFINE(LISPDIR_USER_DEFINED) ;; - sitelispdir ) AC_DEFINE(SITELISPDIR_USER_DEFINED) ;; - moduledir ) AC_DEFINE(MODULEDIR_USER_DEFINED) ;; - etcdir ) AC_DEFINE(ETCDIR_USER_DEFINED) ;; - infodir ) AC_DEFINE(INFODIR_USER_DEFINED) ;; - infopath ) AC_DEFINE(INFOPATH_USER_DEFINED) ;; - package_path ) AC_DEFINE(PACKAGE_PATH_USER_DEFINED) ;; - datadir ) - AC_DEFINE(INFODIR_USER_DEFINED) - AC_DEFINE(LISPDIR_USER_DEFINED) - AC_DEFINE(MODULEDIR_USER_DEFINED) - AC_DEFINE(ETCDIR_USER_DEFINED) ;; - statedir | lockdir ) AC_DEFINE(LOCKDIR_USER_DEFINED) ;; - exec_prefix | libdir | archlibdir ) AC_DEFINE(ARCHLIBDIR_USER_DEFINED) ;; - esac - ;; - - dnl --no-create added by autoconf for use by config.status - "no_create" ) ;; - - dnl Has the user asked for some help? - "usage" | "help" ) ${PAGER-more} ${srcdir}/configure.usage; exit 0 ;; - - dnl Has the user specified the toolkit(s) to use for GUI elements? - "with_menubars" | \ - "with_scrollbars" | \ - "with_dialogs" ) - case "$val" in - l | lu | luc | luci | lucid ) val=lucid ;; - m | mo | mot | moti | motif ) val=motif ;; - athena3d | athena-3d ) val=athena3d ;; - a | at | ath | athe | athen | athena ) val=athena ;; - n | no | non | none ) val=no ;; - * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: - \`lucid', \`motif', \`athena', \`athena3d', or \`no'."]) ;; - esac - eval "$opt=\"$val\"" - ;; - - dnl Obsolete legacy argument? Warn, but otherwise ignore. - "run_in_place" | \ - "with_gnu_make" ) - AC_MSG_WARN([Obsolete option \`--$optname' ignored.]) - ;; - - dnl Unrecognized option? No mercy for user errors. - * ) USAGE_ERROR("Unrecognized option: $arg") ;; - - esac - ;; - - dnl Assume anything with multiple hyphens is a configuration name. - *-*-*) configuration="$arg" ;; - - dnl Unrecognized argument? No mercy for user errors. - *) USAGE_ERROR("Unrecognized argument: $arg") ;; - - esac -done - -dnl ------------------------- -dnl Finish options processing -dnl ------------------------- - -dnl Several options are equivalent to, and override, environment variables. -test -n "$cpp" && CPP="$cpp" -test -n "$cppflags" && CPPFLAGS="$cppflags" -test -n "$libs" && LIBS="$libs" -test -n "$ldflags" && LDFLAGS="$ldflags" - -dnl Get the arguments back. See the diatribe on Shell Magic above. -eval set x "$quoted_arguments"; shift - -dnl --extra-verbose implies --verbose -test "$extra_verbose" = "yes" && verbose=yes - -dnl with_x is an obsolete synonym for with_x11 -test -n "$with_x" && with_x11="$with_x" - -dnl --with-quantify or --with-purify imply --use-system-malloc -if test "$with_purify" = "yes" -o "$with_quantify" = "yes"; then - test "$with_system_malloc" = "default" && with_system_malloc=yes -fi - -dnl --gung-ho=val is a synonym for -dnl --use-minimal-tagbits=val --use-indexed-lrecord-implementation=val -if test -n "$gung_ho"; then - test -z "$use_minimal_tagbits" && use_minimal_tagbits="$gung_ho" - test -z "$use_indexed_lrecord_implementation" && \ - use_indexed_lrecord_implementation="$gung_ho" -fi -if test "$use_minimal_tagbits" = "no"; then - test "$with_dlmalloc" = "yes" && \ - USAGE_ERROR("--with-dlmalloc requires --use-minimal-tagbits") - with_dlmalloc=no -fi - -dnl XE_CHECK_FEATURE_DEPENDENCY(feature1, feature2) -define([XE_CHECK_FEATURE_DEPENDENCY], -[if test "$with_$1 $with_$2" = "yes no"; then - USAGE_ERROR("--with-$1 requires --with-$2") -elif test "$with_$2" = "no" ; then with_$1=no -elif test "$with_$1" = "yes"; then with_$2=yes -fi -]) - -dnl CDE requires tooltalk -XE_CHECK_FEATURE_DEPENDENCY(cde, tooltalk) - -dnl Find the source directory. -case "$srcdir" in - - dnl If srcdir is not specified, see if "." or ".." might work. - "" ) - for dir in "`echo $0 | sed 's|//|/|' | sed 's|/[[^/]]*$||'`" "." ".." ; do - if test -f "$dir/src/lisp.h" -a \ - -f "$dir/lisp/version.el" ; then - srcdir="$dir" - break - fi - done - if test -z "$srcdir" ; then - USAGE_ERROR(["Neither the current directory nor its parent seem to - contain the XEmacs sources. If you do not want to build XEmacs in its - source tree, you should run \`$progname' in the directory in which - you wish to build XEmacs, using the \`--srcdir' option to say where the - sources may be found."]) - fi - ;; - - dnl Otherwise, check if the directory they specified is okay. - * ) - if test ! -f "$srcdir/src/lisp.h" -o \ - ! -f "$srcdir/lisp/version.el" ; then - USAGE_ERROR(["The directory specified with the \`--srcdir' option, - \`$srcdir', doesn't seem to contain the XEmacs sources. You should - either run the \`$progname' script at the top of the XEmacs source - tree, or use the \`--srcdir' option to specify the XEmacs source directory."]) - fi - ;; -esac - -dnl ########################################################################### -if test -z "$configuration"; then - dnl Guess the configuration - configuration=`${CONFIG_SHELL-/bin/sh} $srcdir/config.guess` - if test -z "$configuration"; then - USAGE_ERROR(["XEmacs has not been ported to this host type. -Try explicitly specifying the CONFIGURATION when rerunning configure."]) - fi -fi - -AC_PROG_LN_S - -dnl Make symlinks for etc, lisp, and info directories while the path -dnl is still relative. We do not symlink lock because someone may -dnl have stuck the source on a read-only partition. Instead we -dnl create it as an actual directory later on if it does not already -dnl exist. -for dir in lisp etc man info; do - if test ! -d "$dir" ; then - echo Making symbolic link to "$srcdir/$dir" - ${LN_S} "$srcdir/$dir" "$dir" - fi -done - -dnl Do our best to deal with automounter brokenness -dnl CANONICALIZE_PATH(varname) -define([CANONICALIZE_PATH], -[if test -d "/net"; then - if test -d "/tmp_mnt/net"; then tdir="tmp_mnt/net"; else tdir="tmp_mnt"; fi - $1=`echo "[$]$1" | \ - sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` -fi])dnl - -dnl Calculate canonical name for blddir (i.e. current directory). -dnl PWD may already be the preferable absolute name for ".", -dnl but we can't trust it - it is sometimes inaccurate. -absolute_pwd="`pwd`"; -if test -n "$PWD" -a "`cd $PWD && pwd`" = "$absolute_pwd" -then blddir="$PWD" -else blddir="$absolute_pwd"; CANONICALIZE_PATH(blddir) -fi -AC_SUBST(blddir) - -dnl Make srcdir absolute, if not already. It is important to -dnl avoid running the path through pwd unnecessary, since pwd can -dnl give you automounter prefixes, which can go away. -case "$srcdir" in - /* ) ;; - . ) srcdir="$blddir" ;; - * ) srcdir="`cd $srcdir && pwd`"; CANONICALIZE_PATH(srcdir) ;; -esac - -dnl Check if the source directory already has a configured system in it. -if test `pwd` != `sh -c cd $srcdir && pwd` \ - && test -f "$srcdir/src/config.h"; then - (echo "$progname: WARNING: The directory tree \`$srcdir' is being used" - echo " as a build directory right now; it has been configured in its own" - echo " right. To configure in another directory as well, you MUST" - echo " use GNU make. If you do not have GNU make, then you must" - echo " now do \`make distclean' in $srcdir," - echo " and then run $progname again.") >&2 - extrasub='/^VPATH[[ ]]*=/c\ -vpath %.c $(srcdir)\ -vpath %.h $(srcdir)\ -vpath %.y $(srcdir)\ -vpath %.l $(srcdir)\ -vpath %.s $(srcdir)\ -vpath %.in $(srcdir)' -fi - -dnl ---------------------------------------- -dnl Find out which version of XEmacs this is -dnl ---------------------------------------- -. "$srcdir/version.sh" || exit 1; -dnl Must do the following first to determine verbosity for AC_DEFINE -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi -: "${extra_verbose=$beta}" -version="${emacs_major_version}.${emacs_minor_version}" -AC_DEFINE_UNQUOTED(EMACS_MAJOR_VERSION, $emacs_major_version) -AC_DEFINE_UNQUOTED(EMACS_MINOR_VERSION, $emacs_minor_version) -if test -n "$emacs_beta_version"; then - version="${version}-b${emacs_beta_version}" - AC_DEFINE_UNQUOTED(EMACS_BETA_VERSION, $emacs_beta_version) -fi -AC_DEFINE_UNQUOTED(XEMACS_CODENAME, "$xemacs_codename") -AC_DEFINE_UNQUOTED(EMACS_VERSION, "$version") - -if test "$with_infodock" = "yes"; then - if test ! -f ../ID-INSTALL; then - echo "Cannot build InfoDock without InfoDock sources" - with_infodock=no - fi -fi - -if test "$with_infodock" = "yes"; then - dnl InfoDock version numbers. XEmacs will use the same style of numbering - dnl after the release of XEmacs 21.0. - AC_DEFINE_UNQUOTED(INFODOCK_MAJOR_VERSION, $infodock_major_version) - AC_DEFINE_UNQUOTED(INFODOCK_MINOR_VERSION, $infodock_minor_version) - AC_DEFINE_UNQUOTED(INFODOCK_BUILD_VERSION, $infodock_build_version) - version=${infodock_major_version}.${infodock_minor_version}.${infodock_build_version} - PROGNAME=infodock - CPPFLAGS="$CPPFLAGS -DINFODOCK" -else - PROGNAME=xemacs -fi - -dnl ---------------------------------- -dnl Error checking and debugging flags -dnl ---------------------------------- -dnl Error checking default to "yes" in beta versions, to "no" in releases. -dnl Same goes for --debug and --extra-verbosity. -if test -n "$emacs_beta_version"; then beta=yes; else beta=no; fi -test "${error_check_extents=$beta}" = yes && AC_DEFINE(ERROR_CHECK_EXTENTS) -test "${error_check_typecheck=$beta}" = yes && AC_DEFINE(ERROR_CHECK_TYPECHECK) -test "${error_check_bufpos=$beta}" = yes && AC_DEFINE(ERROR_CHECK_BUFPOS) -test "${error_check_gc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_GC) -test "${error_check_malloc=$beta}" = yes && AC_DEFINE(ERROR_CHECK_MALLOC) -dnl debug=yes must be set when error checking is present. This should be -dnl fixed up. -dnl debug implies other options -if test "${debug:=$beta}" = "yes"; then - use_assertions=yes memory_usage_stats=yes - XE_ADD_OBJS(debug.o) - AC_DEFINE(DEBUG_XEMACS) -fi -test "$use_assertions" = "yes" && AC_DEFINE(USE_ASSERTIONS) -test "$memory_usage_stats" = "yes" && AC_DEFINE(MEMORY_USAGE_STATS) - -dnl ------------------------------ -dnl Determine the s&m files to use -dnl ------------------------------ -dnl Given the configuration name, set machfile and opsysfile to the -dnl names of the m/*.h and s/*.h files we should use. - -dnl Canonicalize the configuration name. -AC_MSG_CHECKING("host system type") -dnl allow -workshop suffix on configuration name -internal_configuration=`echo $configuration | sed 's/-\(workshop\)//'` -canonical=`${CONFIG_SHELL-/bin/sh} $srcdir/config.sub "$internal_configuration"` -XE_STRIP_4TH_COMPONENT(configuration) -XE_STRIP_4TH_COMPONENT(canonical) -AC_MSG_RESULT($configuration) - -dnl If you add support for a new configuration, add code to this -dnl switch statement to recognize your configuration name and select -dnl the appropriate operating system and machine description files. - -dnl You would hope that you could choose an m/*.h file pretty much -dnl based on the machine portion of the configuration name, and an s- -dnl file based on the operating system portion. However, it turns out -dnl that each m/*.h file is pretty manufacturer-specific - for -dnl example, apollo.h, hp9000s300.h, mega68k, news.h, and tad68k are -dnl all 68000 machines; mips.h, pmax.h, and news-risc are all MIPS -dnl machines. So we basically have to have a special case for each -dnl configuration name. - -dnl As far as handling version numbers on operating systems is -dnl concerned, make sure things will fail in a fixable way. If -dnl /etc/MACHINES says nothing about version numbers, be -dnl prepared to handle anything reasonably. If version numbers -dnl matter, be sure /etc/MACHINES says something about it. - -dnl Eric Raymond says we should accept strings like "sysvr4" to mean -dnl "System V Release 4"; he writes, "The old convention encouraged" -dnl "confusion between `system' and `release' levels'." - -machine='' opsys='' - -dnl Straightforward machine determination -case "$canonical" in - sparc-*-* ) machine=sparc ;; - alpha*-*-* ) machine=alpha ;; - vax-*-* ) machine=vax ;; - mips-dec-* ) machine=pmax ;; - mips-sgi-* ) machine=iris4d ;; - romp-ibm-* ) machine=ibmrt ;; - rs6000-ibm-aix* ) machine=ibmrs6000 ;; - powerpc-ibm-aix* ) machine=ibmrs6000 ;; - powerpc*-* ) machine=powerpc ;; - hppa-*-* ) machine=hp800 ;; - m88k-dg-* ) machine=aviion ;; - m68*-sony-* ) machine=news ;; - mips-sony-* ) machine=news-risc ;; - clipper-* ) machine=clipper ;; - arm-* ) machine=arm ;; - ns32k-* ) machine=ns32000 ;; -esac - -dnl Straightforward OS determination -case "$canonical" in - *-*-linux* ) opsys=linux ;; - *-*-netbsd* ) opsys=netbsd ;; - *-*-openbsd* ) opsys=openbsd ;; - *-*-nextstep* ) opsys=nextstep ;; - *-*-vms ) opsys=vms ;; - - dnl DEC OSF - *-dec-osf1.3 | *-dec-osf2* ) opsys=decosf1-3 ;; - *-dec-osf1.2 | *-dec-osf1* ) opsys=decosf1-2 ;; - *-dec-osf3.[[2-9]] ) opsys=decosf3-2 ;; - *-dec-osf3* ) opsys=decosf3-1 ;; - *-dec-osf4* ) opsys=decosf4-0 ;; - - dnl DEC Ultrix - *-*-ultrix[[0-3]].* | *-*-ultrix4.0* ) opsys=bsd4-2 ;; - *-*-ultrix4.[[12]]* ) opsys=bsd4-3 ;; - *-*-ultrix* ) opsys=ultrix4-3 ;; - - dnl AIX - *-*-aix3.1* ) opsys=aix3-1 ;; - *-*-aix3.2.5 ) opsys=aix3-2-5 ;; - *-*-aix3* ) opsys=aix3-2 ;; - *-*-aix4.0* ) opsys=aix4 ;; - *-*-aix4.1* ) opsys=aix4-1 ;; - *-*-aix4* ) opsys=aix4-2 ;; - - dnl Other generic OSes - *-gnu* ) opsys=gnu ;; - *-*-bsd4.[[01]] ) opsys=bsd4-1 ;; - *-*-bsd4.2 ) opsys=bsd4-2 ;; - *-*-bsd4.3 ) opsys=bsd4-3 ;; - *-*-aos4.2 ) opsys=bsd4-2 ;; - *-*-aos* ) opsys=bsd4-3 ;; - *-*-sysv0 | *-*-sysvr0 ) opsys=usg5-0 ;; - *-*-sysv2 | *-*-sysvr2 ) opsys=usg5-2 ;; - *-*-sysv2.2 | *-*-sysvr2.2 ) opsys=usg5-2-2 ;; - *-*-sysv3* | *-*-sysvr3* ) opsys=usg5-3 ;; - *-*-sysv4.1* | *-*-sysvr4.1* )opsys=usg5-4 NON_GNU_CPP=/usr/lib/cpp ;; - *-*-sysv4.[[2-9]]* | *-sysvr4.[[2-9]]* ) - if test -z "$NON_GNU_CPP" ; then - for prog in "/usr/ccs/lib/cpp" "/lib/cpp"; do - if test -f "$prog"; then NON_GNU_CPP="$prog"; break; fi - done - fi - opsys=usg5-4-2 ;; - *-sysv4* | *-sysvr4* ) opsys=usg5-4 ;; - *-*-mach_bsd4.3* ) opsys=mach-bsd4-3 ;; -esac - -case "$canonical" in - - dnl NetBSD ports - *-*-netbsd* ) - case "$canonical" in - i[[3-9]]86-*-netbsd*) machine=intel386 ;; - hp300-*-netbsd* | amiga-*-netbsd* | sun3-*-netbsd* | mac68k-*-netbsd* | da30-*-netbsd* | m68k-*-netbsd* ) - dnl Yes, this is somewhat bogus. - machine=hp9000s300 ;; - pc532-*-netbsd* | ns32k-*-netbsd* ) machine=ns32000 ;; - pmax-*-netbsd* | mips-*-netbsd* ) machine=pmax ;; - esac - ;; - - dnl OpenBSD ports - *-*-openbsd* ) - case "${canonical}" in - i386-*-openbsd*) machine=intel386 ;; - m68k-*-openbsd*) machine=hp9000s300 ;; - mipsel-*-openbsd*) machine=pmax ;; - esac - ;; - - dnl Acorn RISCiX: - arm-acorn-riscix1.1* ) machine=acorn opsys=riscix1-1 ;; - arm-acorn-riscix1.2* | arm-acorn-riscix ) machine=acorn opsys=riscix1-2 ;; - - dnl Alliant machines - fx80-alliant-* ) machine=alliant4 opsys=bsd4-2 ;; - i860-alliant-* ) machine=alliant-2800 opsys=bsd4-3 ;; - - dnl Altos 3068 - m68*-altos-sysv* ) machine=altos opsys=usg5-2 ;; - - dnl Amdahl UTS - 580-amdahl-sysv* ) machine=amdahl opsys=usg5-2-2 ;; - - dnl Apollo, Domain/OS - m68*-apollo-* ) machine=apollo opsys=bsd4-3 ;; - - dnl AT&T 3b2, 3b5, 3b15, 3b20 - we32k-att-sysv* ) machine=att3b opsys=usg5-2-2 ;; - - dnl AT&T 3b1 - The Mighty Unix PC! - m68*-att-sysv* ) machine=7300 opsys=usg5-2-2 ;; - - dnl Bull machines - rs6000-bull-bosx* ) machine=ibmrs6000 opsys=aix3-2 ;; # dpx20 - m68*-bull-sysv3* ) machine=dpx2 opsys=usg5-3 ;; # dpx2 - m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; # sps7 - - dnl CCI 5/32, 6/32 -- see "Tahoe". - - dnl Celerity - celerity-celerity-bsd* ) machine=celerity opsys=bsd4-2 ;; - - dnl Convex - *-convex-bsd* | *-convex-convexos* ) - machine=convex opsys=bsd4-3 - NON_GNU_CPP="cc -E -P" - ;; - - dnl Cubix QBx/386 - i[[3-9]]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; - - dnl Data General AViiON Machines - i586-dg-dgux*R4* | i586-dg-dgux5.4.4* ) machine=aviion opsys=dgux5-4r4 ;; - m88k-dg-dgux5.4R3* | m88k-dg-dgux5.4.3* ) opsys=dgux5-4r3 ;; - m88k-dg-dgux5.4R2* | m88k-dg-dgux5.4.2* ) opsys=dgux5-4r2 ;; - m88k-dg-dgux* ) opsys=dgux ;; - - dnl Motorola Delta machines - m68k-motorola-sysv* | m68000-motorola-sysv* ) machine=delta opsys=usg5-3 ;; - m88k-motorola-sysv4* ) - dnl jbotte@bnr.ca says that UNIX_System_V 4.0 R40V4.3 m88k mc88110 - dnl needs POSIX_SIGNALS and therefore needs usg5-4-2. - dnl I hope there are not other 4.0 versions for this machine - dnl which really need usg5-4 instead. - machine=delta88k opsys=usg5-4-2 - ;; - m88k-motorola-sysv* | m88k-motorola-m88kbcs* ) machine=delta88k opsys=usg5-3 ;; - - dnl Dual machines - m68*-dual-sysv* ) machine=dual opsys=usg5-2 ;; - m68*-dual-uniplus* ) machine=dual opsys=unipl5-2 ;; - - dnl Encore machines - ns16k-encore-bsd* ) machine=ns16000 opsys=umax ;; - - dnl Gould Power Node and NP1 - pn-gould-bsd4.2* ) machine=gould opsys=bsd4-2 ;; - pn-gould-bsd4.3* ) machine=gould opsys=bsd4-3 ;; - np1-gould-bsd* ) machine=gould-np1 opsys=bsd4-3 ;; - - dnl Harris Night Hawk machines running CX/UX (a 5000 looks just like a 4000 - dnl as far as XEmacs is concerned). - m88k-harris-cxux* ) - dnl Build needs to be different on 7.0 and later releases - case "`uname -r`" in - [[56]].[[0-9]] ) machine=nh4000 opsys=cxux ;; - [[7]].[[0-9]] ) machine=nh4000 opsys=cxux7 ;; - esac - NON_GNU_CPP="/lib/cpp" - ;; - dnl Harris ecx or gcx running CX/UX (Series 1200, Series 3000) - m68k-harris-cxux* ) machine=nh3000 opsys=cxux ;; - dnl Harris power pc NightHawk running Power UNIX (Series 6000) - powerpc-harris-powerunix ) machine=nh6000 opsys=powerunix NON_GNU_CPP="cc -Xo -E -P" ;; - - dnl Honeywell XPS100 - xps*-honeywell-sysv* ) machine=xps100 opsys=usg5-2 ;; - - dnl HP 9000 series 200 or 300 - m68*-hp-bsd* ) machine=hp9000s300 opsys=bsd4-3 ;; - - dnl HP-UX - *-hp-hpux* ) - dnl Figure out machine and opsys orthogonally - case "$canonical" in - m68* ) machine=hp9000s300 ;; - hppa* ) machine=hp800 ;; - esac - - case "$canonical" in - *-hp-hpux7* ) opsys=hpux ;; - *-hp-hpux8* ) opsys=hpux8 ;; - *-hp-hpux9* ) opsys=hpux9 ;; - *-hp-hpux10* ) opsys=hpux10 ;; - *-hp-hpux11* ) opsys=hpux11 ;; - * ) opsys=hpux ;; - esac - - dnl HP has a broken "strcat" - case "$opsys" in hpux9 | hpux10 ) XE_ADD_OBJS(strcat.o) ;; esac - - if test "$opsys" = "hpux10" -o "$opsys" = "hpux11"; then \ - ansi_flag="-Ae"; else ansi_flag="-Aa"; fi - NON_GNU_CC="cc $ansi_flag" NON_GNU_CPP="cc $ansi_flag -E" - - case "$canonical" in *-hp-hpux*shr* ) opsys="${opsys}-shr" ;; esac - ;; - - dnl Orion machines - orion-orion-bsd* ) machine=orion opsys=bsd4-2 ;; - clipper-orion-bsd* ) machine=orion105 opsys=bsd4-2 ;; - - dnl IBM machines - i[[3-9]]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; - i[[3-9]]86-ibm-aix1.[[23]]* | i[[3-9]]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; - i370-ibm-aix*) machine=ibm370aix opsys=usg5-3 ;; - romp-ibm-aos* ) opsys=bsd4-3 ;; - romp-ibm-bsd* ) opsys=bsd4-3 ;; - romp-ibm-mach* ) opsys=mach-bsd4-3 ;; - - dnl Integrated Solutions "Optimum V" - m68*-isi-bsd4.2* ) machine=isi-ov opsys=bsd4-2 ;; - m68*-isi-bsd4.3* ) machine=isi-ov opsys=bsd4-3 ;; - - dnl Intel 386 machines where we do care about the manufacturer - i[[3-9]]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; - - dnl Prime EXL - i[[3-9]]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; - - dnl Sequent Symmetry running Dynix - i[[3-9]]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; - - dnl Sequent Symmetry running DYNIX/ptx - i[[3-9]]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; - - dnl Unspecified sysv on an ncr machine defaults to svr4.2. - dnl (Plain usg5-4 does not turn on POSIX signals, which we need.) - i[[3-9]]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; - - dnl Intel Paragon OSF/1 - i860-intel-osf1* ) machine=paragon opsys=osf1 NON_GNU_CPP=/usr/mach/lib/cpp ;; - - dnl Intel 860 - i860-*-sysv4* ) machine=i860 opsys=usg5-4 NON_GNU_CC="/bin/cc" NON_GNU_CPP="/usr/ccs/lib/cpp" ;; - - dnl Masscomp machines - m68*-masscomp-rtu* ) machine=masscomp opsys=rtu ;; - - dnl Megatest machines - m68*-megatest-bsd* ) machine=mega68 opsys=bsd4-2 ;; - - dnl Workstations sold by MIPS - dnl This is not necessarily all workstations using the MIPS processor - - dnl Irises are produced by SGI, and DECstations by DEC. - mips-mips-usg* ) machine=mips4 ;; - mips-mips-riscos4 ) - machine=mips4 - NON_GNU_CC="cc -systype bsd43" - NON_GNU_CPP="cc -systype bsd43 -E" - case "$canonical" in - mips-mips-riscos4* ) opsys=bsd4-3 ;; - mips-mips-riscos5* ) opsys=riscos5 ;; - esac - ;; - mips-mips-bsd* ) machine=mips opsys=bsd4-3 ;; - mips-mips-* ) machine=mips opsys=usg5-2-2 ;; - - dnl NeXT - m68*-next-* | m68k-*-nextstep* ) machine=m68k opsys=nextstep ;; - - dnl The complete machine from National Semiconductor - ns32k-ns-genix* ) machine=ns32000 opsys=usg5-2 ;; - - dnl NCR machines - m68*-ncr-sysv2* | m68*-ncr-sysvr2* ) machine=tower32 opsys=usg5-2-2 ;; - m68*-ncr-sysv3* | m68*-ncr-sysvr3* ) machine=tower32v3 opsys=usg5-3 ;; - - dnl Nixdorf Targon 31 - m68*-nixdorf-sysv* ) machine=targon31 opsys=usg5-2-2 ;; - - dnl Nu (TI or LMI) - m68*-nu-sysv* ) machine=nu opsys=usg5-2 ;; - - dnl Plexus - m68*-plexus-sysv* ) machine=plexus opsys=usg5-2 ;; - - dnl Pyramid machines - pyramid-pyramid-bsd* ) machine=pyramid opsys=bsd4-2 ;; - - dnl Sequent Balance - ns32k-sequent-bsd4.2* ) machine=sequent opsys=bsd4-2 ;; - ns32k-sequent-bsd4.3* ) machine=sequent opsys=bsd4-3 ;; - - dnl Siemens Nixdorf - mips-siemens-sysv* | mips-sni-sysv*) - machine=mips-siemens opsys=usg5-4 - NON_GNU_CC=/usr/ccs/bin/cc - NON_GNU_CPP=/usr/ccs/lib/cpp - ;; - - dnl NEC - mips-nec-sysv*) - machine=mips-nec - NON_GNU_CC=/usr/ccs/bin/cc - NON_GNU_CPP=/usr/ccs/lib/cpp - ;; - - dnl Silicon Graphics machines - dnl Iris 2500 and Iris 2500 Turbo (aka the Iris 3030) - m68*-sgi-iris3.5* ) machine=irist opsys=iris3-5 ;; - m68*-sgi-iris3.6* | m68*-sgi-iris*) machine=irist opsys=iris3-6 ;; - dnl Iris 4D - mips-sgi-irix3.* ) opsys=irix3-3 ;; - mips-sgi-irix4.* ) opsys=irix4-0 ;; - mips-sgi-irix6* ) opsys=irix6-0 ;; - mips-sgi-irix5.1* ) opsys=irix5-1 ;; - mips-sgi-irix5.2* ) opsys=irix5-2 ;; - mips-sgi-irix5.* ) opsys=irix5-3 ;; - mips-sgi-irix* ) opsys=irix5-0 ;; - - dnl SONY machines - *-sony-newsos[[34]]* | *-sony-news[[34]]* ) opsys=bsd4-3 ;; - *-sony-news* ) opsys=newsos5 ;; - - dnl Stride - m68*-stride-sysv* ) machine=stride opsys=usg5-2 ;; - - dnl Suns - *-*-solaris* | *-*-sunos* | *-sun-mach* | *-sun-bsd* ) - dnl Hardware type - case "$canonical" in - m68*-sunos1* ) machine=sun1 ;; - m68*-sunos2* ) machine=sun2 ;; - m68* ) machine=sun3 ;; - i*86*-sun-sunos[[34]]* ) machine=sun386 ;; - i*86-*-* ) machine=intel386 ;; - rs6000* ) machine=rs6000 ;; - esac - - dnl Make $canonical even more so. - case "$canonical" in *-sunos5*) - canonical=`echo $canonical | sed -e s/sunos5/solaris2/`;; - esac - - dnl On SunOS 4, use /usr/lib/cpp, sans dynodump, /bin/ranlib - dnl On SunOS 5, use cc -E, need dynodump, RANLIB not needed - dnl But, SunOS 5.6 no longer needs dynodump because it has a similar - dnl function integrated. - case "$canonical" in - *-sunos4* ) - #test -f /usr/lib/cpp && NON_GNU_CPP=/usr/lib/cpp ;; - : ;; - *-solaris2* ) - #test -f /usr/ccs/lib/cpp && NON_GNU_CPP=/usr/ccs/lib/cpp - RANLIB=':' ;; - esac - - case "$canonical" in - *-solaris* ) - opsys=sol2 - os_release=`uname -r | sed -e 's/^\([[0-9]]\)\.\([[0-9]]\).*/\1\2/'` - AC_DEFINE_UNQUOTED(OS_RELEASE, $os_release) ;; - - dnl The last Sun386 ran 4.0. - i*86-*-sunos4* ) opsys=sunos4-0 ;; - *-sunos4.0* ) opsys=sunos4-0 ;; - *-sunos4.1.2* ) opsys=sunos4-1-2 ;; - *-sunos4.1.3* ) opsys=sunos4-1-3 ;; - *-sunos4.1.[[4-9]]* ) opsys=sunos4-1-4 ;; - *-sunos4* | *-sunos ) opsys=sunos4-1 ;; - *-mach* ) opsys=mach-bsd4-3 ;; - * ) opsys=bsd4-2 ;; - esac - - case "$canonical" in *-sunos4*shr* ) opsys="${opsys}-shr" ;; esac - - dnl Watch out for a compiler guaranteed not to work. - test "$opsys $CC" = "sol2 /usr/ucb/cc" && CC="" - ;; - - dnl Tadpole 68k - m68*-tadpole-sysv* ) machine=tad68k opsys=usg5-3 ;; - - dnl Tahoe machines - tahoe-tahoe-bsd4.2* ) machine=tahoe opsys=bsd4-2 ;; - tahoe-tahoe-bsd4.3* ) machine=tahoe opsys=bsd4-3 ;; - - dnl Tandem Integrity S2 - mips-tandem-sysv* ) machine=tandem-s2 opsys=usg5-3 ;; - - dnl Tektronix XD88 - m88k-tektronix-sysv3* ) machine=tekxd88 opsys=usg5-3 ;; - - dnl Tektronix 16000 box (6130?) - ns16k-tektronix-bsd* ) machine=ns16000 opsys=bsd4-2 ;; - dnl Tektronix 4300 - dnl src/m/tek4300.h hints that this is a m68k machine. - m68*-tektronix-bsd* ) machine=tek4300 opsys=bsd4-3 ;; - - dnl Titan P2 or P3 - titan-titan-sysv* ) machine=titan opsys=usg5-3 ;; - - dnl Ustation E30 (SS5E) - m68*-unisys-uniplus* ) machine=ustation opsystem=unipl5-2 ;; - - dnl Vaxen. - vax-dec-* ) - case "$canonical" in - *-sysv[[01]]* | *-sysvr[[01]]* ) opsys=usg5-0 ;; - *-sysv2* | *-sysvr2* ) opsys=usg5-2 ;; - *-mach* ) opsys=mach-bsd4-3 ;; - esac - ;; - - dnl Whitechapel MG1 - ns16k-whitechapel-* ) machine=mg1 ;; - - dnl Wicat - m68*-wicat-sysv* ) machine=wicat opsys=usg5-2 ;; - - dnl Intel 386 machines where we do not care about the manufacturer - i[[3-9]]86-*-* ) - machine=intel386 - case "$canonical" in - *-isc1.* | *-isc2.[[01]]* ) opsys=386-ix ;; - *-isc2.2* ) opsys=isc2-2 ;; - *-isc4.0* ) opsys=isc4-0 ;; - *-isc4.* ) opsys=isc4-1 - GCC_TEST_OPTIONS=-posix - NON_GCC_TEST_OPTIONS=-Xp - ;; - *-isc* ) opsys=isc3-0 ;; - *-esix5* ) opsys=esix5r4 NON_GNU_CPP=/usr/lib/cpp ;; - *-esix* ) opsys=esix ;; - *-mach* ) opsys=mach-bsd4-3 ;; - *-xenix* ) opsys=xenix ;; - *-sco3.2v4* ) opsys=sco4 NON_GNU_CPP=/lib/cpp ;; - *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; - *-bsdi4* ) opsys=bsdos4 ;; - *-bsdi3* ) opsys=bsdos3 ;; - *-bsdi2.1* ) opsys=bsdos2-1 ;; - *-bsdi2* ) opsys=bsdos2 ;; - *-sco3.2v5* ) opsys=sco5 ; - dnl This is a pain. Like the current USL cc, SCO cc -E - dnl tokenizes as it preprocesses, making configure very - dnl unhappy. Unfortunately, /lib/cpp does not understand - dnl flags like "-b elf", so we have to cheat in order to - dnl pick up the right defines for UNEXEC from the s-file. - dnl 01/05/95 robertl@dgii.com - if test "$dynamic" = "yes" ; then - NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE -D_SCO_ELF" ; - else - NON_GNU_CPP="/lib/cpp -D_XOPEN_SOURCE" ; - fi ;; - *-386bsd* ) opsys=386bsd ;; - *-freebsd* ) opsys=freebsd ;; - *-nextstep* ) opsys=nextstep ;; - *-pc-cygwin32 ) opsys=cygwin32 ;; - dnl Otherwise, we fall through to the generic opsys code at the bottom. - esac - ;; - - dnl Linux/68k - m68k-*-linux* ) machine=m68k opsys=linux ;; - -esac - -if test -z "$machine" -o -z "$opsys"; then - (echo "$progname: XEmacs hasn't been ported to \`$canonical' systems." - echo "$progname: Check \`etc/MACHINES' for recognized configuration names." - ) >&2 - exit 1 -fi - -if test -z "$dynamic"; then - case "$opsys" in - hpux* | sunos4* ) dynamic=no ;; - *) dynamic=yes ;; - esac -fi -if test "$dynamic" = "yes"; then - case "$opsys" in - hpux* | sunos4* | sco5 ) opsys="${opsys}-shr" ;; - decosf* ) ld_call_shared="-call_shared" ;; - esac -else dnl "$dynamic" = "no" - case "$opsys" in - sol2 ) - echo "Static linking is not supported on Solaris 2." - echo "Rerun configure without specifying --dynamic=no." - exit 1 ;; - linux ) ld_call_shared="-Bstatic" ;; - decosf* ) ld_call_shared="-non_shared" ;; - esac -fi - -dnl Use xlc by default on AIX -case "$opsys" in aix*) NON_GNU_CC=xlc ;; esac - -stack_trace_eye_catcher=`echo ${PROGNAME}_${version}_${canonical} | sed 'y/.-/__/'` -AC_DEFINE_UNQUOTED(STACK_TRACE_EYE_CATCHER, $stack_trace_eye_catcher) - -machfile="m/${machine}.h" -opsysfile="s/${opsys}.h" - -dnl -------------------------------------------------- -dnl Determine the compiler, set up for feature testing -dnl -------------------------------------------------- - -dnl Sun Development environment support -test "$with_sparcworks" = "yes" && with_workshop=yes # compatibility alias -XE_CHECK_FEATURE_DEPENDENCY(workshop, tooltalk) -if test "$with_workshop" = "yes"; then - AC_DEFINE(SUNPRO) - XE_ADD_OBJS(sunpro.o) -fi - -if test "$with_clash_detection" = "yes"; then - AC_DEFINE(CLASH_DETECTION) - XE_ADD_OBJS(filelock.o) -fi - -dnl Choose a compiler from (in order) -dnl --compiler, env var CC, with_gcc=no && ${NON_GNU_CC:-cc}, AC_PROG_CC -test -n "$compiler" && CC="$compiler" -if test "$with_gcc" = "no"; then dnl Try to find a non-gcc compiler - case "$CC" in "" | *gcc* ) CC="${NON_GNU_CC-cc}" ;; esac -fi - -dnl If we don't set CFLAGS here, AC_PROG_CC will set it. -dnl But we know better what's good for us, so we do our own -dnl computation of real CFLAGS later. -dnl --cflags overrides environment variable CFLAGS -test "${cflags-unset}" != unset && CFLAGS="$cflags" -if test "${CFLAGS-unset}" != unset - then cflags_specified=yes; - else cflags_specified=no; -fi - -xe_save_CFLAGS="$CFLAGS" - -AC_PROG_CC dnl Autoconf has its own magic for compiler autodetection - -dnl Retry using random guesswork if AC_PROG_CC got it wrong... -if test "$with_gcc" = "no" -a "$GCC" = "yes"; then - CC=${NON_GNU_CC-cc} - AC_PROG_CC -elif test "$with_gcc" = "yes" -a "$GCC" != "yes" ; then - CC=gcc - AC_PROG_CC -fi -CFLAGS="$xe_save_CFLAGS" - -dnl Figure out what C preprocessor to use. - -dnl On Sun systems, people sometimes set up the variable CPP -dnl with a value that is a directory, not an executable at all. -dnl Detect that case, and ignore that value. -test -n "$CPP" -a -d "$CPP" && CPP= - -test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" - -AC_PROG_CPP - -AC_AIX - -AC_MSG_CHECKING(for GNU libc) -AC_TRY_COMPILE([#include ],[ -#if ! (defined __GLIBC__ || defined __GNU_LIBRARY__) -#error Not a GNU libc system :-( -******* ======= ******** &&&&&&&& -#endif -], have_glibc=yes, have_glibc=no) -AC_MSG_RESULT($have_glibc) -dnl I'm tired of pop being broken with GLIBC -slb -dnl Well. then why not fix fucking pop? -test "$have_glibc" = "yes" && AC_DEFINE(_GNU_SOURCE) - - -dnl Identify compilers to enable compiler-specific hacks. -dnl Add support for other compilers HERE! -dnl GCC is already identified elsewhere. -AC_TRY_RUN([int main () { -#if defined __SUNPRO_C -return 11; -#elif defined __DECC -return 12; -#else -return 0; -#endif -}], [], -[case "$conftest_rc" in - 11) echo "You appear to be using the SunPro C compiler."; __SUNPRO_C=yes ;; - 12) echo "You appear to be using the DEC C compiler." ; __DECC=yes ;; -esac]) - - -dnl case "$canonical" in -dnl *-sun-sunos* ) test "$CPP" = "acc -E" && CPP="acc -E -Xs" ;; -dnl esac - -dnl -------------------------------------------------------------------- -dnl Extract some information from the operating system and machine files -dnl -------------------------------------------------------------------- - -echo "Extracting information from the machine- and system-dependent headers..." - -dnl It is not important that this name contain the PID; you cannot run -dnl two configures in the same directory and have anything work -dnl anyway. -tempcname="conftest.c" - -dnl CPP_to_sh(CPP_SYMBOL, SH_VAR, DEFAULT_VALUE) -define([CPP_to_sh], -[[#]ifndef [$1] -[#]define [$1]ifelse([$3],,, [ "$3"]) -[#]endif -configure___ [$2]=[$1] -])dnl CPP_to_sh - -dnl CPP_boolean_to_sh(CPP_SYMBOL, SH_VAR) -define([CPP_boolean_to_sh], -[[#]ifdef [$1] -configure___ [$2]=yes -[#]else -configure___ [$2]=no -[#]endif -])dnl CPP_boolean_to_sh - -cat > $tempcname </dev/null`" && \ - eval "$xe_add_unique_runpath_dir" -}])dnl - -dnl XE_COMPUTE_RUNPATH() -define([XE_COMPUTE_RUNPATH],[ -if test "$add_runtime_path" = "yes" -a -n "$dash_r"; then - dnl Remove runtime paths from current ld switches - ld_switch_site=`echo '' $ld_switch_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` - ld_switch_x_site=`echo '' $ld_switch_x_site | sed -e 's:^ ::' -e "s/$dash_r[[^ ]]*//g"` - dnl PRINT_VAR(ld_switch_site ld_switch_x_site) - - dnl Fix up Runtime path - dnl If LD_RUN_PATH is set in environment, use that. - dnl In this case, assume user has set the right value. - runpath="" runpath_dirs="" - if test -n "$LD_RUN_PATH"; then - runpath="$LD_RUN_PATH" - elif test "$GCC" = "yes"; then - dnl Compute runpath from gcc's -v output - ld_switch_run_save="$ld_switch_run"; ld_switch_run="" - echo "int main(int argc, char *argv[[]]) {return 0;}" > conftest.c - xe_runpath_link='${CC-cc} -o conftest -v $CFLAGS '"$xe_ldflags"' conftest.$ac_ext 2>&1 1>/dev/null' - for arg in `eval "$xe_runpath_link" | grep ' -L'`; do - case "$arg" in P,* | -L* | -R* ) - for dir in `echo '' "$arg" | sed -e 's:^ ::' -e 's/^..//' -e 'y/:/ /'`; do - XE_ADD_RUNPATH_DIR("$dir") - done ;; - esac - done - ld_switch_run="$ld_switch_run_save" - rm -f conftest* - else - dnl Add all directories with .so files to runpath - for arg in $ld_switch_site $ld_switch_x_site; do - case "$arg" in -L*) XE_ADD_RUNPATH_DIR(`echo '' "$arg" | sed -e 's:^ ::' -e 's/^-L//'`);; esac - done - dnl Sometimes /opt/SUNWdt/lib is the only installed Motif available - if test "$opsys $need_motif" = "sol2 yes"; then - xe_runpath_dir="/opt/SUNWdt/lib"; - eval "$xe_add_unique_runpath_dir"; - fi - fi dnl Compute $runpath - - if test -n "$runpath"; then - ld_switch_run="${dash_r}${runpath}" - XE_PROTECT_LINKER_FLAGS(ld_switch_run) - test "$extra_verbose" = "yes" && echo "Setting runpath to $runpath" - fi -fi -])dnl -XE_COMPUTE_RUNPATH() - -dnl JKJ REMOVEME -dnl XE_SHLIB_STUFF - -dnl ----------------------------------- -dnl Do some misc autoconf-special tests -dnl ----------------------------------- - -dnl Do the opsystem or machine files prohibit the use of the GNU malloc? -dnl Assume not, until told otherwise. -GNU_MALLOC=yes -if test "$with_dlmalloc" != "no"; then - doug_lea_malloc=yes -else - doug_lea_malloc=no -fi -after_morecore_hook_exists=yes -AC_CHECK_FUNC(malloc_get_state, ,doug_lea_malloc=no) -AC_CHECK_FUNC(malloc_set_state, ,doug_lea_malloc=no) -AC_MSG_CHECKING(whether __after_morecore_hook exists) -AC_TRY_LINK([extern void (* __after_morecore_hook)();],[__after_morecore_hook = 0], - [AC_MSG_RESULT(yes)], - [AC_MSG_RESULT(no) - after_morecore_hook_exists=no]) -if test "$system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (The GNU allocators don't work with this system configuration)." -elif test "$with_system_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (User chose not to use GNU allocators)." -elif test "$with_debug_malloc" = "yes" ; then - GNU_MALLOC=no - GNU_MALLOC_reason=" - (User chose to use Debugging Malloc)." -fi - -if test "$doug_lea_malloc" = "yes" ; then - if test "$GNU_MALLOC" = yes ; then - GNU_MALLOC_reason=" - (Using Doug Lea's new malloc from the GNU C Library.)" - fi - AC_DEFINE(DOUG_LEA_MALLOC) - if test "$after_morecore_hook_exists" = "no" ; then - GNU_MALLOC_reason=" - (Using Doug Lea's new malloc from the Linux C Library.)" - AC_DEFINE(_NO_MALLOC_WARNING_) - fi - use_minimal_tagbits=yes -fi - -dnl #### mcheck is broken in all versions of Linux libc and glibc. -dnl Try this again when 2.1 hits the streets. -dnl Avoid using free-hook.c if support exists for malloc debugging in libc -dnl have_libmcheck=no -dnl if test "$error_check_malloc" = "yes" -a \ -dnl "$have_glibc" = "yes" -a \ -dnl "$doug_lea_malloc" = "yes"; then -dnl AC_CHECK_HEADERS(mcheck.h) -dnl AC_CHECK_LIB(mcheck, mcheck, have_libmcheck=yes, have_libmcheck=no) -dnl fi - -dnl if test "$have_libmcheck" = "yes"; then -dnl AC_DEFINE(HAVE_LIBMCHECK) -dnl libmcheck=-lmcheck -dnl AC_SUBST(libmcheck) -dnl fi - -dnl Some other nice autoconf tests. If you add a test here which -dnl should make an entry in src/config.h, do not forget to add an -dnl #undef clause to src/config.h.in for autoconf to modify. - -AC_PROG_RANLIB -AC_PROG_INSTALL -AC_PROG_YACC - -dnl checks for header files -AC_CHECK_HEADERS(mach/mach.h sys/stropts.h sys/timeb.h sys/time.h unistd.h) -AC_CHECK_HEADERS(utime.h locale.h libgen.h fcntl.h ulimit.h cygwin/version.h) -AC_CHECK_HEADERS(kstat.h sys/pstat.h inttypes.h sys/un.h a.out.h) -AC_HEADER_SYS_WAIT -AC_HEADER_STDC -AC_HEADER_TIME -AC_DECL_SYS_SIGLIST - -dnl Some systems have utime.h but do not declare the struct anyplace. -AC_MSG_CHECKING(for struct utimbuf) -AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif -#ifdef HAVE_UTIME_H -#include -#endif], [static struct utimbuf x; x.actime = x.modtime;], - [AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_STRUCT_UTIMBUF)], - AC_MSG_RESULT(no)) - -dnl checks for typedefs -AC_TYPE_SIGNAL -AC_TYPE_SIZE_T -AC_TYPE_PID_T -AC_TYPE_UID_T -AC_TYPE_MODE_T -AC_TYPE_OFF_T - -AC_MSG_CHECKING(for struct timeval) -AC_TRY_COMPILE([#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif], [static struct timeval x; x.tv_sec = x.tv_usec;], - [AC_MSG_RESULT(yes) - HAVE_TIMEVAL=yes - AC_DEFINE(HAVE_TIMEVAL)], - [AC_MSG_RESULT(no) - HAVE_TIMEVAL=no]) - -dnl checks for structure members -AC_STRUCT_TM -AC_STRUCT_TIMEZONE - -dnl checks for compiler characteristics -AC_C_CONST - -dnl check for Make feature -AC_PROG_MAKE_SET - -dnl check byte order -AC_C_BIGENDIAN - -dnl define SIZEOF_TYPE -AC_CHECK_SIZEOF(short) -if test "$ac_cv_sizeof_short" = 0; then - echo "" - echo "*** PANIC *** Configure tests are not working - compiler is broken." - echo "*** PANIC *** Please examine config.log for compilation errors." - exit 1 -fi -AC_CHECK_SIZEOF(int) -AC_CHECK_SIZEOF(long) -AC_CHECK_SIZEOF(long long) -AC_CHECK_SIZEOF(void *) - -dnl check for long file names -AC_SYS_LONG_FILE_NAMES - -dnl -lm is required by LISP_FLOAT_TYPE, among other things -AC_CHECK_LIB(m, sin) - -dnl Floating operation support is now unconditional -AC_DEFINE(LISP_FLOAT_TYPE) - -AC_TRY_LINK([#include ], - [return atanh(1.0) + asinh(1.0) + acosh(1.0); ], - AC_DEFINE(HAVE_INVERSE_HYPERBOLIC)) - -dnl Determine type of mail locking from configure args and s&m headers -AC_CHECKING(type of mail spool file locking) -test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock -test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf -if test "$mail_locking" = "lockf"; then AC_DEFINE(REAL_MAIL_USE_LOCKF) -elif test "$mail_locking" = "flock"; then AC_DEFINE(REAL_MAIL_USE_FLOCK) -else mail_locking="dot-locking" -fi - -dnl Used by getloadavg() - does not require root priveleges -AC_CHECK_LIB(kstat, kstat_open) - -dnl Another way to get the load average -AC_CHECK_LIB(kvm, kvm_read) - -case "$opsys" in decosf*) - AC_CHECK_LIB(pthreads, cma_open) - test "$ac_cv_lib_pthreads_cma_open" = "yes" && \ - c_switch_site="$c_switch_site -threads" ;; -esac - -AC_MSG_CHECKING(whether the -xildoff compiler flag is required) -if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then - if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; - then AC_MSG_RESULT(no); - else AC_MSG_RESULT(yes); XE_APPEND(-xildoff, ld_switch_site) - fi - else AC_MSG_RESULT(no) -fi - -dnl Link with "-z ignore" on Solaris if supported -if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then - AC_MSG_CHECKING(for \"-z ignore\" linker flag) - case "`ld -h 2>&1`" in - *-z\ ignore\|record* ) AC_MSG_RESULT(yes) - XE_PREPEND(-z ignore, ld_switch_site) ;; - *) AC_MSG_RESULT(no) ;; - esac -fi - -dnl ---------------------- -dnl Choose a window system -dnl ---------------------- - -AC_CHECKING("for specified window system") - -if test "$with_x11" != "no"; then - dnl User-specified --x-includes or --x-libraries implies --with-x11. - test "$x_includes $x_libraries" != "NONE NONE" && \ - window_system=x11 with_x11=yes - - dnl Autodetection of X11 libraries and includes - dnl ------------------------------------------- - dnl AC_PATH_XTRA thinks it can find our X headers and includes, but - dnl it often gets it wrong, so we only use it as a last resort. - - dnl $OPENWINHOME implies --x-includes and --x-libraries - dnl Not (yet) handled by autoconf2 - if test "$x_includes $x_libraries" = "NONE NONE" \ - -a -n "$OPENWINHOME" \ - -a "$OPENWINHOME" != "/usr/openwin" \ - -a -d "$OPENWINHOME"; then - test -d "$OPENWINHOME/lib" && x_libraries="$OPENWINHOME/lib" - test -d "$OPENWINHOME/include" && x_includes="$OPENWINHOME/include" - test -d "$OPENWINHOME/share/include" && x_includes="$OPENWINHOME/share/include" - fi - - if test "$x_includes" = "NONE"; then - dnl AC_PATH_XTRA often guesses /usr/include, when some other - dnl include directory is a MUCH better guess (Linux, HP-UX 10.20). - dnl This is a workaround for idiot (esp. HP) system vendors, who - dnl provide a /usr/include/X11, but DON'T FULLY POPULATE IT. - for dir in "/usr/X11" "/usr/X11R6"; do - if test -d "$dir/include/X11"; then x_includes="$dir/include"; break; fi - done - fi - - if test "$x_libraries" = "NONE"; then - for dir in "/usr/X11/lib" "/usr/X11R6/lib" "/usr/lib/X11R6"; do - if test -r "$dir/libX11.a"; then x_libraries="$dir"; break; fi - done - fi - - AC_PATH_XTRA # Autoconf claims to find X library and include dirs for us. - if test "$no_x" = "yes" - then with_x11=no window_system=none HAVE_X_WINDOWS=no - else with_x11=yes window_system=x11 HAVE_X_WINDOWS=yes - fi -fi - -case "$with_x11" in - yes ) window_system=x11 HAVE_X_WINDOWS=yes ;; - no ) window_system=none HAVE_X_WINDOWS=no ;; -esac - -if test "$with_x11" = "yes"; then - AC_DEFINE(HAVE_X_WINDOWS) - XE_APPEND(lwlib, MAKE_SUBDIR) - XE_APPEND(lwlib, SRC_SUBDIR_DEPS) - - dnl Try to find Motif/CDE/Tooltalk dirs - dnl These take precedence over other X libs/includes, so PRE-pend - for lib_dir in "/usr/dt/lib" "/usr/lib/Motif2.1" "/usr/lib/Motif1.2" "/usr/lib/Motif1.1"; do - inc_dir=`echo $lib_dir | sed -e 's/lib/include/'` - if test -d "$lib_dir" -a -d "$inc_dir"; then - case "$x_libraries" in *"$lib_dir"* ) ;; *) - x_libraries="$lib_dir $x_libraries" - XE_PREPEND(-L${lib_dir}, X_LIBS) ;; - esac - case "$x_includes" in "$inc_dir"* ) ;; *) - x_includes="$inc_dir $x_includes" - XE_PREPEND(-I${inc_dir}, X_CFLAGS) ;; - esac - break; dnl only need ONE Motif implementation! - fi - done - - dnl Contrib X libs/includes do NOT take precedence, so AP-pend - for rel in "X11R6" "X11R5" "X11R4"; do - lib_dir="/usr/contrib/$rel/lib" inc_dir="/usr/contrib/$rel/include" - if test -d "$lib_dir" -a -d "$inc_dir"; then - case "$x_libraries" in *"$lib_dir"* ) ;; *) - x_libraries="$x_libraries $lib_dir" - XE_APPEND(-L${lib_dir}, X_LIBS) - esac - case "$x_includes" in "$inc_dir"* ) ;; *) - x_includes="$x_includes $inc_dir" - XE_APPEND(-I${inc_dir}, X_CFLAGS) - esac - break; dnl Only need ONE X11 implementation ! - fi - done - - dnl Avoid version mismatch for shared library libXm.so on osf4 - if test "$GCC" = yes -a -d /usr/shlib; then XE_APPEND(-L/usr/shlib, X_LIBS); fi - - ld_switch_x_site="$X_LIBS" - - XE_COMPUTE_RUNPATH() - - if test "$extra_verbose" = "yes"; then - echo; echo "X11 compilation variables:" - PRINT_VAR(x_libraries x_includes X_CFLAGS X_LIBS X_PRE_LIBS X_EXTRA_LIBS) - echo - fi - - dnl Set up bitmaps search path. - dnl The original suggestion was to unconditionally to append X11/bitmaps - dnl to each element of $x_includes, I'm pretty sure this is the wrong - dnl thing to do. We test for bitmaps and X11/bitmaps directories on each - dnl element and add them to BITMAPDIR if they exist. - bitmapdirs= - if test "$x_includes" != NONE; then - for i in $x_includes; do - if test -d "$i/bitmaps"; then - bitmapdirs="$i/bitmaps:$bitmapdirs" - fi - if test -d "$i/X11/bitmaps"; then - bitmapdirs="$i/X11/bitmaps:$bitmapdirs" - fi - done - bitmapdirs=`echo "$bitmapdirs" | sed s/.$//` - fi - test ! -z "$bitmapdirs" && AC_DEFINE_UNQUOTED(BITMAPDIR, "$bitmapdirs") - - dnl Autodetect defines extracted from X config by xmkmf, e.g. NARROWPROTO - AC_CHECKING(for X defines extracted by xmkmf) - rm -fr conftestdir - if mkdir conftestdir; then - cd conftestdir - cat > Imakefile <<'EOF' -xetest: - @echo ${PROTO_DEFINES} ${STD_DEFINES} -EOF - if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then - # GNU make sometimes prints "make[1]: Entering...", which would confuse us. - xmkmf_defines=`${MAKE-make} xetest 2>/dev/null | grep -v make` - fi - cd .. - rm -fr conftestdir - for word in $xmkmf_defines; do - case "$word" in - -D*=* ) ;; - -D* ) word=`echo '' $word | sed -e 's:^ *-D::'` - AC_DEFINE_UNQUOTED($word) ;; - esac - done - fi - - dnl make sure we can find Intrinsic.h - AC_CHECK_HEADER(X11/Intrinsic.h, , - [AC_MSG_ERROR("Unable to find X11 header files.")]) - - dnl -lXt and -lX11 are required - dnl Some broken systems require the magic "-b i486-linuxaout" flag - AC_CHECK_LIB(X11, XOpenDisplay, have_lib_x11=yes) - if test "$have_lib_x11" != "yes"; then - AC_CHECK_LIB(X11, XGetFontProperty, - ld_switch_x_site="-b i486-linuxaout $ld_switch_x_site", - [AC_MSG_ERROR("Unable to find X11 libraries.")], - -b i486-linuxaout) - fi - libs_x="-lX11" - test "$extra_verbose" = "yes" && echo " Setting libs_x to \"-lX11\"" - - dnl Autodetect -lXext - AC_CHECK_LIB(Xext, XShapeSelectInput, XE_PREPEND(-lXext, libs_x)) - - dnl Require -lXt - AC_CHECK_LIB(Xt, XtOpenDisplay, XE_PREPEND(-lXt, libs_x), - AC_MSG_ERROR("Unable to find X11 libraries.")) - - AC_MSG_CHECKING(the version of X11 being used) - AC_TRY_RUN([#include - int main(int c, char *v[]) { return c>1 ? XlibSpecificationRelease : 0; }], - [./conftest foobar; x11_release=$?],[x11_release=4],[x11_release=4]) - AC_MSG_RESULT(R${x11_release}) - AC_DEFINE_UNQUOTED(THIS_IS_X11R${x11_release}) - - AC_CHECK_HEADERS(X11/Xlocale.h) - - dnl remove this - we should avoid checking for specific OS - AC_MSG_CHECKING(for XFree86) - if test -d "/usr/X386/include" -o \ - -f "/etc/XF86Config" -o \ - -f "/etc/X11/XF86Config" -o \ - -f "/usr/X11R6/lib/X11/XF86Config"; then - AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_XFREE386) - else - AC_MSG_RESULT(no) - fi - - dnl autodetect -lXmu - test -z "$with_xmu" && { AC_CHECK_LIB(Xmu, XmuReadBitmapDataFromFile, - with_xmu=yes, with_xmu=no) } - if test "$with_xmu" = "no"; then - XE_ADD_OBJS(xmu.o) - else - XE_PREPEND(-lXmu, libs_x) - AC_DEFINE(HAVE_XMU) - fi - - dnl Autodetect -lXbsd - dnl #### Someone, please add a better function than main - AC_CHECK_LIB(Xbsd, main, XE_PREPEND(-lXbsd, libs_x)) - - dnl Problem with the MIT distribution of X on AIX - if test "$unexec" = "unexaix.o" -a "$x11_release" = "6"; then - dnl X11R6 requires thread-safe code on AIX for some reason - if test "$GCC" = "yes"; then - XE_PREPEND(-mthreads, X_CFLAGS) - XE_PREPEND(-mthreads, libs_x) - else - case "$CC" in - "xlc" ) CC="xlc_r" ;; - "xlC" ) CC="xlC_r" ;; - "cc" ) CC="cc_r" ;; - esac - fi - fi - -fi dnl $with_x11 = yes - -if test "$with_msw" != "no"; then - AC_CHECKING(for MS-Windows) - AC_CHECK_LIB(gdi32,main,with_msw=yes) - if test "$with_msw" = "yes"; then - AC_DEFINE(HAVE_MS_WINDOWS) - install_pp="$blddir/lib-src/installexe.sh" - XE_APPEND(-lshell32 -lgdi32 -luser32 -lcomctl32, libs_system) - test "$with_dragndrop" != no && XE_APPEND(msw, dragndrop_proto) - if test "$window_system" != x11; then - window_system=msw - test "$with_scrollbars" != "no" && with_scrollbars=msw \ - && XE_ADD_OBJS(scrollbar-msw.o) - test "$with_menubars" != "no" && with_menubars=msw \ - && XE_ADD_OBJS(menubar-msw.o) - test "$with_toolbars" != "no" && with_toolbars=msw \ - && XE_ADD_OBJS(toolbar-msw.o) - test "$with_dialogs" != "no" && with_dialogs=msw \ - && XE_ADD_OBJS(dialog-msw.o) - else - test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-msw.o) - test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-msw.o) - test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar-msw.o) - test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog-msw.o) - fi - dnl check for our special version of select - AC_TRY_RUN([#include - int main() { return (open("/dev/windows", O_RDONLY, 0) > 0)? 0 : 1; }], - [AC_DEFINE(HAVE_MSG_SELECT)]) - const_is_losing=no - with_file_coding=yes - use_minimal_tagbits=yes - use_indexed_lrecord_implementation=yes - XE_ADD_OBJS(console-msw.o device-msw.o event-msw.o frame-msw.o objects-msw.o select-msw.o redisplay-msw.o glyphs-msw.o gui-msw.o) - fi -fi - -AC_SUBST(install_pp) - -test -z "$window_system" && window_system="none" - -dnl Test for features that require a window system - ANY window system -if test "$window_system" = "none"; then - for feature in menubars scrollbars toolbars dialogs dragndrop xface - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - AC_MSG_WARN([--with-$feature ignored: Not valid without window system support]) - fi - eval "with_${feature}=no" - done -else - test -z "$with_toolbars" && with_toolbars=yes -fi - -dnl ### Test for features that require mswindows support - currently none -dnl ### MS-Windows folks: add code here..... (martin) -if test "$with_msw" != "yes"; then - for feature in MARTIN_IS_CLUELESS_ABOUT_MSW_FEATURES - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - AC_MSG_WARN([--with-$feature ignored: Not valid without MS-Windows support]) - fi - eval "with_${feature}=no" - done -else - : -fi - -dnl Test for features that require X11 support -if test "$with_x11" != "yes"; then - dnl It ought to be reasonable to have no output device at all, and only use - dnl XEmacs in --batch mode. - dnl if test "$with_tty" = "no" ; then - dnl AC_MSG_ERROR([No window system support and no TTY support - Unable to proceed.]) - dnl fi - for feature in tooltalk cde offix session xim xmu - do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - AC_MSG_WARN([--with-$feature ignored: Not valid without X support]) - fi - eval "with_${feature}=no" - done -fi - -dnl FSF 19.29 has some bitmapdir stuff here. -bitmapdir= - -case "$window_system" in - x11 ) HAVE_X_WINDOWS=yes; echo " Using X11." ;; - msw ) HAVE_X_WINDOWS=no ; echo " Using MS-Windows." ;; - none ) HAVE_X_WINDOWS=no ; echo " Using no window system." ;; -esac - -case "$x_libraries" in *X11R4* ) - test "$opsys" = "hpux9" && opsysfile="s/hpux9-x11r4.h" - test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" -esac - -dnl Enable or disable proper session-management -AC_CHECKING(for session-management option); -dnl if test "$with_session" = "yes"; then -if test "$with_session" != "no"; then - AC_DEFINE(HAVE_SESSION) -fi - -dnl Autodetect Xauth -dnl -lXau is only used by gnuclient, so use a special variable for Xauth X libs -test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no -test -z "$with_xauth" && { AC_CHECK_HEADER(X11/Xauth.h, ,with_xauth=no) } -test -z "$with_xauth" && { AC_CHECK_LIB(Xau, XauGetAuthByAddr,[:],with_xauth=no) } -test -z "$with_xauth" && with_xauth=yes -if test "$with_xauth" = "yes"; then - AC_DEFINE(HAVE_XAUTH) - XE_SPACE(libs_xauth, $X_EXTRA_LIBS -lXau $libs_x $X_PRE_LIBS) -fi -AC_SUBST(libs_xauth) - -dnl This one is for the static initializeds variables in -dnl offix.c, so that the thing is dumped after lastfile.o -AC_SUBST(dnd_objs) - -dnl Autodetect tooltalk -if test "$with_tooltalk" != "no" ; then - dnl autodetect the location of tt_c.h - dnl tt_c.h might be in Tt or desktop include directories - for dir in "" "Tt/" "desktop/" ; do - AC_CHECK_HEADER(${dir}tt_c.h, tt_c_h_path="${dir}tt_c.h"; break) - done - if test -z "$tt_c_h_path"; then - if test "$with_tooltalk" = "yes"; then - USAGE_ERROR("Unable to find required tooltalk header files.") - fi - with_tooltalk=no - fi -fi -if test "$with_tooltalk" != "no" ; then - for extra_libs in "" "-lI18N -lce" "-lcxx"; do - AC_CHECK_LIB(tt, tt_message_create, - tt_libs="-ltt $extra_libs"; break, [:],$extra_libs) - done - if test -z "$tt_libs"; then - if test "$with_tooltalk" = "yes"; then - USAGE_ERROR("Unable to find required tooltalk libraries.") - fi - with_tooltalk=no - fi -fi -test -z "$with_tooltalk" && with_tooltalk=yes -if test "$with_tooltalk" = "yes"; then - AC_DEFINE(TOOLTALK) - AC_DEFINE_UNQUOTED(TT_C_H_PATH, "$tt_c_h_path") - XE_PREPEND($tt_libs, libs_x) - XE_ADD_OBJS(tooltalk.o) -fi - -dnl Autodetect CDE -test -z "$with_cde" && { AC_CHECK_HEADER(Dt/Dt.h, , with_cde=no) } -test -z "$with_cde" && { AC_CHECK_LIB(DtSvc, DtDndDragStart, [:], with_cde=no) } -test -z "$with_cde" && with_cde=yes -if test "$with_dragndrop" = no; then - AC_MSG_WARN([No CDE without generic Drag'n'Drop support]) - with_cde=no -fi -if test "$with_cde" = "yes" ; then - AC_DEFINE(HAVE_CDE) - XE_PREPEND(-lDtSvc, libs_x) - XE_APPEND(CDE, dragndrop_proto) - with_tooltalk=yes # CDE requires Tooltalk - need_motif=yes # CDE requires Motif -fi - -dnl Always compile OffiX unless --without-offix is given, no -dnl X11 support is compiled in, no standard Xmu is available, -dnl or dragndrop support is disabled -dnl Because OffiX support currently loses when more than one display -dnl is in use, we now disable it by default -slb 07/10/1998. -test "$window_system" != "x11" && with_offix=no -if test "$with_xmu" != yes -a "$with_x11" = yes; then - AC_MSG_WARN([No OffiX without real Xmu support]) - with_offix=no -fi -if test "$with_dragndrop" = no; then - AC_MSG_WARN([No OffiX without generic Drag'n'Drop support]) - with_offix=no -fi -if test "$with_cde" = yes; then - AC_MSG_WARN([CDE already found, disabling OffiX support]) - with_offix=no -fi -test -z "$with_offix" && with_offix=no -if test "$with_offix" = "yes"; then - AC_DEFINE(HAVE_OFFIX_DND) - XE_APPEND(offix.o, dnd_objs) - XE_APPEND(OffiX, dragndrop_proto) -fi - -dnl Autodetect Drag'n'Drop support -dnl always included if CDE, Offix, or MSWindows are defined -AC_MSG_CHECKING(if drag and drop API is needed) -if test "$with_dragndrop" != "no" ; then - if test -n "$dragndrop_proto" ; then - with_dragndrop=yes - AC_MSG_RESULT([yes (${dragndrop_proto} )]) - AC_DEFINE(HAVE_DRAGNDROP) - XE_APPEND(dragdrop.o, extra_objs) - else - with_dragndrop=no - AC_MSG_RESULT(no) - fi -fi - -dnl Autodetect LDAP -AC_CHECKING(for LDAP) -test -z "$with_ldap" && { AC_CHECK_HEADER(ldap.h, ,with_ldap=no) } -test -z "$with_ldap" && { AC_CHECK_HEADER(lber.h, ,with_ldap=no) } -if test "$with_ldap" != "no"; then - test -z "$with_umich_ldap" && { AC_CHECK_LIB(ldap, ldap_open, with_umich_ldap=yes, with_umich_ldap=no, -llber) } - test "$with_umich_ldap" = "no" && { AC_CHECK_LIB(ldap10, ldap_set_option, with_ns_ldap=yes, with_ns_ldap=no) } - test -z "$with_ldap" -a \( "$with_umich_ldap" = "yes" -o "$with_ns_ldap" = "yes" \) && with_ldap=yes -fi -if test "$with_ldap" = "yes"; then - AC_DEFINE(HAVE_LDAP) - XE_ADD_OBJS(eldap.o) - if test "$with_umich_ldap" = "yes" ; then - AC_DEFINE(HAVE_UMICH_LDAP) - XE_PREPEND(-llber, LIBS) - XE_PREPEND(-lldap, LIBS) - elif test "$with_ldap" = "yes" -a "$with_ns_ldap" = "yes" ; then - AC_DEFINE(HAVE_NS_LDAP) - XE_PREPEND(-lldap10, LIBS) - elif test "$with_ldap" = "yes" ; then - XE_PREPEND(-lldap, LIBS) - fi -fi - -dnl ---------------------- -dnl Graphics libraries -dnl ---------------------- - -if test "$window_system" != "none"; then - AC_CHECKING(for graphics libraries) - - dnl Autodetect Xpm - xpm_problem="" - if test -z "$with_xpm"; then - AC_MSG_CHECKING(for Xpm - no older than 3.4f) - xe_check_libs=-lXpm - AC_TRY_RUN([#include - int main(int c, char **v) { - return c == 1 ? 0 : - XpmIncludeVersion != XpmLibraryVersion() ? 1 : - XpmIncludeVersion < 30406 ? 2 : 0 ;}], - [./conftest dummy_arg; xpm_status=$?; - if test "$xpm_status" = "0"; then - with_xpm=yes; - else - with_xpm=no; - if test "$xpm_status" = "1"; then - xpm_problem="Xpm library version and header file version don't match!" - elif test "$xpm_status" = "2"; then - xpm_problem="Xpm library version is too old!" - else - xpm_problem="Internal xpm detection logic error!" - fi - echo " -*** WARNING *** $xpm_problem - I'm not touching that with a 10-foot pole! - If you really want to use the installed version of Xpm, rerun - configure and add '--with-xpm=yes', but don't blame me if XEmacs crashes!" - fi], - [with_xpm=no]) - xe_check_libs= - AC_MSG_RESULT($with_xpm) - fi - if test "$with_xpm" = "yes"; then - AC_DEFINE(HAVE_XPM) - XE_PREPEND(-lXpm, libs_x) - AC_MSG_CHECKING(for \"FOR_MSW\" xpm) - xe_check_libs=-lXpm - AC_TRY_LINK(, [XpmCreatePixmapFromData()], - [xpm_for_msw=no], - [xpm_for_msw=yes]) - xe_check_libs= - AC_MSG_RESULT($xpm_for_msw) - if test "$xpm_for_msw" = "yes"; then - AC_DEFINE(FOR_MSW) - fi - fi - - dnl Autodetect XFACE - test -z "$with_xface" && { AC_CHECK_HEADER(compface.h, ,with_xface=no) } - test -z "$with_xface" && { AC_CHECK_LIB(compface, UnGenFace,[:] ,with_xface=no) } - test -z "$with_xface" && with_xface=yes - if test "$with_xface" = "yes"; then - AC_DEFINE(HAVE_XFACE) - XE_PREPEND(-lcompface, libs_x) - fi - - dnl For a brief period we had the GIF code split out into a separate library, - dnl but patent problems, etc. sort of squashed that idea. - dnl We default to building with builtin GIF decoding - if test "$with_gif" != "no"; then - with_gif="yes" - AC_DEFINE(HAVE_GIF) - XE_ADD_OBJS(dgif_lib.o gif_io.o) - fi - - dnl Too many stupid linkers can't detect cascaded lib dependencies until runtime - dnl So we always search for libz compression support. - if test "$with_png $with_tiff" != "no no"; then - AC_CHECK_LIB(c, inflate, [:], [ - AC_CHECK_LIB(z, inflate, [XE_PREPEND(-lz, libs_x)],[ - AC_CHECK_LIB(gz, inflate, [XE_PREPEND(-lgz, libs_x)])])]) - fi - - dnl autodetect JPEG - test -z "$with_jpeg" && { AC_CHECK_HEADER(jpeglib.h, ,with_jpeg=no) } - test -z "$with_jpeg" && { AC_CHECK_LIB(jpeg, jpeg_destroy_decompress,[:],with_jpeg=no) } - test -z "$with_jpeg" && with_jpeg=yes - if test "$with_jpeg" = "yes"; then - AC_DEFINE(HAVE_JPEG) - XE_PREPEND(-ljpeg, libs_x) - fi - - dnl autodetect PNG - png_problem="" - test -z "$with_png" && { AC_CHECK_FUNC(pow, ,with_png=no) } - test -z "$with_png" && { AC_CHECK_HEADER(png.h, ,with_png=no) } - test -z "$with_png" && { AC_CHECK_LIB(png, png_read_image,[:],with_png=no) } - if test -z "$with_png"; then - AC_MSG_CHECKING(for workable png version information) - xe_check_libs="-lpng -lz" - AC_TRY_RUN([#include - int main(int c, char **v) { - if (c == 1) return 0; - if (strcmp(png_libpng_ver, PNG_LIBPNG_VER_STRING) != 0) return 1; - return (PNG_LIBPNG_VER < 10002) ? 2 : 0 ;}], - [./conftest dummy_arg; png_status=$?; - if test "$png_status" = "0"; then - with_png=yes; - else - with_png=no; - if test "$png_status" = "1"; then - png_problem="PNG library version and header file don't match!" - elif test "$png_status" = "2"; then - png_problem="PNG library version too old (pre 1.0.2)!" - fi - echo " -*** WARNING *** $png_problem - I'm not touching that with a 10-foot pole! - If you really want to use the installed version of libPNG, rerun - configure and add '--with-png=yes', but don't blame me if XEmacs crashes!" - fi], - [with_png=no]) - xe_check_libs= - AC_MSG_RESULT($with_png) - fi - if test "$with_png" = "yes"; then - AC_DEFINE(HAVE_PNG) - XE_PREPEND(-lpng, libs_x) - fi - - dnl autodetect TIFF - test -z "$with_tiff" && { AC_CHECK_HEADER(tiffio.h, ,with_tiff=no) } - test -z "$with_tiff" && { AC_CHECK_LIB(tiff, TIFFClientOpen,[:],with_tiff=no) } - test -z "$with_tiff" && with_tiff=yes - if test "$with_tiff" = "yes"; then - AC_DEFINE(HAVE_TIFF) - XE_PREPEND(-ltiff, libs_x) - fi -fi - -dnl ---------------------- -dnl X-Specific Graphics libraries -dnl ---------------------- - -if test "$with_x11" = "yes"; then - - AC_CHECKING(for X11 graphics libraries) - - dnl Autodetect -lXaw - AC_CHECK_LIB(Xaw, XawScrollbarSetThumb, have_xaw=yes, have_xaw=no) - dnl if test "$have_xaw" = "yes"; then - dnl AC_CHECK_HEADER(X11/Xaw/Reports.h, [ - dnl XE_APPEND(pkg-src/tree-x, MAKE_SUBDIR) - dnl XE_APPEND(pkg-src/tree-x, INSTALL_ARCH_DEP_SUBDIR)]) - dnl fi - - dnl autodetect Motif - but only add to libs_x later (if necessary) - AC_CHECK_HEADER(Xm/Xm.h, - [AC_CHECK_LIB(Xm, XmStringFree, have_motif=yes, have_motif=no)], - have_motif=no) - - if test "$have_motif" = "yes"; then - dnl autodetect lesstif - AC_MSG_CHECKING(for Lesstif) - AC_EGREP_CPP(yes, -[#include -#ifdef LESSTIF_VERSION -yes -#endif -], have_lesstif=yes, have_lesstif=no) - AC_MSG_RESULT($have_lesstif) - fi - -fi dnl "$with_x11" = "yes" - -dnl Finish ensuring that we have values for the various toolkit items. -dnl Not all toolkits support all widgets -dnl if Motif is available we use it for the dialog boxes. - -case "$with_menubars" in "" | "yes" | "athena" | "athena3d" ) - with_menubars="lucid" ;; -esac -case "$with_dialogs" in "" | "yes" | "lucid" ) - if test "$have_motif" = "yes"; then with_dialogs="motif" - elif test "$have_xaw" = "yes"; then with_dialogs="athena" - else with_dialogs=no - fi ;; -esac -case "$with_scrollbars" in "" | "yes" ) - with_scrollbars="lucid" ;; -esac - -all_widgets="$with_menubars $with_scrollbars $with_dialogs $with_toolbars" - -case "$all_widgets" in *athena* ) - AC_DEFINE(LWLIB_USES_ATHENA) - AC_DEFINE(NEED_ATHENA) - XE_APPEND(lwlib-Xaw.o, lwlib_objs) - XE_PREPEND(-lXaw, libs_x) ;; -esac - -case "$all_widgets" in *motif* ) - AC_DEFINE(LWLIB_USES_MOTIF) - AC_DEFINE(NEED_MOTIF) - XE_APPEND(lwlib-Xm.o, lwlib_objs) - need_motif=yes ;; -esac - -test "$with_menubars" = "lucid" && XE_APPEND(xlwmenu.o, lwlib_objs) -test "$with_menubars" = "motif" && XE_APPEND(xlwmenu.o, lwlib_objs) -test "$with_scrollbars" = "lucid" && XE_APPEND(xlwscrollbar.o, lwlib_objs) -case "$all_widgets" in *lucid* ) - AC_DEFINE(NEED_LUCID) - XE_APPEND(lwlib-Xlw.o, lwlib_objs) ;; -esac - -AC_SUBST(lwlib_objs) - -case "$with_scrollbars" in athena* ) AC_DEFINE(LWLIB_SCROLLBARS_ATHENA);; esac -case "$with_dialogs" in athena* ) AC_DEFINE(LWLIB_DIALOGS_ATHENA) ;; esac -test "$with_scrollbars" = "athena3d" && AC_DEFINE(LWLIB_SCROLLBARS_ATHENA3D) -test "$with_dialogs" = "athena3d" && AC_DEFINE(LWLIB_DIALOGS_ATHENA3D) - -test "$with_menubars" != "no" && AC_DEFINE(HAVE_MENUBARS) -test "$with_scrollbars" != "no" && AC_DEFINE(HAVE_SCROLLBARS) -test "$with_dialogs" != "no" && AC_DEFINE(HAVE_DIALOGS) -test "$with_toolbars" != "no" && AC_DEFINE(HAVE_TOOLBARS) - -test "$with_menubars" = "lucid" && AC_DEFINE(LWLIB_MENUBARS_LUCID) -test "$with_scrollbars" = "lucid" && AC_DEFINE(LWLIB_SCROLLBARS_LUCID) - -test "$with_menubars" = "motif" && AC_DEFINE(LWLIB_MENUBARS_MOTIF) -test "$with_scrollbars" = "motif" && AC_DEFINE(LWLIB_SCROLLBARS_MOTIF) -test "$with_dialogs" = "motif" && AC_DEFINE(LWLIB_DIALOGS_MOTIF) - -test "$with_menubars" != "no" && XE_ADD_OBJS(menubar.o) -test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar.o) -test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog.o) -test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar.o) - -if test "$with_x11" = "yes"; then - test "$with_menubars" != "no" && XE_ADD_OBJS(menubar-x.o) - test "$with_scrollbars" != "no" && XE_ADD_OBJS(scrollbar-x.o) - test "$with_dialogs" != "no" && XE_ADD_OBJS(dialog-x.o) - test "$with_toolbars" != "no" && XE_ADD_OBJS(toolbar-x.o) - test "$all_widgets" != "no no no no" && XE_ADD_OBJS(gui-x.o) -else - if test \( "$with_sound" = "nas" \) -o \( "$with_sound" = "both" \); then - echo "Attempt to Build NAS sound without X" - echo "Please remove NAS configuration or build with X" - exit 1 - fi -fi - -test "$use_minimal_tagbits" = "yes" && AC_DEFINE(USE_MINIMAL_TAGBITS) -test "$use_indexed_lrecord_implementation" = "yes" && \ - AC_DEFINE(USE_INDEXED_LRECORD_IMPLEMENTATION) - -dnl ---------------------- -dnl Mule-dependent options -dnl ---------------------- - -test -z "$with_mule" && with_mule=no -test -z "$with_file_coding" && with_file_coding=no - -dnl if test "$with_mule" = "yes" && test ! -d "$srcdir/lisp/mule"; then -dnl echo "Attempt to Build with Mule without Mule/Lisp" -dnl echo "Please install the XEmacs/Mule tarball or" -dnl echo "rerun configure with --with-mule=no" -dnl exit 1 -dnl fi - -if test "$with_file_coding" = "yes" && test "$with_mule" = "no"; then - AC_DEFINE(FILE_CODING) - XE_ADD_OBJS(file-coding.o) -fi - -if test "$with_mule" = "yes" ; then - AC_CHECKING(for Mule-related features) - AC_DEFINE(MULE) - AC_DEFINE(FILE_CODING) - XE_ADD_OBJS(mule.o mule-ccl.o mule-charset.o mule-coding.o file-coding.o) - - dnl Use -lintl to get internationalized strerror for Mule - AC_CHECK_HEADERS(libintl.h) - AC_CHECK_LIB(intl, strerror) - - AC_CHECKING(for Mule input methods) - dnl Do we have the XmIm* routines? And if so, do we want to use them? - dnl XIM seems to be flaky except on Solaris... - dnl test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no - case "$with_xim" in "" | "yes" ) - AC_CHECKING(for XIM) - AC_CHECK_LIB(X11, XOpenIM, with_xim=xlib, with_xim=no) - dnl XIM + Lesstif is not (yet?) usable - if test "$have_motif $have_lesstif" = "yes no"; then - AC_CHECK_LIB(Xm, XmImMbLookupString, with_xim=motif) - fi ;; - esac - if test "$with_xim" != "no"; then - AC_DEFINE(HAVE_XIM) - if test "$with_xim" = "xlib"; then - AC_DEFINE(XIM_XLIB) - XE_ADD_OBJS(input-method-xlib.o) - fi - if test "$with_xim" = "motif"; then - AC_DEFINE(XIM_MOTIF) - need_motif=yes - XE_ADD_OBJS(input-method-motif.o) - fi - if test "$with_xim" = "motif"; then - with_xfs=no - fi - fi - - dnl "with_xfs" = "yes" - if test "$with_xfs" = "yes" ; then - AC_CHECKING(for XFontSet) - AC_CHECK_LIB(X11, XmbDrawString, [:], with_xfs=no) - if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then - AC_DEFINE(USE_XFONTSET) - if test "$with_xim" = "no" ; then - XE_ADD_OBJS(input-method-xfs.o) - fi - fi - fi dnl with_xfs - - dnl Autodetect WNN - test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support - test -z "$with_wnn" && { AC_CHECK_HEADER(wnn/jllib.h, ,with_wnn=no) } - dnl Detour to find crypt - if test "$with_wnn" != "no"; then - AC_CHECK_FUNCS(crypt) - test "$ac_cv_func_crypt" != "yes" && { AC_CHECK_LIB(crypt, crypt) } - fi - dnl Back to our regularly scheduled wnn hunting - if test -z "$with_wnn" -o "$with_wnn" = "yes"; then - AC_CHECK_LIB(wnn,jl_dic_list_e,libwnn=wnn, - AC_CHECK_LIB(wnn4,jl_dic_list_e,libwnn=wnn4, - AC_CHECK_LIB(wnn6,jl_dic_list_e,libwnn=wnn6, - AC_CHECK_LIB(wnn6_fromsrc,dic_list_e,libwnn=wnn6_fromsrc,with_wnn=no)))) - fi - test -z "$with_wnn" && with_wnn=yes - if test "$with_wnn" = "yes"; then - AC_DEFINE(HAVE_WNN) - XE_PREPEND(-l$libwnn, libs_x) - XE_ADD_OBJS(mule-wnnfns.o) - if test "$with_wnn6" != "no"; then - AC_CHECK_LIB($libwnn, jl_fi_dic_list, with_wnn6=yes) - test "$with_wnn6" = "yes" && AC_DEFINE(WNN6) - fi - fi - - dnl Autodetect canna - canna_includes_found=no - if test "$with_canna" != "no"; then - AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes) - fi - if test "$canna_includes_found" = "no" -a "$with_canna" != "no" -a \ - -d "/usr/local/canna/include"; then - save_c_switch_site="$c_switch_site" - c_switch_site="$c_switch_site -I/usr/local/canna/include" - AC_CHECK_HEADER(canna/jrkanji.h,canna_includes_found=yes) - if test "$canna_includes_found" != "yes"; then - c_switch_site="$save_c_switch_site" - with_canna="no" - fi - fi - - test -z "$with_canna" && { AC_CHECK_HEADER(canna/RK.h, , with_canna=no) } - test -z "$with_canna" && { AC_CHECK_LIB(RKC, RkBgnBun, [:],with_canna=no) } - test -z "$with_canna" && { AC_CHECK_LIB(canna,jrKanjiControl,[:],with_canna=no) } - test -z "$with_canna" && with_canna=yes - if test "$with_canna" = "yes"; then - AC_DEFINE(HAVE_CANNA) - XE_PREPEND(-lcanna -lRKC, libs_x) - XE_ADD_OBJS(mule-canna.o) - fi - -else dnl "$with_mule" = "no" - for feature in xim canna wnn; do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - AC_MSG_WARN("--with-${feature} ignored: Not valid without Mule support") - fi - eval "with_${feature}=no" - done -fi dnl with_mule - - -dnl At this point, we know whether we need the motif lib or not. -if test "$need_motif" = "yes" ; then - XE_PREPEND(-lXm, libs_x) - dnl AIX needs the following library for use with Motif - AC_CHECK_LIB(i18n, layout_object_getvalue, [XE_PREPEND(-li18n, libs_x)]) - XE_COMPUTE_RUNPATH() -fi - -AC_CHECK_FUNCS(cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask snprintf strcasecmp strerror tzset ulimit usleep utimes waitpid vsnprintf) - -dnl realpath is buggy on linux, decosf and aix4 - -dnl The realpath() in linux libc (4.6.27) sometimes fails with ELOOP. -dnl The realpath in ELF linux libc's is O.K. -dnl For example, call realpath on a file thirty-five or so directories deep -dnl and you get ELOOP even if no symlinks at all are involved. -dnl Reports as of 11/1997 indicate BSDi has problems too. -dnl The realpath() in UnixWare2.1.3 could not get any pathname fragment in error condition. -case "$opsys" in - linuxaout* | bsdos3* | freebsd* | decosf4-0* | aix4* ) XE_ADD_OBJS(realpath.o) ;; - * ) - case "$canonical" in - *-*-sysv4.2uw2* ) XE_ADD_OBJS(realpath.o) ;; - * ) AC_CHECK_FUNCS(realpath) - test "$ac_cv_func_realpath" != "yes" && XE_ADD_OBJS(realpath.o) ;; - esac ;; -esac - -dnl If netdb.h does not declare h_errno, we must declare it by hand. -AC_MSG_CHECKING(whether netdb declares h_errno) -AC_TRY_LINK([#include ], - [return h_errno;], - [AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_H_ERRNO)], - [AC_MSG_RESULT(no)]) - -AC_MSG_CHECKING(for sigsetjmp) -AC_TRY_COMPILE([#include ], - [sigjmp_buf bar; sigsetjmp (bar, 0);], - [AC_MSG_RESULT(yes) - AC_DEFINE(HAVE_SIGSETJMP)], - [AC_MSG_RESULT(no)]) - -AC_MSG_CHECKING(whether localtime caches TZ) -AC_CACHE_VAL(emacs_cv_localtime_cache, -[if test "$ac_cv_func_tzset" = "yes"; then -AC_TRY_RUN([#include -#if STDC_HEADERS -# include -#endif -extern char **environ; -unset_TZ () -{ - char **from, **to; - for (to = from = environ; (*to = *from); from++) - if (! (to[0][0] == 'T' && to[0][1] == 'Z' && to[0][2] == '=')) - to++; -} -char TZ_GMT0[] = "TZ=GMT0"; -char TZ_PST8[] = "TZ=PST8"; -main() -{ - time_t now = time ((time_t *) 0); - int hour_GMT0, hour_unset; - if (putenv (TZ_GMT0) != 0) - exit (1); - hour_GMT0 = localtime (&now)->tm_hour; - unset_TZ (); - hour_unset = localtime (&now)->tm_hour; - if (putenv (TZ_PST8) != 0) - exit (1); - if (localtime (&now)->tm_hour == hour_GMT0) - exit (1); - unset_TZ (); - if (localtime (&now)->tm_hour != hour_unset) - exit (1); - exit (0); -}], emacs_cv_localtime_cache=no, emacs_cv_localtime_cache=yes, -[# If we have tzset, assume the worst when cross-compiling. -emacs_cv_localtime_cache=yes]) -else - # If we lack tzset, report that localtime does not cache TZ, - # since we can't invalidate the cache if we don't have tzset. - emacs_cv_localtime_cache=no -fi],[:])dnl -AC_MSG_RESULT($emacs_cv_localtime_cache) -if test $emacs_cv_localtime_cache = yes; then - AC_DEFINE(LOCALTIME_CACHE) -fi - -if test "$HAVE_TIMEVAL" = "yes"; then -AC_MSG_CHECKING(whether gettimeofday accepts one or two arguments) -AC_TRY_LINK([ -#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif - ], - [ - struct timeval time; - struct timezone dummy; - gettimeofday (&time, &dummy); -], - [AC_MSG_RESULT(two)], - [AC_MSG_RESULT(one) - AC_DEFINE(GETTIMEOFDAY_ONE_ARGUMENT)]) -fi - - -AC_C_INLINE -if test "$ac_cv_c_inline" != "no"; then - AC_DEFINE(HAVE_INLINE) - test "$GCC" = "yes" && XE_ADD_OBJS(inline.o) -fi - -dnl HP-UX has a working alloca in libPW. -dnl case "${GCC}${opsys}" in hpux* ) -dnl AC_CHECK_FUNC(alloca, [:], [AC_CHECK_LIB(PW, alloca)]) -dnl esac - -AC_FUNC_ALLOCA -test -n "$ALLOCA" && XE_ADD_OBJS($ALLOCA) - -dnl Check whether vfork exists and works correctly. (This does more -dnl than just check for its existence.) If so, it defines HAVE_VFORK_H. -dnl If not, it defines vfork to be fork. -AC_FUNC_VFORK - -dnl Check whether strcoll exists and works correctly. (This does more -dnl than just check for its existence.) If so, it defines HAVE_STRCOLL. -AC_FUNC_STRCOLL - -dnl If `getpgrp' takes no argument (the POSIX.1 version), define -dnl `GETPGRP_VOID'. Otherwise, it is the BSD version, which takes a -dnl process ID as an argument. -AC_CHECK_FUNCS(getpgrp) -AC_FUNC_GETPGRP - -dnl We used to call AC_FUNC_MMAP here -dnl Instead we now use following, suggested by Neal Becker -AC_MSG_CHECKING(for working mmap) -case "$opsys" in ultrix* ) have_mmap=no ;; *) -AC_TRY_RUN([#include -#include -#include -#include - -#ifndef MAP_VARIABLE -#define MAP_VARIABLE 0 -#endif - -#ifndef MAP_FAILED -#define MAP_FAILED -1 -#endif - -int main (int argc, char *argv[]) -{ - int fd = -1; - caddr_t p; -#ifndef MAP_ANONYMOUS - fd = open ("/dev/zero", O_RDWR); - if (fd < 0) - return 1; -#define MAP_ANONYMOUS 0 -#endif - if (mmap(0, 1024, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_VARIABLE | MAP_ANONYMOUS, - fd, 0) != (void *) MAP_FAILED) - return 0; - perror ("conftest: mmap failed"); - return 1; -}], have_mmap=yes, have_mmap=no) ;; -esac -AC_MSG_RESULT($have_mmap) -test "$have_mmap" = "yes" && AC_DEFINE(HAVE_MMAP) -AC_FUNC_MMAP - -dnl rel_alloc requires either GNU malloc or system malloc with mmap -dnl We only turn rel_alloc on by default if mmap is available. -test "$GNU_MALLOC" != "yes" -a "$have_mmap" != "yes" && rel_alloc=no -test "$rel_alloc" = "default" -a "$have_mmap" = "yes" && rel_alloc=yes -test "$rel_alloc" = "yes" && AC_DEFINE(REL_ALLOC) - -dnl Check for terminal I/O variants -dnl TERMIOS systems may have termio.h, but not vice-versa, I think. -AC_CHECK_HEADER(termios.h, - AC_DEFINE(HAVE_TERMIOS) - AC_DEFINE(SIGNALS_VIA_CHARACTERS) - AC_DEFINE(NO_TERMIO), - [AC_CHECK_HEADER(termio.h, [AC_DEFINE(HAVE_TERMIO)])]) - - -dnl Check for Internet sockets. -AC_CHECK_FUNC(socket, - [AC_CHECK_HEADER(netinet/in.h, - [AC_CHECK_HEADER(arpa/inet.h, [ - AC_DEFINE(HAVE_SOCKETS) - AC_MSG_CHECKING("for sun_len member in struct sockaddr_un") - AC_TRY_LINK([ -#include -#include -#include - ], - [static struct sockaddr_un x; x.sun_len = 1;], - [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_SOCKADDR_SUN_LEN)], - [AC_MSG_RESULT(no)]) - AC_MSG_CHECKING("for ip_mreq struct in netinet/in.h") - AC_TRY_LINK([ -#include -#include - ], - [static struct ip_mreq x;], - [AC_MSG_RESULT(yes); AC_DEFINE(HAVE_MULTICAST)], - [AC_MSG_RESULT(no)])])])]) - -dnl Check for SYS V IPC. (Inferior to sockets.) -AC_CHECK_FUNC(msgget, - [AC_CHECK_HEADER(sys/ipc.h, - [AC_CHECK_HEADER(sys/msg.h, - [AC_DEFINE(HAVE_SYSVIPC)])])]) - -dnl Check for directory variants -AC_CHECK_HEADER(dirent.h, [AC_DEFINE(SYSV_SYSTEM_DIR)], - [AC_CHECK_HEADER(sys/dir.h, , [AC_DEFINE(NONSYSTEM_DIR_LIBRARY)])]) - -dnl Check for nlist.h -AC_CHECK_HEADER(nlist.h, AC_DEFINE(NLIST_STRUCT), ) - -dnl Check for sound of various sorts. - -dnl Autodetect native sound -AC_CHECKING("for sound support") -case "$with_sound" in - native | both ) with_native_sound=yes;; - nas | no ) with_native_sound=no;; -esac -test -z "$with_native_sound" -a -n "$native_sound_lib" && with_native_sound=yes - -if test "$with_native_sound" != "no"; then - dnl Maybe sound is already on include path... - if test -n "$native_sound_lib"; then - AC_CHECK_HEADER(multimedia/audio_device.h, - [sound_found=yes sound_cflags="" - XE_ADD_OBJS(sunplay.o)]) - fi - - dnl Autodetect Sun native sound from SUNWaudmo package - if test -z "$sound_found" -a -d "/usr/demo/SOUND"; then - sound_found=yes - XE_ADD_OBJS(sunplay.o) - if test -d "/usr/demo/SOUND/include" - then sound_cflags="-I/usr/demo/SOUND/include" - else sound_cflags="-I/usr/demo/SOUND" - fi - if test -z "$native_sound_lib" ; then - if test -r "/usr/demo/SOUND/lib/libaudio.a" - then native_sound_lib="/usr/demo/SOUND/lib/libaudio.a" - else native_sound_lib="/usr/demo/SOUND/libaudio.a" - fi - fi - fi - - dnl Check for SGI and HP native sound libs - if test -z "$sound_found"; then - case "$canonical" in - *-sgi-* ) - if test -z "$native_sound_lib"; then - AC_CHECK_LIB(audio, ALopenport, native_sound_lib="-laudio") - fi - if test -n "$native_sound_lib"; then - sound_found=yes sound_cflags="" - XE_ADD_OBJS(sgiplay.o) - fi ;; - hppa*-hp-hpux* ) - if test -z "$native_sound_lib"; then - AC_CHECK_LIB(Alib, AOpenAudio, native_sound_lib="-lAlib") - fi - if test -n "$native_sound_lib"; then - sound_found=yes - XE_ADD_OBJS(hpplay.o) - if test "$GCC" = "yes" # Kludge city - then sound_cflags="-Dconst= -Dvolatile= -I/usr/audio/examples" - else sound_cflags="+e -I/usr/audio/examples" - fi - fi ;; - esac - fi - - dnl Check for Linux/BSD native sound - if test -z "$sound_found"; then - for dir in "machine" "sys" "linux"; do - AC_CHECK_HEADER(${dir}/soundcard.h, - sound_found=yes - XE_ADD_OBJS(linuxplay.o) - [AC_DEFINE_UNQUOTED(SOUNDCARD_H_PATH, "${dir}/soundcard.h")] - break) - done - fi - - test "$sound_found" = "yes" && with_native_sound=yes -fi - -if test -z "$with_sound"; then - if test "$with_native_sound" = "yes" -o -n "$native_sound_lib"; then - with_sound=native - fi -fi - -if test "$with_native_sound" = "yes"; then - AC_DEFINE(HAVE_NATIVE_SOUND) - test -n "$native_sound_lib" && XE_PREPEND($native_sound_lib, LIBS) -fi - -case "$with_sound" in both | nas ) - AC_DEFINE(HAVE_NAS_SOUND) - XE_ADD_OBJS(nas.o) - XE_PREPEND(-laudio, libs_x) - dnl If the nas library does not contain the error jump point, - dnl then we force safer behavior. - AC_EGREP_HEADER(AuXtErrorJump,audio/Xtutil.h,,[AC_DEFINE(NAS_NO_ERROR_JUMP)]) -esac - -dnl --------------------- -dnl TTY-dependent options -dnl --------------------- - -test -z "$with_tty" && with_tty=yes - -if test "$with_tty" = "yes" ; then - AC_CHECKING(for TTY-related features) - AC_DEFINE(HAVE_TTY) - XE_ADD_OBJS(console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o) - - dnl Autodetect ncurses. - if test -z "$with_ncurses"; then - AC_CHECK_LIB(ncurses, tgetent, with_ncurses=yes, with_ncurses=no) - fi - if test "$with_ncurses" = "yes"; then - AC_DEFINE(HAVE_NCURSES) - AC_CHECK_HEADER(ncurses/curses.h, curses_h_path=ncurses/curses.h) - AC_CHECK_HEADER(ncurses/term.h, term_h_path=ncurses/term.h) - XE_ADD_OBJS(terminfo.o) - XE_PREPEND(-lncurses, LIBS) - - if test "$ac_cv_header_ncurses_curses_h" != "yes" ; then - dnl Try again, and check for the bogus ncurses/ include bug. - dnl (i.e. ncurses/curses.h bogusly includes instead of - dnl ) - save_c_switch_site="$c_switch_site" - c_switch_site="$c_switch_site -I/usr/include/ncurses" - AC_CHECK_HEADER(ncurses/curses.h, curses_h_path=ncurses/curses.h) - if test "$ac_cv_header_ncurses_curses_h" = "yes" - then AC_MSG_WARN("Your system has the bogus ncurses include bug.") - else c_switch_site="$save_c_switch_site" - fi - fi - else dnl "$with_ncurses" = "no" - dnl Autodetect terminfo/-lcurses/-ltermlib/-ltermcap - if test "$have_terminfo" = "yes"; then - XE_ADD_OBJS(terminfo.o) - if test -n "$libs_termcap"; then - XE_PREPEND($libs_termcap, LIBS) - else - for lib in curses termlib termcap; do - AC_CHECK_LIB($lib, tgetent, XE_PREPEND(-l${lib}, LIBS); break) - done - fi - else dnl "$have_terminfo" = "no" && "with_ncurses" = "no" - XE_ADD_OBJS(tparam.o) - dnl The HP-UX curses library seems to have a badly broken version of select(2) - dnl that makes "poll: interrupted system call" messages to appear and - dnl Emacs suprocesses to hang (e.g. TeX compilation w/ AUCTeX) */ - case "$opsys" in *-hp-hpux* ) libs_termcap="-ltermcap" ;; esac - if test -n "$libs_termcap"; then - XE_PREPEND($libs_termcap, LIBS) - else - AC_CHECK_LIB(curses, tgetent, XE_PREPEND(-lcurses, LIBS), - AC_CHECK_LIB(termcap, tgetent, XE_PREPEND(-ltermcap, LIBS), - XE_ADD_OBJS(termcap.o))) - fi - fi - fi - AC_DEFINE_UNQUOTED(CURSES_H_PATH, "${curses_h_path-curses.h}") - AC_DEFINE_UNQUOTED(TERM_H_PATH, "${term_h_path-term.h}") - - dnl Autodetect gpm - test -z "$with_gpm" && { AC_CHECK_HEADER(gpm.h, , with_gpm=no) } - test -z "$with_gpm" && { AC_CHECK_LIB(gpm, Gpm_Open, with_gpm=yes, with_gpm=no) } - if test "$with_gpm" = "yes"; then - AC_DEFINE(HAVE_GPM) - XE_ADD_OBJS(gpmevent.o) - XE_PREPEND(-lgpm, LIBS) - fi - -else dnl "$with_tty" = "no" - for feature in ncurses gpm; do - if eval "test -n \"\$with_${feature}\" -a \"\$with_${feature}\" != no" ; then - AC_MSG_WARN("--with-${feature} ignored: Not valid without TTY support") - fi - eval "with_${feature}=no" - done -fi dnl with_tty - -dnl Do we need event-unixoid.o ? -test "$with_x11" = "yes" -o "$with_tty" = "yes" && XE_ADD_OBJS(event-unixoid.o) - -dnl Database support -dnl We do not necessarily have to have libdb/lib(g)dbm for DB/(G)DBM support. -dnl On FreeBSD, both DB and DBM are part of libc. -dnl By default, we check for DBM support in libgdbm, then libc, then libdbm. - -test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ - != "no no no" && AC_CHECKING(for database support) - -dnl Check for ndbm.h, required for either kind of DBM support. -if test "$with_database_gnudbm $with_database_dbm" != "no no"; then - AC_CHECK_HEADER(ndbm.h, [:], [ - test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ - XE_DIE("Required DBM support cannot be provided.") - with_database_gnudbm=no with_database_dbm=no]) -fi - -dnl Check for DBM support in libgdbm. -if test "$with_database_gnudbm" != "no"; then - AC_CHECK_LIB(gdbm, dbm_open, [ - with_database_gnudbm=yes with_database_dbm=no libdbm=-lgdbm], [ - if test "$with_database_gnudbm" = "yes"; then - XE_DIE("Required GNU DBM support cannot be provided.") - fi - with_database_gnudbm=no]) -fi - -dnl Check for DBM support in libc and libdbm. -if test "$with_database_dbm" != "no"; then - AC_CHECK_FUNC(dbm_open, [with_database_dbm=yes libdbm=], [ - AC_CHECK_LIB(dbm, dbm_open, [with_database_dbm=yes libdbm=-ldbm], [ - test "$with_database_dbm" = "yes" && \ - XE_DIE("Required DBM support cannot be provided.") - with_database_dbm=no])]) -fi - -dnl Tell make about the DBM support we detected. -test -n "$libdbm" && XE_PREPEND("$libdbm", LIBS) -test "$with_database_gnudbm" = "yes" -o \ - "$with_database_dbm" = "yes" && \ - AC_DEFINE(HAVE_DBM) - -dnl Check for Berkeley DB. -if test "$with_database_berkdb" != "no"; then - AC_MSG_CHECKING(for Berkeley db.h) - for path in "db/db.h" "db.h"; do - AC_TRY_COMPILE([#ifdef HAVE_INTTYPES_H -#define __BIT_TYPES_DEFINED__ -#include -typedef uint8_t u_int8_t; -typedef uint16_t u_int16_t; -typedef uint32_t u_int32_t; -#ifdef WE_DONT_NEED_QUADS -typedef uint64_t u_int64_t; -#endif -#endif -#include <$path> -],[], db_h_path="$path"; break) - done - if test -z "$db_h_path" - then AC_MSG_RESULT(no); with_database_berkdb=no - else AC_MSG_RESULT($db_h_path) - fi - - if test "$with_database_berkdb" != "no"; then - AC_MSG_CHECKING(for Berkeley DB version) - AC_EGREP_CPP(yes, -[#include <$db_h_path> -#if DB_VERSION_MAJOR > 1 -yes -#endif -], [AC_MSG_RESULT(2); dbfunc=db_open], [AC_MSG_RESULT(1); dbfunc=dbopen]) - AC_CHECK_FUNC($dbfunc, with_database_berkdb=yes need_libdb=no, [ - AC_CHECK_LIB(db, $dbfunc, with_database_berkdb=yes need_libdb=yes)]) - fi - - if test "$with_database_berkdb" = "yes"; then - AC_DEFINE_UNQUOTED(DB_H_PATH, "$db_h_path") - AC_DEFINE(HAVE_BERKELEY_DB) - test "$need_libdb" = "yes" && XE_PREPEND(-ldb, LIBS) - else with_database_berkdb=no - fi -fi - -if test "$with_database_gnudbm $with_database_dbm $with_database_berkdb" \ - != "no no no"; then - AC_DEFINE(HAVE_DATABASE) - XE_ADD_OBJS(database.o) -fi - -dnl Socks support -if test "$with_socks" = "yes"; then - AC_CHECK_LIB(socks, SOCKSinit) - test -n "$ac_cv_lib_socks_SOCKSinit" && AC_DEFINE(HAVE_SOCKS) -fi - -dnl Usage tracking (undocumented and likely unused option) -if test "$usage_tracking" = "yes"; then - AC_DEFINE(USAGE_TRACKING) - XE_PREPEND(-Bstatic -lut -Bdynamic, LIBS) -fi - -dnl autodetect dll support -AC_CHECK_HEADERS(dlfcn.h, [have_dlfcn=yes - AC_DEFINE(HAVE_DLFCN_H)]) -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(dl, dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=dl; with_shlib=yes]) } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(c, _dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=; with_shlib=yes]) } -test -z "$with_shlib" && test ! -z "$have_dlfcn" && { AC_CHECK_LIB(c, dlopen, [ AC_DEFINE(HAVE_DLOPEN) DLL_LIB=; with_shlib=yes]) } -test -z "$with_shlib" && { AC_CHECK_LIB(dld, shl_load, [ AC_DEFINE(HAVE_SHL_LOAD) DLL_LIB=dld; with_shlib=yes]) } -test -z "$with_shlib" && { AC_CHECK_LIB(dld, dld_init, [ AC_DEFINE(HAVE_DLD_INIT) DLL_LIB=dld; with_shlib=yes]) } -if test "$with_shlib" = "yes"; then - XE_SHLIB_STUFF - if test "$can_build_shared" = "yes"; then - AC_DEFINE(HAVE_SHLIB) - XE_ADD_OBJS(sysdll.o) - XE_ADD_OBJS(emodules.o) - XE_APPEND(src, INSTALL_ARCH_DEP_SUBDIR) - test ! -z "$DLL_LIB" && XE_PREPEND(-l${DLL_LIB}, LIBS) - AC_CHECK_FUNCS(dlerror _dlerror) - else - AC_MSG_WARN(disabling shared library support) - with_shlib=no - fi -fi - -dnl Unfortunately, just because we can link doesn't mean we can run. -dnl One of the above link tests may have succeeded but caused resulting -dnl executables to fail to run. Also any tests using AC_TRY_RUN will -dnl have reported incorrect results. -AC_TRY_RUN([int main(int c,char *v[]){return 0;}],[:],[ - echo "" - echo "*** PANIC *** The C compiler can no longer build working executables." - echo "*** PANIC *** Please examine the tail of config.log for runtime errors." - echo "*** PANIC *** The most likely reason for this problem is that configure" - echo "*** PANIC *** links with shared libraries, but those libraries cannot be" - echo "*** PANIC *** found at run time." - echo "*** PANIC ***" - echo "*** PANIC *** On a Linux system, edit /etc/ld.so.conf and re-run ldconfig." - echo "*** PANIC *** On other systems, try telling configure where to find the" - echo "*** PANIC *** shared libraries using the --site-runtime-libraries option" - echo "*** PANIC ***" - echo "*** PANIC *** Another way to shoot yourself in the foot is to specify" - echo "*** PANIC *** --with-FEATURE when FEATURE is not actually installed" - echo "*** PANIC *** on your system. Don't do that." - exit 1]) - -dnl Process support (hardcoded) -dnl every system that supports this runs configure, the others don't - -dnl We're not ready for this yet. -AC_DEFINE(HAVE_UNIX_PROCESSES) -XE_ADD_OBJS(process-unix.o) - -dnl -------------------------------- -dnl Compute SUBST-itutable variables -dnl -------------------------------- - -dnl We ignore (C|LD)_SWITCH_X_(MACHINE|SYSTEM) -dnl Use XE_SPACE instead of plain assignment statements to remove extraneous blanks -XE_SPACE(CFLAGS, $CFLAGS) -XE_SPACE(extra_objs, $extra_objs) -XE_SPACE(c_switch_general, -DHAVE_CONFIG_H $c_switch_site $c_switch_machine $c_switch_system) -XE_SPACE(c_switch_window_system, $c_switch_x_site $X_CFLAGS) -XE_SPACE(c_switch_all, $c_switch_general $c_switch_window_system) -XE_SPACE(ld_switch_general, $ld_switch_site $ld_switch_machine $ld_switch_system $ld_switch_run) -XE_SPACE(ld_switch_window_system, $ld_switch_x_site) -XE_SPACE(ld_switch_all, $ld_switch_general $ld_switch_window_system) -XE_SPACE(ld_libs_general, $LIBS $libs_machine $libs_system $libs_standard) -XE_SPACE(ld_libs_window_system, $X_EXTRA_LIBS $libs_x $X_PRE_LIBS) -XE_SPACE(ld_libs_all, $ld_libs_window_system $ld_libs_general) - -dnl Compute lists of Makefiles and subdirs -AC_SUBST(SRC_SUBDIR_DEPS) -XE_APPEND(src, MAKE_SUBDIR) -internal_makefile_list="Makefile.in" -SUBDIR_MAKEFILES='' -test -d lock || mkdir lock -for dir in $MAKE_SUBDIR; do - case "$dir" in */* ) dnl Implement mkdir -p - ( for d in `echo $dir | sed 's:/: :g'` ; do - test -d "$d" || mkdir "$d"; cd "$d" - done ) ;; - * ) test -d "$dir" || mkdir "$dir" ;; - esac - XE_SPACE(SUBDIR_MAKEFILES, $SUBDIR_MAKEFILES $dir/Makefile $dir/GNUmakefile) - XE_SPACE(internal_makefile_list, $internal_makefile_list $dir/Makefile.in) -done -AC_SUBST(INSTALL_ARCH_DEP_SUBDIR) -AC_SUBST(MAKE_SUBDIR) -AC_SUBST(SUBDIR_MAKEFILES) - -dnl Make s&m symlinks in the src directory, for config.h -for dir in src/s src/m; do - if test ! -d "$dir" ; then - echo Making symbolic link to "$srcdir/$dir" - ${LN_S} "$srcdir/$dir" "$dir" - fi -done - -if test "$extra_verbose" = "yes"; then - echo "" - PRINT_VAR(extra_objs - c_switch_general c_switch_window_system c_switch_all - ld_switch_general ld_switch_window_system ld_switch_all - ld_libs_general ld_libs_window_system ld_libs_all) - echo "" -fi - -dnl Create some auxiliary files -if test -f $srcdir/src/gdbinit -a ! -f src/gdbinit ; then - echo "creating src/gdbinit"; echo "" - echo "source $srcdir/src/gdbinit" > src/gdbinit -fi - -dnl Create top level .sbinit for Sun compilers -if test "$__SUNPRO_C" = "yes"; then - echo "creating .sbinit"; echo "" - ( echo "# For use with Sun WorkShop's Source browser." - echo "# See sbquery(1) and sbinit(4) for more information" - for dir in $MAKE_SUBDIR; do echo "import $dir"; done - ) > .sbinit -fi - -dnl There are no more compile tests; remove the core they created. -rm -f core - -dnl ---------------------------------------------- -dnl Substitute into Makefile, config.h and paths.h -dnl ---------------------------------------------- - -dnl what sort of things to edit into Makefile, config.h and paths.h -dnl configuration here uncanonicalized to avoid exceeding size limits. - -AC_SUBST(PROGNAME) -AC_SUBST(version) -AC_SUBST(configuration) -AC_SUBST(canonical) -AC_SUBST(srcdir) -AC_SUBST(bindir) -AC_SUBST(datadir) -AC_SUBST(pkgdir) -AC_SUBST(statedir) -AC_SUBST(libdir) -AC_SUBST(mandir) - -AC_SUBST(prefix) -dnl Yo, Stephen Bourne! I want to marry you! -PREFIX=$prefix -while true; do - case "$PREFIX" in - *\$* ) eval "PREFIX=$PREFIX" ;; - *) break ;; - esac -done -AC_SUBST(PREFIX) - -AC_SUBST(exec_prefix) -EXEC_PREFIX=$exec_prefix -while true; do - case "$EXEC_PREFIX" in - *\$* ) eval "EXEC_PREFIX=$EXEC_PREFIX" ;; - *) break ;; - esac -done -AC_SUBST(EXEC_PREFIX) - -AC_SUBST(infodir) -AC_SUBST(INFODIR_USER_DEFINED) -INFODIR=$infodir -while true; do - case "$INFODIR" in - *\$* ) eval "INFODIR=$INFODIR" ;; - *) break ;; - esac -done -AC_SUBST(INFODIR) - -AC_SUBST(infopath) -AC_SUBST(INFOPATH_USER_DEFINED) -INFOPATH=$infopath -while true; do - case "$INFOPATH" in - *\$* ) eval "INFOPATH=$INFOPATH" ;; - *) break ;; - esac -done -AC_SUBST(INFOPATH) - -AC_SUBST(package_path) -AC_SUBST(PACKAGE_PATH_USER_DEFINED) -PACKAGE_PATH=$package_path -while true; do - case "$PACKAGE_PATH" in - *\$* ) eval "PACKAGE_PATH=$PACKAGE_PATH" ;; - *) break ;; - esac -done -AC_SUBST(PACKAGE_PATH) - -AC_SUBST(lispdir) -AC_SUBST(LISPDIR_USER_DEFINED) -LISPDIR=$lispdir -while true; do - case "$LISPDIR" in - *\$* ) eval "LISPDIR=$LISPDIR" ;; - *) break ;; - esac -done -AC_SUBST(LISPDIR) - -AC_SUBST(moduledir) -AC_SUBST(MODULEDIR_USER_DEFINED) -MODULEDIR=$moduledir -while true; do - case "$MODULEDIR" in - *\$* ) eval "MODULEDIR=$MODULEDIR" ;; - *) break ;; - esac -done -AC_SUBST(MODULEDIR) - -AC_SUBST(sitelispdir) -AC_SUBST(SITELISPDIR_USER_DEFINED) -SITELISPDIR=$sitelispdir -while true; do - case "$SITELISPDIR" in - *\$* ) eval "SITELISPDIR=$SITELISPDIR" ;; - *) break ;; - esac -done -AC_SUBST(SITELISPDIR) - -AC_SUBST(sitemoduledir) -AC_SUBST(SITEMODULEDIR_USER_DEFINED) -SITEMODULEDIR=$sitemoduledir -while true; do - case "$SITEMODULEDIR" in - *\$* ) eval "SITEMODULEDIR=$SITEMODULEDIR" ;; - *) break ;; - esac -done -AC_SUBST(SITEMODULEDIR) - -AC_SUBST(etcdir) -AC_SUBST(ETCDIR_USER_DEFINED) -ETCDIR=$etcdir -while true; do - case "$ETCDIR" in - *\$* ) eval "ETCDIR=$ETCDIR" ;; - *) break ;; - esac -done -AC_SUBST(ETCDIR) - -AC_SUBST(lockdir) -AC_SUBST(LOCKDIR_USER_DEFINED) -LOCKDIR=$lockdir -while true; do - case "$LOCKDIR" in - *\$* ) eval "LOCKDIR=$LOCKDIR" ;; - *) break ;; - esac -done -AC_SUBST(LOCKDIR) - -AC_SUBST(archlibdir) -AC_SUBST(ARCHLIBDIR_USER_DEFINED) -ARCHLIBDIR=$archlibdir -while true; do - case "$ARCHLIBDIR" in - *\$* ) eval "ARCHLIBDIR=$ARCHLIBDIR" ;; - *) break ;; - esac -done -AC_SUBST(ARCHLIBDIR) - -AC_SUBST(docdir) -AC_SUBST(bitmapdir) -AC_SUBST(extra_objs) - -dnl The following flags combine all the information from: -dnl - command line options (user always gets priority) -dnl - user environment variables -dnl - determined by configure -dnl - the s&m header files (required for ellcc) -AC_SUBST(machfile) -AC_SUBST(opsysfile) -AC_SUBST(c_switch_general) -AC_SUBST(c_switch_window_system) -AC_SUBST(c_switch_all) -AC_SUBST(ld_switch_general) -AC_SUBST(ld_switch_window_system) -AC_SUBST(ld_switch_all) -AC_SUBST(ld_libs_general) -AC_SUBST(ld_libs_window_system) -AC_SUBST(ld_libs_all) -AC_SUBST(CFLAGS) -AC_SUBST(CPPFLAGS) -AC_SUBST(LDFLAGS) -RECURSIVE_MAKE="\$(MAKE) \$(MFLAGS) CC='\$(CC)' CFLAGS='\$(CFLAGS)' LDFLAGS='\$(LDFLAGS)' CPPFLAGS='\$(CPPFLAGS)'" -AC_SUBST(RECURSIVE_MAKE) - -AC_SUBST(native_sound_lib) -AC_SUBST(sound_cflags) -AC_SUBST(RANLIB) -AC_SUBST(dynodump_arch) - -dnl Preliminary support for using a different compiler for xemacs itself. -dnl Useful for building XEmacs with a C++ or 64-bit compiler. -: ${XEMACS_CC:=$CC} -AC_SUBST(XEMACS_CC) - - -dnl The default is no -if test "$with_site_lisp" = "no"; then - AC_DEFINE(INHIBIT_SITE_LISP) -fi -dnl The default is yes -if test "$with_site_modules" = "no"; then - AC_DEFINE(INHIBIT_SITE_MODULES) -fi - -XE_SPACE(ac_configure_args, $ac_configure_args) -AC_DEFINE_UNQUOTED(EMACS_CONFIGURATION, "$canonical") -AC_DEFINE_UNQUOTED(EMACS_CONFIG_OPTIONS, "$ac_configure_args") -AC_DEFINE_UNQUOTED(config_machfile, "$machfile") -AC_DEFINE_UNQUOTED(config_opsysfile, "$opsysfile") - -dnl Following are deprecated - -null_string="" -AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE, $null_string) -AC_DEFINE_UNQUOTED(LD_SWITCH_X_SITE_AUX, $null_string) -AC_DEFINE_UNQUOTED(C_SWITCH_X_SITE, $null_string) -AC_DEFINE_UNQUOTED(LD_SWITCH_SITE, $null_string) -AC_DEFINE_UNQUOTED(C_SWITCH_SITE, $null_string) - -dnl Note: as a general rule, *only* define things here that are not -dnl autodetected. For things that are autodetected, define them -dnl at the point where the autodetection occurs or would occur, -dnl so that the user gets immediate feedback on the results of the -dnl autodetection. - -test -n "$puresize" && AC_DEFINE_UNQUOTED(RAW_PURESIZE, $puresize) - -if test "$GNU_MALLOC" = "yes"; then AC_DEFINE(GNU_MALLOC) -elif test "$with_system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) -elif test "$with_debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) - AC_DEFINE(USE_SYSTEM_MALLOC) -fi -test "$with_i18n3" = "yes" && AC_DEFINE(I18N3) -test "$GCC" = "yes" && AC_DEFINE(USE_GCC) -test "$external_widget" = "yes" && AC_DEFINE(EXTERNAL_WIDGET) -test "$no_doc_file" = "yes" && AC_DEFINE(NO_DOC_FILE) -dnl test "$const_is_losing" = "yes" && AC_DEFINE(CONST_IS_LOSING) -test "$with_purify" = "yes" && AC_DEFINE(PURIFY) -test "$with_quantify" = "yes" && AC_DEFINE(QUANTIFY) -test "$with_pop" = "yes" && AC_DEFINE(MAIL_USE_POP) -test "$with_kerberos" = "yes" && AC_DEFINE(KERBEROS) -test "$with_hesiod" = "yes" && AC_DEFINE(HESIOD) -test "$use_union_type" = "yes" && AC_DEFINE(USE_UNION_TYPE) - -dnl ------------------------------- -dnl Report on what we decided to do -dnl ------------------------------- - -( -dnl /etc/osversion is on SONY NEWS-OS -if test -f /etc/osversion; then dnl SONY NEWS-OS - echo "osversion: `cat /etc/osversion`" -else - echo "uname -a: `uname -a`" -fi -echo "" -echo "$0 $quoted_arguments" -) > Installation - -xemacs_betaname="" -test ! -z "${emacs_beta_version}" && xemacs_betaname="-b${emacs_beta_version}" - -dnl Start stdout redirection to '| tee -a Installation' -( -echo " - -XEmacs ${emacs_major_version}.${emacs_minor_version}${xemacs_betaname} \"$xemacs_codename\" configured for \`$canonical'. - - Where should the build process find the source code? $srcdir - What installation prefix should install use? $prefix - What operating system and machine description files should XEmacs use? - \`$opsysfile' and \`$machfile' - What compiler should XEmacs be built with? $CC $CFLAGS - Should XEmacs use the GNU version of malloc? ${GNU_MALLOC}${GNU_MALLOC_reason} - Should XEmacs use the relocating allocator for buffers? $rel_alloc - What window system should XEmacs use? ${window_system}" -if test "$with_x11" = "yes"; then - echo " Where do we find X Windows header files? $x_includes" - echo " Where do we find X Windows libraries? $x_libraries" -fi -if test -n "$site_includes"; then - echo " Additional header files: $site_includes" -fi -if test -n "$site_libraries"; then - echo " Additional libraries: $site_libraries" -fi -if test -n "$site_prefixes"; then - echo " Additional prefixes: $site_prefixes" -fi -if test -n "$runpath"; then - echo " Runtime library search path: $runpath" -fi -test "$with_dnet" = yes && echo " Compiling in support for DNET." -test "$with_socks" = yes && echo " Compiling in support for SOCKS." -test "$with_xauth" = yes && echo " Compiling in support for XAUTH." -if test "$with_xmu" != yes -a "$with_x11" = yes; then - echo " No Xmu; substituting equivalent routines." -fi - -if test "$with_xpm" = yes; then - echo " Compiling in support for XPM images." -elif test "$with_x11" = yes; then - echo " --------------------------------------------------------------------" - echo " WARNING: Compiling without XPM support." - if test "$xpm_problem" != ""; then - echo " Reason: $xpm_problem" - fi - echo " WARNING: You should strongly consider installing XPM." - echo " WARNING: Otherwise toolbars and other graphics will look suboptimal." - echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" - echo " --------------------------------------------------------------------" -fi -if test "$with_png" = yes; then - echo " Compiling in support for PNG image handling." -elif test "$window_system" != "none"; then - echo " --------------------------------------------------------------------" - echo " WARNING: Compiling without PNG image support." - if test "$png_problem" != ""; then - echo " Reason: $png_problem" - fi - echo " WARNING: You should strongly consider installing the PNG libraries." - echo " WARNING: Otherwise certain images and glyphs may not display." - echo " WARNING: (a copy may be found in ftp://ftp.xemacs.org/pub/xemacs/aux)" - echo " --------------------------------------------------------------------" -fi -test "$with_gif" = yes && echo " Compiling in support for (builtin) GIF image handling." -test "$with_jpeg" = yes && echo " Compiling in support for JPEG image handling." -test "$with_tiff" = yes && echo " Compiling in support for TIFF image handling." -test "$with_xface" = yes && echo " Compiling in support for X-Face message headers." -case "$with_sound" in - nas ) echo " Compiling in network sound (NAS) support." ;; - native ) echo " Compiling in native sound support." ;; - both ) echo " Compiling in both network and native sound support." ;; -esac -test "$old_nas" = yes && echo " nas library lacks error trapping, will play synchronously." - -test "$with_database_berkdb" = yes && echo " Compiling in support for Berkeley DB." -test "$with_database_dbm" = yes && echo " Compiling in support for DBM." -test "$with_database_gnudbm" = yes && echo " Compiling in support for GNU DBM." - -test "$with_umich_ldap" = yes && echo " Compiling in support for LDAP (UMich libs)." -test "$with_ns_ldap" = yes && echo " Compiling in support for LDAP (Netscape SDK)." -test "$with_ldap" = yes -a "$with_umich_ldap" = no -a "$with_ns_ldap" = no && echo " Compiling in support for LDAP (Generic)." - -test "$with_ncurses" = yes && echo " Compiling in support for ncurses." -test "$with_gpm" = yes && echo " Compiling in support for GPM (General Purpose Mouse)." - -test "$with_mule" = yes && echo " Compiling in Mule (multi-lingual) support." -test "$with_file_coding" = yes && echo " Compiling in File coding support." -test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support." -test "$with_xim" = motif && echo " Using Motif to provide XIM support." -test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support." -test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar." -test "$with_canna" = yes && echo " Compiling in support for Canna on Mule." -if test "$with_wnn" = yes; then - echo " Compiling in support for the WNN input method on Mule." - test "$with_wnn6" = yes && echo " Using WNN version 6." -fi -test "$with_i18n3" = yes && echo " Compiling in I18N support, level 3 (doesn't currently work)." - -test "$with_cde" = yes && echo " Compiling in support for CDE." -test "$with_tooltalk" = yes && echo " Compiling in support for ToolTalk." -test "$with_offix" = yes && echo " Compiling in support for OffiX." -test "$with_dragndrop" = yes && echo " Compiling in EXPERIMENTAL support for Drag'n'Drop ($dragndrop_proto )." -test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." -test "$with_session" != no && echo " Compiling in support for proper session-management." -case "$with_menubars" in - lucid ) echo " Using Lucid menubars." ;; - motif ) echo " Using Motif menubars." - echo " *WARNING* The Motif menubar implementation is currently buggy." - echo " We recommend using the Lucid menubar instead." - echo " Re-run configure with --with-menubars='lucid'." ;; -esac -case "$with_scrollbars" in - lucid ) echo " Using Lucid scrollbars." ;; - motif ) echo " Using Motif scrollbars." ;; - athena ) echo " Using Athena scrollbars." ;; - athena3d ) echo " Using Athena-3d scrollbars." ;; -esac -case "$with_dialogs" in - motif ) - echo " Using Motif dialog boxes." - if test "$unexec" = "unexaix.o" -a `uname -v` = 4 -a `uname -r` -ge 3; then - echo " *WARNING* The Motif dialog boxes cause problems on AIX 4.3 and higher." - echo " We recommend using the Athena dialog boxes instead." - echo " Install libXaw and re-run configure with --with-dialogs='athena'." - echo " Read the PROBLEMS file for more information." - fi - ;; - athena ) echo " Using Athena dialog boxes." ;; - athena3d ) echo " Using Athena-3d dialog boxes." ;; -esac -test "$with_shlib" = "yes" && echo " Compiling in DLL support." -test "$with_clash_detection" = yes && \ - echo " Clash detection will use \"$lockdir\" for locking files." -echo " movemail will use \"$mail_locking\" for locking mail spool files." -test "$with_pop" = yes && echo " Using POP for mail access." -test "$with_kerberos" = yes && echo " Using Kerberos for POP authentication." -test "$with_hesiod" = yes && echo " Using Hesiod to get POP server host." -test "$use_union_type" = yes && echo " Using the union type for Lisp_Objects." -test "$use_minimal_tagbits" = yes && echo " Using Lisp_Objects with minimal tagbits." -test "$use_indexed_lrecord_implementation" = yes && echo " Using indexed lrecord implementation." -test "$debug" = yes && echo " Compiling in extra code for debugging." -test "$memory_usage_stats" = yes && echo " Compiling in code for checking XEmacs memory usage." -test "$usage_tracking" = yes && echo " Compiling with usage tracking active (Sun internal)." -if test "$error_check_extents $error_check_typecheck $error_check_bufpos $error_check_gc $error_check_malloc" \ - != "no no no no no"; then - echo " WARNING: ---------------------------------------------------------" - echo " WARNING: Compiling in support for runtime error checking." - echo " WARNING: XEmacs will run noticeably more slowly as a result." - echo " WARNING: Error checking is on by default for XEmacs beta releases." - echo " WARNING: ---------------------------------------------------------" -fi -echo "" -) | tee -a Installation -dnl echo "The above configure report is appended to \"Installation\" file." -echo "" - -dnl Generate Installation.el -echo '(setq Installation-string "' > Installation.el -sed 's/"/\\"/g' Installation >> Installation.el -echo '")' >> Installation.el - -dnl ----------------------------------- -dnl Now generate config.h and Makefiles -dnl ----------------------------------- -dnl This has to be called in order for this variable to get into config.status -AC_SUBST(internal_makefile_list) -# Remove any trailing slashes in these variables. -test -n "$prefix" && - prefix=`echo '' "$prefix" | sed -e 's:^ ::' -e 's,\([[^/]]\)/*$,\1,'` -test -n "$exec_prefix" && - exec_prefix=`echo '' "$exec_prefix" | sed -e 's:^ ::' -e 's,\([[^/]]\)/*$,\1,'` - -dnl Build Makefile.in's from Makefile.in.in's -dnl except ./Makefile from $srcdir/Makefile.in - -for file in $internal_makefile_list; do - test "$file" = src/Makefile.in && \ - file="src/Makefile.in:src/Makefile.in.in:src/depend" - ac_output_files="${ac_output_files+$ac_output_files }$file" -done -ac_output_files="$ac_output_files src/paths.h lib-src/config.values" -if test "$with_shlib" = "yes"; then - ac_output_files="$ac_output_files lib-src/ellcc.h" -fi - -AC_OUTPUT($ac_output_files, -[for dir in . $MAKE_SUBDIR; do - ( - cd $dir - rm -f junk.c - < Makefile.in \ - sed -e '/^# Generated/d' \ - -e 's%/\*\*/#.*%%' \ - -e 's/^ *# */#/' \ -dnl Delete Makefile.in.in comment lines - -e '/^##/d' \ -dnl Pass through CPP directives unchanged - -e '/^#/ { -p -d -}' \ -dnl Quote other lines to protect from CPP substitution - -e '/./ { -s/\([[\"]]\)/\\\1/g -s/^/"/ -s/$/"/ -}' > junk.c; - -dnl Create a GNUmakefile and Makefile from Makefile.in. - -changequote(<<,>>)dnl -dnl CPP_MAKEFILE(CPPFLAGS,filename) -define(<>, -echo creating $dir/<<$2>> -$CPP -I. -I${top_srcdir}/src <<$1>> junk.c \ -dnl Delete line directives inserted by $CPP - | sed -e 's/^\#.*//' \ -dnl Delete spurious blanks inserted by $CPP - -e 's/^[ TAB][ TAB]*$//'\ - -e 's/^ /TAB/' \ -dnl Delete blank lines - | sed -n -e '/^..*$/p' \ -dnl Restore lines quoted above to original contents. - | sed '/^\"/ { - s/\\\([\"]\)/\1/g - s/^[ TAB]*\"// - s/\"[ TAB]*$// -}' > Makefile.new - chmod 444 Makefile.new - mv -f Makefile.new <<$2>> -)dnl CPP_MAKEFILE - - CPP_MAKEFILE(,Makefile) - CPP_MAKEFILE(-DUSE_GNU_MAKE,GNUmakefile) -changequote([,])dnl - rm -f junk.c - ) -done - -dnl Append AC_DEFINE information to lib-src/config.values -dnl (AC_SUBST information is already there (see config.values.sh). -sed < config.status >> lib-src/config.values \ - -e '/{ac_dA}.*{ac_dB}.*{ac_dC}.*{ac_dD}$/!d' \ - -e 's/\${ac_dA}\(.*\)\${ac_dB}.*\${ac_dC}\(.*\)\${ac_dD}/\1 \2/' \ - -e 's/^\([[^ ]]*\) $/\1 ""/' \ - -e 's/ 1$/ t/' - -], -[CPP="$CPP" - top_srcdir="$srcdir" - MAKE_SUBDIR="$MAKE_SUBDIR" -])dnl diff --git a/configure.usage b/configure.usage deleted file mode 100644 index d612b90..0000000 --- a/configure.usage +++ /dev/null @@ -1,250 +0,0 @@ -Usage: configure [--OPTION[=VALUE] ...] [CONFIGURATION] - -Set compilation and installation parameters for XEmacs, and report. - -Note that for most of the following options, you can explicitly enable -them using `--OPTION=yes' and explicitly disable them using `--OPTION=no'. -This is especially useful for auto-detected options. -The option `--without-FEATURE' is a synonym for `--with-FEATURE=no'. - -Options marked with a (*) are auto-detected. - -Use colons (or quoted spaces) to separate directory names in option -values which are PATHs (i.e. lists of directories). - -General options: - ---help Issue this usage message. ---verbose Display the results of configure tests. ---extra-verbose Display even more information, useful for debugging. - - -Compilation options: - ---compiler=prog C compiler to use. ---with-gcc (*) Use GCC to compile XEmacs. ---without-gcc Don't use GCC to compile XEmacs. ---cflags=FLAGS Compiler flags (such as -O) ---cpp=prog C preprocessor to use (e.g. /usr/ccs/lib/cpp or cc -E) ---cppflags=FLAGS C preprocessor flags (e.g. -I/foo or -Dfoo=bar) ---libs=LIBS Additional libraries (e.g. -lfoo) ---ldflags=FLAGS Additional linker flags (e.g. -L/foo) ---site-includes=PATH List of directories to search first for header files. ---site-libraries=PATH List of directories to search first for libraries. ---site-prefixes=PATH List of directories to search for include/ and lib/ - subdirectories, just after 'site-includes' and - 'site-libraries'. ---site-runtime-libraries=PATH - List of ALL directories to search for dynamically - linked libraries at run time. ---dynamic=yes Link dynamically if supported by system. ---dynamic=no Force static linking on systems where dynamic - linking is the default. ---srcdir=DIR Look for the XEmacs source files in DIR. - Works best when using GNU Make. ---use-indexed-lrecord-implementation ---use-minimal-tagbits ---gung-ho Build with new-style Lisp_Objects. - Equivalent to both of the 2 previous options combined. - - -Installation options: - ---prefix=DIR Install files below DIR. Defaults to `/usr/local'. - - -Window-system options: - ---with-x11 (*) Support the X Window System. ---without-x11 Don't support X. ---x-includes=DIR Search for X header files in DIR. ---x-libraries=DIR Search for X libraries in DIR. ---without-toolbars Don't compile with any toolbar support. ---without-session Compile without realized leader window which will - keep the WM_COMMAND property. Required for proper - session-management. ---with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid - widgets emulate Motif (mostly) but are faster. - *WARNING* The Motif menubar is currently broken. ---with-scrollbars=TYPE Use TYPE scrollbars - (lucid, motif, athena, athena3d, or no). ---with-dialogs=TYPE Use TYPE dialog boxes (motif, athena, athena3d, or no). - Lucid menubars and scrollbars are the default. - Motif dialog boxes will be used if Motif can be found. ---with-dragndrop (*) Compile in the generic drag and drop API. This is - automatically added if one of the drag and drop - protocols is found (currently CDE, OffiX, MSWindows). - *WARNING* The Drag'n'drop support is under development - and is considered experimental. ---with-cde (*) Compile in support for CDE drag and drop. ---with-offix (*) Compile in support for OffiX drag and drop. - *WARNING* If you compile in OffiX, you may not be - able to use multiple X displays success- - fully. If the two servers are from - different vendors, the results may be - unpredictable. ---without-xmu (*) For those unfortunates whose vendors don't ship Xmu. ---external-widget Compile with external widget support. ---with-xpm (*) Compile with support for XPM files. - It is highly recommended that you obtain XPM - (version 3.4h or better) if you don't already - have it. Get it from the XEmacs FTP site. ---with-xface (*) Compile with support for X-Face mail header - conversion. Requires the compface library. - Get it from the XEmacs FTP site. ---without-gif Compile without the built-in support for GIF image - conversion. ---with-jpeg (*) Compile with support for JPEG image conversion. - Requires libjpeg from the Independent JPEG Group. - Get it from the XEmacs FTP site. ---with-png (*) Compile with support for PNG image conversion. - Requires libpng. Get it from the XEmacs FTP site. ---with-tiff (*) Compile with support for TIFF image conversion. - Requires Sam Lefflier's libtiff library. - Get if from the XEmacs FTP site. - - -TTY options: - ---without-tty Don't support TTY-s. ---with-ncurses (*) Use the ncurses library for tty support. ---with-gpm (*) Compile in support for General Purpose Mouse. - - -Additional features: - ---with-tooltalk (*) Support the ToolTalk IPC protocol. ---with-workshop Support the Sun WorkShop (formerly Sparcworks) - development environment. ---with-socks Compile with support for SOCKS (an Internet proxy). ---with-database=TYPE (*) Compile with database support. Valid types are - `no' or a comma-separated list of one or more - of `berkdb' and either `dbm' or `gnudbm'. ---with-sound=native (*) Compile with native sound support. ---with-sound=nas Compile with network sound support. ---with-sound=both Compile with native and network sound support. ---native-sound-lib=LIB Native sound support library. Needed on Suns - with --with-sound=both because both sound libraries - are called libaudio. ---with-pop support POP for mail retrieval ---with-kerberos support Kerberos-authenticated POP ---with-hesiod support Hesiod to get the POP server host ---with-dnet (*) Compile with support for DECnet. ---with-ldap (*) Compile with support for the LDAP protocol (requires - installed LDAP libraries on the system). ---mail-locking=TYPE (*) Specify the locking to be used by movemail to prevent - concurrent updates of mail spool files. Valid types - are `lockf', `flock', and `file'. ---with-site-lisp=yes Allow for a site-lisp directory in the XEmacs hierarchy - searched before the installation packages. ---with-site-modules=no Disable site-modules directory in the XEmacs hierarchy, - which is searched before the installation modules. ---package-path=PATH Directories to search for packages to dump with xemacs. - PATH splits into three parts separated by double - colons (::), an early, a late, and a last part, - corresponding to their position in the various - system paths: The early part is always first, - the late part somewhere in the middle, and the - last part at the very back. - Only the late part gets seen at dump time. - If PATH has only one component, that component - is late. - If PATH has two components, the first is - early, the second is late. ---infodir=DIR Directory to install XEmacs Info manuals and dir in. ---infopath=PATH Directories to search for Info documents, info dir - and localdir files in case run-time searching - for them fails. ---moduledir=DIR Directory to install dynamic modules in. - -Internationalization options: - ---with-mule Compile with Mule (MUlti-Lingual Emacs) support, - needed to support non-Latin-1 (including Asian) - languages. ---with-xim=xlib Compile with support for X input methods, ---with-xim=motif (*) Used in conjunction with Mule support. - Use either raw Xlib to provide XIM support, or - the Motif XmIm* routines (when available). - NOTE: On some systems bugs in X11's XIM support - will cause XEmacs to crash, so by default, - no XIM support is compiled in, unless running - on Solaris and the XmIm* routines are detected. ---with-canna (*) Compile with support for Canna (a Japanese input method - used in conjunction with Mule support). ---with-wnn (*) Compile with support for WNN (a multi-language input - method used in conjunction with Mule support). ---with-wnn6 (*) Compile with support for the comercial package WNN - version 6 ---with-i18n3 Compile with I18N level 3 (support for message - translation). This doesn't currently work. ---with-xfs Compile with XFontSet support for bilingual menubar. - Can't use this option with --with-xim=motif or xlib. - And should have --with-menubars=lucid. - - -Debugging options: - ---debug Compile with support for debugging XEmacs. - (Causes code-size increase and little loss of speed.) ---error-checking=TYPE[,TYPE]... - Compile with internal error-checking added. - Causes noticeable loss of speed. Valid types - are extents, bufpos, malloc, gc, typecheck. ---error-checking=none Disable all internal error-checking (the default). ---error-checking=all Enable all internal error-checking. ---memory-usage-stats Compile with additional code to allow you to - determine what XEmacs's memory is being used - for. Causes a small code increase but no loss - of speed. Normally enabled when --debug is given. ---no-doc-file Don't rebuild the DOC file unless it's explicitly - deleted. Only use during development. (It speeds - up the compile-run-test cycle.) ---use-union-type Enable or disable use of a union, instead of an - int, for the fundamental Lisp_Object type; this - provides stricter type-checking. Only works with - some systems and compilers. ---with-quantify Add support for performance debugging using Quantify. ---with-purify Add support for memory debugging using Purify. - - -Other options: - ---puresize=VALUE Override default amount of space for pure Lisp code. ---rel-alloc Use the relocating allocator (default for this option - is system-dependent). ---with-dlmalloc Control usage of Doug Lea malloc on systems that have - it in the standard C library (default is to use it if - it is available). ---with-system-malloc Force use of the system malloc, rather than GNU malloc. ---with-debug-malloc Use the debugging malloc package. ---with-clash-detection Use lock files to detect multiple edits of the same - file. The default is to not do clash detection. ---lockdir=DIR The directory to put clash detection files in, such as - `/var/lock/emacs'. - Defaults to `${statedir}/xemacs/lock'. - -You may also specify any of the `path' variables found in Makefile.in, -including --bindir, --libdir, --lispdir, --sitelispdir, --datadir, ---infodir, --mandir and so on. Note that we recommend against -explicitly setting any of these variables. See the INSTALL file for a -complete list plus the reasons we advise not changing them. - -If successful, configure leaves its status in config.status. If -unsuccessful after disturbing the status quo, it removes config.status. - -The configure script also recognizes some environment variables, each -of which is equivalent to a corresponding configure flag. A specified -configure flag always overrides the environment variable. - -envvar configure flag ------ -------------- -CC --compiler -CPP --cpp -CFLAGS --cflags -CPPFLAGS --cppflags -LDFLAGS --ldflags -LIBS --libs -LD_RUN_PATH --site-runtime-libraries - -For more details on the install process, consult the INSTALL file. diff --git a/dynodump/_dynodump.h b/dynodump/_dynodump.h deleted file mode 100644 index c09bd7f..0000000 --- a/dynodump/_dynodump.h +++ /dev/null @@ -1,65 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: _dynodump.h,v 1.5 1996/05/23 18:39:07 georgn Exp $ - SMI" - -#ifndef _DYNODUMP_DOT_H -#define _DYNODUMP_DOT_H - -#include -#include "machdep.h" - -/* General rounding macro */ -#define S_ROUND(x, a) (((int)(x) + (((int)(a) ? (int)(a) : 1) - 1)) & \ - ~(((int)(a) ? (int)(a) : 1) - 1)) - -/* - * Define a cache structure that is used to retain all elf section information. - */ -typedef struct cache { - Elf_Scn *c_scn; - Shdr *c_shdr; - Elf_Data *c_data; - char *c_name; -} Cache; - -/* - * Define any local prototypes. - */ -extern void update_dynamic(Cache *); -extern void update_reloc(Cache *, Cache *, Cache *, Cache *, Half shnum); -extern void update_sym(Cache *, Cache *, Addr); -extern void dynodump_uninit(void); - -#endif diff --git a/dynodump/dynodump.c b/dynodump/dynodump.c deleted file mode 100644 index b684813..0000000 --- a/dynodump/dynodump.c +++ /dev/null @@ -1,560 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * dynodump(3x) dumps a running executable into a specified ELF file. The new - * file consists of the memory contents of the original file together with any - * heap. This heap is assigned to a new `.heap' section within the new file. - * - * The new file may be re-executed, and will contain any data modifications - * made to the original image up until the time dynodump(3x) was called. - * - * The original image may have undergone relocations (performed by ld.so.1) - * prior to control being transferred to the image. These relocations will - * reside as the data copied from the image. To prevent subsequent executions - * of the new image from undergoing the same relocations, any relocation entries - * (besides copy or jump slot relocations) are nulled out. Note that copy - * relocations such as required for __iob must be reinitialized each time the - * process starts, so it is not sufficient to simply null out the .dynamic - * sections relocation information. The effect of this is that if the new - * image was bound to definitions in any shared object dependencies, then these - * dependencies *must* reside in the same location as when dynodump(3x) was - * called. Any changes to the shared object dependencies of the new image, or - * uses of such things as LD_PRELOAD, may result in the bindings encoded in the - * image becoming invalid. - * - * The following flags modify the data of the image created: - * - * RTLD_SAVREL save the original relocation data. Under this option any - * relocation offset is reset to contain the same data as was - * found in the images original file. - * - * This option allows relocation information to be retained in the - * new image so that it may be re-executed when the new image is - * run. This allows far greater flexibility as the new image can - * now take advantage of new shared objects. - * - * Note. under this mechanism, any data item that undergoes - * relocation and is then further modified during the execution of - * the image before dynodump(3x) is called will lose the - * modification that occured during the applications execution. - * - * N.B. The above commentary is not quite correct in the flags have been hardwired - * to RTLD_SAVREL. - */ -#pragma ident "@(#) $Id: dynodump.c,v 1.8 1996/05/23 18:39:21 georgn Exp $ - SMI" - -#define __EXTENSIONS__ 1 - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include "machdep.h" -#include "_dynodump.h" - -/* - * Generic elf error message generator - */ -static int -elferr(const char * str) -{ - fprintf(stderr, "%s: %s\n", str, elf_errmsg(elf_errno())); - return (1); -} - -int dynodump (const char * file); -int -dynodump(const char * file) -{ - Elf *ielf, *oelf; - Ehdr *iehdr, *oehdr; - Phdr *iphdr, *ophdr, *data_phdr = 0; - Cache *icache, *ocache, *_icache, *_ocache; - Cache *data_cache = 0, *shstr_cache = 0; - Cache *heap_cache = 0; - Word heap_sz = 0; - Elf_Scn *scn; - Shdr *shdr; - Elf_Data *data, rundata; - Half ndx, _ndx; - int fd, _fd; - Addr edata, _addr; - char *istrs, *ostrs, *_ostrs, proc[16]; - const char heap[] = ".heap"; - prstatus_t pstat; - - /* make a call to the processor specific un-init stuff */ - dynodump_uninit(); - - /* - * Obtain a file descriptor for this process, - * for the executable and get a prstatus_t - * structure. - */ - sprintf(proc, "/proc/%ld", getpid()); - if (((_fd = open(proc, O_RDONLY, 0)) == -1) || - ((fd = ioctl(_fd, PIOCOPENM, (void *)0)) == -1) || - (ioctl(_fd, PIOCSTATUS, &pstat) == -1)) { - fprintf(stderr, "/proc: initialization error: %s\n", - strerror(errno)); - close(_fd); - return (1); - } - close(_fd); - - /* - * Initialize with the ELF library and make sure this is an executable - * ELF file we're dealing with. - */ - elf_version(EV_CURRENT); - if ((ielf = elf_begin(fd, ELF_C_READ, NULL)) == NULL) { - close(fd); - return (elferr("elf_begin")); - } - close(fd); - - if ((elf_kind(ielf) != ELF_K_ELF) || - ((iehdr = elf_getehdr(ielf)) == NULL) || - (iehdr->e_type != ET_EXEC)) { - fprintf(stderr, "image is not an ELF executable\n"); - elf_end(ielf); - return (1); - } - /* - * Elf_elf_header(iehdr); - */ - - /* - * Create the new output file. - */ - if ((fd = open(file, O_RDWR | O_CREAT | O_TRUNC, 0777)) == -1) { - fprintf(stderr, "%s: open failed: %s\n", file, - strerror(errno)); - elf_end(ielf); - return (1); - } - if ((oelf = elf_begin(fd, ELF_C_WRITE, NULL)) == NULL) { - elf_end(ielf); - close(fd); - return (elferr("elf_begin")); - } - - /* - * Obtain the input program headers. Remember the data segments - * program header entry as this will be updated later to reflect the - * new .heap sections size. - */ - if ((iphdr = elf_getphdr(ielf)) == NULL) - return (elferr("elf_getphdr")); - - for (ndx = 0, ophdr = iphdr; ndx != iehdr->e_phnum; ndx++, ophdr++) { - /* - * Save the program header that contains the NOBITS section, or - * the last loadable program header if no NOBITS exists. - * A NOBITS section translates to a memory size requirement that - * is greater than the file data it is mapped from. - */ - if (ophdr->p_type == PT_LOAD) { - if (ophdr->p_filesz != ophdr->p_memsz) - data_phdr = ophdr; - else if (data_phdr) { - if (data_phdr->p_vaddr < ophdr->p_vaddr) - data_phdr = ophdr; - } else - data_phdr = ophdr; - } - } - if (data_phdr == 0) { - fprintf(stderr, "no data segment found!\n"); - return (0); - } - - /* - * Obtain the input files section header string table. - */ - if ((scn = elf_getscn(ielf, iehdr->e_shstrndx)) == NULL) - return (elferr("elf_getscn")); - if ((data = elf_getdata(scn, NULL)) == NULL) - return (elferr("elf_getdata")); - istrs = (char *) data->d_buf; - - /* - * Construct a cache to maintain the input files section information. - */ - if ((icache = (Cache *) malloc(iehdr->e_shnum * sizeof (Cache))) == 0) { - fprintf(stderr, "malloc failed: %s\n", strerror(errno)); - return (1); - } - _icache = icache; - _icache++; - - /* - * Traverse each section from the input file. - */ - for (ndx = 1, scn = 0; - (_icache->c_scn = elf_nextscn(ielf, scn)); - ndx++, scn = _icache->c_scn, _icache++) { - - if ((_icache->c_shdr = shdr = elf_getshdr(_icache->c_scn)) == NULL) - return (elferr("elf_getshdr")); - - if ((_icache->c_data = elf_getdata(_icache->c_scn, NULL)) == NULL) - return (elferr("elf_getdata")); - - _icache->c_name = istrs + (size_t)(shdr->sh_name); - - /* - * For each section that has a virtual address reestablish the - * data buffer to point to the memory image. - * - * if (shdr->sh_addr) - * _icache->c_data->d_buf = (void *)shdr->sh_addr; - */ - - /* - * Remember the last section of the data segment, the new .heap - * section will be added after this section. - * If we already have one, then set data_cache to the previous - * section and set heap_cache to this one. - */ - if ((shdr->sh_addr + shdr->sh_size) - == (data_phdr->p_vaddr + data_phdr->p_memsz)) { - if (strcmp(_icache->c_name, heap) == 0) { -#ifdef DEBUG - printf("Found a previous .heap section\n"); -#endif - data_cache = _icache - 1; - heap_cache = _icache; - heap_sz = shdr->sh_size; - } else { - data_cache = _icache; - } - } - - /* - * Remember the section header string table as this will be - * rewritten with the new .heap name. - */ - if ((shdr->sh_type == SHT_STRTAB) && - ((strcmp(_icache->c_name, ".shstrtab")) == 0)) - shstr_cache = _icache; - } - if (data_cache == 0) { - fprintf(stderr, "final data section not found!\n"); - return (0); - } - - /* - * Determine the new .heap section to create. - */ - rundata.d_buf = (void *)(data_cache->c_shdr->sh_addr + - data_cache->c_shdr->sh_size); - rundata.d_size = (int)sbrk(0) - (int)rundata.d_buf; - rundata.d_type = ELF_T_BYTE; - rundata.d_off = 0; - rundata.d_align = 1; - rundata.d_version = EV_CURRENT; - - /* - * From the new data buffer determine the new value for _end and _edata. - * This will also be used to update the data segment program header. - * - * If we had a .heap section, then its size is part of the program - * headers notion of data size. Because we're only going to output one - * heap section (ignoring the one in the running binary) we need to - * subract the size of that which we're ignoring. - */ - if (heap_cache) { - edata = S_ROUND((data_phdr->p_vaddr - + data_phdr->p_memsz - - heap_sz), rundata.d_align) + rundata.d_size; - } else { - edata = S_ROUND((data_phdr->p_vaddr + data_phdr->p_memsz), - rundata.d_align) + rundata.d_size; - } - - /* - * We're now ready to construct the new elf image. - * - * Obtain a new elf header and initialize it with any basic information - * that isn't calculated as part of elf_update(). Bump the section - * header string table index to account for the .heap section we'll be - * adding. - */ - if ((oehdr = elf_newehdr(oelf)) == NULL) - return (elferr("elf_newehdr")); - - oehdr->e_entry = iehdr->e_entry; - oehdr->e_machine = iehdr->e_machine; - oehdr->e_type = iehdr->e_type; - oehdr->e_flags = iehdr->e_flags; - /* - * If we already have a heap section, we don't need any adjustment - */ - if (heap_cache) - oehdr->e_shstrndx = iehdr->e_shstrndx; - else - oehdr->e_shstrndx = iehdr->e_shstrndx + 1; - -#ifdef DEBUG - printf("iehdr->e_flags = %x\n", iehdr->e_flags); - printf("iehdr->e_entry = %x\n", iehdr->e_entry); - printf("iehdr->e_shstrndx= %d\n", iehdr->e_shstrndx); - printf("iehdr->e_machine = %d\n", iehdr->e_machine); - printf("iehdr->e_type = 0x%x\n", iehdr->e_type); - printf("oehdr->e_machine = %d\n", oehdr->e_machine); - printf("oehdr->e_type = 0x%x\n", oehdr->e_type); -#endif - - /* - * Obtain a new set of program headers. Initialize these with the same - * information as the input program headers and update the data segment - * to reflect the new .heap section. - */ - if ((ophdr = elf_newphdr(oelf, iehdr->e_phnum)) == NULL) - return (elferr("elf_newphdr")); - - for (ndx = 0; ndx != iehdr->e_phnum; ndx++, iphdr++, ophdr++) { - *ophdr = *iphdr; - if (data_phdr == iphdr) - ophdr->p_filesz = ophdr->p_memsz = edata - ophdr->p_vaddr; - } - - /* - * Obtain a new set of sections. - */ - _icache = icache; - _icache++; - for (ndx = 1; ndx != iehdr->e_shnum; ndx++, _icache++) { - /* - * Skip the heap section of the running executable - */ - if (_icache == heap_cache) - continue; - /* - * Create a matching section header in the output file. - */ - if ((scn = elf_newscn(oelf)) == NULL) - return (elferr("elf_newscn")); - if ((shdr = elf_getshdr(scn)) == NULL) - return (elferr("elf_getshdr")); - *shdr = *_icache->c_shdr; - - /* - * Create a matching data buffer for this section. - */ - if ((data = elf_newdata(scn)) == NULL) - return (elferr("elf_newdata")); - *data = *_icache->c_data; - - /* - * For each section that has a virtual address reestablish the - * data buffer to point to the memory image. Note, we skip - * the plt section. - */ - if ((shdr->sh_addr) && (!((shdr->sh_type == SHT_PROGBITS) - && (strcmp(_icache->c_name, ".plt") == 0)))) - data->d_buf = (void *)shdr->sh_addr; - - /* - * Update any NOBITS section to indicate that it now contains - * data. - */ - if (shdr->sh_type == SHT_NOBITS) - shdr->sh_type = SHT_PROGBITS; - - /* - * Add the new .heap section after the last section of the - * present data segment. If we had a heap section, then - * this is the section preceding it. - */ - if (data_cache == _icache) { - if ((scn = elf_newscn(oelf)) == NULL) - return (elferr("elf_newscn")); - if ((shdr = elf_getshdr(scn)) == NULL) - return (elferr("elf_getshdr")); - shdr->sh_type = SHT_PROGBITS; - shdr->sh_flags = SHF_ALLOC | SHF_WRITE; - - if ((data = elf_newdata(scn)) == NULL) - return (elferr("elf_newdata")); - *data = rundata; - } - - /* - * Update the section header string table size to reflect the - * new section name (only if we didn't already have a heap). - */ - if (!heap_cache) { - if (shstr_cache && (shstr_cache == _icache)) { - data->d_size += sizeof (heap); - } - } - } - - /* - * Write out the new image, and obtain a new elf descriptor that will - * allow us to write to the new image. - */ - if (elf_update(oelf, ELF_C_WRITE) == -1) - return (elferr("elf_update")); - elf_end(oelf); - if ((oelf = elf_begin(fd, ELF_C_RDWR, NULL)) == NULL) - return (elferr("elf_begin")); - if ((oehdr = elf_getehdr(oelf)) == NULL) - return (elferr("elf_getehdr")); - - /* - * Obtain the output files section header string table. - */ - if ((scn = elf_getscn(oelf, oehdr->e_shstrndx)) == NULL) - return (elferr("elf_getscn")); - if ((data = elf_getdata(scn, NULL)) == NULL) - return (elferr("elf_getdata")); - ostrs = _ostrs = (char *) data->d_buf; - *_ostrs++ = '\0'; - - /* - * Construct a cache to maintain the output files section information. - */ - if ((ocache = (Cache *)malloc(oehdr->e_shnum * sizeof (Cache))) == 0) { - fprintf(stderr, "malloc failed: %s\n", strerror(errno)); - return (1); - } - _ocache = ocache; - _ocache++; - _icache = icache; - _icache++; - - /* - * Traverse each section from the input file rebuilding the section - * header string table as we go. - */ - _ndx = _addr = 0; - for (ndx = 1, scn = 0; - (_ocache->c_scn = elf_nextscn(oelf, scn)); - ndx++, scn = _ocache->c_scn, _ocache++, _icache++) { - - const char *strs; - - if (_icache == heap_cache) { -#ifdef DEBUG - printf("ignoring .heap section in input\n"); -#endif - _icache++; - } - - if ((_ocache->c_shdr = shdr = - elf_getshdr(_ocache->c_scn)) == NULL) - return (elferr("elf_getshdr")); - if ((_ocache->c_data = - elf_getdata(_ocache->c_scn, NULL)) == NULL) - return (elferr("elf_getdata")); - - /* - * If were inserting the new .heap section, insert the new - * section name and initialize its virtual address. - */ - if (_addr) { - strs = heap; - shdr->sh_addr = S_ROUND(_addr, shdr->sh_addralign); - _addr = 0; - } else { - strs = istrs + (size_t)(_icache->c_shdr->sh_name); - } - - strcpy(_ostrs, strs); - shdr->sh_name = _ostrs - ostrs; - _ocache->c_name = _ostrs; - _ostrs += strlen(strs) + 1; - - /* - * If we've inserted a new section any later section may need - * their sh_link fields updated. - * If we already had a heap section, then this is not required. - */ - if (!heap_cache) { - if (_ndx) { - if (_ocache->c_shdr->sh_link >= _ndx) - _ocache->c_shdr->sh_link++; - } - } - - /* - * If this is the last section of the original data segment - * determine sufficient information to initialize the new .heap - * section which will be obtained next. - */ - if (data_cache == _icache) { - _ndx = ndx + 1; - _addr = shdr->sh_addr + shdr->sh_size; - _icache--; - data_cache = 0; - } - } - - /* - * Now that we have a complete description of the new image update any - * sections that are required. - * - * o update the value of _edata and _end. - * - * o reset any relocation entries if necessary. - */ - _ocache = &ocache[1]; - _icache = &icache[1]; - for (ndx = 1; ndx < oehdr->e_shnum; ndx++, _ocache++, _icache++) { - if ((_ocache->c_shdr->sh_type == SHT_SYMTAB) || - (_ocache->c_shdr->sh_type == SHT_DYNSYM)) - update_sym(ocache, _ocache, edata); - - if (_ocache->c_shdr->sh_type == M_REL_SHT_TYPE) - update_reloc(ocache, _ocache, icache, _icache, oehdr->e_shnum); - } - - if (elf_update(oelf, ELF_C_WRITE) == -1) - return (elferr("elf_update")); - - elf_end(oelf); - elf_end(ielf); - return (0); -} diff --git a/dynodump/i386/_relocate.c b/dynodump/i386/_relocate.c deleted file mode 100644 index d3ec59c..0000000 --- a/dynodump/i386/_relocate.c +++ /dev/null @@ -1,118 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: _relocate.c,v 1.4 1995/06/26 20:12:41 georgn Exp $ - SMI" - -/* LINTLIBRARY */ - -#include -#include -#include -#include "_dynodump.h" - -void -update_reloc(Cache *ocache, Cache *_ocache, - Cache *icache, Cache *_icache, - Half shnum) -{ - Shdr *shdr; - Rel *rels; - int reln, cnt; - Cache *orcache, *ircache; - - /* - * Set up to readh the output relocation table. - */ - shdr = _ocache->c_shdr; - rels = (Rel *) _ocache->c_data->d_buf; - reln = shdr->sh_size / shdr->sh_entsize; - - /* - * Determine the section that is being relocated. - */ - orcache = &ocache[shdr->sh_info]; - shdr = _icache->c_shdr; - ircache = &icache[shdr->sh_info]; - - /* - * Determine the section that is being relocated. Note that for this - * stupid architecture the .rel.plt actually contains offsets into the - * .got. - */ - if (strcmp(_ocache->c_name, ".rel.plt")) { - orcache = &ocache[shdr->sh_info]; - shdr = _icache->c_shdr; - ircache = &icache[shdr->sh_info]; - } else { - Half ndx; - Cache * __ocache = ocache; - - for (__ocache++, ndx = 1; ndx != shnum; ndx++, __ocache++) { - if (strcmp(__ocache->c_name, ".got") == 0) { - orcache = __ocache; - ircache = &icache[ndx]; - break; - } - } - } - - /* - * Loop through the relocation table. - */ - for (cnt = 0; cnt < reln; cnt++, rels++) { - unsigned char *iaddr, *oaddr; - Addr off; - unsigned char type = ELF_R_TYPE(rels->r_info); - - /* - * Ignore some relocations as these can be safely carried out - * twice (they simply override any existing data). In fact, - * some relocations like __iob's copy relocation must be carried - * out each time the process restarts, otherwise stdio blows up. - */ - if ((type == R_386_COPY) || (type == R_386_NONE)) - continue; - - /* - * If we are required to restore the relocation location - * to its value prior to relocation, then read the - * location's original contents from the input image and - * copy it to the output image. - */ - off = rels->r_offset - ircache->c_shdr->sh_addr; - iaddr = (unsigned char *) ircache->c_data->d_buf + off; - oaddr = (unsigned char *) orcache->c_data->d_buf + off; - *(unsigned long *) oaddr = *(unsigned long *) iaddr; - } -} diff --git a/dynodump/i386/machdep.h b/dynodump/i386/machdep.h deleted file mode 100644 index c90e29c..0000000 --- a/dynodump/i386/machdep.h +++ /dev/null @@ -1,93 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: machdep.h,v 1.2 1995/02/16 22:58:43 georgn Exp $ - SMI" - -/* - * Global include file for all sgs Intel machine dependent macros, constants - * and declarations. - */ -#ifndef MACHDEP_DOT_H -#define MACHDEP_DOT_H - -#include -#include - -/* - * Make machine class dependent data types transparent to the common code - */ -#define Word Elf32_Word -#define Sword Elf32_Sword -#define Half Elf32_Half -#define Addr Elf32_Addr -#define Off Elf32_Off -#define Byte unsigned char - -#define Ehdr Elf32_Ehdr -#define Shdr Elf32_Shdr -#define Sym Elf32_Sym -#define Rel Elf32_Rel -#define Phdr Elf32_Phdr -#define Dyn Elf32_Dyn -#define Boot Elf32_Boot -#define Verdef Elf32_Verdef -#define Verdaux Elf32_Verdaux -#define Verneed Elf32_Verneed -#define Vernaux Elf32_Vernaux -#define Versym Elf32_Versym - -/* - * Make machine class dependent functions transparent to the common code - */ -#define ELF_R_TYPE ELF32_R_TYPE -#define ELF_R_INFO ELF32_R_INFO -#define ELF_R_SYM ELF32_R_SYM -#define ELF_ST_BIND ELF32_ST_BIND -#define ELF_ST_TYPE ELF32_ST_TYPE -#define ELF_ST_INFO ELF32_ST_INFO -#define elf_fsize elf32_fsize -#define elf_getehdr elf32_getehdr -#define elf_getphdr elf32_getphdr -#define elf_newehdr elf32_newehdr -#define elf_newphdr elf32_newphdr -#define elf_getshdr elf32_getshdr -#define elf_xlatetof elf32_xlatetof -#define elf_xlatetom elf32_xlatetom - -/* - * Make relocation types transparent to the common code - */ -#define M_REL_SHT_TYPE SHT_REL /* section header type */ - -#endif diff --git a/dynodump/ppc/_relocate.c b/dynodump/ppc/_relocate.c deleted file mode 100644 index feb5ca9..0000000 --- a/dynodump/ppc/_relocate.c +++ /dev/null @@ -1,269 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: _relocate.c,v 1.3 1995/06/26 20:16:39 georgn Exp $ - SMI" - -/* LINTLIBRARY */ - -#include -#include -#include "_dynodump.h" - - -/* - * NOTE: These macros will work reliably only on 32-bit 2's - * complement machines. The type of P in all cases should - * by unsigned char * - */ -#if defined(_BIG_ENDIAN) - -#define GET4(P) ((long)(((unsigned long)(P)[0] << 24) | \ - ((unsigned long)(P)[1] << 16) | \ - ((unsigned long)(P)[2] << 8) | \ - (unsigned long)(P)[3])) -#define PUT4(V, P) { \ - (P)[0] = (unsigned char)((V) >> 24); \ - (P)[1] = (unsigned char)((V) >> 16); \ - (P)[2] = (unsigned char)((V) >> 8); \ - (P)[3] = (unsigned char)(V); \ - } -#define GEThalf(P) ((long) (((unsigned long) (P)[0] << 8) | \ - ((unsigned long) (P)[1]))) -#define GETword(P) GET4(P) -#define PUThalf(V, P) { \ - (P)[0] = ((V) >> 8); \ - (P)[1] = ((V)); \ - } -#define PUTword(V, P) PUT4(V, P) - -#elif defined(_LITTLE_ENDIAN) - -#define GET4(P) ((long)(((unsigned long)(P)[0]) | \ - ((unsigned long)(P)[1] << 8) | \ - ((unsigned long)(P)[2] << 16) | \ - ((unsigned long)(P)[3]) << 24)) -#define PUT4(V, P) { \ - (P)[0] = (unsigned char)(V); \ - (P)[1] = (unsigned char)((V) >> 8); \ - (P)[2] = (unsigned char)((V) >> 16); \ - (P)[3] = (unsigned char)((V) >> 24); \ - } -#define GEThalf(P) ((long) (((unsigned long) (P)[0]) | \ - ((unsigned long) (P)[1] << 8))) -#define GETword(P) GET4(P) -#define PUThalf(V, P) { \ - (P)[0] = (V); \ - (P)[1] = ((V) >> 8); \ - } -#define PUTword(V, P) PUT4(V, P) - -#endif /* defined(_LITTLE_ENDIAN) */ - -/* - * NAME VALUE FIELD CALCULATION - * - * R_PPC_NONE 0 none none - * R_PPC_ADDR32 1 word32 S + A - * R_PPC_ADDR24 2 low24 (S + A) >> 2 - * R_PPC_ADDR16 3 half16 S + A - * R_PPC_ADDR16_LO 4 half16 #lo(S + A) - * R_PPC_ADDR16_HI 5 half16 #hi(S + A) - * R_PPC_ADDR16_HA 6 half16 #ha(S + A) - * R_PPC_ADDR14 7 low14 (S + A) >> 2 - * R_PPC_ADDR14_BRTAKEN 8 low14 (S + A) >> 2 - * R_PPC_ADDR14_BRNTAKEN 9 low14 (S + A) >> 2 - * R_PPC_REL24 10 low24 (S + A - P) >> 2 - * R_PPC_REL14 11 low14 (S + A - P) >> 2 - * R_PPC_REL14_BRTAKEN 12 low14 (S + A - P) >> 2 - * R_PPC_REL14_BRNTAKEN 13 low14 (S + A - P) >> 2 - * R_PPC_GOT16 14 half16 G + A - * R_PPC_GOT16_LO 15 half16 #lo(G + A) - * R_PPC_GOT16_HI 16 half16 #hi(G + A) - * R_PPC_GOT16_HA 17 half16 #ha(G + A) - * R_PPC_PLT24 18 low24 (L + A - P) >> 2 - * R_PPC_COPY 19 none none - * R_PPC_GLOB_DAT 20 word32 S + A - * R_PPC_JMP_SLOT 21 none see below - * R_PPC_RELATIVE 22 word32 B + A - * R_PPC_LOCAL24PC 23 low24 see below - * R_PPC_UADDR32 24 word32 S + A - * R_PPC_UADDR16 25 half16 S + A - * - * This is Figure 4-3: Relocation Types from the Draft Copy of - * the ABI, Printed on 7/25/94. - * - * The field column specifies how much of the data - * at the reference address is to be used. The data are assumed to be - * right-justified with the least significant bit at the right. - * In the case of plt24 addresses, the reference address is - * assumed to be that of a 6-word PLT entry. The address is the right- - * most 24 bits of the third word. - */ -static void -move_reloc(unsigned char *iaddr, unsigned char *oaddr, unsigned char type) -{ - switch(type) { - case R_PPC_NONE: - break; - - case R_PPC_ADDR32: - case R_PPC_UADDR32: - PUTword(GETword(iaddr), oaddr); - break; - - case R_PPC_ADDR24: - case R_PPC_REL24: - case R_PPC_PLT24: - case R_PPC_LOCAL24PC: - /* XXX - big assumption here that the original contents were masked - * properly. If this assumption proves correct, then these 24bit - * cases can be folded into the above 32bit cases. - */ - PUTword(GETword(iaddr), oaddr); - break; - - case R_PPC_ADDR16: - case R_PPC_UADDR16: - case R_PPC_GOT16: - PUThalf(GEThalf(iaddr), oaddr); - break; - - case R_PPC_ADDR16_LO: - case R_PPC_GOT16_LO: - /* XXX - more assumptions which if proved correct, we can - * do some folding with above cases - */ - PUThalf(GEThalf(iaddr), oaddr); - break; - - case R_PPC_ADDR16_HI: - case R_PPC_GOT16_HI: - /* XXX - more assumptions which if proved correct, we can - * do some folding with above cases - */ - PUThalf(GEThalf(iaddr), oaddr); - break; - - case R_PPC_ADDR16_HA: - case R_PPC_GOT16_HA: - /* XXX - more assumptions which if proved correct, we can - * do some folding with above cases - */ - PUThalf(GEThalf(iaddr), oaddr); - break; - - case R_PPC_ADDR14: - case R_PPC_ADDR14_BRTAKEN: - case R_PPC_ADDR14_BRNTAKEN: - case R_PPC_REL14: - case R_PPC_REL14_BRTAKEN: - case R_PPC_REL14_BRNTAKEN: - /* XXX - big assumption here that the original contents were masked - * properly. If this assumption proves correct, then these 14bit - * cases can be folded into the above 32bit cases. - */ - PUTword(GETword(iaddr), oaddr); - break; - - case R_PPC_COPY: - break; - - case R_PPC_GLOB_DAT: - case R_PPC_RELATIVE: - PUTword(GETword(iaddr), oaddr); - break; - - case R_PPC_JMP_SLOT: - break; - - default: - break; - } -} - -void -update_reloc(Cache *ocache, Cache *_ocache, Cache *icache, Cache *_icache, Half shnum) -{ - Shdr *shdr; - Rel *rels; - int reln, cnt; - Cache *orcache, * ircache; - - /* - * Set up to read the output relocation table. - */ - shdr = _ocache->c_shdr; - rels = (Rel *)_ocache->c_data->d_buf; - reln = shdr->sh_size / shdr->sh_entsize; - - /* - * Determine the section that is being relocated. - */ - orcache = &ocache[shdr->sh_info]; - shdr = _icache->c_shdr; - ircache = &icache[shdr->sh_info]; - - /* - * Loop through the relocation table. - */ - for (cnt = 0; cnt < reln; cnt++, rels++) { - unsigned char type = ELF_R_TYPE(rels->r_info); - - /* - * Ignore some relocations as these can safely be carried out - * twice (they simply override any existing data). In fact, - * some relocations like __iob's copy relocation must be carried - * out each time the process restarts otherwise stdio blows up. - */ - if ((type == R_PPC_COPY) || (type == R_PPC_JMP_SLOT) || - (type == R_PPC_NONE)) - continue; - - { - unsigned char *iaddr, *oaddr; - Addr off; - - /* - * If we are required to restore the relocation location - * to its value prior to relocation, then read the - * locations original contents from the input image and - * copy it to the output image. - */ - off = rels->r_offset - ircache->c_shdr->sh_addr; - iaddr = (unsigned char *)ircache->c_data->d_buf + off; - oaddr = (unsigned char *)orcache->c_data->d_buf + off; - move_reloc(iaddr, oaddr, type); - } - } -} diff --git a/dynodump/ppc/machdep.h b/dynodump/ppc/machdep.h deleted file mode 100644 index 2a3d1e6..0000000 --- a/dynodump/ppc/machdep.h +++ /dev/null @@ -1,88 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: machdep.h,v 1.2 1995/02/16 22:58:49 georgn Exp $ - SMI" - -/* - * Global include file for all sgs PowerPC machine dependent macros, constants - * and declarations. - */ -#ifndef MACHDEP_DOT_H -#define MACHDEP_DOT_H - -#include -#include - -/* - * Make machine class dependent data types transparent to the common code - */ -#define Word Elf32_Word -#define Sword Elf32_Sword -#define Half Elf32_Half -#define Addr Elf32_Addr -#define Off Elf32_Off -#define Byte unsigned char - -#define Ehdr Elf32_Ehdr -#define Shdr Elf32_Shdr -#define Sym Elf32_Sym -#define Rel Elf32_Rela -#define Phdr Elf32_Phdr -#define Dyn Elf32_Dyn -#define Boot Elf32_Boot -#define Verdef Elf32_Verdef -#define Verdaux Elf32_Verdaux -#define Verneed Elf32_Verneed -#define Vernaux Elf32_Vernaux -#define Versym Elf32_Versym - -/* - * Make machine class dependent functions transparent to the common code - */ -#define ELF_R_TYPE ELF32_R_TYPE -#define ELF_R_INFO ELF32_R_INFO -#define ELF_R_SYM ELF32_R_SYM -#define ELF_ST_BIND ELF32_ST_BIND -#define ELF_ST_TYPE ELF32_ST_TYPE -#define ELF_ST_INFO ELF32_ST_INFO -#define elf_fsize elf32_fsize -#define elf_getehdr elf32_getehdr -#define elf_getphdr elf32_getphdr -#define elf_newehdr elf32_newehdr -#define elf_newphdr elf32_newphdr -#define elf_getshdr elf32_getshdr - -#define M_REL_SHT_TYPE SHT_RELA /* section header type */ - -#endif diff --git a/dynodump/sparc/_relocate.c b/dynodump/sparc/_relocate.c deleted file mode 100644 index 10b0fda..0000000 --- a/dynodump/sparc/_relocate.c +++ /dev/null @@ -1,294 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * Update the value of the `_edata' and `_end' symbols. - */ -#pragma ident "@(#) $Id: _relocate.c,v 1.4 1995/06/26 20:13:26 georgn Exp $ - SMI" - -#include -#include -#include "machdep.h" -#include "_dynodump.h" - - -#define GETbyte(P) ((long)((unsigned long)(P)[0])) -#define GEThalf(P) ((long)(((unsigned long)(P)[0] << 8) | \ - ((unsigned long)(P)[1]))) -#define GETword(P) ((long)(((unsigned long)(P)[0] << 24) | \ - ((unsigned long)(P)[1] << 16) | \ - ((unsigned long)(P)[2] << 8) | \ - (unsigned long)(P)[3])) -#define GETdisp30(P) (GETword(P) & 0x3fffffff) -#define GETdisp22(P) (GETword(P) & 0x3fffff) -#define GETdisp16(P) (((GETword(P) & 0x300000) >> 6) | \ - (GETword(P) & 0x3fff)) -#define GETdisp19(P) (GETword(P) & 0x7ffff) -#define GETimm22(P) (GETword(P) & 0x3fffff) -#define GETimm5(P) (GEThalf((P)+2) & 0x1f) -#define GETimm6(P) (GEThalf((P)+2) & 0x2f) -#define GETimm7(P) (GEThalf((P)+2) & 0x3f) -#define GETsimm13(P) (GEThalf((P)+2) & 0x1fff) -#define GETsimm10(P) (GEThalf((P)+2) & 0x3ff) -#define GETsimm11(P) (GEThalf((P)+2) & 0x7ff) -#define GETplt22(P) (GETword((P)+8) & 0x3fffff) - -#define PUTbyte(V, P) (P)[0] = (V) -#define PUThalf(V, P) (P)[0] = ((V) >> 8); \ - (P)[1] = ((V)) -#define PUTword(V, P) (P)[0] = (unsigned char)((V) >> 24); \ - (P)[1] = (unsigned char)((V) >> 16); \ - (P)[2] = (unsigned char)((V) >> 8); \ - (P)[3] = (unsigned char)(V) -#define PUTdisp30(V, P) { \ - unsigned long int temp; \ - temp = GETword(P) & ~0x3fffffff; \ - temp |= ((V) & 0x3fffffff); \ - PUTword(temp, P); \ - } -#define PUTdisp22(V, P) { \ - unsigned long int temp; \ - temp = GETword(P) & ~0x3fffff; \ - temp |= ((V) & 0x3fffff); \ - PUTword(temp, P); \ - } -#define PUTimm22(V, P) { \ - unsigned long int temp; \ - temp = GETword(P) & ~0x3fffff; \ - temp |= ((V) & 0x3fffff); \ - PUTword(temp, P); \ - } -#define PUTimm5(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x1f; \ - temp |= ((V) & 0x1f); \ - PUThalf(temp, (P+2)); \ - } -#define PUTimm6(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x2f; \ - temp |= ((V) & 0x2f); \ - PUThalf(temp, (P+2)); \ - } -#define PUTimm7(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x3f; \ - temp |= ((V) & 0x3f); \ - PUThalf(temp, (P+2)); \ - } -#define PUTsimm13(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x1fff; \ - temp |= ((V) & 0x1fff); \ - PUThalf(temp, (P+2)); \ - } -#define PUTplt22(V, P) { \ - unsigned long int temp; \ - temp = GETword((P)+8) & ~0x3fffff; \ - temp |= ((V) & 0x3fffff); \ - PUTword(temp, ((P)+8)); \ - } -#define PUTsimm10(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x3ff; \ - temp |= ((V) & 0x3ff); \ - PUThalf(temp, (P+2)); \ - } -#define PUTsimm11(V, P) { \ - unsigned long int temp; \ - temp = GEThalf(P+2) & ~0x7ff; \ - temp |= ((V) & 0x7ff); \ - PUThalf(temp, (P+2)); \ - } -#define PUTdisp16(V, P) { \ - unsigned long int temp; \ - temp = GETword(P) & ~0x303fff; \ - temp |= ((V) & 0xc000) << 6; \ - temp |= ((V) & 0x3fff); \ - PUTword(temp, P); \ - } -#define PUTdisp19(V, P) { \ - unsigned long int temp; \ - temp = GETword(P) & ~0x7ffff; \ - temp |= ((V) & 0x7ffff); \ - PUTword(temp, P); \ - } - -static void -move_reloc(unsigned char * iaddr, unsigned char * oaddr, unsigned char type) -{ - switch (type) { - case R_SPARC_8: - case R_SPARC_DISP8: - PUTbyte(GETbyte(iaddr), oaddr); - break; - - case R_SPARC_16: - case R_SPARC_DISP16: - PUThalf(GEThalf(iaddr), oaddr); - break; - - case R_SPARC_32: - case R_SPARC_DISP32: - case R_SPARC_GLOB_DAT: - case R_SPARC_RELATIVE: - case R_SPARC_UA32: - PUTword(GETword(iaddr), oaddr); - break; - - case R_SPARC_WDISP30: - case R_SPARC_WPLT30: - PUTdisp30(GETdisp30(iaddr), oaddr); - break; - - case R_SPARC_WDISP22: - case R_SPARC_PC22: - PUTdisp22(GETdisp22(iaddr), oaddr); - break; - - case R_SPARC_HI22: - case R_SPARC_GOT22: - case R_SPARC_22: - PUTimm22(GETimm22(iaddr), oaddr); - break; - - case R_SPARC_13: - case R_SPARC_GOT13: - PUTsimm13(GETsimm13(iaddr), oaddr); - break; - - case R_SPARC_LO10: - case R_SPARC_GOT10: - case R_SPARC_PC10: -#ifdef R_SPARC_10 - case R_SPARC_10: -#endif - PUTsimm10(GETsimm10(iaddr), oaddr); - break; - -#ifdef R_SPARC_11 - case R_SPARC_11: - PUTsimm11(GETsimm11(iaddr), oaddr); - break; -#endif - -#ifdef R_SPARC_WDISP16 - case R_SPARC_WDISP16: - PUTdisp16(GETdisp16(iaddr), oaddr); - break; -#endif - -#ifdef R_SPARC_WDISP19 - case R_SPARC_WDISP19: - PUTdisp19(GETdisp19(iaddr), oaddr); - break; -#endif - -#ifdef R_SPARC_5 - case R_SPARC_5: - PUTimm5(GETimm5(iaddr), oaddr); - break; -#endif - -#ifdef R_SPARC_6 - case R_SPARC_6: - PUTimm6(GETimm6(iaddr), oaddr); - break; -#endif - -#ifdef R_SPARC_7 - case R_SPARC_7: - PUTimm7(GETimm7(iaddr), oaddr); - break; -#endif - - default: - break; - } -} - -void -update_reloc(Cache *ocache, Cache *_ocache, - Cache *icache, Cache *_icache, - Half shnum) -{ - Shdr *shdr; - Rel *rels; - int reln, cnt; - Cache *orcache, *ircache; - - /* - * Set up to read the output relocation table. - */ - shdr = _ocache->c_shdr; - rels = (Rel *)_ocache->c_data->d_buf; - reln = shdr->sh_size / shdr->sh_entsize; - - /* - * Determine the section that is being relocated. - */ - orcache = &ocache[shdr->sh_info]; - shdr = _icache->c_shdr; - ircache = &icache[shdr->sh_info]; - - /* - * Loop through the relocation table. - */ - for (cnt = 0; cnt < reln; cnt++, rels++) { - unsigned char *iaddr, *oaddr; - Addr off; - unsigned char type = ELF_R_TYPE(rels->r_info); - - /* - * Ignore some relocations as these can safely be carried out - * twice (they simply override any existing data). In fact, - * some relocations like __iob's copy relocation must be carried - * out each time the process restarts otherwise stdio blows up. - */ - if ((type == R_SPARC_COPY) || (type == R_SPARC_JMP_SLOT) || - (type == R_SPARC_NONE)) - continue; - - /* - * If we are required to restore the relocation location - * to its value prior to relocation, then read the - * locations original contents from the input image and - * copy it to the output image. - */ - off = rels->r_offset - ircache->c_shdr->sh_addr; - iaddr = (unsigned char *)ircache->c_data->d_buf + off; - oaddr = (unsigned char *)orcache->c_data->d_buf + off; - move_reloc(iaddr, oaddr, type); - } -} diff --git a/dynodump/sparc/machdep.h b/dynodump/sparc/machdep.h deleted file mode 100644 index 972081e..0000000 --- a/dynodump/sparc/machdep.h +++ /dev/null @@ -1,91 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -#pragma ident "@(#) $Id: machdep.h,v 1.2 1995/02/16 22:58:55 georgn Exp $ - SMI" - -/* - * Global include file for all sgs SPARC machine dependent macros, constants - * and declarations. - */ -#ifndef MACHDEP_DOT_H -#define MACHDEP_DOT_H - -#include -#include - -/* - * Make machine class dependent data types transparent to the common code - */ -#define Word Elf32_Word -#define Sword Elf32_Sword -#define Half Elf32_Half -#define Addr Elf32_Addr -#define Off Elf32_Off -#define Byte unsigned char - -#define Ehdr Elf32_Ehdr -#define Shdr Elf32_Shdr -#define Sym Elf32_Sym -#define Rel Elf32_Rela -#define Phdr Elf32_Phdr -#define Dyn Elf32_Dyn -#define Boot Elf32_Boot -#define Verdef Elf32_Verdef -#define Verdaux Elf32_Verdaux -#define Verneed Elf32_Verneed -#define Vernaux Elf32_Vernaux -#define Versym Elf32_Versym - -/* - * Make machine class dependent functions transparent to the common code - */ -#define ELF_R_TYPE ELF32_R_TYPE -#define ELF_R_INFO ELF32_R_INFO -#define ELF_R_SYM ELF32_R_SYM -#define ELF_ST_BIND ELF32_ST_BIND -#define ELF_ST_TYPE ELF32_ST_TYPE -#define ELF_ST_INFO ELF32_ST_INFO -#define elf_fsize elf32_fsize -#define elf_getehdr elf32_getehdr -#define elf_getphdr elf32_getphdr -#define elf_newehdr elf32_newehdr -#define elf_newphdr elf32_newphdr -#define elf_getshdr elf32_getshdr - -/* - * Make relocation types transparent to the common code - */ -#define M_REL_SHT_TYPE SHT_RELA /* section header type */ - -#endif diff --git a/dynodump/syms.c b/dynodump/syms.c deleted file mode 100644 index c060f33..0000000 --- a/dynodump/syms.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 1995 by Sun Microsystems, Inc. - * All rights reserved. - * - * This source code is a product of Sun Microsystems, Inc. and is provided - * for unrestricted use provided that this legend is included on all tape - * media and as a part of the software program in whole or part. Users - * may copy or modify this source code without charge, but are not authorized - * to license or distribute it to anyone else except as part of a product or - * program developed by the user. - * - * THIS PROGRAM CONTAINS SOURCE CODE COPYRIGHTED BY SUN MICROSYSTEMS, INC. - * SUN MICROSYSTEMS, INC., MAKES NO REPRESENTATIONS ABOUT THE SUITABLITY - * OF SUCH SOURCE CODE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT - * EXPRESS OR IMPLIED WARRANTY OF ANY KIND. SUN MICROSYSTEMS, INC. DISCLAIMS - * ALL WARRANTIES WITH REGARD TO SUCH SOURCE CODE, INCLUDING ALL IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN - * NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL, INDIRECT, - * INCIDENTAL, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING - * FROM USE OF SUCH SOURCE CODE, REGARDLESS OF THE THEORY OF LIABILITY. - * - * This source code is provided with no support and without any obligation on - * the part of Sun Microsystems, Inc. to assist in its use, correction, - * modification or enhancement. - * - * SUN MICROSYSTEMS, INC. SHALL HAVE NO LIABILITY WITH RESPECT TO THE - * INFRINGEMENT OF COPYRIGHTS, TRADE SECRETS OR ANY PATENTS BY THIS - * SOURCE CODE OR ANY PART THEREOF. - * - * Sun Microsystems, Inc. - * 2550 Garcia Avenue - * Mountain View, California 94043 - */ - -/* - * Update the value of the `_edata' and `_end' symbols. - */ -#pragma ident "@(#) $Id: syms.c,v 1.2 1995/03/06 22:39:22 georgn Exp $ - SMI" - -#include -#include -#include "machdep.h" -#include "_dynodump.h" - -void -update_sym(Cache * cache, Cache * _cache, Addr edata) -{ - char *strs; - Sym *syms; - Shdr *shdr; - int symn, cnt; - - /* - * Set up to read the symbol table and its associated string table. - */ - shdr = _cache->c_shdr; - syms = (Sym *) _cache->c_data->d_buf; - symn = shdr->sh_size / shdr->sh_entsize; - - strs = (char *) cache[shdr->sh_link].c_data->d_buf; - - /* - * Loop through the symbol table looking for `_end' and `_edata'. - */ - for (cnt = 0; cnt < symn; cnt++, syms++) { - char *name = strs + syms->st_name; - - if (strcmp(name, "_end") && strcmp(name, "_edata")) - continue; - - syms->st_value = edata; - } -} diff --git a/etc/BETA b/etc/BETA deleted file mode 100644 index b5babd1..0000000 --- a/etc/BETA +++ /dev/null @@ -1,370 +0,0 @@ - -*- mode:outline -*- - -* Introduction -============== - -You are running an experimental version of XEmacs. Please do not -report problems with Beta XEmacs to comp.emacs.xemacs. Report them to -xemacs-beta@xemacs.org. - -** XEmacs Beta Mailing List -=========================== - -*** Subscribing ---------------- - -If you are not subscribed to the XEmacs beta list you should be. Send -an email message to xemacs-beta-request@xemacs.org with `subscribe' -(without the quotes) as the BODY of the message. - -*** Unsubscribing ------------------ - -To unsubscribe from the list send an email message to -xemacs-beta-request@xemacs.org with `unsubscribe' (without the quotes) -as the BODY of the message. - -*** Administrivia ------------------ - -The XEmacs beta list is managed by the Majordomo mailing list package, -and the usual Majordomo commands work. Do not send mailing list -requests to the main address (xemacs-beta@xemacs.org), always send -them to xemacs-beta-request@xemacs.org. If you have problems with the -list itself, they should be brought to the attention of the XEmacs -Mailing List manager Jason Mastaler . - - -** Beta Release Schedule -======================== - -The URL ftp://ftp.xemacs.org/pub/xemacs/beta/README always contains -the best estimate of when the next beta XEmacs will be released. For -weekend betas the release time is generally in the vicinity of 2PM to -5PM US Pacific Time (Universal Time minus 8 hours). For weekday -betas, the release time is generally in the vicinity of 8PM to -Midnight US Pacific Time on the listed day. - -Betas are nominally a week apart, scheduled on every Saturday. -Midweek releases are made when a serious enough problem warrants it. - - -** Reporting Problems -===================== - -The best way to get problems fixed in XEmacs is to submit good problem -reports. Since this is beta software, problems are certain to exist. -Please read through all of part II of the XEmacs FAQ for an overview -of problem reporting. Other items which are most important are: - -1. Do not submit C stack backtraces without line numbers. Since it - is possible to compile optimized with debug information with GCC - it is never a good idea to compile XEmacs without the -g flag. - XEmacs runs on a variety of platforms, and often it is not - possible to recreate problems which afflict a specific platform. - The line numbers in the C stack backtrace help isolate where the - problem is actually occurring. - -2. Attempt to recreate the problem starting with an invocation of - XEmacs with `xemacs -q -no-site-file'. Quite often, problems are - due to package interdependencies, and the like. An actual bug in - XEmacs should be reproducible in a default configuration without - loading any special packages (or the one or two specific packages - that cause the bug to appear). - -3. A picture can be worth a thousand words. When reporting an - unusual display, it is generally best to capture the problem in a - screen dump and include that with the problem report. The easiest - way to get a screen dump is to use the xv program and its grab - function. Save the image as a GIF to keep bandwidth requirements - down without loss of information. MIME is the preferred method - for making the image attachments. - -** Getting the Source -===================== - -In addition to the normal tar distribution, XEmacs source is now -available via CVS. Please see the URL: . - -* Compiling Beta XEmacs -======================= - -** Building an XEmacs from patches -================================== - -All beta releases of XEmacs are included with patches from the -previous version in an attempt to keep bandwidth requirements down. -Patches should be applied with the GNU patch program in something like -the following. Let's say you're upgrading XEmacs 20.15-beta10 to -XEmacs 20.15-beta11 and you have a full unmodified XEmacs 20.15-beta10 -source tree to work with. Cd to the top level directory and issue the -shell command: - -$ gunzip -c /tmp/xemacs-20.15-b10-20.15-b11.patch.gz | patch -p1 - -After patching, check to see that no patches were missed by doing -$ find . -name \*.rej -print - -Any rejections should be treated as serious problems to be resolved -before building XEmacs. - -After seeing that there were no rejections, issue the commands - -$ ./config.status --recheck -$ make beta - -and go play minesweep for a while on an older XEmacs while the binary -is rebuilt. - -** Building XEmacs from a full distribution -============================================== - -Locate a convenient place where you have at least 100MB of free space -and issue the command - -$ gunzip -c /tmp/xemacs-20.15-b11.tar.gz | tar xvf - - -(or simply `tar zxvf /tmp/xemacs-20.15-b11.tar.gz' if you use GNU tar). - -cd to the top level directory and issue an appropriate configure -command. One maintainer uses the following at the time of this -writing: - -./configure \ - --cflags="-mpentium -march=pentium -O6 -g -fno-peep-spills" \ - --error-checking=all --debug=yes \ - --with-scrollbars=athena3d --with-dialogs=athena3d \ - --with-mule --with-xfs --with-xim=xlib - -Part of the configure output is a summary that looks something like: - -uname -a: Linux altair.xemacs.org 2.0.32 #2 Sun Nov 16 18:52:14 PST 1997 i586 - -./configure '--cflags=-mpentium -march=pentium -O6 -g -fno-peep-spills' '--error-checking=all' '--debug=yes' '--with-scrollbars=athena3d' '--with-dialogs=athena3d' '--with-mule' '--with-xfs' '--with-xim=xlib' - - -XEmacs 21.0-b34 "Oberhasli-pre2" configured for `i586-pc-linux'. - - Where should the build process find the source code? /home/xemacs/xemacs-20.0 - What installation prefix should install use? /usr/local - What operating system and machine description files should XEmacs use? - `s/linux.h' and `m/intel386.h' - What compiler should XEmacs be built with? gcc -mpentium -march=pentium -O6 -g -fno-peep-spills - Should XEmacs use the GNU version of malloc? yes - (Using Doug Lea's new malloc from the GNU C Library.) - Should XEmacs use the relocating allocator for buffers? yes - What window system should XEmacs use? x11 - Where do we find X Windows header files? /usr/X11/include - Where do we find X Windows libraries? /usr/X11/lib - Compiling in support for XAUTH. - Compiling in support for XPM images. - Compiling in support for X-Face message headers. - Compiling in support for GIF image conversion. - Compiling in support for JPEG image conversion. - Compiling in support for PNG image conversion. - Compiling in support for TIFF image conversion. - Compiling in native sound support. - Compiling in support for Berkeley DB. - Compiling in support for GNU DBM. - Compiling in support for ncurses. - Compiling in support for GPM (General Purpose Mouse). - Compiling in Mule (multi-lingual) support. - Compiling in XIM (X11R5+ I18N input method) support. - Using raw Xlib to provide XIM support. - Using XFontSet to provide bilingual menubar. - Compiling in support for Canna on Mule. - Compiling in support for the WNN input method on Mule. - Using WNN version 6. - Compiling in support for OffiX. - Compiling in support for proper session-management. - Using Lucid menubars. - Using Athena-3d scrollbars. - Using Athena-3d dialog boxes. - Compiling in DLL support. - movemail will use "dot-locking" for locking mail spool files. - Using Lisp_Objects with minimal tagbits. - Compiling in extra code for debugging. - Compiling in code for checking XEmacs memory usage. - WARNING: --------------------------------------------------------- - WARNING: Compiling in support for runtime error checking. - WARNING: XEmacs will run noticeably more slowly as a result. - WARNING: Error checking is on by default for XEmacs beta releases. - WARNING: --------------------------------------------------------- - - - -Then type `make' and you should have a working XEmacs. - -After you have verified that you have a functional editor, fire up -your favorite mail program and send a build report to -xemacs-build-reports@xemacs.org. The build report should include - -1. Your hardware configuration (OS version, etc.) - -2. Version numbers of software in use (X11 version, system library - versions if appropriate, graphics library versions if appropriate). - If you're on a system like Linux, include all the version numbers - you can because chances are it makes a difference. - -3. The options given to configure - -4. The configuration report illustrated above - - For convenience all of the above items are placed in a file called - `Installation' in the top level build directory. They are also - available by performing M-x describe-installation inside XEmacs. - -5. Any other unusual items you feel should be brought to the attention - of the developers. - -** Creating patches for submission -================================== - -Patches to XEmacs should be mailed to . -Each patch will be reviewed by the patches review board, and will be -acked and added to the distribution, or rejected with an explanation. - -Patches to XEmacs Lisp packages should be sent to the maintainer of -the package. If the maintainer is listed as `XEmacs Development Team' -patches should be sent to . - -Emailed patches should preferably be sent in MIME format and quoted -printable encoding (if necessary). - -When making patches, please use the `-u' option, or if your diff -doesn't support it, `-c'. Using ordinary (context-free) diffs are -notoriously prone to error, since line numbers tend to change when -others make changes to the same source file. - -An example of the `diff' usage: - -$ diff -u OLDFILE NEWFILE - --or- - -$ diff -c OLDFILE NEWFILE - -Also, it is helpful if you create the patch in the top level of the -XEmacs source directory: - -$ cp -p lwlib/xlwmenu.c lwlib/xlwmenu.c.orig - hack, hack, hack.... -$ diff -u lwlib/xlwmenu.c.orig lwlib/xlwmenu.c - -Each patch should be accompanied by an update to the appropriate -ChangeLog file. Please don't mail patches to ChangeLog because they -have an extremely high rate of failure; just mail us the new part of -the ChangeLog you added. - -Also note that if you cut & paste from an xterm to an XEmacs mail buffer -you will probably lose due to tab expansion. The best thing to do is -to use an XEmacs shell buffer to run the diff commands, or ... -M-x cd to the appropriate directory, and issue the command `C-u M-!' from -within XEmacs. - -Guidelines for writing ChangeLog entries is governed by the GNU coding -standards. Please see - http://www.gnu.org/prep/standards_toc.html [Change Logs section] -for details. - -Patches should be as single-minded as possible. Mammoth patches can -be very difficult to place into the right slot. They are much easier -to deal with when broken down into functional or conceptual chunks. -The patches submitted by Kyle Jones and Hrvoje Niksic are stellar -examples of how to Do The Right Thing. - -** Packages directory on the FTP Site -===================================== - -The packages directory - ftp://ftp.xemacs.org/pub/xemacs/beta/xemacs-21.0/packages/ - -is divided into subdirectory by the major type of package. - -drwxr-xr-x 2 beta-f beta-f 1024 Oct 10 00:43 binary-packages -drwxr-xr-x 2 beta-f beta-f 512 Oct 10 00:44 package-sources -drwxr-xr-x 2 beta-f beta-f 512 Oct 10 00:44 utils - -** Support Utilities (utils) -============================ - -The utils directory contains tools to deal with current Lisp sources that -have not had yet gotten XEmacs package integration. The script `xpackage.sh' -is used with Quassia Gnus. Edit the appropriate variables at the top of -the script to reflect the local configuration and run it in the top level -directory of a Quassia Gnus source tree to install an update to Quassia Gnus. - -** Binary package installation (binary-packages) -================================================ - -Prerequisite: XEmacs 21.0-b1. - -Binary packages are complete entities that can be untarred at the top -level of an XEmacs package hierarchy and work at runtime. To install files -in this directory, run the command `M-x package-admin-add-binary-package' -and fill in appropriate values to the prompts. - -** Manual procedures for package management -=========================================== - -Prerequisite: XEmacs 21.0 - -When adding and deleting files from a lisp directory the -auto-autoloads.el (global symbols) and custom-load.el (Customization -groups) must be kept in synch. Assuming one is manipulating a -directory called `lisp-utils', the command to rebuild the -auto-autoloads.el file is: - -xemacs-21.0 -vanilla -batch -l autoload -f batch-update-directory lisp-utils - -The command to rebuild the custom-load.el file is: - -xemacs-21.0 -vanilla -batch -l cus-dep \ - -f Custom-make-dependencies lisp-utils - -To bytecompile both of these files the command is: - -xemacs-21.0 -vanilla -batch -f batch-byte-compile \ - lisp-utils/auto-autoloads.el lisp-utils/custom-laod.el - -** Building XEmacs and XEmacs packages from scratch -=================================================== - -To build everything completely from scratch (not a high priority as a -design goal), the following procedure should work. (I don't recommend -building this way). - -*** Phase 1 -- Get a minimal XEmacs binary with mule to build the package - lisp with. - -**** Grab a mule-base tarball and install it into a newly created package - directory. - -**** Configure XEmacs with mule and a package-path including the - directory created above. - -**** Do a `make dist' to build an XEmacs binary. - -*** Phase 2 -- Build and install the package lisp. - -**** Modify XEmacs.rules for local paths and the XEmacs binary created in - Phase 1. - -**** Do a make from the top level package lisp source directory.[1] - -**** Do `make bindist's on all the packages you wish to install and - remove the byproduct .tar.gz's. - -*** Phase 3 -- If necessary, redump XEmacs - with the packages that require dump-time support and install it. - -**** Reconfigure without Mule if you don't wish a Mule-ish XEmacs, and - rebuild XEmacs. - -- or - - -**** rm lib-src/DOC src/xemacs; make - -**** Install or run in-place. - -Note that this is in essence what `make all-elc' has always done. diff --git a/etc/CHARSETS b/etc/CHARSETS deleted file mode 100644 index dd2d083..0000000 --- a/etc/CHARSETS +++ /dev/null @@ -1,57 +0,0 @@ -######################### -## LIST OF CHARSETS -## Each line corresponds to one charset. -## The following attributes are listed in this order -## separated by a colon `:' in one line. -## CHARSET-SYMBOL-NAME, -## CHARSET-ID, -## DIMENSION (1 or 2) -## CHARS (94 or 96) -## BYTES (of multibyte form: 1, 2, 3, or 4), -## WIDTH (occupied column numbers: 1 or 2), -## DIRECTION (0:left-to-right, 1:right-to-left), -## ISO-FINAL-CHAR (character code of ISO-2022's final character) -## ISO-GRAPHIC-PLANE (ISO-2022's graphic plane, 0:GL, 1:GR) -## DESCRIPTION (describing string of the charset) -tibetan-1-column:241:2:94:4:1:0:56:0:Tibetan 1 column glyph -tibetan:252:2:94:4:2:0:55:0:Tibetan characters -lao:167:1:94:3:1:0:49:0:Lao characters (ISO10646 0E80..0EDF) -indian-1-column:240:2:94:4:1:0:54:0:Indian charset for 2-column width glypps -indian-2-column:251:2:94:4:2:0:53:0:Indian charset for 2-column width glyphs -indian-is13194:225:1:94:3:2:0:53:1:Generic Indian charset for data exchange with IS 13194 -ascii-right-to-left:166:1:94:3:1:1:66:0:ASCII (left half of ISO8859-1) with right-to-left direction -chinese-cns11643-7:250:2:94:4:2:0:77:0:CNS11643 Plane 7 Chinese Traditional -chinese-cns11643-6:249:2:94:4:2:0:76:0:CNS11643 Plane 6 Chinese Traditional -chinese-cns11643-5:248:2:94:4:2:0:75:0:CNS11643 Plane 5 Chinese Traditional -chinese-cns11643-4:247:2:94:4:2:0:74:0:CNS11643 Plane 4 Chinese Traditional -chinese-cns11643-3:246:2:94:4:2:0:73:0:CNS11643 Plane 3 Chinese Traditional -ethiopic:245:2:94:4:2:0:51:0:Ethiopic characters -arabic-2-column:224:1:94:3:2:1:52:0:Arabic 2-column -arabic-1-column:165:1:94:3:1:1:51:0:Arabic 1-column -arabic-digit:164:1:94:3:1:0:50:0:Arabic digit -vietnamese-viscii-upper:163:1:96:3:1:0:50:1:VISCII1.1 upper-case -vietnamese-viscii-lower:162:1:96:3:1:0:49:1:VISCII1.1 lower-case -ipa:161:1:96:3:1:0:48:1:IPA (International Phonetic Association) -chinese-sisheng:160:1:94:3:1:0:48:0:SiSheng characters for PinYin/ZhuYin -chinese-big5-2:153:2:94:3:2:0:49:0:Big5 Level-2 Chinese traditional -chinese-big5-1:152:2:94:3:2:0:48:0:Big5 Level-1 Chinese traditional -chinese-cns11643-2:150:2:94:3:2:0:72:0:CNS11643 Plane 2 Chinese traditional -chinese-cns11643-1:149:2:94:3:2:0:71:0:CNS11643 Plane 1 Chinese traditional -japanese-jisx0212:148:2:94:3:2:0:68:0:JISX0212 Japanese supplement -korean-ksc5601:147:2:94:3:2:0:67:0:KSC5601 Korean Hangul and Hanja -japanese-jisx0208:146:2:94:3:2:0:66:0:JISX0208.1983/1990 Japanese Kanji -chinese-gb2312:145:2:94:3:2:0:65:0:GB2312 Chinese simplified -japanese-jisx0208-1978:144:2:94:3:2:0:64:0:JISX0208.1978 Japanese Kanji (so called "old JIS") -latin-iso8859-9:141:1:96:2:1:0:77:1:ISO8859-9 (Latin-5) -cyrillic-iso8859-5:140:1:96:2:1:0:76:1:ISO8859-5 (Cyrillic) -latin-jisx0201:138:1:94:2:1:0:74:0:JISX0201.1976 Japanese Roman -katakana-jisx0201:137:1:94:2:1:0:73:1:JISX0201.1976 Japanese Kana -hebrew-iso8859-8:136:1:96:2:1:1:72:1:ISO8859-8 (Hebrew) -arabic-iso8859-6:135:1:96:2:1:1:71:1:ISO8859-6 (Arabic) -greek-iso8859-7:134:1:96:2:1:0:70:1:ISO8859-7 (Greek) -thai-tis620:133:1:96:2:1:0:84:1:TIS620.2529 (Thai) -latin-iso8859-4:132:1:96:2:1:0:68:1:ISO8859-4 (Latin-4) -latin-iso8859-3:131:1:96:2:1:0:67:1:ISO8859-3 (Latin-3) -latin-iso8859-2:130:1:96:2:1:0:66:1:ISO8859-2 (Latin-2) -latin-iso8859-1:129:1:96:2:1:0:65:1:ISO8859-1 (Latin-1) -ascii:000:1:94:1:1:0:66:0:ASCII (ISO646 IRV) diff --git a/etc/DISTRIB b/etc/DISTRIB deleted file mode 100644 index 3dd537c..0000000 --- a/etc/DISTRIB +++ /dev/null @@ -1,136 +0,0 @@ - -*- text -*- - - XEmacs availability information. Last Modified: 17-Apr-97. - -XEmacs is available via anonymous FTP from ftp.xemacs.org (128.174.252.16) -in the directory /pub/xemacs/. - -ftp.xemacs.org is the primary distribution point, but you may find -copies of it at other sites as well. Please see the file FTP for mirrors. - -The most up-to-date list of distribution sites can always be found on -the XEmacs WWW page, http://www.xemacs.org/. Try to pick a site -that is networkologically close to you. If you know of other mirrors -of the XEmacs archives, please send us mail and we will list them here -as well. - -There are mailing lists and newsgroups specifically for discussing and -reporting bugs in XEmacs; see the file MAILINGLISTS in this directory. - -The FTP and ordering information in the remainder of this file applies -to the versions of GNU Emacs distributed by the Free Software -Foundation, not to XEmacs. - ------------------------------------------------------------------------ - -For an order form for all Emacs and FSF distributions deliverable from -the USA, see the file `ORDERS' in this directory (etc/ in the GNU -Emacs distribution or /pub/gnu/GNUinfo on prep.ai.mit.edu). For a -European order form, see `ORDERS.EUROPE'. For a Japan order form, -see `ORDERS.JAPAN'. - - GNU Emacs availability information, June 1995 -Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. - - Permission is granted to anyone to make or distribute - verbatim copies of this document provided that the - copyright notice and this permission notice are preserved. - -GNU Emacs is legally owned by the Free Software Foundation, but we -regard the foundation more as its custodian on behalf of the public. - -In the GNU project, when we speak of "free software", this refers to -liberty, not price. Specifically, it refers to the users' freedom to -study, copy, change and improve the software. Sometimes users pay -money for copies of GNU software, and sometimes they get copies at no -charge. But regardless of how they got the software, or whether it -was modified by anyone else along the way, they have the freedom to -copy and change it--those freedoms are what "free software" means. - -The precise conditions for copying and modification are stated in the -document "GNU General Public License," a copy of which is required to -be distributed with every copy of GNU Emacs. It is usually in a file -named `COPYING' in the same directory as this file. These conditions -are designed to make sure that everyone who has a copy of GNU Emacs -(including modified versions) has the freedom to redistribute and -change it. - -If you do not know anyone to get a copy of GNU Emacs from, you can -order a tape, cd-rom, or floppy diskette from the Free Software -Foundation. We distribute Emacs version 18 and 19 in different -formats for many machines. We also distribute nicely typeset copies -of the Emacs user manual, Emacs Lisp Reference Manual, the Emacs -reference card, etc. See file `ORDERS'. - -If you have Internet access, you can copy the latest Emacs -distribution from hosts, such as prep.ai.mit.edu. There are several -ways to do this; see the file `FTP' for more information. Even -better, get the latest version of the file from `/pub/gnu/GNUinfo/FTP' -on prep.ai.mit.edu for the most current arrangements. It may also be -possible to copy Emacs via uucp; the file `FTP' contains information -on that too. - -Emacs has been run on both Berkeley Unix and System V Unix, on a -variety of types of cpu. It also works on VMS and on Apollo -computers, though with some deficiencies that reflect problems in -these operating systems. See the file `MACHINES' in this directory -(see above) for a full list of machines that GNU Emacs has been tested -on, with machine-specific installation notes and warnings. There is -also Demacs that works on newer MS-DOS machines (see file `ORDERS'). - -Note that there is significant variation between Unix systems -supposedly running the same version of Unix; it is possible that what -works in GNU Emacs for me does not work on your system due to such an -incompatibility. Since I must avoid reading Unix source code, I -cannot even guess what such problems may exist. - -GNU Emacs is distributed with no warranty (see the General Public -License for full details, in the file `COPYING' in this directory (see -above)), and neither I nor the Free Software Foundation promises any -kind of support or assistance to users. The foundation keeps a list -of people who are willing to offer support and assistance for hire. -See the file `SERVICE'. You can get the latest version from -prep.ai.mit.edu in file `/pub/gnu/GNUinfo/SERVICE'. - -However, we plan to continue to improve GNU Emacs and keep it -reliable, so please send me any complaints and suggestions you have. -I will probably fix anything that I consider a malfunction. I may -make improvements that are suggested, but I may choose not to. -Improving Emacs is not my highest priority now. - -If you are on the Internet, report bugs to -bug-gnu-emacs@prep.ai.mit.edu; on UUCP, use the address -...!uunet!prep.ai.mit.edu!bug-gnu-emacs. Otherwise, phone or write the -foundation at: - Free Software Foundation - 59 Temple Place - Suite 330 - Boston, MA 02111-1307 - Voice: +1-617-542-5942 - Fax: +1-617-542-2652 - -General questions about the GNU Project can be asked of -gnu@prep.ai.mit.edu. - -If you are a computer manufacturer, I encourage you to ship a copy of -GNU Emacs with every computer you deliver. The same copying -permission terms apply to computer manufacturers as to everyone else. -You should consider making a donation to help support the GNU project; -if you estimate what it would cost to distribute some commercial -product and divide it by five, that is a good amount. - -If you like GNU Emacs, please express your satisfaction with a -donation: send me or the Foundation what you feel Emacs has been worth -to you. If you are glad that I developed GNU Emacs and distribute it -as freeware, rather than following the obstructive and antisocial -practices typical of software developers, reward me. If you would -like the Foundation to develop more free software, contribute. - -Your donations will help to support the development of more useful -software to be distributed on the same basis as GNU Emacs. Eventually -we will have a complete imitation of the Unix operating system, called -GNU (Gnu's Not Unix), which will run Unix user programs. For more -information on GNU, see the file `GNU' in this directory (see above). - - Richard M Stallman - Chief GNUisance, - President of the Free Software Foundation diff --git a/etc/Emacs.ad b/etc/Emacs.ad deleted file mode 100644 index 4754a7f..0000000 --- a/etc/Emacs.ad +++ /dev/null @@ -1,284 +0,0 @@ -! This is the app-defaults file for XEmacs. -! -! This used to be identical to sample.Xdefaults, but the resources -! below have been rewritten to be as general as possible to avoid -! overriding user resources. Other than the form rewriting, both -! files should be kept in sync. -! -! The resources below are loaded into the XEmacs executable at compile-time: -! changes to .../etc/Emacs.ad made after XEmacs has been built will have no -! effect. -! -! However, you may copy .../etc/Emacs.ad to /usr/lib/X11/app-defaults/Emacs -! (or whatever the standard app-defaults directory is at your site) to cause -! it to be consulted at run-time. (Do this only for site-wide customizations: -! personal customizations should be put into ~/.Xdefaults instead.) -! Note that the file must be named Emacs, not XEmacs. -! -! See the NEWS file (C-h n) or XEmacs manual (C-h i) for a description of -! the various resources and the syntax for setting them. -! -! Energize users: note that this is not the same app-defaults file that is -! used with the Energize-specific version of XEmacs. - - -! Colors and backgrounds. -! ====================== -! The contrasts of these colors will cause them to map to the appropriate -! one of "black" or "white" on monochrome systems. -! -! The valid color names on your system can be found by looking in the file -! `rgb.txt', usually found in /usr/lib/X11/ or /usr/openwin/lib/X11/. - -! Set the modeline colors. -!Emacs.modeline*attributeForeground: Black -!Emacs.modeline*attributeBackground: Gray75 - -! Set the color of the text cursor. -!Emacs.text-cursor*attributeBackground: Red3 - -! If you want to set the color of the mouse pointer, do this: -! Emacs.pointer*attributeForeground: Black -! If you want to set the background of the mouse pointer, do this: -! Emacs.pointer*attributeBackground: White -! Note that by default, the pointer foreground and background are the same -! as the default face. - -! Set the menubar colors. This overrides the default foreground and -! background colors specified above. -*menubar*Foreground: Gray30 -*menubar*Background: Gray80 -! This is for buttons in the menubar. -! Yellow would be better, but that would map to white on monochrome. -*menubar*buttonForeground: Blue -*XlwMenu*highlightForeground: Red -*XlwMenu*titleForeground: Maroon -*XlwMenu*selectColor: ForestGreen -*XmToggleButton*selectColor: ForestGreen - -! Specify the colors of popup menus. -*popup*Foreground: Black -*popup*Background: Gray80 - -! Specify the colors of the various sub-widgets of the dialog boxes. -*dialog*Foreground: Black -! #A5C0C1 is a shade of blue -*dialog*Background: #A5C0C1 -! The following three are for Motif dialog boxes ... -*dialog*XmTextField*Background: WhiteSmoke -*dialog*XmText*Background: WhiteSmoke -*dialog*XmList*Background: WhiteSmoke -! While this one is for Athena dialog boxes. -*dialog*Command*Background: WhiteSmoke - -! Xlw Scrollbar colors -*XlwScrollBar*Foreground: Gray30 -*XlwScrollBar*Background: Gray80 -*XmScrollBar*Foreground: Gray30 -*XmScrollBar*Background: Gray80 - -! -! The Lucid Scrollbar supports two added resources, SliderStyle is either -! "plain" (default) or "dimple". Dimple puts a small dimple in the middle -! of the slider that depresses when the slider is clicked on. ArrowPosition is -! either "opposite" (default) or "same". Opposite puts the arrows at opposite -! of the scrollbar, same puts both arrows at the same end, like the Amiga. -! -! Emacs*XlwScrollBar.SliderStyle: dimple -! Emacs*XlwScrollBar.ArrowPosition: opposite - - -! -! If you want to turn off a toolbar, set its height or width to 0. -! The correct size value is not really arbitrary. We only control it -! this way in order to avoid excess frame resizing when turning the -! toolbars on and off. -! -! To change the heights and widths of the toolbars: -! -! Emacs.topToolBarHeight: 37 -! Emacs.bottomToolBarHeight: 0 -! Emacs.leftToolBarWidth: 0 -! Emacs.rightToolBarWidth: 0 - -!*topToolBarShadowColor: Gray90 -!*bottomToolBarShadowColor: Gray40 -!*backgroundToolBarColor: Gray80 -*toolBarShadowThickness: 2 - - -! If you want to turn off vertical scrollbars, or change the default -! pixel width of the vertical scrollbars, do it like this (0 width -! means no vertical scrollbars): -! -! Emacs.scrollBarWidth: 0 -! -! To change it for a particular frame, do this: -! -! Emacs*FRAME-NAME.scrollBarWidth: 0 - - -! If you want to turn off horizontal scrollbars, or change the default -! pixel height of the horizontal scrollbars, do it like this (0 height -! means no horizontal scrollbars): -! -! Emacs.scrollBarHeight: 0 -! -! To change it for a particular frame, do this: -! -! Emacs*FRAME-NAME.scrollBarHeight: 0 - - -! To dynamically change the labels used for menubar buttons... -! -! Emacs*XlwMenu.resourceLabels: True -! Emacs*XlwMenu.newFrame.labelString: Open Another Window - -! To have the Motif scrollbars on the left instead of the right, do this: -! -! Emacs*scrollBarPlacement: BOTTOM_LEFT -! -! To have the Athena scrollbars on the right, use `BOTTOM_RIGHT' instead - -! To have Motif scrollbars act more like Xt scrollbars... -! -! Emacs*XmScrollBar.translations: #override \n\ -! : PageDownOrRight(0) \n\ -! : PageUpOrLeft(0) - -! Fonts. -! ====== -! XEmacs requires the use of XLFD (X Logical Font Description) format font -! names, which look like -! -! *-courier-medium-r-*-*-*-120-*-*-*-*-*-* -! -! if you use any of the other, less strict font name formats, some of which -! look like -! lucidasanstypewriter-12 -! and fixed -! and 9x13 -! -! then XEmacs won't be able to guess the names of the bold and italic versions. -! All X fonts can be referred to via XLFD-style names, so you should use those -! forms. See the man pages for X(1), xlsfonts(1), and xfontsel(1). - - -! The default font for the text area of XEmacs is chosen at run-time -! by lisp code which tries a number of different possibilities in order -! of preference. If you wish to override it, use this: -! -! Emacs.default.attributeFont: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* - -! If you choose a font which does not have an italic version, you can specify -! some other font to use for it here: -! -! Emacs.italic.attributeFont: -*-courier-medium-o-*-*-*-120-*-*-*-*-iso8859-* -! -! And here is how you would set the background color of the `highlight' face, -! but only on the screen named `debugger': -! -! Emacs*debugger.highlight.attributeBackground: PaleTurquoise -! -! See the NEWS file (C-h n) for a more complete description of the resource -! syntax of faces. - - -! Font of the modeline, menubar and pop-up menus. -! Note that the menubar resources do not use the `face' syntax, since they -! are X toolkit widgets and thus outside the domain of XEmacs proper. -! -*menubar*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* -*popup*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* - -! Font in the Motif dialog boxes. -! (Motif uses `fontList' while most other things use `font' - if you don't -! know why you probably don't want to.) -! -*XmDialogShell*FontList: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* -*XmTextField*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* -*XmText*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* -*XmList*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* - -! Font in the Athena dialog boxes. -! I think 14-point looks nicer than 12-point. -! Some people use 12-point anyway because you get more text, but -! there's no purpose at all in doing this for dialog boxes. - -*Dialog*Font: -*-helvetica-bold-r-*-*-*-140-*-*-*-*-iso8859-* - -! Dialog box translations. -! ======================= - -! This accelerator binds in a dialog box to on button1 -*dialog*button1.accelerators:#override\ -Return: ArmAndActivate()\n\ -KP_Enter: ArmAndActivate()\n\ -Ctrlm: ArmAndActivate()\n - -! Translations to make the TextField widget behave more like XEmacs -*XmTextField*translations: #override\n\ - !osfBackSpace: delete-previous-character()\n\ - !osfDelete: delete-previous-character()\n\ - !Ctrlh: delete-previous-character()\n\ - !Ctrld: delete-next-character()\n\ - !MetaosfDelete: delete-previous-word()\n\ - !MetaosfBackSpace: delete-previous-word()\n\ - !Metad: delete-next-word()\n\ - !Ctrlk: delete-to-end-of-line()\n\ - !Ctrlg: process-cancel()\n\ - !Ctrlb: backward-character()\n\ - !osfLeft: backward-character()\n\ - !Ctrlf: forward-character()\n\ - !osfRight: forward-character()\n\ - !Metab: backward-word()\n\ - !MetaosfLeft: backward-word()\n\ - !Metaf: forward-word()\n\ - !MetaosfRight: forward-word()\n\ - !Ctrle: end-of-line()\n\ - !Ctrla: beginning-of-line()\n\ - !Ctrlw: cut-clipboard()\n\ - !Metaw: copy-clipboard()\n\ - : copy-primary()\n - -! With the XEmacs typeahead it's better to not have space be bound to -! ArmAndActivate() for buttons that appear in dialog boxes. This is -! not 100% Motif compliant but the benefits far outweight the -! compliancy problem. -*dialog*XmPushButton*translations:#override\n\ - : Arm()\n\ - ,: Activate()\ - Disarm()\n\ - (2+): MultiArm()\n\ - (2+): MultiActivate()\n\ - : Activate()\ - Disarm()\n\ - osfSelect: ArmAndActivate()\n\ - osfActivate: ArmAndActivate()\n\ - osfHelp: Help()\n\ - ~Shift ~Meta ~Alt Return: ArmAndActivate()\n\ - : Enter()\n\ - : Leave()\n - -! XIM input method style -! ======================= - -! ximStyles is a (whitespace or comma-separated) list of XIMStyles in -! order of user's preference. -! Choose a subset of the following styles or reorder to taste -*ximStyles: XIMPreeditPosition|XIMStatusArea\ - XIMPreeditPosition|XIMStatusNothing\ - XIMPreeditPosition|XIMStatusNone\ - XIMPreeditNothing|XIMStatusArea\ - XIMPreeditNothing|XIMStatusNothing\ - XIMPreeditNothing|XIMStatusNone\ - XIMPreeditNone|XIMStatusArea\ - XIMPreeditNone|XIMStatusNothing\ - XIMPreeditNone|XIMStatusNone - -! XIM Preedit and Status foreground and background -*EmacsFrame.ximForeground: black -*EmacsFrame.ximBackground: white - -! XIM fontset (defaults to system fontset default) -! *EmacsFrame.FontSet: -dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-* diff --git a/etc/FTP b/etc/FTP deleted file mode 100644 index 965f0b9..0000000 --- a/etc/FTP +++ /dev/null @@ -1,282 +0,0 @@ - -*- text -*- - - XEmacs availability information. Last Modified: 9-Jul-1998. - -XEmacs is available via anonymous FTP from ftp.xemacs.org (207.96.122.8) -in the directory /pub/xemacs/. - -ftp.xemacs.org is the primary distribution point, but you may find -copies of it at other sites as well. Some sites to try include: - - ftp://ftp.jaist.ac.jp/pub/GNU/xemacs/ - ftp://ring.aist.go.jp/pub/text/xemacs/ - ftp://ring.asahi-net.or.jp/pub/text/xemacs/ - ftp://ftp.uu.net/systems/gnu/xemacs/ - ftp://ftp.sunet.se/pub/gnu/xemacs/ - ftp://ftp.cenatls.cena.dgac.fr/pub/Emacs/xemacs/ - ftp://ftp.th-darmstadt.de/pub/editors/xemacs/ - ftp://sunsite.doc.ic.ac.uk/gnu/xemacs/ - ftp://ftp.lip6.fr/pub/emacs/xemacs/ - ftp://uiarchive.cso.uiuc.edu/pub/packages/xemacs/ - ftp://ftp.technion.ac.il/pub/unsupported/gnu/xemacs/ - ftp://ftp.linux.hr/pub/xemacs/ - ftp://sunsite.cnlab-switch.ch/mirror/xemacs/ - ftp://ftp.unicamp.br/pub/xemacs/ - ftp://ftp.usyd.edu.au/pub/Xemacs/ - ftp://ftp.lab.kdd.co.jp/xemacs/ - ftp://SunSITE.sut.ac.jp/pub/archives/xemacs/ - ftp://sunsite.icm.edu.pl/pub/unix/xemacs - - -The most up-to-date list of distribution sites can always be found on -the XEmacs WWW page, http://www.xemacs.org/. Try to pick a site -that is networkologically close to you. If you know of other mirrors -of the XEmacs archives, please send us mail and we will list them here -as well. - -There are mailing lists and newsgroups specifically for discussing and -reporting bugs in XEmacs; see the file MAILINGLISTS in this directory. - -The FTP and ordering information in the remainder of this file applies -to the versions of GNU Emacs distributed by the Free Software Foundation, -not to XEmacs. - ------------------------------------------------------------------------ -How to get GNU Software by Internet FTP or by UUCP. Last updated 11 June 95. - -* Please send improvements to this file to gnu@prep.ai.mit.edu. - -* No Warranties - -We distribute software in the hope that it will be useful, but without -any warranty. No author or distributor of this software 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. - -* Updates - -If you find this file in the Emacs distribution, there is a chance it -is out of date. If you plan to FTP files from a GNU FTP host, you -might as well start by FTPing the current version of this file, which -is `/pub/gnu/GNUinfo/FTP'. - -* How to FTP - -Use the ftp program on your system (ask locally if you can't find it) -to connect to the host you are ftping from. Unless indicated -otherwise, login in as user "anonymous", with password: "your e-mail -address" and set "binary" mode (to transfer all eight bits in each -byte). - -* FTPing GNU Software - -** How to FTP GNU Emacs - -If you are on the Internet (see also "** Alternative Internet FTP -Sources" below), you can at present copy the latest distribution -version of GNU Emacs from the file /pub/gnu/emacs-M.N.tar on host -prep.ai.mit.edu (or the file /pub/gnu/emacs-M.N.tar.gz which has been -run through gzip after tar). M and N stand for version numbers; look -at a listing of the directory through ftp to see what version is -available. These files are about 11 and 4 megabytes long, -respectively. After you unpack the distribution, be sure to look at -the files README and INSTALL. - -Because of difficulties in transferring large files, sometimes a split -version of the tar file is created. This would be in a directory -named /pub/gnu/emacs-M.N.tar-split or perhaps -/pub/gnu/emacs-M.N.tar.gz-split, containing files of 100000 characters -each. There is generally no trouble in ftping files of this size. -They can be combined with cat to make a tar file or compressed tar -file. If you can't find such files on prep.ai.mit.edu, have a look at -archive.cis.ohio-state.edu. - -ALWAYS USE BINARY/IMAGE MODE TO TRANSFER THESE FILES! -Text mode does not work for tar files or compressed files. - -Some ftp'ers have found it necessary for successful file transfer: - - to explicitly use prep.ai.mit.edu internet address: -18.159.0.42 (as of 18 June 95) - -Files of differences from previous widely distributed GNU Emacs -versions to the present version are also available on prep.ai.mit.edu -under names of the form emacs.diff-OO.OO-NN.NN in directory /pub/gnu. -These are made with diff -rc2. Sometimes there are versions -compressed with gzip of these difference files as well; their names -have .gz appended. - -The Emacs manual in source form is included in the distribution. The -dvi file produced by TeX is not included, but a copy may be available -for ftp under the name /pub/gnu/emacs.dvi. - -The Emacs Lisp Reference Manual is in a separate file: - /pub/gnu/elisp-manual-NN.tar.gz - -** VMS FTP sites with GNU Software -You can anonymously ftp a VMS version of GNU emacs from: - - ftp.stacken.kth.se:[.GNU-VMS] - GNU Emacs and some other VMS -ports (and some VMS binaries) of GNU software - - mango.rsmas.miami.edu has a VMS version of the GCC/G++ compiler. -Contact angel@flipper.miami.edu (angel li) for details. - - addvax.llnl.gov - GNU Emacs - - VMSD.OAC.UCI.EDU - GNU Emacs - - RIGEL.EFD.LTH.SE [130.235.48.3] - GNU Emacs - - ctrsci.cc.utah.edu - GNU Emacs - The 00readme.txt file gives details - - cc.utah.edu [128.110.8.24] - misc. GNU software - user -anonymous, pass guest. The 00README.txt file gives details. - -** Other GNU Software and How To FTP It - -Other GNU software is available on prep.ai.mit.edu under directory -/pub/gnu. diff files to convert between versions (like those used for -GNU Emacs), exist for some of these programs. Some programs have misc -support files as well. Have a look on prep to see which ones. -Compressed versions of the tar or diff files are often available -(indicated by a .gz suffix and made with the `gzip' program). Some of -this software is in beta test (probably still buggy), and is being -made available for use by hackers who like to test software. - -The file /pub/gnu/DESCRIPTIONS has a list of the packages distributed -on prep.ai.mit.edu with a brief description explaining what -each one can be used for. - -More information about these programs can typically be found in the -GNU Bulletin. To receive a copy, write to gnu@prep.ai.mit.edu. - -** Scheme and How to FTP It - -The latest distribution version of C Scheme is available via anonymous FTP -from altdorf.ai.mit.edu in /archive/scheme-X.XX/ (where X.XX is some version -number). - -Read the files INSTALL and README in the top level C Scheme directory. - -** TeX and How to Obtain It - -We don't distribute TeX now, but it is free software. - -TeX is a document formatter that is used, among other things, by the FSF -for all its documentation. You will need it if you want to make printed -manuals. - -TeX is freely redistributable. You can get it by ftp, tape, or CD/ROM. - -*** For FTP instructions, retrieve the file -ftp.cs.umb.edu:pub/tex/unixtex.ftp. (We don't include it here because it -changes relatively frequently. Sorry.) - -*** For TeX on a single tape (4mm DAT or QIC-24), ordering information is -available from unixtex@u.washington.edu. A distribution fee in the area -of US$210.00 covers administrative costs. Tapes will be available at -least through summer of 1994. - -*** The FSF hopes soon to distribute tapes of TeX itself, after the -University of Washington distribution service goes away. - -*** A minimal TeX collection (enough to process Texinfo files, anyway) -is included on the GNU source CD/ROM. See the file ORDERS in this -directory for more information. - -** Alternative Internet FTP Sources - -Please do NOT use a site outside your country, until you have checked -all sites inside your country, and then your continent. Trans-ocean -TCP/IP links are very expensive and usually very low speed. - -The administrators of louie.udel.edu maintains copies of GNU Emacs. -The files are available via anonymous ftp under directory ~ftp/gnu. - -Emacs and other GNU programs may be available via anonymous ftp from -these US sites: ftp.kpc.com:/pub/mirror/gnu (Silicon Valley, CA) -ftp.hawaii.edu:/mirrors/gnu, f.ms.uky.edu:/pub3/gnu, -ftp.digex.net:/pub/gnu (Internet address 164.109.10.23, nightly full -mirror, ran by mcguire@digex.net), wuarchive.wustl.edu:/systems/gnu, -col.hp.com:/mirrors/gnu, ftp.cs.columbia.edu:/archives/gnu/prep, -uiarchive.cso.uiuc.edu:/pub/gnu (Internet address 128.174.5.14, -nightly full mirror, ran by ftpadmin@uiuc.edu), -jaguar.utah.edu:/gnustuff, gatekeeper.dec.com:/pub/GNU, -labrea.stanford.edu, archive.cis.ohio-state.edu, and -ftp.uu.net:/archive/systems/gnu. - -And these foreign sites: ftp.cs.ubc.ca:/mirror2/gnu (Western Canada, -daily full mirror, ran by ftp-admin@cs.ubc.ca), -ftp.inf.utfsm.cl:/pub/gnu (Chile 146.83.198.3 nightly full mirror, ran -by ftp@inf.utfsm.cl), ftp.unicamp.br:/pub/gnu (Brazil manual mirror, -ran by oliva@dcc.unicamp.br), archie.au:/gnu (Australia (archie.oz or -archie.oz.au for ACSnet)), ftp.technion.ac.il:/pub/unsupported/gnu -(Israel, daily full mirror, ran by ftp-admin), ftp.sun.ac.za:/pub/gnu -(South Africa), ftp.etsimo.uniovi.es:/pub/gnu (Spain), -ftp.mcc.ac.uk:/pub/gnu (130.88.203.12 daily full mirror, ran by -root@ftp.mcc.ac.uk), unix.hensa.ac.uk:/mirrors/uunet/systems/gnu, -ftp.warwick.ac.uk (137.205.192.14 daily full mirror, ran by -unixhelp@warwick.ac.uk), ftp.informatik.tu-muenchen.de, -ftp.informatik.rwth-aachen.de, or germany.eu.net (mirror ran by -archive-admin@germany.eu.net) (Germany), isy.liu.se (Sweden), -ftp.stacken.kth.se or ftp.luth.se:/pub/unix/gnu (Sweden), -ftp.sunet.se:/pub/gnu (Sweden 130.238.127.3 daily mirror, ran by -archive@ftp.sunet.se (also mirrors the Mailing List Archives) -ftp.nl.net (Netherlands), ftp.win.tue.nl:/pub/gnu (Netherlands -131.155.70.100 daily mirror, ran by ftp@win.tue.nl), -ftp.funet.fi:/pub/gnu (Finland 128.214.6.100, ran by gnu-adm), -ftp.denet.dk (Denmark), ugle.unit.no (Norway 129.241.1.97), -ftp.eunet.ch or nic.switch.ch:/mirror/gnu (Switzerland), -irisa.irisa.fr:/pub/gnu or ftp.univ-lyon1.fr:pub/gnu (ran by -ftpmaint@ftp.univ-lyon1.fr) (France), ftp.ieunet.ie:pub/gnu (Ireland -192.111.39.1 weekly mirror, ran by archive@ieunet.ie), archive.eu.net -(Europe 192.16.202.1), cair-archive.kaist.ac.kr:/pub/gnu (Korea -143.248.11.171, ran by ftpkeeper@cair-archive.kaist.ac.kr), -ftp.nectec.or.th:/pub/mirrors/gnu (Thailand 192.150.251.32 daily -mirror, ran by ftp@nwg.nectec.or.th), -utsun.s.u-tokyo.ac.jp:/ftpsync/prep or ftp.cs.titech.ac.jp (Japan, -nemacs, the japanese port of GNU Emacs, is under ~ftp/JAPAN). - -* Getting GNU software in Great Britain - -jpo@cs.nott.ac.uk is willing to distribute those GNU sources he has -available. The smaller items are available from the info-server (send -to info-server@cs.nott.ac.uk) the larger items by negotiation. Due to -communication costs this service is only available within the UK. - -BattenIG@computer-science.birmingham.ac.uk (aka -I.G.Batten@fulcrum.bt.co.uk) is also willing to distribute those GNU -sources he has. He can also write tapes in qic-21 and qic-24 formats. - -lmjm@doc.ic.ac.uk is willing to distribute those GNU sources he has -along with comp.sources.unix, comp.sources.x, X windows et al. The -archive, on src.doc.ic.ac.uk in directory /gnu, is available via ftp -over the Internet (on 146.169.3.7), ftam over IXI, HTTP, FSP, Gopher, -ftpmail, NFS, Lanmanger over IP, telnet, and uucp. Due to -communication costs this service is only available within the UK. -Mail to info-server@doc.ic.ac.uk for details. He can also write sun -cartridge or exabyte tapes. - -UK sites with just anonymous FTP access are in the above list. - -* Getting GNU software via UUCP - -OSU is distributing via UUCP: most GNU software, MIT C Scheme, -Compress, News, RN, NNTP, Patch, some Appletalk stuff, some of the -Internet Requests For Comment (RFC) et al.. See their periodic -postings on the Usenet newsgroup comp.sources.d for informational -updates. Current details from or -<...!osu-cis!staff>. - -Information on how to uucp some GNU programs is available via -electronic mail from: uunet!hutch!barber, hqda-ai!merlin, acornrc!bob, -hao!scicom!qetzal!upba!ugn!nepa!denny, ncar!noao!asuvax!hrc!dan, -bigtex!james (aka james@bigtex.cactus.org), oli-stl!root, -src@contrib.de (Germany), toku@dit.co.jp (Japan) and info@ftp.uu.net. - -* If You Like The Software - -If you like the software developed and distributed by the Free -Software Foundation, please express your satisfaction with a donation. -Your donations will help to support the Foundation and make our future -efforts successful, including a complete development and operating -system, called GNU (Gnu's Not Un*x), which will run Un*x user -programs. For more information on GNU and the Foundation, contact us -at the above address. - -Ordering a distribution tape from the Foundation is often a good -way to bring your company or university to make a donation. diff --git a/etc/HELLO b/etc/HELLO deleted file mode 100644 index ea86d00..0000000 --- a/etc/HELLO +++ /dev/null @@ -1,38 +0,0 @@ -You need many fonts to read all. -Please correct this incomplete list and add more! - ---------------------------------------------------------- -Arabic [2](38R(47d(3T!JSa(4W(3W[0](B -Croatian (Hrvatski) Bog (Bok), Dobar dan -Czech (,Bh(Besky) Dobr,B}(B den -Danish (Dansk) Hej, Goddag -English Hello -Esperanto Saluton -Estonian Tere, Tervist -FORTRAN PROGRAM -Finnish (Suomi) Hei -French (Fran,Ag(Bais) Bonjour, Salut -German (Deutsch Nord) Guten Tag -German (Deutsch S,A|(Bd) Gr,A|_(B Gott -Greek (,FGkk]mija(B) ,FCei\(B ,Fsar(B -Hebrew [2],Hylem[0](B -Italiano Ciao, Buon giorno -Maltese Ciao -Nederlands, Vlaams Hallo, Hoi, Goedendag -Norwegian (Norsk) Hei, God dag -Polish Cze,B6f(B! -Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B! -Spanish (Espa,Aq(Bol) ,A!(BHola! -Swedish (Svenska) Hej, Goddag -Vietnamese (Ti,1*(Bng Vi,1.(Bt) Ch,1`(Bo b,1U(Bn - -Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B, $BqV$(DiQ(B -Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B -Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B -Hangul ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B - -Difference among chinese characters in GB, JIS, KSC, BIG5: - GB -- $AT*Fx(B $A?*7"(B - JIS -- $B855$(B $B3+H/(B - KSC -- $(Cj*Q((B $(CKR[!(B - BIG5 -- $(0&x86(B $(0DeBv(B diff --git a/etc/MACHINES b/etc/MACHINES deleted file mode 100644 index 0d3bbf3..0000000 --- a/etc/MACHINES +++ /dev/null @@ -1,1261 +0,0 @@ -This is a list of the status of GNU Emacs on various machines and systems. - -For each system and machine, we give the configuration name you should -pass to the `configure' script to prepare to build Emacs for that -system/machine. - -The `configure' script uses the configuration name to decide which -machine and operating system description files `src/config.h' should -include. The machine description files are all in `src/m', and have -names similar to, but not identical to, the machine names used in -configuration names. The operating system files are all in `src/s', -and are named similarly. See the `configure' script if you need to -know which configuration names use which machine and operating system -description files. - -If you add support for a new configuration, add a section to this -file, and then edit the `configure' script to tell it which -configuration name(s) should select your new machine description and -system description files. - - -Here are the configurations Emacs is intended to work with, with the -corresponding configuration names. You can postpend version numbers -to operating system names (i.e. sunos4.1) or architecture names (i.e. -hppa1.1). If you leave out the version number, the `configure' script -will configure Emacs for the latest version it knows about. - -************************************************************************* -* * -* NOTE: this file is kept in sync with the FSF version, though we * -* expect the information here to be mostly accurate for XEmacs. * -* Bear in mind that the version numbers mentioned in the text below * -* are the FSF numbers, not the Lucid numbers. For comparison, * -* FSFmacs 19.26 roughly corresponds to XEmacs 19.11. * -* * -************************************************************************* - -Acorn RISCiX (arm-acorn-riscix1.2) - - Emacs 19.29 has changes that ought to support RISCiX 1.2. - - Due to a bug in the RISCiX C compiler (3.4.5), emacs must - be built with gcc (versions 2.5.8 onwards). - - In addition, you will need GNU sed and GNU make, as the RISCiX release - versions of these utilities cannot cope with building emacs-19! - - GNU sed should be configured with: - - env 'DEFS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \ - -Doptarg=gnu_optarg' ./configure - - GNU make (3.72+) should be configured with: - - env 'CFLAGS=-Dgetopt=gnu_getopt -Dopterr=gnu_opterr -Doptind=gnu_optind \ - -Doptarg=gnu_optarg' ./configure - - Emacs may be configured to use the X toolkit, by adding --with-x-toolkit - to the configure command. If you do this, you will need to edit the line - in src/Makefile which defines LIBW (about line 59) to read: - - LIBW= -lXaw_n - - This ensures that the non-shared widget library is used. - - It is unlikely that this version of emacs will work with RISCiX 1.1. - -Alliant (fx80-alliant-bsd): - - 18.52 worked on system version 4. Previous Emacs versions were - known to work on previous system versions. - - If you are using older versions of their operating system, you may - need to edit `src/config.h' to use `m/alliant1.h' (on version 1) or - `m/alliant.h' (on versions 2 and 3). - -Alliant FX/2800 (i860-alliant-bsd) - - Known to work with 19.26 and OS version 2.2, compiler version 1.3. - -Alpha (DEC) running OSF/1 (alpha-dec-osf1) - - Worked as of Lucid Emacs 19.8. - -Altos 3068 (m68k-altos-sysv) - - 18.52 was said to work, provided you don't compile unexec.c with -O. - -Amdahl UTS (580-amdahl-sysv) - - Small changes for 18.38 were merged in 18.39. It is mostly - working, but at last report a bug sometimes causes Emacs to - grab very large amounts of memory. No fix or explanation - has yet been reported. It may be possible to find this bug - if you find which Emacs command it happens within and then - run that command with a breakpoint set at malloc. - - The 5.2u370 compiler is so brain damaged that it is not - even worth trying to use it. Success was obtained with the - uts native C compiler on uts version 5.2.5. - -Apollo running Domain (m68k-apollo-domain) - - 19.29 has a few patches that ought to make things work. - - There are reports of bugs in cc -O on this system. - - In `lib-src/Makefile', don't expect emacsclient and emacsserver to - compile. You might want to remove them from your makefile. - - The Apollo has a bizarre operating system which does not permit - Emacs to be dumped with preloaded pure Lisp code. Therefore, each - time you start Emacs on this system, the standard Lisp code is loaded - into it. Expect it to take a long time. You can prevent loading of - the standard Lisp code by specifying the -nl switch. It must - come at the beginning of the command line; only the -t and -batch - switches may come before it. - - - Here is a design for a method of dumping and reloading the relevant - necessary impure areas of Emacs. - - On dumping, you need to dump only the array `pure' plus the - locations that contain values of forwarded Lisp variables or that are - protected for garbage collection. The former can be found by a - garbage- collection-like technique, and the latter are in the - staticprolist vector (see alloc.c for both things). - - Reloading would work in an Emacs that has just been started; except - when a switch is specified to inhibit this, it would read the dump - file and set all the appropriate locations. The data loaded must be - relocated, but that's not hard. Those locations that are of type - Lisp_Object can be found by a technique like garbage-collection, and - those of them that point to storage can be relocated. The other data - read from the file will not need to be relocated. - - The switch to inhibit loading the data base would be used when it - is time to dump a new data base. - - This would take a few seconds, which is much faster than loading - the Lisp code of Emacs from scratch. - -AT&T 3b2, 3b5, 3b15, 3b20 (we32k-att-sysv) - - Emacs will probably not work with certain kernel constants too small. - - In param.h CDLIMIT should be at least (1L << 12) in order to allow - processes to write up to 2 Mbyte files. This parameter is configurable - by normal means in /etc/master.d/kernel; examine that file for the - symbol CDLIMIT or ULIMIT, and raise it by several powers of 2. Then - do normal kernel rebuild things via "cd /boot; mkboot -k KERNEL" and so - forth. - - In seg.h NSEGP and STACKSEG should be at least 16 and 4 respectively - to allow processes with total size of up to 2Mbytes. - However, I'm told it is unlikely this would fail to be true. - - The MAXMEM may also prevent Emacs from running. The file - 3B-MAXMEM in this directory explains how to increase MAXMEM. - - On some of these machines, you may need to define IN_SCCS_ID - in config.h to make Emacs work. Supposedly you can tell whether - this is necessary by checking something in /usr/include/sys/time.h; - we do not know precisely what. - -AT&T 7300 or 3b1 (m68k-att-sysv) - - 18.52 worked. If you have strange troubles with dumping - Emacs, delete the last few lines from `src/m/7300.h' and recompile. - These lines are supposed to produce a sharable executable. - - `src/m/7300.h' defines SHORTNAMES because operating system versions - older than 3.5 did not support long symbol names. Version 3.5 does - support them, so you can remove the #define SHORTNAMES in that - version. - -Bull DPX/2 models 2nn or 3nn (m68k-bull-sysv3) - - Minor fixes merged into 19.19, which should work with CC or GCC. - - You should compile with all the POSIX stuff: undef _SYSV and define - _POSIX_SOURCE, _XOPEN_SOURCE and _BULL_SOURCE. - - On bos2.00.45 there is a bug that makes the F_SETOWN fcntl - call enters in an infinite loop. F_SETOWN_BUG has been defined to avoid - calling it. - -Bull DPX/20 (rs6000-bull-bosx) - - Version 19 works. - -Bull sps7 (m68k-bull-sysv2) - - Changes partially merged in version 19, but some fixes are probably required. - -CCI 5/32, 6/32 - - See "Tahoe". - -Celerity (celerity-celerity-bsd4.2) - - Version 18.49 worked. This configuration name is a hack, because we - don't know the processor used by Celerities. If someone - who uses a Celerity could get in touch with us, we can teach - config.sub a better name for the configuration. - -Clipper (clipper-???) - - Version 19 has support for some brand of clipper system. If you - have successfully built Emacs 19 on some sort of clipper system, let - us know so we can flesh out this entry. - - Note that the Orion 105 is also a clipper, but some system-related - parameters are different. - -Convex (c1-convex-bsd, c2-convex-bsd, c32-convex-bsd, c34-convex-bsd, - c38-convex-bsd) - - Support updated and residual bugs fixed in 19.26. - -Cubix QBx/386 (i386-cubix-sysv) - - Changes merged in 19.1. Systems before 2/A/0 may fail to compile etags.c - due to a compiler bug. - -Cydra 5 (cydra-cydrome-sysv) - - 18.51 worked in one version of their operating system but stopped - working in a newer version. This has not been fixed. - -Data General Aviion (m88k-dg-dgux) - - 19.23 works; however, the GCC provided with DGUX 5.4R3.00 fails to - compile src/emacs.c. GCC 2.5.8 does work. - The 19.26 pretest was reported to work; no word on which compiler. - - System versions other than DGUX 5.4R3.00 have not been tested. - -DECstation (mips-dec-ultrix or mips-dec-osf) - - This machine is the older Mips-based DECstation. - Emacs should now work on the Alpha CPU. - - 19.25 works on Ultrix 4.2. The 19.26 pretest was reported to work - on Ultrix 4.2a and on 4.4. - - One user reported 19.25 did not work at all with --with-x-toolkit - using X11R5 patch level 10, but worked ok with X11R5 pl26. - - See under Ultrix for problems using X windows on Ultrix. - Note that this is a MIPS machine. - - For Ultrix versions 4.1 or earlier, you may need to define - SYSTEM_MALLOC in `src/m/pmax.h', because XvmsAlloc.o in libX11.a seems - to insist on defining malloc itself. - - For Ultrix versions prior to 4.0, you may need to delete - the definition of START_FILES from `src/m/pmax.h'. - -Motorola Delta 147 (m68k-motorola-sysv) - - The EMacs 19.26 pretest was reported to work. - - Motorola Delta boxes running System V/68 release 3. - Tested on 147 board with SVR3V7, no X and gcc. - Tested on 167 board with SVR3V7, no X, cc, gnucc and gcc. - Reports say it works with X too. - - The installation script chooses the compiler itself. gnucc is - preferred. - -Motorola Delta 187 (m88k-motorola-sysv, - m88k-motorola-sysvr4, or - m88k-motorola-m88kbcs) - - The 19.26 pretest was reported to run on SVR3. However, if you - use --with-x-toolkit on svr3, you will have problems compiling some - files because time.h and sys/time.h get included twice. - One fix is to edit those files to protect against multiple inclusion. - - As of version 19.13, Emacs was reported to run under SYSVr3 and SYSVr4. - -Dual running System V (m68k-dual-sysv) - - As of 17.46, this worked except for a few changes - needed in unexec.c. - -Dual running Uniplus (m68k-dual-uniplus) - - Worked, as of 17.51. - -Elxsi 6400 (elxsi-elxsi-sysv) - - Changes for 12.0 release are in 19.1. - Dumping should work now. - -Encore machine (ns16k-encore-bsd) - - This machine bizarrely uses 4.2BSD modified to use the COFF format - for object files. Works (as of 18.40). For the APC processor you - must enable two lines at the end of `src/s/umax.h', which are commented - out in the file as distributed. - - WARNING: If you compile Emacs with the "-O" compiler switch, you - must also use the "-q enter_exits" switch so that all functions have - stack frames. Otherwise routines that call `alloca' all lose. - - A kernel bug in some system versions causes input characters to be lost - occasionally. - -GEC 63 (local-gec63-usg5.2) - - Changes are partially merged in version 18, but certainly require - more work. Let us know if you get this working, and we'll give it a - real configuration name. - -Gould Power Node (pn-gould-bsd4.2 or pn-gould-bsd4.3) - - 18.36 worked on versions 1.2 and 2.0 of the operating system. - - On UTX/32 2.0, use pn-gould-bsd4.3. - - On UTX/32 1.2 and UTX/32S 1.0, use pn-gould-bsd4.2 and note that - compiling `lib-src/sorted-doc' tickles a compiler bug: remove the -g - flag to cc in the makefile. - - UTX/32 1.3 has a bug in the bcopy library routine. Fix it by - #undef BSTRING in `src/m/gould.h'. - - Version 19 incorporates support for releases 2.1 and later of UTX/32. - A site running a pre-release of 2.1 should #define RELEASE2_1 in config.h. - -Gould NP1 (np1-gould-bsd) - - Version 19 supposedly works. - -Harris Night Hawk (m68k-harris-cxux or m88k-harris-cxux) - - This port was added in 19.23. The configuration actually tested was - a Night Hawk 4800 running CX/UX 7.0. - - If you have GCC ported and want to build with it, you probably need to - change things (like compiler switches) defined in the s/cxux.h file. - - With CX/UX 7.0 and later releases, you need to build after setting the - SDE_TARGET environment variable to COFF (a port using ELF and shared - libraries has not yet been done). - -Honeywell XPS100 (xps100-honeywell-sysv) - - Config file added in version 19. - -Hewlett-Packard 9000 series 200 or 300 (m68k-hp-bsd or m68k-hp-hpux7.) - - Version 19 works under BSD. The 19.26 pretest was reported - to work on HPUX 9. - - These machines are 68000-series CPUs running HP/UX - (a derivative of sysV with some BSD features) or BSD 4.3 ported by Utah. - The operating system suffix determines which system Emacs is built for. - - Series 200 HPUX runs Emacs only if it has the "HP/UX upgrade". - - If you are running HP/UX release 8.0 or later, you need the optional - "C/ANSI C" software in order to build Emacs (older releases of HP/UX - do not require any special software). If the file "/etc/filesets/C" - exists on your machine, you have this software, otherwise you do not. - - Note that HP has used two incompatible assembler syntaxes, - and has recently changed the format of C function frames. - `src/crt0.c' and `src/alloca.s' have been conditionalised for the new - assembler and new function-entry sequence. You may need to define - OLD_HP_ASSEMBLER if you are using an older hpux version. If you - have an official (bought from HP) series 300 machine you have - the new assembler. Kernels that are 5.+ or later have new - assembler. A Series 200 that has been upgraded to a 68010 - processor and a 5.+ kernel has the new compiler. - - Define C_SWITCH_MACHINE to be +X to make a version of Emacs that - runs on both 68010 and 68020 based HP/UX's. - - Define HPUX_68010 if you are using the new assembler, for - a system that has a 68010 without a 68881. This is to say, - a s200 (upgraded) or s310. - - Define the symbol HPUX_NET if you have the optional network features - that include the `netunam' system call. This is referred to as - Network Services (NS/9000) in HP literature. - -HP 9000 series 500: not supported. - - The series 500 has a seriously incompatible memory architecture - which relocates data in memory during execution of a program, - and support for it would be difficult to implement. - -HP 9000 series 700 or 800 (Spectrum) (hppa1.0-hp-hpux or hppa1.1-hp-hpux - or ...hpux9shr) - - 19.26 is believed to work on HPUX 9 provided you compile with GCC. - As of version 19.16, Emacs was reported to build (using GCC) and run - on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01. - - Use hppa1.1 for the 700 series and hppa1.0 for the 800 - series machines. (Emacs may not actually care which one you use.) - - Use hppa1.1-hp-hpux9shr to use shared libraries on HPUX version 9. - You may need to create the X libraries libXaw.a and libXmu.a from - the MIT X distribute, and you may need to edit src/Makefile's - definition of LIBXT to look like this: - - LIBXT= $(LIBW) -lXmu -lXt $(LIBXTR6) -lXext - - Some people report trouble using the GNU memory allocator under - HP/UX version 9. The problems often manifest as lots of ^@'s in the - buffer. - - We are told that these problems go away if you obtain the latest - patches for the HP/UX C compiler. James J Dempsey - says that this set of versions works for him: - /bin/cc: - HP92453-01 A.09.28 HP C Compiler - /lib/ccom: - HP92453-01 A.09.28 HP C Compiler - HP-UX SLLIC/OPTIMIZER HP-UX.09.00.23 02/18/93 - Ucode Code Generator - HP-UX.09.00.23.5 (patch) 2/18/93 - - For 700 series machines, the HP-UX patch needed is known as - PHSS_2653. (Perhaps for 800 series machines as well; we don't - know.) If you are on the Internet, you should be able to obtain - this patch by using telnet to access the machine - support.mayfield.hp.com and logging in as "hpslreg" and following - the instructions there. Do not ask FSF for further support on - this. If you have any trouble obtaining the patch, contact HP - Software Support. - - If your buffer fills up with nulls (^@) at some point, it could well - be that problem. That problem does not happen when people use GCC - to compile Emacs. On the other hand, the HP compiler version 9.34 - was reported to work for the 19.26 pretest. 9.65 was also reported to work. - - If you turn on the DSUSP character (delayed suspend), - Emacs 19.26 does not know how to turn it off on HPUX. - You need to turn it off manually. - - If you are running HP/UX release 8.0 or later, you need the optional - "C/ANSI C" software in order to build Emacs (older releases of HP/UX - do not require any special software). If the file "/etc/filesets/C" - exists on your machine, you have this software, otherwise you do not. - -High Level Hardware Orion (orion-highlevel-bsd) - - This is the original microprogrammed hardware. - Machine description file ought to work. - -High Level Hardware Orion 1/05 (clipper-highlevel-bsd) - - Changes merged in 18.52. This is the one with the Clipper cpu. - Note that systems which lack NFS need LOAD_AVE_TYPE changed to `double'. - - C compiler has a bug; it loops compiling eval.c. - Compile it by hand without optimization. - -IBM PS/2 (i386-ibm-aix1.1 or i386-ibm-aix1.2) - - Changes merged in version 19. You may need to copy - /usr/lib/samples/hft/hftctl.c to the Emacs src directory. - - i386-ibm-aix1.1 may not work with certain new X window managers, and - may be suboptimal. - -IBM RS/6000 (rs6000-ibm-aix) - - Emacs 19.26 is believed to work; its pretest was tested. - - At last report, Emacs didn't run well on terminals. Informed - persons say that the tty VMIN and VTIME settings have been - corrupted; if you have a fix, please send it to us. - - Compiling with -O using the IBM compiler has been known - to make Emacs work incorrectly. It's reported that on - AIX 3.2.5 with an IBM compiler earlier than 1.03.00.14, - cc -O fails for some files. You need to install any - PTF containing APAR #IX42810 to bring the compiler to - the 1.03.00.14 level to allow optimized compiles. - Alternatively, recompiling just emacs.c and extents.c - without optimization seems to do the trick as well. - - There are reports that IBM compiler versions earlier than 1.03.00.02 - fail even without -O. - - As of 19.11, if you strip the Emacs executable, it ceases to work. - - If you are using AIX 3.2.3, you may get a core dump when loading - ange-ftp. You may be able to fix the problem by defining LIBS_TERMCAP - as -ltermcap -lcurses. Please tell us if this fails to work. - - If anyone can fix the above problems, or confirm that they don't happen - with certain versions of various programs, we would appreciate it. - -IBM RT/PC (romp-ibm-bsd or romp-ibm-aix) - - Use romp-ibm-bsd for the 4.2-like system and romp-ibm-aix for AIX. - 19.22 is reported to work under bsd. We don't know about AIX. - - On BSD, if you have trouble, try compiling with a different compiler. - - On AIX, the file /usr/lib/samples/hft/hftctl.c must be compiled into - hftctl.o, with this result left in the src directory (hftctl.c is - part of the standard AIX distribution). - - window.c must not be compiled with -O on AIX. - -Integrated Solutions `Optimum V' (m68k-isi-bsd4.2 or -bsd4.3) - - 18.52 said to work on some sort of ISI machine. - Version 18.45 worked (running on a Optimum V (VME bus, 68020) - BSD 4.2 (3.05e) system). 18.42 is reported to work on - a Qbus 68010 system. Has not been tried on `WorkStation' `Cluster - Compute Node' `Cluster WorkStation' or `Server Node' (Love the - StudLYCaps) - - Compilation with -O is rumored to break something. - - On recent system versions, you may need to undefine the macro UMAX - in `lib-src/loadst.c' and `src/getpagesize.h'. They stupidly defined this - in a system header file, which confuses Emacs (which thinks that UMAX - indicates the Umax operating system). - -Intel 386 (i386-*-isc, i386-*-esix, - i386-*-xenix, i386-*-linux, i386-*-freebsd, - i386-intsys-sysv, i386-*-sysv3, - i386-*-sysv4, i386-*-sysv4.2, - i386-*-sysv5.3, i386-*-bsd4.2, - i386-*-sco3.2v4, i386-*-bsd386, i386-*-386bsd - or i486... or i586...) - - In the above configurations, * means that the manufacturer's name - you specify does not matter, and you can use any name you like - (but it should not contain any dashes or stars). - - When using the ISC configurations, be sure to specify the isc - version number - for example, if you're running ISC 3.0, use - i386-unknown-isc3.0 as your configuration name. - Use i386-*-esix for Esix; Emacs runs as of version 19.6. - Use i386-*-linux for GNU/Linux systems; Emacs runs as of version 19.26. - Use i386-intsys-sysv for Integrated Solutions 386 machines. - It may also be correct for Microport systems. - Use i386-*-sco3.2v4 for SCO 3.2v4; Emacs runs as of version 19.26. - - On GNU/Linux systems, Emacs 19.23 was said to work properly with libc - version 4.5.21, but not with 4.5.19. If your system uses QMAGIC - for the executable format, you must edit config.h to define LINUX_QMAGIC. - - On GNU/Linux, configure may fail to put these definitions in config.h: - - #define HAVE_GETTIMEOFDAY - #define HAVE_MKDIR - #define HAVE_RMDIR - - To work around the problem, add those definitions by hand. - It is possible that this problem happens only with X11R6 - or that newer system versions have fixed it. - - The 19.26 pretest was reported to work on SVR4.3 and on Freebsd. - - Use i386-*-bsd386 for BSDI BSD/386; Emacs runs as of version 19.23. - Make on that system is broken; use GNU make instead. - Shell bugs in version 1.0 of BSD/386 cause configure - to do the wrong thing with --with-x-toolkit; the workaround is to edit - configure to run another shell such as bash. - - For System V release 3, use i386-*-sysv3. - For System V release 4, use i386-*-sysv4. - For System V release 4.2, use i386-*-sysv4.2. - - If you are using Xenix, see notes at end under Xenix. - If you are using Esix, see notes at end under Esix. - If you are using SCO Unix, see notes at end under SCO. - - On 386bsd, netbsd and freebsd, you should use GNU make, not the - system's make. Assuming it's installed as gmake, do `gmake install - MAKE=gmake'. - - If you are using System V release 4.2, you may find that `cc -E' - puts spurious spaces in `src/xmakefile'. If that happens, - specify CPP=/lib/cpp as an option when you run make. - There is no problem if you compile with GCC. - - Note that use of Linux with GCC 2.4 and the DLL 4.4 libraries - requires the experimental "net 2" network patches (no relation to - Berkeley Net 2). There is a report that (some version of) Linux - requires including `/usr/src/linux/include/linux' in buffer.c - but no coherent explanation of why that might be so. If it is so, - in current versions of Linux, something else should probably be changed. - - Some sysV.3 systems seem to have bugs in `opendir'; - for them, alter `config.h' to define NONSYSTEM_DIR_LIBRARY - and undefine SYSV_SYSTEM_DIR. - - If you use optimization on V.3, you may need the option -W2,'-y 0' - to prevent certain faulty optimization. - - On 386/ix, to link with shared libraries, add #define USG_SHARED_LIBRARIES - to config.h. - - On SCO, there are problems in regexp matching when Emacs is compiled - with the system compiler. The compiler version is "Microsoft C - version 6", SCO 4.2.0h Dev Sys Maintenance Supplement 01/06/93; - Quick C Compiler Version 1.00.46 (Beta). The solution is to compile - with GCC. - - On ISC systems (2.02 and more recent), don't try to use the versions - of X that come with the system; use XFree86 instead. - - There is no consistency in the handling of certain system header files - on V.3. - - Some versions have sys/sioctl.h, and require it in sysdep.c. - But some versions do not have sys/sioctl.h. - For a given version of the system, this may depend on whether you have - X Windows or TCP/IP. Define or undefine NO_SIOCTL_H in config.h - according to whether you have the file. - - Likewise, some versions have been known to need sys/ttold.h, sys/stream.h, - and sys/ptem.h included in sysdep.c. If your system has these files, - try defining NEED_PTEM_H in config.h if you have trouble without it. - - You may find that adding -I/usr/X/include or -I/usr/netinclude or both - to CFLAGS avoids compilation errors on certain systems. - - Some versions convince sysdep.c to try to use `struct tchars' - but define `struct tc' instead; add `#define tchars tc' - to config.h to solve this problem. - -Iris 2500 and Iris 2500 Turbo (m68k-sgi-iris3.5 or m68k-sgi-iris3.6) - - Version 18 was said to work; use m68k-sgi-iris3.5 for system version 2.5 - and m68k-sgi-iris3.6 for system version 3.6. - Note that the 3030 is the same as the Iris 2500 Turbo. - -Iris 4D (mips-sgi-irix[456].*) - - The 19.26 pretest was reported to work on IRIX 4.0.5 and 5.2. - 19.23 was reported to work on IRIX 5.2, but you may need to install - the "compiler_dev.hdr.internal" subsystem in order to compile unexelfsgi.c. - 19.22 was known to work on all Silicon Graphics machines running - IRIX 4.0.5 or IRIX 5.1. - - Compiling with -O using IRIX compilers prior to 3.10.1 may not work. - Don't use -O or use GCC instead. - - Most IRIX 3.3 systems do not have an ANSI C compiler, but a few do. - Compile Emacs 18 with the -cckr switch on these machines. - - There is a bug in IRIX 3.3 that can sometimes leave ptys owned by root - with a permission of 622. This causes malfunctions in use of - subprocesses of Emacs. Irix versions 4.0 and later with GNU Emacs - versions 18.59 and later fix this bug. - -Masscomp (m68k-masscomp-rtu) - - 18.36 worked on a 5500DP running RTU v3.1a and compiler version 3.2 - with minor fixes that are included in 18.37. However, bizarre behavior - was reported for 18.36 on a Masscomp (model and version unknown but probably - a 68020 system). The report sounds like a compiler bug. - - A compiler bug affecting statements like - unsigned char k; unsigned char *p;... x = p[k]; - has been reported for "C version 1.2 under RTU 3.1". We do not wish - to take the time to install the numerous workarounds required to - compensate for this bug. - - For RTU version 3.1, define FIRST_PTY_LETTER to be 'p' in `src/s/rtu.h' - (or #undef and redefine it in config.h) so that ptys will be used. - - GNU Emacs is said to have no chance of compiling on RTU versions - prior to v3.0. - -Megatest (m68k-megatest-bsd) - - Emacs 15 worked; do not have any reports about Emacs 16 or 17 - but any new bugs are probably not difficult. - -Mips (mips-mips-riscos, mips-mips-riscos4.0, or mips-mips-bsd) - - The C compiler on Riscos 4.51 dumps core trying to optimize - parts of Emacs. Try without optimization or try GCC. - - Meanwhile, the linker on that system returns success even if - there are undefined symbols; as a result, configure gets the - wrong answers to various questions. No work-around is known - except to edit src/config.h by hand to indicate which functions - don't exist. - - Use mips-mips-riscos4.0 for RISCOS version 4. - Use mips-mips-bsd with the BSD world. - - Note that the proper configuration names for DECstations are - mips-dec-ultrix and mips-dec-osf. - - If you are compiling with GCC, then you must run fixincludes; - the alternative of using -traditional won't work because - the definition of SIGN_EXTEND_CHAR uses the keyword `signed'. - - If the SYSV world is the default, then you probably need the following - line in etc/Makefile: - - CFLAGS= -g -systype bsd43 - - Some operating systems on MIPS machines give SIGTRAP for division by - zero instead of the usual signals. The only real solution is to fix - the system to give a proper signal. - - In the meantime, you can change init_data in data.c if you wish. - Change it to handle SIGTRAP as well as SIGFPE. But this will have a - great disadvantage: you will not be able to run Emacs under a - debugger. I think crashing on division by zero is a lesser problem. - - dsg@mitre.org reported needing to use --x-libraries=/bsd43/usr/lib - on a riscos4bsd site. But it is not clear whether this is needed in - general or only because of quirks on a particular site. - -National Semiconductor 32000 (ns32k-ns-genix) - - This is for a complete machine from National Semiconductor, - running Genix. Changes merged in version 19. - -NCR Tower 32 (m68k-ncr-sysv2 or m68k-ncr-sysv3) - - If you are running System V release 2, use m68k-ncr-sysv2. - If you are running System V release 3, use m68k-ncr-sysv3. - - These both worked as of 18.56. If you change `src/ymakefile' so that - CFLAGS includes C_OPTIMIZE_SWITCH rather than C_DEBUG_SWITCH, check - out the comments in `src/m/tower32.h' (for System V release 2) or - `src/m/tower32v3.h' (for System V release 3) about this. - - There is a report that compilation with -O did not work with 18.54 - under System V release 2. - -NCR Intel system (i386-ncr-sysv4.2) - - This system works in 19.31, but if you don't link it with GNU ld, - you may need to set LD_RUN_PATH at link time to specify where - to find the X libraries. - -NeXT (m68k-next-nextstep) - - Emacs 19 has not been tested extensively yet, but it seems to work - in a NeXTStep 3.0 terminal window, and under the X server called - co-Xist. You may need to specify -traditional when src/Makefile - builds xmakefile. - - NeXT users might want to implement direct operation with NeXTStep, - but from the point of view of the GNU project, that is a - distraction. - - Thanks to Thorsten Ohl for working on the NeXT port of Emacs 19. - -Nixdorf Targon 31 (m68k-nixdorf-sysv) - - Machine description file for version 17 is included in 18 - but whether it works is not known. - `src/unexec.c' bombs if compiled with -O. - Note that the "Targon 35" is really a Pyramid. - -Nu (TI or LMI) (m68k-nu-sysv) - - Version 18 is believed to work. - -Paragon OSF/1 (i860-intel-osf1) - - Changes merged in 19.29. - - There is a bug in OSF/1 make which claims there is a syntax error - in the src/xmakefile. You can successfully build emacs with: - - pmake MAKE=pmake - -Plexus (m68k-plexus-sysv) - - Worked as of 17.56. - -Pmax (DEC Mips) (mips-dec-ultrix or mips-dec-osf1) - - See under DECstation, above. - -Prime EXL (i386-prime-sysv) - - Minor changes merged in 19.1. - -Pyramid (pyramid-pyramid-bsd) - - The 19.26 pretest was observed to work on OSx 5.0, but it is necessary - to edit gmalloc.c. You must add #include at the top, - and delete the #define for size_t. - - You need to build Emacs in the Berkeley universe with - the `ucb' command, as in `ucb make' or `ucb build-install'. - - In OSx 4.0, it seems necessary to add the following two lines - to `src/m/pyramid.h': - #define _longjmp longjmp - #define _setjmp setjmp - - In Pyramid system 2.5 there has been a compiler bug making - Emacs crash just after screen-splitting with Qnil containing 0. - A compiler that fixes this is Pyramid customer number 8494, - internal number 1923. - - Some versions of the pyramid compiler get fatal - errors when the -gx compiler switch is used; if this - happens to you, change `src/m/pyramid.h' to define - C_DEBUG_SWITCH with an empty definition. - - Some old system versions may require you to define PYRAMID_OLD - in when alloca.s is preprocessed, in order to define _longjmp and _setjmp. - -Sequent Balance (ns32k-sequent-bsd4.2 or ns32k-sequent-bsd4.3) - - Emacs 18.51 worked on system version 3.0. 18.52 is said to work. - Delete some lines at the end of `src/m/sequent.h' for earlier system - versions. - -Sequent Symmetry (i386-sequent-bsd, i386-sequent-ptx) - - Emacs 19 should work on Dynix (BSD). However, if you compile with - the Sequent compiler, you may find Emacs does not restore the - terminal settings on exit. If this happens, compile with GCC. - - Emacs 19.27 contains patches that should support - DYNIX/ptx 1.4 and 2.1 with the native cc compiler. - - Gcc can't compile src/process.c due to a non-standard Sequent asm - keyword extension supported by cc and used for the network byte/word - swapping functions in the PTX /usr/include/netinet/in.h file. Gcc - 2.5.8 includes the file which can be included into - netinet/in.h to perform these byte/word swapping functions in the - same manner. Patches have been submitted to the FSF against gcc - 2.6.0 to fix this problem and allow Emacs to be built with gcc. - - If your machine does not have TCP/IP installed, you will have to edit the - src/s/ptx.h file and comment out #define TCPIP_INSTALLED. - -Siemens Nixdorf RM600 and RM400 (mips-siemens-sysv4) - - Changes merged in 19.29. This configuration should also work for - Pyramid MIS Server running DC-OSX 1.x. The version configured with - `--with-x' works without any modifications, but `--with-x-toolkit' - works only if the Athena library and the Toolkit library are linked - statically. For this, edit `src/Makefile' after the `configure' run - and modify the lines with `-lXaw' and `-lXt' as follows: - - LIBW= /usr/lib/libXaw.a - LIBXT= $(LIBW) -lXmu /usr/lib/libXt.a $(LIBXTR6) -lXext - -SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3) - - 18.52 worked. Use m68k-sony-bsd4.3 for system release 3. - -SONY News 3000 series (RISC NEWS) (mips-sony-bsd) - - The 19.26 pretest is reported to work. - - Some versions of the operating system give SIGTRAP for division by zero - instead of the usual signals. This causes division by zero - to make Emacs crash. The system should be fixed to give the proper signal. - Changing Emacs is not a proper solution, because it would prevent - Emacs from working under any debugger. But you can change init_data - in data.c if you wish. - -Stardent i860 (i860-stardent-sysv4.0) - - 19.26 pretest reported to work. - -Stardent 1500 or 3000 - - See Titan. - -Stride (m68k-stride-sysv) - - Works (most recent news for 18.30) on their release 2.0. - For release 2.2, see the end of `src/m/stride.h'. - It may be possible to run on their V.1 system but changes - in the s- file would be needed. - -Sun 3, Sun 4 (sparc), Sun 386 (m68k-sun-sunos, sparc-sun-sunos, i386-sun-sunos, - sparc-sun-sunos4shr, sparc-sun-solaris2.*, - i386-sun-solaris2.*) - - 19.26 is believed to work on Sparcs and Sun 3's. Some people report - that Emacs crashes immediately on startup when used with a non-X - terminal, but we think this is due to compiling with GCC and failing - to use GCC's "fixed" system header files. - - Some Sun versions of X windows use the clipboard, not the selections, - for transferring text between clients. The Cut, Paste and Copy items - in the menu bar Edit menu work with the clipboard. - - It's important to include the SunOS version number in the - configuration name. For example, for SunOS release 4.0 on a Sun 3, - use `m68k-sun-sunos4.0'; for SunOS release 4.1 on a Sparc, use - `sparc-sun-sunos4.1'. For SunOS release 4.1.3 on a Sparc, use - `sparc-sun-sunos4.1.3'. Use sunos4shr to link with shared libraries - on Sunos 4.1. - - (FSF MACHINES file says use of shared libraries does not work with - X11R5 or X11R6 on Sunos 4 as of 19.26, but I think this does not - apply to XEmacs.) - - Use `m68k' for the 68000-based Sun boxes, `sparc' for Sparcstations, - and `i386' for Sun Roadrunners. i386 calls for Sunos4.0. - - Do not define the environment variable 'KEEP_STATE' while running - `configure'. - - FSF MACHINES file says the following: (may not apply to XEmacs) - - If you compile with Sun's ANSI compiler acc, you need additional options - when linking temacs, such as - /usr/lang/SC2.0.1/values-Xt.o -L/usr/lang/SC2.0.1/cg87 -L/usr/lang/SC2.0.1 - (those should be added just before the libraries) and you need to - add -lansi just before -lc. The precise file names depend on the - compiler version, so we cannot easily arrange to supply them. - - On SunOS 4.1.1, do not use /usr/5bin/cc. You can use gcc or/usr/bin/cc. - Make sure the environment variable LD_LIBRARY_PATH is not defined. - - Some people report crashes on SunOS 4.1.3 if SYSTEM_MALLOC is defined. - Others have reported that Emacs works if SYSTEM_MALLOC is defined, and not - if it is undefined. So far we do not know why results vary in this way. - The sources are set up so that SYSTEM_MALLOC is defined; if that crashes, - or if you want the benefit of the relocating memory allocator, you can - try enabling the #undef SYSTEM_MALLOC in src/s/sunos4-1-3.h. - - On Solaris 2, you need to install patch 100947-02 to fix a system bug. - Presumably this patch comes from Sun. You must alter the definition of - LD_SWITCH_SYSTEM if your X11 libraries are not in /usr/openwin/lib. - You must make sure that /usr/ucblib is not in your LD_LIBRARY_PATH. - - On Solaris 2.2, with a multiprocessor SparcCenter 1000, Emacs 19.17 is - reported to hang sometimes if it exits while it has one or more - subprocesses (e.g. the `wakeup' subprocess used by `display-time'). - Emacs and its subprocesses become zombies, and in their zombie state - slow down their host and disable rlogin and telnet. This is most - likely due to a bug in Solaris 2.2's multiprocessor support, - rather than an Emacs bug. - - On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make - sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before - /usr/ucb. (Most free software packages have the same requirement on - Solaris.) - - If you have trouble using open-network-stream, get the distribution - of `bind' (the BSD name-server), build libresolv.a, and link Emacs - with -lresolv, by copying the #definition of LIBS_SYSTEM in - src/s/sunos4-1.h to src/config.h. This problem is due to obsolete - software in the nonshared standard library. - - If you want to use SunWindows, define HAVE_SUN_WINDOWS - in config.h to enable a special interface called `emacstool'. - The definition must *precede* the #include "machine.h". - System version 3.2 is required for this facility to work. - - We recommend that you instead use the X window system, which - has technical advantages, is an industry standard, and is also - free software. The FSF does not support the SunWindows code; - we installed it only on the understanding we would not let it - divert our efforts from what we think is important. - - If you are compiling for X windows, and the X window library was - compiled to use the 68881, then you must edit config.h according - the comments at the end of `src/m/sun3.h'. - - Note that Emacs on a Sun is not really as big as it looks. - As dumped, it includes around 200k of zeros between the - original text section and the original data section - (now remapped as part of the text). These are never - swapped in. - - To build a single Emacs that will run on Sun 2 and Sun 3 - HARDWARE, just build it on the Sun 2. - - On Sunos 4.1.3, the word is that Emacs can loop infinitely - on startup with X due perhaps to a bug in Sunos. Installing all of - these Sun patches fixes the problem. We don't know which of them - are really relevant. - - 100075-11 100224-06 100347-03 100482-05 100557-02 100623-03 100804-03 - 101080-01 100103-12 100249-09 100496-02 100564-07 100630-02 100891-10 - 101134-01 100170-09 100296-04 100377-09 100507-04 100567-04 100650-02 - 101070-01 101145-01 100173-10 100305-15 100383-06 100513-04 100570-05 - 100689-01 101071-03 101200-02 100178-09 100338-05 100421-03 100536-02 - 100584-05 100784-01 101072-01 101207-01 - -Tadpole 68K (m68k-tadpole-sysv) - - Changes merged in 19.1. - - You may need to edit Makefile to change the variables LIBDIR and - BINDIR from /usr/local to /usr/contrib. - - To give movemail access to /usr/mail, you may need to execute - - chmod 2755 etc/movemail; chgrp mail etc/movemail - -Tahoe (tahoe-tahoe-bsd4.2 or tahoe-tahoe-bsd4.3) - - 18.52 was known to work on some Tahoes, but a compiler bug intervenes - on others. Some Emacs versions have worked in Unisys 1r4 - (not in 1r3) and CCI I.21. - - If you have trouble compiling `lib-src/loadst.c', turn off the definition - of DKSTAT_HEADER_FILE in `src/m/tahoe.h'. - -Tandem Integrity S2 (mips-tandem-sysv) - - Changes merged in 18.56 but subprocess support is turned off. - You will probably want to see if you can make subprocesses work. - - You must edit `lib-src/Makefile' to define LOADLIBES = -mld. - -Tektronix XD88 (m88k-tektronix-sysv3*) - - The 19.26 pretest was reported to work. - Minor changes merged in 19.19. - -Tektronix 16000 box (6130?) (ns16k-tektronix-bsd) - - Emacs 17.61 worked. - -Tektronix 4300 (m68k-tektronix-bsd) - - Emacs 19.26 pretest reported to work. - -Titan P2 or P3 (titan-titan-sysv) - - Changes probably merged in version 19. - -Ustation E30 (SS5E) (m68k-unisys-unipl) - - Changes merged in 18.52; don't know whether they work. - -Vaxen running Berkeley Unix (vax-dec-bsd4.1, vax-dec-bsd4.2, vax-dec-bsd4.3), - Ultrix (vax-dec-ultrix), - System V (vax-dec-sysv0, vax-dec-sysv2), or - VMS (vax-dec-vms) - - Works. - - See under Ultrix for problems using X windows on Ultrix (vax-dec-ultrix). - - 18.27 worked on System V rel 2 (vax-dec-sysv2). - - 18.36 worked on System V rel 0 (vax-dec-sysv0). - - Richard Levitte distributes a set of patches to - Emacs 18.59 to make it work nicely under VMS. Emacs 19 probably - won't work very well, or even compile. Levitte is working on a - port, so these problems should be fixed in the near future. - -Whitechapel MG1 (ns16k-whitechapel-?) - - May work. Supposedly no changes were needed except in `src/m/mg1.h' - file. I do not know what Unix version runs on them. - -Wicat (m68k-wicat-sysv) - - Changes merged as of 18.6; whether they work is unknown. - See comments in `src/m/wicat.h' for things you should change - depending on the system and compiler version you have. - -Here are notes about some of the systems supported: - -Berkeley 4.1 (bsd4.1) - - Works on vaxes. - -Berkeley 4.2 (bsd4.2) - - Works on several machines. - -Berkeley 4.3 (bsd4.3) - - Works, on Vaxes at least. - -Esix - - The following was written for Emacs 18.59 and has been - slightly adapted for Emacs 19. It may need more change to be correct. - - Use s/usg5-4.h for Esix System V 4.0.[34] systems if you also have - XFree86. If you insist on using the Esix X Window libraries, good - luck. s/esix5r4.h provides a starting point, but doesn't seem to - work consistently. The basic problems involve the need to load - -lX11 *last* in the link command, and even then some things break. - You get best results by installing XFree86 and forgetting about the - Esix stuff unless you want to run IXI xdt3, which really only needs - the Esix X11 shared libraries. - - To compile with XFree86, make sure that your LD_LIBRARY_PATH - contains /usr/X386/lib. Be careful if you also have the Esix X - Window libraries that /usr/X386/lib appears *first* in the - LD_LIBRARY_PATH. Then define C_SWITCH_X_SYSTEM -I/usr/X386/include. - -Microport - - See under "Intel 386". - -SCO Unix - If you have TCP but not X, you need to edit src/s/sco4.h - to define HAVE_SOCKETS. - - If you are using MMDF instead of sendmail, you need to remove - /usr/lib/sendmail or modify lisp/paths.el before compiling. - lisp/paths.el (which is loaded during the build) will attempt to use - sendmail if it exists. - - If you are using SMAIL, you need to define the macro - SMAIL in config.h. - -System V rel 0 (usg5.0) - - Works, on Vaxes and 3bxxx's. - There are some problems in 18.37 due to shortnames/cccp problems: - use the emacs 17 cpp if you have it. - -System V rel 2 (usg5.2) - - Works on various machines. - On some (maybe all) machines the library -lPW exists and contains - a version of `alloca'. On these machines, to use it, put - #define HAVE_ALLOCA - #define LIB_STANDARD -lPW -lc - in the `src/m/MACHINENAME.h' file for the machine. - - If you find that the character Meta-DEL makes Emacs crash, - find where function init_sys_modes in sysdep.c sets sg.c_cc[VQUIT] - and make it store 7 there. I have as yet no evidence of whether - this problem, known in HP/UX, exists in other system V versions. - -System V rel 2.2 (usg5.2.2) - - In 5.2.2 AT&T undid, incompatibly, their previous incompatible - change to the way the nlist library is called. A different s- file - is used to enable the other interface. - - They call themselves the right choice--can't they choose? - - Emacs version 18 unexec is currently not working properly - on 5.2.2. Nobody knows why yet. A workaround is to define - NO_REMAP. It is not yet known whether this applies to all - machines running 5.2.2. - -System V rel 3 (usg5.3) - - Some versions of this system support ptys and BSD-style sockets. - On such systems, you should define HAVE_PTYS and HAVE_SOCKETS in config.h. - - If you want to link Emacs with shared libraries, define - USG_SHARED_LIBRARIES. - - You may have to add ANSI idempotence #-lines to your sys/types.h - file to get Emacs to compile correctly. This may be necessary on - other pre-ANSI systems as well. - - On an AT&T 6386WGS using System V Release 3.2 and X11R3, the X support - cannot be made to work. Whether or not the GNU relocating malloc is - used, the symptom is that the first call Emacs makes to sbrk(0) returns - (char *)-1. Sorry, you're stuck with character-only mode. Try - installing Xfree86 to fix this. - -System V rel 4.0.3 and 4.0.4 (usg5.4) - - Supported, including shared libraries for ELF, but ptys do not work - because TIOCGPGRP fails to work on ptys (but Dell 2.2 seems to have - fixed this). This failure is probably due to a misunderstanding of - the consequences of the POSIX spec: many system designers mistakenly - think that POSIX requires this feature to fail. This is untrue; - ptys are an extension, and POSIX says that extensions *when used* - may change the action of standard facilities in any fashion. - - If you get compilation errors about wrong number of - arguments to getpgrp, define GETPGRP_NO_ARG. - - The standard C preprocessor may generate xmakefile incorrectly. However, - /lib/cpp will work, so use `make CPP=/lib/cpp'. Standard cpp - seems to work OK under Dell 2.2. - - Some versions 3 and earlier of V.4, on the Intel 386 and 860, had - problems in the X11 libraries. These prevent Emacs from working - with X. You can use Emacs with X provided your copy of X is based - on X11 release 4 or newer, or is Dell's 2.2 (which is a 4.0.3). - Unfortunately, the only way you can tell whether your X11 library is - new enough is to try compiling Emacs to use X. If emacs runs, your - X11 library is new enough. - - In this context, GSV4 and GSV4i are alternate names for X11R4. - OL2.* is X11R3 based. OL3 is in between X11R3 and X11R4, and may or - may not work, depending on who made the Unix system. If the library - libXol is part of the X distribution, then you have X11R3 and Emacs - won't work with X. - - Most versions of V.4 support sockets. If `/usr/lib/libsocket.so' - exists, your system supports them. If yours does not, you must add - #undef HAVE_SOCKETS in config.h, after the inclusion of s-usg5-4.h. - (Any system that supports Internet should implement sockets.) - -Ultrix (bsd4.3) - - Recent versions of Ultrix appear to support the features of Berkeley 4.3. - Ultrix was at the BSD 4.2 level for a long time after BSD 4.3 came out. - - Ultrix 3.0 has incompatibilities in its X library if you have the - Ultrix version of X (UWS version 2.0). To solve them, you need to - prevent XvmsAlloc.o in Xlib from being used. Israel Pinkas says: - - I added the following lines to config.h after the X defines: - - #if defined(ultrix) && defined(X11) - #define OBJECTS_SYSTEM calloc.o - #endif - - Then I ran the following: - - ar x /usr/lib/libc.a calloc.o - - The problem is said to be gone in UWS version 2.1. - -Uniplus 5.2 (unipl5.2) - - Works, on Dual machines at least. - -VMS (vmsM.N) - - Richard Levitte distributes a set of patches to - Emacs 18.59 to make it work nicely under VMS. Emacs 19 probably - won't work very well, or even compile. Levitte is working on a - port, so these problems should be fixed in the near future. - - Note that Emacs for VMS is usually distributed in a special VMS - distribution. See the file ../vms/VMSINSTALL for info on moving - Unix distributions to VMS, and other VMS-related topics. - -Xenix (xenix) - - Should work in 18.50, but you will need to edit the files - `lib-src/Makefile' and `src/ymakefile' - (see the comments that mention "Xenix" for what to change.) - Compiling Emacs with -O is said not to work. - - If you want Emacs to work with Smail (installed as /usr/bin/smail) - then add the line #define SMAIL to config.h. - - The file etc/XENIX suggests some useful things to do to Xenix - to make the Emacs meta key work. - -Local variables: -mode: indented-text -fill-prefix: " " -End: diff --git a/etc/MAILINGLISTS b/etc/MAILINGLISTS deleted file mode 100644 index 2bab54a..0000000 --- a/etc/MAILINGLISTS +++ /dev/null @@ -1,1206 +0,0 @@ - - XEmacs Electronic Mailing Lists. Last Modified: 1997-01-13 - -XEmacs has its own mailing list and newsgroup which are distinct from -the FSF GNU Emacs mailing lists and newsgroups. The mailing list is: - - xemacs@xemacs.org For reporting all bugs in XEmacs, including bugs - in the compilation and installation procedures. - Also for all random questions and conversation - about XEmacs. - -This mailing list is bidirectionally gatewayed into the USENET newsgroup -comp.emacs.xemacs. - -To be added or removed from this mailing list, send mail to -xemacs-request@xemacs.org (If it is possible for you to read the -messages via the newsgroup, we would prefer that; the fewer people there -are on the mailing list, the less trouble it is to maintain.) - -Please do NOT send messages about problems with XEmacs to the FSF GNU -Emacs newsgroups and mailing lists (listed below) unless you are sure -that the problem you are reporting is a problem with both versions of -GNU Emacs. People who aren't subscribed to the XEmacs mailing list most -likely are not interested in hearing about problems with it. - -The XEmacs mailing list is archived at ftp://ftp.xemacs.org/pub/xemacs/mlists/. - -See the file etc/BETA for more information about mailing lists for use -by beta testers and XEmacs developers. - -IMPORTANT IMPORTANT IMPORTANT: - -Aside from the names of the mailing lists and newsgroups corresponding -to this version of Emacs, the guidelines enumerated below still apply. -Please read them before sending a message. - ------------------------------------------------------------------------ - GNU Project Electronic Mailing Lists and gnUSENET Newsgroups - Last Updated 1 July 97 - - Please report improvements to: gnu@prep.ai.mit.edu - -* GNU mailing lists are also distributed as USENET news groups - -The mailing lists are gated both ways with the gnu.all newsgroups at -ohio-state.edu. The one-to-one correspondence is indicated below. If -you don't know if your site is on USENET, ask your system administrator. -If you are a USENET site and don't get the gnu.all newsgroups, please -ask your USENET administrator to get them. If he has your feeds ask -their feeds, you should win. And everyone else wins: newsgroups make -better use of the limited bandwidth of the computer networks and your -home machine than mailing list traffic; and staying off the mailing -lists make better use of the people who maintain the lists and the -machines that the GNU people working with rms use (i.e. we have more -time to produce code!!). Thanx. - -* Getting the mailing lists directly - -If several users at your site or local network want to read a list and -you aren't a USENET site, Project GNU would prefer that you would set up -one address that redistributes locally. This reduces overhead on our -people and machines, your gateway machine, and the network(s) used to -transport the mail from us to you. - -* How to subscribe to and report bugs in mailing lists - -Send messages ABOUT these lists, such as reports of mail problems, or -requests to be added or removed, to help-gnu-emacs-request (or -info-gnu-request, bug-gdb-request, etc.), NOT to info-gnu-emacs (or -info-gnu, etc.). These -request addresses go only to the -people who can do something about your requests or problems, and thus -avoids disturbing everyone else. - -Note that all GNU mailing lists are maintained by volunteers. They get -behind occasionally. Wait at least 3 or 4 days before asking again. -Thanks! - -Many of the GNU mailing lists are very large and are received by many -people. Please don't send them anything that is not seriously important -to all their readers. All GNU mailing lists are unmoderated, mail -reflectors, except info-gnu, info-gnu-emacs, info-gcc, info-g++, -info-gnu-fortran. - -All addresses below are in internet format. Consult the mail guru for -your computer to figure out address syntaxes from other networks. From -UUCP machines: - ..!ucbvax!prep.ai.mit.edu!ADDRESS - ..!uunet!prep.ai.mit.edu!ADDRESS - -If a message you mail to a list is returned from a MAILER-DAEMON (often -with the line: - ----- Transcript of session follows ----- - don't resend the message to the list. All this return means is that -your original message failed to reach a few addresses on the list. Such -messages are NEVER a reason to resend a piece of mail a 2nd time. This -just bothers all (less the few delivery failures (which will probably -just fail again!)) of the readers of the list with a message they have -already seen. It also wastes computer and network resources. - -It is appropriate to send these to the -request address for a list, and -ask them to check the problem out. - -* Send Specific Requests for Information to: gnu@prep.ai.mit.edu - -Specific requests for information about obtaining GNU software, or GNU -activities in Cambridge and elsewhere can be directed to: - gnu@prep.ai.mit.edu - -* General Information about all lists - -Please keep each message under 25,000 characters. Some mailers bounce -messages that are longer than this. If your message is long, it is -generally better to send a message offering to make the large file -available to only those people who want it (e.g. mailing it to people -who ask, or putting it up for FTP). In the case of gnu.emacs.sources, -somewhat larger postings (up to 10 parts of no more than 25,000 -characters each) are acceptable (assuming they are likely to be of -interest to a reasonable number of people); if it is larger than that -have it added to archive.cis.ohio-state.edu (the GNU Emacs Lisp ftp and -uucp archive on and announce) its location there. Good bug reports are -short. See section '* General Information about bug-* lists and ...' -for further details. - -Most of the time, when you reply to a message sent to a list, the reply -should not go to the list. But most mail reading programs supply, by -default, all the recipients of the original as recipients of the reply. -Make a point of deleting the list address from the header when it does -not belong. This prevents bothering all readers of a list, and reduces -network congestion. - -The GNU mailing lists and newsgroups, like the GNU project itself, exist -to promote the freedom to share software. So don't use these lists to -promote or recommend non-free software. (Using them to post ordering -information is the ultimate faux pas.) If there is no free program to -do a certain task, then somebody should write one! - -* General Information about info-* lists - -These lists and their newsgroups are meant for important announcements. -Since the GNU project uses software development as a means for social -change, the announcements may be technical or political. - -Most GNU projects info-* lists (and their corresponding gnu.*.announce -newsgroups) are moderated to keep their content significant and -relevant. If you have a bug to report, send it to the bug-* list. If -you need help on something else and the help-* list exists, ask it. - -See section '* General Information about all lists'. - -* General Information about help-* lists - -These lists (and their newsgroups) exist for anyone to ask questions -about the GNU software that the list deals with. The lists are read by -people who are willing to take the time to help other users. - -When you answer the questions that people ask on the help-* lists, keep -in mind that you shouldn't answer by promoting a proprietary program as -a solution. The only real solutions are the ones all the readers can -share. - -If a program crashes, or if you build it following the standard -procedure on a system on which it is supposed to work and it does not -work at all, or if an command does not behave as it is documented to -behave, this is a bug. Don't send bug reports to a help-* list; mail -them to the bug-* list instead. - -See section '* General Information about all lists'. - -* General Information about bug-* lists and reporting program bugs - -If you think something is a bug in a program, it might be one; or, it -might be a misunderstanding or even a feature. Before beginning to -report bugs, please read the section ``Reporting Emacs Bugs'' toward the -end of the GNU Emacs reference manual (or node Emacs/Bugs in Emacs's -built-in Info system) for a discussion of how and when to send in bug -reports. For GNU programs other than GNU Emacs, also consult their -documentation for their bug reporting procedures. Always include the -version number of the GNU program, as well as the operating system and -machine the program was ran on (if the program doesn't have a version -number, send the date of the latest entry in the file ChangeLog). For -GNU Emacs bugs, type "M-x emacs-version". A debugger backtrace of any -core dump, can also be useful. Be careful to separate out hypothesis -from fact! For bugs in GNU Emacs lisp, set variable debug-on-error to -t, and re-enter the command(s) that cause the error message; Emacs will -pop up a debug buffer if something is wrong; please include a copy of -the buffer in your bug report. Please also try to make your bug report -as short as possible; distill the problem to as few lines of code and/or -input as possible. GNU maintainers give priority to the shortest, high -quality bug reports. - -Please don't send in a patch without a test case to illustrate the -problem the patch is supposed to fix. Sometimes the patches aren't -correct or aren't the best way to do the job, and without a test case -there is no way to debug an alternate fix. - -The purpose of reporting a bug is to enable the bug to be fixed for the -sake of the whole community of users. You may or may not receive a -response; the maintainers will send one if that helps them find or -verify a fix. Most GNU maintainers are volunteers and all are -overworked; they don't have time to help individuals and still fix the -bugs and make the improvements that everyone wants. If you want help -for yourself in particular, you may have to hire someone. The GNU -project maintains a list of people providing such services. It is -distributed with GNU Emacs in file etc/SERVICE, and can be requested -from gnu@prep.ai.mit.edu. - -Anything addressed to the implementors and maintainers of a GNU program -via a bug-* list, should NOT be sent to the corresponding info-* or -help-* list. - -Please DON'T post your bug reports on the gnu.*.bug newsgroups! Mail -them to bug-*@prep instead! At first sight, it seems to make no -difference: anything sent to one will be propagated to the other; but: - - if you post on the newsgroup, the information about how to -reach you is lost in the message that goes on the mailing list. It -can be very important to know how to reach you, if there is anything -in the bug report that we don't understand; - - bug reports reach the GNU maintainers quickest when they are -sent to the bug-* mailing list submittal address; - - mail is much more reliable then netnews; and - - if the internet mailers can't get your bug report delivered, -they almost always send you an error message, so you can find another -way to get the bug report in. When netnews fails to get your message -delivered to the maintainers, you'll never know about it and the -maintainers will never see the bug report. - -And please DON'T post your GNU bug reports to comp.* or other gnu.* -newsgroups, they never make it to the GNU maintainers at all. Please -mail them to bug-*@prep instead! - -See section '* General Information about all lists'. - -* info-gnu-request@prep.ai.mit.edu to subscribe to info-gnu -** gnUSENET newsgroup: gnu.announce -** Send announcements to: info-gnu@prep.ai.mit.edu - -This list distributes progress reports on the GNU Project. It is also -used by the GNU Project to ask people for various kinds of help. It is -NOT for general discussion. - -The list is filtered to remove items meant for info-gnu-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -See section '* General Information about info-* lists'. - -* gnu-misc-discuss-request@prep.ai.mit.edu to subscribe to gnu-misc-discuss -** gnUSENET newsgroup: gnu.misc.discuss -** Send contributions to: gnu-misc-discuss@prep.ai.mit.edu - -This list is for serious discussion of freed software, the GNU Project, -the GNU Manifesto, and their implications. It's THE place for -discussion that is not appropriate in the other GNU mailing lists and -gnUSENET newsgroups. - -Flaming is out of place. Tit-for-tat is not welcome. Repetition -should not occur. - -Good READING and writing are expected. Before posting, wait a while, -cool off, and think. - -Don't use this group for complaints and bug reports about GNU software! -The maintainers don't read this group; they won't see your complaint. -Use the appropriate bug-reporting mailing list instead, so that people -who can do something about the problem will see it. - -Don't trust pronouncements made on gnu-misc-discuss about what GNU is, -what FSF position is, what the GNU General Public License is, etc., -unless they are made by someone you know is well connected with GNU and -are sure the message is not forged. - -USENET and gnUSENET readers are expected to have read ALL the articles -in news.announce.newusers before posting. If news.announce.newusers is -empty at your site, wait (the articles are posted monthly), your posting -isn't that urgent! Readers on the Internet can anonymous FTP these -articles from host ftp.uu.net under directory ?? - -Someone from the Free Software Foundation will attempt to follow this -group as time and volume permits. - -Remember, "GNUs Not Unix" and "gnUSENET is Not USENET". We have -higher standards! - -Note that sending technical questions about specific GNU software to -gnu-misc-discuss is likely to be less useful than sending them to the -appropriate mailing list or gnUSENET newsgroup, since more technical -people read those. - -* bug-gnu-sql-request@prep.ai.mit.edu to subscribe to bug-gnu-sql -** gnUSENET newsgroup: NONE PLANNED -** GNU-SQL BUG reports to: bug-gnu-sql@prep.ai.mit.edu - -This list distributes, to the active maintainers of GNU's SQL (GNU's SQL -full scale database server), bug reports and fixes for, and suggestions -for improvements to GNU's SQL. User discussion of GNU's SQL also occurs -here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's SQL. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-guile-request@prep.ai.mit.edu to subscribe to bug-guile -** gnUSENET newsgroup: NONE PLANNED -** GUILE BUG reports to: bug-guile@prep.ai.mit.edu - -This list distributes, to the active maintainers of GUILE (GNU's -Ubiquitous Extension Language), bug reports and fixes for, and suggestions for -improvements to GUILE. User discussion of GUILE also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GUILE . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* guile-sources-request@prep.ai.mit.edu to subscribe to guile-sources -** gnUSENET newsgroup: NONE PLANNED -** Guile source code to: guile-sources@prep.ai.mit.edu - -This list will be for the posting, by their authors, of GUILE, Scheme, -and C sources and patches that improve Guile. Its contents will be -reviewed by the FSF for inclusion in future releases of GUILE. - -Please do NOT discuss or request source code here. Use bug-guile for -those purposes. This allows the automatic archiving of sources posted -to this list. - -Please do NOT post such sources to any other GNU mailing list (e.g -bug-guile) or gnUSENET newsgroups. It's up to each poster to decide -whether to cross-post to any non-gnUSENET newsgroup. - -Please do NOT announce that you have posted source code to guile.sources -to any other GNU mailing list (e.g. bug-guile) or gnUSENET newsgroups. -People who want to keep up with sources will read this list. It's up to -each poster to decide whether to announce a guile.sources article in any -non-gnUSENET newsgroup (e.g. comp.emacs or comp.sources.d). - -If source or patches that were previously posted or a simple fix is -requested in bug-guile, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not by a broadcast medium that reaches millions -of sites. - -If the requested source is very long (>10k bytes) send mail offering to -send it. This prevents the requester from getting many redundant copies -and saves network bandwidth. - -* bug-gnustep-request@prep.ai.mit.edu to subscribe to bug-gnustep -** gnUSENET newsgroup: gnu.gnustep.bug -** Gnustep bug reports to: bug-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNUstep to its active developers. - -Subscribers to bug-gnustep get all info-gnustep messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnustep-request@prep.ai.mit.edu to subscribe to help-gnustep -** gnUSENET newsgroup: gnu.gnustep.help -** Send contributions to: help-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for users and installers of the GNUstep to ask -for help. Please send bug reports to bug-gnustep@prep.ai.mit.edu -instead of posting them here. - -See section '* General Information about help-* lists'. - -* discuss-gnustep-request@prep.ai.mit.edu to subscribe to discuss-gnustep -** gnUSENET newsgroup: gnu.gnustep.discuss -** Send contributions to: discuss-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for GNUstep users and developers to discuss -GNUstep. Please send bug reports to bug-gnustep@prep.ai.mit.edu -instead of posting them here. - -See section '* General Information about discuss-* lists'. - -* info-gnustep-request@prep.ai.mit.edu to subscribe to info-gnustep -** gnUSENET newsgroup: gnu.gnustep.announce -** Send announcements to: info-gnustep@prep.ai.mit.edu -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes announcements and progress reports on GNUstep. -It is NOT for general discussion; please use discuss-gnustep for that. - -The list is filtered to remove items meant for info-gnustep-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -Do not report GNUstep bugs to info-gnustep, help-gnustep, or -discuss-gnustep, mail them to bug-gnustep@prep.ai.mit.edu instead. - -See section '* General Information about info-* lists'. - -* bug-hurd-request@prep.ai.mit.edu to subscribe to bug-hurd -** gnUSENET newsgroup: gnu.hurd.bug -** Hurd bug reports to: bug-hurd@prep.ai.mit.edu - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU Hurd to its active developers. - -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@prep.ai.mit.edu (see above). - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-hurd-request@prep.ai.mit.edu to subscribe to help-hurd -** gnUSENET newsgroup: gnu.hurd.help -** Send contributions to: help-hurd@prep.ai.mit.edu - -This list is the place for users and installers of the GNU Hurd to ask -for help. - -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@prep.ai.mit.edu (see above). - -See section '* General Information about help-* lists'. - -* hurd-ann-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NEVER EXISTED -** DEAD address: hurd-ann@prep.ai.mit.edu - -This list is dead. Announcements about the GNU Hurd will be made to the -list info-gnu@prep.ai.mit.edu (see above). - -* bug-gnu-emacs-request@prep.ai.mit.edu to subscribe to bug-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.bug -** Gnu Emacs bug reports to: bug-gnu-emacs@prep.ai.mit.edu - -This list distributes, to the active maintainers of GNU Emacs, bug -reports and fixes for, and suggestions for improvements in GNU Emacs. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@prep.ai.mit.edu - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -Subscribers to bug-gnu-emacs get all info-gnu-emacs messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* gnu-emacs-sources-request@prep.ai.mit.edu to subscribe to gnu-emacs-sources -** gnUSENET newsgroup: gnu.emacs.sources -** Gnu Emacs source code to: gnu-emacs-sources@prep.ai.mit.edu - -This list/newsgroup will be for the posting, by their authors, of Emacs -Lisp and C sources and patches that improve GNU Emacs. Its contents -will be reviewed by the FSF for inclusion in future releases of GNU -Emacs. - -Please do NOT discuss or request source code here. Use -help-gnu-emacs/gnu.emacs.help for those purposes. This allows the -automatic archiving of sources posted to this list/newsgroup. - -Please do NOT post such sources to any other GNU mailing list (e.g -help-gnu-emacs) or gnUSENET newsgroups (e.g. gnu.emacs.help). It's up -to each poster to decide whether to cross-post to any non-gnUSENET -newsgroup (e.g. comp.emacs or vmsnet.sources). - -Please do NOT announce that you have posted source code to -gnu.emacs.sources to any other GNU mailing list (e.g. help-gnu-emacs) or -gnUSENET newsgroups (e.g. gnu.emacs.help). People who want to keep up -with sources will read this list/newsgroup. It's up to each poster to -decide whether to announce a gnu.emacs.sources article in any -non-gnUSENET newsgroup (e.g. comp.emacs or comp.sources.d). - -If source or patches that were previously posted or a simple fix is -requested in help-gnu-emacs, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not by a broadcast medium that reaches millions -of sites. - -If the requested source is very long (>10k bytes) send mail offering to -send it. This prevents the requester from getting many redundant copies -and saves network bandwidth. - -* help-gnu-emacs-request@prep.ai.mit.edu to subscribe to help-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.help (and one-way into comp.emacs) -** Send contributions to: help-gnu-emacs@prep.ai.mit.edu - -This list is the place for users and installers of GNU Emacs to ask for -help. Please send bug reports to bug-gnu-emacs instead of posting them -here. - -Since help-gnu-emacs is a very large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-gnu-emacs, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -This list is also gated one way to USENET's newsgroup comp.emacs (once -known as net.emacs). This one-way gating is done for users whose sites -get comp.emacs, but not gnu.emacs.help. Users at non-USENET sites may -receive all articles from comp.emacs by making their request to: -unix-emacs-request@bbn.com - -If Emacs crashes, or if you build Emacs following the standard procedure -on a system which Emacs is supposed to work on (see etc/MACHINES) and it -does not work at all, or if an editing command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-gnu-emacs (gnu.emacs.help) or post them to comp.emacs; mail them to -bug-gnu-emacs@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gnu-emacs-request@prep.ai.mit.edu to subscribe to info-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.announce (and one-way into comp.emacs) -** Send announcements to: info-gnu-emacs@prep.ai.mit.edu - -This list distributes announcements and progress reports on GNU Emacs. -It is NOT for general discussion; please use help-gnu-emacs for that. - -The list is filtered to remove items meant for info-gnu-emacs-request, -that can be answered by the moderator without bothering the list, or -should have been sent to another list. - -info-gnu-emacs is also gated one way to USENET's newsgroup comp.emacs -(once known as net.emacs). This one-way gating is done for users whose -sites get comp.emacs, but not gnu.emacs.announce. Users at non-USENET -sites may receive all articles from comp.emacs by making their request -to: unix-emacs-request@bbn.com - -Do not report GNU Emacs bugs to info-gnu-emacs or comp.emacs, instead -mail them to bug-gnu-emacs@prep.ai.mit.edu. - -See section '* General Information about info-* lists'. - -* vms-gnu-emacs-request@prep.ai.mit.edu to subscribe -** gnUSENET newsgroup: gnu.emacs.vms -** Send contributions to: vms-gnu-emacs@prep.ai.mit.edu - -This list was a working group who did the initial port of GNU Emacs to -the VMS operating system. It still discusses problems and solutions to -the VMS port and the distribution of it. - -* bug-bash-request@prep.ai.mit.edu to subscribe to bug-bash -** gnUSENET newsgroup: gnu.bash.bug -** BASH bug reports to: bug-bash@prep.ai.mit.edu - -This list distributes, to the active maintainers of BASH (the Bourne -Again SHell), bug reports and fixes for, and suggestions for -improvements in BASH. User discussion of BASH also occurs here. - -Always report the version number of the operating system, hardware, and -bash (flag -version on startup or check the variable $BASH_VERSION in a -running bash). - -There are no other GNU mailing lists or gnUSENET newsgroups for BASH. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gdb-request@prep.ai.mit.edu to subscribe to bug-gdb -** gnUSENET newsgroup: gnu.gdb.bug -** GDB bug reports to: bug-gdb@prep.ai.mit.edu - -This list distributes, to the active maintainers of GDB (Gnu's -DeBugger), bug reports and fixes for, and suggestions for improvements -in GDB. - -There are no other GNU mailing lists or gnUSENET newsgroups for GDB. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-octave-request@che.utexas.edu to subscribe to bug-octave -** gnUSENET newsgroup: NONE PLANNED -** Octave bug reports to: bug-octave@che.utexas.edu - -This list distributes, to the active maintainers of Octave (a system -for numerical computations), bug reports and fixes for, and -suggestions for improvements to Octave. - -The help-octave mailing list is for user discussion of Octave. - -See section '* General Information about bug-* lists and reporting -program bugs'. - - -* help-octave-request@che.utexas.edu to subscribe to help-octave -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: help-octave@che.utexas.edu - -This list is the place for users and installers of Octave to ask for -help. Please send bug reports to bug-octave instead of posting them -here. - -If Octave crashes, or if you build Octave following the standard -procedure on a system on which Octave is supposed to work on and it -does not work at all, or if a command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-octave; mail them to bug-octave@che.utexas.edu instead. - -See section '* General Information about help-* lists'. - -* bug-gcc-request@prep.ai.mit.edu to subscribe to bug-gcc -** gnUSENET newsgroup: gnu.gcc.bug -** GCC bug reports to: bug-gcc@prep.ai.mit.edu - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C Compiler to its active -developers. - -Please don't send in a patch without a test case to illustrate the -problem the patch is supposed to fix. Sometimes the patches aren't -correct or aren't the best way to do the job, and without a test case -there is no way to debug an alternate fix. - -The most convenient form of test case is a piece of cpp output that can -be passed directly to cc1. Preferably written in C, not C++ or -Objective C. - -Subscribers to bug-gcc get all info-gcc messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gcc-request@prep.ai.mit.edu to subscribe to help-gcc -** gnUSENET newsgroup: gnu.gcc.help -** Send contributions to: help-gcc@prep.ai.mit.edu - -This list is the place for users and installers of the GNU C Compiler to -ask for help. - -If gcc crashes, or if you build gcc following the standard procedure on -a system which gcc is supposed to work on (see config.sub) and it does -not work at all, or if an command line option does not behave as it is -documented to behave, this is a bug. Don't send bug reports to help-gcc -(gnu.gcc.help); mail them to bug-gcc@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gcc-request@prep.ai.mit.edu to subscribe to info-gcc -** gnUSENET newsgroup: gnu.gcc.announce -** Send announcements to: info-gcc@prep.ai.mit.edu - -This list distributes announcements and progress reports on the GNU C -Compiler. It is NOT for general discussion; please use help-gcc for -that. - -The list is filtered to remove items meant for info-gcc-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -See section '* General Information about info-* lists'. - -* bug-gnu960-request@ichips.intel.com to subscribe to bug-gnu960 -** gnUSENET newsgroup: NONE PLANNED -** Intel 960 Port bug reports to: bug-gnu960@ichips.intel.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in Intel's port of GNU software to the -Intel 960 microprocessor. - -You can also fax to: GNU/960 - 1-503-696-4930. - -There are no other GNU mailing lists or gnUSENET newsgroups for Intel's -port of GNU software to the Intel 960 microprocessor. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-glibc-request@prep.ai.mit.edu to subscribe to bug-glibc -** gnUSENET newsgroup: gnu.glibc.bug -** GNU C Library bug reports to: bug-glibc@prep.ai.mit.edu - -This list distributes, to the active maintainers of glibc (GNU's C -library), bug reports and fixes for, and suggestions for improvements in -glibc. User discussion of glibc also occurs here. - -Announcements of new releases of glibc are made on both info-gcc and -bug-glibc. - -There are no other GNU mailing lists or gnUSENET newsgroups for the GNU -C Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-g++-request@prep.ai.mit.edu to subscribe to bug-g++ -** gnUSENET newsgroup: gnu.g++.bug -** G++ bug reports to: bug-g++@prep.ai.mit.edu - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C++ Compiler to its active -developers. - -G++ uses the GNU C-Compiler back end. Active developers may wish to -subscribe to bug-gcc@prep.ai.mit.edu as well. - -Subscribers to bug-g++ get all info-g++ messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-g++-request@prep.ai.mit.edu to subscribe to help-g++ -** gnUSENET newsgroup: gnu.g++.help (and one-way into comp.lang.c++) -** Send contributions to: help-g++@prep.ai.mit.edu - -This list is the place for users and installers of the GNU C++ Compiler -to ask for help. Please send bug reports to bug-g++@prep.ai.mit.edu -instead of posting them here. - -help-g++ is also gated one way to USENET's newsgroup comp.lang.c++. -This one-way gating is done for users whose sites get comp.lang.c++, but -not gnu.g++.help. - -See section '* General Information about help-* lists'. - -* info-g++-request@prep.ai.mit.edu to subscribe to info-g++ -** gnUSENET newsgroup: gnu.g++.announce (and one-way into comp.lang.c++) -** Send announcements to: info-g++@prep.ai.mit.edu - -This list distributes announcements and progress reports on the GNU C++ -Compiler. It is NOT for general discussion; please use help-g++ for -that. - -The list is filtered to remove items meant for info-g++-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -It is also gated one way to USENET's newsgroup comp.lang.c++. This -one-way gating is done for users whose sites get comp.lang.c++, but not -gnu.g++.announce. - -Do not report g++ bugs to info-g++ or comp.lang.c++, mail them to -bug-g++@prep.ai.mit.edu instead. - -See section '* General Information about info-* lists'. - -* bug-lib-g++-request@prep.ai.mit.edu to subscribe to bug-lib-g++ -** gnUSENET newsgroup: gnu.g++.lib.bug -** lib-g++ bug reports to: bug-lib-g++@prep.ai.mit.edu - -This list distributes, to the active maintainers of libg++ (GNU's -library for C++), bug reports and fixes for, and suggestions for -improvements in lib-g++. User discussion of libg++ also occurs here. - -Announcements of new releases of libg++ are made on both info-g++ and -bug-lib-g++. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's -G++ Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* info-gnu-fortran-request@prep.ai.mit.edu to subscribe to info-gnu-fortran -** gnUSENET newsgroup: NONE YET -** Send announcements to: info-gnu-fortran@prep.ai.mit.edu - -This list is for progress reports about the GNU Fortran compiler. In -the future it will also be used for release notices. - -The list is filtered to remove items meant for info-gnu-fortran-request, -that can be answered by the moderator without bothering the list, or -should have been sent to another list. - -People on the Internet can get a current status report by fingering the -address fortran@gnu.ai.mit.edu. - -See section '* General Information about info-* lists'. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Fortran (yet). - -* bug-oleo-request@prep.ai.mit.edu to subscribe to bug-oleo -** gnUSENET newsgroup: NONE PLANNED -** Oleo bug reports to: bug-oleo@prep.ai.mit.edu - -This list distributes, to the active maintainers of Oleo (the GNU -spreadsheet), bug reports and fixes for, and suggestions for -improvements to Oleo. User discussion of Oleo also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for Oleo . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gmp-request@prep.ai.mit.edu to subscribe to bug-gmp -** gnUSENET newsgroup: NONE PLANNED -** gmp bug reports to: bug-gmp@prep.ai.mit.edu - -This list distributes, to the active maintainers of gmp (the GNU -Multiple Precision Library), bug reports and fixes for, and suggestions -for improvements to gmp. User discussion of gmp also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for gmp . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-pine-request@prep.ai.mit.edu to subscribe to bug-pine -** gnUSENET newsgroup: NONE PLANNED -** pine bug reports to: bug-pine@prep.ai.mit.edu - -This list distributes, to the active maintainers of pine (the GNU -version of the pine mail reader), bug reports and fixes for, and suggestions -for improvements to pine. User discussion of pine also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for pine . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-cfengine-request@prep.ai.mit.edu to subscribe to bug-cfengine -** gnUSENET newsgroup: gnu.cfengine.bug -** cfengine bug reports to: bug-cfengine@prep.ai.mit.edu - -This list distributes, to the active maintainers of cfengine (configure -BSD and System-5-like operating systems attached to a TCP/IP network), -bug reports and fixes for, and suggestions for improvements to cfengine. -User discussion of cfengine also occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-cfengine-request@prep.ai.mit.edu to subscribe to help-cfengine -** gnUSENET newsgroup: gnu.cfengine.help -** Send contributions to: help-cfengine@prep.ai.mit.edu - -This list is the place for users and installers of cfengine to ask for -help. Please send bug reports to bug-cfengine instead of posting them -here. - -This list is also used for announcements about cfengine and related -programs, and small but important patches. Announcements of cfengine -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since help-cfengine is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-cfengine, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-smalltalk-request@prep.ai.mit.edu to subscribe to bug-gnu-smalltalk -** gnUSENET newsgroup: gnu.smalltalk.bug -** GNU Smalltalk bug reports to: bug-gnu-smalltalk@prep.ai.mit.edu - -GNU Smalltalk is the GNU project implementation of the Smalltalk language. - -This list distributes, to the active maintainers of GNU Smalltalk, bug -reports and fixes for, and suggestions for improvements to GNU -Smalltalk. User discussion of GNU Smalltalk also occurs here. - -For now, new releases of GNU Smalltalk will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Smalltalk. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* st-next-request@laplace.eng.sun.com to subscribe to st-next -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: st-next@laplace.eng.sun.com - -For people interested in working on GNU Smalltalk on the NeXT. - -* bug-groff-request@prep.ai.mit.edu to subscribe to bug-groff -** gnUSENET newsgroup: gnu.groff.bug -** GNU groff bug reports to: bug-groff@prep.ai.mit.edu - -groff is the GNU project implementation, in C++, of the traditional Unix -document formatting tools. - -This list distributes, to the active maintainers of groff, bug reports -and fixes for, and suggestions for improvements to groff (and it -component programs). User discussion of groff also occurs here. - -For now, new releases of groff will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for groff. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-ghostscript-request@prep.ai.mit.edu to subscribe to bug-ghostscript -** gnUSENET newsgroup: gnu.ghostscript.bug -** Ghostscript bug reports to: bug-ghostscript@prep.ai.mit.edu - -Ghostscript is the GNU project implementation of a language and graphics -library with a remarkable similarity to PostScript. - -This list distributes, to the active maintainers of Ghostscript, bug -reports and fixes for, and suggestions for improvements in Ghostscript. - -For now, new releases of Ghostscript will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for -Ghostscript. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gnu-utils-request@prep.ai.mit.edu to subscribe to bug-gnu-utils -** gnUSENET newsgroup: gnu.utils.bug -** GNU Utilities bug reports to: bug-gnu-utils@prep.ai.mit.edu - -This list distributes, to the active maintainers of these programs, bug -reports and fixes for, and suggestions for improvements in GNU programs -not covered by other bug-* mailing lists/gnu.*.bug newsgroups. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-utils-request@prep.ai.mit.edu to subscribe to help-gnu-utils -** gnUSENET newsgroup: gnu.utils.help -** Send contributions to: help-gnu-utils@prep.ai.mit.edu - -This list is the place for users and installers of GNU programs not -covered by other GNU mailing lists/gnu.* newsgroups to ask for help. - -Don't send bug reports to help-gnu-utils (gnu.utils.help); mail them to -bug-gnu-utils@prep.ai.mit.edu instead. - -See section '* General Information about help-* lists'. - -* info-gnu-utils-request@prep.ai.mit.edu IS NOW DEFUNCT -** a gnUSENET newsgroup bever existed -** DEAD address: info-gnu-utils@prep.ai.mit.edu - -This list is dead. Announcements about GNU Utilities will be made to the -list info-gnu@prep.ai.mit.edu (see above). - -* info-cvs-request@prep.ai.mit.edu to subscribe to info-cvs. -** USENET newsgroup: (none) -** CVS discussions/questions to: info-cvs@prep.ai.mit.edu - -This list is for discussion and dissemination of information about -CVS. Please check the FAQ before posting questions, however. - -* bug-cvs-request@prep.ai.mit.edu to subscribe to bug-cvs. -** USENET newsgroup: (none) -** CVS bug reports to: bug-cvs@prep.ai.mit.edu - -This list distributes bug reports, fixes, and suggestions for -improvements to the maintainers of CVS. - -* bug-fortran-mode-request@erl.mit.edu to subscribe to bug-fortran-mode -** USENET newsgroup: (none) -** Fortran mode bug reports to: bug-fortran-mode@erl.mit.edu - -This list collects bug reports, fixes for bugs, and suggestions for -improvements in GNU Emacs's Fortran mode (a major mode to support -editing Fortran source code). - -It is the place to report Fortran mode bugs by all users of Fortran -mode. - -Always report the version number Fortran mode reports on startup as well -as the version of Emacs. - -There is no info-fortran-mode list. There are no USENET gateways to -bug-fortran-mode at this time. - -* info-gnus-request@flab.fujitsu.co.jp to subscribe -** gnUSENET newsgroup: NONE YET -** Send contributions to: info-gnus@flab.fujitsu.co.jp - -The list is intended to exchange useful information about GNUS, such as -bug reports, useful hooks, and extensions of GNUS. GNUS is an NNTP-base -network news reader for GNU Emacs (which also works with a news spool). -English and Japanese are the official languages of the list. GNUS is -quite different than gnews. - -* info-gnus-english-request@prep.ai.mit.edu to subscribe -** gnUSENET newsgroup: gnu.emacs.gnus -** Send contributions to: info-gnus-english@prep.ai.mit.edu - -The list has the same charter as info-gnus. The difference is that -English is the only official language of the list. - -info-gnus-english/gnu.emacs.gnus is forward to info-gnus, but NOT -vice-versa. - -* info-gnews-request@ics.uci.edu to subscribe to info-gnews -** gnUSENET newsgroup: gnu.emacs.gnews -** Send contributions to: info-gnews@ics.uci.edu - -This newsgroup is intended to exchange useful information about gnews, -such as bug reports, useful hooks, and extensions of gnews. gnews is an -NNTP-base network news reader for GNU Emacs (which also works a news -spool). It is quite different than GNUS. - -* gnu-emacs-ada-request@grebyn.com to subscribe to gnu-emacs-ada -** gnUSENET newsgroup: NONE PLANNED -** Gnu Emacs Ada support bug reports to: gnu-emacs-ada@grebyn.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNU Emacs' editing support of the Ada -programming language. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Emacs' editing support of Ada. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-vm-request@uunet.uu.net to subscribe to bug-vm -** gnUSENET newsgroup: gnu.emacs.vm.bug -** VM mail reader bug reports to: bug-vm@uunet.uu.net - -This list discusses bugs in View Mail mode for GNU Emacs, with an -emphasis on beta and prerelease versions. - -Always report the version number of VM you are using, as well as the -version of Emacs you're running. If you believe it is significant, -report the operating system used and the hardware. - -Subscribers to bug-vm get all info-vm messages. - -* info-vm-request@uunet.uu.net to subscribe to info-vm -** gnUSENET newsgroup: gnu.emacs.vm.info -** Send contributions to: info-vm@uunet.uu.net - -This list discusses the View Mail mode for GNU Emacs, an alternative to -rmail mode. - -* supercite-request@warsaw.nlm.nih.gov to subscribe to supercite -** gnUSENET newsgroup: NONE PLANNED -** Send articles to: supercite@warsaw.nlm.nih.gov -*** UUCP: ..!uunet!warsaw.nlm.nih.gov!supercite-request - -The supercite mailing list covers issues related to the advanced -mail/news citation package called Supercite for GNU Emacs. - -* auc-tex-request@iesd.auc.dk to subscribe -** USENET newsgroup: NONE YET -** Send contributions to: auc-tex@iesd.auc.dk - -The list is intended to exchange information about AUC TeX, such as -bug reports, request for help, and information on current -developments. AUC TeX is a much enhanced LaTeX mode for GNU Emacs. - -The list is unmoderated. - -* bug-gnu-chess-request@prep.ai.mit.edu to subscribe to bug-gnu-chess -** gnUSENET newsgroup: gnu.chess.bug -** GNU Chess bug reports to: bug-gnu-chess@prep.ai.mit.edu - -This list directly accesses the GNU Chess developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-chess get all info-gnu-chess messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-chess-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-chess@prep.ai.mit.edu - -This list is dead. Use info-gnu-chess@prep.ai.mit.edu/gnu.chess instead. - -* info-gnu-chess-request@prep.ai.mit.edu to subscribe to info-gnu-chess -** gnUSENET newsgroup: gnu.chess -** Send contributions to: info-gnu-chess@prep.ai.mit.edu -** FAQ-URL: http://www.research.digital.com/SRC/personal/Tim_Mann/chess.html -** FAQ-Archive-name: games/chess/gnu-faq -** FAQ-Posting-frequency: monthly - -This list is the place for users and installers of GNU Chess to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-chess instead -of posting them here. - -This list is also used for announcements about GNU Chess and related -programs, and small but important patches. Announcements of GNU Chess -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since info-gnu-chess is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-chess, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-shogi-request@prep.ai.mit.edu to subscribe to bug-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** GNU Shogi bug reports to: bug-gnu-shogi@prep.ai.mit.edu - -This list directly accesses the GNU Shogi developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-shogi get all info-gnu-shogi messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -Shogi is a game something like chess. There are several different types -of pieces, a board that is 9 by 9 squares, and the modification that a -captured piece can be reintroduced on the board by the capturing player -(and used). Due to this last difference from Western chess, a Shogi -game never simplifies. - -* help-gnu-shogi-request@prep.ai.mit.edu IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-shogi@prep.ai.mit.edu - -This list is dead. - -* info-gnu-shogi-request@prep.ai.mit.edu to subscribe to info-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: info-gnu-shogi@prep.ai.mit.edu - -This list is the place for users and installers of GNU Shogi to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-shogi instead -of posting them here. - -This list is also used for announcements about GNU Shogi and related -programs, and small but important patches. Announcements of GNU Shogi -releases are also made to info-gnu@prep.ai.mit.edu (see above) - -Since info-gnu-shogi is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-shogi, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* gnu-manual-request@a.cs.uiuc.edu IS NOW DEFUNCT -** DEAD: Gnusenet newsgroup: gnu.emacs.lisp.manual -** DEAD address: gnu-manual@a.cs.uiuc.edu -*** DEAD UUCP address: ..!uunet!uiucdcs!gnu-manual-request - -This list and newsgroup is dead. It was a working group whose -volunteers wrote, proofread and commented on the developing GNU Emacs -Lisp programmers manual. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@prep.ai.mit.edu - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.config -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -configuration. It exists to distribute information about the -administration and configuration of gnUSENET: the gnu.all alternative -USENET hierarchy that carry the GNU mailing lists. - -Administrators of gnUSENET hosts receiving the gnu.all newsgroups are -welcome to ask questions here or via e-mail of gnu@prep.ai.mit.edu. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.test -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -testing. It exists to allow test messages to be made in gnUSENET: the -gnu.all alternative USENET hierarchy that carry the GNU mailing lists. - -Local variables: -mode: outline -fill-column: 72 -End: diff --git a/etc/NEWS b/etc/NEWS deleted file mode 100644 index 439f7c0..0000000 --- a/etc/NEWS +++ /dev/null @@ -1,606 +0,0 @@ --*- mode:outline -*- - -* Introduction -============== - -This file presents some general information about XEmacs. It is -primarily about the changes in recent XEmacs versions and its release -history. - -Use `C-c C-f' to move to the next equal level of outline, and -`C-c C-b' to move to previous equal level. `C-h m' will give more -info about the Outline mode. Many commands are also available through -the menubar. - -Users who would like to know which capabilities have been introduced -in each release should look at the appropriate section of this file. -Starting with version 20.0, XEmacs includes ChangeLogs, which can be -consulted for a more detailed list of changes. - -Users interested in some of the details of how XEmacs differs from GNU -Emacs should read the section "What's Different?" near the end of this -file. - - N.B. The term "GNU Emacs" refers to any release of Emacs Version - 19 from the Free Software Foundation's GNU Project. (We do not - say just "Emacs" as Richard M. Stallman ["RMS"] prefers, because - it is clearly a more generic term.) The term "XEmacs" refers to - this program or to its predecessors "Era" and "Lucid Emacs". The - predecessor of all these program is called "Emacs 18". When no - particular version is implied, "Emacs" will be used. - - -* Changes in XEmacs 21.2 -======================== - -** Interactive searching and matching case improvements: -Case sensitiveness in searching operations is controled by the variable -`case-fold-search' (if non-nil, case is ignored while searching). This -mechanism has now been slightly improved in the case of an interactive -search: if the search string (or regexp) happens to contain uppercase -characters, the searching is forced to be case-sensitive, regardless of -the value of `case-fold-search'. This behavior affects all functions -performing interactive searches, like `zap-to-char', `tags-search', -`occur' etc. - -** You can now create "indirect buffers", like in GNU Emacs. An -indirect buffer shares its text with another buffer ("base buffer"), -but has its own major mode, local variables, extents, and narrowing. -An indirect buffer has a name of its own, distinct from those of the -base buffer and all other buffers. An indirect buffer cannot itself -be visiting a file (though its base buffer can be). The base buffer -cannot itself be indirect. - -Use (make-indirect-buffer BASE-BUFFER NAME) to make an indirect buffer -named NAME whose base is BASE-BUFFER. If BASE-BUFFER is an indirect -buffer, its base buffer is used as the base for the new buffer. - -You can make an indirect buffer current, or switch to it in a window, -just as you would a non-indirect buffer. - -The function `buffer-base-buffer', given an indirect buffer, returns -its base buffer. It returns nil when given an ordinary buffer (not -indirect). `buffer-indirect-children' returns a list of the indirect -children of a base buffer. - - -* Lisp and internal changes in XEmacs 21.2 -========================================== - -** Functions for decoding base64 encoding are now available; see -`base64-encode-region', `base64-encode-string', `base64-decode-region' -and `base64-decode-string'. - -** Many basic lisp operations are now faster. -This is especially the case when running a Mule-enabled XEmacs. - -A general overhaul of the lisp engine should produce a speedup of 1.4 -in a Latin-1 XEmacs, and 2.1 in a Mule XEmacs. These numbers were -obtained running (byte-compile "simple.el"), which should be a pretty -typical test of `pure' lisp. - -Lisp hash tables have been re-implemented. The Common Lisp style hash -table interface has been made standard, and moved from cl.el into fast -C code (See the section on hash tables in the XEmacs Lisp Reference). -A speedup factor of 3 can be expected with code that makes intensive -use of hash tables. - -The garbage collector has been tuned, leading to a speedup of 1.16. - -The family of functions that iterate over lists, like `memq', and -`rassq', have been made a little faster (typically 1.3). - -Lisp function calls are faster, by approximately a factor of two. -However, defining inline functions (via defsubst) still make sense. - -And finally, a few functions have had dramatic performance -improvements. For example, (last long-list) is now 30 times faster. - -Of course, your mileage will vary. - -Many operations do not see any improvement. Surprisingly, running -(font-lock-refontify-buffer) does not use the Lisp engine much at all. -Speeding up your favorite slow operation is an excellent project to -improve XEmacs. Don't forget to profile! - -** XEmacs finally has an automated test suite! -Although this is not yet very sophisticated, it is already responsible -for several important bug fixes in XEmacs. To try it out, simply use -the makefile target `make check' after building XEmacs. - -** New hash table implementation -As was pointed out above, the standard interface to hash tables is now -the Common Lisp interface, as described in Common Lisp, the Language -(CLtL2, by Steele). The older interface (functions with names -containing the phrase `hashtable') will continue to work, but the -preferred interface now has names containing the phrase `hash-table'. - -Here's the executive overview: create hash tables using -make-hash-table, and use gethash, puthash, remhash, maphash and -clrhash to manipulate entries in the hash table. See the (updated) -Lisp Reference Manual for details. - -** Lisp code handles circular lists much more robustly. -Many basic lisp functions used to loop forever when given a circular -list. Now this is more likely to trigger a `circular-list' error. -Printing a circular list now results in something like this: - - (progn (setq x (cons 'foo 'foo)) (setcdr x x) x) -==> (foo ... ) - -An extra bonus is that checking for circularities is not just -friendlier, but actually faster than checking for quit. - - -* Changes in XEmacs 21.0 -======================== - -** XEmacs has been unbundled into constituent installable packages. -See the Info documentation under "Packages" for more information. -See the file `etc/PACKAGES' in the distribution for a partial list of -packages available at the time of the 21.0 release. - -** XEmacs is now supported under Microsoft Windows 95/98 and Windows -NT operating systems. For starters, look at the XEmacs on Windows FAQ -at . To -discuss Windows-specific issues, subscribe to the mailing list at -. - -** XEmacs will now use `XEmacs' as its application class if it finds -any `XEmacs' resources in the resource database. Otherwise, it will -continue to use the `Emacs' class. - -** The options menu has been ported to Custom. -This means that each entry in the options menu acts as if you had customized -the corresponding variable by hand. ### WARNING: there is currently no -upgrading function to help you port your old options settings to the new -format. Consequently, if you want to modify the options for XEmacs 21, you -will have to set them all again through the menu, and remove the code loading -.xemacs-options from your .emacs. - -** When the Zmacs region is active, `M-x query-replace' and the other -replace commands now operate on the region contents only. - -** Using the new `-private' option, you can make XEmacs use a private -colormap. - -** The `imenu' package has been ported to XEmacs and is available as a -package. - -** `echo-keystrokes' can now be a floating-point number, so that you -can set it to intervals shorter than one second. - - (setq echo-keystrokes 0.1) - -** The new command `center-to-window-line' works like `recenter' -(bound to `C-l'), only it does not redisplay the whole display area. - -** The M-. command will now first search through exact tags matches, -and then through inexact matches, as one would expect. - -** The new variable `user-full-name' can be used to customize one's -name when using the Emacs mail and news reading facilities. - -Normally, `user-full-name' is a function that returns the full name of -a user or UID, as specified by the system -- for instance, -(user-full-name "root") returns something like "Super-User". However, -when the function is called without arguments, it will return the -value of the `user-full-name' variable. The `user-full-name' variable -is initialized using the environment variable NAME and (failing that) -the user's system name. - -The behavior of the `user-full-name' function with an argument -specified is unchanged. - -** The new command `M-x customize-changed-options' lets you customize -all the options whose default values have changed in recent Emacs -versions. You specify a previous Emacs version number as argument, -and the command creates a customization buffer showing all the -customizable options whose default values were changed since that -version. - -If you don't specify a particular version number argument, then the -customization buffer shows all the customizable options for which -Emacs versions of changes are recorded. - -** The new command `add-log-convert' can be used to convert the -old-style (pre-20.3) ChangeLog buffers to new style, for -consistency. A reminder: if you wish to revert to old-style -ChangeLogs instead, customize the value of `add-log-time-format' -variable. - -** The new command `zap-up-to-char' is now available. It is similar -to `zap-to-char', except that it does not delete the searched-for -character. It is not bound to a key by default. - -** You can now store a number into a register with `C-u NUMBER C-x r n' -REG, increment it by INC with `C-u INC C-x r + REG' (to increment by -one, omit C-u INC), and insert it in the buffer with `C-x r g REG'. -This is useful for writing keyboard macros. - -** The M-: command, when given a prefix argument, will now insert its -result to the current buffer. - -** The `C-h c' command, when given a prefix argument, will now insert -the message into the current buffer. - -** Horizontally split windows may now be dragged using the mouse. -Because of this, the dividers between vertical windows are always -visible. To turn it off, set `vertical-divider-always-visible-p' to -nil. - -** XEmacs/Mule (internationalization) changes. - -*** Mule support now works on TTY's. Use `set-terminal-coding-system' -and `set-keyboard-coding-system' to specify the coding system of your -display and keyboard. - -*** Egg/SJ3 input method is now officially supported. Quail and -Egg/Skk have been available through the generalized Leim since 20.3. - -*** Localized Japanese menubars are available if XEmacs is built with -XFONTSET and either the X11 libraries are built with X_LOCALE defined -or the native C libraries support Japanese localization. This has -been available since 20.3, only it hasn't been announced before. - -** Jamie Zawinski's `gdb-highlight' extension is now distributed with -the `debug' package. gdb-highlight makes most objects printed in a -gdb buffer be mouse-sensitive: as text shows up in the buffer, it is -parsed, and objects which are recognized have context-sensitive -commands attached to them. To use it, add the following to `.emacs': - - (add-hook 'gdb-mode-hook (lambda () (require 'gdb-highlight))) - -** The package popper.el is now included in the edit-utils package. -It has been greatly enhanced with respect to the one once included -with the ilisp package and should work well under XEmacs 21.0. - -** C mode changes - -*** Multiline macros are now handled, both as they affect indentation, -and as recognized syntax. New syntactic symbol cpp-macro-cont is -assigned to second and subsequent lines of a multiline macro -definition. - -*** A new style "user" which captures all non-hook-ified -(i.e. top-level) .emacs file variable setings and customizations. -Style "cc-mode" is an alias for "user" and is deprecated. "gnu" style -is still the default however. - -*** "java" style now conforms to Sun's JDK coding style. - -*** There are new commands c-beginning-of-defun, c-end-of-defun which -are alternatives which you could bind to C-M-a and C-M-e if you prefer -them. They do not have key bindings by default. - -*** New and improved implementations of M-a (c-beginning-of-statement) -and M-e (c-end-of-statement). - -*** C++ namespace blocks are supported, with new syntactic symbols -namespace-open, namespace-close, and innamespace. - -*** File local variable settings of c-file-style and c-file-offsets -makes the style variables local to that buffer only. - -*** New indentation functions c-lineup-close-paren, -c-indent-one-line-block, c-lineup-dont-change. - -*** Improvements (hopefully!) to the way CC Mode is loaded. You -should now be able to do a (require 'cc-mode) to get the entire -package loaded properly for customization in your .emacs file. A new -variable c-initialize-on-load controls this and is t by default. - -** In Text mode, now only blank lines separate paragraphs. -This makes it possible to get the full benefit of Adaptive Fill mode -in Text mode, and other modes derived from it (such as Mail mode). -TAB in Text mode now runs the command indent-relative; this makes a -practical difference only when you use indented paragraphs. - -As a result, the old Indented Text mode is now identical to Text mode, -and is an alias for it. - -If you want spaces at the beginning of a line to start a paragraph, -use the new mode, Paragraph Indent Text mode. - -** Changes to Gnus, the XEmacs newsreader. - -*** New functionality for using Gnus as an offline newsreader has been -added. A plethora of new commands and modes have been added. See the -Gnus manual for the full story. - -*** The nndraft backend has returned, but works differently than -before. All Message buffers are now also articles in the nndraft -group, which is created automatically. - -*** `gnus-alter-header-function' can now be used to alter header -values. - -*** `gnus-summary-goto-article' now accept Message-ID's. - -*** A new Message command for deleting text in the body of a message -outside the region: `C-c C-v'. - -*** You can now post to component group in nnvirtual groups with -`C-u C-c C-c'. - -*** `nntp-rlogin-program' -- new variable to ease customization. - -*** `C-u C-c C-c' in `gnus-article-edit-mode' will now inhibit -re-highlighting of the article buffer. - -*** New element in `gnus-boring-article-headers' -- `long-to'. - -*** `M-i' symbolic prefix command. See the section "Symbolic -Prefixes" in the Gnus manual for details. - -*** `L' and `I' in the summary buffer now take the symbolic prefix -`a' to add the score rule to the "all.SCORE" file. - -*** `gnus-simplify-subject-functions' variable to allow greater -control over simplification. - -*** `A T' -- new command for fetching the current thread. - -*** `/ T' -- new command for including the current thread in the -limit. - -*** `M-RET' is a new Message command for breaking cited text. - -*** \\1-expressions are now valid in `nnmail-split-methods'. - -*** The `custom-face-lookup' function has been removed. -If you used this function in your initialization files, you must -rewrite them to use `face-spec-set' instead. - -*** Cancelling now uses the current select method. Symbolic prefix -`a' forces normal posting method. - -*** New command to translate M******** sm*rtq**t*s into proper text --- `W d'. - -*** For easier debugging of nntp, you can set `nntp-record-commands' -to a non-nil value. - -*** nntp now uses ~/.authinfo, a .netrc-like file, for controlling -where and how to send AUTHINFO to NNTP servers. - -*** A command for editing group parameters from the summary buffer -has been added. - -*** A history of where mails have been split is available. - -*** A new article date command has been added -- `article-date-iso8601'. - -*** Subjects can be simplified when threading by setting -`gnus-score-thread-simplify'. - -*** A new function for citing in Message has been added -- -`message-cite-original-without-signature'. - -*** `article-strip-all-blank-lines' -- new article command. - -*** A new Message command to kill to the end of the article has -been added. - -*** A minimum adaptive score can be specified by using the -`gnus-adaptive-word-minimum' variable. - -*** The "lapsed date" article header can be kept continually -updated by the `gnus-start-date-timer' command. - -*** Web listserv archives can be read with the nnlistserv backend. - -*** Old dejanews archives can now be read by nnweb. - -*** Byte-compilation of user-specs now works under XEmacs. - -** The `dir' files are no longer essential for functioning of the Info -subsystem. If the `dir' file does not exist in an Info directory, the -relevant information will be generated on-the-fly. - -This behavior can be customized, look for `Info-auto-generate-directory' -and `Info-save-auto-generated-dir' in the `info' customization group. - - -* Lisp and internal changes in XEmacs 21.0 -========================================== - -** It is now possible to build XEmacs with support for 31-bit Lisp -integers (normally, Lisp integers are only 28 bits wide on 32-bit -machines.) Configure with --use-minimal-tagbits to test. With this -change, the maximum buffer size on 32-bit machines is increased from -128M to 1G. This setting will be made default in a future XEmacs -version. - -** Specifier changes. - -*** When instantiating a specifier, the window locale now has a higher -precedence than the buffer locale. This is because the window locale -is more specific than the buffer locale. - -*** The new macro `let-specifier' can be used to temporarily add -specifications to specifiers. See the documentation for details. - -*** The new specifiers `vertical-scrollbar-visible-p' and -`horizontal-scrollbar-visible-p' may be used to control scrollbar -visibility. Previously, the only way to remove a scrollbar was to set -its size to 0. This method is still supported for backward -compatibility. - -*** The new specifiers `scrollbar-on-left-p' and `scrollbar-on-top-p' -may be used to control the position of the vertical and horizontal -toolbar. Previously, their position could be changed only through the -use of X resources. - -*** The new draggable vertical dividers between windows may be turned -off using the `vertical-divider-always-visible-p' specifier. When -this is set to nil, the vertical dividers between windows are shown -only when needed, and they are not draggable. - -Other properties of the vertical dividers may be controlled using -`vertical-divider-shadow-thickness', `vertical-divider-line-width' and -`vertical-divider-spacing' specifiers, which see. - -** Frame focus management changes. - -*** When the variable focus-follows-mouse is non-nil, `select-frame' -no longer permanently selects a different frame. The frame selection -is temporary and is reverted when the current command terminates, much -like the buffer selected by `set-buffer'. This is the same as in FSF -Emacs. - -*** The new function `focus-frame' sets the window system focus to -FRAME (and selects it), regardless of the value of -`focus-follows-mouse'. Doing this is not well behaved, so be -absolutely sure that you want this. - -The code that uses `select-frame' only to get the window manager focus -should be changed to use `set-frame-focus' instead, so that they keep -working when `focus-follows-mouse' is non-nil. - -*** The special forms `save-selected-frame' and `with-selected-frame' -can now be used to temporarily change selected frame. - -*** The behavior of `other-frame' command (`C-x 5 o') is unaffected by -these changes. - -** The function `select-window' now has an optional second argument -NORECORD which if non-nil inhibits the recording of a buffer change. - -** The function `vertical-motion' now correctly handles the second, -optional WINDOW argument. A new third argument PIXELS, if non-nil, -indicates that the returned motion should be in pixels. - -** The new function `vertical-motion-pixels' is similar to -vertical-motion but takes as input a vertical motion in pixels. - -** The new functions window-text-area-pixel-{width,height,edges} can -be used to obtain information about the text-displaying area of a -window. - -** The new functions `shrink-window-pixels' and `enlarge-window-pixels' -can be used to adjust the size of a window by a pixel amount. - -** The new function `window-displayed-text-pixel-height' can be used -to determine the height of the text actually displayed in a window. - -** The arithmetic comparison functions <, >, =, /= now accept a -variable number of arguments. - -This means that if you want to test whether A < B < C, you can write -it as (< A B C) instead of (and (< A B) (< B C)). Likewise, -(apply #'> LIST) now tests if LIST is monotonously increasing -- and -so on. - -** The XEmacs hashtables now have a consistent read/print syntax. -This means that a hashtable will be readably printed in a -structure-like form: - - #s(hashtable size 2 data (key1 value1 key2 value2)) - -When XEmacs reads this form, it will create a new hashtable according -to description. This allows you to easily dump hashtables to files -using `prin1', and read them back in using `read'. - -If `print-readably' is non-nil, a more relaxed syntax is used; for -instance: - - # - -** It is now possible to build XEmacs with LDAP support. -You will need to install a LDAP library first. The following have -been tested: - - LDAP 3.3 from the University of Michigan - (get it from ) - - OpenLDAP 1.0.3 from the OpenLDAP Foundation - (get it from ) - - LDAP SDK 1.0 from Netscape Corp. - (get it from ) - -** When profiling is in effect, a call-count of all recorded functions -is now calculated. This information is stored in -`call-count-profile-table', and is utilized by `profile-results' as -well as the new command `profile-call-count-results'. - -** It is now an error to change the value of a symbol whose name -starts with a colon, if it is interned in the standard obarray. - -However, setting such a symbol to its proper value, which is that -symbol itself, is not an error. This is for the sake of programs that -support pre-19.12 XEmacs and pre-20 GNU Emacs by explicitly setting -these variables to themselves. - -** The `concat' function no longer accepts integer arguments. - -** The new function `string' concatenates all its argument characters -and returns the resulting string. This is consistent with other -functions, like `list', `vector', etc. - -** The function `temp-directory' is now available to return the -directory to store temporary files. On Unix this will be obtained -from TMPDIR, defaulting to `/tmp'. - -** The function load-average now accepts an optional argument -USE-FLOATS. If it is non-nil, the load average values are returned as -floating point numbers, rather than as integers to be divided by 100. - -** The `make-event' function now supports the TYPE and PLIST -arguments, which can be used to create various events from Lisp. See -the documentation for details. - -** `function-interactive' is a new function that returns the -interactive specification of a funcallable object. - -** The new `lmessage' function allows printing of a formatted message -with a particular label. - - (lmessage 'progress "Processing... %d" counter) - -This function is more convenient than `display-message' because it -automatically applies `format' to its arguments. - -** The new `lwarn' function, analogous to `lmessage', allows printing -a formatted warning, with a non-default CLASS or LABEL. - -** The new function `split-path' can now be used to explode the -components of a colon-separated search path into a list. - - (split-path "foo:bar") - => ("foo" "bar") - -** Specifiers and symbols whose value is a specifier are now allowed -as modeline specifications. - -** defcustom now accepts the keyword `:version'. Use this to specify -in which version of Emacs a certain variable's default value changed. -For example, - - (defcustom foo-max 34 "*Maximum number of foo's allowed." - :type 'integer - :group 'foo - :version "21.0") - -This information is used to control the customize-changed-options -command. - -** The line number tracking in modeline is now efficient, even for -very large buffers. This is achieved by caching the line numbers of -recent buffer positions, and reusing them. This cache is used only in -the buffers where `line-number-mode' is in effect. - -** When the new GNU Malloc aka Doug Lea Malloc is available, it will -be used. This should result in better performance on Linux systems -with libc6. - -** The code XEmacs uses to assemble its various paths into the -directory hierarchy has been rewritten to support the package system. -Look under "Startup Paths" in the Info documentation for more -information. - -*** site-lisp is now longer part of the load-path by default. -Its use is deprecated, but you can specify --with-site-lisp=yes at the -configure command line to get it back. - -*** `Info-default-directory-list' is now obsolete. If you want to -change the path which XEmacs uses to search for info files, set -`Info-directory-list' instead. diff --git a/etc/OONEWS b/etc/OONEWS deleted file mode 100644 index 56e72d7..0000000 --- a/etc/OONEWS +++ /dev/null @@ -1,5526 +0,0 @@ --*- mode:outline; minor-mode:outl-mouse -*- -C-c TAB This shows subheadings (if any) of current heading. -C-c C-s Show _all_ the text and headings under current heading - - -* Introduction -============== - -This file presents some general information about XEmacs. It is primarily -about the evolution of XEmacs and its release history. - -There are five sections. - - Introduction................(this section) provides an introduction - - Using Outline Mode..........briefly explains how to use outline mode - - XEmacs Release Notes........detailed changes to this release - - Future Plans for XEmacs.....what's next - - The History of XEmacs.......some historical notes - - A Long List of Packages.....all the stuff in XEmacs - - What Changed................between versions and also FSF GNU Emacs - -New users should look at the next section on "Using Outline Mode". -You will be more efficient when you can navigate quickly through this -file. Users who want to know which capabilities have been introduced -in this release should look at the "XEmacs Release Notes." Users -interested in some of the details of how XEmacs differs from GNU Emacs -should read the section "What Changed?". - - N.B. The term "FSF GNU Emacs" refers to any release of Emacs - Version 19 from the Free Software Foundation's GNU Project. (We do - not say just "GNU Emacs" because Richard M. Stallman ["RMS"] - thinks that this term is too generic; although we sometimes say - e.g. "GNU Emacs 19.30" to refer to a specific version of FSF GNU - Emacs. The term "XEmacs" refers to this program or to its - predecessors "Era", "Epoch", and "Lucid Emacs". The predecessor - of all these program is called "Emacs 18". When no particular - version is implied, "Emacs" will be used. - - -* Using Outline Mode -==================== - -This file is in outline mode, a major mode for viewing (or editing) -outlines. It allows you to make parts of the text temporarily invisible so -that you can see just the overall structure of the outline. - -There are two ways of using outline mode: with keys or with menus. Using -outline mode with menus is the simplest and is just as effective as using -keystrokes. There are menus for outline mode on the menubar as well as in -popup menus activated by pressing mouse button 3. - -Try the following to help you read this file. - -C-c C-q This hides everything but the very top level headings - You can then move to an interesting section -C-c TAB This shows subheadings (if any) of current heading. -C-c C-s Show _all_ the text and headings under current heading -C-c C-d Hide _all_ the text and headings under current heading - -It's then easy to navigate through the file alternating between -showing, C-C C-s, and hiding, C-c C-d, the text. Also, use the "Show" -and "Hide" menus displayed to get access to the same commands. - -You may at any time press `C-h m' to get a listing of the outline mode key -bindings. - -* XEmacs Release Notes -====================== - -** Major Differences Between 19.15 and 19.16 -============================================ - -Many bugs have been fixed. XEmacs 19.16 is a bug-fix release only. No -new features have been added. - --- shell-command did not respect its output-buffer argument. - --- When using CVS in conjunction with frame-icon, an error - would occur when a frame was iconified. - --- dired did not properly protect its data structures during - garbage collection. - --- y-or-n-p-minibuf could crash XEmacs 19.15. - --- overlay-lists did not always return a pair of lists. - --- Starting with the -nw option did not prevent XEmacs 19.15 from - attempting to connect to a tooltalk server. - --- XEmacs 19.15 could not be built on a DUNIX4.0 system. - --- appt.el did not respect the user's hooks. - --- outline-mode did not work in a tty-only XEmacs 19.15. - --- MD5 checksum generation did not work on a 64-bit machine. - --- XEmacs 19.15 ignored the user's mail path. - --- The rcompile package checked for ange-ftp instead of efs. - --- vc-directory did not work. - --- Sometimes clicking on a modeline did not advance to the - next or previous buffer as it should have. - --- The variable enable-local-variables was sometimes ignored. - --- pending-del did not respect the user's hooks. - --- CRiSP mode was synchronized with FSF emacs. - --- The performance of font-lock was improved. - --- There were numerous holes in the garbage collection. - --- There were 2 minor bugs with using XEmacs 19.15 on a tty. - --- XEmacs 19.15 ignored certain dead_key events. - --- XEmacs 19.15 had minor fontification problems with java. - --- mark-pop did not always restore the mark properly. - --- smtpmail.el had a couple of minor bugs. - --- telnet-mode did not always respond to the telnet prompt. - --- gomoku was broken in XEmacs 19.15. - --- recover-all files did not work in XEmacs 19.15. - --- transient-mark-mode and skeleton.el did not work together. - --- Footnotes were not properly formatted in info. - --- Configuration of XEmacs 19.15 did not work on Sequent - computers, because they do not have a working version of alloca. - --- In XEmacs 19.15 it was impossible to compile with Lucid - scrollbars without Motif. - --- XEmacs 19.15 would erroneously report an internal error on - certain types of minibuffer input. - --- When using virtual screens with your X server, sometimes - iconify-frame would cause XEmacs 19.15 to lose one of the frames. - --- server-kill-buffer always returned nil. - --- The :filter keyword on a menubar could crash XEmacs 19.15. - --- psgml-mode did not respect the user's hooks. - --- Many bugs in efs mode were fixed. - --- sh-script.el could hang XEmacs. - --- Options could not be saved after fonts were changed in - XEmacs 19.15. - --- read-from-string could not read "1.". - --- dired was confused about where chown lives on Linux. - --- Edebug did not work on floating point numbers. - --- first-change-hook saved the wrong buffer, so unwinding the - stack could result in the wrong buffer's being restored. - --- pcl-cvs was incompatible with live-icon. - --- save-buffer deactivated the zmacs region. - --- When running a sub-process, if the standard error could - not be opened, the error was reported incorectly. - --- shell-command-on-region had a bogus test for the active - region. - --- get-frame-for-buffer ignored relevant properties. - --- make-database did not correctly expand its filename - argument. - --- A few minor improvements were made to the optimizer in the - byte-compiler. - --- kill-region could get confused when the beginning of the - region was after the end of the region. - --- movemail was upgraded to the same version which shipped - with XEmacs 20.2; this version understands Linux file locking. - --- The regexp cache size was too small. - --- The "save as" dialog was buggy. - --- Minor bugs in sendmail mode. - --- tm did not understand the png image format. - --- set-text-properties only removed the first text property. - --- add-log.el has been upgraded to the version supported by - FSF emacs 20.1. - --- When tags-loop-continue was called inappropriately, the - wrong error message resulted. - --- Frame creation was buggy, and could crash XEmacs. - --- PNG support did not work on Linux. - --- Asynchronous process output did not always work. - --- x-compose.el did not support the degree sign or the - grave keysym. - --- mh-invisible-headers did not work. - --- Creating a tty frame could crash XEmacs 19.15. - --- detach-extent could crash XEmacs. - --- The minibuffer could get the read-only attribute. - --- When the mouse was in the right side of the frame, its - position could be reported incorrectly. - --- lib-complete didn't work with compressed files. - --- getloadavg.c was brought into sync with the XEmacs 20.2 - version. - -** Major Differences Between 19.14 and 19.15 -============================================ - -Many bugs have been fixed. An effort has been made to eradicate all -XEmacs crashes, although we are not quite done yet. The overall -quality of XEmacs should be higher than any previous release. XEmacs -now compiles with nary a warning with some compilers. - -User visible changes: - --- EFS replaces ange-ftp for remote file manipulation capability. - --- TM (Tools for Mime) now comes with XEmacs. This provides MIME - (Multi-purpose Internet Multi-media Extensions?) support for Mail - and News. The primary author is Morioka Tomohiko. - --- There is a new way to customize faces and (some) variables. - Try it with `M-x customize RET', or from the Options->Customize menu. - Documented in . - --- The AUC TeX environment for editing and running TeX is now bundled. - (Per Abrahamsen.) - Enable with (require 'tex-site) in your .emacs file. - Documented in . - --- New user option `init-face-from-resources'. - If you don't set faces with X resources, you can speed up the - initialization of new faces by setting this to nil. - --- `column.el' removed, use `column-number-mode' instead. - --- Command line processing should work much better now - no more order - dependencies. - --- html mode now defaults to using HTML-3.2 - --- VM now has a native MIME mode - --- The traditional time.el package now has optional modeline graphics - --- The XEmacs Logo has been changed courtesy of Jens Lautenbacher - --- Default background changed to gray80 - --- The XEmacs build procedure has been changed to make it easier than - ever to include new packages to be dumped with the binary - --- cc-mode is no longer auto-loaded. (require 'cc-mode) is now needed - before you customize cc-mode in your .emacs. - --- blink-cursor-mode is somewhat more useable now that the cursor - stops blinking during keyboard activity. - --- Dired is now part of efs and went from version 6.X to 7.9. - Keybindings have been synced with FSF Emacs, there are more menus and - items in menus are sometimes grouped differently. Any personnal - customization to dired will probably have to be checked. - - If you are a 19.14 user and use its dired a lot, expect to get mad at - 'c', 'r' and '^' keybindings." - - -** New Packages ------------- - -Noteworthy new packages: - redo - igrep - uniquify - auctex - - --- Many new packages have been added: -*** auctex (Per Abrahamsen) -*** customize (Per Abrahamsen)) -*** m4-mode 1.8 (Andrew Csillag) -*** crisp.el - crisp/brief emulation (Gary D. Foster) - Minor mode emulation for Borland's Brief/Crisp editor -*** Johan Vroman's iso-acc.el has been ported to XEmacs by Alexandre Oliva -*** psgml-1.01 (Lennart Staflin, James Clark) -*** python-mode.el 2.90 (Barry Warsaw) -*** vrml-mode.el (Ben Wing) -*** enriched.el, face-menu.el (Boris Goldowsky, Michael Sperber) -*** sh-script.el (Daniel Pfeiffer) -*** decipher.el (Christopher J. Madsen) -*** mic-paren.el (Mikael Sjödin) -*** xrdb-mode.el 1.21 (Barry Warsaw) -*** redo.el 1.01 (Kyle Jones) -*** edmacro.el (ported by Hrvoje Niksic) -*** verilog-mode.el (Michael McNamara) -*** webjump.el-1.4 (Neil W. Van Dyke) -*** overlay.el (Joseph Nuspl support for Emacs overlay API) -*** browse-cltl2.el 1.1 (Holger Schauer) -*** mine.el 1.17 (Jacques Duthen) -*** igrep.el 2.56 (Kevin Rodgers) -*** speedbar.el (Eric Ludlam) -*** frame-icon.el (Michael Lamoureux) -*** winmgr-mode.el (David Konerding, Stefan Strobel & Barry Warsaw) -*** whitespace-mode.el (Heiko Muenkel) -*** detached-minibuf.el (Alvin Shelton) - -** Updated Packages ------------- - -Most packages have been updated to the latest available versions. -(thanks go to countless maintainers): - -*** ediff 2.64 (Michael Kifer) -*** Gnus Gnus 5.4.36 (Lars Magne Ingebrigtsen) - -**** nntp.el has been totally rewritten in an asynchronous fashion. - -**** Article prefetching functionality has been moved up into -Gnus. - -**** Scoring can now be performed with logical operators like -`and', `or', `not', and parent redirection. - -**** Article washing status can be displayed in the -article mode line. - -**** gnus.el has been split into many smaller files. - -**** Suppression of duplicate articles based on Message-ID. - -(setq gnus-suppress-duplicates t) - -**** New variables for specifying what score and adapt files -are to be considered home score and adapt files. See -`gnus-home-score-file' and `gnus-home-adapt-files'. - -**** Groups can inherit group parameters from parent topics. - -**** Article editing has been revamped and is now usable. - -**** Signatures can be recognized in more intelligent fashions. -See `gnus-signature-separator' and `gnus-signature-limit'. - -**** Summary pick mode has been made to look more nn-like. -Line numbers are displayed and the `.' command can be -used to pick articles. - -**** Commands for moving the .newsrc.eld from one server to -another have been added. - - `M-x gnus-change-server' - -**** A way to specify that "uninteresting" fields be suppressed when -generating lines in buffers. - -**** Several commands in the group buffer can be undone with -`M-C-_'. - -**** Scoring can be done on words using the new score type `w'. - -**** Adaptive scoring can be done on a Subject word-by-word basis: - - (setq gnus-use-adaptive-scoring '(word)) - -**** Scores can be decayed. - - (setq gnus-decay-scores t) - -**** Scoring can be performed using a regexp on the Date header. The -Date is normalized to compact ISO 8601 format first. - -**** A new command has been added to remove all data on articles from -the native server. - - `M-x gnus-group-clear-data-on-native-groups' - -**** A new command for reading collections of documents -(nndoc with nnvirtual on top) has been added -- `M-C-d'. - -**** Process mark sets can be pushed and popped. - -**** A new mail-to-news backend makes it possible to post -even when the NNTP server doesn't allow posting. - -**** A new backend for reading searches from Web search engines -(DejaNews, Alta Vista, InReference) has been added. - - Use the `G w' command in the group buffer to create such - a group. - -**** Groups inside topics can now be sorted using the standard -sorting functions, and each topic can be sorted independently. - - See the commands under the `T S' submap. - -**** Subsets of the groups can be sorted independently. - - See the commands under the `G P' submap. - -**** Cached articles can be pulled into the groups. - - Use the `Y c' command. - -**** Score files are now applied in a more reliable order. - -**** Reports on where mail messages end up can be generated. - - `M-x nnmail-split-history' - -**** More hooks and functions have been added to remove junk -from incoming mail before saving the mail. - - See `nnmail-prepare-incoming-header-hook'. - -**** The nnml mail backend now understands compressed article files. -*** w3 3.0.71 (Bill Perry) - - Major upgrade to Emacs/W3, including - - Much fuller stylesheet support - - Tables support - - Frames support - - better asynchronous downloads - - now uses the widget library for consistent look of form elements - - Much much much faster -*** ilisp 5.8 (Chris McConnell, Ivan Vasquez, Marco Antoniotti, Rick - Campbell) -*** VM 6.22 (Kyle Jones) -*** etags 11.78 (Francesco Potorti`) -*** ksh-mode.el 2.9 -*** vhdl-mode.el 2.73 (Rod Whitby) -*** id-select.el 1.4.5 (Bob Weiner) -*** EDT/TPU emulation modes should work now for the first time. -*** viper 2.93 (Michael Kifer) is now the `official' vi emulator for XEmacs. -*** big-menubar should work much better now. -*** mode-motion+.el 3.16 -*** backup-dir 2.0 (Greg Klanderman) -*** ps-print.el-3.05 (Jacques Duthen Prestataire) -*** lazy-lock-1.16 (Simon Marshall) -*** fast-lock.el 3.10.2 (Simon Marshall) -*** reporter 3.3 (Barry Warsaw) -*** hm--html-menus 5.4 (Heiko Muenkel) -*** cc-mode 4.387 (Barry Warsaw) -*** elp 2.37 (Barry Warsaw) -*** itimer.el-1.05 (Kyle Jones) -*** floating-toolbar.el-1.02 (Kyle Jones) -*** balloon-help.el-1.05 (Kyle Jones) -*** hyperbole-4.023 (Bob Weiner) -*** cperl-mode-1.31+ -*** OO-Browser 2.10 (Bob Weiner) - -** Changes at Lisp level ------------- - --- New `widget' library for inserting UI components in buffers. - Documented in . - --- New `custom' library for declaring user options and faces. - Documented in . - --- New function `make-empty-face'. - Like `make-face', but doesn't query the resource database. - --- New function x-keysym-on-keyboard-p helps determine keyboard - characteristics for key rebinding: - - x-keysym-on-keyboard-p: (KEYSYM &optional DEVICE) - -- a built-in function. - Return true if KEYSYM names a key on the keyboard of DEVICE. - More precisely, return true if pressing a physical key - on the keyboard of DEVICE without any modifier keys generates KEYSYM. - Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in - /usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. - --- Usage of keysyms of the form kp_0 is deprecated and one should use - the Emacs compatible kp-0 instead. - - --- preceding-char and following-char have been obsoleted. Use the - much safer and correct functions char-after and char-before instead. - --- Many symbols present for compatibility with GNU Emacs no longer - generate bytecompiler warning messages - --- Installed info files are now compressed (support courtesy of Joseph J Nuspl) - --- (load-average) works on Solaris, even if you're not root. Thanks to - Hrvoje Niksic. - --- OffiX drag-and-drop support added - --- lots of syncing with 19.34 elisp files, most by Steven Baur - --- M-: (eval-expression) is now enabled by default since it is much - more difficult to type. - --- new variables: - signal-error-on-buffer-boundary - - -* Future Plans for XEmacs -========================== - -This is the end of the line for XEmacs v19. No new development is planned -on this source tree. XEmacs 20.1 will contain the functionality in 19.15, -and development will continue with XEmacs 20.2. The major new `feature' -planned in 20.2 will be the introduction of separable packages and the -capability to download and use an XEmacs lite distribution. - -* The History of XEmacs -======================= - -This product is an extension of GNU Emacs, previously known to some as -"Lucid Emacs" or "ERA". It was initially based on an early version of Emacs -Version 19 from the Free Software Foundation and has since been kept -up-to-date with recent versions of that product. It stems from a -collaboration of Lucid, Inc. with SunSoft DevPro (a division of Sun -Microsystems, Inc.; formerly called SunPro) and the University of Illinois. - -NOTE: Lucid, Inc. is currently out of business but development on XEmacs -continues strong. Recently, Amdahl Corporation and INS Engineering have -both contributed significantly to the development of XEmacs. - - -* A Long List of Packages -======================= - -This section gives a detailed list of packages included with XEmacs. -It's long! Of particular interest are: games, gnus, modes, packages, -and utils. - -** auctex - Super TeX -*** auctex/auc-old.el -This file contains an alternative keymapping, compatible with -older versions of AUC TeX. You are strongly suggested to try the -new keyboard layout, as we would like this file to go away -eventually. -*** auctex/bib-cite.el -Commentary: - -This package is used in various TeX modes to display or edit references -associated with \cite commands, or matching \ref and \label commands. -*** auctex/font-latex.el -Commentary: -*** auctex/style/german.el -Commentary: - -`german.sty' use `"' to give next character an umlaut. -*** auctex/style/harvard.el -Commentary: - -Harvard citation style is from Peter Williams available on the CTAN -servers -*** auctex/style/plfonts.el -Commentary: - -`plfonts.sty' use `"' to make next character Polish. -`plfonts.sty' L. Holenderski, IIUW, lhol@mimuw.edu.pl -*** auctex/style/plhb.el -Commentary: - -`plhb.sty' use `"' to make next character Polish. -`plhb.sty' J. S. Bie\'n, IIUW, jsbien@mimuw.edu.pl - - -** bytecomp - Byte compile Emacs Lisp files -*** bytecomp/byte-optimize.el -Commentary: - -======================================================================== -"No matter how hard you try, you can't make a racehorse out of a pig. -You can, however, make a faster pig." - -Or, to put it another way, the emacs byte compiler is a VW Bug. This code -makes it be a VW Bug with fuel injection and a turbocharger... You're -still not going to make it go faster than 70 mph, but it might be easier -to get it there. - -*** bytecomp/bytecomp-runtime.el -Commentary: - -interface to selectively inlining functions. -This only happens when source-code optimization is turned on. -*** bytecomp/bytecomp.el -Commentary: - -The Emacs Lisp byte compiler. This crunches lisp source into a sort -of p-code which takes up less space and can be interpreted faster. -The user entry points are byte-compile-file and byte-recompile-directory. -*** bytecomp/disass.el -Commentary: - -The single entry point, `disassemble', disassembles a code object generated -by the Emacs Lisp byte-compiler. This doesn't invert the compilation -operation, not by a long shot, but it's useful for debugging. - -** calendar - Calendars, diaries and appointments -*** calendar/calendar.el -Commentary: - -This collection of functions implements a calendar window. It -generates a calendar for the current month, together with the previous -and coming months, or for any other three-month period. The calendar -can be scrolled forward and backward in the window to show months in -the past or future; the cursor can move forward and backward by days, -weeks, or months, making it possible, for instance, to jump to the -date a specified number of days, weeks, or months from the date under -the cursor. The user can display a list of holidays and other notable -days for the period shown; the notable days can be marked on the -calendar, if desired. The user can also specify that dates having -corresponding diary entries (in a file that the user specifies) be -marked; the diary entries for any date can be viewed in a separate -window. The diary and the notable days can be viewed independently of -the calendar. Dates can be translated from the (usual) Gregorian -calendar to the day of the year/days remaining in year, to the ISO -commercial calendar, to the Julian (old style) calendar, to the Hebrew -calendar, to the Islamic calendar, to the French Revolutionary calendar, -to the Mayan calendar, and to the astronomical (Julian) day number. -When floating point is available, times of sunrise/sunset can be displayed, -as can the phases of the moon. Appointment notification for diary entries -is available. -*** calendar/cal-dst.el -Commentary: - -This collection of functions implements the features of calendar.el and -holiday.el that deal with daylight savings time. -*** calendar/cal-french.el -Commentary: - -This collection of functions implements the features of calendar.el and -diary.el that deal with the French Revolutionary calendar. -*** calendar/cal-mayan.el -Commentary: - -This collection of functions implements the features of calendar.el and -diary.el that deal with the Mayan calendar. It was written jointly by -*** calendar/cal-x.el -Commentary: - -This collection of functions implements dedicated frames in x-windows for -calendar.el. -*** calendar/cal-xemacs.el -Commentary: - -This collection of functions implements menu bar and popup menu support for -calendar.el. -*** calendar/diary-ins.el -Commentary: - -This collection of functions implements the diary insertion features as -described in calendar.el. -*** calendar/solar.el -Commentary: - -This collection of functions implements the features of calendar.el, -diary.el, and holiday.el that deal with times of day, sunrise/sunset, and -eqinoxes/solstices. - -** cl - Common Lisp compatibility with Emacs Lisp -*** cl/cl-compat.el -Commentary: - -These are extensions to Emacs Lisp that provide a degree of -Common Lisp compatibility, beyond what is already built-in -in Emacs Lisp. - -** comint - For running shells, telnet, rsh, gdb, dbx under Emacs -*** comint/comint-xemacs.el -Commentary: - -Declare customizable faces for comint outside the main code so it can -be dumped with XEmacs. -*** comint/comint.el -Commentary: - -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. -*** comint/gdb.el -Commentary: - -A facility is provided for the simultaneous display of the source code -in one window, while using gdb to step through a function in the -other. A small arrow in the source window, indicates the current -line. -*** comint/gud.el -Commentary: -*** comint/history.el -Commentary: - -suggested generic history stuff -- tale - -This is intended to provided easy access to a list of elements -being kept as a history ring. -*** comint/inf-lisp.el -Commentary: - -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). -*** comint/kermit.el -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. -*** comint/rlogin.el -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. -*** comint/shell.el -Commentary: - -This file defines a 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. -*** comint/telnet.el -Commentary: - -This mode is intended to be used for telnet or rsh to a remode host; -`telnet' and `rsh' are the two entry points. Multiple telnet or rsh -sessions are supported. - -** custom - Allow's user to customize Emacs -*** custom/custom.el -Commentary: - -This file only contain the code needed to declare and initialize -user options. The code to customize options is autoloaded from -`cus-edit.el'. - -The code implementing face declarations is in `cus-face.el' - -** edebug - Emacs Lisp debugger -*** edebug/cl-read.el -Commentary: - -Please send bugs and comments to the author. - -This package replaces the standard Emacs Lisp reader (implemented -as a set of built-in Lisp function in C) by a flexible and -customizable Common Lisp like one (implemented entirely in Emacs -Lisp). During reading of Emacs Lisp source files, it is about 40% -slower than the built-in reader, but there is no difference in -loading byte compiled files - they dont contain any syntactic sugar -and are loaded with the built in subroutine `load'. - -** ediff - Compare and merge files with graphical difference display -*** ediff/ediff.el -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. - -** efs - Remote file access (replaces ange-ftp) -See online manual. - -** electric - The "electric" commands; these implement temporary -windows for help, list-buffers, etc. - -*** electric/ehelp.el -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. - -** emulators - Various emulations: mocklisp, teco, TPU/EDT, WordStar -*** emulators/mlconvert.el -Commentary: - -This package converts Mocklisp code written under a Gosling or UniPress -Emacs for use with GNU Emacs. The translated code will require runtime -support from the mlsupport.el equivalent. -*** emulators/mlsupport.el -Commentary: - -This package provides equivalents of certain primitives from Gosling -Emacs (including the commercial UniPress versions). These have an -ml- prefix to distinguish them from native GNU Emacs functions with -similar names. The package mlconvert.el translates Mocklisp code -to use these names. -*** emulators/teco.el -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. -*** emulators/tpu-edt.el -Commentary: - -%% TPU-edt -- Emacs emulating TPU emulating EDT - -%% Introduction - - TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates - DEC TPU's EDT emulation, hence the name TPU-edt). -*** emulators/tpu-extras.el -Commentary: - - Use the functions defined here to customize TPU-edt to your tastes by - setting scroll margins and/or turning on free cursor mode. Here's an - example for your .emacs file. -*** emulators/ws-mode.el -Commentary: - -This emulates WordStar, with a major mode. - -** energize - Interface to now-defunct Lucid's C/C++ integrated -environment XEmacs (nee Lucid Emacs) saw birth explicitly to serve -Energize. - -** eos - SPARCworks - -** eterm - Full terminal emulation under Emacs -*** eterm/term.el -Commentary: - -This file defines a general command-interpreter-in-a-buffer package -(term mode). The idea is that you can build specific process-in-a-buffer -modes on top of term 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.). -*** eterm/tgud.el -Commentary: - -The ancestral gdb.el was by W. Schelter -It was later rewritten by rms. Some ideas were due to Masanobu. -Grand Unification (sdb/dbx support) by Eric S. Raymond -The overloading code was then rewritten by Barry Warsaw , -who also hacked the mode to use comint.el. Shane Hartman -added support for xdb (HPUX debugger). Rick Sladkey -wrote the GDB command completion code. Dave Love -added the IRIX kluge and re-implemented the Mips-ish variant. -Then hacked by Per Bothner to use term.el. -*** eterm/tshell.el -Commentary: - -This file defines a a shell-in-a-buffer package (shell mode) built -on top of term 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. - -** games - blackbox, mines, decipher, doctor, ... -*** games/blackbox.el -Commentary: - -The object of the game is to find four hidden balls by shooting rays -into the black box. There are four possibilities: 1) the ray will -pass thru the box undisturbed, 2) it will hit a ball and be absorbed, -3) it will be deflected and exit the box, or 4) be deflected immediately, -not even being allowed entry into the box. -*** games/conx.el -Commentary: - -conx.el: Yet Another Dissociator. - -Select a buffer with a lot of text in it. Say M-x conx-buffer -or M-x conx-region. Repeat on as many other bodies of text as -you like. - -M-x conx will use the word-frequency tree the above generated -to produce random sentences in a popped-up buffer. It will pause -at the end of each paragraph for two seconds; type ^G to stop it. -*** games/cookie1.el -Commentary: - -Support for random cookie fetches from phrase files, used for such -critical applications as emulating Zippy the Pinhead and confounding -the NSA Trunk Trawler. -*** games/decipher.el -Commentary: - -This package is designed to help you crack simple substitution -ciphers where one letter stands for another. It works for ciphers -with or without word divisions. (You must set the variable -decipher-ignore-spaces for ciphers without word divisions.) -*** games/dissociate.el -Commentary: - -The single entry point, `dissociated-press', applies a travesty -generator to the current buffer. The results can be quite amusing. -*** games/doctor.el -Commentary: - -The single entry point `doctor', simulates a Rogerian analyst using -phrase-production techniques similar to the classic ELIZA demonstration -of pseudo-AI. -*** games/flame.el -Commentary: - -"Flame" program. This has a chequered past. -*** games/gomoku.el -Gomoku is a game played between two players on a rectangular board. Each -player, in turn, marks a free square of its choice. The winner is the first -one to mark five contiguous squares in any direction (horizontally, -vertically or diagonally). - -*** games/hanoi.el -Commentary: - -Solves the Towers of Hanoi puzzle while-U-wait. - -The puzzle: Start with N rings, decreasing in sizes from bottom to -top, stacked around a post. There are two other posts. Your mission, -should you choose to accept it, is to shift the pile, stacked in its -original order, to another post. -*** games/life.el -Commentary: - -A demonstrator for John Horton Conway's "Life" cellular automaton -in Emacs Lisp. Picks a random one of a set of interesting Life -patterns and evolves it according to the familiar rules. -*** games/mine.el -Commentary: - -The object of this classical game is to locate the hidden mines. -To do this, you hit the squares on the game board that do not -contain mines, and you mark the squares that do contain mines. -*** games/mpuz.el -Commentary: - -When this package is loaded, `M-x mpuz' generates a random multiplication -puzzle. This is a multiplication example in which each digit has been -consistently replaced with some letter. Your job is to reconstruct -the original digits. Type `?' while the mode is active for detailed help. -*** games/spook.el -Commentary: - - Just before sending mail, do M-x spook. - A number of phrases will be inserted into your buffer, to help - give your message that extra bit of attractiveness for automated - keyword scanners. -*** games/studly.el -Commentary: - -Functions to studlycapsify a region, word, or buffer. Possibly the -esoteric significance of studlycapsification escapes you; that is, -you suffer from autostudlycapsifibogotification. Too bad. -*** games/yow.el -Commentary: - -Important pinheadery for GNU Emacs. - -See cookie1.el for implementation. Note --- the `n' argument of yow -from the 18.xx implementation is no longer; we only support *random* -random access now. - -** gnus - The ultimate News and Mail reader -See online manual -*** gnus/gnus-audio.el -Commentary: -This file provides access to sound effects in Gnus. -Prerelease: This file is partially stripped to support earcons.el -You can safely ignore most of it until Red Gnus. **Evil Laugh** -*** gnus/gnus-gl.el -Commentary: -*** gnus/gnus-undo.el -Commentary: - -This package allows arbitrary undoing in Gnus buffers. As all the -Gnus buffers aren't very text-oriented (what is in the buffers is -just some random representation of the actual data), normal Emacs -undoing doesn't work at all for Gnus. -*** gnus/mailheader.el -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. -*** gnus/message.el -Commentary: - -This mode provides mail-sending facilities from within Emacs. It -consists mainly of large chunks of code from the sendmail.el, -gnus-msg.el and rnewspost.el files. -*** gnus/nnheader.el -Commentary: - -These macros may look very much like the ones in GNUS 4.1. They -are, in a way, but you should note that the indices they use have -been changed from the internal GNUS format to the NOV format. The -makes it possible to read headers from XOVER much faster. - -** hm--html-menus - Menus and popups for writing/viewing html documents - -** hyperbole - Personal database - -** ilisp - A comint-based package for interacting with inferior -lisp processes. - - -** iso - Implement various ISO character standards -*** iso/iso-acc.el -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 character set. -*** iso/iso-ascii.el -Commentary: - -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. -*** iso/iso-cvt.el -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. - -** mailcrypt - Encrypting/decrypting of mail messages - -** mel - MIME encoding library (see also TM) - -** mh-e - Emacs interface to MH mail reader -*** mh-e/mh-e.el -Commentary: - -mh-e is an Emacs interface to the MH mail system. - -** modes - How to edit files: Ada, asm, awk, bib, cperl, eiffel, ... -*** modes/arc-mode.el -Commentary: - -NAMING: "arc" is short for "archive" and does not refer specifically -to files whose name end in ".arc" - -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 - - -*** modes/asm-mode.el -Commentary: - -This minor mode is based on text mode. It defines a private abbrev table -that can be used to save abbrevs for assembler mnemonics. -*** modes/auto-show.el -Commentary: - -This file provides functions that -automatically scroll the window horizontally when the point moves -off the left or right side of the window. -*** modes/awk-mode.el -Commentary: - -Sets up C-mode with support for awk-style #-comments and a lightly -hacked syntax table. -*** modes/bib-mode.el -Commentary: - - GNU Emacs code to help maintain databases compatible with (troff) - refer and lookbib. The file bib-file should be set to your - bibliography file. Keys are automagically inserted as you type, - and appropriate keys are presented for various kinds of entries. -*** modes/bibtex.el -*** modes/cc-compat.el -Commentary: - -Boring old c-mode.el (BOCM) is confusion and brain melt. cc-mode.el -is clarity of thought and purity of chi. If you are still unwilling -to accept enlightenment, this might help, or it may prolong your -agony. -*** modes/cc-guess.el -Commentary: - -This file contains routines that help guess the cc-mode style in a -particular region of C, C++, or Objective-C code. It is provided -for example and experimentation only. It is not supported in -anyway. Some folks have asked for a style guesser and the best way -to show my thoughts on the subject is with this sample code. Feel -free to improve upon it in anyway you'd like. Please send me the -results. Note that style guessing is lossy! -*** modes/cc-lobotomy.el -Commentary: - -Every effort has been made to improve the performance of -cc-mode. However, due to the nature of the C, C++, and Objective-C -language definitions, a trade-off is often required between -accuracy of construct recognition and speed. I believe it is always -best to be correct, and that the mode is currently fast enough for -most normal usage. Others disagree. I have no intention of -including these hacks in the main distribution. When cc-mode -version 5 comes out, it will include a rewritten indentation engine -so that performance will be greatly improved automatically. This -was not included in this release of version 4 so that Emacs 18 -could still be supported. Note that this implies that cc-mode -version 5 will *not* work on Emacs 18! -*** modes/cc-mode.el -Commentary: - -This package provides modes in GNU Emacs for editing C, C++, -Objective-C, and Java code. It is intended to be a replacement for -c-mode.el (a.k.a. BOCM -- Boring Old C-Mode), c++-mode.el, -cplus-md.el, and cplus-md1.el, all of which are in some way -ancestors of this file. A number of important improvements have -been made, briefly: complete K&R C, ANSI C, `ARM' C++, Objective-C, -and Java support with consistent indentation across all modes, more -intuitive indentation controlling variables, compatibility across -all known Emacsen, nice new features, and tons of bug fixes. This -package is called "CC Mode" to distinguish it from its ancestors, -but there is no cc-mode command. Usage and programming details are -contained in an accompanying texinfo manual. -*** modes/cl-indent.el -Commentary: - -This package supplies a single entry point, common-lisp-indent-function, -which performs indentation in the preferred style for Common Lisp code. -*** modes/cperl-mode.el Can't find any Commentary section -*** modes/eiffel3.el Can't find any Commentary section -*** modes/enriched.el Can't find any Commentary section -*** modes/executable.el -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. - -*** modes/f90.el -Commentary: - -Smart mode for editing F90 programs in FREE FORMAT. -Knows about continuation lines, named structured statements, and other -new features in F90 including HPF (High Performance Fortran) structures. -The basic feature is to provide an accurate indentation of F90 programs. -In addition, there are many more features like automatic matching of all -end statements, an auto-fill function to break long lines, a join-lines -function which joins continued lines etc etc. - To facilitate typing, a fairly complete list of abbreviations is provided. - For example, `i is short-hand for integer (if abbrev-mode is on). - -*** modes/follow.el -Commentary: - -`Follow mode' is a minor mode for Emacs 19 and XEmacs which -combines windows into one tall virtual window. - -The feeling of a "virtual window" has been accomplished by the use -of two major techniques: - - * The windows always displays adjacent sections of the buffer. - This means that whenever one window is moved, all the - others will follow. (Hence the name Follow Mode.) - - * Should the point (cursor) end up outside a window, another - window displaying that point is selected, if possible. This - makes it possible to walk between windows using normal cursor - movement commands. -*** modes/fortran.el -Commentary: - -Fortran mode has been upgraded and is now maintained by Stephen A. Wood -(saw@cebaf.gov). It now will use either fixed format continuation line -markers (character in 6th column), or tab format continuation line style -(digit after a TAB character.) A auto-fill mode has been added to -automatically wrap fortran lines that get too long. - -We acknowledge many contributions and valuable suggestions by -Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea, -Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon, -Gary Sabot and Richard Stallman. -*** modes/hideif.el -Commentary: - -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. -*** modes/hideshow.el -Commentary: - -This file provides `hs-minor-mode'. When active, six commands: - hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode -are available. They implement block hiding and showing. Blocks are -defined in mode-specific way. In c-mode or c++-mode, they are simply -curly braces, while in lisp-ish modes they are parens. Multi-line -comments (c-mode) can also be hidden. The command M-x hs-minor-mode -toggles the minor mode or sets it (similar to outline minor mode). -See documentation for each command for more info. -*** modes/icon.el -Commentary: - -A major mode for editing the Icon programming language. -*** modes/ksh-mode.el - - -Description: - sh, ksh, and bash script editing commands for emacs. - - 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. -*** modes/lisp-mnt.el -Commentary: - -This minor mode adds some services to Emacs-Lisp editing mode. - -First, it knows about the header conventions for library packages. -One entry point supports generating synopses from a library directory. -Another can be used to check for missing headers in library files. -*** modes/lisp-mode.el -Commentary: - -The base major mode for editing Lisp code (used also for Emacs Lisp). -This mode is documented in the Emacs manual -*** modes/m4-mode.el -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 -*** modes/mail-abbrevs.el Can't find any Commentary section -*** modes/make-mode.el -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. -*** modes/modula2.el -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. -*** modes/nroff-mode.el -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. -*** modes/old-c-mode.el -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. -*** modes/outl-mouse.el Can't find any Commentary section -*** modes/outline.el -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. -*** modes/pascal.el - -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 -*** modes/perl-mode.el -*** modes/picture.el -Commentary: - -This code provides the picture-mode commands documented in the Emacs -manual. The screen is treated as a semi-infinite quarter-plane with -support for rectangle operations and `etch-a-sketch' character -insertion in any of eight directions. -*** modes/postscript.el Can't find any Commentary section -modes/prolog.el -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. -*** modes/python-mode.el -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. -*** modes/rexx-mode.el Can't find any Commentary section -*** modes/rsz-minibuf.el -Commentary: - -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. -*** modes/scheme.el -Commentary: - -Adapted from Lisp mode by Bill Rozas, jinx@prep. -Initially a query replace of Lisp mode, except for the indentation -of special forms. Probably the code should be merged at some point -so that there is sharing between both libraries. -*** modes/scribe.el Can't find any Commentary section -*** modes/sendmail.el -Commentary: - -This mode provides mail-sending facilities from within Emacs. It is -documented in the Emacs user's manual. -*** modes/sh-script.el -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. -*** modes/simula.el -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. -*** modes/tcl.el -Commentary: - -Major mode for editing Tcl -*** modes/texinfo.el Can't find any Commentary section -*** modes/text-mode.el -Commentary: - -This package provides the fundamental text mode documented in the -Emacs user's manual. -*** modes/two-column.el Can't find any Commentary section -*** modes/verilog-mode.el -Commentary: - -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 - -*** modes/view-less.el -Commentary: - -This mode is for browsing files without changing them. Keybindings -similar to those used by the less(1) program are used. -*** modes/view.el -Commentary: - -This package provides the `view' minor mode documented in the Emacs -user's manual. - -XEmacs: We don't autoload this because we use `view-less' instead. -*** modes/vrml-mode.el -Commentary: - -Mostly bastardized from tcl.el. -*** modes/whitespace-mode.el -Commentary: - - 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-mode - or with: M-x whitespace-incremental-mode - The second one should be used in big files. -*** modes/winmgr-mode.el -Commentary: - -This package is a major mode for editing window configuration files and -also defines font-lock keywords for such files. -*** modes/xpm-mode.el Can't find any Commentary section -modes/xrdb-mode.el Can't find any Commentary section - -** mu - Message Utilities library (part of the Tools for MIME). - -** ns - NeXTstep - -** oobr - Browser for Object Oriented languages -*** oobr/br-c++-ft.el Can't find any Commentary section - -** packages - Lot's of stuff: array, baloon help, version control, ... -*** packages/add-log.el -Commentary: - -This facility is documented in the Emacs Manual. -*** packages/apropos.el -Commentary: - -The ideas for this package were derived from the C code in -src/keymap.c and elsewhere. The functions in this file should -always be byte-compiled for speed. Someone should rewrite this in -C (as part of src/keymap.c) for speed. -*** packages/array.el -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. -*** packages/auto-save.el Can't find any Commentary section -packages/autoinsert.el -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. -*** packages/avoid.el -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: -*** packages/backup-dir.el Can't find any Commentary section -*** packages/balloon-help.el Can't find any Commentary section -*** packages/big-menubar.el Can't find any Commentary section -*** packages/blink-cursor.el -*** packages/blink-paren.el Can't find any Commentary section -*** packages/bookmark.el Can't find any Commentary section -*** packages/buff-menu.el -Commentary: - -Edit, delete, or change attributes of all currently active Emacs -buffers from a list summarizing their state. A good way to browse -any special or scratch buffers you have loaded, since you can't find -them by filename. The single entry point is `Buffer-menu-mode', -normally bound to C-x C-b. -*** packages/chistory.el -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. -*** packages/cmuscheme.el -Commentary: - - This is a customisation of comint-mode (see comint.el) -*** packages/crypt.el -Commentary: - -NOTE: Apparently not being maintained by the author, who now -uses jka-compr.el. --ben (1/26/96) -Included patch (1/26/96) - -Code for handling all sorts of compressed and encrypted files.| -*** packages/cu-edit-faces.el Can't find any Commentary section -*** packages/dabbrev.el -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. -*** packages/desktop.el -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 -*** packages/fast-lock.el -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. -*** packages/font-lock.el -Font-lock-mode is a minor mode that causes your comments to be -displayed in one face, strings in another, reserved words in another, -documentation strings in another, and so on. -*** packages/func-menu.el Can't find any Commentary section -*** packages/generic-sc.el Can't find any Commentary section -*** packages/gnuserv.el Can't find any Commentary section -*** packages/gopher.el -Commentary: -OPERATING INSTRUCTIONS - -To use, `M-x gopher'. To specify a different root server, use -`C-u M-x gopher'. If you want to use bookmarks, set the variable -gopher-support-bookmarks appropriately. -*** packages/hexl.el -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'. -*** packages/hyper-apropos.el -Commentary: - - Rather than run apropos and print all the documentation at once, - I find it easier to view a "table of contents" first, then - get the details for symbols as you need them. -*** packages/icomplete.el -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. -*** packages/igrep.el Can't find any Commentary section -*** packages/info.el Can't find any Commentary section -*** packages/informat.el Can't find any Commentary section -*** packages/ispell.el -Commentary: -*** packages/jka-compr.el -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. -*** packages/lazy-lock.el -Commentary: - -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. -*** packages/ledit.el -Commentary: - -This is a major mode for editing Liszt. See etc/LEDIT for details. -*** packages/lispm-fonts.el Can't find any Commentary section -*** packages/lpr.el -Commentary: - -Commands to send the region or a buffer your printer. Entry points -are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option -variables include `lpr-switches' and `lpr-command'. -*** packages/makeinfo.el -Commentary: - -The Texinfo mode `makeinfo' related commands are: -*** packages/makesum.el -Commentary: - -Displays a nice human-readable summary of all keybindings in a -two-column format. -*** packages/man.el Can't find any Commentary section -*** packages/metamail.el -Commentary: - -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 idea of using metamail to process MIME messages is from -gnus-mime.el by Spike . -*** packages/mic-paren.el Can't find any Commentary section -*** packages/mime-compose.el Can't find any Commentary section -*** packages/mode-motion+.el Can't find any Commentary section -*** packages/netunam.el -Commentary: - -Use the Remote File Access (RFA) facility of HP-UX from Emacs. -*** packages/page-ext.el -Commentary: - -You may use these commands to handle an address list or other -small data base. -*** packages/paren.el -Commentary: - -Purpose of this package: - - This package highlights matching parens (or whole sexps) for easier - editing of source code, particularly lisp source code. -*** packages/pending-del.el Can't find any Commentary section -*** packages/ps-print.el -Commentary: - -This package provides printing of Emacs buffers on PostScript -printers; the buffer's bold and italic text attributes are -preserved in the printer output. Ps-print is intended for use with -Emacs 19 or Lucid Emacs, together with a fontifying package such as -font-lock or hilit. -*** packages/rcompile.el -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). -*** packages/recent-files.el Can't find any Commentary section -*** packages/refbib.el -Commentary: - -Use: from a buffer containing the refer-style bibliography, - M-x r2b-convert-buffer -Program will prompt for an output buffer name, and will log -warnings during the conversion process in the buffer *Log*. -*** packages/remote.el Can't find any Commentary section -*** packages/reportmail.el Can't find any Commentary section -*** packages/resume.el -Commentary: - -The purpose of this library is to handle command line arguments -when you resume an existing Emacs job. - -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. -*** packages/saveconf.el Can't find any Commentary section -*** packages/saveplace.el -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. -*** packages/sccs.el Can't find any Commentary section -*** packages/scroll-in-place.el Can't find any Commentary section -*** packages/server.el -Commentary: - -This Lisp code is run in Emacs when it is to operate as -a server for other processes. - -*** packages/shell-font.el Can't find any Commentary section -*** packages/spell.el -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. -*** packages/supercite.el Can't find any Commentary section -*** packages/tar-mode.el Can't find any Commentary section -*** packages/terminal.el Can't find any Commentary section -*** packages/tex-latin1.el Can't find any Commentary section -*** packages/texinfmt.el Can't find any Commentary section -*** packages/texnfo-tex.el Can't find any Commentary section -*** packages/texnfo-upd.el -Commentary: -*** packages/time-stamp.el -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> -*** packages/time.el -Commentary: - -Facilities to display current time/date and a new-mail indicator -in the Emacs mode line. The single entry point is `display-time'. -*** packages/uncompress.el -Commentary: - -This package can be used to arrange for automatic uncompress of -files packed with the UNIX compress(1) utility when they are visited. -All that's necessary is to load it. This can conveniently be done from -your .emacs file. -*** packages/underline.el -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. -*** packages/upd-copyr.el Can't find any Commentary section -*** packages/vc.el -Commentary: - -This mode is fully documented in the Emacs user's manual. - -Supported version-control systems presently include SCCS, RCS, and CVS. -The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2 -or newer. Currently (January 1994) that is only a beta test release. -Even initial checkins will fail if your RCS version is so old that ci -doesn't understand -t-; this has been known to happen to people running -NExTSTEP 3.0. -*** packages/webjump.el -Change Log: -*** packages/webster-ucb.el Can't find any Commentary section -*** packages/webster.el Can't find any Commentary section -*** packages/xscheme.el Can't find any Commentary section - - -** pcl-cvs - Front end to CVS (see also vc -- version control) -*** pcl-cvs/cookie.el -Commentary: - - Introduction - ============ - -Cookie is a package that implements a connection between an -dll (a doubly linked list) and the contents of a buffer. -Possible uses are dired (have all files in a list, and show them), -buffer-list, kom-prioritize (in the LysKOM elisp client) and -others. pcl-cvs.el uses cookie.el. -*** pcl-cvs/dll-debug.el -Commentary: - -This is a plug-in replacement for dll.el. It is dreadfully -slow, but it facilitates debugging. Don't trust the comments in -this file too much. -(provide 'dll) - -*** pcl-cvs/dll.el -Commentary: - -A doubly linked list consists of one cons cell which holds the tag -'DL-LIST in the car cell and a pointer to a dummy node in the cdr -cell. The doubly linked list is implemented as a circular list -with the dummy node first and last. The dummy node is recognized -by comparing it to the node which the cdr of the cons cell points -to. - -*** pcl-cvs/elib-node.el -Commentary: - -A node is implemented as an array with three elements, using -(elt node 0) as the left pointer -(elt node 1) as the right pointer -(elt node 2) as the data -*** pcl-cvs/pcl-cvs-startup.el Can't find any Commentary section -*** pcl-cvs/pcl-cvs-xemacs.el Can't find any Commentary section -*** pcl-cvs/pcl-cvs.el Can't find any Commentary section -*** pcl-cvs/string.el -Commentary: - - -This file is part of the elisp library Elib. -It implements simple generic string functions for use in other -elisp code: replace regexps in strings, split strings on regexps. - -** prim - Lots of XEmacs primitives (see Emacs-Lisp manual). -*** prim/about.el Can't find any Commentary section -*** prim/advocacy.el Can't find any Commentary section -*** prim/auto-autoloads.el Can't find any Commentary section -*** prim/backquote.el Can't find any Commentary section -*** prim/buffer.el Can't find any Commentary section -*** prim/case-table.el Can't find any Commentary section -*** prim/cleantree.el -Commentary: - -This code is derived from Gnus based on a suggestion by - David Moore -*** prim/cmdloop.el Can't find any Commentary section -*** prim/cmdloop1.el Can't find any Commentary section -*** prim/console.el Can't find any Commentary section -*** prim/custom-load.el Can't find any Commentary section -*** prim/debug.el -Commentary: - -This is a major mode documented in the Emacs manual. -*** prim/device.el Can't find any Commentary section -*** prim/dialog.el Can't find any Commentary section -*** prim/disp-table.el Can't find any Commentary section -*** prim/env.el -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. -*** prim/events.el Can't find any Commentary section -*** prim/extents.el Can't find any Commentary section -*** prim/faces.el Can't find any Commentary section -*** prim/files.el -Commentary: - -Defines most of XEmacs's file- and directory-handling functions, -including basic file visiting, backup generation, link handling, -ITS-id version control, load- and write-hook handling, and the like. -*** prim/fill.el -Commentary: - -All the commands for filling text. These are documented in the XEmacs -Reference Manual. -*** prim/float-sup.el Can't find any Commentary section -*** prim/format.el -Commentary: - -This file defines a unified mechanism for saving & loading files stored -in different formats. `format-alist' contains information that directs -Emacs to call an encoding or decoding function when reading or writing -files that match certain conditions. -*** prim/frame.el Can't find any Commentary section -*** prim/glyphs.el Can't find any Commentary section -*** prim/gui.el Can't find any Commentary section -*** prim/help.el -Commentary: - -This code implements XEmacs's on-line help system, the one invoked by -`M-x help-for-help'. -*** prim/inc-vers.el Can't find any Commentary section -*** prim/indent.el -Commentary: - -Commands for making and changing indentation in text. These are -described in the XEmacs Reference Manual. -*** prim/isearch-mode.el Can't find any Commentary section -*** prim/itimer-autosave.el -Commentary: - -itimer-driven auto-saves -*** prim/itimer.el Can't find any Commentary section -*** prim/keydefs.el Can't find any Commentary section -*** prim/keymap.el Can't find any Commentary section -*** prim/lisp.el -Commentary: - -Lisp editing commands to go with Lisp major mode. -*** prim/loaddefs.el -Commentary: - -You should never need to write autoloads by hand and put them here. - -It is no longer necessary. Instead use autoload.el to maintain them -for you. Just insert ";;;###autoload" before defuns or defmacros you -want to be autoloaded, or other forms you want copied into loaddefs.el -(defvars, key definitions, etc.). -*** prim/loadup-el.el Can't find any Commentary section -*** prim/loadup.el -Commentary: - -This is loaded into a bare Emacs to make a dumpable one. -*** prim/macros.el -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 -*** prim/menubar.el Can't find any Commentary section -*** prim/minibuf.el -Commentary: - -Written by Richard Mlynarik 2-Oct-92 -*** prim/misc.el Can't find any Commentary section -*** prim/mode-motion.el Can't find any Commentary section -*** prim/modeline.el Can't find any Commentary section -*** prim/mouse.el Can't find any Commentary section -*** prim/novice.el -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. -*** prim/objects.el Can't find any Commentary section -*** prim/obsolete.el Can't find any Commentary section -*** prim/options.el -Commentary: - -This code provides functions to list and edit the values of all global -option variables known to loaded Emacs Lisp code. There are two entry -points, `list-options' and `edit' options'. The latter enters a major -mode specifically for editing option values. Do `M-x describe-mode' in -that context for more details. -*** prim/overlay.el Can't find any Commentary section -*** prim/page.el -Commentary: - -This code provides the page-oriented movement and selection commands -documented in the XEmacs Reference Manual. -*** prim/paragraphs.el -Commentary: - -This package provides the paragraph-oriented commands documented in the -XEmacs Reference Manual. -*** prim/process.el Can't find any Commentary section -*** prim/profile.el Can't find any Commentary section -*** prim/rect.el -Commentary: - -This package provides the operations on rectangles that are ocumented -in the XEmacs Reference Manual. -*** prim/register.el -Commentary: - -This package of functions emulates and somewhat extends the venerable -TECO's `register' feature, which permits you to save various useful -pieces of buffer state to named variables. The entry points are -documented in the XEmacs Reference Manual. -*** prim/replace.el -Commentary: - -This package supplies the string and regular-expression replace functions -documented in the XEmacs Reference Manual. - -All the gettext calls are for XEmacs I18N3 message catalog support. -*** prim/reposition.el -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. -*** prim/scrollbar.el Can't find any Commentary section -*** prim/simple.el -Commentary: - -A grab-bag of basic XEmacs commands not specifically related to some -major mode or to file-handling. -*** prim/sort.el -Commentary: - -This package provides the sorting facilities documented in the XEmacs -Reference Manual. -*** prim/sound.el Can't find any Commentary section -*** prim/specifier.el Can't find any Commentary section -*** prim/startup.el Can't find any Commentary section -*** prim/subr.el -Commentary: - -There's not a whole lot in common now with the FSF version, -be wary when applying differences. I've left in a number of lines -of commentary just to give diff(1) something to synch itself with to -provide useful context diffs. -sb -*** prim/symbols.el -Commentary: - -The idea behind magic variables is that you can specify arbitrary -behavior to happen when setting or retrieving a variable's value. The -purpose of this is to make it possible to cleanly provide support for -obsolete variables (e.g. unread-command-event, which is obsolete for -unread-command-events) and variable compatibility -(e.g. suggest-key-bindings, the FSF equivalent of -teach-extended-commands-p and teach-extended-commands-timeout). -*** prim/syntax.el Can't find any Commentary section -*** prim/tabify.el -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. -*** prim/toolbar.el Can't find any Commentary section -*** prim/undo-stack.el Can't find any Commentary section -*** prim/update-elc.el Can't find any Commentary section -*** prim/userlock.el -Commentary: - -This file is autoloaded to handle certain conditions -detected by the file-locking code within XEmacs. -The two entry points are `ask-user-about-lock' and -`ask-user-about-supersession-threat'. -*** prim/window.el Can't find any Commentary section - -** psgml - SGML/HTML editing mode -*** psgml/iso-sgml.el Can't find any Commentary section -*** psgml/psgml-api.el -Commentary: - -Provides some extra functions for the API to PSGML. - -*** psgml/psgml-charent.el -Commentary: - - Functions to convert character entities into displayable characters - and displayable characters back into character entities. - -*** psgml/psgml-debug.el Can't find any Commentary section -*** psgml/psgml-dtd.el -Commentary: - -Part of major mode for editing the SGML document-markup language. - -*** psgml/psgml-edit.el -Commentary: - -Part of major mode for editing the SGML document-markup language. - -*** psgml/psgml-fs.el -Commentary: - -The function `style-format' formats the SGML-file in the current -buffer according to the style defined in the file `psgml-style.fs' -(or the file given by the variable `fs-style'). - -To try it load this file and open the test file example.sgml. Then -run the emacs command `M-x style-format'. - -The style file should contain a single Lisp list. The elements of -this list, are them self lists, describe the style for an element type. -The sublists begin with the generic identifier for the element types and -the rest of the list are characteristic/value pairs. - -E.g. ("p" block t left 4 top 2) - -Defines the style for p-elements to be blocks with left margin 4 and -at least to blank lines before the block. - -*** psgml/psgml-html.el -Commentary: - -Parts were taken from html-helper-mode and from code by Alastair Burt. - -Feb 18 1997, Heiko Muenkel: Added the hook variable html-mode-hook. -; With that you can now use the hm--html-minor-mode together -; with this mode. For that you've to add the following line -; to your ~/.emacs: -; (add-hook 'html-mode-hook 'hm--html-minor-mode) -*** psgml/psgml-info.el -Commentary: - -This file is an addon to the PSGML package. - -This file contains some commands to print out information about the -current DTD. -*** psgml/psgml-other.el -Commentary: - -Part of psgml.el. Code not compatible with XEmacs. - -*** psgml/psgml-parse.el -Commentary: - -Part of major mode for editing the SGML document-markup language. - -*** psgml/psgml-xemacs.el -Commentary: - -Part of psgml.el - -Menus for use with XEmacs - -*** psgml/psgml.el -Commentary: - -Major mode for editing the SGML document-markup language. -*** psgml/tempo.el -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. - -** rmail - Reading Mail (see also VM and GNUS) -*** rmail/rmail-kill.el -Commentary: -*** rmail/rmail-xemacs.el -Commentary: - -Right button pops up a menu of commands in Rmail and Rmail summary buffers. -Middle button selects indicated mail message in Rmail summary buffer -*** rmail/rmail.el Can't find any Commentary section -*** rmail/rmailedit.el Can't find any Commentary section -*** rmail/rmailkwd.el Can't find any Commentary section -*** rmail/rmailmsc.el Can't find any Commentary section -*** rmail/rmailout.el Can't find any Commentary section -*** rmail/rmailsort.el Can't find any Commentary section -*** rmail/rmailsum.el -Commentary: - - Provided all commands from rmail-mode in rmail-summary-mode and made key - bindings in both modes wholly compatible. -*** rmail/undigest.el -Commentary: - -See Internet RFC 934 -*** rmail/unrmail.el Can't find any Commentary section - -** sunpro - Additional code for interfacing with SunPro products. -*** sunpro/sunpro-init.el Can't find any Commentary section -*** sunpro/sunpro-keys.el Can't find any Commentary section -*** sunpro/sunpro-load.el Can't find any Commentary section -*** sunpro/sunpro-menubar.el -Commentary: - Creates the default SunPro menubars. -*** sunpro/sunpro-sparcworks.el -Commentary: - -Called from the SPARCworks Manager with the command: - - xemacs -q -l sunpro-sparcworks $SUNPRO_SWM_TT_ARGS $SUNPRO_SWM_GUI_ARGS - -** term - Terminal specific initialization: vt100, wyse, ... -*** term/AT386.el -Commentary: - -Uses the Emacs 19 terminal initialization features --- won't work with 18. -*** term/apollo.el Can't find any Commentary section -*** term/bg-mouse.el Can't find any Commentary section -*** term/bobcat.el Can't find any Commentary section -*** term/internal.el Can't find any Commentary section -*** term/keyswap.el -Commentary: - -This package is meant to be called by other terminal packages. -*** term/linux.el Can't find any Commentary section -*** term/lk201.el Can't find any Commentary section -*** term/news.el -Commentary: - -Uses the Emacs 19 terminal initialization features --- won't work with 18. -*** term/pc-win.el Can't find any Commentary section -*** term/scoansi.el Can't find any Commentary section -*** term/sun-mouse.el -Commentary: -*** term/sun.el -Commentary: - -The function key sequences for the console have been converted for -use with function-key-map, but the *tool stuff hasn't been touched. -*** term/sup-mouse.el Can't find any Commentary section -*** term/tty-init.el -Commentary: -*** term/tvi970.el -Commentary: - -Uses the Emacs 19 terminal initialization features --- won't work with 18. -*** term/vt-control.el -Commentary: - - The functions contained in this file send various VT control codes - to the terminal where emacs is running. The following functions are - available. -*** term/vt100-led.el Can't find any Commentary section -*** term/vt100.el -Commentary: - -Uses the Emacs 19 terminal initialization features --- won't work with 18. - -Handles all VT100 clones, including the Apollo terminal. Also handles -the VT200 --- its PF- and arrow- keys are different, but all those -are really set up by the terminal initialization code, which mines them -out of termcap. This package is here to define the keypad comma, dash -and period (which aren't in termcap's repertoire) and the function for -changing from 80 to 132 columns & vv. -*** term/vt102.el Can't find any Commentary section -*** term/vt125.el Can't find any Commentary section -*** term/vt200.el Can't find any Commentary section -*** term/vt201.el Can't find any Commentary section -*** term/vt220.el Can't find any Commentary section -*** term/vt240.el Can't find any Commentary section -*** term/vt300.el Can't find any Commentary section -*** term/vt320.el Can't find any Commentary section -*** term/vt400.el Can't find any Commentary section -*** term/vt420.el Can't find any Commentary section -*** term/win32-win.el -Commentary: - -win32-win.el: this file is loaded from ../lisp/startup.el when it recognizes -that win32 windows are to be used. Command line switches are parsed and those -pertaining to win32 are processed and removed from the command line. The -win32 display is opened and hooks are set for popping up the initial window. - -startup.el will then examine startup files, and eventually call the hooks -which create the first window (s). -*** term/wyse50.el -Commentary: - -The Wyse50 is ergonomically wonderful, but its escape-sequence design sucks -rocks. The left-arrow key emits a backspace (!) and the down-arrow a line -feed (!!). Thus, you have to unbind some commonly-used Emacs keys to -enable the arrows. -*** term/xterm.el Can't find any Commentary section - -** tl - Tiny Library (Part of the Tools for MIME). -*** tl/bitmap.el Can't find any Commentary section -*** tl/cless.el Can't find any Commentary section -*** tl/emu-e19.el Can't find any Commentary section -*** tl/emu-orig.el Can't find any Commentary section -*** tl/emu-xemacs.el Can't find any Commentary section -*** tl/emu.el Can't find any Commentary section -*** tl/file-detect.el Can't find any Commentary section -*** tl/filename.el Can't find any Commentary section -*** tl/mu-cite.el -Commentary: -*** tl/mu-comment.el -Commentary: - - type `C-c C-q' at the beginning of S-expression you want to - comment out. -*** tl/mu-replace.el -Commentary: -*** tl/range.el Can't find any Commentary section -*** tl/richtext.el Can't find any Commentary section -*** tl/std11-parse.el Can't find any Commentary section -*** tl/std11.el Can't find any Commentary section -*** tl/texi-util.el Can't find any Commentary section -*** tl/tinyrich.el Can't find any Commentary section -*** tl/tl-822.el Can't find any Commentary section -*** tl/tl-atype.el Can't find any Commentary section -*** tl/tl-list.el Can't find any Commentary section -*** tl/tl-misc.el Can't find any Commentary section -*** tl/tl-num.el Can't find any Commentary section -*** tl/tl-seq.el Can't find any Commentary section -*** tl/tl-str.el Can't find any Commentary section -*** tl/tu-comment.el -Commentary: -*** tl/tu-replace.el -Commentary: - -** tm - Tools for MIME -- integrates in VM, RMAIL, GNUS -*** tm/gnus-art-mime.el Can't find any Commentary section -*** tm/gnus-charset.el Can't find any Commentary section -*** tm/gnus-mime-old.el Can't find any Commentary section -*** tm/gnus-mime.el Can't find any Commentary section -*** tm/gnus-msg-mime.el Can't find any Commentary section -*** tm/gnus-sum-mime.el Can't find any Commentary section -*** tm/message-mime.el Can't find any Commentary section -*** tm/mime-setup.el Can't find any Commentary section -*** tm/sc-setup.el Can't find any Commentary section -*** tm/signature.el Can't find any Commentary section -*** tm/tm-bbdb.el Can't find any Commentary section -*** tm/tm-def.el Can't find any Commentary section -*** tm/tm-edit-mc.el Can't find any Commentary section -*** tm/tm-edit.el -Commentary: - -This is an Emacs minor mode for editing Internet multimedia -messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049). -All messages in this mode are composed in the tagged MIME format, -that are described in the following examples. The messages -composed in the tagged MIME format are automatically translated -into a MIME compliant message when exiting the mode. -*** tm/tm-ew-d.el Can't find any Commentary section -*** tm/tm-ew-e.el Can't find any Commentary section -*** tm/tm-file.el Can't find any Commentary section -*** tm/tm-ftp.el Can't find any Commentary section -*** tm/tm-gd3.el Can't find any Commentary section -*** tm/tm-gnus.el Can't find any Commentary section -*** tm/tm-gnus4.el Can't find any Commentary section -*** tm/tm-gnus5.el Can't find any Commentary section -*** tm/tm-html.el Can't find any Commentary section -*** tm/tm-image.el -Commentary: - If you use this program with MULE, please install - etl8x16-bitmap.bdf font included in tl package. -*** tm/tm-latex.el Can't find any Commentary section -*** tm/tm-mail.el Can't find any Commentary section -*** tm/tm-mh-e.el Can't find any Commentary section -*** tm/tm-orig.el Can't find any Commentary section -*** tm/tm-parse.el Can't find any Commentary section -*** tm/tm-partial.el Can't find any Commentary section -*** tm/tm-pgp.el -Commentary: - - This module is based on 2 drafts about PGP MIME integration: -*** tm/tm-play.el Can't find any Commentary section -*** tm/tm-rmail.el Can't find any Commentary section -*** tm/tm-setup.el Can't find any Commentary section -*** tm/tm-sgnus.el Can't find any Commentary section -*** tm/tm-tar.el Can't find any Commentary section -*** tm/tm-text.el Can't find any Commentary section -*** tm/tm-view.el Can't find any Commentary section -*** tm/tm-vm.el -Commentary: - - Plese insert `(require 'tm-vm)' in your ~/.vm file. -*** tm/tmh-comp.el Can't find any Commentary section - -** tooltalk - Support for Tooltalk protocol -*** tooltalk/tooltalk-init.el Can't find any Commentary section -*** tooltalk/tooltalk-load.el Can't find any Commentary section -*** tooltalk/tooltalk-macros.el Can't find any Commentary section -*** tooltalk/tooltalk-util.el Can't find any Commentary section - -** utils - Lots of stuff -*** utils/abbrevlist.el Can't find any Commentary section -*** utils/advice.el -Commentary: - -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. -*** utils/annotations.el Can't find any Commentary section -*** utils/assoc.el -Commentary: - -Association list utilities providing insertion, deletion, sorting -fetching off key-value pairs in association lists. -*** utils/atomic-extents.el Can't find any Commentary section -*** utils/autoload.el -Commentary: - -This code helps GNU Emacs maintainers keep the loaddefs.el file up to -date. It interprets magic cookies of the form ";;;###autoload" in -lisp source files in various useful ways. To learn more, read the -source; if you're going to use this, you'd better be able to. -*** utils/bench.el -Commentary: - -Adapted from Shane Holder's bench.el by steve@altair.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- -*** utils/blessmail.el -Commentary: - -This is loaded into a bare Emacs to create the blessmail script, -which (on systems that need it) is used during installation -to give appropriate permissions to movemail. - -It has to be done from lisp in order to be sure of getting the -correct value of rmail-spool-directory. -*** utils/browse-cltl2.el Can't find any Commentary section -*** utils/browse-url.el -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: - -*** utils/crontab.el Can't find any Commentary section -*** utils/delbackspace.el Can't find any Commentary section -*** utils/derived.el -Commentary: - -GNU Emacs is already, in a sense, object oriented -- each object -(buffer) belongs to a class (major mode), and that class defines -the relationship between messages (input events) and methods -(commands) by means of a keymap. - -In the mean time, this package offers most of the advantages of -full inheritance with the existing major modes. The macro -`define-derived-mode' allows the user to make a variant of an existing -major mode, with its own keymap. The new mode will inherit the key -bindings of its parent, and will, in fact, run its parent first -every time it is called. For example, the commands -*** utils/detached-minibuf.el -Commentary: - -WARNING. DANGER. This file reportedly crashes 19.14, use it only with a -recent XEmacs. - -Version: 1.1 -*** utils/docref.el -Commentary: - -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. -*** utils/easymenu.el Can't find any Commentary section -*** utils/edmacro.el -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: -*** utils/eldoc.el -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. -*** utils/elp.el -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. -*** utils/facemenu.el -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. -*** utils/find-gc.el -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. -*** utils/finder.el -Commentary: - -This mode uses the Keywords library header to provide code-finding -services by keyword. -*** utils/floating-toolbar.el -Commentary: - -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. -*** utils/flow-ctrl.el -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. - -*** utils/foldout.el -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. -*** utils/forms-d2.el Can't find any Commentary section -*** utils/forms-pass.el Can't find any Commentary section -*** utils/forms.el -Commentary: - -Visit a file using a form. - -Forms mode means visiting a data file which is supposed to consist -of records each containing a number of fields. The records are -separated by a newline, the fields are separated by a user-defined -field separator (default: TAB). -When shown, a record is transferred to an Emacs buffer and -presented using a user-defined form. One record is shown at a -time. -*** utils/frame-icon.el -Commentary: -*** utils/hide-copyleft.el Can't find any Commentary section -*** utils/highlight-headers.el Can't find any Commentary section -*** utils/id-select.el Can't find any Commentary section -*** utils/lib-complete.el Can't find any Commentary section -*** utils/live-icon.el Can't find any Commentary section -*** utils/loadhist.el -Commentary: - -These functions exploit the load-history system variable. -*** utils/mail-extr.el -Commentary: - - mail-extract-address-components: (address) - - 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. - -*** utils/mail-utils.el -Commentary: - -Utility functions for mail and netnews handling. These handle fine -points of header parsing. -*** utils/mailpost.el -Commentary: - -Yet another mail interface. this for the rmail system to provide - the missing sendmail interface on systems without /usr/lib/sendmail, - but with /usr/uci/post. -*** utils/map-ynp.el -Commentary: - -map-y-or-n-p is a general-purpose question-asking function. -It asks a series of y/n questions (a la y-or-n-p), and decides to -applies an action to each element of a list based on the answer. -The nice thing is that you also get some other possible answers -to use, reminiscent of query-replace: ! to answer y to all remaining -questions; ESC or q to answer n to all remaining questions; . to answer -y once and then n for the remainder; and you can get help with C-h. -*** utils/meese.el -Commentary: -This file is grossly misnamed. It should be called reno.el. -*** utils/passwd.el Can't find any Commentary section -*** utils/pp.el Can't find any Commentary section -*** utils/pretty-print.el Can't find any Commentary section -*** utils/redo.el -Commentary: - -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. - -*** utils/regi.el Can't find any Commentary section -*** utils/reporter.el -Commentary: -Lisp Package Authors -==================== -Reporter was written primarily for Emacs Lisp package authors so -that their users can 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 eval 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. -*** utils/rfc822.el Can't find any Commentary section -*** utils/ring.el -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. -*** utils/shadowfile.el Can't find any Commentary section -*** utils/skeleton.el -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. -*** utils/smtpmail.el -Commentary: - -Send Mail to smtp host from smtpmail temp buffer. -*** utils/soundex.el -Commentary: - -The Soundex algorithm maps English words into representations of -how they sound. Words with vaguely similar sound map to the same string. -*** utils/speedbar.el -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. -*** utils/symbol-syntax.el Can't find any Commentary section -*** utils/sysdep.el Can't find any Commentary section -*** utils/text-props.el -Commentary: - -This is a nearly complete implementation of the FSF19 text properties API. -Please let me know if you notice any differences in behavior between -this implementation and the FSF implementation. -*** utils/thing.el Can't find any Commentary section -*** utils/timezone.el Can't find any Commentary section -*** utils/tq.el -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. -*** utils/trace.el -Commentary: - -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. -*** utils/tree-menu.el Can't find any Commentary section -*** utils/uniquify.el -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. -*** utils/xbm-button.el Can't find any Commentary section -*** utils/xpm-button.el Can't find any Commentary section - -** viper - VI emulator -*** viper/viper-ex.el Can't find any Commentary section -*** viper/viper-init.el Can't find any Commentary section -*** viper/viper-keym.el Can't find any Commentary section -*** viper/viper-macs.el Can't find any Commentary section -*** viper/viper-mous.el Can't find any Commentary section -*** viper/viper-util.el Can't find any Commentary section -*** viper/viper.el Can't find any Commentary section - -** vm - Mail reader -See the online documentation. - -** vms - Stuff for Emacs under VMS -vms/vms-patch.el Can't find any Commentary section -*** vms/vmsproc.el Can't find any Commentary section -*** vms/vmsx.el Can't find any Commentary section - -** w3 - World Wide Web browser under Emacs -See the online documentation. - -** x11 - X11 specific stuff: compose keys, menubars, toolbar, ... -*** x11/x-compose.el Can't find any Commentary section -*** x11/x-faces.el Can't find any Commentary section -*** x11/x-font-menu.el -Commentary: - -Creates three menus, "Font", "Size", and "Weight", and puts them on the -"Options" menu. The contents of these menus are the superset of those -properties available on any fonts, but only the intersection of the three -sets is selectable at one time. -*** x11/x-init.el -Commentary: -*** x11/x-iso8859-1.el Can't find any Commentary section -*** x11/x-menubar.el -Commentary: -*** x11/x-misc.el Can't find any Commentary section -*** x11/x-mouse.el Can't find any Commentary section -*** x11/x-scrollbar.el Can't find any Commentary section -*** x11/x-select.el Can't find any Commentary section -*** x11/x-toolbar.el Can't find any Commentary section -*** x11/x-win-sun.el -Commentary: - -This file is loaded by x-win.el at run-time when we are sure that XEmacs -is running on the display of a Sun. - -The Sun X server (both the MIT and OpenWindows varieties) have extremely -stupid names for their keypad and function keys. For example, the key -labeled 3 / PgDn, with R15 written on the front, is actually called F35. -*** x11/x-win-xfree86.el Can't find any Commentary section - - -* What Changed -=================== - - -** Differences between XEmacs and GNU Emacs 19 -================================================== - -In XEmacs, events are first-class objects. FSF 19 represents them as -integers, which obscures the differences between a key gesture and the -ancient ASCII code used to represent a particular overlapping subset of them. - -In XEmacs, keymaps are first-class opaque objects. FSF 19 represents them as -complicated combinations of association lists and vectors. If you use the -advertised functional interface to manipulation of keymaps, the same code -will work in XEmacs, Emacs 18, and GNU Emacs 19; if your code depends -on the underlying implementation of keymaps, it will not. - -XEmacs uses "extents" to represent all non-textual aspects of buffers; -FSF 19 uses two distinct objects, "text properties" and "overlays", -which divide up the functionality between them. Extents are a -superset of the functionality of the two FSF data types. The full FSF -19 interface to text properties is supported in XEmacs (with extents -being the underlying representation). - -Extents can be made to be copied into strings, and thus restored by kill -and yank. Thus, one can specify this behavior on either "extents" or -"text properties", whereas in FSF 19 text properties always have this -behavior and overlays never do. - -Many more packages are provided standard with XEmacs than with FSF 19. - -Pixmaps of arbitrary size can be embedded in a buffer. - -Variable width fonts work. - -The height of a line is the height of the tallest font on that line, instead -of all lines having the same height. - -XEmacs uses the MIT "Xt" toolkit instead of raw Xlib calls, which -makes it be a more well-behaved X citizen (and also improves -portability). A result of this is that it is possible to include -other Xt "Widgets" in the XEmacs window. Also, XEmacs understands the -standard Xt command-line arguments. - -XEmacs provides support for ToolTalk on systems that have it. - -XEmacs can ask questions using popup dialog boxes. Any command executed from -a menu will ask yes/no questions with dialog boxes, while commands executed -via the keyboard will use the minibuffer. - -XEmacs has a built-in toolbar. Four toolbars can actually be configured: -top, bottom, left, and right toolbars. - -XEmacs has vertical and horizontal scrollbars. Unlike in FSF 19 (which -provides a primitive form of vertical scrollbar), these are true toolkit -scrollbars. A look-alike Motif scrollbar is provided for those who -don't have Motif. (Even for those who do, the look-alike may be preferable -as it is faster.) - -If you're running on a machine with audio hardware, you can specify sound -files for XEmacs to play instead of the default X beep. See the documentation -of the function load-sound-file and the variable sound-alist. - -An XEmacs frame can be placed within an "external client widget" managed by -another application. This allows an application to use an XEmacs frame as its -text pane rather than the standard Text widget that is provided with Motif or -Athena. XEmacs supports Motif applications, generic Xt (e.g. Athena) -applications, and raw Xlib applications. - -Here are some more specifics about the XEmacs implementation: - -*** The Input Model -------------------- - -The fundamental unit of input is an "event" instead of a character. An -event is a new data type that contains several pieces of information. -There are several kinds of event, and corresponding accessor and utility -functions. We tried to abstract them so that they would apply equally -well to a number of window systems. - -NOTE: All timestamps are measured as milliseconds since Emacs started. - - key_press_event - event_channel A token representing which keyboard generated it. - For this kind of event, this is a frame object. - (This is for eventual support of multiple displays.) - timestamp When it happened - key What keysym this is; an integer or a symbol. - If this is an integer, it will be in the printing - ASCII range: >32 and <127. - modifiers Bucky-bits on that key: control, meta, etc. - For most keys, Shift is not a bit; that is implicit - in the keyboard layout. - - button_press_event - button_release_event - event_channel A token representing which mouse generated it. - For this kind of event, this is a frame object. - timestamp When it happened - button What button went down or up. - modifiers Bucky-bits on that button: shift, control, meta, etc. - x, y Where it was at the button-state-change (in pixels). - - pointer_motion_event - event_channel A token representing which mouse generated it. - For this kind of event, this is a frame object. - timestamp When it happened - x, y Where it was after it moved (in pixels). - modifiers Bucky-bits down when the motion was detected. - (Possibly not all window systems will provide this?) - - process_event - timestamp When it happened - process the emacs "process" object in question - - timeout_event - timestamp Now (really, when the timeout was signaled) - interval_id The ID returned when the associated call to - add_timeout_cb() was made - ------ the rest of the fields are filled in by Emacs ----- - id_number The Emacs timeout ID for this timeout (more - than one timeout event can have the same value - here, since Emacs timeouts, as opposed to - add_timeout_cb() timeouts, can resignal - themselves) - function An elisp function to call when this timeout is - processed. - object The object passed to that function. - - eval_event - timestamp When it happened - function An elisp function to call with this event object. - object Anything. - This kind of event is used internally; sometimes the - window system interface would like to inform emacs of - some user action (such as focusing on another frame) - but needs that to happen synchronously with the other - user input, like keypresses. This is useful when - events are reported through callbacks rather - than in the standard event stream. - - misc_user_event - timestamp When it happened - function An elisp function to call with this event object. - object Anything. - This is similar to an eval_event, except that it is - generated by user actions: selections in the - menubar or scrollbar actions. It is a "command" - event, like key and mouse presses (and unlike mouse - motion, process output, and enter and leave window - hooks). In many ways, eval_events are not the same - as keypresses or misc_user_events. - - magic_event - No user-serviceable parts within. This is for things - like KeymapNotify and ExposeRegion events and so on - that emacs itself doesn't care about, but which it - must do something with for proper interaction with - the window system. - - Magic_events are handled somewhat asynchronously, just - like subprocess filters. However, occasionally a - magic_event needs to be handled synchronously; in that - case, the asynchronous handling of the magic_event will - push an eval_event back onto the queue, which will be - handled synchronously later. This is one of the - reasons why eval_events exist; I'm not entirely happy - with this aspect of this event model. - - -The function `next-event' blocks and returns one of the above-described -event objects. The function `dispatch-event' takes an event and processes -it in the appropriate way. - -For a process-event, dispatch-event calls the process's handler; for a -mouse-motion event, the mouse-motion-handler hook is called, and so on. -For magic-events, dispatch-event does window-system-dependent things, -including calling some non-window-system-dependent hooks: map-frame-hook, -unmap-frame-hook, mouse-enter-frame-hook, and mouse-leave-frame-hook. - -The function `next-command-event' calls `next-event' until it gets a key or -button from the user (that is, not a process, motion, timeout, or magic -event). If it gets an event that is not a key or button, it calls -`dispatch-event' on it immediately and reads another one. The -next-command-event function could be implemented in Emacs Lisp, though it -isn't. Generally one should call `next-command-event' instead of -`next-event'. - -read-char calls next-command-event; if it doesn't get an event that can be -converted to an ASCII character, it signals an error. Otherwise it returns -an integer. - -The variable `last-command-char' always contains an integer, or nil (if the -last read event has no ASCII equivalent, as when it is a mouse-click or a -non-ASCII character chord.) - -The new variable `last-command-event' holds an event object, that could be -a non-ASCII character, a button click, a menu selection, etc. - -The variable `unread-command-char' no longer exists, and has been replaced -by `unread-command-events'. With the new event model, it is incorrect for -code to do (setq unread-command-char (read-char)), because all user-input -can't be represented as ASCII characters. *** This is an incompatible -change. Code which sets `unread-command-char' must be updated to use the -combination of `next-command-event' and `unread-command-events' instead. - -The functions `this-command-keys' and `recent-keys' return a vector of -event objects, instead of a string of ASCII characters. *** This also -is an incompatible change. - -Almost nothing happens at interrupt level; the SIGIO handler simply sets a -flag, and later, the X event queue is scanned for KeyPress events which map -to ^G. All redisplay happens in the main thread of the process. - - -*** Keymaps ------------ - -Instead of keymaps being alists or obarrays, they are a new primary data -type. The only user access to the contents of a keymap is through the -existing keymap-manipulation functions, and a new function, map-keymap. -This means that existing code that manipulates keymaps may need to -be changed. - -One of our goals with the new input and keymap code was to make more -character combinations available for binding, besides just ASCII and -function keys. We want to be able bind different commands to Control-a -and Control-Shift-a; we also want it to be possible for the keys Control-h -and Backspace (and Control-M and Return, and Control-I and Tab, etc) to -be distinct. - -One of the most common complaints that new Emacs users have is that backspace -is help. The answer is to play around with the keyboard-translate-table, or -be lucky enough to have a system administrator who has done this for you -already; but if it were possible to bind backspace and C-h to different -things, then (under a window manager at least) both backspace and delete -would delete a character, and ^H would be help. There's no need to deal -with xmodmap, kbd-translate-table, etc. - -Here are some more examples: suppose you want to bind one function to Tab, -and another to Control-Tab. This can't be done if Tab and Control-I are the -same thing. What about control keys that have no ASCII equivalent, like -Control-< ? One might want that to be bound to set-mark-at-point-min. We -want M-C-Backspace to be kill-backward-sexp. But we want M-Backspace to be -kill-backward-word. Again, this can't be done if Backspace and C-h are -indistinguishable. - -The user represents keys as a string of ASCII characters (when possible and -convenient), or as a vector of event objects, or as a vector of "key -description lists", that looks like (control a), or (control meta delete) -or (shift f1). The order of the modifier-names is not significant, so -(meta control x) and (control meta x) are the same. - -`define-key' knows how to take any of the above representations and store them -into a keymap. When Emacs wants to return a key sequence (this-command-keys, -recent-keys, keyboard-macros, and read-key-sequence, for example) it returns -a vector of event objects. Keyboard macros can also be represented as ASCII -strings or as vectors of key description lists. - -This is an incompatible change: code which calls `this-command-keys', -`recent-keys', `read-key-sequence', or manipulates keyboard-macros probably -needs to be changed so that it no longer assumes that the returned value is a -string. - -Control-Shift-a is specified as (control A), not (control shift a), since A -is a two-case character. But for keys that don't have an upper case -version, like F1, Backspace, and Escape, you use the (shift backspace) syntax. - -See the doc string for our version of define-key, reproduced below in the -`Changed Functions' section. Note that when the KEYS argument is a string, -it has the same semantics as the v18 define-key. - - -*** Xt Integration ------------------- - -The heart of the event loop is implemented in terms of the Xt event functions -(specifically XtAppProcessEvent), and uses Xt's concept of timeouts and -file-descriptor callbacks, eliminating a large amount of system-dependent code -(Xt does it for you.) - -If Emacs is compiled with support for X, it uses the Xt event loop even when -Emacs is not running on an X display (the Xt event loop supports this). This -makes it possible to run Emacs on a dumb TTY, and later connect it to one or -more X servers. It should also be possible to later connect an existing Emacs -process to additional TTY's, although this code is still experimental. (Our -intent at this point is not to have an Emacs that is being used by multiple -people at the same time: it is to make it possible for someone to go home, log -in on a dialup line, and connect to the same Emacs process that is running -under X in their office without having to recreate their buffer state and so -on.) - -If Emacs is not compiled with support for X, then it instead uses more general -code, something like what v18 does; but this way of doing things is a lot more -modular. - -(Linking Emacs with Xt seems to only add about 300k to the executable size, -compared with an Emacs linked with Xlib only.) - - -*** Region Highlighting ------------------------ - -If the variable `zmacs-regions' is true, then the region between point and -mark will be highlighted when "active". Those commands which push a mark -(such as C-SPC, and C-x C-x) make the region become "active" and thus -highlighted. Most commands (all non-motion commands, basically) cause it to -become non-highlighted (non-"active"). Commands that operate on the region -(such as C-w, C-x C-l, etc.) only work if the region is in the highlighted -state. - -zmacs-activate-region-hook and zmacs-deactivate-region-hook are run at the -appropriate times; under X, zmacs-activate-region-hook makes the X selection -be the region between point and mark, thus doing two things at once: making -the region and the X selection be the same; and making the region highlight -in the same way as the X selection. - -If `zmacs-regions' is true, then the `mark-marker' command returns nil unless -the region is currently in the active (highlighted) state. With an argument -of t, this returns the mark (if there is one) regardless of the active-region -state. You should *generally* not use the mark unless the region is active, -if the user has expressed a preference for the active-region model. Watch -out! Moving this marker changes the mark position. If you set the marker not -to point anywhere, the buffer will have no mark. - -In this way, the primary selection is a fairly transitory entity; but -when something is copied to the kill ring, it is made the Clipboard -selection. It is also stored into CUT_BUFFER0, for compatibility with -X applications that don't understand selections (like Emacs18). - -Compatibility note: if you have code which uses (mark) or (mark-marker), -then you need to either: change those calls to (mark t) or (mark-marker t); -or simply bind `zmacs-regions' to nil around the call to mark or mark-marker. -This is probably the best solution, since it will work in Emacs 18 as well. - - -*** Menubars and Dialog Boxes ------------------------------ - -Here is an example of a menubar definition: - -(defvar default-menubar - '(("File" ["Open File..." find-file t] - ["Save Buffer" save-buffer t] - ["Save Buffer As..." write-file t] - ["Revert Buffer" revert-buffer t] - "-----" - ["Print Buffer" lpr-buffer t] - "-----" - ["Delete Frame" delete-frame t] - ["Kill Buffer..." kill-buffer t] - ["Exit Emacs" save-buffers-kill-emacs t] - ) - ("Edit" ["Undo" advertised-undo t] - ["Cut" kill-primary-selection t] - ["Copy" copy-primary-selection t] - ["Paste" yank-clipboard-selection t] - ["Clear" delete-primary-selection t] - ) - ...)) - -The first element of each menu item is the string to print on the menu. - -The second element is the callback function; if it is a symbol, it is -invoked with `call-interactively.' If it is a list, it is invoked with -`eval'. - -If the second element is a symbol, then the menu also displays the key that -is bound to that command (if any). - -The third element of the menu items determines whether the item is selectable. -It may be t, nil, or a form to evaluate. Also, a hook is run just before a -menu is exposed, which can be used to change the value of these slots. -For example, there is a hook that makes the "undo" menu item be selectable -only in the cases when `advertised-undo' would not signal an error. - -Menus may have other menus nested within them; they will cascade. - -There are utility functions for adding items to menus, deleting items, -disabling them, etc. - -The function `popup-menu' takes a menu description and pops it up. - -The function `popup-dialog-box' takes a dialog-box description and pops -it up. Dialog box descriptions look a lot like menu descriptions. - -The menubar, menu, and dialog-box code is implemented as a library, -with an interface which hides the toolkit that implements it. - - -*** Isearch Changes -------------------- - -Isearch has been reimplemented in a different way, adding some new features, -and causing a few incompatible changes. - - - the old isearch-*-char variables are no longer supported. In the old - system, one could make ^A mean "repeat the search" by doing something - like (setq search-repeat-char ?C-a). In the new system, this is - accomplished with - - (define-key isearch-mode-map "\C-a" 'isearch-repeat-forward) - - - The advantage of using the normal keymap mechanism for this is that you - can bind more than one key to an isearch command: for example, both C-a - and C-s could do the same thing inside isearch mode. You can also bind - multi-key sequences inside of isearch mode, and bind non-ASCII keys. - For example, to use the F1 key to terminate a search: - - (define-key isearch-mode-map 'f1 'isearch-exit) - - or to make ``C-c C-c'' terminate a search: - - (define-key isearch-mode-map "\C-c\C-c" 'isearch-exit) - - - If isearch is behaving case-insensitively (the default) and you type an - upper case character, then the search will become case-sensitive. This - can be disabled by setting `search-caps-disable-folding' to nil. - - - There is a history ring of the strings previously searched for; typing - M-p or M-n while searching will cycle through this ring. Typing M-TAB - will do completion across the set of items in the history ring. - - - The ESC key is no longer used to terminate an incremental search. The - RET key should be used instead. This change is necessary for it to be - possible to bind "meta" characters to isearch commands. - - -*** Startup Code Changes ------------------------- - -The initial X frame is mapped before the user's .emacs file is executed. -Without this, there is no way for the user to see any error messages -generated by their .emacs file, any windows created by the .emacs file -don't show up, and the copyleft notice isn't shown. - -The default values for load-path, exec-path, lock-directory, and -Info-directory-list are not (necessarily) built into Emacs, but are -computed at startup time. - -First, Emacs looks at the directory in which its executable file resides: - - o If that directory contains subdirectories named "lisp" and "lib-src", - then those directories are used as the lisp library and exec directory. - - o If the parent of the directory in which the emacs executable is located - contains "lisp" and "lib-src" subdirectories, then those are used. - - o If ../lib/xemacs- (starting from the directory in which the - emacs executable is located) contains a "lisp" subdirectory and either - a "lib-src" subdirectory or a subdirectory, then - those are used. - - o If the emacs executable that was run is a symbolic link, then the link - is chased, and the resultant directory is checked as above. - -(Actually, it doesn't just look for "lisp/", it looks for "lisp/prim/", -which reduces the chances of a false positive.) - -If the lisp directory contains subdirectories, they are added to the default -load-path as well. If the site-lisp directory exists and contains -subdirectories, they are then added. Subdirectories whose names begin with -a dot or a hyphen are not added to the load-path. - -These heuristics fail if the Emacs binary was copied from the main Emacs -tree to some other directory, and links for the lisp directory were not put -in. This isn't much of a restriction: either make there be subdirectories -(or symbolic links) of the directory of the emacs executable, or make the -"installed" emacs executable be a symbolic link to an executable in a more -appropriate directory structure. For example, this setup works: - - /usr/local/xemacs/xemacs* ; The executable. - /usr/local/xemacs/lisp/ ; The associated directories. - /usr/local/xemacs/etc/ ; Any of the files in this list - /usr/local/xemacs/lock/ ; could be symbolic links as well. - /usr/local/xemacs/info/ - -As does this: - - /usr/local/bin/xemacs -> ../xemacs/src/xemacs-19.14 ; A link... - /usr/local/xemacs/src/xemacs-19.14* ; The executable, - /usr/local/xemacs/lisp/ ; and the rest of - /usr/local/xemacs/etc/ ; the source tree - /usr/local/xemacs/lock/ - /usr/local/xemacs/info/ - -This configuration might be used for a multi-architecture installation; assume -that $LOCAL refers to a directory which contains only files specific to a -particular architecture (i.e., executables) and $SHARED refers to those files -which are not machine specific (i.e., lisp code and documentation.) - - $LOCAL/bin/xemacs@ -> $LOCAL/xemacs-19.14/xemacs* - $LOCAL/xemacs-19.14/lisp@ -> $SHARED/xemacs-19.14/lisp/ - $LOCAL/xemacs-19.14/etc@ -> $SHARED/xemacs-19.14/etc/ - $LOCAL/xemacs-19.14/info@ -> $SHARED/xemacs-19.14/info/ - -The following would also work, but the above is probably more attractive: - - $LOCAL/bin/xemacs* - $LOCAL/bin/lisp@ -> $SHARED/xemacs-19.14/lisp/ - $LOCAL/bin/etc@ -> $SHARED/xemacs-19.14/etc/ - $LOCAL/bin/info@ -> $SHARED/xemacs-19.14/info/ - -If Emacs can't find the requisite directories, it writes a message like this -(or some appropriate subset of it) to stderr: - - WARNING: - couldn't find an obvious default for load-path, exec-directory, and - lock-directory, and there were no defaults specified in paths.h when - Emacs was built. Perhaps some directories don't exist, or the Emacs - executable, /cadillac-th/jwz/somewhere/xemacs is in a strange place? - - Without both exec-directory and load-path, Emacs will be very broken. - Consider making a symbolic link from /cadillac-th/jwz/somewhere/etc - to wherever the appropriate Emacs etc/ directory is, and from - /cadillac-th/jwz/somewhere/lisp/ to wherever the appropriate Emacs - lisp library is. - - Without lock-directory set, file locking won't work. Consider - creating /cadillac-th/jwz/somewhere/lock as a directory or symbolic - link for use as the lock directory. - -The default installation tree is the following: - - /usr/local/bin/b2m ; - ctags ; executables that - emacsclient ; should be in - etags ; user's path - xemacs -> xemacs- ; - xemacs ; - /usr/local/lib/xemacs/site-lisp - /usr/local/lib/xemacs/lock - /usr/local/lib/xemacs-/etc ; architecture ind. files - /usr/local/lib/xemacs-/info - /usr/local/lib/xemacs-/lisp - /usr/local/lib/xemacs-/ ; binaries emacs may run - - -*** X Resources ---------------- - -(Note: This section is copied verbatim from the XEmacs Reference Manual.) - - The Emacs resources are generally set per-frame. Each Emacs frame -can have its own name or the same name as another, depending on the -name passed to the `make-frame' function. - - You can specify resources for all frames with the syntax: - - Emacs*parameter: value - -or - - Emacs*EmacsFrame.parameter:value - -You can specify resources for a particular frame with the syntax: - - Emacs*FRAME-NAME.parameter: value - - -**** Geometry Resources ------------------------ - - To make the default size of all Emacs frames be 80 columns by 55 -lines, do this: - - Emacs*EmacsFrame.geometry: 80x55 - -To set the geometry of a particular frame named `fred', do this: - - Emacs*fred.geometry: 80x55 - -Important! Do not use the following syntax: - - Emacs*geometry: 80x55 - -You should never use `*geometry' with any X application. It does not -say "make the geometry of Emacs be 80 columns by 55 lines." It really -says, "make Emacs and all subwindows thereof be 80x55 in whatever units -they care to measure in." In particular, that is both telling the -Emacs text pane to be 80x55 in characters, and telling the menubar pane -to be 80x55 pixels, which is surely not what you want. - - As a special case, this geometry specification also works (and sets -the default size of all Emacs frames to 80 columns by 55 lines): - - Emacs.geometry: 80x55 - -since that is the syntax used with most other applications (since most -other applications have only one top-level window, unlike Emacs). In -general, however, the top-level shell (the unmapped ApplicationShell -widget named `Emacs' that is the parent of the shell widgets that -actually manage the individual frames) does not have any interesting -resources on it, and you should set the resources on the frames instead. - - The `-geometry' command-line argument sets only the geometry of the -initial frame created by Emacs. - - A more complete explanation of geometry-handling is - - * The `-geometry' command-line option sets the `Emacs.geometry' - resource, that is, the geometry of the ApplicationShell. - - * For the first frame created, the size of the frame is taken from - the ApplicationShell if it is specified, otherwise from the - geometry of the frame. - - * For subsequent frames, the order is reversed: First the frame, and - then the ApplicationShell. - - * For the first frame created, the position of the frame is taken - from the ApplicationShell (`Emacs.geometry') if it is specified, - otherwise from the geometry of the frame. - - * For subsequent frames, the position is taken only from the frame, - and never from the ApplicationShell. - - This is rather complicated, but it does seem to provide the most -intuitive behavior with respect to the default sizes and positions of -frames created in various ways. - - -**** Iconic Resources ---------------------- - - Analogous to `-geometry', the `-iconic' command-line option sets the -iconic flag of the ApplicationShell (`Emacs.iconic') and always applies -to the first frame created regardless of its name. However, it is -possible to set the iconic flag on particular frames (by name) by using -the `Emacs*FRAME-NAME.iconic' resource. - - -**** Resource List ------------------- - - Emacs frames accept the following resources: - -`geometry' (class `Geometry'): string - Initial geometry for the frame. *Note Geometry Resources:: for a - complete discussion of how this works. - -`iconic' (class `Iconic'): boolean - Whether this frame should appear in the iconified state. - -`internalBorderWidth' (class `InternalBorderWidth'): int - How many blank pixels to leave between the text and the edge of the - window. - -`interline' (class `Interline'): int - How many pixels to leave between each line (may not be - implemented). - -`menubar' (class `Menubar'): boolean - Whether newly-created frames should initially have a menubar. Set - to true by default. - -`initiallyUnmapped' (class `InitiallyUnmapped'): boolean - Whether XEmacs should leave the initial frame unmapped when it - starts up. This is useful if you are starting XEmacs as a server - (e.g. in conjunction with gnuserv or the external client widget). - You can also control this with the `-unmapped' command-line option. - -`barCursor' (class `BarColor'): boolean - Whether the cursor should be displayed as a bar, or the - traditional box. - -`textPointer' (class `Cursor'): cursor-name - The cursor to use when the mouse is over text. This resource is - used to initialize the variable `x-pointer-shape'. - -`selectionPointer' (class `Cursor'): cursor-name - The cursor to use when the mouse is over a selectable text region - (an extent with the `highlight' property; for example, an Info - cross-reference). This resource is used to initialize the variable - `x-selection-pointer-shape'. - -`spacePointer' (class `Cursor'): cursor-name - The cursor to use when the mouse is over a blank space in a buffer - (that is, after the end of a line or after the end-of-file). This - resource is used to initialize the variable - `x-nontext-pointer-shape'. - -`modeLinePointer' (class `Cursor'): cursor-name - The cursor to use when the mouse is over a mode line. This - resource is used to initialize the variable `x-mode-pointer-shape'. - -`gcPointer' (class `Cursor'): cursor-name - The cursor to display when a garbage-collection is in progress. - This resource is used to initialize the variable - `x-gc-pointer-shape'. - -`scrollbarPointer' (class `Cursor'): cursor-name - The cursor to use when the mouse is over the scrollbar. This - resource is used to initialize the variable - `x-scrollbar-pointer-shape'. - -`pointerColor' (class `Foreground'): color-name -`pointerBackground' (class `Background'): color-name - The foreground and background colors of the mouse cursor. These - resources are used to initialize the variables - `x-pointer-foreground-color' and `x-pointer-background-color'. - -`scrollBarWidth' (class `ScrollBarWidth'): integer - How wide the vertical scrollbars should be, in pixels; 0 means no - vertical scrollbars. You can also use a resource specification of - the form `*scrollbar.width', or the usual toolkit scrollbar - resources: `*XmScrollBar.width' (Motif), `*XlwScrollBar.width' - (Lucid), or `*Scrollbar.thickness' (Athena). We don't recommend - that you use the toolkit resources, though, because they're - dependent on how exactly your particular build of XEmacs was - configured. - -`scrollBarHeight' (class `ScrollBarHeight'): integer - How high the horizontal scrollbars should be, in pixels; 0 means no - horizontal scrollbars. You can also use a resource specification - of the form `*scrollbar.height', or the usual toolkit scrollbar - resources: `*XmScrollBar.height' (Motif), `*XlwScrollBar.height' - (Lucid), or `*Scrollbar.thickness' (Athena). We don't recommend - that you use the toolkit resources, though, because they're - dependent on how exactly your particular build of XEmacs was - configured. - -`scrollBarPlacement' (class `ScrollBarPlacement'): string - Where the horizontal and vertical scrollbars should be positioned. - This should be one of the four strings `bottom-left', - `bottom-right', `top-left', and `top-right'. Default is - `bottom-right' for the Motif and Lucid scrollbars and - `bottom-left' for the Athena scrollbars. - -`topToolBarHeight' (class `TopToolBarHeight'): integer -`bottomToolBarHeight' (class `BottomToolBarHeight'): integer -`leftToolBarWidth' (class `LeftToolBarWidth'): integer -`rightToolBarWidth' (class `RightToolBarWidth'): integer - Height and width of the four possible toolbars. - -`topToolBarShadowColor' (class `TopToolBarShadowColor'): color-name -`bottomToolBarShadowColor' (class `BottomToolBarShadowColor'): color-name - Color of the top and bottom shadows for the toolbars. NOTE: These - resources do *not* have anything to do with the top and bottom - toolbars (i.e. the toolbars at the top and bottom of the frame)! - Rather, they affect the top and bottom shadows around the edges of - all four kinds of toolbars. - -`topToolBarShadowPixmap' (class `TopToolBarShadowPixmap'): pixmap-name -`bottomToolBarShadowPixmap' (class `BottomToolBarShadowPixmap'): pixmap-name - Pixmap of the top and bottom shadows for the toolbars. If set, - these resources override the corresponding color resources. NOTE: - These resources do *not* have anything to do with the top and - bottom toolbars (i.e. the toolbars at the top and bottom of the - frame)! Rather, they affect the top and bottom shadows around the - edges of all four kinds of toolbars. - -`toolBarShadowThickness' (class `ToolBarShadowThickness'): integer - Thickness of the shadows around the toolbars, in pixels. - -`visualBell' (class `VisualBell'): boolean - Whether XEmacs should flash the screen rather than making an - audible beep. - -`bellVolume' (class `BellVolume'): integer - Volume of the audible beep. - -`useBackingStore' (class `UseBackingStore'): boolean - Whether XEmacs should set the backing-store attribute of the X - windows it creates. This increases the memory usage of the X - server but decreases the amount of X traffic necessary to update - the screen, and is useful when the connection to the X server goes - over a low-bandwidth line such as a modem connection. - - -**** Face Resources -------------------- - - The attributes of faces are also per-frame. They can be specified as: - - Emacs.FACE_NAME.parameter: value - - (*do not* use `Emacs*FACE_NAME...') - -or - - Emacs*FRAME_NAME.FACE_NAME.parameter: value - -Faces accept the following resources: - -`attributeFont' (class `AttributeFont'): font-name - The font of this face. - -`attributeForeground' (class `AttributeForeground'): color-name -`attributeBackground' (class `AttributeBackground'): color-name - The foreground and background colors of this face. - -`attributeBackgroundPixmap' (class `AttributeBackgroundPixmap'): file-name - The name of an XBM file (or XPM file, if your version of Emacs - supports XPM), to use as a background stipple. - -`attributeUnderline' (class `AttributeUnderline'): boolean - Whether text in this face should be underlined. - - All text is displayed in some face, defaulting to the face named -`default'. To set the font of normal text, use -`Emacs*default.attributeFont'. To set it in the frame named `fred', use -`Emacs*fred.default.attributeFont'. - - These are the names of the predefined faces: - -`default' - Everything inherits from this. - -`bold' - If this is not specified in the resource database, Emacs tries to - find a bold version of the font of the default face. - -`italic' - If this is not specified in the resource database, Emacs tries to - find an italic version of the font of the default face. - -`bold-italic' - If this is not specified in the resource database, Emacs tries to - find a bold-italic version of the font of the default face. - -`modeline' - This is the face that the modeline is displayed in. If not - specified in the resource database, it is determined from the - default face by reversing the foreground and background colors. - -`highlight' - This is the face that highlighted extents (for example, Info - cross-references and possible completions, when the mouse passes - over them) are displayed in. - -`left-margin' -`right-margin' - These are the faces that the left and right annotation margins are - displayed in. - -`zmacs-region' - This is the face that mouse selections are displayed in. - -`text-cursor' - This is the face that the cursor is displayed in. - -`isearch' - This is the face that the matched text being searched for is - displayed in. - -`info-node' - This is the face of info menu items. If unspecified, it is copied - from `bold-italic'. - -`info-xref' - This is the face of info cross-references. If unspecified, it is - copied from `bold'. (Note that, when the mouse passes over a - cross-reference, the cross-reference's face is determined from a - combination of the `info-xref' and `highlight' faces.) - - Other packages might define their own faces; to see a list of all -faces, use any of the interactive face-manipulation commands such as -`set-face-font' and type `?' when you are prompted for the name of a -face. - - If the `bold', `italic', and `bold-italic' faces are not specified -in the resource database, then XEmacs attempts to derive them from the -font of the default face. It can only succeed at this if you have -specified the default font using the XLFD (X Logical Font Description) -format, which looks like - - *-courier-medium-r-*-*-*-120-*-*-*-*-*-* - -If you use any of the other, less strict font name formats, some of -which look like - - lucidasanstypewriter-12 - fixed - 9x13 - - then XEmacs won't be able to guess the names of the bold and italic -versions. All X fonts can be referred to via XLFD-style names, so you -should use those forms. See the man pages for `X(1)', `xlsfonts(1)', -and `xfontsel(1)'. - - -**** Widgets ------------- - - There are several structural widgets between the terminal EmacsFrame -widget and the top level ApplicationShell; the exact names and types of -these widgets change from release to release (for example, they changed -in 19.9, 19.10, 19.12, and 19.13) and are subject to further change in -the future, so you should avoid mentioning them in your resource database. -The above-mentioned syntaxes should be forward-compatible. As of 19.14, -the exact widget hierarchy is as follows: - - INVOCATION-NAME "shell" "container" FRAME-NAME - x-emacs-application-class "TopLevelEmacsShell" "EmacsManager" "EmacsFrame" - -(for normal frames) - -or - - INVOCATION-NAME "shell" "container" FRAME-NAME - x-emacs-application-class "TransientEmacsShell" "EmacsManager" "EmacsFrame" - -(for popup/dialog-box frames) - -where INVOCATION-NAME is the terminal component of the name of the -XEmacs executable (usually `xemacs'), and `x-emacs-application-class' -is generally `Emacs'. - - -**** Menubar Resources ----------------------- - - As the menubar is implemented as a widget which is not a part of -XEmacs proper, it does not use the face mechanism for specifying fonts -and colors: It uses whatever resources are appropriate to the type of -widget which is used to implement it. - - If Emacs was compiled to use only the Motif-lookalike menu widgets, -then one way to specify the font of the menubar would be - - Emacs*menubar*font: *-courier-medium-r-*-*-*-120-*-*-*-*-*-* - - If the Motif library is being used, then one would have to use - - Emacs*menubar*fontList: *-courier-medium-r-*-*-*-120-*-*-*-*-*-* - - because the Motif library uses the `fontList' resource name instead -of `font', which has subtly different semantics. - - The same is true of the scrollbars: They accept whichever resources -are appropriate for the toolkit in use. - - -*** Source Code Highlighting ----------------------------- - -It's possible to have your buffers "decorated" with fonts or colors -indicating syntactic structures (such as strings, comments, function names, -"reserved words", etc.). In XEmacs, the preferred way to do this is with -font-lock-mode; activate it by adding the following code to your .emacs file: - - (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) - (add-hook 'c-mode-hook 'turn-on-font-lock) - (add-hook 'c++-mode-hook 'turn-on-font-lock) - (add-hook 'dired-mode-hook 'turn-on-font-lock) - ...etc... - -To customize it, see the descriptions of the function `font-lock-mode' and -the variables `font-lock-keywords', `c-font-lock-keywords', etc. - -There exist several other source code highlighting packages, but font-lock -does one thing that most others don't do: highlights as you type new text; -and one thing that no others do: bases part of its decoration on the -syntax table of the major mode. Font-lock has C-level support to do this -efficiently, so it should also be significantly faster than the others. - -If there's something that another highlighting package does that you can't -make font-lock do, let us know. We would prefer to consolidate all of the -desired functionality into one package rather than ship several different -packages which do essentially the same thing in different ways. - - -** Differences Between XEmacs and Emacs 18 -========================================== - -Auto-configure support has been added, so it should be fairly easy to compile -XEmacs on different systems. If you have any problems or feedback about -compiling on your system, please let us know. - -We have reimplemented the basic input model in a more general way; instead of -X input being a special-case of the normal ASCII input stream, XEmacs has a -concept of "input events", and ASCII characters are a subset of that. The -events that XEmacs knows about are not X events, but are a generalization of -them, so that XEmacs can eventually be ported to different window systems. - -We have reimplemented keymaps so that sequences of events can be stored into -them instead of just ASCII codes; it is possible to, for example, bind -different commands to each of the chords Control-h, Control-H, Backspace, -Control-Backspace, and Super-Shift-Backspace. Key bindings, function key -bindings, and mouse bindings live in the same keymaps. - -Input and display of all ISO-8859-1 characters is supported. - -You can have multiple X windows ("frames" in XEmacs terminology). - -XEmacs has objects called "extents" and "faces", which are roughly -analogous to Epoch's "buttons," "zones," and "styles." An extent is a -region of text (a start position and an end position) and a face is a -collection of textual attributes like fonts and colors. Every extent -is displayed in some "face", so changing the properties of a face -immediately updates the display of all associated extents. Faces can -be frame-local: you can have a region of text which displays with -completely different attributes when its buffer is viewed from a -different X window. - -The display attributes of faces may be specified either in lisp or through -the X resource manager. - -Pixmaps of arbitrary size can be embedded in a buffer. - -Variable width fonts work. - -The height of a line is the height of the tallest font on that line, instead -of all lines having the same height. - -XEmacs uses the MIT "Xt" toolkit instead of raw Xlib calls, which -makes it be a more well-behaved X citizen (and also improves -portability). A result of this is that it is possible to include -other Xt "Widgets" in the XEmacs window. Also, XEmacs understands the -standard Xt command-line arguments. - -XEmacs understands the X11 "Selection" mechanism; it's possible to define -and customize selection converter functions and new selection types from -Emacs Lisp, without having to recompile XEmacs. - -XEmacs provides support for ToolTalk on systems that have it. - -XEmacs supports the Zmacs/Lispm style of region highlighting, where the -region between the point and mark is highlighted when in its "active" state. - -XEmacs has a menubar, whose contents are customizable from emacs-lisp. -This menubar looks Motif-ish, but does not require Motif. If you already -own Motif, however, you can configure XEmacs to use a *real* Motif menubar -instead. - -XEmacs can ask questions using popup dialog boxes. Any command executed from -a menu will ask yes/no questions with dialog boxes, while commands executed -via the keyboard will use the minibuffer. - -XEmacs has vertical and horizontal scrollbars. - -The initial load-path is computed at run-time, instead of at compile-time. -This means that if you move the XEmacs executable and associated directories -to somewhere else, you don't have to recompile anything. - -You can specify what the title of the XEmacs windows and icons should be -with the variables `frame-title-format' and `frame-icon-title-format', -which have the same syntax as `mode-line-format'. - -XEmacs now supports floating-point numbers. - -XEmacs now knows about timers directly, instead of them being simulated by -a subprocess. - -XEmacs understands truenames, and can be configured to notice when you are -visiting two names of the same file. See the variables find-file-use-truenames -and find-file-compare-truenames. - -If you're running on a machine with audio hardware, you can specify sound -files for XEmacs to play instead of the default X beep. See the documentation -of the function load-sound-file and the variable sound-alist. - -An XEmacs frame can be placed within an "external client widget" managed by -another application. This allows an application to use an XEmacs frame as its -text pane rather than the standard Text widget that is provided with Motif or -Athena. XEmacs supports Motif applications, generic Xt (e.g. Athena) -applications, and raw Xlib applications. - -Random changes to the emacs-lisp library: (some of this was not written by -us, but is included because it's free software and we think it's good stuff) - - - there is a new optimizing byte-compiler - - there is a new abbrev-based mail-alias mechanism - - the -*- line can contain local-variable settings - - there is a new TAGS package - - there is a new VI-emulation mode (viper) - - there is a new implementation of Dired - - there is a new implementation of Isearch - - the VM package for reading mail is provided - - the W3 package for browsing the World Wide Web hypertext information - system is provided - - the Hyperbole package, a programmable information management and - hypertext system - - the OO-Browser package, a multi-language object-oriented browser - -There are many more specifics in the "Miscellaneous Changes" section, below. - -The online Emacs Manual and Emacs-Lisp Manual are now both relatively -up-to-date. - -** Major Differences Between 19.13 and 19.14 -============================================ - -XEmacs has a new address! The canonical ftp site is now -ftp.xemacs.org:/pub/xemacs and the Web page is now at -http://www.xemacs.org/. All mailing lists now have @xemacs.org -addresses. For the time being the @cs.uiuc.edu addresses will -continue to function. - -This is a major new release. Many features have been added, as well -as many bugs fixed. The Motif menubar has still _NOT_ been fixed for -19.14. You should use the Lucid menubar instead. - - - -Major user-visible changes: ---------------------------- - --- Color support in TTY mode is provided. You have to have a TTY capable - of displaying them, such as color xterm or the console under Linux. - If your terminal type supports colors (e.g. `xterm-color'), XEmacs - will automatically notice this and start using color. - --- blink-cursor-mode enables a blinking text cursor. There is a - menubar option for this also. - --- auto-show-mode is turned on by default; this means that XEmacs - will automatically scroll a window horizontally as necessary to - keep point in view. - --- a file dialog box is provided and will be used whenever you - are prompted for a filename as a result of a menubar selection. - --- XEmacs can be compiled with built-in GIF, JPEG, and PNG support. - The GIF libraries are supplied with XEmacs; for JPEG and PNG, - you have to obtain the appropriate libraries (this is well- - documented). This makes image display much easier and faster under - W3 (the web browser) and TM (adds MIME support to VM and GNUS; - not yet included with XEmacs but will be in 19.15). - --- XEmacs provides a really nice mode (PSGML with "Wing improvements") - for editing HTML and other SGML documents. It parses the document, - and as a result it does proper indentation, can show you the context - you're in, the allowed tags at a particular position, etc. - --- XEmacs comes standard with modes for editing Java and VRML code, - including font-lock support. - --- GNUS 5.2 comes standard with XEmacs. - --- You can now embed colors in the modeline, with different sections - of the modeline responding appropriately to various mouse gestures: - For example, clicking on the "read-only" indicator toggles the - read-only status of a buffer, and clicking on the buffer name - cycles to the next buffer. Pressing button3 on these areas brings - up a popup menu of appropriate commands. - --- There is a much nicer mode for completion lists and such. - At the minibuffer prompt, if you hit page-up or Meta-V, the completion - buffer will be displayed (if it wasn't already), you're moved into - it, and can move around and select filenames using the arrow keys - and the return key. Rather than a cursor, a filename is highlighted, - and the arrow keys change which filename is highlighted. - --- The edit-faces subsystem has also been much improved, in somewhat - similar ways to the completion list improvements. - --- Many improvements were made to the multi-device support. - We now provide an auxiliary utility called "gnuattach" that - lets you connect to an existing XEmacs process and display - a TTY frame on the current TTY connection, and commands - `make-frame-on-display' (with a corresponding menubar entry) - and `make-frame-on-tty' for more easily creating frames on - new TTY or X connections. - --- We have incorporated nearly all of the functionality of GNU Emacs - 19.30 into XEmacs. This includes support for lazy-loaded - byte code and documentation strings, improved paragraph filling, - better support for margins within documents, v19 regular expression - routines (including caching of compiled regexps), etc. - --- In accordance with GNU Emacs 19.30, the following key binding - changes have been made: - - C-x ESC -> C-x ESC ESC - ESC ESC -> ESC : - ESC ESC ESC is "abort anything" (keyboard-escape-quit). - --- All major packages have been updated to their latest-released - versions. - --- XEmacs now gracefully handles a full colormap (such as typically - results when running Netscape). The nearest available color - is automatically substituted. - --- Many bug fixes to the subprocess/PTY code, ps-print, menubar - functions, `set-text-properties', DEC Alpha support, toolbar - resizing (the "phantom VM toolbar" bug), and lots and lots - of other things were made. - --- The ncurses library (a replacement for curses, found especially - under Linux) is supported, and will be automatically used - if it can be found. - --- You can now undo in the minibuffer. - --- Surrogate minibuffers now work. These are also sometimes referred - to as "global" minibuffers. - --- font-lock has been merged with GNU Emacs 19.30, improved defaults - have been added, and changes have been made to the way it is - configured. - --- Many, many modes have menubar entries for them. - --- `recover-session' lets you recover whatever files can be recovered - after your XEmacs process has died unexpectedly. - --- C-h k followed by a toolbar button press correctly reports - the binding of the toolbar button. - --- `function-key-map', `key-translation-map', and `keyboard-translate-table' - are now correctly implemented. - --- `show-message-log' (and its menubar entry under Edit) have been - removed; instead use `view-lossage' (and its menubar entry under - Help). - --- There is a standard menubar entry for specifying which browser - (Netscape, W3, Mosaic, etc.) to use when dispatching URL's - in mail, Usenet news, etc. - --- Improved native sound support under Linux. - --- Lots of other things we forgot to mention. - - - -Significant Lisp-level changes: -------------------------------- - --- Many improvements to the E-Lisp documentation have been made; - it should now be up-to-date and complete in nearly all cases. - --- XEmacs has extensive documentation on its internals, for - would-be C hackers. - --- Common-Lisp support (the CL package) is now dumped standard - into XEmacs. No more need for (require 'cl) or anything - like that. - --- Full support for extents and text properties over strings is - provided. - --- The extent properties `start-open', `end-open', `start-closed', - and `end-closed' now work correctly w.r.t. text properties. - --- The `face' property of extents and text properties can now - be a list. - --- The `mouse-face' property from GNU Emacs is now supported. - It supersedes the `highlight' property. - --- `enriched' and `facemenu' packages from GNU Emacs have been ported. - --- New functions for easier creation of dialog boxes: - `get-dialog-box-response', `message-box', and `message-or-box'. - --- `function-min-args' and `function-max-args' allow you to determine - the minimum and maximum allowed arguments for any type of - function (i.e. subr, lambda expression, byte-compiled function, etc.). - --- Some C-level support for doing E-Lisp profiling is provided. - See `start-profiling', `stop-profiling', and - `pretty-print-profiling-info'. - --- `current-process-time' reports the user, system, and real times - for the currently running XEmacs process. - --- `next-window', `previous-window', `next-frame', `previous-frame', - `other-window', `get-lru-window', etc. have an extra device - argument that allows you to restrict which devices it includes - (normally all devices). Some functions that incorrectly ignored - frames on different devices (e.g. C-x 0) are fixed. - --- new functions `run-hook-with-args-until-success', - `run-hook-with-args-until-failure'. - --- generalized facility for local vs. global hooks. See `make-local-hook', - `add-hook'. - --- New functions for querying the window tree: `frame-leftmost-window', - `frame-rightmost-window', `window-first-hchild', `window-first-vchild', - `window-next-child', `window-previous-child', and `window-parent'. - --- Epoch support works. This gets you direct access to some X events - and objects (e.g. properties and property-notify events). - --- The multi-device support has been majorly revamped. There is now - a new concept of "consoles" (devices grouped together under a - common keyboard/mouse), console-local variables, and a generalized - concept of device/console connection. - --- `display-buffer' synched with GNU Emacs 19.30, giving you lots of - wondrous cruft such as - -- unsplittable frames - -- pop-up-frames, pop-up-frame-function - -- special-display-buffer-names, special-display-regexps, - special-display-function - -- same-window-buffer-names, same-window-regexps - --- XEmacs has support for accessing DBM- and/or DB-format databases, - provided that you have the appropriate libraries on your system. - --- There is a new font style: "strikethru" fonts. - --- New data type "weak list", which is a list with special - garbage-collection properties, similar to weak hash tables. - --- `set-face-parent' makes one face inherit all properties from another. - --- The junky frame parameters mechanism has been revamped as - frame properties, which a standard property-list interface. - --- Lots and lots of functions for working with property lists have - been added. - --- New functions `push-window-configuration', `pop-window-configuration', - `unpop-window-configuration' for maintain a stack of window - configurations. - --- Many fixups to the glyph code; icons and mouse pointers are now - properly merged into the glyph mechanism. - --- `set-specifier' works more sensibly, like `set-face-property'. - --- Many new specifiers for individually controlling toolbar height/width - and visibility and text cursor visibility. - --- New face `text-cursor' controls the colors of the text cursor. - --- Many new variables for turning on debug information about the - inner workings of XEmacs. - --- Hash tables can now compare their keys using `equal' or `eql' - as well as `eq'. - --- Other things too numerous to mention. - - - -Significant configuration/build changes: ----------------------------------------- - --- You can disable TTY support, toolbar support, scrollbar support, - menubar support, and/or dialog box support at configure time - to save memory. - --- New configure option `--extra-verbose' shows the diagnostic - output from feature testing; this should help track down - problems with incorrect feature detection. - --- `dont-have-xmu' is now `with-xmu', with the reversed sense. - (It defaults to `yes'.) - --- `with-mocklisp' lets you add Mocklisp support if you really - need this. - --- `with-term' for adding TERM support for Linux users. - - - -** Major Differences Between 19.12 and 19.13 -============================================ - -This is primarily a bug-fix release. Lots of bugs have been fixed. -Hopefully only a few have been introduced. The most noteworthy bug -fixes are: - - -- There should be no more problems connecting XEmacs to an X - server over SLIP or other slow connections. - -- Periodic crashes when using the Buffers menu should be gone. - -- etags would sometimes erase the current buffer; it doesn't - any more. - -- XEmacs will correctly exit if the X server dies. - -- uniconified frames are displayed properly under TVTWM. - -- Breakage in `add-menu-item' / `add-menu-button' is fixed. - -The Motif menubar has _NOT_ been fixed for 19.13. You should use the -Lucid menubar instead. - -Multi-device support should now be working properly. You can now open -an X device after having started out on a TTY device. - -Background pixmaps now work. See `set-face-background-pixmap'. - -Echo area messages are now saved to a buffer, " *Message Log*". To -see this buffer, use the command `show-message-log'. It is possible -to filter the message which are actually included by modifying the -variables `log-message-ignore-regexps' and `log-message-ignore-labels'. - -You can now control which warnings you want to see. See -`display-warning-suppressed-classes' and friends. - -You can now set the default location of an "other window" from the -Options menu. - -"Save Options" now saves the state of all faces. - -You can choose which file "Save Options" writes into; see -`save-options-file'. - -XPM support is no longer required for the toolbar. - -The relocating allocator is now enabled by default whenever possible. -This allows buffer memory to be returned to the system when no longer -in use which helps keep XEmacs process size down. - -The ability to have captioned toolbars has been added. Currently only -the default toolbar actually has a captioned version provided. A new -specifier variable, `toolbar-buttons-captioned-p' controls whether the -toolbar is captioned. - -A copy of the XEmacs FAQ is now included and is available through info. - -The on-line E-Lisp reference manual has been significantly updated. - -There is now audio support under Linux. - -Modifier keys can now be sticky. This is controlled by the variable -`modifier-keys-are-sticky'. - -manual-entry should now work correctly under Irix with the penalty of -a longer startup time the first time it is invoked. If you are having -problems with this on another system try setting -`Manual-use-subdirectory-list' to t. - -make-tty-device no longer automatically creates the first frame. - -Rectangular regions now work correctly. - -ediff no longer sets synchronize-minibuffers to t unless you first set -ediff-synchronize-minibuffers - -keyboard-translate-table has been implemented. This means that the -`enable-flow-control' command for dealing with TTY connections that -filter out ^S and ^Q now works. - -You can now create frames that are initially unmapped and frames that -are "transient for another frame", meaning that they behave more like -dialog-box frames. - -Other E-Lisp changes: - --- Specifier `menubar-visible-p' for controlling menubar visibility --- Local command hooks should be set using `local-pre-command-hook' - and `local-post-command-hook' instead of making the global - equivalents be buffer-local. --- `quit-char', `help-char', `meta-prefix-char' can be any key specifier - instead of just an integer. --- new functions `add-async-timeout' and `disable-async-timeout'. - These let you create asynchronous timeouts, which are like - normal timeouts except that they're executed even during - running Lisp code. Use this with care! --- `debug-on-error' and `stack-trace-on-error' now enter the debugger - only when an *unhandled* error occurs. If you want the old - behavior, use `debug-on-signal' and `stack-trace-on-signal'. --- \U, \L, \u, \l, \E recognized specially in `replace-match'. - These are standard ex/perl commands for changing the case of - replaced text. --- New function event-matches-key-specifier-p. This provides - a clean way of comparing keypress events with key specifiers - such as 65, (shift home), etc. without having to resort - to ugly `character-to-event' / `event-to-character' hacks. --- New function `add-to-list' --- New Common-Lisp functions `some', `every', `notevery', `notany', - `adjoin', `union', `intersection', `set-difference', - `set-exclusive-or', `subsetp' --- `remove-face-property' provides a clean way of removing a - face property. - -Many of the Emacs Lisp packages have been updated. Some of the new -Emacs Lisp packages --- - -ada-mode: major mode for editing Ada source - -arc-mode: simple editing of archives - -auto-show-mode: automatically scrolls horizontally to keep point on-screen - -completion: dynamic word completion mode - -dabbrev: the dynamic abbrev package has been rewritten and is much - more powerful -- e.g. it searches in other buffers as well - as the current one - -easymenu: menu support package - -live-icon: makes frame icons represent the current frame contents - -mailcrypt 3.2: mail encryption with PGP; included but v2.4 is still - the default - -two-column: for editing two-column text - - -** Major Differences Between 19.11 and 19.12 -============================================ - -This is a huge new release. Almost every aspect of XEmacs has been changed -at least somewhat. The highlights are: - --- TTY support (includes face support) --- new redisplay engine; should be faster, less buggy, and more powerful --- terminology change from "screen" to "frame" --- built-in toolbar --- toolbar support added to many packages --- multiple device support (still in beta; improvements to come in - 19.13) --- Purify used to ensure that there are no memory leaks or memory corruption - problems --- horizontal and vertical scrollbars in all windows --- new Lucid (i.e. look-alike Motif) scrollbar widget --- stay-up menus in the Lucid (look-alike Motif) menubar widget --- 3-d modeline --- new extents engine; should be faster, less buggy, and more powerful --- much more powerful control over faces --- expanded menubar --- more work on synching with GNU Emacs 19.28 --- new packages: Hyperbole, OOBR (object browser), hm--html-menus, viper, - lazy-lock.el, ksh-mode.el, rsz-minibuf.el --- package updates for all major packages --- dynodump package for Solaris: provides proper undumping and portable - binaries across different OS versions and machine types --- Greatly expanded concept of "glyphs" (pixmaps etc. in a buffer) --- built-in support for displaying X-Faces, if the X-Face library is - available --- built-in support for SOCKS if the SOCKS library is available --- graceful behavior when the colormap is full (e.g. Netscape ate - all the colors) --- built-in MD5 (secure hashing function) support - - -More specific information: - -*** TTY Support ---------------- - -The long-awaited TTY support is now available. XEmacs will start up -in TTY mode (using the tty you started XEmacs from) if the DISPLAY -environment variable is not set or if you use the `-nw' option. - -Faces are available on TTY's. For a demonstration, try editing a C -file and turning on font-lock-mode. - -You can also connect to additional TTY's using `make-tty-device', -whether your first frame was a TTY or an X window. This ability is -not yet completely finished. - -The full event-loop capabilities (processes, timeouts, etc.) are -available on TTY's. - - - -*** New Redisplay Engine ------------------------- - -The redisplay engine has been rewritten to improve its efficiency and -to increase its functionality. It should also be significantly more -bug-free than the previous redisplay engine. - -A line that is not big enough to display at the bottom of the window -will normally be clipped (so that it is partially visible) rather than -not displayed at all. The variable `pixel-vertical-clip-threshold' -can be used to control the minimum space that must be available for a -line to be clipped rather than not displayed at all. - -Tabs are displayed in such a way that things line up fairly well even -in the presence of variable-width fonts and/or lines with -multiply-sized fonts. - -Display tables are implemented, through the specifier variable -`current-display-table'. They can be buffer-local, window-local, -frame-local, or device-local. See below for info about specifiers. - - - -*** Toolbar ------------ - -There is now built-in support for a toolbar. A sample toolbar is -visible by default at the top of the frame. Four separate toolbars -can be configured (at the top, bottom, left, and right of the frame). -The toolbar specification is similar to the menubar specification. -The up, down, and disabled glyphs of a toolbar button can be -separately controlled. Explanatory text can be echoed in the echo -area when the mouse passes over a toolbar button. The size, contents, -and visibility of the various toolbars can be controlled on a -per-buffer, per-window, per-frame, and per-device basis through the -use of specifiers. See the chapter on toolbars in the Lisp Reference -Manual (included with XEmacs) for more information. - -The toolbar color and shadow thicknesses are currently controlled only -through `modify-frame-parameters' and through X resources. We are -planning on making these controllable through specifiers as well. (Our -hope is to make `modify-frame-parameters' obsolete, as it is a clunky -and not very powerful mechanism.) - -Info, GNUS, VM, W3, and various other packages include custom toolbars -with them. - - - -*** Menubar ------------ - -Stay-up menus are implemented in the look-alike Motif menubar. - -The default menubar has been expanded to include most commonly-used -functions in XEmacs. - -The options menu has been greatly expanded to include many more -options. - -The menubar specification format has been greatly expanded. Per-menu -activation hooks can be specified through the :filter keyword (thus -obsoleting `activate-menubar-hook'); this allows for fast response -time when you have a large and complex menu. You can dynamically -control whether menu items are present through the :included and -:config keywords. (The latter keyword implements a simple menubar -configuration scheme, in conjunction with the variable -`menubar-configuration'.) Many different menu-item separators (single -or double line; solid or dashed; flat, etched-in, or etched-out) are -available. See the chapter on menus in the Lisp Reference Manual for -more information about all of this. - -New functions `add-submenu' and `add-menu-button' are available. -These supersede the older `add-menu' and `add-menu-item' functions, -and provide a more powerful and consistent interface. - -New convenience functions for popping up the part or all of the -menubar in a pop-up menu are available: `popup-menubar-menu' and -`popup-buffer-menu'. - -Menus are now incrementally constructed greatly improving menubar -response time. - - - -*** Scrollbars --------------- - -A look-alike Motif scrollbar is now included with XEmacs. No longer -will you have to suffer with ugly Athena scrollbars. - -Windows can now have horizontal scrollbars. Normally they are visible -when the window's buffer is set to truncate lines rather than wrap -them (e.g. `(setq truncate-lines t)'). - -All windows, not only the right-most ones, can have vertical -scrollbars. - -The functions to change a scrollbar's width have been superseded by -the specifier variables `scrollbar-width' and `scrollbar-height'. -This allows their values to be controlled on a buffer-local, -window-local, frame-local, and device-local basis. See below. - -The scrollbars interact better with the event loop (for example, you -can type `C-h k', do a scrollbar action, and see a description of this -scrollbar action printed as if you had pressed a key sequence or -selected a menu item). - -The scrollbar behavior can be reprogrammed, by advising the -`scrollbar-*' functions. - - - -*** Key Bindings ----------------- - -The oft-used function `goto-line' now has its own binding: M-g. - -New bindings are available for scrolling the "other" window: M-next, -M-prior, M-home, M-end. (On many keyboards, `next' and `prior' -labelled `PgUp' and `PgDn'.) - -You can reactivate a deactivated Zmacs region, without having any -other effects, with the binding M-C-z. - -The bindings `M-u', `M-l', and `M-c' now work on the region (if a -region is active) or work on a word, as before. - -Shift-Control-G forces a "critical quit", which drops immediately into -the debugger; see below. - - - -*** Modeline ------------- - -The modeline can now have a 3-d look; this is enabled by default. The -specifier variable `modeline-shadow-thickness' controls the size. - -The modeline can now be turned off on a per-buffer, per-window, -per-frame, or per-device basis. The specifier variable -`has-modeline-p' controls whether the modeline is visible. See below -for details about the vastly powerful specifier mechanism. - -The modeline functions and variables have been renamed to be -`*-modeline-*' rather than `*-mode-line-*'. Aliases are provided for -all the old names. - -Variable width fonts now work correctly when used in the modeline. - - - -*** Minibuffer, Echo Area -------------------------- - -The minibuffer is no longer constrained to be one line high. The -package rsz-minibuf.el is included to automatically resize the -minibuffer when its contents are too big; enable this with -`resize-minibuffer-mode'. - -The echo area is now a true buffer, called " *Echo Area*". This -allows you to customize the echo area behavior through -before-change-functions and after-change-functions. - - - -*** Specifiers --------------- - -XEmacs has a new concept called "specifiers", used to configure most -display options (toolbar size and contents, scrollbar size, face -properties, modeline visibility and shadow-thickness, glyphs, display -tables, etc.). We are planning on converting all display -characteristics to use specifiers, and obsoleting the clunky functions -`frame-parameters' and `modify-frame-parameters'. Specifically: - --- You can specify values (called "instantiators") for particular - "locales" (i.e. buffers, windows, frames, devices, or a global value). - When determining what the actual value (or "instance") of a specifier - is, the specifications that are provided are searched from most - specific (i.e. buffer-local) to most general (i.e. global), looking - for a matching one. - --- You can specify multiple instantiators for a particular locale. - For example, when specifying what the foreground color of a face - is in a particular buffer, you could specify two instantiators: - "dark sea green" and "green". The color would then be dark sea - green on devices that recognize that color, and green on other - devices. You have effectively provided a fallback value to make - sure you get reasonable behavior on all devices. - --- You can add one or more tags to an instantiator, where a tag - is a symbol that has been previously registered with XEmacs. - This allows you to identify your instantiators for later - removal in a way that won't interfere with other applications - using the same specifier. Furthermore, particular tags can - be restricted to match only particular sorts of devices. - Any tagged instantiator will be ignored if the device over which - it is being instanced does not match any of its tags. This - allows you, for example, to restrict an instantiator to a - particular device type (X or TTY) and/or class (color, grayscale, - or mono). (You might want to specify, for example, that a - particular face is displayed in green on color devices and is - underlined on mono devices.) - --- A full API is provided for manipulating specifiers, and full - documentation is provided in the Lisp Reference Manual. - - - -*** Basic Lisp Stuff --------------------- - -Common-Lisp backquote syntax is recognized. For example, the old -expression - -(` (a b (, c))) - -can now be written - -`(a b ,c) - -The old backquote syntax is still accepted. - -The new function `type-of' returns a symbol describing the type of a -Lisp object (`integer', `string', `symbol', etc.) - -Symbols beginning with a colon (called "keywords") are treated -specially in that they are automatically made self-evaluating when -they are interned into `obarray'. The new function `keywordp' returns -whether a symbol begins with a colon. - -`get', `put', and `remprop' have been generalized to allow you to set -and retrieve properties on many different kinds of objects: symbols, -strings, faces, glyphs, and extents (for extents, however, this is not -yet implemented). They are joined by a new function `object-props' -that returns all of the properties that have been set on an object. - -New functions `plists-eq' and `plists-equal' are provided for -comparing property lists (a property list is an alternating list -of keys and values). - -The Common-Lisp functions `caar', `cadr', `cdar', `cddr', `caaar', etc. -(up to four a's and/or d's), `first', `second', `third', etc. (up to -`tenth'), `last', `rest', and `endp' have been added, for more -convenient manipulation of lists. - -New function `mapvector' maps over a sequence and returns a vector -of the results, analogous to `mapcar'. - -New functions `rassoc', `remassoc', `remassq', `remrassoc', and -`remrassq' are provided for working with alists. - -New functions `defvaralias', `variable-alias' and `indirect-variable' -are provided for creating variable aliases. - -Strings have a modified-tick that is bumped every time a string -is modified in-place with `aset' or `fillarray'. This is retrieved -with the new function `string-modified-tick'. - -New macro `push' destructively adds an element to the beginning of a -list. New macro `pop' destructively removes and returns the first -element of a list. - - - -*** Buffers ------------ - -Most functions that operate on buffer text now take an optional BUFFER -argument, specifying which buffer they operate on. (Previously, they -always operated on the current buffer.) - -The new function `transpose-regions' is provided, ported from GNU -Emacs. - -The new function `save-current-buffer' works like `save-excursion' -but only saves the current buffer, not the location of point in -that buffer. - - - -*** Devices ------------ - -XEmacs has a new concept of "device", which is represents a particular -X display or TTY connection. `make-frame' has a new, optional device -parameter that allows you to specify which device the frame is to be -created on. - -Multiple simultaneous TTY and/or X connections may be made. The -specifier mechanism provides reasonable behavior of glyphs, faces, -etc. over heterogeneous device types and over devices whose individual -capabilities may vary. - -There is also a device type called "stream" that represents a STDIO -device that has no redisplay or cursor-motion capabilities, such as -the "glass terminal" that XEmacs uses when it is run noninteractively. -There is not all that much you can do with stream devices currently; -please let us know if there are good uses you can think of for this -capability. (For example, log files?) - -A new device API is provided. Functions are provided such as -`device-name' (the name of the device, which generally is based on the -X display or TTY file name), `device-type' (X, TTY, or stream), -`device-class' (color, grayscale, or mono), etc. See the Lisp -Reference Manual. - -Many functions have been extended to contain an additional, optional -device argument, where such an extension makes sense. In general, if -the argument is omitted, it is equivalent to specifying -`(selected-device)'. - -Many previous functions and variables are obsoleted in favor of the -device API. For example, `window-system' is obsoleted by -`device-type', and `x-color-display-p' and friends are obsoleted by -`device-class'. - -*** NOTE **: The obsolete variable `window-system' is going -to be deleted soon, probably in 19.14. Please correct all -your code to use `device-type'. - -*** INCOMPATIBLE CHANGE **: The function `x-display-visual-class' -returns different values from previous versions of XEmacs. - - - -*** Errors, Warnings, C-g -------------------------- - -There is a new warnings system implemented. Many warnings that were -formerly displayed in various ad-hoc ways (e.g. warnings about screwy -modifier mappings, messages about failures handling the mouse cursor -and errors in a gc-hook) have been regularized through this system. -The new function `warn' displays a warning before the next redisplay -(the actually display of the warning messages is accomplished through -`display-warning-buffer'). Both `warn' and `display-warning-buffer' -are Lisp functions (the C code calls out to them as necessary), and -thus you can customize the warning system. - -Under an X display, you can press Shift-Control-G to force a "critical -quit". This will immediately display a backtrace and pop you into the -debugger, regardless of the settings of `inhibit-quit' and -`debug-on-quit'. - -C-g now works properly even on systems that don't implement SIGIO or -for which SIGIO is broken (e.g. IRIX 5.3 and older versions of Linux). -In addition, the SIGIO support has been fixed for many systems on -which it didn't always work properly before (e.g. HPUX and Solaris). - - - -*** Events ----------- - -*** INCOMPATIBLE CHANGE **: Many event functions have been changed to -accept and return windows instead of frames. - -New function: `event-live-p', specifying whether `deallocate-event' -has been called on an event. - -The "menu event" type has been renamed to "misc-user event", and -encompasses scrollbar events as well as menu events. We are planning -on making it also encompass toolbar events in a future release. - -New functions are provided for determining whether an particular -sections of a frame: `event-over-border-p', `event-over-glyph-p', -`event-over-modeline-p', `event-over-text-area-p', and -`event-over-toolbar-p'. The old, kludgey methods of checking the -window-height, the internal-border-width, etc. are unreliable and -should not be used. - -New functions `event-window-x-pixel' and `event-window-y-pixel' are -provided for determining where in a particular window an event -happened. - -New functions `event-glyph-x-pixel' and `event-glyph-y-pixel' are -provided for determining where in a particular glyph an event -happened. - -New function `event-closest-point', which returns the closest buffer -position to the event even if the event did not occur over any text. - -New variable `unread-command-events', superseding the older -`unread-command-event'. - -Many event-loop bugs have been fixed. - - - -*** Extents ------------ - -The extent code has been largely rewritten. It should be faster and -more reliable. - -The text-property implementation has been greatly improved. - -Some new extent primitives are provided to return the position of the -next or previous property change in a buffer. - -Extents can now have a parent specified; then all of its properties -(except for the buffer it's in and its position in that buffer) come -from that extent. Hierarchies of such extents can be created. - -Extents now have a `detachable' property that controls what happens -(they either get detached or shrink down to zero-length) when their -text is deleted. Previously, such extents would always be detached. - -The `invisible' property on extents now works. - -`map-extents' has three additional parameters that provide more -control over which extents are mapped. - -`map-extents' deals better with changes made to extents in the -buffer being mapped over. - -A new function `mapcar-extents' (an alternative to `map-extents') has -been provided and should be easier to use than `map-extents'. - - - -*** Faces ---------- - -Faces can now be buffer-local, window-local, and device-local as well -as frame-local, and can be further restricted to a particular device -type or class. The way in which faces can be controlled is now based -on the general and powerful specifier mechanism; see above. - -The new function `set-face-property' generalizes `set-face-font', -`set-face-foreground', etc. and takes many new optional arguments, in -accordance with the new specifier mechanism. - -The new functions `face-property' and `face-property-instance' -generalize `face-font', `face-foreground', etc. and take many new -optional arguments, in accordance with the new specifier mechanism. -(`face-property' returns the value, if any, that was specified for a -particular locale, and `face-property-instance' returns the actual -value that will be used for display. See the section on specifiers.) - -The functions `face-font', `face-foreground', `face-background', -`set-face-font', `set-face-foreground', `set-face-background', -etc. are now convenience functions, trivially implemented using -`face-property' and `set-face-property' and take new optioanl -arguments in accordance with those functions. New convenience -functions `face-font-instance', `face-foreground-instance', -`face-background-instance', etc. are provided and are trivially -implemented using `face-property-instance'. - -Inheritance of face properties can now be specified. Each individual -face property can inherit differently from other properties, or not -inherit at all. - -You can set user-defined properties on faces using -`set-face-property'. - -You can create "temporary" faces, which are faces that disappear -when they are no longer in use. This is as opposed to normal -faces, which stay around forever. - -The function `make-face' takes a new optional argument specifying -whether a face should be permanent or temporary, and returns the -actual face object rather than the face symbol, as in previous -versions of XEmacs. - -The function `face-list' takes a new optional argument specifying -whether permanent, temporary, or both kinds of faces should be -returned. - -Faces have new TTY-specific properties: `highlight', `reverse', -`alternate', `blinking', and `dim'. - -Redisplay is smarter about dealing with face changes: changes to a -particular face no longer cause all frames to be cleared and -redisplayed. - -The Edit-Faces package is provided for interactively changing faces. -A menu item on the options menu is provided for this. - -New functions are provided for retrieving the ascent, descent, height, -and width of a character in a particular face. - - - -*** Fonts, Colors ------------------ - -*** INCOMPATIBLE CHANGE **: The old "font" and "pixel" objects are gone. -In place are new objects "font specifier", "font instance", "color -specifier", and "color instance". Functions `font-name', `pixel-name' -(an obsolete alias for `color-name'), etc. are now convenience -functions for working with font and color specifiers. Old code that -is not too sophisticated about working with font and pixel objects may -still work, though. (For example, the idiom `(font-name (face-font -'default))' still works.) - -You can now extract the RGB components of a color-instance object -(similar to the old pixel object) with the function -`color-instance-rgb-components'. There is also a convenience function -`color-rgb-components' for working with color specifiers. - -If there are no more colors available in the colormap, the nearest -existing color will be used when allocating a new color. - - - -*** Frames ----------- - -What used to be called "screens" are now called "frames", for clarity -and consistency with GNU Emacs. Aliases are provided for all the old -screen functions and variables, to avoid introducing a huge E-Lisp -incompatibility. - -The frame code has been merged with GNU Emacs 19.28, providing -improved functionality for many functions. - - - -*** Glyphs, Images, and Pixmaps -------------------------------- - -Glyphs (used in various places, i.e. as begin-glyphs and end-glyphs -attached to extents and appearing in a buffer or in marginal -annotations; as the truncator and continuor glyphs marking line wrap -or truncation; as an overlay at the beginning of a line; as the -displayable element in a toolbar button; etc.) can now be -buffer-local, window-local, frame-local, and device-local, and can be -further restricted to a particular device type or class. The way in -which faces can be controlled is now based on the general and powerful -specifier mechanism; see above. - -*** INCOMPATIBLE CHANGE **: The glyph and pixmap API has been completely -overhauled. A new Lisp object "glyph" is provided and should be used -where the old "pixmap" object would have been used. The pixmap object -exists no longer. There are also new Lisp objects "image specifier" -and "image instance" (an image-instance is the closest equivalent to -what a pixmap object was). More work on glyphs and images is slated -for 19.13. The glyph and image docs in the Lisp Reference Manual are -incomplete and will be finished in 19.13. - -The new function `set-glyph-property' allows setting of all the -glyph properties (`baseline', `contrib-p', etc.). Convenience -functions for particular properties are also provided, just like -for faces. - -You can set user-defined properties on glyphs using the new function -`set-glyph-property'. - -When displaying pixmaps, existing, closest-matching colors will be -used if the colormap is full. - -If the compface library is compiled into XEmacs, there is built-in -support for displaying X-Face bitmaps. (These are typically small -pictures of people's faces, included in a mail message through the -X-Face: header.) VM and highlight-headers will automatically use the -built-in X-Face support if it is available. - -Annotations in the right margin (as well as the left margin) are now -implemented. The left and right margin width functions have been -superseded by the specifier variables `left-margin-width' and -`right-margin-width', allowing much more flexible control through the -specifier mechanism. - -*** INCOMPATIBLE CHANGE **: The variable `use-left-overflow', -for controlling annotations in the left margin, is now a specifier -variable instead of a buffer-local variable. (There is also a new -variable `use-right-overflow', that is complementary.) - - - -*** Hashing ------------ - -Two new types of weak hashtables can be created: key-weak and -value-weak. In a key-weak hashtable, an entry remains around -if its key is referenced elsewhere, regardless of whether this -is also the case for the value. Value-weak hashtables are -complementary. (This is as opposed to the traditional weak -hashtables, where an entry remains around only if both the -key and value are referenced elsewhere.) New functions -`make-key-weak-hashtable' and `make-value-weak-hashtable' -are provided for creating these hashtables. - -The new function `md5' is provided for performing an MD5 -hash of an object. MD5 is a secure message digest algorithm -developed by RSA, inc. - - - -*** Keymaps ------------ - -The GNU Emacs concept of `function-key-map' is now partially -implemented. This allows conversion of function-key escape sequences -such as `ESC [ 1 1 ~' into an equivalent human-readable keysym such as -`F1'. This work will be completed in 19.14. The function-key map is -device-local and controllable through the functions -`device-function-key-map' and `set-device-function-key-map'. - -`where-is-internal' now correctly searches minor-mode keymaps, -extent-local keymaps, etc. As a side effect of this, menu items will -now correctly show the keyboard equivalent for commands that are -available through a minor-mode keymap, extent-local keymap, etc. - -*** INCOMPATIBLE CHANGE **: The modifier key "Symbol" has -been renamed to "Alt", for compatibility with the rest of the world. -Keep in mind that on many keyboards, the key labelled "Alt" actually -generates the "Meta" modifier. (On Sun keyboards, however, the key -labelled "Alt" does indeed generate the "Alt" modifier, and the key -labelled with a diamond generates the "Meta" modifier.) - - - -*** Mouse, Active Region ------------------------- - -The mouse internals in mouse.el have been rewritten. Hooks have been -provided for easier customization of mouse behavior. For example, you -can now easily specify an action to be invoked on single-click -(i.e. down-up without appreciable motion), double-click, drag-up, etc. - -Some code from GNU Emacs has been ported over, generalizing some of -the X-specific mouse stuff. - -*** INCOMPATIBLE CHANGE **: The function `set-mouse-position' accepts -a window instead of a frame. - -New function `mouse-position' that obsoletes and is more powerful than -`read-mouse-position'. - -New functions `mouse-pixel-positon' and `set-mouse-pixel-position' for -working with pixels instead of characters. - -The active (Zmacs) region is now highlighted using the `zmacs-region-face' -instead of the `primary-selection-face'; this generalizes what used -to be X-specific. - -New functions `region-active-p', `region-exists-p', and `activate-region' -provide a uniform API for dealing with the region irrespective of -whether the variable `zmacs-regions' is set. - -XEmacs is now a better X citizen with respect to the primary selection: -it does not stomp on the primary selection quite so much. This makes -things more manageable if you set `zmacs-regions' to nil. - - - -*** Processes -------------- - -Various process race conditions and bugs have been fixed. Problems -with process termination not getting noticed until much later (if at -all) should be gone now, as well as problems with zombie processes -under some systems. - -SOCKS support is now included. SOCKS is a package that allows hosts -behind a firewall to gain full access to the Internet without -requiring direct IP reachability. - - - -*** Windows ------------ - -Windows 95 is still not out yet. - -*** INCOMPATIBLE CHANGE **: The functions `locate-window-from-coordinates' -and `window-edges' have been eliminated. It no longer makes sense to -work with windows in terms of character positions, because windows can -(and often do) have many differently-sized fonts in them, because the -3-D modeline is not exactly one line high, etc. - -The new functions `window-pixel-edges', `window-highest-p', -`window-lowest-p', `frame-highest-window', and `frame-lowest-window' -are provided as substitutes for the above-mentioned, deleted -functions. - -The function `window-end' now takes an optional GUARANTEE argument -that will ensure that the value is actually correct as of the next -redisplay. - -The window code has been merged with GNU Emacs 19.28, providing -improved functionality for many functions. - - - -*** System-Specific Information -------------------------------- - -Georg Nikodym's dynodump package is provided, for proper unexec()ing -on Solaris systems. Executables built on Solaris 2.3 can now run on -Solaris 2.4 without crashing; similarly with executables built on one -type of Sun machine and run on another. - -AIX 4.x is supported. - -The NeXTstep operating system is supported in TTY mode (this is still -in beta). There are plans to port XEmacs to the NeXTstep window -system, but it may be awhile before this is complete. - -Problems with the `round' function causing arithmetic errors on HPUX 9 -have been fixed. - -You can now build XEmacs as an ELF executable on Linux systems that -support ELF. - -Various other new system configurations are supported. - - - - -** Major Differences Between 19.10 and 19.11 -============================================ - -The name has changed from "Lucid Emacs" to "XEmacs". Along with this is a -new canonical ftp site: cs.uiuc.edu:/pub/xemacs. - -XEmacs now has its very own World Wide Web page! It contains a -complete list of the FTP distribution sites, the most recent FAQ, -pointers to Emacs Lisp packages not included with the distribution, and -other useful stuff. Check it out at http://xemacs.cs.uiuc.edu/. - -A preliminary New Users Guide. - -cc-mode.el now provides the default C, C++ and Objective-C modes. - -The primary goal of this release is stability. Very few new features have -been introduced but lots of bugs have been fixed. Many of the Emacs Lisp -packages have been updated. - -Some of the new Emacs Lisp packages --- - -tcl-mode.el: major mode for editing TCL code - -fast-lock.el: saves and restores font-lock highlighting, greatly - reducing the time necessary for loading a font-lock'ed - file - -ps-print.el: prints buffers to Postscript printers preserving the - buffer's bold and italic text attributes - -toolbar.el: provides a "fake" toolbar for use with XEmacs (an - integrated one will be included with 19.12) - - -** Major Differences Between 19.9 and 19.10 -=========================================== - -The GNU `configure' system is now used to build lemacs. - -The Emacs Manual and Emacs Lisp Reference Manual now document version 19.10. -If you notice any errors, please let us know. - -When pixmaps are displayed in a buffer, they contribute to the line height - -that is, if the glyph is taller than the rest of the text on the line, the -line will be as tall as necessary to display the glyph. - -In addition to using arbitrary sound files as emacs beeps, one can control -the pitch and duration of the standard X beep, on X servers which allow that -(Note: most don't.) - -There is support for playing sounds on systems with NetAudio servers. - -Minor modes may have mode-specific key bindings; keymaps may have an arbitrary -number of parent maps. - -Menus can have toggle and radio buttons in them. - -There is a font selection menu. - -Some default key bindings have changed to match FSF19; the new bindings are - - Screen-related commands: - C-x 5 2 make-screen - C-x 5 0 delete-screen - C-x 5 b switch-to-buffer-other-screen - C-x 5 f find-file-other-screen - C-x 5 C-f find-file-other-screen - C-x 5 m mail-other-screen - C-x 5 o other-screen - C-x 5 r find-file-read-only-other-screen - Abbrev-related commands: - C-x a l add-mode-abbrev - C-x a C-a add-mode-abbrev - C-x a g add-global-abbrev - C-x a + add-mode-abbrev - C-x a i g inverse-add-global-abbrev - C-x a i l inverse-add-mode-abbrev - C-x a - inverse-add-global-abbrev - C-x a e expand-abbrev - C-x a ' expand-abbrev - Register-related commands: - C-x r C-SPC point-to-register - C-x r SPC point-to-register - C-x r j jump-to-register - C-x r s copy-to-register - C-x r x copy-to-register - C-x r i insert-register - C-x r g insert-register - C-x r r copy-rectangle-to-register - C-x r c clear-rectangle - C-x r k kill-rectangle - C-x r y yank-rectangle - C-x r o open-rectangle - C-x r t string-rectangle - C-x r w window-configuration-to-register - Narrowing-related commands: - C-x n n narrow-to-region - C-x n w widen - Other changes: - C-x 3 split-window-horizontally (was undefined) - C-x - shrink-window-if-larger-than-buffer - C-x + balance-windows - -The variable allow-deletion-of-last-visible-screen has been removed, since -it was widely hated. You can now always delete the last visible screen if -there are other iconified screens in existence. - -ToolTalk support is provided. - -An Emacs screen can be placed within an "external client widget" managed -by another application. This allows an application to use an Emacs screen -as its text pane rather than the standard Text widget that is provided -with Motif or Athena. - -Additional compatibility with Epoch is provided (though this is not yet -complete.) - - -** Major Differences Between 19.8 and 19.9 -========================================== - -Scrollbars! If you have Motif, these are real Motif scrollbars; otherwise, -Athena scrollbars are used. They obey all the usual resources of their -respective toolkits. - -There is now an implementation of dialog boxes based on the Athena -widgets, as well as the existing Motif implementation. - -This release works with Motif 1.2 as well as 1.1. If you link with Motif, -you do not also need to link with Athena. - -If you compile lwlib with both USE_MOTIF and USE_LUCID defined (which is the -recommended configuration) then the Lucid menus will draw text using the Motif -string-drawing library, instead of the Xlib one. The reason for this is that -one can take advantage of the XmString facilities for including non-Latin1 -characters in resource specifications. However, this is a user-visible change -in that, in this configuration, the menubar will use the "*fontList" resource -in preference to the "*font" resource, if it is set. - -It's possible to make extents which are copied/pasted by kill and undo. -There is an implementation of FSF19-style text properties based on this. - -There is a new variable, minibuffer-max-depth, which is intended to circumvent -a common source of confusion among new Emacs users. Since, under a window -system, it's easy to jump out of the minibuffer (by doing M-x, then getting -distracted, and clicking elsewhere) many, many novice users have had the -problem of having multiple minibuffers build up, even to the point of -exhausting the lisp stack. So the default behavior is to disallow the -minibuffer to ever be reinvoked while active; if you attempt to do so, you -will be prompted about it. - -There is a new variable, teach-extended-commands-p, which if set, will cause -`M-x' to remind you of any key bindings of the command you just invoked the -"long way." - -There are menus in Dired, Tar, Comint, Compile, and Grep modes. - -There is a menu of window management commands on the right mouse button over -the modelines. - -Popup menus now have titles at the top; this is controlled by the new -variable `popup-menu-titles'. - -The `Find' key on Sun keyboards will search for the next (or previous) -occurrence of the selected text, as in OpenWindows programs. - -The `timer' package has been renamed to `itimer' to avoid a conflict with -a different package called `timer'. - -VM 5.40 is included. - -W3, the emacs interface to the World Wide Web, is included. - -Felix Lee's GNUS speedups have been installed, including his new version of -nntp.el which makes GNUS efficiently utilize the NNTP XOVER command if -available (which is much faster.) - -GNUS should also be much friendlier to new users: it starts up much faster, -and doesn't (necessarily) subscribe you to every single newsgroup. - -The byte-compiler issues a new class of warnings: variables which are -bound but not used. This is merely an advisory, and does not mean the -code is incorrect; you can disable these warnings in the usual way with -the `byte-compiler-options' macro. - -the `start-open' and `end-open' extent properties, for specifying whether -characters inserted exactly at a boundary of an extent should go into the -extent or out of it, now work correctly. - -The `extent-data' slot has been generalized/replaced with a property list, -so it's easier to attach arbitrary data to extent objects. - -The `event-modifiers' and `event-modifier-bits' functions work on motion -events as well as other mouse and keyboard events. - -Forms-mode uses fonts and read-only regions. - -The behavior of the -geometry command line option should be correct now. - -The `iconic' screen parameter works when passed to x-create-screen. - -The user's manual now documents Lucid Emacs 19.9. - -The relocating buffer allocator is turned on by default; this means that when -buffers are killed, their storage will be returned to the operating system, -and the size of the emacs process will shrink. - -CAVEAT: code which contains calls to certain `face' accessor functions will -need to be recompiled by version 19.9 before it will work. The functions -whose callers must be recompiled are: face-font, face-foreground, -face-background, face-background-pixmap, and face-underline-p. The symptom -of this problem is the error "Wrong type argument, arrayp, #". -The .elc files generated by version 19.9 will work in 19.6 and 19.8, but -older .elc files which contain calls to these functions will not work in 19.9. - -Work In Progress: - - - We have been in the process of internationalizing Lucid Emacs. This code is - ***not*** ready for general use yet. However, the code is included (and - turned off by default) in this release. - - - If you define I18N2 at compile-time, then sorting/collation will be done - according to the locale returned by setlocale(). - - - If you define I18N3 at compile-time, then all messages printed by lemacs - will be filtered through the gettext() library routine, to enable the use - of locale-specific translation catalogues. The current implementation of - this is quite dependent on Solaris 2, and has a very large impact on - existing code, therefore we are going to be making major changes soon. - (You'll notice calls to `gettext' and `GETTEXT' scattered around much of - the lisp and C code; ignore it, this will be going away.) - - - If you define I18N4 at compile-time, then lemacs will internally use a - wide representation of characters, enabling the use of large character - sets such as Kanji. This code is very OS dependent: it requires X11R5, - and several OS-supplied library routines for reading and writing wide - characters (getwc(), putwc(), and a few others.) Performance is also a - problem. This code is also scheduled for a major overhaul, with the - intent of improving performance and portability. - - Our eventual goal is to merge with MULE, or at least provide the same base - level of functionality. If you would like to help out with this, let us - know. - - - Other work-in-progress includes Motif drag-and-drop support, ToolTalk - support, and support for embedding an Emacs widget inside another - application (where it can function as that other application's text-entry - area). This code has not been extensively tested, and may (or may not) - have portability problems, but it's there for the adventurous. Comments, - suggestions, bug reports, and especially fixes are welcome. But have no - expectations that this experimental code will work at all. - - -** Major Differences Between 19.6 and 19.8 -========================================== - -There were almost no differences between versions 19.6 and 19.7; version 19.7 -was a bug-fix release that was distributed with Energize 2.1. - -Lucid Emacs 19.8 represents the first stage of the Lucid Emacs/Epoch merger. -The redisplay engine now in lemacs is an improved descendant of the Epoch -redisplay. As a result, many bugs have been eliminated, and several disabled -features have been re-enabled. Notably: - -Selective display (and outline-mode) work. - -Horizontally split windows work. - -The height of a line is the height of the tallest font displayed on that line; -it is possible for a screen to display lines of differing heights. (Previously, -the height of all lines was the height of the tallest font loaded.) - -There is lisp code to scale fonts up and down, for example, to load the next- -taller version of a font. - -There is a new internal representation for lisp objects, giving emacs-lisp 28 -bit integers and a 28 bit address space, up from the previous maximum of 26. -We expect eventually to increase this to 30 bit integers and a 32 bit address -space, eliminating the need for DATA_SEG_BITS on some architectures. (On 64 -bit machines, add 32 to all of these numbers.) - -GC performance is improved. - -Various X objects (fonts, colors, cursors, pixmaps) are accessible as first- -class lisp objects, with finalization. - -An alternate interface to embedding images in the text is provided, called -"annotations." You may create an "annotation margin" which is whitespace at -the left side of the screen that contains only annotations, not buffer text. - -When using XPM files, one can specify the values of logical color names to be -used when loading the files. - -It is possible to resize windows by dragging their modelines up and down. More -generally, it is possible to add bindings for mouse gestures on the modelines. - -There is support for playing sound files on HP machines. - -ILISP version 5.5 is included. - -The Common Lisp #' read syntax is supported (#' is to "function" as ' is to -"quote".) - -The `active-p' slot of menu items is now evaluated, so one can put arbitrary -lisp code in a menu to decide whether that item should be selectable, rather -than doing this with an `activate-menubar-hook'. - -The X resource hierarchy has changed slightly, to be more consistent. It used -to be - argv[0] SCREEN-NAME pane screen - ApplicationShell EmacsShell Paned EmacsFrame - - now it is - - argv[0] shell pane SCREEN-NAME - ApplicationShell EmacsShell Paned EmacsFrame - -The Lucid Emacs sources have been largely merged with FSF version 19; this -means that the lisp library contains the most recent releases of various -packages, and many new features of FSF 19 have been incorporated. - -Because of this, the lemacs sources should also be substantially more portable. - - -** Major Differences Between 19.4 and 19.6 -========================================== - -There were almost no differences between versions 19.4 and 19.5; we fixed -a few minor bugs and repacked 19.4 as 19.5 for a CD-ROM that we gave away -as a trade show promotion. - -The primary goal of the 19.6 release is stability, rather than improved -functionality, so there aren't many user-visible changes. The most notable -changes are: - - - The -geometry command-line option now correctly overrides geometry - specifications in the resource database. - - The `width' and `height' screen-parameters work. - - Font-lock-mode considers the comment start and end characters to be - a part of the comment. - - The lhilit package has been removed. Use font-lock-mode instead. - - vm-isearch has been fixed to work with isearch-mode. - - new versions of ispell and calendar. - - sccs.el has menus. - -Lots of bugs were fixed, including the problem that lemacs occasionally -grabbed the keyboard focus. - -Also, as of Lucid Emacs 19.6 and Energize 2.0 (shipping now) it is possible -to compile the public release of Lucid Emacs with support for Energize; so -now Energize users will be able to build their own Energize-aware versions -of lemacs, and will be able to use newer versions of lemacs as they are -released to the net. (Of course, this is not behavior covered by your -Energize support contract; you do it at your own risk.) - -I have not incorporated all portability patches that I have been sent since -19.4; I will try to get to them soon. However, if you need to make any -changes to lemacs to get it to compile on your system, it would be quite -helpful if you would send me context diffs (diff -c) against version 19.6. - - -** Major Differences Between 19.3 and 19.4 -========================================== - -Prototypes have been added for all functions. Emacs compiles in the strict -ANSI modes of lcc and gcc, so portability should be vastly improved. - -Many many many many core leaks have been plugged, especially in screen -creation and deletion. - -The float support reworked to be more portable and ANSI conformant. This -resulted in these new configuration parameters: HAVE_INVERSE_HYPERBOLIC, -HAVE_CBRT, HAVE_RINT, FLOAT_CHECK_ERRNO, FLOAT_CATCH_SIGILL, -FLOAT_CHECK_DOMAIN. Let us know if you had to change the defaults on your -architecture. - -The SunOS unexec has been rewritten, and now works with either static or -dynamic libraries, depending on whether -Bstatic or -Bdynamic were specified -at link-time. - -Small (character-sized) bitmaps can be mixed in with buffer text via the new -functions set-extent-begin-glyph and set-extent-end-glyph. (This is actually -a piece of functionality that Energize has been using for a while, but we've -just gotten around to making it possible to use it without Energize. See how -nice we are? Go buy our product.) - -If compiled with Motif support, one can pop up dialog boxes from emacs lisp. -We encourage someone to contribute Athena an version of this code; it -shouldn't be much work. - -If dialog boxes are available, then y-or-n-p and yes-or-no-p use dialog boxes -instead of the minibuffer if invoked as a result of a command that was -executed from a menu instead of from the keyboard. - -Multiple screen support works better; check out doc of get-screen-for-buffer. - -The default binding of backspace is the same as delete. (C-h is still help.) - -A middle click while the minibuffer is active does completion if you click on -a highlighted completion, otherwise it executes the global binding of button2. - -New versions of Barry Warsaw's c++-mode and syntax.c. Font-lock-mode works -with C++ mode now. - -The semantics of activate-menubar-hook has changed; the functions are called -with no arguments now. - -`truename' no longer hacks the automounter; use directory-abbrev-alist instead. - -Most minibuffer handling has been reimplemented in emacs-lisp. - -There is now a builtin minibuffer history mechanism which replaces gmhist. - - -** Major Differences Between 19.2 and 19.3 -========================================== - -The ISO characters have correct case and syntax tables now, so the word-motion -and case-converting commands work sensibly on them. - -If you set ctl-arrow to an integer, you can control exactly which characters -are printable. (There will be a less crufty way to do this eventually.) - -Menubars can now be buffer local; the function set-screen-menubar no longer -exists. Look at GNUS and VM for examples of how to do this, or read -menubar.el. - -When emacs is reading from the minibuffer with completions, any completions -which are visible on the screen will highlight when the mouse moves over them; -clicking middle on a completion is the same as typing it at the minibuffer. -Some implications of this: The *Completions* buffer is always mousable. If -you're using the completion feature of find-tag, your source code will be -mousable when you type M-. Dired buffers will be mousable as soon as you -type ^X^F. And so on. - -The old isearch code has been replaced with a descendant of Dan LaLiberte's -excellent isearch-mode; it is more customizable, and generally less bogus. -You can search for "composed" characters. There are new commands, too; see -the doc for ^S, or the NEWS file. - -A patched GNUS 3.14 is included. - -The user's manual now documents Lucid Emacs 19.3. - -A few more modes have mouse and menu support. - -The startup code should be a little more robust, and give you more reasonable -error messages when things aren't installed quite right (instead of the -ubiquitous "cannot open DISPLAY"...) - -Subdirectories of the lisp directory whose names begin with a hyphen or dot -are not automatically added to the load-path, so you can use this to avoid -accidentally inflicting experimental software on your users. - -I've tried to incorporate all of the portability patches that were sent to -me; I tried to solve some of the problems in different ways than the -patches did, so let me know if I missed something. - -Some systems will need to define NEED_STRDUP, NEED_REALPATH, HAVE_DREM, or -HAVE_REMAINDER in config.h. Really this should be done in the appropriate -s- or m- files, but I don't know which systems need these and which don't. -If yours does, let me know which file it should be in. - -Check out these new packages: - -blink-paren.el: causes the matching parenthesis to flash on and off whenever - the cursor is sitting on a paren-syntax character. - -pending-del.el: Certain commands implicitly delete the highlighted region: - Typing a character when there is a highlighted region replaces - that region with the typed character. - -font-lock.el: A code-highlighting package, driven off of syntax tables, so - that it understands block comments, strings, etc. The - insertion hook is used to fontify text as you type it in. - -shell-font.el: Displays your shell-buffer prompt in boldface. - diff --git a/etc/PACKAGES b/etc/PACKAGES deleted file mode 100644 index 138ea65..0000000 --- a/etc/PACKAGES +++ /dev/null @@ -1,321 +0,0 @@ -* Description of available packages by category -=============================================== - -This data is up-to-date as of 10 February 1999. - -** Library Packages (libs) -========================== - -These packages are required to build and support most of the rest of -XEmacs. By design, xemacs-base is a `regular' package. Use restraint -when adding new files there as it is required by almost everything. - -*** Sun - -Support for Sparcworks. - -*** apel - -A Portable Emacs Library. Used by XEmacs MIME support. - -*** edebug - -A Lisp debugger. - -*** dired - -The DIRectory EDitor is for manipulating, and running commands on -files in a directory. - -*** efs - -Treat files on remote systems the same as local files. - -*** mail-lib - -Fundamental lisp files for providing email support. - -*** tooltalk - -Support for building with Tooltalk. - -*** xemacs-base - -Fundamental XEmacs support. Install this unless you wish a totally -naked XEmacs. - -*** xemacs-devel - -XEmacs Lisp developer support. This package contains utilities for -supporting Lisp development. It is a single-file package so it may be -tailored. - -** Communications Packages (comm) -================================= - -These packages provide support for various communications, primarily -email and usenet. - -*** footnote - -Footnoting in mail message editing modes. - -*** gnats - -XEmacs bug reports. - -*** gnus - -The Gnus Newsreader and Mailreader. - -*** mailcrypt - -Support for messaging encryption with PGP. - -*** mh-e - -Front end support for MH. - -*** net-utils - -Miscellaneous Networking Utilities. This is a single-file package and -files may be deleted at will. - -*** ph - -Emacs implementation of the ph client to CCSO/qi directory servers. - -*** rmail - -An obsolete Emacs mailer. If you do not already use it don't start. - -*** supercite - -An Emacs citation tool. Useful with all Emacs Mailers and Newsreaders. - -*** tm - -Emacs MIME support. - -*** vm - -An Emacs mailer. - -*** w3 - -A Web browser. - -** Games and Amusements (games) -=============================== - -*** cookie - -Spook and Yow (Zippy quotes). - -*** games - -Tetris, Sokoban, and Snake. - -*** mine - -Minehunt. - -*** misc-games - -Other amusements and diversions. - -** Mule Support (mule) -====================== - -*** egg-its - -Wnn (4.2 and 6) support. SJ3 support. Must be installed prior to -XEmacs build. - -*** leim - -Quail. Used for everything other than English and Japanese. - -*** locale - -Used for localized menubars (French and Japanese) and localized splash -screens (Japanese). - -*** mule-base - -Basic Mule support. Must be installed prior to building with Mule. - -*** skk - -Another Japanese Language Input Method. Can be used without a -separate process running as a dictionary server. - -** Productivity Packages (oa) -============================= - -*** calendar - -Calendar and diary support. - -*** edit-utils - -Single file lisp packages for various XEmacs goodies. Load this and -weed out the junk you don't want. - -*** forms - -Forms editing support (obsolete, use the builtin Widget instead). - -*** frame-icon - -Provide a WM icon based on major mode. - -*** hm--html-menus - -HTML editing. - -*** ispell - -Spell-checking with ispell. - -*** pc - -PC style interface emulation. - -*** psgml - -Validated HTML/SGML editing. - -*** sgml - -SGML/Linuxdoc-SGML editing. - -*** slider - -User interface tool. - -*** speedbar - -??? Document me. - -*** strokes - -Mouse enhancement utility. - -*** text-modes - -Various single file lisp packages for editing text files. - -*** time - -Display time & date on the modeline. - -** Operating System Utilities (os) -================================== - -*** eterm - -Terminal emulator. - -*** igrep - -Enhanced front-end for Grep. - -*** ilisp - -Front-end for Inferior Lisp. - -*** os-utils - -Miscellaneous single-file O/S utilities. - -*** view-process - -A Unix process browsing tool. - -** Program Editing Support (prog) -================================= - -*** ada - -Ada language support. - -*** c-support - -Basic single-file add-ons for editing C code. - -*** cc-mode - -C, C++ and Java language support. - -*** debug - -GUD, gdb, dbx debugging support. - -*** ediff - -Interface over patch. - -*** emerge - -Another interface over patch. - -*** pcl-cvs - -CVS frontend. - -*** prog-modes - -Miscellaneous single-file lisp files for various programming languages. - -*** scheme - -Front-end support for Inferior Scheme. - -*** sh-script - -Support for editing shell scripts. - -*** vc - -Version Control for Free systems. - -*** vc-cc - -Version Control for ClearCase. This package must be installed prior -to building XEmacs [broken as of XEmacs 20.5-beta19]. - -*** vhdl - -Support for VHDL. - -** Word Processing (wp) -======================= - -*** auctex - -Basic TeX/LaTeX support. - -*** crisp - -Crisp/Brief emulation. - -*** edt - -DEC EDIT/EDT emulation. - -*** texinfo - -XEmacs TeXinfo support. - -*** textools - -Single-file TeX support. - -*** tpu - -DEC EDIT/TPU support. - -*** viper - -VI emulation support. diff --git a/etc/README b/etc/README deleted file mode 100644 index 49c2065..0000000 --- a/etc/README +++ /dev/null @@ -1,80 +0,0 @@ - -This directory contains some text files of documentation for XEmacs or -of interest to XEmacs users, some programs used by or with XEmacs, and -the file of on-line documentation for XEmacs. - -BETA Information about Beta versions -CHARSETS Character set descriptions -CODING-STANDARDS XEmacs C & Lisp coding standards -CODINGS Character set codings -COOKIES Urban Legend, or True Story? :-) -COPYING GNU Public License -COPYING.LIB Library GNU Public License -DEBUG Hints on how to debug XEmacs -DISTRIB How to obtain copies of XEmacs and Emacs -Emacs.ad Sample Resource file -FTP XEmacs FTP Mirrors -GNU GNU Manifesto -GOATS Complete XEmacs internals documentation -InstallGuide Fast track to installation -LPF Information about the League for Programming Freedom -MACHINES List of known machines configurations (OLD) -MAILINGLISTS List of available Mailing lists -MORE.STUFF List of useful unbundled packages -NEWS XEmacs 21.2 release information -ORDERS -ORDERS.EUROPE -ORDERS.JAPAN Order forms for GNU software -PACKAGES List of packages available for 21.2 release -README This file -README.HYPERBOLE -README.OO-BROWSER How to obtain Hyperbole and the OO-Browser -SERVICE How to obtain paid support for free software -TERMS Information about termcap entries -TUTORIAL Tutorial for first time users (English version) -TUTORIAL.* Tutorials in non-English languages -XKeysymDB X Keysym Database with Motif bindings -aliases.sh Useful shell aliases -cbx.png "Created by XEmacs" logo -check_cygwin_setup.sh Script to check for presence of Cygwin -ctags.1 Ctags man page -custom/ Images used in Custom mode -editclient.sh Either start up XEmacs or connect to a running one -emacskeys.sco -emacsstrs.sco Special files for running on an SCO console -eos/ Images for EOS support (GUD) -etags.1 Etags man page -gnu.xbm -gnu.xpm Image of a Gnu. -gnuattach.1 Gnuattach man page -gnuclient.1 Gnuclient man page -gnudoit.1 Gnudoit man page -gnuserv.1 Gnuserv man page -gnuserv.README Original README file from gnuserv -gnusref.tex Gnus reference card -gray1.xbm Gray bitmap -ms-kermit -ms-kermit-7bit Files for running XEmacs through kermit -photos/*.Z Various pictures of XEmacs developers -recycle.xpm -recycle2.xpm Two versions of oversized Recycle cursor -refcard.ps.gz Postscript version of XEmacs reference card -refcard.tex XEmacs reference card -sample.Xdefaults Example ~/.Xdefaults file -sample.emacs Example ~/.emacs file -sink.xbm A Gnu icon -sparcworks/ Support files for Sparcworks -tests/ Testcases for external widget -time/ Image files for display-time -toolbar/ Image files for the toolbar -trash.xpm Garbage can icon -xemacs-beta.xpm XEmacs Beta logo -xemacs-fe.sh XEmacs frontend driver -xemacs-icon.xpm -xemacs-icon2.xbm -xemacs-icon2.xpm -xemacs-icon3.xpm Various versions of an XEmacs WM icon -xemacs-ja.1 Japanese XEmacs man page -xemacs.1 XEmacs man page -xemacs.xbm -xemacs.xpm XEmacs logo used on the splash screen diff --git a/etc/README.HYPERBOLE b/etc/README.HYPERBOLE deleted file mode 100644 index b1e8e63..0000000 --- a/etc/README.HYPERBOLE +++ /dev/null @@ -1,6 +0,0 @@ -Hyperbole is a suite of tools for enhancing productivity. - -The latest working version of this package with major enhancements -is available together with professional support exclusively from their -developer, Altrasoft Inc. See http://www.altrasoft.com for product -and service details. diff --git a/etc/README.OO-BROWSER b/etc/README.OO-BROWSER deleted file mode 100644 index f572fab..0000000 --- a/etc/README.OO-BROWSER +++ /dev/null @@ -1,6 +0,0 @@ -The OO-Browser is a tool for examining object oriented code. - -The latest working version of this package with major enhancements -is available together with professional support exclusively from their -developer, Altrasoft Inc. See http://www.altrasoft.com for product -and service details. diff --git a/etc/SERVICE b/etc/SERVICE deleted file mode 100644 index 9219b24..0000000 --- a/etc/SERVICE +++ /dev/null @@ -1,935 +0,0 @@ - -*- text -*- -GNU Service Directory ---------------------- - -This is a list of people who have asked to be listed as offering -support services for GNU software, including GNU Emacs, for a fee -or in some cases at no charge. - -The information comes from the people who asked to be listed; -we do not include any information we know to be false, but we -cannot check out any of the information; we are transmitting it to -you as it was given to us and do not promise it is correct. -Also, this is not an endorsement of the people listed here. -We have no opinions and usually no information about the abilities of -any specific person. We provide this list to enable you to contact -service providers and decide for yourself whether to hire one. - -Before FSF will list your name in the GNU Service Directory, we ask -that you agree informally to the following terms: - -1. You will not restrict (except by copyleft) the use or distribution -of any software, documentation, or other information you supply anyone -in the course of modifying, extending, or supporting GNU software. -This includes any information specifically designed to ameliorate the -use of GNU software. - -2. You will not take advantage of contact made through the Service -Directory to advertise an unrelated business (e.g., sales of -non-GNU-related proprietary information). You may spontaneously -mention your availability for general consulting, but you should not -promote a specific unrelated business unless the client asks. - -Please include some indication of your rates, because otherwise users -have nothing to go by. Please put each e-mail address inside "<>". -Please put nothing else inside "<>". Thanks! - -For a current copy of this directory, or to have yourself listed, ask: - gnu@prep.ai.mit.edu - -** Please keep the entries in this file alphabetical ** - - -Altrasoft -4880 Stevens Creek Blvd., Suite 205 -San Jose, CA 95129-1034 -+1 408 243 3300 -http://www.altrasoft.com - -Altrasoft provides corporate-quality support, development and user -documentation for GNU Emacs, XEmacs and InfoDock. (InfoDock is a turnkey -information management and software development toolset built atop emacs, -written by one of our associates.) Emacs distributions for a variety of -platforms are also available, as is support for other emacs variants, such as -those often found on PCs. - -Our unique focus on emacs-related work allows us to attract expert talent in -this area to keep you on the leading edge of productivity, especially if you -do software development work. We do the porting, patching, coding, -integrating, debugging, documenting and testing so that your people spend -much more productive time on their mainline tasks. - -Standard support packages include help on all aspects of the packages -supported, including all tools shipped as a standard part of the original -package distribution. In general, we want to give you an unbelievably strong -level of support, so where we can, we will also answer questions concerning -any add-on Lisp code that is used at your site. Setup and customization -help, bug fixes, and announcements of new releases are, of course, included. - -Support rates start at $1,000 USD, for single user support for one year. -Discounts are available for group contracts. We also offer Golden Support -contracts for those who need the absolute best in mission-critical support; -contact us for details. Hourly development rates and fixed bid work are -available. - -Updated 20-March-1997. - -Joseph Arceneaux -PO Box 460633 http://www.samsara.com/~jla -San Francisco, CA 94146-0633 -+1 415 648 9988 -+1 415 285 9088 - -Recently led the project making Wells Fargo Bank the first to provide -secure customer account access over the Internet. - -Former FSF staffmember. Performed X11 implementation of Emacs version -19, designed and implemented WYSIWYG Emacs. Installed and -administered FSF network. Maintainer of GNU indent. Over 15 years -experience with Unix and other systems, from writing ROM monitors to -UI design and system administration. - -I provide installation, porting, debugging and customization or -development of GNU and other Unix software. I also design and -implement free software projects and consult on software engineering -and systems design. Handholding and teaching services are also -available as well as things like LAN and compute--infrastructure design. - -Time and material rates around $150 USD per hour, depending upon the -particular job. I am also very interested in fixed-bid jobs. For -selected non-profit organizations with worthy goals, I work for free. - -Updated: 17Oct95 - -Gerd Aschemann -Osannstr. 49 -D-64285 Darmstadt -Tel.: +49 6151 16 2259 -http://www.informatik.th-darmstadt.de/~ascheman/ - -- System Administrator (UNIX) at CS Department, TU Darmstadt, Germany -- 15 years expirience with CS, Systemadministration on different platforms -- 8 years with UNIX/Networking/FreeWare/GNU/X11 -- 6 years organizer of Operating Systems and Distributed Systems courses -- Lectures on System and Network Administration -- Platforms: Solaris, SunOS, Ultrix, OSF1, HP-UX, Linux, FreeBSD, AIX -- Experience with parallel environments (Connection Machine, Meiko, Parsytec) -- Consultant for other UNIX users at TU Darmstadt - -Rates are at 100,-- DM (~60 US$) per hour minimum, depending on the job. -I am willing to travel for sufficiently large jobs. - -Updated: 17Oct95 - -Giuseppe Attardi -Dipartimento di Informatica -Corso Italia 40 -I-56125 Pisa, Italy -+39 50 887-244 - -GNU: help on obtaininig GNU, for italian sites. - -Updated: 5Apr94 - -James Craig Burley -97 Arrowhead Circle -Ashland, MA 01721-1987 -508 881-6087, -4745 -(Please call only between 0900-1700 Eastern time, and only if you -are prepared to hire me -- ask me to help you for free only -via email, to which I might or might not respond.) -Email: --preferred-- - - - -Expertise: - Compiler Internals (author of GNU Fortran, for example) - Operating Systems Internals - Tools/Utilities Development and Maintenance - Microcode Development and Maintenance (primarily VLIW machines) - System Design (computers, operating systems, toolsets, &c) - Debugging (often asked to help debug Other People's Code) - Documentation (authored many books and ran a few doc projects) - Extensive experience with a variety of operating systems, hardware, - languages, and so on - -Rate: $70/hour -- willing to consider flat-fee arrangements - -Updated: 14Aug95 - -Michael I. Bushnell -545 Technology Square, NE43-426 -Cambridge, MA 02139 -(617) 253-8568 - -All GNU software: Installation, customization, answering simple or - complex questions, bug fixing, extension. - -Experience: I have done Unix and GNU programming for several years, - I am the primary author of the Hurd (which provides most - kernel related facilities for the GNU OS). - -I am easily available in the Cambridge/Boston area; work via email. -I am willing to travel for sufficiently large jobs. - -Rates: $100/hr, negotiable, less for non-profit organizaions. - -Updated: 5Apr94 - -C2V Renaud Dumeur -82 bd Haussmann Michel Delval -75009 Paris Jean-Alain Le Borgne -France -Tel (1) 40.08.07.07 -Fax (1) 43.87.35.99 - -We offer source or source+binary distribution, installation, training, -maintenance, technical support, consulting, specific development and -followup on the GNU software development environment: Emacs, gcc/g++, -binutils, gas, gdb. - -Experience: adapted gcc, gas and binutils to work as cross-development -tools for the Thomson st18950 DSP chip: GCC parser and typing system -have been augmented to allow the manipulation of variables located in -separated memory spaces. Porting on new platforms, and professionally -developing software with the GNU tools in the Unix/X11 environment -since they were first available. - -Rates: from 2000 FF/day to 150 000 FF/year, 40% discount for -educational institutions, add taxes and expenses. Ask for list. - -Entered: 5May94 - -Contributed Software -Graefestr. 76 -10967 Berlin, Germany -phone: (+49 30) 694 69 07 -FAX: (+49 30) 694 68 09 -modems: (+49 30) 694 60 55 (5xZyXEL ) -modems: (+49 30) 693 40 51 (8xUSR DS) -email: -internet: uropax.contrib.de [192.109.39.2], login as 'guest'. - -We distribute, install, port, teach and support free software -in general, i.e. X11, GNU, khoros etc. Rates are ECU 80,-- plus -tax per hour. We offer maintenance and support contracts for full -customer satisfaction. -Highlights are transparent development environments for multi-platform -sites and configuration management. Traveling is no problem. - -Free Archive login for downloading on above modem numbers. - -Updated: 5Apr94 - -Stuart Cracraft -25682 Cresta Loma -Laguna Niguel, Ca. -92677 -GNUline: 714-347-8106 -Rate: $75/hour -Consultation topics: - Entire GNU suite - porting, compilation, installation, - user-training, administrator-training -Method: telephone line support, call-in via modem to your site, -or direct visit. - -Experience: supporting GNU since the mid-1980's, coordinator -of GNU Chess (original author), GNU Shogi, GNU Go. Ported GNU Emacs -to Solaris (System V Release 4). Expertise in C, Emacs Lisp, and Perl. -Customized programming also available. - -Entered: 5Apr94 - -Cygnus Support -1937 Landings Drive ...uunet!cygint!info -Mountain View, CA 94043 USA -+1 415 903 1400 voice -+1 415 903 0122 fax - -Cygnus Support -48 Grove Street -Somerville, MA 02144 -+1 617 629 3000 voice -+1 617 629 3010 fax - -Cygnus Support continues to provide supported, maintained versions of -the GNU toolset including GCC, G++, the GNU debugger with graphical -user interface, GNU linker, GNU macro-assembler and Emacs 19. In -keeping with the rapidly advancing needs of software developers, -Cygnus maintains a 90 day release cycle of the GNU toolset. Each -release is regression tested and includes substantial improvements and -additions to the existing matrix of over 65 supported platform -configurations. - -Updated: 2Feb95 - -Edgar Der-Danieliantz -P.O. Box 10 -Yerevan 375009 AM -ARMENIA - -Support for GCC (C & Objective C), X Window System, -World Wide Web, x86-based embedded systems, logic programming, etc. - -Via Internet (mail, talk, irc, etc.) - -Experience: - OS's: 4.3 & 4.4 BSD, SVR3.2 & 4.2, FreeBSD, Linux, - NetBSD, SCO, Solaris, SunOS, Ultrix, NEXTSTEP, UnixWare. - Languages: C, C++, Objective C, Pascal, Tcl/Tk, Perl, - Bourne Shell, PostScript, HTML, Prolog. - Platforms: Intel, SPARC, Mac, VAX, NeXT. - -Rates: Depending on type of work, appx $20/hour. Contact for more information. - Negotiable for individuals and non-profit organizations. - FREE for individuals who can't pay. Your 'Thanks!' just enough! :-) - Payment by international wire transfer. - -Entered: 6Mar96 - -Free Software Association of Germany -Michaela Merz -Heimatring 19 -6000 Frankfurt/Main 70 -phone: (+49 69) 6312083) -ert : (+49-172-6987246) -email: (info@elara.fsag.de) - -Supporting all kinds of freeware (i.e. GNU), freeware development, consulting, -training, installation. Special LINUX support group. - -RATES: - -Companies and for profit -organizations : 100 US$ / hour -Private and not-for-profit -organizations : 40 US$ / hour -ert (24h Emergency -response team) : 300 US$ / hour - -Entered: 14Apr94 - -Noah Friedman -Building 600, Suite 214 2002-A Guadalupe St. #214 -One Kendall Square Austin, TX 78705 -Cambridge, MA 02139 (Local, faster to reach me) -(Permanent) - - -Author of several Emacs Lisp packages and parts of Emacs 19, as well as -numerous utilities written in shell script and perl. Co-maintained GNU -Texinfo and Autoconf for a couple of years. System administrator for a -network of heterogenous machines. FSF employee Feb 1991--Sep 1994. - -I can perform installation, porting, and enhancement of all GNU software -and any other free software; system administration for unix-type systems -and ethernet networks; and I am willing to teach shell programming and -Emacs Lisp. - -Fees negotiable, averaging $60-$75/hour. I can work in the Austin, TX area -or anywhere accessible on the Internet. For larger jobs I may be willing -to travel. - -Updated: 16Aug95 - -Ronald F. Guilmette -Infinite Monkeys & Co. -1751 East Roseville Pkwy. #1828 -Roseville, CA 95661 -Tel: +1 916 786 7945 -FAX: +1 916 786 5311 - -Services: Development & porting of GNU software development tools. - -GNU Contributions: - Invented, designed, and implemented the protoize and - unprotoize tools supplied with GCC2. - - Designed and developed all code to support the generation - of Dwarf symbolic debugging information for System V Release - 4 in GCC2. - - Performed original port of GNU compilers to SVr4 system. - - Finished port of GNU compilers to Intel i860 RISC - processor. - -Experience: 13+ years UNIX systems experience, all working on compilers - and related tools. - - 7+ years working professionally on GCC, G++, and GDB under - contract to various firms including the Microelectronics - and Computer Technology Corporation (MCC), Data General (DG), - Network Computing Devices (NCD), and Intel Corp. - -Other qualifications: - Developer of the RoadTest (tm) C and C++ commercial - compiler test suites. - - Former vice-chairman of UNIX International Programming - Languages Special Interest Group (UI/PLSIG). - - Bachelor's and a Master's degrees, both in Computer Science. - -Rates: Variable depending upon contract duration. Call for quote. - -Updated: 23Sep95 - -Hundred Acre Consulting -1155 W Fourth St Ste 225 -PO Box 6209 -Reno NV 89513-6209 -(702)-348-7299 -Hundred Acre is a consulting group providing support and development -services to organizations of all sizes. We support GNU C++ and C in -particular, but also provide support for all other GNU software and -certain non-GNU public domain software as well. We work on a "service -contract" basis for support -- for a yearly fee, we provide multiple -levels of email and toll free telephone support, and free updates and -bug fixes. The highersupport levels have on-site support. Development -is charged on either an hourly or fixed bid basis. - -Consulting rates: $70 to $90 per hour, or fixed bid. -Support contracts: Several levels, from $495 to $90000 per year. - -Updated: 27Dec94 - -Interactive Information Limited - -Interactive Information Limited is an Edinburgh-based company that -specialises in WWW services and support for using the Internet for -marketing. - -Our staff have many years experience in using, and developing lisp packages -within, Emacs, and in using other GNU/Unix tools, particularly under public -domain UNIXes. - -We can provide services throughout the UK, at any level from general -consultancy through fetching, installing and customising software to -bespoke programming. Fees would be in the range #300 - #600 per day, -depending primarily on the size of the job. - -You can contact us - by email: - by phone: 0370 30 40 52 (UK) - (+44) 370 30 40 52 (International) - by post: 3, Lauriston Gardens, - Edinburgh EH3 9HH - Scotland - -Entered: 13Nov95 - -Scott D. Kalter - : Dennis Fitzgerald - -Kaman Sciences has performed a GNU port for a custom RISC processor. -We have experience in the definition and description of the machine -register transfer language to the GNU tool-set. This includes rewriting -and modification of the necessary description and source files of gcc, gas, -and gld and other binutils. Kaman also has services for installation and -setup of GNU tools, (GAWK, GCC, EMACS, etc.) on Sun workstations. - -Work is on a "service contract" basis and development is charged either -hourly or as a fixed price contract. - -Consulting rates: $70 to $200 per hour. - -Entered: 13Jan95 - -Scott J. Kramer -P.O. Box 620207 -Woodside, CA 94062 -+1 415-941-0755 - -GNU Software: Tutoring, installations/upgrades, Emacs Lisp customizations, - general troubleshooting/support. Prefer that work I do - becomes part integrated into official Free Software Foundation - distributions. - -Systems Administration: Sun (SunOS & Solaris) and SGI (IRIX) - UNIX hardware/software platforms. - -Rate: Task- and time-dependent; non-monetary offers accepted. - -Updated: 12Apr94 - -Fen Labalme - -Services: Supply, porting, installation, consultation on all GNU -products. - -Experience: 20 years OS and compiler experience, portations of most -GNU products. Author of ported software CD-ROM for Unix 4.2. - -Rates: Choice of DM 150 per hour or hotline rates 3 DM per minute + 10 -DM per phone call. Quick questions may be free. Limited free support -available for purchasers of LEMIS CD-ROMs. - -Updated: 21Feb95 - -Marty Leisner -332 Shaftsbury Road -Rochester, New York 14610 -Home:(716) 654-7931 - -Experience: 12 years C/Unix, 7 years DOS. - Extensive experience with GNU binary tools, cross-compilers, - embedded/hosted systems, realtime. -Degree : BS CS, Cornell University -Rates: $75/hr - - - -marty - - -Updated: 15Apr94 - -Richard Levitte (in TeX: Richard Levitte -Södra Långgatan 39, II S\"odra L{\aa}nggatan 39, II -S-171 49 Solna S-171 49 Solna -Sweden Sweden) -Tel.nr.: +46 (8) 18 30 99 (there is an answering machine) -e-mail: (preferred) - - -What I do: - Primarly I work on GNU software for VMS, both VAX and AXP. I - also work on GNU stuff for Unix on occasion. I'm familiar with - SunOS (version 4.x.x), BSD (version 4.2 and up), - Ultrix (version 4.2 and up). - I've been porting GNU Emacs to VMS since spring 1991. This - includes versions 18.57 to 18.59 and version 19.22. - I maintain GNU vmslib. - -Programs supported: - GNU vmslib: extending, installation, upgrading aid, - simple and complex questions, you name it. - GNU Emacs: porting, extending, installation, upgrading aid, - customization, simple or complex questions, - training, you name it. - GNU autoconf: porting, extending, installation, upgrading aid. - GNU zip, diffutils, m4, patch, texinfo: - porting, installation, upgrading aid. - GNU C/C++: installation, upgrading aid. I might start to - hack at it some day. - -The list of programs I currently support represents both my interests and -current priorities. Your interest and funding can influence my priorities. - -Experience: - Fluent in C, C++, Emacs Lisp, Pascal as well as assembler - on VAX, Motorola 680x0, Intel 8086 and 80x86. Modified key - elements in Emacs (e.g., memory and process management) to work - transparently on VMS. I have very good knowledge in the VMS - operating system, as well as MS-DOS and IBM PC compatibles. - I have worked for four and a half years as a VMS system manager. - I've also provided consulting services on IBM PC compatibles, - as well as held classes for IBM PC users. - A reference list is available on request. - -Your Rate: - $50-$80/hour (400-700 SEK in sweden), plus expenses. My rates - are negotiable, depending on how interesting the project is to me. - - -Entered: 18Aug94 - -Roland McGrath -545 Tech Sq, Rm 426 -Cambridge, MA 02139 -Work: (617) 253-8568 - -Co-author of GNU Make (with Richard Stallman); maintainer of GNU Make. -Author and maintainer of the GNU C Library and co-author of the GNU Hurd. -Author of several GNU Emacs Lisp packages and parts of GNU Emacs 19. -FSF employee summer 1989, fall 1990 to the present. - -Installation, maintenance, porting, enhancement of all GNU software. I can -install GNU software and maintain its installation on call via the Internet. - -Fees negotiable; $75-$100/hour, higher for very short term projects. I can -work anywhere in the Boston or SF Bay Area, or anywhere on the Internet. I -am working full-time for the FSF on the GNU Hurd, so I am likely to take on -only jobs that either can be done entirely via the Internet and are -short-term, or that are very interesting. - -Updated: 21Jan95 - -Erik Naggum -P.O. Box 1570 Vika http://www.naggum.no -0118 OSLO phone: +47 2295 0313 -NORWAY NIC handle: EN9 - -Have extensive experience with Unix and C (since 1983), Internet protocols -(1987), International Standards for character sets (1988), SGML (1990), -ANSI Common Lisp (1994); Emacs user and programmer from 1984 to 1987 -(TOPS-20) and 1991 to present (Unix). Have worked on GNU Emacs development -since early 1994, both in Emacs Lisp and C. Have been tracking development -code for Emacs since mid-1995, and know new versions intimately. - -Services offered: installation, support, customization, and development of -new packages, plus courses and seminars from basic usage through Emacs Lisp -programming to writing extensions in C. General aid with all GNU software. - -Rates depend on duration of work: From $6/minute for <= 1 hour, to $500/day -for >= 1 month. Service agreements are encouraged. Cover Scandinavia for -on-site work. Remote debugging and help by mail available for smaller -fees, without limits to distance. - -Please call only about actual work, I prefer mail for all other questions. - -I accept VISA and Mastercard, preferred for remote jobs and small amounts. - -Wolfgang S. Rupprecht -47 Esparito Ave. -Fremont, CA 94539-3827 -(510) 659-9757 - -Anything, (lisp, C, customization, porting, installing) I have -written thousands of lines of GNU Emacs C and Lisp code. Original -author of the floating point additions in Emacs 19. - -Rates: $95/hr. - -Updated: 14Apr94 - -Signum Support AB -Box 2044 _ ...!seunet!signum!info -S-580 02 Linkoping, Sweden -+46 13 21 46 00 voice -+46 13 21 47 00 fax - -Signum Support AB is a company dedicated to supporting, developing -and distributing free software for, including but not limited to, -UNIX systems. The people behind Signum Support AB have many years -of general UNIX experience, both as system administrators and as -programmers, and also extensive experience in maintaining the GNU -programs, both administrating it and finding and fixing bugs. - -Services offered: - - - Installation and customizing GNU and other free software. We will - make free software as easy to install and use as shrink wrapped - programs. - - Warranty protection. - - Customization and porting. - - Subscriptions to new versions which we will send monthly or with - any other interval. - - Finding, Recommending and Investigation of free software in any - area of the customers choise. - - Regular consulting. - -Rates: For software items, request our price list. - For consulting, 400-800 SEK/hour. - -Updated: 14Apr94 - -Small Business Systems, Inc. -Box 17220, Route 104 -Esmond, RI 02917 -401.273.4669 - -Rate: Varies depending on complexity of task. - Hourly and fixed-rate contracts are available. -Programs Supported: All - -Updated: 14Apr94 - -Julian H. Stacey. -Vector Systems Ltd, Holz Strasse 27d, D 80469 Munich (Muenchen), GERMANY. -Tel. +49 89 268616 (089 268616 in Germany) 09:00-21:00 Timezone=GMT+01:00 - -Sources: All FSF/GNU, FreeBSD-current, X-Windows, XFree86, NetBSD, Mach, etc. - (Plus various other things, such as, but not limited to: - blas blt cflow CAD cnews crypt dvi2lj eispack elm encryption expect - ezd f2c flexfax gic gopher info-zip ingres inn jpeg kermit ksh - less lha linpack md5 mh mprof mtools mush nntp octave pbmplus - popper sather sc schemetoc slurp sml spreadsheet sup tcl tcl-dp - tcsh tcx term tex tiff tk top trn unarj ups urt wine xlock xv - xview xxgdb zmodem zip zircon zoo zsh.) -Media: QIC 1/4" Cartridge 525M, 150M, & 60M, TEAC CAS-60 60M Cassette, - CD-ROM, Floppies 1.4M & 1.2 & 720K & 360K. DAT arrangeable. - Postal Service C.O.D.(=`Nachnahme') or pre payment available. -Commercial Consultancy: - Custom Designs, Provision & support of FreeBSD or Unix, C, FSF tools, - X Windows, own tools, systems engineering, hardware interfacing, - multi lingual European, Cyrillic & Chinese tools & systems, - Unix, MSDOS, real time etc, communications & scientific & industrial. -DEUTSCH + FRANCAIS: - Man kann mir in Deutsch schreiben, (oder mich anrufen). - Je comprend Francais, mais je n'ecris pas des responses en Francais. - (Contact me in English, German, or French). -FREE for Symmetric Computer Systems Model 375 owners: - Free Binaries & sources on SCS/375's TEAC 50/60M Cassette, for: - GCC-1.40, UUCP-1.4, Ghostscript 2.3, Tar-1.08, Gzip-1.2.2 etc. - (Native SCS compiler can't compile GCC on this NSC32016 based BSD4.2) -On Request: Resume, Company Profile, Index of public & proprietary tools, -Rate: ~120 DM/hour. ~100DM/Cartridge. (1.5DM = $1 USA = 0.6 UK Pounds @4/'94) -Short enquiries free. (Kurze Anfragen Ohne Gebuhr). - -Updated: 14Jun94 - -Richard M. Stallman -UUCP: {mit-eddie,ucbvax,uunet,harvard,uw-beaver}!ai.mit.edu!rms -545 Tech Sq, Rm 430 -Cambridge, MA 02139 - -Emacs: anything whatever -Is anyone interested in courses in using or extending GNU Emacs? - -Original inventor of Emacs and main author of GNU Emacs and GCC. - -Rates: $6/min or $250/hr. - -Updated: 14Apr94 - -JoS-Ware Comp Tech Johan Svensson -Box 739 -220 07 LUND -SWEDEN -Tel +46-46-104505 (Dept. of Economics, University of LUND) -Fax +46-46-188445 (JoS-Ware Comp Tech) - -What: We offer consulting services regarding installation, - customization, troubleshooting, porting and integration - of all free software, including GNU software. - -Spec.: Network integration, integration of public domain software - into commercial systems, WorldWideWeb, C, X-Windows, Linux, - networked information systems - -How: Remote login over internet, email, modem, phone, personal - visits (in southern Sweden mainly) - -Rates: 550SEK (+ tax) per hour within Sweden - 370SEK (+ tax) per hour within Sweden for educational org. - US $90 per hour outside Sweden - US $70 per hour outside Sweden for educational org. - Note: fees may vary and special arrangements may be considered - -Entered: 7Apr94 - -Kayvan Sylvan -Sylvan Associates -879 Lewiston Drive -San Jose, CA 95136 -Phone: 408-978-1407 - -I will help you port, install and customize GNU Emacs, GCC, G++, -bison, and other GNU tools on almost any architechture and operating -system. Questions answered. GNU C and lisp hacking available. I will -also do ongoing support and periodic upgrades if you get on my GNU -software subscription list. - -Rates: $60-$100/hour, depending on type of work. Substantial discounts -for long-term contracts and also for educational or non-profit -institutions. - -Experience: Many different Unix systems (2.9BSD to 4.4BSD, SVR3 and -SVR4, Linux, Xenix). Systems programming and system administration on all -brands of Unix. Kernel hacking experience. Lots of porting experience. -I can port anything to anything (within reason). - -Updated: 14Apr94 - -Leonard H. Tower Jr. -36 Porter Street -Somerville, MA 02143, USA -+1 (617) 623-7739 - -Will work on most GNU software. -Installation, handholding, trouble shooting, extensions, teaching. - -Rates: 100.00/hour + travel expenses. Negotiable for non-profits. - -Experience: Have hacked on over a dozen architectures in many languages. Have -system mothered several varieties of Unixes. Assisted rms with the front end -of gcc and it's back-end support. Resume available on request. - -Entered: 14Apr94 - -UrbanSoft AO -68 Malooktinskii Prospect -St. Petersburg, Russia 195272 - -Custom GhostScript and TeX programming by e-mail. -Database documents, directories, standard forms. - -UrbanSoft uses a portion of its revenues to contribute -diskette distributions of GNU software to Russian -universities (most of which lack FTP access). - -Rates: 30,000 rubles (currently USD 16.80) per hour. - Fixed rate contracts also possible. - Payable by bank transfer. - -Updated: 20Apr94 - -noris network -Matthias Urlichs -Schleiermacherstrasse 12 -90491 Nuernberg -Germany -Phone: +49 911 9959621 -Fax: +49 911 5980150 - -http://info.noris.de/ (German) - -Expertise: - OS internals, esp. Linux and BSD, esp. device drivers - Network protocol / program design and coding - Utilities coding and maintainance - Program debugging, testing - User interface design and testing - Several programming and tool languages - -Services: - Installation, debugging, enhancement, distribution, - for all kinds of free software. - System administration for most Unix-like systems. - Email, Fax, phone, and in-person consulting (and/or "question answering"). - Remote support and system monitoring (over the Internet), - Update service (new tools tested and installed automagically) - Internet access - -Rates: - DM 110 (~$70) per hour - Support contracts start at DM 170/month + DM 30/supported system. - Willing to travel for sufficiently large jobs. - Rates don't include taxes. - -Entered: 16Aug94 - -Joe Wells -Postal Address: - care of: Boston University Computer Science Department - 111 Cummington Street, Room 138 - Boston, Massachusetts 02215 -Work Telephone: (617) 353-3381 (sorry, but no answering machine or voice mail) -Home Telephone: (617) 739-7456 (until August 1995) -Finger "jbw@cs.bu.edu" for up-to-date contact information. - -Experience: - I have B.A. and M.A. degrees in Computer Science and have completed - all but the dissertation for a Ph.D. in C.S. My research for my - Ph.D. is in the areas of logic, type systems, and programming - language theory. My primary programming languages are Emacs Lisp, - Perl, and Bourne shell, but of course I can program in any language. - I have written numerous Emacs Lisp packages. I started the USENET - "List of Frequently Asked Questions about GNU Emacs with Answers" and - maintained it for more than two years. Most of my work has been - related to the telephone system (modems, voice mail, etc.), but I am - not limited to that. Send e-mail for my complete resume or curriculum - vita. - -Programs supported: - GNU Emacs and Taylor UUCP: - Installation, training, customization, bug fixing, troubleshooting, - extension, development, porting, or answering any kind of question. - Any other GNU program: - The same things, but I don't necessarily have huge amounts of - experience with the particular program. - -Working conditions: - I am usually available for part-time work (less than 20 hours per week - including any travel time). I can sometimes make time for full-time - work for a month or two; please inquire. I can either work in or near - Boston or via the Internet or via telephone; travel outside the Boston - metropolitan area can be negotiated. My schedule is very flexible. - Any programs I write will normally have the copying conditions of the - GNU General Public License; this is negotiable. - -Rates: $65/hour as an independent contractor. - travel and telephone expenses. - higher rates if extensive travel is required. - -Updated: 27Sep94. - -Herb Wood -phone: 1-415-789-7173 -email: - -I'm a better "planner" than I am a hacker. A really good hacker will be able -to keep many pieces of information in their short-term memory and to memorize -new pieces of information at a fast rate. This is not my strong point. -Rather, I excel in domains that require knowledge of the slightly more -theoretical parts of computer science --for example, logic, formal methods of -program development, and functional programming. I can write, and I have -"tutoring" (teaching one-on-one) experience, an, unlike some programmers, -I enjoy doing these things. - -I have spend a lot of time looking at the Emacs Lisp sources and customizing -Emacs and VM. I think I can customize Emacs and its packages quickly and -effectively. - -Entered: 30Jul95 - -Yggdrasil Computing, Inc./ Freesoft, Inc. -4880 Stevens Creek Blvd. Ste. 205 -San Jose, CA 95129 -(408) 261-6630 -(800) 261 6630 - -Updated: 14Apr94 - - -For a current copy of this directory, or to have yourself listed, ask: - gnu@prep.ai.mit.edu - -** Please keep the entries in this file alphabetical ** diff --git a/etc/TUTORIAL b/etc/TUTORIAL deleted file mode 100644 index e6a3b3e..0000000 --- a/etc/TUTORIAL +++ /dev/null @@ -1,1114 +0,0 @@ -Copyright (c) 1985, 1996 Free Software Foundation, Inc. See end for conditions. - -You are looking at the Emacs tutorial. - -Emacs commands generally involve the CONTROL key (sometimes labelled -CTRL or CTL) or the META key. On some keyboards, the META key is -labelled ALT or EDIT or something else (for example, on Sun keyboards, -the diamond key to the left of the spacebar is META). If you have no -META key, you can use ESC instead. Rather than write out META or -CONTROL each time we want you to prefix a character, we'll use the -following abbreviations: - - C- means hold the CONTROL key while typing the character - Thus, C-f would be: hold the CONTROL key and type f. - M- means hold the META key down while typing . If there - is no META key, type , release it, then type the - character . - -Important note: to end the Emacs session, type C-x C-c. (Two characters.) -The characters ">>" at the left margin indicate directions for you to -try using a command. For instance: -<> ->> Now type C-v (View next screen) to move to the next screen. - (go ahead, do it by holding down the control key while typing v). - From now on, you should do this again whenever you finish - reading the screen. - -Note that there is an overlap of two lines when you move from screen -to screen; this provides some continuity so you can continue reading -the text. - -The first thing that you need to know is how to move around from place -to place in the text. You already know how to move forward one screen, -with C-v. To move backwards one screen, type M-v (hold down the META key -and type v, or type v if you do not have a META, EDIT, or ALT key). - ->> Try typing M-v and then C-v, a few times. - - -* SUMMARY ---------- - -The following commands are useful for viewing screenfuls: - - C-v Move forward one screenful - M-v Move backward one screenful - C-l Clear screen and redisplay everything - putting the text near the cursor at the center. - (That's control-L, not control-1.) - ->> Find the cursor, and note what text is near it. - Then type C-l. - Find the cursor again and notice that the same text - is near the cursor now. - - -* BASIC CURSOR CONTROL ----------------------- - -Moving from screenful to screenful is useful, but how do you -move to a specific place within the text on the screen? - -There are several ways you can do this. The most basic way is to use -the commands C-p, C-b, C-f, and C-n. Each of these commands moves the -cursor one row or column in a particular direction on the screen. -Here is a table showing these four commands and shows the directions -they move: - - Previous line, C-p - : - : - Backward, C-b .... Current cursor position .... Forward, C-f - : - : - Next line, C-n - ->> Move the cursor to the line in the middle of that diagram - using C-n or C-p. Then type C-l to see the whole diagram - centered in the screen. - -You'll probably find it easy to think of these by letter: P for -previous, N for next, B for backward and F for forward. These are the -basic cursor positioning commands, and you'll be using them ALL the -time, so it would be of great benefit if you learn them now. - ->> Do a few C-n's to bring the cursor down to this line. - ->> Move into the line with C-f's and then up with C-p's. - See what C-p does when the cursor is in the middle of the line. - -Each of text line ends with a Newline character, which serves to -separate it from the following line. The last line in your file ought -to have a Newline at the end (but Emacs does not require it to have -one). - ->> Try to C-b at the beginning of a line. It should move to - the end of the previous line. This is because it moves back - across the Newline character. - -C-f can move across a Newline just like C-b. - ->> Do a few more C-b's, so you get a feel for where the cursor is. - Then do C-f's to return to the end of the line. - Then do one more C-f to move to the following line. - -When you move past the top or bottom of the screen, the text beyond -the edge shifts onto the screen. This is called "scrolling". It -enables Emacs to move the cursor to the specified place in the text -without moving it off the screen. - ->> Try to move the cursor off the bottom of the screen with C-n, and - see what happens. - -If moving by characters is too slow, you can move by words. M-f -(Meta-f) moves forward a word and M-b moves back a word. - ->> Type a few M-f's and M-b's. - -When you are in the middle of a word, M-f moves to the end of the word. -When you are in whitespace between words, M-f moves to the end of the -following word. M-b works likewise in the opposite direction. - ->> Type M-f and M-b a few times, interspersed with C-f's and C-b's - so that you can observe the action of M-f and M-b from various - places inside and between words. - -Notice the parallel between C-f and C-b on the one hand, and M-f and -M-b on the other hand. Very often Meta characters are used for -operations related to the units defined by language (words, sentences, -paragraphs), while Control characters operate on basic units that are -independent of what you are editing (characters, lines, etc). - -This parallel applies between lines and sentences: C-a and C-e move to -the beginning or end of a line, and M-a and M-e move to the beginning -or end of a sentence. - ->> Try a couple of C-a's, and then a couple of C-e's. - Try a couple of M-a's, and then a couple of M-e's. - -See how repeated C-a's do nothing, but repeated M-a's keep moving one -more sentence. Although these are not quite analogous, each one seems -natural. - -The location of the cursor in the text is also called "point". To -paraphrase, the cursor shows on the screen where point is located in -the text. - -Here is a summary of simple cursor-moving operations, including the -word and sentence moving commands: - - C-f Move forward a character - C-b Move backward a character - - M-f Move forward a word - M-b Move backward a word - - C-n Move to next line - C-p Move to previous line - - C-a Move to beginning of line - C-e Move to end of line - - M-a Move back to beginning of sentence - M-e Move forward to end of sentence - ->> Try all of these commands now a few times for practice. - These are the most often used commands. - -Two other important cursor motion commands are M-< (Meta Less-than), -which moves to the beginning of the whole text, and M-> (Meta -Greater-than), which moves to the end of the whole text. - -On most terminals, the "<" is above the comma, so you must use the -shift key to type it. On these terminals you must use the shift key -to type M-< also; without the shift key, you would be typing M-comma. - ->> Try M-< now, to move to the beginning of the tutorial. - Then use C-v repeatedly to move back here. - ->> Try M-> now, to move to the end of the tutorial. - Then use M-v repeatedly to move back here. - -You can also move the cursor with the arrow keys, if your terminal has -arrow keys. We recommend learning C-b, C-f, C-n and C-p for three -reasons. First, they work on all kinds of terminals. Second, once -you gain practice at using Emacs, you will find that typing these CTRL -characters is faster than typing the arrow keys (because you do not -have to move your hands away from touch-typing position). Third, once -you form the habit of using these CTRL character commands, you can -easily learn to use other advanced cursor motion commands as well. - -Most Emacs commands accept a numeric argument; for most commands, this -serves as a repeat-count. The way you give a command a repeat count -is by typing C-u and then the digits before you type the command. If -you have a META (or EDIT or ALT) key, there is another alternative way -to enter a numeric argument: type the digits while holding down the -META key. We recommend learning the C-u method because it works on -any terminal. - -For instance, C-u 8 C-f moves forward eight characters. - ->> Try using C-n or C-p with a numeric argument, to move the cursor - to a line near this one with just one command. - -Most commands use the numeric argument as a repeat count. Certain -exceptional commands use it differently. C-v and M-v are among the -exceptions. When given an argument, they scroll the screen up or down -by that many lines, rather than by a screenfuls. For example, C-u 4 -C-v scrolls the screen by 4 lines. - ->> Try typing C-u 8 C-v now. - -This should have scrolled the screen up by 8 lines. If you would like -to scroll it down again, you can give an argument to M-v. - -If you are using the X Window system, there is probably a rectangular -area called a scroll bar at the right hand side of the Emacs window. -You can scroll the text by manipulating the scroll bar with the mouse. - ->> Try pressing the middle button at the top of the highlighted area - within the scroll bar. This should scroll the text to a position - determined by how high or low you click. - ->> Move the mouse to a point in the scroll bar about three lines from -the top, and click the left button a couple of times. - - -* CURSOR CONTROL WITH AN X TERMINAL ------------------------------------ - -If you have an X terminal, you will probably find it easier to use -the keys on the keypad to control the cursor. The left, right, up, -and down arrow keys move in the expected direction; they function -exactly like C-b, C-f, C-p, and C-n, but are easier to type and to -remember. You can also use C-left and C-right to move by words, and -C-up and C-down to move by blocks (e.g. paragraphs, if you're -editing text). If you have keys labelled HOME (or BEGIN) and END, -they will take you to the beginning and end of a line, respectively, -and C-home and C-end will move to the beginning and end of the file. -If your keyboard has PgUp and PgDn keys, you can use them to move up -and down a screenful at a time, like M-v and C-v. - -All of these commands can take numeric arguments, as described above. -You can use a shortcut to enter these arguments: just hold down the -CONTROL or META key and type the number. For example, to move 12 -words to the right, type C-1 C-2 C-right. Note that it is very easy -to type this because you do not have to release the CONTROL key -between keystrokes. - - -* WHEN EMACS IS HUNG --------------------- - -If Emacs stops responding to your commands, you can stop it safely by -typing C-g. You can use C-g to stop a command which is taking too -long to execute. - -You can also use C-g to discard a numeric argument or the beginning of -a command that you do not want to finish. - ->> Type C-u 100 to make a numeric arg of 100, then type C-g. - Now type C-f. It should move just one character, - because you canceled the argument with C-g. - -If you have typed an by mistake, you can get rid of it -with a C-g. - - -* DISABLED COMMANDS -------------------- - -Some Emacs commands are "disabled" so that beginning users cannot use -them by accident. - -If you type one of the disabled commands, Emacs displays a message -saying what the command was, and asking you whether you want to go -ahead and execute the command. - -If you really want to try the command, type Space in answer to the -question. Normally, if you do not want to execute the disabled -command, answer the question with "n". - ->> Type `C-x n p' (which is a disabled command), - then type n to answer the question. - - -* WINDOWS ---------- - -Emacs can have several windows, each displaying its own text. -Note that "window" as used by Emacs does not refer to separate -overlapping windows in the window system, but to separate panes -within a single X window. (Emacs can also have multiple X -windows, or "frames" in Emacs terminology. This is described -later.) - -At this stage it is better not to go into the techniques of -using multiple windows. But you do need to know how to get -rid of extra windows that may appear to display help or -output from certain commands. It is simple: - - C-x 1 One window (i.e., kill all other windows). - -That is Control-x followed by the digit 1. C-x 1 expands the window -which contains the cursor, to occupy the full screen. It deletes all -other windows. - ->> Move the cursor to this line and type C-u 0 C-l. - -(Remember that C-l redraws the screen. If you give a -numeric argument to this command, it means "redraw the -screen and put the current line that many lines from the -top of the screen." So C-u 0 C-l means "redraw the -screen, putting the current line at the top.") - ->> Type Control-x 2 - See how this window shrinks, while a new one appears - to display contents of this buffer. - ->> Type C-x 1 and see the new window disappear. - - -* INSERTING AND DELETING ------------------------- - -If you want to insert text, just type the text. Characters which you -can see, such as A, 7, *, etc. are taken by Emacs as text and inserted -immediately. Type (the carriage-return key) to insert a -Newline character. - -You can delete the last character you typed by typing . - is a key on the keyboard, which may be labeled "Del". In -some cases, the "Backspace" key serves as , but not always! - -More generally, deletes the character immediately before the -current cursor position. - ->> Do this now--type a few characters, then delete them - by typing a few times. Don't worry about this file - being changed; you will not alter the master tutorial. This is - your personal copy of it. - -When a line of text gets too big for one line on the screen, the line -of text is "continued" onto a second screen line. A backslash ("\") -at the right margin indicates a line which has been continued. - ->> Insert text until you reach the right margin, and keep on inserting. - You'll see a continuation line appear. - ->> Use s to delete the text until the line fits on one screen - line again. The continuation line goes away. - -You can delete a Newline character just like any other character. -Deleting the Newline character between two lines merges them into -one line. If the resulting combined line is too long to fit in the -screen width, it will be displayed with a continuation line. - ->> Move the cursor to the beginning of a line and type . This - merges that line with the previous line. - ->> Type to reinsert the Newline you deleted. - -Remember that most Emacs commands can be given a repeat count; -this includes text characters. Repeating a text character inserts -it several times. - ->> Try that now -- type C-u 8 * to insert ********. - -You've now learned the most basic way of typing something in -Emacs and correcting errors. You can delete by words or lines -as well. Here is a summary of the delete operations: - - delete the character just before the cursor - C-d delete the next character after the cursor - - M- kill the word immediately before the cursor - M-d kill the next word after the cursor - - C-k kill from the cursor position to end of line - M-k kill to the end of the current sentence - -Notice that and C-d vs M- and M-d extend the parallel -started by C-f and M-f (well, is not really a control -character, but let's not worry about that). C-k and M-k are like C-e -and M-e, sort of, in that lines are opposite sentences. - -When you delete more than one character at a time, Emacs saves the -deleted text so that you can bring it back. Bringing back killed text -is called "yanking". You can yank the killed text either at the same -place where it was killed, or at some other place in the text. You -can yank the text several times in order to make multiple copies of -it. The command to yank is C-y. - -Note that the difference between "Killing" and "Deleting" something is -that "Killed" things can be yanked back, and "Deleted" things cannot. -Generally, the commands that can remove a lot of text save the text, -while the commands that delete just one character, or just blank lines -and spaces, do not save the deleted text. - ->> Move the cursor to the beginning of a line which is not empty. - Then type C-k to kill the text on that line. ->> Type C-k a second time. You'll see that it kills the Newline - which follows that line. - -Note that a single C-k kills the contents of the line, and a second -C-k kills the line itself, and make all the other lines move up. C-k -treats a numeric argument specially: it kills that many lines AND -their contents. This is not mere repetition. C-u 2 C-k kills two -lines and their newlines; typing C-k twice would not do that. - -To retrieve the last killed text and put it where the cursor currently -is, type C-y. - ->> Try it; type C-y to yank the text back. - -Think of C-y as if you were yanking something back that someone took -away from you. Notice that if you do several C-k's in a row, all of -the killed text is saved together, so that one C-y will yank all of -the lines. - ->> Do this now, type C-k several times. - -Now to retrieve that killed text: - ->> Type C-y. Then move the cursor down a few lines and type C-y - again. You now see how to copy some text. - -What do you do if you have some text you want to yank back, and then -you kill something else? C-y would yank the more recent kill. But -the previous text is not lost. You can get back to it using the M-y -command. After you have done C-y to get the most recent kill, typing -M-y replaces that yanked text with the previous kill. Typing M-y -again and again brings in earlier and earlier kills. When you have -reached the text you are looking for, you do not have to do anything to -keep it. Just go on with your editing, leaving the yanked text where -it is. - -If you M-y enough times, you come back to the starting point (the most -recent kill). - ->> Kill a line, move around, kill another line. - Then do C-y to get back the second killed line. - Then do M-y and it will be replaced by the first killed line. - Do more M-y's and see what you get. Keep doing them until - the second kill line comes back, and then a few more. - If you like, you can try giving M-y positive and negative - arguments. - - -* UNDO ------- - -If you make a change to the text, and then decide that it was a -mistake, you can undo the change with the undo command, C-x u. - -Normally, C-x u undoes the changes made by one command; if you repeat -the C-x u several times in a row, each repetition undoes one -additional command. - -But there are two exceptions: commands that do not change the text do -not count (this includes cursor motion commands and scrolling -command), and self-inserting characters are usually handled in groups -of up to 20. (This is to reduce the number of C-x u's you have to -type to undo insertion of text.) - ->> Kill this line with C-k, then type C-x u and it should reappear. - -C-_ is an alternative undo command; it works just the same as C-x u, -but it is easier to type several times in a row. The disadvantage of -C-_ is that on some keyboards it is not obvious how to type it. That -is why we provide C-x u as well. On some terminals, you can type C-_ -by typing / while holding down CTRL. - -A numeric argument to C-_ or C-x u acts as a repeat count. - - -* FILES -------- - -In order to make the text you edit permanent, you must put it in a -file. Otherwise, it will go away when your invocation of Emacs goes -away. You put your editing in a file by "finding" the file. (This is -also called "visiting" the file.) - -Finding a file means that you see the contents of the file within -Emacs. In many ways, it is as if you were editing the file itself. -However, the changes you make using Emacs do not become permanent -until you "save" the file. This is so you can avoid leaving a -half-changed file on the system when you do not want to. Even when -you save, Emacs leaves the original file under a changed name in case -you later decide that your changes were a mistake. - -If you look near the bottom of the screen you will see a line that -begins and ends with dashes, and contains the string "Emacs: -TUTORIAL". This part of the screen always shows the name of the file -that you are visiting. Right now, you are visiting a file called -"TUTORIAL" which is your personal scratch copy of the Emacs tutorial. -Whatever file you find, that file's name will appear in that precise -spot. - -The commands for finding and saving files are unlike the other -commands you have learned in that they consist of two characters. -They both start with the character Control-x. There is a whole series -of commands that start with Control-x; many of them have to do with -files, buffers, and related things. These commands are two, three or -four characters long. - -Another thing about the command for finding a file is that you have -to say what file name you want. We say the command "reads an argument -from the terminal" (in this case, the argument is the name of the -file). After you type the command - - C-x C-f Find a file - -Emacs asks you to type the file name. The file name you type appears -on the bottom line of the screen. The bottom line is called the -minibuffer when it is used for this sort of input. You can use -ordinary Emacs editing commands to edit the file name. - -While you are entering the file name (or any minibuffer input), -you can cancel the command with C-g. - ->> Type C-x C-f, then type C-g. This cancels the minibuffer, - and also cancels the C-x C-f command that was using the - minibuffer. So you do not find any file. - -When you have finished entering the file name, type to -terminate it. Then C-x C-f command goes to work, and finds the file -you chose. The minibuffer disappears when the C-x C-f command is -finished. - -In a little while the file contents appear on the screen, and you can -edit the contents. When you wish to make your changes permanent, -type the command - - C-x C-s Save the file - -This copies the text within Emacs into the file. The first time you -do this, Emacs renames the original file to a new name so that it is -not lost. The new name is made by adding "~" to the end of the -original file's name. - -When saving is finished, Emacs prints the name of the file written. -You should save fairly often, so that you will not lose very much -work if the system should crash. - ->> Type C-x C-s, saving your copy of the tutorial. - This should print "Wrote ...TUTORIAL" at the bottom of the screen. - -NOTE: On some systems, typing C-x C-s will freeze the screen and you -will see no further output from Emacs. This indicates that an -operating system "feature" called "flow control" is intercepting the -C-s and not letting it get through to Emacs. To unfreeze the screen, -type C-q. Then see the section "Spontaneous Entry to Incremental -Search" in the Emacs manual for advice on dealing with this "feature". - -You can find an existing file, to view it or edit it. You can also -find a file which does not already exist. This is the way to create a -file with Emacs: find the file, which will start out empty, and then -begin inserting the text for the file. When you ask to "save" the -file, Emacs will really create the file with the text that you have -inserted. From then on, you can consider yourself to be editing an -already existing file. - - -* BUFFERS ---------- - -If you find a second file with C-x C-f, the first file remains -inside Emacs. You can switch back to it by finding it again with -C-x C-f. This way you can get quite a number of files inside Emacs. - ->> Create a file named "foo" by typing C-x C-f foo . - Then insert some text, edit it, and save "foo" by typing C-x C-s. - Finally, type C-x C-f TUTORIAL - to come back to the tutorial. - -Emacs stores each file's text inside an object called a "buffer." -Finding a file makes a new buffer inside Emacs. To see a list of the -buffers that current exist in your Emacs job, type - - C-x C-b List buffers - ->> Try C-x C-b now. - -See how each buffer has a name, and it may also have a file name -for the file whose contents it holds. Some buffers do not correspond -to files. For example, the buffer named "*Buffer List*" does -not have any file. It is the buffer which contains the buffer -list that was made by C-x C-b. ANY text you see in an Emacs window -is always part of some buffer. - ->> Type C-x 1 to get rid of the buffer list. - -If you make changes to the text of one file, then find another file, -this does not save the first file. Its changes remain inside Emacs, -in that file's buffer. The creation or editing of the second file's -buffer has no effect on the first file's buffer. This is very useful, -but it also means that you need a convenient way to save the first -file's buffer. It would be a nuisance to have to switch back to -it with C-x C-f in order to save it with C-x C-s. So we have - - C-x s Save some buffers - -C-x s asks you about each buffer which contains changes that you have -not saved. It asks you, for each such buffer, whether to save the -buffer. - ->> Insert a line of text, then type C-x s. - It should ask you whether to save the buffer named TUTORIAL. - Answer yes to the question by typing "y". - -* USING THE MENU ----------------- - -If you are on an X terminal, you will notice a menubar at the -top of the Emacs screen. You can use this menubar to access all -the most common Emacs commands, such as "find file". You will -find this easier at first, because you don't need to remember -the keystrokes necessary to access any particular command. Once -you are comfortable with Emacs, it will be easy to begin using -the keyboard commands because each menu item with a -corresponding keyboard command has the command listed next to -it. - -Note that there are many items in the menubar that have no exact -keyboard equivalents. For example, the Buffers menu lists all -of the available buffers in most-recently used order. You can -switch to any buffer by simply findings its name in the Buffers -menu and selecting it. - - -* USING THE MOUSE ------------------ - -When running under X, Emacs is fully integrated with the mouse. -You can position the text cursor by clicking the left button at -the desired location, and you can select text by dragging the -left mouse button across the text you want to select. (Or -alternatively, click the left mouse button at one end of the -text, then move to the other end and use Shift-click to select -the text.) - -To kill some selected text, you can use C-w or choose the Cut -item from the Edit menu. Note that these are *not* equivalent: -C-w only saves the text internally within Emacs (similar to C-k -as described above), whereas Cut does this and also puts the -text into the X clipboard, where it can be accessed by other -applications. - -To retrieve text from the X clipboard, use the Paste item from -the Edit menu. - -The middle mouse button is commonly used to choose items that -are visible on the screen. For example, if you enter Info (the -on-line Emacs documentation) using C-h i or the Help menu, you -can follow a highlighted link by clicking the middle mouse -button on it. Similarly, if you are typing a file name in -(e.g. when prompted by "Find File") and you hit TAB to show the -possible completions, you can click the middle mouse button on -one of the completions to select it. - -The right mouse button brings up a popup menu. The contents of -this menu vary depending on what mode you're in, and usually -contain a few commonly used commands, so they're easier to -access. - ->> Press the right mouse button now. - -You will have to hold the button down in order to keep the -menu up. - - -* EXTENDING THE COMMAND SET ---------------------------- - -There are many, many more Emacs commands than could possibly be put -on all the control and meta characters. Emacs gets around this with -the X (eXtend) command. This comes in two flavors: - - C-x Character eXtend. Followed by one character. - M-x Named command eXtend. Followed by a long name. - -These are commands that are generally useful but used less than the -commands you have already learned about. You have already seen two of -them: the file commands C-x C-f to Find and C-x C-s to Save. Another -example is the command to end the Emacs session--this is the command -C-x C-c. (Do not worry about losing changes you have made; C-x C-c -offers to save each changed file before it kills the Emacs.) - -C-z is the command to exit Emacs *temporarily*--so that you can go -back to the same Emacs session afterward. - -On systems which allow it, C-z "suspends" Emacs; that is, it returns -to the shell but does not destroy the Emacs. In the most common -shells, you can resume Emacs with the `fg' command or with `%emacs'. - -On systems which do not implement suspending, C-z creates a subshell -running under Emacs to give you the chance to run other programs and -return to Emacs afterward; it does not truly "exit" from Emacs. In -this case, the shell command `exit' is the usual way to get back to -Emacs from the subshell. - -The time to use C-x C-c is when you are about to log out. It's also -the right thing to use to exit an Emacs invoked under mail handling -programs and other miscellaneous utilities, since they may not know -how to cope with suspension of Emacs. In ordinary circumstances, -though, if you are not about to log out, it is better to suspend Emacs -with C-z instead of exiting Emacs. - -There are many C-x commands. Here is a list of the ones you have learned: - - C-x C-f Find file. - C-x C-s Save file. - C-x C-b List buffers. - C-x C-c Quit Emacs. - C-x u Undo. - -Named eXtended commands are commands which are used even less -frequently, or commands which are used only in certain modes. An -example is the command replace-string, which globally replaces one -string with another. When you type M-x, Emacs prompts you at the -bottom of the screen with M-x and you should type the name of the -command; in this case, "replace-string". Just type "repl s" and -Emacs will complete the name. End the command name with . - -The replace-string command requires two arguments--the string to be -replaced, and the string to replace it with. You must end each -argument with . - ->> Move the cursor to the blank line two lines below this one. - Then type M-x repl schangedaltered. - - Notice how this line has changed: you've replaced - the word c-h-a-n-g-e-d with "altered" wherever it occurred, - after the initial position of the cursor. - - -* AUTO SAVE ------------ - -When you have made changes in a file, but you have not saved them yet, -they could be lost if your computer crashes. To protect you from -this, Emacs periodically writes an "auto save" file for each file that -you are editing. The auto save file name has a # at the beginning and -the end; for example, if your file is named "hello.c", its auto save -file's name is "#hello.c#". When you save the file in the normal way, -Emacs deletes its auto save file. - -If the computer crashes, you can recover your auto-saved editing by -finding the file normally (the file you were editing, not the auto -save file) and then typing M-x recover file. When it asks for -confirmation, type yes to go ahead and recover the auto-save -data. - - -* ECHO AREA ------------ - -If Emacs sees that you are typing commands slowly it shows them to you -at the bottom of the screen in an area called the "echo area." The echo -area contains the bottom line of the screen. - - -* MODELINE ------------ - -The line immediately above the echo area it is called the "modeline". -The mode line says something like this: - ---**-XEmacs: TUTORIAL (Fundamental)--L670--58%---------------- - -This line gives useful information about the status of Emacs and -the text you are editing. - -You already know what the filename means--it is the file you have -found. -NN%-- indicates your current position in the text; it means -that NN percent of the text is above the top of the screen. If the -top of the file is on the screen, it will say --Top-- instead of ---00%--. If the bottom of the text is on the screen, it will say ---Bot--. If you are looking at text so small that all of it fits on -the screen, the mode line says --All--. - -The stars near the front mean that you have made changes to the text. -Right after you visit or save a file, that part of the mode line shows -no stars, just dashes. - -The part of the mode line inside the parentheses is to tell you what -editing modes you are in. The default mode is Fundamental which is -what you are using now. It is an example of a "major mode". - -Emacs has many different major modes. Some of them are meant for -editing different languages and/or kinds of text, such as Lisp mode, -Text mode, etc. At any time one and only one major mode is active, -and its name can always be found in the mode line just where -"Fundamental" is now. - -Each major mode makes a few commands behave differently. For example, -there are commands for creating comments in a program, and since each -programming language has a different idea of what a comment should -look like, each major mode has to insert comments differently. Each -major mode is the name of an extended command, which is how you can -switch to that mode. For example, M-x fundamental-mode is a command to -switch to Fundamental mode. - -If you are going to be editing English text, such as this file, you -should probably use Text Mode. ->> Type M-x text-mode. - -Don't worry, none of the commands you have learned changes Emacs in -any great way. But you can observe that M-f and M-b now treat -apostrophes as part of words. Previously, in Fundamental mode, -M-f and M-b treated apostrophes as word-separators. - -Major modes usually make subtle changes like that one: most commands -do "the same job" in each major mode, but they work a little bit -differently. - -To view documentation on your current major mode, type C-h m. - ->> Use C-u C-v once or more to bring this line near the top of screen. ->> Type C-h m, to see how Text mode differs from Fundamental mode. ->> Type q to remove the documentation from the screen. - -Major modes are called major because there are also minor modes. -Minor modes are alternatives not to the major modes, just minor -modifications of them. Each minor mode can be turned on or off by -itself, independent of all other minor modes, and independent of your -major mode. So you can use no minor modes, or one minor mode, or any -combination of several minor modes. - -One minor mode which is very useful, especially for editing English -text, is Auto Fill mode. When this mode is on, Emacs breaks the line -in between words automatically whenever you insert text and make a -line that is too wide. - -You can turn Auto Fill mode on by doing M-x auto-fill-mode. -When the mode is on, you can turn it off by doing M-x -auto-fill-mode. If the mode is off, this command turns it on, -and if the mode is on, this command turns it off. We say that the -command "toggles the mode". - ->> Type M-x auto-fill-mode now. Then insert a line of "asdf " - over again until you see it divide into two lines. You must put in - spaces between them because Auto Fill breaks lines only at spaces. - -The margin is usually set at 70 characters, but you can change it -with the C-x f command. You should give the margin setting you want -as a numeric argument. - ->> Type C-x f with an argument of 20. (C-u 2 0 C-x f). - Then type in some text and see Emacs fill lines of 20 - characters with it. Then set the margin back to 70 using - C-x f again. - -If you makes changes in the middle of a paragraph, Auto Fill mode -does not re-fill it for you. -To re-fill the paragraph, type M-q (Meta-q) with the cursor inside -that paragraph. - ->> Move the cursor into the previous paragraph and type M-q. - - -* SEARCHING ------------ - -Emacs can do searches for strings (these are groups of contiguous -characters or words) either forward through the text or backward -through it. Searching for a string is a cursor motion command; -it moves the cursor to the next place where that string appears. - -The Emacs search command is different from the search commands -of most editors, in that it is "incremental". This means that the -search happens while you type in the string to search for. - -The command to initiate a search is C-s for forward search, and C-r -for reverse search. BUT WAIT! Don't try them now. - -When you type C-s you'll notice that the string "I-search" appears as -a prompt in the echo area. This tells you that Emacs is in what is -called an incremental search waiting for you to type the thing that -you want to search for. terminates a search. - ->> Now type C-s to start a search. SLOWLY, one letter at a time, - type the word 'cursor', pausing after you type each - character to notice what happens to the cursor. - Now you have searched for "cursor", once. ->> Type C-s again, to search for the next occurrence of "cursor". ->> Now type four times and see how the cursor moves. ->> Type to terminate the search. - -Did you see what happened? Emacs, in an incremental search, tries to -go to the occurrence of the string that you've typed out so far, -highlighting it for your convenience. To go to the next occurrence of -'cursor' just type C-s again. If no such occurrence exists Emacs -beeps and tells you the search is currently "failing", C-g would also -terminate the search. - -NOTE: On some systems, typing C-s will freeze the screen and you will -see no further output from Emacs. This indicates that an operating -system "feature" called "flow control" is intercepting the C-s and not -letting it get through to Emacs. To unfreeze the screen, type C-q. -Then see the section "Spontaneous Entry to Incremental Search" in the -Emacs manual for advice on dealing with this "feature". - -If you are in the middle of an incremental search and type , -you'll notice that the last character in the search string is erased -and the search backs up to the last place of the search. For -instance, suppose you have typed "c", to search for the first -occurrence of "c". Now if you type "u", the cursor will move -to the first occurrence of "cu". Now type . This erases -the "u" from the search string, and the cursor moves back to -the first occurrence of "c". - -If you are in the middle of a search and type a control or meta -character (with a few exceptions--characters that are special in -a search, such as C-s and C-r), the search is terminated. - -The C-s starts a search that looks for any occurrence of the search -string AFTER the current cursor position. If you want to search for -something earlier in the text, type C-r instead. Everything that we -have said about C-s also applies to C-r, except that the direction of -the search is reversed. - - -* MULTIPLE WINDOWS ------------------- - -One of the nice features of Emacs is that you can display more than one -window on the screen at the same time. - ->> Move the cursor to this line and type C-u 0 C-l. - ->> Now type C-x 2 which splits the screen into two windows. - Both windows display this tutorial. The cursor stays in the top window. - ->> Type C-M-v to scroll the bottom window. - (If you do not have a real Meta key, type ESC C-v.) - ->> Type C-x o ("o" for "other") to move the cursor to the bottom window. ->> Use C-v and M-v in the bottom window to scroll it. - Keep reading these directions in the top window. - ->> Type C-x o again to move the cursor back to the top window. - The cursor in the top window is just where it was before. - -You can keep using C-x o to switch between the windows. Each -window has its own cursor position, but only one window actually -shows the cursor. All the ordinary editing commands apply to the -window that the cursor is in. We call this the "selected window". - -The command C-M-v is very useful when you are editing text in one -window and using the other window just for reference. You can keep -the cursor always in the window where you are editing, and advance -through the other window sequentially with C-M-v. - -C-M-v is an example of a CONTROL-META character. If you have a real -META key, you can type C-M-v by holding down both CTRL and META while -typing v. It does not matter whether CTRL or META "comes first," -because both of these keys act by modifying the characters you type. - -If you do not have a real META key, and you use ESC instead, the order -does matter: you must type ESC followed by CTRL-v; CTRL-ESC v will not -work. This is because ESC is a character in its own right, not a -modifier key. - ->> Type C-x 1 (in the top window) to get rid of the bottom window. - -(If you had typed C-x 1 in the bottom window, that would get rid -of the top one. Think of this command as "Keep just one -window--the window I am already in.") - -You do not have to display the same buffer in both windows. If you -use C-x C-f to find a file in one window, the other window does not -change. You can find a file in each window independently. - -Here is another way to use two windows to display two different -things: - ->> Type C-x 4 C-f followed by the name of one of your files. - End with . See the specified file appear in the bottom - window. The cursor goes there, too. - ->> Type C-x o to go back to the top window, and C-x 1 to delete - the bottom window. - - -* RECURSIVE EDITING LEVELS --------------------------- - -Sometimes you will get into what is called a "recursive editing -level". This is indicated by square brackets in the mode line, -surrounding the parentheses around the major mode name. For -example, you might see [(Fundamental)] instead of (Fundamental). - -To get out of the recursive editing level, type ESC ESC ESC. That is -an all-purpose "get out" command. You can also use it for eliminating -extra windows, and getting out of the minibuffer. - ->> Type M-x to get into a minibuffer; then type ESC ESC ESC to get out. - -You cannot use C-g to get out of a recursive editing level. This is -because C-g is used for canceling commands and arguments WITHIN the -recursive editing level. - - -* GETTING MORE HELP -------------------- - -In this tutorial we have tried to supply just enough information to -get you started using Emacs. There is so much available in Emacs that -it would be impossible to explain it all here. However, you may want -to learn more about Emacs since it has many other useful features. -Emacs provides commands for reading documentation about Emacs -commands. These "help" commands all start with the character -Control-h, which is called "the Help character". - -To use the Help features, type the C-h character, and then a -character saying what kind of help you want. If you are REALLY lost, -type C-h ? and Emacs will tell you what kinds of help it can give. -If you have typed C-h and decide you do not want any help, just -type C-g to cancel it. - -(Some sites rebind the character C-h. They really should not do this -as a blanket measure, so complain to the system administrator. -Meanwhile, if C-h does not display a message about help at the bottom -of the screen, try typing M-x help RET instead.) - -The most basic HELP feature is C-h c. Type C-h, a c, and a -command character or sequence, and Emacs displays a very brief -description of the command. - ->> Type C-h c Control-p. - The message should be something like - - C-p runs the command previous-line - -This tells you the "name of the function". Function names are used -mainly for customizing and extending Emacs. But since function names -are chosen to indicate what the command does, they can serve also as -very brief documentation--sufficient to remind you of commands you -have already learned. - -Multi-character commands such as C-x C-s and (if you have no META or -EDIT or ALT key) v are also allowed after C-h c. - -To get more information about a command, use C-h k instead of C-h c. - ->> Type C-h k Control-p. - -This displays the documentation of the function, as well as its -name, in an Emacs window. When you are finished reading the -output, type q to get rid of the help text. - -Here are some other useful C-h options: - - C-h f Describe a function. You type in the name of the - function. - ->> Try typing C-h f previous-line. - This prints all the information Emacs has about the - function which implements the C-p command. - - C-h a Hyper Apropos. Type in a keyword and Emacs will list - all the functions and variables whose names contain - that keyword. The commands that can be invoked with - Meta-x, an asterisk will be displayed to the left. - ->> Type C-h a newline. - -This displays a list of all functions and variables with "newline" in -their names. Press or click the middle mouse button to find -out more about a function or variable. Type `q' to exit hyper-apropos. - - -* CONCLUSION ------------- - -Remember, to exit Emacs permanently use C-x C-c. To exit to a shell -temporarily, so that you can come back in, use C-z. (under X, this -iconifies the current Emacs frame.) - -This tutorial is meant to be understandable to all new users, so if -you found something unclear, don't sit and blame yourself - complain! - - -COPYING -------- - -This tutorial descends from a long line of Emacs tutorials -starting with the one written by Stuart Cracraft for the original Emacs. -Ben Wing updated the tutorial for X Windows. Martin Buchholz and -Hrvoje Niksic added more corrections for XEmacs. - -This version of the tutorial, like GNU Emacs, is copyrighted, and -comes with permission to distribute copies on certain conditions: - -Copyright (c) 1985, 1996 Free Software Foundation - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and permission notice are preserved, - and that the distributor grants the recipient permission - for further redistribution as permitted by this notice. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last altered them. - -The conditions for copying Emacs itself are more complex, but in the -same spirit. Please read the file COPYING and then do give copies of -GNU Emacs to your friends. Help stamp out software obstructionism -("ownership") by using, writing, and sharing free software! diff --git a/etc/TUTORIAL.de b/etc/TUTORIAL.de deleted file mode 100644 index b0ef6d0..0000000 --- a/etc/TUTORIAL.de +++ /dev/null @@ -1,1159 +0,0 @@ -Copyright (c) 1997, Adrian Aichner . - -Copyright (c) 1985, 1996 Free Software Foundation, Inc. See end for conditions. - -Du betrachtest das Emacs Tutorial. -Dies sind die einführenden Übungen für Emacs. - -Emacs-Befehle verwenden generell entweder die CONTROL- (manchmal mit -CTRL oder CTL beschriftet, auf deutschen Tastaturen auch oft mit STRG) -oder die META-Taste. Auf manchen Tastaturen ist die META-Taste mit -ALT, EDIT oder sonstwie (z.B. ist auf einer Sun Tastatur die -Raute-Taste links vom SPACE Balken die META-Taste) beschriftet. Statt -jedesmal META oder CONTROL auszuschreiben, wenn wir wollen daß Du die -Taste drückst, verwenden wir folgende Abkürzungen: - -C- bedeutet: Halte die CONTROL-Taste während der Betätigung der - -Taste gedrückt. Also bedeutet C-f: Halte die CONTROL - Taste, während Du den Buchstaben f drückst. -M- bedeutet: Halte die META-Taste während der Betätigung der - -Taste gedrückt. Falls es keine META-Taste gibt, tippe - zuerst ESC (die ESCAPE-Taste) und danach die -Taste. - -Wichtig: Tippe C-x C-c, um die Emacs-Sitzung zu beenden (zwei -Zeichen). Die ">>" am linken Seitenrand deuten auf Anweisungen, die -Du probieren solltest. so z.B: -<> ->> Tippe nun C-v (Betrachte nächste Seite) um die nächste Seite zu - betrachten. (Also, halte die CONTROL-Taste gedrückt während - Du v tippst.) - Von jetzt an tu das bitte jeweils nachdem Du eine Seite - vollständig gelesen hast. - -Bitte beachte die Überlappung von zwei Zeilen wenn Du vorwärts -blätterst; dies erlaubt es, den Text fließend weiter zu lesen. - -Zuerst solltest Du wissen, wie man sich im Text von Stelle zu Stelle -bewegt. Du weißt bereits, wie man sich mit C-v eine Seite -weiterbewegt. Um eine Seite zurück zu gehen, tippe M-v (halte die -META-Taste gedrückt und tippe v oder tippe v wenn Deine Tastatur -keine META-, EDIT- oder ALT-Taste besitzt). - ->> Versuche ein paar Mal M-v und C-v zu tippen. - - -* ZUSAMMENFASSUNG ------------------ - -Die folgenden Befehle sind nützlich um Text seitenweise zu betrachten: - - C-v Eine Seite vorwärts blättern - M-v Eine Seite zurück blättern - C-l Bewegt den Bildschirminhalt um den Textzeiger in die - Bildmitte und baut den Bildschirm neu auf. - (Dies ist CONTROL-, nicht CONTROL-1.) - ->> Finde den Textzeiger und merke Dir den Text der ihm nahe ist. - Nun tippe C-l. - Finde den Textzeiger abermals und achte darauf daß er sich, - relativ zum Text, nicht bewegt hat. - - -* EINFACHE TEXTZEIGER-STEUERUNG -------------------------------- - -Das Bewegen von Bildschirminhalt zum nächsten ist nützlich, aber wie -bewegt man sich an eine bestimmte Stelle im Text? - -Dazu gibt es mehrere Möglichkeiten. Die einfachste ist die Befehle -C-p, C-b, C-f und C-n zu verwenden. Jeder dieser Befehle bewegt den -Textzeiger um eine Zeile bzw. Spalte in eine bestimmte Richtung. -Hier ist eine Tabelle welche die Bewegungsrichtung der vier Befehle -zeigt: - - Vorherige Zeile, C-p - : - : - Rückwärts, C-b .... Jetzige Textzeiger-Position .... Vorwärts, C-f - : - : - Nächste Zeile, C-n - ->> Bewege den Textzeiger mittels C-n oder C-p auf die mittlere Zeile - der obigen Tabelle. Dann zentriere das Diagramm mittels C-l im - Bildschirmfenster. - -Auf Englisch kann man sich diese Befehle leicht einprägen: P für -previous, N für next, B für backward und F für forward. Dies sind die -einfachen Befehle zur Bewegung des Textzeigers. Da Du sie ständig -benutzen wirst, solltest Du sie jetzt erlernen. - ->> Verwende einige C-n's um den Textzeiger auf diese Zeile zu - bringen. - ->> Bewege Dich mit C-f's in die Zeile und dann hinauf mit C-p's. - Beobachte das Verhalten von C-p, wenn Du Dich mitten in einer Zeile - befindest. - -Jede Textzeile endet mit einem Newline-Zeichen, welches sie von der -nächsten trennt. Auch die letzte Zeile in Deiner Datei sollte ein -Newline am Ende besitzen (obschon Emacs dieses nicht benötigt). - ->> Versuche C-b am Beginn einer Zeile. Es sollte Dich zum Ende der - vorigen Zeile bringen. Dies deshalb, weil es Dich über das - Newline-Zeichen zurückbewegt. - -C-f kann sich, wie C-b, über ein Newline hinwegbewegen. - ->> Tippe einige C-b's um ein Gefühl für die Position des Textzeigers - zu bekommen. Dann verwende C-f um ans Ende der Zeile zu gelangen. - Nun versuche ein weiteres C-f um in die nächste Zeile zu gelangen. - -Wenn Du Dich am Anfang oder Ende aus dem Bildschirm bewegst, schiebt -sich der Text ins Blickfeld. Diesen Vorgang nennt man Rollen oder -"scrolling". Er erlaubt Emacs den Textzeiger an die gewünschte -Stelle zu bringen, ohne ihn aus dem Bildschirmfenster zu bewegen. - ->> Versuche den Textzeiger mittels C-n aus dem Blickfeld zu bewegen - und beobachte was geschieht. - -Wenn Dir die zeichenweise Fortbewegung zu langsam ist, kannst Du -Dich Wort für Wort bewegen. M-f (META-f) geht ein Wort weiter und M-b -geht eins zurück. - ->> Tippe ein paar M-f's und M-b's. - -Wenn Du mitten in einem Wort bist, bringt Dich M-f an sein Ende. -Wenn Du auf Leerzeichen zwischen Worten stehst, bewegt Dich M-f zum -Ende des folgenden Wortes. M-b bewegt sich sinngemäß zurück. - ->> Versuche M-f und M-b einige Male, abgewechselt von C-f's und C-b's - so daß Du das Verhalten von M-f und M-b an verschiedenen Stellen - innerhalb und zwischen Wörtern beobachten kannst. - -Achte auf die Verwandtschaft von C-f und C-b auf der einen Seite und -M-f und M-b auf der anderen. Sehr oft werden META-Befehle für -Operationen mit Einheiten einer Sprache verwendet (Worte, Sätze, -Absätze), während CONTROL-Befehle unverändert mit den einfachen -Einheiten (Buchstaben, Zeilen, etc.) arbeiten. - -Diese Parallele ist auf Zeilen und Sätze anwendbar: C-a und C-e gehen -zum Anfang und Ende einer Zeile, M-a und M-e zum Anfang bzw. Ende -eines Satzes. - ->> Versuche ein paar C-a's und dann ein paar C-e's. - Versuche ein paar M-a's und dann ein paar M-e's. - -Schau wie mehrere C-a's nichts bewirken, mehrere M-a's sich aber Satz -für Satz weiterbewegen. Obwohl sich ihr Verhalten unterscheidet, -erscheint es natürlich. - -Die Stelle des Textzeigers im Text wird auch Punkt oder "point" -genannt. Der Textzeiger auf dem Bildschirm zeigt an welchem Punkt im -Text sich dieser befindet. - -Hier ist eine Zusammenfassung der einfachen Befehle zur Bewegung des -Textzeigers, inklusive der Befehle zur wort- und satzweisen Bewegung: - - C-f Gehe ein Zeichen weiter - C-b Gehe ein Zeichen zurück - - M-f Gehe ein Wort weiter - M-b Gehe ein Wort zurück - - C-n Gehe zur nächsten Zeile - C-p Gehe zur vorherigen Zeile - - C-a Gehe an den Anfang der Zeile - C-e Gehe an das Ende der Zeile - - M-a Gehe zurück zum Anfang des Satzes - M-e Gehe weiter zum Ende des Satzes - ->> Übe jetzt alle diese Befehle einige Male. - Es sind die am häufigsten benutzten. - -Zwei weitere wichtige Befehle zur Bewegung im Text sind M-< (META -kleiner), welcher an den Anfang des gesamten Texts springt, und M-> -(META größer), welcher an das Textende hüpft. - -Auf einigen deutschen Tastaturen ist ">" über "<", Du mußt also -möglicherweise die Shift-Taste drücken, um ein > zu tippen. Auf -solchen Tastaturen mußt Du auch für M-> die Shift-Taste drücken; ohne -Shift-Taste würdest Du sonst M-< tippen. - ->> Versuche jetzt M-< um an den Beginn dieser einführenden Übungen zu - gelangen. - Dann verwende C-v wiederholt um hierher zurück zu kommen. - ->> Versuche jetzt M-> um ans Ende der Übungen zu springen. - Benutzte M-v wiederholt um hierher zurück zu gelangen. - -Du kannst den Textzeiger auch mit den Pfeil-Tasten bewegen, falls -Deine Tastatur solche besitzt. Wir empfehlen das Erlernen von C-b, -C-f, C-n und C-p aus drei Gründen. Erstens funktionieren sie auf allen -Tastaturen. Zweitens wirst Du herausfinden, wenn Du einige Übung mit -Emacs bekommst, daß es schneller ist die CTRL-Tasten zu drücken als -die Pfeil-Tasten (weil Du Deine Hände nicht aus dem normalen -Fingersatz bringen mußt). Drittens: Hast Du die Verwendung der CTRL -Befehle erst zu Deiner Gewohnheit gemacht, wird es ein Leichtes -weitere Bewegungs-Befehle zu erlernen. - -Die meisten Emacs-Befehle akzeptieren ein numerisches Argument; -meistens dient dieses als Wiederholzähler. Dieses Argument übergibt -man mit C-u, gefolgt von einer Zahl, bevor man den jeweiligen Befehl -eingibt. Steht Dir eine META- (oder EDIT- oder ALT)-Taste zur -Verfügung, so kannst Du dieses Argument auch wie folgt eingeben: Tippe -die Ziffern während Du die META-Taste gedrückt hältst. Wir empfehlen -das Erlernen der C-u Methode, da sie überall funktioniert. - - -z.B., C-u 8 C-f bewegt den Textzeiger um acht Zeichen weiter. - ->> Versuche C-n und C-p mit numerischem Argument um den Textzeiger - mit nur einem Befehl nahe an diese Zeile heranzubringen. - -Die meisten Befehle verwenden ein Argument als Wiederholzähler. Einige -ausgenommene Befehle verwenden es anders. C-v und M-v sind unter den -Ausnahmen. Mit Argument rollen sie den Text um eben soviele Zeilen, -anstelle von Bildschirmseiten. z.B. C-u 4 C-v rollt den -Bildschirminhalt um 4 Zeilen. - ->> Versuche C-u 8 C-v nun aus. - -Dies sollte den Bildschirminhalt um acht Zeilen nach oben gerollt -haben. Wenn Du ihn wieder zurückrollen willst, kannst Du M-v ein -entsprechendes Argument geben. - -Verwendest Du das X Window System, so befindet sich wahrscheinlich ein -rechteckiger Balken, Rollbalken oder "scrollbar" genannt, rechts neben -dem Emacs-Fenster. Du kannst den Text auch durch Manipulieren dieses -Rollbalkens mit der Maus rollen. - ->> Versuche die mittlere Maustaste in der hervorgehobenen Fläche - innerhalb des Rollbalkens zu drücken. Dies sollte den Text mehr - oder weniger rollen, je nachdem wie hoch oder tief der Mauszeiger - auf dem Rollbalken positioniert ist. - ->> Bewege den Mauszeiger im Rollbalken etwa drei Zeilen unter das - obere Ende und drücke die linke Maus-Taste einige Male. - -* TEXTZEIGER STEUERUNG MIT EINEM X-TERMINAL -------------------------------------------- - -An einem X-Terminal wirst Du es wahrscheinlich einfacher finden die -Tasten des Tastenfeldes zur Textzeiger-Steuerung zu gebrauchen. Die -Links, Rechts, Auf und Ab Pfeil-Tasten steuern in die erwartete -Richtung; sie funktionieren exakt wie C-b, C-f, C-p und C-n, sind aber -leichter zu tippen und zu merken. Du kannst auch C-Links und C-Rechts -verwenden um wortweise zu springen. C-Auf und C-Ab bewegen den -Textzeiger blockweise (z.B. Absätze, wenn Du Text bearbeitest). -Die Tasten HOME (oder BEGIN, POS1) und END (oder ENDE) bringen Dich -zum Anfang oder Ende einer Zeile und C-HOME bzw. C-END bringen Dich -zum Anfang oder Ende der Datei. Hat Deine Tastatur PgUp (oder BILD -AUF) und PgDn (oder BILD AB) kannst Du diese wie M-v und C-v zum -seitenweisen Rollen verwenden. - -All diese Befehle nehmen numerische Argumente wie weiter oben -beschrieben. Du kannst diese Argumente mittels einer Abkürzung -eingeben: Drücke einfache die CONTROL- oder META-Taste während Du die -Ziffern tippst. z.B. um 12 Worte nach rechts zu gehen, tippe C-1 C-2 -C-Rechts. Beachte, daß dies ganz einfach, ohne Loslassen der -CONTROL-Taste, getippt werden kann. - -* WENN EMACS HÄNGT ------------------- - -Wenn Emacs auf Deine Befehle nicht mehr reagiert, kannst Du den Befehl -risikolos mit C-g unterbrechen. Mit C-g kann man Befehle abbrechen, -die zu lange dauern. - -Du kannst mit C-g auch ein numerisches Argument oder einen teilweise -eingegebenen Befehl, den Du nicht mehr ausführen willst, verwerfen. - ->> Tippe C-u 100 für ein numerisches Argument von 100, dann tippe - C-g. Nun tippe C-f. Es wird nur eine Bewegung um ein Zeichen - ausgeführt, da Du das Argument mit C-g verworfen hast. - -Hast Du fälschlich ein getippt, kannst Du es mit C-g loswerden. - - -* GESPERRTE BEFEHLE -------------------- - -Einige Emacs-Befehle sind "gesperrt", damit sie von Anfängern nicht -versehentlich benutzt werden können. - -Wenn Du einen der gesperrten Befehle tippst, zeigt Emacs die -Befehlsdokumentation und fragt um Bestätigung, daß der Befehl -tatsächlich ausgeführt werden soll. - -Wenn Du den Befehl wirklich probieren willst, tippe Space als Antwort -auf die Frage. Normalerweise, wenn Du den gesperrten Befehl nicht -ausführen willst, beantwortest Du die Frage mit "n". - ->> Tippe `C-x n p' (ein gesperrter Befehl), dann beantworte die Frage - mit n. - - -* FENSTER ---------- - -Emacs unterstützt mehrere Fenster, jedes mit unterschiedlichem Text. -Beachte, daß sich der Begriff "Fenster" in Emacs nicht auf -verschiedene, überlappende Fenster im Fenstersystem bezieht, sondern -auf verschiedene Teil-Fenster innerhalb eines X Fensters. (Emacs -unterstützt auch mehrere X-Fenster, oder "Rahmen" ("frames") in -Emacs-Terminologie. Dies wird später beschrieben.) - - C-x 1 Ein Fenster (d.h., Beende alle anderen Fenster). - -Dies ist CONTROL-x gefolgt von der Ziffer 1. C-x 1 erweitert das -Fenster mit dem Textzeiger, so daß es das ganze Emacs-Fenster -einnimmt. Alle anderen Fenster werden beendet. - ->> Bewege den Textzeiger auf diese Zeile und tippe C-u 0 C-l. - -(Denke daran, daß C-l den Bildschirminhalt neu aufbaut. Das -numerische Argument bedeutet: "Baue den Bildschirminhalt neu auf und -bewege die aktuelle Zeile ebensoviele Zeilen vom oberen -Bildschirmrand." C-u 0 C-l bedeutet also "Bau den Bildschirm, mit der -aktuellen Zeile ganz oben, neu auf.") - ->> Tippe CONTROL-x 2 - Beachte wie das Fenster schrumpft, während ein neues mit Teilen - derselben Datei erscheint. - ->> Tippe C-x 1 und sehe das neue Fenster verschwinden. - - -* EINFÜGEN UND LÖSCHEN ----------------------- - -Willst Du Text einfügen, so tippe ihn. Sichtbare Zeichen, wie A, -7, *, etc., werden von Emacs als Text betrachtet und unmittelbar -eingefügt. Tippe (die Rücklauf-Taste) um ein Newline -einzufügen. - -Mit kannst Du das zuletzt getippte Zeichen löschen. - ist eine Taste die möglicherweise mit "Del" oder "Entf" -beschriftet ist. In einigen Fällen dient die Backspace (Rückschritt) -Taste als , jedoch nicht immer! - -Allgemeiner ausgedrückt löscht das Zeichen unmittelbar vor -dem Textzeiger. - ->> Tu dies nun -- tippe einige Buchstaben, lösche sie dann durch - mehrmaliges Tippen von . Kein Grund zur Sorge diese Datei - zu verändern. Es ist Deine persönliche Kopie der "Einführenden - Übungen für Emacs". - -Wird eine Zeile zu lang für eine Bildschirm-Zeile, so wird die Zeile -auf der nächsten Bildschirm-Zeile fortgesetzt. Ein umgekehrter -Schrägstrich ("\") am rechten Rand zeigt an, daß die Zeile fortgesetzt -wird. - ->> Füge Text ein bis Du den rechten Rand erreichst und tippe weiter. - Du wirst bemerken, wie die Fortsetzungszeile erscheint. - ->> Verwende s bis die Zeile wieder auf eine Bildschirmzeile - paßt. Die Fortsetzungszeile verschwindet. - -Ein Newline-Zeichen kann wie jedes andere gelöscht werden. Das -Löschen des Newline-Zeichens fügt die umgebenden Zeilen zusammen. -Ist die entstehende Zeile zu lang für den Bildschirm, erscheint -wieder eine Fortsetzungszeile. - ->> Geh an den Anfang einer Zeile und tippe . Dies fügt die - Zeile an die vorhergehende an. - ->> Tippe um das Newline-Zeichen wieder einzufügen. - -Denke daran, daß die meisten Emacs-Befehle mittels eines Arguments -wiederholt werden können; Ein Textzeichen wird mittels Argument -mehrfach eingefügt. - ->> Versuch's einfach -- Tippe C-u 8 * um ******** einzufügen. - -Du hast jetzt die einfachsten Befehle zum Einfügen und Korrigieren von -Text gelernt. Du kannst auch ganze Worte oder Zeilen löschen. Hier -ist eine Zusammenfassung der Lösch-Befehle: - - Lösche das Zeichen vor dem Textzeiger - C-d Lösche das Zeichen nach dem Textzeiger - - M- Lösche das Wort vor dem Textzeiger - M-d Lösche das Wort nach dem Textzeiger - - C-k Lösche vom Textzeiger bis ans Zeilenende - M-k Lösche vom Textzeiger bis ans Satzende - -Beachte daß und C-d gegenüber M- und M-d die -Verwandtschaft von C-f und M-f fortsetzen ( ist zwar keine -CONTROL-Taste, aber das kümmert uns nicht). C-k und M-k verhalten -sich zueinander wie C-e und M-e zu Zeilen und Sätzen. - -Wenn Du mehr als ein Zeichen auf einmal löschst, speichert sie Emacs, -damit Du sie wieder abrufen kannst. Den gelöschten Text zurückzuholen -nennt man "yanking". Du kannst den gelöschten Text an der selben oder -an einer anderen Textstelle zurückholen. Der Text kann mehrere Male -zurückgeholt werden um Mehrfachkopien anzulegen. Der Zurückhol-Befehl -ist C-y. - -Beachte daß der Unterschied zwischen Entfernen ("Killing") und Löschen -("Deleting") darin besteht, daß gelöschte Teile zurückgeholt werden -können, während dies für entfernte Teile nicht möglich ist. Allgemein -speichern Befehle die viel Text löschen diesen auch, während Befehle, -die nur einzelne Zeichen oder Leerzeilen entfernen, diese nicht -speichern. - ->> Gehe zum Beginn einer nicht leeren Zeile. - Dann lösche den gesamten Text der Zeile mit C-k. ->> Tippe C-k ein zweites Mal. Du wirst sehen, daß dies das folgende - Newline-Zeichen löscht. - -Beachte, daß ein einzelnes C-k den Inhalt einer Zeile löscht, ein -zweites die Zeile selbst, so daß sich nachfolgende Zeilen nach oben -bewegen. Ein numerisches Argument wird von C-k besonders behandelt: -Es löscht ebensoviele Zeilen mitsamt Inhalt. Dies ist keine einfache -Wiederholung. C-u 2 C-k löscht zwei Zeilen und deren Inhalt; zwei -aufeinanderfolgende C-k würden dies nicht tun. - -Um den zuletzt gelöschten Text beim Textzeiger zurückzuholen, tippe -C-y. - ->> Versuch's; Tippe C-y um den Text zurückzuholen. - -Denke so über C-y als ob Du etwas zurückholst, das man Dir genommen -hat. Beachte, daß bei aufeinanderfolgenden C-k's der gelöschte Text in -einem Stück gespeichert wird, so daß ein C-y alle Zeilen zurück bringt. - ->> Tu's jetzt, tippe C-k mehrere Male. - -Nun das Zurückholen des gelöschten Texts: - ->> Tippe C-y. Dann gehe einige Zeilen nach unten und tippe wieder C-y. - Jetzt siehst Du, wie man Text kopiert. - -Was machst Du, wenn Du Text zum Zurückholen hast, dann aber etwas -anderes löscht? C-y würde das zuletzt Gelöschte zurückbringen. Aber -der zuvor gelöschte Text ist nicht verloren. Du kannst Ihn mit M-y -zurückholen. Nachdem Du C-y getippt hast, kannst Du mit M-y den -zurückgeholten Text durch früher gelöschten Text ersetzten. Tippst Du -M-y wieder und wieder, holst Du früher und früher Gelöschtes zurück. -Hast Du den gewünschten Text erreicht, brauchst Du nichts weiter zu -tun um diesen zu behalten. Fahre mit Deiner Arbeit fort und laß den -zurückgeholten Text wo er ist. - -Verwendest Du M-y oft genug, kehrst Du an den Anfang zurück (der -letzte Löschvorgang). - ->> Lösche eine Zeile, bewege Dich im Text, lösche eine weitere Zeile. - Dann tippe C-y um die zuletzt gelöschte Zeile zurückzuholen. - Darauf verwende M-y und die zuerst gelöschte Zeile ersetzt den - zuvor zurückgeholten Text. Verwende weitere M-y's und sieh was - passiert. Fahre fort bis die zweite Zeile wiederkehrt und versuche - noch einige M-y's. - Wenn Du willst, kannst Du M-y positive und negative Argumente - geben. - - -* RÜCKGÄNGIG MACHEN -------------------- - -Veränderst Du Text und entscheidest Du dann, daß dies ein Fehler war, -kannst Du die Änderungen mit C-x u rückgängig machen. - -Üblicherweise macht C-x u die Änderungen des letzten Befehls -rückgängig; wenn Du C-x u mehrmals wiederholst, wird jeweils ein -weiterer Befehl rückgängig gemacht. - -Aber es gibt zwei Ausnahmen: Befehle, die keinen Text verändern, -zählen nicht (dies schließt Befehle zum Bewegen und Rollen des -Textzeigers ein) und selbsteinfügende Befehle werden üblicherweise in -Zwanziger-Gruppen behandelt. (Dies dient dazu, die Anzahl der C-x u's -zu reduzieren die Du tippen mußt um eingetippten Text rückgängig zu -machen.) - ->> Lösche diese Zeile mit C-k, dann tippe C-x u und sie sollte - wiedererscheinen. - -C-_ ist ein alternativer rückgängig (undo) Befehl; er funktioniert wie -C-x u, ist aber einfacher zu Wiederholen. Der Nachteil ist, daß C-_ -auf einigen Tastaturen nicht direkt getippt werden kann. Deshalb gibt -es C-x u. Auf einigen Tastaturen kann man C-_ als C-\ tippen. - -Ein numerisches Argument für C-_ oder C-x u dient als Wiederholwert. - - -* DATEIEN ---------- - -Um an einem Text bleibende Änderungen vorzunehmen, mußt Du ihn in -einer Datei speichern. Sonst gehen Deine Änderungen mit dem Beenden -von Emacs verloren. Du legst Deine Arbeit in einer Datei ab, indem Du -eine Datei "findest". (Man nennt dies auch das "Besuchen" -("visiting") einer Datei.) - -Das Finden einer Datei bedeutet, daß Du ihren Inhalt mit Emacs -betrachtest. In vielfacher Hinsicht ist es, als würdest Du die Datei -selbst bearbeiten. Jedoch sind Deine Änderungen nicht permanent bis -Du die Datei sicherst. Damit kannst Du verhindern halb-fertige -Dateien auf dem System abzulegen, wenn Du dies nicht willst. Sogar -beim Abspeichern hinterläßt Emacs die Originaldatei unter verändertem -Namen falls Du später entscheiden solltest, daß die Änderungen ein -Fehler waren. - -Nahe dem unteren Ende des Bildschirms siehst Du eine Zeile die mit -Bindestrichen beginnt und endet und den Text "XEmacs: TUTORIAL.de" -enthält. Dieser Teil des Bildschirms zeigt immer den Namen der -besuchten Datei. Zur Zeit besuchst Du eine Datei namens "TUTORIAL.de", -welche Deine persönliche Kopie des Emacs Tutorials ist. Was immer für -eine Datei Du findest, ihr Name wird immer an dieser Stelle -erscheinen. - -Die Befehle zum Finden und Sichern von Dateien sind anders als die -bisher erlernten, da sie jeweils aus zwei Zeichen bestehen. Beide -beginnen mit dem Zeichen CONTROL-x. Es gibt eine ganze Reihe von -Befehlen, die mit CONTROL-x beginnen; viele haben mit Dateien, Buffern -und verwandten Dingen zu tun. Diese Befehle sind zwei, drei oder vier -Zeichen lang. - -Bei Befehlen zum Finden einer Datei mußt Du außerdem den Dateinamen -angeben. Wir sagen: "Der Befehl liest ein Argument vom Terminal." (In -diesem Fall ist das Argument der Dateiname). Nachdem Du folgenden -Befehl tippst - - C-x C-f Finde eine Datei - -bittet Dich Emacs, einen Dateinamen einzugeben. Der Dateiname den Du -tippst erscheint am unteren Ende des Emacs-Fensters. Diese unterste -Zeile wird Minibuffer genannt, wenn sie für diese Art Eingabe -verwendet wird. Du kannst die üblichen Emacs-Befehle zum -Bearbeiten des Dateinamens verwenden. - -Während Du den Dateinamen eingibst (oder bei jeder anderen -Minibuffer-Eingabe) kannst Du den Befehl mit C-g abbrechen. - ->> Tippe C-x C-f, dann tippe C-g. Dies beendet den Minibuffer und - bricht den C-x C-f Befehl ab, der den Minibuffer benutzte. Du wirst - also keine Datei finden. - -Wenn Du mit dem Bearbeiten des Dateinamens fertig bist, tippe -um die Eingabe zu beenden. Der C-x C-f Befehl beginnt seine Arbeit -und findet die Datei Deiner Wahl. Der Minibuffer verschwindet, wenn -der C-x C-f Befehl beendet ist. - -Nach kurzer Zeit erscheint der Inhalt der Datei auf dem Bildschirm und -Du kannst diesen bearbeiten. Wenn Du Deine Änderungen sichern willst, -tippe den Befehl - - C-x C-s Sichere die Datei - -Das kopiert den Text von Emacs in die Datei. Geschieht dies das erste -Mal so benennt Emacs die Originaldatei um, so daß sie nicht verloren -geht. Der neue Name entsteht durch Anhängen von "~" am Ende des -Originalnamens. - -Ist der Sicherungsvorgang beendet, gibt Emacs den Namen der Datei an. -Du solltest recht oft sichern, damit Du nicht viel Arbeit verlierst, -sollte das System abstürzen. - ->> Tippe C-x C-s um Deine Kopie des tutorials zu sichern. - Dies sollte "Wrote ...TUTORIAL.de" am Fuß des Bildschirms ausgeben. - -ACHTUNG: Auf manchen Systemen wird C-x C-s den Bildschirm anhalten und -Du wirst keine weitere Ausgabe von Emacs sehen. Dies bedeutet, daß -auf Deinem System eine Betriebssystemeigenschaft ("feature") namens -Flußsteuerung ("flow control") das C-s abfängt und nicht an Emacs -weitergibt. Tippe C-q, um den Effekt aufzuheben, so daß der Bildschirm -wieder reagiert. Schau dann unter "Spontaneous Entry to Incremental -Search" im Emacs Manual nach, um Hilfe im Umgang mit diesem "Vorzug" -("feature") zu bekommen. - -Du kannst eine existierende Datei finden, um sie zu betrachten. Du -kannst aber auch eine Datei "finden", die es noch nicht gibt. So -erstellt man eine neue Datei mit Emacs: finde die Datei, welche -anfänglich leer ist, dann tippe den Text für die Datei ein. Wenn Du -danach sicherst, wird Emacs die Datei tatsächlich anlegen und Deinen -eingetippten Text darin ablegen. Von da an arbeitest Du an einer -existierenden Datei. - - -* BUFFER --------- - -Findest Du eine weitere Datei mit C-x C-f, bleibt die erste in Emacs -erhalten. Du kannst zu dieser mit C-x C-f zurückschalten. Auf diese -Art kannst Du eine erhebliche Anzahl von Dateien in Emacs verfügbar -haben. - ->> Erstelle eine Datei namens "foo" durch Eintippen von C-x C-f foo - . - Dann füge etwas Text ein, bearbeite ihn und sichere die Datei "foo" - mit C-x C-s. - Schließlich tippe C-x C-f TUTORIAL.de um zum Tutorial zurück - zu gelangen. - -Emacs hält den Text jeder Datei in einem Objekt namens "buffer". Das -Finden einer Datei legt in Emacs einen neuen Buffer an. Um eine Liste -aller Buffer in Deiner Emacs-Sitzung zu erhalten tippst Du - - C-x C-b Liste alle Buffer - ->> Probiere C-x C-b jetzt aus. - -Beachte, daß jeder Buffer einen Namen hat. Wenn der Buffer einer Datei -zugeordnet ist, wird auch der Dateiname angezeigt. Einige Buffer haben -keine Entsprechung im Dateisystem. So hat z.B. der Buffer namens -"*Buffer List*" keine zugeordnete Datei. Dieser Buffer enthält die -Liste der Buffer, die mit C-x C-b erstellt wurde. JEDER Text in Emacs -ist Teil irgendeines Buffers. - ->> Tippe C-x 1 um die Bufferliste loszuwerden. - -Wenn Du Änderungen in einer Datei vornimmst, dann eine andere findest, -so wird der Inhalt der ersten nicht gesichert. Die Änderungen bleiben -innerhalb von Emacs im zugeordneten Buffer erhalten. Das Bearbeiten -einer weiteren Datei hat keinen Einfluß auf den Buffer der ersten. -Dies ist sehr nützlich, man braucht aber auch eine angenehme -Möglichkeit, den Buffer der ersten Datei zu sichern. Es wäre lästig, -müßte man mit C-x C-f zur ersten Datei zurückgehen, um diese dann mit -C-x C-s zu sichern. Darum haben wir - - C-x s Sichere mehrere Buffer - -C-x s befragt Dich zu jedem Buffer, der ungesicherte Änderungen -enthält. Für jeden einzelnen wirst Du gefragt ob Du Ihn sichern -willst. - ->> Füge eine Text-Zeile ein, dann tippe C-x s. - Du wirst gefragt, ob Du den Buffer namens TUTORIAL.de speichern - willst. - -* VERWENDUNG DES MENÜS ----------------------- - -An einem X-Terminal wirst Du eine Menüleiste am oberen Ende des Emacs- -Fensters bemerken. Mit der Menüleiste kannst Du die allgemeinsten -Emacs-Befehle, wie "Finde Datei" ("find file"), erreichen. Du wirst -dies anfänglich einfacher finden, da Du Dir die notwendigen Tasten- -kombinationen der Befehle nicht merken mußt. Bist Du einmal mit Emacs -vertraut, wird es ein Leichtes sein die Kommandos zu benutzen, da -jeder Menüeintrag, der einer Tastenkombination entspricht, diese auch -anzeigt. - -Beachte, daß es viele Menüeinträge ohne entsprechende Tastensequenz -gibt. So listet z.B. das Buffers-Menü die verfügbaren Buffer in -letzt-benutzter Reihenfolge. Du kannst zu jedem Buffer über den -Eintrag im Buffers-Menü gelangen. - -* VERWENDUNG DER MAUS ---------------------- - -Unter X Windows hat Emacs volle Maus-Unterstützung. Der Textzeiger -kann durch Drücken der linken Maustaste an der gewünschten Stelle des -Mauszeigers dorthin gesetzt werden. Text kann durch Ziehen des -Mauszeigers bei gedrückter linker Maustaste selektiert werden. -(Oder man klickt die linke Maustaste an der einen Stelle im Text und -verwendet SHIFT-Klick an der anderen um den dazwischenliegenden Text -zu selektieren.) - -Um selektierten Text zu löschen kannst Du C-w benutzen, oder den -Menüeintrag "Cut" im Edit-Menü verwenden. Beachte, daß diese -Methoden nicht gleichbedeutend sind: C-w sichert den Text nur -innerhalb von Emacs (ähnlich wie oben unter C-k beschrieben), während -Cut den Text auch im X Clipboard ablegt, von wo ihn andere Programme -abholen können. - -Verwende "Paste" im Edit-Menü um Text vom X Clipboard zurückzuholen. - -Die mittlere Maustaste wird häufig verwendet um sichtbare Objekte auf -dem Bildschirm auszuwählen. Wenn Du z.B. "Info" (die Emacs Online -Dokumentation) mit C-h i oder über das Help-Menü aufrufst, kannst Du -einer hervorgehobenen Verknüpfung durch Klicken der mittleren -Maustaste folgen. Ganz ähnlich, wenn Du einen Dateinamen eingibst -(z.B. wenn von "Find File" gefragt) und TAB tippst um die möglichen -Vervollständigungen zu erhalten, kannst Du mit der mittleren Maus die -gewünschte Vervollständigung wählen. - -Die rechte Maustaste zeigt ein Popup-Menü. Der Inhalt des Menüs -variiert abhängig vom gewählten Modus und zeigt für gewöhnlich einige -häufig benutzte Befehle, die so einfacher benutzt werden können. - ->> Drücke jetzt die rechte Maustaste. - -Du mußt die Taste gedrückt halten, damit das Menü nicht gleich wieder -verschwindet. - -* ERWEITERUNG DES BEFEHLSSATZES -------------------------------- - -Es gibt viel mehr Emacs-Befehle als man auf allen CONTROL- und -META-Zeichen unterbringen könnte. Emacs löst dieses Problem mit dem X -(eXtend) Befehl. Davon gibt es zwei Ausführungen: - - C-x Zeichenerweiterung eXtend. Gefolgt von einer - Tastenkombination. - M-x Namenserweiterung eXtend. Gefolgt von einer - ausgeschriebenen Befehlsbezeichnung. - -Diese Befehle sind zwar im Allgemeinen nützlich, werden aber seltener -verwendet als die bereits erlernten Befehle. Zwei von ihnen hast Du -bereits kennengelernt: Die Befehle C-x C-f zum Finden und C-x C-s -zum Sichern von Dateien. Ein anderes Beispiel ist der Befehl zum Beenden -einer Emacs-Sitzung -- dieser Befehl ist C-x C-c. (Habe keine Angst, -ungesicherte Änderungen zu verlieren; C-x C-c bietet die Möglichkeit zum -Sichern einer jeden geänderten Datei bevor Emacs beendet wird.) - -Mit C-z kann man Emacs vorübergehend verlassen -- so daß Du später zur -gleichen Sitzung zurückkehren kannst. - -Auf Systemen, die dies unterstützen, sendet C-z Emacs "in den -Hintergrund"; man kehrt zur Shell zurück, ohne daß der Emacs-Prozeß -beendet wird. In den gebräuchlichsten Shells kann man zu Emacs mit -`fg' oder `%emacs' zurückkehren. - -Auf Systemen, die dieses Aussetzen von Emacs nicht unterstützen, -startet C-z eine s.g. Sub-Shell von der aus Du Programme starten und -danach zu Emacs zurückkehren kannst; Emacs wird in diesem Fall nicht -wirklich verlassen. Der Shell-Befehl `exit' ist in diesem Fall der -üblichste um zu Emacs zurückzukehren. - -C-x C-c verwendet man unmittelbar bevor man das System verlassen will. -Es ist auch die richtige Methode um einen Emacs zu verlassen der für -E-mail-Programme, oder andere Erweiterungen, die das Aussetzen von -Emacs nicht korrekt handhaben können, benutzt wird. Normalerweise -ist es besser Emacs mit C-z auszusetzen statt ihn zu beenden, wenn -man das System nicht verlassen will. - -Es gibt viele C-x-Befehle. Hier ist eine Liste der bereits erlernten: - - C-x C-f Finde Datei. - C-x C-s Sichere Datei. - C-x C-b Liste alle Buffer. - C-x C-c Beende Emacs. - C-x u Rückgängig machen (Undo). - -Namenserweiterte Befehle (eXtended commands) sind solche, die weniger -häufig oder nur in einem bestimmten Modus verwendet werden. Ein -Beispiel ist der Befehl replace-string, der einen Text durch einen -anderen ersetzt. Wenn Du M-x tippst, zeigt dies Emacs am unteren Ende -des Emacs-Fensters mit M-x an und Du solltest den Namen des Befehls -eintippen; in diesem Fall "replace-string". Tippe einfach -"repl s" und Emacs wird den Namen vervollständigen. Beende den -Befehlsnamen mit . - -Der replace-string Befehl braucht zwei Argumente -- den zu ersetzenden -Text und den Ersatz-Text. Jedes Argument muß mit beendet -werden. - ->> Gehe zur Leerzeile zwei Zeilen unter dieser. - Dann tippe M-x repl sveraendertgeaendert. - - Beachte wie diese Zeile sich veraendert hat: Du hast das Wort - v-e-r-a-e-n-d-e-r-t mit "geaendert" ersetzt wo immer es nach der - anfänglichen Textzeiger-Position auftrat. - - -* AUTOMATISCHE SICHERUNG ------------------------- - -Wenn Du Änderungen in einer Datei vornimmst, diese aber noch nicht -gesichert hast, so können diese bei einem Computerabsturz verloren -gehen. Um Dich davor zu schützen, schreibt Emacs regelmäßig eine -Autosave-Datei für jede Datei, die Du bearbeitest. Autosave-Dateien -beginnen und enden mit "#"; wenn Deine Datei z.B. "hello.c" heißt, so -heißt ihre auto-save Datei "#hello.c#". Sicherst Du die Datei, so -löscht Emacs die entsprechende auto-save Datei. - -Nach einem Computerabsturz kannst Du die automatisch -gesicherten Änderungen nach dem normalen Finden der Datei (Deiner -Datei, nicht der Autosave-Datei) durch Eintippen von M-x -recover-file zurückholen. Wenn Du nach der Bestätigung -gefragt wirst, tippst Du yes um die Änderungen in der -Autosave-Datei wiederherzustellen. - - -* ECHO BEREICH --------------- - -Wenn Emacs bemerkt, daß Du Befehle langsam tippst, werden Dir diese am -Fuß des Emacs-Fensters in der s.g. "echo area" angezeigt. Die echo -area nimmt die unterste Zeile im Emacs-Fenster ein. - - -* MODUSZEILE ------------- - -Die Zeile über der echo area wird "mode line" genannt. Die Moduszeile -zeigt etwa folgendes: - ---**-XEmacs: TUTORIAL.de (Fundamental)--L791--67%---------------- - -Diese Zeile gibt nützliche Information über den Zustand von Emacs und -dem Text, den Du bearbeitest. - -Du kennst bereits die Bedeutung des Dateinamens -- es ist die Datei, -die Du gefunden hast. -NN%-- zeigt Deine Position im Text; dies -bedeutet daß NN Prozent des Texts oberhalb des sichtbaren Bereiches -liegen. Bist Du am Beginn, so erscheint --Top-- anstelle von --00%--. -Bist Du am Ende des Texts, so erscheint --Bot--. Ist der gesamte Text -sichtbar, so erscheint --All--. - -Die Sterne nahe dem Beginn der Moduszeile bedeuten, daß der Text -verändert wurde. Unmittelbar nach dem Besuchen oder Sichern einer -Datei, zeigt dieser Bereich keine Sterne, sondern Bindestriche. - -Der Teil der Moduszeile innerhalb der Klammern gibt Auskunft über die -Bearbeitungs-Modi, die Du derzeit verwendest. Der Ausgangsmodus ist -Fundamental -- der, den Du jetzt gerade benutzt. Er ist ein Beispiel -für einen Hauptmodus ("major mode"). - -Emacs besitzt viele verschiedene Hauptmodi. Einige von ihnen sind zum -Bearbeiten von verschiedenen Computersprachen und/oder Textformaten, -wie z.B. Lisp-Modus, Text-Modus, etc., gedacht. Es ist immer nur ein -Hauptmodus aktiv und sein Name kann dort gefunden werden, wo jetzt -"Fundamental" steht. - -Jeder Hauptmodus ändert das Verhalten einiger Befehle. So gibt es -z.B. Befehle zum Erstellen von Kommentaren in Programmen. Da diese -in jeder Programmiersprache unterschiedlich aussehen, muß jeder -Hauptmodus diese Kommentare entsprechend vorbereiten. Jeder -Hauptmodus trägt den Namen eines entsprechenden Erweiterungsbefehls, so -kann man ihn wählen. So ist z.B. M-x fundamental-mode der Befehl, um -in den Fundamental-Modus zu schalten. - -Wenn Du deutschen Text bearbeitest, wie in diesem Fall, solltest Du -wahrscheinlich den Text-Modus verwenden. - ->> Tippe M-x text-mode. - -Keine Sorge, keiner der bis jetzt erlernten Befehle ändert Emacs -grundlegend. Du kannst aber beobachten, daß M-f und M-b Gänsefüßchen -jetzt als Teil von Worten betrachten. Zuvor, im Fundamental-Modus, -haben M-f und M-b diese als Wort-Separatoren betrachtet. - -Hauptmodi machen im Allgemeinen kleine Änderungen wie diese: die -meisten Befehle erfüllen den selben Zweck, aber sie funktionieren -etwas anders. - -Um Dokumentation über den aktuellen Hauptmodus zu bekommen, kannst Du -immer C-h m verwenden. - ->> Verwende C-u C-v ein- oder mehrmals um diese Zeile ans obere Ende - des Emacs-Fensters zu bekommen. ->> Tippe C-h m um den Unterschied zwischen Text- und Fundamental-Modus - zu sehen. ->> Tippe C-x 1 um die Dokumentation wieder verschwinden zu lassen. - -Hauptmodi heißen so, weil es auch Untermodi gibt. Untermodi sind keine -Alternativen zu Hauptmodi, sondern bewirken kleine Veränderungen -derselben. Jeder Untermodus kann für sich allein, unabhängig von -allen Haupt- und Untermodi, ein und ausgeschaltet werden. Du kannst -also jederzeit keinen, einen, oder beliebig viele Untermodi verwenden. - -Ein sehr nützlicher Untermodus, speziell für deutschen Text, ist der -Automatische-Zeilenumbruch-Modus (auto fill). Ist dieser Modus aktiv, -bricht Emacs überlange Zeilen automatisch zwischen zwei Worten um. - -Du kannst den Modus mit M-x auto-fill-mode einschalten. Ist -der Modus aktiv, kannst Du ihn mit M-x auto-fill-mode wieder -ausschalten. Wir sagen der Befehl "toggelt" den Modus. - ->> Tippe jetzt M-x auto-fill-mode. Dann füge "asdf " - wiederholt ein, bis die Zeile, zu lang geworden, umgebrochen - wird. Du mußt die Leerzeichen einfügen, weil Auto Fill Zeilen nur an - diesen Zeichen umbricht. - -Die Umbruchspalte steht üblicherweise bei 70 Zeichen, aber Du kannst -dies mit dem C-x f Befehl ändern. Die gewünschte Umbruchspalte wird -als numerisches Argument übergeben. - ->> Tippe C-x f mit einem Argument von 20. (C-u 2 0 C-x f). - Danach tippe etwas Text, um zu sehen wie Emacs die Zeilen jetzt bis - Spalte 20 füllt. Dann setze den Zeilenumbruch zurück auf 70. - -Machst Du Änderungen mitten im Absatz, so wird der automatische Umbruch -diesen nicht für Dich auffüllen. Um den Absatz aufzufüllen, tippe M-q -(META-q) während der Textzeiger in diesem Absatz steht. - ->> Bewege den Textzeiger in den vorherigen Absatz und tippe M-q. - - -* SUCHEN --------- - -Emacs kann nach Zeichenketten ("Strings", dies sind Gruppen von -zusammenhängenden Buchstaben oder Worten) entweder vorwärts oder -rückwärts durch den Text suchen. Suchen nach einem String ist ein -Befehl, der den Textzeiger bewegt; er bewegt den Textzeiger zur -nächsten Stelle an der ein bestimmter String vorkommt. - -Der Emacs Suchbefehl unterscheidet sich von denen der meisten anderen -Editoren, da er "inkrementell" ist. Dies bedeutet, daß das Suchen -während der Eingabe des Such-Strings passiert. - -Der Befehl um eine Suche auszulösen ist C-s für vorwärtiges und C-r -für rückwärtiges Suchen. ABER WARTE! Versuche die Befehle noch nicht. - -Wenn Du C-s tippt, wirst Du den String "I-search" in der echo area -bemerken. Dies bedeutet, daß Emacs im inkrementellen Suchmodus auf -Deine Eingabe wartet. bricht die Suche ab. - ->> Nun tippe C-s um die Suche einzuleiten. LANGSAM, Buchstabe für - Buchstabe, tippe das Wort 'Textzeiger', mit Pausen dazwischen, - damit Du beobachten kannst, was mit dem Textzeiger basiert. - Du hast jetzt einmal nach "Textzeiger" gesucht. ->> Tippe erneut C-s, um nach dem nächsten Vorkommen von "Textzeiger" - zu suchen. ->> Nun tippe viermal und schau wie sich der Textzeiger - bewegt. ->> Tippe zum Abbrechen der Suche. - -Hast Du gesehen was passiert? Emacs, in der inkrementellen Suche, -versucht zu dem String zu springen, den Du bisher getippt hast. Um -zum nächsten Auftreten von "Textzeiger" zu gelangen, tippst Du einfach -wieder C-s. Gibt es kein weiteres Vorkommen, so piepst Emacs und -zeigt die Suche als fehlgeschlagen an. C-g bricht die Suche auch ab. - -ACHTUNG: Auf manchen Systemen wird C-s den Bildschirm anhalten und Du -wirst keine weitere Ausgabe von Emacs sehen. Dies bedeutet, daß auf -Deinem System eine Betriebssystemeigenschaft ("feature") namens -Flußsteuerung ("flow control") das C-s abfängt und nicht an Emacs -weitergibt. Tippe C-q, um den Effekt aufzuheben, so daß der Bildschirm -wieder reagiert. Schau dann unter "Spontaneous Entry to Incremental -Search" im Emacs Manual nach, um Hilfe im Umgang mit diesem "Vorzug" -("feature") zu bekommen. - -Wenn Du in der Mitte einer inkrementellen Suche tippst, wirst -Du bemerken, wie der letzte Such-Buchstabe entfernt wird und die Suche -an die letzte Stelle der Suche zurück springt. Nehmen wir z.B. an, Du -hast "T" getippt, um nach dem ersten Auftreten von "T" zu suchen. Wenn -Du jetzt "e" tippst, springt der Textzeiger zum ersten Auftreten von -"Te". Tippe nun . Dies entfernt das "e" von Such-String und -der Textzeiger springt zurück zum ersten Vorkommen von "T". - -Wenn Du mitten in einer Suche ein CONTROL- oder META-Zeichen tippst -(mit wenigen Ausnahmen -- Buchstaben mit Sonderbedeutung bei der -Suche, so wie C-s und C-r), wird die Suche abgebrochen. - -C-s startet eine Suche NACH der aktuellen Textzeiger Position. Willst -Du etwas früher im Text finden, tippe stattdessen C-r. All das was -wir über C-s gesagt haben gilt auch für C-r, nur daß die Suchrichtung -umgedreht wird. - - -* MEHRERE FENSTER ------------------ - -Einer der netten Vorzüge von Emacs ist es, daß Du mehr als jeweils ein -Fenster am Bildschirm darstellen kannst. - ->> Bewege den Textzeiger auf diese Zeile und tippe C-u 0 C-l. - ->> Nun tippe C-x 2, was das Emacs-Fenster zweiteilen wird. - Beide Fenster zeigen dieses Tutorial. Der Textzeiger bleibt im - oberen Fenster. - ->> Tippe C-M-v um beide Fenster zu rollen. - (Hast Du keine echte META-Taste, tippe Esc C-v.) - ->> Tippe C-x o ("o" für "other" oder anderes) um den Textzeiger ins - andere (untere) Fenster zu bewegen. ->> Verwende C-v und M-v im unteren Fenster um dieses zu rollen. - Lies diese Anweisungen im oberen Fenster weiter. - ->> Tippe C-x o um wieder zurück ins obere Fenster zu gelangen. - Der Textzeiger im oberen Fenster ist noch immer wo er vorher war. - -Du kannst weiterhin mit C-x o zwischen den Fenstern umschalten. Jedes -Fenster hat seine eigene Textzeiger-Position, aber nur ein Fenster -zeigt diese auch an. Alle üblichen Bearbeitungs-Befehle beziehen sich -auf das Fenster mit dem Textzeiger. Wir nennen es das "selektierte -Fenster". - -Der Befehl C-M-v ist sehr hilfreich wenn Du in einem Fenster Text -bearbeitest und das andere als Referenz verwendest. Du kannst den -Textzeiger immer im oberen Fenster lassen, und Dich mit C-M-v durch -das andere Fenster bewegen. - -C-M-v ist ein Beispiel für einen CONTROL-META-Zeichen. Wenn Du eine -echte META-Taste hast, kannst Du sowohl CTRL als auch META gedrückt -halten, während Du v tippst. Es kommt nicht darauf an ob CTRL oder -META zuerst gedrückt wird, weil beide dazu dienen um den gedrückten -Buchstaben zu verändern. - -Hast Du keine echte META-Taste und Du verwendest stattdessen ESC, ist -die Reihenfolge nicht egal: zuerst tippst Du ESC, gefolgt von CTRL-v; -CTRL-ESC v wird nicht funktionieren. Dies ist so weil ESC ein -eigenständiges Zeichen ist und keine Modifikations-Taste. - ->> Tippe C-x 1 (im oberen Fenster) um das untere Fenster loszuwerden. - -(Hättest Du C-x 1 im unteren Fenster getippt, wäre das obere Fenster -verschwunden. Merke Dir den Befehl mit "Behalte nur ein Fenster -- -das aktuelle Fenster.") - -Du mußt nicht denselben Buffer in beiden Fenstern anzeigen. Wenn Du -C-x C-f zum Finden einer Datei in einem Fenster verwendest, verändert -sich das andere Fenster nicht. Du kannst in jedem Fenster unabhängig -eine Datei finden. - -Hier ist eine andere Möglichkeit zwei Fenster zum Anzeigen -verschiedener Dinge zu nutzen: - ->> Tippe C-x 4 C-f gefolgt vom Namen einer Deiner Dateien. - Beende mit . Schau wie die angegebene Datei im unteren - Fenster erscheint. Auch der Textzeiger folgt dorthin. - ->> Tippe C-x o um ins obere Fenster zurückzukehren und beende das - untere Fenster mit C-x 1. - - -* REKURSIVE BEARBEITUNGSEBENEN ------------------------------- - -Manchmal wirst Du in sogenannte rekursive Bearbeitungsebenen -gelangen. Dies wird durch eckige Klammern in der Moduszeile angezeigt, -welche den Namen des Hauptmodus umgeben. Du könntest -z.B. [(Fundamental)] anstelle von (Fundamental) sehen. - -Um aus der rekursiven Bearbeitungsebene zu gelangen, tippst Du ESC -ESC ESC. Dies ist ein allgemeiner Ausstiegs- oder "get out"-Befehl. -Du kannst ihn auch verwenden, um unnötige Fenster loszuwerden und um -aus dem Minibuffer zu gelangen. - ->> Tippe M-x um in den Minibuffer zu gelangen; dann ESC ESC ESC um - auszusteigen. - -Du kannst nicht mit C-g aus einer rekursiven Bearbeitungs-Ebene -gelangen. Dies deshalb, weil C-g zum Beenden von Befehlen und -Argumenten INNERHALB von rekursiven Bearbeitungs-Ebenen dient. - - -* WEITERFÜHRENDE HILFE ----------------------- - -In diesen einführenden Übungen haben wir versucht, gerade genug -Information zu liefern, damit Du beginnen kannst mit Emacs zu -arbeiten. Emacs ist so umfangreich, daß es unmöglich wäre, alles -hier zu erklären. Allerdings solltest Du versuchen, mehr über Emacs zu -lernen, da er so viele nützliche Vorzüge besitzt. Emacs bietet -Befehle zum Lesen der Emacs-Befehlsdokumentation. Diese Hilfe- oder -"help" Befehle beginnen alle mit dem Buchstaben CONTROL-h, den wir auch -das "Hilfe-Zeichen" nennen. - -Um die Hilfeeinrichtungen zu verwenden, tippe C-h, gefolgt von einem -Buchstaben der angibt, welche Art von Hilfe Du willst. Wenn Du Dich -WIRKLICH "verirrst", tippe C-h ? und Emacs wird Dir mitteilen, welche -Art von Hilfe zur Verfügung steht. Hast Du C-h getippt, willst aber -keine Hilfe mehr, dann tippe einfach C-g zum Abbrechen des Befehls. - -(Einige Administratoren verändern die Bedeutung von C-h. Sie sollten -dies wirklich nicht tun, beschwere Dich also beim System -Administrator. In der Zwischenzeit, wenn C-h keine Mitteilung -bezüglich Hilfe am Fuß des Emacs-Fensters anzeigt, versuche M-x help - zu tippen.) - -Die einfachste Hilfe-Einrichtung ist C-h c. Tippe C-h, ein c und -einen Befehls-Buchstaben oder eine Sequenz davon und Emacs gibt Dir -eine ganz kurze Beschreibung des Befehls. - ->> Tippe C-h c C-p. - Die Mitteilung sollte etwa wie folgt aussehen - - C-p runs the command previous-line - -Dies teilt Dir den "Namen der Funktion" mit. Funktions-Namen werden -hauptsächlich zum Spezialisieren und Erweitern von Emacs verwendet. -Aber da die Funktions-Namen etwas darüber aussagen was der Befehl tut, -können Sie auch als sehr kurze Dokumentation dienen -- genug um Dich -an Befehle zu erinnern die Du bereits gelernt hast. - -Zeichenerweiterte Befehle so wie C-x C-s und (wenn Du keine META- oder -EDIT- oder ALT-Taste hast) v sind nach C-h c auch erlaubt. - -Um mehr Hilfe zu einem Befehl zu bekommen verwende C-h k anstelle von -C-h c. - ->> Tippe C-h k C-p. - -Dies zeigt sowohl die Dokumentation der Funktion, als auch ihren -Namen, in einem eigenen Emacs-Fenster. Wenn Du mit dem Lesen fertig -bist, tippe C-x 1 um den Hilfetext loszuwerden. Du mußt dies nicht -gleich tun. Du kannst etwas bearbeiten, das sich auf den Hilfetext -bezieht und dann C-x 1 tippen. - -Hier sind einige andere nützliche C-h Möglichkeiten: - - C-h f Beschreibe eine Funktion. Du tippst den Namen der - Funktion - ->> Versuche C-h f previous-line. - Dies gibt Dir all die Information die Emacs zu der Funktion hat, welche - C-p implementiert. - - C-h a Befehls-Apropos. Tippe ein Schlüsselwort und Emacs listet - alle Befehle die es enthalten. - Diese Befehle können alle mit M-x aufgerufen werden. - Für einige Befehle listet das Befehls-Apropos eine - Buchstaben-Sequenz, die den Befehl ausführt. - ->> Tippe C-h a file. - -Dies zeigt in einem anderen Fenster eine Liste aller M-x Befehle die -"file" in ihrem Namen haben. Du wirst Buchstaben-Sequenzen wie C-x -C-f mit dem entsprechenden Befehl, wie etwa find-file, aufgelistet -sehen. - ->> Tippe C-M-v um das Hilfe Fenster zu rollen. Mache dies ein paar mal. - ->> Tippe C-x 1 um das Fenster loszuwerden. - - -* ZUM SCHLUß ------------- - -Merke Dir, daß Du Emacs mit C-x C-c endgültig beendest. Um vorübergehend -in eine Shell auszusteigen, so daß Du später zurückkehren kannst, -verwende C-z. (Unter X ikonifiziert dies den aktuellen Emacs-Rahmen.) - -Dieses Tutorial sollte für Anfänger verständlich sein, hast Du etwas -Unklares gefunden, schiebe die Schuld nicht auf Dich -- beschwere Dich! - - -ANFERTIGEN VON KOPIEN ---------------------- - -Dieses Tutorial stammt, über eine lange Linie von Emacs Tutorials, von -dem von Stuart Cracraft für den ursprünglichen Emacs geschriebenen ab. -Ben Wing hat das Tutorial für X Windows erweitert. Martin Buchholz -und Hrvoje Niksic haben weitere Korrekturen für XEmacs beigetragen. -Ins Deutsche übertragen wurde es von Adrian Aichner -. - -Diese Version des Tutorials ist, wie GNU Emacs selbst, -urheberrechtlich geschützt und erlaubt die Verteilung von Kopien unter -bestimmten Voraussetzungen: - -Copyright (c) 1997, Adrian Aichner . - -Copyright (c) 1985, 1996 Free Software Foundation - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and permission notice are preserved, - and that the distributor grants the recipient permission - for further redistribution as permitted by this notice. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last altered them. - -Die Bedingungen zum Kopieren von Emacs sind komplexer, entsprechen -aber dem selben Geist. Bitte lies die Datei COPYING und gib doch -Kopien von GNU Emacs an Freunde weiter. Hilf mit bei der Beseitigung -von Software-Verhinderungspolitik ("Besitz") durch das Verwenden, -Schreiben and Weitergeben von kostenloser Software! diff --git a/etc/TUTORIAL.fr b/etc/TUTORIAL.fr deleted file mode 100644 index 4a0d27c..0000000 --- a/etc/TUTORIAL.fr +++ /dev/null @@ -1,1085 +0,0 @@ -Copyright (c) 1997, Didier Verna . -Se reporter à la fin du document pour les conditions. - -Vous lisez actuellement la version française du tutoriel d'Emacs. - -Cette version a été produite à partir de la version anglaise, qui est -Copyright (c) 1985, 1996 Free Software Foundation, Inc. - - - - Bienvenue dans le tutoriel d'Emacs en Français !! - - -La plupart des commandes d'Emacs utilisent la touche -(également notée ou ), ou la touche . Sur certains -claviers, la touche s'appelle , ou autre chose (sur -les claviers des stations Sun par exemple, il s'agit de la touche à -gauche de la barre espace, celle avec un petit losange). Si vous ne -disposez pas de la touche , il est possible d'utiliser la touche - à la place. Afin de décrire les combinaisons de touches -disponibles dans Emacs, les conventions suivantes sont utilisées: - - C- signifie maintenir la touche enfoncée tout en tapant - le caractère . Ainsi, C-f signifie «maintenir la touche - enfoncée, et taper 'f'». - M- signifie maintenir la touche enfoncée tout en tapant le - caractère . Si la touche n'est pas disponible, - tapez d'abord , relâchez la, puis tapez . - -NOTE IMPORTANTE: pour quitter Emacs, tapez C-x C-c (deux caractères). - -Quand vous trouvez les caractères >> au début d'une ligne, cette ligne -vous donne des directives pour essayer une commande. Par exemple: -<> ->> Maintenant, tapez C-v («view next screen») pour passer à l'écran - suivant. (Faites le vraiment! Maintenez la touche - enfoncée et tapez 'v'). À partir de maintenant, refaites la même - chose quand vous avez fini de lire tout l'écran. - -Remarquez que quand vous changez d'écran, les deux dernières lignes de -l'écran précédent sont conservées, ceci afin de conserver un minimum -de continuité dans la lecture. - -Une des premières choses à savoir dans Emacs est comment se déplacer -dans un texte. Vous savez déjà comment changer d'écran avec C-v. Pour -revenir d'un écran en arrière, tapez M-v (maintenez la touche -enfoncée tout en appuyant sur 'v', ou encore tapez -v si vous ne -disposez pas de , ou ). - ->> Essayez de taper M-v puis C-v un certain nombre de fois. - - -* RÉSUMÉ --------- - -Les commandes suivantes sont utiles pour voir des écrans entiers: - - C-v Passer à l'écran suivant - M-v Revenir à l'écran précédent - C-l Effacer l'écran et tout retracer, en mettant la ligne - où se trouve le curseur au centre (C'est bien la - touche 'L', pas la touche 'un' - ->> Trouvez le curseur et rappelez vous bien du texte qui l'entoure. - Tapez C-l - Trouvez le curseur à nouveau, et remarquez qu'il s'agit bien du - même texte autour de lui. - - -* MOUVEMENTS DE BASE DU CURSEUR -------------------------------- - -Passer d'un écran à l'autre, c'est bien ... mais comment faire pour se -déplacer dans le texte d'un seul écran? - -Il existe plusieurs manières de faire. La plus simple est d'utiliser -les commandes C-p, C-b, C-f et C-n. Chacune de ces commandes déplace -le curseur d'une ligne ou d'une colonne dans une direction donnée, -comme illustré sur le diagramme suivant: - - - Ligne précédente, C-p - : - : - En arrière, C-b .... Position courante .... En avant, C-f - : - : - Ligne suivante, C-n - ->> Déplacez le curseur au centre de ce diagramme en utilisant C-n ou - C-p, puis placez le au centre de l'écran avec C-l. - - -Pour vous rappeler ces commandes, pensez à leur signification en -anglais (et oui, pas en français ...): F pour Forward, B pour -Backward, N pour Next, P pour Previous. Retenez bien ces commandes, -car vous vous en servirez très souvent. - ->> Amenez le curseur sur cette ligne avec quelques C-n. - ->> Déplacez vous sur la ligne avec des C-f, puis vers le haut avec des - C-p. Remarquez ce que fait C-p quand le curseur est au milieu de la - ligne. - -Chaque ligne de texte se termine avec un caractère nommé Newline, qui -sert à séparer les lignes entre elles. La dernière ligne du fichier -est censée avoir un tel caractère à la fin (bien qu'Emacs n'ait pas -particulièrement besoin de sa présence). - ->> Placez vous au début d'une ligne, et tapez C-b. Cela devrait vous - placer à la fin de la ligne précédente. En fait, on a juste reculé - d'un caractère, à travers le caractère Newline. - -C-f vous déplace à travers Newline, exactement comme C-b. - ->> Faites encore quelques C-b, pour bien sentir comment se déplace le - curseur, puis des C-f pour retourner à la fin de la ligne, et pour - finir encore un C-f pour aller au début de la ligne suivante. - -Si vous vous déplacez en dehors de l'écran, le texte se déplace de -manière à ce que la position du curseur redevienne visible. Cette -opération est appelée «scrolling». - ->> Déplacez le curseur jusqu'en bas de l'écran, et remarquez ce qu'il - se passe. - -Si vous trouvez que le déplacement caractère par caractère est trop -lent, vous pouvez vous déplacer mot par mot. M-f et M-b vous déplacent -respectivement d'un mot en avant et en arrière. - ->> Tapez quelques M-f et M-b. - -Si vous êtes au milieu d'un mot, M-f vous déplace à la fin du mot. -Si vous êtes entre deux mots, M-f vous déplace à la fin du mot -suivant. M-b produit le même comportement, en sens inverse. - ->> Mélangez quelques M-f et M-b avec quelques C-f et C-b pour bien -noter les différences de comportement suivant l'endroit où vous êtes. - -Remarquez le parallèle qui existe entre C-f et C-b d'un côté, et M-f -et M-b de l'autre. Très souvent, les commandes Meta agissent sur des -unités de langage (mots, phrases, paragraphes etc.) tandis que les -commandes Control agissent sur des unités plus primaires (caractères, -lignes etc.). - -Ce parallèle existe encore entre les lignes et les phrases: C-a et C-e -vous positionnent au début ou à la fin d'une ligne, tandis que M-a et -M-e vous déplacent au début ou à la fin d'une phrase. - ->> Tapez quelques C-a et quelques C-e. - Puis tapez quelques M-a et quelques M-e. - -Remarquez que plusieurs C-a ne font rien, mais que plusieurs M-a -n'arrêtent pas de vous faire remonter de phrase en phrase. - -La position du curseur sur dans le texte est aussi appelée le -«point». En d'autres termes, le curseur à l'écran se trouve où le -point est dans le texte. - -Voici un résumé des commandes simples de déplacement, y compris celles -relatives aux mots et aux phrases: - - C-f En avant d'un caractère - C-b En arrière d'un caractère - - M-f En avant d'un mot - M-b En arrière d'un mot - - C-n Ligne suivante - C-p Ligne précédente - - C-a Début de ligne - C-e Fin de ligne - - M-a Début de phrase - M-e Fin de phrase - ->> Entraînez vous un peu à la pratique de ces commandes. Elles sont - très souvent utilisées. - -Deux autres commandes importantes pour le déplacement sont M-< -(Meta-Inférieur) et M-> (Meta-Supérieur). Elles vous déplacent -respectivement au début et à la fin de tout le texte. - -Sur la plupart des terminaux, '<' se trouve au dessus de la -virgule. Il faut donc utiliser la touche pour l'obtenir, sans -quoi vous obtiendrez M-'virgule'. - ->> Tapez M-< pour retourner au début du texte. - Puis tapez plusieurs C-v pour revenir ici. - ->> Tapez M-> pour aller à la fin du texte. - Puis tapez plusieurs M-v pour revenir ici. - -Vous pouvez aussi déplacer le curseur avec les flèches, si votre -clavier en possède. Il est cependant préférable d'utiliser C-b C-f C-n -et C-p pour trois raisons: premièrement, ces commandes fonctionnent -sur tous les terminaux. Deuxièmement, quand vous vous serez habitué à -Emacs, vous découvrirez que ces touches sont plus rapides car vous -n'avez pas besoin de déplacer vos mains loin des lettres du -clavier. Enfin, quand vous aurez l'habitude d'utiliser la touche -, vous apprendrez plus facilement d'autres commandes de -déplacement plus complexes. - -La plupart des commandes d'Emacs acceptent un argument numérique, qui -sert souvent comme compteur de répétition. Pour donner un tel argument -à une fonction, tapez C-u puis les chiffres, et enfin entrez la -commande. Si vous disposez de la touche (ou ou ), vous -pouvez aussi tapez directement les chiffres tout en maintenant la -touche enfoncée. Il est préférable d'apprendre la méthode C-u car -elle fonctionne sur tous les terminaux. - -Par exemple, C-u 8 C-f vous déplace de huit caractères en avant. - ->> Essayez d'utiliser C-n avec un argument numérique pour vous - déplacer d'un seul coup sur une autre ligne. - -Certaines commandes n'interprètent pas leur argument numérique comme -un compteur de répétition. C'est le cas de C-v et M-v qui déplacent le -texte d'autant de lignes plutôt que d'écrans entiers. Par exemple, C-u -4 C-v déroulera l'écran de 4 lignes. - ->> Essayez C-u 8 C-v. - -Cela a du déplacer l'écran de 8 lignes. Pour faire la manoeuvre -inverse, donnez le même argument a M-v. - -Si vous travaillez sous X Window, il y a sans doute une scrollbar sur -le côté droit de la fenêtre d'Emacs. Vous pouvez aussi vous en servir -avec la souris pour déplacer le texte. - ->> Essayer de cliquer avec le deuxième bouton au dessus du bouton de - la scrollbar. Cela devrait dérouler le texte jusqu'à une position - déterminée par l'endroit où vous avez cliqué. - ->> Cliquez maintenant avec le premier bouton à quelques lignes du - sommet dans la scrollbar. - - -* CONTRôLE DU CURSEUR AVEC UN TERMINAL X ----------------------------------------- - -Si vous travaillez sur un terminal X, vous trouverez surement plus -facile d'utiliser les flèches du pavé numérique pour déplacer le -curseur. Les quatre flèches fonctionnent exactement comme C-f C-b C-n -et C-p mais sont plus faciles à retenir. Vous pouvez aussi les -combiner avec la touche pour vous déplacer par bloc (par -exemple par paragraphe dans un texte). Si votre pavé numérique dispose -de touches (ou ) et , elles vous déplaceront -respectivement en début et en fin de ligne. Combinées avec la touche -, elles vous déplaceront respectivement en début et en fin de -fichier. Si enfin votre pavé numérique dispose des touches et -, celles-ci vous déplaceront d'écran en écran comme C-v et M-v. - -Toutes ces commandes acceptent des arguments numériques comme décrit -précédemment. - - -* QUAND EMACS EST BLOQUÉ ------------------------- - -Si jamais Emacs ne répond plus à vos ordres, vous pouvez l'arrêter en -toute sécurité en tapant C-g. C-g peut aussi être utilisé pour stopper -une commande qui met trop de temps à s'exécuter. - -C-g sert également à annuler un argument numérique, ou une commande -que vous ne voulez plus mener à terme. - ->> Tapez C-u 1 0 0 pour produire un argument numérique de 100, puis - tapez C-g. - Maintenant, tapez C-f. Le curseur doit finalement ne bouger que - d'un seul caractère, puisque vous avez annulé l'argument. - -Si vous avez tapé un par erreur, vous pourrez toujours l'annuler -avec C-g. - - -* COMMANDES DÉSACTIVÉES ------------------------ - -Quelques commandes sont «désactivées» pour empêcher les nouveaux -utilisateurs de les appeler par accident. - -Si vous tapez une de ces commandes, Emacs ouvrira un message vous -disant quelle était cette commande, et vous demandant si vous voulez -vraiment poursuivre son exécution. - -Si vous souhaitez effectivement l'essayer, appuyez sur la barre -espace. Sinon, répondez à la question en tapant 'n'. - ->> Tapez `C-x n p' (commande désactivée), puis répondez par 'n'. - - -* FENÊTRES ----------- - -Emacs peut afficher plusieurs fenêtres, chacune avec un texte -différent. Le terme «fenêtre» signifie ici une zone particulière dans -la fenêtre d'Emacs; il ne s'agit pas de fenêtres pouvant se superposer -dans votre système de multifenétrage. Emacs peut aussi ouvrir -plusieurs fenêtres X (appelées «frames» en jargon Emacsien), mais ceci -est décrit ultérieurement. - -Pour l'instant, mieux vaut ne pas trop s'occuper de plusieurs fenêtres -simultanées, sauf peut-être pour savoir les éliminer toutes sauf -une. Ceci est effectué par la commande C-x 1 ('un', pas 'L'). Cette -commande tue toutes les fenêtres sauf celle dans laquelle vous vous -trouvez, et s'arrange pour que la fenêtre restante occupe toute la place. - ->> Amenez le curseur ici, puis tapez C-u 0 C-l. - -(Rappelez vous que C-l recentre le curseur au milieu de la -fenêtre. Avec un argument numérique, elle place la ligne courante à -autant de lignes du sommet de la fenêtre. Avec 0 comme argument, on -réaffiche donc le texte, en plaçant la ligne courante en haut.) - ->> Tapez Control-x 2 - Notez que cette fenêtre diminue (de moitié), et qu'une nouvelle - fenêtre apparaît (avec le même texte). - ->> Tapez C-x 1 pour faire à nouveau disparaître la deuxième fenêtre. - - -* INSÉRER ET EFFACER --------------------- - -Pour insérer du texte, il suffit de le taper. Tous les caractères que -vous pouvez voir à l'écran (A, %, - etc.) sont considérés comme du -texte et sont insérés. Pour insérer le caractère Newline, tapez - (retour chariot). - -Vous pouvez effacer le dernier caractère que vous avez tapé avec la -touche parfois nommée «Del». La touche peut -quelques fois être utilisée de la même manière, mais pas tout le -temps! - -Plus généralement, efface le caractère situé juste avant le -curseur. - ->> Maintenant, tapez quelques caractères, puis effacez-les avec - . Ne vous inquiétez pas pour le contenu de ce tutoriel, ce - que vous avez à l'écran n'est que votre copie personnelle du - fichier, pas le fichier d'origine. - -Si une ligne de texte devient trop grande, elle se poursuit sur une -seconde ligne. Un «Backslash» ('\') situé tout à fait à droite de la -ligne indique que celle-ci continue sur la ligne suivante. - ->> Insérez des caractères jusqu'à ce que la ligne devienne trop - grande, et notez l'apparition du '\'. - ->> Utilisez pour effacer des caractères jusqu'à ce que la - ligne reprenne une taille raisonnable. Vous remarquerez que le '\' - disparaît. - -Le caractère Newline s'efface exactement comme les autres. L'effacer -revient à ne faire qu'une seule ligne à partir de deux. Si cette -nouvelle ligne est trop grande, le '\' apparaîtra a nouveau. - ->> Déplacez le curseur au début d'une ligne et tapez . Le -caractère Newline sera effacé et cette ligne sera ajoutée à la ligne -précédente. - ->> Tapez pour réinsérer le Newline que vous avez effacé. - -Rappelez-vous bien que la plupart des commandes acceptent un argument -numérique, y compris l'insertion de caractères: - ->> Tapez C-u 8 *, vous obtiendrez "********". - -Vous connaissez maintenant les commandes de base pour insérer du texte -et corriger des erreurs. Toujours grâce aux touches et -, vous pouvez aussi effacer du texte par mot ou par ligne: - - efface le caractère juste avant le curseur - C-d efface le caractère juste après le curseur - - M- supprime le mot juste avant le curseur - M-d supprime le mot juste après le curseur - - C-k supprime tout du curseur jusqu'à la fin de ligne - M-k supprime tout du curseur jusqu'à la fin de phrase - - -Quand vous supprimez plus d'un caractère à la fois, Emacs sauvegarde le -texte pour vous donner la possibilité de le réintroduire. L'opération -de réintroduction s'appelle le «yanking». Vous pouvez réintroduire le -texte à la même place ou ailleurs. Vous pouvez même le réintroduire -plusieurs fois, pourquoi pas à des endroits différents. La commande de -«yanking» est C-y. - -Notez bien la différence entre «effacer» et «supprimer». Un texte -«supprimé» est sauvegardé, tandis qu'un caractère «effacé» ne l'est -pas. De même, les commandes effaçant juste des blancs ou des lignes -vides ne sauvegardent rien. - ->> Placez le curseur au début d'une ligne non vide. - Tapez C-k pour supprimer le texte sur cette ligne. ->> Tapez C-k une deuxième fois. Vous remarquerez que cette fois-ci, la - ligne elle-même est supprimée (le caractère Newline). - -C-k traite son argument numérique de manière spéciale: il supprime -autant de lignes Y COMPRIS LE CARACTÈRE NEWLINE. Taper C-k deux fois -de suite ne produirait pas le même résultat. - ->> Pour récupérer le texte dernièrement supprimé, tapez C-y. Celui-ci - sera placé où se trouve le curseur. - -Notez également que si vous faites plusieurs C-k à la suite, tout les -morceaux supprimés seront concaténés, et un seul C-y suffira à tout -ramener. - ->> Faites-le. C-k plusieurs fois, puis C-y. - ->> Déplacez le curseur à un autre endroit puis tapez à nouveau C-y. - Voilà comment on copie du texte! - -C-y restaure le dernier morceau de texte à avoir été supprimé, mais -les suppressions précédentes ne sont pas perdues pour autant. Après -avoir tapé C-y, la commande M-y remplace le texte restauré par l'avant -dernière suppression. Tapez à nouveau M-y et vous obtiendrez -l'avant-avant dernière suppression et ainsi de suite. Quand vous avez -récupéré le texte que vous cherchiez, rien de plus à faire: continuez -simplement votre édition. - -Si vous tapez M-y assez longtemps, vous retomberez sur la suppression -la plus récente. - ->> Supprimez une ligne, déplacez vous et supprimez-en une autre. - Tapez C-y pour récupérer la dernière ligne. - Puis tapez M-y, ce qui restaurera la première ligne supprimée. - Tapez encore M-y pour voir ce qu'il se passe, et continuez jusqu'à - récupérer à nouveau la deuxième ligne. - Si ça vous amuse, donnez des arguments positifs et négatifs à M-y. - - -* ANNULATION ------------- - -Si vous changez du texte, et que finalement vous décidez que ce -n'était pas une bonne idée, vous pouvez annuler les changements grâce -à la commande C-x u. - -C-x u annule les changements produits par la dernière commande. Taper -C-x u plusieurs fois annule de plus en plus de commandes précédentes. - -Il existe cependant quelques exceptions: les commandes qui ne changent -pas le texte ne comptent pas (par exemple les commandes de -déplacement). Les commandes qui insèrent juste un caractère sont -souvent regroupées jusqu'à une vingtaine, ceci pour réduire le nombre -de C-x u à taper ensuite. - ->> Supprimez cette ligne avec C-k, puis tapez C-x u. Elle devrait - revenir ... - -Une alternative à C-x u est C-_. C-x u existe car c'est plus facile à -taper sur certains claviers. Sur d'autres vous pouvez également -obtenir C-_ en tapant C-/. - -Enfin, la commande d'annulation accepte les argument numériques. - - -* FICHIERS ----------- - -Pour sauver votre texte, vous avez besoin de le mettre dans un -fichier, sans quoi il disparaîtra quand vous quitterez Emacs. On dit -«trouver» un fichier («finding»), ou encore «visiter» un fichier -(«visiting»), ou bien «ouvrir». - -Visiter un fichier revient à voir son contenu dans Emacs. Si vous -modifiez le texte du fichier dans Emacs, ces changements ne deviennent -pas permanent, sauf si vous «sauvez» le fichier. Cela permet de ne pas -avoir des fichiers à moitié modifiés sur votre système, à moins que -vous ne le souhaitiez vraiment. D'autre part, quand Emacs «sauve» un -fichier, il commence par copier l'ancienne version sous un nouveau nom -afin que vous puissiez toujours revenir en arrière. - -Regardez en bas de la fenêtre d'Emacs. Vous trouverez une ligne -contenant des tirets '-', et la chaîne de caractères -«Emacs: TUTORIAL.FRANCAIS». Cela vous donne le nom du fichier que vous -êtes en train de visiter. En ce moment, vous visitez le fichier -«TUTORIAL.FRANCAIS» qui correspond au Tutoriel d'Emacs, version -française. Ceci est votre copie personnelle du fichier. Pour chaque -fichier que vous visitez, son nom apparaît exactement à cet endroit. - -La plupart des commandes relatives aux fichiers sont des commandes à -deux caractères, commençant par C-x. Il y a toute une série de -commandes commençant par C-x, beaucoup concernant les fichiers et les -buffers, et longues de 2 caractères ou plus. - -Une autre chose importante pour visiter un fichier est que vous devez -spécifier le nom du fichier à visiter. On dit que cette commande «lis -un argument depuis le terminal». Dans le cas présent, l'argument est -le nom du fichier. Après avoir tapé la commande - -C-x C-f («find») - -Emacs vous demande son nom. Le nom que vous tapez apparaît tout en bas -de la fenêtre. Quand cette ligne sert à entrer des données de cette -manière, on l'appelle «minibuffer». Les commandes d'édition ordinaires -peuvent être utilisées pour éditer le nom du fichier. - -Pendant que vous êtes en train de taper le nom du fichier, vous pouvez -annuler la commande grâce à C-g. - ->> Tapez C-x C-f puis C-g. Cela annule le minibuffer ainsi que la - commande C-x C-f. Vous n'allez finalement pas visiter de fichier. - -Quand le nom du fichier est correct, tapez . La commande -prendra alors effet et ira chercher le fichier. Après avoir terminé la -saisie du nom, le minibuffer disparaît. - -Au bout d'un petit moment, le contenu du fichier apparaît et vous -pouvez commencer votre édition. Quand vous êtes satisfait des -changements apportés au texte, tapez - -C-x C-s («save») - -Cette commande copie le texte contenu dans Emacs vers le fichier -lui-même. La première fois que vous le faites, Emacs sauvegarde la -version initiale du fichier sous un autre nom, en ajoutant un '~' à la -fin du nom. - -Quand la sauvegarde est terminée, Emacs affiche le nom du fichier dans -lequel on vient d'écrire. Il est fortement conseillé de sauver assez -souvent les fichiers pour éviter de tout perdre en cas de crash -système (non pas qu'Emacs ne puisse jamais crasher lui-même ...). - ->> Tapez C-x C-s pour sauver votre copie du tutoriel. - Vous devriez voir apparaître «Wrote ...TUTORIAL.FRANCAIS" tout en bas - de la fenêtre. - -NOTE: Sur certains systèmes, C-x C-s bloque l'écran et Emacs ne dit -plus rien. Cela signifie qu'une «fonctionnalité» système que l'on -appelle le «flow control» intercepte le C-s et l'empêche de parvenir à -Emacs. Pour débloquer la situation, tapez C-q. Reportez-vous dans ce -cas à la section «Spontaneous Entry to Incremental Search» du manuel -d'Emacs pour plus d'information sur cette ... «particularité». - -Vous pouvez visiter des fichiers existant, mais aussi des fichiers qui -n'existent pas. C'est en fait comme cela que l'on crée un nouveau -fichier dans Emacs. Initialement, le fichier sera inexistant, et la -première fois que vous demanderez à Emacs de le sauver, il créera -effectivement le fichier correspondant. - - -* BUFFERS ---------- - -Si vous ouvrez un nouveau fichier avec C-x C-f, le précédent reste -dans Emacs. Pour retravailler dessus, retapez simplement C-x C-f. De -cette manière, vous pouvez avoir un nombre important de fichiers -ouverts dans Emacs. - ->> Créez un fichier nommé «foo» en tapant C-x C-f foo. - Insérez un peu de texte puis sauvez-le en tapant C-x C-s. - Enfin, tapez C-x C-f TUTORIAL.FRANCAIS pour revenir ici. - -Emacs conserve le contenu de chaque fichier dans un objet appelé -«buffer». Visiter un fichier revient à créer un nouveau buffer et y -placer le contenu du fichier. Pour obtenir la liste des buffers qui -existent actuellement dans votre session Emacs, tapez la commande -suivante: - ->> Tapez C-x C-b pour obtenir la liste des buffers. - -Remarquez que chaque buffer a un nom, et qu'il peut aussi avoir un nom -de fichier dans le cas où un fichier lui est associé. Il extsite des -buffers non attachés à des fichiers, par exemple, le buffer nommé -«*Buffer List*». C'est le buffer qui a été créé par la commande C-x -C-b. Par contre, TOUT texte que vous pouvez voir dans Emacs appartient -à un buffer. - ->> Tapez C-x 1 pour faire disparaître le buffer contenant la liste des - buffers. - -Quand vous éditez un fichier, puis que vous en ouvrez un autre, le -fichier précédent n'a pas été sauvé. Tous les changements effectués -sont conservés dans le buffer associé au fichier, mais l'ouverture -et l'édition d'un nouveau fichier n'ont aucun effet sur le -premier. Vous constatez donc qu'il serait ennuyeux d'avoir à revenir -au premier fichier pour le sauver avec C-x C-s. Pour éviter ce -désagrément, il existe une autre commande: - - C-x s (Sauver certains buffers) - -C-x s vous demandera, pour chaque buffer contenant des modifications -non sauvegardées, si vous désirez le sauver ou non. - ->> Insérez une ligne de texte, puis tapez C-x s - Emacs vous demandera si vous désirez sauver le buffer nommé - TUTORIAL.FRANCAIS. - Répondez «oui» à la question en tapant 'y'. - - -* UTILISATION DES MENU ----------------------- - -Si vous travaillez sur un terminal X, vous avez déjà remarqué une -barre de menu en haut de la fenêtre d'Emacs. Cette barre de menu vous -permet d'accéder à la plupart des commandes d'Emacs comme celles -permettant d'ouvrir ou de sauver un fichier. L'utilisation de la barre -de menu vous semblera plus facile au début, puis quand vous serez -habitué à Emacs, il vous sera facile d'utiliser les commandes au -clavier, car chaque commande figurant dans un menu affiche également -son équivalent clavier sur le bouton. - -Remarquez qu'il existe des boutons n'ayant aucun équivalent -clavier. Par exemple, le menu «Buffers» donne la liste de tous les -buffers par ordre de plus récente utilisation. Vous pouvez passer d'un -buffer à l'autre en les sélectionnant par leur nom dans ce menu. - - -* UTILISATION DE LA SOURIS --------------------------- - -Quand vous travaillez sous X, Emacs utilise pleinement la souris. Vous -pouvez vous positionner dans le texte en cliquant avec le bouton de -gauche à l'endroit souhaité, vous pouvez sélectionner du texte en -déplaçant la souris avec le bouton de gauche enfoncé, ou bien en -cliquant le bouton de gauche au début de la portion à sélectionner, -puis en Shift-cliquant à l'autre bout. - -Pour supprimer un morceau de texte, utilisez C-w ou le bouton «Cut» du -menu «Edit». Notez bien que ces deux commandes ne sont pas -équivalentes: C-w ne fait que supprimer le texte en le sauvegardant de -manière interne (comme C-k), mais «Cut» sauvegarde en plus le texte -dans le clipboard de X Window, où il pourra être accédé par d'autres -applications. - -Pour récupérer du texte en provenance d'autres applications, utilisez -«Paste» du menu «Edit». - -Le bouton du milieu sert principalement à choisir des objets visibles -dans les fenêtres d'Emacs. Par exemple, si vous entrez dans «Info» (le -système de documentation en ligne) en tapant C-h i ou en utilisant le -menu «Help», vous pourrez suivre un lien surligné en cliquant dessus -avec le bouton du milieu. De la même manière, si vous commencez à -taper un nom de fichier après avoir fait C-x C-f, et que vous appuyez -sur en cours de route, Emacs vous ouvrira une fenêtre avec -toutes les complétions possibles, et vous pourrez en sélectionner une -grâce au bouton du milieu. - -Le bouton droit fait apparaître un menu. Le contenu de ce menu varie -en fonction du mode dans lequel vous vous trouvez, et contient en -général quelques commandes fréquemment utilisées. - ->> Cliquez avec le bouton de droite pour voir le menu en question. - -Si vous relâchez le bouton, le menu disparaît. - - -* EXTENSION DE L'ENSEMBLE DES COMMANDES ---------------------------------------- - -Il existe bien plus de commandes dans Emacs que l'on ne pourrait en -associer aux touches et . Pour remédier à cela, Emacs -utilise la commande X (eXtension) qui se présente sous deux aspects: - - C-x Extension par caractère (suivit d'un caractère). - M-x Extension par nom (suivit d'un nom de commande). - -Ces commandes, bien que très utiles, sont utilisées moins souvent que -celles que vous avez déjà apprises. Vous en connaissez déjà deux: les -commandes relatives aux fichiers (C-x C-f et C-x C-s). Un autre -exemple est la commande pour quitter définitivement Emacs, C-x C-c (ne -vous inquiétez pas des éventuels changements qui seraient perdus, C-x -C-c vous propose de sauver ces changements avant de tuer Emacs). - -C-z est la commande qui vous permet de quitter Emacs «temporairement», -pour que vous puissiez y revenir plus tard. - -Sur les systèmes le permettant, C-z «suspend» Emacs, ce qui signifie -que l'on retourne au shell sans tuer Emacs. Dans la plupart des cas, -vous pouvez revenir à Emacs en tapant 'fg' ou '%emacs'. - -Sur les systèmes ne permettant pas la suspension de processus, cette -commande créé un sous-shell qui continue à exécuter Emacs, vous -donnant ainsi la possibilité de faire tourner d'autres programmes et -revenir à Emacs plus tard. Dans ce cas, la commande shell 'exit' est -la manière habituelle de retourner au sous-shell d'Emacs. - -Vous utiliserez C-x C-c quand le moment sera venu de vous déloguer ou -d'éteindre la machine. C'est aussi la bonne manière de sortir d'Emacs -si celui-ci a été lancé depuis un maileur ou tout autre utilitaire, -ceux-ci ne sachant pas forcément comment gérer les suspensions. Dans -des circonstances où vous ne vous déloguez pas, mieux vaut suspendre -par C-z au lieu de sortir véritablement d'Emacs. - -Il existe de nombreuses commandes sous C-x. Voici celles que vous avez -apprises jusque là: - - C-x C-f Visiter un fichier (Find File). - C-x C-s Sauver un fichier (Save File). - C-x C-b Lister les buffers (List buffers). - C-x C-c Quitter Emacs (Quit Emacs). - C-x u Annuler Opération (Undo). - -Les commandes étendues par nom sont des commandes utilisées très peu -souvent, ou disponibles seulement sous certains modes. Par exemple, la -commande «replace-string» substitue globalement une chaîne de -caractères par une autre. Si vous tapez M-x, Emacs vous affichera M-x -en bas de la fenêtre et vous pourrez alors taper le nom d'une -commande, ici replace-string. Tapez simplement 'repl s ' -et Emacs complétera le nom pour vous. Terminez le nom avec - -La commande replace-string requiert deux arguments: la chaîne à -remplacer et la chaîne de remplacement. Terminez chacune de ces -chaînes par . - ->> Déplacez le curseur sur la ligne blanche en dessous de ce - paragraphe, puis tapez - M-x replsRemarquezNotez. - - Remarquez comme cette ligne a changé: le mot R-e-m-a-r-q-u-e-z a - été remplacé par N-o-t-e-z partout où il est apparu après le - curseur. - - -* SAUVEGARDE AUTOMATIQUE ------------------------- - -Si votre système crashe alors que certaines modifications n'étaient -pas sauvées, vous perdez des donnés. Pour remédier à ce problème, -Emacs sauvegarde périodiquement tous vous fichiers, et cela de manière -automatique. Ce fichier de sauvegarde est appelé «auto save». Son nom -commence et se termine par un '#'. Par exemple, un fichier auto save -de 'hello.c' a pour nom '#hello.c#'. Quand vous sauvez le fichier de -manière normale, le fichier auto save est effacé. - -Si votre ordinateur crashe, vous pouvez restaurer la sauvegarde en -ouvrant le fichier normalement (le VRAI fichier, pas l'auto save), -puis en tapant M-x recover-file. Répondez 'yes' à la -question. - - -* ZONE D'ÉCHO -------------- - -Quand Emacs constate que vous tapez lentement, il vous montre ce que -vous avez tapez en bas de la fenêtre, dans la zone d'écho («echo -area»). Cette zone contient la dernière ligne de la fenêtre d'Emacs. - - -* LIGNE DE MODE ---------------- - -La ligne juste au dessus de la zone d'écho s'appelle ligne de mode -(«modeline»). Elle dit actuellement quelque chose comme ça: - ---**-XEmacs: TUTORIAL.FRANCAIS (Fundamental)--L752--67%--------- - -Cette ligne fournit des renseignements utiles sur le status d'Emacs et -le texte que vous éditez. - -Vous connaissez déjà la signification du nom de fichier: c'est celui -que vous êtes en train d'éditer. -xx%- indique le pourcentage de texte -situé au dessus du curseur. Si vous pouvez voir le début du fichier à -l'écran, --Top-- sera indiqué au lieu de --00%--. Si le bas du fichier -est visible, il y aura --Bot-- à la place. Si votre texte est tout -entier contenu dans la fenêtre, vous verrez --All--. - -Les étoiles '*' au début signifient que vous avez fait des changements -au texte. Quand vous ouvrez le fichier, ou après l'avoir sauvé, il n'y -aura plus d'étoiles, mais juste des tirets. - -La partie entre parenthèses vous indique dans quel mode d'édition vous -vous trouvez. Le défaut (que vous utilisez en ce moment) est le mode -«Fundamental». C'est un exemple de Mode Majeur («major mode»). - -Il existe de nombreux modes majeurs. Certains sont faits pour éditer -différents langages, différentes sortes de texte, du Lisp, du C etc. -Il ne peut y avoir qu'un mode majeur actif à la fois, et son nom se -trouve sur la ligne de mode (là ou vous voyez «Fundamental» en ce -moment). - -Chaque mode fait certaines commandes se comporter différemment. Par -exemple, la commande pour créer des commentaires dans un programme -tient compte des différents caractères de commentaire des -langages. Chaque mode majeur est le nom d'une commande étendue. Par -exemple la commande M-x fundamental-mode vous place en mode -fondamental. - -Si vous voulez éditer du texte en français, vous devriez plutôt -choisir le mode Text. - ->> Tapez M-x text-mode - -Pas d'inquiétude: les commandes que vous avez apprises jusqu'ici ne -sont pas radicalement différentes d'un mode à l'autre. Mais vous -pouvez constater par exemple que M-b et M-f traitent les apostrophes -comme faisant partie des mots. Auparavant, ces caractères étaient -considérés comme des séparateurs de mots. En général, les modes -majeurs ne changent que très peu le comportement des commandes -habituelles. - -Pour voir la documentation du mode majeur courant, tapez C-h m. - ->> Utilisez C-u C-v pour amener cette ligne vers le haut de l'écran. ->> Tapez C-h m, pour voir les différences entre les mode Fundamental - et Text. ->> Tapez 'q' pour faire disparaître la documentation. - -Les modes majeurs sont appelés «majeurs» parce qu'il y en a aussi des -«mineurs». Les modes mineurs n'altèrent que partiellement le -comportement de tel ou tel mode majeur. Ils peuvent être activés ou -désactivés indépendamment du mode majeur courant. Vous pouvez en -utiliser autant que possible en même temps. - -Un mode mineur très utile pour éditer du texte est le mode -«Auto Fill». Quand ce mode est activé, Emacs coupe lui-même les lignes -si vous tapez du texte trop long pour être contenu sur une seule. - -Pour activer ce mode, tapez M-x auto-fill-mode. Cette commande -sert à le désactiver ou à l'activer selon son status actuel; elle -intervertit son état d'activation. - ->> Tapez M-x auto-fill-mode. Insérez maintenant une quantité - de «aslidfhw» jusqu'à voir que votre ligne se divise - automatiquement en deux, à un endroit où il y avait un espace. - -La marge est en général à 70 caractères, mais vous pouvez la changer -grâce à la commande C-x f. Donner la marge requise comme argument -numérique. - ->> Tapez C-x f avec un argument de 20 (C-u 2 0 C-x f). - Tapez du texte jusqu'à ce que la ligne soit coupée, puis replacez - la marge à 70. - -Si vous faites des changements au milieu d'un paragraphe, le mode Auto -Fill ne recoupera pas les lignes tout seul. Pour réajuster les lignes -d'un tel paragraphe, tapez M-q avec le curseur n'importe où dans le -paragraphe. - ->> Déplacez le curseur dans le paragraphe précédent, et tapez M-q. - - -* RECHERCHE ------------ - -Emacs est capable de rechercher des chaînes de caractères aussi bien -en avant qu'en arrière dans un texte. Ces commandes sont en fait des -commandes de déplacement du curseur. Elles déplacent le curseur au -prochain (ou précédent) endroit ou la chaîne apparaît. - -La commande de recherche d'Emacs est un peu différente de celle des -autres éditeurs de texte dans la mesure où elle est incrémentale: la -recherche intervient au fur et à mesure que vous tapez la chaîne à -rechercher. - -Pour démarrer une recherche, tapez C-s (en avant) ou C-r (en -arrière). MAIS PAS TOUT DE SUITE !! Attendez un peu pour tester ... - -Après avoir tapé C-s, vous constaterez que la chaîne «I-search» -apparaît comme prompt dans la zone d'écho. Cela vous indique qu'Emacs -est en mode de recherche incrémentale, et qu'il attend que vous -entriez la chaîne à rechercher. termine la chaîne. - ->> Tapez C-s, et entrez LENTEMENT, une lettre à la fois, le mot - «curseur», en regardant bien ce qu'il se produit. - À ce stade, vous avez cherché le mot «curseur» une fois. ->> Tapez C-s à nouveau, pour chercher la prochaine occurrence du mot. ->> Maintenant, tapez quatre fois et regardez comment le - curseur se déplace. ->> Tapez pour terminer la recherche. - -En mode incrémental, Emacs recherche ce que vous avez tapé jusqu'ici, -en surlignant les occurrences trouvées. Si aucune (nouvelle) occurrence -n'existe, C-s produira un «bip», et la zone d'écho affichera -«failing». C-g terminerait aussi bien la recherche. - -NOTE: Sur certains systèmes, C-x C-s bloque l'écran et Emacs ne dit -plus rien. Cela signifie qu'une «fonctionnalité» système que l'on -appelle le «flow control» intercepte le C-s et l'empêche de parvenir à -Emacs. Pour débloquer la situation, tapez C-q. Reportez-vous dans ce -cas à la section «Spontaneous Entry to Incremental Search» du manuel -d'Emacs pour plus d'information sur cette ... «particularité». - -Si vous êtes au milieu d'une recherche incrémentale et que vous tapez -, vous constaterez que le dernier caractère de la chaîne est -effacé, et que Emacs retourne à l'occurrence précédente. Si d'autre -part vous tapez un caractère ou (mises à part -quelques exceptions comme les caractères spéciaux pour la recherche, -C-s et C-r), la recherche sera terminée. - -Rappelez vous que si C-s cherche une chaîne APRÈS le curseur, C-r la -recherche AVANT. Tout ce que nous venons de dire sur C-s s'applique à -C-r. - - -* FENÊTRES MULTIPLES --------------------- - -Un des avantages d'Emacs est que vous pouvez afficher plusieurs -fenêtres à la fois sur l'écran. - ->> Déplacez le curseur sur cette ligne, et tapez C-u 0 C-l ('L' pas '1') - ->> Maintenant tapez C-x 2 pour obtenir deux fenêtres. - Les deux fenêtres affichent le tutoriel. Le curseur reste en haut. - ->> Tapez C-M-v (ou C-v) pour dérouler la fenêtre du bas. - ->> Tapez C-x o (o pour ôtre ...) pour placer le curseur dans la - fenêtre du bas. ->> Utilisez C-v et M-v pour dérouler la fenêtre. - Continuez de lire dans celle du haut. - ->> Tapez C-x o pour retourner dans la fenêtre du haut. - Le curseur est exactement à la même place que quand vous aviez - quitté cette fenêtre. - -Vous pouvez continuer d'utiliser C-x o pour passer d'une fenêtre à -l'autre. Chaque fenêtre a sa propre position du curseur, mais une -seule fenêtre a la fois contient réellement le curseur. Toutes les -commandes ordinaires d'édition prennent effet dans la fenêtre qui -contient le curseur. On dit que cette fenêtre est «sélectionnée». - -La commande C-M-v est très utile quand vous éditez un texte dans une -fenêtre et que vous vous servez d'une autre en guise de -référence. Vous pouvez avancer dans l'autre grâce à C-M-v. - -C-M-v (ou C-v si vous n'avez pas de touche ) est un -exemple de Control-Méta caractère. L'ordre dans lequel les touches - et sont enfoncées n'a pas d'importance. Ce sont juste -des modificateurs. Par contre, n'est pas un modificateur, donc -vous êtes obligés de taper d'abord , et C-v ensuite. - ->> Tapez C-x 1 dans la fenêtre du haut pour éliminer celle du bas. - -C-x 1 élimine en fait toutes les fenêtres non sélectionnées. - -Les fenêtres peuvent bien entendu contenir des buffers différents. Si -vous utilisez C-x C-f pour ouvrir un fichier dans l'une des fenêtres, -l'autre ne change pas. Elles sont totalement indépendantes. - -Voici une autre manière d'ouvrir un fichier dans l'autre fenêtre: - ->> Tapez C-x 4 C-f suivit du nom d'un fichier, puis . - Vous verrez le fichier apparaître dans l'autre fenêtre. Le curseur - ira également dans cette fenêtre. - ->> Tapez C-x o pour remonter à la fenêtre du haut, puis C-x 1 pour - éliminer celle du bas. - - -* NIVEAUX D'ÉDITION RÉCURSIFS ------------------------------ - -De temps en temps, vous vous trouverez dans ce qu'on appelle des -niveaux d'édition récursifs. Ceci est indiqué dans la ligne de mode -par des crochets autour des parenthèses qui englobent le nom du mode -majeur. Par exemple, vous pouvez voir [(Fundamental)] au lieu de -(Fundamental). - -Pour sortir d'un niveau récursif d'édition, tapez -. C'est un «siège éjectable» à usage multiple. Vous pouvez aussi -l'utiliser pour sortir du minibuffer ou éliminer des fenêtres -superflues. - ->> Tapez M-x pour vous rendre dans le minibuffer, puis tapez - pour en sortir. - -Il n'est pas possible d'utiliser C-g pour sortir d'un niveau récursif -d'édition. La raison en est que C-g sert à annuler des commandes au -sein même d'un niveau récursif d'édition. - - -* POUR OBTENIR PLUS D'AIDE --------------------------- - -Dans ce tutoriel, nous avons essayé de vous fournir assez de -connaissance pour commencer à utiliser Emacs. Emacs est tellement -riche en possibilités qu'il serait impossible de tout dire -ici. Cependant, vous souhaiterez surement à un moment ou un autre -avoir plus de renseignements sur ses énormes possibilités. Emacs -comprend entre autres des commandes d'aide sur sa propre -utilisation. Toutes ces commandes d'aide commencent par le préfixe -C-h, le «caractère d'aide». - -Typiquement, vous tapez C-h, puis un caractère indiquant quelle aide -vous souhaitez obtenir. Si vous êtes VRAIMENT perdu, tapez C-h ? et -Emacs vous indiquera quelles sortes d'aide il peut vous fournir. Si -vous ne désirez finalement pas d'aide après avoir tapé C-h, tapez -simplement C-g. - -(Quelques sites redéfinissent la commande C-h. Cela ne devrait vraiment -pas être fait, donc allez vous plaindre à votre administrateur système. -Si C-h ne marche pas, tapez M-x help.) - -L'aide de base est C-h c. Tapez C-h c puis une commande (même une -séquence comme C-x f), et Emacs vous donnera une brève description de -la commande en question. - ->> Tapez C-h c C-p. - Le message doit ressembler à quelque chose comme - - C-p runs the command previous-line - -Cela vous donne le «nom de la fonction». Les noms de fonctions sont -principalement utilisés pour customiser Emacs, mais comme en général -ils sont choisi de manière à indiquer ce que fait la commande, ils -peuvent servir de courte documentation (au moins pour vous rappeler -les commandes que vous avez déjà apprises). - -Pour de plus amples informations sur les commandes, utilisez C-h k au -lieu de C-h c. - ->> Tapez C-h k C-p. - -Ceci affiche la documentation sur la fonction, ainsi que son nom dans -une autre fenêtre. Quand vous avez fini de lire, tapez 'q' pour -éliminer la fenêtre d'aide. - -Voici d'autres aides utiles: - - C-h f Décrire une fonction. Vous donnez son nom. - ->> Tapez C-h f previous-line. - Cela vous donne toute l'information dont Emacs dispose sur la - fonction appelée par la commande C-p. - - C-h a Hyper Apropos. Tapez un mot-clé et Emacs vous - affichera toutes les fonctions ou variables contenant - ce mot-clé. Les commandes que vous pouvez appeler - grâce à M-x ont un astérisque à gauche de leur nom. - ->> Tapez C-h a newline. - -Tapez pour effacer l'à-propos, ou cliquez avec le bouton du -milieu sur un nom pour obtenir l'aide sur cette fonction ou variable. - - -* CONCLUSION ------------- - -Rappelez-vous bien, pour quitter définitivement Emacs, tapez C-x -C-c. Pour quitter temporairement (et pour pouvoir revenir), tapez C-z -(sous X Windows, C-z iconifie la fenêtre). - -Ce tutoriel est fait pour être compréhensible par tout nouvel -utilisateur. Donc si quelque chose n'est pas clair, n'hésitez pas à -vous plaindre !! - -Si vous avez plus particulièrement des remarques à faire sur la -version française, vous pouvez aussi me contacter directement -(Didier Verna ). - - -COPIES / DISTRIBUTION ---------------------- - -Un peu d'histoire ... - -* Le premier tutoriel pour l'Emacs d'origine fut écrit par Stuart - Cracraft. -* Ben Wing l'a mis à jour pour X Windows. -* Martin Buchholz et Hrvoje Niksic y ont apporté des corrections pour - XEmacs. -* J'en (Didier Verna) ai fait une version française un beau jour de 1997. - -Cette version du tutoriel, tout comme Emacs, est copyrightée, et vous -est fournie avec la permission d'en distribuer des copies sous -certaines conditions (je laisse la notice du copyright en anglais): - -Copyright (c) 1997, Didier Verna. - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and permission notice are preserved, - and that the distributor grants the recipient permission - for further redistribution as permitted by this notice. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last altered them. - -Les conditions pour copier Emacs lui-même sont plus complexes, mais -dans le même état d'esprit. Vous êtes conviés à lire le fichier -COPYING et à distribuer Emacs à vos amis. Aidez-nous à tuer -l'obstructionnisme logiciel en utilisant, écrivant et partageant du -logiciel libre! - diff --git a/etc/TUTORIAL.ja b/etc/TUTORIAL.ja deleted file mode 100644 index e7cfc57..0000000 --- a/etc/TUTORIAL.ja +++ /dev/null @@ -1,741 +0,0 @@ - ============================== - $BF|K\8l(B GNUEMACS(Mule) $BF~LgJT(B - ============================== - -$BCm0U!'(B $B$3$NF~LgJT$O!"!V=,$&$h$j47$l$m!W$r%b%C%H!<$K:n@.$5$l$F$$$^(B - $B$9!#(B">>" $B$+$i;O$^$k9T$O!"$=$N;~2?$r$9$Y$-$+$r;X<($7$F$$$^$9!#(B - - - Mule $B$N%3%^%s%I$rF~NO$9$k$H$-$K$O!"0lHLE*$K%3%s%H%m!<%k!&%-! $B%3%s%H%m!<%k!&%-!<$r2!$7$?$^$^!"(B<$BJ8;z(B>$B%-!<$r2!$7$^$9!#Nc$($P!"(B - C-f $B$O!"%3%s%H%m!<%k!&%-!<$r2!$7$J$,$i(B f $B$N%-!<$r2!$9$3$H$r(B - $B0UL#$7$^$9!#(B -<> - >> $B$=$l$G$O!"(BC-v$B!J(BView Next Screen; $B $B%(%9%1!<%W!&%-!<$r2!$7$F$+$iN%$7!"$=$l$+$i(B<$BJ8;z(B>$B%-!<$r2!$7$^(B - $B$9!#(B - -$BCm0U!'(B <$BJ8;z(B>$B$O!"BgJ8;z$G$b>.J8;z$G$b%3%^%s%I$H$7$F$OF1$80UL#$K$J$j(B - $B$^$9!#%a%?%-!<$,;H$($k$J$i$P(B ESC <$BJ8;z(B> $B$NBe$o$j$K(B M-<$BJ8;z(B> - ($B%a%?%-!<$r2!$7$?$^$^(B<$BJ8;z(B>$B%-!<$r2!$9(B) $B$,;H$($^$9!#(B - -$B=EMW$G$9!'(B Emacs$B$r=*N;$5$;$?$$;~$O!"(BC-x C-c $B$r%?%$%W$7$^$9!#(BEmacs$B$r(Bcsh - $B$+$i5/F0$7$F$$$k>l9g!"%5%9%Z%s%I$9$k!J0l;~E*$K;_$a$k(B)$B$3$H$,(B - $B=PMh$^$9!#(BEmacs$B$r%5%9%Z%s%I$9$k$K$O!"(BC-z$B$r%?%$%W$7$^$9!#(B - - - $B$5$F!"$3$l$+$i$O!"0l2hLLJ,FI$_=*$($?$i!"(BC-v $B$rF~NO$7$F9T$C$F2<$5$$!#(B - - $BA0$N2hLL$H> ESC v $B$H(B C-v $B$r;H$C$F!"A08e$K0\F0$9$k$3$H$r2?2s$+;n$7$F$_$J$5$$!#(B - -$BMWLs(B -==== - $B%U%!%$%k$r2hLLKh$K8+$F9T$/$K$O!"$9!#$3$N$H$-!"85%+!<%=%k$N$"$C$?9T$,(B - $B2hLL$NCf1{$K$/$k$h$&$K$9$k(B - - >> $B:#%+!<%=%k$,$I$3$K$"$k$+!"$=$N6a$/$K$I$s$J%F%-%9%H$,=q$+$l$F$$$k(B - $B$+$r3P$($J$5$$!#(BC-l $B$r%?%$%W$7!"%+!<%=%k$,$I$3$K0\F0$7$?$+!"$=$N(B - $B6a$/$N%F%-%9%H$O$I$&$J$C$?$+$rD4$Y$F$_$J$5$$!#(B - -$B4pK\E*$J%+!<%=%k$N@)8f(B -====================== - - $B2hLLKh$N0\F0$O$G$-$k$h$&$K$J$j$^$7$?!#:#EY$O!"2hLL$NCf$G!"FCDj$N>l=j$K(B -$B0\F0$9$k$?$a$NJ}K!$r21$($^$7$g$&!#$3$l$K$O$$$/$D$+$N$d$jJ}$,$"$j$^$9!#0l$D(B -$B$NJ}K!$O!"A0(B(previous)$B$l!"(BC-p, C-n, C-f,C-b $B$K3d$jEv$F$i$l$F(B -$B$*$j!"8=:_$N>l=j$+$i?7$7$$>l=j$K%+!<%=%k$r0\F0$5$;$^$9!#?^$G=q$1$P!"(B - - - $BA0$N9T!$(BC-p - : - : - $B8e$NJ8;z!$(BC-b .... $B8=:_$N%+!<%=%k0LCV(B .... $B@h$NJ8;z!$(BC-f - : - : - $B$l!"(BPrevious, Next, Backward, Forward $B$NF,J8;z$K$J$C$F(B -$B$$$k$N$G!"21$($d$9$$$G$7$g$&!#$3$l$i$O!"4pK\E*$J%+!<%=%k0\F0%3%^%s%I$G$"$j!"(B -$B$$$D$G$b;H$&$b$N$G$9!#(B - - >> C-n $B$r2?2s$+%?%$%W$7!"!J:#!"$"$J$?$,FI$s$G$$$k!K$3$N9T$^$G%+!<%=(B - $B%k$r0\F0$5$;$J$5$$!#(B - - >> C-f $B$r;H$C$F9T$NCf$[$I$K0\F0$7!"(BC-p $B$G2?9T$+>e$K0\F0$7$F$_$J$5(B - $B$$!#%+!<%=%k$N0LCV$NJQ2=$KCm0U$7$J$5$$!#(B - - >> $B9T$N@hF,$G(B C-b $B$r%?%$%W$7$F$_$J$5$$!#%+!<%=%k$O$I$3$K0\F0$7$^$9$+(B - $B!)$5$i$K$b$&>/$7(B C-b $B$r%?%$%W$7!":#EY$O(B C-f $B$G9TKv$NJ}$KLa$j$J$5(B - $B$$!#%+!<%=%k$,9TKv$r1[$($k$H$I$&$J$j$^$9$+!)(B - - - $B2hLL$N@hF,$dKvHx$r1[$($F%+!<%=%k$r0\F0$5$;$h$&$H$9$k$H!"$=$NJ}8~$K$"$k(B -$B%F%-%9%H$,0\F0$7$FMh$F!"%+!<%=%k$O>o$K2hLLFb$K$"$k$h$&$K$5$l$^$9!#(B - - >> C-n $B$r;H$C$F!"%+!<%=%k$r2hLL$N2> ESC f $B$d(B ESC b $B$r2?2s$+%?%$%W$7$F$_$J$5$$!#(BC-f $B$d(B C-b $B$HJ;MQ$7$F(B - $B$_$J$5$$!#(B - - C-f $B$d(B C-b $B$KBP$9$k!"(BESC f $B$d(B ESC b $B$NN`;w@-$KCmL\$7$^$7$g$&!#B?$/$N(B -$B>l9g!"(BESC <$BJ8;z(B>$B$OJ8=q4X78$N=hM}$K;H$o$l!"0lJ}(BC-<$BJ8;z(B>$B$O$=$l$h$j$b$b$C$H4p(B -$BK\E*$JBP>]!JJ8;z$H$+9T$H$+!K$KBP$9$kA`:n$K;H$o$l$^$9!#(B - - C-a $B$H(B C-e $B$bCN$C$F$$$FJXMx$J%3%^%s%I$G$9!#(BC-a $B$O%+!<%=%k$r9T$N@hF,$K(B -$B0\F0$5$;!"(BC-e $B$O9T$NKvHx$K0\F0$5$;$^$9!#(B - - - >> C-a $B$r#22s!"$=$l$+$i(B C-e $B$r#22sF~NO$7$F$_$J$5$$!#$3$l$i$N%3%^%s%I(B - $B$r#22s0J>e7+JV$7$F$b!"%+!<%=%k$O$=$l0J>e0\F0$7$J$$$3$H$KCm0U!#(B - - $B$"$HFs$D!"4JC1$J%+!<%=%k0\F0%3%^%s%I$,$"$j$^$9!#%U%!%$%k$N@hF,$K0\F0$9(B -$B$k(B ESC < $B$H!"%U%!%$%k$NKvHx$K0\F0$9$k(B ESC > $B$G$9!#(B - - $B%F%-%9%HCf$G%+!<%=%k$NB8:_$9$k0LCV$r!V%]%$%s%H!W$H8F$S$^$9!#8@$$$+$($l(B -$B$P!"%+!<%=%k$O!"%F%-%9%H$N$I$3$K%]%$%s%H$,$"$k$+$r2hLL>e$G<($7$F$$$k$N$G$9!#(B - - $B0J2<$KC1=c$J0\F0A`:n$K$D$$$FMWLs$7$^$9!#$3$N$J$+$K$O!"C18l$d9TC10L$G$N(B -$B0\F0%3%^%s%I$b4^$^$l$F$$$^$9!#(B - - C-f $B0lJ8;z@h$K?J$`(B - C-b $B0lJ8;z8e$KLa$k(B - - ESC f $B0lC18l@h$K?J$`(B - ESC b $B0lC18l8e$KLa$k(B - - C-n $B $B%U%!%$%k$N:G8e$K0\F0(B - - >> $B3F!9$N%3%^%s%I$r;n$7$F$_$J$5$$!#$3$l$i$N%3%^%s%I$O!":G$b$7$P$7$P(B - $B;H$o$l$k$b$N$G$9!#:G8e$NFs$D$G$O!"$3$N>l=j$H$ON%$l$?$H$3$m$K0\F0(B - $B$9$k$N$G!"(B C-v $B$d(B ESC v $B$r;H$C$F$3$3$KLa$C$FMh$k$h$&$K$7$J$5$$!#(B - - Emacs$B$NB>$N%3%^%s%I$HF1MM$K!"$3$l$i$N%3%^%s%I$K$O!"7+$jJV$7$N2s?t$r;X(B -$BDj$9$k0z?t(B $B$rM?$($k$3$H$,$G$-$^$9!#$=$N$?$a$K$O!"%3%^%s%I$rF~NO$9$kA0$K!"(B -C-u$B$KB3$$$F7+$jJV$92s?t$rF~NO$7$^$9!#(B - - $BNc$($P!"(BC-u 8 C-f $B$H$9$k$H!"#8J8;zJ,@h$K0\F0$7$^$9!#(B - - >> C-n $B$"$k$$$O(B C-p $B$KE,Ev$J0z?t$r;XDj$7$F!"0l2s$N0\F0$G$J$k$Y$/$3(B - $B$N9T$N6a$/$KMh$k$h$&$K$7$F$_$J$5$$!#(B - - C-v $B$d(B ESC v $B$K$D$$$F$O>/$70c$$$^$9!#$3$N>l9g!";XDj$5$l$??t$N9T$@$12h(B -$BLL$r0\F0$9$k$3$H$K$J$j$^$9!#(B - - >> C-u 3 C-v $B$HF~NO$7$F$_$J$5$$!#(B - - $B85$KLa$k$K$O!"(BC-u 3 ESC v $B$r;H$($P$h$$$N$G$9!#(B - -$BCf;_%3%^%s%I(B -============ - - C-g $B$H$$$&%3%^%s%I$G!"F~NO$rI,MW$H$9$k$h$&$J%3%^%s%I$rCf;_$9$k$3$H$,(B -$B$G$-$^$9!#Nc$($P!"0z?t$rF~NO$7$F$$$kESCf$d!"#2$D0J>e$N%-!> C-u 100 $B$r%?%$%W$7$F0z?t$r#1#0#0$K@_Dj$7!"(BC-g $B$r%?%$%W$7$J$5$$!#(B - $B$=$N$"$H$G(B C-f $B$r%?%$%W$7$F$_$J$5$$!#2?J8;z0\F0$7$^$7$?$+!)$b$7(B - $B4V0c$C$F(B ESC $B$rF~NO$7$F$7$^$C$?;~$b!"(BC-g $B$rF~NO$9$l$PC$;$^(B - $B$9!#(B - -$B%(%i!<(B -====== - - $B;~$K$O!"(BEmacs$B$G5v$5$l$F$$$J$$A`:n$r$7$F$7$^$&$3$H$,$"$j$^$9!#Nc$($P!"(B -$B%3%^%s%I$NDj5A$5$l$F$$$J$$%3%s%H%m!<%k!&%-!<$rF~NO$7$F$7$^$C$?;~$K$O!"(BEmacs -$B$O%Y%k$rLD$i$7!"$5$i$K!"2hLL$N0lHV2<$K!"2?$,0-$+$C$?$+$rI=<($7$^$9!#(B - - Emacs$B$N%P!<%8%g%s$K$h$C$F$O!"$3$NF~LgJT$K=q$+$l$F$$$k$3$H$rl9g$,$"$jF@$^$9!#$=$NMM$J>l9g$K$O!"%(%i!<%a%C%;!<%8$,I=<($5$l$^$9$+$i!"(B -$B2?$+%+!<%=%k0\F0%-!<$r2!$7$F!"$=$N$l$KBP$7$F%F%-%9%H$r(B -$BI=<($9$k$3$H$,$G$-$^$9!#%X%k%W$d!"4v$D$+$N%3%^%s%I$+$i$N=PNO$rI=<($9$k$?$a(B -$B$K8=$l$?M>J,$J%&%#%s%I%&$r>C$9$?$a$K!"$N%&%#%s%I%&$r>C$7$F!"%+!<%=%k$N$"$k%&%#%s%I%&$r!"2hLLA4BN(B -$B$K9-$2$^$9!#(B - - >> $B%+!<%=%k$r$3$N9T$K;}$C$F$-$F!"(BC-u 0 C-l $B$H%?%$%W$7$^$9!#(B - - >> C-h k C-f $B$H%?%$%W$7$J$5$$!#?7$7$$%&%#%s%I%&$,(B C-f $B%3%^%s%I$N%I%-(B - $B%e%a%s%H$rI=<($9$k$?$a$K8=$l$k$HF1;~$K!"$3$N%&%#%s%I%&$,$I$N$h$&(B - $B$K=L$`$+$r4Q;!$7$J$5$$!#(B - - >> C-x 1$B$H%?%$%W$7$F!"%I%-%e%a%s%H$N8=$o$l$F$$$?%&%#%s%I%&$r>C$7$J$5(B - $B$$!#(B - -$BA^F~$H:o=|(B -========== - - $B%F%-%9%H$r%?%$%W$7$?$1$l$P!"C1$K$=$l$r%?%$%W$9$k$@$1$G9=$$$^$;$s!#L\$K(B -$B8+$($kJ8;z!J(B'A','7','*','$B$"(B'$B$J$I!K$O(BEmacs$B$K$h$C$F%F%-%9%H$G$"$k$H$_$J$5$l!"(B -$B$=$N$^$^A^F~$5$l$^$9!#9T$N=*$o$j$O2~9TJ8;z$GI=$5$l!"$3$l$rF~NO$9$k$K$O(B - $B$r%?%$%W$7$^$9!#(B - - $BD>A0$KF~NO$7$?J8;z$r:o=|$9$k$K$O!"(B $B$rF~NO$7$^$9!#(B $B$O!"(B -$B%-!<%\!<%I$G!V(BDelete$B!W$H=q$$$F$"$k%-!<$r2!$7$FF~NO$7$^$9!#!V(BDelete$B!W$N$+$o(B -$B$j$K!V(BRubout$B!W$H=q$$$F$"$k$+$bCN$l$^$;$s!#$h$j0lHLE*$K$O!"(B $B$O!"8=:_(B -$B%+!<%=%k$N$"$k0LCV$ND>A0$NJ8;z$r:o=|$7$^$9!#(B - - >> $BJ8;z$r$$$/$D$+%?%$%W$7!"$=$l$+$i$=$l$i$r(B $B$r;H$C$F:o=|$7(B - $B$J$5$$!#(B - - >> $B1&%^!<%8%s$r1[$($k$^$G%F%-%9%H$r%?%$%W$7$J$5$$!#%F%-%9%H$,0l9T$N(B - $BI}0J>e$KD9$/$J$k$H!"$=$N9T$O2hLL$+$i$O$_=P$7$F!V7QB3!W$5$l$^$9!#(B - $B1&C<$K$"$k(B'\'$B5-9f$O!"$=$N9T$,7QB3$5$l$F$$$k$3$H$rI=$7$F$$$^$9!#(B - Emacs$B$O!"8=:_JT=8Cf$N0LCV$,8+$($k$h$&$K9T$r%9%/%m!<%k$7$^$9!#2hLL(B - $B$N1&$"$k$$$O:8$NC<$K$"$k(B'\'$B5-9f$O!"$=$NJ}8~$K9T$,$^$@B3$$$F$$$k$3(B - $B$H$rI=$7$F$$$^$9!#(B - - $B$3$l$O!"J8>O$G@bL@$9$k$h$j> $B@h$[$IF~NO$7$?!"7QB3$5$l$?9T$N>e$K%+!<%=%k$r$b$C$F$$$-!"(BC-d $B$G%F(B - $B%-%9%H$r:o=|$7$F!"%F%-%9%H$,0l9T$K<}$^$k$h$&$K$7$F$_$J$5$$!#7QB3(B - $B$rI=$9(B'\'$B5-9f$O>C$($^$7$?$M!#(B - - >> $B%+!<%=%k$r9T$N@hF,$K0\F0$7!"(B $B$rF~NO$7$J$5$$!#$3$l$O$=$N9T(B - $B$ND>A0$N9T6g@Z$j$r:o=|$9$k$N$G!"$=$N9T$,A0$N9T$H$D$J$,$C$F$7$^$$(B - $B$^$9!#$D$J$,$C$?9T$,2hLL$NI}$h$jD9$/$J$k$H!"7QB3$NI=<($,$5$l$k$G(B - $B$7$g$&!#(B - - >> $B$r2!$7$F!"$b$&0lEY9T6g@Z$j$rA^F~$7$J$5$$!#(B - - Emacs$B$N$[$H$s$I$N%3%^%s%I$O!"7+$jJV$7$N2s?t$rM?$($k$3$H$,$G$-$^$9!#$3(B -$B$N$3$H$O!"J8;z$NA^F~$K$D$$$F$bEv$F$O$^$j$^$9!#(B - - >> C-u 8 * $B$HF~NO$7$F$_$J$5$$!#$I$&$J$j$^$7$?$+!#(B - - $BFs$D$N9T$N4V$K6uGr9T$r:n$j$?$$>l9g$K$O!"FsHVL\$N9T$N@hF,$K9T$-!"(BC-o $B$r(B -$BF~NO$7$^$9!#(B - - >> $BE,Ev$J9T$N@hF,$K9T$-!"$=$3$G(B C-o $B$rF~NO$7$F$_$J$5$$!#(B - - $B$3$l$G!"(BEmacs$B$G!"%F%-%9%H$rF~NO$7!"$^$?4V0c$$$r=$@5$9$k$b$C$H$b4pK\E*(B -$B$JJ}K!$r3X$s$@$3$H$K$J$j$^$9!#J8;z$HF1$8MM$K!"C18l$d9T$b:o=|$9$k$3$H$,$G$-(B -$B$^$9!#:o=|A`:n$K$D$$$FMWLs$9$k$H $B%+!<%=%k$ND>A0$NJ8;z$r:o=|(B - C-d $B%+!<%=%k$N$"$kJ8;z$r:o=|(B - - ESC $B%+!<%=%k$ND>A0$NC18l$r:o=|(B - ESC d $B%+!<%=%k0LCV0J9_$K$"$kC18l$r:o=|(B - - C-k $B%+!<%=%k0LCV$+$i9TKv$^$G$r:o=|(B - - $B2?$+$r:o=|$7$?8e$G!"$=$l$r85$KLa$7$?$/$J$k$3$H$,$"$j$^$9!#(BEmacs$B$O!"0l(B -$BJ8;z$h$j$bBg$-$$C10L$G:o=|$r9T$C$?;~$K$O!":o=|$7$?FbMF$rJ]B8$7$F$*$-$^$9!#(B -$B85$KLa$9$K$O!"(BC-y $B$r;H$$$^$9!#Cm0U$7$?$$$N$O!"(BC-y $B$r:o=|$r9T$C$?>l=j$@$1$G(B -$B$O$J$/!"$I$3$K$G$b=PMh$k$3$H$G$9!#(BC-y $B$O!"J]B8$5$l$?%F%-%9%H$r8=:_%+!<%=%k(B -$B$N$"$k>l=j$KA^F~$9$k$?$a$N%3%^%s%I$G$9$+$i!"$3$l$r;H$C$F%F%-%9%H$N0\F0$r9T(B -$B$&$3$H$,$G$-$^$9!#(B - - $B:o=|$r9T$&%3%^%s%I$K$O!"(B"Delete" $B%3%^%s%I$H!"(B"Kill" $B%3%^%s%I$H$,$"$j$^(B -$B$9!#(B"Kill" $B%3%^%s%I$G$O:o=|$5$l$?$b$N$OJ]B8$5$l$^$9$,!"(B"Delete" $B%3%^%s%I$G(B -$B$OJ]B8$5$l$^$;$s!#$?$@$7!"7+$jJV$72s?t$,M?$($i$l$k$H!"J]B8$5$l$^$9!#(B - - >> C-n $B$r#22s$[$I%?%$%W$7$F!"2hLL$NE,Ev$J>l=j$K0\F0$7$J$5$$!#$=$7$F!"(B - C-k $B$G!"$=$N9T$r:o=|$7$J$5$$!#(B - - $B0l2sL\$N(B C-k $B$G$=$N9T$NFbMF$,:o=|$5$l!"$b$&0lEY(B C-k $B$rF~NO$9$k$H!"$=$N(B -$B9T<+?H$,:o=|$5$l$^$9!#$b$7!"(BC-k $B$K7+$jJV$72s?t$r;XDj$7$?>l9g$K$O!"$=$N2s?t(B -$B$@$1$N9T$,!JFbMF$H9T<+?H$H$,F1;~$K!K:o=|$5$l$^$9!#(B - - $B:#:o=|$5$l$?%F%-%9%H$O!"J]B8$5$l$F$$$k$N$G!"$=$l$r> C-y $B$r;n$7$F$_$J$5$$!#(B - - C-k $B$r2?EY$bB3$1$F9T$&$H!":o=|$5$l$k%F%-%9%H$O!"$^$H$a$FJ]B8$5$l!"(BC-y -$B$G!"$=$NA4$F$,> C-k $B$r2?EY$b%?%$%W$7$F$_$J$5$$!#(B - - >> $B%F%-%9%H$r$N%F%-%9%H$r:o=|$9$k$H$I$&(B -$B$J$k$G$7$g$&$+!#(BC-y $B$O!"$b$C$H$b:G6a:o=|$5$l$?$b$N$r> $B9T$r:o=|$7!"%+!<%=%k$r0\F0$5$;!"JL$N9T$r:o=|$7$J$5$$!#(BC-y $B$r9T$&(B - $B$H!"#2HVL\$N9T$,F@$i$l$^$9!#(B - -$BC$7(B(UNDO) -============== - - $B$$$D$G$b!"%F%-%9%H$rJQ99$7$?$1$l$I$b!"$=$l$r$b$H$KLa$7$?$$$H$-$O(BC-x u -$B$GD>$j$^$9!#IaDL$O4V0c$($?%3%^%s%I$rL58z$K$9$kF/$-$r$7$^$9!#7+$jJV$7$F(BUNDO -$B$r9T$J$*$&$H$9$k;~$O!"2?EY$b$=$N%3%^%s%I$r9T$J$($P=PMh$k$h$&$K$J$C$F$$$^$9!#(B - - >> $B$3$N9T$r(BC-k$B$G>C$7$F2<$5$$!#$=$7$F!"(BC-x u$B$GLa$7$F2<$5$$!#(B - - C-_$B$O!"(BUNDO$B$r9T$J$&!"$b$&0l$D$N%3%^%s%I$G$9!#5!G=$O!"(BC-x u$B$HF1$8$G$9!#(B - - C-_$B$d(BC-x u$B$K(BUNDO$B$N2s?t$r!"M?$($k$3$H$,=PMh$^$9!#(B - - -$B%U%!%$%k(B -======== - - $B%F%-%9%H$X$NJQ99$r1J5WE*$K$9$k$?$a$K$O!"$=$l$r%U%!%$%k$KJ]B8$7$J$1$l$P(B -$B$J$j$^$;$s!#J]B8$5$l$J$$$H!"$[$I$3$7$?JQ99$O!"(BEmacs$B$r=*N;$9$k$HF1;~$K<:$o$l(B -$B$F$7$^$$$^$9!#(B - - $B$$$^8+$F$$$k%U%!%$%k$KBP$7$F!"$"$J$?$NJT=8$r9T$C$?$b$N$r=q$-9~$_$^$9!#(B -$B$$$^8+$F$$$k%U%!%$%k$H$O!"4JC1$K$$$($PJT=8$7$F$$$k%U%!%$%k<+BN$N$3$H$G$9!#(B - - $B$"$J$?$,%U%!%$%k$r%;!<%V!JJ]B8$9$k!K$9$k$^$G!":#$^$G$NJQ99$OJT=8$7$F$$(B -$B$k%U%!%$%k$K=q$-9~$^$l$k;v$O$"$j$^$;$s!#$=$l$O!"$"$J$?$,$=$N$h$&$K9T$$$?$/(B -$B$J$$$N$K!"ESCf$^$GJQ99$r2C$($?$b$N$,>!A0(B -$B$rJQ$($F%*%j%8%J%k$N%U%!%$%k$r;D$7$^$9!#(B - -$BHw9M(B: $B$^$?!"(BEmacs$B$OITB,$N;vBV$KBP$7!"0lDj$N%?%$%_%s%0$4$H$K<+F0E*(B - $B$KJT=8$7$F$$$k%U%!%$%k$NFbMF$rL>A0$rJQ$($?%U%!%$%k$K%;!<%V$7(B - $B$^$9!#$3$l$K$h$C$F!"K|0l$N>l9g$O9T$C$?$NJQ99$KBP$7:G>.8B$NHo(B - $B32$G:Q$`$h$&$K$J$C$F$$$^$9!#(B - - $B2hLL$N2<$NJ}$r8+$k$H!"$3$N$h$&$J46$8$G%b!<%I%i%$%s$,I=<($5$l$F$$$k$H;W(B -$B$$$^$9!#(B - - -($BNc(B) [--]J:--**-Mule: MULE.tut (Fundamental) ---55%-------------- - - - $B$3$N(BEmacs$B%A%e!<%H%j%"%k$N%3%T!<$O(BMULE.tut$B$H8F$P$l$F$$$^$9!#%U%!%$%k$r(B -$B%U%!%$%s%I!J%U%!%$%k$r8+$D$1$F%P%C%U%!$KFI$_9~$`$3$H!K$9$k$H!"(BMULE.tut$B$NIt(B -$BJ,$KI=<($5$l$^$9!#Nc$($P!"(Bnew-file$B$H$$$&L>A0$N%U%!%$%k$r%U%!%$%s%I$7$?$J$i(B -$B$P!"(B"Mule: new-file"$B$H$$$&%b!<%I%i%$%s$K$J$k$G$7$g$&!#(B - -$BCm0U!'(B $B%b!<%I%i%$%s$K$D$$$F$O8e$[$I@bL@$7$^$9!#>/$7$*BT$A$r!#(B - - $B%U%!%$%k$r%U%!%$%s%I$7$?$j!"%;!<%V$7$?$j$9$k%3%^%s%I$O!"$3$l$^$G$N$b$N(B -$B$H$O0c$$!"#2$D$NJ8;z$+$i$J$C$F$$$^$9!#(BC-x $B$KB3$$$FF~NO$9$kJ8;z$,!"%U%!%$%k(B -$B$KBP$7$F9T$&A`:n$rI=$7$^$9!#(B - - $B$b$&0l$D$3$l$^$G$N$b$N$H0c$&E@$O!"%U%!%$%s%I$N;~!"%U%!%$%kL>$r(BEmacs$B$K(B -$BLd$o$l$^$9!#$3$N$3$H$r!"Cl9g$O%U%!%$%kL>$G$9!#(B - - C-x C-f $B%U%!%$%k$r8+$D$1$k!J%U%!%$%s%I$9$k!K(B - - Emacs$B$O%U%!%$%kL>$rJ9$$$F$-$^$9!#$=$l$O!"2hLL$N2<$N9T$K8=$l$^$9!#%U%!(B -$B%$%kL>$r;XDj$7$F$$$kItJ,$O!"%_%K%P%C%U%!$H8F$P$l$k$b$N$G$9!#%_%K%P%C%U%!$O(B -$B$3$NMM$J;H$o$lJ}$r$7$^$9!#%U%!%$%kL>$KB3$$$F!"%j%?!<%s%-!<$r2!$9$H!"%_%K%P(B -$B%C%U%!$KI=<($5$l$F$$$?FbMF$O$b$&I,MW$G$O$J$/$J$k$N$G>C$($F$7$^$$$^$9!#(B - - >> C-x C-f$B$H%?%$%W$7$?8e$K(BC-g$B$H%?%$%W$7$F2<$5$$!#%_%K%P%C%U%!$NFbMF(B - $B$rC$7!"$^$?!"(BC-x C-f$B%3%^%s%I$bC$7$^$9!#$H8@$&Lu$G!"2?$b(B - $B%U%!%$%k$r8+$D$1$k$h$&$J$3$H$O$7$^$;$s!#(B - - $B:#EY$O%U%!%$%k$r%;!<%V$7$F$_$^$7$g$&!#:#$^$G$NJQ99$rJ]B8$9$k$?$a$K$OA0$r$D$1$i$l$F;D$5$l$F$$$k$N$GFbMF$O<:$o$l$^$;$s!#$=(B -$B$N?7$7$$L>A0$O%*%j%8%J%k$N%U%!%$%k$NL>A0$K(B'~'$B$r$D$1$?$b$N$G$9!#(B - - $B%;!<%V$,=*$o$k$H!"(BEmacs$B$O%;!<%V$7$?%U%!%$%k$NL>A0$rI=<($7$^$9!#(B - - >> C-x C-s$B$H%?%$%W$7$F%A%e!<%H%j%"%k$N%3%T!<$r%;!<%V$7$F2<$5$$!#$=$N(B - $B;~!"2hLL$N2<$NJ}$K(B"Wrote ...../MULE.tut"$B$HI=<($5$l$^$9!#(B - - $B?7$7$$%U%!%$%k$r:n$k;~!"$"$?$+$b0JA0$+$i$"$C$?%U%!%$%k$r%U%!%$%s%I$9$k(B -$B$h$&$J%U%j$r$7$^$9!#$=$&$7$F!"$=$N%U%!%$%s%I$7$?%U%!%$%k$K%?%$%W$7$F$$$-$^(B -$B$9!#(B - - $B%U%!%$%k$r%;!<%V$7$h$&$H$7$?;~$K=i$a$F!"(BEmacs$B$O:#$^$GJT=8$7$F$$$?FbMF(B -$B$r%U%!%$%k$NCf$K=q$-9~$_$^$9!#(B - - -$B%P%C%U%!(B -======== - - $B$b$7!"#2HVL\$N%U%!%$%k$r(B C-x C-f $B$G> C-x C-b $B$H%?%$%W$7$J$5$$!#$=$l$>$l$N%P%C%U%!$,$I$N$h$&$KL>A0$r;}(B - $B$C$F$$$k$+!"$=$7$F!"$I$N$h$&$J%U%!%$%kL>$r$D$1$F$$$k$N$+4Q;!$7$J(B - $B$5$$!#(B - - $B%P%C%U%!$K$O%U%!%$%k$H0lCW$J$$$b$N$b$"$j$^$9!#$?$H$($P!"(B -"*Buffer List*" $B$H$$$&%U%!%$%k$O$"$j$^$;$s!#$3$l$O(B C-x C-b $B$K$h$C$F:n$i$l(B -$B$?%P%C%U%!%j%9%H$KBP$7$F$N%P%C%U%!$G$9!#(B - - $B$"$J$?$,8+$F$$$k(BEmacs$B%&%#%s%I%&Fb$K$"$k!"$I$s$J%F%-%9%H$G$b!"$$$:$l$+(B -$B$N%P%C%U%!Fb$K$"$j$^$9!#(B - - >> $B%P%C%U%!%j%9%H$r>C$9$?$a(B C-x 1 $B$H%?%$%W$7$J$5$$!#(B - - $B$b$7!"$"$k%U%!%$%k$N%F%-%9%H$KJQ99$r9T$J$C$F$+$i!"B>$N%U%!%$%k$rA0$K$h$k3HD%!#B3$1$F%3%^%s%I$NL>A0$rF~NO$7$^$9!#(B - - $B$3$l$i$O0lHL$K!"JXMx$@$1$l$I$b!"$3$l$^$G8+$F$-$?$b$N$[$IIQHK$K$OMQ$$$i(B -$B$l$J$$%3%^%s%I$N$?$a$N$b$N$G$9!#(BC-x C-f $B!J%U%!%$%s%I!K$d(B C-x C-s$B!J%;!<%V!K(B -$B$O$3$NCg4V$G$9!#B>$K!"(BC-x C-c$B!J%(%G%#%?$N=*N;!K$b$=$&$G$9!#(B - - C-z$B$O(BEmacs$B$rH4$1$k$N$KNI$/;H$o$l$kJ}K!$G$9!#(BEmacs$B$r=*N;$9$k$3$H$J$/!"(B -$B0lC6!"(Bcsh$B$N%l%Y%k$KLa$k$K$O0lHVNI$$J}K!$H8@$($k$G$7$g$&!#(BC-z$B$r9T$J$o$l$F$b(B -Emacs$B$O%9%H%C%W$7$F$$$k$@$1$G!"FbMF$,GK2u$5$l$k$H$$$&$3$H$O$"$j$^$;$s!#(B - -$BCm0U(B: $B$?$@$7(BX-window$B$G9T$J$C$F$$$k>l9g!"$b$7$/$O;HMQ$7$F$$$k%7%'%k(B - $B$,(Bsh$B$N;~$O!"$3$N8B$j$G$O$"$j$^$;$s!#(B - - - C-x $B%3%^%s%I$O!"$?$/$5$s$"$j$^$9!#$9$G$K3X$s$@$b$N$O0J2<$N$b$N$G$9!#(B - - C-x C-f $B%U%!%$%k$NJT=8!J(BFind$B!K(B - C-x C-s $B%U%!%$%k$NJ]B8!J(BSave$B!K(B - C-x C-b $B%P%C%U%!%j%9%H$NI=<((B - C-x C-c $B%(%G%#%?$r=*N;$9$k!#%U%!%$%k$NJ]B8$O!"<+F0E*$K$O9T$o$l$^$;(B - $B$s!#$7$+$7!"$b$7%U%!%$%k$,JQ99$5$l$F$$$l$P!"%U%!%$%k$NJ]B8(B - $B$r$9$k$N$+$I$&$+$rJ9$$$F$-$^$9!#J]B8$7$F=*N;$9$kIaDL$NJ}K!(B - $B$O!"(BC-x C-s C-x C-c $B$H$9$k$3$H$G$9!#(B - - $BL>A0$K$h$k3HD%%3%^%s%I$K$O!"$"$^$j;H$o$l$J$$$b$N$d!"FCDj$N%b!<%I$G$7$+(B -$B;H$o$J$$$b$N$J$I$,$"$j$^$9!#Nc$H$7$F!"(B"command-apropos" $B$r$H$j$"$2$^$9!#$3(B -$B$N%3%^%s%I$O%-!<%o!<%I$rF~NO$5$;!"$=$l$K%^%C%A$9$kA4$F$N%3%^%s%I$NL>A0$rI=(B -$B<($7$^$9!#(BESC x $B$H%?%$%W$9$k$H!"%9%/%j!<%s$N2<$K(B "M-x" $B$,I=<($5$l$^$9!#$3$l(B -$B$KBP$7$F!"A0!J:#$N>l9g!"(B"command-apropos"$B!K$rF~NO$7$^$9!#(B -"command-a" $B$^$GF~NO$7$?8e%9%Z!<%9$rF~$l$l$P!"8e$NItJ,$O<+F0E*$KJd$o$l$^$9!#(B -$B$3$N8e!"%-!<%o!<%I$rJ9$+$l$^$9$+$i!"CN$j$?$$J8;zNs$r%?%$%W$7$^$9!#$J$*!"%-!<(B -$B%o!<%I$rF~$l$J$$$H!"A4$F$N%3%^%s%I$,I=<($5$l$^$9!#(B - - >> ESC x $B$r%?%$%W$7!"B3$1$F!"(B"command-apropos" $B$"$k$$$O(B - "command-a" $B$H%?%$%W$7$^$9!#" - $B$H%?%$%W$7$^$9!#(B - - $B8=$l$?!V%&%#%s%I%&!W$r>C$9$K$O!"(BC-x 1 $B$H%?%$%W$7$^$9!#(B - -$B%b!<%I%i%$%s(B -============ - - $B$b$7$f$C$/$j$H%3%^%s%I$rBG$C$?$J$i$P!"2hLL$N2l=j$KBG$C$?$b$N$,I=<($5$l$^$9!#%(%3!<%(%j%"$O2hLL$N(B1$B$P$s2<$N9T$G$9!#$=$N(B -$B$9$0>e$N9T$O!"%b!<%I%i%$%s$H8F$P$l$F$$$^$9!#%b!<%I%i%$%s$O$3$s$JIw$KI=<($5(B -$B$l$F$$$k$G$7$g$&!#(B - - [--]J:--**-Mule: MULE.tut (Fundamental) ---NN%-------------- - - -$BCm0U(B: NN%$B$N(BNN$B$O?t;z$,F~$C$F$$$^$9!#$"$J$?$,;H$C$F$$$k(BEmacs$B$N%b!<(B - $B%I%i%$%s$H0c$&$+$bCN$l$J$$$1$I!"92$F$J$$$h$&$K!#Nc$($P!";~4V(B - $B$d(Buptime$B$,I=<($5$l$F$$$k$N$O!"(Bdisplay-time$B$H$$$&5!G=$,F0$$$F(B - $B$$$k$+$i$G$9!#(B - - $B$3$N9T$K$h$C$FB?$/$NM-MQ$J>pJs$,F@$i$l$^$9!#(B - - - $B:#!"$"$J$?$,8+$F$$$k%U%!%$%kL>$rI=<($7$F$$$^$9!#(BNN%$B$O8=:_%9%/%j!<%s>e(B -$B$K%U%!%$%k$N0lHV>e$+$i2?%Q!<%;%s%HL\$,I=<($5$l$F$$$k$+$r<($7$F$$$^$9!#%U%!(B -$B%$%k$N0lHV:G=i$rI=<($7$F$$$k$J$i$P!"(B--Top--$B$HI=<($5$l$F$^$9!#%U%!%$%k$N0lHV(B -$B:G8e$rI=<($7$F$$$k$J$i$P!"(B--Bot--$B$HI=<($5$l$^$9!#2hLL$NCf$K%U%!%$%k$NA4$F$,(B -$BI=<($5$l$F$$$k$J$i$P!"(B--All--$B$HI=<($5$l$^$9!#(B - - $B%b!<%I%i%$%s$N>.3g8L$NCf$O!":#$I$s$J%b!<%I$KF~$C$F$$$k$+$r<($7$F$$$^$9!#(B -$B8=:_$O!"%G%U%)%k%H$N(BFundamental$B$KF~$C$F$$$^$9!#$3$l$b%a%8%c!<%b!<%I$N0lNc$G(B -$B$9!#(B - - Emacs$B$O(BLisp mode$B$d(BText mode$B$N$h$&$J$3$H$J$k%W%m%0%i%`8@8l$d%F%-%9%H$K(B -$BBP$7$F%(%G%#%C%H$r9T$&$?$a$N4v$D$+$N%a%8%c!<%b!<%I$r;}$C$F$$$^$9!#$I$s$J;~(B -$B$G$bI,$:$$$:$l$+$N%a%8%c!<%b!<%I$N>uBV$K$J$C$F$$$^$9!#(B - - $B$=$l$>$l$N%a%8%c!<%b!<%I$O4v$D$+$N%3%^%s%I$rA4$/0c$&?6$kIq$$$K$7$F$7$^(B -$B$$$^$9!#Nc$r>e$2$F$_$^$7$g$&!#%W%m%0%i%`$NCf$K%3%a%s%H$r:n$k%3%^%s%I$,$"$j(B -$B$^$9!#%3%a%s%H$r$I$NMM$J7A<0$K$9$k$+$O!"3F%W%m%0%i%`8@8l$K$h$C$F0c$$$^$9$,!"(B -$B$=$l$>$l$N%a%8%c!<%b!<%I$O!"$-$A$s$HF~$l$F$/$l$^$9!#(B - - $B$=$l$>$l$N%a%8%c!<%b!<%I$KF~$k$?$a$N%3%^%s%I$O%b!<%IL>$N3HD%$5$l$?$b$N(B -$B$K$J$C$F$$$^$9!#Nc$($P!"(BM-x fundamental-mode$B$O(BFundamental$B$KF~$k$?$a$N$b$N$G(B -$B$9!#(B - - $B$b$7!"1Q8l$r%(%G%#%C%H$9$k$J$i$P!"(BText mode$B$KF~$j$^$9!#(B - - >> M-x text-mode $B$H%?%$%W$7$J$5$$!#(B - - $B8=:_$N%a%8%c!<%b!<%I$K$D$$$F$N%I%-%e%a%s%H$r8+$?$$;~$O!"(BC-h m$B$H%?%$%W(B -$B$7$^$9!#(B - - >> C-h m $B$r;H$C$F(BText mode$B$H(BFundamental mode$B$N0c$$$rD4$Y$J$5$$!#(B - - >> C-x 1$B$G%I%-%e%a%s%H$r2hLL$+$i>C$7$J$5$$!#(B - - $B:8C<$N(B '[--]' $B$O8=:_$N%-!\$7$$@bL@$O(B -$B!V$?$^$4!W$N%^%K%e%"%k$rD4$Y$F2<$5$$!#(B - - $B$=$N$9$01&$K$O%3!<%IBN7O(B (coding-system) $B$K4X$9$k%U%i%0$N>uBV$,I=(B -$B<($5$l$F$$$^$9!#(BMule $B$O!"%U%!%$%kF~=PNO!"F~NO!"2hLL=PNO$K$D$$$F!"$=$l$>$lFH(B -$BN)$K%3!<%IBN7O$r;XDj$5$;$k$3$H$,=PMh$^$9$,!"DL>o$O%U%!%$%kMQ$N%3!<%IBN7O$N(B -$B%K!<%b%K%C%/$N$_I=<($7$F$$$^$9!#(B - - >> $B%b!<%I%i%$%s>e$K(B"J:","S:",$B$b$7$/$O(B "E:"$B$,I=<($5$l$F$$$k$+$I$&$+3N(B - $BG'$7$J$5$$!#(B - - $B:G=i$N0lJ8;z$,%3!<%IBN7O$N%K!<%b%K%C%/!"> C-x C-k t$B$r(B2$BEY9T$$$J$5$$!#(B - - $BF~NO%b!<%I$,(BJIS$B%3!<%I$N@_Dj$H$J$C$F$$$k;~!"$b$7$"$J$?$N;H$C$F$$$kC$B$b(BM-<$BJ8;z(B>$B$bF1$8F/$-$r$7$^$9!#:#$^$G$N@bL@$G(BESC -<$BJ8;z(B>$B$H9T$J$C$F$$$?$H$3$m$,!"(BM-<$BJ8;z(B>$B$H$J$j$^$9!#Cm0U$7$J$1$l$P$J$i$J$$$N(B -$B$O!"%7%U%H(BJIS$B$d(BEUC$B%3!<%I$N;~$O;HMQ$G$-$^$;$s!#(B - - $B%3!<%IBN7O$N$N@Z$jBX$($O!"3F!9$N%P%C%U%!$KBP$7$F$N$_M-8z$G$9!#$=$l$>$l(B -$B$N!"%3!<%IBN7O;XDj$K$D$$$F$O!"(BC-h a coding-system $B$G8+$k$3$H(B -$B$,=PMh$^$9!#(B - - >> C-h a coding-system $B$G=P$F$/$k%I%-%e%a%s%HCf$N!"(B - set-display-coding-system, set-file-coding-system, - set-process-coding-system $B$N@bL@$rFI$_$J$5$$!#(B - -$B8!:w(B -===== - - $BJ8;zNs$r!"%U%!%$%kFb$G!"A0J}Kt$O8eJ}$K!"C5$9;v$,$G$-$^$9!#8!:w$r;O$a$k(B -$B%3%^%s%I$O!"%+!<%=%k0LCV0J9_$r8!:w$9$k$J$i$P(B C-s$B!"%+!<%=%k0LCV0JA0$J$i$P(B -C-r $B$G$9!#(BC-s $B$r%?%$%W$9$k$H!"%(%3!<%(%j%"$K(B "I-search:"$B$H$$$&J8;zNs$,%W%m(B -$B%s%W%H$H$7$FI=<($5$l$^$9!#(BESC$B$r2!$9$H!"=*N;$G$-$^$9!#(B - - - >> C-s$B$G8!:w$,;O$^$j$^$9!#$=$l$+$i!"$f$C$/$j$H#1J8;z$:$D(B"cursor"$B$H$$(B - $B$&C18l$rF~NO$7$^$9!##1J8;zF~NO$9$k$4$H$K!"%+!<%=%k$O!"$I$s$JF0$-(B - $B$r$7$^$9$+(B? - - >> $B$b$EY(B C-s $B$r%?%$%W$9$k$H!"> $B$r#42sF~NO$7$F!"%+!<%=%k$NF0$-$r8+$J$5$$!#(B - - >> ESC$B$r2!$7$F!"=*N;$7$^$9!#(B - - $BC5$7$?$$J8;zNs$r%?%$%WCf$G$b!"%?%$%W$7$?J8;zItJ,$@$1$G!"8!:w$r;O$a$^$9!#(B -$B$B$rF~NO$9$k$H!"8!:wJ8;zNs$N#1HV8e$m$NJ8;z$,>C$($^$9!#(B -$B$=$7$F!"%+!<%=%k$O!"A02s$N0LCV$KLa$j$^$9!#$?$H$($P!"(B"cu"$B$H%?%$%W$7$F!":G=i(B -$B$N(B"cu"$B$N0LCV$K%+!<%=%k$,F0$$$?$H$7$^$9!#$3$3$G(B$B$rF~NO$9$k$H!"%5!<%A(B -$B%i%$%s$N(B'u'$B$,>C$(!"%+!<%=%k$O!"(B'u'$B$r%?%$%W$9$kA0$K!"%+!<%=%k$,$"$C$?(B'c'$B$N0L(B -$BCV$K!"0\F0$7$^$9!#(B - - $B8!:wuBV$K(B -$BF~$k$3$H$,$"$j$^$9!#%a%8%c!<%b!<%I$N>.3g8L(B'()'$B$N2s$j$rCf3g8L(B'[]'$B$G0O$s$@$b(B -$B$N$,%b!<%I%i%$%s>e$KI=<($5$l$^$9!#Nc$($P!"(B(Fundamental)$B$HI=<($5$l$kBe$o$j$K(B -[(Fundamental)]$B$N$h$&$K$J$j$^$9!#(B - -$BCm0U(B: $B$3$3$G$O%j%+!<%7%V(B $B%(%G%#%F%#%s%0(B $B%l%Y%k<+BN$K$D$$$F$O@bL@$7(B - $B$^$;$s!#(B - - $B%j%+!<%7%V(B $B%(%G%#%F%#%s%0(B $B%l%Y%k$+$iH4$1$G$k$?$a$K$O!"(BM-x top-level -$B$H%?%$%W$7$^$9!#(B - - >> $B;n$7$F$_$F2<$5$$!#%9%/%j!<%s$NDl$K(B"Back to top level"$B$HI=<($5$l$^(B - $B$9!#(B - - $BK\Ev$O!"$3$N;n$_$,9T$o$l$?;~$O!"$9$G$K%H%C%W%l%Y%k$K$$$?$N$G$9!#(BM-x -top-level$B$O!"2?$b1F6A$rM?$($F$$$^$;$s!#(B - - $B%j%+!<%7%V(B $B%(%G%#%F%#%s%0(B $B%l%Y%k$+$iH4$1=P$k$N$KBP$7$F$O(BC-g$B$O8z$-$^$;(B -$B$s!#(B - - -$B%X%k%W(B -====== - - Emacs$B$K$O!"$?$/$5$s$NLr$KN)$D5!G=$,$"$j!"$3$3$G!"$9$Y$F$r@bL@$9$k$3$H(B -$B$O!"IT2DG=$G$9!#$7$+$7!"$^$@CN$i$J$$B?$/$N5!G=$r3X$V$?$a$K$O!"(B$B$H8F$P(B -$B$l$k(B C-h $B$r%?%$%W$9$k$3$H$G!"$?$/$5$s$N>pJs$rC$9(B -$B$3$H$,$G$-$^$9!#(B - - $B:G$b4pK\E*$J$b$N$O!"(BC-h c $B$G$9!#$3$l$KB3$$$F%-!<$rF~NO$9$k$H!"$=$N%3%^(B -$B%s%I$K$D$$$F$NC;$$@bL@$rI=<($7$^$9!#(B - - >> C-h c C-p $B$H%?%$%W$7$F$_$J$5$$!#(B"C-p runs the command previous- - line"$B$N$h$&$J%a%C%;!<%8$,I=<($5$l$k$O$:$G$9!#(B - - $B8+$?$3$H$O$"$k$,!"3P$($F$O$$$J$$%3%^%s%I$b;W$$=P$;$k$N$G$9!#(BC-x C-s $B$N(B -$B$h$&$JJ#?t$G#1$D$N%3%^%s%I$b(BC-h c $B$N8e$m$KB3$1$i$l$^$9!#(B - - $B$b$C$H>\$7$/CN$j$?$+$C$?$i!"(Bc $B$NBe$o$j$K(B k $B$r;XDj$7$^$9!#(B - - >> C-h k C-p $B$H%?%$%W$7$F$_$J$5$$!#(B - - Emacs$B$N%&%#%s%I%&$K!"%3%^%s%I$NL>A0$H5!G=$,I=<($5$l$^$9!#FI$_=*$($?$i!"(B -C-x 1 $B$H%?%$%W$9$k$H!"H4$1$i$l$^$9!#(B - - $BB>$K$bLr$KN)$D%*%W%7%g%s$,$"$j$^$9!#(B - - C-h f $B%U%!%s%/%7%g%sL>$rF~NO$9$k$H!"%U%!%s%/%7%g%s$rI=<($7$^$9!#(B - - >> C-h f previous-line $B$r%?%$%W$7!"(B $B$r2!$7$J$5$$!#(BC-p $B%3%^%s(B - $B%I$rpJs$rI=<($7$^$9!#(B - - C-h a $B%-!<%o!<%I$rF~NO$9$k$H!"L>A0$K$=$N%-!<%o!<%I$r4^$`!"A4$F$N%3(B - $B%^%s%I$rI=<($7$^$9!#$3$l$i$N%3%^%s%I$O$9$Y$F(BESC x $B$G> C-h a file $B$H%?%$%W$7!"(B$B$r2!$7$J$5$$!#L>A0$K(B"file"$B$H$$$&J8(B - $B;z$r;}$DA4$F$N%3%^%s%I$rI=<($7$^$9!#$^$?!"(Bfind-file $B$d(B write-file - $B$H$$$&L>$N(B C-x C-f $B$d(B C-x C-w $B$N$h$&$J%3%^%s%I$bI=<($5$l$^$9!#(B - -$B$*$o$j$K(B -======== - -$BK:$l$:$K!'(B $B=*N;$9$k$K$O!"(BC-x C-c $B$H$7$^$9!#(B - - - $B$3$NF~LgJT$O!"$^$C$?$/$N=i?4o$KB?$/$N$3$H$,$G$-$k>l9g$K$OFC$K$=$&$G$7$g(B -$B$&!#$=$7$F!"(BEMACS $B$G$O!"O$O(BGMW + -Wnn + Nemacs$B$r;H$C$F=q$-$^$7$?!#$=$N$h$&$JAG@2$i$7$$%W%m%0%i%`$r:n$C$?J}!9(B -$B$X46M;R$5$s!"$I$&$b$"$j$,$H$&!#(B - - - - - -$B8mLu!"13!"$=$NB>!"$NJ8@U$O!"0J2<$N ÓÌÅÄÕÅÔ ÕÄÅÒÖÉ×ÁÔØ ËÌÁ×ÉÛÕ CONTROL ÐÏËÁ ÎÁÂÉÒÁÅÔÓÑ ÓÉÍ×ÏÌ - ôÁË, C-f ÄÏÌÖÎÏ ÏÚÎÁÞÁÔØ: ÎÁÖÁÔØ ËÌÁ×ÉÛÕ CONTROL É f. - M- ÓÌÅÄÕÅÔ ÕÄÅÒÖÉ×ÁÔØ ËÌÁ×ÉÛÕ META ÐÏËÁ ÎÁÂÉÒÁÅÔÓÑ ÓÉÍ×ÏÌ . - åÓÌÉ ÔÁËÏ×ÏÊ ÎÅÔ, ÎÁÖÍÉÔÅ , ÏÔÐÕÓÔÉÔÅ ÅÅ, ÐÏÔÏÍ ÓÉÍ×ÏÌ . - -÷ÁÖÎÏÅ ÚÁÍÅÞÁÎÉÅ: ÄÌÑ ÚÁ×ÅÒÛÅÎÉÑ ÓÅÁÎÓÁ Emacs, ÎÁÂÅÒÉÔÅ C-x C-c. (ä×Á -ÓÉÍ×ÏÌÁ). óÉÍ×ÏÌÙ ">>" Ó ÌÅ×ÏÊ ÓÔÏÒÏÎÙ ÕËÁÚÙ×ÁÀÔ, ÞÔÏ ×ÁÍ ÎÕÖÎÏ ÄÅÌÁÔØ, -ÞÔÏ ÐÒÉÍÅÎÉÔØ ËÏÍÁÎÄÕ. îÁÐÒÉÍÅÒ: - ->> ôÅÐÅÒØ ÎÁÖÍÉÔÅ C-v (ðÒÏÓÍÏÔÒ ÓÌÅÄÕÀÝÅÇÏ ÜËÒÁÎÁ) ÄÌÑ ÐÅÒÅÍÅÝÅÎÉÑ ÎÁ - ÓÌÅÄÕÀÝÉÊ ÜËÒÁÎ. (ÉÄÉÔÅ ×ÐÅÒÅÄ, ÕÄÅÒÖÉ×ÁÑ ËÌÁ×ÉÛÕ Control ÎÁÖÉÍÁÑ v). - ôÅÐÅÒØ ×Ù ÄÏÌÖÎÙ ÜÔÏ ÓÄÅÌÁÔØ ÅÝÅ ÒÁÚ, ËÏÇÄÁ ÚÁËÏÎÞÉÔÅ ÞÉÔÁÔØ ÜËÒÁÎ. - -ïÂÒÁÔÉÔÅ ×ÎÉÍÁÎÉÅ ÎÁ ÔÏ, ÞÔÏ, ÐÏËÁ ×Ù Ä×ÉÖÅÔÅÓØ Ó ÜËÒÁÎÁ ÎÁ ÜËÒÁÎ, -ÐÅÒÅËÒÙ×ÁÀÔÓÑ Ä×Å ÓÔÒÏÞËÉ; ÜÔÏ ÏÂÅÓÐÅÞÉ×ÁÅÔ ÎÅËÏÔÏÒÕÀ ÎÅÐÒÅÒÙ×ÎÏÓÔØ, ÔÁËÉÍ -ÏÂÒÁÚÏÍ ×Ù ÍÏÖÅÔÅ ÐÒÏÄÏÌÖÁÔØ ÞÉÔÁÔØ ÔÅËÓÔ. - -ðÅÒ×ÏÅ ÞÔÏ ×ÁÍ ÎÅÏÂÈÏÄÉÍÏ ÚÎÁÔØ - ËÁË ÐÅÒÅÄ×ÉÇÁÔØÓÑ ÐÏ ÔÅËÓÔÕ ÉÚ ÏÄÎÏÇÏ ÍÅÓÔÁ -× ÄÒÕÇÏÅ. ÷Ù ÕÖÅ ÚÎÁÅÔÅ, ËÁË ÐÅÒÅÄ×ÉÎÕÔØ ×ÐÅÒÅÄ ÏÄÉÎ ÜËÒÁÎ, ÉÓÐÏÌØÚÕÑ C-v. -äÌÑ ÐÅÒÅÍÅÝÅÎÉÑ ÎÁÚÁÄ ÏÄÎÏÇÏ ÜËÒÁÎÁ, ÎÁÖÍÉÔÅ M-v (ÕÄÅÒÖÉ×ÁÊÔÅ ËÌÁ×ÉÛÕ META -É ÎÁÂÅÒÉÔÅ v, ÉÌÉ ÎÁÖÍÉÔÅ v ÅÓÌÉ Õ ×ÁÓ ÎÅÔ ËÌÁ×ÉÛÕ META, EDIT, ÉÌÉ ALT). - ->> ÐÏÐÒÏÂÕÊÔÅ ÎÁÂÒÁÔØ M-v É ÐÏÔÏÍ C-v, ÎÅÓËÏÌØËÏ ÒÁÚ. - - -* ëòáôëï ---------- - -óÌÅÄÕÀÝÉÅ ËÏÍÁÎÄÙ ÉÓÐÏÌØÚÕÀÔÓÑ ÄÌÑ ÐÒÏÓÍÏÔÒÁ: - - C-v ðÅÒÅÊÔÉ ÎÁ ÏÄÉÎ ÜËÒÁÎ ×ÐÅÒÅÄ - M-v ðÅÒÅÊÔÉ ÎÁ ÏÄÉÎ ÜËÒÁÎ ÎÁÚÁÄ - C-l ïÞÉÓÔÉÔØ ÜËÒÁÎ É ÏÔÏÂÒÁÚÉÔØ ×ÓÅ ÚÁÎÏ×Ï, ÒÁÚÍÅÓÔÉ× - ÔÅËÓÔ, ÎÁÈÏÄÑÝÉÊÓÑ ×ÏÚÌÅ ËÕÒÓÏÒÁ, × ÃÅÎÔÒÅ ÜËÒÁÎÁ. - (üÔÏ control-L, ÎÅ control-1.) - ->> îÁÊÄÉÔÅ ËÕÒÓÏÒ, É ÚÁÐÏÍÎÉÔÅ ÔÅËÓÔ ×ÏÚÌÅ ÎÅÇÏ. - ðÏÔÏÍ ÎÁÖÍÉÔÅ C-l. - îÁÊÄÉÔÅ ËÕÒÓÏÒ ÓÎÏ×Á É ÕÂÅÄÉÔÅÓØ, ÞÔÏ ×ÏÚÌÅ ÎÅÇÏ ×ÓÅ ÔÏÔ ÖÅ ÔÅËÓÔ. - - -* âáúï÷ïå õðòá÷ìåîéå ëõòóïòïí ------------------------------ - -ä×ÉÖÅÎÉÅ ÏÔ ÜËÒÁÎÁ Ë ÜËÒÁÎÕ ÕÄÏÂÎÏ, ÎÏ ËÁË ÐÅÒÅÍÅÓÔÉÔØÓÑ × -ÏÐÒÅÄÅÌÅÎÎÏÅ ÍÅÓÔÏ ÐÏ ÔÅËÓÔÕ ÎÁ ÜËÒÁÎÅ? - -åÓÔØ ÎÁÓËÏÌØËÏ ÐÕÔÅÊ, ÞÔÏÂÙ ÓÄÅÌÁÔØ ÜÔÏ. ïÓÎÏ×ÎÏÊ ÐÕÔØ - ÉÓÐÏÌØÚÏ×ÁÔØ ËÏÍÁÎÄÙ -C-p, C-b, C-f, É C-n. ëÁÖÄÁÑ ÉÚ ÜÔÉÈ ËÏÍÁÎÄ ÐÅÒÅÄ×ÉÇÁÅÔ ËÕÒÓÏÒ ÎÁ ÏÄÎÕ -ÓÔÒÏËÕ ÉÌÉ ËÏÌÏÎËÕ ÎÁ ÜËÒÁÎÅ × ÏÐÒÅÄÅÌÅÎÎÏÍ ÎÁÐÒÁ×ÌÅÎÉÉ. üÔÁ ÔÁÂÌÉÃÁ -ÐÏËÁÚÙ×ÁÅÔ ÞÅÔÙÒÅ ËÏÍÁÎÄÙ É ÞÅÔÙÒÅ ÎÁÐÒÁ×ÌÅÎÉÑ Ä×ÉÖÅÎÉÑ: - - ðÒÅÄÙÄÕÝÁÑ ÓÔÒÏËÁ, C-p - : - : - îÁÚÁÄ, C-b .... ôÅËÕÝÁÑ ÐÏÚÉÃÉÑ ËÕÒÓÏÒÁ .... ÷ÐÅÒÅÄ, C-f - : - : - óÌÅÄÕÀÝÁÑ ÓÔÒÏËÁ, C-n - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ ÓÔÒÏËÕ ÒÑÄÏÍ Ó ÄÉÁÇÒÁÍÍÏÊ, ÉÓÐÏÌØÚÕÑ C-n ÉÌÉ C-p. - ðÏÔÏÍ, ÎÁÖÍÉÔÅ C-l É ÐÏÓÍÏÔÒÉÔÅ ËÁË ÄÉÁÇÒÁÍÍÁ ÒÁÚÍÅÓÔÉÔÓÑ × ÃÅÎÔÒÅ ÜËÒÁÎÁ. - -÷ÁÍ ÂÕÄÅÔ ÎÅÓÌÏÖÎÏ ÚÁÐÏÍÎÉÔØ ÐÏ ÂÕË×ÁÍ (// ÎÄÁ, ÚÎÁÑ ÁÎÇÌÉÊÓËÉÊ - ÓÏ×ÓÅÍ -ÌÅÇËÏ ) : P-ÐÒÅÄÙÄÕÝÉÊ (previous), N-ÓÌÅÄÕÀÝÉÊ (next), B-ÎÁÚÁÄ (backward) É -F-×ÐÅÒÅÄ (forward). üÔÏ ÏÓÎÏ×ÎÙÅ ËÏÍÁÎÄÙ ÐÏÚÉÃÉÏÎÉÒÏ×ÁÎÉÑ ËÕÒÓÏÒÁ, ËÏÔÏÒÙÍÉ ÷Ù -ÂÕÄÅÔÅ ÐÏÌØÚÏ×ÁÔØÓÑ ÷óåçäá, ÔÁË ÞÔÏ ÂÕÄÅÔ ÎÅÐÌÏÈÏ ÉÈ ×ÙÕÞÉÔØ. - ->> îÁÖÍÉÔÅ ÎÅÓËÏÌØËÏ ÒÁÚ C-n ÞÔÏ ÏÐÕÓÔÉÔØ ËÕÒÓÏÒ ×ÎÉÚ ÎÁ ÜÔÕ ÓÔÒÏËÕ. - ->> ðÅÒÅÍÅÓÔÉÔÅÓØ ÐÏ ÓÔÒÏËÅ, ÉÓÐÏÌØÚÕÑ C-f É ÐÏÔÏÍ ÐÏÄÎÉÍÉÔÅÓØ ××ÅÒÈ Ó ÐÏÍÏÝØÀ - C-p. ðÏÓÍÏÔÒÉÔÅ, ËÁË ÉÚÍÅÎÉÌÏÓØ ÐÏÌÏÖÅÎÉÅ ËÕÒÓÏÒÁ ÐÒÉ ÎÁÖÁÔÉÉ ó-Ò, ÅÓÌÉ ÏÎ - ÎÁÈÏÄÉÌÓÑ × ÓÅÒÅÄÉÎÅ ÓÔÒÏËÉ. - -ëÁÖÄÁÑ ÓÔÒÏËÁ ÔÅËÓÔÁ ÚÁ×ÅÒÛÁÅÔÓÑ ÓÉÍ×ÏÌÏÍ îÏ×ÁÑóÔÒÏËÁ (Newline character), -ËÏÔÏÒÙÊ ÏÔÄÅÌÑÅÔ ÅÅ ÏÔ ÓÌÅÄÕÀÝÅÊ ÓÔÒÏËÉ. ðÏÓÌÅÄÎÑÑ ÓÔÒÏËÁ × ×ÁÛÅÍ ÆÁÊÌÅ -ÄÏÌÖÎÁ ÂÙ ÔÏÖÅ ÚÁ×ÅÒÛÁÔØÓÑ ÓÉÍ×ÏÌÏÍ îÏ×ÁÑóÔÒÏËÁ (ÎÏ Emacs ÎÅ ÔÒÅÂÕÅÔ ÜÔÏÇÏ). - ->> ðÏÐÒÏÂÕÊÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-b × ÎÁÞÁÌÅ ÓÔÒÏËÉ. ëÕÒÓÏÒ ÄÏÌÖÅÎ ÐÅÒÅÍÅÓÔÉÔØÓÑ ÎÁ - ËÏÎÅà ÐÒÅÄÙÄÕÝÅÊ ÓÔÒÏËÉ. üÔÏ ÐÒÏÉÓÈÏÄÉÔ ÐÏÔÏÍÕ, ÞÔÏ ÏÎ Ä×ÉÖÅÔÓÑ ÎÁÚÁÄ ÞÅÒÅÚ - ÓÉÍ×ÏÌ îÏ×ÁÑóÔÒÏËÁ. - -C-f ÍÏÖÅÔ ÐÅÒÅÍÅÝÁÔØ ËÕÒÓÏÒ ÞÅÒÅÚ îÏ×ÕÀóÔÒÏËÕ ÔÁË ÖÅ, ËÁË É C-b. - ->> ðÏÐÒÏÂÕÊÔÅ ÎÅÓËÏÌØËÏ ÒÁÚ ÐÒÉÍÅÎÉÔØ C-b, ÔÁË ÞÔÏÂÙ ÷Ù Õ×ÉÄÅÌÉ, ËÁË Ä×ÉÖÅÔÓÑ - ËÕÒÓÏÒ. - äÁÌÅÅ ÉÓÐÏÌØÚÕÊÔÅ C-f ÞÔÏÂÙ ×ÅÒÎÕÔØÓÑ ÎÁ ËÏÎÅà ÓÔÒÏËÉ. - îÁÖÍÉÔÅ C-f ÅÝÅ ÒÁÚ, ÞÔÏÂÙ ÐÅÒÅÊÔÉ Ë ÎÁÞÁÌÕ ÓÌÅÄÕÀÝÅÊ ÓÔÒÏËÉ. - -ëÏÇÄÁ ×Ù ÐÅÒÅÍÅÝÁÅÔÅÓØ ÚÁ ×ÅÒÈÎÉÊ ÉÌÉ ÎÉÖÎÉÊ ËÒÁÊ ÜËÒÁÎÁ, ÔÅËÓÔ, ÎÁÈÏÄÑÝÉÊÓÑ -ÚÁ ÜËÒÁÎÏÍ, ÓÄ×ÉÇÁÅÔÓÑ ×ÎÕÔÒØ ÜËÒÁÎÁ. üÔÏ ÎÁÚÙ×ÁÅÔÓÑ "ÓËÒÏÌÌÉÎÇ". óËÒÏÌÌÉÎÇ -ÐÏÚ×ÏÌÑÅÔ Emacs`Õ ÐÅÒÅÍÅÝÁÔØ ËÕÒÓÏÒ × ÎÕÖÎÏÅ ÍÅÓÔÏ ÔÅËÓÔÁ ÂÅÚ ÐÅÒÅÍÅÝÅÎÉÑ -ÅÇÏ ÚÁ ÐÒÅÄÅÌÙ ÜËÒÁÎÁ. - ->> ðÏÐÒÏÂÕÊÔÅ ÐÅÒÅÍÅÓÔÉÔØ ËÕÒÓÏÒ ÚÁ ÎÉÖÎÀÀ ÇÒÁÎÉÃÕ ÜËÒÁÎÁ, ÉÓÐÏÌØÚÕÑ C-n, - É ÐÏÓÍÏÔÒÉÔÅ, ÞÔÏ ÉÚÍÅÎÉÔÓÑ. - -åÓÌÉ ÐÏÓÉÍ×ÏÌØÎÏÅ ÐÅÒÅÍÅÝÅÎÉÅ ÓÌÉÛËÏÍ ÍÅÄÌÅÎÎÏ, ÷Ù ÍÏÖÅÔÅ Ä×ÉÇÁÔØÓÑ ÐÏ -ÓÌÏ×ÁÍ. M-f (Meta-f) ÐÅÒÅÍÅÝÁÅÔ ×ÐÅÒÅÄ ÎÁ ÓÌÏ×Ï, Á M-b ÎÁÚÁÄ ÎÁ ÓÌÏ×Ï. - ->> îÁÖÍÉÔÅ ÎÅÓËÏÌØËÏ ÒÁÚ M-f É M-b. - -åÓÌÉ ËÕÒÓÏÒ ÎÁÈ. × ÓÅÒÅÄÉÎÅ ÓÌÏ×Á, M-f ÐÅÒÅÍÅÓÔÉÔ ÅÇÏ × ËÏÎÅà ÓÌÏ×Á. -åÓÌÉ ËÕÒÓÏÒ ÎÁÈ. ÍÅÖÄÕ ÓÌÏ×ÁÍÉ, M-f ÐÅÒÅÍÅÓÔÉÔ ÅÇÏ × ËÏÎÅà -ÓÌÅÄÕÀÝÅÇÏ ÓÌÏ×Á. M-b ÒÁÂÏÔÁÅÔ ÔÏÞÎÏ ÔÁË ÖÅ × ÐÒÏÔÉ×ÏÐÏÌÏÖÎÏÍ ÎÁÐÒÁ×ÌÅÎÉÉ. - ->> îÁÖÍÉÔÅ M-f É M-b ÎÅÓËÏÌØËÏ ÒÁÚ, ÐÅÒÅÍÅÖÁÑ Ó C-f É C-b - ÔÁË ×Ù ÓÍÏÖÅÔÅ - ÚÁÍÅÔÉÔØ ÄÅÊÓÔ×ÉÑ M-f É M-b ÉÚ ÒÁÚÎÙÈ ÐÏÚÉÃÉÊ × ÓÌÏ×ÁÈ É ÍÅÖÄÕ ÎÉÍÉ. - -ïÔÍÅÔØÔÅ ÐÁÒÁÌÌÅÌØ ÍÅÖÄÕ C-f É C-b Ó ÏÄÎÏÊ ÓÔÏÒÏÎÙ, É M-f É M-b Ó ÄÒÕÇÏÊ. -ïÞÅÎØ ÞÁÓÔÏ Meta-ÓÉÍ×ÏÌÙ ÉÓÐÏÌØÚÕÀÔÓÑ ÄÌÑ ÓÏÏÔ×ÅÔÓÔ×ÕÀÝÉÈ ÏÐÅÒÁÃÉÊ ÎÁÄ -ÅÄÉÎÉÃÁÍÉ, ÏÐÒÅÄÅÌÅÎÎÙÍÉ × ÑÚÙËÅ (ÓÌÏ×Á, ÐÒÅÄÌÏÖÅÎÉÑ, ÁÂÚÁÃÙ), ËÏÇÄÁ -Control-ÓÉÍ×ÏÌÙ ÏÐÅÒÉÒÕÀÔ ÏÓÎÏ×ÎÙÍÉ ÅÄÉÎÉÃÁÍÉ, ÎÅÚÁ×ÉÓÉÍÏ ÏÔ ÔÏÇÏ, ÞÔÏ -÷Ù ÒÅÄÁËÔÉÒÕÅÔÅ (ÓÉÍ×ÏÌÙ, ÓÔÒÏËÉ, É Ô.Ä.). - -üÔÁ ÐÁÒÁÌÌÅÌØ ÓÕÝÅÓÔ×ÕÅÔ ÍÅÖÄÕ ÓÔÒÏËÁÍÉ É ÐÒÅÄÌÏÖÅÎÉÑÍÉ: C-a É C-e ÐÅÒÅÍÅÝÁÅÔ -ËÕÒÓÏÒ × ÎÁÞÁÌÏ É ËÏÎÅà ÓÔÒÏËÉ, Á M-a É M-e ÐÅÒÅÍÅÝÁÅÔ ËÕÒÓÏÒ × ÎÁÞÁÌÏ É -ËÏÎÅà ÐÒÅÄÌÏÖÅÎÉÑ. - ->> ðÏÐÒÏÂÕÊÔÅ ÎÁÖÁÔØ ÐÁÒÕ ÒÁÚ C-a, É ÐÏÔÏÍ ÐÁÒÕ ÒÁÚ C-e. - ðÏÐÒÏÂÕÊÔÅ ÐÁÒÕ ÒÁÚ ÎÁÖÁÔØ M-a, ÐÏÓÌÅ ÜÔÏÇÏ ÐÁÒÕ ÒÁÚ ÎÁÖÁÔØ M-e. - -ðÏÓÍÏÔÒÉÔÅ, ÞÔÏ ÐÏ×ÔÏÒ C-a ÎÉÞÅÇÏ ÎÅ ÉÚÍÅÎÑÅÔ, Á ÐÏ×ÔÏÒ M-a ÐÒÏÄÏÌÖÁÅÔ Ä×ÉÖÅÎÉÅ -ËÕÒÓÏÒÁ Ë ÓÌÅÄÕÀÝÅÍÕ ÐÒÅÄÌÏÖÅÎÉÀ. üÔÏ ÎÅ ÓÏÈÒÁÎÑÅÔ ÁÎÁÌÏÇÉÀ, ÎÏ ×ÙÇÌÑÄÉÔ -ÅÓÔÅÓÔ×ÅÎÎÏ. - -ðÏÌÏÖÅÎÉÅ ËÕÒÓÏÒÁ × ÔÅËÓÔÅ ÔÁËÖÅ ÎÁÚÙ×ÁÀÔ "ÔÏÞËÁ". óËÁÖÅÍ ÉÎÁÞÅ: ËÕÒÓÏÒ -ÐÏËÁÚÙ×ÁÅÔ ÍÅÓÔÏ ÎÁ ÜËÒÁÎÅ × ËÁËÏÊ ÔÏÞËÅ ÂÕÄÅÔ ÒÁÓÐÏÌÏÖÅÎ ××ÏÄÉÍÙÊ ÔÅËÓÔ. - -úÄÅÓØ ÓÏÂÒÁÎÙ ÐÒÏÓÔÙÅ ËÏÍÁÎÄÙ ÐÅÒÅÍÅÝÅÎÉÑ ËÕÒÓÏÒÁ, ×ËÌÀÞÁÑ Ä×ÉÖÅÎÉÅ ÐÏ ÓÌÏ×ÁÍ -É ÐÒÅÄÌÏÖÅÎÉÑÍ: - - C-f îÁ ÓÉÍ×ÏÌ ×ÐÅÒÅÄ - C-b îÁ ÓÉÍ×ÏÌ ÎÁÚÁÄ - - M-f îÁ ÓÌÏ×Ï ×ÐÅÒÅÄ - M-b îÁ ÓÌÏ×Ï ÎÁÚÁÄ - - C-n îÁ ÓÌÅÄÕÀÝÕÀ ÓÔÒÏËÕ - C-p îÁ ÐÒÅÄÙÄÕÝÕÀ ÓÔÒÏËÕ - - C-a ÷ ÎÁÞÁÌÏ ÓÔÒÏËÉ - C-e ÷ ËÏÎÅà ÓÔÒÏËÉ - - M-a îÁÚÁÄ, × ÎÁÞÁÌÏ ÐÒÅÄÌÏÖÅÎÉÑ - M-e ÷ÐÅÒÅÄ, × ËÏÎÅà ÐÒÅÄÌÏÖÅÎÉÑ - ->> ðÏÐÒÏÂÕÊÔÅ ÓÅÊÞÁÓ ÎÁ ÐÒÁËÔÉËÅ ÐÒÉÍÅÎÉÔØ ÎÅÓËÏÌØËÏ ÒÁÚ ×ÓÅ ÜÔÉ ËÏÍÁÎÄÙ. - üÔÏ ÎÁÉÂÏÌÅÅ ÉÓÐÏÌØÚÕÅÍÙÅ ËÏÍÁÎÄÙ. - -ä×Å ÄÒÕÇÉÅ ×ÁÖÎÙÅ ËÏÍÁÎÄÙ Ä×ÉÖÅÎÉÑ ËÕÒÓÏÒÁ M-< (Meta Less-then {íÅÎØÛÅ-þÅÍ}), -ËÏÔÏÒÁÑ ÐÅÒÅÍÅÝÁÅÔ ËÕÒÓÏÒ × ÎÁÞÁÌÏ ÔÅËÓÔÁ, É M-> (Meta Greater-than {âÏÌØÛÅ-þÅÍ}), -ËÏÔÏÒÁÑ ÐÅÒÅÍÅÝÁÅÔ ËÕÒÓÏÒ × ËÏÎÅà ÔÅËÓÔÁ. - -îÁ ÂÏÌØÛÉÎÓÔ×Å ÔÅÒÍÉÎÁÌÏ× ÓÉÍ×ÏÌ "<" ÎÁÈÏÄÉÔÓÑ ÎÁÄ ÔÏÞËÏÊ, É ×Ù ÄÏÌÖÎÙ -ÉÓÐÏÌØÚÏ×ÁÔØ ËÌÁ×ÉÛÕ Shift ÞÔÏ ÎÁÂÒÁÔØ ÅÇÏ. îÁ ÜÔÉÈ ÔÅÒÍÉÎÁÌÁÈ ×Ù ÔÁË ÖÅ -ÄÏÌÖÎÙ ÉÓÐÏÌØÚÏ×ÁÔØ Shift ÞÔÏ ÎÁÂÒÁÔØ M-<; âÅÚ ÕÄÅÒÖÁÎÉÑ ËÌÁ×ÉÛÉ Shift ×Ù -ÎÁÂÅÒÅÔÅ M-ÔÏÞËÁ. - ->> óÅÊÞÁÓ ÐÏÐÒÏÂÕÊÔÅ M-<, ÞÔÏ ÐÅÒÅÍÅÓÔÉÔØÓÑ × ÎÁÞÁÌÏ ÕÞÅÂÎÉËÁ. - ðÏÔÏÍ ÉÓÐÏÌØÚÕÊÔÅ C-v ÞÔÏ ×ÅÒÎÕÔØÓÑ ÎÁÚÁÄ. - ->> óÅÊÞÁÓ ÐÏÐÒÏÂÕÊÔÅ M->, ÞÔÏ ÐÅÒÅÍÅÓÔÉÔØÓÑ Ë ËÏÎÃÕ ÕÞÅÂÎÉËÁ. - éÓÐÏÌØÚÕÊÔÅ M-v ÞÔÏ ×ÅÒÎÕÔØÓÑ ÓÎÏ×Á. - -ëÕÒÓÏÒ ÍÏÖÎÏ ÐÅÒÅÍÅÝÁÔØ ÓÔÒÅÌÏÞËÁÍÉ, ÅÓÌÉ ÷ÁÛ ÔÅÒÍÉÎÁÌ ÉÍÅÅÔ ÉÈ. -íÙ ÒÅËÏÍÅÎÄÕÅÍ ×ÙÕÞÉÔØ C-b, C-f, C-n É C-p ÐÏ ÔÒÅÍ ÐÒÉÞÉÎÁÍ. ðÅÒ×ÏÅ, ÏÎÉ -ÒÁÂÏÔÁÀÔ ÎÁ ÌÀÂÙÈ ÔÅÒÍÉÎÁÌÁÈ. ÷ÔÏÒÏÅ, ÏÄÎÁÖÄÙ ÐÏÌÕÞÉ× ÐÒÁËÔÉËÕ ÉÓÐÏÌØÚÏ×ÁÎÉÑ -Emacs, ×Ù ÐÏÊÍÅÔÅ, ÞÔÏ ÉÓÐÏÌØÚÏ×ÁÔØ CTRL-ÓÉÍ×ÏÌÙ ÕÄÏÂÎÅÅ É ÂÙÓÔÒÅÅ, ÞÅÍ ËÎÏÐËÉ -ÓÏ ÓÔÒÅÌÏÞËÁÍÉ (ÐÏÔÏÍÕ ÞÔÏ ×Ù ÎÅ ÕÂÉÒÁÅÔÅ ÒÕËÉ Ó ÏÂÙÞÎÏÇÏ ÉÈ ÐÏÌÏÖÅÎÉÑ ÐÒÉ -ÐÅÞÁÔÉ). ôÒÅÔØÅ, ËÁË ÔÏÌØËÏ ×Ù ÐÒÉ×ÙËÎÉÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ CTRL-ÓÉÍ×ÏÌÙ, ×Ù -ÓÍÏÖÅÔÅ ÔÁË ÖÅ ÌÅÇËÏ ×ÙÕÞÉÔØ É ÉÓÐÏÌØÚÏ×ÁÔØ ÄÒÕÇÉÅ, ÂÏÌÅÅ ÓÐÅÃÉÁÌØÎÙÅ -ËÏÍÁÎÄÙ ÐÅÒÅÍÅÝÅÎÉÑ ËÕÒÓÏÒÁ. - -âÏÌØÛÉÎÓÔ×Ï ËÏÍÁÎÄ Emacs`Á ÄÏÐÕÓËÁÀÔ ÃÉÆÒÏ×ÏÊ ÁÒÇÕÍÅÎÔ; ÄÌÑ ÂÏÌØÛÉÎÓÔ×Á -ËÏÍÁÎÄ, ÜÔÏ ÓÌÕÖÉÔ ÓÞÅÔÞÉËÏÍ ÐÏ×ÔÏÒÅÎÉÑ. þÔÏ ÚÁÄÁÔØ ÓÞÅÔÞÉË ÐÏ×ÔÏÒÅÎÉÑ ÄÌÑ -ËÏÍÁÎÄÙ, ÎÁÖÍÉÔÅ C-u, ÐÏÔÏÍ ÞÉÓÌÏ ÐÏ×ÔÏÒÅÎÉÊ, ÕËÁÖÉÔÅ ËÏÍÁÎÄÕ. åÓÌÉ Õ -×ÁÓ ÅÓÔØ ËÌÁ×ÉÛÁ META (ÉÌÉ EDIT ÉÌÉ ALT), ÅÓÔØ ÄÒÕÇÏÊ ÓÐÏÓÏ ÚÁÄÁÔØ ÃÉÆÒÏ×ÏÊ -ÁÒÇÕÍÅÎÔ: ÎÁÂÅÒÉÔÅ ÃÉÆÒÙ, ÕÄÅÒÖÉ×ÁÑ ËÎÏÐËÕ META. íÙ ÒÅËÏÍÅÎÄÕÅÍ ÏÓ×ÏÉÔØ -ÉÓÐÏÌØÚÏ×ÁÎÉÅ C-u, Ô.Ë ÜÔÁ ÐÏÓÌÅÄÏ×ÁÔÅÌØÎÏÓÔØ ËÌÁ×ÉÛ ÒÁÂÏÔÁÅÔ ÎÁ ÌÀÂÏÍ ÔÅÒÍÉÎÁÌÅ. - -îÁÐÒÉÍÅÒ, C-u 8 C-f ÐÅÒÅÍÅÓÔÉÔ ËÕÒÓÏÒ ÎÁ ×ÏÓÅÍØ ÓÉÍ×ÏÌÏ× ×ÐÅÒÅÄ. - ->> ðÏÐÒÏÂÕÊÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-n ÉÌÉ C-p Ó ÃÉÆÒÏ×ÙÍ ÁÒÇÕÍÅÎÔÏÍ, ÞÔÏÂÙ ÐÅÒÅÍÅÓÔÉÔØ - ËÕÒÓÏÒ ÎÁ ÓÔÒÏËÕ ÒÑÄÏÍ Ó ÜÔÏÊ ËÏÍÁÎÄÏÊ. - -íÎÏÇÉÅ ËÏÍÁÎÄÙ ÉÓÐÏÌØÚÕÀÔ ÞÉÓÌÏ×ÏÊ ÁÒÇÕÍÅÎÔ ËÁË ÓÞÅÔÞÉË ÐÏ×ÔÏÒÅÎÉÊ. îÏ ÅÓÔØ -ÉÓËÌÀÞÅÎÉÑ. ôÁËÉÅ ÉÓËÌÀÞÅÎÉÑ - C-v É M-v . -ðÒÉ ÐÏÌÕÞÅÎÉÉ ÞÉÓÌÏ×ÏÇÏ ÁÒÇÕÍÅÎÔÁ, ÏÎÉ ÓËÒÏÌÌÉÒÕÀÔ ÜËÒÁÎ ××ÅÒÈ ÉÌÉ ×ÎÉÚ -ÎÁ ÕËÁÚÁÎÎÏÅ ÞÉÓÌÏ ÓÔÒÏË, ×ÍÅÓÔÏ ÔÁËÏÇÏ ÖÅ ÞÉÓÌÁ ÜËÒÁÎÏ×. îÁÐÒÉÍÅÒ, C-u 4 C-v -ÐÒÏËÒÕÔÉÔ ÜËÒÁÎ ÎÁ 4 ÓÔÒÏËÉ. - ->> óÅÊÞÁÓ ÐÏÐÒÏÂÕÊÔÅ ËÏÍÂÉÎÁÃÉÀ C-u 8 C-v. - -üÔÁ ËÏÍÁÎÄÁ ÄÏÌÖÎÁ ÐÒÏËÒÕÔÉÔØ ÜËÒÁÎ ÎÁ 8 ÓÔÒÏË ××ÅÒÈ. åÓÌÉ ×Ù ÈÏÔÉÔÅ -ÐÒÏËÒÕÔÉÔØ ÅÇÏ ×ÎÉÚ, ÍÏÖÅÔÅ ÚÁÄÁÔØ ÁÒÇÕÍÅÎÔ ÄÌÑ M-v. - -åÓÌÉ ×Ù ÉÓÐÏÌØÚÕÅÔÅ X Window, ×ÅÒÏÑÔÎÏ ÅÓÔØ ÐÒÑÍÏÕÇÏÌØÎÉË ÉÍÅÎÕÅÍÙÊ ÐÏÌÏÓÁ -ÐÒÏËÒÕÔËÉ (scroll bar) Ó ÓÐÒÁ×ÏÊ ÓÔÏÒÏÎÙ ÏËÎÁ Emacs. ÷Ù ÍÏÖÅÔÅ ÓËÒÏÌÌÉÒÏ×ÁÔØ -ÔÅËÓÔ, ÍÁÎÉÐÕÌÉÒÕÑ ÍÙÛØÀ. - ->> ðÏÐÒÏÂÕÊÔÅ ÎÁÖÁÔØ ÓÒÅÄÎÀÀ ËÎÏÐËÕ ÍÙÛËÉ ××ÅÒÈÕ ÐÏÄÓ×ÅÞÅÎÎÏÊ ÏÂÌÁÓÔÉ - ×ÎÕÔÒÉ ÐÏÌÏÓÙ ÐÒÏËÒÕÔËÉ. ôÅËÓÔ ÄÏÌÖÅÎ ÐÒÏËÒÕÔÉÔØÓÑ ÄÏ ÐÏÚÉÃÉÉ, - ÏÐÒÅÄÅÌÅÎÎÏÊ ÔÅÍ, ËÁË ×ÙÓÏËÏ ÉÌÉ ÎÉÚËÏ ×Ù ÎÁÖÍÅÔÅ. - ->> ðÅÒÍÅÓÔÉÔÅ ÍÙÛËÕ × ÔÏÞËÕ ÐÏÌÏÓÙ ÐÒÏËÒÕÔËÉ ×ÏÚÌÅ ÔÒÅÔÅÊ ÓÔÒÏËÉ Ó×ÅÒÈÕ - É ÎÁÖÍÉÔÅ ÌÅ×ÕÀ ËÎÏÐËÕ ÐÁÒÕ ÒÁÚ. - - -* õðòá÷ìåîéå ëõòóïòïí îá X-ôåòíéîáìå ------------------------------------- - -åÓÌÉ Õ ×ÁÓ X-ÔÅÒÍÉÎÁÌ, ×ÁÍ, ×ÅÒÏÑÔÎÏ, ÐÏËÁÖÅÔÓÑ ÂÏÌÅÅ ÌÅÇËÉÍ ÉÓÐÏÌØÚÏ×ÁÔØ ËÌÁ×ÉÛÉ -ÎÁ keypad`Å ÄÌÑ ÕÐÒÁ×ÌÅÎÉÑ ËÕÒÓÏÒÏÍ. óÔÒÅÌËÉ ×ÌÅ×Ï, ×ÐÒÁ×Ï, ××ÅÒÈ É ×ÎÉÚ -ÐÅÒÅÄ×ÉÇÁÀÔ ËÕÒÓÏÒ × ÏÖÉÄÁÅÍÏÍ ÎÁÐÒÁ×ÌÅÎÉÉ; ÏÎÉ ÆÕÎËÃÉÏÎÉÒÕÀÔ ÔÏÞÎÏ ËÁË C-b, -C-f, C-p, É C-n, ÎÏ ÌÅÇÞÅ × ÎÁÂÏÒÅ É ÚÁÐÏÍÉÎÁÎÉÉ. ÷Ù ÔÁË ÖÅ ÍÏÖÅÔÅ -ÉÓÐÏÌØÚÏ×ÁÔØ C-left É C-right ÄÌÑ ÐÅÒÅÄ×ÉÖÅÎÉÑ ÐÏ ÓÌÏ×ÁÍ, É C-up É C-down ÄÌÑ -ÐÅÒÅÄ×ÉÖÅÎÉÑ ÐÏ ÂÌÏËÁÍ (Ô.Å. ÐÁÒÁÇÒÁÆÁÍ, ÅÓÌÉ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ ÔÅËÓÔ). åÓÌÉ Õ -×ÁÓ ÅÓÔØ ËÎÏÐËÁ ÐÏÍÅÞÅÎÎÁÑ HOME (ÉÌÉ BEGIN) É END, ÔÏ ÏÎÉ ÂÕÄÕÔ ÐÅÒÅÍÅÝÁÔØ -ËÕÒÓÏÒ × ÎÁÞÁÌÏ É ËÏÎÅà ÓÔÒÏËÉ, ÓÏÏÔ×ÅÔÓÔ×ÅÎÎÏ, É C-home É C-end ÂÕÄÕÔ -ÐÅÒÅÍÅÝÁÔØ × ÎÁÞÁÌÏ É ËÏÎÅà ÆÁÊÌÁ. åÓÌÉ ÎÁ ×ÁÛÅÊ ËÌÁ×ÉÁÔÕÒÅ ÅÓÔØ ËÎÏÐËÉ PgUp -É PgDn, ×Ù ÍÏÖÅÔÅ ÉÈ ÉÓÐÏÌØÚÏ×ÁÔØ ÄÌÑ ÐÅÒÅÍÅÝÅÎÉÑ ××ÅÒÈ É ×ÎÉÚ ÐÏÜËÒÁÎÎÏ, ËÁË -M-v É C-v. - -÷ÓÅ ÜÔÉ ËÏÍÁÎÄÙ ÍÏÇÕÔ ÐÏÌÕÞÁÔØ ÃÉÆÒÏ×ÏÊ ÁÒÇÕÍÅÎÔ, ËÁË ÒÁÓÓËÁÚÁÎÏ ×ÙÛÅ. -÷Ù ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ shortcut ÄÌÑ ××ÏÄÁ ÜÔÏÇÏ ÁÒÇÕÍÅÎÔÁ: ÐÒÏÓÔÏ ÎÁÖÍÉÔÅ -CONTROL ÉÌÉ META É ÎÁÂÅÒÉÔÅ ÞÉÓÌÏ. îÁÐÒÉÍÅÒ, ÄÌÑ ÐÅÒÅÍÅÝÅÎÉÑ ÎÁ 12 ÓÌÏ× -×ÐÒÁ×Ï, ÎÁÂÅÒÉÔÅ C-1 C-2 C-right. úÁÐÏÍÎÉÔÅ ÞÔÏ ÔÁË ÏÞÅÎØ ÌÅÇËÏ ÎÁÂÉÒÁÔØ, -ÐÏÔÏÍÕ ÞÔÏ ×Ù ÎÅ ÏÔÐÕÓËÁÅÔÅ ËÎÏÐËÕ CONTROL ÍÅÖÄÕ ÎÁÖÁÔÉÑÍÉ. - - -* åóìé EMACS úá÷éó ------------------- - -åÓÌÉ Emacs ÐÅÒÅÓÔÁÌ ÒÅÁÇÉÒÏ×ÁÔØ ÎÁ ×ÁÛÉ ËÏÍÁÎÄÙ, ×Ù ÍÏÖÅÔÅ ÏÓÔÁÎÏ×ÉÔØ ÜÔÏ -ÐÒÏÓÔÏ ÎÁÖÁ× C-g. ÷Ù ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-g ÞÔÏ ÏÓÔÁÎÏ×ÉÔØ ËÏÍÁÎÄÕ ËÏÔÏÒÁÑ -ÓÌÉÛËÏÍ ÄÏÌÇÏ ×ÙÐÏÌÎÑÅÔÓÑ. - -÷Ù ÔÁË ÖÅ ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-g ÄÌÑ ÏÔÍÅÎÙ ÃÉÆÒÏ×ÏÇÏ ÁÒÇÕÍÅÎÔÁ ÉÌÉ ÎÁÞÁÔÏÊ -ËÏÍÁÎÄÙ ËÏÔÏÒÕÀ ×Ù ÎÅ ÈÏÔÉÔÅ ÚÁ×ÅÒÛÁÔØ. - ->> îÁÂÅÒÉÔÅ C-u 100 ÄÌÑ ÚÁÄÁÎÉÑ ÁÒÇÕÍÅÎÔÁ 100, ÐÏÔÏÍ ÎÁÖÍÉÔÅ C-g. - ôÅÐÅÒØ ÎÁÖÍÉÔÅ C-f. ëÕÒÓÏÒ ÄÏÌÖÅÎ ÐÅÒÅÍÅÓÔÉÔØÓÑ ×ÓÅÇÏ ÎÁ ÏÄÉÎ ÓÉÍ×ÏÌ, - ÐÏÔÏÍÕ ÞÔÏ ×Ù ÏÔÍÅÎÉÌÉ ÁÒÇÕÍÅÎÔ ÎÁÖÁÔÉÅÍ C-g. - -åÓÌÉ ×Ù ÎÁÖÁÌÉ ÐÏ ÏÛÉÂËÅ, ×Ù ÔÁË ÖÅ ÍÏÖÅÔÅ ÉÚÂÁ×ÉÔØÓÑ ÏÔ ÜÔÏÇÏ ÎÁÖÁÔÉÅÍ -C-g. - - -* ÷ùëìàþåîîùå ëïíáîäù (DISABLED COMMANDS) ------------------------------------------ - -îÅËÏÔÏÒÙÅ ËÏÍÁÎÄÙ Emacs "×ÙËÌÀÞÅÎÙ" ÔÁË ËÁË ÎÁÞÉÎÁÀÝÉÅ ÐÏÌØÚÏ×ÁÔÅÌÉ ÍÏÇÕÔ ÉÈ -ÉÓÐÏÌØÚÏ×ÁÔØ ÓÌÕÞÁÊÎÏ. - -åÓÌÉ ×Ù ÎÁÂÒÁÌÉ ÏÄÎÕ ÉÚ ×ÙËÌÀÞÅÎÎÙÈ ËÏÍÁÎÄ, Emacs ÐÏËÁÖÅÔ ÓÏÏÂÝÅÎÉÅ ÇÏ×ÏÒÑÝÅÅ -ËÁËÁÑ ËÏÍÁÎÄÁ ×ÙÚÙ×ÁÅÔÓÑ, É ÓÐÒÏÓÉÔ, ÈÏÔÉÔÅ ÌÉ ×Ù ÐÒÏÄÏÌÖÉÔØ É ×ÙÐÏÌÎÉÔØ -ËÏÍÁÎÄÕ. - -åÓÌÉ ×Ù ÄÅÊÓÔ×ÉÔÅÌØÎÏ ÈÏÔÉÔÅ ÐÏÐÒÏÂÏ×ÁÔØ ËÏÍÁÎÄÕ, ÎÁÖÍÉÔÅ ðÒÏÂÅÌ (Space) × -ÏÔ×ÅÔ ÎÁ ÜÔÏÔ ×ÏÐÒÏÓ. ïÂÙÞÎÏ, ÅÓÌÉ ×Ù ÎÅ ÈÏÔÉÔÅ ×ÙÐÏÌÎÑÔØ ×ÙËÌÀÞÅÎÎÕÀ -ËÏÍÁÎÄÕ, ÏÔ×ÅÞÁÊÔÅ ÎÁ ×ÏÐÒÏÓ "n". - ->> îÁÖÍÉÔÅ `C-x n p' (×ÙËÌÀÞÅÎÎÁÑ ËÏÍÁÎÄÁ), ÐÏÔÏÍ ÏÔ×ÅÔØÔÅ "n" ÎÁ ×ÏÐÒÏÓ. - - -* ïëîá ------- - -Emacs ÍÏÖÅÔ ÉÍÅÔØ ÎÅÓËÏÌØËÏ ÏËÏÎ, ËÁÖÄÏÅ ÏÔÏÂÒÁÖÁÅÔ Ó×ÏÊ ÔÅËÓÔ. -úÁÍÅÔØÔÅ, "ÏËÎÏ" ÉÓÐÏÌØÚÕÅÍÏÅ Emacs`ÏÍ ÜÔÏ ÎÅ ÏÔÄÅÌØÎÙÅ ÐÅÒÅËÒÙ×ÁÀÝÅÅÓÑ -ÏËÎÁ × ÏËÏÎÎÏÊ ÓÉÓÔÅÍÙ, ÜÔÏ ÏÔÄÅÌØÎÙÅ ÏÂÌÁÓÔÉ × ÏÄÎÏÍ ÏËÎÅ X window. -(Emacs ÔÁË ÖÅ ÍÏÖÅÔ ÉÍÅÔØ ÎÅÓËÏÌØËÏ ÏËÏÎ X windows, ÉÌÉ "ËÁÄÒÏ×" ("frames") -× ÔÅÒÍÉÎÏÌÏÇÉÉ Emacs. üÔÏ ÂÕÄÅÔ ÏÐÉÓÁÎÏ ÐÏÚÖÅ.) - -îÁ ÜÔÏÊ ÓÔÁÄÉÉ ÌÕÞÛÅ ÎÅ ÐÏÇÒÕÖÁÔØÓÑ × ÔÅÈÎÏÌÏÇÉÀ ÉÓÐÏÌØÚÏ×ÁÎÉÑ ÍÎÏÖÅÓÔ×Á -ÏËÏÎ. îÏ ×ÁÍ ÎÕÖÎÏ ÚÎÁÔØ, ËÁË ÉÚÂÁ×ÌÑÔØÓÑ ÏÔ ÌÉÛÎÉÈ ÏËÏÎ, ËÏÔÏÒÙÅ ÍÏÇÕÔ -ÐÏÑ×ÌÑÔØÓÑ ÞÔÏ ÏÔÏÂÒÁÚÉÔØ ÐÏÍÏÝØ, ÉÌÉ ×Ù×ÏÄ ÏÐÒÅÄÅÌÅÎÎÙÈ ËÏÍÁÎÄ. üÔÏ -ÐÒÏÓÔÏ: - - C-x 1 ïÄÎÏ ÏËÎÏ. (ÚÁËÒÙÔØ ×ÓÅ ÄÒÕÇÉÅ ÏËÎÁ). - -üÔÏ Control-x ÓÏ ÓÌÅÄÕÀÝÅÊ ÃÉÆÒÏÊ 1. C-x 1 ÒÁÚ×ÅÒÎÅÔ ÏËÎÏ ËÏÔÏÒÏÅ ÓÏÄÅÒÖÉÔ -ËÕÒÓÏÒ, ÔÁË, ÞÔÏ ÏÎÏ ÚÁÎÑÌÏ ×ÅÓØ ÜËÒÁÎ. üÔÏ ÕÄÁÌÉÔ ×ÓÅ ÄÒÕÇÉÅ ÏËÎÁ. - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ ÜÔÕ ÓÔÒÏËÕ É ÎÁÖÍÉÔÅ C-u 0 C-l. - -(úÁÐÏÍÎÉÔÅ ÞÔÏ C-l ÐÅÒÅÒÉÓÏ×Ù×ÁÅÔ ÜËÒÁÎ. åÓÌÉ ×Ù ÚÁÄÁÅÔÅ ÃÉÆÒÏ×ÏÊ -ÁÒÇÕÍÅÎÔ ÄÌÑ ÜÔÏÊ ËÏÍÁÎÄÙ, ÜÔÏ ÚÎÁÞÉÔ "ÐÅÒÅÒÉÓÏ×ÁÔØ ÜËÒÁÎ É ÐÏÍÅÓÔÉÔØ -ÔÅËÕÝÕÀ ÓÔÒÏËÕ ÎÁ ÓÔÏÌØËÏ-ÔÏ ÓÔÒÏË ÏÔ ÎÁÞÁÌÁ ÜËÒÁÎÁ." ôÁË C-u 0 C-l -ÏÚÎÁÞÁÅÔ "ÐÅÒÅÒÉÓÏ×ÁÔØ ÜËÒÁÎ, ÐÏÍÅÓÔÉÔØ ÔÅËÕÝÕÀ ÓÔÒÏËÕ × ÎÁÞÁÌÅ.") - ->> îÁÂÅÒÉÔÅ Control-x 2 - ðÏÓÍÏÔÒÉÔÅ, ËÁË ÔÅËÕÝÅÅ ÏËÎÏ ÓÏÖÍÅÔÓÑ, ËÏÇÄÁ ÎÏ×ÏÅ ÐÏÑ×ÉÔÓÑ É - ÏÔÏÂÒÁÚÉÔ ÓÏÄÅÒÖÉÍÏÅ ÜÔÏÇÏ ÂÕÆÅÒÁ. - ->> îÁÂÅÒÉÔÅ C-x 1 É ÐÏÓÍÏÔÒÉÔÅ ËÁË ÏËÎÏ ÉÓÞÅÚÎÅÔ. - - -* ÷óôá÷ëá é õäáìåîéå --------------------- - -åÓÌÉ ×Ù ÈÏÔÉÔÅ ×ÓÔÁ×ÉÔØ ÔÅËÓÔ, ÐÒÏÓÔÏ ÎÁÂÅÒÉÔÅ ÔÅËÓÔ. óÉÍ×ÏÌÙ, ËÏÔÏÒÙÅ ×Ù -ÍÏÖÅÔÅ ×ÉÄÅÔØ, ÔÁËÉÅ ËÁË A, 7, *, É ÐÒ. ÐÏÎÉÍÁÀÔÓÑ Emacs`ÏÍ ËÁË ÔÅËÓÔ É -×ÓÔÁ×ÌÑÀÔÓÑ ÎÅÍÅÄÌÅÎÎÏ. îÁÖÍÉÔÅ (ËÎÏÐËÁ ÐÅÒÅ×ÏÄÁ ËÁÒÅÔËÉ) ÄÌÑ -×ÓÔÁ×ËÉ ÓÉÍ×ÏÌÁ îÏ×ÁÑóÔÒÏËÁ. - -÷Ù ÍÏÖÅÔÅ ÕÄÁÌÉÔØ ÐÏÓÌÅÄÎÉÊ ÎÁÂÒÁÎÎÙÊ ÓÉÍ×ÏÌ ÎÁÖÉÍÁÑ . -ëÌÁ×ÉÛÁ ÎÁ ËÌÁ×ÉÁÔÕÒÅ ÍÏÖÅÔ ÂÙÔØ ÏÂÏÚÎÁÞÅÎÁ ËÁË "Del". -÷ ÎÅËÏÔÏÒÙÈ ÓÌÕÞÁÑÈ, ËÌÁ×ÉÛÅ "Backspace" ÒÁÂÏÔÁÅÔ ËÁË , -ÎÏ ÎÅ ×ÓÅÇÄÁ! - -÷ ÏÓÎÏ×ÎÏÍ, ÕÄÁÌÑÅÔ ÓÉÍ×ÏÌ ÎÅÐÏÓÒÅÄÓÔ×ÅÎÎÏ ÐÅÒÅÄ ÔÅËÕÝÅÊ ÐÏÚÉÃÉÅÊ -ËÕÒÓÏÒÁ. - ->> ðÏÐÒÏÂÕÊÔÅ ÜÔÏ ÓÅÊÞÁÓ -- ÎÁÂÅÒÉÔÅ ÎÅÓËÏÌØËÏ ÓÉÍ×ÏÌÏ×, ÐÏÔÏÍ ÕÄÁÌÉÔÅ ÉÈ - ÎÁÖÉÍÁÑ ÎÅÓËÏÌØËÏ ÒÁÚ. îÅ ×ÏÌÎÕÊÔÅÓØ Ï ÉÚÍÅÎÅÎÉÑÈ ÜÔÏÇÏ ÆÁÊÌÁ; - ×Ù ÎÅ ÉÚÍÅÎÑÅÔÅ ÇÌÁ×ÎÙÊ ÕÞÅÂÎÉË. üÔÏ ×ÁÛÁ ÌÉÞÎÁÑ ËÏÐÉÑ ÕÞÅÂÎÉËÁ. - -ëÏÇÄÁ ÓÔÒÏËÁ ÔÅËÓÔÁ ÓÔÁÎÏ×ÉÔÓÑ ÓÌÉÛËÏÍ ÂÏÌØÛÏÊ ÄÌÑ ÓÔÒÏËÉ ÜËÒÁÎÁ, ÓÔÒÏËÁ -ÔÅËÓÔÁ "ÐÒÏÄÏÌÖÁÅÔÓÑ" ÎÁ ÓÌÅÄÕÀÝÅÊ ÓÔÒÏËÅ ÜËÒÁÎÁ. óÉÍ×ÏÌ "ÏÂÒÁÔÎÏÅ ÄÅÌÅÎÉÅ" -("\") Ó ÐÒÁ×ÏÊ ÇÒÁÎÉÃÙ ÐÏËÁÚÙ×ÁÅÔ, ÞÔÏ ÓÔÒÏËÁ ÂÕÄÅÔ ÐÒÏÄÏÌÖÅÎÁ. - ->> ÷ÓÔÁ×ÌÑÊÔÅ ÔÅËÓÔ, ÐÏËÁ ÎÅ ÄÏÓÔÉÇÎÉÔÅ ÐÒÁ×ÏÊ ÇÒÁÎÉÃÙ, É ÐÒÏÄÏÌÖÁÊÔÅ ×ÓÔÁ×ËÕ. - ÷Ù Õ×ÉÄÉÔÅ, ËÁË ÐÏÑ×ÉÔÓÑ ÓÉÍ×ÏÌ ÐÒÏÄÏÌÖÅÎÉÑ ÓÔÒÏËÉ. - ->> éÓÐÏÌØÚÕÊÔÅ ÄÌÑ ÕÄÁÌÅÎÉÑ ÔÅËÓÔÁ, ÐÏËÁ ÓÔÒÏËÁ ÎÅ ÐÏÍÅÓÔÉÔÓÑ × - ÜËÒÁÎ ÓÎÏ×Á. óÉÍ×ÏÌ ÐÒÏÄÏÌÖÅÎÉÑ ÓÔÒÏËÉ ÉÓÞÅÚÎÅÔ. - -íÏÖÎÏ ÕÄÁÌÑÔØ ÓÉÍ×ÏÌ îÏ×ÁÑóÔÒÏËÁ ÔÁË ÖÅ, ËÁË É ÌÀÂÏÊ ÄÒÕÇÏÊ. õÄÁÌÅÎÉÅ ÓÉÍ×ÏÌÁ -îÏ×ÁÑóÔÒÏËÁ ÍÅÖÄÕ Ä×ÕÍÑ ÓÔÒÏËÁÍÉ ÐÒÉ×ÅÄÅÔ Ë ÓËÌÅÊËÅ ÉÈ × ÏÄÎÕ. åÓÌÉ -ÒÅÚÕÌØÔÉÒÕÀÝÁÑ ÓÔÒÏËÁ ÓÌÉÛËÏÍ ÄÌÉÎÎÁÑ, ÞÔÏÂÙ ×ÍÅÓÔÉÔØÓÑ × ÜËÒÁÎ, ÏÎÁ ÂÕÄÅÔ -ÏÔÏÂÒÁÖÅÎÁ ËÁË ÐÒÏÄÏÌÖÅÎÎÁÑ ÓÔÒÏËÁ. - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ × ÎÁÞÁÌÏ ÓÔÒÏËÉ É ÎÁÖÍÉÔÅ . üÔÏ ÓÏÅÄÉÎÉÔ - ÔÅËÕÝÕÀ ÓÔÒÏËÕ É ÐÒÅÄÙÄÕÝÕÀ. - ->> îÁÖÍÉÔÅ ÄÌÑ ×ÓÔÁ×ËÉ ÓÉÍ×ÏÌÁ îÏ×ÁÑóÔÒÏËÁ ÓÎÏ×Á, ×ÍÅÓÔÏ - ÕÄÁÌÅÎÎÏÇÏ ×ÁÍÉ. - -ðÏÍÎÉÔÅ, ÞÔÏ ÍÎÏÇÉÅ ËÏÍÁÎÄÙ Emacs ÍÏÇÕÔ ÐÏÌÕÞÁÔØ ÓÞÅÔÞÉË ÐÏ×ÔÏÒÅÎÉÑ; -ÐÒÏÓÔÙÅ ÓÉÍ×ÏÌÙ ÎÅ ÉÓËÌÀÞÅÎÉÅ. îÅÂÅÒÁÊÔÅ ÐÒÏÓÔÙÅ ÓÉÍ×ÏÌÙ ×ÓÔÁ×ÌÑÑ -ÉÈ ÐÏ ÎÅÓËÏÌØËÏ ÚÁ ÏÄÉÎ ÒÁÚ. - ->> ðÏÐÒÏÂÕÊÔÅ ÜÔÏ -- ÎÁÂÅÒÉÔÅ C-u 8 * ÄÌÑ ×ÓÔÁ×ËÉ ********. - -ôÅÐÅÒØ ×Ù ÎÁÕÞÉÌÉÓØ ÏÓÎÏ×ÎÏÍÕ ÓÐÏÓÏÂÕ ÎÁÂÒÉÔØ ÞÔÏ-ÎÉÂÕÄØ × Emacs É -ÉÓÐÒÁ×ÌÑÔØ ÏÛÉÂËÉ. ôÁË ÖÅ ×Ù ÍÏÖÅÔÅ ÕÄÁÌÑÔØ ÓÌÏ×Á É ÓÔÒÏËÉ. -úÄÅÓØ ÓÏÂÒÁÎÙ ÏÐÅÒÁÃÉÉ ÕÄÁÌÅÎÉÑ: - - ÕÄÁÌÉÔØ ÓÉÍ×ÏÌ ÐÅÒÅÄ ËÕÒÓÏÒÏÍ - C-d ÕÄÁÌÉÔØ ÓÉÍ×ÏÌ ÓÌÅÄÕÀÝÉÊ ÚÁ (ÎÁÄ) ËÕÒÓÏÒÏÍ - - M- õÂÉÔØ ÓÔÒÏËÕ ÎÅÐÏÓÒÅÄÓÔ×ÅÎÎÏ ÐÅÒÅÄ ËÕÒÓÏÒÏÍ - M-d õÂÉÔØ ÓÌÏ×Ï ÓÌÅÄÕÀÝÅÅ ÚÁ ËÕÒÓÏÒÏÍ - - C-k õÂÉÔØ ×ÓÅ ÏÔ ËÕÒÓÏÒÁ ÄÏ ËÏÎÃÁ ÓÔÒÏËÉ - M-k õÂÉÔØ ×ÓÅ ÄÏ ËÏÎÃÁ ÐÒÅÄÌÏÖÅÎÉÑ - -úÁÍÅÔØÔÅ, ÞÔÏ É C-d ÐÒÏÔÉ× M- É M-d ÒÁÓÛÉÒÑÀÔ ÐÁÒÁÌÌÅÌØ -ÎÁÞÁÔÕÀ, C-f É M-f (ÄÁ, ÜÔÏ ÎÅ ÒÅÁÌØÎÙÊ control-ÓÉÍ×ÏÌ, ÎÏ -ÎÅ ÎÕÖÎÏ ×ÏÌÎÏ×ÁÔØÓÑ Ï ÜÔÏÍ). C-k É M-k ËÁË É C-e É M-e, ÐÒÏ×ÏÄÑÔ -ÐÁÒÁÌÌÅÌØ ÍÅÖÄÕ ÓÔÒÏËÁÍÉ É ÐÒÅÄÌÏÖÅÎÉÑÍÉ. - -ëÏÇÄÁ ×Ù ÕÄÁÌÑÅÔÅ ÂÏÌÅÅ ÞÅÍ ÏÄÉÎ ÓÉÍ×ÏÌ ÓÒÁÚÕ, Emacs ÓÏÈÒÁÎÑÅÔ ÕÄÁÌÅÎÎÙÊ -ÔÅËÓÔ, ÞÔÏÂÙ ×Ù ÍÏÇÌÉ ×ÅÒÎÕÔØ ÅÇÏ ÏÂÒÁÔÎÏ. ÷ÏÚ×ÒÁÔ ÔÅËÓÔÁ, ÕÄÁÌÅÎÎÏÇÏ ÒÁÎÅÅ, -ÎÁÚÙ×ÁÀÔ "×ÏÓÓÔÁÎÏ×ÌÅÎÉÅ" ("yanking"). ÷Ù ÍÏÖÅÔÅ ×ÏÓÓÔÁÎÏ×ÉÔØ ÕÄÁÌÅÎÎÙÊ -ÔÅËÓÔ × ÔÏÍ ÖÅ ÍÅÓÔÅ, ÉÌÉ × ÌÀÂÏÍ ÄÒÕÇÏÍ. ÷Ù ÍÏÖÅÔÅ ×ÏÓÓÔÁÎÏ×ÉÔØ -ÔÅËÓÔ ÎÅÓËÏÌØËÏ ÒÁÚ É ÐÏÌÕÞÉÔØ ÍÎÏÇÏ ËÏÐÉÊ. ëÏÍÁÎÄÁ "×ÏÓÓÔÁÎÏ×ÉÔØ" - C-y. - -úÁÍÅÔØÔÅ, ÞÔÏ ÅÓÔØ ÒÁÚÎÉÃÁ ÍÅÖÄÕ "ÕÄÁÌÉÔØ" É "ÕÂÉÔØ" ÞÔÏ-ÎÉÂÕÄØ. "õÂÉÔÏÅ" -ÍÏÖÅÔ ÂÙÔØ ×ÏÓÓÔÁÎÏ×ÌÅÎÏ ÎÁÚÁÄ, Á ÕÄÁÌÅÎÎÏÅ - ÎÅÔ. ïÂÙÞÎÏ, ËÏÍÁÎÄÙ, ËÏÔÏÒÙÅ -ÍÏÇÕÔ ÕÂÉÒÁÔØ ÍÎÏÇÏ ÔÅËÓÔÁ, ÓÏÈÒÁÎÑÀÔ ÅÇÏ, Á ËÏÍÁÎÄÙ, ÕÄÁÌÑÀÝÉÅ ÏÄÉÎ ÓÉÍ×ÏÌ -ÉÌÉ ÐÒÏÓÔÏ ÐÕÓÔÕÀ ÓÔÒÏËÕ, ÎÅ ÓÏÈÒÁÎÑÀÔ ÕÄÁÌÅÎÎÏÅ. - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ ÎÁÞÁÌÏ ÎÅÐÕÓÔÏÊ ÓÔÒÏËÉ. - ôÅÐÅÒØ ÎÁÖÍÉÔÅ C-k ÞÔÏ ÕÂÉÔØ ÔÅËÓÔ × ÜÔÏÊ ÓÔÒÏËÅ. - ->> îÁÖÍÉÔÅ C-k ÅÝÅ ÒÁÚ. ÷Ù ×ÉÄÉÔÅ, ÞÔÏ ÜÔÏ ÕÂßÅÔ ÓÉÍ×ÏÌ îÏ×ÁÑóÔÒÏËÁ - ÓÌÅÄÕÀÝÉÊ ÚÁ ÜÔÏÊ ÓÔÒÏËÏÊ. - -úÁÍÅÔØÔÅ ÞÔÏ ÐÅÒ×ÏÅ C-k ÕÂÉ×ÁÅÔ ÓÏÄÅÒÖÉÍÏÅ ÓÔÒÏËÉ, Á ×ÔÏÒÏÅ C-k ÕÂÉ×ÁÅÔ -ÓÁÍÕ ÓÔÒÏËÕ É ÐÏÄÎÉÍÁÅÔ ÄÒÕÇÉÅ ÓÔÒÏËÉ ××ÅÒÈ. C-k ÏÂÒÁÂÁÔÙ×ÁÅÔ ÞÉÓÌÏ×ÏÊ -ÁÒÇÕÍÅÎÔ ÓÐÅÃÉÁÌØÎÙÍ ÏÂÒÁÚÏÍ: ÕÂÉ×ÁÅÔ ÍÎÏÇÏ ÓÔÒÏË _é_ ÉÈ ÓÏÄÅÒÖÉÍÏÅ. -ÜÔÏ ÎÅ ÐÒÏÓÔÏ ÐÏ×ÔÏÒÅÎÉÅ. C-u 2 C-k ÕÂ`ÅÔ Ä×Å ÓÔÒÏÉ É ÚÁ×ÅÒÛÁÀÝÉÅ ÉÈ -ÓÉÍ×ÏÌÙ îÏ×ÁÑóÔÒÏËÁ; ÷×ÏÄ C-k Ä×ÁÖÄÙ ÎÅ ÓÄÅÌÁÅÔ ÜÔÏÇÏ. - -äÌÑ ÔÏÇÏ ÞÔÏ ×ÅÒÎÕÔØ ÐÏÓÌÅÄÎÉÊ ÕÂÉÔÙÊ ÔÅËÓÔ × ÍÅÓÔÏ ÒÁÓÐÏÌÏÖÅÎÉÅ ËÕÒÓÏÒÁ -ÎÁÂÅÒÉÔÅ C-y. - ->> ðÏÐÒÏÂÕÊÔÅ ÜÔÏ; ÎÁÂÅÒÉÔÅ C-y ÞÔÏ ×ÅÒÎÕÔØ ÔÅËÓÔ ÎÁÚÁÄ. - -äÕÍÁÊÔÅ Ï C-y ËÁË Ï ÓÐÏÓÏÂÅ ×ÅÒÎÕÔØ ÞÔÏ-ÔÏ ÎÁÚÁÄ, ÞÔÏ ×Ù ÐÏÔÅÒÑÌÉ. -ðÏÍÎÉÔÅ, ÅÓÌÉ ×Ù ÉÓÐÏÌØÚÏ×ÁÌÉ ÎÅÓËÏÌØËÏ C-k' × ÓÔÒÏËÅ, ×ÓÅ ÕÂÉÔÙÅ ÓÔÒÏËÉ -ÂÕÄÕÔ ÓÏÈÒÁÎÅÎÙ ×ÍÅÓÔÅ, ÔÁË, ÞÔÏ C-y ×ÏÓÓÔÁÎÏ×ÉÔ ÉÈ ×ÍÅÓÔÅ. - ->> ðÏÐÒÏÂÕÊÔÅ ÜÔÏ ÓÅÊÞÁÓ, ÎÁÖÍÉÔÅ C-k ÎÅÓËÏÌØËÏ ÒÁÚ. - -ôÅÐÅÒØ ×ÅÒÎÅÍ ÜÔÏÔ ÕÂÉÔÙÊ ÔÅËÓÔ: - ->> îÁÖÍÉÔÅ C-y. ôÅÐÅÒØ ÐÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ ÎÅÓËÏÌØËÏ ÓÔÒÏË ×ÎÉÚ, É ÓÎÏ×Á - ÎÁÖÍÉÔÅ C-y. óÅÊÞÁÓ ×Ù ×ÉÄÉÔÅ ËÁË ÍÏÖÎÏ ÓËÏÐÉÒÏ×ÁÔØ ÎÅËÏÔÏÒÙÊ ÔÅËÓÔ. - -þÔÏ ÄÅÌÁÔØ ÅÓÌÉ ÅÓÔØ ÎÅËÏÔÏÒÙÊ ÔÅËÓÔ, ËÏÔÏÒÙÊ ×Ù ÈÏÔÉÔÅ ×ÅÒÎÕÔØ ÎÁÚÁÄ É -ÐÏÔÏÍ ÕÂÉÔØ ÞÔÏ-ÔÏ ÅÝÅ? C-y ×ÅÒÎÅÔ ÎÅ ÂÏÌÅÅ ÞÅÍ ÐÏÓÌÅÄÎÉÊ ÕÄÁÌÅÎÎÙÊ ÔÅËÓÔ. -îÏ ÐÒÅÄÙÄÕÝÉÊ ÔÅËÓÔ ÎÅ ÂÕÄÅÔ ÐÏÔÅÒÑÎ. ÷Ù ÓÍÏÖÅÔÅ ÅÇÏ ×ÅÒÎÕÔØ ÎÁÚÁÄ ÉÓÐÏÌØÚÕÑ -ËÏÍÁÎÄÕ M-y. ðÏÓÌÅ ÔÏÇÏ ËÁË ×Ù ×ÅÒÎÕÌÉ ÐÏÓÌÅÄÎÉÊ ÕÄÁÌÅÎÎÙÊ ÔÅËÓÔ, ÎÁÖÍÉÔÅ -M-y, É ÚÁÍÅÎÉÔÅ ÜÔÏÔ ×ÏÓÓÔÁÎÏ×ÌÅÎÎÙÊ ÔÅËÓÔ ÔÅÍ, ËÏÔÏÒÙÊ ÂÙÌ ÕÂÉÔ ÒÁÎÅÅ. -îÁÖÁÔÉÅ M-y ÓÎÏ×Á É ÓÎÏ×Á ÂÕÄÅÔ ×ÏÚ×ÒÁÝÁÔØ ×ÓÅ ÒÁÎÅÅ É ÒÁÎÅÅ ÕÂÉÔÙÊ ÔÅËÓÔ. -ëÏÇÄÁ ×Ù ÄÏÓÔÉÇÎÉÔÅ ÉÓËÏÍÏÇÏ ÔÅËÓÔÁ, ×ÁÍ ÎÅ ÎÕÖÎÏ ÄÅÌÁÔØ ÎÉÞÅÇÏ ÂÏÌÅÅ ÞÔÏ -ÓÏÈÒÁÎÉÔØ ÅÇÏ. ðÒÏÓÔÏ ÐÒÏÄÏÌÖÁÊÔÅ ÒÅÄÁËÔÉÒÏ×ÁÎÉÅ, ÏÓÔÁ×É× ×ÏÓÓÔÁÎÏ×ÌÅÎÎÙÊ -ÔÅËÓÔ ÔÁÍ, ÇÄÅ ÏÎ ÅÓÔØ. - -îÁÖÉÍÁÑ M-y ÄÏÓÔÁÔÏÞÎÏÅ ÞÉÓÌÏ ÒÁÚ, ×Ù ÍÏÖÅÔÅ ×ÅÒÎÕÔØÓÑ × ÎÁÞÁÌØÎÕÀ ÔÏÞËÕ -(ÎÁÉÂÏÌÅÅ ÒÁÎÎÅÅ ÕÄÁÌÅÎÉÅ). - ->> õÂÅÊÔÅ ÓÔÒÏËÕ, ÐÏËÒÕÔÉÔÅÓØ ËÕÒÓÏÒÏÍ ×ÏËÒÕÇ, ÐÏÔÏÍ ÕÄÁÌÉÔÅ ÅÝÅ ÏÄÎÕ ÓÔÒÏËÕ. - úÁÔÅÍ ÉÓÐÏÌØÚÕÊÔÅ C-y ÄÌÑ ×ÏÓÓÔÁÎÏ×ÌÅÎÉÑ ×ÔÏÒÏÊ ÕÂÉÔÏÊ ÓÔÒÏËÉ. - úÁÔÅÍ ÉÓÐÏÌØÚÕÊÔÅ M-y É ÏÎÁ ÂÕÄÅÔ ÚÁÍÅÎÅÎÁ ÐÅÒ×ÏÊ ÕÂÉÔÏÊ ÓÔÒÏËÏÊ. - îÁÖÍÉÔÅ ÅÝÅ ÎÅÓËÏÌØËÏ ÒÁÚ M-y ÞÔÏ Õ×ÉÄÅÔØ ÞÔÏ ÐÏÌÕÞÉÔÓÑ. ðÒÏÄÏÌÖÁÊÔÅ - ÄÅÌÁÔØ ÜÔÏ ÐÏËÁ ×ÔÏÒÁÑ ÕÂÉÔÁÑ ÓÔÒÏËÁ ÎÅ ×ÅÒÎÅÔÓÑ, É ÅÝÅ ÞÕÔØ-ÞÕÔØ. - åÓÌÉ ×ÁÍ ÈÏÞÅÔÓÑ, ×Ù ÍÏÖÅÔÅ ÚÁÄÁ×ÁÔØ ÄÌÑ M-y ÐÏÌÏÖÉÔÅÌØÎÙÅ É ÏÔÒÉÃÁÔÅÌØÎÙ - ÁÒÇÕÍÅÎÔÙ. - - -* ïôíåîá (UNDO) ---------------- - -åÓÌÉ ×Ù ÓÄÅÌÁÌÉ ÉÚÍÅÎÅÎÉÑ × ÔÅËÓÔÅ, É ÒÅÛÉÌÉ, ÞÔÏ ÏÛÉÂÌÉÓØ, ÍÏÖÅÔÅ -ÏÔÍÅÎÉÔØ ÉÚÍÅÎÅÎÉÑ ËÏÍÁÎÄÏÊ "ÏÔÍÅÎÁ", C-x u. - -ïÂÙÞÎÏ, C-x u ÏÔÍÅÎÑÅÔ ÉÚÍÅÎÅÎÉÑ, ÓÄÅÌÁÎÎÙÅ ÏÄÎÏÊ ËÏÍÁÎÄÏÊ; ÅÓÌÉ ÐÏ×ÔÏÒÉÔØ C-x -u ÎÅÓËÏÌØËÏ ÒÁÚ ÐÏÄÒÑÄ, ËÁÖÄÙÊ ÒÁÚ ÂÕÄÅÔ ÏÔÍÅÎÑÔØÓÑ ÅÝÅ ÏÄÎÁ ËÏÍÁÎÄÁ. - -îÏ ÅÓÔØ Ä×Á ÉÓËÌÀÞÅÎÉÑ: ËÏÍÁÎÄÙ ËÏÔÏÒÙÅ ÎÅ ÉÚÍÅÎÑÀÔ ÔÅËÓÔ ÎÅ ÕÞÉÔÙ×ÁÀÔÓÑ (ÜÔÏ -×ËÌÀÞÁÅÔ ËÏÍÁÎÄÙ ÐÅÒÅÍÅÝÅÎÉÑ ËÕÒÓÏÒÁ É ÐÒÏËÒÕÔËÉ), É ÓÁÍÏ×ÓÔÁ×ÌÑÀÝÉÅÓÑ -(self-inserting) ÓÉÍ×ÏÌÙ ÏÂÒÁÂÁÔÙ×ÁÀÔÓÑ ÇÒÕÐÐÁÍÉ ÄÏ 20. (üÔÏ ÕÍÅÎØÛÁÅÔ ÞÉÓÌÏ -C-x u ËÏÔÏÒÙÅ ×Ù ÍÏÖÅÔÅ ÎÁÂÒÁÔØ ÄÌÑ ÏÔÍÅÎÙ ××ÏÄÁ ÔÅËÓÔÁ.) - ->> õÂÅÊÔÅ ÜÔÕ ÓÔÒÏËÕ ÉÓÐÏÌØÚÕÑ C-k, ÚÁÔÅÍ ÎÁÂÅÒÉÔÅ C-x u - É ÏÎÁ ÄÏÌÖÎÁ ×ÅÒÎÕÔØÓÑ ÎÁÚÁÄ. - -C-_ ÁÌØÔÅÒÎÁÔÉ×ÎÁÑ ËÏÍÁÎÄÁ ÏÔÍÅÎÙ; ÏÎÁ ÒÁÂÏÔÁÅÔ ÔÁËÖÅ ËÁË É C-x u, ÎÏ ÌÅÇÞÅ × -ÉÓÐÏÌØÚÏ×ÁÎÉÉ ÎÅÓËÏÌØËÏ ÒÁÚ ÐÏÄÒÑÄ. îÅÕÄÏÂÎÏÅ ÐÏÌÏÖÅÎÉÅ C-_ Á ÎÁ ÎÅËÏÔÏÒÙÈ -ËÌÁ×ÉÁÔÕÒÁÈ ÄÅÌÁÅÔ ÎÅÏÞÅ×ÉÄÎÙÍ ÓÐÏÓÏ ÅÅ ÎÁÂÏÒÁ. ðÏÜÔÏÍÕ ÍÙ ÐÒÅÄÌÁÇÁÅÍ C-x u -Ë ÉÓÐÏÌØÚÏ×ÁÎÉÀ. îÁ ÎÅËÏÔÏÒÙÈ ÔÅÒÍÉÎÁÌÁÈ, ×Ù ÍÏÖÅÔÅ ÎÁÂÉÒÁÔØ C-_ ÎÁÖÉÍÁÑ / É -ÕÄÅÒÖÉ×ÁÑ ËÌÁ×ÉÛÕ CTRL. - -þÉÓÌÏ×ÏÊ ÁÒÇÕÍÅÎÔ ÄÌÑ C-_ ÉÌÉ C-x u ÒÁÂÏÔÁÅÔ ËÁË ÓÞÅÔÞÉË ÐÏ×ÔÏÒÅÎÉÑ. - - -* æáêìù -------- - -þÔÏÂÙ ÓÏÚÄÁÎÎÙÊ ÔÅËÓÔ ÍÏÖÎÏ ÂÙÌÏ ÒÅÄÁËÔÉÒÏ×ÁÔØ ÐÏÚÖÅ, ×Ù ÄÏÌÖÎÙ ÅÇÏ -ÐÏÍÅÓÔÉÔØ × ÆÁÊÌ. éÎÁÞÅ, ÏÎ ÉÓÞÅÚÎÅÔ ËÏÇÄÁ ×Ù ×ÙÊÄÉÔÅ ÉÚ Emacs. ÷Ù ÐÏÍÅÝÁÅÔÅ -×ÁÛ ÔÅËÓÔ × ÆÁÊÌ "ÏÔËÒÙ×ÁÑ" ÆÁÊÌ. (åÝÅ ÜÔÏ ÎÁÚÙ×ÁÀÔ "ÐÒÉÊÔÉ" × ÆÁÊÌ.) -(// × ÏÒÉÇÉÎÁÌÅ ÔÅÒÍÉÎÙ "finding", É "visiting") - -ïÔËÒÙÔØ ÆÁÊÌ ÏÚÎÁÞÁÅÔ ÐÏÓÍÏÔÒÅÔØ ÅÇÏ ÓÏÄÅÒÖÉÍÏÅ ÉÓÐÏÌØÚÕÑ Emacs. ÷Ï ÍÎÏÇÉÈ -ÓÌÕÞÁÑÈ, ÜÔÏ ÐÒÏÉÓÈÏÄÉÔ ËÏÇÄÁ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ ÆÁÊÌ ÓÁÍÉ. ïÄÎÁËÏ ×ÁÛÉ -ÉÚÍÅÎÅÎÉÑ, ÓÄÅÌÁÎÎÙÅ Ó ÉÓÐÏÌØÚÏ×ÁÎÉÅÍ Emacs ÎÅ ÂÕÄÕÔ ÚÁÆÉËÓÉÒÏ×ÁÎÙ, ÐÏËÁ ×Ù ÎÅ -"ÓÏÈÒÁÎÉÔÅ" ("save") ÆÁÊÌ. ôÁË ×Ù ÍÏÖÅÔÅ ÎÅ ÏÓÔÁ×ÌÑÔØ ÐÏÌÕÉÚÍÅÎÅÎÎÙÊ ÆÁÊÌ × -ÓÉÓÔÅÍÅ, ÅÓÌÉ ×Ù ÎÅ ÈÏÔÉÔÅ ÜÔÏÇÏ. äÁÖÅ ËÏÇÄÁ ×Ù ÓÏÈÒÁÎÑÅÔÅ ÆÁÊÌ, Emacs -ÏÓÔÁ×ÌÑÅÔ ÏÒÉÇÉÎÁÌØÎÙÊ ÆÁÊÌ Ó ÉÚÍÅÎÅÎÎÙÍ ÉÍÅÎÅÍ, ÞÔÏ ×Ù ÍÏÇÌÉ ÐÏÚÖÅ ÒÅÛÉÔØ -ÞÔÏ ×ÁÛÉ ÉÚÍÅÎÅÎÉÑ ÂÙÌÉ ÏÛÉÂÏÞÎÙ. - -åÓÌÉ ÐÏÓÍÏÔÒÅÔØ × ÎÉÖÎÀÀ ÞÁÓÔØ ÜËÒÁÎÁ, ×Ù Õ×ÉÄÉÔÅ ÓÔÒÏËÕ ËÏÔÏÒÁÑ ÎÁÞÉÎÁÅÔÓÑ Ó -ÔÉÒÅ É ÓÏÄÅÒÖÉÔ ÓÔÒÏËÕ "Emacs: TUTORIAL.ru". üÔÁ ÞÁÓÔØ ÜËÒÁÎÁ ×ÓÅÇÄÁ -ÐÏËÁÚÙ×ÁÅÔ ÉÍÑ ÆÁÊÌÁ ËÏÔÏÒÙÊ ×Ù ÏÔËÒÙÌÉ. éÔÁË, ÓÅÊÞÁÓ ×Ù ÏÔËÒÙÌÉ ÆÁÊÌ Ó -ÉÍÅÎÅÍ "TUTORIAL.ru" ËÏÔÏÒÙÊ Ñ×ÌÑÅÔÓÑ ×ÁÛÅÊ ÐÅÒÓÏÎÁÌØÎÏÊ ËÏÐÉÅÊ ÕÞÅÂÎÉËÁ -Emacs. ìÀÂÏÊ ÆÁÊÌ ËÏÔÏÒÙÊ ×Ù ÏÔËÒÏÅÔÅ, ÜÔÏ ÉÍÑ ÆÁÊÌÁ Ó ÄÏÂÁ×ÌÅÎÎÏÊ ÍÁÌÅÎØËÏÊ -ËÒÁÐÉÎËÏÊ. (Whatever file you find, that file's name will appear in that -precise spot.) - -ëÏÍÁÎÄÙ ÄÌÑ ÏÔËÒÙÔÉÑ É ÓÏÈÒÁÎÅÎÉÑ ÆÁÊÌÁ × ÏÔÌÉÞÉÉ ÏÔ ÄÒÕÇÉÈ ËÏÍÁÎÄ, ËÏÔÏÒÙÅ ×Ù -ÕÖÅ ×ÙÕÞÉÌÉ, ÔÒÅÂÕÀÔ Ä×ÕÈ ÓÉÍ×ÏÌÏ×. ïÎÉ ÏÂÁ ÎÁÞÉÎÁÀÔÓÑ Ó ÓÉÍ×ÏÌÁ Control-x. -âÏÌØÛÁÑ ÓÅÒÉÑ ËÏÍÁÎÄ ÎÁÞÉÎÁÅÔÓÑ Ó ÓÉÍ×ÏÌÁ Control-x; íÎÏÇÉÅ ÉÈ ÎÉÈ ÒÁÂÏÔÁÀÔ Ó -ÆÁÊÌÁÍÉ, ÂÕÆÅÒÁÍÉ É ÐÏÈÏÖÉÍÉ ×ÅÝÁÍÉ. üÔÏ ËÏÍÁÎÄÙ × Ä×Á, ÔÒÉ ÉÌÉ ÞÅÔÙÒÅ -ÓÉÍ×ÏÌÁ ÄÌÉÎÏÊ. - -óÌÅÄÕÀÝÅÅ, ÞÔÏ ×ÁÍ ÎÕÖÎÏ ÚÎÁÔØ Ï ËÏÍÁÎÄÅ ÏÔËÒÙÔÉÑ ÆÁÊÌÁ - ÜÔÏ ÔÏ, ÞÔÏ ×Ù -ÄÏÌÖÎÙ ××ÅÓÔÉ ÉÍÑ ÆÁÊÌÁ, ËÏÔÏÒÙÊ ÎÕÖÎÏ ÞÉÔÁÔØ. íÙ ÜÔÏ ÎÁÚÙ×ÁÅÍ ËÏÍÁÎÄÁ "ÞÉÔÁÀÝÁÑ -ÁÒÇÕÍÅÎÔ Ó ÔÅÒÍÉÎÁÌÁ" (× ÜÔÏÍ ÓÌÕÞÁÅ, ÁÒÇÕÍÅÎÔ ÜÔÏ ÉÍÑ ÆÁÊÌÁ). ðÏÓÌÅ ××ÏÄÁ -ËÏÍÁÎÄÙ - - C-x C-f ïÔËÒÙÔØ (ÎÁÊÔÉ) ÆÁÊÌ - -Emacs ÐÏÐÒÏÓÉÔ ×ÁÓ ××ÅÓÔÉ ÉÍÑ ÆÁÊÌÁ. éÍÑ ÆÁÊÌÁ ×Ù ÎÁÂÅÒÅÔÅ × ÎÉÖÎÅÊ ÓÔÒÏËÅ -ÜËÒÁÎÁ. îÉÖÎÑÑ ÓÔÒÏËÁ ÎÁÚÙ×ÁÅÔÓÑ ÍÉÎÉÂÕÆÅÒ, ÏÎ ÉÓÐÏÌØÚÕÅÔÓÑ ÄÌÑ ËÏÒÏÔËÏÇÏ -××ÏÄÁ. ÷Ù ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ ÏÂÙÞÎÙÅ ËÏÍÁÎÄÙ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ Emacs ÄÌÑ -ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ ÉÍÅÎÉ. - -ëÏÇÄÁ ×Ù ××ÏÄÉÔÅ ÉÍÑ ÆÁÊÌÁ (ÉÌÉ ÌÀÂÕÀ ÉÎÆÏÒÍÁÃÉÀ × ÍÉÎÉÂÕÆÅÒ), ×Ù ÍÏÖÅÔÅ -ÏÔÍÅÎÉÔØ ËÏÍÁÎÄÕ ÎÁÖÁ× C-g. - ->> îÁÖÍÉÔÅ C-x C-f, ÚÁÔÅÍ ÎÁÖÍÉÔÅ C-g. üÔÏ ÏÔÍÅÎÉÔ ÍÉÎÉÂÕÆÅÒ, É ËÏÍÁÎÄÕ - C-x C-f ËÏÔÏÒÁÑ ÉÓÐÏÌØÚÏ×ÁÌÁ ÍÉÎÉÂÕÆÅÒ. ÷ ÉÔÏÇÅ, ×Ù ÎÅ ÏÔËÒÙÌÉ ÎÉ ÏÄÎÏÇÏ - ÆÁÊÌÁ. - -ëÏÇÄÁ ×Ù ÚÁ×ÅÒÛÉÔÅ ××ÏÄ ÉÍÅÎÉ ÆÁÊÌÁ, ÎÁÖÍÉÔÅ . äÁÌÅÅ ÓÒÁÂÏÔÁÅÔ -ËÏÍÁÎÄÁ C-x C-f, É ÏÔËÒÏÅÔ ÆÁÊÌ ×ÙÂÒÁÎÎÙÊ ×ÁÍÉ. íÉÎÉÂÕÆÅÒ ÉÓÞÅÚÎÅÔ ËÏÇÄÁ -ËÏÍÁÎÄ C-x C-f ÚÁ×ÅÒÛÉÔÓÑ. - -é ÍÇÎÏ×ÅÎÉÅÍ ÐÏÚÖÅ ÓÏÄÅÒÖÉÍÏÅ ÆÁÊÌÁ ÐÏÑ×ÉÔÓÑ ÎÁ ÜËÒÁÎÅ, É ×Ù ÓÍÏÖÅÔÅ ÅÇÏ -ÒÅÄÁËÔÉÒÏ×ÁÔØ. ëÏÇÄÁ ×Ù ÚÁËÏÎÞÉÔÅ ÒÅÄÁËÔÉÒÏ×ÁÎÉÅ, ÞÔÏÂÙ ÓÏÈÒÁÎÉÔØ ÉÚÍÅÎÅÎÉÑ -ÎÁÂÅÒÉÔÅ ËÏÍÁÎÄÕ - - C-x C-s óÏÈÒÁÎÉÔØ ÆÁÊÌ - -üÔÏ ÓËÏÐÉÒÕÅÔ ÔÅËÓ ÉÚ Emacs × ÆÁÊÌ. ÷ ÐÅÒ×ÙÊ ÒÁÚ, ËÏÇÄÁ ×Ù ÜÔÏ ÓÄÅÌÁÅÔÅ, -Emacs ÐÅÒÅÉÍÅÎÕÅÔ ÏÒÉÇÉÎÁÌØÎÙÊ ÆÁÊÌ Ó ÎÏ×ÙÍ ÉÍÅÎÅÍ, ÞÔÏÂÙ ÏÎ ÎÅ ÐÏÔÅÒÑÌÓÑ. -îÏ×ÏÅ ÉÍÑ ÐÏÌÕÞÁÅÔÓÑ ÄÏÂÁ×ÌÅÎÉÅÍ ÓÉÍ×ÏÌÁ "~" Ë ÏÒÉÇÉÎÁÌØÎÏÍÕ ÉÍÅÎÉ ÆÁÊÌÁ. - -ëÏÇÄÁ ÓÏÈÒÁÎÅÎÉÅ ÚÁ×ÅÒÛÉÔÓÑ, Emacs ÎÁÐÅÞÁÔÁÅÔ ÉÍÑ ÚÁÐÉÓÁÎÎÏÇÏ ÆÁÊÌÁ. -÷Ù ÄÏÌÖÎÙ ÓÏÈÒÁÎÑÔØ ÉÚÍÅÎÅÎÉÑ ÄÏÓÔÁÔÏÞÎÏ ÞÁÓÔÏ, ÔÁË ÞÔÏÂÙ ÎÅ ÐÏÔÅÒÑÔØ -ÍÎÏÇÏ ÒÁÂÏÔÙ ÅÓÌÉ ×ÄÒÕÇ ÓÉÓÔÅÍÁ ÐÏÇÉÂÎÅÔ. - ->> îÁÂÅÒÉÔÅ C-x C-s, ÓÏÈÒÁÎÉÔÅ ×ÁÛÕ ËÏÐÉÀ ÕÞÅÂÎÉËÁ. - äÏÌÖÎÁ ÐÏÑ×ÉÔØÓÑ ÎÁÄÐÉÓØ "Wrote ...TUTORIAL.ru" × ÎÉÖÎÅÊ ÓÔÒÏËÅ ÜËÒÁÎÁ. - -úáíåþáîéå: îÁ ÎÅËÏÔÏÒÙÈ ÓÉÓÔÅÍÁÈ, ××ÏÄ C-x C-s ÚÁÍÏÒÏÚÉÔ ÜËÒÁÎ É ×Ù ÎÅ -Õ×ÉÄÉÔÅ ÐÏÓÌÅÄÕÀÝÅÇÏ ×Ù×ÏÄÁ Emacs`Á. üÔÏ ÏÚÎÁÞÁÅÔ ÞÔÏ ÏÐÅÒÁÃÉÏÎÎÁÑ ÓÉÓÔÅÍÁ -ÉÍÅÅÔ "ÏÓÏÂÅÎÎÏÓÔØ" ÉÍÅÎÕÅÍÕÀ "flow control" ÐÅÒÅÈ×ÁÔÙ×ÁÀÝÕÀ C-s É ÎÅ -ÐÒÏÐÕÓËÁÀÝÕÀ ÜÔÏÔ ÓÉÍ×ÏÌ Ë Emacs`Õ. äÌÑ ÒÁÚÍÏÒÏÚËÉ ÜËÒÁÎÁ, ÎÁÖÍÉÔÅ C-q. -óÍÏÔÒÉÔÅ ÒÁÚÄÅÌ "Spontaneous Entry to Incremental Search" ÒÕËÏ×ÏÄÓÔ×Á Emacs -ÞÔÏÂÙ ÕÚÎÁÔØ ËÁË ÂÏÒÏÔØÓÑ Ó ÜÔÏÊ "ÏÓÏÂÅÎÎÏÓÔØÀ". - -÷Ù ÍÏÖÅÔÅ ÏÔËÒÙÔØ ÓÕÝÅÓÔ×ÕÀÝÉÊ ÆÁÊÌ ÄÌÑ ÐÒÏÓÍÏÔÒÁ ÉÌÉ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ. ÷Ù -ÔÁË-ÖÅ ÍÏÖÅÔÅ ÎÁÊÔÉ ÆÁÊÌ, ËÏÔÏÒÙÊ ÅÝÅ ÎÅ ÓÕÝÅÓÔ×ÕÅÔ. äÒÕÇÉÍÉ ÓÌÏ×ÁÍÉ - -ÓÏÚÄÁÔØ ÆÁÊÌ Ó ÐÏÍÏÝØÀ Emacs: ÎÁÊÔÉ ÆÁÊÌ, ÓÏÚÄÁÔØ ÎÏ×ÙÊ, É ÎÁÞÁÔØ ××ÏÄÉÔØ -ÔÅËÓÔ. ëÏÇÄÁ ×Ù ÓËÁÖÉÔÅ "ÓÏÈÒÁÎÉ" ÆÁÊÌ, Emacs ÓÏÚÄÁÓÔ ÒÅÁÌØÎÙÊ ÆÁÊÌ Ó -ÎÁÂÒÁÎÎÙÍ ×ÁÍÉ ÔÅËÓÔÏÍ. äÁÌÅÅ, ËÁË ×Ù ÐÏÎÑÌÉ, ×Ù ÂÕÄÉÔÅ ÒÅÄÁËÔÉÒÏ×ÁÔØ ÕÖÅ -ÓÕÝÅÓÔ×ÕÀÝÉÊ ÆÁÊÌ. - - -* âõæåòá --------- - -åÓÌÉ ×Ù ÎÁÈÏÄÉÔÅ ×ÔÏÒÏÊ ÆÁÊÌ Ó ÉÓÐÏÌØÚÏ×ÁÎÉÅÍ C-x C-f, ÐÅÒ×ÙÊ ÏÓÔÁÅÔÓÑ ×ÎÕÔÒÉ -Emacs. ÷Ù ÍÏÖÅÔÅ ÐÅÒÅËÌÀÞÉÔØÓÑ ÎÁÚÁÄ ÎÁÊÄÑ ÅÇÏ ÓÎÏ×Á C-x C-f. üÔÏ ÓÐÏÓÏ -ÚÁÇÒÕÚÉÔØ ÎÅÓËÏÌØËÏ ÆÁÊÌÏ× × Emacs. - ->> óÏÚÄÁÊÔÅ ÆÁÊÌ Ó ÉÍÅÎÅÍ "foo" ÎÁÂÉÒÁÑ C-x C-f foo . - ÷ÓÔÁ×ØÔÅ ËÁËÏÊ-ÎÉÂÕÄØ ÔÅËÓÔ, ÏÔÒÅÄÁËÔÉÒÕÊÔÅ ÅÇÏ, É ÓÏÈÒÁÎÉÔÅ "foo" - ÎÁÂÒÁ× C-x C-s. - îÁËÏÎÅÃ, ÎÁÂÅÒÉÔÅ C-x C-f TUTORIAL.ru - ÞÔÏÂÙ ×ÅÒÎÕÔØÓÑ ÎÁÚÁÄ Ë ÕÞÅÂÎÉËÕ. - -Emacs ÓÏÈÒÁÎÑÅÔ ÔÅËÓÔ ËÁÖÄÏÇÏ ÆÁÊÌÁ ×ÎÕÔÒÉ × ÏÂßÅËÔÅ ÉÍÅÎÕÅÍÙÊ "ÂÕÆÅÒ" -("buffer"). ïÔËÒÙÔÉÅ ÆÁÊÌÁ ÓÏÚÄÁÅÔ ÎÏ×ÙÊ ÂÕÆÅÒ ×ÎÕÔÒÉ Emacs. ÞÔÏÂÙ Õ×ÉÄÅÔØ -ÓÐÉÓÏË ÂÕÆÅÒÏ× ÓÏÚÄÁÎÎÙÈ × ÔÅËÕÝÅÍ Emacs ÎÁÂÅÒÉÔÅ - - C-x C-b óÐÉÓÏË ÂÕÆÅÒÏ× - ->> ðÏÐÒÏÂÕÊÔÅ C-x C-b ÓÅÊÞÁÓ. - -íÙ ×ÉÄÉÍ ÞÔÏ ËÁÖÄÙÊ ÂÕÆÅÒ ÉÍÅÅÔ ÉÍÑ, É ÍÏÖÅÔ ÉÍÅÔØ ÉÍÑ ÆÁÊÌÁ, ÓÏÄÅÒÖÉÍÏÅ -ËÏÔÏÒÏÇÏ × ÎÅÍ ÈÒÁÎÉÔÓÑ. îÅËÏÔÏÒÙÅ ÂÕÆÅÒÁ ÎÅ ÓÏÏÔ×ÅÔÓÔ×ÕÀÔ ÆÁÊÌÁÍ. îÁÐÒÉÍÅÒ, -ÂÕÆÅÒ ÎÁÚ×ÁÎÎÙÊ "*Buffer List*" ÎÅ ÓÏÄÅÒÖÉÔ ÎÉËÁËÏÇÏ ÆÁÊÌÁ. ÷ ÜÔÏÍ ÂÕÆÅÒÅ -ÓÏÄÅÒÖÉÔÓÑ ÓÐÉÓÏË ÂÕÆÅÒÏ×, ËÏÔÏÒÙÊ ÂÙÌ ÓÏÚÄÁÎ ËÏÍÁÎÄÏÊ C-x C-b. ìàâïê ÔÅËÓÔ -ËÏÔÏÒÙÊ ×É ×ÉÄÉÔÅ × ÏËÎÅ Emacs ×ÓÅÇÄÁ Ñ×ÌÑÅÔÓÑ ÞÁÓÔØÀ ËÁËÏÇÏ-ÌÉÂÏ ÂÕÆÅÒÁ. - ->> îÁÂÅÒÉÔÅ C-x 1 ÞÔÏÂÙ ÉÚÂÁ×ÉÔØÓÑ ÏÔ ÓÐÉÓËÁ ÂÕÆÅÒÏ×. - -åÓÌÉ ×Ù ÉÚÍÅÎÑÅÔÅ ÔÅËÓÔ ÏÄÎÏÇÏ ÆÁÊÌÁ, ÐÏÔÏÍ ÏÔËÒÙ×ÁÅÔÅ ÄÒÕÇÏÊ, ÔÏ ÐÅÒ×ÙÊ -ÏÓÔÁÅÔÓÑ ÎÅ ÓÏÈÒÁÎÅÎÎÙÍ. éÚÍÅÎÅÎÉÑ ÏÓÔÁÎÕÔÓÑ ×ÎÕÔÒÉ Emacs, × ÆÁÊÌÏ×ÏÍ ÂÕÆÅÒÅ. -óÏÚÄÁÎÉÅ ÉÌÉ ÒÅÄÁËÔÉÒÏ×ÁÎÉÅ ÓÌÅÄÕÀÝÅÇÏ ÆÁÊÌÏ×ÏÇÏ ÂÕÆÅÒÁ ÎÅ ÓËÁÚÙ×ÁÅÔÓÑ ÎÁ -ÐÅÒ×ÏÍ ÂÕÆÅÒÅ. üÔÏ ÏÞÅÎØ ÕÄÏÂÎÏ, ÎÏ ÉÍÅÊÔÅ × ×ÉÄÕ ÞÔÏ ×ÁÍ ÎÕÖÎÏ ÉÍÅÔØ ÕÄÏÂÎÙÊ -ÓÐÏÓÏ ÓÏÈÒÁÎÉÔØ ÐÅÒ×ÙÊ ÆÁÊÌÏ×ÙÊ ÂÕÆÅÒ. âÙÌÏ ÂÙ ÎÅÐÒÉÑÔÎÏ ËÁÖÄÙÊ ÒÁÚ -×ÏÚ×ÒÁÝÁÔØÓÑ ÎÁÚÁÄ Ó ÐÏÍÏÝØÀ C-x C-f É ÐÏÔÏÍ ÉÓÐÏÌØÚÏ×ÁÔØ C-x C-s. -ðÏÜÔÏÍÕ ÓÕÝÅÓÔ×ÕÅÔ - - C-x s óÏÈÒÁÎÉÔØ ÎÅËÏÔÏÒÙÅ ÂÕÆÅÒÁ. (Save some buffers) - -C-x s ÓÐÒÁÛÉ×ÁÅÔ ×ÁÓ Ï ËÁÖÄÏÍ ÂÕÆÅÒÅ ËÏÔÏÒÙÊ ÓÏÄÅÒÖÉÔ ÎÅ ÓÏÈÒÁÎÅÎÎÙÅ -ÉÚÍÅÎÅÎÉÑ. äÌÑ ËÁÖÄÏÇÏ ÔÁËÏÇÏ ÂÕÆÅÒÁ Õ ×ÁÓ ÓÐÒÁÛÉ×ÁÀÔ ÓÏÈÒÁÎÑÔØ ÉÌÉ ÎÅ -ÓÏÈÒÁÎÑÔØ ÉÚÍÅÎÅÎÉÑ. - ->> ÷ÓÔÁ×ØÔÅ ÓÔÒÏËÕ ÔÅËÓÔÁ, ÐÏÔÏÍ ÎÁÂÅÒÉÔÅ C-x s. - õ ×ÁÓ ÄÏÌÖÎÙ ÓÐÒÏÓÉÔØ ÓÏÈÒÁÎÑÔØ ÌÉ ÂÕÆÅÒ Ó ÉÍÅÎÅÍ TUTORIAL.ru. - ïÔ×ÅÔØÔÅ ÎÁ ×ÏÐÒÏÓ ÄÁ ÎÁÂÒÁ× "y". - -* éóðïìøúï÷áîéå íåîà --------------------- - -åÓÌÉ Õ ×ÁÓ X-ÔÅÒÍÉÎÁÌ, ×Ù ÚÁÍÅÔÉÔÅ ÐÏÌÏÓÙ ÍÅÎÀ ××ÅÒÈÕ ÜËÒÁÎÁ Emacs. ÷Ù -ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ ÜÔÏ ÍÅÎÀ ÄÌÑ ÄÏÓÔÕÐÁ ËÏ ×ÓÅÍ ÎÁÉÂÏÌÅÅ ÏÂÝÉÍ ËÏÍÁÎÄÁÍ -Emacs, ÔÁËÉÅ ËÁË "ÏÔËÒÙÔØ ÆÁÊÌ" ("find file"). ÷Ù ÓÒÁÚÕ ÎÁÊÄÅÔÅ ÞÔÏ ÜÔÏ -ÐÒÏÓÔÏ, ÐÏÔÏÍÕ ÞÔÏ ×ÁÍ ÎÅ ÎÕÖÎÏ ÚÁÐÏÍÉÎÁÔØ ÓÏÞÅÔÁÎÉÑ ËÌÁ×ÉÛ ÎÅÏÂÈÏÄÉÍÙÈ ÄÌÑ -ÄÏÓÔÕÐÁ Ë ËÁÖÄÏÊ ËÏÍÁÎÄÙ. ëÏÇÄÁ ×Ù ÐÒÉ×ÙËÎÉÔÅ Ë Emacs, ×ÁÍ ÂÕÄÉÔÅ ÌÅÇËÏ -ÉÓÐÏÌØÚÏ×ÁÔØ ËÌÁ×ÉÁÔÕÒÎÙÅ ËÏÍÁÎÄÙ, ÐÏÔÏÍÕ ÞÔÏ ËÁÖÄÏÍ ÐÕÎËÔÅ ÍÅÎÀ, Ë ËÏÔÏÒÏÍÕ -ÐÒÉ×ÑÚÁÎÁ ÓÏÞÅÔÁÎÉÅ ËÌÁ×ÉÛ, ÎÁÐÉÓÁÎÏ ÜÔÏ ÓÏÞÅÔÁÎÉÅ. - -úÁÍÅÔÉÍ ÞÔÏ ÍÎÏÇÏ ÐÕÎËÔÏ× ÍÅÎÀ ÎÅ ÓÏÄÅÒÖÁÔ ËÌÁ×ÉÁÔÕÒÎÙÅ ÜË×É×ÁÌÅÎÔÙ. -îÁÐÒÉÍÅÒ, ÓÐÉÓÏË ÍÅÎÀ ÓÏ ×ÓÅÍÉ ÄÏÓÔÕÐÎÙÍÉ ÂÕÆÅÒÁÍÉ. ÷Ù ÍÏÖÅÔÅ ÐÅÒÅËÌÀÞÉÔØ × -ÌÀÂÏÊ ÂÕÆÅÒ ðÒÏÓÔÏ ÎÁÊÄÑ ÅÇÏ ÉÍÑ × ÍÅÎÀ ÂÕÆÅÒÏ× (Buffers menu) É ×ÙÂÒÁ× ÅÇÏ. - - -* éóðïìøúï÷áîéå íùûé --------------------- - -÷ÙÐÏÌÎÑÅÍÙÊ × X, Emacs ÐÏÌÎÏÓÔØÀ ÉÎÔÅÇÒÉÒÏ×ÁÎ Ó ÍÙÛØÀ. ÷Ù ÍÏÖÅÔÅ -ÐÏÚÉÃÉÏÎÉÒÏ×ÁÔØ ËÕÒÓÏÒ ÎÁÖÁÔÉÅÍ ÌÅ×ÏÊ ËÎÏÐËÉ × ÖÅÌÁÅÍÏÍ ÍÅÓÔÅ, ×Ù ÍÏÖÅÔÅ -ÏÔÍÅÞÁÔØ ÔÅËÓÔ ÐÏÔÑÎÕ× ÍÙÛËÕ Ó ÎÁÖÁÔÏÊ ÌÅ×ÏÊ ËÎÏÐËÏÊ ÞÅÒÅÚ ÔÕ ÞÁÓÔØ, ËÏÔÏÒÕÀ -ÈÏÔÉÔÅ ÏÔÍÅÔÉÔØ. (éÌÉ ËÌÉËÎÕÔØ ÌÅ×ÏÊ ËÎÏÐËÏÊ ÍÙÛËÉ × ÏÄÎÏÍ ËÏÎÃÅ ÔÅËÓÔÁ, -ÚÁÔÅÍ ÐÅÒÅÍÅÓÔÉÔØÓÑ × ÄÒÕÇÏÊ, É ËÌÉËÎÕÔØ ÅÝÅ ÒÁÚ, ÕÄÅÒÖÉ×ÁÑ Shift ÞÔÏÂÙ -ÏÔÍÅÔÉÔØ ÔÅËÓÔ.) - -ÞÔÏÂÙ ÕÂÉÔØ ÎÅËÏÔÏÒÙÊ ×ÙÄÅÌÅÎÎÙÊ ÔÅËÓÔ, ×Ù ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-w ÉÌÉ ×ÙÂÒÁÔØ -ÐÕÎËÔ ÍÅÎÀ "÷ÙÒÅÚÁÔØ" ("Cut") ÉÚ ÍÅÎÀ "òÅÄÁËÔÉÒÏ×ÁÔØ" ("Edit"). úÁÍÅÔØÔÅ, ÞÔÏ -ÜÔÏ *ÎÅ* ÏÄÎÏ É ÔÏ ÖÅ: C-w ÓÏÈÒÁÎÑÅÔ ÔÅËÓÔ ÔÏÌØËÏ ×ÎÕÔÒÉ Emacs (ÁÎÁÌÏÇÉÞÎÏ C-k -ÏÐÉÓÁÎÎÏÇÏ ÒÁÎÅÅ), "÷ÙÒÅÚÁÔØ" ("Cut") ÄÅÌÁÅÔ ÜÔÏ ÖÅ, É ÐÏÍÅÝÁÅÔ ÔÅËÓÔ × ÂÕÆÅÒ -ÏÂÍÅÎÁ X (X clipboard), ÇÄÅ ÏÎ ÍÏÖÅÔ ÂÙÔØ ÄÏÓÔÕÐÅÎ ÄÒÕÇÉÍ ÐÒÏÇÒÁÍÍÁÍ. - -ÞÔÏÂÙ ÐÏÌÕÞÉÔØ ÔÅËÓÔ ÉÚ ÂÕÆÅÒÁ ÏÂÍÅÎÁ X, ÉÓÐÏÌØÚÕÊÔÅ ËÏÍÁÎÄÕ "÷ÓÔÁ×ÉÔØ" -("Insert") ÉÚ ÍÅÎÀ "òÅÄÁËÔÉÒÏ×ÁÔØ" ("Edit"). - -óÒÅÄÎÑÑ ËÎÏÐËÁ ÍÙÛÉ ÏÂÙÞÎÏ ÉÓÐÏÌØÚÕÅÔÓÑ ÄÌÑ ×ÙÂÏÒÁ ÐÕÎËÔÏ× (items), ×ÉÄÉÍÙÈ ÎÁ -ÜËÒÁÎÅ. îÁÐÒÉÍÅÒ, ÅÓÌÉ ×Ù ×ÏÛÌÉ × Info (on-line ÄÏËÕÍÅÎÔÁÃÉÑ Emacs) ÉÓÐÏÌØÚÕÑ -C-h i ÉÌÉ ÍÅÎÀ ðÏÍÏÝØ (Help), ×Ù ÍÏÖÅÔÅ ÓÌÅÄÏ×ÁÔØ ÐÏÄÓ×ÅÞÅÎÎÙÍ ÓÓÙÌËÁÍ -ÐÒÏÓÔÙÍ ÎÁÖÁÔÉÅÍ ÓÒÅÄÎÅÊ ËÎÏÐËÉ ÎÁ ÎÉÈ. áÎÁÌÏÇÉÞÎÏ, ÅÓÌÉ ×Ù ××ÏÄÉÔÅ ÉÍÑ ÆÁÊÌÁ -(ÎÁÐÒÉÍÅÒ × ÐÒÉÇÌÁÛÅÎÉÉ "ÏÔËÒÙÔØ ÆÁÊÌ") É ×Ù ÎÁÖÉÍÁÅÔÅ TAB ÞÔÏÂÙ Õ×ÉÄÅÔØ -×ÏÚÍÏÖÎÙÅ ×ÁÒÉÁÎÔÙ (completions), ×Ù ÍÏÖÅÔÅ ËÌÉËÎÕÔØ ÓÒÅÄÎÀÀ ËÎÏÐËÕ ÍÙÛÉ ÎÁ -ÏÄÎÏÍ ÉÚ ×ÁÒÉÁÎÔÏ×, ÞÔÏÂÙ ×ÙÂÒÁÔØ ÅÇÏ. - -ðÒÁ×ÁÑ ËÎÏÐËÁ ÍÙÛÉ ×ÙÚÙ×ÁÅÔ ×ÓÐÌÙ×ÁÀÝÅÅ ÍÅÎÀ (popup menu). óÏÄÅÒÖÉÍÏÅ ÜÔÏÇÏ -ÍÅÎÀ ÉÚÍÅÎÑÅÔÓÑ × ÚÁ×ÉÓÉÍÏÓÔÉ ÏÔÏ ÔÏÇÏ ÇÄÅ ×Ù ÎÁÈÏÄÉÔÅÓØ, É ÏÂÙÞÎÏ ÓÏÄÅÒÖÉÔ -ÎÅÓËÏÌØËÏ ÞÁÓÔÏ ÉÓÐÏÌØÚÕÅÍÙÈ ËÏÍÁÎÄ ÄÌÑ ÂÏÌÅÅ ÐÒÏÓÔÏÇÏ ÄÏÓÔÕÐÁ Ë ÎÉÍ. - ->> îÁÖÍÉÔÅ ÐÒÁ×ÕÀ ËÎÏÐËÕ ÍÙÛÉ ÓÅÊÞÁÓ. - -÷ÁÍ ÎÕÖÎÏ ÕÄÅÒÖÉ×ÁÔØ ËÎÏÐËÕ ÎÁÖÁÔÏÊ, ÞÔÏÂÙ ÓÏÈÒÁÎÉÔØ ÍÅÎÀ ÏÔËÒÙÔÙÍ. -(// You will have to hold the button down in order to keep the menu up.) - - -* òáóûéòåîîùê îáâïò ëïíáîä --------------------------- - -õ Emacs ÏÞÅÎØ ÍÎÏÇÏ ËÏÍÁÎÄ, ÏÎÉ ÍÏÇÕÔ ÂÙÔØ ÎÁÚÎÁÞÅÎÙ ÎÁ ×ÓÅ control- É meta- -ÓÉÍ×ÏÌÙ. Emacs ÏÂÈÏÄÉÔ ÜÔÏ, ÉÓÐÏÌØÚÕÑ X-ËÏÍÁÎÄÕ (eXtend). åÓÔØ Ä×Å -×ÏÚÍÏÖÎÏÓÔÉ: - - C-x óÉÍ×ÏÌ ÒÁÓÛÉÒÅÎÉÑ (Character eXtend). - úÁ ÎÉÍ ÓÌÅÄÕÅÍ ÏÄÉÎ ÓÉÍ×ÏÌ. - M-x éÍÅÎÎÏ×ÁÎÙÅ ÒÁÓÛÉÒÅÎÎÙÅ ËÏÍÁÎÄÙ (Named command eXtend). - úÁ ÎÉÍ ÓÌÅÄÕÅÔ ÉÍÑ ËÏÍÁÎÄÙ. - -üÔÏ ËÏÍÁÎÄÙ ËÏÔÏÒÙÅ ÏÂÙÞÎÏ ÉÓÐÏÌØÚÕÀÔÓÑ, ÎÏ ×Ù ÕÖÅ ×ÙÕÞÉÌÉ ÎÅËÏÔÏÒÙÅ ÉÚ ÎÉÈ. -÷Ù ÕÖÅ ×ÉÄÅÌÉ: ËÏÍÁÎÄÙ ÒÁÂÏÔÙ Ó ÆÁÊÌÁÍÉ C-x C-f - ÏÔËÒÙÔØ, É C-x C-s -ÓÏÈÒÁÎÉÔØ. äÒÕÇÏÊ ÐÒÉÍÅÒ - ÚÁ×ÅÒÛÅÎÉÑ ÒÁÂÏÔÙ Ó Emacs -- ÜÔÏ ËÏÍÁÎÄÁ C-x C-c. -(ÎÅ ×ÏÌÎÕÊÔÅÓØ Ï ÔÏÍ, ÞÔÏ ×Ù ÐÏÔÅÒÑÅÔÅ ÓÄÅÌÁÎÎÙÅ ÉÚÍÅÎÅÎÉÑ, C-x C-c -ÐÒÅÄÌÁÇÁÅÔ ÓÏÈÒÁÎÉÔØ ÉÚÍÅÎÅÎÉÑ ÐÅÒÅÄ ÔÅÍ ËÁË ÕÄÁÌÉÔ ÂÕÆÅÒ Emacs.) - -C-z ÜÔÏ ËÏÍÁÎÄÁ *×ÒÅÍÅÎÎÏÇÏ* ×ÙÈÏÄÁ ÉÚ Emacs -- ×Ù ÍÏÖÅÔÅ ×ÅÒÎÕÔØÓÑ × ÔÕÖÅ -ÓÅÓÓÉÀ Emacs ÐÏÓÌÅ. - -îÁ ÓÉÓÔÅÍÁÈ, ËÏÔÏÒÙÅ ÄÏÐÕÓËÁÀÔ ÜÔÏÇÏ, C-z "ÐÒÉÏÓÔÁÎÁ×ÌÉ×ÁÀÔ" ("suspends") -Emacs; ÷ÏÚ×ÒÁÝÁÀÔ × ÏÂÏÌÏÞËÕ (shell), ÎÏ ÎÅ ÚÁËÒÙ×ÁÀÔ Emacs. ÷ ÂÏÌØÛÉÎÓÔ×Å -ÏÂÏÌÏÞÅË ×Ù ÍÏÖÅÔÅ ÐÒÏÄÏÌÖÉÔØ ÒÁÂÏÔÕ × Emacs ÉÓÐÏÌØÚÕÑ ËÏÍÁÎÄÕ `fg' ÉÌÉ -`%emacs'. - -÷ ÓÉÓÔÅÍÁÈ ÎÅ ÐÏÄÄÅÒÖÉ×ÁÀÝÉÈ ÐÒÉÏÓÔÁÎÏ×, C-z ÓÏÚÄÁÅÔ ÎÏ×ÕÀ ÏÂÏÌÏÞËÕ (subshell), -ÚÁÐÕÝÅÎÎÕÀ ÉÚ-ÐÏÄ Emacs ÞÔÏÂÙ ÄÁÔØ ×ÁÍ ×ÏÚÍÏÖÎÏÓÔØ ×ÙÐÏÌÎÉÔØ ÄÒÕÇÕÀ ÐÒÏÇÒÁÍÍÕ, -É ÐÏÔÏÍ ×ÅÒÎÕÔØÓÑ × Emacs; üÔÏ ÎÅ ÎÁÓÔÏÑÝÉÊ ×ÙÈÏÄ ÉÚ Emacs. ÷ ÜÔÏÍ ÓÌÕÞÁÅ, -ËÏÍÁÎÄÁ `exit' ×ÅÒÎÅÔ ×ÁÓ × Emacs ÉÚ ÏÂÏÌÏÞËÉ. - -éÓÐÏÌØÚÕÊÔÅ C-x C-c ÅÓÌÉ ×Ù ÈÏÔÉÔÅ ×ÙÊÔÉ (log out) ÉÚ ÓÉÓÔÅÍÙ. üÔÏ ÔÁËÖÅ -ÉÓÐÏÌØÚÕÅÔÓÑ ÞÔÏÂÙ ×ÙÊÔÉ ÉÚ Emacs ×ÙÚ×ÁÎÎÏÇÏ ÉÚ ÐÏÞÔÏ×ÏÊ ÐÒÏÇÒÁÍÍÙ, ÉÌÉ ÄÒÕÇÏÊ -ÕÔÉÌÉÔÙ, ËÏÔÏÒÁÑ ÍÏÖÅÔ ÎÅ ÚÎÁÅÔ ËÁË ÓÐÒÁ×ÉÔØÓÑ Ó ÐÒÉÏÓÔÁÎÏ×ÌÅÎÎÙÍ Emacs. -ïÂÙÞÎÏ, ÔÁËÉ ÅÓÌÉ ×Ù ÎÅ ×ÙÈÏÄÉÔÅ ÉÚ ÓÉÓÔÅÍÙ, ÌÕÞÛÅ ÐÒÉÏÓÔÁÎÏ×ÉÔØ Emacs -ÉÓÐÏÌØÚÕÑ C-z ×ÍÅÓÔÏ ×ÙÈÏÄÁ ÉÈ ÎÅÇÏ. - -ïÞÅÎØ ÍÎÏÇÏ C-x ËÏÍÁÎÄ. üÔÉ ×Ù ÕÖÅ ×ÙÕÞÉÌÉ: - - C-x C-f ïÔËÒÙÔØ ÆÁÊÌ. - C-x C-s óÏÈÒÁÎÉÔØ ÆÁÊÌ. - C-x C-b óÐÉÓÏË ÂÕÆÅÒÏ×. - C-x C-c ÷ÙÈÏÄ ÉÚ Emacs. - C-x u ïÔÍÅÎÁ. - -éÍÅÎÏ×ÁÎÎÙÅ ÒÁÓÛÉÒÅÎÎÙÅ ËÏÍÁÎÄÙ ÉÓÐÏÌØÚÕÀÔÓÑ ÇÏÒÁÚÄÏ ÒÅÖÅ, ÉÌÉ ÉÓÐÏÌØÚÕÀÔÓÑ -ÔÏÌØËÏ × ÏÐÒÅÄÅÌÅÎÎÙÈ ÒÅÖÉÍÁÈ. ÷ ËÁÞÅÓÔ×Å ÐÒÉÍÅÒÁ ËÏÍÁÎÄÁ ÚÁÍÅÎÁ ÓÔÒÏËÉ, -ËÏÔÏÒÁÑ ÚÁÍÅÎÑÅÔ ÏÄÎÕ ÓÔÒÏËÕ ÎÁ ÄÒÕÇÕÀ ×Ï ×ÓÅÍ ÔÅËÓÔÅ. ëÏÇÄÁ ×Ù ÎÁÂÅÒÅÔÅ M-x, -Emacs ÐÒÅÄÌÏÖÉÔ ×ÁÍ ××ÅÓÔÉ ÉÍÑ ËÏÍÁÎÄÙ × ÎÉÖÎÅÊ ÓÔÒÏËÅ ÜËÒÁÎÁ; × ÎÁÛÅÍ ÓÌÕÞÁÅ, -"replace-string". ôÏÌØËÏ ÎÁÂÅÒÉÔÅ "repl s" É Emacs ÄÏÐÏÌÎÉÔ -ÉÍÑ. úÁ×ÅÒÛÉÔÅ ÉÍÑ ××ÏÄÏÍ . - -ëÏÍÁÎÄÁ ÚÁÍÅÎÙ ÓÔÒÏËÉ (replace-string) ÔÒÅÂÕÅÔ Ä×Á ÁÒÇÕÍÅÎÔÁ -- ÓÔÒÏËÕ -ËÏÔÏÒÁÑ ÂÕÄÅÔ ÚÁÍÅÎÅÎÁ, É ÓÔÒÏËÁ ÎÁ ËÏÔÏÒÕÀ ÎÕÖÎÏ ÚÁÍÅÎÉÔØ. ÷Ù ÄÏÌÖÎÙ -ÚÁ×ÅÒÛÁÔØ ËÁÖÄÙÊ ÁÒÇÕÍÅÎÔ ××ÏÄÏÍ . - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ Ä×Å ÐÕÓÔÙÅ ÓÔÒÏËÉ ÎÉÖÅ ÜÔÏÊ. - îÁÂÅÒÉÔÅ M-x repl schangedaltered. - - úÁÍÅÔØÔÅ ËÁË ÜÔÁ ÓÔÒÏËÁ ÉÚÍÅÎÉÔÓÑ: ×Ù ÚÁÍÅÎÉÔÅ ÓÌÏ×Ï c-h-a-n-g-e-d - ÓÌÏ×ÏÍ "altered" ×ÅÚÄÅ, ÇÄÅ ÏÎÏ ×ÓÔÒÅÔÉÔÓÑ, ÎÉÖÅ ÐÏÚÉÃÉÉ ËÕÒÓÏÒÁ. - - -* á÷ôïóïèòáîåîéå ----------------- - -ëÏÇÄÁ ×Ù ÍÏÄÉÆÉÃÉÒÕÅÔÅ ÆÁÊÌ, ÎÏ ÎÅ ÓÏÈÒÁÎÑÅÔÅ ÅÇÏ, ×Ù ÍÏÖÅÔÅ ÐÏÔÅÒÑÔØ -ÉÎÆÏÒÍÁÃÉÀ × ÓÌÕÞÁÅ ËÒÁÈÁ ÓÉÓÔÅÍÙ. ÞÔÏÂÙ ÚÁÝÉÔÉÔØ ×ÁÓ ÏÔ ÜÔÏÇÏ, Emacs -ÐÅÒÉÏÄÉÞÅÓËÉ ÚÁÐÉÓÙ×ÁÅÔ ËÁÖÄÙÊ ÆÁÊÌ, ËÏÔÏÒÙÊ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ. á×ÔÏÓÏÈÒÁÎÅÎÉÅ -ÐÒÏÉÓÈÏÄÉÔ × ÆÁÊÌ, ÉÍÑ ËÏÔÏÒÏÇÏ ÔÁËÏÅ ÖÅ, ÎÏ ÎÁÞÉÎÁÅÔÓÑ É ÚÁËÁÎÞÉ×ÁÅÔÓÑ -ÓÉÍ×ÏÌÏÍ "#"; ÎÁÐÒÉÍÅÒ, ÅÓÌÉ ×ÁÛ ÆÁÊÌ ÎÁÚÙ×ÁÅÔÓÑ "hello.c", ÔÏ -Á×ÔÏÓÏÈÒÁÎÅÎÎÙÊ ÆÁÊÌ ÂÕÄÅÔ ÎÁÚÙ×ÁÔØÓÑ "#hello.c#". ëÏÇÄÁ ×Ù ÓÏÈÒÁÎÉÔÅ ÆÁÊÌ -ÏÂÙÞÎÙÍ ÓÐÏÓÏÂÏÍ. Emacs ÕÄÁÌÉÔ Á×ÔÏÓÏÈÒÁÎÅÎÎÙÊ ÆÁÊÌ. - -åÓÌÉ ÓÉÓÔÅÍÁ ÐÏÄ×ÉÓÁÅÔ, ×Ù ÍÏÖÅÔÅ ×ÏÓÓÔÁÎÏ×ÉÔØ ×ÁÛÉ ÉÚÍÅÎÅÎÉÑ ËÏÔÏÒÙÊ ÂÙÌÉ -ÓÏÈÒÁÎÅÎÙ Á×ÔÏÍÁÔÉÞÅÓËÉ, ÐÕÔÅÍ ÏÔËÒÙÔÉÑ ÎÏÒÍÁÌØÎÏÇÏ ÆÁÊÌÁ (ÆÁÊÌÁ ËÏÔÏÒÙÊ ×Ù -ÒÅÄÁËÔÉÒÏ×ÁÌÉ, ÎÅ Á×ÔÏÓÏÈÒÁÎÅÎÎÏÇÏ) É ÚÁÔÅÍ ÎÁÂÒÁÔØ M-x recover file. -ëÏÇÄÁ Õ ×ÁÓ ÓÐÒÏÓÑÔ ÐÏÄÔ×ÅÒÖÄÅÎÉÅ, ÎÁÂÅÒÉÔÅ yes ÞÔÏÂÙ ×ÏÓÓÔÁÎÏ×ÉÔØ -Á×ÔÏÓÏÈÒÁÎÅÎÎÙÅ ÄÁÎÎÙÅ. - - -* ïâìáóôø üèï (ECHO AREA) -------------------------- - -åÓÌÉ Emacs ×ÉÄÉÔ ÞÔÏ ×Ù ÍÅÄÌÅÎÎÏ ÎÁÂÉÒÁÅÔÅ ËÏÍÁÎÄÙ, ÏÎ ÐÏËÁÚÙ×ÁÅÔ ÉÈ ×ÁÍ -×ÎÉÚÕ ÜËÒÁÎÁ, × ÏÂÌÁÓÔÉ ÎÁÚÙ×ÁÅÍÏÊ "ÏÂÌÁÓÔØ ÜÈÏ". ïÂÌÁÓÔØ ÜÈÏ ÜÔÏ ÎÉÖÎÑÑ -ÓÔÒÏËÁ ÜËÒÁÎÁ. - - -* óôòïëá óïóôïñîéñ ------------------- - -óÔÒÏËÁ ÓÒÁÚÕ ÎÁÄ ÏÂÌÁÓÔØÀ ÜÈÏ ÎÁÚÙ×ÁÅÔÓÑ "ÓÔÒÏËÁ ÓÏÓÔÏÑÎÉÑ". -÷ÙÇÌÑÄÉÔ ÜÔÁ ÓÔÒÏËÁ ÐÒÉÍÅÒÎÏ ÔÁË: - ---**-XEmacs: TUTORIAL.ru (Fundamental)--L670--66%---------------- - -üÔÁ ÓÔÒÏËÁ ÓÏÏÂÝÁÅÔ ÐÏÌÅÚÎÕÀ ÉÎÆÏÒÍÁÃÉÀ Ï ÓÏÓÔÏÑÎÉÉ Emacs É ÔÅËÓÔÁ, ËÏÔÏÒÙÊ -×Ù ÒÅÄÁËÔÉÒÕÅÔÅ. - -÷Ù ÕÖÅ ÚÎÁÅÔÅ ÞÔÏ ÏÚÎÁÞÁÅÔ ÉÍÑ ÆÁÊÌÁ - ÜÔÏ ÆÁÊÌ, ËÏÔÏÒÙÊ ×Ù ÏÔËÒÙÌÉ. -NN%-- -ÐÏËÁÚÙ×ÁÅÔ ÔÅËÕÝÕÀ ÐÏÚÉÃÉÀ ËÕÒÓÏÒÁ × ÔÅËÓÔÅ; ÜÔÏ ÏÚÎÁÞÁÅÔ ÞÔÏ NN ÐÒÏÃÅÎÔÏ× -ÔÅËÓÔÁ ×ÙÛÅ ÞÅÍ ÎÁÞÁÌÏ ÜËÒÁÎÁ. åÓÌÉ ÐÅÒ×ÁÑ ÓÔÒÏËÁ ÎÁÈÏÄÉÔÓÑ × ÐÅÒ×ÏÊ ÓÔÒÏËÅ -ÜËÒÁÎÁ, ×Ù ÔÁÍ Õ×ÉÄÉÔÅ --Top-- ×ÍÅÓÔÏ --00%--. åÓÌÉ ÐÏÓÌÅÄÎÑÑ ÓÔÒÏËÁ -ÏÔÏÂÒÁÖÁÅÔÓÑ ÎÁ ÜËÒÁÎÅ, ÔÁÍ ÂÕÄÅÔ --Bot--. åÓÌÉ ÔÅËÓÔ ÎÁÓÔÏÌØËÏ ÍÁÌ, ÞÔÏ ×ÅÓØ -×ÍÅÝÁÅÔÓÑ × ÜËÒÁÎ, ÓÔÒÏËÁ ÓÏÓÔÏÑÎÉÑ ÓÏÏÂÝÉÔ --All--. - -ú×ÅÚÄÏÞËÉ × ÎÁÞÁÌÅ ÓÔÒÏËÉ ÏÚÎÁÞÁÀÔ ÞÔÏ ×Ù ÉÚÍÅÎÑÌÉ ÔÅËÓÔ. ëÁË ÔÏÌØËÏ ×Ù -ÏÔËÒÙÌÉ ÉÌÉ ÓÏÈÒÁÎÉÌÉ ÆÁÊÌ, ÜÔÁ ÞÁÓÔØ ÓÔÒÏËÉ ÂÕÄÅÔ ÓÏÄÅÒÖÁÔØ ÎÅ Ú×ÅÚÄÏÞËÉ, Á -ÔÉÒÅ. - -þÁÓÔØ ÓÔÒÏËÉ ÓÔÁÔÕÓÁ ×ÎÕÔÒÉ ÓËÏÂÏÞÅË ÓÏÏÂÝÁÅÔ ×ÁÍ ÒÅÖÉÍ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ, -ËÏÔÏÒÙÍ ×Ù ÐÏÌØÚÕÅÔÅÓØ. óÔÁÎÄÁÒÔÎÙÊ ÒÅÖÉÍ - Fundamental, ÅÇÏ ×Ù ÉÓÐÏÌØÚÕÅÔÅ -É ÓÅÊÞÁÓ. üÔÏ ÐÒÉÍÅÒ "ÏÓÎÏ×ÎÏÇÏ ÒÅÖÉÍÁ" ("major mode"). - -Emacs ÉÍÅÅÔ ÍÎÏÇÏ ÒÁÚÌÉÞÎÙÈ ÏÓÎÏ×ÎÙÈ ÒÅÖÉÍÏ×. îÅËÏÔÏÒÙÅ ÉÚ ÒÅÖÉÍÏ× ÏÚÎÁÞÁÀÔ, -ÞÔÏ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ ÔÅËÓÔ ÎÁ ÒÁÚÌÉÞÎÏÍ ÑÚÙËÅ É/ÉÌÉ ÒÁÚÌÉÞÎÙÅ ×ÉÄÙ ÔÅËÓÔÁ, -ÔÁËÉÅ ËÁË Lisp-ÒÅÖÉÍ, Text-ÒÅÖÉÍ É ÐÒ. ÷ ÌÀÂÏÅ ×ÒÅÍÑ ÔÏÌØËÏ ÏÄÉÎ ÏÓÎÏ×ÎÏÊ -ÒÅÖÉÍ ÁËÔÉ×ÉÒÏ×ÁÎ, É ÅÇÏ ÎÁÚ×ÁÎÉÅ ×Ù ÍÏÖÅÔÅ ÎÁÊÔÉ × ÓËÏÂÏÞËÁÈ, ÇÄÅ ÓÅÊÞÁÓ -ÎÁÈÏÄÉÔÓÑ ÓÌÏ×Ï "Fundamental" (ÂÁÚÏ×ÙÊ). - -ëÁÖÄÙÊ ÏÓÎÏ×ÎÏÊ ÒÅÖÉÍ ÉÍÅÅÔ ÎÅÓËÏÌØËÏ ÏÔÌÉÞÉÔÅÌØÎÙÈ ËÏÍÁÎÄ. îÁÐÒÉÍÅÒ, ËÏÍÁÎÄÙ -ÓÏÚÄÁÎÉÑ ËÏÍÍÅÎÔÁÒÉÑ × ÐÒÏÇÒÁÍÍÅ, É ÐÏÓËÏÌØËÕ × ËÁÖÄÏÍ ÑÚÙËÅ ÐÒÏÇÒÁÍÍÉÒÏ×ÁÎÉÑ -ËÏÍÍÅÎÔÁÒÉÉ ÚÁÐÉÓÙ×ÁÀÔÓÑ ÐÏ-Ó×ÏÅÍÕ, ËÁÖÄÙÊ ÏÓÎÏ×ÎÏÊ ÒÅÖÉÍ ×ÓÔÁ×ÌÑÅÔ ÉÈ -ÐÏ-ÒÁÚÎÏÍÕ. ëÁÖÄÙÊ ÏÓÎÏ×ÎÏÊ ÒÅÖÉÍ ÉÍÅÅÔ ÉÍÅÎÏ×ÁÎÎÕÀ ËÏÍÁÎÄÕ, ËÏÔÏÒÁÑ ×ËÌÀÞÁÅÔ -ÅÇÏ. îÁÐÒÉÍÅÒ, M-x fundamental-mode - ËÏÍÁÎÄÁ, ËÏÔÏÒÁÑ ÐÅÒÅËÌÀÞÁÅÔ × ÂÁÚÏ×ÙÊ -(Fundamental) ÒÅÖÉÍ. - -åÓÌÉ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ ÁÎÇÌÉÊÓËÉÊ ÔÅËÓÔ, ÎÁÐÒÉÍÅÒ ËÁË ÜÔÏÔ (//ËÏÎÅÞÎÏ ÎÅ ÉÍÅÎÎÏ -ÜÔÏÔ, Á TUTORIAL) ÆÁÊÌ, ×Ù ×ÅÒÏÑÔÎÏ ÄÏÌÖÎÙ ÐÅÒÅËÌÀÞÉÔØÓÑ × Text-ÒÅÖÉÍ. - ->> îÁÂÅÒÉÔÅ M-x text-mode. - -îÅ ×ÏÌÎÕÊÔÅÓØ, ÎÉ ÏÄÎÁ ÉÚ ×ÙÕÞÅÎÎÙÈ ×ÁÍÉ ËÏÍÁÎÄ Emacs ÎÅ ÉÚÍÅÎÉÌÁÓØ. îÏ ×Ù -ÍÏÖÉÔÅ ÚÁÍÅÔÉÔØ, ÞÔÏ M-f É M-b ÔÅÐÅÒØ ÒÁÚÌÉÞÁÔØ ÁÐÏÓÔÒÏÆÙ ËÁË ÞÁÓÔÉ ÓÌÏ×Á. -òÁÎÅÅ, × ÂÁÚÏ×ÏÍ ÒÅÖÉÍÅ (Fundamental mode), M-f É M-b ÐÏÎÉÍÁÌÉ ÁÐÏÓÔÒÏÆÙ -ËÁË ÒÁÚÄÅÌÉÔÅÌÉ ÓÌÏ×. - -ïÓÎÏ×ÎÏÊ ÒÅÖÉÍ ÏÂÙÞÎÏ ÄÅÌÁÅÔ ÎÅÂÏÌØÛÉÅ ÉÚÍÅÎÅÎÉÑ, ÔÁËÉÅ ËÁË: ÂÏÌØÛÉÎÓÔ×Ï -ËÏÍÁÎÄ ÄÅÌÁÀÔ "ÔÕÖÅ ÒÁÂÏÔÕ" × ËÁÖÄÏÍ ÉÚ ÒÅÖÉÍÏ×, ÎÏ ÉÈ ÒÁÂÏÔÁ ÏÔÌÉÞÁÅÔÓÑ -ËÁËÏÊ-ÎÉÂÕÄØ ÍÅÌÏÞØÀ. - -äÌÑ ÐÒÏÓÍÏÔÒÁ ÄÏËÕÍÅÎÔÁÃÉÉ Ï ×ÁÛÅÍ ÔÅËÕÝÅÍ ÏÓÎÏ×ÎÏÍ ÒÅÖÉÍÅ, ÎÁÖÍÉÔÅ C-h m. - ->> éÓÐÏÌØÚÕÊÔÅ C-u C-v ÏÄÉÎ ÒÁÚ ÉÌÉ ÂÏÌÅÅ, ÞÔÏÂÙ ÒÁÓÐÏÌÏÖÉÔØ ÜÔÕ ÓÔÒÏËÕ ÂÌÉÖÅ - Ë ×ÅÒÈÕ ÜËÒÁÎÁ. ->> îÁÂÅÒÉÔÅ C-h m, ÞÔÏ ÐÏÓÍÏÔÒÅÔØ ÏÔÌÉÞÉÑ Text-ÒÅÖÉÍÁ ÏÔ ÂÁÚÏ×ÏÇÏ. ->> îÁÂÅÒÉÔÅ q ÞÔÏÂÙ ÕÂÒÁÔØ ÄÏËÕÍÅÎÔÁÃÉÀ Ó ÇÌÁÚ ÄÏÌÏÊ :) - -ïÓÎÏ×ÎÏÊ ÒÅÖÉÍ ÎÁÚÙ×ÁÅÔÓÑ ÏÓÎÏ×ÎÙÍ ÐÏÔÏÍÕ, ÞÔÏ ÅÓÔØ ÎÅÓËÏÌØËÏ ÄÏÐÏÌÎÉÔÅÌØÎÙÈ -(minor) ÒÅÖÉÍÏ×. äÏÐÏÌÎÉÔÅÌØÎÙÅ ÒÅÖÉÍÙ ÎÅ ÁÌØÔÅÒÎÁÔÉ×Ù Ë ÏÓÎÏ×ÎÙÍ, ÏÎÉ ÔÏÌØËÏ -ÞÕÔØ-ÞÕÔØ ÍÏÄÉÆÉÃÉÒÕÀÔ ÉÈ. ëÁÖÄÙÊ ÄÏÐÏÌÎÉÔÅÌØÎÙÊ ÒÅÖÉÍ ×ËÌÀÞÁÅÔÓÑ/×ÙËÌÀÞÁÅÔÓÑ -ÎÅÚÁ×ÉÓÉÍÏ ÏÔ ÄÒÕÇÉÈ ÄÏÐÏÌÎÉÔÅÌØÎÙÈ ÒÅÖÉÍÏ×, É ÎÅÚÁ×ÉÓÉÍÏ ÏÔ ×ÁÛÅÇÏ ÏÓÎÏ×ÎÏÇÏ -ÒÅÖÉÍÁ. ÷Ù ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ ÏÓÎÏ×ÎÏÊ ÒÅÖÉÍ ÂÅÚ ÄÏÐÏÌÎÉÔÅÌØÎÙÈ, ÉÌÉ Ó ÌÀÂÏÊ -ÉÈ ËÏÍÂÉÎÁÃÉÅÊ. - -ïÄÉÎ ÉÚ ÄÏÐÏÌÎÉÔÅÌØÎÙÈ ÒÅÖÉÍÏ× ÏÞÅÎØ ÐÏÌÅÚÅÎ, ÏÓÏÂÅÎÎÏ ÄÌÑ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ -ÁÎÇÌÉÊÓËÏÇÏ ÔÅËÓÔÁ - ÜÔÏ ÒÅÖÉÍ Á×ÔÏÚÁÐÏÌÎÅÎÉÑ (Auto Fill mode). ëÏÇÄÁ ÜÔÏÔ -ÒÅÖÉÍ ×ËÌÀÞÅÎ, Emacs ÒÁÚÒÙ×ÁÅÔ ÓÔÒÏËÉ ÍÅÖÄÕ ÓÌÏ×ÁÍÉ Á×ÔÏÍÁÔÉÞÅÓËÉ, ËÏÇÄÁ ×Ù -×ÓÔÁ×ÌÑÅÔÅ ÔÅËÓÔ É ÄÅÌÁÅÔÅ ÓÔÒÏËÉ ÓÌÉÛËÏÍ ÄÌÉÎÎÙÍÉ. - -÷Ù ÍÏÖÅÔÅ ×ËÌÀÞÉÔØ ÒÅÖÉÍ Á×ÔÏÚÁÐÏÌÎÅÎÉÑ ÎÁÂÒÁ× M-x auto-fill-mode. -ëÏÇÄÁ ÜÔÏÔ ÒÅÖÉÍ ×ËÌÀÞÅÎ, ÅÇÏ ÍÏÖÎÏ ×ÙËÌÀÞÉÔØ - M-x auto-fill-mode. -åÓÌÉ ÒÅÖÉÍ ×ËÌÀÞÅÎ - ËÏÍÁÎÄÁ ÅÇÏ ×ÙËÌÀÞÉÔ, ÅÓÌÉ ×ÙËÌÀÞÅÎ - ×ËÌÀÞÉÔ. íÙ -ÎÁÚÙ×ÁÅÍ ÜÔÏ ËÏÍÁÎÄÁ "ÐÅÒÅËÌÀÞÅÎÉÑ ÒÅÖÉÍÁ". - ->> îÁÂÅÒÉÔÅ M-x auto-fill-mode. úÁÔÅÍ ×ÓÔÁ×ÌÑÊÔÅ ÓÔÒÏËÕ - ÉÚ "ÆÙ×Á " ÐÏËÁ ÎÅ Õ×ÉÄÉÔÅ ËÁË ÏÎÁ ÒÁÚÄÅÌÉÔÓÑ ÎÁ Ä×Å ÓÔÒÏËÉ. - ÷Ù ÄÏÌÖÎÙ ÐÏÍÅÝÁÔØ ÐÒÏÂÅÌÙ ÍÅÖÄÕ ÓÌÏ×ÁÍÉ, ÐÏÔÏÍÕ ÞÔÏ ÒÅÖÉÍ Á×ÔÏÚÁÐÏÌÎÅÎÉÑ - ÒÁÚÄÅÌÑÅÔ ÓÔÒÏËÉ ÔÏÌØËÏ ÐÏ ÐÒÏÂÅÌÁÍ. - -çÒÁÎÉÃÁ ÏÂÙÞÎÏ ×ÙÓÔÁ×ÌÅÎÁ ÎÁ 70-ÔÉ ÓÉÍ×ÏÌÁÈ, ÎÏ ×Ù ÍÏÖÅÔÅ ÉÚÍÅÎÉÔØ ÅÅ -ÉÓÐÏÌØÚÕÑ ËÏÍÁÎÄÕ C-x f. ÷Ù ÄÏÌÖÎÙ ÚÁÄÁÔØ ÇÒÁÎÉÃÕ × ×ÉÄÅ ÞÉÓÌÏ×ÏÇÏ ÁÒÇÕÍÅÎÔÁ -ÄÌÑ ÜÔÏÊ ËÏÍÁÎÄÙ. - ->> ÷×ÅÄÉÔÅ C-x f Ó ÁÒÇÕÍÅÎÔÏÍ 20. (C-u 2 0 C-x f). - ÚÁÔÅÍ ××ÏÄÉÔÅ ËÁËÏÊ-ÎÉÂÕÄØ ÔÅËÓÔ, É ÓÍÏÔÒÉÔÅ ËÁË Emacs ÚÁÐÏÌÎÑÅÔ ÌÉÎÉÉ - ÐÏ 20 ÓÉÍ×ÏÌÏ× × ËÁÖÄÏÊ. ÷ÅÒÎÉÔÅ ÚÎÁÞÅÎÉÅ ÇÒÁÎÉÃÙ 70 ÎÁÚÁÄ, ÉÓÐÏÌØÚÕÑ - C-x f ÓÎÏ×Á. - -åÓÌÉ ×Ù ÓÄÅÌÁÌÉ ÉÚÍÅÎÅÎÉÑ × ÓÅÒÅÄÉÎÅ ÐÁÒÁÇÒÁÆÁ, Á×ÔÏÚÁÐÏÌÎÅÎÉÅ ÎÅ ÐÅÒÅÓÔÒÏÉÔ -ÔÅËÓÔ ÄÌÑ ×ÁÓ. þÔÏÂÙ ÐÅÒÅÓÔÒÏÉÔØ ÐÁÒÁÇÒÁÆ, ÎÁÂÅÒÉÔÅ M-q (Meta-q) × ÔÏ ×ÒÅÍÑ, -ËÏÇÄÁ ËÕÒÓÏÒ ÂÕÄÅÔ ×ÎÕÔÒÉ ÐÁÒÁÇÒÁÆÁ. - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ × ÐÒÅÄÙÄÕÝÉÊ ÐÁÒÁÇÒÁÆ, É ÎÁÖÍÉÔÅ M-q. - - -* ðïéóë -------- - -Emacs ÕÍÅÅÔ ÉÓËÁÔØ ÓÔÒÏËÉ (ÜÔÏ ÎÅÐÒÅÒÙ×ÎÙÅ ÇÒÕÐÐÙ ÓÉÍ×ÏÌÏ× ÉÌÉ ÓÌÏ×Á) ×ÐÅÒÅÄ -ÐÏ ÔÅËÓÔÕ, ÉÌÉ ÎÁÚÁÄ. ðÏÉÓË ÓÔÒÏËÉ ÜÔÏ ËÏÍÁÎÄÁ ÐÅÒÅÍÅÝÅÎÉÑ ËÕÒÓÏÒÁ; ÏÎÁ -ÐÅÒÅÍÅÝÁÅÔ ËÕÒÓÏÒ × ÓÌÅÄÕÀÝÕÀ ÔÏÞËÕ, ÇÄÅ ÎÁÊÄÅÎÁ ÉÓËÏÍÁÑ ÓÔÒÏËÁ. - -ëÏÍÁÎÄÁ ÐÏÉÓËÁ Emacs ÏÔÌÉÞÁÀÔÓÑ ÏÔ ÁÎÁÌÏÇÉÞÎÙÈ ËÏÍÁÎÄ ÂÏÌØÛÉÎÓÔ×Á ÄÒÕÇÉÈ -ÒÅÄÁËÔÏÒÏ× ÔÅÍ, ÞÔÏ ÏÎÁ ÉÎËÒÅÍÅÎÔÁÌØÎÁÑ. üÔÏ ÏÚÎÁÞÁÅÔ ÞÔÏ ÐÏÉÓË ÐÒÏÉÓÈÏÄÉÔ ÐÏ -ÍÅÒÅ ÔÏÇÏ ËÁË ×Ù ÎÁÂÉÒÁÅÔÅ ÉÓËÏÍÕÀ ÓÔÒÏËÕ. - -ëÏÍÁÎÄÁ, ÎÁÞÉÎÁÀÝÁÑ ÐÏÉÓË ×ÐÅÒÅÄ - C-s, É C-r ÉÝÅÔ ÎÁÚÁÄ. -ðïäïöäéôå! îÅ ÎÕÖÎÏ ÐÒÏÂÏ×ÁÔØ ÜÔÏ ÐÒÑÍÏ ÓÅÊÞÁÓ. - -ëÏÇÄÁ ×Ù ÎÁÖÍÅÔÅ C-s ×Ù Õ×ÉÄÉÔÅ ÓÔÒÏËÕ "I-search", ÐÏÑ×É×ÛÕÀÓÑ × ÏÂÌÁÓÔÉ ÜÈÏ. -÷ÁÍ ÓÏÏÂÝÁÅÔÓÑ ÞÔÏ Emacs ÖÄÅÔ ××ÏÄÁ ÓÌÏ×Á, ËÏÔÏÒÏÅ ×Ù ÈÏÔÉÔÅ ÎÁÊÔÉ. - ÚÁ×ÅÒÛÁÅÔ ÐÏÉÓË. - ->> ôÅÐÅÒØ, ÎÁÖÍÉÔÅ C-s ÄÌÑ ÎÁÞÁÌÁ ÐÏÉÓËÁ. íÅÄÌÅÎÎÏ, ÏÄÎÕ ÂÕË×Õ ÚÁ ÏÄÉÎ ÒÁÚ, - ÎÁÂÉÒÁÊÔÅ ÓÌÏ×Ï, 'ËÕÒÓÏÒ', ÏÓÔÁÎÁ×ÌÉ×ÁÑÓØ ÐÏÓÌÅ ËÁÖÄÏÊ ××ÅÄÅÎÎÏÊ ÂÕË×Ù, - ÚÁÍÅÞÁÑ ÞÔÏ ÐÒÏÉÓÈÏÄÉÔ Ó ËÕÒÓÏÒÏÍ. - óÅÊÞÁÓ ×Ù ÎÁÛÌÉ ÐÅÒ×ÏÅ ×ÈÏÖÄÅÎÉÅ ÓÌÏ×Á "ËÕÒÓÏÒ". ->> îÁÖÍÉÔÅ C-s ÓÎÏ×Á, ÞÔÏÂÙ ÎÁÊÔÉ ÓÌÅÄÕÀÝÅÅ ×ÈÏÖÄÅÎÉÅ ÓÌÏ×Á "ËÕÒÓÏÒ". ->> ôÅÐÅÒØ ÎÁÖÍÉÔÅ ÞÅÔÙÒÅ ÒÁÚÁ É ÐÒÏÓÌÅÄÉÔÅ ÚÁ ÐÅÒÅÍÅÝÅÎÉÑÍÉ ËÕÒÓÏÒÁ. ->> îÁÖÍÉÔÅ ÄÌÑ ÚÁ×ÅÒÛÅÎÉÑ ÐÏÉÓËÁ. - -÷Ù ×ÉÄÅÌÉ ÞÔÏ ÐÒÏÉÓÈÏÄÉÌÏ? Emacs, × ÒÅÖÉÍÅ ÉÎËÒÅÍÅÎÔÁÌØÎÏÇÏ ÐÏÉÓËÁ, ÐÙÔÁÌÓÑ -ÐÅÒÅÈÏÄÉÔØ Ë ÓÔÒÏËÁÍ ÓÏ×ÐÁÄÁÀÝÉÍ Ó ÎÁÂÉÒÁÅÍÏÊ ×ÁÍÉ, ÐÏÄÓ×ÅÞÉ×ÁÑ ÉÈ ÄÌÑ ×ÁÓ. -ÞÔÏÂÙ ÐÅÒÅÊÔÉ Ë ÓÌÅÄÕÀÝÅÍÕ ×ÈÏÖÄÅÎÉÑ ÓÌÏ×Á 'ËÕÒÓÏÒ' ÐÒÏÓÔÏ ÎÁÖÍÉÔÅ C-s ÓÎÏ×Á. -åÓÌÉ ÂÏÌØÛÅ ÎÅÔ ×ÈÏÖÄÅÎÉÊ, Emacs ÉÚÄÁÓÔ Ú×ÕËÏ×ÏÊ ÓÉÇÎÁÌ, É ÓËÁÖÅÔ ÞÔÏ ×ÁÛ -ÐÏÉÓË ÎÅ ÕÄÁÌÓÑ ("failing"), C-g ÔÏ ÖÅ ÔÏÌÖÅÎ ÏÔÍÅÎÉÔØ ÐÏÉÓË. - -úáíåþáîéå: îÁ ÎÅËÏÔÏÒÙÈ ÓÉÓÔÅÍÁÈ, ××ÏÄ C-x C-s ÚÁÍÏÒÏÚÉÔ ÜËÒÁÎ É ×Ù ÎÅ Õ×ÉÄÉÔÅ -ÐÏÓÌÅÄÕÀÝÅÇÏ ×Ù×ÏÄÁ Emacs`Á. üÔÏ ÏÚÎÁÞÁÅÔ ÞÔÏ ÏÐÅÒÁÃÉÏÎÎÁÑ ÓÉÓÔÅÍÁ ÉÍÅÅÔ -"ÏÓÏÂÅÎÎÏÓÔØ" ÉÍÅÎÕÅÍÕÀ "flow control" ÐÅÒÅÈ×ÁÔÙ×ÁÀÝÕÀ C-s É ÎÅ ÐÒÏÐÕÓËÁÀÝÕÀ -ÜÔÏÔ ÓÉÍ×ÏÌ Ë Emacs`Õ. äÌÑ ÒÁÚÍÏÒÏÚËÉ ÜËÒÁÎÁ, ÎÁÖÍÉÔÅ C-q. óÍÏÔÒÉÔÅ ÒÁÚÄÅÌ -"Spontaneous Entry to Incremental Search" ÒÕËÏ×ÏÄÓÔ×Á Emacs ÞÔÏÂÙ ÕÚÎÁÔØ ËÁË -ÂÏÒÏÔØÓÑ Ó ÜÔÏÊ "ÏÓÏÂÅÎÎÏÓÔØÀ". - -åÓÌÉ ×Ù ×Ï ×ÒÅÍÑ ÉÎËÒÅÍÅÎÔÁÌØÎÏÇÏ ÐÏÉÓËÁ ÎÁÖÍÅÔÅ , ×Ù ÍÏÖÅÔÅ ÚÁÍÅÔÉÔØ -ÞÔÏ ÐÏÓÌÅÄÎÉÊ ÓÉÍ×ÏÌ × ÉÓËÏÍÏÊ ÓÔÒÏËÅ ÕÄÁÌÉÌÓÑ, É ÐÏÉÓË ×ÅÒÎÕÌÓÑ Ë ÐÒÅÄÙÄÕÝÅÍÕ -ÎÁÊÄÅÎÎÏÍÕ ÍÅÓÔÕ. îÁÐÒÉÍÅÒ, ÐÒÅÄÐÏÌÏÖÉÍ ×Ù ÎÁÂÒÁÌÉ "c", ÐÏÉÓË ÐÅÒÅÊÄÅÔ Ë -ÐÅÒ×ÏÍÕ ×ÈÏÖÄÅÎÉÀ ÓÉÍ×ÏÌÁ "c". ôÅÐÅÒØ ÅÓÌÉ ×Ù ÎÁÂÅÒÅÔÅ "u", ËÕÒÓÏÒ ÐÅÒÅÊÄÅÔ Ë -ÐÅÒ×ÏÍÕ ×ÈÏÖÄÅÎÉÀ "cu". îÁÖÁÔÉÅ ÕÄÁÌÉÔ ÓÉÍ×ÏÌ "u" ÉÈ ÓÔÒÏËÉ ÐÏÉÓËÁ, É -ËÕÒÓÏÒ ×ÅÒÎÅÔÓÑ Ë ÐÅÒ×ÏÍÕ ×ÈÏÖÄÅÎÉÀ "c". - -åÓÌÉ ×Ù ×Ï ×ÒÅÍÑ ÐÏÉÓËÁ ××ÅÄÅÔÅ control- ÉÌÉ meta- ÓÉÍ×ÏÌ (ÚÁ ÎÅËÏÔÏÒÙÍÉ -ÉÓËÌÀÞÅÎÉÑÍÉ -- ÓÉÍ×ÏÌÙ ×ÙÚÙ×ÁÀÝÉÅ ÐÏÉÓË, Á ÉÍÅÎÎÏ C-s É C-r), ÐÏÉÓË -ÐÒÅËÒÁÔÉÔÓÑ. - -C-s ÎÁÞÉÎÁÅÔ ÐÏÉÓË É ÓÍÏÔÒÉÔ ÎÁ ÌÀÂÙÅ ×ÈÏÖÄÅÎÉÑ ÉÓËÏÍÏÊ ÓÔÒÏËÉ ðïóìå ÔÅËÕÝÅÊ -ÐÏÚÉÃÉÉ ËÕÒÓÏÒÁ. åÓÌÉ ×Ù ÈÏÔÉÔÅ ÎÁÊÔÉ ÞÔÏ-ÔÏ ÒÁÎÅÅ × ÔÅËÓÔÅ, ÎÁÖÍÉÔÅ C-r. ÷ÓÅ -ÞÔÏ ÍÙ ÇÏ×ÏÒÉÌÉ Ï C-s ÐÒÉÍÅÎÉÍÏ É Ë C-r, ÚÁ ÉÓËÌÀÞÅÎÉÅÍ ÐÒÏÔÉ×ÏÐÏÌÏÖÎÏÇÏ -ÎÁÐÒÁ×ÌÅÎÉÑ ÐÏÉÓËÁ. - - -* íîïçï ïëïî (MULTIPLE WINDOWS) -------------------------------- - -ïÄÎÁ ÉÚ ÐÒÉÑÔÎÙÈ ÏÓÏÂÅÎÎÏÓÔÅÊ Emacs ÜÔÏ ÔÏ, ÞÔÏ ×Ù ÍÏÖÅÔÅ ÏÔÏÂÒÁÖÁÔØ ÂÏÌÅÅ ÞÅÍ -ÏÄÎÏ ÏËÎÏ ÎÁ ÜËÒÁÎÅ ÏÄÎÏ×ÒÅÍÅÎÎÏ. - ->> ðÅÒÅÍÅÓÔÉÔÅ ËÕÒÓÏÒ ÎÁ ÜÔÕ ÌÉÎÉÀ, É ÎÁÂÅÒÉÔÅ C-u 0 C-l. - ->> ôÅÐÅÒØ, ÎÁÂÅÒÉÔÅ C-x 2, ÞÔÏ ÒÁÚÄÅÌÉÔ ÜËÒÁÎ ÎÁ Ä×Á ÏËÎÁ. - ïÂÁ ÏËÎÁ ÏÔÏÂÒÁÖÁÀÔ ÕÞÅÂÎÉË. ëÕÒÓÏÒ ÏÓÔÁÌÓÑ × ×ÅÒÈÎÅÍ ÏËÎÅ. - ->> îÁÖÍÉÔÅ C-M-v ÄÌÑ ÐÒÏËÒÕÔËÉ ÎÉÖÎÅÇÏ ÏËÎÁ. - (ÅÓÌÉ Õ ×ÁÓ ÎÅÔ ÎÁÓÔÏÑÝÅÊ ËÎÏÐËÉ Meta (Alt), ÎÁÖÍÉÔÅ ESC C-v.) - ->> îÁÖÍÉÔÅ C-x o ("o" ÏÔ ÓÌÏ×Á "other" - ÄÒÕÇÏÅ) ÄÌÑ ÐÅÒÅÍÅÝÅÎÉÑ ËÕÒÓÏÒÁ × - ÎÉÖÎÅÅ ÏËÎÏ. ->> éÓÐÏÌØÚÕÊÔÅ C-v É M-v × ÎÉÖÎÅÍ ÏËÎÅ ÞÔÏ ÐÒÏËÒÕÞÉ×ÁÔØ ÅÇÏ. - ðÒÏÄÏÌÖÉÔÅ ÞÔÅÎÉÅ ÜÔÉÈ ÉÎÓÔÒÕËÃÉÊ × ×ÅÒÈÎÅÍ ÏËÎÅ. - ->> îÁÖÍÉÔÅ C-x o ÓÎÏ×Á ÞÔÏÂÙ ÐÅÒÅÍÅÓÔÉÔØ ËÕÒÓÏÒ ÎÁÚÁÄ × ×ÅÒÈÎÅÅ ÏËÎÏ. - ëÕÒÓÏÒ × ×ÅÒÈÎÅÍ ÏËÎÅ ÔÁÍ ÖÅ, ÇÄÅ É ÂÙÌ ÄÏ ÔÏÇÏ. - -÷Ù ÍÏÖÅÔÅ ÐÒÏÄÏÌÖÁÔØ ÐÅÒÅËÌÀÞÁÔØÓÑ ÍÅÖÄÕ ÏËÎÁÍÉ, ÉÓÐÏÌØÚÕÑ C-x o. ëÁÖÄÏÅ ÏËÎÏ -ÈÒÁÎÉÔ Ó×ÏÀ ÐÏÚÉÃÉÀ ËÕÒÓÏÒÁ, ÎÏ ÔÏÌØËÏ ÏÄÎÏ ÐÏËÁÚÙ×ÁÅÔ ËÕÒÓÏÒ. ÷ÓÅ ÏÂÙÞÎÙÅ -ËÏÍÁÎÄÙ ÒÅÄÁËÃÉÉ ÐÒÉÍÅÎÑÀÔÓÑ Ë ÏËÎÕ, × ËÏÔÏÒÏÍ ÏÔÏÂÒÁÖÁÅÔÓÑ ËÕÒÓÏÒ. -íÙ ÎÁÚÙ×ÁÅÍ ÅÇÏ "×ÙÂÒÁÎÎÏÅ ÏËÎÏ" ("selected window"). - -ëÏÍÁÎÄÁ C-M-v ÏÞÅÎØ ÕÄÏÂÎÁ, ËÏÇÄÁ ×Ù ÒÅÄÁËÔÉÒÕÅÔÅ ÔÅËÓÔ × ÏÄÎÏÍ ÏËÎÅ, É -ÉÓÐÏÌØÚÕÅÔÅ ×ÔÏÒÏÅ × ËÁÞÅÓÔ×Å ÓÐÒÁ×ÏÞÎÉËÁ. ÷Ù ÍÏÖÅÔÅ ×ÓÅÇÄÁ ÓÏÈÒÁÎÑÔØ ËÕÒÓÏÒ -× ÏËÎÅ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ É ÐÏÓÌÅÄÏ×ÁÔÅÌØÎÏ ÐÒÏÄ×ÉÇÁÔØÓÑ ×Ï ×ÔÏÒÏÍ, ÉÓÐÏÌØÚÕÑ -C-M-v. - -C-M-v ÐÒÉÍÅÒ CONTROL-META ÓÉÍ×ÏÌÁ. åÓÌÉ Õ ×ÁÓ ÅÓÔØ ÎÁÓÔÏÑÝÁÑ ËÎÏÐËÁ META -(Alt), ×Ù ÍÏÖÅÔÅ ÎÁÂÒÁÔØ C-M-v ÎÁÖÁ× ÏÄÎÏ×ÒÅÍÅÎÎÏ CTRL É META É ÎÅ ÏÔÐÕÓËÁÑ -ÎÁÖÁÔØ v. é ÎÅ ×ÁÖÎÏ ËÔÏ ÂÕÄÅÔ ÎÁÖÁÔ ÐÅÒ×ÙÍ, CTRL ÉÌÉ META, ÐÏÔÏÍÕ ÞÔÏ ÜÔÉ -ËÎÏÐËÉ ÍÏÄÉÆÉÃÉÒÕÀÔ ÔÉÐ ÓÉÍ×ÏÌÁ. - -åÓÌÉ Õ ×ÁÓ ÎÅÔ ÎÁÓÔÏÑÝÅÊ ËÎÏÐËÉ META, É ×Ù ÉÓÐÏÌØÚÕÅÔÅ ESC ×ÍÅÓÔÏ ÎÅÅ, -ÐÏÒÑÄÏË ÄÏÌÖÅÎ ÂÙÔØ ÓÌÅÄÕÀÝÉÍ: ×Ù ÄÏÌÖÎÙ ÎÁÖÁÔØ ESC Á ÓÌÅÄÏÍ CTRL-v; -CTRL-ESC v ÎÅ ÂÕÄÅÔ ÒÁÂÏÔÁÔØ. ðÏÔÏÍÕ, ÞÔÏ ESC ÉÍÅÅÔ Ó×ÏÊ ÓÏÂÓÔ×ÅÎÎÙÊ ÓÉÍ×ÏÌ, -ÜÔÏ ÎÅ ÍÏÄÉÆÉÃÉÒÕÀÝÁÑ ËÎÏÐËÁ. - ->> îÁÖÍÉÔÅ C-x 1 (× ×ÅÒÈÎÅÍ ÏËÎÅ) ÞÔÏÂÙ ÉÚÂÁ×ÉÔØÓÑ ÏÔ ÎÉÖÎÅÇÏ. - -(åÓÌÉ ×Ù ÎÁÖÁÌÉ C-x 1 × ÎÉÖÎÅÍ ÏËÎÅ, ÔÏ ×Ù ÉÚÂÁ×ÉÌÉÓØ ÏÔ ×ÅÒÈÎÅÇÏ. ðÏÎÉÍÁÊÔÅ -ÜÔÕ ËÏÍÁÎÄÕ ËÁË "ïÓÔÁ×ÉÔØ ÔÏÌØËÏ ÏÄÎÏ ÏËÎÏ, ÔÏ × ËÏÔÏÒÏÍ Ñ ÓÅÊÞÁÓ ÎÁÈÏÖÕÓØ"). - -÷ÁÍ ÎÅ ÎÕÖÎÏ ÏÔÏÂÒÁÖÁÔØ ÏÄÉÎ É ÔÏÔ ÖÅ ÂÕÆÅÒ × ÏÂÏÉÈ ÏËÎÁÈ. åÓÌÉ ×Ù ÉÓÐÏÌØÚÕÅÔÅ -C-x C-f ÞÔÏÂÙ ÏÔËÒÙÔØ ÆÁÊÌ × ÏÄÎÏÍ ÏËÎÅ, ÄÒÕÇÏÅ ÏÓÔÁÎÅÔÓÑ ÂÅÚ ÉÚÍÅÎÅÎÉÑ. ÷Ù -ÍÏÖÅÔÅ ÏÔËÒÙ×ÁÔØ ÆÁÊÌÙ × ËÁÖÄÏÍ ÏËÎÅ ÎÅÚÁ×ÉÓÉÍÏ. - -åÓÔØ ÄÒÕÇÏÊ ÐÕÔØ ÉÓÐÏÌØÚÏ×ÁÔØ Ä×Á ÏËÎÁ ÏÔÏÂÒÁÖÁÀÝÉÈ ÒÁÚÎÙÅ ÆÁÊÌÙ: - ->> îÁÂÅÒÉÔÅ C-x 4 C-f ÚÁÔÅÍ ÉÍÑ ÏÄÎÏÇÏ É ×ÁÛÉÈ ÆÁÊÌÏ×. úÁ×ÅÒÛÉÔÅ . - ðÏÓÍÏÔÒÉÔÅ ÞÔÏ ×ÙÂÒÁÎÎÙÊ ÆÁÊÌ ÐÏÑ×ÉÌÓÑ × ÎÉÖÎÅÍ ÏËÎÅ. ëÕÒÓÏÒ ÐÅÒÅÛÅÌ - ÔÕÄÁ ÖÅ. - ->> îÁÂÅÒÉÔÅ C-x o ÞÔÏÂÙ ×ÅÒÎÕÔØÓÑ × ×ÅÒÈÎÅÅ ÏËÎÏ, É C-x 1 ÞÔÏÂÙ ÕÄÁÌÉÔØ ÎÉÖÎÅÅ - ÏËÎÏ. - - -* òåëõòóé÷îùå õòï÷îé òåäáëôéòï÷áîéñ (RECURSIVE EDITING LEVELS) --------------------------------------------------------------- - -éÎÏÇÄÁ ×Ù ÂÕÄÅÔÅ ×ËÌÀÞÁÔØ ÔÁË ÎÁÚÙ×ÁÅÍÙÅ "ÒÅËÕÒÓÉ×ÎÙÅ ÕÒÏ×ÎÉ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ". -îÁ ÜÔÏ ÕËÁÚÙ×ÁÀÔ ÐÒÑÍÏÕÇÏÌØÎÙÅ ÓËÏÂÏÞËÉ × ÓÔÒÏËÅ ÓÏÓÔÏÑÎÉÑ, ÏËÒÕÖÁÀÝÉÅ ÏÂÙÞÎÙÅ -ÓËÏÂËÉ ×ÏËÒÕÇ ÉÍÅÎÉ ÏÓÎÏ×ÎÏÇÏ ÒÅÖÉÍÁ. îÁÐÒÉÍÅÒ ×Ù ÍÏÖÅÔÅ Õ×ÉÄÅÔØ -[(Fundamental)] ×ÍÅÓÔÏ (Fundamental). - -ÞÔÏÂÙ ×ÙÊÔÉ ÉÚ ÒÅËÕÒÓÉ×ÎÙÈ ÕÒÏ×ÎÅÊ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ, ÎÁÖÍÉÔÅ ESC ESC ESC. -üÔÏ ÍÎÏÇÏÃÅÌÅ×ÁÑ ËÏÍÁÎÄÁ "×ÙÈÏÄ". ÷Ù ÔÁË ÖÅ ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ ÅÅ ÄÌÑ -ÕÎÉÞÔÏÖÅÎÉÑ ÌÉÛÎÉÈ ÏËÏÎ, É ×ÙÈÏÄÁ ÉÚ ÍÉÎÉÂÕÆÅÒÁ. - ->> îÁÖÍÉÔÅ M-x ÞÔÏÂÙ ÐÏÐÁÓÔØ × ÍÉÎÉÂÕÆÅÒ; ÚÁÔÅÍ ÎÁÖÍÉÔÅ ESC ESC ESC - ÞÏ ×ÙÊÔÉ. - -÷Ù ÎÅ ÍÏÖÅÔÅ ÉÓÐÏÌØÚÏ×ÁÔØ C-g ÞÔÏÂÙ ÕÊÔÉ ÉÚ ÒÅËÕÒÓÉ×ÎÙÈ ÕÒÏ×ÎÅÊ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ. -ðÏÔÏÍÕ ÞÔÏ C-g ÉÓÐÏÌØÚÕÅÔÓÑ ÄÌÑ ÏÔÍÅÎÙ ËÏÍÁÎÄÙ É ÁÒÇÕÍÅÎÔÏ× âåú ÒÅËÕÒÓÉ×ÎÙÈ -ÕÒÏ×ÎÅÊ ÒÅÄÁËÔÉÒÏ×ÁÎÉÑ. - - -* ëáë ðïìõþéôø ðïíïýø (GETTING MORE HELP) ------------------------------------------ - -÷ ÜÔÏÍ ÕÞÅÂÎÉËÅ ÍÙ ÐÏÐÙÔÁÌÉÓØ ÓÎÁÂÄÉÔØ ×ÁÓ ÔÏÌØËÏ ÔÏÊ ÉÎÆÏÒÍÁÃÉÅÊ, ËÏÔÏÒÁÑ -ÐÏÍÏÖÅÔ ÎÁÞÁÔØ ÉÓÐÏÌØÚÏ×ÁÔØ Emacs. ïÞÅÎØ ÍÎÏÇÏ ÉÎÆÏÒÍÁÃÉÉ ÄÏÓÔÕÐÎÏ × -Emacs, É ÎÅ×ÏÚÍÏÖÎÏ ×ÓÀ ÅÅ ÐÒÅÄÓÔÁ×ÉÔØ ÚÄÅÓØ. ïÄÎÁËÏ, ×Ù ÍÏÖÅÔÅ -×ÙÕÞÉÔØ ÂÏÌØÛÅ ×ÏÚÍÏÖÎÏÓÔÅÊ Emacs, ÕÚÎÁÔØ ÄÒÕÇÉÅ ÐÏÌÅÚÎÙÅ ÏÓÏÂÅÎÎÏÓÔÉ. Emacs -ÐÒÅÄÏÓÔÁ×ÌÑÅÔ ËÏÍÁÎÄÙ ÄÌÑ ÞÔÅÎÉÑ ÄÏËÕÍÅÎÔÁÃÉÉ Ï ËÏÍÁÎÄÁÈ Emacs. üÔÉ ËÏÍÁÎÄÙ -"ÐÏÍÏÝÉ" ("help") ×ÓÅ ÎÁÞÉÎÁÀÔÓÑ Ó ÓÉÍ×ÏÌÁ Control-h, ËÏÔÏÒÙÊ Ñ×ÌÑÅÔÓÑ -"ÓÉÍ×ÏÌÏÍ ÐÏÍÏÝÉ". - -ÞÔÏÂÙ ÉÓÐÏÌØÚÏ×ÁÔØ ÏÓÏÂÅÎÎÏÓÔÉ ðÏÍÏÝÉ, ÎÁÖÍÉÔÅ C-h, É ÚÁÔÅÍ ÓÉÍ×ÏÌ, ËÏÔÏÒÙÊ -ÒÁÓÓËÁÖÅÔ ËÁËÏÊ ÉÍÅÎÎÏ ×ÉÄ ÐÏÍÏÝÉ ×Ù ÈÏÔÉÔÅ ÐÏÌÕÞÉÔØ. åÓÌÉ ×Ù äåêóô÷éôåìøîï -ÒÁÓÔÅÒÑÌÉÓØ, ÎÁÂÅÒÉÔÅ C-h ? É Emacs ÒÁÓÓËÁÖÅÔ ×ÁÍ ËÁËÕÀ ÐÏÍÏÝØ ÏÎ ÍÏÖÅÔ ×ÁÍ -ÐÒÅÄÏÓÔÁ×ÉÔØ. åÓÌÉ ×Ù ÎÁÖÁÌÉ C-h É ÐÅÒÅÄÕÍÁÌÉ ÏÂÒÁÝÁÔØÓÑ Ë ÐÏÍÏÝÉ, ÐÒÏÓÔÏ -ÎÁÖÍÉÔÅ C-g ÞÔÏÂÙ ÏÔÍÅÎÉÔØ ÜÔÕ ËÏÍÁÎÄÕ. - -(ëÏÅ-ÇÄÅ ÐÅÒÅÎÁÚÎÁÞÁÀÔ ÓÉÍ×ÏÌ C-h. òÅÁÌØÎÏÊ ÎÅÏÂÈÏÄÉÍÏÓÔÉ × ÜÔÏÍ ÎÅÔ, -ÓÏÏÂÝÉÔÅ Ï ÎÅÊ ÓÉÓÔÅÍÎÏÍÕ ÁÄÍÉÎÉÓÔÒÁÔÏÒÕ. ôÅÍ ×ÒÅÍÅÎÅÍ, ÅÓÌÉ C-h ÎÅ -×ÙÚÙ×ÁÅÔ ÓÏÏÂÝÅÎÉÅ ÐÏÍÏÝÉ ×ÎÉÚÕ ÜËÒÁÎÁ, ÐÏÐÒÏÂÕÊÔÅ ÎÁÂÒÁÔØ M-x help RET -×ÍÅÓÔÏ ÜÔÏÇÏ.) - -óÁÍÁÑ ÏÓÎÏ×ÎÁÑ ×ÏÚÍÏÖÎÏÓÔØ ðïíïýé - C-h c. îÁÖÍÉÔÅ C-h, ÚÁÔÅÍ c, É ÓÉÍ×ÏÌ -ËÏÍÁÎÄÙ ÉÌÉ ÐÏÓÌÅÄÏ×ÁÔÅÌØÎÏÓÔØ, É Emacs ÏÔÏÂÒÁÚÉÔ ÏÞÅÎØ ËÒÁÔËÏÅ ÏÐÉÓÁÎÉÅ -ËÏÍÁÎÄÙ. - ->> îÁÖÍÉÔÅ C-h c Control-p. - óÏÏÂÝÅÎÉÅ ÄÏÌÖÎÏ ×ÙÇÌÑÄÅÔØ ÐÒÉÍÅÒÎÏ ÔÁË - - C-p runs the command previous-line - (C-p ×ÙÐÏÌÎÑÅÔ ËÏÍÁÎÄÕ previous-line {ÐÒÅÄÙÄÕÝÁÑ-ÌÉÎÉÑ}) - -÷ÁÍ ÓÏÏÂÝÁÀÔ "ÉÍÑ ÆÕÎËÃÉÉ". éÍÅÎÁ ÆÕÎËÃÉÉ ÉÓÐÏÌØÚÕÀÔÓÑ × ÏÓÎÏ×ÎÏÍ ÄÌÑ -ÎÁÓÔÒÏÊËÉ É ÒÁÓÛÉÒÅÎÉÑ Emacs. éÍÅÎÁ ÆÕÎËÃÉÊ ×ÙÂÒÁÎÙ ÔÁË, ÞÔÏÂÙ ÐÏËÁÚÁÔØ ÞÔÏ -ÉÍÅÎÎÏ ËÏÍÁÎÄÁ ÄÅÌÁÅÔ, ÔÁË ÖÅ ÏÎÉ ÐÏÚ×ÏÌÑÀÔ Ó ÐÏÍÏÝØÀ ÜÔÏÊ ËÒÁÔËÏÊ ÉÎÆÏÒÍÁÃÉÉ -ÌÅÇÞÅ ÚÁÐÏÍÎÉÔØ ÕÖÅ ×ÙÕÞÅÎÎÙÅ ËÏÍÁÎÄÙ. - -íÎÏÇÏÓÉÍ×ÏÌØÎÙÅ ËÏÍÁÎÄÙ, ÔÁËÉÅ ËÁË C-x C-s É (ÅÓÌÉ Õ ×ÁÓ ÎÅÔ ËÎÏÐËÉ META ÉÌÉ -EDIT ÉÌÉ ALT) v ÔÁË ÖÅ ÂÕÄÕÔ ÄÏÓÔÕÐÎÙ ÐÏÓÌÅ C-h c. - -ðÏÌÕÞÉÔÅ ÂÏÌØÛÅ ÉÎÆÏÒÍÁÃÉÉ Ï ËÏÍÁÎÄÅ ÉÓÐÏÌØÚÕÑ C-h k ×ÍÅÓÔÏ C-h c. - ->> îÁÂÅÒÉÔÅ C-h k Control-p. - -÷Ù Õ×ÉÄÉÔÅ ÏÐÉÓÁÎÉÅ ÆÕÎËÃÉÉ, Á ÔÁËÖÅ ÅÅ ÉÍÑ × ÏÔÄÅÌØÎÏÍ ÏËÎÅ Emacs. ëÏÇÄÁ ×Ù -ÚÁ×ÅÒÛÉÔÅ ÞÔÅÎÉÅ, ÎÁÖÍÉÔÅ q ÞÔÏÂÙ ÉÚÂÁ×ÉÔØÓÑ ÏÔ ÔÅËÓÔÁ ÐÏÍÏÝÉ. - -åÓÔØ ÅÝÅ ÎÅÓËÏÌØËÏ ÐÏÌÅÚÎÙÈ ÏÐÃÉÊ C-h: - - C-h f ïÐÉÓÙ×ÁÅÔ ÆÕÎËÃÉÀ. ÷ÁÍ ÎÅÏÂÈÏÄÉÍÏ ÎÁÂÒÁÔØ ÉÍÑ ÆÕÎËÃÉÉ. - ->> ðÏÐÒÏÂÕÊÔÅ ÎÁÂÒÁÔØ C-h f previous-line. - üÔÏ ÒÁÓÐÅÞÁÔÁÅÔ ÉÎÆÏÒÍÁÃÉÀ Emacs Ï ÜÔÏÊ ÆÕÎËÃÉÉ, ËÏÔÏÒÁÑ ×ÙÐÏÌÎÑÅÔÓÑ - ËÏÍÁÎÄÏÊ C-p. - - C-h a Hyper Apropos. ÷×ÅÄÉÔÅ ËÌÀÞÅ×ÏÅ ÓÌÏ×Ï É Emacs ÐÏËÁÖÅÔ ×ÁÍ - ÓÐÉÓÏË ×ÓÅÈ ÆÕÎËÃÉÊ É ÐÅÒÅÍÅÎÎÙÈ, ÉÍÅÎÁ ËÏÔÏÒÙÈ ÓÏÄÅÒÖÁÔ ÜÔÏ - ÓÌÏ×Ï. ëÏÍÁÎÄÙ, ËÏÔÏÒÙÅ ÍÏÇÕÔ ÂÙÔØ ×ÙÚ×ÁÎÙ ÞÅÒÅÚ Meta-x, - ÂÕÄÕÔ ÏÔÍÅÞÅÎÙ Ú×ÅÚÄÏÞËÏÊ ÓÌÅ×Á. - ->> îÁÂÅÒÉÔÅ C-h a newline. - -ÜÔÏ ÏÔÏÂÒÁÚÉÔ ÐÏÌÎÙÊ ÓÐÉÓÏË ÆÕÎËÃÉÊ É ÐÅÒÅÍÅÎÎÙÈ ÉÍÅÎÁ ËÏÔÏÒÙÈ ÎÁÞÉÎÁÀÔÓÑ Ó -"newline". îÁÖÍÉÔÅ ÉÌÉ ËÌÉËÎÉÔÅ ÓÒÅÄÎÅÊ ËÎÏÐËÏÊ ÍÙÛËÉ ÞÔÏÂÙ ÐÏÌÕÞÉÔØ -ÂÏÌØÛÅ Ï ÆÕÎËÃÉÉ ÉÌÉ ÐÅÒÅÍÅÎÎÏÊ. îÁÖÍÉÔÅ `q' ÞÏ ×ÙÊÔÉ ÉÚ hyper-apropos. - - -* úáëìàþåîéå ------------- - -úÁÐÏÍÎÉÔÅ, ÞÔÏÂÙ ×ÙÊÔÉ ÉÚ Emacs ÎÁÓÏ×ÓÅÍ ÉÓÐÏÌØÚÕÊÔÅ C-x C-c. ÞÔÏÂÙ ×ÒÅÍÅÎÎÏ -×ÙÊÔÉ × ÏÂÏÌÏÞËÕ (shell) É ÐÏÔÏÍ ×ÅÒÎÕÔØÓÑ ÏÂÒÁÔÎÏ, ÉÓÐÏÌØÚÕÊÔÅ C-z. -(× X, ÜÔÏ Ó×ÅÒÎÅÔ ÔÅËÕÝÅÅ ÏËÎÏ Emacs × ÉËÏÎËÕ.) - -üÔÏÔ ÕÞÅÂÎÉË ÄÏÌÖÅÎ ÂÙÔØ ÐÏÎÑÔÅÎ ×ÓÅÍ ÎÏ×ÙÍ ÐÏÌØÚÏ×ÁÔÅÌÑÍ, ÅÓÌÉ ×Ù ÎÁÊÄÅÔÅ -ÞÔÏ-ÎÉÂÕÄØ ÎÅÑÓÎÏÅ, ÎÅ ÎÕÖÎÏ ÓÉÄÅÔØ É ÐÏÒÉÃÁÔØ ÓÅÂÑ - ÖÁÌÕÊÔÅÓØ! - - -COPYING -------- - -üÔÏÔ ÕÞÅÂÎÉË ÐÒÏÉÚÏÛÅÌ ÉÚ ÄÌÉÎÎÏÊ ÓÅÒÉÉ ÕÞÅÂÎÉËÏ× Emacs, ÎÁÞÁÔÏÊ Ó ÏÄÎÁÖÄÙ -ÎÁÐÉÓÁÎÎÏÇÏ by Stuart Cracraft ÄÌÑ ÏÒÉÇÉÎÁÌØÎÏÇÏ Emacs. Ben Wing ÐÏÄÐÒÁ×ÉÌ -ÕÞÅÂÎÉË ÄÌÑ X Windows. Martin Buchholz É Hrvoje Niksic ÄÏÂÁ×ÉÌÉ ÍÎÏÇÏ -ÉÓÐÒÁ×ÌÅÎÉÊ ÄÌÑ XEmacs. - -üÔÁ ×ÅÒÓÉÑ ÕÞÅÂÎÉËÁ, ËÁË É GNU Emacs, ÚÁÝÉÝÅÎÁ ÐÒÁ×ÁÍÉ ËÏÐÉÒÏ×ÁÎÉÑ -(copyrighted), É ÐÒÉÈÏÄÉÔ Ó ÏÇÒÁÎÉÞÅÎÉÑÍÉ ÒÁÓÐÒÏÓÔÒÁÎÅÎÉÑ ËÏÐÉÊ ÓÏ -ÓÌÅÄÕÀÝÉÍÉ ÓÏÇÌÁÛÅÎÉÑÍÉ: - -Copyright (c) 1985, 1996 Free Software Foundation - - Permission is granted to anyone to make or distribute verbatim copies - of this document as received, in any medium, provided that the - copyright notice and permission notice are preserved, - and that the distributor grants the recipient permission - for further redistribution as permitted by this notice. - - Permission is granted to distribute modified versions - of this document, or of portions of it, - under the above conditions, provided also that they - carry prominent notices stating who last altered them. - -õÓÌÏ×ÉÑ ËÏÐÉÒÏ×ÁÎÉÑ ÓÁÍÏÇÏ Emacs ÂÏÌÅÅ ÓÌÏÖÎÙÅ, ÎÏ × ÔÏÍ ÖÅ ÄÕÈÅ. -ðÏÖÁÌÕÊÓÔÁ, ÐÒÏÞÔÉÔÅ ÆÁÊÌ COPYING É ÚÁÔÅÍ ÄÁÊÔÅ ËÏÐÉÀ GNU Emacs ×ÁÛÉ -ÄÒÕÚØÑÍ. Help stamp out software obstructionism ("ownership") by using, -writing, and sharing free software! - -// ÚÁÍÅÞÁÎÉÑ, ÉÓÐÒÁ×ÌÅÎÉÑ ÏÛÉÂÏË Ó ÎÅÔÅÒÐÅÎÉÅÍ ÖÄÕ ÐÏ ÁÄÒÅÓÕ bor@vb.dn.ua -// Vladimir Bormotov. \ No newline at end of file diff --git a/etc/TUTORIAL.th b/etc/TUTORIAL.th deleted file mode 100644 index e2319c6..0000000 --- a/etc/TUTORIAL.th +++ /dev/null @@ -1,696 +0,0 @@ - ============================== - GNUEMACS ,T@RIR0-Uh10;Xh19(B (Mule) ,T`0:Wi1M'05i19(B - ============================== - -,TKARB`K05X1(B: ,T`M!JRC)0:Q1:`0:Wi1M'05i1909Ui1(B 0,T6Y1!`0"U1B90"Vi19b4B0BV14K0EQ1!07Uh10Gh1R(B ",TEM'`0Eh19`EB04U1!0Gh1R`0CU1B90CYi1(B" - ,T:CC07Q1407Uh1`0CTh1A05i1904i1GB(B ">>" ,T(P0AU1$S0JQh1'0Gh1R(B 0,T5h1Md;(Pc0Ki17SMPdC(B - - ,Tb4B07Qh1Gd;(B ,T!RC0;i1M9$S0JQh1'c0Ki10!Q1:(B Mule ,T7Sd04i1b4Bc0*i1(B 0,T;Xh1A$M9b7CE(B (0,T;Xh1A07Uh1:9K09i1R0JQ1A0 ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A$M9b7CE0$i1R'd0Gi1(B ,Ta0Ei1G!40;Xh1A(B <0,T5Q1G0MQ1!IC(B> 0,T5Q1GM0Bh1R'`0*h19(B C-f - ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A$M9b7CE0$i1R'd0Gi1(B ,Ta0Ei1G!40;Xh1A(B f -<> - >> ,T5M909Ui1"Mc0Ki1EM'!4(B C-v (View Next Screen 0,T4Y1K09i1R05h1Md;(B) 0,T4Y1(B ,T`0>Wh1M`0EWh1M9d;0Mh1R9K09i1R(B - 0,T5h1Md;(B - 0,T5h1M(R!09Ui1`0;g1905i19d;(B 0,T7X1!$0CQi1'07Uh10Mh1R9K09i1RK09Vh1'(B ,Tf(B ,T(:"Mc0Ki17Sc97S9M'`04U1BG0!Q19(B ,T`0>Wh1M`0EWh1M9d;(B - 0,T4Y1K09i1R05h1Md;(B - -ESC <0,T5Q1G0MQ1!IC(B> ,TKARB06V1'(B ,Tc0Ki1!40;Xh1A(B ESC ,Ta0Ei1G;0Eh1MB(B ,TK0EQ1'(R!09Qi190(V1'!40;Xh1A(B <0,T5Q1G0MQ1!IC(B> ,T5RA(B - -,TKARB`K05X1(B: <0,T5Q1G0MQ1!IC(B> ,Td0Ah10Gh1R`0;g1905Q1GcK0-h1K0CW1M05Q1G`0Eg1!(B ,T(Pc0Ki1$GRAKARB`K0AW1M90!Q19`0AWh1M06Y1!c0*i1c9(B - ,T$S0JQh1'(B 0,T6i1RKR!0AU10;Xh1A(B META ,Tc0Ki1!4(B 0,T!g1(PJRARC6c0*i1!RC!4(B M-<0,T5Q1G0MQ1!IC(B> ,Ta79(B - ,T!RC(B ESC <0,T5Q1G0MQ1!IC(B> ,Td04i1(B (0,T$W1Mc0Ki1!40;Xh1A(B META 0,T$i1R'd0Gi1(B ,Ta0Ei1G0(V1'!4(B <0,T5Q1G0MQ1!IC(B>) - -0,T"i1MJS0$Q1-(B: ,T`GER(P`0ET1!c0*i1(B Emacs ,Tc0Ki1!4(B C-x C-c ,TK0CW1Mc9!C03U107Uh10JQh1'(B Emacs ,T(R!(B csh - 0,T!g1JRARC6c0*i1(B suspend (,TK0BX140*Qh1G$CRG(B) ,Td04i1(B ,T!RC(B suspend Emacs ,T7Sd04i1b4B(B - ,T!4(B C-z - - 0,T5h1M(R!09Ui1(B ,T"Mc0Ki10;i1M9$S0JQh1'(B C-v 0,T7X1!(B ,Tf(B ,T$0CQi1'07Uh10Mh1R9(:K09Vh1'K09i1R(B - - ,T@RBc9K09i1R07Uh1a0Ei1G0!Q1:K09i1R06Q14d;(B ,T(P0AU1`09Wi1MKR0+i1S0!Q19M0BYh1:R':CC07Q14(B 0,T7Uh1`0;g19`0*h1909Ui1(B 0,T!g1`0>Wh1Mc0Ki1JRARC60CYi1(B -,Td04i10Gh1R(B ,T`09Wi1MKR07Uh1aJ4'M0BYh109Qi19(B 0,T5h1M`09Wh1M'0!Q19M0BYh1(B - - - 0,T!h1M90MWh19(B ,T(S`0;g19(P05i1M'0CYi10GT108U1!RCbB!0Bi1RB5SaK09h1'd;AR(B ,T@RBc9a0?i1A0"i1M0AY1E`0JU1B0!h1M9(B ,T5RA07Uh1:M!d;(B -,Ta0Ei1G(B 0,T!g10$W1M(B C-v ,Tc0*i1JSK0CQ1:`0EWh1M9d;0"i1R'K09i1R(B 0,T6i1R(P`0EWh1M9!0EQ1:07Uh1`0!h1R(B 0,T!g1c0Ki1!4(B ESC v - - >> ,TEM'c0*i1(B ESC v ,TaEP(B C-v ,T`0>Wh1M`0EWh1M9d;AR04Y1(B 0,TJQ1!JM'JRA$0CQi1'(B - -,TJ0CX1;(B -=== - ,T$S0JQh1'(B ,TJSK0CQ1:`0EWh1M9d;AR07U1EPK09i1R@RBc9a0?i1A0"i1M0AY1E(B 0,T$W1M(B - - C-v ,T`0EWh1M9d;0"i1R'K09i1R(B ,TK09Vh1'K09i1R(M(B - ESC v ,T`0EWh1M9d;0"i1R'K0EQ1'(B ,TK09Vh1'K09i1R(M(B - C-l ,T`0"U1B9K09i1R(McK0Ah1(B ,TaEPc9"3P`04U1BG0!Q19(B 0,T!g1c0Ki1`0EWh1M95SaK09h1'"M'`$M0Cl1`+M0Cl1(B (cursor) - ,Td;M0BYh15C'!ER'(M(B - - >> ,T"Mc0Ki10JQ1'`!504Y10Gh1R(B ,Tc9"3P09Ui1`$M0Cl1`+M0Cl1M0BYh107Uh1dK9(B ,T>0Ci1MA07Qi1'(S0"i1M$GRA07Uh1M0BYh1CM:0"i1R'"M'(B - ,T`$M0Cl1`+M0Cl104i1GB(B ,Ta0Ei1GEM'!4(B C-l 0,T4Y1(B ,T5CG(JM:04Y10Gh1R(B ,T`$M0Cl1`+M0Cl1`0EWh1M9d;M0BYh107Uh1dK9(B - 0,T"i1M$GRA07Uh1M0BYh1CM:0"i1R'`;0EUh1B9d;M0Bh1R'dC(B - -0,TGT108U1bB!0Bi1RB`$M0Cl1`+M0Cl10"Qi190>Wi190R9(B -======================= - - ,T5M909Ui1(B ,T`CR0!g10CYi10GT108U1bB!0Bi1RBd;ARa::07U1EPK09i1Ra0Ei1G(B 0,T5h1Md;(B 0,T!g1AR`0CU1B90CYi10GT108U1bB!0Bi1RBd;07Uh15SaK09h1'c4(B -,T5SaK09h1'K09Vh1'@RBc9K09i1R`04U1BG0!Q19(B 0,T+Vh1'JRARC67Sd04i1KERB0GT108U1(B 0,TGT108U1K09Vh1'0!g10$W1Mc0Ki1c0*i1$S0JQh1'(B ,Td;:CC07Q140!h1M9K09i1R(B -(previous) ,Td;:CC07Q1405h1Md;(B (next) ,Td;04i1R9K09i1R(B (forward) ,Td;04i1R9K0EQ1'(B (backward) ,T$S0JQh1'(B -,T`K0Eh1R09Ui1(B 0,T6Y1!05Qi1'd0Gi107Uh1(B C-p C-n C-f ,TaEP(B C-b ,T5RAES04Q1:(B 0,T+Vh1'(P7Sc0Ki1bB!0Bi1RBd;ARd04i1(B ,Tb4B`07U1B:0!Q1:(B -,T5SaK09h1'0;Q1(0(X10:Q19(B ,TJ0CX1;`0"U1B9`0;g19a<9@R>d04i104Q1'09Ui1(B - - - ,T:CC07Q1407Uh1a0Ei1G(B C-p - : - : - 0,T5Q1G0MQ1!IC04i1R9K0EQ1'(B C-b .... ,T5SaK09h1'`$M0Cl1`+M0Cl10;Q1(0(X10:Q19(B .... 0,T5Q1G0MQ1!IC04i1R9K09i1R(B C-f - : - : - ,T:CC07Q1405h1Md;(B C-n - - - ,T$S0JQh1'`K0Eh1R09Ui1(B ,T`MRAR(R!05Q1G0MQ1!IC05Q1GaC!"M'(B ,T$S0Gh1R(B Previous Next Backward Forward -0,T+Vh1'(P0*h1GBc0Ki1(Sd04i1d0Ah1BR!(B ,T$S0JQh1'`K0Eh1R09Ui1`0;g19$S0JQh1'JSK0CQ1:!RCbB!0Bi1RB0"Qi190>Wi190R9(B 0,T+Vh1'05i1M'c0*i1M0BYh1`JAM(B - - >> ,TEM'!4(B C-n 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1AR0BQ1':CC07Q1409Ui1(B (,T:CC07Q1407Uh1!S0EQ1'0Mh1R9(B - ,TM0BYh109Ui1(B) - - >> ,TEM'!4(B C-f 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1d;0BQ1'5C'!ER'"M':CC07Q14(B ,Ta0Ei1GEM'(B - ,T!4(B C-p ,T`0EWh1M90"Vi190"i1R':904Y1(B 0,TJQ1'`!504Y104i1GB0Gh1R(B ,T5SaK09h1'"M'`$M0Cl1`+M0Cl1`;0EUh1B9d;M0Bh1R'dC(B - - >> ,TEM'!4(B C-b ,T"3P07Uh1M0BYh107Uh15SaK09h1'K09i1R0JX14"M':CC07Q1404Y1(B 0,TJQ1'`!504Y104i1GB0Gh1R(B ,T`$M0Cl1`+M0Cl1`$0EWh1M9(B - ,Td;M0Bh1R'dC(B ,T(R!09Qi19c0Ki1!4(B C-b 0,TMU1!JM'JRA$0CQi1'(B ,Ta0Ei1G!4(B C-f ,T`0>Wh1M`0EWh1M9d;0BQ1'07i1RB0JX14(B - ,T"M':CC07Q1404Y1(B ,T`$M0Cl1`+M0Cl1(P`0;g19M0Bh1R'dC(B 0,T6i1R!4(9`EB07i1RB:CC07Q14d;(B - - - ,T`GER07Uh1`0EWh1M9`$M0Cl1`+M0Cl1(B ,T(9`EB:CC07Q14aC!0JX14K0CW1M:CC07Q1407i1RB0JX14"M'K09i1Rd;(B ,T`$M0Cl1`+M0Cl1(P(B -,T`0EWh1M9d;0BQ1':CC07Q1405h1Md;c907T1H7R'09Qi19(B ,Tf(B ,TaEP;0CQ1:c0Ki1`$M0Cl1`+M0Cl1!0EQ1:ARM0BYh1:9K09i1R(M`JAM(B - - >> ,TEM'!4(B C-n ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1c0Ki1`EB:CC07Q140Eh1R'0JX14"M'K09i1R(M04Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R(B - ,T`0!T14MPdC0"Vi19(B ,TaEP5SaK09h1'"M'`$M0Cl1`+M0Cl1`;0EUh1B9d;M0Bh1R'dC(B - - 0,T6i1R0CYi10JV1!0Gh1R!RC"0BQ1:d;07U1EP05Q1G0MQ1!IC09Qi190MW14MR40BW14BR4(B 0,T!g1JRARC6c0*i1!RC`0EWh1M9`$M0Cl1`+M0Cl1d;07U1EP$S(B -,Td04i1(B ,T!4(B ESC f ,T`0>Wh1Mc0Ki1`0EWh1M9d;0"i1R'K09i1RK09Vh1'$S(B ,TaEP(B ESC b ,T`0>Wh1Mc0Ki1`0EWh1M9d;0"i1R'K0EQ1'K09Vh1'$S(B - -,TKARB`K05X1(B: ,TJSK0CQ1:@RIRd7B(B 0,TBQ1'd0Ah1JRARC6a0:h1'aB!5SaK09h1'"M'$Sd04i106Y1!05i1M'(B 0,T(V1'd0Ah1(B - ,TJRARC6c0*i1JM'$S0JQh1'09Ui1d04i1(B - - >> ,TEM'!4(B ESC f ,TaEP(B ESC b ,TEM'04Y1KERB(B ,Tf(B ,T$0CQi1'(B ,TaEPEM'c0*i10Ch1GA0!Q1:(B C-f 0,T!Q1:(B C-b 0,T4Y1(B - 0,T4i1GB(B - - ,T(P0JQ1'`!5`0Kg19d04i10Gh1R(B ESC f ,TaEP(B ESC b 0,TAU10CY1;a::$0Ei1RB$0EV1'0!Q1:(B C-f ,TaEP(B C-b ,Tb4B0Jh1G9cK0-h1(B -ESC <0,T5Q1G0MQ1!IC(B> ,T(Pc0*i1`0!Uh1BG0!Q1:!RC0(Q14!RC0"i1M$GRA(B 0,TJh1G9(B C-<0,T5Q1G0MQ1!IC(B> ,T(Pc0*i10!Q1:0JTh1'07Uh1`0;g190>Wi190R9AR!(B -,T!0Gh1R(B (,T`0*h19(B 0,T5Q1G0MQ1!IC(B ,TK0CW1M(B ,T:CC07Q14(B) - - C-a 0,T!Q1:(B C-e ,T`0;g19$S0JQh1'09h1R(P0CYi1d0Gi1(B ,T`>CRP0$h1M90"i1R'JP4G!04U107U1`04U1BG(B C-a ,Tc0*i1JSK0CQ1:`0EWh1M9(B -,T`$M0Cl1`+M0Cl1d;07Uh15SaK09h1'K09i1R0JX14"M':CC07Q14(B C-e ,TJSK0CQ1:`0EWh1M9d;07Uh15SaK09h1'07i1RB0JX14"M':CC07Q14(B - - - >> ,TEM'!4(B C-a 0,T4Y1JM'$0CQi1'(B ,TK0EQ1'(R!09Qi19c0Ki1!4(B C-e 0,T4Y1JM'$0CQi1'(B ,Ta0Ei1GEM'0JQ1'`!504Y10Gh1R(B ,T!RC(B - ,T!4$S0JQh1'09Ui1AR!!0Gh1RJM'$0CQi1'(B ,T(Pd0Ah10*h1GBc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1d;dK9d04i1AR!!0Gh1R09Qi190MU1!(B - - 0,TBQ1'0AU10MU1!JM'$S0JQh1'(B ,TJSK0CQ1:!RC`0EWh1M9`$M0Cl1`+M0Cl1a::0'h1RB(B ,Tf(B 0,T$W1M(B ,T$S0JQh1'(B ESC < ,TJSK0CQ1:!RC`0EWh1M9(B -,T`$M0Cl1`+M0Cl1d;07Uh15SaK09h1'aC!0JX14"M'a0?i1A0"i1M0AY1E(B ,TaEP$S0JQh1'(B ESC > ,TJSK0CQ1:!RC`0EWh1M9d;5SaK09h1'07i1RB0JX14(B - - ,T`CR`0CU1B!5SaK09h1'"M'0"i1M$GRA(B 0,T7Uh10AU1`$M0Cl1`+M0Cl1M0BYh10Gh1R(B "0,T(X14(B (point)" ,TK0CW1M0>Y140MU1!M0Bh1R'K09Vh1'd04i1(B -0,TGh1R(B ,T`$M0Cl1`+M0Cl1(B ,T`0;g190JTh1'07Uh1:M!c0Ki1`CR0CYi10Gh1R(B 0,T(X14(B ,TM0BYh15C'dK9"M'K09i1R(M(B - - ,TJ0CX1;$S0JQh1'JSK0CQ1:!RC`$0EWh1M9d;AR(B 0,T+Vh1'CGA!RC`$0EWh1M907Uh1c9K09h1GB"M'$S(B ,TK09h1GB"M':CC07Q14d0Gi104i1GB(B -,Td04i104Q1'09Ui1(B - - C-f ,Td;0"i1R'K09i1RK09Vh1'05Q1G0MQ1!IC(B - C-b ,T!0EQ1:0"i1R'K0EQ1'K09Vh1'05Q1G0MQ1!IC(B - - ESC f ,Td;0"i1R'K09i1RK09Vh1'$S(B - ESC b ,T!0EQ1:0"i1R'K0EQ1'K09Vh1'$S(B - - C-n ,T`0EWh1M9d;:CC07Q1405h1Md;(B - C-p ,T`0EWh1M9d;:CC07Q1407Uh1a0Ei1G(B - - ESC ] ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M'0Bh1MK09i1R(B (paragraph) - ESC [ ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M'0Bh1MK09i1R(B - - C-a ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M':CC07Q14(B - C-e ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M':CC07Q14(B - - ESC < ,T`0EWh1M9d;5SaK09h1'aC!0JX14"M'a0?i1A0"i1M0AY1E(B - ESC > ,T`0EWh1M9d;5SaK09h1'07i1RB0JX14"M'a0?i1A0"i1M0AY1E(B - - >> ,TEM'c0*i1$S0JQh1'a05h1EP$S0JQh1'04Y1(B ,T$S0JQh1'`K0Eh1R09Ui1`0;g19$S0JQh1'07Uh1c0*i10!Q190:h1MB0JX14(B ,T$S0JQh1'JM'$S0JQh1'K0EQ1'(B - ,T(P`0EWh1M9`$M0Cl1`+M0Cl1(B ,Td;0BQ1'07Uh107Uh10$h1M90"i1R'd!E(B ,Tc0Ki1EM'c0*i1$S0JQh1'(B C-v ,TaEP(B ESC v ,T`0>Wh1M(B - ,T`0EWh1M9`$M0Cl1`+M0Cl1!0EQ1:AR07Uh15C'09Ui1(B - - ,TJSK0CQ1:$S0JQh1'0MWh19(B ,Tf(B ,T"M'(B Emacs 0,T!g1`0*h190!Q19(B ,T$S0JQh1'`K0Eh1R09Ui1(PJRARC6`0>Th1A05Q1G`0EW1M!(B (argument) -,T`0>Wh1M!SK94(B ,T(S9G9$0CQi1'(B ,Tc9!RC;0/T10:Q105T1'R9d04i1(B ,T!RC!SK94(S9G9$0CQi1'(B ,T7Sd04i1b4B!4(B C-u ,Ta0Ei1G5RA(B -0,T4i1GB(S9G9$0CQi1'07Uh105i1M'!RC0!h1M9(B ,Ta0Ei1G0(V1'0$h1MB!4$S0JQh1'5RA(B - - 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B C-u 8 C-f ,TKARB06V1'(B ,Tc0Ki1`0EWh1M9d;0"i1R'K09i1R(B 8 0,T5Q1G0MQ1!IC(B - - >> ,Tc0Ki1EM'!SK94(S9G9$0CQi1'07Uh1`KARPJAJSK0CQ1:$S0JQh1'(B C-n ,TK0CW1M(B C-p ,T`0>Wh1M`0EWh1M9`$M0Cl1`+M0Cl1(B - ,Tc0Ki1ARM0BYh1c!0Ei1:CC07Q1409Ui1c0Ki1AR!07Uh10JX14`07h1R07Uh1(P7Sd04i1(B ,Tc9!RC`0EWh1M9`$M0Cl1`+M0Cl1$0CQi1'`04U1BG(B - - ,TJSK0CQ1:(B C-v ,TaEP(B ESC v ,T(Pd04i1> ,TEM'!4(B C-u 3 C-v 0,T4Y1(B - - ,T`0EWh1M9!0EQ1:07Uh1`0!h1Rd04i1b4B(B C-u 3 ESC v - -,T$S0JQh1'B!`0ET1!(B -========= - - ,T$S0JQh1'(B C-g ,Tc0*i1JSK0CQ1:0JQh1'B!`0ET1!$S0JQh1'05h1R'(B ,Tf(B 0,T7Uh105i1M'!RC!RC0;i1M90"i1M0AY1E`0>Th1A`05T1A(B 0,T5Q1GM0Bh1R'`0*h19(B -,TCPK0Gh1R'07Uh1c0Jh105Q1G`0EW1M!(B (argument) ,TM0BYh1(B ,TK0CW1MCPK0Gh1R'$S0JQh1'07Uh105i1M'!RC!40;Xh1AAR!!0Gh1R(B 2 0,T;Xh1A0"Vi19d;(B 0,T6i1R(B -,TKR!05i1M'!RCB!`0ET1!(B 0,T!g1c0Ki1!4(B C-g - - >> ,TEM'!SK94(S9G9$0CQi1'c0Ki1`0;g19(B 100 ,Tb4B!RC!4(B C-u 100 ,Ta0Ei1G!4(B C-g 0,T4Y1(B ,TK0EQ1'(R!09Qi19(B - ,Tc0Ki1EM'!4(B C-f 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R`$M0Cl1`+M0Cl1`0EWh1M9d;0!Uh105Q1G0MQ1!IC(B ,TK0CW1M5M907Uh1>ER4d;!4(B - ESC ,Tb4Bd0Ah105Qi1'c((B 0,T!g1JRARC6!4(B C-g ,TB!`0ET1!d04i1(B - -0,T"i1M0ER4(B (Error) -================ - - ,Tc9:R'$0CQi1'(B ,TMR((P0AU1!RC0JQh1';0/T10:Q105T1'R9:R'M0Bh1R'(B 0,T7Uh1(B Emacs ,TBMA0CQ1:d0Ah1d04i1`0!T140"Vi19(B 0,T5Q1GM0Bh1R'`0*h19(B -,T!RC!4$S0JQh1'$M9b7CE:R'$S0JQh1'(B 0,T7Uh1d0Ah1d04i1!SK94d0Gi1c9(B Emacs 0,T!g1(P7Sc0Ki1(B Emacs 0,TJh1'`0JU1B'`05W1M9(B -,TaEPaJ4'ER4M0Bh1R'dC(B - - ,T$S0JQh1':R'$S0JQh1'07Uh1`0"U1B9d0Gi1c9`M!JRC)0:Q1:09Ui1(B ,TMR(c0*i1d0Ah1d04i10!Q1:(B Emacs ,T:R'0CXh19(B (version) 0,T+Vh1'(P(B -,T7Sc0Ki10AU1!RCaJ4'ER4(B (error) 0,T"Vi19(B ,Tc9!C03U109Ui1(B ,T"Mc0Ki1!40;Xh1AMPdC0!g1d04i1(B ,T`0>Wh1M`0EWh1M9d;0BQ1'0Jh1G9(B -0,T5h1Md;(B - -0,TGT19b40Gl1(B (Window) -============== - - Emacs ,TJRARC6`0;T140GT19b40Gl1d04i1>0Ci1MA0!Q19KERB0GT19b40Gl1(B ,TaEPc0*i10GT19b40Gl1`K0Eh1R09Qi19aJ4'08l1"M'$S0JQh1':R'$S0JQh1'(B ,TK0CW1M(B Help ,TMM!`0JU1B0!h1M9(B - - C-x 1 ,T7Sc0Ki1`0;g190GT19b40Gl1`04U1BG(B - - ,T$S0JQh1'(B C-x 1 ,Tc0*i1JSK0CQ1:E:0GT19b40Gl10MWh19(B ,Ta0Ei1G"BRB0GT19b40Gl107Uh10AU1`$M0Cl1`+M0Cl1M0BYh1(B ,Tc0Ki1`05g1A(M`0;g19(B -0,TGT19b40Gl1`04U1BG(B - - >> ,Tc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1AR07Uh1:CC07Q1409Ui1(B ,Ta0Ei1G!4(B C-u 0 C-l - - >> ,TEM'!4(B C-h k C-f 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R0GT19b40Gl109Ui1`;0EUh1B9d;M0Bh1R'dC(B ,T`0AWh1M0AU10GT19b40Gl1cK0Ah10+Vh1'(B - ,TM08T1:RB0GT108U1c0*i1$S0JQh1'(B C-f ,T;CR!/0"Vi19(B - - >> ,TEM'!4(B C-x 1 ,T`0>Wh1ME:0GT19b40Gl107Uh1b<0Eh10"Vi19ARcK0Ah1(B ,TMM!(B - -,T!RCa7C!(B (insert) ,TaEP(B ,T!RCE:(B (delete) -=================================== - - ,T:9(B Emacs ,T`CR(PJRARC60>T1A0>l105Q1G0MQ1!IC`0"i1Rd;d04i1`EB(B ,T`0AWh1M05i1M'!RC0>T1A0>l10"i1M$GRA(B Emacs ,T(P(B -0,T6W1M0Gh1R05Q1GK09Q1'0JW1M07Uh1AM'`0Kg19d04i107X1!05Q1G(B (,T`0*h19(B 'A' '7' '*' ',T!(B' ,TaEP0MWh19(B ,Tf(B) ,T`0;g190"i1M$GRA07Uh105i1M'!RC(P(B -,Ta7C!(B (insert) ,T`0"i1Rd;5C'(B ,Tf(B ,T`0AWh1M(P(::CC07Q14(B ,Tc0Ki1!4(B ,T`0>Wh1M`05T1A0MQ1!IC0"Vi19:CC07Q14cK0Ah1(B -(linefeed character) ,Ta7C!`0"i1Rd;(B - - ,Tc0Ki1!4(B ,T`0AWh1M05i1M'!RC(PE:05Q1G0MQ1!IC07Uh1`0>Th1'0>T1A0>l1`0"i1Rd;(B ,TKARB06V1'0;Xh1A`0"U1B9(B -,T:90 -,Tc0*i1JSK0CQ1:E:05Q1G0MQ1!IC07Uh1M0BYh10!h1M9K09i1R5SaK09h1'`$M0Cl1`+M0Cl10;Q1(0(X10:Q19(B - - >> ,TEM'0>T1A0>l105Q1G0MQ1!IC`0"i1Rd;KERB(B ,Tf(B 0,T5Q1G(B ,Ta0Ei1Gc0*i1(B ,TE:05Q1G0MQ1!IC`K0Eh1R09Qi1907Ti1'(B - - >> ,TEM'0>T1A0>l10"i1M$GRAE'd;c0Ki1`0!T19"M:"GR(B (right margin) ,T`GER07Uh10>T1A0>l10"i1M$GRA`0"i1Rd;(B - ,TBRG`0!T19$GRA!0Gi1R'"M'K09Vh1':CC07Q14(B ,T:CC07Q1409Qi190!g1(P(B "0,T6Y1!05h1M(B" ,Tc0Ki1BRG`0!T19K09Vh1'K09i1R(M(B - ,Tb4Bc0Jh1`$0CWh1M'KARB(B '\' ,Td0Gi107Uh1"M:"GR0JX14(B ,T`0>Wh1M:M!c0Ki10CYi10Gh1R:CC07Q1409Ui10BQ1'0AU105h1M(B Emacs ,T(P(B - ,T`0EWh1M9(B (scroll) ,TK09i1R(M`0>Wh1Mc0Ki1`0Kg195SaK09h1'07Uh1!S0EQ1'a0!i1d"M0BYh1d04i1M0Bh1R'0*Q14`(9(B 0,T6i1RKR!(B - ,T"M:"GRK0CW1M"M:0+i1RB"M'0AU1`$0CWh1M'KARB(B '\' ,TM0BYh1(B 0,T!g1`0;g19!RC:M!c0Ki10CYi10Gh1R(B ,T:CC07Q1409Qi190BQ1'0AU105h1M(B - ,Td;c907T1H7R'09Qi19(B ,Tf(B - - ,TEM';0/T10:Q105T104Y1`EB(B ,T$'(P0*h1GBc0Ki1`0"i1Rc(0'h1RB!0Gh1R!RCM08T1:RB04i1GB05Q1GK09Q1'0JW1M(B - - >> ,Tc0Ki1"0BQ1:`$M0Cl1`+M0Cl1d;d0Gi1:9:CC07Q140+Vh1'06Y1!05h1Mc0Ki1BRG`0!T19K09Vh1'K09i1R(M(B 0,T7Uh1`0>Th1'0;i1M9`0"i1Rd;`0AWh1M(B - 0,TJQ1!$0CYh109Ui1(B ,Ta0Ei1Gc0*i1(B C-d ,TE:0"i1M$GRAMM!:R'0Jh1G9(B ,T(9$GRABRG"M'0"i1M$GRAM0BYh1@RBc9K09Vh1'(B - ,T:CC07Q14(B 0,TJQ1'`!504Y10Gh1R`$0CWh1M'KARB(B '\' ,T(PKRBd;(B - - >> ,Tc0Ki1`0EWh1M9`$M0Cl1`+M0Cl1d;d0Gi107Uh15SaK09h1'aC!0JX14"M':CC07Q14(B ,Ta0Ei1G!4(B 0,T4Y1(B ,T!RC7S(B - ,Ta::09Ui1(B ,T(P7Sc0Ki10JQ1-0EQ1!I03l10$Qh19CPK0Gh1R':CC07Q1406Y1!E:MM!d;(B ,T:CC07Q1409Qi190!g1(P06Y1!`MRd;05h1M0!Q1:(B - ,T:CC07Q140!h1M9K09i1R09Qi19(B ,TCGA0!Q19`0;g19:CC07Q14BRG:CC07Q14`04U1BG(B ,TaEPMR((P0AU10JQ1-0EQ1!I03l105h1M:CC07Q14(B - ,T;CR!/0"Vi19(B - - >> ,Tc0Ki1!4(B ,T`0>Wh1M`0>Th1A(B 0,T5Q1G0MQ1!IC0"Vi19:CC07Q14cK0Ah1(B ,T!0EQ1:d;M0Bh1R'`04T1A(B - - ,T$S0JQh1'0Jh1G9cK0-h1"M'(B Emacs ,T(PJRARC6!SK94(S9G9$0CQi1'07Uh105i1M'!RCc0Ki1;0/T10:Q105T1d04i1(B ,TCGA07Qi1'!RC(B -,Ta7C!(B (insert) 0,T5Q1G0MQ1!IC04i1GB(B - - - >> ,TEM'0;i1M9$S0JQh1'(B C-u 8 * 0,T4Y1(B 0,TJQ1'`!504Y10Gh1R`0!T14MPdC0"Vi19(B - - 0,T6i1R05i1M'!RC(P`0>Th1A:CC07Q140Gh1R'(B ,Tf(B (blank line) ,TCPK0Gh1R'JM':CC07Q14(B ,Tc0Ki1`0EWh1M9d;07Uh15SaK09h1'(B -,TaC!0JX14"M':CC07Q1407Uh1JM'(B ,Ta0Ei1G!4(B C-o - - >> ,Tc0Ki1`0EWh1M9d;07Uh15SaK09h1'aC!0JX14"M':CC07Q14c40!g1d04i1(B ,Ta0Ei1GEM'!4(B C-o 0,T4Y1(B - - 0,T6V1'5C'09Ui1(B ,T`CR0!g1d04i1`0CU1B90GT108U10>Wi190R9JSK0CQ1:!RC0;i1M90"i1M$GRA(B ,TaEP!RCa0!i107Uh10 ,TE:05Q1G0MQ1!IC07Uh1M0BYh1K09i1R`$M0Cl1`+M0Cl1(B - C-d ,TE:05Q1G0MQ1!IC07Uh1M0BYh107Uh1`$M0Cl1`+M0Cl1(B - - ESC ,TE:$S07Uh1M0BYh1K09i1R`$M0Cl1`+M0Cl1(B - ESC d ,TE:$S05Qi1'a05h15SaK09h1'07Uh1`$M0Cl1`+M0Cl1M0BYh1(B - - C-k ,TE::CC07Q1405Qi1'a05h15SaK09h1'07Uh1`$M0Cl1`+M0Cl1M0BYh1(B - - ,Tc9:R'$0CQi1'(B ,T`CRMR(05i1M'!RC(P`MR0Jh1G907Uh1E:d;!0EQ1:0$W19AR(B ,Tb;Ca!CA(B Emacs ,T(P(S0Jh1G907Uh1E:(B -,TMM!d0Gi1(B ,T`GER07Uh1E:0"i1M$GRAc9K09h1GB07Uh1AR!!0Gh1RK09Vh1'05Q1G0MQ1!IC(B ,Tc0Ki1c0*i1$S0JQh1'(B C-y ,T`GER07Uh105i1M'!RC(P`MR(B -0,T"i1M$GRA!0EQ1:0$W19(B 0,TJTh1'07Uh1$GCCP0GQ1'0!g10$W1M(B C-y ,Td0Ah1c0*h1c0*i1d04i1`0>U1B'a0$h15SaK09h1'07Uh1E:0"i1M$GRAMM!`07h1R09Qi19(B ,Ta05h1(P(B -,Tc0*i10!Q1:5SaK09h1'c40!g1d04i1(B C-y ,T`0;g19$S0JQh1'JSK0CQ1:a7C!0"i1M$GRA07Uh1`0!g1:d0Gi1(B ,TE'c95SaK09h1'07Uh10AU1`$M0Cl1`+M0Cl1M0BYh1(B -,T`CRJRARC6c0*i1$GRAJRARC609Ui1c9!RC`$0EWh1M90Bi1RB0"i1M$GRAd04i1(B - - ,T$S0JQh1'JSK0CQ1:!RCE:0AU1M0BYh1JM'a::0$W1M(B ,T$S0JQh1'(B "Delete" 0,T!Q1:(B ,T$S0JQh1'(B "Kill" ,T$S0JQh1'(B "Kill" -,T(P`0!g1:0Jh1G9E:MM!d0Gi1(B ,Ta05h1$S0JQh1'(B "Delete" ,T(Pd0Ah1`0!g1:(B ,Ta05h106i1RKR!c0*i1$S0JQh1'09Ui1KERB(B ,Tf(B ,T$0CQi1'(B 0,T!g1(P`0!g1:(B -0,TJh1G907Uh1E:MM!d0Gi1c0Ki1(B - - >> ,Tc0Ki1!4(B C-n 0,TJQ1!JM'JRA$0CQi1'(B ,T`0>Wh1M`0EWh1M9d;0BQ1'07Uh107Uh1`KARPJA:9K09i1R(M(B ,Ta0Ei1GEM'!4(B C-k ,T`0>Wh1M(B - ,TE::CC07Q1409Qi19MM!04Y1(B - - ,T`0AWh1M!4(B C-k ,T$0CQi1'aC!(B 0,T"i1M$GRAc9:CC07Q1409Qi19(P06Y1!E:MM!(B ,TaEP`0AWh1M!40MU1!(B C-k 0,TMU1!$0CQi1'(B ,T:CC07Q14(B -0,T9Qi19`M'07Qi1':CC07Q140!g1(P06Y1!E:MM!d;04i1GB(B ,Ta05h106i1R!SK94(S9G9$0CQi1'c0Ki10!Q1:$S0JQh1'(B C-k 0,T!g1(PKARB06V1'(B ,Tc0Ki1E:(B -,T:CC07Q14MM!(B (0,T7Qi1'`09Wi1MKRaEP05Q1G:CC07Q14(B) ,T`0;g19(S9G9:CC07Q14(B ,T`07h1R0!Q1:(S9G9$0CQi1'07Uh1!SK94(B - - ,T:CC07Q1407Uh1`0>Th1'E:MM!d;(B ,T(P06Y1!`0!g1:d0Gi1(B ,TaEPJRARC69S!0EQ1:0$W19ARd04i1(B ,Tb4Bc0*i1$S0JQh1'(B C-y - - >> ,TEM'!4(B C-y 0,T4Y1(B - - 0,T"i1M$GRA07Uh106Y1!E:MM!(B ,Tb4B!RC!4(B C-k ,TKERB(B ,Tf(B ,T$0CQi1'(B ,T(P06Y1!`0!g1:CG:CGAd0Gi1(B ,TaEPJRARC69S(B -,T!0EQ1:AR07Qi1'KA4d04i1c9$0CQi1'`04U1BG(B ,Tb4B!RC!4(B C-y - - >> ,TEM'!4(B C-k 0,T4Y1KERB(B ,Tf(B ,T$0CQi1'(B - - >> ,T$S0JQh1'JSK0CQ1:`0CU1B!0"i1M$GRA!0EQ1:AR(B 0,T$W1M(B C-y 0,T!h1M90MWh19c0Ki1`0EWh1M9`$M0Cl1`+M0Cl1E'd;0"i1R'0Eh1R'(B - 0,TJQ1!JM'JRA:CC07Q14(B ,Ta0Ei1GEM'!4(B C-y 0,T4Y1(B 0,T!g1(PJRARC60$Q14EM!(B (copy) 0,T"i1M$GRAd04i1(B - - 0,T6i1R5M909Ui1`0!g1:0"i1M$GRAMPdC:R'M0Bh1R'd0Gi1(B ,Ta0Ei1GE:0"i1M$GRA0MWh19`0>Th1A`0"i1Rd;0MU1!(B ,T(P`0!T14MPdC0"Vi19(B -,T08l10$W1M(B C-y ,T(P`0CU1B!0$W19d04i1a0$h1`0>U1B'0"i1M$GRA07Uh1E:MM!$0CQi1'0Eh1R0JX14`07h1R09Qi19(B - - - >> ,TEM'E::CC07Q1404Y1K09Vh1':CC07Q14(B ,Ta0Ei1G`0EWh1M9`$M0Cl1`+M0Cl1d;07Uh10MWh19(B ,Ta0Ei1GE::CC07Q14MM!04Y10MU1!K09Vh1'(B - ,T:CC07Q14(B ,TEM'!4(B C-y 0,T4Y1(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R(Pd04i1a0$h1`0>U1B':CC07Q1407Uh1JM'0$W19`07h1R09Qi19(B - -,T!RC0MQ1904Y1(B (UNDO) -============= - - ,T`GER07Uh1a0!i1d"0"i1M$GRA:R'M0Bh1R'(B ,Ta0Ei1G05i1M'!RC(P`;0EUh1B9!0EQ1:c0Ki1`0;g19M0Bh1R'`04T1A(B 0,T!g1JRARC67Sd04i107X1!(B -,T`0AWh1M04i1GB$S0JQh1'(B C-x u ,Tb4B;!05T1(B ,T(Pc0*i1JSK0CQ1:B!`0ET1!$S0JQh1'(B 0,T7Uh10;i1M9`0"i1Rd;b4Bd0Ah105Qi1'c((B ,TJRARC6c0*i1(B -,T$S0JQh1'09Ui10!Uh1$0CQi1'0!g1d04i15RA05i1M'!RC(B - - >> ,TEM'E::CC07Q1409Ui1MM!04Y1(B 0,T4i1GB$S0JQh1'(B C-k ,Ta0Ei1G`0CU1B!!0EQ1:0$W19AR04i1GB(B C-x u - - ,T$S0JQh1'(B C-_ 0,T!g1`0;g19$S0JQh1'0MQ1904Y10MU1!0MQ19K09Vh1'(B ,T$GRAJRARC6`K0AW1M90!Q1:$S0JQh1'(B C-x u - - ,TJRARC6!SK94(S9G9$0CQi1'c0Ki1$S0JQh1'(B C-_ ,TaEP(B C-x u ,Td04i1(B - - -,Ta0?i1A0"i1M0AY1E(B (File) -============== - - ,T`CR(S`0;g1905i1M'`0!g1:0CQ1!IR(B (save) 0,T"i1M$GRA07Uh1a0!i1d"d0Gi1c9a0?i1A0"i1M0AY1E(B 0,T6i1R05i1M'!RC(Pc0Ki10JTh1'07Uh1(B -,Ta0!i1d"`;0EUh1B9d;M0Bh1R'6RGC(B ,Td0Ah1`0*h1909Qi19(B 0,TJTh1'07Uh1a0!i1d"d;0!g1(PKRBd;(B 0,T7Q1907U107Uh1`0ET1!!RCc0*i1(B Emacs - - ,Ta0?i1A0"i1M0AY1E07Uh1AM'`0Kg19M0BYh1(B 0,T$W1M0JTh1'07Uh10:Q1907V1!0JTh1'07Uh1!S0EQ1'a0!i1d"M0BYh1(B ,TK0CW1M0>Y140'h1RB(B ,Tf(B 0,T!g10$W1Ma0?i1A0"i1M0AY1E07Uh1AM'`0Kg19(B -,TM0BYh10$W1M05Q1Ga0?i1A0"i1M0AY1E07Uh1!S0EQ1'a0!i1d"M0BYh1(B - - ,Ta05h1(9!0Gh1Ra0?i1A0"i1M0AY1E(P06Y1!`0!g1:0CQ1!IR(B (save) ,TE'd;(B ,Ta0?i1A0"i1M0AY1E07Uh106Y1!a0!i1d"M0BYh1(B ,T(Pd0Ah106Y1!`0"U1B907Q1:(B -,TE'd;M0Bh1R'`04g14"R4(B 0,TMQ1909Ui1`0>Wh1M`0;g19!RC0;i1M'0!Q19!RC`0"U1B907Q1:a0?i1A0"i1M0AY1E07Uh1a0!i1d"d;a::$0CVh1'(B ,Tf(B ,T!ER'(B ,Tf(B -,Tb4Bd0Ah1d04i105Qi1'c((B - - ,T9M!(R!09Ui1(B ,T`0>Wh1M`0;g19!RC0;i1M'0!Q19!RC`0!g1:0CQ1!IR(B (save) 0,TJTh1'07Uh1a0!i1d"0Th1A`05T1A`0!Uh1BG0!Q1::CC07Q14bKA4(B (mode line) ,Tc95M9K0EQ1'(B - - ,T$S0JQh1'c0Ki1KRa0?i1A0"i1M0AY1E(B ,TaEP$S0JQh1'c0Ki1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B 0,TAU10EQ1!I3Pa5!05h1R'(R!$S0JQh1'07Uh10 - - >> ,TEM'!4(B C-x C-f ,Ta0Ei1G5RA04i1GB(B C-g 0,T4Y1(B ,T`0;g19!RC0JQh1'B!`0ET1!`09Wi1MKRc90AT109T10:Q1?`?M0Cl1(B ,TK0CW1M(B - ,TB!`0ET1!$S0JQh1'(B C-x C-f 0,T4Q1'09Qi19(B Emacs ,T(Pd0Ah10$i19KRa0?i1A0"i1M0AY1Ec4(B ,Tf(B - - ,T$CRG09Ui1(B ,TAREM'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E04Y1(B ,T`GER07Uh105i1M'!RC`0!g1:0CQ1!IR0JTh1'07Uh1a0!i1d"AR(906V1'5M909Ui1(B 0,T!g1c0Ki1c0*i1(B -,T$S0JQh1'04Q1'09Ui1(B - - C-x C-s ,T`0!g1:0CQ1!IR(B (save) ,Ta0?i1A0"i1M0AY1E(B - - ,Ta0Ei1G`09Wi1MKR07Uh1M0BYh1c9(B Emacs 0,T!g1(P06Y1!`0"U1B9E'd;07Uh1a0?i1A0"i1M0AY1E(B ,T`GER`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B ,Ta0?i1A0"i1M0AY1E(B -0,T5i19)0:Q1:(Pd0Ah10JY1-KRBd;(B ,Ta05h1(P06Y1!`0!g1:d0Gi1c90*Wh1McK0Ah1(B 0,T+Vh1'd04i1AR(R!0*Wh1M`0!h1R07Uh105h1M07i1RB04i1GB(B '~' - - ,TK0EQ1'(R!07Uh1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E`J0Cg1(a0Ei1G(B Emacs 0,T!g1(PaJ4'0*Wh1Ma0?i1A0"i1M0AY1E07Uh1`0!g1:c0Ki104Y1(B - - >> ,TEM'!4(B C-x C-x ,T`0>Wh1M`0!g1:0CQ1!IRJS`9R"M'(B Tutorial 0,T9Ui104Y1(B 0,T!g1(P`0Kg190Gh1R(B 0,T7Uh10Jh1G90Eh1R'(B - ,T"M'(M(B 0,TAU10"i1M$GRA0Gh1R(B "Wrote ...../TUTORIAL.th" ,T;CR!/0"Vi19(B - - ,T`GER07Uh1(PJ0Ci1R'a0?i1A0"i1M0AY1EcK0Ah1(B 0,T!g1c0Ki17SCRG0!Q1:0Gh1R(P0$i19KR(B (find-file) ,Ta0?i1A0"i1M0AY1E`0!h1R0+Vh1'0AU1(B -,TM0BYh10!h1M9K09i1R09Ui1a0Ei1G(B ,Ta0Ei1G0>T1A0>l10"i1M$GRAE'd;c9a0?i1A0"i1M0AY1E07Uh1KR`(M(B - - ,TaEP`GER07Uh10JQh1'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E`07h1R09Qi19(B 0,T$W1M5M907Uh1(B Emacs ,T(P`0!g1:`09Wi1MKR07Uh1a0!i1d"AR07Qi1'KA4(B ,TE'(B -,Tc9a0?i1A0"i1M0AY1E`0;g19$0CQi1'aC!(B - - -0,T:Q1?`?M0Cl1(B (Buffer) -=============== - - 0,T6i1RKR!0JQh1'c0Ki1KRa0?i1A0"i1M0AY1E0MQ1907Uh1JM'(B 0,T4i1GB$S0JQh1'(B C-x C-f ,T`09Wi1MKR"M'a0?i1A0"i1M0AY1EaC!(B 0,T!g1(P0BQ1'$'(B -0,T6Y1!`0!g1:0CQ1!IRM0BYh1c9(B Emacs 0,TJTh1'07Uh1`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E07Uh10Mh1R9`0"i1RAR(B 0,T+Vh1'M0BYh1@RBc9(B Emacs ,T`0CU1B!0Gh1R(B -0,T:Q1?`?M0Cl1(B (Buffer) ,T`GER07Uh10Mh1R9a0?i1A0"i1M0AY1EcK0Ah1`0"i1RAR(B Emacs 0,T!g1(PJ0Ci1R'0:Q1?`?M0Cl1cK0Ah1(B 0,T"Vi19AR@RBc9(B - - 0,T6i1R05i1M'!RC(P04Y1CRB!RC"M'0:Q1?`?M0Cl1(B 0,T7Uh106Y1!`0!g1:0CQ1!IRM0BYh1@RBc9(B Emacs 0,T!g1c0Ki1!4$S0JQh1'(B - - C-x C-b - - >> ,TEM'!4(B C-x C-b 0,T4Y1(B 0,TJQ1'`!504Y10Gh1Ra05h1EP0:Q1?`?M0Cl10AU10*Wh1M0Gh1RMPdC(B ,TaEP06Y1!05Qi1'0*Wh1Md0Gi10Gh1R(B - ,TM0Bh1R'dC(B ,Tc9(B Emacs - - 0,TAU1:R'0:Q1?`?M0Cl1(B 0,T7Uh1d0Ah10AU10$Yh10!Q1:a0?i1A0"i1M0AY1E(0CT1'(B ,Tf(B 0,T5Q1GM0Bh1R'`0*h19(B ,Td0Ah10AU1a0?i1A0"i1M0AY1E07Uh10AU10*Wh1M0Gh1R(B "*Buffer -List*" ,TM0BYh1(0CT1'(B ,Tf(B ,Ta05h1`0;g190:Q1?`?M0Cl107Uh1J0Ci1R'0"Vi19AR`0>Wh1MaJ4'CRB!RC0:Q1?`?M0Cl1(B ,Tb4B$S0JQh1'(B C-x C-b - - 0,T"i1M$GRA07X1!0"i1M$GRA07Uh1;CR!/M0BYh1c90GT19b40Gl1"M'(B Emacs 0,T9Qi19(B ,T(PM0BYh1c90:Q1?`?M0Cl1c40:Q1?`?M0Cl1K09Vh1'`JAM(B - - >> ,TEM'!4(B C-x 1 ,T`0>Wh1ME:CRB!RC0:Q1?`?M0Cl1MM!04Y1(B - - ,T!RC`0CU1B!a0?i1A0"i1M0AY1E0MWh190"Vi19ARa0!i1d"(B ,T5M907Uh1!S0EQ1'a0!i1d"a0?i1A0"i1M0AY1EK09Vh1'M0BYh109Qi19(B ,T(Pd0Ah17Sc0Ki1a0?i1A0"i1M0AY1E(B -,TaC!06Y1!`0!g1:0CQ1!IR(B 0,TJTh1'07Uh1a0!i1d"d;c9a0?i1A0"i1M0AY1EaC!(P06Y1!0:Q1907V1!d0Gi1c90:Q1?`?M0Cl1"M'a0?i1A0"i1M0AY1E09Qi19(B ,T`07h1R09Qi19(B - - ,T!RCJ0Ci1R'0:Q1?`?M0Cl1cK0Ah10"Vi19(B ,TJSK0CQ1:a0!i1d"a0?i1A0"i1M0AY1E0MQ1907Uh1JM'(B ,Ta0Ei1Ga0!i1MPdC:R'M0Bh1R'c90:Q1?`?M0Cl109Qi19(B -,T(Pd0Ah10AU1Wh1M(B -,Ta0!i1d"c95M9K0EQ1'(B - - ,Ta05h1`GER07Uh105i1M'!RC(P`0!g1:0CQ1!IR(B (save) 0,T:Q1?`?M0Cl1E'd;c9a0?i1A0"i1M0AY1E(B 0,T4i1GB$S0JQh1'(B C-x C-s 0,T9Qi19(B -,T(P05i1M'J0GT170+l1d;0BQ1'0:Q1?`?M0Cl107Uh105i1M'!RC(P`0!g1:(B 0,T4i1GB$S0JQh1'(B C-x C-f 0,T+Vh1'0$h1M90"i1R'0BXh1'BR!(B ,T`CR0AU1$S0JQh1'0+Vh1'(B -,Tc0*i1JSK0CQ1:!RC09Ui1b4B`)>RP(B 0,T$W1M(B - - C-x s ,T`0!g1:0CQ1!IR(B (save) 0,T7X1!0:Q1?`?M0Cl107Uh10AU1M0BYh1(B - - C-x s ,T(P`0!g1:0CQ1!IR07X1!0:Q1?`?M0Cl107Uh106Y1!a0!i1d"`09Wi1MKRd;(B ,TE'c9a0?i1A0"i1M0AY1E(B ,Tb4B(P6RA0!h1M90Gh1R(Pc0Ki1(B -,T`0!g1:0:Q1?`?M0Cl109Ui1dKA(B y ,TK0CW1M(B n 0,T!Q1:0:Q1?`?M0Cl1a05h1EP0:Q1?`?M0Cl1(B ,T$S6RA(P;CR!/c90Jh1G90Eh1R'"M'K09i1R(M(B 0,T4Q1'(B -0,T5Q1GM0Bh1R'09Ui1(B - - Save file /usr/private/yours/TUTORIAL.th? (y or n) - - - -,T!RC"BRB$S0JQh1'(B (extension) -======================= - - ,Tc9b;Ca!CA(B Editor 0,T9Ui1(B 0,TAU1(S9G9$S0JQh1'AR!!0Gh1R(B ,T(S9G9$S0JQh1'0+Vh1'JRARC6!4d04i1b4B0;Xh1A$M9b7CE(B -,TK0CW1M0;Xh1A(B META ,Td04i1KA4(B ,T$S0JQh1'"BRB(B (eXtend) 0,TAU1d0Gi1`0>Wh1Mc0Ki1JRARC6c0*i1$S0JQh1'`K0Eh1R09Ui1d04i1KA4(B 0,TAU1M0BYh1(B 2 -,Ta::(B 0,T4Q1'09Ui1(B - - C-x ,T"BRB`0>Th1A04i1GB05Q1G0MQ1!IC(B ,TJSK0CQ1:!405Q1G0MQ1!IC5RA`0"i1Rd;(B 1 0,T5Q1G(B - ESC x ,T"BRB`0>Th1A04i1GB0*Wh1M$S0JQh1'(B ,TJSK0CQ1:!40*Wh1M$S0JQh1'5RA`0"i1Rd;07Qi1'KA4(B - - ,T$S0JQh1';CP`@709Ui1(B 0,T!g1`0;g19$S0JQh1'07Uh10AU1;CPbB*09l1(B ,Ta05h10Jh1G9cK0-h1(P06Y1!`0CU1B!c0*i1(B 0,T9i1MB$0CQi1'!0Gh1R$S0JQh1'07Qh1Gd;(B -0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'KRa0?i1A0"i1M0AY1E(B (find) C-x C-f ,T$S0JQh1'`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B (save) C-x C-s -,T$S0JQh1'(B C-x C-c (,T`0ET1!(B Editor) 0,T5h1R'0!g1`0;g19K09Vh1'c9$S0JQh1'`K0Eh1R09Ui1(B - - ,T$S0JQh1'(B C-z ,T`0;g19$S0JQh1'07Uh1c0*i1c9c9!RCMM!(R!(B Emacs 0,T$h1M90"i1R'0:h1MB(B ,T$S0JQh1'09Ui1(Pd0Ah1B!`0ET1!(B -Emacs ,T`EB07U1`04U1BG(B ,Ta05h1(PK0BX14(B Emacs ,Td0Gi10*Qh1G$CRG(B ,T`0>Wh1Mc0Ki1JRARC6!0EQ1:d;c0*i1(B csh ,Td04i10MU1!(B ,T!RC!4(B -C-z 0,T(V1'`0;g19!RCK0BX14(B Emacs ,Td0Gi10*Qh1G$CRG`07h1R09Qi19(B ,T(Pd0Ah17S$GRA`0JU1BKRBc0Ki10!Q1:`09Wi1MKR07Uh1a0!i1d"d;(B - -,TKARB`K05X1(B: ,Ta05h170Gh1R(B ,Tc9!C03U107Uh1c0*i1:9(B X-window ,TK0CW1Mc0*i1(B sh ,TM0BYh1(B 0,T!g1(Pd0Ah10AU1$GRAJRARC609Ui1(B - - - ,T$S0JQh1';CP`@7(B C-x 0,TAU1AR!ARBKERB$S0JQh1'(B ,T$S0JQh1'07Uh1M08T1:RBd;a0Ei1G0AU104Q1'09Ui1(B - - C-x C-f ,TKRa0?i1A0"i1M0AY1E(B (find) ,TJSK0CQ1:a0!i1d"(B - C-x C-s ,T`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E(B (save) - C-x C-b ,TaJ4'CRB!RC0:Q1?`?M0Cl1(B (buffer list) - C-x C-c ,T`0ET1!!RCc0*i1(B Editor ,TaEP`0!g1:0CQ1!IRa0?i1A0"i1M0AY1Eb4B0MQ15b90AQ105T1(B ,Ta05h106i1RKR!0AU1a0?i1A(B - 0,T"i1M0AY1E:R'0MQ1906Y1!a0!i1d"(B 0,T!g1c0Ki16RA0Gh1R(P`0!g1:0CQ1!IRa0?i1A0"i1M0AY1E09Qi19dKA(B ,Tb4B07Qh1Gd;(B - ,T!RCMM!(R!(B Emacs ,T7Sd04i1b4B$S0JQh1'(B C-x C-s C-x C-c 0,T$W1Mc0Ki1`0!g1:0CQ1!IR(B - 0,T!h1M9a0Ei1G0(V1'`0ET1!(B - - ,T$S0JQh1'"BRB`0>Th1Aa::0*Wh1M09Qi19(B ,Tc0*i1JSK0CQ1:$S0JQh1'07Uh1d0Ah10$h1MBd04i1c0*i1(B ,TK0CW1M$S0JQh1'07Uh1c0*i1`)>RP0!Q1:bKA40>T1`HI:R'(B -,TbKA4(B 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B "command-apropos" 0,T+Vh1'(P6RA(B 0,T$U10Bl1`0GT10Cl14(B (keyword) ,Ta0Ei1GaJ4'> ,TEM'!4(B ESC x ,T5RA04i1GB(B "command-apropos" ,TK0CW1M(B - "command-a" ,TK0EQ1'(R!09Qi190!g1!4(B "kanji" 0,T4Y1(B - - ,Tc0Ki1!4(B C-x 1 ,T`GER05i1M'!RC(PE:(B "0,TGT19b40Gl1(B" 0,T7Uh1b<0Eh10"Vi19ARcK0Ah1(B - -,T:CC07Q14bKA4(B (Mode Line) -===================== - - ,T`GER07Uh10>T1A0>l1$S0JQh1'`0"i1Rd;0*i1R(B ,Tf(B Emacs ,T(PaJ4'0JTh1'07Uh10>T1A0>l1E'd;5C':CC07Q140Eh1R'0JX14"M'(M0+Vh1'`0CU1B!(B -0,TGh1R(B echo area ,T:CC07Q140+Vh1'M0BYh106Q140"Vi19ARK09Vh1':CC07Q14(B ,T`0CU1B!0Gh1R:CC07Q14bKA4(B (mode line) ,T:CC07Q14(B -,TbKA40AU10EQ1!I3P04Q1'09Ui1(B - - - [--]J:--**-Mule: TUTORIAL.th (Fundamental) ---NN%-------------- - - -,TKARB`K05X1(B: ,T5C'0Jh1G9(B NN ,T"M'(B NN% ,T(P0AU105Q1G`E"c0Jh1M0BYh1(B ,T:CC07Q14bKA407Uh1aJ4'M0BYh1MR((Pa5!05h1R'(B - ,Td;(R!05Q1GM0Bh1R'0:i1R'(B ,Ta05h10!g1d0Ah1`0;g19dC(B 0,T5Q1GM0Bh1R'`0*h19(B ,TMR((P0AU1`GERK0CW1M(B uptime - ,TaJ4'D05T1!CCA07Uh1a5!05h1R'0!Q19b4B0JTi19`0*T1'(B ,T`0AWh1MM0BYh1c9bKA4K0EQ1!07Uh105h1R'0!Q19(B 0,T5Q1GM0Bh1R'(B -,T`0*h19(B ,T`GERb;Ca!CA@RIR(B ,T(P0AU1$S0JQh1'JSK0CQ1:J0Ci1R'(B ,TKARB`K05X1(B (comment) ,TM0BYh1(B ,T`09Wh1M'(R!0GT108U1c0Jh1(B -,TKARB`K05X1"M'@RIRa05h1EP@RIRa5!05h1R'0!Q19(B ,T$S0JQh1'09Ui10!g1(Pa5!05h1R'0!Q19d;c9a05h1EPbKA4K0EQ1!(B ,T`0>Wh1Mc0Ki1(B -,TJRARC6c0Jh1KARB`K05X1c9a05h1EP@RIRd04i1M0Bh1R'06Y1!05i1M'(B - - ,T$S0JQh1'JSK0CQ1:!RC`;0EUh1B9bKA4c0Ki1`0;g19bKA4K0EQ1!0MWh19(B 0,T$W1M$S0JQh1'"BRB(B (extend) 0,T+Vh1'0*Wh1M$S0JQh1'`0;g190*Wh1M(B -,TbKA4(B 0,T5Q1GM0Bh1R'`0*h19(B ,T$S0JQh1'(B M-x fundamental-mode 0,T$W1M$S0JQh1'JSK0CQ1:`;0EUh1B9bKA4`0;g19bKA4(B -Fundamental - - ,T`GER07Uh1(Pa0!i1d"a0?i1A0"i1M0AY1E@RIR0MQ1'!DI(B 0,T!g1c0Ki1c0*i1(B Text mode - - >> ,TEM'0;i1M9$S0JQh1'(B M-x text-mode - - 0,T6i1R05i1M'!RCKR0"i1M0AY1E`0>Th1A`0!Uh1BG0!Q1:bKA4K0EQ1!07Uh1c0*i1M0BYh1c90;Q1(0(X10:Q19(B 0,T!g1c0Ki10;i1M9$S0JQh1'(B C-h m - - >> ,Tc0Ki1!4(B C-h m ,T`0>Wh1M0HV1!IR0"i1Ma5!05h1R'CPK0Gh1R'(B Text mode 0,T!Q1:(B Fundamental mode - - >> ,Tc0Ki1!4(B C-x 1 ,T`0>Wh1ME:`M!JRCMM!(R!(M(B - - ,T5C'0Jh1G90+i1RB"M':CC07Q14bKA4(B ,T(P0AU10JQ1-0EQ1!I03l1(B '[--]' ,T`0>Wh1MaJ4'bKA4JSK0CQ1:!RC0;i1M90"i1M0AY1E(B -(input mode) ,TM0BYh1(B 0,TJQ1-0EQ1!I03l1(B [--] ,TKARB06V1'JRARC60;i1M90"i1M0AY1Ed04i104i1GB05Q1G0MQ1!IC@RIR0MQ1'!DI(B -(English alphabets) ,T!0CX13R0Mh1R90$Yh10AW1M"M'(B "Tamago" ,TJSK0CQ1:CRBEP`0MU1B4"M'0GT108U1c0*i1(B - - ,TaEP5C'04i1R9"GR"M'0JQ1-0EQ1!I03l109Qi19(B ,T(P0AU1`$0CWh1M'KARBaJ4'J6R9P"M'(B flag ,T"M'CP::C0KQ1J(B -(coding-system) ,TM0BYh1(B Mule ,TJRARC6!SK94CP::C0KQ1JaB!`)>RPJSK0CQ1:(B ,T!RC`0!g1:0Mh1R9a0?i1A0"i1M0AY1E(B -,T!RC0;i1M90"i1M0AY1E(R!0$U10Bl1:M0Cl14(B ,T!RCaJ4'RP(B -0,TJQ1-0EQ1!I03l10*h1GB(S(B (mnemonic) ,T"M'CP::C0KQ1JJSK0CQ1:!RC`0!g1:0Mh1R9a0?i1A0"i1M0AY1E(B ,T`07h1R09Qi19(B - - >> ,T5CG(04Y10Gh1R0AU10JQ1-0EQ1!I03l1(B ,T$0Ei1RB$0EV1'0!Q1:(B "J:" "S:" "E:" ,TaJ4'M0BYh107Uh1:CC07Q14bKA4K0CW1Md0Ah1(B - - 0,T5Q1G0MQ1!IC05Q1GaC!0$W1M(B 0,TJQ1-0EQ1!I03l10*h1GB(S(B (mnemonic) ,T"M'CP::C0KQ1J07Uh1c0*i1M0BYh1(B 0,T5Q1G(B ':' ,TaJ4'c0Ki10CYi1(B -0,TGh1R0AU105Q1G0MQ1!IC"M'@RIR0MWh19(B ,T9M!(R!@RIR0MQ1'!DIaJ4'M0BYh1(B (,T`0*h19(B ,T@RIR0(U19(B ,T@RIR0-Uh10;Xh19(B ,T`0;g1905i19(B) 0,T5Q1G(B J -,TKARB06V1'(B ,TC0KQ1J07Uh1c0*i10!Q1:(B JUNET 0,T$W1M(B ,TC0KQ1J(B JIS 0,T5Q1G(B S ,TKARB06V1'(B Shift-JIS ,TaEP(B 0,T5Q1G(B E ,TKARB06V1'(B -,TC0KQ1J(B EUC ,T@RIR0-Uh10;Xh19(B ,T(PJ0EQ1:`;0EUh1B9(B (toggle) ,T!RCaJ4'> ,TEM'0;i1M9$S0JQh1'(B C-x C-k t 0,T4Y1JM'$0CQi1'(B - - 0,T6i1R`7M0Cl10AT109Q1E07Uh1c0*i1M0BYh10AU10;Xh1A(B META ,TaEPbKA407Uh1c0*i1M0BYh1`0;g19C0KQ1J(B JIS ,T`CR0!g1(PJRARC6c0*i10;Xh1A(B META -,Ta79!RC!40;Xh1A(B ESCAPE ,Td04i1(B 0,TGT108U1c0*i1(P`K0AW1M90!Q1:!RCc0*i10;Xh1A$M9b7CE(B 0,T$W1Mc0Ki1!40;Xh1A(B META 0,T$i1R'd0Gi1a0Ei1G0(V1'(B -,T!405Q1G0MQ1!IC5RA(B M-<0,T5Q1G0MQ1!IC(B> ,T(P7SK09i1R07Uh1`K0AW1M90!Q1:(B ESC <0,T5Q1G0MQ1!IC(B> 0,T9Qh190$W1M(B 0,T7X1!M0Bh1R'07Uh1M08T1:RBAR(B -,T(906V1'0(X1409Ui1(B ,T(P0BQ1'$'0AU1 ,Tc0Ki1`0;g19(B M-<0,T5Q1G0MQ1!IC(B> ,Ta05h10"i1M(B -,T$GCCP0GQ1'0!g10$W1M(B 0,T;Xh1A(B META ,T(Pd0Ah1JRARC6c0*i1d04i10!Q1:C0KQ1J(B Shift-JIS ,TaEP(B EUC - - ,T!RC`;0EUh1B9CP::C0KQ1J(P0AU1U1B'0!Q1:a05h1EP0:Q1?`?M0Cl1`07h1R09Qi19(B ,TJRARC604Y1$S0JQh1'`0!Uh1BG0!Q1:CP::C0KQ1J(B -,Td04i1b4B$S0JQh1'(B C-h a coding-system - - >> ,Tc0Ki10;i1M9$S0JQh1'(B C-h a coding-system ,Ta0Ei1G0Mh1R9CRBEP`0MU1B4"M'$S0JQh1'(B - set-display-coding-system set-file-coding-system ,TaEP(B - set-process-coding-system ,T(R!`M!JRC07Uh1;CR!/0"Vi19(B - -,T!RC0$i19KR(B (search) -================ - - Emacs ,TJRARC60$i19KRJRB0MQ1!"CP(B (string) ,T@RBc9a0?i1A0"i1M0AY1Ed;7R'0"i1R'K09i1RK0CW1M0"i1R'K0EQ1'd04i1(B -0,T6i1R05i1M'!RC0$i19KRd;7R'0"i1R'K09i1R"M'5SaK09h1'`$M0Cl1`+M0Cl1(B (cursor) 0,T!g1c0Ki1!4(B C-s 0,T6i1R05i1M'!RC0$i19KR(B -,Td;7R'0"i1R'K0EQ1'"M'5SaK09h1'`$M0Cl1`+M0Cl1(B 0,T!g1c0Ki1!4(B C-r ,TK0EQ1'(R!09Qi19(P0AU10"i1M$GRA0Gh1R(B "I-search:" -,T;CR!/0"Vi195C'(B echo area ,TB!`0ET1!!RC0$i19KRd04i104i1GB!RC!4(B ESC - - - >> ,T!4(B C-s ,T`0>Wh1M`0CTh1A!RC0$i19KR(B ,Ta0Ei1G!405Q1G0MQ1!IC"M'$S0Gh1R(B "cursor" ,TE'd;07U1EP05Q1GM0Bh1R'(B - 0,T*i1R(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R`$M0Cl1`+M0Cl1"0BQ1:d;M0Bh1R'dC(B - - >> ,TEM'!4(B C-s 0,T4Y10MU1!K09Vh1'$0CQi1'`0>Wh1M0$i19KR$S0Gh1R(B "cursor" 0,T5Q1G05h1Md;(B - - >> ,T!4(B 0,T4Y1(B 4 ,T$0CQi1'(B ,Ta0Ei1G0JQ1'`!504Y10Gh1R!RC`$0EWh1M907Uh1"M'`$M0Cl1`+M0Cl1(B - - >> ,T!4(B ESC ,T`0>Wh1MB!`0ET1!!RC0$i19KR(B - - ,T!RC0$i19KR(P`0CTh1A0"Vi1907Q1907U1(B ,Tc9CPK0Gh1R'07Uh10>T1A0>l1JRB0MQ1!"CP07Uh105i1M'!RC(P0$i19KR(B ,T`0"i1Rd;`0>U1B':R'0Jh1G9(B -0,T6i1R05i1M'!RC(P0$i19KR05Q1G05h1Md;(B 0,T!g1c0Ki1!4(B C-s 0,TMU1!K09Vh1'$0CQi1'(B 0,T6i1RKR!0$i19KRJRB0MQ1!"CP07Uh10;i1M9`0"i1Rd;d0Ah1>:(B 0,T!g1(B -,T(P0AU10"i1M$GRA;CR!/0"Vi19(B ,Tc0Ki1!4(B C-g ,T`0>Wh1MB!`0ET1!(B - - ,TCPK0Gh1R'07Uh10$i19KRM0BYh1(B 0,T6i1R!4(B 0,T5Q1G0MQ1!IC05Q1G0JX1407i1RBc9JRB0MQ1!"CP0!g1(P06Y1!E:d;(B ,Ta0Ei1G(B -,T`$M0Cl1`+M0Cl10!g1(P!0EQ1:d;5SaK09h1'0!h1M9K09i1R(B 0,T5Q1GM0Bh1R'`0*h19(B 0,T6i1R!4(B "cu" 0,T!g1(P0$i19KRd;06V1'5SaK09h1'07Uh10AU1$S0Gh1R(B -"cu" ,Ta05h106i1R!4(B ,Tc90(Q1'KGP09Ui1(B 0,T5Q1G(B 'u' ,Tc9(B search line 0,T!g1(PKRBd;(B ,Ta0Ei1G`$M0Cl1`+M0Cl1(B -,T(P"0BQ1:!0EQ1:d;07Uh15SaK09h1'07Uh10AU105Q1G(B 'c' ,TM0BYh1(B - - 0,T6i1R!405Q1G0MQ1!IC$M9b7CE(B (control character) 0,T5Q1G0MWh19(B ,T9M!`K09W1M(R!(B C-s ,TK0CW1M(B C-r -,T!RC0$i19KR0!g1(P0JTi190JX14E'(B - - ,T$S0JQh1'(B C-s ,T(P0$i19KRJRB0MQ1!"CP07Uh105i1M'!RC(B ,Td;7R'0"i1R'K09i1R"M'5SaK09h1'`$M0Cl1`+M0Cl1(B 0,T6i1R05i1M'!RC(B -0,T$i19KRd;7R'07T1HK0EQ1'(B 0,T!g1c0Ki1!4(B C-r 0,T9Qh190$W1M(B ,TJRARC6c0*i1(B C-s ,TaEP(B C-r ,TJ0EQ1:0!Q19`0>Wh1M0$i19KRd;d04i1c907Qi1'(B -,TJM'07T1H7R'(B C-s ,TaEP(B C-r ,T7SK09i1R07Uh1`K0AW1M90!Q1907X1!;CP!RC(B ,T(P05h1R'0!Q190!g15C'07T1H7R'!RC0$i19KR`07h1R09Qi19(B - -Recursive Editing Level - - ,T:R'07U1(B ,T`CRMR((PK0EX14`0"i1Rd;M0BYh1c9J6R9P07Uh1`0CU1B!0Gh1R(B Recursive Editing Level ,Td04i1b4B(B -,Td0Ah105Qi1'c((B ,Tc9bKA409Ui1(B ,T`$0CWh1M'KARBG'`0Eg1:(B '()' 0,T7Uh1aJ4'0*Wh1MbKA4K0EQ1!(B (major mode) ,TM0BYh1(P0AU1G'`0Eg1:(B -'[]' 0,TEi1MA(B ,T`0>Th1A0"Vi190MU1!K09Vh1'0*Qi19(B 0,T5Q1GM0Bh1R'`0*h19(B 0,T6i1R`04T1A`0;g19(B (Fundamental) ,TM0BYh1(B 0,T!g1(P`;0EUh1B9`0;g19(B -[(Fundamental)] ,Ta79(B - -,TKARB`K05X1(B: ,T`CR(Pd0Ah1M08T1:RB`0!Uh1BG0!Q1:(B Recursive Editing Level ,Tc907Uh109Ui1(B - - ,Tc0Ki1!4(B M-x top-level ,T`0>Wh1M07Uh1(PMM!(R!(B Recursive Editing Level - - >> ,TEM'!404Y1(B ,T5C'0Jh1G90Eh1R'"M'(M(P0AU10"i1M$GRA0Gh1R(B "Back to top level" ,T;CR!/0"Vi19(B - - ,T`09Wh1M'(R!(B ,T`CRM0BYh1c9CP04Q1::90JX14(B (top level) ,TM0BYh1a0Ei1G(B ,T$S0JQh1'09Ui10(V1'd0Ah10AU1Wh1M07Uh1(PMM!(R!(B Recursive Editing Level ,Td04i1(B - - -Help -==== - - Emacs 0,TAU1$GRAJRARC607Uh10AU1;CPbB*09l1(B ,TAR!ARBKERBM0Bh1R'(B 0,T+Vh1'd0Ah1JRARC6M08T1:RBd04i1KA4c907Uh109Ui1(B -,Ta05h1`CR(PJRARC6`0CU1B!c0*i1(B ,T`0>Wh1M07Uh1(P`0CU1B90CYi1$GRAJRARC6`K0Eh1R09Ui1(B ,Td04i1b4B!RC!4(B C-h 0,T+Vh1'(P(B -0,T*h1GBc0Ki1`CRd04i10CQ1:0CYi10"i1M0AY1E`0>Th1A`05T1AKERBM0Bh1R'(B - - 0,TGT108U1c0*i10$W1Mc0Ki1!4(B C-h ,Ta0Ei1G5RA04i1GB05Q1G`0EW1M!(B (option) 0,TMU1!K09Vh1'05Q1G0MQ1!IC(B 0,T6i1Rd0Ah10CYi10Gh1R(P05i1M'c0*i1(B -0,T5Q1G`0EW1M!MPdC(B 0,T!g1c0Ki1!4(B C-h ? ,Ta0Ei1G(P0AU1$SM08T1:RB`0!Uh1BG0!Q1:05Q1G`0EW1M!;CR!/0"Vi19(B ,Td04i1KR!`;0EUh1B9c((P(B -,Td0Ah1`0CU1B!(B HELP ,TK0EQ1'(R!!4(B C-h 0,T!g1c0Ki1!4(B C-g ,T`0>Wh1MB!`0ET1!d04i1(B - - ,T$S0JQh1'(B HELP 0,T>Wi190R907Uh10JX140MQ19K09Vh1'0!g10$W1M(B C-h c ,Ta0Ei1G5RA04i1GB!RC!4$S0JQh1':R'$S0JQh1'(B 0,T+Vh1'(Pc0Ki1$S(B -,TM08T1:RB0JQi19(B ,Tf(B ,T`0!Uh1BG0!Q1:$S0JQh1'09Qi19(B - - >> ,TEM'!4(B C-h c C-p 0,T4Y1(B 0,T+Vh1'(Pc0Ki10"i1M$GRA0Gh1R(B - "C-p runs the command previous-line" - - ,T$S0JQh1'09Ui1(P0*h1GB0CWi1M0?Wi19$GRA(S(B ,T`0!Uh1BG0!Q1:$S0JQh1'07Uh1`$B0> ,TEM'!4(B C-h k C-p 0,T4Y1(B - - 0,T!g1(P0AU10GT19b40Gl1`0>Th1Ac9(B Emacs 0,TMU1!K09Vh1'0MQ19(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4"M'$S0JQh1'09Qi19(B ,T`0AWh1M0Mh1R9(:a0Ei1G(B -0,T!g1c0Ki1!4(B C-x 1 ,T`0>Th1AE:0GT19b40Gl1MM!(B - - 0,T5Q1G`0EW1M!0MWh1907Uh10AU1;CPbB*09l1(B 0,TAU104Q1'09Ui1(B - - C-h f ,Tc0Ki1c0Jh10*Wh1M"M'$S0JQh1'(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4`0!Uh1BG0!Q1:$S0JQh1'09Qi19(B - - >> ,Tc0Ki1!4(B C-h f previous-line ,Ta0Ei1G5RA04i1GB(B ,T`0>Wh1MaJ4'CRBEP`0MU1B4`0!Uh1BG(B - 0,T!Q1:$S0JQh1'0+Vh1'`0CU1B!c0*i1d04i1(R!!RC!4(B C-p - - C-h a ,Ta0Ei1G5RA04i1GB0$U10Bl1`0GT10Cl14(B (keyword) ,T`0>Wh1MaJ4'$S0JQh1'07X1!$S0JQh1'(B 0,T7Uh10AU10$U10Bl1`0GT10Cl14(B ,TCGAM0BYh1(B - ,T$S0JQh1'`K0Eh1R09Ui1JRARC6`0CU1B!c0*i1d04i1b4B!RC!4(B ESC x - - >> ,TEM'!4(B C-h a file ,Ta0Ei1G5RA04i1GB(B ,T`0>Wh1MaJ4'0*Wh1M$S0JQh1'07X1!$S0JQh1'07Uh10AU1$S0Gh1R(B - "file" ,TCGAM0BYh1(B 0,T+Vh1'(P0AU1(B find-file ,TaEP(B write-file 0,T7Uh1`0CU1B!c0*i1d04i1b4B!RC!4(B - C-x C-f ,TaEP(B C-x C-w ,TCGAM0BYh104i1GB(B - -0,T7i1RB0JX1409Ui1(B -====== - -,TM0Bh1R0EW1A(B: ,T$S0JQh1'JSK0CQ1:!RC`0ET1!(B Emacs 0,T$W1M(B C-x C-c - - - ,T`M!JRC)0:Q1:`0:Wi1M'05i1909Ui1(B 0,T5Qi1'c(`0"U1B90"Vi19JSK0CQ1:0RP(B 0,T6i1RKR!0AU10(X14dK907Uh1d0Ah1(B -,T`0"i1Rc((B 0,T!g1M0Bh1R0AQ1Ga05h1b7I05Q1G`M'(B ,Ta05h1"Mc0Ki1bB9$GRA0RP(B -,TM0Bh1R'0BTh1'0!Q1:(B EMACS ,T`09Wh1M'(R!`0;g19b;Ca!CA07Uh10AU1$GRAJRARC6KER!KERBAR!(B 0,TMQ1907Uh1(0CT1'a0Ei1G(B EMACS -,T7Sd04i107X1!0JTh1'07X1!M0Bh1R'(B - - - -,T"M"M:0$X13(B -======= - ,T`M!JRC)0:Q1:09Ui1(B 0,T4Q14a;E'AR(R!(B "MicroEMACS (kemacs) ,T@RIR0-Uh10;Xh19(B ,T`0:Wi1M'05i19(B" 0,T+Vh1'd04i1AR(R!(B -JUNET ,T`0>Wh1Mc0Ki1c0*i1`0;g19(B Tutorial ,TJSK0CQ1:(B GNUEmacs (Nemacs) - - ,T`M!JRC09Ui1(B 0,T4Q14a;E'AR(R!(B "JOVE Tutorial" (19 ,TA!CR$A(B 86) ,T"M'(B Jonathan Payne - 0,T+Vh1'04Q14a;E'AR(R!`M!JRC"M'(B Steve Zimmerman ,Ta0Kh1'(B CCA-UNIX 0,T+Vh1'04Q14a;E'(B (0,TMU1!07U1(B) ,TAR(B - ,T(R!`M!JRC(B "Teach-Emacs" ,T)0:Q1:`0:Wi1M'05i19(B (31 0,T5X1ER$A(B 85) ,T"M'(B MIT - - Update - February 1986 by Dana Hoggatt. - - Update - December 1986 by Kim Leburg. - - Update/Translate - July 1987 by SANETO Takanori - -,T"M"M:0$X13`0;g190>T1`HI(B -============== - - 0,T$X13(B SANETO Takanori (,T+R`9b5P(B ,T7R!Rb90CT1(B) 0,TER4(B 0,T"i1M0AY1E`07g1((B ,TaEP0MWh19(B ,Tf(B ,Td0Gi1a05h1`0>U1B'0 -# Run temacs as XEmacs -function runtemacs -{ - if [ ! -x temacs ]; then - echo "Must be in temacs source directory to run temacs." - return 1; - fi - - ./temacs -batch -l loadup.el run-temacs "$@" -} - -# From Adrian Aichner -# Convenience function for running build-report -function mak -{ - make "$@" 2>&1 | tee beta.err -} -# export -f mak - -# From Karl Hegbloom -# igrep from the shell command line -function listargs -{ - for arg in "$@"; do - echo " \"$arg\"" - done -} - -function igrep -{ - exp="$1"; shift - gnudoit -q "(igrep nil \"$exp\" '($(listargs "$@")))" -} diff --git a/etc/editclient.sh b/etc/editclient.sh deleted file mode 100644 index 8e1c9b7..0000000 --- a/etc/editclient.sh +++ /dev/null @@ -1,13 +0,0 @@ -#!/bin/sh -if gnuclient -batch -eval t >/dev/null 2>&1 -then - exec gnuclient ${1+"$@"} -else - xemacs -unmapped -f gnuserv-start & - until gnuclient -batch -eval t >/dev/null 2>&1 - do - sleep 1 - done - exec gnuclient ${1+"$@"} -fi - diff --git a/etc/etags.1 b/etc/etags.1 deleted file mode 100644 index 2a6c375..0000000 --- a/etc/etags.1 +++ /dev/null @@ -1,227 +0,0 @@ -.\" Copyright (c) 1992 Free Software Foundation -.\" See section COPYING for conditions for redistribution -.TH etags 1 "19apr1994" "GNU Tools" "GNU Tools" -.de BP -.sp -.ti -.2i -\(** -.. - -.SH NAME -etags, ctags \- generate tag file for Emacs, vi -.SH SYNOPSIS -.hy 0 -.na -.B etags [\|\-aCDRSVh\|] [\|\-i \fIfile\fP\|] [\|\-l \fIlanguage\fP\|] [\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] -.br -[\|\-\-c++\|] [\|\-\-no\-defines\|] [\|\-\-ignore\-indentation\|] -[\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] -[\|\-\-no\-regexp\|] [\|\-\-help\|] [\|\-\-version\|] -[\|\-\-include=\fIfile\fP\|] [\|\-\-output=\fItagfile\fP\|] -[\|\-\-append\|] \fIfile\fP .\|.\|. - -.B ctags [\|\-aCdRSVh\|] [\|\-BtTuvwx\|] [\|\-l \fIlanguage\fP\|] -.br -[\|\-i \fIregexp\fP\|] [\|\-o \fItagfile\fP\|] -[\|\-\-c++\|] [\|\-\-defines\|] [\|\-\-ignore\-indentation\|] -[\|\-\-no\-warn\|] [\|\-\-cxref\|] [\|\-\-backward\-search\|] -[\|\-\-forward\-search\|] [\|\-\-typedefs\|] [\|\-\-typedefs\-and\-c++\|] -[\|\-\-language=\fIlanguage\fP\|] [\|\-\-regex=\fIregexp\fP\|] -[\|\-\-help\|] [\|\-\-version\|] -.br -[\|\-\-output=\fItagfile\fP\|] [\|\-\-append\|] [\|\-\-update\|] \fIfile\fP .\|.\|. -.ad b -.hy 1 -.SH DESCRIPTION -The `\|\fBetags\fP\|' program is used to create a tag table file, in a format -understood by -.BR emacs ( 1 )\c -\&; the `\|\fBctags\fP\|' program is used to create a similar table in a -format understood by -.BR vi ( 1 )\c -\&. Both forms of the program understand -the syntax of C, Objective C, C++, Java, Fortran, Pascal, Cobol, -LaTeX, Scheme, Emacs Lisp/Common Lisp, Postscript, Erlang, Prolog and -most assembler\-like syntaxes. -Both forms read the files specified on the command line, and write a tag -table (defaults: `\|TAGS\|' for \fBetags\fP, `\|tags\|' for -\fBctags\fP) in the current working directory. -Files specified with relative file names will be recorded in the tag -table with file names relative to the directory where the tag table -resides. Files specified with absolute file names will be recorded -with absolute file names. -The programs recognize the language used in an input file based on its -file name and contents. The --language switch can be used to force -parsing of the file names following the switch according to the given -language, overriding guesses based on filename extensions. -.SH OPTIONS -Some options make sense only for the \fBvi\fP style tag files produced -by ctags; -\fBetags\fP does not recognize them. -The programs accept unambiguous abbreviations for long option names. -.TP -.B \-a, \-\-append -Append to existing tag file. (For vi-format tag files, see also -\fB\-\-update\fP.) -.TP -.B \-B, \-\-backward\-search -Tag files written in the format expected by \fBvi\fP contain regular -expression search instructions; the \fB\-B\fP option writes them using -the delimiter `\|\fB?\fP\|', to search \fIbackwards\fP through files. -The default is to use the delimiter `\|\fB/\fP\|', to search \fIforwards\fP -through files. -Only \fBctags\fP accepts this option. -.TP -.B \-C, \-\-c++ -Treat files with `\|.c\|' and `\|.h\|' extensions as C++ code, not C -code. Files with `\|.C\|', `\|.H\|', `\|.cxx\|', `\|.hxx\|', or -`\|.cc\|' extensions are always assumed to be C++ code. -.TP -.B \-d, \-\-defines -Create tag entries for C preprocessor constant definitions -and enum constants, too. This is the -default behavior for \fBetags\fP, so this option is only accepted -by \fBctags\fP. -.TP -.B \-D, \-\-no\-defines -Do not create tag entries for C preprocessor constant definitions -and enum constants. -This may make the tags file much smaller if many header files are tagged. -This is the default behavior for \fBctags\fP, so this option is only -accepted by \fBetags\fP. -.TP -\fB\-l\fP \fIlanguage\fP, \fB\-\-language=\fIlanguage\fP -Parse the following files according to the given language. More than -one such options may be intermixed with filenames. Use \fB\-\-help\fP -to get a list of the available languages and their default filename -extensions. The `auto' language can be used to restore automatic -detection of language based on filename extension. The `none' -language may be used to disable language parsing altogether; only -regexp matching is done in this case (see the \fB\-\-regex\fP option). -.TP -\fB\-\-no_globals\fP -Do not tag global variables in C, C++, Objective C, Java. Typically -this reduces the file size by one fourth. -.TP -\fB\-\-members\fP -Tag variables that are members of strucure-like constructs in C++, -Objective C, Java. -.TP -\fB\-o\fP \fItagfile\fP, \fB\-\-output=\fItagfile\fP -Explicit name of file for tag table; overrides default `\|TAGS\|' or -`\|tags\|'. (But ignored with \fB\-v\fP or \fB\-x\fP.) -.TP -\fB\-r\fP \fIregexp\fP, \fB\-\-regex=\fIregexp\fP -Make tags based on regexp matching for each line of the files -following this option, in addition to the tags made with the standard -parsing based on language. May be freely intermixed with filenames -and the \fB\-R\fP option. The regexps are cumulative, i.e. each -option will add to the previous ones. The regexps are of the form: -.br - - \fB/\fP\fItagregexp\fP[\fB/\fP\fInameregexp\fP]\fB/\fP -.br - -where \fItagregexp\fP is used to match the lines that must be tagged. -It should not match useless characters. If the match is -such that more characters than needed are unavoidably matched by -\fItagregexp\fP, it may be useful to add a \fInameregexp\fP, to -narrow down the tag scope. \fBctags\fP ignores regexps without a -\fInameregexp\fP. The syntax of regexps is the same as in emacs, -augmented with intervals of the form \\{m,n\\}, as id ed or grep. -.br -Here are some examples. All the regexps are quoted to protect them -from shell interpretation. -.br - -Tag the DEFVAR macros in the emacs source files: -.br -\fI\-\-regex\='/[ \\t]*DEFVAR_[A-Z_ \\t(]+"\\([^"]+\\)"\/'\fP -.br - -Tag VHDL files (this example is a single long line, broken here for -formatting reasons): -.br -\fI\-\-language\=none\ \-\-regex='/[\ \\t]*\\(ARCHITECTURE\\|\\ -CONFIGURATION\\)\ +[^\ ]*\ +OF/'\ \-\-regex\='/[\ \\t]*\\ -\\(ATTRIBUTE\\|ENTITY\\|FUNCTION\\|PACKAGE\\(\ BODY\\)?\\ -\\|PROCEDURE\\|PROCESS\\|TYPE\\)[\ \\t]+\\([^\ \\t(]+\\)/\\3/'\fP -.br - -Tag TCL files (this last example shows the usage of a \fItagregexp\fP): -.br -\fI\-\-lang\=none \-\-regex\='/proc[\ \\t]+\\([^\ \\t]+\\)/\\1/'\fP - -.TP -.B \-R, \-\-no\-regex -Don't do any more regexp matching on the following files. May be -freely intermixed with filenames and the \fB\-\-regex\fP option. -.TP -.B \-S, \-\-ignore\-indentation -Don't rely on indentation as much as we normally do. Currently, this -means not to assume that a closing brace in the first column is the -final brace of a function or structure definition in C and C++. -.TP -.B \-t, \-\-typedefs -Record typedefs in C code as tags. Since this is the default behaviour -of \fBetags\fP, only \fBctags\fP accepts this option. -.TP -.B \-T, \-\-typedefs\-and\-c++ -Generate tag entries for typedefs, struct, enum, and union tags, and -C++ member functions. Since this is the default behaviour -of \fBetags\fP, only \fBctags\fP accepts this option. -.TP -.B \-u, \-\-update -Update tag entries for \fIfiles\fP specified on command line, leaving -tag entries for other files in place. Currently, this is implemented -by deleting the existing entries for the given files and then -rewriting the new entries at the end of the tags file. It is often -faster to simply rebuild the entire tag file than to use this. -Only \fBctags\fP accepts this option. -.TP -.B \-v, \-\-vgrind -Instead of generating a tag file, write index (in \fBvgrind\fP format) -to standard output. Only \fBctags\fP accepts this option. -.TP -.B \-w, \-\-no\-warn -Suppress warning messages about duplicate entries. The \fBetags\fP -program does not check for duplicate entries, so this option is not -allowed with it. -.TP -.B \-x, \-\-cxref -Instead of generating a tag file, write a cross reference (in -\fBcxref\fP format) to standard output. Only \fBctags\fP accepts this option. -.TP -.B \-H, \-\-help -Print usage information. -.TP -.B \-V, \-\-version -Print the current version of the program (same as the version of the -emacs \fBetags\fP is shipped with). - -.SH "SEE ALSO" -`\|\fBemacs\fP\|' entry in \fBinfo\fP; \fIGNU Emacs Manual\fP, Richard -Stallman. -.br -.BR cxref ( 1 ), -.BR emacs ( 1 ), -.BR vgrind ( 1 ), -.BR vi ( 1 ). - -.SH COPYING -Copyright (c) 1992 Free Software Foundation, Inc. -.PP -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. -.PP -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. -.PP -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 included in -translations approved by the Free Software Foundation instead of in -the original English. diff --git a/etc/gnuserv.1 b/etc/gnuserv.1 deleted file mode 100644 index f87359f..0000000 --- a/etc/gnuserv.1 +++ /dev/null @@ -1,294 +0,0 @@ -.TH GNUSERV 1 "" "XEmacs Server" -.UC 4 -.SH NAME -gnuserv, gnuclient \- Server and Clients for XEmacs -.SH SYNOPSIS -.B gnuclient -[-nw] [-display display] [-q] [-v] [-l library] [-batch] [-f function] [-eval form] -[-h hostname] [-p port] [-r remote-pathname] [[+line] file] ... -.br -.B gnudoit [-q] -form -.br -.B gnuserv -.br -.B gnuattach -Removed as of gnuserv 3.x -.SH DESCRIPTION - -.PP -\fIgnuclient\fP allows the user to request a running XEmacs process to -edit the named files or directories and/or evaluate lisp forms. -Depending on your environment, it can be an X frame or a TTY frame. -One typical use for this is with a dialup connection to a machine on -which an XEmacs process is currently running. -.PP -\fIgnudoit\fP is a shell script frontend to ``gnuclient -batch -eval form''. -Its use is depreciated. Try to get used to calling gnuclient directly. -.PP -\fIgnuserv\fP is the server program that is set running by XEmacs to -handle all incoming and outgoing requests. It is not usually invoked -directly, but is started from XEmacs by loading the \fIgnuserv\fP -package and evaluating the Lisp form (gnuserv-start). -.PP -\fIgnuattach\fP no longer exists. Its functionality has been replaced by -\fIgnuclient -nw\fP. -.SH OPTIONS -.PP -\fIgnuclient\fP supports as much of the command line options of Emacs as -makes sense in this context. In addition it adds a few of its own. -.br -Options with long names can also be specified using a double -hyphen instead of a single one. -.TP 8 -.BI \-nw -This option makes \fIgnuclient\fP act as a frontend such that XEmacs -can attach to the current TTY. XEmacs will then open a new TTY frame. -The effect is similar to having started a new XEmacs on this TTY with -the ``-nw'' option. It currently only works if XEmacs is running on -the same machine as gnuclient. This is the default if the `DISPLAY' -environment variable is not set. -.TP 8 -.BI \-display " display, " \--display " display" -If this option is given or the `DISPLAY' environment variable is set -then gnuclient will tell XEmacs to edit files in a frame on the -specified X device. -.TP 8 -.BI \-q -This option informs \fIgnuclient\fP to exit once connection has been -made with the XEmacs process. Normally \fIgnuclient\fP waits until -all of the files on the command line have been finished with (their -buffers killed) by the XEmacs process, and all the forms have been -evaluated. -.TP 8 -.BI \-v -When this option is specified \fIgnuclient\fP will request for the -specified files to be viewed instead of edited. -.TP 8 -.BI \-l " library" -Tell Emacs to load the specified library. -.TP 8 -.BI \-batch -Tell Emacs not to open any frames. Just load libraries and evaluate -lisp code. If no files to execute, functions to call or forms to eval -are given using the -.BR \-l , -.BR \-f , -or -.B \-eval -options, then forms to eval are read from STDIN. -.TP 8 -.BI \-f " function," -Make Emacs execute the lisp function. -.TP 8 -.BI \-eval " form" -Make Emacs execute the lisp form. -.TP 8 -.BI \-h " hostname" -Used only with Internet-domain sockets, this option specifies the host -machine which should be running \fIgnuserv\fP. If this option is not -specified then the value of the environment variable GNU_HOST is used -if set. If no hostname is specified, and the GNU_HOST variable is not -set, an internet connection will not be attempted. N\.B.: -\fIgnuserv\fP does NOT allow internet connections unless XAUTH -authentication is used or the GNU_SECURE variable has been specified -and points at a file listing all trusted hosts. (See SECURITY below.) - -.br -Note that an internet address may be specified instead of a hostname -which can speed up connections to the server by quite a bit, -especially if the client machine is running YP. - -.br -Note also that a hostname of \fBunix\fP can be used to specify that -the connection to the server should use a Unix-domain socket (if -supported) rather than an Internet-domain socket. -.TP 8 -.BI \-p " port" -Used only with Internet-domain sockets, this option specifies the -service port used to communicate between server and clients. If this -option is not specified, then the value of the environment variable -GNU_PORT is used, if set, otherwise a service called ``gnuserv'' is -looked up in the services database. Finally, if no other value can be -found for the port, then a default port is used which is usually 21490 -+ uid. -.br -Note that since \fIgnuserv\fP doesn't allow command-line options, the port for -it will have to be specified via one of the alternative methods. -.TP 8 -.BI \-r " pathname" -Used only with Internet-domain sockets, the pathname argument may be -needed to inform XEmacs how to reach the root directory of a remote -machine. \fIgnuclient\fP prepends this string to each path argument -given. For example, if you were trying to edit a file on a client -machine called otter, whose root directory was accessible from the -server machine via the path /net/otter, then this argument should be -set to '/net/otter'. If this option is omitted, then the value is -taken from the environment variable GNU_NODE, if set, or the empty -string otherwise. -.TP 8 -.BI "[+n] file" -This is the path of the file to be edited. If the file is a directory, then -the directory browsers dired or monkey are usually invoked instead. -The cursor is put at line number 'n' if specified. - -.SH SETUP -\fIgnuserv\fP is packaged standardly with recent versions of XEmacs. -Therefore, you should be able to start the server simply by evaluating -the XEmacs Lisp form (gnuserv-start), or equivalently by typing -`M-x gnuserv-start'. - -.SH CONFIGURATION -The behavior of this suite of program is mostly controlled on the lisp -side in Emacs and its behavior can be customized to a large extent. -Type `M-x customize-group RET gnuserv RET' for easy access. More -documentation can be found in the file `gnuserv.el' - -.SH EXAMPLE -.RS 4 -gnuclient -q -f mh-smail -.br -gnuclient -h cuckoo -r /ange@otter: /tmp/* -.br -gnuclient -nw ../src/listproc.c -.RE -.br - -.br -More examples and sample wrapper scripts are provided in the -etc/gnuserv directory of the Emacs installation. - - -.SH SYSV IPC -SysV IPC is used to communicate between \fIgnuclient\fP and -\fIgnuserv\fP if the symbol SYSV_IPC is defined at the top of -gnuserv.h. This is incompatible with both Unix-domain and -Internet-domain socket communication as described below. A file called -/tmp/gsrv??? is created as a key for the message queue, and if removed -will cause the communication between server and client to fail until -the server is restarted. -.SH UNIX-DOMAIN SOCKETS -A Unix-domain socket is used to communicate between \fIgnuclient\fP -and \fIgnuserv\fP if the symbol UNIX_DOMAIN_SOCKETS is defined at the -top of gnuserv.h. A file called /tmp/gsrvdir????/gsrv is created for -communication and if deleted will cause communication between server -and client to fail. Only the user running gnuserv will be able to -connect to the socket. -.SH INTERNET-DOMAIN SOCKETS -Internet-domain sockets are used to communicate between -\fIgnuclient\fP and \fIgnuserv\fP if the symbol -INTERNET_DOMAIN_SOCKETS is defined at the top of gnuserv.h. Both -Internet-domain and Unix-domain sockets can be used at the same -time. If a hostname is specified via -h or via the GNU_HOST -environment variable, \fIgnuclient\fP establish connections using an -internet domain socket. If not, a local connection is attempted via -either a unix-domain socket or SYSV IPC. -.SH SECURITY -Using Internet-domain sockets, a more robust form of security is -needed that wasn't necessary with either Unix-domain sockets or SysV -IPC. Currently, two authentication protocols are supported to provide -this: MIT-MAGIC-COOKIE-1 (based on the X11 xauth(1) program) and a -simple host-based access control mechanism, hereafter called -GNUSERV-1. The GNUSERV-1 protocol is always available, whereas support -for MIT-MAGIC-COOKIE-1 may or may not have been enabled (via a #define -at the top of gnuserv.h) at compile-time. -.PP -\fIgnuserv\fP, using GNUSERV-1, performs a limited form of access -control at the machine level. By default no internet-domain socket is -opened. If the variable GNU_SECURE can be found in \fIgnuserv\fP's -environment, and it names a readable filename, then this file is -opened and assumed to be a list of hosts, one per line, from which the -server will allow requests. Connections from any other host will be -rejected. Even the machine on which \fIgnuserv\fP is running is not -permitted to make connections via the internet socket unless its -hostname is explicitly specified in this file. Note that a host may -be either a numeric IP address or a hostname, and that -.I any -user on an approved host may connect to your gnuserv and execute arbitrary -elisp (e.g., delete all your files). -If this file contains a lot of -hostnames then the server may take quite a time to start up. -.PP -When the MIT-MAGIC-COOKIE-1 protocol is enabled, an internet socket -\fIis\fP opened by default. \fIgnuserv\fP will accept a connection from -any host, and will wait for a "magic cookie" (essentially, a password) -to be presented by the client. If the client doesn't present the -cookie, or if the cookie is wrong, the authentication of the client is -considered to have failed. At this point. \fIgnuserv\fP falls back to -the GNUSERV-1 protocol; If the client is calling from a host listed in -the GNU_SECURE file, the connection will be accepted, otherwise it -will be rejected. -.TP 4 -.I Using MIT-MAGIC-COOKIE-1 authentication -When the \fIgnuserv\fP server is started, it looks for a cookie -defined for display 999 on the machine where it is running. If the -cookie is found, it will be stored for use as the authentication -cookie. These cookies are defined in an authorization file (usually -~/.Xauthority) that is manipulated by the X11 xauth(1) program. For -example, a machine "kali" which runs an emacs that invokes -\fIgnuserv\fP should respond as follows (at the shell prompt) when set -up correctly. -.PP -.RS 8 -kali% xauth list -.br -GS65.SP.CS.CMU.EDU:0 MIT-MAGIC-COOKIE-1 11223344 -.br -KALI.FTM.CS.CMU.EDU:999 MIT-MAGIC-COOKIE-1 1234 -.RE -.PP -.RS 4 -In the above case, the authorization file defines two cookies. The -second one, defined for screen 999 on the server machine, is used for -gnuserv authentication. -.PP -On the client machine's side, the authorization file must contain an -identical line, specifying the -.I server's -cookie. In other words, on a machine "foobar" which wishes to connect -to "kali," the `xauth list' output should contain the line: -.PP -.RS 4 -KALI.FTM.CS.CMU.EDU:999 MIT-MAGIC-COOKIE-1 1234 -.RE -.PP -For more information on authorization files, take a look at the -xauth(1X11) man page, or invoke xauth interactively (without any -arguments) and type "help" at the prompt. Remember that case in the -name of the authorization protocol (i.e.`MIT-MAGIC-COOKIE-1') -.I is -significant! -.RE - - -.SH ENVIRONMENT -.PP -.TP 8 -.B DISPLAY -Default X device to put edit frame. - -.SH FILES -.PP -.TP 8 -.B /tmp/gsrv??? -(SYSV_IPC only) -.TP 8 -.B /tmp/gsrvdir???/gsrv -(unix domain sockets only) -.TP 8 -.B ~/.emacs -XEmacs customization file, see xemacs(1). -.SH SEE ALSO -.PP -.TP 8 -xauth(1X11), Xsecurity(1X11), gnuserv.el -.SH BUGS -.PP -NULs occurring in result strings don't get passed back to gnudoit properly. - -.SH AUTHOR. -Andy Norman (ange@hplb.hpl.hp.com), based heavily upon -etc/emacsclient.c, etc/server.c and lisp/server.el from the GNU Emacs -18.52 distribution. Various modifications from Bob Weiner (weiner@mot.com), -Darrell Kindred (dkindred@cmu.edu), Arup Mukherjee (arup@cmu.edu), Ben -Wing (ben@xemacs.org) and Hrvoje Niksic (hniksic@srce.hr). diff --git a/etc/package-index.LATEST.pgp b/etc/package-index.LATEST.pgp deleted file mode 100644 index 0ae705e..0000000 --- a/etc/package-index.LATEST.pgp +++ /dev/null @@ -1,1763 +0,0 @@ -;; Package Index file -- Do not edit manually. -;;;@@@ -(package-get-update-base-entry (quote -(ediff - (standards-version 1.0 - version "1.17" - author-version "2.72" - date "1999-02-16" - build-date "1999-03-01" - maintainer "Michael Kifer " - distribution stable - priority medium - category "prog" - dump nil - description "Interface over GNU patch." - filename "ediff-1.17-pkg.tar.gz" - md5sum "b69c621d1943a9b668374f0babd243f3" - size 281481 - provides (ediff) - requires (pcl-cvs elib dired xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(hm--html-menus - (standards-version 1.0 - version "1.12" - author-version "5.9" - date "1999-02-05" - build-date "1999-02-05" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "HTML editing." - filename "hm--html-menus-1.12-pkg.tar.gz" - md5sum "fc80ef260cc0682bde6e706cdc8ddae4" - size 177442 - provides (adapt hm--date hm--html-configuration hm--html-drag-and-drop hm--html-indentation hm--html-keys hm--html-menu hm--html-mode hm--html-not-standard hm--html html-view tmpl-minor-mode) - requires (dired xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(jde - (standards-version 1.0 - version "1.14" - author-version "2.14" - date "1999-02-05" - build-date "1999-02-05" - maintainer "Andy Piper " - distribution stable - priority medium - category "prog" - dump nil - description "Java language and development support." - filename "jde-1.14-pkg.tar.gz" - md5sum "1028c54ef317d8dd4d4c78e5b9c004e6" - size 320702 - provides (jde) - requires (cc-mode debug speedbar edit-utils mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(skk - (standards-version 1.0 - version "1.12" - author-version "10.38" - date "1998-10-01" - build-date "1999-02-02" - maintainer "SL Baur " - distribution mule - priority medium - category "mule" - dump t - description "Japanese Language Input Method." - filename "skk-1.12-pkg.tar.gz" - md5sum "f690c518a0da65c4dc9fe2a867026c26" - size 1514106 - provides (skk skk-tut) - requires (viper mule-base elib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(egg-its - (standards-version 1.0 - version "1.15" - author-version "21.0b62" - date "1999-01-04" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "mule" - dump t - description "Wnn (4.2 and 6) support. SJ3 support." - filename "egg-its-1.15-pkg.tar.gz" - md5sum "9c3f18c0c7eb0e77bc23af5aed0e3bcd" - size 257327 - provides (egg-cnpinyin egg-cnzhuyin egg-cwnn-leim egg-jisx0201 egg-jsymbol egg-kwnn-leim egg-leim egg-sj3-client egg-sj3-leim egg-sj3 egg-wnn egg) - requires (leim mule-base fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(edict - (standards-version 1.0 - version "1.07" - author-version "0.9.8" - date "1998-07-23" - build-date "1999-02-02" - maintainer "Stephen J. Turnbull " - distribution mule - priority high - category "mule" - dump nil - description "Lisp Interface to EDICT, Kanji Dictionary" - filename "edict-1.07-pkg.tar.gz" - md5sum "493ef0ec6f2760e5c94423c23c9d124e" - size 71661 - provides (dui-registry dui edict-edit edict-english edict-japanese edict-morphology edict-test edict ts-mode) - requires (mule-base xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(leim - (standards-version 1.0 - version "1.12" - author-version "21.0b62" - date "1998-07-23" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution mule - priority medium - category "mule" - dump nil - description "Quail. All non-English and non-Japanese language support." - filename "leim-1.12-pkg.tar.gz" - md5sum "07cc5be34a0d9d312b883b430349a882" - size 1671757 - provides () - requires (mule-base fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(locale - (standards-version 1.0 - version "1.11" - author-version "21.0b62" - date "1998-07-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "mule" - dump nil - description "Localized menubars and localized splash screens." - filename "locale-1.11-pkg.tar.gz" - md5sum "245f5110c2adb4411e3f4e2db014c4bc" - size 32690 - provides () - requires (mule-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mule-base - (standards-version 1.0 - version "1.28" - author-version "21.0b63" - date "1999-02-17" - build-date "1999-03-01" - maintainer "SL Baur " - distribution mule - priority high - category "mule" - dump t - description "Basic Mule support, required for building with Mule." - filename "mule-base-1.28-pkg.tar.gz" - md5sum "498d725e923476af3df12b83fef6277d" - size 441953 - provides (canna-leim canna char-table china-util cyril-util isearch-ext japan-util ccl can-n-egg mule-help) - requires (fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(strokes - (standards-version 1.0 - version "1.04" - author-version "21.0b62" - date "1998-01-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "oa" - dump nil - description "Mouse enhancement utility." - filename "strokes-1.04-pkg.tar.gz" - md5sum "9a83020e888d140da2360dcac83c7c86" - size 43481 - provides (strokes) - requires (text-modes edit-utils mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(time - (standards-version 1.0 - version "1.07" - author-version "1.17" - date "1998-04-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "oa" - dump nil - description "Display time & date on the modeline." - filename "time-1.07-pkg.tar.gz" - md5sum "4cc97d84357412fb7d737a88b6f05cbe" - size 20006 - provides (time) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(text-modes - (standards-version 1.0 - version "1.18" - author-version "21.0b63" - date "1999-02-15" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "oa" - dump nil - description "Miscellaneous support for editing text files." - filename "text-modes-1.18-pkg.tar.gz" - md5sum "f9d30bd220d0806179397194603b0b0f" - size 207596 - provides (autoinsert crontab-edit filladapt fold-isearch folding image-mode iso-acc iso-ascii iso-cvt iso-insert iso-swed swedish tabify whitespace-mode winmgr-mode xpm-mode xrdb-mode) - requires (ispell fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(slider - (standards-version 1.0 - version "1.09" - author-version "0.3x1" - date "1998-08-13" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution experimental - priority low - category "oa" - dump nil - description "User interface tool." - filename "slider-1.09-pkg.tar.gz" - md5sum "b211a950179fee88712fc5c38e395069" - size 12004 - provides (slider color-selector) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(sgml - (standards-version 1.0 - version "1.04" - author-version "21.0b62" - date "1998-01-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "oa" - dump nil - description "SGML/Linuxdoc-SGML editing." - filename "sgml-1.04-pkg.tar.gz" - md5sum "2b762a0fbdda616916624dc2fa53e647" - size 26938 - provides (sgml linuxdoc-sgml) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(psgml - (standards-version 1.0 - version "1.11" - author-version "1.01" - date "1998-07-06" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "oa" - dump nil - description "Validated HTML/SGML editing." - filename "psgml-1.11-pkg.tar.gz" - md5sum "e6d5a593138aa8861a5a178097c05594" - size 425005 - provides (psgml sgml) - requires (edit-utils) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(pc - (standards-version 1.0 - version "1.14" - author-version "21.0b62" - date "1998-07-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "PC style interface emulation." - filename "pc-1.14-pkg.tar.gz" - md5sum "e300f9e0ee56640e110bee972fca8333" - size 16243 - provides (delbs fusion pc-select pending-del s-region) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(ispell - (standards-version 1.0 - version "1.14" - author-version "3.1" - date "1998-12-09" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "Spell-checking with GNU ispell." - filename "ispell-1.14-pkg.tar.gz" - md5sum "2b382122698c2c46aeaa4847e7ab3825" - size 67525 - provides (ispell) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(frame-icon - (standards-version 1.0 - version "1.06" - author-version "21.0b62" - date "1998-07-14" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "oa" - dump nil - description "Set up mode-specific icons for each frame under XEmacs" - filename "frame-icon-1.06-pkg.tar.gz" - md5sum "bc4f6e838a4fa12d7f3b8b1996b3a9ac" - size 33483 - provides (forms forms-mode) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(forms - (standards-version 1.0 - version "1.09" - author-version "2.10" - date "1998-01-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "oa" - dump nil - description "Forms editing support (obsolete, use Widget instead)." - filename "forms-1.09-pkg.tar.gz" - md5sum "7023bf24836c00572fc3b014d9c9b3c9" - size 47673 - provides (forms forms-mode) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(calendar - (standards-version 1.0 - version "1.10" - author-version "21.0b63" - date "1999-02-08" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "Calendar and diary support." - filename "calendar-1.10-pkg.tar.gz" - md5sum "09e93d157d2853a35e735a6a04f54055" - size 248580 - provides (appt cal-dst cal-french cal-mayan cal-x cal-xemacs calendar diary-ins diary-lib holidays lunar solar) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(calc - (standards-version 1.0 - version "1.10" - author-version "2.02fX3" - date "1998-07-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "Emacs calculator" - filename "calc-1.10-pkg.tar.gz" - md5sum "148c82bf6f213d6e2fb234e1f21e4699" - size 1616821 - provides (calc) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(speedbar - (standards-version 1.0 - version "1.11" - author-version "0.6.2x" - date "1998-10-02" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "oa" - dump nil - description "Provides a seperate frame with convenient references." - filename "speedbar-1.11-pkg.tar.gz" - md5sum "896acffc88848f175ada5ae637b67738" - size 64858 - provides (speedbar) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(edit-utils - (standards-version 1.0 - version "1.37" - author-version "21.0b63" - date "1999-02-18" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "oa" - dump nil - description "Miscellaneous editor extensions, you probably need this." - filename "edit-utils-1.37-pkg.tar.gz" - md5sum "fb7f38fd037c0fa045a199796c69e6d7" - size 577293 - provides (abbrevlist atomic-extents avoid backup-dir balloon-help big-menubar blink-cursor blink-paren bookmark compare-w completion dabbrev desktop detached-minibuf edit-toolbar fast-lock file-part floating-toolbar flow-ctrl foldout func-menu hippie-exp icomplete id-select info-look iswitchb lazy-lock lazy-shot live-icon man mic-paren paren popper mode-motion+ outl-mouse page-ext blink-paren paren permanent-buffers recent-files redo reportmail rsz-minibuf saveconfsavehist saveplace scroll-in-place tempo toolbar-utils tree-menu uniquify where-was-i-db) - requires (xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(view-process - (standards-version 1.0 - version "1.06" - author-version "2.4" - date "1998-01-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "os" - dump nil - description "A Unix process browsing tool." - filename "view-process-1.06-pkg.tar.gz" - md5sum "61c4c7175f23cb4cfd314e10303b238c" - size 59958 - provides (view-process-mode) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(os-utils - (standards-version 1.0 - version "1.14" - author-version "21.0b62" - date "1998-12-30" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "os" - dump nil - description "Miscellaneous O/S utilities." - filename "os-utils-1.14-pkg.tar.gz" - md5sum "2ff61cea716a53af1846d1699b5194a7" - size 227298 - provides (archive-mode background crypt crypt++ inf-lisp jka-compr lpr mchat ps-print tar-mode telnet terminal uncompress) - requires (xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(ilisp - (standards-version 1.0 - version "1.07" - author-version "5.8" - date "1998-01-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "os" - dump nil - description "Front-end for Inferior Lisp." - filename "ilisp-1.07-pkg.tar.gz" - md5sum "38cb2d94926e310a6e71ec1be854d636" - size 262173 - provides (ilisp completer) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(igrep - (standards-version 1.0 - version "1.05" - author-version "2.83" - date "1998-08-11" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "os" - dump nil - description "Enhanced front-end for Grep." - filename "igrep-1.05-pkg.tar.gz" - md5sum "e70d4973a2af4dbd6222f5943bfa1a50" - size 14935 - provides (igrep) - requires (dired xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(eterm - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-06-28" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "os" - dump nil - description "Terminal emulation." - filename "eterm-1.08-pkg.tar.gz" - md5sum "77e56529b5de6a0a0dd46c5d1634eebf" - size 108905 - provides (eterm) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(viper - (standards-version 1.0 - version "1.13" - author-version "3.061" - date "1999-02-17" - build-date "1999-03-01" - maintainer "Michael Kifer " - distribution stable - priority low - category "wp" - dump nil - description "VI emulation support." - filename "viper-1.13-pkg.tar.gz" - md5sum "b369c53c499c3ab2e1478031ddaf6071" - size 317868 - provides (viper) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(tpu - (standards-version 1.0 - version "1.08" - author-version "4.2X" - date "1998-07-23" - build-date "1999-02-02" - maintainer "Kevin Oberman " - distribution normal - priority medium - category "wp" - dump nil - description "DEC EDIT/TPU support." - filename "tpu-1.08-pkg.tar.gz" - md5sum "2306ac55a0a1ed23da02a85c91f881bb" - size 58804 - provides (tpu) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(textools - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-04-29" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stabl - priority medium - category "wp" - dump nil - description "Miscellaneous TeX support." - filename "textools-1.08-pkg.tar.gz" - md5sum "22dd0e16433a96547fde5757c6793388" - size 79176 - provides (bib-mode bibtex refer-to-bibtex) - requires (xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(texinfo - (standards-version 1.0 - version "1.14" - author-version "21.0b62" - date "1998-07-20" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "wp" - dump nil - description "XEmacs TeXinfo support." - filename "texinfo-1.14-pkg.tar.gz" - md5sum "b1b6a7f4c1ff10be38d3e27d1213f1c8" - size 127830 - provides (makeinfo tex-mode texinfmt texinfo texnfo-tex texnfo-upd) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(reftex - (standards-version 1.0 - version "1.11" - author-version "3.42" - date "1998-08-11" - build-date "1999-02-02" - maintainer "Carsten Dominik " - distribution stable - priority medium - category "wp" - dump nil - description "Emacs support for LaTeX cross-references, citations.." - filename "reftex-1.11-pkg.tar.gz" - md5sum "efe43ac8ef52b9f8cf949783e30bb4a9" - size 209331 - provides (reftex) - requires (fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(edt - (standards-version 1.0 - version "1.07" - author-version "21.0b62" - date "1998-04-07" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "wp" - dump nil - description "DEC EDIT/EDT emulation." - filename "edt-1.07-pkg.tar.gz" - md5sum "6c48ceb9686c50058be3938288940bc5" - size 46131 - provides (edt) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(crisp - (standards-version 1.0 - version "1.09" - author-version "1.34" - date "1998-08-18" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "wp" - dump nil - description "Crisp/Brief emulation." - filename "crisp-1.09-pkg.tar.gz" - md5sum "faa9b6f2868a7e5b212d1094039cf526" - size 10067 - provides (crisp scroll-lock) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(auctex - (standards-version 1.0 - version "1.16" - author-version "9.7p" - date "1998-09-30" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "wp" - dump nil - description "Basic TeX/LaTeX support." - filename "auctex-1.16-pkg.tar.gz" - md5sum "56e3454a1162c25db93fc84bdab61d0f" - size 365136 - provides (auc-old bib-cite font-latex latex multi-prompt tex-buf tex-info tex-jp tex-site tex) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(vhdl - (standards-version 1.0 - version "1.07" - author-version "2.74" - date "1998-01-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "Support for VHDL." - filename "vhdl-1.07-pkg.tar.gz" - md5sum "0eae8d15cff7d7b6dd7e1d00029c0e3a" - size 65961 - provides (vhdl-mode) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(vc - (standards-version 1.0 - version "1.17" - author-version "21.0b63" - date "1999-02-25" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "Version Control for Free systems." - filename "vc-1.17-pkg.tar.gz" - md5sum "4e80458c0e6d4cf2805ed6a46135e1c6" - size 84499 - provides (vc) - requires (dired xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(vc-cc - (standards-version 1.0 - version "1.11" - author-version "21.0b62" - date "1998-12-09" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "prog" - dump nil - description "Version Control for ClearCase (UnFree) systems." - filename "vc-cc-1.11-pkg.tar.gz" - md5sum "561ab60400e3fa6bfef8ad8567a3702d" - size 96544 - provides (vc) - requires (dired xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(sh-script - (standards-version 1.0 - version "1.08" - author-version "2.0e" - date "1998-05-12" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "Support for editing shell scripts." - filename "sh-script-1.08-pkg.tar.gz" - md5sum "f2f584ab19761b1db14160d9d3cbc6f3" - size 33900 - provides (sh-script executable) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(scheme - (standards-version 1.0 - version "1.07" - author-version "21.0b62" - date "1998-09-08" - build-date "1999-02-02" - maintainer "Karl M. Hegbloom " - distribution contrib - priority low - category "prog" - dump nil - description "Front-end support for Inferior Scheme." - filename "scheme-1.07-pkg.tar.gz" - md5sum "998d46aee749b32493cae61cac3888d2" - size 36292 - provides (scheme xscheme cmuscheme cmuscheme48) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(prog-modes - (standards-version 1.0 - version "1.18" - author-version "21.0b63" - date "1999-02-05" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "prog" - dump nil - description "Support for various programming languages." - filename "prog-modes-1.18-pkg.tar.gz" - md5sum "b6b86a7a88544c54e5231e11e0a9af79" - size 595658 - provides (autoconf-mode cperl-mode eiffel3 f90 fortran ksh-mode m4-mode makefile perl-mode postscript python-mode rexx-mode simula-mode tcl teco verilog-mod) - requires (mail-lib xemacs-devel xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(emerge - (standards-version 1.0 - version "1.05" - author-version "21.0b62" - date "1998-04-07" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "Another interface over GNU patch." - filename "emerge-1.05-pkg.tar.gz" - md5sum "1f4d70d7f4e73290837b2dbd2189be99" - size 61009 - provides (emerge) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(debug - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-11-18" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "prog" - dump nil - description "GUD, gdb, dbx debugging support." - filename "debug-1.08-pkg.tar.gz" - md5sum "e2c9ff97146272670632311a9267765a" - size 89552 - provides (dbx gdb-highlight gdb gdbsrc gud history) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(c-support - (standards-version 1.0 - version "1.11" - author-version "21.0b63" - date "1999-02-06" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "prog" - dump nil - description "Basic single-file add-ons for editing C code." - filename "c-support-1.11-pkg.tar.gz" - md5sum "d93566b09c3d9e79ac12a644250e7ca0" - size 69876 - provides (c-comment-edit cmacexp ctypes hideif hideshow) - requires (cc-mode xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(ada - (standards-version 1.0 - version "1.06" - author-version "2.27" - date "1998-01-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "Ada language support." - filename "ada-1.06-pkg.tar.gz" - md5sum "0f3d2dc2ff33d40092b324a7a5a363d6" - size 54364 - provides (ada-mode ada-stmt) - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(pcl-cvs - (standards-version 1.0 - version "1.38" - author-version "R-2_0-Beta_2" - date "1998-11-17" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "prog" - dump nil - description "CVS frontend." - filename "pcl-cvs-1.38-pkg.tar.gz" - md5sum "a5ff4e61dffe3985c20385eb741d4783" - size 163524 - provides (pcl-cvs generic-sc) - requires (xemacs-base elib dired) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(cc-mode - (standards-version 1.0 - version "1.15" - author-version "5.25" - date "1998-12-30" - build-date "1999-02-02" - maintainer "Barry Warsaw " - distribution stable - priority medium - category "prog" - dump nil - description "C, C++ and Java language support." - filename "cc-mode-1.15-pkg.tar.gz" - md5sum "ca73b190e79f96ab928eecd12af94222" - size 212611 - provides (cc-mode) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(misc-games - (standards-version 1.0 - version "1.09" - author-version "21.0b62" - date "1998-03-22" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "games" - dump nil - description "Other amusements and diversions." - filename "misc-games-1.09-pkg.tar.gz" - md5sum "a4e7e18e7cf3ce771ad65dae24967603" - size 165698 - provides (decipher gomoku hanoi life morse rot13) - requires (xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mine - (standards-version 1.0 - version "1.10" - author-version "1.9" - date "1998-05-09" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "games" - dump nil - description "Minehunt Game." - filename "mine-1.10-pkg.tar.gz" - md5sum "a2d4f93830fe86e4d4e2f081ec0517fb" - size 66679 - provides (xmine) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(games - (standards-version 1.0 - version "1.09" - author-version "1.04" - date "1998-06-04" - build-date "1999-02-02" - maintainer "Glynn Clements " - distribution stable - priority low - category "games" - dump nil - description "Tetris, Sokoban, and Snake." - filename "games-1.09-pkg.tar.gz" - md5sum "76a327a228745576538711180a9e444e" - size 32146 - provides (gamegrid snake tetris sokoban) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(cookie - (standards-version 1.0 - version "1.10" - author-version "21.0b62" - date "1998-04-07" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "games" - dump nil - description "Spook and Yow (Zippy quotes)." - filename "cookie-1.10-pkg.tar.gz" - md5sum "1c5599fa30e346af452c126d872121be" - size 34198 - provides (cookie1 yow) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(bbdb - (standards-version 1.0 - version "1.07" - author-version "2.00.02" - date "1998-10-08" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "comm" - dump nil - description "The Big Brother Data Base" - filename "bbdb-1.07-pkg.tar.gz" - md5sum "e28c4aed70df000812d34cb3795c2f72" - size 282200 - provides (bbdb) - requires (bbdb edit-utils gnus mh-e rmail supercite vm tm apel mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(zenirc - (standards-version 1.0 - version "1.05" - author-version "2.112" - date "1998-08-15" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "comm" - dump nil - description "ZENIRC IRC Client." - filename "zenirc-1.05-pkg.tar.gz" - md5sum "df432e4987ddd0dd65e0124d7d910967" - size 276054 - provides (zenirc) - requires (zenirc) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mew - (standards-version 1.0 - version "1.07" - author-version "1.93b38x1" - date "1998-12-09" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "comm" - dump nil - description "Messaging in an Emacs World." - filename "mew-1.07-pkg.tar.gz" - md5sum "04ed302d5a3735169835e52dadc9e84d" - size 518432 - provides (mew) - requires (mew) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(tm - (standards-version 1.0 - version "1.17" - author-version "21.0b63" - date "1999-02-06" - build-date "1999-02-06" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "comm" - dump nil - description "Emacs MIME support." - filename "tm-1.17-pkg.tar.gz" - md5sum "ee33e9f5fb4cd461e19e5ff23b4a3ea2" - size 329581 - provides (tm tm-edit tm-view mime-setup) - requires (gnus mh-e rmail vm mailcrypt mail-lib apel xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(gnus - (standards-version 1.0 - version "1.38" - author-version "5.6.45" - date "1999-02-17" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "comm" - dump nil - description "The Gnus Newsreader and Mailreader." - filename "gnus-1.38-pkg.tar.gz" - md5sum "22f00c391c4680d0a4fe53a5e6b85f40" - size 1869217 - provides (gnus message) - requires (gnus tm apel w3 mh-e mailcrypt rmail mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(rmail - (standards-version 1.0 - version "1.08" - author-version "21.0b62" - date "1998-06-28" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "comm" - dump nil - description "An obsolete Emacs mailer." - filename "rmail-1.08-pkg.tar.gz" - md5sum "90f98f9043e0c6f2180ffec9c6904eca" - size 96450 - provides (rmail rmailsum) - requires (tm apel mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mailcrypt - (standards-version 1.0 - version "1.07" - author-version "3.4" - date "1998-01-24" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "comm" - dump nil - description "Support for messaging encryption with PGP." - filename "mailcrypt-1.07-pkg.tar.gz" - md5sum "350dccab50ef0800b95d44ef62cca359" - size 86362 - provides (mailcrypt) - requires (gnus vm mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(supercite - (standards-version 1.0 - version "1.11" - author-version "3.55x2" - date "1998-08-9" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "comm" - dump nil - description "An Emacs citation tool for News & Mail messages." - filename "supercite-1.11-pkg.tar.gz" - md5sum "816ba6aa0d984b06a0d8749fd85c4434" - size 99417 - provides (supercite) - requires (mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mh-e - (standards-version 1.0 - version "1.09" - author-version "21.0b62" - date "1998-07-12" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "comm" - dump nil - description "Front end support for MH." - filename "mh-e-1.09-pkg.tar.gz" - md5sum "89e6f44e8dca03f6be10068391831262" - size 176469 - provides (mh-e) - requires (mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(gnats - (standards-version 1.0 - version "1.08" - author-version "3.101" - date "1998-08-01" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "comm" - dump nil - description "XEmacs bug reports." - filename "gnats-1.08-pkg.tar.gz" - md5sum "8c1e3100399aac86c63683b1836d4a61" - size 189265 - provides (gnats gnats-admin send-pr) - requires (mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(footnote - (standards-version 1.0 - version "1.08" - author-version "0.18x" - date "1998-08-27" - build-date "1999-02-02" - maintainer "SL Baur " - distribution stable - priority low - category "comm" - dump nil - description "Footnoting in mail message editing modes." - filename "footnote-1.08-pkg.tar.gz" - md5sum "2c2377f0e702b8ba437cc8e245c08cfd" - size 13352 - provides (footnote) - requires (mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(eudc - (standards-version 1.0 - version "1.28" - author-version "1.28" - date "1999-02-13" - build-date "1999-03-01" - maintainer "Oscar Figueiredo " - distribution stable - priority low - category "comm" - dump nil - description "Emacs Unified Directory Client (LDAP, PH)." - filename "eudc-1.28-pkg.tar.gz" - md5sum "e88e7ed791d16105824812edcd743bc6" - size 62476 - provides (eudc eudc-ldap eudc-ph) - requires (fsf-compat xemacs-base bbdb) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(net-utils - (standards-version 1.0 - version "1.11" - author-version "21.0b62" - date "1998-07-01" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "comm" - dump nil - description "Miscellaneous Networking Utilities." - filename "net-utils-1.11-pkg.tar.gz" - md5sum "f9d52e6e6b4f53ccf5cdd3521403e276" - size 107193 - provides (ilisp-browse-cltl2 emacsbug feedmail metamail net-utils rcompile shadowfile webjump webster-www) - requires (w3 efs mail-lib xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(w3 - (standards-version 1.0 - version "1.12" - author-version "4.0pre39" - date "1999-01-08" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution experimental - priority high - category "comm" - dump nil - description "A Web browser." - filename "w3-1.12-pkg.tar.gz" - md5sum "e7afce350e99f71dfde7ec752290670c" - size 679826 - provides (w3 url) - requires (w3 mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(vm - (standards-version 1.0 - version "1.16" - author-version "6.67" - date "1998-09-22" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "comm" - dump nil - description "An Emacs mailer." - filename "vm-1.16-pkg.tar.gz" - md5sum "e5ad7011473b17f7d1e9521407199b64" - size 603773 - provides (vm) - requires (mail-lib xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(sounds-wav - (standards-version 1.0 - version "1.06" - author-version "21.0b62" - date "1998-06-30" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "libs" - dump nil - description "XEmacs Microsoft sound files." - filename "sounds-wav-1.06-pkg.tar.gz" - md5sum "7f3dfd84e88b418ea58233bde7d859fc" - size 148545 - provides () - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(sounds-au - (standards-version 1.0 - version "1.06" - author-version "21.0b62" - date "1998-06-30" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority high - category "libs" - dump nil - description "XEmacs Sun sound files." - filename "sounds-au-1.06-pkg.tar.gz" - md5sum "aa4a6080061e802b72156f4ce59e9561" - size 125744 - provides () - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(xemacs-devel - (standards-version 1.0 - version "1.21" - author-version "21.0b62" - date "1998-10-20" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "libs" - dump nil - description "Emacs Lisp developer support." - filename "xemacs-devel-1.21-pkg.tar.gz" - md5sum "aa472f2d412382c2fdd3150105ca7d1c" - size 83543 - provides (docref eldoc elp find-func hide-copyleft ielm regexp-opt trace) - requires (xemacs-base) - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(tooltalk - (standards-version 1.0 - version "1.09" - author-version "21.0b62" - date "1998-07-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution contrib - priority low - category "libs" - dump nil - description "Support for building with Tooltalk." - filename "tooltalk-1.09-pkg.tar.gz" - md5sum "368d6407bf82711bee9a01fa6908b576" - size 9271 - provides () - requires () - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(elib - (standards-version 1.0 - version "1.04" - author-version "1.0" - date "1998-10-01" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "libs" - dump nil - description "Portable Emacs Lisp utilities library." - filename "elib-1.04-pkg.tar.gz" - md5sum "d17596beb9b03292e322f8460c36eb81" - size 72834 - provides (avltree bintree cookie dll elib-node queue-f queue-m read stack-f stack-m string) - requires () - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(edebug - (standards-version 1.0 - version "1.07" - author-version "21.0b62" - date "1998-03-12" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority low - category "libs" - dump nil - description "An Emacs Lisp debugger." - filename "edebug-1.07-pkg.tar.gz" - md5sum "62d3e581feac2c3a73917ad0d81151b0" - size 112408 - provides (edebug cl-read cust-print eval-reg cl-specs) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(Sun - (standards-version 1.0 - version "1.10" - author-version "21.0b62" - date "1998-07-25" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution sun - priority low - category "libs" - dump nil - description "Support for Sparcworks." - filename "Sun-1.10-pkg.tar.gz" - md5sum "54cce5cbb182d99de5562a586714e50c" - size 63693 - provides (sccs eos-browser eos-common eos-debugger eos-debugger eos-editor eos-init eos-load eos-menubar eos-toolbar sunpro) - requires (cc-mode xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(apel - (standards-version 1.0 - version "1.09" - author-version "3.3" - date "1998-07-23" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "libs" - dump nil - description "A Portable Emacs Library. Used by XEmacs MIME support." - filename "apel-1.09-pkg.tar.gz" - md5sum "2030f4f38ef76da3104f77f36b797916" - size 35302 - provides (atype emu-20 emu-e19 emu-x20 emu-xemacs emu file-detect filename install mule-caesar path-util richtext std11-parse std11 tinyrich) - requires (fsf-compat xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(efs - (standards-version 1.0 - version "1.14" - author-version "1.18" - date "1999-01-03" - build-date "1999-02-02" - maintainer "Mike Sperber " - distribution stable - priority medium - category "libs" - dump nil - description "Treat files on remote systems the same as local files." - filename "efs-1.14-pkg.tar.gz" - md5sum "2b4128fec0dcb31834f404ef962f10ab" - size 369742 - provides (efs) - requires (xemacs-base vm dired) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(dired - (standards-version 1.0 - version "1.05" - author-version "7.9" - date "1998-12-09" - build-date "1999-02-02" - maintainer "Mike Sperber " - distribution stable - priority medium - category "libs" - dump nil - description "Manage file systems." - filename "dired-1.05-pkg.tar.gz" - md5sum "392440b1472a2415b0b9b6779df93619" - size 187654 - provides (diff dired) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(mail-lib - (standards-version 1.0 - version "1.21" - author-version "21.0b62" - date "1999-01-20" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution stable - priority medium - category "libs" - dump nil - description "Fundamental lisp files for providing email support." - filename "mail-lib-1.21-pkg.tar.gz" - md5sum "4011698f9a440406af74ee1694e5539b" - size 131218 - provides (browse-url highlight-headers mail-abbrevs mail-extr mail-utils reporter rfc822 rmail-mini rmailout sendmail smtpmail) - requires (xemacs-base) - type regular -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(fsf-compat - (standards-version 1.0 - version "1.05" - author-version "21.0b62" - date "1998-09-12" - build-date "1999-02-02" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "libs" - dump nil - description "FSF Emacs compatibility files." - filename "fsf-compat-1.05-pkg.tar.gz" - md5sum "64cb1984a71974f3f40c0be1a971f441" - size 17347 - provides (overlay thingatpt timer x-popup-menu) - requires () - type single -)) -)) -;;;@@@ -(package-get-update-base-entry (quote -(xemacs-base - (standards-version 1.0 - version "1.30" - author-version "21.0b63" - date "1998-11-30" - build-date "1999-03-01" - maintainer "XEmacs Development Team " - distribution mule - priority high - category "libs" - dump nil - description "Fundamental XEmacs support, you almost certainly need this." - filename "xemacs-base-1.30-pkg.tar.gz" - md5sum "e0c4ffb2561c10755c8132b2b88e11b2" - size 430503 - provides (add-log advice annotations assoc case-table chistory comint-xemacs comint compile debug ebuff-menu echistory edmacro ehelp electric enriched env facemenu ffap helper imenu iso-syntax macros novice outline overlay passwd pp regi ring shell skeleton sort thing time-stamp timezone xbm-button xpm-button) - requires () - type regular -)) -)) -;;;@@@ -;; Package Index file ends here diff --git a/etc/photos/hniksic.png b/etc/photos/hniksic.png deleted file mode 100644 index 6394eb97894b8154d012c2f8b642a1e4c1a72568..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7771 zcmV-h9;D%kP)7UTBMwsNI*l7fq9UBd6}Jw1ql zeP~-(aA#sPGc=HdfslfMq?L}`+}zmM*qD%vcx+~PYG%~b)X>n-$jHdV#KgeBz)VwE zSW!^Cyu5&OYPh(#lzewUIW=HgTR=B8hC zI5;#kG%zqQkcELPEG$q>Ok`eJZf|fXC@3T(B%F+fI5ROIARrtZ9Dsg)fN*M5N=#r} zTNcUOw*UYfrAb6VRCwBTTMa|nSh~*C862jy8_SkjEp4G7T^F*W0d{K&q{W@IRWOX) zEk-`Z2pJ3BLF$9fr0v&WYyy!rBFJidwNalX>tk90hd zW&6|5SxtN>TItDuRY8xUlDH zIvv1xnDlviNNh@*n~8MlC0*73!U}r~2=Qz2zhg*wt(4DedH=f$NcMH`Vfs1(ET8w` z*as8RW;_w+7gq=fU-S-=2dApLc~ukZKsSwpl73(SRbyAu1TY8p0P^B1@?YtPDkVsH zOq~oXMWP9Kc~VjUM;9*{CF8*ObY_~mX&Q!JGBiTWYYd98R4xg@%F`hS#)qW%=8HIk z@{P))6)g5Qx?a+CqiLDds)^O42eXQoj8dtjvC9Q3&$tR+LX`|q5=P8mmO%N_G&2sa za;;z!QtX>YBjI`#7qQsQ6>mdk%YHmZAtk0WDSWtz;J#Vi@LG)wC>I ztbN~9rU@GiOj7kwRo~VKFaBKUF0CrdLi9Ap$w6NbWT$1@j$>arc<5OB z_I{HnH;qraad5DtG1a#hLDPFng8H7rTF8L|tiViQD6o`Li3GX7zYj2%Zf@IkozA|E zSM3&v0#i4bRMllIieK}d1LpJO4`iImvW2JuN_CAf)4(IrUR=@8lkuiB;oPZVm*`w9#~jGC98QalrZ zY$=T>zFihf=5;U>#%@B(6Drvb-e512e4QqXH{2cXvJ)nXd=yWKu>WmHQS%6tRkKR+ zByn;mejgFq;L3H$g7_OGZ^twQm=<7p{FpyH-GsX@xtton?INU@q&ftXX2&66PCSBw zB4dY_zIdEFh~yrdZ#AegeoxbWYE%5g!sH2QR-60eT!{sg;Q?=2Tr zO5s$ylNh{227drShPRZ+M2OdP5+!059E>SxFnCPYblYT;aQ!xcdRSjZ{O6$a$;k7p zq55|}!T?X$iON|io}=$-I-+F@a4o<&L~b;gjBr7Ff1f<=ipU9ew@jphqG@t}%lpyV zr%3+3N%R8M@tm1Q6f;a*w$p0axHDJ38ce?62V;jTFef9=FmES=CDAgI9r@niS?8B4WW-L>2%@%M3^IPt6R7}@i4>pGEmE7y z!F-`k_;;8Dj^R1Ngy|0=C2&NDj%6$*1+U!Z^_db^&@u$(NzR~?sW9z`kP>7D4t^^b zGB`37?+2g}$vb`?RFylui}dtG;+x8hq5|-cNg2vx;ctx4z~%XFARNSFcgy38;D-|G z)4{SA2My8iNj;YipLe#tw^r0TmM@C>%V@Up!i~UJ{@Q!Rvan< zQrM03BA)O%JnJrF3_6P_eQn}!`(s(R6j&Q$$7wDLQ-qHd#{M~{)sY_J-21G~| z@g>FkV~?N03dSaK&&1`IW3?FNJOj1fFZAX$8J$aVt7PhgX6(fzE2bD@i`te7p{S{P& z=Ocb1L9mj7T`nKYDZnqG`ZED`7l7Ja) z<}y}~R_tE!xRC@+$rUbYJ64HVi?9=~<7NJyRs}g#R1~U*_m~A_ROv~q%J@O?_`Dk( zZiU0cVYDj)RGtBoi1s6mBrM3Gx&s<_2rp04RJ~f3JG{o^DVlYGM?c75IKRo`$F7}h zTpuSNH2Sej6!gONtzm}5n$6DS?K$if%KQfyj(H>?e{Yia@tK99`Z0$2J8xFf%2HiT z9lKT%C7Ii{Pa3h<`M>2%<`JGIk6!e)Cu|>pe|FP(oz)4IO3QV$O^nP@lk8kSnF zm1F1q$jM1DIR-!8_nHTqFisy&_3Tp#+G*A6RyZC@>aJ8N_8xABLZR;2Gz@{BZEXRs z8;VAO2a&>H?(Ic(lF9c;TcS?ab*xW>r+W6n4U|z-q`1b1XUio84aAIrFz!mDItP!; zFtjxd4ZP73!3*`O|x0bTl8XxArNS^nsx0!7CntZo!wcXfPB$gSdga; zaiVo{h@ZN|&mT^bz3`E-5*P8BnG^h7w+D|O5A0%W7Rx}MZR6irfABMxz zN8Q3qCb%(V`JufIk05>rp1G(?>SOYRKfFxe84mIcc;LVv2KGs;8bfTJ&*fNgfy-LB z_p0IWnI3-o2;wXhs=dXSxg9bRl^oz`mkxM;qAvAZyzQiT9S;URLf)uhbO*(|`*Q^H zoFj_F`a37qqGiLyq~xMk1=B9{+1-9tq|%tzaMa!Wt!;NYCCwkFrAoyp8h3&{V&}<3mY4wan#=* zT)I+87XRIgWy$wqk;?j45VIW!6Siqf4#O*H!L)ICzk}wjOPdctpR~KXHQV_x_~0yJ z$a|UYusc64j%iFWu%$m5d;M}|cvkQ3?W}+O`V}3%%WLm;Tl$&syj<(^^G9|ZPx0l+ zb1&?3Ww!VL1AzY(D3WDkeG65tJsC7DtFecm^8+fG$O9-(vaJDne1|5Ml0@^+j-Fqx zh6I$B_u>oRd{Tm_wyWgyaNmZYim_}a^h5Lq;6<9ILo?3id9_@~%1<)ga>HJy>b*(L zX~(X#+v}i*W;&n0TYcsI5v8;l_vEPvp)#_iT>ZBOlu?AW{QmoNiV`sP)4OJ?)vWG( zJ}h<2x!F_xJZL zHY>Ojt-OLl1HTu1oP2jTjJ{SboV~W4omqECa4Y!tD4Ky9&tv6sb_Qwwl9i8lPy#yE zPO*60J3cwNUM!M`ucqeXDSrAB0tH?o9&Gw49wIz&tNwP!Dax7Y*~Z2S7Lg49_T-mx zcb3h(&SsuOf9W6FNC_2drytov6u2%%u9JkP=2c%oYA`%!{Sj@)`I};XE3vz~0=#Mk zc%k372oDr>y^b)ALiaVwHB>Oa^^Ysxudmy!B)W)xf3J64Ofo!;@kUSX)m(jJT7O%UGceEk%8H?KndZXv=}I{II{N!G94_}OXlBRB zMiFW~k0Iib$(XFs6czx!l2nKto`F#2OBR zDI=K3895T^wEiR%4Gn=;sn}=`BgMTvz`7a2)Yj8z_Q~t$ijJZ!i7ZlS^g$0Lee%8Zv$KD|=Vl2p z+!O(g1yY6COIqPRAx;?3E6f8?(RQg!3I7mYVd}#J%r?3Tey^j`l~T6cU$hWG;Sj}Q zq?oKoKOre*P_ws^hq{)wpH)Sy&}zh zDvikTy+|@i#%k(ZS3aJoOoy{!YAy=fzLaKk(xd%TRt$+eIDPMaVoG4!7zXD+oB#`s(i+TY5Mf z%Z7i;#$r2d>M+}tM&qP$ZT~FU&0uqb+|SGJqKjbpZwVB`k!t%yEs9c2=-P!dmV+th-+DM8RfXHiG`GjH&}0paEK zaDhw|Ab_Jxkm*uz33m%}w_2o(;Ix659Fy}ckL6ibQq*8GfW?<|JpN~xajzK7>xH+d zTxcE<$|8=$%7sFgI<)d^HtQp!(|&*Z=W&Hn#lEij*5YkZ1=)e>!FVG5E!^`!zG+q2 zHO~qtB0}A4H1n{0zK7PVf803kqfXm9{v%nj*U=Qg&ru56)|uvSX$sJwpJr0!^NByP zmw22{?3LXDtw-HQXyQ?y#md!R%Ru~$+wphbJ+M&`4jh}vwaFX2opAN;c^@&(Lj96X zeCz1X5lj;zhN?=gS}4rkZd0Q^%gSXmyYe~6{Z#&p^^fBR_K$7Xe*gYwhWE+ae9s42 z$nR}ws4T_r#82hhs$w?}yx*!YjY5WvJAcVMl*|2Je*NjUCqMo2`SW*F@w#?JYCB+f z^zoy?C~Eoq(l(VB%?K~SPM#@$?t+kgDg3tk77V+EZe})<=V&C#a;$m|_4Pj=1J3!n z4)bi&n85mI7)B~(7`m?Imp0(N5w?f7d;shldZm?c0nBQ(?LsDlu806*<7aY}et{@8DpgQqBj;}a zRC_1O+uIrR@vlQPXNBFwB8}t&sV!BQOQ4Sc-jRL;kpdAnRU8uwPBpQ3mIw+aug#_0 zh>p0#Dx>hDY&Jt9s~8Y7fQ*JR8QcqUtk-xj9$Vx05*?(tvQAHL=-8ckM40~sVBSMy z)871YeU?`I^KC2>>m@ajOXOBo!$ZgujAFfBt%gP=6J@n7dU`pwmqfruAfq|R*DK39 zy)krC=M?{GpbX_g)wIAXC9yr0_P3By^f43USSf}$`8E^X?iOl2lqj)nC=tOs+|ABq z;6a6z{V~O}!QjxbEb9jRj!g3-sZqlnie%?~=zIgOcZFl8#mYD zt5NtvCfnWKj`fQty?66MraKHn#`1Z&ANfnAm1O+TzmHrS1oc<1NTTM)Bc?+@9UL$? zT@&XuL^qx0CpSM@*7wabbV97soQ6Z8C`!$4cDn$9E*6X4U$+4`9A;$TLwy#_A=~a~ z;EqO)eQ|LEshWK029v9P#80PaY&%|h5o7{rPP1<8cRH~ny!zTI>OMaFMEhR6K3OcT z|5~GHnjvZa&wIws{mS4#&~dB_w`De)=4sPBGN4HYsxw55_bWac2~;z`ujT+prC)tz zZEX#GtW2{{wncTXh>GR<8opSl)gay^ZR1b{1FX^E=+Hepys%x^>1h*PCn*x9a|Cns z4ytNw-b12fqu98j9hmSsf&(6Eu{zq4d4{d+8d|PM15J9b*Lzk)N89*IWnAIM#70mb z8%G`vT#EoZAV{`j92^<&N{=DOW5HfL~MC4BHQ2PCI-^XJvq<@t>9lb@ldym#HF!8qksr|qtPG__5H!%mTZ%Nfq8p7nz$C>fmRcOZ5}mAqB?g8+FzmUmkOpc2PNw8 z>a+v)``X$nvK<0-cN-B6`eQqqk&_dPHd6?1K-;zh21vWvqY-U6*{xI3A02cg=O9Ew zNL1PsZ5T&XQ^rSw&90)+Z1l;r{u+LOJPY%rjkg%X>lIIE_hy|aeuX%{knXOS2fCA6 z$khQLWaMZFHO3FCU&nV|*vu9ycWC)ZHW#-|$MgxdnuY1?m z@I0iV@tAaYpW$7xHe$pMqro{wHslF`(pj=5@g(O*WD|I)moQFoXi*126ZKy<6U|V; z`A}wgwmT=X{5+z}5m%mp1f2x#5h zz%KyY%4zN(T_3$`(*9Xb^!^O6Q?Fj)z<7@)CgN$7*dxox6-ug*Mvd zZ8$r??xB7^fpu1FNt~VFd%S%6!99dv4+joVc``h;!4Cgg6md=s9bty*CI7ssu3ugf zVCv&#bvA?EP>#vqhZ~FqvW%P{MOX{i$~wd2Csq(Mox_oLT#d~15Cl(w*C8xGA>zRG z4-O22*(Zadhs(=U>QcXaWnP-7s<*q@8ASQ)S&cm5-X7&6uuIx#8vfqCKVU~DzD#Zr zKH1qA=gMWLP)CP{1c>Zwvsik{5G_Pek|zt*ghzKp(?Ad;O{-eihS@-p&*W#lXYcyO z2)P|H(1PXy4$-?$hioS7C@(u4?HrPoB1vEop5=5-Ay1}2+>QhuRb{#mC*fUQ8isXg zy{m2)YBFQj>%Hr7YVU2du@$Pv?t|R`?2!0Kb%%~~aY2xT^)D3n7XZ580zGXtS-@G+ zAH#z%wG(GAl#?YjPRJ8a1jBbVRPsm*y~Qk43G&c+bz#43M0 zXb~pzt?f?Ss|yzbw3)On zE}%9C72(Cjn;YxKdGqS#aAMhSZZ7!yP~#^$?;TI0Dg~xkmzVqzDukUPw!iDW`}G=8 z^Tax-NNmfLw!GgXq7592N$djhx?zyub-^zE>J=~@dtieeUcz^BFD#Sl33dRKNs=V0 zafWy#t1;mCrnTQhrF#+~e*j+lYg>|Rv<>_1`z?|r2@^I!MUuk`B^!~NuYVm{uo!s# h#o>i>)hsEA{{>l4xAORBz}Nr)002ovPDHLkV1kR%C9D7d diff --git a/etc/photos/hniksicm.png b/etc/photos/hniksicm.png deleted file mode 100644 index 190b4c9229ab1bef52ccee733704c7c94c099cfb..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 6858 zcmV;*8a3sKP)kOIX)XtV>DVtsl)?<4Fti8I>)#wF$?FZ16pTO{o_=Og_kN`_q zSb{MUh(*ibj%sFVILYRztf+HNX8IyCtD4&vO|m;H&!33+;)^eW#Ty_4z-cd8$in({ z|5rvbk^#9r4wzz!F#lqCV)@Pqul(^>@dok)Dj*kPbXTrtRicTe{_g0epC}O9Pes@y^xO zXAGOqK3~E77gJSUQ@r8L>r?Q-n-V;hUv&Y|b^WluL%~evrOZ%M(A%wo+OpQX%Xyh~ z&E?m6I27M-H1Rpyu6=##ejrnuKV9X0`1({t|6$FE9 z9+03q$4;&Noj>xGJ#m8jf=fWm*9=0)Z_Q`)DJ(8a zVVHs0!zXZr47P+~FNWq_NLK($uEW#LFIH~Au!M!JmeS%IPGLdbKfcQO)kpu(`4BqH z)b37f(5mF!8Edt}^yCkR*V(HcTb8|xU30% zW7c6{9R~r+>vQ+uzd4M}@!(HSK+u+T7DFdI$GvnN7~1LmRh^d|Xq1^&_JTv2sr(GhiwWl7Ts40p-kYz)5Pay^% zrf=wY+v0-{rM2C>4Fj?mkp1$`Ebs`}8xWo0OrKhL#VtX|3uxVzvl(9lNcWR#J%JFO z5lY)sAGcDx8FbggwWL{w*>t!Y3_ z$8t8Zf|4~Tn0*txKNuf@qpl&1z{3i5Yaq;j`jh<)ooaH{S_g)SoF${}4%cD9m)-5k z6!H=&Z@&ob6ZpP+q5&oO^&BO7qX>qoNl-h0g<;9psygRy`t!L1WHdFKGm*lL*4fdk z>YDTI9<(|K`Uz$O>MdFfAB^MC*f~(M&M-7*#FSW$vE~s|Yy0>yZOVeqwr;VztE|Rf z>D)>)Za^FSDZj~Wb#6Q4@$qJaEMSJl`8q5U$D)D5LI-iyQN%_`LSQjS1-(!i4aUQliA#MZ`Q5I zKGRAFuikd`pfO3-7T4}MqNpQ zB1lHmu_*C1OyRv*tK?6%t0*-zUL(-6*YmpxEpBeL&lRAHhM!SMKt6! z==7G%OkSO`-HN!yISy^Nb1u{N=hxl*BYk4u1v?d`oB!(PcdFhYQSdq29e-Ch_4~JI zPy?!Ae&4g7S1r>*BD#*&Q;ly>2?lC6DG6)C1_sQFi|A%>#$ zCshP3TnPxyWj8f-1Y&$KNru=bN4>r!XLbkw1kvuri6UaAl5MWGSu@o_4p6IAtAUsA zyXyItQP^@3a-AC>)_}hZ1!+|-X6JWb2&TG}DmR@%L4qnlZ&0Z>Qb;9Pj1sDfaQ&oc zF3-FxHrMTdOVW_zXAyGTa-C?9Jbd=3SY<2mY}aCJCHS3Eu1B>eM1M|kLngDU44n5( z(YWU?T&k{U!-WPW2V;%`Na4t`b*kvu7VT!v?P{3m%4AfewY4t1vEhJUXon73Q%}!% zHax45qP+sw9g$QN43wKRMT!z?$W2;eF+2gz8#^$-%3vURPgbU?ssW=~ACwx3XQN16 zU14Jzn;gw{q6A9nI+ul^)tZf zxbZ4QzTjM4J18o)1x4|k!6k>OnR;18pO5Q#)l%k@>n$nXpAk^QWmo7}Q^%wXr6mF& z4hIzDrW~+=D!#we$u%fS>zBGk^^Ic zf;ty@>k4F37Mr4mIK@O+dQVtc*OO9r$$91ez}wkZ7yNmeC#l%&KB?0L+cZt6O8{&> z-AUC@6w+*A0~NShY07c*wEIP_yEBSgN-7cW=Nz_*E2{Uz>wfmU9VX{$F63ge%9Z10 zWDFBStOVlaikpOj1g;;;Sq;{;!qt1BXQ)vUa^T}i8^hDKfVNFdlP)R6?G&R_md5hR z$atmN=1PH$OVTq=M1vAeV^~XNTaNIAPnRce9@M-o+LeWunUFL6p-Wb9LqDh|+btYaOu6Isl)0*TQsQo4W-_>(ToZpmE|I9$2`rg{@Sed8wA zkB?*FNNxvPMqJ&+@I!x&Kn;{5Zm!$?O8IUo%UT|*K;UV@U68Z=*Y;1&bCNHo;#sB$ z{h4GRTtV|($N0RiE_L7c=Uz~?4z0nZa$LJR`b6bf%2hR!{gdXy-G-u@hT3*EAvMs% z#~-UMbq0qdeOXlny!fdf&pmn1@uuuJVXa-(Q`zmDbAZmNc&6AZu_t&6h&bxWZ5=6U zpWtA;`q>UP!;~@NBO=dfQKfAmI;3AMr*{edPOt?um`YZj6h0zy`lM;1Doh1Km4W(| z|J_j!p6zDvr0oa!DMq@3YyFoGsLwCXq?$(fqWz;z)=YabOz^=&p20^=mmJdVfBO8r zjUWXz8?MjOW*5FVu@@_m?S%^o9PLs1kKWR+?1@v z@{)JQm*1x0G`4j?Nkg%H%yIWPY$ztU41-WzT}`B&3X$wbfU1VW;m#lK8pVv@Vn}$B z_0}p<1Sc=kKr3uY@L}4x<}wx6x~Oo)7KUoGk@J}n9D~0^>XE)lp7x2vuXgX}si{Er zYlmr8eNcledGpzJcw0xFrDr%ip=Ea!7cMXIL>&uXd{A>WmCFIBbCr<8|rYj-xvCMVjgfwnf@N;b5{$B5t?!c38@v4u#t>7hTdY zLm+sbv_6;k6Y64j-v5VOi*7bEW|S|%cy?(>av`&QYz&tgt)5d$rXDr9lw9ZzOG8fW z)))eXmQwGX#Z|DhMVCmr+e^&Dc!}_RLlfh>&7WLUUJ9{W%FS0z|e#=87hO0ZCVwkVcei8n-Y`<0Ww| zWR;`ZdBxKWNl>gjc?g6#(pUS`sUle=YZDzSz10+``3SqYpSpr&zuGep^--WOMx~GyTAb z#dDmlb1UQJm+c&UW*<+<%$Y(6KH$R>$@d9A%?FN+khX)BMRJ@f&e!_O>zH`Yvp&D) z{61ouGO>vMyF59kcblQwEs?(r6i}jhu4ry!Gi%We>Q!HDUEzjm>W2%LYGAm;c!lRb zlgA(b@YDBiBPgzcsR+g7+OOt~&n{w}_qVRV+;2Q(z0HG|hK0o3uNe2Z{jeS8O%E6H z~N4^PlY;;3ndPt4NlYewVJT6?9h0xWySNm) z_uC>OiDnB)nvx>IkdoVR?u%_Y=*Lq*x1pO`Ud6A=eKc6G{!QRJP096r z7^+X|{9)Ke(2gQz9BFqeq}P#_TXSrdu>=kNkCuD&79W-&hfe+Pe(|_Xl1VP*CST}# z?7Gp3en{`?e(H&J1Dhey{zg@oM%%n-*RK7y`6uO`yT2@7Zz16QnhrmCJ4D1q0~>-7Y$SQ=g+`OeP%h>H_0FSBf^L2^x`nx^Y!h{cZ- zOxOO}m7yWI1g5Pje8vApnI}7z-jUv=A6azck7n=gZYsy-av>K1*<>b=%hvT*BNo$i z?XNt7fa_tTJwR*!NNX6@-kO^?|6H3C-1-B0?-ZzYUaSdhFHbJLwgD#n~?X9b|B13j%7oz zOcr6qYkM-^X4VO9c=a~sG)MwRj#2QFvV|=qTq39DOsZpIBtsSs@S5XXI9PXU>D=Tc zs=vxTCMF^ovgEw~HlM;bzkaO$HCa4cS&l;!whSqnjYZZ-UC4E~45T#ld2}(kb9EkH zeDLFWe9?7gLA*TDcEL-|WX^`RCTkj&qz`66CVsD)p2u z^|VO^RDhi28jsseMa}y zv(@o@O*Iy6-JPUTePAzQMtY^pJ)6ho;o*7@-Vxr#MpEO&b&2lM&+ z7EsL+L?|uHbjp;@)V}$w`;TA!$$pN@^S=}kC~$7$nl_f1bN?ZvbBw^yzsq$>@qO0^ z(Evuy-=7`=A#e&D(GERX+s%a3)C^I=TDhZe_=o@eYb2l9oum6be|Q;Fa>WG_*|}>-k8pT<#vVt9OH>yO`UXQ3g0~z9T}#FjIC4Cg zr_J0S*ROUyYNj5xq)SXdkC~R3iI)(_ctLdzv79p}yZ}Cg;F+7IMj6P2j7K~V%Ikmpb8SCd zQnH?0z?7knF{KeMv2as7kC%y=X?tO)AP*y1VRhmvROW6a#t=C^x*;E9bbP9@BUXu?x#%nq};4!Onga9mKO^XUELDm$}1(WR<1%Y9*M;T(CUwn%8gO-OE1%-oDzB zh%zR&m$(_HAxorpi3TP%%WREg@zyTr=&N%U#RIzm_};wGwMalsPpADH4zuWD0!#FrSby>3y2E&bqJP2$WZ)sSR%)V2YCJW^U5#ZHNX4SKfj{fTr)kyGL1c# zi76$BD`_^H$I&z+&107NKPtWKvozBtzW-1Erz-Xc{PLgYCBBsMu-1LSfA#L&-+%r& z@HOxLfiKHnWiICt9Mo4JRx%|=8Ogvn0_1Fa9^uE>?l$plq9X(?aunj^;t-hhAeEuVk>=Ih^n{jUGpp7GbA66Z28R@*JR zZIL#SMqotiT4{aTshI5H`#nrVlh5|~#4A2~S4@A(aU;#2o+P)L6<&)LZ#agdahL}b zfp7U7_?DONn!e#k*d{l97|BdU7td-yU20kJ{;@qAIh^1?{_K0;^sHtkD_4qF-yijO zV7uY8KV|Lw{_yKoGJ6g@;DImR0DKO>=ik!5wBxf!e@riAB)e45M5z15;am-j?Me2q z=jA(jCmC`LhupQF0r1&p|L|%1L*8@(Ro3qH7j66h0qxX=8S>HW2><{907*qoM6N<$ Ef;C5sQvd(} diff --git a/etc/photos/jwz.png b/etc/photos/jwz.png deleted file mode 100644 index fe55b4febbaed2d2af5a21020bf726175c1ba867..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8056 zcmV-;ABW(HP)sbY01s7FRWmb0L{&uf$e0KZndainoUyO1o@3Our$j_mcV=et z;^I|ARp9gSQdM6>L_}bYlp-QCRYXKnXL=DLA~Pa0goJ-0A|g2x8?ups&z+4F6ckT) zXwB2m5C9PH)1#)dkLb7hg#Z8^Qb|NXRCwBLTa9Cy*q3GMpd_Ue>byv`uc7i`1=<-m z5>|ewNF1W;|NjT=Irm|j&hAUJMib7v-{)Rlt%v*9Jk#lk#$buBpHp)d_6j!M=^fHTW!mC7RjPnVCg1qlq&$ZDj)Ao^OITD6?py@ zcs?HhH($AjV$uM(YXIDKJ@7d>cV}GvJQ{Vxy+4o6anfPoH}Ua#k+h2#z)b+)tOpi^ zSKO0ja4+BI|5~T{>f)xe0I-V~xC_AI>WN5vJ}2Q~aRyW`@OhMU_>Fdf-6i}1V#kZP zt)p}}{Qi9<7krC*mH6Mv=E}T{ZkoF77QhAUV$p>V7EoOm#*3znfqTBL4!?%?nzrBA zxl7_j-Im_xivbpCPQL;Zb@lyMrlX49{U_b^w(_-;@~o#r~2S z+7=~@IF8Qw-R?}WI`fUs z>HpnT8OHnLNPW2cMHjmJ1@~kPL|#0;ztOav?Q}GmHH%hsynu%3RWU8cEiA6K9pP&T>XA@5BRoJUmVfrFA|?tmtn8$?|)q-zF9}rL^X}rEH)PI z7rZxKoX=g4%Oo;N!i2w>(9+xx+>bj-jPXZtv;Jt}^%omo`nCG$^{Z4@lcq5pRz+DL*@jqTMP!uXv*{hPp94{TIzwC!z69kfji z4;Cm!QVhA0kl?-OCU?Z0QFzCUkziBZ`TqP9p5I*;sL$gpzlwYZ+;`ULD)6e$A$ZCr zItZGep_sUI7~V@zhG8h;ib3xUt}!t-w^+!I!cZJ-bY0Xp!eHZG4w>^-*VZY^e&((f zCC)EOS3%PRLD)&^kC`YTa2zsRVqP2XhKU5$nQjbRIzJVJ6fH^~o#ksJo}C1q;|^Wm z-n|xyS5=$*g2%-x%ch0I@Rt$23CM_1+B$4I(H_Lc2KZWniI{OiXkf>Ly5gQCuCPaa zvvfaXkAv5UvQD3euh8EwwD3huCdkgn()2B0K;I}oaU#w|ZJxVOmShO=zlDT5pTeZ~ z0V+B%K8{~(^|$PEb{U-BNc@U>xy--MSGlVy7SbjR+ZY}bheV673%Q?Ggu;!+kzHbz zuLyNaq~><0jE?$FXbRb5Gh1FR!@qv2`jlOIXrt=6<4sBm+&0iG?3&x8^aFt@veo1wN~FeFI7sF8WjzeP9%xb^^*I0xL^X^b-Hk!;cHAG zfn=08I|?#H9v2(rj$qLke~Dw=Kx@<^;<^h3Z^4fsNZcmRu`WH&#rmTF^i1o>d=}Cv zLzFDoWYO+nw9*?6S65_aE>ZQ$k$B2i-bVQ>=nEEO>=b}-7o_dh?1OSMnZ_ZWSpK!= z9FxHVtb9sef8-xpbClUW(y;V{GZ=V7nxi-%nUW08ndF|QAA!nNc_ z><0`C>7|JSmZIlHvvITI(O%k1=lJD@D%W%o;{$P1;m5YF+ZOoR{p<{0CC+H%;YG^w z#aU%)0xt=GOkFqJIwbDmMoRp?C5LOGsA+Wb{2VWypLMZZI(Cj_J4+W*@8D()G+twW zzTSbz$W9=!c8{x98zXal=J%x++AY*1^2xD!*G4=;P$^VE)*au0S0k(!t=46UYemRxP(vx=4!8)tbZz?x!9Dnzn9tm(>fwb_%W_lQ_zU<$vw#nEK6rIQ?gba2z9BKIN8}hDJcVvC5pY*ZJjEJJ zq47r}cWzrt2n~_PJH1s~?N_Br4@elVRGPqmqre|1^x<&3(=qJ{H7AmN!j6vpEJ*=a zH6<=5>xzjrYN+bz^aNxGJ`iggjoTS5eb^zes>rWqsb_#eD#f|xly%&%!{Lx3aY4&? z1aRY!wXvni`QQh53N&J5hKNE{YLGu5aZZWx$c@tTM>v>`Bm0qc zR@?!=?&+6VItBFL#`s^mhH zXyr)|1NVO*@w5+Ulgp^=a+a25RPMa-%eR;G@NzhO_;Wl2FvLBGl11KvC6yZWHC2r- zqAr43wt*}X1dQQQfgce$h)`zp-01o@6V8Ky5jtPt+i^?fDkQOCHpX+Beth|O3uJ4a z0`ZXI8L&GD648>3*?_rcz}kK8n!5g~Y%8cE!zCHncs~ zlbh_2zT84ImA(`o$G0DDKaK%>gB%Lb^cGSe>ejTd78~~!nDqi`SV%2Ih0xE4&Do|b z5zB4#d*nLToM{5fuGSSFo0?!2T&HNt!_ob(qj>XtAkDWpS9%M*1NTKuHjsAh zi#6jbE($|i)1_z_ z#mi3Zc8c<1^-K{(0!2CL6B3uj5KIN`ks2cn;keU+&wNbQmhQd0G+Ob=xIndAW=|g5R+(YOdfdVX-)wz|KA)Z_SjOfycU@2|uVSj!Frza#A6kZA&#vzhpoL z4}lMQU?C{owXr3M1TP8Tom#iZ{WKT-HkPcs;5d&e={N;2iOdIb#DtM9v!&}o)my=a zI0|JzP0%rx5FA;pD860b*z7M{HVIlJBZ~ZM!U?)&ph?xC%C)J6Ezu}-!^CBl{#2r% ztAah+&2ENOf)RiPDc2i&?A?Sgf?0n9%LNs%ZMeAQD8KT9z+ltheh-|&0q}wELy=I2 zu1(79J*_6K^|1qR$_k?K`d>&~xkSgMcHJ>CojzUJM|eI-t_^R8i>1xlCjzS~9+X6K zHAx3P(436 zX|YxA*vm{elZ(LM+d1eDYY$`=z4|Qm0=%P-h{$U+8&Y*5*@u*==x3FTKy%>E9>hle zs3wRkFWtIMmOnf_*zR9;3O3@p&ZD7SNMB52OO)ib;38l9468nzZqvyc4JGtkiO3A+ z2GySVfv-xYaK0I+?BSH7`F6nzVObOlRVef@c7A$z%EvJO>S>Uye0cVjZ{*kt_u+8b@1>o zm^*{%$@<5!h3XDuL-=>BjY7F1`dH-mz{nv%#lg6)w!m3OjB3bZVpNz$gt8SV&w&)k zjBq6nzd+fEY3kwW^mL*tJwBRR#eQNieR|40?f13}3_84v2?V;{DH+Jq#VTKKE2L&W zQY?HvFrn*+O+%w^tQC7u0^_rCU8WL1LOf2V>BHBDr|EB}>2L21t%r@L4-dJ=!e%@R z+SYYrQl_Yyqz9PzP^1i?fTnbnNlcmq8tZqRA{kkhZ8VMF1Lt8`n&R?PeD&)IKN(;f z1~}QO*KNQ$4Qd;N$X0t6Df$VXdrZW4{(4B{` zU!M$QztBxFq^OCd>Vvoz#>^Cge~iSpDXv@lJ+j~DPcmmA&&U+mK%i++JGYJ;bd*t~ z$ZLi2JUo5<`XJz6`GQ-R4!}ZkS|BT%nxWhH!qgi>2$;EGWvH5YB{0B-0kPyTBkFC* zaYDqN!8Q|?Bhr3^1~tC|6Hr9%{}sl!v>ze3?RE<_iZMR5E(6faizq~=iF>?n4%P9JRZY8QVxIhN*k*dx!=3ZPC@f!q^JGRS+ypIS6#kz*Q2)*S0nQKsUSZ* z^#8mUWE5i<#`63|x3M3$LcOrq>nC9!PPa(cwYZ!3R~#cvN%IYfnH-^RlE4*$ky(c|>nU-x5fJ{MG0hzQtlZE+sv;?W?B4eHg|B-lfIu z?nSMQo@sxXJ8GA#on%Htu2?b{P|O~MS8h?6zqzipWC^+|`KkY+Zy}o4HF`8|Pw;AR zWpQnY2SN{Vcd6RxxJ9f5^g!?)&|ht(J*C)iswEyaP^BCj$0lU&*-xi|ZRMbw zB>;y6p1HT_2ehfX-A1w`;uy`bl77)-Hu_&6^WhjB8`2^~lHL$$Y?d;BIod*9{^sP% zC5ogOWlBW7@hw<4YvQEU8ya$=*T7q&F*J@AGmZ&N~}O4&wr$HA8~}6Oa@vm(rx2UTdQ4fP`S>HA#YwzFM!>x{bev+^C) zxZ4$*3bGQKG&(+mgRI+ja>y(aMhjM@f{&Sq%$KeZ0>em{l%M$ZWXufUmF?9@7zTb> zt;=-~tS9UB22UF>9B##$Z-kfwS{vX-n)0CBD7*pY%BnhGWZeLQqN84yf{G4G!rC=* zOLIJ>zE9Iro@Z%;4jcj_&6l9$g12G!k5^S`&8gU0acntuv}`x9Wz<61XI;6d$3w>WU;ub9qi5gtWf`zwb~H*g;}Ir>&b>) z1zPeV)o;q z(CToT;>B(Har}|9HUSpry4}f|G)Ys*8=6OV7B{&G$gzh2-mpQFJW?WU!t6@!aBVev zRJi>Hv6*Z>2<4H3+;P?cfEGIpU%n8L2QwrsE8aZ|Z$ZQzWh%?}p}bQ;43y)-ZXN z?p%9dOq@k1atqiPVh)ENlwUZ|`Gq-?nKQEnlMNH544rlr3dI^$EGxuvD5pvqSNfj| z>%GV&}nRm9`;7$)9f2icO7{6Kcph|(y@3qelT!U z+XdkWSESmN z98;7`KWItvk}!S`?oP2~Ql2T^RKTOYGJv?R$ufQM!K+arclcJH+Aa*y$MLpp$RiLT z&!i=bMuEXR=JWh@Y?xaE!)lQ#@zcPf0-jFq-w({auM^UTvuV3#pL7%g<-g}1Z=S7u zg4mr*KIwLp?B&2x0_z%yJ07rUW*Gu`jQP?^Z6!@ALhAcRw2O`~D2z8opGUqYL2`oP5ljDOfZSfZ?ih+s%#^ zuK)MblXQk?$4(FU_e5Y+2kIA{#+}S=oub~iO_;PnLqUuQ(mz*)_6DNh4x6fLj#loY6pvucX|xJ1Wp4;XW+Jli&$iMFj#rJQ98=DcFXal7AwX^33RIX@E~B6t2{@I0v|_?6gUEi=8fg zFP9%dpnHDD_acy$^E_i>j+lhTo3RY*zUR9oiY|OQU(OWU)RQne8@W4`B<~JL-=Sy} zE+kAun7y){Y@6(1-mdjy9*dAuN#Q*Qg`sIjL2tXC&h&QeLt~i^49nD7w=7dud_?nf z;Gj;aT`@}?(ep#jsb#sr9vyqWT8%Yy#arHf8;7s9gV6guk|T!$R&L%k4NY>ze0A_R zj&9@(!0Lzs_%d_{;!>yFB?*I!Z2BLjz{ML;bz^7t+~&wn6w;>? zP8P++Z)8sXEkD93TQW#2*PG2=mXaV)1e_b5K|pUlI8o1;d-DPY`fZs%!YnJ-51XV0 zi3_;@dodfH>wBI(O4y-W`Blz;>DeeJ4i}MfWZpk_)TG?O;Qa`mq=3K{S-U$fP!zXi zX71(Ex8gmho959IbFq;Ls}YZEw%XYES1FULrs--)?5j+GPpfpR%cA(kGU1{|rA1lJ z!0o}tQtV;|^18L<&h-j>Ya{|SBC%05Pgy0QImy{k;(v==zu5uL?v@-tP`yjgEieR7 ztdA*gfR@_{8Ypy=DV`51(t7K#fv_xl9O3euKLi~j(_9m34n<;-ls5kVyt?jXM$#*( zYF2kgHJm#dQaa=L4sf8N@MaTsR1>s?u4GJb`B@8Pu@W_cVuTaT%7JC+k9!{q`w0GZ zC8*HbOh!r%Pt&E+0h&G#pP4W%G_QO`uCFF43QCzi%>nHBahtFYYtQkk2BlKeW)A=! zbyt~r{^8Y`UroKJ+{gKV>G;0~9y?peT{W9#BqMC?%bn6{<1*w(sp;0vtY#;M)D?7SJL~;xeFrH?BxsDpiRib(SF*o`Q?joq zzmS1h{=i!B^yA@VjiGK%P_zbp(?I6UKeb%thRIW6j(RljF15PZ^ZpU8G^)d20{5q? z#j)xTDUN(BY()Vr3-h9jyg|=+o(9W9y7nV2GtW{7@GC^qvL9LxMBuEHle?|l9}MfD z=@P>S-XQ<#)pc^+74}!}jjCCqw99HJ>olJ)QHjem^Bfy31aEI;f92xOfSnIcxoYHI zEsrDxame1SCwtw`8f?vzYfaksG|-4osc9OdKHlmok5YGKTKNNxJHLA}KfF85^S|bU zyVJXezm2L_s1ON((R&4TyQjY-zh>h7FRC`5>`|&AY}dcuceR}Q)ye|$4>Kiw;`KQ* z<&@>_bT_yg{5bWnrk5?1c{Ovp_ODFd0a(7Tdf4Jt+AmA-Qy-CpPpJPH=xi>KFn zIXK@wmu}A|IoIJG7d)8KfPLy6`t)Pq`BYcS0Z!ZcP;$%WrRS4qbXxbIh= zQo_9)WL~se5TEO9ho|?16o2Y5Pd|Q~IDqKn4|%APXRzepYCtjC>)^IFxmtReSJR3=k;jx}&`FokjKl~u>4@0h!KfqQwy`CCaS_~YhT9p{F@KfHVT`yK4e`4Z@!m#%rr z7N&(oso{Mir*y~{1Hd;%tuzF1lPj=*)O;6z_iALMI?gxw7q#q5jtufH&|vUGV(JI= zKFGb@rjl_uc39)jn6r?%0^Q2#aC7XWPZfIx?%tYTeMlN{#xMSM&zwzUyu!8ibpl9#rgTU0lT#G-mB(Lwp*8)13~_`0v>BYP200N)lnVt@CRr9ZQr91306ftzPgZj z-o9mAw~5#neNQdcZ;@2G7BR*D-iBW68BDDB!^_6*_=fZQ%16fu<#L-bD`6Y3f9dML zZ@J%?wUy8%p-gjMER@q^Xoc{X z2{n(L!c)&?ph5$QDv_jOPEHXUE%{{#QK@oD{U$vTz4>2TW#Y^?^=Y&K0000&~(|s12Hi%Sy#$#AQrqB;%+G#prqr><2!xZck0ne+L_<{pRf0M zKL%D1^H98A+C|t=;+rM*ClMx5+b{8WHUKNiVz|WDP=}p>CNqB@LOeNELO6?ASo!UQ zan}fmAMi77#w4VUPu(Tv69|imH<-@pSvXD}F@}T+pTECk={I%ABpzG(X9%Be?^*im z0Z3jCTlz4<&#UVecix1R?FSZjA;bcr#f@1|mg(>~^RG4tTRT*@n_+E9h)q(xX2^U= z>|<1SN#t%*L0Kz~^@!LB2+CK~z9T7u$j2c%LhW0&{7&GAuF!gWbmb=!1Y#2Pzc}?? zE1W@y4pO~a_ou2l18}#U`d?VhwSy~3{EPPbngVT;5Sgd>y3-j6UL*Ak6i|Ly)7GFN z3iDqVIu9*)KjpM9LiCm5Tkx&^gx}<1w?&(}76is^01?_L%C%muL6`*QFOVDO3p3pzg6zF!t|Xe@BXg28`q3zK6^+|>IhG; z@l|Y|Bb+r`yLX5ndW0SowQv<3FV|BoEKeX7Hs&<>rQ>}{91Xdc4>CSZQewG6>u$@?mz4MgKD8@4 z2ZkWz=HMU#ip--NY4rf~0gTD;+R)1n<-{A8%lC0&<0 zI-)S^BztA7Q{Vnxg{HQlLVZ2A;zsHgJr>RU&#Dh&Bl!a;t*@3G;(?|zt{vAuoirlp^f z)2|}Wxb7b_3HvM%oxH#B9n&k#R*gSpTw#zu!-{W18TeJJ9u6Onqj8Bb;9oCn8HZ(z zsO8ozzDO1~hRfJM^}cLzJsO4v7TbusQN|nzcvQwfR%f`Jn~STDoi~9~C}+U3uf~5a b`Tz01avbm8QFpxQ00000NkvXXu0mjf0IN3S diff --git a/etc/sample.Xdefaults b/etc/sample.Xdefaults deleted file mode 100644 index 52199e8..0000000 --- a/etc/sample.Xdefaults +++ /dev/null @@ -1,288 +0,0 @@ -! This is a sample .Xdefaults file. The resources below are the -! actual resources used as defaults for XEmacs, although the -! form of these resources in the XEmacs app-defaults file is -! slightly different. -! -! You can use the examples below as a basis for your own customizations: -! copy and modify any of the resources below into your own ~/.Xdefaults file. -! .Xdefaults specifies defaults for all applications, not just XEmacs; it is -! normally used to customize fonts, colors, and the like, while ~/.emacs is -! used to change other sorts of (XEmacs-specific) behavior. -! -! In general, changes to your .Xdefaults file will not take effect until the -! next time you restart the window system. To reload your resources -! explicitly, use the shell command -! -! xrdb -load ~/.Xdefaults -! -! The resources will take effect the next time you restart XEmacs. (Simply -! creating a new xemacs frame is not enough - you must restart the editor -! for the changes to take effect.) -! - - -! Colors and backgrounds. -! ====================== -! The contrasts of these colors will cause them to map to the appropriate -! one of "black" or "white" on monochrome systems. -! -! The valid color names on your system can be found by looking in the file -! `rgb.txt', usually found in /usr/lib/X11/ or /usr/openwin/lib/X11/. - -! Set the foreground and background colors of the `default' face. -! The default face colors are the base for most of the other faces' -! colors. The default background is gray80, and the default foreground -! is black. -Emacs.default.attributeBackground: gray80 -Emacs.default.attributeForeground: black - -! Set the modeline colors. -Emacs.modeline*attributeForeground: Black -Emacs.modeline*attributeBackground: Gray75 - -! Set the color of the text cursor. -Emacs.text-cursor*attributeBackground: Red3 - -! If you want to set the color of the mouse pointer, do this: -! Emacs.pointer*attributeForeground: Black -! If you want to set the background of the mouse pointer, do this: -! Emacs.pointer*attributeBackground: White -! Note that by default, the pointer foreground and background are the same -! as the default face. - -! Set the menubar colors. This overrides the default foreground and -! background colors specified above. -Emacs*menubar*Foreground: Gray30 -Emacs*menubar*Background: Gray75 -! This is for buttons in the menubar. -! Yellow would be better, but that would map to white on monochrome. -Emacs*menubar.buttonForeground: Blue -Emacs*XlwMenu.selectColor: ForestGreen -Emacs*XmToggleButton.selectColor: ForestGreen - -! Specify the colors of popup menus. -Emacs*popup*Foreground: Black -Emacs*popup*Background: Gray75 - -! Specify the colors of the various sub-widgets of the dialog boxes. -Emacs*dialog*Foreground: Black -! #A5C0C1 is a shade of blue -Emacs*dialog*Background: #A5C0C1 -! The following three are for Motif dialog boxes ... -Emacs*dialog*XmTextField*Background: WhiteSmoke -Emacs*dialog*XmText*Background: WhiteSmoke -Emacs*dialog*XmList*Background: WhiteSmoke -! While this one is for Athena dialog boxes. -Emacs*dialog*Command*Background: WhiteSmoke - -! Xlw Scrollbar colors -Emacs*XlwScrollBar.Foreground: Gray30 -Emacs*XlwScrollBar.Background: Gray75 -Emacs*XmScrollBar.Foreground: Gray30 -Emacs*XmScrollBar.Background: Gray75 - -! -! The Lucid Scrollbar supports two added resources, SliderStyle is either -! "plain" (default) or "dimple". Dimple puts a small dimple in the middle -! of the slider that depresses when the slider is clicked on. ArrowPosition is -! either "opposite" (default) or "same". Opposite puts the arrows at opposite -! of the scrollbar, same puts both arrows at the same end, like the Amiga. -! -! Emacs*XlwScrollBar.SliderStyle: dimple -! Emacs*XlwScrollBar.ArrowPosition: opposite - - -! -! If you want to turn off a toolbar, set its height or width to 0. -! The correct size value is not really arbitrary. We only control it -! this way in order to avoid excess frame resizing when turning the -! toolbars on and off. -! -! To change the heights and widths of the toolbars: -! -! Emacs.topToolBarHeight: 37 -! Emacs.bottomToolBarHeight: 0 -! Emacs.leftToolBarWidth: 0 -! Emacs.rightToolBarWidth: 0 - -Emacs*topToolBarShadowColor: Gray90 -Emacs*bottomToolBarShadowColor: Gray40 -Emacs*backgroundToolBarColor: Gray75 -Emacs*toolBarShadowThickness: 2 - - -! If you want to turn off vertical scrollbars, or change the default -! pixel width of the vertical scrollbars, do it like this (0 width -! means no vertical scrollbars): -! -! Emacs.scrollBarWidth: 0 -! -! To change it for a particular frame, do this: -! -! Emacs*FRAME-NAME.scrollBarWidth: 0 - - -! If you want to turn off horizontal scrollbars, or change the default -! pixel height of the horizontal scrollbars, do it like this (0 height -! means no horizontal scrollbars): -! -! Emacs.scrollBarHeight: 0 -! -! To change it for a particular frame, do this: -! -! Emacs*FRAME-NAME.scrollBarHeight: 0 - - -! To dynamically change the labels used for menubar buttons... -! -! Emacs*XlwMenu.resourceLabels: True -! Emacs*XlwMenu.newFrame.labelString: Open Another Window - -! To have the Motif scrollbars on the left instead of the right, do this: -! -! Emacs*scrollBarPlacement: BOTTOM_LEFT -! -! To have the Athena scrollbars on the right, use `BOTTOM_RIGHT' instead - -! To have Motif scrollbars act more like Xt scrollbars... -! -! Emacs*XmScrollBar.translations: #override \n\ -! : PageDownOrRight(0) \n\ -! : PageUpOrLeft(0) - -! Fonts. -! ====== -! XEmacs requires the use of XLFD (X Logical Font Description) format font -! names, which look like -! -! *-courier-medium-r-*-*-*-120-*-*-*-*-*-* -! -! if you use any of the other, less strict font name formats, some of which -! look like -! lucidasanstypewriter-12 -! and fixed -! and 9x13 -! -! then XEmacs won't be able to guess the names of the bold and italic versions. -! All X fonts can be referred to via XLFD-style names, so you should use those -! forms. See the man pages for X(1), xlsfonts(1), and xfontsel(1). - - -! The default font for the text area of XEmacs is chosen at run-time -! by lisp code which tries a number of different possibilities in order -! of preference. If you wish to override it, use this: -! -! Emacs.default.attributeFont: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* - -! If you choose a font which does not have an italic version, you can specify -! some other font to use for it here: -! -! Emacs.italic.attributeFont: -*-courier-medium-o-*-*-*-120-*-*-*-*-iso8859-* -! -! And here is how you would set the background color of the `highlight' face, -! but only on the screen named `debugger': -! -! Emacs*debugger.highlight.attributeBackground: PaleTurquoise -! -! See the NEWS file (C-h n) for a more complete description of the resource -! syntax of faces. - - -! Font of the modeline, menubar and pop-up menus. -! Note that the menubar resources do not use the `face' syntax, since they -! are X toolkit widgets and thus outside the domain of XEmacs proper. -! -Emacs*menubar*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* -Emacs*popup*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* - -! Font in the Motif dialog boxes. -! (Motif uses `fontList' while most other things use `font' - if you don't -! know why you probably don't want to.) -! -Emacs*XmDialogShell*FontList: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-* -Emacs*XmTextField*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* -Emacs*XmText*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* -Emacs*XmList*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-* - -! Font in the Athena dialog boxes. -! I think 14-point looks nicer than 12-point. -! Some people use 12-point anyway because you get more text, but -! there's no purpose at all in doing this for dialog boxes. - -Emacs*Dialog*Font: -*-helvetica-bold-r-*-*-*-140-*-*-*-*-iso8859-* - -! Dialog box translations. -! ======================= - -! This accelerator binds in a dialog box to on button1 -Emacs*dialog*button1.accelerators:#override\ -Return: ArmAndActivate()\n\ -KP_Enter: ArmAndActivate()\n\ -Ctrlm: ArmAndActivate()\n - -! Translations to make the TextField widget behave more like XEmacs -Emacs*XmTextField.translations: #override\n\ - !osfBackSpace: delete-previous-character()\n\ - !osfDelete: delete-previous-character()\n\ - !Ctrlh: delete-previous-character()\n\ - !Ctrld: delete-next-character()\n\ - !MetaosfDelete: delete-previous-word()\n\ - !MetaosfBackSpace: delete-previous-word()\n\ - !Metad: delete-next-word()\n\ - !Ctrlk: delete-to-end-of-line()\n\ - !Ctrlg: process-cancel()\n\ - !Ctrlb: backward-character()\n\ - !osfLeft: backward-character()\n\ - !Ctrlf: forward-character()\n\ - !osfRight: forward-character()\n\ - !Metab: backward-word()\n\ - !MetaosfLeft: backward-word()\n\ - !Metaf: forward-word()\n\ - !MetaosfRight: forward-word()\n\ - !Ctrle: end-of-line()\n\ - !Ctrla: beginning-of-line()\n\ - !Ctrlw: cut-clipboard()\n\ - !Metaw: copy-clipboard()\n\ - : copy-primary()\n - -! With the XEmacs typeahead it's better to not have space be bound to -! ArmAndActivate() for buttons that appear in dialog boxes. This is -! not 100% Motif compliant but the benefits far outweight the -! compliancy problem. -Emacs*dialog*XmPushButton.translations:#override\n\ - : Arm()\n\ - ,: Activate()\ - Disarm()\n\ - (2+): MultiArm()\n\ - (2+): MultiActivate()\n\ - : Activate()\ - Disarm()\n\ - osfSelect: ArmAndActivate()\n\ - osfActivate: ArmAndActivate()\n\ - osfHelp: Help()\n\ - ~Shift ~Meta ~Alt Return: ArmAndActivate()\n\ - : Enter()\n\ - : Leave()\n - -! XIM input method style -! ======================= - -! ximStyles is a (whitespace or comma-separated) list of XIMStyles in -! order of user's preference. -! Choose a subset of the following styles or reorder to taste -Emacs*ximStyles: XIMPreeditPosition|XIMStatusArea\ - XIMPreeditPosition|XIMStatusNothing\ - XIMPreeditPosition|XIMStatusNone\ - XIMPreeditNothing|XIMStatusArea\ - XIMPreeditNothing|XIMStatusNothing\ - XIMPreeditNothing|XIMStatusNone\ - XIMPreeditNone|XIMStatusArea\ - XIMPreeditNone|XIMStatusNothing\ - XIMPreeditNone|XIMStatusNone - -! XIM Preedit and Status foreground and background -Emacs*EmacsFrame.ximForeground: black -Emacs*EmacsFrame.ximBackground: white - -! XIM fontset (defaults to system fontset default) -! Emacs*EmacsFrame.FontSet: -dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-* diff --git a/etc/xemacs-fe.sh b/etc/xemacs-fe.sh deleted file mode 100755 index 881ad07..0000000 --- a/etc/xemacs-fe.sh +++ /dev/null @@ -1,316 +0,0 @@ -#! /bin/sh -# emacs-fe --- front end driver for `emacs' and other programs - -# Copyright (C) 1995, 1996 Noah S. Friedman - -# Author: Noah Friedman -# Created: 1995-09-11 - -# $.Id: emacs-fe,v 1.8 1996/03/07 04:32:33 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: - -# Inspired by a similar set of scripts by Charles Sandel , -# but generalized into this single script. - -# Front-end shell script for GNU Emacs, used to manage multiple versions of -# Emacs and its associated utilities. -# -# Strategy: Install this script as "$prefix/bin/[progname]", for each -# program named [progname], (e.g. "emacs", "ispell", "etags", etc). These -# are the commands users would normally execute to run them. - -# Give each version of emacs/xemacs/mule/ispell a separate hierarchy under -# $prefix/[emacs|xemacs|mule|ispell], with the name -# "[emacs|xemacs|mule|ispell]-NN.NN" where NN.NN is the version number. -# This script looks at what versions are available, and selects a version, -# currently whatever is specified by $DEFAULTLVERSION. - -# However, users can specify their own choice to force the selection of a -# particular version by setting the environment variable PROGNAMEVERSION -# (e.g. EMACSVERSION, MULEVERSION, XEMACSVERSION, etc.) to have a value -# which is the version number of the program that they want to use (just -# the numeric value), or to specify either the NEWEST or OLDEST versions. - -# Code: - -# Name by which this script was invoked. -progname=`echo "$0" | sed -e 's/[^\/]*\///g'` - -# To prevent hairy quoting and escaping later. -bq='`' -eq="'" - -case "$progname" in - emacs-fe-print ) - case $# in - 1 ) : ;; - * ) - echo "$progname: Exactly one argument is required." 1>&2 - exit 1 - ;; - esac - - # sed is more portable than `dirname' - dir=`echo "$0" | sed -e 's/\/*$//' -e 's/\/[^\/]*$//'` - if test -f "$dir/$1"; then - EMACS_FE_PRINT=t - export EMACS_FE_PRINT - exec "$dir/$1" - fi - - echo "$progname: $bq$dir/$1$eq does not seem to exist." 1>&2 - exit 1 - ;; -esac - -DEFAULTVERSION="${DEFAULTVERSION-NEWEST}" -VARIANT="${EMACSVARIANT-emacs}" - -if [ "$prefix" = "" ] ; then - # root of the GNU installed tree - prefix=/usr/local/gnu -fi - -if [ ! -d "$prefix" ] ; then - echo "Cannot find root of GNU tree ($prefix)." - exit 1 -fi - -case "$progname" in - emacs | lemacs | xemacs | mule | ispell ) - if [ "$eprefix" = "" ] ; then - # prefix name of the subdirectory - eprefix="${progname}/${progname}-" - fi - ;; - * ) - eprefix="$VARIANT/${VARIANT}-" - ;; -esac - -# Find out which versions are available on the system and sort them -# in numeric order. -# -# The largish sed script prefixes all version numbers with a sort key. -# That key is constructed by padding out any single or double digits to 3 -# digits from the version number, then converting all occurences of `.' to -# `0', and prefixing and suffixing the entire result with an additional -# zero. After sorting, the sort key is stripped from the output. -# We do all this because `sort' cannot numerically sort decimal numbers and -# will stop on the first `.'. -# This may not work correctly if the version number has more than 4 levels -# of minor versions (e.g. "1.2.3.4.5" may cause problems). -availversions=`ls -1d $prefix/${eprefix}*/. 2> /dev/null \ - | sed -n \ - -e "s#^$prefix/$eprefix\([0-9.][0-9.]*\)/\.*#\1#" \ - -e 'h - s/[^.]*[^0-9.][^.]*\.//g - :0 - /[0-9.][0-9.]*\.[0-9.][0-9.]*\.[0-9.][0-9.]*\.[0-9.][0-9.]*/!{ - s/$/.0/ - b 0 - } - s/^/./ - s/$/./ - :1 - s/\.\([0-9]\)\./.00\1./g - s/\.\([0-9][0-9]\)\./.0\1./g - t 1 - s/\./0/g - G - s/\n/ /' \ - -e 'p' \ - | sort -nu \ - | sed -e 's/.* //'` - -if [ "$availversions" = "" ] ; then - echo "No version of $progname found in $prefix/$eprefix*." - exit 1 -fi - -# This sets `oldest' to the oldest version available, and `newest' -# to the newest version available. -# On line 1, we save the original pattern in the hold space and restore it -# in case it is the only line of input. -eval `echo "$availversions" \ - | sed -ne '1{h;s/^/oldest=/p;g;} - ${s/^/newest=/p;} - '` - -# The environment variable [progname]VERSION can have a value which specifies -# a version number, OR it can contain the values "NEWEST" or "OLDEST" to -# specify the newest or oldest version which was found. -sed_upcase='y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' - -PROGNAME=`echo "$progname" | sed -e "$sed_upcase" -e 's/-/_/g'` -eval version=\"\$${PROGNAME}VERSION\" - -# If there is no ETAGSVERSION, EMACSCLIENTVERSION, etc, then look for -# EMACSVERSION, XEMACSVERSION, or whatever the current variant is. -case "$version" in - '' ) - case "$progname" in - ispell ) - # If this is ispell and ISPELLVERSION isn't set, just use 3.1. - # We could run this script recursively with a flag indicating to - # find the current emacs variant and version and just print it out, - # but that is a very pathological case and is a lot of work. - version=3.1 ;; - * ) - variant=`echo "$VARIANT" | sed -e "$sed_upcase"` - eval version=\"\$${variant}VERSION\" - case "$version" in - '' ) version="$DEFAULTVERSION" ;; - esac - ;; - esac -esac - -case "$version" in - [Oo][Ll][Dd][Ee][Ss][Tt]) version="$oldest" ;; - [Nn][Ee][Ww][Ee][Ss][Tt]) version="$newest" ;; - '') version="$oldest" ;; - *) - if [ ! -d "$prefix/$eprefix$version" ] ; then - echo "$progname: $version: Cannot find requested version." 1>&2 - version= - fi - ;; -esac - -# If we don't have a version by now, then give up. -if [ "$version" = "" ] ; then - exec 1>&2 - echo "$progname: Cannot determine which version to use." - case "$availversions" in - */* ) - echo "Available versions are:" - for f in $availversions; do - echo " $f" - done | sort - ;; - * ) - echo "Available versions are:" $availversions - ;; - esac - exit 1 -fi - -case "$progname" in - emacs | lemacs | xemacs | mule ) - EMACSVARIANT=$progname - eval ${PROGNAME}VERSION=$version - eval export EMACSVARIANT ${PROGNAME}VERSION - - case "$EMACSVARIANT-$version" in - emacs-18* ) ISPELLVERSION=4.0 ;; - emacs-19.[0-9] ) ISPELLVERSION=4.0 ;; - emacs-19.1[0-9] ) ISPELLVERSION=4.0 ;; - emacs-19.2[0-2] ) ISPELLVERSION=4.0 ;; - emacs-19.2[3-9] ) ISPELLVERSION=3.1 ;; - emacs-* ) ISPELLVERSION=3.1 ;; - - lemacs-19.[0-9] ) ISPELLVERSION=3.0.09 ;; - lemacs-19.10 ) ISPELLVERSION=3.1 ;; - - xemacs-* ) ISPELLVERSION=3.1 ;; - - mule-* ) ISPELLVERSION=3.1 ;; - esac - export ISPELLVERSION - ;; -esac - -case "$progname" in - xemacs ) - # xemacs expects to use the keysym database in /usr/openwin, but that - # database doesn't define many of the keysyms it uses. Unless the user - # has already defined their own, specify the keysym database in X11. - XKEYSYMDB="${XKEYSYMDB-/usr/local/X11/lib/X11/XKeysymDB}" - export XKEYSYMDB - - # Some versions of xemacs (e.g. 19.12) are dynamically linked against - # the openwin tooltalk library (libtt.so), so add openwin to the - # dynamic load path if necessary. - case "$LD_LIBRARY_PATH" in - *'/usr/openwin/lib'* ) : ;; - '' ) - LD_LIBRARY_PATH=/usr/local/X11R5/lib:/usr/openwin/lib:/lib - export LD_LIBRARY_PATH - ;; - * ) - LD_LIBRARY_PATH="$LD_LIBRARY_PATH:/usr/openwin/lib" - export LD_LIBRARY_PATH - ;; - esac - ;; -esac - -# Set up the MANPATH so that the man pages for this version -# are searched first -if [ -d $prefix/$eprefix$version/man ] ; then - MANPATH=$prefix/$eprefix$version/man:$MANPATH - export MANPATH -fi - -# There is no need to do this, and it can potentially cause problems, -# especially if a program like `xemacs' exists in that directory and gets -# run in subshells instead of this script. -#PATH=$prefix/$eprefix$version/bin:$PATH -#export PATH - -searchdirs=`exec 2> /dev/null - cd $prefix/$eprefix$version \ - && find bin \ - libexec/$VARIANT/$version/* \ - lib/$VARIANT/$version/* \ - lib/$VARIANT-$version/* \ - lib/$VARIANT/etc \ - lib/etc \ - -type d -print` - -for dir in $searchdirs ; do - for p in $progname-$version $progname ; do - prog="$prefix/$eprefix$version/$dir/$p" - - if test -f "$prog" ; then - case "${EMACS_FE_PRINT+set}" in - set ) - echo "$prog" - exit 0 - ;; - esac - - exec "$prog" ${1+"$@"} - fi - done -done - -exec 1>&2 - -echo "$progname: Cannot find $bq$progname-$version$eq or $bq$progname$eq in" - -for d in $searchdirs ; do - ls -1d $prefix/$eprefix$version/$d 2> /dev/null \ - | sed -e "s/^/$progname: /" -done - -exit 1 - -# emacs-fe ends here diff --git a/etc/xemacs-ja.1 b/etc/xemacs-ja.1 deleted file mode 100644 index a31a535..0000000 --- a/etc/xemacs-ja.1 +++ /dev/null @@ -1,776 +0,0 @@ -.TH XEMACS 1 "1997 ǯ 3 ·î 11 Æü" -.UC 4 -.SH "̾Á°" -xemacs \- ¼¡À¤Âå Emacs -.SH "·Á¼°" -.B xemacs -[ -.I <¥³¥Þ¥ó¥É¹Ô¥ª¥×¥·¥ç¥ó> -] [ -.I <¥Õ¥¡¥¤¥ë̾>... -] -.br -.\"°Ê²¼¡¢bold ¤Ë¤¹¤Ù¤­¥³¥Þ¥ó¥É̾¤Ê¤É¤¬±Ñ¸ì¤Ç¤Ï italic ¤Ë¤Ê¤Ã¤Æ¤¤¤ë¤Î¤Ç¡¢½¤Àµ¡£ -.SH "µ¡Ç½ÀâÌÀ" -.B XEmacs -¤Ï¡¢Free Software Foundation ¤Î Richard Stallman ¤Ë¤è¤Ã¤Æ½ñ¤«¤ì¤¿¤â¤Î¤Ç¡¢ -.B Emacs -¤È¤Î¸ß´¹À­¤òÊÝ»ý¤·¤¿¤Þ¤Þ¿¤¯¤Î²þÎɤ¬²Ã¤¨¤é¤ì¤¿¥Ð¡¼¥¸¥ç¥ó¤Ç¤¹¡£ -.B "GNU Emacs " -¥Ð¡¼¥¸¥ç¥ó 19 ¤ÎÁá´ü¥ê¥ê¡¼¥¹¤ò¤â¤È¤Ë³«È¯¤µ¤ì¡¢ -.B "GNU Emacs " -¤Î¸å³¥ê¥ê¡¼¥¹¤ÈƱ´ü¤¬¤È¤é¤ì¤Æ¤¤¤Þ¤¹¡£ -.PP -.B XEmacs -¤Î¼ç¤Ê¥Þ¥Ë¥å¥¢¥ë¤Ï¡¢ -.B XEmacs -¥µ¥Ö¥·¥¹¥Æ¥à¤Î 1 ¤Ä¤Ç¤¢¤ë Info ¤ò»È¤Ã¤Æ¥ª¥ó¥é¥¤¥ó¤Ç»²¾È¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -´°À®¤µ¤ì¤¿ºÇ¿·¤Î¥Þ¥Ë¥å¥¢¥ë¤Ï¡¢¤½¤Á¤é¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤ -(¤¿¤À¤·¸½»þÅÀ¤Ç¤Ï¡¢Info ·Á¼°¥É¥­¥å¥á¥ó¥È¤Ï±Ñ¸ìÈǤΤߤ¬ÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤¹)¡£ -Emacs Lisp »ÈÍÑÊýË¡¤Ë¤Ä¤¤¤Æ¤Î´°Á´¤Ê¥Þ¥Ë¥å¥¢¥ë¤È¤·¤Æ¤Ï -¡ØXEmacs Lisp Programmer's Manual¡Ù¤ò¡¢ -¥ª¥ó¥é¥¤¥ó¤Ç»²¾È¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¤É¤Á¤é¤Î¥Þ¥Ë¥å¥¢¥ë¤â -.B TeX -½ñ¼°¥Ñ¥Ã¥±¡¼¥¸¤ò»ÈÍѤ¹¤ì¤Ð¡¢¤­¤ì¤¤¤Ë°õºþ¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.PP -»ÈÍѤǤ­¤ë -.B XEmacs -¤Îµ¡Ç½¤Ï¡¢¤Û¤«¤Î -.B Emacs -¥¨¥Ç¥£¥¿¤Ç¤Ç¤­¤ë¤¹¤Ù¤Æ¤Îµ¡Ç½¤¬´Þ¤Þ¤ì¤Æ¤ª¤ê¡¢ -ÊÔ½¸¥³¥Þ¥ó¥É¤Ï Lisp ¤Çµ­½Ò¤µ¤ì¤Æ¤¤¤ë¤¿¤á¡¢Íưפ˳ÈÄ¥¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.PP -.B XEmacs -¤Ë¤Ï³ÈÄ¥ÂÐÏ÷¿¥Ø¥ë¥×µ¡Ç½¤¬ÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤¹¤¬¡¢¤³¤Îµ¡Ç½¤ò»ÈÍѤ¹¤ë¤Ë¤Ï¡¢ -.B XEmacs -¥¦¥£¥ó¥É¥¦¤È¥Ð¥Ã¥Õ¥¡¤Ë¤Ä¤¤¤Æ¤Î°·¤¤Êý¤òÃΤäƤ¤¤ë¤³¤È¤¬Á°Äó¤È¤Ê¤ê¤Þ¤¹¡£ -CTRL-h ¤Ç¥Ø¥ë¥×µ¡Ç½¤ò¼Â¹Ô¤·¤Þ¤¹¡£¡ÖXEmacs ¼«½¬½ñ(CTRL-h t)¡×¤Ï¡¢ -½é¿´¼Ô¤¬¿ôʬ´Ö¤Ç -.B XEmacs -¤Î´ðÁäòÃΤ뤳¤È¤¬¤Ç¤­¤ëÂÐÏ÷¿¤Î¥Á¥å¡¼¥È¥ê¥¢¥ë¤ò¸Æ¤Ó½Ð¤·¤Þ¤¹¡£ -¡ÖŬÀÚ¸¡º÷...(CTRL-h a)¡×¤Ï¡¢»ØÄꤷ¤¿µ¡Ç½¤ò¼Â¹Ô¤¹¤ë¥³¥Þ¥ó¥É¤ò -õ¤¹¼ê½õ¤±¤ò¤·¤Þ¤¹¡£ -¡Ö¥­¡¼/¥Þ¥¦¥¹µ­½Ò...(CTRL-h k)¡×¤Ï¡¢»ØÄꤷ¤¿¥­¡¼Áàºî¤Î¼Â¹ÔÆâÍƤòɽ¼¨¤·¤Þ¤¹¡£ -¡Ö´Ø¿ôµ­½Ò...(CTRL-h f)¡×¤Ï¡¢»ØÄꤷ¤¿Ì¾Á°¤Î Lisp ´Ø¿ô¤òɽ¼¨¤·¤Þ¤¹¡£ -¤µ¤é¤Ë¡Ö¥­¡¼/¥Þ¥¦¥¹³ä¤êÅö¤Æ...(CTRL-h CTRL-k)¡×¤ò»ÈÍѤ¹¤ë¤È¡¢ -.B XEmacs -¥ê¥Õ¥¡¥ì¥ó¥¹¥Þ¥Ë¥å¥¢¥ë¾å¤Î¥­¡¼Áàºî¤ò»²¾È¤Ç¤­¡¢ -¡ÖElisp ´Ø¿ô...(CTRL-h CTRL-f)¡×¤ò»ÈÍѤ¹¤ë¤È¡¢ -¡ØXEmacs Lisp Programmer's Manual¡Ù¾å¤Î Lisp ´Ø¿ô¤ò»²¾È¤Ç¤­¤Þ¤¹¡£ -¥æ¡¼¥¶¡¼¤¬¥¦¥£¥ó¥É¥¦¥·¥¹¥Æ¥à¤ò»ÈÍѤ·¤Æ¤¤¤ë¾ì¹ç¤Ï¡¢ -¤³¤ì¤é¤Î¥Ø¥ë¥×µ¡Ç½¤Ï¤¹¤Ù¤Æ¥Ø¥ë¥×¥á¥Ë¥å¡¼¤«¤é»ÈÍѤ¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.PP -Ê£¿ô¥Õ¥ì¡¼¥à(¥È¥Ã¥×¥ì¥Ù¥ë¥¦¥£¥ó¥É¥¦)¡¢¥á¥Ë¥å¡¼¥Ð¡¼¡¢¥Ä¡¼¥ë¥Ð¡¼¡¢ -¿åÊ¿¡¦¿âľ¥¹¥¯¥í¡¼¥ë¥Ð¡¼¡¢¥À¥¤¥¢¥í¥°¥Ü¥Ã¥¯¥¹¡¢³ÈÄ¥¥Þ¥¦¥¹µ¡Ç½ -¤Ê¤É¤ò»ý¤Ä X ¤Î¤è¤¦¤Ê¥¦¥£¥ó¥É¥¦¥·¥¹¥Æ¥à´Ä¶­²¼¤Ç¤Ï¡¢ -.B XEmacs -¤Ï -³ÈÄ¥ GUI(¥°¥é¥Õ¥£¥«¥ë¥æ¡¼¥¶¡¼¥¤¥ó¥¿¥Õ¥§¡¼¥¹)¤ò¥µ¥Ý¡¼¥È¤·¤Þ¤¹¡£ -.PP -.B XEmacs -¤Ï¡¢Ê£¿ô¤Î¥Õ¥©¥ó¥È¤ä¥«¥é¡¼¡¢²ÄÊÑÉý¥Õ¥©¥ó¥È¡¢²ÄÊѹԴֳ֤ò -´°Á´¤Ë¥µ¥Ý¡¼¥È¤·¤Æ¤ª¤ê¡¢ -¥Ô¥Ã¥¯¥¹¥Þ¥Ã¥×¤ò¥Ð¥Ã¥Õ¥¡¤Ë¼è¤ê¹þ¤à¤³¤È¤â²Äǽ¤Ç¤¹ -(¤³¤ì¤ÏÆäˡ¢W3 Web ¥Ö¥é¥¦¥¸¥ó¥°¥Ñ¥Ã¥±¡¼¥¸¤ä°ìÉô¤Î -¥Ç¥Ð¥Ã¥¬¡¢¥¢¥¦¥È¥é¥¤¥óµ¡Ç½¤Î¥¤¥ó¥¿¥Õ¥§¡¼¥¹¤ËÍѤ¤¤é¤ì¤Þ¤¹)¡£ -.PP -.B XEmacs -¤Î¡Ö¸µ¤ËÌ᤹¡×¤Ï¡¢¥Ð¥Ã¥Õ¥¡¤ËÈ¿±Ç¤µ¤ì¤¿¿ô¥¹¥Æ¥Ã¥×Á°¤Þ¤Ç¤ÎÊѹ¹¤ò -¼è¤ê¾Ã¤¹¤³¤È¤¬¤Ç¤­¡¢ÊÔ½¸¤Î¥ß¥¹¤ò´Êñ¤Ë½¤Éü¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.PP -.B XEmacs -¤Ë¤Ï¡¢Â¿¤¯¤ÎÀìÍѥѥ屡¼¥¸¤¬ÍÑ°Õ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£¥á¡¼¥ë¤ÎÆɤ߽Ф· (VM¡¢MH-E¡¢ -RMail) ¤äȯ¿® (Mail)¡¢¥Í¥Ã¥È¥Ë¥å¡¼¥¹¤ÎÆɤ߽Ф·¤ÈÅêÈ¡ (GNUS)¡¢ -World Wide Web ¤Î¥Ö¥é¥¦¥º (W3)¡¢¤¹¤Ù¤Æ¤Î¼çÍ×¤Ê¥×¥í¥°¥é¥ß¥ó¥°¸À¸ì¤Ë -¤Ç½ñ¤«¤ì¤¿¥½¡¼¥¹¥³¡¼¥É¤òÊÔ½¸¤¹¤ë¤¿¤á¤ÎÆò½¤µ¤ì¤¿¥â¡¼¥É¡¢ -¿¤¯¤Î¸À¸ìÍѤι½Ê¸¶¯Ä´É½¼¨ (Font-Lock)¡¢¥³¥ó¥Ñ¥¤¥ë (Compile)¡¢ -.B XEmacs -¥¦¥£¥ó¥É¥¦Æâ¤ÇÆ°ºî¤¹¤ë¥µ¥Ö¥·¥§¥ë (Shell)¡¢¥¢¥¦¥È¥é¥¤¥óÊÔ½¸ (Outline)¡¢ -Lisp ¤Î¡ÖÆɤ߹þ¤ß¡¢É¾²Á¡¢É½¼¨¡×¥ë¡¼¥×¤Î¼Â¹Ô (Lisp-Interaction-Mode)¡¢ -¥²¡¼¥àÀº¿ÀʬÀÏ°å (Doctor) ¤Ê¤É¤Ç¤¹¡£ -.PP -¾ÜºÙ¤Ê¥ê¥Õ¥¡¥ì¥ó¥¹¥Þ¥Ë¥å¥¢¥ë¤Ï¤¢¤ê¤Þ¤¹¤¬¡¢ -¾¤Î¥Ð¡¼¥¸¥ç¥ó¤Î Emacs ¤ò»ÈÍѤ·¤¿¤³¤È¤¬¤¢¤ì¤Ð¡¢ -¥Þ¥Ë¥å¥¢¥ë¤Ê¤·¤Ç¤âÌäÂê¤Ê¤¯Âбþ¤Ç¤­¤ë¤È»×¤ï¤ì¤Þ¤¹¡£ -½é¤á¤Æ Emacs ¤ò»ÈÍѤ¹¤ë¿Í¤Ç¤â¡¢¥Á¥å¡¼¥È¥ê¥¢¥ë¤ò³Ø½¬¤·¤¿¤ê¼«Æ° -¥Þ¥Ë¥å¥¢¥ëµ¡Ç½¤òÍøÍѤ¹¤ë¤³¤È¤Ç¡¢¤¹¤°¤Ë´ðËܵ¡Ç½¤ò»È¤¦¤³¤È¤¬¤Ç¤­¤ë¤è¤¦¤Ë -¤Ê¤ë¤Ç¤·¤ç¤¦¡£ -.PP -.SM "XEmacs ¥ª¥×¥·¥ç¥ó" -.PP -XEmacs ¤Ï¡¢X ¥¦¥£¥ó¥É¥¦¤¬Æ°ºî¤¹¤ë´Ä¶­²¼¤Ç¤Ï¡¢¤¹¤Ù¤Æ¤Îɸ½à X ¥Ä¡¼¥ë¥­¥Ã¥È¤Î -¥³¥Þ¥ó¥É¥ª¥×¥·¥ç¥ó¤òǧ¼±¤·¤Þ¤¹¡£¤½¤ì¤Ë²Ã¤¨¤Æ¡¢°Ê²¼¤Î¥ª¥×¥·¥ç¥ó¤òǧ¼± -¤·¤Þ¤¹ -(¥ª¥×¥·¥ç¥ó¤¬°ìÏ¢¤ÎÊ£¿ô¤Î½èÍý¤ò°ÕÌ£¤¹¤ë¾ì¹ç¤Ï¡¢»ØÄꤵ¤ì¤¿½ç¤Ë¼Â¹Ô¤µ¤ì¤Þ¤¹)¡£ -.TP -.BI \-t " ¥Ç¥Ð¥¤¥¹Ì¾" -»ÈÍÑÃæ¤Îɸ½àÆþ½ÐÎϤÎÂå¤ï¤ê¤Ë¡¢»ØÄꤵ¤ì¤¿¥Ç¥Ð¥¤¥¹¤ò»È¤¤¤Þ¤¹¡£¤³¤ì¤Ï -.BR \-nw -¥ª¥×¥·¥ç¥ó¤ò´Þ°Õ¤·¤Æ¤¤¤Þ¤¹¡£ -.TP -.BI \-batch -¥Ð¥Ã¥Á¥â¡¼¥É¤ÇÊÔ½¸¤ò¹Ô¤¤¤Þ¤¹¡£¥¨¥Ç¥£¥¿¤Ïɸ½à½ÐÎϤ˥á¥Ã¥»¡¼¥¸¤òÁ÷½Ð¤·¤Þ¤¹¡£ -¼Â¹Ô¥Õ¥¡¥¤¥ë¤ò»ØÄꤷ¤¿¤ê´Ø¿ô¤ò¸Æ¤Ó½Ð¤¹¾ì¹ç¤Ï¡¢É¬¤º -.BR \-l -¡¢ -.BR \-f -¡¢ -.B \-eval -¥ª¥×¥·¥ç¥ó¤ò»ÈÍѤ·¤Æ¤¯¤À¤µ¤¤¡£ -.TP -.B \-nw\ -¥¦¥£¥ó¥É¥¦¥·¥¹¥Æ¥àÆÃÍ­¤Îɽ¼¨ÍÑ¥³¡¼¥É¤Î»ÈÍѤò¤¹¤Ù¤Æ¶Ø»ß¤·¤Þ¤¹¡£ -¸½ºß¤Î TTY ¤ò»ÈÍѤ·¤Þ¤¹¡£ -.TP -.B \-debug\-init -½é´ü²½¥Õ¥¡¥¤¥ë¤ÎÆɤ߹þ¤ßÃæ¤Ë¥¨¥é¡¼¤¬È¯À¸¤·¤¿¾ì¹ç¡¢¥Ç¥Ð¥Ã¥¬¤òµ¯Æ°¤·¤Þ¤¹¡£ -.TP -.B \-unmapped -½é´ü¥Õ¥ì¡¼¥à¤ò¥Þ¥Ã¥Ô¥ó¥°¤·¤Þ¤»¤ó¡£ -.TP -.B \-no\-site\-file -¥µ¥¤¥È¸ÇÍ­¤Î½é´ü²½¥Õ¥¡¥¤¥ë(site-init.el)¤òÆɤ߹þ¤ß¤Þ¤»¤ó¡£ -.TP -.BR \-q "¡¢" \-no\-init\-file -½é´ü²½¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤ß¤Þ¤»¤ó¡£ -.TP -.BI \-u " ¥æ¡¼¥¶¡¼Ì¾¡¢" \-user " ¥æ¡¼¥¶¡¼Ì¾" -»ØÄꤷ¤¿¥æ¡¼¥¶¡¼¸ÇÍ­¤Î½é´ü²½¥Õ¥¡¥¤¥ë¤òÆɤ߹þ¤ß¤Þ¤¹¡£ -.TP -.I ¥Õ¥¡¥¤¥ë̾ -»ØÄꤷ¤¿¥Õ¥¡¥¤¥ë¤òÊÔ½¸¤·¤Þ¤¹¡£ -.TP -.BI \+ "¹ÔÈÖ¹æ" -.I ¹ÔÈÖ¹æ -¤Ë»ØÄꤷ¤¿¹Ô¤Ë°ÜÆ°¤·¤Þ¤¹ -.br -(+ Éä¹æ¤È¹ÔÈÖ¹æ¤Î´Ö¤Ë¶õÇòʸ»ú¤ÏÆþ¤ì¤Ê¤¤¤Ç¤¯¤À¤µ¤¤)¡£ -.TP -.BR \-help "¡¢" \-flags "¡¢" \-? -¥Ø¥ë¥×¥á¥Ã¥»¡¼¥¸¤ò½ÐÎϤ·¤Æ½ªÎ»¤·¤Þ¤¹¡£ -.TP -.BR \-V "¡¢" \-version -¥Ð¡¼¥¸¥ç¥óÈÖ¹æ¤ò½ÐÎϤ·¤Æ½ªÎ»¤·¤Þ¤¹¡£ -.TP -.BI \-f " ´Ø¿ô̾¡¢ " \-funcall " ´Ø¿ô̾" -.I "´Ø¿ô̾ " -¤Ë»ØÄꤷ¤¿ Lisp ´Ø¿ô¤ò¼Â¹Ô¤·¤Þ¤¹¡£ -.TP -.BI \-l " ¥Õ¥¡¥¤¥ë̾¡¢ " \-load " ¥Õ¥¡¥¤¥ë̾" -.I ¥Õ¥¡¥¤¥ë̾ -¤Ë»ØÄꤷ¤¿¥Õ¥¡¥¤¥ëÃæ¤Î Lisp ¥³¡¼¥É¤òÆɤ߹þ¤ß¤Þ¤¹¡£ -.TP -.BI \-eval " ¥Õ¥©¡¼¥à" -.I ¥Õ¥©¡¼¥à -¤Ë»ØÄꤷ¤¿ Lisp ¤Î¥Õ¥©¡¼¥à¤òɾ²Á¤·¤Þ¤¹¡£ -.TP -.BI \-i " ¥Õ¥¡¥¤¥ë̾¡¢" \-insert " ¥Õ¥¡¥¤¥ë̾" -¸½ºß¤Î¥Ð¥Ã¥Õ¥¡¤Ë¡¢ -.I ¥Õ¥¡¥¤¥ë̾ -¤Ë»ØÄꤷ¤¿¥Õ¥¡¥¤¥ë¤ò¼è¤ê¹þ¤ß¤Þ¤¹¡£ -.TP -.B \-kill -.B XEmacs -¤ò½ªÎ»¤·¤Þ¤¹( -.BR \-batch -¤ÇÍ­¸ú¤Ç¤¹)¡£ -.PP -.SM "X ¤Ç¤Î XEmacs ¤Î»ÈÍÑ" -.PP -.B XEmacs -¤Ï¡¢X ¥¦¥£¥ó¥É¥¦¥·¥¹¥Æ¥à¾å¤ÇÀµ¤·¤¯Æ°ºî¤¹¤ë¤è¤¦¤Ë³«È¯¤µ¤ì¤Æ¤­¤Þ¤·¤¿¡£ -X ¥¦¥£¥ó¥É¥¦¤Ç -.B XEmacs -¤òµ¯Æ°¤¹¤ë¤È¡¢¥Ç¥£¥¹¥×¥ì¥¤Æâ¤ËÆȼ«¤Î X ¥¦¥£¥ó¥É¥¦¤ò³«¤­¤Þ¤¹¡£ -¥æ¡¼¥¶¡¼¤Î¥ª¥ê¥¸¥Ê¥ë¤Î¥¦¥£¥ó¥É¥¦¤ò¤½¤Î¤Þ¤Þ»È¤¤Â³¤±¤ë¤³¤È¤¬¤Ç¤­¤ë¤è¤¦¤Ë¡¢ -¥¨¥Ç¥£¥¿¤Ï¥Ð¥Ã¥¯¥°¥é¥¦¥ó¥É¤Î¥¸¥ç¥Ö¤È¤·¤Æµ¯Æ°¤·¤¿¤Û¤¦¤¬¤è¤¤¤Ç¤·¤ç¤¦¡£ -.PP -.B XEmacs -¤Ï¡¢°Ê²¼¤Îɸ½à X ¥ª¥×¥·¥ç¥ó¤òÉÕ¤±¤Æµ¯Æ°¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.TP -.BI \-geometry " ##x##+##+##" -½é´ü¥¦¥£¥ó¥É¥¦¤Î¥¸¥ª¥á¥È¥ê¤ò»ØÄꤷ¤Þ¤¹¡£## ¤Ë¤Ï¡¢Éý(ʸ»ú¿ô)¡¢ -¹â¤µ(ʸ»ú¿ô)¡¢X ¥ª¥Õ¥»¥Ã¥È(¥Ô¥¯¥»¥ë¿ô)¡¢Y ¥ª¥Õ¥»¥Ã¥È(¥Ô¥¯¥»¥ë¿ô) -¤ò¿ô»ú¤Ç»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£ -.I ##x## -¤ä -.I +##+## -¤Ê¤É¤Î½ñ¼°¤ÎÉôʬ»ØÄê¤âÍ­¸ú¤Ç¤¹¡£(¥¸¥ª¥á¥È¥ê»ÅÍͤϡ¢É¸½à X ¥Õ¥©¡¼¥Þ¥Ã¥È¤Ë -½àµò¤·¤Æ¤¤¤Þ¤¹¡£¾ÜºÙ¤Ï -.BR X (1) -¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£) -.TP -.B \-iconic -µ¯Æ°»þ¤Î½é´ü¥¦¥£¥ó¥É¥¦¤ò¥¢¥¤¥³¥ó¤Çɽ¼¨¤·¤Þ¤¹¡£ -.TP -.BI \-name " ¥×¥í¥°¥é¥à̾" -¥æ¡¼¥¶¡¼¤Î X ¥ê¥½¡¼¥¹Æâ¤Ë¤¢¤ë¥Ç¥Õ¥©¥ë¥È¤ò»²¾È¤¹¤ë¤¿¤á¤Ë»ÈÍѤµ¤ì¤ë -¥×¥í¥°¥é¥à̾¤ò»ØÄꤷ¤Þ¤¹¡£ -.TP -.BI \-title " ¥¿¥¤¥È¥ë̾¡¢" \-T " ¥¿¥¤¥È¥ë̾¡¢" \-wn " ¥¿¥¤¥È¥ë̾" -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Î¥¿¥¤¥È¥ë̾¤ò»ØÄꤷ¤Þ¤¹¡£ -.TP -.BI \-d " ¥Ç¥£¥¹¥×¥ì¥¤Ì¾¡¢" \-display " ¥Ç¥£¥¹¥×¥ì¥¤Ì¾" -.IR ¥Ç¥£¥¹¥×¥ì¥¤Ì¾ -¤Ë»ØÄꤷ¤¿¥Ç¥£¥¹¥×¥ì¥¤¾å¤Ë -.B XEmacs -¥¦¥£¥ó¥É¥¦¤òºîÀ®¤·¤Þ¤¹¡£ -¤³¤Î¥ª¥×¥·¥ç¥ó¤Ï¡¢¥³¥Þ¥ó¥É¹Ô¤ÇºÇ½é (ÀèƬ) ¤Ë»ØÄꤷ¤Æ¤¯¤À¤µ¤¤¡£ -.TP -.BI \-font " ¥Õ¥©¥ó¥È̾¡¢" \-fn " ¥Õ¥©¥ó¥È̾" -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Î¥Õ¥©¥ó¥È¤È¤·¤Æ¡¢ -.I ¥Õ¥©¥ó¥È̾ -¤Ë»ØÄꤷ¤¿¥Õ¥©¥ó¥È¤ò»ÈÍѤ·¤Þ¤¹¡£X ¥Õ¥©¥ó¥È¤Ï -.B "/usr/lib/X11/fonts" -¥Ç¥£¥ì¥¯¥È¥ê¤«¤éÁªÂò¤·¤Æ¤¯¤À¤µ¤¤¡£ -.B XEmacs -¤Ï¡¢¸ÇÄêÉý¥Õ¥©¥ó¥È¤È²ÄÊÑÉý¥Õ¥©¥ó¥È¤Î¤É¤Á¤é¤Ç¤âÆ°ºî¤·¤Þ¤¹¤¬¡¢ -¸ÇÄêÉý¥Õ¥©¥ó¥È¤ò»ÈÍѤ¹¤ë¤³¤È¤ò¤ª´«¤á¤·¤Þ¤¹¡£ -.TP -.BI \-scrollbar\-width " ¥Ô¥¯¥»¥ë¿ô" -¿âľ¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤ÎÉý¤ò»ØÄꤷ¤Þ¤¹¡£ -.TP -.BI \-scrollbar\-height " ¥Ô¥¯¥»¥ë¿ô" -¿åÊ¿¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤Î¹â¤µ¤ò»ØÄꤷ¤Þ¤¹¡£ -.TP -.BI \-bw " ¥Ô¥¯¥»¥ë¿ô¡¢ " \-borderwidth " ¥Ô¥¯¥»¥ë¿ô" -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Î¶­³¦Éý¤ò»ØÄꤷ¤Þ¤¹¡£ -¥¦¥£¥ó¥É¥¦Î¾Â¦¤Î¥Ç¥Õ¥©¥ë¥ÈÃÍ¤Ï 1 ¥Ô¥¯¥»¥ë¤Ç¤¹¡£ -.TP -.BI \-ib " ¥Ô¥¯¥»¥ë¿ô¡¢ " \-internal\-border\-width " ¥Ô¥¯¥»¥ë¿ô" -¥Õ¥ì¡¼¥à¤Î¶­³¦¤È¥Æ¥­¥¹¥È¤È¤Î´Ö³Ö¤ò»ØÄꤷ¤Þ¤¹¡£ -¥¦¥£¥ó¥É¥¦Î¾Â¦¤Î¥Ç¥Õ¥©¥ë¥ÈÃÍ¤Ï 1 ¥Ô¥¯¥»¥ë¤Ç¤¹¡£ -.TP -.BI \-fg " ¥«¥é¡¼Ì¾¡¢ " \-foreground " ¥«¥é¡¼Ì¾" -¥Æ¥­¥¹¥È¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£¥«¥é¡¼Ì¾¤Ë¤Ä¤¤¤Æ¤Ï¡¢ -.B "/usr/lib/X11/rgb.txt" -¥Õ¥¡¥¤¥ëÃæ¤Î¥ê¥¹¥È¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ -.TP -.BI \-bg " ¥«¥é¡¼Ì¾¡¢ " \-background " ¥«¥é¡¼Ì¾" -¥¦¥£¥ó¥É¥¦¤ÎÇطʤ理òÀßÄꤷ¤Þ¤¹¡£ -.TP -.BI \-bd " ¥«¥é¡¼Ì¾¡¢ " \-bordercolor " ¥«¥é¡¼Ì¾" -¥¦¥£¥ó¥É¥¦¶­³¦¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.BI \-mc " ¥«¥é¡¼Ì¾" -¥Þ¥¦¥¹¥Ý¥¤¥ó¥¿¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.BI \-cr " ¥«¥é¡¼Ì¾" -¥Æ¥­¥¹¥È¥«¡¼¥½¥ë¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.BR \-rv "¡¢" \-reverse -Á°·Ê¤ÈÇطʤ理òȿž¤·¤Þ¤¹(ȿžɽ¼¨)¡£ -¤³¤Î¥ª¥×¥·¥ç¥ó¤ò»ÈÍѤ»¤º¤Ë¡¢ -Á°·Ê¿§¤ÈÇØ·Ê¿§¤òÌÀ¼¨Åª¤ËÀßÄꤹ¤ë¤³¤È¤ò¤ª´«¤á¤·¤Þ¤¹¡£ -.TP -.BI \-xrm " °ú¿ô" -¥³¥Þ¥ó¥É¹Ô¤ÇǤ°Õ¤Î¥ê¥½¡¼¥¹¤òÀßÄꤹ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.B \.Xresource -¤ä -.B \.Xdefaults -¥Õ¥¡¥¤¥ëÃæ¤Ë»ØÄꤵ¤ì¤ë¤Î¤ÈƱÍͤˡ¢ -.I °ú¿ô -¤Ë»ØÄꤷ¤¿Ãͤ¬¥ê¥½¡¼¥¹¤È¤·¤Æ²ò¼á¤µ¤ì¤Þ¤¹¡£ -.PP -¥æ¡¼¥¶¡¼¤Ï¡¢¤¿¤È¤¨¤Ð -.B \.Xresources -¤ä -.B \.Xdefaults -¥Õ¥¡¥¤¥ë¤Ç¡¢ -.B XEmacs -¥¦¥£¥ó¥É¥¦ÍѤΥ꥽¡¼¥¹¤Î¥Ç¥Õ¥©¥ë¥ÈÃͤòÀßÄꤹ¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹( -.BR xrdb (1) -»²¾È)¡£ -½ñ¼°¤Ï°Ê²¼¤Î¤è¤¦¤Ë¤Ê¤ê¤Þ¤¹¡£ -.IP -\f3Emacs.\f2¥­¡¼¥ï¡¼¥É\f3:\f2ÃÍ\f1 -.PP -¤Þ¤¿¤Ï -.IP -\f3Emacs*EmacsFrame.\f2¥­¡¼¥ï¡¼¥É\f3:\f2ÃÍ\f1 -.PP -¤Ç¤¹ (¤É¤Á¤é¤Î·Á¼°¤«¤Ï¡¢¥ê¥½¡¼¥¹¤Ë¤è¤ë)¡£ -.PP -°Ê²¼¤Î½ñ¼°¤ò»ÈÍѤ·¤Æ¡¢ÆÃÄê¤Î¥Õ¥ì¡¼¥à¤Î¥ê¥½¡¼¥¹¤òÀßÄꤹ¤ë¤³¤È¤â¤Ç¤­¤Þ¤¹¡£ -.IP -\f3Emacs*\f2¥Õ¥ì¡¼¥à̾\f3.\f2¥­¡¼¥ï¡¼¥É\f3:\f2ÃÍ\f1 -.PP -(VM ¤Î¤è¤¦¤Ê´°À®¤µ¤ì¤¿¥Ñ¥Ã¥±¡¼¥¸¤Ï¡¢¤½¤ì¤é¤Î¥Õ¥ì¡¼¥à¤Ë¸ÇÍ­¤Î -¥ê¥½¡¼¥¹Ì¾¤òÍ¿¤¨¤Þ¤¹¡£¤³¤Î¾ì¹ç¤Ï VM ¤Ë¤Ê¤ê¤Þ¤¹¡£) -.PP -.B XEmacs -¤Ç¤Ï¡¢°Ê²¼¤Î¥­¡¼¥ï¡¼¥É¤ËÂФ¹¤ë¥Ç¥Õ¥©¥ë¥ÈÀßÄê¤ò¥æ¡¼¥¶¡¼¤¬¹Ô¤¦¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -.TP -.B default.attributeFont (\fPclass\fB Face.AttributeFont) -¥¦¥£¥ó¥É¥¦¤Î¥Æ¥­¥¹¥È¥Õ¥©¥ó¥È¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B default.attributeForeground (\fPclass\fB Face.AttributeForeground) -¥¦¥£¥ó¥É¥¦¥Æ¥­¥¹¥È¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B default.attributeBackground (\fPclass\fB Face.AttributeBackground) -¥¦¥£¥ó¥É¥¦¤ÎÇØ·Ê¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B \fI¥Õ¥§¥¤¥¹\fB.attributeFont (\fPclass\fB Face.AttributeFont) -¥Õ¥§¥¤¥¹Ì¾¤Î¥Õ¥©¥ó¥È¤òÀßÄꤷ¤Þ¤¹¡£ -¤è¤¯»ÈÍѤµ¤ì¤ë¥Õ¥§¥¤¥¹Ì¾¤ò¡¢°Ê²¼¤Ë¼¨¤·¤Þ¤¹¡£ -.PP -.in +\w'right-margin'u+12n -.ta \w'right-margin'u+4n -.ti -\w'right-margin'u+4n -¥Õ¥§¥¤¥¹ ÌÜŪ -.br -.ti -\w'right-margin'u+4n -default Ä̾ï¤Î¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -bold ¥Ü¡¼¥ë¥É (ÂÀ»ú) ¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -italic ¥¤¥¿¥ê¥Ã¥¯ (¼ÐÂÎ) ¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -bold-italic ¥Ü¡¼¥ë¥É¥¤¥¿¥ê¥Ã¥¯¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -modeline ¥â¡¼¥É¹Ô¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -zmacs-region ¥Þ¥¦¥¹ÁªÂò¤µ¤ì¤¿¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -highlight ¥Þ¥¦¥¹Ä̲á»þ¤Î¶¯Ä´¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -left-margin º¸¥Þ¡¼¥¸¥óÆâ¤Î¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -right-margin ±¦¥Þ¡¼¥¸¥óÆâ¤Î¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -isearch ¸¡º÷»þ¤Î¶¯Ä´¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -info-node Info ¥á¥Ë¥å¡¼¤Î¥Æ¥­¥¹¥È¡£ -.br -.ti -\w'right-margin'u+4n -info-xref Info Áê¸ß»²¾È¤Î¥Æ¥­¥¹¥È¡£ -.TP -.B \fI¥Õ¥§¥¤¥¹\fB.attributeForeground(\f1class\fB Face.AttributeForeground) -»ØÄê¥Õ¥§¥¤¥¹ÍѤÎÁ°·Ê¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B \fI¥Õ¥§¥¤¥¹\fB.attributeBackground(\f1class\fB Face.AttributeBackground) -»ØÄê¥Õ¥§¥¤¥¹ÍѤÎÇØ·Ê¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B \fI¥Õ¥§¥¤¥¹\fB.attributeBackgroundPixmap -.B (\f1class\fB Face.AttributeBackgroundPixmap)\f1 -.br -»ØÄê¥Õ¥§¥¤¥¹ÍѤÎÇطʥԥ寥¹¥Þ¥Ã¥×¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B \fI¥Õ¥§¥¤¥¹\fB.attributeUnderline (\f1class\fB Face.AttributeUnderline) -»ØÄê¥Õ¥§¥¤¥¹ÍѤβ¼Àþ¤Î̵ͭ¤ò·è¤á¤Þ¤¹¡£ -.TP -.B reverseVideo (\f1class\fB ReverseVideo) -.IR on -¤ËÀßÄꤵ¤ì¤¿¾ì¹ç¤Ï¡¢¥¦¥£¥ó¥É¥¦¤Ïȿžɽ¼¨¤·¤Þ¤¹¡£ -¤³¤Î¥ê¥½¡¼¥¹¤ò»ÈÍѤ»¤º¤Ë¡¢Á°·Ê¿§¤ÈÇØ·Ê¿§¤ò -ÌÀ¼¨Åª¤ËÀßÄꤹ¤ë¤³¤È¤ò¤ª´«¤á¤·¤Þ¤¹¡£ -.TP -.B borderWidth (\fPclass\fB BorderWidth) -¥¦¥£¥ó¥É¥¦¤Î¶­³¦Éý¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -.TP -.B internalBorderWidth (\fPclass\fB InternalBorderWidth) -¥¦¥£¥ó¥É¥¦¤ÎÆ⦶­³¦Éý¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -.TP -.B borderColor (\fPclass\fB BorderColor) -¥¦¥£¥ó¥É¥¦¶­³¦¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B cursorColor (\fPclass\fB Foreground) -¥¦¥£¥ó¥É¥¦¤Î¥Æ¥­¥¹¥È¥«¡¼¥½¥ë¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B pointerColor (\fPclass\fB Foreground) -¥¦¥£¥ó¥É¥¦¤Î¥Þ¥¦¥¹¥«¡¼¥½¥ë¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B geometry (\fPclass\fB Geometry) -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Î¥¸¥ª¥á¥È¥ê¤òÀßÄꤷ¤Þ¤¹(¾å½Ò)¡£ -.TP -.B iconic (\fPclass\fB Iconic) -on ¤ËÀßÄꤵ¤ì¤Æ¤¤¤ë¾ì¹ç¤Ï¡¢ -.B XEmacs -¥¦¥£¥ó¥É¥¦¤ÏºÇ½é¤Ë¥¢¥¤¥³¥ó²½¤µ¤ì¤Æɽ¼¨¤µ¤ì¤Þ¤¹¡£ -.TP -.B menubar (\fPclass\fB Menubar) -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Ë¥á¥Ë¥å¡¼¥Ð¡¼¤òɽ¼¨¤µ¤»¤ë¤«¤É¤¦¤«¤òÀßÄꤷ¤Þ¤¹¡£½é´üÃÍ¤Ï true ¤Ç¤¹¡£ -.TP -.B initiallyUnmapped (\fPclass\fB InitiallyUnmapped) -.B XEmacs -¤¬µ¯Æ°»þ¤Ë¥¢¥ó¥Þ¥Ã¥×¤µ¤ì¤¿½é´ü¥Õ¥ì¡¼¥à¤ò»Ä¤¹¤«¤É¤¦¤«¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B barCursor (\fPclass\fB BarCursor) -¥«¡¼¥½¥ë¤Î·Á¾õ¤ò¡¢È¢·¿¤Þ¤¿¤Ï¥Ð¡¼¤ËÀßÄꤷ¤Þ¤¹¡£ -.TP -.B title (\fPclass\fB Title) -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Î¥¿¥¤¥È¥ë̾¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B iconName (\fPclass\fB Title) -.B XEmacs -¥¦¥£¥ó¥É¥¦¥¢¥¤¥³¥ó¤Î̾Á°¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B scrollBarWidth (\fPclass\fB ScrollBarWidth) -¿âľ¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤ÎÉý¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢¿âľ¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B scrollBarHeight (\fPclass\fB ScrollBarHeight) -¿åÊ¿¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤Î¹â¤µ¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢¿åÊ¿¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B scrollBarPlacement (\fPclass\fB ScrollBarPlacement) -¿âľ¡¦¿åÊ¿¥¹¥¯¥í¡¼¥ë¥Ð¡¼¤Î°ÌÃÖ¤òÀßÄꤷ¤Þ¤¹¡£"top-left"¡¢"bottom-left"¡¢ -"top-right"¡¢"bottom-right"¤Î¤¤¤º¤ì¤«¤òÁªÂò¤·¤Þ¤¹¡£ -¥Ç¥Õ¥©¥ë¥È¤Ç¤Ï¡¢Motif ¤È Lucid ÍÑ¤Ë¤Ï "bottom-right" ¤¬¡¢ -Athena ÍÑ¤Ë¤Ï "buttom-left" ¤¬ÀßÄꤵ¤ì¤Æ¤¤¤Þ¤¹¡£ -.TP -.B topToolBarHeight (\fPclass\fB TopToolBarHeight) -¾åÉô¤Î¥Ä¡¼¥ë¥Ð¡¼¤Î¹â¤µ¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢¥Ä¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B bottomToolBarHeight (\fPclass\fB BottomToolBarHeight) -²¼Éô¥Ä¡¼¥ë¥Ð¡¼ ¤Î¹â¤µ¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢²¼Éô¥Ä¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B leftToolBarWidth (\fPclass\fB LeftToolBarWidth) -º¸Â¦¤Î¥Ä¡¼¥ë¥Ð¡¼¤ÎÉý¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢º¸Â¦¤Î¥Ä¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B rightToolBarWidth (\fPclass\fB RightToolBarWidth) -±¦Â¦¤Î¥Ä¡¼¥ë¥Ð¡¼¤ÎÉý¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -Ãͤò 0 ¤Ë¤¹¤ë¤È¡¢±¦Â¦¤Î¥Ä¡¼¥ë¥Ð¡¼¤Ïɽ¼¨¤µ¤ì¤Þ¤»¤ó¡£ -.TP -.B topToolBarShadowColor (\fPclass\fB TopToolBarShadowColor) -¥Ä¡¼¥ë¥Ð¡¼¤Î¾åÉô¥·¥ã¥É¥¦¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -(¤¹¤Ù¤Æ¤Î¥Ä¡¼¥ë¥Ð¡¼¤ËÍ­¸ú¡£¾åÉô¥Ä¡¼¥ë¥Ð¡¼°Ê³°¤Ë¤âÍ­¸ú¤Ç¤¹¡£) -.TP -.B bottomToolBarShadowColor (\fPclass\fB BottomToolBarShadowColor) -¥Ä¡¼¥ë¥Ð¡¼¤Î²¼Éô¥·¥ã¥É¥¦¤Î¿§¤òÀßÄꤷ¤Þ¤¹¡£ -(¤¹¤Ù¤Æ¤Î¥Ä¡¼¥ë¥Ð¡¼¤ËÍ­¸ú¡£¾åÉô¥Ä¡¼¥ë¥Ð¡¼°Ê³°¤Ë¤âÍ­¸ú¤Ç¤¹¡£) -.TP -.B topToolBarShadowPixmap (\fPclass\fB TopToolBarShadowPixmap) -¥Ä¡¼¥ë¥Ð¡¼¤Î¾åÉô¥·¥ã¥É¥¦¤Î¥Ô¥Ã¥¯¥¹¥Þ¥Ã¥×¤òÀßÄꤷ¤Þ¤¹¡£ -(¤¹¤Ù¤Æ¤Î¥Ä¡¼¥ë¥Ð¡¼¤ËÍ­¸ú¡£¾åÉô¥Ä¡¼¥ë¥Ð¡¼°Ê³°¤Ë¤âÍ­¸ú¤Ç¤¹¡£) -ÀßÄꤵ¤ì¤Æ¤¤¤ì¤Ð¡¢¤³¤Î¥ê¥½¡¼¥¹¤ÏÂбþ¤¹¤ë¥«¥é¡¼¥ê¥½¡¼¥¹¤ò̵¸ú¤Ë¤·¤Þ¤¹¡£ -.TP -.B bottomToolBarShadowPixmap (\fPclass\fB BottomToolBarShadowPixmap) -¥Ä¡¼¥ë¥Ð¡¼¤Î²¼Éô¥·¥ã¥É¥¦¤Î¥Ô¥Ã¥¯¥¹¥Þ¥Ã¥×¤òÀßÄꤷ¤Þ¤¹¡£ -(¤¹¤Ù¤Æ¤Î¥Ä¡¼¥ë¥Ð¡¼¤ËÍ­¸ú¡£¾åÉô¥Ä¡¼¥ë¥Ð¡¼°Ê³°¤Ë¤âÍ­¸ú¤Ç¤¹¡£) -ÀßÄꤵ¤ì¤Æ¤¤¤ì¤Ð¡¢¤³¤Î¥ê¥½¡¼¥¹¤ÏÂбþ¤¹¤ë¥«¥é¡¼¥ê¥½¡¼¥¹¤ò̵¸ú¤Ë¤·¤Þ¤¹¡£ -.TP -.B toolBarShadowThickness (\fPclass\fB ToolBarShadowThickness) -¥Ä¡¼¥ë¥Ð¡¼¤ò°Ï¤à¥·¥ã¥É¥¦Ç»ÅÙ¤ò¥Ô¥¯¥»¥ë¿ô¤ÇÀßÄꤷ¤Þ¤¹¡£ -.TP -.B visualBell (\fPclass\fB VisualBell) -¥¹¥¯¥ê¡¼¥óÅÀÌǤޤ¿¤Ï¥Ó¡¼¥×²»¤Î¤É¤Á¤é¤ò»ÈÍѤ¹¤ë¤«¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B bellVolume (\fPclass\fB BellVolume) -¥Ó¡¼¥×²»¤Î²»Î̤òÀßÄꤷ¤Þ¤¹¡£ÀßÄêÈÏ°Ï¤Ï 0 ¤«¤é 100 ¤Ç¤¹¡£ -.TP -.B useBackingStore (\fPclass\fB UseBackingStore) -.B XEmacs -X ¥¦¥£¥ó¥É¥¦¤Î¥Ð¥Ã¥­¥ó¥°¥¹¥È¥¢Â°À­¤òÀßÄꤹ¤ë¤«¤É¤¦¤«¤ò·èÄꤷ¤Þ¤¹¡£ -¤³¤Î°À­¤òÀßÄꤹ¤ë¤È¡¢ -X ¥µ¡¼¥Ð¡¼¤¬»ÈÍѤ¹¤ë¥á¥â¥ê¡¼¤¬Â¿¤¯¤Ê¤ê¤Þ¤¹¤¬¡¢ -¥¹¥¯¥ê¡¼¥ó¤ò¹¹¿·¤¹¤ëºÝ¤Î X ¥È¥é¥Õ¥£¥Ã¥¯¤¬¾¯¤Ê¤¯¤Ê¤ê¤Þ¤¹¡£ -¤Þ¤¿¡¢¥â¥Ç¥àÀܳ¤Î¤è¤¦¤ÊÄ㮲óÀþ¤ò»È¤Ã¤¿ -.I X -¥µ¡¼¥Ð¡¼¤È¤ÎÀܳ¤ËÍ­¸ú¤Ç¤¹¡£ -.TP -.B textPointer (\fPclass\fB Cursor) -¥Æ¥­¥¹¥È¾å¤Ë¥Þ¥¦¥¹¤¬¤¢¤ë¤È¤­¤Ë»ÈÍѤ¹¤ë¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B selectionPointer (\fPclass\fB Cursor) -¥Þ¥¦¥¹ÁªÂò¤µ¤ì¤¿¥Æ¥­¥¹¥ÈÈϰϾå¤Ë¥Þ¥¦¥¹¤¬¤¢¤ë¤È¤­¤Ë»ÈÍѤ¹¤ë -¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B spacePointer (\fPclass\fB Cursor) -¥Ð¥Ã¥Õ¥¡Æâ¤Î¶õÇò¥¹¥Ú¡¼¥¹¾å¤Ë¥Þ¥¦¥¹¤¬¤¢¤ë¤È¤­¤Ë(¤Ä¤Þ¤ê¡¢ -¹ÔËö¤ä¥Õ¥¡¥¤¥ë¤ÎºÇ¸å¤Ç) »ÈÍѤ¹¤ë¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B modeLinePointer (\fPclass\fB Cursor) -¥â¡¼¥É¥é¥¤¥ó¾å¤Ë¥Þ¥¦¥¹¤¬¤¢¤ë¤È¤­¤Ë»ÈÍѤ¹¤ë¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B gcPointer (\fPclass\fB Cursor) -¥¬¡¼¥Ù¥Ã¥¸¥³¥ì¥¯¥·¥ç¥óÃæ¤Ëɽ¼¨¤¹¤ë¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B scrollbarPointer (\fPclass\fB Cursor) -¥¹¥¯¥í¡¼¥ë¥Ð¡¼¾å¤Ë¥Þ¥¦¥¹¤¬¤¢¤ë¤È¤­¤Ë»ÈÍѤ¹¤ë¥«¡¼¥½¥ë¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B pointerColor (\fPclass\fB Foreground) -¥Þ¥¦¥¹¥«¡¼¥½¥ë¤ÎÁ°·Ê¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.TP -.B pointerBackground (\fPclass\fB Background) -¥Þ¥¦¥¹¥«¡¼¥½¥ë¤ÎÇØ·Ê¿§¤òÀßÄꤷ¤Þ¤¹¡£ -.PP -.SM "¥Þ¥¦¥¹¤Î»ÈÍÑ" -.PP -°Ê²¼¤Î¥ê¥¹¥È¤Ï¡¢X11 ¤Ë¤ª¤±¤ë -.B XEmacs -¥¦¥£¥ó¥É¥¦¤Ç¤Î¡¢¥Þ¥¦¥¹¥Ü¥¿¥ó¤Î³ä¤êÅö¤Æ¤Ç¤¹¡£ - -.in +\w'CTRL-SHIFT-middle'u+4n -.ta \w'CTRL-SHIFT-middle'u+4n -.ti -\w'CTRL-SHIFT-middle'u+4n -¥Þ¥¦¥¹¥Ü¥¿¥ó µ¡Ç½ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -º¸ ¥Ý¥¤¥ó¥È¤Î°ÌÃÖ·è¤á¤È¡¢¥Æ¥­¥¹¥È¤ÎÁªÂò¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -Ãæ±û ¥Æ¥­¥¹¥È¤Î¥Ú¡¼¥¹¥È¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -±¦ ¥ª¥×¥·¥ç¥ó¥á¥Ë¥å¡¼¤Î¥Ý¥Ã¥×¥¢¥Ã¥× -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -SHIFT-º¸ ÁªÂòÈϰϤγÈÄ¥¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-º¸ ÁªÂò¤·¤¿ÆâÍƤò¥Ý¥¤¥ó¥È°ÌÃÖ¤ËÁÞÆþ¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-Ãæ±û ¥Ý¥¤¥ó¥È¤Î°ÌÃÖ·è¤á¤È¤½¤Î°ÌÃ֤ǤΥƥ­¥¹¥È¤ÎÁªÂò¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-SHIFT-º¸ ÁªÂò¤·¤¿ÆâÍƤòºï½ü¤·¤½¤ÎÆâÍƤò¥Ý¥¤¥ó¥È°ÌÃÖ¤ËÁÞÆþ¡£ -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -META-º¸ È¢·¿ÁªÂò¡£ -.SH "¥Õ¥¡¥¤¥ë" -.LP -Lisp ¥³¡¼¥É¤¬¡¢µ¯Æ°»þ¤Ë¥æ¡¼¥¶¡¼¤Î½é´ü²½¥Õ¥¡¥¤¥ë \fB$HOME/.emacs\fP ¤«¤é -Æɤ߹þ¤Þ¤ì¤Þ¤¹¡£ -.LP -\f3/usr/local/info\f1 -.br -Info ʸ½ñ¥Ö¥é¥¦¥¶ -( -.BR XEmacs -¤Î¥µ¥Ö¥·¥¹¥Æ¥à)¤Î»²¾È¤¹¤ë¥Õ¥¡¥¤¥ë¡£ -¡ØXEmacs Reference Manual¡Ù¤È¡ØXEmacs Lisp Programmer's Manual¡Ù -¤Î´°Á´¤Ê¥Æ¥­¥¹¥È¤¬¡¢½êÄê¤Î³¬Áع½Â¤¤Ç¼ý¤á¤é¤ì¤Æ¤¤¤Þ¤¹¡£ -.LP -\f3/usr/local/lib/xemacs-$VERSION/info\f1 -.br -Info ¥Õ¥¡¥¤¥ë(¤³¤Î°ÌÃ֤ȤϤ«¤®¤é¤Ê¤¤) -.LP -\f3/usr/local/lib/xemacs-$VERSION/src\f1 -.br -C ¥½¡¼¥¹¥Õ¥¡¥¤¥ë¤È¥ª¥Ö¥¸¥§¥¯¥È¥Õ¥¡¥¤¥ë(¸ºß¤·¤Ê¤¤¾ì¹ç¤â¤¢¤ë) -.LP -\f3/usr/local/lib/xemacs-$VERSION/lisp/*\f1 -.br -¿¤¯¤ÎÊÔ½¸¥³¥Þ¥ó¥É¤òÄêµÁ¤¹¤ë Lisp ¥½¡¼¥¹¥Õ¥¡¥¤¥ë¤È¥³¥ó¥Ñ¥¤¥ëºÑ¤ß¥Õ¥¡¥¤¥ë¡£ -¤³¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Ïµ¡Ç½¤ä¸Ä¡¹¤Î¥Ñ¥Ã¥±¡¼¥¸Ê̤˥µ¥Ö¥Ç¥£¥ì¥¯¥È¥êÆâ¤Ë -ʬÎव¤ì¡¢ÃÖ¤«¤ì¤Æ¤¤¤Þ¤¹¡£¤¤¤¯¤Ä¤«¤Î¥Õ¥¡¥¤¥ë¤Ï -Á°¤â¤Ã¤ÆÆɤ߹þ¤Þ¤ì¤Æ¤¤¤Þ¤¹¡£¤½¤ì°Ê³°¤Î¤â¤Î¤Ï¡¢»ÈÍÑ»þ¤Ë¤³¤ì¤é¤Î¥Ç¥£¥ì¥¯¥È¥ê¤«¤é¡¢ -¼«Æ°Åª¤ËÆɤ߹þ¤Þ¤ì¤Þ¤¹¡£ -.LP -\f3/usr/local/lib/xemacs-$VERSION/etc\f1 -.br -¤¤¤¯¤Ä¤«¤Î¾ðÊó¥Õ¥¡¥¤¥ë¡¢¥Ô¥Ã¥¯¥¹¥Þ¥Ã¥×¥Õ¥¡¥¤¥ë¡¢ -¥Ñ¥Ã¥±¡¼¥¸¤Ë»ÈÍѤµ¤ì¤ë¥Ç¡¼¥¿¥Õ¥¡¥¤¥ë¤Ê¤É¡£ -.LP -\f3/usr/local/lib/xemacs-$VERSION/$CONFIGURATION\f1 -.br -XEmacs ¤Ë»ÈÍѤµ¤ì¤ë¤µ¤Þ¤¶¤Þ¤Ê¥×¥í¥°¥é¥à¥Õ¥¡¥¤¥ë¡£ -.LP -\f3/usr/local/lib/xemacs-$VERSION/$CONFIGURATION/DOC\f1 -.br -Lisp ¥×¥ê¥ß¥Æ¥£¥Ö (´ðËÜ´Ø¿ô) ¤È \fBXEmacs\fP ¤Ë¤¢¤é¤«¤¸¤á -Æɤ߹þ¤Þ¤ì¤¿ Lisp ´Ø¿ô¤Î¥É¥­¥å¥á¥ó¥Èʸ»úÎó¡£ -¤³¤ì¤é¤Î¥Õ¥¡¥¤¥ë¤Ï¡¢\fBXEmacs\fP ËÜÂΤΥµ¥¤¥º¤ò¸º¤é¤¹¤¿¤á¤Ë¤³¤³¤ËÊÝ´É -¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ -.LP -\f3/usr/local/lib/xemacs-$VERSION/etc/SERVICE\f1 -.br -\fBXEmacs\fP ¥æ¡¼¥¶¡¼¤Î¤¿¤á¤Î¡¢³Ø½¬¡¢Êݼ顢°Ü¿¢¡¢ -¥«¥¹¥¿¥Þ¥¤¥º¤Ê¤É¤Î¤µ¤Þ¤¶¤Þ¤Ê¥µ¡¼¥Ó¥¹¤òÄ󶡤¹¤ë¿Í¡¹¤Ë¤Ä¤¤¤Æ¤Þ¤È¤á¤Æ¤¤¤Þ¤¹¡£ -.LP -\f3/usr/local/lib/xemacs/lock\f1 -.br -2 ¿Í¤Î¥æ¡¼¥¶¡¼¤¬ 1 ¤Ä¤Î¥Õ¥¡¥¤¥ë¤òƱ»þ¤Ë¹¹¿·¤Ç¤­¤Ê¤¤¤è¤¦¤Ë¡¢ -.BR XEmacs -¤Ç¹¹¿·Ãæ¤Î¤¹¤Ù¤Æ¤Î¥Õ¥¡¥¤¥ë¤ËÂФ·¤Æ¤Ç¤­¤ë¥í¥Ã¥¯¥Õ¥¡¥¤¥ë¤òÊÝ»ý¤·¤Þ¤¹¡£ -.LP -\f3/usr/local/lib/xemacs/site-lisp\f1 -.br -¥í¡¼¥«¥ë¤ËºîÀ®¤¹¤ë Lisp ¥Õ¥¡¥¤¥ë¡£ -.LP -\f3/usr/lib/X11/rgb.txt\f1 -.br -Àµ¼°¤Î X ¥«¥é¡¼Ì¾¤¬¥ê¥¹¥È¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ -.PP -.SH "»ÈÍѾå¤Îα°ÕÅÀ¤ÈÌ䤤¹ç¤ï¤»Àè" -.B XEmacs -¤Ë´Ø¤¹¤ë¥Ð¥°¤ä½¤Àµ¤ÎÊó¹ðÀè¤È¤·¤Æ¡¢¤Þ¤¿½õ¸À¤òµá¤á¤ë°¸Àè¤È¤·¤Æ¡¢ -comp.emacs.xemacs ¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×¤¬¤¢¤ê¤Þ¤¹¡£ -¤¿¤À¤·¡¢ÌäÂêÅÀ¤ò¥Ð¥°¤È¤·¤ÆÊó¹ð¤¹¤ëÁ°¤Ë¡¢ -ËÜÅö¤Ë¤½¤ì¤¬¥Ð¥°¤Ç¤¢¤ë¤«¡¢¸í²ò¤ä°Õ¿ÞŪ¤Êµ¡Ç½¤Ç¤Ï¤Ê¤¤¤« -¤È¤¤¤¦¤³¤È¤ò¤ª³Î¤«¤á¤¯¤À¤µ¤¤¡£¥Ð¥°¥ì¥Ý¡¼¥È¤ÎÊýË¡¤ä»þ´ü¤Ë¤Ä¤¤¤Æ¤Ï¡¢ -¥ê¥Õ¥¡¥ì¥ó¥¹¥Þ¥Ë¥å¥¢¥ë(¤Þ¤¿¤Ï Into ¥·¥¹¥Æ¥à) ¤Î¸åȾ¶á¤¯¤¢¤ë -¡ÖReporting XEmacs Bugs¡×¤È¤¤¤¦¾Ï¤ò¤ªÆɤߤ¯¤À¤µ¤¤¡£ -¤Þ¤¿¡¢Êó¹ð¤¹¤ë¥Ð¥°¥ì¥Ý¡¼¥È¤Ë¤Ï¡¢Æ°ºîÃæ¤Î -.B XEmacs -¤Î¥Ð¡¼¥¸¥ç¥óÈÖ¹æ¤È¤½¤ì¤¬Æ°ºî¤·¤Æ¤¤¤ë¥·¥¹¥Æ¥à¤òµ­Æþ¤·¤Æ¤¯¤À¤µ¤¤¡£ -ºÇ¸å¤Ë¡¢¥Ð¥°¤Î¸¶°ø¤È¤½¤ì¤¬È¯À¸¤·¤¿¾õ¶·¤ò¡¢¤Ç¤­¤ë¤À¤±¤½¤Î¤Þ¤ÞÊݸ¤·¤Æ¤ª¤¤¤Æ -¤¯¤À¤µ¤¤¡£¤½¤ÎÊݸ¾õÂÖ¤¬Îɤ±¤ì¤Ð´Êñ¤Ë½¤Àµ¤Ç¤­¤ë²ÄǽÀ­¤¬¹â¤¯¤Ê¤ê¤Þ¤¹¡£ -¤Ç¤­¤ë¤À¤±¤´¶¨ÎϤò¤ª´ê¤¤¤·¤Þ¤¹¡£ - -¤³¤Î¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×¤Ï¡¢xemacs@xemacs.org ¤È¤¤¤¦¥á¡¼¥ë¥ê¥¹¥È¤«¤é¤Îȯ¿®¡¢¼õ¿®¤ò -ÁÐÊý¸þ¤Ë¹Ô¤¦¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£¥Í¥Ã¥È¥Ë¥å¡¼¥¹¤Ë´Êñ¤Ë¥¢¥¯¥»¥¹¤Ç¤­¤Ê¤¤¤è¤¦¤Ê¾ì¹ç¤Ï¡¢ -newsgroup ¤ËÂå¤ï¤Ã¤Æ¥á¡¼¥ë¥ê¥¹¥È¤òÆɤळ¤È¤¬¤Ç¤­¤Þ¤¹¡£¥á¡¼¥ë¥ê¥¹¥È¤Ø¤ÎÄɲà -¤´´õ˾¤ÎÊý¤Ï¡¢xemacs-request@xemacs.org ¤Ø¥á¡¼¥ë¤ò¤ªÁ÷¤ê¤¯¤À¤µ¤¤¡£ -(ľÀܥꥹ¥È¤Ë¥á¡¼¥ë¤òÁ÷¿®¤·¤Ê¤¤¤Ç¤¯¤À¤µ¤¤¡£) - -.B XEmacs -¤ÎÊݼéôÅö¼Ô¤Ï¡¢Äê´üŪ¤Ë¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×¤òÆɤó¤Ç¤¤¤Þ¤¹¡£¤½¤·¤ÆÊó¹ð¤µ¤ì¤¿ -¥Ð¥°¤ËÂФ·¤Æ¿×®¤Ë½¤Àµ¤ò¤¹¤ë¤è¤¦¤ËÅؤá¤Æ¤¤¤Þ¤¹¡£¤·¤«¤·¤Ê¤¬¤é¡¢¤¹¤Ù¤Æ¤Î -¥á¥Ã¥»¡¼¥¸¤¬ÊݼéôÅö¼Ô¤«¤éÊÖÅú¤ò¼õ¤±¤ë¤³¤È¤¬¤Ç¤­¤ë¤ï¤±¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£ -ÊݼéôÅö¼Ô°Ê³°¤Ë¿¿ô¤Î¿Í㤬¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×¤òÆɤó¤Ç¤ª¤ê¡¢Ä̾ïÈà¤é¤«¤é¤â -½Ð¤¯¤ï¤·¤¿ÌäÂê¤ò²ò·è¤¹¤ë¤¿¤á¤Î½õ¸À¤òÆÀ¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ - -¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×¤«¤éÆÀ¤é¤ì¤ë¾ðÊó°Ê¾å¤Ë¡¢¾ÜºÙ¤Ê¥µ¥Ý¡¼¥È¤¬É¬Íפʾì¹ç¤Ï¡¢ -SERVICE ¥Õ¥¡¥¤¥ë(¾å½Ò)¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ -¤½¤Î¥Õ¥¡¥¤¥ë¤Ë¡¢Ã´Åö¼Ô¤¬¥ê¥¹¥È¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ - -XEmacs ¤Î¥á¡¼¥ë¥ê¥¹¥È¤Ë¤Ä¤¤¤Æ¤Î¾ÜºÙ¤Ï¡¢ -.B /usr/local/lib/xemacs-$VERSION/etc/MAILINGLISTS -¤Î¥Õ¥¡¥¤¥ë¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ -.SH "ÈóÀ©Ìó»ö¹à" -.PP -.B XEmacs -¤Ï¡¢¥Õ¥ê¡¼¤Î¥½¥Õ¥È¥¦¥§¥¢¤Ç¤¹¡£ -.B XEmacs -General Public License ¤Ë½Ò¤Ù¤é¤ì¤Æ¤¤¤ë¸Â¤ê¤Ë¤ª¤¤¤Æ¡¢¤À¤ì¤Ç¤â -.B XEmacs -¤ä¤½¤ì¤ËÉտ路¤¿¤â¤Î¤Î¥³¥Ô¡¼¡¢¤ª¤è¤Ó¥ê¥Õ¥¡¥ì¥ó¥¹¥Þ¥Ë¥å¥¢¥ë¤Ëɽ¼¨¤µ¤ì¤Æ¤¤¤ë -ÆâÍƤΥ³¥Ô¡¼¤ò¡¢Ç¤°Õ¤Î¿Í¤ËÄ󶡤¹¤ë¤³¤È¤¬µö¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ -.PP -.B XEmacs -¤Ï¡¢UNIX ¥·¥¹¥Æ¥à¤ÎÇÛÉÛʪ¤È¤È¤â¤Ë¥Ñ¥Ã¥±¡¼¥¸¤µ¤ì¤ÆÄ󶡤µ¤ì¤ë¤³¤È¤¬¤¢¤ê¤Þ¤¹¤¬¡¢ -.B XEmacs -¤Ï¾ï¤Ë¤½¤ì¤é¤Î¥·¥¹¥Æ¥à¤Ë´Ø¤¹¤ë¥é¥¤¥»¥ó¥¹¤ÎÈϰϳ°¤Ç¤¹¡£¤â¤· -.B XEmacs -¤â¤½¤Î¥é¥¤¥»¥ó¥¹¤Ë´Þ¤Þ¤ì¤Æ¤¤¤ë¤È¤¹¤ì¤Ð¡¢¤½¤ì¤ÏÇÛÉÛµö²ÄÍ×¹à¤ËÈ¿¤·¤Þ¤¹¡£ -¤¤¤«¤Ê¤ë¿Í¤â -.B XEmacs -¤ÎÇÛÉۤ˴ؤ·¤Æ¤Ï²¿¤ÎÀ©Ìó¤â¼õ¤±¤Æ¤Ï¤Ê¤é¤Ê¤¤¡¢¤È¤¤¤¦¤Î¤¬ -General Public License ¤ÎËÜÍè¤ÎÌÜŪ¤Ç¤¹¡£ -.SH "´ØÏ¢¹àÌÜ" -.BR X (1), -.BR xlsfonts (1), -.BR xterm (1), -.BR xrdb (1), -.BR emacs (1), -.BR vi (1) -.SH "Ãø¼Ô" -.PP -.B XEmacs -¤Ï¡¢Chuck Thompson ¡¢Ben Wing ¡¢ -Jamie Zawinski ¡¢Richard Mlynarik ¡¢ -Martin Buchholz ¾¡¢¤Ë¤è¤Ã¤Æ½ñ¤«¤ì¤Þ¤·¤¿¡£ -Free Software Foundation ¤Î Richard Stallman ¤Î½ñ¤¤¤¿ -.B "GNU Emacs " -¥Ð¡¼¥¸¥ç¥ó -.I 19 -¤ÎÁá´ü¥Ð¡¼¥¸¥ç¥ó¤ò¤â¤È¤Ë¤·¤Æ¤¤¤Þ¤·¤¿¤¬¡¢ -.B GNU Emacs -¤¬»ÈÍѲÄǽ¤È¤Ê¤Ã¤¿¸å¤Ç¤Ï¡¢¤½¤Î¸å³¥ê¥ê¡¼¥¹¤ËƱ´ü¤µ¤ì¤Æ¤¤¤Þ¤¹¡£ -¤â¤È¤â¤È¤Ï¡¢(º£¤ä¸ºß¤·¤Ê¤¤) Lucid, Inc. ¤Ë¤è¤Ã¤Æ½ñ¤«¤ì¤¿¤â¤Î¤Ç¡¢ -.B "Lucid Emacs " -¤È¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤·¤¿¡£ -.PP -Chuck Thompson ¤¬ -.B XEmacs -¤ÎºÆɽ¼¨¤Î´ðËÜÉôʬ¤ò½ñ¤­¡¢ -.B XEmacs -¤Î FTP ¤È WWW ¥µ¥¤¥È¤òÊÝ»ý¤·¡¢ -¥Ð¡¼¥¸¥ç¥ó 19.11 ( -.B XEmacs -¤È¤è¤Ð¤ì¤¿ºÇ½é¤Î¥ê¥ê¡¼¥¹) ¤«¤é¤¹¤Ù¤Æ¤Î -.B XEmacs -¤Îµ¡Ç½¤¬¥ê¥ê¡¼¥¹¤µ¤ì¤Þ¤·¤¿¡£ -Ben Wing ¤Ï¡¢¥¢¥¸¥¢¸À¸ì¤Î¥µ¥Ý¡¼¥È¡¢¥ª¥ó¥é¥¤¥ó¥Þ¥Ë¥å¥¢¥ë (¥Þ¥Ë¥å¥¢¥ë -¥Ú¡¼¥¸¤È¿¤¯¤Î FAQ ¤ò´Þ¤à)¡¢³°Éô¥¦¥£¥¸¥§¥Ã¥È¥³¡¼¥É¤ò½ñ¤­¡¢Äã¥ì¥Ù¥ë¤À¤Ã¤¿ -.B XEmacs -¥µ¥Ö¥·¥¹¥Æ¥à¤Î¿¤¯¤Î´ðËÜÉôʬ¤ò¶¯²½¤·¡¢½ñ¤­Ä¾¤·¤Þ¤·¤¿¡£ -Jamie Zawinski ¤Ï¡¢ -.B "Lucid Emacs " -¤Î½é´ü¥Ð¡¼¥¸¥ç¥ó (19.0) ¤«¤éºÇ½ª¥Ð¡¼¥¸¥ç¥ó (19.10) ¤Þ¤Ç¤Î¤¹¤Ù¤Æ¤ò -¥ê¥ê¡¼¥¹¤·¡¢¤³¤ì¤é¤¹¤Ù¤Æ¤Î¥ê¥ê¡¼¥¹¤Î¼ç¥³¡¼¥É¹×¸¥¼Ô¤Ç¤·¤¿¡£ -Richard Mlynarik ¤Ï¡¢ -.B XEmacs -Lisp ¥ª¥Ö¥¸¥§¥¯¥È³ä¤êÅö¤Æ¥·¥¹¥Æ¥à¤ò½ñ¤­Ä¾¤·¤È¡¢¥­¡¼¥Þ¥Ã¥×¥³¡¼¥É¤È -¥ß¥Ë¥Ð¥Ã¥Õ¥¡¥³¡¼¥É¤Î½¤Àµ¡¢¤½¤·¤Æ -.B XEmacs -¤È -.B GNU Emacs -¥Ð¡¼¥¸¥ç¥ó -.IR 19 -¤Î½é´ü¤ÎƱ´ü¤ò¹Ô¤¤¤Þ¤·¤¿¡£ -.PP -¤½¤Î¾¿¤¯¤Î¿Í¤â¡¢Â¿Âç¤Ê¹×¸¥¤ò³¤±¤Æ¤­¤Þ¤·¤¿¡£¾ÜºÙ¤ÊÆâÍÆ(Ê̤δÑÅÀ -¤«¤é¸«¤¿ \fBXEmacs\fP ¤ÎŤ¤Îò»Ë¤äÁ¯ÌÀ¤Ê²èÁü¡¢\fBXEmacs\fP ¹×¸¥¼Ô¤¿¤Á -¤Î¿Íʪ¾Ò²ð¤Ê¤É)¤Ë¤Ä¤¤¤Æ¤Ï¡¢ -¥Ø¥ë¥×¥á¥Ë¥å¡¼¤Î¡ÖXEmacs ¤Ë¤Ä¤¤¤Æ¡×¤ò»²¾È¤·¤Æ¤¯¤À¤µ¤¤¡£ -.SH "ÄɲþðÊó" -\fBXEmacs\fP ¤ÎÄɲþðÊó¤Ë¤Ä¤¤¤Æ¤Ï¡¢ -¥Ø¥ë¥×¥á¥Ë¥å¡¼¤Î¡ÖXEmacs ¤Ë¤Ä¤¤¤Æ¡×(¾å½Ò)¤ò»²¾È¤¹¤ë¤«¡¢ -.B /usr/local/lib/xemacs-$VERSION/etc/NEWS -¥Õ¥¡¥¤¥ë¤ò¤ªÆɤߤ¯¤À¤µ¤¤¡£¤Þ¤¿¤Ï Web ¥Ö¥é¥¦¥¶¤Ç -.PP -http://www.xemacs.org/ -.PP -¤ò»ØÄꤷ¤Æ¤¹¤ë¤È¡¢\fBXEmacs\fP ¤Ë¤Ä¤¤¤Æ¤ÎºÇ¿·¾ðÊó¤¬ÆÀ¤é¤ì¤Þ¤¹¡£ -.PP -.B XEmacs -¤Ë¤Ä¤¤¤Æ¤Î FAQ (¤è¤¯¿Ò¤Í¤é¤ì¤ë¼ÁÌä) ¤â¡¢¤³¤Î URL ¤Ç¸«¤Ä¤±¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -\fBXEmacs\fP Æâ¤Î Info ¥·¥¹¥Æ¥à¤«¤é¤Ï¡¢»ÈÍѲÄǽ¤Êµì¥Ð¡¼¥¸¥ç¥ó¤Ë -¥¢¥¯¥»¥¹¤¹¤ë¤³¤È¤â²Äǽ¤Ç¤¹¡£ -.PP -ºÇ¿·¥Ð¡¼¥¸¥ç¥ó¤Î \fBXEmacs\fP ¤Ï¡¢ -.B "ftp://ftp.xemacs.org/pub/xemacs/" -¤Þ¤¿¤Ï¤ª¶á¤¯¤Î¥ß¥é¡¼¥µ¥¤¥È¤«¤éƿ̾ (anonymous) FTP ¤Ç -¥À¥¦¥ó¥í¡¼¥É¤¹¤ë¤³¤È¤¬¤Ç¤­¤Þ¤¹¡£ -°Ê²¼¤Ë¥ß¥é¡¼¥µ¥¤¥È¤Î°ìÍ÷¤òµ­½Ò¤·¤Þ¤¹¡£ -¤¿¤À¤·¡¢¥ß¥é¡¼¥µ¥¤¥È¤¬Êѹ¹¤µ¤ì¤Æ¥¢¥¯¥»¥¹¤Ç¤­¤Ê¤¤¾ì¹ç¤â¤¢¤ê¤Þ¤¹¡£ -.PP -ftp://ftp.ai.mit.edu/pub/xemacs/ -.br -ftp://ftp.uu.net/systems/gnu/xemacs/ -.br -ftp://ftp.sunet.se/pub/gnu/xemacs/ -.br -ftp://ftp.cenatls.cena.dgac.fr/pub/Emacs/xemacs/ -.br -ftp://liasun3.epfl.ch/pub/gnu/xemacs/ -.br -ftp://ftp.th-darmstadt.de/pub/editors/xemacs/ -.br -ftp://audrey.levels.unisa.edu.au/xemacs/ -.br -ftp://sunsite.doc.ic.ac.uk/gnu/xemacs/ -.br -ftp://ftp.ibp.fr/pub/emacs/xemacs/ -.br -ftp://uiarchive.cso.uiuc.edu/pub/packages/xemacs/ -.br -ftp://ftp.technion.ac.il/pub/unsupported/gnu/xemacs/ -.br -ftp://thphys.irb.hr/pub/xemacs/ -.PP -¥ß¥é¡¼¥µ¥¤¥È¤ÎºÇ¿·¥ê¥¹¥È¤Ë¤Ä¤¤¤Æ¤Ï¡¢Web ¥µ¥¤¥È¤ò¤´Í÷¤¯¤À¤µ¤¤¡£ - diff --git a/etc/xemacs.1 b/etc/xemacs.1 deleted file mode 100644 index d812351..0000000 --- a/etc/xemacs.1 +++ /dev/null @@ -1,791 +0,0 @@ -.TH XEMACS 1 "1998 January 13" -.UC 4 -.SH NAME -xemacs \- Emacs: The Next Generation -.SH SYNOPSIS -.B xemacs -[ -.I command-line switches -] [ -.I files ... -] -.br -.SH DESCRIPTION -.I XEmacs -is a version of -.IR Emacs , -compatible with and containing many improvements over -.I GNU -.IR Emacs , -written by Richard Stallman of the Free Software Foundation. It was -originally based on an early release of -.I GNU Emacs Version -.IR 19 , -and has tracked subsequent releases of -.I GNU Emacs -as they have become available. -.PP -The primary documentation of -.I XEmacs -is in the -.I XEmacs Reference -.IR Manual , -which you can read on-line using Info, a subsystem of -.IR XEmacs . -Please look there for complete and up-to-date documentation. -Complete documentation on using Emacs Lisp is available on-line -through the -.I XEmacs Lisp Programmer's -.IR Manual . -Both manuals also can be printed out nicely using the -.I TeX -formatting package. -.PP -The user functionality of -.I XEmacs -encompasses everything other -.I Emacs -editors do, and it is easily extensible since its -editing commands are written in Lisp. -.PP -.I XEmacs -has an extensive interactive help facility, -but the facility assumes that you know how to manipulate -.I XEmacs -windows and buffers. -CTRL-h enters the Help facility. Help Tutorial (CTRL-h t) -requests an interactive tutorial which can teach beginners the fundamentals -of -.I XEmacs -in a few minutes. -Help Apropos (CTRL-h a) helps you -find a command given its functionality, Help Key Binding (CTRL-h k) -describes a given key sequence's effect, and Help Function (CTRL-h f) -describes a given Lisp function specified by name. You can also -look up key sequences in the -.I XEmacs Reference Manual -using Lookup Key Binding (CTRL-h CTRL-k), -and look up Lisp functions in the -.I XEmacs Lisp Programmer's Manual -using Lookup Function (CTRL-h CTRL-f). All of these help functions, -and more, are available on the Help menu if you are using a window -system. -.PP -.I XEmacs -has extensive GUI (graphical user interface) support when running under -a window system such as -.IR X , -including multiple frames (top-level windows), a menubar, a toolbar, -horizontal and vertical scrollbars, dialog boxes, and extensive mouse -support. -.PP -.I XEmacs -has full support for multiple fonts and colors, variable-width fonts, -and variable-height lines, and allows for pixmaps to be inserted into -a buffer. (This is used in the W3 web-browsing package and in some -of the debugger and outlining interfaces, among other things.) -.PP -.IR XEmacs 's -Undo can undo several steps of modification to your buffers, so it is -easy to recover from editing mistakes. -.PP -.IR XEmacs 's -many special packages handle mail reading (VM, MH-E and RMail) and -sending (Mail), Usenet news reading and posting (GNUS), World Wide Web -browsing (W3), specialized modes for editing source code in all common -programming languages, syntax highlighting for many languages -(Font-Lock), compiling (Compile), running subshells within -.I XEmacs -windows (Shell), outline editing (Outline), running a Lisp read-eval-print -loop (Lisp-Interaction-Mode), and automated psychotherapy (Doctor). -.PP -There is an extensive reference manual, but users of other Emacsen -should have little trouble adapting even without a copy. Users new to -Emacs will be able to use basic features fairly rapidly by studying -the tutorial and using the self-documentation features. -.PP -.SM XEmacs Options -.PP -XEmacs accepts all standard X Toolkit command line options when run in -an X Windows environment. In addition, the following options are accepted -(when options imply a sequence of actions to perform, they are -performed in the order encountered): -.TP 8 -.BI \-t " file" -Use specified -.I file -as the terminal instead of using stdin/stdout. This implies -.BR \-nw \. -.TP -.BI \-batch -Edit in batch mode. The editor will send messages to stdout. You -must use the -.BR \-l , -.BR \-f , -and -.B \-eval -options to specify files to execute and functions to call. -.TP -.B \-nw -Inhibit the use of any window-system-specific display code: use the -current TTY. -.TP -.B \-debug\-init -Enter the debugger if an error occurs loading the init file. -.TP -.B \-unmapped -Do not map the initial frame. -.TP -.B \-no\-site\-file -Do not load the site-specific init file (site-start.el). -.TP -.B \-q, \-no\-init\-file -Do not load an init file. -.TP -.B \-no-early-packages -Do not process the early packages. -.TP -.B \-vanilla -Load no extra files at startup. Equivalent to the combination of -.B \-q -, -.B \-no-site-file -, and -.B \-no-packages -\. -.TP -.BI \-u " user, " \-user " user" -Load -.IR user 's -init file. -.TP 8 -.I file -Edit -.IR file \. -.TP -.BI \+ number -Go to the line specified by -.I number -(do not insert a space between the "+" sign and the number). -.TP -.B \-help -Print a help message and exit. -.TP -.B \-V, \-version, -Print the version number and exit. -.TP -.BI \-f " function, " \-funcall " function" -Execute the lisp function -.IR function \. -.TP -.BI \-l " file, " \-load " file" -Load the Lisp code in the file -.IR file \. -.TP -.BI \-eval " form" -Evaluate the Lisp form -.IR form \. -.TP -.BI \-i " file, " \-insert " file" -Insert -.I file -into the current buffer. -.TP -.B \-kill -Exit -.I XEmacs -(useful with -.BR \-batch ). -.PP -.SM Using XEmacs with X -.PP -.I XEmacs -has been tailored to work well with the X window system. -If you run -.I XEmacs -from under X windows, it will create its own X window to -display in. You will probably want to start the editor -as a background process -so that you can continue using your original window. -.PP -.I XEmacs -can be started with the following standard X options: -.TP -.BI \-geometry " ##x##+##+##" -Specify the geometry of the initial window. The ##'s represent a number; -the four numbers are width (characters), height (characters), X offset -(pixels), and Y offset (pixels), respectively. Partial specifications of -the form -.I ##x## -or -.I +##+## -are also allowed. (The geometry -specification is in the standard X format; see -.IR X (1) -for more information.) -.TP -.B \-iconic -Specifies that the initial window should initially appear iconified. -.TP 8 -.BI \-name " name" -Specifies the program name which should be used when looking up -defaults in the user's X resources. -.TP -.BI \-title " title, " \-T " title, " \-wn " title" -Specifies the title which should be assigned to the -.I XEmacs -window. -.TP -.BI \-d " displayname, " \-display " displayname" -Create the -.I XEmacs -window on the display specified by -.IR displayname . -Must be the first option specified in the command line. -.TP -.BI \-font " font, " \-fn " font" -Set the -.I XEmacs -window's font to that specified by -.IR font \. -You will find the various -.I X -fonts in the -.I /usr/lib/X11/fonts -directory. -.I XEmacs -works with either fixed- or variable-width fonts, but will probably -look better with a fixed-width font. -.TP -.BI \-scrollbar\-width " pixels" -Specify the width of the vertical scrollbars. -.TP -.BI \-scrollbar\-height " pixels" -Specify the height of the horizontal scrollbars. -.TP -.BI \-bw " pixels, " \-borderwidth " pixels" -Set the -.I XEmacs -window's border width to the number of pixels specified by -.IR pixels \. -Defaults to one pixel on each side of the window. -.TP -.BI \-ib " pixels, " \-internal\-border\-width " pixels" -Specify the width between a frame's border and its text, in pixels. -Defaults to one pixel on each side of the window. -.TP -.BI \-fg " color, " \-foreground " color" -Sets the color of the text. - -See the file -.I /usr/lib/X11/rgb.txt -for a list of valid -color names. -.TP -.BI \-bg " color, " \-background " color" -Sets the color of the window's background. -.TP -.BI \-bd " color, " \-bordercolor " color" -Sets the color of the window's border. -.TP -.BI \-mc " color" -Sets the color of the mouse pointer. -.TP -.BI \-cr " color" -Sets the color of the text cursor. -.TP -.B \-rv, \-reverse -Reverses the foreground and background colors (reverse video). Consider -explicitly setting the foreground and background colors instead of using -this option. -.TP -.BI \-xrm " argument" -This allows you to set an arbitrary resource on the command line. -.I argument -should be a resource specification, as might as in your -.I \.Xresources -or -.I \.Xdefaults -file. -.PP -You can also set resources, i.e. -.I X -default values, for your -.I XEmacs -windows in your -.I \.Xresources -or -.I \.Xdefaults -file (see -.IR xrdb (1)). -Use the following format: -.IP -Emacs.keyword:value -.PP -or -.IP -Emacs*EmacsFrame.keyword:value -.PP -where -.I value -specifies the default value of -.IR keyword \. -(Some resources need the former format; some the latter.) -.PP -You can also set resources for a particular frame by using the -format -.IP -Emacs*framename.keyword:value -.PP -where -.I framename -is the resource name assigned to that particular frame. -(Certain packages, such as VM, give their frames unique resource -names, in this case "VM".) -.PP -.I XEmacs -lets you set default values for the following keywords: -.TP 8 -.B default.attributeFont (\fPclass\fB Face.AttributeFont) -Sets the window's text font. -.TP -.B default.attributeForeground (\fPclass\fB Face.AttributeForeground) -Sets the window's text color. -.TP -.B default.attributeBackground (\fPclass\fB Face.AttributeBackground) -Sets the window's background color. -.TP -.B \fIface\fB.attributeFont (\fPclass\fB Face.AttributeFont) -Sets the font for -.IR face , -which should be the name of a face. Common face names are -.PP -.in +\w'right-margin'u+12n -.ta \w'right-margin'u+4n -.ti -\w'right-margin'u+4n -FACE PURPOSE -.br -.ti -\w'right-margin'u+4n -default Normal text. -.br -.ti -\w'right-margin'u+4n -bold Bold text. -.br -.ti -\w'right-margin'u+4n -italic Italicized text. -.br -.ti -\w'right-margin'u+4n -bold-italic Bold and italicized text. -.br -.ti -\w'right-margin'u+4n -modeline Modeline text. -.br -.ti -\w'right-margin'u+4n -zmacs-region Text selected with the mouse. -.br -.ti -\w'right-margin'u+4n -highlight Text highlighted when the mouse passes over. -.br -.ti -\w'right-margin'u+4n -left-margin Text in the left margin. -.br -.ti -\w'right-margin'u+4n -right-margin Text in the right margin. -.br -.ti -\w'right-margin'u+4n -isearch Text highlighted during incremental search. -.br -.ti -\w'right-margin'u+4n -info-node Text of Info menu items. -.br -.ti -\w'right-margin'u+4n -info-xref Text of Info cross references. -.TP 8 -.B \fIface\fB.attributeForeground (\fPclass\fB Face.AttributeForeground) -Sets the foreground color for -.IR face \. -.TP 8 -.B \fIface\fB.attributeBackground (\fPclass\fB Face.AttributeBackground) -Sets the background color for -.IR face \. -.TP 8 -.B \fIface\fB.attributeBackgroundPixmap (\fPclass\fB Face.AttributeBackgroundPixmap) -Sets the background pixmap (stipple) for -.IR face \. -.TP 8 -.B \fIface\fB.attributeUnderline (\fPclass\fB Face.AttributeUnderline) -Whether -.I face -should be underlined. -.TP -.B reverseVideo (\fPclass\fB ReverseVideo) -If set to -.IR on , -the window will be displayed in reverse video. Consider -explicitly setting the foreground and background colors instead -of using this resources. -.TP -.B borderWidth (\fPclass\fB BorderWidth) -Sets the window's border width in pixels. -.TP -.B internalBorderWidth (\fPclass\fB InternalBorderWidth) -Sets the window's internal border width in pixels. -.TP -.B borderColor (\fPclass\fB BorderColor) -Sets the color of the window's border. -.TP -.B cursorColor (\fPclass\fB Foreground) -Sets the color of the window's text cursor. -.TP -.B pointerColor (\fPclass\fB Foreground) -Sets the color of the window's mouse cursor. -.TP -.B geometry (\fPclass\fB Geometry) -Sets the geometry of the -.I XEmacs -window (as described above). -.TP -.B iconic (\fPclass\fB Iconic) -If set to on, the -.I XEmacs -window will initially appear as an icon. -.TP -.B menubar (\fPclass\fB Menubar) -Whether the -.I XEmacs -window will have a menubar. Defaults to true. -.TP -.B initiallyUnmapped (\fPclass\fB InitiallyUnmapped) -Whether -.I XEmacs -will leave the initial frame unmapped when it starts up. -.TP -.B barCursor (\fPclass\fB BarCursor) -Whether the cursor should be a bar instead of the traditional box. -.TP -.B title (\fPclass\fB Title) -Sets the title of the -.I XEmacs -window. -.TP -.B iconName (\fPclass\fB Title) -Sets the icon name for the -.I XEmacs -window icon. -.TP -.B scrollBarWidth (\fPclass\fB ScrollBarWidth) -Sets the width of the vertical scrollbars, in pixels. A width of 0 -means no vertical scrollbars. -.TP -.B scrollBarHeight (\fPclass\fB ScrollBarHeight) -Sets the height of the horizontal scrollbars, in pixels. A height of 0 -means no horizontal scrollbars. -.TP -.B scrollBarPlacement (\fPclass\fB ScrollBarPlacement) -Sets the position of vertical and horizontal scrollbars. Should be one -of the strings "top-left", "bottom-left", "top-right", or "bottom-right". -The default is "bottom-right" for the Motif and Lucid scrollbars and -"buttom-left" for the Athena scrollbars. -.TP -.B topToolBarHeight (\fPclass\fB TopToolBarHeight) -Sets the height of the top toolbar, in pixels. 0 means no top toolbar. -.TP -.B bottomToolBarHeight (\fPclass\fB BottomToolBarHeight) -Sets the height of the bottom toolbar, in pixels. 0 means no -bottom toolbar. -.TP -.B leftToolBarWidth (\fPclass\fB LeftToolBarWidth) -Sets the width of the left toolbar, in pixels. 0 means no left toolbar. -.TP -.B rightToolBarWidth (\fPclass\fB RightToolBarWidth) -Sets the width of the right toolbar, in pixels. 0 means no right toolbar. -.TP -.B topToolBarShadowColor (\fPclass\fB TopToolBarShadowColor) -Sets the color of the top shadows for the toolbars. (For all toolbars, -\fBnot\fR just the toolbar at the top of the frame.) -.TP -.B bottomToolBarShadowColor (\fPclass\fB BottomToolBarShadowColor) -Sets the color of the bottom shadows for the toolbars. (For all toolbars, -\fBnot\fR just the toolbar at the bottom of the frame.) -.TP -.B topToolBarShadowPixmap (\fPclass\fB TopToolBarShadowPixmap) -Sets the pixmap of the top shadows for the toolbars. (For all toolbars, -\fBnot\fR just the toolbar at the top of the frame.) If set, this -resource overrides the corresponding color resource. -.TP -.B bottomToolBarShadowPixmap (\fPclass\fB BottomToolBarShadowPixmap) -Sets the pixmap of the bottom shadows for the toolbars. (For all toolbars, -\fBnot\fR just the toolbar at the bottom of the frame.) If set, this -resource overrides the corresponding color resource. -.TP -.B toolBarShadowThickness (\fPclass\fB ToolBarShadowThickness) -Thickness of the shadows around the toolbars, in pixels. -.TP -.B visualBell (\fPclass\fB VisualBell) -Whether XEmacs should flash the screen rather than making an audible beep. -.TP -.B bellVolume (\fPclass\fB BellVolume) -Volume of the audible beep. Range is 0 through 100. -.TP -.B useBackingStore (\fPclass\fB UseBackingStore) -Whether -.I XEmacs -should set the backing-store attribute of the -.I X -windows it creates. This increases the memory usage of the -.I X -server but decreases the amount of -.I X -traffic necessary to update the screen, and is useful when the -connection to the -.I X -server goes over a low-bandwidth line such as a modem connection. -.TP -.B textPointer (\fPclass\fB Cursor) -The cursor to use when the mouse is over text. -.TP -.B selectionPointer (\fPclass\fB Cursor) -The cursor to use when the mouse is over a mouse-highlighted -text region. -.TP -.B spacePointer (\fPclass\fB Cursor) -The cursor to use when the mouse is over a blank space in a buffer (that -is, after the end of a line or after the end-of-file). -.TP -.B modeLinePointer (\fPclass\fB Cursor) -The cursor to use when the mouse is over a mode line. -.TP -.B gcPointer (\fPclass\fB Cursor) -The cursor to display when a garbage-collection is in progress. -.TP -.B scrollbarPointer (\fPclass\fB Cursor) -The cursor to use when the mouse is over the scrollbar. -.TP -.B pointerColor (\fPclass\fB Foreground) -The foreground color of the mouse cursor. -.TP -.B pointerBackground (\fPclass\fB Background) -The background color of the mouse cursor. -.PP -.SM Using the Mouse -.PP -The following lists the mouse button bindings for the -.I XEmacs -window under X11. - -.in +\w'CTRL-SHIFT-middle'u+4n -.ta \w'CTRL-SHIFT-middle'u+4n -.ti -\w'CTRL-SHIFT-middle'u+4n -MOUSE BUTTON FUNCTION -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -left Set point or make a text selection. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -middle Paste text. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -right Pop up a menu of options. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -SHIFT-left Extend a selection. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-left Make a selection and insert it at point. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-middle Set point and move selected text there. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -CTRL-SHIFT-left Make a selection, delete it, and insert it at point. -.br -.ti -\w'CTRL-SHIFT-middle'u+4n -META-left Make a rectangular selection. -.SH FILES -Lisp code is read at startup from the user's init file, -\fB$HOME/.emacs\fP. - -/usr/local/info - files for the Info documentation browser -(a subsystem of -.IR XEmacs ) -to refer to. The complete text of the -.I XEmacs Reference Manual -and the -.I XEmacs Lisp Programmer's Manual -is included in a convenient tree structured form. - -/usr/local/lib/xemacs-$VERSION/info - the Info files may be here instead. - -/usr/local/lib/xemacs-$VERSION/src - C source files and object files. -(May not be present.) - -/usr/local/lib/xemacs-$VERSION/lisp/* - Lisp source files and compiled files -that define most editing commands. The files are contained in subdirectories, -categorized by function or individual package. Some are preloaded; -others are autoloaded from these directories when used. - -/usr/local/lib/xemacs-$VERSION/etc - some files of information, pixmap -files, other data files used by certain packages, etc. - -/usr/local/lib/xemacs-$VERSION/$CONFIGURATION - various programs that are used -with XEmacs. - -/usr/local/lib/xemacs-$VERSION/$CONFIGURATION/DOC - -contains the documentation strings for the Lisp primitives and -preloaded Lisp functions of \fIXEmacs\fP. -They are stored here to reduce the size of \fIXEmacs\fP proper. - -.br -/usr/local/lib/xemacs-$VERSION/etc/SERVICE - lists people offering -various services to assist users of \fIXEmacs\fP, -including education, troubleshooting, porting and customization. - -/usr/local/lib/xemacs/lock - holds lock files that are made for all -files being modified in -.IR XEmacs , -to prevent simultaneous modification of one file by two users. - -/usr/local/lib/xemacs/site-lisp - locally-provided Lisp files. - -/usr/lib/X11/rgb.txt - list of valid X color names. -.PP -.SH BUGS AND HELP -There is a newsgroup, comp.emacs.xemacs, for reporting -.I XEmacs -bugs and fixes and requesting help. But before reporting something -as a bug, please try to be sure that it really is a bug, not a -misunderstanding or a deliberate feature. We ask you to read the section -``Reporting XEmacs Bugs'' near the end of the reference manual (or Info -system) for hints on how and when to report bugs. Also, include the version -number of the -.I XEmacs -you are running and the system you are running it on -in \fIevery\fR bug report that you send in. Finally, the more you can -isolate the cause of a bug and the conditions it happens under, the more -likely it is to be fixed, so please take the time to do so. - -The newsgroup is bidirectionally gatewayed to and from the mailing list -xemacs@xemacs.org. You can read the list instead of the newsgroup if -you do not have convenient Usenet news access. To request to be added -to the mailing list, send mail to xemacs-request@xemacs.org. (Do not -send mail to the list itself.) - -The -.I XEmacs -maintainers read the newsgroup regularly and will attempt to -fix bugs reported in a timely fashion. However, not every message will -get a response from one of the maintainers. Note that there are many -people other than the maintainers who read the newsgroup, and will usually -be of assistance in helping with any problems encountered. - -If you need more personal assistance than can be provided by the -newsgroup, look in the SERVICE file (see above) for a list of people -who offer it. - -For more information about XEmacs mailing lists, see the -file /usr/local/lib/xemacs-$VERSION/etc/MAILINGLISTS. -.SH UNRESTRICTIONS -.PP -.I XEmacs -is free; anyone may redistribute copies of -.I XEmacs -to -anyone under the terms stated in the -.I XEmacs -General Public License, -a copy of which accompanies each copy of -.I XEmacs -and which also -appears in the reference manual. -.PP -Copies of -.I XEmacs -may sometimes be received packaged with distributions of Unix systems, -but it is never included in the scope of any license covering those -systems. Such inclusion violates the terms on which distribution -is permitted. In fact, the primary purpose of the General Public -License is to prohibit anyone from attaching any other restrictions -to redistribution of -.IR XEmacs \. -.SH SEE ALSO -X(1), xlsfonts(1), xterm(1), xrdb(1), emacs(1), vi(1) -.SH AUTHORS -.PP -.I XEmacs -was written by -Steve Baur , -Martin Buchholz , -Richard Mlynarik , -Hrvoje Niksic , -Chuck Thompson , -Ben Wing , -Jamie Zawinski , -and many others. -It was based on an early version of -.I GNU Emacs Version -.IR 19 , -written by Richard Stallman of the Free Software -Foundation, and has tracked subsequent releases of -.I GNU Emacs -as they have become available. It was originally written by Lucid, Inc. -(now defunct) and was called -.I Lucid -.IR Emacs \. -.PP -Chuck Thompson wrote the -.I XEmacs -redisplay engine, maintains the -.I XEmacs -FTP and WWW sites, and has put out all releases of -.I XEmacs -since 19.11 (the first release called -.IR XEmacs ). -Ben Wing wrote the Asian-language support, the on-line documentation -(including this man page and much of the FAQ), the external widget code, -and retooled or rewrote most of the basic, low-level -.I XEmacs -subsystems. Jamie Zawinski put out all releases of -.I Lucid -.IR Emacs , -from the first (19.0) through the last (19.10), and was the primary -code contributor for all of these releases. Richard Mlynarik rewrote -the -.I XEmacs -Lisp-object allocation system, improved the keymap and minibuffer code, -and did the initial synching of -.I XEmacs -with -.I GNU Emacs Version -.IR 19 \. -.PP -Many others have also contributed significantly. For more detailed -information, including a long history of \fIXEmacs\fP from multiple -viewpoints and pretty pictures and bios of the major \fIXEmacs\fP -contributors, see the -.I XEmacs About Page -(the About XEmacs option on the Help menu). -.SH MORE INFORMATION -For more information about \fIXEmacs\fP, see the -.I XEmacs About Page -(mentioned above), -look in the file /usr/local/lib/xemacs-$VERSION/etc/NEWS, -or point your Web browser at -.PP -http://www.xemacs.org/ -.PP -for up-to-the-minute information about \fIXEmacs\fP. -.PP -The -.I XEmacs -FAQ (Frequently Asked Questions) can be found at the Web site just listed. -A possibly out-of-date version is also accessible through the Info system -inside of \fIXEmacs\fP. -.PP -The latest version of \fIXEmacs\fP can be downloaded using anonymous -FTP from -.PP -ftp://ftp.xemacs.org/pub/xemacs/ -.PP -or from a mirror site near you. Mirror sites are listed in the file -etc/FTP in the XEmacs distribution or see the Web site for an up-to-date -list of mirror sites. diff --git a/info/dir b/info/dir deleted file mode 100644 index 59cc3ed..0000000 --- a/info/dir +++ /dev/null @@ -1,60 +0,0 @@ --*- Text -*- - -This is the file .../info/dir, which contains the topmost node of the Info -hierarchy. The first time you invoke Info you start off looking at that node, -which is (dir)Top. - -Rather than adding new nodes to this directory (and this file) it is a better -idea to put them in a site-local directory, and then configure info to search -in that directory as well. That way, you won't have to re-edit this file when -a new release of the editor comes out. - -For example, you could add this code to .../lisp/site-start.el, which is -loaded before ~/.emacs each time the editor starts up: - - ;; find local info nodes - (setq Info-directory-list - (append Info-directory-list '("/private/info/"))) - -Then, when you enter info, a dir file like this one will be automatically -created and saved (provided you have write access to the directory). The -contents of that file "/private/info/dir" will be appended to the contents of -this file. - - -File: dir Node: Top This is the top of the INFO tree - - This is Info, the online documentation browsing system. - This page (the Directory node) gives a menu of major topics. - - button1 or button2 on a highlighted word follows that cross-reference. - button3 anywhere brings up a menu of commands. - ? lists additional keyboard commands. - h invokes the Info tutorial. - -* Menu: - -XEmacs 21.2 -=========== -* Info: (info). Documentation browsing system. -* XEmacs:: The extensible user-friendly self-documenting text editor. - This manual is for XEmacs 21.2 -* Lispref:: XEmacs Lisp technical reference. - This manual is for XEmacs 21.2. -* New-Users-Guide:: XEmacs New User's Guide for XEmacs 21.2. -* XEmacs-FAQ:: XEmacs Frequently Asked Questions for 21.2. -* Internals:: Guide to the internals of XEmacs. - - -Local Packages: - -* CL:: A Common Lisp compatibility package for Emacs-Lisp. -* Custom:: Customization Library for Emacs -* External-Widget:: Use XEmacs as a text widget inside of another program. -* Standards: (standards). GNU coding standards. -* Term:: A mode to control inferior processes (a comint replacement) -* Termcap:: The termcap library, which enables application programs - to handle all types of character-display terminals. -* Texinfo: (texinfo). The GNU documentation format. -* Widget:: An Emacs Lisp widget library - diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog deleted file mode 100644 index 581ff01..0000000 --- a/lib-src/ChangeLog +++ /dev/null @@ -1,658 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-17 SL Baur - - * update-elc.sh (ignore_dirs): Ignore lisp/mule subdirectory when - running latin-1 XEmacs. Eliminate 20.4 bundled kludges. - * update-custom.sh (ignore_dirs): Ditto. - -1999-02-15 Martin Buchholz - - * update-elc.sh: - * update-autoloads.sh: - * update-custom.sh: - - improved automounter tmp directory support. - - support 4 (!) empirically discovered automounter conventions - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-01-27 Martin Buchholz - - * movemail.c (strerror): Must be NON-static, since it is used by - the POP code, which got moved to a separate file. - -1999-01-11 Damon Lipparelli - - * Makefile.in.in: use ellcc (not ellc) everywhere - -1999-01-10 J. Kean Johnston - - * Makefile.in.in: Include moduledir and sitemoduledir as defined - by configure. - - Install ellcc if we're supporting shared objects - - Rules and dependancies for ellcc - - * ellcc.c: New file. Front end to the compiler for making modules. - - * ellcc.h.in: New file. Contains path definitions used by ellcc. - - * make-docfile.c (main): Add check for -E argument used by ellcc. - - * make-docfile.c: Changed output format when in -E mode. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-17 Andy Piper - - * pop.c (pop_open): disable use of getpass() which doesn't exist under NT. - - * movemail.c: mess with includes so that it builds under native NT. - - * pop.c: mess with includes so that it builds under native NT. - From Fabrice Popineau - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-10-14 Andy Piper - - * Makefile.in.in (movemail): add getopt.o to objects to link with. - - * movemail.c (main): rewrite to use getopt(). Add options for - order reversal, progress output, regexp matching and message - deletion. - (popmail): add some optional verbose messages. Use pop_search_top - for getting messages. Make message deletion optional. Delete all - messages at the end rather than on a message my message basis. - (pop_search_top): new function. Looks for messages matching regexp. - (compile_regex): new function stolen from etags. - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-10-12 SL Baur - - * lib-src/gnudepend.pl: Use /usr/bin/perl. - * Makefile.in.in (INSTALLABLE_SCRIPTS): Remove send-pr, install-sid. - (GEN_SCRIPTS): Ditto. - Delete TM_SCRIPTS. - -1998-10-11 SL Baur - - * tm-au: - * tm-file: - * tm-html: - * tm-image: - * tm-mpeg: - * tm-plain: - * tm-ps: - * tmdecode: packaged. - -1998-10-10 SL Baur - - * install-sid: - * send-pr: Packaged - -1998-10-01 Jan Vroonhof - - * gnuclient.c (filename_expand): Don't forget to copy the - filename under UNIX. - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-09-08 Raymond Toy - - * gnuclient.c (filename_expand): Added better recognition of - absolute pathnames for CYGWIN. Convert absolute pathnames with - drive letters to something xemacs can handle. - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-15 SL Baur - - * update-elc.sh (ignore_pattern): Add very-early-lisp.el as - something to never bytecompile. - -1998-07-12 SL Baur - - * XEmacs 21.0-pre5 is released. - -1998-07-09 SL Baur - - * XEmacs 21.0-pre4 is released. - -1998-06-16 Jan Vroonhof - - * gnuclient.c (main): Use disconnect_from_server to read & echo - result. - -1998-06-15 Andy Piper - - * Makefile.in.in: add xemacs icon to the runemacs executable. - -1998-06-12 Jim Radford - - * gnuclient.c (initialize_signals): Don't pass SIGHUP to XEmacs. - -1998-06-04 Andy Piper - - * Makefile.in.in (runemacs): add runemacs as a build target if - HAVE_MS_WINDOWS is defined. move cpp stuff up slightly so that - build targets can benefit from it. - -1998-05-31 Kirill M. Katsnelson - - * wakeup.c (sleep): Added NT preprocessor quirkfest. - (main): Exit when fflush() fails on stdout. - -1998-05-30 Kirill M. Katsnelson - - * getopt.c: Undefine getpid before redefinition. - - * make-docfile.c: Added when compiling on NT - - * movemail.c: Ditto. - (main): Declare some auto variables only when DISABLE_DIRECT_ACCESS - is undefined, so they are actually used, to supress compilation - warnings. - -1998-05-16 SL Baur - - * etags.c (C_entries): Avoid short circuiting comparisons on - characters that may appear in C++ operator constructs. - - * ootags.c (C_entries): Commentary change. - - * Makefile.in.in (PKG_SCRIPTS): Remove add-little-package.sh. - -1998-05-11 Martin Buchholz - - * Makefile.in.in: - - Adjust for luser's CDPATH being set to something weird. - - Take into account bash 2.02's tendency to print the cwd when - using CDPATH. Always use `cd ./foo' instead of `cd foo'. - - fix the run-temacs target to use $(DUMPENV) - - fix the run-puremacs target to use $(DUMPENV) - - fix the `depend' target to properly $(RM) the right files - - Generate a better TAGS file for XEmacs' lisp code using - hand-crafted regexps. - - Use standard coding conventions for modules/Makefile.in - -1998-05-07 Andy Piper - - * update-elc.sh: test x && y loses in the presence of set -e, use - if instead. - -1998-05-06 SL Baur - - * Makefile.in.in (INSTALLABLES): Add ootags. - (ootags): New rule. - - * ootags.c: New file. - (C_entries): Annotate changes neeeded for increased OO-Browser - context. - -1998-05-05 Jeff Miller - - * Makefile.in.in: Fix blessmail target. - -1998-05-05 SL Baur - - * Makefile.in.in (etags_args): Back out -DOO_BROWSER - - * etags.c: Revert to CVS version 1.11 (pre OO-browser additions). - -1998-05-04 SL Baur - - * etags.c (C_entries): Fix order typo. - (C_entries): Restore previous test. - -Wed Apr 22 12:59:35 1998 Andy Piper - - * installexe.sh: fix to use -f instead of -e file and fix shift - typo. - -1998-04-22 SL Baur - - * etags.c: Unconditionally define OO_BROWSER. - - * update-elc.sh: Tighten up regexp on uname -r output. - From Marcus Thiessel - -1998-04-19 Jan Vroonhof - - * gnuclient.c (main): Read eval from from stdin if just "-batch" - is given. - * gnudoit: Support this. - * gnuserv.1: Document this behavior. - -1998-04-18 Andreas Jaeger - - * etags.c (C_entries): Add parentheses. - - * etags-vmslib.c: Remove. It's not needed anymore. - -Fri Apr 17 12:59:35 1998 Andy Piper - - * installexe.sh: New file. - -1998-04-17 Olivier Galibert - - * etags.c (print_help): Correct typo. - -1998-04-16 SL Baur - - * Makefile.in.in: Add -DOO_BROWSER to etags arguments. - - * etags.c: Synch with InfoDock. - - * update-autoloads.sh: Don't attempt to eval `make-special' stuffs - anymore. They are no longer used. - * update-custom.sh: Always check in lisp/. - -1998-03-18 Jan Vroonhof - - * gnuclient.c (main): Do not copy string unnecessary in (too) - small buffers. - -1998-03-02 SL Baur - - * update-elc.sh: Change all -q -no-site-file to -vanilla - -1998-02-27 SL Baur - - * update-elc.sh (ignore_pattern): Add Installation.el, remove old - stuff from 20.4. - -Tue Feb 17 12:50:37 1998 Andy Piper - - * lib-src/Makefile.in.in: make sure clean removes msw executables - -1998-02-24 SL Baur - - * gnuserv.h: Enable USE_TMPDIR. - -1998-02-23 Glynn Clements - - * gnuclient.c (main): initialise variable `tmpdir' from the TMPDIR - environment variable. - - * gnuserv.c (various): replace hardcoded references to /tmp with - the value of `tmpdir'. - (main): initialise variable `tmpdir' from the TMPDIR - environment variable. - - * gnuserv.h: include (commented-out) definition of USE_TMPDIR. - Add `extern char *tmpdir'. - - * gnuslib.c (various): replace hardcoded references to /tmp with - the value of `tmpdir'. - -1998-02-15 SL Baur - - * getopt.c (_getopt_internal): Add braces for clarity. - -1998-01-13 Martin Buchholz - - * lib-src/add-little-package.sh: - * lib-src/add-big-package.sh: - Use proper paranoid quoting for sh variables. - -batch implies -q. - -Thu Jan 08 09:42:36 1998 - - * gnuserv.h: only set UNIX_DOMAIN_SOCKETS if HAVE_SYS_UN_H is - set. - - * gnuserv.c: tidy up so that it builds when we don't have - UNIX_DOMAIN_SOCKETS. - -1998-01-07 SL Baur - - * update-elc.sh (ignore_pattern): Replace -vanilla with `-q - -no-site-file'. - * update-autoloads.sh (dirs): Ditto. - * update-custom.sh (dirs): Ditto. - -1997-12-18 SL Baur - - * update-elc.sh (mule_p): Remove skk's special treatment. - -1997-12-09 SL Baur - - * update-elc.sh (ignore_pattern): Correct paths of files that - should not be bytecompiled, and remove dead files. - -1997-12-02 SL Baur - - * update-elc.sh (mule_p): Update for addition of SKK. - - * update-autoloads.sh (mule_p): Update ignore_dirs for - lisp/language and lisp/skk. - * update-custom.sh (mule_p): Ditto. - -1997-11-29 Jeff Miller - - * Makefile.in.in: Changed path to blessmail.el for blessmail target - to match new lisp directory layout. - -1997-11-27 SL Baur - - * update-elc.sh: Obliterate usage of make_special, since nothing - requires it any more. - -1997-11-23 SL Baur - - * update-elc.sh (BYTECOMP): cleantree.el has been moved. - -1997-11-18 Colin Rafferty - - * update-elc.sh (prune_vc): Made it ignore any directory that - starts with a period. - -1997-11-16 SL Baur - - * gnuserv.c (main): make return type int. - Suggested by Andreas Jaeger - - * fakemail.c (main): Ditto. - -1997-11-13 SL Baur - - * pop.c: Add includes from movemail.c so standard functions get - declared. - (pop_retrieve): Return NULL if falling off the end of the - function. - - * movemail.c: Hide declarations of popmail(), mbx_write(), - mbc_delimit_begin(), and mbx_delimit_end() behind MAIL_USE_POP - guard. - (pop_retr): Change 4th parameter to void *. - -1997-11-02 SL Baur - - * update-custom.sh (dirs): Remove packaged directories. - - * update-elc.sh (ignore_pattern): Hyperbole, oobr and ilisp are - now packaged. - - * update-autoloads.sh (mule_p): Hyperbole and oobr are now - packaged. - -1997-10-30 SL Baur - - * update-autoloads.sh (mule_p): EFS has been packaged. - * update-elc.sh (make_special_commands): Ditto. - - * update-elc.sh: VM has been packaged. - - * update-autoloads.sh: Add directory language - -1997-10-23 SL Baur - - * update-elc.sh (BYTECOMP): Specify -vanilla - * update-autoloads.sh (dirs): Ditto. - * update-custom.sh (dirs): Ditto. - -1997-10-10 Martin Buchholz - - * config.values.in: Run config.values.sh - -1997-10-09 SL Baur - - * Makefile.in.in (PKG_SCRIPTS): Add new package manipulation - scripts. - - * add-little-package.sh: New file. Support script to install - single file packages. - - * Makefile.in.in (distclean): Reverse change -- do not remove - config.values.in. - Suggested by: Martin Buchholz - -1997-10-06 SL Baur - - * Makefile.in.in (distclean): Remove config.values.in. - From Martin Buchholz - -1997-10-04 SL Baur - - * update-autoloads.sh (mule_p): W3 is a package now. - -1997-09-30 SL Baur - - * update-elc.sh (ignore_pattern): Don't attempt bytecompiling - lisp/leim/quail/tibetan.el and lisp/language/tibet-util.el. - -1997-09-29 SL Baur - - * update-elc.sh (mule_p): Ignore mu/latex-math-symbol.el if we're - not building with Mule. - -1997-09-27 Hrvoje Niksic - - * update-custom.sh: New file. - - * update-autoloads.sh: Minor fixes. - -1997-08-11 Jeff Miller - * Makefile.in.in: Added a test for system-type equal to linux to - lisp/paths.el. Mail spool dir should be /var/spool/mail. - - * cleaned up lib-src/Makefile.in.in regarding targets blessmail and - maybe-blessmail. Added target do-blessmail. Makefile.in.in was also - missing a variable called "configuration. This messed up archilibdir. - - * Added highlighting to text suggesting to do "make gzip-el" in top - level Makefile.in. Added code to do make maybe-blessmail after a - make install is done. - -1997-08-07 Jan Vroonhof - - * gnuclient.c (main): Made help string correspond to options. - -1997-08-01 SL Baur - - * Makefile.in.in (distclean): Remove config.values here only. - -1997-07-27 SL Baur - - * Makefile.in.in (UTILITIES): Add config.values so it can be - cleared away by `make distclean'. - -1997-07-21 SL Baur - - * update-elc.sh (make_special_commands): Remove processing for - Gnus and AUCTeX. - -1997-07-19 SL Baur - - * update-elc.sh (mule_p): Do not attempt to bytecompile - char-table.el and chartblxmas.el. - -1997-07-08 Steven L Baur - - * update-elc.sh (cc-mode): Don't give cc-mode special treatment. - - * update-autoloads.sh (cc-mode): Don't give cc-mode special - treatment. - - * rcs2log: Synch with Emacs/Mule zeta. - -1997-07-03 Steven L Baur - - * update-elc.sh (make_special_commands): Fix building of ilisp so - custom-load.elc gets built. - -1997-06-27 Steven L Baur - - * update-autoloads.sh: Major rework. Avoid looking at MULE - directories if not running XEmacs/Mule. - - Look into all Mule directories for building autoloads. - - * update-elc.sh (make_special_commands): Fix handling of - bytecompilation of AUCTeX to avoid looking at tex-jp.el if not - running MULE. - -1997-06-24 Steven L Baur - - * gnuattach: Needed executable bit set. - Suggested by Kyle Jones - - * update-elc.sh (ignore_pattern): lisp/language/ethiopic byte - compiles now. - -1997-06-24 MORIOKA Tomohiko - - * update-autoloads.sh: Search lisp/mule/. - -1997-06-20 Steven L Baur - - * gnuattach: Readd as warning script. - - * Makefile.in.in (INSTALLABLE_SCRIPTS): Readd Gnuattach. - From Hrvoje Niksic - -1997-06-13 Steven L Baur - - * update-elc.sh (mule_p): Ignore lisp/language when building - non-Mule. - (ignore_pattern): Ignore Languages we don't support yet. - -1997-06-02 Steven L Baur - - * update-elc.sh (ignore_dirs): Handle ported Quail (LEIM). - -Tue May 20 23:22:00 1997 Steven L Baur - - * update-autoloads.sh (dirs): Remove obsolete directory lisp/vms - from exclusion list (it doesn't exist any more). Remove - lisp/eterm from exclusion list of directories searched for - autoloads. - -Thu May 1 15:26:20 1997 Steven L Baur - - * update-elc.sh (mule_p): Test for mule bombs with change in format - of new output of featurep. - -Fri Apr 25 09:12:04 1997 Steven L Baur - - * pstogif: Use Martin Buchholz magic to automagically find perl - interpreter. - -Tue Apr 8 03:08:22 1997 Steven L Baur - - * Makefile.in.in: C Comment out Make comments. No snide comments - from me, no sir. - -Tue Apr 1 12:26:53 1997 Steven L Baur - - * Makefile.in.in: Added stuff for updated movemail.c. - -Sat Mar 29 16:57:01 1997 Steven L Baur - - * send-pr (GNATS_ADDR): Use xemacs.org as submission address. - (DATADIR): Allow for DATADIR to be passed in as an environment - variable. - -Sun Mar 23 15:57:19 1997 Steven L Baur - - * update-elc.sh (make_special_commands): Use target of x20 for efs. - -Wed Mar 19 10:38:04 1997 Steven L Baur - - * Makefile.in.in (SCRIPTS): Link gzip-el.sh in --srcdir - configuration. - -Tue Mar 18 17:49:14 1997 Steven L Baur - - * update-elc.sh (EMACS): Removed $XEMACS backdoor. We will make - the .elcs *only* with the freshly built XEmacs. - -Mon Mar 17 10:12:03 1997 Steven L Baur - - * Makefile.in.in (INSTALLABLE_SCRIPTS): Add install-sid and - send-pr (from GNATS). - - * update-elc.sh (prune_vc): Use full path to cleantree.el. - (NUMTOCOMPILE): Remove useless rule to recompile out-of-date .elcs. - -Sun Mar 16 21:13:29 1997 Steven L Baur - - * install-sid: New file (GNATS integration). - - * send-pr: New file (GNATS integration). - -Fri Mar 14 17:59:57 1997 Steven L Baur - - * update-elc.sh (ignore_dirs): Build VM with `make autoload'. - -Wed Mar 5 18:07:57 1997 Steven L Baur - - * gzip-el.sh: New file. Courtesy of Jeff Miller and Hrvoje Niksic. - - * update-elc.sh (els): Remove out of date .elcs before building. - -Tue Mar 4 18:45:10 1997 Martin Buchholz - - * update-elc.sh (els): No more special treatment for vm.elc. - -Wed Feb 26 18:17:59 1997 Steven L Baur - - * make-docfile.c (next_extra_elc): New function. - (main): Use it. Implementation of `-i' parameter to pass a list - of site-loaded lisp files. - -Wed Feb 19 18:24:49 1997 Steven L Baur - - * update-elc.sh: Added lisp/auctex. - -Thu Feb 13 11:32:47 1997 Steven L Baur - - * Makefile.in.in: Install pstogif script. - -Sun Dec 29 17:16:45 1996 Martin Buchholz - - * update-elc.sh (make_special_commands): Make ilisp be a little - smarter about recompilation. - -Wed Dec 18 20:22:55 1996 Martin Buchholz - - * mmencode.c: Don't declare index(). - - * Makefile.in.in: Documentation changes. - - * update-elc.sh: Portability Fix. - -Thu Dec 5 15:41:53 1996 Martin Buchholz - - * update-elc.sh: Corrections to protect against too smart /bin/sh'es. - diff --git a/lib-src/Makefile.in.in b/lib-src/Makefile.in.in deleted file mode 100644 index 1e62172..0000000 --- a/lib-src/Makefile.in.in +++ /dev/null @@ -1,390 +0,0 @@ -## Makefile for lib-src subdirectory in XEmacs. -## Copyright (C) 1985, 1987, 1988, 1993, 1994 Free Software Foundation, Inc. -## Copyright (C) 1996, 1997 Sun Microsystems, 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. - -## Note: FSF Makefile.in.in does something weird so that the comments -## above a certain point in this file are in shell format instead of -## in C format. How the hell is this supposed to work? */ - -## For performance and consistency, no built-in rules -.SUFFIXES: -.SUFFIXES: .c .h .o -## ==================== Things "configure" will edit ==================== - -@SET_MAKE@ -SHELL = /bin/sh -RM = rm -f -pwd = /bin/pwd - -CC=@CC@ -CPP=@CPP@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ -LDFLAGS=@LDFLAGS@ -ALLOCA=@ALLOCA@ -LN_S=@LN_S@ -version=@version@ - -## This will be the name of the generated binary and is set automatically -## by configure. -PROGNAME=@PROGNAME@ - -## ==================== Where To Install Things ==================== - -prefix=@prefix@ -exec_prefix=@exec_prefix@ -bindir=@bindir@ -libdir=@libdir@ -srcdir=@srcdir@ -archlibdir=@archlibdir@ -configuration=@configuration@ -moduledir=@moduledir@ -sitemoduledir=@sitemoduledir@ - -## ==================== Utility Programs for the Build ================= - -INSTALL = @install_pp@ @INSTALL@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_DATA = @INSTALL_DATA@ - -## ========================== Lists of Files =========================== - -#define NO_SHORTNAMES -#define NOT_C_CODE -#include "../src/config.h" - -## Things that a user might actually run, -## which should be installed in bindir. -INSTALLABLES_BASE = etags ctags b2m gnuclient ootags -INSTALLABLE_SCRIPTS = rcs-checkin pstogif gnudoit gnuattach -#ifdef HAVE_SHLIB -#ifdef HAVE_MS_WINDOWS -INSTALLABLES = $(INSTALLABLES_BASE) runxemacs rungnuclient ellcc -#else -INSTALLABLES = $(INSTALLABLES_BASE) ellcc -#endif -#else -#ifdef HAVE_MS_WINDOWS -INSTALLABLES = $(INSTALLABLES_BASE) runxemacs rungnuclient -#else -INSTALLABLES = $(INSTALLABLES_BASE) -#endif -#endif - - -## Things that Emacs runs internally, or during the build process, -## which should not be installed in bindir. -UTILITIES= make-path wakeup profile make-docfile digest-doc \ - sorted-doc movemail cvtmail fakemail yow hexl \ - gnuserv mmencode -## These need to be conditional on I18N3 make-msgfile make-po - -## Like UTILITIES, but they are not system-dependent, and should not be -## deleted by the distclean target. -GEN_SCRIPTS = rcs2log vcdiff gzip-el.sh -PKG_SCRIPTS = add-big-package.sh -SCRIPTS = $(GEN_SCRIPTS) $(PKG_SCRIPTS) - -EXECUTABLES= ${UTILITIES} ${INSTALLABLES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} - -SOURCES = COPYING ChangeLog Makefile.in.in README aixcc.lex emacs.csh \ - makedoc.com *.[chy] $(SCRIPTS) -## Additional -D flags for movemail (add to MOVE_FLAGS if desired): -## MAIL_USE_POP Support mail retrieval from a POP mailbox. -## MAIL_USE_MMDF Support MMDF mailboxes. -## MAIL_USE_FLOCK Use flock for file locking (see the comments -## about locking in movemail.c) -## MAIL_UNLINK_SPOOL Unlink the user spool mailbox after reading -## it (instead of just emptying it). -## KERBEROS Support Kerberized POP. -## KRB5 Support Kerberos Version 5 pop instead of -## Version 4 (define this in addition to -## KERBEROS). -## HESIOD Support Hesiod lookups of user mailboxes. -## MAILHOST A string, the host name of the default POP -## mail host for the site. - -MOVE_FLAGS= -## -## Additional libraries for movemail: -## For KERBEROS -## MOVE_LIBS= -lkrb -ldes -lcom_err -## For KERBEROS + KRB5 -## MOVE_LIBS= -lkrb5 -lcrypto -lisode -lcom_err -## Add "-lhesiod" if HESIOD is defined. - -MOVE_LIBS= - -## ========================== start of cpp stuff ======================= - -#ifdef USE_GNU_MAKE -vpath %.c @srcdir@ -vpath %.h @srcdir@ -#else -VPATH=@srcdir@ -#endif - -c_switch_general=@c_switch_general@ -c_switch_all=@c_switch_all@ -ld_switch_general=@ld_switch_general@ -ld_switch_all=@ld_switch_all@ -ld_libs_general=@ld_libs_general@ - -## We need to #define emacs to get the right versions of some files. - -cppflags = -Demacs -I../src $(CPPFLAGS) -cflags = $(CFLAGS) $(cppflags) $(c_switch_general) -ldflags = $(LDFLAGS) $(ld_switch_general) $(ld_libs_general) - -## This is the default compilation command. -## But we should never rely on it, because some make version -## failed to find it for getopt.o. -## Using an explicit command made it work. -.c.o: - ${CC} -c $(cflags) $< - -all: ${UTILITIES} ${INSTALLABLES} srcdir-symlink.stamp - -## Make symlinks for shell scripts if using --srcdir -srcdir-symlink.stamp: - for f in ${SCRIPTS}; do \ - if test ! -r $$f; then ${LN_S} ${srcdir}/$$f $$f; fi; \ - done; \ - touch $@; - -#undef MOVEMAIL_NEEDS_BLESSING -#if !defined (MAIL_USE_FLOCK) && ! defined (MAIL_USE_LOCKF) -#define MOVEMAIL_NEEDS_BLESSING -blessmail = blessmail -blessmail: - ../src/xemacs -batch -l ../lisp/blessmail.el - chmod +x $@ -#endif /* movemail needs blessing */ - -maybe-blessmail: $(blessmail) -#ifdef MOVEMAIL_NEEDS_BLESSING -## Do not charge ahead and do it! Let the installer decide. -## ./blessmail ${archlibdir}/movemail - @if test `wc -l -# Maintainer: SL Baur -# Keywords: packages 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. - -### Commentary: - -## This file copies a single lisp file into an XEmacs package hierarchy and -## performs the necessary magic so that it will be autoloaded at the next -## dump. - -## Parameters: -## $1 -- Full path to an XEmacsen later than 20.3 -## $2 -- Full path to a lisp package tarball to install -## $3 -- Full path to a lisp directory in an XEmacs package hierarchy -## This directory will be created if it does not exist. -## NOTE: the directory name should *not* end in a trailing slash - - -### Code: - -XEMACS="$1" # Not used at present -LISP_FILE="$2" # Should be a binary package tarball -DEST_DIR="$3" # Should be a top level package directory - -# Test for valid XEmacs executable and valid input file -if [ ! -f "${LISP_FILE}" -o ! -x "${XEMACS}" ]; then - exit 1 -fi - -# Test for destination directory, creating if necessary -test -d "${DEST_DIR}" || mkdir "${DEST_DIR}" -test -d "${DEST_DIR}" || exit 1; - -# Very simple minded extraction for the first cut -# We'll get more sophisticated later -cd "${DEST_DIR}" -gunzip -c "${LISP_FILE}" | tar xvf - - -# Need to refresh the info/dir file, I don't know how to do that. - -exit 0 - -### add-big-package.sh ends here diff --git a/lib-src/b2m.c b/lib-src/b2m.c deleted file mode 100644 index dda077d..0000000 --- a/lib-src/b2m.c +++ /dev/null @@ -1,263 +0,0 @@ -/* - * b2m - a filter for Babyl -> Unix mail files - * - * usage: b2m < babyl > mailbox - * - * I find this useful whenever I have to use a - * system which - shock horror! - doesn't run - * Gnu emacs. At least now I can read all my - * Gnumacs Babyl format mail files! - * - * it's not much but it's free! - * - * Ed Wilkinson - * E.Wilkinson@massey.ac.nz - * Mon Nov 7 15:54:06 PDT 1988 - */ - -/* Made conformant to the GNU coding standards January, 1995 - by Francesco Potorti` . */ - -#ifdef HAVE_CONFIG_H -#include <../src/config.h> -/* On some systems, Emacs defines static as nothing for the sake - of unexec. We don't want that here since we don't use unexec. */ -#undef static -#endif - -#include -#include -#include -#include -#include -#ifdef MSDOS -#include -#endif - -#undef TRUE -#define TRUE 1 -#undef FALSE -#define FALSE 0 - -/* Exit codes for success and failure. */ -#ifdef VMS -#define GOOD 1 -#define BAD 0 -#else -#define GOOD 0 -#define BAD 1 -#endif - -#define streq(s,t) (strcmp (s, t) == 0) -#define strneq(s,t,n) (strncmp (s, t, n) == 0) - -typedef int logical; - -/* - * A `struct linebuffer' is a structure which holds a line of text. - * `readline' reads a line from a stream into a linebuffer and works - * regardless of the length of the line. - */ -struct linebuffer -{ - long size; - char *buffer; -}; - - -static long *xmalloc (unsigned int); -static long *xrealloc (void *, unsigned int); -static char *concat (char *s1, char *s2, char *s3); -static long readline (struct linebuffer *, FILE *); -static void fatal (char *); - -/* - * xnew -- allocate storage. SYNOPSIS: Type *xnew (int n, Type); - */ -#define xnew(n, Type) ((Type *) xmalloc ((n) * sizeof (Type))) - - - -char *progname; - -int -main (int argc, char *argv[]) -{ - logical labels_saved, printing, header; - time_t ltoday; - char *labels = NULL, *p, *today; - struct linebuffer data; - -#ifdef MSDOS - _fmode = O_BINARY; /* all of files are treated as binary files */ -#if __DJGPP__ > 1 - if (!isatty (fileno (stdout))) - setmode (fileno (stdout), O_BINARY); - if (!isatty (fileno (stdin))) - setmode (fileno (stdin), O_BINARY); -#else /* not __DJGPP__ > 1 */ - (stdout)->_flag &= ~_IOTEXT; - (stdin)->_flag &= ~_IOTEXT; -#endif /* not __DJGPP__ > 1 */ -#endif - progname = argv[0]; - - if (argc != 1) - { - fprintf (stderr, "Usage: %s unixmailbox\n", progname); - exit (GOOD); - } - labels_saved = printing = header = FALSE; - ltoday = time (0); - today = ctime (<oday); - data.size = 200; - data.buffer = xnew (200, char); - - if (readline (&data, stdin) == 0 - || !strneq (data.buffer, "BABYL OPTIONS:", 14)) - fatal ("standard input is not a Babyl mailfile."); - - while (readline (&data, stdin) > 0) - { - if (streq (data.buffer, "*** EOOH ***") && !printing) - { - printing = header = TRUE; - printf ("From \"Babyl to mail by %s\" %s", progname, today); - continue; - } - - if (data.buffer[0] == '\037') - { - if (data.buffer[1] == '\0') - continue; - else if (data.buffer[1] == '\f') - { - /* Save labels. */ - readline (&data, stdin); - p = strtok (data.buffer, " ,\r\n\t"); - labels = "X-Babyl-Labels: "; - - while ((p = strtok (NULL, " ,\r\n\t"))) - labels = concat (labels, p, ", "); - - p = &labels[strlen (labels) - 2]; - if (*p == ',') - *p = '\0'; - printing = header = FALSE; - labels_saved = TRUE; - continue; - } - } - - if ((data.buffer[0] == '\0') && header) - { - header = FALSE; - if (labels_saved) - puts (labels); - } - - if (printing) - puts (data.buffer); - } - return 0; -} - - - -/* - * Return a newly-allocated string whose contents - * concatenate those of s1, s2, s3. - */ -static char * -concat (char *s1, char *s2, char *s3) -{ - int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = xnew (len1 + len2 + len3 + 1, char); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - result[len1 + len2 + len3] = '\0'; - - return result; -} - -/* - * Read a line of text from `stream' into `linebuffer'. - * Return the number of characters read from `stream', - * which is the length of the line including the newline, if any. - */ -static long -readline (struct linebuffer *linebuffer, FILE *stream) -{ - char *buffer = linebuffer->buffer; - register char *p = linebuffer->buffer; - register char *pend; - int chars_deleted; - - pend = p + linebuffer->size; /* Separate to avoid 386/IX compiler bug. */ - - while (1) - { - register int c = getc (stream); - if (p == pend) - { - linebuffer->size *= 2; - buffer = (char *) xrealloc (buffer, linebuffer->size); - p += buffer - linebuffer->buffer; - pend = buffer + linebuffer->size; - linebuffer->buffer = buffer; - } - if (c == EOF) - { - chars_deleted = 0; - break; - } - if (c == '\n') - { - if (p[-1] == '\r' && p > buffer) - { - *--p = '\0'; - chars_deleted = 2; - } - else - { - *p = '\0'; - chars_deleted = 1; - } - break; - } - *p++ = c; - } - - return (p - buffer + chars_deleted); -} - -/* - * Like malloc but get fatal error if memory is exhausted. - */ -static long * -xmalloc (unsigned int size) -{ - long *result = (long *) malloc (size); - if (result == NULL) - fatal ("virtual memory exhausted"); - return result; -} - -static long * -xrealloc (void *ptr, unsigned int size) -{ - long *result = (long *) realloc (ptr, size); - if (result == NULL) - fatal ("virtual memory exhausted"); - return result; -} - -static void -fatal (char *message) -{ - fprintf (stderr, "%s: %s\n", progname, message); - exit (BAD); -} - diff --git a/lib-src/config.values.in b/lib-src/config.values.in deleted file mode 100644 index a816455..0000000 --- a/lib-src/config.values.in +++ /dev/null @@ -1,136 +0,0 @@ -;;; Do not edit this file! -;;; This file was automatically generated, by the config.values.sh script, -;;; from configure, which was itself automatically generated from configure.in -;;; -;;; See lisp/util/config.el for details on how this file is used. -;;; -;;; You are trapped in a twisty maze of strange-looking files, all autogenerated... - -;;; configure is created, from configure.in, by autoconf -;;; config.values.in is created, from configure, by config.values.sh -;;; config.values is created, from config.values.in, by configure -;;; config.values is read by lisp/utils/config.el, -;;; to create the (Lisp object) config-value-hash-table - -;;; Variables defined in configure by AC_SUBST follow: -;;; (These are used in Makefiles) - -ALLOCA "@ALLOCA@" -ARCHLIBDIR "@ARCHLIBDIR@" -ARCHLIBDIR_USER_DEFINED "@ARCHLIBDIR_USER_DEFINED@" -CC "@CC@" -CFLAGS "@CFLAGS@" -CPP "@CPP@" -CPPFLAGS "@CPPFLAGS@" -CXXFLAGS "@CXXFLAGS@" -DEFS "@DEFS@" -ETCDIR "@ETCDIR@" -ETCDIR_USER_DEFINED "@ETCDIR_USER_DEFINED@" -EXEC_PREFIX "@EXEC_PREFIX@" -INFODIR "@INFODIR@" -INFODIR_USER_DEFINED "@INFODIR_USER_DEFINED@" -INFOPATH "@INFOPATH@" -INFOPATH_USER_DEFINED "@INFOPATH_USER_DEFINED@" -INSTALL "@INSTALL@" -INSTALL_ARCH_DEP_SUBDIR "@INSTALL_ARCH_DEP_SUBDIR@" -INSTALL_DATA "@INSTALL_DATA@" -INSTALL_PROGRAM "@INSTALL_PROGRAM@" -LDFLAGS "@LDFLAGS@" -LIBS "@LIBS@" -LISPDIR "@LISPDIR@" -LISPDIR_USER_DEFINED "@LISPDIR_USER_DEFINED@" -LN_S "@LN_S@" -LOCKDIR "@LOCKDIR@" -LOCKDIR_USER_DEFINED "@LOCKDIR_USER_DEFINED@" -MAKE_SUBDIR "@MAKE_SUBDIR@" -MODULEDIR "@MODULEDIR@" -MODULEDIR_USER_DEFINED "@MODULEDIR_USER_DEFINED@" -PACKAGE_PATH "@PACKAGE_PATH@" -PACKAGE_PATH_USER_DEFINED "@PACKAGE_PATH_USER_DEFINED@" -PREFIX "@PREFIX@" -PROGNAME "@PROGNAME@" -RANLIB "@RANLIB@" -RECURSIVE_MAKE "@RECURSIVE_MAKE@" -SET_MAKE "@SET_MAKE@" -SITELISPDIR "@SITELISPDIR@" -SITELISPDIR_USER_DEFINED "@SITELISPDIR_USER_DEFINED@" -SITEMODULEDIR "@SITEMODULEDIR@" -SITEMODULEDIR_USER_DEFINED "@SITEMODULEDIR_USER_DEFINED@" -SRC_SUBDIR_DEPS "@SRC_SUBDIR_DEPS@" -SUBDIR_MAKEFILES "@SUBDIR_MAKEFILES@" -XEMACS_CC "@XEMACS_CC@" -X_CFLAGS "@X_CFLAGS@" -X_EXTRA_LIBS "@X_EXTRA_LIBS@" -X_LIBS "@X_LIBS@" -X_PRE_LIBS "@X_PRE_LIBS@" -YACC "@YACC@" -archlibdir "@archlibdir@" -bindir "@bindir@" -bitmapdir "@bitmapdir@" -blddir "@blddir@" -c_switch_all "@c_switch_all@" -c_switch_general "@c_switch_general@" -c_switch_window_system "@c_switch_window_system@" -canonical "@canonical@" -configuration "@configuration@" -configure_input "@configure_input@" -datadir "@datadir@" -dll_cflags "@dll_cflags@" -dll_ld "@dll_ld@" -dll_ldflags "@dll_ldflags@" -dll_ldo "@dll_ldo@" -dll_post "@dll_post@" -dnd_objs "@dnd_objs@" -docdir "@docdir@" -dynodump_arch "@dynodump_arch@" -etcdir "@etcdir@" -exec_prefix "@exec_prefix@" -extra_objs "@extra_objs@" -includedir "@includedir@" -infodir "@infodir@" -infopath "@infopath@" -install_pp "@install_pp@" -internal_makefile_list "@internal_makefile_list@" -ld "@ld@" -ld_dynamic_link_flags "@ld_dynamic_link_flags@" -ld_libs_all "@ld_libs_all@" -ld_libs_general "@ld_libs_general@" -ld_libs_window_system "@ld_libs_window_system@" -ld_switch_all "@ld_switch_all@" -ld_switch_general "@ld_switch_general@" -ld_switch_shared "@ld_switch_shared@" -ld_switch_window_system "@ld_switch_window_system@" -lib_gcc "@lib_gcc@" -libdir "@libdir@" -libexecdir "@libexecdir@" -libs_xauth "@libs_xauth@" -lispdir "@lispdir@" -localstatedir "@localstatedir@" -lockdir "@lockdir@" -lwlib_objs "@lwlib_objs@" -machfile "@machfile@" -mandir "@mandir@" -moduledir "@moduledir@" -native_sound_lib "@native_sound_lib@" -oldincludedir "@oldincludedir@" -opsysfile "@opsysfile@" -package_path "@package_path@" -pkgdir "@pkgdir@" -prefix "@prefix@" -program_transform_name "@program_transform_name@" -sbindir "@sbindir@" -sharedstatedir "@sharedstatedir@" -sitelispdir "@sitelispdir@" -sitemoduledir "@sitemoduledir@" -sound_cflags "@sound_cflags@" -srcdir "@srcdir@" -start_files "@start_files@" -start_flags "@start_flags@" -statedir "@statedir@" -sysconfdir "@sysconfdir@" -top_srcdir "@top_srcdir@" -version "@version@" - -;;; Variables defined in configure by AC_DEFINE and AC_DEFINE_UNQUOTED follow: -;;; (These are used in C code) - diff --git a/lib-src/config.values.sh b/lib-src/config.values.sh deleted file mode 100644 index d755d0c..0000000 --- a/lib-src/config.values.sh +++ /dev/null @@ -1,76 +0,0 @@ -#! /bin/sh -# config.values.sh --- create config.values.in from ../configure - -# Author: Martin Buchholz -# Maintainer: Martin Buchholz -# Keywords: configure elisp report-xemacs-bugs - -# 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: - -## Extract all the @foo@ configuration symbols from ../configure -## to make them available to elisp later (see util/config.el) -## Primarily useful for creating ridiculously verbose bug reports. -## -## See lisp/utils/config.el, ../configure.in, -## and the Autoconf documentation on AC_OUTPUT, for more details. -## -## This script needs only to be run occasionally (before a Net release) -## by an XEmacs Maintainer (consider yourself so blessed, if you are -## actually reading this commentary). -## -if test ! -r ./configure; then - cd .. - if test ! -r ./configure; then - echo "Can't find configure!"; - exit 1; - fi -fi - -exec < ./configure > "lib-src/config.values.in" -cat <<\EOF -;;; Do not edit this file! -;;; This file was automatically generated, by the config.values.sh script, -;;; from configure, which was itself automatically generated from configure.in -;;; -;;; See lisp/util/config.el for details on how this file is used. -;;; -;;; You are trapped in a twisty maze of strange-looking files, all autogenerated... - -;;; configure is created, from configure.in, by autoconf -;;; config.values.in is created, from configure, by config.values.sh -;;; config.values is created, from config.values.in, by configure -;;; config.values is read by lisp/utils/config.el, -;;; to create the (Lisp object) config-value-hash-table - -;;; Variables defined in configure by AC_SUBST follow: -;;; (These are used in Makefiles) - -EOF -sed -n '/^s%@\([A-Za-z_][A-Za-z_]*\)@%\$\1%g$/ { - s/^s%@\([A-Za-z_][A-Za-z_]*\)@%\$\1%g$/\1 "@\1@"/ - p -}' | \ -sort -u -cat <<\EOF - -;;; Variables defined in configure by AC_DEFINE and AC_DEFINE_UNQUOTED follow: -;;; (These are used in C code) - -EOF diff --git a/lib-src/cvtmail.c b/lib-src/cvtmail.c deleted file mode 100644 index 962ec3a..0000000 --- a/lib-src/cvtmail.c +++ /dev/null @@ -1,165 +0,0 @@ -/* Copyright (C) 1985, 1993, 1994 Free Software Foundation -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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.28. */ - -/* cvtmail: - * Program to convert oldstyle goslings emacs mail directories into - * gnu-rmail format. Program expects a directory called Messages to - * exist in your home directory, containing individual mail messages in - * separate files in the standard gosling emacs mail reader format. - * - * Program takes one argument: an output file. THis file will contain - * all the messages in Messages directory, in berkeley mail format. - * If no output file is mentioned, messages are put in ~/OMAIL. - * - * In order to get rmail to read the messages, the resulting file must - * be mv'ed to ~/mbox, and then have rmail invoked on them. - * - * Author: Larry Kolodney, 1985 - */ - - -#include <../src/config.h> - -#include -#include - -#if __STDC__ || defined(STDC_HEADERS) -# include -#else -char *malloc (); -char *getenv (); -#endif -static void *xmalloc (unsigned int); -static void *xrealloc (char *ptr, unsigned int); -static void skip_to_lf (FILE *stream); -static void fatal (CONST char *s1, CONST char *s2); -static void error (CONST char *s1, CONST char *s2); - -int -main (argc, argv) - int argc; - char *argv[]; -{ - char *hd; - char *md; - char *mdd; - char *mfile; - char *cf; - int cflen; - FILE *mddf; - FILE *mfilef; - FILE *cff; - char pre[10]; - char name[14]; - int c; - - hd = (char *) getenv ("HOME"); - - md = (char *) xmalloc (strlen (hd) + 10); - strcpy (md, hd); - strcat (md, "/Messages"); - - mdd = (char *) xmalloc (strlen (md) + 11); - strcpy (mdd, md); - strcat (mdd, "/Directory"); - - cflen = 100; - cf = (char *) xmalloc (cflen); - - mddf = fopen (mdd, "r"); - if (argc > 1) - mfilef = fopen (argv[1], "w"); - else - { - mfile = (char *) xmalloc (strlen (hd) + 7); - strcpy (mfile, hd); - strcat (mfile, "/OMAIL"); - mfilef = fopen (mfile, "w"); - } - skip_to_lf (mddf); - while (fscanf (mddf, "%4c%14[0123456789]", pre, name) != EOF) - { - int comp_len = strlen (md) + strlen (name) + 2; - if (cflen < comp_len) - { - cflen = strlen (md) + strlen (name) + 2; - cf = (char *) xrealloc (cf, cflen); - } - strcpy (cf, md); - strcat (cf,"/"); - strcat (cf, name); - cff = fopen (cf, "r"); - while ((c = getc(cff)) != EOF) - putc (c, mfilef); - putc ('\n', mfilef); - skip_to_lf (mddf); - fclose (cff); - } - fclose (mddf); - fclose (mfilef); - return 0; -} - -static void -skip_to_lf (stream) - FILE *stream; -{ - register int c; - while ((c = getc(stream)) != '\n') - ; -} - -static void * -xmalloc (size) - unsigned size; -{ - char *result = (char *) malloc (size); - if (!result) - fatal ("virtual memory exhausted", 0); - return result; -} - -static void * -xrealloc (ptr, size) - char *ptr; - unsigned size; -{ - char *result = (char *) realloc (ptr, size); - if (!result) - fatal ("virtual memory exhausted", 0); - return result; -} - -/* Print error message and exit. */ - -static void -fatal (CONST char *s1, CONST char *s2) -{ - error (s1, s2); - exit (1); -} - -static void -error (CONST char *s1, CONST char *s2) -{ - fprintf (stderr, "cvtmail: "); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} diff --git a/lib-src/digest-doc.c b/lib-src/digest-doc.c deleted file mode 100644 index b4f7ca2..0000000 --- a/lib-src/digest-doc.c +++ /dev/null @@ -1,52 +0,0 @@ -/* Give this program DOCSTR.mm.nn as standard input - and it outputs to standard output - a file of nroff output containing the doc strings. - - See also sorted-doc.c, which produces similar output - but in texinfo format and sorted by function/variable name. */ - -#ifdef emacs -#include <../src/config.h> -#endif -#include - -int -main () -{ - register int ch; - register int notfirst = 0; - - printf (".TL\n"); - printf ("Command Summary for GNU Emacs\n"); - printf (".AU\nRichard M. Stallman\n"); - while ((ch = getchar ()) != EOF) - { - if (ch == '\037') - { - if (notfirst) - printf ("\n.DE"); - else - notfirst = 1; - - printf ("\n.SH\n"); - - ch = getchar (); - printf (ch == 'F' ? "Function " : "Variable "); - - while ((ch = getchar ()) != '\n') /* Changed this line */ - { - if (ch != EOF) - putchar (ch); - else - { - ungetc (ch, stdin); - break; - } - } - printf ("\n.DS L\n"); - } - else - putchar (ch); - } - return 0; -} diff --git a/lib-src/ellcc.c b/lib-src/ellcc.c deleted file mode 100644 index acc3abe..0000000 --- a/lib-src/ellcc.c +++ /dev/null @@ -1,681 +0,0 @@ -/* ellcc.c - front-end for compiling Emacs modules -Copyright (C) 1998, 1999 J. Kean Johnston. - -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. - -Author: J. Kean Johnston (jkj@sco.com). -Please mail bugs and suggestions to the XEmacs maintainer. -*/ - -/* -Here's the scoop. We would really like this to be a shell script, but -the various Windows platforms dont have reliable scripting that suits -our needs. We dont want to reply on perl or some other such language -so we have to roll our own executable to act as a front-end for the -compiler. - -This program is used to invoke the compiler, the linker and to generate -the module specific documentation and initialization code. We assume we -are in 'compile' mode unless we encounter an argument which tells us -that we're not. We take all arguments and pass them on directly to the -compiler, except for a few which are specific to this program: - - --mode=VALUE This sets the program mode. VALUE can be one of - compile, link, init or verbose. - --mod-name=NAME Sets the module name to the string NAME. - --mod-title=TITLE Sets the module title to the string TITLE. - --mod-version=VER Sets the module version to the string VER. - -The idea is that Makefiles will use ellcc as the compiler for making -dynamic Emacs modules, and life should be as simple as: - - make CC=ellcc LD='ellcc --mode=link' - -The only additional requirement is an entry in the Makefile to produce -the module initialization file, which will usually be something along -the lines of: - - modinit.c: $(SRCS) - ellcc --mode=init --mod-name=\"$(MODNAME)\" \ - --mod-title=\"$(MODTITLE)\" --mod-version=\"$(MODVERSION)\" \ - -o $@ $(SRCS) - -See the samples for more details. -*/ - -#include -#include - -#ifdef MSDOS -# include -# include -# include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif -#endif /* MSDOS */ - -#ifdef WINDOWSNT -# include -# include -# include -# include -# define MAXPATHLEN _MAX_PATH -# ifdef HAVE_CONFIG_H -# undef HAVE_NTGUI -# else -# define DOS_NT -# define HAVE_GETCWD -# endif /* not HAVE_CONFIG_H */ -#endif /* WINDOWSNT */ - -#ifdef HAVE_CONFIG_H -# include - /* On some systems, Emacs defines static as nothing for the sake - of unexec. We don't want that here since we don't use unexec. */ -# undef static -#endif /* HAVE_CONFIG_H */ - -#if !defined (WINDOWSNT) && defined (STDC_HEADERS) -#include -#include -#endif - -#ifdef HAVE_UNISTD_H -# include -#else -# ifdef HAVE_GETCWD - extern char *getcwd (); -# endif -#endif /* HAVE_UNISTD_H */ - -#include -#include -#include -#ifndef errno - extern int errno; -#endif -#include -#include - -#define EMODULES_GATHER_VERSION -#include "emodules.h" -#include "ellcc.h" - -#if !defined (S_ISREG) && defined (S_IFREG) -# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -#endif - -/* Exit codes for success and failure. */ -#ifdef VMS -# define GOOD 1 -# define BAD 0 -#else -# define GOOD 0 -# define BAD 1 -#endif - -#define DEBUG - -#ifndef HAVE_SHLIB -int -main() -{ - fprintf (stderr, "Dynamic modules not supported on this platform\n"); - return (BAD); -} -#else - -/* - * Try to figure out the commands we need to use to create shared objects, - * and how to compile for PIC mode. - */ - -/* - * xnew, xrnew -- allocate, reallocate storage - * - * SYNOPSIS: Type *xnew (int n, Type); - * Type *xrnew (OldPointer, int n, Type); - */ -#ifdef chkmalloc -# include "chkmalloc.h" -# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \ - (n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) trace_realloc (__FILE__, __LINE__, \ - (op), (n) * sizeof (Type))) -#else -# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) xrealloc ((op), (n) * sizeof (Type))) -#endif -long *xmalloc (), *xrealloc (); -void fatal (), pfatal (); -char *ellcc_strchr (), *ellcc_strrchr (); -void add_to_argv (); -void do_compile_mode(), do_link_mode(), do_init_mode(); - -#define SSTR(S) ((S)?(S):"") - -#define ELLCC_COMPILE_MODE 0 -#define ELLCC_LINK_MODE 1 -#define ELLCC_INIT_MODE 2 - -int ellcc_mode = ELLCC_COMPILE_MODE; -char *progname; -char *mod_name = (char *)0, *mod_version = (char *)0, *mod_title = (char *)0; -char *mod_output = (char *)0; -int verbose = 0; -char **exec_argv; -int exec_argc = 1, *exec_args; -int real_argc = 0; -int prog_argc; -char **prog_argv; - -/* - * We allow the user to over-ride things in the environment - */ -char *ellcc, *ellld, *ellcflags, *ellldflags, *ellpicflags, *elldllflags; -#define OVERENV(STR,EVAR,DFLT) \ - STR = getenv(EVAR); \ - if ((STR) == (char *)0) \ - STR = DFLT - -int -main (argc, argv) - int argc; - char *argv[]; -{ - char *tmp; - int i, done_mode = 0; - - prog_argc = argc; - prog_argv = argv; - -#if defined(MSDOS) || defined(WINDOWSNT) - tmp = ellcc_strrchr (argv[0], '\\'); - if (tmp != (char *)0) - tmp++; -#elif !defined (VMS) - tmp = ellcc_strrchr (argv[0], '/'); - if (tmp != (char *)0) - tmp++; -#else - tmp = argv[0]; -#endif - - if (tmp != (char *)0) - progname = tmp; - else - progname = argv[0]; - - tmp = &progname[strlen(progname)-2]; - if (strcmp (tmp, "cc") == 0) - ellcc_mode = ELLCC_COMPILE_MODE; - else if (strcmp (tmp, "ld") == 0) - ellcc_mode = ELLCC_LINK_MODE; - else if (strcmp (tmp, "it") == 0) - ellcc_mode = ELLCC_INIT_MODE; - - exec_argv = xnew(argc + 20, char *); - exec_args = xnew(argc, int); - for (i = 0; i < argc; i++) - exec_args[i] = -1; - - if (argc < 2) - fatal ("too few arguments", (char *)0); - - exec_args[0] = 0; - - for (i = 1; i < argc; i++) - { - if (strncmp (argv[i], "--mode=", 7) == 0) - { - char *modeopt = argv[i] + 7; - - if (done_mode && strcmp (modeopt, "verbose")) - fatal ("more than one mode specified"); - if (strcmp (modeopt, "link") == 0) - { - done_mode++; - ellcc_mode = ELLCC_LINK_MODE; - } - else if (strcmp (modeopt, "compile") == 0) - { - done_mode++; - ellcc_mode = ELLCC_COMPILE_MODE; - } - else if (strcmp (modeopt, "init") == 0) - { - done_mode++; - ellcc_mode = ELLCC_INIT_MODE; - } - else if (strcmp (modeopt, "verbose") == 0) - verbose += 1; - } - else if (strcmp (argv[i], "--mod-location") == 0) - { - printf ("%s\n", ELLCC_MODDIR); - return 0; - } - else if (strcmp (argv[i], "--mod-site-location") == 0) - { - printf ("%s\n", ELLCC_SITEMODS); - return 0; - } - else if (strcmp (argv[i], "--mod-archdir") == 0) - { - printf ("%s\n", ELLCC_ARCHDIR); - return 0; - } - else if (strcmp (argv[i], "--mod-config") == 0) - { - printf ("%s\n", ELLCC_CONFIG); - return 0; - } - else if (strncmp (argv[i], "--mod-name=", 10) == 0) - mod_name = argv[i] + 11; - else if (strncmp (argv[i], "--mod-title=", 11) == 0) - mod_title = argv[i] + 12; - else if (strncmp (argv[i], "--mod-version=", 13) == 0) - mod_version = argv[i] + 14; - else if (strncmp (argv[i], "--mod-output=", 12) == 0) - mod_output = argv[i] + 13; - else - { - exec_args[exec_argc] = i; - exec_argc++; - } - } - - if (ellcc_mode == ELLCC_LINK_MODE && mod_output == (char *)0) - fatal ("must specify --mod-output when linking", (char *)0); - if (ellcc_mode == ELLCC_INIT_MODE && mod_output == (char *)0) - fatal ("must specify --mod-output when creating init file", (char *)0); - if (ellcc_mode == ELLCC_INIT_MODE && mod_name == (char *)0) - fatal ("must specify --mod-name when creating init file", (char *)0); - - /* - * We now have the list of arguments to pass to the compiler or - * linker (or to process for doc files). We can do the real work - * now. - */ - if (verbose) - printf ("ellcc driver version %s for EMODULES version %s (%ld)\n", - ELLCC_EMACS_VER, EMODULES_VERSION, EMODULES_REVISION); -#ifdef DEBUG - if (verbose >= 2) - { - printf (" mode = %d (%s)\n", ellcc_mode, - ellcc_mode == ELLCC_COMPILE_MODE ? "compile" : - ellcc_mode == ELLCC_LINK_MODE ? "link" : "init"); - printf (" module_name = \"%s\"\n", SSTR(mod_name)); - printf (" module_title = \"%s\"\n", SSTR(mod_title)); - printf (" module_version = \"%s\"\n", SSTR(mod_version)); - - printf (" CC = %s\n", ELLCC_CC); - printf (" CFLAGS = %s\n", ELLCC_CFLAGS); - printf (" CC PIC flags = %s\n", ELLCC_DLL_CFLAGS); - printf (" LD = %s\n", ELLCC_DLL_LD); - printf (" LDFLAGS = %s\n", ELLCC_DLL_LDFLAGS); - printf (" architecture = %s\n", ELLCC_CONFIG); - printf (" Include directory = %s/include\n", ELLCC_ARCHDIR); - printf ("\n"); - } -#endif - - if (exec_argc < 2) - fatal ("too few arguments"); - - /* - * Get the over-rides from the environment - */ - OVERENV(ellcc, "ELLCC", ELLCC_CC); - OVERENV(ellld, "ELLLD", ELLCC_DLL_LD); - OVERENV(ellcflags, "ELLCFLAGS", ELLCC_CFLAGS); - OVERENV(ellldflags, "ELLLDFLAGS", ELLCC_LDFLAGS); - OVERENV(elldllflags, "ELLDLLFLAGS", ELLCC_DLL_LDFLAGS); - OVERENV(ellpicflags, "ELLPICFLAGS", ELLCC_DLL_CFLAGS); - - if (ellcc_mode == ELLCC_COMPILE_MODE) - do_compile_mode(); - else if (ellcc_mode == ELLCC_LINK_MODE) - do_link_mode(); - else - do_init_mode(); - - /* - * The arguments to pass on to the desired program have now been set - * up and we can run the program. - */ - if (verbose) - { - for (i = 0; i < real_argc; i++) - printf ("%s ", exec_argv[i]); - printf ("\n"); - fflush (stdout); - } - exec_argv[real_argc] = (char *)0; /* Terminate argument list */ - - i = execvp (exec_argv[0], exec_argv); - if (verbose) - printf ("%s exited with status %d\n", exec_argv[0], i); - return i; -} - -/* Like malloc but get fatal error if memory is exhausted. */ -long * -xmalloc (size) - unsigned int size; -{ - long *result = (long *) malloc (size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} - -long * -xrealloc (ptr, size) - char *ptr; - unsigned int size; -{ - long *result = (long *) realloc (ptr, size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} - -/* Print error message and exit. */ -void -fatal (s1, s2) - char *s1, *s2; -{ - fprintf (stderr, "%s: ", progname); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); - exit (BAD); -} - -void -pfatal (s1) - char *s1; -{ - perror (s1); - exit (BAD); -} - -/* - * Return the ptr in sp at which the character c last - * appears; NULL if not found - * - * Identical to System V strrchr, included for portability. - */ -char * -ellcc_strrchr (sp, c) - register char *sp, c; -{ - register char *r; - - r = NULL; - do - { - if (*sp == c) - r = sp; - } while (*sp++); - return r; -} - -/* - * Return the ptr in sp at which the character c first - * appears; NULL if not found - * - * Identical to System V strchr, included for portability. - */ -char * -ellcc_strchr (sp, c) - register char *sp, c; -{ - do - { - if (*sp == c) - return sp; - } while (*sp++); - return NULL; -} - -/* - * Add a string to the argument vector list that will be passed on down - * to the compiler or linker. We need to split individual words into - * arguments, taking quoting into account. This can get ugly. - */ -void -add_to_argv (str) - CONST char *str; -{ - int sm = 0; - CONST char *s = (CONST char *)0; - - if ((str == (CONST char *)0) || (str[0] == '\0')) - return; - - while (*str) - { - switch (sm) - { - case 0: /* Start of case - string leading whitespace */ - if (isspace (*str)) - str++; - else - { - sm = 1; /* Change state to non-whitespace */ - s = str; /* Mark the start of THIS argument */ - } - break; - - case 1: /* Non-whitespace character. Mark the start */ - if (isspace (*str)) - { - /* Reached the end of the argument. Add it. */ - int l = str-s; - exec_argv[real_argc] = xnew (l+2, char); - strncpy (exec_argv[real_argc], s, l); - exec_argv[real_argc][l] = '\0'; - real_argc++; - sm = 0; /* Back to start state */ - s = (CONST char *)0; - break; - } - else if (*str == '\\') - { - sm = 2; /* Escaped character */ - str++; - break; - } - else if (*str == '\'') - { - /* Start of quoted string (single quotes) */ - sm = 3; - } - else if (*str == '"') - { - /* Start of quoted string (double quotes) */ - sm = 4; - } - else - { - /* This was just a normal character. Advance the pointer. */ - str++; - } - break; - - case 2: /* Escaped character */ - str++; /* Preserve the quoted character */ - sm = 1; /* Go back to gathering state */ - break; - - case 3: /* Inside single quoted string */ - if (*str == '\'') - sm = 1; - str++; - break; - - case 4: /* inside double quoted string */ - if (*str == '"') - sm = 1; - str++; - break; - } - } - - if (s != (CONST char *)0) - { - int l = str-s; - exec_argv[real_argc] = xnew (l+2, char); - strncpy (exec_argv[real_argc], s, l); - exec_argv[real_argc][l] = '\0'; - real_argc++; - s = (CONST char *)0; - } -} - -/* - * For compile mode, things are pretty straight forward. All we need to do - * is build up the argument vector and exec() it. We must just make sure - * that we get all of the required arguments in place. - */ -void -do_compile_mode() -{ - int i; - char ts[4096]; /* Plenty big enough */ - - add_to_argv (ellcc); - add_to_argv (ellcflags); - add_to_argv (ellpicflags); - add_to_argv ("-DPIC"); - add_to_argv ("-DEMACS_MODULE"); -#ifdef XEMACS - add_to_argv ("-DXEMACS_MODULE"); /* Cover both cases */ - add_to_argv ("-Dxemacs"); -#endif - add_to_argv ("-Demacs"); - sprintf (ts, "-I%s/include", ELLCC_ARCHDIR); - add_to_argv (ts); - add_to_argv (ELLCC_CF_ALL); - for (i = 1; i < exec_argc; i++) - exec_argv[real_argc++] = strdup (prog_argv[exec_args[i]]); -} - -/* - * For link mode, things are a little bit more complicated. We need to - * insert the linker commands first, replace any occurrence of ELLSONAME - * with the desired output file name, insert the output arguments, then - * all of the provided arguments, then the final post arguments. Once - * all of this has been done, the argument vector is ready to run. - */ -void -do_link_mode() -{ - int i,x; - char *t, ts[4096]; /* Plenty big enough */ - - add_to_argv (ellld); - add_to_argv (ellldflags); - add_to_argv (elldllflags); - add_to_argv (ELLCC_DLL_LDO); - add_to_argv (mod_output); - for (i = 1; i < exec_argc; i++) - exec_argv[real_argc++] = strdup (prog_argv[exec_args[i]]); - add_to_argv (ELLCC_DLL_POST); - - /* - * Now go through each argument and replace ELLSONAME with mod_output. - */ - for (i = 0; i < real_argc; i++) - { - x = 0; - ts[0] = '\0'; - - t = exec_argv[i]; - while (*t) - { - if (*t == 'E') - { - if (strncmp (t, "ELLSONAME", 9) == 0) - { - strcat (ts, mod_output); - t += 8; - x += strlen (mod_output); - } - else - { - ts[x] = *t; - x++; - ts[x] = '\0'; - } - } - else - { - ts[x] = *t; - x++; - ts[x] = '\0'; - } - t++; - } - free (exec_argv[i]); - exec_argv[i] = strdup (ts); - } -} - -/* - * In init mode, things are a bit easier. We assume that the only things - * passed on the command line are the names of source files which the - * make-doc program will be processing. We prepare the output file with - * the header information first, as make-doc will append to the file by - * special dispensation. - */ -void -do_init_mode() -{ - int i; - char ts[4096]; /* Plenty big enough */ - char *mdocprog; - FILE *mout = fopen (mod_output, "w"); - - if (mout == (FILE *)0) - fatal ("failed to open output file", mod_output); - fprintf (mout, "/* DO NOT EDIT - AUTOMATICALLY GENERATED */\n\n"); - fprintf (mout, "#include \n\n"); - fprintf (mout, "const long emodule_compiler = %ld;\n", EMODULES_REVISION); - fprintf (mout, "const char *emodule_name = \"%s\";\n", SSTR(mod_name)); - fprintf (mout, "const char *emodule_version = \"%s\";\n", SSTR(mod_version)); - fprintf (mout, "const char *emodule_title = \"%s\";\n", SSTR(mod_title)); - fprintf (mout, "\n\n"); - fprintf (mout, "void docs_of_%s()\n", SSTR(mod_name)); - fclose (mout); - - sprintf (ts, "%s/make-docfile", ELLCC_ARCHDIR); - OVERENV(mdocprog, "ELLMAKEDOC", ts); - add_to_argv (mdocprog); - sprintf (ts, "-E %s", mod_output); - add_to_argv (ts); - for (i = 1; i < exec_argc; i++) - exec_argv[real_argc++] = strdup (prog_argv[exec_args[i]]); -} - -#endif /* HAVE_SHLIB */ - diff --git a/lib-src/etags.c b/lib-src/etags.c deleted file mode 100644 index e9ce59f..0000000 --- a/lib-src/etags.c +++ /dev/null @@ -1,5084 +0,0 @@ -/* Tags file maker to go with GNU Emacs - Copyright (C) 1984, 87, 88, 89, 93, 94, 95, 98 - Free Software Foundation, Inc. and Ken Arnold - -This file is not considered part of GNU Emacs. - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software Foundation, -Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - -/* - * Authors: - * Ctags originally by Ken Arnold. - * Fortran added by Jim Kleckner. - * Ed Pelegri-Llopart added C typedefs. - * Gnu Emacs TAGS format and modifications by RMS? - * Sam Kendall added C++. - * Francesco Potorti` reorganised C and C++ based on work by Joe Wells. - * Regexp tags by Tom Tromey. - * - * Francesco Potorti` (F.Potorti@cnuce.cnr.it) is the current maintainer. - */ - -char pot_etags_version[] = "@(#) pot revision number is 13.7"; - -#define TRUE 1 -#define FALSE 0 - -#ifndef DEBUG -# define DEBUG FALSE -#endif - -#ifdef MSDOS -# include -# include -# include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif -#endif /* MSDOS */ - -#ifdef WINDOWSNT -# include -# include -# include -# include -# define MAXPATHLEN _MAX_PATH -# ifdef HAVE_CONFIG_H -# undef HAVE_NTGUI -# else -# define DOS_NT -# define HAVE_GETCWD -# endif /* not HAVE_CONFIG_H */ -#endif /* WINDOWSNT */ - -#ifdef HAVE_CONFIG_H -# include - /* On some systems, Emacs defines static as nothing for the sake - of unexec. We don't want that here since we don't use unexec. */ -# undef static -# define ETAGS_REGEXPS /* use the regexp features */ -# define LONG_OPTIONS /* accept long options */ -#endif /* HAVE_CONFIG_H */ - -#if !defined (WINDOWSNT) && defined (STDC_HEADERS) -#include -#include -#endif - -#ifdef HAVE_UNISTD_H -# include -#else -# ifdef HAVE_GETCWD - extern char *getcwd (); -# endif -#endif /* HAVE_UNISTD_H */ - -#include -#include -#include -#ifndef errno - extern int errno; -#endif -#include -#include - -#if !defined (S_ISREG) && defined (S_IFREG) -# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -#endif - -#ifdef LONG_OPTIONS -# include -#else -# define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr) - extern char *optarg; - extern int optind, opterr; -#endif /* LONG_OPTIONS */ - -#ifdef ETAGS_REGEXPS -# include -#endif /* ETAGS_REGEXPS */ - -/* Define CTAGS to make the program "ctags" compatible with the usual one. - Leave it undefined to make the program "etags", which makes emacs-style - tag tables and tags typedefs, #defines and struct/union/enum by default. */ -#ifdef CTAGS -# undef CTAGS -# define CTAGS TRUE -#else -# define CTAGS FALSE -#endif - -/* Exit codes for success and failure. */ -#ifdef VMS -# define GOOD 1 -# define BAD 0 -#else -# define GOOD 0 -# define BAD 1 -#endif - -/* C extensions. */ -#define C_PLPL 0x00001 /* C++ */ -#define C_STAR 0x00003 /* C* */ -#define C_JAVA 0x00005 /* JAVA */ -#define YACC 0x10000 /* yacc file */ - -#define streq(s,t) ((DEBUG && (s) == NULL && (t) == NULL \ - && (abort (), 1)) || !strcmp (s, t)) -#define strneq(s,t,n) ((DEBUG && (s) == NULL && (t) == NULL \ - && (abort (), 1)) || !strncmp (s, t, n)) - -#define lowcase(c) tolower ((char)c) - -#define CHARS 256 /* 2^sizeof(char) */ -#define CHAR(x) ((unsigned int)x & (CHARS - 1)) -#define iswhite(c) (_wht[CHAR(c)]) /* c is white */ -#define notinname(c) (_nin[CHAR(c)]) /* c is not in a name */ -#define begtoken(c) (_btk[CHAR(c)]) /* c can start token */ -#define intoken(c) (_itk[CHAR(c)]) /* c can be in token */ -#define endtoken(c) (_etk[CHAR(c)]) /* c ends tokens */ - - -/* - * xnew, xrnew -- allocate, reallocate storage - * - * SYNOPSIS: Type *xnew (int n, Type); - * Type *xrnew (OldPointer, int n, Type); - */ -#ifdef chkmalloc -# include "chkmalloc.h" -# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \ - (n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) trace_realloc (__FILE__, __LINE__, \ - (op), (n) * sizeof (Type))) -#else -# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) xrealloc ((op), (n) * sizeof (Type))) -#endif - -typedef int bool; - -typedef void Lang_function (); - -typedef struct -{ - char *suffix; - int sufflen; - char *command; /* Takes one arg and decompresses to stdout */ -} compressor; - -typedef struct -{ - char *name; - Lang_function *function; - char **suffixes; - char **interpreters; -} language; - -extern char *getenv (); - -/* Many compilers barf on this: - Lang_function Asm_labels; - so let's write it this way */ -void Asm_labels (); -void C_entries (); -void default_C_entries (); -void plain_C_entries (); -void Cjava_entries (); -void Cobol_paragraphs (); -void Cplusplus_entries (); -void Cstar_entries (); -void Erlang_functions (); -void Fortran_functions (); -void Yacc_entries (); -void Lisp_functions (); -void Pascal_functions (); -void Perl_functions (); -void Postscript_functions (); -void Prolog_functions (); -void Python_functions (); -void Scheme_functions (); -void TeX_functions (); -void just_read_file (); - -compressor *get_compressor_from_suffix (); -language *get_language_from_name (); -language *get_language_from_interpreter (); -language *get_language_from_suffix (); -int total_size_of_entries (); -long readline (), readline_internal (); -#ifdef ETAGS_REGEXPS -void analyse_regex (); -void add_regex (); -void free_patterns (); -#endif /* ETAGS_REGEXPS */ -void error (); -void suggest_asking_for_help (); -void fatal (), pfatal (); -void add_node (); - -void init (); -void initbuffer (); -void find_entries (); -void free_tree (); -void pfnote (), new_pfnote (); -void process_file (); -void put_entries (); -void takeprec (); - -char *concat (); -char *skip_spaces (), *skip_non_spaces (); -char *savenstr (), *savestr (); -char *etags_strchr (), *etags_strrchr (); -char *etags_getcwd (); -char *relative_filename (), *absolute_filename (), *absolute_dirname (); -bool filename_is_absolute (); -void canonicalize_filename (); -void grow_linebuffer (); -long *xmalloc (), *xrealloc (); - - -char searchar = '/'; /* use /.../ searches */ - -char *tagfile; /* output file */ -char *progname; /* name this program was invoked with */ -char *cwd; /* current working directory */ -char *tagfiledir; /* directory of tagfile */ -FILE *tagf; /* ioptr for tags file */ - -char *curfile; /* current input file name */ -language *curlang; /* current language */ - -int lineno; /* line number of current line */ -long charno; /* current character number */ -long linecharno; /* charno of start of current line */ -char *dbp; /* pointer to start of current tag */ - -typedef struct node_st -{ /* sorting structure */ - char *name; /* function or type name */ - char *file; /* file name */ - bool is_func; /* use pattern or line no */ - bool been_warned; /* set if noticed dup */ - int lno; /* line number tag is on */ - long cno; /* character number line starts on */ - char *pat; /* search pattern */ - struct node_st *left, *right; /* left and right sons */ -} node; - -node *head; /* the head of the binary tree of tags */ - -/* - * A `linebuffer' is a structure which holds a line of text. - * `readline_internal' reads a line from a stream into a linebuffer - * and works regardless of the length of the line. - * SIZE is the size of BUFFER, LEN is the length of the string in - * BUFFER after readline reads it. - */ -typedef struct -{ - long size; - int len; - char *buffer; -} linebuffer; - -linebuffer lb; /* the current line */ -linebuffer token_name; /* used by C_entries as a temporary area */ -struct -{ - long linepos; - linebuffer lb; /* used by C_entries instead of lb */ -} lbs[2]; - -/* boolean "functions" (see init) */ -bool _wht[CHARS], _nin[CHARS], _itk[CHARS], _btk[CHARS], _etk[CHARS]; -char - /* white chars */ - *white = " \f\t\n\r", - /* not in a name */ - *nonam = " \f\t\n\r(=,[;", - /* token ending chars */ - *endtk = " \t\n\r\"'#()[]{}=-+%*/&|^~!<>;,.:?", - /* token starting chars */ - *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$~@", - /* valid in-token chars */ - *midtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789"; - -bool append_to_tagfile; /* -a: append to tags */ -/* The following four default to TRUE for etags, but to FALSE for ctags. */ -bool typedefs; /* -t: create tags for C typedefs */ -bool typedefs_and_cplusplus; /* -T: create tags for C typedefs, level */ - /* 0 struct/enum/union decls, and C++ */ - /* member functions. */ -bool constantypedefs; /* -d: create tags for C #define, enum */ - /* constants and variables. */ - /* -D: opposite of -d. Default under ctags. */ -bool globals; /* create tags for global variables */ -bool members; /* create tags for C member variables */ -bool update; /* -u: update tags */ -bool vgrind_style; /* -v: create vgrind style index output */ -bool no_warnings; /* -w: suppress warnings */ -bool cxref_style; /* -x: create cxref style output */ -bool cplusplus; /* .[hc] means C++, not C */ -bool noindentypedefs; /* -I: ignore indentation in C */ - -#ifdef LONG_OPTIONS -struct option longopts[] = -{ - { "append", no_argument, NULL, 'a' }, - { "backward-search", no_argument, NULL, 'B' }, - { "c++", no_argument, NULL, 'C' }, - { "cxref", no_argument, NULL, 'x' }, - { "defines", no_argument, NULL, 'd' }, - { "no-defines", no_argument, NULL, 'D' }, - { "globals", no_argument, &globals, TRUE }, - { "no-globals", no_argument, &globals, FALSE }, - { "help", no_argument, NULL, 'h' }, - { "help", no_argument, NULL, 'H' }, - { "ignore-indentation", no_argument, NULL, 'I' }, - { "include", required_argument, NULL, 'i' }, - { "language", required_argument, NULL, 'l' }, - { "members", no_argument, &members, TRUE }, - { "no-members", no_argument, &members, FALSE }, - { "no-warn", no_argument, NULL, 'w' }, - { "output", required_argument, NULL, 'o' }, -#ifdef ETAGS_REGEXPS - { "regex", required_argument, NULL, 'r' }, - { "no-regex", no_argument, NULL, 'R' }, -#endif /* ETAGS_REGEXPS */ - { "typedefs", no_argument, NULL, 't' }, - { "typedefs-and-c++", no_argument, NULL, 'T' }, - { "update", no_argument, NULL, 'u' }, - { "version", no_argument, NULL, 'V' }, - { "vgrind", no_argument, NULL, 'v' }, - { 0 } -}; -#endif /* LONG_OPTIONS */ - -#ifdef ETAGS_REGEXPS -/* Structure defining a regular expression. Elements are - the compiled pattern, and the name string. */ -typedef struct pattern -{ - struct pattern *p_next; - language *language; - char *regex; - struct re_pattern_buffer *pattern; - struct re_registers regs; - char *name_pattern; - bool error_signaled; -} pattern; - -/* Array of all regexps. */ -pattern *p_head = NULL; -#endif /* ETAGS_REGEXPS */ - -compressor compressors[] = -{ - { "z", 1, "gzip -d -c"}, - { "Z", 1, "gzip -d -c"}, - { "gz", 2, "gzip -d -c"}, - { "GZ", 2, "gzip -d -c"}, - { "bz2", 3, "bzip2 -d -c" }, - { NULL } -}; - -/* - * Language stuff. - */ - -/* Non-NULL if language fixed. */ -language *forced_lang = NULL; - -/* Assembly code */ -char *Asm_suffixes [] = { "a", /* Unix assembler */ - "asm", /* Microcontroller assembly */ - "def", /* BSO/Tasking definition includes */ - "inc", /* Microcontroller include files */ - "ins", /* Microcontroller include files */ - "s", "sa", /* Unix assembler */ - "S", /* cpp-processed Unix assembler */ - "src", /* BSO/Tasking C compiler output */ - NULL - }; - -/* Note that .c and .h can be considered C++, if the --c++ flag was - given. That is why default_C_entries is called here. */ -char *default_C_suffixes [] = - { "c", "h", NULL }; - -char *Cplusplus_suffixes [] = - { "C", "H", "c++", "cc", "cpp", "cxx", "h++", "hh", "hpp", "hxx", - "M", /* Objective C++ */ - "pdb", /* Postscript with C syntax */ - NULL }; - -char *Cjava_suffixes [] = - { "java", NULL }; - -char *Cobol_suffixes [] = - { "COB", "cob", NULL }; - -char *Cstar_suffixes [] = - { "cs", "hs", NULL }; - -char *Erlang_suffixes [] = - { "erl", "hrl", NULL }; - -char *Fortran_suffixes [] = - { "F", "f", "f90", "for", NULL }; - -char *Lisp_suffixes [] = - { "cl", "clisp", "el", "l", "lisp", "lsp", "ml", NULL }; - -char *Pascal_suffixes [] = - { "p", "pas", NULL }; - -char *Perl_suffixes [] = - { "pl", "pm", NULL }; -char *Perl_interpreters [] = - { "perl", "@PERL@", NULL }; - -char *plain_C_suffixes [] = - { "pc", /* Pro*C file */ - "m", /* Objective C file */ - "lm", /* Objective lex file */ - NULL }; - -char *Postscript_suffixes [] = - { "ps", NULL }; - -char *Prolog_suffixes [] = - { "prolog", NULL }; - -char *Python_suffixes [] = - { "py", NULL }; - -/* Can't do the `SCM' or `scm' prefix with a version number. */ -char *Scheme_suffixes [] = - { "SCM", "SM", "oak", "sch", "scheme", "scm", "sm", "ss", "t", NULL }; - -char *TeX_suffixes [] = - { "TeX", "bib", "clo", "cls", "ltx", "sty", "tex", NULL }; - -char *Yacc_suffixes [] = - { "y", "ym", "yy", "yxx", "y++", NULL }; /* .ym is Objective yacc file */ - -/* - * Table of languages. - * - * It is ok for a given function to be listed under more than one - * name. I just didn't. - */ - -language lang_names [] = -{ - { "asm", Asm_labels, Asm_suffixes, NULL }, - { "c", default_C_entries, default_C_suffixes, NULL }, - { "c++", Cplusplus_entries, Cplusplus_suffixes, NULL }, - { "c*", Cstar_entries, Cstar_suffixes, NULL }, - { "cobol", Cobol_paragraphs, Cobol_suffixes, NULL }, - { "erlang", Erlang_functions, Erlang_suffixes, NULL }, - { "fortran", Fortran_functions, Fortran_suffixes, NULL }, - { "java", Cjava_entries, Cjava_suffixes, NULL }, - { "lisp", Lisp_functions, Lisp_suffixes, NULL }, - { "pascal", Pascal_functions, Pascal_suffixes, NULL }, - { "perl", Perl_functions, Perl_suffixes, Perl_interpreters }, - { "postscript", Postscript_functions, Postscript_suffixes, NULL }, - { "proc", plain_C_entries, plain_C_suffixes, NULL }, - { "prolog", Prolog_functions, Prolog_suffixes, NULL }, - { "python", Python_functions, Python_suffixes, NULL }, - { "scheme", Scheme_functions, Scheme_suffixes, NULL }, - { "tex", TeX_functions, TeX_suffixes, NULL }, - { "yacc", Yacc_entries, Yacc_suffixes, NULL }, - { "auto", NULL }, /* default guessing scheme */ - { "none", just_read_file }, /* regexp matching only */ - { NULL, NULL } /* end of list */ -}; - -void -print_language_names () -{ - language *lang; - char **ext; - - puts ("\nThese are the currently supported languages, along with the\n\ -default file name suffixes:"); - for (lang = lang_names; lang->name != NULL; lang++) - { - printf ("\t%s\t", lang->name); - if (lang->suffixes != NULL) - for (ext = lang->suffixes; *ext != NULL; ext++) - printf (" .%s", *ext); - puts (""); - } - puts ("Where `auto' means use default language for files based on file\n\ -name suffix, and `none' means only do regexp processing on files.\n\ -If no language is specified and no matching suffix is found,\n\ -the first line of the file is read for a sharp-bang (#!) sequence\n\ -followed by the name of an interpreter. If no such sequence is found,\n\ -Fortran is tried first; if no tags are found, C is tried next.\n\ -Compressed files are supported using gzip and bzip2."); -} - -#ifndef VERSION -# define VERSION "20" -#endif -void -print_version () -{ - printf ("%s (GNU Emacs %s)\n", (CTAGS) ? "ctags" : "etags", VERSION); - puts ("Copyright (C) 1996 Free Software Foundation, Inc. and Ken Arnold"); - puts ("This program is distributed under the same terms as Emacs"); - - exit (GOOD); -} - -void -print_help () -{ - printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ -\n\ -These are the options accepted by %s.\n", progname, progname); -#ifdef LONG_OPTIONS - puts ("You may use unambiguous abbreviations for the long option names."); -#else - puts ("Long option names do not work with this executable, as it is not\n\ -linked with GNU getopt."); -#endif /* LONG_OPTIONS */ - puts ("A - as file name means read names from stdin (one per line)."); - if (!CTAGS) - printf (" Absolute names are stored in the output file as they are.\n\ -Relative ones are stored relative to the output file's directory."); - puts ("\n"); - - puts ("-a, --append\n\ - Append tag entries to existing tags file."); - - if (CTAGS) - puts ("-B, --backward-search\n\ - Write the search commands for the tag entries using '?', the\n\ - backward-search command instead of '/', the forward-search command."); - - puts ("-C, --c++\n\ - Treat files whose name suffix defaults to C language as C++ files."); - - if (CTAGS) - puts ("-d, --defines\n\ - Create tag entries for C #define constants and enum constants, too."); - else - puts ("-D, --no-defines\n\ - Don't create tag entries for C #define constants and enum constants.\n\ - This makes the tags file smaller."); - - if (!CTAGS) - { - puts ("-i FILE, --include=FILE\n\ - Include a note in tag file indicating that, when searching for\n\ - a tag, one should also consult the tags file FILE after\n\ - checking the current file."); - puts ("-l LANG, --language=LANG\n\ - Force the following files to be considered as written in the\n\ - named language up to the next --language=LANG option."); - } - - if (CTAGS) - puts ("--globals\n\ - Create tag entries for global variables in some languages."); - else - puts ("--no-globals\n\ - Do not create tag entries for global variables in some\n\ - languages. This makes the tags file smaller."); - puts ("--members\n\ - Create tag entries for member variables in C and derived languages."); - -#ifdef ETAGS_REGEXPS - puts ("-r /REGEXP/, --regex=/REGEXP/ or --regex=@regexfile\n\ - Make a tag for each line matching pattern REGEXP in the\n\ - following files. regexfile is a file containing one REGEXP\n\ - per line. REGEXP is anchored (as if preceded by ^).\n\ - The form /REGEXP/NAME/ creates a named tag. For example Tcl\n\ - named tags can be created with:\n\ - --regex=/proc[ \\t]+\\([^ \\t]+\\)/\\1/."); - puts ("-R, --no-regex\n\ - Don't create tags from regexps for the following files."); -#endif /* ETAGS_REGEXPS */ - puts ("-o FILE, --output=FILE\n\ - Write the tags to FILE."); - puts ("-I, --ignore-indentation\n\ - Don't rely on indentation quite as much as normal. Currently,\n\ - this means not to assume that a closing brace in the first\n\ - column is the final brace of a function or structure\n\ - definition in C and C++."); - - if (CTAGS) - { - puts ("-t, --typedefs\n\ - Generate tag entries for C typedefs."); - puts ("-T, --typedefs-and-c++\n\ - Generate tag entries for C typedefs, C struct/enum/union tags,\n\ - and C++ member functions."); - puts ("-u, --update\n\ - Update the tag entries for the given files, leaving tag\n\ - entries for other files in place. Currently, this is\n\ - implemented by deleting the existing entries for the given\n\ - files and then rewriting the new entries at the end of the\n\ - tags file. It is often faster to simply rebuild the entire\n\ - tag file than to use this."); - puts ("-v, --vgrind\n\ - Generates an index of items intended for human consumption,\n\ - similar to the output of vgrind. The index is sorted, and\n\ - gives the page number of each item."); - puts ("-w, --no-warn\n\ - Suppress warning messages about entries defined in multiple\n\ - files."); - puts ("-x, --cxref\n\ - Like --vgrind, but in the style of cxref, rather than vgrind.\n\ - The output uses line numbers instead of page numbers, but\n\ - beyond that the differences are cosmetic; try both to see\n\ - which you like."); - } - - puts ("-V, --version\n\ - Print the version of the program.\n\ --h, --help\n\ - Print this help message."); - - print_language_names (); - - puts (""); - puts ("Report bugs to bug-gnu-emacs@prep.ai.mit.edu"); - - exit (GOOD); -} - - -enum argument_type -{ - at_language, - at_regexp, - at_filename -}; - -/* This structure helps us allow mixing of --lang and file names. */ -typedef struct -{ - enum argument_type arg_type; - char *what; - language *lang; /* language of the regexp */ -} argument; - -#ifdef VMS /* VMS specific functions */ - -#define EOS '\0' - -/* This is a BUG! ANY arbitrary limit is a BUG! - Won't someone please fix this? */ -#define MAX_FILE_SPEC_LEN 255 -typedef struct { - short curlen; - char body[MAX_FILE_SPEC_LEN + 1]; -} vspec; - -/* - v1.05 nmm 26-Jun-86 fn_exp - expand specification of list of file names - returning in each successive call the next file name matching the input - spec. The function expects that each in_spec passed - to it will be processed to completion; in particular, up to and - including the call following that in which the last matching name - is returned, the function ignores the value of in_spec, and will - only start processing a new spec with the following call. - If an error occurs, on return out_spec contains the value - of in_spec when the error occurred. - - With each successive file name returned in out_spec, the - function's return value is one. When there are no more matching - names the function returns zero. If on the first call no file - matches in_spec, or there is any other error, -1 is returned. -*/ - -#include -#include -#define OUTSIZE MAX_FILE_SPEC_LEN -short -fn_exp (out, in) - vspec *out; - char *in; -{ - static long context = 0; - static struct dsc$descriptor_s o; - static struct dsc$descriptor_s i; - static bool pass1 = TRUE; - long status; - short retval; - - if (pass1) - { - pass1 = FALSE; - o.dsc$a_pointer = (char *) out; - o.dsc$w_length = (short)OUTSIZE; - i.dsc$a_pointer = in; - i.dsc$w_length = (short)strlen(in); - i.dsc$b_dtype = DSC$K_DTYPE_T; - i.dsc$b_class = DSC$K_CLASS_S; - o.dsc$b_dtype = DSC$K_DTYPE_VT; - o.dsc$b_class = DSC$K_CLASS_VS; - } - if ((status = lib$find_file(&i, &o, &context, 0, 0)) == RMS$_NORMAL) - { - out->body[out->curlen] = EOS; - return 1; - } - else if (status == RMS$_NMF) - retval = 0; - else - { - strcpy(out->body, in); - retval = -1; - } - lib$find_file_end(&context); - pass1 = TRUE; - return retval; -} - -/* - v1.01 nmm 19-Aug-85 gfnames - return in successive calls the - name of each file specified by the provided arg expanding wildcards. -*/ -char * -gfnames (arg, p_error) - char *arg; - bool *p_error; -{ - static vspec filename = {MAX_FILE_SPEC_LEN, "\0"}; - - switch (fn_exp (&filename, arg)) - { - case 1: - *p_error = FALSE; - return filename.body; - case 0: - *p_error = FALSE; - return NULL; - default: - *p_error = TRUE; - return filename.body; - } -} - -#ifndef OLD /* Newer versions of VMS do provide `system'. */ -system (cmd) - char *cmd; -{ - error ("%s", "system() function not implemented under VMS"); -} -#endif - -#define VERSION_DELIM ';' -char *massage_name (s) - char *s; -{ - char *start = s; - - for ( ; *s; s++) - if (*s == VERSION_DELIM) - { - *s = EOS; - break; - } - else - *s = lowcase (*s); - return start; -} -#endif /* VMS */ - - -int -main (argc, argv) - int argc; - char *argv[]; -{ - int i; - unsigned int nincluded_files; - char **included_files; - char *this_file; - argument *argbuffer; - int current_arg, file_count; - linebuffer filename_lb; -#ifdef VMS - bool got_err; -#endif - -#ifdef DOS_NT - _fmode = O_BINARY; /* all of files are treated as binary files */ -#endif /* DOS_NT */ - - progname = argv[0]; - nincluded_files = 0; - included_files = xnew (argc, char *); - current_arg = 0; - file_count = 0; - - /* Allocate enough no matter what happens. Overkill, but each one - is small. */ - argbuffer = xnew (argc, argument); - -#ifdef ETAGS_REGEXPS - /* Set syntax for regular expression routines. */ - re_set_syntax (RE_SYNTAX_EMACS | RE_INTERVALS); -#endif /* ETAGS_REGEXPS */ - - /* - * If etags, always find typedefs and structure tags. Why not? - * Also default is to find macro constants, enum constants and - * global variables. - */ - if (!CTAGS) - { - typedefs = typedefs_and_cplusplus = constantypedefs = TRUE; - globals = TRUE; - members = FALSE; - } - - while (1) - { - int opt; - char *optstring; - -#ifdef ETAGS_REGEXPS - optstring = "-aCdDf:Il:o:r:RStTi:BuvxwVhH"; -#else - optstring = "-aCdDf:Il:o:StTi:BuvxwVhH"; -#endif /* ETAGS_REGEXPS */ - -#ifndef LONG_OPTIONS - optstring = optstring + 1; -#endif /* LONG_OPTIONS */ - - opt = getopt_long (argc, argv, optstring, longopts, 0); - if (opt == EOF) - break; - - switch (opt) - { - case 0: - /* If getopt returns 0, then it has already processed a - long-named option. We should do nothing. */ - break; - - case 1: - /* This means that a file name has been seen. Record it. */ - argbuffer[current_arg].arg_type = at_filename; - argbuffer[current_arg].what = optarg; - ++current_arg; - ++file_count; - break; - - /* Common options. */ - case 'a': append_to_tagfile = TRUE; break; - case 'C': cplusplus = TRUE; break; - case 'd': constantypedefs = TRUE; break; - case 'D': constantypedefs = FALSE; break; - case 'f': /* for compatibility with old makefiles */ - case 'o': - if (tagfile) - { - error ("-%c option may only be given once.", opt); - suggest_asking_for_help (); - } - tagfile = optarg; - break; - case 'I': - case 'S': /* for backward compatibility */ - noindentypedefs = TRUE; - break; - case 'l': - { - language *lang = get_language_from_name (optarg); - if (lang != NULL) - { - argbuffer[current_arg].lang = lang; - argbuffer[current_arg].arg_type = at_language; - ++current_arg; - } - } - break; -#ifdef ETAGS_REGEXPS - case 'r': - argbuffer[current_arg].arg_type = at_regexp; - argbuffer[current_arg].what = optarg; - ++current_arg; - break; - case 'R': - argbuffer[current_arg].arg_type = at_regexp; - argbuffer[current_arg].what = NULL; - ++current_arg; - break; -#endif /* ETAGS_REGEXPS */ - case 'V': - print_version (); - break; - case 'h': - case 'H': - print_help (); - break; - case 't': - typedefs = TRUE; - break; - case 'T': - typedefs = typedefs_and_cplusplus = TRUE; - break; -#if (!CTAGS) - /* Etags options */ - case 'i': - included_files[nincluded_files++] = optarg; - break; -#else /* CTAGS */ - /* Ctags options. */ - case 'B': searchar = '?'; break; - case 'u': update = TRUE; break; - case 'v': vgrind_style = TRUE; /*FALLTHRU*/ - case 'x': cxref_style = TRUE; break; - case 'w': no_warnings = TRUE; break; -#endif /* CTAGS */ - default: - suggest_asking_for_help (); - } - } - - for (; optind < argc; ++optind) - { - argbuffer[current_arg].arg_type = at_filename; - argbuffer[current_arg].what = argv[optind]; - ++current_arg; - ++file_count; - } - - if (nincluded_files == 0 && file_count == 0) - { - error ("no input files specified.", 0); - suggest_asking_for_help (); - } - - if (tagfile == NULL) - tagfile = CTAGS ? "tags" : "TAGS"; - cwd = etags_getcwd (); /* the current working directory */ - if (cwd[strlen (cwd) - 1] != '/') - { - char *oldcwd = cwd; - cwd = concat (oldcwd, "/", ""); - free (oldcwd); - } - if (streq (tagfile, "-")) - tagfiledir = cwd; - else - tagfiledir = absolute_dirname (tagfile, cwd); - - init (); /* set up boolean "functions" */ - - initbuffer (&lb); - initbuffer (&token_name); - initbuffer (&lbs[0].lb); - initbuffer (&lbs[1].lb); - initbuffer (&filename_lb); - - if (!CTAGS) - { - if (streq (tagfile, "-")) - { - tagf = stdout; -#ifdef DOS_NT - /* Switch redirected `stdout' to binary mode (setting `_fmode' - doesn't take effect until after `stdout' is already open). */ - if (!isatty (fileno (stdout))) - setmode (fileno (stdout), O_BINARY); -#endif /* DOS_NT */ - } - else - tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); - if (tagf == NULL) - pfatal (tagfile); - } - - /* - * Loop through files finding functions. - */ - for (i = 0; i < current_arg; ++i) - { - switch (argbuffer[i].arg_type) - { - case at_language: - forced_lang = argbuffer[i].lang; - break; -#ifdef ETAGS_REGEXPS - case at_regexp: - analyse_regex (argbuffer[i].what); - break; -#endif - case at_filename: -#ifdef VMS - while ((this_file = gfnames (argbuffer[i].what, &got_err)) != NULL) - { - if (got_err) - { - error ("can't find file %s\n", this_file); - argc--, argv++; - } - else - { - this_file = massage_name (this_file); - } -#else - this_file = argbuffer[i].what; -#endif - /* Input file named "-" means read file names from stdin - (one per line) and use them. */ - if (streq (this_file, "-")) - while (readline_internal (&filename_lb, stdin) > 0) - process_file (filename_lb.buffer); - else - process_file (this_file); -#ifdef VMS - } -#endif - break; - } - } - -#ifdef ETAGS_REGEXPS - free_patterns (); -#endif /* ETAGS_REGEXPS */ - - if (!CTAGS) - { - while (nincluded_files-- > 0) - fprintf (tagf, "\f\n%s,include\n", *included_files++); - - fclose (tagf); - exit (GOOD); - } - - /* If CTAGS, we are here. process_file did not write the tags yet, - because we want them ordered. Let's do it now. */ - if (cxref_style) - { - put_entries (head); - free_tree (head); - head = NULL; - exit (GOOD); - } - - if (update) - { - char cmd[BUFSIZ]; - for (i = 0; i < current_arg; ++i) - { - if (argbuffer[i].arg_type != at_filename) - continue; - sprintf (cmd, - "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS", - tagfile, argbuffer[i].what, tagfile); - if (system (cmd) != GOOD) - fatal ("failed to execute shell command", (char *)NULL); - } - append_to_tagfile = TRUE; - } - - tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); - if (tagf == NULL) - pfatal (tagfile); - put_entries (head); - free_tree (head); - head = NULL; - fclose (tagf); - - if (update) - { - char cmd[BUFSIZ]; - sprintf (cmd, "sort %s -o %s", tagfile, tagfile); - exit (system (cmd)); - } - return GOOD; -} - - - -/* - * Return a compressor given the file name. - * Idea by Vladimir Alexiev - */ -compressor * -get_compressor_from_suffix (file) - char *file; -{ - compressor *compr; - char *suffix; - - suffix = etags_strrchr (file, '.'); - if (suffix == NULL) - return NULL; - suffix += 1; - for (compr = compressors; compr->suffix != NULL; compr++) - if (streq (compr->suffix, suffix)) - return compr; - return NULL; -} - - - -/* - * Return a language given the name. - */ -language * -get_language_from_name (name) - char *name; -{ - language *lang; - - if (name == NULL) - error ("empty language name", (char *)NULL); - else - { - for (lang = lang_names; lang->name != NULL; lang++) - if (streq (name, lang->name)) - return lang; - error ("unknown language \"%s\"", name); - } - - return NULL; -} - - -/* - * Return a language given the interpreter name. - */ -language * -get_language_from_interpreter (interpreter) - char *interpreter; -{ - language *lang; - char **iname; - - if (interpreter == NULL) - return NULL; - for (lang = lang_names; lang->name != NULL; lang++) - if (lang->interpreters != NULL) - for (iname = lang->interpreters; *iname != NULL; iname++) - if (streq (*iname, interpreter)) - return lang; - - return NULL; -} - - - -/* - * Return a language given the file name. - */ -language * -get_language_from_suffix (file) - char *file; -{ - language *lang; - char **ext, *suffix; - - suffix = etags_strrchr (file, '.'); - if (suffix == NULL) - return NULL; - suffix += 1; - for (lang = lang_names; lang->name != NULL; lang++) - if (lang->suffixes != NULL) - for (ext = lang->suffixes; *ext != NULL; ext++) - if (streq (*ext, suffix)) - return lang; - return NULL; -} - - - -/* - * This routine is called on each file argument. - */ -void -process_file (file) - char *file; -{ - struct stat stat_buf; - FILE *inf; - compressor *compr; - char *compressed_name, *uncompressed_name; - char *real_name; - - canonicalize_filename (file); - if (streq (file, tagfile) && !streq (tagfile, "-")) - { - error ("skipping inclusion of %s in self.", file); - return; - } - if ((compr = get_compressor_from_suffix (file)) == NULL) - { - compressed_name = NULL; - real_name = uncompressed_name = savestr (file); - } - else - { - real_name = compressed_name = savestr (file); - uncompressed_name = savenstr (file, strlen(file) - compr->sufflen - 1); - } - if (stat (real_name, &stat_buf) != 0) - { - /* Reset real_name and try with a different name. */ - real_name = NULL; - if (compressed_name != NULL) /* try with the given suffix */ - { - if (stat (uncompressed_name, &stat_buf) == 0) - real_name = uncompressed_name; - } - else /* try all possible suffixes */ - { - for (compr = compressors; compr->suffix != NULL; compr++) - { - compressed_name = concat (file, ".", compr->suffix); - if (stat (compressed_name, &stat_buf) != 0) - free (compressed_name); - else - { - real_name = compressed_name; - break; - } - } - } - if (real_name == NULL) - { - perror (file); - goto exit; - } - } /* try with a different name */ - - if (!S_ISREG (stat_buf.st_mode)) - { - error ("skipping %s: it is not a regular file.", real_name); - goto exit; - } - if (real_name == compressed_name) - { - char *cmd = concat (compr->command, " ", real_name); - inf = popen (cmd, "r"); - free (cmd); - } - else - inf = fopen (real_name, "r"); - if (inf == NULL) - { - perror (real_name); - goto exit; - } - - find_entries (uncompressed_name, inf); - - if (real_name == compressed_name) - pclose (inf); - else - fclose (inf); - - if (!CTAGS) - { - char *filename; - - if (filename_is_absolute (uncompressed_name)) - { - /* file is an absolute file name. Canonicalise it. */ - filename = absolute_filename (uncompressed_name, cwd); - } - else - { - /* file is a file name relative to cwd. Make it relative - to the directory of the tags file. */ - filename = relative_filename (uncompressed_name, tagfiledir); - } - fprintf (tagf, "\f\n%s,%d\n", filename, total_size_of_entries (head)); - free (filename); - put_entries (head); - free_tree (head); - head = NULL; - } - - exit: - if (compressed_name) free(compressed_name); - if (uncompressed_name) free(uncompressed_name); - return; -} - -/* - * This routine sets up the boolean pseudo-functions which work - * by setting boolean flags dependent upon the corresponding character. - * Every char which is NOT in that string is not a white char. Therefore, - * all of the array "_wht" is set to FALSE, and then the elements - * subscripted by the chars in "white" are set to TRUE. Thus "_wht" - * of a char is TRUE if it is the string "white", else FALSE. - */ -void -init () -{ - register char *sp; - register int i; - - for (i = 0; i < CHARS; i++) - iswhite(i) = notinname(i) = begtoken(i) = intoken(i) = endtoken(i) = FALSE; - for (sp = white; *sp != '\0'; sp++) iswhite (*sp) = TRUE; - for (sp = nonam; *sp != '\0'; sp++) notinname (*sp) = TRUE; - for (sp = begtk; *sp != '\0'; sp++) begtoken (*sp) = TRUE; - for (sp = midtk; *sp != '\0'; sp++) intoken (*sp) = TRUE; - for (sp = endtk; *sp != '\0'; sp++) endtoken (*sp) = TRUE; - iswhite('\0') = iswhite('\n'); - notinname('\0') = notinname('\n'); - begtoken('\0') = begtoken('\n'); - intoken('\0') = intoken('\n'); - endtoken('\0') = endtoken('\n'); -} - -/* - * This routine opens the specified file and calls the function - * which finds the function and type definitions. - */ -node *last_node = NULL; - -void -find_entries (file, inf) - char *file; - FILE *inf; -{ - char *cp; - language *lang; - node *old_last_node; - - /* Memory leakage here: the string pointed by curfile is - never released, because curfile is copied into np->file - for each node, to be used in CTAGS mode. The amount of - memory leaked here is the sum of the lengths of the - file names. */ - curfile = savestr (file); - - /* If user specified a language, use it. */ - lang = forced_lang; - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - return; - } - - /* Try to guess the language given the file name. */ - lang = get_language_from_suffix (file); - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - return; - } - - /* Look for sharp-bang as the first two characters. */ - if (readline_internal (&lb, inf) > 0 - && lb.len >= 2 - && lb.buffer[0] == '#' - && lb.buffer[1] == '!') - { - char *lp; - - /* Set lp to point at the first char after the last slash in the - line or, if no slashes, at the first nonblank. Then set cp to - the first successive blank and terminate the string. */ - lp = etags_strrchr (lb.buffer+2, '/'); - if (lp != NULL) - lp += 1; - else - lp = skip_spaces (lb.buffer + 2); - cp = skip_non_spaces (lp); - *cp = '\0'; - - if (strlen (lp) > 0) - { - lang = get_language_from_interpreter (lp); - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - return; - } - } - } - /* We rewind here, even if inf may be a pipe. We fail if the - length of the first line is longer than the pipe block size, - which is unlikely. */ - rewind (inf); - - /* Try Fortran. */ - old_last_node = last_node; - curlang = get_language_from_name ("fortran"); - Fortran_functions (inf); - - /* No Fortran entries found. Try C. */ - if (old_last_node == last_node) - { - /* We do not tag if rewind fails. - Only the file name will be recorded in the tags file. */ - rewind (inf); - curlang = get_language_from_name (cplusplus ? "c++" : "c"); - default_C_entries (inf); - } - return; -} - -/* Record a tag. */ -void -pfnote (name, is_func, linestart, linelen, lno, cno) - char *name; /* tag name, or NULL if unnamed */ - bool is_func; /* tag is a function */ - char *linestart; /* start of the line where tag is */ - int linelen; /* length of the line where tag is */ - int lno; /* line number */ - long cno; /* character number */ -{ - register node *np; - - if (CTAGS && name == NULL) - return; - - np = xnew (1, node); - - /* If ctags mode, change name "main" to M. */ - if (CTAGS && !cxref_style && streq (name, "main")) - { - register char *fp = etags_strrchr (curfile, '/'); - np->name = concat ("M", fp == NULL ? curfile : fp + 1, ""); - fp = etags_strrchr (np->name, '.'); - if (fp != NULL && fp[1] != '\0' && fp[2] == '\0') - fp[0] = '\0'; - } - else - np->name = name; - np->been_warned = FALSE; - np->file = curfile; - np->is_func = is_func; - np->lno = lno; - /* Our char numbers are 0-base, because of C language tradition? - ctags compatibility? old versions compatibility? I don't know. - Anyway, since emacs's are 1-base we expect etags.el to take care - of the difference. If we wanted to have 1-based numbers, we would - uncomment the +1 below. */ - np->cno = cno /* + 1 */ ; - np->left = np->right = NULL; - if (CTAGS && !cxref_style) - { - if (strlen (linestart) < 50) - np->pat = concat (linestart, "$", ""); - else - np->pat = savenstr (linestart, 50); - } - else - np->pat = savenstr (linestart, linelen); - - add_node (np, &head); -} - -/* Date: Wed, 22 Jan 1997 02:56:31 -0500 [last amended 18 Sep 1997] - * From: Sam Kendall - * Subject: Proposal for firming up the TAGS format specification - * To: F.Potorti@cnuce.cnr.it - * - * pfnote should emit the optimized form [unnamed tag] only if: - * 1. name does not contain any of the characters " \t\r\n(),;"; - * 2. linestart contains name as either a rightmost, or rightmost but - * one character, substring; - * 3. the character, if any, immediately before name in linestart must - * be one of the characters " \t(),;"; - * 4. the character, if any, immediately after name in linestart must - * also be one of the characters " \t(),;". - * - * The real implementation uses the notinname() macro, which recognises - * characters slightly different form " \t\r\n(),;". See the variable - * `nonam'. - */ -#define traditional_tag_style TRUE -void -new_pfnote (name, namelen, is_func, linestart, linelen, lno, cno) - char *name; /* tag name, or NULL if unnamed */ - int namelen; /* tag length */ - bool is_func; /* tag is a function */ - char *linestart; /* start of the line where tag is */ - int linelen; /* length of the line where tag is */ - int lno; /* line number */ - long cno; /* character number */ -{ - register char *cp; - bool named; - - named = TRUE; - if (!CTAGS) - { - for (cp = name; !notinname (*cp); cp++) - continue; - if (*cp == '\0') /* rule #1 */ - { - cp = linestart + linelen - namelen; - if (notinname (linestart[linelen-1])) - cp -= 1; /* rule #4 */ - if (cp >= linestart /* rule #2 */ - && (cp == linestart - || notinname (cp[-1])) /* rule #3 */ - && strneq (name, cp, namelen)) /* rule #2 */ - named = FALSE; /* use unnamed tag */ - } - } - - if (named) - name = savenstr (name, namelen); - else - name = NULL; - pfnote (name, is_func, linestart, linelen, lno, cno); -} - -/* - * free_tree () - * recurse on left children, iterate on right children. - */ -void -free_tree (np) - register node *np; -{ - while (np) - { - register node *node_right = np->right; - free_tree (np->left); - if (np->name != NULL) - free (np->name); - free (np->pat); - free (np); - np = node_right; - } -} - -/* - * add_node () - * Adds a node to the tree of nodes. In etags mode, we don't keep - * it sorted; we just keep a linear list. In ctags mode, maintain - * an ordered tree, with no attempt at balancing. - * - * add_node is the only function allowed to add nodes, so it can - * maintain state. - */ -void -add_node (np, cur_node_p) - node *np, **cur_node_p; -{ - register int dif; - register node *cur_node = *cur_node_p; - - if (cur_node == NULL) - { - *cur_node_p = np; - last_node = np; - return; - } - - if (!CTAGS) - { - /* Etags Mode */ - if (last_node == NULL) - fatal ("internal error in add_node", (char *)NULL); - last_node->right = np; - last_node = np; - } - else - { - /* Ctags Mode */ - dif = strcmp (np->name, cur_node->name); - - /* - * If this tag name matches an existing one, then - * do not add the node, but maybe print a warning. - */ - if (!dif) - { - if (streq (np->file, cur_node->file)) - { - if (!no_warnings) - { - fprintf (stderr, "Duplicate entry in file %s, line %d: %s\n", - np->file, lineno, np->name); - fprintf (stderr, "Second entry ignored\n"); - } - } - else if (!cur_node->been_warned && !no_warnings) - { - fprintf - (stderr, - "Duplicate entry in files %s and %s: %s (Warning only)\n", - np->file, cur_node->file, np->name); - cur_node->been_warned = TRUE; - } - return; - } - - /* Actually add the node */ - add_node (np, dif < 0 ? &cur_node->left : &cur_node->right); - } -} - -void -put_entries (np) - register node *np; -{ - register char *sp; - - if (np == NULL) - return; - - /* Output subentries that precede this one */ - put_entries (np->left); - - /* Output this entry */ - - if (!CTAGS) - { - if (np->name != NULL) - fprintf (tagf, "%s\177%s\001%d,%ld\n", - np->pat, np->name, np->lno, np->cno); - else - fprintf (tagf, "%s\177%d,%ld\n", - np->pat, np->lno, np->cno); - } - else - { - if (np->name == NULL) - error ("internal error: NULL name in ctags mode.", (char *)NULL); - - if (cxref_style) - { - if (vgrind_style) - fprintf (stdout, "%s %s %d\n", - np->name, np->file, (np->lno + 63) / 64); - else - fprintf (stdout, "%-16s %3d %-16s %s\n", - np->name, np->lno, np->file, np->pat); - } - else - { - fprintf (tagf, "%s\t%s\t", np->name, np->file); - - if (np->is_func) - { /* a function */ - putc (searchar, tagf); - putc ('^', tagf); - - for (sp = np->pat; *sp; sp++) - { - if (*sp == '\\' || *sp == searchar) - putc ('\\', tagf); - putc (*sp, tagf); - } - putc (searchar, tagf); - } - else - { /* a typedef; text pattern inadequate */ - fprintf (tagf, "%d", np->lno); - } - putc ('\n', tagf); - } - } - - /* Output subentries that follow this one */ - put_entries (np->right); -} - -/* Length of a number's decimal representation. */ -int -number_len (num) - long num; -{ - int len = 1; - while ((num /= 10) > 0) - len += 1; - return len; -} - -/* - * Return total number of characters that put_entries will output for - * the nodes in the subtree of the specified node. Works only if - * we are not ctags, but called only in that case. This count - * is irrelevant with the new tags.el, but is still supplied for - * backward compatibility. - */ -int -total_size_of_entries (np) - register node *np; -{ - register int total; - - if (np == NULL) - return 0; - - for (total = 0; np != NULL; np = np->right) - { - /* Count left subentries. */ - total += total_size_of_entries (np->left); - - /* Count this entry */ - total += strlen (np->pat) + 1; - total += number_len ((long) np->lno) + 1 + number_len (np->cno) + 1; - if (np->name != NULL) - total += 1 + strlen (np->name); /* \001name */ - } - - return total; -} - -/* - * The C symbol tables. - */ -enum sym_type -{ - st_none, - st_C_objprot, st_C_objimpl, st_C_objend, - st_C_gnumacro, - st_C_ignore, - st_C_javastruct, - st_C_operator, - st_C_struct, st_C_enum, st_C_define, st_C_typedef, st_C_typespec -}; - -/* Feed stuff between (but not including) %[ and %] lines to: - gperf -c -k 1,3 -o -p -r -t -%[ -struct C_stab_entry { char *name; int c_ext; enum sym_type type; } -%% -@interface, 0, st_C_objprot -@protocol, 0, st_C_objprot -@implementation,0, st_C_objimpl -@end, 0, st_C_objend -import, C_JAVA, st_C_ignore -package, C_JAVA, st_C_ignore -friend, C_PLPL, st_C_ignore -extends, C_JAVA, st_C_javastruct -implements, C_JAVA, st_C_javastruct -interface, C_JAVA, st_C_struct -class, C_PLPL, st_C_struct -namespace, C_PLPL, st_C_struct -domain, C_STAR, st_C_struct -union, 0, st_C_struct -struct, 0, st_C_struct -enum, 0, st_C_enum -typedef, 0, st_C_typedef -define, 0, st_C_define -operator, C_PLPL, st_C_operator -bool, C_PLPL, st_C_typespec -long, 0, st_C_typespec -short, 0, st_C_typespec -int, 0, st_C_typespec -char, 0, st_C_typespec -float, 0, st_C_typespec -double, 0, st_C_typespec -signed, 0, st_C_typespec -unsigned, 0, st_C_typespec -auto, 0, st_C_typespec -void, 0, st_C_typespec -extern, 0, st_C_typespec -static, 0, st_C_typespec -const, 0, st_C_typespec -volatile, 0, st_C_typespec -explicit, C_PLPL, st_C_typespec -mutable, C_PLPL, st_C_typespec -typename, C_PLPL, st_C_typespec -# DEFUN used in emacs, the next three used in glibc (SYSCALL only for mach). -DEFUN, 0, st_C_gnumacro -SYSCALL, 0, st_C_gnumacro -ENTRY, 0, st_C_gnumacro -PSEUDO, 0, st_C_gnumacro -# These are defined inside C functions, so currently they are not met. -# EXFUN used in glibc, DEFVAR_* in emacs. -#EXFUN, 0, st_C_gnumacro -#DEFVAR_, 0, st_C_gnumacro -%] -and replace lines between %< and %> with its output. */ -/*%<*/ -/* C code produced by gperf version 2.5 (GNU C++ version) */ -/* Command-line: gperf -c -k 1,3 -o -p -r -t */ -struct C_stab_entry { char *name; int c_ext; enum sym_type type; }; - -#define TOTAL_KEYWORDS 41 -#define MIN_WORD_LENGTH 3 -#define MAX_WORD_LENGTH 15 -#define MIN_HASH_VALUE 20 -#define MAX_HASH_VALUE 136 -/* maximum key range = 117, duplicates = 0 */ - -static unsigned int -hash (str, len) - register char *str; - register int unsigned len; -{ - static unsigned char asso_values[] = - { - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 58, 137, 137, 137, 38, 37, - 45, 137, 137, 137, 137, 137, 137, 137, 137, 137, - 62, 137, 137, 14, 16, 137, 137, 137, 137, 137, - 137, 137, 137, 137, 137, 137, 137, 26, 16, 51, - 18, 61, 5, 19, 137, 23, 137, 137, 32, 63, - 54, 10, 26, 137, 24, 42, 30, 18, 46, 137, - 137, 137, 137, 137, 137, 137, 137, 137, - }; - return len + asso_values[str[2]] + asso_values[str[0]]; -} - -struct C_stab_entry * -in_word_set (str, len) - register char *str; - register unsigned int len; -{ - static struct C_stab_entry wordlist[] = - { - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, - {"float", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"define", 0, st_C_define}, - {"bool", C_PLPL, st_C_typespec}, - {"",}, {"",}, {"",}, - {"friend", C_PLPL, st_C_ignore}, - {"SYSCALL", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"double", 0, st_C_typespec}, - {"",}, {"",}, {"",}, - {"union", 0, st_C_struct}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"import", C_JAVA, st_C_ignore}, - {"int", 0, st_C_typespec}, - {"short", 0, st_C_typespec}, - {"ENTRY", 0, st_C_gnumacro}, - {"implements", C_JAVA, st_C_javastruct}, - {"auto", 0, st_C_typespec}, - {"",}, - {"interface", C_JAVA, st_C_struct}, - {"typedef", 0, st_C_typedef}, - {"typename", C_PLPL, st_C_typespec}, - {"",}, {"",}, - {"signed", 0, st_C_typespec}, - {"unsigned", 0, st_C_typespec}, - {"",}, {"",}, {"",}, - {"struct", 0, st_C_struct}, - {"void", 0, st_C_typespec}, - {"static", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, - {"operator", C_PLPL, st_C_operator}, - {"",}, - {"char", 0, st_C_typespec}, - {"class", C_PLPL, st_C_struct}, - {"enum", 0, st_C_enum}, - {"package", C_JAVA, st_C_ignore}, - {"",}, - {"volatile", 0, st_C_typespec}, - {"domain", C_STAR, st_C_struct}, - {"DEFUN", 0, st_C_gnumacro}, - {"",}, - {"long", 0, st_C_typespec}, - {"@protocol", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"explicit", C_PLPL, st_C_typespec}, - {"",}, - {"extern", 0, st_C_typespec}, - {"extends", C_JAVA, st_C_javastruct}, - {"",}, - {"mutable", C_PLPL, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, - {"PSEUDO", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, {"",}, - {"const", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"@end", 0, st_C_objend}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"@interface", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"namespace", C_PLPL, st_C_struct}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"@implementation", 0, st_C_objimpl}, - }; - - if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH) - { - register int key = hash (str, len); - - if (key <= MAX_HASH_VALUE && key >= 0) - { - register char *s = wordlist[key].name; - - if (*s == *str && !strncmp (str + 1, s + 1, len - 1)) - return &wordlist[key]; - } - } - return 0; -} -/*%>*/ - -enum sym_type -C_symtype (str, len, c_ext) - char *str; - int len; - int c_ext; -{ - register struct C_stab_entry *se = in_word_set (str, len); - - if (se == NULL || (se->c_ext && !(c_ext & se->c_ext))) - return st_none; - return se->type; -} - - /* - * C functions and variables are recognized using a simple - * finite automaton. fvdef is its state variable. - */ -enum -{ - fvnone, /* nothing seen */ - foperator, /* func: operator keyword seen (cplpl) */ - fvnameseen, /* function or variable name seen */ - fstartlist, /* func: just after open parenthesis */ - finlist, /* func: in parameter list */ - flistseen, /* func: after parameter list */ - fignore, /* func: before open brace */ - vignore /* var-like: ignore until ';' */ -} fvdef; - - - /* - * typedefs are recognized using a simple finite automaton. - * typdef is its state variable. - */ -enum -{ - tnone, /* nothing seen */ - ttypedseen, /* typedef keyword seen */ - tinbody, /* inside typedef body */ - tend, /* just before typedef tag */ - tignore /* junk after typedef tag */ -} typdef; - - - /* - * struct-like structures (enum, struct and union) are recognized - * using another simple finite automaton. `structdef' is its state - * variable. - */ -enum -{ - snone, /* nothing seen yet */ - skeyseen, /* struct-like keyword seen */ - stagseen, /* struct-like tag seen */ - scolonseen, /* colon seen after struct-like tag */ - sinbody /* in struct body: recognize member func defs*/ -} structdef; - -/* - * When structdef is stagseen, scolonseen, or sinbody, structtag is the - * struct tag, and structtype is the type of the preceding struct-like - * keyword. - */ -char *structtag = ""; -enum sym_type structtype; - -/* - * When objdef is different from onone, objtag is the name of the class. - */ -char *objtag = ""; - -/* - * Yet another little state machine to deal with preprocessor lines. - */ -enum -{ - dnone, /* nothing seen */ - dsharpseen, /* '#' seen as first char on line */ - ddefineseen, /* '#' and 'define' seen */ - dignorerest /* ignore rest of line */ -} definedef; - -/* - * State machine for Objective C protocols and implementations. - * Tom R.Hageman - */ -enum -{ - onone, /* nothing seen */ - oprotocol, /* @interface or @protocol seen */ - oimplementation, /* @implementations seen */ - otagseen, /* class name seen */ - oparenseen, /* parenthesis before category seen */ - ocatseen, /* category name seen */ - oinbody, /* in @implementation body */ - omethodsign, /* in @implementation body, after +/- */ - omethodtag, /* after method name */ - omethodcolon, /* after method colon */ - omethodparm, /* after method parameter */ - oignore /* wait for @end */ -} objdef; - - -/* - * Use this structure to keep info about the token read, and how it - * should be tagged. Used by the make_C_tag function to build a tag. - */ -typedef struct -{ - bool valid; - char *str; - bool named; - int linelen; - int lineno; - long linepos; - char *buffer; -} token; - -token tok; /* latest token read */ - -/* - * Set this to TRUE, and the next token considered is called a function. - * Used only for GNU emacs's function-defining macros. - */ -bool next_token_is_func; - -/* - * TRUE in the rules part of a yacc file, FALSE outside (parse as C). - */ -bool yacc_rules; - -/* - * methodlen is the length of the method name stored in token_name. - */ -int methodlen; - -/* - * consider_token () - * checks to see if the current token is at the start of a - * function or variable, or corresponds to a typedef, or - * is a struct/union/enum tag, or #define, or an enum constant. - * - * *IS_FUNC gets TRUE iff the token is a function or #define macro - * with args. C_EXT is which language we are looking at. - * - * Globals - * fvdef IN OUT - * structdef IN OUT - * definedef IN OUT - * typdef IN OUT - * objdef IN OUT - * next_token_is_func IN OUT - */ - -bool -consider_token (str, len, c, c_ext, cblev, parlev, is_func_or_var) - register char *str; /* IN: token pointer */ - register int len; /* IN: token length */ - register char c; /* IN: first char after the token */ - int c_ext; /* IN: C extensions mask */ - int cblev; /* IN: curly brace level */ - int parlev; /* IN: parenthesis level */ - bool *is_func_or_var; /* OUT: function or variable found */ -{ - enum sym_type toktype = C_symtype (str, len, c_ext); - - /* - * Advance the definedef state machine. - */ - switch (definedef) - { - case dnone: - /* We're not on a preprocessor line. */ - break; - case dsharpseen: - if (toktype == st_C_define) - { - definedef = ddefineseen; - } - else - { - definedef = dignorerest; - } - return FALSE; - case ddefineseen: - /* - * Make a tag for any macro, unless it is a constant - * and constantypedefs is FALSE. - */ - definedef = dignorerest; - *is_func_or_var = (c == '('); - if (!*is_func_or_var && !constantypedefs) - return FALSE; - else - return TRUE; - case dignorerest: - return FALSE; - default: - error ("internal error: definedef value.", (char *)NULL); - } - - /* - * Now typedefs - */ - switch (typdef) - { - case tnone: - if (toktype == st_C_typedef) - { - if (typedefs) - typdef = ttypedseen; - fvdef = fvnone; - return FALSE; - } - break; - case ttypedseen: - switch (toktype) - { - case st_none: - case st_C_typespec: - typdef = tend; - break; - case st_C_struct: - case st_C_enum: - break; - } - /* Do not return here, so the structdef stuff has a chance. */ - break; - case tend: - switch (toktype) - { - case st_C_typespec: - case st_C_struct: - case st_C_enum: - return FALSE; - } - return TRUE; - } - - /* - * This structdef business is currently only invoked when cblev==0. - * It should be recursively invoked whatever the curly brace level, - * and a stack of states kept, to allow for definitions of structs - * within structs. - * - * This structdef business is NOT invoked when we are ctags and the - * file is plain C. This is because a struct tag may have the same - * name as another tag, and this loses with ctags. - */ - switch (toktype) - { - case st_C_javastruct: - if (structdef == stagseen) - structdef = scolonseen; - return FALSE; - case st_C_struct: - case st_C_enum: - if (typdef == ttypedseen - || (typedefs_and_cplusplus && cblev == 0 && structdef == snone)) - { - structdef = skeyseen; - structtype = toktype; - } - return FALSE; - } - - if (structdef == skeyseen) - { - /* Save the tag for struct/union/class, for functions and variables - that may be defined inside. */ - if (structtype == st_C_struct) - structtag = savenstr (str, len); - else - structtag = ""; - structdef = stagseen; - return TRUE; - } - - /* Avoid entering fvdef stuff if typdef is going on. */ - if (typdef != tnone) - { - definedef = dnone; - return FALSE; - } - - /* Detect GNU macros. - - DEFUN note for writers of emacs C code: - The DEFUN macro, used in emacs C source code, has a first arg - that is a string (the lisp function name), and a second arg that - is a C function name. Since etags skips strings, the second arg - is tagged. This is unfortunate, as it would be better to tag the - first arg. The simplest way to deal with this problem would be - to name the tag with a name built from the function name, by - removing the initial 'F' character and substituting '-' for '_'. - Anyway, this assumes that the conventions of naming lisp - functions will never change. Currently, this method is not - implemented, so writers of emacs code are recommended to put the - first two args of a DEFUN on the same line. */ - if (definedef == dnone && toktype == st_C_gnumacro) - { - next_token_is_func = TRUE; - return FALSE; - } - if (next_token_is_func) - { - next_token_is_func = FALSE; - fvdef = fignore; - *is_func_or_var = TRUE; - return TRUE; - } - - /* Detect Objective C constructs. */ - switch (objdef) - { - case onone: - switch (toktype) - { - case st_C_objprot: - objdef = oprotocol; - return FALSE; - case st_C_objimpl: - objdef = oimplementation; - return FALSE; - } - break; - case oimplementation: - /* Save the class tag for functions or variables defined inside. */ - objtag = savenstr (str, len); - objdef = oinbody; - return FALSE; - case oprotocol: - /* Save the class tag for categories. */ - objtag = savenstr (str, len); - objdef = otagseen; - *is_func_or_var = TRUE; - return TRUE; - case oparenseen: - objdef = ocatseen; - *is_func_or_var = TRUE; - return TRUE; - case oinbody: - break; - case omethodsign: - if (parlev == 0) - { - objdef = omethodtag; - methodlen = len; - grow_linebuffer (&token_name, methodlen + 1); - strncpy (token_name.buffer, str, len); - token_name.buffer[methodlen] = '\0'; - token_name.len = methodlen; - return TRUE; - } - return FALSE; - case omethodcolon: - if (parlev == 0) - objdef = omethodparm; - return FALSE; - case omethodparm: - if (parlev == 0) - { - objdef = omethodtag; - methodlen += len; - grow_linebuffer (&token_name, methodlen + 1); - strncat (token_name.buffer, str, len); - token_name.len = methodlen; - return TRUE; - } - return FALSE; - case oignore: - if (toktype == st_C_objend) - { - /* Memory leakage here: the string pointed by objtag is - never released, because many tests would be needed to - avoid breaking on incorrect input code. The amount of - memory leaked here is the sum of the lengths of the - class tags. - free (objtag); */ - objdef = onone; - } - return FALSE; - } - - /* A function, variable or enum constant? */ - switch (toktype) - { - case st_C_typespec: - if (fvdef != finlist && fvdef != fignore && fvdef != vignore) - fvdef = fvnone; /* should be useless */ - return FALSE; - case st_C_ignore: - fvdef = vignore; - return FALSE; - case st_C_operator: - fvdef = foperator; - *is_func_or_var = TRUE; - return TRUE; - case st_none: - if (constantypedefs && structdef == sinbody && structtype == st_C_enum) - return TRUE; - if (fvdef == fvnone) - { - fvdef = fvnameseen; /* function or variable */ - *is_func_or_var = TRUE; - return TRUE; - } - } - - return FALSE; -} - -/* - * C_entries () - * This routine finds functions, variables, typedefs, - * #define's, enum constants and struct/union/enum definitions in - * #C syntax and adds them to the list. - */ -#define current_lb_is_new (newndx == curndx) -#define switch_line_buffers() (curndx = 1 - curndx) - -#define curlb (lbs[curndx].lb) -#define othlb (lbs[1-curndx].lb) -#define newlb (lbs[newndx].lb) -#define curlinepos (lbs[curndx].linepos) -#define othlinepos (lbs[1-curndx].linepos) -#define newlinepos (lbs[newndx].linepos) - -#define CNL_SAVE_DEFINEDEF() \ -do { \ - curlinepos = charno; \ - lineno++; \ - linecharno = charno; \ - charno += readline (&curlb, inf); \ - lp = curlb.buffer; \ - quotednl = FALSE; \ - newndx = curndx; \ -} while (0) - -#define CNL() \ -do { \ - CNL_SAVE_DEFINEDEF(); \ - if (savetok.valid) \ - { \ - tok = savetok; \ - savetok.valid = FALSE; \ - } \ - definedef = dnone; \ -} while (0) - - -void -make_C_tag (isfun) - bool isfun; -{ - /* This function should never be called when tok.valid is FALSE, but - we must protect against invalid input or internal errors. */ - if (tok.valid) - { - if (traditional_tag_style) - { - /* This was the original code. Now we call new_pfnote instead, - which uses the new method for naming tags (see new_pfnote). */ - char *name = NULL; - - if (CTAGS || tok.named) - name = savestr (token_name.buffer); - pfnote (name, isfun, - tok.buffer, tok.linelen, tok.lineno, tok.linepos); - } - else - new_pfnote (token_name.buffer, token_name.len, isfun, - tok.buffer, tok.linelen, tok.lineno, tok.linepos); - tok.valid = FALSE; - } - else if (DEBUG) - abort (); -} - - -void -C_entries (c_ext, inf) - int c_ext; /* extension of C */ - FILE *inf; /* input file */ -{ - register char c; /* latest char read; '\0' for end of line */ - register char *lp; /* pointer one beyond the character `c' */ - int curndx, newndx; /* indices for current and new lb */ - register int tokoff; /* offset in line of start of current token */ - register int toklen; /* length of current token */ - char *qualifier; /* string used to qualify names */ - int qlen; /* length of qualifier */ - int cblev; /* current curly brace level */ - int parlev; /* current parenthesis level */ - bool incomm, inquote, inchar, quotednl, midtoken; - bool cplpl, cjava; - token savetok; /* token saved during preprocessor handling */ - - - tokoff = toklen = 0; /* keep compiler quiet */ - curndx = newndx = 0; - lineno = 0; - charno = 0; - lp = curlb.buffer; - *lp = 0; - - fvdef = fvnone; typdef = tnone; structdef = snone; - definedef = dnone; objdef = onone; - next_token_is_func = yacc_rules = FALSE; - midtoken = inquote = inchar = incomm = quotednl = FALSE; - tok.valid = savetok.valid = FALSE; - cblev = 0; - parlev = 0; - cplpl = (c_ext & C_PLPL) == C_PLPL; - cjava = (c_ext & C_JAVA) == C_JAVA; - if (cjava) - { qualifier = "."; qlen = 1; } - else - { qualifier = "::"; qlen = 2; } - - while (!feof (inf)) - { - c = *lp++; - if (c == '\\') - { - /* If we're at the end of the line, the next character is a - '\0'; don't skip it, because it's the thing that tells us - to read the next line. */ - if (*lp == '\0') - { - quotednl = TRUE; - continue; - } - lp++; - c = ' '; - } - else if (incomm) - { - switch (c) - { - case '*': - if (*lp == '/') - { - c = *lp++; - incomm = FALSE; - } - break; - case '\0': - /* Newlines inside comments do not end macro definitions in - traditional cpp. */ - CNL_SAVE_DEFINEDEF (); - break; - } - continue; - } - else if (inquote) - { - switch (c) - { - case '"': - inquote = FALSE; - break; - case '\0': - /* Newlines inside strings do not end macro definitions - in traditional cpp, even though compilers don't - usually accept them. */ - CNL_SAVE_DEFINEDEF (); - break; - } - continue; - } - else if (inchar) - { - switch (c) - { - case '\0': - /* Hmmm, something went wrong. */ - CNL (); - /* FALLTHRU */ - case '\'': - inchar = FALSE; - break; - } - continue; - } - else - switch (c) - { - case '"': - inquote = TRUE; - if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; - continue; - case '\'': - inchar = TRUE; - if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; - continue; - case '/': - if (*lp == '*') - { - lp++; - incomm = TRUE; - continue; - } - else if (/* cplpl && */ *lp == '/') - { - c = '\0'; - break; - } - else - break; - case '%': - if ((c_ext & YACC) && *lp == '%') - { - /* entering or exiting rules section in yacc file */ - lp++; - definedef = dnone; fvdef = fvnone; - typdef = tnone; structdef = snone; - next_token_is_func = FALSE; - midtoken = inquote = inchar = incomm = quotednl = FALSE; - cblev = 0; - yacc_rules = !yacc_rules; - continue; - } - else - break; - case '#': - if (definedef == dnone) - { - char *cp; - bool cpptoken = TRUE; - - /* Look back on this line. If all blanks, or nonblanks - followed by an end of comment, this is a preprocessor - token. */ - for (cp = newlb.buffer; cp < lp-1; cp++) - if (!iswhite (*cp)) - { - if (*cp == '*' && *(cp+1) == '/') - { - cp++; - cpptoken = TRUE; - } - else - cpptoken = FALSE; - } - if (cpptoken) - definedef = dsharpseen; - } /* if (definedef == dnone) */ - - continue; - } /* switch (c) */ - - - /* Consider token only if some complicated conditions are satisfied. */ - if ((definedef != dnone - || (cblev == 0 && structdef != scolonseen) - || (cblev == 1 && cplpl && structdef == sinbody) - || (structdef == sinbody && structtype == st_C_enum)) - && typdef != tignore - && definedef != dignorerest - && fvdef != finlist) - { - if (midtoken) - { - if (endtoken (c)) - { - if (c == ':' && cplpl && *lp == ':' && begtoken(*(lp + 1))) - { - /* - * This handles :: in the middle, but not at the - * beginning of an identifier. - */ - lp += 2; - toklen += 3; - } - else - { - bool funorvar = FALSE; - - if (yacc_rules - || consider_token (newlb.buffer + tokoff, toklen, c, - c_ext, cblev, parlev, &funorvar)) - { - tok.named = FALSE; - if (structdef == sinbody - && definedef == dnone - && funorvar) - /* function or var defined in C++ class body */ - { - int len; - if (fvdef == foperator) - { - char *oldlp = lp; - lp = skip_spaces (lp-1); - while (*lp != '\0' - && !isspace (*lp) && *lp != '(') - lp += 1; - c = *lp++; - toklen += lp - oldlp; - } - - len = strlen (structtag) + qlen + toklen; - grow_linebuffer (&token_name, len + 1); - strcpy (token_name.buffer, structtag); - strcat (token_name.buffer, qualifier); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - token_name.len = len; - tok.named = TRUE; - } - else if (objdef == ocatseen) - /* Objective C category */ - { - int len = strlen (objtag) + 2 + toklen; - grow_linebuffer (&token_name, len + 1); - strcpy (token_name.buffer, objtag); - strcat (token_name.buffer, "("); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - strcat (token_name.buffer, ")"); - token_name.len = len; - tok.named = TRUE; - } - else if (objdef == omethodtag - || objdef == omethodparm) - /* Objective C method */ - { - tok.named = TRUE; - } - else - { - grow_linebuffer (&token_name, toklen + 1); - strncpy (token_name.buffer, - newlb.buffer + tokoff, toklen); - token_name.buffer[toklen] = '\0'; - token_name.len = toklen; - /* Name macros. */ - tok.named = (structdef == stagseen - || typdef == tend - || (funorvar - && definedef == dignorerest)); - } - tok.lineno = lineno; - tok.linelen = tokoff + toklen + 1; - tok.buffer = newlb.buffer; - tok.linepos = newlinepos; - tok.valid = TRUE; - - if (definedef == dnone - && (fvdef == fvnameseen - || fvdef == foperator - || structdef == stagseen - || typdef == tend - || objdef != onone)) - { - if (current_lb_is_new) - switch_line_buffers (); - } - else - make_C_tag (funorvar); - } - midtoken = FALSE; - } - } /* if (endtoken (c)) */ - else if (intoken (c)) - { - toklen++; - continue; - } - } /* if (midtoken) */ - else if (begtoken (c)) - { - switch (definedef) - { - case dnone: - switch (fvdef) - { - case fstartlist: - fvdef = finlist; - continue; - case flistseen: - make_C_tag (TRUE); /* a function */ - fvdef = fignore; - break; - case fvnameseen: - fvdef = fvnone; - break; - } - if (structdef == stagseen && !cjava) - structdef = snone; - break; - case dsharpseen: - savetok = tok; - } - if (!yacc_rules || lp == newlb.buffer + 1) - { - tokoff = lp - 1 - newlb.buffer; - toklen = 1; - midtoken = TRUE; - } - continue; - } /* if (begtoken) */ - } /* if must look at token */ - - - /* Detect end of line, colon, comma, semicolon and various braces - after having handled a token.*/ - switch (c) - { - case ':': - if (definedef != dnone) - break; - switch (objdef) - { - case otagseen: - objdef = oignore; - make_C_tag (TRUE); /* an Objective C class */ - break; - case omethodtag: - case omethodparm: - objdef = omethodcolon; - methodlen += 1; - grow_linebuffer (&token_name, methodlen + 1); - strcat (token_name.buffer, ":"); - token_name.len = methodlen; - break; - } - if (structdef == stagseen) - structdef = scolonseen; - else - switch (fvdef) - { - case fvnameseen: - if (yacc_rules) - { - make_C_tag (FALSE); /* a yacc function */ - fvdef = fignore; - } - break; - case fstartlist: - fvdef = fvnone; - break; - } - break; - case ';': - if (definedef != dnone) - break; - if (cblev == 0) - switch (typdef) - { - case tend: - make_C_tag (FALSE); /* a typedef */ - /* FALLTHRU */ - default: - typdef = tnone; - } - switch (fvdef) - { - case fignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ - /* FALLTHRU */ - default: - fvdef = fvnone; - /* The following instruction invalidates the token. - Probably the token should be invalidated in all - other cases where some state machine is reset. */ - tok.valid = FALSE; - } - if (structdef == stagseen) - structdef = snone; - break; - case ',': - if (definedef != dnone) - break; - switch (objdef) - { - case omethodtag: - case omethodparm: - make_C_tag (TRUE); /* an Objective C method */ - objdef = oinbody; - break; - } - switch (fvdef) - { - case foperator: - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ - break; - default: - fvdef = fvnone; - } - if (structdef == stagseen) - structdef = snone; - break; - case '[': - if (definedef != dnone) - break; - if (cblev == 0 && typdef == tend) - { - typdef = tignore; - make_C_tag (FALSE); /* a typedef */ - break; - } - switch (fvdef) - { - case foperator: - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ - /* FALLTHRU */ - default: - fvdef = fvnone; - } - if (structdef == stagseen) - structdef = snone; - break; - case '(': - if (definedef != dnone) - break; - if (objdef == otagseen && parlev == 0) - objdef = oparenseen; - switch (fvdef) - { - case fvnone: - switch (typdef) - { - case ttypedseen: - case tend: - if (tok.valid && *lp != '*') - { - /* This handles constructs like: - typedef void OperatorFun (int fun); */ - make_C_tag (FALSE); - typdef = tignore; - } - break; - } /* switch (typdef) */ - break; - case foperator: /* operator() is not handled */ - case fvnameseen: - fvdef = fstartlist; - break; - case flistseen: - fvdef = finlist; - break; - } - parlev++; - break; - case ')': - if (definedef != dnone) - break; - if (objdef == ocatseen && parlev == 1) - { - make_C_tag (TRUE); /* an Objective C category */ - objdef = oignore; - } - if (--parlev == 0) - { - switch (fvdef) - { - case fstartlist: - case finlist: - fvdef = flistseen; - break; - } - if (cblev == 0 && typdef == tend) - { - typdef = tignore; - make_C_tag (FALSE); /* a typedef */ - } - } - else if (parlev < 0) /* can happen due to ill-conceived #if's. */ - parlev = 0; - break; - case '{': - if (definedef != dnone) - break; - if (typdef == ttypedseen) - typdef = tinbody; - switch (structdef) - { - case skeyseen: /* unnamed struct */ - structdef = sinbody; - structtag = "_anonymous_"; - break; - case stagseen: - case scolonseen: /* named struct */ - structdef = sinbody; - make_C_tag (FALSE); /* a struct */ - break; - } - switch (fvdef) - { - case flistseen: - make_C_tag (TRUE); /* a function */ - /* FALLTHRU */ - case fignore: - fvdef = fvnone; - break; - case fvnone: - switch (objdef) - { - case otagseen: - make_C_tag (TRUE); /* an Objective C class */ - objdef = oignore; - break; - case omethodtag: - case omethodparm: - make_C_tag (TRUE); /* an Objective C method */ - objdef = oinbody; - break; - default: - /* Neutralize `extern "C" {' grot. */ - if (cblev == 0 && structdef == snone && typdef == tnone) - cblev = -1; - } - } - cblev++; - break; - case '*': - if (definedef != dnone) - break; - if (fvdef == fstartlist) - fvdef = fvnone; /* avoid tagging `foo' in `foo (*bar()) ()' */ - break; - case '}': - if (definedef != dnone) - break; - if (!noindentypedefs && lp == newlb.buffer + 1) - { - cblev = 0; /* reset curly brace level if first column */ - parlev = 0; /* also reset paren level, just in case... */ - } - else if (cblev > 0) - cblev--; - if (cblev == 0) - { - if (typdef == tinbody) - typdef = tend; - /* Memory leakage here: the string pointed by structtag is - never released, because I fear to miss something and - break things while freeing the area. The amount of - memory leaked here is the sum of the lengths of the - struct tags. - if (structdef == sinbody) - free (structtag); */ - - structdef = snone; - structtag = ""; - } - break; - case '=': - if (definedef != dnone) - break; - switch (fvdef) - { - case foperator: - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ - /* FALLTHRU */ - default: - fvdef = vignore; - } - break; - case '+': - case '-': - if (objdef == oinbody && cblev == 0) - { - objdef = omethodsign; - break; - } - /* FALLTHRU */ - case '#': case '~': case '&': case '%': case '/': case '|': - case '^': case '!': case '<': case '>': case '.': case '?': case ']': - if (definedef != dnone) - break; - /* These surely cannot follow a function tag in C. */ - switch (fvdef) - { - case foperator: - case finlist: - case fignore: - case vignore: - break; - default: - fvdef = fvnone; - } - break; - case '\0': - if (objdef == otagseen) - { - make_C_tag (TRUE); /* an Objective C class */ - objdef = oignore; - } - /* If a macro spans multiple lines don't reset its state. */ - if (quotednl) - CNL_SAVE_DEFINEDEF (); - else - CNL (); - break; - } /* switch (c) */ - - } /* while not eof */ -} - -/* - * Process either a C++ file or a C file depending on the setting - * of a global flag. - */ -void -default_C_entries (inf) - FILE *inf; -{ - C_entries (cplusplus ? C_PLPL : 0, inf); -} - -/* Always do plain ANSI C. */ -void -plain_C_entries (inf) - FILE *inf; -{ - C_entries (0, inf); -} - -/* Always do C++. */ -void -Cplusplus_entries (inf) - FILE *inf; -{ - C_entries (C_PLPL, inf); -} - -/* Always do Java. */ -void -Cjava_entries (inf) - FILE *inf; -{ - C_entries (C_JAVA, inf); -} - -/* Always do C*. */ -void -Cstar_entries (inf) - FILE *inf; -{ - C_entries (C_STAR, inf); -} - -/* Always do Yacc. */ -void -Yacc_entries (inf) - FILE *inf; -{ - C_entries (YACC, inf); -} - -/* A useful macro. */ -#define LOOP_ON_INPUT_LINES(file_pointer, line_buffer, char_pointer) \ - for (lineno = charno = 0; /* loop initialization */ \ - !feof (file_pointer) /* loop test */ \ - && (lineno++, /* instructions at start of loop */ \ - linecharno = charno, \ - charno += readline (&line_buffer, file_pointer), \ - char_pointer = lb.buffer, \ - TRUE); \ - ) - - -/* - * Read a file, but do no processing. This is used to do regexp - * matching on files that have no language defined. - */ -void -just_read_file (inf) - FILE *inf; -{ - register char *dummy; - - LOOP_ON_INPUT_LINES (inf, lb, dummy) - continue; -} - -/* Fortran parsing */ - -bool -tail (cp) - char *cp; -{ - register int len = 0; - - while (*cp && lowcase(*cp) == lowcase(dbp[len])) - cp++, len++; - if (*cp == '\0' && !intoken(dbp[len])) - { - dbp += len; - return TRUE; - } - return FALSE; -} - -void -takeprec () -{ - dbp = skip_spaces (dbp); - if (*dbp != '*') - return; - dbp++; - dbp = skip_spaces (dbp); - if (strneq (dbp, "(*)", 3)) - { - dbp += 3; - return; - } - if (!isdigit (*dbp)) - { - --dbp; /* force failure */ - return; - } - do - dbp++; - while (isdigit (*dbp)); -} - -void -getit (inf) - FILE *inf; -{ - register char *cp; - - dbp = skip_spaces (dbp); - if (*dbp == '\0') - { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (dbp[5] != '&') - return; - dbp += 6; - dbp = skip_spaces (dbp); - } - if (!isalpha (*dbp) - && *dbp != '_' - && *dbp != '$') - return; - for (cp = dbp + 1; *cp && intoken (*cp); cp++) - continue; - pfnote (savenstr (dbp, cp-dbp), TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - - -void -Fortran_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (*dbp == '%') - dbp++; /* Ratfor escape to fortran */ - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - switch (lowcase (*dbp)) - { - case 'i': - if (tail ("integer")) - takeprec (); - break; - case 'r': - if (tail ("real")) - takeprec (); - break; - case 'l': - if (tail ("logical")) - takeprec (); - break; - case 'c': - if (tail ("complex") || tail ("character")) - takeprec (); - break; - case 'd': - if (tail ("double")) - { - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - if (tail ("precision")) - break; - continue; - } - break; - } - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - switch (lowcase (*dbp)) - { - case 'f': - if (tail ("function")) - getit (inf); - continue; - case 's': - if (tail ("subroutine")) - getit (inf); - continue; - case 'e': - if (tail ("entry")) - getit (inf); - continue; - case 'p': - if (tail ("program") || tail ("procedure")) - getit (inf); - continue; - case 'b': - if (tail ("blockdata") || tail ("block data")) - { - dbp = skip_spaces (dbp); - if (*dbp == '\0') /* assume un-named */ - pfnote (savestr ("blockdata"), TRUE, - lb.buffer, dbp - lb.buffer, lineno, linecharno); - else - getit (inf); /* look for name */ - } - continue; - } - } -} - -/* - * Bob Weiner, Motorola Inc., 4/3/94 - * Unix and microcontroller assembly tag handling - * look for '^[a-zA-Z_.$][a-zA_Z0-9_.$]*[: ^I^J]' - */ -void -Asm_labels (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - /* If first char is alphabetic or one of [_.$], test for colon - following identifier. */ - if (isalpha (*cp) || *cp == '_' || *cp == '.' || *cp == '$') - { - /* Read past label. */ - cp++; - while (isalnum (*cp) || *cp == '_' || *cp == '.' || *cp == '$') - cp++; - if (*cp == ':' || isspace (*cp)) - { - /* Found end of label, so copy it and add it to the table. */ - pfnote ((CTAGS) ? savenstr(lb.buffer, cp-lb.buffer) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } - } -} - -/* - * Perl support by Bart Robinson - * enhanced by Michael Ernst - * Perl sub names: look for /^sub[ \t\n]+[^ \t\n{]+/ - * Perl variable names: /^(my|local).../ - */ -void -Perl_functions (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (*cp++ == 's' - && *cp++ == 'u' - && *cp++ == 'b' && isspace (*cp++)) - { - cp = skip_spaces (cp); - if (*cp != '\0') - { - char *sp = cp; - while (*cp != '\0' - && !isspace (*cp) && *cp != '{' && *cp != '(') - cp++; - pfnote (savenstr (sp, cp-sp), TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } - else if (globals /* only if tagging global vars is enabled */ - && ((cp = lb.buffer, - *cp++ == 'm' - && *cp++ == 'y') - || (cp = lb.buffer, - *cp++ == 'l' - && *cp++ == 'o' - && *cp++ == 'c' - && *cp++ == 'a' - && *cp++ == 'l')) - && (*cp == '(' || isspace (*cp))) - { - /* After "my" or "local", but before any following paren or space. */ - char *varname = NULL; - - cp = skip_spaces (cp); - if (*cp == '$' || *cp == '@' || *cp == '%') - { - char* varstart = ++cp; - while (isalnum (*cp) || *cp == '_') - cp++; - varname = savenstr (varstart, cp-varstart); - } - else - { - /* Should be examining a variable list at this point; - could insist on seeing an open parenthesis. */ - while (*cp != '\0' && *cp != ';' && *cp != '=' && *cp != ')') - cp++; - } - - /* Perhaps I should back cp up one character, so the TAGS table - doesn't mention (and so depend upon) the following char. */ - pfnote ((CTAGS) ? savenstr (lb.buffer, cp-lb.buffer) : varname, - FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } -} - -/* - * Python support by Eric S. Raymond - * Look for /^def[ \t\n]+[^ \t\n(:]+/ or /^class[ \t\n]+[^ \t\n(:]+/ - */ -void -Python_functions (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (*cp++ == 'd' - && *cp++ == 'e' - && *cp++ == 'f' && isspace (*cp++)) - { - cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') - cp++; - pfnote (NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - - cp = lb.buffer; - if (*cp++ == 'c' - && *cp++ == 'l' - && *cp++ == 'a' - && *cp++ == 's' - && *cp++ == 's' && isspace (*cp++)) - { - cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') - cp++; - pfnote (NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } -} - -/* Idea by Corny de Souza - * Cobol tag functions - * We could look for anything that could be a paragraph name. - * i.e. anything that starts in column 8 is one word and ends in a full stop. - */ -void -Cobol_paragraphs (inf) - FILE *inf; -{ - register char *bp, *ep; - - LOOP_ON_INPUT_LINES (inf, lb, bp) - { - if (lb.len < 9) - continue; - bp += 8; - - /* If eoln, compiler option or comment ignore whole line. */ - if (bp[-1] != ' ' || !isalnum (bp[0])) - continue; - - for (ep = bp; isalnum (*ep) || *ep == '-'; ep++) - continue; - if (*ep++ == '.') - pfnote (savenstr (bp, ep-bp), TRUE, - lb.buffer, ep - lb.buffer + 1, lineno, linecharno); - } -} - -/* Added by Mosur Mohan, 4/22/88 */ -/* Pascal parsing */ - -/* - * Locates tags for procedures & functions. Doesn't do any type- or - * var-definitions. It does look for the keyword "extern" or - * "forward" immediately following the procedure statement; if found, - * the tag is skipped. - */ -void -Pascal_functions (inf) - FILE *inf; -{ - linebuffer tline; /* mostly copied from C_entries */ - long save_lcno; - int save_lineno, save_len; - char c, *cp, *namebuf; - - bool /* each of these flags is TRUE iff: */ - incomment, /* point is inside a comment */ - inquote, /* point is inside '..' string */ - get_tagname, /* point is after PROCEDURE/FUNCTION - keyword, so next item = potential tag */ - found_tag, /* point is after a potential tag */ - inparms, /* point is within parameter-list */ - verify_tag; /* point has passed the parm-list, so the - next token will determine whether this - is a FORWARD/EXTERN to be ignored, or - whether it is a real tag */ - - save_lcno = save_lineno = save_len = 0; /* keep compiler quiet */ - namebuf = NULL; /* keep compiler quiet */ - lineno = 0; - charno = 0; - dbp = lb.buffer; - *dbp = '\0'; - initbuffer (&tline); - - incomment = inquote = FALSE; - found_tag = FALSE; /* have a proc name; check if extern */ - get_tagname = FALSE; /* have found "procedure" keyword */ - inparms = FALSE; /* found '(' after "proc" */ - verify_tag = FALSE; /* check if "extern" is ahead */ - - - while (!feof (inf)) /* long main loop to get next char */ - { - c = *dbp++; - if (c == '\0') /* if end of line */ - { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (*dbp == '\0') - continue; - if (!((found_tag && verify_tag) - || get_tagname)) - c = *dbp++; /* only if don't need *dbp pointing - to the beginning of the name of - the procedure or function */ - } - if (incomment) - { - if (c == '}') /* within { } comments */ - incomment = FALSE; - else if (c == '*' && *dbp == ')') /* within (* *) comments */ - { - dbp++; - incomment = FALSE; - } - continue; - } - else if (inquote) - { - if (c == '\'') - inquote = FALSE; - continue; - } - else - switch (c) - { - case '\'': - inquote = TRUE; /* found first quote */ - continue; - case '{': /* found open { comment */ - incomment = TRUE; - continue; - case '(': - if (*dbp == '*') /* found open (* comment */ - { - incomment = TRUE; - dbp++; - } - else if (found_tag) /* found '(' after tag, i.e., parm-list */ - inparms = TRUE; - continue; - case ')': /* end of parms list */ - if (inparms) - inparms = FALSE; - continue; - case ';': - if (found_tag && !inparms) /* end of proc or fn stmt */ - { - verify_tag = TRUE; - break; - } - continue; - } - if (found_tag && verify_tag && (*dbp != ' ')) - { - /* check if this is an "extern" declaration */ - if (*dbp == '\0') - continue; - if (lowcase (*dbp == 'e')) - { - if (tail ("extern")) /* superfluous, really! */ - { - found_tag = FALSE; - verify_tag = FALSE; - } - } - else if (lowcase (*dbp) == 'f') - { - if (tail ("forward")) /* check for forward reference */ - { - found_tag = FALSE; - verify_tag = FALSE; - } - } - if (found_tag && verify_tag) /* not external proc, so make tag */ - { - found_tag = FALSE; - verify_tag = FALSE; - pfnote (namebuf, TRUE, - tline.buffer, save_len, save_lineno, save_lcno); - continue; - } - } - if (get_tagname) /* grab name of proc or fn */ - { - if (*dbp == '\0') - continue; - - /* save all values for later tagging */ - grow_linebuffer (&tline, lb.len + 1); - strcpy (tline.buffer, lb.buffer); - save_lineno = lineno; - save_lcno = linecharno; - - /* grab block name */ - for (cp = dbp + 1; *cp != '\0' && !endtoken (*cp); cp++) - continue; - namebuf = savenstr (dbp, cp-dbp); - dbp = cp; /* set dbp to e-o-token */ - save_len = dbp - lb.buffer + 1; - get_tagname = FALSE; - found_tag = TRUE; - continue; - - /* and proceed to check for "extern" */ - } - else if (!incomment && !inquote && !found_tag) - { - /* check for proc/fn keywords */ - switch (lowcase (c)) - { - case 'p': - if (tail ("rocedure")) /* c = 'p', dbp has advanced */ - get_tagname = TRUE; - continue; - case 'f': - if (tail ("unction")) - get_tagname = TRUE; - continue; - } - } - } /* while not eof */ - - free (tline.buffer); -} - -/* - * lisp tag functions - * look for (def or (DEF, quote or QUOTE - */ -int -L_isdef (strp) - register char *strp; -{ - return ((strp[1] == 'd' || strp[1] == 'D') - && (strp[2] == 'e' || strp[2] == 'E') - && (strp[3] == 'f' || strp[3] == 'F')); -} - -int -L_isquote (strp) - register char *strp; -{ - return ((*++strp == 'q' || *strp == 'Q') - && (*++strp == 'u' || *strp == 'U') - && (*++strp == 'o' || *strp == 'O') - && (*++strp == 't' || *strp == 'T') - && (*++strp == 'e' || *strp == 'E') - && isspace (*++strp)); -} - -void -L_getit () -{ - register char *cp; - - if (*dbp == '\'') /* Skip prefix quote */ - dbp++; - else if (*dbp == '(') - { - if (L_isquote (dbp)) - dbp += 7; /* Skip "(quote " */ - else - dbp += 1; /* Skip "(" before name in (defstruct (foo)) */ - dbp = skip_spaces (dbp); - } - - for (cp = dbp /*+1*/; - *cp != '\0' && *cp != '(' && *cp != ' ' && *cp != ')'; - cp++) - continue; - if (cp == dbp) - return; - - pfnote (savenstr (dbp, cp-dbp), TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - -void -Lisp_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (dbp[0] == '(') - { - if (L_isdef (dbp)) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - L_getit (); - } - else - { - /* Check for (foo::defmumble name-defined ... */ - do - dbp++; - while (*dbp != '\0' && !isspace (*dbp) - && *dbp != ':' && *dbp != '(' && *dbp != ')'); - if (*dbp == ':') - { - do - dbp++; - while (*dbp == ':'); - - if (L_isdef (dbp - 1)) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - L_getit (); - } - } - } - } - } -} - -/* - * Postscript tag functions - * Just look for lines where the first character is '/' - * Richard Mlynarik - */ -void -Postscript_functions (inf) - FILE *inf; -{ - register char *bp, *ep; - - LOOP_ON_INPUT_LINES (inf, lb, bp) - { - if (bp[0] == '/') - { - for (ep = bp+1; - *ep != '\0' && *ep != ' ' && *ep != '{'; - ep++) - continue; - pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, - lb.buffer, ep - lb.buffer + 1, lineno, linecharno); - } - } -} - - -/* - * Scheme tag functions - * look for (def... xyzzy - * look for (def... (xyzzy - * look for (def ... ((...(xyzzy .... - * look for (set! xyzzy - */ - -void get_scheme (); - -void -Scheme_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (dbp[0] == '(' - && (dbp[1] == 'D' || dbp[1] == 'd') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'F' || dbp[3] == 'f')) - { - dbp = skip_non_spaces (dbp); - /* Skip over open parens and white space */ - while (isspace (*dbp) || *dbp == '(') - dbp++; - get_scheme (); - } - if (dbp[0] == '(' - && (dbp[1] == 'S' || dbp[1] == 's') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'T' || dbp[3] == 't') - && (dbp[4] == '!' || dbp[4] == '!') - && (isspace (dbp[5]))) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - get_scheme (); - } - } -} - -void -get_scheme () -{ - register char *cp; - - if (*dbp == '\0') - return; - /* Go till you get to white space or a syntactic break */ - for (cp = dbp + 1; - *cp != '\0' && *cp != '(' && *cp != ')' && !isspace (*cp); - cp++) - continue; - pfnote (savenstr (dbp, cp-dbp), TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - -/* Find tags in TeX and LaTeX input files. */ - -/* TEX_toktab is a table of TeX control sequences that define tags. - Each TEX_tabent records one such control sequence. - CONVERT THIS TO USE THE Stab TYPE!! */ -struct TEX_tabent -{ - char *name; - int len; -}; - -struct TEX_tabent *TEX_toktab = NULL; /* Table with tag tokens */ - -/* Default set of control sequences to put into TEX_toktab. - The value of environment var TEXTAGS is prepended to this. */ - -char *TEX_defenv = "\ -:chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ -:part:appendix:entry:index"; - -void TEX_mode (); -struct TEX_tabent *TEX_decode_env (); -int TEX_Token (); - -char TEX_esc = '\\'; -char TEX_opgrp = '{'; -char TEX_clgrp = '}'; - -/* - * TeX/LaTeX scanning loop. - */ -void -TeX_functions (inf) - FILE *inf; -{ - char *cp, *lasthit; - register int i; - - /* Select either \ or ! as escape character. */ - TEX_mode (inf); - - /* Initialize token table once from environment. */ - if (!TEX_toktab) - TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv); - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - lasthit = cp; - /* Look at each esc in line. */ - while ((cp = etags_strchr (cp, TEX_esc)) != NULL) - { - if (*++cp == '\0') - break; - linecharno += cp - lasthit; - lasthit = cp; - i = TEX_Token (lasthit); - if (i >= 0) - { - /* We seem to include the TeX command in the tag name. - register char *p; - for (p = lasthit + TEX_toktab[i].len; - *p != '\0' && *p != TEX_clgrp; - p++) - continue; */ - pfnote (/*savenstr (lasthit, p-lasthit)*/ (char *)NULL, TRUE, - lb.buffer, lb.len, lineno, linecharno); - break; /* We only tag a line once */ - } - } - } -} - -#define TEX_LESC '\\' -#define TEX_SESC '!' -#define TEX_cmt '%' - -/* Figure out whether TeX's escapechar is '\\' or '!' and set grouping - chars accordingly. */ -void -TEX_mode (inf) - FILE *inf; -{ - int c; - - while ((c = getc (inf)) != EOF) - { - /* Skip to next line if we hit the TeX comment char. */ - if (c == TEX_cmt) - while (c != '\n') - c = getc (inf); - else if (c == TEX_LESC || c == TEX_SESC ) - break; - } - - if (c == TEX_LESC) - { - TEX_esc = TEX_LESC; - TEX_opgrp = '{'; - TEX_clgrp = '}'; - } - else - { - TEX_esc = TEX_SESC; - TEX_opgrp = '<'; - TEX_clgrp = '>'; - } - /* If the input file is compressed, inf is a pipe, and rewind may fail. - No attempt is made to correct the situation. */ - rewind (inf); -} - -/* Read environment and prepend it to the default string. - Build token table. */ -struct TEX_tabent * -TEX_decode_env (evarname, defenv) - char *evarname; - char *defenv; -{ - register char *env, *p; - - struct TEX_tabent *tab; - int size, i; - - /* Append default string to environment. */ - env = getenv (evarname); - if (!env) - env = defenv; - else - { - char *oldenv = env; - env = concat (oldenv, defenv, ""); - } - - /* Allocate a token table */ - for (size = 1, p = env; p;) - if ((p = etags_strchr (p, ':')) && *++p != '\0') - size++; - /* Add 1 to leave room for null terminator. */ - tab = xnew (size + 1, struct TEX_tabent); - - /* Unpack environment string into token table. Be careful about */ - /* zero-length strings (leading ':', "::" and trailing ':') */ - for (i = 0; *env;) - { - p = etags_strchr (env, ':'); - if (!p) /* End of environment string. */ - p = env + strlen (env); - if (p - env > 0) - { /* Only non-zero strings. */ - tab[i].name = savenstr (env, p - env); - tab[i].len = strlen (tab[i].name); - i++; - } - if (*p) - env = p + 1; - else - { - tab[i].name = NULL; /* Mark end of table. */ - tab[i].len = 0; - break; - } - } - return tab; -} - -/* If the text at CP matches one of the tag-defining TeX command names, - return the pointer to the first occurrence of that command in TEX_toktab. - Otherwise return -1. - Keep the capital `T' in `token' for dumb truncating compilers - (this distinguishes it from `TEX_toktab' */ -int -TEX_Token (cp) - char *cp; -{ - int i; - - for (i = 0; TEX_toktab[i].len > 0; i++) - if (strneq (TEX_toktab[i].name, cp, TEX_toktab[i].len)) - return i; - return -1; -} - -/* - * Prolog support (rewritten) by Anders Lindgren, Mar. 96 - * - * Assumes that the predicate starts at column 0. - * Only the first clause of a predicate is added. - */ -int prolog_pred (); -void prolog_skip_comment (); -int prolog_atom (); - -void -Prolog_functions (inf) - FILE *inf; -{ - char *cp, *last; - int len; - int allocated; - - allocated = 0; - len = 0; - last = NULL; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (cp[0] == '\0') /* Empty line */ - continue; - else if (isspace (cp[0])) /* Not a predicate */ - continue; - else if (cp[0] == '/' && cp[1] == '*') /* comment. */ - prolog_skip_comment (&lb, inf); - else if ((len = prolog_pred (cp, last)) > 0) - { - /* Predicate. Store the function name so that we only - generate a tag for the first clause. */ - if (last == NULL) - last = xnew(len + 1, char); - else if (len + 1 > allocated) - last = xrnew (last, len + 1, char); - allocated = len + 1; - strncpy (last, cp, len); - last[len] = '\0'; - } - } -} - - -void -prolog_skip_comment (plb, inf) - linebuffer *plb; - FILE *inf; -{ - char *cp; - - do - { - for (cp = plb->buffer; *cp != '\0'; cp++) - if (cp[0] == '*' && cp[1] == '/') - return; - lineno++; - linecharno += readline (plb, inf); - } - while (!feof(inf)); -} - -/* - * A predicate definition is added if it matches: - * ( - * - * It is added to the tags database if it doesn't match the - * name of the previous clause header. - * - * Return the size of the name of the predicate, or 0 if no header - * was found. - */ -int -prolog_pred (s, last) - char *s; - char *last; /* Name of last clause. */ -{ - int pos; - int len; - - pos = prolog_atom (s, 0); - if (pos < 1) - return 0; - - len = pos; - pos = skip_spaces (s + pos) - s; - - if ((s[pos] == '(') || (s[pos] == '.')) - { - if (s[pos] == '(') - pos++; - - /* Save only the first clause. */ - if (last == NULL - || len != (int)strlen (last) - || !strneq (s, last, len)) - { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); - return len; - } - } - return 0; -} - -/* - * Consume a Prolog atom. - * Return the number of bytes consumed, or -1 if there was an error. - * - * A prolog atom, in this context, could be one of: - * - An alphanumeric sequence, starting with a lower case letter. - * - A quoted arbitrary string. Single quotes can escape themselves. - * Backslash quotes everything. - */ -int -prolog_atom (s, pos) - char *s; - int pos; -{ - int origpos; - - origpos = pos; - - if (islower(s[pos]) || (s[pos] == '_')) - { - /* The atom is unquoted. */ - pos++; - while (isalnum(s[pos]) || (s[pos] == '_')) - { - pos++; - } - return pos - origpos; - } - else if (s[pos] == '\'') - { - pos++; - - while (1) - { - if (s[pos] == '\'') - { - pos++; - if (s[pos] != '\'') - break; - pos++; /* A double quote */ - } - else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ - return -1; - else if (s[pos] == '\\') - { - if (s[pos+1] == '\0') - return -1; - pos += 2; - } - else - pos++; - } - return pos - origpos; - } - else - return -1; -} - -/* - * Support for Erlang -- Anders Lindgren, Feb 1996. - * - * Generates tags for functions, defines, and records. - * - * Assumes that Erlang functions start at column 0. - */ -int erlang_func (); -void erlang_attribute (); -int erlang_atom (); - -void -Erlang_functions (inf) - FILE *inf; -{ - char *cp, *last; - int len; - int allocated; - - allocated = 0; - len = 0; - last = NULL; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (cp[0] == '\0') /* Empty line */ - continue; - else if (isspace (cp[0])) /* Not function nor attribute */ - continue; - else if (cp[0] == '%') /* comment */ - continue; - else if (cp[0] == '"') /* Sometimes, strings start in column one */ - continue; - else if (cp[0] == '-') /* attribute, e.g. "-define" */ - { - erlang_attribute (cp); - last = NULL; - } - else if ((len = erlang_func (cp, last)) > 0) - { - /* - * Function. Store the function name so that we only - * generates a tag for the first clause. - */ - if (last == NULL) - last = xnew (len + 1, char); - else if (len + 1 > allocated) - last = xrnew (last, len + 1, char); - allocated = len + 1; - strncpy (last, cp, len); - last[len] = '\0'; - } - } -} - - -/* - * A function definition is added if it matches: - * ( - * - * It is added to the tags database if it doesn't match the - * name of the previous clause header. - * - * Return the size of the name of the function, or 0 if no function - * was found. - */ -int -erlang_func (s, last) - char *s; - char *last; /* Name of last clause. */ -{ - int pos; - int len; - - pos = erlang_atom (s, 0); - if (pos < 1) - return 0; - - len = pos; - pos = skip_spaces (s + pos) - s; - - /* Save only the first clause. */ - if (s[pos++] == '(' - && (last == NULL - || len != (int)strlen (last) - || !strneq (s, last, len))) - { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); - return len; - } - - return 0; -} - - -/* - * Handle attributes. Currently, tags are generated for defines - * and records. - * - * They are on the form: - * -define(foo, bar). - * -define(Foo(M, N), M+N). - * -record(graph, {vtab = notable, cyclic = true}). - */ -void -erlang_attribute (s) - char *s; -{ - int pos; - int len; - - if (strneq (s, "-define", 7) || strneq (s, "-record", 7)) - { - pos = skip_spaces (s + 7) - s; - if (s[pos++] == '(') - { - pos = skip_spaces (s + pos) - s; - len = erlang_atom (s, pos); - if (len != 0) - pfnote ((CTAGS) ? savenstr (& s[pos], len) : NULL, TRUE, - s, pos + len, lineno, linecharno); - } - } - return; -} - - -/* - * Consume an Erlang atom (or variable). - * Return the number of bytes consumed, or -1 if there was an error. - */ -int -erlang_atom (s, pos) - char *s; - int pos; -{ - int origpos; - - origpos = pos; - - if (isalpha (s[pos]) || s[pos] == '_') - { - /* The atom is unquoted. */ - pos++; - while (isalnum (s[pos]) || s[pos] == '_') - pos++; - return pos - origpos; - } - else if (s[pos] == '\'') - { - pos++; - - while (1) - { - if (s[pos] == '\'') - { - pos++; - break; - } - else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ - return -1; - else if (s[pos] == '\\') - { - if (s[pos+1] == '\0') - return -1; - pos += 2; - } - else - pos++; - } - return pos - origpos; - } - else - return -1; -} - -#ifdef ETAGS_REGEXPS - -/* Take a string like "/blah/" and turn it into "blah", making sure - that the first and last characters are the same, and handling - quoted separator characters. Actually, stops on the occurrence of - an unquoted separator. Also turns "\t" into a Tab character. - Returns pointer to terminating separator. Works in place. Null - terminates name string. */ -char * -scan_separators (name) - char *name; -{ - char sep = name[0]; - char *copyto = name; - bool quoted = FALSE; - - for (++name; *name != '\0'; ++name) - { - if (quoted) - { - if (*name == 't') - *copyto++ = '\t'; - else if (*name == sep) - *copyto++ = sep; - else - { - /* Something else is quoted, so preserve the quote. */ - *copyto++ = '\\'; - *copyto++ = *name; - } - quoted = FALSE; - } - else if (*name == '\\') - quoted = TRUE; - else if (*name == sep) - break; - else - *copyto++ = *name; - } - - /* Terminate copied string. */ - *copyto = '\0'; - return name; -} - -/* Look at the argument of --regex or --no-regex and do the right - thing. Same for each line of a regexp file. */ -void -analyse_regex (regex_arg) - char *regex_arg; -{ - if (regex_arg == NULL) - free_patterns (); /* --no-regex: remove existing regexps */ - - /* A real --regexp option or a line in a regexp file. */ - switch (regex_arg[0]) - { - /* Comments in regexp file or null arg to --regex. */ - case '\0': - case ' ': - case '\t': - break; - - /* Read a regex file. This is recursive and may result in a - loop, which will stop when the file descriptors are exhausted. */ - case '@': - { - FILE *regexfp; - linebuffer regexbuf; - char *regexfile = regex_arg + 1; - - /* regexfile is a file containing regexps, one per line. */ - regexfp = fopen (regexfile, "r"); - if (regexfp == NULL) - { - pfatal (regexfile); - return; - } - initbuffer (®exbuf); - while (readline_internal (®exbuf, regexfp) > 0) - analyse_regex (regexbuf.buffer); - free (regexbuf.buffer); - fclose (regexfp); - } - break; - - /* Regexp to be used for a specific language only. */ - case '{': - { - language *lang; - char *lang_name = regex_arg + 1; - char *cp; - - for (cp = lang_name; *cp != '}'; cp++) - if (*cp == '\0') - { - error ("unterminated language name in regex: %s", regex_arg); - return; - } - *cp = '\0'; - lang = get_language_from_name (lang_name); - if (lang == NULL) - return; - add_regex (cp + 1, lang); - } - break; - - /* Regexp to be used for any language. */ - default: - add_regex (regex_arg, NULL); - break; - } -} - -/* Turn a name, which is an ed-style (but Emacs syntax) regular - expression, into a real regular expression by compiling it. */ -void -add_regex (regexp_pattern, lang) - char *regexp_pattern; - language *lang; -{ - char *name; - const char *err; - struct re_pattern_buffer *patbuf; - pattern *pp; - - - if (regexp_pattern[strlen(regexp_pattern)-1] != regexp_pattern[0]) - { - error ("%s: unterminated regexp", regexp_pattern); - return; - } - name = scan_separators (regexp_pattern); - if (regexp_pattern[0] == '\0') - { - error ("null regexp", (char *)NULL); - return; - } - (void) scan_separators (name); - - patbuf = xnew (1, struct re_pattern_buffer); - patbuf->translate = NULL; - patbuf->fastmap = NULL; - patbuf->buffer = NULL; - patbuf->allocated = 0; - - err = re_compile_pattern (regexp_pattern, strlen (regexp_pattern), patbuf); - if (err != NULL) - { - error ("%s while compiling pattern", err); - return; - } - - pp = p_head; - p_head = xnew (1, pattern); - p_head->regex = savestr (regexp_pattern); - p_head->p_next = pp; - p_head->language = lang; - p_head->pattern = patbuf; - p_head->name_pattern = savestr (name); - p_head->error_signaled = FALSE; -} - -/* - * Do the substitutions indicated by the regular expression and - * arguments. - */ -char * -substitute (in, out, regs) - char *in, *out; - struct re_registers *regs; -{ - char *result, *t; - int size, dig, diglen; - - result = NULL; - size = strlen (out); - - /* Pass 1: figure out how much to allocate by finding all \N strings. */ - if (out[size - 1] == '\\') - fatal ("pattern error in \"%s\"", out); - for (t = etags_strchr (out, '\\'); - t != NULL; - t = etags_strchr (t + 2, '\\')) - if (isdigit (t[1])) - { - dig = t[1] - '0'; - diglen = regs->end[dig] - regs->start[dig]; - size += diglen - 2; - } - else - size -= 1; - - /* Allocate space and do the substitutions. */ - result = xnew (size + 1, char); - - for (t = result; *out != '\0'; out++) - if (*out == '\\' && isdigit (*++out)) - { - /* Using "dig2" satisfies my debugger. Bleah. */ - dig = *out - '0'; - diglen = regs->end[dig] - regs->start[dig]; - strncpy (t, in + regs->start[dig], diglen); - t += diglen; - } - else - *t++ = *out; - *t = '\0'; - - if (DEBUG && (t > result + size || t - result != (int)strlen (result))) - abort (); - - return result; -} - -/* Deallocate all patterns. */ -void -free_patterns () -{ - pattern *pp; - while (p_head != NULL) - { - pp = p_head->p_next; - free (p_head->regex); - free (p_head->name_pattern); - free (p_head); - p_head = pp; - } - return; -} - -#endif /* ETAGS_REGEXPS */ -/* Initialize a linebuffer for use */ -void -initbuffer (lbp) - linebuffer *lbp; -{ - lbp->size = 200; - lbp->buffer = xnew (200, char); -} - -/* - * Read a line of text from `stream' into `lbp', excluding the - * newline or CR-NL, if any. Return the number of characters read from - * `stream', which is the length of the line including the newline. - * - * On DOS or Windows we do not count the CR character, if any, before the - * NL, in the returned length; this mirrors the behavior of emacs on those - * platforms (for text files, it translates CR-NL to NL as it reads in the - * file). - */ -long -readline_internal (lbp, stream) - linebuffer *lbp; - register FILE *stream; -{ - char *buffer = lbp->buffer; - register char *p = lbp->buffer; - register char *pend; - int chars_deleted; - - pend = p + lbp->size; /* Separate to avoid 386/IX compiler bug. */ - - while (1) - { - register int c = getc (stream); - if (p == pend) - { - /* We're at the end of linebuffer: expand it. */ - lbp->size *= 2; - buffer = xrnew (buffer, lbp->size, char); - p += buffer - lbp->buffer; - pend = buffer + lbp->size; - lbp->buffer = buffer; - } - if (c == EOF) - { - *p = '\0'; - chars_deleted = 0; - break; - } - if (c == '\n') - { - if (p > buffer && p[-1] == '\r') - { - p -= 1; -#ifdef DOS_NT - /* Assume CRLF->LF translation will be performed by Emacs - when loading this file, so CRs won't appear in the buffer. - It would be cleaner to compensate within Emacs; - however, Emacs does not know how many CRs were deleted - before any given point in the file. */ - chars_deleted = 1; -#else - chars_deleted = 2; -#endif - } - else - { - chars_deleted = 1; - } - *p = '\0'; - break; - } - *p++ = c; - } - lbp->len = p - buffer; - - return lbp->len + chars_deleted; -} - -/* - * Like readline_internal, above, but in addition try to match the - * input line against relevant regular expressions. - */ -long -readline (lbp, stream) - linebuffer *lbp; - FILE *stream; -{ - /* Read new line. */ - long result = readline_internal (lbp, stream); -#ifdef ETAGS_REGEXPS - int match; - pattern *pp; - - /* Match against relevant patterns. */ - if (lbp->len > 0) - for (pp = p_head; pp != NULL; pp = pp->p_next) - { - /* Only use generic regexps or those for the current language. */ - if (pp->language != NULL && pp->language != curlang) - continue; - - match = re_match (pp->pattern, lbp->buffer, lbp->len, 0, &pp->regs); - switch (match) - { - case -2: - /* Some error. */ - if (!pp->error_signaled) - { - error ("error while matching \"%s\"", pp->regex); - pp->error_signaled = TRUE; - } - break; - case -1: - /* No match. */ - break; - default: - /* Match occurred. Construct a tag. */ - if (pp->name_pattern[0] != '\0') - { - /* Make a named tag. */ - char *name = substitute (lbp->buffer, - pp->name_pattern, &pp->regs); - if (name != NULL) - pfnote (name, TRUE, lbp->buffer, match, lineno, linecharno); - } - else - { - /* Make an unnamed tag. */ - pfnote ((char *)NULL, TRUE, - lbp->buffer, match, lineno, linecharno); - } - break; - } - } -#endif /* ETAGS_REGEXPS */ - - return result; -} - -/* - * Return a pointer to a space of size strlen(cp)+1 allocated - * with xnew where the string CP has been copied. - */ -char * -savestr (cp) - char *cp; -{ - return savenstr (cp, strlen (cp)); -} - -/* - * Return a pointer to a space of size LEN+1 allocated with xnew where - * the string CP has been copied for at most the first LEN characters. - */ -char * -savenstr (cp, len) - char *cp; - int len; -{ - register char *dp; - - dp = xnew (len + 1, char); - strncpy (dp, cp, len); - dp[len] = '\0'; - return dp; -} - -/* - * Return the ptr in sp at which the character c last - * appears; NULL if not found - * - * Identical to System V strrchr, included for portability. - */ -char * -etags_strrchr (sp, c) - register char *sp, c; -{ - register char *r; - - r = NULL; - do - { - if (*sp == c) - r = sp; - } while (*sp++); - return r; -} - - -/* - * Return the ptr in sp at which the character c first - * appears; NULL if not found - * - * Identical to System V strchr, included for portability. - */ -char * -etags_strchr (sp, c) - register char *sp, c; -{ - do - { - if (*sp == c) - return sp; - } while (*sp++); - return NULL; -} - -/* Skip spaces, return new pointer. */ -char * -skip_spaces (cp) - char *cp; -{ - while (isspace (*cp)) /* isspace('\0')==FALSE */ - cp++; - return cp; -} - -/* Skip non spaces, return new pointer. */ -char * -skip_non_spaces (cp) - char *cp; -{ - while (!iswhite (*cp)) /* iswhite('\0')==TRUE */ - cp++; - return cp; -} - -/* Print error message and exit. */ -void -fatal (s1, s2) - char *s1, *s2; -{ - error (s1, s2); - exit (BAD); -} - -void -pfatal (s1) - char *s1; -{ - perror (s1); - exit (BAD); -} - -void -suggest_asking_for_help () -{ - fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n", - progname, -#ifdef LONG_OPTIONS - "--help" -#else - "-h" -#endif - ); - exit (BAD); -} - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ -void -error (s1, s2) - char *s1, *s2; -{ - fprintf (stderr, "%s: ", progname); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} - -/* Return a newly-allocated string whose contents - concatenate those of s1, s2, s3. */ -char * -concat (s1, s2, s3) - char *s1, *s2, *s3; -{ - int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = xnew (len1 + len2 + len3 + 1, char); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - result[len1 + len2 + len3] = '\0'; - - return result; -} - -/* Does the same work as the system V getcwd, but does not need to - guess the buffer size in advance. */ -char * -etags_getcwd () -{ -#ifdef HAVE_GETCWD - int bufsize = 200; - char *path = xnew (bufsize, char); - - while (getcwd (path, bufsize) == NULL) - { - if (errno != ERANGE) - pfatal ("getcwd"); - bufsize *= 2; - free (path); - path = xnew (bufsize, char); - } - - canonicalize_filename (path); - return path; - -#else /* not HAVE_GETCWD */ -#ifdef MSDOS - char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ - - getwd (path); - - for (p = path; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; - else - *p = lowcase (*p); - - return strdup (path); -#else /* not MSDOS */ - linebuffer path; - FILE *pipe; - - initbuffer (&path); - pipe = (FILE *) popen ("pwd 2>/dev/null", "r"); - if (pipe == NULL || readline_internal (&path, pipe) == 0) - pfatal ("pwd"); - pclose (pipe); - - return path.buffer; -#endif /* not MSDOS */ -#endif /* not HAVE_GETCWD */ -} - -/* Return a newly allocated string containing the file name of FILE - relative to the absolute directory DIR (which should end with a slash). */ -char * -relative_filename (file, dir) - char *file, *dir; -{ - char *fp, *dp, *afn, *res; - int i; - - /* Find the common root of file and dir (with a trailing slash). */ - afn = absolute_filename (file, cwd); - fp = afn; - dp = dir; - while (*fp++ == *dp++) - continue; - fp--, dp--; /* back to the first differing char */ - do /* look at the equal chars until '/' */ - fp--, dp--; - while (*fp != '/'); - - /* Build a sequence of "../" strings for the resulting relative file name. */ - i = 0; - while ((dp = etags_strchr (dp + 1, '/')) != NULL) - i += 1; - res = xnew (3*i + strlen (fp + 1) + 1, char); - res[0] = '\0'; - while (i-- > 0) - strcat (res, "../"); - - /* Add the file name relative to the common root of file and dir. */ - strcat (res, fp + 1); - free (afn); - - return res; -} - -/* Return a newly allocated string containing the absolute file name - of FILE given DIR (which should end with a slash). */ -char * -absolute_filename (file, dir) - char *file, *dir; -{ - char *slashp, *cp, *res; - - if (filename_is_absolute (file)) - res = savestr (file); -#ifdef DOS_NT - /* We don't support non-absolute file names with a drive - letter, like `d:NAME' (it's too much hassle). */ - else if (file[1] == ':') - fatal ("%s: relative file names with drive letters not supported", file); -#endif - else - res = concat (dir, file, ""); - - /* Delete the "/dirname/.." and "/." substrings. */ - slashp = etags_strchr (res, '/'); - while (slashp != NULL && slashp[0] != '\0') - { - if (slashp[1] == '.') - { - if (slashp[2] == '.' - && (slashp[3] == '/' || slashp[3] == '\0')) - { - cp = slashp; - do - cp--; - while (cp >= res && !filename_is_absolute (cp)); - if (cp < res) - cp = slashp; /* the absolute name begins with "/.." */ -#ifdef DOS_NT - /* Under MSDOS and NT we get `d:/NAME' as absolute - file name, so the luser could say `d:/../NAME'. - We silently treat this as `d:/NAME'. */ - else if (cp[0] != '/') - cp = slashp; -#endif - strcpy (cp, slashp + 3); - slashp = cp; - continue; - } - else if (slashp[2] == '/' || slashp[2] == '\0') - { - strcpy (slashp, slashp + 2); - continue; - } - } - - slashp = etags_strchr (slashp + 1, '/'); - } - - if (res[0] == '\0') - return savestr ("/"); - else - return res; -} - -/* Return a newly allocated string containing the absolute - file name of dir where FILE resides given DIR (which should - end with a slash). */ -char * -absolute_dirname (file, dir) - char *file, *dir; -{ - char *slashp, *res; - char save; - - canonicalize_filename (file); - slashp = etags_strrchr (file, '/'); - if (slashp == NULL) - return savestr (dir); - save = slashp[1]; - slashp[1] = '\0'; - res = absolute_filename (file, dir); - slashp[1] = save; - - return res; -} - -/* Whether the argument string is an absolute file name. The argument - string must have been canonicalized with canonicalize_filename. */ -bool -filename_is_absolute (fn) - char *fn; -{ - return (fn[0] == '/' -#ifdef DOS_NT - || (isalpha(fn[0]) && fn[1] == ':' && fn[2] == '/') -#endif - ); -} - -/* Translate backslashes into slashes. Works in place. */ -void -canonicalize_filename (fn) - register char *fn; -{ -#ifdef DOS_NT - for (; *fn != '\0'; fn++) - if (*fn == '\\') - *fn = '/'; -#else - /* No action. */ - fn = NULL; /* shut up the compiler */ -#endif -} - -/* Increase the size of a linebuffer. */ -void -grow_linebuffer (lbp, toksize) - linebuffer *lbp; - int toksize; -{ - while (lbp->size < toksize) - lbp->size *= 2; - lbp->buffer = xrnew (lbp->buffer, lbp->size, char); -} - -/* Like malloc but get fatal error if memory is exhausted. */ -long * -xmalloc (size) - unsigned int size; -{ - long *result = (long *) malloc (size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} - -long * -xrealloc (ptr, size) - char *ptr; - unsigned int size; -{ - long *result = (long *) realloc (ptr, size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} diff --git a/lib-src/fakemail.c b/lib-src/fakemail.c deleted file mode 100644 index 22cb1ab..0000000 --- a/lib-src/fakemail.c +++ /dev/null @@ -1,680 +0,0 @@ -/* sendmail-like interface to /bin/mail for system V, - Copyright (C) 1985, 1994 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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.28. */ - -#define NO_SHORTNAMES -#include <../src/config.h> - -#if defined (BSD) && !defined (BSD4_1) && !defined (USE_FAKEMAIL) -/* This program isnot used in BSD, so just avoid loader complaints. */ -int -main () -{ - return 0; -} -#elif defined (LINUX) -#include -#include -int -main () -{ - /* Linux /bin/mail, if it exists, is NOT the Unix v7 mail that - fakemail depends on! This causes garbled mail. Better to - output an error message. */ - fprintf (stderr, "Sorry, fakemail does not work on Linux.\n"); - fprintf (stderr, "Make sure you have the sendmail program, and\n"); - fprintf (stderr, "set the Lisp variable `sendmail-program' to point\n"); - fprintf (stderr, "to the path of the sendmail binary.\n"); - return 1; -} -#else /* not BSD 4.2 (or newer) */ -#ifdef MSDOS -int -main () -{ - return 0; -} -#else /* not MSDOS */ -/* This conditional contains all the rest of the file. */ - -/* These are defined in config in some versions. */ - -#ifdef static -#undef static -#endif - -#ifdef read -#undef read -#undef write -#undef open -#undef close -#endif - -#include -#if __STDC__ || defined(STDC_HEADERS) -#include -#include -#endif -#include -#include -#include -#include - -/* Type definitions */ - -#define boolean int -#define true 1 -#define false 0 - -/* Various lists */ - -struct line_record -{ - char *string; - struct line_record *continuation; -}; -typedef struct line_record *line_list; - -struct header_record -{ - line_list text; - struct header_record *next; - struct header_record *previous; -}; -typedef struct header_record *header; - -struct stream_record -{ - FILE *handle; - int (*action)(); - struct stream_record *rest_streams; -}; -typedef struct stream_record *stream_list; - -/* A `struct linebuffer' is a structure which holds a line of text. - * `readline' reads a line from a stream into a linebuffer - * and works regardless of the length of the line. - */ - -struct linebuffer -{ - long size; - char *buffer; -}; - -struct linebuffer lb; - -#define new_list() \ - ((line_list) xmalloc (sizeof (struct line_record))) -#define new_header() \ - ((header) xmalloc (sizeof (struct header_record))) -#define new_stream() \ - ((stream_list) xmalloc (sizeof (struct stream_record))) -#define alloc_string(nchars) \ - ((char *) xmalloc ((nchars) + 1)) - -/* Global declarations */ - -#define BUFLEN 1024 -#define KEYWORD_SIZE 256 -#define FROM_PREFIX "From" -#define MY_NAME "fakemail" -#define NIL ((line_list) NULL) -#define INITIAL_LINE_SIZE 200 - -#ifndef MAIL_PROGRAM_NAME -#define MAIL_PROGRAM_NAME "/bin/mail" -#endif - -static CONST char *my_name; -static char *the_date; -static char *the_user; -static line_list file_preface; -static stream_list the_streams; -static boolean no_problems = true; - -#if !__STDC__ && !defined(STDC_HEADERS) -extern FILE *popen (); -extern int fclose (), pclose (); -extern char *malloc (), *realloc (); -#endif - -#ifdef CURRENT_USER -extern struct passwd *getpwuid (); -extern unsigned short geteuid (); -static struct passwd *my_entry; -#define cuserid(s) \ -(my_entry = getpwuid (((int) geteuid ())), \ - my_entry->pw_name) -#endif - -/* Utilities */ - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ - -static void -error (CONST char *s1, CONST char *s2) -{ - printf ("%s: ", my_name); - printf (s1, s2); - printf ("\n"); - no_problems = false; -} - -/* Print error message and exit. */ - -static void -fatal (CONST char *s1, CONST char *s2) -{ - error (s1, s2); - exit (1); -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -static char * -xmalloc (size) - size_t size; -{ - char *result = malloc (((unsigned) size)); - if (result == ((char *) NULL)) - fatal ("virtual memory exhausted", (char *) 0); - return result; -} - -static char * -xrealloc (ptr, size) - char *ptr; - size_t size; -{ - char *result = realloc (ptr, ((unsigned) size)); - if (result == ((char *) NULL)) - fatal ("virtual memory exhausted", (char *) 0); - return result; -} - -/* Initialize a linebuffer for use */ - -static void -init_linebuffer (struct linebuffer *linebuffer) -{ - linebuffer->size = INITIAL_LINE_SIZE; - linebuffer->buffer = ((char *) xmalloc (INITIAL_LINE_SIZE)); -} - -/* Read a line of text from `stream' into `linebuffer'. - * Return the length of the line. - */ - -static long -readline (struct linebuffer *linebuffer, FILE *stream) -{ - char *buffer = linebuffer->buffer; - char *p = linebuffer->buffer; - char *end = p + linebuffer->size; - - while (true) - { - int c = getc (stream); - if (p == end) - { - linebuffer->size *= 2; - buffer = ((char *) xrealloc ((char *) buffer, - (size_t) (linebuffer->size))); - p = buffer + (p - linebuffer->buffer); - end = buffer + linebuffer->size; - linebuffer->buffer = buffer; - } - if (c < 0 || c == '\n') - { - *p = 0; - break; - } - *p++ = c; - } - - return p - buffer; -} - -static char * -get_keyword (register char *field, char **rest) -{ - static char keyword[KEYWORD_SIZE]; - register char *ptr; - register char c; - - ptr = &keyword[0]; - c = *field++; - if ((isspace (c)) || (c == ':')) - return ((char *) NULL); - *ptr++ = ((islower (c)) ? (toupper (c)) : c); - while (((c = *field++) != ':') && (!(isspace (c)))) - *ptr++ = ((islower (c)) ? (toupper (c)) : c); - *ptr++ = '\0'; - while (isspace (c)) c = *field++; - if (c != ':') return ((char *) NULL); - *rest = field; - return &keyword[0]; -} - -static boolean -has_keyword (char *field) -{ - char *ignored; - return (get_keyword (field, &ignored) != ((char *) NULL)); -} - -static char * -add_field (line_list the_list, register char *field, register char *where) -{ - register char c; - while (true) - { - *where++ = ' '; - while ((c = *field++) != '\0') - { - if (c == '(') - { - while (*field && *field != ')') ++field; - if (! (*field++)) break; /* no closer */ - if (! (*field)) break; /* closerNULL */ - c = *field; - } - *where++ = ((c == ','||c=='>'||c=='<') ? ' ' : c); - } - if (the_list == NIL) break; - field = the_list->string; - the_list = the_list->continuation; - } - return where; -} - -static line_list -make_file_preface (void) -{ - char *the_string, *temp; - long idiotic_interface; - long prefix_length; - long user_length; - long date_length; - line_list result; - - prefix_length = strlen (FROM_PREFIX); - time (&idiotic_interface); - the_date = ctime (&idiotic_interface); - /* the_date has an unwanted newline at the end */ - date_length = strlen (the_date) - 1; - the_date[date_length] = '\0'; - temp = cuserid ((char *) NULL); - user_length = strlen (temp); - the_user = alloc_string ((size_t) (user_length + 1)); - strcpy (the_user, temp); - the_string = alloc_string ((size_t) (3 + prefix_length + - user_length + - date_length)); - temp = the_string; - strcpy (temp, FROM_PREFIX); - temp = &temp[prefix_length]; - *temp++ = ' '; - strcpy (temp, the_user); - temp = &temp[user_length]; - *temp++ = ' '; - strcpy (temp, the_date); - result = new_list (); - result->string = the_string; - result->continuation = ((line_list) NULL); - return result; -} - -static void -write_line_list (register line_list the_list, FILE *the_stream) -{ - for ( ; - the_list != ((line_list) NULL) ; - the_list = the_list->continuation) - { - fputs (the_list->string, the_stream); - putc ('\n', the_stream); - } - return; -} - -static int -close_the_streams (void) -{ - register stream_list rem; - for (rem = the_streams; - rem != ((stream_list) NULL); - rem = rem->rest_streams) - no_problems = (no_problems && - ((*rem->action) (rem->handle) == 0)); - the_streams = ((stream_list) NULL); - return (no_problems ? 0 : 1); -} - -static void -add_a_stream (FILE *the_stream, int (*closing_action)()) -{ - stream_list old = the_streams; - the_streams = new_stream (); - the_streams->handle = the_stream; - the_streams->action = closing_action; - the_streams->rest_streams = old; - return; -} - -static int -my_fclose (FILE *the_file) -{ - putc ('\n', the_file); - fflush (the_file); - return fclose (the_file); -} - -static boolean -open_a_file (char *name) -{ - FILE *the_stream = fopen (name, "a"); - if (the_stream != ((FILE *) NULL)) - { - add_a_stream (the_stream, my_fclose); - if (the_user == ((char *) NULL)) - file_preface = make_file_preface (); - write_line_list (file_preface, the_stream); - return true; - } - return false; -} - -static void -put_string (char *s) -{ - register stream_list rem; - for (rem = the_streams; - rem != ((stream_list) NULL); - rem = rem->rest_streams) - fputs (s, rem->handle); - return; -} - -static void -put_line (CONST char *string) -{ - register stream_list rem; - for (rem = the_streams; - rem != ((stream_list) NULL); - rem = rem->rest_streams) - { - CONST char *s = string; - int column = 0; - - /* Divide STRING into lines. */ - while (*s != 0) - { - CONST char *breakpos; - - /* Find the last char that fits. */ - for (breakpos = s; *breakpos && column < 78; ++breakpos) - { - if (*breakpos == '\t') - column += 8; - else - column++; - } - /* If we didn't reach end of line, break the line. */ - if (*breakpos) - { - /* Back up to just after the last comma that fits. */ - while (breakpos != s && breakpos[-1] != ',') --breakpos; - - if (breakpos == s) - { - /* If no comma fits, move past the first address anyway. */ - while (*breakpos != 0 && *breakpos != ',') ++breakpos; - if (*breakpos != 0) - /* Include the comma after it. */ - ++breakpos; - } - } - /* Output that much, then break the line. */ - fwrite (s, 1, breakpos - s, rem->handle); - column = 8; - - /* Skip whitespace and prepare to print more addresses. */ - s = breakpos; - while (*s == ' ' || *s == '\t') ++s; - if (*s != 0) - fputs ("\n\t", rem->handle); - } - putc ('\n', rem->handle); - } - return; -} - -#define mail_error error - -static void -setup_files (register line_list the_list, register char *field) -{ - register char *start; - register char c; - while (true) - { - while (((c = *field) != '\0') && - ((c == ' ') || - (c == '\t') || - (c == ','))) - field += 1; - if (c != '\0') - { - start = field; - while (((c = *field) != '\0') && - (c != ' ') && - (c != '\t') && - (c != ',')) - field += 1; - *field = '\0'; - if (!open_a_file (start)) - mail_error ("Could not open file %s", start); - *field = c; - if (c != '\0') continue; - } - if (the_list == ((line_list) NULL)) return; - field = the_list->string; - the_list = the_list->continuation; - } -} - -static int -args_size (header the_header) -{ - register header old = the_header; - register line_list rem; - register int size = 0; - do - { - char *field; - register char *keyword = get_keyword (the_header->text->string, &field); - if ((strcmp (keyword, "TO") == 0) || - (strcmp (keyword, "CC") == 0) || - (strcmp (keyword, "BCC") == 0)) - { - size += 1 + strlen (field); - for (rem = the_header->text->continuation; - rem != NIL; - rem = rem->continuation) - size += 1 + strlen (rem->string); - } - the_header = the_header->next; - } while (the_header != old); - return size; -} - -static void -parse_header (header the_header, register char *where) -{ - register header old = the_header; - do - { - char *field; - register char *keyword = get_keyword (the_header->text->string, &field); - if (strcmp (keyword, "TO") == 0) - where = add_field (the_header->text->continuation, field, where); - else if (strcmp (keyword, "CC") == 0) - where = add_field (the_header->text->continuation, field, where); - else if (strcmp (keyword, "BCC") == 0) - { - where = add_field (the_header->text->continuation, field, where); - the_header->previous->next = the_header->next; - the_header->next->previous = the_header->previous; - } - else if (strcmp (keyword, "FCC") == 0) - setup_files (the_header->text->continuation, field); - the_header = the_header->next; - } while (the_header != old); - *where = '\0'; - return; -} - -static header -read_header (void) -{ - register header the_header = ((header) NULL); - register line_list *next_line = ((line_list *) NULL); - - init_linebuffer (&lb); - - do - { - long length; - register char *line; - - readline (&lb, stdin); - line = lb.buffer; - length = strlen (line); - if (length == 0) break; - - if (has_keyword (line)) - { - register header old = the_header; - the_header = new_header (); - if (old == ((header) NULL)) - { - the_header->next = the_header; - the_header->previous = the_header; - } - else - { - the_header->previous = old; - the_header->next = old->next; - old->next = the_header; - } - next_line = &(the_header->text); - } - - if (next_line == ((line_list *) NULL)) - { - /* Not a valid header */ - exit (1); - } - *next_line = new_list (); - (*next_line)->string = alloc_string ((size_t) length); - strcpy (((*next_line)->string), line); - next_line = &((*next_line)->continuation); - *next_line = NIL; - - } while (true); - - return the_header->next; -} - -static void -write_header (header the_header) -{ - register header old = the_header; - do - { - register line_list the_list; - for (the_list = the_header->text; - the_list != NIL; - the_list = the_list->continuation) - put_line (the_list->string); - the_header = the_header->next; - } while (the_header != old); - put_line (""); - return; -} - -int -main (argc, argv) - int argc; - char **argv; -{ - char *command_line; - header the_header; - long name_length; - char *mail_program_name; - char buf[BUFLEN + 1]; - register int size; - FILE *the_pipe; - -#if !(__STDC__ || defined(STDC_HEADERS)) - extern char *getenv (); -#endif - - mail_program_name = getenv ("FAKEMAILER"); - if (!(mail_program_name && *mail_program_name)) - mail_program_name = (char *) MAIL_PROGRAM_NAME; - name_length = strlen (mail_program_name); - - my_name = MY_NAME; - the_streams = ((stream_list) NULL); - the_date = ((char *) NULL); - the_user = ((char *) NULL); - - the_header = read_header (); - command_line = alloc_string ((size_t) (name_length + - args_size (the_header))); - strcpy (command_line, mail_program_name); - parse_header (the_header, &command_line[name_length]); - - the_pipe = popen (command_line, "w"); - if (the_pipe == ((FILE *) NULL)) - fatal ("cannot open pipe to real mailer", (char *) 0); - - add_a_stream (the_pipe, pclose); - - write_header (the_header); - - /* Dump the message itself */ - - while (!feof (stdin)) - { - size = fread (buf, 1, BUFLEN, stdin); - buf[size] = '\0'; - put_string (buf); - } - - return close_the_streams (); -} - -#endif /* not MSDOS */ -#endif /* not BSD 4.2 (or newer) */ diff --git a/lib-src/getopt.c b/lib-src/getopt.c deleted file mode 100644 index dd5cc71..0000000 --- a/lib-src/getopt.c +++ /dev/null @@ -1,1032 +0,0 @@ -/* Getopt for GNU. - NOTE: getopt is now part of the C library, so if you don't know what - "Keep this file name-space clean" means, talk to roland@gnu.ai.mit.edu - before changing it! - - Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97 - Free Software Foundation, Inc. - -NOTE: The canonical source of this file is maintained with the GNU C Library. -Bugs can be reported to bug-glibc@prep.ai.mit.edu. - -This program is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ - -/* This tells Alpha OSF/1 not to define a getopt prototype in . - Ditto for AIX 3.2 and . */ -#ifndef _NO_PROTO -#define _NO_PROTO -#endif - -#ifdef HAVE_CONFIG_H -#include <../src/config.h> -#endif - -#include -#include -#include - -/* Comment out all this code if we are using the GNU C Library, and are not - actually compiling the library itself. This code is part of the GNU C - Library, but also included in many other GNU distributions. Compiling - and linking in this code is a waste when using the GNU C library - (especially if it is a shared library). Rather than having every GNU - program understand `configure --with-gnu-libc' and omit the object files, - it is simpler to just do this in the source for each such file. */ - -#define GETOPT_INTERFACE_VERSION 2 -#if !defined (_LIBC) && defined (__GLIBC__) && __GLIBC__ >= 2 -#include -#if _GNU_GETOPT_INTERFACE_VERSION == GETOPT_INTERFACE_VERSION -#define ELIDE_CODE -#endif -#endif - -#ifndef ELIDE_CODE - - -/* This needs to come after some library #include - to get __GNU_LIBRARY__ defined. */ -#ifdef __GNU_LIBRARY__ -/* Don't include stdlib.h for non-GNU C libraries because some of them - contain conflicting prototypes for getopt. */ -#include -#include -#endif /* GNU C library. */ - -#ifdef VMS -#include -#if HAVE_STRING_H - 0 -#include -#endif -#endif - -#if defined (WIN32) && !defined (__CYGWIN32__) -/* It's not Unix, really. See? Capital letters. */ -#include -#undef getpid -#define getpid() GetCurrentProcessId() -#endif - -#ifndef _ -/* This is for other GNU distributions with internationalized messages. - When compiling libc, the _ macro is predefined. */ -#ifdef HAVE_LIBINTL_H -# include -# define _(msgid) gettext (msgid) -#else -# define _(msgid) (msgid) -#endif -#endif - -/* This version of `getopt' appears to the caller like standard Unix `getopt' - but it behaves differently for the user, since it allows the user - to intersperse the options with the other arguments. - - As `getopt' works, it permutes the elements of ARGV so that, - when it is done, all the options precede everything else. Thus - all application programs are extended to handle flexible argument order. - - Setting the environment variable POSIXLY_CORRECT disables permutation. - Then the behavior is completely standard. - - GNU application programs can use a third alternative mode in which - they can distinguish the relative order of options and other arguments. */ - -#include "getopt.h" - -/* For communication from `getopt' to the caller. - When `getopt' finds an option that takes an argument, - the argument value is returned here. - Also, when `ordering' is RETURN_IN_ORDER, - each non-option ARGV-element is returned here. */ - -char *optarg = NULL; - -/* Index in ARGV of the next element to be scanned. - This is used for communication to and from the caller - and for communication between successive calls to `getopt'. - - On entry to `getopt', zero means this is the first call; initialize. - - When `getopt' returns -1, this is the index of the first of the - non-option elements that the caller should itself scan. - - Otherwise, `optind' communicates from one call to the next - how much of ARGV has been scanned so far. */ - -/* 1003.2 says this must be 1 before any call. */ -int optind = 1; - -/* Formerly, initialization of getopt depended on optind==0, which - causes problems with re-calling getopt as programs generally don't - know that. */ - -int __getopt_initialized = 0; - -/* The next char to be scanned in the option-element - in which the last option character we returned was found. - This allows us to pick up the scan where we left off. - - If this is zero, or a null string, it means resume the scan - by advancing to the next ARGV-element. */ - -static char *nextchar; - -/* Callers store zero here to inhibit the error message - for unrecognized options. */ - -int opterr = 1; - -/* Set to an option character which was unrecognized. - This must be initialized on some systems to avoid linking in the - system's own getopt implementation. */ - -int optopt = '?'; - -/* Describe how to deal with options that follow non-option ARGV-elements. - - If the caller did not specify anything, - the default is REQUIRE_ORDER if the environment variable - POSIXLY_CORRECT is defined, PERMUTE otherwise. - - REQUIRE_ORDER means don't recognize them as options; - stop option processing when the first non-option is seen. - This is what Unix does. - This mode of operation is selected by either setting the environment - variable POSIXLY_CORRECT, or using `+' as the first character - of the list of option characters. - - PERMUTE is the default. We permute the contents of ARGV as we scan, - so that eventually all the non-options are at the end. This allows options - to be given in any order, even with programs that were not written to - expect this. - - RETURN_IN_ORDER is an option available to programs that were written - to expect options and other ARGV-elements in any order and that care about - the ordering of the two. We describe each non-option ARGV-element - as if it were the argument of an option with character code 1. - Using `-' as the first character of the list of option characters - selects this mode of operation. - - The special argument `--' forces an end of option-scanning regardless - of the value of `ordering'. In the case of RETURN_IN_ORDER, only - `--' can cause `getopt' to return -1 with `optind' != ARGC. */ - -static enum -{ - REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER -} ordering; - -/* Value of POSIXLY_CORRECT environment variable. */ -static char *posixly_correct; - -#ifdef __GNU_LIBRARY__ -/* We want to avoid inclusion of string.h with non-GNU libraries - because there are many ways it can cause trouble. - On some systems, it contains special magic macros that don't work - in GCC. */ -#include -#define my_index strchr -#else - -/* Avoid depending on library functions or files - whose names are inconsistent. */ - -char *getenv (); - -static char * -my_index (const char *str, int chr) -{ - while (*str) - { - if (*str == chr) - return (char *) str; - str++; - } - return 0; -} - -/* If using GCC, we can safely declare strlen this way. - If not using GCC, it is ok not to declare it. */ -#ifdef __GNUC__ -/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h. - That was relevant to code that was here before. */ -#if !defined (__STDC__) || !__STDC__ -/* gcc with -traditional declares the built-in strlen to return int, - and has done so at least since version 2.4.5. -- rms. */ -extern int strlen (const char *); -#endif /* not __STDC__ */ -#endif /* __GNUC__ */ - -#endif /* not __GNU_LIBRARY__ */ - -/* Handle permutation of arguments. */ - -/* Describe the part of ARGV that contains non-options that have - been skipped. `first_nonopt' is the index in ARGV of the first of them; - `last_nonopt' is the index after the last of them. */ - -static int first_nonopt; -static int last_nonopt; - -#ifdef _LIBC -/* Bash 2.0 gives us an environment variable containing flags - indicating ARGV elements that should not be considered arguments. */ - -/* Defined in getopt_init.c */ -extern char *__getopt_nonoption_flags; - -static int nonoption_flags_max_len; -static int nonoption_flags_len; - -static int original_argc; -static char *const *original_argv; - -extern pid_t __libc_pid; - -/* Make sure the environment variable bash 2.0 puts in the environment - is valid for the getopt call we must make sure that the ARGV passed - to getopt is that one passed to the process. */ -static void -__attribute__ ((unused)) -store_args_and_env (int argc, char *const *argv) -{ - /* XXX This is no good solution. We should rather copy the args so - that we can compare them later. But we must not use malloc(3). */ - original_argc = argc; - original_argv = argv; -} -text_set_element (__libc_subinit, store_args_and_env); - -# define SWAP_FLAGS(ch1, ch2) \ - if (nonoption_flags_len > 0) \ - { \ - char __tmp = __getopt_nonoption_flags[ch1]; \ - __getopt_nonoption_flags[ch1] = __getopt_nonoption_flags[ch2]; \ - __getopt_nonoption_flags[ch2] = __tmp; \ - } -#else /* !_LIBC */ -# define SWAP_FLAGS(ch1, ch2) -#endif /* _LIBC */ - -/* Exchange two adjacent subsequences of ARGV. - One subsequence is elements [first_nonopt,last_nonopt) - which contains all the non-options that have been skipped so far. - The other is elements [last_nonopt,optind), which contains all - the options processed since those non-options were skipped. - - `first_nonopt' and `last_nonopt' are relocated so that they describe - the new indices of the non-options in ARGV after they are moved. */ - -#if defined (__STDC__) && __STDC__ -static void exchange (char **); -#endif - -static void -exchange (char **argv) -{ - int bottom = first_nonopt; - int middle = last_nonopt; - int top = optind; - char *tem; - - /* Exchange the shorter segment with the far end of the longer segment. - That puts the shorter segment into the right place. - It leaves the longer segment in the right place overall, - but it consists of two parts that need to be swapped next. */ - -#ifdef _LIBC - /* First make sure the handling of the `__getopt_nonoption_flags' - string can work normally. Our top argument must be in the range - of the string. */ - if (nonoption_flags_len > 0 && top >= nonoption_flags_max_len) - { - /* We must extend the array. The user plays games with us and - presents new arguments. */ - char *new_str = malloc (top + 1); - if (new_str == NULL) - nonoption_flags_len = nonoption_flags_max_len = 0; - else - { - memcpy (new_str, __getopt_nonoption_flags, nonoption_flags_max_len); - memset (&new_str[nonoption_flags_max_len], '\0', - top + 1 - nonoption_flags_max_len); - nonoption_flags_max_len = top + 1; - __getopt_nonoption_flags = new_str; - } - } -#endif - - while (top > middle && middle > bottom) - { - if (top - middle > middle - bottom) - { - /* Bottom segment is the short one. */ - int len = middle - bottom; - register int i; - - /* Swap it with the top part of the top segment. */ - for (i = 0; i < len; i++) - { - tem = argv[bottom + i]; - argv[bottom + i] = argv[top - (middle - bottom) + i]; - argv[top - (middle - bottom) + i] = tem; - SWAP_FLAGS (bottom + i, top - (middle - bottom) + i); - } - /* Exclude the moved bottom segment from further swapping. */ - top -= len; - } - else - { - /* Top segment is the short one. */ - int len = top - middle; - register int i; - - /* Swap it with the bottom part of the bottom segment. */ - for (i = 0; i < len; i++) - { - tem = argv[bottom + i]; - argv[bottom + i] = argv[middle + i]; - argv[middle + i] = tem; - SWAP_FLAGS (bottom + i, middle + i); - } - /* Exclude the moved top segment from further swapping. */ - bottom += len; - } - } - - /* Update records for the slots the non-options now occupy. */ - - first_nonopt += (optind - last_nonopt); - last_nonopt = optind; -} - -/* Initialize the internal data when the first call is made. */ - -#if defined (__STDC__) && __STDC__ -static const char *_getopt_initialize (int, char *const *, const char *); -#endif -static const char * -_getopt_initialize (int argc, char *const *argv, const char *optstring) -{ - /* Start processing options with ARGV-element 1 (since ARGV-element 0 - is the program name); the sequence of previously skipped - non-option ARGV-elements is empty. */ - - first_nonopt = last_nonopt = optind; - - nextchar = NULL; - - posixly_correct = getenv ("POSIXLY_CORRECT"); - - /* Determine how to handle the ordering of options and nonoptions. */ - - if (optstring[0] == '-') - { - ordering = RETURN_IN_ORDER; - ++optstring; - } - else if (optstring[0] == '+') - { - ordering = REQUIRE_ORDER; - ++optstring; - } - else if (posixly_correct != NULL) - ordering = REQUIRE_ORDER; - else - ordering = PERMUTE; - -#ifdef _LIBC - if (posixly_correct == NULL - && argc == original_argc && argv == original_argv) - { - if (nonoption_flags_max_len == 0) - { - if (__getopt_nonoption_flags == NULL - || __getopt_nonoption_flags[0] == '\0') - nonoption_flags_max_len = -1; - else - { - const char *orig_str = __getopt_nonoption_flags; - int len = nonoption_flags_max_len = strlen (orig_str); - if (nonoption_flags_max_len < argc) - nonoption_flags_max_len = argc; - __getopt_nonoption_flags = - (char *) malloc (nonoption_flags_max_len); - if (__getopt_nonoption_flags == NULL) - nonoption_flags_max_len = -1; - else - { - memcpy (__getopt_nonoption_flags, orig_str, len); - memset (&__getopt_nonoption_flags[len], '\0', - nonoption_flags_max_len - len); - } - } - } - nonoption_flags_len = nonoption_flags_max_len; - } - else - nonoption_flags_len = 0; -#endif - - return optstring; -} - -/* Scan elements of ARGV (whose length is ARGC) for option characters - given in OPTSTRING. - - If an element of ARGV starts with '-', and is not exactly "-" or "--", - then it is an option element. The characters of this element - (aside from the initial '-') are option characters. If `getopt' - is called repeatedly, it returns successively each of the option characters - from each of the option elements. - - If `getopt' finds another option character, it returns that character, - updating `optind' and `nextchar' so that the next call to `getopt' can - resume the scan with the following option character or ARGV-element. - - If there are no more option characters, `getopt' returns -1. - Then `optind' is the index in ARGV of the first ARGV-element - that is not an option. (The ARGV-elements have been permuted - so that those that are not options now come last.) - - OPTSTRING is a string containing the legitimate option characters. - If an option character is seen that is not listed in OPTSTRING, - return '?' after printing an error message. If you set `opterr' to - zero, the error message is suppressed but we still return '?'. - - If a char in OPTSTRING is followed by a colon, that means it wants an arg, - so the following text in the same ARGV-element, or the text of the following - ARGV-element, is returned in `optarg'. Two colons mean an option that - wants an optional arg; if there is text in the current ARGV-element, - it is returned in `optarg', otherwise `optarg' is set to zero. - - If OPTSTRING starts with `-' or `+', it requests different methods of - handling the non-option ARGV-elements. - See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above. - - Long-named options begin with `--' instead of `-'. - Their names may be abbreviated as long as the abbreviation is unique - or is an exact match for some defined option. If they have an - argument, it follows the option name in the same ARGV-element, separated - from the option name by a `=', or else the in next ARGV-element. - When `getopt' finds a long-named option, it returns 0 if that option's - `flag' field is nonzero, the value of the option's `val' field - if the `flag' field is zero. - - The elements of ARGV aren't really const, because we permute them. - But we pretend they're const in the prototype to be compatible - with other systems. - - LONGOPTS is a vector of `struct option' terminated by an - element containing a name which is zero. - - LONGIND returns the index in LONGOPT of the long-named option found. - It is only valid when a long-named option has been found by the most - recent call. - - If LONG_ONLY is nonzero, '-' as well as '--' can introduce - long-named options. */ - -int -_getopt_internal (int argc, char *const *argv, const char *optstring, - const struct option *longopts, int *longind, int long_only) -{ - optarg = NULL; - - if (optind == 0 || !__getopt_initialized) - { - if (optind == 0) - optind = 1; /* Don't scan ARGV[0], the program name. */ - optstring = _getopt_initialize (argc, argv, optstring); - __getopt_initialized = 1; - } - - /* Test whether ARGV[optind] points to a non-option argument. - Either it does not have option syntax, or there is an environment flag - from the shell indicating it is not an option. The later information - is only used when the used in the GNU libc. */ -#ifdef _LIBC -#define NONOPTION_P (argv[optind][0] != '-' || argv[optind][1] == '\0' \ - || (optind < nonoption_flags_len \ - && __getopt_nonoption_flags[optind] == '1')) -#else -#define NONOPTION_P (argv[optind][0] != '-' || argv[optind][1] == '\0') -#endif - - if (nextchar == NULL || *nextchar == '\0') - { - /* Advance to the next ARGV-element. */ - - /* Give FIRST_NONOPT & LAST_NONOPT rational values if OPTIND has been - moved back by the user (who may also have changed the arguments). */ - if (last_nonopt > optind) - last_nonopt = optind; - if (first_nonopt > optind) - first_nonopt = optind; - - if (ordering == PERMUTE) - { - /* If we have just processed some options following some non-options, - exchange them so that the options come first. */ - - if (first_nonopt != last_nonopt && last_nonopt != optind) - exchange ((char **) argv); - else if (last_nonopt != optind) - first_nonopt = optind; - - /* Skip any additional non-options - and extend the range of non-options previously skipped. */ - - while (optind < argc && NONOPTION_P) - optind++; - last_nonopt = optind; - } - - /* The special ARGV-element `--' means premature end of options. - Skip it like a null option, - then exchange with previous non-options as if it were an option, - then skip everything else like a non-option. */ - - if (optind != argc && !strcmp (argv[optind], "--")) - { - optind++; - - if (first_nonopt != last_nonopt && last_nonopt != optind) - exchange ((char **) argv); - else if (first_nonopt == last_nonopt) - first_nonopt = optind; - last_nonopt = argc; - - optind = argc; - } - - /* If we have done all the ARGV-elements, stop the scan - and back over any non-options that we skipped and permuted. */ - - if (optind == argc) - { - /* Set the next-arg-index to point at the non-options - that we previously skipped, so the caller will digest them. */ - if (first_nonopt != last_nonopt) - optind = first_nonopt; - return -1; - } - - /* If we have come to a non-option and did not permute it, - either stop the scan or describe it to the caller and pass it by. */ - - if (NONOPTION_P) - { - if (ordering == REQUIRE_ORDER) - return -1; - optarg = argv[optind++]; - return 1; - } - - /* We have found another option-ARGV-element. - Skip the initial punctuation. */ - - nextchar = (argv[optind] + 1 - + (longopts != NULL && argv[optind][1] == '-')); - } - - /* Decode the current option-ARGV-element. */ - - /* Check whether the ARGV-element is a long option. - - If long_only and the ARGV-element has the form "-f", where f is - a valid short option, don't consider it an abbreviated form of - a long option that starts with f. Otherwise there would be no - way to give the -f short option. - - On the other hand, if there's a long option "fubar" and - the ARGV-element is "-fu", do consider that an abbreviation of - the long option, just like "--fu", and not "-f" with arg "u". - - This distinction seems to be the most useful approach. */ - - if (longopts != NULL - && (argv[optind][1] == '-' - || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1]))))) - { - char *nameend; - const struct option *p; - const struct option *pfound = NULL; - int exact = 0; - int ambig = 0; - int indfound = -1; - int option_index; - - for (nameend = nextchar; *nameend && *nameend != '='; nameend++) - /* Do nothing. */ ; - - /* Test all long options for either exact match - or abbreviated matches. */ - for (p = longopts, option_index = 0; p->name; p++, option_index++) - if (!strncmp (p->name, nextchar, nameend - nextchar)) - { - if ((unsigned int) (nameend - nextchar) - == (unsigned int) strlen (p->name)) - { - /* Exact match found. */ - pfound = p; - indfound = option_index; - exact = 1; - break; - } - else if (pfound == NULL) - { - /* First nonexact match found. */ - pfound = p; - indfound = option_index; - } - else - /* Second or later nonexact match found. */ - ambig = 1; - } - - if (ambig && !exact) - { - if (opterr) - fprintf (stderr, _("%s: option `%s' is ambiguous\n"), - argv[0], argv[optind]); - nextchar += strlen (nextchar); - optind++; - optopt = 0; - return '?'; - } - - if (pfound != NULL) - { - option_index = indfound; - optind++; - if (*nameend) - { - /* Don't test has_arg with >, because some C compilers don't - allow it to be used on enums. */ - if (pfound->has_arg) - optarg = nameend + 1; - else - { - if (opterr) { - if (argv[optind - 1][1] == '-') - /* --option */ - fprintf (stderr, - _("%s: option `--%s' doesn't allow an argument\n"), - argv[0], pfound->name); - else - /* +option or -option */ - fprintf (stderr, - _("%s: option `%c%s' doesn't allow an argument\n"), - argv[0], argv[optind - 1][0], pfound->name); - } - nextchar += strlen (nextchar); - - optopt = pfound->val; - return '?'; - } - } - else if (pfound->has_arg == 1) - { - if (optind < argc) - optarg = argv[optind++]; - else - { - if (opterr) - fprintf (stderr, - _("%s: option `%s' requires an argument\n"), - argv[0], argv[optind - 1]); - nextchar += strlen (nextchar); - optopt = pfound->val; - return optstring[0] == ':' ? ':' : '?'; - } - } - nextchar += strlen (nextchar); - if (longind != NULL) - *longind = option_index; - if (pfound->flag) - { - *(pfound->flag) = pfound->val; - return 0; - } - return pfound->val; - } - - /* Can't find it as a long option. If this is not getopt_long_only, - or the option starts with '--' or is not a valid short - option, then it's an error. - Otherwise interpret it as a short option. */ - if (!long_only || argv[optind][1] == '-' - || my_index (optstring, *nextchar) == NULL) - { - if (opterr) - { - if (argv[optind][1] == '-') - /* --option */ - fprintf (stderr, _("%s: unrecognized option `--%s'\n"), - argv[0], nextchar); - else - /* +option or -option */ - fprintf (stderr, _("%s: unrecognized option `%c%s'\n"), - argv[0], argv[optind][0], nextchar); - } - nextchar = (char *) ""; - optind++; - optopt = 0; - return '?'; - } - } - - /* Look at and handle the next short option-character. */ - - { - char c = *nextchar++; - char *temp = my_index (optstring, c); - - /* Increment `optind' when we start to process its last character. */ - if (*nextchar == '\0') - ++optind; - - if (temp == NULL || c == ':') - { - if (opterr) - { - if (posixly_correct) - /* 1003.2 specifies the format of this message. */ - fprintf (stderr, _("%s: illegal option -- %c\n"), - argv[0], c); - else - fprintf (stderr, _("%s: invalid option -- %c\n"), - argv[0], c); - } - optopt = c; - return '?'; - } - /* Convenience. Treat POSIX -W foo same as long option --foo */ - if (temp[0] == 'W' && temp[1] == ';') - { - char *nameend; - const struct option *p; - const struct option *pfound = NULL; - int exact = 0; - int ambig = 0; - int indfound = 0; - int option_index; - - /* This is an option that requires an argument. */ - if (*nextchar != '\0') - { - optarg = nextchar; - /* If we end this ARGV-element by taking the rest as an arg, - we must advance to the next element now. */ - optind++; - } - else if (optind == argc) - { - if (opterr) - { - /* 1003.2 specifies the format of this message. */ - fprintf (stderr, _("%s: option requires an argument -- %c\n"), - argv[0], c); - } - optopt = c; - if (optstring[0] == ':') - c = ':'; - else - c = '?'; - return c; - } - else - /* We already incremented `optind' once; - increment it again when taking next ARGV-elt as argument. */ - optarg = argv[optind++]; - - /* optarg is now the argument, see if it's in the - table of longopts. */ - - for (nextchar = nameend = optarg; *nameend && *nameend != '='; nameend++) - /* Do nothing. */ ; - - /* Test all long options for either exact match - or abbreviated matches. */ - for (p = longopts, option_index = 0; p->name; p++, option_index++) - if (!strncmp (p->name, nextchar, nameend - nextchar)) - { - if ((unsigned int) (nameend - nextchar) == strlen (p->name)) - { - /* Exact match found. */ - pfound = p; - indfound = option_index; - exact = 1; - break; - } - else if (pfound == NULL) - { - /* First nonexact match found. */ - pfound = p; - indfound = option_index; - } - else - /* Second or later nonexact match found. */ - ambig = 1; - } - if (ambig && !exact) - { - if (opterr) - fprintf (stderr, _("%s: option `-W %s' is ambiguous\n"), - argv[0], argv[optind]); - nextchar += strlen (nextchar); - optind++; - return '?'; - } - if (pfound != NULL) - { - option_index = indfound; - if (*nameend) - { - /* Don't test has_arg with >, because some C compilers don't - allow it to be used on enums. */ - if (pfound->has_arg) - optarg = nameend + 1; - else - { - if (opterr) - fprintf (stderr, _("\ -%s: option `-W %s' doesn't allow an argument\n"), - argv[0], pfound->name); - - nextchar += strlen (nextchar); - return '?'; - } - } - else if (pfound->has_arg == 1) - { - if (optind < argc) - optarg = argv[optind++]; - else - { - if (opterr) - fprintf (stderr, - _("%s: option `%s' requires an argument\n"), - argv[0], argv[optind - 1]); - nextchar += strlen (nextchar); - return optstring[0] == ':' ? ':' : '?'; - } - } - nextchar += strlen (nextchar); - if (longind != NULL) - *longind = option_index; - if (pfound->flag) - { - *(pfound->flag) = pfound->val; - return 0; - } - return pfound->val; - } - nextchar = NULL; - return 'W'; /* Let the application handle it. */ - } - if (temp[1] == ':') - { - if (temp[2] == ':') - { - /* This is an option that accepts an argument optionally. */ - if (*nextchar != '\0') - { - optarg = nextchar; - optind++; - } - else - optarg = NULL; - nextchar = NULL; - } - else - { - /* This is an option that requires an argument. */ - if (*nextchar != '\0') - { - optarg = nextchar; - /* If we end this ARGV-element by taking the rest as an arg, - we must advance to the next element now. */ - optind++; - } - else if (optind == argc) - { - if (opterr) - { - /* 1003.2 specifies the format of this message. */ - fprintf (stderr, - _("%s: option requires an argument -- %c\n"), - argv[0], c); - } - optopt = c; - if (optstring[0] == ':') - c = ':'; - else - c = '?'; - } - else - /* We already incremented `optind' once; - increment it again when taking next ARGV-elt as argument. */ - optarg = argv[optind++]; - nextchar = NULL; - } - } - return c; - } -} - -int -getopt (int argc, char *const *argv, const char *optstring) -{ - return _getopt_internal (argc, argv, optstring, - (const struct option *) 0, - (int *) 0, - 0); -} - -#endif /* Not ELIDE_CODE. */ - -#ifdef TEST - -/* Compile with -DTEST to make an executable for use in testing - the above definition of `getopt'. */ - -int -main (int argc, char **argv) -{ - int c; - int digit_optind = 0; - - while (1) - { - int this_option_optind = optind ? optind : 1; - - c = getopt (argc, argv, "abc:d:0123456789"); - if (c == -1) - break; - - switch (c) - { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (digit_optind != 0 && digit_optind != this_option_optind) - printf ("digits occur in two different argv-elements.\n"); - digit_optind = this_option_optind; - printf ("option %c\n", c); - break; - - case 'a': - printf ("option a\n"); - break; - - case 'b': - printf ("option b\n"); - break; - - case 'c': - printf ("option c with value `%s'\n", optarg); - break; - - case '?': - break; - - default: - printf ("?? getopt returned character code 0%o ??\n", c); - } - } - - if (optind < argc) - { - printf ("non-option ARGV-elements: "); - while (optind < argc) - printf ("%s ", argv[optind++]); - printf ("\n"); - } - - exit (0); -} - -#endif /* TEST */ diff --git a/lib-src/getopt.h b/lib-src/getopt.h deleted file mode 100644 index 69256fd..0000000 --- a/lib-src/getopt.h +++ /dev/null @@ -1,133 +0,0 @@ -/* Declarations for getopt. - Copyright (C) 1989,90,91,92,93,94,96,97 Free Software Foundation, Inc. - -NOTE: The canonical source of this file is maintained with the GNU C Library. -Bugs can be reported to bug-glibc@prep.ai.mit.edu. - -This program is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ - -#ifndef _GETOPT_H -#define _GETOPT_H 1 - -#ifdef __cplusplus -extern "C" { -#endif - -/* For communication from `getopt' to the caller. - When `getopt' finds an option that takes an argument, - the argument value is returned here. - Also, when `ordering' is RETURN_IN_ORDER, - each non-option ARGV-element is returned here. */ - -extern char *optarg; - -/* Index in ARGV of the next element to be scanned. - This is used for communication to and from the caller - and for communication between successive calls to `getopt'. - - On entry to `getopt', zero means this is the first call; initialize. - - When `getopt' returns -1, this is the index of the first of the - non-option elements that the caller should itself scan. - - Otherwise, `optind' communicates from one call to the next - how much of ARGV has been scanned so far. */ - -extern int optind; - -/* Callers store zero here to inhibit the error message `getopt' prints - for unrecognized options. */ - -extern int opterr; - -/* Set to an option character which was unrecognized. */ - -extern int optopt; - -/* Describe the long-named options requested by the application. - The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector - of `struct option' terminated by an element containing a name which is - zero. - - The field `has_arg' is: - no_argument (or 0) if the option does not take an argument, - required_argument (or 1) if the option requires an argument, - optional_argument (or 2) if the option takes an optional argument. - - If the field `flag' is not NULL, it points to a variable that is set - to the value given in the field `val' when the option is found, but - left unchanged if the option is not found. - - To have a long-named option do something other than set an `int' to - a compiled-in constant, such as set a value from `optarg', set the - option's `flag' field to zero and its `val' field to a nonzero - value (the equivalent single-letter option character, if there is - one). For long options that have a zero `flag' field, `getopt' - returns the contents of the `val' field. */ - -struct option -{ -#if defined (__STDC__) && __STDC__ - const char *name; -#else - char *name; -#endif - /* has_arg can't be an enum because some compilers complain about - type mismatches in all the code that assumes it is an int. */ - int has_arg; - int *flag; - int val; -}; - -/* Names for the values of the `has_arg' field of `struct option'. */ - -#define no_argument 0 -#define required_argument 1 -#define optional_argument 2 - -#if defined (__STDC__) && __STDC__ -#ifdef __GNU_LIBRARY__ -/* Many other libraries have conflicting prototypes for getopt, with - differences in the consts, in stdlib.h. To avoid compilation - errors, only prototype getopt for the GNU C library. */ -extern int getopt (int argc, char *const *argv, const char *shortopts); -#else /* not __GNU_LIBRARY__ */ -extern int getopt (); -#endif /* __GNU_LIBRARY__ */ -extern int getopt_long (int argc, char *const *argv, const char *shortopts, - const struct option *longopts, int *longind); -extern int getopt_long_only (int argc, char *const *argv, - const char *shortopts, - const struct option *longopts, int *longind); - -/* Internal only. Users should not call this directly. */ -extern int _getopt_internal (int argc, char *const *argv, - const char *shortopts, - const struct option *longopts, int *longind, - int long_only); -#else /* not __STDC__ */ -extern int getopt (); -extern int getopt_long (); -extern int getopt_long_only (); - -extern int _getopt_internal (); -#endif /* __STDC__ */ - -#ifdef __cplusplus -} -#endif - -#endif /* _GETOPT_H */ diff --git a/lib-src/getopt1.c b/lib-src/getopt1.c deleted file mode 100644 index 1492066..0000000 --- a/lib-src/getopt1.c +++ /dev/null @@ -1,171 +0,0 @@ -/* getopt_long and getopt_long_only entry points for GNU getopt. - Copyright (C) 1987,88,89,90,91,92,93,94,96,97 Free Software Foundation, Inc. - -NOTE: The canonical source of this file is maintained with the GNU C Library. -Bugs can be reported to bug-glibc@prep.ai.mit.edu. - -This program is free software; you can redistribute it and/or modify it -under the terms of the GNU General Public License as published by the -Free Software Foundation; either version 2, or (at your option) any -later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -USA. */ - -#ifdef HAVE_CONFIG_H -#include <../src/config.h> -#endif - -#include "getopt.h" - -#include - -/* Comment out all this code if we are using the GNU C Library, and are not - actually compiling the library itself. This code is part of the GNU C - Library, but also included in many other GNU distributions. Compiling - and linking in this code is a waste when using the GNU C library - (especially if it is a shared library). Rather than having every GNU - program understand `configure --with-gnu-libc' and omit the object files, - it is simpler to just do this in the source for each such file. */ - -#define GETOPT_INTERFACE_VERSION 2 -#if !defined (_LIBC) && defined (__GLIBC__) && __GLIBC__ >= 2 -#include -#if _GNU_GETOPT_INTERFACE_VERSION == GETOPT_INTERFACE_VERSION -#define ELIDE_CODE -#endif -#endif - -#ifndef ELIDE_CODE - - -/* This needs to come after some library #include - to get __GNU_LIBRARY__ defined. */ -#ifdef __GNU_LIBRARY__ -#include -#endif - -#ifndef NULL -#define NULL 0 -#endif - -int -getopt_long (int argc, char *const *argv, const char *options, - const struct option *long_options, int *opt_index) -{ - return _getopt_internal (argc, argv, options, long_options, opt_index, 0); -} - -/* Like getopt_long, but '-' as well as '--' can indicate a long option. - If an option that starts with '-' (not '--') doesn't match a long option, - but does match a short option, it is parsed as a short option - instead. */ - -int -getopt_long_only (int argc, char *const *argv, const char *options, - const struct option *long_options, int *opt_index) -{ - return _getopt_internal (argc, argv, options, long_options, opt_index, 1); -} - - -#endif /* Not ELIDE_CODE. */ - -#ifdef TEST - -#include - -int -main (int argc, char **argv) -{ - int c; - int digit_optind = 0; - - while (1) - { - int this_option_optind = optind ? optind : 1; - int option_index = 0; - static struct option long_options[] = - { - {"add", 1, 0, 0}, - {"append", 0, 0, 0}, - {"delete", 1, 0, 0}, - {"verbose", 0, 0, 0}, - {"create", 0, 0, 0}, - {"file", 1, 0, 0}, - {0, 0, 0, 0} - }; - - c = getopt_long (argc, argv, "abc:d:0123456789", - long_options, &option_index); - if (c == -1) - break; - - switch (c) - { - case 0: - printf ("option %s", long_options[option_index].name); - if (optarg) - printf (" with arg %s", optarg); - printf ("\n"); - break; - - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (digit_optind != 0 && digit_optind != this_option_optind) - printf ("digits occur in two different argv-elements.\n"); - digit_optind = this_option_optind; - printf ("option %c\n", c); - break; - - case 'a': - printf ("option a\n"); - break; - - case 'b': - printf ("option b\n"); - break; - - case 'c': - printf ("option c with value `%s'\n", optarg); - break; - - case 'd': - printf ("option d with value `%s'\n", optarg); - break; - - case '?': - break; - - default: - printf ("?? getopt returned character code 0%o ??\n", c); - } - } - - if (optind < argc) - { - printf ("non-option ARGV-elements: "); - while (optind < argc) - printf ("%s ", argv[optind++]); - printf ("\n"); - } - - exit (0); -} - -#endif /* TEST */ diff --git a/lib-src/gnuclient.c b/lib-src/gnuclient.c deleted file mode 100644 index 4fd2771..0000000 --- a/lib-src/gnuclient.c +++ /dev/null @@ -1,687 +0,0 @@ -/* -*-C-*- - Client code to allow local and remote editing of files by XEmacs. - Copyright (C) 1989 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - Author: Andy Norman (ange@hplb.hpl.hp.com), based on - 'etc/emacsclient.c' from the GNU Emacs 18.52 distribution. - - Please mail bugs and suggestions to the XEmacs maintainer. -*/ - -/* - * This file incorporates new features added by Bob Weiner , - * Darrell Kindred and Arup Mukherjee . - * GNUATTACH support added by Ben Wing . - * Please see the note at the end of the README file for details. - * - * (If gnuserv came bundled with your emacs, the README file is probably - * ../etc/gnuserv.README relative to the directory containing this file) - */ - -#if 0 -/* Hand-munged RCS header */ -static char rcsid [] = "!Header: gnuclient.c,v 2.2 95/12/12 01:39:21 wing nene !"; -#endif - -#include "gnuserv.h" -#include "getopt.h" - -#include -#include -#include - -#ifdef HAVE_STRING_H -#include -#endif /* HAVE_STRING_H */ - -#ifdef HAVE_UNISTD_H -#include -#endif /* HAVE_UNISTD_H */ - -#include - -#if !defined(SYSV_IPC) && !defined(UNIX_DOMAIN_SOCKETS) && \ - !defined(INTERNET_DOMAIN_SOCKETS) -int -main (int argc, char *argv[]) -{ - fprintf (stderr, "Sorry, the Emacs server is only " - "supported on systems that have\n"); - fprintf (stderr, "Unix Domain sockets, Internet Domain " - "sockets or System V IPC.\n"); - exit (1); -} /* main */ -#else /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */ - -static char cwd[MAXPATHLEN+2]; /* current working directory when calculated */ -static char *cp = NULL; /* ptr into valid bit of cwd above */ - -static pid_t emacs_pid; /* Process id for emacs process */ - -void initialize_signals (void); - -static void -tell_emacs_to_resume (int sig) -{ - char buffer[GSERV_BUFSZ+1]; - int s; /* socket / msqid to server */ - int connect_type; /* CONN_UNIX, CONN_INTERNET, or - ONN_IPC */ - - /* Why is SYSV so retarded? */ - /* We want emacs to realize that we are resuming */ - signal(SIGCONT, tell_emacs_to_resume); - - connect_type = make_connection (NULL, (u_short) 0, &s); - - sprintf(buffer,"(gnuserv-eval '(resume-pid-console %d))", (int)getpid()); - send_string(s, buffer); - -#ifdef SYSV_IPC - if (connect_type == (int) CONN_IPC) - disconnect_from_ipc_server (s, msgp, FALSE); -#else /* !SYSV_IPC */ - if (connect_type != (int) CONN_IPC) - disconnect_from_server (s, FALSE); -#endif /* !SYSV_IPC */ -} - -static void -pass_signal_to_emacs (int sig) -{ - if (kill (emacs_pid, sig) == -1) - { - fprintf (stderr, "gnuattach: Could not pass signal to emacs process\n"); - exit (1); - } - initialize_signals (); -} - -void -initialize_signals () -{ - /* Set up signal handler to pass relevant signals to emacs process. - We used to send SIGSEGV, SIGBUS, SIGPIPE, SIGILL and others to - Emacs, but I think it's better not to. I can see no reason why - Emacs should SIGSEGV whenever gnuclient SIGSEGV-s, etc. */ - signal (SIGQUIT, pass_signal_to_emacs); - signal (SIGINT, pass_signal_to_emacs); -#ifdef SIGWINCH - signal (SIGWINCH, pass_signal_to_emacs); -#endif - - /* We want emacs to realize that we are resuming */ - signal (SIGCONT, tell_emacs_to_resume); -} - - -/* - get_current_working_directory -- return the cwd. -*/ -static char * -get_current_working_directory (void) -{ - if (cp == NULL) - { /* haven't calculated it yet */ -#ifdef BSD - if (getwd (cwd) == 0) -#else /* !BSD */ - if (getcwd (cwd,MAXPATHLEN) == NULL) -#endif /* !BSD */ - { - perror (progname); - fprintf (stderr, "%s: unable to get current working directory\n", - progname); - exit (1); - } /* if */ - - /* on some systems, cwd can look like '@machine/' ... */ - /* ignore everything before the first '/' */ - for (cp = cwd; *cp && *cp != '/'; ++cp) - ; - - } /* if */ - - return cp; - -} /* get_current_working_directory */ - - -/* - filename_expand -- try to convert the given filename into a fully-qualified - pathname. -*/ -static void -filename_expand (char *fullpath, char *filename) - /* fullpath - returned full pathname */ - /* filename - filename to expand */ -{ - int len; - - fullpath[0] = '\0'; - - if (filename[0] && filename[0] == '/') - { - /* Absolute (unix-style) pathname. Do nothing */ - strcat (fullpath, filename); - } -#ifdef __CYGWIN32__ - else if (filename[0] && filename[0] == '\\' && - filename[1] && filename[1] == '\\') - { - /* This path includes the server name (something like - "\\server\path"), so we assume it's absolute. Do nothing to - it. */ - strcat (fullpath, filename); - } - else if (filename[0] && - filename[1] && filename[1] == ':' && - filename[2] && filename[2] == '\\') - { - /* Absolute pathname with drive letter. Convert ":" - to "///". */ - strcat (fullpath, "//"); - strncat (fullpath, filename, 1); - strcat (fullpath, &filename[2]); - } -#endif - else - { - /* Assume relative Unix style path. Get the current directory - and prepend it. FIXME: need to fix the case of DOS paths like - "\foo", where we need to get the current drive. */ - - strcat (fullpath, get_current_working_directory ()); - len = strlen (fullpath); - - if (len > 0 && fullpath[len-1] == '/') /* trailing slash already? */ - ; /* yep */ - else - strcat (fullpath, "/"); /* nope, append trailing slash */ - /* Don't forget to add the filename! */ - strcat (fullpath,filename); - } -} /* filename_expand */ - -/* Encase the string in quotes, escape all the backslashes and quotes - in string. */ -static char * -clean_string (CONST char *s) -{ - int i = 0; - char *p, *res; - - { - CONST char *const_p; - for (const_p = s; *const_p; const_p++, i++) - { - if (*const_p == '\\' || *const_p == '\"') - ++i; - else if (*const_p == '\004') - i += 3; - } - } - - p = res = (char *) malloc (i + 2 + 1); - *p++ = '\"'; - for (; *s; p++, s++) - { - switch (*s) - { - case '\\': - *p++ = '\\'; - *p = '\\'; - break; - case '\"': - *p++ = '\\'; - *p = '\"'; - break; - case '\004': - *p++ = '\\'; - *p++ = 'C'; - *p++ = '-'; - *p = 'd'; - break; - default: - *p = *s; - } - } - *p++ = '\"'; - *p = '\0'; - return res; -} - -#define GET_ARGUMENT(var, desc) do { \ - if (*(p + 1)) (var) = p + 1; \ - else \ - { \ - if (!argv[++i]) \ - { \ - fprintf (stderr, "%s: `%s' must be followed by an argument\n", \ - progname, desc); \ - exit (1); \ - } \ - (var) = argv[i]; \ - } \ - over = 1; \ -} while (0) - -/* A strdup immitation. */ -static char * -my_strdup (CONST char *s) -{ - char *new = malloc (strlen (s) + 1); - if (new) - strcpy (new, s); - return new; -} - -int -main (int argc, char *argv[]) -{ - int starting_line = 1; /* line to start editing at */ - char command[MAXPATHLEN+50]; /* emacs command buffer */ - char fullpath[MAXPATHLEN+1]; /* full pathname to file */ - char *eval_form = NULL; /* form to evaluate with `-eval' */ - char *eval_function = NULL; /* function to evaluate with `-f' */ - char *load_library = NULL; /* library to load */ - int quick = 0; /* quick edit, don't wait for user to - finish */ - int batch = 0; /* batch mode */ - int view = 0; /* view only. */ - int nofiles = 0; - int errflg = 0; /* option error */ - int s; /* socket / msqid to server */ - int connect_type; /* CONN_UNIX, CONN_INTERNET, or - * CONN_IPC */ - int suppress_windows_system = 0; - char *display = NULL; -#ifdef INTERNET_DOMAIN_SOCKETS - char *hostarg = NULL; /* remote hostname */ - char *remotearg; - char thishost[HOSTNAMSZ]; /* this hostname */ - char remotepath[MAXPATHLEN+1]; /* remote pathname */ - char *path; - int rflg = 0; /* pathname given on cmdline */ - char *portarg; - u_short port = 0; /* port to server */ -#endif /* INTERNET_DOMAIN_SOCKETS */ -#ifdef SYSV_IPC - struct msgbuf *msgp; /* message */ -#endif /* SYSV_IPC */ - char *tty = NULL; - char buffer[GSERV_BUFSZ + 1]; /* buffer to read pid */ - char result[GSERV_BUFSZ + 1]; - int i; - -#ifdef INTERNET_DOMAIN_SOCKETS - memset (remotepath, 0, sizeof (remotepath)); -#endif /* INTERNET_DOMAIN_SOCKETS */ - - progname = strrchr (argv[0], '/'); - if (progname) - ++progname; - else - progname = argv[0]; - -#ifdef USE_TMPDIR - tmpdir = getenv ("TMPDIR"); -#endif - if (!tmpdir) - tmpdir = "/tmp"; - - display = getenv ("DISPLAY"); - if (display) - display = my_strdup (display); -#ifndef HAVE_MS_WINDOWS - else - suppress_windows_system = 1; -#endif - - for (i = 1; argv[i] && !errflg; i++) - { - if (*argv[i] != '-') - break; - else if (*argv[i] == '-' - && (*(argv[i] + 1) == '\0' - || (*(argv[i] + 1) == '-' && *(argv[i] + 2) == '\0'))) - { - /* `-' or `--' */ - ++i; - break; - } - - if (!strcmp (argv[i], "-batch") || !strcmp (argv[i], "--batch")) - batch = 1; - else if (!strcmp (argv[i], "-eval") || !strcmp (argv[i], "--eval")) - { - if (!argv[++i]) - { - fprintf (stderr, "%s: `-eval' must be followed by an argument\n", - progname); - exit (1); - } - eval_form = argv[i]; - } - else if (!strcmp (argv[i], "-display") || !strcmp (argv[i], "--display")) - { - suppress_windows_system = 0; - if (!argv[++i]) - { - fprintf (stderr, - "%s: `-display' must be followed by an argument\n", - progname); - exit (1); - } - if (display) - free (display); - /* no need to strdup. */ - display = argv[i]; - } - else if (!strcmp (argv[i], "-nw")) - suppress_windows_system = 1; - else - { - /* Iterate over one-letter options. */ - char *p; - int over = 0; - for (p = argv[i] + 1; *p && !over; p++) - { - switch (*p) - { - case 'q': - quick = 1; - break; - case 'v': - view = 1; - break; - case 'f': - GET_ARGUMENT (eval_function, "-f"); - break; - case 'l': - GET_ARGUMENT (load_library, "-l"); - break; -#ifdef INTERNET_DOMAIN_SOCKETS - case 'h': - GET_ARGUMENT (hostarg, "-h"); - break; - case 'p': - GET_ARGUMENT (portarg, "-p"); - port = atoi (portarg); - break; - case 'r': - GET_ARGUMENT (remotearg, "-r"); - strcpy (remotepath, remotearg); - rflg = 1; - break; -#endif /* INTERNET_DOMAIN_SOCKETS */ - default: - errflg = 1; - } - } /* for */ - } /* else */ - } /* for */ - - if (errflg) - { - fprintf (stderr, -#ifdef INTERNET_DOMAIN_SOCKETS - "usage: %s [-nw] [-display display] [-q] [-v] [-l library]\n" - " [-batch] [-f function] [-eval form]\n" - " [-h host] [-p port] [-r remote-path] [[+line] file] ...\n", -#else /* !INTERNET_DOMAIN_SOCKETS */ - "usage: %s [-nw] [-q] [-v] [-l library] [-f function] [-eval form] " - "[[+line] path] ...\n", -#endif /* !INTERNET_DOMAIN_SOCKETS */ - progname); - exit (1); - } - if (batch && argv[i]) - { - fprintf (stderr, "%s: Cannot specify `-batch' with file names\n", - progname); - exit (1); - } - if (suppress_windows_system && hostarg) - { - fprintf (stderr, "%s: Remote editing is available only on X\n", - progname); - exit (1); - } - - *result = '\0'; - if (eval_function || eval_form || load_library) - { -#if defined(INTERNET_DOMAIN_SOCKETS) - connect_type = make_connection (hostarg, port, &s); -#else - connect_type = make_connection (NULL, (u_short) 0, &s); -#endif - sprintf (command, "(gnuserv-eval%s '(progn ", quick ? "-quickly" : ""); - send_string (s, command); - if (load_library) - { - send_string (s , "(load-library "); - send_string (s, clean_string(load_library)); - send_string (s, ") "); - } - if (eval_form) - { - send_string (s, eval_form); - } - if (eval_function) - { - send_string (s, "("); - send_string (s, eval_function); - send_string (s, ")"); - } - send_string (s, "))"); - /* disconnect already sends EOT_STR */ -#ifdef SYSV_IPC - if (connect_type == (int) CONN_IPC) - disconnect_from_ipc_server (s, msgp, batch && !quick); -#else /* !SYSV_IPC */ - if (connect_type != (int) CONN_IPC) - disconnect_from_server (s, batch && !quick); -#endif /* !SYSV_IPC */ - } /* eval_function || eval_form || load_library */ - else if (batch) - { - /* no sexp on the command line, so read it from stdin */ - int nb; - -#if defined(INTERNET_DOMAIN_SOCKETS) - connect_type = make_connection (hostarg, port, &s); -#else - connect_type = make_connection (NULL, (u_short) 0, &s); -#endif - sprintf (command, "(gnuserv-eval%s '(progn ", quick ? "-quickly" : ""); - send_string (s, command); - - while ((nb = read(fileno(stdin), buffer, GSERV_BUFSZ-1)) > 0) - { - buffer[nb] = '\0'; - send_string(s, buffer); - } - send_string(s,"))"); - /* disconnect already sends EOT_STR */ -#ifdef SYSV_IPC - if (connect_type == (int) CONN_IPC) - disconnect_from_ipc_server (s, msgp, batch && !quick); -#else /* !SYSV_IPC */ - if (connect_type != (int) CONN_IPC) - disconnect_from_server (s, batch && !quick); -#endif /* !SYSV_IPC */ - } - - if (!batch) - { - if (suppress_windows_system) - { - tty = ttyname (0); - if (!tty) - { - fprintf (stderr, "%s: Not connected to a tty", progname); - exit (1); - } -#if defined(INTERNET_DOMAIN_SOCKETS) - connect_type = make_connection (hostarg, port, &s); -#else - connect_type = make_connection (NULL, (u_short) 0, &s); -#endif - send_string (s, "(gnuserv-eval '(emacs-pid))"); - send_string (s, EOT_STR); - - if (read_line (s, buffer) == 0) - { - fprintf (stderr, "%s: Could not establish Emacs process id\n", - progname); - exit (1); - } - /* Don't do disconnect_from_server becasue we have already read - data, and disconnect doesn't do anything else. */ -#ifndef INTERNET_DOMAIN_SOCKETS - if (connect_type == (int) CONN_IPC) - disconnect_from_ipc_server (s, msgp, FALSE); -#endif /* !SYSV_IPC */ - - emacs_pid = (pid_t)atol(buffer); - initialize_signals(); - } /* suppress_windows_system */ - -#if defined(INTERNET_DOMAIN_SOCKETS) - connect_type = make_connection (hostarg, port, &s); -#else - connect_type = make_connection (NULL, (u_short) 0, &s); -#endif - -#ifdef INTERNET_DOMAIN_SOCKETS - if (connect_type == (int) CONN_INTERNET) - { - char *ptr; - gethostname (thishost, HOSTNAMSZ); - if (!rflg) - { /* attempt to generate a path - * to this machine */ - if ((ptr = getenv ("GNU_NODE")) != NULL) - /* user specified a path */ - strcpy (remotepath, ptr); - } -#if 0 /* This is really bogus... re-enable it if you must have it! */ -#if defined (hp9000s300) || defined (hp9000s800) - else if (strcmp (thishost,hostarg)) - { /* try /net/thishost */ - strcpy (remotepath, "/net/"); /* (this fails using internet - addresses) */ - strcat (remotepath, thishost); - } -#endif -#endif - } - else - { /* same machines, no need for path */ - remotepath[0] = '\0'; /* default is the empty path */ - } -#endif /* INTERNET_DOMAIN_SOCKETS */ - -#ifdef SYSV_IPC - if ((msgp = (struct msgbuf *) - malloc (sizeof *msgp + GSERV_BUFSZ)) == NULL) - { - fprintf (stderr, "%s: not enough memory for message buffer\n", progname); - exit (1); - } /* if */ - - msgp->mtext[0] = '\0'; /* ready for later strcats */ -#endif /* SYSV_IPC */ - - if (suppress_windows_system) - { - char *term = getenv ("TERM"); - if (!term) - { - fprintf (stderr, "%s: unknown terminal type\n", progname); - exit (1); - } - sprintf (command, "(gnuserv-edit-files '(tty %s %s %d) '(", - clean_string (tty), clean_string (term), (int)getpid ()); - } - else /* !suppress_windows_system */ - { - if (display) - sprintf (command, "(gnuserv-edit-files '(x %s) '(", - clean_string (display)); -#ifdef HAVE_MS_WINDOWS - else - sprintf (command, "(gnuserv-edit-files '(mswindows nil) '("); -#endif - } /* !suppress_windows_system */ - send_string (s, command); - - if (!argv[i]) - nofiles = 1; - - for (; argv[i]; i++) - { - if (i < argc - 1 && *argv[i] == '+') - starting_line = atoi (argv[i++]); - else - starting_line = 1; - /* If the last argument is +something, treat it as a file. */ - if (i == argc) - { - starting_line = 1; - --i; - } - filename_expand (fullpath, argv[i]); -#ifdef INTERNET_DOMAIN_SOCKETS - path = malloc (strlen (remotepath) + strlen (fullpath) + 1); - sprintf (path, "%s%s", remotepath, fullpath); -#else - path = my_strdup (fullpath); -#endif - sprintf (command, "(%d . %s)", starting_line, clean_string (path)); - send_string (s, command); - free (path); - } /* for */ - - sprintf (command, ")%s%s", - (quick || (nofiles && !suppress_windows_system)) ? " 'quick" : "", - view ? " 'view" : ""); - send_string (s, command); - send_string (s, ")"); - -#ifdef SYSV_IPC - if (connect_type == (int) CONN_IPC) - disconnect_from_ipc_server (s, msgp, FALSE); -#else /* !SYSV_IPC */ - if (connect_type != (int) CONN_IPC) - disconnect_from_server (s, FALSE); -#endif /* !SYSV_IPC */ - } /* not batch */ - - - return 0; - -} /* main */ - -#endif /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */ diff --git a/lib-src/gnuserv.c b/lib-src/gnuserv.c deleted file mode 100644 index ddce69c..0000000 --- a/lib-src/gnuserv.c +++ /dev/null @@ -1,913 +0,0 @@ -/* -*-C-*- - Server code for handling requests from clients and forwarding them - on to the GNU Emacs process. - - This file is part of GNU Emacs. - - Copying is permitted under those conditions described by the GNU - General Public License. - - Copyright (C) 1989 Free Software Foundation, Inc. - - Author: Andy Norman (ange@hplb.hpl.hp.com), based on 'etc/server.c' - from the 18.52 GNU Emacs distribution. - - Please mail bugs and suggestions to the author at the above address. -*/ - -/* HISTORY - * 11-Nov-1990 bristor@simba - * Added EOT stuff. - */ - -/* - * This file incorporates new features added by Bob Weiner , - * Darrell Kindred and Arup Mukherjee . - * Please see the note at the end of the README file for details. - * - * (If gnuserv came bundled with your emacs, the README file is probably - * ../etc/gnuserv.README relative to the directory containing this file) - */ - -#if 0 -static char rcsid [] = "!Header: gnuserv.c,v 2.1 95/02/16 11:58:27 arup alpha !"; -#endif - -#include "gnuserv.h" - -#ifdef USE_LITOUT -#ifdef linux -#include -#else -#include -#endif -#endif - -#ifdef AIX -#include -#endif - -#include -#include -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#endif /* HAVE_UNISTD_H */ - -#ifdef HAVE_STRING_H -#include -#endif /* HAVE_STRING_H */ - -#if !defined(SYSV_IPC) && !defined(UNIX_DOMAIN_SOCKETS) && \ - !defined(INTERNET_DOMAIN_SOCKETS) -main () -{ - fprintf (stderr,"Sorry, the Emacs server is only supported on systems that have\n"); - fprintf (stderr,"Unix Domain sockets, Internet Domain sockets or System V IPC\n"); - exit (1); -} /* main */ -#else /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */ - -#ifdef SYSV_IPC - -int ipc_qid = 0; /* ipc message queue id */ -int ipc_wpid = 0; /* watchdog task pid */ - - -/* - ipc_exit -- clean up the queue id and queue, then kill the watchdog task - if it exists. exit with the given status. -*/ -void -ipc_exit (int stat) -{ - msgctl (ipc_qid,IPC_RMID,0); - - if (ipc_wpid != 0) - kill (ipc_wpid, SIGKILL); - - exit (stat); -} /* ipc_exit */ - - -/* - ipc_handle_signal -- catch the signal given and clean up. -*/ -void -ipc_handle_signal(int sig) -{ - ipc_exit (0); -} /* ipc_handle_signal */ - - -/* - ipc_spawn_watchdog -- spawn a watchdog task to clean up the message queue should the - server process die. -*/ -void -ipc_spawn_watchdog (void) -{ - if ((ipc_wpid = fork ()) == 0) - { /* child process */ - int ppid = getppid (); /* parent's process id */ - - setpgrp(); /* gnu kills process group on exit */ - - while (1) - { - if (kill (ppid, 0) < 0) /* ppid is no longer valid, parent - may have died */ - { - ipc_exit (0); - } /* if */ - - sleep(10); /* have another go later */ - } /* while */ - } /* if */ - -} /* ipc_spawn_watchdog */ - - -/* - ipc_init -- initialize server, setting the global msqid that can be listened on. -*/ -void -ipc_init (struct msgbuf **msgpp) -{ - key_t key; /* messge key */ - char buf[GSERV_BUFSZ]; /* pathname for key */ - - sprintf (buf,"%s/gsrv%d",tmpdir,(int)geteuid ()); - creat (buf,0600); - key = ftok (buf,1); - - if ((ipc_qid = msgget (key,0600|IPC_CREAT)) == -1) - { - perror (progname); - fprintf (stderr, "%s: unable to create msg queue\n", progname); - ipc_exit (1); - } /* if */ - - ipc_spawn_watchdog (); - - signal (SIGTERM,ipc_handle_signal); - signal (SIGINT,ipc_handle_signal); - - if ((*msgpp = (struct msgbuf *) - malloc (sizeof **msgpp + GSERV_BUFSZ)) == NULL) - { - fprintf (stderr, - "%s: unable to allocate space for message buffer\n", progname); - ipc_exit(1); - } /* if */ -} /* ipc_init */ - - -/* - handle_ipc_request -- accept a request from a client, pass the request on - to the GNU Emacs process, then wait for its reply and - pass that on to the client. -*/ -void -handle_ipc_request (struct msgbuf *msgp) -{ - struct msqid_ds msg_st; /* message status */ - char buf[GSERV_BUFSZ]; - int len; /* length of message / read */ - int s, result_len; /* tag fields on the response from emacs */ - int offset = 0; - int total = 1; /* # bytes that will actually be sent off */ - - if ((len = msgrcv (ipc_qid, msgp, GSERV_BUFSZ - 1, 1, 0)) < 0) - { - perror (progname); - fprintf (stderr, "%s: unable to receive\n", progname); - ipc_exit (1); - } /* if */ - - msgctl (ipc_qid, IPC_STAT, &msg_st); - strncpy (buf, msgp->mtext, len); - buf[len] = '\0'; /* terminate */ - - printf ("%d %s", ipc_qid, buf); - fflush (stdout); - - /* now for the response from gnu */ - msgp->mtext[0] = '\0'; - -#if 0 - if ((len = read(0,buf,GSERV_BUFSZ-1)) < 0) - { - perror (progname); - fprintf (stderr, "%s: unable to read\n", progname); - ipc_exit (1); - } /* if */ - - sscanf (buf, "%d:%[^\n]\n", &junk, msgp->mtext); -#else - - /* read in "n/m:" (n=client fd, m=message length) */ - - while (offset < (GSERV_BUFSZ-1) && - ((len = read (0, buf + offset, 1)) > 0) && - buf[offset] != ':') - { - offset += len; - } - - if (len < 0) - { - perror (progname); - fprintf (stderr, "%s: unable to read\n", progname); - exit(1); - } - - /* parse the response from emacs, getting client fd & result length */ - buf[offset] = '\0'; - sscanf (buf, "%d/%d", &s, &result_len); - - while (result_len > 0) - { - if ((len = read(0, buf, min2 (result_len, GSERV_BUFSZ - 1))) < 0) - { - perror (progname); - fprintf (stderr, "%s: unable to read\n", progname); - exit (1); - } - - /* Send this string off, but only if we have enough space */ - - if (GSERV_BUFSZ > total) - { - if (total + len <= GSERV_BUFSZ) - buf[len] = 0; - else - buf[GSERV_BUFSZ - total] = 0; - - send_string(s,buf); - total += strlen(buf); - } - - result_len -= len; - } - - /* eat the newline */ - while ((len = read (0,buf,1)) == 0) - ; - if (len < 0) - { - perror(progname); - fprintf (stderr,"%s: unable to read\n", progname); - exit (1); - } - if (buf[0] != '\n') - { - fprintf (stderr,"%s: garbage after result [%c]\n", progname, buf[0]); - exit (1); - } -#endif - - /* Send a response back to the client. */ - - msgp->mtype = msg_st.msg_lspid; - if (msgsnd (ipc_qid,msgp,strlen(msgp->mtext)+1,0) < 0) - perror ("msgsend(gnuserv)"); - -} /* handle_ipc_request */ -#endif /* SYSV_IPC */ - - -#if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -/* - echo_request -- read request from a given socket descriptor, and send the information - to stdout (the gnu process). -*/ -static void -echo_request (int s) -{ - char buf[GSERV_BUFSZ]; - int len; - - printf("%d ",s); - - /* read until we get a newline or no characters */ - while ((len = recv(s,buf,GSERV_BUFSZ-1,0)) > 0) { - buf[len] = '\0'; - printf("%s",buf); - - if (buf[len-1] == EOT_CHR) { - fflush(stdout); - break; /* end of message */ - } - - } /* while */ - - if (len < 0) { - perror(progname); - fprintf(stderr,"%s: unable to recv\n",progname); - exit(1); - } /* if */ - -} /* echo_request */ - - -/* - handle_response -- accept a response from stdin (the gnu process) and pass the - information on to the relevant client. -*/ -static void -handle_response (void) -{ - char buf[GSERV_BUFSZ+1]; - int offset=0; - int s; - int len; - int result_len; - - /* read in "n/m:" (n=client fd, m=message length) */ - while (offset < GSERV_BUFSZ && - ((len = read(0,buf+offset,1)) > 0) && - buf[offset] != ':') { - offset += len; - } - - if (len < 0) { - perror(progname); - fprintf(stderr,"%s: unable to read\n",progname); - exit(1); - } - - /* parse the response from emacs, getting client fd & result length */ - buf[offset] = '\0'; - sscanf(buf,"%d/%d", &s, &result_len); - - while (result_len > 0) { - if ((len = read(0,buf,min2(result_len,GSERV_BUFSZ))) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to read\n",progname); - exit(1); - } - buf[len] = '\0'; - send_string(s,buf); - result_len -= len; - } - - /* eat the newline */ - while ((len = read(0,buf,1)) == 0) - ; - if (len < 0) - { - perror(progname); - fprintf(stderr,"%s: unable to read\n",progname); - exit(1); - } - if (buf[0] != '\n') - { - fprintf(stderr,"%s: garbage after result\n",progname); - exit(1); - } - /* send the newline */ - buf[1] = '\0'; - send_string(s,buf); - close(s); - -} /* handle_response */ -#endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */ - - -#ifdef INTERNET_DOMAIN_SOCKETS -struct entry { - u_long host_addr; - struct entry *next; -}; - -struct entry *permitted_hosts[TABLE_SIZE]; - -#ifdef AUTH_MAGIC_COOKIE -# include -# include - -static Xauth *server_xauth = NULL; -#endif - -static int -timed_read (int fd, char *buf, int max, int timeout, int one_line) -{ - fd_set rmask; - struct timeval tv; /* = {timeout, 0}; */ - char c = 0; - int nbytes = 0; - int r; - - tv.tv_sec = timeout; - tv.tv_usec = 0; - - FD_ZERO(&rmask); - FD_SET(fd, &rmask); - - do - { - r = select(fd + 1, &rmask, NULL, NULL, &tv); - - if (r > 0) - { - if (read (fd, &c, 1) == 1 ) - { - *buf++ = c; - ++nbytes; - } - else - { - printf ("read error on socket\004\n"); - return -1; - } - } - else if (r == 0) - { - printf ("read timed out\004\n"); - return -1; - } - else - { - printf ("error in select\004\n"); - return -1; - } - } while ((nbytes < max) && !(one_line && (c == '\n'))); - - --buf; - if (one_line && *buf == '\n') - { - *buf = 0; - } - - return nbytes; -} - - - -/* - permitted -- return whether a given host is allowed to connect to the server. -*/ -static int -permitted (u_long host_addr, int fd) -{ - int key; - struct entry *entry; - - char auth_protocol[128]; - char buf[1024]; - int auth_data_len; - - if (fd > 0) - { - /* we are checking permission on a real connection */ - - /* Read auth protocol name */ - - if (timed_read(fd, auth_protocol, AUTH_NAMESZ, AUTH_TIMEOUT, 1) <= 0) - return FALSE; - - if (strcmp (auth_protocol, DEFAUTH_NAME) && - strcmp (auth_protocol, MCOOKIE_NAME)) - { - printf ("authentication protocol (%s) from client is invalid...\n", - auth_protocol); - printf ("... Was the client an old version of gnuclient/gnudoit?\004\n"); - - return FALSE; - } - - if (!strcmp(auth_protocol, MCOOKIE_NAME)) - { - - /* - * doing magic cookie auth - */ - - if (timed_read(fd, buf, 10, AUTH_TIMEOUT, 1) <= 0) - return FALSE; - - auth_data_len = atoi(buf); - - if (timed_read(fd, buf, auth_data_len, AUTH_TIMEOUT, 0) != auth_data_len) - return FALSE; - -#ifdef AUTH_MAGIC_COOKIE - if (server_xauth && server_xauth->data && - !memcmp(buf, server_xauth->data, auth_data_len)) - { - return TRUE; - } -#else - printf ("client tried Xauth, but server is not compiled with Xauth\n"); -#endif - - /* - * auth failed, but allow this to fall through to the GNU_SECURE - * protocol.... - */ - - printf ("Xauth authentication failed, trying GNU_SECURE auth...\004\n"); - - } - - /* Other auth protocols go here, and should execute only if the - * auth_protocol name matches. - */ - - } - - - /* Now, try the old GNU_SECURE stuff... */ - - /* First find the hash key */ - key = HASH(host_addr) % TABLE_SIZE; - - /* Now check the chain for that hash key */ - for(entry=permitted_hosts[key]; entry != NULL; entry=entry->next) - if (host_addr == entry->host_addr) - return(TRUE); - - return(FALSE); - -} /* permitted */ - - -/* - add_host -- add the given host to the list of permitted hosts, provided it isn't - already there. -*/ -static void -add_host (u_long host_addr) -{ - int key; - struct entry *new_entry; - - if (!permitted(host_addr, -1)) - { - if ((new_entry = (struct entry *) malloc(sizeof(struct entry))) == NULL) { - fprintf(stderr,"%s: unable to malloc space for permitted host entry\n", - progname); - exit(1); - } /* if */ - - new_entry->host_addr = host_addr; - key = HASH(host_addr) % TABLE_SIZE; - new_entry->next = permitted_hosts[key]; - permitted_hosts[key] = new_entry; - } /* if */ - -} /* add_host */ - - -/* - setup_table -- initialize the table of hosts allowed to contact the server, - by reading from the file specified by the GNU_SECURE - environment variable - Put in the local machine, and, if a security file is specifed, - add each host that is named in the file. - Return the number of hosts added. -*/ -static int -setup_table (void) -{ - FILE *host_file; - char *file_name; - char hostname[HOSTNAMSZ]; - u_int host_addr; - int i, hosts=0; - - /* Make sure every entry is null */ - for (i=0; is_port; - - /* Create the listen socket. */ - if ((ls = socket (AF_INET,SOCK_STREAM, 0)) == -1) - { - perror(progname); - fprintf(stderr,"%s: unable to create socket\n",progname); - exit(1); - } /* if */ - - /* Bind the listen address to the socket. */ - if (bind(ls,(struct sockaddr *) &server,sizeof(struct sockaddr_in)) == -1) - { - perror(progname); - fprintf(stderr,"%s: unable to bind socket\n",progname); - exit(1); - } /* if */ - - /* Initiate the listen on the socket so remote users - * can connect. - */ - if (listen(ls,20) == -1) - { - perror(progname); - fprintf(stderr,"%s: unable to listen\n",progname); - exit(1); - } /* if */ - - return(ls); - -} /* internet_init */ - - -/* - handle_internet_request -- accept a request from a client and send the information - to stdout (the gnu process). -*/ -static void -handle_internet_request (int ls) -{ - int s; - size_t addrlen = sizeof(struct sockaddr_in); - struct sockaddr_in peer; /* for peer socket address */ - - memset((char *)&peer,0,sizeof(struct sockaddr_in)); - - if ((s = accept(ls,(struct sockaddr *)&peer, (void *) &addrlen)) == -1) - { - perror(progname); - fprintf(stderr,"%s: unable to accept\n",progname); - exit(1); - } /* if */ - - /* Check that access is allowed - if not return crud to the client */ - if (!permitted(peer.sin_addr.s_addr, s)) - { - send_string(s,"gnudoit: Connection refused\ngnudoit: unable to connect to remote"); - close(s); - - printf("Refused connection from %s\004\n", inet_ntoa(peer.sin_addr)); - return; - } /* if */ - - echo_request(s); - -} /* handle_internet_request */ -#endif /* INTERNET_DOMAIN_SOCKETS */ - - -#ifdef UNIX_DOMAIN_SOCKETS -/* - unix_init -- initialize server, returning an unix-domain socket that can - be listened on. -*/ -static int -unix_init (void) -{ - int ls; /* socket descriptor */ - struct sockaddr_un server; /* unix socket address */ - int bindlen; - - if ((ls = socket(AF_UNIX,SOCK_STREAM, 0)) < 0) - { - perror(progname); - fprintf(stderr,"%s: unable to create socket\n",progname); - exit(1); - } /* if */ - - /* Set up address structure for the listen socket. */ -#ifdef HIDE_UNIX_SOCKET - sprintf(server.sun_path,"%s/gsrvdir%d",tmpdir,(int)geteuid()); - if (mkdir(server.sun_path, 0700) < 0) - { - /* assume it already exists, and try to set perms */ - if (chmod(server.sun_path, 0700) < 0) - { - perror(progname); - fprintf(stderr,"%s: can't set permissions on %s\n", - progname, server.sun_path); - exit(1); - } - } - strcat(server.sun_path,"/gsrv"); - unlink(server.sun_path); /* remove old file if it exists */ -#else /* HIDE_UNIX_SOCKET */ - sprintf(server.sun_path,"%s/gsrv%d",tmpdir,(int)geteuid()); - unlink(server.sun_path); /* remove old file if it exists */ -#endif /* HIDE_UNIX_SOCKET */ - - server.sun_family = AF_UNIX; -#ifdef HAVE_SOCKADDR_SUN_LEN - /* See W. R. Stevens "Advanced Programming in the Unix Environment" - p. 502 */ - bindlen = (sizeof (server.sun_len) + sizeof (server.sun_family) - + strlen (server.sun_path) + 1); - server.sun_len = bindlen; -#else - bindlen = strlen (server.sun_path) + sizeof (server.sun_family); -#endif - - if (bind(ls,(struct sockaddr *)&server,bindlen) < 0) - { - perror(progname); - fprintf(stderr,"%s: unable to bind socket\n",progname); - exit(1); - } /* if */ - - chmod(server.sun_path,0700); /* only this user can send commands */ - - if (listen(ls,20) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to listen\n",progname); - exit(1); - } /* if */ - - /* #### there are also better ways of dealing with this when - sigvec() is present. */ -#if defined (HAVE_SIGPROCMASK) - { - sigset_t _mask; - sigemptyset (&_mask); - sigaddset (&_mask, SIGPIPE); - sigprocmask (SIG_BLOCK, &_mask, NULL); - } -#else - signal(SIGPIPE,SIG_IGN); /* in case user kills client */ -#endif - - return(ls); - -} /* unix_init */ - - -/* - handle_unix_request -- accept a request from a client and send the information - to stdout (the gnu process). -*/ -static void -handle_unix_request (int ls) -{ - int s; - size_t len = sizeof(struct sockaddr_un); - struct sockaddr_un server; /* for unix socket address */ - - server.sun_family = AF_UNIX; - - if ((s = accept(ls,(struct sockaddr *)&server, (void *)&len)) < 0) - { - perror(progname); - fprintf(stderr,"%s: unable to accept\n",progname); - } /* if */ - - echo_request(s); - -} /* handle_unix_request */ -#endif /* UNIX_DOMAIN_SOCKETS */ - - -int -main (int argc, char *argv[]) -{ - int chan; /* temporary channel number */ -#ifdef SYSV_IPC - struct msgbuf *msgp; /* message buffer */ -#else - int ils = -1; /* internet domain listen socket */ - int uls = -1; /* unix domain listen socket */ -#endif /* SYSV_IPC */ - - progname = argv[0]; - - for(chan=3; chan < _NFILE; close(chan++)) /* close unwanted channels */ - ; - -#ifdef USE_TMPDIR - tmpdir = getenv("TMPDIR"); -#endif - if (!tmpdir) - tmpdir = "/tmp"; -#ifdef USE_LITOUT - { - /* this is to allow ^D to pass to emacs */ - int d = LLITOUT; - (void) ioctl(fileno(stdout), TIOCLBIS, &d); - } -#endif - -#ifdef SYSV_IPC - ipc_init(&msgp); /* get a msqid to listen on, and a message buffer */ -#endif /* SYSV_IPC */ - -#ifdef INTERNET_DOMAIN_SOCKETS - ils = internet_init(); /* get an internet domain socket to listen on */ -#endif /* INTERNET_DOMAIN_SOCKETS */ - -#ifdef UNIX_DOMAIN_SOCKETS - uls = unix_init(); /* get a unix domain socket to listen on */ -#endif /* UNIX_DOMAIN_SOCKETS */ - - while (1) { -#ifdef SYSV_IPC - handle_ipc_request(msgp); -#else /* NOT SYSV_IPC */ - fd_set rmask; - FD_ZERO(&rmask); - FD_SET(fileno(stdin), &rmask); - if (uls >= 0) - FD_SET(uls, &rmask); - if (ils >= 0) - FD_SET(ils, &rmask); - - if (select(max2(fileno(stdin),max2(uls,ils)) + 1, &rmask, - (fd_set *)NULL, (fd_set *)NULL, (struct timeval *)NULL) < 0) - { - perror(progname); - fprintf(stderr,"%s: unable to select\n",progname); - exit(1); - } /* if */ - -#ifdef UNIX_DOMAIN_SOCKETS - if (uls > 0 && FD_ISSET(uls, &rmask)) - handle_unix_request(uls); -#endif - -#ifdef INTERNET_DOMAIN_SOCKETS - if (ils > 0 && FD_ISSET(ils, &rmask)) - handle_internet_request(ils); -#endif /* INTERNET_DOMAIN_SOCKETS */ - - if (FD_ISSET(fileno(stdin), &rmask)) /* from stdin (gnu process) */ - handle_response(); -#endif /* NOT SYSV_IPC */ - } /* while */ - - return 0; -} /* main */ - -#endif /* SYSV_IPC || UNIX_DOMAIN_SOCKETS || INTERNET_DOMAIN_SOCKETS */ diff --git a/lib-src/gnuserv.h b/lib-src/gnuserv.h deleted file mode 100644 index 9fb3edd..0000000 --- a/lib-src/gnuserv.h +++ /dev/null @@ -1,225 +0,0 @@ -/* -*-C-*- - - Header file for the GNU Emacs server and client C code. - - This file is part of GNU Emacs. - - Copying is permitted under those conditions described by the GNU - General Public License. - - Copyright (C) 1989 Free Software Foundation, Inc. - - Author: Andy Norman (ange@hplb.hpl.hp.com), based on - 'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU - Emacs distribution. - - Please mail bugs and suggestions to the author at the above address. -*/ - -/* HISTORY - * 11-Nov-1990 bristor@simba - * Added EOT stuff. - */ - -/* - * This file incorporates new features added by Bob Weiner , - * Darrell Kindred and Arup Mukherjee . - * Please see the note at the end of the README file for details. - * - * (If gnuserv came bundled with your emacs, the README file is probably - * ../etc/gnuserv.README relative to the directory containing this file) - */ - -#if 0 -static char header_rcsid [] = "!Header: gnuserv.h,v 2.4 95/02/16 11:58:11 arup alpha !"; -#endif - -#define USE_TMPDIR - -#define NO_SHORTNAMES - -#define PATCHLEVEL 2 - -#define NO_SHORTNAMES -/* gnuserv should not be compiled using SOCKS */ -#define DO_NOT_SOCKSIFY -#include <../src/config.h> -#undef read -#undef write -#undef open -#undef close -#undef signal - -/* Define the communication method between server and clients: - * You can have either or both kinds of sockets, but you can't mix - * sockets with sysv ipc - */ - - -#define INTERNET_DOMAIN_SOCKETS -#ifdef HAVE_SYS_UN_H -#define UNIX_DOMAIN_SOCKETS -/* #define SYSV_IPC */ -#endif - -/* - * Define additional authentication protocols to be used. These methods will - * be tried before falling back to the default gnuserv protocol (based on - * the GNU_SECURE environment variable). Currently, only MIT-MAGIC-COOKIE-1 - * is also supported. - * - * Comment out the next line(s) if you don't want to enable the - * appropriate authentication protocol. - */ - -#if defined (HAVE_XAUTH) -#define AUTH_MAGIC_COOKIE -#endif /* HAVE_XAUTH */ - -/* - * stuff related to supporting MIT-MAGIC-COOKIE-1 - */ - -#define MCOOKIE_SCREEN "999" /* screen # to use as the gnuserv cookie */ -#define MCOOKIE_NAME "MAGIC-1" /* authentication protocol name */ -#define MCOOKIE_X_NAME "MIT-MAGIC-COOKIE-1" /* as needed by X */ - - -#define DEFAUTH_NAME "GNU-SECURE" /* name of default auth protocol */ -#define AUTH_TIMEOUT 15 /* # seconds to wait for auth data */ -#define AUTH_NAMESZ 15 /* max allows auth protocol name size */ - - -/* - * Pick a default communication scheme, if none was specified. - */ - -#if !defined(SYSV_IPC) && !defined(UNIX_DOMAIN_SOCKETS) && !defined(INTERNET_DOMAIN_SOCKETS) - -#ifdef HAVE_SYSVIPC -#define SYSV_IPC /* SYSV systems use SYSV IPC by default */ -#endif /* HAVE_SYSVIPC */ - -#ifdef BSD -#define UNIX_DOMAIN_SOCKETS /* BSD systems use Unix Domain sockets by default */ -#endif /* BSD */ - -#endif /* No communication method pre-defined */ - -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef HAVE_SYS_TIME_H -#include -#endif - -/* - * If you are using SYSV_IPC, you might want to make the buffer size bigger - * since it limits the size of requests and responses. Don't make it bigger - * than your system's max message size though (usually a couple of k) or else - * msgsend will start failing. For sockets, using the system BUFSIZ is usually - * what you want. - */ - -# define GSERV_BUFSZ BUFSIZ - - -#ifdef SYSV_IPC -#include -#include - -#define send_string(s,str) \ - if (strlen(msgp->mtext) + strlen(str) < GSERV_BUFSZ) \ - strcat(msgp->mtext,str); \ - else \ - { \ - fprintf(stderr,"%s: not enough message buffer space\n",progname); \ - exit(1); \ - } \ - -#endif /* SYSV_IPC */ - -#if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -#include -#endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */ - -#ifdef INTERNET_DOMAIN_SOCKETS -#include -#include -#include -#define TABLE_SIZE 101 /* The number of entries in the hash table */ -#define HASH(host) host /* Rather simplistic hash function */ -#define DEFAULT_PORT 21490 /* default port number to use is - * DEFAULT_PORT + uid */ -#endif /* INTERNET_DOMAIN_SOCKETS */ - -#ifdef UNIX_DOMAIN_SOCKETS -#include -#define HIDE_UNIX_SOCKET /* put the unix socket in a protected dir */ -#endif /* UNIX_DOMAIN_SOCKETS */ - -/* On some platforms, we need to do the equivalent of "stty litout" to get - * characters like ^D to pass through to emacs. This problem has only - * been observed under emacs18; fsf19 and lemacs are probably okay without it. - */ -#ifndef DONT_USE_LITOUT -#if !defined(HAVE_TERMIO) && !defined(HAVE_TERMIOS) && !defined(VMS) -#if !defined(MSDOS) && !defined(BSD4_1) -#define USE_LITOUT -#endif -#endif -#endif - - -#define HOSTNAMSZ 255 /* max size of a hostname */ -#define REPLYSIZ 300 /* max size of reply from server to client */ -#undef FALSE -#define FALSE 0 -#undef TRUE -#define TRUE 1 - -extern char *optarg; -extern int optind; -extern char *progname; -extern char *tmpdir; - -/* The casts shut Sun's compiler up and are safe in the context these - are actually used. */ -#define max2(x,y) (((int) (x) > (int) (y)) ? (x) : (y)) -#define min2(x,y) (((int) (x) < (int) (y)) ? (x) : (y)) - -#ifndef _NFILE /* rough guess at maximum number of open files */ -#define _NFILE 20 -#endif - -#define EOT_STR "\004" -#define EOT_CHR '\004' - -/* connection types */ -#define CONN_UNIX 0 -#define CONN_INTERNET 1 -#define CONN_IPC 2 - -/* function declarations */ -int make_connection (char *hostarg, int portarg, int *s); -#ifdef SYSV_IPC -void disconnect_from_ipc_server(); -#endif -#if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -void send_string (int s, CONST char *msg); -void disconnect_from_server (int s, int echo); -int read_line (int s, char *dest); -#endif -#ifdef INTERNET_DOMAIN_SOCKETS -int internet_addr (char *host); -#endif diff --git a/lib-src/gnuslib.c b/lib-src/gnuslib.c deleted file mode 100644 index a30f9f9..0000000 --- a/lib-src/gnuslib.c +++ /dev/null @@ -1,456 +0,0 @@ -/* -*-C-*- - Common library code for the GNU Emacs server and client. - - This file is part of GNU Emacs. - - Copying is permitted under those conditions described by the GNU - General Public License. - - Copyright (C) 1989 Free Software Foundation, Inc. - - Author: Andy Norman (ange@hplb.hpl.hp.com), based on - 'etc/server.c' and 'etc/emacsclient.c' from the 18.52 GNU - Emacs distribution. - - Please mail bugs and suggestions to the author at the above address. -*/ - -/* HISTORY - * 11-Nov-1990 bristor@simba - * Added EOT stuff. - */ - -/* - * This file incorporates new features added by Bob Weiner , - * Darrell Kindred and Arup Mukherjee . - * Please see the note at the end of the README file for details. - * - * (If gnuserv came bundled with your emacs, the README file is probably - * ../etc/gnuserv.README relative to the directory containing this file) - */ - -#if 0 -static char rcsid [] = "!Header: gnuslib.c,v 2.4 95/02/16 11:57:37 arup alpha !"; -#endif - -#include "gnuserv.h" -#include - -#ifdef SYSV_IPC -static int connect_to_ipc_server (void); -#endif -#ifdef UNIX_DOMAIN_SOCKETS -static int connect_to_unix_server (void); -#endif -#ifdef INTERNET_DOMAIN_SOCKETS -static int connect_to_internet_server (char *serverhost, u_short port); -#endif - -/* On some systems, e.g. DGUX, inet_addr returns a 'struct in_addr'. */ -#ifdef HAVE_BROKEN_INET_ADDR -# define IN_ADDR struct in_addr -# define NUMERIC_ADDR_ERROR (numeric_addr.s_addr == -1) -#else -# if (LONGBITS > 32) -# define IN_ADDR unsigned int -# else -# define IN_ADDR unsigned long -# endif -# define NUMERIC_ADDR_ERROR (numeric_addr == (IN_ADDR) -1) -#endif - -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif /* HAVE_UNISTD_H */ -#ifdef HAVE_STRING_H -#include -#endif /* HAVE_STRING_H */ - -#include - -char *tmpdir = NULL; - -char *progname = NULL; - -int make_connection(hostarg, portarg, s) - char *hostarg; - int portarg; - int *s; -{ -#ifdef INTERNET_DOMAIN_SOCKETS - char *ptr; - if (hostarg == NULL) - hostarg = getenv("GNU_HOST"); - if (portarg == 0 && (ptr=getenv("GNU_PORT")) != NULL) - portarg = atoi(ptr); -#endif - - if (hostarg != NULL) { - /* hostname was given explicitly, via cmd line arg or GNU_HOST, - * so obey it. */ -#ifdef UNIX_DOMAIN_SOCKETS - if (!strcmp(hostarg, "unix")) { - *s = connect_to_unix_server(); - return (int) CONN_UNIX; - } -#endif /* UNIX_DOMAIN_SOCKETS */ -#ifdef INTERNET_DOMAIN_SOCKETS - *s = connect_to_internet_server(hostarg, portarg); - return (int) CONN_INTERNET; -#endif -#ifdef SYSV_IPC - return -1; /* hostarg should always be NULL for SYSV_IPC */ -#endif - } else { - /* no hostname given. Use unix-domain/sysv-ipc, or - * internet-domain connection to local host if they're not available. */ -#if defined(UNIX_DOMAIN_SOCKETS) - *s = connect_to_unix_server(); - return (int) CONN_UNIX; -#elif defined(SYSV_IPC) - *s = connect_to_ipc_server(); - return (int) CONN_IPC; -#elif defined(INTERNET_DOMAIN_SOCKETS) - { - char localhost[HOSTNAMSZ]; - gethostname(localhost,HOSTNAMSZ); /* use this host by default */ - *s = connect_to_internet_server(localhost, portarg); - return (int) CONN_INTERNET; - } -#endif /* IPC type */ - } -} - -#ifdef SYSV_IPC -/* - connect_to_ipc_server -- establish connection with server process via SYSV IPC - Returns msqid for server if successful. -*/ -static int connect_to_ipc_server (void) -{ - int s; /* connected msqid */ - key_t key; /* message key */ - char buf[GSERV_BUFSZ+1]; /* buffer for filename */ - - sprintf(buf,"%s/gsrv%d",tmpdir,(int)geteuid()); - creat(buf,0600); - if ((key = ftok(buf,1)) == -1) { - perror(progname); - fprintf(stderr, "%s: unable to get ipc key from %s\n", - progname, buf); - exit(1); - } - - if ((s = msgget(key,0600)) == -1) { - perror(progname); - fprintf(stderr,"%s: unable to access msg queue\n",progname); - exit(1); - }; /* if */ - - return(s); - -} /* connect_to_ipc_server */ - - -/* - disconnect_from_ipc_server -- inform the server that sending has finished, - and wait for its reply. -*/ -void disconnect_from_ipc_server(s,msgp,echo) - int s; - struct msgbuf *msgp; - int echo; -{ - int len; /* length of received message */ - - send_string(s,EOT_STR); /* EOT terminates this message */ - msgp->mtype = 1; - - if(msgsnd(s,msgp,strlen(msgp->mtext)+1,0) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to send message to server\n",progname); - exit(1); - }; /* if */ - - if((len = msgrcv(s,msgp,GSERV_BUFSZ,getpid(),0)) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to receive message from server\n",progname); - exit(1); - }; /* if */ - - if (echo) { - msgp->mtext[len] = '\0'; /* string terminate message */ - fputs(msgp->mtext, stdout); - if (msgp->mtext[len-1] != '\n') putchar ('\n'); - }; /* if */ - -} /* disconnect_from_ipc_server */ -#endif /* SYSV_IPC */ - - -#if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -/* - send_string -- send string to socket. -*/ -void send_string(s,msg) - int s; - CONST char *msg; -{ -#if 0 - if (send(s,msg,strlen(msg),0) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to send\n",progname); - exit(1); - }; /* if */ -#else - int len, left=strlen(msg); - while (left > 0) { - if ((len=write(s,msg,min2(left,GSERV_BUFSZ))) < 0) { - /* XEmacs addition: robertl@arnet.com */ - if (errno == EPIPE) { - return ; - } - perror(progname); - fprintf(stderr,"%s: unable to send\n",progname); - exit(1); - }; /* if */ - left -= len; - msg += len; - }; /* while */ -#endif -} /* send_string */ - -/* - read_line -- read a \n terminated line from a socket -*/ -int read_line(int s, char *dest) -{ - int length; - int offset=0; - char buffer[GSERV_BUFSZ+1]; - - while ((length=read(s,buffer+offset,1)>0) && buffer[offset]!='\n' - && buffer[offset] != EOT_CHR) { - offset += length; - if (offset >= GSERV_BUFSZ) - break; - } - buffer[offset] = '\0'; - strcpy(dest,buffer); - return 1; -} /* read_line */ -#endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */ - - -#ifdef UNIX_DOMAIN_SOCKETS -/* - connect_to_unix_server -- establish connection with server process via a unix- - domain socket. Returns socket descriptor for server - if successful. -*/ -static int connect_to_unix_server (void) -{ - int s; /* connected socket descriptor */ - struct sockaddr_un server; /* for unix connections */ - - if ((s = socket(AF_UNIX,SOCK_STREAM,0)) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to create socket\n",progname); - exit(1); - }; /* if */ - - server.sun_family = AF_UNIX; -#ifdef HIDE_UNIX_SOCKET - sprintf(server.sun_path,"%s/gsrvdir%d/gsrv",tmpdir,(int)geteuid()); -#else /* HIDE_UNIX_SOCKET */ - sprintf(server.sun_path,"%s/gsrv%d",tmpdir,(int)geteuid()); -#endif /* HIDE_UNIX_SOCKET */ - if (connect(s,(struct sockaddr *)&server,strlen(server.sun_path)+2) < 0) { - perror(progname); - fprintf(stderr,"%s: unable to connect to local\n",progname); - exit(1); - }; /* if */ - - return(s); - -} /* connect_to_unix_server */ -#endif /* UNIX_DOMAIN_SOCKETS */ - - -#ifdef INTERNET_DOMAIN_SOCKETS -/* - internet_addr -- return the internet addr of the hostname or - internet address passed. Return -1 on error. -*/ -int internet_addr(host) - char *host; -{ - struct hostent *hp; /* pointer to host info for remote host */ - IN_ADDR numeric_addr; /* host address */ - - numeric_addr = inet_addr(host); - if (!NUMERIC_ADDR_ERROR) - return numeric_addr; - else if ((hp = gethostbyname(host)) != NULL) - return ((struct in_addr *)(hp->h_addr))->s_addr; - else - return -1; - -} /* internet_addr */ - -#ifdef AUTH_MAGIC_COOKIE -# include -# include - -static Xauth *server_xauth = NULL; -#endif - -/* - connect_to_internet_server -- establish connection with server process via - an internet domain socket. Returns socket - descriptor for server if successful. -*/ -static int connect_to_internet_server (char *serverhost, u_short port) -{ - int s; /* connected socket descriptor */ - struct servent *sp; /* pointer to service information */ - struct sockaddr_in peeraddr_in; /* for peer socket address */ - char buf[512]; /* temporary buffer */ - - /* clear out address structures */ - memset((char *)&peeraddr_in,0,sizeof(struct sockaddr_in)); - - /* Set up the peer address to which we will connect. */ - peeraddr_in.sin_family = AF_INET; - - /* look up the server host's internet address */ - if ((peeraddr_in.sin_addr.s_addr = internet_addr(serverhost)) == -1) { - fprintf(stderr,"%s: unable to find %s in /etc/hosts or from YP\n", - progname,serverhost); - exit(1); - }; /* if */ - - if (port == 0) { - if ((sp = getservbyname ("gnuserv","tcp")) == NULL) - peeraddr_in.sin_port = htons(DEFAULT_PORT+getuid()); - else - peeraddr_in.sin_port = sp->s_port; - } /* if */ - else - peeraddr_in.sin_port = htons(port); - - /* Create the socket. */ - if ((s = socket (AF_INET,SOCK_STREAM, 0))== -1) { - perror(progname); - fprintf(stderr,"%s: unable to create socket\n",progname); - exit(1); - }; /* if */ - - /* Try to connect to the remote server at the address - * which was just built into peeraddr. - */ - if (connect(s, (struct sockaddr *)&peeraddr_in, - sizeof(struct sockaddr_in)) == -1) { - perror(progname); - fprintf(stderr, "%s: unable to connect to remote\n",progname); - exit(1); - }; /* if */ - -#ifdef AUTH_MAGIC_COOKIE - - /* send credentials using MIT-MAGIC-COOKIE-1 protocol */ - - server_xauth = - XauGetAuthByAddr(FamilyInternet, - sizeof(peeraddr_in.sin_addr.s_addr), - (char *) &peeraddr_in.sin_addr.s_addr, - strlen(MCOOKIE_SCREEN), MCOOKIE_SCREEN, - strlen(MCOOKIE_X_NAME), MCOOKIE_X_NAME); - - if (server_xauth && server_xauth->data) { - sprintf(buf, "%s\n%d\n", MCOOKIE_NAME, server_xauth->data_length); - write (s, buf, strlen(buf)); - write (s, server_xauth->data, server_xauth->data_length); - - return (s); - } - -#endif /* AUTH_MAGIC_COOKIE */ - - sprintf (buf, "%s\n", DEFAUTH_NAME); - write (s, buf, strlen(buf)); - - return(s); - -} /* connect_to_internet_server */ -#endif /* INTERNET_DOMAIN_SOCKETS */ - - -#if defined(INTERNET_DOMAIN_SOCKETS) || defined(UNIX_DOMAIN_SOCKETS) -/* - disconnect_from_server -- inform the server that sending has finished, and wait for - its reply. -*/ -void disconnect_from_server(s,echo) - int s; - int echo; -{ -#if 0 - char buffer[REPLYSIZ+1]; -#else - char buffer[GSERV_BUFSZ+1]; -#endif - int add_newline = 1; - int length; - - send_string(s,EOT_STR); /* make sure server gets string */ - -#if !defined (linux) && !defined (_SCO_DS) - /* - * shutdown is completely hozed under linux. If s is a unix domain socket, - * you'll get EOPNOTSUPP back from it. If s is an internet socket, you get - * a broken pipe when you try to read a bit later. The latter - * problem is fixed for linux versions >= 1.1.46, but the problem - * with unix sockets persists. Sigh. - */ - - if (shutdown(s,1) == -1) { - perror(progname); - fprintf(stderr, "%s: unable to shutdown socket\n",progname); - exit(1); - }; /* if */ -#endif - -#if 0 - while((length = recv(s,buffer,REPLYSIZ,0)) > 0) { - buffer[length] = '\0'; - if (echo) fputs(buffer,stdout); - add_newline = (buffer[length-1] != '\n'); - }; /* while */ -#else - while ((length = read(s,buffer,GSERV_BUFSZ)) > 0 || - (length == -1 && errno == EINTR)) { - if (length) { - buffer[length] = '\0'; - if (echo) { - fputs(buffer,stdout); - add_newline = (buffer[length-1] != '\n'); - }; /* if */ - }; /* if */ - }; /* while */ -#endif - - if (echo && add_newline) putchar('\n'); - - if(length < 0) { - perror(progname); - fprintf(stderr,"%s: unable to read the reply from the server\n",progname); - exit(1); - }; /* if */ - -} /* disconnect_from_server */ -#endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */ diff --git a/lib-src/gzip-el.sh b/lib-src/gzip-el.sh deleted file mode 100755 index 9d1563a..0000000 --- a/lib-src/gzip-el.sh +++ /dev/null @@ -1,37 +0,0 @@ -#! /bin/sh -### gzip-el.sh --- compress superfluous installed source lisp - -# Author: Jeff Miller -# Author: Hrvoje Niksic -# Maintainer: Steve Baur -# Created: 13 Feb 1997 -# Version: 1.0 -# 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. - -# -# -echo Compressing .el files in "$1"... - -find "$1" -type f -name "*.el" -print | - while read file; do - [ -s "${file}c" ] && echo "$file" && gzip -f9 "$file" - done - -echo Compressing .el files in "$1"...done. diff --git a/lib-src/hexl.c b/lib-src/hexl.c deleted file mode 100644 index 58855a0..0000000 --- a/lib-src/hexl.c +++ /dev/null @@ -1,252 +0,0 @@ -/* Synched up with: FSF 19.28. */ - -#include <../src/config.h> - -#include -#include -#ifdef MSDOS -#include -#endif - -#if __STDC__ || defined(STDC_HEADERS) -#include -#include -#include -#endif - -#define DEFAULT_GROUPING 0x01 -#define DEFAULT_BASE 16 - -#undef TRUE -#undef FALSE -#define TRUE (1) -#define FALSE (0) - -int base = DEFAULT_BASE, un_flag = FALSE, iso_flag = FALSE, endian = 1; -int group_by = DEFAULT_GROUPING; -char *progname; - -void usage (void); - -int -main(argc, argv) - int argc; - char *argv[]; -{ - register long address; - char string[18]; - FILE *fp; - - progname = *argv++; --argc; - - /* - ** -hex hex dump - ** -oct Octal dump - ** -group-by-8-bits - ** -group-by-16-bits - ** -group-by-32-bits - ** -group-by-64-bits - ** -iso iso character set. - ** -big-endian Big Endian - ** -little-endian Little Endian - ** -un || -de from hexl format to binary. - ** -- End switch list. - ** dump filename - ** - (as filename == stdin) - */ - - while (*argv && *argv[0] == '-' && (*argv)[1]) - { - /* A switch! */ - if (!strcmp (*argv, "--")) - { - --argc; argv++; - break; - } - else if (!strcmp (*argv, "-un") || !strcmp (*argv, "-de")) - { - un_flag = TRUE; - --argc; argv++; - } - else if (!strcmp (*argv, "-hex")) - { - base = 16; - --argc; argv++; - } - else if (!strcmp (*argv, "-iso")) - { - iso_flag = TRUE; - --argc; argv++; - } - else if (!strcmp (*argv, "-oct")) - { - base = 8; - --argc; argv++; - } - else if (!strcmp (*argv, "-big-endian")) - { - endian = 1; - --argc; argv++; - } - else if (!strcmp (*argv, "-little-endian")) - { - endian = 0; - --argc; argv++; - } - else if (!strcmp (*argv, "-group-by-8-bits")) - { - group_by = 0x00; - --argc; argv++; - } - else if (!strcmp (*argv, "-group-by-16-bits")) - { - group_by = 0x01; - --argc; argv++; - } - else if (!strcmp (*argv, "-group-by-32-bits")) - { - group_by = 0x03; - --argc; argv++; - } - else if (!strcmp (*argv, "-group-by-64-bits")) - { - group_by = 0x07; - endian = 0; - --argc; argv++; - } - else - { - (void) fprintf (stderr, "%s: invalid switch: \"%s\".\n", progname, - *argv); - usage (); - } - } - - do - { - if (*argv == NULL) - fp = stdin; - else - { - char *filename = *argv++; - - if (!strcmp (filename, "-")) - fp = stdin; - else if ((fp = fopen (filename, "r")) == NULL) - { - perror (filename); - continue; - } - } - - if (un_flag) - { - char buf[18]; - -#ifdef MSDOS - (stdout)->_flag &= ~_IOTEXT; /* print binary */ - _setmode (fileno (stdout), O_BINARY); -#endif - for (;;) - { - register int i, c, d; - -#define hexchar(x) (isdigit (x) ? x - '0' : x - 'a' + 10) - - fread (buf, 1, 10, fp); /* skip 10 bytes */ - - for (i=0; i < 16; ++i) - { - if ((c = getc (fp)) == ' ' || c == EOF) - break; - - d = getc (fp); - c = hexchar (c) * 0x10 + hexchar (d); - putchar (c); - - if ((i&group_by) == group_by) - getc (fp); - } - - if (c == ' ') - { - while ((c = getc (fp)) != '\n' && c != EOF) - ; - - if (c == EOF) - break; - } - else - { - if (i < 16) - break; - - fread (buf, 1, 18, fp); /* skip 18 bytes */ - } - } - } - else - { -#ifdef MSDOS - (fp)->_flag &= ~_IOTEXT; /* read binary */ - _setmode (fileno (fp), O_BINARY); -#endif - address = 0; - string[0] = ' '; - string[17] = '\0'; - for (;;) - { - register int i, c; - - for (i=0; i < 16; ++i) - { - if ((c = getc (fp)) == EOF) - { - if (!i) - break; - - fputs (" ", stdout); - string[i+1] = '\0'; - } - else - { - if (!i) - (void) printf ("%08lx: ", address); - - if (iso_flag) - string[i+1] = - (c < 0x20 || (c >= 0x7F && c < 0xa0)) ? '.' :c; - else - string[i+1] = (c < 0x20 || c >= 0x7F) ? '.' : c; - - (void) printf ("%02x", c); - } - - if ((i&group_by) == group_by) - putchar (' '); - } - - if (i) - puts (string); - - if (c == EOF) - break; - - address += 0x10; - - } - } - - if (fp != stdin) - (void) fclose (fp); - - } while (*argv != NULL); - return 0; -} - -void -usage () -{ - (void) fprintf (stderr, "usage: %s [-de] [-iso]\n", progname); - exit (1); -} diff --git a/lib-src/installexe.sh b/lib-src/installexe.sh deleted file mode 100644 index 2c1849a..0000000 --- a/lib-src/installexe.sh +++ /dev/null @@ -1,21 +0,0 @@ -#!sh - -install_prog=$1 -shift - -tstr="" -while [ $# -gt 0 ] -do - if [ -f $1.exe ] - then - tstr="$tstr$1.exe $2.exe" - shift 2 - else - tstr="$tstr$1 " - fi - shift -done -echo "$install_prog $tstr" -eval "$install_prog $tstr" -exit - diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c deleted file mode 100644 index 79f79e1..0000000 --- a/lib-src/make-docfile.c +++ /dev/null @@ -1,1097 +0,0 @@ -/* Generate doc-string file for XEmacs from source files. - Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1998, 1999 J. Kean Johnston. - -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. */ - -/* The arguments given to this program are all the C and Lisp source files - of XEmacs. .elc and .el and .c files are allowed. - A .o file can also be specified; the .c file it was made from is used. - This helps the makefile pass the correct list of files. - - The results, which go to standard output or to a file - specified with -a or -o (-a to append, -o to start from nothing), - are entries containing function or variable names and their documentation. - Each entry starts with a ^_ character. - Then comes F for a function or V for a variable. - Then comes the function or variable name, terminated with a newline. - Then comes the documentation for that function or variable. - - Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages - without modifying Makefiles, etc. - */ - -#define NO_SHORTNAMES /* Tell config not to load remap.h */ -#include <../src/config.h> - -#include -#include -#if __STDC__ || defined(STDC_HEADERS) -#include -#include -#include -#include -#endif - -#include - -#if defined(MSDOS) || defined(__CYGWIN32__) -#include -#endif /* MSDOS */ -#ifdef WINDOWSNT -#include -#include -#include -#include -#endif /* WINDOWSNT */ - -#if defined(DOS_NT) || defined(__CYGWIN32__) -#define READ_TEXT "rt" -#define READ_BINARY "rb" -#define WRITE_BINARY "wb" -#define APPEND_BINARY "ab" -#else /* not DOS_NT */ -#define READ_TEXT "r" -#define READ_BINARY "r" -#define WRITE_BINARY "w" -#define APPEND_BINARY "a" -#endif /* not DOS_NT */ - -#ifdef MSDOS -/* s/msdos.h defines this as sys_chdir, but we're not linking with the - file where that function is defined. */ -#undef chdir -#endif - -/* Stdio stream for output to the DOC file. */ -static FILE *outfile; - -enum -{ - el_file, - elc_file, - c_file -} Current_file_type; - -static int scan_file (CONST char *filename); -static int read_c_string (FILE *, int, int); -static void write_c_args (FILE *out, CONST char *func, char *buf, int minargs, - int maxargs); -static int scan_c_file (CONST char *filename, CONST char *mode); -static void skip_white (FILE *); -static void read_lisp_symbol (FILE *, char *); -static int scan_lisp_file (CONST char *filename, CONST char *mode); - -#define C_IDENTIFIER_CHAR_P(c) \ - (('A' <= c && c <= 'Z') || \ - ('a' <= c && c <= 'z') || \ - ('0' <= c && c <= '9') || \ - (c == '_')) - -/* Name this program was invoked with. */ -char *progname; - -/* Set to 1 if this was invoked by ellcc */ -int ellcc = 0; - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ - -static void -error (CONST char *s1, CONST char *s2) -{ - fprintf (stderr, "%s: ", progname); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} - -/* Print error message and exit. */ - -static void -fatal (CONST char *s1, CONST char *s2) -{ - error (s1, s2); - exit (1); -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -static long * -xmalloc (unsigned int size) -{ - long *result = (long *) malloc (size); - if (result == NULL) - fatal ("virtual memory exhausted", 0); - return result; -} - -static char * -next_extra_elc(char *extra_elcs) -{ - static FILE *fp = NULL; - static char line_buf[BUFSIZ]; - char *p = line_buf+1; - - if (!fp) { - if (!extra_elcs) { - return NULL; - } else if (!(fp = fopen(extra_elcs, READ_BINARY))) { - /* It is not an error if this file doesn't exist. */ - /*fatal("error opening site package file list", 0);*/ - return NULL; - } - fgets(line_buf, BUFSIZ, fp); - } - -again: - if (!fgets(line_buf, BUFSIZ, fp)) { - fclose(fp); - fp = NULL; - return NULL; - } - line_buf[0] = '\0'; - if (strlen(p) <= 2 || strlen(p) >= (BUFSIZ - 5)) { - /* reject too short or too long lines */ - goto again; - } - p[strlen(p) - 2] = '\0'; - strcat(p, ".elc"); - - return p; -} - - -int -main (int argc, char **argv) -{ - int i; - int err_count = 0; - int first_infile; - char *extra_elcs = NULL; - - progname = argv[0]; - - outfile = stdout; - - /* Don't put CRs in the DOC file. */ -#ifdef MSDOS - _fmode = O_BINARY; -#if 0 /* Suspicion is that this causes hanging. - So instead we require people to use -o on MSDOS. */ - (stdout)->_flag &= ~_IOTEXT; - _setmode (fileno (stdout), O_BINARY); -#endif - outfile = 0; -#endif /* MSDOS */ -#ifdef WINDOWSNT - _fmode = O_BINARY; - _setmode (fileno (stdout), O_BINARY); -#endif /* WINDOWSNT */ - - /* If first two args are -o FILE, output to FILE. */ - i = 1; - if (argc > i + 1 && !strcmp (argv[i], "-o")) - { - outfile = fopen (argv[i + 1], WRITE_BINARY); - i += 2; - } - if (argc > i + 1 && !strcmp (argv[i], "-a")) - { - outfile = fopen (argv[i + 1], APPEND_BINARY); - i += 2; - } - if (argc > i + 1 && !strcmp (argv[i], "-E")) - { - outfile = fopen (argv[i + 1], APPEND_BINARY); - i += 2; - ellcc = 1; - } - if (argc > i + 1 && !strcmp (argv[i], "-d")) - { - chdir (argv[i + 1]); - i += 2; - } - - if (argc > (i + 1) && !strcmp(argv[i], "-i")) { - extra_elcs = argv[i + 1]; - i += 2; - } - - if (outfile == 0) - fatal ("No output file specified", ""); - - if (ellcc) - fprintf (outfile, "{\n"); - - first_infile = i; - for (; i < argc; i++) - { - int j; - /* Don't process one file twice. */ - for (j = first_infile; j < i; j++) - if (! strcmp (argv[i], argv[j])) - break; - if (j == i) - /* err_count seems to be {mis,un}used */ - err_count += scan_file (argv[i]); - } - - if (extra_elcs) { - char *p; - - while ((p = next_extra_elc(extra_elcs)) != NULL) { - err_count += scan_file(p); - } - } - - putc ('\n', outfile); - if (ellcc) - fprintf (outfile, "}\n\n"); -#ifndef VMS - exit (err_count > 0); -#endif /* VMS */ - return err_count > 0; -} - -/* Read file FILENAME and output its doc strings to outfile. */ -/* Return 1 if file is not found, 0 if it is found. */ - -static int -scan_file (CONST char *filename) -{ - int len = strlen (filename); - if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) - { - Current_file_type = elc_file; - return scan_lisp_file (filename, READ_BINARY); - } - else if (ellcc == 0 && len > 3 && !strcmp (filename + len - 3, ".el")) - { - Current_file_type = el_file; - return scan_lisp_file (filename, READ_TEXT); - } - else - { - Current_file_type = c_file; - return scan_c_file (filename, READ_TEXT); - } -} - -char buf[128]; - -/* Skip a C string from INFILE, - and return the character that follows the closing ". - If printflag is positive, output string contents to outfile. - If it is negative, store contents in buf. - Convert escape sequences \n and \t to newline and tab; - discard \ followed by newline. */ - -static int -read_c_string (FILE *infile, int printflag, int c_docstring) -{ - register int c; - char *p = buf; - int start = -1; - - c = getc (infile); - while (c != EOF) - { - while ((c_docstring || c != '"') && c != EOF) - { - if (start) - { - if (c == '*') - { - int cc = getc (infile); - if (cc == '/') - break; - else - ungetc (cc, infile); - } - - if (start != -1) - { - if (printflag > 0) - { - if (ellcc) - fprintf (outfile, "\\n\\"); - putc ('\n', outfile); - } - else if (printflag < 0) - *p++ = '\n'; - } - } - - if (c == '\\') - { - c = getc (infile); - if (c == '\n') - { - c = getc (infile); - start = 1; - continue; - } - if (!c_docstring && c == 'n') - c = '\n'; - if (c == 't') - c = '\t'; - } - if (c == '\n') - start = 1; - else - { - start = 0; - if (printflag > 0) { - if (ellcc && c == '"') - putc ('\\', outfile); - putc (c, outfile); - } - else if (printflag < 0) - *p++ = c; - } - c = getc (infile); - } - /* look for continuation of string */ - if (Current_file_type == c_file) - { - while (isspace (c = getc (infile))) - ; - if (c != '"') - break; - } - else - { - c = getc (infile); - if (c != '"') - break; - /* If we had a "", concatenate the two strings. */ - } - c = getc (infile); - } - - if (printflag < 0) - *p = 0; - - return c; -} - -/* Write to file OUT the argument names of function FUNC, whose text is in BUF. - MINARGS and MAXARGS are the minimum and maximum number of arguments. */ - -static void -write_c_args (FILE *out, CONST char *func, char *buff, int minargs, - int maxargs) -{ - register char *p; - int in_ident = 0; - int just_spaced = 0; -#if 0 - int need_space = 1; - - fprintf (out, "(%s", func); -#else - /* XEmacs - "arguments:" is for parsing the docstring. FSF's help system - doesn't parse the docstring for arguments like we do, so we're also - going to omit the function name to preserve compatibility with elisp - that parses the docstring. Finally, not prefixing the arglist with - anything is asking for trouble because it's not uncommon to have an - unescaped parenthesis at the beginning of a line. --Stig */ - fprintf (out, "arguments: ("); -#endif - - if (*buff == '(') - ++buff; - - for (p = buff; *p; p++) - { - char c = *p; - int ident_start = 0; - - /* Add support for ANSI prototypes. Hop over - "Lisp_Object" string (the only C type allowed in DEFUNs) */ - static char lo[] = "Lisp_Object"; - if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident && - (strncmp (p, lo, sizeof (lo) - 1) == 0) && - isspace(*(p + sizeof (lo) - 1))) - { - p += (sizeof (lo) - 1); - while (isspace (*p)) - p++; - c = *p; - } - - /* Notice when we start printing a new identifier. */ - if (C_IDENTIFIER_CHAR_P (c) != in_ident) - { - if (!in_ident) - { - in_ident = 1; - ident_start = 1; -#if 0 - /* XEmacs - This goes along with the change above. */ - if (need_space) - putc (' ', out); -#endif - if (minargs == 0 && maxargs > 0) - fprintf (out, "&optional "); - just_spaced = 1; - - minargs--; - maxargs--; - } - else - in_ident = 0; - } - - /* Print the C argument list as it would appear in lisp: - print underscores as hyphens, and print commas as spaces. - Collapse adjacent spaces into one. */ - if (c == '_') c = '-'; - if (c == ',') c = ' '; - - /* If the C argument name ends with `_', change it to ' ', - to allow use of C reserved words or global symbols as Lisp args. */ - if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) - { - in_ident = 0; - just_spaced = 0; - } - else if (c != ' ' || ! just_spaced) - { - if (c >= 'a' && c <= 'z') - /* Upcase the letter. */ - c += 'A' - 'a'; - putc (c, out); - } - - just_spaced = (c == ' '); -#if 0 - need_space = 0; -#endif - } - if (!ellcc) - putc ('\n', out); /* XEmacs addition */ -} - -/* Read through a c file. If a .o file is named, - the corresponding .c file is read instead. - Looks for DEFUN constructs such as are defined in ../src/lisp.h. - Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ - -static int -scan_c_file (CONST char *filename, CONST char *mode) -{ - FILE *infile; - register int c; - register int commas; - register int defunflag; - register int defvarperbufferflag = 0; - register int defvarflag; - int minargs, maxargs; - int l = strlen (filename); - char f[MAXPATHLEN]; - - if (l > sizeof (f)) - { -#ifdef ENAMETOOLONG - errno = ENAMETOOLONG; -#else - errno = EINVAL; -#endif - return (0); - } - - strcpy (f, filename); - if (f[l - 1] == 'o') - f[l - 1] = 'c'; - infile = fopen (f, mode); - - /* No error if non-ex input file */ - if (infile == NULL) - { - perror (f); - return 0; - } - - c = '\n'; - while (!feof (infile)) - { - if (c != '\n') - { - c = getc (infile); - continue; - } - c = getc (infile); - if (c == ' ') - { - while (c == ' ') - c = getc (infile); - if (c != 'D') - continue; - c = getc (infile); - if (c != 'E') - continue; - c = getc (infile); - if (c != 'F') - continue; - c = getc (infile); - if (c != 'V') - continue; - c = getc (infile); - if (c != 'A') - continue; - c = getc (infile); - if (c != 'R') - continue; - c = getc (infile); - if (c != '_') - continue; - - defvarflag = 1; - defunflag = 0; - - c = getc (infile); - /* Note that this business doesn't apply under XEmacs. - DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */ - defvarperbufferflag = (c == 'P'); - - c = getc (infile); - } - else if (c == 'D') - { - c = getc (infile); - if (c != 'E') - continue; - c = getc (infile); - if (c != 'F') - continue; - c = getc (infile); - defunflag = (c == 'U'); - defvarflag = 0; - c = getc (infile); - } - else continue; - - while (c != '(') - { - if (c < 0) - goto eof; - c = getc (infile); - } - - c = getc (infile); - if (c != '"') - continue; - c = read_c_string (infile, -1, 0); - - if (defunflag) - commas = 4; - else if (defvarperbufferflag) - commas = 2; - else if (defvarflag) - commas = 1; - else /* For DEFSIMPLE and DEFPRED */ - commas = 2; - - while (commas) - { - if (c == ',') - { - commas--; - if (defunflag && (commas == 1 || commas == 2)) - { - do - c = getc (infile); - while (c == ' ' || c == '\n' || c == '\t') - ; - if (c < 0) - goto eof; - ungetc (c, infile); - if (commas == 2) /* pick up minargs */ - fscanf (infile, "%d", &minargs); - else /* pick up maxargs */ - if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ - maxargs = -1; - else - fscanf (infile, "%d", &maxargs); - } - } - if (c < 0) - goto eof; - c = getc (infile); - } - while (c == ' ' || c == '\n' || c == '\t') - c = getc (infile); - if (c == '"') - c = read_c_string (infile, 0, 0); - if (defunflag | defvarflag) - { - while (c != '/') - c = getc (infile); - c = getc (infile); - while (c == '*') - c = getc (infile); - } - else - { - while (c != ',') - c = getc (infile); - c = getc (infile); - } - while (c == ' ' || c == '\n' || c == '\t') - c = getc (infile); - if (defunflag | defvarflag) - ungetc (c, infile); - - if (defunflag || defvarflag || c == '"') - { - if (ellcc) - fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", - defvarflag ? "SYM" : "SUBR", buf); - else - { - putc (037, outfile); - putc (defvarflag ? 'V' : 'F', outfile); - fprintf (outfile, "%s\n", buf); - } - c = read_c_string (infile, 1, (defunflag || defvarflag)); - - /* If this is a defun, find the arguments and print them. If - this function takes MANY or UNEVALLED args, then the C source - won't give the names of the arguments, so we shouldn't bother - trying to find them. */ - if (defunflag && maxargs != -1) - { - char argbuf[1024], *p = argbuf; -#if 0 /* For old DEFUN's only */ - while (c != ')') - { - if (c < 0) - goto eof; - c = getc (infile); - } -#endif - /* Skip into arguments. */ - while (c != '(') - { - if (c < 0) - goto eof; - c = getc (infile); - } - /* Copy arguments into ARGBUF. */ - *p++ = c; - do - *p++ = c = getc (infile); - while (c != ')'); - *p = '\0'; - /* Output them. */ - if (ellcc) - fprintf (outfile, "\\n\\\n\\n\\\n"); - else - fprintf (outfile, "\n\n"); - write_c_args (outfile, buf, argbuf, minargs, maxargs); - } - if (ellcc) - fprintf (outfile, "\\n\");\n\n"); - } - } - eof: - fclose (infile); - return 0; -} - -/* Read a file of Lisp code, compiled or interpreted. - Looks for - (defun NAME ARGS DOCSTRING ...) - (defmacro NAME ARGS DOCSTRING ...) - (autoload (quote NAME) FILE DOCSTRING ...) - (defvar NAME VALUE DOCSTRING) - (defconst NAME VALUE DOCSTRING) - (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) - (fset (quote NAME) #[... DOCSTRING ...]) - (defalias (quote NAME) #[... DOCSTRING ...]) - starting in column zero. - (quote NAME) may appear as 'NAME as well. - - We also look for #@LENGTH CONTENTS^_ at the beginning of the line. - When we find that, we save it for the following defining-form, - and we use that instead of reading a doc string within that defining-form. - - For defun, defmacro, and autoload, we know how to skip over the arglist. - For defvar, defconst, and fset we skip to the docstring with a kludgy - formatting convention: all docstrings must appear on the same line as the - initial open-paren (the one in column zero) and must contain a backslash - and a double-quote immediately after the initial double-quote. No newlines - must appear between the beginning of the form and the first double-quote. - The only source file that must follow this convention is loaddefs.el; aside - from that, it is always the .elc file that we look at, and they are no - problem because byte-compiler output follows this convention. - The NAME and DOCSTRING are output. - NAME is preceded by `F' for a function or `V' for a variable. - An entry is output only if DOCSTRING has \ newline just after the opening " - */ - -static void -skip_white (FILE *infile) -{ - char c = ' '; - while (c == ' ' || c == '\t' || c == '\n') - c = getc (infile); - ungetc (c, infile); -} - -static void -read_lisp_symbol (FILE *infile, char *buffer) -{ - char c; - char *fillp = buffer; - - skip_white (infile); - while (1) - { - c = getc (infile); - if (c == '\\') - /* FSF has *(++fillp), which is wrong. */ - *fillp++ = getc (infile); - else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') - { - ungetc (c, infile); - *fillp = 0; - break; - } - else - *fillp++ = c; - } - - if (! buffer[0]) - fprintf (stderr, "## expected a symbol, got '%c'\n", c); - - skip_white (infile); -} - -static int -scan_lisp_file (CONST char *filename, CONST char *mode) -{ - FILE *infile; - register int c; - char *saved_string = 0; - - infile = fopen (filename, mode); - if (infile == NULL) - { - perror (filename); - return 0; /* No error */ - } - - c = '\n'; - while (!feof (infile)) - { - char buffer[BUFSIZ]; - char type; - - if (c != '\n') - { - c = getc (infile); - continue; - } - c = getc (infile); - /* Detect a dynamic doc string and save it for the next expression. */ - if (c == '#') - { - c = getc (infile); - if (c == '@') - { - int length = 0; - int i; - - /* Read the length. */ - while ((c = getc (infile), - c >= '0' && c <= '9')) - { - length *= 10; - length += c - '0'; - } - - /* The next character is a space that is counted in the length - but not part of the doc string. - We already read it, so just ignore it. */ - length--; - - /* Read in the contents. */ - if (saved_string != 0) - free (saved_string); - saved_string = (char *) xmalloc (length); - for (i = 0; i < length; i++) - saved_string[i] = getc (infile); - /* The last character is a ^_. - That is needed in the .elc file - but it is redundant in DOC. So get rid of it here. */ - saved_string[length - 1] = 0; - /* Skip the newline. */ - c = getc (infile); - while (c != '\n') - c = getc (infile); - } - continue; - } - - if (c != '(') - continue; - - read_lisp_symbol (infile, buffer); - - if (! strcmp (buffer, "defun") || - ! strcmp (buffer, "defmacro")) - { - type = 'F'; - read_lisp_symbol (infile, buffer); - - /* Skip the arguments: either "nil" or a list in parens */ - - c = getc (infile); - if (c == 'n') /* nil */ - { - if ((c = getc (infile)) != 'i' || - (c = getc (infile)) != 'l') - { - fprintf (stderr, "## unparsable arglist in %s (%s)\n", - buffer, filename); - continue; - } - } - else if (c != '(') - { - fprintf (stderr, "## unparsable arglist in %s (%s)\n", - buffer, filename); - continue; - } - else - while (c != ')') - c = getc (infile); - skip_white (infile); - - /* If the next three characters aren't `dquote bslash newline' - then we're not reading a docstring. - */ - if ((c = getc (infile)) != '"' || - (c = getc (infile)) != '\\' || - (c = getc (infile)) != '\n') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } - - else if (! strcmp (buffer, "defvar") || - ! strcmp (buffer, "defconst")) - { - char c1 = 0, c2 = 0; - type = 'V'; - read_lisp_symbol (infile, buffer); - - if (saved_string == 0) - { - - /* Skip until the first newline; remember the two previous chars. */ - while (c != '\n' && c >= 0) - { - /* ### Kludge -- Ignore any ESC x x ISO2022 sequences */ - if (c == 27) - { - getc (infile); - getc (infile); - goto nextchar; - } - - c2 = c1; - c1 = c; - nextchar: - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } - } - - else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) - { - char c1 = 0, c2 = 0; - type = 'F'; - - c = getc (infile); - if (c == '\'') - read_lisp_symbol (infile, buffer); - else - { - if (c != '(') - { - fprintf (stderr, "## unparsable name in fset in %s\n", - filename); - continue; - } - read_lisp_symbol (infile, buffer); - if (strcmp (buffer, "quote")) - { - fprintf (stderr, "## unparsable name in fset in %s\n", - filename); - continue; - } - read_lisp_symbol (infile, buffer); - c = getc (infile); - if (c != ')') - { - fprintf (stderr, - "## unparsable quoted name in fset in %s\n", - filename); - continue; - } - } - - if (saved_string == 0) - { - /* Skip until the first newline; remember the two previous chars. */ - while (c != '\n' && c >= 0) - { - c2 = c1; - c1 = c; - c = getc (infile); - } - - /* If two previous characters were " and \, - this is a doc string. Otherwise, there is none. */ - if (c2 != '"' || c1 != '\\') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } - } - - else if (! strcmp (buffer, "autoload")) - { - type = 'F'; - c = getc (infile); - if (c == '\'') - read_lisp_symbol (infile, buffer); - else - { - if (c != '(') - { - fprintf (stderr, "## unparsable name in autoload in %s\n", - filename); - continue; - } - read_lisp_symbol (infile, buffer); - if (strcmp (buffer, "quote")) - { - fprintf (stderr, "## unparsable name in autoload in %s\n", - filename); - continue; - } - read_lisp_symbol (infile, buffer); - c = getc (infile); - if (c != ')') - { - fprintf (stderr, - "## unparsable quoted name in autoload in %s\n", - filename); - continue; - } - } - skip_white (infile); - if ((c = getc (infile)) != '\"') - { - fprintf (stderr, "## autoload of %s unparsable (%s)\n", - buffer, filename); - continue; - } - read_c_string (infile, 0, 0); - skip_white (infile); - - if (saved_string == 0) - { - /* If the next three characters aren't `dquote bslash newline' - then we're not reading a docstring. */ - if ((c = getc (infile)) != '"' || - (c = getc (infile)) != '\\' || - (c = getc (infile)) != '\n') - { -#ifdef DEBUG - fprintf (stderr, "## non-docstring in %s (%s)\n", - buffer, filename); -#endif - continue; - } - } - } - -#if 0 /* causes crash */ - else if (! strcmp (buffer, "if") || - ! strcmp (buffer, "byte-code")) - ; -#endif - - else - { -#ifdef DEBUG - fprintf (stderr, "## unrecognized top-level form, %s (%s)\n", - buffer, filename); -#endif - continue; - } - - /* At this point, we should either use the previous - dynamic doc string in saved_string - or gobble a doc string from the input file. - - In the latter case, the opening quote (and leading - backslash-newline) have already been read. */ - putc ('\n', outfile); /* XEmacs addition */ - putc (037, outfile); - putc (type, outfile); - fprintf (outfile, "%s\n", buffer); - if (saved_string) - { - fputs (saved_string, outfile); - /* Don't use one dynamic doc string twice. */ - free (saved_string); - saved_string = 0; - } - else - read_c_string (infile, 1, 0); - } - fclose (infile); - return 0; -} diff --git a/lib-src/make-msgfile.c b/lib-src/make-msgfile.c deleted file mode 100644 index 31b9379..0000000 --- a/lib-src/make-msgfile.c +++ /dev/null @@ -1,480 +0,0 @@ -/* - - - PROPOSAL FOR HOW THIS ALL OUGHT TO WORK - this isn't implemented yet, but this is the plan-in-progress - - - In general, it's accepted that the best way to internationalize is for all - messages to be referred to by a symbolic name (or number) and come out of a - table or tables, which are easy to change. - - However, with Emacs, we've got the task of internationalizing a huge body - of existing code, which already contains messages internally. - - For the C code we've got two options: - - - Use a Sun-like gettext() form, which takes an "english" string which - appears literally in the source, and uses that as a hash key to find - a translated string; - - Rip all of the strings out and put them in a table. - - In this case, it's desirable to make as few changes as possible to the C - code, to make it easier to merge the code with the FSF version of emacs - which won't ever have these changes made to it. So we should go with the - former option. - - The way it has been done (between 19.8 and 19.9) was to use gettext(), but - *also* to make massive changes to the source code. The goal now is to use - gettext() at run-time and yet not require a textual change to every line - in the C code which contains a string constant. A possible way to do this - is described below. - - (gettext() can be implemented in terms of catgets() for non-Sun systems, so - that in itself isn't a problem.) - - For the Lisp code, we've got basically the same options: put everything in - a table, or translate things implicitly. - - Another kink that lisp code introduces is that there are thousands of third- - party packages, so changing the source for all of those is simply not an - option. - - Is it a goal that if some third party package displays a message which is - one we know how to translate, then we translate it? I think this is a - worthy goal. It remains to be seen how well it will work in practice. - - So, we should endeavor to minimize the impact on the lisp code. Certain - primitive lisp routines (the stuff in lisp/prim/, and especially in - cmdloop.el and minibuf.el) may need to be changed to know about translation, - but that's an ideologically clean thing to do because those are considered - a part of the emacs substrate. - - However, if we find ourselves wanting to make changes to, say, RMAIL, then - something has gone wrong. (Except to do things like remove assumptions - about the order of words within a sentence, or how pluralization works.) - - There are two parts to the task of displaying translated strings to the - user: the first is to extract the strings which need to be translated from - the sources; and the second is to make some call which will translate those - strings before they are presented to the user. - - The old way was to use the same form to do both, that is, GETTEXT() was both - the tag that we searched for to build a catalog, and was the form which did - the translation. The new plan is to separate these two things more: the - tags that we search for to build the catalog will be stuff that was in there - already, and the translation will get done in some more centralized, lower - level place. - - This program (make-msgfile.c) addresses the first part, extracting the - strings. - - For the emacs C code, we need to recognize the following patterns: - - message ("string" ... ) - error ("string") - report_file_error ("string" ... ) - signal_simple_error ("string" ... ) - signal_simple_error_2 ("string" ... ) - - build_translated_string ("string") - #### add this and use it instead of build_string() in some places. - - yes_or_no_p ("string" ... ) - #### add this instead of funcalling Qyes_or_no_p directly. - - barf_or_query_if_file_exists #### restructure this - check all callers of Fsignal #### restructure these - signal_error (Qerror ... ) #### change all of these to error() - - And we also parse out the `interactive' prompts from DEFUN() forms. - - #### When we've got a string which is a candidate for translation, we - should ignore it if it contains only format directives, that is, if - there are no alphabetic characters in it that are not a part of a `%' - directive. (Careful not to translate either "%s%s" or "%s: ".) - - For the emacs Lisp code, we need to recognize the following patterns: - - (message "string" ... ) - (error "string" ... ) - (format "string" ... ) - (read-from-minibuffer "string" ... ) - (read-shell-command "string" ... ) - (y-or-n-p "string" ... ) - (yes-or-no-p "string" ... ) - (read-file-name "string" ... ) - (temp-minibuffer-message "string") - (query-replace-read-args "string" ... ) - - I expect there will be a lot like the above; basically, any function which - is a commonly used wrapper around an eventual call to `message' or - `read-from-minibuffer' needs to be recognized by this program. - - - (dgettext "domain-name" "string") #### do we still need this? - - things that should probably be restructured: - `princ' in cmdloop.el - `insert' in debug.el - face-interactive - help.el, syntax.el all messed up - - - Menu descriptors: one way to extract the strings in menu labels would be - to teach this program about "^(defvar .*menu\n" forms; that's probably - kind of hard, though, so perhaps a better approach would be to make this - program recognize lines of the form - - "string" ... ;###translate - - where the magic token ";###translate" on a line means that the string - constant on this line should go into the message catalog. This is analagous - to the magic ";###autoload" comments, and to the magic comments used in the - EPSF structuring conventions. - - ----- - So this program manages to build up a catalog of strings to be translated. - To address the second part of the problem, of actually looking up the - translations, there are hooks in a small number of low level places in - emacs. - - Assume the existence of a C function gettext(str) which returns the - translation of `str' if there is one, otherwise returns `str'. - - - message() takes a char* as its argument, and always filters it through - gettext() before displaying it. - - - errors are printed by running the lisp function `display-error' which - doesn't call `message' directly (it princ's to streams), so it must be - carefully coded to translate its arguments. This is only a few lines - of code. - - - Fread_minibuffer_internal() is the lowest level interface to all minibuf - interactions, so it is responsible for translating the value that will go - into Vminibuf_prompt. - - - Fpopup_menu filters the menu titles through gettext(). - - The above take care of 99% of all messages the user ever sees. - - - The lisp function temp-minibuffer-message translates its arg. - - - query-replace-read-args is funny; it does - (setq from (read-from-minibuffer (format "%s: " string) ... )) - (setq to (read-from-minibuffer (format "%s %s with: " string from) ... )) - - What should we do about this? We could hack query-replace-read-args to - translate its args, but might this be a more general problem? I don't - think we ought to translate all calls to format. We could just change - the calling sequence, since this is odd in that the first %s wants to be - translated but the second doesn't. - - - Solving the "translating too much" problem: - The concern has been raised that in this situation: - - "Help" is a string for which we know a translation; - - someone visits a file called Help, and someone does something - contrived like (error buffer-file-name) - then we would display the translation of Help, which would not be correct. - We can solve this by adding a bit to Lisp_String objects which identifies - them as having been read as literal constants from a .el or .elc file (as - opposed to having been constructed at run time as it would in the above - case.) To solve this: - - - Fmessage() takes a lisp string as its first argument. - If that string is a constant, that is, was read from a source file - as a literal, then it calls message() with it, which translates. - Otherwise, it calls message_no_translate(), which does not translate. - - - Ferror() (actually, Fsignal() when condition is Qerror) works similarly. -*/ - - - - -/* Scan specified C and Lisp files, extracting the following messages: - - C files: - GETTEXT (...) - DEFER_GETTEXT (...) - DEFUN interactive prompts - Lisp files: - (gettext ...) - (dgettext "domain-name" ...) - (defer-gettext ...) - (interactive ...) - - The arguments given to this program are all the C and Lisp source files - of GNU Emacs. .el and .c files are allowed. There is no support for .elc - files at this time, but they may be specified; the corresponding .el file - will be used. Similarly, .o files can also be specified, and the corresponding - .c file will be used. This helps the makefile pass the correct list of files. - - The results, which go to standard output or to a file specified with -a or -o - (-a to append, -o to start from nothing), are quoted strings wrapped in - gettext(...). The results can be passed to xgettext to produce a .po message - file. -*/ - -#include -#include - -#define LINESIZE 256 -#define GET_LINE fgets (line, LINESIZE, infile) -#define CHECK_EOL(p) if (*(p) == '\0') (p) = GET_LINE -#define SKIP_BLANKS(p) while ((*p) == ' ' || (*p) == '\t') (p)++ - -enum filetype { C_FILE, LISP_FILE, INVALID_FILE }; -/* some brain-dead headers define this ... */ -#undef FALSE -#undef TRUE -enum boolean { FALSE, TRUE }; - -FILE *infile; -FILE *outfile; -char line[LINESIZE]; - - -void scan_file (char *filename); -void process_C_file (void); -void process_Lisp_file (void); -char *copy_up_to_paren (register char *p); -char *copy_quoted_string (register char *p); -enum boolean no_interactive_prompt (register char *q); -char *skip_blanks (register char *p); - - -main (int argc, char *argv[]) -{ - register int i; - - outfile = stdout; - - /* If first two args are -o FILE, output to FILE. */ - i = 1; - if (argc > i + 1 && strcmp (argv[i], "-o") == 0) { - outfile = fopen (argv[++i], "w"); - ++i; - } - /* ...Or if args are -a FILE, append to FILE. */ - if (argc > i + 1 && strcmp (argv[i], "-a") == 0) { - outfile = fopen (argv[++i], "a"); - ++i; - } - if (!outfile) { - fprintf (stderr, "Unable to open output file %s\n", argv[--i]); - return; - } - - for (; i < argc; i++) - scan_file (argv[i]); - - return 0; -} - - -void scan_file (char *filename) -{ - enum filetype type = INVALID_FILE; - register char *p = filename + strlen (filename); - - if (strcmp (p - 4, ".elc") == 0) { - *--p = '\0'; /* Use .el file instead */ - type = LISP_FILE; - } else if (strcmp (p - 3, ".el") == 0) - type = LISP_FILE; - else if (strcmp (p - 2, ".o") == 0) { - *--p = 'c'; /* Use .c file instead */ - type = C_FILE; - } else if (strcmp (p - 2, ".c") == 0) - type = C_FILE; - - if (type == INVALID_FILE) { - fprintf (stderr, "File %s being ignored\n", filename); - return; - } - infile = fopen (filename, "r"); - if (!infile) { - fprintf (stderr, "Unable to open input file %s\n", filename); - return; - } - - fprintf (outfile, "/* %s */\n", filename); - if (type == C_FILE) - process_C_file (); - else - process_Lisp_file (); - fputc ('\n', outfile); - - fclose (infile); -} - - -void process_C_file (void) -{ - register char *p; - char *gettext, *defun; - - while (p = GET_LINE) { - gettext = strstr (p, "GETTEXT"); - defun = strstr (p, "DEFUN"); - if (gettext || defun) { - if (gettext) { - p = gettext; - p += 7; /* Skip over "GETTEXT" */ - } - else if (defun) { - p = defun; - p += 5; /* Skip over "DEFUN" */ - } - - p = skip_blanks (p); - if (*p++ != '(') - continue; - - if (defun) { - register int i; - - for (i = 0; i < 5; i++) /* Skip over commas to doc string */ - while (*p++ != ',') - CHECK_EOL (p); - if (*p == '\n') - p = GET_LINE; - } - - p = skip_blanks (p); - if (*p != '\"') /* Make sure there is a quoted string */ - continue; - - if (defun && no_interactive_prompt (p)) - continue; - - fprintf (outfile, "gettext("); - if (gettext) - p = copy_up_to_paren (p); - else - p = copy_quoted_string (p); - fprintf (outfile, ")\n"); - } - } -} - - -void process_Lisp_file (void) -{ - register char *p; - char *gettext, *interactive; - enum boolean dgettext = FALSE; - - while (p = GET_LINE) { - gettext = strstr (p, "gettext"); - interactive = strstr (p, "(interactive"); - if (gettext || interactive) { - if (!interactive) - p = gettext; - else if (!gettext) - p = interactive; - else if (gettext < interactive) { - p = gettext; - interactive = NULL; - } else { - p = interactive; - gettext = NULL; - } - - if (gettext) { - if (p > line && *(p-1) == 'd') - dgettext = TRUE; - p += 7; /* Skip over "gettext" */ - } else - p += 12; /* Skip over "(interactive" */ - - p = skip_blanks (p); - if (*p != '\"') /* Make sure there is a quoted string */ - continue; - - if (dgettext) { /* Skip first quoted string (domain name) */ - while (*++p != '"') - ; /* null statement */ - ++p; - p = skip_blanks (p); - if (*p != '\"') /* Check for second quoted string (message) */ - continue; - } - - if (interactive && no_interactive_prompt (p)) - continue; - - fprintf (outfile, "gettext("); - p = copy_up_to_paren (p); - fprintf (outfile, ")\n"); - } - } -} - - -/* Assuming p points to some character beyond an opening parenthesis, copy - everything to outfile up to but not including the closing parenthesis. -*/ -char *copy_up_to_paren (register char *p) -{ - for (;;) { - SKIP_BLANKS (p); /* We don't call skip_blanks() in order to */ - CHECK_EOL (p); /* preserve blanks at the beginning of the line */ - if (*p == ')') - break; - - if (*p == '\"') - p = copy_quoted_string (p); - else - fputc (*p++, outfile); - } - return p; -} - - -/* Assuming p points to a quote character, copy the quoted string to outfile. -*/ -char *copy_quoted_string (register char *p) -{ - do { - if (*p == '\\') - fputc (*p++, outfile); - fputc (*p++, outfile); - CHECK_EOL (p); - } while (*p != '\"'); - - fputc (*p++, outfile); - return p; -} - - -/* Return TRUE if the interactive specification consists only - of code letters and no prompt. -*/ -enum boolean no_interactive_prompt (register char *q) -{ - while (++q, *q == '*' || *q == '@') - ; /* null statement */ - if (*q == '\"') - return TRUE; - skip_code_letter: - if (*++q == '\"') - return TRUE; - if (*q == '\\' && *++q == 'n') { - ++q; - goto skip_code_letter; - } - return FALSE; -} - - -char *skip_blanks (register char *p) -{ - while (*p == ' ' || *p == '\t' || *p == '\n') { - p++; - CHECK_EOL (p); - } - return p; -} diff --git a/lib-src/make-msgfile.lex b/lib-src/make-msgfile.lex deleted file mode 100644 index 21a050a..0000000 --- a/lib-src/make-msgfile.lex +++ /dev/null @@ -1,681 +0,0 @@ -%{ - -/* This is a Lex file. */ - -/* Localizable-message snarfing. - Copyright (C) 1994, 1995 Amdahl Corporation. - -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. */ - -/* Written by Ben Wing, November 1994. Some code based on earlier - make-msgfile.c. */ - -/* Note: there is still much work to be done on this. - - 1) Definition of Arg below won't handle a generalized argument - as might appear in a function call. This is fine for DEFUN - and friends, because only simple arguments appear there; but - it might run into problems if Arg is used for other sorts - of functions. - 2) snarf() should be modified so that it doesn't output null - strings and non-textual strings (see the comment at the top - of make-msgfile.c). - 3) parsing of (insert) should snarf all of the arguments. - 4) need to add set-keymap-prompt and deal with gettext of that. - 5) parsing of arguments should snarf all strings anywhere within - the arguments, rather than just looking for a string as the - argument. This allows if statements as arguments to get parsed. - 6) begin_paren_counting() et al. should handle recursive entry. - 7) handle set-window-buffer and other such functions that take - a buffer as the other-than-first argument. - 8) there is a fair amount of work to be done on the C code. - Look through the code for #### comments associated with - '#ifdef I18N3' or with an I18N3 nearby. - 9) Deal with `get-buffer-process' et al. - 10) Many of the changes in the Lisp code marked - 'rewritten for I18N3 snarfing' should be undone once (5) is - implemented. - 11) Go through the Lisp code in prim and make sure that all - strings are gettexted as necessary. This may reveal more - things to implement. - 12) Do the equivalent of (8) for the Lisp code. - 13) Deal with parsing of menu specifications. - - --ben - -*/ - -/* Long comment from jwz: - - (much of this comment is outdated, and a lot of it is actually - implemented) - - - PROPOSAL FOR HOW THIS ALL OUGHT TO WORK - this isn't implemented yet, but this is the plan-in-progress - - - In general, it's accepted that the best way to internationalize is for all - messages to be referred to by a symbolic name (or number) and come out of a - table or tables, which are easy to change. - - However, with Emacs, we've got the task of internationalizing a huge body - of existing code, which already contains messages internally. - - For the C code we've got two options: - - - Use a Sun-like gettext() form, which takes an "english" string which - appears literally in the source, and uses that as a hash key to find - a translated string; - - Rip all of the strings out and put them in a table. - - In this case, it's desirable to make as few changes as possible to the C - code, to make it easier to merge the code with the FSF version of emacs - which won't ever have these changes made to it. So we should go with the - former option. - - The way it has been done (between 19.8 and 19.9) was to use gettext(), but - *also* to make massive changes to the source code. The goal now is to use - gettext() at run-time and yet not require a textual change to every line - in the C code which contains a string constant. A possible way to do this - is described below. - - (gettext() can be implemented in terms of catgets() for non-Sun systems, so - that in itself isn't a problem.) - - For the Lisp code, we've got basically the same options: put everything in - a table, or translate things implicitly. - - Another kink that lisp code introduces is that there are thousands of third- - party packages, so changing the source for all of those is simply not an - option. - - Is it a goal that if some third party package displays a message which is - one we know how to translate, then we translate it? I think this is a - worthy goal. It remains to be seen how well it will work in practice. - - So, we should endeavor to minimize the impact on the lisp code. Certain - primitive lisp routines (the stuff in lisp/prim/, and especially in - cmdloop.el and minibuf.el) may need to be changed to know about translation, - but that's an ideologically clean thing to do because those are considered - a part of the emacs substrate. - - However, if we find ourselves wanting to make changes to, say, RMAIL, then - something has gone wrong. (Except to do things like remove assumptions - about the order of words within a sentence, or how pluralization works.) - - There are two parts to the task of displaying translated strings to the - user: the first is to extract the strings which need to be translated from - the sources; and the second is to make some call which will translate those - strings before they are presented to the user. - - The old way was to use the same form to do both, that is, GETTEXT() was both - the tag that we searched for to build a catalog, and was the form which did - the translation. The new plan is to separate these two things more: the - tags that we search for to build the catalog will be stuff that was in there - already, and the translation will get done in some more centralized, lower - level place. - - This program (make-msgfile.c) addresses the first part, extracting the - strings. - - For the emacs C code, we need to recognize the following patterns: - - message ("string" ... ) - error ("string") - report_file_error ("string" ... ) - signal_simple_error ("string" ... ) - signal_simple_error_2 ("string" ... ) - - build_translated_string ("string") - #### add this and use it instead of build_string() in some places. - - yes_or_no_p ("string" ... ) - #### add this instead of funcalling Qyes_or_no_p directly. - - barf_or_query_if_file_exists #### restructure this - check all callers of Fsignal #### restructure these - signal_error (Qerror ... ) #### change all of these to error() - - And we also parse out the `interactive' prompts from DEFUN() forms. - - #### When we've got a string which is a candidate for translation, we - should ignore it if it contains only format directives, that is, if - there are no alphabetic characters in it that are not a part of a `%' - directive. (Careful not to translate either "%s%s" or "%s: ".) - - For the emacs Lisp code, we need to recognize the following patterns: - - (message "string" ... ) - (error "string" ... ) - (format "string" ... ) - (read-from-minibuffer "string" ... ) - (read-shell-command "string" ... ) - (y-or-n-p "string" ... ) - (yes-or-no-p "string" ... ) - (read-file-name "string" ... ) - (temp-minibuffer-message "string") - (query-replace-read-args "string" ... ) - - I expect there will be a lot like the above; basically, any function which - is a commonly used wrapper around an eventual call to `message' or - `read-from-minibuffer' needs to be recognized by this program. - - - (dgettext "domain-name" "string") #### do we still need this? - - things that should probably be restructured: - `princ' in cmdloop.el - `insert' in debug.el - face-interactive - help.el, syntax.el all messed up - - BPW: (format) is a tricky case. If I use format to create a string - that I then send to a file, I probably don't want the string translated. - On the other hand, If the string gets used as an argument to (y-or-n-p) - or some such function, I do want it translated, and it needs to be - translated before the %s and such are replaced. The proper solution - here is for (format) and other functions that call gettext but don't - immediately output the string to the user to add the translated (and - formatted) string as a string property of the object, and have - functions that output potentially translated strings look for a - "translated string" property. Of course, this will fail if someone - does something like - - (y-or-n-p (concat (if you-p "Do you " "Does he ") - (format "want to delete %s? " filename)))) - - But you shouldn't be doing things like this anyway. - - BPW: Also, to avoid excessive translating, strings should be marked - as translated once they get translated, and further calls to gettext - don't do any more translating. Otherwise, a call like - - (y-or-n-p (format "Delete %s? " filename)) - - would cause translation on both the pre-formatted and post-formatted - strings, which could lead to weird results in some cases (y-or-n-p - has to translate its argument because someone could pass a string to - it directly). Note that the "translating too much" solution outlined - below could be implemented by just marking all strings that don't - come from a .el or .elc file as already translated. - - Menu descriptors: one way to extract the strings in menu labels would be - to teach this program about "^(defvar .*menu\n" forms; that's probably - kind of hard, though, so perhaps a better approach would be to make this - program recognize lines of the form - - "string" ... ;###translate - - where the magic token ";###translate" on a line means that the string - constant on this line should go into the message catalog. This is analagous - to the magic ";###autoload" comments, and to the magic comments used in the - EPSF structuring conventions. - - ----- - So this program manages to build up a catalog of strings to be translated. - To address the second part of the problem, of actually looking up the - translations, there are hooks in a small number of low level places in - emacs. - - Assume the existence of a C function gettext(str) which returns the - translation of `str' if there is one, otherwise returns `str'. - - - message() takes a char* as its argument, and always filters it through - gettext() before displaying it. - - - errors are printed by running the lisp function `display-error' which - doesn't call `message' directly (it princ's to streams), so it must be - carefully coded to translate its arguments. This is only a few lines - of code. - - - Fread_minibuffer_internal() is the lowest level interface to all minibuf - interactions, so it is responsible for translating the value that will go - into Vminibuf_prompt. - - - Fpopup_menu filters the menu titles through gettext(). - - The above take care of 99% of all messages the user ever sees. - - - The lisp function temp-minibuffer-message translates its arg. - - - query-replace-read-args is funny; it does - (setq from (read-from-minibuffer (format "%s: " string) ... )) - (setq to (read-from-minibuffer (format "%s %s with: " string from) ... )) - - What should we do about this? We could hack query-replace-read-args to - translate its args, but might this be a more general problem? I don't - think we ought to translate all calls to format. We could just change - the calling sequence, since this is odd in that the first %s wants to be - translated but the second doesn't. - - - Solving the "translating too much" problem: - The concern has been raised that in this situation: - - "Help" is a string for which we know a translation; - - someone visits a file called Help, and someone does something - contrived like (error buffer-file-name) - then we would display the translation of Help, which would not be correct. - We can solve this by adding a bit to Lisp_String objects which identifies - them as having been read as literal constants from a .el or .elc file (as - opposed to having been constructed at run time as it would in the above - case.) To solve this: - - - Fmessage() takes a lisp string as its first argument. - If that string is a constant, that is, was read from a source file - as a literal, then it calls message() with it, which translates. - Otherwise, it calls message_no_translate(), which does not translate. - - - Ferror() (actually, Fsignal() when condition is Qerror) works similarly. -*/ - -/* Some notes: - --- {Arg} below could get confused by commas inside of quotes. --- {LispToken} below can match some things that are not tokens (e.g. - numbers) but for all practical purposes it should be fine. -*/ - -#include - -int snarf_return_state; - -%} - -%p 6000 -%e 2000 -%n 1000 -%a 4000 -%s C_QUOTE C_COMMENT LQUO LCOM -%s CSNARF LSNARF -%s DO_C DO_LISP DEFUN -%s DEFUN2 DEFUN3 LDEF - -W [ \t\n] -Any (.|"\n") -Q "\"" -NQ [^"] -NT [^A-Za-z_0-9] -LP "(" -RP ")" -BS "\\" -Esc ({BS}{Any}) -Wh ({W}*) -LCom (";"({Esc}|.)*) -LWh (({W}|{Lcom})*) -Open ({Wh}{LP}) -OpWQ ({Open}{Wh}{Q}) -String ({Q}({Esc}|{NQ})*{Q}) -Arg ([^,]*",") -StringArg ({Wh}{String}{Wh}",") -OpenString ({Open}{StringArg}) -LispToken (({Esc}|[-A-Za-z0-9!@$%^&*_=+|{}`~,<.>/?])+) -%% - -{NT}"GETTEXT"{OpWQ} { snarf (); } -{NT}"DEFER_GETTEXT"{OpWQ} { snarf (); } -{NT}"build_translated_string"{OpWQ} { snarf (); } -{NT}"insert_string"{OpWQ} { snarf (); } -{NT}"message"{OpWQ} { snarf (); } -{NT}"warn_when_safe"{OpWQ} { snarf (); } -{NT}"error"{OpWQ} { snarf (); } -{NT}"continuable_error"{OpWQ} { snarf (); } -{NT}"signal_simple_error"{OpWQ} { snarf (); } -{NT}"signal_simple_error_2"{OpWQ} { snarf (); } -{NT}"signal_simple_continuable_error"{OpWQ} { snarf (); } -{NT}"signal_simple_continuable_error_2"{OpWQ} { snarf (); } -{NT}"report_file_error"{OpWQ} { snarf (); } -{NT}"signal_file_error"{OpWQ} { snarf (); } -{NT}"signal_double_file_error"{OpWQ} { snarf (); } -{NT}"signal_double_file_error_2"{OpWQ} { snarf (); } -{NT}"syntax_error"{OpWQ} { snarf (); } -{NT}"continuable_syntax_error"{OpWQ} { snarf (); } -{NT}"CTB_ERROR"{OpWQ} { snarf (); } -{NT}"fatal"{OpWQ} { snarf (); } -{NT}"stdout_out"{OpWQ} { snarf (); } -{NT}"stderr_out"{OpWQ} { snarf (); } -{NT}"with_output_to_temp_buffer"{OpWQ} { snarf (); } - -{NT}"DEFVAR_BOOL"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"DEFVAR_LISP"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"DEFVAR_SPECIFIER"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"DEFVAR_INT"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"DEFVAR_BUFFER_LOCAL"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"DEFVAR_BUFFER_DEFAULTS"{OpenString}{Arg}{Wh}{Q} { snarf (); } -{NT}"deferror"{Open}{Arg}{StringArg}{Wh}{Q} { snarf (); } - -{NT}"barf_or_query_if_file_exists"{Open}{Arg}{Wh}{Q} { - /* #### see comment above about use of Arg */ - snarf (); -} - -{NT}"DEFUN"{Open} { BEGIN DEFUN; } - -"/*" { - /* This is hateful, but doc strings are sometimes put inside of comments - (to get around limits in cpp), so we can't ignore stuff inside of - comments. */ - /* BEGIN C_COMMENT; */ -} -{Q} { BEGIN C_QUOTE; } -{Any} { } - -{StringArg}{Arg}{Arg}{Arg}{Arg}{Wh} { BEGIN DEFUN2; } -{Any} { bad_c_defun (); } - -{Q} { - /* We found an interactive specification. */ - snarf_return_state = DEFUN3; - snarf (); -} -[^,]* { - /* This function doesn't have an interactive specification. - Don't use {Arg} in the specification because DEFUN3 looks - for the comma. */ - BEGIN DEFUN3; -} - -{Wh}","{Wh}{Q} { - snarf_return_state = DO_C; - snarf (); -} -{Any} { bad_c_defun (); } - -{Esc} { } -{Q} { BEGIN DO_C; } -{Any} { } - -"*/" { BEGIN DO_C; } -{Any} { } - -{LP}{LWh}"gettext"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"purecopy"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"interactive"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"message"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"error"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"warn"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"format"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"substitute-command-keys"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"temp-minibuffer-message"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"momentary-string-display"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"princ"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"prin1"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"prin1-to-string"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"print"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"insert"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"insert-before-markers"{LWh}{Q} { inc_paren (); snarf (); } - -{LP}{LWh}"get-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"get-buffer-create"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"generate-new-buffer-name"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"rename-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"set-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"switch-to-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"pop-to-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"with-output-to-temp-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"buffer-enable-undo"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"buffer-disable-undo"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"get-buffer-window"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"delete-windows-on"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"replace-buffer-in-windows"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"display-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"other-buffer"{LWh}{Q} { inc_paren (); snarf (); } - -{LP}{LWh}"read-from-minibuffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-shell-command"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-file-name"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-buffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-variable"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-command"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-function"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-directory-name"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-string"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-number"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-minibuffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-quoted-char"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-face-name"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"read-itimer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"completing-read"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"y-or-n-p"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"yes-or-no-p"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"query-replace-read-args"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"eval-minibuffer"{LWh}{Q} { inc_paren (); snarf (); } -{LP}{LWh}"edit-and-eval-command"{LWh}{Q} { inc_paren (); snarf (); } - -{LP}{LWh}"defvar"{LWh}{LispToken}{LWh} { - inc_paren (); begin_paren_counting (LDEF); -} -{LP}{LWh}"defconst"{LWh}{LispToken}{LWh} { - inc_paren (); begin_paren_counting (LDEF); -} -{LP}{LWh}"defun"{LWh}{LispToken}{LWh} { - inc_paren (); begin_paren_counting (LDEF); -} -{LP}{LWh}"defmacro"{LWh}{LispToken}{LWh} { - inc_paren (); begin_paren_counting (LDEF); -} -{LP}{LWh}"defsubst"{LWh}{LispToken}{LWh} { - inc_paren (); begin_paren_counting (LDEF); -} - -{Q} { BEGIN LQUO; } -";" { BEGIN LCOM; } -{LP} { inc_paren (); } -{RP} { dec_paren (); } -{Esc} { } -{W} { lisp_whitespace (); } -{Any} { } - -{Esc} { } -{Q} { BEGIN DO_LISP; } -{Any} { } - -"\n" { BEGIN DO_LISP; } -{Any} { } - -{LWh}{Q} { snarf (); } -{Any} { BEGIN DO_LISP; } - -{Esc} { ECHO; } -{Q} { ECHO; fprintf (yyout, ")\n"); BEGIN snarf_return_state; } -{Any} { ECHO; } - -{Esc} { ECHO; } -"\n" { fprintf (yyout, "\\n\\\n"); } -{Q} { ECHO; fprintf (yyout, ")\n"); BEGIN snarf_return_state; } -{Any} { ECHO; } - -%% - -enum filetype { C_FILE, LISP_FILE, INVALID_FILE }; -/* some brain-dead headers define this ... */ -#undef FALSE -#undef TRUE -enum boolean { FALSE, TRUE }; - -void scan_file (char *filename); -void process_C_file (void); -void process_Lisp_file (void); - -int in_c; -int in_paren_counting, paren_count; -int paren_return_state; - -snarf () -{ - fprintf (yyout, "gettext(\""); - if (in_c) - BEGIN CSNARF; - else - BEGIN LSNARF; -} - -bad_c_defun () -{ - fprintf (stderr, "Warning: Invalid DEFUN encountered in C, line %d.\n", - yylineno); - snarf_return_state = DO_C; - BEGIN DO_C; - /* REJECT; Sun's lex is broken! Use Flex! */ -} - -bad_lisp_def () -{ - fprintf (stderr, - "Warning: Invalid defmumble encountered in Lisp, line %d.\n", - yylineno); - snarf_return_state = DO_LISP; - BEGIN DO_LISP; - /* REJECT; Sun's lex is broken! Use Flex! */ -} - -inc_paren () -{ - if (in_paren_counting) - paren_count++; -} - -dec_paren () -{ - if (in_paren_counting) - { - /* If we find a right paren without a matching left paren, it usually - just indicates a statement like - - (defvar foo-mumble nil) - - where 'nil' is the sexp we are skipping over, and there's no - doc string. */ - if (paren_count > 0) - paren_count--; - else - unput (')'); - if (paren_count == 0) - { - in_paren_counting = 0; - BEGIN paren_return_state; - } - } -} - -/* #### begin_paren_counting () does not handle recursive entries */ - -begin_paren_counting (int return_state) -{ - in_paren_counting = 1; - paren_count = 0; - paren_return_state = return_state; -} - -lisp_whitespace () -{ - if (in_paren_counting && !paren_count) - { - /* We got to the end of a token and we're not in a parenthesized - expression, so we're at the end of an sexp. */ - in_paren_counting = 0; - BEGIN paren_return_state; - } -} - -yywrap () -{ - return 1; -} - -main (int argc, char *argv[]) -{ - register int i; - - yyout = stdout; - - /* If first two args are -o FILE, output to FILE. */ - i = 1; - if (argc > i + 1 && strcmp (argv[i], "-o") == 0) { - yyout = fopen (argv[++i], "w"); - ++i; - } - /* ...Or if args are -a FILE, append to FILE. */ - if (argc > i + 1 && strcmp (argv[i], "-a") == 0) { - yyout = fopen (argv[++i], "a"); - ++i; - } - if (!yyout) { - fprintf (stderr, "Unable to open output file %s\n", argv[--i]); - return; - } - - for (; i < argc; i++) - scan_file (argv[i]); - - return 0; -} - - -void scan_file (char *filename) -{ - enum filetype type = INVALID_FILE; - register char *p = filename + strlen (filename); - - if (strcmp (p - 4, ".elc") == 0) { - *--p = '\0'; /* Use .el file instead */ - type = LISP_FILE; - } else if (strcmp (p - 3, ".el") == 0) - type = LISP_FILE; - else if (strcmp (p - 2, ".o") == 0) { - *--p = 'c'; /* Use .c file instead */ - type = C_FILE; - } else if (strcmp (p - 2, ".c") == 0) - type = C_FILE; - - if (type == INVALID_FILE) { - fprintf (stderr, "File %s being ignored\n", filename); - return; - } - yyin = fopen (filename, "r"); - if (!yyin) { - fprintf (stderr, "Unable to open input file %s\n", filename); - return; - } - - fprintf (yyout, "/* %s */\n", filename); - if (type == C_FILE) - process_C_file (); - else - process_Lisp_file (); - fputc ('\n', yyout); - - fclose (yyin); -} - -void process_C_file () -{ - snarf_return_state = DO_C; - in_c = 1; - BEGIN DO_C; - yylex (); -} - -void process_Lisp_file () -{ - snarf_return_state = DO_LISP; - in_c = 0; - BEGIN DO_LISP; - yylex (); -} - diff --git a/lib-src/make-path.c b/lib-src/make-path.c deleted file mode 100644 index b3de190..0000000 --- a/lib-src/make-path.c +++ /dev/null @@ -1,91 +0,0 @@ -/* Make all the directories along a path. - Copyright (C) 1992 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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.28. */ - -/* This program works like mkdir, except that it generates - intermediate directories if they don't exist. This is just like - the `mkdir -p' command on most systems; unfortunately, the mkdir - command on some of the purer BSD systems (like Mt. Xinu) don't have - that option. */ - -#ifdef emacs -#include <../src/config.h> -#endif - -#include -#include -#include -#include - -extern int errno; - -char *prog_name; - -static int touchy_mkdir (char *path) -{ - struct stat buf; - - /* If PATH already exists and is a directory, return success. */ - if (stat (path, &buf) >= 0 - && (buf.st_mode & S_IFMT) == S_IFDIR) - return 0; - - /* Otherwise, try to make it. If PATH exists but isn't a directory, - this will signal an error. */ - if (mkdir (path, 0777) < 0) - { - fprintf (stderr, "%s: ", prog_name); - perror (path); - return 1; - } - - return 0; -} - -int -main (int argc, char *argv[]) -{ - prog_name = *argv; - - for (argc--, argv++; argc > 0; argc--, argv++) - { - char *path = *argv; - int i; - - /* Stop at each slash in path and try to create the directory. - Skip any initial slash. */ - for (i = (path[0] == '/') ? 1 : 0; path[i]; i++) - if (path[i] == '/') - { - path[i] = '\0'; - if (touchy_mkdir (path) < 0) - goto next_pathname; - path[i] = '/'; - } - - touchy_mkdir (path); - - next_pathname: - ; - } - - return 0; -} diff --git a/lib-src/make-po.c b/lib-src/make-po.c deleted file mode 100644 index 3db1189..0000000 --- a/lib-src/make-po.c +++ /dev/null @@ -1,301 +0,0 @@ -/* Generate .po file from doc-string file. - - Scan specified doc-string file, creating .po format messages for processing - with msgfmt. The results go to standard output or to a file specified - with -a or -o (-a to append, -o to start from nothing). - - Kludge to make up for shortcoming in make-docfile and Snarf-documentation: - If arg before input filename is -p, we are scanning an add-on - package, which requires slightly different processing. -*/ - -#include -#include - -#ifndef EXIT_SUCCESS -#define EXIT_SUCCESS 0 -#define EXIT_FAILURE 1 -#endif - -/* #define BUFSIZE 8192 */ -#define BUFSIZE 16384 -#define NEWSTRING 31 /* Character signalling start of new doc string */ -#define LINEEND "\\n" -#define ENDSTRING "\"\n" -#define LINEBEGIN " \"" -#define LINEBREAK ENDSTRING LINEBEGIN - -/* some brain-dead headers define this ... */ -#undef FALSE -#undef TRUE -enum boolean { FALSE, TRUE }; - - -/***********************/ -/* buffer pseudo-class */ -/***********************/ - -typedef struct _buffer -{ - size_t index; /* current position in buf[] */ - size_t size; /* size of buf */ - char *buf; -} buffer_struct; - -#define BUF_NULL {0, 0, NULL} - -int buf_init (buffer_struct *buffer, size_t size); -void buf_free (buffer_struct *buffer); -void buf_clear (buffer_struct *buffer); -int buf_putc (buffer_struct *buffer, int c); -int buf_print (buffer_struct *buffer, const char *s); - - -/********************/ -/* global variables */ -/********************/ - -FILE *infile = NULL; -FILE *outfile = NULL; -buffer_struct buf = BUF_NULL; - - -void scan_file (enum boolean package); -void initialize (void); -void clean_exit (int status); -void buf_putc_safe (int c); -void buf_print_safe (const char *s); -void terminate_string (void); - -main (int argc, char *argv[]) -{ - register int i; - enum boolean package = FALSE; /* TRUE if scanning add-on package */ - - initialize (); - - outfile = stdout; - - /* If first two args are -o FILE, output to FILE. */ - i = 1; - if (argc > i + 1 && strcmp (argv[i], "-o") == 0) { - outfile = fopen (argv[++i], "w"); - ++i; - } - /* ...Or if args are -a FILE, append to FILE. */ - if (argc > i + 1 && strcmp (argv[i], "-a") == 0) { - outfile = fopen (argv[++i], "a"); - ++i; - } - if (!outfile) { - fprintf (stderr, "Unable to open output file %s\n", argv[--i]); - return 1; - } - - if (argc > i && !strcmp (argv[i], "-p")) { - package = TRUE; - ++i; - } - - infile = fopen (argv[i], "r"); - if (!infile) { - fprintf (stderr, "Unable to open input file %s\n", argv[i]); - return 1; - } - - scan_file (package); - clean_exit (EXIT_SUCCESS); -} - - -void scan_file (enum boolean package) -{ - register int c; /* Character read in */ - - fprintf (outfile, "###############\n"); - fprintf (outfile, "# DOC strings #\n"); - fprintf (outfile, "###############\n"); - - while (c = getc (infile), !feof (infile)) { - if (c == NEWSTRING) { - /* If a string was being processed, terminate it. */ - if (buf.index > 0) - terminate_string (); - - /* Skip function or variable name. */ - while (c != '\n') - c = getc (infile); - c = getc (infile); - - /* Begin a new string. */ - fprintf (outfile, "msgid \""); - buf_print_safe ("msgstr \""); - } - - if (c == '\n') { - /* Peek at next character. */ - c = getc (infile); - ungetc (c, infile); - - /* For add-on (i.e., non-preloaded) documentation, ignore the last - carriage return of a string. */ - if (!(package && c == NEWSTRING)) { - fprintf (outfile, LINEEND); - buf_print_safe (LINEEND); - } - - /* If not end of string, continue it on the next line. */ - if (c != NEWSTRING) { - fprintf (outfile, LINEBREAK); - buf_print_safe (LINEBREAK); - } - } - else { - - /* If character is \ or ", precede it by a backslash. */ - if (c == '\\' || c == '\"') { - putc ('\\', outfile); - buf_putc_safe ('\\'); - } - - putc (c, outfile); - buf_putc_safe (c); - } - } - terminate_string (); -} - - -/* initialize sets up the global variables. -*/ -void initialize (void) -{ - if (buf_init (&buf, BUFSIZE) != 0) - clean_exit (EXIT_FAILURE); -} - - -/* clean_exit returns any resources and terminates the program. - An error message is printed if status is EXIT_FAILURE. -*/ -void clean_exit (int status) -{ - if (buf.size > 0) - buf_free (&buf); - if (outfile) - fclose (outfile); - if (infile) - fclose (infile); - - if (status == EXIT_FAILURE) - fprintf (stderr, "make-po abnormally terminated\n"); - exit (status); -} - - -/* buf_putc_safe writes the character c on the global buffer buf, - checking to make sure that the operation was successful. -*/ -void buf_putc_safe (int c) -{ - register int status; - - status = buf_putc (&buf, c); - if (status == EOF) - clean_exit (EXIT_FAILURE); -} - - -/* buf_putc_safe writes the string s on the global buffer buf, - checking to make sure that the operation was successful. -*/ -void buf_print_safe (const char *s) -{ - register int status; - - status = buf_print (&buf, s); - if (status < 0) - clean_exit (EXIT_FAILURE); -} - - -/* terminate_string terminates the current doc string and outputs the buffer. -*/ -void terminate_string (void) - { - fprintf (outfile, ENDSTRING); - - /* Make the "translation" different from the original string. */ - buf_print_safe ("_X"); - - buf_print_safe (ENDSTRING); - fprintf (outfile, "%s", buf.buf); - buf_clear (&buf); - } - - -/*********************************/ -/* buffer pseudo-class functions */ -/*********************************/ - -/* buf_init initializes a buffer to the specified size. - It returns non-zero if the attempt fails. -*/ -int buf_init (buffer_struct *buffer, size_t size) -{ - buffer->buf = malloc (size); - if (buffer->buf == NULL) - return 1; - - buffer->size = size; - buf_clear (buffer); - return 0; -} - - -/* buf_free releases the memory allocated for the buffer. -*/ -void buf_free (buffer_struct *buffer) -{ - free (buffer->buf); - buffer->size = 0; -} - - -/* buf_clear resets a buffer to an empty string. -*/ -void buf_clear (buffer_struct *buffer) -{ - buffer->index = 0; - buffer->buf[0] = '\0'; -} - - -/* buf_putc writes the character c on the buffer. - It returns the character written, or EOF for error. -*/ -int buf_putc (buffer_struct *buffer, int c) -{ - if (buffer->index >= buffer->size) - return EOF; - - buffer->buf[buffer->index++] = c; - return c; -} - - -/* buf_print writes the string s on the buffer. - It returns the number of characters written, or negative if an error occurred. -*/ -int buf_print (buffer_struct *buffer, const char *s) -{ - register int len; - - len = strlen (s); - if (buffer->index + len >= buffer->size) - return -1; - - sprintf (&(buffer->buf[buffer->index]), s); - buffer->index += len; - return len; -} diff --git a/lib-src/mmencode.c b/lib-src/mmencode.c deleted file mode 100644 index 8ba79d4..0000000 --- a/lib-src/mmencode.c +++ /dev/null @@ -1,522 +0,0 @@ -/* -Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore) - -Permission to use, copy, modify, and distribute this material -for any purpose and without fee is hereby granted, provided -that the above copyright notice and this permission notice -appear in all copies, and that the name of Bellcore not be -used in advertising or publicity pertaining to this -material without the specific, prior written permission -of an authorized representative of Bellcore. BELLCORE -MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY -OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS", -WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. -*/ - -#define NEWLINE_CHAR '\n' -#include -#include -#include -#include - -static void -output64chunk(int c1, int c2, int c3, int pads, FILE *outfile); - -static signed char basis_64[] = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; - -static signed char index_64[128] = { - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,62, -1,-1,-1,63, - 52,53,54,55, 56,57,58,59, 60,61,-1,-1, -1,-1,-1,-1, - -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, - 15,16,17,18, 19,20,21,22, 23,24,25,-1, -1,-1,-1,-1, - -1,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, - 41,42,43,44, 45,46,47,48, 49,50,51,-1, -1,-1,-1,-1 -}; - -#define char64(c) (((c) < 0 || (c) > 127) ? -1 : index_64[(c)]) - -/* -char64(c) -char c; -{ - char *s = (char *) strchr(basis_64, c); - if (s) return(s-basis_64); - return(-1); -} -*/ - -/* the following gets a character, but fakes it properly into two chars if there's a newline character */ -static int InNewline=0; - -static int -nextcharin(infile, PortableNewlines) -FILE *infile; -int PortableNewlines; -{ - int c; - -#ifndef NEWLINE_CHAR - return(getc(infile)); -#else - if (!PortableNewlines) return(getc(infile)); - if (InNewline) { - InNewline = 0; - return(10); /* LF */ - } - c = getc(infile); - if (c == NEWLINE_CHAR) { - InNewline = 1; - return(13); /* CR */ - } - return(c); -#endif -} - -static void -to64(FILE *infile, FILE *outfile, int PortableNewlines) -{ - int c1, c2, c3, ct=0; - InNewline = 0; /* always reset it */ - while ((c1 = nextcharin(infile, PortableNewlines)) != EOF) { - c2 = nextcharin(infile, PortableNewlines); - if (c2 == EOF) { - output64chunk(c1, 0, 0, 2, outfile); - } else { - c3 = nextcharin(infile, PortableNewlines); - if (c3 == EOF) { - output64chunk(c1, c2, 0, 1, outfile); - } else { - output64chunk(c1, c2, c3, 0, outfile); - } - } - ct += 4; - if (ct > 71) { - putc('\n', outfile); - ct = 0; - } - } - if (ct) putc('\n', outfile); - fflush(outfile); -} - -static void -output64chunk(int c1, int c2, int c3, int pads, FILE *outfile) -{ - putc(basis_64[c1>>2], outfile); - putc(basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)], outfile); - if (pads == 2) { - putc('=', outfile); - putc('=', outfile); - } else if (pads) { - putc(basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)], outfile); - putc('=', outfile); - } else { - putc(basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)], outfile); - putc(basis_64[c3 & 0x3F], outfile); - } -} - -static int -PendingBoundary(char *s, char **Boundaries, int *BoundaryCt) -{ - int i, len; - - if (s[0] != '-' || s[1] != '-') return(0); - - - for (i=0; i < *BoundaryCt; ++i) { - len = strlen(Boundaries[i]); - if (!strncmp(s, Boundaries[i], len)) { - if (s[len] == '-' && s[len+1] == '-') *BoundaryCt = i; - return(1); - } - } - return(0); -} - -/* If we're in portable newline mode, we have to convert CRLF to the - local newline convention on output */ - -static int CRpending = 0; - -#ifdef NEWLINE_CHAR -static void -almostputc(int c, FILE *outfile, int PortableNewlines) -{ - if (CRpending) { - if (c == 10) { - putc(NEWLINE_CHAR, outfile); - CRpending = 0; - } else { - putc(13, outfile); - if (c != 13) { - putc(c, outfile); - CRpending = 0; - } - } - } else { - if (PortableNewlines && c == 13) { - CRpending = 1; - } else { - putc(c, outfile); - } - } -} -#else -static void -almostputc(int c, FILE *outfile, int PortableNewlines) -{ - putc(c, outfile); -} -#endif - -static void -from64(FILE *infile, FILE *outfile, - char **boundaries, int *boundaryct, int PortableNewlines) -{ - int c1, c2, c3, c4; - int newline = 1, DataDone = 0; - - /* always reinitialize */ - CRpending = 0; - while ((c1 = getc(infile)) != EOF) { - if (isspace(c1)) { - if (c1 == '\n') { - newline = 1; - } else { - newline = 0; - } - continue; - } - if (newline && boundaries && c1 == '-') { - char Buf[200]; - /* a dash is NOT base 64, so all bets are off if NOT a boundary */ - ungetc(c1, infile); - fgets(Buf, sizeof(Buf), infile); - if (boundaries - && (Buf[0] == '-') - && (Buf[1] == '-') - && PendingBoundary(Buf, boundaries, boundaryct)) { - return; - } - fprintf(stderr, "Ignoring unrecognized boundary line: %s\n", Buf); - continue; - } - if (DataDone) continue; - newline = 0; - do { - c2 = getc(infile); - } while (c2 != EOF && isspace(c2)); - do { - c3 = getc(infile); - } while (c3 != EOF && isspace(c3)); - do { - c4 = getc(infile); - } while (c4 != EOF && isspace(c4)); - if (c2 == EOF || c3 == EOF || c4 == EOF) { - fprintf(stderr, "Warning: base64 decoder saw premature EOF!\n"); - return; - } - if (c1 == '=' || c2 == '=') { - DataDone=1; - continue; - } - c1 = char64(c1); - c2 = char64(c2); - almostputc(((c1<<2) | ((c2&0x30)>>4)), outfile, PortableNewlines); - if (c3 == '=') { - DataDone = 1; - } else { - c3 = char64(c3); - almostputc((((c2&0XF) << 4) | ((c3&0x3C) >> 2)), outfile, PortableNewlines); - if (c4 == '=') { - DataDone = 1; - } else { - c4 = char64(c4); - almostputc((((c3&0x03) <<6) | c4), outfile, PortableNewlines); - } - } - } - if (CRpending) putc(13, outfile); /* Don't drop a lone trailing char 13 */ -} - -static signed char basis_hex[] = "0123456789ABCDEF"; -static signed char index_hex[128] = { - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1, -1,-1,-1,-1, - -1,10,11,12, 13,14,15,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,10,11,12, 13,14,15,-1, -1,-1,-1,-1, -1,-1,-1,-1, - -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1, -1,-1,-1,-1 -}; - -/* The following version generated complaints on Solaris. */ -/* #define hexchar(c) (((c) < 0 || (c) > 127) ? -1 : index_hex[(c)]) */ -/* Since we're no longer ever calling it with anything signed, this should work: */ -#define hexchar(c) (((c) > 127) ? -1 : index_hex[(c)]) - -/* -hexchar(c) -char c; -{ - char *s; - if (islower(c)) c = toupper(c); - s = (char *) strchr(basis_hex, c); - if (s) return(s-basis_hex); - return(-1); -} -*/ - -static void -toqp(FILE *infile, FILE *outfile) -{ - int c, ct=0, prevc=255; - while ((c = getc(infile)) != EOF) { - if ((c < 32 && (c != '\n' && c != '\t')) - || (c == '=') - || (c >= 127) - /* Following line is to avoid single periods alone on lines, - which messes up some dumb smtp implementations, sigh... */ - || (ct == 0 && c == '.')) { - putc('=', outfile); - putc(basis_hex[c>>4], outfile); - putc(basis_hex[c&0xF], outfile); - ct += 3; - prevc = 'A'; /* close enough */ - } else if (c == '\n') { - if (prevc == ' ' || prevc == '\t') { - putc('=', outfile); /* soft & hard lines */ - putc(c, outfile); - } - putc(c, outfile); - ct = 0; - prevc = c; - } else { - if (c == 'F' && prevc == '\n') { - /* HORRIBLE but clever hack suggested by MTR for sendmail-avoidance */ - c = getc(infile); - if (c == 'r') { - c = getc(infile); - if (c == 'o') { - c = getc(infile); - if (c == 'm') { - c = getc(infile); - if (c == ' ') { - /* This is the case we are looking for */ - fputs("=46rom", outfile); - ct += 6; - } else { - fputs("From", outfile); - ct += 4; - } - } else { - fputs("Fro", outfile); - ct += 3; - } - } else { - fputs("Fr", outfile); - ct += 2; - } - } else { - putc('F', outfile); - ++ct; - } - ungetc(c, infile); - prevc = 'x'; /* close enough -- printable */ - } else { /* END horrible hack */ - putc(c, outfile); - ++ct; - prevc = c; - } - } - if (ct > 72) { - putc('=', outfile); - putc('\n', outfile); - ct = 0; - prevc = '\n'; - } - } - if (ct) { - putc('=', outfile); - putc('\n', outfile); - } -} - -static void -fromqp(FILE *infile, FILE *outfile, char **boundaries, int *boundaryct) -{ - unsigned int c1, c2; - int sawnewline = 1, neednewline = 0; - /* The neednewline hack is necessary because the newline leading into - a multipart boundary is part of the boundary, not the data */ - - while ((c1 = getc(infile)) != EOF) { - if (sawnewline && boundaries && (c1 == '-')) { - char Buf[200]; - unsigned char *s; - - ungetc(c1, infile); - fgets(Buf, sizeof(Buf), infile); - if (boundaries - && (Buf[0] == '-') - && (Buf[1] == '-') - && PendingBoundary(Buf, boundaries, boundaryct)) { - return; - } - /* Not a boundary, now we must treat THIS line as q-p, sigh */ - if (neednewline) { - putc('\n', outfile); - neednewline = 0; - } - for (s=(unsigned char *) Buf; *s; ++s) { - if (*s == '=') { - if (!*++s) break; - if (*s == '\n') { - /* ignore it */ - sawnewline = 1; - } else { - c1 = hexchar(*s); - if (!*++s) break; - c2 = hexchar(*s); - putc(c1<<4 | c2, outfile); - } - } else { -#ifdef MSDOS - if (*s == '\n') - putc('\r', outfile); /* insert CR for binary-mode write */ -#endif - putc(*s, outfile); - } - } - } else { - if (neednewline) { - putc('\n', outfile); - neednewline = 0; - } - if (c1 == '=') { - sawnewline = 0; - c1 = getc(infile); - if (c1 == '\n') { - /* ignore it */ - sawnewline = 1; - } else { - c2 = getc(infile); - c1 = hexchar(c1); - c2 = hexchar(c2); - putc(c1<<4 | c2, outfile); - if (c2 == '\n') sawnewline = 1; - } - } else { - if (c1 == '\n') { - sawnewline = 1; - neednewline = 1; - } else { - sawnewline = 0; - putc(c1, outfile); - } - } - } - } - if (neednewline) { - putc('\n', outfile); - neednewline = 0; - } -} - - -/* -Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore) - -Permission to use, copy, modify, and distribute this material -for any purpose and without fee is hereby granted, provided -that the above copyright notice and this permission notice -appear in all copies, and that the name of Bellcore not be -used in advertising or publicity pertaining to this -material without the specific, prior written permission -of an authorized representative of Bellcore. BELLCORE -MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY -OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS", -WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. -*/ -#ifdef MSDOS -#include -#endif - -#define BASE64 1 -#define QP 2 /* quoted-printable */ - -int main(int argc, char *argv[]) -{ - int encode = 1, which = BASE64, i, portablenewlines = 0; - FILE *fp = stdin; - FILE *fpo = stdout; - - for (i=1; i= argc) { - fprintf(stderr, "mimencode: -o requires a file name.\n"); - exit(-1); - } - fpo = fopen(argv[i], "w"); - if (!fpo) { - perror(argv[i]); - exit(-1); - } - break; - case 'u': - encode = 0; - break; - case 'q': - which = QP; - break; - case 'p': - portablenewlines = 1; - break; - case 'b': - which = BASE64; - break; - default: - fprintf(stderr, - "Usage: mmencode [-u] [-q] [-b] [-p] [-o outputfile] [file name]\n"); - exit(-1); - } - } else { -#ifdef MSDOS - if (encode) - fp = fopen(argv[i], "rb"); - else - { - fp = fopen(argv[i], "rt"); - setmode(fileno(fpo), O_BINARY); - } /* else */ -#else - fp = fopen(argv[i], "r"); -#endif /* MSDOS */ - if (!fp) { - perror(argv[i]); - exit(-1); - } - } - } -#ifdef MSDOS - if (fp == stdin) setmode(fileno(fp), O_BINARY); -#endif /* MSDOS */ - if (which == BASE64) { - if (encode) { - to64(fp, fpo, portablenewlines); - } else { - from64(fp,fpo, (char **) NULL, (int *) 0, portablenewlines); - } - } else { - if (encode) toqp(fp, fpo); else fromqp(fp, fpo, NULL, 0); - } - return(0); -} - diff --git a/lib-src/movemail.c b/lib-src/movemail.c deleted file mode 100644 index 7a91c6e..0000000 --- a/lib-src/movemail.c +++ /dev/null @@ -1,893 +0,0 @@ -/* movemail foo bar -- move file foo to file bar, - locking file foo the way /bin/mail respects. - Copyright (C) 1986, 1992, 1993, 1994, 1996 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. */ - -/* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will - cause loss of mail* if you do it on a system that does not normally - use flock as its way of interlocking access to inbox files. The - setting of MAIL_USE_FLOCK and MAIL_USE_LOCKF *must agree* with the - system's own conventions. It is not a choice that is up to you. - - So, if your system uses lock files rather than flock, then the only way - you can get proper operation is to enable movemail to write lockfiles there. - This means you must either give that directory access modes - that permit everyone to write lockfiles in it, or you must make movemail - a setuid or setgid program. */ - -/* - * Modified January, 1986 by Michael R. Gretzinger (Project Athena) - * - * Added POP (Post Office Protocol) service. When compiled -DMAIL_USE_POP - * movemail will accept input filename arguments of the form - * "po:username". This will cause movemail to open a connection to - * a pop server running on $MAILHOST (environment variable). Movemail - * must be setuid to root in order to work with POP. - * - * New module: popmail.c - * Modified routines: - * main - added code within #ifdef MAIL_USE_POP; added setuid (getuid ()) - * after POP code. - * New routines in movemail.c: - * get_errmsg - return pointer to system error message - * - * Modified August, 1993 by Jonathan Kamens (OpenVision Technologies) - * - * Move all of the POP code into a separate file, "pop.c". - * Use strerror instead of get_errmsg. - * - */ - -#define NO_SHORTNAMES /* Tell config not to load remap.h */ -#define DONT_ENCAPSULATE -#include <../src/config.h> -#include -#include -#include -#include -#include -#include "../src/sysfile.h" -#include "../src/syswait.h" -#ifndef WINDOWSNT -#include "../src/systime.h" -#endif -#include -#include -#include "getopt.h" -#ifdef MAIL_USE_POP -#include "pop.h" -#include "../src/regex.h" -#endif - -extern char *optarg; -extern int optind, opterr; - -#ifndef HAVE_STRERROR -char * strerror (int errnum); -#endif /* HAVE_STRERROR */ - -#ifdef MSDOS -#undef access -#endif /* MSDOS */ - -#ifndef DIRECTORY_SEP -#define DIRECTORY_SEP '/' -#endif -#ifndef IS_DIRECTORY_SEP -#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) -#endif - -#ifdef WINDOWSNT -#undef access -#undef unlink -#define fork() 0 -#define sys_wait(var) (*(var) = 0) -/* Unfortunately, Samba doesn't seem to properly lock Unix files even - though the locking call succeeds (and indeed blocks local access from - other NT programs). If you have direct file access using an NFS - client or something other than Samba, the locking call might work - properly - make sure it does before you enable this! */ -#define DISABLE_DIRECT_ACCESS -#include -#endif /* WINDOWSNT */ - -#if defined (HAVE_UNISTD_H) || defined (USG) -#include -#endif /* unistd.h */ -#ifndef F_OK -#define F_OK 0 -#define X_OK 1 -#define W_OK 2 -#define R_OK 4 -#endif /* No F_OK */ - -#if defined (HAVE_FCNTL_H) || defined (USG) -#include -#endif /* fcntl.h */ - -#if defined (XENIX) || defined (WINDOWSNT) -#include -#endif - -#ifdef MAIL_USE_LOCKF -#define MAIL_USE_SYSTEM_LOCK -#endif - -#ifdef MAIL_USE_FLOCK -#define MAIL_USE_SYSTEM_LOCK -#endif - -#ifdef MAIL_USE_MMDF -extern int lk_open (), lk_close (); -#endif - -/* Cancel substitutions made by config.h for Emacs. */ -#undef open -#undef read -#undef write -#undef close - -static void fatal (char *, char*); -static void error (char *, char *, char *); -static void pfatal_with_name (char *); -static void pfatal_and_delete (char *); -static char *concat (char *, char *, char *); -static long *xmalloc (unsigned int); -#ifdef MAIL_USE_POP -static int popmail (char *, char *, char *); -static int pop_retr (popserver server, int msgno, int (*action)(), void *arg); -static int mbx_write (char *, FILE *); -static int mbx_delimit_begin (FILE *); -static int mbx_delimit_end (FILE *); -static struct re_pattern_buffer* compile_regex (char* regexp_pattern); -static int pop_search_top (popserver server, int msgno, int lines, - struct re_pattern_buffer* regexp); -#endif - -/* Nonzero means this is name of a lock file to delete on fatal error. */ -char *delete_lockname; - -int verbose=0; -#ifdef MAIL_USE_POP -int reverse=0; -int keep_messages=0; -struct re_pattern_buffer* regexp_pattern=0; -int match_lines=10; -#endif - -#define VERBOSE(x) if (verbose) { printf x; fflush(stdout); } - -struct option longopts[] = -{ - { "inbox", required_argument, NULL, 'i' }, - { "outfile", required_argument, NULL, 'o' }, -#ifdef MAIL_USE_POP - { "password", required_argument, NULL, 'p' }, - { "reverse-pop-order", no_argument, NULL, 'x' }, - { "keep-messages", no_argument, NULL, 'k' }, - { "regex", required_argument, NULL, 'r' }, - { "match-lines", required_argument, NULL, 'l' }, -#endif - { "verbose", no_argument, NULL, 'v' }, - { 0 } -}; - -int -main (int argc, char *argv[]) -{ - char *inname=0, *outname=0, *poppass=0; -#ifndef DISABLE_DIRECT_ACCESS - int indesc, outdesc; - int nread; - int status; -#endif - -#ifndef MAIL_USE_SYSTEM_LOCK - struct stat st; - long now; - int tem; - char *lockname, *p; - char *tempname; - int desc; -#endif /* not MAIL_USE_SYSTEM_LOCK */ - - delete_lockname = 0; - - while (1) - { -#ifdef MAIL_USE_POP - char* optstring = "i:o:p:l:r:xvk"; -#else - char* optstring = "i:o:v"; -#endif - int opt = getopt_long (argc, argv, optstring, longopts, 0); - - if (opt == EOF) - break; - - switch (opt) - { - case 0: - break; - case 1: /* one of the standard arguments seen */ - if (!inname) - inname = optarg; - else if (!outname) - outname = optarg; - else - poppass = optarg; - break; - - case 'i': /* infile */ - inname = optarg; - break; - - case 'o': /* outfile */ - outname = optarg; - break; -#ifdef MAIL_USE_POP - case 'p': /* pop password */ - poppass = optarg; - break; - case 'k': keep_messages=1; break; - case 'x': reverse = 1; break; - case 'l': /* lines to match */ - match_lines = atoi (optarg); - break; - - case 'r': /* regular expression */ - regexp_pattern = compile_regex (optarg); - break; -#endif - case 'v': verbose = 1; break; - } - } - - while (optind < argc) - { - if (!inname) - inname = argv[optind]; - else if (!outname) - outname = argv[optind]; - else - poppass = argv[optind]; - optind++; - } - - if (!inname || !outname) - { - fprintf (stderr, "Usage: movemail [-rvxk] [-l lines ] [-i] inbox [-o] destfile [[-p] POP-password]\n"); - exit(1); - } - -#ifdef MAIL_USE_MMDF - mmdf_init (argv[0]); -#endif - - if (*outname == 0) - fatal ("Destination file name is empty", 0); - - /* Check access to output file. */ - if (access (outname, F_OK) == 0 && access (outname, W_OK) != 0) - pfatal_with_name (outname); - - /* Also check that outname's directory is writable to the real uid. */ - { - char *buf = (char *) xmalloc (strlen (outname) + 1); - char *cp; - strcpy (buf, outname); - cp = buf + strlen (buf); - while (cp > buf && !IS_DIRECTORY_SEP (cp[-1])) - *--cp = 0; - if (cp == buf) - *cp++ = '.'; - if (access (buf, W_OK) != 0) - pfatal_with_name (buf); - free (buf); - } - -#ifdef MAIL_USE_POP - if (!strncmp (inname, "po:", 3)) - { - int retcode = popmail (inname + 3, outname, poppass); - exit (retcode); - } - -#ifndef WINDOWSNT - setuid (getuid ()); -#endif -#endif /* MAIL_USE_POP */ - -#ifndef DISABLE_DIRECT_ACCESS - - /* Check access to input file. */ - if (access (inname, R_OK | W_OK) != 0) - pfatal_with_name (inname); - -#ifndef MAIL_USE_MMDF -#ifndef MAIL_USE_SYSTEM_LOCK - /* Use a lock file named after our first argument with .lock appended: - If it exists, the mail file is locked. */ - /* Note: this locking mechanism is *required* by the mailer - (on systems which use it) to prevent loss of mail. - - On systems that use a lock file, extracting the mail without locking - WILL occasionally cause loss of mail due to timing errors! - - So, if creation of the lock file fails - due to access permission on the mail spool directory, - you simply MUST change the permission - and/or make movemail a setgid program - so it can create lock files properly. - - You might also wish to verify that your system is one - which uses lock files for this purpose. Some systems use other methods. - - If your system uses the `flock' system call for mail locking, - define MAIL_USE_SYSTEM_LOCK in config.h or the s-*.h file - and recompile movemail. If the s- file for your system - should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report - to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */ - - lockname = concat (inname, ".lock", ""); - tempname = (char *) xmalloc (strlen (inname) + strlen ("EXXXXXX") + 1); - strcpy (tempname, inname); - p = tempname + strlen (tempname); - while (p != tempname && !IS_DIRECTORY_SEP (p[-1])) - p--; - *p = 0; - strcpy (p, "EXXXXXX"); - mktemp (tempname); - unlink (tempname); - - while (1) - { - /* Create the lock file, but not under the lock file name. */ - /* Give up if cannot do that. */ - desc = open (tempname, O_WRONLY | O_CREAT | O_EXCL, 0666); - if (desc < 0) - { - char *message = (char *) xmalloc (strlen (tempname) + 50); - sprintf (message, "%s--see source file lib-src/movemail.c", - tempname); - pfatal_with_name (message); - } - close (desc); - - tem = link (tempname, lockname); - unlink (tempname); - if (tem >= 0) - break; - sleep (1); - - /* If lock file is five minutes old, unlock it. - Five minutes should be good enough to cope with crashes - and wedgitude, and long enough to avoid being fooled - by time differences between machines. */ - if (stat (lockname, &st) >= 0) - { - now = time (0); - if (st.st_ctime < now - 300) - unlink (lockname); - } - } - - delete_lockname = lockname; -#endif /* not MAIL_USE_SYSTEM_LOCK */ -#endif /* not MAIL_USE_MMDF */ - - if (fork () == 0) - { - setuid (getuid ()); - -#ifndef MAIL_USE_MMDF -#ifdef MAIL_USE_SYSTEM_LOCK - indesc = open (inname, O_RDWR); -#else /* if not MAIL_USE_SYSTEM_LOCK */ - indesc = open (inname, O_RDONLY); -#endif /* not MAIL_USE_SYSTEM_LOCK */ -#else /* MAIL_USE_MMDF */ - indesc = lk_open (inname, O_RDONLY, 0, 0, 10); -#endif /* MAIL_USE_MMDF */ - - if (indesc < 0) - pfatal_with_name (inname); - -#if defined (BSD) || defined (XENIX) - /* In case movemail is setuid to root, make sure the user can - read the output file. */ - /* This is desirable for all systems - but I don't want to assume all have the umask system call */ - umask (umask (0) & 0333); -#endif /* BSD or Xenix */ - outdesc = open (outname, O_WRONLY | O_CREAT | O_EXCL, 0666); - if (outdesc < 0) - pfatal_with_name (outname); -#ifdef MAIL_USE_SYSTEM_LOCK -#ifdef MAIL_USE_LOCKF - if (lockf (indesc, F_LOCK, 0) < 0) pfatal_with_name (inname); -#else /* not MAIL_USE_LOCKF */ -#ifdef XENIX - if (locking (indesc, LK_RLCK, 0L) < 0) pfatal_with_name (inname); -#else -#ifdef WINDOWSNT - if (locking (indesc, LK_RLCK, -1L) < 0) pfatal_with_name (inname); -#else - if (flock (indesc, LOCK_EX) < 0) pfatal_with_name (inname); -#endif -#endif -#endif /* not MAIL_USE_LOCKF */ -#endif /* MAIL_USE_SYSTEM_LOCK */ - - { - char buf[1024]; - - while (1) - { - nread = read (indesc, buf, sizeof buf); - if (nread != write (outdesc, buf, nread)) - { - int saved_errno = errno; - unlink (outname); - errno = saved_errno; - pfatal_with_name (outname); - } - if (nread < sizeof buf) - break; - } - } - -#ifdef BSD - if (fsync (outdesc) < 0) - pfatal_and_delete (outname); -#endif - - /* Check to make sure no errors before we zap the inbox. */ - if (close (outdesc) != 0) - pfatal_and_delete (outname); - -#ifdef MAIL_USE_SYSTEM_LOCK -#if defined (STRIDE) || defined (XENIX) || defined (WINDOWSNT) - /* Stride, xenix have file locking, but no ftruncate. This mess will do. */ - close (open (inname, O_CREAT | O_TRUNC | O_RDWR, 0666)); -#else - ftruncate (indesc, 0L); -#endif /* STRIDE or XENIX */ -#endif /* MAIL_USE_SYSTEM_LOCK */ - -#ifdef MAIL_USE_MMDF - lk_close (indesc, 0, 0, 0); -#else - close (indesc); -#endif - -#ifndef MAIL_USE_SYSTEM_LOCK - /* Delete the input file; if we can't, at least get rid of its - contents. */ -#ifdef MAIL_UNLINK_SPOOL - /* This is generally bad to do, because it destroys the permissions - that were set on the file. Better to just empty the file. */ - if (unlink (inname) < 0 && errno != ENOENT) -#endif /* MAIL_UNLINK_SPOOL */ - creat (inname, 0600); -#endif /* not MAIL_USE_SYSTEM_LOCK */ - - exit (0); - } - - wait (&status); - if (!WIFEXITED (status)) - exit (1); - else if (WEXITSTATUS (status) != 0) - exit (WEXITSTATUS (status)); - -#if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK) - unlink (lockname); -#endif /* not MAIL_USE_MMDF and not MAIL_USE_SYSTEM_LOCK */ - -#endif /* ! DISABLE_DIRECT_ACCESS */ - - return 0; -} - -/* Print error message and exit. */ - -static void -fatal (char *s1, char *s2) -{ - if (delete_lockname) - unlink (delete_lockname); - error (s1, s2, NULL); - exit (1); -} - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ - -static void -error (char *s1, char *s2, char *s3) -{ - fprintf (stderr, "movemail: "); - fprintf (stderr, s1, s2, s3); - fprintf (stderr, "\n"); -} - -static void -pfatal_with_name (char *name) -{ - char *s = concat ("", strerror (errno), " for %s"); - fatal (s, name); -} - -static void -pfatal_and_delete (char *name) -{ - char *s = concat ("", strerror (errno), " for %s"); - unlink (name); - fatal (s, name); -} - -/* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ - -static char * -concat (char *s1, char *s2, char *s3) -{ - int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = (char *) xmalloc (len1 + len2 + len3 + 1); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - *(result + len1 + len2 + len3) = 0; - - return result; -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -static long * -xmalloc (unsigned int size) -{ - long *result = (long *) malloc (size); - if (!result) - fatal ("virtual memory exhausted", 0); - return result; -} - -/* This is the guts of the interface to the Post Office Protocol. */ - -#ifdef MAIL_USE_POP - -#ifndef WINDOWSNT -#include -#include -#include -#else -#undef _WINSOCKAPI_ -#include -#endif -#include -#include - -#define POP_ERROR (-1) -#define POP_RETRIEVED (0) -#define POP_DONE (1) - -char *progname; -FILE *sfi; -FILE *sfo; -char ibuffer[BUFSIZ]; -char obuffer[BUFSIZ]; -char Errmsg[80]; - -static int -popmail (char *user, char *outfile, char *password) -{ - int nmsgs, nbytes; - register int i, idx; - int mbfi; - short* retrieved_list; - FILE *mbf; - popserver server; - - VERBOSE(("opening server\r")); - server = pop_open (0, user, password, POP_NO_GETPASS); - if (! server) - { - error (pop_error, NULL, NULL); - return (1); - } - - VERBOSE(("stat'ing messages\r")); - if (pop_stat (server, &nmsgs, &nbytes)) - { - error (pop_error, NULL, NULL); - return (1); - } - - if (!nmsgs) - { - VERBOSE(("closing server\n")); - pop_close (server); - return (0); - } - - /* build a retrieved table */ - retrieved_list = (short*) xmalloc (sizeof (short) * (nmsgs+1)); - memset (retrieved_list, 0, sizeof (short) * (nmsgs+1)); - - mbfi = open (outfile, O_WRONLY | O_CREAT | O_EXCL, 0666); - if (mbfi < 0) - { - pop_close (server); - error ("Error in open: %s, %s", strerror (errno), outfile); - return (1); - } -#if !defined(__CYGWIN32__) && !defined(WINDOWSNT) - fchown (mbfi, getuid (), -1); -#endif - - if ((mbf = fdopen (mbfi, "wb")) == NULL) - { - pop_close (server); - error ("Error in fdopen: %s", strerror (errno), NULL); - close (mbfi); - unlink (outfile); - return (1); - } - - for (idx = 0; idx < nmsgs; idx++) - { - i = reverse ? nmsgs - idx : idx + 1; - VERBOSE(("checking message %d \r", i)); - - if (!regexp_pattern - || - pop_search_top (server, i, match_lines, regexp_pattern) == POP_RETRIEVED) - { - VERBOSE(("retrieving message %d \r", i)); - mbx_delimit_begin (mbf); - if (pop_retr (server, i, mbx_write, mbf) != POP_RETRIEVED) - { - error (Errmsg, NULL, NULL); - close (mbfi); - return (1); - } - - retrieved_list[i]=1; - - mbx_delimit_end (mbf); - fflush (mbf); - if (ferror (mbf)) - { - error ("Error in fflush: %s", strerror (errno), NULL); - pop_close (server); - close (mbfi); - return (1); - } - } - } - - /* On AFS, a call to write only modifies the file in the local - * workstation's AFS cache. The changes are not written to the server - * until a call to fsync or close is made. Users with AFS home - * directories have lost mail when over quota because these checks were - * not made in previous versions of movemail. */ - -#ifdef BSD - if (fsync (mbfi) < 0) - { - error ("Error in fsync: %s", strerror (errno), NULL); - return (1); - } -#endif - - if (close (mbfi) == -1) - { - error ("Error in close: %s", strerror (errno), NULL); - return (1); - } - - if (!keep_messages) - { - for (i = 1; i <= nmsgs; i++) - { - if (retrieved_list[i] == 1) - { - VERBOSE(("deleting message %d \r", i)); - if (pop_delete (server, i)) - { - error (pop_error, NULL, NULL); - pop_close (server); - return (1); - } - } - } - } - - VERBOSE(("closing server \n")); - if (pop_quit (server)) - { - error (pop_error, NULL, NULL); - return (1); - } - - return (0); -} - -static int -pop_retr (popserver server, int msgno, int (*action)(), void *arg) -{ - char *line; - int ret; - - if (pop_retrieve_first (server, msgno, &line)) - { - strncpy (Errmsg, pop_error, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - return (POP_ERROR); - } - - while (! (ret = pop_retrieve_next (server, &line))) - { - if (! line) - break; - - if ((*action)(line, arg) != POP_RETRIEVED) - { - strcpy (Errmsg, strerror (errno)); - pop_close (server); - return (POP_ERROR); - } - } - - if (ret) - { - strncpy (Errmsg, pop_error, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - return (POP_ERROR); - } - - return (POP_RETRIEVED); -} - -/* search the top lines of each message looking for a match */ -static int -pop_search_top (popserver server, int msgno, int lines, struct re_pattern_buffer* regexp) -{ - char *line; - int ret; - int match = POP_DONE; - - if (pop_top_first (server, msgno, lines, &line)) - { - strncpy (Errmsg, pop_error, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - return (POP_ERROR); - } - - while (! (ret = pop_top_next (server, &line))) - { - if (! line) - break; - - /* VERBOSE (("checking %s\n", line));*/ - if (match != POP_RETRIEVED) - { - if ((ret = re_match (regexp, line, strlen (line), 0, 0)) == -2 ) - { - strcpy (Errmsg, "error in regular expression"); - pop_close (server); - return (POP_ERROR); - } - else if (ret >=0) - { - match = POP_RETRIEVED; - } - } - } - - if (ret) - { - strncpy (Errmsg, pop_error, sizeof (Errmsg)); - Errmsg[sizeof (Errmsg)-1] = '\0'; - return (POP_ERROR); - } - - return match; -} - -/* Do this as a macro instead of using strcmp to save on execution time. */ -#define IS_FROM_LINE(a) ((a[0] == 'F') \ - && (a[1] == 'r') \ - && (a[2] == 'o') \ - && (a[3] == 'm') \ - && (a[4] == ' ')) - -static int -mbx_write (char *line, FILE *mbf) -{ - if (IS_FROM_LINE (line)) - { - if (fputc ('>', mbf) == EOF) - return (POP_ERROR); - } - if (fputs (line, mbf) == EOF) - return (POP_ERROR); - if (fputc (0x0a, mbf) == EOF) - return (POP_ERROR); - return (POP_RETRIEVED); -} - -static int -mbx_delimit_begin (FILE *mbf) -{ - if (fputs ("\f\n0, unseen,,\n", mbf) == EOF) - return (POP_ERROR); - return (POP_RETRIEVED); -} - -static int -mbx_delimit_end (FILE *mbf) -{ - if (putc ('\037', mbf) == EOF) - return (POP_ERROR); - return (POP_RETRIEVED); -} - -/* Turn a name, which is an ed-style (but Emacs syntax) regular - expression, into a real regular expression by compiling it. */ -static struct re_pattern_buffer* -compile_regex (char* pattern) -{ - char *err; - struct re_pattern_buffer *patbuf=0; - - patbuf = (struct re_pattern_buffer*) xmalloc (sizeof (struct re_pattern_buffer)); - patbuf->translate = NULL; - patbuf->fastmap = NULL; - patbuf->buffer = NULL; - patbuf->allocated = 0; - - err = (char*) re_compile_pattern (pattern, strlen (pattern), patbuf); - if (err != NULL) - { - error ("%s while compiling pattern", err, NULL); - return 0; - } - - return patbuf; -} - - - -#endif /* MAIL_USE_POP */ - -#ifndef HAVE_STRERROR -char * -strerror (int errnum) -{ - extern char *sys_errlist[]; - extern int sys_nerr; - - if (errnum >= 0 && errnum < sys_nerr) - return sys_errlist[errnum]; - return (char *) "Unknown error"; -} - -#endif /* ! HAVE_STRERROR */ diff --git a/lib-src/ootags.c b/lib-src/ootags.c deleted file mode 100644 index 8a9d0c3..0000000 --- a/lib-src/ootags.c +++ /dev/null @@ -1,5432 +0,0 @@ -/* Tags file maker to go with GNU Emacs - Copyright (C) 1984, 87, 88, 89, 93, 94, 95 - Free Software Foundation, Inc. and Ken Arnold - -This file is not considered part of GNU Emacs. - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software Foundation, -Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - -/* - * Authors: - * Ctags originally by Ken Arnold. - * Fortran added by Jim Kleckner. - * Ed Pelegri-Llopart added C typedefs. - * Gnu Emacs TAGS format and modifications by RMS? - * Sam Kendall added C++. - * Francesco Potorti` reorganised C and C++ based on work by Joe Wells. - * Regexp tags by Tom Tromey. - * - * Francesco Potorti` (F.Potorti@cnuce.cnr.it) is the current maintainer. - */ - -char pot_etags_version[] = "@(#) pot revision number is 12.28"; - -/* Prototyping magic snarfed from gmalloc.c */ -#if defined (__cplusplus) || defined (__STDC__) -#undef PP -#define PP(args) args -#undef __ptr_t -#define __ptr_t void * -#else /* Not C++ or ANSI C. */ -#undef PP -#define PP(args) () -#undef const -#define const -#undef __ptr_t -#define __ptr_t char * -#endif /* C++ or ANSI C. */ - -#ifdef HAVE_CONFIG_H -# include - /* On some systems, Emacs defines static as nothing for the sake - of unexec. We don't want that here since we don't use unexec. */ -# undef static -# define ETAGS_REGEXPS /* use the regexp features */ -# define LONG_OPTIONS /* accept long options */ -#endif /* HAVE_CONFIG_H */ - -#define TRUE 1 -#define FALSE 0 - -#ifndef DEBUG -# define DEBUG FALSE -#endif - -#ifdef MSDOS -# include -# include -# include -# ifndef HAVE_CONFIG_H -# define DOS_NT -# include -# endif -#endif /* MSDOS */ - -#ifdef WINDOWSNT -# include -# include -# include -# include -# define MAXPATHLEN _MAX_PATH -# ifdef HAVE_CONFIG_H -# undef HAVE_NTGUI -# else -# define DOS_NT -# define HAVE_GETCWD -# endif /* not HAVE_CONFIG_H */ -#endif /* WINDOWSNT */ - -#if !defined (WINDOWSNT) && defined (STDC_HEADERS) -#include -#include -#endif - -#ifdef HAVE_UNISTD_H -# include -#else -# ifdef HAVE_GETCWD - extern char *getcwd (); -# endif -#endif /* HAVE_UNISTD_H */ - -#include -#include -#include -#ifndef errno - extern int errno; -#endif -#include -#include - -#if !defined (S_ISREG) && defined (S_IFREG) -# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -#endif - -#ifdef LONG_OPTIONS -# include -#else -# define getopt_long(argc,argv,optstr,lopts,lind) getopt (argc, argv, optstr) - extern char *optarg; - extern int optind, opterr; -#endif /* LONG_OPTIONS */ - -#ifdef ETAGS_REGEXPS -# include -#endif /* ETAGS_REGEXPS */ - -/* Define CTAGS to make the program "ctags" compatible with the usual one. - Leave it undefined to make the program "etags", which makes emacs-style - tag tables and tags typedefs, #defines and struct/union/enum by default. */ -#ifdef CTAGS -# undef CTAGS -# define CTAGS TRUE -#else -# define CTAGS FALSE -#endif - -/* Exit codes for success and failure. */ -#ifdef VMS -# define GOOD 1 -# define BAD 0 -#else -# define GOOD 0 -# define BAD 1 -#endif - -/* C extensions. */ -#define C_PLPL 0x00001 /* C++ */ -#define C_STAR 0x00003 /* C* */ -#define C_JAVA 0x00005 /* JAVA */ -#define YACC 0x10000 /* yacc file */ - -#define streq(s,t) ((DEBUG && (s) == NULL && (t) == NULL \ - && (abort (), 1)) || !strcmp (s, t)) -#define strneq(s,t,n) ((DEBUG && (s) == NULL && (t) == NULL \ - && (abort (), 1)) || !strncmp (s, t, n)) - -#define lowcase(c) tolower ((char)c) - -#define CHARS 256 /* 2^sizeof(char) */ -#define CHAR(x) ((unsigned int)x & (CHARS - 1)) -#define iswhite(c) (_wht[CHAR(c)]) /* c is white */ -#define notinname(c) (_nin[CHAR(c)]) /* c is not in a name */ -#define begtoken(c) (_btk[CHAR(c)]) /* c can start token */ -#define intoken(c) (_itk[CHAR(c)]) /* c can be in token */ -#define endtoken(c) (_etk[CHAR(c)]) /* c ends tokens */ - -/*#ifdef INFODOCK*/ -/*#undef OO_BROWSER*/ -/* Due to the way this file is constructed, this unfortunately doesn't */ -/* work except for documentation purposes. -slb */ -#define OO_BROWSER 1 -/*#endif*/ - -#ifdef OO_BROWSER -#define set_construct(construct) \ - if (!oo_browser_construct) oo_browser_construct = construct -void oo_browser_clear_all_globals(); -void oo_browser_clear_some_globals(); -void oo_browser_check_and_clear_structtype(); -#endif - -/* - * xnew, xrnew -- allocate, reallocate storage - * - * SYNOPSIS: Type *xnew (int n, Type); - * Type *xrnew (OldPointer, int n, Type); - */ -#ifdef chkmalloc -# include "chkmalloc.h" -# define xnew(n,Type) ((Type *) trace_malloc (__FILE__, __LINE__, \ - (n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) trace_realloc (__FILE__, __LINE__, \ - (op), (n) * sizeof (Type))) -#else -# define xnew(n,Type) ((Type *) xmalloc ((n) * sizeof (Type))) -# define xrnew(op,n,Type) ((Type *) xrealloc ((op), (n) * sizeof (Type))) -#endif - -typedef int bool; - -typedef void Lang_function (); - -typedef struct -{ - char *name; - Lang_function *function; - char **suffixes; - char **interpreters; -} language; - -typedef struct node_st -{ /* sorting structure */ - char *name; /* function or type name */ -#ifdef OO_BROWSER - short int construct; /* Construct type for the OO-Browser */ -#endif - char *file; /* file name */ - bool is_func; /* use pattern or line no */ - bool been_warned; /* set if noticed dup */ - int lno; /* line number tag is on */ - long cno; /* character number line starts on */ - char *pat; /* search pattern */ - struct node_st *left, *right; /* left and right sons */ -} node; - -#ifdef OO_BROWSER -/* If you add to this array, you must add a corresponding entry to the - following enum. */ -static char *oo_browser_default_classes[] = - /* Lack of square brackets around some of these entries are intentional. */ - {"null", "class", "method", "[constant]", "[enumeration]", "[enum_label]", - "extern", "[function]", "[macro]", "objc", "[structure]", "[type]", - "[union]", "[variable]"}; - -/* If you add to this enum, you must add a corresponding entry to the - preceding array. */ -enum oo_browser_constructs {C_NULL, C_CLASS, C_METHOD, C_CONSTANT, C_ENUMERATION, - C_ENUM_LABEL, C_EXTERN, C_FUNCTION, C_MACRO, - C_OBJC, C_STRUCTURE, C_TYPE, C_UNION, C_VARIABLE}; - -enum oo_browser_constructs oo_browser_construct = C_NULL; -#endif - -/* - * A `linebuffer' is a structure which holds a line of text. - * `readline_internal' reads a line from a stream into a linebuffer - * and works regardless of the length of the line. - * SIZE is the size of BUFFER, LEN is the length of the string in - * BUFFER after readline reads it. - */ -typedef struct -{ - long size; - int len; - char *buffer; -} linebuffer; - -extern char *getenv PP ((const char *envvar)); - -/* Many compilers barf on this: - Lang_function Asm_labels; - so let's write it this way */ -void Asm_labels PP ((FILE *inf)); -void C_entries PP ((int c_ext, FILE *inf)); -void default_C_entries PP ((FILE *inf)); -void plain_C_entries PP ((FILE *inf)); -void Cjava_entries PP ((FILE *inf)); -void Cplusplus_entries PP ((FILE *inf)); -void Yacc_entries PP ((FILE *inf)); -void Cobol_paragraphs PP ((FILE *inf)); -void Cstar_entries PP ((FILE *inf)); -void Erlang_functions PP ((FILE *inf)); -void Fortran_functions PP ((FILE *inf)); -void Lisp_functions PP ((FILE *inf)); -void Pascal_functions PP ((FILE *inf)); -void Perl_functions PP ((FILE *inf)); -void Postscript_functions PP ((FILE *inf)); -void Prolog_functions PP ((FILE *inf)); -void Python_functions PP ((FILE *inf)); -void Scheme_functions PP ((FILE *inf)); -void TeX_functions PP ((FILE *inf)); -void just_read_file PP ((FILE *inf)); - -void print_language_names PP ((void)); -void print_version PP ((void)); -void print_help PP ((void)); - -language *get_language_from_name PP ((char *name)); -language *get_language_from_interpreter PP ((char *interpreter)); -language *get_language_from_suffix PP ((char *suffix)); -int total_size_of_entries PP ((node *np)); -long readline PP ((linebuffer *lbp, FILE *stream)); -long readline_internal PP ((linebuffer *lbp, FILE *stream)); -#ifdef ETAGS_REGEXPS -void analyse_regex PP ((char *regex_arg)); -void add_regex PP ((char *regexp_pattern, language *lang)); -void free_patterns PP ((void)); -#endif /* ETAGS_REGEXPS */ -void error PP ((const char *s1, const char *s2)); -void suggest_asking_for_help PP ((void)); -void fatal PP ((char *s1, char *s2)); -void pfatal PP ((char *s1)); -void add_node PP ((node *np, node **cur_node_p)); - -void init PP ((void)); -void initbuffer PP ((linebuffer *lbp)); -void find_entries PP ((char *file, FILE *inf)); -void free_tree PP ((node *np)); -void pfnote PP ((char *name, bool is_func, char *linestart, int linelen, int lno, long cno)); -void new_pfnote PP ((char *name, int namelen, bool is_func, char *linestart, int linelen, int lno, long cno)); -void process_file PP ((char *file)); -void put_entries PP ((node *np)); -void takeprec PP ((void)); - -char *concat PP ((char *s1, char *s2, char *s3)); -char *skip_spaces PP ((char *cp)); -char *skip_non_spaces PP ((char *cp)); -char *savenstr PP ((char *cp, int len)); -char *savestr PP ((char *cp)); -char *etags_strchr PP ((char *sp, int c)); -char *etags_strrchr PP ((char *sp, int c)); -char *etags_getcwd PP ((void)); -char *relative_filename PP ((char *file, char *dir)); -char *absolute_filename PP ((char *file, char *dir)); -char *absolute_dirname PP ((char *file, char *dir)); -bool filename_is_absolute PP ((char *fn)); -void canonicalize_filename PP ((char *fn)); -void grow_linebuffer PP ((linebuffer *lbp, int toksize)); -long *xmalloc PP ((unsigned int size)); -long *xrealloc PP ((char *ptr, unsigned int size)); - - -char searchar = '/'; /* use /.../ searches */ - -char *tagfile; /* output file */ -char *progname; /* name this program was invoked with */ -char *cwd; /* current working directory */ -char *tagfiledir; /* directory of tagfile */ -FILE *tagf; /* ioptr for tags file */ - -char *curfile; /* current input file name */ -language *curlang; /* current language */ - -int lineno; /* line number of current line */ -long charno; /* current character number */ -long linecharno; /* charno of start of current line */ -char *dbp; /* pointer to start of current tag */ -node *head; /* the head of the binary tree of tags */ - -linebuffer lb; /* the current line */ -linebuffer token_name; /* used by C_entries as a temporary area */ -struct -{ - long linepos; - linebuffer lb; /* used by C_entries instead of lb */ -} lbs[2]; - -/* boolean "functions" (see init) */ -bool _wht[CHARS], _nin[CHARS], _itk[CHARS], _btk[CHARS], _etk[CHARS]; -char - /* white chars */ - *white = " \f\t\n\r", - /* not in a name */ - *nonam = " \f\t\n\r(=,[;", - /* token ending chars */ - *endtk = " \t\n\r\"'#()[]{}=-+%*/&|^~!<>;,.:?", - /* token starting chars */ - *begtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$~@", - /* valid in-token chars */ - *midtk = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz$0123456789"; - -bool append_to_tagfile; /* -a: append to tags */ -/* The following four default to TRUE for etags, but to FALSE for ctags. */ -bool typedefs; /* -t: create tags for C typedefs */ -bool typedefs_and_cplusplus; /* -T: create tags for C typedefs, level */ - /* 0 struct/enum/union decls, and C++ */ - /* member functions. */ -bool constantypedefs; /* -d: create tags for C #define, enum */ - /* constants and variables. */ - /* -D: opposite of -d. Default under ctags. */ -bool globals; /* create tags for global variables */ -bool members; /* create tags for C member variables */ -bool update; /* -u: update tags */ -bool vgrind_style; /* -v: create vgrind style index output */ -bool no_warnings; /* -w: suppress warnings */ -bool cxref_style; /* -x: create cxref style output */ -bool cplusplus; /* .[hc] means C++, not C */ -bool noindentypedefs; /* -I: ignore indentation in C */ -#ifdef OO_BROWSER -bool oo_browser_format; /* -O: OO-Browser tags format */ -#endif - -#ifdef LONG_OPTIONS -struct option longopts[] = -{ - { "append", no_argument, NULL, 'a' }, - { "backward-search", no_argument, NULL, 'B' }, - { "c++", no_argument, NULL, 'C' }, - { "cxref", no_argument, NULL, 'x' }, - { "defines", no_argument, NULL, 'd' }, - { "no-defines", no_argument, NULL, 'D' }, - { "globals", no_argument, &globals, TRUE }, - { "no-globals", no_argument, &globals, FALSE }, - { "help", no_argument, NULL, 'h' }, - { "help", no_argument, NULL, 'H' }, - { "ignore-indentation", no_argument, NULL, 'I' }, - { "include", required_argument, NULL, 'i' }, - { "language", required_argument, NULL, 'l' }, - { "members", no_argument, &members, TRUE }, - { "no-members", no_argument, &members, FALSE }, - { "no-warn", no_argument, NULL, 'w' }, - { "output", required_argument, NULL, 'o' }, -#ifdef OO_BROWSER - { "oo-browser", no_argument, NULL, 'O' }, -#endif -#ifdef ETAGS_REGEXPS - { "regex", required_argument, NULL, 'r' }, - { "no-regex", no_argument, NULL, 'R' }, -#endif /* ETAGS_REGEXPS */ - { "typedefs", no_argument, NULL, 't' }, - { "typedefs-and-c++", no_argument, NULL, 'T' }, - { "update", no_argument, NULL, 'u' }, - { "version", no_argument, NULL, 'V' }, - { "vgrind", no_argument, NULL, 'v' }, - { 0 } -}; -#endif /* LONG_OPTIONS */ - -#ifdef ETAGS_REGEXPS -/* Structure defining a regular expression. Elements are - the compiled pattern, and the name string. */ -typedef struct pattern -{ - struct pattern *p_next; - language *language; - char *regex; - struct re_pattern_buffer *pattern; - struct re_registers regs; - char *name_pattern; - bool error_signaled; -} pattern; - -/* Array of all regexps. */ -pattern *p_head = NULL; -#endif /* ETAGS_REGEXPS */ - -/* - * Language stuff. - */ - -/* Non-NULL if language fixed. */ -language *forced_lang = NULL; - -/* Assembly code */ -char *Asm_suffixes [] = { "a", /* Unix assembler */ - "asm", /* Microcontroller assembly */ - "def", /* BSO/Tasking definition includes */ - "inc", /* Microcontroller include files */ - "ins", /* Microcontroller include files */ - "s", "sa", /* Unix assembler */ - "src", /* BSO/Tasking C compiler output */ - NULL - }; - -/* Note that .c and .h can be considered C++, if the --c++ flag was - given. That is why default_C_entries is called here. */ -char *default_C_suffixes [] = - { "c", "h", NULL }; - -char *Cplusplus_suffixes [] = - { "C", "H", "c++", "cc", "cpp", "cxx", "h++", "hh", "hpp", "hxx", - "M", /* Objective C++ */ - "pdb", /* Postscript with C syntax */ - NULL }; - -char *Cjava_suffixes [] = - { "java", NULL }; - -char *Cobol_suffixes [] = - { "COB", "cob", NULL }; - -char *Cstar_suffixes [] = - { "cs", "hs", NULL }; - -char *Erlang_suffixes [] = - { "erl", "hrl", NULL }; - -char *Fortran_suffixes [] = - { "F", "f", "f90", "for", NULL }; - -char *Lisp_suffixes [] = - { "cl", "clisp", "el", "l", "lisp", "lsp", "ml", NULL }; - -char *Pascal_suffixes [] = - { "p", "pas", NULL }; - -char *Perl_suffixes [] = - { "pl", "pm", NULL }; -char *Perl_interpreters [] = - { "perl", "@PERL@", NULL }; - -char *plain_C_suffixes [] = - { "pc", /* Pro*C file */ - "m", /* Objective C file */ - "lm", /* Objective lex file */ - NULL }; - -char *Postscript_suffixes [] = - { "ps", NULL }; - -char *Prolog_suffixes [] = - { "prolog", NULL }; - -char *Python_suffixes [] = - { "py", NULL }; - -/* Can't do the `SCM' or `scm' prefix with a version number. */ -char *Scheme_suffixes [] = - { "SCM", "SM", "oak", "sch", "scheme", "scm", "sm", "ss", "t", NULL }; - -char *TeX_suffixes [] = - { "TeX", "bib", "clo", "cls", "ltx", "sty", "tex", NULL }; - -char *Yacc_suffixes [] = - { "y", "ym", NULL }; /* .ym is Objective yacc file */ - -/* - * Table of languages. - * - * It is ok for a given function to be listed under more than one - * name. I just didn't. - */ - -language lang_names [] = -{ - { "asm", Asm_labels, Asm_suffixes, NULL }, - { "c", default_C_entries, default_C_suffixes, NULL }, - { "c++", Cplusplus_entries, Cplusplus_suffixes, NULL }, - { "c*", Cstar_entries, Cstar_suffixes, NULL }, - { "cobol", Cobol_paragraphs, Cobol_suffixes, NULL }, - { "erlang", Erlang_functions, Erlang_suffixes, NULL }, - { "fortran", Fortran_functions, Fortran_suffixes, NULL }, - { "java", Cjava_entries, Cjava_suffixes, NULL }, - { "lisp", Lisp_functions, Lisp_suffixes, NULL }, - { "pascal", Pascal_functions, Pascal_suffixes, NULL }, - { "perl", Perl_functions, Perl_suffixes, Perl_interpreters }, - { "postscript", Postscript_functions, Postscript_suffixes, NULL }, - { "proc", plain_C_entries, plain_C_suffixes, NULL }, - { "prolog", Prolog_functions, Prolog_suffixes, NULL }, - { "python", Python_functions, Python_suffixes, NULL }, - { "scheme", Scheme_functions, Scheme_suffixes, NULL }, - { "tex", TeX_functions, TeX_suffixes, NULL }, - { "yacc", Yacc_entries, Yacc_suffixes, NULL }, - { "auto", NULL }, /* default guessing scheme */ - { "none", just_read_file }, /* regexp matching only */ - { NULL, NULL } /* end of list */ -}; - - -void -print_language_names () -{ - language *lang; - char **ext; - - puts ("\nThese are the currently supported languages, along with the\n\ -default file name suffixes:"); - for (lang = lang_names; lang->name != NULL; lang++) - { - printf ("\t%s\t", lang->name); - if (lang->suffixes != NULL) - for (ext = lang->suffixes; *ext != NULL; ext++) - printf (" .%s", *ext); - puts (""); - } - puts ("Where `auto' means use default language for files based on file\n\ -name suffix, and `none' means only do regexp processing on files.\n\ -If no language is specified and no matching suffix is found,\n\ -the first line of the file is read for a sharp-bang (#!) sequence\n\ -followed by the name of an interpreter. If no such sequence is found,\n\ -Fortran is tried first; if no tags are found, C is tried next."); -} - -#ifndef VERSION -# define VERSION "20" -#endif -void -print_version () -{ - printf ("%s (GNU Emacs %s)\n", (CTAGS) ? "ctags" : "etags", VERSION); - puts ("Copyright (C) 1996 Free Software Foundation, Inc. and Ken Arnold"); - puts ("This program is distributed under the same terms as Emacs"); - - exit (GOOD); -} - -void -print_help () -{ - printf ("Usage: %s [options] [[regex-option ...] file-name] ...\n\ -\n\ -These are the options accepted by %s.\n", progname, progname); -#ifdef LONG_OPTIONS - puts ("You may use unambiguous abbreviations for the long option names."); -#else - puts ("Long option names do not work with this executable, as it is not\n\ -linked with GNU getopt."); -#endif /* LONG_OPTIONS */ - puts ("A - as file name means read names from stdin (one per line)."); - if (!CTAGS) - printf (" Absolute names are stored in the output file as they are.\n\ -Relative ones are stored relative to the output file's directory."); - puts ("\n"); - - puts ("-a, --append\n\ - Append tag entries to existing tags file."); - - if (CTAGS) - puts ("-B, --backward-search\n\ - Write the search commands for the tag entries using '?', the\n\ - backward-search command instead of '/', the forward-search command."); - - puts ("-C, --c++\n\ - Treat files whose name suffix defaults to C language as C++ files."); - - if (CTAGS) - puts ("-d, --defines\n\ - Create tag entries for C #define constants and enum constants, too."); - else - puts ("-D, --no-defines\n\ - Don't create tag entries for C #define constants and enum constants.\n\ - This makes the tags file smaller."); - - if (!CTAGS) - { - puts ("-i FILE, --include=FILE\n\ - Include a note in tag file indicating that, when searching for\n\ - a tag, one should also consult the tags file FILE after\n\ - checking the current file."); - puts ("-l LANG, --language=LANG\n\ - Force the following files to be considered as written in the\n\ - named language up to the next --language=LANG option."); - } - - if (CTAGS) - puts ("--globals\n\ - Create tag entries for global variables in some languages."); - else - puts ("--no-globals\n\ - Do not create tag entries for global variables in some\n\ - languages. This makes the tags file smaller."); - puts ("--members\n\ - Create tag entries for member variables in C and derived languages."); - -#ifdef ETAGS_REGEXPS - puts ("-r /REGEXP/, --regex=/REGEXP/ or --regex=@regexfile\n\ - Make a tag for each line matching pattern REGEXP in the\n\ - following files. regexfile is a file containing one REGEXP\n\ - per line. REGEXP is anchored (as if preceded by ^).\n\ - The form /REGEXP/NAME/ creates a named tag. For example Tcl\n\ - named tags can be created with:\n\ - --regex=/proc[ \\t]+\\([^ \\t]+\\)/\\1/."); - puts ("-R, --no-regex\n\ - Don't create tags from regexps for the following files."); -#endif /* ETAGS_REGEXPS */ - puts ("-o FILE, --output=FILE\n\ - Write the tags to FILE."); -#ifdef OO_BROWSER - puts ("-O, --oo-browser\n\ - Generate a specialized tags format used only by the Altrasoft OO-Browser."); -#endif - puts ("-I, --ignore-indentation\n\ - Don't rely on indentation quite as much as normal. Currently,\n\ - this means not to assume that a closing brace in the first\n\ - column is the final brace of a function or structure\n\ - definition in C and C++."); - - if (CTAGS) - { - puts ("-t, --typedefs\n\ - Generate tag entries for C typedefs."); - puts ("-T, --typedefs-and-c++\n\ - Generate tag entries for C typedefs, C struct/enum/union tags,\n\ - and C++ member functions."); - puts ("-u, --update\n\ - Update the tag entries for the given files, leaving tag\n\ - entries for other files in place. Currently, this is\n\ - implemented by deleting the existing entries for the given\n\ - files and then rewriting the new entries at the end of the\n\ - tags file. It is often faster to simply rebuild the entire\n\ - tag file than to use this."); - puts ("-v, --vgrind\n\ - Generates an index of items intended for human consumption,\n\ - similar to the output of vgrind. The index is sorted, and\n\ - gives the page number of each item."); - puts ("-w, --no-warn\n\ - Suppress warning messages about entries defined in multiple\n\ - files."); - puts ("-x, --cxref\n\ - Like --vgrind, but in the style of cxref, rather than vgrind.\n\ - The output uses line numbers instead of page numbers, but\n\ - beyond that the differences are cosmetic; try both to see\n\ - which you like."); - } - - puts ("-V, --version\n\ - Print the version of the program.\n\ --h, --help\n\ - Print this help message."); - - print_language_names (); - - puts (""); - puts ("Report bugs to bug-gnu-emacs@prep.ai.mit.edu"); - - exit (GOOD); -} - - -enum argument_type -{ - at_language, - at_regexp, - at_filename -}; - -/* This structure helps us allow mixing of --lang and file names. */ -typedef struct -{ - enum argument_type arg_type; - char *what; - language *lang; -} argument; - -#ifdef VMS /* VMS specific functions */ - -#define EOS '\0' - -/* This is a BUG! ANY arbitrary limit is a BUG! - Won't someone please fix this? */ -#define MAX_FILE_SPEC_LEN 255 -typedef struct { - short curlen; - char body[MAX_FILE_SPEC_LEN + 1]; -} vspec; - -/* - v1.05 nmm 26-Jun-86 fn_exp - expand specification of list of file names - returning in each successive call the next file name matching the input - spec. The function expects that each in_spec passed - to it will be processed to completion; in particular, up to and - including the call following that in which the last matching name - is returned, the function ignores the value of in_spec, and will - only start processing a new spec with the following call. - If an error occurs, on return out_spec contains the value - of in_spec when the error occurred. - - With each successive file name returned in out_spec, the - function's return value is one. When there are no more matching - names the function returns zero. If on the first call no file - matches in_spec, or there is any other error, -1 is returned. -*/ - -#include -#include -#define OUTSIZE MAX_FILE_SPEC_LEN -short -fn_exp (out, in) - vspec *out; - char *in; -{ - static long context = 0; - static struct dsc$descriptor_s o; - static struct dsc$descriptor_s i; - static bool pass1 = TRUE; - long status; - short retval; - - if (pass1) - { - pass1 = FALSE; - o.dsc$a_pointer = (char *) out; - o.dsc$w_length = (short)OUTSIZE; - i.dsc$a_pointer = in; - i.dsc$w_length = (short)strlen(in); - i.dsc$b_dtype = DSC$K_DTYPE_T; - i.dsc$b_class = DSC$K_CLASS_S; - o.dsc$b_dtype = DSC$K_DTYPE_VT; - o.dsc$b_class = DSC$K_CLASS_VS; - } - if ((status = lib$find_file(&i, &o, &context, 0, 0)) == RMS$_NORMAL) - { - out->body[out->curlen] = EOS; - return 1; - } - else if (status == RMS$_NMF) - retval = 0; - else - { - strcpy(out->body, in); - retval = -1; - } - lib$find_file_end(&context); - pass1 = TRUE; - return retval; -} - -/* - v1.01 nmm 19-Aug-85 gfnames - return in successive calls the - name of each file specified by the provided arg expanding wildcards. -*/ -char * -gfnames (arg, p_error) - char *arg; - bool *p_error; -{ - static vspec filename = {MAX_FILE_SPEC_LEN, "\0"}; - - switch (fn_exp (&filename, arg)) - { - case 1: - *p_error = FALSE; - return filename.body; - case 0: - *p_error = FALSE; - return NULL; - default: - *p_error = TRUE; - return filename.body; - } -} - -#ifndef OLD /* Newer versions of VMS do provide `system'. */ -system (cmd) - char *cmd; -{ - error ("%s", "system() function not implemented under VMS"); -} -#endif - -#define VERSION_DELIM ';' -char *massage_name (s) - char *s; -{ - char *start = s; - - for ( ; *s; s++) - if (*s == VERSION_DELIM) - { - *s = EOS; - break; - } - else - *s = lowcase (*s); - return start; -} -#endif /* VMS */ - - -int -main (argc, argv) - int argc; - char *argv[]; -{ - int i; - unsigned int nincluded_files; - char **included_files; - char *this_file; - argument *argbuffer; - int current_arg, file_count; - linebuffer filename_lb; -#ifdef VMS - bool got_err; -#endif - -#ifdef DOS_NT - _fmode = O_BINARY; /* all of files are treated as binary files */ -#endif /* DOS_NT */ - - progname = argv[0]; - nincluded_files = 0; - included_files = xnew (argc, char *); - current_arg = 0; - file_count = 0; - - /* Allocate enough no matter what happens. Overkill, but each one - is small. */ - argbuffer = xnew (argc, argument); - -#ifdef ETAGS_REGEXPS - /* Set syntax for regular expression routines. */ - re_set_syntax (RE_SYNTAX_EMACS | RE_INTERVALS); -#endif /* ETAGS_REGEXPS */ - - /* - * If etags, always find typedefs and structure tags. Why not? - * Also default is to find macro constants, enum constants and - * global variables. - */ - if (!CTAGS) - { - typedefs = typedefs_and_cplusplus = constantypedefs = TRUE; - globals = TRUE; - members = FALSE; - } - - while (1) - { - int opt; - char *optstring; - -#ifdef ETAGS_REGEXPS -#ifndef OO_BROWSER - optstring = "-aCdDf:Il:o:r:RStTi:BuvxwVhH"; -#else - optstring = "-aCdDf:Il:o:r:RStTi:BOuvxwVhH"; -#endif -#else -#ifndef OO_BROWSER - optstring = "-aCdDf:Il:o:StTi:BuvxwVhH"; -#else - optstring = "-aCdDf:Il:o:StTi:BOuvxwVhH"; -#endif -#endif /* ETAGS_REGEXPS */ - -#ifndef LONG_OPTIONS - optstring = optstring + 1; -#endif /* LONG_OPTIONS */ - - opt = getopt_long (argc, argv, optstring, longopts, 0); - if (opt == EOF) - break; - - switch (opt) - { - case 0: - /* If getopt returns 0, then it has already processed a - long-named option. We should do nothing. */ - break; - - case 1: - /* This means that a file name has been seen. Record it. */ - argbuffer[current_arg].arg_type = at_filename; - argbuffer[current_arg].what = optarg; - ++current_arg; - ++file_count; - break; - - /* Common options. */ - case 'a': append_to_tagfile = TRUE; break; - case 'C': cplusplus = TRUE; break; - case 'd': constantypedefs = TRUE; break; - case 'D': constantypedefs = FALSE; break; - case 'f': /* for compatibility with old makefiles */ - case 'o': - if (tagfile) - { - /* convert char to string, to call error with */ - char buf[2]; - sprintf (buf, "%c", opt); - error ("-%s option may only be given once.", buf); - suggest_asking_for_help (); - } - tagfile = optarg; - break; -#ifdef OO_BROWSER - case 'O': - oo_browser_format = TRUE; - break; -#endif - case 'I': - case 'S': /* for backward compatibility */ - noindentypedefs = TRUE; - break; - case 'l': - { - language *lang = get_language_from_name (optarg); - if (lang != NULL) - { - argbuffer[current_arg].lang = lang; - argbuffer[current_arg].arg_type = at_language; - ++current_arg; - } - } - break; -#ifdef ETAGS_REGEXPS - case 'r': - argbuffer[current_arg].arg_type = at_regexp; - argbuffer[current_arg].what = optarg; - ++current_arg; - break; - case 'R': - argbuffer[current_arg].arg_type = at_regexp; - argbuffer[current_arg].what = NULL; - ++current_arg; - break; -#endif /* ETAGS_REGEXPS */ - case 'V': - print_version (); - break; - case 'h': - case 'H': - print_help (); - break; - case 't': - typedefs = TRUE; - break; - case 'T': - typedefs = typedefs_and_cplusplus = TRUE; - break; -#if (!CTAGS) - /* Etags options */ - case 'i': - included_files[nincluded_files++] = optarg; - break; -#else /* CTAGS */ - /* Ctags options. */ - case 'B': searchar = '?'; break; - case 'u': update = TRUE; break; - case 'v': vgrind_style = TRUE; /*FALLTHRU*/ - case 'x': cxref_style = TRUE; break; - case 'w': no_warnings = TRUE; break; -#endif /* CTAGS */ - default: - suggest_asking_for_help (); - } - } - - for (; optind < argc; ++optind) - { - argbuffer[current_arg].arg_type = at_filename; - argbuffer[current_arg].what = argv[optind]; - ++current_arg; - ++file_count; - } - - if (nincluded_files == 0 && file_count == 0) - { - error ("no input files specified.", 0); - suggest_asking_for_help (); - } - - if (tagfile == NULL) - tagfile = CTAGS ? "tags" : "TAGS"; - cwd = etags_getcwd (); /* the current working directory */ - if (cwd[strlen (cwd) - 1] != '/') - { - char *oldcwd = cwd; - cwd = concat (oldcwd, "/", ""); - free (oldcwd); - } - if (streq (tagfile, "-")) - tagfiledir = cwd; - else - tagfiledir = absolute_dirname (tagfile, cwd); - - init (); /* set up boolean "functions" */ - - initbuffer (&lb); - initbuffer (&token_name); - initbuffer (&lbs[0].lb); - initbuffer (&lbs[1].lb); - initbuffer (&filename_lb); - - if (!CTAGS) - { - if (streq (tagfile, "-")) - { - tagf = stdout; -#ifdef DOS_NT - /* Switch redirected `stdout' to binary mode (setting `_fmode' - doesn't take effect until after `stdout' is already open). */ - if (!isatty (fileno (stdout))) - setmode (fileno (stdout), O_BINARY); -#endif /* DOS_NT */ - } - else - tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); - if (tagf == NULL) - pfatal (tagfile); - } - - /* - * Loop through files finding functions. - */ - for (i = 0; i < current_arg; ++i) - { - switch (argbuffer[i].arg_type) - { - case at_language: - forced_lang = argbuffer[i].lang; - break; -#ifdef ETAGS_REGEXPS - case at_regexp: - analyse_regex (argbuffer[i].what); - break; -#endif - case at_filename: -#ifdef VMS - while ((this_file = gfnames (argbuffer[i].what, &got_err)) != NULL) - { - if (got_err) - { - error ("can't find file %s\n", this_file); - argc--, argv++; - } - else - { - this_file = massage_name (this_file); - } -#else - this_file = argbuffer[i].what; -#endif -#ifdef OO_BROWSER - oo_browser_clear_all_globals(); -#endif - /* Input file named "-" means read file names from stdin - (one per line) and use them. */ - if (streq (this_file, "-")) - while (readline_internal (&filename_lb, stdin) > 0) -#ifdef OO_BROWSER - { - oo_browser_clear_some_globals(); -#endif - process_file (filename_lb.buffer); -#ifdef OO_BROWSER - } -#endif - else - process_file (this_file); -#ifdef VMS - } -#endif - break; - } - } - -#ifdef ETAGS_REGEXPS - free_patterns (); -#endif /* ETAGS_REGEXPS */ - - if (!CTAGS) - { - while (nincluded_files-- > 0) - fprintf (tagf, "\f\n%s,include\n", *included_files++); - - fclose (tagf); - exit (GOOD); - } - - /* If CTAGS, we are here. process_file did not write the tags yet, - because we want them ordered. Let's do it now. */ - if (cxref_style) - { - put_entries (head); - exit (GOOD); - } - - if (update) - { - char cmd[BUFSIZ]; - for (i = 0; i < current_arg; ++i) - { - if (argbuffer[i].arg_type != at_filename) - continue; - sprintf (cmd, - "mv %s OTAGS;fgrep -v '\t%s\t' OTAGS >%s;rm OTAGS", - tagfile, argbuffer[i].what, tagfile); - if (system (cmd) != GOOD) - fatal ("failed to execute shell command", (char *)NULL); - } - append_to_tagfile = TRUE; - } - - tagf = fopen (tagfile, append_to_tagfile ? "a" : "w"); - if (tagf == NULL) - pfatal (tagfile); - put_entries (head); - fclose (tagf); - - if (update) - { - char cmd[BUFSIZ]; - sprintf (cmd, "sort %s -o %s", tagfile, tagfile); - exit (system (cmd)); - } - return GOOD; -} - - -/* - * Return a language given the name. - */ -language * -get_language_from_name (name) - char *name; -{ - language *lang; - - if (name == NULL) - error ("empty language name", (char *)NULL); - else - { - for (lang = lang_names; lang->name != NULL; lang++) - if (streq (name, lang->name)) - return lang; - error ("unknown language \"%s\"", name); - } - - return NULL; -} - - -/* - * Return a language given the interpreter name. - */ -language * -get_language_from_interpreter (interpreter) - char *interpreter; -{ - language *lang; - char **iname; - - if (interpreter == NULL) - return NULL; - for (lang = lang_names; lang->name != NULL; lang++) - if (lang->interpreters != NULL) - for (iname = lang->interpreters; *iname != NULL; iname++) - if (streq (*iname, interpreter)) - return lang; - - return NULL; -} - - - -/* - * Return a language given the file suffix. - */ -language * -get_language_from_suffix (suffix) - char *suffix; -{ - language *lang; - char **ext; - - if (suffix == NULL) - return NULL; - for (lang = lang_names; lang->name != NULL; lang++) - if (lang->suffixes != NULL) - for (ext = lang->suffixes; *ext != NULL; ext++) - if (streq (*ext, suffix)) - return lang; - - return NULL; -} - - -/* - * This routine is called on each file argument. - */ -void -process_file (file) - char *file; -{ - struct stat stat_buf; - FILE *inf; - - canonicalize_filename (file); - if (stat (file, &stat_buf) == 0 && !S_ISREG (stat_buf.st_mode)) - { - error ("skipping %s: it is not a regular file.", file); - return; - } - if (streq (file, tagfile) && !streq (tagfile, "-")) - { - error ("skipping inclusion of %s in self.", file); - return; - } - inf = fopen (file, "r"); - if (inf == NULL) - { - perror (file); - return; - } - - find_entries (file, inf); - - if (!CTAGS) - { - char *filename; - - if (filename_is_absolute (file)) - { - /* file is an absolute file name. Canonicalise it. */ - filename = absolute_filename (file, cwd); - } - else - { - /* file is a file name relative to cwd. Make it relative - to the directory of the tags file. */ - filename = relative_filename (file, tagfiledir); - } -#ifdef OO_BROWSER - if (oo_browser_format) - fprintf (tagf, "\f\n%s\n", filename); - else -#endif - fprintf (tagf, "\f\n%s,%d\n", filename, total_size_of_entries (head)); - free (filename); - put_entries (head); - free_tree (head); - head = NULL; - } -} - -/* - * This routine sets up the boolean pseudo-functions which work - * by setting boolean flags dependent upon the corresponding character. - * Every char which is NOT in that string is not a white char. Therefore, - * all of the array "_wht" is set to FALSE, and then the elements - * subscripted by the chars in "white" are set to TRUE. Thus "_wht" - * of a char is TRUE if it is the string "white", else FALSE. - */ -void -init () -{ - register char *sp; - register int i; - - for (i = 0; i < CHARS; i++) - iswhite(i) = notinname(i) = begtoken(i) = intoken(i) = endtoken(i) = FALSE; - for (sp = white; *sp != '\0'; sp++) iswhite (*sp) = TRUE; - for (sp = nonam; *sp != '\0'; sp++) notinname (*sp) = TRUE; - for (sp = begtk; *sp != '\0'; sp++) begtoken (*sp) = TRUE; - for (sp = midtk; *sp != '\0'; sp++) intoken (*sp) = TRUE; - for (sp = endtk; *sp != '\0'; sp++) endtoken (*sp) = TRUE; - iswhite('\0') = iswhite('\n'); - notinname('\0') = notinname('\n'); - begtoken('\0') = begtoken('\n'); - intoken('\0') = intoken('\n'); - endtoken('\0') = endtoken('\n'); -} - -/* - * This routine opens the specified file and calls the function - * which finds the function and type definitions. - */ -node *last_node = NULL; - -void -find_entries (file, inf) - char *file; - FILE *inf; -{ - char *cp; - language *lang; - node *old_last_node; - - curfile = savestr (file); - - /* If user specified a language, use it. */ - lang = forced_lang; - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - free (curfile); - fclose (inf); - return; - } - - cp = etags_strrchr (file, '.'); - if (cp != NULL) - { - cp += 1; - lang = get_language_from_suffix (cp); - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - free (curfile); - fclose (inf); - return; - } - } - - /* Look for sharp-bang as the first two characters. */ - if (readline_internal (&lb, inf) > 0 - && lb.len >= 2 - && lb.buffer[0] == '#' - && lb.buffer[1] == '!') - { - char *lp; - - /* Set lp to point at the first char after the last slash in the - line or, if no slashes, at the first nonblank. Then set cp to - the first successive blank and terminate the string. */ - lp = etags_strrchr (lb.buffer+2, '/'); - if (lp != NULL) - lp += 1; - else - lp = skip_spaces (lb.buffer + 2); - cp = skip_non_spaces (lp); - *cp = '\0'; - - if (strlen (lp) > 0) - { - lang = get_language_from_interpreter (lp); - if (lang != NULL && lang->function != NULL) - { - curlang = lang; - lang->function (inf); - fclose (inf); - free (curfile); - return; - } - } - } - rewind (inf); - - /* Try Fortran. */ - old_last_node = last_node; - curlang = get_language_from_name ("fortran"); - Fortran_functions (inf); - - /* No Fortran entries found. Try C. */ - if (old_last_node == last_node) - { - rewind (inf); - curlang = get_language_from_name (cplusplus ? "c++" : "c"); - default_C_entries (inf); - } - free (curfile); - fclose (inf); - return; -} - -/* Record a tag. */ -void -pfnote (name, is_func, linestart, linelen, lno, cno) - char *name; /* tag name, or NULL if unnamed */ - bool is_func; /* tag is a function */ - char *linestart; /* start of the line where tag is */ - int linelen; /* length of the line where tag is */ - int lno; /* line number */ - long cno; /* character number */ -{ - register node *np; - - if (CTAGS && name == NULL) - return; - - np = xnew (1, node); - - /* If ctags mode, change name "main" to M. */ - if (CTAGS && !cxref_style && streq (name, "main")) - { - register char *fp = etags_strrchr (curfile, '/'); - np->name = concat ("M", fp == 0 ? curfile : fp + 1, ""); - fp = etags_strrchr (np->name, '.'); - if (fp && fp[1] != '\0' && fp[2] == '\0') - fp[0] = 0; - } - else - np->name = name; - np->been_warned = FALSE; - np->file = curfile; - np->is_func = is_func; - np->lno = lno; - /* Our char numbers are 0-base, because of C language tradition? - ctags compatibility? old versions compatibility? I don't know. - Anyway, since emacs's are 1-base we expect etags.el to take care - of the difference. If we wanted to have 1-based numbers, we would - uncomment the +1 below. */ - np->cno = cno /* + 1 */ ; - np->left = np->right = NULL; - if (CTAGS && !cxref_style) - { - if (strlen (linestart) < 50) - np->pat = concat (linestart, "$", ""); - else - np->pat = savenstr (linestart, 50); - } - else - np->pat = savenstr (linestart, linelen); - -#ifdef OO_BROWSER - if (oo_browser_format) - np->construct = oo_browser_construct; - oo_browser_construct = C_NULL; - oo_browser_check_and_clear_structtype(); -#endif - - add_node (np, &head); -} - -/* Date: Wed, 22 Jan 1997 02:56:31 -0500 [last amended 18 Sep 1997] - * From: Sam Kendall - * Subject: Proposal for firming up the TAGS format specification - * To: F.Potorti@cnuce.cnr.it - * - * pfnote should emit the optimized form [unnamed tag] only if: - * 1. name does not contain any of the characters " \t\r\n(),;"; - * 2. linestart contains name as either a rightmost, or rightmost but - * one character, substring; - * 3. the character, if any, immediately before name in linestart must - * be one of the characters " \t(),;"; - * 4. the character, if any, immediately after name in linestart must - * also be one of the characters " \t(),;". - * - * The real implementation uses the notinname() macro, which recognises - * characters slightly different form " \t\r\n(),;". See the variable - * `nonam'. - */ -#define traditional_tag_style TRUE -void -new_pfnote (name, namelen, is_func, linestart, linelen, lno, cno) - char *name; /* tag name, or NULL if unnamed */ - int namelen; /* tag length */ - bool is_func; /* tag is a function */ - char *linestart; /* start of the line where tag is */ - int linelen; /* length of the line where tag is */ - int lno; /* line number */ - long cno; /* character number */ -{ - register char *cp; - bool named; - - named = TRUE; - if (!CTAGS) - { - for (cp = name; !notinname (*cp); cp++) - continue; - if (*cp == '\0') /* rule #1 */ - { - cp = linestart + linelen - namelen; - if (notinname (linestart[linelen-1])) - cp -= 1; /* rule #4 */ -#ifdef OO_BROWSER - if (!oo_browser_format - && cp >= linestart /* rule #2 */ -#else - if (cp >= linestart /* rule #2 */ -#endif - && (cp == linestart - || notinname (cp[-1])) /* rule #3 */ - && strneq (name, cp, namelen)) /* rule #2 */ - named = FALSE; /* use unnamed tag */ - } - } - - if (named) - name = savenstr (name, namelen); - else - name = NULL; - pfnote (name, is_func, linestart, linelen, lno, cno); -} - -/* - * free_tree () - * recurse on left children, iterate on right children. - */ -void -free_tree (np) - register node *np; -{ - while (np) - { - register node *node_right = np->right; - free_tree (np->left); - if (np->name != NULL) - free (np->name); - free (np->pat); - free (np); - np = node_right; - } -} - -/* - * add_node () - * Adds a node to the tree of nodes. In etags mode, we don't keep - * it sorted; we just keep a linear list. In ctags mode, maintain - * an ordered tree, with no attempt at balancing. - * - * add_node is the only function allowed to add nodes, so it can - * maintain state. - */ -void -add_node (np, cur_node_p) - node *np, **cur_node_p; -{ - register int dif; - register node *cur_node = *cur_node_p; - - if (cur_node == NULL) - { - *cur_node_p = np; - last_node = np; - return; - } - - if (!CTAGS) - { - /* Etags Mode */ - if (last_node == NULL) - fatal ("internal error in add_node", (char *)NULL); - last_node->right = np; - last_node = np; - } - else - { - /* Ctags Mode */ - dif = strcmp (np->name, cur_node->name); - - /* - * If this tag name matches an existing one, then - * do not add the node, but maybe print a warning. - */ - if (!dif) - { - if (streq (np->file, cur_node->file)) - { - if (!no_warnings) - { - fprintf (stderr, "Duplicate entry in file %s, line %d: %s\n", - np->file, lineno, np->name); - fprintf (stderr, "Second entry ignored\n"); - } - } - else if (!cur_node->been_warned && !no_warnings) - { - fprintf - (stderr, - "Duplicate entry in files %s and %s: %s (Warning only)\n", - np->file, cur_node->file, np->name); - cur_node->been_warned = TRUE; - } - return; - } - - /* Actually add the node */ - add_node (np, dif < 0 ? &cur_node->left : &cur_node->right); - } -} - -#ifdef OO_BROWSER -/* Default class name for the current OO-Browser tag. */ -static char *oo_browser_class; -/* Prefix character to use in OO-Browser listings for the current tag. */ -static char oo_browser_prefix; -#endif - -void -put_entries (np) - register node *np; -{ - register char *sp; - - if (np == NULL) - return; - - /* Output subentries that precede this one */ - put_entries (np->left); - - /* Output this entry */ - - if (!CTAGS) - { -#ifdef OO_BROWSER - if (oo_browser_format) - { - /* Omit C++ `class' and `method' entries as well as Objective-C - entries from this OO-Browser tags file since the browser handles - them independently of this file. Omit `extern' variable declarations - as they are unused by the OO-Browser. */ - if (np->construct != C_CLASS - && np->construct != C_METHOD - && np->construct != C_EXTERN - && np->construct != C_OBJC) - { - oo_browser_class = oo_browser_default_classes[np->construct]; - switch (np->construct) - { - case C_CONSTANT: - case C_ENUMERATION: - case C_ENUM_LABEL: - case C_STRUCTURE: - case C_TYPE: - case C_UNION: - case C_VARIABLE: - oo_browser_prefix = '='; - break; - case C_FUNCTION: - case C_MACRO: - oo_browser_prefix = '-'; - break; - } - if (np->name != NULL) - fprintf (tagf, "%s@%c %s@%s\n", - oo_browser_class, oo_browser_prefix, - np->name, np->pat); - else - fprintf (tagf, "%s@%c ???@%s\n", - oo_browser_class, oo_browser_prefix, np->pat); - } - } - else - { -#endif - if (np->name != NULL) - fprintf (tagf, "%s\177%s\001%d,%ld\n", - np->pat, np->name, np->lno, np->cno); - else - fprintf (tagf, "%s\177%d,%ld\n", - np->pat, np->lno, np->cno); -#ifdef OO_BROWSER - } -#endif - } - else - { - if (np->name == NULL) - error ("internal error: NULL name in ctags mode.", (char *)NULL); - - if (cxref_style) - { - if (vgrind_style) - fprintf (stdout, "%s %s %d\n", - np->name, np->file, (np->lno + 63) / 64); - else - fprintf (stdout, "%-16s %3d %-16s %s\n", - np->name, np->lno, np->file, np->pat); - } - else - { - fprintf (tagf, "%s\t%s\t", np->name, np->file); - - if (np->is_func) - { /* a function */ - putc (searchar, tagf); - putc ('^', tagf); - - for (sp = np->pat; *sp; sp++) - { - if (*sp == '\\' || *sp == searchar) - putc ('\\', tagf); - putc (*sp, tagf); - } - putc (searchar, tagf); - } - else - { /* a typedef; text pattern inadequate */ - fprintf (tagf, "%d", np->lno); - } - putc ('\n', tagf); - } - } - - /* Output subentries that follow this one */ - put_entries (np->right); -} - -/* Length of a number's decimal representation. */ -int number_len PP ((long num)); -int -number_len (num) - long num; -{ - int len = 1; - while ((num /= 10) > 0) - len += 1; - return len; -} - -/* - * Return total number of characters that put_entries will output for - * the nodes in the subtree of the specified node. Works only if - * we are not ctags, but called only in that case. This count - * is irrelevant with the new tags.el, but is still supplied for - * backward compatibility. - */ -int -total_size_of_entries (np) - register node *np; -{ - register int total; - - if (np == NULL) - return 0; - - for (total = 0; np != NULL; np = np->right) - { - /* Count left subentries. */ - total += total_size_of_entries (np->left); - - /* Count this entry */ - total += strlen (np->pat) + 1; - total += number_len ((long) np->lno) + 1 + number_len (np->cno) + 1; - if (np->name != NULL) - total += 1 + strlen (np->name); /* \001name */ - } - - return total; -} - -/* - * The C symbol tables. - */ -enum sym_type -{ - st_none, - st_C_objprot, st_C_objimpl, st_C_objend, - st_C_gnumacro, - st_C_ignore, - st_C_javastruct, - st_C_struct, st_C_enum, st_C_define, st_C_typedef, st_C_typespec, - st_C_const -#ifdef OO_BROWSER - , st_C_union, st_C_class, st_C_extern, st_C_inline -#endif -}; - -/* Feed stuff between (but not including) %[ and %] lines to: - gperf -c -k 1,3 -o -p -r -t -%[ -struct C_stab_entry { char *name; int c_ext; enum sym_type type; } -%% -@interface, 0, st_C_objprot -@protocol, 0, st_C_objprot -@implementation,0, st_C_objimpl -@end, 0, st_C_objend -import, C_JAVA, st_C_ignore -package, C_JAVA, st_C_ignore -friend, C_PLPL, st_C_ignore -extends, C_JAVA, st_C_javastruct -implements, C_JAVA, st_C_javastruct -interface, C_JAVA, st_C_struct -class, C_PLPL, st_C_class -namespace, C_PLPL, st_C_struct -domain, C_STAR, st_C_struct -union, 0, st_C_union -struct, 0, st_C_struct -enum, 0, st_C_enum -typedef, 0, st_C_typedef -define, 0, st_C_define -inline, 0, st_C_inline -bool, C_PLPL, st_C_typespec -long, 0, st_C_typespec -short, 0, st_C_typespec -int, 0, st_C_typespec -char, 0, st_C_typespec -float, 0, st_C_typespec -double, 0, st_C_typespec -signed, 0, st_C_typespec -unsigned, 0, st_C_typespec -auto, 0, st_C_typespec -void, 0, st_C_typespec -extern, 0, st_C_extern -static, 0, st_C_typespec -const, 0, st_C_const -volatile, 0, st_C_typespec -explicit, C_PLPL, st_C_typespec -mutable, C_PLPL, st_C_typespec -typename, C_PLPL, st_C_typespec -# DEFUN used in emacs, the next three used in glibc (SYSCALL only for mach). -DEFUN, 0, st_C_gnumacro -SYSCALL, 0, st_C_gnumacro -ENTRY, 0, st_C_gnumacro -PSEUDO, 0, st_C_gnumacro -# These are defined inside C functions, so currently they are not met. -# EXFUN used in glibc, DEFVAR_* in emacs. -#EXFUN, 0, st_C_gnumacro -#DEFVAR_, 0, st_C_gnumacro -%] -and replace lines between %< and %> with its output. */ -/*%<*/ -/* C code produced by gperf version 2.5 (GNU C++ version) */ -/* Command-line: gperf -c -k 1,3 -o -p -r -t */ -struct C_stab_entry { char *name; int c_ext; enum sym_type type; }; - -#define TOTAL_KEYWORDS 41 -#define MIN_WORD_LENGTH 3 -#define MAX_WORD_LENGTH 15 -#define MIN_HASH_VALUE 13 -#define MAX_HASH_VALUE 129 -/* maximum key range = 117, duplicates = 0 */ - -static unsigned int -hash (str, len) - register char *str; - register int unsigned len; -{ - static unsigned char asso_values[] = - { - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 13, 130, 130, 130, 33, 32, - 47, 130, 130, 130, 130, 130, 130, 130, 130, 130, - 5, 130, 130, 20, 32, 130, 130, 130, 130, 130, - 130, 130, 130, 130, 130, 130, 130, 47, 55, 8, - 15, 33, 61, 38, 130, 60, 130, 130, 2, 9, - 10, 62, 59, 130, 28, 27, 50, 19, 3, 130, - 130, 130, 130, 130, 130, 130, 130, 130, - }; - return len + asso_values[str[2]] + asso_values[str[0]]; -} - -struct C_stab_entry * -in_word_set (str, len) - register char *str; - register unsigned int len; -{ - static struct C_stab_entry wordlist[] = - { - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, {"",}, {"",}, - {"volatile", 0, st_C_typespec}, - {"",}, {"",}, - {"long", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"const", 0, st_C_const}, - {"",}, {"",}, {"",}, - {"@end", 0, st_C_objend}, - {"namespace", C_PLPL, st_C_struct}, - {"",}, - {"domain", C_STAR, st_C_struct}, - {"",}, {"",}, - {"@interface", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"@implementation", 0, st_C_objimpl}, - {"",}, {"",}, - {"double", 0, st_C_typespec}, - {"",}, {"",}, - {"PSEUDO", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, - {"SYSCALL", 0, st_C_gnumacro}, - {"",}, {"",}, - {"@protocol", 0, st_C_objprot}, - {"",}, {"",}, {"",}, - {"unsigned", 0, st_C_typespec}, - {"",}, - {"enum", 0, st_C_enum}, - {"",}, {"",}, - {"char", 0, st_C_typespec}, - {"class", C_PLPL, st_C_class}, - {"struct", 0, st_C_struct}, - {"",}, {"",}, {"",}, {"",}, - {"mutable", C_PLPL, st_C_typespec}, - {"void", 0, st_C_typespec}, - {"inline", 0, st_C_inline}, - {"ENTRY", 0, st_C_gnumacro}, - {"",}, - {"signed", 0, st_C_typespec}, - {"",}, {"",}, - {"package", C_JAVA, st_C_ignore}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"static", 0, st_C_typespec}, - {"",}, - {"define", 0, st_C_define}, - {"",}, - {"union", 0, st_C_union}, - {"DEFUN", 0, st_C_gnumacro}, - {"",}, {"",}, {"",}, - {"extern", 0, st_C_extern}, - {"extends", C_JAVA, st_C_javastruct}, - {"",}, {"",}, {"",}, - {"short", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, - {"explicit", C_PLPL, st_C_typespec}, - {"auto", 0, st_C_typespec}, - {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, - {"",}, {"",}, - {"int", 0, st_C_typespec}, - {"",}, {"",}, - {"typedef", 0, st_C_typedef}, - {"typename", C_PLPL, st_C_typespec}, - {"",}, - {"interface", C_JAVA, st_C_struct}, - {"",}, - {"bool", C_PLPL, st_C_typespec}, - {"",}, {"",}, {"",}, - {"import", C_JAVA, st_C_ignore}, - {"",}, - {"friend", C_PLPL, st_C_ignore}, - {"float", 0, st_C_typespec}, - {"implements", C_JAVA, st_C_javastruct}, - }; - - if (len <= MAX_WORD_LENGTH && len >= MIN_WORD_LENGTH) - { - register int key = hash (str, len); - - if (key <= MAX_HASH_VALUE && key >= 0) - { - register char *s = wordlist[key].name; - - if (*s == *str && !strncmp (str + 1, s + 1, len - 1)) - return &wordlist[key]; - } - } - return 0; -} -/*%>*/ - -enum sym_type C_symtype PP ((char *str, int len, int c_ext)); -enum sym_type -C_symtype (str, len, c_ext) - char *str; - int len; - int c_ext; -{ - register struct C_stab_entry *se = in_word_set (str, len); - - if (se == NULL || (se->c_ext && !(c_ext & se->c_ext))) - return st_none; - return se->type; -} - - /* - * C functions and variables are recognized using a simple - * finite automaton. fvdef is its state variable. - */ -enum -{ - fvnone, /* nothing seen */ - fvnameseen, /* function or variable name seen */ - fstartlist, /* func: just after open parenthesis */ - finlist, /* func: in parameter list */ - flistseen, /* func: after parameter list */ - fignore, /* func: before open brace */ - vignore /* var-like: ignore until ';' */ -} fvdef; - - - /* - * typedefs are recognized using a simple finite automaton. - * typdef is its state variable. - */ -enum -{ - tnone, /* nothing seen */ - ttypedseen, /* typedef keyword seen */ - tinbody, /* inside typedef body */ - tend, /* just before typedef tag */ - tignore /* junk after typedef tag */ -} typdef; - - - /* - * struct-like structures (enum, struct and union) are recognized - * using another simple finite automaton. `structdef' is its state - * variable. - */ -enum -{ - snone, /* nothing seen yet */ - skeyseen, /* struct-like keyword seen */ - stagseen, /* struct-like tag seen */ - scolonseen, /* colon seen after struct-like tag */ - sinbody /* in struct body: recognize member func defs*/ -} structdef; - -/* - * When structdef is stagseen, scolonseen, or sinbody, structtag is the - * struct tag, and structtype is the type of the preceding struct-like - * keyword. - */ -char *structtag = ""; -enum sym_type structtype; - -#ifdef OO_BROWSER -void -oo_browser_check_and_clear_structtype() -{ - /* Allow for multiple enum_label tags. */ - if (structtype != st_C_enum) - structtype = st_none; -} -#endif - -/* - * When objdef is different from onone, objtag is the name of the class. - */ -char *objtag = ""; - -/* - * Yet another little state machine to deal with preprocessor lines. - */ -enum -{ - dnone, /* nothing seen */ - dsharpseen, /* '#' seen as first char on line */ - ddefineseen, /* '#' and 'define' seen */ - dignorerest /* ignore rest of line */ -} definedef; - -/* - * State machine for Objective C protocols and implementations. - * Tom R.Hageman - */ -enum -{ - onone, /* nothing seen */ - oprotocol, /* @interface or @protocol seen */ - oimplementation, /* @implementations seen */ - otagseen, /* class name seen */ - oparenseen, /* parenthesis before category seen */ - ocatseen, /* category name seen */ - oinbody, /* in @implementation body */ - omethodsign, /* in @implementation body, after +/- */ - omethodtag, /* after method name */ - omethodcolon, /* after method colon */ - omethodparm, /* after method parameter */ - oignore /* wait for @end */ -} objdef; - -/* - * Use this structure to keep info about the token read, and how it - * should be tagged. Used by the make_C_tag function to build a tag. - */ -typedef struct -{ - bool valid; - char *str; - bool named; - int linelen; - int lineno; - long linepos; - char *buffer; -} token; - -token tok; /* latest token read */ - -/* - * Set this to TRUE, and the next token considered is called a function. - * Used only for GNU emacs's function-defining macros. - */ -bool next_token_is_func; - -/* - * TRUE in the rules part of a yacc file, FALSE outside (parse as C). - */ -bool yacc_rules; - -/* - * methodlen is the length of the method name stored in token_name. - */ -int methodlen; - -#ifdef OO_BROWSER -void -oo_browser_clear_all_globals() -{ - /* Initialize globals so there is no carry over between files. */ - oo_browser_construct = C_NULL; - fvdef = fvnone; typdef = tnone; structdef = snone; - definedef = dnone; objdef = onone; - structtype = st_none; - next_token_is_func = yacc_rules = FALSE; -} - -void -oo_browser_clear_some_globals() -{ - oo_browser_construct = C_NULL; - structtype = st_none; -} -#endif - -/* - * consider_token () - * checks to see if the current token is at the start of a - * function or variable, or corresponds to a typedef, or - * is a struct/union/enum tag, or #define, or an enum constant. - * - * *IS_FUNC gets TRUE iff the token is a function or #define macro - * with args. C_EXT is which language we are looking at. - * - * In the future we will need some way to adjust where the end of - * the token is; for instance, implementing the C++ keyword - * `operator' properly will adjust the end of the token to be after - * whatever follows `operator'. - * - * Globals - * fvdef IN OUT - * structdef IN OUT - * definedef IN OUT - * typdef IN OUT - * objdef IN OUT - * next_token_is_func IN OUT - */ -bool consider_token PP ((char *str, int len, int c, int c_ext, - int cblev, int parlev, bool *is_func_or_var)); -bool -consider_token (str, len, c, c_ext, cblev, parlev, is_func_or_var) - register char *str; /* IN: token pointer */ - register int len; /* IN: token length */ - register int c; /* IN: first char after the token */ - int c_ext; /* IN: C extensions mask */ - int cblev; /* IN: curly brace level */ - int parlev; /* IN: parenthesis level */ - bool *is_func_or_var; /* OUT: function or variable found */ -{ - enum sym_type toktype = C_symtype (str, len, c_ext); - -#ifdef OO_BROWSER - switch (toktype) - { - case st_C_struct: - set_construct(C_STRUCTURE); - break; - case st_C_union: - set_construct(C_UNION); - break; - case st_C_class: - set_construct(C_CLASS); - break; - case st_C_enum: - set_construct(C_ENUMERATION); - break; - case st_C_typedef: - set_construct(C_TYPE); - break; - case st_C_extern: - set_construct(C_EXTERN); - break; - case st_C_inline: - set_construct(C_FUNCTION); - break; - } -#endif - - /* - * Advance the definedef state machine. - */ - switch (definedef) - { - case dnone: - /* We're not on a preprocessor line. */ - break; - case dsharpseen: - if (toktype == st_C_define) - { - definedef = ddefineseen; - } - else - { - definedef = dignorerest; - } - return FALSE; - case ddefineseen: - /* - * Make a tag for any macro, unless it is a constant - * and constantypedefs is FALSE. - */ - definedef = dignorerest; -#ifndef OO_BROWSER - *is_func_or_var = (c == '('); -#else - { - char *p = str + len * sizeof(char); - - if (*p == '(') - /* This must be a macro since there is no - whitespace between the opening parenthesis - and the definition name. */ - *is_func_or_var = TRUE; - else - { - *is_func_or_var = FALSE; - - /* Handle possible whitespace between macro tag and opening - parenthesis and ensure this is an actual macro. - -- Bob Weiner, Altrasoft, 11/19/1997 */ - while (*p && isspace(*p)) p++; - if (*p) c = *p; - - /* Skip over nested parentheses. */ - if (c == '(') - { - short depth = 1; - - while (*++p && depth > 0 && *p != '\n') - { - switch (*p) - { - case '(': - depth++; break; - case ')': - depth--; break; - } - } - - /* If this is a macro, we have just passed - the arguments and there will be more on - the line before the NULL character that marks - the end of the line token. */ - while (*p == ' ' || *p == '\t') p++; - if (*p) *is_func_or_var = TRUE; - } - } - } - - set_construct((*is_func_or_var) ? C_MACRO : C_CONSTANT); -#endif - if (!*is_func_or_var && !constantypedefs) - return FALSE; - else - return TRUE; - case dignorerest: - return FALSE; - default: - error ("internal error: definedef value.", (char *)NULL); - } - - /* - * Now typedefs - */ - switch (typdef) - { - case tnone: - if (toktype == st_C_typedef) - { - if (typedefs) - typdef = ttypedseen; - fvdef = fvnone; - return FALSE; - } - break; - case ttypedseen: - switch (toktype) - { - case st_C_const: - set_construct(C_CONSTANT); - /* fall through */ - case st_none: - case st_C_typespec: -#ifdef OO_BROWSER - case st_C_extern: -#endif - typdef = tend; - break; - case st_C_struct: - case st_C_enum: -#ifdef OO_BROWSER - case st_C_union: - case st_C_class: -#endif - break; - } - /* Do not return here, so the structdef stuff has a chance. */ - break; - case tend: - switch (toktype) - { - case st_C_const: - set_construct(C_CONSTANT); - /* fall through */ - case st_C_typespec: - case st_C_struct: - case st_C_enum: -#ifdef OO_BROWSER - case st_C_extern: - case st_C_union: - case st_C_class: -#endif - return FALSE; - } - return TRUE; - } - - /* - * This structdef business is currently only invoked when cblev==0. - * It should be recursively invoked whatever the curly brace level, - * and a stack of states kept, to allow for definitions of structs - * within structs. - * - * This structdef business is NOT invoked when we are ctags and the - * file is plain C. This is because a struct tag may have the same - * name as another tag, and this loses with ctags. - */ - switch (toktype) - { - case st_C_javastruct: - if (structdef == stagseen) - structdef = scolonseen; - return FALSE; - case st_C_struct: - case st_C_enum: -#ifdef OO_BROWSER - case st_C_union: - case st_C_class: - case st_C_extern: -#endif - if (typdef == ttypedseen - || (typedefs_and_cplusplus && cblev == 0 && structdef == snone)) - { - structdef = skeyseen; - structtype = toktype; - } - return FALSE; - } - - if (structdef == skeyseen) - { - /* Save the tag for struct/union/class, for functions and variables - that may be defined inside. */ -#ifndef OO_BROWSER - if (structtype == st_C_struct) -#else - if (structtype == st_C_struct - || structtype == st_C_union - || structtype == st_C_class) -#endif - structtag = savenstr (str, len); - else - structtag = ""; - structdef = stagseen; - return TRUE; - } - - /* Avoid entering fvdef stuff if typdef is going on. */ - if (typdef != tnone) - { - definedef = dnone; - return FALSE; - } - - /* Detect GNU macros. - - DEFUN note for writers of emacs C code: - The DEFUN macro, used in emacs C source code, has a first arg - that is a string (the lisp function name), and a second arg that - is a C function name. Since etags skips strings, the second arg - is tagged. This is unfortunate, as it would be better to tag the - first arg. The simplest way to deal with this problem would be - to name the tag with a name built from the function name, by - removing the initial 'F' character and substituting '-' for '_'. - Anyway, this assumes that the conventions of naming lisp - functions will never change. Currently, this method is not - implemented, so writers of emacs code are recommended to put the - first two args of a DEFUN on the same line. */ - if (definedef == dnone && toktype == st_C_gnumacro) - { - next_token_is_func = TRUE; - return FALSE; - } - if (next_token_is_func) - { - next_token_is_func = FALSE; - fvdef = fignore; - *is_func_or_var = TRUE; - return TRUE; - } - - /* Detect Objective C constructs. */ - switch (objdef) - { - case onone: - switch (toktype) - { - case st_C_objprot: -#ifdef OO_BROWSER - set_construct(C_OBJC); -#endif - objdef = oprotocol; - return FALSE; - case st_C_objimpl: -#ifdef OO_BROWSER - set_construct(C_OBJC); -#endif - objdef = oimplementation; - return FALSE; - } - break; - case oimplementation: - /* Save the class tag for functions or variables defined inside. */ - objtag = savenstr (str, len); - objdef = oinbody; - return FALSE; - case oprotocol: - /* Save the class tag for categories. */ - objtag = savenstr (str, len); - objdef = otagseen; - *is_func_or_var = TRUE; - return TRUE; - case oparenseen: - objdef = ocatseen; - *is_func_or_var = TRUE; - return TRUE; - case oinbody: - break; - case omethodsign: - if (parlev == 0) - { - objdef = omethodtag; - methodlen = len; - grow_linebuffer (&token_name, methodlen + 1); - strncpy (token_name.buffer, str, len); - token_name.buffer[methodlen] = '\0'; - token_name.len = methodlen; - return TRUE; - } - return FALSE; - case omethodcolon: - if (parlev == 0) - objdef = omethodparm; - return FALSE; - case omethodparm: - if (parlev == 0) - { - objdef = omethodtag; - methodlen += len; - grow_linebuffer (&token_name, methodlen + 1); - strncat (token_name.buffer, str, len); - token_name.len = methodlen; - return TRUE; - } - return FALSE; - case oignore: - if (toktype == st_C_objend) - { - /* Memory leakage here: the string pointed by objtag is - never released, because many tests would be needed to - avoid breaking on incorrect input code. The amount of - memory leaked here is the sum of the lengths of the - class tags. - free (objtag); */ - objdef = onone; - } - return FALSE; - } - - /* A function, variable or enum constant? */ - switch (toktype) - { - case st_C_const: - set_construct(C_CONSTANT); - /* fall through */ - case st_C_typespec: -#ifdef OO_BROWSER - case st_C_extern: -#endif - if (fvdef != finlist && fvdef != fignore && fvdef != vignore) - fvdef = fvnone; /* should be useless */ - return FALSE; - case st_C_ignore: - fvdef = vignore; - return FALSE; - case st_none: - if (constantypedefs && structdef == sinbody && structtype == st_C_enum) -#ifdef OO_BROWSER - { - oo_browser_construct = C_ENUM_LABEL; -#endif - return TRUE; -#ifdef OO_BROWSER - } -#endif - if (fvdef == fvnone) - { - fvdef = fvnameseen; /* function or variable */ - *is_func_or_var = TRUE; - return TRUE; - } - } - - return FALSE; -} - -/* - * C_entries () - * This routine finds functions, variables, typedefs, - * #define's, enum constants and struct/union/enum definitions in - * #C syntax and adds them to the list. - */ -#define current_lb_is_new (newndx == curndx) -#define switch_line_buffers() (curndx = 1 - curndx) - -#define curlb (lbs[curndx].lb) -#define othlb (lbs[1-curndx].lb) -#define newlb (lbs[newndx].lb) -#define curlinepos (lbs[curndx].linepos) -#define othlinepos (lbs[1-curndx].linepos) -#define newlinepos (lbs[newndx].linepos) - -#define CNL_SAVE_DEFINEDEF() \ -do { \ - curlinepos = charno; \ - lineno++; \ - linecharno = charno; \ - charno += readline (&curlb, inf); \ - lp = curlb.buffer; \ - quotednl = FALSE; \ - newndx = curndx; \ -} while (0) - -#define CNL() \ -do { \ - CNL_SAVE_DEFINEDEF(); \ - if (savetok.valid) \ - { \ - tok = savetok; \ - savetok.valid = FALSE; \ - } \ - definedef = dnone; \ -} while (0) - - -void make_C_tag PP ((bool isfun)); -void -make_C_tag (isfun) - bool isfun; -{ - /* This function should never be called when tok.valid is FALSE, but - we must protect against invalid input or internal errors. */ - if (tok.valid) - { - if (traditional_tag_style) - { - /* This was the original code. Now we call new_pfnote instead, - which uses the new method for naming tags (see new_pfnote). */ - char *name = NULL; - - if (CTAGS || tok.named) - name = savestr (token_name.buffer); - pfnote (name, isfun, - tok.buffer, tok.linelen, tok.lineno, tok.linepos); - } - else - new_pfnote (token_name.buffer, token_name.len, isfun, - tok.buffer, tok.linelen, tok.lineno, tok.linepos); - tok.valid = FALSE; - } - else if (DEBUG) - abort (); -} - - -void -C_entries (c_ext, inf) - int c_ext; /* extension of C */ - FILE *inf; /* input file */ -{ - register char c; /* latest char read; '\0' for end of line */ - register char *lp; /* pointer one beyond the character `c' */ - int curndx, newndx; /* indices for current and new lb */ - register int tokoff; /* offset in line of start of current token */ - register int toklen; /* length of current token */ - char *qualifier; /* string used to qualify names */ - int qlen; /* length of qualifier */ - int cblev; /* current curly brace level */ - int parlev; /* current parenthesis level */ - bool incomm, inquote, inchar, quotednl, midtoken; - bool cplpl, cjava; - token savetok; /* token saved during preprocessor handling */ - - - tokoff = toklen = 0; /* keep compiler quiet */ - curndx = newndx = 0; - lineno = 0; - charno = 0; - lp = curlb.buffer; - *lp = 0; - - fvdef = fvnone; typdef = tnone; structdef = snone; - definedef = dnone; objdef = onone; - next_token_is_func = yacc_rules = FALSE; - midtoken = inquote = inchar = incomm = quotednl = FALSE; - tok.valid = savetok.valid = FALSE; - cblev = 0; - parlev = 0; - cplpl = (c_ext & C_PLPL) == C_PLPL; - cjava = (c_ext & C_JAVA) == C_JAVA; - if (cjava) - { qualifier = "."; qlen = 1; } - else - { qualifier = "::"; qlen = 2; } - - while (!feof (inf)) - { - c = *lp++; - if (c == '\\') - { - /* If we're at the end of the line, the next character is a - '\0'; don't skip it, because it's the thing that tells us - to read the next line. */ - if (*lp == '\0') - { - quotednl = TRUE; - continue; - } - lp++; - c = ' '; - } - else if (incomm) - { - switch (c) - { - case '*': - if (*lp == '/') - { - c = *lp++; - incomm = FALSE; - } - break; - case '\0': - /* Newlines inside comments do not end macro definitions in - traditional cpp. */ - CNL_SAVE_DEFINEDEF (); - break; - } - continue; - } - else if (inquote) - { - switch (c) - { - case '"': - inquote = FALSE; - break; - case '\0': - /* Newlines inside strings do not end macro definitions - in traditional cpp, even though compilers don't - usually accept them. */ - CNL_SAVE_DEFINEDEF (); - break; - } - continue; - } - else if (inchar) - { - switch (c) - { - case '\0': - /* Hmmm, something went wrong. */ - CNL (); - /* FALLTHRU */ - case '\'': - inchar = FALSE; - break; - } - continue; - } - else - switch (c) - { - case '"': - inquote = TRUE; - if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; - continue; - case '\'': - inchar = TRUE; - if (fvdef != finlist && fvdef != fignore && fvdef !=vignore) - fvdef = fvnone; - continue; - case '/': - if (*lp == '*') - { - lp++; - incomm = TRUE; - continue; - } - else if (/* cplpl && */ *lp == '/') - { - c = '\0'; - break; - } - else - break; - case '%': - if ((c_ext & YACC) && *lp == '%') - { - /* entering or exiting rules section in yacc file */ - lp++; - definedef = dnone; fvdef = fvnone; - typdef = tnone; structdef = snone; - next_token_is_func = FALSE; - midtoken = inquote = inchar = incomm = quotednl = FALSE; - cblev = 0; - yacc_rules = !yacc_rules; - continue; - } - else - break; - case '#': - if (definedef == dnone) - { - char *cp; - bool cpptoken = TRUE; - - /* Look back on this line. If all blanks, or nonblanks - followed by an end of comment, this is a preprocessor - token. */ - for (cp = newlb.buffer; cp < lp-1; cp++) - if (!iswhite (*cp)) - { - if (*cp == '*' && *(cp+1) == '/') - { - cp++; - cpptoken = TRUE; - } - else - cpptoken = FALSE; - } - if (cpptoken) - definedef = dsharpseen; - } /* if (definedef == dnone) */ - - continue; - } /* switch (c) */ - - - /* Consider token only if some complicated conditions are satisfied. */ - if ((definedef != dnone - || (cblev == 0 && structdef != scolonseen) - || (cblev == 1 && cplpl && structdef == sinbody) - || (structdef == sinbody && structtype == st_C_enum)) - && typdef != tignore - && definedef != dignorerest - && fvdef != finlist) - { - if (midtoken) - { - if (endtoken (c)) - { - if (c == ':' && cplpl && *lp == ':' && begtoken(*(lp + 1))) - { - /* - * This handles :: in the middle, but not at the - * beginning of an identifier. - */ - lp += 2; - toklen += 3; -#ifdef OO_BROWSER - set_construct(C_METHOD); -#endif - } - else - { - bool funorvar = FALSE; - - if (yacc_rules - || consider_token (newlb.buffer + tokoff, toklen, c, - c_ext, cblev, parlev, &funorvar)) - { - tok.named = FALSE; - if (structdef == sinbody - && definedef == dnone - && funorvar) - /* function or var defined in C++ class body */ - { - int len = strlen (structtag) + qlen + toklen; - grow_linebuffer (&token_name, len + 1); - strcpy (token_name.buffer, structtag); - strcat (token_name.buffer, qualifier); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - token_name.len = len; - tok.named = TRUE; -#ifdef OO_BROWSER - oo_browser_construct = C_METHOD; -#endif - } - else if (objdef == ocatseen) - /* Objective C category */ - { - int len = strlen (objtag) + 2 + toklen; - grow_linebuffer (&token_name, len + 1); - strcpy (token_name.buffer, objtag); - strcat (token_name.buffer, "("); - strncat (token_name.buffer, - newlb.buffer + tokoff, toklen); - strcat (token_name.buffer, ")"); - token_name.len = len; - tok.named = TRUE; -#ifdef OO_BROWSER - oo_browser_construct = C_OBJC; -#endif - } - else if (objdef == omethodtag - || objdef == omethodparm) - /* Objective C method */ - { - tok.named = TRUE; -#ifdef OO_BROWSER - oo_browser_construct = C_OBJC; -#endif - } - else - { - grow_linebuffer (&token_name, toklen + 1); - strncpy (token_name.buffer, - newlb.buffer + tokoff, toklen); - token_name.buffer[toklen] = '\0'; - token_name.len = toklen; - /* Name macros. */ - tok.named - = (structdef == stagseen - || typdef == tend -#ifdef OO_BROWSER - /* Also name #define constants, - enumerations and enum_labels. - Conditionalize `funorvar' reference - here or #defines will appear without - their #names. - -- Bob Weiner, Altrasoft, 4/25/1998 */ - || ((oo_browser_format || funorvar) - && definedef == dignorerest) - || (oo_browser_format - && (oo_browser_construct == C_ENUMERATION - || oo_browser_construct == C_ENUM_LABEL)) -#else - || (funorvar - && definedef == dignorerest) -#endif - ); - } - tok.lineno = lineno; - tok.linelen = tokoff + toklen + 1; - tok.buffer = newlb.buffer; - tok.linepos = newlinepos; - tok.valid = TRUE; - - if (definedef == dnone - && (fvdef == fvnameseen - || structdef == stagseen - || typdef == tend - || objdef != onone)) - { - if (current_lb_is_new) - switch_line_buffers (); - } - else - make_C_tag (funorvar); - } - midtoken = FALSE; - } - } /* if (endtoken (c)) */ - else if (intoken (c)) - { - toklen++; - continue; - } - } /* if (midtoken) */ - else if (begtoken (c)) - { - switch (definedef) - { - case dnone: - switch (fvdef) - { - case fstartlist: - fvdef = finlist; - continue; - case flistseen: -#ifdef OO_BROWSER - set_construct(C_MACRO); -#endif - make_C_tag (TRUE); /* a function */ - fvdef = fignore; - break; - case fvnameseen: - fvdef = fvnone; - break; - } - if (structdef == stagseen && !cjava) - structdef = snone; - break; - case dsharpseen: - savetok = tok; - } - if (!yacc_rules || lp == newlb.buffer + 1) - { - tokoff = lp - 1 - newlb.buffer; - toklen = 1; - midtoken = TRUE; - } - continue; - } /* if (begtoken) */ - } /* if must look at token */ - - - /* Detect end of line, colon, comma, semicolon and various braces - after having handled a token.*/ - switch (c) - { - case ':': - if (definedef != dnone) - break; - switch (objdef) - { - case otagseen: - objdef = oignore; - make_C_tag (TRUE); /* an Objective C class */ - break; - case omethodtag: - case omethodparm: - objdef = omethodcolon; - methodlen += 1; - grow_linebuffer (&token_name, methodlen + 1); - strcat (token_name.buffer, ":"); - token_name.len = methodlen; - break; - } - if (structdef == stagseen) - structdef = scolonseen; - else - switch (fvdef) - { - case fvnameseen: - if (yacc_rules) - { - make_C_tag (FALSE); /* a yacc function */ - fvdef = fignore; - } - break; - case fstartlist: - fvdef = fvnone; - break; - } - break; - case ';': - if (definedef != dnone) - break; - if (cblev == 0) - switch (typdef) - { - case tend: -#ifdef OO_BROWSER - set_construct(C_TYPE); -#endif - make_C_tag (FALSE); /* a typedef */ - /* FALLTHRU */ - default: - typdef = tnone; - } - switch (fvdef) - { - case fignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) -#ifndef OO_BROWSER - make_C_tag (FALSE); /* a variable */ -#else -/* if (constantypedefs && structdef == snone)*/ - { - tok.named = TRUE; - switch (structtype) - { - case st_C_enum: - set_construct(C_ENUMERATION); - break; - case st_C_class: - set_construct(C_CLASS); - break; - default: - set_construct(C_VARIABLE); - break; - } - make_C_tag (FALSE); - /* Force reset of st_C_enum structtype value. */ - structtype = st_none; - } -#endif - /* FALLTHRU */ - default: - fvdef = fvnone; - /* The following instruction invalidates the token. - Probably the token should be invalidated in all - other cases where some state machine is reset. */ - tok.valid = FALSE; - } - if (structdef == stagseen) - structdef = snone; - break; - case ',': - if (definedef != dnone) - break; - switch (objdef) - { - case omethodtag: - case omethodparm: - make_C_tag (TRUE); /* an Objective C method */ - objdef = oinbody; - break; - } - switch (fvdef) - { - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ - break; - default: - fvdef = fvnone; - } - if (structdef == stagseen) - structdef = snone; - break; - case '[': - if (definedef != dnone) - break; - if (cblev == 0 && typdef == tend) - { -#ifdef OO_BROWSER - set_construct(C_TYPE); -#endif - typdef = tignore; - make_C_tag (FALSE); /* a typedef */ - break; - } - switch (fvdef) - { - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: -#ifndef OO_BROWSER - if ((globals && cblev == 0) || (members && cblev == 1)) - make_C_tag (FALSE); /* a variable */ -#else - if (constantypedefs && structdef == snone) - { - tok.named = TRUE; - switch (structtype) - { - case st_C_enum: - set_construct(C_ENUMERATION); - break; - case st_C_class: - set_construct(C_CLASS); - break; - default: - set_construct(C_VARIABLE); - break; - } - make_C_tag (FALSE); - /* Force reset of st_C_enum structtype value. */ - structtype = st_none; - } -#endif - /* FALLTHRU */ - default: - fvdef = fvnone; - } - if (structdef == stagseen) - structdef = snone; - break; - case '(': - if (definedef != dnone) - break; - if (objdef == otagseen && parlev == 0) - objdef = oparenseen; - switch (fvdef) - { - case fvnone: - switch (typdef) - { - case ttypedseen: - case tend: - if (tok.valid && *lp != '*') - { - /* This handles constructs like: - typedef void OperatorFun (int fun); */ - typdef = tignore; -#ifdef OO_BROWSER - set_construct(C_TYPE); -#endif - make_C_tag (FALSE); - } - break; - } /* switch (typdef) */ - break; - case fvnameseen: - fvdef = fstartlist; - break; - case flistseen: - fvdef = finlist; - break; - } - parlev++; - break; - case ')': - if (definedef != dnone) - break; - if (objdef == ocatseen && parlev == 1) - { - make_C_tag (TRUE); /* an Objective C category */ - objdef = oignore; - } - if (--parlev == 0) - { - switch (fvdef) - { - case fstartlist: - case finlist: - fvdef = flistseen; - break; - } - if (cblev == 0 && typdef == tend) - { -#ifdef OO_BROWSER - set_construct(C_TYPE); -#endif - typdef = tignore; - make_C_tag (FALSE); /* a typedef */ - } - } - else if (parlev < 0) /* can happen due to ill-conceived #if's. */ - parlev = 0; - break; - case '{': - if (definedef != dnone) - break; - if (typdef == ttypedseen) - typdef = tinbody; - switch (structdef) - { - case skeyseen: /* unnamed struct */ - structdef = sinbody; - structtag = "_anonymous_"; - break; - case stagseen: - case scolonseen: /* named struct */ - structdef = sinbody; - make_C_tag (FALSE); /* a struct */ - break; - } - switch (fvdef) - { - case flistseen: -#ifdef OO_BROWSER - set_construct(C_FUNCTION); - /* Ensure function name is recorded. - -- Bob Weiner, Altrasoft */ - tok.named = TRUE; -#endif - make_C_tag (TRUE); /* a function */ - /* FALLTHRU */ - case fignore: - fvdef = fvnone; - break; - case fvnone: - switch (objdef) - { - case otagseen: - make_C_tag (TRUE); /* an Objective C class */ - objdef = oignore; - break; - case omethodtag: - case omethodparm: - make_C_tag (TRUE); /* an Objective C method */ - objdef = oinbody; - break; - default: - /* Neutralize `extern "C" {' grot. */ - if (cblev == 0 && structdef == snone && typdef == tnone) - cblev = -1; - } - } - cblev++; - break; - case '*': - if (definedef != dnone) - break; - if (fvdef == fstartlist) - fvdef = fvnone; /* avoid tagging `foo' in `foo (*bar()) ()' */ - break; - case '}': - if (definedef != dnone) - break; - if (!noindentypedefs && lp == newlb.buffer + 1) - { - cblev = 0; /* reset curly brace level if first column */ - parlev = 0; /* also reset paren level, just in case... */ - } - else if (cblev > 0) - cblev--; - if (cblev == 0) - { - if (typdef == tinbody) - typdef = tend; - /* Memory leakage here: the string pointed by structtag is - never released, because I fear to miss something and - break things while freeing the area. The amount of - memory leaked here is the sum of the lengths of the - struct tags. - if (structdef == sinbody) - free (structtag); */ - - structdef = snone; - structtag = ""; -#ifdef OO_BROWSER - /* Next line added to avoid any state carryover between - functions. -- Bob Weiner, Altrasoft, 11/19/1997 */ - fvdef = fvnone; oo_browser_construct = C_NULL; -#endif - } - break; - case '=': - if (definedef != dnone) - break; -#ifdef OO_BROWSER - { - int is_method = 0; -#endif - switch (fvdef) - { - case finlist: - case fignore: - case vignore: - break; - case fvnameseen: - if ((globals && cblev == 0) || (members && cblev == 1)) -#ifndef OO_BROWSER - make_C_tag (FALSE); /* a variable */ -#else - { - tok.named = TRUE; - switch (structtype) - { - case st_C_enum: - set_construct(C_ENUMERATION); - break; - case st_C_class: - set_construct(C_CLASS); - break; - default: - /* a global variable */ - set_construct(C_VARIABLE); - break; - } - - /* ootags categorizes each tag found whereas etags doesn't. - Set the is_method flag if this tag has been marked as - such by an earlier section of code. - -- Steve Baur, Altrasoft, 5/7/1998 */ - is_method = (oo_browser_construct == C_METHOD); - - make_C_tag (FALSE); - /* Force reset of st_C_enum structtype value. */ - structtype = st_none; - } -#endif - /* FALLTHRU */ - default: -#ifdef OO_BROWSER - fvdef = is_method ? fignore : vignore; -#else - fvdef = vignore; -#endif - } -#ifdef OO_BROWSER - } -#endif - break; - case '+': - case '-': - if (objdef == oinbody && cblev == 0) - { - objdef = omethodsign; - break; - } - /* FALLTHRU */ - case '#': case '~': case '&': case '%': case '/': case '|': - case '^': case '!': case '<': case '>': case '.': case '?': case ']': - if (definedef != dnone) - break; -#ifdef OO_BROWSER - if (!cplpl) - { -#endif - /* The above characters cannot follow a function tag in C, so - unmark this as a function entry. For C++, these characters - may follow an `operator' function construct, so skip the - unmarking conditional below. - -- Steve Baur, Altrasoft, 5/7/1998 */ - if (fvdef != finlist && fvdef != fignore && fvdef != vignore) - fvdef = fvnone; -#ifdef OO_BROWSER - } -#endif - break; - case '\0': - if (objdef == otagseen) - { - make_C_tag (TRUE); /* an Objective C class */ - objdef = oignore; - } - /* If a macro spans multiple lines don't reset its state. */ - if (quotednl) - CNL_SAVE_DEFINEDEF (); - else - CNL (); - break; - } /* switch (c) */ - - } /* while not eof */ -} - -/* - * Process either a C++ file or a C file depending on the setting - * of a global flag. - */ -void -default_C_entries (inf) - FILE *inf; -{ - C_entries (cplusplus ? C_PLPL : 0, inf); -} - -/* Always do plain ANSI C. */ -void -plain_C_entries (inf) - FILE *inf; -{ - C_entries (0, inf); -} - -/* Always do C++. */ -void -Cplusplus_entries (inf) - FILE *inf; -{ - C_entries (C_PLPL, inf); -} - -/* Always do Java. */ -void -Cjava_entries (inf) - FILE *inf; -{ - C_entries (C_JAVA, inf); -} - -/* Always do C*. */ -void -Cstar_entries (inf) - FILE *inf; -{ - C_entries (C_STAR, inf); -} - -/* Always do Yacc. */ -void -Yacc_entries (inf) - FILE *inf; -{ - C_entries (YACC, inf); -} - -/* A useful macro. */ -#define LOOP_ON_INPUT_LINES(file_pointer, line_buffer, char_pointer) \ - for (lineno = charno = 0; /* loop initialization */ \ - !feof (file_pointer) /* loop test */ \ - && (lineno++, /* instructions at start of loop */ \ - linecharno = charno, \ - charno += readline (&line_buffer, file_pointer), \ - char_pointer = lb.buffer, \ - TRUE); \ - ) - - -/* - * Read a file, but do no processing. This is used to do regexp - * matching on files that have no language defined. - */ -void -just_read_file (inf) - FILE *inf; -{ - register char *dummy; - - LOOP_ON_INPUT_LINES (inf, lb, dummy) - continue; -} - -/* Fortran parsing */ - -bool tail PP ((char *cp)); -bool -tail (cp) - char *cp; -{ - register int len = 0; - - while (*cp && lowcase(*cp) == lowcase(dbp[len])) - cp++, len++; - if (*cp == '\0' && !intoken(dbp[len])) - { - dbp += len; - return TRUE; - } - return FALSE; -} - -void -takeprec () -{ - dbp = skip_spaces (dbp); - if (*dbp != '*') - return; - dbp++; - dbp = skip_spaces (dbp); - if (strneq (dbp, "(*)", 3)) - { - dbp += 3; - return; - } - if (!isdigit (*dbp)) - { - --dbp; /* force failure */ - return; - } - do - dbp++; - while (isdigit (*dbp)); -} - -void getit PP ((FILE *inf)); -void -getit (inf) - FILE *inf; -{ - register char *cp; - - dbp = skip_spaces (dbp); - if (*dbp == '\0') - { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (dbp[5] != '&') - return; - dbp += 6; - dbp = skip_spaces (dbp); - } - if (!isalpha (*dbp) - && *dbp != '_' - && *dbp != '$') - return; - for (cp = dbp + 1; *cp && intoken (*cp); cp++) - continue; - pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - - -void -Fortran_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (*dbp == '%') - dbp++; /* Ratfor escape to fortran */ - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - switch (lowcase (*dbp)) - { - case 'i': - if (tail ("integer")) - takeprec (); - break; - case 'r': - if (tail ("real")) - takeprec (); - break; - case 'l': - if (tail ("logical")) - takeprec (); - break; - case 'c': - if (tail ("complex") || tail ("character")) - takeprec (); - break; - case 'd': - if (tail ("double")) - { - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - if (tail ("precision")) - break; - continue; - } - break; - } - dbp = skip_spaces (dbp); - if (*dbp == '\0') - continue; - switch (lowcase (*dbp)) - { - case 'f': - if (tail ("function")) - getit (inf); - continue; - case 's': - if (tail ("subroutine")) - getit (inf); - continue; - case 'e': - if (tail ("entry")) - getit (inf); - continue; - case 'p': - if (tail ("program")) - { - getit (inf); - continue; - } - if (tail ("procedure")) - getit (inf); - continue; - } - } -} - -/* - * Bob Weiner, Motorola Inc., 4/3/94 - * Unix and microcontroller assembly tag handling - * look for '^[a-zA-Z_.$][a-zA_Z0-9_.$]*[: ^I^J]' - */ -void -Asm_labels (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - /* If first char is alphabetic or one of [_.$], test for colon - following identifier. */ - if (isalpha (*cp) || *cp == '_' || *cp == '.' || *cp == '$') - { - /* Read past label. */ - cp++; - while (isalnum (*cp) || *cp == '_' || *cp == '.' || *cp == '$') - cp++; - if (*cp == ':' || isspace (*cp)) - { - /* Found end of label, so copy it and add it to the table. */ - pfnote ((CTAGS) ? savenstr(lb.buffer, cp-lb.buffer) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } - } -} - -/* - * Perl support by Bart Robinson - * enhanced by Michael Ernst - * Perl sub names: look for /^sub[ \t\n]+[^ \t\n{]+/ - * Perl variable names: /^(my|local).../ - */ -void -Perl_functions (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (*cp++ == 's' - && *cp++ == 'u' - && *cp++ == 'b' && isspace (*cp++)) - { - cp = skip_spaces (cp); - if (*cp != '\0') - { - while (*cp != '\0' - && !isspace (*cp) && *cp != '{' && *cp != '(') - cp++; - pfnote ((CTAGS) ? savenstr(lb.buffer, cp-lb.buffer) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } - else if (globals /* only if tagging global vars is enabled */ - && ((cp = lb.buffer, - *cp++ == 'm' - && *cp++ == 'y') - || (cp = lb.buffer, - *cp++ == 'l' - && *cp++ == 'o' - && *cp++ == 'c' - && *cp++ == 'a' - && *cp++ == 'l')) - && (*cp == '(' || isspace (*cp))) - { - /* After "my" or "local", but before any following paren or space. */ - char *varname = NULL; - - cp = skip_spaces (cp); - if (*cp == '$' || *cp == '@' || *cp == '%') - { - char* varstart = ++cp; - while (isalnum (*cp) || *cp == '_') - cp++; - varname = savenstr (varstart, cp-varstart); - } - else - { - /* Should be examining a variable list at this point; - could insist on seeing an open parenthesis. */ - while (*cp != '\0' && *cp != ';' && *cp != '=' && *cp != ')') - cp++; - } - - /* Perhaps I should back cp up one character, so the TAGS table - doesn't mention (and so depend upon) the following char. */ - pfnote ((CTAGS) ? savenstr (lb.buffer, cp-lb.buffer) : varname, - FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } -} - -/* - * Python support by Eric S. Raymond - * Look for /^def[ \t\n]+[^ \t\n(:]+/ or /^class[ \t\n]+[^ \t\n(:]+/ - */ -void -Python_functions (inf) - FILE *inf; -{ - register char *cp; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (*cp++ == 'd' - && *cp++ == 'e' - && *cp++ == 'f' && isspace (*cp++)) - { - cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') - cp++; - pfnote ((char *) NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - - cp = lb.buffer; - if (*cp++ == 'c' - && *cp++ == 'l' - && *cp++ == 'a' - && *cp++ == 's' - && *cp++ == 's' && isspace (*cp++)) - { - cp = skip_spaces (cp); - while (*cp != '\0' && !isspace (*cp) && *cp != '(' && *cp != ':') - cp++; - pfnote ((char *) NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); - } - } -} - -/* Idea by Corny de Souza - * Cobol tag functions - * We could look for anything that could be a paragraph name. - * i.e. anything that starts in column 8 is one word and ends in a full stop. - */ -void -Cobol_paragraphs (inf) - FILE *inf; -{ - register char *bp, *ep; - - LOOP_ON_INPUT_LINES (inf, lb, bp) - { - if (lb.len < 9) - continue; - bp += 8; - - /* If eoln, compiler option or comment ignore whole line. */ - if (bp[-1] != ' ' || !isalnum (bp[0])) - continue; - - for (ep = bp; isalnum (*ep) || *ep == '-'; ep++) - continue; - if (*ep++ == '.') - pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, - lb.buffer, ep - lb.buffer + 1, lineno, linecharno); - } -} - -/* Added by Mosur Mohan, 4/22/88 */ -/* Pascal parsing */ - -/* - * Locates tags for procedures & functions. Doesn't do any type- or - * var-definitions. It does look for the keyword "extern" or - * "forward" immediately following the procedure statement; if found, - * the tag is skipped. - */ -void -Pascal_functions (inf) - FILE *inf; -{ - linebuffer tline; /* mostly copied from C_entries */ - long save_lcno; - int save_lineno, save_len; - char c, *cp, *namebuf; - - bool /* each of these flags is TRUE iff: */ - incomment, /* point is inside a comment */ - inquote, /* point is inside '..' string */ - get_tagname, /* point is after PROCEDURE/FUNCTION - keyword, so next item = potential tag */ - found_tag, /* point is after a potential tag */ - inparms, /* point is within parameter-list */ - verify_tag; /* point has passed the parm-list, so the - next token will determine whether this - is a FORWARD/EXTERN to be ignored, or - whether it is a real tag */ - - save_lcno = save_lineno = save_len = 0; /* keep compiler quiet */ - namebuf = NULL; /* keep compiler quiet */ - lineno = 0; - charno = 0; - dbp = lb.buffer; - *dbp = '\0'; - initbuffer (&tline); - - incomment = inquote = FALSE; - found_tag = FALSE; /* have a proc name; check if extern */ - get_tagname = FALSE; /* have found "procedure" keyword */ - inparms = FALSE; /* found '(' after "proc" */ - verify_tag = FALSE; /* check if "extern" is ahead */ - - - while (!feof (inf)) /* long main loop to get next char */ - { - c = *dbp++; - if (c == '\0') /* if end of line */ - { - lineno++; - linecharno = charno; - charno += readline (&lb, inf); - dbp = lb.buffer; - if (*dbp == '\0') - continue; - if (!((found_tag && verify_tag) - || get_tagname)) - c = *dbp++; /* only if don't need *dbp pointing - to the beginning of the name of - the procedure or function */ - } - if (incomment) - { - if (c == '}') /* within { } comments */ - incomment = FALSE; - else if (c == '*' && *dbp == ')') /* within (* *) comments */ - { - dbp++; - incomment = FALSE; - } - continue; - } - else if (inquote) - { - if (c == '\'') - inquote = FALSE; - continue; - } - else - switch (c) - { - case '\'': - inquote = TRUE; /* found first quote */ - continue; - case '{': /* found open { comment */ - incomment = TRUE; - continue; - case '(': - if (*dbp == '*') /* found open (* comment */ - { - incomment = TRUE; - dbp++; - } - else if (found_tag) /* found '(' after tag, i.e., parm-list */ - inparms = TRUE; - continue; - case ')': /* end of parms list */ - if (inparms) - inparms = FALSE; - continue; - case ';': - if (found_tag && !inparms) /* end of proc or fn stmt */ - { - verify_tag = TRUE; - break; - } - continue; - } - if (found_tag && verify_tag && (*dbp != ' ')) - { - /* check if this is an "extern" declaration */ - if (*dbp == '\0') - continue; - if (lowcase (*dbp == 'e')) - { - if (tail ("extern")) /* superfluous, really! */ - { - found_tag = FALSE; - verify_tag = FALSE; - } - } - else if (lowcase (*dbp) == 'f') - { - if (tail ("forward")) /* check for forward reference */ - { - found_tag = FALSE; - verify_tag = FALSE; - } - } - if (found_tag && verify_tag) /* not external proc, so make tag */ - { - found_tag = FALSE; - verify_tag = FALSE; - pfnote (namebuf, TRUE, - tline.buffer, save_len, save_lineno, save_lcno); - continue; - } - } - if (get_tagname) /* grab name of proc or fn */ - { - if (*dbp == '\0') - continue; - - /* save all values for later tagging */ - grow_linebuffer (&tline, lb.len + 1); - strcpy (tline.buffer, lb.buffer); - save_lineno = lineno; - save_lcno = linecharno; - - /* grab block name */ - for (cp = dbp + 1; *cp != '\0' && !endtoken (*cp); cp++) - continue; - namebuf = (CTAGS) ? savenstr (dbp, cp-dbp) : NULL; - dbp = cp; /* set dbp to e-o-token */ - save_len = dbp - lb.buffer + 1; - get_tagname = FALSE; - found_tag = TRUE; - continue; - - /* and proceed to check for "extern" */ - } - else if (!incomment && !inquote && !found_tag) - { - /* check for proc/fn keywords */ - switch (lowcase (c)) - { - case 'p': - if (tail ("rocedure")) /* c = 'p', dbp has advanced */ - get_tagname = TRUE; - continue; - case 'f': - if (tail ("unction")) - get_tagname = TRUE; - continue; - } - } - } /* while not eof */ - - free (tline.buffer); -} - -/* - * lisp tag functions - * look for (def or (DEF, quote or QUOTE - */ -int L_isdef PP ((char *strp)); -int -L_isdef (strp) - register char *strp; -{ - return ((strp[1] == 'd' || strp[1] == 'D') - && (strp[2] == 'e' || strp[2] == 'E') - && (strp[3] == 'f' || strp[3] == 'F')); -} -int L_isquote PP ((char *strp)); -int -L_isquote (strp) - register char *strp; -{ - return ((*++strp == 'q' || *strp == 'Q') - && (*++strp == 'u' || *strp == 'U') - && (*++strp == 'o' || *strp == 'O') - && (*++strp == 't' || *strp == 'T') - && (*++strp == 'e' || *strp == 'E') - && isspace (*++strp)); -} - -void L_getit PP ((void)); -void -L_getit () -{ - register char *cp; - - if (*dbp == '\'') /* Skip prefix quote */ - dbp++; - else if (*dbp == '(') - { - if (L_isquote (dbp)) - dbp += 7; /* Skip "(quote " */ - else - dbp += 1; /* Skip "(" before name in (defstruct (foo)) */ - dbp = skip_spaces (dbp); - } - - for (cp = dbp /*+1*/; - *cp != '\0' && *cp != '(' && *cp != ' ' && *cp != ')'; - cp++) - continue; - if (cp == dbp) - return; - - pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - -void -Lisp_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (dbp[0] == '(') - { - if (L_isdef (dbp)) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - L_getit (); - } - else - { - /* Check for (foo::defmumble name-defined ... */ - do - dbp++; - while (*dbp != '\0' && !isspace (*dbp) - && *dbp != ':' && *dbp != '(' && *dbp != ')'); - if (*dbp == ':') - { - do - dbp++; - while (*dbp == ':'); - - if (L_isdef (dbp - 1)) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - L_getit (); - } - } - } - } - } -} - -/* - * Postscript tag functions - * Just look for lines where the first character is '/' - * Richard Mlynarik - */ -void -Postscript_functions (inf) - FILE *inf; -{ - register char *bp, *ep; - - LOOP_ON_INPUT_LINES (inf, lb, bp) - { - if (bp[0] == '/') - { - for (ep = bp+1; - *ep != '\0' && *ep != ' ' && *ep != '{'; - ep++) - continue; - pfnote ((CTAGS) ? savenstr (bp, ep-bp) : NULL, TRUE, - lb.buffer, ep - lb.buffer + 1, lineno, linecharno); - } - } -} - - -/* - * Scheme tag functions - * look for (def... xyzzy - * look for (def... (xyzzy - * look for (def ... ((...(xyzzy .... - * look for (set! xyzzy - */ - -void get_scheme PP ((void)); - -void -Scheme_functions (inf) - FILE *inf; -{ - LOOP_ON_INPUT_LINES (inf, lb, dbp) - { - if (dbp[0] == '(' - && (dbp[1] == 'D' || dbp[1] == 'd') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'F' || dbp[3] == 'f')) - { - dbp = skip_non_spaces (dbp); - /* Skip over open parens and white space */ - while (isspace (*dbp) || *dbp == '(') - dbp++; - get_scheme (); - } - if (dbp[0] == '(' - && (dbp[1] == 'S' || dbp[1] == 's') - && (dbp[2] == 'E' || dbp[2] == 'e') - && (dbp[3] == 'T' || dbp[3] == 't') - && (dbp[4] == '!' || dbp[4] == '!') - && (isspace (dbp[5]))) - { - dbp = skip_non_spaces (dbp); - dbp = skip_spaces (dbp); - get_scheme (); - } - } -} - -void -get_scheme () -{ - register char *cp; - - if (*dbp == '\0') - return; - /* Go till you get to white space or a syntactic break */ - for (cp = dbp + 1; - *cp != '\0' && *cp != '(' && *cp != ')' && !isspace (*cp); - cp++) - continue; - pfnote ((CTAGS) ? savenstr (dbp, cp-dbp) : NULL, TRUE, - lb.buffer, cp - lb.buffer + 1, lineno, linecharno); -} - -/* Find tags in TeX and LaTeX input files. */ - -/* TEX_toktab is a table of TeX control sequences that define tags. - Each TEX_tabent records one such control sequence. - CONVERT THIS TO USE THE Stab TYPE!! */ -struct TEX_tabent -{ - char *name; - int len; -}; - -struct TEX_tabent *TEX_toktab = NULL; /* Table with tag tokens */ - -/* Default set of control sequences to put into TEX_toktab. - The value of environment var TEXTAGS is prepended to this. */ - -char *TEX_defenv = "\ -:chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ -:part:appendix:entry:index"; - -void TEX_mode PP ((FILE *inf)); -struct TEX_tabent *TEX_decode_env PP ((char *evarname, char *defenv)); -int TEX_Token PP ((char *cp)); - -char TEX_esc = '\\'; -char TEX_opgrp = '{'; -char TEX_clgrp = '}'; - -/* - * TeX/LaTeX scanning loop. - */ -void -TeX_functions (inf) - FILE *inf; -{ - char *cp, *lasthit; - register int i; - - /* Select either \ or ! as escape character. */ - TEX_mode (inf); - - /* Initialize token table once from environment. */ - if (!TEX_toktab) - TEX_toktab = TEX_decode_env ("TEXTAGS", TEX_defenv); - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - lasthit = cp; - /* Look at each esc in line. */ - while ((cp = etags_strchr (cp, TEX_esc)) != NULL) - { - if (*++cp == '\0') - break; - linecharno += cp - lasthit; - lasthit = cp; - i = TEX_Token (lasthit); - if (i >= 0) - { - /* We seem to include the TeX command in the tag name. - register char *p; - for (p = lasthit + TEX_toktab[i].len; - *p != '\0' && *p != TEX_clgrp; - p++) - continue; */ - pfnote (/*savenstr (lasthit, p-lasthit)*/ (char *)NULL, TRUE, - lb.buffer, lb.len, lineno, linecharno); - break; /* We only tag a line once */ - } - } - } -} - -#define TEX_LESC '\\' -#define TEX_SESC '!' -#define TEX_cmt '%' - -/* Figure out whether TeX's escapechar is '\\' or '!' and set grouping - chars accordingly. */ -void -TEX_mode (inf) - FILE *inf; -{ - int c; - - while ((c = getc (inf)) != EOF) - { - /* Skip to next line if we hit the TeX comment char. */ - if (c == TEX_cmt) - while (c != '\n') - c = getc (inf); - else if (c == TEX_LESC || c == TEX_SESC ) - break; - } - - if (c == TEX_LESC) - { - TEX_esc = TEX_LESC; - TEX_opgrp = '{'; - TEX_clgrp = '}'; - } - else - { - TEX_esc = TEX_SESC; - TEX_opgrp = '<'; - TEX_clgrp = '>'; - } - rewind (inf); -} - -/* Read environment and prepend it to the default string. - Build token table. */ -struct TEX_tabent * -TEX_decode_env (evarname, defenv) - char *evarname; - char *defenv; -{ - register char *env, *p; - - struct TEX_tabent *tab; - int size, i; - - /* Append default string to environment. */ - env = getenv (evarname); - if (!env) - env = defenv; - else - { - char *oldenv = env; - env = concat (oldenv, defenv, ""); - free (oldenv); - } - - /* Allocate a token table */ - for (size = 1, p = env; p;) - if ((p = etags_strchr (p, ':')) && *++p != '\0') - size++; - /* Add 1 to leave room for null terminator. */ - tab = xnew (size + 1, struct TEX_tabent); - - /* Unpack environment string into token table. Be careful about */ - /* zero-length strings (leading ':', "::" and trailing ':') */ - for (i = 0; *env;) - { - p = etags_strchr (env, ':'); - if (!p) /* End of environment string. */ - p = env + strlen (env); - if (p - env > 0) - { /* Only non-zero strings. */ - tab[i].name = savenstr (env, p - env); - tab[i].len = strlen (tab[i].name); - i++; - } - if (*p) - env = p + 1; - else - { - tab[i].name = NULL; /* Mark end of table. */ - tab[i].len = 0; - break; - } - } - return tab; -} - -/* If the text at CP matches one of the tag-defining TeX command names, - return the pointer to the first occurrence of that command in TEX_toktab. - Otherwise return -1. - Keep the capital `T' in `token' for dumb truncating compilers - (this distinguishes it from `TEX_toktab' */ -int -TEX_Token (cp) - char *cp; -{ - int i; - - for (i = 0; TEX_toktab[i].len > 0; i++) - if (strneq (TEX_toktab[i].name, cp, TEX_toktab[i].len)) - return i; - return -1; -} - -/* - * Prolog support (rewritten) by Anders Lindgren, Mar. 96 - * - * Assumes that the predicate starts at column 0. - * Only the first clause of a predicate is added. - */ -int prolog_pred PP ((char *s, char *last)); -void prolog_skip_comment PP ((linebuffer *plb, FILE *inf)); -int prolog_atom PP ((char *s, int pos)); - -void -Prolog_functions (inf) - FILE *inf; -{ - char *cp, *last; - int len; - int allocated; - - allocated = 0; - len = 0; - last = NULL; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (cp[0] == '\0') /* Empty line */ - continue; - else if (isspace (cp[0])) /* Not a predicate */ - continue; - else if (cp[0] == '/' && cp[1] == '*') /* comment. */ - prolog_skip_comment (&lb, inf); - else if ((len = prolog_pred (cp, last)) > 0) - { - /* Predicate. Store the function name so that we only - generate a tag for the first clause. */ - if (last == NULL) - last = xnew(len + 1, char); - else if (len + 1 > allocated) - last = xrnew (last, len + 1, char); - allocated = len + 1; - strncpy (last, cp, len); - last[len] = '\0'; - } - } -} - - -void -prolog_skip_comment (plb, inf) - linebuffer *plb; - FILE *inf; -{ - char *cp; - - do - { - for (cp = plb->buffer; *cp != '\0'; cp++) - if (cp[0] == '*' && cp[1] == '/') - return; - lineno++; - linecharno += readline (plb, inf); - } - while (!feof(inf)); -} - -/* - * A predicate definition is added if it matches: - * ( - * - * It is added to the tags database if it doesn't match the - * name of the previous clause header. - * - * Return the size of the name of the predicate, or 0 if no header - * was found. - */ -int -prolog_pred (s, last) - char *s; - char *last; /* Name of last clause. */ -{ - int pos; - int len; - - pos = prolog_atom (s, 0); - if (pos < 1) - return 0; - - len = pos; - pos = skip_spaces (s + pos) - s; - - if ((s[pos] == '(') || (s[pos] == '.')) - { - if (s[pos] == '(') - pos++; - - /* Save only the first clause. */ - if (last == NULL - || len != strlen (last) - || !strneq (s, last, len)) - { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); - return len; - } - } - return 0; -} - -/* - * Consume a Prolog atom. - * Return the number of bytes consumed, or -1 if there was an error. - * - * A prolog atom, in this context, could be one of: - * - An alphanumeric sequence, starting with a lower case letter. - * - A quoted arbitrary string. Single quotes can escape themselves. - * Backslash quotes everything. - */ -int -prolog_atom (s, pos) - char *s; - int pos; -{ - int origpos; - - origpos = pos; - - if (islower(s[pos]) || (s[pos] == '_')) - { - /* The atom is unquoted. */ - pos++; - while (isalnum(s[pos]) || (s[pos] == '_')) - { - pos++; - } - return pos - origpos; - } - else if (s[pos] == '\'') - { - pos++; - - while (1) - { - if (s[pos] == '\'') - { - pos++; - if (s[pos] != '\'') - break; - pos++; /* A double quote */ - } - else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ - return -1; - else if (s[pos] == '\\') - { - if (s[pos+1] == '\0') - return -1; - pos += 2; - } - else - pos++; - } - return pos - origpos; - } - else - return -1; -} - -/* - * Support for Erlang -- Anders Lindgren, Feb 1996. - * - * Generates tags for functions, defines, and records. - * - * Assumes that Erlang functions start at column 0. - */ -int erlang_func PP ((char *s, char *last)); -void erlang_attribute PP ((char *s)); -int erlang_atom PP ((char *s, int pos)); - -void -Erlang_functions (inf) - FILE *inf; -{ - char *cp, *last; - int len; - int allocated; - - allocated = 0; - len = 0; - last = NULL; - - LOOP_ON_INPUT_LINES (inf, lb, cp) - { - if (cp[0] == '\0') /* Empty line */ - continue; - else if (isspace (cp[0])) /* Not function nor attribute */ - continue; - else if (cp[0] == '%') /* comment */ - continue; - else if (cp[0] == '"') /* Sometimes, strings start in column one */ - continue; - else if (cp[0] == '-') /* attribute, e.g. "-define" */ - { - erlang_attribute (cp); - last = NULL; - } - else if ((len = erlang_func (cp, last)) > 0) - { - /* - * Function. Store the function name so that we only - * generates a tag for the first clause. - */ - if (last == NULL) - last = xnew (len + 1, char); - else if (len + 1 > allocated) - last = xrnew (last, len + 1, char); - allocated = len + 1; - strncpy (last, cp, len); - last[len] = '\0'; - } - } -} - - -/* - * A function definition is added if it matches: - * ( - * - * It is added to the tags database if it doesn't match the - * name of the previous clause header. - * - * Return the size of the name of the function, or 0 if no function - * was found. - */ -int -erlang_func (s, last) - char *s; - char *last; /* Name of last clause. */ -{ - int pos; - int len; - - pos = erlang_atom (s, 0); - if (pos < 1) - return 0; - - len = pos; - pos = skip_spaces (s + pos) - s; - - /* Save only the first clause. */ - if (s[pos++] == '(' - && (last == NULL - || len != strlen (last) - || !strneq (s, last, len))) - { - pfnote ((CTAGS) ? savenstr (s, len) : NULL, TRUE, - s, pos, lineno, linecharno); - return len; - } - - return 0; -} - - -/* - * Handle attributes. Currently, tags are generated for defines - * and records. - * - * They are on the form: - * -define(foo, bar). - * -define(Foo(M, N), M+N). - * -record(graph, {vtab = notable, cyclic = true}). - */ -void -erlang_attribute (s) - char *s; -{ - int pos; - int len; - - if (strneq (s, "-define", 7) || strneq (s, "-record", 7)) - { - pos = skip_spaces (s + 7) - s; - if (s[pos++] == '(') - { - pos = skip_spaces (s + pos) - s; - len = erlang_atom (s, pos); - if (len != 0) - pfnote ((CTAGS) ? savenstr (& s[pos], len) : NULL, TRUE, - s, pos + len, lineno, linecharno); - } - } - return; -} - - -/* - * Consume an Erlang atom (or variable). - * Return the number of bytes consumed, or -1 if there was an error. - */ -int -erlang_atom (s, pos) - char *s; - int pos; -{ - int origpos; - - origpos = pos; - - if (isalpha (s[pos]) || s[pos] == '_') - { - /* The atom is unquoted. */ - pos++; - while (isalnum (s[pos]) || s[pos] == '_') - pos++; - return pos - origpos; - } - else if (s[pos] == '\'') - { - pos++; - - while (1) - { - if (s[pos] == '\'') - { - pos++; - break; - } - else if (s[pos] == '\0') - /* Multiline quoted atoms are ignored. */ - return -1; - else if (s[pos] == '\\') - { - if (s[pos+1] == '\0') - return -1; - pos += 2; - } - else - pos++; - } - return pos - origpos; - } - else - return -1; -} - -#ifdef ETAGS_REGEXPS - -/* Take a string like "/blah/" and turn it into "blah", making sure - that the first and last characters are the same, and handling - quoted separator characters. Actually, stops on the occurrence of - an unquoted separator. Also turns "\t" into a Tab character. - Returns pointer to terminating separator. Works in place. Null - terminates name string. */ -char * scan_separators PP ((char *name)); -char * -scan_separators (name) - char *name; -{ - char sep = name[0]; - char *copyto = name; - bool quoted = FALSE; - - for (++name; *name != '\0'; ++name) - { - if (quoted) - { - if (*name == 't') - *copyto++ = '\t'; - else if (*name == sep) - *copyto++ = sep; - else - { - /* Something else is quoted, so preserve the quote. */ - *copyto++ = '\\'; - *copyto++ = *name; - } - quoted = FALSE; - } - else if (*name == '\\') - quoted = TRUE; - else if (*name == sep) - break; - else - *copyto++ = *name; - } - - /* Terminate copied string. */ - *copyto = '\0'; - return name; -} - -/* Look at the argument of --regex or --no-regex and do the right - thing. Same for each line of a regexp file. */ -void -analyse_regex (regex_arg) - char *regex_arg; -{ - if (regex_arg == NULL) - free_patterns (); /* --no-regex: remove existing regexps */ - - /* A real --regexp option or a line in a regexp file. */ - switch (regex_arg[0]) - { - /* Comments in regexp file or null arg to --regex. */ - case '\0': - case ' ': - case '\t': - break; - - /* Read a regex file. This is recursive and may result in a - loop, which will stop when the file descriptors are exhausted. */ - case '@': - { - FILE *regexfp; - linebuffer regexbuf; - char *regexfile = regex_arg + 1; - - /* regexfile is a file containing regexps, one per line. */ - regexfp = fopen (regexfile, "r"); - if (regexfp == NULL) - { - pfatal (regexfile); - return; - } - initbuffer (®exbuf); - while (readline_internal (®exbuf, regexfp) > 0) - analyse_regex (regexbuf.buffer); - free (regexbuf.buffer); - fclose (regexfp); - } - break; - - /* Regexp to be used for a specific language only. */ - case '{': - { - language *lang; - char *lang_name = regex_arg + 1; - char *cp; - - for (cp = lang_name; *cp != '}'; cp++) - if (*cp == '\0') - { - error ("unterminated language name in regex: %s", regex_arg); - return; - } - *cp = '\0'; - lang = get_language_from_name (lang_name); - if (lang == NULL) - return; - add_regex (cp + 1, lang); - } - break; - - /* Regexp to be used for any language. */ - default: - add_regex (regex_arg, NULL); - break; - } -} - -/* Turn a name, which is an ed-style (but Emacs syntax) regular - expression, into a real regular expression by compiling it. */ -void -add_regex (regexp_pattern, lang) - char *regexp_pattern; - language *lang; -{ - char *name; - const char *err; - struct re_pattern_buffer *patbuf; - pattern *pp; - - - if (regexp_pattern[strlen(regexp_pattern)-1] != regexp_pattern[0]) - { - error ("%s: unterminated regexp", regexp_pattern); - return; - } - name = scan_separators (regexp_pattern); - if (regexp_pattern[0] == '\0') - { - error ("null regexp", (char *)NULL); - return; - } - (void) scan_separators (name); - - patbuf = xnew (1, struct re_pattern_buffer); - patbuf->translate = NULL; - patbuf->fastmap = NULL; - patbuf->buffer = NULL; - patbuf->allocated = 0; - - err = re_compile_pattern (regexp_pattern, strlen (regexp_pattern), patbuf); - if (err != NULL) - { - error ("%s while compiling pattern", err); - return; - } - - pp = p_head; - p_head = xnew (1, pattern); - p_head->regex = savestr (regexp_pattern); - p_head->p_next = pp; - p_head->language = lang; - p_head->pattern = patbuf; - p_head->name_pattern = savestr (name); - p_head->error_signaled = FALSE; -} - -/* - * Do the substitutions indicated by the regular expression and - * arguments. - */ -char * substitute PP ((char *in, char *out, struct re_registers *regs)); -char * -substitute (in, out, regs) - char *in, *out; - struct re_registers *regs; -{ - char *result, *t; - int size, dig, diglen; - - result = NULL; - size = strlen (out); - - /* Pass 1: figure out how much to allocate by finding all \N strings. */ - if (out[size - 1] == '\\') - fatal ("pattern error in \"%s\"", out); - for (t = etags_strchr (out, '\\'); - t != NULL; - t = etags_strchr (t + 2, '\\')) - if (isdigit (t[1])) - { - dig = t[1] - '0'; - diglen = regs->end[dig] - regs->start[dig]; - size += diglen - 2; - } - else - size -= 1; - - /* Allocate space and do the substitutions. */ - result = xnew (size + 1, char); - - for (t = result; *out != '\0'; out++) - if (*out == '\\' && isdigit (*++out)) - { - /* Using "dig2" satisfies my debugger. Bleah. */ - dig = *out - '0'; - diglen = regs->end[dig] - regs->start[dig]; - strncpy (t, in + regs->start[dig], diglen); - t += diglen; - } - else - *t++ = *out; - *t = '\0'; - - if (DEBUG && (t > result + size || t - result != strlen (result))) - abort (); - - return result; -} - -/* Deallocate all patterns. */ -void -free_patterns () -{ - pattern *pp; - while (p_head != NULL) - { - pp = p_head->p_next; - free (p_head->regex); - free (p_head->name_pattern); - free (p_head); - p_head = pp; - } - return; -} - -#endif /* ETAGS_REGEXPS */ -/* Initialize a linebuffer for use */ -void -initbuffer (lbp) - linebuffer *lbp; -{ - lbp->size = 200; - lbp->buffer = xnew (200, char); -} - -/* - * Read a line of text from `stream' into `lbp', excluding the - * newline or CR-NL, if any. Return the number of characters read from - * `stream', which is the length of the line including the newline. - * - * On DOS or Windows we do not count the CR character, if any, before the - * NL, in the returned length; this mirrors the behavior of emacs on those - * platforms (for text files, it translates CR-NL to NL as it reads in the - * file). - */ -long -readline_internal (lbp, stream) - linebuffer *lbp; - register FILE *stream; -{ - char *buffer = lbp->buffer; - register char *p = lbp->buffer; - register char *pend; - int chars_deleted; - - pend = p + lbp->size; /* Separate to avoid 386/IX compiler bug. */ - - while (1) - { - register int c = getc (stream); - if (p == pend) - { - /* We're at the end of linebuffer: expand it. */ - lbp->size *= 2; - buffer = xrnew (buffer, lbp->size, char); - p += buffer - lbp->buffer; - pend = buffer + lbp->size; - lbp->buffer = buffer; - } - if (c == EOF) - { - *p = '\0'; - chars_deleted = 0; - break; - } - if (c == '\n') - { - if (p > buffer && p[-1] == '\r') - { - p -= 1; -#ifdef DOS_NT - /* Assume CRLF->LF translation will be performed by Emacs - when loading this file, so CRs won't appear in the buffer. - It would be cleaner to compensate within Emacs; - however, Emacs does not know how many CRs were deleted - before any given point in the file. */ - chars_deleted = 1; -#else - chars_deleted = 2; -#endif - } - else - { - chars_deleted = 1; - } - *p = '\0'; - break; - } - *p++ = c; - } - lbp->len = p - buffer; - - return lbp->len + chars_deleted; -} - -/* - * Like readline_internal, above, but in addition try to match the - * input line against relevant regular expressions. - */ -long -readline (lbp, stream) - linebuffer *lbp; - FILE *stream; -{ - /* Read new line. */ - long result = readline_internal (lbp, stream); -#ifdef ETAGS_REGEXPS - int match; - pattern *pp; - - /* Match against relevant patterns. */ - if (lbp->len > 0) - for (pp = p_head; pp != NULL; pp = pp->p_next) - { - /* Only use generic regexps or those for the current language. */ - if (pp->language != NULL && pp->language != curlang) - continue; - - match = re_match (pp->pattern, lbp->buffer, lbp->len, 0, &pp->regs); - switch (match) - { - case -2: - /* Some error. */ - if (!pp->error_signaled) - { - error ("error while matching \"%s\"", pp->regex); - pp->error_signaled = TRUE; - } - break; - case -1: - /* No match. */ - break; - default: - /* Match occurred. Construct a tag. */ - if (pp->name_pattern[0] != '\0') - { - /* Make a named tag. */ - char *name = substitute (lbp->buffer, - pp->name_pattern, &pp->regs); - if (name != NULL) - pfnote (name, TRUE, lbp->buffer, match, lineno, linecharno); - } - else - { - /* Make an unnamed tag. */ - pfnote ((char *)NULL, TRUE, - lbp->buffer, match, lineno, linecharno); - } - break; - } - } -#endif /* ETAGS_REGEXPS */ - - return result; -} - -/* - * Return a pointer to a space of size strlen(cp)+1 allocated - * with xnew where the string CP has been copied. - */ -char * -savestr (cp) - char *cp; -{ - return savenstr (cp, strlen (cp)); -} - -/* - * Return a pointer to a space of size LEN+1 allocated with xnew where - * the string CP has been copied for at most the first LEN characters. - */ -char * -savenstr (cp, len) - char *cp; - int len; -{ - register char *dp; - - dp = xnew (len + 1, char); - strncpy (dp, cp, len); - dp[len] = '\0'; - return dp; -} - -/* - * Return the ptr in sp at which the character c last - * appears; NULL if not found - * - * Identical to System V strrchr, included for portability. - */ -char * -etags_strrchr (sp, c) - register char *sp; - register int c; -{ - register char *r; - - r = NULL; - do - { - if (*sp == c) - r = sp; - } while (*sp++); - return r; -} - - -/* - * Return the ptr in sp at which the character c first - * appears; NULL if not found - * - * Identical to System V strchr, included for portability. - */ -char * -etags_strchr (sp, c) - register char *sp; - register int c; -{ - do - { - if (*sp == c) - return sp; - } while (*sp++); - return NULL; -} - -/* Skip spaces, return new pointer. */ -char * -skip_spaces (cp) - char *cp; -{ - while (isspace (*cp)) /* isspace('\0')==FALSE */ - cp++; - return cp; -} - -/* Skip non spaces, return new pointer. */ -char * -skip_non_spaces (cp) - char *cp; -{ - while (!iswhite (*cp)) /* iswhite('\0')==TRUE */ - cp++; - return cp; -} - -/* Print error message and exit. */ -void -fatal (s1, s2) - char *s1, *s2; -{ - error (s1, s2); - exit (BAD); -} - -void -pfatal (s1) - char *s1; -{ - perror (s1); - exit (BAD); -} - -void -suggest_asking_for_help () -{ - fprintf (stderr, "\tTry `%s %s' for a complete list of options.\n", - progname, -#ifdef LONG_OPTIONS - "--help" -#else - "-h" -#endif - ); - exit (BAD); -} - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ -void -error (s1, s2) - const char *s1, *s2; -{ - fprintf (stderr, "%s: ", progname); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} - -/* Return a newly-allocated string whose contents - concatenate those of s1, s2, s3. */ -char * -concat (s1, s2, s3) - char *s1, *s2, *s3; -{ - int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); - char *result = xnew (len1 + len2 + len3 + 1, char); - - strcpy (result, s1); - strcpy (result + len1, s2); - strcpy (result + len1 + len2, s3); - result[len1 + len2 + len3] = '\0'; - - return result; -} - -/* Does the same work as the system V getcwd, but does not need to - guess the buffer size in advance. */ -char * -etags_getcwd () -{ -#ifdef HAVE_GETCWD - int bufsize = 200; - char *path = xnew (bufsize, char); - - while (getcwd (path, bufsize) == NULL) - { - if (errno != ERANGE) - pfatal ("getcwd"); - bufsize *= 2; - free (path); - path = xnew (bufsize, char); - } - - canonicalize_filename (path); - return path; - -#else /* not HAVE_GETCWD */ -#ifdef MSDOS - char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ - - getwd (path); - - for (p = path; *p != '\0'; p++) - if (*p == '\\') - *p = '/'; - else - *p = lowcase (*p); - - return strdup (path); -#else /* not MSDOS */ - linebuffer path; - FILE *pipe; - - initbuffer (&path); - pipe = (FILE *) popen ("pwd 2>/dev/null", "r"); - if (pipe == NULL || readline_internal (&path, pipe) == 0) - pfatal ("pwd"); - pclose (pipe); - - return path.buffer; -#endif /* not MSDOS */ -#endif /* not HAVE_GETCWD */ -} - -/* Return a newly allocated string containing the file name of FILE - relative to the absolute directory DIR (which should end with a slash). */ -char * -relative_filename (file, dir) - char *file, *dir; -{ - char *fp, *dp, *afn, *res; - int i; - - /* Find the common root of file and dir (with a trailing slash). */ - afn = absolute_filename (file, cwd); - fp = afn; - dp = dir; - while (*fp++ == *dp++) - continue; - fp--, dp--; /* back to the first differing char */ - do /* look at the equal chars until '/' */ - fp--, dp--; - while (*fp != '/'); - - /* Build a sequence of "../" strings for the resulting relative file name. */ - i = 0; - while ((dp = etags_strchr (dp + 1, '/')) != NULL) - i += 1; - res = xnew (3*i + strlen (fp + 1) + 1, char); - res[0] = '\0'; - while (i-- > 0) - strcat (res, "../"); - - /* Add the file name relative to the common root of file and dir. */ - strcat (res, fp + 1); - free (afn); - - return res; -} - -/* Return a newly allocated string containing the absolute file name - of FILE given DIR (which should end with a slash). */ -char * -absolute_filename (file, dir) - char *file, *dir; -{ - char *slashp, *cp, *res; - - if (filename_is_absolute (file)) - res = savestr (file); -#ifdef DOS_NT - /* We don't support non-absolute file names with a drive - letter, like `d:NAME' (it's too much hassle). */ - else if (file[1] == ':') - fatal ("%s: relative file names with drive letters not supported", file); -#endif - else - res = concat (dir, file, ""); - - /* Delete the "/dirname/.." and "/." substrings. */ - slashp = etags_strchr (res, '/'); - while (slashp != NULL && slashp[0] != '\0') - { - if (slashp[1] == '.') - { - if (slashp[2] == '.' - && (slashp[3] == '/' || slashp[3] == '\0')) - { - cp = slashp; - do - cp--; - while (cp >= res && !filename_is_absolute (cp)); - if (cp < res) - cp = slashp; /* the absolute name begins with "/.." */ -#ifdef DOS_NT - /* Under MSDOS and NT we get `d:/NAME' as absolute - file name, so the luser could say `d:/../NAME'. - We silently treat this as `d:/NAME'. */ - else if (cp[0] != '/') - cp = slashp; -#endif - strcpy (cp, slashp + 3); - slashp = cp; - continue; - } - else if (slashp[2] == '/' || slashp[2] == '\0') - { - strcpy (slashp, slashp + 2); - continue; - } - } - - slashp = etags_strchr (slashp + 1, '/'); - } - - if (res[0] == '\0') - return savestr ("/"); - else - return res; -} - -/* Return a newly allocated string containing the absolute - file name of dir where FILE resides given DIR (which should - end with a slash). */ -char * -absolute_dirname (file, dir) - char *file, *dir; -{ - char *slashp, *res; - char save; - - canonicalize_filename (file); - slashp = etags_strrchr (file, '/'); - if (slashp == NULL) - return savestr (dir); - save = slashp[1]; - slashp[1] = '\0'; - res = absolute_filename (file, dir); - slashp[1] = save; - - return res; -} - -/* Whether the argument string is an absolute file name. The argument - string must have been canonicalized with canonicalize_filename. */ -bool -filename_is_absolute (fn) - char *fn; -{ - return (fn[0] == '/' -#ifdef DOS_NT - || (isalpha(fn[0]) && fn[1] == ':' && fn[2] == '/') -#endif - ); -} - -/* Translate backslashes into slashes. Works in place. */ -void -canonicalize_filename (fn) - register char *fn; -{ -#ifdef DOS_NT - for (; *fn != '\0'; fn++) - if (*fn == '\\') - *fn = '/'; -#else - /* No action. */ -#endif -} - -/* Increase the size of a linebuffer. */ -void -grow_linebuffer (lbp, toksize) - linebuffer *lbp; - int toksize; -{ - while (lbp->size < toksize) - lbp->size *= 2; - lbp->buffer = xrnew (lbp->buffer, lbp->size, char); -} - -/* Like malloc but get fatal error if memory is exhausted. */ -long * -xmalloc (size) - unsigned int size; -{ - long *result = (long *) malloc (size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} - -long * -xrealloc (ptr, size) - char *ptr; - unsigned int size; -{ - long *result = (long *) realloc (ptr, size); - if (result == NULL) - fatal ("virtual memory exhausted", (char *)NULL); - return result; -} diff --git a/lib-src/pop.c b/lib-src/pop.c deleted file mode 100644 index bbec8ab..0000000 --- a/lib-src/pop.c +++ /dev/null @@ -1,1512 +0,0 @@ -/* pop.c: client routines for talking to a POP3-protocol post-office server - Copyright (c) 1991, 1993, 1996 Free Software Foundation, Inc. - Written by Jonathan Kamens, jik@security.ov.com. - -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. */ - -#ifdef HAVE_CONFIG_H -#define NO_SHORTNAMES /* Tell config not to load remap.h */ -#include <../src/config.h> -#else -#define MAIL_USE_POP -#endif - -#ifdef MAIL_USE_POP - -#ifdef HAVE_CONFIG_H -/* Cancel these substitutions made in config.h */ -#undef open -#undef read -#undef write -#undef close -#endif - -#include -#ifdef WINDOWSNT -#include -#undef SOCKET_ERROR -#define RECV(s,buf,len,flags) recv(s,buf,len,flags) -#define SEND(s,buf,len,flags) send(s,buf,len,flags) -#define CLOSESOCKET(s) closesocket(s) -#else -#include -#include -#define RECV(s,buf,len,flags) read(s,buf,len) -#define SEND(s,buf,len,flags) write(s,buf,len) -#define CLOSESOCKET(s) close(s) -#endif -#include "pop.h" - -#ifdef sun -#include -#endif /* sun */ - -#ifdef HESIOD -#include -/* - * It really shouldn't be necessary to put this declaration here, but - * the version of hesiod.h that Athena has installed in release 7.2 - * doesn't declare this function; I don't know if the 7.3 version of - * hesiod.h does. - */ -extern struct servent *hes_getservbyname (/* char *, char * */); -#endif - -#include -#include -#include -#include - -#include -#include -#include -#include "../src/syswait.h" -#ifndef WINDOWSNT -#include "../src/systime.h" -#endif -#include -#include - -#ifdef KERBEROS -#ifndef KRB5 -#include -#include -#else /* KRB5 */ -#include -#include -#include -#endif /* KRB5 */ -#endif /* KERBEROS */ - -#ifdef KERBEROS -#ifndef KRB5 -extern int krb_sendauth (/* long, int, KTEXT, char *, char *, char *, - u_long, MSG_DAT *, CREDENTIALS *, Key_schedule, - struct sockaddr_in *, struct sockaddr_in *, - char * */); -extern char *krb_realmofhost (/* char * */); -#endif /* ! KRB5 */ -#endif /* KERBEROS */ - -#ifndef WINDOWSNT -#if !defined(HAVE_H_ERRNO) || !defined(HAVE_CONFIG_H) -extern int h_errno; -#endif -#endif - -static int socket_connection (char *, int); -static char *pop_getline (popserver); -static int sendline (popserver, char *); -static int fullwrite (int, char *, int); -static int getok (popserver); -#if 0 -static int gettermination (popserver); -#endif -static void pop_trash (popserver); -static char *find_crlf (char *); - -#define ERROR_MAX 80 /* a pretty arbitrary size */ -#define POP_PORT 110 -#define KPOP_PORT 1109 -#if defined(WINDOWSNT) || defined(__CYGWIN32__) -#define POP_SERVICE "pop3" /* we don't want the POP2 port! */ -#else -#define POP_SERVICE "pop" -#endif -#ifdef KERBEROS -#ifdef KRB5 -#define KPOP_SERVICE "k5pop"; -#else -#define KPOP_SERVICE "kpop" -#endif -#endif - -char pop_error[ERROR_MAX]; -int pop_debug = 0; - -#ifndef min -#define min(a,b) (((a) < (b)) ? (a) : (b)) -#endif - -/* - * Function: pop_open (char *host, char *username, char *password, - * int flags) - * - * Purpose: Establishes a connection with a post-office server, and - * completes the authorization portion of the session. - * - * Arguments: - * host The server host with which the connection should be - * established. Optional. If omitted, internal - * heuristics will be used to determine the server host, - * if possible. - * username - * The username of the mail-drop to access. Optional. - * If omitted, internal heuristics will be used to - * determine the username, if possible. - * password - * The password to use for authorization. If omitted, - * internal heuristics will be used to determine the - * password, if possible. - * flags A bit mask containing flags controlling certain - * functions of the routine. Valid flags are defined in - * the file pop.h - * - * Return value: Upon successful establishment of a connection, a - * non-null popserver will be returned. Otherwise, null will be - * returned, and the string variable pop_error will contain an - * explanation of the error. - */ -popserver -pop_open (char *host, char *username, char *password, int flags) -{ - int sock; - popserver server; - - /* Determine the user name */ - if (! username) - { - username = getenv ("USER"); - if (! (username && *username)) - { -#ifndef WINDOWSNT - username = getlogin (); - if (! (username && *username)) - { - struct passwd *passwd; - passwd = getpwuid (getuid ()); - if (passwd && passwd->pw_name && *passwd->pw_name) - { - username = passwd->pw_name; - } - else - { - strcpy (pop_error, "Could not determine username"); - return (0); - } - } -#else - strcpy (pop_error, "Could not determine username"); - return (0); -#endif - } - } - - /* - * Determine the mail host. - */ - - if (! host) - { - host = getenv ("MAILHOST"); - } - -#ifdef HESIOD - if ((! host) && (! (flags & POP_NO_HESIOD))) - { - struct hes_postoffice *office; - office = hes_getmailhost (username); - if (office && office->po_type && (! strcmp (office->po_type, "POP")) - && office->po_name && *office->po_name && office->po_host - && *office->po_host) - { - host = office->po_host; - username = office->po_name; - } - } -#endif - -#ifdef MAILHOST - if (! host) - { - host = MAILHOST; - } -#endif - - if (! host) - { - strcpy (pop_error, "Could not determine POP server"); - return (0); - } - - /* Determine the password */ -#ifdef KERBEROS -#define DONT_NEED_PASSWORD (! (flags & POP_NO_KERBEROS)) -#else -#define DONT_NEED_PASSWORD 0 -#endif - - if ((! password) && (! DONT_NEED_PASSWORD)) - { -#ifndef WINDOWSNT - if (! (flags & POP_NO_GETPASS)) - { - password = getpass ("Enter POP password:"); - } -#endif - if (! password) - { - strcpy (pop_error, "Could not determine POP password"); - return (0); - } - } - if (password) - flags |= POP_NO_KERBEROS; - else - password = username; - - sock = socket_connection (host, flags); - if (sock == -1) - return (0); - - server = (popserver) malloc (sizeof (struct _popserver)); - if (! server) - { - strcpy (pop_error, "Out of memory in pop_open"); - return (0); - } - server->buffer = (char *) malloc (GETLINE_MIN); - if (! server->buffer) - { - strcpy (pop_error, "Out of memory in pop_open"); - free ((char *) server); - return (0); - } - - server->file = sock; - server->data = 0; - server->buffer_index = 0; - server->buffer_size = GETLINE_MIN; - server->in_multi = 0; - server->trash_started = 0; - - if (getok (server)) - return (0); - - /* - * I really shouldn't use the pop_error variable like this, but.... - */ - if (strlen (username) > ERROR_MAX - 6) - { - pop_close (server); - strcpy (pop_error, - "Username too long; recompile pop.c with larger ERROR_MAX"); - return (0); - } - sprintf (pop_error, "USER %s", username); - - if (sendline (server, pop_error) || getok (server)) - { - return (0); - } - - if (strlen (password) > ERROR_MAX - 6) - { - pop_close (server); - strcpy (pop_error, - "Password too long; recompile pop.c with larger ERROR_MAX"); - return (0); - } - sprintf (pop_error, "PASS %s", password); - - if (sendline (server, pop_error) || getok (server)) - { - return (0); - } - - return (server); -} - -/* - * Function: pop_stat - * - * Purpose: Issue the STAT command to the server and return (in the - * value parameters) the number of messages in the maildrop and - * the total size of the maildrop. - * - * Return value: 0 on success, or non-zero with an error in pop_error - * in failure. - * - * Side effects: On failure, may make further operations on the - * connection impossible. - */ -int -pop_stat (popserver server, int *count, int *size) -{ - char *fromserver; - - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_stat"); - return (-1); - } - - if (sendline (server, "STAT") || (! (fromserver = pop_getline (server)))) - return (-1); - - if (strncmp (fromserver, "+OK ", 4)) - { - if (0 == strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - } - else - { - strcpy (pop_error, - "Unexpected response from POP server in pop_stat"); - pop_trash (server); - } - return (-1); - } - - *count = atoi (&fromserver[4]); - - fromserver = strchr (&fromserver[4], ' '); - if (! fromserver) - { - strcpy (pop_error, - "Badly formatted response from server in pop_stat"); - pop_trash (server); - return (-1); - } - - *size = atoi (fromserver + 1); - - return (0); -} - -/* - * Function: pop_list - * - * Purpose: Performs the POP "list" command and returns (in value - * parameters) two malloc'd zero-terminated arrays -- one of - * message IDs, and a parallel one of sizes. - * - * Arguments: - * server The pop connection to talk to. - * message The number of the one message about which to get - * information, or 0 to get information about all - * messages. - * - * Return value: 0 on success, non-zero with error in pop_error on - * failure. - * - * Side effects: On failure, may make further operations on the - * connection impossible. - */ -int -pop_list (popserver server, int message, int **IDs, int **sizes) -{ - int how_many, i; - char *fromserver; - - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_list"); - return (-1); - } - - if (message) - how_many = 1; - else - { - int count, size; - if (pop_stat (server, &count, &size)) - return (-1); - how_many = count; - } - - *IDs = (int *) malloc ((how_many + 1) * sizeof (int)); - *sizes = (int *) malloc ((how_many + 1) * sizeof (int)); - if (! (*IDs && *sizes)) - { - strcpy (pop_error, "Out of memory in pop_list"); - return (-1); - } - - if (message) - { - sprintf (pop_error, "LIST %d", message); - if (sendline (server, pop_error)) - { - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - if (! (fromserver = pop_getline (server))) - { - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - if (strncmp (fromserver, "+OK ", 4)) - { - if (! strncmp (fromserver, "-ERR", 4)) - strncpy (pop_error, fromserver, ERROR_MAX); - else - { - strcpy (pop_error, - "Unexpected response from server in pop_list"); - pop_trash (server); - } - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - (*IDs)[0] = atoi (&fromserver[4]); - fromserver = strchr (&fromserver[4], ' '); - if (! fromserver) - { - strcpy (pop_error, - "Badly formatted response from server in pop_list"); - pop_trash (server); - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - (*sizes)[0] = atoi (fromserver); - (*IDs)[1] = (*sizes)[1] = 0; - return (0); - } - else - { - if (pop_multi_first (server, "LIST", &fromserver)) - { - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - for (i = 0; i < how_many; i++) - { - if (pop_multi_next (server, &fromserver)) - { - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - (*IDs)[i] = atoi (fromserver); - fromserver = strchr (fromserver, ' '); - if (! fromserver) - { - strcpy (pop_error, - "Badly formatted response from server in pop_list"); - free ((char *) *IDs); - free ((char *) *sizes); - pop_trash (server); - return (-1); - } - (*sizes)[i] = atoi (fromserver); - } - if (pop_multi_next (server, &fromserver)) - { - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - else if (fromserver) - { - strcpy (pop_error, - "Too many response lines from server in pop_list"); - free ((char *) *IDs); - free ((char *) *sizes); - return (-1); - } - (*IDs)[i] = (*sizes)[i] = 0; - return (0); - } -} - -/* - * Function: pop_retrieve - * - * Purpose: Retrieve a specified message from the maildrop. - * - * Arguments: - * server The server to retrieve from. - * message The message number to retrieve. - * markfrom - * If true, then mark the string "From " at the beginning - * of lines with '>'. - * - * Return value: A string pointing to the message, if successful, or - * null with pop_error set if not. - * - * Side effects: May kill connection on error. - */ -char * -pop_retrieve (popserver server, int message, int markfrom) -{ - int *IDs, *sizes, bufsize, fromcount = 0, cp = 0; - char *ptr, *fromserver; - int ret; - - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_retrieve"); - return (0); - } - - if (pop_list (server, message, &IDs, &sizes)) - return (0); - - if (pop_retrieve_first (server, message, &fromserver)) - { - return (0); - } - - /* - * The "5" below is an arbitrary constant -- I assume that if - * there are "From" lines in the text to be marked, there - * probably won't be more than 5 of them. If there are, I - * allocate more space for them below. - */ - bufsize = sizes[0] + (markfrom ? 5 : 0); - ptr = (char *)malloc (bufsize); - free ((char *) IDs); - free ((char *) sizes); - - if (! ptr) - { - strcpy (pop_error, "Out of memory in pop_retrieve"); - pop_retrieve_flush (server); - return (0); - } - - while (! (ret = pop_retrieve_next (server, &fromserver))) - { - int linesize; - - if (! fromserver) - { - ptr[cp] = '\0'; - return (ptr); - } - if (markfrom && fromserver[0] == 'F' && fromserver[1] == 'r' && - fromserver[2] == 'o' && fromserver[3] == 'm' && - fromserver[4] == ' ') - { - if (++fromcount == 5) - { - bufsize += 5; - ptr = (char *)realloc (ptr, bufsize); - if (! ptr) - { - strcpy (pop_error, "Out of memory in pop_retrieve"); - pop_retrieve_flush (server); - return (0); - } - fromcount = 0; - } - ptr[cp++] = '>'; - } - linesize = strlen (fromserver); - memcpy (&ptr[cp], fromserver, linesize); - cp += linesize; - ptr[cp++] = '\n'; - } - - if (ret) - { - free (ptr); - /* return (0); */ - } - /* This function used to fall off the end, but that doesn't make any sense */ - return (0); -} - -int -pop_retrieve_first (popserver server, int message, char **response) -{ - sprintf (pop_error, "RETR %d", message); - return (pop_multi_first (server, pop_error, response)); -} - -int -pop_retrieve_next (popserver server, char **line) -{ - return (pop_multi_next (server, line)); -} - -int -pop_retrieve_flush (popserver server) -{ - return (pop_multi_flush (server)); -} - -int -pop_top_first (popserver server, int message, int lines, char **response) -{ - sprintf (pop_error, "TOP %d %d", message, lines); - return (pop_multi_first (server, pop_error, response)); -} - -int -pop_top_next (popserver server, char **line) -{ - return (pop_multi_next (server, line)); -} - -int -pop_top_flush (popserver server) -{ - return (pop_multi_flush (server)); -} - -int -pop_multi_first (popserver server, char *command, char **response) -{ - if (server->in_multi) - { - strcpy (pop_error, - "Already in multi-line query in pop_multi_first"); - return (-1); - } - - if (sendline (server, command) || (! (*response = pop_getline (server)))) - { - return (-1); - } - - if (0 == strncmp (*response, "-ERR", 4)) - { - strncpy (pop_error, *response, ERROR_MAX); - return (-1); - } - else if (0 == strncmp (*response, "+OK", 3)) - { - for (*response += 3; **response == ' '; (*response)++) /* empty */; - server->in_multi = 1; - return (0); - } - else - { - strcpy (pop_error, - "Unexpected response from server in pop_multi_first"); - return (-1); - } -} - -int -pop_multi_next (popserver server, char **line) -{ - char *fromserver; - - if (! server->in_multi) - { - strcpy (pop_error, "Not in multi-line query in pop_multi_next"); - return (-1); - } - - fromserver = pop_getline (server); - if (! fromserver) - { - return (-1); - } - - if (fromserver[0] == '.') - { - if (! fromserver[1]) - { - *line = 0; - server->in_multi = 0; - return (0); - } - else - { - *line = fromserver + 1; - return (0); - } - } - else - { - *line = fromserver; - return (0); - } -} - -int -pop_multi_flush (popserver server) -{ - char *line; - - if (! server->in_multi) - { - return (0); - } - - while (! pop_multi_next (server, &line)) - { - if (! line) - { - return (0); - } - } - - return (-1); -} - -/* Function: pop_delete - * - * Purpose: Delete a specified message. - * - * Arguments: - * server Server from which to delete the message. - * message Message to delete. - * - * Return value: 0 on success, non-zero with error in pop_error - * otherwise. - */ -int -pop_delete (popserver server, int message) -{ - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_delete"); - return (-1); - } - - sprintf (pop_error, "DELE %d", message); - - if (sendline (server, pop_error) || getok (server)) - return (-1); - - return (0); -} - -/* - * Function: pop_noop - * - * Purpose: Send a noop command to the server. - * - * Argument: - * server The server to send to. - * - * Return value: 0 on success, non-zero with error in pop_error - * otherwise. - * - * Side effects: Closes connection on error. - */ -int -pop_noop (popserver server) -{ - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_noop"); - return (-1); - } - - if (sendline (server, "NOOP") || getok (server)) - return (-1); - - return (0); -} - -/* - * Function: pop_last - * - * Purpose: Find out the highest seen message from the server. - * - * Arguments: - * server The server. - * - * Return value: If successful, the highest seen message, which is - * greater than or equal to 0. Otherwise, a negative number with - * the error explained in pop_error. - * - * Side effects: Closes the connection on error. - */ -int -pop_last (popserver server) -{ - char *fromserver; - - if (server->in_multi) - { - strcpy (pop_error, "In multi-line query in pop_last"); - return (-1); - } - - if (sendline (server, "LAST")) - return (-1); - - if (! (fromserver = pop_getline (server))) - return (-1); - - if (! strncmp (fromserver, "-ERR", 4)) - { - strncpy (pop_error, fromserver, ERROR_MAX); - return (-1); - } - else if (strncmp (fromserver, "+OK ", 4)) - { - strcpy (pop_error, "Unexpected response from server in pop_last"); - pop_trash (server); - return (-1); - } - else - { - return (atoi (&fromserver[4])); - } -} - -/* - * Function: pop_reset - * - * Purpose: Reset the server to its initial connect state - * - * Arguments: - * server The server. - * - * Return value: 0 for success, non-0 with error in pop_error - * otherwise. - * - * Side effects: Closes the connection on error. - */ -int -pop_reset (popserver server) -{ - if (pop_retrieve_flush (server)) - { - return (-1); - } - - if (sendline (server, "RSET") || getok (server)) - return (-1); - - return (0); -} - -/* - * Function: pop_quit - * - * Purpose: Quit the connection to the server, - * - * Arguments: - * server The server to quit. - * - * Return value: 0 for success, non-zero otherwise with error in - * pop_error. - * - * Side Effects: The popserver passed in is unusable after this - * function is called, even if an error occurs. - */ -int -pop_quit (popserver server) -{ - int ret = 0; - - if (server->file >= 0) - { - if (pop_retrieve_flush (server)) - { - ret = -1; - } - - if (sendline (server, "QUIT") || getok (server)) - { - ret = -1; - } - - close (server->file); - } - - if (server->buffer) - free (server->buffer); - free ((char *) server); - - return (ret); -} - -#ifdef WINDOWSNT -static int have_winsock = 0; -#endif - -/* - * Function: socket_connection - * - * Purpose: Opens the network connection with the mail host, without - * doing any sort of I/O with it or anything. - * - * Arguments: - * host The host to which to connect. - * flags Option flags. - * - * Return value: A file descriptor indicating the connection, or -1 - * indicating failure, in which case an error has been copied - * into pop_error. - */ -static int -socket_connection (char *host, int flags) -{ - struct hostent *hostent; - struct servent *servent; - struct sockaddr_in addr; - char found_port = 0; - char *service; - int sock; -#ifdef KERBEROS -#ifdef KRB5 - krb5_error_code rem; - krb5_ccache ccdef; - krb5_principal client, server; - krb5_error *err_ret; - register char *cp; -#else - KTEXT ticket; - MSG_DAT msg_data; - CREDENTIALS cred; - Key_schedule schedule; - int rem; -#endif /* KRB5 */ -#endif /* KERBEROS */ - - int try_count = 0; - -#ifdef WINDOWSNT - { - WSADATA winsockData; - if (WSAStartup (0x101, &winsockData) == 0) - have_winsock = 1; - } -#endif - - do - { - hostent = gethostbyname (host); - try_count++; - if ((! hostent) -#ifndef BROKEN_CYGWIN - && ((h_errno != TRY_AGAIN) || (try_count == 5)) -#endif - ) - { - strcpy (pop_error, "Could not determine POP server's address"); - return (-1); - } - } while (! hostent); - - memset (&addr, 0, sizeof (addr)); - addr.sin_family = AF_INET; - -#ifdef KERBEROS - service = (flags & POP_NO_KERBEROS) ? POP_SERVICE : KPOP_SERVICE; -#else - service = POP_SERVICE; -#endif - -#ifdef HESIOD - if (! (flags & POP_NO_HESIOD)) - { - servent = hes_getservbyname (service, "tcp"); - if (servent) - { - addr.sin_port = servent->s_port; - found_port = 1; - } - } -#endif - if (! found_port) - { - servent = getservbyname (service, "tcp"); - if (servent) - { - addr.sin_port = servent->s_port; - } - else - { -#ifdef KERBEROS - addr.sin_port = htons ((flags & POP_NO_KERBEROS) ? - POP_PORT : KPOP_PORT); -#else - addr.sin_port = htons (POP_PORT); -#endif - } - } - -#define SOCKET_ERROR "Could not create socket for POP connection: " - - sock = socket (PF_INET, SOCK_STREAM, 0); - if (sock < 0) - { - strcpy (pop_error, SOCKET_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (SOCKET_ERROR)); - return (-1); - - } - - while (*hostent->h_addr_list) - { - memcpy (&addr.sin_addr, *hostent->h_addr_list, hostent->h_length); - if (! connect (sock, (struct sockaddr *) &addr, sizeof (addr))) - break; - hostent->h_addr_list++; - } - -#define CONNECT_ERROR "Could not connect to POP server: " - - if (! *hostent->h_addr_list) - { - CLOSESOCKET (sock); - strcpy (pop_error, CONNECT_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (CONNECT_ERROR)); - return (-1); - - } - -#ifdef KERBEROS -#define KRB_ERROR "Kerberos error connecting to POP server: " - if (! (flags & POP_NO_KERBEROS)) - { -#ifdef KRB5 - krb5_init_ets (); - - if (rem = krb5_cc_default (&ccdef)) - { - krb5error: - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof(KRB_ERROR)); - CLOSESOCKET (sock); - return (-1); - } - - if (rem = krb5_cc_get_principal (ccdef, &client)) - { - goto krb5error; - } - - for (cp = hostent->h_name; *cp; cp++) - { - if (isupper (*cp)) - { - *cp = tolower (*cp); - } - } - - if (rem = krb5_sname_to_principal (hostent->h_name, POP_SERVICE, - FALSE, &server)) - { - goto krb5error; - } - - rem = krb5_sendauth ((krb5_pointer) &sock, "KPOPV1.0", client, server, - AP_OPTS_MUTUAL_REQUIRED, - 0, /* no checksum */ - 0, /* no creds, use ccache instead */ - ccdef, - 0, /* don't need seq # */ - 0, /* don't need subsession key */ - &err_ret, - 0); /* don't need reply */ - krb5_free_principal (server); - if (rem) - { - if (err_ret && err_ret->text.length) - { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); - strncat (pop_error, " [server says '", - ERROR_MAX - strlen (pop_error) - 1); - strncat (pop_error, err_ret->text.data, - min (ERROR_MAX - strlen (pop_error) - 1, - err_ret->text.length)); - strncat (pop_error, "']", - ERROR_MAX - strlen (pop_error) - 1); - } - else - { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, error_message (rem), - ERROR_MAX - sizeof (KRB_ERROR)); - } - if (err_ret) - krb5_free_error (err_ret); - - CLOSESOCKET (sock); - return (-1); - } -#else /* ! KRB5 */ - ticket = (KTEXT) malloc (sizeof (KTEXT_ST)); - rem = krb_sendauth (0L, sock, ticket, "pop", hostent->h_name, - (char *) krb_realmofhost (hostent->h_name), - (unsigned long) 0, &msg_data, &cred, schedule, - (struct sockaddr_in *) 0, - (struct sockaddr_in *) 0, - "KPOPV0.1"); - free ((char *) ticket); - if (rem != KSUCCESS) - { - strcpy (pop_error, KRB_ERROR); - strncat (pop_error, krb_err_txt[rem], - ERROR_MAX - sizeof (KRB_ERROR)); - CLOSESOCKET (sock); - return (-1); - } -#endif /* KRB5 */ - } -#endif /* KERBEROS */ - - return (sock); -} /* socket_connection */ - -/* - * Function: pop_getline - * - * Purpose: Get a line of text from the connection and return a - * pointer to it. The carriage return and linefeed at the end of - * the line are stripped, but periods at the beginnings of lines - * are NOT dealt with in any special way. - * - * Arguments: - * server The server from which to get the line of text. - * - * Returns: A non-null pointer if successful, or a null pointer on any - * error, with an error message copied into pop_error. - * - * Notes: The line returned is overwritten with each call to pop_getline. - * - * Side effects: Closes the connection on error. - */ -static char * -pop_getline (popserver server) -{ -#define GETLINE_ERROR "Error reading from server: " - - int ret; - int search_offset = 0; - - if (server->data) - { - char *cp = find_crlf (server->buffer + server->buffer_index); - if (cp) - { - int found; - int data_used; - - found = server->buffer_index; - data_used = (cp + 2) - server->buffer - found; - - *cp = '\0'; /* terminate the string to be returned */ - server->data -= data_used; - server->buffer_index += data_used; - - if (pop_debug) - fprintf (stderr, "<<< %s\n", server->buffer + found); - return (server->buffer + found); - } - else - { - memcpy (server->buffer, - server->buffer + server->buffer_index, - server->data); - /* Record the fact that we've searched the data already in - the buffer for a CRLF, so that when we search below, we - don't have to search the same data twice. There's a "- - 1" here to account for the fact that the last character - of the data we have may be the CR of a CRLF pair, of - which we haven't read the second half yet, so we may have - to search it again when we read more data. */ - search_offset = server->data - 1; - server->buffer_index = 0; - } - } - else - { - server->buffer_index = 0; - } - - while (1) - { - /* There's a "- 1" here to leave room for the null that we put - at the end of the read data below. We put the null there so - that find_crlf knows where to stop when we call it. */ - if (server->data == server->buffer_size - 1) - { - server->buffer_size += GETLINE_INCR; - server->buffer = (char *)realloc (server->buffer, server->buffer_size); - if (! server->buffer) - { - strcpy (pop_error, "Out of memory in pop_getline"); - pop_trash (server); - return (0); - } - } - ret = RECV (server->file, server->buffer + server->data, - server->buffer_size - server->data - 1, 0); - if (ret < 0) - { - strcpy (pop_error, GETLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (GETLINE_ERROR)); - pop_trash (server); - return (0); - } - else if (ret == 0) - { - strcpy (pop_error, "Unexpected EOF from server in pop_getline"); - pop_trash (server); - return (0); - } - else - { - char *cp; - server->data += ret; - server->buffer[server->data] = '\0'; - - cp = find_crlf (server->buffer + search_offset); - if (cp) - { - int data_used = (cp + 2) - server->buffer; - *cp = '\0'; - server->data -= data_used; - server->buffer_index = data_used; - - if (pop_debug) - fprintf (stderr, "<<< %s\n", server->buffer); - return (server->buffer); - } - search_offset += ret; - } - } - - /* NOTREACHED */ -} - -/* - * Function: sendline - * - * Purpose: Sends a line of text to the POP server. The line of text - * passed into this function should NOT have the carriage return - * and linefeed on the end of it. Periods at beginnings of lines - * will NOT be treated specially by this function. - * - * Arguments: - * server The server to which to send the text. - * line The line of text to send. - * - * Return value: Upon successful completion, a value of 0 will be - * returned. Otherwise, a non-zero value will be returned, and - * an error will be copied into pop_error. - * - * Side effects: Closes the connection on error. - */ -static int -sendline (popserver server, char *line) -{ -#define SENDLINE_ERROR "Error writing to POP server: " - int ret; - - ret = fullwrite (server->file, line, strlen (line)); - if (ret >= 0) - { /* 0 indicates that a blank line was written */ - ret = fullwrite (server->file, "\r\n", 2); - } - - if (ret < 0) - { - pop_trash (server); - strcpy (pop_error, SENDLINE_ERROR); - strncat (pop_error, strerror (errno), - ERROR_MAX - sizeof (SENDLINE_ERROR)); - return (ret); - } - - if (pop_debug) - fprintf (stderr, ">>> %s\n", line); - - return (0); -} - -/* - * Procedure: fullwrite - * - * Purpose: Just like write, but keeps trying until the entire string - * has been written. - * - * Return value: Same as write. Pop_error is not set. - */ -static int -fullwrite (int fd, char *buf, int nbytes) -{ - char *cp; - int ret; - - cp = buf; - while ((ret = SEND (fd, cp, nbytes, 0)) > 0) - { - cp += ret; - nbytes -= ret; - } - - return (ret); -} - -/* - * Procedure getok - * - * Purpose: Reads a line from the server. If the return indicator is - * positive, return with a zero exit status. If not, return with - * a negative exit status. - * - * Arguments: - * server The server to read from. - * - * Returns: 0 for success, else for failure and puts error in pop_error. - * - * Side effects: On failure, may make the connection unusable. - */ -static int -getok (popserver server) -{ - char *fromline; - - if (! (fromline = pop_getline (server))) - { - return (-1); - } - - if (! strncmp (fromline, "+OK", 3)) - return (0); - else if (! strncmp (fromline, "-ERR", 4)) - { - strncpy (pop_error, fromline, ERROR_MAX); - pop_error[ERROR_MAX-1] = '\0'; - return (-1); - } - else - { - strcpy (pop_error, - "Unexpected response from server; expecting +OK or -ERR"); - pop_trash (server); - return (-1); - } -} - -#if 0 -/* - * Function: gettermination - * - * Purpose: Gets the next line and verifies that it is a termination - * line (nothing but a dot). - * - * Return value: 0 on success, non-zero with pop_error set on error. - * - * Side effects: Closes the connection on error. - */ -static int -gettermination (popserver server) -{ - char *fromserver; - - fromserver = pop_getline (server); - if (! fromserver) - return (-1); - - if (strcmp (fromserver, ".")) - { - strcpy (pop_error, - "Unexpected response from server in gettermination"); - pop_trash (server); - return (-1); - } - - return (0); -} -#endif - -/* - * Function pop_close - * - * Purpose: Close a pop connection, sending a "RSET" command to try to - * preserve any changes that were made and a "QUIT" command to - * try to get the server to quit, but ignoring any responses that - * are received. - * - * Side effects: The server is unusable after this function returns. - * Changes made to the maildrop since the session was started (or - * since the last pop_reset) may be lost. - */ -void -pop_close (popserver server) -{ - pop_trash (server); - free ((char *) server); - - return; -} - -/* - * Function: pop_trash - * - * Purpose: Like pop_close or pop_quit, but doesn't deallocate the - * memory associated with the server. It is legal to call - * pop_close or pop_quit after this function has been called. - */ -static void -pop_trash (popserver server) -{ - if (server->file >= 0) - { - /* avoid recursion; sendline can call pop_trash */ - if (server->trash_started) - return; - server->trash_started = 1; - - sendline (server, "RSET"); - sendline (server, "QUIT"); - - CLOSESOCKET (server->file); - server->file = -1; - if (server->buffer) - { - free (server->buffer); - server->buffer = 0; - } - } - -#ifdef WINDOWSNT - if (have_winsock) - WSACleanup (); -#endif -} - -/* Return a pointer to the first CRLF in IN_STRING, - or 0 if it does not contain one. */ - -static char * -find_crlf (char *in_string) -{ - while (1) - { - if (! *in_string) - return (0); - else if (*in_string == '\r') - { - if (*++in_string == '\n') - return (in_string - 1); - } - else - in_string++; - } - /* NOTREACHED */ -} - -#endif /* MAIL_USE_POP */ diff --git a/lib-src/profile.c b/lib-src/profile.c deleted file mode 100644 index 5644d21..0000000 --- a/lib-src/profile.c +++ /dev/null @@ -1,96 +0,0 @@ -/* profile.c --- generate periodic events for profiling of Emacs Lisp code. - Copyright (C) 1992, 1994 Free Software Foundation, Inc. - - Author: Boaz Ben-Zvi - - 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 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.28. */ -/* #### Not sure if this is needed for XEmacs. */ - -/** - ** To be run as an emacs process. Input string that starts with: - ** 'z' -- resets the watch (to zero). - ** 'p' -- return time (on stdout) as string with format . - ** 'q' -- exit. - ** - ** abstraction : a stopwatch - ** operations: reset_watch, get_time - */ -#include <../src/config.h> -#include -#include -#include "../src/systime.h" - -static struct timeval TV1, TV2; -static int watch_not_started = 1; /* flag */ -static char time_string[30]; - -/* Reset the stopwatch to zero. */ - -static void -reset_watch (void) -{ - EMACS_GET_TIME (TV1); - watch_not_started = 0; -} - -/* This call returns the time since the last reset_watch call. The time - is returned as a string with the format . - If reset_watch was not called yet, exit. */ - -static char * -get_time (void) -{ - if (watch_not_started) - exit (1); /* call reset_watch first ! */ - EMACS_GET_TIME (TV2); - if (TV1.tv_usec > TV2.tv_usec) - { - TV2.tv_usec += 1000000; - TV2.tv_sec--; - } - sprintf (time_string, "%lu.%06lu", - (unsigned long) TV2.tv_sec - TV1.tv_sec, - (unsigned long) TV2.tv_usec - TV1.tv_usec); - return time_string; -} - -int -main (int argc, char *argv[]) -{ - int c; - while ((c = getchar ()) != EOF) - { - switch (c) - { - case 'z': - reset_watch (); - break; - case 'p': - puts (get_time ()); - break; - case 'q': - exit (0); - } - /* Anything remaining on the line is ignored. */ - while (c != '\n' && c != EOF) - c = getchar (); - } - return 1; -} diff --git a/lib-src/qsort.c b/lib-src/qsort.c deleted file mode 100644 index ff8ef60..0000000 --- a/lib-src/qsort.c +++ /dev/null @@ -1,237 +0,0 @@ -/* Plug-compatible replacement for UNIX qsort. - Copyright (C) 1989 Free Software Foundation, Inc. - Written by Douglas C. Schmidt (schmidt@ics.uci.edu) - -This file is part of GNU CC. - -GNU QSORT is free software; you can redistribute it and/or modify -it under the 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 QSORT is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 QSORT; see the file COPYING. If not, write to -the Free the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: FSF 19.28. */ - -#ifdef sparc -#include -#endif - -/* Invoke the comparison function, returns either 0, < 0, or > 0. */ -#define CMP(A,B) ((*cmp)((A),(B))) - -/* Byte-wise swap two items of size SIZE. */ -#define SWAP(A,B,SIZE) do {int sz = (SIZE); char *a = (A); char *b = (B); \ - do { char _temp = *a;*a++ = *b;*b++ = _temp;} while (--sz);} while (0) - -/* Copy SIZE bytes from item B to item A. */ -#define COPY(A,B,SIZE) {int sz = (SIZE); do { *(A)++ = *(B)++; } while (--sz); } - -/* This should be replaced by a standard ANSI macro. */ -#define BYTES_PER_WORD 8 - -/* The next 4 #defines implement a very fast in-line stack abstraction. */ -#define STACK_SIZE (BYTES_PER_WORD * sizeof (long)) -#define PUSH(LOW,HIGH) do {top->lo = LOW;top++->hi = HIGH;} while (0) -#define POP(LOW,HIGH) do {LOW = (--top)->lo;HIGH = top->hi;} while (0) -#define STACK_NOT_EMPTY (stack < top) - -/* Discontinue quicksort algorithm when partition gets below this size. - This particular magic number was chosen to work best on a Sun 4/260. */ -#define MAX_THRESH 4 - -/* Stack node declarations used to store unfulfilled partition obligations. */ -typedef struct -{ - char *lo; - char *hi; -} stack_node; - -/* Order size using quicksort. This implementation incorporates - four optimizations discussed in Sedgewick: - - 1. Non-recursive, using an explicit stack of pointer that store the - next array partition to sort. To save time, this maximum amount - of space required to store an array of MAX_INT is allocated on the - stack. Assuming a 32-bit integer, this needs only 32 * - sizeof (stack_node) == 136 bits. Pretty cheap, actually. - - 2. Chose the pivot element using a median-of-three decision tree. - This reduces the probability of selecting a bad pivot value and - eliminates certain extraneous comparisons. - - 3. Only quicksorts TOTAL_ELEMS / MAX_THRESH partitions, leaving - insertion sort to order the MAX_THRESH items within each partition. - This is a big win, since insertion sort is faster for small, mostly - sorted array segments. - - 4. The larger of the two sub-partitions is always pushed onto the - stack first, with the algorithm then concentrating on the - smaller partition. This *guarantees* no more than log (n) - stack size is needed (actually O(1) in this case)! */ - -int -qsort (base_ptr, total_elems, size, cmp) - char *base_ptr; - int total_elems; - int size; - int (*cmp)(); -{ - /* Allocating SIZE bytes for a pivot buffer facilitates a better - algorithm below since we can do comparisons directly on the pivot. */ - char *pivot_buffer = (char *) alloca (size); - int max_thresh = MAX_THRESH * size; - - if (total_elems > MAX_THRESH) - { - char *lo = base_ptr; - char *hi = lo + size * (total_elems - 1); - stack_node stack[STACK_SIZE]; /* Largest size needed for 32-bit int!!! */ - stack_node *top = stack + 1; - - while (STACK_NOT_EMPTY) - { - char *left_ptr; - char *right_ptr; - { - char *pivot = pivot_buffer; - { - /* Select median value from among LO, MID, and HI. Rearrange - LO and HI so the three values are sorted. This lowers the - probability of picking a pathological pivot value and - skips a comparison for both the LEFT_PTR and RIGHT_PTR. */ - - char *mid = lo + size * ((hi - lo) / size >> 1); - - if (CMP (mid, lo) < 0) - SWAP (mid, lo, size); - if (CMP (hi, mid) < 0) - SWAP (mid, hi, size); - else - goto jump_over; - if (CMP (mid, lo) < 0) - SWAP (mid, lo, size); - jump_over: - COPY (pivot, mid, size); - pivot = pivot_buffer; - } - left_ptr = lo + size; - right_ptr = hi - size; - - /* Here's the famous ``collapse the walls'' section of quicksort. - Gotta like those tight inner loops! They are the main reason - that this algorithm runs much faster than others. */ - do - { - while (CMP (left_ptr, pivot) < 0) - left_ptr += size; - - while (CMP (pivot, right_ptr) < 0) - right_ptr -= size; - - if (left_ptr < right_ptr) - { - SWAP (left_ptr, right_ptr, size); - left_ptr += size; - right_ptr -= size; - } - else if (left_ptr == right_ptr) - { - left_ptr += size; - right_ptr -= size; - break; - } - } - while (left_ptr <= right_ptr); - - } - - /* Set up pointers for next iteration. First determine whether - left and right partitions are below the threshold size. If so, - ignore one or both. Otherwise, push the larger partition's - bounds on the stack and continue sorting the smaller one. */ - - if ((right_ptr - lo) <= max_thresh) - { - if ((hi - left_ptr) <= max_thresh) /* Ignore both small partitions. */ - POP (lo, hi); - else /* Ignore small left partition. */ - lo = left_ptr; - } - else if ((hi - left_ptr) <= max_thresh) /* Ignore small right partition. */ - hi = right_ptr; - else if ((right_ptr - lo) > (hi - left_ptr)) /* Push larger left partition indices. */ - { - PUSH (lo, right_ptr); - lo = left_ptr; - } - else /* Push larger right partition indices. */ - { - PUSH (left_ptr, hi); - hi = right_ptr; - } - } - } - - /* Once the BASE_PTR array is partially sorted by quicksort the rest - is completely sorted using insertion sort, since this is efficient - for partitions below MAX_THRESH size. BASE_PTR points to the beginning - of the array to sort, and END_PTR points at the very last element in - the array (*not* one beyond it!). */ - -#define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) - - { - char *end_ptr = base_ptr + size * (total_elems - 1); - char *run_ptr; - char *tmp_ptr = base_ptr; - char *thresh = MIN (end_ptr, base_ptr + max_thresh); - - /* Find smallest element in first threshold and place it at the - array's beginning. This is the smallest array element, - and the operation speeds up insertion sort's inner loop. */ - - for (run_ptr = tmp_ptr + size; run_ptr <= thresh; run_ptr += size) - if (CMP (run_ptr, tmp_ptr) < 0) - tmp_ptr = run_ptr; - - if (tmp_ptr != base_ptr) - SWAP (tmp_ptr, base_ptr, size); - - /* Insertion sort, running from left-hand-side up to `right-hand-side.' - Pretty much straight out of the original GNU qsort routine. */ - - for (run_ptr = base_ptr + size; (tmp_ptr = run_ptr += size) <= end_ptr; ) - { - - while (CMP (run_ptr, tmp_ptr -= size) < 0) - ; - - if ((tmp_ptr += size) != run_ptr) - { - char *trav; - - for (trav = run_ptr + size; --trav >= run_ptr;) - { - char c = *trav; - char *hi, *lo; - - for (hi = lo = trav; (lo -= size) >= tmp_ptr; hi = lo) - *hi = *lo; - *hi = c; - } - } - - } - } - return 1; -} - diff --git a/lib-src/rcs2log b/lib-src/rcs2log deleted file mode 100755 index 2a9e7d1..0000000 --- a/lib-src/rcs2log +++ /dev/null @@ -1,650 +0,0 @@ -#! /bin/sh - -# RCS to ChangeLog generator - -# Generate a change log prefix from RCS files (perhaps in the CVS repository) -# and the ChangeLog (if any). -# Output the new prefix to standard output. -# You can edit this prefix by hand, and then prepend it to ChangeLog. - -# Ignore log entries that start with `#'. -# Clump together log entries that start with `{topic} ', -# where `topic' contains neither white space nor `}'. - -Help='The default FILEs are the files registered under the working directory. -Options: - - -c CHANGELOG Output a change log prefix to CHANGELOG (default ChangeLog). - -h HOSTNAME Use HOSTNAME in change log entries (default current host). - -i INDENT Indent change log lines by INDENT spaces (default 8). - -l LENGTH Try to limit log lines to LENGTH characters (default 79). - -R If no FILEs are given and RCS is used, recurse through working directory. - -r OPTION Pass OPTION to subsidiary log command. - -t TABWIDTH Tab stops are every TABWIDTH characters (default 8). - -u "LOGINFULLNAMEMAILADDR" Assume LOGIN has FULLNAME and MAILADDR. - -v Append RCS revision to file names in log lines. - --help Output help. - --version Output version number. - -Report bugs to .' - -Id='$Id: rcs2log,v 1.37 1997/03/21 22:19:30 eggert Exp $' - -# Copyright 1992, 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. - -# 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. - -Copyright='Copyright 1997 Free Software Foundation, Inc. -This program comes with NO WARRANTY, to the extent permitted by law. -You may redistribute copies of this program -under the terms of the GNU General Public License. -For more information about these matters, see the files named COPYING. -Author: Paul Eggert ' - -tab=' ' -nl=' -' - -# Parse options. - -# defaults -: ${AWK=awk} -: ${TMPDIR=/tmp} -changelog=ChangeLog # change log file name -datearg= # rlog date option -hostname= # name of local host (if empty, will deduce it later) -indent=8 # indent of log line -length=79 # suggested max width of log line -logins= # login names for people we know fullnames and mailaddrs of -loginFullnameMailaddrs= # loginfullnamemailaddr triplets -logTZ= # time zone for log dates (if empty, use local time) -recursive= # t if we want recursive rlog -revision= # t if we want revision numbers -rlog_options= # options to pass to rlog -tabwidth=8 # width of horizontal tab - -while : -do - case $1 in - -c) changelog=${2?}; shift;; - -i) indent=${2?}; shift;; - -h) hostname=${2?}; shift;; - -l) length=${2?}; shift;; - -[nu]) # -n is obsolescent; it is replaced by -u. - case $1 in - -n) case ${2?}${3?}${4?} in - *"$tab"* | *"$nl"*) - echo >&2 "$0: -n '$2' '$3' '$4': tabs, newlines not allowed" - exit 1 - esac - loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2$tab$3$tab$4 - shift; shift; shift;; - -u) - # If $2 is not tab-separated, use colon for separator. - case ${2?} in - *"$nl"*) - echo >&2 "$0: -u '$2': newlines not allowed" - exit 1;; - *"$tab"*) - t=$tab;; - *) - t=: - esac - case $2 in - *"$t"*"$t"*"$t"*) - echo >&2 "$0: -u '$2': too many fields" - exit 1;; - *"$t"*"$t"*) - ;; - *) - echo >&2 "$0: -u '$2': not enough fields" - exit 1 - esac - loginFullnameMailaddrs=$loginFullnameMailaddrs$nl$2 - shift - esac - logins=$logins$nl$login - ;; - -r) rlog_options=$rlog_options$nl${2?}; shift;; - -R) recursive=t;; - -t) tabwidth=${2?}; shift;; - -v) revision=t;; - --version) - set $Id - rcs2logVersion=$3 - echo >&2 "rcs2log (GNU Emacs) $rcs2logVersion$nl$Copyright" - exit 0;; - -*) echo >&2 "Usage: $0 [OPTION]... [FILE ...]$nl$Help" - case $1 in - --help) exit 0;; - *) exit 1 - esac;; - *) break - esac - shift -done - -month_data=' - m[0]="Jan"; m[1]="Feb"; m[2]="Mar" - m[3]="Apr"; m[4]="May"; m[5]="Jun" - m[6]="Jul"; m[7]="Aug"; m[8]="Sep" - m[9]="Oct"; m[10]="Nov"; m[11]="Dec" -' - - -# Put rlog output into $rlogout. - -# If no rlog options are given, -# log the revisions checked in since the first ChangeLog entry. -# Since ChangeLog is only by date, some of these revisions may be duplicates of -# what's already in ChangeLog; it's the user's responsibility to remove them. -case $rlog_options in -'') - if test -s "$changelog" - then - e=' - /^[0-9]+-[0-9][0-9]-[0-9][0-9]/{ - # ISO 8601 date - print $1 - exit - } - /^... ... [ 0-9][0-9] [ 0-9][0-9]:[0-9][0-9]:[0-9][0-9] [0-9]+ /{ - # old-fashioned date and time (Emacs 19.31 and earlier) - '"$month_data"' - year = $5 - for (i=0; i<=11; i++) if (m[i] == $2) break - dd = $3 - printf "%d-%02d-%02d\n", year, i+1, dd - exit - } - ' - d=`$AWK "$e" <"$changelog"` || exit - case $d in - ?*) datearg="-d>$d" - esac - fi -esac - -# Use TZ specified by ChangeLog local variable, if any. -if test -s "$changelog" -then - extractTZ=' - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*"\([^"]*\)".*/{ - s//\1/; p; q - } - /^.*change-log-time-zone-rule['"$tab"' ]*:['"$tab"' ]*t.*/{ - s//UTC0/; p; q - } - ' - logTZ=`tail "$changelog" | sed -n "$extractTZ"` - case $logTZ in - ?*) TZ=$logTZ; export TZ - esac -fi - -# If CVS is in use, examine its repository, not the normal RCS files. -if test ! -f CVS/Repository -then - rlog=rlog - repository= -else - rlog='cvs -q log' - repository=`sed 1q &2 "$0: $repository: bad repository (see CVS/Repository)" - exit 1 - fi - esac -fi - -# Use $rlog's -zLT option, if $rlog supports it. -case `$rlog -zLT 2>&1` in -*' option'*) ;; -*) rlog_options=-zLT$nl$rlog_options -esac - -# With no arguments, examine all files under the RCS directory. -case $# in -0) - case $repository in - '') - oldIFS=$IFS - IFS=$nl - case $recursive in - t) - RCSdirs=`find . -name RCS -type d -print` - filesFromRCSfiles='s|,v$||; s|/RCS/|/|; s|^\./||' - files=` - { - case $RCSdirs in - ?*) find $RCSdirs \ - -type f \ - ! -name '*_' \ - ! -name ',*,' \ - ! -name '.*_' \ - ! -name .rcsfreeze.log \ - ! -name .rcsfreeze.ver \ - -print - esac - find . -name '*,v' -print - } | - sort -u | - sed "$filesFromRCSfiles" - `;; - *) - files= - for file in RCS/.* RCS/* .*,v *,v - do - case $file in - RCS/. | RCS/.. | RCS/,*, | RCS/*_) continue;; - RCS/.rcsfreeze.log | RCS/.rcsfreeze.ver) continue;; - RCS/.\* | RCS/\* | .\*,v | \*,v) test -f "$file" || continue - esac - files=$files$nl$file - done - case $files in - '') exit 0 - esac - esac - set x $files - shift - IFS=$oldIFS - esac -esac - -llogout=$TMPDIR/rcs2log$$l -rlogout=$TMPDIR/rcs2log$$r -trap exit 1 2 13 15 -trap "rm -f $llogout $rlogout; exit 1" 0 - -case $datearg in -?*) $rlog $rlog_options "$datearg" ${1+"$@"} >$rlogout;; -'') $rlog $rlog_options ${1+"$@"} >$rlogout -esac || exit - - -# Get the full name of each author the logs mention, and set initialize_fullname -# to awk code that initializes the `fullname' awk associative array. -# Warning: foreign authors (i.e. not known in the passwd file) are mishandled; -# you have to fix the resulting output by hand. - -initialize_fullname= -initialize_mailaddr= - -case $loginFullnameMailaddrs in -?*) - case $loginFullnameMailaddrs in - *\"* | *\\*) - sed 's/["\\]/\\&/g' >$llogout <$llogout </dev/null | - $AWK -F: "$awkscript" - `$initialize_fullname -esac - - -# Function to print a single log line. -# We don't use awk functions, to stay compatible with old awk versions. -# `Log' is the log message (with \n replaced by \r). -# `files' contains the affected files. -printlogline='{ - - # Following the GNU coding standards, rewrite - # * file: (function): comment - # to - # * file (function): comment - if (Log ~ /^\([^)]*\): /) { - i = index(Log, ")") - files = files " " substr(Log, 1, i) - Log = substr(Log, i+3) - } - - # If "label: comment" is too long, break the line after the ":". - sep = " " - if ('"$length"' <= '"$indent"' + 1 + length(files) + index(Log, CR)) sep = "\n" indent_string - - # Print the label. - printf "%s*%s:", indent_string, files - - # Print each line of the log, transliterating \r to \n. - while ((i = index(Log, CR)) != 0) { - logline = substr(Log, 1, i-1) - if (logline ~ /[^'"$tab"' ]/) { - printf "%s%s\n", sep, logline - } else { - print "" - } - sep = indent_string - Log = substr(Log, i+1) - } -}' - -# Pattern to match the `revision' line of rlog output. -rlog_revision_pattern='^revision [0-9]+\.[0-9]+(\.[0-9]+\.[0-9]+)*(['"$tab"' ]+locked by: [^'"$tab"' $,.0-9:;@]*[^'"$tab"' $,:;@][^'"$tab"' $,.0-9:;@]*;)?['"$tab"' ]*$' - -case $hostname in -'') - hostname=`( - hostname || uname -n || uuname -l || cat /etc/whoami - ) 2>/dev/null` || { - echo >&2 "$0: cannot deduce hostname" - exit 1 - } - - case $hostname in - *.*) ;; - *) - domainname=`(domainname) 2>/dev/null` && - case $domainname in - *.*) hostname=$hostname.$domainname - esac - esac -esac - - -# Process the rlog output, generating ChangeLog style entries. - -# First, reformat the rlog output so that each line contains one log entry. -# Transliterate \n to \r so that multiline entries fit on a single line. -# Discard irrelevant rlog output. -$AWK <$rlogout ' - BEGIN { repository = "'"$repository"'" } - /^RCS file:/ { - if (repository != "") { - filename = $3 - if (substr(filename, 1, length(repository) + 1) == repository "/") { - filename = substr(filename, length(repository) + 2) - } - if (filename ~ /,v$/) { - filename = substr(filename, 1, length(filename) - 2) - } - if (filename ~ /(^|\/)Attic\/[^\/]*$/) { - i = length(filename) - while (substr(filename, i, 1) != "/") i-- - filename = substr(filename, 1, i - 6) substr(filename, i + 1) - } - } - rev = "?" - } - /^Working file:/ { if (repository == "") filename = $3 } - /'"$rlog_revision_pattern"'/, /^(-----------*|===========*)$/ { - if ($0 ~ /'"$rlog_revision_pattern"'/) { - rev = $2 - next - } - if ($0 ~ /^date: [0-9][- +\/0-9:]*;/) { - date = $2 - if (date ~ /\//) { - # This is a traditional RCS format date YYYY/MM/DD. - # Replace "/"s with "-"s to get ISO format. - newdate = "" - while ((i = index(date, "/")) != 0) { - newdate = newdate substr(date, 1, i-1) "-" - date = substr(date, i+1) - } - date = newdate date - } - time = substr($3, 1, length($3) - 1) - author = substr($5, 1, length($5)-1) - printf "%s %s %s %s %s %c", filename, rev, date, time, author, 13 - rev = "?" - next - } - if ($0 ~ /^branches: /) { next } - if ($0 ~ /^(-----------*|===========*)$/) { print ""; next } - if ($0 == "Initial revision" || $0 ~ /^file .+ was initially added on branch .+\.$/) { - $0 = "New file." - } - printf "%s%c", $0, 13 - } -' | - -# Now each line is of the form -# FILENAME REVISION YYYY-MM-DD HH:MM:SS[+-TIMEZONE] AUTHOR \rLOG -# where \r stands for a carriage return, -# and each line of the log is terminated by \r instead of \n. -# Sort the log entries, first by date+time (in reverse order), -# then by author, then by log entry, and finally by file name and revision -# (just in case). -sort +2 -4r +4 +0 | - -# Finally, reformat the sorted log entries. -$AWK ' - BEGIN { - logTZ = "'"$logTZ"'" - revision = "'"$revision"'" - - # Some awk variants do not understand "\r" or "\013", so we have to - # put a carriage return directly in the file. - CR=" " # <-- There is a single CR between the " chars here. - - # Initialize the fullname and mailaddr associative arrays. - '"$initialize_fullname"' - '"$initialize_mailaddr"' - - # Initialize indent string. - indent_string = "" - i = '"$indent"' - if (0 < '"$tabwidth"') - for (; '"$tabwidth"' <= i; i -= '"$tabwidth"') - indent_string = indent_string "\t" - while (1 <= i--) - indent_string = indent_string " " - } - - { - newlog = substr($0, 1 + index($0, CR)) - - # Ignore log entries prefixed by "#". - if (newlog ~ /^#/) { next } - - if (Log != newlog || date != $3 || author != $5) { - - # The previous log and this log differ. - - # Print the old log. - if (date != "") '"$printlogline"' - - # Logs that begin with "{clumpname} " should be grouped together, - # and the clumpname should be removed. - # Extract the new clumpname from the log header, - # and use it to decide whether to output a blank line. - newclumpname = "" - sep = "\n" - if (date == "") sep = "" - if (newlog ~ /^\{[^'"$tab"' }]*}['"$tab"' ]/) { - i = index(newlog, "}") - newclumpname = substr(newlog, 1, i) - while (substr(newlog, i+1) ~ /^['"$tab"' ]/) i++ - newlog = substr(newlog, i+1) - if (clumpname == newclumpname) sep = "" - } - printf sep - clumpname = newclumpname - - # Get ready for the next log. - Log = newlog - if (files != "") - for (i in filesknown) - filesknown[i] = 0 - files = "" - } - if (date != $3 || author != $5) { - # The previous date+author and this date+author differ. - # Print the new one. - date = $3 - time = $4 - author = $5 - - zone = "" - if (logTZ && ((i = index(time, "-")) || (i = index(time, "+")))) - zone = " " substr(time, i) - - # Print "date[ timezone] fullname ". - # Get fullname and email address from associative arrays; - # default to author and author@hostname if not in arrays. - if (fullname[author]) - auth = fullname[author] - else - auth = author - printf "%s%s %s ", date, zone, auth - if (mailaddr[author]) - printf "<%s>\n\n", mailaddr[author] - else - printf "<%s@%s>\n\n", author, "'"$hostname"'" - } - if (! filesknown[$1]) { - filesknown[$1] = 1 - if (files == "") files = " " $1 - else files = files ", " $1 - if (revision && $2 != "?") files = files " " $2 - } - } - END { - # Print the last log. - if (date != "") { - '"$printlogline"' - printf "\n" - } - } -' && - - -# Exit successfully. - -exec rm -f $llogout $rlogout - -# Local Variables: -# tab-width:4 -# End: diff --git a/lib-src/sorted-doc.c b/lib-src/sorted-doc.c deleted file mode 100644 index 89ecafd..0000000 --- a/lib-src/sorted-doc.c +++ /dev/null @@ -1,270 +0,0 @@ -/* Give this program DOCSTR.mm.nn as standard input - and it outputs to standard output - a file of texinfo input containing the doc strings. - - This version sorts the output by function name. - */ - -/* Synched up with: FSF 19.28. */ - -#include <../src/config.h> - -#include -#include -#if __STDC__ || defined(STDC_HEADERS) -# include /* for qsort() and malloc() */ -# include -static void *xmalloc (int); -# ifndef CONST -# define CONST const -# endif -#else -extern char *malloc (); -static void *xmalloc (); -# ifndef CONST -# define CONST -# endif -#endif - -#define NUL '\0' -#define MARKER '\037' - -#define DEBUG 0 - -typedef struct line LINE; - -struct line -{ - LINE *next; /* ptr to next or NULL */ - char *line; /* text of the line */ -}; - -typedef struct docstr DOCSTR; - -struct docstr /* Allocated thing for an entry. */ -{ - DOCSTR *next; /* next in the chain */ - char *name; /* name of the function or var */ - LINE *first; /* first line of doc text. */ - char type; /* 'F' for function, 'V' for variable */ -}; - - -/* Print error message. `s1' is printf control string, `s2' is arg for it. */ - -static void -error (char *s1, char *s2) -{ - fprintf (stderr, "sorted-doc: "); - fprintf (stderr, s1, s2); - fprintf (stderr, "\n"); -} - -/* Print error message and exit. */ - -static void -fatal (char *s1, char *s2) -{ - error (s1, s2); - exit (1); -} - -/* Like malloc but get fatal error if memory is exhausted. */ - -static void * -xmalloc (int size) -{ - char *result = malloc ((unsigned)size); - if (result == NULL) - fatal ("%s", "virtual memory exhausted"); - return result; -} - -static char * -strsav (char *str) -{ - char *buf = xmalloc (strlen (str) + 1); - (void) strcpy (buf, str); - return (buf); -} - -/* Comparison function for qsort to call. */ - -static int -cmpdoc (DOCSTR **a, DOCSTR **b) -{ - register int val = strcmp ((*a)->name, (*b)->name); - if (val) return val; - return (*a)->type - (*b)->type; -} - - -enum state -{ - WAITING, BEG_NAME, NAME_GET, BEG_DESC, DESC_GET -}; - -CONST char *states[] = -{ - "WAITING", "BEG_NAME", "NAME_GET", "BEG_DESC", "DESC_GET" -}; - -int -main (int argc, char *argv[]) -{ - register DOCSTR *dp = NULL; /* allocated DOCSTR */ - register LINE *lp = NULL; /* allocated line */ - register char *bp = 0; /* ptr inside line buffer */ - /* int notfirst = 0; / * set after read something */ - register enum state state = WAITING; /* state at start */ - int cnt = 0; /* number of DOCSTRs read */ - - DOCSTR *docs = 0; /* chain of allocated DOCSTRS */ - char buf[512]; /* line buffer */ - - while (1) /* process one char at a time */ - { - /* this char from the DOCSTR file */ - register int ch = getchar (); - - /* Beginnings */ - - if (state == WAITING) - { - if (ch == MARKER) - state = BEG_NAME; - } - else if (state == BEG_NAME) - { - cnt++; - if (dp == NULL) /* first dp allocated */ - { - docs = dp = (DOCSTR*) xmalloc (sizeof (DOCSTR)); - } - else /* all the rest */ - { - dp->next = (DOCSTR*) xmalloc (sizeof (DOCSTR)); - dp = dp->next; - } - lp = NULL; - dp->next = NULL; - bp = buf; - state = NAME_GET; - /* Record whether function or variable. */ - dp->type = ch; - ch = getchar (); - } - else if (state == BEG_DESC) - { - if (lp == NULL) /* first line for dp */ - { - dp->first = lp = (LINE*)xmalloc (sizeof (LINE)); - } - else /* continuing lines */ - { - lp->next = (LINE*)xmalloc (sizeof (LINE)); - lp = lp->next; - } - lp->next = NULL; - bp = buf; - state = DESC_GET; - } - - /* process gets */ - - if (state == NAME_GET || state == DESC_GET) - { - if (ch != MARKER && ch != '\n' && ch != EOF) - { - *bp++ = ch; - } - else /* saving and changing state */ - { - *bp = NUL; - bp = strsav (buf); - - if (state == NAME_GET) - dp->name = bp; - else - lp->line = bp; - - bp = buf; - state = (ch == MARKER) ? BEG_NAME : BEG_DESC; - } - } /* NAME_GET || DESC_GET */ - if (ch == EOF) - break; - } - - { - DOCSTR **array; - register int i; /* counter */ - - /* build array of ptrs to DOCSTRs */ - - array = (DOCSTR**)xmalloc (cnt * sizeof (*array)); - for (dp = docs, i = 0; dp != NULL ; dp = dp->next) - array[i++] = dp; - - /* sort the array by name; within each name, by type */ - - qsort ((char*)array, cnt, sizeof (DOCSTR*), - /* was cast to (int (*)(CONST void *, CONST void *)) - but that loses on HP because CONST_IS_LOSING. */ - /* This one loses too: (int (*)()) */ - /* Ok, so let's try const instead of CONST. Fuck me!!! */ - (int (*)(const void *, const void *)) - cmpdoc); - - /* write the output header */ - - printf ("\\input texinfo @c -*-texinfo-*-\n"); - printf ("@setfilename ../info/summary\n"); - printf ("@settitle Command Summary for GNU Emacs\n"); - printf ("@unnumbered Command Summary for GNU Emacs\n"); - printf ("@table @asis\n"); - printf ("\n"); - printf ("@let@ITEM@item\n"); - printf ("@def@item{@filbreak@vskip5pt@ITEM}\n"); - printf ("@font@tensy cmsy10 scaled @magstephalf\n"); - printf ("@font@teni cmmi10 scaled @magstephalf\n"); - printf ("@def\\{{@tensy@char110}}\n"); /* this backslash goes with cmr10 */ - printf ("@def|{{@tensy@char106}}\n"); - printf ("@def@{{{@tensy@char102}}\n"); - printf ("@def@}{{@tensy@char103}}\n"); - printf ("@def<{{@teni@char62}}\n"); - printf ("@def>{{@teni@char60}}\n"); - printf ("@chardef@@64\n"); - printf ("@catcode43=12\n"); - printf ("@tableindent-0.2in\n"); - - /* print each function from the array */ - - for (i = 0; i < cnt; i++) - { - printf ("\n@item %s @code{%s}\n@display\n", - array[i]->type == 'F' ? "Function" : "Variable", - array[i]->name); - - for (lp = array[i]->first; lp != NULL ; lp = lp->next) - { - for (bp = lp->line; *bp; bp++) - { - /* the characters "@{}" need special treatment */ - if (*bp == '@' || *bp == '{' || *bp == '}') - { - putchar('@'); - } - putchar(*bp); - } - putchar ('\n'); - } - printf("@end display\n"); - } - - printf ("@end table\n"); - printf ("@bye\n"); - } - - return 0; -} diff --git a/lib-src/update-autoloads.sh b/lib-src/update-autoloads.sh deleted file mode 100644 index ee56e65..0000000 --- a/lib-src/update-autoloads.sh +++ /dev/null @@ -1,137 +0,0 @@ -#!/bin/sh -### update-autoloads.sh --- update auto-autoloads.el as necessary - -# Author: Jamie Zawinski, Ben Wing, Martin Buchholz, Steve Baur -# Maintainer: Steve Baur -# 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. - -### Commentary: - -### Code: - -set -eu - -# This means we're running in a Sun workspace -test -d ../era-specific && cd ../editor - -# get to the right directory -test ! -d ./lisp -a -d ../lisp && cd .. -if test ! -d ./lisp ; then - echo $0: neither ./lisp/ nor ../lisp/ exist - exit 1 -fi - -test -z "$EMACS" && EMACS="./src/xemacs" -echo " (using $EMACS)" - -export EMACS - -EMACS_DIR=`cd \`dirname $EMACS\` && pwd`; -CANON_PWD=`pwd` -# Account for various system automounter configurations -if test -d "/net"; then - if test -d "/tmp_mnt/net"; then tdir="/tmp_mnt/net"; else tdir="/tmp_mnt"; fi - EMACS_DIR=`echo "$EMACS_DIR" | \ - sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` - CANON_PWD=`echo "$CANON_PWD" | \ - sed -e "s|^${tdir}/|/net/|" -e "s|^/a/|/net/|" -e "s|^/amd/|/net/|"` -fi -REAL="$EMACS_DIR/`basename $EMACS`" - -echo "Rebuilding autoloads in $CANON_PWD" -echo " with $REAL..." - -if [ "`uname -r | sed 's/\(.\).*/\1/'`" -gt 4 ]; then - echon() - { - /bin/echo $* '\c' - } -else - echon() - { - echo -n $* - } -fi - -# Compute patterns to ignore when searching for files -# These directories don't have autoloads or are partially broken. -ignore_dirs="egg eos ilisp its locale mel mu sunpro term tooltalk" - -# Prepare for autoloading directories with directory-specific instructions -make_special_commands='' -make_special () { - dir="$1"; shift; - ignore_dirs="$ignore_dirs $dir" - make_special_commands="$make_special_commands \ - (cd \"lisp/$dir\" && ${MAKE:-make} EMACS=$REAL ${1+$*});" -} - -# Only use Mule XEmacs to build Mule-specific autoloads & custom-loads. -echon "Checking for Mule support..." -lisp_prog='(princ (featurep (quote mule)))' -mule_p="`$EMACS -batch -q -no-site-file -eval \"$lisp_prog\"`" -if test "$mule_p" = nil ; then - echo No - ignore_dirs="$ignore_dirs mule leim language skk" -else - echo Yes -fi - -## AUCTeX is a Package now -# if test "$mule_p" = nil ; then -# make_special auctex autoloads -# else -# make_special auctex autoloads MULE_EL=tex-jp.elc -# fi -#make_special cc-mode autoloads -# EFS is now packaged -#make_special efs autoloads -#make_special eos autoloads # EOS doesn't have custom or autoloads -# Hyperbole is now packaged -# make_special hyperbole autoloads -# make_special ilisp autoloads -# oobr is now packaged -# make_special oobr HYPB_ELC='' autoloads -## W3 is a package now -##make_special w3 autoloads - -dirs= -for dir in lisp/*; do - if test -d $dir \ - -a $dir != lisp/CVS \ - -a $dir != lisp/SCCS; then - for ignore in $ignore_dirs; do - if test $dir = lisp/$ignore; then - continue 2 - fi - done - dirs="$dirs $dir" - fi -done - -$EMACS -batch -q -no-site-file -eval '(setq autoload-package-name "Standard")' \ - -l autoload -f batch-update-directory lisp - -# set -x -for dir in $dirs; do - $EMACS -batch -q -no-site-file -l autoload -f batch-update-directory $dir -done - -# eval "$make_special_commands" diff --git a/lib-src/wakeup.c b/lib-src/wakeup.c deleted file mode 100644 index 979bd82..0000000 --- a/lib-src/wakeup.c +++ /dev/null @@ -1,63 +0,0 @@ -/* Program to produce output at regular intervals. */ - -#include <../src/config.h> - -#if __STDC__ || defined(STDC_HEADERS) -#include -#include -#endif - -#include -#include - -#ifdef WINDOWSNT -#define WIN32_LEAN_AND_MEAN -#include -#undef sleep -#define sleep(t) Sleep ((t) * 1000) -#define getppid() (0) -#undef HAVE_SYS_TIME_H -#endif /* WINDOWSNT */ - -#ifdef TIME_WITH_SYS_TIME -#include -#include -#else -#ifdef HAVE_SYS_TIME_H -#include -#else -#include -#endif -#endif - -int -main (int argc, char *argv[]) -{ - int period = 60; - - if (argc > 1) - period = atoi (argv[1]); - - while (1) - { - /* Make sure wakeup stops when Emacs goes away. */ - if (getppid () == 1) - return 0; - printf ("Wake up!\n"); - /* If fflush fails, then our stdout pipe is broken. */ - if (fflush (stdout) != 0) - return 0; - /* If using a period of 60, produce the output when the minute - changes. */ - if (period == 60) - { - time_t when; - struct tm *tp; - time (&when); - tp = localtime (&when); - sleep (60 - tp->tm_sec); - } - else - sleep (period); - } -} diff --git a/lib-src/yow.c b/lib-src/yow.c deleted file mode 100644 index f5b7410..0000000 --- a/lib-src/yow.c +++ /dev/null @@ -1,178 +0,0 @@ -/* - * yow.c - * - * Print a quotation from Zippy the Pinhead. - * Qux March 6, 1986 - * - * With dynamic memory allocation. - */ - -/* Synched up with: FSF 19.28. */ - -#include <../src/config.h> - -#include -#include -#include <../src/paths.h> /* For PATH_DATA. */ - -#if __STDC__ || defined(STDC_HEADERS) -#include -#include -#include -#include /* for time() */ -#endif - -#define BUFSIZE 80 -#define SEP '\0' - -#ifndef YOW_FILE -#define YOW_FILE "yow.lines" -#endif - -void yow (FILE *fp); -void setup_yow (FILE *fp); - -#ifdef MSDOS -#define rootrelativepath(rel) \ -({\ - static char res[BUFSIZE], *p;\ - strcpy (res, argv[0]);\ - p = res + strlen (res);\ - while (p != res && *p != '/' && *p != '\\' && *p != ':') p--;\ - strcpy (p + 1, "../");\ - strcpy (p + 4, rel);\ - &res;}) -#endif - -int -main (int argc, char *argv[]) -{ - FILE *fp; - char file[BUFSIZ]; - - if (argc > 2 && !strcmp (argv[1], "-f")) - strcpy (file, argv[2]); - else -#ifdef PATH_DATA -#ifdef vms - sprintf (file, "%s%s", PATH_DATA, YOW_FILE); -#else - sprintf (file, "%s/%s", PATH_DATA, YOW_FILE); -#endif -#else /* !PATH_DATA */ - { - fprintf (stderr, - "%s: the location of the \"%s\" file was not supplied at compile-time.\n\ - You must supply it with the -f command-line option.\n", - argv[0], YOW_FILE); - exit (1); - } -#endif - - if ((fp = fopen(file, "r")) == NULL) { - perror(file); - exit(1); - } - - /* initialize random seed */ - srand((int) (getpid() + time((time_t *) 0))); - - setup_yow(fp); - yow(fp); - fclose(fp); - return 0; -} - -static long len = -1; -static long header_len; - -#define AVG_LEN 40 /* average length of a quotation */ - -/* Sets len and header_len */ -void -setup_yow(fp) - FILE *fp; -{ - int c; - - /* Get length of file */ - /* Because the header (stuff before the first SEP) can be very long, - * thus biasing our search in favor of the first quotation in the file, - * we explicitly skip that. */ - while ((c = getc(fp)) != SEP) { - if (c == EOF) { - fprintf(stderr, "File contains no separators.\n"); - exit(2); - } - } - header_len = ftell(fp); - if (header_len > AVG_LEN) - header_len -= AVG_LEN; /* allow the first quotation to appear */ - - if (fseek(fp, 0L, 2) == -1) { - perror("fseek 1"); - exit(1); - } - len = ftell(fp) - header_len; -} - - -/* go to a random place in the file and print the quotation there */ -void -yow (fp) - FILE *fp; -{ - long offset; - int c, i = 0; - char *buf; - unsigned int bufsize; - - offset = rand() % len + header_len; - if (fseek(fp, offset, 0) == -1) { - perror("fseek 2"); - exit(1); - } - - /* Read until SEP, read next line, print it. - (Note that we will never print anything before the first separator.) - If we hit EOF looking for the first SEP, just recurse. */ - while ((c = getc(fp)) != SEP) - if (c == EOF) { - yow(fp); - return; - } - - /* Skip leading whitespace, then read in a quotation. - If we hit EOF before we find a non-whitespace char, recurse. */ - while (isspace(c = getc(fp))) - ; - if (c == EOF) { - yow(fp); - return; - } - - bufsize = BUFSIZE; - buf = (char *) malloc(bufsize); - if (buf == (char *)0) { - fprintf(stderr, "can't allocate any memory\n"); - exit (3); - } - - buf[i++] = c; - while ((c = getc(fp)) != SEP && c != EOF) { - buf[i++] = c; - - if (i == bufsize-1) { - /* Yow! Is this quotation too long yet? */ - bufsize *= 2; - buf = (char *)realloc(buf, bufsize); - if (buf == (char *)0) { - fprintf(stderr, "can't allocate more memory\n"); - exit (3); - } - } - } - buf[i++] = 0; - printf("%s\n", buf); -} - diff --git a/lisp/ChangeLog b/lisp/ChangeLog deleted file mode 100644 index 1da4016..0000000 --- a/lisp/ChangeLog +++ /dev/null @@ -1,4278 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-22 Jan Vroonhof - - * userlock.el (ask-user-about-supersession-threat-dbox): Guard - against window close (Fix Bug #460). - (ask-user-about-lock-dbox): Idem. - -1999-02-25 SL Baur - - * mule/mule-charset.el (charset-leading-byte): New function. - From Kazuyuki IENAGA - -1999-02-12 Andy Piper - - * about.el (xemacs-hackers): change andy's email address. - (about-url-alist): change andy's web page address. - (about-xemacs): add piper. - -1999-02-16 SL Baur - - * dumped-lisp.el (preloaded-file-list): Core mule files moved out - of mule-base into lisp/mule. - -1999-02-16 SL Baur - - * mule/arabic.el: - mule/canna-leim.el: - mule/chinese.el: - mule/cyrillic.el: - mule/english.el: - mule/european.el: - mule/greek.el: - mule/hebrew.el: - mule/japanese.el: - mule/kinsoku.el: - mule/korean.el: - mule/misc-lang.el: - mule/mule-category.el: - mule/mule-ccl.el: - mule/mule-charset.el: - mule/mule-cmds.el: - mule/mule-coding.el: - mule/mule-files.el: - mule/mule-help.el: - mule/mule-init.el: - mule/mule-misc.el: - mule/mule-tty-init.el: - mule/mule-x-init.el: - mule/viet-chars.el: Remerge from mule-base. - - * dumped-lisp.el (preloaded-file-list): Core mule files moved out - of mule-base into lisp/mule. - -1999-02-10 Adrian Aichner - - * process.el (exec-to-string): Use `shell-command-switch' in place - of hard-wired "-c" (for WindowsNT). - -1999-02-08 Charles G Waldman - - * menubar-items.el (default-menubar): Remove obsolete - "Gopher" item - -1999-02-06 Jan Vroonhof - - * package-admin.el (package-admin-get-install-dir): First fall - back to the location of xemacs-base for non-mule packages. - -1999-02-15 Martin Buchholz - - * paths.el: - - improved automounter tmp directory support. - - support 4 (!) empirically discovered automounter conventions - -1999-02-12 SL Baur - - * etags.el (pop-tag-mark): autoload to match key binding. - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 Jan Vroonhof - - * package-get.el (package-get-remote-filename): Don't bug out for - a local file name in the search entry. - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-01-19 Didier Verna - - * replace.el (replace-search-function): new variable containing a - function to perform a search-forward. - (replace-re-search-function): new variable containing a function - to perform a re-search-forward. - (perform-replace): use them. - -1999-01-25 Didier Verna - - * select.el (selection-owner-p): use the name `XEmacs'. - (cut-copy-clear-internal): ditto. - -1999-01-18 Andy Piper - - * about.el (about-url-alist): Update my entry. - (xemacs-hackers): Ditto. - -1999-01-14 Adrian Aichner - - * buffer.el (switch-to-buffer): Fixing documentation. - * minibuf.el (minibuffer-completion-table): ditto. - * cl-macs.el (return-from): ditto. - -1999-01-04 Didier Verna - - * replace.el (delete-non-matching-lines): temporarily disable - case-folding when called interactively with a regexp containing - uppercase characters. - (delete-matching-lines): ditto. - (count-matches): ditto. - (list-matching-lines): ditto. - -1999-01-07 Colin Rafferty - - * window.el (shrink-window-if-larger-than-buffer): Clean up. Only - abort if current window is split horizontally, not if others are - split. Got rid of unnecessary minibuffer checking. Also, add - some comments (it's still complex). - -1999-01-12 Robert Pluim - - * package-get.el: changed address for doc.ic.ac.uk to - sunsite.doc.ic.ac.uk - -1999-01-09 Oscar Figueiredo - - * ldap.el (toplevel): Remove requires so that the file compiles - with a non LDAP-enabled XEmacs binary. Provide `ldap'. - -1999-01-10 J. Kean Johnston - - * dump-paths.el: Calculate module-directory and set - module-load-path to the load path for modules. - - * loadup.el: Get bootstrap value of module-load-path from the - environment variable EMACSBOOTSTRAPMODULEPATH. - - Display the module load path if we're debugging paths. - - * setup-paths.el: Added function paths-find-site-module-directory. - - Added function paths-find-module-directory. - - Added function paths-construct-module-load-path. Uses new - environment variable EMACSMODULEPATH. - -1998-12-30 Martin Buchholz - - * font.el (font-default-object-for-device): - Oops! This `or' can't be replaced by `unless'. - Fixed inability to run w3, among other things. - -1998-12-17 Charles G. Waldman - - * package-admin.el: Change initialization of - package-admin-install-function dependent on system type. - Change package-admin-install-function-mswindows to use - "minitar". - -1998-12-23 Hrvoje Niksic - - * mouse.el (default-mouse-motion-handler): Disable help echo while - in the minibuffer. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-07 Jan Vroonhof - - * package-ui.el (pui-list-packages): Set truncate-lines. - - * package-get.el (package-get-download-menu): Use - `package-ui-add-site'. Add a a toggle to indicate it is in the list. - - * package-ui.el (pui-help): Ditch in favor of `describe-mode' - (pui-help-string): idem. - (list-packages-mode): New major mode. - (pui-list-packages): Use 'list-packages-mode' in the package buffer. - (pui-install-selected-packages): Add suport for removing packages. - (pui-toggle-package-delete-key): New function. - (pui-popup-context-sensitive): New kludge. - (pui-list-packages): Add warning when `package-get-remote' is nil. - (package-ui-add-site): New function. - -1998-12-01 Didier Verna - - * hyper-apropos.el (hyper-where-is): added the missing autoload. - -1998-11-29 Oscar Figueiredo - - * ldap.el: Custom-ized - (toplevel): Do not provide `ldap' which is provided by C level - LDAP code - (ldap-search): Docstring and stylistic fixes as suggested by Hrvoje - -1998-12-05 Hrvoje Niksic - - * isearch-mode.el (isearch-mode): Really fix keymap lossage. - -1998-12-17 Andy Piper - - * sound.el (sound-load-list): name changed from sound-load-alist. - (sound-extension-list): name changed from sound-ext-list. - (load-default-sounds): use new names. - (load-sound-file): use new names. - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-11-30 Hrvoje Niksic - - * cus-dep.el (Custom-make-dependencies): Be smarter about trapping - errors. - -1998-12-04 Hrvoje Niksic - - * wid-edit.el (widget-echo-this-extent): Set - help-echo-owns-message to t. - -1998-11-30 Greg Klanderman - - * package-get.el (package-get-download-menu): use toggles for - each site in the download site menu. - -1998-12-01 Jan Vroonhof - - * package-get.el (package-get): If we cannot find a package - because package-get-remote is not set, give a more helpful - error message. - -1998-11-30 Greg Klanderman - - * package-get.el (package-get-remote-filename): use an EFS path - with user anonymous if no user is specified. - -1998-12-10 Jan Vroonhof - - * faces.el (face-spec-set): Re-init fallfacks for default after - calling reset-face on the default face. - -1998-12-10 Jan Vroonhof - - * package-admin.el (package-admin-default-install-function): - Behave as advertised. Make sure the pkg-dir is proper for - default-directory. - (package-admin-add-binary-package): Make sure the pkg-dir is - proper for default-directory. - (package-admin-install-function-mswindows): Make sure the pkg-dir - is proper for default-directory. - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-12-05 SL Baur - - * files.el (binary-file-regexps): regexp-opt is not available at - bytecompile time. - -1998-11-30 Martin Buchholz - - * x-win-xfree86.el: - * x-win-sun.el (x-win-init-sun): - * x-win-sun.el: - * x-mouse.el (mouse-track-and-copy-to-cutbuffer): - * x-iso8859-1.el: - * x-init.el (init-post-x-win): - * x-init.el (init-pre-x-win): - * x-init.el (x-initialize-compose): - * x-init.el: - * x-compose.el: - * winnt.el: - * widget.el: - * wid-edit.el (widget-glyph-click): - * wid-edit.el (widget-glyph-find): - * wid-edit.el (widget-type): - * view-less.el (view-buffer-other-window): - * very-early-lisp.el: - * version.el: - * toolbar.el: - * toolbar-items.el: - * term/sun.el (suntool-map): - * term/sun-mouse.el: - * term/internal.el: - * syntax.el (modify-syntax-entry): - * symbol-syntax.el: - * subr.el: - * startup.el (lock-directory): - * simple.el (set-comment-column): - * simple.el (backward-delete-char-untabify): - * shadow.el (find-emacs-lisp-shadows): - * shadow.el: - * setup-paths.el (paths-construct-info-path): - * select.el (cut-copy-clear-internal): - * process.el (call-process-region): - * process.el (start-process-shell-command): - * process.el: - * paths.el (rmail-spool-directory): - * paragraphs.el (use-hard-newlines): - * package-get.el (package-get-dependencies): - * package-admin.el (package-admin-delete-binary-package): - * obsolete.el (truncate-string): - * obsolete.el (store-substring): - * mouse.el (default-mouse-track-maybe-own-selection): - * mouse.el (mouse-yank-at-point): - * modeline.el: - * modeline.el (mouse-drag-modeline): - * minibuf.el (read-directory-name-internal): - * minibuf.el (read-file-name-internal): - * minibuf.el (read-file-name-internal-1): - * minibuf.el (read-file-name-2): - * minibuf.el (exact-minibuffer-completion-p): - * minibuf.el (read-from-minibuffer): - * minibuf.el: - * menubar.el (check-menu-syntax): - * map-ynp.el (map-y-or-n-p): - * make-docfile.el (docfile-out-of-date): - * loadup.el ((member "run-temacs" command-line-args)): - * loadup.el ((member "no-site-file" command-line-args)): - * loadup.el (really-early-error-handler): - * loadup.el: - * loadhist.el: - * loaddefs.el: - * lisp-mnt.el (lm-verify): - * lib-complete.el (lib-complete:cache-completions): - * lib-complete.el (library-all-completions): - * itimer.el (itimer-run-expired-timers): - * info.el (Info-mode): - * info.el (Info-insert-file-contents): - * info.el (Info-rebuild-dir): - * info.el (Info-build-dir-anew): - * info.el (Info-parse-dir-entries): - * info.el (Info-dir-outdated-p): - * info.el (Info-insert-dir): - * info.el (info-xref): - * info.el: - * hyper-apropos.el (hyper-apropos-get-doc): - * hyper-apropos.el (hyper-describe-face): - * hyper-apropos.el (hyper-apropos-mode): - * hyper-apropos.el: - * help.el (list-processes): - * help.el: - * gnuserv.el: - * font.el (mswindows-font-create-name): - * font.el (font-default-font-for-device): - * font.el (x-font-create-object): - * font.el (font-registry): - * font.el: - * font-lock.el (font-lock-keywords): - * font-lock.el: - * finder.el (finder-compile-keywords): - * find-paths.el (paths-find-recursive-path): - * fill.el (set-justification-center): - * fill.el (fill-region-as-paragraph): - * files.el (insert-directory): - * files.el (wildcard-to-regexp): - * files.el (recover-file): - * files.el (basic-save-buffer): - * files.el (delete-auto-save-file-if-necessary): - * files.el (file-relative-name): - * files.el (backup-extract-version): - * files.el (backup-buffer): - * files.el (set-visited-file-name): - * files.el (set-auto-mode): - * files.el (interpreter-mode-alist): - * files.el: - * files.el (find-file-noselect): - * files.el (abbreviate-file-name): - * files.el (parse-colon-path): - * files.el (directory-abbrev-alist): - * etags.el (visit-tags-table-buffer): - * easymenu.el (easy-menu-define): - * dragdrop.el (experimental-dragdrop-drag): - * dragdrop.el (dragdrop-drop-do-functions): - * dragdrop.el (dragdrop-drop-at-point): - * disass.el (disassemble-1): - * disass.el (disassemble-internal): - * disass.el (disassemble): - * disass.el: - * derived.el (derived-mode-init-mode-variables): - * derived.el (define-derived-mode): - * custom.el (defgroup): - * cus-edit.el (custom-quote): - * config.el: - * code-process.el (open-network-stream): - * code-process.el (start-process): - * code-process.el (call-process-region): - * code-process.el (call-process): - * code-process.el: - * code-files.el (insert-file-contents): - * code-files.el: - * code-files.el (buffer-file-coding-system-for-read): - * cmdloop.el (yes-or-no-p-minibuf): - * cl.el: - * cl-macs.el: - * cl-extra.el: - * callers-of-rpt.el (make-caller-report): - * callers-of-rpt.el: - * bytecomp.el (batch-byte-recompile-directory): - * bytecomp.el (batch-byte-compile-1): - * bytecomp.el (batch-byte-compile): - * bytecomp.el (display-call-tree): - * bytecomp.el (byte-compile-insert): - * bytecomp.el (byte-compile-two-args-19->20): - * bytecomp.el (byte-compile-variable-ref): - * bytecomp.el (byte-compile-form): - * bytecomp.el (byte-compile-top-level-body): - * bytecomp.el (byte-compile-out-toplevel): - * bytecomp.el (byte-compile-byte-code-maker): - * bytecomp.el (byte-compile-file-form-defmumble): - * bytecomp.el (byte-compile-file-form): - * bytecomp.el (byte-compile-keep-pending): - * bytecomp.el (byte-compile-insert-header): - * bytecomp.el (byte-compile-from-buffer): - * bytecomp.el (byte-compile-file): - * bytecomp.el (byte-recompile-file): - * bytecomp.el (byte-compile-close-variables): - * bytecomp.el (byte-compile-warn-about-unused-variables): - * bytecomp.el (byte-compile-warn-about-unresolved-functions): - * bytecomp.el (byte-compiler-legal-options): - * bytecomp.el (byte-compile-lapcode): - * bytecomp.el (byte-optimize-log): - * bytecomp.el ((fboundp 'defsubst)): - * bytecomp.el: - * bytecomp-runtime.el: - * byte-optimize.el (byte-optimize-apply): - * byte-optimize.el (car): - * byte-optimize.el (byte-optimize-form): - * byte-optimize.el (byte-optimize-form-code-walker): - * byte-optimize.el: - * build-report.el (build-report-insert-installation-file): - * build-report.el (build-report): - * auto-show.el: - * apropos.el (apropos-documentation): - - mega patch - - clean up byte-compile warnings - - remove unused variables - - Use common lisp style hashtable functions - - byte compiler cleanup - - use #'(lambda ...) instead of '(lambda ...) or (function (lambda ...)) - - remove old backquote syntax usage - - move some cl functionality into C for speed. - - remove last remaining VMS support - - spelling fixes - - implement last, butlast, nbutlast, copy-list in C. - - new macro ignore-file-errors, similar to ignore-errors - (ignore-file-errors (delete-file "foo")) - - get frequent garbage collection during loadup.el by tweaking - gc-cons-threshold, rather than explicitly calling garbage-collect - - default delete-key-deletes-forward to `t'. - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-11-27 Jan Vroonhof - - * easymenu.el (easy-menu-add-item): Wraper around add-menu-btton. - (easy-menu-item-present-p): Wrapper around find-menu-item. - (easy-menu-remove-item): Wrapper around delete-menu-item. - - * menubar.el (delete-menu-item): Add 'from-menu' argument. - (add-menu-button): Add 'in-menu' argument. - (add-menu-item-1): Add in-menu support to helper function. - -1998-11-27 Katsumi Yamaoka - - * isearch-mode.el (isearch-mode): Fix keymap lossage. - -1998-11-26 Jan Vroonhof - - * faces.el (get-custom-frame-properties): Revert Hrvoje Niksic change - of Dec 4, 1997. - -1998-11-25 Hrvoje Niksic - - * process.el (shell-command-on-region): Report if the command - succeeded or failed. - -1998-11-24 Hrvoje Niksic - - * subr.el (buffer-substring-no-properties): Comment out. - -1998-11-07 Adrian Aichner - - * msw-faces.el (mswindows-find-smaller-font): Turning font names - into font instances first, like `x-frob-font-size' does. - (mswindows-find-larger-font): ditto - -1998-11-04 Greg Klanderman - - * package-ui.el (pui-install-selected-packages): fix args in call - to `package-get'. - -1998-10-29 Jan Vroonhof - - * package-get.el (host-name): New widget type. - (package-get-remote): Better customization using new type. - (package-get-download-sites): idem dito. - - (package-get-custom): Do not use package-get-all untill we have - runtime dependencies. - - (package-get-remove-copy): Default to 't' we no longer need this - kludge as we do not currently use depenencies. - - (package-get-was-current): New variable. - (package-get-require-base): New 'force-current' argument. - (package-get-update-base): idem - (package-get-package-provider): idem - (package-get-locate-index-file): New 'no-remote' argument. - (package-get-locate-file): idem. - - (package-get-maybe-save-index): New function. - (package-get-update-base): Use it. - -1998-10-28 Greg Klanderman - - * package-get.el (package-get-remote): default to nil; by default, - don't go out to the net via EFS. They must select a download site. - (package-get-download-sites): new variable. - (package-get-download-menu): new function. - (package-get-locate-index-file): new function. - (package-get-update-base): use it. - - * menubar-items.el (default-menubar): add "Update Package Index" - and "Add Download Site" menus under Options | Manage Packages. - -1998-10-19 Greg Klanderman - - * package-get.el (package-get): bugfix code checking installed version - for case where package is not currently installed. - (package-get-require-signed-base-updates): new variable. - (package-get-update-base-from-buffer): remove REMOTE-SOURCE arg, it was - deemed not a goot thing. Use the variable - package-get-allow-unsigned-base-updates instead. - -1998-10-16 Greg Klanderman - - * package-get.el (package-get): Don't install an older version than - we already have unless explicitly told to. Issue a warning. - - * package-ui.el (pui-add-required-packages): when adding - dependencies, don't add packages that are up to date. - (pui-package-symbol-char): Don't consider a package out of date - if you have a newer version installed than the latest version in - package-get-base. - - * package-get.el (package-get-base-filename): document that it may - be a path relative to package-get-remote; new default value. - (package-get-locate-file): new function. - (package-get-update-base): use it to expand package-get-base-filename. - (package-get-save-base): new function to save the package-get database - to file. - (package-get-update-base-from-buffer): add REMOTE-SOURCE argument. - (package-get-update-base): pass the REMOTE-SOURCE arg. - (package-get-update-base-entry): call package-get-custom-add-entry. - (package-get-file-installed-p): removed; no longer needed. - (package-get-create-custom): ditto. - (toplevel): remove code to build and load package-get-custom.el - (package-get-custom-add-entry): new function. - -1998-10-12 Hrvoje Niksic - - * wid-edit.el (widget-button-click): Don't switch window. - -1998-10-22 Jan Vroonhof - - * cus-face.el (custom-set-face-update-spec): Add autoload cookie - -1998-10-20 Malcolm Box - - * etags.el (find-tag-default): Run find-tag-hook using - run-hooks rather than funcall - -1998-10-19 Hrvoje Niksic - - * isearch-mode.el (isearch-mode): Set the current minor mode maps - and the current local map as the parents to isearch-mode-map. - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-10-15 Greg Klanderman - - * package-get.el (package-get-update-base): use - insert-file-contents-internal, not insert-file-contents-literally. - -1998-10-14 Jan Vroonhof - - * auto-save.el: expand-file 'auto-save-*-dir' at runtime not at - dump time. - -1998-10-15 Greg Klanderman - - * package-get.el (package-get-update-base-entry): new function. - (package-get-update-base): renamed; was `package-get-load-base'. - cleanup, and use package-get-update-base-from-buffer. - (package-get-update-base-from-buffer): new function. - (package-get-update-base-entries): new; helper for above. - Do not eval lisp grabbed over ftp; parse it from new format. - -1998-10-15 Greg Klanderman - - * files.el (set-auto-mode): Don't play games loading package-get - database; package-get-package-provider will handle it all. - -1998-10-14 Greg Klanderman - - * package-get.el (package-get-base-filename): new variable. - (package-get-require-base): new function. - (package-get-pgp-signed-begin-line): new variable. - (package-get-pgp-signature-begin-line): ditto. - (package-get-pgp-signature-end-line): ditto. - (package-get-load-base): new function. - (package-get-interactive-package-query): - (package-get-update-all): - (package-get-dependencies): - (package-get-package-provider): - (package-get-custom): use package-get-require-base. - [package-get-custom loading]: disable for now. - - * package-ui.el (pui-list-packages): use (package-get-require-base) - -1998-10-14 Jan Vroonhof - - * package-ui.el: Correct obvious thinko in choosing extent face. - -1998-10-12 Jan Vroonhof - - * menubar-items.el (default-menubar): pui-list-package has nothing - to with Customize. Move all the package stuff to a new Item in Options. - - * package-ui.el (pui-menu): Add menu and Popup menu. - - * package-get.el (package-get): Use new - package-admin-get-install-dir. - - * package-admin.el (package-admin-get-install-dir): New syntax. - Conserve package location and put mule packages where mule-base is. - - * package-get.el : Customized - - * package-ui.el (pui): Customized - (pui-package-install-dest-dir): New variable. - (pui-install-selected-packages): Use it - -1998-10-12 SL Baur - - * package-get.el (package-get-interactive-package-query): Move - dependency on package-get-base to run-time. - (package-get-update-all): Ditto. - (package-get-dependencies): Ditto. - (package-get-package-provider): Ditto. - (package-get-custom): Ditto. - -1998-10-11 Glynn Clements - - * events.el: Remove 'ascii-character property from 'backspace - and 'delete symbols - -1998-10-11 SL Baur - - * package-get-base.el: removed. - -1998-09-23 Didier Verna - - * simple.el (search-caps-disable-folding): moved from isearch-mode.el - (no-upper-case-p): new function. - (with-search-caps-disable-folding): new macro. - (with-interactive-search-caps-disable-folding): new macro. - (zap-to-char): In interactive mode, do a case-sensitive search if - the character is uppercase. - (zap-up-to-char): ditto. - - * replace.el (perform-replace): use the function no-upper-case-p. - - * isearch-mode.el (isearch-fix-case): ditto. - make obsolete `with-caps-disable-folding' and - `isearch-no-upper-case-p'. - - * etags.el (find-tag-internal): use `with-search-caps-disable-folding'. - (tags-search): ditto. - (tags-query-replace): ditto. - - * info.el (Info-search): ditto. - -1998-10-07 Jan Vroonhof - - * x-font-menu.el (font-menu-set-font): Respect font-menu-frame-local - -1998-10-07 Greg Klanderman - - * package-admin.el (package-admin-rmtree): rewritten. need to - check for "." and ".." before symlink check. expand files and - directories with respect to DIRECTORY, not default-directory. - -1998-10-04 Greg Klanderman - - * package-get.el (package-get-all): add INSTALL-DIR argument. - -1998-10-06 Greg Klanderman - - * package-ui.el (pui-add-required-packages): new function, select - dependent packages. - (pui-display-keymap): bind it. - (pui-help-string): document it. - (pui-install-selected-packages): package-get-all -> package-get. - - * package-get.el (package-get-dependencies): new function. - -1998-10-04 Hrvoje Niksic - - * isearch-mode.el (isearch-done): Use regexp-search-ring-max for - regexps. - -1998-10-05 Hrvoje Niksic - - * mouse.el (default-mouse-track-point-at-opening-quote-p): New - function. - (default-mouse-track-normalize-point): Use it. - -1998-09-30 Jan Vroonhof - - * package-admin.el (package-admin-delete-binary-package): - General cleanup. Remove unnessary use of progn and - save-excursion. - (package-admin-delete-binary-package): Do NOT mess with file - modes. That is evil. - (package-admin-delete-binary-package): Wrap all deleting in - condition-case. The data in MANIFEST is untrustworthy. - (package-admin-delete-binary-package): Let the OS worry about non - empty directories. - -1998-10-09 SL Baur - - * lisp-mnt.el (lm-commentary): Fix InfoDock-style comment - processing. - (lm-report-bug): Fix mail address to send bug reports to. - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-08-14 Jan Vroonhof - - * files.el (auto-mode-alist): Enhanced regexp for perl-mode - -1998-09-22 Karl M. Hegbloom - - * info.el (Info-mode): Document page turning by double clicks in - docstring so `M-x describe-mode' will display it. - -1998-09-20 Karl M. Hegbloom - - * info.el (Info-mouse-track-double-click-hook): Use character - widths to calculate a border region where double clicking does - page turning, and return `nil' by default so other hooks, such as - region highlighting, will be run. - -1998-09-29 Colin Rafferty - - * sound.el (default-sound-directory-list): Initialize with all the - "sounds" directories in `data-directory-list'. It used to just be - the first one. - - * packages.el (locate-data-directory-list): Created. This gives - the list of matching directories, unlike `locate-data-directory', - which just gives the first one. - -1998-09-26 Jan Vroonhof - - * minibuf.el (read-from-minibuffer): No longer bind help-form but - make a binding in the local keymap until help-char handling is - improved. - - * help.el (help-keymap-with-help-key): Provide keymap with help - binding. - (help-print-help-form): New helper function. - -1998-09-23 Hrvoje Niksic - - * isearch-mode.el (isearch-highlight): set-extent-endpoints can - move extent to another buffer; no need to create a new extent. - (isearch-fix-case): New function. - (isearch-search-and-update): Use it. - -1998-09-22 Hrvoje Niksic - - * isearch-mode.el (isearch-mode): Use overriding-local-map to set - the keymap, not minor-mode-map-alist. - (isearch-done): Restore overriding-local-map. - -1998-09-21 Martin Buchholz - - * bytecomp.el (byte-compile-buffer-substring): - Fix for: (byte-compile (defun f () (buffer-substring))) - ==> ** buffer-substring called with 3 args, but requires 0-3 - - new code not only works, but is more readable, too. - -1998-09-20 Jonathan Harris - - * msw-faces.el (mswindows-init-device-faces): Don't try to - specify a default font at this late stage. Do try to force - creation of the default face font so that if it fails we get - an error now instead of a crash at frame creation. - - mswindows-font-canonicalize-name, mswindows-make-font-unbold, - mswindows-make-font-unitalic: Canonical default weight - changed from "Normal" to "Regular". - - mswindows-make-font-bold / -bold-italic: Supplied device was - not being passed into call to mswindows-find-smaller-font. - -1998-09-10 Bjrn Torkelsson - - * package-get.el (package-get-remote): Fix the path where to find - the packages on xemacs.org. - -1998-09-08 Hrvoje Niksic - - * about.el (about-maintainer-info): Update Ben's entry. - -1998-09-24 Martin Buchholz - - * lisp/shadow.el (find-emacs-lisp-shadows): - - `member' was being called on lists of length 2000! - - Replace with hashtables. - - Replace hand-coded loops with (dolist) - - Fix comment typo - -1998-09-20 Darryl Okahata - - * packages.el: Added new function, `package-delete-name', to - delete existing packages from the installed package database - (`packages-package-list'). Also added the "pkginfo" directory - to `packages-special-base-regexp', so that the pkginfo directory - would not get added to `late-packages'. - - * package-admin.el: Added ability to delete an installed package - (added low-level function, `package-admin-delete-package'). - Understands how to use the pkginfo/MANIFEST. file to - delete the package. When installing a package, will also - create a MANIFEST.* file if one is not provided by the - package. If the MANIFEST.* doesn't exist when deleting a - package, the functions will fall back to attempting to delete - any package-specific lisp directory. - - * package-get.el: Moved some functions to package-admin.el. - Added interactive function `package-get-delete-package', for - use by users for deleting a package. - - Also modified to not require the prescence of efs. - -1998-09-22 Hrvoje Niksic - - * files.el (find-file-noselect): Handle all signals, kill the - buffer and resignal. - -1998-09-23 SL Baur - - * cl-macs.el (glyph-image): Add setf method. - -1998-09-06 Darryl Okahata - - * package-get.el: Fixed broken EFS downloading. Also, look for - .tar.gz files first, in preference over .tgz files. - - * package-ui.el: Fix display of package version numbers. - -1998-08-27 Jan Vroonhof - - * x-font-menu.el (font-menu-set-font): Add "pt" units to size - argument. - -1998-09-03 Darryl Okahata - - * list-mode.el: `display-completion-list': added new/optional - keyword `:completion-string', which allows the programmer to - change the "Possible completions are:" prompt. - - * menubar-items.el: Added new pulldown menu-pick to start up the - visual package browser/installer: - - Options->Customize->List Packages - - * package-admin.el: Added hooks for installing under both Unix - and MS Windows. Does additional error checking. No longer - calls "add-big-package.sh" to install packages under Unix; now - calls gunzip & tar directly. - - * package-get.el: Added ability to install packages from files - on a local disk/CDROM. Now deletes any existing package lisp - directory. Does completion on available packages when - querying for package names. Will also search for .tgz files - in addition for .tar.gz files. Tries to reload - auto-autoloads, as a convenience when loading new packages, - and also tries to add any new package paths to `load-path'. - Changed all occurences of `concat' to use `expand-file-name'. - - * package-ui.el: New file which implements the main visual - package browser/installer, which is started via a menu pick or - M-x pui-list packages. - -1998-09-03 Hrvoje Niksic - - * startup.el (load-init-file): spelling fix. - -1998-09-02 Michael Sperber [Mr. Preprocessor] - - * startup.el (normal-top-level): Load auto-autoload files - covariantly with their precedence. - -1998-08-26 Jan Vroonhof - - * menubar-items.el (default-menubar): Remove "Font Weight" - option, there is currently no custom equivalent.. Customize-faces - is "Edit faces". - - * x-font-menu.el (font-menu-set-font): Use customize to set - default face. - - * faces.el (face-spec-update-all-matching): New function. - - * cus-face.el (custom-set-face-update-spec): New function. - Interface to customize faces from elisp. - - (custom-face-value-create): Show the customized settings if set - but not saved. - -1998-08-26 Jan Vroonhof - - (custom-face-value-create): Show the customized settings if set - but not saved. - -1998-08-31 Hrvoje Niksic - - * keydefs.el (global-map): Add FSF 20.3 binding of - query-replace-regexp. - -1998-08-21 Greg Klanderman - - * minibuf.el (read-file-name-internal-1): use - user-name-completion-1 instead of user-name-completion. - -1998-08-19 Michael Sperber [Mr. Preprocessor] - - * loadup.el: - * make-docfile.el: - * update-elc.el: Don't set `source-directory' (now defunct as a - global variable) no more. - - * packages.el (packages-list-autoloads): Made `source-directory' - (now defunct as a global variable) a parameter. - -1998-08-13 Carsten Leonhardt - - * about.el (about-hackers): new email - -1998-08-16 SL Baur - - * lisp-mode.el (with-string-as-buffer-contents): Set indentation. - -1998-07-17 Didier Verna - - * faces.el (set-face-property): - (set-face-dim-p): - (face-dim-p): updated the doc strings now that the dim property isn't - tty-specific. - (face-equal): the dim property is now a common one. - - * cus-face.el (custom-face-attributes): New face attribute: `dim' - Renamed the `stipple' attribute to `background-pixmap'. - (custom-face-background-pixmap): make custom-face-stipple an - obsolete alias for this. - -1998-08-11 Michael Sperber [Mr. Preprocessor] - - * find-paths.el (paths-file-readable-directory-p): Created and - used. - - * loadup.el: Don't set inhibit-... flags from run-temacs. - -1998-08-06 Michael Sperber [Mr. Preprocessor] - - * packages.el (packages-data-path-depth): Added and used. - -1998-08-05 Charles G. Waldman - - * about.el: - - Change .xpm to .png, delete "zcat" section. - - cosmetic fix in the 'marcpa' entry. - - * etc/photos - - convert all .xpm.Z to .png - - rename mrb to martin - - rename mcook-m to mcookm - -1998-07-31 Martin Buchholz - - * x-init.el (x-initialize-compose): Add support for - dead-circumflex as YET ANOTHER NAME for that dead key. - -1998-08-05 Colin Rafferty - - * setup-paths.el (paths-construct-exec-path): Made the - last-packages really be last. - (paths-construct-data-directory-list): Ditto. - -1998-08-01 Kai Haberzettl - - * startup.el(startup-splash-frame-body): - Update Copyright notice in splash screen - -1998-07-20 Greg Klanderman - - * minibuf.el (read-file-name-internal-1): do ~user completion. - -1998-07-22 Jan Vroonhof - - * font-lock.el (font-lock-fontify-glumped-region): Add guard - aginst destroyed extents - -1998-07-24 Greg Klanderman - - * package-get.el (package-get): add `install-dir' argument. - -1998-07-20 John Jones - - * package-get.el: calls to package-get-update-all will only - update packages which are already installed. - -1998-07-23 SL Baur - - * autoload.el (update-file-autoloads): Ensure autoloads buffer is - writable. - -1998-07-20 Colin Rafferty - - * about.el (about-hackers): Correct my email. - -1998-07-20 Kai Haberzettl - - * about.el (about-hackers): new email-address. - -1998-07-25 SL Baur - - * minibuf.el (read-number): Don't let `input-error' condition - escape. - -1998-07-20 Greg Klanderman - - * about.el (about-hackers): use my `email-for-life' address. - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-12 Oscar Figueiredo - - * ldap.el (ldap-search): Doc string change - -1998-07-16 Colin Rafferty - - * menubar-items.el (default-menubar): Removed references to - `data-directory', and use `locate-data-file' instead, and made - then greyed out if they don't exist. - -1998-07-14 Oscar Figueiredo - - * keymap.el (events-to-keys): Use `format' instead of `concat' - since the latter does not accept integer args anymore - -1998-07-15 SL Baur - - * dumped-lisp.el (preloaded-file-list): Usage of Lisp read-time - macros replaced. - -1998-07-14 SL Baur - - * make-docfile.el: Get first initialization from very-early-lisp.el - * update-elc.el: Ditto. - * loadup.el (really-early-error-handler): Ditto. - - * packages.el (packages-unbytecompiled-lisp): Add new file, - very-early-lisp.el. - - * very-early-lisp.el: New file. - -1998-07-14 SL Baur - - * Symbols that have been obsolete for at least 3 years removed (II). - - * obsolete.el (eval-current-buffer): Make compatible. - (byte-code-function-p): Ditto. - (send-string): Removed. - (send-region): Removed. - (screen-scrollbar-width): Removed. - (set-screen-scrollbar-width): Removed. - (set-screen-left-margin-width): Removed. - (set-screen-right-margin-width): Removed. - (screen-left-margin-width): Removed. - (screen-right-margin-width): Removed. - (set-buffer-left-margin-width): Removed. - (set-buffer-right-margin-width): Removed. - (buffer-left-margin-width): Removed. - (buffer-right-margin-width): Removed. - (x-set-frame-icon-pixmap): Removed. - (x-set-screen-icon-pixmap): Removed. - (pixel-name): Removed. - (make-pixmap): Removed. - (make-cursor): Removed. - (pixmap-width): Removed. - (pixmap-contributes-to-line-height-p): Removed. - (set-pixmap-contributes-to-line-height): Removed. - -1998-07-13 SL Baur - - * obsolete.el (popup-menu-up-p): removed. - (read-no-blanks-input): Removed. - (wholenump): Removed. - (ring-mod): Removed (what was ring-mod?). - (current-time-seconds): Removed. - (run-special-hook-with-args): Removed. - (dot): Removed. - (dot-marker): Removed. - (dot-min): Removed. - (dot-max): Removed. - (window-dot): Removed. - (set-window-dot): Removed. - - * bytecomp.el: Remove bytecompiler support for `dot', `dot-max' and - `dot-min'. - - * minibuf.el: (read-no-blanks-input): remove commented-out copy. - - * code-files.el (insert-file-contents): Rename - run-special-hook-with-args to run-hook-with-args-until-success. - (write-region): Ditto. - -1998-07-12 SL Baur - - * about.el: Fix typos, update release date. - - * Symbols that have been obsolete for at least 3 years removed. - - * cl-macs.el (cl-parse-loop-clause): Delete obsolete references to - screen- functions. - (toplevel): remove setf methods for screen functions. - * cl-macs.el (extent-data): defsetf removed. - * obsolete.el (lisp-indent-hook): Make compatible, it's used too - many places to remove. - (comment-indent-hook): Ditto. - * obsolete.el (get-screen-for-buffer-default-screen-name): Remove. - (buffer-dedicated-screen): Ditto. - (deiconify-screen): Ditto. - (delete-screen): Ditto. - (event-screen): Ditto. - (find-file-other-screen): Ditto. - (find-file-read-only-other-screen): Ditto. - (live-screen-p): Ditto. - (screen-height): Ditto. - (screen-iconified-p): Ditto. - (screen-list): Ditto. - (screen-live-p): Ditto. - (screen-name): Ditto. - (screen-parameters): Ditto. - (screen-pixel-height): Ditto. - (screen-pixel-width): Ditto. - (screen-root-window): Ditto. - (screen-selected-window): Ditto. - (screen-totally-visible-p): Ditto. - (screen-visible-p): Ditto. - (screen-width): Ditto. - (screenp): Ditto. - (get-screen-for-buffer): Ditto. - (get-screen-for-buffer-noselect): Ditto. - (get-other-screen): Ditto. - (iconify-screen): Ditto. - (lower-screen): Ditto. - (mail-other-screen): Ditto. - (make-screen): Ditto. - (make-screen-invisible): Ditto. - (make-screen-visible): Ditto. - (modify-screen-parameters): Ditto. - (new-screen): Ditto. - (next-screen): Ditto. - (next-multiscreen-window): Ditto. - (other-screen): Ditto. - (previous-screen): Ditto. - (previous-multiscreen-window): Ditto. - (raise-screen): Ditto. - (redraw-screen): Ditto. - (select-screen): Ditto. - (selected-screen): Ditto. - (set-buffer-dedicated-screen): Ditto. - (set-screen-height): Ditto. - (set-screen-position): Ditto. - (set-screen-size): Ditto. - (set-screen-width): Ditto. - (show-temp-buffer-in-current-screen): Ditto. - (switch-to-buffer-other-screen): Ditto. - (visible-screen-list): Ditto. - (window-screen): Ditto. - (x-set-screen-pointer): Ditto. - (x-set-frame-pointer): Ditto. - (screen-title-format): Ditto. - (screen-icon-title-format): Ditto. - (terminal-screen): Ditto. - (delete-screen-hook): Ditto. - (create-screen-hook): Ditto. - (mouse-enter-screen-hook): Ditto. - (mouse-leave-screen-hook): Ditto. - (map-screen-hook): Ditto. - (unmap-screen-hook): Ditto. - (default-screen-alist): Ditto. - (default-screen-name): Ditto. - (x-screen-defaults): Ditto. - (x-create-screen): Ditto. - * obsolete.el: meta-flag removed. - baud-rate removed. - sleep-for-millisecs removed. - extent-data removed. - set-extent-data removed. - set-extent-attribute removed. - extent-glyph removed. - extent-layout removed. - set-extent-layout removed. - list-faces-display removed. - list-faces removed. - trim-versions-without-asking removed. - after-write-file-hooks removed. - truename removed. - auto-fill-hook removed. - blink-paren-hook removed. - select-screen-hook, deselect-screen-hook removed. - auto-raise-screen, auto-lower-screen removed. - - * msw-mouse.el: Global change resource -> mswindows-resource. - - * XEmacs 21.0-pre5 is released. - -1998-07-11 SL Baur - - * about.el (about-hackers): Credits update. - -1998-07-11 Hrvoje Niksic - - * register.el (insert-register): Don't activate the region. - -1998-07-10 SL Baur - - * select.el: Restore x-* symbols for backwards compatibility: - x-copy-primary-selection, x-kill-primary-selection, - x-delete-primary-selection, x-select-make-extent-for-selection, - x-valid-simple-selection-, x-cut-copy-clear-internal. - -1998-07-09 SL Baur - - * XEmacs 21.0-pre4 is released. - -1998-06-28 Hrvoje Niksic - - * menubar-items.el (default-menubar): Use `report-emacs-bug' for - reporting bugs. - (maybe-add-init-button): Fix semantics under Windows. Use - `expand-file-name' rather than `concat'. - - * help.el (print-messages): New function. - -1998-07-05 Oscar Figueiredo - - * ldap.el (ldap-host-parameters-alist): Docstring fixes - -1998-07-04 Jonathan Harris - - * about.el: Tweaked my entry in about-hackers. - - * find-paths.el (paths-emacs-root-p): - Relaxed emacs-root checking of an in-place installation to - also accomodate the flat layout used on MS Windows. - -1998-06-29 John Jones - - * package-get.el: calls to package-get-update-all will only - update packages which are already installed. - -1998-07-05 Andy Piper - - * faces.el (xpm-color-symbols): remove hardcoded defaults these - are handled by the gui-element face fallbacks now. - - * x-faces.el: default gui-element face to "background" as well as - the default face. - - * msw-faces.el (mswindows-init-device-faces): remove gui-element - and default face settings since these are set as fallbacks now in - the appropriate domain. - -1998-07-02 SL Baur - - * text-mode.el (text-mode): Reorder regexp so the OR part - corresponding to `page-delim' goes first and the hack in - `forward-paragraph' will work. - With bug analysis from Bob Weiner - -1998-06-29 Kyle Jones - - * subr.el (remove-hook): When checking the hook value - with functionp, don't apply car to it. - -1998-06-24 Jonathan Harris - - * package-get.el (package-get-remote-filename): - Don't use file-name-as-directory because the local directory - separator conventions might not be the same as ftp's. - -1998-06-27 Oscar Figueiredo - - * ldap.el (ldap-host-parameters-alist): New name of - `ldap-host-parameters-plist' - -1998-06-26 Adrian Aichner - - * package-get.el: Using (require 'package-get-base), now that it - provides itself. Consequently removed all instances of (load - "package-get-base.el"). - -1998-06-29 Kyle Jones - - * subr.el (remove-hook): Don't treat the hook value as a - list unless it is both consp and not functionp. - -1998-06-29 SL Baur - - * about.el: Email address for Ben Wing is ben@xemacs.org. - * auto-show.el: Ditto. - * bytecomp.el: Ditto. - * faces.el: Ditto. - * x-scrollbar.el: Ditto. - * x-misc.el: Ditto. - * tty-init.el: Ditto. - * toolbar-items.el: Ditto. - * symbol-syntax.el: Ditto. - * specifier.el: Ditto. - * objects.el: Ditto. - * hyper-apropos.el: Ditto. - * glyphs.el: Ditto. - -1998-06-27 Hrvoje Niksic - - * mouse.el (drag-window-divider): vertical-divider-draggable-p -> - vertical-divider-always-visible-p. - (default-mouse-motion-handler): Ditto. - -1998-06-21 Hrvoje Niksic - - * scrollbar.el (scrollbars-visible-p): Simplify. Always set the - global value. - -1998-06-21 Oliver Graf - - * build-reports.el: changed receiver to xemacs-build-reports list - -1998-06-19 Jonathan Harris - - * font.el: Split font-family-mappings into X and - mswindows-specific versions. - mswindows-font-create-[object|name]: Treat supplied size - as a pointsize. Added underline and strikethru handling. - - * msw-faces.el: changed default mswindows charset to western. - - * msw-glyphs.el: removed space in border-glyph font string that - was inserted to get round bugs in the mswindows C font code. - -1998-06-27 SL Baur - - * about.el (about-hackers): Credits update. - - * help-nomule.el (tutorial-supported-languages): Add Romanian - TUTORIAL. - - * code-files.el (file-coding-system-alist): Hardwire TUTORIAL.ro - to ISO-8859-2. - -1998-06-19 Jonathan Harris - - * font.el: Split font-family-mappings into X and - mswindows-specific versions. - mswindows-font-create-[object|name]: Treat supplied size - as a pointsize. Added underline and strikethru handling. - - * msw-faces.el: changed default mswindows charset to western. - - * msw-glyphs.el: removed space in border-glyph font string that - was inserted to get round bugs in the mswindows C font code. - -1998-06-15 Jonathan Harris - - * minibuf.el: make read-color-completion-table call - (mswindows-color-list for mswindows devices. - -1998-06-18 Sam Mikes - - * lisp/font-lock.el - (font-lock-match-c++-style-declaration-item-and-skip-to-next): - Let declaration items contain non-word symbol characters. - -1998-06-15 Adrian Aichner - - * package-get.el (package-get-package-provider): Added autoload - cookie. Loading "package-get-base.el" in ALL functions that use - it. Fixed some (interactive ...) with multiple argument specs - again. Cosmetic indentation changes. - -1998-05-27 Glynn Clements - - * info.el (Info-insert-dir): Don't use nreverse on variables - that you want to use later. - -1998-06-17 Glynn Clements - - * x-mouse.el (x-set-point-and-move-selection): Replace call - to x-kill-primary-selection with kill-primary-selection - -1998-06-12 Martin Buchholz - - * simple.el (what-cursor-position): Make cursor position reported - use value of column-number-start-at-one - -1998-06-17 SL Baur - - * about.el (xemacs-hackers): Fix Jareth's email address. - -1998-06-16 SL Baur - - * startup.el (startup-splash-frame): Remove - `xemacs-startup-logo-function'. - -1998-06-15 SL Baur - - * about.el (about-hackers): Update credits list. - -1998-06-06 Jeff Miller - - * lisp/sound.el: Update sound-ext to allow filenames with - extensions to be found by load-sound-file - -1998-06-14 Oscar Figueiredo - - * info.el (Info-rebuild-outdated-dir): Removed variable - (Info-auto-generate-directory): New variable - (Info-save-auto-generated-dir): New variable - (Info-maybe-update-dir): Use `Info-auto-generate-directory' - (Info-build-dir-anew): Second parameter removed. Use - `Info-save-auto-generated-dir' - (Info-rebuild-dir): Ditto - -1998-06-02 Christoph Wedler - - * list-mode.el (next-list-mode-item): Would not recognize - border between directly neighbored items. - -1998-06-12 Andy Piper - - * package-get.el: add autoloads for some functions. - -1998-06-10 Hrvoje Niksic - - * specifier.el (let-specifier): Tiny docfixes. - -1998-06-12 Andy Piper - - * msw-mouse.el: set selection-pointer-glyph to Normal. - -1998-06-09 Per Abrahamsen - - * wid-edit.el (widget-specify-secret): New function. - (widget-after-change): Use it. - (widget-specify-field): Use it. - -1998-06-08 Hrvoje Niksic - - * mouse.el (drag-window-divider): Use `(not done)' instead of - `doit'; reuse result of `window-pixel-edges'. - - * modeline.el (drag-modeline-event-lag): Rename to - drag-divider-event-lag. - -1998-06-07 Hrvoje Niksic - - * specifier.el (let-specifier): Rewritten not to generate needless - `let's; clarified documentation; support TAG-SET and HOW-TO-ADD - arguments. - -1998-05-28 Hrvoje Niksic - - * minibuf.el (read-file-name-1): Setup buffer-local value of - `completion-ignore-case' in completions buffer under Windows. - -1998-06-06 Kirill M. Katsnelson - - * about.el (about-maintainer-glyph): Fix support for not - compressed images. - -1998-06-04 Kirill M. Katsnelson - - * cmdloop.el (cancel-mode-internal): Defined this do-nothing function. - - * mouse.el (mouse-track): Cancel selection if misc-user event with - `cancel-mode-internal' function is fetched. - -1998-06-03 Hrvoje Niksic - - * files.el (save-some-buffers-1): Fixed return value. - -1998-06-01 Oliver Graf - - * dragdrop.el: added experimental - -1998-05-26 Stephen J. Turnbull - - * startup.el (after-init-hook, init-file-user, - user-init-directory, load-user-init-file): Purge references - to "~/.xemacs/init.el" from docstrings. - - (load-user-init-file) Use paths-construct-path to construct - paths to user init files. Go directly to ~/.emacs, do not - search ~/.xemacs/, do not load `default-custom-file'. - -1998-06-03 Hrvoje Niksic - - * files.el (interpreter-mode-alist): Catch wish and tclsh before - general *sh. - (inhibit-first-line-modes-regexps): Added `.tar.gz'. - -1998-06-03 Andy Piper - - * menubar-items.el (default-menubar): add Update Packages to customize - menu. - -1998-06-02 Andy Piper - - * faces.el: use toolbar face as a fallback for toolbar properties - in xpm-color-symbols instead of default. - - * msw-faces.el: rename 3d-object -> gui-element face. - -1998-06-06 SL Baur - - * startup.el (xemacs-startup-logo-function): New variable. - (startup-splash-frame): Use it. - -1998-06-02 Hrvoje Niksic - - * files.el (save-some-buffers): Would wait 1 second. - (save-some-buffers-1): Delete other windows here instead of in - `save-some-buffers'. - (save-some-buffers): Force redisplay only if windows were deleted. - -1998-06-02 Didier Verna - - * cus-face.el (custom-face-attributes): generalized the use of - toggle buttons for boolean attributes. - Re-ordered the items a bit. - -1998-06-01 SL Baur - - * sound.el (default-sound-directory): Use `locate-data-directory' - to find the sounds directory. - -1998-05-29 Andy Piper - - * sound.el: default sound-ext to .wav under mswindows, .au - otherwise. load-default sounds without extensions. - -1998-05-27 Bjrn Torkelsson - - * menubar-items.el (default-menubar): Dim out "Submit Bug Report" - if send-pr is not bound. - -1998-06-01 Andy Piper - - * files.el: grok idl files in auto-mode-alist. -1998-06-01 Jeff Miller - - * minibuf.el (exact-minibuffer-completion-p): check for nil before - calling `upcase'. - -1998-05-30 Andy Piper - - * msw-glyphs.el: add xbm to the list of image types supported. - -1998-05-30 Kirill M. Katsnelson - - * msw-init.el (init-post-mswindows-win): Load InfoDock toolbar - instead of XEmacs one when dumping InfoDock. - -1998-05-30 Kirill M. Katsnelson - - * obsolete.el (has-modeline-p): Added obsolete alias `has-modeline-p' - for `modeline-visible-p' - - * winnt.el (nt-quote-process-args): Fix for duplicating argv[0]. - -1998-05-29 Andy Piper - - * msw-select.el (mswindows-cut-copy-clear-clipboard): deleted - since it's not used anymore. doc string fixes. - - * package-get.el (package-get-file-installed-p): new function. use - instead of file-installed-p which is in an external package. - -1998-05-28 Oliver Graf - - * dragdrop.el (dragdrop-drop-url-default): dropped pop-to-buffer in - favor of select-window/switch-to-buffer - -Wed May 27, 1998 Darryl Okahata - - * startup.el: changed (getenv "HOME") to (user-home-directory) - -1998-05-25 Oliver Graf - - * frame.el (cde-start-drag) moved to dragdrop.el - (offix-start-drag-region) moved to dragdrop.el - (offix-start-drag) moved to dragdrop.el - * dragdrop.el (cde-start-drag) moved from frame.el - (offix-start-drag-region) moved from frame.el - (offix-start-drag) moved from frame.el - (cde-start-drag-region) cde drag regions - * mouse.el (mouse-drag-or-yank) will now call cde-start-drag-region - -1998-05-26 Oliver Graf - - * dragdrop.el: created dragdrop-drag prototypes - (cde-start-drag-region) fixed typo - -1998-05-28 SL Baur - - * simple.el (after-init-hook): Remove reader macro. - - * packages.el (packages-hardcoded-lisp): Get rid of reader - macros. Update DOC string. - -1998-05-25 Hrvoje Niksic - - * mouse.el (drag-window-divider): Ditto. - - * modeline.el (mouse-drag-modeline): Use it. - - * lisp-mode.el (let-specifier): Specify indentation. - - * specifier.el (let-specifier): Renamed from - `with-specifier-instance'. - -1998-05-27 Andy Piper - - * x-faces.el: - * faces.el: move definition of xpm-color-symbols from x-faces.el - to faces. Predicate x-get-resource on the presence of x. - - * msw-faces.el: set 3d-object face rather than modeline. Specifiy - faces as specfier defaults. - - * package-get.el: don't use package-admin-add-single-file-package. - -1998-05-25 Hrvoje Niksic - - * toolbar-items.el: Fixup tooltips. - (toolbar-gnus): Don't use obsolete variable - toolbar-news-frame-properties. - (toolbar-news-reader): Default to `gnus' instead of - `not-configured'. - - * files.el (auto-mode-alist): Correctly recognize `.emacs' under - Windows. - -1998-05-25 Andy Piper - - * package-get.el: rename -installedp -> -installed-p. - -1998-05-23 Kirill M. Katsnelson - - * glyphs.el (init-glyphs): Created `border-glyph' face, with no - attributes, and assinged it to continuation, truncation and - hscroll glyphs. - - * msw-glyphs.el: Assigned WinDings font to `border-glyph' face, - and made continuation, truncation and hscroll glyphs arrow - characters out of that font. - -1998-05-22 Hrvoje Niksic - - * minibuf.el (minibuffer-electric-separator): Play nicely with - directory-sep-char being \. - (minibuffer-electric-tilde): Ditto. - (read-file-name-map): Ditto. - -1998-05-22 Hrvoje Niksic - - * mouse.el (default-mouse-track-maybe-own-selection): Pause only - on X devices. - (default-mouse-track-deal-with-down-event): Avoid - `x-disown-selection'; use `disown-selection' instead. - -1998-05-21 Andy Piper - - * select.el: - * x-select.el: selection cleanup. (x-cut-copy-clear-internal) - moved to (cut-copy-clear-internal) in select.el. Ditto for - (x-delete-primary-selection) (x-kill-primary-selection) - (x-copy-primary-selection). - (own-clipboard): new function. - - * msw-select.el: use the new kill/delete/copy/cut-copy-clear - functions in select.el. remove old ones. - (mswindows-own-clipboard): new function. - -1998-05-21 Andy Piper - - * gnuserv.el: allow connections from mswindows type devices. - -1998-05-20 Andy Piper - - * msw-glyphs.el: change image type used from cursor to resource. - -1998-05-20 Kirill M. Katsnelson - - * x-scrollbar.el (x-init-scrollbar-from-resources): Added support - for {top,bottom}-{left,right} values in addition to - {top,bottom}_{left,right}. - Use x-get-resource instead of x-get-resource-and-bogosity-check. - -1998-05-20 Hrvoje Niksic - - * cl-macs.el (specifier-instance): Undefine its setf method. - - * specifier.el (with-specifier-instance): Added docstring. - - * mouse.el (drag-window-divider): Ditto. - - * modeline.el (mouse-drag-modeline): Use it. - - * lisp-mode.el (with-specifier-instance): Define its indentation - level. - - * specifier.el (with-specifier-instance): New macro. - -1998-05-19 Andy Piper - - * package-get.el (package-get-create-custom): new function to - auto-generate package-get-custom.el from package-get-base.el. - * (package-get-ever-installedp): new function. - * (package-get-custom): new function to get all packages specified - by customize. - -1998-05-19 Hrvoje Niksic - - * cus-edit.el (custom-file): Revert to `~/.emacs'. - -1998-05-23 SL Baur - - * cl-extra.el: Reverse previous float change. - -1998-05-17 Andy Piper - - * x-faces.el: - * faces.el (try-font-name): moved from x-faces.el since it is - required by w3 under mswindows as well X. - -1998-05-18 Kirill M. Katsnelson - - * winnt.el: Removed evil (setq completion-ignore-case t) - clause, one more overlookef fsfism. - (nt-quote-args-functions-alist): End sentences with double space. - -1998-05-18 Kirill M. Katsnelson - - * window-xemacs.el (push-window-configuration): Remove kludgery of - recaching default-toolbar specifier. - (pop-window-configuration): Ditto. - (unpop-window-configuration): Ditto. - -1998-05-16 Hrvoje Niksic - - * modeline.el (modeline-minor-mode-menu): Don't use :menu-tag. - -1998-05-17 Kirill M. Katsnelson - - * winnt.el (nt-quote-args-verbatim): Added function. - (nt-quote-args-prefix-quote): Added function. - (nt-quote-args-backslash-quote): Added function. - (nt-quote-args-double-quote): Added function. - (nt-quote-args-functions-alist): New variable. - (nt-quote-process-args): Added function. This is the main quoting - work horse called from process-nt.c - -1998-05-16 Kirill M. Katsnelson - - * winnt.el: Removed duplicate definitions for backspace, - delete, M-backspace and C-M-backspace. - (file-name-buffer-file-type-alist): Removed this variable. - (find-buffer-file-type): Removed function. - (find-file-binary): Removed function. - (find-file-text): Removed function. - (find-file-not-found-set-buffer-file-type): Removed function. - (save-to-unix-hook): Removed function. - (revert-from-unix-hook): Removed function. - (using-unix-filesystems): Removed function. - (original-make-auto-save-file-name): DEFSUBR to avoid doc snarf - warning. - (x-set-selection): Removed function. - (x-get-selection): Removed function. - Removed commented FSFisms. - Replaced copyright notice (this file is not part of GNU Emacs). - (nt-shell-mode-hook): Moved here from a lambda expression. Added - comint-process-echoes setting to t. - -1998-05-17 Michael Sperber [Mr. Preprocessor] - - * packages.el (packages-no-package-hierarchy-regexp): Introduced - and used following the interface change of - `paths-find-recursive-path'. - - * find-paths.el (paths-find-recursive-path): Exclusion is now by a - regexp instead of a list of base names. - (paths-version-control-filename-regexp): - (paths-lisp-filename-regexp): (paths-no-lisp-directory-regexp): - Introduced and used following the interface change of - `paths-find-recursive-path'. - -1998-05-16 Hrvoje Niksic - - * simple.el (delete-forward-p): Make it a defun; do X garbage only - on X devices, rather than on all non-TTY devices. - -1998-05-16 Kirill M. Katsnelson - - * msw-mouse.el: New file. Sets up cursor shapes for Windows. - - * dumped-lisp.el (preloaded-file-list): Added msw-mouse.el - -1998-05-17 Adrian Aichner - - * itimer.el (activate-itimer): Fixed usage of integers - as argument to `concat'. - -1998-05-17 Glynn Clements - - * itimer.el (start-itimer): replace the use of `concat' with - `format' - -1998-05-16 SL Baur - - * mode-motion.el (mode-motion-hook): Clarify docstring. - From Bob Weiner - - * loadhist.el (symbol-file): Supply prompt string when used - interactively. - From Bob Weiner - -1998-05-16 Hrvoje Niksic - - * loadup.el (really-early-error-handler): Ditto. - - * update-elc.el: Ditto. - - * setup-paths.el (paths-construct-exec-path): Ditto. - - * make-docfile.el: Ditto. - - * find-paths.el (paths-decode-directory-path): Use split-path - instead of decode-path. - - * files.el (parse-colon-path): Update docstring reference. - -1998-05-15 Jonathan Harris - - * msw-init.el: - * x-init.el: - Bind cut'n'paste keys to non window-system specific functions. - - * msw-select.el: New function mswindows-clear-clipboard. - mswindows-cut-copy-clipboard extended to handle clearing of the - selection and renamed to mswindows-cut-copy-clear-clipboard. - - * select.el: on mswindows devices delete-primary-selection - calls mswindows-clear-clipboard. - -1998-05-15 Hrvoje Niksic - - * simple.el (quoted-insert): Inhibit quit when using read-char. - - * cmdloop.el (read-char): Don't inhibit quit. - (read-char-exclusive): Ditto. - (read-char): Signal quit if quit-char was pressed. - (read-char-exclusive): Ditto. - (read-quoted-char): Return a character, not integer. - - * menubar-items.el (default-popup-menu): Use Andy's generic - selection code. - (default-popup-menu): Fix code. - -1998-05-14 Oliver Graf - - * dragdrop.el (dragdrop-function-widget): this time it's done - -1998-05-13 Oliver Graf - - * dumped-lisp.el: dragdrop.el now based on dragdrop-api feature - -1998-05-15 Kirill M. Katsnelson - - * device.el (device-pixel-width): - (device-pixel-height): - (device-mm-width): - (device-mm-height): - (device-bitplanes): - (device-color-cells): Swapped parameters to device-system-metric - according to the interface change. - -1998-05-14 Kirill M. Katsnelson - - * mouse.el (default-mouse-motion-handler): Use new name of the - function event-over-vertical-divider-p. - Do not set E-W arrow cursor over the divider if - vertical-divider-draggable-p is nil in the window. - ([top-level]): Use new name for the variable - vertical-divider-map. - (drag-window-divider): Respect vertical-divider-draggable-p. - Variable name typo fixes. - -1998-05-14 Hrvoje Niksic - - * keymap.el (kbd): Define here; handle string constants and - others... - -1998-05-15 Christian Nyb - - * simple.el (zap-up-to-char): New function. Behaves like `zap-to-char' - in Emacs 18. - -1998-05-13 Didier Verna - - * mouse.el (drag-window-divider): give the vertical divider a - pressed look when dragging it. - -1998-05-13 Andy Piper - - * faces.el: predicate some more face operations on x or mswindows - not just x. - - * modeline.el: enable modeline coloring for mswindows. - -1998-05-13 Michael Sperber [Mr. Preprocessor] - - * minibuf.el (minibuffer-default): Added variable; compatible with - FSF Emacs. - (next-history-element): Used `minibuffer-default'. - -1998-05-12 Oliver Graf - - * dragdrop.el (dragdrop-function-widget): button and mods ok - arguments still look a bit strange - (dragdrop-compare-mods) created - (dragdrop-drop-do-functions) correctly checks for buttons and - modifiers - -1998-05-14 Hrvoje Niksic - - * setup-paths.el (paths-default-info-directories): Replace - path-separator with directory-sep-char. - - * files.el (path-separator): Don't define it here. - -1998-05-14 Hrvoje Niksic - - * update-elc.el: Ditto. - - * setup-paths.el (paths-construct-exec-path): Ditto. - - * make-docfile.el: Ditto. - - * loadup.el (really-early-error-handler): Ditto. - - * find-paths.el (paths-decode-directory-path): Use decode-path - instead of decode-path-internal. - - * files.el (parse-colon-path): Update docstring. - -1998-05-13 Hrvoje Niksic - - * subr.el (get-buffer-window-list): Make BUFFER optional. - - * window-xemacs.el (windows-of-buffer): Defalias to - get-buffer-window-list. - -1998-05-12 Hrvoje Niksic - - * disass.el: Fix maintainer keyword. - - * bytecomp.el (byte-compile-and-load-file): Autoload. - (byte-compile-buffer): Ditto. - - * lisp-mode.el (eval-last-sexp): Skip ` in `variable' so that the - value is returned, not the name. - (lisp-imenu-generic-expression): Enable it. - (lisp-mode-variables): Ditto. - (lisp-indent-offset): Change defconst to defvar. - (lisp-indent-function): Ditto. - (lisp-body-indent): Ditto. - -1998-05-12 Hrvoje Niksic - - * modeline.el: Use zap-last-kbd-macro-event. - - * lisp-mode.el (eval-interactive): If eval-interactive-verbose is - nil, don't attempt to do anything with messages. - (eval-last-sexp): Use `letf' for clarity. - -1998-05-12 Hrvoje Niksic - - * startup.el: It's still `.emacs', not yet `.xemacs/init.el'. - -1998-05-11 Martin Buchholz - - * buff-menu.el: - * lisp-mode.el: - * obsolete.el: - Change empty docstrings into no doc strings at all. - Fix bogus FSF-format docstrings. - * etags.el: Fix docstring. - -1998-05-11 Jan Vroonhof - - * package-get.el (package-get): Use internal md5 - -1998-05-13 SL Baur - - * about.el (about-xemacs): Correct abuse of concat. - -1998-05-11 SL Baur - - * info.el (Info-mode): Use easymenu. - -1998-05-12 Hrvoje Niksic - - * apropos.el (apropos): Don't use concat with integers. - - * cmdloop.el (describe-last-error): Handle the case when no error - was seen gracefully. - - * apropos.el (apropos-print): Use with-displaying-help-buffer as - defun. - (apropos-describe-plist): Ditto. - - * help.el (with-displaying-help-buffer): Revert to a defun. - (describe-key): Use it as defun. - (describe-mode): Ditto. - (describe-bindings): Ditto. - (describe-prefix-bindings): Ditto. - (describe-installation): Ditto. - (view-lossage): Ditto. - (describe-function): Ditto. - (describe-variable): Ditto. - (describe-syntax): Ditto. - -1998-05-11 Oliver Graf - - * dragdrop.el: changed order of require/provide - (dragdrop-drop-mime-default) changed to new calling conventions - (dragdrop-drop-do-functions) changed to new calling conventions - (dragdrop-function-widget) this one needs more work... - -1998-05-10 Oliver Graf - - * about.el: another small change in my entry - * dragdrop.el (dragdrop-drop-log-function): logging added - plus customizations - changed interface to handler functions. now called with event - and object - -1998-05-12 Kirill M. Katsnelson - - * glyphs.el (divider-pointer-glyph): Declared new glyph, - E-W arrow pointer displayed over draggable dividers. - - * mouse.el (default-mouse-motion-handler): Show it when - appropriate. - (drag-window-divider): Added. - ([top-level]): Initialized window-divider-map with a keymap - binding the above function to left button down event. - - * x-mouse.el (x-init-pointer-shape): Initialize - divider-pointer-glyph from Cursor.dividerPointer, or use default - E-W double arrow. - -1998-04-30 Gunnar Evermann - - * toolbar-items.el (toolbar-compile): respect should-use-dialog-box-p - -1998-05-11 Hrvoje Niksic - - * simple.el (count-words-buffer): Don't query for buffer. - (count-lines-buffer): Ditto. - -1998-05-11 Jan Vroonhof - - * help.el (where-is): add optional insert argument. - -1998-05-11 Hrvoje Niksic - - * help.el (describe-key-briefly): New argument INSERT. - - * simple.el (eval-expression): New optional argument; synch with - FSF 20.3. - - * keydefs.el (global-map): Add new register bindings. - - * register.el: Synched with FSF 20.3. - -1998-05-11 Jan Vroonhof - - * window-xemacs.el (recenter): all arguments are optional. - -1998-05-10 Kirill M. Katsnelson - - * device.el: (device-pixel-width): Reflected name/parameters - change to device-system-metric. - (device-pixel-height): Ditto. - (device-mm-width): Ditto. - (device-mm-height): Ditto. - (device-bitplanes): Ditto. - (device-color-cells): Ditto. - -1998-05-10 Hrvoje Niksic - - * cl-extra.el (cl-float-limits): Removed; move code to top-level. - - * cl.el (most-positive-fixnum): Document. - (most-negative-fixnum): Ditto. - - * cus-dep.el: Updated comment. - - * cus-load.el: Use most-positive-fixnum as the gc-inhibiting - constant. - - * cus-load.el (custom-put): Removed. - - * files.el (after-find-file): Just resignal quit instead of - signaling "canceled". - -1998-05-10 Hrvoje Niksic - - * frame.el (other-frame): Use `focus-frame' instead of - select-frame kludges. - - * lisp-mode.el: Update lisp-indent-function for - save-selected-frame and with-selected-frame. - - * frame.el (save-selected-frame): New macro. - (with-selected-frame): Ditto. - (other-frame): Use `set-frame-focus'. - -1998-05-06 Oliver Graf - - * dragdrop.el (dragdrop-drop-dispatch): changed to new list concept - (dragdrop-drop-url-default) default handler for URL drops created - (dragdrop-drop-mime-default) default handler for MIME drops created - (dragdrop-drop-functions) default custom for handling drops created - (dragdrop-drop-do-functions) helper for drgadrop-drop-dispatch - -1998-05-05 Jonathan Harris - - * mouse.el: Removed redundant mouse-mswindows-drop function. - -1998-05-05 Oliver Graf - - * about.el: changed some text in my entry - * dragdrop.el: added customs - -1998-05-04 Oliver Graf - - * mouse.el: killed global drop key bindings - (mouse-offix-drop) removed - * dragdrop.el: created - * dumped-lisp.el: inclusion of dragdrop.el for window-systems - -1998-05-09 Kirill M. Katsnelson - - * x-scrollbar.el (x-init-scrollbar-from-resources): Initialize - scrollbar-on-{left,top}-p from *scrollBarPlacement resources. - - * x-misc.el (x-get-resource-and-maybe-bogosity-check): Removed - obsolete comment. - - * scrollbar.el (scrollbars-visible-p): Use new - {vertical,horizontal}-scrollbar-visible-p specifiers. - -1998-04-18 Kirill M. Katsnelson - - * device.el (device-pixel-height): - (device-pixel-width): - (device-mm-width): - (device-mm-height): - (device-bitplanes): - (device-color-cells): Moved these 6 functions from device.c; they - all use single (device-system-metrics) call. - -1998-05-09 SL Baur - - * dumped-lisp.el (preloaded-file-list): x-menubar.el and x-toolbar.el - were renamed. - - * menubar-items.el: - * toolbar-items.el: Renamed from x-menubar/x-toolbar. - Suggested by Hrvoje Niksic - - * help.el (help-map): Remove Hyperbole keybinding logic. - Suggested by: Michael Ernst - -1998-05-08 SL Baur - - * x-menubar.el (default-menubar): Enable 'mail-user-agent' feature. - From SAKIYAMA Nobuo - -1998-05-07 Andy Piper - - * msw-glyphs.el: use nicer icon3 from the frame icon. - -1998-05-07 SL Baur - - * version.el (emacs-version): Remove InfoDock conditionals. - - * startup.el (startup-splash-frame): Change ID logo name. - -1998-05-06 Hrvoje Niksic - - * files.el (after-find-file): If the user presses C-g on - directory-creation prompt, kill the buffer. - -1998-05-06 SL Baur - - * simple.el (count-words-region): Reverse previous change. - -1998-05-05 Hrvoje Niksic - - * replace.el (query-replace): Just call perform-replace. - (query-replace-regexp): Ditto. - (perform-replace): Move region handling here. - (perform-replace): Use the new arg to match-data. - -1998-03-08 Kyle Jones - - * x-init.el: Install X specific display table that - displays char 0240 as a space to avoid whatever it is - that screws up display of that character code. - -1998-05-03 Hrvoje Niksic - - * help.el (function-arglist): If no arguments are documented for a - subr, print nothing rather than incorrect output. - -1998-05-05 SL Baur - - * cmdloop.el (command-error): Update bail-out error message to use - `emacs-program-name'. - - * lib-complete.el: Remove reader macro cruft. - - * dumped-lisp.el (preloaded-file-list): Phase I: remove InfoDock - cruft. - - * simple.el (count-words-region): Drop interactive-p check on the - message. - -1998-05-04 Jonathan Harris - - * font.el - * msw-faces.el - Correct spelling of mswindows-font-canonicalize-name. - -1998-05-03 Oscar Figueiredo - - * ldap.el (ldap-host-parameters-alist): Replaced with - `ldap-host-parameters-plist' - (ldap-search): Adapt to previous change - -1998-05-02 SL Baur - - * about.el (about-hackers): Update Bob Weiner bio. - (about-maintainer-info): Ditto. - -1998-05-02 Hrvoje Niksic - - * simple.el (display-warning-minimum-level): Docfix. - -1998-04-04 Per Abrahamsen - - * widget.el (:default-get): New keyword. - * wid-edit.el (default, widget-default-default-get): Define it. - (group, widget-group-default-get): Define it. - (menu-choice, widget-choice-default-get): Define it. - (widget-default-get): New function. - (widget-choice-action): Call it. - (widget-editable-list-entry-create): Call it. - -1998-05-01 Hrvoje Niksic - - * byte-optimize.el (byte-boolean-vars): Removed. - (byte-optimize-lapcode): Use `built-in-variable-type' instead of - lookup through `byte-boolean-vars'. - -1998-05-01 Kirill M. Katsnelson - - * x-scrollbar.el (x-init-scrollbar-from-resources): Stuff - resource-provided values into ghost specs for scrollbar-height and - scrollbar-width. - -1998-05-01 Hrvoje Niksic - - * byte-optimize.el: Don't attempt to optimize /=. - - * bytecomp.el (byte-compile-one-ore-more-args): New function. - (byte-compile-/=): Ditto. - -1998-05-02 SL Baur - - * apropos.el: Use `with-displaying-help-buffer'. - (apropos-print): Remove explicit mentions of "*Apropos*" buffer. - Use `with-displaying-help-buffer'. - (apropos-follow): Do not give special treatment to buffer cursor - was in prior to a mouse click. - (apropos-describe-plist): Use `with-displaying-help-buffer'. - (apropos-print-doc): Set correct buffer for setting text - properties. - -1998-05-01 SL Baur - - * help.el (help-buffer-prefix-string): New variable. - (help-buffer-name): Use it. - - * modeline.el (modeline-minor-mode-menu): Alphabetize the minor - mode menu. - -1998-04-30 Greg Klanderman - - * frame.el (other-frame): Work even when focus-follows-mouse is true. - -1998-05-01 Hrvoje Niksic - - * files.el (find-file-noselect): Update docstring. - (find-file-noselect): Signal an error if found an unreadable file. - (file-chase-links): Save the match data. - (normal-mode): Use `lwarn' and `error-message-string'. - (interpreter-mode-alist): Change defconst to defvar. - (inhibit-first-line-modes-regexps): Ditto. - (inhibit-first-line-modes-regexps): Added .tgz. - (inhibit-first-line-modes-suffixes): Change defconst to defvar. - (change-major-mode-with-file-name): New user-option. - (set-visited-file-name): Synched with FSF. - (file-name-extension): New function, from FSF 20.3. - (file-relative-name): Synched with FSF. - (save-some-buffers): Support the C-r feature. - (recover-session): Synched with FSF. - (kill-some-buffers): Ditto. - (set-auto-mode): New argument JUST-FROM-FILE-NAME. - -1998-04-30 SL Baur - - * files.el (insert-file): Undo previous change and reenable use of - format.el. - -1998-04-30 Hrvoje Niksic - - * window-xemacs.el (recenter): Define. - -1998-04-29 Andy Piper - - * font.el (mswindows-font-create-name) - (mswindows-font-create-object): new functions for mswindows type - fonts. - - * msw-faces.el (mswindows-font-canicolize-name): fix so that - strings are parsed as well as font objects. - -1998-04-30 Hrvoje Niksic - - * modeline.el (defining-kbd-macro): Restore modeline indication of - kbd-macro being recorded. - (add-minor-mode): Simplify docstring. - (modeline-minor-mode-menu): Remove stuff. - -1998-04-29 Andy Piper - - * code-process.el (call-process): dynamically decide process - coding type. - -1998-04-29 Jim Radford - - * modeline.el: Add line-number-mode, column-number-mode to - the modeline minor-mode menu. Button2 on the line number does - goto-line. - -1998-04-29 Andy Piper - - * mouse.el: move x-selection-owner-p type things to - selection-owner-p. - - * msw-init.el: copy zmacs stuff from x-init.el - - * msw-select.el (mswindows-own-selection) - (mswindows-disown-selection) (mswindows-selection-owner-p): new - functions. Very simple minded implementation of selectio - ownership. - - * select.el (own-selection) (disown-selection) - (activate-region-as-selection) (select-make-extent-for-selection) - (valid-simple-selection-p): functions moved from x-select.el for - generalized selection. - - * x-select.el: see select.el changes. - - * x-toolbar.el: use new selection functions. - -1998-04-28 Michael Sperber [Mr. Preprocessor] - - * packages.el (packages-find-package-directories): Fixed bug that - would pick up multiple site-package directories. - (package-locations): Added "xemacs-packages" as a late package - location. - - * find-paths.el: Now uses `emacs-program-name' and - `emacs-program-version'. - Additions to enforce version-specific directories in - `paths-find-version-directory'. - -1998-04-29 SL Baur - - * default.el: Removed. - * site-start.el: Removed. - -1998-04-29 Didier Verna - - * minibuf.el (minibuffer-history-minimum-string-length): Default - to nil. - -1998-04-28 SL Baur - - * find-paths.el (paths-program-name): Rename. - (paths-emacs-root-p): Ditto. - (paths-find-site-directory): Ditto. - -1998-04-26 Karl M. Hegbloom - - * lisp-mode.el (emacs-lisp-mode-popup-menu-1): Add menu entry for - `emacs-lisp-byte-compile-and-load'. - -1998-04-26 Oscar Figueiredo - - * ldap.el (ldap-search): Fixed additional parameter passing to - `ldap-open' - -1998-04-27 Andy Piper - - * select.el (kill-primary-selection) (selection-owner-p) - (copy-primary-selection) (yank-clipboard-selection) - (selection-exists-p) (delete-primary-selection): new file and - functions that do the right thing for the selected device. - - * x-menubar.el: use generalised selection functions. - - * dumped-lisp.el: dump select.el. - -1998-04-27 SL Baur - - * find-paths.el (paths-progname): New variable. - (paths-emacs-root-p): Use it. - (paths-find-site-directory): Ditto. - -1998-04-26 SL Baur - - * loadup.el ((member "dump" command-line-args)): Dump as - `infodock' if InfoDock. - -1998-04-25 SL Baur - - * find-paths.el (construct-emacs-version): Simplify, include - program name in the return value. - * (paths-find-version-directory): Use it. - -1998-04-25 Oscar Figueiredo - - * info.el (Info-parse-dir-entries): Fixed regexp - (Info-build-dir-anew): Remove full suffix and capitalize info file - name for files with no @direntry - (Info-batch-rebuild-dir): New function - (Info-suffixed-file): Check for regular files instead of simple - file existence (could catch directories before) - -1998-04-25 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el, find-paths.el: Removed uses of `not' which - temacs doesn't have. - - * find-paths.el (paths-find-emacs-roots): Included exec-prefix - into root searching. - -1998-04-24 Martin Buchholz - - * subr.el: Remove definition of `not'. - -Sat Apr 24 1998 Andy Piper - - * msw-glyphs.el: enable graphics support. - -1998-04-23 Didier Verna - - * x-menubar.el (default-menubar): restored the line-number-mode - option. - - * misc doc string updates related to the options menu. - -1998-04-24 SL Baur - - * setup-paths.el (paths-construct-load-path): Fix typo. - -1998-04-23 Michael Sperber [Mr. Preprocessor] - - * x-menubar.el (default-menubar): font-menu-this-frame-only-p and - font-menu-ignore-scaled-fonts don't have to be bound now; this - gets us one step further towards making --no-autoloads work. - - * startup.el (normal-top-level): Load auto-autoloads only if - lisp-directory is non-nil. - - * setup-paths.el (paths-construct-load-path): Made it robust - against nil lisp-directory. - - * startup.el (startup-setup-paths-warning): Added `lisp-directory' - to the list of variables that cause a warning when nil. - - * toolbar.el (init-toolbar-location): Now works even when there's - no toolbar icon directory. - -1998-04-23 Hrvoje Niksic - - * help.el (view-lossage): Recognize it. - - * simple.el (log-message): Mark multiline messages. - -1998-04-22 SL Baur - - * info.el (Info-exit): `toolbar-info-frame' doesn't necessarily exist. - -1998-4-20 Stephen J. Turnbull - - * package-get.el (package-get-all): add `\n' separator to - interactive specification so that both variables are read - -1998-04-22 Didier Verna - - * x-menubar.el: ported the options menu to Custom. - Moved the "read only" toggle button to the buffers menu. - Corrected some missing ;;;###autoload or defcustom. - - * scrollbar.el (scrollbars-visible-p): defcustom wrapper around - the scrollbar-visible specifier for options menu handling. - - * toolbar.el (toolbar-visible-p) - (toolbar-captioned-p) - (default-toolbar-position): defcustom wrappers around - the toolbar specifiers for options menu handling. - - * frame.el (get-frame-for-buffer-default-instance-limit): - defcustom it for options menu handling. - - * font-lock.el (font-lock-mode): defcustom and autolaod the variable - font-lock-mode for options menu handling. - - * cus-start.el: added Custom properties to overwrite-mode for - options menu handling. - -Wed Apr 22 12:59:35 1998 Andy Piper - - * about.el: shameless self-promotion. - -1998-04-21 Hrvoje Niksic - - * simple.el (raw-append-message): Slightly optimize. - (remove-message): Use `push' for clarity. - (append-message): Ditto. - (display-warning): Dito. - (raw-append-message): Send the message to the appropriate device. - -1998-04-22 SL Baur - - * auto-save.el (auto-save-cyclic-hash-14): De-ebolification. - From Sean MacLennan - -1998-04-18 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el: Changed `directory-sep-char' to - `path-separator', following a change in GNU Emacs. - -1998-04-19 Oscar Figueiredo - - * info.el (Info-maybe-update-dir): Bug fix in `conservative' behaviour - (Info-build-dir-anew): Add a final newline. - (Info-build-dir-anew): Do not issue warning when rebuilding policy - is `always' - (Info-rebuild-dir): Ditto - - * dumped-lisp.el (preloaded-file-list): Added ldap.el - -1998-04-21 SL Baur - - * simple.el (count-words-buffer): Retain zmacs region. - (count-words-region): Ditto. - * simple.el: (what-line): Expanded line counts. - (count-lines): New parameter to conditionalize whether collapsed - lines get counted. - From Bob Weiner - -1998-04-19 SL Baur - - * packages.el (package-locations): infodock-packages must override - mule-packages and packages. - -1998-04-19 Jonathan Harris - - * wid-edit.el: - remove rude messages from widget-activation-widget-mapper - and widget-activation-glyph-mapper - -1998-04-17 Jonathan Harris - - * toolbar.el: Remove (featurep 'x) test from - toolbar-make-button-list - -1998-04-17 Hrvoje Niksic - - * gnuserv.el (gnuserv-edit): Switch to the next gnuserv buffer - only if in the same frame. - -1998-04-17 Michael Sperber [Mr. Preprocessor] - - * packages.el (package-locations): Added site-packages hierarchy. - - * setup-paths.el (paths-default-info-directories): Introduced and - used. - - * packages.el, setup-paths.el: Set various path searching depths - to 1. - - * packages.el (packages-hierarchy-depth): - (packages-load-path-depth): Introduced and used. - - * setup-paths.el (paths-load-path-depth): Introduced and used. - - * find-paths.el (paths-find-recursive-path): Added max-depth - parameter. - -1998-04-15 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el (paths-construct-info-path): Removed - dependency on behavior of (file-name-as-directory ""). - -1998-04-09 Oscar Figueiredo - - * ldap.el (ldap-search): Adapt to the new low-level API using ldap - lisp objects - -1998-04-14 Michael Sperber [Mr. Preprocessor] - - * dump-paths.el, startup.el: Added handling for --debug-paths. - -1998-04-15 William M. Perry - - * wid-edit.el: We cannot just set the help-echo or balloon-help - properties for an extent based on the :help-echo widget - property, since help-echo and balloon-help cause an EXTENT to - get passed in, where :help-echo functions are expecting a WIDGET - -1998-04-15 Kirill M. Katsnelson - - * scrollbar.el (init-scrollbar-from-resources): Call - mswindows-init-scrollbar-metrics when appropriate. - -Thu Apr 16 12:59:35 1998 Andy Piper - - * dumped-lisp.el: dump x-toolbar for window system - - * msw-init.el (init-post-mswindows-win): enable toolbars if we - have support and xpm. - -1998-04-16 SL Baur - - * files.el (toggle-read-only): Fix docstring. - From Didier Verna - -1998-04-14 Michael Sperber [Mr. Preprocessor] - - * startup.el (normal-top-level): Load autoload-file-name without - specifying an extension---some people only auto-autoload.el.gz. - -1998-04-06 Hrvoje Niksic - - * files.el (backup-enable-predicate): Don't bomb on NAME being - nil. - -1998-04-13 Michael Sperber [Mr. Preprocessor] - - * find-paths.el, packages.el: Now prefers configure'd paths. - This shouldn't cause any of the originally anticipated problems as - the current paths architecture will not define the various - configure-xxx variables if they're not specified on the configure - command line. - - * find-paths.el, setup-paths.el, packages.el: Removed all - mentionings of "/" as a path separator. - Used paths-construct-path throughout. - - * find-paths.el (paths-construct-path): Created to assemble paths - from directory components. - - * setup-paths.el, packages.el: Used paths-decode-directory-path - instead of decode-path-internal. - - * find-paths.el: Removed unused (and bogus) paths-find-emacs-path - and associates. - (paths-decode-directory-path) Created. - - * setup-paths.el: Changed configure-exec-path to - configure-exec-directory. - -1998-04-11 Michael Sperber [Mr. Preprocessor] - - * packages.el (packages-find-packages): Fixed decoding of - EMACSPACKAGEPATH. - - * startup.el: -no-packages -> -no-early-packages. - - (packages-load-package-lisps): Fixed loading of auto-autoload - files. - - * startup.el (normal-top-level): Fixed loading of core - auto-autoload. - - * obsolete.el: Un-obsoleted site-directory. Sigh. - - * startup.el, packages.el, dump-paths.el: Added proper settings - for site-directory and lisp-directory variables. - - * startup.el, loadup.el: Renamed inhibit-update-autoloads to - inhibit-package-autoloads and fixed handling of it. - - * startup.el, packages.el, dump-paths.el, loadup.el: Fixed - handling of former inhibit-package-init, now - inhibit-early-packages, to make -vanilla etc. work. - -1998-04-10 Kirill M. Katsnelson - - * code-process.el (start-process): Fallback to 'undecided instead - of 'binary for process input coding stream. - - * process.el (start-process): Docstring fix. - -1998-04-09 Oscar Figueiredo - - * info.el (Info-insert-dir): Do not insert temporary dir files - in Info-dir-file-attributes - (Info-build-dir-anew): Ensure temporary buffer is not read-only - (Info-rebuild-dir): Ditto. - -1998-04-09 Michael Sperber [Mr. Preprocessor] - - * obsolete.el: Added obsoleteness declarations for - `site-directory' and `Info-default-directory-list'. - -1998-04-08 Michael Sperber [Mr. Preprocessor] - - * find-paths.el (paths-find-emacs-root): Only look at the - executable at the end of the symlink chain for determining the - Emacs root. - -1998-04-07 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el (paths-construct-info-path): Changed construction - to cater to gone default in configure. - - * find-paths.el (paths-uniq-append): Added. - - * packages.el: Rewritten package path construction once again. - - * dump-paths.el, startup.el: Removed package-path as a global - variable. - - * package-admin.el (package-admin-add-single-file-package): - (package-admin-add-binary-package): Changed package-path to - late-packages. - - * packages.el (packages-split-path): Split path at "/" rather than - nil according to change in emacs.c. - -1998-04-06 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el (paths-construct-info-path): Changed info path - order so that directories come out right. - (paths-find-lock-directory): Fixed bug: It used to think - configure-lock-directory is a path. - -1998-04-06 Jeff Miller - - * x-toolbar.el: Added toolbar-vector-xxxxxx defvars. Modified - initial-toolbar-spec to use new toolbar-vector-xxxxxx defvars. This - eases the use of toolbar-add/kill-item functions. - -1998-04-07 Kirill M. Katsnelson - - * code-files.el (file-coding-system-alist): Commented out - loaddefs.el magical treatment. - -1998-04-06 Oscar Figueiredo - - * info.el (Info-rebuild-outdated-dir): Added new option - `conservative' and made it the default - (Info-rebuild-dir): Appropriately parse multi-line description - strings, and multi-section dir files. Issue warning when dir - is rebuilt as temporary - (Info-build-dir-anew): Issue warning when dir is built as - temporary - -1998-04-04 Kirill M. Katsnelson - - * list-mode.el (list-mode-map): Bind highlight motion commands to - standard keys left, right, C-b and C-f. - -1998-03-29 Karl M. Hegbloom - - * files.el (auto-mode-alist): allow .sc for Scheme->C - -1998-04-06 SL Baur - - * loadup.el (pureload): Don't quote (garbage-collect). - -1998-04-04 SL Baur - - * package-get-base.el: Updated. - -1998-04-04 Hrvoje Niksic - - * isearch-mode.el (isearch-just-started): New variable. - (isearch-mode): Set it. - (isearch-repeat): Advance one character forward only if the search - was successful, and was not just started. - (isearch-repeat): Clear isearch-just-started. - -1998-04-02 SL Baur - - * finder.el (finder-compile-keywords): Don't eval new finder-inf - if running -batch. - -1998-03-26 Hrvoje Niksic - - * subr.el (listify-key-sequence): Removed. - -1998-03-31 Hrvoje Niksic - - * bytecomp.el (byte-compile-print-gensym): New option. - (byte-compile-output-file-form): Use it. - (byte-compile-output-docform): Ditto. - (byte-compile-compiled-obj-to-list): Ditto. - -Sun Mar 29 1998 Andy Piper - - * msw-glyphs.el: set frame icon if xpm support. - -1998-03-30 Kyle Jones - - * help.el: Code that pretty prints variable values - removed. - -1998-04-02 SL Baur - - * find-paths.el (paths-emacs-root-p): Correct test for installation - directory. - From Michael Sperber [Mr. Preprocessor] - -1998-03-30 Kyle Jones - - * loaddefs.el: Don't set debug-ignored-errors; leave - its default value set to nil. - -1998-03-29 Damon Lipparelli - - * info.el (Info-rebuild-dir): fixed mis-spelling. - -1998-03-29 Oscar Figueiredo - - * info.el (Info-rebuild-outdated-dir): New custom var - (Info-insert-node): Create/update dir file when needed, ie when it - does not exist or is older than some info files in directory - -1998-04-01 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el, dump-paths.el, startup.el, packages.el: Allowed - for last packages, mainly for using a 20.4 package base. - - * packages.el (late-packages): Typo fix. It was called - early-packages. - - * find-paths.el (paths-find-emacs-root): Bug fix: it now chases - relative symlinks correctly. - (paths-find-emacs-roots): More rigorous checking for plausible - configuration-time root. - - * startup.el (normal-top-level): Added a warning if XEmacs cannot - find its roots. - -1998-03-27 Martin Buchholz - - * faces.el: Fix docstrings. - * glyphs.el: Fix docstrings. - * mouse.el: Fix docstrings. - - * frame.el: Change phrase `current frame' to `selected frame'. - - * faces.el (face-spec-set-match-display): Make FRAME arg optional. - - * bytecomp.el (displaying-byte-compile-warnings): Rewrite some - macros using backquote to make them infinitely more readable. - -1998-03-30 SL Baur - - * packages.el (packages-find-package-path): Hardcoded specialized - InfoDock support until we can clean this up. - - * help.el (describe-bindings-1): Return the value of the bindings - help buffer created. - (describe-bindings): Ditto. - - * simple.el (set-variable): Restore previous behavior of not - bombing if the variable to set is not boundp. - -1998-03-30 Michael Sperber [Mr. Preprocessor] - - * packages.el (packages-handle-package-dumped-lisps): Allow for - non-local files to be loaded off the package-lisp variable. - -1998-03-27 Kyle Jones - - * x-faces.el: Global X resources should override - specs for all device classes (color, grayscale, mono); - code currently doesn't override any of them. Fixed by - calling remove-specifier with '(x default) as the tag - set and allowing inexact matches. - -1998-03-27 Kyle Jones - - * faces.el: Separated face intializations based on - device classes into device type specific (tag set, - instantiator) pairs. - -1998-03-09 Hrvoje Niksic - - * wid-edit.el (widget-choice-action): Remember user's explicit - choice. - (widget-choice-value-create): Respect it. - From Richard Stallman - -1998-03-26 Michael Sperber [Mr. Preprocessor] - - * setup-paths.el (paths-construct-info-path): Always append - existing directories from configure-time info path. - - * startup.el (startup-setup-paths): Renamed misnamed info-path to - Info-directory-list. - - * info.el: Removed Info-default-directory-list which was broken by - design. - Removed bogus initialization of Info-directory-list---startup.el - can do a much better job. - Added autoload of Info-directory-list. - - * setup-paths.el (paths-construct-load-path): Fixed a bug pointed - out by Martin Buchholz : EMACSLOADPATH used to - be exclusive; now it's merely given precedence, just like in the - old days. - -1998-03-25 Michael Sperber [Mr. Preprocessor] - - * find-paths.el (paths-find-architecture-directory): Fix bug with - finding; it used to default too early. - -1998-03-25 Martin Buchholz - - * packages.el (packages-split-path): Fix a bug; it used to fail - for paths that weren't split. - -1998-03-26 SL Baur - - * finder.el (finder-compile-keywords): trap on errors. - -1998-03-24 Kyle Jones - - * x-faces.el (remove-specifier-specs-matching-tag-set-cdrs): Pass - fourth argument of t so that only the specs exactly - matching the tag lists are removed. - -1998-03-25 SL Baur - - * make-docfile.el: Don't discard the BOOTSTRAPLOADPATH. - -1998-03-23 SL Baur - - * minibuf.el (mouse-read-file-name-1): If a default directory was - specified, use it for generating the completions. - -1998-03-23 Michael Sperber [Mr. Preprocessor] - - * update-elc.el: Now respects inhibit-package-init and - inhibit-site-lisp. - Now does path construction with loadup-paths. - - * startup.el (normal-top-level, startup-setup-paths): Now respects - inhibit-package-init and inhibit-site-lisp. - - * packages.el (packages-find-package-path): Extended package path - by version-specific hierarchies. - (packages-find-packages): Now respects inhibit flag and - inhibit-site-lisp. - Moved path setup to loadup-paths. - - * make-docfile.el: Now respects inhibit-package-init and - inhibit-site-lisp. - Now does path construction with loadup-paths. - - * loadup.el: Now respects inhibit-package-init and - inhibit-site-lisp. - - * dumped-lisp.el (preloaded-file-list): Added loadup-paths. - - * loadup-paths.el: New file: setup load-path to encompass - packages. - -1998-03-22 SL Baur - - * auto-show.el: load-gc renamed to pureload. - * site-load.el: Ditto. - * packages.el (toplevel): Ditto. - * loadup.el (really-early-error-handler): Ditto. - * dumped-lisp.el (preloaded-file-list): Ditto. - * cus-face.el (custom-declare-face): Ditto. - -1998-03-22 Michael Sperber [Mr. Preprocessor] - - * : The Big Path Searching Overhaul. - - * find-paths.el: New file: find and assemble paths in the - installation hierarchy. - - * setup-paths.el: New file: global layout of paths and directories - within the XEmacs hierarchy. - - * packages.el: Replaced everything related to path searching and - startup by code in terms of find-paths. - - * loadup.el, make-docfile.el, update-elc.el, startup.el: Now calls - the new path searching engine. - - * dumped-lisp.el (preloaded-file-list): Added new files find-paths - and setup-paths. - -1998-03-22 SL Baur - - * dumped-lisp.el (preloaded-file-list): Load setup-paths.elc not - setup-paths.el. - -1998-03-20 Kirill M. Katsnelson - - * msw-glyphs.el: Added check for 'mswindows feature, so the file - compiles identically in any configuration. - Removed irrelevant commentary. - -1998-03-20 Kirill M. Katsnelson - - * simple.el (set-variable): Allow setting specifiers. - -1998-03-19 SL Baur - - * lisp.el (forward-sexp): Revert previous change. - -1998-03-18 SL Baur - - * frame.el (frame-initialize): Use `delete-console' instead of - `delete-device' to delete the stream console to match the usage in - Fkill_emacs. - -1998-03-16 SL Baur - - * files.el (cdpath-previous): New variable. - (cd): Use it. - From Bob Weiner - -1998-03-15 Kyle Jones - - * keydefs.el: Changed keybindings of forward-char, - backward, scroll-up and scroll-down to point to their - -command counterparts. - - * simple.el: New functions: forwarc-char-command, - backwrad-char-command, scroll-up-command, - scroll-down-command which work liek their counterparts - except that they honor the variable - signal-error-on-buffer-boundary. - - Definition of signal-error-on-buffer-boundary received - from src/cmds.c. - - defvar declaration added for word-across-newline to avoid - byte-compiler warning about the free variable reference. - -1998-03-14 Kirill M. Katsnelson - - * winnt.el: Removed "%t" from the beginning of - modeline-format. From now on, there's no nt-specifics in the modeline. - -1998-03-14 SL Baur - - * setup-paths.el (paths-setup-paths-warning): Replace occurrences - of `when' with `if'. - -1998-03-03 Kirill M. Katsnelson - - * msw-glyphs.el: New file. Defines TTY-style glyphs for - mswindows. Must be reworked along with glyphs.el, or - merged into it, after there is images support. - - * dumped-lisp.el (preloaded-file-list): Dump msw-glyphs.el when - 'mswindows. - -1998-03-13 SL Baur - - * faces.el: fix for text cursor initialization. - Suggested by Kyle Jones - From Andy Piper - -1998-03-11 Pete Ware - - * files.el (set-auto-mode): If a mode is not fboundp, check to see - if there is an existing package that handles it and warn the user - about that mode. - -1998-03-02 Kirill M. Katsnelson - - * x-menubar.el (default-menubar): Greyed out "Help / Basics / - Installation" menu item when Installation-string is not bound. - -1998-03-11 SL Baur - - * lisp.el (forward-sexp): Fix for test for balanced sexp. - From Jeremiah W. James - -1998-03-10 Kyle Jones - - * msw-faces.el: - * faces.el: Fix face initialization. - -1998-03-10 Glynn Clements - - * files.el (backup-enable-predicate): fix breakage introduced - by TMPDIR patch. - -1998-03-09 Kyle Jones - - * x-faces.el (x-init-face-from-resources): The - TTY face property retrieval functions don't return - specifiers, so use face-property instead. - -1998-03-09 SL Baur - - * mwheel.el (mwheel-install): Use portable keysyms and syntax. - -1998-03-09 Kyle Jones - - * x-menubar.el: Expanded documentation for - option-save-faces. Changed Options -> Browse Faces - menu entry to invoke customize-face. - -1998-03-09 Kyle Jones - - * faces.el: Most face initialization moved out of - init-other-random-faces to the top level so that the - initialization happens before Xemacs is dumped. Much - of the fascist "face-differs-from-default-p or FROB!" - code has been retired in favor of letting the user do - what they want to do. Face initialization code changed - to use `default' specifier tag so that the settings can - be overridden later if the user wishes it. - -1998-03-08 SL Baur - - * about.el (about-hackers): Update contributors list. - -1998-03-07 Kyle Jones - - * specifier.el: Define new specifier tag `default'. - - * modeline.el: Initialize faces using `default' tag. - - * x-faces.el (x-init-face-from-resources): Remove - specifier specs containing the `default' tag before - adding new specs. - -1998-03-02 John Jones - - * package-get.el (package-get-all): fixed arguments on call to - package-admin-add-single-file-package. - * package-get.el (package-get-installedp): fixed to match - advertised behavior. - * package-get.el: added function package-get-update-all which - installs newest versions of all the current packages (if they are - not already installed). - -1998-03-04 Jens-Ulrik Petersen - - * files.el (find-file-noselect): Uncommented `truename' binding in - `let*' and use it later to set `buffer-file-truename' iff it's - still nil, as happens for example when finding a compressed - file with "jka-compr". - -Wed Mar 04 08:55:12 1998 Andy Piper - - * faces.el: in make-face-* type functions do the operation for all - window systems, not just the first one found. - - * font.el: call mswindows-list-fonts for mswindows. - -1998-03-02 Glynn Clements - - * code-process.el (call-process-region): - * process.el (call-process-region): - * package-get.el (package-get-dir): - * files.el (backup-enable-predicate): - * gnuserv.el (gnuserv-temp-file-regexp): - Use temp-directory in place of `/tmp'. - -Fri Feb 20 21:22:34 1998 Darryl Okahata - - * "Fast" dired-in-C enhancements for Windows 95/NT: - - * files.el: Added function, `wildcard-to-regexp', from GNU - Emacs. - - * files.el (insert-directory): Modified to use special - dired-in-C enhancements if present. - -Mon Mar 02 11:37:36 1998 Andy Piper - - * code-files.el: make default coding no-conversion. - -1998-03-02 SL Baur - - * dumped-lisp.el (preloaded-file-list): Find Installation.el from - the load-path. - - * update-elc.el: Strip directory when testing for files not to - bytecompile. - -1998-03-02 Aki Vehtari - - * lisp-mode.el: Use recommended form for menus. - - * info.el (Info-construct-menu): Use recommended form for menus. - - * gnuserv.el (gnuserv-edit-files): Use recommended form for menu - entry. - -1998-02-28 Kyle Jones - - * frame.el: Resurrect get-frame-for-buffer-default-to-current. - (get-frame-for-buffer-noselect): Always return frames - in the not-this-window-p cond clause. - -1998-02-27 SL Baur - - * help.el (describe-installation): New function. - - * x-menubar.el (default-menubar): Add describe-installation to - Help menu. - - * packages.el (packages-unbytecompiled-lisp): Installation.el - should not be bytecompiled. - - * dumped-lisp.el (preloaded-file-list): Dump Installation with - XEmacs. - - * x-menubar.el (default-menubar): Use correct guard for VM menu - entry. - - * coding.el: Add coding systems for iso-8859-[12] for No-Mule + file - coding. - From Andy Piper - -1998-02-26 Oscar Figueiredo - - * ldap.el: Do not require ldap-internal at compile time. - -Tue Feb 17 12:50:37 1998 Andy Piper - - * code-files.el: new file. a virtual copy of mule-files.el - but without charset - dependencies. (toggle-buffer-file-ocding-system) new function for - changing the eol type for the current buffer. - - * code-process.el: new file. a copy of - mule-process.el. mule-process.el will disappear when things have - settled. - - * coding.el: new file. a virtual copy of mule-files.el but - without charset dependencies. (coding-system-base) new function - for getting the parent coding system of a coding system with eol - type set. - - * dumped-lisp.el: add above files for the non-mule case. - -1998-02-25 Kyle Jones - - * window-xemacs.el (display-buffer): If no explicit - frame is specified, search for a window that displays - the buffer on the currently selected frame, before - searching other frames. - -1998-02-25 Kyle Jones - - * frame.el (get-frame-for-buffer): If not-this-window-p - is non-nil, use window on the selected frame if it is not - also the selected window. When defaulting, search for - windows on the currently selected fgrame before searching - other frames. - -1998-02-25 Didier Verna - - * modeline.el (modeline-swap-buffers): originally named - `mouse-release-modeline'. Whether to actually swap the buffers is - decided in `mouse-drag-modeline'. - (mouse-drag-modeline): A button release event is considered a - mouse click is both X (modeline scroll) and Y (modeline drag) pos - stay unchanged. - -1998-02-25 SL Baur - - * x-menubar.el: Put redo on the menubar. - From Aki Vehtari - -1998-02-22 Greg Klanderman - - * bytecomp.el (displaying-byte-compile-warnings): if - temp-buffer-show-function is set, use it to display current set of - warnings in the "*Compile-Log-Show*" buffer. - - * simple.el (display-warning-buffer): if temp-buffer-show-function - is set, use it to display current set of warnings in the - "*Warnings-Show*" buffer. - -1998-02-20 Karl M. Hegbloom - - * cl-extra.el (equalp): Make (equalp ?A ?a) return t as in - Common Lisp. - -1998-02-23 Aki Vehtari - - * menubar.el: Allow button descriptors at least 2 long. - - * x-menubar.el (default-menubar): Use recommended forms. - (file-menu-filter): Remove. - (edit-menu-filter): Remove. - -1998-02-24 SL Baur - - * about.el (about-hackers): Updated. - -1998-02-22 Greg Klanderman - - * help.el (help-max-help-buffers): new variable - (help-register-and-maybe-prune-excess): new function - (help-buffer-name): use help-max-help-buffers. - (with-displaying-help-buffer): use - help-register-and-maybe-prune-excess. - - * help.el (help-maybe-pretty-print-value): if the value fits on - one line, let it. - -1998-02-21 Greg Klanderman - - * (with-displaying-help-buffer): there is no need to kill the buffer - if it exists, becasuse with-output-to-temp-buffer will clear it. - further, killing the buffer violates the rule that - temp-buffer-show-function, if set, has the full responsibility of - showing the temp buffer. killing the buffer fucks with the window - configuration, hosing temp-buffer-show-function. - - -1998-02-23 Didier Verna - - * modeline.el (mouse-drag-modeline): - - Always scroll the modeline that was originally clicked on. - - Use x pixels instead of x characters (which doesn't work anyway) - as horizontal reference for modeline dragging. This allows us to - keep on dragging the modeline even if the motion event occurs in - another window. - -1998-02-23 Didier Verna - - * x-mouse.el (x-init-pointer-shape): use a crossed-arrows cursor - glyph on the modeline to indicate that dragging the mouse has an - effect both horizontally and vertically. - -1998-02-24 SL Baur - - * about.el (about-xemacs): Get rid of redundant visible version - number. - -1998-02-19 SL Baur - - * about.el (about-hackers): Update credits. - -1997-12-22 Christoph Wedler - - * prim/register.el (view-register): Show register type file-query. - -1998-02-17 Kyle Jones - - * mode-motion.el (mode-motion-highlight-internal): - save-excursion inside save-window-exucrsion form to - hide buffer point changes from save-window-excursion. - Prevents display flickering when the mouse pointer - moves. - -1998-02-17 Didier Verna - - * mouse.el (default-mouse-track-set-point-in-window): rewrote this - function to handle correctly the case of a toolbar one side of the - window: scrolling will not necessarily happen. - -1998-02-17 Kyle Jones - - * files.el (after-find-file): Restore missing argument - to format that provides filename for "... consider M-x - recover-file" message. Also call `message' with "%s" - as the first arg instead of an arbitrary string. - -1998-02-18 SL Baur - - * about.el (about-hackers): Various additions. - -1998-02-15 SL Baur - - * autoload.el (generate-file-autoloads-1): Don't force an extra - line out when copying on-the-same line autoloads. - - * x-menubar.el (default-menubar): Add Sokoban to the menubar if it - is installed. - -1998-02-14 Martin Buchholz - - * x11/x-win-xfree86.el (x-win-init-xfree86): - * x11/x-win-sun.el (x-win-init-sun): - * x11/x-init.el (x-initialize-compose): - * prim/simple.el: - (backward-or-forward-kill-sexp): - (backward-or-forward-kill-sentence): - (backward-or-forward-kill-word): - (backward-or-forward-delete-char): - * prim/isearch-mode.el (isearch-help-or-delete-char): - Use x-keysym-on-keyboard-sans-modifiers-p instead of - x-keysym-on-keyboard-p to detect backspace. - Use symbols instead of strings (now deprecated) with x-keysym-*-p. - Clean up symbols used with dead keys, checking Linux and solaris - keysyms. - Simplify x-win-*.el using above methods. - Change documentation for x-keysym-*-p functions. - -1998-02-14 SL Baur - - * about.el (about-hackers): Restore entries for Michael Sperber and - Vinnie Shelton. - From Vinnie Shelton - -1998-02-14 Hrvoje Niksic - - * simple.el (count-words-region): Ditto. - -1998-02-12 Hrvoje Niksic - - * simple.el (count-words-buffer): Document. Don't print anything - if non-interactive. - -1998-02-12 SL Baur - - * packages.el (packages-hardcoded-lisp): easymenu.el is in - multiple files in InfoDock. - -1998-02-11 SL Baur - - * packages.el (packages-hardcoded-lisp): id-vers.elc is loaded - from version.el in InfoDock. - - * dumped-lisp.el (preloaded-file-list): Don't treat InfoDock - specially. - -1998-02-09 Karl M. Hegbloom - - * bytecomp-runtime.el (proclaim-inline): Single quotes around - variable name in docstring. - -1998-02-10 Andreas Jaeger - - * menubar.h: Include "gui.h". - -1998-02-10 SL Baur - - * site-load.el: Fix documentation. - -1998-02-09 SL Baur - - * package-get-base.el (package-get-base): Updated. - - * keymap.el: PC-ize. - -1998-02-08 Karl M. Hegbloom - - * hyper-apropos.el (hyper-apropos-get-doc): Print the `loaded - from' on a fresh line. - -1998-02-08 Hrvoje Niksic - - * help.el (help-maybe-pretty-print-value): prin1, not princ the - object. - -1998-02-09 SL Baur - - * undo-stack.el: PC-ize. - - * cmdloop.el: PC-ize. - -1998-02-08 SL Baur - - * bytecomp-runtime.el: PC-ize. - - * byte-optimize.el: Prolog fixup. PC-ize. - - * cus-dep.el: Spelling fix. - - * text-mode.el: Synch with Emacs 20.2. (Original ChangeLog - entries follow). - -1997-08-29 Richard Stallman - - * text-mode.el (text-mode-hook-identify): New function, - put on text-mode-hook. Set text-mode-variant here. - (text-mode): Don't set it here. - -1997-08-27 Richard Stallman - - * text-mode.el (text-mode-hook): New defvar. - (text-mode-variant): New variable. - (text-mode): Set that variable locally. - (toggle-text-mode-auto-fill): New command. - -1997-06-15 Richard Stallman - - * text-mode.el (text-mode): Let all-white lines separate paragraphs. - -1997-06-11 Richard Stallman - - * text-mode.el (paragraph-indent-text-mode): - Renamed from spaced-text-mode. - (text-mode-map): Bind TAB to indent-relative. - (indented-text-mode-map): Variable deleted. - (indented-text-mode): Now an alias for text-mode. - -1998-02-05 SL Baur - - * loadup.el: test-atoms debugging stuffs removed. - -1998-02-03 Martin Buchholz > - - * lisp/loaddefs.el (completion-ignored-extensions): Add ".class" - -1997-12-30 Colin Rafferty - - * help.el (describe-beta): Made it use `locate-data-file'. - (describe-distribution): Ditto. - (describe-copying): Ditto. - (describe-project): Ditto. - (view-emacs-news): Ditto. - - * help-nomule.el (help-with-tutorial): Made it use - `locate-data-file' to find tutorial. - -1998-01-28 Jonathon Harris - - * about.el: Corrected my email address. - - * mouse.el: Added 'mouse-mswindows-drop' similar to - 'mouse-offix-drop'. - -1998-01-27 SL Baur - - * loadup.el (running-xemacs): Spelling fix. - -1998-01-26 Colin Rafferty - - * packages.el (packages-find-packages-1): Don't allow a backwards - compatible lisp tree to overwrite `preloaded-file-list'. - -1998-01-26 SL Baur - - * loadup.el: Don't delete "xemacs" prior to dumping. - -1998-01-24 SL Baur - - * package-info.el (pi-last-mod-date): New function. - (pi-author-version): New function. - (batch-update-package-info): Use them. - -1998-01-23 Colin Rafferty - - * frame.el (get-frame-for-buffer-default-to-current): Create. - (get-frame-for-buffer-noselect): Allow user to use current frame - with `get-frame-for-buffer-default-to-current'. - -1998-01-22 Hrvoje Niksic - - * bytecomp.el (byte-compile-output-file-form): Set print-gensym. - (byte-compile-output-docform): Ditto. - (byte-compile-compiled-obj-to-list): Ditto. - -1998-01-22 Kyle Jones - - * startup.el (command-line-1): Removed code that ran - buffer-menu. - -1998-01-21 Hrvoje Niksic - - * help-macro.el (make-help-screen): Bind `help-read-key' via flet. - -1998-01-17 Hrvoje Niksic - - * frame.el (suspend-emacs-or-iconify-frame): Check using - `device-on-window-system-p' instead of explicitly checking for X, - so that the same logic works for MS Windows. - (suspend-or-iconify-emacs): Ditto. - -1998-01-14 Hrvoje Niksic - - * about.el (about-maintainer-info): Andy Piper is back. - (xemacs-hackers): Updated Andy Piper's email address. - (about-hackers): Added Jonathan Harris. - (about-hackers): Updated Tibor Polgar's email address. - -1998-01-18 SL Baur - - * about.el: Add xemacs.org email manager. - - * package-get-base.el (package-get-base): Updated with most recent - package updates. - -1998-01-14 Jens-Ulrik Holger Petersen - - * help.el (function-arglist): Use `indirect-function' instead of - `symbol-function' so that aliases are treated correctly. - -1998-01-13 Jens-Ulrik Holger Petersen - - * help.el (help-map): Add f1 binding to `help-for-help'. - Suggested by Karl M. Hegbloom . - (describe-key-briefly): Use `princ' "%s" to print object. - (with-displaying-help-buffer): Kill buffer if it exists, again. - (describe-key): Use `princ' "%s" to print object. - (describe-function-1): Use `princ' "%s" to print object. - Commented out alias lines removed. - (help-pretty-print-limit): New variable to control pretty-printing - of variable values. - (help-maybe-pretty-print-value): Steve wins! Renamed back from - `help-pretty-print-value' again. Only print-print when OBJECT is - list of length less than `help-pretty-print-limit'. - (describe-variable): Use `help-maybe-pretty-print-value' again. - -1998-01-18 SL Baur - - * simple.el (blink-matching-open): Remove C++ kludge. - Suggested by Bob Weiner - -1998-01-14 Karl M. Hegbloom - - * info.el (Info-default-directory-list): Made the documentation - more explanitory. - -1998-01-13 Martin Buchholz - - * lisp/packages.el: - * lisp/package-admin.el: - * lisp/build-report.el: - Fix typos. - -1998-01-14 Christoph Wedler - - * Patches/font-lock.el (java-font-lock-keywords-*): Would produce - warnings in Java buffers without final newline and editing the - last line. - -1998-01-17 SL Baur - - * packages.el (packages-find-packages-1): Don't allow a backwards - compatible lisp tree to overwrite `preloaded-file-list'. - Suggested by Colin Rafferty - - * mouse.el (mouse-offix-drop): Set undo-boundary. - From Oliver Graf - -1998-01-13 SL Baur - - * loadup.el (load-gc): rewrite as defun. - Print something sensical if a required dump-time file isn't found. - -1998-01-12 SL Baur - - * menubar.el (check-menu-syntax): Emergency dirty fix -- the 0 plist - bug strikes a menudescriptor. - - * package-get-base.el (package-get-base): Updated. - - * package-info.el (batch-update-package-info): Derive REQUIRES - from the Makefile. - -1998-01-13 Hrvoje Niksic - - * files.el (save-some-buffers): Don't play games with deleting - other windows if we are in the minibuffer window. - -1998-01-08 Karl M. Hegbloom - - * modeline.el (modeline-minor-mode-menu): Add support for :active - (add-minor-mode): Document :active property to TOGGLE. - -1998-01-07 Karl M. Hegbloom - - * modeline.el (modeline-minor-mode-menu): Add support for an - `:included' predicate in the `toggle-sym' plist. - (add-minor-mode): Document the :included property, format - docstring some more. - (modeline-minor-mode-menu): Documentation string added. - -1998-01-02 Karl M. Hegbloom - - * modeline.el (modeline-minor-mode-menu): genmenlab the menu - labels from the symbol-names by thwacking off the overly redundant - and overused "mode", parenthesizing "minor", and capitalizing the - resultant strings. Also shortened the menu's title by eliminating - the redundant buffer name. - (add-minor-mode): Beautified the docstring, added mention of the - `:menu-tag' property of TOGGLE. - (modeline-minor-mode-menu): Frinked the `:menu-tag' property on - `toggle-sym' to beatify the mode-life menus. - * (abbrev-mode): (put)'ed a `:menu-tag' on it and - `auto-fill-function'. - -1998-01-02 Karl M. Hegbloom <> - - * modeline.el (modeline-minor-mode-menu): Changed the string-only - menus to :style 'toggle. - -1997-12-10 Markus Linnala - - * simple.el: Use mh-user-agent-compose as mh-e-user-agent. - -1997-12-11 Christoph Wedler - - * packages/hyper-apropos.el (hyper-apropos-insert-face): Would - only recognize first hyperlink. - (hyper-apropos-highlightify): Deletia, this is already done by - `hyper-apropos-insert-face'. - (hyper-apropos-help-mode): Don't call `hyper-apropos-highlightify. - -1998-01-09 SL Baur - - * x-toolbar.el (toolbar-ispell-internal): Use ispell-message for - mail. - (toolbar-mail-reader): Add support for `send'. - From Jonathan Marten - -1998-01-05 Karl M. Hegbloom <> - - * info.el (Info-emacs-info-file-name): Add defvar for - `Info-emacs-info-file-name' so that `Info-goto-emacs-command-node' - will function properly. - -1998-01-05 Gary D. Foster - - * simple.el: make the backwards delete function called by - `backward-or-forward-delete-char' user configurable. - -1998-01-09 Karl M. Hegbloom - - * hyper-apropos.el (hyper-apropos-get-doc): Print where a byte - compiled function got loaded from. - -1998-01-09 SL Baur - - * term/apollo.el: Synched up with InfoDock 3.6.2. - -1998-01-08 SL Baur - - * startup.el (load-init-file): Load autoloads earlier. - (startup-splash-frame): Handle InfoDock logo. - - * x-init.el (init-post-x-win): Don't call init-x-toolbar in - InfoDock. - (x-init-toolbar-from-resources): Move from x-toolbar.el. - - * toolbar.el (init-toolbar-from-resources): InfoDock x-toolbar.el - doesn't have this function. - - * packages.el (locate-data-file): Fix to call `locate-file'. - -1998-01-07 SL Baur - - * dumped-lisp.el (preloaded-file-list): InfoDock uses its own - version of version.el. - (preloaded-file-list): Ditto for x-menubar.el and x-toolbar.el. - - * x-menubar.el (default-menubar): Guard reference to - `gnuserv-frame'. - (default-menubar): Guard references to `font-lock-mode'. - (default-menubar): Guard references to font-menu-this-frame-only-p'. - (default-menubar): Guard references to `font-menu-ignore-scaled-fonts'. - - * make-docfile.el: Don't snarf doc strings from autoloads. - - * startup.el (load-init-file): Use algorithm from loaddefs.el for - loading auto-autoloads files. - - * loaddefs.el: Disable dumping autoloads. - -1998-01-05 SL Baur - - * lisp-mnt.el: Synch to Emacs 20.2. - - * help.el: Remove manual autoload of `finder-by-keyword'. - - * finder.el (finder-by-keyword): Autoload. - - * help.el: Conditionalize hyperbole setup. - -1998-01-04 SL Baur - - * packages.el (package-require): Update to reflect new data format. - -1998-01-02 Didier Verna - - * x-menubar.el (default-menubar): make the tutorials available - through the menubar. (Plus some compilation warnings cleanup). - -1998-01-04 SL Baur - - * check-features.el: New file. Perform sanity check after build. - - * dumped-lisp.el (preloaded-file-list): Move tooltalk dumped lisp - files to tooltalk package. - (preloaded-file-list): Moved sparcworks dumped lisp files to Sun - package. - - * package-admin.el (package-admin-xemacs): Use better default for - location of XEmacs binary. - -1998-01-03 Aki Vehtari - - * x-menubar.el (buffers-menu-submenus-for-groups-p): Replace const - tag with sexp and add value tag with value `t'. - -1998-01-03 SL Baur - - * package-get.el: Changes to work with real data. - From Pete Ware - - * packages.el (packages-reload-autoloads): Guard load for the time - being. - - * update-elc.el ("packages.el"): Force loading packages.el instead - of possibly out-of-date packges.elc. - * make-docfile.el ("packages.el"): Ditto. - -1998-01-02 Colin Rafferty - - * build-report.el (build-report-delete-regexp): Added a rule for - the main tarball shadowing anything past it. - -1998-01-02 SL Baur - - * packages.el (package-provide): Delete a previous provide. - - * package-info.el: New file. - - * package-get.el: New file. - From Pete Ware - (package-get): Fix md5 computation to work with Mule. - -1997-12-11 Jens-Ulrik Holger Petersen - - * simple.el (log-message-*): Quote symbols in docstrings properly. - -1998-01-01 SL Baur - - * packages.el (packages-new-autoloads): Ignore symbolic links. - - * cus-face.el (face-custom-attributes-get): Fix typo. - From Jens-Ulrik Holger Petersen - -1997-12-31 SL Baur - - * startup.el (load-init-file): Reload new or changed autoloads - unless inhibited. Reload modified dumped lisp (stubbed). - - * packages.el (packages-new-autoloads): New function. - (packages-reload-autoloads): New function. - (packages-reload-dumped-lisp): New (stub) function. - - * loadup.el: Inhibit reloading dumped files when running temacs. - - * loadhist.el (file-provides): Extend to handle variant - extensions. - - * replace.el (query-replace): Fix typo. - -1997-12-30 SL Baur - - * make-docfile.el: list-autoloads-path has been renamed. - * update-elc.el: list-autoloads has been renamed. - - * packages.el (packages-list-autoloads): Renamed. - (packages-list-autoloads-path): Ditto. - -1997-12-29 Colin Rafferty - - * packages.el (packages-find-packages-1): Made it signal a warning - for an error in an auto-autoload.el file. - -1997-12-30 SL Baur - - * x-menubar.el (buffers-menu-submenus-for-groups-p): Replace sexp - tag with const. - From Aki Vehtari - - * dumped-lisp.el (preloaded-file-list): Dump loadhist with XEmacs. - - * loadhist.el (unload-feature): Remove autoload. - -1997-12-28 SL Baur - - * loadhist.el: Unpackaged. - - * help.el (describe-symbol-find-file): Rename - `describe-function-find-file' and make old name obsolete. - (describe-function-1): Use it. - (describe-function-1): Guard reference to - `compiled-function-annotation'. - -1997-12-27 Jens-Ulrik Holger Petersen - - * help.el (help-mode-bury): Now a call to `help-mode-quit' with - argument. - (help-mode-quit): New optional arg to control whether it kills or - buries. Tidied up. - (with-displaying-help-buffer): Don't kill buffer initially, even - if it exists: it is erased by `with-output-to-temp-buffer' anyway. - (help-pretty-print-value): Rename back from - `help-maybe-pretty-print-value'! If `pp-internal' is available - use it, otherwise use dumped `cl-prettyprint'. - (describe-variable): Use `help-pretty-print-value' again. - (find-func): Removed reference to "find-func" at end. - -1997-12-26 Kirill M. Katsnelson - - * dumped-lisp.el: x-menubar.el dumped along with mswindows native - GUI XEmacs. Rename? x-menubar is rather window system - independant, except for a couple of items. - -1997-12-26 SL Baur - - * x-menubar.el (default-menubar): Remove hyperbole and oobr - entries as they will no longer be distributed with XEmacs. - - * format.el (format-alist): Fix image/tiff regexps. - From P. E. Jareth Hein - - * help.el (help-maybe-pretty-print-value): Rename. - (describe-variable): Use it. - (describe-variable): Add trailing linefeed. - -1997-12-26 Jens-Ulrik Holger Petersen - - * help.el (describe-function-1): Don't output anything for - arglist of autoload functions. - -1997-12-26 Jens-Ulrik Holger Petersen - - * help.el (describe-function-1): Don't output anything for - arglist of autoload functions. - -1997-12-26 Jens-Ulrik Holger Petersen - - * help.el (help-mode-map): New bindings for `help-mode-bury', - `describe-function-at-point', `describe-variable-at-point', - `Info-elisp-ref', `customize-variable', `help-next-section' and - `help-prev-section'. - (help-next-section): New function. - (help-prev-section): New function. - (help-mode-quit): Changed to kill the help buffer. - (help-mode-bury): Formerly `help-mode-quit'. Bury buffer - correctly. - (help-buffer-name): New function to generate the name of help - buffers. - (with-displaying-help-buffer): Is now a macro. Takes an new first - argument giving the name of the help buffer. - (describe-key): Use `with-displaying-help-buffer' with name. - (describe-mode): Ditto. - (describe-bindings): Ditto. - (describe-prefix-bindings): Ditto. - (view-lossage): Ditto. - (with-syntax-table): New macro. - (function-called-at-point): Use `ignore-errors' and - `with-syntax-table'. - (function-at-point): Ditto. - (describe-function): Use `with-displaying-help-buffer' with name. - (function-arglist): Extracted from `describe-function-1'. Returns - function's arglist as string. - (function-documentation): Extracted from `describe-function-1'. - Returns function's docstring. - (describe-function-1): Remove all the "stream" garbage, including - the stream argument. Use `function-arglist' and - `function-documentation'. - (describe-function-arglist): Just use `function-arglist'. - (variable-at-point): Use `ignore-errors' and `with-syntax-table'. - (help-pretty-print-value): New function to help with - pretty-printing variable values. Knows about `#<...>'. Needs - `pp-internal'. - (describe-variable): Use `with-displaying-help-buffer' with name. - Formatting improved. Display file where variable is defined, if - known. Use `help-pretty-print-value'. - (describe-syntax): Use `with-displaying-help-buffer' with name. - (list-processes): Remove "stream" garbage. - -1997-12-25 SL Baur - - * x-init.el (x-initialize-keyboard): Don't load x-win*.el files, - call a dumped routine instead. - - * x-win-xfree86.el: Wrap file in defun. - * x-win-sun.el: Ditto. - -1997-12-23 SL Baur - - * help.el (view-emacs-news): Remove usage of outl-mouse which - advises functions and does other evil things. - -1997-12-22 SL Baur - - * format.el (format-alist): Add `image/tiff'. - From P. E. Jareth Hein - -1997-12-21 SL Baur - - * about.el (about-hackers): More names added. - - * make-docfile.el: Remove superfluous package path search. - - * loaddefs.el: Commentary changes. Removal of VM autoloads. - -1997-12-20 SL Baur - - * shadow.el (find-emacs-lisp-shadows): Add _pkg to the list of - ignored shadows. - -1997-12-18 SL Baur - - * startup.el (set-default-load-path): Make sure lisp and site-lisp - get trailing slashes when added to the load-path. - - * x-init.el (init-x-win): Locate where XEmacs X localization files - are. - -1997-12-18 Kyle Jones - - * x-faces.el: Added support for foregroundToolBarColor - to xpm-color-symbols. - -1997-12-17 Hrvoje Niksic - - * etags.el (tags-remove-duplicates): Removed. - (buffer-tag-table-list): Use `delete-duplicates'. - - * cl-extra.el (coerce): Coerce to bit-vector and weak-list - correctly. - (get*): Defalias to `get'. - - * cl.el (eql): Compare integers with `eq'. - (cl-map-extents): Check for `map-extents' first. - -1997-12-17 Didier Verna - - * leim/quail/latin-pre.el ("french-prefix"): doc string cleanup + - added the 'numero', 'copyright' and 'trademark' symbols. - - * leim/quail/latin-post.el ("french-postfix"): see above. - -1997-12-15 Hrvoje Niksic - - * widget.el (define-widget): Check the arguments. - - * cus-edit.el (customize-face): Use `check-argument-type'. - (custom-variable-value-create): Use `signal' to signal error. - (custom-variable-reset-saved): Ditto. - (custom-variable-reset-standard): Ditto. - (custom-face-reset-saved): Ditto. - - * wid-edit.el (widget-prompt-value): Use `signal' to signal error. - (widget-default-format-handler): Ditto. - (widget-checklist-add-item): Ditto. - (widget-radio-add-item): Ditto. - (widget-editable-list-entry-create): Ditto. - (widget-sexp-prompt-value): Ditto. - - * custom.el (custom-declare-variable): Signal errors better. - (custom-handle-keyword): Ditto. - (custom-declare-group): Ditto. - - * window-xemacs.el (windows): Ditto. - - * menubar.el (menu): Ditto. - - * keydefs.el (keyboard): Ditto. - - * minibuf.el (minibuffer): Ditto. - - * process.el (execute): Ditto. - - * fill.el (fill): Ditto. - - * modeline.el (modeline): Ditto. - - * help.el (help): Ditto. - - * faces.el (faces): Ditto. - - * files.el (files): Ditto. - - * x-init.el (x): Ditto. - - * lisp-mode.el (lisp): Ditto. - - * process.el (processes): Ditto. - - * mouse.el (mouse): Ditto. - - * abbrev.el (abbrev): Moved from cus-edit. - - * font-lock.el (lisp-font-lock-keywords-1): Recognize `defcustom' - as variable declaration. - -1997-12-15 Hrvoje Niksic - - * menubar.el (find-menu-item): Use `check-argument-type'. - (find-menu-item): Cosmetic changes. - -1997-12-18 SL Baur - - * x-menubar.el (default-menubar): Guard usage of lpr-switches. - -1997-12-17 SL Baur - - * startup.el (set-default-load-path): Only search package-path - when not running temacs. - - * dumped-lisp.el (preloaded-file-list): Remove Egg/Its dumped lisp - files. - - * loadup.el: Correct commentary. Reformatting. - (really-early-error-handler): Use absolute path to the - first dumped-lisp.el file. - (really-early-error-handler): Print full path name of - each dumped lisp file (inherited from InfoDock). - - * shadow.el (find-emacs-lisp-shadows): Ignore multiple - dumped-lisp.el files. - - * make-docfile.el (preloaded-file-list): Reorder when the - package-path is searched. - * update-elc.el: Ditto. - - * lisp-mode.el (call-with-condition-handler): Treat the same as - `condition-case' for indentation. - - * about.el (about-xemacs): Update release date. - -1997-12-17 Hrvoje Niksic - - * cl-macs.el (case): Signal error if `t' or `otherwise' are seen - anywhere but at the last clause. - (ecase): Disallow `t' and `otherwise'. - -1997-12-16 Jens-Ulrik Holger Petersen - - * cus-edit.el (custom-buffer-create-buttons): New function - from stuff moved out of `custom-buffer-create-internal'. - (custom-novice): New variable. Default t. - (custom-display-global-buttons): Ditto. Default `top'. - (custom-buffer-create-internal): Only display help if - `custom-novice' is non-nil. Display global buttons according to - `custom-display-global-buttons'. - -1997-12-15 Hrvoje Niksic - - * menubar.el (find-menu-item): Use `check-argument-type'. - (find-menu-item): Cosmetic changes. - -1997-12-15 Hrvoje Niksic - - * modeline.el (mouse-drag-modeline): Give the modeline a "pressed" - look. - -1997-12-16 Oscar Figueiredo - - * format.el (format-deannotate-region): Bug fix. - Deannotating a region containing unknown tags would fail - (causing decoding of text/enriched to fail at user level) - -1997-12-16 Kyle Jones - - * minibuf.el (read-directory-name): Support sixth - arg, HISTORY, as already documented. - -1997-12-17 Hrvoje Niksic - - * etags.el (get-tag-table-buffer): Use explicit lists as arguments - to `ecase'. - -1997-12-14 SL Baur - - * skk/skk-leim.el (skk-auto-fill-activate): Synch with - skk-activate. - -1997-12-13 SL Baur - - * dumped-lisp.el (preloaded-file-list): Remove debugging statement. diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1 deleted file mode 100644 index f72e3c1..0000000 --- a/lisp/ChangeLog.1 +++ /dev/null @@ -1,8056 +0,0 @@ -1997-12-13 SL Baur - - * help.el (describe-function-arglist): Restore. - (describe-function-1): Correct typo. - From Jamie Zawinski - -1997-12-13 Hrvoje Niksic - - * cus-dep.el (Custom-make-dependencies): Cut a newline. - - * cus-edit.el (customize-changed-options): Handle output more nicely. - (customize-changed-options): Mention `:version' instead of `:new'. - (customize-changed-options): Use `push'. - -1997-12-12 Colin Rafferty - - * window.el (shrink-window-if-larger-than-buffer): Modified the - algorithm so that is calculates the amount it can shrink the - buffer by shrinking the buffer itself first. - -1997-12-10 Hrvoje Niksic - - * undo-stack.el (trunc-stack-bottom): Don't terminate error - message with a period. - - * cus-start.el: Synch quoter with `custom-quote'. - - * custom.el (custom-add-load): Update custom-group-hash-table. - -1997-12-12 Hrvoje Niksic - - * mouse.el (mouse-track-run-hook): Understand `make-local-hook' - convention. - - * custom.el (custom-add-version): New function, from FSF. - (custom-handle-keyword): Use it. - - * cus-edit.el (custom-variable-prompt): Require match. - (customize-changed-options): New function, from FSF. - (customize-version-lessp): Ditto. - - * cus-edit.el (custom-quote): Defalias to `quote-maybe'. - (customize-set-variable): Use `quote-maybe'. - (customize-save-variable): Ditto. - (custom-variable-value-create): Ditto. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - - * cus-start.el: Use `quote-maybe'. - -1997-12-11 Hrvoje Niksic - - * simple.el (fsf:do-auto-fill): Comment out. - - * simple.el (set-goal-column): Be careful about the format - argument to message. - - * cl-macs.el: New setf methods for: buffer-dedicated-frame, - console-type-image-conversion-list, default-toolbar-position, - device-class, extent-begin-glyph, extent-begin-glyph-layout, - extent-end-glyph, extent-end-glyph-layout, extent-keymap, - extent-parent, extent-properties, frame-selected-window, - itimer-function, itimer-function-arguments, itimer-is-idle, - itimer-recorded-run-time, itimer-restart, itimer-uses-arguments, - itimer-value, keymap-parents, marker-insertion-type, - mouse-pixel-position, trunc-stack-length, trunc-stack-stack, - undoable-stack-max and weak-list-list. - -1997-12-12 SL Baur - - * keydefs.el (global-map): Import C-x M-: keybinding for - `repeat-complex-command' from Emacs 20. - -1997-12-11 Christoph Wedler - - * mule/mule-debug.el (list-charsets): Make it work. Better - formatting. - -1997-12-11 SL Baur - - * files.el (insert-file): Don't use format.el settings. - - * format.el (format-decode): Update docstring. - -1997-12-09 SL Baur - - * make-docfile.el (package-path): Set load-path from package path - before collecting the files to dump. - * update-elc.el (package-path): Ditto. - - * loadup.el: Comment changes, cleanup. - -1997-12-09 Hrvoje Niksic - - * etags.el (tags-loop-continue): Avoid giant `progn' in while test. - (next-file): Use `pop'. - -1997-12-08 Hrvoje Niksic - - * etags.el (find-tag-internal): Set the initial fuzz offset to 100 - instead of 1000. - (find-tag-internal): Use `letf'. - (tags-delete): Removed -- was unused. - (set-buffer-tag-table): Use `expland-file-name'. - (get-tag-table-buffer): Use `ecase'. - (add-to-tag-completion-table): Mark the filename messages with - progress. - (add-to-tag-completion-table): Use `char-after' instead of - `following-char'. - (add-to-tag-completion-table): Use `match-string'. - (complete-symbol): Use `error' instead of message+ding. - (complete-symbol): Use `skip-syntax-forward'. - (tag-complete-symbol): Autoload. - (pop-mark-from-stack): Use `buffer-live-p'. - (pop-tag-mark): Autoload the `M-*' binding. - (list-tags): Made it work. - -1997-12-09 SL Baur - - * x-toolbar.el (toolbar-news): Fix typo. - -1997-12-06 Jonathan Harris - - * dumped-lisp.el, emacs.c, symsinit.h, msw-init.el, nt/xemacs.mak - Created files: msw-select.el, select-msw.c - Copy and paste 8-bit text to/from mswindows clipboard. - - * msw-faces.el: mswindows-make-font-bold[-italic] - Try to make the bold font the same width as the non-bold font. - -1997-12-07 Hrvoje Niksic - - * wid-edit.el (widget-prettyprint-to-string): Nix cl-prettyprint's - newlines. - -1997-12-06 Hrvoje Niksic - - * x-toolbar.el (toolbar-not-configured): Use `error'. - (toolbar-compile): Restore `toolbar-already-run' feature from - 19.15. - (toolbar-news): Use `eval' on non-symbols. - (toolbar-info-frame-plist): Use the new `plist' widget. - (toolbar-news-frame-plist): Ditto. - - * font-lock.el (font-lock-fontify-buffer-function): New variable, - synched with FSF Emacs 20. - (font-lock-unfontify-buffer-function): Ditto. - (font-lock-fontify-region-function): Ditto. - (font-lock-unfontify-region-function): Ditto. - (font-lock-inhibit-thing-lock): Ditto. - -1997-12-07 SL Baur - - * egg/egg-cwnn-leim.el (egg-pinyin-activate): New file. Interface - to Chinese Wnn server. - - * egg/egg-kwnn-leim.el: New file. Interface to Korean Wnn - server. - - * dumped-lisp.el (preloaded-file-list): Dump LEIM integration - files for kWnn and cWnn. - -1997-11-30 Adrian Aichner - - * build-report.el: - Making better use of `custom'-features to represent various - `build-report' variables. - build-report-*-regexp have become lists which are or-ed together - internally. - customized group `build-report' is now a child of group `build' which is - not release as of this version. - Including comment now into build-report stating wheter all or just the - most recent ./configure output is being inserted. - -1997-12-01 Jonathon Harris - - * msw-init.el: Provide default bindings for cut, paste, copy and undo - -1997-12-05 Hrvoje Niksic - - * wid-edit.el: Ditto. - (widget-prettyprint-to-string): Use `cl-prettyprint'. - (widget-sexp-value-to-internal): Handle printed object beginning - with newline. - - * cus-edit.el: Avoid `pp-to-string'. - -1997-12-04 Hrvoje Niksic - - * simple.el (display-warning): Use `with-current-buffer'. - - * font-lock.el (font-lock-mode): Use `lmessage'. - (font-lock-fontify-buffer): Ditto. - (font-lock-unfontify-region): Ditto. - (font-lock-fontify-syntactically-region): Ditto. - (font-lock-fontify-keywords-region): Ditto. - (font-lock-fontify-keywords-region): Ditto. - - * simple.el (raw-append-message): Use `with-current-buffer'. - (log-message-filter): Place `save-match-data' outside the loop. - (log-message): Use `with-current-buffer'. - (remove-message): Use `lwarn' to warn about the hook error. - - * lisp-mode.el: Indent `lmessage' and `lwarn' properly. - - * simple.el (lmessage): New function. - (lwarn): Ditto. - (kill-region): Use `lmessage' instead of `display-message'. - (set-comment-column): Ditto. - (set-fill-column): Ditto. - - * faces.el (get-custom-frame-properties): Don't use - `default-custom-frame-properties'. - - * font-lock.el: Customized variables. - - * font-lock.el: Customized faces. - - * font-lock.el: (font-lock-maximum-decoration): Default to t. - - * cus-edit.el (vms): Removed. - -1997-12-03 Hrvoje Niksic - - * cus-start.el: Ditto. - - * gui.el (dialog-frame-plist): Ditto. - - * gnuserv.el (gnuserv-frame-plist): Ditto. - - * frame.el: Use the `plist' widget type in defcustoms. - - * cus-edit.el (plist): New widget type. - (custom-plist-convert-widget): New function. - (custom-quote): Vectors and bit-vectors are also self-printable. - -1997-12-05 Mark Borges - - * mail/mail-extr.el (all-top-level-domains): - Two letter country codes synched with - http://www.iana.org/in-notes/iana/assignments/country-codes - as updated by the RIPE Network Coordination Centre. - Source: ISO 3166 Maintenance Agency - Latest change: Thu Aug 7 17:59:51 MET DST 1997 - -1997-12-03 Eric Eide - - * files.el (set-auto-mode): Don't invoke - `hack-local-variables-prop-line' if `enable-local-variables' - is nil. - - * files.el (hack-local-variables-prop-line): Don't invoke - `hack-local-variables-p' for mode-only or empty -*- lines. - Don't test `enable-local-variables' before setting the mode; - instead, just verify that the specified major mode isn't the - current major mode. - -1997-12-03 Hrvoje Niksic - - * startup.el (load-init-file): Use a warning buffer in case of - error. - -1997-12-05 SL Baur - - * buffer.el (switch-to-buffer): Update docstring. - Suggested by Adrian Aichner - -1997-12-01 Jens-Ulrik Holger Petersen - - * cus-edit.el (custom-unlispify-remove-prefixes): Reference to - related variables added. - (custom-variable-default-form): New variable controlling default - display form for customization of variables. - (custom-variable): widget `:form' is nil before initialization. - (custom-variable-value-create): Initialize `:form' to - `custom-variable-default-form'. - (custom-face-default-form): New variable controlling default - display form for customization of faces. - (custom-face): widget `:form' is nil before initialization. - (custom-face-value-create): Initialize `:form' to - `custom-face-default-form'. - -1997-11-28 Jens-Ulrik Holger Petersen - - * misc/mic-paren.el: Define faces with `defface'. Colors - given for both dark and light backgrounds. Keep face - variables for backward compatibility. - -1997-12-03 Hrvoje Niksic - - * simple.el (temporary-goal-column): Made buffer-local. - -1997-12-01 Hrvoje Niksic - - * cus-edit.el (Custom-move-and-invoke): Removed. - (custom-mode): Ditto for doc. - -1997-12-02 SL Baur - - * egg/egg-sj3-client.el (sj3-command-reset): Initial port to XEmacs. - - * egg/egg-sj3.el: Initial port to XEmacs. - - * egg/egg-leim.el (egg-activate): Define - `egg-default-startup-file'. - - * language/japanese.el (japanese): Remove definition of - `egg-default-startup-file'. - - * dumped-lisp.el (preloaded-file-list): Dump egg-sj3 and skk LEIM - support. - - * egg/egg-sj3-leim.el: New file -- Add Egg/SJ3 support to LEIM. - -1997-12-01 SL Baur - - * locale/ja/locale-start.el (startup-splash-frame-body): Fix typo - on advertised-undo. - Suggested by: Hajime Saitou - - Comment cleanup. - -1997-11-30 SL Baur - - * help-macro.el (help-read-key): Autoload. - -1997-11-29 Hrvoje Niksic - - * etags.el (buffer-tag-table-list): Check for `../TAGS'. - (visit-tags-table): Disallow setting `tags-file-name' to a - nonexistent file. - -1997-11-29 SL Baur - - * update-elc.el ((preloaded-file-list site-load-packages)): Modify - error message to be more build-report.el friendly. - - * dumped-lisp.el (preloaded-file-list): Remove tooltalk/ prefix - from tooltalk dumped files. - - * symbol-syntax.el: Modify comments. - -1997-11-29 Kyle Jones - - * etags.el (find-tag-default): Use symbol-near-point - instead of thing-symbol to remove the dependency on - thing.el. - -1997-11-29 SL Baur - - * symbol-syntax.el: Unpackaged. - * disp-table.el: Unpackaged. - * picture.el: Unpackaged. - * rect.el: Unpackaged. - * lisp-mnt.el: Unpackaged. - - * mule/canna.el: Don't require emu. - (canna:enter-canna-mode): Inline code for compatibility function - `minibuffer-prompt-width'. - - * info.el (Info-find-node): Guard call to browse-url. - * wid-edit.el (widget-url-link-action): Ditto. - - * hyper-apropos.el (hyper-apropos-get-doc): Use cl-prettyprint - instead of pp. - (hyper-apropos-disassemble): Ditto. - - * x-menubar.el (default-menubar): Disable WWW items in help menu - if no browse-url. - - * help.el (xemacs-www-page): Print error message intead of bombing - if not browse-url. - (xemacs-www-faq): Ditto. - - * files.el (recover-session): Print error message instead of - bombing if no dired. - (file-remote-p): Return nil if no ange-ftp and no efs. - - * format.el (format-encode-run-method): `shell-command-on-region' - called with wrong number of args. - (format-decode-run-method): Ditto. - - * buff-menu.el (Buffer-menu-toggle-read-only): Call - modeline-toggle-read-only. - - * register.el (copy-rectangle-to-register): Check for rectangle - functions. - (insert-register): Ditto. - - * x-toolbar.el (pending-delete): Don't (require 'pending-del). - * x-menubar.el (pending-delete): Don't (require 'pending-del). - - * x-menubar.el (bookmark-menu-filter): Add guards against bookmark - package not being loaded. - - * mule/char-table.el: Imported from tm. - * mule/chartblxmas.el: Ditto. - * alist.el: Ditto. - * overlay.el: Unpackaged for Quail. - - * x-menubar.el (default-menubar): Put guard on evaluation of - `ps-paper-type'. - (default-menubar): Put guard on `paren-mode'. - - Put guard on `mouse-avoidance-mode'. - - Guard `font-lock' stuffs. - - Guard browse-url stuffs. - - Clean up old deprecated syntax. - - Put guards on File, Edit, Apps, and Tools menus. - -1997-11-28 Hrvoje Niksic - - * x-toolbar.el (toolbar-news-frame-properties): Made customizable. - -1997-11-27 Christoph Wedler - - * lazy-shot.el (lazy-shot-stealth-timer): `defvar'. Would - bug out when setting `lazy-shot-stealth-time' to nil and visiting - a buffer smaller than `lazy-shot-minimum-size'. - (font-lock-mode-hook): Option is turn-on-lazy-shot. - -1997-11-27 Kyle Jones - - * etags.el: Support new `include' - directive. Search for exact tag matches and then - inexact matches. - -1997-11-26 SL Baur - - * packages.el (packages-useful-lisp): advice.el is a package. - - * x-menubar.el (default-menubar): Make `Options ... Color Printing' - a toggle. - -1997-11-26 Kyle Jones - - * toolbar.el (init-toolbar-from-resrouces): Fix - parens to make valid if-expression. - -1997-11-21 Hrvoje Niksic - - * x-toolbar.el (toolbar-gnus): Respect - `toolbar-news-use-separate-frame'. - -1997-11-22 Hrvoje Niksic - - * x-menubar.el (default-menubar): Use `bookmark-menu-filter' - for the Bookmarks menu. - (bookmark-menu-filter): Handle inactive submenus. - -1997-11-25 Hrvoje Niksic - - * custom.el (custom-declare-variable): Attach the symbol to - load history. - -1997-11-23 SL Baur - - * startup.el (find-emacs-root-internal-1): Erase references to - prim. - - * blessmail.el: dumped-lisp.el has been moved. - * font.el: ditto. - * make-docfile.el: ditto. - * package-admin.el: ditto. - * update-elc.el: ditto. - - * about.el: Moved. - * cleantree.el: ditto. - * dumped-lisp.el: ditto. - * sound.el: ditto. - * winnt.el: ditto. - -1997-11-22 Kyle Jones - - * faces.el: Don't set global background pixmap - property of the modeline face to [nothing], as that - the attributeBackgroundPixmap X resource. - -1997-11-21 SL Baur - - * autoload.el: Moved. - * config.el: ditto. - * etags.el: ditto. - * font-lock.el: ditto. - * fontl-hooks.el: ditto. - * gnuserv.el: ditto. - * info.el: ditto. - * shadow.el: ditto. - * view-less.el: ditto. - -1997-11-18 Colin Rafferty - - * packages.el (packages-find-packages): Modified to allow `nil' - entry in the `package-path'. All entries before the nil will be - prepended to the paths (as before). All entries after nil will be - appended. - - * packages.el (locate-data-file): Implemented similar to - locate-data-directory. - -1997-11-20 Kyle Jones - - * x-faces.el: Add expression to xpm-color-symbols to - look for the global background resource when supporting - the backgroundToolBarColor XPM symbolic name. - -1997-11-17 Marc Paquette - - * efs/dired.el: Removed special case for windows-nt in - dired-get-filename(); no longer needed because we now do - CRLF->LF conversion upstream. - -1997-11-18 Jonathan Harris - - * msw-faces.el: Actually does something. - -1997-11-18 Christoph Wedler - - * packages/font-lock.el (font-lock-fontify-anchored-keywords): - Sync'd with FSF 20.2. - (font-lock-keywords): Docstring partly sync'd with FSF 20.2. - -1997-11-18 SL Baur - - * egg/egg-leim.el (egg-activate): Call normal language setup - function. - - Call egg-mode - - require egg-wnn - - * egg/egg-wnn.el (set-wnn-host-name): Use localhost as a fallback. - (set-cwnn-host-name): Ditto. - (set-kwnn-host-name): Ditto. - (open-wnn-if-disconnected): Ditto. - -1997-11-18 Hrvoje Niksic - - * prim/about.el (about-maintainer-info): Corrected typo. - - * x-toolbar.el (toolbar-mail): Use `eval' to evaluate forms. - - * cus-edit.el (customize-browse): Call `widget-add-change'. - -1997-11-18 SL Baur - - * utils/uniquify.el (uniquify-buffer-name-style): Fix typo. - Suggested by: Michael Sperber - -1997-11-18 Hrvoje Niksic - - * prim/about.el (about-news): Announce a way to leave the buffer. - -1997-11-17 Kyle Jones - - * x-toolbar.el (x-init-toolbar-from-resources): - Initialize the toolbar border width specifiers. - -1997-11-17 SL Baur - - * mule/mule-files.el: Add TUTORIAL.pl to - `file-coding-system-alist'. - * language/european.el: Add Polish language environment. - - * loadup.el: set inhibit-package-init when running from temacs. - -1997-11-16 SL Baur - - * prim/options.el: Fix comment typo. - From Peter Pezaris - -1997-11-16 Kyle Jones - - * prim/minibuf.el (reset-buffer): Make inhibit-read-only - local to the current buffer and set it to t to prevent - read-only text from permanently wedging the minibuffer. - -1997-11-16 SL Baur - - * packages/emacsbug.el (report-xemacs-bug): Handle case where - ` *Message-Log*' buffer has not already been created. - * prim/help.el (view-lossage): Ditto. - * prim/simple.el (show-message-log): Ditto. - -1997-11-15 SL Baur - - * packages.el (list-autoloads): Fix doubleslash problem. - -1997-11-14 Hrvoje Niksic - - * custom/wid-edit.el (widget-before-change): Check for inactive - editable fields. - -1997-11-13 SL Baur - - * prim/about.el (about-xemacs): Update maintainers. - -1997-11-12 Hrvoje Niksic - - * custom/cus-edit.el (custom-face-save): Save the face. - -1997-11-13 Kyle Jones - - * packages/font-lock.el (font-lock-fontify-keywords-region): - If not fontifying a MATCH-ANCHORED style keyword, - backtrack to just after the end of the keyword before - doing the next search. - -1997-11-13 Olivier Galibert - - * language/vietnamese.el: Synched ccl with FSF 20.2. - - * language/cyrillic.el: Synched ccl with FSF 20.2. - - * language/chinese.el: Synched ccl with FSF 20.2. - - * mule/mule-ccl.el: Synched with FSF 20.2. - -1997-11-12 SL Baur - - * leim/quail.el (quail-translation-keymap): Guard against - meta-prefix-char being -1 (documented as disabling it :-(). - (quail-simple-translation-keymap): Ditto. - (quail-conversion-keymap): Ditto. - -1997-11-11 Hrvoje Niksic - - * custom/cus-face.el (custom-face-attributes): Use - `set-face-stipple' instead of `set-face-background-pixmap'. - - * prim/faces.el (set-face-stipple): Search through - x-bitmap-file-path. - -1997-11-09 Hrvoje Niksic - - * speedbar/speedbar.el (speedbar-needed-height): New function. - (speedbar-frame-mode): Use it. - -1997-11-07 Karl M. Hegbloom - - * speedbar/speedbar.el: Various docfixes. - -1997-11-12 SL Baur - - * pcl-cvs/pcl-cvs-xemacs.el: Fix emerge menu item. - From Jens Krinke - - * mule/mule-cmds.el (set-language-info): Don't add mule menu if - menubars haven't been compiled in. - -1997-11-10 Jens-Ulrik Holger Petersen - - * custom/cus-edit.el (custom-file): Use `user-init-directory' - instead of `emacs-user-extension-dir'. - -1997-11-12 SL Baur - - * modes/image-mode.el: Add command to enter xpm mode when viewing XPM - image. - From: Jens Krinke - -1997-11-12 Greg Klanderman - - * packages/compile.el (compilation-build-compilation-error-regexp-alist): - Added documentation for this function. - - ** (compilation-error-regexp-systems-list): Update documentation - to note that `compilation-build-compilation-error-regexp-alist' - must be called after changing the value. Update customization to - add a set method which automatically calls - `compilation-build-compilation-error-regexp-alist' when the value - is set by custom. Move declaration below declarations that it now - depends upon. - - ** (compilation-mouse-motion-initiate-parsing): Default to nil. - -1997-11-12 Hrvoje Niksic - - * help.el (help-for-help): Use `make-help-screen'. - * help-macro.el: New file. - -1997-11-10 SL Baur - - * x-menubar.el (options-menu-saved-forms): - `current-language-environment' is a variable now. - - * packages/add-log.el (TopLevel): Require 'fortran only if it is - available. - - * modes/lazy-shot.el (lazy-shot-unstall): Add guard on removing - the timer because the timer may not have been installed first. - -1997-11-10 Hrvoje Niksic - - * prim/frame.el (default-deselect-frame-hook): Dehighlight the - currently highlighted extent. - -1997-11-09 Hrvoje Niksic - - * prim/help.el (describe-variable): Add proper spacing. - -1997-11-10 SL Baur - - * utils/browse-url.el (TopLevel): Guard against term not being in - the load path. - (browse-url-lynx-emacs): Attach guards against term not being in - the load path. - -1997-11-09 SL Baur - - * packages/autoinsert.el: Fix bottom of lisp file template. - -1997-11-09 Kyle Jones - - * gui.el: For gui-button-face, set - foreground/background colors only on X devices. - Previously they were set for all devices. - -1997-11-09 Hrvoje Niksic - - * prim/extents.el (extent-keymap): New function. - -1997-11-09 Kyle Jones - - * specifier.el: Define specifier tags for the - device types that do not have compiled in support. - This allows device type specific properties to be set - in specifiers even if the device type isn't supported - in the current binary. - -1997-11-07 Hrvoje Niksic - - * custom/wid-edit.el (widget-glyph-pointer-glyph): New variable. - (widget-glyph-insert-glyph): Use it. - -1997-11-09 SL Baur - - * files.el (find-file-noselect): Guard against dired not being - available. - -1997-11-09 Kyle Jones - - * gui.el: Set the reverse-p property on - gui-button-face so that it will likely look different - than the default face on ttys. - -1997-11-09 SL Baur - - * x-menubar.el (default-menubar): Strokes has been packaged. - -1997-11-08 SL Baur - - * prim/about.el (about-hackers): New entries. - - * utils/shadow.el (list-load-path-shadows): Supress message when - no shadowings are found. - - * loadup.el: Modify algorithm for finding initial lisp directories - since the search now starts from lisp/ not lisp/prim/. - * update-elc.el: Ditto. - * make-docfile.el: Ditto. - -1997-11-07 SL Baur - - * prim/dumped-lisp.el: "lib-complete" is not dumped with InfoDock. - * utils/finder.el (finder-known-keywords): New keyword -- `dumped'. - - * version.el: Cleaned up Lisp comments. - * paths.el: Ditto. - * x-menubar.el: Ditto. - * x-faces.el: Ditto. - * x-iso8859-1.el: Ditto. - * x-mouse.el: Ditto. - * x-select.el: Ditto. - * x-scrollbar.el: Ditto. - * x-misc.el: Ditto. - * x-init.el: Ditto. - * x-toolbar.el: Ditto. - - * backquote.el: Moved to top-level. Cleaned up Lisp comments. - * packages.el: Ditto. - * subr.el: Ditto. - * replace.el: Ditto. - * cl.el: Ditto. - * cl-extra.el: Ditto. - * cl-seq.el: Ditto. - * widget.el: Ditto. - * custom.el: Ditto. - * cus-start.el: Ditto. - * cmdloop.el: Ditto. - * keymap.el: Ditto. - * syntax.el: Ditto. - * device.el: Ditto. - * console.el: Ditto. - * obsolete.el: Ditto. - * specifier.el: Ditto. - * faces.el: Ditto. - * glyphs.el: Ditto. - * objects.el: Ditto. - * extents.el: Ditto. - * events.el: Ditto. - * text-props.el: Ditto. - * process.el: Ditto. - * frame.el: Ditto. - * map-ynp.el: Ditto. - * simple.el: Ditto. - * keydefs.el: Ditto. - * abbrev.el: Ditto. - * derived.el: Ditto. - * minibuf.el: Ditto. - * list-mode.el: Ditto. - * modeline.el: Ditto. - * startup.el: Ditto. - * misc.el: Ditto. - * help-nomule.el: Ditto. - * help.el: Ditto. - * files-nomule.el: Ditto. - * files.el: Ditto. - * lib-complete.el: Ditto. - * format.el: Ditto. - * indent.el: Ditto. - * isearch-mode.el: Ditto. - * buffer.el: Ditto. - * buff-menu.el: Ditto. - * undo-stack.el: Ditto. - * window.el: Ditto. - * window-xemacs.el: Ditto. - * lisp.el: Ditto. - * page.el: Ditto. - * register.el: Ditto. - * iso8859-1.el: Ditto. - * paragraphs.el: Ditto. - * easymenu.el: Ditto. - * lisp-mode.el: Ditto. - * text-mode.el: Ditto. - * fill.el: Ditto. - * auto-save.el: Ditto. - * float-sup.el: Ditto. - * itimer.el: Ditto. - * itimer-autosave.el: Ditto. - * toolbar.el: Ditto. - * scrollbar.el: Ditto. - * menubar.el: Ditto. - * dialog.el: Ditto. - * gui.el: Ditto. - * mode-motion.el: Ditto. - * mouse.el: Ditto. - * tty-init.el: Ditto. - * auto-show.el: Ditto. - -1997-11-07 Kyle Jones - - * modes/abbrev.el (abbrev-prefix-mark): Instead of - inserting a dash to indicate the start of the abbrev, - add an extent with a begin-glyph that contains a dash. - -Wed Nov 05 23:40:00 1997 Jonathan Harris - - * faces.el: init-other-random-faces - Reinstated code that uses (mono x) as a specifer tag, but - conditioned it on (featurep 'x) because x is not a valid - specifier tag under native-win32. - - * Added file headers to: - w32-faces.el, w32-init.el - -1997-11-06 Hrvoje Niksic - - * facemenu.el (facemenu-insert-menu-entry): Check for - menubar availability. - - * easymenu.el (easy-menu-change): Check for menubar - availability. - - * wid-edit.el (widget-echo-help): Use `help-echo' as label - for help-echo messages. - -Sun Nov 01 12:00:00 1997 Jonathan Harris - - * make-docfile.el: Fixed typo when dumped file does not exist. - - * device.el: make-w32-device added. - - * dumped-lisp: added w32-faces and w32-init to list. - - * faces.el: - - make-face-*: Added calls to appropriate w32 functions - conditioned on (featurep 'w32). Made existing X calls - conditioned on (featurep 'x). - - init-other-random-faces: Hacked out a piece of code which used - (mono x) as a specifier because it made w32 unhappy. - - * New files: - w32-faces.el, w32-init.el - -1997-11-07 Hrvoje Niksic - - * prim/mouse.el (default-mouse-motion-handler): When over - modeline, correctly dehighlight the last extent. - -1997-11-07 Hrvoje Niksic - - * prim/minibuf.el (mouse-read-file-name-1): Ditto. - - * packages/balloon-help.el (balloon-help-make-help-frame): Ditto. - - * games/life.el (life-setup): Check for scrollbars before using - them. - -1997-11-07 Hrvoje Niksic - - * hm--html-menus/hm--html-mode.el (hm--html-minor-mode): Ditto. - - * hm--html-menus/hm--html-menu.el ((adapt-xemacsp)): Ditto. - - * comint/gud.el (gdb-install-menubar): Ditto. - - * calendar/calendar.el (calendar-mode): Ditto. - - * auctex/bib-cite.el (bib-cite-initialize): Ditto. - - * utils/floating-toolbar.el (floating-toolbar): Ditto. - - * utils/edit-toolbar.el (edit-toolbar-mode): Ditto. - - * utils/browse-cltl2.el (cltl2-lisp-mode-install): Ditto. - - * modes/view-process-xemacs.el - (View-process-install-pulldown-menu): Ditto. - - * modes/verilog-mode.el (verilog-mode): Ditto. - - * modes/tcl.el (tcl-mode): Ditto. - - * modes/f90.el (f90-mode): Ditto. - - * packages/emerge.el (emerge-set-keys): Ditto. - - * packages/tar-mode.el (tar-mode): Check for menubars. - -1997-11-07 Kyle Jones - - * prim/modeline.el (mouse-drag-modeline): Don't - allow the window size to shrink to a size that is not a - multiple of the height of the default face's font. - - * prim/modeline.el (mouse-drag-modeline): Don't - discard timeout events. - -1997-11-07 SL Baur - - * prim/simple.el (universal-argument-minus): Retain zmacs region. - -1997-11-07 Hrvoje Niksic - - * packages/hyper-apropos.el (hyper-apropos-grok-functions): Ignore - errors when fetching documentation. - - * prim/about.el (about-maintainer-glyph): Handle not having XPM or - XBM gracefully. - - * custom/wid-edit.el (widget-glyph-find): Allow glyphs without - window-system, when TAG is nil. - -1997-11-05 Jens-Ulrik Holger Petersen - - * mule/mule-cmds.el (set-default-coding-systems): Make - add-hook to `comint-exec-hook' be an append, for when the user - changes language environment say. - -1997-11-05 SL Baur - - * prim/winnt.el: Use a cleaner method for getting Text/Binary file - type in the mode-line for MS Windows. - -1997-11-06 Hrvoje Niksic - - * prim/mouse.el: Removed "junk me" functions. - - * prim/mouse.el (default-mouse-motion-handler): Make events over - modeline invalidate `point'. - - * prim/mouse.el (mouse-line-length): Use point-at-eol and - point-at-bol. - (default-mouse-track-normalize-point): Highlight the whole symbol - only if the mouse is on a symbol-constituent. - - * custom/wid-edit.el (widget-specify-field): Make sure the extent - is end-open. - - * prim/keymap.el (next-key-event): Use `next-command-event'. - -1997-11-05 Hrvoje Niksic - - * utils/easymenu.el (easy-menu-add): Check with `equal' whether - the menu already belongs to all-popups. - -1997-11-05 Jan Vroonhof - - * packages/font-lock.el (font-lock-thing-lock-cleanup): - Provisionally add lazy-shot - - * modes/lazy-shot.el (lazy-shot-mode): Unstall lazy-shot only if - needed. - (lazy-shot-fontify-internal): Functionality put in seperate function. - (lazy-shot-lock-extent): Use it. - (lazy-shot-fontify-region): Dumb implementation added. - (lazy-shot-unstall-after-fontify): Needed to disable lazy - fontifying after fontify-buffer. - (lazy-shot-unstall): Make sure buffer is left in a fontified state if - needed. Take optional argument. - - - * packages/ps-print.el (ps-print-ensure-fontified): Added - temporary support for lazy-shot. - -1997-11-05 Hrvoje Niksic - - * utils/text-props.el (set-text-properties): Updated docstring. - -1997-11-04 Didier Verna - - * mule/mule-cmds.el (set-default-coding-systems): - The coding-system argument to comint-exec-hook wasn't evaluated - before building the lambda expression. - -1997-11-04 Jens-Ulrik Holger Petersen - - * packages/time.el: Change all occurences of ballon to balloon. - -1997-11-04 Jens-Ulrik Holger Petersen - - * prim/help.el (function-at-point-function): Remove this variable. - (function-at-point): Remove use of `function-at-point-function'. - - * packages/info.el (Info-elisp-ref): Change call to - `find-function-function' to `function-at-point'. - -1997-11-04 Jens-Ulrik Holger Petersen - - * packages/info.el (Info-elisp-ref): Really change call to - `find-function-function' to `function-at-point'. - -1997-11-04 Hrvoje Niksic - - * packages/auto-save.el: Updated commentary; changed default - autosave fallback to "~/.autosave". Minor changes to compile - without warnings. - -1997-11-03 Hrvoje Niksic - - * prim/subr.el (function-interactive): New function. - -1997-11-03 SL Baur - - * prim/dumped-lisp.el: Dump auto-save with XEmacs. - - * prim/loadup.el: Make sure top level lisp directory gets a - trailing slash when added to load-path. - * prim/make-docfile.el: Ditto. - -1997-11-03 MORIOKA Tomohiko - - * prim/simple.el (interprogram-cut-function, - interprogram-paste-function): New variable (imported from Emacs - 20.2). - (kill-new): Use `interprogram-cut-function' if it is not nil. - (current-kill): Use `interprogram-paste-function' if it is not - nil. - -1997-11-03 MORIOKA Tomohiko - - * locale/ja/locale-start.el (startup-splash-frame-body): Modify to - be more natural Japanese. - - * x11/x-menubar.el: Delete "language environment" menu of - "Options" menu. - -1997-11-02 MORIOKA Tomohiko - - * language/korean.el: Rename TUTORIAL.kr -> TUTORIAL.ko to fit - with ISO 639 (two letter language code). - - * prim/dumped-lisp.el: Don't dump language/vietnamese.el because - language/viet-util.el was removed temporary. - - * language/japanese.el: Rename TUTORIAL.jp -> TUTORIAL.ja to fit - with ISO 639 (two letter language code). - -1997-10-31 Pete Ware - - * shell.el (shell-chdrive-regexp): New for DOS/NT - (shell-mode): Added shell-font-lock-keywrods - (shell-mode): Use $PWD for ksh - (shell-directory-tracker): Use dirs and dirtrack-toggle. This may - cause problems at is interferes with "dired" - (shell-snarf-envar): NEW - (shell-copy-environment-variable): NEW - -1997-10-30 Pete Ware - - * comint.el (comint-mode-map): Rearranged menus so they have a - meaningful name. - -1997-10-30 Pete Ware - - * comint.el (comint-find-source-file-hook): - (comint-goto-source-line-hook): - (comint-find-source-code): - (comint-default-find-source-file): - (comint-fixup-source-file-name): - (comint-default-goto-source-line): Removed. compile.el does a - better job of this stuff. - - * comint.el - (comint-file-name-chars): Support for msdos/nt - - Let easymenu deal with whether menubar is available. - - Use ^d for delchar or maybe eof. - - Use "dumb" as the terminal type if on a system using terminfo - (comint-output-filter): Removed replacement of ^M -- use filter - (comint-dynamic-complete-as-filename): Don't set - file-name-handler-alist to nil. This makes remote path - completion work! - -1997-11-02 SL Baur - - * prim/advocacy.el (xemacs-praise-sound-file): Don't default to - using a hardcoded directory. - - * eterm/term.el (term-is-xemacs): Match against XEmacs instead of - Lucid. - - * eos/sun-eos-toolbar.el (eos::toolbar-icon-directory): Use - `locate-data-directory' instead of data-directory. - * eterm/term.el (term-exec-1): Ditto. - * packages/time.el (display-time-icons-dir): Ditto. - * prim/advocacy.el (praise-be-unto-xemacs): Ditto. - * prim/sound.el (default-sound-directory): Ditto. - * prim/toolbar.el (init-toolbar-location): Ditto. - -1997-10-31 Hrvoje Niksic - - * custom/wid-edit.el (widget-color-complete): Use - `read-color-completion-table' directly. - - * prim/subr.el (rplaca): Warn against the return value. - (replace-in-string): Use `wrong-type-argument'. Use standard - error message. - (functionp): Would bug out on certain types of objects; synch with - FSF. - (with-output-to-string): Use new-style backquotes. - (with-temp-buffer): Update docstring references. - - * prim/minibuf.el (reset-buffer): Use `with-current-buffer'. - (read-color-completion-table): Ditto. - (read-color-completion-table): Complete TTY colors on TTY devices. - - * custom/cus-start.el: Customize `scroll-conservatively'. - Customize `help-char' correctly. - -1997-11-02 SL Baur - - * packages/desktop.el (toplevel): Don't require dired or reporter - when byte compiling. - -1997-11-02 Hrvoje Niksic - - * prim/keymap.el (synthesize-keysym): Collect a list of - characters, instead of consing a string each time. - (synthesize-keysym): Better error checking. - - * prim/keymap.el (synthesize-keysym): Don't bug out when reading a - non-character event. - -1997-11-02 Tomasz Cholewo - - * prim/keymap.el (synthesize-keysym): New function bound to C-x @ k. - -1997-11-02 Kyle Jones - - * modes/sendmail.el: Don't (require 'vm-misc). Change - mail-do-fcc-vm-internal to not compile the chunk of code - that uses VM internal macros. This prevents the byte - compiler from compiling such references into function - calls that Fbyte_code will complain about later when it - discovers that the references are macros. - - * modes/sendmail.el: added defvars for - rmail-summary-buffer and rmail-total-messages to get - rid of compiler warnings. -1997-11-01 Hrvoje Niksic - - * prim/subr.el (lambda): Moved from `packages.el'. - - * prim/packages.el: Updated commentary. - (packages-useful-lisp): Added `cl-macs'. - -1997-10-27 Didier Verna - - * prim/help-nomule.el (help-with-tutorial): The 'didactic' blank - lines message is now taken directly from each tutorial, and thus - can appear in different languages. - - * mule/mule-help.el (help-with-tutorial): idem - -1997-10-26 Karl M. Hegbloom - - * utils/shadowfile.el (shadow-clusters): Customized. - (shadow-read-files): replace obsolete `eval-current-buffer' - (shadow-parse-fullpath): `efs-ftp-name' doesn't exist. change to - `efs-ftp-path' - -1997-11-01 SL Baur - - * x11/x-menubar.el: Change Viper menu item to use - `toggle-viper-mode'. - Suggested by Michael Kifer - - * mule/mule-init.el: Remove `help-with-tutorial-for-mule'. - Suggested by Didier Verna - - * Disable Cyrillic CCL until CCL engine gets fixed. - From: Martin Buchholz - -1997-10-30 Colin Rafferty - - * prim/startup.el (command-line-early): Made it recognize - --vanilla and --no-packages, as is already done in emacs.c. - -1997-10-30 Karl M. Hegbloom - - * modes/cperl-mode.el: Add Commentary and Code statements to - comment header for finder. - -1997-10-30 SL Baur - - * vm/vm-vars.el (vm-image-directory): Use locate-data-directory if - it exists. - - * language/european.el: Remove erroneous references to - `Serbo-Croatian'. - * language/cyril-util.el: Ditto. - * leim/quail/cyrillic.el: Ditto. - - * comint.el: reverse previous patch - -1997-10-29 MORIOKA Tomohiko - - * mule/mule-init.el (init-mule): Load locale-start even if lang is - not exactly matched. - - * mule/mule-init.el (auto-language-alist): Modify for new language - environment feature. - (init-mule): Modify for new language environment feature. - -1997-10-29 MORIOKA Tomohiko - - * language/korean.el (setup-korean-environment): Modify for - XEmacs. - - * language/greek.el: Modify setting about language environment. - - * language/european.el: Fix setting for Croatian language - environment. - - * language/vietnamese.el: Fix setting about language environment. - - * language/viet-util.el (setup-vietnamese-environment): Modify for - XEmacs. - - * language/cyril-util.el (setup-cyrillic-iso-environment): Modify - for XEmacs. - (setup-cyrillic-koi8-environment): Modify for XEmacs. - (setup-cyrillic-alternativnyj-environment): Modify for XEmacs. - -1997-10-28 MORIOKA Tomohiko - - * language/hebrew.el (setup-hebrew-environment): Modify for - XEmacs. - - * mule/mule-cmds.el (set-default-coding-systems): New function. - (set-language-info): Fix about menu. - (read-input-method-name, toggle-input-method): Sync with Emacs - 20.2. - - * language/cyril-util.el: Modify header. - - * language/cyril-util.el - (setup-cyrillic-alternativnyj-environment): Modify for XEmacs. - - * language/cyril-util.el: New file; imported from Emacs 20.2. - - * language/japan-util.el (setup-japanese-environment): Use - `set-default-coding-systems'. - - * language/european.el (setup-8-bit-environment): Modify for - XEmacs. - - * language/english.el (setup-english-environment): Use - `set-default-coding-systems'. - - * language/chinese.el: Modify for XEmacs. - - * language/china-util.el (setup-chinese-gb-environment, - setup-chinese-big5-environment): Use `set-default-coding-systems'. - - * mule/mule-files.el (file-coding-system-alist): Fix typo. - -1997-10-28 MORIOKA Tomohiko - - * prim/dumped-lisp.el: Abolish Thai support temporary. - - * language/thai.el, language/thai-util.el: Delete Thai specific - files because composite character features don't work in XEmacs. - - * language/japan-util.el: Modify header. - - * language/chinese.el: Abolish `Chinese-CNS' environment - temporary. - - * language/china-util.el: Abolish `setup-chinese-cns-environment' - temporary. - - * language/china-util.el (setup-chinese-big5-environment): Modify - for XEmacs. - - * language/china-util.el (setup-chinese-gb-environment): Modify - for XEmacs. - - * language/chinese.el: Delete set-coding-category-system for big5. - - * language/japan-util.el (setup-japanese-environment): Modify for - XEmacs. - - * language/japanese.el: Delete set-coding-category-system for - shift-jis. - - * language/english.el (setup-english-environment): Modify for - XEmacs. - -1997-10-28 MORIOKA Tomohiko - - * language/auto-autoloads.el: New file. - - * mule/mule-files.el (file-coding-system-alist): Add setting for - TUTORIAL.hr to iso-8859-2. - - * leim/quail/tibetan.el, leim/quail/ethiopic.el, - leim/quail/japanese.el, leim/quail/lao.el, leim/quail/lrt.el, - leim/quail/devanagari.el: Delete broken features temporary. - - * language/tibetan.el, language/indian.el, language/lao-util.el, - language/lao.el, language/tibet-util.el, language/ethio-util.el, - language/ethiopic.el, language/devanagari.el: Delete broken - features temporary. - - * mule/mule-cmds.el (universal-coding-system-argument): New - function; imported from Emacs 20.2. - -1997-10-27 MORIOKA Tomohiko - - * language/korean.el, language/thai.el, language/vietnamese.el, - language/chinese.el, language/japanese.el, language/arabic.el, - language/ethiopic.el: Abolish setting for old language - environment. - - * language/hebrew.el: Modify for XEmacs. - - * Use language/hebrew.el instead of mule/hebrew-hooks.el; abolish - mule/hebrew-hooks.el. - - * mule/mule-misc.el: Abolish old language environment features. - - * mule/mule-init.el: Delete old language environment specific - features temporary. - - * prim/dumped-lisp.el: Use language/hebrew.el instead of - hebrew-hooks.el. - - * mule/mule-cmds.el (describe-language-environment): Modify for - XEmacs because `coding-system-mnemonic' returns string instead of - character in XEmacs. - - * mule/mule-cmds.el: Sync with Emacs 20.2 about language - environment. - - * mule/mule-cmds.el: Don't use `mule-prefix'. - -1997-10-26 MORIOKA Tomohiko - - * language/ethiopic.el (ccl-encode-ethio-font): Modify to sync - with Emacs 20.2. - -1997-10-26 MORIOKA Tomohiko - - * mule-diag.el (list-coding-systems): Modify for XEmacs. - -1997-10-26 MORIOKA Tomohiko - - * mule/mule-files.el (find-coding-system-magic-cookie): Regard top - line magic. - (load): Use `find-file-coding-system-for-read-from-filename'. - - * language/arabic-util.el: Use iso-2022-7bit. - -1997-10-26 MORIOKA Tomohiko - - * mule-diag.el (describe-designation): Moved from mule-debug.el. - (describe-coding-system): Use `describe-designation'. - - * mule-debug.el: Move function `describe-designation' to - mule-diag.el; Abolish function `describe-coding-system' because of - using it in mule-diag.el. - - * mule-coding.el (keyboard-coding-system): New inline function. - (terminal-coding-system): New inline function. - - * mule-cmds.el: Bind `describe-coding-system' to C-h C instead of - `describe-current-coding-system' to sync with Emacs 20.2. - - * mule-diag.el: Abolish `print-designation' because it does not - work in XEmacs. - - (describe-coding-system): Modify for XEmacs. - (print-coding-system-briefly): Modify for XEmacs. - (describe-current-coding-system): Modify for XEmacs. - - * mule-coding.el: Abolish function `coding-system-charset' - (defined as builtin function). - - * mule-diag.el: New file; imported from Emacs 20.2. - - * mule-misc.el (set-buffer-process-coding-system): New function; - imported from mule.el of Emacs 20.2. - - * mule-cmds.el: Bind `set-buffer-process-coding-system' to C-x C-m - p and abolish C-x C-m P. - - * mule-files.el (load): Use `binary' instead of `no-conversion'. - -1997-10-28 Kyle Jones - - * modes/enriched.el (enriched-face-ans): Use - color-name instead of color-instance-name. - color-instance-name will not handle the specifiers that - are passed as arguments. - -1997-10-28 Tomasz Cholewo - - * prim/find-func.el (find-function-noselect): Fix nil argument - handling and add support for dumped macros. - -1997-10-28 SL Baur - - * pcl-cvs/pcl-cvs-xemacs.el: Add `cvs-mode-update-no-prompt' to menu. - From Stig Bjorlykke - -1997-10-28 Didier Verna - - * packages/man.el (manual-entry): corrected the `when' - form to include 'section' in the buffer name. - -1997-10-28 SL Baur - - * prim/packages (packages-find-pacakges): Fix test on - inhibit-package-init - -1997-10-27 Tomasz Cholewo - - * prim/keymap.el (event-apply-modifier): Fix the return type and - scan the function-key-map. - (next-key-event): New function. - (key-sequence-list-description): Ditto. - -1997-10-27 SL Baur - - * x11/x-menubar.el: Turn off `popup-menubar-menu' keybinding. - - * prim/dumped-lisp.el (preloaded-file-list): Dump canna-leim and - egg-leim with XEmacs. - - * mule/canna-leim.el: Clean up file for dumping with XEmacs. - * egg/egg-leim.el: Ditto. - -1997-10-27 Stephen J. Turnbull - - * mule/canna-leim.el: Register Canna with LEIM when loaded - - * mule/canna.el (canna): Bind `canna-toggle-japanese-mode' to - "\C-o" only if LEIM is not present - - * egg/egg-leim.el: Registers EGG/Wnn with LEIM when loaded - - * egg/egg.el: Bind `toggle-egg-mode' to "\C-\" only if LEIM is - not present when loaded - -1997-10-27 SL Baur - - * prim/about.el: Update entries - -1997-10-26 SL Baur - - * prim/startup.el (startup-message-timeout): Startup message - timeout is too short. - - * mule/canna.el (canna): Move canna-toggle-japanese-mode - keybinding to C-\. - - * emulators/edt-mapper.el (edt-lucid-emacs19-p): Test for XEmacs - instead of Lucid in `emacs-version'. - -1997-10-25 SL Baur - - * mule/mule-cmds.el: describe-language-support, - describe-language-support-internal removed. - -Fri Aug 8 12:58:00 1997 David Byers - - * fill.el (fill-region-as-paragraph): When justifying, check for - end-of-buffer at the end of whitespace point is sitting in, and - delete the trailing whitespace if we are on the last line. - -1997-10-24 Hrvoje Niksic - - * prim/about.el (about-finish-buffer): Kill the buffer, when - button documents so. - -1997-10-24 Jens-Ulrik Holger Petersen - - * pcl-cvs.el (cvs-parse-stderr): Ignore ssh-askpass message. - -1997-10-20 Hrvoje Niksic - - * prim/packages.el (locate-library): Make NOSUFFIX not affect - compression. - -1997-10-24 SL Baur - - * modes/c-comment.el: Create c-comment-edit-map. - (c-comment-edit): Fix docstring, use new keymap. - Suggested by Chris Felaco - - * prim/help-nomule.el (tutorial-supported-languages): Add - Norwegian. - - * prim/simple.el (assoc-ignore-case): Synch with Emacs 20.1. - - * mule/mule-cmds.el (set-language-info): Forgot to set any data - values in language-alist. - (read-multilingual-string): Fix call to `read-string'. - -1997-10-22 Karl M. Hegbloom - - * packages/backup-dir.el (bkup-backup-directory-info): customized, - with :require so it loads automagicly if you've set it. Docstring - updated to reflect that, and reformatted for easier reading. - - * packages/jka-compr.el (jka-compr-compression-info-list): - Docstring clarification: what does the append flag do? - - * prim/minibuf.el (minibuffer-electric-slash): leave efs prefix - and ~\(blah\)? when / is pressed. - -1997-10-24 Jens-Ulrik Holger Petersen - - * efs/dired.el (dired-create-files): Get mark-char thing working - again: replace `integerp' by `characterp'. - (dired-add-entry): Ditto. - (dired-add-entry-do-indentation): Ditto. - -1997-10-24 Hrvoje Niksic - - * x11/x-faces.el (*try-oblique-before-italic-fonts*): Customized. - -1997-10-23 SL Baur - - * prim/startup.el (command-line-do-help): Add Documentation for - -vanilla and -no-packages. - (command-line-early): Implement them. - - * prim/packages.el (inhibit-package-init): New variable. - (packages-find-packages): Use it. - - - * packages/jka-compr.el (jka-compr-compression-info-list): - Add bzip2 extensions. - From Tomasz Cholewo - -1997-10-22 Karl M. Hegbloom - - * comint/comint.el (comint-scroll-show-maximum-output): fixups to - docstring, and to :type to allow numbers. - (comint-postoutput-scroll-to-bottom): Added window arg to - `recenter' call to fix the horrid flash and global recentering, - and uncommented the code allowing numeric values for - `comint-scroll-show-maximum-output'. - -1997-10-23 Hrvoje Niksic - - * packages/info.el (Info-mode): Don't initialize faces. - - * packages/info.el: Use `defface' to initialize faces. - -1997-10-23 Karl M. Hegbloom - - * modes/cperl-mode.el (cperl-here-face): fix the horrible invisible - green default face. - -1997-10-23 Hrvoje Niksic - - * custom/wid-edit.el (widget-choose): Acknowledge aborted choice - with a `Canceled' message, even if C-g wasn't pressed explicitly. - -1997-10-23 Per Abrahamsen - - * custom/cus-edit.el (hook): Use `widget-group-match' instead of - `widget-editable-list-match'. - -1997-10-23 SL Baur - - * modes/c-comment.el (c-comment-edit): Fixed autoload cookie. - Reformatted Lisp comments. - -1997-10-22 SL Baur - - * psgml/psgml-charent.el (sgml-display-char-list-filename): Use - locate-data-directory instead of data-directory. - * psgml.el (sgml-data-directory): Ditto. - -1997-10-20 Jan Vroonhof - - * extents.c: Renamed shot property to initial-redisplay-function - (extent_fragment_update): Changed the bookkeeping whether an event - has been spawned. The initial-redisplay-function property is no - longer set to nil. - -1997-10-21 SL Baur - - * custom/cus-dep.el (Custom-make-dependencies): Ditch the time - stamp. - -1997-10-22 Jens-Ulrik Holger Petersen - - * comint/gdb.el (gdb-with-core): Fixed autoload cookie. - -1997-10-22 Hrvoje Niksic - - * prim/startup.el (command-line-1): Run term-setup-hook regardless - of `input-pending-p'. - - * custom/cus-edit.el (custom-split-regexp-maybe): Use `split-string'. - - * custom/cus-start.el (custom-start-quote): Synch with - `custom-quote'. - - * prim/subr.el (functionp): Synched docstring with Emacs 20.2. - - * custom/cus-edit.el (custom-quote): Use `keywordp'; use - `car-safe'; don't conditionalize on having `characterp'. - -1997-10-21 Hrvoje Niksic - - * custom/wid-edit.el (radio-button): Use "radio0" as inactive - glyph. - (widget-visibility-value-create): Use new semantics of - `widget-glyph-insert'. - - * custom/cus-edit.el (custom-buffer-create-internal): Setup - tag-down-glyphs with list. - (custom-group-value-create): Ditto. - - * custom/wid-edit.el (widget-glyph-click): Check whether the - extent was detached/killed. - (widget-push-button-value-create): Removed crufty XPM contrast - hack. - (widget-default-create): Make the markers point nowhere after - using them. - (widget-default-create): Use `point-min-marker'/`point-max-marker'. - (widget-glyph-find): Disallow list. - (widget-glyph-insert): Allow IMAGE to be a list. - -1997-10-20 Hrvoje Niksic - - * prim/featurep.el (featurep): Handle `not' correctly. - -1997-10-21 SL Baur - - * prim/about.el (about-maintainer-glyph): Pictures have been moved - to photos subdirectory. - -1997-10-21 Hrvoje Niksic - - * x11/x-menubar.el (options-menu-saved-forms): Check whether - `pending-delete' is bound before accessing it. - -1997-10-21 SL Baur - - * x11/x-menubar.el (default-menubar): Conditionalize games menu. - -1997-10-21 Colin Rafferty - - * x11/x-menubar.el (default-menubar): Made it use lazy-shot - instead of lazy-lock in "Syntax Highlighting->Lazy". - (options-menu-saved-forms): Made it save lazy-shot instead of - lazy-lock in the options. - -1997-10-21 SL Baur - - * mule/mule-help.el (help-with-tutorial): New file. - - * prim/dumped-lisp.el (preloaded-file-list): New entries for - help-nomule and mule-help. - - * prim/help.el: Remove `help-with-tutorial'. - - * prim/help-nomule.el: New file. - -1997-10-19 Hrvoje Niksic - - * prim/subr.el: Moved int-char and char-int definitions from - obsolete.el. - -1997-10-18 Hrvoje Niksic - - * custom/wid-edit.el (widget-push-button-value-create): Require - `xpm-button'. - (widget-push-button-value-create): Use :tag-down-glyph and - :tag-inactive-glyph. - (widget-default-create): Use :tag-inactive-glyph. - (widget-button-click): Correctly merge faces. - - * custom/cus-edit.el (custom-variable-action): Don't redraw - magic. - - * custom/wid-edit.el (widget-glyph-insert): Return glyph. - (widget-default-create): Insert :button-prefix and :button-suffix - only if a glyph is not used. - (widget-glyph-click): Respect :mouse-down-action. - (widget-specify-insert): Document for edebug. - (widget-default-create): Use markers to keep track of stuff. - - * custom/cus-edit.el (custom-group-value-create): Ditto. - - * custom/wid-edit.el (widget-default-create): Use :tag-down-glyph. - - * custom/cus-edit.el (custom-group-value-create): Use image. - - * prim/glyphs.el (init-glyphs): Minor fixups. - -1997-10-17 Hrvoje Niksic - - * custom/wid-edit.el (widget-field-value-get): Use `cond'. - (default): Use :button-keymap. - (widget-specify-button): Ditto. - (widget-glyph-insert-glyph): Ditto. - (widget-activation-glyph-mapper): Renamed from - `widget-activation-glyphs-mapper'. - - * custom/cus-edit.el (Custom-mode-menu): Go to `Easy - Customization' node. - (boolean): Don't use nested backquotes. - - * custom/wid-edit.el (widget-field-action): Check whether the new - value is valid before using it. - -1997-10-16 Hrvoje Niksic - - * custom/wid-edit.el (character): Use [\0-\377] instead of . in - :valid-regexp. - (widget-color-notify): Use `valid-color-name-p'. - (widget-activation-widget-mapper): New function. - (widget-specify-inactive): Use it. - (widget-specify-active): Ditto. - (widget-setup): Ditto. - (radio-button): Added :inactive-glyph spec. - (widget-toggle-value-create): Use it. - (widget-color-sample-face-get): Check for color before setting it. - (widget-color-sample-face-get): Store the face object, not its - name. - -1997-10-18 Jens-Ulrik Holger Petersen - - * help.el (function-at-point): Use `function-at-point-function'. - (function-at-point-function): New variable, formerly - `find-function-function'. - (describe-function): Use `function-at-point'. - (where-is): Ditto. - - * find-func.el (find-function-read-function): Use - `function-at-point'. - - * packages/info.el (Info-elisp-ref): Use `function-at-point'. - - * packages/hyper-apropos.el (hyper-apropos-read-function-symbol): - Use `function-at-point'. - - * packages/etags.el (emacs-lisp-default-tag): Use - `function-at-point'. - - * prim/obsolete.el (function-called-at-point): Make it - obsolete. - -1997-10-09 Jens-Ulrik Holger Petersen - - * prim/files.el (switch-to-buffer-other-frame): Remove call to - `select-frame'. - -1997-10-17 SL Baur - - * prim/packages.el (packages-find-packages-1): New argument: - `user-package' non-nil when searching user packages. - - Load any autoloads found in user packages. - -1997-10-17 Karl M. Hegbloom - - * packages/info.el (Info-insert-dir): Also kill the localdir temp - buffers. - -1997-10-17 SL Baur - - * utils/facemenu.el: autoload the `facemenu-keymap' properly. - - * mule/mule-cmds.el (read-language-name): Fix typo. - From Didier Verna - -1997-10-15 Adrian Aichner - - * utils/build-report.el: Leaving point at begin of composed mail now. - Using mime-edit-content-beginning to determine file-begin of - Installation file. - Introduced the according alias for SEMI/TM compatibility. - - * utils/build-report.el: - Corrected backward search for begin of last configuration in - Installation file. - - * utils/build-report.el: - Incorporated `xemacs-build-report-installation-insert-all' feature - suggested by Didier Verna. - Composing mail parts (with-temp-buffer ...) to simplify implementing - future features. - Eliminated use of mail-mode -specific function `mail-text'. - -1997-10-14 Adrian Aichner - - * utils/build-report.el: - Incorporated fix for SEMI/TM compatibility suggested by Jens-Ulrik - Holger Petersen . If SEMI symbols are - not fboundp, alias them to corresponding TM symbols. - -1997-10-13 Adrian Aichner - - * utils/build-report.el: - Changed to (mime-edit-insert-tag "text" "plain" ...) from - "application" "octet-stream" due to complaint from - Kazuyoshi Furutaka in - Message-Id: <19971013102132V.furutaka@Flux.tokai.jaeri.go.jp> - -1997-10-13 Hrvoje Niksic - - * utils/facemenu.el: Autoload `facemenu-keymap' function definition. - (facemenu-color-defined-p): Nuked. - (facemenu-find-face): Ditto. - (facemenu-region-active-p): Ditto. - (facemenu-sized-face): Declare `prefix'. - (facemenu-read-color): Aliased to `read-color'. - (facemenu-face-attributes): Use `mapvector'. - - * utils/facemenu.el: Customized and synched with FSF 20.2. - -1997-10-17 Hrvoje Niksic - - * cl/cl-macs.el (extent-properties): Remove old setf method. - -1997-10-16 Karl M. Hegbloom - - * prim/files.el (revert-without-query): changed from boolean to - list of regexp as documented in NEWS and its docstring. - -1997-10-16 SL Baur - - * utils/floating-toolbar.el: (TopLevel): Don't unconditionally - require the feature `toolbar' it causes breakage only at - bytecompile time. Don't do any initialization if toolbar support - is not available. - (floating-toolbar): Whine if no run-time toolbar support is - available. - - * custom/wid-edit.el (widget-change-glyphs-mapper): cosmetic changes. - From Hrvoje Niksic - - * prim/glyphs.el (init-glyphs): Use different logo for beta XEmacsen. - From Didier Verna - -1997-10-15 Hrvoje Niksic - - * cl/cl-macs.el (extent-property): Updated SETF methods for `get' - and `extent-property'. - - * custom/wid-edit.el (widget-field-value-create): Revert to using - two markers. - (widget-setup): Ditto. - (widget-color-sample-face-get): Get only a unique face per widget. - (widget-color-notify): Change the color of the face instead of - creating a new one. - - * packages/add-log.el (add-change-log-entry): Push window - configuration. - (change-log-exit): New function. - (change-log-cancel): Ditto. - (change-log-mode-map): Bind them. - - * custom/wid-edit.el (widget-specify-inactive): Make glyphs look - inactive. - (widget-change-glyphs-mapper): New function. - (widget-glyph-click): Disallow operations on inactive glyphs. - -1997-10-14 Hrvoje Niksic - - * custom/wid-edit.el: (widget-glyph-insert-glyph): Use - `widget-mouse-help' if necessary. - (widget-documentation-string-value-create): Don't coerce help-echo - WIDGET to widget. - (widget-button-keymap): New keymap. - (widget-specify-button): Use it. - (widget-glyph-insert-glyph): Ditto. - (widget-glyph-click): Dispatch events during the loop. - (widget-glyph-click): Use `unwind-protect' to ensure that the - glyph stays in up position. - (widget-keymap): Don't bind buttons and RET. - (widget-button-keymap): Bind mouse buttons and RET. - (widget-field-activate): Use `widget-field-find'. - - * custom/wid-edit.el (widget-button-click): Visually "release" the - button *before* doing the buttonup action. - (widget-button-click): Reworked. - (widget-echo-help): Accept extent. - - * custom/cus-edit.el (custom-face-value-create): Use `make-face'. - - * custom/wid-edit.el (widget-restore-tabable): New function. - (widget-deactivate-widget-extent): New function. - (widget-reactivate-widget-extent): New function. - (widget-specify-inactive): Use `widget-deactivate-widget-extent'. - (widget-setup): Ditto. - (widget-specify-active): Use `widget-reactivate-widget-extent'. - (widget-move): Don't stop within inactive range. - -1997-10-14 MORIOKA Tomohiko - - * language/japan-util.el: Copied from Emacs 20.2. - - * mule/mule-cmds.el (char-code-property-table): New variable. - (get-char-code-property): New function. - (put-char-code-property): New function. - -1997-10-10 MORIOKA Tomohiko - - * language/vietnamese.el: Use language/viet-util.el instead of - mule/mule-vietnamese.el; abolish mule/mule-vietnamese.el. - -1997-10-09 MORIOKA Tomohiko - - * mule/mule-coding.el: Rename `automatic-conversion' -> - `undecided' to sync with Emacs 20.2; define coding-system - `automatic-conversion' as an alias for `undecided'. - - mule/mule-files.el (buffer-file-coding-system-for-read, - convert-mbox-coding-system, insert-file-contents), - language/japanese.el, language/chinese.el, language/korean.el: - Rename `automatic-conversion' -> `undecided' to sync with Emacs - 20.2. - -1997-10-08 MORIOKA Tomohiko - - * language/viet-chars.el: New file; moved from - mule/vietnamese-hooks-1.el. - - * language/vietnamese.el: Merge mule/vietnamese-hooks-2.el; - abolish mule/vietnamese-hooks-2.el. - - * prim/dumped-lisp.el: Use language/viet-chars and - language/vietnamese instead of mule/vietnamese-hooks-{1|2}. - -1997-10-07 MORIOKA Tomohiko - - * mule/mule-misc.el (split-char): New function. - -1997-10-14 SL Baur - - * default.el: New file. - * site-start.el: New file. XEmacs starts faster if dummy versions - of these files are found early in the `load-path'. - Suggested by Kyle Jones - -1997-10-14 Hrvoje Niksic - - * custom/wid-edit.el (widget-field-find): Use `map-extents'. - (widget-transpose-chars): Check for empty fields, and point at - beginning of field. - (widget-documentation-string-value-create): `insert-char' handles - 0 gracefully, so no need to protect. - (widget-specify-inactive): Detach the button extents. - (widget-specify-active): Reattach the button extents. - (widget-make-field-untabable): New function. - (widget-specify-inactive): Make the fields non-tabable; use - `widget-make-field-untabable'. - (widget-type): Revert to defsubst. - -1997-10-13 Adrian Aichner - - * utils/xemacs-build-report.el: - Switched from (mail ...) to (compose-mail ...) upon suggestion by - Hrvoje Niksic. - Extended xemacs-build-report-keep-regexp. - Changed xemacs-build-report-make-output-file value to beta.err - Shortend and bracketed xemacs-build-report-subject. - Improved (I hope) tm-edit to SEMI aliasing logic. - -1997-10-09 Adrian Aichner - - * utils/xemacs-build-report.el: - Restored RCS keywords and updated comment for `xemacs-build-report-version'. - - * utils/xemacs-build-report.el: - Separated the Spaghetti code into separate functions to do the following: - xemacs-build-report-insert-header - xemacs-build-report-insert-make-output - xemacs-build-report-insert-installation-file - -1997-10-13 Hrvoje Niksic - - * custom/cus-load.el: Disable gc while loading `custom-load' - files. - (custom-put): Added docstring; ignore PROPERTY. - - * custom/wid-edit.el (widget-previous-button-or-field): If the - point is within a button or field, return the beginning position - of the field. - - * prim/frame.el (frame-list): Use `nconc' instead of `append'. - (set-frame-configuration): Use `mapc'. - (delete-other-frames): Ditto. - - * prim/faces.el: Use the CL macro at top-level. - - * prim/faces.el (face-spec-set-match-display): Use `case'. - (set-face-stipple): Use backquotes. - - * custom/wid-edit.el (widget-glyph-find): Use `laxputf'. - (widget-push-button-value-create): Ditto. - - * custom/cus-face.el (custom-face-attributes): Support - inverse-video for TTY-s. - - * prim/cmdloop.el (keyboard-escape-quit): Abort recursive edit, as - documented. - -1997-10-12 Hrvoje Niksic - - * prim/simple.el (zmacs-deactivate-region): Use `mapc' instead of - `mapcar'. - (zmacs-make-extent-for-region): Ditto. - - * custom/cus-dep.el: Updated comments. - - * custom/cus-edit.el (custom-variable-prompt): Prompt with - `variable'. - -1997-10-12 Karl Hegbloom - - * custom/cus-edit.el (custom-guess-name-alist): Allow `-hooks' - instead of `hook'. - -1997-10-12 Hrvoje Niksic - - * prim/profile.el (profile-results): Use %-*s format. - (profile-align): Nuked. - - * packages/gnuserv.el (gnuserv-frame-plist): New variable. - (gnuserv-special-frame-function): Use it. - (gnuserv-edit-files): Ditto. - -1997-10-12 SL Baur - - * prim/package-admin.el (package-admin-add-binary-package): - Correctly deal with package-paths with a single directory. - -1997-10-11 SL Baur - - * prim/startup.el (set-default-load-path): Look for `packages' - directory too. - (set-default-load-path): Initialize Info-default-directory-list - from the environment variable INFOPATH. - (set-default-load-path): Initialize Info-default-diretory-list - from the configure variable `infopath'. - -1997-10-10 Karl M. Hegbloom - - * prim/startup.el: (set-default-load-path): loop over the `Info- - default-directory-list' and collect those that are `file- - directory-p'. - - * '': various doc string corrections. - - * '': changed `auto-saves-file-prefix' to "~/.xemacs/saves-" - - * '' Added toplevel block (when (fboundp 'load-gc) ...to init the - Info-def..list from the environment variable INFOPATH at dump time. - - * prim/packages.el (packages-find-packages-1): append the list of - packages info directories to `Info-default-directory-list' rather - than prepending them. Don't add them if they're already in the - list. - - * packages/info.el (Info-directory-list): various fixes to the - directory list handling. - * (Info-localdir-heading-regexp) added. - - * '' removed the unrequired defcustom of `Info-default-directory- - list' - -1997-10-11 SL Baur - - * prim/about.el: New faces, new entries. - - * prim/profile.el (profile-results): Rename. - (pretty-print-profiling-info): Ditto. - From Kyle Jones - -1997-10-10 Per Abrahamsen - - * custom/wid-edit.el (variable-link): New widget. - (widget-variable-link-action): New function. - (function-link): New widget. - (widget-function-link-action): New function. - -1997-10-10 Karl M. Hegbloom - - * prim/modeline.el (modeline-minor-mode-menu): menus are toggles - not strings now. - -1997-10-10 SL Baur - - * psgml/psgml-html.el (html-quote-region): Grow bounds when performing - substitutions. - From Adrian Aichner - -1997-10-10 SL Baur - - * utils/highlight-headers.el (highlight-headers-citation-header-regexp): - Correct doc string. - From Kazuyoshi Furutaka - -1997-10-10 Martin Buchholz - - * packages/bookmark.el: - * packages/iswitchb.el: - * utils/speedbar.el: - * utils/xemacs-build-report.el: - - change Xemacs --> XEmacs - -1997-10-09 Colin Rafferty - - * modes/lazy-shot.el (lazy-shot-shot-function): Undid a breakage. - -1997-10-09 Jens-Ulrik Holger Petersen - - * prim/help.el (function-called-at-point): Added docstring. - (function-at-point): Ditto. - (describe-function-arglist): Commented out -- seems unused. - (find-function): ALL find-function stuff moved to "find-func.el" - - * prim/find-func.el: new file created from functions previously in - "help.el". - -1997-10-09 SL Baur - - * pcl-cvs/pcl-cvs.el (cvs-changelog-ours-p): Grok new ChangeLog - format. - - * prim/startup.el (user-init-directory): New name for - `emacs-user-extension-dir'. - (load-user-init-file): Use it. - -Mon Oct 6 19:12:51 1997 Barry A. Warsaw - - * cc-mode/Release 5.19 - -Mon Oct 6 19:09:17 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-guess-basic-syntax): - CASE 5F: extern-lang-close relpos should be - element 0 of inclass-p, not element 1. - - * cc-mode/cc-cmds.el (c-progress-init, c-progress-fini): - Be silent if c-progress-interval - is nil. - - * cc-mode/cc-vars.el (c-progress-interval): Document new semantics - -Fri Oct 3 23:10:04 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-beginning-of-statement-1): - Watch out for keywords which have a - preceding underscore. - -Fri Sep 26 23:30:58 1997 Barry A. Warsaw - - * cc-mode/cc-menus.el: Patches to Imenu support given by - "Masatake (jet) YAMATO" . - (Jan Dubois) jan.dubois@ibm.net - - * cc-mode/cc-cmds.el (c-comment-line-break-function): - Fix for when comment starts at - comment-column and there is non-whitespace preceding this on the - current line. - - * cc-mode/cc-mode.el (c-submit-bug-report): Remove - c-recognize-knr-p. Add c-comment-continuation-stars. - -Mon Sep 22 15:47:02 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-initialize-builtin-style): - Only use copy-tree if it is - funcall-able. This is the right patch, and was given by Erik Naggum - - -1997-10-08 SL Baur - - * x11/x-menubar.el (file-menu-filter): Reverse sense of bounds - test. - From: Didier Verna - - * prim/format.el (format-annotate-function): Reverse sync to Emacs - 19. - -1997-10-08 Hrvoje Niksic - - * prim/profile.el (profile-align): New function. - - * prim/help.el (describe-function): Use `buffer-string' with a - BUFFER argument, instead of `save-excursion'+`buffer-string'. - (describe-variable): Ditto. - (describe-variable): Use `when'. - - * modes/lisp-mode.el: Indent `display-message' and - `display-warning' better. - - * prim/help.el: Customized find-function stuff. - (help-with-tutorial): Use point-at-{bol,eol}. - (with-displaying-help-buffer): Use `with-current-buffer'. - - * prim/keymap.el (event-apply-modifier): Use `vconcat'. - (define-prefix-command): Use the NAME argument to - `make-sparse-keymap'. - (suppress-keymap): Use `incf'. - - * prim/help.el (key-or-menu-binding): Document it. - - * prim/keymap.el (insert-key-binding): Use `key-or-menu-binding' - from help.el. - - * prim/help.el (built-in-variable-doc): Use `case'. - (describe-function-1): Assign to `file-name' instead of `home'. - - * prim/profile.el (profiling-results): Handle strings correctly. - - * prim/profile.el (profile): Expand FORMS only once. - -1997-10-08 Colin Rafferty - - * prim/lisp-file-db.el (lookup-lisp-file-db): Made it stop on - failure. - -1997-10-08 SL Baur - - * prim/lisp-file-db.el: New file. - From Raymond Toy - -1997-10-08 Colin Rafferty - - * modes/lazy-shot.el: Customified. Made it handle long lines - better. - -1997-10-08 SL Baur - - * prim/startup.el (load-user-init-file): Remove reference to - .xemacs as a file. - -1997-10-07 SL Baur - - * utils/thing.el (thing-filename): Deal with point at end of - buffer. - -1997-10-07 Karl M. Hegbloom - - * psgml/psgml.el (sgml-mode-map): modify defin-key statements to - use the new and improved key designator syntax. Rebound - 'sgml-split-element to a similar key as the global 'split-line - binding. - -1997-10-07 Jens-Ulrik Holger Petersen - - * utils/thing.el (thing-symbol): Return nil if `end' is nil. - -1997-10-07 Karl M. Hegbloom - - * modes/cperl-mode.el: Fixed the help toggle menuitem, and added - an autoload cookie. - * modes/perl-mode.el: ditch the autoload in favor of cperl-mode. - -1997-10-07 Jens-Ulrik Holger Petersen - - * packages/etags.el (add-to-tag-completion-table): Better support - for Scheme code. Parse scheme definitions and identifiers - with colons correctly. - -1997-10-07 SL Baur - - * mule/mule-cmds.el (read-input-method-name): Use a default if - available. - From Didier Verna - - * prim/about.el (about-url-alist): Update jwz's home page. - -1997-10-07 Hrvoje Niksic - - * x11/x-menubar.el (default-menubar): Handle pending-delete - correctly. - -1997-10-06 SL Baur - - * utils/font.el: Don't need devices.el on XEmacs. - -1997-10-05 SL Baur - - * utils/mail-utils.el (rmail-dont-reply-to-names): Snarf from - rmail.el. - -1997-10-04 SL Baur - - * efs/dired.el (dired-mail-reader): Default to VM instead of old, - broken rmail. - -1997-09-29 Karl M. Hegbloom - - * prim/files.el (auto-mode-alist): make `.cl' a lisp-mode - extension for Franz Allegro CL. - -1997-10-05 Hrvoje Niksic - - * prim/simple.el: Minor docstring and comment changes. Customized - some more. - -1997-10-04 Hrvoje Niksic - - * utils/xemacs-build-report.el (xemacs-build-report): Placed to - maintenance group. - (xemacs-create-build-report): Added an autoload cookie. - - * prim/profile.el (profiling-results): Renamed from - `pretty-print-profiling-info'. - -1997-10-03 Karl M. Hegbloom > - - * custom/cus-edit.el (custom-save-all): Bind `auto-mode-alist' to - nil around the init file handling to prevent unnecessary automagic - processing. - -1997-10-03 Hrvoje Niksic - - * prim/faces.el (face-spec-set): Invoke `init-face-from-resources'. - - * custom/cus-face.el (custom-set-faces): Revert to using - `make-empty-face'. - (custom-declare-face): Ditto. - -1997-10-04 SL Baur - - * prim/modeline.el (modeline-modified-map): Call wrapper function - over `vc-toggle-read-only'. - (modeline-toggle-read-only): New function. - - * prim/files.el (basic-save-buffer): Put guard on call to - `vc-after-save' since someone may wish not to install the vc - package. - - * prim/fill.el (sentence-end-double-space): Fix docstring. - - * cl/cl-seq.el (remq): Reformat and add doc-string. - Suggested by: Karl M. Hegbloom - -1997-10-03 Karl M. Hegbloom - - * packages/func-menu.el: change the countups from message's to - display-message 'progress's so they don't dump in the lossage - buffer. - -1997-10-03 Karl M. Hegbloom - - * psgml/psgml.el (sgml-mode-map): Bind (meta backspace) to - 'backward-kill-word so it works as expected. "\e\C-h" will still - do 'sgml-mark-current-element. - -1997-08-13 Yves BLUSSEAU - - * efs/efs.el (efs-set-file-modes): Fix a bug that cause an error - when using the efs-set-file-modes function on a remote station with - a FTP daemon that don't support the QUOTE function. - -1997-10-02 Colin Rafferty - - * prim/frame.el (default-drag-and-drop-functions): Fixed a typo - that was calling `data' rather than looking at it. - -1997-10-04 SL Baur - - * cl/cl-seq.el (remove): Add docstring. - Suggested by Karl M Hegbloom - -1997-10-02 Colin Rafferty - - * prim/simple.el (set-fill-column): Used format to create the - string for `display-message'. - -1997-10-03 Hrvoje Niksic - - * custom/cus-face.el (custom-set-faces): Make the face, if - necessary. - -1997-10-02 Hrvoje Niksic - - * custom/cus-face.el (custom-declare-face): Use `make-face' - instead of `make-empty-face'. - (custom-declare-face): Don't invoke init-face-from-resources - explicitly. - - * prim/profile.el (pretty-print-profiling-info): When interactive, - use a separate buffer instead of current-buffer. - (pretty-print-profiling-info): Prettified output. - -1997-10-01 SL Baur - - * custom/cus-dep.el (cus-face): Remove unneeded dependency on - cus-edit. - -1997-09-30 SL Baur - - * utils/finder.el (finder-known-keywords): Fix typo. - -1997-09-30 SL Baur - - * prim/dumped-lisp.el (preloaded-file-list): Load - cl/auto-autoloads early. - -1997-10-01 Hrvoje Niksic - - * custom/cus-edit.el (custom-save-delete): Bind `find-file-hooks' - to nil. - - * custom/wid-edit.el (widget-next-button-or-field): Use the - `start-open' flag to `map-extents'. - (widget-previous-button-or-field): Ditto. - - * custom/cus-edit.el (custom-face-value-create): Use - `face-custom-attributes'. - - * packages/font-lock.el: Defcustomed some variables. - -1997-09-30 Hrvoje Niksic - - * custom/cus-face.el: Big changes. Most of the functionality - moved to faces.el. Internal functions renamed not to start with - `custom-'. - - * custom/cus-face.el (face-spec-set): Use `reset-face'. - - * prim/faces.el (reset-face): Accept LOCALE, TAG-SET and EXACT-P. - - * custom/cus-face.el (face-spec-set): Use `remove-specifier'. - (get-frame-background-mode): Cache background modes of frames. - - * prim/minibuf.el (input-error): Add a `display-error' property. - - * custom/cus-face.el (initialize-face-resources): Check for - `make-face-x-resource-internal' before using it. - (custom-get-frame-properties): Use `set-frame-property'. - -1997-09-29 Hrvoje Niksic - - * custom/wid-edit.el (widget-specify-button): Set the `tabable' - property. - (widget-specify-field): Ditto. - (widget-next-button-or-field): Use it. - (widget-previous-button-or-field): Ditto. - -1997-09-29 Martin Buchholz - - * sunpro/sunpro-init.el: Fix initialization failure if - compile/debug toolbar buttons are LAST on the toolbar. - -1997-09-29 Jens-Ulrik Holger Petersen - - * prim/help.el (find-function-noselect): Now finds libraries - explicitly loaded from outside `load-path' as it should. - -1997-09-29 SL Baur - - * prim/help.el(describe-function-1): Fix for compiled macros. - From Hrvoje Niksic - -Mon Sep 29 01:30:45 1997 Kyle Jones - - * prim/startup.el: Added defvars for lock-directory - and superlock-file to quiet the byte-compiler. - - (normal-top-level): Removed call to init-glyphs; it now - runs at dump time from lisp/prim/glyphs.el. - - (splash-frame-present): Call splash-hack-version-string - once after all the strings have been inserted, instead - of once per string insertion. - - * prim/glyphs.el (init-glyphs): Replaced references - to data-directory with "../etc/" which is the data - directory at dump time. This is likely a lose for - those who CANNOT_DUMP. I don't know what the right - answer is in that case. - - Run init-glyphs at dump time. - - * prim/faces.el (init-other-random-faces): Don't set - colors for the text cursor if we're initializating a - tty device, since it does nothing on a tty. - - Removed modeline-buffer-id, modeline-mousable and - modeline-mousable-minor-mode-code face initialization; this - code is now run at dump time in lisp/prim/modeline.el. - - * prim/faces.el: Set reverse-p property on tty devices - for the primary-selection face. Set underline-p property - on tty devices for the secondary-selection face. Both of - these actions are to prevent init-other-random-faces from - considering these faces the same as the default face on - ttys and applying useless color specs to them. - - * prim/modeline.el: Initialize modeline-buffer-id, - modeline-mousable and modeline-mousable-minor-mode - faces in this file at dump time. - - Added (defvar place) to quiet the byte-compiler. - -Mon Sep 29 02:11:35 1997 Kyle Jones - - * packages/vc-hooks.el: Move menu installation off - before-init-hook and do it at dump time. - - * ediff/ediff-hook.el: Move menu installation off - before-init-hook and do it at dump time. - -1997-09-29 Jens-Ulrik Holger Petersen - - * prim/help.el (describe-function-1): If the function is not yet - loaded, print the autoload file-name. If function is loaded, - print the library name in `load-history' or from - `compiled-function-annotation'. - -1997-09-28 Karl M. Hegbloom - - * prim/help.el (find-function-noselect): remove reference to - `path' from the (let* ((path find... since &optional path is no - longer an argument to this function. Cures "Signaling: - (void-variable path)" error when using {M-x find-function}. - -1997-09-27 Karl M. Hegbloom - - * utils/regexp-opt.el: Add support for the shy grouping "\\(?:" - that came along with the new regexp syntax. - -1997-09-29 Hrvoje Niksic - - * x11/x-toolbar.el: Minor fixes. - -1997-09-28 Hrvoje Niksic - - * custom/wid-edit.el (color): Buttonify the tag. - (widget-color-action): Use `read-color' unconditionally. - - * utils/edmacro.el: Use append/vconcat instead of mapcar/mapvector - with `identity'. - (format-kbd-macro): Use `indirect-function' instead of - `symbol-function'. - (read-kbd-macro): Fix docstring. - (edmacro-finish-edit): Use `match-string'. - (edmacro-parse-keys): Ditto. - (edmacro-parse-word): Use `dotimes' instead of `loop'. - (edmacro-format-keys): Ditto. - - * custom/cus-face.el (custom-face-attributes): Use - `set-face-background-pixmap', instead of `set-face-stipple'. - - * custom/cus-edit.el (custom-group-menu-create): Check whether - `custom-menu-create' returned a list. - -1997-09-28 SL Baur - - * utils/finder.el (finder-known-keywords): Ignore mule entry when - built without Mule. - -1997-09-27 MORIOKA Tomohiko - - * quail.el (quail-execute-non-quail-command): `keylist' is not - list of characters. - (quail-update-translation): Don't use `quail-delete-region' - because overlay emulation of XEmacs can not regard 0 length - overlay. - (quail-show-kbd-layout): Must convert character(code) to event. - -1997-09-26 MORIOKA Tomohiko - - * quail.el: sync with Emacs 20.2. - -1997-09-27 MORIOKA Tomohiko - - * mule-init.el (init-mule): Load leim-list.el (to sync with Emacs - 20.2). - - * mule-cmds.el: Change key binding for `select-input-method' to - sync with Emacs 20.2. - - (get-language-info, set-language-info, set-language-info-alist, - read-language-name): Modify to sync with Emacs 20.2. - - (leim-list-file-name): New constant (imported from Emacs 20.2). - (leim-list-header, leim-list-entry-regexp, - update-leim-list-functions): New variable (imported from Emacs - 20.2). - (update-leim-list-file): New function (imported from Emacs 20.2). - - (current-input-method, current-input-method-title): Modify - DOC-string to sync with Emacs 20.2. - (default-input-method): Use `defcustom' (to sync with Emacs 20.2). - (input-method-history): New variable (imported from Emacs 20.2). - - (inactivate-current-input-method-function): Modify DOC-string to - sync with Emacs 20.2. - - (input-method-alist): New variable (imported from Emacs 20.2). - (register-input-method, read-input-method-name, - activate-input-method, inactivate-input-method): New function - (imported from Emacs 20.2). - (select-input-method, toggle-input-method, describe-input-method, - describe-current-input-method, read-multilingual-string): Modify - to sync with Emacs 20.2. - (input-method-verbose-flag): New variable; abolish - `input-method-tersely-flag'; to sync with Emacs 20.2. - (input-method-highlight-flag): New variable (imported from Emacs - 20.2). - - (input-method-activate-hook, input-method-inactivate-hook): Modify - DOC-string to sync with Emacs 20.2. - (input-method-exit-on-invalid-key): New variable (imported from - Emacs 20.2). - - * mule-coding.el (check-coding-system): New alias. - (modify-coding-system-alist): New function (imported from Emacs - 20.2). - - Rename coding-system `iso-2022-7' -> `iso-2022-7bit' to sync with - Emacs 20.2; define alias `iso-2022-7' for compatibility. - - * mule-process.el (network-coding-system-alist): New variable. - (open-network-stream): Refer it. - -1997-09-27 MORIOKA Tomohiko - - * viet-util.el: New file; Imported from Emacs 20.2. - - * tibet-util.el: New file; Imported from Emacs 20.2. - - * hebrew.el, lao.el, lao-util.el, vietnamese.el, tibetan.el: - Imported from Emacs 20.2. - - * greek.el, european.el, ethiopic.el, english.el, cyrillic.el, - chinese.el, korean.el, japanese.el, thai.el, misc-lang.el: Modify - to sync with Emacs 20.2. - -1997-09-24 MORIOKA Tomohiko - - * mule-process.el (start-process): Refer - `process-coding-system-alist'. - - * mule-process.el (call-process-region): Refer - `process-coding-system-alist'. - - * mule-process.el (process-coding-system-alist): New variable. - (call-process): Refer it. - - * mule-init.el: Rename `pathname-coding-system' to - `file-name-coding-system' to sync with Emacs 20.2. - - * mule-coding.el: Rename `pathname-coding-system' to - `file-name-coding-system' to sync with Emacs 20.2; define - `pathname-coding-system' as an obsolete variable. - -1997-09-03 MORIOKA Tomohiko - - * mule/mule-files.el: Implement `file-coding-system-alist' of - Emacs 20.0.97 to sync; abolish variable - `buffer-file-coding-system-alist'. - - (find-file-coding-system-for-read-from-filename): Renamed from - `find-buffer-file-coding-system-from-filename'; modify for new - `file-coding-system-alist'. - - (find-file-coding-system-for-write-from-filename): New function. - - (insert-file-contents): Modify for new `file-coding-system-alist'. - - (write-region): Use - `find-file-coding-system-for-write-from-filename'. - -1997-09-27 SL Baur - - * prim/obsolete.el (define-widget-keywords): Make it obsolete. - - * custom/widget.el (define-widget-keywords): Restore superfluous - function `define-widget-keywords'. - - * modes/sh-script.el (sh-script): Restore correct feature. - -1997-09-27 Tomasz Cholewo - - * prim/isearch-mode.el (isearch-help-or-delete-char): New function. - -1997-09-27 Hrvoje Niksic - - * custom/cus-dep.el (Custom-make-dependencies): Minor fixes. - -1997-09-27 SL Baur - - * packages/completion.el: Remove keybinding of M-return for - hyperbole. - (completion-kill-region): The version of this function in InfoDock - 4.0pre was very broken for XEmacs due to active region handling - and because it didn't set the `this-command' variable properly - when doing a kill. - From: Bob Weiner - -1997-09-26 SL Baur - - * utils/autoload.el: Removed code dealing with customization. - (update-file-autoloads): Fix typo in DOC string, remove custom code. - (update-autoloads-from-directory): Remove custom code. - (batch-update-autoloads): Fix DOC string, remove custom code. - (batch-update-directory): Fix DOC string, remove custom code. - -1997-09-26 Jens-Ulrik Holger Petersen - - * prim/help.el (describe-function-at-point): new function. - (describe-variable-at-point): ditto. - (help-next-symbol): ditto. - (help-prev-symbol): ditto. - (describe-function): Mention `find-function-function' in - docstring. Use `function-history' in completing-read. - (describe-function-1): Only print one filename, even if we know - two! Use `variable-history' in completing-read. - (where-is): Mention `find-function-function' in docstring. - (find-function-function): improve docstring. - (find-function-noselect): Remove optional arg. Search also for - cl's defun*. Return a pair instead of a list. - (find-function-read-function): use `function-history'. - (find-function-do-it): new function. - (find-function): Remove optional arg. Use `find-function-do-it'. - (find-function-other-window): ditto. - (find-function-other-frame): ditto. - (find-function-at-point): new function. - -1997-09-26 Hrvoje Niksic - - * custom/cus-edit.el: Issue a message about loading customization - dependencies. - - * custom/wid-edit.el (widget-map-buttons): Fixed typo. - -1997-09-25 SL Baur - - * prim/files.el (after-find-file): Revert synch to Emacs 20 and - restore old directory creation behavior. - -1997-09-25 Hrvoje Niksic - - * custom/wid-edit.el (widget-button-or-field-extent): New - function. - (widget-next-button-or-field): Use it. - (widget-previous-button-or-field): Ditto. - (widget-move): Don't signal an error when there is only one widget - in the buffer. - (widget-push-button-value-create): Cache glyphs themselves, - instead of instantiators. - (widget-documentation-string-value-create): Better help echo - (widget-mouse-help): Use `functionp'. - (widget-echo-help): Ditto. - -1997-09-25 SL Baur - - * prim/glyphs.el (init-glyphs): Fix jpeg signature. - -1997-09-24 Jens-Ulrik Holger Petersen - - * modes/lazy-shot.el (lazy-shot-shot-function): make the message - be displayed as progress. - -1997-09-25 Hrvoje Niksic - - * comint/telnet.el: Minor custom changes. - - * custom/wid-edit.el (widget-field-action): Edit the value in the - minibuffer. - - * custom/cus-edit.el (custom-group-value-create): Renamed `Go to - Group' tag to `Open'. - - * custom/wid-edit.el (widget-shadow-subrs): New variable. - (widget-url-link-help-echo): New function. - (url-link): Use it. - (widget-emacs-library-link-help-echo): New function. - (emacs-library-link): Use it. - -1997-09-24 Hrvoje Niksic - - * custom/wid-edit.el (widget-glyph-insert-glyph): Encode the - widget information to extent, not to the glyph. - (widget-glyph-click): Extract the widget from the extent, not the - glyph. - (widget-glyph-find): Set up a glyph cache. - - * prim/about.el: Use :button-prefix and :button-suffix instead of - the variables. - - * custom/wid-edit.el (widget-field-keymap): Bind Sh-TAB to - `widget-backward'. - (widget-specify-field): Use extents, not overlays. - (widget-specify-button): Ditto. - (widget-specify-sample): Ditto. - (widget-specify-inactive): Ditto. - (widget-button-click): Ditto. - (widget-field-value-create): Ditto. - (widget-field-value-delete): Ditto. - (widget-color-notify): Ditto. - (widget-setup): Ditto. - (widget-map-buttons): Use `map-extents'. - (widget-keymap): Made `global-map' its parent. - (widget-next-button-or-field): New function. - (widget-previous-button-or-field): Ditto. - (widget-move): Use them. - - * custom/custom.el (custom-group-hash-table): Use - `make-hashtable', with initial size 300. - (custom-add-to-group): Update hash-table unconditionally. - -1997-09-24 SL Baur - - * prim/packages.el (packages-useful-lisp): Arrange to bytecompile - shadow.elc early. - -1997-09-22 Karl M. Hegbloom - - * x11/x-toolbar.el (Info-frame-plist): Added. - (toolbar-info) Use new plist variable to make-frame. - -1997-09-24 Hrvoje Niksic - - * custom/wid-edit.el (widget-button1-click): Would bug out on - events with no bindings. - - * custom/cus-edit.el (custom-group-value-create): Update members - after loading the widget. - (custom-group-link-help-echo): New function. - (custom-group-link): Use it. - - * prim/cus-load.el (custom-put): Update - `custom-parent-hash-table'. - - * custom/cus-edit.el (custom-add-parent-links): Use - `custom-group-hash-table' to map the groups. - - * custom/custom.el (custom-parent-hash-table): New variable. - (custom-add-to-group): Use it. - - * prim/cus-load.el: Don't issue message for every loaded file. - - * custom/cus-edit.el (custom-group-prompt): New function. - (customize): Use it. - (customize-other-window): Ditto. - - * custom/wid-edit.el (widget-field-keymap): Bind TAB to - `widget-forward'. - -1997-09-23 Hrvoje Niksic - - * custom/cus-edit.el: Use `display-message' to indicate progress - messages. - (customize-set-variable): Use the third argument to `get'. - (customize-save-variable): Ditto. - (custom-variable-value-create): Ditto. - (custom-variable-state-set): Ditto. - (custom-variable-set): Ditto. - (custom-variable-save): Ditto. - (custom-variable-reset-saved): Ditto. - (custom-variable-reset-standard): Ditto. - - * custom/cus-edit.el: Removed C-coded routines. - - * custom/cus-edit.el (custom-buffer-create-internal): Print a - limited number of messages. - (custom-group-value-create): Ditto. - - * custom/wid-edit.el (widget-editable-list-value-get): Revert to - `append'. - -1997-09-22 Colin Rafferty - - * modes/lazy-shot.el (lazy-shot-shot-function): Made it do its - work in the correct buffer. Also, changed obsolete - function call to non-obsolete version. - -1997-09-22 Colin Rafferty - - * utils/shadow.el (find-emacs-lisp-shadows): Removed extra slash - between directory and filename. - -1997-09-23 SL Baur - - * ilisp/Makefile (SHELL): Remove dependency on /bin/csh. - -1997-09-23 Hrvoje Niksic - - * custom/wid-edit.el (widget-move): Use `incf'. - (widget-after-change): Ditto. - (widget-field-value-get): Ditto. - (widget-info-link-help-echo): New function. - (info-link): Use it. - - * custom/cus-edit.el (custom-last): Removed. - (custom-buffer-create-internal): Use `incf'. - (custom-group-value-create): Ditto. - - * packages/auto-save.el: Minor custom fixes. - - * prim/cus-dep.el (Custom-make-dependencies): Generate correct - output wrt `custom-put'. - - * custom/wid-edit.el (widget-tabable-at): Use `widget-at'. - - * custom/cus-edit.el (custom-group-value-create): Use - `custom-group-visibility' instead of `group-visibility'. - - * prim/help.el (help-map): Bound `C-h C' to `customize'. - - * custom/wid-edit.el (widget-princ-to-string): Don't use `let'. - (widget-clear-undo): Removed current-buffer argument. - (widget-choose): Use minibuffer when there are more than 10 items. - -1997-09-22 Hrvoje Niksic - - * custom/cus-edit.el (custom-button-face): Made it bold. - (custom-group-value-create): Change outlook of buffer. - (custom-buffer-create-internal): Ditto. - (custom-menu-nesting): Removed -- was unused by XEmacs. - (custom-menu-create): Don't use `custom-menu-nesting'. - (custom-group-menu-create): Define unconditionally. - (customize-menu-create): Ditto. - (custom-unlispify-menu-entry): Use `with-current-buffer'. - - * custom/wid-edit.el (widget-checklist-match-inline): Revert to - `append'. - (widget-checklist-value-get): Ditto. - (widget-editable-list-match-inline): Ditto. - (widget-group-match-inline): Ditto. - (widget-glyph-find): Removed compatibility checks; use - `locate-data-directory'. - (widget-glyph-find): Use backquotes. - (widget-push-button-value-create): Ditto. - (widget-choice-mouse-down-action): Don't use `window-system'. - (widget-transpose-chars): New function. - (widget-text-keymap): Use it. - (widget-princ-to-string): Use `with-current-buffer'. - (widget-map-buttons): Ditto. - (widget-push-button-gui): Set to value of `widget-glyph-enable' by - default. - (widget-push-button-value-create): Call `widget-specify-button'. - - * utils/mail-extr.el: Customized. - -1997-09-21 SL Baur - - * packages/man.el: Reverse manual prefix patch. - -1997-09-21 Karl M. Hegbloom - - * packages/man.el: Got rid of the `stars', and hard coded a prefix - of "Man: " for manual-entry buffers. - -1997-09-21 Hrvoje Niksic - - * custom/cus-face.el (frame-background-mode): Renamed from - `custom-background-mode'. - (frame-background-mode): Rewritten. - - * x11/x-menubar.el: Customized. - - * custom/cus-face.el (face-spec-set-match-display): Use `warn' for - warnings. - - * x11/x-font-menu.el: Customized. - - * modes/reftex.el: Add prefixes to customization groups. - - * custom/cus-edit.el (customize): Accept GROUP. - (customize-group): Defalias to `customize'. - (customize-other-window): New function. - (customize-group-other-window): Alias to `customize-other-window'. - - * custom/wid-edit.el (widget-choose): Now works with - `widget-menu-minibuffer-flag' set to nil. - (widget-menu-minibuffer-flag): Default to nil. - (widget-specify-insert): Use new blackquote syntax. - (widget-checklist-value-get): Ditto. - (widget-map-buttons): Ditto. - (widget-checklist-match-inline): Ditto. - (widget-editable-list-match-inline): Ditto. - (widget-group-match-inline): Ditto. - (widget-checklist-match-inline): Use `nconc'. - (widget-keymap): Bind `M-tab' to `widget-backward'. - - * prim/help.el (find-function-noselect): `locate-library' is - compression-aware; don't duplicate the work. - - * prim/packages.el (packages-hardcoded-lisp): Remove "cl-defs". - - * custom/wid-edit.el: Use `remove-if'. - (widget-glyph-directory): Use `locate-data-directory'. - - * custom/cus-edit.el (custom-unlispify-remove-prefixes): Default - to t. - - * custom/wid-edit.el: Removed *lots* of compatibility stuff. - - * custom/wid-edit.el: (widget-editable-list-value-get): Apply - `nconc' instead of `append'. - - * custom/wid-edit.el: Ditto. - - * custom/cus-edit.el: Ditto. - - * custom/custom.el: Use `mapc' instead of `mapcar', where - appropriate. - - * custom/wid-edit.el: Ditto. - - * custom/cus-edit.el: Ditto. - - * custom/custom.el: Ditto. - - * custom/widget.el: Don't define widget keywords. - -1997-09-21 Joel Peterson - - * prim/menubar.el: use normalize-menu-item-name instead of downcase - to compare menu item names. - -1997-09-20 Hrvoje Niksic - - * packages/etags.el: Lots of changes. - -1997-09-20 SL Baur - - * prim/faces.el (Top Level): Back out use of the loop macro. It now - isn't defined until loaddefs gets loaded. - -1997-09-20 Tomasz Cholewo - - * prim/help.el (help-for-help): Make menu items style more uniform. - -1997-09-20 Hrvoje Niksic - - * modes/sendmail.el: Don't define keys to mail etc. - - * prim/keydefs.el: Add bindings to `compose-mail'. - - * prim/simple.el: Synch mail stuff with Emacs 20. - - * utils/reporter.el: Removed mail-user-agent stuff. - - * x11/x-menubar.el (default-menubar): Use new semantics for - `gnuserv-frame'. - - * prim/obsolete.el (string-to-sequence): Wouldn't work with TYPE - `vector'. - -1997-09-19 Hrvoje Niksic - - * cl/cl.el: Don't load cl-defs. - - * cl/cl-macs.el: Added autoload cookies. - -1997-09-19 SL Baur - - * packages/man.el (Manual-buffers-have-prefix): New function. - (manual-entry): Use it. - From Remek Trzaska - -1997-09-18 Colin Rafferty - - * prim/novice.el (disable-command): Made it modify `custom-file' - instead of `user-init-file'. - - Stop multiple disable/enable-command calls from adding - extra newlines. - -1997-09-19 Tomasz Cholewo - - * prim/make-docfile.el: Use null, not not. - -1997-09-18 Jens-Ulrik Holger Petersen - - * prim/isearch-mode.el (isearch-message): Display-message as - progress (this way isearch message won't appear in the message - log). - -1997-09-18 Jens-Ulrik Holger Petersen - - * packages/info.el (Info-elisp-ref): Use `find-function-function'. - -1997-09-18 Jens-Ulrik Holger Petersen - - * packages/lazy-lock.el (lazy-lock-pre-idle-fontify-windows): - Don't do lazy-lock'ing if we're in the minibuffer. - -1997-09-17 SL Baur - - * oobr/Makefile (autoloads): Fix target. - - * hyperbole/Makefile (autoloads): Fix target. - - * utils/autoload.el (batch-update-autoloads): Obey - `autoload-package-name' setting. - - * efs/Makefile: Correct autoloads target. - - * prim/packages.el (locate-library): Simplify regexp for - compression suffixes. - Suggested by: Hrvoje Niksic - -1997-09-17 Karl M. Hegbloom - - * ilisp/ilisp-out.el (ilisp-scroll-output): bind `scroll-in-place' - to nil around the call to #'scroll-up so that {C-c v} - will properly scroll the *output* buffer. - -1997-09-17 Karl M. Hegbloom - - * ilisp/ilisp-out.el (ilisp-needed-window-height): make window one - line bigger - -1997-09-15 Karl M. Hegbloom - - * packages/info.el (Info-mouse-track-double-click-hook): follow - the top menu item when double click in bottom 1/4 and middle 1/3 - -1997-09-16 SL Baur - - * prim/about.el (about-hackers): Add new entry. - -Tue Sep 16 19:23:24 1997 Barry A. Warsaw - - * cc-mode/Release 5.18 - -Tue Sep 16 23:17:15 1997 Barry A. Warsaw - - * cc-mode/cc-menus.el (cc-imenu-c-prototype-macro-regexp): New - variable. - - (cc-imenu-c++-generic-expression): Patches to better match C++ code. - Given by jan.dubois@ibm.net (Jan Dubois) - - * cc-mode/cc-menus.el (cc-imenu-java-generic-expression): - Removed test for declaration - statements. Patch given by Ake Stenhoff , as - forwarded to me by RMS. - - * cc-mode/cc-menus.el: - Imenu support for Objective-C given by Masatake (jet) YAMATO. - - * cc-mode/cc-mode.el (objc-mode): Bind imenu-create-index-function to - cc-imenu-objc-function to enable Imenu support for Objective-C. - Contributed by Masatake (jet) YAMATO. - -Mon Sep 15 23:21:51 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-initialize-builtin-style): - Use existing copy-tree if it's defined. - - copy-sequence doesn't work; the - c-offsets-alist must be copied recursively. Use copy-tree solution - given by Simon Marshall. - -Fri Sep 5 04:47:03 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-beginning-of-statement): - Fixes in sentence movement to properly - handle M-e moving forward into a comment when looking at preceding - whitespace, and M-a moving backward into comment when looking at - following whitespace. - - Uncommented the looking-at call in the - sentence-flag clause so that moving by forward-sentence when looking - at the beginning of a comment works again. A previous log message in - cc-mode.el indicates this was commented out "because - c-beginning-of-statement-1 should do the right thing", but clearly it - doesn't. - - I don't know if this breaks something else, because I can't figure out - why it was commented out in the first place. - - * cc-mode/cc-langs.el: - Define `/' in c-mode-base-map since all modes now support - c-electric-slash. - - Define C-c C-e in mode-specific maps instead of c-mode-base-map since - c-expand-macro is meaningless in Java and IDL. - - * cc-mode/cc-engine.el (c-end-of-statement-1): - Wrap backward-up-list in a c-safe call so no - error results when buffer contains only a comment and point is at - eob. - -1997-09-15 SL Baur - - * utils/autoload.el (customized-symbols): Use a hash table. - - * prim/cus-load.el (custom-put): Restore. - Adapted from code by Hrvoje Niksic - - * x11/x-toolbar.el (initial-toolbar-spec): Remove news and mail - icons from default toolbar. - -1997-09-14 Hrvoje Niksic - - * prim/packages.el (locate-data-directory): Return nil when - directory not found. - (locate-library): Reimplemented using `locate-file'. - -1997-09-14 Hrvoje Niksic - - * prim/cus-dep.el: Provide `cus-dep'. - - * packages/time.el (display-time-insinuate): New function; don't - insinuate upon loading. - (display-time): Use it. - - * prim/loadup.el: Use it. - - * prim/dumped-lisp.el (dumped-lisp-packages): Renamed to - `preloaded-file-list'. - - * prim/cus-load.el: Updated the comment. - - * prim/cus-dep.el (custom-make-dependencies): Unjunkify. - - * modes/lisp-mode.el: Declare indentation of `with-temp-buffer'. - - * prim/cus-dep.el (custom-make-dependencies): Allow optional - parameter; don't kill Emacs. - - * modes/cl-indent.el: Minor customize changes. - - * modes/asm-mode.el: Minor customize changes. - - * modes/arc-mode.el: Customized. - - * modes/ada-stmt.el: New file. - - * modes/ada-mode.el: Synched with FSF (customized, etc.) - -1997-09-13 SL Baur - - * prim/files.el (switch-to-buffer-other-frame): Undo previous - change when focus-follows-mouse policy is in effect. - -1997-09-14 Hrvoje Niksic - - * packages/recent-files.el: Minor customize changes. - - * packages/man.el: Minor customize changes. - (Manual-use-rosetta-man): Moved the extensive info from docstring. - - * packages/makeinfo.el: Minor customize changes. - - * packages/info.el: Minor customize changes. - - * packages/gopher.el: Minor customize changes. - - * packages/func-menu.el: Minor customize changes. - - * packages/etags.el (tags-delete): Use builtin `delete'. - (tags-remove-duplicates): Don't recurse. - Fixup customizations. - - * packages/emerge.el: Use `with-current-buffer' instead of - `emerge-eval-in-buffer'; reindent. - - * packages/compile.el: Minor customize changes. - - * packages/bookmark.el: Customized. - - * packages/avoid.el (mouse-avoidance-mode): Customized properly. - - * packages/autoinsert.el: Customized. - - * modes/xrdb-mode.el: Minor customize changes. - - * modes/vrml-mode.el: Minor customize changes. - - * modes/vhdl-mode.el: Customized. - (vhdl-emacs-features): Recognize XEmacs 20 correctly. - - * modes/vhdl-mode.el: Require elp when compiling. - - * modes/texinfo.el: Minor customize changes. - - * modes/tcl.el: Minot customize changes. - - * modes/strokes.el: Small fixes. - (strokes-mode): Don't signal error without window system; issue a - warning. - (strokes-insinuate): New function. Don't defadvice upon loading. - (strokes-mode): Use it. - (strokes-char-face): Use `defface'. - - * modes/simula.el: Customized. - - * modes/scribe.el: Customized. - (scribe-envelop-word): Don't bind `noparens' (unused). - - * modes/rsz-minibuf.el: Remove old lemacs support, - e.g. screen-vs-frame, etc. - (resize-minibuffer-min): Removed. - - * modes/rsz-minibuf.el: Fix customizations. - - * prim/subr.el: Moved string-to-foo functions to obsolete.el. - - * prim/obsolete.el: Comments. - -1997-09-13 Hrvoje Niksic - - * packages/filladapt.el: Added `:require' to filladapt-mode - customization. - - * modes/whitespace-mode.el: Customize better. - - * modes/hideshow.el: Customize. - - * packages/icomplete.el: Don't turn on by default; customize - correctly. - - * utils/uniquify.el: Don't invade Emacs by default. - (uniquify-buffer-name-style): Default to nil. - - * utils/uniquify.el: Removed support for Emacs 18. - - * packages/pending-del.el: Customize `pending-delete-mode'. - - * modes/sh-script.el: Renamed `sh-script' customization group to `sh'. - - * packages/balloon-help.el: Customize `balloon-help-mode'. - - * packages/paren.el: Don't invade Emacs by default. - Finished customizing. - -1997-09-13 SL Baur - - * x11/x-toolbar.el (toolbar-paste-function): Remove reference to - x-yank-primary-selection. - Suggested by: Hrvoje Niksic - - * prim/about.el (about-xemacs): Update release date with worst - case. - (about-maintainer-info): Sync entry with 19.16. - -1997-09-11 Jens-Ulrik Holger Petersen - - * packages/vc.el (vc-default-init-version): Make the default value - be `nil'. Improve the docstring. - -1997-09-12 SL Baur - - * prim/make-docfile.el: Spawn make-docfile to csh on next-mach as - well as BSD. - -1997-09-13 Hrvoje Niksic - - * mule/mule-util.el: Clean of Emacs-ported things. - -1997-09-12 Hrvoje Niksic - - * packages/etags.el (tags-file-pattern): Allow `,' in file names. - - * prim/startup.el (initial-scratch-message): Converted to defcustom. - -1997-09-11 Hrvoje Niksic - - * packages/tar-mode.el: Customize; use cl.el instead of - home-brewed extensions. - -1997-09-10 Hrvoje Niksic - - * prim/subr.el (mapc-internal): Define for backward compatibility. - - * cl/cl-extra.el: Don't define `mapc'. - -1997-09-07 Hrvoje Niksic - - * prim/startup.el (initial-scratch-message): Cosmetic change. - -Fri Sep 5 00:50:41 1997 Barry A. Warsaw - - * cc-mode/Release 5.17 - -Fri Sep 5 04:47:03 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-beginning-of-statement): - Fixes in sentence movement to properly - handle M-e moving forward into a comment when looking at preceding - whitespace, and M-a moving backward into comment when looking at - following whitespace. - - * cc-mode/cc-langs.el: - Define `/' in c-mode-base-map since all modes now support - c-electric-slash. - - Define C-c C-e in mode-specific maps instead of c-mode-base-map since - c-expand-macro is meaningless in Java and IDL. - - * cc-mode/cc-engine.el (c-end-of-statement-1): - Wrap backward-up-list in a c-safe call so no error results when - buffer contains only a comment and point is at eob. - - * cc-mode/cc-cmds.el (c-beginning-of-statement): - Uncommented the looking-at call in the - sentence-flag clause so that moving by forward-sentence when looking - at the beginning of a comment works again. A previous log message in - cc-mode.el indicates this was commented out "because - c-beginning-of-statement-1 should do the right thing", but clearly it - doesn't. - - I don't know if this breaks something else, because I can't figure out - why it was commented out in the first place. - -Tue Aug 26 22:31:55 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-style-alist): "python" style, - knr-argdecl-intro == + - -Mon Aug 25 17:25:12 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-inside-bracelist-p): - Add a test to the enum list test so that the - following code won't erroneously recognize as inside a brace list: - - static PyObject ** - unpack_sequence(v, argcnt, why) - PyObject **v; - int argcnt; - enum *why_code; - { - int i; - - Otherwise, the `enum' in the K&R decl trips this code up. - - * cc-mode/cc-styles.el (c-style-alist): "python" style, - fill-column = 78 - -Fri Aug 22 20:25:57 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-comment-line-break-function): - Don't break line in the middle of a string. - -Mon Aug 18 17:37:24 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-style-alist): - "python" style change: arglist-intro <= + - "python" style change: inextern-lang <= 0 - -Fri Aug 15 18:39:10 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-style-alist): - "python" style requires c-comment-continuation-stars - to be "". - -1997-09-09 SL Baur - - * utils/autoload.el: One too many -autoload suffixes. - -1997-09-07 Hrvoje Niksic - - * prim/startup.el (initial-scratch-message): Cosmetic grammar - fixup in startup *scratch* message. - -1997-09-09 Jens-Ulrik Holger Petersen - - * packages/vc.el (vc-register): make the second option arg COMMENT - do something - - * packages/vc.el (vc-register): Make the default initial - version be `vc-default-init-version', a new variable - defaulting to "0.1". - -1997-09-08 SL Baur - - * prim/packages.el (packages-find-packages): Reverse package path. - From Colin Rafferty - -1997-09-07 Hrvoje Niksic - - * utils/edmacro.el (edmacro-parse-word): Accept ^foo (would signal - error). - (edmacro-format-1): Add SPC after ^. - -1997-09-03 SL Baur - - * prim/make-docfile.el (Top Level): Ensure `load-path' always has - directory names ending in '/'. - - * prim/packages.el (list-autoloads-path): Assume `load-path' - always has directories ending with trailing `/'s. - - * version.el (emacs-version): Preserve previous matching info. - From Didier Verna - -Wed Sep 3 13:53:10 1997 SL Baur - - * prim/loadup.el: *Never* add directories to the load-path - without trailing slashes. - -1997-09-03 SL Baur - - * prim/packages.el (packages-find-packages): New argument: - `suppress-user' to allow suppression of searching package - hierarchies beginning with "~". - (Top Level): Suppress searching user directories at dump time. - -1997-08-30 Karl M. Hegbloom - - * packages/info.el (Info-mouse-track-double-click-hook): Added, - and placed an `add-hook' into (Info-mode) - -1997-08-29 Jens-Ulrik Holger Petersen - - * packages/hyper-apropos.el (hyper-apropos-help-map): add - keybinding to `hyper-apropos-find-function'. - (hyper-apropos-map): removed unnecessary double binding to - `hyper-apropos-set-variable'. - (hyper-apropos-find-function): new function. - (hyper-apropos-popup-menu): if in the help mode, look for symbol - at top of the buffer if necessary. Added menu entry for - `hyper-apropos-find-function'. - -1997-08-29 Jens-Ulrik Holger Petersen - - * prim/files.el (switch-to-buffer-other-frame): make it select-frame - -1997-09-01 SL Baur - - * x11/x-menubar.el (default-menubar): Put tetris in the game menu, - and move it and the mine game to the top of the menu. - -1997-08-29 SL Baur - - * packages/lpr.el: Clone message-flatten-list. - -1997-08-25 MORIOKA Tomohiko - - * apel/emu-x20.el (mime-charset-coding-system-alist): - iso-2022-jp-2 is defined as coding-system. - - * mule/mule-coding.el: Rename `iso-2022-ss2-{7|8}' -> - `iso-2022-{7|8}bit-ss2' to sync with Emacs 20.0.96. - - (iso-2022-jp-2): New coding system. - -1997-08-23 MORIOKA Tomohiko - - * prim/about.el (about-maintainer-glyph): Fix problem with - jka-compr.el. - -1997-08-25 SL Baur - - * prim/help.el (find-function): ff-read-function was renamed. - (find-function-other-window): Ditto. - (find-function-other-frame): Ditto. - -1997-08-21 SL Baur - - * prim/packages.el (packages-find-packages-1): Append trailing - slash to directories added to the load-path. - -1997-08-17 SL Baur - - * utils/autoload.el (fixup-autoload-buffer): Replace lost guard - statement. - - * prim/make-docfile.el: Remove BOGUS redefinition of - find-file-hooks. - * prim/update-elc.el: Ditto. - - * prim/packages.el (locate-library): Put guard on usage of - `find-file-hooks' (it doesn't exist when temacs is being run). - -Fri Aug 15 17:26:05 1997 Barry A. Warsaw - - * cc-mode/Release 5.16 - -Fri Aug 15 18:39:10 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-style-alist): - "python" style requires c-comment-continuation-stars - to be "". - - * cc-mode/cc-engine.el (c-end-of-statement-1): - Eliminate false hits on important characters - inside literals (strings, comments). - -Tue Aug 12 21:47:18 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-comment-line-break-function): - In this function, and the defadvice, - call indent-new-comment-line if not in a comment. - - * cc-mode/cc-vars.el (c-buffer-is-cc-mode): Definition moved to - cc-mode.el - - * cc-mode/cc-mode.el (c-buffer-is-cc-mode): - Definition moved here from cc-vars.el. Also, - put permanent-local property on variable so it's value won't get - killed by kill-all-local-variables. This makes it easier for non-CC - Mode derived modes to be initialized correctly. - - * cc-mode/cc-cmds.el (c-electric-brace): - In preserve-p test, don't test char-before when at - bobp. Open brace at bobp is illegal in most modes, but not awk-mode, - which depends on CC Mode. - -Mon Aug 11 15:37:04 1997 Barry A. Warsaw - - * cc-mode/cc-mode.el (c++-mode, java-mode, objc-mode, idl-mode): - Remove obsolete variable c-double-slash-is-comments-p. - - * cc-mode/cc-langs.el (c-double-slash-is-comments-p): Remove - obsolete variable. - - * cc-mode/cc-cmds.el (c-fill-paragraph): - Remove conditional on obsolete variable - c-double-slash-is-comments-p. - - * cc-mode/cc-styles.el (c-style-alist): - Conform comment settings to RMS's preferences. - -Thu Aug 7 19:21:32 1997 Barry A. Warsaw - - * cc-styles.el (c-set-offset): Added autoload cookie. - -1997-08-15 SL Baur - - * cl/cl-macs.el (cl-make-type-test): De-ebolify type test for - 'character. - -1997-08-12 Karl M. Hegbloom - - * packages/man.el (Manual-mouseify-xrefs): Skip the top line of - manual entries so to not get the all-caps pseudo xrefs in the - heading in our list of manuals. - (Manual-buffers-have-stars): new customize option. - (manual-entry): Fix to utilize the new variable, and to not put - stars around manual names put in the minibuffer history. - -1997-08-12 Karl M. Hegbloom - - * packages/info.el (Info-directory-list): reverse the - `Info-default-directory-list' when using it to initialize the - `Info-directory-list'. - (Info-insert-dir): make it so the insertion of a locadir file at a - "^[ \t]*Local.*\n[ \t]*[-=]+" line works correctly. - -Mon Aug 11 17:35:35 1997 SL Baur - - * prim/loaddefs.el (((dir load-path))): Ignore all errors. - - * utils/autoload.el (fixup-autoload-buffer): Wrapping autoloads - files with a guard produces invalid bytecode. - - * prim/make-docfile.el (package-path): Look in the package path - for autoloads files. - - * prim/packages.el (packages-find-packages-1): Don't append - trailing "/" when adding a top-level Lisp directory. - (list-autoloads-path): New function. Use existing precomputed - load-path instead of doing the old broken computation. - -1997-08-11 SL Baur - - * prim/startup.el (command-line-1): Allow setting of - `initial-scratch-message' to nil to turn it off. - Suggested by Gary D. Foster - -1997-08-09 Karl M. Hegbloom - - * packages/info.el: (info::toolbar) swap next and prev buttons to - match the order of the node headings in info files. - -1997-08-09 Karl M. Hegbloom - - * packages/info.el: (Info-fontify-node) will now split top line - that spans 3 lines. (Info-extract-pointer) adjust to match. - -1997-08-08 Karl M. Hegbloom - - * packages/info.el: (Info-extract-pointer) make it move forward - one more line so when the top line has been split, the toolbar - arrows, u, and p will find the link they need. - -Thu Aug 7 18:13:12 1997 Barry A. Warsaw - - * cc-mode/Release 5.15 - -Thu Aug 7 19:21:32 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-set-offset): Added autoload cookie. - - * cc-mode/cc-langs.el (c++-mode-syntax-table, java-mode-syntax-table, - objc-mode-syntax-table, idl-mode-syntax-table): Added autoload - cookies. c-mode-syntax-table already has one. - -Wed Aug 6 21:50:08 1997 Barry A. Warsaw - - * cc-mode/cc-mode.el (c-initialize-cc-mode): - Check all cc-mode-19 interface requirements. - -Tue Aug 5 21:56:02 1997 Barry A. Warsaw - - * cc-mode/cc-align.el (c-lineup-java-throws): - Change the `when' clause to an `if-progn' :-( - - * cc-mode/cc-langs.el (c-common-init): - Make comment-line-break-function buffer local iff it's boundp. - - * cc-mode/cc-cmds.el: - defadvice for indent-new-comment-line keys off of c-buffer-is-cc-mode - instead of an explicit major-mode list. this means non-CC Mode - derived modes will work properly - - * cc-mode/cc-mode.el (c-initialize-cc-mode): Set - c-buffer-is-cc-mode to t. - - * cc-mode/cc-vars.el (c-buffer-is-cc-mode): New variable - - * cc-mode/cc-mode.el (c-initialize-cc-mode): - Give in to the pressure. require 'cc-mode-19 - if functionp is not bound. Too many novice errors without this. - - * cc-mode/cc-cmds.el: - Added advice for indent-new-comment-line so older Emacsen work if they - don't have the variable comment-line-break-function. - -Mon Aug 4 14:55:40 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-mode-base-map, c++-mode-map): - Move `/' as an electric character - from c++-mode-map to c-mode-base-map for all languages. - - * cc-mode/cc-cmds.el (c-electric-slash): - Make this work as the final slash in a */ block - oriented comment closing token. - - * cc-mode/cc-vars.el (c-comment-continuation-stars): - Can take a nil value. Also, the default value is "* ". - - * cc-mode/cc-cmds.el (c-comment-line-break-function): nil value for - c-comment-continuation-stars means use old semantics - -Fri Aug 1 22:44:49 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-comment-line-break-function): - Added optional soft argument - - * cc-mode/cc-langs.el (c-common-init): Set comment-multi-line and - comment-line-break-function here for all modes. - - * cc-mode/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode, - idl-mode): - Don't set comment-multi-line here. - - * cc-mode/cc-vars.el (c-comment-continuation-stars): New variable - - * cc-mode/cc-cmds.el (c-comment-line-break-function): New function - for proposed mode-specific comment-line-break-function variable. - - * cc-mode/cc-mode.el (c-mode): comment-multi-line => nil - - * cc-mode/cc-langs.el (c-C-comment-start-regexp): Obsolete. - - (c-comment-start-regexp): Initialize from c-C++-comment-start-regexp. - - (c-populate-syntax-table, c-setup-dual-comments): Merge both functions - into c-populate-syntax-table. With the new 9X draft C standard, both - line and block oriented comments are supported in all modes, so always - set up the syntax tables to support both comment styles. - - (c-mode-syntax-table, c++-mode-syntax-table, java-mode-syntax-table, - objc-mode-syntax-table, idl-mode-syntax-table): Use the new syntax - table initialization idioms. - - (c-enable-//-in-c-mode): Obsolete. - - * cc-mode/cc-mode.el (c-mode): - c-comment-start-regexp uses c-C++-comment-start-regexp to - support line oriented comments. - -Wed Jul 30 00:01:45 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-guess-basic-syntax): - CASE 5D.4: template argument continuation - lines are now analyzed as template-args-cont. - - * cc-mode/cc-styles.el (c-offsets-alist): - Added template-args-cont syntactic symbol - -Sat Jul 26 16:03:33 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-styles-alist): - In "java" style, set c-hanging-comment-starter-p to - nil to preserve Javadoc starter lines. - -1997-08-08 Jan Vroonhof - - * prim/obsolete.el (define-obsolete-variable-alias): If the - obsolete variable was setq'ed before the code was loaded we want - that value. - -1997-08-06 Karl M. Hegbloom - - * packages/man.el: Several modifications - - * (manual-entry) buffers are named without *'s, when - `buffers-menu-submenus-for-groups-p' is t, so they show up - in a subsection of the Buffer's menu now, rather than - lumped under *Misc*. - - * (Manual-mode) added a local `kill-buffer-hook' to remove - a killed manual from the `Manual-page-history' - - * (Manual-last-page) begun rewrite of manuvering and - viewing mode code - - * (Manual-mouseify-xrefs) hyphenated xrefs are highlighted - now, and properly handled when the second line is - indented. They end up on the menus too. - - * (Manual-popup-menu) made the far button popup menus look - better by removing the prefix string and adding a title. - -1997-08-06 Karl M. Hegbloom - - * packages/info.el: (Info-highlight-region) Fixed it to not - highlight the indention spaces in xrefs split across lines with - indention on the second line. - -1997-08-06 Karl M. Hegbloom - - * packages/info.el: Numerous modifications, including: - - * support for "dir" merging 'ala Emacs-19.34, with - fallback to cheap localdir files in the secondary info - directories. - - * changed default `Info-annotations-path' from - ~/.infonotes to ~/.xemacs/info.notes - - * added `Info-additional-directory-list' - - * changed a call to w3-fetch to browse-url - - * added new variables and functions from GNU Emacs 19.34: - `Info-dir-contents', `Info-dir-contents-directory', - `Info-dir-file-attributes', and the function - `Info-insert-dir' - - * rewrote `Info-suffixed-file' to a cond block rather than - nested if's for aesthetic reasons. - - * made the top line get split if it's longer than 79 - characters and tweaked fontification to handle that. - - * changed the look of the pop-up mouse menus by utilizing - the "--:etchedThing" dividers. - - * several docstring reformats and typo fixes, a few - comments deleted. - - * info/dir: deleted the Locals: line. I think it's obsolete since - the "dir" merge can put things from like-named nodes in separated - "dir" files all under one menu, which is more versatile than just - a "Locals:" section. If you still want a "Locals:" section, make - yourself a node for it. - -1997-08-07 SL Baur - - * egg/egg.el (hiragana-region): Ebola cleanup. - (katakana-region): Ditto. - -1997-08-02 Jens-Ulrik Holger Petersen - * prim/files.el (save-buffers-kill-emacs): - If there are active processes, then list them before querying if - it is ok to exit emacs. - -1997-08-01 Karl M. Hegbloom - - * efs/dired.el (dired-get-filename) Move the skipping of the - ending carriage return on NT to inside the setq so `and' won't - fail on Unix. - -1997-07-30 SL Baur - - * prim/startup.el (find-emacs-root-internal-1): Remove diagnostic. - - * prim/packages.el (packages-find-packages): Remove diagnostic. - -1997-07-27 SL Baur - - * utils/config.el (config-value-hash-table): Only store the first - occurrence of a symbol. - - * modes/make-mode.el: Remove imenu stuffs. - -Sat Jul 26 12:24:20 1997 Barry A. Warsaw - - * cc-mode/ Release 5.14 - -Sat Jul 26 16:03:33 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-styles-alist): - In "java" style, set c-hanging-comment-starter-p to - nil to preserve Javadoc starter lines. - -Fri Jul 25 22:17:07 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-beginning-of-statement-1): - When checking for bare semi, don't match - on a semi following a close brace, otherwise the following legal code - fails: - - void foo() - { - static struct Pattern nums - = {1, 2, 3}; - - int j = 2; - } - - This might break some bare semi idioms but those are probably more - rare than static initializers. - - * cc-mode/cc-vars.el (idl-mode-hook): New variable. - - * cc-mode/cc-mode.el (idl-mode): Support for CORBA's IDL language. - - * cc-mode/idl-font-lock.el: Unsupported font-lock definitions for IDL. - This should be merged in with font-lock.el - - * cc-mode/cc-mode.el (c-initialize-cc-mode): - move the calling of c-make-styles-buffer-local - into c-initialize-builtin-style. - - * cc-mode/cc-styles.el (c-set-style-2): - Fixed broken implementation of inherited styles. - - * cc-mode/cc-mode.el (c-initialize-cc-mode): - Run the c-initialization-hook, but only once - per Emacs session. - - * cc-mode/cc-vars.el (c-initialization-hook): New variable. - - * cc-mode/cc-engine.el (c-guess-basic-syntax): - CASE 5I: When adding 'inclass syntax, use the - relpos pointing to the class opening brace, unless that hangs on the - right side, in which case, use the start of the class/struct keyword. - -Thu Jul 17 03:36:22 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-symbol-key): - first character must be a letter or underscore - -1997-07-25 SL Baur - - * packages/vc.el (vc-version-diff): Autoload for the menu. - Suggested by Karl M. Hegbloom - -1997-07-24 SL Baur - - * prim/make-docfile.el (docfile-out-of-date): Workaround for NEWOS - process exit handling bug. - Suggested by Katsumi Yamaoka - -1997-07-23 Karl M. Hegbloom - - * packages/info.el: (Info-fontify-node) Allow colons in menu - names. There must be whitespace following the menu ending colon. - -1997-07-23 SL Baur - - * prim/faces.el (invert-face): Make interactive. - Suggested by David Bakhash - -1997-07-21 Karl M. Hegbloom - - * modes/view-process-system-specific.el added - `View-process-field-name-descriptions-linux', transcribed from - man 7 ps_fields. Linux signals fixed to match . - -1997-07-22 SL Baur - - * x11/x-toolbar.el (toolbar-paste-function): Add default as - option. - - * prim/minibuf.el (force-dialog-box-use): Fix typo. - From Pekka Marjola - -1997-07-21 SL Baur - - * prim/packages.el (locate-data-directory): New function to search - for directories in the data-directory-list. - -1997-07-21 Karl M. Hegbloom - - * prim/minibuf.el: New customize variable: - `minibuffer-history-uniquify' - (read-from-minibuffer) Only remove histval from list if - minibuffer-history-uniquify is t. - - * custom/custom.el: Fix typo in (defgroup) docstring. - -1997-07-21 SL Baur - - * prim/startup.el (set-default-load-path): Initialize package - paths as final step if everything else went O.K. - - * prim/help.el: Removed locate-library (moved to packages.el). - - * prim/subr.el: Removed lamda macro (moved to packages.el). - - * prim/packages.el (package-find-packages): New function. Search - package hierarchies for interesting directories. - (package-find-packages-1): Helper function for the above. Do the - searching in exactly 1 directory. - - * packages/vc.el: Add ClearCase maintainer. - -1997-07-21 Karl M. Hegbloom - - * modes/whitespace-mode.el (toplevel) Install toolbar button using - `toolbar-add-item' rather than redefining the whole default - toolbar. If the button is already there, does nothing, so a - custom toolbar containing a whitespace button can made with - `edit-toolbar' once it's been installed the first time. - -1997-07-20 SL Baur - - * utils/speedbar.el: - (speedbar-frame-mode): Autoload. - (speedbar-get-focus): Autoload. - (speedbar): Autoload (correctly). - - (speedbar-frame-width): Test liveness of frame - too. - (speedbar-frame-mode): Avoid some Emacs 20 code. - From Markus Linnala - - * prim/startup.el (find-emacs-root-internal): Search - prefix-directory directly for XEmacs installed stuffs. - - * utils/smtpmail.el (smtpmail-send-it): Autoload. - - * prim/startup.el (command-line): Put advisory text in *scratch* - at startup. - - * packages/info.el (Info-exit): Guard against deletion of only - frame. - From David Bakhash - -1997-07-19 SL Baur - - * utils/elp.el: Spelling correction. - From karlheg+xemacs@inetarena.com (Karl M. Hegbloom) - -1997-07-19 Steven L Baur - - * prim/about.el: Sundry changes. - -1997-07-18 Steven L Baur - - * packages/crypt.el (crypt-inhibit-formats): New variable. - (crypt-encoded-p): Use it. - Based on a patch by Tkil - - * utils/ring.el (ring-p): Make compatible, not obsolete. - -1997-07-16 Steven L Baur - - * utils/crontab.el (crontab-get): Check for `no crontab for' as an - error return. - Suggested by Jeff Miller - - * modes/arc-mode.el: Clean up comment. - - * packages/tar-mode.el: Clean up comments. - -Wed Jul 16 23:56:58 1997 Barry A. Warsaw - - * cc-mode/: Release 5.13. - -Thu Jul 17 03:36:22 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-symbol-key): - first character must be a letter or underscore - -Mon Jul 14 23:43:33 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-make-inherited-keymap): Change to a defun - - * cc-mode/cc-langs.el: - Added (require 'cc-defs) to pick up the definition of c-emacs-features. - - * cc-mode/README: Simplified instructions - - * cc-mode/cc-make.el: New file to aid in byte-compiling in older - Emacsen. - -Sun Jul 13 21:24:37 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el: cc-defs is required to pick up the - c-add-syntax macro - - * cc-mode/cc-langs.el (c-mode-menu): - Added uncomment region and slight rearrangement of - items - - * cc-mode/cc-cmds.el (c-electric-backspace): - Must get 'supercede property values to work - with delsel and pending-del. - -Thu Jul 10 20:46:09 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-maybe-labelp): - defvar this to shut up the byte compiler - -Wed Jul 9 22:08:58 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el (c-initialize-builtin-style): - use copy-sequence instead of copy-tree - so the cl module isn't necessary. - - * cc-mode/cc-cmds.el (c-electric-brace): - fix ebola eradication consequence in the - preserve-p test. - -1997-07-15 Steven L Baur - - * prim/about.el (xemacs-hackers): Add info about IENAGA Kazuyuki. - (about-url-alist): Ditto. - (about-maintainer-info): Ditto. - - * prim/modeline.el (add-minor-mode): Update docstring. - -1997-07-15 Hrvoje Niksic - - * packages/pending-del.el (pending-delete-mode): Use the option - symbol as argument to add-minor-mode, not its value. - -1997-07-14 Hrvoje Niksic - - * packages/pending-del.el (pending-delete-modeline-string): New - option. - -1997-07-14 Steven L Baur - - * prim/files.el (auto-mode-alist): Readd objective c mode. - From Barry A. Warsaw - - * prim/make-docfile.el: Print more informative message when - attempting to create docfile and all dumped .elcs do not exist. - -1997-07-13 Steven L Baur - - * prim/files.el (save-some-buffers): Guard call to - `delete-other-windows'. - -1997-07-13 Karl M. Hegbloom - - * prim/minibuf.el: (read-from-minibuffer) Corrected indentation, - History lists don't contain dups anymore, newest is put on top and - removed from the cdr. - -1997-07-13 Karl M. Hegbloom - - * packages/man.el: (manual-entry) Added `Manual-page- - minibuffer-history', and added it to the read-string statement. - Added #\: to `fmh' so that manuals named like MIME::Parser(3) are - found at point. - (Manual-mouseify-xrefs) Fixed it so now it will mousify the manual - entry on the first line of an apropos listing. - -1997-07-10 Karl M. Hegbloom - - * packages/info.el: Added `Info-minibuffer-history', and made it - the minibuffer history variable in the `completing-read' calls. - - * utils/savehist.el: Added `Info-minibuffer-history' to default - value of `savehist-history-variables'. - -1997-07-13 Steven L Baur - - * modes/lisp-mode.el: Restore verbosity as an option. - From Hrvoje Niksic - -1997-07-11 Hrvoje Niksic - - * prim/cmdloop.el (execute-extended-command): Use - `sorted-key-descriptions'. - - * prim/help.el (sorted-key-descriptions): New function. - (where-is): Use it. - (where-is): Use `read-command'. - - * prim/macros.el (kbd-macro-query): Use `read-char-exclusive' - instead of `read-char'. - - * prim/cmdloop.el (read-char): Correctly inhibit quit. - - * prim/files.el: Use `files' group. - - * prim/disp-table.el (describe-display-table): Made it work; don't - use `describe-vector'. - - * prim/gui.el: Customized. - - * utils/edmacro.el (insert-kbd-macro): Move to macros.el. - - * prim/macros.el: Synch with FSF 19.34. - - * prim/featurep.el: Comment addition. - - * prim/cus-start.el: Add variables from replace.el. - - * prim/replace.el (case-replace): Use `defvar', not `defconst'. - - * utils/crontab.el: Customized. - - * utils/highlight-headers.el: Define -faces as a separate group; - customize the variables. - - * utils/uniquify.el: Hide from the Customize tree; the package - changes state of XEmacs on load. - - * packages/igrep.el: Don't insinuate XEmacs when loading. - (igrep-insinuate): New function. - - * packages/blink-cursor.el (blink-cursor-callback): Don't blink on - TTY-s. - - * prim/console.el (resume-pid-console): Use `eql'. - - * prim/profile.el (profile): Restore old profiling state, instead - of blindly turning off profiling. - - * packages/add-log.el (add-log-c-like-modes): Add java-mode. - - * packages/add-log.el: Require fortran when compiling. - - * prim/device.el (device-list): Use `nconc' instead of `append'. - -1997-07-13 Steven L Baur - - * prim/files.el (save-some-buffers): Only delete other windows the - first time through. - Based on code from Hrvoje Niksic - -1997-07-12 Steven L Baur - - * prim/modeline.el (mouse-drag-modeline): Don't queue dummy eval - events. - From Kyle Jones - -1997-07-10 Hrvoje Niksic - - * packages/gnuserv.el (gnuserv-edit-files): Operate on this - buffer's menubar. - -1997-07-11 Steven L Baur - - * packages/gnuserv.el: Add done button. - From Hrvoje Niksic - -1997-07-10 Steven L Baur - - * utils/edit-toolbar.el: (edit-toolbar-file-name): Use - `emacs-user-extension-dir'. - (edit-toolbar-add-initialization): Ditto. - (edit-toolbar-prompt-for-initialization): Ditto. - - * utils/edit-toolbar.el: New file. - From Peter Pezaris - - * utils/toolbar-utils.el: New file. - From Jeff Miller - -1997-07-10 Hrvoje Niksic - - * packages/add-log.el (change-log-font-lock-keywords): Don't - fontify closing paren. - - * packages/pending-del.el: Some renamings, synch with Emacs 19.34. - -1997-07-10 Steven L Baur - - * packages/hyper-apropos.el (hyper-apropos-get-doc): Don't - autoload, there is very little point. - - * prim/obsolete.el (frame-first-window): Make compatible, not - obsolete. - -1997-07-10 Hrvoje Niksic - - * packages/pending-del.el (pending-delete-pre-hook): Don't quote - lambda. - (pending-delete-pre-hook): Use `error-message-string'. - (pending-delete): Treat as minor mode; define the standard turn-on - and turn-off functions. - (delete-active-region): Simplified. - - * packages/pending-del.el: Don't turn on by default. - -1997-07-09 Steven L Baur - - * packages/pending-del.el: Correct typo in Hrvoje's upgrade. - - * mel/mel-u.el (uuencode-external-decode-region): Force - buffer-read-only nil because it gets changed magically to t during - the call to `insert-file-contents'. - - * tm/tm-image.el (mime-preview/filter-for-image): Comment out test - for invalid glyph. It appears to be non-functional. - - * modes/lisp-mode.el (lisp-interaction-mode-popup-menu-1): Add - entry for debug on signal. - - * packages/supercite.el (sc-attribs-%@-addresses): + is valid in - an Email address. - (sc-attribs-<>-addresses): Ditto. - (sc-get-address): Ditto. - - * cc-mode/cc-cmds.el (c-electric-brace): Fix Ebola infection. - - * prim/dumped-lisp.el (dumped-lisp-packages): Tweak dump order - so "startup" is loaded before the autoloads. - - * custom/cus-edit.el (custom-file): Use same logic as startup.el - -j1997-07-08 Hrvoje Niksic - - * prim/simple.el (log-message-ignore-regexps): Reduced - significantly. - -Tue Jul 8 23:47:47 1997 Barry A. Warsaw - - * cc-mode/Release 5.12 - -Mon Jul 7 23:47:02 1997 Barry A. Warsaw - - * cc-mode/cc-styles.el, cc-mode/cc-mode.el, cc-mode/cc-menus.el, - cc-mode/cc-langs.el, cc-mode/cc-engine.el, cc-mode/cc-compat.el, - cc-mode/cc-cmds.el, cc-mode/cc-align.el: - Reorganization to support byte-recompile-directory. - - * cc-mode/Release: Don't put release number in tar file - -Thu Jul 3 22:54:03 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-mode-base-map): - Proper binding of c-electric-backspace and - c-electric-delete, based on the policy of the various maintainers. - Thank goodness for delete-key-deletes-forward! - - * cc-mode/cc-vars.el (c-tab-always-indent, c-hanging-braces-alist): - Minor changes to the cutomize format. - - * cc-mode/cc-mode-19.el: Initial revision - - * cc-mode/cc-menus.el, cc-mode/cc-engine.el, cc-mode/cc-compat.el, - cc-mode/cc-cmds.el, cc-mode/cc-align.el: - Major Ebola eradication. - -Wed Jul 2 21:33:04 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-crosses-statement-barrier-p, - c-guess-basic-syntax): Ebola eradication. - - * cc-mode/cc-cmds.el (c-indent-region): - Call c-echo-parsing-error to echo last parsing - error that may have occurred. - - * cc-mode/cc-engine.el (c-echo-parsing-error): New function. - - * cc-mode/cc-engine.el (c-parsing-error): new variable - - (c-parse-state): When an unbalanced close brace is discovered, don't - raise an error (prevents insertion of character). Insert the - character, display a warning message, and set c-parsing-error so - syntax echoing will be disabled. - - (c-show-syntactic-information, c-indent-line): Suppress syntax echoing - if c-parsing-error is non-nil. - - * cc-styles.el: Added require of cl to pick up definition of copy-tree. - -Mon Jun 30 21:41:00 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el, cc-mode/cc-mode.el (c-mode-map, - c++-mode-map, objc-mode-map, java-mode-map): - Moved - defvars from cc-langs.el to cc-mode.el for use in c-mode, c++-mode, - objc-mode, and java-mode docstrings. Actual population of these mode - maps remains in cc-langs.el. - - * cc-mode/cc-mode.el: - Require cc-langs at top level, so as to get the definitions for - c-mode-map, et al. that are used in the *-mode docstrings. - -Fri Jun 27 17:33:32 1997 Barry A. Warsaw - - * cc-mode/cc-langs.el (c-mode-syntax-table): - Added autoload cookie for gdb-mode. - -Thu Jun 26 21:12:56 1997 Barry A. Warsaw - - * cc-mode/cc-engine.el (c-guess-basic-syntax): - CASE 5H: Whack one ebola infection (e.g. using - memq with the results of following-char in XEmacs 20). - - * cc-mode/cc-styles.el: - Added two require's that make autoload call of (c-set-style) work. - -Sun Jun 22 16:40:30 1997 Barry A. Warsaw - - * cc-mode/cc-cmds.el (c-electric-delete): - Don't call c-electric-backspace interactively. - -Fri Jun 20 20:40:33 1997 Barry A. Warsaw - - * cc-mode/cc-mode.el (c-mode, c++-mode, objc-mode, java-mode): - Make sure to call - c-update-modeline after the hooks are run, so that the modeline - accurately reflects auto-newline and delete-key minor modes if the - hooks set c-hungry-delete-key or c-auto-newline directly. - - * cc-align.el (c-lineup-java-throws): Fixed some regressions. -1997-07-08 Steven L Baur - - * packages/func-menu.el: Don't enable Makefile mode function menu - by default. - From Martin Buchholz - - * x11/x-menubar.el (file-menu-filter): Delete Frame should be - active when multiple frames span multiple devices. - From Aki Vehtari - -1997-07-08 Hrvoje Niksic - - * packages/gnuserv.el: Remove RCS ID keywords. - - * utils/savehist.el: Cosmetic changes. Hopefully, not - user-visible. - - * prim/debug.el (debug-convert-byte-code): Use compiled-function - accessor functions. - -1997-07-08 Steven L Baur - - * modes/hideif.el (hide-ifdef-mode): Include modemap in call to - `add-minor-mode'. - -1997-07-08 Tomasz Cholewo - - * packages/add-log.el: Require add-log for accessing - add-log-mailing-address and add-log-full-name variables. - -1997-07-08 Steven L Baur - - * bytecomp/disass.el (disassemble-1): Use functional interface - instead of indexing into vector. - From Hrvoje Niksic - - * prim/startup.el (emacs-user-extension-dir): New variable. - (load-user-init-file): Use it. .xemacs and .xemacs-custom are - moved into `emacs-user-extension-dir' and renamed to init.el and - options.el respectively. - - * prim/packages.el (packages-hardcoded-lisp): Remove "startup" - since it is mentioned in dumped-lisp.el. - - * cl/cl-macs.el (keymap-name): New defsetf. - (keymap-prompt): Ditto. - (keymap-default-binding): Ditto. - From Hrvoje Niksic - -1997-07-07 Karl M. Hegbloom - - * packages/dabbrev.el: replace `buffer-substring' with - `buffer-substring-no-properties' so that unwanted text - properties (like read-only) are stripped from inserted - dabbrev expansions. - -1997-07-08 Steven L Baur - - * comint/comint.el (comint-replace-by-expanded-history): Change - buggy history test regexp. - From Simon Marshall (Emacs/Mule zeta) - -1997-07-07 Steven L Baur - - * oobr/br-clos-ft.el (clos-scan-routine-arglist): Don't reference - bytecode object as vector. - - * hypberbole/hact.el (action:commandp): Don't reference bytecode - objects as vectors. - (action:params): Ditto. - - * hyperbole/hypb.el (hypb:function-copy): Don't reference byte - code objects as vectors. - (hypb:function-symbol-replace): Document as broken. The - substition cannot be done without some thinking I'm not in the - mood for. - - * efs/efs-ovwrt.el (efs-overwrite-fn): Attempt to correctly deal - with the interactive spec. - - * packages/apropos.el (apropos-safe-documentation): Use - `compiled-function-doc-string' instead of referencing a bytecode - object as an array. - - * prim/subr.el (buffer-substring-no-properties): Undo previous - change removing extents. set-text-properties works now. - From Hrvoje Niksic - - * packages/hyper-apropos.el (hyper-apropos-get-doc): Get the - argument list through a function instead of indexing into - bytecode. - - * utils/easymenu.el (easy-menu-add): Oops, wrong sense in - comparison. - - * comint/gdb.el (gdb-mode-syntax-table): New variable. Initialize - with the logic currently in CC Mode 5.11. - (gdb-mode): Use it. - - * modes/hideif.el (hide-ifdef-mode-submap): Correctly specify the - current local map. - -1997-07-08 MORIOKA Tomohiko - - * language/english.el: Add quail-british for British. - - * language/european.el: Register input-method for various non - quail-latin-1 methods. - -1997-07-06 Steven L Baur - - * prim/cmdloop.el (errors-deactivate-region): Default to no error - behavior for beta testing. - - * prim/dumped-lisp.el (dumped-lisp-packages): Reenable dumping - winnt.elc with MS Windows NT version of XEmacs. - -1997-07-05 Steven L Baur - - * comint/shell.el ((not shell-mode-map)): M-RET conflicts with - Hyperbole binding. - - * comint/comint.el (comint-mode): Use easymenu for making menus. - (comint-popup-menu): Use mode-popup menu instead of private menu. - - * efs/dired.el (toplevel): Do not string test version against - "Lucid". - - * prim/obsolete.el (add-menu): Don't make obsolete. - - * utils/easymenu.el (easy-menu-remove): Do something neater when - only one buffer menu is in effect. - (easy-menu-add): Ditto. - - * prim/dumped-lisp.el (dumped-lisp-packages): easymenu will be - dumped with XEmacs. - - * utils/easymenu.el (easy-menu-define): Don't autoload. - - * modes/lisp-mode.el (toplevel): Rename menu descriptors. - (emacs-lisp-mode): Use easy-menu-define/easy-menu-add to add menus. - (lisp-interaction-mode): Ditto. - -1997-07-04 Steven L Baur - - * prim/cmdloop.el (errors-deactivate-region): Default to existing - behavior. - - * leim/quail.el (quail-mode): Correct addition of quail minor mode - info to minor-mode-map-alist. - (top-level): Ditto. - -1997-06-30 Hrvoje Niksic - - * modes/abbrev.el (define-mode-abbrev): Call `define-abbrev' with - correct arguments. - -1997-07-04 Hrvoje Niksic - - * prim/minibuf.el (read-from-minibuffer): Initialize - `current-minibuffer-contents', `current-minibuffer-point', and - `initial-minibuffer-history-position'. - (next-history-element): Use them. - (previous-matching-history-element): Ditto. - -1997-07-04 Steven L Baur - - * prim/cus-load.el (custom-put): New alias for overloadable - function. - -1997-07-03 Steven L Baur - - * utils/autoload.el (batch-update-directory): Fix typo. - (update-autoloads-from-directory): Avoid scanning custom-load.el - and auto-autoload.el files. - (batch-update-autoloads): Remove duplicate status message. - (autoload-snarf-defcustom): Keep track of what symbols we have - attached property lists to. - - * ilisp/Makefile (autoloads): Add autoloads dependencies. - - * hyperbole/Makefile: Add autoloads dependencies. - - * utils/autoload.el (batch-update-autoloads): Load custom-load - prior to updating autoloads. - - * cc-mode/Makefile (autoloads): New targets to automatically - rebuild autoloads and custom-loads. - -1997-07-02 Steven L Baur - - * auctex/Makefile (autoloads): New targets to automatically - rebuild autoloads and custom-loads. - - * utils/autoload.el (batch-update-autoloads): Add new parameter, - update DOC string. - - * comint/gdb.el (gdb-mode): Semantics of c-mode-syntax-table have - changed. - -1997-07-01 Steven L Baur - - * x11/x-menubar.el: bookmark submenu beautification -- This will - make it look better (and will prevent some consing, but that's - being anal). - From Hrvoje Niksic - - * prim/simple.el (delete-key-deletes-forward): Mark docstring as - an user option. - From Gary D. Foster - - * mel/mel-q.el (q-encoding-encode-string): Fix Ebola-ified - comparison. - - * efs/efs-ovwrt.el (efs-overwrite-fn): efs is manufacturing its - own byte code. Whee. - * utils/advice.el (ad-interactive-form): Don't treat bytecode as a - vector if it can be avoided. - From Kyle Jones - -1997-06-30 Steven L Baur - - * prim/files.el (auto-mode-alist): Don't set image-mode by default - on xpms. - -Sun Jun 29 20:57:15 1997 Kyle Jones - - * prim/simple.el: bind inhibit-read-only to t before - trying to erase or otherwise modify the echo area buffer. - -1997-07-01 MORIOKA Tomohiko - - * modes/image-mode.el: Add `image-maybe-restore' to - `change-major-mode-hook'. - - * modes/image-mode.el (image-maybe-restore): New function. - -1997-06-29 Hrvoje Niksic - - * modes/abbrev.el (define-mode-abbrev): Would ignore EXPANSION. - -1997-06-28 Hrvoje Niksic - - * modes/abbrev.el (define-abbrev): If NAME contains a non-word - character, intern a ` ' symbol in the obarray. - -1997-06-29 Steven L Baur - - * prim/files.el (auto-mode-alist): Set image-mode for various - image file names (JPEG, GIF, PNG, and xpm). - -Sun Jun 29 03:02:10 1997 Kyle Jones - - * src/undo.c (record_extent): - If the extent's object is a string, just return. We - can't record undo information for strings, and it is - very bad to reference through a string pointer as if it - were a buffer pointer. - -1997-06-28 Steven L Baur - - * utils/delbs.el: Removed as obsolete. - Suggested by Gary D. Foster - - * packages/hyper-apropos.el (hyper-apropos-documentation): Remove - obsolete alias. - (hyper-apropos-hyperlink): Ditto. - (hyper-apropos-major-heading): Ditto. - (hyper-apropos-section-heading): Ditto. - (hyper-apropos-heading): Ditto. - (hyper-apropos-warning): Ditto. - From Hrvoje Niksic - - * prim/simple.el (show-message-log): Restore an oldie-but - prematurely-retired-goodie. - - * x11/x-menubar.el (default-menubar): Restore Show Message Log - command in Edit menu. - - * mule/mule-util.el: Change defsubst to defun for - string-to-sequence, string-to-list, string-to-vector, - nested-alist-p to shut up build time diagnostics. - - * prim/loadup.el (Top level): Added instrumentation to diagnose - where the 0 property list is getting added at dump. Naturally, I - cannot reproduce the problem now. - - * modes/abbrev.el (define-abbrev): Trap nil tables (which might - cause bogus plists to get put into obarray). - Fix docstring. - -1997-06-27 Hrvoje Niksic - - * modes/auto-show.el: Customized. - -1997-06-27 Steven L Baur - - * prim/make-docfile.el: [oops] Check auto-autoloads.elc for - out-of-dated-ness too. - - * utils/autoload.el (batch-update-directory): Kill command line - args when done. - (autoload-save-customization): Print a warning message with the - offending symbol when we run across the elusive malformed property - list ((0 0)). - -1997-06-26 Hrvoje Niksic - - * prim/profile.el (profile-key-sequence): New function. - (pretty-print-profiling-info): Allow interactive calls. - - * prim/overlay.el: Make more FSF compatible. - -1997-06-27 Steven L Baur - - * prim/loaddefs.el (debug-ignored-errors): Fix regexps. - From Hrvoje Niksic - - * hyperbole/wrolo-menu.el (TopLevel): Fix tests so that W3's - id-menubar simulation doesn't bollux up feature tests. - - * prim/about.el (about-xemacs): Adjust planned release date. - -1997-06-26 Steven L Baur - - * prim/cus-load.el: Use correct load name. - - Silence the load messages. - - * mule/mule-util.el (string-to-sequence): Spelling correction. - - * prim/make-docfile.el: Don't overwrite DOC file when it is - up-to-date. - -1997-06-29 MORIOKA Tomohiko - - * language/chinese.el: Add chinese-isoir165 (CCITT Extended GB). - - * language/chinese.el: Modify charset DOC-strings for CNS 11643 to - be more detailed. - - * language/arabic.el: (require 'language/arabic-util) instead - of (require 'arabic) for Arabic environment. - - * language/arabic-util.el: Provide `language/arabic-util' instead - of `arabic'. - - * language/arabic.el: Rename `arabic-0', `arabic-1' and `arabic-2' - to `arabic-digit', `arabic-1-column' and `arabic-2-column' to sync - with Emacs/mule-19.34.94-zeta. - - * tl/char-table.el (char-position-to-string): Use `defsubst'. - (char-table-1): New implementation. - - Use BOX DRAWINGS characters of JIS X0208. - -1997-06-28 MORIOKA Tomohiko - - * apel/richtext.el: Add autoload comments for `richtext-encode' - and `richtext-decode'. - - * prim/format.el (format-alist): Add `text/richtext'. - - * modes/image-mode.el (image-decode): Display description for some - commands when XEmacs cannot decodes current buffer as inline - image. - - * tl/chartblxmas.el: New file. - - * tl/char-table.el (view-charset): Use `view-buffer'. - - * x11/x-menubar.el (default-menubar): Add "Show character table" - for MULE menu. - - * apel/emu.el: Check richtext.el is bundled. - - * tl/char-table.el: Use `charset-doc-string' directly. - - * tl/char-table.el (view-charset): New command. - - * tl/char-table.el: `show-char-table' -> `insert-charset-table'. - - * tl/char-table.el: `show-96x96-table' -> - `insert-96x96-charset-table'. - - * tl/char-table.el: `show-94x94-table' -> - `insert-94x94-charset-table'. - - * tl/char-table.el: `show-96-table' -> `insert-96-charset-table'. - - * tl/char-table.el: `show-94-table' -> `insert-94-charset-table'. - - * tl/char-table.el: Use `insert'. - - * packages/hexl.el (hexl-mode-exit): Run `hexl-mode-exit-hook'. - - * x11/x-menubar.el (default-menubar): Fix "Describe language - support" and "Set language environment" of mule menu. - - * apel/file-detect.el: Add autoload comments for function - `add-path', `add-latest-path', `get-latest-path', - `file-installed-p', `exec-installed-p', `module-installed-p' and - variable `exec-suffix-list'. - - * prim/format.el (format-alist): Add image/jpeg, image/gif, - image/png and image/x-xpm. - - * modes/image-mode.el: New file. - -1997-06-27 MORIOKA Tomohiko - - * tm/tm-ew-e.el (tm-eword::encode-string-1): avoid infinite loop - caused by long non-encoded-word element. (cf. [tm-en:1356]) - - (mime/field-encoding-method-alist): Add "Message-ID" as ignored. - -1997-06-25 Steven L Baur - - * x11/x-menubar.el(default-menubar): Comment out changes to the - Mule menu because they bombed after recompilation. - - * packages/hyper-apropos.el - (hyper-apropos-toggle-programming-flag): Use `with-current-buffer' - instead of `eval-in-buffer'. - - * term/sun-mouse.el: Remove bogus redefinition of - `eval-in-buffer'. - (sun-mouse-handler): Use with-current-buffer instead of - `eval-in-buffer'. - - * prim/make-docfile.el: Use princ not print. - Suggested by Hrvoje Niksic. - - * packages/info.el (Info-select-node): Desensitive case search for - Note:. - (Info-next-reference): Ditto. - * prim/simple.el (kill-region): Adjust endpoints of extent to - test and deal with case of the end being less than the beginning. - * prim/cmdloop.el (teach-extended-commands-timeout): Bump value to 4. - From Hrvoje Niksic - - * prim/subr.el (eval-in-buffer): Make obsolete. - Suggested by Hrvoje Niksic. - - * packages/hyper-apropos.el (hyper-apropos-faces): Change group to - 'faces. - Suggested by Per Abrahamsen. - -1997-06-23 Hrvoje Niksic - - * prim/cmdloop.el (execute-extended-command): Print message after - the command finishes, and restore old echo-area contents. - - - Get keybinding before command is executed. - Suggested by Kyle Jones and Steve Baur. - -1997-06-24 Steven L Baur - - * packages/gnuserv.el: Make old symbols Obsolete. - From Hrvoje Niksic - - * prim/cmdloop.el (keyboard-quit): Don't kill zmacs-region in - minibuffer. - * prim/minibuf.el (minibuffer-keyboard-quit): Ditto. - From Hrvoje Niksic - - * prim/help.el (help-mode-quit): Bury buffer when quitting. - From Hrvoje Niksic - -1997-06-24 Hrvoje Niksic - - * prim/cmdloop.el: Customize `teach-extended-commands-p' and - `teach-extended-commands-timeout'. - -1997-06-23 Steven L Baur - - * version.el (emacs-version): Synch with InfoDock 4.0. - (emacs-version): Ditto. - -Mon Jun 23 12:33:52 1997 Per Abrahamsen - - * about.el (about-show-linked-info): Use empty strings for - `widget-link-prefix' and `widget-link-suffix'. - -1997-06-22 Gary D. Foster - - * x11/x-menubar.el: Added `bookmark-menu-filter', changed - bookmark submenu from a popup to a cascading submenu. - * packages/bookmark.el: Added an autoload cookie for - `bookmark-all-names' (by Steve Baur) - -1997-06-23 Hrvoje Niksic - - * packages/info.el (Info-next-reference): Fix up for M-TAB to work - correctly. - - * utils/live-icon.el (live-icon-one-frame): Don't set glyphs to - balloon-help frames. - - * packages/balloon-help.el (balloon-help-make-help-frame): Set the - `balloon-help' property to the newly created frame. - - * prim/profile.el (profile): New macro. - - * prim/files.el (auto-mode-alist): Add winmgr-mode. - - * modes/winmgr-mode.el: Customize. - -1997-06-23 Steven L Baur - - * utils/autoload.el (generate-file-autoloads-1): Remove warning - about 900 character lines. - - * x11/x-toolbar.el (toolbar-mail-commands-alist): Correction for - calling Netscape mail. - From Hrvoje Niksic - -1997-06-22 Steven L Baur - - * x11/x-menubar.el (default-menubar): Make `Jump to bookmark' menu - dynamic. - From Gary D. Foster - - * prim/dumped-lisp.el (dumped-lisp-packages): Sparcworks dumps - comint and ring. - -1997-06-24 MORIOKA Tomohiko - - * language/arabic.el: moved from mule/arabic-hooks.el. - - * mh-e/mh-e.el (mh-get-new-mail): Decode output as - `mh-folder-coding-system'. - -1997-06-24 MORIOKA Tomohiko - - * language/ethio-util.el: imported from Emacs/mule-19.34.94-zeta. - - * language/arabic-util.el: moved from mule/arabic.el; repair - Arabic characters. - -1997-06-24 MORIOKA Tomohiko - - * x11/x-menubar.el: Fix "Describe language support" and "Set - language environment" of Mule menu. - - * language/visual-mode.el: moved from mule/. - - * language/ethiopic.el: Modify for XEmacs. - - * language/cyrillic.el: Modify DOC-string of koi8-r; Fixed problem - of setting for `language-info-alist' about koi8-r. - - * mule/auto-autoloads.el: Enable auto-autoloads.el for mule/. - - * mule/mule-util.el: New file (imported from - Emacs/mule-19.34.94-zeta). - - * mule/mule-misc.el: Function `truncate-string-to-width' was moved - to mule-util.el. - - * prim/dumped-lisp.el, mule/mule-load.el: mule/arabic-hooks.el was - moved to language/arabic.el; mule/arabic.el was moved to - language/arabic-util.el; Use language/ethiopic.el instead of - mule/ethiopic-hooks.el; Use language/ethio-util.el instead of - mule/ethiopic.el. - - * mule/mule-coding.el (coding-system-docstring): New alias (to - emulate Emacs/mule-19.34.94-zeta function). - - * mule/mule-cmds.el: modified to sync with - Emacs/mule-19.34.94-zeta (mule-prefix was changed to "C-x C-m") - - (set-language-info): Add to "Describe Language Support" and "Set - Language Environment" menu. - - * mule/mule-charset.el: Function `compose-region' and - `decompose-region' were moved to mule-util.el. - - * leim/quail.el: modify to sync with latest quail.el of Emacs/mule - in ETL. - - (quail-toggle-mode-temporarily): check `quail-conv-overlay'. - - (quail-map-p): Use `characterp' instead of `integerp'. - -1997-06-21 Steven L Baur - - * prim/tabify.el (untabify): Return nil. - From contributor name lost. - - * prim/packages.el (packages-hardcoded-lisp): startup.elc needs to - be scanned for docstrings. - -1997-06-21 Hrvoje Niksic - - * packages/bookmark.el (bookmark-menu-popup-paned-menu): Change - title to name. - * prim/overlay.el (overlay-put): Support `local-map'. - (overlay-get): Support `category'. - -1997-06-21 Steven L Baur - - * prim/startup.el (load-user-init-file): Load custom-file if it - has not changed from the default. - -1997-06-21 Hrvoje Niksic - - * prim/overlay.el (make-overlay): Avoid temporary variable. - (move-overlay): Ditto. - (overlays-in): Use `mapcar-extents'. - (next-overlay-change): Avoid consing; use `map-extents'. - (previous-overlay-change): Ditto. - (overlay-lists): Ditto. - (overlay-lists): Call `overlay-recenter' with correct value. - -1997-06-20 Steven L Baur - - * utils/autoload.el (fixup-autoload-buffer): New function. Insert - guards so a (load "auto-autoloads") works the same as require. - (batch-update-directory): Use it. - - * prim/update-elc.el: Allow for specification of packages that - must not be bytecompiled. Better error diagnostics if a package - is not found. - - * prim/window.el, prim/window-xemacs.el, prim/simple.el: - * prim/lisp.el, prim/frame.el: - Customizations/synch to Emacs 20.1. - * packages/hyper-apropos.el: Massive update. - From Hrvoje Niksic - - * tm/tm-vm.el (vm-menu-mail-menu): Fix typo. - - * packages/font-lock.el (lisp-font-lock-keywords-2): Add some new - functions. - From Karl M. Hegbloom - - * prim/files.el (save-some-buffers-query-display-buffer): New - user variable. - (save-some-buffers): Use it. - From David Bakhash - - Customization patches from Hrvoje Niksic. - - * prim/simple.el (kill-region): Undo sorting region limits patch. - -1997-06-20 Mike Scheidler - - * prim/tabify.el: Fixed 'untabify' to return 'nil value. - -1997-06-18 Steven L Baur - - * efs/dired-xemacs.el (dired-do-interactive-chmod): Advance point - after not failure. - From - - * utils/edmacro.el (edmacro-parse-word): make (kbd "M-123"), (kbd - "M--256") and such behave as documented. - From Hrvoje Niksic - - * prim/cus-start.el: Various additions to built-in variable list. - From Hrvoje Niksic - - * prim/subr.el: Remove mapvector. - (with-output-to-string): Use with-current-buffer. - (with-string-as-buffer-contents): Ditto. - From Hrvoje Niksic - - * modes/arc-mode.el (archive-quit): New function. - From Karl M. Hegbloom - (archive-mode-map): Bind it to `q'. - - * utils/autoload.el (cusload-file-name): Default to custom-load.el - for each individual file. - - * prim/minibuf.el (minibuffer-max-depth-exceeded): Use - `custom-file' as a location for saving enable multiple minibuffers - option. - - * packages/man.el (manual-entry): Don't leave empty buffer if - error occurs. - From Glynn Clements - - * modes/arc-mode.el (archive-arc-summarize): De-ebolify. - (archive-lzh-summarize): Ditto. - (archive-zip-summarize): Ditto. - (archive-zip-chmod-entry): Ditto. - -1997-06-17 Steven L Baur - - * prim/update-elc.el: Total rework for dynamic dumped .elc finding. - -1997-06-18 Hrvoje Niksic - - * prim/loaddefs.el (debug-ignored-errors): Initialize it. - -1997-06-17 Steven L Baur - - * prim/files.el (auto-mode-alist): Add /app-defaults/ as candidate - for xrdb-mode. - Suggested by Karl Hegbloom, Regexp by David Moore. - - * version.el: Remove variables emacs-version, emacs-major-version, - and emacs-minor-version. - - * tooltalk/tooltalk-load.el: Comment as obsolete and move contents - to dumped-lisp.el. - - * prim/make-docfile.el: New file. - -1997-06-16 Steven L Baur - - * prim/startup.el (load-user-init-file): Look for ~[user]/.xemacs - before loading .emacs. - - * modes/xrdb-mode.el (xrdb-mode): Autoload. - - * prim/files.el (auto-mode-alist): Add defaults for xrdb-mode. - - * leim/quail.el (quail-toggle-mode-temporarily): Guard against - possibility of quail-conv-overlay not being an overlay. - -1997-06-15 Steven L Baur - - * prim/loadup.el: Remove most but not all of the hardcoded dumped - lisp file names. - - * prim/dumped-lisp.el: New file. - - * prim/update-elc.el (toplevel): Rework using a better function to - determine autoload file locations. - - * prim/packages.el: New file. - - * prim/update-elc.el: Determine location and count of - auto-autoloads files at run-time. - - * prim/loaddefs.el (((dir load-path))): Generalize load of - auto-autoloads. - - * utils/autoload.el (autoload-file-name): New variable. - (autoload-target-directory): New variable. - (generated-autoload-file): Use them. - (cusload-file-name): New variable. - (generated-custom-file): Use it. - (batch-update-directory): New function. - -1997-06-14 Steven L Baur - - * mule/canna.el: Guard call to function dynamic-link, which - doesn't exist in XEmacs/Mule. - - * bytecomp/bytecomp.el (byte-compile-file): Suppress unavoidable - Ebola notices. - -1997-06-13 Steven L Baur - - * bytecomp/bytecomp.el (batch-byte-compile): Suppress unavoidable - Ebola notices. - (batch-byte-recompile-directory): Ditto. - - * utils/lib-complete.el (read-library): Look for .el.gz if not - using Mule. - (get-library-path): Ditto. - Suggested by Jonathan Doughty - - * packages/add-log.el: Restore backwards compatible date behavior - as an option. - Eliminate XEmacs specific autoloads. - From Hrvoje Niksic - - * efs/dired.el (dired-save-excursion): Ebola cleanup. - - * packages/hyper-apropos.el: Massive cleanup, Customize. - From Hrvoje Niksic - -Fri Jun 13 13:20:39 1997 Kyle Jones - - * prim/syntax.el (symbol-near-point): - Check for bobp and avoid (char-syntax (char-before)) if - there. - -1997-06-13 Steven L Baur - - * prim/rect.el (operate-on-rectangle): Correct boundary error. - From Bob Weiner - -1997-06-12 Steven L Baur - - * packages/ispell.el (ispell-command-loop): De-Ebolify. - - * x11/x-iso8859-1.el: Added Grave keysym. - From Heiko Muenkel - - * modes/make-mode.el (makefile-browse): Shouldn't be interactive. - From Hrvoje Niksic - - * prim/files.el (interpreter-mode-alist): ksh-mode is obsoleted by - sh-script. - From Hrvoje Niksic - -1997-06-11 Hrvoje Niksic - - * prim/subr.el (with-current-buffer): New macro. - (with-temp-file): Ditto. - - * bytecomp/byte-optimize.el (byte-optimize-form-code-walker): Test - for `save-current-buffer'. - - * bytecomp/bytecomp.el: Recognize `save-current-buffer'. - - * edebug/edebug.el: Register with-current-buffer and others. - - * modes/lisp-mode.el: Added specs for save-current-buffer, - with-output-to-string, with-current-buffer, with-temp-file and - with-output-to-temp-buffer. - -1997-06-13 MORIOKA Tomohiko - - * gnus/smiley.el (smiley-deformed-regexp-alist): Modify regexp for - horizontal smiley faces. - (smiley-nosey-regexp-alist): Add horizontal smiley faces. - -1997-06-13 MORIOKA Tomohiko - - * leim/quail.el (quail-get-translation): Don't use - `string-to-vector' for XEmacs. - -1997-06-11 Steven L Baur - - * prim/help.el (function-called-at-point): Use char-(after|before) - instead of (following|preceding)-char. - (variable-at-point): Ditto. - - * prim/simple.el (delete-indentation): Use char-(after|before) - instead of (following|preceding)-char. - (just-one-space): Ditto. - (backward-delete-char-untabify): Ditto. - (do-auto-fill): Ditto. - - * prim/paragraphs.el (end-of-paragraph-text): Use char-before - instead of preceding-char. - - * prim/misc.el (copy-from-above-command): Use char-(after|before) - instead of (following|preceding)-char. - - * prim/obsolete.el (preceding-char): Correct a typo. - - * prim/minibuf.el (minibuffer-electric-slash): Use char-(after|before) - instead of (following|preceding)-char. - (minibuffer-electric-tilde): Ditto. - - * prim/lisp.el (insert-parentheses): Use char-(after|before) - instead of (following|preceding)-char. - - * prim/indent.el (tab-to-tab-stop): Use char-(after|before) - instead of (following|preceding)-char. - (move-to-tab-stop): Ditto. - - * prim/fill.el (fill-end-of-sentence-p): Use - char-after/char-before instead of following-char/preceding-char. - (canonically-space-region): Ditto. - (fill-region-as-paragraph): Ditto. - (fill-region): Change (= char char) to (eq char char). - - * prim/debug.el (debugger-frame-number): Use char-after not - following-char. - (debugger-frame): Ditto. - (debugger-frame-clear): Ditto. - - * prim/case-table.el (invert-case): Use char-after not - following-char. - Clean up comments. - - * prim/syntax.el (symbol-near-point): Use char-before not - preceding-char. - - * prim/window.el (window-list): Update DOCstring. - From Noah Friedman - - * utils/uniquify.el (toplevel): Make version test match XEmacs v20. - - * tm/tm-ew-e.el: Clean up Ebola infection. - - * x11/x-compose.el: Various corrections - From Heiko Muenkel - -1997-06-10 Gary D. Foster - - * modes/view-less.el: Changed \177 bindings to 'delete - * modes/help.el: Changed \177 bindings to 'delete - -1997-06-10 Gary D. Foster - - * prim/keydefs.el: Changed all 'delete key bindings to point to - the `backward-or-forward-foo' functions. - * prim/simple.el: - - Renamed `delete-erases-forward' to `delete-key-deletes-forward'. - - Removed `backspace-or-delete-hook' - - Renamed `backspace-or-delete' to `backward-or-forward-delete-char' - - Added functions: `backward-or-forward-kill-word' - `backward-or-forward-kill-sentence' - `backward-or-forward-kill-sexp' - - Removed the zmacs hacks from all the `b-or-f-foo' functions and - began playing nicely with pending-del. - * modes/cc-mode.el: - * modes/cperl-mode.el: Fixed references to delete functions - to use the new names. - -1997-06-11 Karl M Hegbloom - - * ilisp/ilisp-def.el (toplevel): Changed `ilisp-prefix' from - "C-z" to "C-c" because of conflict with global key binding for - `iconify-frame'. - -1997-06-11 Steven L Baur - - * prim/window.el (window-list): New function. - Suggested by Noah Friedman - Modified by Hrvoje Niksic - - * utils/mail-extr.el (mail-extract-address-components): Replace - preceding-char with char-before. - - * utils/passwd.el (read-passwd-map): Clean up Ebola BS. - -1997-06-10 Steven L Baur - - * packages/supercite.el (sc-attribs-extract-namestring): Clean up - Ebola -- replace literal 32 with `?\ '. - - * utils/mail-extr.el (mail-extr-voodoo): Clean up Ebola -- replace - `following-char' with `char-after'. - -1997-06-10 Hrvoje Niksic - - * prim/subr.el (split-string): Make PATTERN optional. - -1997-06-11 MORIOKA Tomohiko - - * mule/language/misc-lang.el, mule/mule-load.el, - mule/ipa-hooks.el: Use lisp/mule/language/misc-lang.el instead of - lisp/mule/ipa-hooks.el; mule/ipa-hooks.el was deleted. - -1997-06-10 MORIOKA Tomohiko - - * mule/language/thai-util.el, mule/thai.el: Use - lisp/mule/language/thai-util.el instead of lisp/mule/thai.el; - lisp/mule/thai.el was deleted. - - * custom/wid-edit.el: Add widget `coding-system' for mule. - - * mule/thai-hooks.el, mule/mule-load.el: Use - lisp/mule/language/thai.el instead of lisp/mule/thai-hooks.el; - lisp/mule/thai-hooks.el was deleted. - - * mule/language/thai.el: modified for XEmacs. - -1997-06-09 MORIOKA Tomohiko - - * mule/language/misc-lang.el, mule/language/thai-util.el, - mule/language/thai.el, mule/language/tibetan.el, - mule/language/vietnamese.el, mule/language/japan-util.el, - mule/language/japanese.el, mule/language/korean.el, - mule/language/lao-util.el, mule/language/lao.el, - mule/language/english.el, mule/language/ethiopic.el, - mule/language/european.el, mule/language/greek.el, - mule/language/hebrew.el, mule/language/indian.el, - mule/language/chinese.el, mule/language/cyrillic.el, - mule/language/devanagari.el, mule/language/china-util.el: imported - from Emacs/mule-19.34.94-zeta. - - * mule/mule-load.el, mule/chinese-hooks.el, mule/chinese.el, - mule/cyrillic-hooks.el, mule/european-hooks.el, - mule/greek-hooks.el, mule/japanese-hooks.el, mule/korean-hooks.el: - chinese-hooks.el, chinese.el, cyrillic-hooks.el, - european-hooks.el, greek-hooks.el, japanese-hooks.el and - korean-hooks.el were deleted. - -1997-06-08 MORIOKA Tomohiko - - * apel/emu-x20.el (mime-charset-coding-system-alist): iso-8859-1, - hz-gb-2312, cn-gb-2312, gb2312, cn-big5 and koi8-r were defined as - coding-system. - -1997-06-09 Steven L Baur - - * prim/keydefs.el, modes/cc-mode.el, modes/cperl-mode.el, - vm/vm-vars.el: - Change usage of \177 to use keysym 'delete. - From Gary D. Foster - - * packages/etags.el (tags-loop-scan): Don't pass a straight string - to error as a format string. - Reported by Miles Duke - - * its/its-kata.el ((require 'egg)): Needed for bytecompilation. - - * its/its-hira.el ((require 'egg)): Needed for bytecompilation. - - * bytecomp/bytecomp.el (byte-compile-two-args-19->20): Correct an - ebolifaction. - From Kyle Jones - -1997-06-08 Steven L Baur - - * prim/files.el (auto-mode-alist): Restore bash regexps. - From "Barry A. Warsaw" - -1997-06-05 Steven L Baur - - * packages/jka-compr.el (jka-compr-write-region): Use 'binary - coding-system for compression. - Suggested by Katsumi Yamaoka - -1997-06-04 Gary D. Foster - - * modes/cc-mode.el: Modified `c-electric-delete' to honor the - desired delete direction in both normal and "hungry" modes. - * modes/cperl-mode.el: Modified `cperl-electric-backspace' to - honor the desired delete direction. - -1997-06-03 MORIOKA Tomohiko - - * x11/x-menubar.el (default-menubar): Add menu for Mule. - - * mule/mule-cmds.el: Menu for XEmacs were moved to - x11/x-menubar.el. - -1997-06-03 MORIOKA Tomohiko - - * leim/quail.el: to avoid compiling warnings about overlay.el. - -1997-05-16 Gary D. Foster - - * prim/simple.el: Created `backspace-or-delete' function and - `backspace-or-delete-hook' - * prim/keydefs.el: Changed \177 bindings to point to new - delete function. - * modes/*.el: Removed conflicting \177 bindings. - * modes/cc-mode.el: Modified `c-electric-delete' to use new - delete bindings. - * modes/cperl-mode.el: Modified `cperl-electric-backspace' to - use new delete bindings. - -1997-06-03 MORIOKA Tomohiko - - * leim/quail.el: to sync with quail.el of Emacs-19.34.94-epsilon. - - * leim/quail/ziranma.el, leim/quail/tonepy.el, leim/quail/py.el, - leim/quail/qj.el, leim/quail/sw.el, leim/quail/ccdospy.el, - leim/quail/punct.el, leim/quail/4corner.el, - leim/quail/symbol-ksc.el, leim/quail/ethiopic.el, - leim/quail/hanja.el, leim/quail/quick-cns.el, - leim/quail/tsangchi-cns.el, leim/quail/lrt.el, - leim/quail/tsangchi-b5.el, leim/quail/devanagari.el, - leim/quail/japanese.el, leim/quail/quick-b5.el, - leim/quail/punct-b5.el, leim/quail/qj-b5.el, leim/quail/py-b5.el, - leim/quail/ctlau.el, leim/quail/ctlaub.el, leim/quail/ecdict.el, - leim/quail/array30.el, leim/quail/hangul3.el, - leim/quail/hanja-jis.el, leim/quail/cyrillic.el, - leim/quail/etzy.el, leim/quail/greek.el, leim/quail/ipa.el, - leim/quail/lao.el, leim/quail/zozy.el, leim/quail/viqr.el, - leim/quail/latin.el, leim/quail/thai.el, leim/quail/hangul.el: - quail of LEIM for Emacs-19.34.94-epsilon. - -1997-06-04 Steven L Baur - - * prim/about.el: Installed new version 2.1. - From Hrvoje Niksic - - * prim/profile.el (pretty-print-profiling-info): Autoload don't - dump. - Clean up comments. - - * prim/update-elc.el: Comment cleanup. - - * modes/cperl-mode.el (cperl-mode-map): Restore previous - definition. - (cperl-electric-backspace): Use backspace-or-delete if it exists. - - * bytecomp/bytecomp-runtime.el (eval-when-feature): New macro. - From Roland McGrath - - * prim/glyphs.el (init-glyphs): Add xbm instantiator for 'x - consoles. - Suggested by Hrvoje Niksic . - - * utils/passwd.el: Eliminate obsolete Lucid emacs usage. - - * utils/timezone.el (timezone-make-date-arpa-standard): Correct - docstring. - (timezone-make-date-sortable): Ditto. - - * utils/passwd.el (passwd-invert-frame-when-keyboard-grabbed): - Change default for InfoDock. - - * utils/highlight-headers.el - (highlight-headers-follow-url-function): Correct docstring. - - * utils/finder.el (finder-known-keywords): Cleanup keyword - documentation. - - * prim/startup.el (command-line-do-help): Use emacs-name function - for printing the editor name. - - * prim/simple.el: Disable for InfoDock. - (display-warning): Disable for InfoDock. - (emacs-name): New function. - - * prim/toolbar.el (press-toolbar-button): Allow mouse presses on - blank portions of the toolbar to do something. - (release-and-activate-toolbar-button): Handle arbitrary functions - as toolbar callbacks. - From weiner@altrasoft.com - - * prim/mouse.el (default-mouse-track-cleanup-extent): Correct test - on dead-func extent. - - * prim/help.el (view-emacs-news): outl-mouse turned off in - InfoDock. - - * packages/tar-mode.el (tar-mode-map): InfoDock doesn't like the - mouse bindings. - - * packages/makesum.el (make-command-summary): Output correct - program name. - (double-column): Remove unused variable. - - * packages/hyper-apropos.el (hypropos-popup-menu): Synch with - infodock. Initialize command-p to either t or nil. - - * eterm/term.el (make-term): Fix docstring. - - * comint/shell.el: Correct comment. - - * comint/comint.el (comint-mode-map): Infodock doesn't like the - button3 assignment. - -1997-06-03 Steven L Baur - - * modes/lisp-mode.el (eval-interactive): Treat defcustom like - defvar (turn into an effective defconst). - - * cl/cl-macs.el (widget-get): Add defsetf method. - (widget-value): Add defsetf method. - From Hrvoje Niksic - -1997-06-02 Steven L Baur - - * prim/obsolete.el (insert-and-inherit): Make 'compatible not - 'obsolete. - Suggested by Hrvoje Niksic - (insert-before-markers-and-inherit): Ditto. - -1997-06-02 MORIOKA Tomohiko - - * mule/korean.el was abolished because it seems not to be used. - - * mule/japanese.el was abolished because it seems not to be used. - -1997-06-01 MORIOKA Tomohiko - - * tm/gnus-mime-old.el was abolished because XEmacs 20.3 has Gnus - 5.4. - - * tm/tm-edit.el: updated to 7.108. - - * tm/tm-view.el: updated to 7.83. - - * leim/quail.el: modified for XEmacs. - - * mule/mule-load.el, lisp/mule/mule-process.el: delete - mule-process.el because it is not used. - - * mule/european.el was abolished because it seems not to be used. - - * mule/mule-load.el: must load mule-cmds before setting for - language-environment. - - * mule/mule-cmds.el, lisp/mule/european-hooks.el: Modified - for LEIM. - - * mule/mule-cmds.el: Uncomment key definition for - `toggle-input-method'. - - * mule/mule-init.el: Comment out about `mule-keymap' (moved to - mule-cmds.el). - - * mule/mule-cmds.el: Uncomment about `mule-keymap' (moved from - mule-init.el). - - * tl/tl-atype.el: Don't require tl-str. - - * tl/tl-atype.el: Use atype.el of APEL. - - * tl/tl-list.el: Use alist.el of APEL. - -1997-05-31 MORIOKA Tomohiko - - * tl/richtext.el, tl/emu-x20.el, tl/emu-xemacs.el, - lisp/tl/emu.el, lisp/tl/emu-e19.el: moved to lisp/apel/. - - * tl/file-detect.el, tl/filename.el: replaced by APEL's. - - * mu/std11-parse.el, mu/std11.el: moved to lisp/apel/. - - * leim/quail.el: Add new quail.el (imported from Emacs - 19.34.94-epsilon). - - * leim/skk/skkdic.el: delete skkdic.el temporary because XEmacs - can not compile it. - - * leim/skk/skkdic.el, leim/quail/zozy.el, leim/quail/ziranma.el, - leim/quail/viqr.el, leim/quail/tsangchi-cns.el, - leim/quail/tsangchi-b5.el, leim/quail/symbol-ksc.el, - leim/quail/thai.el, leim/quail/tonepy.el, leim/quail/quick-cns.el, - leim/quail/sw.el, leim/quail/qj-b5.el, leim/quail/qj.el, - leim/quail/quick-b5.el, leim/quail/py-b5.el, leim/quail/py.el, - leim/quail/lao.el, leim/quail/latin.el, leim/quail/lrt.el, - leim/quail/punct-b5.el, leim/quail/punct.el, - leim/quail/hanja-jis.el, leim/quail/hanja.el, leim/quail/ipa.el, - leim/quail/japanese.el, leim/quail/hangul3.el, leim/quail/etzy.el, - leim/quail/greek.el, leim/quail/hangul.el, leim/quail/ethiopic.el, - leim/quail/devanagari.el, leim/quail/ecdict.el, - leim/quail/ctlau.el, leim/quail/ctlaub.el, leim/quail/cyrillic.el, - leim/quail/array30.el, leim/quail/ccdospy.el, - leim/quail/4corner.el: Add LEIM elisp files. - - * mule/mule-load.el, mule/mule-cmds.el: Add mule-cmds.el. - - * prim/simple.el (assoc-ignore-case): New function; imported - from Emacs/mule-19.34.94-epsilon. - -1997-06-02 Steven L Baur - - * modes/hideshow.el: Make it work again. - From Pete Ware - -Sat May 31 09:00:14 1997 David Moore - - * utils/text-props.el (set-text-properties): Was exiting - map-extents too early. - -1997-06-02 Steven L Baur - - * cl/cl-macs.el (frame-parameters): Tweaking frame configuration - defsetf's. - From Hrvoje Niksic - - * modes/vhdl-mode.el (vhdl-emacs-features): Allow recognition of - major version 20. - - * prim/simple.el (kill-region): Sort beginning and ending - endpoints to simplify logic. - From Hrvoje Niksic - -Tue May 27 13:42:57 1997 Ken Manheimer - - * packages/icomplete.el: - * Updated my email address - klm@python.org instead of klm@nist.gov. - - * Icomplete no longer installs itself when you load the package - - you have to invoke `icomplete-mode'. (Since it's autoloaded in - both emacs, you can just invoke the function.) - - * Integrated Emacs 19.34 and XEmacs 19.15 corrections (typos, - style, command revisions, etc). - - * Integrated immediate keybindings display. See - `icomplete-show-key-bindings', `icomplete-get-keys', and - `icomplete-completions'. - - * `icomplete-get-keys': Return keys bound in prior buffer to func name. - - * Added icomplete delay behavior, so completions don't intrude as - quickly for short input, with customization variables: - - `icomplete-max-delay-chars' - Maximum number of initial chars to - apply icomplete compute delay. - - `icomplete-compute-delay' - Completions-computation stall, used - only with large-number completions - - `icomplete-delay-completions-threshold' Pending-completions - number over which to apply icomplete-compute-delay - - * Provided `icomplete-exhibit' on `icomplete-minibuffer-setup-hook' - so icomplete behaves well with XEmacs GNUS. - -Fri May 30 18:39:01 1997 Hrvoje Niksic - - * prim/glyphs.el (init-glyphs): Minor regexp cleanup. - -1997-05-30 Steven L Baur - - * prim/simple.el (fsf:do-auto-fill): Remove unused variable. - (indent-for-comment): Use comment-indent-function instead of - obsolete variant. This is dumped with XEmacs! - - * packages/generic-sc.el (sc-next-operation): Remove unused - variable. - (sccs-insert-c-header): Ditto. - (ccase-new-revision-p): Ditto. - (sc-sensitize-menu): Ditto. - - * modes/auto-show.el (TopLevel): Tighten check on - dump-time initialization. - -1997-05-29 Steven L Baur - - * prim/format.el (format-alist): Change defconst to defvar. - From Richard Stallman - - (format-encode-region): Reduce bytecompiler warnings for bound but - unused variables. - (format-deannotate-region): Ditto. - (format-annotate-region): Ditto. - (format-annotate-single-property-change) Ditto. - - * utils/lib-complete.el: Clean up documentation in header. - - * prim/glyphs.el: Eliminate bytecompiler warnings. - (define-obsolete-pointer-glyph): Mark as 'compatible not 'obsolete. - - * prim/keydefs.el (ctl-x-map): Bind narrow-to-defun to `C-x n d'. - - * prim/lisp.el (narrow-to-defun): Narrow to the same defun that - `mark-defun' would make the region. - (insert-parentheses): Let a negative argument enclose preceding - sexps. - From Erik Naggum - - * prim/window-xemacs.el: New file, split from window.el with - XEmacs-specific stuff. - - * prim/window.el (display-buffer): Remove unused variable. - - * prim/keydefs.el (ctl-x-4-map): Add binding for - `kill-buffer-and-window'. - - * prim/window.el (kill-buffer-and-window): New command. - Bind it to C-x 4 0. - From Richard Stallman - - * prim/window.el (split-window-vertically): Don't change point in old - window if both the original point and the end of the buffer are - visible after splitting, when split-window-keep-point is nil. - From Noah Friedman - - * prim/files.el (revert-buffer-internal-hook): Declare. - - * utils/map-ynp.el: Synch with Emacs 19.34.94. - (map-y-or-n-p): Clean up bytecompiler warnings. - - * packages/generic-sc.el: Restored to distribution, comment - cleanup. - - * prim/simple.el (message-log-max): Add compatible variable alias - for `log-message-max-size'. - - * comint/background.el (background): Autoload. - - * prim/process.el (shell-command): background.el is now - autoloaded. - - * prim/minibuf.el: Clean up file header. - - * packages/bookmark.el (bookmark-menu-popup-paned-menu): Naive - port to XEmacs. - (bookmark-bmenu-other-window-with-mouse): Naive port to XEmacs. - - * utils/autoload.el (generated-custom-file): custom-load.el - renamed to cus-load.el. - - * prim/loadup.el: Don't preload custom-load.elc. - -Thu May 29 19:03:52 1997 Per Abrahamsen - - * x11/x-menubar.el (default-menubar): Updated customize entries. - -1997-05-29 Steven L Baur - - * prim/about.el (about-xemacs-xref): Update contributors list. - -1997-05-28 Steven L Baur - - * prim/minibuf.el (mouse-file-display-completion-list): Protect - against bogus directory becoming default. - (mouse-directory-display-completion-list): Ditto. - - From Per Abrahamsen - * bytecomp/bytecomp.el - (byte-compile-file-form-custom-declare-variable): New function. - (custom-declare-variable): Use it. - - * packages/vc.el (vc-directory): dirname typo'ed as dir. - - * packages/vc-hooks.el (vc-menu): Remove vc-file-status. - (Toplevel): Remove key definition for vc-file-status. - -1997-05-27 Steven L Baur - - * prim/cus-start.el (Toplevel): Rename factory-value to - standard-value for Custom-1.98. - -1997-05-26 Steven L Baur - - * prim/help.el (view-lossage-key-count): New variable. - (view-lossage-message-count): New variable. - (view-lossage): Use them. - - From Hrvoje Niksic - * prim/help.el (view-lossage): Use new argument to `recent-keys'. - - * cl/cl-macs.el (recent-keys-ring-size): New setf method. - -1997-05-26 Steven L Baur - - * prim/process.el (shell-command-to-string): Alias exec-to-string - to more logical name. - -1997-05-23 Steven L Baur - - * tm/tm-view.el (mime/content-decoding-condition): Add image/png - mime type. - - * tm/tm-image.el (toplevel): Add image/png mime type. - - * tm/tm-edit.el (mime-file-types): Add png handling. - (mime-content-types): Ditto. - -Thu May 22 04:19:09 1997 Martin Buchholz - - * prim/files.el (auto-mode-alist): Reorg. Support - pre-processed fortran files. *.m4 files now default to autoconf mode. - - * prim/about.el: Promote Hrvoje. Picture still needed... - - * modes/ksh-mode.el: _ has symbol syntax. - * modes/m4-mode.el: _ has symbol syntax. - * modes/pascal.el: _ has symbol syntax. - * modes/f90.el: _ has symbol syntax. - * modes/cperl-mode.el: _ has symbol syntax. - * modes/autoconf-mode.el: _ has symbol syntax. - -1997-05-22 Steven L Baur - - * prim/files.el (save-buffer): From Hrvoje Niksic. Don't clear - zmacs region. - - * packages/func-menu.el: Update for David Hughes' new email - address. - -1997-05-21 Noah Friedman - - * eldoc.el (eldoc-message-commands): Move docstring into comments, - since this isn't a user variable. - (eldoc-message-commands-table-size, eldoc-use-idle-timer-p, - eldoc-function-argstring-from-docstring-method-table): Use defvar, - not defconst. - (eldoc-last-data): Use cons explicitly; don't rely on dotted pair - read syntax. I'm worried the latter might get compiled as - read-only data someday. - (eldoc-docstring-message): If truncating symbol name, show ending - of name rather than beginning. The former is generally more unique. - (eldoc-function-argstring-from-docstring-method-table): Handle - pathological `save-restriction' case. - [top level]: Add `indent-for-tab-command' to eldoc-message-commands. - -1997-05-21 Steven L Baur - - * x11/x-menubar.el (default-menubar): strokes added to mouse - menu. - -Wed May 21 17:12:28 1997 Per Bothner - - * eterm/term.el (term-send-raw): Better XEmacs character event - handling. - * eterm/term.el (term-char-mode): Re-do Meta-handling by temporarily - setting meta-prefix-char to -1 while building keymaps. - (term-send-raw-meta): Removed. - -Tue Mar 11 20:15:26 1997 Kurt Hornik - - * eterm/term.el (term-completion-addsuffix): Doc fix. - (term-dynamic-complete-as-filename): Support the case where - term-completion-addsuffix is a (DIRSUFFIX . FILESUFFIX) cons - pair. - -Tue Jun 4 10:15:54 1996 Per Bothner - - * eterm/term.el: Add kd, kl, kr, du capabilities. - * eterm/e/eterm.ti: Add kcub1, kcuf1, kcuu1, kcud1 capabilities. - -Wed May 15 14:38:45 1996 Per Bothner - - * eterm/term.el (term-send-raw-string): send-string -> - process-send-string. - * eterm/term.el (term-arguments): Remove unused local 'values'. - * eterm/term.el (term-handle-deferred-scroll): Fix off-by-one bug, - - * eterm/term.el: Merge changes from FSF (mostly typos). - -Mon Sep 25 17:19:51 1995 Per Bothner - - * eterm/term.el (term-emulate-terminal): On CR, set - term-current-column to term-start-line-column, not 0. - -1997-05-21 Steven L Baur - - * packages/add-log.el (change-log-font-lock-keywords): Tweak - font-lock-keywords. - -1997-05-21 Erik Naggum - - * add-log.el (add-log-lisp-like-modes, add-log-c-like-modes, - add-log-tex-like-modes): New variables. - (add-log-current-defun): Use them instead of constant lists. - -1997-05-21 Steven L Baur - - * packages/add-log.el: Synch to Emacs 20.0. - - * prim/obsolete.el (read-minibuffer): Make compatible not obsolete. - (read-input): Ditto. - -Tue May 20 20:32:59 1997 Steven L Baur - - * prim/subr.el (buffer-substring-no-properties): Clean out extents - too. - -Mon May 19 19:48:35 1997 Steven L Baur - - * prim/process.el (shell-command-on-region): Remove region active - test (which played havoc with the hack in call-interactively to - place explicit calls to region-beginning and region-end in - interactive specs in the command history). - -Mon May 19 18:13:50 1997 Hrvoje Niksic - - * utils/easymenu.el (easy-menu-add): Check for existing, before - entering MENU to `easy-menu-all-popups'. - -Sun May 18 09:11:50 1997 Steven L Baur - - * prim/files.el (revert-buffer): Add optional third parameter to - preserve buffer modes (from Emacs 19.34.94). - (after-find-file): Add optional fifth parameter to preserve buffer - modes (from Emacs 19.34.94). - - * packages/vc.el: Synch with Emacs 19.34.94 because our version was - hopeless. - (vc-checkout): Autoload. - (vc-find-binary): Ditto. - - * prim/files.el (find-buffer-visiting): Restore because FSF vc.el - needs it. - -Fri Apr 25 13:21:46 1997 Per Abrahamsen - - * apropos.el (apropos): Add support for customization groups. - (apropos-print): Ditto. - -Sat May 17 19:56:31 1997 Glynn Clements - - * packages/man.el (manual-entry): Strip out stderr output. - -Sun May 11 18:24:25 1997 Kyle Jones - - * prim/modeline.el: new mouse-drag-modeline function. - Allows bottommost modeline to be dragged. - -Sat May 17 03:41:11 1997 Steven L Baur - - * cl/cl-macs.el: A whole bunch of XEmacs specific setf methods - from Hrvoje Niksic. - - * prim/files.el (auto-mode-alist): Don't copy to purespace. - (interpreter-mode-alist): Ditto. - -Fri May 16 21:43:35 1997 Steven L Baur - - * packages/info.el (Info-button1-follows-hyperlink): New variable. - (Info-maybe-follow-clicked-node): Use it. - - * prim/simple.el (transpose-preceding-chars): New function. - -Fri May 16 20:37:35 1997 Steven L Baur - - * version.el: Update minor version number. - -Mon May 12 13:47:37 1997 Oscar Figueiredo - - * tm/tm-vm.el: Provide for vm-unsaved-message having been removed - in recent versions of VM. - -Fri May 9 10:41:44 1997 Steven L Baur - - * iso/iso-acc.el (iso-accents-compose): Fix XEmacs 19.14 - compatibility (patch suggested by Hrvoje Niksic). - - * packages/man.el (manual-entry): (Patch from Soren Dayton) Allow - subchapters not to be trimmed on Solaris. - - * prim/itimer.el (itimer-edit-mode): Correct use of obsolete - function. - - * prim/startup.el: Update copyright notice. - -Thu May 8 14:35:34 1997 Steven L Baur - - * hm--html-menus/hm--html.el: Define obsolete aliases for the - previous function spellings. - - * hm--html-menus/hm--html-keys.el: Define obsolete aliases for the - previous variable spellings. - - * prim/obsolete.el (define-obsolete-variable-alias): Fix docstring - spelling. - (define-compatible-variable-alias): Ditto. - - * tm/tm-vm.el (vm-unsaved-message): Symbol doesn't exist any - more. - -Tue May 6 21:33:19 1997 Steven L Baur - - * mule/mule-files.el (write-region): Correct docstring. - - * prim/files-nomule.el (write-region): Correct docstring. - -Mon May 5 12:26:41 1997 Steven L Baur - - * prim/about.el (about-xemacs-xref): Infodock Associates is now - Altrasoft. - -Sat May 3 16:32:47 1997 Steven L Baur - - * efs/dired.el (dired-chown-program): chown program is in /bin on - Linux. - -Fri May 2 20:04:35 1997 Steven L Baur - - * egg/egg.el: paren.el needed at bytecompile time for - `pos-visible-in-window-safe' defsubst. - - * pcl-cvs/pcl-cvs.el (cvs-update): Inhibit dialog box usage in - call to cvs-do-update as this bombs when this function is invoked - from a menu. - -Wed Apr 30 18:06:35 1997 Steven L Baur - - * prim/loadup.el: Put features.elc in the dump list. - - * prim/about.el (about-xemacs): Change date. - -Tue Apr 29 18:51:31 1997 Steven L Baur - - * mule/mule-files.el (buffer-file-coding-system-alist): Regexp for - handling info files didn't match the right pattern. - -Sun Apr 27 18:09:48 1997 Steven L Baur - - * prim/sound.el (load-sound-file): Fix typo. - -Sat Apr 26 16:25:49 1997 Steven L Baur - - * utils/lib-complete.el: Make conformant to Lisp coding standards - MULE-ize by allowing for coding system argument. - -Fri Apr 25 08:39:50 1997 Steven L Baur - - * modes/sh-script.el (sh-indent-line): Deal with pathological case - of indenting a first line containing a `#' as first non-white - space character. - -Thu Apr 24 18:40:32 1997 Steven L Baur - - * comint/telnet.el (telnet-mode-map): Correct Emacs synch typo. - - * rmail/rmail.el (rmail-get-new-mail): display-time-string is not - necessarily a string. - -Thu Apr 24 11:08:28 1997 Kyle Jones - - * packages/balloon-help.el: - - default background color now grey80 to match XEmacs default. - - default border width is now 1. - - default font is now "variable" - - balloon-help can now handle variable width fonts. - - loading balooon-help no longer turns on balloon-help-mode. - - new `balloon-help' command. - - changes to the font/background/foreground variables now affect - the help frame at next display. - - help frame should now pop up on the correct display if XEmacs - is running with multiple devices open. - - Customized, courtesy of Hrvoje. - - don't use the padding lines that were needed for 19.12. - Compatibility with older XEmacs versions is hereby disavowed. - - xclock frame name hack is gone. - -Wed Apr 23 10:56:05 1997 Steven L Baur - - * prim/files.el (hack-local-variables-prop-line): Mistakenly - returned t when enable-local-variables was nil. - - * psgml/psgml-charent.el (sgml-display-char-list-filename): Move - iso88591.map to a proper location. - - * prim/sound.el (load-sound-file): Make sure sound files are read - as binary files. - -Tue Apr 22 02:05:38 1997 Steven L Baur - - * packages/vc.el (vc-directory): Set text properties. - - * psgml/psgml-xemacs.el (sgml-xemacs-get-popup-value): Allow for - interactive commands. - -Mon Apr 21 15:15:12 1997 Steven L Baur - - * prim/minibuf.el (input-error): New error type. - (read-from-minibuffer): Use it. - - * comint/comint.el (comint-exec-hook): Do not Customize due to - interactions with setting language environment in MULE. - -Sun Apr 20 09:36:19 1997 Steven L Baur - - * packages/info.el (Info-footnote-tag): Changing the footnote tag - from the default "Note" is broken. - -Tue Apr 22 07:01:20 1997 Hrvoje Niksic - - * prim/keydefs.el (global-map): Bind it to `C-z'. - - * prim/frame.el (suspend-emacs-or-iconify-frame): New function. - -Fri Apr 18 16:45:07 1997 Steven L Baur - - * utils/skeleton.el (skeleton-pair-insert-maybe): Guard test with - existence check on mark-active too. - (skeleton-proxy): Ditto. - (skeleton-proxy-new): Ditto. - -Fri Apr 18 09:26:24 1997 Dave Gillespie - - * cl/cl-macs.el (values): New setf-method. - -Thu Apr 17 21:29:57 1997 Bob Weiner - - * packages/avoid.el (mouse-avoidance-kbd-command): Correct - detection of keypress. - -Thu Apr 17 21:20:04 1997 Michael McNamara - - * modes/verilog-mode.el: Changes to 2.25 - 1) Autoindent a new declaration according to the previous - declaration, if any. Only use the previous one, don't try to re - line things up. - 2) Include "Customize Verilog-Mode" in the Verilog menu bar. Make it - safe to do so, even if the underlying emacs does not yet support - custom. - 3) Include keybinding C-c C-b for reporting bugs. - 4) Include keybinding C-c i for reindenting declarations. - - * modes/verilog-mode.el: Changes to 2.24 - Cleaned up menubar items; added submit bug report there, for - example. - - * modes/verilog-mode.el: Changes to 2.23 - 1) Support custom (XEmacs) or defvar method of customization. - 2) fix verilog-pretty declarations - 3) add support so folks turning up the complexity of commenting don't - get errors (they don't get any more complexity either) - - * modes/verilog-mode.el: Changes to 2.22 - 1) Moved installation hints to the web page. - 2) Added support for XEmacs's custom variable setting package. - 3) Added variables to separatly control indentation of - module level items (always, initial. etc) - declarations - behavorial (the begin in the task & function declaration - 4) Attempted to shorten comments and lisp so that the %@* NT - mailers won't turn long comments into extra code. - 5) Used make-regexp to optimize many regular expressions so that they - are no longer backtrack. - 6) fixed bugs - a) a newline on a blank line no longer generates two new lines. - b) a semicolon on a comment no longer auto indents - c) lines like ''else if (a) begin'' - no longer confuse auto commenter - d) a number of other bugs which fail to come to mind... - 7) Added support for menu pulldowns on FSF and XEmacs - 8) Added support for XEmacs v20 - 9) Changed verilog-comment-region to insert comments that Verilog-XL - doesn't b*tch about. - 10) Eliminated auto lineup of declarations upon typing newline of - semicolon. (Cheers all around) Now instead there is a command, and - also a menu pulldown, which lines up indentations around point. - 11) Added verilog-submit-bug-report - -Mon Apr 14 13:06:10 1997 Steven L Baur - - * utils/autoload.el (generate-file-autoloads-1): Turn off local - variable processing. - - * prim/files.el (hack-local-variables-prop-line): Respect setting - of enable-local-variables. - - * vm/vm-startup.el (vm-session-initialization): Remove for - production version. - - * utils/smtpmail.el (smtpmail-send-it): Forgot quote. - (smtpmail-deduce-address-list): case-fold-search mistakenly set - before buffer change. - -Sun Apr 13 14:49:34 1997 Steven L Baur - - * x11/x-menubar.el (default-menubar): Added `send-pr' to Help - menu. - - * modes/make-mode.el (makefile-font-lock-keywords): Correct old, - restored :-( 19.14 makefile-space-face lossage. - -Sat Apr 12 23:20:31 1997 David Moore - - * packages/font-lock.el (c-font-lock-keywords-1): Performance - tuned regexps. - -Sat Apr 12 21:32:37 1997 Steven L Baur - - * prim/about.el (about-xemacs): Update printed release date. - - * calendar/appt.el (install-display-time-hook): Friends don't let - Friends quote lambda functions. - -Fri Apr 11 11:50:14 1997 Oscar Figueiredo - - * tm/tm-vm.el: tm-vm/use-original-url-button: - - Default is now t (principle of least surprise). - (tm-vm/build-preview-buffer): - - Bind vm-message-pointer in Preview-buffer. - - X-Face was not displayed for a certain set of enabling variables. - Calls to (vm-xemacs-p) were removed. - -Sat Apr 12 05:27:56 1997 Steven L Baur - - * modes/list-mode.el (list-mode-item-mouse-selected): Sometimes - event-closest-point returns nil. - - * comint/telnet.el (telnet-check-software-type-initialize): - Restore 19.14 initialization of telnet-prompt-pattern for Unix. - (rsh): Allow a way to get back old password-less behavior. - - * edebug/edebug.el (edebug-read-and-maybe-wrap-form): Protect - against pathological recursive calls. - - * prim/loadup.el: add cus-start as dumped package. - - * packages/vc.el (vc-directory): Dired requires a list not a - string of space separated names. - - * utils/live-icon.el (live-icon-colour-name-from-face): `face' may - be a list of faces since it is generated by `extent-face'. - -Fri Apr 11 21:12:57 1997 Steven L Baur - - * packages/ispell.el: Don't attempt creation of the menubar unless - XEmacs has been compiled with menubars. - - * prim/simple.el (yank-pop): mark-marker needs optional force - parameter to activate the region (suggested by Jamie Zawinski). - -Fri Apr 11 17:47:26 1997 Per Abrahamsen - - * packages/apropos.el (apropos): Add support for faces, widgets, - and user options. - (apropos-print): Ditto. - -Fri Apr 11 01:23:45 1997 Steven L Baur - - * prim/loadup.el (running-xemacs): Declare. This variable is the - new canonical way of determining whether you're running under - XEmacs. - -Thu Apr 10 13:23:14 1997 Steven L Baur - - * packages/font-lock.el (font-lock-apply-highlight): Remove - support for back to back font hack (and restore correct - fontification of `int a, b, c;'). Patch from Anders Lindgren. - - * prim/about.el (about-xemacs-xref): Forgot to link David Moore's - picture (oops). - -Thu Apr 10 12:30:29 1997 Per Abrahamsen - - * efs/dired-faces.el (dired): Move to environment group. - -Wed Apr 9 19:45:46 1997 Per Abrahamsen - - * x11/x-menubar.el (default-menubar): Inline definition of - customize menu. - -Wed Apr 9 10:45:54 1997 Steven L Baur - - * prim/about.el (about-xemacs-xref): Add Jan Vroonhof to list of - contributors. - (about-xemacs-xref): Add MORIOKA Tomohiko's bio. - (about-xemacs-xref): Add Per Abrahamsen. - -Tue Apr 8 12:57:05 1997 Steven L Baur - - * modes/lisp-mode.el (eval-defun): Evaluate defcustom in defconst - style instead of defvar style (patch derived from Emacs 19.35/Lars - Magne Ingebrigtsen). - -Mon Apr 7 16:38:43 1997 Steven L Baur - - * prim/frame.el (temp-buffer-shrink-to-fit): Default to nil since - this feature has gotten broken. - -Sun Apr 6 06:56:03 1997 Steven L Baur - - * modes/outl-mouse.el (outline-down-arrow-mask): Set up arrow - glyphs to display on when no X11 support is available. - - * modes/outline.el (outline-install-menubar): short circuit if no - menubars are available. - - * x11/x-menubar.el (default-menubar): Use xmine not mine. - - * prim/help.el (describe-variable): Some doc strings weren't being - terminated with a newline. - -Sat Apr 5 20:20:00 1997 Steven L Baur - - * prim/about.el (about-xemacs-xref): Correct Jareth Hein's links. - -Sat Apr 5 13:18:05 1997 Tomasz J. Cholewo - - * packages/etags.el (tags-query-replace): Fixed DELIMITED argument - bug. `with-caps-disable-folding' moved to isearch-mode.el. - - * packages/info.el (Info-search): Use `with-caps-disable-folding'. - -Sat Apr 5 09:32:43 1997 Steven L Baur - - * utils/finder-inf.el: Regenerated. - - * utils/finder.el (finder-known-keywords): Add mule keyword. - -Tue Apr 1 14:08:04 1997 Steven L Baur - - * prim/winnt.el: New file. Derived from Emacs 19.34, adapted by - Marc Paquette. - - * prim/faces.el (set-face-stipple): Allow usage of a pixmap - (suggested by Per Abrahamsen). - - * mule/canna.el (running-xemacs): Move to the top. - - * prim/cmdloop.el (y-or-n-p-minibuf): Add protection in case user - hits something that can't be bound to a key. - -Tue Apr 1 11:25:33 1997 Martin Buchholz - - * bytecomp/bytecomp.el (char-after): Correct coding of calling - sequence. - -Mon Mar 31 21:36:47 1997 Kyle Jones - - * prim/faces.el (set-face-stipple): New function. - -Sat Mar 29 14:52:02 1997 Steven L Baur - - * gnats/send-pr.el (send-pr:submit-pr): Pass send-pr:datadir in - the environment to send-pr. - (send-pr::insert-template): Ditto. - (send-pr:default-site): Default submission address is at xemacs.org. - -Fri Jul 19 12:01:51 1996 Christoph Wedler - - * packages/info.el (Info-elisp-ref): Look first in lispref, then - elisp. - - * packages/func-menu.el (fume-function-name-regexp-bibtex): `,' - isn't allowed. - - * packages/etags.el (list-tags): Interactive argument should be an - existing file name. - -Wed Mar 26 22:33:40 1997 Steven L Baur - - * Remove ns lisp directory. - * Remove vms lisp directory. - -Tue Mar 25 12:22:57 1997 Steven L Baur - - * prim/files.el (file-remote-p): Update doc string. - - * packages/terminal.el (te-stty-string): Fix definition for Linux. - -Mon Mar 24 23:43:53 1997 Steven L Baur - - * prim/files.el (file-remote-p): Correct documentation and allow - for `allow-remote-paths' to control loading of efs. - -Sun Mar 23 16:58:08 1997 Tomasz J. Cholewo - - * packages/etags.el (with-caps-disable-folding): New macro. - (find-tag-internal): Use it. - (tags-search): Use it. - (tags-query-replace): Use it. Case bug corrected. - -Mon Mar 24 00:47:38 1997 Steven L Baur - - * x11/x-menubar.el (popup-mode-menu): Change guard when stripping - keywords to be more robust. - -Sun Mar 23 00:26:53 1997 Steven L Baur - - * prim/startup.el (splash-hack-version-string): Correct for case - of hosts with '-' in the names. - -Sat Mar 22 14:25:47 1997 Tomasz J. Cholewo - - * modes/sendmail.el (user-mail-address): Require cus-edit. - Fix when scope. - -Sat Mar 22 14:25:47 1997 Tomasz J. Cholewo - - * calendar/diary-lib.el (diary-countdown): New function. - (fancy-diary-display): Use modeline-buffer-identification. - - * calendar/appt.el (appt-diary-entries): Do not display diary. - (appt-check): Display diary buffer at midnight. - -Fri Mar 21 19:16:46 1997 Steven L Baur - - * mule/mule-coding.el (enable-multibyte-characters): MULE - compatible variable. - -Thu Mar 20 13:28:17 1997 Steven L Baur - - * bytecomp/bytecomp.el (byte-compile-output-docform): Ebola fix. - (byte-compile-lambda): Ebola fix. - - * prim/obsolete.el (following-char): Make this turkey obsolete. - (preceding-char): Ditto. (Suggested by Richard Mlynarik). - -Wed Mar 19 10:12:09 1997 Steven L Baur - - * modes/sendmail.el (sendmail-send-it): Use function for - user-mail-address. - (user-mail-address): Autoload. - - * pcl-cvs/pcl-cvs.el (cvs-changelog-ours-p): Use function for - user-mail-address. - - * prim/startup.el (load-init-file): Only set user-mail-address if - non-interactive. - - * utils/smtpmail.el (smtpmail-send-it): Use function for - user-mail-address. - (smtpmail-via-smtp): Ditto. - - * packages/add-log.el (add-log-mailing-address): Use new function - to obtaion email address. - (add-change-log-entry): Ditto. - - * prim/device.el (device-pixel-depth): New alias for - `device-bitplanes'. - - * comint/comint-xemacs.el (comint): Fix typo in defgroup. - -Tue Mar 18 11:16:28 1997 Steven L Baur - - * prim/loadup.el: ls-lisp doesn't exist now. - - * comint/comint-xemacs.el (comint): Touch up fixes from Per - Abrahamsen. - - * prim/glyphs.el (subwindow-image-instance-p): Change doc string - to reflect unimplemented status. - -Mon Mar 17 15:34:06 1997 Steven L Baur - - * comint/comint.el (comint-input-setup): Require comint-xemacs. - - * utils/autoload.el (autoload-snarf-defcustom): Don't snarf from - auto-autoloads.el. - - * comint/comint-xemacs.el: New file. Contains face declarations - for comint. - - * comint/comint.el: Remove inline defface. - -Sat Mar 15 15:14:06 1997 Steven L Baur - - * prim/loadup.el: Add prim/auto-customize.elc to dumped files. - - * utils/autoload.el (generated-custom-file): New variable. - (autoload-snarf-defcustom): New function. Grab Customization as - we look for autoload cookies. (based on code by Per Abrahamsen). - (update-file-autoloads): Use it. - (autoload-save-customization): New function (based on code by Per - Abrahamsen). - (batch-update-autoloads): Use it. - -Fri Mar 14 19:59:36 1997 Bob Weiner - - * packages/jka-compr.el (jka-compr-installed-p): Simplify. - -Fri Mar 14 17:24:30 1997 Steven L Baur - - * modes/sendmail.el: Correct vm macro hack. - (query-user-mail-address): New customizable variable. - (user-mail-address): New function, use it. (Courtesy of Per - Abrahamsen ). - -Thu Mar 13 18:49:50 1997 Steven L Baur - - * x11/x-menubar.el (popup-mode-menu): Do something more correct - when combining a global popup menu and a local mode menu. - -Thu Mar 13 08:36:35 1997 Adrian Aichner - - * packages/crypt.el (crypt-unix-to-dos-region): Correct DOC string. - -Wed Mar 12 13:46:21 1997 Steven L Baur - - * prim/obsolete.el (char=): Make alias for common lisp - compatibility. - -Mon Mar 10 09:44:05 1997 Steven L Baur - - * prim/simple.el (set-fill-column): Clean up docstring. - - * x11/x-menubar.el (save-options-non-customized-face-list): Allow - save-options to save faces declared with defface macro. - - * packages/vc.el: diff-switches is autoloaded again in diff.el. - - * packages/diff.el (diff-switches): Default to "-c". - -Sun Mar 9 18:44:59 1997 Tomasz J. Cholewo - - * prim/help.el (describe-function-1): Add missing stream arguments - to terpri and princ. - -Sun Mar 9 15:38:29 1997 Steven L Baur - - * prim/modeline.el (modeline-minor-mode-menu): Evaluate minor - modes in context of correct buffer. - - * prim/help.el (locate-library): Synched with Emacs 19.35. - - * packages/icomplete.el (icomplete-get-keys): Make it work. - - * prim/about.el: Add Jens Lautenbacher's picture. - -Sun Mar 9 12:38:53 1997 Noah Friedman - - * utils/eldoc.el (eldoc-pre-command-refresh-echo-area): Use - eldoc-display-message-p, not eldoc-display-message-no-interference-p. - -Sat Mar 8 11:20:47 1997 Steven L Baur - - * prim/startup.el (startup-splash-frame-body): More text tweaking. - - * x11/x-faces.el (*try-oblique-before-italic-fonts*): New user - variable. Allow trying oblique fonts ahead of italic fonts (from - Raymond Toy). - (x-make-font-italic): Use it. - - * prim/obsolete.el (window-system): Make it compatible not - obsolete. - -Fri Oct 11 14:21:05 1996 Christoph Wedler - - * packages/hyper-apropos.el (hypropos-get-doc): Put font names etc in - parentheses if instantiation uses fallback. - (hypropos-face-history): New variable. - (hyper-describe-face): New function. - (hyper-where-is): New command. - (hypropos-read-function-symbol): New function. - (hyper-describe-key): New command. - (hyper-describe-key-briefly): New command. - (hypropos-read-variable-symbol): New function. - (hyper-set-variable): New command. - (hypropos-set-variable): Changed to work with buffer-locals. - -Fri Jul 19 12:01:51 1996 Christoph Wedler - - * packages/hyper-apropos.el: Massive changes--the original knew nothing - about buffer-locals and local-bindings. - (hypropos-shrink-window): New user option. - (hypropos-ref-buffer): New variable. - (hypropos-regexp-history): New variable. - (hyper-apropos): Better interactive version. - (hypropos-grok-variables): Omit OBSOLETE stuff. - (hyper-describe-variable): Additional ARG, better interactive - version. - (hyper-describe-function): Ditto. - (hypropos-last-help): Without prefix arg, just display buffer. - (hypropos-insert-face): New function. - (hypropos-insert-keybinding): New function. - (hypropos-get-doc): Additional ARG, display documentation for - faces, complete change. - (hypropos-this-symbol): Using better regexp. - -Fri Mar 7 10:44:48 1997 Steven L Baur - - * x11/x-menubar.el (default-menubar): Reorganize again undoing - previous change. Customize submenu moved to top of options menu. - Edit faces restored to edit-faces and renamed to Browse faces. - -Thu Mar 6 08:43:27 1997 Steven L Baur - - * x11/x-menubar.el (options-menu): New variable. - (default-menubar): Use it. - - * prim/about.el (view-less): Explicit require. - -Wed Mar 5 18:03:02 1997 Steven L Baur - - * prim/cleantree.el: New file based on suggestion by David Moore, - and derived from Gnus nnml code. - -Tue Mar 4 01:19:37 1997 Hrvoje Niksic - - * edebug/edebug.el (edebug-compute-previous-result): Don't treat - numbers as chars. - -Wed Mar 5 10:11:55 1997 Steven L Baur - - * prim/startup.el (splash-hack-version-string): New function to - narrow the output of (emacs-version) for the splash screen. - (splash-frame-present): Use it. - -Tue Mar 4 19:52:10 1997 Steven L Baur - - * packages/supercite.el (sc-name-filter-alist): (Idea from Bob - Weiner). Update to handle names like Michael Sperber - [Mr. Preprocessor]. - -Mon Mar 3 17:50:04 1997 Per Abrahamsen - - * prim/faces.el (init-face-from-resources): New variable. - (init-face-from-resources): Use it. - (init-device-faces): Use it. - (init-frame-faces): Use it. - (make-empty-face): New function. - - * x11/x-faces.el (x-init-face-from-resources): Made second - argument optional, and added a third argument. - (make-face-x-resource-internal): New alias. - -Mon Mar 3 14:45:16 1997 Steven L Baur - - * prim/loadup.el: Remove custom.elc. - - * prim/simple.el (newline): Attempt to not add newline to a - previous end-open extent. - -Sun Mar 2 10:10:31 1997 Steven L Baur - - * hm--html-menus/tmpl-minor-mode.el (tmpl-sign): Remove nul byte. - - * site-load.el: Move site-packages to the top level. - -Sun Mar 2 01:37:04 1997 Hrvoje Niksic - - * utils/mail-extr.el (all-top-level-domains): Added "hr" domain. - - * packages/ps-print.el (ps-print-color-p): Default to nil. - - * x11/x-menubar.el (default-menubar): Changed menubar entry for - color printing. - - * prim/faces.el (init-other-random-faces): Use gray65 for - zmacs-region and primary-selection background. - - * x11/x-faces.el (x-init-global-faces): New default background - gray80. - -Sat Mar 1 14:38:14 1997 Hrvoje Niksic - - * packages/diff.el: (diff): Autoload. - (diff-backup): Autoload. - (diff-switches): Autoload. - -Sat Mar 1 01:09:08 1997 Steven L Baur - - * packages/tar-mode.el (tar-mode-map): Removed extraneous C-c - binding of tar-copy. - - * prim/keydefs.el: Don't disable upcase-region and - downcase-region. - -Fri Feb 28 11:22:29 1997 Steven L Baur - - * prim/obsolete.el (char-to-int): Define as alias to `char-int'. - - * prim/help.el (describe-function-1): Show annotation contents if - they exist. - - * packages/man.el (Manual-mode): Don't turn off scrollbars if - XEmacs doesn't have them to begin with. - - * prim/keydefs.el: Don't disable eval-expression by default now - that it is harder to type. - -Thu Feb 27 13:06:41 1997 Steven L Baur - - * prim/subr.el (with-string-as-buffer-contents): Moved from - mule/mule-coding.el. - - * mule/mule-coding.el: Remove with-string-as-buffer-contents. - - * prim/format.el (format-insert-file): Correct wrong order of args - passed to format-decode. - - * prim/startup.el (load-user-init-file): Allow XEmacs to read a - bytecompiled .emacs if it exists. - -Thu Feb 27 17:41:57 1997 Per Abrahamsen - - * subr.el (eval-after-load): Enable. - (eval-next-after-load): Ditto. - -Thu Feb 27 10:59:05 1997 Steven L Baur - - * prim/subr.el (with-temp-buffer): New function from Emacs 19.35, - courtesy of Erik Naggum . - -Fri Feb 28 22:17:03 1997 Hrvoje Niksic - - * prim/isearch-mode.el: Added "_" to the `interactive' forms of - most functions. - (isearch-mode-map): Define M-y. - (isearch-yank-kill): New function. - - * prim/keydefs.el: Don't bind `C-x C-n' to `set-goal-column'; - don't disable `set-goal-column'. - - * mule/mule-init.el (ctl-x-map): Use `C-x C-n' as mule-prefix, - instead of `C-x C-k'. - -Wed Feb 26 18:09:56 1997 Andreas Jaeger - - * x11/x-menubar.el (default-menubar): `FAQ' should be `FAQ - (local)' in Help menu. - -Mon Feb 24 18:33:38 1997 Martin Buchholz - - * mule/mule-debug.el (describe-coding-system): Ported from - Mule to XEmacs. - - * mule/mule-x-init.el (x-use-halfwidth-roman-font): New - function: - "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY. - - Do this only if: - - the current display is an X device - - the displayed width of FULLWIDTH-CHARSET is twice the displayed - width of the 'ascii charset, but only when using ROMAN-REGISTRY. - - Traditionally, Asian characters have been displayed so that they - occupy exactly twice the screen space of ASCII (`halfwidth') - characters. On many systems, e.g. Sun CDE systems, this can only be - achieved by using a national variant roman font to display ASCII." - -Sun Feb 23 12:56:28 1997 Steven L Baur - - * edebug/edebug.el: Synch up with Emacs 19.34. - - * prim/itimer-autosave.el (auto-save-timeout): Increase to 960. - -Sat Feb 22 17:11:31 1997 Steven L Baur - - * prim/loadup.el: Dump new file itimer-autosave.el. - -Sat Feb 22 17:06:32 1997 Kyle Jones - - * prim/itimer.el: Cleanup, removal of autosave cruft. - -Fri Feb 21 09:41:44 1997 Steven L Baur - - * prim/simple.el (line-move-ignore-invisible): Reverse previous - change to make this default to nil again. - -Thu Feb 20 14:30:50 1997 Jamie Zawinski - - * prim/files.el (hack-local-variables-prop-line): New version. - -Thu Feb 20 11:14:22 1997 Steven L Baur - - * prim/files.el: Delete definition of dired-kept-versions. - - * prim/about.el (about-xemacs-xref): Added Kyle's picture. :-) - -Wed Feb 19 15:47:47 1997 Steven L Baur - - * packages/vc.el (diff-switches): Restore since this global - variable went away with the passing of ange-ftp. - - * utils/autoload.el (generate-file-autoloads-1): Don't let - find-file-hooks be run. - (update-file-autoloads): Ditto. - (update-autoloads-from-directory): Ditto. - - * x11/x-menubar.el (default-menubar): Correct unguarded reference - to fast-lock-mode variable. - -Wed Feb 19 08:04:02 1997 Noah Friedman - - * utils/eldoc.el (eldoc-message-commands): Doc fixes. - (eldoc-message): Make function, not macro. - - * utils/eldoc.el (eldoc-last-message): New internal variable. - (eldoc-mode): Initialize it to nil. - (eldoc-message): Use it. - (eldoc-print-current-symbol-info): Use it. - - * utils/eldoc.el (eldoc-pre-command-refresh-echo-area): New function. - (eldoc-mode): Put it on pre-command-hook if in XEmacs or using - idle timers in Emacs. - - * utils/eldoc.el (eldoc-message-commands-table-size): New constant. - (eldoc-add-command): Use it to initialize eldoc-message-commands. - - * utils/eldoc.el (eldoc-display-message-no-interference-p): New - function. - (eldoc-display-message-p): Use it. - - * utils/eldoc.el (eldoc-print-fnsym-args, eldoc-print-var-docstring): - Arg sym no longer optional. - Do not initialize arg if nil. - - * utils/eldoc.el (eldoc-forward-sexp-safe): Function deleted. - (eldoc-beginning-of-sexp): New function. - (eldoc-fnsym-in-current-sexp): Use eldoc-beginning-of-sexp. - Use eldoc-current-symbol to get symbol at point. - - * utils/eldoc.el - (eldoc-function-argstring-from-docstring-method-table): Forge - docstrings for `and', `or', `list', `+', and `-'. - - * utils/eldoc.el (eldoc-add-command-completions): New function. - (eldoc-add-command): Take list of args. - No longer interactive. - (eldoc-remove-command-completions): New function. - (eldoc-remove-command): Take list of args. - No longer interactive. - - * utils/eldoc.el: Initialize eldoc-message-commands using - eldoc-add-command-completions. - - * utils/eldoc.el (eldoc-display-message-p): New function. - Return nil if cursor-in-echo-area, or using idle timers and a - command is still active. - (eldoc-print-current-symbol-info): Use eldoc-display-message-p. - -Tue Feb 18 14:20:01 1997 David Byers - - * packages/paren.el (paren-highlight): Minor typo correction. - -Tue Feb 18 13:05:33 1997 Steven L Baur - - * prim/loadup.el: Dump new file custom-xmas. - -Mon Feb 17 21:01:38 1997 Steven L Baur - - * prim/help.el (function-compatible-p): New function. - (function-compatibility-doc): New function. - (describe-function-1): Use them. - (variable-compatible-p): New function. - (variable-compatibility-doc): New function. - (describe-variable): Use them. - -Mon Feb 17 19:12:55 1997 Per Abrahamsen - - * prim/obsolete.el (x-color-values): Added for Emacs - compatibility. - -Mon Feb 17 18:11:24 1997 Michael Kifer - - * prim/files.el (file-remote-p): Force load of EFS if not already - loaded. - -Mon Feb 17 17:45:23 1997 Bob Weiner - - * modes/lisp-mode.el (eval-last-sexp): Do something special if - evaluating (interactive ...). - -Sun Feb 16 21:49:18 1997 Bjorn Victor - - * utils/facemenu.el (facemenu-adjust-face-sizes): Strip size when - face is neither nil nor cons. - -Sun Feb 16 14:26:03 1997 Steven L Baur - - * prim/loadup.el: Try not dumping font.elc. - - * prim/obsolete.el (display-column-mode): Remove column.el and - leave a forwarding address. - -Sat Feb 15 23:21:11 1997 Kyle Jones - - * prim/minibuf.el (read-from-minibuffer): Don't put evaluated - expressions in the minibuffer history list. - -Sat Feb 15 22:57:11 1997 Steven L Baur - - * packages/scroll-in-place.el (scroll-signal-boundary-error): - Allow user to suspend error signals. - -Sat Feb 15 21:43:49 1997 John Turner - - * packages/column.el (current-line): Correct defaults for starting - at 1, remove an obsolete variable. - -Sat Feb 15 20:17:46 1997 Hal Peterson - - * packages/vc.el (vc-backend-print-log): Change `cvs rlog' to - `cvs log' - -Mon Feb 17 02:01:27 1997 Hrvoje Niksic - - * utils/edmacro.el (edmacro-format-keys): Would bug out on empty - macro. - -Mon Feb 17 02:01:27 1997 Hrvoje Niksic - - * utils/edmacro.el (edmacro-format-keys): Would bug out on empty - macro. - (edmacro-fix-menu-commands): Would bug out on 'control, etc. - (edmacro-events-to-keys): New function. - (edmacro-format-keys): Use it. - (edmacro-finish-edit): Compare to macros, not strings. - (edmacro-fkeys): New function. - (edmacro-format-keys): Use it. - (edit-kbd-macro): Tweak. - -Sat Feb 15 13:58:14 1997 Kyle Jones - - * packages/info.el: Don't call switch-to-buffer if the Info frame - is being deleted. - -Sat Feb 15 12:07:46 1997 Steven L Baur - - * prim/simple.el (previous-line): Allow escape from signaled error - on buffer boundary. - (next-line): Ditto. - -Sat Feb 15 11:05:29 1997 Kyle Jones - * utils/redo.el: made before and after status messages so that - the user is aware if a long action is still being processed. - - rolled version number up to 1.00, since the package seems to be - stable. - - cosmetic changes so the file could be included in the XEmacs - distribution. - -Sat Feb 15 11:13:05 1997 Hrvoje Niksic - - * prim/simple.el (line-move-ignore-invisible): Change default to - t. - -Sat Feb 15 01:04:21 1997 Hrvoje Niksic - - * prim/macros.el: Removed. Superseded by new version in - edmacro.el. - -Fri Feb 14 23:29:16 1997 Adrian Aichner - - * modes/executable.el (executable-set-magic): Correct for the #! - getting lost. - -Fri Feb 14 23:10:58 1997 Steven L Baur - - * prim/modeline.el (modeline-modified-map): Call - vc-toggle-read-only instead of toggle-read-only to be consistent - with override of `C-x C-q'. - -Fri Feb 14 16:11:10 1997 Jonathon Edwards - - * packages/blink-cursor.el (blink-cursor-post-command-hook): stop - cursor blink momentarily after receiving user input. - -Fri Feb 14 15:26:38 1997 Jacques Duthen - - * x11/x-menubar.el (default-menubar): mine goes into games menu. - -Thu Feb 13 22:16:09 1997 Michael Sperber - - * prim/files.el (recover-session-finish): Modify for efs. - -Thu Feb 13 21:23:07 1997 Steven L Baur - - * prim/files.el (file-remote-p): New function. - - * sunpro/sunpro-load.el: Do not dump mime-setup under any - circumstances. - -Thu Feb 13 17:58:09 1997 Richard Mlynarik - - * prim/obsolete.el (insert-before-markers-and-inherit): Correct - typo. - -Wed Feb 12 17:48:59 1997 Steven L Baur - - * comint/gdb.el (gdb-control-c-subjob): Nuke this loser. - -Wed Feb 12 13:58:01 1997 Hrvoje Niksic - - * utils/edmacro.el: New file. - -Wed Feb 12 09:00:48 1997 Steven L Baur - - * prim/sound.el (load-sound-file): Update documentation of - restrictions on what machines XEmacs can play sound on. - -Tue Feb 11 09:39:25 1997 Steven L Baur - - * prim/glyphs.el (init-glyphs): Correct autodetection to find - GIF89. Look for PNG. - -Mon Feb 10 21:37:54 1997 Steven L Baur - - * prim/frame.el (show-temp-buffer-in-current-frame): Conditional - shrink-to-fit behavior on `temp-buffer-shrink-to-fit'. - - * packages/apropos.el (apropos-print): Ditto. - - * prim/lisp.el (lisp-complete-symbol): Ditto. - - * prim/help.el (with-displaying-help-buffer): Ditto. - -Mon Feb 10 20:58:19 1997 Hrvoje Niksic - - * x11/x-toolbar.el: Allow customization of toolbar functions by - customizable variables. - -Mon Feb 10 14:58:05 1997 Greg Klanderman - - * comint/gdb.el (gdb-mode): Correct setting of obsolete hook. - -Sun Feb 9 19:55:03 1997 Steven L Baur - - * prim/obsolete.el (define-compatible-variable-alias): New function. - (define-compatible-variable-alias): New function. - .*mode-line.*, frame-parameters, modify-frame-parameters, - x-display-.* all made compatible not obsolete. - - * bytecomp/bytecomp.el (byte-compile-variable-ref): Warn for - compatibility symbols. - (byte-compile-compatible): New function. - - * bytecomp/bytecomp-runtime.el (make-compatible): New function. - (make-compatible-variable): New function. - -Sun Feb 9 19:14:25 1997 Kyle Jones - - * utils/redo.el: New file. - - * utils/floating-toolbar.el: New file. - -Sun Feb 9 15:19:46 1997 Steven L Baur - - * custom/custom.el: Remove ;;;###autoloads since this file is - dumped with XEmacs. - -Sun Feb 9 00:28:20 1997 Per Abrahamsen - - * custom/widget.el: New file. - - * custom/widget-example.el: New file. - - * custom/widget-edit.el: New file. - - * custom/custom.el: New file. - - * custom/custom-edit.el: New file. - -Fri Feb 7 03:09:32 1997 Alastair Burt - - * bytecomp/bytecomp.el (byte-compile-insert-header): Correct - typo. - -Thu Feb 6 17:14:32 1997 Steven L Baur - - * packages/font-lock.el (font-lock-fontify-keywords-region): - Correct bounds checking in case the keywords regexp is not - properly anchored. - - * packages/ps-print.el: Update maintainer address. - -Thu Feb 6 12:35:39 1997 Bill Dubuque - - * cl/cl-macs.el (cl-do-proclaim): Correct addition of bound - variables to `byte-compile-bound-variables'. - -Thu Feb 6 01:07:56 1997 Steven L Baur - - * bytecomp/bytecomp.el (byte-compile-warn-about-unused-variables): - Reverse previous patch. - - * prim/minibuf.el (use-dialog-box): Rename from - should-use-dialog-box. - (should-use-dialog-box-p): Use it. - - * bytecomp/bytecomp.el (byte-compile-warn-about-unused-variables): - cell is not a cons when the cl declare macro is used. - -Wed Feb 5 21:37:13 1997 Hrvoje Niksic - - * modes/cperl-mode.el: Provide 'cperl-mode. - -Tue Feb 4 11:51:25 1997 Greg Klanderman - - * modes/make-mode.el: Remove `makefile-runtime-macros-list' from - `makefile-macro-table'. - -Tue Feb 4 11:06:33 1997 Steven L Baur - - * packages/metamail.el (metamail-region): *junet* coding system - name changed to 'junet. - -Mon Feb 3 22:34:09 1997 Alexandre Oliva - - * iso/iso-acc.el: Critical Bug fix. - Add ISO-8859-3 support to iso-acc.el, as suggested by Dale - Gulledge. - -Mon Feb 3 17:11:21 1997 Steven L Baur - - * modes/make-mode.el (makefile-browser-format-macro-line): Remove - redundant (and wrong) format statement. - -Fri Jan 31 21:38:47 1997 Steven L Baur - - * psgml/psgml-html.el (html-auto-sgml-entity-conversion): Allow - user control over automatic sgml entity to ISO-8859-1 conversion. - -Fri Jan 31 09:50:51 1997 Hrvoje Niksic - - * x11/x-toolbar.el (toolbar-mail-commands-alist): Updated with a - lot of new mailer possiblities. - -Fri Jan 31 09:28:49 1997 Martin Buchholz - - * x11/x-font-menu.el (reset-device-font-menus): Correct guard on - charset-registry call. - -Fri Jan 31 00:21:07 1997 Darrell Kindred - - * packages/font-lock.el (font-lock-mode): Don't remove the - `font-lock-pre-idle-hook' from `pre-idle-hook'. - -Thu Jan 30 22:43:43 1997 David Moore - - * packages/compile.el: Speed up regexps. - (compilation-parse-errors): replace re-search-forward with - something faster. - -Thu Jan 30 20:33:56 1997 Hvoje Niksic - - * x11/x-toolbar.el - (toolbar-open,toolbar-dired,toolbar-save,toolbar-print,toolbar-cut,toolbar-copy,toolbar-paste,toolbar-undo,toolbar-replace): - New functions. - (toolbar-news): Allow running without separate frame. - (toolbar-mail-commands-alist): New variable. - (toolbar-mail-reader): Ditto. - (toolbar-mail): Use them. - - * x11/x-menubar.el: Shorten help menu item names. - -Thu Jan 30 17:22:15 1997 Alexandre Oliva - - * iso/iso-acc.el: Accept accents in isearch. - -Wed Jan 29 22:25:38 1997 Tomasz J. Cholewo - - * packages/ps-print.el: Make postscript files generated by - ps-print conformant to Adobe DSC specification. - -Mon Jan 27 21:45:17 1997 Tomasz J. Cholewo - - * dired/ange-ftp.el (ange-ftp-write-region): Changes for jka-compr. - - * packages/jka-compr.el (jka-compr-write-region): Convert to 20.0 - write-region interface. - -Mon Jan 27 19:09:28 1997 Steven L Baur - - * prim/about.el (about-xemacs): Updated to reflect change of - management. - -Mon Jan 27 13:25:17 1997 William M. Perry - - * packages/man.el (Manual-entry-switches): Don't default to -s. - -Sun Jan 26 16:27:49 1997 Steven L Baur - - * bytecomp/byte-optimize.el (byte-compile-inline-expand): - Correctly refresh the pointer to a symbol being autoloaded prior - to inline. - -Sun Jan 26 13:57:22 1997 Bob Weiner - - * prim/about.el (about-xemacs-xref): Update bio. - -Sat Jan 25 22:58:15 1997 Steven L Baur - - * x11/x-menubar.el (default-menubar): Update ps-paper-type options - for new ps-print.el. - -Thu Jan 23 01:40:53 1997 Steven L Baur - - * psgml/psgml-html.el (html-mode): Set up friendlier syntax - table. - - * psgml/psgml.el (sgml-running-xemacs): Remove - sgml-mode-syntax-table since it has been superseded. - -Thu Jan 9 13:32:01 1997 Jacques Duthen Prestataire - - * ps-print.el: Merge patch from [simon] Oct 8, 1996 Simon Marshall - - (ps-print-version): Fix value. - (cl lisp-float-type): Require them. - (ps-number-of-columns ps-*-font-size): Try to select defaults - better suited when `ps-landscape-mode' is non-nil. - (ps-*-faces): Change default for Font Lock mode faces when - `ps-print-color-p' is nil. - (ps-right-header): Replace `time-stamp-yy/mm/dd' - by `time-stamp-mon-dd-yyyy'. - (ps-end-file ps-begin-page): Fix bug in page count for Ghostview. - (ps-generate-postscript-with-faces): Replace `ps-sorter' by - `car-less-than-car'. - (ps-plot ps-generate): Replace `%d' by `%3d'. - -Wed Jan 22 15:32:39 1997 Greg Klanderman - - * modes/rsz-minibuf.el (resize-minibuffer-setup): Resize the - minibuffer earlier than the first received event. - -Wed Jan 22 15:29:08 1997 Barry A. Warsaw - - * modes/imenu.el (imenu-add-to-menubar): Don't attempt anything if - menu-bar lookup fails. - -Wed Jan 22 01:03:42 1997 Martin Buchholz - - * x11/x-font-menu.el: Make font menus work better in a - Japanese environment. - -Tue Jan 21 19:56:26 1997 Martin Buchholz - - * mule/mule-init.el (init-mule): Get Japanese man pages working. - -Fri Jan 17 17:22:54 1997 Hrvoje Niksic - - * man.el (Manual-mode): Don't mess with scrollbars if they aren't - present. - -Tue Jan 21 19:52:45 1997 Steven L Baur - - * utils/timezone.el (timezone-parse-date): Fix Y2K bug. - -Tue Jan 21 19:32:44 1997 Barry A. Warsaw - - * prim/files.el (hack-local-variables-prop-line): XEmacs should - not query to set local variables in the -*- line if there aren't - any to set! - -Thu Jan 16 18:24:20 1997 Steven L Baur - - * psgml/psgml.el: Use newer interface form for nsgmls. - -Thu Jan 16 04:06:24 1997 Steven L Baur - - * comint/telnet.el (rsh): (Mostly) correct dealing with detection - of password prompt at login. - -Thu Jan 16 03:28:25 1997 Martin Buchholz - - * modes/view.el (View-scroll-lines-forward): Correct format typo. - -Mon Jan 13 22:50:23 1997 David Moore - - * packages/compile.el: Clean up regexps. - -Sun Jan 12 20:50:08 1997 Steven L Baur - - * modes/m4-mode.el: Changed m4-program to point to /usr/bin/m4. - -Sun Jan 12 18:49:30 1997 $B - - * mule/mule-misc.el: `-columns' -> `-width' and define `-columns' - alias - Import definition of `truncate-string-to-width' from Emacs/mule-delta. - -Sun Jan 12 13:57:11 1997 Kyle Jones - - * prim/window.el (shrink-window-if-larger-than-buffer): Don't let - readjusted window change the buffer order stack. - -Sat Jan 11 20:12:47 1997 Vinnie Shelton - - * utils/finder.el (finder-insert-at-column): Correct off-by-one - error affecting long file names. - -Fri Jan 10 22:27:58 1997 Shane Holder - - * utils/bench.el: New version. - -Fri Jan 10 13:22:26 1997 Christoph Wedler - - * packages/man.el (Manual-entry-switches): New variable. - (Manual-apropos-switches): New variable. - (Manual-run-formatter): Use them. - -Thu Jan 9 22:04:42 1997 Greg Klanderman - - * modes/make-mode.el: Allow disabling of suspicious line warnings - allow macro pickup when a macro is entered normally - add the runtime macros to the completion list so confirmation is - not necessary when minibuffer-confirm-incomplete is t. - (these last two only in effect when makefile-electric-keys=t) - -Thu Jan 9 11:44:11 1997 Martin Buchholz - - * mule/mule-files.el (file-coding-system-alist): Default to 8 bit - on .el and .info files. - -Wed Jan 8 20:57:16 1997 Steven L Baur - - * prim/help.el (help-mode-quit): Correct typo in docstring. - (help-mode-quit): Bury help buffer before restoring previous - window configuration. - -Wed Jan 8 20:20:01 1997 Joe Nuspl - - * x11/x-menubar.el (default-menubar): Include enriched.doc in the - samples in the help menu. - -Wed Jan 8 20:09:32 1997 Jens Krinke - - * x11/x-toolbar.el (toolbar-news-frame-properties): New variable. - (toolbar-news): Use it. - -Wed Jan 8 10:11:35 1997 Steven L Baur - - * x11/x-compose.el (global-map): Keysyms use `-' not `_'. - -Mon Jan 6 18:19:03 1997 Steven L Baur - - * comint/telnet.el (telnet-initial-filter): Enable - case-fold-search. - (telnet-maximum-count): Bump up to 6, since 4 does not always - appear to be enough. - -Mon Jan 6 08:30:55 1997 Andrew Cohen - - * psgml/psgml-parse.el (sgml-compile-dtd): noconv coding system - has been renamed to no-conversion. - (sgml-bdtd-merge): Ditto. - (sgml-push-to-entity): Ditto. - -Sun Jan 5 14:35:30 1997 Steven L Baur - - * utils/loadhist.el (symbol-file): Make interactive. - -Sun Jan 5 00:40:02 1997 Bob Weiner - - * packages/avoid.el (mouse-avoidance-mode): autoload. - - * x11/x-menubar.el (options-menu-saved-forms): Mouse avoidance - mode option. - -Sat Jan 4 12:25:34 1997 Steven L Baur - - * prim/faces.el (init-other-random-faces): Guard against adding - modeline buffer tty face if no tty support. - -Fri Jan 3 23:15:22 1997 Greg Klanderman - - * packages/backup-dir.el: Added to distribution. - -Fri Jan 3 16:20:42 1997 Steven L Baur - - * gnus/gnus-setup.el: Updated to gracefully handle installed - auxilliary packages like tm, and handle eventual integration of - Red Gnus/Gnus 5.4. - -Fri Jan 3 14:32:07 1997 Vinnie Shelton - - * packages/gnuserv.el (gnuserv-frame): Autoload. - - * x11/x-menubar.el (default-menubar): Add option to control gnuserv - creating a new frame. - (options-menu-saved-forms): Ditto. - -Fri Jan 3 12:18:41 1997 Martin Buchholz - - * x11/x-mouse.el: Protect creation of scrollbar-pointer-glyph with - feature test on 'scrollbar. - -Fri Jan 3 10:37:48 1997 Steven L Baur - - * packages/mic-paren.el (paren-activate): Update to v1.2. - -Fri Jan 3 10:21:58 1997 Pete Ware - - * x11/x-menubar.el (default-menubar): Add require-final-newline - and next-line-add-newlines as options in the options menu. - (options-menu-saved-forms): Ditto. - -Thu Jan 2 18:52:32 1997 Joel Peterson - - * prim/simple.el (blink-matching-open): Make sure point is visible - when blinking. - -Thu Jan 2 11:25:05 1997 Vinnie Shelton - - * prim/replace.el (occur-mode-mouse-goto): Fix typo in Emacs 19.34 - synch up. - (occur-mode-map): Ditto. - -Wed Nov 20 19:40:05 1996 Lennart Staflin - - * psgml-parse.el (sgml-modify-dtd): set sgml-current-tree to - sgml-top-tree. Needed by sgml-open-element. - -Mon Nov 11 01:50:40 1996 Lennart Staflin - - * Version 1.0 released. - -Sun Sep 15 14:07:24 1996 Lennart Staflin - - * psgml.el (sgml-mode): modify mode-line-format with subst, don't - replicate the whole format in the code. - -Thu Sep 12 20:27:38 1996 Lennart Staflin - - * psgml-parse.el (sgml-external-file): Try to find system - identifiers using the sgml-public-map - if sgml-system-identifiers-are-preferred; this way that flag will - have effect even if the sgml-public-map contains `%s'. - (sgml-final): moved to be defined before use. - - * psgml-dtd.el (sgml-parse-parameter-literal): Try to handle - character references to character number above 255 by leaving a - character reference in then parsed entity text. - -Thu Sep 5 14:11:00 1996 Dave Love - - * psgml-other.el (sgml-set-face-for): Nullify - {after,before}-change-functions as well as (obsolete) - {after,before}-change-function. - -Tue Dec 31 11:34:37 1996 Steven L Baur - - * comint/gdb.el (gdb-mode): Require 'cc-mode if not already loaded - prior to starting gdb. - -Mon Dec 30 17:59:48 1996 Steven L Baur - - * comint/telnet.el (telnet-check-software-type-initialize): Remove - default in cond (which allows special treatment of password prompt - to work). - -Mon Dec 30 09:36:04 1996 Valdis Kletnieks - - * packages/gnuserv.el (server-edit): Add option to allow killing - last visible frame. - -Sun Dec 29 21:36:44 1996 Steven L Baur - - * prim/files-nomule.el: Add trailing newline. - -Sun Dec 29 18:45:34 1996 James LewisMoss - - * modes/perl-mode.el: Add (provide 'perl-mode). - -Sun Dec 29 17:15:57 1996 Martin Buchholz - - * ilisp/Makefile (elc): Be a little smarter about recompilation. - -Sun Dec 29 17:14:27 1996 Steven L Baur - - * tm/tm-edit-tipgp.el: Don't unconditionally require tinypgpa.el. - -Sat Dec 28 11:15:55 1996 Steven L Baur - - * x11/x-menubar.el (default-menubar): Move Frame-local font menu - option to Frame Appearance submenu. - -Fri Dec 27 20:30:00 1996 Steven L Baur - - * x11/x-font-menu.el (font-menu-this-frame-only-p): Default to - nil, because everyone was confused by it defaulting to t. - -Fri Dec 27 12:30:37 1996 Richard Mlynarik - - * prim/sort.el (sort-subr): Document use of `sort-fold-case'. - (sort-lines): Ditto. - (sort-paragraphs): Ditto. - (sort-pages): Ditto. - (sort-regexp-fields): Ditto. - (sort-numeric-fields): Ditto. - (sort-regexp-fields): Ditto. - (sort-columns): Ditto. - (sort-regexp-fields): Use compare-buffer-substrings if available. - -Fri Dec 27 12:09:23 1996 Noah Friedman - - * modes/mail-abbrevs.el (mail-abbrev-expand-hook): Prevent abbrev - expansion from happening multiple times. - -Fri Dec 27 02:31:15 1996 Steven L Baur - - * prim/help.el (help-for-help): Don't confuse help character `b' - with scrolling character `b' in view-less help buffer. - - * packages/scroll-in-place.el: Synch with 19.15. - -Thu Dec 26 15:25:09 1996 Steven L Baur - - * x11/x-menubar.el (xemacs-splash-buffer): New function. - (default-menubar): Use it. - (default-menubar): Reorganize help menus. - - * prim/startup.el (startup-message-timeout): More or less disable - the timeout of the splash screen. - - * packages/man.el (Manual-use-rosetta-man): For Neal Becker's - Rosetta Man patch. - (Manual-nuke-nroff-bs): Use it. - -Tue Dec 24 12:46:22 1996 Steven L Baur - - * prim/frame.el (show-temp-buffer-in-current-frame): Shrink temp - buffer to fit. - -Mon Dec 23 15:44:49 1996 Steven L Baur - - * utils/delbackspace.el: Correct rebindings so they work properly - when cc-mode is not dumped with XEmacs. - - * packages/apropos.el (apropos-print): Minimize size of *Apropos* - window if it is small. - - * prim/lisp.el (lisp-complete-symbol): Minimize size of - *Completions* window. - - * prim/help.el (with-displaying-help-buffer): (Based on an idea - from Sudish Joseph) minimize size of displayed help window. - - * modes/fortran.el (fortran-window-create-momentarily): Fix - lossage from synch with Emacs 19.34. - (fortran-abbrev-start): Ditto. - -Sun Dec 22 15:33:25 1996 Hrvoje Niksic - - * x11/x-toolbar.el (toolbar-news): Check whether this is the last - frame before deleting it. - -Sun Dec 22 00:37:42 1996 Sudish Joseph - - * eterm/tgud.el (tgud-gdb-complete-filter): Match carriage returns - as well as linefeeds. - - * eterm/term.el (term-dynamic-list-completions): Correct Emacsism - in setting unread-command-events. - -Sat Dec 21 23:37:02 1996 Bob Weiner - - * packages/font-lock.el: Update Java support. - -Sat Dec 21 22:48:59 1996 Steven L Baur - - * packages/fontl-hooks.el: Add provide (synch with 19.15). - - * x11/x-toolbar.el: Don't quote lambda macro. - - * packages/session.el: Removed from distribution. - -Sat Dec 21 22:37:37 1996 Neal Becker - - * pcl-cvs/pcl-cvs.el: Synched with pcl-cvs.el from cvs-1.9. - -Fri Dec 20 15:19:36 1996 Steven L Baur - - * packages/compile.el (compilation-error-regexp-alist): Complete - fix for lossage on bad regexps. - - * prim/loadup.el: Remove cc-mode as a dumped package. - - * prim/glyphs.el (init-glyphs): hscroll-glyph is now builtin. - - * prim/minibuf.el (minibuffer-complete-word): Correct an ebola - infection that caused incorrect interpretation of SPC in the - minibuffer. - -Thu Dec 19 22:16:47 1996 Heiko Muenkel - - * modes/outl-mouse.el (outline-glyph-menu): Remove Hide body item, - Add Show all item. - -Thu Dec 19 00:37:59 1996 Bart Robinson - - * prim/files.el: Make enable-local-variables 'ask-me behave sanely. - -Wed Dec 18 23:10:15 1996 Steven L Baur - - * prim/simple.el (next-line-add-newlines): Now defaults to nil. - -Wed Dec 18 22:56:48 1996 Hrvoje Niksic - - * utils/bench.el (bench-mark-13): Added. - -Wed Dec 18 20:26:10 1996 Martin Buchholz - - * mule/mule-coding.el: Change charset names. - - * mule/japanese-hooks.el: Change charset names. - - * mule/hebrew-hooks.el: Change charset names. - Remove quail hooks. - - * mule/greek-hooks.el: Change charset names. - Remove quail hooks. - - * mule/european-hooks.el ((make-char 'latin-iso8859-1 32)): Change - charset names. - Remove quail hooks. - - * mule/cyrillic-hooks.el (cyrillic-iso8859-5): Use instead of cyrillic. - Remove quail hooks. - - * mule/chinese-hooks.el (chinese-gb2312): Fix chinese syntax tables. - Use chinese-gb2312. - Remove quail hooks. - (chinese): Comment out code for egg. - - * mule/thai-hooks.el: Use thai-tis620. - (thai): Prefer macro definition of lambda. - - * sunpro/sunpro-init.el (sunpro-startup): Guard against Sun - censorship. - - * prim/obsolete.el (wholenump): New obsolete alias. - - * prim/simple.el (comment-indent-function): Use macro definition - of (lambda () ...). - - * prim/replace.el (list-matching-lines): Remove redundant - (message (format ...)) - - * modes/cc-mode.el: Readd autoloads (prior to removing cc-mode as - a dumped package). - -Wed Dec 18 11:09:45 1996 Steven L Baur - - * comint/telnet.el: Synch up to 19.15 & Emacs 19.34. - (telnet-check-software-type-initialize): Cleanup from Synch. - -Sat Dec 14 17:39:17 1996 Steven L Baur - - * packages/buff-menu.el (list-buffers-directory): autoload. - -Fri Dec 13 16:53:14 1996 Steven L Baur - - * electric/ebuff-menu.el (electric-buffer-list): Restore behavior - of using prefix argument. - - * emulators/crisp.el (crisp-mode-map): Rename kp_.* keysyms to - kp-\1. - - * emulators/tpu-edt.el: Ditto. - - * x11/x-win-sun.el: Ditto. - - * x11/x-iso8859-1.el: Ditto. - - * term/tvi970.el: Ditto. - - * term/news.el: Ditto. - - * term/lk201.el: Ditto. - - * term/linux.el: Ditto. - - * prim/keydefs.el: Ditto. - - * prim/events.el: Ditto. - - * packages/icomplete.el (icomplete-get-keys): Ditto. - - * games/gomoku.el (gomoku-mode-map): Ditto. - - * games/blackbox.el (blackbox-mode-map): Ditto. - -Fri Dec 13 09:40:27 1996 Sudish Joseph - - * prim/minibuf.el (next-history-element): Remove kludge test on - minibuffer-history-sexp-flag. - - * x11/x-init.el (init-post-x-win): Fix hooks for gnuattached ttys - on XEmacsen started on X displays. - -Thu Dec 12 16:05:53 1996 Raymond Toy - - * ilisp/ilisp-out.el (ilisp-find-lower-window): Correct XEmacs - version check to look at major numbers. - (ilisp-find-top-left-most-window): Ditto. - -Thu Dec 12 15:21:43 1996 Lars Magne Ingebrigtsen - - * utils/mail-extr.el (mail-extract-address-components): Don't - automatically downcase extracted elements. It violates standards. - -Thu Dec 12 14:46:47 1996 Christoph Wedler - - * x11/x-menubar.el (buffers-menu-filter): The buffer menu was - shortened to `buffers-menu-max-size' items even if - `buffers-menu-submenus-for-groups-p' is non-nil. - - Let `buffers-menu-submenus-for-groups-p' be an integer : if there - are more buffers than this value, use submenus, otherwise not. - - * packages/vc.el (vc-rename-this-file): New function (was missing, - but referred to on the menubar). - - * packages/compile.el (compilation-font-lock-keywords): `defvar' - instead of `defconst'! - - * prim/mouse.el (default-mouse-track-normalize-point): Double - click mouse-1 on sexpr selects the sexpr. - - * x11/x-menubar.el (options-menu-saved-forms): Fix bug in - `save-options-menu-settings'. - -Thu Dec 12 14:25:21 1996 Steven L Baur - - * prim/simple.el (forward-to-indentation): Do not deactivate zmacs - region on usage. - (backward-to-indentation): Ditto. - -Thu Dec 12 14:22:55 1996 Christoph Wedler - - * prim/lisp.el (backward-up-list): Do not deactivate zmacs region - on usage. - -Wed Dec 11 20:26:21 1996 Barry A. Warsaw - - * prim/files.el (set-auto-mode): Require a #! signature to set - mode based on interpreter. - -Wed Dec 11 13:25:50 1996 Steven L Baur - - * packages/man.el (Manual-use-rosetta-man): Restore Neal Becker's - Rosetta Man Patch. - (Man-cleanup-manpage): Use it. - - * prim/simple.el (yank): Corrected a mistaken synch with Emacs - 19.34. - - * modes/eiffel3.el (eiffel-mode-syntax-table): Quote the semicolon - syntax entry so update-autoloads doesn't barf. - - * packages/buff-menu.el (Buffer-menu-mode-map): Correct mouse key - bindings. - -Tue Dec 10 21:24:04 1996 Steven L Baur - - * packages/ps-print.el (ps-do-despool): Allow dynamic expansion of - `ps-lpr-switches'. - - * packages/lpr.el (print-region-1): Allow dynamic expansion of - `lpr-switches'. - -Tue Dec 10 18:30:01 1996 Rod Whitby - - * modes/vhdl-mode.el: New File. - -Tue Dec 10 17:59:35 1996 Shane Holder - - * utils/bench.el: New file. Utility for benchmarking emacs - performance. - -Tue Dec 10 10:11:55 1996 Steven L Baur - - * electric/ebuff-menu.el (electric-buffer-menu-mode-map): Correct - bad 19.34 synch patch. - - * utils/pretty-print.el: New File. - -Sun Dec 8 13:59:40 1996 Steven L Baur - - * prim/files-nomule.el: Documentation corrections. - - * prim/files.el: Synch to 19.15/Emacs 19.34. - -Sat Dec 7 18:48:34 1996 Steven L Baur - - * packages/hexl.el (hexl-mode-map): Corrected obsolescent key - names introduced in 19.15-b2. - -Fri Dec 6 20:17:47 1996 Steven L Baur - - * games/yow.el: Sync to GNU Emacs 19.34. - - * games/studly.el: Documentation fixes. - - * games/spook.el: Sync to GNU Emacs 19.34. - - * games/mpuz.el: Sync to GNU Emacs 19.34. - - * games/life.el: Sync to GNU Emacs 19.34. - - * games/hanoi.el: Sync to GNU Emacs 19.34. - - * games/flame.el: Documentation fixes. - - * games/dunnet.el: Sync to GNU Emacs 19.34. - - * games/doctor.el: Sync to GNU Emacs 19.34. - - * games/dissociate.el: Sync to GNU Emacs 19.34. - - * games/cookie1.el: Sync to GNU Emacs 19.34. - - * games/conx.el: Documentation fixes. - - * games/blackbox.el: Sync to GNU Emacs 19.34. - - * games/NeXTify.el: Documentation fixes. - - * packages/man.el: New file/replacement from Emacs 19.34. - - * packages/man-xref.el: New file from Emacs 19.35. - - * utils/smtpmail.el: New file from Emacs 19.34. - -Fri Dec 6 09:28:04 1996 $B - - * prim/startup.el (set-default-load-path): Set default-load-path - dynamically since file-detect.el is dumped with XEmacs. - -Thu Dec 5 20:37:32 1996 Steven L Baur - - * emulators/tpu-mapper.el: Total replacement with version in GNU - Emacs 19.34. - - * emulators/tpu-extras.el: Total replacement with version in GNU - Emacs 19.34. - - * emulators/tpu-edt.el: Total replacement with version in GNU Emacs - 19.34. - - * comint/history.el: Documentation fixes. - - * comint/gdb.el: Documentation fixes. - - * comint/dbx.el: Documentation fixes. - - * comint/background.el: Documentation fixes. - - * rmail/rmail-xemacs.el: Documentation fixes. - - * rmail/rmail-kill.el: Documentation fixes. - - * emulators/ws-mode.el: Synch up to Emacs 19.34. - - * emulators/teco.el: Documentation cleanup. - - * emulators/mlsupport.el: Synch up to Emacs 19.34. - - * emulators/mlconvert.el: Synch up to Emacs 19.34. - - * emulators/edt-vt100.el: New file from Emacs 19.34. - - * emulators/edt-pc.el: New file from Emacs 19.34. - - * emulators/edt-mapper.el: New file from Emacs 19.34. - - * emulators/edt-lk201.el: New file from Emacs 19.34. - - * emulators/edt.el: Synched up to Emacs 19.34. - -Thu Dec 5 12:09:19 1996 Lars Magne Ingebrigtsen - - * prim/replace.el (match-string): Use a function instead of a - macro to be compatible with .elc files compiled under Emacs. - -Thu Dec 5 09:50:12 1996 Bob Weiner - - * utils/id-select.el: New file -- Version 1.4.3. - -Thu Dec 5 09:17:53 1996 Gary D. Foster - - * emulators/crisp.el: New file. - - * emulators/scroll-lock.el: New file. - -Thu Dec 5 00:15:59 1996 Steven L Baur - - * prim/help.el: A callable library-type function should not - contain an unprotected print statement. This change implements my - version of Erik Naggum's statement about locate-library being less - chatty in Emacs 19.35. - -Wed Dec 4 22:00:49 1996 Steven L Baur - - * utils/flow-ctrl.el: Synch up to Emacs 19.34. - - * utils/forms.el: Synch up to Emacs 19.34. - - * packages/column.el: Allow column numbers to start at one. - - * prim/userlock.el: Synch up to Emacs 19.34. - - * prim/paragraphs.el: Synch up to Emacs 19.34. - - * prim/page.el: Synch up to Emacs 19.34. - - * prim/options.el: Synch up to Emacs 19.34. - - * prim/novice.el: Synch up to Emacs 19.34. - - * prim/rect.el: Sync up to Emacs 19.34. - - * prim/reposition.el: Synch up to Emacs 19.34. - - * prim/replace.el: Synch up to Emacs 19.34. - - * prim/register.el: Synch up to Emacs 19.34. - - * prim/indent.el: Synch up to Emacs 19.34. - - * prim/subr.el: Synch up to Emacs 19.34. - - * prim/simple.el: Synch up to Emacs 19.34. - - * prim/debug.el: Synch up to Emacs 19.34. - - * edebug/cl-specs.el: Comment formatting changes. - - * edebug/cl-read.el: Protect advisement of eval-region from being - evaluated more than once. - - Comment formatting changes. - - * edebug/advise-eval-region.el: New File. Separate out advise for - eval-region so it is only evaluated once. - - * packages/icomplete.el: Fix a bug in locating command bound to key. - - icomplete-exhibit needs to be called in the setup-hook. - - * packages/apropos.el: Correct a typo in button binding. - - Fixes the bug where if apropos-label-face is actually defined as - face, apropos bombs with an error - - Do a (provide 'apropos), like all packages should. - - Provides an apropos-mode-hook for Apropos Mode buffers (otherwise - customization is unnecessarily painful). - - Redefines the default faces for the various apropos faces so they - come out in color by default (defaults are based on various - standard font-lock faces). - - * version.el: Bumped up to b31. - - diff --git a/lisp/abbrev.el b/lisp/abbrev.el deleted file mode 100644 index dec62a1..0000000 --- a/lisp/abbrev.el +++ /dev/null @@ -1,544 +0,0 @@ -;;; abbrev.el --- abbrev mode commands for Emacs - -;; Copyright (C) 1985, 1986, 1987, 1992, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: abbrev, dumped - -;; 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 some additions) - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; This facility is documented in the Emacs Manual. - -;;; Code: - -(defgroup abbrev nil - "Abbreviation handling, typing shortcuts, macros." - :tag "Abbreviations" - :group 'editing) - -(defgroup abbrev-mode nil - "Word abbreviations mode." - :group 'abbrev) - -;jwz: this is preloaded so don't ;;;###autoload -(defcustom only-global-abbrevs nil "\ -*Non-nil means user plans to use global abbrevs only. -Makes the commands to define mode-specific abbrevs define global ones instead." - :type 'boolean - :group 'abbrev) - -;;; XEmacs: the following block of code is not in FSF -(defvar abbrev-table-name-list '() - "List of symbols whose values are abbrev tables.") - -(defvar abbrevs-changed nil - "Set non-nil by defining or altering any word abbrevs. -This causes `save-some-buffers' to offer to save the abbrevs.") - -(defun make-abbrev-table () - "Return a new, empty abbrev table object." - (make-vector 59 0)) ; 59 is prime - -(defun clear-abbrev-table (table) - "Undefine all abbrevs in abbrev table TABLE, leaving it empty." - (fillarray table 0) - (setq abbrevs-changed t) - nil) - - -(defun define-abbrev-table (name defs) - "Define TABNAME (a symbol) as an abbrev table name. -Define abbrevs in it according to DEFINITIONS, which is a list of elements -of the form (ABBREVNAME EXPANSION HOOK USECOUNT)." - (let ((table (and (boundp name) (symbol-value name)))) - (cond ((vectorp table)) - ((not table) - (setq table (make-abbrev-table)) - (set name table) - (setq abbrev-table-name-list (cons name abbrev-table-name-list))) - (t - (setq table (signal 'wrong-type-argument (list 'vectorp table))) - (set name table))) - (while defs - (apply (function define-abbrev) table (car defs)) - (setq defs (cdr defs))))) - -(defun define-abbrev (table name &optional expansion hook count) - "Define an abbrev in TABLE named NAME, to expand to EXPANSION or call HOOK. -NAME and EXPANSION are strings. Hook is a function or `nil'. -To undefine an abbrev, define it with an expansion of `nil'." - (or (not expansion) - (stringp expansion) - (setq expansion (signal 'wrong-type-argument - (list 'stringp expansion)))) - (or (not count) - (integerp count) - (setq count (signal 'wrong-type-argument - (list 'fixnump count)))) - (or (vectorp table) - (setq table (signal 'wrong-type-argument - (list 'vectorp table)))) - (let* ((sym (intern name table)) - (oexp (and (boundp sym) (symbol-value sym))) - (ohook (and (fboundp sym) (symbol-function sym)))) - (unless (and (equal ohook hook) - (stringp oexp) - (stringp expansion) - (string-equal oexp expansion)) - (setq abbrevs-changed t) - ;; If there is a non-word character in the string, set the flag. - (if (string-match "\\W" name) - (set (intern " " table) nil))) - (set sym expansion) - (fset sym hook) - (setplist sym (or count 0)) - name)) - - -;; Fixup stuff from bootstrap def of define-abbrev-table in subr.el -(let ((l abbrev-table-name-list)) - (while l - (let ((fixup (car l))) - (if (consp fixup) - (progn - (setq abbrev-table-name-list (delq fixup abbrev-table-name-list)) - (define-abbrev-table (car fixup) (cdr fixup)))) - (setq l (cdr l)))) - ;; These are no longer initialized by C code - (if (not global-abbrev-table) - (progn - (setq global-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'global-abbrev-table - abbrev-table-name-list)))) - (if (not fundamental-mode-abbrev-table) - (progn - (setq fundamental-mode-abbrev-table (make-abbrev-table)) - (setq abbrev-table-name-list (cons 'fundamental-mode-abbrev-table - abbrev-table-name-list)))) - (and (eq major-mode 'fundamental-mode) - (not local-abbrev-table) - (setq local-abbrev-table fundamental-mode-abbrev-table))) - - -(defun define-global-abbrev (name expansion) - "Define ABBREV as a global abbreviation for EXPANSION." - (interactive "sDefine global abbrev: \nsExpansion for %s: ") - (define-abbrev global-abbrev-table - (downcase name) expansion nil 0)) - -(defun define-mode-abbrev (name expansion) - "Define ABBREV as a mode-specific abbreviation for EXPANSION." - (interactive "sDefine mode abbrev: \nsExpansion for %s: ") - (define-abbrev (or local-abbrev-table - (error "Major mode has no abbrev table")) - (downcase name) expansion nil 0)) - -(defun abbrev-symbol (abbrev &optional table) - "Return the symbol representing abbrev named ABBREV. -This symbol's name is ABBREV, but it is not the canonical symbol of that name; -it is interned in an abbrev-table rather than the normal obarray. -The value is nil if that abbrev is not defined. -Optional second arg TABLE is abbrev table to look it up in. -The default is to try buffer's mode-specific abbrev table, then global table." - (let ((frob (function (lambda (table) - (let ((sym (intern-soft abbrev table))) - (if (and (boundp sym) - (stringp (symbol-value sym))) - sym - nil)))))) - (if table - (funcall frob table) - (or (and local-abbrev-table - (funcall frob local-abbrev-table)) - (funcall frob global-abbrev-table))))) - -(defun abbrev-expansion (abbrev &optional table) - "Return the string that ABBREV expands into in the current buffer. -Optionally specify an abbrev table as second arg; -then ABBREV is looked up in that table only." - (let ((sym (abbrev-symbol abbrev table))) - (if sym - (symbol-value sym) - nil))) - -(defun unexpand-abbrev () - "Undo the expansion of the last abbrev that expanded. -This differs from ordinary undo in that other editing done since then -is not undone." - (interactive) - (if (or (< last-abbrev-location (point-min)) - (> last-abbrev-location (point-max)) - (not (stringp last-abbrev-text))) - nil - (let* ((opoint (point)) - (val (symbol-value last-abbrev)) - (adjust (length val))) - ;; This isn't correct if (symbol-function last-abbrev-text) - ;; was used to do the expansion - (goto-char last-abbrev-location) - (delete-region last-abbrev-location (+ last-abbrev-location adjust)) - (insert last-abbrev-text) - (setq adjust (- adjust (length last-abbrev-text))) - (setq last-abbrev-text nil) - (if (< last-abbrev-location opoint) - (goto-char (- opoint adjust)) - (goto-char opoint))))) - - - -(defun insert-abbrev-table-description (name human-readable) - "Insert before point a full description of abbrev table named NAME. -NAME is a symbol whose value is an abbrev table. -If optional 2nd arg HUMAN is non-nil, insert a human-readable description. -Otherwise the description is an expression, -a call to `define-abbrev-table', which would -define the abbrev table NAME exactly as it is currently defined." - (let ((table (symbol-value name)) - (stream (current-buffer))) - (message "Abbrev-table %s..." name) - (if human-readable - (progn - (prin1 (list name) stream) - ;; Need two terpri's or cretinous edit-abbrevs blows out - (terpri stream) - (terpri stream) - (mapatoms (function (lambda (sym) - (if (symbol-value sym) - (let* ((n (prin1-to-string (symbol-name sym))) - (pos (length n))) - (princ n stream) - (while (< pos 14) - (write-char ?\ stream) - (setq pos (1+ pos))) - (princ (format " %-5S " (symbol-plist sym)) - stream) - (if (not (symbol-function sym)) - (prin1 (symbol-value sym) stream) - (progn - (setq n (prin1-to-string (symbol-value sym)) - pos (+ pos 6 (length n))) - (princ n stream) - (while (< pos 45) - (write-char ?\ stream) - (setq pos (1+ pos))) - (prin1 (symbol-function sym) stream))) - (terpri stream))))) - table) - (terpri stream)) - (progn - (princ "\(define-abbrev-table '" stream) - (prin1 name stream) - (princ " '\(\n" stream) - (mapatoms (function (lambda (sym) - (if (symbol-value sym) - (progn - (princ " " stream) - (prin1 (list (symbol-name sym) - (symbol-value sym) - (symbol-function sym) - (symbol-plist sym)) - stream) - (terpri stream))))) - table) - (princ " \)\)\n" stream))) - (terpri stream)) - (message "")) -;;; End code not in FSF - -(defun abbrev-mode (arg) - "Toggle abbrev mode. -With argument ARG, turn abbrev mode on iff ARG is positive. -In abbrev mode, inserting an abbreviation causes it to expand -and be replaced by its expansion." - (interactive "P") - (setq abbrev-mode - (if (null arg) (not abbrev-mode) - (> (prefix-numeric-value arg) 0))) - ;; XEmacs change - (redraw-modeline)) - - -(defvar edit-abbrevs-map nil - "Keymap used in edit-abbrevs.") -(if edit-abbrevs-map - nil - (setq edit-abbrevs-map (make-sparse-keymap)) - ;; XEmacs change - (set-keymap-name edit-abbrevs-map 'edit-abbrevs-map) - (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine) - (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine)) - -(defun kill-all-abbrevs () - "Undefine all defined abbrevs." - (interactive) - (let ((tables abbrev-table-name-list)) - (while tables - (clear-abbrev-table (symbol-value (car tables))) - (setq tables (cdr tables))))) - -(defun insert-abbrevs () - "Insert after point a description of all defined abbrevs. -Mark is set after the inserted text." - (interactive) - (push-mark - (save-excursion - (let ((tables abbrev-table-name-list)) - (while tables - (insert-abbrev-table-description (car tables) t) - (setq tables (cdr tables)))) - (point)))) - -(defun list-abbrevs () - "Display a list of all defined abbrevs." - (interactive) - (display-buffer (prepare-abbrev-list-buffer))) - -(defun prepare-abbrev-list-buffer () - (save-excursion - (set-buffer (get-buffer-create "*Abbrevs*")) - (erase-buffer) - (let ((tables abbrev-table-name-list)) - (while tables - (insert-abbrev-table-description (car tables) t) - (setq tables (cdr tables)))) - (goto-char (point-min)) - (set-buffer-modified-p nil) - (edit-abbrevs-mode)) - (get-buffer-create "*Abbrevs*")) - -(defun edit-abbrevs-mode () - "Major mode for editing the list of abbrev definitions. -\\{edit-abbrevs-map}" - (interactive) - (setq major-mode 'edit-abbrevs-mode) - (setq mode-name "Edit-Abbrevs") - (use-local-map edit-abbrevs-map)) - -(defun edit-abbrevs () - "Alter abbrev definitions by editing a list of them. -Selects a buffer containing a list of abbrev definitions. -You can edit them and type \\\\[edit-abbrevs-redefine] to redefine abbrevs -according to your editing. -Buffer contains a header line for each abbrev table, - which is the abbrev table name in parentheses. -This is followed by one line per abbrev in that table: -NAME USECOUNT EXPANSION HOOK -where NAME and EXPANSION are strings with quotes, -USECOUNT is an integer, and HOOK is any valid function -or may be omitted (it is usually omitted)." - (interactive) - (switch-to-buffer (prepare-abbrev-list-buffer))) - -(defun edit-abbrevs-redefine () - "Redefine abbrevs according to current buffer contents." - (interactive) - (define-abbrevs t) - (set-buffer-modified-p nil)) - -(defun define-abbrevs (&optional arg) - "Define abbrevs according to current visible buffer contents. -See documentation of `edit-abbrevs' for info on the format of the -text you must have in the buffer. -With argument, eliminate all abbrev definitions except -the ones defined from the buffer now." - (interactive "P") - (if arg (kill-all-abbrevs)) - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (re-search-forward "^(" nil t)) - (let* ((buf (current-buffer)) - (table (read buf)) - abbrevs name hook exp count) - (forward-line 1) - (while (progn (forward-line 1) - (not (eolp))) - (setq name (read buf) count (read buf) exp (read buf)) - (skip-chars-backward " \t\n\f") - (setq hook (if (not (eolp)) (read buf))) - (skip-chars-backward " \t\n\f") - (setq abbrevs (cons (list name exp hook count) abbrevs))) - (define-abbrev-table table abbrevs))))) - -(defun read-abbrev-file (&optional file quietly) - "Read abbrev definitions from file written with `write-abbrev-file'. -Optional argument FILE is the name of the file to read; -it defaults to the value of `abbrev-file-name'. -Optional second argument QUIETLY non-nil means don't print anything." - (interactive "fRead abbrev file: ") - (load (if (and file (> (length file) 0)) file abbrev-file-name) - nil quietly) - (setq save-abbrevs t abbrevs-changed nil)) - -(defun quietly-read-abbrev-file (&optional file) - "Read abbrev definitions from file written with write-abbrev-file. -Optional argument FILE is the name of the file to read; -it defaults to the value of `abbrev-file-name'. -Does not print anything." - ;(interactive "fRead abbrev file: ") - (read-abbrev-file file t)) - -(defun write-abbrev-file (file) - "Write all abbrev definitions to a file of Lisp code. -The file written can be loaded in another session to define the same abbrevs. -The argument FILE is the file name to write." - (interactive - (list - (read-file-name "Write abbrev file: " - (file-name-directory (expand-file-name abbrev-file-name)) - abbrev-file-name))) - (or (and file (> (length file) 0)) - (setq file abbrev-file-name)) - (save-excursion - (set-buffer (get-buffer-create " write-abbrev-file")) - (erase-buffer) - (let ((tables abbrev-table-name-list)) - (while tables - (insert-abbrev-table-description (car tables) nil) - (setq tables (cdr tables)))) - (write-region 1 (point-max) file) - (erase-buffer))) - -(defun add-mode-abbrev (arg) - "Define mode-specific abbrev for last word(s) before point. -Argument is how many words before point form the expansion; -or zero means the region is the expansion. -A negative argument means to undefine the specified abbrev. -Reads the abbreviation in the minibuffer. - -Don't use this function in a Lisp program; use `define-abbrev' instead." - ;; XEmacs change: - (interactive "P") - (add-abbrev - (if only-global-abbrevs - global-abbrev-table - (or local-abbrev-table - (error "No per-mode abbrev table"))) - "Mode" arg)) - -(defun add-global-abbrev (arg) - "Define global (all modes) abbrev for last word(s) before point. -The prefix argument specifies the number of words before point that form the -expansion; or zero means the region is the expansion. -A negative argument means to undefine the specified abbrev. -This command uses the minibuffer to read the abbreviation. - -Don't use this function in a Lisp program; use `define-abbrev' instead." - ;; XEmacs change: - (interactive "P") - (add-abbrev global-abbrev-table "Global" arg)) - -(defun add-abbrev (table type arg) - ;; XEmacs change: - (if (and (not arg) (region-active-p)) (setq arg 0) - (setq arg (prefix-numeric-value arg))) - (let ((exp (and (>= arg 0) - (buffer-substring - (point) - (if (= arg 0) (mark) - (save-excursion (forward-word (- arg)) (point)))))) - name) - (setq name - (read-string (format (if exp "%s abbrev for \"%s\": " - "Undefine %s abbrev: ") - type exp))) - (set-text-properties 0 (length name) nil name) - (if (or (null exp) - (not (abbrev-expansion name table)) - (y-or-n-p (format "%s expands to \"%s\"; redefine? " - name (abbrev-expansion name table)))) - (define-abbrev table (downcase name) exp)))) - -(defun inverse-add-mode-abbrev (arg) - "Define last word before point as a mode-specific abbrev. -With prefix argument N, defines the Nth word before point. -This command uses the minibuffer to read the expansion. -Expands the abbreviation after defining it." - (interactive "p") - (inverse-add-abbrev - (if only-global-abbrevs - global-abbrev-table - (or local-abbrev-table - (error "No per-mode abbrev table"))) - "Mode" arg)) - -(defun inverse-add-global-abbrev (arg) - "Define last word before point as a global (mode-independent) abbrev. -With prefix argument N, defines the Nth word before point. -This command uses the minibuffer to read the expansion. -Expands the abbreviation after defining it." - (interactive "p") - (inverse-add-abbrev global-abbrev-table "Global" arg)) - -(defun inverse-add-abbrev (table type arg) - (let (name nameloc exp) - (save-excursion - (forward-word (- arg)) - (setq name (buffer-substring (point) (progn (forward-word 1) - (setq nameloc (point)))))) - (set-text-properties 0 (length name) nil name) - (setq exp (read-string (format "%s expansion for \"%s\": " - type name))) - (if (or (not (abbrev-expansion name table)) - (y-or-n-p (format "%s expands to \"%s\"; redefine? " - name (abbrev-expansion name table)))) - (progn - (define-abbrev table (downcase name) exp) - (save-excursion - (goto-char nameloc) - (expand-abbrev)))))) - -(defun abbrev-prefix-mark (&optional arg) - "Mark current point as the beginning of an abbrev. -Abbrev to be expanded starts here rather than at beginning of word. -This way, you can expand an abbrev with a prefix: insert the prefix, -use this command, then insert the abbrev." - (interactive "P") - (or arg (expand-abbrev)) - (setq abbrev-start-location (point-marker) - abbrev-start-location-buffer (current-buffer)) - (let ((e (make-extent (point) (point)))) - (set-extent-begin-glyph e (make-glyph [string :data "-"])))) - -(defun expand-region-abbrevs (start end &optional noquery) - "For abbrev occurrence in the region, offer to expand it. -The user is asked to type y or n for each occurrence. -A prefix argument means don't query; expand all abbrevs. -If called from a Lisp program, arguments are START END &optional NOQUERY." - (interactive "r\nP") - (save-excursion - (goto-char start) - (let ((lim (- (point-max) end)) - pnt string) - (while (and (not (eobp)) - (progn (forward-word 1) - (<= (setq pnt (point)) (- (point-max) lim)))) - (if (abbrev-expansion - (setq string - (buffer-substring - (save-excursion (forward-word -1) (point)) - pnt))) - (if (or noquery (y-or-n-p (format "Expand `%s'? " string))) - (expand-abbrev))))))) - -;;; abbrev.el ends here diff --git a/lisp/about.el b/lisp/about.el deleted file mode 100644 index 959887e..0000000 --- a/lisp/about.el +++ /dev/null @@ -1,1517 +0,0 @@ -;;; about.el --- the About The Authors page (shameless self promotion). - -;; Copyright (c) 1997 Free Software Foundation, Inc. - -;; Keywords: extensions -;; Version: 2.4 -;; Maintainer: Hrvoje Niksic - -;; 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. - -;; Original code: Jamie Zawinski -;; Text: Ben Wing , Jamie Zawinski -;; Hard: Amiga 1000, Progressive Peripherals Frame Grabber. -;; Soft: FG 2.0, DigiPaint 3.0, pbmplus (dec 91), xv 3.0. -;; Modified for 19.11 by Eduardo Pelegri-Llopart -;; and Chuck Thompson -;; More hacking for 19.12 by Chuck Thompson and Ben Wing. -;; 19.13 and 19.14 updating done by Chuck Thompson. -;; 19.15 and 20.0 updating done by Steve Baur and Martin Buchholz. - -;; Completely rewritten for 20.3 by Hrvoje Niksic . -;; The original had no version numbers; I numbered the rewrite as 2.0. - -;; Many things in this file are to gag. Ideally, we should just use -;; HTML (or some other extension, e.g. info) for this sort of thing. -;; However, W3 loads too long and is too large to be dumped with -;; XEmacs. - -;; If you think this is ugly now -- o boy, you should have seen it -;; before. - -(require 'wid-edit) - -;; People in this list have their individual links from the main page, -;; or from the `Legion' page. If they have an image, it should be -;; named after the CAR of the list element (baw -> baw.png). -;; -;; If you add to this list, you'll want to update -;; `about-maintainer-info' (and maybe `about-hackers'. -(defvar xemacs-hackers - '((ajc "Andrew Cosgriff" "ajc@bing.wattle.id.au") - (baw "Barry Warsaw" "bwarsaw@python.org") - (bw "Bob Weiner" "weiner@altrasoft.com") - (chr "Christian Nybø" "chr@mediascience.no") - (cthomp "Chuck Thompson" "cthomp@xemacs.org") - (dmoore "David Moore" "dmoore@ucsd.edu") - (dkindred "Darrell Kindred" "dkindred@cmu.edu") - (dv "Didier Verna" "verna@inf.enst.fr") - (hniksic "Hrvoje Niksic" "hniksic@srce.hr") - (jareth "Jareth Hein" "jareth@camelot.co.jp") - (jason "Jason Mastaler" "jason@xemacs.org") - (jens "Jens Lautenbacher" "jens@lemcbed.lem.uni-karlsruhe.de") - (jmiller "Jeff Miller" "jmiller@smart.net") - (juhp "Jens-Ulrik Holger Petersen" "petersen@kurims.kyoto-u.ac.jp") - (jwz "Jamie Zawinski" "jwz@netscape.com") - (kazz "IENAGA Kazuyuki" "ienaga@jsys.co.jp") - (kyle "Kyle Jones" "kyle_jones@wonderworks.com") - (larsi "Lars Magne Ingebrigtsen" "larsi@gnus.org") - (marcpa "Marc Paquette" "marcpa@CAM.ORG") - (mcook "Michael R. Cook" "mcook@cognex.com") - (mly "Richard Mlynarik" "mly@adoc.xerox.com") - (morioka "MORIOKA Tomohiko" "morioka@jaist.ac.jp") - (martin "Martin Buchholz" "martin@xemacs.org") - (ograf "Oliver Graf" "ograf@fga.de") - (pez "Peter Pezaris" "pez@dwwc.com") - (piper "Andy Piper" "andy@xemacs.org") - (rickc "Rick Campbell" "rickc@lehman.com") - (rossini "Anthony Rossini" "rossini@stat.sc.edu") - (vin "Vin Shelton" "acs@acm.org") - (sperber "Michael Sperber" "sperber@informatik.uni-tuebingen.de") - (slb "SL Baur" "steve@xemacs.org") - (stig "Jonathan Stigelman" "stig@hackvan.com") - (stigb "Stig Bjorlykke" "stigb@tihlde.hist.no") - (thiessel "Marcus Thiessel" "marcus@xemacs.org") - (vladimir "Vladimir Ivanovic" "vladimir@mri.com") - (wing "Ben Wing" "ben@xemacs.org") - (wmperry "William Perry" "wmperry@aventail.com")) - "Alist of XEmacs hackers.") - -;; The CAR of alist elements is a valid argument to `about-url-link'. -;; It is preferred to a simple string, because it makes maintenance -;; easier. Please add new URLs to this list. -(defvar about-url-alist - '((ajc . "http://www-personal.monash.edu.au/~ajc/") - (altrasoft . "http://www.altrasoft.com/") - (ben . "http://www.666.com/ben/") - (ben-xemacs . "http://www.666.com/xemacs/") - (baw . "http://www.python.org/~bwarsaw/") - (cc-mode . "http://www.python.org/ftp/emacs/") - (chr . "http://www.xemacs.org/faq/") - (dkindred . "http://www.cs.cmu.edu/People/dkindred/me.html") - (dmoore . "http://oj.egbt.org/dmoore/") - (jason . "http://www.mastaler.com/") - (juhp . "http://www.kurims.kyoto-u.ac.jp/~petersen/") - (jwz . "http://people.netscape.com/jwz/") - (kazz . "http://www.imasy.or.jp/~kazz/") - (kyle . "http://www.wonderworks.com/kyle/") - (larsi . "http://www.ifi.uio.no/~larsi/") - (marcpa . "http://www.positron911.com/products/power.htm") - (ograf . "http://www.fga.de/~ograf/") - (pez . "http://www.dwwc.com/") - (piper . "http://www.xemacs.freeserve.co.uk/") - (vin . "http://www.upa.org/") - (stigb . "http://www.tihlde.hist.no/~stigb/") - (wget . "ftp://gnjilux.cc.fer.hr/pub/unix/util/wget/") - (xemacs . "http://www.xemacs.org/")) - "Some of the more important URLs.") - -(defvar about-left-margin 3) - -;; Insert a URL link to the buffer. -(defun about-url-link (what &optional echo) - (or (stringp what) - (setq what (cdr (assq what about-url-alist)))) - (assert what) - (widget-create 'url-link - :button-prefix "" - :button-suffix "" - :help-echo echo - what)) - -;; Attach a face to a string, in order to be inserted into the buffer. -;; Make sure that the extent is duplicable, but unique. Returns the -;; string. -(defun about-with-face (string face) - (let ((ext (make-extent 0 (length string) string))) - (set-extent-property ext 'duplicable t) - (set-extent-property ext 'unique t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'end-open t) - (set-extent-face ext face)) - string) - -;; Switch to buffer NAME. If it doesn't exist, make it and switch to it. -(defun about-get-buffer (name) - (cond ((get-buffer name) - (switch-to-buffer name) - (delete-other-windows) - (goto-char (point-min)) - name) - (t - (switch-to-buffer name) - (delete-other-windows) - (buffer-disable-undo) - (set-specifier left-margin-width about-left-margin (current-buffer)) - nil))) - -;; Set up the stuff needed by widget. Allowed types are `bury' and -;; `kill'. -(defun about-finish-buffer (&optional type) - (or type (setq type 'bury)) - (widget-insert "\n") - (if (eq type 'bury) - (widget-create 'link :help-echo "Bury buffer" - :action (lambda (&rest ignore) - (bury-buffer)) - "Remove") - (widget-create 'link :help-echo "Kill buffer" - :action (lambda (&rest ignore) - (kill-buffer (current-buffer))) - "Kill")) - (widget-insert " this buffer.\n") - (use-local-map (make-sparse-keymap)) - (set-keymap-parent (current-local-map) widget-keymap) - (if (eq type 'bury) - (progn - (local-set-key "q" 'bury-buffer) - (local-set-key "l" 'bury-buffer)) - (let ((dispose (lambda () (interactive) (kill-buffer (current-buffer))))) - (local-set-key "q" dispose) - (local-set-key "l" dispose))) - (local-set-key " " 'scroll-up) - (local-set-key "\177" 'scroll-down) - (widget-setup) - (goto-char (point-min)) - (toggle-read-only 1) - (set-buffer-modified-p nil)) - -;; Make the appropriate number of spaces. -(defun about-center (string-or-glyph) - (let ((n (- (startup-center-spaces string-or-glyph) about-left-margin))) - (make-string (if (natnump n) n 0) ?\ ))) - -;; Main entry page. - -;;;###autoload -(defun about-xemacs () - "Describe the True Editor and its minions." - (interactive) - (unless (about-get-buffer "*About XEmacs*") - (widget-insert (about-center xemacs-logo)) - (widget-create 'default - :format "%t" - :tag-glyph xemacs-logo) - (widget-insert "\n") - (let* ((emacs-short-version (format "%d.%d" - emacs-major-version - emacs-minor-version)) - (emacs-about-version (format "version %s; Aug 1998" - emacs-short-version))) - (widget-insert (about-center emacs-about-version)) - (widget-create 'link :help-echo "The latest NEWS of XEmacs" - :action 'about-news - emacs-about-version)) - - (widget-insert - "\n\n" - (about-with-face "XEmacs" 'italic) - " (formerly known as " - (about-with-face "Lucid Emacs" 'italic) - ") is a powerful, extensible text -editor with full GUI support, initially based on an early version of\n" - (about-with-face "GNU Emacs 19" 'italic) - " from the Free Software Foundation and since kept up to -date with recent versions of that product. XEmacs stems from a\n") - (widget-create 'link :help-echo "An XEmacs history lesson" - :action 'about-collaboration - :button-prefix "" - :button-suffix "" - "collaboration") - (widget-insert - " of Lucid, Inc. with Sun Microsystems, Inc. and the -University of Illinois with additional support having been provided by -Amdahl Corporation, INS Engineering Corporation, and a huge amount of -volunteer effort. - -XEmacs provides a great number of ") - (widget-create 'link :help-echo "See a list of the new features" - :action 'about-features - :button-prefix "" - :button-suffix "" - "new features") - (widget-insert ". More details on -XEmacs's functionality, including bundled packages, can be obtained -through the ") - (widget-create 'info-link - :help-echo "Browse the info system" - :button-prefix "" - :button-suffix "" - :tag "info" - "(dir)") - - (widget-insert - " on-line information system.\n -The XEmacs web page can be browsed, using any WWW browser at\n -\t\t ") - (about-url-link 'xemacs "Visit XEmacs WWW page") - (widget-insert "\n -Note that W3 (XEmacs's own browser), might need customization (due to -firewalls) in order to work correctly. - -XEmacs is the result of the time and effort of many people. The -developers responsible for this release are:\n\n") - - (flet ((setup-person (who) - (widget-insert "\t* ") - (let* ((entry (assq who xemacs-hackers)) - (name (cadr entry)) - (address (caddr entry))) - (widget-create 'link - :help-echo (concat "Find out more about " name) - :button-prefix "" - :button-suffix "" - :action 'about-maintainer - :tag name - :value who) - (widget-insert (format " <%s>\n" address))))) - ;; Setup persons responsible for this release. - (mapc 'setup-person '(slb hniksic kyle martin piper)) - (widget-insert "\n\t* ") - (widget-create 'link :help-echo "A legion of XEmacs hackers" - :action 'about-hackers - :button-prefix "" - :button-suffix "" - "And many other contributors...") - (widget-insert "\n -Chuck Thompson was Mr. XEmacs from 19.11 through 19.14. Ben Wing was -crucial to each of these releases.\n\n") - (setup-person 'cthomp) - (setup-person 'wing) - (widget-insert " -Jamie Zawinski was Mr. Lucid Emacs from 19.0 through 19.10, the last -release actually named Lucid Emacs. A lot of work has been done by -Richard Mlynarik.\n\n") - (setup-person 'jwz) - (setup-person 'mly)) - (about-finish-buffer))) - -;; View news -(defun about-news (&rest ignore) - (view-emacs-news) - (message "%s" (substitute-command-keys - "Press \\[kill-buffer] to exit this buffer"))) - -(defun about-collaboration (&rest ignore) - (unless (about-get-buffer "*About Collaboration*") - (let ((title "Why Another Version of Emacs")) - (widget-insert - "\n" - (about-center title) - (about-with-face title 'bold))) - (widget-insert - "\n\n" - (about-with-face "The Lucid, Inc. Point of View" - 'italic) - " (quite outdated)\n -At the time of the inception of Lucid Emacs (the former name of -XEmacs), Lucid's latest product was Energize, a C/C++ development -environment. Rather than invent (and force our users to learn) a new -user interface, we chose to build part of our environment on top of -the world's best editor, GNU Emacs. (Though our product is -commercial, the work we did on GNU Emacs is free software, and is -useful in its own right.) - -We needed a version of Emacs with mouse-sensitive regions, multiple -fonts, the ability to mark sections of a buffer as read-only, the -ability to detect which parts of a buffer have been modified, and many -other features. - -For our purposes, the existing version of Epoch was not sufficient; it -did not allow us to put arbitrary pixmaps/icons in buffers, `undo' did -not restore changes to regions, regions did not overlap and merge -their attributes in the way we needed, and several other things. - -We could have devoted our time to making Epoch do what we needed (and, -in fact, we spent some time doing that in 1990) but, since the FSF -planned to include Epoch-like features in their version 19, we decided -that our efforts would be better spent improving Emacs 19 instead of -Epoch. - -Our original hope was that our changes to Emacs would be incorporated -into the \"official\" v19. However, scheduling conflicts arose, and -we found that, given the amount of work still remaining to be done, we -didn't have the time or manpower to do the level of coordination that -would be necessary to get our changes accepted by the FSF. -Consequently, we released our work as a forked branch of Emacs, -instead of delaying any longer. - -Roughly a year after Lucid Emacs 19.0 was released, a beta version of -the FSF branch of Emacs 19 was released. The FSF version is better in -some areas, and worse in others, as reflects the differing focus of -our development efforts. - -We plan to continue developing and supporting Lucid Emacs, and merging -in bug fixes and new features from the FSF branch as appropriate; we -do not plan to discard any of the functionality that we implemented -which RMS has chosen not to include in his version. - -Certain elements of Lucid Emacs, or derivatives of them, have been -ported to the FSF version. We have not been doing work in this -direction, because we feel that Lucid Emacs has a cleaner and more -extensible substrate, and that any kind of merger between the two -branches would be far easier by merging the FSF changes into our -version than the other way around. - -We have been working closely with the Epoch developers to merge in the -remaining Epoch functionality which Lucid Emacs does not yet have. -Epoch and Lucid Emacs will soon be one and the same thing. Work is -being done on a compatibility package which will allow Epoch 4 code to -run in XEmacs with little or no change.\n\n" - (about-with-face "The Sun Microsystems, Inc. Point of View" - 'italic) - "\n -Emacs 18 has been around for a long, long time. Version 19 was -supposed to be the successor to v18 with X support. It was going to -be available \"real soon\" for a long time (some people remember -hearing about v19 as early as 1984!), but it never came out. v19 -development was going very, very slowly, and from the outside it -seemed that it was not moving at all. In the meantime other people -gave up waiting for v19 and decided to build their own X-aware -Emacsen. The most important of these was probably Epoch, which came -from the University of Illinois (\"UofI\") and was based on v18. - -Around 1990, the Developer Products group within Sun Microsystems -Inc., decided that it wanted an integrated editor. (This group is now -known as DevPro. It used to be known as SunPro - the name was changed -in mid-1994.) They contracted with the University of Illinois to -provide a number of basic enhancements to the functionality in Epoch. -UofI initially was planning to deliver this on top of Epoch code. - -In the meantime, (actually some time before they talked with UofI) -Lucid had decided that it also wanted to provide an integrated -environment with an integrated editor. Lucid decided that the Version -19 base was a better one than Version 18 and thus decided not to use -Epoch but instead to work with Richard Stallman, the head of the Free -Software Foundation and principal author of Emacs, on getting v19 out. -At some point Stallman and Lucid parted ways. Lucid kept working and -got a v19 out that they called Lucid Emacs 19. - -After Lucid's v19 came out it became clear to us (the UofI and Sun) -that the right thing to do was to push for an integration of both -Lucid Emacs and Epoch, and to get the deliverables that Sun was asking -from the University of Illinois on top of this integrated platform. -Until 1994, Sun and Lucid both actively supported XEmacs as part of -their product suite and invested a comparable amount of effort into -it. Substantial portions of the current code have originated under -the support of Sun, either directly within Sun, or at UofI but paid -for by Sun. This code was kept away from Lucid for a while, but later -was made available to them. Initially Lucid didn't know that Sun was -supporting UofI, but later Sun was open about it. - -Around 1992 DevPro-originated code started showing up in Lucid Emacs, -starting with the infusion of the Epoch redisplay code. The separate -code bases at Lucid, Sun, and the University of Illinois were merged, -allowing a single XEmacs to evolve from that point on. - -Sun originally called the integrated product ERA, for \"Emacs -Rewritten Again\". SunPro and Lucid eventually came to an agreement -to find a name for the product that was not specific to either -company. An additional constraint that Lucid placed on the name was -that it must contain the word \"Emacs\" in it -- thus \"ERA\" was not -acceptable. The tentatively agreed-upon name was \"XEmacs\", and this -has been the name of the program since version 19.11.) - -As of 1997, Sun is shipping XEmacs as part of its Developer Products -integrated programming environment \"Sun WorkShop\". Sun is -continuing to support XEmacs development, with focus on -internationalization and quality improvement.\n\n" - (about-with-face "Lucid goes under" 'italic) - "\n -Around mid-'94, Lucid went out of business. Lucid founder Richard -Gabriel's book \"Patterns of Software\", which is highly recommended -reading in any case, documents the demise of Lucid and suggests -lessons to be learned for the whole software development community. - -Development on XEmacs, however, has continued unabated under the -auspices of Sun Microsystems and the University of Illinois, with help -from Amdahl Corporation and INS Engineering Corporation. Sun plans to -continue to support XEmacs into the future.\n\n" - (about-with-face "The Amdahl Corporation point of view" - 'italic) - "\n -Amdahl Corporation's Storage Products Group (SPG) uses XEmacs as the -focal point of a environment for development of the microcode used in -Amdahl's large-scale disk arrays, or DASD's. SPG has joint ventures -with Japanese companies, and decided in late 1994 to contract out for -work on XEmacs in order to hasten the development of Mule support -\(i.e. support for Japanese, Chinese, etc.) in XEmacs and as a gesture -of goodwill towards the XEmacs community for all the work they have -done on making a powerful, modern, freely available text editor. -Through this contract, Amdahl provided a large amount of work in -XEmacs in the form of rewriting the basic text-processing mechanisms -to allow for Mule support and writing a large amount of the support -for multiple devices. - -Although Amdahl is no longer hiring a full-time contractor, they are -still funding part-time work on XEmacs and providing resources for -further XEmacs development.\n\n" - (about-with-face "The INS Engineering point of view" - 'italic) - "\n -INS Engineering Corporation, based in Tokyo, bought rights to sell -Energize when Lucid went out of business. Unhappy with the -performance of the Japanese support in XEmacs 19.11, INS also -contributed to the XEmacs development from late 1994 to early -1995.\n") - (about-finish-buffer))) - -(defun about-features (&rest ignore) - (unless (about-get-buffer "*About Features*") - (let ((title "New features in XEmacs")) - (widget-insert - "\n" - (about-center title) - (about-with-face title 'bold))) - (widget-insert - "\n -* MULE (Multi-Lingual Emacs) support. Simultaneous display of - multiple character sets is now possible. - -* Support for arbitrary pixmaps in a buffer. - -* A real toolbar. - -* Horizontal and vertical scrollbars in all windows. - -* Support for variable-width and variable height fonts. - -* Support for display on multiple simultaneous X and/or TTY devices. - -* Face support on TTY's, including color. - -* Support for overlapping regions (or extents) and efficient handling - of a large number of such extents in a single buffer. - -* Powerful, flexible control over the display characteristics of most - of the visual aspects of XEmacs through the use of specifiers, which - allow separate values to be specified for individual buffers, - windows, frames, devices, device classes, and device types. - -* A clean interface to the menubar, window-system events, and key - combinations. - -* Proper integration with Xt and Motif (including Motif menubars and - scrollbars). Motif look-alike menubars and scrollbars are provided - for those systems without real Motif support. - -* Text for complex languages can be entered using the XIM mechanism. - -* Localization of menubar text for the Japanese locale. - -* Access to the ToolTalk API. - -* Support for using XEmacs frames as Xt widgets.\n\n") - (about-finish-buffer))) - -(defvar about-glyphs nil - "Cached glyphs") - -;; Return a maintainer's glyph -(defun about-maintainer-glyph (who) - (let ((glyph (cdr (assq who about-glyphs)))) - (unless glyph - (let ((file (expand-file-name - (concat (symbol-name who) - (if (memq (device-class) - '(color grayscale)) - "" "m") - ".png") - (locate-data-directory "photos"))) - (data nil)) - (setq glyph - (cond ((stringp data) - (make-glyph - (if (featurep 'png) - `([png :data ,data] - [string :data "[Image]"]) - `([string :data "[Image]"])))) - ((eq data 'error) - (make-glyph [string :data "[Error]"])) - (file - (make-glyph - (if (featurep 'png) - `([png :file ,file] - [string :data "[Image]"]) - `([string :data "[Image]"])))) - (t - (make-glyph [nothing])))) - (set-glyph-property glyph 'baseline 100) - ;; Cache the glyph - (push (cons who glyph) about-glyphs))) - glyph)) - -;; Insert info about a maintainer. Add the maintainer-specific info -;; here. -(defun about-maintainer-info (entry) - (ecase (car entry) - (slb - (widget-insert "\ -I took over the maintenance of XEmacs in November of 1996 (it -seemed like a good idea at the time ...). In real life I am a -network administrator and Unix systems programmer for Calag.com, -Inc. a small, but growing ISP in California. - -My main hobby while not maintaining XEmacs or working is ... -you have got to be kidding ...") - (widget-insert ".\n")) - (martin - (widget-insert "\ -Martin was the XEmacs guy at DevPro, a part of Sun Microsystems. -Martin used to do XEmacs as a `hobby' while at IBM, and was crazy -enough to try to make a living doing it at Sun. - -Martin starting using Emacs originally not to edit files, but to get -the benefit of shell mode. He actually used to run nothing but a shell -buffer, and use `xterm -e vi' to edit files. But then he saw the -light. He dreams of rewriting shell mode from scratch. Stderr should -show up in red!! - -Martin is no longer doing XEmacs for a living, and is Just Another -Volunteer.\n")) - (hniksic - (widget-insert "\ -Hrvoje is a student at the Faculty of Electrical Engineering and -Computing in Zagreb, Croatia, working part-time at system administration -at SRCE. His hobby is hacking free software, particularly XEmacs and -GNU Wget, the latter being his very own creation. - -His contribution to XEmacs consists of a multitude of hours spent -adding new features and bugs, and fixing old ones. He dreams of -writing a home page.\n")) - (wing - (widget-insert - "\ -I began my Emacs life in 1992 as the co-founder of the now defunct -Pearl Software. As part of this company, I became the principal -architect of Win-Emacs, an early port of Lucid Emacs to Microsoft -Windows and Windows NT. - -Since April 1993, I've worked on XEmacs as a contractor for various -companies, changing hats faster than Ronald Reagan's hair color (oops, -did I just show my age?). My main contributions to XEmacs include -rewriting large parts of the internals and the gory Xt/Xlib -interfacing, adding the Mule support, implementing the external client -widget, improving the documentation (especially the Emacs Lisp -manual), and being a general nuisance ... er, brainstormer for many of -the new features of XEmacs. - -Alas, life has not been good to me recently. This former San Francisco -\"Mission Critter\" was exiled to \"Stroller Valley\" and, after a brief -stint developing a Java-based VRML toolkit for the now also defunct -Dimension X, I developed insidious hand and neck problems, and I was -forced to quit working. Since then, I have been learning how to interact -with the computer by using foot pedals and by dictating text to other -people. Recently I completed Architecting XEmacs, a web site about the -future of XEmacs.\n\n") - (widget-insert "Architecting XEmacs: ") - (about-url-link 'ben-xemacs "Find the miracles in store for XEmacs") - (widget-insert "\nBen's home page: ") - (about-url-link 'ben "Visit Ben's page") - (widget-insert "\n")) - (cthomp - (widget-insert "\ -Chuck, through being in the wrong place at the right time, has gotten -stuck with being Jamie's replacement as the primary maintainer of -XEmacs. This has caused his hair to begin falling out and quadrupled -his daily coffee dosage. Though he works at and for the University of -Illinois his funding for XEmacs work actually came from Sun -Microsystems. - -He has worked on XEmacs since November 1992, which fact occasionally -gives him nightmares. As of October 1995, he no longer works -full-time on XEmacs, though he does continue as an active maintainer. -His main contributions have been the greatly enhanced redisplay -engine, scrollbar support, the toolbars, configure support and -numerous other features and fixes. - -Rumors that Chuck is aka Black Francis aka Frank Black are completely -unfounded.\n")) - (jwz - (widget-insert - "\t" - (about-with-face "\"So much to do, so little time.\"" 'italic) - "\n -Jamie Zawinski was primarily to blame for Lucid Emacs from its -inception in 1991, to 1994 when Lucid Inc. finally died. He is now to -be found at Netscape Communications, hacking on Netscape Navigator (he -did the first Unix version and the mail and news reader). Thankfully -his extensive sleep deprivation experiments conducted during 1994 and -1995 are now a thing of the past, but his predilection for dark, -Gothic music remains unabated. - -Come visit his glorified .plan file at\n\n") - (about-url-link 'jwz "Visit Jamie's home page") - (widget-insert "\n")) - (mly - (widget-insert "Cars are evil. Ride a bike.\n")) - (vladimir - (widget-insert "\ -Former technical lead for XEmacs at Sun. He is now with Microtec -Research Inc., working on embedded systems development tools.\n")) - (stig - (widget-insert "\ -Stig is sort of a tool fetishist. He has a hate/love relationship -with computers and he hacks on XEmacs because it's a good tool that -makes computers somewhat less of a nuisance. Besides XEmacs, Stig -especially likes his Leatherman, his Makita, and his lockpicks. Stig -wants a MIG welder and air tools. - -Stig likes to perch, hang from the ceiling, and climb on the walls. -Stig has a cool van. Stig would like to be able to telecommute from, -say, the north rim of the Grand Canyon or the midst of Baja.\n")) - (stigb - (widget-insert "\ -Currently studying computer science in Trondheim, Norway. Full time -Linux user and proud of it. XEmacs hacker light. Maintainer of the -RPM package. - -See:\t") - (about-url-link 'stigb "Visit Stig's home page")) - (baw - (widget-insert - "\ -Author of CC Mode, for C, C++, Objective-C and Java editing, and -Supercite for mail and news citing. Also various and sundry other -Emacs utilities, fixes, enhancements and kludgery as whimsy, boredom, -and ToT dictate (but not necessarily in that order). See also:\n\n\t") - (about-url-link 'baw "Visit Barry's home page") - (widget-insert "\n\nand:\n\n\t") - (about-url-link 'cc-mode "Visit the CC Mode distribution") - (widget-insert "\n -Daddy -\(C) 1994 Warsaw -=============== -Drive me Daddy, drive me quick -Push my pedal, shift my stick -Fill me up with golden gas -My rubber squeals, I go real fast - -Milk me Daddy, milk me now -Milk me like a big ol' cow -I've got milk inside my udder -Churn it up and make some butter\n")) - (piper - (widget-insert "\ -Author of the original \"fake\" XEmacs toolbar, outl-mouse for mouse -gesture based outlining, the original CDE drag-n-drop support, the -cygwin port of XEmacs including unexec, glyphs under MS-Windows, -toolbars under MS-Windows. My home page is here:\n") - (about-url-link 'piper "Visit andy's home page") - (widget-insert "\n -Andy has recently rejoined the XEmacs team to help port XEmacs to -MS Windows operating systems.\n")) - (bw - (widget-insert "\ -Author of the Hyperbole everyday information management hypertext -system and the OO-Browser multi-language code browser. He also -designed the Altrasoft InfoDock integrated development environment -for software engineers. It runs atop XEmacs and is available from -his firm, Altrasoft, which offers distributions, custom development, -support, and training packages for corporate users of XEmacs, GNU -Emacs and InfoDock. See ") - (about-url-link 'altrasoft "Visit Altrasoft WWW page") - (widget-insert ". - -His interests include user interfaces, information management, -CASE tools, communications and enterprise integration.\n")) - (wmperry - (widget-insert "\ -Author of Emacs-w3, the builtin web browser that comes with XEmacs, -and various additions to the C code (e.g. the database support, the -PNG support, some of the GIF/JPEG support, the strikethru face -attribute support). - -He is currently working at Aventail, Corp. on SOCKS v5 servers.\n")) - (kyle - (widget-insert "\ -Author of VM, a mail-reading package that is included in the standard -XEmacs distribution, and contributor of many improvements and bug -fixes. Unlike RMAIL and MH-E, VM uses the standard UNIX mailbox -format for its folders; thus, you can use VM concurrently with other -UNIX mail readers such as Berkeley Mail and ELM. See\n") - (about-url-link 'kyle "Visit Kyle's Home page") - (widget-insert ".\n")) - (larsi - (widget-insert "\ -Author of Gnus the Usenet news and Mail reading package in the -standard XEmacs distribution, and contributor of various enhancements -and portability fixes. Lars is a student at the Institute of -Informatics at the University of Oslo. He is currently plumbing away -at his majors work at the Institute of Physics, working on an SCI -project connected with CASCADE and CERN and stuff. - -See ") - (about-url-link 'larsi "Visit the Larsissistic pages") - (widget-insert ".\n")) - (marcpa - (widget-insert "\ -I work for Positron Industries Inc., Public Safety Division. -I'm part of the team producing POWER 911, a 911 emergency response -system written in Modula3:\n") - (about-url-link 'marcpa "Visit POWER 911") - (widget-insert "\ -\n\nPreviously, I worked at Softimage Inc., now a Microsoft company -\(eeekkk!), as a UNIX system administrator. This is where I've been -converted to NT. - -In a previous life, I was a programmer/sysadmin at CRIM (Centre de -Recherche Informatique de Montreal) for the speech recognition group.\n")) - (jens - (widget-insert "\ -Jens did the artwork for graphics added to XEmacs 20.2 and 19.15. - -I'm currently working at the University of Karlsruhe, Germany on -getting my diploma thesis on Supersymmetry (uuh, that's physics) done. -After that (and all the remaining exams) I'm looking forward to make a -living out of my hobbies -- computers (and graphics). But because I -have no deadline for the exams and XEmacs betas are released at a high -rate this may take some time...\n")) - (jareth - (widget-insert "\ -Jareth Hein is a mountain boy who abandoned his home state of Colorado -for the perpetual state of chaos known as Tokyo in a failed attempt to -become a cel-animator, and a more successful one to become a -computer-game programmer. As he happens to be bilingual (guess which -two?) he's been doing quite a bit of MULE hacking. He's also getting -his hands dirty in the graphics areas as well.\n")) - (morioka - (widget-insert "\ -I am the author of tm-view (general MIME Viewer for GNU Emacs) and -major author and maintainer of tm (Tools for MIME; general MIME -package for GNU Emacs). In addition, I am working to unify MULE API -for Emacs and XEmacs. In XEmacs, I have ported many mule features. - -I am a doctoral student at School of Information Science of JAIST -\(Japan Advanced Institute of Science and Technology, Hokuriku). I'm -interested in Natural Language, Affordance and writing systems.\n")) - (dmoore - (widget-insert "\ -David has contributed greatly to the quest to speed up XEmacs. He is -a student in the Computer Systems Laboratory at UCSD. When he manages -to have free time, he usually spends it on 200 mile bicycle rides, -learning german or showing people the best mail & news environment -he's found in 10 years. (That'd be XEmacs, Gnus and bbdb, of course.) -He can be found at `druidmuck.egbt.org 4201' at various hours of the -day. - -He has a page at ") - (about-url-link 'dmoore "Visit David's home page") - (widget-insert ".\n")) - (thiessel - (widget-insert "\ - All of the buildings, - all of the cars - were once just a dream - in somebody's head.\n - P. Gabriel\n\n -") - (widget-insert "\n")) - (sperber - (widget-insert "\ -Mike ported EFS to XEmacs 20 and integrated EFS into XEmacs. He's -also responsible for the ports of facemenu.el and enriched.el. When -Mike isn't busy putting together patches for free software he has just -installed or changing his hairstyle, he does research in modern -programming languages and their implementation, and hopes that one day -XEmacs will speak Scheme.\n")) - (vin - (widget-insert "\ -Vin maintains the XEmacs patch pages in order to bring a more -stable XEmacs. (Actually, he does it 'cause it's fun and he's been -using emacs for a long, long time.) Vin also contributed the detached -minibuffer code as well as a few minor enhancements to the menubar -options. - -I own and operate my own consulting firm, EtherSoft. Shhh, don't -tell anyone, but it's named after an Ultimate team I used to play -with in Austin, Texas - the Ether Bunnies. I'm getting too old -to play competitive Ultimate any more, so now I've gotten roped -into serving on the board of directors of the Ultimate Players -Association. See ") - (about-url-link 'vin "Visit the UPA homepage") - (widget-insert ".\n")) - (ajc - (widget-insert "\ -When not helping maintain the XEmacs website, Andrew is a Network -Software Engineer(tm) for Monash University in Australia, maintaining -webservers and doing random other things. As well as spending spare -time being an Eager Young Space Cadet and fiddling with XEmacs/Gnus -et. al., he spends his time pursuing, among other things, a Life. -Some of this currently involves doing an A-Z (by country) of -restaurants with friends, and has, in the past, involved dyeing his -hair various colours (see ") - (about-url-link 'ajc "Visit Andrew's home page") - (widget-insert ".\n")) - (rickc - (widget-insert "\ -The hacker formerly known as Rick Busdiecker develops and maintains -libraries for financial applications at Lehman Brothers during -daylight hours. In the evenings he maintains three children, and -when he ought to be sleeping he co-maintains ILISP, builds XEmacs -betas, and tinkers with various personal hacking projects..\n")) - (kazz - (widget-insert "\ -Kazz is the XEmacs lead on BSD (especially FreeBSD). -His main workspace is, probably, the latest stable version of -FreeBSD and it makes him comfortable and not. -His *mission* is to make XEmacs runs on FreeBSD without -any problem. - -In real life, he is working on a PDM product based on CORBA, -and doing consultation, design and implemention. -He loves to play soccer, yes football! -See also:") - (about-url-link 'kazz "Visit Kazz's home page") - (widget-insert ".\n")) - (dkindred - (widget-insert "\ -Darrell tends to come out of the woodwork a couple of weeks -before a new release with a flurry of fixes for bugs that -annoy him. He hopes he's spared you from a core dump or two. - -Darrell is currently a doctoral student in computer science at -Carnegie Mellon University, but he's trying hard to kick that -habit. - -See ") - (about-url-link 'dkindred "Visit Darrell's WWW page") - (widget-insert ".\n")) - (pez - (widget-insert "\ -Author of SQL Mode, edit-toolbar, mailtool-mode, and various other -small packages with varying degrees of usefulness. Peter has -recently left Wall Street to start Daedalus World Wide Corporation, -a software development firm. See ") - (about-url-link 'pez "Daedalus on the web") - (widget-insert ".\n")) - (dv - (widget-insert "\ -I'm currently working (Ph.D.) on the cognitive aspects of -Human-Machine Interaction in Virtual Environments, and especialy on -the possibility of adding (artificial) intelligence between the system -and the operator, in order to detect the intentions of the latter. - -Otherwise, I'm, say, 35.82% professional Jazz guitar player, -which means that's not the way I earn my crust, but things may very -well reverse in the future ...\n")) - (rossini - (widget-insert "\ -Author of the first XEmacs FAQ, as well as minor priest in the -movement to get every statistician in the world to use XEmacs for -statistical programming and data analysis. Current development lead -for ESS (Emacs Speaks Statistics), a mode and inferior mode for -statistical programming and data analysis for SAS, S, S-PLUS, R, -XLispStat; configurable for nearly any other statistical -language/package one might want. In spare time, acts as a -Ph.D. (bio)statistician for money and amusement. Current position: -Assistant Professor of Statistics at the University of South Carolina.\n")) - (ograf - (widget-insert "\ -I'm a student of computer sciences at the University of Koblenz. My -major is computational linguistics (human language generation and -analysis). - -I make my living as a managing director of a small but fine company -which I started two years ago with one of my friends. We provide -business network solutions based on linux servers and various other -networking products. - -Most of my spare time I spent on the development of the XEmacs -Drag'n'Drop API, a enhanced version of Tk called TkStep (better looks, -also Drag'n'Drop, and more), and various other hacks: ISDN-tools, -cd players, python, etc... - -To see some of these have a look at ") - (about-url-link 'ograf "one of my homepages") - (widget-insert ".\n")) - (juhp - (widget-insert "\ -I started using XEmacs-20 as my work-environment in June 1997. I -became a beta developer shortly after that (\"it seems like a good -idea at the time...\" :-), so far contributing mainly bug fixes, -\"find-func.el\" and improvements to \"help.el\". - -My current dreams for XEmacs: move to using guile as the Lisp engine -and gtk as the default X toolkit. - -I have been a postdoctoral researcher at the Research Institute for -Mathematical Sciences, Kyoto University, since August 1994, doing -research in mathematical physics (representation theory of quantum -groups). Though now I seem to be heading for other things. - -My homepage is ") - (about-url-link 'juhp "Visit Jens' homepage") - (widget-insert ".\n")) - (jason - (widget-insert "\ -Beta tester and manager of the various XEmacs mailing lists. -Originator and maintainer of the gnus.org domain. - -Jason resides in Albuquerque, New Mexico where he keeps himself -busy with studies at the university and consulting work. - -See: ") - (about-url-link 'jason "Visit Jason's homepage") - (widget-insert ".\n")) - (jmiller - (widget-insert "\ -Jeff grew up in Indiana and is a country boy at heart. He currently lives -in, of all places, Millersville Maryland. He spends a lot of his free -time tinkering with Linux and hacking on XEmacs and loves it when he finds -new cool features in either. When he's not doing that, he enjoys downhill -skiing, puzzles, and sci-fi. Jeff is also really interested in classical -Roman history and enjoys making trips to Italy, where he was born, and -seeing the sights") - (widget-insert ".\n")) - (chr - (widget-insert "\ -Maintainer of the XEmacs FAQ and proud author of `zap-up-to-char'. - -Christian is a student at the Norwegian School of Economics and -Business Administration in Bergen, Norway. He used to work for an -internet startup called New Media Science, doing scripting and -violation of HTML DTD's. After graduation, spring 1999, he'll be -looking for a job involving lisp programming, French and Russian.") - (widget-insert ".\n")) -)) - -;; Setup the buffer for a maintainer. -(defun about-maintainer (widget &optional event) - (let* ((entry (assq (widget-value widget) xemacs-hackers)) - (who (car entry)) - (name (cadr entry)) - (address (caddr entry)) - (bufname (format "*About %s*" name))) - (unless (about-get-buffer bufname) - ;; Display the glyph and name - (widget-insert "\n") - (widget-create 'default :format "%t" - :tag-glyph (about-maintainer-glyph who)) - (widget-insert - " " (about-with-face (format "%s" name) 'bold) - " <" address ">\n\n") - ;; Display the actual info - (about-maintainer-info entry) - (widget-insert "\n") - (about-finish-buffer 'kill) - (forward-line 2)))) - -(defsubst about-tabs (str) - (let ((x (length str))) - (cond ((>= x 24) " ") - ((>= x 16) "\t") - ((>= x 8) "\t\t") - (t "\t\t\t")))) - -(defun about-show-linked-info (who shortinfo) - (let* ((entry (assq who xemacs-hackers)) - (name (cadr entry)) - (address (caddr entry))) - (widget-create 'link :help-echo (concat "Find out more about " name) - :action 'about-maintainer - :button-prefix "" - :button-suffix "" - :tag name - :value who) - (widget-insert (about-tabs name) - (format "<%s>\n%s\n" address shortinfo)))) - -(defun about-hackers (&rest ignore) - (unless (about-get-buffer "*About Contributors*") - (let ((title "Other Contributors to XEmacs")) - (widget-insert - (about-center title) - (about-with-face title 'bold))) - (widget-insert - "\n -Like most free software, XEmacs is a collaborative effort. These are -some of the contributors. We have no doubt forgotten someone; we -apologize! You can see some of our faces under the links.\n\n") - (about-show-linked-info 'vladimir "\ -Former technical lead for XEmacs at Sun Microsystems. He is now with -Microtec Research Inc., working on embedded systems development tools.\n") - (about-show-linked-info 'stig "\ -Peripatetic uninominal Emacs hacker. Stig sometimes operates out of a -big white van set up for nomadic living and hacking. Implemented the -faster stay-up Lucid menus and hyper-apropos. Contributor of many -dispersed improvements in the core Lisp code, and back-seat -contributor for several of its major packages.\n") - (about-show-linked-info 'baw "\ -Author of CC Mode for C, C++, Objective-C and Java editing, and -Supercite for mail and news citing. Also various and sundry other -Emacs utilities, fixes, enhancements and kludgery as whimsy, boredom, -and ToT dictate (but not necessarily in that order).\n") - (about-show-linked-info 'piper "\ -Created the prototype for the toolbars. Has been the first to make -use of many of the new XEmacs graphics features. Has implemented many -of XEmacs' graphics features under MS-Windows and has ported XEmacs -to cygwin under MS-Windows.\n") - (about-show-linked-info 'bw "\ -Author of the Hyperbole everyday information management hypertext -system and the OO-Browser multi-language code browser. He also -designed the Altrasoft InfoDock integrated development environment -for software engineers. It runs atop XEmacs and is available from -his firm, Altrasoft, which offers custom development and support packages -for corporate users of XEmacs, GNU Emacs and InfoDock. His interests -include user interfaces, information management, CASE tools, -communications and enterprise integration.\n") - (about-show-linked-info 'wmperry "\ -Author of Emacs-w3, the builtin web browser that comes with XEmacs, -and various additions to the C code (e.g. the database support, the -PNG support, some of the GIF/JPEG support, the strikethru face -attribute support).\n") - (about-show-linked-info 'kyle "\ -Author of VM, a mail-reading package that is included in the standard -XEmacs distribution, and contributor of many improvements and bug -fixes. Unlike RMAIL and MH-E, VM uses the standard UNIX mailbox -format for its folders; thus, you can use VM concurrently with other -UNIX mail readers such as Berkeley Mail and ELM.\n") - (about-show-linked-info 'larsi "\ -Author of Gnus the Usenet news and Mail reading package in the -standard XEmacs distribution, and contributor of various enhancements -and portability fixes. Lars is a student at the Institute of -Informatics at the University of Oslo. He is currently plumbing away -at his majors work at the Institute of Physics, working on an SCI -project connected with CASCADE and CERN and stuff.\n") - (about-show-linked-info 'jens "\ -I'm currently working at the University of Karlsruhe, Germany on -getting my diploma thesis on Supersymmetry (uuh, that's physics) done. -After that (and all the remaining exams) I'm looking forward to make a -living out of my hobbies -- computers (and graphics). But because I -have no deadline for the exams and XEmacs betas are released at a high -rate this may take some time...\n") - (about-show-linked-info 'jareth "\ -Jareth Hein is a mountain boy who abandoned his home state of Colorado -for the perpetual state of chaos known as Tokyo in a failed attempt to -become a cel-animator, and a more successful one to become a -computer-game programmer. As he happens to be bilingual (guess which -two?) he's been doing quite a bit of MULE hacking. He's also getting -his hands dirty in the graphics areas as well.\n") - (about-show-linked-info 'morioka "\ -I am the author of tm-view (general MIME Viewer for GNU Emacs) and -major author and maintainer of tm (Tools for MIME; general MIME -package for GNU Emacs). In addition, I am working to unify MULE API -for Emacs and XEmacs. In XEmacs, I have ported many mule features. - -I am a doctoral student at School of Information Science of JAIST -\(Japan Advanced Institute of Science and Technology, Hokuriku). I'm -interested in Natural Language, Affordance and writing systems.\n") - (about-show-linked-info 'dmoore "\ -David has contributed greatly to the quest to speed up XEmacs. He is -a student in the Computer Systems Laboratory at UCSD. When he manages -to have free time, he usually spends it on 200 mile bicycle rides, -learning german or showing people the best mail & news environment -he's found in 10 years. (That'd be XEmacs, Gnus and bbdb, of course.) -He can be found at `druidmuck.egbt.org 4201' at various hours of the -day.\n") - (about-show-linked-info 'sperber "\ -Mike ported EFS to XEmacs 20 and integrated EFS into XEmacs. He's -also responsible for the ports of facemenu.el and enriched.el. When -Mike isn't busy putting together patches for free software he has just -installed or changing his hairstyle, he does research in modern -programming languages and their implementation, and hopes that one day -XEmacs will speak Scheme.\n") - (about-show-linked-info 'vin "\ -Vin helps maintain the older, more mature (read: moldy) versions of -XEmacs. Vin has maintained the official XEmacs patch pages.\n") - (about-show-linked-info 'thiessel "\ -Worked at University of Kaiserslautern where he took part in the -development and design of a CAD framework for analog integrated -circuits with special emphasis on distributed software concepts. He -has now joined HP as technical consultant. - -For XEmacs he does beta testing and tries to take care of XEmacs -website at .\n") - (about-show-linked-info 'ajc "\ -When not helping maintain the XEmacs website, Andrew is a Network -Software Engineer(tm) for Monash University in Australia, maintaining -webservers and doing random other things. As well as spending spare -time being an Eager Young Space Cadet and fiddling with XEmacs/Gnus -et. al., he spends his time pursuing, among other things, a Life. -Some of this currently involves doing an A-Z (by country) of -restaurants with friends, and has, in the past, involved dyeing his -hair various colours.\n") - (about-show-linked-info 'kazz "\ -IENAGA Kazuyuki is the XEmacs technical lead on BSD, particularly -FreeBSD.\n") - (about-show-linked-info 'dkindred "\ -Darrell tends to come out of the woodwork a couple of weeks -before a new release with a flurry of fixes for bugs that -annoy him. He hopes he's spared you from a core dump or two. - -Darrell is currently a doctoral student in computer science at -Carnegie Mellon University, but he's trying hard to kick that -habit.\n") - (about-show-linked-info 'dv "\ -I'm currently working (Ph.D.) on the cognitive aspects of -Human-Machine Interaction in Virtual Environments, and especialy on -the possibility of adding (artificial) intelligence between the system -and the operator, in order to detect the intentions of the latter. - -Otherwise, I'm, say, 35.82% professional Jazz guitar player, -which means that's not the way I earn my crust, but things may very -well reverse in the future ...\n") - (about-show-linked-info 'marcpa "\ -I work for Positron Industries Inc., Public Safety Division.\n") - (about-show-linked-info 'pez "\ -Author of SQL Mode, edit-toolbar, mailtool-mode, and various other -small packages with varying degrees of usefulness.\n") - (about-show-linked-info 'rickc "\ -The hacker formerly known as Rick Busdiecker, maintainer of ILISP.\n") - (about-show-linked-info 'rossini "\ -Author of the first XEmacs FAQ, as well as minor priest in the -movement to get every statistician in the world to use XEmacs for -statistical programming and data analysis. Current development lead -for ESS (Emacs Speaks Statistics), a mode and inferior mode for -statistical programming and data analysis for SAS, S, S-PLUS, R, -XLispStat; configurable for nearly any other statistical -language/package one might want. In spare time, acts as a -Ph.D. (bio)statistician for money and amusement. Current position: -Assistant Professor of Statistics at the University of South Carolina.\n") - (about-show-linked-info 'stigb "\ -Currently studying computer science in Trondheim, Norway. Full time -Linux user and proud of it. XEmacs hacker light. Maintainer of the -RPM package.\n") - (about-show-linked-info 'ograf "\ -Author of the XEmacs Drag'n'Drop API.\n") - (about-show-linked-info 'juhp "\ -Author of \"find-func.el\".\n") - (about-show-linked-info 'jason "\ -Beta tester and manager of the various XEmacs mailing lists. -Originator and maintainer of the gnus.org domain.\n") - (about-show-linked-info 'jmiller "\ -Beta tester and last hacker of calendar.\n") - (about-show-linked-info 'chr "\ -Maintainer of the XEmacs FAQ and proud author of `zap-up-to-char'.\n") - (flet ((print-short (name addr &optional shortinfo) - (concat (about-with-face name 'italic) - (about-tabs name) - "<" addr ">\n" - (if shortinfo (concat shortinfo "\n") "")))) - (widget-insert - (print-short "Eduardo Pelegri-Llopart" "pelegri@eng.sun.com" "\ -Author of EOS, a package included in the standard XEmacs distribution -that integrates XEmacs with the SPARCworks development environment -from Sun. Past lead for XEmacs at Sun; advocated the validity of -using Epoch, and later Lemacs, at Sun through several early -prototypes.\n") - (print-short "Matthieu Devin" "devin@rs.com" "\ -Part of the original (pre-19.0) Lucid Emacs development team. -Matthieu wrote the initial Energize interface, designed the -toolkit-independent Lucid Widget library, and fixed enough redisplay -bugs to last a lifetime. The features in Lucid Emacs were largely -inspired by Matthieu's initial prototype of an Energize interface -using Epoch.\n") - (print-short "Harlan Sexton" "hbs@odi.com" "\ -Part of the original (pre-19.0) Lucid Emacs development team. Harlan -designed and implemented many of the low level data structures which -are original to the Lucid version of Emacs, including extents and hash -tables.\n") - (print-short "Eric Benson" "eb@kaleida.com" "\ -Also part of the original Lucid Emacs development team. Eric played a -big part in the design of many aspects of the system, including the -new command loop and keymaps, fixed numerous bugs, and has been a -reliable beta tester ever since.\n") - (print-short "John Rose" "john.rose@sun.com" "\ -Author of many extensions to the `extents' code, including the initial -implementation of `duplicable' properties.\n") - (print-short "Hans Muller" "hmuller@eng.sun.com" "\ -Author of the code used to connect XEmacs with ToolTalk, and of an -early client of the external Emacs widget.\n") - (print-short "David hobley" "david.hobley@usa.net" "\ -I used to do real work, but now I am a Project Manager for one of the -Telco's in Australia. In my spare time I like to get back to basics and -muck around with things. As a result I started the NT port. Hopefully I -will get to finish it sometime sooner rather than later. I do vaguely -remember University where it seems like I had more spare time that I can -believe now. Oh well, such is life.\n") - (print-short "Jonathan Harris" "jhar@tardis.ed.ac.uk" "\ -Manages the team responsible for the EPOC kernel at Symbian Ltd. Started -the mswindows native-GUI port of XEmacs because he felt lost using -Microsoft Windows without a real editor.\n") - (print-short "Michael R. Cook" "mcook@cognex.com" "\ -Author of the \"shy groups\" and minimal matching regular expression -extensions.\n") - (print-short "Darryl Okahata" "darrylo@sr.hp.com" "\ -Perennial Emacs hacker since 1986 or so, when he first started on GNU -Emacs 17.something. Over the years, he's developed \"OEmacs\", the first -version of GNU Emacs 19 for MSDOS, and \"bigperl\", a 32-bit version of -Perl4 for MSDOS. In recent years, reality has intruded and he no longer -has much time for playing with cool programs. What little time he has -now goes to XEmacs hacking, where he's worked on speeding up dired under -MS Windows, and to feeding his two cats.\n") - "\n\ -In addition to those just mentioned, the following people have spent a -great deal of effort providing feedback, testing beta versions of -XEmacs, providing patches to the source code, or doing all of the -above. We couldn't have done it without them.\n\n" - (print-short "Nagi M. Aboulenein" "aboulene@ponder.csci.unt.edu") - (print-short "Per Abrahamsen" "abraham@dina.kvl.dk") - (print-short "Gary Adams" "gra@zeppo.East.Sun.COM") - (print-short "Gennady Agranov" "agranov@csa.CS.Technion.Ac.IL") - (print-short "Adrian Aichner" "aichner@ecf.teradyne.com") - (print-short "Mark Allender" "allender@vnet.IBM.COM") - (print-short "Stephen R. Anderson" "sra@bloch.ling.yale.edu") - (print-short "Butch Anton" "butch@zaphod.uchicago.edu") - (print-short "Fred Appelman" "Fred.Appelman@cv.ruu.nl") - (print-short "Erik \"The Pope\" Arneson" "lazarus@mind.net") - (print-short "Tor Arntsen" "tor@spacetec.no") - (print-short "Marc Aurel" "4-tea-2@bong.saar.de") - (print-short "Larry Auton" "lda@control.att.com") - (print-short "Larry Ayers" "layers@marktwain.net") - (print-short "Oswald P. Backus IV" "backus@altagroup.com") - (print-short "Mike Battaglia" "mbattagl@dsccc.com") - (print-short "Neal Becker" "neal@ctd.comsat.com") - (print-short "Paul Bibilo" "peb@delcam.com") - (print-short "Leonard Blanks" "ltb@haruspex.demon.co.uk") - (print-short "Jan Borchers" "job@tk.uni-linz.ac.at") - (print-short "Mark Borges" "mdb@cdc.noaa.gov") - (print-short "David P. Boswell" "daveb@tau.space.thiokol.com") - (print-short "Tim Bradshaw" "tfb@edinburgh.ac.uk") - (print-short "Rick Braumoeller" "rickb@mti.sgi.com") - (print-short "Matthew J. Brown" "mjb@doc.ic.ac.uk") - (print-short "Alastair Burt" "burt@dfki.uni-kl.de") - (print-short "David Bush" "david.bush@adn.alcatel.com") - (print-short "Richard Caley" "rjc@cstr.edinburgh.ac.uk") - (print-short "Stephen Carney" "carney@gvc.dec.com") - (print-short "Lorenzo M. Catucci" "lorenzo@argon.roma2.infn.it") - (print-short "Philippe Charton" "charton@lmd.ens.fr") - (print-short "Peter Cheng" "peter.cheng@sun.com") - (print-short "Jin S. Choi" "jin@atype.com") - (print-short "Tomasz J. Cholewo" "tjchol01@mecca.spd.louisville.edu") - (print-short "Serenella Ciongoli" "czs00@ladybug.oes.amdahl.com") - (print-short "Glynn Clements" "glynn@sensei.co.uk") - (print-short "Richard Cognot" "cognot@ensg.u-nancy.fr") - (print-short "Andy Cohen" "cohen@andy.bu.edu") - (print-short "Richard Coleman" "coleman@math.gatech.edu") - (print-short "Mauro Condarelli" "MC5686@mclink.it") - (print-short "Andrew J Cosgriff" "ajc@bing.wattle.id.au") - (print-short "Nick J. Crabtree" "nickc@scopic.com") - (print-short "Christopher Davis" "ckd@kei.com") - (print-short "Soren Dayton" "csdayton@cs.uchicago.edu") - (print-short "Chris Dean" "ctdean@cogit.com") - (print-short "Michael Diers" "mdiers@logware.de") - (print-short "William G. Dubuque" "wgd@martigny.ai.mit.edu") - (print-short "Steve Dunham" "dunham@dunham.tcimet.net") - (print-short "Samuel J. Eaton" "samuele@cogs.susx.ac.uk") - (print-short "Carl Edman" "cedman@Princeton.EDU") - (print-short "Dave Edmondson" "davided@sco.com") - (print-short "Jonathan Edwards" "edwards@intranet.com") - (print-short "Eric Eide" "eeide@asylum.cs.utah.edu") - (print-short "EKR" "ekr@terisa.com") - (print-short "Gunnar Evermann" "Gunnar.Evermann@nats.informatik.uni-hamburg.de") - (print-short "Oscar Figueiredo" "Oscar.Figueiredo@di.epfl.ch") - (print-short "David Fletcher" "frodo@tsunami.com") - (print-short "Paul Flinders" "ptf@delcam.co.uk") - (print-short "Jered J Floyd" "jered@mit.edu") - (print-short "Gary D. Foster" "Gary.Foster@Corp.Sun.COM") - (print-short "Jerry Frain" "jerry@sneffels.tivoli.com") - (print-short "Holger Franz" "hfranz@physik.rwth-aachen.de") - (print-short "Benjamin Fried" "bf@morgan.com") - (print-short "Barry Friedman" "friedman@nortel.ca") - (print-short "Noah Friedman" "friedman@splode.com") - (print-short "Kazuyoshi Furutaka" "furutaka@Flux.tokai.jaeri.go.jp") - (print-short "Lew Gaiter III" "lew@StarFire.com") - (print-short "Olivier Galibert" "Olivier.Galibert@mines.u-nancy.fr") - (print-short "Itay Gat" "itay@cs.huji.ac.il") - (print-short "Tim Geisler" "Tim.Geisler@informatik.uni-muenchen.de") - (print-short "Dave Gillespie" "daveg@synaptics.com") - (print-short "Christian F. Goetze" "cg@bigbook.com") - (print-short "Yusuf Goolamabbas" "yusufg@iss.nus.sg") - (print-short "Wolfgang Grieskamp" "wg@cs.tu-berlin.de") - (print-short "John Griffith" "griffith@sfs.nphil.uni-tuebingen.de") - (print-short "James Grinter" "jrg@demon.net") - (print-short "Ben Gross" "bgross@uiuc.edu") - (print-short "Dirk Grunwald" "grunwald@foobar.cs.Colorado.EDU") - (print-short "Michael Guenther" "michaelg@igor.stuttgart.netsurf.de") - (print-short "Dipankar Gupta" "dg@hplb.hpl.hp.com") - (print-short "Markus Gutschke" "gutschk@GOEDEL.UNI-MUENSTER.DE") - (print-short "Kai Haberzettl" "khaberz@synnet.de") - (print-short "Adam Hammer" "hammer@cs.purdue.edu") - (print-short "Magnus Hammerin" "magnush@epact.se") - (print-short "ChangGil Han" "cghan@phys401.phys.pusan.ac.kr") - (print-short "Derek Harding" "dharding@lssec.bt.co.uk") - (print-short "Michael Harnois" "mharnois@sbt.net") - (print-short "John Haxby" "J.Haxby@isode.com") - (print-short "Karl M. Hegbloom" "karlheg@inetarena.com") - (print-short "Benedikt Heinen" "beh@icemark.thenet.ch") - (print-short "Stephan Herrmann" "sh@first.gmd.de") - (print-short "August Hill" "awhill@inlink.com") - (print-short "Mike Hill" "mikehill@hgeng.com") - (print-short "Charles Hines" "chuck_hines@VNET.IBM.COM") - (print-short "Shane Holder" "holder@rsn.hp.com") - (print-short "Chris Holt" "xris@migraine.stanford.edu") - (print-short "Tetsuya HOYANO" "hoyano@ari.bekkoame.or.jp") - (print-short "David Hughes" "djh@harston.cv.com") - (print-short "Tudor Hulubei" "tudor@cs.unh.edu") - (print-short "Tatsuya Ichikawa" "ichikawa@hv.epson.co.jp") - (print-short "Andrew Innes" "andrewi@harlequin.co.uk") - (print-short "Andreas Jaeger" "aj@arthur.rhein-neckar.de") - (print-short "Markku Jarvinen" "Markku.Jarvinen@simpukka.funet.fi") - (print-short "Robin Jeffries" "robin.jeffries@sun.com") - (print-short "Philip Johnson" "johnson@uhics.ics.Hawaii.Edu") - (print-short "J. Kean Johnston" "jkj@paradigm-sa.com") - (print-short "John W. Jones" "jj@asu.edu") - (print-short "Andreas Kaempf" "andreas@sccon.com") - (print-short "Yoshiaki Kasahara" "kasahara@nc.kyushu-u.ac.jp") - (print-short "Kirill M. Katsnelson" "kkm@kis.ru") - (print-short "Amir Katz" "amir@ndsoft.com") - (print-short "Doug Keller" "dkeller@vnet.ibm.com") - (print-short "Hunter Kelly" "retnuh@corona") - (print-short "Gregor Kennedy" "gregork@dadd.ti.com") - (print-short "Michael Kifer" "kifer@cs.sunysb.edu") - (print-short "Yasuhiko Kiuchi" "kiuchi@dsp.ksp.fujixerox.co.jp") - (print-short "Greg Klanderman" "greg.klanderman@alum.mit.edu") - (print-short "Valdis Kletnieks" "Valdis.Kletnieks@vt.edu") - (print-short "Norbert Koch" "n.koch@delta-ii.de") - (print-short "Rob Kooper" "kooper@cc.gatech.edu") - (print-short "Peter Skov Knudsen" "knu@dde.dk") - (print-short "Jens Krinke" "krinke@ips.cs.tu-bs.de") - (print-short "Maximilien Lincourt" "max@toonboom.com") - (print-short "Mats Larsson" "Mats.Larsson@uab.ericsson.se") - (print-short "Simon Leinen" "simon@instrumatic.ch") - (print-short "Carsten Leonhardt" "leo@arioch.oche.de") - (print-short "James LewisMoss" "moss@cs.sc.edu") - (print-short "Mats Lidell" "mats.lidell@contactor.se") - (print-short "Matt Liggett" "mliggett@seven.ucs.indiana.edu") - (print-short "Christian Limpach" "Christian.Limpach@nice.ch") - (print-short "Maximilien Lincourt" "max@toonboom.com") - (print-short "Markus Linnala" "maage@b14b.tupsu.ton.tut.fi") - (print-short "Robert Lipe" "robertl@arnet.com") - (print-short "Derrell Lipman" "derrell@vis-av.com") - (print-short "Damon Lipparelli" "lipp@aa.net") - (print-short "Hamish Macdonald" "hamish@bnr.ca") - (print-short "Ian MacKinnon" "imackinnon@telia.co.uk") - (print-short "Patrick MacRoberts" "macro@hpcobr30.cup.hp.com") - (print-short "Tonny Madsen" "Tonny.Madsen@netman.dk") - (print-short "Ketil Z Malde" "ketil@ii.uib.no") - (print-short "Steve March" "smarch@quaver.urbana.mcd.mot.com") - (print-short "Ricardo Marek" "ricky@ornet.co.il") - (print-short "Pekka Marjola" "pema@iki.fi") - (print-short "Simon Marshall" "simon@gnu.ai.mit.edu") - (print-short "Dave Mason" "dmason@plg.uwaterloo.ca") - (print-short "Jaye Mathisen" "mrcpu@cdsnet.net") - (print-short "Jason McLaren" "mclaren@math.mcgill.ca") - (print-short "Michael McNamara" "mac@silicon-sorcery.com") - (print-short "Michael Meissner" "meissner@osf.org") - (print-short "David M. Meyer" "meyer@ns.uoregon.edu") - (print-short "John Mignault" "jbm@panix.com") - (print-short "Brad Miller" "bmiller@cs.umn.edu") - (print-short "John Morey" "jmorey@crl.com") - (print-short "Rob Mori" "rob.mori@sun.com") - (print-short "Heiko Muenkel" "muenkel@tnt.uni-hannover.de") - (print-short "Arup Mukherjee" "arup+@cs.cmu.edu") - (print-short "Colas Nahaboo" "Colas.Nahaboo@sophia.inria.fr") - (print-short "Lynn D. Newton" "lynn@ives.phx.mcd.mot.com") - (print-short "Casey Nielson" "knielson@joule.elee.calpoly.edu") - (print-short "Georg Nikodym" "Georg.Nikodym@canada.sun.com") - (print-short "Andy Norman" "ange@hplb.hpl.hp.com") - (print-short "Joe Nuspl" "nuspl@sequent.com") - (print-short "Kim Nyberg" "kny@tekla.fi") - (print-short "Kevin Oberman" "oberman@es.net") - (print-short "David Ofelt" "ofelt@getalife.Stanford.EDU") - (print-short "Alexandre Oliva" "oliva@dcc.unicamp.br") - (print-short "Tore Olsen" "toreo@colargol.idb.hist.no") - (print-short "Greg Onufer" "Greg.Onufer@eng.sun.com") - (print-short "Achim Oppelt" "aoppelt@theorie3.physik.uni-erlangen.de") - (print-short "Rebecca Ore" "rebecca.ore@op.net") - (print-short "Sudeep Kumar Palat" "palat@idt.unit.no") - (print-short "Joel Peterson" "tarzan@aosi.com") - (print-short "Thomas A. Peterson" "tap@src.honeywell.com") - (print-short "Tibor Polgar" "tibor@alteon.com") - (print-short "Fabrice POPINEAU" "popineau@esemetz.ese-metz.fr") - (print-short "Frederic Poncin" "fp@info.ucl.ac.be") - (print-short "E. Rehmi Post" "rehmi@asylum.sf.ca.us") - (print-short "Martin Pottendorfer" "Martin.Pottendorfer@aut.alcatel.at") - (print-short "Colin Rafferty" "colin@xemacs.org") - (print-short "Rick Rankin" "Rick_Rankin-P15254@email.mot.com") - (print-short "Paul M Reilly" "pmr@pajato.com") - (print-short "Jack Repenning" "jackr@sgi.com") - (print-short "Daniel Rich" "drich@cisco.com") - (print-short "Roland Rieke" "rol@darmstadt.gmd.de") - (print-short "Art Rijos" "art.rijos@SNET.com") - (print-short "Russell Ritchie" "ritchier@britannia-life.co.uk") - (print-short "Roland" "rol@darmstadt.gmd.de") - (print-short "Mike Russell" "mjruss@rchland.vnet.ibm.com") - (print-short "Hajime Saitou" "hajime@jsk.t.u-tokyo.ac.jp") - (print-short "Jan Sandquist" "etxquist@iqa.ericsson.se") - (print-short "Marty Sasaki" "sasaki@spdcc.com") - (print-short "SATO Daisuke" "densuke@ga2.so-net.or.jp") - (print-short "Kenji Sato" "ken@ny.kdd.com") - (print-short "Mike Scheidler" "c23mts@eng.delcoelect.com") - (print-short "Daniel Schepler" "daniel@shep13.wustl.edu") - (print-short "Holger Schauer" "schauer@coling.uni-freiburg.de") - (print-short "Darrel Schneider" "darrel@slc.com") - (print-short "Hayden Schultz" "haydens@ll.mit.edu") - (print-short "Cotton Seed" "cottons@cybercom.net") - (print-short "Axel Seibert" "seiberta@informatik.tu-muenchen.de") - (print-short "Odd-Magne Sekkingstad" "oddms@ii.uib.no") - (print-short "Gregory Neil Shapiro" "gshapiro@sendmail.org") - (print-short "Justin Sheehy" "justin@linus.mitre.org") - (print-short "John Shen" "zfs60@cas.org") - (print-short "Murata Shuuichirou" "mrt@mickey.ai.kyutech.ac.jp") - (print-short "Matt Simmons" "simmonmt@acm.org") - (print-short "Dinesh Somasekhar" "somasekh@ecn.purdue.edu") - (print-short "Jeffrey Sparkes" "jsparkes@bnr.ca") - (print-short "Manoj Srivastava" "srivasta@pilgrim.umass.edu") - (print-short "Francois Staes" "frans@kiwi.uia.ac.be") - (print-short "Anders Stenman" "stenman@isy.liu.se") - (print-short "Jason Stewart" "jasons@cs.unm.edu") - (print-short "Rick Tait" "rickt@gnu.ai.mit.edu") - (print-short "TANAKA Hayashi" "tanakah@mxa.mesh.ne.jp") - (print-short "Samuel Tardieu" "sam@inf.enst.fr") - (print-short "James Thompson" "thompson@wg2.waii.com") - (print-short "Nobu Toge" "toge@accad1.kek.jp") - (print-short "Raymond L. Toy" "toy@rtp.ericsson.se") - (print-short "Remek Trzaska" "remek@npac.syr.edu") - (print-short "TSUTOMU Nakamura" "tsutomu@rs.kyoto.omronsoft.co.jp") - (print-short "Stefanie Teufel" "s.teufel@ndh.net") - (print-short "Gary Thomas" "g.thomas@opengroup.org") - (print-short "Stephen Turnbull" "turnbull@sk.tsukuba.ac.jp") - (print-short "John Turner" "turner@xdiv.lanl.gov") - (print-short "UENO Fumihiro" "7m2vej@ritp.ye.IHI.CO.JP") - (print-short "Aki Vehtari" "Aki.Vehtari@hut.fi") - (print-short "Juan E. Villacis" "jvillaci@cs.indiana.edu") - (print-short "Jan Vroonhof" "vroonhof@math.ethz.ch") - (print-short "Vladimir Vukicevic" "vladimir@intrepid.com") - (print-short "Charles G. Waldman" "cgw@pgt.com") - (print-short "David Walte" "djw18@cornell.edu") - (print-short "Peter Ware" "ware@cis.ohio-state.edu") - (print-short "Christoph Wedler" "wedler@fmi.uni-passau.de") - (print-short "Yoav Weiss" "yoav@zeus.datasrv.co.il") - (print-short "Peter B. West" "p.west@uq.net.au") - (print-short "Rod Whitby" "rwhitby@asc.corp.mot.com") - (print-short "Rich Williams" "rdw@hplb.hpl.hp.com") - (print-short "Raymond Wiker" "raymond@orion.no") - (print-short "Peter Windle" "peterw@SDL.UG.EDS.COM") - (print-short "David C Worenklein" "dcw@gcm.com") - (print-short "Takeshi Yamada" "yamada@sylvie.kecl.ntt.jp") - (print-short "Katsumi Yamaoka" "yamaoka@ga.sony.co.jp") - (print-short "Jason Yanowitz" "yanowitz@eternity.cs.umass.edu") - (print-short "La Monte Yarroll" "piggy@hilbert.maths.utas.edu.au") - (print-short "Blair Zajac" "blair@olympia.gps.caltech.edu") - (print-short "Volker Zell" "vzell@de.oracle.com") - (print-short "Daniel Zivkovic" "daniel@canada.sun.com") - (print-short "Karel Zuiderveld" "Karel.Zuiderveld@cv.ruu.nl") - "\n")) - (about-finish-buffer))) - -;;; about.el ends here diff --git a/lisp/alist.el b/lisp/alist.el deleted file mode 100644 index 4a1fd3a..0000000 --- a/lisp/alist.el +++ /dev/null @@ -1,101 +0,0 @@ -;;; alist.el --- utility functions about assoc-list - -;; Copyright (C) 1993,1994,1995,1996 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: -;; $Id: alist.el,v 0.0 1997/02/28 02:18:23 tmorioka Exp $ -;; Keywords: alist - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; 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. - -;;; Code: - -(defun put-alist (item value alist) - "Modify ALIST to set VALUE to ITEM. -If there is a pair whose car is ITEM, replace its cdr by VALUE. -If there is not such pair, create new pair (ITEM . VALUE) and -return new alist whose car is the new pair and cdr is ALIST. -\[tomo's ELIS like function]" - (let ((pair (assoc item alist))) - (if pair - (progn - (setcdr pair value) - alist) - (cons (cons item value) alist) - ))) - -(defun del-alist (item alist) - "If there is a pair whose key is ITEM, delete it from ALIST. -\[tomo's ELIS emulating function]" - (if (equal item (car (car alist))) - (cdr alist) - (let ((pr alist) - (r (cdr alist)) - ) - (catch 'tag - (while (not (null r)) - (if (equal item (car (car r))) - (progn - (rplacd pr (cdr r)) - (throw 'tag alist))) - (setq pr r) - (setq r (cdr r)) - ) - alist)))) - -(defun set-alist (symbol item value) - "Modify a alist indicated by SYMBOL to set VALUE to ITEM." - (or (boundp symbol) - (set symbol nil) - ) - (set symbol (put-alist item value (symbol-value symbol))) - ) - -(defun remove-alist (symbol item) - "Remove ITEM from the alist indicated by SYMBOL." - (and (boundp symbol) - (set symbol (del-alist item (symbol-value symbol))) - )) - -(defun modify-alist (modifier default) - "Modify alist DEFAULT into alist MODIFIER." - (mapcar (function - (lambda (as) - (setq default (put-alist (car as)(cdr as) default)) - )) - modifier) - default) - -(defun set-modified-alist (sym modifier) - "Modify a value of a symbol SYM into alist MODIFIER. -The symbol SYM should be alist. If it is not bound, -its value regard as nil." - (if (not (boundp sym)) - (set sym nil) - ) - (set sym (modify-alist modifier (eval sym))) - ) - - -;;; @ end -;;; - -(provide 'alist) - -;;; alist.el ends here diff --git a/lisp/apropos.el b/lisp/apropos.el deleted file mode 100644 index 5839194..0000000 --- a/lisp/apropos.el +++ /dev/null @@ -1,690 +0,0 @@ -;;; apropos.el --- apropos commands for users and programmers. - -;; Copyright (C) 1989, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Joe Wells -;; Rewritten: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 -;; Maintainer: SL Baur -;; 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 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: Last synched with FSF 19.34, diverged since. - -;;; Commentary: - -;; The ideas for this package were derived from the C code in -;; src/keymap.c and elsewhere. The functions in this file should -;; always be byte-compiled for speed. Someone should rewrite this in -;; C (as part of src/keymap.c) for speed. - -;; The idea for super-apropos is based on the original implementation -;; by Lynn Slater . - -;;; ChangeLog: - -;; Fixed bug, current-local-map can return nil. -;; Change, doesn't calculate key-bindings unless needed. -;; Added super-apropos capability, changed print functions. -;;; Made fast-apropos and super-apropos share code. -;;; Sped up fast-apropos again. -;; Added apropos-do-all option. -;;; Added fast-command-apropos. -;; Changed doc strings to comments for helping functions. -;;; Made doc file buffer read-only, buried it. -;; Only call substitute-command-keys if do-all set. - -;; Optionally use configurable faces to make the output more legible. -;; Differentiate between command, function and macro. -;; Apropos-command (ex command-apropos) does cmd and optionally user var. -;; Apropos shows all 3 aspects of symbols (fn, var and plist) -;; Apropos-documentation (ex super-apropos) now finds all it should. -;; New apropos-value snoops through all values and optionally plists. -;; Reading DOC file doesn't load nroff. -;; Added hypertext following of documentation, mouse-2 on variable gives value -;; from buffer in active window. - -;;; Code: - -;; I see a degradation of maybe 10-20% only. -;; [sb -- FSF protects the face declarations with `if window-system' -;; I see no reason why we should do so] -(defvar apropos-do-all nil - "*Whether the apropos commands should do more. -Slows them down more or less. Set this non-nil if you have a fast machine.") - -;; XEmacs addition -(defvar apropos-symbol-face (if (boundp 'font-lock-keyword-face) - font-lock-keyword-face - 'bold) - "*Face for symbol name in apropos output or `nil'. -This looks good, but slows down the commands several times.") - -;; XEmacs addition -(defvar apropos-keybinding-face (if (boundp 'font-lock-string-face) - font-lock-string-face - 'underline) - "*Face for keybinding display in apropos output or `nil'. -This looks good, but slows down the commands several times.") - -;; XEmacs addition -(defvar apropos-label-face (if (boundp 'font-lock-comment-face) - font-lock-comment-face - 'italic) - "*Face for label (Command, Variable ...) in apropos output or `nil'. -If this is `nil' no mouse highlighting occurs. -This looks good, but slows down the commands several times. -When this is a face name, as it is initially, it gets transformed to a -text-property list for efficiency.") - -;; XEmacs addition -(defvar apropos-property-face (if (boundp 'font-lock-variable-name-face) - font-lock-variable-name-face - 'bold-italic) - "*Face for property name in apropos output or `nil'. -This looks good, but slows down the commands several times.") - -(defvar apropos-match-face 'secondary-selection - "*Face for matching part in apropos-documentation/value output or `nil'. -This looks good, but slows down the commands several times.") - - -(defvar apropos-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(control m)] 'apropos-follow) - (define-key map [(button2up)] 'apropos-mouse-follow) - (define-key map [(button2)] 'undefined) - map) - "Keymap used in Apropos mode.") - - -(defvar apropos-regexp nil - "Regexp used in current apropos run.") - -(defvar apropos-files-scanned () - "List of elc files already scanned in current run of `apropos-documentation'.") - -(defvar apropos-accumulator () - "Alist of symbols already found in current apropos run.") - -(defvar apropos-item () - "Current item in or for apropos-accumulator.") - -(defvar apropos-mode-hook nil) ; XEmacs - -(defun apropos-mode () - "Major mode for following hyperlinks in output of apropos commands. - -\\{apropos-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map apropos-mode-map) - (setq major-mode 'apropos-mode - mode-name "Apropos") - (run-hooks 'apropos-mode-hook)) ; XEmacs - - -;; For auld lang syne: -;;;###autoload -(fset 'command-apropos 'apropos-command) - -;;;###autoload -(defun apropos-command (apropos-regexp &optional do-all) - "Shows commands (interactively callable functions) that match REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also show -variables." - ;; XEmacs: All code related to special treatment of buffer has been removed - (interactive (list (read-string (concat "Apropos command " - (if (or current-prefix-arg - apropos-do-all) - "or variable ") - "(regexp): ")) - current-prefix-arg)) - (or do-all (setq do-all apropos-do-all)) - (setq apropos-accumulator - (apropos-internal apropos-regexp - (if do-all - (lambda (symbol) (or (commandp symbol) - (user-variable-p symbol))) - 'commandp))) - (apropos-print - t - (lambda (p) - (let (doc symbol) - (while p - (setcar p (list - (setq symbol (car p)) - (if (commandp symbol) - (if (setq doc - ;; XEmacs change: if obsolete, - ;; only mention that. - (or (function-obsoleteness-doc symbol) - (documentation symbol t))) - (substring doc 0 (string-match "\n" doc)) - "(not documented)")) - (and do-all - (user-variable-p symbol) - (if (setq doc - (or - ;; XEmacs change: if obsolete, - ;; only mention that. - (variable-obsoleteness-doc symbol) - (documentation-property - symbol 'variable-documentation t))) - (substring doc 0 - (string-match "\n" doc)))))) - (setq p (cdr p))))) - nil)) - - -;;;###autoload -(defun apropos (apropos-regexp &optional do-all) - "Show all bound symbols whose names match REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound -symbols and key bindings, which is a little more time-consuming. -Returns list of symbols and documentation found." - (interactive "sApropos symbol (regexp): \nP") - ;; XEmacs change: hitting ENTER by mistake is a common mess-up and - ;; shouldn't make Emacs hang for a long time trying to list all symbols. - (or (> (length apropos-regexp) 0) - (error "Must pass non-empty regexp to `apropos'")) - (setq apropos-accumulator - (apropos-internal apropos-regexp - (and (not do-all) - (not apropos-do-all) - (lambda (symbol) - (or (fboundp symbol) - (boundp symbol) - (find-face symbol) - (symbol-plist symbol)))))) - (apropos-print - (or do-all apropos-do-all) - (lambda (p) - (let (symbol doc) - (while p - (setcar p (list - (setq symbol (car p)) - (if (fboundp symbol) - (if (setq doc - ;; XEmacs change: if obsolete, - ;; only mention that. - (or (function-obsoleteness-doc symbol) - (documentation symbol t))) - (substring doc 0 (string-match "\n" doc)) - "(not documented)")) - (if (boundp symbol) - (if (setq doc - (or - ;; XEmacs change: if obsolete, - ;; only mention that. - (variable-obsoleteness-doc symbol) - (documentation-property - symbol 'variable-documentation t))) - (substring doc 0 - (string-match "\n" doc)) - "(not documented)")) - (if (setq doc (symbol-plist symbol)) - (if (eq (/ (length doc) 2) 1) - (format "1 property (%s)" (car doc)) - (format "%d properties" (/ (length doc) 2)))) - (if (get symbol 'widget-type) - (if (setq doc (documentation-property - symbol 'widget-documentation t)) - (substring doc 0 - (string-match "\n" doc)) - "(not documented)")) - (if (find-face symbol) - (if (setq doc (face-doc-string symbol)) - (substring doc 0 - (string-match "\n" doc)) - "(not documented)")) - (when (get symbol 'custom-group) - (if (setq doc (documentation-property - symbol 'group-documentation t)) - (substring doc 0 - (string-match "\n" doc)) - "(not documented)")))) - (setq p (cdr p))))) - nil)) - - -;;;###autoload -(defun apropos-value (apropos-regexp &optional do-all) - "Show all symbols whose value's printed image matches REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also looks -at the function and at the names and values of properties. -Returns list of symbols and values found." - (interactive "sApropos value (regexp): \nP") - (or do-all (setq do-all apropos-do-all)) - (setq apropos-accumulator ()) - (let (f v p) - (mapatoms - (lambda (symbol) - (setq f nil v nil p nil) - (or (memq symbol '(apropos-regexp do-all apropos-accumulator - symbol f v p)) - (setq v (apropos-value-internal 'boundp symbol 'symbol-value))) - (if do-all - (setq f (apropos-value-internal 'fboundp symbol 'symbol-function) - p (apropos-format-plist symbol "\n " t))) - (if (or f v p) - (setq apropos-accumulator (cons (list symbol f v p) - apropos-accumulator)))))) - (apropos-print nil nil t)) - - -;;;###autoload -(defun apropos-documentation (apropos-regexp &optional do-all) - "Show symbols whose documentation contain matches for REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also use -documentation that is not stored in the documentation file and show key -bindings. -Returns list of symbols and documentation found." - (interactive "sApropos documentation (regexp): \nP") - (or do-all (setq do-all apropos-do-all)) - (setq apropos-accumulator () apropos-files-scanned ()) - (let ((standard-input (get-buffer-create " apropos-temp")) - f v) - (unwind-protect - (save-excursion - (set-buffer standard-input) - (apropos-documentation-check-doc-file) - (if do-all - (mapatoms - (lambda (symbol) - (setq f (apropos-safe-documentation symbol) - v (get symbol 'variable-documentation)) - (when (integerp v) (setq v nil)) - (setq f (apropos-documentation-internal f) - v (apropos-documentation-internal v)) - (if (or f v) - (if (setq apropos-item - (cdr (assq symbol apropos-accumulator))) - (progn - (if f - (setcar apropos-item f)) - (if v - (setcar (cdr apropos-item) v))) - (setq apropos-accumulator - (cons (list symbol f v) - apropos-accumulator))))))) - (apropos-print nil nil t)) - (kill-buffer standard-input)))) - - -(defun apropos-value-internal (predicate symbol function) - (if (funcall predicate symbol) - (progn - (setq symbol (prin1-to-string (funcall function symbol))) - (if (string-match apropos-regexp symbol) - (progn - (if apropos-match-face - (put-text-property (match-beginning 0) (match-end 0) - 'face apropos-match-face - symbol)) - symbol))))) - -(defun apropos-documentation-internal (doc) - (if (consp doc) - (apropos-documentation-check-elc-file (car doc)) - (and doc - (string-match apropos-regexp doc) - (progn - (if apropos-match-face - (put-text-property (match-beginning 0) - (match-end 0) - 'face apropos-match-face - (setq doc (copy-sequence doc)))) - doc)))) - -(defun apropos-format-plist (pl sep &optional compare) - (setq pl (symbol-plist pl)) - (let (p p-out) - (while pl - (setq p (format "%s %S" (car pl) (nth 1 pl))) - (if (or (not compare) (string-match apropos-regexp p)) - (if apropos-property-face - (put-text-property 0 (length (symbol-name (car pl))) - 'face apropos-property-face p)) - (setq p nil)) - (if p - (progn - (and compare apropos-match-face - (put-text-property (match-beginning 0) (match-end 0) - 'face apropos-match-face - p)) - (setq p-out (concat p-out (if p-out sep) p)))) - (setq pl (nthcdr 2 pl))) - p-out)) - - -;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name. - -(defun apropos-documentation-check-doc-file () - (let (type symbol (sepa 2) sepb beg end) - (princ ?\^_) - (backward-char) - (insert-file-contents (concat doc-directory internal-doc-file-name)) - (forward-char) - (while (save-excursion - (setq sepb (search-forward "\^_")) - (not (eobp))) - (beginning-of-line 2) - (if (save-restriction - (narrow-to-region (point) (1- sepb)) - (re-search-forward apropos-regexp nil t)) - (progn - (setq beg (match-beginning 0) - end (point)) - (goto-char (1+ sepa)) - (or (setq type (if (eq ?F (preceding-char)) - 1 ; function documentation - 2) ; variable documentation - symbol (read) - beg (- beg (point) 1) - end (- end (point) 1) - doc (buffer-substring (1+ (point)) (1- sepb)) - apropos-item (assq symbol apropos-accumulator)) - (setq apropos-item (list symbol nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (if apropos-match-face - (put-text-property beg end 'face apropos-match-face doc)) - (setcar (nthcdr type apropos-item) doc))) - (setq sepa (goto-char sepb))))) - -(defun apropos-documentation-check-elc-file (file) - (if (member file apropos-files-scanned) - nil - (let (symbol doc beg end this-is-a-variable) - (setq apropos-files-scanned (cons file apropos-files-scanned)) - (erase-buffer) - (insert-file-contents file) - (while (search-forward "\n#@" nil t) - ;; Read the comment length, and advance over it. - (setq end (read) - beg (1+ (point)) - end (+ (point) end -1)) - (forward-char) - (if (save-restriction - ;; match ^ and $ relative to doc string - (narrow-to-region beg end) - (re-search-forward apropos-regexp nil t)) - (progn - (goto-char (+ end 2)) - (setq doc (buffer-substring beg end) - end (- (match-end 0) beg) - beg (- (match-beginning 0) beg) - this-is-a-variable (looking-at "(def\\(var\\|const\\) ") - symbol (progn - (skip-chars-forward "(a-z") - (forward-char) - (read)) - symbol (if (consp symbol) - (nth 1 symbol) - symbol)) - (if (if this-is-a-variable - (get symbol 'variable-documentation) - (and (fboundp symbol) (apropos-safe-documentation symbol))) - (progn - (or (setq apropos-item (assq symbol apropos-accumulator)) - (setq apropos-item (list symbol nil nil) - apropos-accumulator (cons apropos-item - apropos-accumulator))) - (if apropos-match-face - (put-text-property beg end 'face apropos-match-face - doc)) - (setcar (nthcdr (if this-is-a-variable 2 1) - apropos-item) - doc))))))))) - - - -(defun apropos-safe-documentation (function) - "Like documentation, except it avoids calling `get_doc_string'. -Will return nil instead." - (while (and function (symbolp function)) - (setq function (if (fboundp function) - (symbol-function function)))) - (if (eq (car-safe function) 'macro) - (setq function (cdr function))) - ;; XEmacs change from: (setq function (if (byte-code-function-p function) - (setq function (if (compiled-function-p function) - (if (fboundp 'compiled-function-doc-string) - (compiled-function-doc-string function) - (if (> (length function) 4) - (aref function 4))) - (if (eq (car-safe function) 'autoload) - (nth 2 function) - (if (eq (car-safe function) 'lambda) - (if (stringp (nth 2 function)) - (nth 2 function) - (if (stringp (nth 3 function)) - (nth 3 function))))))) - (if (integerp function) - nil - function)) - - - -(defun apropos-print (do-keys doc-fn spacing) - "Output result of various apropos commands with `apropos-regexp'. -APROPOS-ACCUMULATOR is a list. Optional DOC-FN is called for each element -of apropos-accumulator and may modify it resulting in (symbol fn-doc -var-doc [plist-doc]). Returns sorted list of symbols and documentation -found." - (if (null apropos-accumulator) - (message "No apropos matches for `%s'" apropos-regexp) - (if doc-fn - (funcall doc-fn apropos-accumulator)) - (setq apropos-accumulator - (sort apropos-accumulator (lambda (a b) - (string-lessp (car a) (car b))))) - (and apropos-label-face - (or (symbolp apropos-label-face) - (facep apropos-label-face)) ; XEmacs - (setq apropos-label-face `(face ,apropos-label-face - mouse-face highlight))) - (let ((help-buffer-prefix-string "Apropos")) - (with-displaying-help-buffer - (lambda () - (with-current-buffer standard-output - (run-hooks 'apropos-mode-hook) - (let ((p apropos-accumulator) - (old-buffer (current-buffer)) - symbol item point1 point2) - ;; XEmacs change from (if window-system - (if (device-on-window-system-p) - (progn - (princ "If you move the mouse over text that changes color,\n") - (princ (substitute-command-keys - "you can click \\[apropos-mouse-follow] to get more information.\n")))) - (princ (substitute-command-keys - "Type \\[apropos-follow] in this buffer to get full documentation.\n\n")) - (while (consp p) - (or (not spacing) (bobp) (terpri)) - (setq apropos-item (car p) - symbol (car apropos-item) - p (cdr p) - point1 (point)) - (princ symbol) ; print symbol name - (setq point2 (point)) - ;; Calculate key-bindings if we want them. - (and do-keys - (commandp symbol) - (indent-to 30 1) - (if (let ((keys - (save-excursion - (set-buffer old-buffer) - (where-is-internal symbol))) - filtered) - ;; Copy over the list of key sequences, - ;; omitting any that contain a buffer or a frame. - (while keys - (let ((key (car keys)) - (i 0) - loser) - (while (< i (length key)) - (if (or (framep (aref key i)) - (bufferp (aref key i))) - (setq loser t)) - (setq i (1+ i))) - (or loser - (setq filtered (cons key filtered)))) - (setq keys (cdr keys))) - (setq item filtered)) - ;; Convert the remaining keys to a string and insert. - (princ - (mapconcat - (lambda (key) - (setq key (key-description key)) - (if apropos-keybinding-face - (put-text-property 0 (length key) - 'face apropos-keybinding-face - key)) - key) - item ", ")) - (princ "Type ") - (princ "M-x") - (put-text-property (- (point) 3) (point) - 'face apropos-keybinding-face) - (princ (format " %s " (symbol-name symbol))) - (princ "RET") - (put-text-property (- (point) 3) (point) - 'face apropos-keybinding-face))) - (terpri) - ;; only now so we don't propagate text attributes all over - (put-text-property point1 point2 'item - (if (eval `(or ,@(cdr apropos-item))) - (car apropos-item) - apropos-item)) - (if apropos-symbol-face - (put-text-property point1 point2 'face apropos-symbol-face)) - (apropos-print-doc 'describe-function 1 - (if (commandp symbol) - "Command" - (if (apropos-macrop symbol) - "Macro" - "Function")) - do-keys) - (if (get symbol 'custom-type) - (apropos-print-doc 'customize-variable-other-window 2 - "User Option" do-keys) - (apropos-print-doc 'describe-variable 2 - "Variable" do-keys)) - (apropos-print-doc 'customize-other-window 6 "Group" do-keys) - (apropos-print-doc 'customize-face-other-window 5 "Face" do-keys) - (apropos-print-doc 'widget-browse-other-window 4 "Widget" do-keys) - (apropos-print-doc 'apropos-describe-plist 3 - "Plist" nil))))) - apropos-regexp)) - (prog1 apropos-accumulator - (setq apropos-accumulator ())))) ; permit gc - - -(defun apropos-macrop (symbol) - "Return t if SYMBOL is a Lisp macro." - (and (fboundp symbol) - (consp (setq symbol - (symbol-function symbol))) - (or (eq (car symbol) 'macro) - (if (eq (car symbol) 'autoload) - (memq (nth 4 symbol) - '(macro t)))))) - - -(defun apropos-print-doc (action i str do-keys) - (with-current-buffer standard-output - (if (stringp (setq i (nth i apropos-item))) - (progn - (insert " ") - (put-text-property (- (point) 2) (1- (point)) - 'action action) - (insert str ": ") - (if apropos-label-face - (add-text-properties (- (point) (length str) 2) - (1- (point)) - apropos-label-face)) - (add-text-properties (- (point) (length str) 2) - (1- (point)) - (list 'keymap apropos-mode-map)) - (insert (if do-keys (substitute-command-keys i) i)) - (or (bolp) (terpri)))))) - -(defun apropos-mouse-follow (event) - (interactive "e") - ;; XEmacs change: We're using the standard help buffer code now, don't - ;; do special tricks about trying to preserve current-buffer about mouse - ;; clicks. - - (save-excursion - ;; XEmacs change from: - ;; (set-buffer (window-buffer (posn-window (event-start event)))) - ;; (goto-char (posn-point (event-start event))) - (set-buffer (event-buffer event)) - (goto-char (event-closest-point event)) - ;; XEmacs change: following code seems useless - ;;(or (and (not (eobp)) (get-text-property (point) 'mouse-face)) - ;; (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face)) - ;; (error "There is nothing to follow here")) - (apropos-follow))) - - -(defun apropos-follow (&optional other) - (interactive) - (let* (;; Properties are always found at the beginning of the line. - (bol (save-excursion (beginning-of-line) (point))) - ;; If there is no `item' property here, look behind us. - (item (get-text-property bol 'item)) - (item-at (if item nil (previous-single-property-change bol 'item))) - ;; Likewise, if there is no `action' property here, look in front. - (action (get-text-property bol 'action)) - (action-at (if action nil (next-single-property-change bol 'action)))) - (and (null item) item-at - (setq item (get-text-property (1- item-at) 'item))) - (and (null action) action-at - (setq action (get-text-property action-at 'action))) - (if (not (and item action)) - (error "There is nothing to follow here")) - (if (consp item) (error "There is nothing to follow in `%s'" (car item))) - (if other (set-buffer other)) - (funcall action item))) - - - -(defun apropos-describe-plist (symbol) - "Display a pretty listing of SYMBOL's plist." - (let ((help-buffer-prefix-string "Apropos-plist")) - (with-displaying-help-buffer - (lambda () - (run-hooks 'apropos-mode-hook) - (princ "Symbol ") - (prin1 symbol) - (princ "'s plist is\n (") - (with-current-buffer standard-output - (if apropos-symbol-face - (put-text-property 8 (- (point) 14) 'face apropos-symbol-face))) - (princ (apropos-format-plist symbol "\n ")) - (princ ")") - (terpri) - (print-help-return-message)) - (symbol-name symbol)))) - -(provide 'apropos) ; XEmacs - -;;; apropos.el ends here diff --git a/lisp/auto-autoloads.el b/lisp/auto-autoloads.el deleted file mode 100644 index c77939e..0000000 --- a/lisp/auto-autoloads.el +++ /dev/null @@ -1,1679 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (featurep 'Standard-autoloads) (error "Already loaded")) - -;;;### (autoloads nil "abbrev" "lisp/abbrev.el") - -;;;*** - -;;;### (autoloads (about-xemacs) "about" "lisp/about.el") - -(autoload 'about-xemacs "about" "\ -Describe the True Editor and its minions." t nil) - -;;;*** - -;;;### (autoloads (apropos-documentation apropos-value apropos apropos-command) "apropos" "lisp/apropos.el") - -(fset 'command-apropos 'apropos-command) - -(autoload 'apropos-command "apropos" "\ -Shows commands (interactively callable functions) that match REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also show -variables." t nil) - -(autoload 'apropos "apropos" "\ -Show all bound symbols whose names match REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound -symbols and key bindings, which is a little more time-consuming. -Returns list of symbols and documentation found." t nil) - -(autoload 'apropos-value "apropos" "\ -Show all symbols whose value's printed image matches REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also looks -at the function and at the names and values of properties. -Returns list of symbols and values found." t nil) - -(autoload 'apropos-documentation "apropos" "\ -Show symbols whose documentation contain matches for REGEXP. -With optional prefix ARG or if `apropos-do-all' is non-nil, also use -documentation that is not stored in the documentation file and show key -bindings. -Returns list of symbols and documentation found." t nil) - -;;;*** - -;;;### (autoloads (batch-update-directory batch-update-autoloads update-autoloads-from-directory update-autoloads-here update-file-autoloads generate-file-autoloads) "autoload" "lisp/autoload.el") - -(autoload 'generate-file-autoloads "autoload" "\ -Insert at point a loaddefs autoload section for FILE. -autoloads are generated for defuns and defmacros in FILE -marked by `generate-autoload-cookie' (which see). -If FILE is being visited in a buffer, the contents of the buffer -are used." t nil) - -(autoload 'update-file-autoloads "autoload" "\ -Update the autoloads for FILE in `generated-autoload-file' -\(which FILE might bind in its local variables). -This functions refuses to update autoloads files." t nil) - -(autoload 'update-autoloads-here "autoload" "\ -Update sections of the current buffer generated by `update-file-autoloads'." t nil) - -(autoload 'update-autoloads-from-directory "autoload" "\ -Update `generated-autoload-file' with all the current autoloads from DIR. -This runs `update-file-autoloads' on each .el file in DIR. -Obsolete autoload entries for files that no longer exist are deleted." t nil) - -(autoload 'batch-update-autoloads "autoload" "\ -Update the autoloads for the files or directories on the command line. -Runs `update-file-autoloads' on files and `update-directory-autoloads' -on directories. 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 `xemacs -batch -f batch-update-autoloads *.el'. -The directory to which the auto-autoloads.el file must be the first parameter -on the command line." nil nil) - -(autoload 'batch-update-directory "autoload" "\ -Update the autoloads for the directory on the command line. -Runs `update-file-autoloads' on each file in the given directory, must -be used only with -batch and kills XEmacs on completion." nil nil) - -;;;*** - -;;;### (autoloads nil "buff-menu" "lisp/buff-menu.el") - -(defvar list-buffers-directory nil) - -(make-variable-buffer-local 'list-buffers-directory) - -;;;*** - -;;;### (autoloads (batch-byte-recompile-directory batch-byte-recompile-directory-norecurse batch-byte-compile display-call-tree byte-compile-sexp byte-compile compile-defun byte-compile-buffer byte-compile-and-load-file byte-compile-file byte-recompile-file byte-recompile-directory byte-force-recompile) "bytecomp" "lisp/bytecomp.el") - -(autoload 'byte-force-recompile "bytecomp" "\ -Recompile every `.el' file in DIRECTORY that already has a `.elc' file. -Files in subdirectories of DIRECTORY are processed also." t nil) - -(autoload 'byte-recompile-directory "bytecomp" "\ -Recompile every `.el' file in DIRECTORY that needs recompilation. -This is if a `.elc' file exists but is older than the `.el' file. -Files in subdirectories of DIRECTORY are processed also unless argument -NORECURSION is non-nil. - -If the `.elc' file does not exist, normally the `.el' file is *not* compiled. -But a prefix argument (optional second arg) means ask user, -for each such `.el' file, whether to compile it. Prefix argument 0 means -don't ask and compile the file anyway. - -A nonzero prefix argument also means ask about each subdirectory. - -If the fourth argument FORCE is non-nil, -recompile every `.el' file that already has a `.elc' file." t nil) - -(autoload 'byte-recompile-file "bytecomp" "\ -Recompile a file of Lisp code named FILENAME if it needs recompilation. -This is if the `.elc' file exists but is older than the `.el' file. - -If the `.elc' file does not exist, normally the `.el' file is *not* -compiled. But a prefix argument (optional second arg) means ask user -whether to compile it. Prefix argument 0 don't ask and recompile anyway." t nil) - -(autoload 'byte-compile-file "bytecomp" "\ -Compile a file of Lisp code named FILENAME into a file of byte code. -The output file's name is made by appending `c' to the end of FILENAME. -With prefix arg (noninteractively: 2nd arg), load the file after compiling." t nil) - -(autoload 'byte-compile-and-load-file "bytecomp" "\ -Compile a file of Lisp code named FILENAME into a file of byte code, -and then load it. The output file's name is made by appending \"c\" to -the end of FILENAME." t nil) - -(autoload 'byte-compile-buffer "bytecomp" "\ -Byte-compile and evaluate contents of BUFFER (default: the current buffer)." t nil) - -(autoload 'compile-defun "bytecomp" "\ -Compile and evaluate the current top-level form. -Print the result in the minibuffer. -With argument, insert value in current buffer after the form." t nil) - -(autoload 'byte-compile "bytecomp" "\ -If FORM is a symbol, byte-compile its function definition. -If FORM is a lambda or a macro, byte-compile it as a function." nil nil) - -(autoload 'byte-compile-sexp "bytecomp" "\ -Compile and return SEXP." nil nil) - -(autoload 'display-call-tree "bytecomp" "\ -Display a call graph of a specified file. -This lists which functions have been called, what functions called -them, and what functions they call. The list includes all functions -whose definitions have been compiled in this Emacs session, as well as -all functions called by those functions. - -The call graph does not include macros, inline functions, or -primitives that the byte-code interpreter knows about directly (eq, -cons, etc.). - -The call tree also lists those functions which are not known to be called -\(that is, to which no calls have been compiled), and which cannot be -invoked interactively." t nil) - -(autoload 'batch-byte-compile "bytecomp" "\ -Run `byte-compile-file' on the files remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -Each file is processed even if an error occurred previously. -For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" nil nil) - -(autoload 'batch-byte-recompile-directory-norecurse "bytecomp" "\ -Same as `batch-byte-recompile-directory' but without recursion." nil nil) - -(autoload 'batch-byte-recompile-directory "bytecomp" "\ -Runs `byte-recompile-directory' on the dirs remaining on the command line. -Must be used only with `-batch', and kills Emacs on completion. -For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'." nil nil) - -;;;*** - -;;;### (autoloads (compiler-macroexpand define-compiler-macro ignore-file-errors ignore-errors assert check-type typep deftype cl-struct-setf-expander defstruct define-modify-macro callf2 callf letf* letf rotatef shiftf remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method declare the locally multiple-value-setq multiple-value-bind lexical-let* lexical-let symbol-macrolet macrolet labels flet 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 function* defmacro* defun* gentemp gensym cl-compile-time-init) "cl-macs" "lisp/cl-macs.el") - -(autoload 'cl-compile-time-init "cl-macs" nil nil nil) - -(autoload 'gensym "cl-macs" "\ -Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." nil nil) - -(autoload 'gentemp "cl-macs" "\ -Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\"." nil nil) - -(autoload 'defun* "cl-macs" "\ -(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. -Like normal `defun', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (block NAME ...)." nil 'macro) - -(autoload 'defmacro* "cl-macs" "\ -(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. -Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (block NAME ...)." nil 'macro) - -(autoload 'function* "cl-macs" "\ -(function* SYMBOL-OR-LAMBDA): introduce a function. -Like normal `function', except that if argument is a lambda form, its -ARGLIST allows full Common Lisp conventions." nil 'macro) - -(autoload 'destructuring-bind "cl-macs" nil nil 'macro) - -(autoload 'eval-when "cl-macs" "\ -(eval-when (WHEN...) BODY...): control when BODY is evaluated. -If `compile' is in WHEN, BODY is evaluated when compiled at top-level. -If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. -If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." nil 'macro) - -(autoload 'load-time-value "cl-macs" "\ -Like `progn', but evaluates the body at load time. -The result of the body appears to the compiler as a quoted constant." nil 'macro) - -(autoload 'case "cl-macs" "\ -(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. -Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared -against each key in each KEYLIST; the corresponding BODY is evaluated. -If no clause succeeds, case returns nil. A single atom may be used in -place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is -allowed only in the final clause, and matches if no other keys match. -Key values are compared by `eql'." nil 'macro) - -(autoload 'ecase "cl-macs" "\ -(ecase EXPR CLAUSES...): like `case', but error if no case fits. -`otherwise'-clauses are not allowed." nil 'macro) - -(autoload 'typecase "cl-macs" "\ -(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. -Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it -satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, -typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the -final clause, and matches if no other keys match." nil 'macro) - -(autoload 'etypecase "cl-macs" "\ -(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. -`otherwise'-clauses are not allowed." nil 'macro) - -(autoload 'block "cl-macs" "\ -(block NAME BODY...): define a lexically-scoped block named NAME. -NAME may be any symbol. Code inside the BODY forms can call `return-from' -to jump prematurely out of the block. This differs from `catch' and `throw' -in two respects: First, the NAME is an unevaluated symbol rather than a -quoted symbol or other form; and second, NAME is lexically rather than -dynamically scoped: Only references to it within BODY will work. These -references may appear inside macro expansions, but not inside functions -called from BODY." nil 'macro) - -(autoload 'return "cl-macs" "\ -(return [RESULT]): return from the block named nil. -This is equivalent to `(return-from nil RESULT)'." nil 'macro) - -(autoload 'return-from "cl-macs" "\ -(return-from NAME [RESULT]): return from the block named NAME. -This jumps out to the innermost enclosing `(block NAME ...)' form, -returning RESULT from that form (or nil if RESULT is omitted). -This is compatible with Common Lisp, but note that `defun' and -`defmacro' do not create implicit blocks as they do in Common Lisp." nil 'macro) - -(autoload 'loop "cl-macs" "\ -(loop CLAUSE...): The Common Lisp `loop' macro. -Valid clauses are: - for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, - for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, - for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, - always COND, never COND, thereis COND, collect EXPR into VAR, - append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, - count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, - if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, - finally return EXPR, named NAME." nil 'macro) - -(autoload 'do "cl-macs" "\ -The Common Lisp `do' loop. -Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil 'macro) - -(autoload 'do* "cl-macs" "\ -The Common Lisp `do*' loop. -Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil 'macro) - -(autoload 'dolist "cl-macs" "\ -(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." nil 'macro) - -(autoload 'dotimes "cl-macs" "\ -(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. -Evaluate BODY with VAR bound to successive integers from 0, inclusive, -to COUNT, exclusive. Then evaluate RESULT to get return value, default -nil." nil 'macro) - -(autoload 'do-symbols "cl-macs" "\ -(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. -Evaluate BODY with VAR bound to each interned symbol, or to each symbol -from OBARRAY." nil 'macro) - -(autoload 'do-all-symbols "cl-macs" nil nil 'macro) - -(autoload 'psetq "cl-macs" "\ -(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. -This is like `setq', except that all VAL forms are evaluated (in order) -before assigning any symbols SYM to the corresponding values." nil 'macro) - -(autoload 'progv "cl-macs" "\ -(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. -The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. -Each SYMBOL in the first list is bound to the corresponding VALUE in the -second list (or made unbound if VALUES is shorter than SYMBOLS); then the -BODY forms are executed and their result is returned. This is much like -a `let' form, except that the list of symbols can be computed at run-time." nil 'macro) - -(autoload 'flet "cl-macs" "\ -(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. -This is an analogue of `let' that operates on the function cell of FUNC -rather than its value cell. The FORMs are evaluated with the specified -function definitions in place, then the definitions are undone (the FUNCs -go back to their previous definitions, or lack thereof)." nil 'macro) - -(autoload 'labels "cl-macs" "\ -(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings. -This is like `flet', except the bindings are lexical instead of dynamic. -Unlike `flet', this macro is fully compliant with the Common Lisp standard." nil 'macro) - -(autoload 'macrolet "cl-macs" "\ -(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. -This is like `flet', but for macros instead of functions." nil 'macro) - -(autoload 'symbol-macrolet "cl-macs" "\ -(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. -Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." nil 'macro) - -(autoload 'lexical-let "cl-macs" "\ -(lexical-let BINDINGS BODY...): like `let', but lexically scoped. -The main visible difference is that lambdas inside BODY will create -lexical closures as in Common Lisp." nil 'macro) - -(autoload 'lexical-let* "cl-macs" "\ -(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. -The main visible difference is that lambdas inside BODY will create -lexical closures as in Common Lisp." nil 'macro) - -(autoload 'multiple-value-bind "cl-macs" "\ -(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. -FORM must return a list; the BODY is then executed with the first N elements -of this list bound (`let'-style) to each of the symbols SYM in turn. This -is analogous to the Common Lisp `multiple-value-bind' macro, using lists to -simulate true multiple return values. For compatibility, (values A B C) is -a synonym for (list A B C)." nil 'macro) - -(autoload 'multiple-value-setq "cl-macs" "\ -(multiple-value-setq (SYM SYM...) FORM): collect multiple return values. -FORM must return a list; the first N elements of this list are stored in -each of the symbols SYM in turn. This is analogous to the Common Lisp -`multiple-value-setq' macro, using lists to simulate true multiple return -values. For compatibility, (values A B C) is a synonym for (list A B C)." nil 'macro) - -(autoload 'locally "cl-macs" nil nil 'macro) - -(autoload 'the "cl-macs" nil nil 'macro) - -(autoload 'declare "cl-macs" nil nil 'macro) - -(autoload 'define-setf-method "cl-macs" "\ -(define-setf-method NAME ARGLIST BODY...): define a `setf' method. -This method shows how to handle `setf's to places of the form (NAME ARGS...). -The argument forms ARGS are bound according to ARGLIST, as if NAME were -going to be expanded as a macro, then the BODY forms are executed and must -return a list of five elements: a temporary-variables list, a value-forms -list, a store-variables list (of length one), a store-form, and an access- -form. See `defsetf' for a simpler way to define most setf-methods." nil 'macro) - -(autoload 'defsetf "cl-macs" "\ -(defsetf NAME FUNC): define a `setf' method. -This macro is an easy-to-use substitute for `define-setf-method' that works -well for simple place forms. In the simple `defsetf' form, `setf's of -the form (setf (NAME ARGS...) VAL) are transformed to function or macro -calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). -Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). -Here, the above `setf' call is expanded by binding the argument forms ARGS -according to ARGLIST, binding the value form VAL to STORE, then executing -BODY, which must return a Lisp form that does the necessary `setf' operation. -Actually, ARGLIST and STORE may be bound to temporary variables which are -introduced automatically to preserve proper execution order of the arguments. -Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." nil 'macro) - -(autoload 'get-setf-method "cl-macs" "\ -Return a list of five values describing the setf-method for PLACE. -PLACE may be any Lisp form which can appear as the PLACE argument to -a macro like `setf' or `incf'." nil nil) - -(autoload 'setf "cl-macs" "\ -(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. -This is a generalized version of `setq'; the PLACEs may be symbolic -references such as (car x) or (aref x i), as well as plain symbols. -For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). -The return value is the last VAL in the list." nil 'macro) - -(autoload 'psetf "cl-macs" "\ -(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. -This is like `setf', except that all VAL forms are evaluated (in order) -before assigning any PLACEs to the corresponding values." nil 'macro) - -(autoload 'cl-do-pop "cl-macs" nil nil nil) - -(autoload 'remf "cl-macs" "\ -(remf PLACE TAG): remove TAG from property list PLACE. -PLACE may be a symbol, or any generalized variable allowed by `setf'. -The form returns true if TAG was found and removed, nil otherwise." nil 'macro) - -(autoload 'shiftf "cl-macs" "\ -(shiftf PLACE PLACE... VAL): shift left among PLACEs. -Example: (shiftf A B C) sets A to B, B to C, and returns the old A. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'." nil 'macro) - -(autoload 'rotatef "cl-macs" "\ -(rotatef PLACE...): rotate left among PLACEs. -Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'." nil 'macro) - -(autoload 'letf "cl-macs" "\ -(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. -This is the analogue of `let', but with generalized variables (in the -sense of `setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." nil 'macro) - -(autoload 'letf* "cl-macs" "\ -(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. -This is the analogue of `let*', but with generalized variables (in the -sense of `setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." nil 'macro) - -(autoload 'callf "cl-macs" "\ -(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). -FUNC should be an unquoted function name. PLACE may be a symbol, -or any generalized variable allowed by `setf'." nil 'macro) - -(autoload 'callf2 "cl-macs" "\ -(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). -Like `callf', but PLACE is the second argument of FUNC, not the first." nil 'macro) - -(autoload 'define-modify-macro "cl-macs" "\ -(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. -If NAME is called, it combines its PLACE argument with the other arguments -from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" nil 'macro) - -(autoload 'defstruct "cl-macs" "\ -(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. -This macro defines a new Lisp data type called NAME, which contains data -stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' -copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." nil 'macro) - -(autoload 'cl-struct-setf-expander "cl-macs" nil nil nil) - -(autoload 'deftype "cl-macs" "\ -(deftype NAME ARGLIST BODY...): define NAME as a new data type. -The type name can then be used in `typecase', `check-type', etc." nil 'macro) - -(autoload 'typep "cl-macs" "\ -Check that OBJECT is of type TYPE. -TYPE is a Common Lisp-style type specifier." nil nil) - -(autoload 'check-type "cl-macs" "\ -Verify that FORM is of type TYPE; signal an error if not. -STRING is an optional description of the desired type." nil 'macro) - -(autoload 'assert "cl-macs" "\ -Verify that FORM returns non-nil; signal an error if not. -Second arg SHOW-ARGS means to include arguments of FORM in message. -Other args STRING and ARGS... are arguments to be passed to `error'. -They are not evaluated unless the assertion fails. If STRING is -omitted, a default message listing FORM itself is used." nil 'macro) - -(autoload 'ignore-errors "cl-macs" "\ -Execute FORMS; if an error occurs, return nil. -Otherwise, return result of last FORM." nil 'macro) - -(autoload 'ignore-file-errors "cl-macs" "\ -Execute FORMS; if an error of type `file-error' occurs, return nil. -Otherwise, return result of last FORM." nil 'macro) - -(autoload 'define-compiler-macro "cl-macs" "\ -(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. -This is like `defmacro', but macro expansion occurs only if the call to -FUNC is compiled (i.e., not interpreted). Compiler macros should be used -for optimizing the way calls to FUNC are compiled; the form returned by -BODY should do the same thing as a call to the normal function called -FUNC, though possibly more efficiently. Note that, like regular macros, -compiler macros are expanded repeatedly until no further expansions are -possible. Unlike regular macros, BODY can decide to \"punt\" and leave the -original function call alone by declaring an initial `&whole foo' parameter -and then returning foo." nil 'macro) - -(autoload 'compiler-macroexpand "cl-macs" nil nil nil) - -;;;*** - -;;;### (autoloads (batch-remove-old-elc) "cleantree" "lisp/cleantree.el") - -(autoload 'batch-remove-old-elc "cleantree" nil nil nil) - -;;;*** - -;;;### (autoloads (config-value config-value-hash-table) "config" "lisp/config.el") - -(autoload 'config-value-hash-table "config" "\ -Return hash table of configuration parameters and their values." nil nil) - -(autoload 'config-value "config" "\ -Return the value of the configuration parameter CONFIG_SYMBOL." nil nil) - -;;;*** - -;;;### (autoloads (Custom-make-dependencies) "cus-dep" "lisp/cus-dep.el") - -(autoload 'Custom-make-dependencies "cus-dep" "\ -Extract custom dependencies from .el files in SUBDIRS. -SUBDIRS is a list of directories. If it is nil, the command-line -arguments are used. If it is a string, only that directory is -processed. This function is especially useful in batch mode. - -Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" t nil) - -;;;*** - -;;;### (autoloads (customize-menu-create custom-menu-create custom-save-all customize-save-customized customize-browse custom-buffer-create-other-window custom-buffer-create customize-apropos-groups customize-apropos-faces customize-apropos-options customize-apropos customize-saved customize-customized customize-face-other-window customize-face customize-option-other-window customize-changed-options customize-variable customize-other-window customize customize-save-variable customize-set-variable customize-set-value) "cus-edit" "lisp/cus-edit.el") - -(autoload 'customize-set-value "cus-edit" "\ -Set VARIABLE to VALUE. VALUE is a Lisp object. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." t nil) - -(autoload 'customize-set-variable "cus-edit" "\ -Set the default for VARIABLE to VALUE. VALUE is a Lisp object. - -If VARIABLE has a `custom-set' property, that is used for setting -VARIABLE, otherwise `set-default' is used. - -The `customized-value' property of the VARIABLE will be set to a list -with a quoted VALUE as its sole list member. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " t nil) - -(autoload 'customize-save-variable "cus-edit" "\ -Set the default for VARIABLE to VALUE, and save it for future sessions. -If VARIABLE has a `custom-set' property, that is used for setting -VARIABLE, otherwise `set-default' is used. - -The `customized-value' property of the VARIABLE will be set to a list -with a quoted VALUE as its sole list member. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " t nil) - -(autoload 'customize "cus-edit" "\ -Select a customization buffer which you can use to set user options. -User options are structured into \"groups\". -The default group is `Emacs'." t nil) - -(defalias 'customize-group 'customize) - -(autoload 'customize-other-window "cus-edit" "\ -Customize SYMBOL, which must be a customization group." t nil) - -(defalias 'customize-group-other-window 'customize-other-window) - -(defalias 'customize-option 'customize-variable) - -(autoload 'customize-variable "cus-edit" "\ -Customize SYMBOL, which must be a user option variable." t nil) - -(autoload 'customize-changed-options "cus-edit" "\ -Customize all user option variables whose default values changed recently. -This means, in other words, variables defined with a `:version' keyword." t nil) - -(defalias 'customize-variable-other-window 'customize-option-other-window) - -(autoload 'customize-option-other-window "cus-edit" "\ -Customize SYMBOL, which must be a user option variable. -Show the buffer in another window, but don't select it." t nil) - -(autoload 'customize-face "cus-edit" "\ -Customize SYMBOL, which should be a face name or nil. -If SYMBOL is nil, customize all faces." t nil) - -(autoload 'customize-face-other-window "cus-edit" "\ -Show customization buffer for FACE in other window." t nil) - -(autoload 'customize-customized "cus-edit" "\ -Customize all user options set since the last save in this session." t nil) - -(autoload 'customize-saved "cus-edit" "\ -Customize all already saved user options." t nil) - -(autoload 'customize-apropos "cus-edit" "\ -Customize all user options matching REGEXP. -If ALL is `options', include only options. -If ALL is `faces', include only faces. -If ALL is `groups', include only groups. -If ALL is t (interactively, with prefix arg), include options which are not -user-settable, as well as faces and groups." t nil) - -(autoload 'customize-apropos-options "cus-edit" "\ -Customize all user options matching REGEXP. -With prefix arg, include options which are not user-settable." t nil) - -(autoload 'customize-apropos-faces "cus-edit" "\ -Customize all user faces matching REGEXP." t nil) - -(autoload 'customize-apropos-groups "cus-edit" "\ -Customize all user groups matching REGEXP." t nil) - -(autoload 'custom-buffer-create "cus-edit" "\ -Create a buffer containing OPTIONS. -Optional NAME is the name of the buffer. -OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where -SYMBOL is a customization option, and WIDGET is a widget for editing -that option." nil nil) - -(autoload 'custom-buffer-create-other-window "cus-edit" "\ -Create a buffer containing OPTIONS. -Optional NAME is the name of the buffer. -OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where -SYMBOL is a customization option, and WIDGET is a widget for editing -that option." nil nil) - -(autoload 'customize-browse "cus-edit" "\ -Create a tree browser for the customize hierarchy." t nil) - -(defcustom custom-file "~/.emacs" "File used for storing customization information.\nIf you change this from the default \"~/.emacs\" you need to\nexplicitly load that file for the settings to take effect." :type 'file :group 'customize) - -(autoload 'customize-save-customized "cus-edit" "\ -Save all user options which have been set in this session." t nil) - -(autoload 'custom-save-all "cus-edit" "\ -Save all customizations in `custom-file'." nil nil) - -(autoload 'custom-menu-create "cus-edit" "\ -Create menu for customization group SYMBOL. -The menu is in a format applicable to `easy-menu-define'." nil nil) - -(autoload 'customize-menu-create "cus-edit" "\ -Return a customize menu for customization group SYMBOL. -If optional NAME is given, use that as the name of the menu. -Otherwise the menu will be named `Customize'. -The format is suitable for use with `easy-menu-define'." nil nil) - -;;;*** - -;;;### (autoloads (custom-set-faces custom-set-face-update-spec custom-declare-face) "cus-face" "lisp/cus-face.el") - -(autoload 'custom-declare-face "cus-face" "\ -Like `defface', but FACE is evaluated as a normal argument." nil nil) - -(autoload 'custom-set-face-update-spec "cus-face" "\ -Customize the FACE for display types matching DISPLAY, merging - in the new items from PLIST" nil nil) - -(autoload 'custom-set-faces "cus-face" "\ -Initialize faces according to user preferences. -The arguments should be a list where each entry has the form: - - (FACE SPEC [NOW]) - -SPEC will be stored as the saved value for FACE. If NOW is present -and non-nil, FACE will also be created according to SPEC. - -See `defface' for the format of SPEC." nil nil) - -;;;*** - -;;;### (autoloads (disassemble) "disass" "lisp/disass.el") - -(autoload 'disassemble "disass" "\ -Print disassembled code for OBJECT in (optional) BUFFER. -OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). -If OBJECT is not already compiled, we compile it, but do not -redefine OBJECT if it is a symbol." t nil) - -;;;*** - -;;;### (autoloads (standard-display-european standard-display-underline standard-display-graphic standard-display-g1 standard-display-ascii standard-display-default standard-display-8bit make-display-table describe-current-display-table) "disp-table" "lisp/disp-table.el") - -(autoload 'describe-current-display-table "disp-table" "\ -Describe the display table in use in the selected window and buffer." t nil) - -(autoload 'make-display-table "disp-table" "\ -Return a new, empty display table." nil nil) - -(autoload 'standard-display-8bit "disp-table" "\ -Display characters in the range L to H literally." nil nil) - -(autoload 'standard-display-default "disp-table" "\ -Display characters in the range L to H using the default notation." nil nil) - -(autoload 'standard-display-ascii "disp-table" "\ -Display character C using printable string S." nil nil) - -(autoload 'standard-display-g1 "disp-table" "\ -Display character C as character SC in the g1 character set. -This function assumes that your terminal uses the SO/SI characters; -it is meaningless for an X frame." nil nil) - -(autoload 'standard-display-graphic "disp-table" "\ -Display character C as character GC in graphics character set. -This function assumes VT100-compatible escapes; it is meaningless for an -X frame." nil nil) - -(autoload 'standard-display-underline "disp-table" "\ -Display character C as character UC plus underlining." nil nil) - -(autoload 'standard-display-european "disp-table" "\ -Toggle display of European characters encoded with ISO 8859. -When enabled, characters in the range of 160 to 255 display not -as octal escapes, but as accented characters. -With prefix argument, enable European character display iff arg is positive." t nil) - -;;;*** - -;;;### (autoloads nil "easymenu" "lisp/easymenu.el") - -;;;*** - -;;;### (autoloads (pop-tag-mark tags-apropos list-tags tags-query-replace tags-search tags-loop-continue next-file tag-complete-symbol find-tag-other-window find-tag visit-tags-table) "etags" "lisp/etags.el") - -(autoload 'visit-tags-table "etags" "\ -Tell tags commands to use tags table file FILE when all else fails. -FILE should be the name of a file created with the `etags' program. -A directory name is ok too; it means file TAGS in that directory." t nil) - -(autoload 'find-tag "etags" "\ -*Find tag whose name contains TAGNAME. - Selects the buffer that the tag is contained in -and puts point at its definition. - If TAGNAME is a null string, the expression in the buffer -around or before point is used as the tag name. - If called interactively with a numeric argument, searches for the next tag -in the tag table that matches the tagname used in the previous find-tag. - If second arg OTHER-WINDOW is non-nil, uses another window to display -the tag. - -This version of this function supports multiple active tags tables, -and completion. - -Variables of note: - - tag-table-alist controls which tables apply to which buffers - tags-file-name a default tags table - tags-build-completion-table controls completion behavior - buffer-tag-table another way of specifying a buffer-local table - make-tags-files-invisible whether tags tables should be very hidden - tag-mark-stack-max how many tags-based hops to remember" t nil) - -(autoload 'find-tag-other-window "etags" "\ -*Find tag whose name contains TAGNAME. - Selects the buffer that the tag is contained in in another window -and puts point at its definition. - If TAGNAME is a null string, the expression in the buffer -around or before point is used as the tag name. - If second arg NEXT is non-nil (interactively, with prefix arg), -searches for the next tag in the tag table -that matches the tagname used in the previous find-tag. - -This version of this function supports multiple active tags tables, -and completion. - -Variables of note: - - tag-table-alist controls which tables apply to which buffers - tags-file-name a default tags table - tags-build-completion-table controls completion behavior - buffer-tag-table another way of specifying a buffer-local table - make-tags-files-invisible whether tags tables should be very hidden - tag-mark-stack-max how many tags-based hops to remember" t nil) - -(autoload 'tag-complete-symbol "etags" "\ -The function used to do tags-completion (using 'tag-completion-predicate)." t nil) - -(autoload 'next-file "etags" "\ -Select next file among files in current tag table(s). - -A first argument of t (prefix arg, if interactive) initializes to the -beginning of the list of files in the (first) tags table. If the argument -is neither nil nor t, it is evalled to initialize the list of files. - -Non-nil second argument NOVISIT means use a temporary buffer -to save time and avoid uninteresting warnings. - -Value is nil if the file was already visited; -if the file was newly read in, the value is the filename." t nil) - -(autoload 'tags-loop-continue "etags" "\ -Continue last \\[tags-search] or \\[tags-query-replace] command. -Used noninteractively with non-nil argument to begin such a command (the -argument is passed to `next-file', which see). -Two variables control the processing we do on each file: -the value of `tags-loop-scan' is a form to be executed on each file -to see if it is interesting (it returns non-nil if so) -and `tags-loop-operate' is a form to execute to operate on an interesting file -If the latter returns non-nil, we exit; otherwise we scan the next file." t nil) - -(autoload 'tags-search "etags" "\ -Search through all files listed in tags table for match for REGEXP. -Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. - -See documentation of variable `tag-table-alist'." t nil) - -(autoload 'tags-query-replace "etags" "\ -Query-replace-regexp FROM with TO through all files listed in tags table. -Third arg DELIMITED (prefix arg) means replace only word-delimited matches. -If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace -with the command \\[tags-loop-continue]. - -See documentation of variable `tag-table-alist'." t nil) - -(autoload 'list-tags "etags" "\ -Display list of tags in FILE." t nil) - -(autoload 'tags-apropos "etags" "\ -Display list of all tags in tag table REGEXP matches." t nil) -(define-key esc-map "*" 'pop-tag-mark) - -(autoload 'pop-tag-mark "etags" "\ -Go to last tag position. -`find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack. -This function pops (and moves to) the tag at the top of this stack." t nil) - -;;;*** - -;;;### (autoloads (finder-by-keyword) "finder" "lisp/finder.el") - -(autoload 'finder-by-keyword "finder" "\ -Find packages matching a given keyword." t nil) - -;;;*** - -;;;### (autoloads (font-lock-set-defaults-1 font-lock-fontify-buffer turn-off-font-lock turn-on-font-lock font-lock-mode) "font-lock" "lisp/font-lock.el") - -(defcustom font-lock-auto-fontify t "*Whether font-lock should automatically fontify files as they're loaded.\nThis will only happen if font-lock has fontifying keywords for the major\nmode of the file. You can get finer-grained control over auto-fontification\nby using this variable in combination with `font-lock-mode-enable-list' or\n`font-lock-mode-disable-list'." :type 'boolean :group 'font-lock) - -(defcustom font-lock-mode-enable-list nil "*List of modes to auto-fontify, if `font-lock-auto-fontify' is nil." :type '(repeat (symbol :tag "Mode")) :group 'font-lock) - -(defcustom font-lock-mode-disable-list nil "*List of modes not to auto-fontify, if `font-lock-auto-fontify' is t." :type '(repeat (symbol :tag "Mode")) :group 'font-lock) - -(defcustom font-lock-use-colors '(color) "*Specification for when Font Lock will set up color defaults.\nNormally this should be '(color), meaning that Font Lock will set up\ncolor defaults that are only used on color displays. Set this to nil\nif you don't want Font Lock to set up color defaults at all. This\nshould be one of\n\n-- a list of valid tags, meaning that the color defaults will be used\n when all of the tags apply. (e.g. '(color x))\n-- a list whose first element is 'or and whose remaining elements are\n lists of valid tags, meaning that the defaults will be used when\n any of the tag lists apply.\n-- nil, meaning that the defaults should not be set up at all.\n\n(If you specify face values in your init file, they will override any\nthat Font Lock specifies, regardless of whether you specify the face\nvalues before or after loading Font Lock.)\n\nSee also `font-lock-use-fonts'. If you want more control over the faces\nused for fontification, see the documentation of `font-lock-mode' for\nhow to do it." :type 'sexp :group 'font-lock) - -(defcustom font-lock-use-fonts '(or (mono) (grayscale)) "*Specification for when Font Lock will set up non-color defaults.\n\nNormally this should be '(or (mono) (grayscale)), meaning that Font\nLock will set up non-color defaults that are only used on either mono\nor grayscale displays. Set this to nil if you don't want Font Lock to\nset up non-color defaults at all. This should be one of\n\n-- a list of valid tags, meaning that the non-color defaults will be used\n when all of the tags apply. (e.g. '(grayscale x))\n-- a list whose first element is 'or and whose remaining elements are\n lists of valid tags, meaning that the defaults will be used when\n any of the tag lists apply.\n-- nil, meaning that the defaults should not be set up at all.\n\n(If you specify face values in your init file, they will override any\nthat Font Lock specifies, regardless of whether you specify the face\nvalues before or after loading Font Lock.)\n\nSee also `font-lock-use-colors'. If you want more control over the faces\nused for fontification, see the documentation of `font-lock-mode' for\nhow to do it." :type 'sexp :group 'font-lock) - -(defcustom font-lock-maximum-decoration t "*If non-nil, the maximum decoration level for fontifying.\nIf nil, use the minimum decoration (equivalent to level 0).\nIf t, use the maximum decoration available.\nIf a number, use that level of decoration (or if not available the maximum).\nIf a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),\nwhere MAJOR-MODE is a symbol or t (meaning the default). For example:\n ((c++-mode . 2) (c-mode . t) (t . 1))\nmeans use level 2 decoration for buffers in `c++-mode', the maximum decoration\navailable for buffers in `c-mode', and level 1 decoration otherwise." :type '(choice (const :tag "default" nil) (const :tag "maximum" t) (integer :tag "level" 1) (repeat :menu-tag "mode specific" :tag "mode specific" :value ((t . t)) (cons :tag "Instance" (radio :tag "Mode" (const :tag "all" t) (symbol :tag "name")) (radio :tag "Decoration" (const :tag "default" nil) (const :tag "maximum" t) (integer :tag "level" 1))))) :group 'font-lock) - -(define-obsolete-variable-alias 'font-lock-use-maximal-decoration 'font-lock-maximum-decoration) - -(defcustom font-lock-maximum-size (* 250 1024) "*If non-nil, the maximum size for buffers for fontifying.\nOnly buffers less than this can be fontified when Font Lock mode is turned on.\nIf nil, means size is irrelevant.\nIf a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),\nwhere MAJOR-MODE is a symbol or t (meaning the default). For example:\n ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576))\nmeans that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one\nmegabyte for buffers in `rmail-mode', and size is irrelevant otherwise." :type '(choice (const :tag "none" nil) (integer :tag "size") (repeat :menu-tag "mode specific" :tag "mode specific" :value ((t)) (cons :tag "Instance" (radio :tag "Mode" (const :tag "all" t) (symbol :tag "name")) (radio :tag "Size" (const :tag "none" nil) (integer :tag "size"))))) :group 'font-lock) - -(defvar font-lock-keywords nil "\ -A list of the keywords to highlight. -Each element should be of the form: - - MATCHER - (MATCHER . MATCH) - (MATCHER . FACENAME) - (MATCHER . HIGHLIGHT) - (MATCHER HIGHLIGHT ...) - (eval . FORM) - -where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. - -FORM is an expression, whose value should be a keyword element, -evaluated when the keyword is (first) used in a buffer. This feature -can be used to provide a keyword that can only be generated when Font -Lock mode is actually turned on. - -For highlighting single items, typically only MATCH-HIGHLIGHT is required. -However, if an item or (typically) items is to be highlighted following the -instance of another item (the anchor) then MATCH-ANCHORED may be required. - -MATCH-HIGHLIGHT should be of the form: - - (MATCH FACENAME OVERRIDE LAXMATCH) - -Where MATCHER can be either the regexp to search for, a variable -containing the regexp to search for, or the function to call to make -the search (called with one argument, the limit of the search). MATCH -is the subexpression of MATCHER to be highlighted. FACENAME is either -a symbol naming a face, or an expression whose value is the face name -to use. If you want FACENAME to be a symbol that evaluates to a face, -use a form like \"(progn sym)\". - -OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may -be overwritten. If `keep', only parts not already fontified are highlighted. -If `prepend' or `append', existing fontification is merged with the new, in -which the new or existing fontification, respectively, takes precedence. -If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. - -For example, an element of the form highlights (if not already highlighted): - - \"\\\\\\=\" Discrete occurrences of \"foo\" in the value of the - variable `font-lock-keyword-face'. - (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in - the value of `font-lock-keyword-face'. - (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. - (\"foo\\\\|bar\" 0 foo-bar-face t) - Occurrences of either \"foo\" or \"bar\" in the value - of `foo-bar-face', even if already highlighted. - -MATCH-ANCHORED should be of the form: - - (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) - -Where MATCHER is as for MATCH-HIGHLIGHT with one exception; see below. -PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after -the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be -used to initialize before, and cleanup after, MATCHER is used. Typically, -PRE-MATCH-FORM is used to move to some position relative to the original -MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might -be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. - -For example, an element of the form highlights (if not already highlighted): - - (\"\\\\\\=\" (0 anchor-face) (\"\\\\\\=\" nil nil (0 item-face))) - - Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent - discrete occurrences of \"item\" (on the same line) in the value of `item-face'. - (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is - initially searched for starting from the end of the match of \"anchor\", and - searching for subsequent instance of \"anchor\" resumes from where searching - for \"item\" concluded.) - -The above-mentioned exception is as follows. The limit of the MATCHER search -defaults to the end of the line after PRE-MATCH-FORM is evaluated. -However, if PRE-MATCH-FORM returns a position greater than the position after -PRE-MATCH-FORM is evaluated, that position is used as the limit of the search. -It is generally a bad idea to return a position greater than the end of the -line, i.e., cause the MATCHER search to span lines. - -Note that the MATCH-ANCHORED feature is experimental; in the future, we may -replace it with other ways of providing this functionality. - -These regular expressions should not match text which spans lines. While -\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating -when you edit the buffer does not, since it considers text one line at a time. - -Be very careful composing regexps for this list; -the wrong pattern can dramatically slow things down!") - -(make-variable-buffer-local 'font-lock-keywords) - -(defcustom font-lock-mode nil "Non nil means `font-lock-mode' is on" :group 'font-lock :type 'boolean :initialize 'custom-initialize-default :require 'font-lock :set (function (lambda (var val) (font-lock-mode (or val 0))))) - -(defvar font-lock-mode-hook nil "\ -Function or functions to run on entry to font-lock-mode.") - -(autoload 'font-lock-mode "font-lock" "\ -Toggle Font Lock Mode. -With arg, turn font-lock mode on if and only if arg is positive. - -When Font Lock mode is enabled, text is fontified as you type it: - - - Comments are displayed in `font-lock-comment-face'; - - Strings are displayed in `font-lock-string-face'; - - Documentation strings (in Lisp-like languages) are displayed in - `font-lock-doc-string-face'; - - Language keywords (\"reserved words\") are displayed in - `font-lock-keyword-face'; - - Function names in their defining form are displayed in - `font-lock-function-name-face'; - - Variable names in their defining form are displayed in - `font-lock-variable-name-face'; - - Type names are displayed in `font-lock-type-face'; - - References appearing in help files and the like are displayed - in `font-lock-reference-face'; - - Preprocessor declarations are displayed in - `font-lock-preprocessor-face'; - - and - - - Certain other expressions are displayed in other faces according - to the value of the variable `font-lock-keywords'. - -Where modes support different levels of fontification, you can use the variable -`font-lock-maximum-decoration' to specify which level you generally prefer. -When you turn Font Lock mode on/off the buffer is fontified/defontified, though -fontification occurs only if the buffer is less than `font-lock-maximum-size'. -To fontify a buffer without turning on Font Lock mode, and regardless of buffer -size, you can use \\[font-lock-fontify-buffer]. - -See the variable `font-lock-keywords' for customization." t nil) - -(autoload 'turn-on-font-lock "font-lock" "\ -Unconditionally turn on Font Lock mode." nil nil) - -(autoload 'turn-off-font-lock "font-lock" "\ -Unconditionally turn off Font Lock mode." nil nil) - -(autoload 'font-lock-fontify-buffer "font-lock" "\ -Fontify the current buffer the way `font-lock-mode' would. -See `font-lock-mode' for details. - -This can take a while for large buffers." t nil) - -(autoload 'font-lock-set-defaults-1 "font-lock" nil nil nil) - -(add-minor-mode 'font-lock-mode " Font") - -;;;*** - -;;;### (autoloads (x-font-build-cache font-default-size-for-device font-default-encoding-for-device font-default-registry-for-device font-default-family-for-device font-default-object-for-device font-default-font-for-device font-create-object) "font" "lisp/font.el") - -(autoload 'font-create-object "font" nil nil nil) - -(autoload 'font-default-font-for-device "font" nil nil nil) - -(autoload 'font-default-object-for-device "font" nil nil nil) - -(autoload 'font-default-family-for-device "font" nil nil nil) - -(autoload 'font-default-registry-for-device "font" nil nil nil) - -(autoload 'font-default-encoding-for-device "font" nil nil nil) - -(autoload 'font-default-size-for-device "font" nil nil nil) - -(autoload 'x-font-build-cache "font" nil nil nil) - -;;;*** - -;;;### (autoloads (gnuserv-start gnuserv-running-p) "gnuserv" "lisp/gnuserv.el") - -(defcustom gnuserv-frame nil "*The frame to be used to display all edited files.\nIf nil, then a new frame is created for each file edited.\nIf t, then the currently selected frame will be used.\nIf a function, then this will be called with a symbol `x' or `tty' as the\nonly argument, and its return value will be interpreted as above." :tag "Gnuserv Frame" :type '(radio (const :tag "Create new frame each time" nil) (const :tag "Use selected frame" t) (function-item :tag "Use main Emacs frame" gnuserv-main-frame-function) (function-item :tag "Use visible frame, otherwise create new" gnuserv-visible-frame-function) (function-item :tag "Create special Gnuserv frame and use it" gnuserv-special-frame-function) (function :tag "Other")) :group 'gnuserv :group 'frames) - -(autoload 'gnuserv-running-p "gnuserv" "\ -Return non-nil if a gnuserv process is running from this XEmacs session." nil nil) - -(autoload 'gnuserv-start "gnuserv" "\ -Allow this Emacs process to be a server for client processes. -This starts a gnuserv communications subprocess through which -client \"editors\" (gnuclient and gnudoit) can send editing commands to -this Emacs job. See the gnuserv(1) manual page for more details. - -Prefix arg means just kill any existing server communications subprocess." t nil) - -;;;*** - -;;;### (autoloads nil "help-macro" "lisp/help-macro.el") - -(defcustom three-step-help t "*Non-nil means give more info about Help command in three steps.\nThe three steps are simple prompt, prompt with all options,\nand window listing and describing the options.\nA value of nil means skip the middle step, so that\n\\[help-command] \\[help-command] gives the window that lists the options." :type 'boolean :group 'help-appearance) - -;;;*** - -;;;### (autoloads (hyper-apropos-popup-menu hyper-apropos-set-variable hyper-set-variable hyper-apropos-read-variable-symbol hyper-describe-function hyper-where-is hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos) "hyper-apropos" "lisp/hyper-apropos.el") - -(autoload 'hyper-apropos "hyper-apropos" "\ -Display lists of functions and variables matching REGEXP -in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the -value of `hyper-apropos-programming-apropos' is toggled for this search. -See also `hyper-apropos-mode'." t nil) - -(autoload 'hyper-describe-key "hyper-apropos" nil t nil) - -(autoload 'hyper-describe-key-briefly "hyper-apropos" nil t nil) - -(autoload 'hyper-describe-face "hyper-apropos" "\ -Describe face.. -See also `hyper-apropos' and `hyper-describe-function'." t nil) - -(autoload 'hyper-describe-variable "hyper-apropos" "\ -Hypertext drop-in replacement for `describe-variable'. -See also `hyper-apropos' and `hyper-describe-function'." t nil) - -(autoload 'hyper-where-is "hyper-apropos" "\ -Print message listing key sequences that invoke specified command." t nil) - -(autoload 'hyper-describe-function "hyper-apropos" "\ -Hypertext replacement for `describe-function'. Unlike `describe-function' -in that the symbol under the cursor is the default if it is a function. -See also `hyper-apropos' and `hyper-describe-variable'." t nil) - -(autoload 'hyper-apropos-read-variable-symbol "hyper-apropos" "\ -Hypertext drop-in replacement for `describe-variable'. -See also `hyper-apropos' and `hyper-describe-function'." nil nil) - -(define-obsolete-function-alias 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol) - -(define-obsolete-function-alias 'hypropos-get-doc 'hyper-apropos-get-doc) - -(autoload 'hyper-set-variable "hyper-apropos" nil t nil) - -(autoload 'hyper-apropos-set-variable "hyper-apropos" "\ -Interactively set the variable on the current line." t nil) - -(define-obsolete-function-alias 'hypropos-set-variable 'hyper-apropos-set-variable) - -(autoload 'hyper-apropos-popup-menu "hyper-apropos" nil t nil) - -(define-obsolete-function-alias 'hypropos-popup-menu 'hyper-apropos-popup-menu) - -;;;*** - -;;;### (autoloads (Info-elisp-ref Info-emacs-key Info-goto-emacs-key-command-node Info-goto-emacs-command-node Info-emacs-command Info-search Info-visit-file Info-goto-node Info-batch-rebuild-dir Info-query info) "info" "lisp/info.el") - -(defvar Info-directory-list nil "\ -List of directories to search for Info documentation files. - -The first directory in this list, the \"dir\" file there will become -the (dir)Top node of the Info documentation tree. If you wish to -modify the info search path, use `M-x customize-variable, -Info-directory-list' to do so.") - -(autoload 'info "info" "\ -Enter Info, the documentation browser. -Optional argument FILE specifies the file to examine; -the default is the top-level directory of Info. - -In interactive use, a prefix argument directs this command -to read a file name from the minibuffer." t nil) - -(autoload 'Info-query "info" "\ -Enter Info, the documentation browser. Prompt for name of Info file." t nil) - -(autoload 'Info-batch-rebuild-dir "info" "\ -(Re)build info `dir' files in the directories remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -Each file is processed even if an error occurred previously. -For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\"" nil nil) - -(autoload 'Info-goto-node "info" "\ -Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME. -Actually, the following interpretations of NAME are tried in order: - (FILENAME)NODENAME - (FILENAME) (using Top node) - NODENAME (in current file) - TAGNAME (see below) - FILENAME (using Top node) -where TAGNAME is a string that appears in quotes: \"TAGNAME\", in an -annotation for any node of any file. (See `a' and `x' commands.)" t nil) - -(autoload 'Info-visit-file "info" "\ -Directly visit an info file." t nil) - -(autoload 'Info-search "info" "\ -Search for REGEXP, starting from point, and select node it's found in." t nil) - -(autoload 'Info-emacs-command "info" "\ -Look up an Emacs command in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." t nil) - -(autoload 'Info-goto-emacs-command-node "info" "\ -Look up an Emacs command in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." t nil) - -(autoload 'Info-goto-emacs-key-command-node "info" "\ -Look up an Emacs key sequence in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." t nil) - -(autoload 'Info-emacs-key "info" "\ -Look up an Emacs key sequence in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." t nil) - -(autoload 'Info-elisp-ref "info" "\ -Look up an Emacs Lisp function in the Elisp manual in the Info system. -This command is designed to be used whether you are already in Info or not." t nil) - -;;;*** - -;;;### (autoloads nil "itimer-autosave" "lisp/itimer-autosave.el") - -;;;*** - -;;;### (autoloads nil "loaddefs" "lisp/loaddefs.el") - -;;;*** - -;;;### (autoloads nil "loadhist" "lisp/loadhist.el") - -;;;*** - -;;;### (autoloads (mwheel-install) "mwheel" "lisp/mwheel.el") - -(autoload 'mwheel-install "mwheel" "\ -Enable mouse wheel support." nil nil) - -;;;*** - -;;;### (autoloads (package-admin-add-binary-package package-admin-add-single-file-package) "package-admin" "lisp/package-admin.el") - -(autoload 'package-admin-add-single-file-package "package-admin" "\ -Install a single file Lisp package into XEmacs package hierarchy. -`file' should be the full path to the lisp file to install. -`destdir' should be a simple directory name. -The optional `pkg-dir' can be used to override the default package hierarchy -\(car (last late-packages))." t nil) - -(autoload 'package-admin-add-binary-package "package-admin" "\ -Install a pre-bytecompiled XEmacs package into package hierarchy." t nil) - -;;;*** - -;;;### (autoloads (package-get-custom package-get-package-provider package-get package-get-dependencies package-get-all package-get-update-all package-get-delete-package package-get-save-base package-get-update-base-from-buffer package-get-update-base package-get-update-base-entry package-get-require-base package-get-download-menu) "package-get" "lisp/package-get.el") - -(autoload 'package-get-download-menu "package-get" "\ -Build the `Add Download Site' menu." nil nil) - -(autoload 'package-get-require-base "package-get" "\ -Require that a package-get database has been loaded. -If the optional FORCE-CURRENT argument or the value of -`package-get-always-update' is Non-nil, try to update the database -from a location in `package-get-remote'. Otherwise a local copy is used -if available and remote access is never done. - -Please use FORCE-CURRENT only when the user is explictly dealing with packages -and remote access is likely in the near future." nil nil) - -(autoload 'package-get-update-base-entry "package-get" "\ -Update an entry in `package-get-base'." nil nil) - -(autoload 'package-get-update-base "package-get" "\ -Update the package-get database file with entries from DB-FILE. -Unless FORCE-CURRENT is non-nil never try to update the database." t nil) - -(autoload 'package-get-update-base-from-buffer "package-get" "\ -Update the package-get database with entries from BUFFER. -BUFFER defaults to the current buffer. This command can be -used interactively, for example from a mail or news buffer." t nil) - -(autoload 'package-get-save-base "package-get" "\ -Write the package-get database to FILE. - -Note: This database will be unsigned of course." t nil) - -(autoload 'package-get-delete-package "package-get" "\ -Delete an installation of PACKAGE below directory PKG-TOPDIR. -PACKAGE is a symbol, not a string. -This is just an interactive wrapper for `package-admin-delete-binary-package'." t nil) - -(autoload 'package-get-update-all "package-get" "\ -Fetch and install the latest versions of all currently installed packages." t nil) - -(autoload 'package-get-all "package-get" "\ -Fetch PACKAGE with VERSION and all other required packages. -Uses `package-get-base' to determine just what is required and what -package provides that functionality. If VERSION is nil, retrieves -latest version. Optional argument FETCHED-PACKAGES is used to keep -track of packages already fetched. Optional argument INSTALL-DIR, -if non-nil, specifies the package directory where fetched packages -should be installed. - -Returns nil upon error." t nil) - -(autoload 'package-get-dependencies "package-get" "\ -Compute dependencies for PACKAGES. -Uses `package-get-base' to determine just what is required and what -package provides that functionality. Returns the list of packages -required by PACKAGES." nil nil) - -(autoload 'package-get "package-get" "\ -Fetch PACKAGE from remote site. -Optional arguments VERSION indicates which version to retrieve, nil -means most recent version. CONFLICT indicates what happens if the -package is already installed. Valid values for CONFLICT are: -'always always retrieve the package even if it is already installed -'never do not retrieve the package if it is installed. -INSTALL-DIR, if non-nil, specifies the package directory where -fetched packages should be installed. - -The value of `package-get-base' is used to determine what files should -be retrieved. The value of `package-get-remote' is used to determine -where a package should be retrieved from. The sites are tried in -order so one is better off listing easily reached sites first. - -Once the package is retrieved, its md5 checksum is computed. If that -sum does not match that stored in `package-get-base' for this version -of the package, an error is signalled. - -Returns `t' upon success, the symbol `error' if the package was -successfully installed but errors occurred during initialization, or -`nil' upon error." t nil) - -(autoload 'package-get-package-provider "package-get" "\ -Search for a package that provides SYM and return the name and - version. Searches in `package-get-base' for SYM. If SYM is a - consp, then it must match a corresponding (provide (SYM VERSION)) from - the package. - -If FORCE-CURRENT is non-nil make sure the database is up to date. This might -lead to Emacs accessing remote sites." t nil) - -(autoload 'package-get-custom "package-get" "\ -Fetch and install the latest versions of all customized packages." t nil) - -;;;*** - -;;;### (autoloads (pui-list-packages pui-add-install-directory package-ui-add-site) "package-ui" "lisp/package-ui.el") - -(autoload 'package-ui-add-site "package-ui" "\ -Add site to package-get-remote and possibly offer to update package list." nil nil) - -(autoload 'pui-add-install-directory "package-ui" "\ -Add a new package binary directory to the head of `package-get-remote'. -Note that no provision is made for saving any changes made by this function. -It exists mainly as a convenience for one-time package installations from -disk." t nil) - -(autoload 'pui-list-packages "package-ui" "\ -List all packages and package information. -The package name, version, and description are displayed. From the displayed -buffer, the user can see which packages are installed, which are not, and -which are out-of-date (a newer version is available). The user can then -select packages for installation via the keyboard or mouse." t nil) - -(defalias 'list-packages 'pui-list-packages) - -;;;*** - -;;;### (autoloads (picture-mode) "picture" "lisp/picture.el") - -(autoload 'picture-mode "picture" "\ -Switch to Picture mode, in which a quarter-plane screen model is used. -Printing characters replace instead of inserting themselves with motion -afterwards settable by these commands: - C-c < Move left after insertion. - C-c > Move right after insertion. - C-c ^ Move up after insertion. - C-c . Move down after insertion. - C-c ` Move northwest (nw) after insertion. - C-c ' Move northeast (ne) after insertion. - C-c / Move southwest (sw) after insertion. - C-c \\ Move southeast (se) after insertion. -The current direction is displayed in the modeline. The initial -direction is right. Whitespace is inserted and tabs are changed to -spaces when required by movement. You can move around in the buffer -with these commands: - \\[picture-move-down] Move vertically to SAME column in previous line. - \\[picture-move-up] Move vertically to SAME column in next line. - \\[picture-end-of-line] Move to column following last non-whitespace character. - \\[picture-forward-column] Move right inserting spaces if required. - \\[picture-backward-column] Move left changing tabs to spaces if required. - C-c C-f Move in direction of current picture motion. - C-c C-b Move in opposite direction of current picture motion. - Return Move to beginning of next line. -You can edit tabular text with these commands: - M-Tab Move to column beneath (or at) next interesting character. - `Indents' relative to a previous line. - Tab Move to next stop in tab stop list. - C-c Tab Set tab stops according to context of this line. - With ARG resets tab stops to default (global) value. - See also documentation of variable picture-tab-chars - which defines \"interesting character\". You can manually - change the tab stop list with command \\[edit-tab-stops]. -You can manipulate text with these commands: - C-d Clear (replace) ARG columns after point without moving. - C-c C-d Delete char at point - the command normally assigned to C-d. - \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them. - \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared - text is saved in the kill ring. - \\[picture-open-line] Open blank line(s) beneath current line. -You can manipulate rectangles with these commands: - C-c C-k Clear (or kill) a rectangle and save it. - C-c C-w Like C-c C-k except rectangle is saved in named register. - C-c C-y Overlay (or insert) currently saved rectangle at point. - C-c C-x Like C-c C-y except rectangle is taken from named register. - \\[copy-rectangle-to-register] Copies a rectangle to a register. - \\[advertised-undo] Can undo effects of rectangle overlay commands - commands if invoked soon enough. -You can return to the previous mode with: - C-c C-c Which also strips trailing whitespace from every line. - Stripping is suppressed by supplying an argument. - -Entry to this mode calls the value of picture-mode-hook if non-nil. - -Note that Picture mode commands will work outside of Picture mode, but -they are not defaultly assigned to keys." t nil) - -(defalias 'edit-picture 'picture-mode) - -;;;*** - -;;;### (autoloads (clear-rectangle string-rectangle open-rectangle insert-rectangle yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle delete-rectangle) "rect" "lisp/rect.el") - -(autoload 'delete-rectangle "rect" "\ -Delete (don't save) text in rectangle with point and mark as corners. -The same range of columns is deleted in each line starting with the line -where the region begins and ending with the line where the region ends." t nil) - -(autoload 'delete-extract-rectangle "rect" "\ -Delete contents of rectangle and return it as a list of strings. -Arguments START and END are the corners of the rectangle. -The value is list of strings, one for each line of the rectangle." nil nil) - -(autoload 'extract-rectangle "rect" "\ -Return contents of rectangle with corners at START and END. -Value is list of strings, one for each line of the rectangle." nil nil) - -(defvar killed-rectangle nil "\ -Rectangle for yank-rectangle to insert.") - -(autoload 'kill-rectangle "rect" "\ -Delete rectangle with corners at point and mark; save as last killed one. -Calling from program, supply two args START and END, buffer positions. -But in programs you might prefer to use `delete-extract-rectangle'." t nil) - -(autoload 'yank-rectangle "rect" "\ -Yank the last killed rectangle with upper left corner at point." t nil) - -(autoload 'insert-rectangle "rect" "\ -Insert text of RECTANGLE with upper left corner at point. -RECTANGLE's first line is inserted at point, its second -line is inserted at a point vertically under point, etc. -RECTANGLE should be a list of strings. -After this command, the mark is at the upper left corner -and point is at the lower right corner." nil nil) - -(autoload 'open-rectangle "rect" "\ -Blank out rectangle with corners at point and mark, shifting text right. -The text previously in the region is not overwritten by the blanks, -but instead winds up to the right of the rectangle." t nil) - -(autoload 'string-rectangle "rect" "\ -Insert STRING on each line of the region-rectangle, shifting text right. -The left edge of the rectangle specifies the column for insertion. -This command does not delete or overwrite any existing text. - -Called from a program, takes three args; START, END and STRING." t nil) - -(autoload 'clear-rectangle "rect" "\ -Blank out rectangle with corners at point and mark. -The text previously in the region is overwritten by the blanks. -When called from a program, requires two args which specify the corners." t nil) - -;;;*** - -;;;### (autoloads (list-load-path-shadows) "shadow" "lisp/shadow.el") - -(autoload 'list-load-path-shadows "shadow" "\ -Display a list of Emacs Lisp files that shadow other files. - -This function lists potential load-path problems. Directories in the -`load-path' variable are searched, in order, for Emacs Lisp -files. When a previously encountered file name is found again, a -message is displayed indicating that the later file is \"hidden\" by -the earlier. - -For example, suppose `load-path' is set to - -\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\") - -and that each of these directories contains a file called XXX.el. Then -XXX.el in the site-lisp directory is referred to by all of: -\(require 'XXX), (autoload .... \"XXX\"), (load-library \"XXX\") etc. - -The first XXX.el file prevents emacs from seeing the second (unless -the second is loaded explicitly via load-file). - -When not intended, such shadowings can be the source of subtle -problems. For example, the above situation may have arisen because the -XXX package was not distributed with versions of emacs prior to -19.30. An emacs maintainer downloaded XXX from elsewhere and installed -it. Later, XXX was updated and included in the emacs distribution. -Unless the emacs maintainer checks for this, the new version of XXX -will be hidden behind the old (which may no longer work with the new -emacs version). - -This function performs these checks and flags all possible -shadowings. Because a .el file may exist without a corresponding .elc -\(or vice-versa), these suffixes are essentially ignored. A file -XXX.elc in an early directory (that does not contain XXX.el) is -considered to shadow a later file XXX.el, and vice-versa. - -When run interactively, the shadowings (if any) are displayed in a -buffer called `*Shadows*'. Shadowings are located by calling the -\(non-interactive) companion function, `find-emacs-lisp-shadows'." t nil) - -;;;*** - -;;;### (autoloads (load-default-sounds load-sound-file) "sound" "lisp/sound.el") - -(or sound-alist (setq sound-alist '((ready nil) (warp nil)))) - -(autoload 'load-sound-file "sound" "\ -Read in an audio-file and add it to the sound-alist. - -You can only play sound files if you are running on display 0 of the -console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in. - -The sound file must be in the Sun/NeXT U-LAW format, except on Linux, -where .wav files are also supported by the sound card drivers." t nil) - -(autoload 'load-default-sounds "sound" "\ -Load and install some sound files as beep-types, using -`load-sound-file'. This only works if you're on display 0 of the -console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in." t nil) - -;;;*** - -;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "lisp/userlock.el") - -(autoload 'ask-user-about-lock "userlock" "\ -Ask user what to do when he wants to edit FILE but it is locked by USER. -This function has a choice of three things to do: - do (signal 'file-locked (list FILE USER)) - to refrain from editing the file - return t (grab the lock on the file) - return nil (edit the file even though it is locked). -You can rewrite it to use any criterion you like to choose which one to do." nil nil) - -(autoload 'ask-user-about-supersession-threat "userlock" "\ -Ask a user who is about to modify an obsolete buffer what to do. -This function has two choices: it can return, in which case the modification -of the buffer will proceed, or it can (signal 'file-supersession (file)), -in which case the proposed buffer modification will not be made. - -You can rewrite this to use any criterion you like to choose which one to do. -The buffer in question is current when this function is called." nil nil) - -;;;*** - -;;;### (autoloads (auto-view-mode view-major-mode view-mode view-minor-mode view-buffer-other-window view-file-other-window view-buffer view-file) "view-less" "lisp/view-less.el") - -(defvar view-minor-mode-map (let ((map (make-keymap))) (set-keymap-name map 'view-minor-mode-map) (suppress-keymap map) (define-key map "-" 'negative-argument) (define-key map " " 'scroll-up) (define-key map "f" 'scroll-up) (define-key map "b" 'scroll-down) (define-key map 'backspace 'scroll-down) (define-key map 'delete 'scroll-down) (define-key map " " 'view-scroll-lines-up) (define-key map "\n" 'view-scroll-lines-up) (define-key map "e" 'view-scroll-lines-up) (define-key map "j" 'view-scroll-lines-up) (define-key map "y" 'view-scroll-lines-down) (define-key map "k" 'view-scroll-lines-down) (define-key map "d" 'view-scroll-some-lines-up) (define-key map "u" 'view-scroll-some-lines-down) (define-key map "r" 'recenter) (define-key map "t" 'toggle-truncate-lines) (define-key map "N" 'view-buffer) (define-key map "E" 'view-file) (define-key map "P" 'view-buffer) (define-key map "!" 'shell-command) (define-key map "|" 'shell-command-on-region) (define-key map "=" 'what-line) (define-key map "?" 'view-search-backward) (define-key map "h" 'view-mode-describe) (define-key map "s" 'view-repeat-search) (define-key map "n" 'view-repeat-search) (define-key map "/" 'view-search-forward) (define-key map "\\" 'view-search-backward) (define-key map "g" 'view-goto-line) (define-key map "G" 'view-last-windowful) (define-key map "%" 'view-goto-percent) (define-key map "p" 'view-goto-percent) (define-key map "m" 'point-to-register) (define-key map "'" 'register-to-point) (define-key map "C" 'view-cleanup-backspaces) (define-key map "" 'view-quit) (define-key map "" 'view-quit-toggle-ro) (define-key map "q" 'view-quit) map)) - -(defvar view-mode-map (let ((map (copy-keymap view-minor-mode-map))) (set-keymap-name map 'view-mode-map) map)) - -(autoload 'view-file "view-less" "\ -Find FILE, enter view mode. With prefix arg OTHER-P, use other window." t nil) - -(autoload 'view-buffer "view-less" "\ -Switch to BUF, enter view mode. With prefix arg use other window." t nil) - -(autoload 'view-file-other-window "view-less" "\ -Find FILE in other window, and enter view mode." t nil) - -(autoload 'view-buffer-other-window "view-less" "\ -Switch to BUFFER in another window, and enter view mode." t nil) - -(autoload 'view-minor-mode "view-less" "\ -Minor mode for viewing text, with bindings like `less'. -Commands are: -\\ -0..9 prefix args -- prefix minus -\\[scroll-up] page forward -\\[scroll-down] page back -\\[view-scroll-lines-up] scroll prefix-arg lines forward, default 1. -\\[view-scroll-lines-down] scroll prefix-arg lines backward, default 1. -\\[view-scroll-some-lines-down] scroll prefix-arg lines backward, default 10. -\\[view-scroll-some-lines-up] scroll prefix-arg lines forward, default 10. -\\[what-line] print line number -\\[view-mode-describe] print this help message -\\[view-search-forward] regexp search, uses previous string if you just hit RET -\\[view-search-backward] as above but searches backward -\\[view-repeat-search] repeat last search -\\[view-goto-line] goto line prefix-arg, default 1 -\\[view-last-windowful] goto line prefix-arg, default last line -\\[view-goto-percent] goto a position by percentage -\\[toggle-truncate-lines] toggle truncate-lines -\\[view-file] view another file -\\[view-buffer] view another buffer -\\[view-cleanup-backspaces] cleanup backspace constructions -\\[shell-command] execute a shell command -\\[shell-command-on-region] execute a shell command with the region as input -\\[view-quit] exit view-mode, and bury the current buffer. - -If invoked with the optional (prefix) arg non-nil, view-mode cleans up -backspace constructions. - -More precisely: -\\{view-minor-mode-map}" t nil) - -(autoload 'view-mode "view-less" "\ -View the current buffer using view-minor-mode. This exists to be 99.9% -compatible with the implementations of `view-mode' in view.el and older -versions of view-less.el." t nil) - -(autoload 'view-major-mode "view-less" "\ -View the current buffer using view-mode, as a major mode. -This function has a nonstandard name because `view-mode' is wrongly -named but is like this for compatibility reasons." t nil) - -(autoload 'auto-view-mode "view-less" "\ -If the file of the current buffer is not writable, call view-mode. -This is meant to be added to `find-file-hooks'." nil nil) - -;;;*** - -;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse widget-browse-at) "wid-browse" "lisp/wid-browse.el") - -(autoload 'widget-browse-at "wid-browse" "\ -Browse the widget under point." t nil) - -(autoload 'widget-browse "wid-browse" "\ -Create a widget browser for WIDGET." t nil) - -(autoload 'widget-browse-other-window "wid-browse" "\ -Show widget browser for WIDGET in other window." t nil) - -(autoload 'widget-minor-mode "wid-browse" "\ -Togle minor mode for traversing widgets. -With arg, turn widget mode on if and only if arg is positive." t nil) - -;;;*** - -;;;### (autoloads (widget-delete widget-create widget-prompt-value) "wid-edit" "lisp/wid-edit.el") - -(autoload 'widget-prompt-value "wid-edit" "\ -Prompt for a value matching WIDGET, using PROMPT. -The current value is assumed to be VALUE, unless UNBOUND is non-nil." nil nil) - -(autoload 'widget-create "wid-edit" "\ -Create widget of TYPE. -The optional ARGS are additional keyword arguments." nil nil) - -(autoload 'widget-delete "wid-edit" "\ -Delete WIDGET." nil nil) - -;;;*** - -;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "lisp/x-font-menu.el") - -(defcustom font-menu-ignore-scaled-fonts t "*If non-nil, then the font menu will try to show only bitmap fonts." :type 'boolean :group 'x) - -(defcustom font-menu-this-frame-only-p nil "*If non-nil, then changing the default font from the font menu will only\naffect one frame instead of all frames." :type 'boolean :group 'x) - -(fset 'install-font-menus 'reset-device-font-menus) - -(autoload 'reset-device-font-menus "x-font-menu" "\ -Generates the `Font', `Size', and `Weight' submenus for the Options menu. -This is run the first time that a font-menu is needed for each device. -If you don't like the lazy invocation of this function, you can add it to -`create-device-hook' and that will make the font menus respond more quickly -when they are selected for the first time. If you add fonts to your system, -or if you change your font path, you can call this to re-initialize the menus." nil nil) - -(autoload 'font-menu-family-constructor "x-font-menu" nil nil nil) - -(autoload 'font-menu-size-constructor "x-font-menu" nil nil nil) - -(autoload 'font-menu-weight-constructor "x-font-menu" nil nil nil) - -;;;*** - -;;;### (autoloads (x-win-init-sun) "x-win-sun" "lisp/x-win-sun.el") - -(autoload 'x-win-init-sun "x-win-sun" nil nil nil) - -;;;*** - -;;;### (autoloads (x-win-init-xfree86) "x-win-xfree86" "lisp/x-win-xfree86.el") - -(autoload 'x-win-init-xfree86 "x-win-xfree86" nil nil nil) - -;;;*** - -(provide 'Standard-autoloads) diff --git a/lisp/auto-save.el b/lisp/auto-save.el deleted file mode 100644 index bbda85d..0000000 --- a/lisp/auto-save.el +++ /dev/null @@ -1,554 +0,0 @@ -;;; auto-save.el -- Safer autosaving for EFS and tmp. - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1992 by Sebastian Kremer - -;; Author: Sebastian Kremer -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped -;; Version: 1.26 - -;; 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 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 is dumped with XEmacs. - -;; Combines autosaving for efs (to a local or remote directory) -;; with the ability to do autosaves to a fixed directory on a local -;; disk, in case NFS is slow. The auto-save file used for -;; /usr/foo/bar/baz.txt -;; will be -;; AUTOSAVE/#\!usr\!foo\!bar\!baz.txt# -;; assuming AUTOSAVE is the non-nil value of the variable -;; `auto-save-directory'. - -;; Takes care that autosave files for non-file-buffers (e.g. *mail*) -;; from two simultaneous Emacses don't collide. - -;; Autosaves even if the current directory is not writable. - -;; Can limit autosave names to 14 characters using a hash function, -;; see `auto-save-hash-p'. - -;; See `auto-save-directory' and `make-auto-save-file-name' and -;; references therein for complete documentation. - -;; `M-x recover-all-files' will effectively do recover-file on all -;; files whose autosave file is newer (one of the benefits of having -;; all autosave files in the same place). - -;; This file is dumped with XEmacs. - -;; If you want to autosave in the fixed directory /tmp/USER-autosave/ -;; (setq auto-save-directory -;; (concat "/tmp/" (user-login-name) "-autosave/")) - -;; If you don't want to save in /tmp (e.g., because it is swap -;; mounted) but rather in ~/autosave/ -;; (setq auto-save-directory (expand-file-name "~/.autosave/")) - -;; If you want to save each file in its own directory (the default) -;; (setq auto-save-directory nil) -;; You still can take advantage of autosaving efs remote files -;; in a fixed local directory, `auto-save-directory-fallback' will -;; be used. - -;; If you want to use 14 character hashed autosave filenames -;; (setq auto-save-hash-p t) - -;; Finally, put this line after the others in your ~/.emacs: -;; (require 'auto-save) - - -;;; Acknowledgement: - -;; This code is loosely derived from autosave-in-tmp.el by Jamie -;; Zawinski (the version I had was last modified 22 -;; dec 90 jwz) and code submitted to ange-ftp-lovers on Sun, 5 Apr -;; 92 23:20:47 EDT by drw@BOURBAKI.MIT.EDU (Dale R. Worley). -;; auto-save.el tries to cover the functionality of those two -;; packages. - -;; Valuable comments and help from Dale Worley, Andy Norman, Jamie -;; Zawinski and Sandy Rutherford are gratefully acknowledged. - -(defconst auto-save-version "1.26" - "Version number of auto-save.") - -(provide 'auto-save) - - -;;; Customization: - -(defgroup auto-save nil - "Autosaving with support for efs and /tmp." - :group 'data) - -(put 'auto-save-interval 'custom-type 'integer) -(put 'auto-save-interval 'factory-value '(300)) -(custom-add-to-group 'auto-save 'auto-save-interval 'custom-variable) - -(defcustom auto-save-directory nil - - ;; Don't make this user-variable-p, it should be set in .emacs and - ;; left at that. In particular, it should remain constant across - ;; several Emacs session to make recover-all-files work. - - ;; However, it's OK for it to be customizable, as most of the - ;; customizable variables are set at the time `.emacs' is read. - ;; -hniksic - - "If non-nil, fixed directory for autosaving: all autosave files go -there. If this directory does not yet exist at load time, it is -created and its mode is set to 0700 so that nobody else can read your -autosave files. - -If nil, each autosave files goes into the same directory as its -corresponding visited file. - -A non-nil `auto-save-directory' could be on a local disk such as in -/tmp, then auto-saves will always be fast, even if NFS or the -automounter is slow. In the usual case of /tmp being locally mounted, -note that if you run emacs on two different machines, they will not -see each other's auto-save files. - -The value \(expand-file-name \"~/.autosave/\"\) might be better if /tmp -is mounted from swap (possible in SunOS, type `df /tmp' to find out) -and thus vanishes after a reboot, or if your system is particularly -thorough when cleaning up /tmp, clearing even non-empty subdirectories. - -It should never be an efs remote filename because that would -defeat `efs-auto-save-remotely'. - -Unless you set `auto-save-hash-p', you shouldn't set this to a -directory in a filesystem that does not support long filenames, since -a file named - - /home/sk/lib/emacs/lisp/auto-save.el - -will have a longish filename like - - AUTO-SAVE-DIRECTORY/#\\!home\\!sk\\!lib\\!emacs\\!lisp\\!auto-save.el# - -as auto save file. - -See also variables `auto-save-directory-fallback', -`efs-auto-save' and `efs-auto-save-remotely'." - :type '(choice (const :tag "Same as file" nil) - directory) - :group 'auto-save) - - -(defcustom auto-save-hash-p nil - "If non-nil, hashed autosave names of length 14 are used. -This is to avoid autosave filenames longer than 14 characters. -The directory used is `auto-save-hash-directory' regardless of -`auto-save-directory'. -Hashing defeats `recover-all-files', you have to recover files -individually by doing `recover-file'." - :type 'boolean - :group 'auto-save) - -;;; This defvar is in efs.el now, but doesn't hurt to give it here as -;;; well so that loading first auto-save.el does not abort. - -;; #### Now that `auto-save' is dumped, this is looks obnoxious. -(or (boundp 'efs-auto-save) (defvar efs-auto-save 0)) -(or (boundp 'efs-auto-save-remotely) (defvar efs-auto-save-remotely nil)) - -(defcustom auto-save-offer-delete nil - "*If non-nil, `recover-all-files' offers to delete autosave files -that are out of date or were dismissed for recovering. -Special value 'always deletes those files silently." - :type '(choice (const :tag "on" t) - (const :tag "off" nil) - (const :tag "Delete silently" always)) - :group 'auto-save) - -;;;; end of customization - - -;;; Preparations to be done at load time - -;; Do not call expand-file-name! This is evaluated at dump time now! -(defvar auto-save-directory-fallback "~/.autosave/" - ;; not user-variable-p, see above - "Directory used for local autosaving of remote files if -both `auto-save-directory' and `efs-auto-save-remotely' are nil. -Also used if a working directory to be used for autosaving is not writable. -This *must* always be the name of directory that exists or can be -created by you, never nil.") - -(defvar auto-save-hash-directory - (expand-file-name "hash/" (or auto-save-directory - auto-save-directory-fallback)) - "If non-nil, directory used for hashed autosave filenames.") - -(defun auto-save-checked-directory (dir) - "Make sure the directory DIR exists and return it expanded if non-nil." - (when dir - (setq dir (expand-file-name dir)) - ;; Make sure directory exists - (unless (file-directory-p dir) - ;; Else we create and chmod 0700 the directory - (setq dir (directory-file-name dir)) ; some systems need this - (make-directory dir) - (set-file-modes dir #o700)) - dir)) - -;; This make no sense at dump time -;; (mapc #'auto-save-check-directory -; '(auto-save-directory auto-save-directory-fallback)) - -;(and auto-save-hash-p -; (auto-save-check-directory 'auto-save-hash-directory)) - - -;;; Computing an autosave name for a file and vice versa - -;; #### Now that this file is dumped, we should turn off the routine -;; from files.el. But it would make it harder to remove it! - -(defun make-auto-save-file-name (&optional file-name);; redefines files.el - ;; auto-save-file-name-p need not be redefined. - - "Return file name to use for auto-saves of current buffer. -Does not consider `auto-save-visited-file-name'; that is checked -before calling this function. - -Offers to autosave all files in the same `auto-save-directory'. All -autosave files can then be recovered at once with function -`recover-all-files'. - -Takes care to make autosave files for files accessed through efs -be local files if variable `efs-auto-save-remotely' is nil. - -Takes care of slashes in buffer names to prevent autosave errors. - -Takes care that autosave files for buffers not visiting any file (such -as `*mail*') from two simultaneous Emacses don't collide by prepending -the Emacs pid. - -Uses 14 character autosave names if `auto-save-hash-p' is true. - -Autosaves even if the current directory is not writable, using -directory `auto-save-directory-fallback'. - -You can redefine this for customization (he he :-). -See also function `auto-save-file-name-p'." - - ;; We have to be very careful about not signalling an error in this - ;; function since files.el does not provide for this (e.g. find-file - ;; would fail for each new file). - - (setq file-name (or file-name - buffer-file-truename - (and buffer-file-name - (expand-file-name buffer-file-name)))) - (condition-case error-data - (let ( - ;; So autosavename looks like #%...#, roughly as with the - ;; old make-auto-save-file-name function. The - ;; make-temp-name inserts the pid of this Emacs: this - ;; avoids autosaving from two Emacses into the same file. - ;; It cannot be recovered automatically then because in - ;; the next Emacs session (the one after the crash) the - ;; pid will be different, but file-less buffers like - ;; *mail* must be recovered manually anyway. - - ;; jwz: putting the emacs PID in the auto-save file name is bad - ;; news, because that defeats auto-save-recovery of *mail* - ;; buffers -- the (sensible) code in sendmail.el calls - ;; (make-auto-save-file-name) to determine whether there is - ;; unsent, auto-saved mail to recover. If that mail came from a - ;; previous emacs process (far and away the most likely case) - ;; then this can never succeed as the pid differs. - ;;(name-prefix (if file-name nil (make-temp-name "#%"))) - (name-prefix (if file-name nil "#%")) - - (save-name (or file-name - ;; Prevent autosave errors. Buffername - ;; (to become non-dir part of filename) will - ;; be unslashified twice. Don't care. - (auto-save-unslashify-name (buffer-name)))) - (remote-p (and (stringp file-name) - (fboundp 'efs-ftp-path) - (efs-ftp-path file-name)))) - ;; Return the appropriate auto save file name: - (expand-file-name;; a buffername needs this, a filename not - (cond (remote-p - (if efs-auto-save-remotely - (auto-save-name-in-same-directory save-name) - ;; We have to use the `fixed-directory' now since the - ;; `same-directory' would be remote. - ;; It will use the fallback if needed. - (auto-save-name-in-fixed-directory save-name))) - ;; Else it is a local file (or a buffer without a file, - ;; hence the name-prefix). - ((or auto-save-directory auto-save-hash-p) - ;; Hashed files always go into the special hash dir, - ;; never in the same directory, to make recognizing - ;; reliable. - (auto-save-name-in-fixed-directory save-name name-prefix)) - (t - (auto-save-name-in-same-directory save-name name-prefix))))) - - ;; If any error occurs in the above code, return what the old - ;; version of this function would have done. It is not ok to - ;; return nil, e.g., when after-find-file tests - ;; file-newer-than-file-p, nil would bomb. - - (error (warn "Error caught in `make-auto-save-file-name':\n%s" - (error-message-string error-data)) - (if buffer-file-name - (concat (file-name-directory buffer-file-name) - "#" - (file-name-nondirectory buffer-file-name) - "#") - (expand-file-name (concat "#%" (buffer-name) "#")))))) - -(defun auto-save-original-name (savename) - "Reverse of `make-auto-save-file-name'. -Returns nil if SAVENAME was not associated with a file (e.g., it came -from an autosaved `*mail*' buffer) or does not appear to be an -autosave file at all. -Hashed files are not understood, see `auto-save-hash-p'." - (let ((basename (file-name-nondirectory savename)) - (savedir (file-name-directory savename))) - (cond ((or (not (auto-save-file-name-p basename)) - (string-match "^#%" basename)) - nil) - ;; now we know it looks like #...# thus substring is safe to use - ((or (equal savedir - (and auto-save-directory - (expand-file-name auto-save-directory))) - ; 2nd arg may be nil - (equal savedir - (expand-file-name auto-save-directory-fallback))) - ;; it is of the `-fixed-directory' type - (auto-save-slashify-name (substring basename 1 -1))) - (t - ;; else it is of `-same-directory' type - (concat savedir (substring basename 1 -1)))))) - -(defun auto-save-name-in-fixed-directory (filename &optional prefix) - ;; Unslashify and enclose the whole FILENAME in `#' to make an auto - ;; save file in the auto-save-directory, or if that is nil, in - ;; auto-save-directory-fallback (which must be the name of an - ;; existing directory). If the results would be too long for 14 - ;; character filenames, and `auto-save-hash-p' is set, hash FILENAME - ;; into a shorter name. - ;; Optional PREFIX is string to use instead of "#" to prefix name. - (let ((base-name (concat (or prefix "#") - (auto-save-unslashify-name filename) - "#"))) - (if (and auto-save-hash-p - auto-save-hash-directory - (> (length base-name) 14)) - (expand-file-name (auto-save-cyclic-hash-14 filename) - (auto-save-checked-directory auto-save-hash-directory)) - (expand-file-name base-name - (auto-save-checked-directory - (or auto-save-directory - auto-save-directory-fallback)))))) - -(defun auto-save-name-in-same-directory (filename &optional prefix) - ;; Enclose the non-directory part of FILENAME in `#' to make an auto - ;; save file in the same directory as FILENAME. But if this - ;; directory is not writable, use auto-save-directory-fallback. - ;; FILENAME is assumed to be in non-directory form (no trailing slash). - ;; It may be a name without a directory part (pesumably it really - ;; comes from a buffer name then), the fallback is used then. - ;; Optional PREFIX is string to use instead of "#" to prefix name. - (let ((directory (file-name-directory filename))) - (or (null directory) - (file-writable-p directory) - (setq directory (auto-save-checked-directory - auto-save-directory-fallback))) - (concat directory ; (concat nil) is "" - (or prefix "#") - (file-name-nondirectory filename) - "#"))) - -;; #### The following two should probably use `replace-in-string'. - -(defun auto-save-unslashify-name (s) - ;; "Quote any slashes in string S by replacing them with the two - ;;characters `\\!'. - ;;Also, replace any backslash by double backslash, to make it one-to-one." - (let ((limit 0)) - (while (string-match "[/\\]" s limit) - (setq s (concat (substring s 0 (match-beginning 0)) - (if (string= (substring s - (match-beginning 0) - (match-end 0)) - "/") - "\\!" - "\\\\") - (substring s (match-end 0)))) - (setq limit (1+ (match-end 0))))) - s) - -(defun auto-save-slashify-name (s) - ;;"Reverse of `auto-save-unslashify-name'." - (let (pos) - (while (setq pos (string-match "\\\\[\\!]" s pos)) - (setq s (concat (substring s 0 pos) - (if (eq ?! (aref s (1+ pos))) "/" "\\") - (substring s (+ pos 2))) - pos (1+ pos)))) - s) - - -;;; Hashing for autosave names - -;;; Hashing function contributed by Andy Norman -;;; based upon C code from pot@fly.cnuce.cnr.IT (Francesco Potorti`). - -(defun auto-save-cyclic-hash-14 (s) - ;; "Hash string S into a string of length 14. - ;; A 7-bytes cyclic code for burst correction is calculated on a - ;; byte-by-byte basis. The polynomial used is D^7 + D^6 + D^3 +1. - ;; The resulting string consists of hexadecimal digits [0-9a-f]. - ;; In particular, it contains no slash, so it can be used as autosave name." - (let ((crc (make-vector 7 ?\0))) - (mapc - (lambda (new) - (setq new (+ new (aref crc 6))) - (aset crc 6 (+ (aref crc 5) new)) - (aset crc 5 (aref crc 4)) - (aset crc 4 (aref crc 3)) - (aset crc 3 (+ (aref crc 2) new)) - (aset crc 2 (aref crc 1)) - (aset crc 1 (aref crc 0)) - (aset crc 0 new)) - s) - (format "%02x%02x%02x%02x%02x%02x%02x" - (logand 255 (aref crc 0)) - (logand 255 (aref crc 1)) - (logand 255 (aref crc 2)) - (logand 255 (aref crc 3)) - (logand 255 (aref crc 4)) - (logand 255 (aref crc 5)) - (logand 255 (aref crc 6))))) - -;; #### It is unclear to me how the following function is useful. It -;; should be used in `auto-save-name-in-same-directory', if anywhere. -;; -hniksic - -;; This leaves two characters that could be used to wrap it in `#' or -;; make two filenames from it: one for autosaving, and another for a -;; file containing the name of the autosaved filed, to make hashing -;; reversible. -;(defun auto-save-cyclic-hash-12 (s) -; "Outputs the 12-characters ascii hex representation of a 6-bytes -;cyclic code for burst correction calculated on STRING on a -;byte-by-byte basis. The used polynomial is D^6 + D^5 + D^4 + D^3 +1." -; (let ((crc (make-string 6 0))) -; (mapc -; (lambda (new) -; (setq new (+ new (aref crc 5))) -; (aset crc 5 (+ (aref crc 4) new)) -; (aset crc 4 (+ (aref crc 3) new)) -; (aset crc 3 (+ (aref crc 2) new)) -; (aset crc 2 (aref crc 1)) -; (aset crc 1 (aref crc 0)) -; (aset crc 0 new)) -; s) -; (format "%02x%02x%02x%02x%02x%02x" -; (aref crc 0) -; (aref crc 1) -; (aref crc 2) -; (aref crc 3) -; (aref crc 4) -; (aref crc 5)))) - - - -;;; Recovering files - -(defun recover-all-files (&optional silent) - "Do recover-file for all autosave files which are current. -Only works if you have a non-nil `auto-save-directory'. - -Optional prefix argument SILENT means to be silent about non-current -autosave files. This is useful if invoked automatically at Emacs -startup. - -If `auto-save-offer-delete' is t, this function will offer to delete -old or rejected autosave files. - -Hashed files (see `auto-save-hash-p') are not understood, use -`recover-file' to recover them individually." - (interactive "P") - (let ((savefiles (directory-files auto-save-directory - t "\\`#" nil t)) - afile ; the auto save file - file ; its original file - (total 0) ; # of files offered to recover - (count 0)) ; # of files actually recovered - (or (equal (expand-file-name auto-save-directory) - (expand-file-name auto-save-directory-fallback)) - (setq savefiles - (nconc savefiles - (directory-files auto-save-directory-fallback - t "\\`#" nil t)))) - (while savefiles - (setq afile (car savefiles) - file (auto-save-original-name afile) - savefiles (cdr savefiles)) - (cond ((and file (not (file-newer-than-file-p afile file))) - (warn "Autosave file \"%s\" is not current." afile)) - (t - (incf total) - (with-output-to-temp-buffer "*Directory*" - (apply 'call-process "ls" nil standard-output nil - "-l" afile (if file (list file)))) - (if (yes-or-no-p (format "Recover %s from auto save file? " - (or file "non-file buffer"))) - (let* ((obuf (current-buffer))) - (set-buffer (if file - (find-file-noselect file t) - (generate-new-buffer "*recovered*"))) - (setq buffer-read-only nil) - (erase-buffer) - (insert-file-contents afile nil) - (ignore-errors - (after-find-file nil)) - (setq buffer-auto-save-file-name nil) - (incf count) - (message "\ -Auto-save off in buffer \"%s\" till you do M-x auto-save-mode." - (buffer-name)) - (set-buffer obuf) - (sit-for 1)) - ;; If not used for recovering, offer to delete - ;; autosave file - (and auto-save-offer-delete - (or (eq 'always auto-save-offer-delete) - (yes-or-no-p - (format "Delete autosave file for `%s'? " file))) - (delete-file afile)))))) - (if (zerop total) - (or silent (message "Nothing to recover.")) - (message "%d/%d file%s recovered." count total (if (= count 1) "" "s")))) - (and (get-buffer "*Directory*") - (kill-buffer "*Directory*"))) - -;;; auto-save.el ends here diff --git a/lisp/auto-show.el b/lisp/auto-show.el deleted file mode 100644 index 9e44467..0000000 --- a/lisp/auto-show.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; auto-show.el --- perform automatic horizontal scrolling as point moves - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; This file is in the public domain. - -;; Author: Pete Ware -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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/Mule zeta. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Modified by: Ben Wing - -;; This file provides functions that -;; automatically scroll the window horizontally when the point moves -;; off the left or right side of the window. - -;; Once this library is loaded, automatic horizontal scrolling -;; occurs whenever long lines are being truncated. -;; To request truncation of long lines, set the variable -;; Setting the variable `truncate-lines' to non-nil. -;; You can do this for all buffers as follows: -;; -;; (set-default 'truncate-lines t) - -;; Here is how to do it for C mode only: -;; -;; (set-default 'truncate-lines nil) ; this is the original value -;; (defun my-c-mode-hook () -;; "Run when C-mode starts up. Changes ..." -;; ... set various personal preferences ... -;; (setq truncate-lines t)) -;; (add-hook 'c-mode-hook 'my-c-mode-hook) -;; -;; -;; As a finer level of control, you can still have truncated lines but -;; without the automatic horizontal scrolling by setting the buffer -;; local variable `auto-show-mode' to nil. The default value is t. -;; The command `auto-show-mode' toggles the value of the variable -;; `auto-show-mode'. - -;;; Code: - -(defgroup auto-show nil - "Perform automatic horizontal scrolling as point moves." - :group 'display - :group 'extensions) - -;; This is preloaded, so we don't need special :set, :require, etc. -(defcustom auto-show-mode t - "*Non-nil enables automatic horizontal scrolling, when lines are truncated. -The default value is t. To change the default, do this: - (set-default 'auto-show-mode nil) -See also command `auto-show-mode'. -This variable has no effect when lines are not being truncated. -This variable is automatically local in each buffer where it is set." - :type 'boolean - :group 'auto-show) - -(make-variable-buffer-local 'auto-show-mode) - -(defcustom auto-show-shift-amount 8 - "*Extra columns to scroll. for automatic horizontal scrolling." - :type 'integer - :group 'auto-show) - -(defcustom auto-show-show-left-margin-threshold 50 - "*Threshold column for automatic horizontal scrolling to the right. -If point is before this column, we try to scroll to make the left margin -visible. Setting this to 0 disables this feature." - :type 'number - :group 'auto-show) - -(defun auto-show-truncationp () - "True if line truncation is enabled for the selected window." - ;; XEmacs change (use specifiers) - ;; ### There should be a more straightforward way to do this from elisp. - (or truncate-lines - (and truncate-partial-width-windows - (< (+ (window-width) - (specifier-instance left-margin-width) - (specifier-instance right-margin-width)) - (frame-width))))) - -(defun auto-show-mode (arg) - "Turn automatic horizontal scroll mode on or off. -With arg, turn auto scrolling on if arg is positive, off otherwise. -This mode is enabled or disabled for each buffer individually. -It takes effect only when `truncate-lines' is non-nil." - (interactive "P") - (setq auto-show-mode - (if (null arg) - (not auto-show-mode) - (> (prefix-numeric-value arg) 0)))) - -;; XEmacs addition: -(defvar auto-show-inhibiting-commands - '(scrollbar-char-left - scrollbar-char-right - scrollbar-page-left - scrollbar-page-right - scrollbar-to-left - scrollbar-to-right - scrollbar-horizontal-drag) - "Commands that inhibit auto-show behavior. -This normally includes the horizontal scrollbar commands.") - -;; XEmacs addition: -(defun auto-show-should-take-action-p () - (and auto-show-mode (auto-show-truncationp) - (equal (window-buffer) (current-buffer)) - (not (memq this-command auto-show-inhibiting-commands)))) - -;; XEmacs addition: -(defun auto-show-make-region-visible (start end) - "Move point in such a way that the region (START, END) is visible. -This only does anything if auto-show-mode is enabled, and it doesn't -actually do any horizontal scrolling; rather, it just sets things up so -that the region will be visible when `auto-show-make-point-visible' -is next called (this happens after every command)." - (if (auto-show-should-take-action-p) - (let* ((scroll (window-hscroll)) ;how far window is scrolled - (w-width (- (window-width) - (if (> scroll 0) - 2 1))) ;how wide window is on the screen - (right-col (+ scroll w-width)) - (start-col (save-excursion (goto-char start) (current-column))) - (end-col (save-excursion (goto-char end) (current-column)))) - (cond ((and (>= start-col scroll) - (<= end-col right-col)) - ;; already completely visible - nil) - ((< start-col scroll) - (scroll-right (- scroll start-col))) - (t - (scroll-left (- end-col right-col))))))) - -(defun auto-show-make-point-visible (&optional ignore-arg) - "Scroll horizontally to make point visible, if that is enabled. -This function only does something if `auto-show-mode' is non-nil -and longlines are being truncated in the selected window. -See also the command `auto-show-mode'." - (interactive) - ;; XEmacs change - (if (auto-show-should-take-action-p) - (let* ((col (current-column)) ;column on line point is at - (scroll (window-hscroll)) ;how far window is scrolled - (w-width (- (window-width) - (if (> scroll 0) - 2 1))) ;how wide window is on the screen - (right-col (+ scroll w-width))) - (if (and (< col auto-show-show-left-margin-threshold) - (< col (window-width)) - (> scroll 0)) - (scroll-right scroll) - (if (< col scroll) ;to the left of the screen - (scroll-right (+ (- scroll col) auto-show-shift-amount)) - (if (or (> col right-col) ;to the right of the screen - (and (= col right-col) - (not (eolp)))) - (scroll-left (+ auto-show-shift-amount - (- col (+ scroll w-width)))))))))) - -;; XEmacs change: -;; #### instead of this, we kludgily call it from the C code, to make sure -;; that it's done after any other things on post-command-hook (which might -;; move point). -;; Do auto-scrolling after commands. -;;(add-hook 'post-command-hook 'auto-show-make-point-visible) - -;; If being dumped, turn it on right away. -(when (boundp 'pureload) - (auto-show-mode 1)) - -;; Do auto-scrolling in comint buffers after process output also. -; XEmacs -- don't do this now, it messes up comint. -;(add-hook 'comint-output-filter-functions 'auto-show-make-point-visible t) - -(provide 'auto-show) - -;;; auto-show.el ends here diff --git a/lisp/autoload.el b/lisp/autoload.el deleted file mode 100644 index ec70873..0000000 --- a/lisp/autoload.el +++ /dev/null @@ -1,566 +0,0 @@ -;;; autoload.el --- maintain autoloads in loaddefs.el. - -;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1996 Ben Wing. - -;; Author: Roland McGrath -;; 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: Not synched with FSF. - -;;; Commentary: - -;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to -;; date. It interprets magic cookies of the form ";;;###autoload" in -;; lisp source files in various useful ways. To learn more, read the -;; source; if you're going to use this, you'd better be able to. - -;; ChangeLog: - -;; Sep-26-1997: slb removed code dealing with customization. - -;;; Code: - -(defun make-autoload (form file) - "Turn FORM, a defun or defmacro, into an autoload for source file FILE. -Returns nil if FORM is not a defun, define-skeleton or defmacro." - (let ((car (car-safe form))) - (if (memq car '(defun define-skeleton defmacro)) - (let ((macrop (eq car 'defmacro)) - name doc) - (setq form (cdr form) - name (car form) - ;; Ignore the arguments. - form (cdr (if (eq car 'define-skeleton) - form - (cdr form))) - doc (car form)) - (if (stringp doc) - (setq form (cdr form)) - (setq doc nil)) - (list 'autoload (list 'quote name) file doc - (or (eq car 'define-skeleton) - (eq (car-safe (car form)) 'interactive)) - (if macrop (list 'quote 'macro) nil))) - nil))) - -(put 'define-skeleton 'doc-string-elt 3) - -(defvar generate-autoload-cookie ";;;###autoload" - "Magic comment indicating the following form should be autoloaded. -Used by `update-file-autoloads'. This string should be -meaningless to Lisp (e.g., a comment). - -This string is used: - -;;;###autoload -\(defun function-to-be-autoloaded () ...) - -If this string appears alone on a line, the following form will be -read and an autoload made for it. If it is followed by the string -\"immediate\", then the form on the following line will be copied -verbatim. If there is further text on the line, that text will be -copied verbatim to `generated-autoload-file'.") - -(defvar generate-autoload-section-header "\f\n;;;### " - "String inserted before the form identifying -the section of autoloads for a file.") - -(defvar generate-autoload-section-trailer "\n;;;***\n" - "String which indicates the end of the section of autoloads for a file.") - -;;; Forms which have doc-strings which should be printed specially. -;;; A doc-string-elt property of ELT says that (nth ELT FORM) is -;;; the doc-string in FORM. -;;; -;;; There used to be the following note here: -;;; ;;; Note: defconst and defvar should NOT be marked in this way. -;;; ;;; We don't want to produce defconsts and defvars that -;;; ;;; make-docfile can grok, because then it would grok them twice, -;;; ;;; once in foo.el (where they are given with ;;;###autoload) and -;;; ;;; once in loaddefs.el. -;;; -;;; Counter-note: Yes, they should be marked in this way. -;;; make-docfile only processes those files that are loaded into the -;;; dumped Emacs, and those files should never have anything -;;; autoloaded here. The above-feared problem only occurs with files -;;; which have autoloaded entries *and* are processed by make-docfile; -;;; there should be no such files. - -(put 'autoload 'doc-string-elt 3) -(put 'defun 'doc-string-elt 3) -(put 'defvar 'doc-string-elt 3) -(put 'defconst 'doc-string-elt 3) -(put 'defmacro 'doc-string-elt 3) - -(defun autoload-trim-file-name (file) - "Returns a relative pathname of FILE including the last directory." - (setq file (expand-file-name file)) - (file-relative-name file (file-name-directory - (directory-file-name - (file-name-directory file))))) - -;;;###autoload -(defun generate-file-autoloads (file &optional funlist) - "Insert at point a loaddefs autoload section for FILE. -autoloads are generated for defuns and defmacros in FILE -marked by `generate-autoload-cookie' (which see). -If FILE is being visited in a buffer, the contents of the buffer -are used." - (interactive "fGenerate autoloads for file: ") - (generate-file-autoloads-1 file funlist)) - -(defun* generate-file-autoloads-1 (file funlist) - "Insert at point a loaddefs autoload section for FILE. -autoloads are generated for defuns and defmacros in FILE -marked by `generate-autoload-cookie' (which see). -If FILE is being visited in a buffer, the contents of the buffer -are used." - (let ((outbuf (current-buffer)) - (autoloads-done '()) - (load-name (replace-in-string (file-name-nondirectory file) - "\\.elc?$" - "")) - (trim-name (autoload-trim-file-name file)) - (dofiles (not (null funlist))) - (print-length nil) - (print-readably t) ; XEmacs - (float-output-format nil) - ;; (done-any nil) - (visited (get-file-buffer file)) - output-end) - - ;; If the autoload section we create here uses an absolute - ;; pathname for FILE in its header, and then Emacs is installed - ;; under a different path on another system, - ;; `update-autoloads-here' won't be able to find the files to be - ;; autoloaded. So, if FILE is in the same directory or a - ;; subdirectory of the current buffer's directory, we'll make it - ;; relative to the current buffer's directory. - (setq file (expand-file-name file)) - - (save-excursion - (unwind-protect - (progn - (let ((find-file-hooks nil) - (enable-local-variables nil)) - (set-buffer (or visited (find-file-noselect file))) - (set-syntax-table lisp-mode-syntax-table)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (unless (search-forward generate-autoload-cookie nil t) - (message "No autoloads found in %s" trim-name) - (return-from generate-file-autoloads-1)) - - (message "Generating autoloads for %s..." trim-name) - (goto-char (point-min)) - (while (if dofiles funlist (not (eobp))) - (if (not dofiles) - (skip-chars-forward " \t\n\f") - (goto-char (point-min)) - (re-search-forward - (concat "(def\\(un\\|var\\|const\\|macro\\) " - (regexp-quote (symbol-name (car funlist))) - "\\s ")) - (goto-char (match-beginning 0))) - (cond - ((or dofiles - (looking-at (regexp-quote generate-autoload-cookie))) - (if dofiles - nil - (search-forward generate-autoload-cookie) - (skip-chars-forward " \t")) - ;; (setq done-any t) - (if (or dofiles (eolp)) - ;; Read the next form and make an autoload. - (let* ((form (prog1 (read (current-buffer)) - (or (bolp) (forward-line 1)))) - (autoload (make-autoload form load-name)) - (doc-string-elt (get (car-safe form) - 'doc-string-elt))) - (if autoload - (setq autoloads-done (cons (nth 1 form) - autoloads-done)) - (setq autoload form)) - (if (and doc-string-elt - (stringp (nth doc-string-elt autoload))) - ;; We need to hack the printing because the - ;; doc-string must be printed specially for - ;; make-docfile (sigh). - (let* ((p (nthcdr (1- doc-string-elt) - autoload)) - (elt (cdr p))) - (setcdr p nil) - (princ "\n(" outbuf) - ;; XEmacs change: don't let ^^L's get into - ;; the file or sorting is hard. - (let ((print-escape-newlines t) - (p (save-excursion - (set-buffer outbuf) - (point))) - p2) - (mapcar (function (lambda (elt) - (prin1 elt outbuf) - (princ " " outbuf))) - autoload) - (save-excursion - (set-buffer outbuf) - (setq p2 (point-marker)) - (goto-char p) - (save-match-data - (while (search-forward "\^L" p2 t) - (delete-char -1) - (insert "\\^L"))) - (goto-char p2) - )) - (princ "\"\\\n" outbuf) - (let ((begin (save-excursion - (set-buffer outbuf) - (point)))) - (princ (substring - (prin1-to-string (car elt)) 1) - outbuf) - ;; Insert a backslash before each ( that - ;; appears at the beginning of a line in - ;; the doc string. - (save-excursion - (set-buffer outbuf) - (save-excursion - (while (search-backward "\n(" begin t) - (forward-char 1) - (insert "\\")))) - (if (null (cdr elt)) - (princ ")" outbuf) - (princ " " outbuf) - (princ (substring - (prin1-to-string (cdr elt)) - 1) - outbuf)) - (terpri outbuf))) - ;; XEmacs change: another fucking ^L hack - (let ((p (save-excursion - (set-buffer outbuf) - (point))) - (print-escape-newlines t) - p2) - (print autoload outbuf) - (save-excursion - (set-buffer outbuf) - (setq p2 (point-marker)) - (goto-char p) - (save-match-data - (while (search-forward "\^L" p2 t) - (delete-char -1) - (insert "\\^L"))) - (goto-char p2) - )) - )) - ;; Copy the rest of the line to the output. - (let ((begin (point))) - ;; (terpri outbuf) - (cond ((looking-at "immediate\\s *$") ; XEmacs - ;; This is here so that you can automatically - ;; have small hook functions copied to - ;; loaddefs.el so that it's not necessary to - ;; load a whole file just to get a two-line - ;; do-nothing find-file-hook... --Stig - (forward-line 1) - (setq begin (point)) - (forward-sexp) - (forward-line 1)) - (t - (forward-line 1))) - (princ (buffer-substring begin (point)) outbuf)))) - ((looking-at ";") - ;; Don't read the comment. - (forward-line 1)) - (t - (forward-sexp 1) - (forward-line 1))) - (if dofiles - (setq funlist (cdr funlist))))))) - (unless visited - ;; We created this buffer, so we should kill it. - (kill-buffer (current-buffer))) - (set-buffer outbuf) - (setq output-end (point-marker)))) - (if t ;; done-any - ;; XEmacs -- always do this so that we cache the information - ;; that we've processed the file already. - (progn - (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads-done load-name trim-name) - outbuf) - (terpri outbuf) - ;;;; (insert ";;; Generated autoloads from " - ;;;; (autoload-trim-file-name file) "\n") - ;; Warn if we put a line in loaddefs.el - ;; that is long enough to cause trouble. - (when (< output-end (point)) - (setq output-end (point-marker))) - (while (< (point) output-end) - ;; (let ((beg (point))) - (end-of-line) - ;; Emacs -- I still haven't figured this one out. - ;; (if (> (- (point) beg) 900) - ;; (progn - ;; (message "A line is too long--over 900 characters") - ;; (sleep-for 2) - ;; (goto-char output-end))) - ;; ) - (forward-line 1)) - (goto-char output-end) - (insert generate-autoload-section-trailer))) - (or noninteractive ; XEmacs: only need one line in -batch mode. - (message "Generating autoloads for %s...done" file)))) - - -(defconst autoload-file-name "auto-autoloads.el" - "Generic filename to put autoloads into. -Unless you are an XEmacs maintainer, it is probably unwise to change this.") - -(defvar autoload-target-directory "../lisp/prim/" - "Directory to put autoload declaration file into. -Unless you know what you're doing, don't mess with this.") - -(defvar generated-autoload-file - (expand-file-name (concat autoload-target-directory - autoload-file-name) - data-directory) - "*File `update-file-autoloads' puts autoloads into. -A .el file can set this in its local variables section to make its -autoloads go somewhere else.") - -(defconst cusload-file-name "custom-load.el" - "Generic filename ot put custom loads into. -Unless you are an XEmacs maintainr, it is probably unwise to change this.") - -;;;###autoload -(defun update-file-autoloads (file) - "Update the autoloads for FILE in `generated-autoload-file' -\(which FILE might bind in its local variables). -This functions refuses to update autoloads files." - (interactive "fUpdate autoloads for file: ") - (setq file (expand-file-name file)) - (when (and (file-newer-than-file-p file generated-autoload-file) - (not (member (file-name-nondirectory file) - (list autoload-file-name)))) - - (let ((load-name (replace-in-string (file-name-nondirectory file) - "\\.elc?$" - "")) - (trim-name (autoload-trim-file-name file)) - section-begin form) - (save-excursion - (let ((find-file-hooks nil)) - (set-buffer (or (get-file-buffer generated-autoload-file) - (find-file-noselect generated-autoload-file)))) - ;; Make sure we can scribble in it. - (setq buffer-read-only nil) - ;; First delete all sections for this file. - (goto-char (point-min)) - (while (search-forward generate-autoload-section-header nil t) - (setq section-begin (match-beginning 0)) - (setq form (read (current-buffer))) - (when (string= (nth 2 form) load-name) - (search-forward generate-autoload-section-trailer) - (delete-region section-begin (point)))) - - ;; Now find insertion point for new section - (block find-insertion-point - (goto-char (point-min)) - (while (search-forward generate-autoload-section-header nil t) - (setq form (read (current-buffer))) - (when (string< trim-name (nth 3 form)) - ;; Found alphabetically correct insertion point - (goto-char (match-beginning 0)) - (return-from find-insertion-point)) - (search-forward generate-autoload-section-trailer)) - (when (eq (point) (point-min)) ; No existing entries? - (goto-char (point-max)))) ; Append. - - ;; Add in new sections for file - (generate-file-autoloads file)) - - (when (interactive-p) (save-buffer))))) - -;;;###autoload -(defun update-autoloads-here () - "Update sections of the current buffer generated by `update-file-autoloads'." - (interactive) - (let ((generated-autoload-file (buffer-file-name))) - (save-excursion - (goto-char (point-min)) - (while (search-forward generate-autoload-section-header nil t) - (let* ((form (condition-case () - (read (current-buffer)) - (end-of-file nil))) - (file (nth 3 form))) - ;; XEmacs change: if we can't find the file as specified, look - ;; around a bit more. - (cond ((and (stringp file) - (or (get-file-buffer file) - (file-exists-p file)))) - ((and (stringp file) - (save-match-data - (let ((loc (locate-file (file-name-nondirectory file) - load-path))) - (if (null loc) - nil - (setq loc (expand-file-name - (autoload-trim-file-name loc) - "..")) - (if (or (get-file-buffer loc) - (file-exists-p loc)) - (setq file loc) - nil)))))) - (t - (setq file - (if (y-or-n-p - (format - "Can't find library `%s'; remove its autoloads? " - (nth 2 form) file)) - t - (condition-case () - (read-file-name - (format "Find `%s' load file: " - (nth 2 form)) - nil nil t) - (quit nil)))))) - (if file - (let ((begin (match-beginning 0))) - (search-forward generate-autoload-section-trailer) - (delete-region begin (point)))) - (if (stringp file) - (generate-file-autoloads file))))))) - -;;;###autoload -(defun update-autoloads-from-directory (dir) - "Update `generated-autoload-file' with all the current autoloads from DIR. -This runs `update-file-autoloads' on each .el file in DIR. -Obsolete autoload entries for files that no longer exist are deleted." - (interactive "DUpdate autoloads for directory: ") - (setq dir (expand-file-name dir)) - (let ((simple-dir (file-name-as-directory - (file-name-nondirectory - (directory-file-name dir)))) - (enable-local-eval nil)) - (save-excursion - (let ((find-file-hooks nil)) - (set-buffer (find-file-noselect generated-autoload-file))) - (goto-char (point-min)) - (while (search-forward generate-autoload-section-header nil t) - (let* ((begin (match-beginning 0)) - (form (condition-case () - (read (current-buffer)) - (end-of-file nil))) - (file (nth 3 form))) - (when (and (stringp file) - (string= (file-name-directory file) simple-dir) - (not (file-exists-p - (expand-file-name - (file-name-nondirectory file) dir)))) - ;; Remove the obsolete section. - (search-forward generate-autoload-section-trailer) - (delete-region begin (point))))) - ;; Update or create autoload sections for existing files. - (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$")) - (unless noninteractive - (save-buffer))))) - -;;;###autoload -(defun batch-update-autoloads () - "Update the autoloads for the files or directories on the command line. -Runs `update-file-autoloads' on files and `update-directory-autoloads' -on directories. 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 `xemacs -batch -f batch-update-autoloads *.el'. -The directory to which the auto-autoloads.el file must be the first parameter -on the command line." - (unless noninteractive - (error "batch-update-autoloads is to be used only with -batch")) - (let ((defdir default-directory) - (enable-local-eval nil)) ; Don't query in batch mode. - ;; (message "Updating autoloads in %s..." generated-autoload-file) - (dolist (arg command-line-args-left) - (setq arg (expand-file-name arg defdir)) - (cond - ((file-directory-p arg) - (message "Updating autoloads for directory %s..." arg) - (update-autoloads-from-directory arg)) - ((file-exists-p arg) - (update-file-autoloads arg)) - (t (error "No such file or directory: %s" arg)))) - (fixup-autoload-buffer (concat (if autoload-package-name - autoload-package-name - (file-name-nondirectory defdir)) - "-autoloads")) - (save-some-buffers t) - ;; (message "Done") - (kill-emacs 0))) - -(defun fixup-autoload-buffer (sym) - (save-excursion - (set-buffer (find-file-noselect generated-autoload-file)) - (goto-char (point-min)) - (if (and (not (= (point-min) (point-max))) - (not (looking-at ";;; DO NOT MODIFY THIS FILE"))) - (progn - (insert ";;; DO NOT MODIFY THIS FILE\n") - (insert "(if (featurep '" sym ")") - (insert " (error \"Already loaded\"))\n") - (goto-char (point-max)) - (insert "\n(provide '" sym ")\n"))))) - -(defvar autoload-package-name nil) - -;;;###autoload -(defun batch-update-directory () - "Update the autoloads for the directory on the command line. -Runs `update-file-autoloads' on each file in the given directory, must -be used only with -batch and kills XEmacs on completion." - (unless noninteractive - (error "batch-update-directory is to be used only with -batch")) - (let ((defdir default-directory) - (enable-local-eval nil)) ; Don't query in batch mode. - (dolist (arg command-line-args-left) - (setq arg (expand-file-name arg defdir)) - (let ((generated-autoload-file (concat arg "/" autoload-file-name))) - (cond - ((file-directory-p arg) - (message "Updating autoloads in directory %s..." arg) - (update-autoloads-from-directory arg)) - (t (error "No such file or directory: %s" arg))) - (fixup-autoload-buffer (concat (if autoload-package-name - autoload-package-name - (file-name-nondirectory arg)) - "-autoloads")) - (save-some-buffers t)) - ;; (message "Done") - ;; (kill-emacs 0) - ) - (setq command-line-args-left nil))) - -(provide 'autoload) - -;;; autoload.el ends here diff --git a/lisp/backquote.el b/lisp/backquote.el deleted file mode 100644 index 1232603..0000000 --- a/lisp/backquote.el +++ /dev/null @@ -1,304 +0,0 @@ -;;; backquote.el --- Full backquote support for elisp. Reverse compatible too. - -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; The bulk of the code is originally from CMU Common Lisp (original notice -;; below). - -;; It correctly supports nested backquotes and backquoted vectors. - -;; Converted to work with elisp by Miles Bader - -;; Changes by Jonathan Stigelman : -;; - Documentation added -;; - support for old-backquote-compatibility-hook nixed because the -;; old-backquote compatibility is now done in the reader... -;; - nixed support for |,.| because -;; (a) it's not in CLtl2 -;; (b) ",.foo" is the same as ". ,foo" -;; (c) because RMS isn't interested in using this version of backquote.el -;; -;; wing@666.com; added ,. support back in: -;; (a) yes, it is in CLtl2. Read closely on page 529. -;; (b) RMS in 19.30 adds C support for ,. even if it's not really -;; handled. -;; -;; ********************************************************************** -;; This code was written as part of the CMU Common Lisp project at -;; Carnegie Mellon University, and has been placed in the public domain. -;; If you want to use this code or any part of CMU Common Lisp, please contact -;; Scott Fahlman or slisp-group@cs.cmu.edu. -;; -;; ********************************************************************** -;; -;; BACKQUOTE: Code Spice Lispified by Lee Schumacher. -;; -;; The flags passed back by BQ-PROCESS-2 can be interpreted as follows: -;; -;; |`,|: [a] => a -;; NIL: [a] => a ;the NIL flag is used only when a is NIL -;; T: [a] => a ;the T flag is used when a is self-evaluating -;; QUOTE: [a] => (QUOTE a) -;; APPEND: [a] => (APPEND . a) -;; NCONC: [a] => (NCONC . a) -;; LIST: [a] => (LIST . a) -;; LIST*: [a] => (LIST* . a) -;; -;; The flags are combined according to the following set of rules: -;; ([a] means that a should be converted according to the previous table) -;; -;; \ car || otherwise | QUOTE or | |`,@| | |`,.| -;;cdr \ || | T or NIL | | -;;============================================================================ -;; |`,| ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a [d]) -;; NIL ||LIST ([a]) |QUOTE (a) | a | a -;;QUOTE or T||LIST* ([a] [d]) |QUOTE (a . d) |APPEND (a [d]) |NCONC (a [d]) -;; APPEND ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a . d) |NCONC (a [d]) -;; NCONC ||LIST* ([a] [d]) |LIST* ([a] [d]) |APPEND (a [d]) |NCONC (a . d) -;; LIST ||LIST ([a] . d) |LIST ([a] . d) |APPEND (a [d]) |NCONC (a [d]) -;; LIST* ||LIST* ([a] . d) |LIST* ([a] . d) |APPEND (a [d]) |NCONC (a [d]) -;; -;; involves starting over again pretending you had read ".,a)" instead -;; of ",@a)" -;; - -;; These are the forms it expects: |backquote| |`| |,| |,@| and |,.|. - -;;; Code: - -(defconst bq-backquote-marker 'backquote) -(defconst bq-backtick-marker '\`) ; remnant of the old lossage -(defconst bq-comma-marker '\,) -(defconst bq-at-marker '\,@) -(defconst bq-dot-marker '\,\.) - -;;; ---------------------------------------------------------------- - -(fset '\` 'backquote) - -(defmacro backquote (template) - "Expand the internal representation of a backquoted TEMPLATE into a lisp form. - -The backquote character is like the quote character in that it prevents the -template which follows it from being evaluated, except that backquote -permits you to evaluate portions of the quoted template. A comma character -inside TEMPLATE indicates that the following item should be evaluated. A -comma character may be followed by an at-sign, which indicates that the form -which follows should be evaluated and inserted and \"spliced\" into the -template. Forms following ,@ must evaluate to lists. - -Here is how to use backquotes: - (setq p 'b - q '(c d e)) - `(a ,p ,@q) -> (a b c d e) - `(a . b) -> (a . b) - `(a . ,p) -> (a . b) - -The XEmacs lisp reader expands lisp backquotes as it reads them. -Examples: - `atom is read as (backquote atom) - `(a ,b ,@(c d e)) is read as (backquote (a (\\, b) (\\,\\@ (c d e)))) - `(a . ,p) is read as (backquote (a \\, p)) - -\(backquote TEMPLATE) is a macro that produces code to construct TEMPLATE. -Note that this is very slow in interpreted code, but fast if you compile. -TEMPLATE is one or more nested lists or vectors, which are `almost quoted'. -They are copied recursively, with elements preceded by comma evaluated. - (backquote (a b)) == (list 'a 'b) - (backquote (a [b c])) == (list 'a (vector 'b 'c)) - -However, certain special lists are not copied. They specify substitution. -Lists that look like (\\, EXP) are evaluated and the result is substituted. - (backquote (a (\\, (+ x 5)))) == (list 'a (+ x 5)) - -Elements of the form (\\,\\@ EXP) are evaluated and then all the elements -of the result are substituted. This result must be a list; it may -be `nil'. - -Elements of the form (\\,\\. EXP) are evaluated and then all the elements -of the result are concatenated to the list of preceding elements in the list. -They must occur as the last element of a list (not a vector). -EXP may evaluate to nil. - -As an example, a simple macro `push' could be written: - (defmacro push (v l) - `(setq ,l (cons ,@(list v l)))) -or as - (defmacro push (v l) - `(setq ,l (cons ,v ,l))) - -For backwards compatibility, old-style emacs-lisp backquotes are still read. - OLD STYLE NEW STYLE - (` (foo (, bar) (,@ bing))) `(foo ,bar ,@bing) - -Because of the old-style backquote support, you cannot use a new-style -backquoted form as the first element of a list. Perhaps some day this -restriction will go away, but for now you should be wary of it: - (`(this ,will ,@fail)) - ((` (but (, this) will (,@ work)))) -This is an extremely rare thing to need to do in lisp." - (bq-process template)) - -;;; ---------------------------------------------------------------- - -(defconst bq-comma-flag 'unquote) -(defconst bq-at-flag 'unquote-splicing) -(defconst bq-dot-flag 'unquote-nconc-splicing) - -(defun bq-process (form) - (let* ((flag-result (bq-process-2 form)) - (flag (car flag-result)) - (result (cdr flag-result))) - (cond ((eq flag bq-at-flag) - (error ",@ after ` in form: %s" form)) - ((eq flag bq-dot-flag) - (error ",. after ` in form: %s" form)) - (t - (bq-process-1 flag result))))) - -;;; ---------------------------------------------------------------- - -(defun bq-vector-contents (vec) - (let ((contents nil) - (n (length vec))) - (while (> n 0) - (setq n (1- n)) - (setq contents (cons (aref vec n) contents))) - contents)) - -;;; This does the expansion from table 2. -(defun bq-process-2 (code) - (cond ((vectorp code) - (let* ((dflag-d - (bq-process-2 (bq-vector-contents code)))) - (cons 'vector (bq-process-1 (car dflag-d) (cdr dflag-d))))) - ((atom code) - (cond ((null code) (cons nil nil)) - ((or (numberp code) (eq code t)) - (cons t code)) - (t (cons 'quote code)))) - ((eq (car code) bq-at-marker) - (cons bq-at-flag (nth 1 code))) - ((eq (car code) bq-dot-marker) - (cons bq-dot-flag (nth 1 code))) - ((eq (car code) bq-comma-marker) - (bq-comma (nth 1 code))) - ((or (eq (car code) bq-backquote-marker) - (eq (car code) bq-backtick-marker)) ; old lossage - (bq-process-2 (bq-process (nth 1 code)))) - (t (let* ((aflag-a (bq-process-2 (car code))) - (aflag (car aflag-a)) - (a (cdr aflag-a))) - (let* ((dflag-d (bq-process-2 (cdr code))) - (dflag (car dflag-d)) - (d (cdr dflag-d))) - (if (eq dflag bq-at-flag) - ;; get the errors later. - (error ",@ after dot in %s" code)) - (if (eq dflag bq-dot-flag) - (error ",. after dot in %s" code)) - (cond - ((eq aflag bq-at-flag) - (if (null dflag) - (bq-comma a) - (cons 'append - (cond ((eq dflag 'append) - (cons a d )) - (t (list a (bq-process-1 dflag d))))))) - ((eq aflag bq-dot-flag) - (if (null dflag) - (bq-comma a) - (cons 'nconc - (cond ((eq dflag 'nconc) - (cons a d)) - (t (list a (bq-process-1 dflag d))))))) - ((null dflag) - (if (memq aflag '(quote t nil)) - (cons 'quote (list a)) - (cons 'list (list (bq-process-1 aflag a))))) - ((memq dflag '(quote t)) - (if (memq aflag '(quote t nil)) - (cons 'quote (cons a d )) - (cons 'list* (list (bq-process-1 aflag a) - (bq-process-1 dflag d))))) - (t (setq a (bq-process-1 aflag a)) - (if (memq dflag '(list list*)) - (cons dflag (cons a d)) - (cons 'list* - (list a (bq-process-1 dflag d))))))))))) - -;;; This handles the cases -(defun bq-comma (code) - (cond ((atom code) - (cond ((null code) - (cons nil nil)) - ((or (numberp code) (eq code 't)) - (cons t code)) - (t (cons bq-comma-flag code)))) - ((eq (car code) 'quote) - (cons (car code) (car (cdr code)))) - ((memq (car code) '(append list list* nconc)) - (cons (car code) (cdr code))) - ((eq (car code) 'cons) - (cons 'list* (cdr code))) - (t (cons bq-comma-flag code)))) - -;;; This handles table 1. -(defun bq-process-1 (flag thing) - (cond ((or (eq flag bq-comma-flag) - (memq flag '(t nil))) - thing) - ((eq flag 'quote) - (list 'quote thing)) - ((eq flag 'vector) - (list 'apply '(function vector) thing)) - (t (cons (cdr - (assq flag - '((cons . cons) - (list* . bq-list*) - (list . list) - (append . append) - (nconc . nconc)))) - thing)))) - -;;; ---------------------------------------------------------------- - -(defmacro bq-list* (&rest args) - "Return a list of its arguments with last cons a dotted pair." - (setq args (reverse args)) - (let ((result (car args))) - (setq args (cdr args)) - (while args - (setq result (list 'cons (car args) result)) - (setq args (cdr args))) - result)) - -(provide 'backquote) - -;;; backquote.el ends here diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el deleted file mode 100644 index b93feb4..0000000 --- a/lisp/buff-menu.el +++ /dev/null @@ -1,639 +0,0 @@ -;;; buff-menu.el --- buffer menu main function and support functions. - -;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: extensions, dumped - -;; 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 except as noted. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Edit, delete, or change attributes of all currently active Emacs -;; buffers from a list summarizing their state. A good way to browse -;; any special or scratch buffers you have loaded, since you can't find -;; them by filename. The single entry point is `Buffer-menu-mode', -;; normally bound to C-x C-b. - -;;; Change Log: - -;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993 -;; -;; Modified by Bob Weiner, Motorola, Inc., 4/14/89 -;; -;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete -;; current entry and then move to previous one. -;; -;; Based on FSF code dating back to 1985. - -;;; Code: - -;;;Trying to preserve the old window configuration works well in -;;;simple scenarios, when you enter the buffer menu, use it, and exit it. -;;;But it does strange things when you switch back to the buffer list buffer -;;;with C-x b, later on, when the window configuration is different. -;;;The choice seems to be, either restore the window configuration -;;;in all cases, or in no cases. -;;;I decided it was better not to restore the window config at all. -- rms. - -;;;But since then, I changed buffer-menu to use the selected window, -;;;so q now once again goes back to the previous window configuration. - -;;;(defvar Buffer-menu-window-config nil -;;; "Window configuration saved from entry to `buffer-menu'.") - -; Put buffer *Buffer List* into proper mode right away -; so that from now on even list-buffers is enough to get a buffer menu. - -(defvar Buffer-menu-buffer-column 4) - -(defvar Buffer-menu-mode-map nil) - -(if Buffer-menu-mode-map - () - (setq Buffer-menu-mode-map (make-keymap)) - (suppress-keymap Buffer-menu-mode-map t) - (set-keymap-name Buffer-menu-mode-map 'Buffer-menu-mode-map) ; XEmacs - (define-key Buffer-menu-mode-map "q" 'Buffer-menu-quit) - (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select) - (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window) - (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window) - (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window) - (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window) - (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window) - (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window) - (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save) - (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete) - (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete) - (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards) - (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete) - (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute) - (define-key Buffer-menu-mode-map " " 'next-line) - (define-key Buffer-menu-mode-map "n" 'next-line) - (define-key Buffer-menu-mode-map "p" 'previous-line) - (define-key Buffer-menu-mode-map 'backspace 'Buffer-menu-backup-unmark) - (define-key Buffer-menu-mode-map 'delete 'Buffer-menu-backup-unmark) - (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified) - (define-key Buffer-menu-mode-map "?" 'describe-mode) - (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark) - (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark) - (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table) - (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only) - (define-key Buffer-menu-mode-map "g" 'revert-buffer) - (define-key Buffer-menu-mode-map 'button2 'Buffer-menu-mouse-select) - (define-key Buffer-menu-mode-map 'button3 'Buffer-menu-popup-menu) - ) - -;; Buffer Menu mode is suitable only for specially formatted data. -(put 'Buffer-menu-mode 'mode-class 'special) - -(defun 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. -\\ -\\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu. -\\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu. -\\[Buffer-menu-other-window] -- select that buffer in another window, - so the buffer menu buffer remains visible in its window. -\\[Buffer-menu-switch-other-window] -- make another window display that buffer. -\\[Buffer-menu-mark] -- mark current line's buffer to be displayed. -\\[Buffer-menu-select] -- select current line's buffer. - Also show buffers marked with m, in other windows. -\\[Buffer-menu-1-window] -- select that buffer in full-frame window. -\\[Buffer-menu-2-window] -- select that buffer in one window, - together with buffer selected before this one in another window. -\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer. -\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer. -\\[Buffer-menu-save] -- mark that buffer to be saved, and move down. -\\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down. -\\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up. -\\[Buffer-menu-execute] -- delete or save marked buffers. -\\[Buffer-menu-unmark] -- remove all kinds of marks from current line. - With prefix argument, also move up one line. -\\[Buffer-menu-backup-unmark] -- back up a line and remove marks. -\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line." - (kill-all-local-variables) - (use-local-map Buffer-menu-mode-map) - (setq major-mode 'Buffer-menu-mode) - (setq mode-name "Buffer Menu") - (make-local-variable 'revert-buffer-function) - (setq revert-buffer-function 'Buffer-menu-revert-function) - (setq truncate-lines t) - (setq buffer-read-only t) - (make-local-variable 'mouse-track-click-hook) ; XEmacs - (add-hook 'mouse-track-click-hook 'Buffer-menu-maybe-mouse-select) ; XEmacs - (run-hooks 'buffer-menu-mode-hook)) - -(defun Buffer-menu-revert-function (ignore1 ignore2) - (list-buffers)) - -(defun Buffer-menu-buffer (error-if-non-existent-p) - "Return buffer described by this line of buffer menu." - (let* ((where (save-excursion - (beginning-of-line) - (+ (point) Buffer-menu-buffer-column))) - (name (and (not (eobp)) (get-text-property where 'buffer-name)))) - (if name - (or (get-buffer name) - (if error-if-non-existent-p - (error "No buffer named `%s'" name) - nil)) - (if error-if-non-existent-p - (error "No buffer on this line") - nil)))) - -(defun buffer-menu (&optional arg) - "Make a menu of buffers so you can save, delete or select them. -With argument, show only buffers that are visiting files. -Type ? after invocation to get help on commands available. -Type q immediately to make the buffer menu go away." - (interactive "P") -;;; (setq Buffer-menu-window-config (current-window-configuration)) - (switch-to-buffer (list-buffers-noselect arg)) - (message - "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) - -(defun buffer-menu-other-window (&optional arg) - "Display a list of buffers in another window. -With the buffer list buffer, you can save, delete or select the buffers. -With argument, show only buffers that are visiting files. -Type ? after invocation to get help on commands available. -Type q immediately to make the buffer menu go away." - (interactive "P") -;;; (setq Buffer-menu-window-config (current-window-configuration)) - (switch-to-buffer-other-window (list-buffers-noselect arg)) - (message - "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) - -(defun Buffer-menu-quit () - "Quit the buffer menu." - (interactive) - (let ((buffer (current-buffer))) - ;; Switch away from the buffer menu and bury it. - (switch-to-buffer (other-buffer)) - (bury-buffer buffer))) - -(defun Buffer-menu-mark () - "Mark buffer on this line for being displayed by \\\\[Buffer-menu-select] command." - (interactive) - (beginning-of-line) - (if (looking-at " [-M]") - (ding) - (let ((buffer-read-only nil)) - (delete-char 1) - (insert ?>) - (forward-line 1)))) - -(defun Buffer-menu-unmark (&optional backup) - "Cancel all requested operations on buffer on this line and move down. -Optional ARG means move up." - (interactive "P") - (beginning-of-line) - (if (looking-at " [-M]") - (ding) - (let* ((buf (Buffer-menu-buffer t)) - (mod (buffer-modified-p buf)) - (readonly (save-excursion (set-buffer buf) buffer-read-only)) - (buffer-read-only nil)) - (delete-char 3) - (insert (if readonly (if mod " *%" " %") (if mod " * " " "))))) - (forward-line (if backup -1 1))) - -(defun Buffer-menu-backup-unmark () - "Move up and cancel all requested operations on buffer on line above." - (interactive) - (forward-line -1) - (Buffer-menu-unmark) - (forward-line -1)) - -(defun Buffer-menu-delete (&optional arg) - "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command. -Prefix arg is how many buffers to delete. -Negative arg means delete backwards." - (interactive "p") - (beginning-of-line) - (if (looking-at " [-M]") ;header lines - (ding) - (let ((buffer-read-only nil)) - (if (or (null arg) (= arg 0)) - (setq arg 1)) - (while (> arg 0) - (delete-char 1) - (insert ?D) - (forward-line 1) - (setq arg (1- arg))) - (while (< arg 0) - (delete-char 1) - (insert ?D) - (forward-line -1) - (setq arg (1+ arg)))))) - -(defun Buffer-menu-delete-backwards (&optional arg) - "Mark buffer on this line to be deleted by \\\\[Buffer-menu-execute] command -and then move up one line. Prefix arg means move that many lines." - (interactive "p") - (Buffer-menu-delete (- (or arg 1))) - (while (looking-at " [-M]") - (forward-line 1))) - -(defun Buffer-menu-save () - "Mark buffer on this line to be saved by \\\\[Buffer-menu-execute] command." - (interactive) - (beginning-of-line) - (if (looking-at " [-M]") ;header lines - (ding) - (let ((buffer-read-only nil)) - (forward-char 1) - (delete-char 1) - (insert ?S) - (forward-line 1)))) - -(defun Buffer-menu-not-modified (&optional arg) - "Mark buffer on this line as unmodified (no changes to save)." - (interactive "P") - (save-excursion - (set-buffer (Buffer-menu-buffer t)) - (set-buffer-modified-p arg)) - (save-excursion - (beginning-of-line) - (forward-char 1) - (if (= (char-after (point)) (if arg ? ?*)) - (let ((buffer-read-only nil)) - (delete-char 1) - (insert (if arg ?* ? )))))) - -(defun Buffer-menu-execute () - "Save and/or delete buffers marked with \\\\[Buffer-menu-save] or \\\\[Buffer-menu-delete] commands." - (interactive) - (save-excursion - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward "^.S" nil t) - (let ((modp nil)) - (save-excursion - (set-buffer (Buffer-menu-buffer t)) - (save-buffer) - (setq modp (buffer-modified-p))) - (let ((buffer-read-only nil)) - (delete-char -1) - (insert (if modp ?* ? )))))) - (save-excursion - (goto-char (point-min)) - (forward-line 1) - (let ((buff-menu-buffer (current-buffer)) - (buffer-read-only nil)) - (while (search-forward "\nD" nil t) - (forward-char -1) - (let ((buf (Buffer-menu-buffer nil))) - (or (eq buf nil) - (eq buf buff-menu-buffer) - (save-excursion (kill-buffer buf)))) - (if (Buffer-menu-buffer nil) - (progn (delete-char 1) - (insert ? )) - (delete-region (point) (progn (forward-line 1) (point))) - (forward-char -1)))))) - -(defun Buffer-menu-select () - "Select this line's buffer; also display buffers marked with `>'. -You can mark buffers with the \\\\[Buffer-menu-mark] command. -This command deletes and replaces all the previously existing windows -in the selected frame." - (interactive) - (let ((buff (Buffer-menu-buffer t)) - (menu (current-buffer)) - (others ()) - tem) - (goto-char (point-min)) - (while (search-forward "\n>" nil t) - (setq tem (Buffer-menu-buffer t)) - (let ((buffer-read-only nil)) - (delete-char -1) - (insert ?\ )) - (or (eq tem buff) (memq tem others) (setq others (cons tem others)))) - (setq others (nreverse others) - tem (/ (1- (frame-height)) (1+ (length others)))) - (delete-other-windows) - (switch-to-buffer buff) - (or (eq menu buff) - (bury-buffer menu)) - (if (equal (length others) 0) - (progn -;;; ;; Restore previous window configuration before displaying -;;; ;; selected buffers. -;;; (if Buffer-menu-window-config -;;; (progn -;;; (set-window-configuration Buffer-menu-window-config) -;;; (setq Buffer-menu-window-config nil))) - (switch-to-buffer buff)) - (while others - (split-window nil tem) - (other-window 1) - (switch-to-buffer (car others)) - (setq others (cdr others))) - (other-window 1) ;back to the beginning! -))) - - - -(defun Buffer-menu-visit-tags-table () - "Visit the tags table in the buffer on this line. See `visit-tags-table'." - (interactive) - (let ((file (buffer-file-name (Buffer-menu-buffer t)))) - (if file - (visit-tags-table file) - (error "Specified buffer has no file")))) - -(defun Buffer-menu-1-window () - "Select this line's buffer, alone, in full frame." - (interactive) - (switch-to-buffer (Buffer-menu-buffer t)) - (bury-buffer (other-buffer)) - (delete-other-windows) - ;; XEmacs: - ;; This is to get w->force_start set to nil. Don't ask me, I only work here. - (set-window-buffer (selected-window) (current-buffer))) - -(defun Buffer-menu-mouse-select (event) - "Select the buffer whose line you click on." - (interactive "e") - (let (buffer) - (save-excursion - (set-buffer (event-buffer event)) ; XEmacs - (save-excursion - (goto-char (event-point event)) ; XEmacs - (setq buffer (Buffer-menu-buffer t)))) - (select-window (event-window event)) ; XEmacs - (if (and (window-dedicated-p (selected-window)) - (eq (selected-window) (frame-root-window))) - (switch-to-buffer-other-frame buffer) - (switch-to-buffer buffer)))) - -;; XEmacs -(defun Buffer-menu-maybe-mouse-select (event &optional click-count) - (interactive "e") - (and (>= click-count 2) - (let ((buffer (current-buffer)) - (point (point)) - (config (current-window-configuration))) - (condition-case nil - (progn - (Buffer-menu-mouse-select event) - t) - (error - (set-window-configuration config) - (set-buffer buffer) - (goto-char point) - nil))))) - -(defun Buffer-menu-this-window () - "Select this line's buffer in this window." - (interactive) - (switch-to-buffer (Buffer-menu-buffer t))) - -(defun Buffer-menu-other-window () - "Select this line's buffer in other window, leaving buffer menu visible." - (interactive) - (switch-to-buffer-other-window (Buffer-menu-buffer t))) - -(defun Buffer-menu-switch-other-window () - "Make the other window select this line's buffer. -The current window remains selected." - (interactive) - (display-buffer (Buffer-menu-buffer t))) - -(defun Buffer-menu-2-window () - "Select this line's buffer, with previous buffer in second window." - (interactive) - (let ((buff (Buffer-menu-buffer t)) - (menu (current-buffer)) - (pop-up-windows t)) - (delete-other-windows) - (switch-to-buffer (other-buffer)) - (pop-to-buffer buff) - (bury-buffer menu))) - -(defun Buffer-menu-toggle-read-only () - "Toggle read-only status of buffer on this line, perhaps via version control." - (interactive) - (let (char) - (save-excursion - (set-buffer (Buffer-menu-buffer t)) - (modeline-toggle-read-only) - (setq char (if buffer-read-only ?% ? ))) - (save-excursion - (beginning-of-line) - (forward-char 2) - (if (/= (following-char) char) - (let (buffer-read-only) - (delete-char 1) - (insert char)))))) - -;; XEmacs -(defvar Buffer-menu-popup-menu - '("Buffer Commands" - ["Select Buffer" Buffer-menu-select t] - ["Select buffer Other Window" Buffer-menu-other-window t] - ["Clear Buffer Modification Flag" Buffer-menu-not-modified t] - "----" - ["Mark Buffer for Selection" Buffer-menu-mark t] - ["Mark Buffer for Save" Buffer-menu-save t] - ["Mark Buffer for Deletion" Buffer-menu-delete t] - ["Unmark Buffer" Buffer-menu-unmark t] - "----" - ["Delete/Save Marked Buffers" Buffer-menu-execute t] - )) - -;; XEmacs -(defun Buffer-menu-popup-menu (event) - (interactive "e") - (mouse-set-point event) - (beginning-of-line) - (let ((buffer (Buffer-menu-buffer nil))) - (if buffer - (popup-menu - (nconc (list (car Buffer-menu-popup-menu) - (concat - "Commands on buffer \"" (buffer-name buffer) "\":") - "----") - (cdr Buffer-menu-popup-menu))) - (error "no buffer on this line")))) - - -;; XEmacs -(defvar list-buffers-header-line - (purecopy (concat " MR Buffer Size Mode File\n" - " -- ------ ---- ---- ----\n"))) - -;; XEmacs -(defvar list-buffers-identification 'default-list-buffers-identification - "String used to identify this buffer, or a function of one argument -to generate such a string. This variable is always buffer-local.") -(make-variable-buffer-local 'list-buffers-identification) - -;; XEmacs -;;;###autoload -(defvar list-buffers-directory nil) - -;;;###autoload -(make-variable-buffer-local 'list-buffers-directory) - -;; #### not synched -(defun default-list-buffers-identification (output) - (save-excursion - (let ((file (or (buffer-file-name (current-buffer)) - (and (boundp 'list-buffers-directory) - list-buffers-directory))) - (size (buffer-size)) - (mode mode-name) - eob p s col) - (set-buffer output) - (end-of-line) - (setq eob (point)) - (prin1 size output) - (setq p (point)) - ;; right-justify the size - (move-to-column 19 t) - (setq col (point)) - (if (> eob col) - (goto-char eob)) - (setq s (- 6 (- p col))) - (while (> s 0) ; speed/consing tradeoff... - (insert ? ) - (setq s (1- s))) - (end-of-line) - (indent-to 27 1) - (insert mode) - (if (not file) - nil - ;; if the mode-name is really long, clip it for the filename - (if (> 0 (setq s (- 39 (current-column)))) - (delete-char (max s (- eob (point))))) - (indent-to 40 1) - (insert file))))) - -;; #### not synched -(defun list-buffers-internal (output &optional predicate) - (let ((current (current-buffer)) - (buffers (buffer-list))) - (save-excursion - (set-buffer output) - (setq buffer-read-only nil) - (erase-buffer) - (buffer-disable-undo output) - (insert list-buffers-header-line) - - (while buffers - (let* ((col1 19) - (buffer (car buffers)) - (name (buffer-name buffer)) - this-buffer-line-start) - (setq buffers (cdr buffers)) - (cond ((null name)) ;deleted buffer - ((and predicate - (not (if (stringp predicate) - (string-match predicate name) - (funcall predicate buffer)))) - nil) - (t - (set-buffer buffer) - (let ((ro buffer-read-only) - (id list-buffers-identification)) - (set-buffer output) - (setq this-buffer-line-start (point)) - (insert (if (eq buffer current) - (progn (setq current (point)) ?\.) - ?\ )) - (insert (if (buffer-modified-p buffer) - ?\* - ?\ )) - (insert (if ro - ?\% - ?\ )) - (if (string-match "[\n\"\\ \t]" name) - (let ((print-escape-newlines t)) - (prin1 name output)) - (insert ?\ name)) - (indent-to col1 1) - (cond ((stringp id) - (insert id)) - (id - (set-buffer buffer) - (condition-case e - (funcall id output) - (error - (princ "***" output) (prin1 e output))) - (set-buffer output) - (goto-char (point-max))))) - (put-nonduplicable-text-property this-buffer-line-start - (point) - 'buffer-name name) - (put-nonduplicable-text-property this-buffer-line-start - (point) - 'highlight t) - (insert ?\n))))) - - (Buffer-menu-mode) - (if (not (bufferp current)) - (goto-char current))))) -;(define-key ctl-x-map "\C-b" 'list-buffers) - -(defun list-buffers (&optional files-only) - "Display a list of names of existing buffers. -The list is displayed in a buffer named `*Buffer List*'. -Note that buffers with names starting with spaces are omitted. -Non-null optional arg FILES-ONLY means mention only file buffers. - -The M column contains a * for buffers that are modified. -The R column contains a % for buffers that are read-only." - (interactive (list (if current-prefix-arg t nil))) ; XEmacs - (display-buffer (list-buffers-noselect files-only))) - -;; #### not synched -(defun list-buffers-noselect (&optional files-only) - "Create and return a buffer with a list of names of existing buffers. -The buffer is named `*Buffer List*'. -Note that buffers with names starting with spaces are omitted. -Non-null optional arg FILES-ONLY means mention only file buffers. - -The M column contains a * for buffers that are modified. -The R column contains a % for buffers that are read-only." - (let ((buffer (get-buffer-create "*Buffer List*"))) - (list-buffers-internal buffer - (if (memq files-only '(t nil)) - #'(lambda (b) - (let ((n (buffer-name b))) - (cond ((and (/= 0 (length n)) - (= (aref n 0) ?\ )) - ;;don't mention if starts with " " - nil) - (files-only - (buffer-file-name b)) - (t - t)))) - files-only)) - buffer)) - -(provide 'buff-menu) - -;;; buff-menu.el ends here diff --git a/lisp/buffer.el b/lisp/buffer.el deleted file mode 100644 index c829284..0000000 --- a/lisp/buffer.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; buffer.el --- buffer routines taken from C - -;; Copyright (C) 1985-1989, 1992-1995, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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 19.30 buffer.c. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun switch-to-buffer (bufname &optional norecord) - "Select buffer BUFNAME in the current window. -BUFNAME may be a buffer or a buffer name and is created if it did not exist. -Optional second arg NORECORD non-nil means do not put this buffer at the -front of the list of recently selected ones. - -WARNING: This is NOT the way to work on another buffer temporarily -within a Lisp program! Use `set-buffer' instead. That avoids messing with -the window-buffer correspondences." - (interactive "BSwitch to buffer: ") - ;; #ifdef I18N3 - ;; #### Doc string should indicate that the buffer name will get - ;; translated. - ;; #endif - (if (eq (minibuffer-window) (selected-window)) - (error "Cannot switch buffers in minibuffer window")) - (if (window-dedicated-p (selected-window)) - (error "Cannot switch buffers in a dedicated window")) - (let (buf) - (if (null bufname) - (setq buf (other-buffer (current-buffer))) - (setq buf (get-buffer bufname)) - (if (null buf) - (progn - (setq buf (get-buffer-create bufname)) - (set-buffer-major-mode buf)))) - (push-window-configuration) - (set-buffer buf) - (or norecord (record-buffer buf)) - (set-window-buffer (if (eq (selected-window) (minibuffer-window)) - (next-window (minibuffer-window)) - (selected-window)) - buf) - buf)) - -(defun pop-to-buffer (bufname &optional not-this-window-p on-frame) - "Select buffer BUFNAME in some window, preferably a different one. -If BUFNAME is nil, then some other buffer is chosen. -If `pop-up-windows' is non-nil, windows can be split to do this. -If optional second arg NOT-THIS-WINDOW-P is non-nil, insist on finding -another window even if BUFNAME is already visible in the selected window. -If optional third arg is non-nil, it is the frame to pop to this -buffer on. -If `focus-follows-mouse' is non-nil, keyboard focus is left unchanged." - ;; #ifdef I18N3 - ;; #### Doc string should indicate that the buffer name will get - ;; translated. - ;; #endif - ;; This is twisted. It is evil to throw the keyboard focus around - ;; willy-nilly if the user wants focus-follows-mouse. - (let ((oldbuf (current-buffer)) - buf window frame) - (if (null bufname) - (setq buf (other-buffer (current-buffer))) - (setq buf (get-buffer bufname)) - (if (null buf) - (progn - (setq buf (get-buffer-create bufname)) - (set-buffer-major-mode buf)))) - (push-window-configuration) - (set-buffer buf) - (setq window (display-buffer buf not-this-window-p on-frame)) - (setq frame (window-frame window)) - ;; if the display-buffer hook decided to show this buffer in another - ;; frame, then select that frame, (unless obeying focus-follows-mouse -sb). - (if (and (not focus-follows-mouse) - (not (eq frame (selected-frame)))) - (select-frame frame)) - (record-buffer buf) - (if (and focus-follows-mouse - on-frame - (not (eq on-frame (selected-frame)))) - (set-buffer oldbuf) - ;; select-window will modify the internal keyboard focus of XEmacs - (select-window window)) - buf)) - -;;; buffer.el ends here diff --git a/lisp/build-report.el b/lisp/build-report.el deleted file mode 100644 index 5e33dc5..0000000 --- a/lisp/build-report.el +++ /dev/null @@ -1,295 +0,0 @@ -;;; build-report.el --- Automatically formatted build reports for XEmacs - -;; Copyright (C) 1997 Adrian Aichner - -;; Author: Adrian Aichner, Teradyne GmbH Munich -;; Date: Sun., Apr. 20, 1997. -;; Version: 1.35 -;; 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: -;; Let XEmacs report interesting aspects of how it was built. - -;; The Concept: -;; User creates an XEmacs Build Report by just calling -;; M-x build-report -;; which will initialize a mail buffer with relevant information -;; derived from the XEmacs build process. Point is left at the -;; beginning of the report for user to input some personal notes and -;; send the report. - -;; The Status: -;; This is the first `Proof of Concept'. - -;; The Author: -;; Adrian Aichner, Teradyne GmbH Munich, Sun., Apr. 20, 1997. - -;;; Code: - -(require 'config) -(provide 'build-report) - -;; Due to recommendation by developers on xemacs-beta@xemacs.org, -;; release versions are to be checked out using `co -u -kv ...'. -(defconst build-report-version - "1.35" - "Version number of build-report.") - -(defgroup build-report nil - "Package automating the process of sending XEmacs Build Reports." - :group 'build) - -(defcustom build-report-destination - "xemacs-build-reports@xemacs.org" - "The mail address XEmacs Build Reports should go to." - :type 'string - :group 'build-report) - -(defcustom build-report-keep-regexp - (list - "make\\[" - "error" - "warn" - "pure.*\\(space\\|size\\)" - "hides\\b" - "strange" - "shadowings" - "^Compilation" - "not\\s-+found") - "Regexp of make process output lines to keep in the report." - :type '(repeat regexp) - :group 'build-report) - -(defcustom build-report-delete-regexp - (list - "confl.*with.*auto-inlining" - (concat (regexp-quote (gethash 'blddir (config-value-hash-table))) "/lisp/[^ \t\n]+ hides ")) - "Regexp of make process output lines to delete from the report." - :type '(repeat regexp) - :group 'build-report) - -(defcustom build-report-make-output-file - (concat (gethash 'blddir (config-value-hash-table)) "/beta.err") - "Filename where stdout and stderr of XEmacs make process have been stored. -mk.err will not be created automatically. You'll have to run make with -output redirection. I use an alias -alias mk 'make \!* >>&\! \!$.err &' -for that, so that I get beta.err went I run `mk beta'." - :type 'file - :group 'build-report) - -(defcustom build-report-installation-file - (concat (gethash 'blddir (config-value-hash-table)) "/Installation") - "Installation file produced by XEmacs configure process." - :type 'file - :group 'build-report) - -(defcustom build-report-installation-insert-all nil - "Tell build-report to insert the whole Installation file -instead of just the last report." - :type 'boolean - :group 'build-report) - -(defcustom build-report-subject - (concat "[%s] " emacs-version " on " system-configuration) - "XEmacs Build Report Subject Line. %s-sequences will be substituted -with user input through `build-report' according to -`build-report-prompts' using `format'." - :type 'string - :group 'build-report) - -(defcustom build-report-prompts - '(("Status?: " "Success" "Failure")) - "XEmacs Build Report Prompt(s). This is a list of prompt-string -lists used by `build-report' in conjunction with -`build-report-subject'. Each list consists of a prompt string -followed by any number of strings which can be chosen via the history -mechanism." - :group 'build-report) - -(defcustom build-report-file-encoding - "7bit" - "XEmacs Build Report File Encoding to be used when MIME support is -available." - :group 'build-report) - -;; Symbol Name mappings from TM to SEMI serving as Compatibility -;; Bandaid -(when (featurep 'mime-setup) - ;; No (defvaralias ...) so far. Thanks to "Didier Verna" - ;; for reporting my incorrect defvaraliasing of - ;; `mime-editor/insert-tag'. - ;; Thanks to Jens-Ulrik Holger Petersen - ;; for suggesting the conditional - ;; aliasing of SEMI functions. - (unless (fboundp 'mime-edit-content-beginning) - (defalias 'mime-edit-content-beginning 'mime-editor/content-beginning)) - (unless (fboundp 'mime-edit-insert-tag) - (defalias 'mime-edit-insert-tag 'mime-editor/insert-tag)) - (unless (fboundp 'mime-edit-insert-binary-file) - (defalias 'mime-edit-insert-binary-file - 'mime-editor/insert-binary-file))) - -(defun build-report (&rest args) - "Initializes a fresh mail composition buffer using `compose-mail' -with the contents of XEmacs Installation file and excerpts from XEmacs -make output and errors and leaves point at the beginning of the mail text. - See also -`compose-mail', `mail-user-agent', -`build-report-destination', -`build-report-keep-regexp', -`build-report-delete-regexp', -`build-report-make-output-file' and -`build-report-installation-file'." - (interactive - (let (prompt - hist - arg - (prompts build-report-prompts)) - (progn - (while prompts - (defvar hist) - (setq prompt (caar prompts)) - (setq hist (cdar prompts)) - (setq prompts (cdr prompts)) - (setq arg (cons (read-string prompt "" 'hist) arg))) - arg))) - (save-excursion - (compose-mail - build-report-destination - (apply 'format build-report-subject args) - nil - nil - nil - nil - nil) - (let ((report-begin (point))) - (insert (build-report-insert-make-output report-begin)) - (insert (build-report-insert-installation-file - report-begin - build-report-installation-insert-all)) - (insert (build-report-insert-header report-begin)) - (goto-char report-begin)))) - -(defun build-report-insert-header (where) - "Inserts the build-report-header at the point specified by `where'." - (goto-char where) - (with-temp-buffer - (insert "\n> XEmacs Build Report as generated\n> by" - " build-report-version " - build-report-version " follows:\n\n") - (buffer-string))) - -(defun build-report-insert-make-output (where) - "Inserts the output of the XEmacs Beta make run. -The make process output must have been saved in -`build-report-make-output-file' during the XEmacs Beta building." - (goto-char where) - (with-temp-buffer - (if (file-exists-p build-report-make-output-file) - (progn - (if (featurep 'mime-setup) - (progn - (mime-edit-insert-tag - "text" - "plain" - (concat - "\nContent-Disposition: attachment;" - " filename=\"" - (file-name-nondirectory - build-report-make-output-file) - "\"")) - (mime-edit-insert-binary-file - build-report-make-output-file - build-report-file-encoding)) - (insert-file-contents build-report-make-output-file)) - (goto-char (point-min)) - (delete-non-matching-lines (build-report-keep)) - (goto-char (point-min)) - (delete-matching-lines (build-report-delete)) - (goto-char (point-min)) - (insert "> Contents of " - build-report-make-output-file - "\n> keeping lines matching\n> \"" - (build-report-keep) - "\"\n> and then deleting lines matching\n> \"" - (build-report-delete) - "\"\n\n")) - (insert "> " build-report-make-output-file - " does not exist!\n\n")) - (buffer-string))) - -(defun build-report-insert-installation-file (where all) - "Inserts the contents of the `build-report-installation-file' -created by the XEmacs Beta configure process." - (goto-char where) - (with-temp-buffer - (if (file-exists-p build-report-installation-file) - (let (file-begin last-configure) - (insert "> Contents of " - build-report-installation-file - ":\n") - (insert - (format - "> (Output from %s of ./configure)\n\n" - (if all "all runs" "most recent run"))) - (if (featurep 'mime-setup) - (progn - (mime-edit-insert-tag - "text" - "plain" - (concat - "\nContent-Disposition: attachment;" - " filename=\"" - (file-name-nondirectory - build-report-installation-file) - "\"")) - (mime-edit-insert-binary-file - build-report-installation-file - build-report-file-encoding) - (setq file-begin (mime-edit-content-beginning))) - (setq file-begin (point)) - (insert-file-contents - build-report-installation-file)) - (unless all - (setq last-configure - (search-backward-regexp - "^\\(uname.*\\|osversion\\):\\s-+" file-begin t)) - (if (and file-begin last-configure) - (delete-region file-begin last-configure)))) - (insert "> " build-report-installation-file - " does not exist!\n\n")) - (buffer-string))) - -(defun build-report-keep () - "build-report-internal function of no general value." - (mapconcat #'identity - (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|")) - -(defun build-report-delete () - "build-report-internal function of no general value." - (mapconcat #'identity - build-report-delete-regexp "\\|")) - -;;; build-report.el ends here diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el deleted file mode 100644 index 95e7cb4..0000000 --- a/lisp/byte-optimize.el +++ /dev/null @@ -1,1991 +0,0 @@ -;;; byte-optimize.el --- the optimization passes of the emacs-lisp byte compiler. - -;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski -;; Hallvard Furuseth -;; 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: FSF 19.30. - -;;; Commentary: - -;; ======================================================================== -;; "No matter how hard you try, you can't make a racehorse out of a pig. -;; You can, however, make a faster pig." -;; -;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code -;; makes it be a VW Bug with fuel injection and a turbocharger... You're -;; still not going to make it go faster than 70 mph, but it might be easier -;; to get it there. -;; - -;; TO DO: -;; -;; (apply #'(lambda (x &rest y) ...) 1 (foo)) -;; -;; maintain a list of functions known not to access any global variables -;; (actually, give them a 'dynamically-safe property) and then -;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==> -;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> ) -;; by recursing on this, we might be able to eliminate the entire let. -;; However certain variables should never have their bindings optimized -;; away, because they affect everything. -;; (put 'debug-on-error 'binding-is-magic t) -;; (put 'debug-on-abort 'binding-is-magic t) -;; (put 'debug-on-next-call 'binding-is-magic t) -;; (put 'mocklisp-arguments 'binding-is-magic t) -;; (put 'inhibit-quit 'binding-is-magic t) -;; (put 'quit-flag 'binding-is-magic t) -;; (put 't 'binding-is-magic t) -;; (put 'nil 'binding-is-magic t) -;; possibly also -;; (put 'gc-cons-threshold 'binding-is-magic t) -;; (put 'track-mouse 'binding-is-magic t) -;; others? -;; -;; Simple defsubsts often produce forms like -;; (let ((v1 (f1)) (v2 (f2)) ...) -;; (FN v1 v2 ...)) -;; It would be nice if we could optimize this to -;; (FN (f1) (f2) ...) -;; but we can't unless FN is dynamically-safe (it might be dynamically -;; referring to the bindings that the lambda arglist established.) -;; One of the uncountable lossages introduced by dynamic scope... -;; -;; Maybe there should be a control-structure that says "turn on -;; fast-and-loose type-assumptive optimizations here." Then when -;; we see a form like (car foo) we can from then on assume that -;; the variable foo is of type cons, and optimize based on that. -;; But, this won't win much because of (you guessed it) dynamic -;; scope. Anything down the stack could change the value. -;; (Another reason it doesn't work is that it is perfectly valid -;; to call car with a null argument.) A better approach might -;; be to allow type-specification of the form -;; (put 'foo 'arg-types '(float (list integer) dynamic)) -;; (put 'foo 'result-type 'bool) -;; It should be possible to have these types checked to a certain -;; degree. -;; -;; collapse common subexpressions -;; -;; It would be nice if redundant sequences could be factored out as well, -;; when they are known to have no side-effects: -;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2 -;; but beware of traps like -;; (cons (list x y) (list x y)) -;; -;; Tail-recursion elimination is not really possible in Emacs Lisp. -;; Tail-recursion elimination is almost always impossible when all variables -;; have dynamic scope, but given that the "return" byteop requires the -;; binding stack to be empty (rather than emptying it itself), there can be -;; no truly tail-recursive Emacs Lisp functions that take any arguments or -;; make any bindings. -;; -;; Here is an example of an Emacs Lisp function which could safely be -;; byte-compiled tail-recursively: -;; -;; (defun tail-map (fn list) -;; (cond (list -;; (funcall fn (car list)) -;; (tail-map fn (cdr list))))) -;; -;; However, if there was even a single let-binding around the COND, -;; it could not be byte-compiled, because there would be an "unbind" -;; byte-op between the final "call" and "return." Adding a -;; Bunbind_all byteop would fix this. -;; -;; (defun foo (x y z) ... (foo a b c)) -;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return) -;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return) -;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return) -;; -;; this also can be considered tail recursion: -;; -;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return) -;; could generalize this by doing the optimization -;; (goto X) ... X: (return) --> (return) -;; -;; But this doesn't solve all of the problems: although by doing tail- -;; recursion elimination in this way, the call-stack does not grow, the -;; binding-stack would grow with each recursive step, and would eventually -;; overflow. I don't believe there is any way around this without lexical -;; scope. -;; -;; Wouldn't it be nice if Emacs Lisp had lexical scope. -;; -;; Idea: the form (lexical-scope) in a file means that the file may be -;; compiled lexically. This proclamation is file-local. Then, within -;; that file, "let" would establish lexical bindings, and "let-dynamic" -;; would do things the old way. (Or we could use CL "declare" forms.) -;; We'd have to notice defvars and defconsts, since those variables should -;; always be dynamic, and attempting to do a lexical binding of them -;; should simply do a dynamic binding instead. -;; But! We need to know about variables that were not necessarily defvarred -;; in the file being compiled (doing a boundp check isn't good enough.) -;; Fdefvar() would have to be modified to add something to the plist. -;; -;; A major disadvantage of this scheme is that the interpreter and compiler -;; would have different semantics for files compiled with (dynamic-scope). -;; Since this would be a file-local optimization, there would be no way to -;; modify the interpreter to obey this (unless the loader was hacked -;; in some grody way, but that's a really bad idea.) -;; -;; HA! RMS removed the following paragraph from his version of -;; byte-optimize.el. -;; -;; Really the Right Thing is to make lexical scope the default across -;; the board, in the interpreter and compiler, and just FIX all of -;; the code that relies on dynamic scope of non-defvarred variables. - -;; Other things to consider: - -;; Associative math should recognize subcalls to identical function: -;;(disassemble #'(lambda (x) (+ (+ (foo) 1) (+ (bar) 2)))) -;; This should generate the same as (1+ x) and (1- x) - -;;(disassemble #'(lambda (x) (cons (+ x 1) (- x 1)))) -;; An awful lot of functions always return a non-nil value. If they're -;; error free also they may act as true-constants. - -;;(disassemble #'(lambda (x) (and (point) (foo)))) -;; When -;; - all but one arguments to a function are constant -;; - the non-constant argument is an if-expression (cond-expression?) -;; then the outer function can be distributed. If the guarding -;; condition is side-effect-free [assignment-free] then the other -;; arguments may be any expressions. Since, however, the code size -;; can increase this way they should be "simple". Compare: - -;;(disassemble #'(lambda (x) (eq (if (point) 'a 'b) 'c))) -;;(disassemble #'(lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) - -;; (car (cons A B)) -> (progn B A) -;;(disassemble #'(lambda (x) (car (cons (foo) 42)))) - -;; (cdr (cons A B)) -> (progn A B) -;;(disassemble #'(lambda (x) (cdr (cons 42 (foo))))) - -;; (car (list A B ...)) -> (progn B ... A) -;;(disassemble #'(lambda (x) (car (list (foo) 42 (bar))))) - -;; (cdr (list A B ...)) -> (progn A (list B ...)) -;;(disassemble #'(lambda (x) (cdr (list 42 (foo) (bar))))) - - -;;; Code: - -(require 'byte-compile "bytecomp") - -(defun byte-compile-log-lap-1 (format &rest args) - (if (aref byte-code-vector 0) - (error "The old version of the disassembler is loaded. Reload new-bytecomp as well.")) - (byte-compile-log-1 - (apply 'format format - (let (c a) - (mapcar - #'(lambda (arg) - (if (not (consp arg)) - (if (and (symbolp arg) - (string-match "^byte-" (symbol-name arg))) - (intern (substring (symbol-name arg) 5)) - arg) - (if (integerp (setq c (car arg))) - (error "non-symbolic byte-op %s" c)) - (if (eq c 'TAG) - (setq c arg) - (setq a (cond ((memq c byte-goto-ops) - (car (cdr (cdr arg)))) - ((memq c byte-constref-ops) - (car (cdr arg))) - (t (cdr arg)))) - (setq c (symbol-name c)) - (if (string-match "^byte-." c) - (setq c (intern (substring c 5))))) - (if (eq c 'constant) (setq c 'const)) - (if (and (eq (cdr arg) 0) - (not (memq c '(unbind call const)))) - c - (format "(%s %s)" c a)))) - args))))) - -(defmacro byte-compile-log-lap (format-string &rest args) - (list 'and - '(memq byte-optimize-log '(t byte)) - (cons 'byte-compile-log-lap-1 - (cons format-string args)))) - - -;;; byte-compile optimizers to support inlining - -(put 'inline 'byte-optimizer 'byte-optimize-inline-handler) - -(defun byte-optimize-inline-handler (form) - "byte-optimize-handler for the `inline' special-form." - (cons - 'progn - (mapcar - #'(lambda (sexp) - (let ((fn (car-safe sexp))) - (if (and (symbolp fn) - (or (cdr (assq fn byte-compile-function-environment)) - (and (fboundp fn) - (not (or (cdr (assq fn byte-compile-macro-environment)) - (and (consp (setq fn (symbol-function fn))) - (eq (car fn) 'macro)) - (subrp fn)))))) - (byte-compile-inline-expand sexp) - sexp))) - (cdr form)))) - - -;; Splice the given lap code into the current instruction stream. -;; If it has any labels in it, you're responsible for making sure there -;; are no collisions, and that byte-compile-tag-number is reasonable -;; after this is spliced in. The provided list is destroyed. -(defun byte-inline-lapcode (lap) - (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))) - - -(defun byte-compile-inline-expand (form) - (let* ((name (car form)) - (fn (or (cdr (assq name byte-compile-function-environment)) - (and (fboundp name) (symbol-function name))))) - (if (null fn) - (progn - (byte-compile-warn "attempt to inline %s before it was defined" name) - form) - ;; else - (if (and (consp fn) (eq (car fn) 'autoload)) - (progn - (load (nth 1 fn)) - (setq fn (or (cdr (assq name byte-compile-function-environment)) - (and (fboundp name) (symbol-function name)))))) - (if (and (consp fn) (eq (car fn) 'autoload)) - (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name)) - (if (symbolp fn) - (byte-compile-inline-expand (cons fn (cdr form))) - (if (compiled-function-p fn) - (progn - (fetch-bytecode fn) - (cons (list 'lambda (compiled-function-arglist fn) - (list 'byte-code - (compiled-function-instructions fn) - (compiled-function-constants fn) - (compiled-function-stack-depth fn))) - (cdr form))) - (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name)) - (cons fn (cdr form))))))) - -;;; ((lambda ...) ...) -;;; -(defun byte-compile-unfold-lambda (form &optional name) - (or name (setq name "anonymous lambda")) - (let ((lambda (car form)) - (values (cdr form))) - (if (compiled-function-p lambda) - (setq lambda (list 'lambda (compiled-function-arglist lambda) - (list 'byte-code - (compiled-function-instructions lambda) - (compiled-function-constants lambda) - (compiled-function-stack-depth lambda))))) - (let ((arglist (nth 1 lambda)) - (body (cdr (cdr lambda))) - optionalp restp - bindings) - (if (and (stringp (car body)) (cdr body)) - (setq body (cdr body))) - (if (and (consp (car body)) (eq 'interactive (car (car body)))) - (setq body (cdr body))) - (while arglist - (cond ((eq (car arglist) '&optional) - ;; ok, I'll let this slide because funcall_lambda() does... - ;; (if optionalp (error "multiple &optional keywords in %s" name)) - (if restp (error "&optional found after &rest in %s" name)) - (if (null (cdr arglist)) - (error "nothing after &optional in %s" name)) - (setq optionalp t)) - ((eq (car arglist) '&rest) - ;; ...but it is by no stretch of the imagination a reasonable - ;; thing that funcall_lambda() allows (&rest x y) and - ;; (&rest x &optional y) in arglists. - (if (null (cdr arglist)) - (error "nothing after &rest in %s" name)) - (if (cdr (cdr arglist)) - (error "multiple vars after &rest in %s" name)) - (setq restp t)) - (restp - (setq bindings (cons (list (car arglist) - (and values (cons 'list values))) - bindings) - values nil)) - ((and (not optionalp) (null values)) - (byte-compile-warn "attempt to open-code %s with too few arguments" name) - (setq arglist nil values 'too-few)) - (t - (setq bindings (cons (list (car arglist) (car values)) - bindings) - values (cdr values)))) - (setq arglist (cdr arglist))) - (if values - (progn - (or (eq values 'too-few) - (byte-compile-warn - "attempt to open-code %s with too many arguments" name)) - form) - (let ((newform - (if bindings - (cons 'let (cons (nreverse bindings) body)) - (cons 'progn body)))) - (byte-compile-log " %s\t==>\t%s" form newform) - newform))))) - - -;;; implementing source-level optimizers - -(defun byte-optimize-form-code-walker (form for-effect) - ;; - ;; For normal function calls, We can just mapcar the optimizer the cdr. But - ;; we need to have special knowledge of the syntax of the special forms - ;; like let and defun (that's why they're special forms :-). (Actually, - ;; the important aspect is that they are subrs that don't evaluate all of - ;; their args.) - ;; - (let ((fn (car-safe form)) - tmp) - (cond ((not (consp form)) - (if (not (and for-effect - (or byte-compile-delete-errors - (not (symbolp form)) - (eq form t)))) - form)) - ((eq fn 'quote) - (if (cdr (cdr form)) - (byte-compile-warn "malformed quote form: %s" - (prin1-to-string form))) - ;; map (quote nil) to nil to simplify optimizer logic. - ;; map quoted constants to nil if for-effect (just because). - (and (nth 1 form) - (not for-effect) - form)) - ((or (compiled-function-p fn) - (eq 'lambda (car-safe fn))) - (byte-compile-unfold-lambda form)) - ((memq fn '(let let*)) - ;; recursively enter the optimizer for the bindings and body - ;; of a let or let*. This for depth-firstness: forms that - ;; are more deeply nested are optimized first. - (cons fn - (cons - (mapcar - #'(lambda (binding) - (if (symbolp binding) - binding - (if (cdr (cdr binding)) - (byte-compile-warn "malformed let binding: %s" - (prin1-to-string binding))) - (list (car binding) - (byte-optimize-form (nth 1 binding) nil)))) - (nth 1 form)) - (byte-optimize-body (cdr (cdr form)) for-effect)))) - ((eq fn 'cond) - (cons fn - (mapcar - #'(lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: %s" - (prin1-to-string clause)) - clause)) - (cdr form)))) - ((eq fn 'progn) - ;; as an extra added bonus, this simplifies (progn ) --> - (if (cdr (cdr form)) - (progn - (setq tmp (byte-optimize-body (cdr form) for-effect)) - (if (cdr tmp) (cons 'progn tmp) (car tmp))) - (byte-optimize-form (nth 1 form) for-effect))) - ((eq fn 'prog1) - (if (cdr (cdr form)) - (cons 'prog1 - (cons (byte-optimize-form (nth 1 form) for-effect) - (byte-optimize-body (cdr (cdr form)) t))) - (byte-optimize-form (nth 1 form) for-effect))) - ((eq fn 'prog2) - (cons 'prog2 - (cons (byte-optimize-form (nth 1 form) t) - (cons (byte-optimize-form (nth 2 form) for-effect) - (byte-optimize-body (cdr (cdr (cdr form))) t))))) - - ((memq fn '(save-excursion save-restriction save-current-buffer)) - ;; those subrs which have an implicit progn; it's not quite good - ;; enough to treat these like normal function calls. - ;; This can turn (save-excursion ...) into (save-excursion) which - ;; will be optimized away in the lap-optimize pass. - (cons fn (byte-optimize-body (cdr form) for-effect))) - - ((eq fn 'with-output-to-temp-buffer) - ;; this is just like the above, except for the first argument. - (cons fn - (cons - (byte-optimize-form (nth 1 form) nil) - (byte-optimize-body (cdr (cdr form)) for-effect)))) - - ((eq fn 'if) - (cons fn - (cons (byte-optimize-form (nth 1 form) nil) - (cons - (byte-optimize-form (nth 2 form) for-effect) - (byte-optimize-body (nthcdr 3 form) for-effect))))) - - ((memq fn '(and or)) ; remember, and/or are control structures. - ;; take forms off the back until we can't any more. - ;; In the future it could conceivably be a problem that the - ;; subexpressions of these forms are optimized in the reverse - ;; order, but it's ok for now. - (if for-effect - (let ((backwards (reverse (cdr form)))) - (while (and backwards - (null (setcar backwards - (byte-optimize-form (car backwards) - for-effect)))) - (setq backwards (cdr backwards))) - (if (and (cdr form) (null backwards)) - (byte-compile-log - " all subforms of %s called for effect; deleted" form)) - (and backwards - (cons fn (nreverse backwards)))) - (cons fn (mapcar 'byte-optimize-form (cdr form))))) - - ((eq fn 'interactive) - (byte-compile-warn "misplaced interactive spec: %s" - (prin1-to-string form)) - nil) - - ((memq fn '(defun defmacro function - condition-case save-window-excursion)) - ;; These forms are compiled as constants or by breaking out - ;; all the subexpressions and compiling them separately. - form) - - ((eq fn 'unwind-protect) - ;; the "protected" part of an unwind-protect is compiled (and thus - ;; optimized) as a top-level form, so don't do it here. But the - ;; non-protected part has the same for-effect status as the - ;; unwind-protect itself. (The protected part is always for effect, - ;; but that isn't handled properly yet.) - (cons fn - (cons (byte-optimize-form (nth 1 form) for-effect) - (cdr (cdr form))))) - - ((eq fn 'catch) - ;; the body of a catch is compiled (and thus optimized) as a - ;; top-level form, so don't do it here. The tag is never - ;; for-effect. The body should have the same for-effect status - ;; as the catch form itself, but that isn't handled properly yet. - (cons fn - (cons (byte-optimize-form (nth 1 form) nil) - (cdr (cdr form))))) - - ;; If optimization is on, this is the only place that macros are - ;; expanded. If optimization is off, then macroexpansion happens - ;; in byte-compile-form. Otherwise, the macros are already expanded - ;; by the time that is reached. - ((not (eq form - (setq form (macroexpand form - byte-compile-macro-environment)))) - (byte-optimize-form form for-effect)) - - ((not (symbolp fn)) - (or (eq 'mocklisp (car-safe fn)) ; ha! - (byte-compile-warn "%s is a malformed function" - (prin1-to-string fn))) - form) - - ((and for-effect (setq tmp (get fn 'side-effect-free)) - (or byte-compile-delete-errors - (eq tmp 'error-free) - (progn - (byte-compile-warn "%s called for effect" - (prin1-to-string form)) - nil))) - (byte-compile-log " %s called for effect; deleted" fn) - ;; appending a nil here might not be necessary, but it can't hurt. - (byte-optimize-form - (cons 'progn (append (cdr form) '(nil))) t)) - - (t - ;; Otherwise, no args can be considered to be for-effect, - ;; even if the called function is for-effect, because we - ;; don't know anything about that function. - (cons fn (mapcar 'byte-optimize-form (cdr form))))))) - - -(defun byte-optimize-form (form &optional for-effect) - "The source-level pass of the optimizer." - ;; - ;; First, optimize all sub-forms of this one. - (setq form (byte-optimize-form-code-walker form for-effect)) - ;; - ;; After optimizing all subforms, optimize this form until it doesn't - ;; optimize any further. This means that some forms will be passed through - ;; the optimizer many times, but that's necessary to make the for-effect - ;; processing do as much as possible. - ;; - (let (opt new) - (if (and (consp form) - (symbolp (car form)) - (or (and for-effect - ;; we don't have any of these yet, but we might. - (setq opt (get (car form) 'byte-for-effect-optimizer))) - (setq opt (get (car form) 'byte-optimizer))) - (not (eq form (setq new (funcall opt form))))) - (progn -;; (if (equal form new) (error "bogus optimizer -- %s" opt)) - (byte-compile-log " %s\t==>\t%s" form new) - (setq new (byte-optimize-form new for-effect)) - new) - form))) - - -(defun byte-optimize-body (forms all-for-effect) - ;; Optimize the cdr of a progn or implicit progn; `forms' is a list of - ;; forms, all but the last of which are optimized with the assumption that - ;; they are being called for effect. The last is for-effect as well if - ;; all-for-effect is true. Returns a new list of forms. - (let ((rest forms) - (result nil) - fe new) - (while rest - (setq fe (or all-for-effect (cdr rest))) - (setq new (and (car rest) (byte-optimize-form (car rest) fe))) - (if (or new (not fe)) - (setq result (cons new result))) - (setq rest (cdr rest))) - (nreverse result))) - - -;;; some source-level optimizers -;;; -;;; when writing optimizers, be VERY careful that the optimizer returns -;;; something not EQ to its argument if and ONLY if it has made a change. -;;; This implies that you cannot simply destructively modify the list; -;;; you must return something not EQ to it if you make an optimization. -;;; -;;; It is now safe to optimize code such that it introduces new bindings. - -;; I'd like this to be a defsubst, but let's not be self-referential... -(defmacro byte-compile-trueconstp (form) - ;; Returns non-nil if FORM is a non-nil constant. - `(cond ((consp ,form) (eq (car ,form) 'quote)) - ((not (symbolp ,form))) - ((eq ,form t)) - ((keywordp ,form)))) - -;; If the function is being called with constant numeric args, -;; evaluate as much as possible at compile-time. This optimizer -;; assumes that the function is associative, like + or *. -(defun byte-optimize-associative-math (form) - (let ((args nil) - (constants nil) - (rest (cdr form))) - (while rest - (if (numberp (car rest)) - (setq constants (cons (car rest) constants)) - (setq args (cons (car rest) args))) - (setq rest (cdr rest))) - (if (cdr constants) - (if args - (list (car form) - (apply (car form) constants) - (if (cdr args) - (cons (car form) (nreverse args)) - (car args))) - (apply (car form) constants)) - form))) - -;; If the function is being called with constant numeric args, -;; evaluate as much as possible at compile-time. This optimizer -;; assumes that the function satisfies -;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn) -;; like - and /. -(defun byte-optimize-nonassociative-math (form) - (if (or (not (numberp (car (cdr form)))) - (not (numberp (car (cdr (cdr form)))))) - form - (let ((constant (car (cdr form))) - (rest (cdr (cdr form)))) - (while (numberp (car rest)) - (setq constant (funcall (car form) constant (car rest)) - rest (cdr rest))) - (if rest - (cons (car form) (cons constant rest)) - constant)))) - -;;(defun byte-optimize-associative-two-args-math (form) -;; (setq form (byte-optimize-associative-math form)) -;; (if (consp form) -;; (byte-optimize-two-args-left form) -;; form)) - -;;(defun byte-optimize-nonassociative-two-args-math (form) -;; (setq form (byte-optimize-nonassociative-math form)) -;; (if (consp form) -;; (byte-optimize-two-args-right form) -;; form)) - -;; jwz: (byte-optimize-approx-equal 0.0 0.0) was returning nil -;; in xemacs 19.15 because it used < instead of <=. -(defun byte-optimize-approx-equal (x y) - (<= (* (abs (- x y)) 100) (abs (+ x y)))) - -;; Collect all the constants from FORM, after the STARTth arg, -;; and apply FUN to them to make one argument at the end. -;; For functions that can handle floats, that optimization -;; can be incorrect because reordering can cause an overflow -;; that would otherwise be avoided by encountering an arg that is a float. -;; We avoid this problem by (1) not moving float constants and -;; (2) not moving anything if it would cause an overflow. -(defun byte-optimize-delay-constants-math (form start fun) - ;; Merge all FORM's constants from number START, call FUN on them - ;; and put the result at the end. - (let ((rest (nthcdr (1- start) form)) - (orig form) - ;; t means we must check for overflow. - (overflow (memq fun '(+ *)))) - (while (cdr (setq rest (cdr rest))) - (if (integerp (car rest)) - (let (constants) - (setq form (copy-sequence form) - rest (nthcdr (1- start) form)) - (while (setq rest (cdr rest)) - (cond ((integerp (car rest)) - (setq constants (cons (car rest) constants)) - (setcar rest nil)))) - ;; If necessary, check now for overflow - ;; that might be caused by reordering. - (if (and overflow - ;; We have overflow if the result of doing the arithmetic - ;; on floats is not even close to the result - ;; of doing it on integers. - (not (byte-optimize-approx-equal - (apply fun (mapcar 'float constants)) - (float (apply fun constants))))) - (setq form orig) - (setq form (nconc (delq nil form) - (list (apply fun (nreverse constants))))))))) - form)) - -(defun byte-optimize-plus (form) - (setq form (byte-optimize-delay-constants-math form 1 '+)) - (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) - ;;(setq form (byte-optimize-associative-two-args-math form)) - (cond ((null (cdr form)) - (condition-case () - (eval form) - (error form))) - - ;; `add1' and `sub1' are a marginally fewer instructions - ;; than `plus' and `minus', so use them when possible. - ((and (null (nthcdr 3 form)) - (eq (nth 2 form) 1)) - (list '1+ (nth 1 form))) ; (+ x 1) --> (1+ x) - ((and (null (nthcdr 3 form)) - (eq (nth 1 form) 1)) - (list '1+ (nth 2 form))) ; (+ 1 x) --> (1+ x) - ((and (null (nthcdr 3 form)) - (eq (nth 2 form) -1)) - (list '1- (nth 1 form))) ; (+ x -1) --> (1- x) - ((and (null (nthcdr 3 form)) - (eq (nth 1 form) -1)) - (list '1- (nth 2 form))) ; (+ -1 x) --> (1- x) - -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker). -;; ((null (cdr (cdr form))) (nth 1 form)) - (t form))) - -(defun byte-optimize-minus (form) - ;; Put constants at the end, except the last constant. - (setq form (byte-optimize-delay-constants-math form 2 '+)) - ;; Now only first and last element can be a number. - (let ((last (car (reverse (nthcdr 3 form))))) - (cond ((eq 0 last) - ;; (- x y ... 0) --> (- x y ...) - (setq form (copy-sequence form)) - (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form)))) - ;; If form is (- CONST foo... CONST), merge first and last. - ((and (numberp (nth 1 form)) - (numberp last)) - (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) - (delq last (copy-sequence (nthcdr 3 form)))))))) - (setq form -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker). -;;; (if (eq (nth 2 form) 0) -;;; (nth 1 form) ; (- x 0) --> x - (byte-optimize-predicate - (if (and (null (cdr (cdr (cdr form)))) - (eq (nth 1 form) 0)) ; (- 0 x) --> (- x) - (cons (car form) (cdr (cdr form))) - form)) -;;; ) - ) - - ;; `add1' and `sub1' are a marginally fewer instructions than `plus' - ;; and `minus', so use them when possible. - (cond ((and (null (nthcdr 3 form)) - (eq (nth 2 form) 1)) - (list '1- (nth 1 form))) ; (- x 1) --> (1- x) - ((and (null (nthcdr 3 form)) - (eq (nth 2 form) -1)) - (list '1+ (nth 1 form))) ; (- x -1) --> (1+ x) - (t - form)) - ) - -(defun byte-optimize-multiply (form) - (setq form (byte-optimize-delay-constants-math form 1 '*)) - ;; If there is a constant in FORM, it is now the last element. - (cond ((null (cdr form)) 1) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker or if it appears in other arithmetic). -;;; ((null (cdr (cdr form))) (nth 1 form)) - ((let ((last (car (reverse form)))) - (cond ((eq 0 last) (cons 'progn (cdr form))) - ((eq 1 last) (delq 1 (copy-sequence form))) - ((eq -1 last) (list '- (delq -1 (copy-sequence form)))) - ((and (eq 2 last) - (memq t (mapcar 'symbolp (cdr form)))) - (prog1 (setq form (delq 2 (copy-sequence form))) - (while (not (symbolp (car (setq form (cdr form)))))) - (setcar form (list '+ (car form) (car form))))) - (form)))))) - -(defsubst byte-compile-butlast (form) - (nreverse (cdr (reverse form)))) - -(defun byte-optimize-divide (form) - (setq form (byte-optimize-delay-constants-math form 2 '*)) - (let ((last (car (reverse (cdr (cdr form)))))) - (if (numberp last) - (cond ((= (length form) 3) - (if (and (numberp (nth 1 form)) - (not (zerop last)) - (condition-case nil - (/ (nth 1 form) last) - (error nil))) - (setq form (list 'progn (/ (nth 1 form) last))))) - ((= last 1) - (setq form (byte-compile-butlast form))) - ((numberp (nth 1 form)) - (setq form (cons (car form) - (cons (/ (nth 1 form) last) - (byte-compile-butlast (cdr (cdr form))))) - last nil)))) - (cond -;;; ((null (cdr (cdr form))) -;;; (nth 1 form)) - ((eq (nth 1 form) 0) - (append '(progn) (cdr (cdr form)) '(0))) - ((eq last -1) - (list '- (if (nthcdr 3 form) - (byte-compile-butlast form) - (nth 1 form)))) - (form)))) - -(defun byte-optimize-logmumble (form) - (setq form (byte-optimize-delay-constants-math form 1 (car form))) - (byte-optimize-predicate - (cond ((memq 0 form) - (setq form (if (eq (car form) 'logand) - (cons 'progn (cdr form)) - (delq 0 (copy-sequence form))))) - ((and (eq (car-safe form) 'logior) - (memq -1 form)) - (cons 'progn (cdr form))) - (form)))) - - -(defun byte-optimize-binary-predicate (form) - (if (byte-compile-constp (nth 1 form)) - (if (byte-compile-constp (nth 2 form)) - (condition-case () - (list 'quote (eval form)) - (error form)) - ;; This can enable some lapcode optimizations. - (list (car form) (nth 2 form) (nth 1 form))) - form)) - -(defun byte-optimize-predicate (form) - (let ((ok t) - (rest (cdr form))) - (while (and rest ok) - (setq ok (byte-compile-constp (car rest)) - rest (cdr rest))) - (if ok - (condition-case () - (list 'quote (eval form)) - (error form)) - form))) - -(defun byte-optimize-identity (form) - (if (and (cdr form) (null (cdr (cdr form)))) - (nth 1 form) - (byte-compile-warn "identity called with %d arg%s, but requires 1" - (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s")) - form)) - -(put 'identity 'byte-optimizer 'byte-optimize-identity) - -(put '+ 'byte-optimizer 'byte-optimize-plus) -(put '* 'byte-optimizer 'byte-optimize-multiply) -(put '- 'byte-optimizer 'byte-optimize-minus) -(put '/ 'byte-optimizer 'byte-optimize-divide) -(put 'max 'byte-optimizer 'byte-optimize-associative-math) -(put 'min 'byte-optimizer 'byte-optimize-associative-math) - -(put '= 'byte-optimizer 'byte-optimize-binary-predicate) -(put 'eq 'byte-optimizer 'byte-optimize-binary-predicate) -(put 'eql 'byte-optimizer 'byte-optimize-binary-predicate) -(put 'equal 'byte-optimizer 'byte-optimize-binary-predicate) -(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) -(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) - -(put '< 'byte-optimizer 'byte-optimize-predicate) -(put '> 'byte-optimizer 'byte-optimize-predicate) -(put '<= 'byte-optimizer 'byte-optimize-predicate) -(put '>= 'byte-optimizer 'byte-optimize-predicate) -(put '1+ 'byte-optimizer 'byte-optimize-predicate) -(put '1- 'byte-optimizer 'byte-optimize-predicate) -(put 'not 'byte-optimizer 'byte-optimize-predicate) -(put 'null 'byte-optimizer 'byte-optimize-predicate) -(put 'memq 'byte-optimizer 'byte-optimize-predicate) -(put 'consp 'byte-optimizer 'byte-optimize-predicate) -(put 'listp 'byte-optimizer 'byte-optimize-predicate) -(put 'symbolp 'byte-optimizer 'byte-optimize-predicate) -(put 'stringp 'byte-optimizer 'byte-optimize-predicate) -(put 'string< 'byte-optimizer 'byte-optimize-predicate) -(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) - -(put 'logand 'byte-optimizer 'byte-optimize-logmumble) -(put 'logior 'byte-optimizer 'byte-optimize-logmumble) -(put 'logxor 'byte-optimizer 'byte-optimize-logmumble) -(put 'lognot 'byte-optimizer 'byte-optimize-predicate) - -(put 'car 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr 'byte-optimizer 'byte-optimize-predicate) -(put 'car-safe 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) - - -;; I'm not convinced that this is necessary. Doesn't the optimizer loop -;; take care of this? - Jamie -;; I think this may some times be necessary to reduce eg. (quote 5) to 5, -;; so arithmetic optimizers recognize the numeric constant. - Hallvard -(put 'quote 'byte-optimizer 'byte-optimize-quote) -(defun byte-optimize-quote (form) - (if (or (consp (nth 1 form)) - (and (symbolp (nth 1 form)) - ;; XEmacs addition: - (not (keywordp (nth 1 form))) - (not (memq (nth 1 form) '(nil t))))) - form - (nth 1 form))) - -(defun byte-optimize-zerop (form) - (cond ((numberp (nth 1 form)) - (eval form)) - (byte-compile-delete-errors - (list '= (nth 1 form) 0)) - (form))) - -(put 'zerop 'byte-optimizer 'byte-optimize-zerop) - -(defun byte-optimize-and (form) - ;; Simplify if less than 2 args. - ;; if there is a literal nil in the args to `and', throw it and following - ;; forms away, and surround the `and' with (progn ... nil). - (cond ((null (cdr form))) - ((memq nil form) - (list 'progn - (byte-optimize-and - (prog1 (setq form (copy-sequence form)) - (while (nth 1 form) - (setq form (cdr form))) - (setcdr form nil))) - nil)) - ((null (cdr (cdr form))) - (nth 1 form)) - ((byte-optimize-predicate form)))) - -(defun byte-optimize-or (form) - ;; Throw away nil's, and simplify if less than 2 args. - ;; If there is a literal non-nil constant in the args to `or', throw away all - ;; following forms. - (if (memq nil form) - (setq form (delq nil (copy-sequence form)))) - (let ((rest form)) - (while (cdr (setq rest (cdr rest))) - (if (byte-compile-trueconstp (car rest)) - (setq form (copy-sequence form) - rest (setcdr (memq (car rest) form) nil)))) - (if (cdr (cdr form)) - (byte-optimize-predicate form) - (nth 1 form)))) - -(defun byte-optimize-cond (form) - ;; if any clauses have a literal nil as their test, throw them away. - ;; if any clause has a literal non-nil constant as its test, throw - ;; away all following clauses. - (let (rest) - ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...) - (while (setq rest (assq nil (cdr form))) - (setq form (delq rest (copy-sequence form)))) - (if (memq nil (cdr form)) - (setq form (delq nil (copy-sequence form)))) - (setq rest form) - (while (setq rest (cdr rest)) - (cond ((byte-compile-trueconstp (car-safe (car rest))) - (cond ((eq rest (cdr form)) - (setq form - (if (cdr (car rest)) - (if (cdr (cdr (car rest))) - (cons 'progn (cdr (car rest))) - (nth 1 (car rest))) - (car (car rest))))) - ((cdr rest) - (setq form (copy-sequence form)) - (setcdr (memq (car rest) form) nil))) - (setq rest nil))))) - ;; - ;; Turn (cond (( )) ... ) into (or (cond ... )) - (if (eq 'cond (car-safe form)) - (let ((clauses (cdr form))) - (if (and (consp (car clauses)) - (null (cdr (car clauses)))) - (list 'or (car (car clauses)) - (byte-optimize-cond - (cons (car form) (cdr (cdr form))))) - form)) - form)) - -(defun byte-optimize-if (form) - ;; (if ) ==> - ;; (if ) ==> (progn ) - ;; (if nil ) ==> (if (not ) (progn )) - ;; (if nil) ==> (if ) - (let ((clause (nth 1 form))) - (cond ((byte-compile-trueconstp clause) - (nth 2 form)) - ((null clause) - (if (nthcdr 4 form) - (cons 'progn (nthcdr 3 form)) - (nth 3 form))) - ((nth 2 form) - (if (equal '(nil) (nthcdr 3 form)) - (list 'if clause (nth 2 form)) - form)) - ((or (nth 3 form) (nthcdr 4 form)) - (list 'if - ;; Don't make a double negative; - ;; instead, take away the one that is there. - (if (and (consp clause) (memq (car clause) '(not null)) - (= (length clause) 2)) ; (not xxxx) or (not (xxxx)) - (nth 1 clause) - (list 'not clause)) - (if (nthcdr 4 form) - (cons 'progn (nthcdr 3 form)) - (nth 3 form)))) - (t - (list 'progn clause nil))))) - -(defun byte-optimize-while (form) - (if (nth 1 form) - form)) - -(put 'and 'byte-optimizer 'byte-optimize-and) -(put 'or 'byte-optimizer 'byte-optimize-or) -(put 'cond 'byte-optimizer 'byte-optimize-cond) -(put 'if 'byte-optimizer 'byte-optimize-if) -(put 'while 'byte-optimizer 'byte-optimize-while) - -;; byte-compile-negation-optimizer lives in bytecomp.el -;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer) -(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) -(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer) - - -(defun byte-optimize-funcall (form) - ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...) - ;; (funcall 'foo ...) ==> (foo ...) - (let ((fn (nth 1 form))) - (if (memq (car-safe fn) '(quote function)) - (cons (nth 1 fn) (cdr (cdr form))) - form))) - -(defun byte-optimize-apply (form) - ;; If the last arg is a literal constant, turn this into a funcall. - ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...). - (let ((fn (nth 1 form)) - (last (nth (1- (length form)) form))) ; I think this really is fastest - (or (if (or (null last) - (eq (car-safe last) 'quote)) - (if (listp (nth 1 last)) - (let ((butlast (nreverse (cdr (reverse (cdr (cdr form))))))) - (nconc (list 'funcall fn) butlast - (mapcar #'(lambda (x) (list 'quote x)) (nth 1 last)))) - (byte-compile-warn - "last arg to apply can't be a literal atom: %s" - (prin1-to-string last)) - nil)) - form))) - -(put 'funcall 'byte-optimizer 'byte-optimize-funcall) -(put 'apply 'byte-optimizer 'byte-optimize-apply) - - -(put 'let 'byte-optimizer 'byte-optimize-letX) -(put 'let* 'byte-optimizer 'byte-optimize-letX) -(defun byte-optimize-letX (form) - (cond ((null (nth 1 form)) - ;; No bindings - (cons 'progn (cdr (cdr form)))) - ((or (nth 2 form) (nthcdr 3 form)) - form) - ;; The body is nil - ((eq (car form) 'let) - (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form))) - '(nil))) - (t - (let ((binds (reverse (nth 1 form)))) - (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil))))) - - -(put 'nth 'byte-optimizer 'byte-optimize-nth) -(defun byte-optimize-nth (form) - (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1))) - (list 'car (if (zerop (nth 1 form)) - (nth 2 form) - (list 'cdr (nth 2 form)))) - (byte-optimize-predicate form))) - -(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr) -(defun byte-optimize-nthcdr (form) - (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2)))) - (byte-optimize-predicate form) - (let ((count (nth 1 form))) - (setq form (nth 2 form)) - (while (>= (setq count (1- count)) 0) - (setq form (list 'cdr form))) - form))) - -;;; enumerating those functions which need not be called if the returned -;;; value is not used. That is, something like -;;; (progn (list (something-with-side-effects) (yow)) -;;; (foo)) -;;; may safely be turned into -;;; (progn (progn (something-with-side-effects) (yow)) -;;; (foo)) -;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo. - -;;; I wonder if I missed any :-\) -(let ((side-effect-free-fns - '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan - assoc assq - boundp buffer-file-name buffer-local-variables buffer-modified-p - buffer-substring - capitalize car-less-than-car car cdr ceiling concat - ;; coordinates-in-window-p not in XEmacs - copy-marker cos count-lines - default-boundp default-value documentation downcase - elt exp expt fboundp featurep - file-directory-p file-exists-p file-locked-p file-name-absolute-p - file-newer-than-file-p file-readable-p file-symlink-p file-writable-p - float floor format - get get-buffer get-buffer-window getenv get-file-buffer - ;; hash-table functions - make-hash-table copy-hash-table - gethash - hash-table-count - hash-table-rehash-size - hash-table-rehash-threshold - hash-table-size - hash-table-test - hash-table-type - ;; - int-to-string - length log log10 logand logb logior lognot logxor lsh - marker-buffer max member memq min mod - next-window nth nthcdr number-to-string - parse-colon-path previous-window - radians-to-degrees rassq regexp-quote reverse round - sin sqrt string< string= string-equal string-lessp string-to-char - string-to-int string-to-number substring symbol-plist - tan upcase user-variable-p vconcat - ;; XEmacs change: window-edges -> window-pixel-edges - window-buffer window-dedicated-p window-pixel-edges window-height - window-hscroll window-minibuffer-p window-width - zerop - ;; functions defined by cl - oddp evenp plusp minusp - abs expt signum last butlast ldiff - pairlis gcd lcm - isqrt floor* ceiling* truncate* round* mod* rem* subseq - list-length get* getf - )) - (side-effect-and-error-free-fns - '(arrayp atom - bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp - car-safe case-table-p cdr-safe char-or-string-p char-table-p - characterp commandp cons - consolep console-live-p consp - current-buffer - ;; XEmacs: extent functions, frame-live-p, various other stuff - devicep device-live-p - dot dot-marker eobp eolp eq eql equal eventp extentp - extent-live-p floatp framep frame-live-p - get-largest-window get-lru-window - hash-table-p - identity ignore integerp integer-or-marker-p interactive-p - invocation-directory invocation-name - ;; keymapp may autoload in XEmacs, so not on this list! - list listp - make-marker mark mark-marker markerp memory-limit minibuffer-window - ;; mouse-movement-p not in XEmacs - natnump nlistp not null number-or-marker-p numberp - one-window-p ;; overlayp not in XEmacs - point point-marker point-min point-max processp - range-table-p - selected-window sequencep stringp subrp symbolp syntax-table-p - user-full-name user-login-name user-original-login-name - user-real-login-name user-real-uid user-uid - vector vectorp - window-configuration-p window-live-p windowp - ;; Functions defined by cl - eql floatp-safe list* subst acons equalp random-state-p - copy-tree sublis - ))) - (dolist (fn side-effect-free-fns) - (put fn 'side-effect-free t)) - (dolist (fn side-effect-and-error-free-fns) - (put fn 'side-effect-free 'error-free))) - - -(defun byte-compile-splice-in-already-compiled-code (form) - ;; form is (byte-code "..." [...] n) - (if (not (memq byte-optimize '(t lap))) - (byte-compile-normal-call form) - (byte-inline-lapcode - (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)) - (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form)) - byte-compile-maxdepth)) - (setq byte-compile-depth (1+ byte-compile-depth)))) - -(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) - - -(defconst byte-constref-ops - '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) - -;;; This function extracts the bitfields from variable-length opcodes. -;;; Originally defined in disass.el (which no longer uses it.) - -(defun disassemble-offset () - "Don't call this!" - ;; fetch and return the offset for the current opcode. - ;; return NIL if this opcode has no offset - ;; OP, PTR and BYTES are used and set dynamically - (defvar op) - (defvar ptr) - (defvar bytes) - (cond ((< op byte-nth) - (let ((tem (logand op 7))) - (setq op (logand op 248)) - (cond ((eq tem 6) - (setq ptr (1+ ptr)) ;offset in next byte - ;; char-to-int to avoid downstream problems - ;; caused by chars appearing where ints are - ;; expected. In bytecode the bytes in the - ;; opcode string are always interpreted as ints. - (char-to-int (aref bytes ptr))) - ((eq tem 7) - (setq ptr (1+ ptr)) ;offset in next 2 bytes - (+ (aref bytes ptr) - (progn (setq ptr (1+ ptr)) - (lsh (aref bytes ptr) 8)))) - (t tem)))) ;offset was in opcode - ((>= op byte-constant) - (prog1 (- op byte-constant) ;offset in opcode - (setq op byte-constant))) - ((and (>= op byte-constant2) - (<= op byte-goto-if-not-nil-else-pop)) - (setq ptr (1+ ptr)) ;offset in next 2 bytes - (+ (aref bytes ptr) - (progn (setq ptr (1+ ptr)) - (lsh (aref bytes ptr) 8)))) - ;; XEmacs: this code was here before. FSF's first comparison - ;; is (>= op byte-listN). It appears that the rel-goto stuff - ;; does not exist in FSF 19.30. It doesn't exist in 19.28 - ;; either, so I'm going to assume that this is an improvement - ;; on our part and leave it in. --ben - ((and (>= op byte-rel-goto) - (<= op byte-insertN)) - (setq ptr (1+ ptr)) ;offset in next byte - ;; Use char-to-int to avoid downstream problems caused by - ;; chars appearing where ints are expected. In bytecode - ;; the bytes in the opcode string are always interpreted as - ;; ints. - (char-to-int (aref bytes ptr))))) - - -;;; This de-compiler is used for inline expansion of compiled functions, -;;; and by the disassembler. -;;; -;;; This list contains numbers, which are pc values, -;;; before each instruction. -(defun byte-decompile-bytecode (bytes constvec) - "Turns BYTECODE into lapcode, referring to CONSTVEC." - (let ((byte-compile-constants nil) - (byte-compile-variables nil) - (byte-compile-tag-number 0)) - (byte-decompile-bytecode-1 bytes constvec))) - -;; As byte-decompile-bytecode, but updates -;; byte-compile-{constants, variables, tag-number}. -;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced -;; with `goto's destined for the end of the code. -;; That is for use by the compiler. -;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler. -;; In that case, we put a pc value into the list -;; before each insn (or its label). -(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) - (let ((length (length bytes)) - (ptr 0) optr tags op offset - ;; tag unused - lap tmp - endtag - ;; (retcount 0) unused - ) - (while (not (= ptr length)) - (or make-spliceable - (setq lap (cons ptr lap))) - (setq op (aref bytes ptr) - optr ptr - offset (disassemble-offset)) ; this does dynamic-scope magic - (setq op (aref byte-code-vector op)) - ;; XEmacs: the next line in FSF 19.30 reads - ;; (cond ((memq op byte-goto-ops) - ;; see the comment above about byte-rel-goto in XEmacs. - (cond ((or (memq op byte-goto-ops) - (cond ((memq op byte-rel-goto-ops) - (setq op (aref byte-code-vector - (- (symbol-value op) - (- byte-rel-goto byte-goto)))) - (setq offset (+ ptr (- offset 127))) - t))) - ;; it's a pc - (setq offset - (cdr (or (assq offset tags) - (car (setq tags - (cons (cons offset - (byte-compile-make-tag)) - tags))))))) - ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t) - ((memq op byte-constref-ops))) - (setq tmp (aref constvec offset) - offset (if (eq op 'byte-constant) - (byte-compile-get-constant tmp) - (or (assq tmp byte-compile-variables) - (car (setq byte-compile-variables - (cons (list tmp) - byte-compile-variables))))))) - ((and make-spliceable - (eq op 'byte-return)) - (if (= ptr (1- length)) - (setq op nil) - (setq offset (or endtag (setq endtag (byte-compile-make-tag))) - op 'byte-goto)))) - ;; lap = ( [ (pc . (op . arg)) ]* ) - (setq lap (cons (cons optr (cons op (or offset 0))) - lap)) - (setq ptr (1+ ptr))) - ;; take off the dummy nil op that we replaced a trailing "return" with. - (let ((rest lap)) - (while rest - (cond ((numberp (car rest))) - ((setq tmp (assq (car (car rest)) tags)) - ;; this addr is jumped to - (setcdr rest (cons (cons nil (cdr tmp)) - (cdr rest))) - (setq tags (delq tmp tags)) - (setq rest (cdr rest)))) - (setq rest (cdr rest)))) - (if tags (error "optimizer error: missed tags %s" tags)) - (if (null (car (cdr (car lap)))) - (setq lap (cdr lap))) - (if endtag - (setq lap (cons (cons nil endtag) lap))) - ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) - (mapcar #'(lambda (elt) (if (numberp elt) elt (cdr elt))) - (nreverse lap)))) - - -;;; peephole optimizer - -(defconst byte-tagref-ops (cons 'TAG byte-goto-ops)) - -(defconst byte-conditional-ops - '(byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) - -(defconst byte-after-unbind-ops - '(byte-constant byte-dup - byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp - byte-eq byte-equal byte-not - byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 - byte-interactive-p) - ;; How about other side-effect-free-ops? Is it safe to move an - ;; error invocation (such as from nth) out of an unwind-protect? - "Byte-codes that can be moved past an unbind.") - -(defconst byte-compile-side-effect-and-error-free-ops - '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp - byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe - byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max - byte-point-min byte-following-char byte-preceding-char - byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp - byte-current-buffer byte-interactive-p)) - -(defconst byte-compile-side-effect-free-ops - (nconc - '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref - byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1 - byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate - byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax - byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt - byte-member byte-assq byte-quo byte-rem) - byte-compile-side-effect-and-error-free-ops)) - -;;; This piece of shit is because of the way DEFVAR_BOOL() variables work. -;;; Consider the code -;;; -;;; (defun foo (flag) -;;; (let ((old-pop-ups pop-up-windows) -;;; (pop-up-windows flag)) -;;; (cond ((not (eq pop-up-windows old-pop-ups)) -;;; (setq old-pop-ups pop-up-windows) -;;; ...)))) -;;; -;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is -;;; something else. But if we optimize -;;; -;;; varref flag -;;; varbind pop-up-windows -;;; varref pop-up-windows -;;; not -;;; to -;;; varref flag -;;; dup -;;; varbind pop-up-windows -;;; not -;;; -;;; we break the program, because it will appear that pop-up-windows and -;;; old-pop-ups are not EQ when really they are. So we have to know what -;;; the BOOL variables are, and not perform this optimization on them. -;;; - -;;; This used to hold a large list of boolean variables, which had to -;;; be updated every time a new DEFVAR_BOOL is added, making it very -;;; hard to maintain. Such a list is not necessary under XEmacs, -;;; where we can use `built-in-variable-type' to query for boolean -;;; variables. - -;(defconst byte-boolean-vars -; '(abbrev-all-caps purify-flag find-file-compare-truenames -; find-file-use-truenames delete-auto-save-files byte-metering-on -; x-seppuku-on-epipe zmacs-regions zmacs-region-active-p -; zmacs-region-stays atomic-extent-goto-char-p -; suppress-early-error-handler-backtrace noninteractive -; inhibit-early-packages inhibit-autoloads debug-paths -; inhibit-site-lisp debug-on-quit debug-on-next-call -; modifier-keys-are-sticky x-allow-sendevents -; mswindows-dynamic-frame-resize focus-follows-mouse -; inhibit-input-event-recording enable-multibyte-characters -; disable-auto-save-when-buffer-shrinks -; allow-deletion-of-last-visible-frame indent-tabs-mode -; load-in-progress load-warn-when-source-newer -; load-warn-when-source-only load-ignore-elc-files -; load-force-doc-strings fail-on-bucky-bit-character-escapes -; popup-menu-titles menubar-show-keybindings completion-ignore-case -; canna-empty-info canna-through-info canna-underline -; canna-inhibit-hankakukana enable-multibyte-characters -; re-short-flag x-handle-non-fully-specified-fonts -; print-escape-newlines print-readably delete-exited-processes -; windowed-process-io visible-bell no-redraw-on-reenter -; cursor-in-echo-area inhibit-warning-display -; column-number-start-at-one parse-sexp-ignore-comments -; words-include-escapes scroll-on-clipped-lines) -; "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. -;If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer -;may generate incorrect code.") - -(defun byte-optimize-lapcode (lap &optional for-effect) - "Simple peephole optimizer. LAP is both modified and returned." - (let (lap0 ;; off0 unused - lap1 ;; off1 - lap2 ;; off2 - (keep-going 'first-time) - (add-depth 0) - rest tmp tmp2 tmp3 - (side-effect-free (if byte-compile-delete-errors - byte-compile-side-effect-free-ops - byte-compile-side-effect-and-error-free-ops))) - (while keep-going - (or (eq keep-going 'first-time) - (byte-compile-log-lap " ---- next pass")) - (setq rest lap - keep-going nil) - (while rest - (setq lap0 (car rest) - lap1 (nth 1 rest) - lap2 (nth 2 rest)) - - ;; You may notice that sequences like "dup varset discard" are - ;; optimized but sequences like "dup varset TAG1: discard" are not. - ;; You may be tempted to change this; resist that temptation. - (cond ;; - ;; pop --> - ;; ...including: - ;; const-X pop --> - ;; varref-X pop --> - ;; dup pop --> - ;; - ((and (eq 'byte-discard (car lap1)) - (memq (car lap0) side-effect-free)) - (setq keep-going t) - (setq tmp (aref byte-stack+-info (symbol-value (car lap0)))) - (setq rest (cdr rest)) - (cond ((= tmp 1) - (byte-compile-log-lap - " %s discard\t-->\t" lap0) - (setq lap (delq lap0 (delq lap1 lap)))) - ((= tmp 0) - (byte-compile-log-lap - " %s discard\t-->\t discard" lap0) - (setq lap (delq lap0 lap))) - ((= tmp -1) - (byte-compile-log-lap - " %s discard\t-->\tdiscard discard" lap0) - (setcar lap0 'byte-discard) - (setcdr lap0 0)) - ((error "Optimizer error: too much on the stack")))) - ;; - ;; goto*-X X: --> X: - ;; - ((and (memq (car lap0) byte-goto-ops) - (eq (cdr lap0) lap1)) - (cond ((eq (car lap0) 'byte-goto) - (setq lap (delq lap0 lap)) - (setq tmp "")) - ((memq (car lap0) byte-goto-always-pop-ops) - (setcar lap0 (setq tmp 'byte-discard)) - (setcdr lap0 0)) - ((error "Depth conflict at tag %d" (nth 2 lap0)))) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " (goto %s) %s:\t-->\t%s %s:" - (nth 1 lap1) (nth 1 lap1) - tmp (nth 1 lap1))) - (setq keep-going t)) - ;; - ;; varset-X varref-X --> dup varset-X - ;; varbind-X varref-X --> dup varbind-X - ;; const/dup varset-X varref-X --> const/dup varset-X const/dup - ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup - ;; The latter two can enable other optimizations. - ;; - ((and (eq 'byte-varref (car lap2)) - (eq (cdr lap1) (cdr lap2)) - (memq (car lap1) '(byte-varset byte-varbind))) - (if (and (setq tmp (eq (built-in-variable-type (car (cdr lap2))) - 'boolean)) - (not (eq (car lap0) 'byte-constant))) - nil - (setq keep-going t) - (if (memq (car lap0) '(byte-constant byte-dup)) - (progn - (setq tmp (if (or (not tmp) - (memq (car (cdr lap0)) '(nil t))) - (cdr lap0) - (byte-compile-get-constant t))) - (byte-compile-log-lap " %s %s %s\t-->\t%s %s %s" - lap0 lap1 lap2 lap0 lap1 - (cons (car lap0) tmp)) - (setcar lap2 (car lap0)) - (setcdr lap2 tmp)) - (byte-compile-log-lap " %s %s\t-->\tdup %s" lap1 lap2 lap1) - (setcar lap2 (car lap1)) - (setcar lap1 'byte-dup) - (setcdr lap1 0) - ;; The stack depth gets locally increased, so we will - ;; increase maxdepth in case depth = maxdepth here. - ;; This can cause the third argument to byte-code to - ;; be larger than necessary. - (setq add-depth 1)))) - ;; - ;; dup varset-X discard --> varset-X - ;; dup varbind-X discard --> varbind-X - ;; (the varbind variant can emerge from other optimizations) - ;; - ((and (eq 'byte-dup (car lap0)) - (eq 'byte-discard (car lap2)) - (memq (car lap1) '(byte-varset byte-varbind))) - (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) - (setq keep-going t - rest (cdr rest)) - (setq lap (delq lap0 (delq lap2 lap)))) - ;; - ;; not goto-X-if-nil --> goto-X-if-non-nil - ;; not goto-X-if-non-nil --> goto-X-if-nil - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (eq 'byte-not (car lap0)) - (or (eq 'byte-goto-if-nil (car lap1)) - (eq 'byte-goto-if-not-nil (car lap1)))) - (byte-compile-log-lap " not %s\t-->\t%s" - lap1 - (cons - (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil) - (cdr lap1))) - (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil) - 'byte-goto-if-not-nil - 'byte-goto-if-nil)) - (setq lap (delq lap0 lap)) - (setq keep-going t)) - ;; - ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X: - ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X: - ;; - ;; it is wrong to do the same thing for the -else-pop variants. - ;; - ((and (or (eq 'byte-goto-if-nil (car lap0)) - (eq 'byte-goto-if-not-nil (car lap0))) ; gotoX - (eq 'byte-goto (car lap1)) ; gotoY - (eq (cdr lap0) lap2)) ; TAG X - (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) - 'byte-goto-if-not-nil 'byte-goto-if-nil))) - (byte-compile-log-lap " %s %s %s:\t-->\t%s %s:" - lap0 lap1 lap2 - (cons inverse (cdr lap1)) lap2) - (setq lap (delq lap0 lap)) - (setcar lap1 inverse) - (setq keep-going t))) - ;; - ;; const goto-if-* --> whatever - ;; - ((and (eq 'byte-constant (car lap0)) - (memq (car lap1) byte-conditional-ops)) - (cond ((if (or (eq (car lap1) 'byte-goto-if-nil) - (eq (car lap1) 'byte-goto-if-nil-else-pop)) - (car (cdr lap0)) - (not (car (cdr lap0)))) - (byte-compile-log-lap " %s %s\t-->\t" - lap0 lap1) - (setq rest (cdr rest) - lap (delq lap0 (delq lap1 lap)))) - (t - (if (memq (car lap1) byte-goto-always-pop-ops) - (progn - (byte-compile-log-lap " %s %s\t-->\t%s" - lap0 lap1 (cons 'byte-goto (cdr lap1))) - (setq lap (delq lap0 lap))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 - (cons 'byte-goto (cdr lap1)))) - (setcar lap1 'byte-goto))) - (setq keep-going t)) - ;; - ;; varref-X varref-X --> varref-X dup - ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup - ;; We don't optimize the const-X variations on this here, - ;; because that would inhibit some goto optimizations; we - ;; optimize the const-X case after all other optimizations. - ;; - ((and (eq 'byte-varref (car lap0)) - (progn - (setq tmp (cdr rest)) - (while (eq (car (car tmp)) 'byte-dup) - (setq tmp (cdr tmp))) - t) - (eq (cdr lap0) (cdr (car tmp))) - (eq 'byte-varref (car (car tmp)))) - (if (memq byte-optimize-log '(t byte)) - (let ((str "")) - (setq tmp2 (cdr rest)) - (while (not (eq tmp tmp2)) - (setq tmp2 (cdr tmp2) - str (concat str " dup"))) - (byte-compile-log-lap " %s%s %s\t-->\t%s%s dup" - lap0 str lap0 lap0 str))) - (setq keep-going t) - (setcar (car tmp) 'byte-dup) - (setcdr (car tmp) 0) - (setq rest tmp)) - ;; - ;; TAG1: TAG2: --> TAG1: - ;; (and other references to TAG2 are replaced with TAG1) - ;; - ((and (eq (car lap0) 'TAG) - (eq (car lap1) 'TAG)) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " adjacent tags %d and %d merged" - (nth 1 lap1) (nth 1 lap0))) - (setq tmp3 lap) - (while (setq tmp2 (rassq lap0 tmp3)) - (setcdr tmp2 lap1) - (setq tmp3 (cdr (memq tmp2 tmp3)))) - (setq lap (delq lap0 lap) - keep-going t)) - ;; - ;; unused-TAG: --> - ;; - ((and (eq 'TAG (car lap0)) - (not (rassq lap0 lap))) - (and (memq byte-optimize-log '(t byte)) - (byte-compile-log " unused tag %d removed" (nth 1 lap0))) - (setq lap (delq lap0 lap) - keep-going t)) - ;; - ;; goto ... --> goto - ;; return ... --> return - ;; - ((and (memq (car lap0) '(byte-goto byte-return)) - (not (memq (car lap1) '(TAG nil)))) - (setq tmp rest) - (let ((i 0) - (opt-p (memq byte-optimize-log '(t lap))) - str deleted) - (while (and (setq tmp (cdr tmp)) - (not (eq 'TAG (car (car tmp))))) - (if opt-p (setq deleted (cons (car tmp) deleted) - str (concat str " %s") - i (1+ i)))) - (if opt-p - (let ((tagstr - (if (eq 'TAG (car (car tmp))) - (format "%d:" (car (cdr (car tmp)))) - (or (car tmp) "")))) - (if (< i 6) - (apply 'byte-compile-log-lap-1 - (concat " %s" str - " %s\t-->\t%s %s") - lap0 - (nconc (nreverse deleted) - (list tagstr lap0 tagstr))) - (byte-compile-log-lap - " %s <%d unreachable op%s> %s\t-->\t%s %s" - lap0 i (if (= i 1) "" "s") - tagstr lap0 tagstr)))) - (rplacd rest tmp)) - (setq keep-going t)) - ;; - ;; unbind --> unbind - ;; (this may enable other optimizations.) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) byte-after-unbind-ops)) - (byte-compile-log-lap " %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0) - (setcar rest lap1) - (setcar (cdr rest) lap0) - (setq keep-going t)) - ;; - ;; varbind-X unbind-N --> discard unbind-(N-1) - ;; save-excursion unbind-N --> unbind-(N-1) - ;; save-restriction unbind-N --> unbind-(N-1) - ;; - ((and (eq 'byte-unbind (car lap1)) - (memq (car lap0) '(byte-varbind byte-save-excursion - byte-save-restriction)) - (< 0 (cdr lap1))) - (if (zerop (setcdr lap1 (1- (cdr lap1)))) - (delq lap1 rest)) - (if (eq (car lap0) 'byte-varbind) - (setcar rest (cons 'byte-discard 0)) - (setq lap (delq lap0 lap))) - (byte-compile-log-lap " %s %s\t-->\t%s %s" - lap0 (cons (car lap1) (1+ (cdr lap1))) - (if (eq (car lap0) 'byte-varbind) - (car rest) - (car (cdr rest))) - (if (and (/= 0 (cdr lap1)) - (eq (car lap0) 'byte-varbind)) - (car (cdr rest)) - "")) - (setq keep-going t)) - ;; - ;; goto*-X ... X: goto-Y --> goto*-Y - ;; goto-X ... X: return --> return - ;; - ((and (memq (car lap0) byte-goto-ops) - (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap)))) - '(byte-goto byte-return))) - (cond ((and (not (eq tmp lap0)) - (or (eq (car lap0) 'byte-goto) - (eq (car tmp) 'byte-goto))) - (byte-compile-log-lap " %s [%s]\t-->\t%s" - (car lap0) tmp tmp) - (if (eq (car tmp) 'byte-return) - (setcar lap0 'byte-return)) - (setcdr lap0 (cdr tmp)) - (setq keep-going t)))) - ;; - ;; goto-*-else-pop X ... X: goto-if-* --> whatever - ;; goto-*-else-pop X ... X: discard --> whatever - ;; - ((and (memq (car lap0) '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) - (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap0 (car tmp)))) - (setq tmp2 (car tmp)) - (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop - byte-goto-if-nil) - (byte-goto-if-not-nil-else-pop - byte-goto-if-not-nil)))) - (if (memq (car tmp2) tmp3) - (progn (setcar lap0 (car tmp2)) - (setcdr lap0 (cdr tmp2)) - (byte-compile-log-lap " %s-else-pop [%s]\t-->\t%s" - (car lap0) tmp2 lap0)) - ;; Get rid of the -else-pop's and jump one step further. - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (byte-compile-log-lap " %s [%s]\t-->\t%s " - (car lap0) tmp2 (nth 1 tmp3)) - (setcar lap0 (nth 1 tmp3)) - (setcdr lap0 (nth 1 tmp))) - (setq keep-going t)) - ;; - ;; const goto-X ... X: goto-if-* --> whatever - ;; const goto-X ... X: discard --> whatever - ;; - ((and (eq (car lap0) 'byte-constant) - (eq (car lap1) 'byte-goto) - (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap))))) - (eval-when-compile - (cons 'byte-discard byte-conditional-ops))) - (not (eq lap1 (car tmp)))) - (setq tmp2 (car tmp)) - (cond ((memq (car tmp2) - (if (null (car (cdr lap0))) - '(byte-goto-if-nil byte-goto-if-nil-else-pop) - '(byte-goto-if-not-nil - byte-goto-if-not-nil-else-pop))) - (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s" - lap0 tmp2 lap0 tmp2) - (setcar lap1 (car tmp2)) - (setcdr lap1 (cdr tmp2)) - ;; Let next step fix the (const,goto-if*) sequence. - (setq rest (cons nil rest))) - (t - ;; Jump one step further - (byte-compile-log-lap - " %s goto [%s]\t-->\t goto " - lap0 tmp2) - (or (eq 'TAG (car (nth 1 tmp))) - (setcdr tmp (cons (byte-compile-make-tag) - (cdr tmp)))) - (setcdr lap1 (car (cdr tmp))) - (setq lap (delq lap0 lap)))) - (setq keep-going t)) - ;; - ;; X: varref-Y ... varset-Y goto-X --> - ;; X: varref-Y Z: ... dup varset-Y goto-Z - ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.) - ;; (This is so usual for while loops that it is worth handling). - ;; - ((and (eq (car lap1) 'byte-varset) - (eq (car lap2) 'byte-goto) - (not (memq (cdr lap2) rest)) ;Backwards jump - (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) - 'byte-varref) - (eq (cdr (car tmp)) (cdr lap1)) - (not (eq (built-in-variable-type (car (cdr lap1))) - 'boolean))) - ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" - (nth 1 (cdr lap2)) (car tmp) - lap1 lap2 - (nth 1 (cdr lap2)) (car tmp) - (nth 1 newtag) 'byte-dup lap1 - (cons 'byte-goto newtag) - ) - (setcdr rest (cons (cons 'byte-dup 0) (cdr rest))) - (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp)))) - (setq add-depth 1) - (setq keep-going t)) - ;; - ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y: - ;; (This can pull the loop test to the end of the loop) - ;; - ((and (eq (car lap0) 'byte-goto) - (eq (car lap1) 'TAG) - (eq lap1 - (cdr (car (setq tmp (cdr (memq (cdr lap0) lap)))))) - (memq (car (car tmp)) - '(byte-goto byte-goto-if-nil byte-goto-if-not-nil - byte-goto-if-nil-else-pop))) -;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional" -;; lap0 lap1 (cdr lap0) (car tmp)) - (let ((newtag (byte-compile-make-tag))) - (byte-compile-log-lap - "%s %s: ... %s: %s\t-->\t%s ... %s:" - lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp) - (cons (cdr (assq (car (car tmp)) - '((byte-goto-if-nil . byte-goto-if-not-nil) - (byte-goto-if-not-nil . byte-goto-if-nil) - (byte-goto-if-nil-else-pop . - byte-goto-if-not-nil-else-pop) - (byte-goto-if-not-nil-else-pop . - byte-goto-if-nil-else-pop)))) - newtag) - - (nth 1 newtag) - ) - (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp))) - (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop) - ;; We can handle this case but not the -if-not-nil case, - ;; because we won't know which non-nil constant to push. - (setcdr rest (cons (cons 'byte-constant - (byte-compile-get-constant nil)) - (cdr rest)))) - (setcar lap0 (nth 1 (memq (car (car tmp)) - '(byte-goto-if-nil-else-pop - byte-goto-if-not-nil - byte-goto-if-nil - byte-goto-if-not-nil - byte-goto byte-goto)))) - ) - (setq keep-going t)) - ) - (setq rest (cdr rest))) - ) - ;; Cleanup stage: - ;; Rebuild byte-compile-constants / byte-compile-variables. - ;; Simple optimizations that would inhibit other optimizations if they - ;; were done in the optimizing loop, and optimizations which there is no - ;; need to do more than once. - (setq byte-compile-constants nil - byte-compile-variables nil) - (setq rest lap) - (while rest - (setq lap0 (car rest) - lap1 (nth 1 rest)) - (if (memq (car lap0) byte-constref-ops) - (if (eq (cdr lap0) 'byte-constant) - (or (memq (cdr lap0) byte-compile-variables) - (setq byte-compile-variables (cons (cdr lap0) - byte-compile-variables))) - (or (memq (cdr lap0) byte-compile-constants) - (setq byte-compile-constants (cons (cdr lap0) - byte-compile-constants))))) - (cond (;; - ;; const-C varset-X const-C --> const-C dup varset-X - ;; const-C varbind-X const-C --> const-C dup varbind-X - ;; - (and (eq (car lap0) 'byte-constant) - (eq (car (nth 2 rest)) 'byte-constant) - (eq (cdr lap0) (car (nth 2 rest))) - (memq (car lap1) '(byte-varbind byte-varset))) - (byte-compile-log-lap " %s %s %s\t-->\t%s dup %s" - lap0 lap1 lap0 lap0 lap1) - (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1))) - (setcar (cdr rest) (cons 'byte-dup 0)) - (setq add-depth 1)) - ;; - ;; const-X [dup/const-X ...] --> const-X [dup ...] dup - ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup - ;; - ((memq (car lap0) '(byte-constant byte-varref)) - (setq tmp rest - tmp2 nil) - (while (progn - (while (eq 'byte-dup (car (car (setq tmp (cdr tmp)))))) - (and (eq (cdr lap0) (cdr (car tmp))) - (eq (car lap0) (car (car tmp))))) - (setcar tmp (cons 'byte-dup 0)) - (setq tmp2 t)) - (if tmp2 - (byte-compile-log-lap - " %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0))) - ;; - ;; unbind-N unbind-M --> unbind-(N+M) - ;; - ((and (eq 'byte-unbind (car lap0)) - (eq 'byte-unbind (car lap1))) - (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 - (cons 'byte-unbind - (+ (cdr lap0) (cdr lap1)))) - (setq keep-going t) - (setq lap (delq lap0 lap)) - (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) - ) - (setq rest (cdr rest))) - (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth))) - lap) - -(provide 'byte-optimize) - - -;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles -;; itself, compile some of its most used recursive functions (at load time). -;; -(eval-when-compile - (or (compiled-function-p (symbol-function 'byte-optimize-form)) - (assq 'byte-code (symbol-function 'byte-optimize-form)) - (let ((byte-optimize nil) - (byte-compile-warnings nil)) - (mapcar - #'(lambda (x) - (or noninteractive (message "compiling %s..." x)) - (byte-compile x) - (or noninteractive (message "compiling %s...done" x))) - '(byte-optimize-form - byte-optimize-body - byte-optimize-predicate - byte-optimize-binary-predicate - ;; Inserted some more than necessary, to speed it up. - byte-optimize-form-code-walker - byte-optimize-lapcode)))) - nil) - -;;; byte-optimize.el ends here diff --git a/lisp/bytecomp-runtime.el b/lisp/bytecomp-runtime.el deleted file mode 100644 index 95d8c31..0000000 --- a/lisp/bytecomp-runtime.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; bytecomp-runtime.el --- byte-compiler support for inlining - -;; Copyright (C) 1992, 1997 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski -;; Author: Hallvard Furuseth -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; The code in this file should always be loaded, because it defines things -;; like "defsubst" which should work interpreted as well. The code in -;; bytecomp.el and byte-optimize.el can be loaded as needed. - -;; interface to selectively inlining functions. -;; This only happens when source-code optimization is turned on. - -;;; Code: - -;; Redefined in byte-optimize.el. -;; This is not documented--it's not clear that we should promote it. -(fset 'inline 'progn) -(put 'inline 'lisp-indent-hook 0) - - -;;; Interface to inline functions. - -;; FSF comments the next two out, but I see no reason to do so. --ben -(defmacro proclaim-inline (&rest fns) - "Cause the named functions to be open-coded when called from compiled code. -They will only be compiled open-coded when `byte-optimize' is true." - (cons 'eval-and-compile - (apply - 'nconc - (mapcar - #'(lambda (x) - `((or (memq (get ',x 'byte-optimizer) - '(nil byte-compile-inline-expand)) - (error - "%s already has a byte-optimizer, can't make it inline" - ',x)) - (put ',x 'byte-optimizer 'byte-compile-inline-expand))) - fns)))) - - -(defmacro proclaim-notinline (&rest fns) - "Cause the named functions to no longer be open-coded." - (cons 'eval-and-compile - (apply - 'nconc - (mapcar - #'(lambda (x) - `((if (eq (get ',x 'byte-optimizer) - 'byte-compile-inline-expand) - (put ',x 'byte-optimizer nil)))) - fns)))) - -;; This has a special byte-hunk-handler in bytecomp.el. -(defmacro defsubst (name arglist &rest body) - "Define an inline function. The syntax is just like that of `defun'." - (or (memq (get name 'byte-optimizer) - '(nil byte-compile-inline-expand)) - (error "`%s' is a primitive" name)) - (list 'prog1 - (cons 'defun (cons name (cons arglist body))) - (list 'proclaim-inline name))) -; Instead of the above line, FSF has this: -; (list 'eval-and-compile -; (list 'put (list 'quote name) -; ''byte-optimizer ''byte-compile-inline-expand)))) - -(defun make-obsolete (fn new) - "Make the byte-compiler warn that FUNCTION is obsolete. -The warning will say that NEW should be used instead. -If NEW is a string, that is the `use instead' message." - (interactive "aMake function obsolete: \nxObsoletion replacement: ") - (let ((handler (get fn 'byte-compile))) - (if (eq 'byte-compile-obsolete handler) - (setcar (get fn 'byte-obsolete-info) new) - (put fn 'byte-obsolete-info (cons new handler)) - (put fn 'byte-compile 'byte-compile-obsolete))) - fn) - -(defun make-obsolete-variable (var new) - "Make the byte-compiler warn that VARIABLE is obsolete, -and NEW should be used instead. If NEW is a string, then that is the -`use instead' message." - (interactive - (list - (let ((str (completing-read "Make variable obsolete: " obarray 'boundp t))) - (if (equal str "") (error "")) - (intern str)) - (car (read-from-string (read-string "Obsoletion replacement: "))))) - (put var 'byte-obsolete-variable new) - var) - -;; By overwhelming demand, we separate out truly obsolete symbols from -;; those that are present for GNU Emacs compatibility. -(defun make-compatible (fn new) - "Make the byte-compiler know that FUNCTION is provided for compatibility. -The warning will say that NEW should be used instead. -If NEW is a string, that is the `use instead' message." - (interactive "aMake function compatible: \nxCompatible replacement: ") - (let ((handler (get fn 'byte-compile))) - (if (eq 'byte-compile-compatible handler) - (setcar (get fn 'byte-compatible-info) new) - (put fn 'byte-compatible-info (cons new handler)) - (put fn 'byte-compile 'byte-compile-compatible))) - fn) - -(defun make-compatible-variable (var new) - "Make the byte-compiler know that VARIABLE is provided for compatibility. -and NEW should be used instead. If NEW is a string, then that is the -`use instead' message." - (interactive - (list - (let ((str (completing-read "Make variable compatible: " - obarray 'boundp t))) - (if (equal str "") (error "")) - (intern str)) - (car (read-from-string (read-string "Compatible replacement: "))))) - (put var 'byte-compatible-variable new) - var) - -(put 'dont-compile 'lisp-indent-hook 0) -(defmacro dont-compile (&rest body) - "Like `progn', but the body always runs interpreted (not compiled). -If you think you need this, you're probably making a mistake somewhere." - (list 'eval (list 'quote (if (cdr body) (cons 'progn body) (car body))))) - - -;;; interface to evaluating things at compile time and/or load time -;;; these macro must come after any uses of them in this file, as their -;;; definition in the file overrides the magic definitions on the -;;; byte-compile-macro-environment. - -(put 'eval-when-compile 'lisp-indent-hook 0) -(defmacro eval-when-compile (&rest body) - "Like `progn', but evaluates the body at compile time. -The result of the body appears to the compiler as a quoted constant." - ;; Not necessary because we have it in b-c-initial-macro-environment - ;; (list 'quote (eval (cons 'progn body))) - (cons 'progn body)) - -(put 'eval-and-compile 'lisp-indent-hook 0) -(defmacro eval-and-compile (&rest body) - "Like `progn', but evaluates the body at compile time and at load time." - ;; Remember, it's magic. - (cons 'progn body)) - -;;; From Emacs 20. -(put 'eval-when-feature 'lisp-indent-hook 1) -(defmacro eval-when-feature (feature &rest body) - "Run the body forms when FEATURE is featurep, be it now or later. -Called (eval-when-feature (FEATURE [. FILENAME]) BODYFORMS...). -If (featurep 'FEATURE), evals now; otherwise adds an elt to -`after-load-alist' (which see), using FEATURE as filename if FILENAME is nil." - (let ((file (or (cdr feature) (symbol-name (car feature))))) - `(let ((bodythunk #'(lambda () ,@body))) - (if (featurep ',(car feature)) - (funcall bodythunk) - (setq after-load-alist (cons '(,file . (list 'lambda '() bodythunk)) - after-load-alist)))))) - - - -;;; Interface to file-local byte-compiler parameters. -;;; Redefined in bytecomp.el. - -;;; The great RMS speaketh: -;;; -;;; I nuked this because it's not a good idea for users to think of -;;; using it. These options are a matter of installation preference, -;;; and have nothing to do with particular source files; it's a -;;; mistake to suggest to users that they should associate these with -;;; particular source files. There is hardly any reason to change -;;; these parameters, anyway. --rms. -;;; -;;; But I'll leave this stuff alone. --ben - -(put 'byte-compiler-options 'lisp-indent-hook 0) -(defmacro byte-compiler-options (&rest args) - "Set some compilation-parameters for this file. -This will affect only the file in which it appears; this does nothing when -evaluated, or when loaded from a .el file. - -Each argument to this macro must be a list of a key and a value. - - Keys: Values: Corresponding variable: - - verbose t, nil byte-compile-verbose - optimize t, nil, source, byte byte-optimize - warnings list of warnings byte-compile-warnings - file-format emacs19, emacs20 byte-compile-emacs19-compatibility - -The value specified with the `warnings' option must be a list, containing -some subset of the following flags: - - free-vars references to variables not in the current lexical scope. - unused-vars references to non-global variables bound but not referenced. - unresolved calls to unknown functions. - callargs lambda calls with args that don't match the definition. - redefine function cell redefined from a macro to a lambda or vice - versa, or redefined to take a different number of arguments. - -If the first element if the list is `+' or `-' then the specified elements -are added to or removed from the current set of warnings, instead of the -entire set of warnings being overwritten. - -For example, something like this might appear at the top of a source file: - - (byte-compiler-options - (optimize t) - (warnings (- callargs)) ; Don't warn about arglist mismatch - (warnings (+ unused-vars)) ; Do warn about unused bindings - (file-format emacs19))" - nil) - -;;; bytecomp-runtime.el ends here diff --git a/lisp/bytecomp.el b/lisp/bytecomp.el deleted file mode 100644 index 5340162..0000000 --- a/lisp/bytecomp.el +++ /dev/null @@ -1,4167 +0,0 @@ -;;; bytecomp.el --- compilation of Lisp code into byte code. - -;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. -;;; Copyright (C) 1996 Ben Wing. - -;; Author: Jamie Zawinski -;; Hallvard Furuseth -;; Keywords: internal - -;; Subsequently modified by RMS and others. - -(defconst byte-compile-version (purecopy "2.26 XEmacs; 1998-10-07.")) - -;; 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: - -;; The Emacs Lisp byte compiler. This crunches lisp source into a -;; sort of p-code which takes up less space and can be interpreted -;; faster. The user entry points are byte-compile-file, -;; byte-recompile-directory and byte-compile-buffer. - -;;; Code: - -;;; ======================================================================== -;;; Entry points: -;;; byte-recompile-directory, byte-compile-file, -;;; batch-byte-compile, batch-byte-recompile-directory, -;;; byte-compile, compile-defun, -;;; display-call-tree -;;; RMS says: -;;; (byte-compile-buffer and byte-compile-and-load-file were turned off -;;; because they are not terribly useful and get in the way of completion.) -;;; But I'm leaving them. --ben - -;;; This version of the byte compiler has the following improvements: -;;; + optimization of compiled code: -;;; - removal of unreachable code; -;;; - removal of calls to side-effectless functions whose return-value -;;; is unused; -;;; - compile-time evaluation of safe constant forms, such as (consp nil) -;;; and (ash 1 6); -;;; - open-coding of literal lambdas; -;;; - peephole optimization of emitted code; -;;; - trivial functions are left uncompiled for speed. -;;; + support for inline functions; -;;; + compile-time evaluation of arbitrary expressions; -;;; + compile-time warning messages for: -;;; - functions being redefined with incompatible arglists; -;;; - functions being redefined as macros, or vice-versa; -;;; - functions or macros defined multiple times in the same file; -;;; - functions being called with the incorrect number of arguments; -;;; - functions being called which are not defined globally, in the -;;; file, or as autoloads; -;;; - assignment and reference of undeclared free variables; -;;; - various syntax errors; -;;; + correct compilation of nested defuns, defmacros, defvars and defsubsts; -;;; + correct compilation of top-level uses of macros; -;;; + the ability to generate a histogram of functions called. - -;;; User customization variables: -;;; -;;; byte-compile-verbose Whether to report the function currently being -;;; compiled in the minibuffer; -;;; byte-optimize Whether to do optimizations; this may be -;;; t, nil, 'source, or 'byte; -;;; byte-optimize-log Whether to report (in excruciating detail) -;;; exactly which optimizations have been made. -;;; This may be t, nil, 'source, or 'byte; -;;; byte-compile-error-on-warn Whether to stop compilation when a warning is -;;; produced; -;;; byte-compile-delete-errors Whether the optimizer may delete calls or -;;; variable references that are side-effect-free -;;; except that they may return an error. -;;; byte-compile-generate-call-tree Whether to generate a histogram of -;;; function calls. This can be useful for -;;; finding unused functions, as well as simple -;;; performance metering. -;;; byte-compile-warnings List of warnings to issue, or t. May contain -;;; 'free-vars (references to variables not in the -;;; current lexical scope) -;;; 'unused-vars (non-global variables bound but -;;; not referenced) -;;; 'unresolved (calls to unknown functions) -;;; 'callargs (lambda calls with args that don't -;;; match the lambda's definition) -;;; 'subr-callargs (calls to subrs with args that -;;; don't match the subr's definition) -;;; 'redefine (function cell redefined from -;;; a macro to a lambda or vice versa, -;;; or redefined to take other args) -;;; 'obsolete (obsolete variables and functions) -;;; 'pedantic (references to Emacs-compatible -;;; symbols) -;;; byte-compile-emacs19-compatibility Whether the compiler should -;;; generate .elc files which can be loaded into -;;; generic emacs 19. -;;; emacs-lisp-file-regexp Regexp for the extension of source-files; -;;; see also the function byte-compile-dest-file. -;;; byte-compile-overwrite-file If nil, delete old .elc files before saving. -;;; -;;; Most of the above parameters can also be set on a file-by-file basis; see -;;; the documentation of the `byte-compiler-options' macro. - -;;; New Features: -;;; -;;; o The form `defsubst' is just like `defun', except that the function -;;; generated will be open-coded in compiled code which uses it. This -;;; means that no function call will be generated, it will simply be -;;; spliced in. Lisp functions calls are very slow, so this can be a -;;; big win. -;;; -;;; You can generally accomplish the same thing with `defmacro', but in -;;; that case, the defined procedure can't be used as an argument to -;;; mapcar, etc. -;;; -;;; o You can make a given function be inline even if it has already been -;;; defined with `defun' by using the `proclaim-inline' form like so: -;;; (proclaim-inline my-function) -;;; This is, in fact, exactly what `defsubst' does. To make a function no -;;; longer be inline, you must use `proclaim-notinline'. Beware that if -;;; you define a function with `defsubst' and later redefine it with -;;; `defun', it will still be open-coded until you use proclaim-notinline. -;;; -;;; o You can also open-code one particular call to a function without -;;; open-coding all calls. Use the 'inline' form to do this, like so: -;;; -;;; (inline (foo 1 2 3)) ;; `foo' will be open-coded -;;; or... -;;; (inline ;; `foo' and `baz' will be -;;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not. -;;; (baz 0)) -;;; -;;; o It is possible to open-code a function in the same file it is defined -;;; in without having to load that file before compiling it. the -;;; byte-compiler has been modified to remember function definitions in -;;; the compilation environment in the same way that it remembers macro -;;; definitions. -;;; -;;; o Forms like ((lambda ...) ...) are open-coded. -;;; -;;; o The form `eval-when-compile' is like progn, except that the body -;;; is evaluated at compile-time. When it appears at top-level, this -;;; is analogous to the Common Lisp idiom (eval-when (compile) ...). -;;; When it does not appear at top-level, it is similar to the -;;; Common Lisp #. reader macro (but not in interpreted code). -;;; -;;; o The form `eval-and-compile' is similar to eval-when-compile, but -;;; the whole form is evalled both at compile-time and at run-time. -;;; -;;; o The command M-x byte-compile-and-load-file does what you'd think. -;;; -;;; o The command compile-defun is analogous to eval-defun. -;;; -;;; o If you run byte-compile-file on a filename which is visited in a -;;; buffer, and that buffer is modified, you are asked whether you want -;;; to save the buffer before compiling. -;;; -;;; o You can add this to /etc/magic to make file(1) recognize the files -;;; generated by this compiler: -;;; -;;; 0 string ;ELC GNU Emacs Lisp compiled file, -;;; >4 byte x version %d -;;; -;;; TO DO: -;;; -;;; o Should implement declarations and proclamations, notably special, -;;; unspecial, and ignore. Do this in such a way as to not break cl.el. -;;; o The bound-but-not-used warnings are not issued for variables whose -;;; bindings were established in the arglist, due to the lack of an -;;; ignore declaration. Once ignore exists, this should be turned on. -;;; o Warn about functions and variables defined but not used? -;;; Maybe add some kind of `export' declaration for this? -;;; (With interactive functions being automatically exported?) -;;; o Any reference to a variable, even one which is a no-op, will cause -;;; the warning not to be given. Possibly we could use the for-effect -;;; flag to determine when this reference is useless; possibly more -;;; complex flow analysis would be necessary. -;;; o If the optimizer deletes a variable reference, we might be left with -;;; a bound-but-not-referenced warning. Generally this is ok, but not if -;;; it's a synergistic result of macroexpansion. Need some way to note -;;; that a varref is being optimized away? Of course it would be nice to -;;; optimize away the binding too, someday, but it's unsafe today. -;;; o (See byte-optimize.el for the optimization TODO list.) - -(require 'backquote) - -(or (fboundp 'defsubst) - ;; This really ought to be loaded already! - (load-library "bytecomp-runtime")) - -(eval-when-compile - (defvar byte-compile-single-version nil - "If this is true, the choice of emacs version (v19 or v20) byte-codes will -be hard-coded into bytecomp when it compiles itself. If the compiler itself -is compiled with optimization, this causes a speedup.") - - (cond - (byte-compile-single-version - (defmacro byte-compile-single-version () t) - (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond)))) - (t - (defmacro byte-compile-single-version () nil) - (defmacro byte-compile-version-cond (cond) cond))) - ) - -(defvar emacs-lisp-file-regexp (purecopy "\\.el$") - "*Regexp which matches Emacs Lisp source files. -You may want to redefine `byte-compile-dest-file' if you change this.") - -;; This enables file name handlers such as jka-compr -;; to remove parts of the file name that should not be copied -;; through to the output file name. -(defun byte-compiler-base-file-name (filename) - (let ((handler (find-file-name-handler filename - 'byte-compiler-base-file-name))) - (if handler - (funcall handler 'byte-compiler-base-file-name filename) - filename))) - -(unless (fboundp 'byte-compile-dest-file) - ;; The user may want to redefine this along with emacs-lisp-file-regexp, - ;; so only define it if it is undefined. - (defun byte-compile-dest-file (filename) - "Convert an Emacs Lisp source file name to a compiled file name." - (setq filename (byte-compiler-base-file-name filename)) - (setq filename (file-name-sans-versions filename)) - (if (string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc") - (concat filename ".elc")))) - -;; This can be the 'byte-compile property of any symbol. -(autoload 'byte-compile-inline-expand "byte-optimize") - -;; This is the entrypoint to the lapcode optimizer pass1. -(autoload 'byte-optimize-form "byte-optimize") -;; This is the entrypoint to the lapcode optimizer pass2. -(autoload 'byte-optimize-lapcode "byte-optimize") -(autoload 'byte-compile-unfold-lambda "byte-optimize") - -;; This is the entry point to the decompiler, which is used by the -;; disassembler. The disassembler just requires 'byte-compile, but -;; that doesn't define this function, so this seems to be a reasonable -;; thing to do. -(autoload 'byte-decompile-bytecode "byte-optimize") - -(defvar byte-compile-verbose - (and (not noninteractive) (> (device-baud-rate) search-slow-speed)) - "*Non-nil means print messages describing progress of byte-compiler.") - -(defvar byte-compile-emacs19-compatibility - (not (emacs-version>= 20)) - "*Non-nil means generate output that can run in Emacs 19.") - -(defvar byte-compile-print-gensym t - "*Non-nil means generate code that creates unique symbols at run-time. -This is achieved by printing uninterned symbols using the `#:SYMBOL' -notation, so that they will be read uninterned when run. - -With this feature, code that uses uninterned symbols in macros will -not be runnable under pre-21.0 XEmacsen. - -When `byte-compile-emacs19-compatibility' is non-nil, this variable is -ignored and considered to be nil.") - -(defvar byte-optimize t - "*Enables optimization in the byte compiler. -nil means don't do any optimization. -t means do all optimizations. -`source' means do source-level optimizations only. -`byte' means do code-level optimizations only.") - -(defvar byte-compile-delete-errors t - "*If non-nil, the optimizer may delete forms that may signal an error. -This includes variable references and calls to functions such as `car'.") - -;; XEmacs addition -(defvar byte-compile-new-bytecodes nil - "This is completely ignored. It is only around for backwards -compatibility.") - - -;; FSF enables byte-compile-dynamic-docstrings but not byte-compile-dynamic -;; by default. This would be a reasonable conservative approach except -;; for the fact that if you enable either of these, you get incompatible -;; byte code that can't be read by XEmacs 19.13 or before or FSF 19.28 or -;; before. -;; -;; Therefore, neither is enabled for 19.14. Both are enabled for 20.0 -;; because we have no reason to be conservative about changing the -;; way things work. (Ben) - -;; However, I don't think that defaulting byte-compile-dynamic to nil -;; is a compatibility issue - rather it is a performance issue. -;; Therefore I am setting byte-compile-dynamic back to nil. (mrb) - -(defvar byte-compile-dynamic nil - "*If non-nil, compile function bodies so they load lazily. -They are hidden comments in the compiled file, and brought into core when the -function is called. - -To enable this option, make it a file-local variable -in the source file you want it to apply to. -For example, add -*-byte-compile-dynamic: t;-*- on the first line. - -When this option is true, if you load the compiled file and then move it, -the functions you loaded will not be able to run.") - -(defvar byte-compile-dynamic-docstrings (emacs-version>= 20) - "*If non-nil, compile doc strings for lazy access. -We bury the doc strings of functions and variables -inside comments in the file, and bring them into core only when they -are actually needed. - -When this option is true, if you load the compiled file and then move it, -you won't be able to find the documentation of anything in that file. - -To disable this option for a certain file, make it a file-local variable -in the source file. For example, add this to the first line: - -*-byte-compile-dynamic-docstrings:nil;-*- -You can also set the variable globally. - -This option is enabled by default because it reduces Emacs memory usage.") - -(defvar byte-optimize-log nil - "*If true, the byte-compiler will log its optimizations into *Compile-Log*. -If this is 'source, then only source-level optimizations will be logged. -If it is 'byte, then only byte-level optimizations will be logged.") - -(defvar byte-compile-error-on-warn nil - "*If true, the byte-compiler reports warnings with `error'.") - -;; byte-compile-warning-types in FSF. -(defvar byte-compile-default-warnings - '(redefine callargs subr-callargs free-vars unresolved unused-vars obsolete) - "*The warnings used when byte-compile-warnings is t.") - -(defvar byte-compile-warnings t - "*List of warnings that the compiler should issue (t for the default set). -Elements of the list may be: - - free-vars references to variables not in the current lexical scope. - unused-vars references to non-global variables bound but not referenced. - unresolved calls to unknown functions. - callargs lambda calls with args that don't match the definition. - subr-callargs calls to subrs with args that don't match the definition. - redefine function cell redefined from a macro to a lambda or vice - versa, or redefined to take a different number of arguments. - obsolete use of an obsolete function or variable. - pedantic warn of use of compatible symbols. - -The default set is specified by `byte-compile-default-warnings' and -normally encompasses all possible warnings. - -See also the macro `byte-compiler-options'.") - -(defvar byte-compile-generate-call-tree nil - "*Non-nil means collect call-graph information when compiling. -This records functions that were called and from where. -If the value is t, compilation displays the call graph when it finishes. -If the value is neither t nor nil, compilation asks you whether to display -the graph. - -The call tree only lists functions called, not macros used. Those functions -which the byte-code interpreter knows about directly (eq, cons, etc.) are -not reported. - -The call tree also lists those functions which are not known to be called -\(that is, to which no calls have been compiled). Functions which can be -invoked interactively are excluded from this list.") - -(defconst byte-compile-call-tree nil "Alist of functions and their call tree. -Each element looks like - - \(FUNCTION CALLERS CALLS\) - -where CALLERS is a list of functions that call FUNCTION, and CALLS -is a list of functions for which calls were generated while compiling -FUNCTION.") - -(defvar byte-compile-call-tree-sort 'name - "*If non-nil, sort the call tree. -The values `name', `callers', `calls', `calls+callers' -specify different fields to sort on.") - -(defvar byte-compile-overwrite-file t - "If nil, old .elc files are deleted before the new is saved, and .elc -files will have the same modes as the corresponding .el file. Otherwise, -existing .elc files will simply be overwritten, and the existing modes -will not be changed. If this variable is nil, then an .elc file which -is a symbolic link will be turned into a normal file, instead of the file -which the link points to being overwritten.") - -(defvar byte-recompile-directory-ignore-errors-p nil - "If true, then `byte-recompile-directory' will continue compiling even -when an error occurs in a file. This is bound to t by -`batch-byte-recompile-directory'.") - -(defvar byte-recompile-directory-recursively t - "*If true, then `byte-recompile-directory' will recurse on subdirectories.") - -(defvar byte-compile-constants nil - "list of all constants encountered during compilation of this form") -(defvar byte-compile-variables nil - "list of all variables encountered during compilation of this form") -(defvar byte-compile-bound-variables nil - "Alist of variables bound in the context of the current form, -that is, the current lexical environment. This list lives partly -on the specbind stack. The cdr of each cell is an integer bitmask.") - -(defconst byte-compile-referenced-bit 1) -(defconst byte-compile-assigned-bit 2) -(defconst byte-compile-arglist-bit 4) -(defconst byte-compile-global-bit 8) - -(defvar byte-compile-free-references) -(defvar byte-compile-free-assignments) -(defvar debug-issue-ebola-notices) - -(defvar byte-compiler-error-flag) - -(defconst byte-compile-initial-macro-environment - (purecopy - '((byte-compiler-options . (lambda (&rest forms) - (apply 'byte-compiler-options-handler forms))) - (eval-when-compile . (lambda (&rest body) - (list 'quote (eval (byte-compile-top-level - (cons 'progn body)))))) - (eval-and-compile . (lambda (&rest body) - (eval (cons 'progn body)) - (cons 'progn body))))) - "The default macro-environment passed to macroexpand by the compiler. -Placing a macro here will cause a macro to have different semantics when -expanded by the compiler as when expanded by the interpreter.") - -(defvar byte-compile-macro-environment byte-compile-initial-macro-environment - "Alist of macros defined in the file being compiled. -Each element looks like (MACRONAME . DEFINITION). It is -\(MACRONAME . nil) when a macro is redefined as a function.") - -(defvar byte-compile-function-environment nil - "Alist of functions defined in the file being compiled. -This is so we can inline them when necessary. -Each element looks like (FUNCTIONNAME . DEFINITION). It is -\(FUNCTIONNAME . nil) when a function is redefined as a macro.") - -(defvar byte-compile-autoload-environment nil - "Alist of functions and macros defined by autoload in the file being compiled. -This is so we can suppress warnings about calls to these functions, even though -they do not have `real' definitions. -Each element looks like (FUNCTIONNAME . CALL-TO-AUTOLOAD).") - -(defvar byte-compile-unresolved-functions nil - "Alist of undefined functions to which calls have been compiled (used for -warnings when the function is later defined with incorrect args).") - -(defvar byte-compile-file-domain) ; domain of file being compiled - -(defvar byte-compile-tag-number 0) -(defvar byte-compile-output nil - "Alist describing contents to put in byte code string. -Each element is (INDEX . VALUE)") -(defvar byte-compile-depth 0 "Current depth of execution stack.") -(defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.") - - -;;; The byte codes; this information is duplicated in bytecode.c - -(defconst byte-code-vector nil - "An array containing byte-code names indexed by byte-code values.") - -(defconst byte-stack+-info nil - "An array with the stack adjustment for each byte-code.") - -(defmacro byte-defop (opcode stack-adjust opname &optional docstring) - ;; This is a speed-hack for building the byte-code-vector at compile-time. - ;; We fill in the vector at macroexpand-time, and then after the last call - ;; to byte-defop, we write the vector out as a constant instead of writing - ;; out a bunch of calls to aset. - ;; Actually, we don't fill in the vector itself, because that could make - ;; it problematic to compile big changes to this compiler; we store the - ;; values on its plist, and remove them later in -extrude. - (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value) - (put 'byte-code-vector 'tmp-compile-time-value - (make-vector 256 nil)))) - (v2 (or (get 'byte-stack+-info 'tmp-compile-time-value) - (put 'byte-stack+-info 'tmp-compile-time-value - (make-vector 256 nil))))) - (aset v1 opcode opname) - (aset v2 opcode stack-adjust)) - (if docstring - (list 'defconst opname opcode (concat "Byte code opcode " docstring ".")) - (list 'defconst opname opcode))) - -(defmacro byte-extrude-byte-code-vectors () - (prog1 (list 'setq 'byte-code-vector - (get 'byte-code-vector 'tmp-compile-time-value) - 'byte-stack+-info - (get 'byte-stack+-info 'tmp-compile-time-value)) - (remprop 'byte-code-vector 'tmp-compile-time-value) - (remprop 'byte-stack+-info 'tmp-compile-time-value))) - - -;; unused: 0-7 - -;; These opcodes are special in that they pack their argument into the -;; opcode word. -;; -(byte-defop 8 1 byte-varref "for variable reference") -(byte-defop 16 -1 byte-varset "for setting a variable") -(byte-defop 24 -1 byte-varbind "for binding a variable") -(byte-defop 32 0 byte-call "for calling a function") -(byte-defop 40 0 byte-unbind "for unbinding special bindings") -;; codes 8-47 are consumed by the preceding opcodes - -;; unused: 48-55 - -(byte-defop 56 -1 byte-nth) -(byte-defop 57 0 byte-symbolp) -(byte-defop 58 0 byte-consp) -(byte-defop 59 0 byte-stringp) -(byte-defop 60 0 byte-listp) -(byte-defop 61 -1 byte-old-eq) -(byte-defop 62 -1 byte-old-memq) -(byte-defop 63 0 byte-not) -(byte-defop 64 0 byte-car) -(byte-defop 65 0 byte-cdr) -(byte-defop 66 -1 byte-cons) -(byte-defop 67 0 byte-list1) -(byte-defop 68 -1 byte-list2) -(byte-defop 69 -2 byte-list3) -(byte-defop 70 -3 byte-list4) -(byte-defop 71 0 byte-length) -(byte-defop 72 -1 byte-aref) -(byte-defop 73 -2 byte-aset) -(byte-defop 74 0 byte-symbol-value) -(byte-defop 75 0 byte-symbol-function) ; this was commented out -(byte-defop 76 -1 byte-set) -(byte-defop 77 -1 byte-fset) ; this was commented out -(byte-defop 78 -1 byte-get) -(byte-defop 79 -2 byte-substring) -(byte-defop 80 -1 byte-concat2) -(byte-defop 81 -2 byte-concat3) -(byte-defop 82 -3 byte-concat4) -(byte-defop 83 0 byte-sub1) -(byte-defop 84 0 byte-add1) -(byte-defop 85 -1 byte-eqlsign) -(byte-defop 86 -1 byte-gtr) -(byte-defop 87 -1 byte-lss) -(byte-defop 88 -1 byte-leq) -(byte-defop 89 -1 byte-geq) -(byte-defop 90 -1 byte-diff) -(byte-defop 91 0 byte-negate) -(byte-defop 92 -1 byte-plus) -(byte-defop 93 -1 byte-max) -(byte-defop 94 -1 byte-min) -(byte-defop 95 -1 byte-mult) -(byte-defop 96 1 byte-point) -(byte-defop 97 -1 byte-eq) ; new as of v20 -(byte-defop 98 0 byte-goto-char) -(byte-defop 99 0 byte-insert) -(byte-defop 100 1 byte-point-max) -(byte-defop 101 1 byte-point-min) -(byte-defop 102 0 byte-char-after) -(byte-defop 103 1 byte-following-char) -(byte-defop 104 1 byte-preceding-char) -(byte-defop 105 1 byte-current-column) -(byte-defop 106 0 byte-indent-to) -(byte-defop 107 -1 byte-equal) ; new as of v20 -(byte-defop 108 1 byte-eolp) -(byte-defop 109 1 byte-eobp) -(byte-defop 110 1 byte-bolp) -(byte-defop 111 1 byte-bobp) -(byte-defop 112 1 byte-current-buffer) -(byte-defop 113 0 byte-set-buffer) -(byte-defop 114 0 byte-save-current-buffer - "To make a binding to record the current buffer.") -;;(byte-defop 114 1 byte-read-char-OBSOLETE) ;obsolete as of v19 -(byte-defop 115 -1 byte-memq) ; new as of v20 -(byte-defop 116 1 byte-interactive-p) - -(byte-defop 117 0 byte-forward-char) -(byte-defop 118 0 byte-forward-word) -(byte-defop 119 -1 byte-skip-chars-forward) -(byte-defop 120 -1 byte-skip-chars-backward) -(byte-defop 121 0 byte-forward-line) -(byte-defop 122 0 byte-char-syntax) -(byte-defop 123 -1 byte-buffer-substring) -(byte-defop 124 -1 byte-delete-region) -(byte-defop 125 -1 byte-narrow-to-region) -(byte-defop 126 1 byte-widen) -(byte-defop 127 0 byte-end-of-line) - -;; unused: 128 - -;; These store their argument in the next two bytes -(byte-defop 129 1 byte-constant2 - "for reference to a constant with vector index >= byte-constant-limit") -(byte-defop 130 0 byte-goto "for unconditional jump") -(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil") -(byte-defop 132 -1 byte-goto-if-not-nil - "to pop value and jump if it's not nil") -(byte-defop 133 -1 byte-goto-if-nil-else-pop - "to examine top-of-stack, jump and don't pop it if it's nil, -otherwise pop it") -(byte-defop 134 -1 byte-goto-if-not-nil-else-pop - "to examine top-of-stack, jump and don't pop it if it's non-nil, -otherwise pop it") - -(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'") -(byte-defop 136 -1 byte-discard "to discard one value from stack") -(byte-defop 137 1 byte-dup "to duplicate the top of the stack") - -(byte-defop 138 0 byte-save-excursion - "to make a binding to record the buffer, point and mark") -(byte-defop 139 0 byte-save-window-excursion - "to make a binding to record entire window configuration") -(byte-defop 140 0 byte-save-restriction - "to make a binding to record the current buffer clipping restrictions") -(byte-defop 141 -1 byte-catch - "for catch. Takes, on stack, the tag and an expression for the body") -(byte-defop 142 -1 byte-unwind-protect - "for unwind-protect. Takes, on stack, an expression for the unwind-action") - -;; For condition-case. Takes, on stack, the variable to bind, -;; an expression for the body, and a list of clauses. -(byte-defop 143 -2 byte-condition-case) - -;; For entry to with-output-to-temp-buffer. -;; Takes, on stack, the buffer name. -;; Binds standard-output and does some other things. -;; Returns with temp buffer on the stack in place of buffer name. -(byte-defop 144 0 byte-temp-output-buffer-setup) - -;; For exit from with-output-to-temp-buffer. -;; Expects the temp buffer on the stack underneath value to return. -;; Pops them both, then pushes the value back on. -;; Unbinds standard-output and makes the temp buffer visible. -(byte-defop 145 -1 byte-temp-output-buffer-show) - -;; To unbind back to the beginning of this frame. -;; Not used yet, but will be needed for tail-recursion elimination. -(byte-defop 146 0 byte-unbind-all) - -(byte-defop 147 -2 byte-set-marker) -(byte-defop 148 0 byte-match-beginning) -(byte-defop 149 0 byte-match-end) -(byte-defop 150 0 byte-upcase) -(byte-defop 151 0 byte-downcase) -(byte-defop 152 -1 byte-string=) -(byte-defop 153 -1 byte-string<) -(byte-defop 154 -1 byte-old-equal) -(byte-defop 155 -1 byte-nthcdr) -(byte-defop 156 -1 byte-elt) -(byte-defop 157 -1 byte-old-member) -(byte-defop 158 -1 byte-old-assq) -(byte-defop 159 0 byte-nreverse) -(byte-defop 160 -1 byte-setcar) -(byte-defop 161 -1 byte-setcdr) -(byte-defop 162 0 byte-car-safe) -(byte-defop 163 0 byte-cdr-safe) -(byte-defop 164 -1 byte-nconc) -(byte-defop 165 -1 byte-quo) -(byte-defop 166 -1 byte-rem) -(byte-defop 167 0 byte-numberp) -(byte-defop 168 0 byte-integerp) - -;; unused: 169 - -;; These are not present in FSF. -;; -(byte-defop 170 0 byte-rel-goto) -(byte-defop 171 -1 byte-rel-goto-if-nil) -(byte-defop 172 -1 byte-rel-goto-if-not-nil) -(byte-defop 173 -1 byte-rel-goto-if-nil-else-pop) -(byte-defop 174 -1 byte-rel-goto-if-not-nil-else-pop) - -(byte-defop 175 nil byte-listN) -(byte-defop 176 nil byte-concatN) -(byte-defop 177 nil byte-insertN) - -;; unused: 178-181 - -;; these ops are new to v20 -(byte-defop 182 -1 byte-member) -(byte-defop 183 -1 byte-assq) - -;; unused: 184-191 - -(byte-defop 192 1 byte-constant "for reference to a constant") -;; codes 193-255 are consumed by byte-constant. -(defconst byte-constant-limit 64 - "Exclusive maximum index usable in the `byte-constant' opcode.") - -(defconst byte-goto-ops (purecopy - '(byte-goto byte-goto-if-nil byte-goto-if-not-nil - byte-goto-if-nil-else-pop - byte-goto-if-not-nil-else-pop)) - "List of byte-codes whose offset is a pc.") - -(defconst byte-goto-always-pop-ops - (purecopy '(byte-goto-if-nil byte-goto-if-not-nil))) - -(defconst byte-rel-goto-ops - (purecopy '(byte-rel-goto byte-rel-goto-if-nil byte-rel-goto-if-not-nil - byte-rel-goto-if-nil-else-pop byte-rel-goto-if-not-nil-else-pop)) - "byte-codes for relative jumps.") - -(byte-extrude-byte-code-vectors) - -;;; lapcode generator -;;; -;;; the byte-compiler now does source -> lapcode -> bytecode instead of -;;; source -> bytecode, because it's a lot easier to make optimizations -;;; on lapcode than on bytecode. -;;; -;;; Elements of the lapcode list are of the form ( . ) -;;; where instruction is a symbol naming a byte-code instruction, -;;; and parameter is an argument to that instruction, if any. -;;; -;;; The instruction can be the pseudo-op TAG, which means that this position -;;; in the instruction stream is a target of a goto. (car PARAMETER) will be -;;; the PC for this location, and the whole instruction "(TAG pc)" will be the -;;; parameter for some goto op. -;;; -;;; If the operation is varbind, varref, varset or push-constant, then the -;;; parameter is (variable/constant . index_in_constant_vector). -;;; -;;; First, the source code is macroexpanded and optimized in various ways. -;;; Then the resultant code is compiled into lapcode. Another set of -;;; optimizations are then run over the lapcode. Then the variables and -;;; constants referenced by the lapcode are collected and placed in the -;;; constants-vector. (This happens now so that variables referenced by dead -;;; code don't consume space.) And finally, the lapcode is transformed into -;;; compacted byte-code. -;;; -;;; A distinction is made between variables and constants because the variable- -;;; referencing instructions are more sensitive to the variables being near the -;;; front of the constants-vector than the constant-referencing instructions. -;;; Also, this lets us notice references to free variables. - -(defun byte-compile-lapcode (lap) - "Turns lapcode into bytecode. The lapcode is destroyed." - ;; Lapcode modifications: changes the ID of a tag to be the tag's PC. - (let ((pc 0) ; Program counter - op off ; Operation & offset - (bytes '()) ; Put the output bytes here - (patchlist nil) ; List of tags and goto's to patch - rest rel tmp) - (while lap - (setq op (car (car lap)) - off (cdr (car lap))) - (cond ((not (symbolp op)) - (error "Non-symbolic opcode `%s'" op)) - ((eq op 'TAG) - (setcar off pc) - (push off patchlist)) - ((memq op byte-goto-ops) - (setq pc (+ pc 3)) - (setq bytes (cons (cons pc (cdr off)) - (cons nil - (cons (symbol-value op) bytes)))) - (push bytes patchlist)) - (t - (setq bytes - (cond ((cond ((consp off) - ;; Variable or constant reference - (setq off (cdr off)) - (eq op 'byte-constant))) - (cond ((< off byte-constant-limit) - (setq pc (1+ pc)) - (cons (+ byte-constant off) bytes)) - (t - (setq pc (+ 3 pc)) - (cons (lsh off -8) - (cons (logand off 255) - (cons byte-constant2 bytes)))))) - ((and (<= byte-listN (symbol-value op)) - (<= (symbol-value op) byte-insertN)) - (setq pc (+ 2 pc)) - (cons off (cons (symbol-value op) bytes))) - ((< off 6) - (setq pc (1+ pc)) - (cons (+ (symbol-value op) off) bytes)) - ((< off 256) - (setq pc (+ 2 pc)) - (cons off (cons (+ (symbol-value op) 6) bytes))) - (t - (setq pc (+ 3 pc)) - (cons (lsh off -8) - (cons (logand off 255) - (cons (+ (symbol-value op) 7) - bytes)))))))) - (setq lap (cdr lap))) - ;;(if (not (= pc (length bytes))) - ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) - (cond (t ;; starting with Emacs 19. - ;; Make relative jumps - (setq patchlist (nreverse patchlist)) - (while (progn - (setq off 0) ; PC change because of deleted bytes - (setq rest patchlist) - (while rest - (setq tmp (car rest)) - (and (consp (car tmp)) ; Jump - (prog1 (null (nth 1 tmp)) ; Absolute jump - (setq tmp (car tmp))) - (progn - (setq rel (- (car (cdr tmp)) (car tmp))) - (and (<= -129 rel) (< rel 128))) - (progn - ;; Convert to relative jump. - (setcdr (car rest) (cdr (cdr (car rest)))) - (setcar (cdr (car rest)) - (+ (car (cdr (car rest))) - (- byte-rel-goto byte-goto))) - (setq off (1- off)))) - (setcar tmp (+ (car tmp) off)) ; Adjust PC - (setq rest (cdr rest))) - ;; If optimizing, repeat until no change. - (and byte-optimize - (not (zerop off))))))) - ;; Patch PC into jumps - (let (bytes) - (while patchlist - (setq bytes (car patchlist)) - (cond ((atom (car bytes))) ; Tag - ((nth 1 bytes) ; Relative jump - (setcar bytes (+ (- (car (cdr (car bytes))) (car (car bytes))) - 128))) - (t ; Absolute jump - (setq pc (car (cdr (car bytes)))) ; Pick PC from tag - (setcar (cdr bytes) (logand pc 255)) - (setcar bytes (lsh pc -8)))) - (setq patchlist (cdr patchlist)))) - (concat (nreverse bytes)))) - - -;;; byte compiler messages - -(defvar byte-compile-current-form nil) -(defvar byte-compile-current-file nil) -(defvar byte-compile-dest-file nil) - -(defmacro byte-compile-log (format-string &rest args) - `(when (and byte-optimize (memq byte-optimize-log '(t source))) - (let ((print-escape-newlines t) - (print-level 4) - (print-length 4)) - (byte-compile-log-1 (format ,format-string ,@args))))) - -(defconst byte-compile-last-warned-form 'nothing) - -;; Log a message STRING in *Compile-Log*. -;; Also log the current function and file if not already done. -(defun byte-compile-log-1 (string &optional fill) - (let* ((this-form (or byte-compile-current-form "toplevel forms")) - (while-compiling-msg - (when (or byte-compile-current-file - (not (eq this-form byte-compile-last-warned-form))) - (format - "While compiling %s%s:" - this-form - (cond - ((stringp byte-compile-current-file) - (concat " in file " byte-compile-current-file)) - ((bufferp byte-compile-current-file) - (concat " in buffer " - (buffer-name byte-compile-current-file))) - ("")))))) - (if noninteractive - (progn - (when while-compiling-msg (message "%s" while-compiling-msg)) - (message " %s" string)) - (with-current-buffer (get-buffer-create "*Compile-Log*") - (goto-char (point-max)) - (when byte-compile-current-file - (when (> (point-max) (point-min)) - (insert "\n\^L\n")) - (insert (current-time-string) "\n")) - (when while-compiling-msg (insert while-compiling-msg "\n")) - (insert " " string "\n") - (when (and fill (not (string-match "\n" string))) - (let ((fill-prefix " ") - (fill-column 78)) - (fill-paragraph nil))))) - (setq byte-compile-current-file nil) - (setq byte-compile-last-warned-form this-form))) - -;; Log the start of a file in *Compile-Log*, and mark it as done. -;; But do nothing in batch mode. -(defun byte-compile-log-file () - (when (and byte-compile-current-file (not noninteractive)) - (with-current-buffer (get-buffer-create "*Compile-Log*") - (when (> (point-max) (point-min)) - (goto-char (point-max)) - (insert "\n\^L\n")) - (insert "Compiling " - (if (stringp byte-compile-current-file) - (concat "file " byte-compile-current-file) - (concat "buffer " (buffer-name byte-compile-current-file))) - " at " (current-time-string) "\n") - (setq byte-compile-current-file nil)))) - -(defun byte-compile-warn (format &rest args) - (setq format (apply 'format format args)) - (if byte-compile-error-on-warn - (error "%s" format) ; byte-compile-file catches and logs it - (byte-compile-log-1 (concat "** " format) t) -;;; RMS says: -;;; It is useless to flash warnings too fast to be read. -;;; Besides, they will all be shown at the end. -;;; and comments out the next two lines. - (or noninteractive ; already written on stdout. - (message "Warning: %s" format)))) - -;;; This function should be used to report errors that have halted -;;; compilation of the current file. -(defun byte-compile-report-error (error-info) - (setq byte-compiler-error-flag t) - (byte-compile-log-1 - (concat "!! " - (format (if (cdr error-info) "%s (%s)" "%s") - (get (car error-info) 'error-message) - (prin1-to-string (cdr error-info)))))) - -;;; Used by make-obsolete. -(defun byte-compile-obsolete (form) - (let ((new (get (car form) 'byte-obsolete-info))) - (if (memq 'obsolete byte-compile-warnings) - (byte-compile-warn "%s is an obsolete function; %s" (car form) - (if (stringp (car new)) - (car new) - (format "use %s instead." (car new))))) - (funcall (or (cdr new) 'byte-compile-normal-call) form))) - -;;; Used by make-obsolete. -(defun byte-compile-compatible (form) - (let ((new (get (car form) 'byte-compatible-info))) - (if (memq 'pedantic byte-compile-warnings) - (byte-compile-warn "%s is provided for compatibility; %s" (car form) - (if (stringp (car new)) - (car new) - (format "use %s instead." (car new))))) - (funcall (or (cdr new) 'byte-compile-normal-call) form))) - -;; Compiler options - -(defconst byte-compiler-legal-options - '((optimize byte-optimize (t nil source byte) val) - (file-format byte-compile-emacs19-compatibility (emacs19 emacs20) - (eq val 'emacs19)) - (delete-errors byte-compile-delete-errors (t nil) val) - (verbose byte-compile-verbose (t nil) val) - (new-bytecodes byte-compile-new-bytecodes (t nil) val) - (warnings byte-compile-warnings - ((callargs subr-callargs redefine free-vars unused-vars unresolved)) - val))) - -;; XEmacs addition -(defconst byte-compiler-obsolete-options - '((new-bytecodes t))) - -;; Inhibit v19/v20 selectors if the version is hardcoded. -;; #### This should print a warning if the user tries to change something -;; than can't be changed because the running compiler doesn't support it. -(cond - ((byte-compile-single-version) - (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options))) - (if (byte-compile-version-cond byte-compile-emacs19-compatibility) - '(emacs19) '(emacs20))))) - -;; now we can copy it. -(setq byte-compiler-legal-options (purecopy byte-compiler-legal-options)) - -(defun byte-compiler-options-handler (&rest args) - (let (key val desc choices) - (while args - (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args)))) - (error "malformed byte-compiler-option %s" (car args))) - (setq key (car (car args)) - val (car (cdr (car args))) - desc (assq key byte-compiler-legal-options)) - (or desc - (error "unknown byte-compiler option %s" key)) - (if (assq key byte-compiler-obsolete-options) - (byte-compile-warn "%s is an obsolete byte-compiler option." key)) - (setq choices (nth 2 desc)) - (if (consp (car choices)) - (let* (this - (handler 'cons) - (var (nth 1 desc)) - (ret (and (memq (car val) '(+ -)) - (copy-sequence (if (eq t (symbol-value var)) - (car choices) - (symbol-value var)))))) - (setq choices (car choices)) - (while val - (setq this (car val)) - (cond ((memq this choices) - (setq ret (funcall handler this ret))) - ((eq this '+) (setq handler 'cons)) - ((eq this '-) (setq handler 'delq)) - ((error "%s only accepts %s." key choices))) - (setq val (cdr val))) - (set (nth 1 desc) ret)) - (or (memq val choices) - (error "%s must be one of %s." key choices)) - (set (nth 1 desc) (eval (nth 3 desc)))) - (setq args (cdr args))) - nil)) - -;;; sanity-checking arglists - -(defun byte-compile-fdefinition (name macro-p) - (let* ((list (if (memq macro-p '(nil subr)) - byte-compile-function-environment - byte-compile-macro-environment)) - (env (cdr (assq name list)))) - (or env - (let ((fn name)) - (while (and (symbolp fn) - (fboundp fn) - (or (symbolp (symbol-function fn)) - (consp (symbol-function fn)) - (and (not macro-p) - (compiled-function-p (symbol-function fn))) - (and (eq macro-p 'subr) (subrp fn)))) - (setq fn (symbol-function fn))) - (if (or (and (not macro-p) (compiled-function-p fn)) - (and (eq macro-p 'subr) (subrp fn))) - fn - (and (consp fn) - (not (eq macro-p 'subr)) - (if (eq 'macro (car fn)) - (cdr fn) - (if macro-p - nil - (if (eq 'autoload (car fn)) - nil - fn))))))))) - -(defun byte-compile-arglist-signature (arglist) - (let ((args 0) - opts - restp) - (while arglist - (cond ((eq (car arglist) '&optional) - (or opts (setq opts 0))) - ((eq (car arglist) '&rest) - (if (cdr arglist) - (setq restp t - arglist nil))) - (t - (if opts - (setq opts (1+ opts)) - (setq args (1+ args))))) - (setq arglist (cdr arglist))) - (cons args (if restp nil (if opts (+ args opts) args))))) - - -(defun byte-compile-arglist-signatures-congruent-p (old new) - (not (or - (> (car new) (car old)) ; requires more args now - (and (null (cdr old)) ; tooks rest-args, doesn't any more - (cdr new)) - (and (cdr new) (cdr old) ; can't take as many args now - (< (cdr new) (cdr old))) - ))) - -(defun byte-compile-arglist-signature-string (signature) - (cond ((null (cdr signature)) - (format "%d+" (car signature))) - ((= (car signature) (cdr signature)) - (format "%d" (car signature))) - (t (format "%d-%d" (car signature) (cdr signature))))) - - -;; Warn if the form is calling a function with the wrong number of arguments. -(defun byte-compile-callargs-warn (form) - (let* ((def (or (byte-compile-fdefinition (car form) nil) - (byte-compile-fdefinition (car form) t))) - (sig (and def (byte-compile-arglist-signature - (if (eq 'lambda (car-safe def)) - (nth 1 def) - (if (compiled-function-p def) - (compiled-function-arglist def) - '(&rest def)))))) - (ncall (length (cdr form)))) - (if (and (null def) - (fboundp 'subr-min-args) - (setq def (byte-compile-fdefinition (car form) 'subr))) - (setq sig (cons (subr-min-args def) (subr-max-args def)))) - (if sig - (if (or (< ncall (car sig)) - (and (cdr sig) (> ncall (cdr sig)))) - (byte-compile-warn - "%s called with %d argument%s, but %s %s" - (car form) ncall - (if (= 1 ncall) "" "s") - (if (< ncall (car sig)) - "requires" - "accepts only") - (byte-compile-arglist-signature-string sig))) - (or (fboundp (car form)) ; might be a subr or autoload. - ;; ## this doesn't work with recursion. - (eq (car form) byte-compile-current-form) - ;; It's a currently-undefined function. - ;; Remember number of args in call. - (let ((cons (assq (car form) byte-compile-unresolved-functions)) - (n (length (cdr form)))) - (if cons - (or (memq n (cdr cons)) - (setcdr cons (cons n (cdr cons)))) - (setq byte-compile-unresolved-functions - (cons (list (car form) n) - byte-compile-unresolved-functions)))))))) - -;; Warn if the function or macro is being redefined with a different -;; number of arguments. -(defun byte-compile-arglist-warn (form macrop) - (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) - (if old - (let ((sig1 (byte-compile-arglist-signature - (if (eq 'lambda (car-safe old)) - (nth 1 old) - (if (compiled-function-p old) - (compiled-function-arglist old) - '(&rest def))))) - (sig2 (byte-compile-arglist-signature (nth 2 form)))) - (or (byte-compile-arglist-signatures-congruent-p sig1 sig2) - (byte-compile-warn "%s %s used to take %s %s, now takes %s" - (if (eq (car form) 'defun) "function" "macro") - (nth 1 form) - (byte-compile-arglist-signature-string sig1) - (if (equal sig1 '(1 . 1)) "argument" "arguments") - (byte-compile-arglist-signature-string sig2)))) - ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions)) - nums sig min max) - (if calls - (progn - (setq sig (byte-compile-arglist-signature (nth 2 form)) - nums (sort (copy-sequence (cdr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (if (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-warn - "%s being defined to take %s%s, but was previously called with %s" - (nth 1 form) - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max)))) - - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions))))) - ))) - -;; If we have compiled any calls to functions which are not known to be -;; defined, issue a warning enumerating them. -;; `unresolved' in the list `byte-compile-warnings' disables this. -(defun byte-compile-warn-about-unresolved-functions (&optional msg) - (if (memq 'unresolved byte-compile-warnings) - (let ((byte-compile-current-form (or msg "the end of the data"))) - ;; First delete the autoloads from the list. - (if byte-compile-autoload-environment - (let ((rest byte-compile-unresolved-functions)) - (while rest - (if (assq (car (car rest)) byte-compile-autoload-environment) - (setq byte-compile-unresolved-functions - (delq (car rest) byte-compile-unresolved-functions))) - (setq rest (cdr rest))))) - ;; Now warn. - (if (cdr byte-compile-unresolved-functions) - (let* ((str "The following functions are not known to be defined: ") - (L (+ (length str) 5)) - (rest (reverse byte-compile-unresolved-functions)) - s) - (while rest - (setq s (symbol-name (car (car rest))) - L (+ L (length s) 2) - rest (cdr rest)) - (if (<= L (1- fill-column)) - (setq str (concat str " " s (and rest ","))) - (setq str (concat str "\n " s (and rest ",")) - L (+ (length s) 4)))) - (byte-compile-warn "%s" str)) - (if byte-compile-unresolved-functions - (byte-compile-warn "the function %s is not known to be defined." - (car (car byte-compile-unresolved-functions))))))) - nil) - -(defun byte-compile-defvar-p (var) - ;; Whether the byte compiler thinks that non-lexical references to this - ;; variable are ok. - (or (globally-boundp var) - (let ((rest byte-compile-bound-variables)) - (while (and rest var) - (if (and (eq var (car-safe (car rest))) - (not (= 0 (logand (cdr (car rest)) - byte-compile-global-bit)))) - (setq var nil)) - (setq rest (cdr rest))) - ;; if var is nil at this point, it's a defvar in this file. - (not var)))) - - -;;; If we have compiled bindings of variables which have no referents, warn. -(defun byte-compile-warn-about-unused-variables () - (let ((rest byte-compile-bound-variables) - (unreferenced '()) - cell) - (while (and rest - ;; only warn about variables whose lifetime is now ending, - ;; that is, variables from the lexical scope that is now - ;; terminating. (Think nested lets.) - (not (eq (car rest) 'new-scope))) - (setq cell (car rest)) - (if (and (= 0 (logand byte-compile-referenced-bit (cdr cell))) - ;; Don't warn about declared-but-unused arguments, - ;; for two reasons: first, the arglist structure - ;; might be imposed by external forces, and we don't - ;; have (declare (ignore x)) yet; and second, inline - ;; expansion produces forms like - ;; ((lambda (arg) (byte-code "..." [arg])) x) - ;; which we can't (ok, well, don't) recognize as - ;; containing a reference to arg, so every inline - ;; expansion would generate a warning. (If we had - ;; `ignore' then inline expansion could emit an - ;; ignore declaration.) - (= 0 (logand byte-compile-arglist-bit (cdr cell))) - ;; Don't warn about defvars because this is a - ;; legitimate special binding. - (not (byte-compile-defvar-p (car cell)))) - (setq unreferenced (cons (car cell) unreferenced))) - (setq rest (cdr rest))) - (setq unreferenced (nreverse unreferenced)) - (while unreferenced - (byte-compile-warn - (format "variable %s bound but not referenced" (car unreferenced))) - (setq unreferenced (cdr unreferenced))))) - - -(defmacro byte-compile-constant-symbol-p (symbol) - `(or (keywordp ,symbol) (memq ,symbol '(nil t)))) - -(defmacro byte-compile-constp (form) - ;; Returns non-nil if FORM is a constant. - `(cond ((consp ,form) (eq (car ,form) 'quote)) - ((symbolp ,form) (byte-compile-constant-symbol-p ,form)) - (t))) - -(defmacro byte-compile-close-variables (&rest body) - `(let - (;; - ;; Close over these variables to encapsulate the - ;; compilation state - ;; - (byte-compile-macro-environment - ;; Copy it because the compiler may patch into the - ;; macroenvironment. - (copy-alist byte-compile-initial-macro-environment)) - (byte-compile-function-environment nil) - (byte-compile-autoload-environment nil) - (byte-compile-unresolved-functions nil) - (byte-compile-bound-variables nil) - (byte-compile-free-references nil) - (byte-compile-free-assignments nil) - ;; - ;; Close over these variables so that `byte-compiler-options' - ;; can change them on a per-file basis. - ;; - (byte-compile-verbose byte-compile-verbose) - (byte-optimize byte-optimize) - (byte-compile-emacs19-compatibility - byte-compile-emacs19-compatibility) - (byte-compile-dynamic byte-compile-dynamic) - (byte-compile-dynamic-docstrings - byte-compile-dynamic-docstrings) - (byte-compile-warnings (if (eq byte-compile-warnings t) - byte-compile-default-warnings - byte-compile-warnings)) - (byte-compile-file-domain nil) - - ;; We reserve the right to compare ANY objects for equality. - (debug-issue-ebola-notices -42) - ) - (prog1 - (progn ,@body) - (if (memq 'unused-vars byte-compile-warnings) - ;; done compiling in this scope, warn now. - (byte-compile-warn-about-unused-variables))))) - - -(defmacro displaying-byte-compile-warnings (&rest body) - `(let* ((byte-compile-log-buffer (get-buffer-create "*Compile-Log*")) - (byte-compile-point-max-prev (point-max byte-compile-log-buffer))) - ;; Log the file name or buffer name. - (byte-compile-log-file) - ;; Record how much is logged now. - ;; We will display the log buffer if anything more is logged - ;; before the end of BODY. - (defvar byte-compile-warnings-beginning) - (let ((byte-compile-warnings-beginning - (if (boundp 'byte-compile-warnings-beginning) - byte-compile-warnings-beginning - (point-max byte-compile-log-buffer)))) - - (unwind-protect - (condition-case error-info - (progn ,@body) - (error - (byte-compile-report-error error-info))) - - ;; Always set point in log to start of interesting output. - (with-current-buffer byte-compile-log-buffer - (let ((show-begin - (progn (goto-char byte-compile-point-max-prev) - (skip-chars-forward "\^L\n") - (point)))) - ;; If there were compilation warnings, display them. - (if temp-buffer-show-function - (let ((show-buffer (get-buffer-create "*Compile-Log-Show*"))) - ;; Always clean show-buffer, even when not displaying it, - ;; so that misleading previous messages aren't left around. - (with-current-buffer show-buffer - (setq buffer-read-only nil) - (erase-buffer)) - (copy-to-buffer show-buffer show-begin (point-max)) - (when (< byte-compile-warnings-beginning (point-max)) - (funcall temp-buffer-show-function show-buffer))) - (when (< byte-compile-warnings-beginning (point-max)) - (select-window - (prog1 (selected-window) - (select-window (display-buffer (current-buffer))) - (goto-char show-begin) - (recenter 1))))))))))) - - -;;;###autoload -(defun byte-force-recompile (directory) - "Recompile every `.el' file in DIRECTORY that already has a `.elc' file. -Files in subdirectories of DIRECTORY are processed also." - (interactive "DByte force recompile (directory): ") - (byte-recompile-directory directory nil t)) - -;;;###autoload -(defun byte-recompile-directory (directory &optional arg norecursion force) - "Recompile every `.el' file in DIRECTORY that needs recompilation. -This is if a `.elc' file exists but is older than the `.el' file. -Files in subdirectories of DIRECTORY are processed also unless argument -NORECURSION is non-nil. - -If the `.elc' file does not exist, normally the `.el' file is *not* compiled. -But a prefix argument (optional second arg) means ask user, -for each such `.el' file, whether to compile it. Prefix argument 0 means -don't ask and compile the file anyway. - -A nonzero prefix argument also means ask about each subdirectory. - -If the fourth argument FORCE is non-nil, -recompile every `.el' file that already has a `.elc' file." - (interactive "DByte recompile directory: \nP") - (if arg - (setq arg (prefix-numeric-value arg))) - (if noninteractive - nil - (save-some-buffers) - (redraw-modeline)) - (let ((directories (list (expand-file-name directory))) - (file-count 0) - (dir-count 0) - last-dir) - (displaying-byte-compile-warnings - (while directories - (setq directory (file-name-as-directory (car directories))) - (or noninteractive (message "Checking %s..." directory)) - (let ((files (directory-files directory)) - source dest) - (while files - (setq source (expand-file-name (car files) directory)) - (if (and (not (member (car files) '("." ".." "RCS" "CVS" "SCCS"))) - ;; Stay away from directory back-links, etc: - (not (file-symlink-p source)) - (file-directory-p source) - byte-recompile-directory-recursively) - ;; This file is a subdirectory. Handle them differently. - (if (or (null arg) - (eq arg 0) - (y-or-n-p (concat "Check " source "? "))) - (setq directories - (nconc directories (list source)))) - ;; It is an ordinary file. Decide whether to compile it. - (if (and (string-match emacs-lisp-file-regexp source) - (not (auto-save-file-name-p source)) - (setq dest (byte-compile-dest-file source)) - (if (file-exists-p dest) - ;; File was already compiled. - (or force (file-newer-than-file-p source dest)) - ;; No compiled file exists yet. - (and arg - (or (eq 0 arg) - (y-or-n-p (concat "Compile " source "? ")))))) - (progn ;(if (and noninteractive (not byte-compile-verbose)) - ; (message "Compiling %s..." source)) - ; we do this in byte-compile-file. - (if byte-recompile-directory-ignore-errors-p - (batch-byte-compile-1 source) - (byte-compile-file source)) - (or noninteractive - (message "Checking %s..." directory)) - (setq file-count (1+ file-count)) - (if (not (eq last-dir directory)) - (setq last-dir directory - dir-count (1+ dir-count))) - ))) - (setq files (cdr files)))) - (setq directories (cdr directories)))) - (message "Done (Total of %d file%s compiled%s)" - file-count (if (= file-count 1) "" "s") - (if (> dir-count 1) (format " in %d directories" dir-count) "")))) - -;;;###autoload -(defun byte-recompile-file (filename &optional force) - "Recompile a file of Lisp code named FILENAME if it needs recompilation. -This is if the `.elc' file exists but is older than the `.el' file. - -If the `.elc' file does not exist, normally the `.el' file is *not* -compiled. But a prefix argument (optional second arg) means ask user -whether to compile it. Prefix argument 0 don't ask and recompile anyway." - (interactive "fByte recompile file: \nP") - (let ((dest)) - (if (and (string-match emacs-lisp-file-regexp filename) - (not (auto-save-file-name-p filename)) - (setq dest (byte-compile-dest-file filename)) - (if (file-exists-p dest) - (file-newer-than-file-p filename dest) - (and force - (or (eq 0 force) - (y-or-n-p (concat "Compile " filename "? ")))))) - (byte-compile-file filename)))) - -;;;###autoload -(defun byte-compile-file (filename &optional load) - "Compile a file of Lisp code named FILENAME into a file of byte code. -The output file's name is made by appending `c' to the end of FILENAME. -With prefix arg (noninteractively: 2nd arg), load the file after compiling." -;; (interactive "fByte compile file: \nP") - (interactive - (let ((file buffer-file-name) - (file-name nil) - (file-dir nil)) - (and file - (eq (cdr (assq 'major-mode (buffer-local-variables))) - 'emacs-lisp-mode) - (setq file-name (file-name-nondirectory file) - file-dir (file-name-directory file))) - (list (read-file-name (if current-prefix-arg - "Byte compile and load file: " - "Byte compile file: ") - file-dir nil nil file-name) - current-prefix-arg))) - ;; Expand now so we get the current buffer's defaults - (setq filename (expand-file-name filename)) - - ;; If we're compiling a file that's in a buffer and is modified, offer - ;; to save it first. - (or noninteractive - (let ((b (get-file-buffer (expand-file-name filename)))) - (if (and b (buffer-modified-p b) - (y-or-n-p (format "save buffer %s first? " (buffer-name b)))) - (save-excursion (set-buffer b) (save-buffer))))) - - (if (or noninteractive byte-compile-verbose) ; XEmacs change - (message "Compiling %s..." filename)) - (let (;;(byte-compile-current-file (file-name-nondirectory filename)) - (byte-compile-current-file filename) - target-file input-buffer output-buffer - byte-compile-dest-file) - (setq target-file (byte-compile-dest-file filename)) - (setq byte-compile-dest-file target-file) - (save-excursion - (setq input-buffer (get-buffer-create " *Compiler Input*")) - (set-buffer input-buffer) - (erase-buffer) - (insert-file-contents filename) - ;; Run hooks including the uncompression hook. - ;; If they change the file name, then change it for the output also. - (let ((buffer-file-name filename) - (default-major-mode 'emacs-lisp-mode) - (enable-local-eval nil)) - (normal-mode) - (setq filename buffer-file-name))) - (setq byte-compiler-error-flag nil) - ;; It is important that input-buffer not be current at this call, - ;; so that the value of point set in input-buffer - ;; within byte-compile-from-buffer lingers in that buffer. - (setq output-buffer (byte-compile-from-buffer input-buffer filename)) - (if byte-compiler-error-flag - nil - (if byte-compile-verbose - (message "Compiling %s...done" filename)) - (kill-buffer input-buffer) - (save-excursion - (set-buffer output-buffer) - (goto-char (point-max)) - (insert "\n") ; aaah, unix. - (setq target-file (byte-compile-dest-file filename)) - (unless byte-compile-overwrite-file - (ignore-file-errors (delete-file target-file))) - (if (file-writable-p target-file) - (progn - (when (memq system-type '(ms-dos windows-nt)) - (defvar buffer-file-type) - (setq buffer-file-type t)) - (write-region 1 (point-max) target-file)) - ;; This is just to give a better error message than write-region - (signal 'file-error - (list "Opening output file" - (if (file-exists-p target-file) - "cannot overwrite file" - "directory not writable or nonexistent") - target-file))) - (or byte-compile-overwrite-file - (condition-case () - (set-file-modes target-file (file-modes filename)) - (error nil))) - (kill-buffer (current-buffer))) - (if (and byte-compile-generate-call-tree - (or (eq t byte-compile-generate-call-tree) - (y-or-n-p (format "Report call tree for %s? " filename)))) - (save-excursion - (display-call-tree filename))) - (if load - (load target-file)) - t))) - -;; RMS comments the next two out. - -;;;###autoload -(defun byte-compile-and-load-file (&optional filename) - "Compile a file of Lisp code named FILENAME into a file of byte code, -and then load it. The output file's name is made by appending \"c\" to -the end of FILENAME." - (interactive) - (if filename ; I don't get it, (interactive-p) doesn't always work - (byte-compile-file filename t) - (let ((current-prefix-arg '(4))) - (call-interactively 'byte-compile-file)))) - -;;;###autoload -(defun byte-compile-buffer (&optional buffer) - "Byte-compile and evaluate contents of BUFFER (default: the current buffer)." - (interactive "bByte compile buffer: ") - (setq buffer (if buffer (get-buffer buffer) (current-buffer))) - (message "Compiling %s..." buffer) - (let* ((filename (or (buffer-file-name buffer) - (prin1-to-string buffer))) - (byte-compile-current-file buffer)) - (byte-compile-from-buffer buffer filename t)) - (message "Compiling %s...done" buffer) - t) - -;;; compiling a single function -;;;###autoload -(defun compile-defun (&optional arg) - "Compile and evaluate the current top-level form. -Print the result in the minibuffer. -With argument, insert value in current buffer after the form." - (interactive "P") - (save-excursion - (end-of-defun) - (beginning-of-defun) - (let* ((byte-compile-current-file (buffer-file-name)) - (load-file-name (buffer-file-name)) - (byte-compile-last-warned-form 'nothing) - (value (eval (displaying-byte-compile-warnings - (byte-compile-sexp (read (current-buffer)) - "toplevel forms"))))) - (cond (arg - (message "Compiling from buffer... done.") - (prin1 value (current-buffer)) - (insert "\n")) - ((message "%s" (prin1-to-string value))))))) - -(defvar byte-compile-inbuffer) -(defvar byte-compile-outbuffer) - -(defun byte-compile-from-buffer (byte-compile-inbuffer filename &optional eval) - ;; buffer --> output-buffer, or buffer --> eval form, return nil - (let (byte-compile-outbuffer - ;; Prevent truncation of flonums and lists as we read and print them - (float-output-format nil) - (case-fold-search nil) - (print-length nil) - (print-level nil) - ;; Simulate entry to byte-compile-top-level - (byte-compile-constants nil) - (byte-compile-variables nil) - (byte-compile-tag-number 0) - (byte-compile-depth 0) - (byte-compile-maxdepth 0) - (byte-compile-output nil) - ;; #### This is bound in b-c-close-variables. - ;; (byte-compile-warnings (if (eq byte-compile-warnings t) - ;; byte-compile-warning-types - ;; byte-compile-warnings)) - ) - (byte-compile-close-variables - (save-excursion - (setq byte-compile-outbuffer - (set-buffer (get-buffer-create " *Compiler Output*"))) - (erase-buffer) - ;; (emacs-lisp-mode) - (setq case-fold-search nil) - (and filename - (not eval) - (byte-compile-insert-header filename - byte-compile-inbuffer - byte-compile-outbuffer)) - - ;; This is a kludge. Some operating systems (OS/2, DOS) need to - ;; write files containing binary information specially. - ;; Under most circumstances, such files will be in binary - ;; overwrite mode, so those OS's use that flag to guess how - ;; they should write their data. Advise them that .elc files - ;; need to be written carefully. - (setq overwrite-mode 'overwrite-mode-binary)) - (displaying-byte-compile-warnings - (save-excursion - (set-buffer byte-compile-inbuffer) - (goto-char 1) - - ;; Compile the forms from the input buffer. - (while (progn - (while (progn (skip-chars-forward " \t\n\^L") - (looking-at ";")) - (forward-line 1)) - (not (eobp))) - (byte-compile-file-form (read byte-compile-inbuffer))) - - ;; Compile pending forms at end of file. - (byte-compile-flush-pending) - (byte-compile-warn-about-unresolved-functions) - ;; Should we always do this? When calling multiple files, it - ;; would be useful to delay this warning until all have - ;; been compiled. - (setq byte-compile-unresolved-functions nil))) - (save-excursion - (set-buffer byte-compile-outbuffer) - (goto-char (point-min)))) - (if (not eval) - byte-compile-outbuffer - (let (form) - (while (condition-case nil - (progn (setq form (read byte-compile-outbuffer)) - t) - (end-of-file nil)) - (eval form))) - (kill-buffer byte-compile-outbuffer) - nil))) - -(defun byte-compile-insert-header (filename byte-compile-inbuffer - byte-compile-outbuffer) - (set-buffer byte-compile-inbuffer) - (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (set-buffer byte-compile-outbuffer) - (goto-char 1) - ;; - ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After that is - ;; the file-format version number (19 or 20) as a byte, followed by some - ;; nulls. The primary motivation for doing this is to get some binary - ;; characters up in the first line of the file so that `diff' will simply - ;; say "Binary files differ" instead of actually doing a diff of two .elc - ;; files. An extra benefit is that you can add this to /etc/magic: - ;; - ;; 0 string ;ELC GNU Emacs Lisp compiled file, - ;; >4 byte x version %d - ;; - (insert - ";ELC" - (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 19 20) - "\000\000\000\n" - ) - (insert ";;; compiled by " - (or (and (boundp 'user-mail-address) user-mail-address) - (concat (user-login-name) "@" (system-name))) - " on " - (current-time-string) "\n;;; from file " filename "\n") - (insert ";;; emacs version " emacs-version ".\n") - (insert ";;; bytecomp version " byte-compile-version "\n;;; " - (cond - ((eq byte-optimize 'source) "source-level optimization only") - ((eq byte-optimize 'byte) "byte-level optimization only") - (byte-optimize "optimization is on") - (t "optimization is off")) - (if (byte-compile-version-cond byte-compile-emacs19-compatibility) - "; compiled with Emacs 19 compatibility.\n" - ".\n")) - (if (not (byte-compile-version-cond byte-compile-emacs19-compatibility)) - (insert ";;; this file uses opcodes which do not exist in Emacs 19.\n" - ;; Have to check if emacs-version is bound so that this works - ;; in files loaded early in loadup.el. - "\n(if (and (boundp 'emacs-version)\n" - "\t (or (and (boundp 'epoch::version) epoch::version)\n" - "\t (string-lessp emacs-version \"20\")))\n" - " (error \"`" - ;; prin1-to-string is used to quote backslashes. - (substring (prin1-to-string (file-name-nondirectory filename)) - 1 -1) - "' was compiled for Emacs 20\"))\n\n")) - (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n" - "\n") - (if (and (byte-compile-version-cond byte-compile-emacs19-compatibility) - dynamic-docstrings) - (insert ";;; this file uses opcodes which do not exist prior to\n" - ";;; XEmacs 19.14/GNU Emacs 19.29 or later." - ;; Have to check if emacs-version is bound so that this works - ;; in files loaded early in loadup.el. - "\n(if (and (boundp 'emacs-version)\n" - "\t (or (and (boundp 'epoch::version) epoch::version)\n" - "\t (and (not (string-match \"XEmacs\" emacs-version))\n" - "\t (string-lessp emacs-version \"19.29\"))\n" - "\t (string-lessp emacs-version \"19.14\")))\n" - " (error \"`" - ;; prin1-to-string is used to quote backslashes. - (substring (prin1-to-string (file-name-nondirectory filename)) - 1 -1) - "' was compiled for XEmacs 19.14/Emacs 19.29 or later\"))\n\n" - ) - )) - - ;; back in the inbuffer; determine and set the coding system for the .elc - ;; file if under Mule. If there are any extended characters in the - ;; input file, use `escape-quoted' to make sure that both binary and - ;; extended characters are output properly and distinguished properly. - ;; Otherwise, use `no-conversion' for maximum portability with non-Mule - ;; Emacsen. - (when (featurep 'mule) - (defvar buffer-file-coding-system) - (if (save-excursion - (set-buffer byte-compile-inbuffer) - (goto-char (point-min)) - ;; mrb- There must be a better way than skip-chars-forward - (skip-chars-forward (concat (char-to-string 0) "-" - (char-to-string 255))) - (eq (point) (point-max))) - (setq buffer-file-coding-system 'no-conversion) - (insert "(require 'mule)\n;;;###coding system: escape-quoted\n") - (setq buffer-file-coding-system 'escape-quoted) - ;; #### Lazy loading not yet implemented for MULE files - ;; mrb - Fix this someday. - (save-excursion - (set-buffer byte-compile-inbuffer) - (setq byte-compile-dynamic nil - byte-compile-dynamic-docstrings nil)) - ;;(external-debugging-output (prin1-to-string (buffer-local-variables)))) - )) - ) - - -(defun byte-compile-output-file-form (form) - ;; writes the given form to the output buffer, being careful of docstrings - ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is - ;; so amazingly stupid. - ;; defalias calls are output directly by byte-compile-file-form-defmumble; - ;; it does not pay to first build the defalias in defmumble and then parse - ;; it here. - (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload)) - (stringp (nth 3 form))) - (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil - (eq (car form) 'autoload)) - (let ((print-escape-newlines t) - (print-length nil) - (print-level nil) - (print-readably t) ; print #[] for bytecode, 'x for (quote x) - (print-gensym (if (and byte-compile-print-gensym - (not byte-compile-emacs19-compatibility)) - t nil))) - (princ "\n" byte-compile-outbuffer) - (prin1 form byte-compile-outbuffer) - nil))) - -(defun byte-compile-output-docform (preface name info form specindex quoted) - "Print a form with a doc string. INFO is (prefix doc-index postfix). -If PREFACE and NAME are non-nil, print them too, -before INFO and the FORM but after the doc string itself. -If SPECINDEX is non-nil, it is the index in FORM -of the function bytecode string. In that case, -we output that argument and the following argument (the constants vector) -together, for lazy loading. -QUOTED says that we have to put a quote before the -list that represents a doc string reference. -`autoload' needs that." - ;; We need to examine byte-compile-dynamic-docstrings - ;; in the input buffer (now current), not in the output buffer. - (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (set-buffer - (prog1 (current-buffer) - (set-buffer byte-compile-outbuffer) - (let (position) - - ;; Insert the doc string, and make it a comment with #@LENGTH. - (and (>= (nth 1 info) 0) - dynamic-docstrings - (progn - ;; Make the doc string start at beginning of line - ;; for make-docfile's sake. - (insert "\n") - (setq position - (byte-compile-output-as-comment - (nth (nth 1 info) form) nil)) - ;; If the doc string starts with * (a user variable), - ;; negate POSITION. - (if (and (stringp (nth (nth 1 info) form)) - (> (length (nth (nth 1 info) form)) 0) - (char= (aref (nth (nth 1 info) form) 0) ?*)) - (setq position (- position))))) - - (if preface - (progn - (insert preface) - (prin1 name byte-compile-outbuffer))) - (insert (car info)) - (let ((print-escape-newlines t) - (print-readably t) ; print #[] for bytecode, 'x for (quote x) - ;; Use a cons cell to say that we want - ;; print-gensym-alist not to be cleared between calls - ;; to print functions. - (print-gensym (if (and byte-compile-print-gensym - (not byte-compile-emacs19-compatibility)) - '(t) nil)) - print-gensym-alist - (index 0)) - (prin1 (car form) byte-compile-outbuffer) - (while (setq form (cdr form)) - (setq index (1+ index)) - (insert " ") - (cond ((and (numberp specindex) (= index specindex)) - (let ((position - (byte-compile-output-as-comment - (cons (car form) (nth 1 form)) - t))) - (princ (format "(#$ . %d) nil" position) - byte-compile-outbuffer) - (setq form (cdr form)) - (setq index (1+ index)))) - ((= index (nth 1 info)) - (if position - (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") - position) - byte-compile-outbuffer) - (let ((print-escape-newlines nil)) - (goto-char (prog1 (1+ (point)) - (prin1 (car form) - byte-compile-outbuffer))) - (insert "\\\n") - (goto-char (point-max))))) - (t - (prin1 (car form) byte-compile-outbuffer))))) - (insert (nth 2 info)))))) - nil) - -(defvar for-effect) ; ## Kludge! This should be an arg, not a special. - -(defun byte-compile-keep-pending (form &optional handler) - (if (memq byte-optimize '(t source)) - (setq form (byte-optimize-form form t))) - (if handler - (let ((for-effect t)) - ;; To avoid consing up monstrously large forms at load time, we split - ;; the output regularly. - (and (memq (car-safe form) '(fset defalias define-function)) - (nthcdr 300 byte-compile-output) - (byte-compile-flush-pending)) - (funcall handler form) - (when for-effect - (byte-compile-discard))) - (byte-compile-form form t)) - nil) - -(defun byte-compile-flush-pending () - (if byte-compile-output - (let ((form (byte-compile-out-toplevel t 'file))) - (cond ((eq (car-safe form) 'progn) - (mapcar 'byte-compile-output-file-form (cdr form))) - (form - (byte-compile-output-file-form form))) - (setq byte-compile-constants nil - byte-compile-variables nil - byte-compile-depth 0 - byte-compile-maxdepth 0 - byte-compile-output nil)))) - -(defun byte-compile-file-form (form) - (let ((byte-compile-current-form nil) ; close over this for warnings. - handler) - (cond - ((not (consp form)) - (byte-compile-keep-pending form)) - ((and (symbolp (car form)) - (setq handler (get (car form) 'byte-hunk-handler))) - (cond ((setq form (funcall handler form)) - (byte-compile-flush-pending) - (byte-compile-output-file-form form)))) - ((eq form (setq form (macroexpand form byte-compile-macro-environment))) - (byte-compile-keep-pending form)) - (t - (byte-compile-file-form form))))) - -;; Functions and variables with doc strings must be output separately, -;; so make-docfile can recognize them. Most other things can be output -;; as byte-code. - -(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst) -(defun byte-compile-file-form-defsubst (form) - (cond ((assq (nth 1 form) byte-compile-unresolved-functions) - (setq byte-compile-current-form (nth 1 form)) - (byte-compile-warn "defsubst %s was used before it was defined" - (nth 1 form)))) - (byte-compile-file-form - (macroexpand form byte-compile-macro-environment)) - ;; Return nil so the form is not output twice. - nil) - -(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) -(defun byte-compile-file-form-autoload (form) - ;; - ;; If this is an autoload of a macro, and all arguments are constants (that - ;; is, there is no hairy computation going on here) then evaluate the form - ;; at compile-time. This is so that we can make use of macros which we - ;; have autoloaded from the file being compiled. Normal function autoloads - ;; are not automatically evaluated at compile time, because there's not - ;; much point to it (so why bother cluttering up the compile-time namespace.) - ;; - ;; If this is an autoload of a function, then record its definition in the - ;; byte-compile-autoload-environment to suppress any `not known to be - ;; defined' warnings at the end of this file (this only matters for - ;; functions which are autoloaded and compiled in the same file, if the - ;; autoload already exists in the compilation environment, we wouldn't have - ;; warned anyway.) - ;; - (let* ((name (if (byte-compile-constp (nth 1 form)) - (eval (nth 1 form)))) - ;; In v19, the 5th arg to autoload can be t, nil, 'macro, or 'keymap. - (macrop (and (byte-compile-constp (nth 5 form)) - (memq (eval (nth 5 form)) '(t macro)))) -;; (functionp (and (byte-compile-constp (nth 5 form)) -;; (eq 'nil (eval (nth 5 form))))) - ) - (if (and macrop - (let ((form form)) - ;; all forms are constant - (while (if (setq form (cdr form)) - (byte-compile-constp (car form)))) - (null form))) - ;; eval the macro autoload into the compilation enviroment - (eval form)) - - (if name - (let ((old (assq name byte-compile-autoload-environment))) - (cond (old - (if (memq 'redefine byte-compile-warnings) - (byte-compile-warn "multiple autoloads for %s" name)) - (setcdr old form)) - (t - ;; We only use the names in the autoload environment, but - ;; it might be useful to have the bodies some day. - (setq byte-compile-autoload-environment - (cons (cons name form) - byte-compile-autoload-environment))))))) - ;; - ;; Now output the form. - (if (stringp (nth 3 form)) - form - ;; No doc string, so we can compile this as a normal form. - (byte-compile-keep-pending form 'byte-compile-normal-call))) - -(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) -(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) -(defun byte-compile-file-form-defvar (form) - (if (> (length form) 4) - (byte-compile-warn "%s used with too many args (%s)" - (car form) (nth 1 form))) - (if (and (> (length form) 3) (not (stringp (nth 3 form)))) - (byte-compile-warn "Third arg to %s %s is not a string: %s" - (car form) (nth 1 form) (nth 3 form))) - (if (null (nth 3 form)) - ;; Since there is no doc string, we can compile this as a normal form, - ;; and not do a file-boundary. - (byte-compile-keep-pending form) - (if (memq 'free-vars byte-compile-warnings) - (setq byte-compile-bound-variables - (cons (cons (nth 1 form) byte-compile-global-bit) - byte-compile-bound-variables))) - (cond ((consp (nth 2 form)) - (setq form (copy-sequence form)) - (setcar (cdr (cdr form)) - (byte-compile-top-level (nth 2 form) nil 'file)))) - - ;; The following turns out not to be necessary, since we emit a call to - ;; defvar, which can hack Vfile_domain by itself! - ;; - ;; If a file domain has been set, emit (put 'VAR 'variable-domain ...) - ;; after this defvar. -; (if byte-compile-file-domain -; (progn -; ;; Actually, this will emit the (put ...) before the (defvar ...) -; ;; but I don't think that can matter in this case. -; (byte-compile-keep-pending -; (list 'put (list 'quote (nth 1 form)) ''variable-domain -; (list 'quote byte-compile-file-domain))))) - form)) - -(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) -(defun byte-compile-file-form-eval-boundary (form) - (eval form) - (byte-compile-keep-pending form 'byte-compile-normal-call)) - -(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) -(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) -(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) -(defun byte-compile-file-form-progn (form) - (mapcar 'byte-compile-file-form (cdr form)) - ;; Return nil so the forms are not output twice. - nil) - -;; This handler is not necessary, but it makes the output from dont-compile -;; and similar macros cleaner. -(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval) -(defun byte-compile-file-form-eval (form) - (if (eq (car-safe (nth 1 form)) 'quote) - (nth 1 (nth 1 form)) - (byte-compile-keep-pending form))) - -(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun) -(defun byte-compile-file-form-defun (form) - (byte-compile-file-form-defmumble form nil)) - -(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro) -(defun byte-compile-file-form-defmacro (form) - (byte-compile-file-form-defmumble form t)) - -(defun byte-compile-compiled-obj-to-list (obj) - ;; #### this is fairly disgusting. Rewrite the code instead - ;; so that it doesn't create compiled objects in the first place! - ;; Much better than creating them and then "uncreating" them - ;; like this. - (read (concat "(" - (substring (let ((print-readably t) - (print-gensym - (if (and byte-compile-print-gensym - (not byte-compile-emacs19-compatibility)) - '(t) nil)) - (print-gensym-alist nil)) - (prin1-to-string obj)) - 2 -1) - ")"))) - -(defun byte-compile-file-form-defmumble (form macrop) - (let* ((name (car (cdr form))) - (this-kind (if macrop 'byte-compile-macro-environment - 'byte-compile-function-environment)) - (that-kind (if macrop 'byte-compile-function-environment - 'byte-compile-macro-environment)) - (this-one (assq name (symbol-value this-kind))) - (that-one (assq name (symbol-value that-kind))) - (byte-compile-free-references nil) - (byte-compile-free-assignments nil)) - - ;; When a function or macro is defined, add it to the call tree so that - ;; we can tell when functions are not used. - (if byte-compile-generate-call-tree - (or (assq name byte-compile-call-tree) - (setq byte-compile-call-tree - (cons (list name nil nil) byte-compile-call-tree)))) - - (setq byte-compile-current-form name) ; for warnings - (when (memq 'redefine byte-compile-warnings) - (byte-compile-arglist-warn form macrop)) - (defvar filename) ; #### filename used free - (when byte-compile-verbose - (message "Compiling %s... (%s)" - (if filename (file-name-nondirectory filename) "") - (nth 1 form))) - (cond (that-one - (when (and (memq 'redefine byte-compile-warnings) - ;; hack hack: don't warn when compiling the stubs in - ;; bytecomp-runtime... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn - "%s defined multiple times, as both function and macro" - (nth 1 form))) - (setcdr that-one nil)) - (this-one - (when (and (memq 'redefine byte-compile-warnings) - ;; hack: don't warn when compiling the magic internal - ;; byte-compiler macros in bytecomp-runtime.el... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) - (byte-compile-warn "%s %s defined multiple times in this file" - (if macrop "macro" "function") - (nth 1 form)))) - ((and (fboundp name) - (or (subrp (symbol-function name)) - (eq (car-safe (symbol-function name)) - (if macrop 'lambda 'macro)))) - (if (memq 'redefine byte-compile-warnings) - (byte-compile-warn "%s %s being redefined as a %s" - (if (subrp (symbol-function name)) - "subr" - (if macrop "function" "macro")) - (nth 1 form) - (if macrop "macro" "function"))) - ;; shadow existing definition - (set this-kind - (cons (cons name nil) (symbol-value this-kind))))) - (let ((body (nthcdr 3 form))) - (if (and (stringp (car body)) - (symbolp (car-safe (cdr-safe body))) - (car-safe (cdr-safe body)) - (stringp (car-safe (cdr-safe (cdr-safe body))))) - (byte-compile-warn "Probable `\"' without `\\' in doc string of %s" - (nth 1 form)))) - (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form)))) - (code (byte-compile-byte-code-maker new-one))) - (if this-one - (setcdr this-one new-one) - (set this-kind - (cons (cons name new-one) (symbol-value this-kind)))) - (if (and (stringp (nth 3 form)) - (eq 'quote (car-safe code)) - (eq 'lambda (car-safe (nth 1 code)))) - (cons (car form) - (cons name (cdr (nth 1 code)))) - (byte-compile-flush-pending) - (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) - ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) - ;; FSF just calls `(append code nil)' here but that relies - ;; on horrible C kludges in concat() that accept byte- - ;; compiled objects and pretend they're vectors. - (if (compiled-function-p code) - (byte-compile-compiled-obj-to-list code) - (append code nil)) - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) ; compiled-function-p - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) - ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) - ;; The result of byte-compile-byte-code-maker is either a - ;; compiled-function object, or a list of some kind. If it's - ;; not a cons, we must coerce it into a list of the elements - ;; to be printed to the file. - (if (consp code) - code - (nconc (list - (compiled-function-arglist code) - (compiled-function-instructions code) - (compiled-function-constants code) - (compiled-function-stack-depth code)) - (let ((doc (documentation code t))) - (if doc (list doc))) - (if (commandp code) - (list (nth 1 (compiled-function-interactive code)))))) - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile-outbuffer) - nil)))) - -;; Print Lisp object EXP in the output file, inside a comment, -;; and return the file position it will have. -;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. -(defun byte-compile-output-as-comment (exp quoted) - (let ((position (point))) - (set-buffer - (prog1 (current-buffer) - (set-buffer byte-compile-outbuffer) - - ;; Insert EXP, and make it a comment with #@LENGTH. - (insert " ") - (if quoted - (prin1 exp byte-compile-outbuffer) - (princ exp byte-compile-outbuffer)) - (goto-char position) - ;; Quote certain special characters as needed. - ;; get_doc_string in doc.c does the unquoting. - (while (search-forward "\^A" nil t) - (replace-match "\^A\^A" t t)) - (goto-char position) - (while (search-forward "\000" nil t) - (replace-match "\^A0" t t)) - (goto-char position) - (while (search-forward "\037" nil t) - (replace-match "\^A_" t t)) - (goto-char (point-max)) - (insert "\037") - (goto-char position) - (insert "#@" (format "%d" (- (point-max) position))) - - ;; Save the file position of the object. - ;; Note we should add 1 to skip the space - ;; that we inserted before the actual doc string, - ;; and subtract 1 to convert from an 1-origin Emacs position - ;; to a file position; they cancel. - (setq position (point)) - (goto-char (point-max)))) - position)) - - - -;; The `domain' declaration. This is legal only at top-level in a file, and -;; should generally be the first form in the file. It is not legal inside -;; function bodies. - -(put 'domain 'byte-hunk-handler 'byte-compile-file-form-domain) -(defun byte-compile-file-form-domain (form) - (if (not (null (cdr (cdr form)))) - (byte-compile-warn "domain used with too many arguments: %s" form)) - (let ((domain (nth 1 form))) - (or (null domain) - (stringp domain) - (progn - (byte-compile-warn - "argument to `domain' declaration must be a literal string: %s" - form) - (setq domain nil))) - (setq byte-compile-file-domain domain)) - (byte-compile-keep-pending form 'byte-compile-normal-call)) - -(defun byte-compile-domain (form) - (byte-compile-warn "The `domain' declaration is legal only at top-level: %s" - (let ((print-escape-newlines t) - (print-level 4) - (print-length 4)) - (prin1-to-string form))) - (byte-compile-normal-call - (list 'signal ''error - (list 'quote (list "`domain' used inside a function" form))))) - -;; This is part of bytecomp.el in 19.35: -(put 'custom-declare-variable 'byte-hunk-handler - 'byte-compile-file-form-custom-declare-variable) -(defun byte-compile-file-form-custom-declare-variable (form) - (if (memq 'free-vars byte-compile-warnings) - (setq byte-compile-bound-variables - (cons (cons (nth 1 (nth 1 form)) - byte-compile-global-bit) - byte-compile-bound-variables))) - form) - - -;;;###autoload -(defun byte-compile (form) - "If FORM is a symbol, byte-compile its function definition. -If FORM is a lambda or a macro, byte-compile it as a function." - (displaying-byte-compile-warnings - (byte-compile-close-variables - (let* ((fun (if (symbolp form) - (and (fboundp form) (symbol-function form)) - form)) - (macro (eq (car-safe fun) 'macro))) - (if macro - (setq fun (cdr fun))) - (cond ((eq (car-safe fun) 'lambda) - (setq fun (if macro - (cons 'macro (byte-compile-lambda fun)) - (byte-compile-lambda fun))) - (if (symbolp form) - (defalias form fun) - fun))))))) - -;;;###autoload -(defun byte-compile-sexp (sexp &optional msg) - "Compile and return SEXP." - (displaying-byte-compile-warnings - (byte-compile-close-variables - (prog1 - (byte-compile-top-level sexp) - (byte-compile-warn-about-unresolved-functions msg))))) - -;; Given a function made by byte-compile-lambda, make a form which produces it. -(defun byte-compile-byte-code-maker (fun) - (cond - ;; ## atom is faster than compiled-func-p. - ((atom fun) ; compiled-function-p - fun) - ;; b-c-lambda didn't produce a compiled-function, so it must be a trivial - ;; function. - ((let (tmp) - (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) - (null (cdr (memq tmp fun)))) - ;; Generate a make-byte-code call. - (let* ((interactive (assq 'interactive (cdr (cdr fun))))) - (nconc (list 'make-byte-code - (list 'quote (nth 1 fun)) ;arglist - (nth 1 tmp) ;instructions - (nth 2 tmp) ;constants - (nth 3 tmp)) ;stack-depth - (cond ((stringp (nth 2 fun)) - (list (nth 2 fun))) ;docstring - (interactive - (list nil))) - (cond (interactive - (list (if (or (null (nth 1 interactive)) - (stringp (nth 1 interactive))) - (nth 1 interactive) - ;; Interactive spec is a list or a variable - ;; (if it is correct). - (list 'quote (nth 1 interactive)))))))) - ;; a non-compiled function (probably trivial) - (list 'quote fun)))))) - -;; Byte-compile a lambda-expression and return a valid function. -;; The value is usually a compiled function but may be the original -;; lambda-expression. -(defun byte-compile-lambda (fun) - (or (eq 'lambda (car-safe fun)) - (error "not a lambda -- %s" (prin1-to-string fun))) - (let* ((arglist (nth 1 fun)) - (byte-compile-bound-variables - (let ((new-bindings - (mapcar #'(lambda (x) (cons x byte-compile-arglist-bit)) - (and (memq 'free-vars byte-compile-warnings) - (delq '&rest (delq '&optional - (copy-sequence arglist))))))) - (nconc new-bindings - (cons 'new-scope byte-compile-bound-variables)))) - (body (cdr (cdr fun))) - (doc (if (stringp (car body)) - (prog1 (car body) - (setq body (cdr body))))) - (int (assq 'interactive body))) - (dolist (arg arglist) - (cond ((not (symbolp arg)) - (byte-compile-warn "non-symbol in arglist: %S" arg)) - ((byte-compile-constant-symbol-p arg) - (byte-compile-warn "constant symbol in arglist: %s" arg)) - ((and (char= ?\& (aref (symbol-name arg) 0)) - (not (eq arg '&optional)) - (not (eq arg '&rest))) - (byte-compile-warn "unrecognized `&' keyword in arglist: %s" - arg)))) - (cond (int - ;; Skip (interactive) if it is in front (the most usual location). - (if (eq int (car body)) - (setq body (cdr body))) - (cond ((consp (cdr int)) - (if (cdr (cdr int)) - (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string int))) - ;; If the interactive spec is a call to `list', - ;; don't compile it, because `call-interactively' - ;; looks at the args of `list'. - (let ((form (nth 1 int))) - (while (or (eq (car-safe form) 'let) - (eq (car-safe form) 'let*) - (eq (car-safe form) 'save-excursion)) - (while (consp (cdr form)) - (setq form (cdr form))) - (setq form (car form))) - (or (eq (car-safe form) 'list) - (setq int (list 'interactive - (byte-compile-top-level (nth 1 int))))))) - ((cdr int) - (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string int)))))) - (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda))) - (if (memq 'unused-vars byte-compile-warnings) - ;; done compiling in this scope, warn now. - (byte-compile-warn-about-unused-variables)) - (if (eq 'byte-code (car-safe compiled)) - (apply 'make-byte-code - (append (list arglist) - ;; byte-string, constants-vector, stack depth - (cdr compiled) - ;; optionally, the doc string. - (if (or doc int) - (list doc)) - ;; optionally, the interactive spec. - (if int - (list (nth 1 int))))) - (setq compiled - (nconc (if int (list int)) - (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) - (compiled (list compiled))))) - (nconc (list 'lambda arglist) - (if (or doc (stringp (car compiled))) - (cons doc (cond (compiled) - (body (list nil)))) - compiled)))))) - -(defun byte-compile-constants-vector () - ;; Builds the constants-vector from the current variables and constants. - ;; This modifies the constants from (const . nil) to (const . offset). - ;; To keep the byte-codes to look up the vector as short as possible: - ;; First 6 elements are vars, as there are one-byte varref codes for those. - ;; Next up to byte-constant-limit are constants, still with one-byte codes. - ;; Next variables again, to get 2-byte codes for variable lookup. - ;; The rest of the constants and variables need 3-byte byte-codes. - (let* ((i -1) - (rest (nreverse byte-compile-variables)) ; nreverse because the first - (other (nreverse byte-compile-constants)) ; vars often are used most. - ret tmp - (limits '(5 ; Use the 1-byte varref codes, - 63 ; 1-constlim ; 1-byte byte-constant codes, - 255 ; 2-byte varref codes, - 65535)) ; 3-byte codes for the rest. - limit) - (while (or rest other) - (setq limit (car limits)) - (while (and rest (not (eq i limit))) - (if (setq tmp (assq (car (car rest)) ret)) - (setcdr (car rest) (cdr tmp)) - (setcdr (car rest) (setq i (1+ i))) - (setq ret (cons (car rest) ret))) - (setq rest (cdr rest))) - (setq limits (cdr limits) - rest (prog1 other - (setq other rest)))) - (apply 'vector (nreverse (mapcar 'car ret))))) - -;; Given an expression FORM, compile it and return an equivalent byte-code -;; expression (a call to the function byte-code). -(defun byte-compile-top-level (form &optional for-effect output-type) - ;; OUTPUT-TYPE advises about how form is expected to be used: - ;; 'eval or nil -> a single form, - ;; 'progn or t -> a list of forms, - ;; 'lambda -> body of a lambda, - ;; 'file -> used at file-level. - (let ((byte-compile-constants nil) - (byte-compile-variables nil) - (byte-compile-tag-number 0) - (byte-compile-depth 0) - (byte-compile-maxdepth 0) - (byte-compile-output nil)) - (if (memq byte-optimize '(t source)) - (setq form (byte-optimize-form form for-effect))) - (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) - (setq form (nth 1 form))) - (if (and (eq 'byte-code (car-safe form)) - (not (memq byte-optimize '(t byte))) - (stringp (nth 1 form)) - (vectorp (nth 2 form)) - (natnump (nth 3 form))) - form - (byte-compile-form form for-effect) - (byte-compile-out-toplevel for-effect output-type)))) - -(defun byte-compile-out-toplevel (&optional for-effect output-type) - (if for-effect - ;; The stack is empty. Push a value to be returned from (byte-code ..). - (if (eq (car (car byte-compile-output)) 'byte-discard) - (setq byte-compile-output (cdr byte-compile-output)) - (byte-compile-push-constant - ;; Push any constant - preferably one which already is used, and - ;; a number or symbol - ie not some big sequence. The return value - ;; isn't returned, but it would be a shame if some textually large - ;; constant was not optimized away because we chose to return it. - (and (not (assq nil byte-compile-constants)) ; Nil is often there. - (let ((tmp (reverse byte-compile-constants))) - (while (and tmp (not (or (symbolp (car (car tmp))) - (numberp (car (car tmp)))))) - (setq tmp (cdr tmp))) - (car (car tmp))))))) - (byte-compile-out 'byte-return 0) - (setq byte-compile-output (nreverse byte-compile-output)) - (if (memq byte-optimize '(t byte)) - (setq byte-compile-output - (byte-optimize-lapcode byte-compile-output for-effect))) - - ;; Decompile trivial functions: - ;; only constants and variables, or a single funcall except in lambdas. - ;; Except for Lisp_Compiled objects, forms like (foo "hi") - ;; are still quicker than (byte-code "..." [foo "hi"] 2). - ;; Note that even (quote foo) must be parsed just as any subr by the - ;; interpreter, so quote should be compiled into byte-code in some contexts. - ;; What to leave uncompiled: - ;; lambda -> never. we used to leave it uncompiled if the body was - ;; a single atom, but that causes confusion if the docstring - ;; uses the (file . pos) syntax. Besides, now that we have - ;; the Lisp_Compiled type, the compiled form is faster. - ;; eval -> atom, quote or (function atom atom atom) - ;; progn -> as <> or (progn <> atom) - ;; file -> as progn, but takes both quotes and atoms, and longer forms. - (let (rest - (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. - tmp body) - (cond - ;; #### This should be split out into byte-compile-nontrivial-function-p. - ((or (eq output-type 'lambda) - (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) - (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. - (not (setq tmp (assq 'byte-return byte-compile-output))) - (progn - (setq rest (nreverse - (cdr (memq tmp (reverse byte-compile-output))))) - (while (cond - ((memq (car (car rest)) '(byte-varref byte-constant)) - (setq tmp (car (cdr (car rest)))) - (if (if (eq (car (car rest)) 'byte-constant) - (or (consp tmp) - (and (symbolp tmp) - (not (byte-compile-constant-symbol-p tmp))))) - (if maycall - (setq body (cons (list 'quote tmp) body))) - (setq body (cons tmp body)))) - ((and maycall - ;; Allow a funcall if at most one atom follows it. - (null (nthcdr 3 rest)) - (setq tmp - ;; XEmacs change for rms funs - (or (and - (byte-compile-version-cond - byte-compile-emacs19-compatibility) - (get (car (car rest)) - 'byte-opcode19-invert)) - (get (car (car rest)) - 'byte-opcode-invert))) - (or (null (cdr rest)) - (and (memq output-type '(file progn t)) - (cdr (cdr rest)) - (eq (car (nth 1 rest)) 'byte-discard) - (progn (setq rest (cdr rest)) t)))) - (setq maycall nil) ; Only allow one real function call. - (setq body (nreverse body)) - (setq body (list - (if (and (eq tmp 'funcall) - (eq (car-safe (car body)) 'quote)) - (cons (nth 1 (car body)) (cdr body)) - (cons tmp body)))) - (or (eq output-type 'file) - (not (delq nil (mapcar 'consp (cdr (car body)))))))) - (setq rest (cdr rest))) - rest)) - (let ((byte-compile-vector (byte-compile-constants-vector))) - (list 'byte-code (byte-compile-lapcode byte-compile-output) - byte-compile-vector byte-compile-maxdepth))) - ;; it's a trivial function - ((cdr body) (cons 'progn (nreverse body))) - ((car body))))) - -;; Given BODY, compile it and return a new body. -(defun byte-compile-top-level-body (body &optional for-effect) - (setq body (byte-compile-top-level (cons 'progn body) for-effect t)) - (cond ((eq (car-safe body) 'progn) - (cdr body)) - (body - (list body)))) - -;; This is the recursive entry point for compiling each subform of an -;; expression. -;; If for-effect is non-nil, byte-compile-form will output a byte-discard -;; before terminating (ie. no value will be left on the stack). -;; A byte-compile handler may, when for-effect is non-nil, choose output code -;; which does not leave a value on the stack, and then set for-effect to nil -;; (to prevent byte-compile-form from outputting the byte-discard). -;; If a handler wants to call another handler, it should do so via -;; byte-compile-form, or take extreme care to handle for-effect correctly. -;; (Use byte-compile-form-do-effect to reset the for-effect flag too.) -;; -(defun byte-compile-form (form &optional for-effect) - (setq form (macroexpand form byte-compile-macro-environment)) - (cond ((not (consp form)) - (cond ((or (not (symbolp form)) - (byte-compile-constant-symbol-p form)) - (byte-compile-constant form)) - ((and for-effect byte-compile-delete-errors) - (setq for-effect nil)) - (t (byte-compile-variable-ref 'byte-varref form)))) - ((symbolp (car form)) - (let* ((fn (car form)) - (handler (get fn 'byte-compile))) - (if (memq fn '(t nil)) - (byte-compile-warn "%s called as a function" fn)) - (if (and handler - (or (not (byte-compile-version-cond - byte-compile-emacs19-compatibility)) - (not (get (get fn 'byte-opcode) 'emacs20-opcode)))) - (funcall handler form) - (if (memq 'callargs byte-compile-warnings) - (byte-compile-callargs-warn form)) - (byte-compile-normal-call form)))) - ((and (or (compiled-function-p (car form)) - (eq (car-safe (car form)) 'lambda)) - ;; if the form comes out the same way it went in, that's - ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (byte-compile-unfold-lambda form))))) - (byte-compile-form form for-effect) - (setq for-effect nil)) - ((byte-compile-normal-call form))) - (when for-effect - (byte-compile-discard))) - -(defun byte-compile-normal-call (form) - (if byte-compile-generate-call-tree - (byte-compile-annotate-call-tree form)) - (byte-compile-push-constant (car form)) - (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster. - (byte-compile-out 'byte-call (length (cdr form)))) - -;; kludge added to XEmacs to work around the bogosities of a nonlexical lisp. -(or (fboundp 'globally-boundp) (fset 'globally-boundp 'boundp)) - -(defun byte-compile-variable-ref (base-op var &optional varbind-flags) - (if (or (not (symbolp var)) (byte-compile-constant-symbol-p var)) - (byte-compile-warn - (case base-op - (byte-varref "Variable reference to %s %s") - (byte-varset "Attempt to set %s %s") - (byte-varbind "Attempt to let-bind %s %s")) - (if (symbolp var) "constant symbol" "non-symbol") - var) - (if (and (get var 'byte-obsolete-variable) - (memq 'obsolete byte-compile-warnings)) - (let ((ob (get var 'byte-obsolete-variable))) - (byte-compile-warn "%s is an obsolete variable; %s" var - (if (stringp ob) - ob - (format "use %s instead." ob))))) - (if (and (get var 'byte-compatible-variable) - (memq 'pedantic byte-compile-warnings)) - (let ((ob (get var 'byte-compatible-variable))) - (byte-compile-warn "%s is provided for compatibility; %s" var - (if (stringp ob) - ob - (format "use %s instead." ob))))) - (if (memq 'free-vars byte-compile-warnings) - (if (eq base-op 'byte-varbind) - (setq byte-compile-bound-variables - (cons (cons var (or varbind-flags 0)) - byte-compile-bound-variables)) - (or (globally-boundp var) - (let ((cell (assq var byte-compile-bound-variables))) - (if cell (setcdr cell - (logior (cdr cell) - (if (eq base-op 'byte-varset) - byte-compile-assigned-bit - byte-compile-referenced-bit))))) - (if (eq base-op 'byte-varset) - (or (memq var byte-compile-free-assignments) - (progn - (byte-compile-warn "assignment to free variable %s" - var) - (setq byte-compile-free-assignments - (cons var byte-compile-free-assignments)))) - (or (memq var byte-compile-free-references) - (progn - (byte-compile-warn "reference to free variable %s" var) - (setq byte-compile-free-references - (cons var byte-compile-free-references))))))))) - (let ((tmp (assq var byte-compile-variables))) - (or tmp - (setq tmp (list var) - byte-compile-variables (cons tmp byte-compile-variables))) - (byte-compile-out base-op tmp))) - -(defmacro byte-compile-get-constant (const) - `(or (if (stringp ,const) - (assoc ,const byte-compile-constants) - (assq ,const byte-compile-constants)) - (car (setq byte-compile-constants - (cons (list ,const) byte-compile-constants))))) - -;; Use this when the value of a form is a constant. This obeys for-effect. -(defun byte-compile-constant (const) - (if for-effect - (setq for-effect nil) - (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) - -;; Use this for a constant that is not the value of its containing form. -;; This ignores for-effect. -(defun byte-compile-push-constant (const) - (let ((for-effect nil)) - (inline (byte-compile-constant const)))) - - -;; Compile those primitive ordinary functions -;; which have special byte codes just for speed. - -(defmacro byte-defop-compiler (function &optional compile-handler) - ;; add a compiler-form for FUNCTION. - ;; If function is a symbol, then the variable "byte-SYMBOL" must name - ;; the opcode to be used. If function is a list, the first element - ;; is the function and the second element is the bytecode-symbol. - ;; COMPILE-HANDLER is the function to use to compile this byte-op, or - ;; may be the abbreviations 0, 1, 2, 3, 0-1, 1-2, 2-3, 0+1, 1+1, 2+1, - ;; 0-1+1, 1-2+1, 2-3+1, 0+2, or 1+2. If it is nil, then the handler is - ;; "byte-compile-SYMBOL." - (let (opcode) - (if (symbolp function) - (setq opcode (intern (concat "byte-" (symbol-name function)))) - (setq opcode (car (cdr function)) - function (car function))) - (let ((fnform - (list 'put (list 'quote function) ''byte-compile - (list 'quote - (or (cdr (assq compile-handler - '((0 . byte-compile-no-args) - (1 . byte-compile-one-arg) - (2 . byte-compile-two-args) - (3 . byte-compile-three-args) - (0-1 . byte-compile-zero-or-one-arg) - (1-2 . byte-compile-one-or-two-args) - (2-3 . byte-compile-two-or-three-args) - (0+1 . byte-compile-no-args-with-one-extra) - (1+1 . byte-compile-one-arg-with-one-extra) - (2+1 . byte-compile-two-args-with-one-extra) - (0-1+1 . byte-compile-zero-or-one-arg-with-one-extra) - (1-2+1 . byte-compile-one-or-two-args-with-one-extra) - (2-3+1 . byte-compile-two-or-three-args-with-one-extra) - (0+2 . byte-compile-no-args-with-two-extra) - (1+2 . byte-compile-one-arg-with-two-extra) - - ))) - compile-handler - (intern (concat "byte-compile-" - (symbol-name function)))))))) - (if opcode - (list 'progn fnform - (list 'put (list 'quote function) - ''byte-opcode (list 'quote opcode)) - (list 'put (list 'quote opcode) - ''byte-opcode-invert (list 'quote function))) - fnform)))) - -(defmacro byte-defop-compiler20 (function &optional compile-handler) - ;; Just like byte-defop-compiler, but defines an opcode that will only - ;; be used when byte-compile-emacs19-compatibility is false. - (if (and (byte-compile-single-version) - byte-compile-emacs19-compatibility) - ;; #### instead of doing nothing, this should do some remprops, - ;; #### to protect against the case where a single-version compiler - ;; #### is loaded into a world that has contained a multi-version one. - nil - (list 'progn - (list 'put - (list 'quote - (or (car (cdr-safe function)) - (intern (concat "byte-" - (symbol-name (or (car-safe function) function)))))) - ''emacs20-opcode t) - (list 'byte-defop-compiler function compile-handler)))) - -;; XEmacs addition: -(defmacro byte-defop-compiler-rmsfun (function &optional compile-handler) - ;; for functions like `eq' that compile into different opcodes depending - ;; on the Emacs version: byte-old-eq for v19, byte-eq for v20. - (let ((opcode (intern (concat "byte-" (symbol-name function)))) - (opcode19 (intern (concat "byte-old-" (symbol-name function)))) - (fnform - (list 'put (list 'quote function) ''byte-compile - (list 'quote - (or (cdr (assq compile-handler - '((2 . byte-compile-two-args-19->20) - ))) - compile-handler - (intern (concat "byte-compile-" - (symbol-name function)))))))) - (list 'progn fnform - (list 'put (list 'quote function) - ''byte-opcode (list 'quote opcode)) - (list 'put (list 'quote function) - ''byte-opcode19 (list 'quote opcode19)) - (list 'put (list 'quote opcode) - ''byte-opcode-invert (list 'quote function)) - (list 'put (list 'quote opcode19) - ''byte-opcode19-invert (list 'quote function))))) - -(defmacro byte-defop-compiler-1 (function &optional compile-handler) - (list 'byte-defop-compiler (list function nil) compile-handler)) - - -(put 'byte-call 'byte-opcode-invert 'funcall) -(put 'byte-list1 'byte-opcode-invert 'list) -(put 'byte-list2 'byte-opcode-invert 'list) -(put 'byte-list3 'byte-opcode-invert 'list) -(put 'byte-list4 'byte-opcode-invert 'list) -(put 'byte-listN 'byte-opcode-invert 'list) -(put 'byte-concat2 'byte-opcode-invert 'concat) -(put 'byte-concat3 'byte-opcode-invert 'concat) -(put 'byte-concat4 'byte-opcode-invert 'concat) -(put 'byte-concatN 'byte-opcode-invert 'concat) -(put 'byte-insertN 'byte-opcode-invert 'insert) - -;; How old is this stuff? -slb -;(byte-defop-compiler (dot byte-point) 0+1) -;(byte-defop-compiler (dot-max byte-point-max) 0+1) -;(byte-defop-compiler (dot-min byte-point-min) 0+1) -(byte-defop-compiler point 0+1) -(byte-defop-compiler-rmsfun eq 2) -(byte-defop-compiler point-max 0+1) -(byte-defop-compiler point-min 0+1) -(byte-defop-compiler following-char 0+1) -(byte-defop-compiler preceding-char 0+1) -(byte-defop-compiler current-column 0+1) -;; FSF has special function here; generalized here by the 1+2 stuff. -(byte-defop-compiler (indent-to-column byte-indent-to) 1+2) -(byte-defop-compiler indent-to 1+2) -(byte-defop-compiler-rmsfun equal 2) -(byte-defop-compiler eolp 0+1) -(byte-defop-compiler eobp 0+1) -(byte-defop-compiler bolp 0+1) -(byte-defop-compiler bobp 0+1) -(byte-defop-compiler current-buffer 0) -;;(byte-defop-compiler read-char 0) ;; obsolete -(byte-defop-compiler-rmsfun memq 2) -(byte-defop-compiler interactive-p 0) -(byte-defop-compiler widen 0+1) -(byte-defop-compiler end-of-line 0-1+1) -(byte-defop-compiler forward-char 0-1+1) -(byte-defop-compiler forward-line 0-1+1) -(byte-defop-compiler symbolp 1) -(byte-defop-compiler consp 1) -(byte-defop-compiler stringp 1) -(byte-defop-compiler listp 1) -(byte-defop-compiler not 1) -(byte-defop-compiler (null byte-not) 1) -(byte-defop-compiler car 1) -(byte-defop-compiler cdr 1) -(byte-defop-compiler length 1) -(byte-defop-compiler symbol-value 1) -(byte-defop-compiler symbol-function 1) -(byte-defop-compiler (1+ byte-add1) 1) -(byte-defop-compiler (1- byte-sub1) 1) -(byte-defop-compiler goto-char 1+1) -(byte-defop-compiler char-after 0-1+1) -(byte-defop-compiler set-buffer 1) -;;(byte-defop-compiler set-mark 1) ;; obsolete -(byte-defop-compiler forward-word 1+1) -(byte-defop-compiler char-syntax 1+1) -(byte-defop-compiler nreverse 1) -(byte-defop-compiler car-safe 1) -(byte-defop-compiler cdr-safe 1) -(byte-defop-compiler numberp 1) -(byte-defop-compiler integerp 1) -(byte-defop-compiler skip-chars-forward 1-2+1) -(byte-defop-compiler skip-chars-backward 1-2+1) -(byte-defop-compiler (eql byte-eq) 2) -(byte-defop-compiler20 old-eq 2) -(byte-defop-compiler20 old-memq 2) -(byte-defop-compiler cons 2) -(byte-defop-compiler aref 2) -(byte-defop-compiler get 2+1) -(byte-defop-compiler nth 2) -(byte-defop-compiler substring 2-3) -(byte-defop-compiler (move-marker byte-set-marker) 2-3) -(byte-defop-compiler set-marker 2-3) -(byte-defop-compiler match-beginning 1) -(byte-defop-compiler match-end 1) -(byte-defop-compiler upcase 1+1) -(byte-defop-compiler downcase 1+1) -(byte-defop-compiler string= 2) -(byte-defop-compiler string< 2) -(byte-defop-compiler (string-equal byte-string=) 2) -(byte-defop-compiler (string-lessp byte-string<) 2) -(byte-defop-compiler20 old-equal 2) -(byte-defop-compiler nthcdr 2) -(byte-defop-compiler elt 2) -(byte-defop-compiler20 old-member 2) -(byte-defop-compiler20 old-assq 2) -(byte-defop-compiler (rplaca byte-setcar) 2) -(byte-defop-compiler (rplacd byte-setcdr) 2) -(byte-defop-compiler setcar 2) -(byte-defop-compiler setcdr 2) -(byte-defop-compiler delete-region 2+1) -(byte-defop-compiler narrow-to-region 2+1) -(byte-defop-compiler (% byte-rem) 2) -(byte-defop-compiler aset 3) - -(byte-defop-compiler-rmsfun member 2) -(byte-defop-compiler-rmsfun assq 2) - -(byte-defop-compiler max byte-compile-associative) -(byte-defop-compiler min byte-compile-associative) -(byte-defop-compiler (+ byte-plus) byte-compile-associative) -(byte-defop-compiler (* byte-mult) byte-compile-associative) - -;;####(byte-defop-compiler move-to-column 1) -(byte-defop-compiler-1 interactive byte-compile-noop) -(byte-defop-compiler-1 domain byte-compile-domain) - -;; As of GNU Emacs 19.18 and Lucid Emacs 19.8, mod and % are different: `%' -;; means integral remainder and may have a negative result; `mod' is always -;; positive, and accepts floating point args. All code which uses `mod' and -;; requires the new interpretation must be compiled with bytecomp version 2.18 -;; or newer, or the emitted code will run the byte-code for `%' instead of an -;; actual call to `mod'. So be careful of compiling new code with an old -;; compiler. Note also that `%' is more efficient than `mod' because the -;; former is byte-coded and the latter is not. -;;(byte-defop-compiler (mod byte-rem) 2) - - -(defun byte-compile-subr-wrong-args (form n) - (when (memq 'subr-callargs byte-compile-warnings) - (byte-compile-warn "%s called with %d arg%s, but requires %s" - (car form) (length (cdr form)) - (if (= 1 (length (cdr form))) "" "s") n)) - ;; get run-time wrong-number-of-args error. - (byte-compile-normal-call form)) - -(defun byte-compile-no-args (form) - (case (length (cdr form)) - (0 (byte-compile-out (get (car form) 'byte-opcode) 0)) - (t (byte-compile-subr-wrong-args form "none")))) - -(defun byte-compile-one-arg (form) - (case (length (cdr form)) - (1 (byte-compile-form (car (cdr form))) ;; Push the argument - (byte-compile-out (get (car form) 'byte-opcode) 0)) - (t (byte-compile-subr-wrong-args form 1)))) - -(defun byte-compile-two-args (form) - (case (length (cdr form)) - (2 (byte-compile-form (nth 1 form)) ;; Push the arguments - (byte-compile-form (nth 2 form)) - (byte-compile-out (get (car form) 'byte-opcode) 0)) - (t (byte-compile-subr-wrong-args form 2)))) - -(defun byte-compile-three-args (form) - (case (length (cdr form)) - (3 (byte-compile-form (nth 1 form)) ;; Push the arguments - (byte-compile-form (nth 2 form)) - (byte-compile-form (nth 3 form)) - (byte-compile-out (get (car form) 'byte-opcode) 0)) - (t (byte-compile-subr-wrong-args form 3)))) - -(defun byte-compile-zero-or-one-arg (form) - (case (length (cdr form)) - (0 (byte-compile-one-arg (append form '(nil)))) - (1 (byte-compile-one-arg form)) - (t (byte-compile-subr-wrong-args form "0-1")))) - -(defun byte-compile-one-or-two-args (form) - (case (length (cdr form)) - (1 (byte-compile-two-args (append form '(nil)))) - (2 (byte-compile-two-args form)) - (t (byte-compile-subr-wrong-args form "1-2")))) - -(defun byte-compile-two-or-three-args (form) - (case (length (cdr form)) - (2 (byte-compile-three-args (append form '(nil)))) - (3 (byte-compile-three-args form)) - (t (byte-compile-subr-wrong-args form "2-3")))) - -;; from Ben Wing : some inlined functions have extra -;; optional args added to them in XEmacs 19.12. Changing the byte -;; interpreter to deal with these args would be wrong and cause -;; incompatibility, so we generate non-inlined calls for those cases. -;; Without the following functions, spurious warnings will be generated; -;; however, they would still compile correctly because -;; `byte-compile-subr-wrong-args' also converts the call to non-inlined. - -(defun byte-compile-no-args-with-one-extra (form) - (case (length (cdr form)) - (0 (byte-compile-no-args form)) - (1 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "0-1")))) - -(defun byte-compile-one-arg-with-one-extra (form) - (case (length (cdr form)) - (1 (byte-compile-one-arg form)) - (2 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "1-2")))) - -(defun byte-compile-two-args-with-one-extra (form) - (case (length (cdr form)) - (2 (byte-compile-two-args form)) - (3 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "2-3")))) - -(defun byte-compile-zero-or-one-arg-with-one-extra (form) - (case (length (cdr form)) - (0 (byte-compile-one-arg (append form '(nil)))) - (1 (byte-compile-one-arg form)) - (2 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "0-2")))) - -(defun byte-compile-one-or-two-args-with-one-extra (form) - (case (length (cdr form)) - (1 (byte-compile-two-args (append form '(nil)))) - (2 (byte-compile-two-args form)) - (3 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "1-3")))) - -(defun byte-compile-two-or-three-args-with-one-extra (form) - (case (length (cdr form)) - (2 (byte-compile-three-args (append form '(nil)))) - (3 (byte-compile-three-args form)) - (4 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "2-4")))) - -(defun byte-compile-no-args-with-two-extra (form) - (case (length (cdr form)) - (0 (byte-compile-no-args form)) - ((1 2) (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "0-2")))) - -(defun byte-compile-one-arg-with-two-extra (form) - (case (length (cdr form)) - (1 (byte-compile-one-arg form)) - ((2 3) (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "1-3")))) - -;; XEmacs: used for functions that have a different opcode in v19 than v20. -;; this includes `eq', `equal', and other old-ified functions. -(defun byte-compile-two-args-19->20 (form) - (if (not (= (length form) 3)) - (byte-compile-subr-wrong-args form 2) - (byte-compile-form (car (cdr form))) ;; Push the arguments - (byte-compile-form (nth 2 form)) - (if (byte-compile-version-cond byte-compile-emacs19-compatibility) - (byte-compile-out (get (car form) 'byte-opcode19) 0) - (byte-compile-out (get (car form) 'byte-opcode) 0)))) - -(defun byte-compile-noop (form) - (byte-compile-constant nil)) - -(defun byte-compile-discard () - (byte-compile-out 'byte-discard 0)) - -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -;(defun byte-compile-associative (form) -; (if (cdr form) -; (let ((opcode (get (car form) 'byte-opcode)) -; (args (copy-sequence (cdr form)))) -; (byte-compile-form (car args)) -; (setq args (cdr args)) -; (while args -; (byte-compile-form (car args)) -; (byte-compile-out opcode 0) -; (setq args (cdr args)))) -; (byte-compile-constant (eval form)))) - -;; Compile a function that accepts one or more args and is right-associative. -;; We do it by left-associativity so that the operations -;; are done in the same order as in interpreted code. -(defun byte-compile-associative (form) - (let ((args (cdr form)) - (opcode (get (car form) 'byte-opcode))) - (case (length args) - (0 (byte-compile-constant (eval form))) - (t (byte-compile-form (car args)) - (dolist (arg (cdr args)) - (byte-compile-form arg) - (byte-compile-out opcode 0)))))) - - -;; more complicated compiler macros - -(byte-defop-compiler list) -(byte-defop-compiler concat) -(byte-defop-compiler fset) -(byte-defop-compiler insert) -(byte-defop-compiler-1 function byte-compile-function-form) -(byte-defop-compiler-1 - byte-compile-minus) -(byte-defop-compiler (/ byte-quo) byte-compile-quo) -(byte-defop-compiler nconc) -(byte-defop-compiler-1 beginning-of-line) - -(byte-defop-compiler (= byte-eqlsign) byte-compile-arithcompare) -(byte-defop-compiler (< byte-lss) byte-compile-arithcompare) -(byte-defop-compiler (> byte-gtr) byte-compile-arithcompare) -(byte-defop-compiler (<= byte-leq) byte-compile-arithcompare) -(byte-defop-compiler (>= byte-geq) byte-compile-arithcompare) - -(defun byte-compile-arithcompare (form) - (case (length (cdr form)) - (0 (byte-compile-subr-wrong-args form "1 or more")) - (1 (byte-compile-constant t)) - (2 (byte-compile-two-args form)) - (t (byte-compile-normal-call form)))) - -(byte-defop-compiler /= byte-compile-/=) - -(defun byte-compile-/= (form) - (case (length (cdr form)) - (0 (byte-compile-subr-wrong-args form "1 or more")) - (1 (byte-compile-constant t)) - ;; optimize (/= X Y) to (not (= X Y)) - (2 (byte-compile-form-do-effect `(not (= ,@(cdr form))))) - (t (byte-compile-normal-call form)))) - -;; buffer-substring now has its own function. This used to be -;; 2+1, but now all args are optional. -(byte-defop-compiler buffer-substring) - -(defun byte-compile-buffer-substring (form) - ;; buffer-substring used to take exactly two args, but now takes 0-3. - ;; convert 0-2 to two args and use special bytecode operand. - ;; convert 3 args to a normal call. - (case (length (cdr form)) - (0 (byte-compile-two-args (append form '(nil nil)))) - (1 (byte-compile-two-args (append form '(nil)))) - (2 (byte-compile-two-args form)) - (3 (byte-compile-normal-call form)) - (t (byte-compile-subr-wrong-args form "0-3")))) - -(defun byte-compile-list (form) - (let* ((args (cdr form)) - (nargs (length args))) - (cond - ((= nargs 0) - (byte-compile-constant nil)) - ((< nargs 5) - (mapcar 'byte-compile-form args) - (byte-compile-out - (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- nargs)) - 0)) - ((< nargs 256) - (mapcar 'byte-compile-form args) - (byte-compile-out 'byte-listN nargs)) - (t (byte-compile-normal-call form))))) - -(defun byte-compile-concat (form) - (let* ((args (cdr form)) - (nargs (length args))) - ;; Concat of one arg is not a no-op if arg is not a string. - (cond - ((memq nargs '(2 3 4)) - (mapcar 'byte-compile-form args) - (byte-compile-out - (aref [byte-concat2 byte-concat3 byte-concat4] (- nargs 2)) - 0)) - ((eq nargs 0) - (byte-compile-form "")) - ((< nargs 256) - (mapcar 'byte-compile-form args) - (byte-compile-out 'byte-concatN nargs)) - ((byte-compile-normal-call form))))) - -(defun byte-compile-minus (form) - (let ((args (cdr form))) - (case (length args) - (0 (byte-compile-subr-wrong-args form "1 or more")) - (1 (byte-compile-form (car args)) - (byte-compile-out 'byte-negate 0)) - (t (byte-compile-form (car args)) - (dolist (elt (cdr args)) - (byte-compile-form elt) - (byte-compile-out 'byte-diff 0)))))) - -(defun byte-compile-quo (form) - (let ((args (cdr form))) - (case (length args) - (0 (byte-compile-subr-wrong-args form "1 or more")) - (1 (byte-compile-constant 1) - (byte-compile-form (car args)) - (byte-compile-out 'byte-quo 0)) - (t (byte-compile-form (car args)) - (dolist (elt (cdr args)) - (byte-compile-form elt) - (byte-compile-out 'byte-quo 0)))))) - -(defun byte-compile-nconc (form) - (let ((args (cdr form))) - (case (length args) - (0 (byte-compile-constant nil)) - ;; nconc of one arg is a noop, even if that arg isn't a list. - (1 (byte-compile-form (car args))) - (t (byte-compile-form (car args)) - (dolist (elt (cdr args)) - (byte-compile-form elt) - (byte-compile-out 'byte-nconc 0)))))) - -(defun byte-compile-fset (form) - ;; warn about forms like (fset 'foo '(lambda () ...)) - ;; (where the lambda expression is non-trivial...) - ;; Except don't warn if the first argument is 'make-byte-code, because - ;; I'm sick of getting mail asking me whether that warning is a problem. - (let ((fn (nth 2 form)) - body) - (when (and (eq (car-safe fn) 'quote) - (eq (car-safe (setq fn (nth 1 fn))) 'lambda) - (not (eq (car-safe (cdr-safe (nth 1 form))) 'make-byte-code))) - (setq body (cdr (cdr fn))) - (if (stringp (car body)) (setq body (cdr body))) - (if (eq 'interactive (car-safe (car body))) (setq body (cdr body))) - (if (and (consp (car body)) - (not (eq 'byte-code (car (car body))))) - (byte-compile-warn - "A quoted lambda form is the second argument of fset. This is probably - not what you want, as that lambda cannot be compiled. Consider using - the syntax (function (lambda (...) ...)) instead.")))) - (byte-compile-two-args form)) - -(defun byte-compile-funarg (form) - ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..) - ;; for cases where it's guaranteed that first arg will be used as a lambda. - (byte-compile-normal-call - (let ((fn (nth 1 form))) - (if (and (eq (car-safe fn) 'quote) - (eq (car-safe (nth 1 fn)) 'lambda)) - (cons (car form) - (cons (cons 'function (cdr fn)) - (cdr (cdr form)))) - form)))) - -;; (function foo) must compile like 'foo, not like (symbol-function 'foo). -;; Otherwise it will be incompatible with the interpreter, -;; and (funcall (function foo)) will lose with autoloads. - -(defun byte-compile-function-form (form) - (byte-compile-constant - (cond ((symbolp (nth 1 form)) - (nth 1 form)) - ((byte-compile-lambda (nth 1 form)))))) - -(defun byte-compile-insert (form) - (cond ((null (cdr form)) - (byte-compile-constant nil)) - ((<= (length form) 256) - (mapcar 'byte-compile-form (cdr form)) - (if (cdr (cdr form)) - (byte-compile-out 'byte-insertN (length (cdr form))) - (byte-compile-out 'byte-insert 0))) - ((memq t (mapcar 'consp (cdr (cdr form)))) - (byte-compile-normal-call form)) - ;; We can split it; there is no function call after inserting 1st arg. - (t - (while (setq form (cdr form)) - (byte-compile-form (car form)) - (byte-compile-out 'byte-insert 0) - (when (cdr form) - (byte-compile-discard)))))) - -;; alas, the old (pre-19.12, and all existing versions of FSFmacs 19) -;; byte compiler will generate incorrect code for -;; (beginning-of-line nil buffer) because it buggily doesn't -;; check the number of arguments passed to beginning-of-line. - -(defun byte-compile-beginning-of-line (form) - (let ((len (length form))) - (cond ((> len 3) - (byte-compile-subr-wrong-args form "0-2")) - ((or (= len 3) (not (byte-compile-constp (nth 1 form)))) - (byte-compile-normal-call form)) - (t - (byte-compile-form - (list 'forward-line - (if (integerp (setq form (or (eval (nth 1 form)) 1))) - (1- form) - (byte-compile-warn - "Non-numeric arg to beginning-of-line: %s" form) - (list '1- (list 'quote form)))) - t) - (byte-compile-constant nil))))) - - -(byte-defop-compiler set) -(byte-defop-compiler-1 setq) -(byte-defop-compiler-1 set-default) -(byte-defop-compiler-1 setq-default) - -(byte-defop-compiler-1 quote) -(byte-defop-compiler-1 quote-form) - -(defun byte-compile-setq (form) - (let ((args (cdr form)) var val) - (if (null args) - ;; (setq), with no arguments. - (byte-compile-form nil for-effect) - (while args - (setq var (pop args)) - (if (null args) - ;; Odd number of args? Let `set' get the error. - (byte-compile-form `(set ',var) for-effect) - (setq val (pop args)) - (if (keywordp var) - ;; (setq :foo ':foo) compatibility kludge - (byte-compile-form `(set ',var ,val) (if args t for-effect)) - (byte-compile-form val) - (unless (or args for-effect) - (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-ref 'byte-varset var)))))) - (setq for-effect nil)) - -(defun byte-compile-set (form) - ;; Compile (set 'foo x) as (setq foo x) for trivially better code and so - ;; that we get applicable warnings. Compile everything else (including - ;; malformed calls) like a normal 2-arg byte-coded function. - (let ((symform (nth 1 form)) - (valform (nth 2 form)) - sym) - (if (and (= (length form) 3) - (= (safe-length symform) 2) - (eq (car symform) 'quote) - (symbolp (setq sym (car (cdr symform)))) - (not (byte-compile-constant-symbol-p sym))) - (byte-compile-setq `(setq ,sym ,valform)) - (byte-compile-two-args form)))) - -(defun byte-compile-setq-default (form) - (let ((args (cdr form))) - (if (null args) - ;; (setq-default), with no arguments. - (byte-compile-form nil for-effect) - ;; emit multiple calls to `set-default' if necessary - (while args - (byte-compile-form - ;; Odd number of args? Let `set-default' get the error. - `(set-default ',(pop args) ,@(if args (list (pop args)) nil)) - (if args t for-effect))))) - (setq for-effect nil)) - - -(defun byte-compile-set-default (form) - (let* ((args (cdr form)) - (nargs (length args)) - (var (car args))) - (when (and (= (safe-length var) 2) - (eq (car var) 'quote)) - (let ((sym (nth 1 var))) - (cond - ((not (symbolp sym)) - (byte-compile-warn "Attempt to set-globally non-symbol %s" sym)) - ((byte-compile-constant-symbol-p sym) - (byte-compile-warn "Attempt to set-globally constant symbol %s" sym)) - ((let ((cell (assq sym byte-compile-bound-variables))) - (and cell - (setcdr cell (logior (cdr cell) byte-compile-assigned-bit)) - t))) - ;; notice calls to set-default/setq-default for variables which - ;; have not been declared with defvar/defconst. - ((globally-boundp sym)) ; OK - ((not (memq 'free-vars byte-compile-warnings))) ; warnings suppressed? - ((memq sym byte-compile-free-assignments)) ; already warned about sym - (t - (byte-compile-warn "assignment to free variable %s" sym) - (push sym byte-compile-free-assignments))))) - (if (= nargs 2) - ;; now emit a normal call to set-default - (byte-compile-normal-call form) - (byte-compile-subr-wrong-args form 2)))) - - -(defun byte-compile-quote (form) - (byte-compile-constant (car (cdr form)))) - -(defun byte-compile-quote-form (form) - (byte-compile-constant (byte-compile-top-level (nth 1 form)))) - - -;;; control structures - -(defun byte-compile-body (body &optional for-effect) - (while (cdr body) - (byte-compile-form (car body) t) - (setq body (cdr body))) - (byte-compile-form (car body) for-effect)) - -(proclaim-inline byte-compile-body-do-effect) -(defun byte-compile-body-do-effect (body) - (byte-compile-body body for-effect) - (setq for-effect nil)) - -(proclaim-inline byte-compile-form-do-effect) -(defun byte-compile-form-do-effect (form) - (byte-compile-form form for-effect) - (setq for-effect nil)) - -(byte-defop-compiler-1 inline byte-compile-progn) -(byte-defop-compiler-1 progn) -(byte-defop-compiler-1 prog1) -(byte-defop-compiler-1 prog2) -(byte-defop-compiler-1 if) -(byte-defop-compiler-1 cond) -(byte-defop-compiler-1 and) -(byte-defop-compiler-1 or) -(byte-defop-compiler-1 while) -(byte-defop-compiler-1 funcall) -(byte-defop-compiler-1 apply byte-compile-funarg) -(byte-defop-compiler-1 mapcar byte-compile-funarg) -(byte-defop-compiler-1 mapatoms byte-compile-funarg) -(byte-defop-compiler-1 mapconcat byte-compile-funarg) -(byte-defop-compiler-1 let) -(byte-defop-compiler-1 let*) - -(defun byte-compile-progn (form) - (byte-compile-body-do-effect (cdr form))) - -(defun byte-compile-prog1 (form) - (setq form (cdr form)) - (byte-compile-form-do-effect (pop form)) - (byte-compile-body form t)) - -(defun byte-compile-prog2 (form) - (setq form (cdr form)) - (byte-compile-form (pop form) t) - (byte-compile-form-do-effect (pop form)) - (byte-compile-body form t)) - -(defmacro byte-compile-goto-if (cond discard tag) - `(byte-compile-goto - (if ,cond - (if ,discard 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop) - (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop)) - ,tag)) - -(defun byte-compile-if (form) - (byte-compile-form (car (cdr form))) - (if (null (nthcdr 3 form)) - ;; No else-forms - (let ((donetag (byte-compile-make-tag))) - (byte-compile-goto-if nil for-effect donetag) - (byte-compile-form (nth 2 form) for-effect) - (byte-compile-out-tag donetag)) - (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag))) - (byte-compile-goto 'byte-goto-if-nil elsetag) - (byte-compile-form (nth 2 form) for-effect) - (byte-compile-goto 'byte-goto donetag) - (byte-compile-out-tag elsetag) - (byte-compile-body (cdr (cdr (cdr form))) for-effect) - (byte-compile-out-tag donetag))) - (setq for-effect nil)) - -(defun byte-compile-cond (clauses) - (let ((donetag (byte-compile-make-tag)) - nexttag clause) - (while (setq clauses (cdr clauses)) - (setq clause (car clauses)) - (cond ((or (eq (car clause) t) - (and (eq (car-safe (car clause)) 'quote) - (car-safe (cdr-safe (car clause))))) - ;; Unconditional clause - (setq clause (cons t clause) - clauses nil)) - ((cdr clauses) - (byte-compile-form (car clause)) - (if (null (cdr clause)) - ;; First clause is a singleton. - (byte-compile-goto-if t for-effect donetag) - (setq nexttag (byte-compile-make-tag)) - (byte-compile-goto 'byte-goto-if-nil nexttag) - (byte-compile-body (cdr clause) for-effect) - (byte-compile-goto 'byte-goto donetag) - (byte-compile-out-tag nexttag))))) - ;; Last clause - (and (cdr clause) (not (eq (car clause) t)) - (progn (byte-compile-form (car clause)) - (byte-compile-goto-if nil for-effect donetag) - (setq clause (cdr clause)))) - (byte-compile-body-do-effect clause) - (byte-compile-out-tag donetag))) - -(defun byte-compile-and (form) - (let ((failtag (byte-compile-make-tag)) - (args (cdr form))) - (if (null args) - (byte-compile-form-do-effect t) - (while (cdr args) - (byte-compile-form (car args)) - (byte-compile-goto-if nil for-effect failtag) - (setq args (cdr args))) - (byte-compile-form-do-effect (car args)) - (byte-compile-out-tag failtag)))) - -(defun byte-compile-or (form) - (let ((wintag (byte-compile-make-tag)) - (args (cdr form))) - (if (null args) - (byte-compile-form-do-effect nil) - (while (cdr args) - (byte-compile-form (car args)) - (byte-compile-goto-if t for-effect wintag) - (setq args (cdr args))) - (byte-compile-form-do-effect (car args)) - (byte-compile-out-tag wintag)))) - -(defun byte-compile-while (form) - (let ((endtag (byte-compile-make-tag)) - (looptag (byte-compile-make-tag))) - (byte-compile-out-tag looptag) - (byte-compile-form (car (cdr form))) - (byte-compile-goto-if nil for-effect endtag) - (byte-compile-body (cdr (cdr form)) t) - (byte-compile-goto 'byte-goto looptag) - (byte-compile-out-tag endtag) - (setq for-effect nil))) - -(defun byte-compile-funcall (form) - (mapcar 'byte-compile-form (cdr form)) - (byte-compile-out 'byte-call (length (cdr (cdr form))))) - - -(defun byte-compile-let (form) - ;; First compute the binding values in the old scope. - (let ((varlist (car (cdr form)))) - (while varlist - (if (consp (car varlist)) - (byte-compile-form (car (cdr (car varlist)))) - (byte-compile-push-constant nil)) - (setq varlist (cdr varlist)))) - (let ((byte-compile-bound-variables - (cons 'new-scope byte-compile-bound-variables)) - (varlist (reverse (car (cdr form)))) - (extra-flags - ;; If this let is of the form (let (...) (byte-code ...)) - ;; then assume that it is the result of a transformation of - ;; ((lambda (...) (byte-code ... )) ...) and thus compile - ;; the variable bindings as if they were arglist bindings - ;; (which matters for what warnings.) - (if (eq 'byte-code (car-safe (nth 2 form))) - byte-compile-arglist-bit - nil))) - (while varlist - (byte-compile-variable-ref 'byte-varbind - (if (consp (car varlist)) - (car (car varlist)) - (car varlist)) - extra-flags) - (setq varlist (cdr varlist))) - (byte-compile-body-do-effect (cdr (cdr form))) - (if (memq 'unused-vars byte-compile-warnings) - ;; done compiling in this scope, warn now. - (byte-compile-warn-about-unused-variables)) - (byte-compile-out 'byte-unbind (length (car (cdr form)))))) - -(defun byte-compile-let* (form) - (let ((byte-compile-bound-variables - (cons 'new-scope byte-compile-bound-variables)) - (varlist (copy-sequence (car (cdr form))))) - (while varlist - (if (atom (car varlist)) - (byte-compile-push-constant nil) - (byte-compile-form (car (cdr (car varlist)))) - (setcar varlist (car (car varlist)))) - (byte-compile-variable-ref 'byte-varbind (car varlist)) - (setq varlist (cdr varlist))) - (byte-compile-body-do-effect (cdr (cdr form))) - (if (memq 'unused-vars byte-compile-warnings) - ;; done compiling in this scope, warn now. - (byte-compile-warn-about-unused-variables)) - (byte-compile-out 'byte-unbind (length (car (cdr form)))))) - - -;;(byte-defop-compiler-1 /= byte-compile-negated) -(byte-defop-compiler-1 atom byte-compile-negated) -(byte-defop-compiler-1 nlistp byte-compile-negated) - -;;(put '/= 'byte-compile-negated-op '=) -(put 'atom 'byte-compile-negated-op 'consp) -(put 'nlistp 'byte-compile-negated-op 'listp) - -(defun byte-compile-negated (form) - (byte-compile-form-do-effect (byte-compile-negation-optimizer form))) - -;; Even when optimization is off, atom is optimized to (not (consp ...)). -(defun byte-compile-negation-optimizer (form) - ;; an optimizer for forms where is less efficient than (not ) - (list 'not - (cons (or (get (car form) 'byte-compile-negated-op) - (error - "Compiler error: `%s' has no `byte-compile-negated-op' property" - (car form))) - (cdr form)))) - -;;; other tricky macro-like special-forms - -(byte-defop-compiler-1 catch) -(byte-defop-compiler-1 unwind-protect) -(byte-defop-compiler-1 condition-case) -(byte-defop-compiler-1 save-excursion) -(byte-defop-compiler-1 save-current-buffer) -(byte-defop-compiler-1 save-restriction) -(byte-defop-compiler-1 save-window-excursion) -(byte-defop-compiler-1 with-output-to-temp-buffer) -;; no track-mouse. - -(defun byte-compile-catch (form) - (byte-compile-form (car (cdr form))) - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) - (byte-compile-out 'byte-catch 0)) - -(defun byte-compile-unwind-protect (form) - (byte-compile-push-constant - (byte-compile-top-level-body (cdr (cdr form)) t)) - (byte-compile-out 'byte-unwind-protect 0) - (byte-compile-form-do-effect (car (cdr form))) - (byte-compile-out 'byte-unbind 1)) - -;;(defun byte-compile-track-mouse (form) -;; (byte-compile-form -;; (list -;; 'funcall -;; (list 'quote -;; (list 'lambda nil -;; (cons 'track-mouse -;; (byte-compile-top-level-body (cdr form)))))))) - -(defun byte-compile-condition-case (form) - (let* ((var (nth 1 form)) - (byte-compile-bound-variables - (if var - (cons (cons var 0) - (cons 'new-scope byte-compile-bound-variables)) - (cons 'new-scope byte-compile-bound-variables)))) - (or (symbolp var) - (byte-compile-warn - "%s is not a variable-name or nil (in condition-case)" - (prin1-to-string var))) - (byte-compile-push-constant var) - (byte-compile-push-constant (byte-compile-top-level - (nth 2 form) for-effect)) - (let ((clauses (cdr (cdr (cdr form)))) - compiled-clauses) - (while clauses - (let* ((clause (car clauses)) - (condition (car clause))) - (cond ((not (or (symbolp condition) - (and (listp condition) - (let ((syms condition) (ok t)) - (while syms - (if (not (symbolp (car syms))) - (setq ok nil)) - (setq syms (cdr syms))) - ok)))) - (byte-compile-warn - "%s is not a symbol naming a condition or a list of such (in condition-case)" - (prin1-to-string condition))) -;; ((not (or (eq condition 't) -;; (and (stringp (get condition 'error-message)) -;; (consp (get condition 'error-conditions))))) -;; (byte-compile-warn -;; "%s is not a known condition name (in condition-case)" -;; condition)) - ) - (setq compiled-clauses - (cons (cons condition - (byte-compile-top-level-body - (cdr clause) for-effect)) - compiled-clauses))) - (setq clauses (cdr clauses))) - (byte-compile-push-constant (nreverse compiled-clauses))) - (if (memq 'unused-vars byte-compile-warnings) - ;; done compiling in this scope, warn now. - (byte-compile-warn-about-unused-variables)) - (byte-compile-out 'byte-condition-case 0))) - - -(defun byte-compile-save-excursion (form) - (byte-compile-out 'byte-save-excursion 0) - (byte-compile-body-do-effect (cdr form)) - (byte-compile-out 'byte-unbind 1)) - -(defun byte-compile-save-restriction (form) - (byte-compile-out 'byte-save-restriction 0) - (byte-compile-body-do-effect (cdr form)) - (byte-compile-out 'byte-unbind 1)) - -(defun byte-compile-save-current-buffer (form) - (if (byte-compile-version-cond byte-compile-emacs19-compatibility) - ;; `save-current-buffer' special form is not available in XEmacs 19. - (byte-compile-form - `(let ((_byte_compiler_save_buffer_emulation_closure_ (current-buffer))) - (unwind-protect - (progn ,@(cdr form)) - (and (buffer-live-p _byte_compiler_save_buffer_emulation_closure_) - (set-buffer _byte_compiler_save_buffer_emulation_closure_))))) - (byte-compile-out 'byte-save-current-buffer 0) - (byte-compile-body-do-effect (cdr form)) - (byte-compile-out 'byte-unbind 1))) - -(defun byte-compile-save-window-excursion (form) - (byte-compile-push-constant - (byte-compile-top-level-body (cdr form) for-effect)) - (byte-compile-out 'byte-save-window-excursion 0)) - -(defun byte-compile-with-output-to-temp-buffer (form) - (byte-compile-form (car (cdr form))) - (byte-compile-out 'byte-temp-output-buffer-setup 0) - (byte-compile-body (cdr (cdr form))) - (byte-compile-out 'byte-temp-output-buffer-show 0)) - - -;;; top-level forms elsewhere - -(byte-defop-compiler-1 defun) -(byte-defop-compiler-1 defmacro) -(byte-defop-compiler-1 defvar) -(byte-defop-compiler-1 defconst byte-compile-defvar) -(byte-defop-compiler-1 autoload) -;; According to Mly this can go now that lambda is a macro -;(byte-defop-compiler-1 lambda byte-compile-lambda-form) -(byte-defop-compiler-1 defalias) -(byte-defop-compiler-1 define-function) - -(defun byte-compile-defun (form) - ;; This is not used for file-level defuns with doc strings. - (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning. - (list 'fset (list 'quote (nth 1 form)) - (byte-compile-byte-code-maker - (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))) - (byte-compile-discard) - (byte-compile-constant (nth 1 form))) - -(defun byte-compile-defmacro (form) - ;; This is not used for file-level defmacros with doc strings. - (byte-compile-body-do-effect - (list (list 'fset (list 'quote (nth 1 form)) - (let ((code (byte-compile-byte-code-maker - (byte-compile-lambda - (cons 'lambda (cdr (cdr form))))))) - (if (eq (car-safe code) 'make-byte-code) - (list 'cons ''macro code) - (list 'quote (cons 'macro (eval code)))))) - (list 'quote (nth 1 form))))) - -(defun byte-compile-defvar (form) - ;; This is not used for file-level defvar/consts with doc strings: - ;; byte-compile-file-form-defvar will be used in that case. - (let ((var (nth 1 form)) - (value (nth 2 form)) - (string (nth 3 form))) - (if (> (length form) 4) - (byte-compile-warn "%s used with too many args" (car form))) - (if (memq 'free-vars byte-compile-warnings) - (setq byte-compile-bound-variables - (cons (cons var byte-compile-global-bit) - byte-compile-bound-variables))) - (byte-compile-body-do-effect - (list (if (cdr (cdr form)) - (if (eq (car form) 'defconst) - (list 'setq var value) - (list 'or (list 'boundp (list 'quote var)) - (list 'setq var value)))) - ;; Put the defined variable in this library's load-history entry - ;; just as a real defvar would. - (list 'setq 'current-load-list - (list 'cons (list 'quote var) - 'current-load-list)) - (if string - (list 'put (list 'quote var) ''variable-documentation string)) - (list 'quote var))))) - -(defun byte-compile-autoload (form) - (and (byte-compile-constp (nth 1 form)) - (byte-compile-constp (nth 5 form)) - (memq (eval (nth 5 form)) '(t macro)) ; macro-p - (not (fboundp (eval (nth 1 form)))) - (byte-compile-warn - "The compiler ignores `autoload' except at top level. You should - probably put the autoload of the macro `%s' at top-level." - (eval (nth 1 form)))) - (byte-compile-normal-call form)) - -;; Lambda's in valid places are handled as special cases by various code. -;; The ones that remain are errors. -;; According to Mly this can go now that lambda is a macro -;(defun byte-compile-lambda-form (form) -; (byte-compile-warn -; "`lambda' used in function position is invalid: probably you mean #'%s" -; (let ((print-escape-newlines t) -; (print-level 4) -; (print-length 4)) -; (prin1-to-string form))) -; (byte-compile-normal-call -; (list 'signal ''error -; (list 'quote (list "`lambda' used in function position" form))))) - -;; Compile normally, but deal with warnings for the function being defined. -(defun byte-compile-defalias (form) - (if (and (consp (cdr form)) (consp (nth 1 form)) - (eq (car (nth 1 form)) 'quote) - (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form))) - (consp (nthcdr 2 form)) - (consp (nth 2 form)) - (eq (car (nth 2 form)) 'quote) - (consp (cdr (nth 2 form))) - (symbolp (nth 1 (nth 2 form)))) - (progn - (byte-compile-defalias-warn (nth 1 (nth 1 form)) - (nth 1 (nth 2 form))) - (setq byte-compile-function-environment - (cons (cons (nth 1 (nth 1 form)) - (nth 1 (nth 2 form))) - byte-compile-function-environment)))) - (byte-compile-normal-call form)) - -(defun byte-compile-define-function (form) - (byte-compile-defalias form)) - -;; Turn off warnings about prior calls to the function being defalias'd. -;; This could be smarter and compare those calls with -;; the function it is being aliased to. -(defun byte-compile-defalias-warn (new alias) - (let ((calls (assq new byte-compile-unresolved-functions))) - (if calls - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions))))) - -;;; tags - -;; Note: Most operations will strip off the 'TAG, but it speeds up -;; optimization to have the 'TAG as a part of the tag. -;; Tags will be (TAG . (tag-number . stack-depth)). -(defun byte-compile-make-tag () - (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number)))) - - -(defun byte-compile-out-tag (tag) - (push tag byte-compile-output) - (if (cdr (cdr tag)) - (progn - ;; ## remove this someday - (and byte-compile-depth - (not (= (cdr (cdr tag)) byte-compile-depth)) - (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) - (setq byte-compile-depth (cdr (cdr tag)))) - (setcdr (cdr tag) byte-compile-depth))) - -(defun byte-compile-goto (opcode tag) - (push (cons opcode tag) byte-compile-output) - (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops) - (1- byte-compile-depth) - byte-compile-depth)) - (setq byte-compile-depth (and (not (eq opcode 'byte-goto)) - (1- byte-compile-depth)))) - -(defun byte-compile-out (opcode offset) - (push (cons opcode offset) byte-compile-output) - (case opcode - (byte-call - (setq byte-compile-depth (- byte-compile-depth offset))) - (byte-return - ;; This is actually an unnecessary case, because there should be - ;; no more opcodes behind byte-return. - (setq byte-compile-depth nil)) - (t - (setq byte-compile-depth (+ byte-compile-depth - (or (aref byte-stack+-info - (symbol-value opcode)) - (- (1- offset)))) - byte-compile-maxdepth (max byte-compile-depth - byte-compile-maxdepth)))) - ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) - ) - - -;;; call tree stuff - -(defun byte-compile-annotate-call-tree (form) - (let (entry) - ;; annotate the current call - (if (setq entry (assq (car form) byte-compile-call-tree)) - (or (memq byte-compile-current-form (nth 1 entry)) ;callers - (setcar (cdr entry) - (cons byte-compile-current-form (nth 1 entry)))) - (push (list (car form) (list byte-compile-current-form) nil) - byte-compile-call-tree)) - ;; annotate the current function - (if (setq entry (assq byte-compile-current-form byte-compile-call-tree)) - (or (memq (car form) (nth 2 entry)) ;called - (setcar (cdr (cdr entry)) - (cons (car form) (nth 2 entry)))) - (push (list byte-compile-current-form nil (list (car form))) - byte-compile-call-tree)))) - -;; Renamed from byte-compile-report-call-tree -;; to avoid interfering with completion of byte-compile-file. -;;;###autoload -(defun display-call-tree (&optional filename) - "Display a call graph of a specified file. -This lists which functions have been called, what functions called -them, and what functions they call. The list includes all functions -whose definitions have been compiled in this Emacs session, as well as -all functions called by those functions. - -The call graph does not include macros, inline functions, or -primitives that the byte-code interpreter knows about directly \(eq, -cons, etc.\). - -The call tree also lists those functions which are not known to be called -\(that is, to which no calls have been compiled\), and which cannot be -invoked interactively." - (interactive) - (message "Generating call tree...") - (with-output-to-temp-buffer "*Call-Tree*" - (set-buffer "*Call-Tree*") - (erase-buffer) - (message "Generating call tree... (sorting on %s)" - byte-compile-call-tree-sort) - (insert "Call tree for " - (cond ((null byte-compile-current-file) (or filename "???")) - ((stringp byte-compile-current-file) - byte-compile-current-file) - (t (buffer-name byte-compile-current-file))) - " sorted on " - (prin1-to-string byte-compile-call-tree-sort) - ":\n\n") - (if byte-compile-call-tree-sort - (setq byte-compile-call-tree - (sort byte-compile-call-tree - (cond - ((eq byte-compile-call-tree-sort 'callers) - #'(lambda (x y) (< (length (nth 1 x)) - (length (nth 1 y))))) - ((eq byte-compile-call-tree-sort 'calls) - #'(lambda (x y) (< (length (nth 2 x)) - (length (nth 2 y))))) - ((eq byte-compile-call-tree-sort 'calls+callers) - #'(lambda (x y) (< (+ (length (nth 1 x)) - (length (nth 2 x))) - (+ (length (nth 1 y)) - (length (nth 2 y)))))) - ((eq byte-compile-call-tree-sort 'name) - #'(lambda (x y) (string< (car x) - (car y)))) - (t (error - "`byte-compile-call-tree-sort': `%s' - unknown sort mode" - byte-compile-call-tree-sort)))))) - (message "Generating call tree...") - (let ((rest byte-compile-call-tree) - (b (current-buffer)) - f p - callers calls) - (while rest - (prin1 (car (car rest)) b) - (setq callers (nth 1 (car rest)) - calls (nth 2 (car rest))) - (insert "\t" - (cond ((not (fboundp (setq f (car (car rest))))) - (if (null f) - " ";; shouldn't insert nil then, actually -sk - " ")) - ((subrp (setq f (symbol-function f))) - " ") - ((symbolp f) - (format " ==> %s" f)) - ((compiled-function-p f) - "") - ((not (consp f)) - "") - ((eq 'macro (car f)) - (if (or (compiled-function-p (cdr f)) - (assq 'byte-code (cdr (cdr (cdr f))))) - " " - " ")) - ((assq 'byte-code (cdr (cdr f))) - "") - ((eq 'lambda (car f)) - "") - (t "???")) - (format " (%d callers + %d calls = %d)" - ;; Does the optimizer eliminate common subexpressions?-sk - (length callers) - (length calls) - (+ (length callers) (length calls))) - "\n") - (if callers - (progn - (insert " called by:\n") - (setq p (point)) - (insert " " (if (car callers) - (mapconcat 'symbol-name callers ", ") - "")) - (let ((fill-prefix " ")) - (fill-region-as-paragraph p (point))))) - (if calls - (progn - (insert " calls:\n") - (setq p (point)) - (insert " " (mapconcat 'symbol-name calls ", ")) - (let ((fill-prefix " ")) - (fill-region-as-paragraph p (point))))) - (insert "\n") - (setq rest (cdr rest))) - - (message "Generating call tree...(finding uncalled functions...)") - (setq rest byte-compile-call-tree) - (let ((uncalled nil)) - (while rest - (or (nth 1 (car rest)) - (null (setq f (car (car rest)))) - (byte-compile-fdefinition f t) - (commandp (byte-compile-fdefinition f nil)) - (setq uncalled (cons f uncalled))) - (setq rest (cdr rest))) - (if uncalled - (let ((fill-prefix " ")) - (insert "Noninteractive functions not known to be called:\n ") - (setq p (point)) - (insert (mapconcat 'symbol-name (nreverse uncalled) ", ")) - (fill-region-as-paragraph p (point))))) - ) - (message "Generating call tree...done.") - )) - - -;;; by crl@newton.purdue.edu -;;; Only works noninteractively. -;;;###autoload -(defun batch-byte-compile () - "Run `byte-compile-file' on the files remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -Each file is processed even if an error occurred previously. -For example, invoke \"xemacs -batch -f batch-byte-compile $emacs/ ~/*.el\"" - ;; command-line-args-left is what is left of the command line (from - ;; startup.el) - (defvar command-line-args-left) ;Avoid 'free variable' warning - (if (not noninteractive) - (error "`batch-byte-compile' is to be used only with -batch")) - (let ((error nil)) - (while command-line-args-left - (if (file-directory-p (expand-file-name (car command-line-args-left))) - (let ((files (directory-files (car command-line-args-left))) - source dest) - (while files - (if (and (string-match emacs-lisp-file-regexp (car files)) - (not (auto-save-file-name-p (car files))) - (setq source (expand-file-name - (car files) - (car command-line-args-left))) - (setq dest (byte-compile-dest-file source)) - (file-exists-p dest) - (file-newer-than-file-p source dest)) - (if (null (batch-byte-compile-1 source)) - (setq error t))) - (setq files (cdr files)))) - (if (null (batch-byte-compile-1 (car command-line-args-left))) - (setq error t))) - (setq command-line-args-left (cdr command-line-args-left))) - (message "Done") - (kill-emacs (if error 1 0)))) - -(defun batch-byte-compile-1 (file) - (condition-case err - (progn (byte-compile-file file) t) - (error - (princ ">>Error occurred processing ") - (princ file) - (princ ": ") - (if (fboundp 'display-error) ; XEmacs 19.8+ - (display-error err nil) - (princ (or (get (car err) 'error-message) (car err))) - (mapcar #'(lambda (x) (princ " ") (prin1 x)) (cdr err))) - (princ "\n") - nil))) - -;;;###autoload -(defun batch-byte-recompile-directory-norecurse () - "Same as `batch-byte-recompile-directory' but without recursion." - (setq byte-recompile-directory-recursively nil) - (batch-byte-recompile-directory)) - -;;;###autoload -(defun batch-byte-recompile-directory () - "Runs `byte-recompile-directory' on the dirs remaining on the command line. -Must be used only with `-batch', and kills Emacs on completion. -For example, invoke `xemacs -batch -f batch-byte-recompile-directory .'." - ;; command-line-args-left is what is left of the command line (startup.el) - (defvar command-line-args-left) ;Avoid 'free variable' warning - (if (not noninteractive) - (error "batch-byte-recompile-directory is to be used only with -batch")) - (or command-line-args-left - (setq command-line-args-left '("."))) - (let ((byte-recompile-directory-ignore-errors-p t)) - (while command-line-args-left - (byte-recompile-directory (car command-line-args-left)) - (setq command-line-args-left (cdr command-line-args-left)))) - (kill-emacs 0)) - -(make-obsolete 'elisp-compile-defun 'compile-defun) -(make-obsolete 'byte-compile-report-call-tree 'display-call-tree) - -;; other make-obsolete calls in obsolete.el. - -(provide 'byte-compile) -(provide 'bytecomp) - - -;;; report metering (see the hacks in bytecode.c) - -(if (boundp 'byte-code-meter) - (defun byte-compile-report-ops () - (defvar byte-code-meter) - (with-output-to-temp-buffer "*Meter*" - (set-buffer "*Meter*") - (let ((i 0) n op off) - (while (< i 256) - (setq n (aref (aref byte-code-meter 0) i) - off nil) - (if t ;(not (zerop n)) - (progn - (setq op i) - (setq off nil) - (cond ((< op byte-nth) - (setq off (logand op 7)) - (setq op (logand op 248))) - ((>= op byte-constant) - (setq off (- op byte-constant) - op byte-constant))) - (setq op (aref byte-code-vector op)) - (insert (format "%-4d" i)) - (insert (symbol-name op)) - (if off (insert " [" (int-to-string off) "]")) - (indent-to 40) - (insert (int-to-string n) "\n"))) - (setq i (1+ i))))))) - - -;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles -;; itself, compile some of its most used recursive functions (at load time). -;; -(eval-when-compile - (or (compiled-function-p (symbol-function 'byte-compile-form)) - (assq 'byte-code (symbol-function 'byte-compile-form)) - (let ((byte-optimize nil) ; do it fast - (byte-compile-warnings nil)) - (mapcar #'(lambda (x) - (or noninteractive (message "compiling %s..." x)) - (byte-compile x) - (or noninteractive (message "compiling %s...done" x))) - '(byte-compile-normal-call - byte-compile-form - byte-compile-body - ;; Inserted some more than necessary, to speed it up. - byte-compile-top-level - byte-compile-out-toplevel - byte-compile-constant - byte-compile-variable-ref)))) - nil) - -;;; bytecomp.el ends here diff --git a/lisp/check-features.el b/lisp/check-features.el deleted file mode 100644 index 3aa0a82..0000000 --- a/lisp/check-features.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; check-features.el --- Do a sanity check on an XEmacs build - -;; Copyright (C) 1998 by Free Software Foundation, Inc. - -;; Author: SL Baur -;; 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 in FSF - -;;; Commentary: - -;; This file is executed after a build to check that all lisp packages that -;; need to be installed are. - -;;; Code: - -(require 'packages) - -(defvar build-error 0) - -(when (featurep 'tooltalk) - (condition-case nil - (package-require 'tooltalk 1.0) - (t (progn - (setq build-error 1) - (message "Error: This XEmacs is built with tooltalk support but") - (message "does not have a tooltalk package installed. Without the") - (message "tooltalk lisp package, Tooltalk support is broken."))))) - -(when (featurep 'sparcworks) - (condition-case nil - (package-require 'Sun 1.0) - (t (progn - (setq build-error 1) - (message "Error: This XEmacs is built with sparcworks support but") - (message "does not have the Sun package installed. Without the Sun") - (message "lisp package, Sparcworks support will be broken."))))) - -(kill-emacs build-error) - -;;; check-features.el ends here diff --git a/lisp/cl-compat.el b/lisp/cl-compat.el deleted file mode 100644 index 82ba291..0000000 --- a/lisp/cl-compat.el +++ /dev/null @@ -1,194 +0,0 @@ -;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) - -;; Copyright (C) 1993 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Version: 2.02 -;; 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: - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and XEmacs/Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains emulations of internal routines of the older -;; CL package which users may have called directly from their code. -;; Use (require 'cl-compat) to get these routines. - -;; See cl.el for Change Log. - - -;;; Code: - -;; Require at load-time, but not when compiling cl-compat. -(or (featurep 'cl) (require 'cl)) - - -;;; Keyword routines not supported by new package. - -(defmacro defkeyword (x &optional doc) - (list* 'defconst x (list 'quote x) (and doc (list doc)))) - -(defun keywordp (sym) - (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) - -(defun keyword-of (sym) - (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) - - -;;; Multiple values. Note that the new package uses a different -;;; convention for multiple values. The following definitions -;;; emulate the old convention; all function names have been changed -;;; by capitalizing the first letter: Values, Multiple-value-*, -;;; to avoid conflict with the new-style definitions in cl-macs. - -(put 'Multiple-value-bind 'lisp-indent-function 2) -(put 'Multiple-value-setq 'lisp-indent-function 2) -(put 'Multiple-value-call 'lisp-indent-function 1) -(put 'Multiple-value-prog1 'lisp-indent-function 1) - -(defvar *mvalues-values* nil) - -(defun Values (&rest val-forms) - (setq *mvalues-values* val-forms) - (car val-forms)) - -(defun Values-list (val-forms) - (apply 'values val-forms)) - -(defmacro Multiple-value-list (form) - (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) - '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) - (list *mvalues-temp*)))) - -(defmacro Multiple-value-call (function &rest args) - (list 'apply function - (cons 'append - (mapcar (function (lambda (x) (list 'Multiple-value-list x))) - args)))) - -(defmacro Multiple-value-bind (vars form &rest body) - (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) - -(defmacro Multiple-value-setq (vars form) - (list 'multiple-value-setq vars (list 'Multiple-value-list form))) - -(defmacro Multiple-value-prog1 (form &rest body) - (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) - - -;;; Routines for parsing keyword arguments. - -(defun build-klist (arglist keys &optional allow-others) - (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) - (or allow-others - (let ((bad (set-difference (mapcar 'car res) keys))) - (if bad (error "Bad keywords: %s not in %s" bad keys)))) - res)) - -(defun extract-from-klist (klist key &optional def) - (let ((res (assq key klist))) (if res (cdr res) def))) - -(defun keyword-argument-supplied-p (klist key) - (assq key klist)) - -(defun elt-satisfies-test-p (item elt klist) - (let ((test-not (cdr (assq ':test-not klist))) - (test (cdr (assq ':test klist))) - (key (cdr (assq ':key klist)))) - (if key (setq elt (funcall key elt))) - (if test-not (not (funcall test-not item elt)) - (funcall (or test 'eql) item elt)))) - - -;;; Rounding functions with old-style multiple value returns. - -(defun cl-floor (a &optional b) (Values-list (floor* a b))) -(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) -(defun cl-round (a &optional b) (Values-list (round* a b))) -(defun cl-truncate (a &optional b) (Values-list (truncate* a b))) - -(defun safe-idiv (a b) - (let* ((q (/ (abs a) (abs b))) - (s (* (signum a) (signum b)))) - (Values q (- a (* s q b)) s))) - - -;; Internal routines. - -(defun pair-with-newsyms (oldforms) - (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms))) - (Values (mapcar* 'list newsyms oldforms) newsyms))) - -(defun zip-lists (evens odds) - (mapcan 'list evens odds)) - -(defun unzip-lists (list) - (let ((e nil) (o nil)) - (while list - (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) - (Values (nreverse e) (nreverse o)))) - -(defun reassemble-argslists (list) - (let ((n (apply 'min (mapcar 'length list))) (res nil)) - (while (>= (setq n (1- n)) 0) - (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) - res)) - -(defun duplicate-symbols-p (list) - (let ((res nil)) - (while list - (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) - (setq list (cdr list))) - res)) - - -;;; Setf internals. - -(defun setnth (n list x) - (setcar (nthcdr n list) x)) - -(defun setnthcdr (n list x) - (setcdr (nthcdr (1- n) list) x)) - -(defun setelt (seq n x) - (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) - - -;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, -;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, -;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, -;;; all names with embedded `$'. - - -(provide 'cl-compat) - -;;; cl-compat.el ends here - diff --git a/lisp/cl-extra.el b/lisp/cl-extra.el deleted file mode 100644 index e419fe3..0000000 --- a/lisp/cl-extra.el +++ /dev/null @@ -1,847 +0,0 @@ -;;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two) - -;; Copyright (C) 1993 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Maintainer: XEmacs Development Team -;; Version: 2.02 -;; Keywords: extensions, dumped - -;; 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 file is dumped with XEmacs. - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and XEmacs/Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains portions of the Common Lisp extensions -;; package which are autoloaded since they are relatively obscure. - -;; See cl.el for Change Log. - - -;;; Code: -(eval-when-compile - (require 'obsolete)) - -(or (memq 'cl-19 features) - (error "Tried to load `cl-extra' before `cl'!")) - - -;;; We define these here so that this file can compile without having -;;; loaded the cl.el file already. - -(defmacro cl-push (x place) (list 'setq place (list 'cons x place))) -(defmacro cl-pop (place) - (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) - -(defvar cl-emacs-type) - - -;;; Type coercion. - -(defun coerce (x type) - "Coerce OBJECT to type TYPE. -TYPE is a Common Lisp type specifier." - (cond ((eq type 'list) (if (listp x) x (append x nil))) - ((eq type 'vector) (if (vectorp x) x (vconcat x))) - ((eq type 'string) (if (stringp x) x (concat x))) - ((eq type 'array) (if (arrayp x) x (vconcat x))) - ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) - ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) - ((eq type 'float) (float x)) - ((eq type 'bit-vector) (if (bit-vector-p x) x - (apply 'bit-vector (append x nil)))) - ((eq type 'weak-list) - (if (weak-list-p x) x - (let ((wl (make-weak-list))) - (set-weak-list-list wl (if (listp x) x (append x nil))) - wl))) - ((typep x type) x) - (t (error "Can't coerce %s to type %s" x type)))) - - -;;; Predicates. - -(defun equalp (x y) - "Return t if two Lisp objects have similar structures and contents. -This is like `equal', except that it accepts numerically equal -numbers of different types (float vs. integer), and also compares -strings case-insensitively." - (cond ((eq x y) t) - ((stringp x) - (and (stringp y) (= (length x) (length y)) - (or (string-equal x y) - (string-equal (downcase x) (downcase y))))) ; lazy but simple! - ((characterp x) - (and (characterp y) - (or (char-equal x y) - (char-equal (downcase x) (downcase y))))) - ((numberp x) - (and (numberp y) (= x y))) - ((consp x) - ;; XEmacs change - (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) - (and (not (consp x)) (equalp x y))) - ((vectorp x) - (and (vectorp y) (= (length x) (length y)) - (let ((i (length x))) - (while (and (>= (setq i (1- i)) 0) - (equalp (aref x i) (aref y i)))) - (< i 0)))) - (t (equal x y)))) - - -;;; Control structures. - -(defun cl-mapcar-many (cl-func cl-seqs) - (if (cdr (cdr cl-seqs)) - (let* ((cl-res nil) - (cl-n (apply 'min (mapcar 'length cl-seqs))) - (cl-i 0) - (cl-args (copy-sequence cl-seqs)) - cl-p1 cl-p2) - (setq cl-seqs (copy-sequence cl-seqs)) - (while (< cl-i cl-n) - (setq cl-p1 cl-seqs cl-p2 cl-args) - (while cl-p1 - (setcar cl-p2 - (if (consp (car cl-p1)) - (prog1 (car (car cl-p1)) - (setcar cl-p1 (cdr (car cl-p1)))) - (aref (car cl-p1) cl-i))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))) - (cl-push (apply cl-func cl-args) cl-res) - (setq cl-i (1+ cl-i))) - (nreverse cl-res)) - (let ((cl-res nil) - (cl-x (car cl-seqs)) - (cl-y (nth 1 cl-seqs))) - (let ((cl-n (min (length cl-x) (length cl-y))) - (cl-i -1)) - (while (< (setq cl-i (1+ cl-i)) cl-n) - (cl-push (funcall cl-func - (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i)) - (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i))) - cl-res))) - (nreverse cl-res)))) - -(defun map (cl-type cl-func cl-seq &rest cl-rest) - "Map a function across one or more sequences, returning a sequence. -TYPE is the sequence type to return, FUNC is the function, and SEQS -are the argument sequences." - (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) - (and cl-type (coerce cl-res cl-type)))) - -(defun maplist (cl-func cl-list &rest cl-rest) - "Map FUNC to each sublist of LIST or LISTS. -Like `mapcar', except applies to lists and their cdr's rather than to -the elements themselves." - (if cl-rest - (let ((cl-res nil) - (cl-args (cons cl-list (copy-sequence cl-rest))) - cl-p) - (while (not (memq nil cl-args)) - (cl-push (apply cl-func cl-args) cl-res) - (setq cl-p cl-args) - (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) ))) - (nreverse cl-res)) - (let ((cl-res nil)) - (while cl-list - (cl-push (funcall cl-func cl-list) cl-res) - (setq cl-list (cdr cl-list))) - (nreverse cl-res)))) - - -;; mapc is now in C, renamed from `mapc-internal'. - -;(defun mapc (cl-func cl-seq &rest cl-rest) -; "Like `mapcar', but does not accumulate values returned by the function." -; (if cl-rest -; (apply 'map nil cl-func cl-seq cl-rest) -; ;; XEmacs change: we call mapc-internal, which really doesn't -; ;; accumulate any results. -; (mapc-internal cl-func cl-seq)) -; cl-seq) - -(defun mapl (cl-func cl-list &rest cl-rest) - "Like `maplist', but does not accumulate values returned by the function." - (if cl-rest - (apply 'maplist cl-func cl-list cl-rest) - (let ((cl-p cl-list)) - (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) - cl-list) - -(defun mapcan (cl-func cl-seq &rest cl-rest) - "Like `mapcar', but nconc's together the values returned by the function." - (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) - -(defun mapcon (cl-func cl-list &rest cl-rest) - "Like `maplist', but nconc's together the values returned by the function." - (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) - -(defun some (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is true of any element of SEQ or SEQs. -If so, return the true (non-nil) value returned by PREDICATE." - (if (or cl-rest (nlistp cl-seq)) - (catch 'cl-some - (apply 'map nil - (function (lambda (&rest cl-x) - (let ((cl-res (apply cl-pred cl-x))) - (if cl-res (throw 'cl-some cl-res))))) - cl-seq cl-rest) nil) - (let ((cl-x nil)) - (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq)))))) - cl-x))) - -(defun every (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is true of every element of SEQ or SEQs." - (if (or cl-rest (nlistp cl-seq)) - (catch 'cl-every - (apply 'map nil - (function (lambda (&rest cl-x) - (or (apply cl-pred cl-x) (throw 'cl-every nil)))) - cl-seq cl-rest) t) - (while (and cl-seq (funcall cl-pred (car cl-seq))) - (setq cl-seq (cdr cl-seq))) - (null cl-seq))) - -(defun notany (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is false of every element of SEQ or SEQs." - (not (apply 'some cl-pred cl-seq cl-rest))) - -(defun notevery (cl-pred cl-seq &rest cl-rest) - "Return true if PREDICATE is false of some element of SEQ or SEQs." - (not (apply 'every cl-pred cl-seq cl-rest))) - -;;; Support for `loop'. -(defun cl-map-keymap (cl-func cl-map) - (while (symbolp cl-map) (setq cl-map (symbol-function cl-map))) - (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map) - (if (listp cl-map) - (let ((cl-p cl-map)) - (while (consp (setq cl-p (cdr cl-p))) - (cond ((consp (car cl-p)) - (funcall cl-func (car (car cl-p)) (cdr (car cl-p)))) - ((vectorp (car cl-p)) - (cl-map-keymap cl-func (car cl-p))) - ((eq (car cl-p) 'keymap) - (setq cl-p nil))))) - (let ((cl-i -1)) - (while (< (setq cl-i (1+ cl-i)) (length cl-map)) - (if (aref cl-map cl-i) - (funcall cl-func cl-i (aref cl-map cl-i)))))))) - -(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) - (or cl-base - (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0])))) - (cl-map-keymap - (function - (lambda (cl-key cl-bind) - (aset cl-base (1- (length cl-base)) cl-key) - (if (keymapp cl-bind) - (cl-map-keymap-recursively - cl-func-rec cl-bind - (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat) - cl-base (list 0))) - (funcall cl-func-rec cl-base cl-bind)))) - cl-map)) - -(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) - (or cl-what (setq cl-what (current-buffer))) - (if (bufferp cl-what) - (let (cl-mark cl-mark2 (cl-next t) cl-next2) - (save-excursion - (set-buffer cl-what) - (setq cl-mark (copy-marker (or cl-start (point-min)))) - (setq cl-mark2 (and cl-end (copy-marker cl-end)))) - (while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2))) - (setq cl-next (and (fboundp 'next-property-change) - (if cl-prop (next-single-property-change - cl-mark cl-prop cl-what) - (next-property-change cl-mark cl-what))) - cl-next2 (or cl-next (save-excursion - (set-buffer cl-what) (point-max)))) - (funcall cl-func (prog1 (marker-position cl-mark) - (set-marker cl-mark cl-next2)) - (if cl-mark2 (min cl-next2 cl-mark2) cl-next2))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))) - (or cl-start (setq cl-start 0)) - (or cl-end (setq cl-end (length cl-what))) - (while (< cl-start cl-end) - (let ((cl-next (or (and (fboundp 'next-property-change) - (if cl-prop (next-single-property-change - cl-start cl-prop cl-what) - (next-property-change cl-start cl-what))) - cl-end))) - (funcall cl-func cl-start (min cl-next cl-end)) - (setq cl-start cl-next))))) - -(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) - (or cl-buffer (setq cl-buffer (current-buffer))) - (if (fboundp 'overlay-lists) - - ;; This is the preferred algorithm, though overlay-lists is undocumented. - (let (cl-ovl) - (save-excursion - (set-buffer cl-buffer) - (setq cl-ovl (overlay-lists)) - (if cl-start (setq cl-start (copy-marker cl-start))) - (if cl-end (setq cl-end (copy-marker cl-end)))) - (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) - (while (and cl-ovl - (or (not (overlay-start (car cl-ovl))) - (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) - (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) - (not (funcall cl-func (car cl-ovl) cl-arg)))) - (setq cl-ovl (cdr cl-ovl))) - (if cl-start (set-marker cl-start nil)) - (if cl-end (set-marker cl-end nil))) - - ;; This alternate algorithm fails to find zero-length overlays. - (let ((cl-mark (save-excursion (set-buffer cl-buffer) - (copy-marker (or cl-start (point-min))))) - (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) - (copy-marker cl-end)))) - cl-pos cl-ovl) - (while (save-excursion - (and (setq cl-pos (marker-position cl-mark)) - (< cl-pos (or cl-mark2 (point-max))) - (progn - (set-buffer cl-buffer) - (setq cl-ovl (overlays-at cl-pos)) - (set-marker cl-mark (next-overlay-change cl-pos))))) - (while (and cl-ovl - (or (/= (overlay-start (car cl-ovl)) cl-pos) - (not (and (funcall cl-func (car cl-ovl) cl-arg) - (set-marker cl-mark nil))))) - (setq cl-ovl (cdr cl-ovl)))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) - -;;; Support for `setf'. -(defun cl-set-frame-visible-p (frame val) - (cond ((null val) (make-frame-invisible frame)) - ((eq val 'icon) (iconify-frame frame)) - (t (make-frame-visible frame))) - val) - -;;; Support for `progv'. -(defvar cl-progv-save) -(defun cl-progv-before (syms values) - (while syms - (cl-push (if (boundp (car syms)) - (cons (car syms) (symbol-value (car syms))) - (car syms)) cl-progv-save) - (if values - (set (cl-pop syms) (cl-pop values)) - (makunbound (cl-pop syms))))) - -(defun cl-progv-after () - (while cl-progv-save - (if (consp (car cl-progv-save)) - (set (car (car cl-progv-save)) (cdr (car cl-progv-save))) - (makunbound (car cl-progv-save))) - (cl-pop cl-progv-save))) - - -;;; Numbers. - -(defun gcd (&rest args) - "Return the greatest common divisor of the arguments." - (let ((a (abs (or (cl-pop args) 0)))) - (while args - (let ((b (abs (cl-pop args)))) - (while (> b 0) (setq b (% a (setq a b)))))) - a)) - -(defun lcm (&rest args) - "Return the least common multiple of the arguments." - (if (memq 0 args) - 0 - (let ((a (abs (or (cl-pop args) 1)))) - (while args - (let ((b (abs (cl-pop args)))) - (setq a (* (/ a (gcd a b)) b)))) - a))) - -(defun isqrt (a) - "Return the integer square root of the argument." - (if (and (integerp a) (> a 0)) - ;; XEmacs change - (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000) - ((>= a 100) 100) (t 10))) - g2) - (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) - (setq g g2)) - g) - (if (eq a 0) 0 (signal 'arith-error nil)))) - -(defun cl-expt (x y) - "Return X raised to the power of Y. Works only for integer arguments." - (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0)) - (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2))))) -(or (and (fboundp 'expt) (subrp (symbol-function 'expt))) - (defalias 'expt 'cl-expt)) - -(defun floor* (x &optional y) - "Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - -(defun ceiling* (x &optional y) - "Return a list of the ceiling of X and the fractional part of X. -With two arguments, return ceiling and remainder of their quotient." - (let ((res (floor* x y))) - (if (= (car (cdr res)) 0) res - (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) - -(defun truncate* (x &optional y) - "Return a list of the integer part of X and the fractional part of X. -With two arguments, return truncation and remainder of their quotient." - (if (eq (>= x 0) (or (null y) (>= y 0))) - (floor* x y) (ceiling* x y))) - -(defun round* (x &optional y) - "Return a list of X rounded to the nearest integer and the remainder. -With two arguments, return rounding and remainder of their quotient." - (if y - (if (and (integerp x) (integerp y)) - (let* ((hy (/ y 2)) - (res (floor* (+ x hy) y))) - (if (and (= (car (cdr res)) 0) - (= (+ hy hy) y) - (/= (% (car res) 2) 0)) - (list (1- (car res)) hy) - (list (car res) (- (car (cdr res)) hy)))) - (let ((q (round (/ x y)))) - (list q (- x (* q y))))) - (if (integerp x) (list x 0) - (let ((q (round x))) - (list q (- x q)))))) - -(defun mod* (x y) - "The remainder of X divided by Y, with the same sign as Y." - (nth 1 (floor* x y))) - -(defun rem* (x y) - "The remainder of X divided by Y, with the same sign as X." - (nth 1 (truncate* x y))) - -(defun signum (a) - "Return 1 if A is positive, -1 if negative, 0 if zero." - (cond ((> a 0) 1) ((< a 0) -1) (t 0))) - - -;; Random numbers. - -(defvar *random-state*) -(defun random* (lim &optional state) - "Return a random nonnegative number less than LIM, an integer or float. -Optional second arg STATE is a random-state object." - (or state (setq state *random-state*)) - ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. - (let ((vec (aref state 3))) - (if (integerp vec) - (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1)) - (aset state 3 (setq vec (make-vector 55 nil))) - (aset vec 0 j) - (while (> (setq i (% (+ i 21) 55)) 0) - (aset vec i (setq j (prog1 k (setq k (- j k)))))) - (while (< (setq i (1+ i)) 200) (random* 2 state)))) - (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) - (j (aset state 2 (% (1+ (aref state 2)) 55))) - (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) - (if (integerp lim) - (if (<= lim 512) (% n lim) - (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state)))) - (let ((mask 1023)) - (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) - (if (< (setq n (logand n mask)) lim) n (random* lim state)))) - (* (/ n '8388608e0) lim))))) - -(defun make-random-state (&optional state) - "Return a copy of random-state STATE, or of `*random-state*' if omitted. -If STATE is t, return a new state object seeded from the time of day." - (cond ((null state) (make-random-state *random-state*)) - ((vectorp state) (cl-copy-tree state t)) - ((integerp state) (vector 'cl-random-state-tag -1 30 state)) - (t (make-random-state (cl-random-time))))) - -(defun random-state-p (object) - "Return t if OBJECT is a random-state object." - (and (vectorp object) (= (length object) 4) - (eq (aref object 0) 'cl-random-state-tag))) - - -;; Implementation limits. - -(defun cl-finite-do (func a b) - (condition-case nil - (let ((res (funcall func a b))) ; check for IEEE infinity - (and (numberp res) (/= res (/ res 2)) res)) - (arith-error nil))) - -(defvar most-positive-float) -(defvar most-negative-float) -(defvar least-positive-float) -(defvar least-negative-float) -(defvar least-positive-normalized-float) -(defvar least-negative-normalized-float) -(defvar float-epsilon) -(defvar float-negative-epsilon) - -(defun cl-float-limits () - (or most-positive-float (not (numberp '2e1)) - (let ((x '2e0) y z) - ;; Find maximum exponent (first two loops are optimizations) - (while (cl-finite-do '* x x) (setq x (* x x))) - (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) - (while (cl-finite-do '+ x x) (setq x (+ x x))) - (setq z x y (/ x 2)) - ;; Now fill in 1's in the mantissa. - (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) - (setq x (+ x y) y (/ y 2))) - (setq most-positive-float x - most-negative-float (- x)) - ;; Divide down until mantissa starts rounding. - (setq x (/ x z) y (/ 16 z) x (* x y)) - (while (condition-case nil (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) - (arith-error nil)) - (setq x (/ x 2) y (/ y 2))) - (setq least-positive-normalized-float y - least-negative-normalized-float (- y)) - ;; Divide down until value underflows to zero. - (setq x (/ 1 z) y x) - (while (condition-case nil (> (/ x 2) 0) (arith-error nil)) - (setq x (/ x 2))) - (setq least-positive-float x - least-negative-float (- x)) - (setq x '1e0) - (while (/= (+ '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-epsilon (* x 2)) - (setq x '1e0) - (while (/= (- '1e0 x) '1e0) (setq x (/ x 2))) - (setq float-negative-epsilon (* x 2)))) - nil) - - -;;; Sequence functions. - -;XEmacs -- our built-in is more powerful. -;(defun subseq (seq start &optional end) -; "Return the subsequence of SEQ from START to END. -;If END is omitted, it defaults to the length of the sequence. -;If START or END is negative, it counts from the end." -; (if (stringp seq) (substring seq start end) -; (let (len) -; (and end (< end 0) (setq end (+ end (setq len (length seq))))) -; (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) -; (cond ((listp seq) -; (if (> start 0) (setq seq (nthcdr start seq))) -; (if end -; (let ((res nil)) -; (while (>= (setq end (1- end)) start) -; (cl-push (cl-pop seq) res)) -; (nreverse res)) -; (copy-sequence seq))) -; (t -; (or end (setq end (or len (length seq)))) -; (let ((res (make-vector (max (- end start) 0) nil)) -; (i 0)) -; (while (< start end) -; (aset res i (aref seq start)) -; (setq i (1+ i) start (1+ start))) -; res)))))) - -(defun concatenate (type &rest seqs) - "Concatenate, into a sequence of type TYPE, the argument SEQUENCES." - (case type - (vector (apply 'vconcat seqs)) - (string (apply 'concat seqs)) - (list (apply 'append (append seqs '(nil)))) - (t (error "Not a sequence type name: %s" type)))) - -;;; List functions. - -(defun revappend (x y) - "Equivalent to (append (reverse X) Y)." - (nconc (reverse x) y)) - -(defun nreconc (x y) - "Equivalent to (nconc (nreverse X) Y)." - (nconc (nreverse x) y)) - -(defun list-length (x) - "Return the length of a list. Return nil if list is circular." - (let ((n 0) (fast x) (slow x)) - (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) - (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) - (if fast (if (cdr fast) nil (1+ n)) n))) - -(defun tailp (sublist list) - "Return true if SUBLIST is a tail of LIST." - (while (and (consp list) (not (eq sublist list))) - (setq list (cdr list))) - (if (numberp sublist) (equal sublist list) (eq sublist list))) - -(defun cl-copy-tree (tree &optional vecp) - "Make a copy of TREE. -If TREE is a cons cell, this recursively copies both its car and its cdr. -Contrast to copy-sequence, which copies only along the cdrs. With second -argument VECP, this copies vectors as well as conses." - (if (consp tree) - (let ((p (setq tree (copy-list tree)))) - (while (consp p) - (if (or (consp (car p)) (and vecp (vectorp (car p)))) - (setcar p (cl-copy-tree (car p) vecp))) - (or (listp (cdr p)) (setcdr p (cl-copy-tree (cdr p) vecp))) - (cl-pop p))) - (if (and vecp (vectorp tree)) - (let ((i (length (setq tree (copy-sequence tree))))) - (while (>= (setq i (1- i)) 0) - (aset tree i (cl-copy-tree (aref tree i) vecp)))))) - tree) -(or (and (fboundp 'copy-tree) (subrp (symbol-function 'copy-tree))) - (defalias 'copy-tree 'cl-copy-tree)) - - -;;; Property lists. - -;; XEmacs: our `get' groks DEFAULT. -(defalias 'get* 'get) - -(defun getf (plist tag &optional def) - "Search PROPLIST for property PROPNAME; return its value or DEFAULT. -PROPLIST is a list of the sort returned by `symbol-plist'." - (setplist '--cl-getf-symbol-- plist) - (or (get '--cl-getf-symbol-- tag) - (and def (get* '--cl-getf-symbol-- tag def)))) - -(defun cl-set-getf (plist tag val) - (let ((p plist)) - (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) - (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) - -(defun cl-do-remf (plist tag) - (let ((p (cdr plist))) - (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) - (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) - -(defun cl-remprop (sym tag) - "Remove from SYMBOL's plist the property PROP and its value." - (let ((plist (symbol-plist sym))) - (if (and plist (eq tag (car plist))) - (progn (setplist sym (cdr (cdr plist))) t) - (cl-do-remf plist tag)))) -(or (and (fboundp 'remprop) (subrp (symbol-function 'remprop))) - (defalias 'remprop 'cl-remprop)) - - - -;;; Hash tables. - -;; The `regular' Common Lisp hash-table stuff has been moved into C. -;; Only backward compatibility stuff remains here. -(defun make-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'non-weak)) -(defun make-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'weak)) -(defun make-key-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'key-weak)) -(defun make-value-weak-hashtable (size &optional test) - (make-hash-table :size size :test test :type 'value-weak)) - -(define-obsolete-function-alias 'hashtablep 'hash-table-p) -(define-obsolete-function-alias 'hashtable-fullness 'hash-table-count) -(define-obsolete-function-alias 'hashtable-test-function 'hash-table-test) -(define-obsolete-function-alias 'hashtable-type 'hash-table-type) -(define-obsolete-function-alias 'hashtable-size 'hash-table-size) -(define-obsolete-function-alias 'copy-hashtable 'copy-hash-table) - -(make-obsolete 'make-hashtable 'make-hash-table) -(make-obsolete 'make-weak-hashtable 'make-hash-table) -(make-obsolete 'make-key-weak-hashtable 'make-hash-table) -(make-obsolete 'make-value-weak-hashtable 'make-hash-table) - -(when (fboundp 'x-keysym-hash-table) - (make-obsolete 'x-keysym-hashtable 'x-keysym-hash-table)) - -;; Compatibility stuff for old kludgy cl.el hash table implementation -(defvar cl-builtin-gethash (symbol-function 'gethash)) -(defvar cl-builtin-remhash (symbol-function 'remhash)) -(defvar cl-builtin-clrhash (symbol-function 'clrhash)) -(defvar cl-builtin-maphash (symbol-function 'maphash)) - -(defalias 'cl-gethash 'gethash) -(defalias 'cl-puthash 'puthash) -(defalias 'cl-remhash 'remhash) -(defalias 'cl-clrhash 'clrhash) -(defalias 'cl-maphash 'maphash) - -;;; Some debugging aids. - -(defun cl-prettyprint (form) - "Insert a pretty-printed rendition of a Lisp FORM in current buffer." - (let ((pt (point)) last) - (insert "\n" (prin1-to-string form) "\n") - (setq last (point)) - (goto-char (1+ pt)) - (while (search-forward "(quote " last t) - (delete-backward-char 7) - (insert "'") - (forward-sexp) - (delete-char 1)) - (goto-char (1+ pt)) - (cl-do-prettyprint))) - -(defun cl-do-prettyprint () - (skip-chars-forward " ") - (if (looking-at "(") - (let ((skip (or (looking-at "((") (looking-at "(prog") - (looking-at "(unwind-protect ") - (looking-at "(function (") - (looking-at "(cl-block-wrapper "))) - (two (or (looking-at "(defun ") (looking-at "(defmacro "))) - (let (or (looking-at "(let\\*? ") (looking-at "(while "))) - (set (looking-at "(p?set[qf] "))) - (if (or skip let - (progn - (forward-sexp) - (and (>= (current-column) 78) (progn (backward-sexp) t)))) - (let ((nl t)) - (forward-char 1) - (cl-do-prettyprint) - (or skip (looking-at ")") (cl-do-prettyprint)) - (or (not two) (looking-at ")") (cl-do-prettyprint)) - (while (not (looking-at ")")) - (if set (setq nl (not nl))) - (if nl (insert "\n")) - (lisp-indent-line) - (cl-do-prettyprint)) - (forward-char 1)))) - (forward-sexp))) - -(defvar cl-macroexpand-cmacs nil) -(defvar cl-closure-vars nil) - -(defun cl-macroexpand-all (form &optional env) - "Expand all macro calls through a Lisp FORM. -This also does some trivial optimizations to make the form prettier." - (while (or (not (eq form (setq form (macroexpand form env)))) - (and cl-macroexpand-cmacs - (not (eq form (setq form (compiler-macroexpand form))))))) - (cond ((not (consp form)) form) - ((memq (car form) '(let let*)) - (if (null (nth 1 form)) - (cl-macroexpand-all (cons 'progn (cddr form)) env) - (let ((letf nil) (res nil) (lets (cadr form))) - (while lets - (cl-push (if (consp (car lets)) - (let ((exp (cl-macroexpand-all (caar lets) env))) - (or (symbolp exp) (setq letf t)) - (cons exp (cl-macroexpand-body (cdar lets) env))) - (let ((exp (cl-macroexpand-all (car lets) env))) - (if (symbolp exp) exp - (setq letf t) (list exp nil)))) res) - (setq lets (cdr lets))) - (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form)) - (nreverse res) (cl-macroexpand-body (cddr form) env))))) - ((eq (car form) 'cond) - (cons (car form) - (mapcar (function (lambda (x) (cl-macroexpand-body x env))) - (cdr form)))) - ((eq (car form) 'condition-case) - (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env) - (mapcar (function - (lambda (x) - (cons (car x) (cl-macroexpand-body (cdr x) env)))) - (cdddr form)))) - ((memq (car form) '(quote function)) - (if (eq (car-safe (nth 1 form)) 'lambda) - (let ((body (cl-macroexpand-body (cddadr form) env))) - (if (and cl-closure-vars (eq (car form) 'function) - (cl-expr-contains-any body cl-closure-vars)) - (let* ((new (mapcar 'gensym cl-closure-vars)) - (sub (pairlis cl-closure-vars new)) (decls nil)) - (while (or (stringp (car body)) - (eq (car-safe (car body)) 'interactive)) - (cl-push (list 'quote (cl-pop body)) decls)) - (put (car (last cl-closure-vars)) 'used t) - (append - (list 'list '(quote lambda) '(quote (&rest --cl-rest--))) - (sublis sub (nreverse decls)) - (list - (list* 'list '(quote apply) - (list 'list '(quote quote) - (list 'function - (list* 'lambda - (append new (cadadr form)) - (sublis sub body)))) - (nconc (mapcar (function - (lambda (x) - (list 'list '(quote quote) x))) - cl-closure-vars) - '((quote --cl-rest--))))))) - (list (car form) (list* 'lambda (cadadr form) body)))) - (let ((found (assq (cadr form) env))) - (if (eq (cadr (caddr found)) 'cl-labels-args) - (cl-macroexpand-all (cadr (caddr (cadddr found))) env) - form)))) - ((memq (car form) '(defun defmacro)) - (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env))) - ((and (eq (car form) 'progn) (not (cddr form))) - (cl-macroexpand-all (nth 1 form) env)) - ((eq (car form) 'setq) - (let* ((args (cl-macroexpand-body (cdr form) env)) (p args)) - (while (and p (symbolp (car p))) (setq p (cddr p))) - (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args)))) - (t (cons (car form) (cl-macroexpand-body (cdr form) env))))) - -(defun cl-macroexpand-body (body &optional env) - (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) - -(defun cl-prettyexpand (form &optional full) - (message "Expanding...") - (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) - (byte-compile-macro-environment nil)) - (setq form (cl-macroexpand-all form - (and (not full) '((block) (eval-when))))) - (message "Formatting...") - (prog1 (cl-prettyprint form) - (message "")))) - - - -(run-hooks 'cl-extra-load-hook) - -(provide 'cl-extra) - -;;; cl-extra.el ends here diff --git a/lisp/cl-macs.el b/lisp/cl-macs.el deleted file mode 100644 index db30575..0000000 --- a/lisp/cl-macs.el +++ /dev/null @@ -1,2809 +0,0 @@ -;;; cl-macs.el --- Common Lisp extensions for GNU Emacs Lisp (part four) - -;; Copyright (C) 1993 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Version: 2.02 -;; 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: - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains the portions of the Common Lisp extensions -;; package which should be autoloaded, but need only be present -;; if the compiler or interpreter is used---this file is not -;; necessary for executing compiled code. - -;; See cl.el for Change Log. - - -;;; Code: - -(or (memq 'cl-19 features) - (error "Tried to load `cl-macs' before `cl'!")) - - -;;; We define these here so that this file can compile without having -;;; loaded the cl.el file already. - -(defmacro cl-push (x place) (list 'setq place (list 'cons x place))) -(defmacro cl-pop (place) - (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) -(defmacro cl-pop2 (place) - (list 'prog1 (list 'car (list 'cdr place)) - (list 'setq place (list 'cdr (list 'cdr place))))) -(put 'cl-push 'edebug-form-spec 'edebug-sexps) -(put 'cl-pop 'edebug-form-spec 'edebug-sexps) -(put 'cl-pop2 'edebug-form-spec 'edebug-sexps) - -(defvar cl-emacs-type) -(defvar cl-optimize-safety) -(defvar cl-optimize-speed) - - -;;; This kludge allows macros which use cl-transform-function-property -;;; to be called at compile-time. - -(require - (progn - (or (fboundp 'defalias) (fset 'defalias 'fset)) - (or (fboundp 'cl-transform-function-property) - (defalias 'cl-transform-function-property - #'(lambda (n p f) - (list 'put (list 'quote n) (list 'quote p) - (list 'function (cons 'lambda f)))))) - (car (or features (setq features (list 'cl-kludge)))))) - - -;;; Initialization. - -(defvar cl-old-bc-file-form nil) - -;; Patch broken Emacs 18 compiler (re top-level macros). -;; Emacs 19 compiler doesn't need this patch. -;; Also, undo broken definition of `eql' that uses same bytecode as `eq'. - -;;;###autoload -(defun cl-compile-time-init () - (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form)) - (or (fboundp 'byte-compile-flush-pending) ; Emacs 19 compiler? - (defalias 'byte-compile-file-form - #'(lambda (form) - (setq form (macroexpand form byte-compile-macro-environment)) - (if (eq (car-safe form) 'progn) - (cons 'progn (mapcar 'byte-compile-file-form (cdr form))) - (funcall cl-old-bc-file-form form))))) - (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro) - (run-hooks 'cl-hack-bytecomp-hook)) - - -;;; Symbols. - -(defvar *gensym-counter*) - -;;;###autoload -(defun 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 *gensym-counter* - (setq *gensym-counter* (1+ *gensym-counter*)))))) - (make-symbol (format "%s%d" prefix num)))) - -;;;###autoload -(defun gentemp (&optional arg) - "Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((prefix (if (stringp arg) arg "G")) - name) - (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) - (setq *gensym-counter* (1+ *gensym-counter*))) - (intern name))) - - -;;; Program structure. - -;;;###autoload -(defmacro defun* (name args &rest body) - "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. -Like normal `defun', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (block NAME ...)." - (let* ((res (cl-transform-lambda (cons args body) name)) - (form (list* 'defun name (cdr res)))) - (if (car res) (list 'progn (car res) form) form))) - -;;;###autoload -(defmacro defmacro* (name args &rest body) - "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. -Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, -and BODY is implicitly surrounded by (block NAME ...)." - (let* ((res (cl-transform-lambda (cons args body) name)) - (form (list* 'defmacro name (cdr res)))) - (if (car res) (list 'progn (car res) form) form))) - -;;;###autoload -(defmacro function* (func) - "(function* SYMBOL-OR-LAMBDA): introduce a function. -Like normal `function', except that if argument is a lambda form, its -ARGLIST allows full Common Lisp conventions." - (if (eq (car-safe func) 'lambda) - (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) - (form (list 'function (cons 'lambda (cdr res))))) - (if (car res) (list 'progn (car res) form) form)) - (list 'function func))) - -(defun cl-transform-function-property (func prop form) - (let ((res (cl-transform-lambda form func))) - (append '(progn) (cdr (cdr (car res))) - (list (list 'put (list 'quote func) (list 'quote prop) - (list 'function (cons 'lambda (cdr res)))))))) - -(defconst lambda-list-keywords - '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) - -(defvar cl-macro-environment nil) -(defvar bind-block) (defvar bind-defs) (defvar bind-enquote) -(defvar bind-inits) (defvar bind-lets) (defvar bind-forms) - -(defun cl-transform-lambda (form bind-block) - (let* ((args (car form)) (body (cdr form)) - (bind-defs nil) (bind-enquote nil) - (bind-inits nil) (bind-lets nil) (bind-forms nil) - (header nil) (simple-args nil)) - (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) - (cl-push (cl-pop body) header)) - (setq args (if (listp args) (copy-list args) (list '&rest args))) - (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) - (if (setq bind-defs (cadr (memq '&cl-defs args))) - (setq args (delq '&cl-defs (delq bind-defs args)) - bind-defs (cadr bind-defs))) - (if (setq bind-enquote (memq '&cl-quote args)) - (setq args (delq '&cl-quote args))) - (if (memq '&whole args) (error "&whole not currently implemented")) - (let* ((p (memq '&environment args)) (v (cadr p))) - (if p (setq args (nconc (delq (car p) (delq v args)) - (list '&aux (list v 'cl-macro-environment)))))) - (while (and args (symbolp (car args)) - (not (memq (car args) '(nil &rest &body &key &aux))) - (not (and (eq (car args) '&optional) - (or bind-defs (consp (cadr args)))))) - (cl-push (cl-pop args) simple-args)) - (or (eq bind-block 'cl-none) - (setq body (list (list* 'block bind-block body)))) - (if (null args) - (list* nil (nreverse simple-args) (nconc (nreverse header) body)) - (if (memq '&optional simple-args) (cl-push '&optional args)) - (cl-do-arglist args nil (- (length simple-args) - (if (memq '&optional simple-args) 1 0))) - (setq bind-lets (nreverse bind-lets)) - (list* (and bind-inits (list* 'eval-when '(compile load eval) - (nreverse bind-inits))) - (nconc (nreverse simple-args) - (list '&rest (car (cl-pop bind-lets)))) - (nconc (nreverse header) - (list (nconc (list 'let* bind-lets) - (nreverse bind-forms) body))))))) - -(defun cl-do-arglist (args expr &optional num) ; uses bind-* - (if (nlistp args) - (if (or (memq args lambda-list-keywords) (not (symbolp args))) - (error "Invalid argument name: %s" args) - (cl-push (list args expr) bind-lets)) - (setq args (copy-list args)) - (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) - (let ((p (memq '&body args))) (if p (setcar p '&rest))) - (if (memq '&environment args) (error "&environment used incorrectly")) - (let ((save-args args) - (restarg (memq '&rest args)) - (safety (if (cl-compiling-file) cl-optimize-safety 3)) - (keys nil) - (laterarg nil) (exactarg nil) minarg) - (or num (setq num 0)) - (if (listp (cadr restarg)) - (setq restarg (gensym "--rest--")) - (setq restarg (cadr restarg))) - (cl-push (list restarg expr) bind-lets) - (if (eq (car args) '&whole) - (cl-push (list (cl-pop2 args) restarg) bind-lets)) - (let ((p args)) - (setq minarg restarg) - (while (and p (not (memq (car p) lambda-list-keywords))) - (or (eq p args) (setq minarg (list 'cdr minarg))) - (setq p (cdr p))) - (if (memq (car p) '(nil &aux)) - (setq minarg (list '= (list 'length restarg) - (length (ldiff args p))) - exactarg (not (eq args p))))) - (while (and args (not (memq (car args) lambda-list-keywords))) - (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) - restarg))) - (cl-do-arglist - (cl-pop args) - (if (or laterarg (= safety 0)) poparg - (list 'if minarg poparg - (list 'signal '(quote wrong-number-of-arguments) - (list 'list (and (not (eq bind-block 'cl-none)) - (list 'quote bind-block)) - (list 'length restarg))))))) - (setq num (1+ num) laterarg t)) - (while (and (eq (car args) '&optional) (cl-pop args)) - (while (and args (not (memq (car args) lambda-list-keywords))) - (let ((arg (cl-pop args))) - (or (consp arg) (setq arg (list arg))) - (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t))) - (let ((def (if (cdr arg) (nth 1 arg) - (or (car bind-defs) - (nth 1 (assq (car arg) bind-defs))))) - (poparg (list 'pop restarg))) - (and def bind-enquote (setq def (list 'quote def))) - (cl-do-arglist (car arg) - (if def (list 'if restarg poparg def) poparg)) - (setq num (1+ num)))))) - (if (eq (car args) '&rest) - (let ((arg (cl-pop2 args))) - (if (consp arg) (cl-do-arglist arg restarg))) - (or (eq (car args) '&key) (= safety 0) exactarg - (cl-push (list 'if restarg - (list 'signal '(quote wrong-number-of-arguments) - (list 'list - (and (not (eq bind-block 'cl-none)) - (list 'quote bind-block)) - (list '+ num (list 'length restarg))))) - bind-forms))) - (while (and (eq (car args) '&key) (cl-pop args)) - (while (and args (not (memq (car args) lambda-list-keywords))) - (let ((arg (cl-pop args))) - (or (consp arg) (setq arg (list arg))) - (let* ((karg (if (consp (car arg)) (caar arg) - (intern (format ":%s" (car arg))))) - (varg (if (consp (car arg)) (cadar arg) (car arg))) - (def (if (cdr arg) (cadr arg) - (or (car bind-defs) (cadr (assq varg bind-defs))))) - (look (list 'memq (list 'quote karg) restarg))) - (and def bind-enquote (setq def (list 'quote def))) - (if (cddr arg) - (let* ((temp (or (nth 2 arg) (gensym))) - (val (list 'car (list 'cdr temp)))) - (cl-do-arglist temp look) - (cl-do-arglist varg - (list 'if temp - (list 'prog1 val (list 'setq temp t)) - def))) - (cl-do-arglist - varg - (list 'car - (list 'cdr - (if (null def) - look - (list 'or look - (if (eq (cl-const-expr-p def) t) - (list - 'quote - (list nil (cl-const-expr-val def))) - (list 'list nil def)))))))) - (cl-push karg keys) - (if (= (aref (symbol-name karg) 0) ?:) - (progn (set karg karg) - (cl-push (list 'setq karg (list 'quote karg)) - bind-inits))))))) - (setq keys (nreverse keys)) - (or (and (eq (car args) '&allow-other-keys) (cl-pop args)) - (null keys) (= safety 0) - (let* ((var (gensym "--keys--")) - (allow '(:allow-other-keys)) - (check (list - 'while var - (list - 'cond - (list (list 'memq (list 'car var) - (list 'quote (append keys allow))) - (list 'setq var (list 'cdr (list 'cdr var)))) - (list (list 'car - (list 'cdr - (list 'memq (cons 'quote allow) - restarg))) - (list 'setq var nil)) - (list t - (list - 'error - (format "Keyword argument %%s not one of %s" - keys) - (list 'car var))))))) - (cl-push (list 'let (list (list var restarg)) check) bind-forms))) - (while (and (eq (car args) '&aux) (cl-pop args)) - (while (and args (not (memq (car args) lambda-list-keywords))) - (if (consp (car args)) - (if (and bind-enquote (cadar args)) - (cl-do-arglist (caar args) - (list 'quote (cadr (cl-pop args)))) - (cl-do-arglist (caar args) (cadr (cl-pop args)))) - (cl-do-arglist (cl-pop args) nil)))) - (if args (error "Malformed argument list %s" save-args))))) - -(defun cl-arglist-args (args) - (if (nlistp args) (list args) - (let ((res nil) (kind nil) arg) - (while (consp args) - (setq arg (cl-pop args)) - (if (memq arg lambda-list-keywords) (setq kind arg) - (if (eq arg '&cl-defs) (cl-pop args) - (and (consp arg) kind (setq arg (car arg))) - (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg))) - (setq res (nconc res (cl-arglist-args arg)))))) - (nconc res (and args (list args)))))) - -;;;###autoload -(defmacro destructuring-bind (args expr &rest body) - (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) - (bind-defs nil) (bind-block 'cl-none)) - (cl-do-arglist (or args '(&aux)) expr) - (append '(progn) bind-inits - (list (nconc (list 'let* (nreverse bind-lets)) - (nreverse bind-forms) body))))) - - -;;; The `eval-when' form. - -(defvar cl-not-toplevel nil) - -;;;###autoload -(defmacro eval-when (when &rest body) - "(eval-when (WHEN...) BODY...): control when BODY is evaluated. -If `compile' is in WHEN, BODY is evaluated when compiled at top-level. -If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. -If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." - (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) - (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge - (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when))) - (cl-not-toplevel t)) - (if (or (memq 'load when) (memq ':load-toplevel when)) - (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) - (list* 'if nil nil body)) - (progn (if comp (eval (cons 'progn body))) nil))) - (and (or (memq 'eval when) (memq ':execute when)) - (cons 'progn body)))) - -(defun cl-compile-time-too (form) - (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler)) - (setq form (macroexpand - form (cons '(eval-when) byte-compile-macro-environment)))) - (cond ((eq (car-safe form) 'progn) - (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) - ((eq (car-safe form) 'eval-when) - (let ((when (nth 1 form))) - (if (or (memq 'eval when) (memq ':execute when)) - (list* 'eval-when (cons 'compile when) (cddr form)) - form))) - (t (eval form) form))) - -(or (and (fboundp 'eval-when-compile) - (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload))) - (eval '(defmacro eval-when-compile (&rest body) - "Like `progn', but evaluates the body at compile time. -The result of the body appears to the compiler as a quoted constant." - (list 'quote (eval (cons 'progn body)))))) - -;;;###autoload -(defmacro load-time-value (form &optional read-only) - "Like `progn', but evaluates the body at load time. -The result of the body appears to the compiler as a quoted constant." - (if (cl-compiling-file) - (let* ((temp (gentemp "--cl-load-time--")) - (set (list 'set (list 'quote temp) form))) - (if (and (fboundp 'byte-compile-file-form-defmumble) - (boundp 'this-kind) (boundp 'that-one)) - (fset 'byte-compile-file-form - (list 'lambda '(form) - (list 'fset '(quote byte-compile-file-form) - (list 'quote - (symbol-function 'byte-compile-file-form))) - (list 'byte-compile-file-form (list 'quote set)) - '(byte-compile-file-form form))) - ;; XEmacs change - (print set (symbol-value ;;'outbuffer - 'byte-compile-output-buffer - ))) - (list 'symbol-value (list 'quote temp))) - (list 'quote (eval form)))) - - -;;; Conditional control structures. - -;;;###autoload -(defmacro case (expr &rest clauses) - "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. -Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared -against each key in each KEYLIST; the corresponding BODY is evaluated. -If no clause succeeds, case returns nil. A single atom may be used in -place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is -allowed only in the final clause, and matches if no other keys match. -Key values are compared by `eql'." - (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) - (head-list nil) - (last-clause (car (last clauses))) - (body (cons - 'cond - (mapcar - #'(lambda (c) - (cons (cond ((memq (car c) '(t otherwise)) - (or (eq c last-clause) - (error - "`%s' is allowed only as the last case clause" - (car c))) - t) - ((eq (car c) 'ecase-error-flag) - (list 'error "ecase failed: %s, %s" - temp (list 'quote (reverse head-list)))) - ((listp (car c)) - (setq head-list (append (car c) head-list)) - (list 'member* temp (list 'quote (car c)))) - (t - (if (memq (car c) head-list) - (error "Duplicate key in case: %s" - (car c))) - (cl-push (car c) head-list) - (list 'eql temp (list 'quote (car c))))) - (or (cdr c) '(nil)))) - clauses)))) - (if (eq temp expr) body - (list 'let (list (list temp expr)) body)))) - -;; #### CL standard also requires `ccase', which signals a continuable -;; error (`cerror' in XEmacs). However, I don't think it buys us -;; anything to introduce it, as there is probably much more CL stuff -;; missing, and the feature is not essential. --hniksic - -;;;###autoload -(defmacro ecase (expr &rest clauses) - "(ecase EXPR CLAUSES...): like `case', but error if no case fits. -`otherwise'-clauses are not allowed." - (let ((disallowed (or (assq t clauses) - (assq 'otherwise clauses)))) - (if disallowed - (error "`%s' is not allowed in ecase" (car disallowed)))) - (list* 'case expr (append clauses '((ecase-error-flag))))) - -;;;###autoload -(defmacro typecase (expr &rest clauses) - "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. -Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it -satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, -typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the -final clause, and matches if no other keys match." - (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) - (type-list nil) - (body (cons - 'cond - (mapcar - #'(lambda (c) - (cons (cond ((eq (car c) 'otherwise) t) - ((eq (car c) 'ecase-error-flag) - (list 'error "etypecase failed: %s, %s" - temp (list 'quote (reverse type-list)))) - (t - (cl-push (car c) type-list) - (cl-make-type-test temp (car c)))) - (or (cdr c) '(nil)))) - clauses)))) - (if (eq temp expr) body - (list 'let (list (list temp expr)) body)))) - -;;;###autoload -(defmacro etypecase (expr &rest clauses) - "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. -`otherwise'-clauses are not allowed." - (list* 'typecase expr (append clauses '((ecase-error-flag))))) - - -;;; Blocks and exits. - -;;;###autoload -(defmacro block (name &rest body) - "(block NAME BODY...): define a lexically-scoped block named NAME. -NAME may be any symbol. Code inside the BODY forms can call `return-from' -to jump prematurely out of the block. This differs from `catch' and `throw' -in two respects: First, the NAME is an unevaluated symbol rather than a -quoted symbol or other form; and second, NAME is lexically rather than -dynamically scoped: Only references to it within BODY will work. These -references may appear inside macro expansions, but not inside functions -called from BODY." - (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) - (list 'cl-block-wrapper - (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) - body)))) - -(defvar cl-active-block-names nil) - -(put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) -(defun cl-byte-compile-block (cl-form) - (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing compiler - (progn - (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) - (cl-active-block-names (cons cl-entry cl-active-block-names)) - (cl-body (byte-compile-top-level - (cons 'progn (cddr (nth 1 cl-form)))))) - (if (cdr cl-entry) - (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body)) - (byte-compile-form cl-body)))) - (byte-compile-form (nth 1 cl-form)))) - -(put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw) -(defun cl-byte-compile-throw (cl-form) - (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) - (if cl-found (setcdr cl-found t))) - (byte-compile-normal-call (cons 'throw (cdr cl-form)))) - -;;;###autoload -(defmacro return (&optional res) - "(return [RESULT]): return from the block named nil. -This is equivalent to `(return-from nil RESULT)'." - (list 'return-from nil res)) - -;;;###autoload -(defmacro return-from (name &optional res) - "(return-from NAME [RESULT]): return from the block named NAME. -This jumps out to the innermost enclosing `(block NAME ...)' form, -returning RESULT from that form (or nil if RESULT is omitted). -This is compatible with Common Lisp, but note that `defun' and -`defmacro' do not create implicit blocks as they do in Common Lisp." - (let ((name2 (intern (format "--cl-block-%s--" name)))) - (list 'cl-block-throw (list 'quote name2) res))) - - -;;; The "loop" macro. - -(defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) -(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) -(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag) -(defvar loop-initially) (defvar loop-map-form) (defvar loop-name) -(defvar loop-result) (defvar loop-result-explicit) -(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) - -;;;###autoload -(defmacro loop (&rest args) - "(loop CLAUSE...): The Common Lisp `loop' macro. -Valid clauses are: - for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, - for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, - for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, - always COND, never COND, thereis COND, collect EXPR into VAR, - append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, - count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, - if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], - do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, - finally return EXPR, named NAME." - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) - (list 'block nil (list* 'while t args)) - (let ((loop-name nil) (loop-bindings nil) - (loop-body nil) (loop-steps nil) - (loop-result nil) (loop-result-explicit nil) - (loop-result-var nil) (loop-finish-flag nil) - (loop-accum-var nil) (loop-accum-vars nil) - (loop-initially nil) (loop-finally nil) - (loop-map-form nil) (loop-first-flag nil) - (loop-destr-temps nil) (loop-symbol-macs nil)) - (setq args (append args '(cl-end-loop))) - (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) - (if loop-finish-flag - (cl-push (list (list loop-finish-flag t)) loop-bindings)) - (if loop-first-flag - (progn (cl-push (list (list loop-first-flag t)) loop-bindings) - (cl-push (list 'setq loop-first-flag nil) loop-steps))) - (let* ((epilogue (nconc (nreverse loop-finally) - (list (or loop-result-explicit loop-result)))) - (ands (cl-loop-build-ands (nreverse loop-body))) - (while-body (nconc (cadr ands) (nreverse loop-steps))) - (body (append - (nreverse loop-initially) - (list (if loop-map-form - (list 'block '--cl-finish-- - (subst - (if (eq (car ands) t) while-body - (cons (list 'or (car ands) - '(return-from --cl-finish-- - nil)) - while-body)) - '--cl-map loop-map-form)) - (list* 'while (car ands) while-body))) - (if loop-finish-flag - (if (equal epilogue '(nil)) (list loop-result-var) - (list (list 'if loop-finish-flag - (cons 'progn epilogue) loop-result-var))) - epilogue)))) - (if loop-result-var (cl-push (list loop-result-var) loop-bindings)) - (while loop-bindings - (if (cdar loop-bindings) - (setq body (list (cl-loop-let (cl-pop loop-bindings) body t))) - (let ((lets nil)) - (while (and loop-bindings - (not (cdar loop-bindings))) - (cl-push (car (cl-pop loop-bindings)) lets)) - (setq body (list (cl-loop-let lets body nil)))))) - (if loop-symbol-macs - (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) - (list* 'block loop-name body))))) - -(defun cl-parse-loop-clause () ; uses args, loop-* - (let ((word (cl-pop args)) - (hash-types '(hash-key hash-keys hash-value hash-values)) - (key-types '(key-code key-codes key-seq key-seqs - key-binding key-bindings))) - (cond - - ((null args) - (error "Malformed `loop' macro")) - - ((eq word 'named) - (setq loop-name (cl-pop args))) - - ((eq word 'initially) - (if (memq (car args) '(do doing)) (cl-pop args)) - (or (consp (car args)) (error "Syntax error on `initially' clause")) - (while (consp (car args)) - (cl-push (cl-pop args) loop-initially))) - - ((eq word 'finally) - (if (eq (car args) 'return) - (setq loop-result-explicit (or (cl-pop2 args) '(quote nil))) - (if (memq (car args) '(do doing)) (cl-pop args)) - (or (consp (car args)) (error "Syntax error on `finally' clause")) - (if (and (eq (caar args) 'return) (null loop-name)) - (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil))) - (while (consp (car args)) - (cl-push (cl-pop args) loop-finally))))) - - ((memq word '(for as)) - (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil) - (ands nil)) - (while - (let ((var (or (cl-pop args) (gensym)))) - (setq word (cl-pop args)) - (if (eq word 'being) (setq word (cl-pop args))) - (if (memq word '(the each)) (setq word (cl-pop args))) - (if (memq word '(buffer buffers)) - (setq word 'in args (cons '(buffer-list) args))) - (cond - - ((memq word '(from downfrom upfrom to downto upto - above below by)) - (cl-push word args) - (if (memq (car args) '(downto above)) - (error "Must specify `from' value for downward loop")) - (let* ((down (or (eq (car args) 'downfrom) - (memq (caddr args) '(downto above)))) - (excl (or (memq (car args) '(above below)) - (memq (caddr args) '(above below)))) - (start (and (memq (car args) '(from upfrom downfrom)) - (cl-pop2 args))) - (end (and (memq (car args) - '(to upto downto above below)) - (cl-pop2 args))) - (step (and (eq (car args) 'by) (cl-pop2 args))) - (end-var (and (not (cl-const-expr-p end)) (gensym))) - (step-var (and (not (cl-const-expr-p step)) - (gensym)))) - (and step (numberp step) (<= step 0) - (error "Loop `by' value is not positive: %s" step)) - (cl-push (list var (or start 0)) loop-for-bindings) - (if end-var (cl-push (list end-var end) loop-for-bindings)) - (if step-var (cl-push (list step-var step) - loop-for-bindings)) - (if end - (cl-push (list - (if down (if excl '> '>=) (if excl '< '<=)) - var (or end-var end)) loop-body)) - (cl-push (list var (list (if down '- '+) var - (or step-var step 1))) - loop-for-steps))) - - ((memq word '(in in-ref on)) - (let* ((on (eq word 'on)) - (temp (if (and on (symbolp var)) var (gensym)))) - (cl-push (list temp (cl-pop args)) loop-for-bindings) - (cl-push (list 'consp temp) loop-body) - (if (eq word 'in-ref) - (cl-push (list var (list 'car temp)) loop-symbol-macs) - (or (eq temp var) - (progn - (cl-push (list var nil) loop-for-bindings) - (cl-push (list var (if on temp (list 'car temp))) - loop-for-sets)))) - (cl-push (list temp - (if (eq (car args) 'by) - (let ((step (cl-pop2 args))) - (if (and (memq (car-safe step) - '(quote function - function*)) - (symbolp (nth 1 step))) - (list (nth 1 step) temp) - (list 'funcall step temp))) - (list 'cdr temp))) - loop-for-steps))) - - ((eq word '=) - (let* ((start (cl-pop args)) - (then (if (eq (car args) 'then) (cl-pop2 args) start))) - (cl-push (list var nil) loop-for-bindings) - (if (or ands (eq (car args) 'and)) - (progn - (cl-push (list var - (list 'if - (or loop-first-flag - (setq loop-first-flag - (gensym))) - start var)) - loop-for-sets) - (cl-push (list var then) loop-for-steps)) - (cl-push (list var - (if (eq start then) start - (list 'if - (or loop-first-flag - (setq loop-first-flag (gensym))) - start then))) - loop-for-sets)))) - - ((memq word '(across across-ref)) - (let ((temp-vec (gensym)) (temp-idx (gensym))) - (cl-push (list temp-vec (cl-pop args)) loop-for-bindings) - (cl-push (list temp-idx -1) loop-for-bindings) - (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx)) - (list 'length temp-vec)) loop-body) - (if (eq word 'across-ref) - (cl-push (list var (list 'aref temp-vec temp-idx)) - loop-symbol-macs) - (cl-push (list var nil) loop-for-bindings) - (cl-push (list var (list 'aref temp-vec temp-idx)) - loop-for-sets)))) - - ((memq word '(element elements)) - (let ((ref (or (memq (car args) '(in-ref of-ref)) - (and (not (memq (car args) '(in of))) - (error "Expected `of'")))) - (seq (cl-pop2 args)) - (temp-seq (gensym)) - (temp-idx (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (eq (caadr args) 'index)) - (cadr (cl-pop2 args)) - (error "Bad `using' clause")) - (gensym)))) - (cl-push (list temp-seq seq) loop-for-bindings) - (cl-push (list temp-idx 0) loop-for-bindings) - (if ref - (let ((temp-len (gensym))) - (cl-push (list temp-len (list 'length temp-seq)) - loop-for-bindings) - (cl-push (list var (list 'elt temp-seq temp-idx)) - loop-symbol-macs) - (cl-push (list '< temp-idx temp-len) loop-body)) - (cl-push (list var nil) loop-for-bindings) - (cl-push (list 'and temp-seq - (list 'or (list 'consp temp-seq) - (list '< temp-idx - (list 'length temp-seq)))) - loop-body) - (cl-push (list var (list 'if (list 'consp temp-seq) - (list 'pop temp-seq) - (list 'aref temp-seq temp-idx))) - loop-for-sets)) - (cl-push (list temp-idx (list '1+ temp-idx)) - loop-for-steps))) - - ((memq word hash-types) - (or (memq (car args) '(in of)) (error "Expected `of'")) - (let* ((table (cl-pop2 args)) - (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (memq (caadr args) hash-types) - (not (eq (caadr args) word))) - (cadr (cl-pop2 args)) - (error "Bad `using' clause")) - (gensym)))) - (if (memq word '(hash-value hash-values)) - (setq var (prog1 other (setq other var)))) - (setq loop-map-form - (list 'maphash (list 'function - (list* 'lambda (list var other) - '--cl-map)) table)))) - - ((memq word '(symbol present-symbol external-symbol - symbols present-symbols external-symbols)) - (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args)))) - (setq loop-map-form - (list 'mapatoms (list 'function - (list* 'lambda (list var) - '--cl-map)) ob)))) - - ((memq word '(overlay overlays extent extents)) - (let ((buf nil) (from nil) (to nil)) - (while (memq (car args) '(in of from to)) - (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) - ((eq (car args) 'to) (setq to (cl-pop2 args))) - (t (setq buf (cl-pop2 args))))) - (setq loop-map-form - (list 'cl-map-extents - (list 'function (list 'lambda (list var (gensym)) - '(progn . --cl-map) nil)) - buf from to)))) - - ((memq word '(interval intervals)) - (let ((buf nil) (prop nil) (from nil) (to nil) - (var1 (gensym)) (var2 (gensym))) - (while (memq (car args) '(in of property from to)) - (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) - ((eq (car args) 'to) (setq to (cl-pop2 args))) - ((eq (car args) 'property) - (setq prop (cl-pop2 args))) - (t (setq buf (cl-pop2 args))))) - (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) - (setq var1 (car var) var2 (cdr var)) - (cl-push (list var (list 'cons var1 var2)) loop-for-sets)) - (setq loop-map-form - (list 'cl-map-intervals - (list 'function (list 'lambda (list var1 var2) - '(progn . --cl-map))) - buf prop from to)))) - - ((memq word key-types) - (or (memq (car args) '(in of)) (error "Expected `of'")) - (let ((map (cl-pop2 args)) - (other (if (eq (car args) 'using) - (if (and (= (length (cadr args)) 2) - (memq (caadr args) key-types) - (not (eq (caadr args) word))) - (cadr (cl-pop2 args)) - (error "Bad `using' clause")) - (gensym)))) - (if (memq word '(key-binding key-bindings)) - (setq var (prog1 other (setq other var)))) - (setq loop-map-form - (list (if (memq word '(key-seq key-seqs)) - 'cl-map-keymap-recursively 'cl-map-keymap) - (list 'function (list* 'lambda (list var other) - '--cl-map)) map)))) - - ((memq word '(frame frames screen screens)) - (let ((temp (gensym))) - (cl-push (list var '(selected-frame)) - loop-for-bindings) - (cl-push (list temp nil) loop-for-bindings) - (cl-push (list 'prog1 (list 'not (list 'eq var temp)) - (list 'or temp (list 'setq temp var))) - loop-body) - (cl-push (list var (list 'next-frame var)) - loop-for-steps))) - - ((memq word '(window windows)) - (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) - (temp (gensym))) - (cl-push (list var (if scr - (list 'frame-selected-window scr) - '(selected-window))) - loop-for-bindings) - (cl-push (list temp nil) loop-for-bindings) - (cl-push (list 'prog1 (list 'not (list 'eq var temp)) - (list 'or temp (list 'setq temp var))) - loop-body) - (cl-push (list var (list 'next-window var)) loop-for-steps))) - - (t - (let ((handler (and (symbolp word) - (get word 'cl-loop-for-handler)))) - (if handler - (funcall handler var) - (error "Expected a `for' preposition, found %s" word))))) - (eq (car args) 'and)) - (setq ands t) - (cl-pop args)) - (if (and ands loop-for-bindings) - (cl-push (nreverse loop-for-bindings) loop-bindings) - (setq loop-bindings (nconc (mapcar 'list loop-for-bindings) - loop-bindings))) - (if loop-for-sets - (cl-push (list 'progn - (cl-loop-let (nreverse loop-for-sets) 'setq ands) - t) loop-body)) - (if loop-for-steps - (cl-push (cons (if ands 'psetq 'setq) - (apply 'append (nreverse loop-for-steps))) - loop-steps)))) - - ((eq word 'repeat) - (let ((temp (gensym))) - (cl-push (list (list temp (cl-pop args))) loop-bindings) - (cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body))) - - ((eq word 'collect) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum nil 'nreverse))) - (if (eq var loop-accum-var) - (cl-push (list 'progn (list 'push what var) t) loop-body) - (cl-push (list 'progn - (list 'setq var (list 'nconc var (list 'list what))) - t) loop-body)))) - - ((memq word '(nconc nconcing append appending)) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum nil 'nreverse))) - (cl-push (list 'progn - (list 'setq var - (if (eq var loop-accum-var) - (list 'nconc - (list (if (memq word '(nconc nconcing)) - 'nreverse 'reverse) - what) - var) - (list (if (memq word '(nconc nconcing)) - 'nconc 'append) - var what))) t) loop-body))) - - ((memq word '(concat concating)) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum ""))) - (cl-push (list 'progn (list 'callf 'concat var what) t) loop-body))) - - ((memq word '(vconcat vconcating)) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum []))) - (cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body))) - - ((memq word '(sum summing)) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum 0))) - (cl-push (list 'progn (list 'incf var what) t) loop-body))) - - ((memq word '(count counting)) - (let ((what (cl-pop args)) - (var (cl-loop-handle-accum 0))) - (cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body))) - - ((memq word '(minimize minimizing maximize maximizing)) - (let* ((what (cl-pop args)) - (temp (if (cl-simple-expr-p what) what (gensym))) - (var (cl-loop-handle-accum nil)) - (func (intern (substring (symbol-name word) 0 3))) - (set (list 'setq var (list 'if var (list func var temp) temp)))) - (cl-push (list 'progn (if (eq temp what) set - (list 'let (list (list temp what)) set)) - t) loop-body))) - - ((eq word 'with) - (let ((bindings nil)) - (while (progn (cl-push (list (cl-pop args) - (and (eq (car args) '=) (cl-pop2 args))) - bindings) - (eq (car args) 'and)) - (cl-pop args)) - (cl-push (nreverse bindings) loop-bindings))) - - ((eq word 'while) - (cl-push (cl-pop args) loop-body)) - - ((eq word 'until) - (cl-push (list 'not (cl-pop args)) loop-body)) - - ((eq word 'always) - (or loop-finish-flag (setq loop-finish-flag (gensym))) - (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body) - (setq loop-result t)) - - ((eq word 'never) - (or loop-finish-flag (setq loop-finish-flag (gensym))) - (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args))) - loop-body) - (setq loop-result t)) - - ((eq word 'thereis) - (or loop-finish-flag (setq loop-finish-flag (gensym))) - (or loop-result-var (setq loop-result-var (gensym))) - (cl-push (list 'setq loop-finish-flag - (list 'not (list 'setq loop-result-var (cl-pop args)))) - loop-body)) - - ((memq word '(if when unless)) - (let* ((cond (cl-pop args)) - (then (let ((loop-body nil)) - (cl-parse-loop-clause) - (cl-loop-build-ands (nreverse loop-body)))) - (else (let ((loop-body nil)) - (if (eq (car args) 'else) - (progn (cl-pop args) (cl-parse-loop-clause))) - (cl-loop-build-ands (nreverse loop-body)))) - (simple (and (eq (car then) t) (eq (car else) t)))) - (if (eq (car args) 'end) (cl-pop args)) - (if (eq word 'unless) (setq then (prog1 else (setq else then)))) - (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then)) - (if simple (nth 1 else) (list (nth 2 else)))))) - (if (cl-expr-contains form 'it) - (let ((temp (gensym))) - (cl-push (list temp) loop-bindings) - (setq form (list* 'if (list 'setq temp cond) - (subst temp 'it form)))) - (setq form (list* 'if cond form))) - (cl-push (if simple (list 'progn form t) form) loop-body)))) - - ((memq word '(do doing)) - (let ((body nil)) - (or (consp (car args)) (error "Syntax error on `do' clause")) - (while (consp (car args)) (cl-push (cl-pop args) body)) - (cl-push (cons 'progn (nreverse (cons t body))) loop-body))) - - ((eq word 'return) - (or loop-finish-flag (setq loop-finish-flag (gensym))) - (or loop-result-var (setq loop-result-var (gensym))) - (cl-push (list 'setq loop-result-var (cl-pop args) - loop-finish-flag nil) loop-body)) - - (t - (let ((handler (and (symbolp word) (get word 'cl-loop-handler)))) - (or handler (error "Expected a loop keyword, found %s" word)) - (funcall handler)))) - (if (eq (car args) 'and) - (progn (cl-pop args) (cl-parse-loop-clause))))) - -(defun cl-loop-let (specs body par) ; uses loop-* - (let ((p specs) (temps nil) (new nil)) - (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) - (setq p (cdr p))) - (and par p - (progn - (setq par nil p specs) - (while p - (or (cl-const-expr-p (cadar p)) - (let ((temp (gensym))) - (cl-push (list temp (cadar p)) temps) - (setcar (cdar p) temp))) - (setq p (cdr p))))) - (while specs - (if (and (consp (car specs)) (listp (caar specs))) - (let* ((spec (caar specs)) (nspecs nil) - (expr (cadr (cl-pop specs))) - (temp (cdr (or (assq spec loop-destr-temps) - (car (cl-push (cons spec (or (last spec 0) - (gensym))) - loop-destr-temps)))))) - (cl-push (list temp expr) new) - (while (consp spec) - (cl-push (list (cl-pop spec) - (and expr (list (if spec 'pop 'car) temp))) - nspecs)) - (setq specs (nconc (nreverse nspecs) specs))) - (cl-push (cl-pop specs) new))) - (if (eq body 'setq) - (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new))))) - (if temps (list 'let* (nreverse temps) set) set)) - (list* (if par 'let 'let*) - (nconc (nreverse temps) (nreverse new)) body)))) - -(defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* - (if (eq (car args) 'into) - (let ((var (cl-pop2 args))) - (or (memq var loop-accum-vars) - (progn (cl-push (list (list var def)) loop-bindings) - (cl-push var loop-accum-vars))) - var) - (or loop-accum-var - (progn - (cl-push (list (list (setq loop-accum-var (gensym)) def)) - loop-bindings) - (setq loop-result (if func (list func loop-accum-var) - loop-accum-var)) - loop-accum-var)))) - -(defun cl-loop-build-ands (clauses) - (let ((ands nil) - (body nil)) - (while clauses - (if (and (eq (car-safe (car clauses)) 'progn) - (eq (car (last (car clauses))) t)) - (if (cdr clauses) - (setq clauses (cons (nconc (butlast (car clauses)) - (if (eq (car-safe (cadr clauses)) - 'progn) - (cdadr clauses) - (list (cadr clauses)))) - (cddr clauses))) - (setq body (cdr (butlast (cl-pop clauses))))) - (cl-push (cl-pop clauses) ands))) - (setq ands (or (nreverse ands) (list t))) - (list (if (cdr ands) (cons 'and ands) (car ands)) - body - (let ((full (if body - (append ands (list (cons 'progn (append body '(t))))) - ands))) - (if (cdr full) (cons 'and full) (car full)))))) - - -;;; Other iteration control structures. - -;;;###autoload -(defmacro do (steps endtest &rest body) - "The Common Lisp `do' loop. -Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" - (cl-expand-do-loop steps endtest body nil)) - -;;;###autoload -(defmacro do* (steps endtest &rest body) - "The Common Lisp `do*' loop. -Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" - (cl-expand-do-loop steps endtest body t)) - -(defun cl-expand-do-loop (steps endtest body star) - (list 'block nil - (list* (if star 'let* 'let) - (mapcar #'(lambda (c) (if (consp c) (list (car c) (nth 1 c)) c)) - steps) - (list* 'while (list 'not (car endtest)) - (append body - (let ((sets (mapcar - #'(lambda (c) - (and (consp c) (cdr (cdr c)) - (list (car c) (nth 2 c)))) - steps))) - (setq sets (delq nil sets)) - (and sets - (list (cons (if (or star (not (cdr sets))) - 'setq 'psetq) - (apply 'append sets))))))) - (or (cdr endtest) '(nil))))) - -;;;###autoload -(defmacro dolist (spec &rest body) - "(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 (gensym "--dolist-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (car spec)) - (list* 'while temp (list 'setq (car spec) (list 'car temp)) - (append body (list (list 'setq temp - (list 'cdr temp))))) - (if (cdr (cdr spec)) - (cons (list 'setq (car spec) nil) (cdr (cdr spec))) - '(nil)))))) - -;;;###autoload -(defmacro dotimes (spec &rest body) - "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. -Evaluate BODY with VAR bound to successive integers from 0, inclusive, -to COUNT, exclusive. Then evaluate RESULT to get return value, default -nil." - (let ((temp (gensym "--dotimes-temp--"))) - (list 'block nil - (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) - (list* 'while (list '< (car spec) temp) - (append body (list (list 'incf (car spec))))) - (or (cdr (cdr spec)) '(nil)))))) - -;;;###autoload -(defmacro do-symbols (spec &rest body) - "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. -Evaluate BODY with VAR bound to each interned symbol, or to each symbol -from OBARRAY." - ;; Apparently this doesn't have an implicit block. - (list 'block nil - (list 'let (list (car spec)) - (list* 'mapatoms - (list 'function (list* 'lambda (list (car spec)) body)) - (and (cadr spec) (list (cadr spec)))) - (caddr spec)))) - -;;;###autoload -(defmacro do-all-symbols (spec &rest body) - (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) - - -;;; Assignments. - -;;;###autoload -(defmacro psetq (&rest args) - "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. -This is like `setq', except that all VAL forms are evaluated (in order) -before assigning any symbols SYM to the corresponding values." - (cons 'psetf args)) - - -;;; Binding control structures. - -;;;###autoload -(defmacro progv (symbols values &rest body) - "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. -The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. -Each SYMBOL in the first list is bound to the corresponding VALUE in the -second list (or made unbound if VALUES is shorter than SYMBOLS); then the -BODY forms are executed and their result is returned. This is much like -a `let' form, except that the list of symbols can be computed at run-time." - (list 'let '((cl-progv-save nil)) - (list 'unwind-protect - (list* 'progn (list 'cl-progv-before symbols values) body) - '(cl-progv-after)))) - -;;; This should really have some way to shadow 'byte-compile properties, etc. -;;;###autoload -(defmacro flet (bindings &rest body) - "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. -This is an analogue of `let' that operates on the function cell of FUNC -rather than its value cell. The FORMs are evaluated with the specified -function definitions in place, then the definitions are undone (the FUNCs -go back to their previous definitions, or lack thereof)." - (list* 'letf* - (mapcar - #'(lambda (x) - (if (or (and (fboundp (car x)) - (eq (car-safe (symbol-function (car x))) 'macro)) - (cdr (assq (car x) cl-macro-environment))) - (error "Use `labels', not `flet', to rebind macro names")) - (let ((func (list 'function* - (list 'lambda (cadr x) - (list* 'block (car x) (cddr x)))))) - (if (and (cl-compiling-file) - (boundp 'byte-compile-function-environment)) - (cl-push (cons (car x) (eval func)) - byte-compile-function-environment)) - (list (list 'symbol-function (list 'quote (car x))) func))) - bindings) - body)) - -;;;###autoload -(defmacro labels (bindings &rest body) - "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings. -This is like `flet', except the bindings are lexical instead of dynamic. -Unlike `flet', this macro is fully compliant with the Common Lisp standard." - (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment)) - (while bindings - (let ((var (gensym))) - (cl-push var vars) - (cl-push (list 'function* (cons 'lambda (cdar bindings))) sets) - (cl-push var sets) - (cl-push (list (car (cl-pop bindings)) 'lambda '(&rest cl-labels-args) - (list 'list* '(quote funcall) (list 'quote var) - 'cl-labels-args)) - cl-macro-environment))) - (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body)) - cl-macro-environment))) - -;; The following ought to have a better definition for use with newer -;; byte compilers. -;;;###autoload -(defmacro macrolet (bindings &rest body) - "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. -This is like `flet', but for macros instead of functions." - (if (cdr bindings) - (list 'macrolet - (list (car bindings)) (list* 'macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (let* ((name (caar bindings)) - (res (cl-transform-lambda (cdar bindings) name))) - (eval (car res)) - (cl-macroexpand-all (cons 'progn body) - (cons (list* name 'lambda (cdr res)) - cl-macro-environment)))))) - -;;;###autoload -(defmacro symbol-macrolet (bindings &rest body) - "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. -Within the body FORMs, references to the variable NAME will be replaced -by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." - (if (cdr bindings) - (list 'symbol-macrolet - (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) - (if (null bindings) (cons 'progn body) - (cl-macroexpand-all (cons 'progn body) - (cons (list (symbol-name (caar bindings)) - (cadar bindings)) - cl-macro-environment))))) - -(defvar cl-closure-vars nil) -;;;###autoload -(defmacro lexical-let (bindings &rest body) - "(lexical-let BINDINGS BODY...): like `let', but lexically scoped. -The main visible difference is that lambdas inside BODY will create -lexical closures as in Common Lisp." - (let* ((cl-closure-vars cl-closure-vars) - (vars (mapcar #'(lambda (x) - (or (consp x) (setq x (list x))) - (cl-push (gensym (format "--%s--" (car x))) - cl-closure-vars) - (list (car x) (cadr x) (car cl-closure-vars))) - bindings)) - (ebody - (cl-macroexpand-all - (cons 'progn body) - (nconc (mapcar #'(lambda (x) - (list (symbol-name (car x)) - (list 'symbol-value (caddr x)) - t)) - vars) - (list '(defun . cl-defun-expander)) - cl-macro-environment)))) - (if (not (get (car (last cl-closure-vars)) 'used)) - (list 'let (mapcar #'(lambda (x) (list (caddr x) (cadr x))) vars) - (sublis (mapcar #'(lambda (x) - (cons (caddr x) (list 'quote (caddr x)))) - vars) - ebody)) - (list 'let (mapcar #'(lambda (x) - (list (caddr x) - (list 'make-symbol - (format "--%s--" (car x))))) - vars) - (apply 'append '(setf) - (mapcar #'(lambda (x) - (list (list 'symbol-value (caddr x)) (cadr x))) - vars)) - ebody)))) - -;;;###autoload -(defmacro lexical-let* (bindings &rest body) - "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. -The main visible difference is that lambdas inside BODY will create -lexical closures as in Common Lisp." - (if (null bindings) (cons 'progn body) - (setq bindings (reverse bindings)) - (while bindings - (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body)))) - (car body))) - -(defun cl-defun-expander (func &rest rest) - (list 'progn - (list 'defalias (list 'quote func) - (list 'function (cons 'lambda rest))) - (list 'quote func))) - - -;;; Multiple values. - -;;;###autoload -(defmacro multiple-value-bind (vars form &rest body) - "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. -FORM must return a list; the BODY is then executed with the first N elements -of this list bound (`let'-style) to each of the symbols SYM in turn. This -is analogous to the Common Lisp `multiple-value-bind' macro, using lists to -simulate true multiple return values. For compatibility, (values A B C) is -a synonym for (list A B C)." - (let ((temp (gensym)) (n -1)) - (list* 'let* (cons (list temp form) - (mapcar #'(lambda (v) - (list v (list 'nth (setq n (1+ n)) temp))) - vars)) - body))) - -;;;###autoload -(defmacro multiple-value-setq (vars form) - "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values. -FORM must return a list; the first N elements of this list are stored in -each of the symbols SYM in turn. This is analogous to the Common Lisp -`multiple-value-setq' macro, using lists to simulate true multiple return -values. For compatibility, (values A B C) is a synonym for (list A B C)." - (cond ((null vars) (list 'progn form nil)) - ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) - (t - (let* ((temp (gensym)) (n 0)) - (list 'let (list (list temp form)) - (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp)) - (cons 'setq - (apply 'nconc - (mapcar - #'(lambda (v) - (list v (list - 'nth - (setq n (1+ n)) - temp))) - vars))))))))) - - -;;; Declarations. - -;;;###autoload -(defmacro locally (&rest body) (cons 'progn body)) -;;;###autoload -(defmacro the (type form) form) - -(defvar cl-proclaim-history t) ; for future compilers -(defvar cl-declare-stack t) ; for future compilers - -(defun cl-do-proclaim (spec hist) - (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history)) - (cond ((eq (car-safe spec) 'special) - (if (boundp 'byte-compile-bound-variables) - (setq byte-compile-bound-variables - ;; todo: this should compute correct binding bits vs. 0 - (append (mapcar #'(lambda (v) (cons v 0)) - (cdr spec)) - byte-compile-bound-variables)))) - - ((eq (car-safe spec) 'inline) - (while (setq spec (cdr spec)) - (or (memq (get (car spec) 'byte-optimizer) - '(nil byte-compile-inline-expand)) - (error "%s already has a byte-optimizer, can't make it inline" - (car spec))) - (put (car spec) 'byte-optimizer 'byte-compile-inline-expand))) - - ((eq (car-safe spec) 'notinline) - (while (setq spec (cdr spec)) - (if (eq (get (car spec) 'byte-optimizer) - 'byte-compile-inline-expand) - (put (car spec) 'byte-optimizer nil)))) - - ((eq (car-safe spec) 'optimize) - (let ((speed (assq (nth 1 (assq 'speed (cdr spec))) - '((0 nil) (1 t) (2 t) (3 t)))) - (safety (assq (nth 1 (assq 'safety (cdr spec))) - '((0 t) (1 t) (2 t) (3 nil))))) - (if speed (setq cl-optimize-speed (car speed) - byte-optimize (nth 1 speed))) - (if safety (setq cl-optimize-safety (car safety) - byte-compile-delete-errors (nth 1 safety))))) - - ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) - (if (eq byte-compile-warnings t) - ;; XEmacs change - (setq byte-compile-warnings byte-compile-default-warnings)) - (while (setq spec (cdr spec)) - (if (consp (car spec)) - (if (eq (cadar spec) 0) - (setq byte-compile-warnings - (delq (caar spec) byte-compile-warnings)) - (setq byte-compile-warnings - (adjoin (caar spec) byte-compile-warnings))))))) - nil) - -;;; Process any proclamations made before cl-macs was loaded. -(defvar cl-proclaims-deferred) -(let ((p (reverse cl-proclaims-deferred))) - (while p (cl-do-proclaim (cl-pop p) t)) - (setq cl-proclaims-deferred nil)) - -;;;###autoload -(defmacro declare (&rest specs) - (if (cl-compiling-file) - (while specs - (if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack)) - (cl-do-proclaim (cl-pop specs) nil))) - nil) - - - -;;; Generalized variables. - -;;;###autoload -(defmacro define-setf-method (func args &rest body) - "(define-setf-method NAME ARGLIST BODY...): define a `setf' method. -This method shows how to handle `setf's to places of the form (NAME ARGS...). -The argument forms ARGS are bound according to ARGLIST, as if NAME were -going to be expanded as a macro, then the BODY forms are executed and must -return a list of five elements: a temporary-variables list, a value-forms -list, a store-variables list (of length one), a store-form, and an access- -form. See `defsetf' for a simpler way to define most setf-methods." - (append '(eval-when (compile load eval)) - (if (stringp (car body)) - (list (list 'put (list 'quote func) '(quote setf-documentation) - (cl-pop body)))) - (list (cl-transform-function-property - func 'setf-method (cons args body))))) - -;;;###autoload -(defmacro defsetf (func arg1 &rest args) - "(defsetf NAME FUNC): define a `setf' method. -This macro is an easy-to-use substitute for `define-setf-method' that works -well for simple place forms. In the simple `defsetf' form, `setf's of -the form (setf (NAME ARGS...) VAL) are transformed to function or macro -calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). -Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). -Here, the above `setf' call is expanded by binding the argument forms ARGS -according to ARGLIST, binding the value form VAL to STORE, then executing -BODY, which must return a Lisp form that does the necessary `setf' operation. -Actually, ARGLIST and STORE may be bound to temporary variables which are -introduced automatically to preserve proper execution order of the arguments. -Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." - (if (listp arg1) - (let* ((largs nil) (largsr nil) - (temps nil) (tempsr nil) - (restarg nil) (rest-temps nil) - (store-var (car (prog1 (car args) (setq args (cdr args))))) - (store-temp (intern (format "--%s--temp--" store-var))) - (lets1 nil) (lets2 nil) - (docstr nil) (p arg1)) - (if (stringp (car args)) - (setq docstr (prog1 (car args) (setq args (cdr args))))) - (while (and p (not (eq (car p) '&aux))) - (if (eq (car p) '&rest) - (setq p (cdr p) restarg (car p)) - (or (memq (car p) '(&optional &key &allow-other-keys)) - (setq largs (cons (if (consp (car p)) (car (car p)) (car p)) - largs) - temps (cons (intern (format "--%s--temp--" (car largs))) - temps)))) - (setq p (cdr p))) - (setq largs (nreverse largs) temps (nreverse temps)) - (if restarg - (setq largsr (append largs (list restarg)) - rest-temps (intern (format "--%s--temp--" restarg)) - tempsr (append temps (list rest-temps))) - (setq largsr largs tempsr temps)) - (let ((p1 largs) (p2 temps)) - (while p1 - (setq lets1 (cons (list (car p2) - (list 'gensym (format "--%s--" (car p1)))) - lets1) - lets2 (cons (list (car p1) (car p2)) lets2) - p1 (cdr p1) p2 (cdr p2)))) - (if restarg (setq lets2 (cons (list restarg rest-temps) lets2))) - (append (list 'define-setf-method func arg1) - (and docstr (list docstr)) - (list - (list 'let* - (nreverse - (cons (list store-temp - (list 'gensym (format "--%s--" store-var))) - (if restarg - (append - (list - (list rest-temps - (list 'mapcar '(quote gensym) - restarg))) - lets1) - lets1))) - (list 'list ; 'values - (cons (if restarg 'list* 'list) tempsr) - (cons (if restarg 'list* 'list) largsr) - (list 'list store-temp) - (cons 'let* - (cons (nreverse - (cons (list store-var store-temp) - lets2)) - args)) - (cons (if restarg 'list* 'list) - (cons (list 'quote func) tempsr))))))) - (list 'defsetf func '(&rest args) '(store) - (let ((call (list 'cons (list 'quote arg1) - '(append args (list store))))) - (if (car args) - (list 'list '(quote progn) call 'store) - call))))) - -;;; Some standard place types from Common Lisp. -(eval-when-compile (defvar ignored-arg)) ; Warning suppression -(defsetf aref aset) -(defsetf car setcar) -(defsetf cdr setcdr) -(defsetf elt (seq n) (store) - (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store) - (list 'aset seq n store))) -(defsetf get (x y &optional ignored-arg) (store) (list 'put x y store)) -(defsetf get* (x y &optional ignored-arg) (store) (list 'put x y store)) -(defsetf gethash (x h &optional ignored-arg) (store) (list 'cl-puthash x store h)) -(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) -(defsetf subseq (seq start &optional end) (new) - (list 'progn (list 'replace seq new ':start1 start ':end1 end) new)) -(defsetf symbol-function fset) -(defsetf symbol-plist setplist) -(defsetf symbol-value set) - -;;; Various car/cdr aliases. Note that `cadr' is handled specially. -(defsetf first setcar) -(defsetf second (x) (store) (list 'setcar (list 'cdr x) store)) -(defsetf third (x) (store) (list 'setcar (list 'cddr x) store)) -(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store)) -(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store)) -(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store)) -(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store)) -(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store)) -(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store)) -(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store)) -(defsetf rest setcdr) - -;;; Some more Emacs-related place types. -(defsetf buffer-file-name set-visited-file-name t) -(defsetf buffer-modified-p set-buffer-modified-p t) -(defsetf buffer-name rename-buffer t) -(defsetf buffer-string () (store) - (list 'progn '(erase-buffer) (list 'insert store))) -(defsetf buffer-substring cl-set-buffer-substring) -(defsetf current-buffer set-buffer) -(defsetf current-case-table set-case-table) -(defsetf current-column move-to-column t) -(defsetf current-global-map use-global-map t) -(defsetf current-input-mode () (store) - (list 'progn (list 'apply 'set-input-mode store) store)) -(defsetf current-local-map use-local-map t) -(defsetf current-window-configuration set-window-configuration t) -(defsetf default-file-modes set-default-file-modes t) -(defsetf default-value set-default) -(defsetf documentation-property put) -(defsetf extent-face set-extent-face) -(defsetf extent-priority set-extent-priority) -(defsetf extent-property (x y &optional ignored-arg) (arg) - (list 'set-extent-property x y arg)) -(defsetf extent-end-position (ext) (store) - (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) - store) store)) -(defsetf extent-start-position (ext) (store) - (list 'progn (list 'set-extent-endpoints store - (list 'extent-end-position ext)) store)) -(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) -(defsetf face-background-pixmap (f &optional s) (x) - (list 'set-face-background-pixmap f x s)) -(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s)) -(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) -(defsetf face-underline-p (f &optional s) (x) - (list 'set-face-underline-p f x s)) -(defsetf file-modes set-file-modes t) -(defsetf frame-parameters modify-frame-parameters t) -(defsetf frame-visible-p cl-set-frame-visible-p) -(defsetf frame-properties (&optional f) (p) - `(progn (set-frame-properties ,f ,p) ,p)) -(defsetf frame-property (f p &optional ignored-arg) (v) - `(progn (set-frame-property ,f ,v) ,p)) -(defsetf frame-width (&optional f) (v) - `(progn (set-frame-width ,f ,v) ,v)) -(defsetf frame-height (&optional f) (v) - `(progn (set-frame-height ,f ,v) ,v)) -(defsetf current-frame-configuration set-frame-configuration) - -;; XEmacs: new stuff -;; Consoles -(defsetf selected-console select-console t) -(defsetf selected-device select-device t) -(defsetf device-baud-rate (&optional d) (v) - `(set-device-baud-rate ,d ,v)) -;; This setf method is a bad idea, because set-specifier *adds* a -;; specification, rather than just setting it. The net effect is that -;; it makes specifier-instance return VAL, but other things don't work -;; as expected -- letf, to name one. -;(defsetf specifier-instance (spec &optional dom def nof) (val) -; `(set-specifier ,spec ,val ,dom)) - -;; Annotations -(defsetf annotation-glyph set-annotation-glyph) -(defsetf annotation-down-glyph set-annotation-down-glyph) -(defsetf annotation-face set-annotation-face) -(defsetf annotation-layout set-annotation-layout) -(defsetf annotation-data set-annotation-data) -(defsetf annotation-action set-annotation-action) -(defsetf annotation-menu set-annotation-menu) -;; Widget -(defsetf widget-get widget-put t) -(defsetf widget-value widget-value-set t) - -;; Misc -(defsetf recent-keys-ring-size set-recent-keys-ring-size) -(defsetf symbol-value-in-buffer (s b &optional ignored-arg) (store) - `(with-current-buffer ,b (set ,s ,store))) -(defsetf symbol-value-in-console (s c &optional ignored-arg) (store) - `(letf (((selected-console) ,c)) - (set ,s ,store))) - -(defsetf buffer-dedicated-frame (&optional b) (v) - `(set-buffer-dedicated-frame ,b ,v)) -(defsetf console-type-image-conversion-list - set-console-type-image-conversion-list) -(defsetf default-toolbar-position set-default-toolbar-position) -(defsetf device-class (&optional d) (v) - `(set-device-class ,d ,v)) -(defsetf extent-begin-glyph set-extent-begin-glyph) -(defsetf extent-begin-glyph-layout set-extent-begin-glyph-layout) -(defsetf extent-end-glyph set-extent-end-glyph) -(defsetf extent-end-glyph-layout set-extent-end-glyph-layout) -(defsetf extent-keymap set-extent-keymap) -(defsetf extent-parent set-extent-parent) -(defsetf extent-properties set-extent-properties) -;; Avoid adding various face and glyph functions. -(defsetf frame-selected-window (&optional f) (v) - `(set-frame-selected-window ,f ,v)) -(defsetf glyph-image (glyph &optional domain) (i) - (list 'set-glyph-image glyph i domain)) -(defsetf itimer-function set-itimer-function) -(defsetf itimer-function-arguments set-itimer-function-arguments) -(defsetf itimer-is-idle set-itimer-is-idle) -(defsetf itimer-recorded-run-time set-itimer-recorded-run-time) -(defsetf itimer-restart set-itimer-restart) -(defsetf itimer-uses-arguments set-itimer-uses-arguments) -(defsetf itimer-value set-itimer-value) -(defsetf keymap-parents set-keymap-parents) -(defsetf marker-insertion-type set-marker-insertion-type) -(defsetf mouse-pixel-position (&optional d) (v) - `(progn - (set-mouse-pixel-position ,d ,(car v) ,(car (cdr v)) ,(cdr (cdr v))) - ,v)) -(defsetf trunc-stack-length set-trunc-stack-length) -(defsetf trunc-stack-stack set-trunc-stack-stack) -(defsetf undoable-stack-max set-undoable-stack-max) -(defsetf weak-list-list set-weak-list-list) - - -(defsetf getenv setenv t) -(defsetf get-register set-register) -(defsetf global-key-binding global-set-key) -(defsetf keymap-parent set-keymap-parent) -(defsetf keymap-name set-keymap-name) -(defsetf keymap-prompt set-keymap-prompt) -(defsetf keymap-default-binding set-keymap-default-binding) -(defsetf local-key-binding local-set-key) -(defsetf mark set-mark t) -(defsetf mark-marker set-mark t) -(defsetf marker-position set-marker t) -(defsetf match-data store-match-data t) -(defsetf mouse-position (scr) (store) - (list 'set-mouse-position scr (list 'car store) (list 'cadr store) - (list 'cddr store))) -(defsetf overlay-get overlay-put) -(defsetf overlay-start (ov) (store) - (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store)) -(defsetf overlay-end (ov) (store) - (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store)) -(defsetf point goto-char) -(defsetf point-marker goto-char t) -(defsetf point-max () (store) - (list 'progn (list 'narrow-to-region '(point-min) store) store)) -(defsetf point-min () (store) - (list 'progn (list 'narrow-to-region store '(point-max)) store)) -(defsetf process-buffer set-process-buffer) -(defsetf process-filter set-process-filter) -(defsetf process-sentinel set-process-sentinel) -(defsetf read-mouse-position (scr) (store) - (list 'set-mouse-position scr (list 'car store) (list 'cdr store))) -(defsetf selected-window select-window) -(defsetf selected-frame select-frame) -(defsetf standard-case-table set-standard-case-table) -(defsetf syntax-table set-syntax-table) -(defsetf visited-file-modtime set-visited-file-modtime t) -(defsetf window-buffer set-window-buffer t) -(defsetf window-display-table set-window-display-table t) -(defsetf window-dedicated-p set-window-dedicated-p t) -(defsetf window-height (&optional window) (store) - `(progn (enlarge-window (- ,store (window-height)) nil ,window) ,store)) -(defsetf window-hscroll set-window-hscroll) -(defsetf window-point set-window-point) -(defsetf window-start set-window-start) -(defsetf window-width (&optional window) (store) - `(progn (enlarge-window (- ,store (window-width)) t ,window) ,store)) -(defsetf x-get-cutbuffer x-store-cutbuffer t) -(defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. -(defsetf x-get-secondary-selection x-own-secondary-selection t) -(defsetf x-get-selection x-own-selection t) - -;;; More complex setf-methods. -;;; These should take &environment arguments, but since full arglists aren't -;;; available while compiling cl-macs, we fake it by referring to the global -;;; variable cl-macro-environment directly. - -(define-setf-method apply (func arg1 &rest rest) - (or (and (memq (car-safe func) '(quote function function*)) - (symbolp (car-safe (cdr-safe func)))) - (error "First arg to apply in setf is not (function SYM): %s" func)) - (let* ((form (cons (nth 1 func) (cons arg1 rest))) - (method (get-setf-method form cl-macro-environment))) - (list (car method) (nth 1 method) (nth 2 method) - (cl-setf-make-apply (nth 3 method) (cadr func) (car method)) - (cl-setf-make-apply (nth 4 method) (cadr func) (car method))))) - -(defun cl-setf-make-apply (form func temps) - (if (eq (car form) 'progn) - (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form)) - (or (equal (last form) (last temps)) - (error "%s is not suitable for use with setf-of-apply" func)) - (list* 'apply (list 'quote (car form)) (cdr form)))) - -(define-setf-method nthcdr (n place) - (let ((method (get-setf-method place cl-macro-environment)) - (n-temp (gensym "--nthcdr-n--")) - (store-temp (gensym "--nthcdr-store--"))) - (list (cons n-temp (car method)) - (cons n (nth 1 method)) - (list store-temp) - (list 'let (list (list (car (nth 2 method)) - (list 'cl-set-nthcdr n-temp (nth 4 method) - store-temp))) - (nth 3 method) store-temp) - (list 'nthcdr n-temp (nth 4 method))))) - -(define-setf-method getf (place tag &optional def) - (let ((method (get-setf-method place cl-macro-environment)) - (tag-temp (gensym "--getf-tag--")) - (def-temp (gensym "--getf-def--")) - (store-temp (gensym "--getf-store--"))) - (list (append (car method) (list tag-temp def-temp)) - (append (nth 1 method) (list tag def)) - (list store-temp) - (list 'let (list (list (car (nth 2 method)) - (list 'cl-set-getf (nth 4 method) - tag-temp store-temp))) - (nth 3 method) store-temp) - (list 'getf (nth 4 method) tag-temp def-temp)))) - -(define-setf-method substring (place from &optional to) - (let ((method (get-setf-method place cl-macro-environment)) - (from-temp (gensym "--substring-from--")) - (to-temp (gensym "--substring-to--")) - (store-temp (gensym "--substring-store--"))) - (list (append (car method) (list from-temp to-temp)) - (append (nth 1 method) (list from to)) - (list store-temp) - (list 'let (list (list (car (nth 2 method)) - (list 'cl-set-substring (nth 4 method) - from-temp to-temp store-temp))) - (nth 3 method) store-temp) - (list 'substring (nth 4 method) from-temp to-temp)))) - -(define-setf-method values (&rest args) - (let ((methods (mapcar #'(lambda (x) - (get-setf-method x cl-macro-environment)) - args)) - (store-temp (gensym "--values-store--"))) - (list (apply 'append (mapcar 'first methods)) - (apply 'append (mapcar 'second methods)) - (list store-temp) - (cons 'list - (mapcar #'(lambda (m) - (cl-setf-do-store (cons (car (third m)) (fourth m)) - (list 'pop store-temp))) - methods)) - (cons 'list (mapcar 'fifth methods))))) - -;;; Getting and optimizing setf-methods. -;;;###autoload -(defun get-setf-method (place &optional env) - "Return a list of five values describing the setf-method for PLACE. -PLACE may be any Lisp form which can appear as the PLACE argument to -a macro like `setf' or `incf'." - (if (symbolp place) - (let ((temp (gensym "--setf--"))) - (list nil nil (list temp) (list 'setq place temp) place)) - (or (and (symbolp (car place)) - (let* ((func (car place)) - (name (symbol-name func)) - (method (get func 'setf-method)) - (case-fold-search nil)) - (or (and method - (let ((cl-macro-environment env)) - (setq method (apply method (cdr place)))) - (if (and (consp method) (= (length method) 5)) - method - (error "Setf-method for %s returns malformed method" - func))) - (and (save-match-data - (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name)) - (get-setf-method (compiler-macroexpand place))) - (and (eq func 'edebug-after) - (get-setf-method (nth (1- (length place)) place) - env))))) - (if (eq place (setq place (macroexpand place env))) - (if (and (symbolp (car place)) (fboundp (car place)) - (symbolp (symbol-function (car place)))) - (get-setf-method (cons (symbol-function (car place)) - (cdr place)) env) - (error "No setf-method known for %s" (car place))) - (get-setf-method place env))))) - -(defun cl-setf-do-modify (place opt-expr) - (let* ((method (get-setf-method place cl-macro-environment)) - (temps (car method)) (values (nth 1 method)) - (lets nil) (subs nil) - (optimize (and (not (eq opt-expr 'no-opt)) - (or (and (not (eq opt-expr 'unsafe)) - (cl-safe-expr-p opt-expr)) - (cl-setf-simple-store-p (car (nth 2 method)) - (nth 3 method))))) - (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place))))) - (while values - (if (or simple (cl-const-expr-p (car values))) - (cl-push (cons (cl-pop temps) (cl-pop values)) subs) - (cl-push (list (cl-pop temps) (cl-pop values)) lets))) - (list (nreverse lets) - (cons (car (nth 2 method)) (sublis subs (nth 3 method))) - (sublis subs (nth 4 method))))) - -(defun cl-setf-do-store (spec val) - (let ((sym (car spec)) - (form (cdr spec))) - (if (or (cl-const-expr-p val) - (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1)) - (cl-setf-simple-store-p sym form)) - (subst val sym form) - (list 'let (list (list sym val)) form)))) - -(defun cl-setf-simple-store-p (sym form) - (and (consp form) (eq (cl-expr-contains form sym) 1) - (eq (nth (1- (length form)) form) sym) - (symbolp (car form)) (fboundp (car form)) - (not (eq (car-safe (symbol-function (car form))) 'macro)))) - -;;; The standard modify macros. -;;;###autoload -(defmacro setf (&rest args) - "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. -This is a generalized version of `setq'; the PLACEs may be symbolic -references such as (car x) or (aref x i), as well as plain symbols. -For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). -The return value is the last VAL in the list." - (if (cdr (cdr args)) - (let ((sets nil)) - (while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets)) - (cons 'progn (nreverse sets))) - (if (symbolp (car args)) - (and args (cons 'setq args)) - (let* ((method (cl-setf-do-modify (car args) (nth 1 args))) - (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) - (if (car method) (list 'let* (car method) store) store))))) - -;;;###autoload -(defmacro psetf (&rest args) - "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. -This is like `setf', except that all VAL forms are evaluated (in order) -before assigning any PLACEs to the corresponding values." - (let ((p args) (simple t) (vars nil)) - (while p - (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars)) - (setq simple nil)) - (if (memq (car p) vars) - (error "Destination duplicated in psetf: %s" (car p))) - (cl-push (cl-pop p) vars) - (or p (error "Odd number of arguments to psetf")) - (cl-pop p)) - (if simple - (list 'progn (cons 'setf args) nil) - (setq args (reverse args)) - (let ((expr (list 'setf (cadr args) (car args)))) - (while (setq args (cddr args)) - (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) - (list 'progn expr nil))))) - -;;;###autoload -(defun cl-do-pop (place) - (if (cl-simple-expr-p place) - (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) - (let* ((method (cl-setf-do-modify place t)) - (temp (gensym "--pop--"))) - (list 'let* - (append (car method) - (list (list temp (nth 2 method)))) - (list 'prog1 - (list 'car temp) - (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) - -;;;###autoload -(defmacro remf (place tag) - "(remf PLACE TAG): remove TAG from property list PLACE. -PLACE may be a symbol, or any generalized variable allowed by `setf'. -The form returns true if TAG was found and removed, nil otherwise." - (let* ((method (cl-setf-do-modify place t)) - (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--"))) - (val-temp (and (not (cl-simple-expr-p place)) - (gensym "--remf-place--"))) - (ttag (or tag-temp tag)) - (tval (or val-temp (nth 2 method)))) - (list 'let* - (append (car method) - (and val-temp (list (list val-temp (nth 2 method)))) - (and tag-temp (list (list tag-temp tag)))) - (list 'if (list 'eq ttag (list 'car tval)) - (list 'progn - (cl-setf-do-store (nth 1 method) (list 'cddr tval)) - t) - (list 'cl-do-remf tval ttag))))) - -;;;###autoload -(defmacro shiftf (place &rest args) - "(shiftf PLACE PLACE... VAL): shift left among PLACEs. -Example: (shiftf A B C) sets A to B, B to C, and returns the old A. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'." - (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) - (list* 'prog1 place - (let ((sets nil)) - (while args - (cl-push (list 'setq place (car args)) sets) - (setq place (cl-pop args))) - (nreverse sets))) - (let* ((places (reverse (cons place args))) - (form (cl-pop places))) - (while places - (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) - (setq form (list 'let* (car method) - (list 'prog1 (nth 2 method) - (cl-setf-do-store (nth 1 method) form)))))) - form))) - -;;;###autoload -(defmacro rotatef (&rest args) - "(rotatef PLACE...): rotate left among PLACEs. -Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. -Each PLACE may be a symbol, or any generalized variable allowed by `setf'." - (if (not (memq nil (mapcar 'symbolp args))) - (and (cdr args) - (let ((sets nil) - (first (car args))) - (while (cdr args) - (setq sets (nconc sets (list (cl-pop args) (car args))))) - (nconc (list 'psetf) sets (list (car args) first)))) - (let* ((places (reverse args)) - (temp (gensym "--rotatef--")) - (form temp)) - (while (cdr places) - (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) - (setq form (list 'let* (car method) - (list 'prog1 (nth 2 method) - (cl-setf-do-store (nth 1 method) form)))))) - (let ((method (cl-setf-do-modify (car places) 'unsafe))) - (list 'let* (append (car method) (list (list temp (nth 2 method)))) - (cl-setf-do-store (nth 1 method) form) nil))))) - -;;;###autoload -(defmacro letf (bindings &rest body) - "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. -This is the analogue of `let', but with generalized variables (in the -sense of `setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." - (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) - (list* 'let bindings body) - (let ((lets nil) - (rev (reverse bindings))) - (while rev - (let* ((place (if (symbolp (caar rev)) - (list 'symbol-value (list 'quote (caar rev))) - (caar rev))) - (value (cadar rev)) - (method (cl-setf-do-modify place 'no-opt)) - (save (gensym "--letf-save--")) - (bound (and (memq (car place) '(symbol-value symbol-function)) - (gensym "--letf-bound--"))) - (temp (and (not (cl-const-expr-p value)) (cdr bindings) - (gensym "--letf-val--")))) - (setq lets (nconc (car method) - (if bound - (list (list bound - (list (if (eq (car place) - 'symbol-value) - 'boundp 'fboundp) - (nth 1 (nth 2 method)))) - (list save (list 'and bound - (nth 2 method)))) - (list (list save (nth 2 method)))) - (and temp (list (list temp value))) - lets) - body (list - (list 'unwind-protect - (cons 'progn - (if (cdr (car rev)) - (cons (cl-setf-do-store (nth 1 method) - (or temp value)) - body) - body)) - (if bound - (list 'if bound - (cl-setf-do-store (nth 1 method) save) - (list (if (eq (car place) 'symbol-value) - 'makunbound 'fmakunbound) - (nth 1 (nth 2 method)))) - (cl-setf-do-store (nth 1 method) save)))) - rev (cdr rev)))) - (list* 'let* lets body)))) - -;;;###autoload -(defmacro letf* (bindings &rest body) - "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. -This is the analogue of `let*', but with generalized variables (in the -sense of `setf') for the PLACEs. Each PLACE is set to the corresponding -VALUE, then the BODY forms are executed. On exit, either normally or -because of a `throw' or error, the PLACEs are set back to their original -values. Note that this macro is *not* available in Common Lisp. -As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', -the PLACE is not modified before executing BODY." - (if (null bindings) - (cons 'progn body) - (setq bindings (reverse bindings)) - (while bindings - (setq body (list (list* 'letf (list (cl-pop bindings)) body)))) - (car body))) - -;;;###autoload -(defmacro callf (func place &rest args) - "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). -FUNC should be an unquoted function name. PLACE may be a symbol, -or any generalized variable allowed by `setf'." - (let* ((method (cl-setf-do-modify place (cons 'list args))) - (rargs (cons (nth 2 method) args))) - (list 'let* (car method) - (cl-setf-do-store (nth 1 method) - (if (symbolp func) (cons func rargs) - (list* 'funcall (list 'function func) - rargs)))))) - -;;;###autoload -(defmacro callf2 (func arg1 place &rest args) - "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). -Like `callf', but PLACE is the second argument of FUNC, not the first." - (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func)) - (list 'setf place (list* func arg1 place args)) - (let* ((method (cl-setf-do-modify place (cons 'list args))) - (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--"))) - (rargs (list* (or temp arg1) (nth 2 method) args))) - (list 'let* (append (and temp (list (list temp arg1))) (car method)) - (cl-setf-do-store (nth 1 method) - (if (symbolp func) (cons func rargs) - (list* 'funcall (list 'function func) - rargs))))))) - -;;;###autoload -(defmacro define-modify-macro (name arglist func &optional doc) - "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. -If NAME is called, it combines its PLACE argument with the other arguments -from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" - (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) - (let ((place (gensym "--place--"))) - (list 'defmacro* name (cons place arglist) doc - (list* (if (memq '&rest arglist) 'list* 'list) - '(quote callf) (list 'quote func) place - (cl-arglist-args arglist))))) - - -;;; Structures. - -;;;###autoload -(defmacro defstruct (struct &rest descs) - "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. -This macro defines a new Lisp data type called NAME, which contains data -stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' -copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." - (let* ((name (if (consp struct) (car struct) struct)) - (opts (cdr-safe struct)) - (slots nil) - (defaults nil) - (conc-name (concat (symbol-name name) "-")) - (constructor (intern (format "make-%s" name))) - (constrs nil) - (copier (intern (format "copy-%s" name))) - (predicate (intern (format "%s-p" name))) - (print-func nil) (print-auto nil) - (safety (if (cl-compiling-file) cl-optimize-safety 3)) - (include nil) - (tag (intern (format "cl-struct-%s" name))) - (tag-symbol (intern (format "cl-struct-%s-tags" name))) - (include-descs nil) - (side-eff nil) - (type nil) - (named nil) - (forms nil) - pred-form pred-check) - (if (stringp (car descs)) - (cl-push (list 'put (list 'quote name) '(quote structure-documentation) - (cl-pop descs)) forms)) - (setq descs (cons '(cl-tag-slot) - (mapcar #'(lambda (x) (if (consp x) x (list x))) - descs))) - (while opts - (let ((opt (if (consp (car opts)) (caar opts) (car opts))) - (args (cdr-safe (cl-pop opts)))) - (cond ((eq opt ':conc-name) - (if args - (setq conc-name (if (car args) - (symbol-name (car args)) "")))) - ((eq opt ':constructor) - (if (cdr args) - (cl-push args constrs) - (if args (setq constructor (car args))))) - ((eq opt ':copier) - (if args (setq copier (car args)))) - ((eq opt ':predicate) - (if args (setq predicate (car args)))) - ((eq opt ':include) - (setq include (car args) - include-descs (mapcar #'(lambda (x) - (if (consp x) x (list x))) - (cdr args)))) - ((eq opt ':print-function) - (setq print-func (car args))) - ((eq opt ':type) - (setq type (car args))) - ((eq opt ':named) - (setq named t)) - ((eq opt ':initial-offset) - (setq descs (nconc (make-list (car args) '(cl-skip-slot)) - descs))) - (t - (error "Slot option %s unrecognized" opt))))) - (if print-func - (setq print-func (list 'progn - (list 'funcall (list 'function print-func) - 'cl-x 'cl-s 'cl-n) t)) - (or type (and include (not (get include 'cl-struct-print))) - (setq print-auto t - print-func (and (or (not (or include type)) (null print-func)) - (list 'progn - (list 'princ (format "#S(%s" name) - 'cl-s)))))) - (if include - (let ((inc-type (get include 'cl-struct-type)) - (old-descs (get include 'cl-struct-slots))) - (or inc-type (error "%s is not a struct name" include)) - (and type (not (eq (car inc-type) type)) - (error ":type disagrees with :include for %s" name)) - (while include-descs - (setcar (memq (or (assq (caar include-descs) old-descs) - (error "No slot %s in included struct %s" - (caar include-descs) include)) - old-descs) - (cl-pop include-descs))) - (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) - type (car inc-type) - named (assq 'cl-tag-slot descs)) - (if (cadr inc-type) (setq tag name named t)) - (let ((incl include)) - (while incl - (cl-push (list 'pushnew (list 'quote tag) - (intern (format "cl-struct-%s-tags" incl))) - forms) - (setq incl (get incl 'cl-struct-include))))) - (if type - (progn - (or (memq type '(vector list)) - (error "Illegal :type specifier: %s" type)) - (if named (setq tag name))) - (setq type 'vector named 'true))) - (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) - (cl-push (list 'defvar tag-symbol) forms) - (setq pred-form (and named - (let ((pos (- (length descs) - (length (memq (assq 'cl-tag-slot descs) - descs))))) - (if (eq type 'vector) - (list 'and '(vectorp cl-x) - (list '>= '(length cl-x) (length descs)) - (list 'memq (list 'aref 'cl-x pos) - tag-symbol)) - (if (= pos 0) - (list 'memq '(car-safe cl-x) tag-symbol) - (list 'and '(consp cl-x) - (list 'memq (list 'nth pos 'cl-x) - tag-symbol)))))) - pred-check (and pred-form (> safety 0) - (if (and (eq (caadr pred-form) 'vectorp) - (= safety 1)) - (cons 'and (cdddr pred-form)) pred-form))) - (let ((pos 0) (descp descs)) - (while descp - (let* ((desc (cl-pop descp)) - (slot (car desc))) - (if (memq slot '(cl-tag-slot cl-skip-slot)) - (progn - (cl-push nil slots) - (cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag)) - defaults)) - (if (assq slot descp) - (error "Duplicate slots named %s in %s" slot name)) - (let ((accessor (intern (format "%s%s" conc-name slot)))) - (cl-push slot slots) - (cl-push (nth 1 desc) defaults) - (cl-push (list* - 'defsubst* accessor '(cl-x) - (append - (and pred-check - (list (list 'or pred-check - (list 'error - (format "%s accessing a non-%s" - accessor name) - 'cl-x)))) - (list (if (eq type 'vector) (list 'aref 'cl-x pos) - (if (= pos 0) '(car cl-x) - (list 'nth pos 'cl-x)))))) forms) - (cl-push (cons accessor t) side-eff) - (cl-push (list 'define-setf-method accessor '(cl-x) - (if (cadr (memq ':read-only (cddr desc))) - (list 'error (format "%s is a read-only slot" - accessor)) - (list 'cl-struct-setf-expander 'cl-x - (list 'quote name) (list 'quote accessor) - (and pred-check (list 'quote pred-check)) - pos))) - forms) - (if print-auto - (nconc print-func - (list (list 'princ (format " %s" slot) 'cl-s) - (list 'prin1 (list accessor 'cl-x) 'cl-s))))))) - (setq pos (1+ pos)))) - (setq slots (nreverse slots) - defaults (nreverse defaults)) - (and predicate pred-form - (progn (cl-push (list 'defsubst* predicate '(cl-x) - (if (eq (car pred-form) 'and) - (append pred-form '(t)) - (list 'and pred-form t))) forms) - (cl-push (cons predicate 'error-free) side-eff))) - (and copier - (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms) - (cl-push (cons copier t) side-eff))) - (if constructor - (cl-push (list constructor - (cons '&key (delq nil (copy-sequence slots)))) - constrs)) - (while constrs - (let* ((name (caar constrs)) - (args (cadr (cl-pop constrs))) - (anames (cl-arglist-args args)) - (make (mapcar* #'(lambda (s d) (if (memq s anames) s d)) - slots defaults))) - (cl-push (list 'defsubst* name - (list* '&cl-defs (list 'quote (cons nil descs)) args) - (cons type make)) forms) - (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs))) - (cl-push (cons name t) side-eff)))) - (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) - (if print-func - (cl-push (list 'push - (list 'function - (list 'lambda '(cl-x cl-s cl-n) - (list 'and pred-form print-func))) - 'custom-print-functions) forms)) - (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) - (cl-push (list* 'eval-when '(compile load eval) - (list 'put (list 'quote name) '(quote cl-struct-slots) - (list 'quote descs)) - (list 'put (list 'quote name) '(quote cl-struct-type) - (list 'quote (list type (eq named t)))) - (list 'put (list 'quote name) '(quote cl-struct-include) - (list 'quote include)) - (list 'put (list 'quote name) '(quote cl-struct-print) - print-auto) - (mapcar #'(lambda (x) - (list 'put (list 'quote (car x)) - '(quote side-effect-free) - (list 'quote (cdr x)))) - side-eff)) - forms) - (cons 'progn (nreverse (cons (list 'quote name) forms))))) - -;;;###autoload -(defun cl-struct-setf-expander (x name accessor pred-form pos) - (let* ((temp (gensym "--x--")) (store (gensym "--store--"))) - (list (list temp) (list x) (list store) - (append '(progn) - (and pred-form - (list (list 'or (subst temp 'cl-x pred-form) - (list 'error - (format - "%s storing a non-%s" accessor name) - temp)))) - (list (if (eq (car (get name 'cl-struct-type)) 'vector) - (list 'aset temp pos store) - (list 'setcar - (if (<= pos 5) - (let ((xx temp)) - (while (>= (setq pos (1- pos)) 0) - (setq xx (list 'cdr xx))) - xx) - (list 'nthcdr pos temp)) - store)))) - (list accessor temp)))) - - -;;; Types and assertions. - -;;;###autoload -(defmacro deftype (name args &rest body) - "(deftype NAME ARGLIST BODY...): define NAME as a new data type. -The type name can then be used in `typecase', `check-type', etc." - (list 'eval-when '(compile load eval) - (cl-transform-function-property - name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body)))) - -(defun cl-make-type-test (val type) - (if (symbolp type) - (cond ((get type 'cl-deftype-handler) - (cl-make-type-test val (funcall (get type 'cl-deftype-handler)))) - ((memq type '(nil t)) type) - ((eq type 'string-char) (list 'characterp val)) - ((eq type 'null) (list 'null val)) - ((eq type 'float) (list 'floatp-safe val)) - ((eq type 'real) (list 'numberp val)) - ((eq type 'fixnum) (list 'integerp val)) - (t - (let* ((name (symbol-name type)) - (namep (intern (concat name "p")))) - (if (fboundp namep) (list namep val) - (list (intern (concat name "-p")) val))))) - (cond ((get (car type) 'cl-deftype-handler) - (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler) - (cdr type)))) - ((memq (car-safe type) '(integer float real number)) - (delq t (list 'and (cl-make-type-test val (car type)) - (if (memq (cadr type) '(* nil)) t - (if (consp (cadr type)) (list '> val (caadr type)) - (list '>= val (cadr type)))) - (if (memq (caddr type) '(* nil)) t - (if (consp (caddr type)) (list '< val (caaddr type)) - (list '<= val (caddr type))))))) - ((memq (car-safe type) '(and or not)) - (cons (car type) - (mapcar #'(lambda (x) (cl-make-type-test val x)) - (cdr type)))) - ((memq (car-safe type) '(member member*)) - (list 'and (list 'member* val (list 'quote (cdr type))) t)) - ((eq (car-safe type) 'satisfies) (list (cadr type) val)) - (t (error "Bad type spec: %s" type))))) - -;;;###autoload -(defun typep (val type) ; See compiler macro below. - "Check that OBJECT is of type TYPE. -TYPE is a Common Lisp-style type specifier." - (eval (cl-make-type-test 'val type))) - -;;;###autoload -(defmacro check-type (form type &optional string) - "Verify that FORM is of type TYPE; signal an error if not. -STRING is an optional description of the desired type." - (and (or (not (cl-compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) - (let* ((temp (if (cl-simple-expr-p form 3) form (gensym))) - (body (list 'or (cl-make-type-test temp type) - (list 'signal '(quote wrong-type-argument) - (list 'list (or string (list 'quote type)) - temp (list 'quote form)))))) - (if (eq temp form) (list 'progn body nil) - (list 'let (list (list temp form)) body nil))))) - -;;;###autoload -(defmacro assert (form &optional show-args string &rest args) - "Verify that FORM returns non-nil; signal an error if not. -Second arg SHOW-ARGS means to include arguments of FORM in message. -Other args STRING and ARGS... are arguments to be passed to `error'. -They are not evaluated unless the assertion fails. If STRING is -omitted, a default message listing FORM itself is used." - (and (or (not (cl-compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) - (let ((sargs (and show-args (delq nil (mapcar - #'(lambda (x) - (and (not (cl-const-expr-p x)) - x)) - (cdr form)))))) - (list 'progn - (list 'or form - (if string - (list* 'error string (append sargs args)) - (list 'signal '(quote cl-assertion-failed) - (list* 'list (list 'quote form) sargs)))) - nil)))) - -;;;###autoload -(defmacro ignore-errors (&rest body) - "Execute FORMS; if an error occurs, return nil. -Otherwise, return result of last FORM." - `(condition-case nil (progn ,@body) (error nil))) - -;;;###autoload -(defmacro ignore-file-errors (&rest body) - "Execute FORMS; if an error of type `file-error' occurs, return nil. -Otherwise, return result of last FORM." - `(condition-case nil (progn ,@body) (file-error nil))) - -;;; Some predicates for analyzing Lisp forms. These are used by various -;;; macro expanders to optimize the results in certain common cases. - -(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max - car-safe cdr-safe progn prog1 prog2)) -(defconst cl-safe-funcs '(* / % length memq list vector vectorp - < > <= >= = error)) - -;;; Check if no side effects, and executes quickly. -(defun cl-simple-expr-p (x &optional size) - (or size (setq size 10)) - (if (and (consp x) (not (memq (car x) '(quote function function*)))) - (and (symbolp (car x)) - (or (memq (car x) cl-simple-funcs) - (get (car x) 'side-effect-free)) - (progn - (setq size (1- size)) - (while (and (setq x (cdr x)) - (setq size (cl-simple-expr-p (car x) size)))) - (and (null x) (>= size 0) size))) - (and (> size 0) (1- size)))) - -(defun cl-simple-exprs-p (xs) - (while (and xs (cl-simple-expr-p (car xs))) - (setq xs (cdr xs))) - (not xs)) - -;;; Check if no side effects. -(defun cl-safe-expr-p (x) - (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) - (and (symbolp (car x)) - (or (memq (car x) cl-simple-funcs) - (memq (car x) cl-safe-funcs) - (get (car x) 'side-effect-free)) - (progn - (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) - (null x))))) - -;;; Check if constant (i.e., no side effects or dependencies). -(defun cl-const-expr-p (x) - (cond ((consp x) - (or (eq (car x) 'quote) - (and (memq (car x) '(function function*)) - (or (symbolp (nth 1 x)) - (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) - ((symbolp x) (and (memq x '(nil t)) t)) - (t t))) - -(defun cl-const-exprs-p (xs) - (while (and xs (cl-const-expr-p (car xs))) - (setq xs (cdr xs))) - (not xs)) - -(defun cl-const-expr-val (x) - (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) - -(defun cl-expr-access-order (x v) - (if (cl-const-expr-p x) v - (if (consp x) - (progn - (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) - v) - (if (eq x (car v)) (cdr v) '(t))))) - -;;; Count number of times X refers to Y. Return NIL for 0 times. -(defun cl-expr-contains (x y) - (cond ((equal y x) 1) - ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) - (let ((sum 0)) - (while x - (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0)))) - (and (> sum 0) sum))) - (t nil))) - -(defun cl-expr-contains-any (x y) - (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y)) - y) - -;;; Check whether X may depend on any of the symbols in Y. -(defun cl-expr-depends-p (x y) - (and (not (cl-const-expr-p x)) - (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) - - -;;; Compiler macros. - -;;;###autoload -(defmacro define-compiler-macro (func args &rest body) - "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. -This is like `defmacro', but macro expansion occurs only if the call to -FUNC is compiled (i.e., not interpreted). Compiler macros should be used -for optimizing the way calls to FUNC are compiled; the form returned by -BODY should do the same thing as a call to the normal function called -FUNC, though possibly more efficiently. Note that, like regular macros, -compiler macros are expanded repeatedly until no further expansions are -possible. Unlike regular macros, BODY can decide to \"punt\" and leave the -original function call alone by declaring an initial `&whole foo' parameter -and then returning foo." - (let ((p (if (listp args) args (list '&rest args))) (res nil)) - (while (consp p) (cl-push (cl-pop p) res)) - (setq args (nreverse res)) (setcdr res (and p (list '&rest p)))) - (list 'eval-when '(compile load eval) - (cl-transform-function-property - func 'cl-compiler-macro - (cons (if (memq '&whole args) (delq '&whole args) - (cons '--cl-whole-arg-- args)) body)) - (list 'or (list 'get (list 'quote func) '(quote byte-compile)) - (list 'put (list 'quote func) '(quote byte-compile) - '(quote cl-byte-compile-compiler-macro))))) - -;;;###autoload -(defun compiler-macroexpand (form) - (while - (let ((func (car-safe form)) (handler nil)) - (while (and (symbolp func) - (not (setq handler (get func 'cl-compiler-macro))) - (fboundp func) - (or (not (eq (car-safe (symbol-function func)) 'autoload)) - (load (nth 1 (symbol-function func))))) - (setq func (symbol-function func))) - (and handler - (not (eq form (setq form (apply handler form (cdr form)))))))) - form) - -(defun cl-byte-compile-compiler-macro (form) - (if (eq form (setq form (compiler-macroexpand form))) - (byte-compile-normal-call form) - (byte-compile-form form))) - -(defmacro defsubst* (name args &rest body) - "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. -Like `defun', except the function is automatically declared `inline', -ARGLIST allows full Common Lisp conventions, and BODY is implicitly -surrounded by (block NAME ...)." - (let* ((argns (cl-arglist-args args)) (p argns) - (pbody (cons 'progn body)) - (unsafe (not (cl-safe-expr-p pbody)))) - (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p)) - (list 'progn - (if p nil ; give up if defaults refer to earlier args - (list 'define-compiler-macro name - (list* '&whole 'cl-whole '&cl-quote args) - (list* 'cl-defsubst-expand (list 'quote argns) - (list 'quote (list* 'block name body)) - (not (or unsafe (cl-expr-access-order pbody argns))) - (and (memq '&key args) 'cl-whole) unsafe argns))) - (list* 'defun* name args body)))) - -(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) - (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole - (if (cl-simple-exprs-p argvs) (setq simple t)) - (let ((lets (delq nil - (mapcar* #'(lambda (argn argv) - (if (or simple (cl-const-expr-p argv)) - (progn (setq body (subst argv argn body)) - (and unsafe (list argn argv))) - (list argn argv))) - argns argvs)))) - (if lets (list 'let lets body) body)))) - - -;;; Compile-time optimizations for some functions defined in this package. -;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, -;;; mainly to make sure these macros will be present. - -(put 'eql 'byte-compile nil) -(define-compiler-macro eql (&whole form a b) - (cond ((eq (cl-const-expr-p a) t) - (let ((val (cl-const-expr-val a))) - (if (and (numberp val) (not (integerp val))) - (list 'equal a b) - (list 'eq a b)))) - ((eq (cl-const-expr-p b) t) - (let ((val (cl-const-expr-val b))) - (if (and (numberp val) (not (integerp val))) - (list 'equal a b) - (list 'eq a b)))) - ((cl-simple-expr-p a 5) - (list 'if (list 'numberp a) - (list 'equal a b) - (list 'eq a b))) - ((and (cl-safe-expr-p a) - (cl-simple-expr-p b 5)) - (list 'if (list 'numberp b) - (list 'equal a b) - (list 'eq a b))) - (t form))) - -(define-compiler-macro member* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) ':test) - (cl-const-expr-val (nth 1 keys))))) - (cond ((eq test 'eq) (list 'memq a list)) - ((eq test 'equal) (list 'member a list)) - ((or (null keys) (eq test 'eql)) - (if (eq (cl-const-expr-p a) t) - (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq) - a list) - (if (eq (cl-const-expr-p list) t) - (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) - (if (not (cdr p)) - (and p (list 'eql a (list 'quote (car p)))) - (while p - (if (floatp-safe (car p)) (setq mb t) - (or (integerp (car p)) (symbolp (car p)) (setq mq t))) - (setq p (cdr p))) - (if (not mb) (list 'memq a list) - (if (not mq) (list 'member a list) form)))) - form))) - (t form)))) - -(define-compiler-macro assoc* (&whole form a list &rest keys) - (let ((test (and (= (length keys) 2) (eq (car keys) ':test) - (cl-const-expr-val (nth 1 keys))))) - (cond ((eq test 'eq) (list 'assq a list)) - ((eq test 'equal) (list 'assoc a list)) - ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) - (if (floatp-safe (cl-const-expr-val a)) - (list 'assoc a list) (list 'assq a list))) - (t form)))) - -(define-compiler-macro adjoin (&whole form a list &rest keys) - (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) - (not (memq ':key keys))) - (list 'if (list* 'member* a list keys) list (list 'cons a list)) - form)) - -(define-compiler-macro list* (arg &rest others) - (let* ((args (reverse (cons arg others))) - (form (car args))) - (while (setq args (cdr args)) - (setq form (list 'cons (car args) form))) - form)) - -(define-compiler-macro get* (sym prop &optional def) - (if def - (list 'getf (list 'symbol-plist sym) prop def) - (list 'get sym prop))) - -(define-compiler-macro typep (&whole form val type) - (if (cl-const-expr-p type) - (let ((res (cl-make-type-test val (cl-const-expr-val type)))) - (if (or (memq (cl-expr-contains res val) '(nil 1)) - (cl-simple-expr-p val)) res - (let ((temp (gensym))) - (list 'let (list (list temp val)) (subst temp val res))))) - form)) - - -(mapc - #'(lambda (y) - (put (car y) 'side-effect-free t) - (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) - (put (car y) 'cl-compiler-macro - (list 'lambda '(w x) - (if (symbolp (cadr y)) - (list 'list (list 'quote (cadr y)) - (list 'list (list 'quote (caddr y)) 'x)) - (cons 'list (cdr y)))))) - '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) - (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) - (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) - (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) - (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) - (caaar car caar) (caadr car cadr) (cadar car cdar) - (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) - (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) - (caaadr car caadr) (caadar car cadar) (caaddr car caddr) - (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) - (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) - (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) - (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr))) - -;;; Things that are inline. -(proclaim '(inline floatp-safe acons map concatenate notany notevery -;; XEmacs change - cl-set-elt revappend nreconc - plusp minusp oddp evenp - )) - -;;; Things that are side-effect-free. Moved to byte-optimize.el -;(dolist (fun '(oddp evenp plusp minusp -; abs expt signum last butlast ldiff -; pairlis gcd lcm -; isqrt floor* ceiling* truncate* round* mod* rem* subseq -; list-length get* getf)) -; (put fun 'side-effect-free t)) - -;;; Things that are side-effect-and-error-free. Moved to byte-optimize.el -;(dolist (fun '(eql floatp-safe list* subst acons equalp random-state-p -; copy-tree sublis)) -; (put fun 'side-effect-free 'error-free)) - - -(run-hooks 'cl-macs-load-hook) - -;;; cl-macs.el ends here diff --git a/lisp/cl-seq.el b/lisp/cl-seq.el deleted file mode 100644 index 9f1b256..0000000 --- a/lisp/cl-seq.el +++ /dev/null @@ -1,938 +0,0 @@ -;;; cl-seq.el --- Common Lisp extensions for GNU Emacs Lisp (part three) - -;; Copyright (C) 1993 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Maintainer: XEmacs Development Team -;; Version: 2.02 -;; Keywords: extensions, dumped - -;; 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 file is dumped with XEmacs. - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains the Common Lisp sequence and list functions -;; which take keyword arguments. - -;; See cl.el for Change Log. - - -;;; Code: - -(or (memq 'cl-19 features) - (error "Tried to load `cl-seq' before `cl'!")) - - -;;; We define these here so that this file can compile without having -;;; loaded the cl.el file already. - -(defmacro cl-push (x place) (list 'setq place (list 'cons x place))) -(defmacro cl-pop (place) - (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) - - -;;; Keyword parsing. This is special-cased here so that we can compile -;;; this file independent from cl-macs. - -(defmacro cl-parsing-keywords (kwords other-keys &rest body) - (cons - 'let* - (cons (mapcar - (function - (lambda (x) - (let* ((var (if (consp x) (car x) x)) - (mem (list 'car (list 'cdr (list 'memq (list 'quote var) - 'cl-keys))))) - (if (eq var ':test-not) - (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) - (if (eq var ':if-not) - (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) - (list (intern - (format "cl-%s" (substring (symbol-name var) 1))) - (if (consp x) (list 'or mem (car (cdr x))) mem))))) - kwords) - (append - (and (not (eq other-keys t)) - (list - (list 'let '((cl-keys-temp cl-keys)) - (list 'while 'cl-keys-temp - (list 'or (list 'memq '(car cl-keys-temp) - (list 'quote - (mapcar - (function - (lambda (x) - (if (consp x) - (car x) x))) - (append kwords - other-keys)))) - '(car (cdr (memq (quote :allow-other-keys) - cl-keys))) - '(error "Bad keyword argument %s" - (car cl-keys-temp))) - '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) - body)))) -(put 'cl-parsing-keywords 'lisp-indent-function 2) -(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) - -(defmacro cl-check-key (x) - (list 'if 'cl-key (list 'funcall 'cl-key x) x)) - -(defmacro cl-check-test-nokey (item x) - (list 'cond - (list 'cl-test - (list 'eq (list 'not (list 'funcall 'cl-test item x)) - 'cl-test-not)) - (list 'cl-if - (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not)) - (list 't (list 'if (list 'numberp item) - (list 'equal item x) (list 'eq item x))))) - -(defmacro cl-check-test (item x) - (list 'cl-check-test-nokey item (list 'cl-check-key x))) - -(defmacro cl-check-match (x y) - (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) - (list 'if 'cl-test - (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) - (list 'if (list 'numberp x) - (list 'equal x y) (list 'eq x y)))) - -(put 'cl-check-key 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) -(put 'cl-check-match 'edebug-form-spec 'edebug-forms) - -(defvar cl-test) (defvar cl-test-not) -(defvar cl-if) (defvar cl-if-not) -(defvar cl-key) - - -(defun reduce (cl-func cl-seq &rest cl-keys) - "Reduce two-argument FUNCTION across SEQUENCE. -Keywords supported: :start :end :from-end :initial-value :key" - (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () - (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) - (setq cl-seq (subseq cl-seq cl-start cl-end)) - (if cl-from-end (setq cl-seq (nreverse cl-seq))) - (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value) - (cl-seq (cl-check-key (cl-pop cl-seq))) - (t (funcall cl-func))))) - (if cl-from-end - (while cl-seq - (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq)) - cl-accum))) - (while cl-seq - (setq cl-accum (funcall cl-func cl-accum - (cl-check-key (cl-pop cl-seq)))))) - cl-accum))) - -(defun fill (seq item &rest cl-keys) - "Fill the elements of SEQ with ITEM. -Keywords supported: :start :end" - (cl-parsing-keywords ((:start 0) :end) () - (if (listp seq) - (let ((p (nthcdr cl-start seq)) - (n (if cl-end (- cl-end cl-start) 8000000))) - (while (and p (>= (setq n (1- n)) 0)) - (setcar p item) - (setq p (cdr p)))) - (or cl-end (setq cl-end (length seq))) - (if (and (= cl-start 0) (= cl-end (length seq))) - (fillarray seq item) - (while (< cl-start cl-end) - (aset seq cl-start item) - (setq cl-start (1+ cl-start))))) - seq)) - -(defun replace (cl-seq1 cl-seq2 &rest cl-keys) - "Replace the elements of SEQ1 with the elements of SEQ2. -SEQ1 is destructively modified, then returned. -Keywords supported: :start1 :end1 :start2 :end2" - (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () - (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) - (or (= cl-start1 cl-start2) - (let* ((cl-len (length cl-seq1)) - (cl-n (min (- (or cl-end1 cl-len) cl-start1) - (- (or cl-end2 cl-len) cl-start2)))) - (while (>= (setq cl-n (1- cl-n)) 0) - (cl-set-elt cl-seq1 (+ cl-start1 cl-n) - (elt cl-seq2 (+ cl-start2 cl-n)))))) - (if (listp cl-seq1) - (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) - (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) - (if (listp cl-seq2) - (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) - (cl-n (min cl-n1 - (if cl-end2 (- cl-end2 cl-start2) 4000000)))) - (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) - (setcar cl-p1 (car cl-p2)) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) - (setq cl-end2 (min (or cl-end2 (length cl-seq2)) - (+ cl-start2 cl-n1))) - (while (and cl-p1 (< cl-start2 cl-end2)) - (setcar cl-p1 (aref cl-seq2 cl-start2)) - (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) - (setq cl-end1 (min (or cl-end1 (length cl-seq1)) - (+ cl-start1 (- (or cl-end2 (length cl-seq2)) - cl-start2)))) - (if (listp cl-seq2) - (let ((cl-p2 (nthcdr cl-start2 cl-seq2))) - (while (< cl-start1 cl-end1) - (aset cl-seq1 cl-start1 (car cl-p2)) - (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1)))) - (while (< cl-start1 cl-end1) - (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2)) - (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) - cl-seq1)) - -(defun remove* (cl-item cl-seq &rest cl-keys) - "Remove all occurrences of ITEM in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end - (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) - cl-seq - (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) - (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end - cl-from-end))) - (if cl-i - (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) - (append (if cl-from-end - (list ':end (1+ cl-i)) - (list ':start cl-i)) - cl-keys)))) - (if (listp cl-seq) cl-res - (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) - cl-seq)) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (if (= cl-start 0) - (while (and cl-seq (> cl-end 0) - (cl-check-test cl-item (car cl-seq)) - (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) - (> (setq cl-count (1- cl-count)) 0)))) - (if (and (> cl-count 0) (> cl-end 0)) - (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq) - (setq cl-end (1- cl-end)) (cdr cl-seq)))) - (while (and cl-p (> cl-end 0) - (not (cl-check-test cl-item (car cl-p)))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end))) - (if (and cl-p (> cl-end 0)) - (nconc (ldiff cl-seq cl-p) - (if (= cl-count 1) (cdr cl-p) - (and (cdr cl-p) - (apply 'delete* cl-item - (copy-sequence (cdr cl-p)) - ':start 0 ':end (1- cl-end) - ':count (1- cl-count) cl-keys)))) - cl-seq)) - cl-seq))))) - -(defun remove-if (cl-pred cl-list &rest cl-keys) - "Remove all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'remove* nil cl-list ':if cl-pred cl-keys)) - -(defun remove-if-not (cl-pred cl-list &rest cl-keys) - "Remove all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'remove* nil cl-list ':if-not cl-pred cl-keys)) - -(defun delete* (cl-item cl-seq &rest cl-keys) - "Remove all occurrences of ITEM in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end - (:start 0) :end) () - (if (<= (or cl-count (setq cl-count 8000000)) 0) - cl-seq - (if (listp cl-seq) - (if (and cl-from-end (< cl-count 4000000)) - (let (cl-i) - (while (and (>= (setq cl-count (1- cl-count)) 0) - (setq cl-i (cl-position cl-item cl-seq cl-start - cl-end cl-from-end))) - (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) - (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) - (setcdr cl-tail (cdr (cdr cl-tail))))) - (setq cl-end cl-i)) - cl-seq) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (if (= cl-start 0) - (progn - (while (and cl-seq - (> cl-end 0) - (cl-check-test cl-item (car cl-seq)) - (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) - (> (setq cl-count (1- cl-count)) 0))) - (setq cl-end (1- cl-end))) - (setq cl-start (1- cl-start))) - (if (and (> cl-count 0) (> cl-end 0)) - (let ((cl-p (nthcdr cl-start cl-seq))) - (while (and (cdr cl-p) (> cl-end 0)) - (if (cl-check-test cl-item (car (cdr cl-p))) - (progn - (setcdr cl-p (cdr (cdr cl-p))) - (if (= (setq cl-count (1- cl-count)) 0) - (setq cl-end 1))) - (setq cl-p (cdr cl-p))) - (setq cl-end (1- cl-end))))) - cl-seq) - (apply 'remove* cl-item cl-seq cl-keys))))) - -(defun delete-if (cl-pred cl-list &rest cl-keys) - "Remove all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'delete* nil cl-list ':if cl-pred cl-keys)) - -(defun delete-if-not (cl-pred cl-list &rest cl-keys) - "Remove all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'delete* nil cl-list ':if-not cl-pred cl-keys)) - -(or (and (fboundp 'delete) (subrp (symbol-function 'delete))) - (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) - -(defun remove (cl-item cl-seq) - "Remove all occurrences of ITEM in SEQ, testing with `equal' -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Also see: `remove*', `delete', `delete*'" - (remove* cl-item cl-seq ':test 'equal)) - -(defun remq (cl-elt cl-list) - "Remove all occurances of ELT in LIST, comparing with `eq'. -This is a non-destructive function; it makes a copy of LIST to avoid -corrupting the original LIST. -Also see: `delq', `delete', `delete*', `remove', `remove*'." - (if (memq cl-elt cl-list) - (delq cl-elt (copy-list cl-list)) - cl-list)) - -(defun remove-duplicates (cl-seq &rest cl-keys) - "Return a copy of SEQ with all duplicate elements removed. -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-delete-duplicates cl-seq cl-keys t)) - -(defun delete-duplicates (cl-seq &rest cl-keys) - "Remove all duplicate elements from SEQ (destructively). -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-delete-duplicates cl-seq cl-keys nil)) - -(defun cl-delete-duplicates (cl-seq cl-keys cl-copy) - (if (listp cl-seq) - (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) - () - (if cl-from-end - (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) - (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) - (while (> cl-end 1) - (setq cl-i 0) - (while (setq cl-i (cl-position (cl-check-key (car cl-p)) - (cdr cl-p) cl-i (1- cl-end))) - (if cl-copy (setq cl-seq (copy-sequence cl-seq) - cl-p (nthcdr cl-start cl-seq) cl-copy nil)) - (let ((cl-tail (nthcdr cl-i cl-p))) - (setcdr cl-tail (cdr (cdr cl-tail)))) - (setq cl-end (1- cl-end))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end) - cl-start (1+ cl-start))) - cl-seq) - (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) - (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1) - (cl-position (cl-check-key (car cl-seq)) - (cdr cl-seq) 0 (1- cl-end))) - (setq cl-seq (cdr cl-seq) cl-end (1- cl-end))) - (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq) - (setq cl-end (1- cl-end) cl-start 1) cl-seq))) - (while (and (cdr (cdr cl-p)) (> cl-end 1)) - (if (cl-position (cl-check-key (car (cdr cl-p))) - (cdr (cdr cl-p)) 0 (1- cl-end)) - (progn - (if cl-copy (setq cl-seq (copy-sequence cl-seq) - cl-p (nthcdr (1- cl-start) cl-seq) - cl-copy nil)) - (setcdr cl-p (cdr (cdr cl-p)))) - (setq cl-p (cdr cl-p))) - (setq cl-end (1- cl-end) cl-start (1+ cl-start))) - cl-seq))) - (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) - (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) - -(defun substitute (cl-new cl-old cl-seq &rest cl-keys) - "Substitute NEW for OLD in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count - (:start 0) :end :from-end) () - (if (or (eq cl-old cl-new) - (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) - cl-seq - (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end))) - (if (not cl-i) - cl-seq - (setq cl-seq (copy-sequence cl-seq)) - (or cl-from-end - (progn (cl-set-elt cl-seq cl-i cl-new) - (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) - (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count - ':start cl-i cl-keys)))))) - -(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys)) - -(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a non-destructive function; it makes a copy of SEQ if necessary -to avoid corrupting the original SEQ. -Keywords supported: :key :count :start :end :from-end" - (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys)) - -(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) - "Substitute NEW for OLD in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :test :test-not :key :count :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not :count - (:start 0) :end :from-end) () - (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) - (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) - (let ((cl-p (nthcdr cl-start cl-seq))) - (setq cl-end (- (or cl-end 8000000) cl-start)) - (while (and cl-p (> cl-end 0) (> cl-count 0)) - (if (cl-check-test cl-old (car cl-p)) - (progn - (setcar cl-p cl-new) - (setq cl-count (1- cl-count)))) - (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) - (or cl-end (setq cl-end (length cl-seq))) - (if cl-from-end - (while (and (< cl-start cl-end) (> cl-count 0)) - (setq cl-end (1- cl-end)) - (if (cl-check-test cl-old (elt cl-seq cl-end)) - (progn - (cl-set-elt cl-seq cl-end cl-new) - (setq cl-count (1- cl-count))))) - (while (and (< cl-start cl-end) (> cl-count 0)) - (if (cl-check-test cl-old (aref cl-seq cl-start)) - (progn - (aset cl-seq cl-start cl-new) - (setq cl-count (1- cl-count)))) - (setq cl-start (1+ cl-start)))))) - cl-seq)) - -(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys)) - -(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) - "Substitute NEW for all items not satisfying PREDICATE in SEQ. -This is a destructive function; it reuses the storage of SEQ whenever possible. -Keywords supported: :key :count :start :end :from-end" - (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys)) - -(defun find (cl-item cl-seq &rest cl-keys) - "Find the first occurrence of ITEM in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" - (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) - (and cl-pos (elt cl-seq cl-pos)))) - -(defun find-if (cl-pred cl-list &rest cl-keys) - "Find the first item satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'find nil cl-list ':if cl-pred cl-keys)) - -(defun find-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item not satisfying PREDICATE in LIST. -Return the matching ITEM, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'find nil cl-list ':if-not cl-pred cl-keys)) - -(defun position (cl-item cl-seq &rest cl-keys) - "Find the first occurrence of ITEM in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :test :test-not :key :start :end :from-end" - (cl-parsing-keywords (:test :test-not :key :if :if-not - (:start 0) :end :from-end) () - (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) - -(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) - (if (listp cl-seq) - (let ((cl-p (nthcdr cl-start cl-seq))) - (or cl-end (setq cl-end 8000000)) - (let ((cl-res nil)) - (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) - (if (cl-check-test cl-item (car cl-p)) - (setq cl-res cl-start)) - (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) - cl-res)) - (or cl-end (setq cl-end (length cl-seq))) - (if cl-from-end - (progn - (while (and (>= (setq cl-end (1- cl-end)) cl-start) - (not (cl-check-test cl-item (aref cl-seq cl-end))))) - (and (>= cl-end cl-start) cl-end)) - (while (and (< cl-start cl-end) - (not (cl-check-test cl-item (aref cl-seq cl-start)))) - (setq cl-start (1+ cl-start))) - (and (< cl-start cl-end) cl-start)))) - -(defun position-if (cl-pred cl-list &rest cl-keys) - "Find the first item satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'position nil cl-list ':if cl-pred cl-keys)) - -(defun position-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item not satisfying PREDICATE in LIST. -Return the index of the matching item, or nil if not found. -Keywords supported: :key :start :end :from-end" - (apply 'position nil cl-list ':if-not cl-pred cl-keys)) - -(defun count (cl-item cl-seq &rest cl-keys) - "Count the number of occurrences of ITEM in LIST. -Keywords supported: :test :test-not :key :start :end" - (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () - (let ((cl-count 0) cl-x) - (or cl-end (setq cl-end (length cl-seq))) - (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) - (while (< cl-start cl-end) - (setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start))) - (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) - (setq cl-start (1+ cl-start))) - cl-count))) - -(defun count-if (cl-pred cl-list &rest cl-keys) - "Count the number of items satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" - (apply 'count nil cl-list ':if cl-pred cl-keys)) - -(defun count-if-not (cl-pred cl-list &rest cl-keys) - "Count the number of items not satisfying PREDICATE in LIST. -Keywords supported: :key :start :end" - (apply 'count nil cl-list ':if-not cl-pred cl-keys)) - -(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) - "Compare SEQ1 with SEQ2, return index of first mismatching element. -Return nil if the sequences match. If one sequence is a prefix of the -other, the return value indicates the end of the shorted sequence. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" - (cl-parsing-keywords (:test :test-not :key :from-end - (:start1 0) :end1 (:start2 0) :end2) () - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (if cl-from-end - (progn - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (cl-check-match (elt cl-seq1 (1- cl-end1)) - (elt cl-seq2 (1- cl-end2)))) - (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - (1- cl-end1))) - (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) - (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) - (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) - (cl-check-match (if cl-p1 (car cl-p1) - (aref cl-seq1 cl-start1)) - (if cl-p2 (car cl-p2) - (aref cl-seq2 cl-start2)))) - (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) - cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) - (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) - cl-start1))))) - -(defun search (cl-seq1 cl-seq2 &rest cl-keys) - "Search for SEQ1 as a subsequence of SEQ2. -Return the index of the leftmost element of the first match found; -return nil if there are no matches. -Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" - (cl-parsing-keywords (:test :test-not :key :from-end - (:start1 0) :end1 (:start2 0) :end2) () - (or cl-end1 (setq cl-end1 (length cl-seq1))) - (or cl-end2 (setq cl-end2 (length cl-seq2))) - (if (>= cl-start1 cl-end1) - (if cl-from-end cl-end2 cl-start2) - (let* ((cl-len (- cl-end1 cl-start1)) - (cl-first (cl-check-key (elt cl-seq1 cl-start1))) - (cl-if nil) cl-pos) - (setq cl-end2 (- cl-end2 (1- cl-len))) - (while (and (< cl-start2 cl-end2) - (setq cl-pos (cl-position cl-first cl-seq2 - cl-start2 cl-end2 cl-from-end)) - (apply 'mismatch cl-seq1 cl-seq2 - ':start1 (1+ cl-start1) ':end1 cl-end1 - ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len) - ':from-end nil cl-keys)) - (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) - (and (< cl-start2 cl-end2) cl-pos))))) - -(defun sort* (cl-seq cl-pred &rest cl-keys) - "Sort the argument SEQUENCE according to PREDICATE. -This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" - (if (nlistp cl-seq) - (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) - (cl-parsing-keywords (:key) () - (if (memq cl-key '(nil identity)) - (sort cl-seq cl-pred) - (sort cl-seq (function (lambda (cl-x cl-y) - (funcall cl-pred (funcall cl-key cl-x) - (funcall cl-key cl-y))))))))) - -(defun stable-sort (cl-seq cl-pred &rest cl-keys) - "Sort the argument SEQUENCE stably according to PREDICATE. -This is a destructive function; it reuses the storage of SEQUENCE if possible. -Keywords supported: :key" - (apply 'sort* cl-seq cl-pred cl-keys)) - -(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) - "Destructively merge the two sequences to produce a new sequence. -TYPE is the sequence type to return, SEQ1 and SEQ2 are the two -argument sequences, and PRED is a `less-than' predicate on the elements. -Keywords supported: :key" - (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) - (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) - (cl-parsing-keywords (:key) () - (let ((cl-res nil)) - (while (and cl-seq1 cl-seq2) - (if (funcall cl-pred (cl-check-key (car cl-seq2)) - (cl-check-key (car cl-seq1))) - (cl-push (cl-pop cl-seq2) cl-res) - (cl-push (cl-pop cl-seq1) cl-res))) - (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) - -;;; See compiler macro in cl-macs.el -(defun member* (cl-item cl-list &rest cl-keys) - "Find the first occurrence of ITEM in LIST. -Return the sublist of LIST whose car is ITEM. -Keywords supported: :test :test-not :key" - (if cl-keys - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) - (setq cl-list (cdr cl-list))) - cl-list) - (if (and (numberp cl-item) (not (integerp cl-item))) - (member cl-item cl-list) - (memq cl-item cl-list)))) - -(defun member-if (cl-pred cl-list &rest cl-keys) - "Find the first item satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. -Keywords supported: :key" - (apply 'member* nil cl-list ':if cl-pred cl-keys)) - -(defun member-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item not satisfying PREDICATE in LIST. -Return the sublist of LIST whose car matches. -Keywords supported: :key" - (apply 'member* nil cl-list ':if-not cl-pred cl-keys)) - -(defun cl-adjoin (cl-item cl-list &rest cl-keys) - (if (cl-parsing-keywords (:key) t - (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) - cl-list - (cons cl-item cl-list))) - -;;; See compiler macro in cl-macs.el -(defun assoc* (cl-item cl-alist &rest cl-keys) - "Find the first item whose car matches ITEM in LIST. -Keywords supported: :test :test-not :key" - (if cl-keys - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-alist - (or (not (consp (car cl-alist))) - (not (cl-check-test cl-item (car (car cl-alist)))))) - (setq cl-alist (cdr cl-alist))) - (and cl-alist (car cl-alist))) - (if (and (numberp cl-item) (not (integerp cl-item))) - (assoc cl-item cl-alist) - (assq cl-item cl-alist)))) - -(defun assoc-if (cl-pred cl-list &rest cl-keys) - "Find the first item whose car satisfies PREDICATE in LIST. -Keywords supported: :key" - (apply 'assoc* nil cl-list ':if cl-pred cl-keys)) - -(defun assoc-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item whose car does not satisfy PREDICATE in LIST. -Keywords supported: :key" - (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys)) - -(defun rassoc* (cl-item cl-alist &rest cl-keys) - "Find the first item whose cdr matches ITEM in LIST. -Keywords supported: :test :test-not :key" - (if (or cl-keys (numberp cl-item)) - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (while (and cl-alist - (or (not (consp (car cl-alist))) - (not (cl-check-test cl-item (cdr (car cl-alist)))))) - (setq cl-alist (cdr cl-alist))) - (and cl-alist (car cl-alist))) - (rassq cl-item cl-alist))) - -(defun rassoc-if (cl-pred cl-list &rest cl-keys) - "Find the first item whose cdr satisfies PREDICATE in LIST. -Keywords supported: :key" - (apply 'rassoc* nil cl-list ':if cl-pred cl-keys)) - -(defun rassoc-if-not (cl-pred cl-list &rest cl-keys) - "Find the first item whose cdr does not satisfy PREDICATE in LIST. -Keywords supported: :key" - (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys)) - -(defun union (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) cl-list1) - (t - (or (>= (length cl-list1) (length cl-list2)) - (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) - (while cl-list2 - (if (or cl-keys (numberp (car cl-list2))) - (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) - (or (memq (car cl-list2) cl-list1) - (cl-push (car cl-list2) cl-list1))) - (cl-pop cl-list2)) - cl-list1))) - -(defun nunion (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - (t (apply 'union cl-list1 cl-list2 cl-keys)))) - -(defun intersection (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (and cl-list1 cl-list2 - (if (equal cl-list1 cl-list2) cl-list1 - (cl-parsing-keywords (:key) (:test :test-not) - (let ((cl-res nil)) - (or (>= (length cl-list1) (length cl-list2)) - (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) - (while cl-list2 - (if (if (or cl-keys (numberp (car cl-list2))) - (apply 'member* (cl-check-key (car cl-list2)) - cl-list1 cl-keys) - (memq (car cl-list2) cl-list1)) - (cl-push (car cl-list2) cl-res)) - (cl-pop cl-list2)) - cl-res))))) - -(defun nintersection (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) - -(defun set-difference (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (if (or (null cl-list1) (null cl-list2)) cl-list1 - (cl-parsing-keywords (:key) (:test :test-not) - (let ((cl-res nil)) - (while cl-list1 - (or (if (or cl-keys (numberp (car cl-list1))) - (apply 'member* (cl-check-key (car cl-list1)) - cl-list2 cl-keys) - (memq (car cl-list1) cl-list2)) - (cl-push (car cl-list1) cl-res)) - (cl-pop cl-list1)) - cl-res)))) - -(defun nset-difference (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (if (or (null cl-list1) (null cl-list2)) cl-list1 - (apply 'set-difference cl-list1 cl-list2 cl-keys))) - -(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. -This is a non-destructive function; it makes a copy of the data if necessary -to avoid corrupting the original LIST1 and LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) nil) - (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) - (apply 'set-difference cl-list2 cl-list1 cl-keys))))) - -(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) - "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. -This is a destructive function; it reuses the storage of LIST1 and LIST2 -whenever possible. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) - ((equal cl-list1 cl-list2) nil) - (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) - (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) - -(defun subsetp (cl-list1 cl-list2 &rest cl-keys) - "True if LIST1 is a subset of LIST2. -I.e., if every element of LIST1 also appears in LIST2. -Keywords supported: :test :test-not :key" - (cond ((null cl-list1) t) ((null cl-list2) nil) - ((equal cl-list1 cl-list2) t) - (t (cl-parsing-keywords (:key) (:test :test-not) - (while (and cl-list1 - (apply 'member* (cl-check-key (car cl-list1)) - cl-list2 cl-keys)) - (cl-pop cl-list1)) - (null cl-list1))))) - -(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced by NEW. -Keywords supported: :key" - (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) - -(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). -Return a copy of TREE with all non-matching elements replaced by NEW. -Keywords supported: :key" - (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) - -(defun nsubst (cl-new cl-old cl-tree &rest cl-keys) - "Substitute NEW for OLD everywhere in TREE (destructively). -Any element of TREE which is `eql' to OLD is changed to NEW (via a call -to `setcar'). -Keywords supported: :test :test-not :key" - (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) - -(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elements matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" - (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) - -(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) - "Substitute NEW for elements not matching PREDICATE in TREE (destructively). -Any element of TREE which matches is changed to NEW (via a call to `setcar'). -Keywords supported: :key" - (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) - -(defun sublis (cl-alist cl-tree &rest cl-keys) - "Perform substitutions indicated by ALIST in TREE (non-destructively). -Return a copy of TREE with all matching elements replaced. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (cl-sublis-rec cl-tree))) - -(defvar cl-alist) -(defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* - (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist)) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p (cdr (car cl-p)) - (if (consp cl-tree) - (let ((cl-a (cl-sublis-rec (car cl-tree))) - (cl-d (cl-sublis-rec (cdr cl-tree)))) - (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree))) - cl-tree - (cons cl-a cl-d))) - cl-tree)))) - -(defun nsublis (cl-alist cl-tree &rest cl-keys) - "Perform substitutions indicated by ALIST in TREE (destructively). -Any matching element of TREE is changed via a call to `setcar'. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key :if :if-not) () - (let ((cl-hold (list cl-tree))) - (cl-nsublis-rec cl-hold) - (car cl-hold)))) - -(defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if* - (while (consp cl-tree) - (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist)) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p (setcar cl-tree (cdr (car cl-p))) - (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree)))) - (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist) - (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) - (setq cl-p (cdr cl-p))) - (if cl-p - (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) - (setq cl-tree (cdr cl-tree)))))) - -(defun tree-equal (cl-x cl-y &rest cl-keys) - "Return t if trees X and Y have `eql' leaves. -Atoms are compared by `eql'; cons cells are compared recursively. -Keywords supported: :test :test-not :key" - (cl-parsing-keywords (:test :test-not :key) () - (cl-tree-equal-rec cl-x cl-y))) - -(defun cl-tree-equal-rec (cl-x cl-y) - (while (and (consp cl-x) (consp cl-y) - (cl-tree-equal-rec (car cl-x) (car cl-y))) - (setq cl-x (cdr cl-x) cl-y (cdr cl-y))) - (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y))) - - -(run-hooks 'cl-seq-load-hook) - -;;; cl-seq.el ends here diff --git a/lisp/cl.el b/lisp/cl.el deleted file mode 100644 index 41a5955..0000000 --- a/lisp/cl.el +++ /dev/null @@ -1,760 +0,0 @@ -;;; cl.el --- Common Lisp extensions for GNU Emacs Lisp - -;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Maintainer: XEmacs Development Team -;; Version: 2.02 -;; Keywords: extensions, dumped, 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: - -;; This file is dumped with XEmacs. - -;; These are extensions to Emacs Lisp that provide a degree of -;; Common Lisp compatibility, beyond what is already built-in -;; in Emacs Lisp. -;; -;; This package was written by Dave Gillespie; it is a complete -;; rewrite of Cesar Quiroz's original cl.el package of December 1986. -;; -;; This package works with Emacs 18, Emacs 19, and XEmacs/Lucid Emacs 19. -;; -;; Bug reports, comments, and suggestions are welcome! - -;; This file contains the portions of the Common Lisp extensions -;; package which should always be present. - - -;;; Future notes: - -;; Once Emacs 19 becomes standard, many things in this package which are -;; messy for reasons of compatibility can be greatly simplified. For now, -;; I prefer to maintain one unified version. - - -;;; Change Log: - -;; Version 2.02 (30 Jul 93): -;; * Added "cl-compat.el" file, extra compatibility with old package. -;; * Added `lexical-let' and `lexical-let*'. -;; * Added `define-modify-macro', `callf', and `callf2'. -;; * Added `ignore-errors'. -;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero. -;; * Merged `*gentemp-counter*' into `*gensym-counter*'. -;; * Extended `subseq' to allow negative START and END like `substring'. -;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses. -;; * Added `concat', `vconcat' loop clauses. -;; * Cleaned up a number of compiler warnings. - -;; Version 2.01 (7 Jul 93): -;; * Added support for FSF version of Emacs 19. -;; * Added `add-hook' for Emacs 18 users. -;; * Added `defsubst*' and `symbol-macrolet'. -;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'. -;; * Added `map', `concatenate', `reduce', `merge'. -;; * Added `revappend', `nreconc', `tailp', `tree-equal'. -;; * Added `assert', `check-type', `typecase', `typep', and `deftype'. -;; * Added destructuring and `&environment' support to `defmacro*'. -;; * Added destructuring to `loop', and added the following clauses: -;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'. -;; * Renamed `delete' to `delete*' and `remove' to `remove*'. -;; * Completed support for all keywords in `remove*', `substitute', etc. -;; * Added `most-positive-float' and company. -;; * Fixed hash tables to work with latest Lucid Emacs. -;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'. -;; * Syntax for `warn' declarations has changed. -;; * Improved implementation of `random*'. -;; * Moved most sequence functions to a new file, cl-seq.el. -;; * Moved `eval-when' into cl-macs.el. -;; * Moved `pushnew' and `adjoin' to cl.el for most common cases. -;; * Moved `provide' forms down to ends of files. -;; * Changed expansion of `pop' to something that compiles to better code. -;; * Changed so that no patch is required for Emacs 19 byte compiler. -;; * Made more things dependent on `optimize' declarations. -;; * Added a partial implementation of struct print functions. -;; * Miscellaneous minor changes. - -;; Version 2.00: -;; * First public release of this package. - - -;;; Code: - -(defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version) - (symbol-value 'epoch::version)) - (string-lessp emacs-version "19")) 18) - ((string-match "XEmacs" emacs-version) - 'lucid) - (t 19))) - -(or (fboundp 'defalias) (fset 'defalias 'fset)) - -(defvar cl-optimize-speed 1) -(defvar cl-optimize-safety 1) - - -;;; Keywords used in this package. - -;;; XEmacs - keywords are done in Fintern(). -;;; -;;; (defconst :test ':test) -;;; (defconst :test-not ':test-not) -;;; (defconst :key ':key) -;;; (defconst :start ':start) -;;; (defconst :start1 ':start1) -;;; (defconst :start2 ':start2) -;;; (defconst :end ':end) -;;; (defconst :end1 ':end1) -;;; (defconst :end2 ':end2) -;;; (defconst :count ':count) -;;; (defconst :initial-value ':initial-value) -;;; (defconst :size ':size) -;;; (defconst :from-end ':from-end) -;;; (defconst :rehash-size ':rehash-size) -;;; (defconst :rehash-threshold ':rehash-threshold) -;;; (defconst :allow-other-keys ':allow-other-keys) - - -(defvar custom-print-functions nil - "This is a list of functions that format user objects for printing. -Each function is called in turn with three arguments: the object, the -stream, and the print level (currently ignored). If it is able to -print the object it returns true; otherwise it returns nil and the -printer proceeds to the next function on the list. - -This variable is not used at present, but it is defined in hopes that -a future Emacs interpreter will be able to use it.") - - -;;; Predicates. - -(defun eql (a b) ; See compiler macro in cl-macs.el - "Return t if the two args are the same Lisp object. -Floating-point numbers of equal value are `eql', but they may not be `eq'." - (if (floatp a) - (equal a b) - (eq a b))) - - -;;; Generalized variables. These macros are defined here so that they -;;; can safely be used in .emacs files. - -(defmacro incf (place &optional x) - "(incf PLACE [X]): increment PLACE by X (1 by default). -PLACE may be a symbol, or any generalized variable allowed by `setf'. -The return value is the incremented value of PLACE." - (if (symbolp place) - (list 'setq place (if x (list '+ place x) (list '1+ place))) - ;; XEmacs byte-compiler optimizes (+ FOO 1) to (1+ FOO), so this - ;; is OK. - (list 'callf '+ place (or x 1)))) - -(defmacro decf (place &optional x) - "(decf PLACE [X]): decrement PLACE by X (1 by default). -PLACE may be a symbol, or any generalized variable allowed by `setf'. -The return value is the decremented value of PLACE." - (if (symbolp place) - (list 'setq place (if x (list '- place x) (list '1- place))) - (list 'callf '- place (or x 1)))) - -(defmacro pop (place) - "(pop PLACE): remove and return the head of the list stored in PLACE. -Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more -careful about evaluating each argument only once and in the right order. -PLACE may be a symbol, or any generalized variable allowed by `setf'." - (if (symbolp place) - `(car (prog1 ,place (setq ,place (cdr ,place)))) - (cl-do-pop place))) - -(defmacro push (x place) - "(push X PLACE): insert X at the head of the list stored in PLACE. -Analogous to (setf PLACE (cons X PLACE)), though more careful about -evaluating each argument only once and in the right order. PLACE may -be a symbol, or any generalized variable allowed by `setf'." - (if (symbolp place) `(setq ,place (cons ,x ,place)) - (list 'callf2 'cons x place))) - -(defmacro pushnew (x place &rest keys) - "(pushnew X PLACE): insert X at the head of the list if not already there. -Like (push X PLACE), except that the list is unmodified if X is `eql' to -an element already on the list. -Keywords supported: :test :test-not :key" - (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) - (list* 'callf2 'adjoin x place keys))) - -(defun cl-set-elt (seq n val) - (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) - -(defun cl-set-nthcdr (n list x) - (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) - -(defun cl-set-buffer-substring (start end val) - (save-excursion (delete-region start end) - (goto-char start) - (insert val) - val)) - -(defun cl-set-substring (str start end val) - (if end (if (< end 0) (incf end (length str))) - (setq end (length str))) - (if (< start 0) (incf start str)) - (concat (and (> start 0) (substring str 0 start)) - val - (and (< end (length str)) (substring str end)))) - - -;;; Control structures. - -;; The macros `when' and `unless' are so useful that we want them to -;; ALWAYS be available. So they've been moved from cl.el to eval.c. -;; Note: FSF Emacs moved them to subr.el in FSF 20. - -(defun cl-map-extents (&rest cl-args) - ;; XEmacs: This used to check for overlays first, but that's wrong - ;; because of the new compatibility library. *duh* - (cond ((fboundp 'map-extents) - (apply 'map-extents cl-args)) - ((fboundp 'next-overlay-at) - (apply 'cl-map-overlays cl-args)))) - - -;;; Blocks and exits. - -(defalias 'cl-block-wrapper 'identity) -(defalias 'cl-block-throw 'throw) - - -;;; Multiple values. True multiple values are not supported, or even -;;; simulated. Instead, multiple-value-bind and friends simply expect -;;; the target form to return the values as a list. - -(defalias 'values 'list) -(defalias 'values-list 'identity) -(defalias 'multiple-value-list 'identity) -(defalias 'multiple-value-call 'apply) ; only works for one arg -(defalias 'nth-value 'nth) - - -;;; Macros. - -(defvar cl-macro-environment nil) -;; XEmacs: we renamed the internal function to macroexpand-internal -;; to avoid doc-file problems. -(defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand-internal) - (defalias 'macroexpand 'cl-macroexpand))) - -(defun cl-macroexpand (cl-macro &optional cl-env) - "Return result of expanding macros at top level of FORM. -If FORM is not a macro call, it is returned unchanged. -Otherwise, the macro is expanded and the expansion is considered -in place of FORM. When a non-macro-call results, it is returned. - -The second optional arg ENVIRONMENT species an environment of macro -definitions to shadow the loaded ones for use in file byte-compilation." - (let ((cl-macro-environment cl-env)) - (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) - (and (symbolp cl-macro) - (cdr (assq (symbol-name cl-macro) cl-env)))) - (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) - cl-macro)) - - -;;; Declarations. - -(defvar cl-compiling-file nil) -(defun cl-compiling-file () - (or cl-compiling-file - ;; XEmacs change -; (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer)) -; (equal (buffer-name (symbol-value 'outbuffer)) -; " *Compiler Output*")) - (and (boundp 'byte-compile-outbuffer) - (bufferp (symbol-value 'byte-compile-outbuffer)) - (equal (buffer-name (symbol-value 'byte-compile-outbuffer)) - " *Compiler Output*")) - )) - -(defvar cl-proclaims-deferred nil) - -(defun proclaim (spec) - (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) - (push spec cl-proclaims-deferred)) - nil) - -(defmacro declaim (&rest specs) - (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x)))) - specs))) - (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) - (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when - - -;;; Symbols. - -(defun cl-random-time () - (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) - (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) - v)) - -(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) - - -;;; Numbers. - -(defun floatp-safe (x) - "Return t if OBJECT is a floating point number. -On Emacs versions that lack floating-point support, this function -always returns nil." - ;;(and (numberp x) (not (integerp x))) - ;; XEmacs: use floatp. XEmacs is always compiled with - ;; floating-point, anyway. - (floatp x)) - -(defun plusp (x) - "Return t if NUMBER is positive." - (> x 0)) - -(defun minusp (x) - "Return t if NUMBER is negative." - (< x 0)) - -(defun oddp (x) - "Return t if INTEGER is odd." - (eq (logand x 1) 1)) - -(defun evenp (x) - "Return t if INTEGER is even." - (eq (logand x 1) 0)) - -(defun cl-abs (x) - "Return the absolute value of ARG." - (if (>= x 0) x (- x))) -(or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19 - -(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) - -;;; We use `eval' in case VALBITS differs from compile-time to load-time. -(defconst most-positive-fixnum (eval '(lsh -1 -1)) - "The integer closest in value to positive infinity.") -(defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1))) - "The integer closest in value to negative infinity.") - -;;; The following are set by code in cl-extra.el -(defconst most-positive-float nil - "The float closest in value to positive infinity.") -(defconst most-negative-float nil - "The float closest in value to negative infinity.") -(defconst least-positive-float nil - "The positive float closest in value to 0.") -(defconst least-negative-float nil - "The negative float closest in value to 0.") -(defconst least-positive-normalized-float nil) -(defconst least-negative-normalized-float nil) -(defconst float-epsilon nil) -(defconst float-negative-epsilon nil) - - -;;; Sequence functions. - -(defalias 'copy-seq 'copy-sequence) - -(defun mapcar* (cl-func cl-x &rest cl-rest) - "Apply FUNCTION to each element of SEQ, and make a list of the results. -If there are several SEQs, FUNCTION is called with that many arguments, -and mapping stops as soon as the shortest list runs out. With just one -SEQ, this is like `mapcar'. With several, it is like the Common Lisp -`mapcar' function extended to arbitrary sequence types." - (if cl-rest - (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) - (cl-mapcar-many cl-func (cons cl-x cl-rest)) - (let ((cl-res nil) (cl-y (car cl-rest))) - (while (and cl-x cl-y) - (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) - (nreverse cl-res))) - (mapcar cl-func cl-x))) - - -;;; List functions. - -;; These functions are made known to the byte-compiler by cl-macs.el -;; and turned into efficient car and cdr bytecodes. - -(defalias 'first 'car) -(defalias 'rest 'cdr) -(defalias 'endp 'null) - -(defun second (x) - "Return the second element of the list LIST." - (car (cdr x))) - -(defun third (x) - "Return the third element of the list LIST." - (car (cdr (cdr x)))) - -(defun fourth (x) - "Return the fourth element of the list LIST." - (nth 3 x)) - -(defun fifth (x) - "Return the fifth element of the list LIST." - (nth 4 x)) - -(defun sixth (x) - "Return the sixth element of the list LIST." - (nth 5 x)) - -(defun seventh (x) - "Return the seventh element of the list LIST." - (nth 6 x)) - -(defun eighth (x) - "Return the eighth element of the list LIST." - (nth 7 x)) - -(defun ninth (x) - "Return the ninth element of the list LIST." - (nth 8 x)) - -(defun tenth (x) - "Return the tenth element of the list LIST." - (nth 9 x)) - -(defun caar (x) - "Return the `car' of the `car' of X." - (car (car x))) - -(defun cadr (x) - "Return the `car' of the `cdr' of X." - (car (cdr x))) - -(defun cdar (x) - "Return the `cdr' of the `car' of X." - (cdr (car x))) - -(defun cddr (x) - "Return the `cdr' of the `cdr' of X." - (cdr (cdr x))) - -(defun caaar (x) - "Return the `car' of the `car' of the `car' of X." - (car (car (car x)))) - -(defun caadr (x) - "Return the `car' of the `car' of the `cdr' of X." - (car (car (cdr x)))) - -(defun cadar (x) - "Return the `car' of the `cdr' of the `car' of X." - (car (cdr (car x)))) - -(defun caddr (x) - "Return the `car' of the `cdr' of the `cdr' of X." - (car (cdr (cdr x)))) - -(defun cdaar (x) - "Return the `cdr' of the `car' of the `car' of X." - (cdr (car (car x)))) - -(defun cdadr (x) - "Return the `cdr' of the `car' of the `cdr' of X." - (cdr (car (cdr x)))) - -(defun cddar (x) - "Return the `cdr' of the `cdr' of the `car' of X." - (cdr (cdr (car x)))) - -(defun cdddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of X." - (cdr (cdr (cdr x)))) - -(defun caaaar (x) - "Return the `car' of the `car' of the `car' of the `car' of X." - (car (car (car (car x))))) - -(defun caaadr (x) - "Return the `car' of the `car' of the `car' of the `cdr' of X." - (car (car (car (cdr x))))) - -(defun caadar (x) - "Return the `car' of the `car' of the `cdr' of the `car' of X." - (car (car (cdr (car x))))) - -(defun caaddr (x) - "Return the `car' of the `car' of the `cdr' of the `cdr' of X." - (car (car (cdr (cdr x))))) - -(defun cadaar (x) - "Return the `car' of the `cdr' of the `car' of the `car' of X." - (car (cdr (car (car x))))) - -(defun cadadr (x) - "Return the `car' of the `cdr' of the `car' of the `cdr' of X." - (car (cdr (car (cdr x))))) - -(defun caddar (x) - "Return the `car' of the `cdr' of the `cdr' of the `car' of X." - (car (cdr (cdr (car x))))) - -(defun cadddr (x) - "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." - (car (cdr (cdr (cdr x))))) - -(defun cdaaar (x) - "Return the `cdr' of the `car' of the `car' of the `car' of X." - (cdr (car (car (car x))))) - -(defun cdaadr (x) - "Return the `cdr' of the `car' of the `car' of the `cdr' of X." - (cdr (car (car (cdr x))))) - -(defun cdadar (x) - "Return the `cdr' of the `car' of the `cdr' of the `car' of X." - (cdr (car (cdr (car x))))) - -(defun cdaddr (x) - "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." - (cdr (car (cdr (cdr x))))) - -(defun cddaar (x) - "Return the `cdr' of the `cdr' of the `car' of the `car' of X." - (cdr (cdr (car (car x))))) - -(defun cddadr (x) - "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." - (cdr (cdr (car (cdr x))))) - -(defun cdddar (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." - (cdr (cdr (cdr (car x))))) - -(defun cddddr (x) - "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." - (cdr (cdr (cdr (cdr x))))) - -;;; `last' is implemented as a C primitive, as of 1998-11 - -;(defun last (x &optional n) -; "Return the last link in the list LIST. -;With optional argument N, return Nth-to-last link (default 1)." -; (if n -; (let ((m 0) (p x)) -; (while (consp p) (incf m) (pop p)) -; (if (<= n 0) p -; (if (< n m) (nthcdr (- m n) x) x))) -; (while (consp (cdr x)) (pop x)) -; x)) - -;;; `butlast' is implemented as a C primitive, as of 1998-11 -;;; `nbutlast' is implemented as a C primitive, as of 1998-11 - -;(defun butlast (x &optional n) -; "Return a copy of LIST with the last N elements removed." -; (if (and n (<= n 0)) x -; (nbutlast (copy-sequence x) n))) - -;(defun nbutlast (x &optional n) -; "Modify LIST to remove the last N elements." -; (let ((m (length x))) -; (or n (setq n 1)) -; (and (< n m) -; (progn -; (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) -; x)))) - -(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el - "Return a new list with specified args as elements, cons'd to last arg. -Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to -`(cons A (cons B (cons C D)))'." - (cond ((not rest) arg) - ((not (cdr rest)) (cons arg (car rest))) - (t (let* ((n (length rest)) - (copy (copy-sequence rest)) - (last (nthcdr (- n 2) copy))) - (setcdr last (car (cdr last))) - (cons arg copy))))) - -(defun ldiff (list sublist) - "Return a copy of LIST with the tail SUBLIST removed." - (let ((res nil)) - (while (and (consp list) (not (eq list sublist))) - (push (pop list) res)) - (nreverse res))) - -;;; `copy-list' is implemented as a C primitive, as of 1998-11 - -;(defun copy-list (list) -; "Return a copy of a list, which may be a dotted list. -;The elements of the list are not copied, just the list structure itself." -; (if (consp list) -; (let ((res nil)) -; (while (consp list) (push (pop list) res)) -; (prog1 (nreverse res) (setcdr res list))) -; (car list))) - -(defun cl-maclisp-member (item list) - (while (and list (not (equal item (car list)))) (setq list (cdr list))) - list) - -;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users. -(or (and (fboundp 'member) (subrp (symbol-function 'member))) - (defalias 'member 'cl-maclisp-member)) - -(defalias 'cl-member 'memq) ; for compatibility with old CL package -(defalias 'cl-floor 'floor*) -(defalias 'cl-ceiling 'ceiling*) -(defalias 'cl-truncate 'truncate*) -(defalias 'cl-round 'round*) -(defalias 'cl-mod 'mod*) - -(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs - "Return ITEM consed onto the front of LIST only if it's not already there. -Otherwise, return LIST unmodified. -Keywords supported: :test :test-not :key" - (cond ((or (equal cl-keys '(:test eq)) - (and (null cl-keys) (not (numberp cl-item)))) - (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) - ((or (equal cl-keys '(:test equal)) (null cl-keys)) - (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) - (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) - -(defun subst (cl-new cl-old cl-tree &rest cl-keys) - "Substitute NEW for OLD everywhere in TREE (non-destructively). -Return a copy of TREE with all elements `eql' to OLD replaced by NEW. -Keywords supported: :test :test-not :key" - (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) - (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) - (cl-do-subst cl-new cl-old cl-tree))) - -(defun cl-do-subst (cl-new cl-old cl-tree) - (cond ((eq cl-tree cl-old) cl-new) - ((consp cl-tree) - (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) - (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) - (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) - cl-tree (cons a d)))) - (t cl-tree))) - -(defun acons (a b c) - "Return a new alist created by adding (KEY . VALUE) to ALIST." - (cons (cons a b) c)) - -(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) - - -;;; Miscellaneous. - -;; XEmacs change -(define-error 'cl-assertion-failed "Assertion failed") - -;;; This is defined in Emacs 19; define it here for Emacs 18 users. -(defun cl-add-hook (hook func &optional append) - "Add to hook variable HOOK the function FUNC. -FUNC is not added if it already appears on the list stored in HOOK." - (let ((old (and (boundp hook) (symbol-value hook)))) - (and (listp old) (not (eq (car old) 'lambda)) - (setq old (list old))) - (and (not (member func old)) - (set hook (if append (nconc old (list func)) (cons func old)))))) -(or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook)) - -;; XEmacs change -;(load "cl-defs") - -;;; Define data for indentation and edebug. -(mapc - #'(lambda (entry) - (mapc - #'(lambda (func) - (put func 'lisp-indent-function (nth 1 entry)) - (put func 'lisp-indent-hook (nth 1 entry)) - (or (get func 'edebug-form-spec) - (put func 'edebug-form-spec (nth 2 entry)))) - (car entry))) - '(((defun* defmacro*) defun) - ((function*) nil - (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) - ((eval-when) 1 (sexp &rest form)) - ((when unless) 1 (&rest form)) - ((declare) nil (&rest sexp)) - ((the) 1 (sexp &rest form)) - ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) - ((block return-from) 1 (sexp &rest form)) - ((return) nil (&optional form)) - ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) - (form &rest form) - &rest form)) - ((dolist dotimes) 1 ((symbolp form &rest form) &rest form)) - ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) - ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) - ((psetq setf psetf) nil edebug-setq-form) - ((progv) 2 (&rest form)) - ((flet labels macrolet) 1 - ((&rest (sexp sexp &rest form)) &rest form)) - ((symbol-macrolet lexical-let lexical-let*) 1 - ((&rest &or symbolp (symbolp form)) &rest form)) - ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) - ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) - ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form)) - ((letf letf*) 1 ((&rest (&rest form)) &rest form)) - ((callf destructuring-bind) 2 (sexp form &rest form)) - ((callf2) 3 (sexp form form &rest form)) - ((loop) defun (&rest &or symbolp form)) - ((ignore-errors) 0 (&rest form)))) - - -;;; This goes here so that cl-macs can find it if it loads right now. -(provide 'cl-19) ; usage: (require 'cl-19 "cl") - - -;;; Things to do after byte-compiler is loaded. -;;; As a side effect, we cause cl-macs to be loaded when compiling, so -;;; that the compiler-macros defined there will be present. - -(defvar cl-hacked-flag nil) -(defun cl-hack-byte-compiler () - (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) - (progn - (cl-compile-time-init) ; in cl-macs.el - (setq cl-hacked-flag t)))) - -;;; Try it now in case the compiler has already been loaded. -(cl-hack-byte-compiler) - -;;; Also make a hook in case compiler is loaded after this file. -;;; The compiler doesn't call any hooks when it loads or runs, but -;;; we can take advantage of the fact that emacs-lisp-mode will be -;;; called when the compiler reads in the file to be compiled. -;;; BUG: If the first compilation is `byte-compile' rather than -;;; `byte-compile-file', we lose. Oh, well. -(add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler) - - -;;; The following ensures that packages which expect the old-style cl.el -;;; will be happy with this one. - -(provide 'cl) - -(provide 'mini-cl) ; for Epoch - -(run-hooks 'cl-load-hook) - -;;; cl.el ends here diff --git a/lisp/cmdloop.el b/lisp/cmdloop.el deleted file mode 100644 index e5b4be0..0000000 --- a/lisp/cmdloop.el +++ /dev/null @@ -1,570 +0,0 @@ -;;; cmdloop.el --- support functions for the top-level command loop. - -;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. - -;; Author: Richard Mlynarik -;; Date: 8-Jul-92 -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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 19.30. (Some of the stuff below is in FSF's subr.el.) - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun recursion-depth () - "Return the current depth in recursive edits." - (+ command-loop-level (minibuffer-depth))) - -(defun top-level () - "Exit all recursive editing levels." - (interactive) - (throw 'top-level nil)) - -(defun exit-recursive-edit () - "Exit from the innermost recursive edit or minibuffer." - (interactive) - (if (> (recursion-depth) 0) - (throw 'exit nil)) - (error "No recursive edit is in progress")) - -(defun abort-recursive-edit () - "Abort the command that requested this recursive edit or minibuffer input." - (interactive) - (if (> (recursion-depth) 0) - (throw 'exit t)) - (error "No recursive edit is in progress")) - -;; (defun keyboard-quit () -;; "Signal a `quit' condition." -;; (interactive) -;; (deactivate-mark) -;; (signal 'quit nil)) - -;; moved here from pending-del. -(defun keyboard-quit () - "Signal a `quit' condition. -If this character is typed while lisp code is executing, it will be treated - as an interrupt. -If this character is typed at top-level, this simply beeps. -If `zmacs-regions' is true, and the zmacs region is active in this buffer, -then this key deactivates the region without beeping or signalling." - (interactive) - (if (and (region-active-p) - (eq (current-buffer) (zmacs-region-buffer))) - ;; pseudo-zmacs compatibility: don't beep if this ^G is simply - ;; deactivating the region. If it is inactive, beep. - nil - (signal 'quit nil))) - -(defvar buffer-quit-function nil - "Function to call to \"quit\" the current buffer, or nil if none. -\\[keyboard-escape-quit] calls this function when its more local actions -\(such as cancelling a prefix argument, minibuffer or region) do not apply.") - -(defun keyboard-escape-quit () - "Exit the current \"mode\" (in a generalized sense of the word). -This command can exit an interactive command such as `query-replace', -can clear out a prefix argument or a region, -can get out of the minibuffer or other recursive edit, -cancel the use of the current buffer (for special-purpose buffers), -or go back to just one window (by deleting all but the selected window)." - (interactive) - (cond ((eq last-command 'mode-exited) nil) - ((> (minibuffer-depth) 0) - (abort-recursive-edit)) - (current-prefix-arg - nil) - ((region-active-p) - (zmacs-deactivate-region)) - ((> (recursion-depth) 0) - (exit-recursive-edit)) - (buffer-quit-function - (funcall buffer-quit-function)) - ((not (one-window-p t)) - (delete-other-windows)) - ((string-match "^ \\*" (buffer-name (current-buffer))) - (bury-buffer)))) - -;; `cancel-mode-internal' is a function of a misc-user event, which is -;; queued when window system directs XEmacs frame to cancel any modal -;; behavior it exposes, like mouse pointer grabbing. -;; -;; This function does nothing at the top level, but the code which -;; runs modal event loops, such as selection drag loop in `mouse-track', -;; check if misc-user function symbol is `cancel-mode-internal', and -;; takes necessary cleanup actions. -(defun cancel-mode-internal (object) - (setq zmacs-region-stays t)) - -;; Someone wrote: "This should really be a ring of last errors." -;; -;; But why bother? This stuff is not all that necessary now that we -;; have message log, anyway. -(defvar last-error nil - "Object describing the last signaled error.") - -(defcustom errors-deactivate-region nil - "*Non-nil means that errors will cause the region to be deactivated." - :type 'boolean - :group 'editing-basics) - -(defun command-error (error-object) - (let ((inhibit-quit t) - (debug-on-error nil) - (etype (car-safe error-object))) - (setq quit-flag nil) - (setq standard-output t) - (setq standard-input t) - (setq executing-kbd-macro nil) - (and errors-deactivate-region - (zmacs-deactivate-region)) - (discard-input) - - (setq last-error error-object) - - (message nil) - (ding nil (cond ((eq etype 'undefined-keystroke-sequence) - (if (and (vectorp (nth 1 error-object)) - (/= 0 (length (nth 1 error-object))) - (button-event-p (aref (nth 1 error-object) 0))) - 'undefined-click - 'undefined-key)) - ((eq etype 'quit) - 'quit) - ((memq etype '(end-of-buffer beginning-of-buffer)) - 'buffer-bound) - ((eq etype 'buffer-read-only) - 'read-only) - (t 'command-error))) - (display-error error-object t) - - (if (noninteractive) - (progn - (message "%s exiting." emacs-program-name) - (kill-emacs -1))) - t)) - -(defun describe-last-error () - "Redisplay the last error-message. See the variable `last-error'." - (interactive) - (if last-error - (with-displaying-help-buffer - (lambda () - (princ "Last error was:\n" standard-output) - (display-error last-error standard-output))) - (message "No error yet"))) - - -;;#### Must be done later in the loadup sequence -;(define-key (symbol-function 'help-command) "e" 'describe-last-error) - - -(defun truncate-command-history-for-gc () - (let ((tail (nthcdr 30 command-history))) - (if tail (setcdr tail nil))) - (let ((tail (nthcdr 30 values))) - (if tail (setcdr tail nil))) - ) - -(add-hook 'pre-gc-hook 'truncate-command-history-for-gc) - - -;;;; Object-oriented programming at its finest - -;; Now in src/print.c; used by Ferror_message_string and others -;(defun display-error (error-object stream) ;(defgeneric report-condition ...) -; "Display `error-object' on `stream' in a user-friendly way." -; (funcall (or (let ((type (car-safe error-object))) -; (catch 'error -; (and (consp error-object) -; (symbolp type) -; ;;(stringp (get type 'error-message)) -; (consp (get type 'error-conditions)) -; (let ((tail (cdr error-object))) -; (while (not (null tail)) -; (if (consp tail) -; (setq tail (cdr tail)) -; (throw 'error nil))) -; t) -; ;; (check-type condition condition) -; (get type 'error-conditions) -; ;; Search class hierarchy -; (let ((tail (get type 'error-conditions))) -; (while (not (null tail)) -; (cond ((not (and (consp tail) -; (symbolp (car tail)))) -; (throw 'error nil)) -; ((get (car tail) 'display-error) -; (throw 'error (get (car tail) -; 'display-error))) -; (t -; (setq tail (cdr tail))))) -; ;; Default method -; #'(lambda (error-object stream) -; (let ((type (car error-object)) -; (tail (cdr error-object)) -; (first t) -; (print-message-label 'error)) -; (if (eq type 'error) -; (progn (princ (car tail) stream) -; (setq tail (cdr tail))) -; (princ (or (gettext (get type 'error-message)) type) -; stream)) -; (while tail -; (princ (if first ": " ", ") stream) -; (prin1 (car tail) stream) -; (setq tail (cdr tail) -; first nil)))))))) -; #'(lambda (error-object stream) -; (princ (gettext "Peculiar error ") stream) -; (prin1 error-object stream))) -; error-object stream)) - -(put 'file-error 'display-error - #'(lambda (error-object stream) - (let ((tail (cdr error-object)) - (first t)) - (princ (car tail) stream) - (while (setq tail (cdr tail)) - (princ (if first ": " ", ") stream) - (princ (car tail) stream) - (setq first nil))))) - -(put 'undefined-keystroke-sequence 'display-error - #'(lambda (error-object stream) - (princ (key-description (car (cdr error-object))) stream) - ;; #### I18N3: doesn't localize properly. - (princ (gettext " not defined.") stream) ; doo dah, doo dah. - )) - - -(defcustom teach-extended-commands-p t - "*If true, then `\\[execute-extended-command]' will teach you keybindings. -Any time you execute a command with \\[execute-extended-command] which has a -shorter keybinding, you will be shown the alternate binding before the -command executes. There is a short pause after displaying the binding, -before executing it; the length can be controlled by -`teach-extended-commands-timeout'." - :type 'boolean - :group 'keyboard) - -(defcustom teach-extended-commands-timeout 4 - "*How long to pause after displaying a keybinding before executing. -The value is measured in seconds. This only applies if -`teach-extended-commands-p' is true." - :type 'number - :group 'keyboard) - -;That damn RMS went off and implemented something differently, after -;we had already implemented it. We can't support both properly until -;we have Lisp magic variables. -;(defvar suggest-key-bindings t -; "*FSFmacs equivalent of `teach-extended-commands-*'. -;Provided for compatibility only. -;Non-nil means show the equivalent key-binding when M-x command has one. -;The value can be a length of time to show the message for. -;If the value is non-nil and not a number, we wait 2 seconds.") -; -;(make-obsolete-variable 'suggest-key-bindings 'teach-extended-commands-p) - -(defun execute-extended-command (prefix-arg) - "Read a command name from the minibuffer using 'completing-read'. -Then call the specified command using 'command-execute' and return its -return value. If the command asks for a prefix argument, supply the -value of the current raw prefix argument, or the value of PREFIX-ARG -when called from Lisp." - (interactive "P") - ;; Note: This doesn't hack "this-command-keys" - (let ((prefix-arg prefix-arg)) - (setq this-command (read-command - ;; Note: this has the hard-wired - ;; "C-u" and "M-x" string bug in common - ;; with all GNU Emacs's. - ;; (i.e. it prints C-u and M-x regardless of - ;; whether some other keys were actually bound - ;; to `execute-extended-command' and - ;; `universal-argument'. - (cond ((eq prefix-arg '-) - "- M-x ") - ((equal prefix-arg '(4)) - "C-u M-x ") - ((integerp prefix-arg) - (format "%d M-x " prefix-arg)) - ((and (consp prefix-arg) - (integerp (car prefix-arg))) - (format "%d M-x " (car prefix-arg))) - (t - "M-x "))))) - - (if (and teach-extended-commands-p - (interactive-p)) - ;; We need to fiddle with keys: remember the keys, run the - ;; command, and show the keys (if any). - (let ((_execute_command_keys_ (where-is-internal this-command)) - (_execute_command_name_ this-command)) ; the name can change - (command-execute this-command t) - (when (and _execute_command_keys_ - ;; Wait for a while, so the user can see a message - ;; printed, if any. - (sit-for 1)) - (display-message - 'no-log - (format "Command `%s' is bound to key%s: %s" - _execute_command_name_ - (if (cdr _execute_command_keys_) "s" "") - (sorted-key-descriptions _execute_command_keys_))) - (sit-for teach-extended-commands-timeout) - (clear-message 'no-log))) - ;; Else, just run the command. - (command-execute this-command t))) - - -;;; C code calls this; the underscores in the variable names are to avoid -;;; cluttering the specbind namespace (lexical scope! lexical scope!) -;;; Putting this in Lisp instead of C slows kbd macros by 50%. -;(defun command-execute (_command &optional _record-flag) -; "Execute CMD as an editor command. -;CMD must be a symbol that satisfies the `commandp' predicate. -;Optional second arg RECORD-FLAG non-nil -;means unconditionally put this command in `command-history'. -;Otherwise, that is done only if an arg is read using the minibuffer." -; (let ((_prefix prefix-arg) -; (_cmd (indirect-function _command))) -; (setq prefix-arg nil -; this-command _command -; current-prefix-arg _prefix -; zmacs-region-stays nil) -; ;; #### debug_on_next_call = 0; -; (cond ((and (symbolp _command) -; (get _command 'disabled)) -; (run-hooks disabled-command-hook)) -; ((or (stringp _cmd) (vectorp _cmd)) -; ;; If requested, place the macro in the command history. -; ;; For other sorts of commands, call-interactively takes -; ;; care of this. -; (if _record-flag -; (setq command-history -; (cons (list 'execute-kbd-macro _cmd _prefix) -; command-history))) -; (execute-kbd-macro _cmd _prefix)) -; (t -; (call-interactively _command _record-flag))))) - -(defun y-or-n-p-minibuf (prompt) - "Ask user a \"y or n\" question. Return t if answer is \"y\". -Takes one argument, which is the string to display to ask the question. -It should end in a space; `y-or-n-p' adds `(y or n) ' to it. -No confirmation of the answer is requested; a single character is enough. -Also accepts Space to mean yes, or Delete to mean no." - (save-excursion - (let* ((pre "") - (yn (gettext "(y or n) ")) - ;; we need to translate the prompt ourselves because of the - ;; strange way we handle it. - (prompt (gettext prompt)) - event) - (while (stringp yn) - (if (let ((cursor-in-echo-area t) - (inhibit-quit t)) - (message "%s%s%s" pre prompt yn) - (setq event (next-command-event event)) - (condition-case nil - (prog1 - (or quit-flag (eq 'keyboard-quit (key-binding event))) - (setq quit-flag nil)) - (wrong-type-argument t))) - (progn - (message "%s%s%s%s" pre prompt yn (single-key-description event)) - (setq quit-flag nil) - (signal 'quit '()))) - (let* ((keys (events-to-keys (vector event))) - (def (lookup-key query-replace-map keys))) - (cond ((eq def 'skip) - (message "%s%sNo" prompt yn) - (setq yn nil)) - ((eq def 'act) - (message "%s%sYes" prompt yn) - (setq yn t)) - ((eq def 'recenter) - (recenter)) - ((or (eq def 'quit) (eq def 'exit-prefix)) - (signal 'quit '())) - ((button-release-event-p event) ; ignore them - nil) - (t - (message "%s%s%s%s" pre prompt yn - (single-key-description event)) - (ding nil 'y-or-n-p) - (discard-input) - (if (= (length pre) 0) - (setq pre (gettext "Please answer y or n. "))))))) - yn))) - -(defun yes-or-no-p-minibuf (prompt) - "Ask user a yes-or-no question. Return t if answer is yes. -Takes one argument, which is the string to display to ask the question. -It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it. -The user must confirm the answer with RET, -and can edit it until it has been confirmed." - (save-excursion - (let ((p (concat (gettext prompt) (gettext "(yes or no) "))) - (ans "")) - (while (stringp ans) - (setq ans (downcase (read-string p nil t))) ;no history - (cond ((string-equal ans (gettext "yes")) - (setq ans t)) - ((string-equal ans (gettext "no")) - (setq ans nil)) - (t - (ding nil 'yes-or-no-p) - (discard-input) - (message "Please answer yes or no.") - (sleep-for 2)))) - ans))) - -;; these may be redefined later, but make the original def easily encapsulable -(define-function 'yes-or-no-p 'yes-or-no-p-minibuf) -(define-function 'y-or-n-p 'y-or-n-p-minibuf) - - -(defun read-char () - "Read a character from the command input (keyboard or macro). -If a mouse click or non-ASCII character is detected, an error is -signalled. The character typed is returned as an ASCII value. This -is most likely the wrong thing for you to be using: consider using -the `next-command-event' function instead." - (save-excursion - (let ((event (next-command-event))) - (or inhibit-quit - (and (event-matches-key-specifier-p event (quit-char)) - (signal 'quit nil))) - (prog1 (or (event-to-character event) - ;; Kludge. If the event we read was a mouse-release, - ;; discard it and read the next one. - (if (button-release-event-p event) - (event-to-character (next-command-event event))) - (error "Key read has no ASCII equivalent %S" event)) - ;; this is not necessary, but is marginally more efficient than GC. - (deallocate-event event))))) - -(defun read-char-exclusive () - "Read a character from the command input (keyboard or macro). -If a mouse click or non-ASCII character is detected, it is discarded. -The character typed is returned as an ASCII value. This is most likely -the wrong thing for you to be using: consider using the -`next-command-event' function instead." - (let (event ch) - (while (progn - (setq event (next-command-event)) - (or inhibit-quit - (and (event-matches-key-specifier-p event (quit-char)) - (signal 'quit nil))) - (setq ch (event-to-character event)) - (deallocate-event event) - (null ch))) - ch)) - -(defun read-quoted-char (&optional prompt) - "Like `read-char', except that if the first character read is an octal -digit, we read up to two more octal digits and return the character -represented by the octal number consisting of those digits. -Optional argument PROMPT specifies a string to use to prompt the user." - (let ((count 0) (code 0) done - (prompt (and prompt (gettext prompt))) - char event) - (while (and (not done) (< count 3)) - (let ((inhibit-quit (zerop count)) - ;; Don't let C-h get the help message--only help function keys. - (help-char nil) - (help-form - "Type the special character you want to use, -or three octal digits representing its character code.")) - (and prompt (display-message 'prompt (format "%s-" prompt))) - (setq event (next-command-event) - char (or (event-to-character event nil nil t) - (signal 'error - (list "key read cannot be inserted in a buffer" - event)))) - (if inhibit-quit (setq quit-flag nil))) - (cond ((<= ?0 char ?7) - (setq code (+ (* code 8) (- char ?0)) - count (1+ count)) - (when prompt - (display-message 'prompt - (setq prompt (format "%s %c" prompt char))))) - ((> count 0) - (setq unread-command-event event - done t)) - (t (setq code (char-int char) - done t)))) - (int-char code) - ;; Turn a meta-character into a character with the 0200 bit set. -; (logior (if (/= (logand code ?\M-\^@) 0) 128 0) -; (logand 255 code)))) - )) - -(defun momentary-string-display (string pos &optional exit-char message) - "Momentarily display STRING in the buffer at POS. -Display remains until next character is typed. -If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; -otherwise it is then available as input (as a command if nothing else). -Display MESSAGE (optional fourth arg) in the echo area. -If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." - (or exit-char (setq exit-char ?\ )) - (let ((buffer-read-only nil) - ;; Don't modify the undo list at all. - (buffer-undo-list t) - (modified (buffer-modified-p)) - (name buffer-file-name) - insert-end) - (unwind-protect - (progn - (save-excursion - (goto-char pos) - ;; defeat file locking... don't try this at home, kids! - (setq buffer-file-name nil) - (insert-before-markers (gettext string)) - (setq insert-end (point)) - ;; If the message end is off frame, recenter now. - (if (> (window-end) insert-end) - (recenter (/ (window-height) 2))) - ;; If that pushed message start off the frame, - ;; scroll to start it at the top of the frame. - (move-to-window-line 0) - (if (> (point) pos) - (progn - (goto-char pos) - (recenter 0)))) - (message (or message (gettext "Type %s to continue editing.")) - (single-key-description exit-char)) - (let ((event (save-excursion (next-command-event)))) - (or (eq (event-to-character event) exit-char) - (setq unread-command-event event)))) - (if insert-end - (save-excursion - (delete-region pos insert-end))) - (setq buffer-file-name name) - (set-buffer-modified-p modified)))) - -;;; cmdloop.el ends here diff --git a/lisp/code-files.el b/lisp/code-files.el deleted file mode 100644 index accbc0d..0000000 --- a/lisp/code-files.el +++ /dev/null @@ -1,558 +0,0 @@ -;;; code-files.el --- File I/O functions for XEmacs. - -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. - -;; This file is part of XEmacs. - -;; This file is very similar to mule-files.el - -;; 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: - -;;; Derived from mule.el in the original Mule but heavily modified -;;; by Ben Wing. - -;; 1997/3/11 modified by MORIOKA Tomohiko to sync with Emacs 20 API. - -;;; Code: - -(setq-default buffer-file-coding-system 'no-conversion) -(put 'buffer-file-coding-system 'permanent-local t) - -(define-obsolete-variable-alias - 'file-coding-system - 'buffer-file-coding-system) - -(define-obsolete-variable-alias - 'overriding-file-coding-system - 'coding-system-for-read) - -(defvar buffer-file-coding-system-for-read 'undecided - "Coding system used when reading a file. -This provides coarse-grained control; for finer-grained control, use -`file-coding-system-alist'. From a Lisp program, if you wish to -unilaterally specify the coding system used for one particular -operation, you should bind the variable `coding-system-for-read' -rather than setting this variable, which is intended to be used for -global environment specification.") - -(define-obsolete-variable-alias - 'file-coding-system-for-read - 'buffer-file-coding-system-for-read) - -(defvar file-coding-system-alist - `( -;; This must not be necessary, slb suggests -kkm -;; ("loaddefs.el$" . (binary . binary)) - ,@(mapcar - #'(lambda (regexp) (cons regexp 'binary)) binary-file-regexps) - ("TUTORIAL\\.\\(?:hr\\|pl\\|ro\\)\\'" . iso-8859-2) - ;; ("\\.\\(el\\|emacs\\|info\\(-[0-9]+\\)?\\|texi\\)$" . iso-2022-8) - ;; ("\\(ChangeLog\\|CHANGES-beta\\)$" . iso-2022-8) - ("/spool/mail/.*$" . convert-mbox-coding-system)) - "Alist to decide a coding system to use for a file I/O operation. -The format is ((PATTERN . VAL) ...), -where PATTERN is a regular expression matching a file name, -VAL is a coding system, a cons of coding systems, or a function symbol. -If VAL is a coding system, it is used for both decoding and encoding -the file contents. -If VAL is a cons of coding systems, the car part is used for decoding, -and the cdr part is used for encoding. -If VAL is a function symbol, the function must return a coding system -or a cons of coding systems which are used as above. - -This overrides the more general specification in -`buffer-file-coding-system-for-read', but is overridden by -`coding-system-for-read'.") - -(defun set-buffer-file-coding-system (coding-system &optional force) - "Set buffer-file-coding-system of the current buffer to CODING-SYSTEM. -If optional argument FORCE (interactively, the prefix argument) is not -given, attempt to match the EOL type of the new coding system to -the current value of `buffer-file-coding-system'." - (interactive "zFile coding system: \nP") - (get-coding-system coding-system) ;; correctness check - (if (not force) - (setq coding-system - (subsidiary-coding-system - coding-system - (coding-system-eol-type buffer-file-coding-system)))) - (setq buffer-file-coding-system coding-system) - (redraw-modeline t)) - -(defun toggle-buffer-file-coding-system () - "Set EOL type of buffer-file-coding-system of the current buffer to -something other than what it is at the moment." - (interactive) - (let ((eol-type - (coding-system-eol-type buffer-file-coding-system))) - (setq buffer-file-coding-system - (subsidiary-coding-system - (coding-system-base buffer-file-coding-system) - (cond ((eq eol-type 'lf) 'crlf) - ((eq eol-type 'crlf) 'lf) - ((eq eol-type 'cr) 'lf)))))) - -(define-obsolete-function-alias - 'set-file-coding-system - 'set-buffer-file-coding-system) - -(defun set-buffer-file-coding-system-for-read (coding-system) - "Set the coding system used when reading in a file. -This is equivalent to setting the variable -`buffer-file-coding-system-for-read'. You can also use -`file-coding-system-alist' to specify the coding system for -particular files." - (interactive "zFile coding system for read: ") - (get-coding-system coding-system) ;; correctness check - (setq buffer-file-coding-system-for-read coding-system)) - -(define-obsolete-function-alias - 'set-file-coding-system-for-read - 'set-buffer-file-coding-system-for-read) - -(defun set-default-buffer-file-coding-system (coding-system) - "Set the default value of `buffer-file-coding-system' to CODING-SYSTEM. -The default value is used both for buffers without associated files -and for files with no apparent coding system (i.e. primarily ASCII). -See `buffer-file-coding-system' for more information." - (interactive "zDefault file coding system: ") - (setq-default buffer-file-coding-system coding-system) - (redraw-modeline t)) - -(define-obsolete-function-alias - 'set-default-file-coding-system - 'set-default-buffer-file-coding-system) - -(defun find-file-coding-system-for-read-from-filename (filename) - "Look up coding system to read a file in `file-coding-system-alist'. -The return value will be nil (no applicable entry) or a coding system -object (the entry specified a coding system)." - (let ((alist file-coding-system-alist) - (found nil) - (codesys nil)) - (let ((case-fold-search nil)) - (setq filename (file-name-sans-versions filename)) - (while (and (not found) alist) - (if (string-match (car (car alist)) filename) - (setq codesys (cdr (car alist)) - found t)) - (setq alist (cdr alist)))) - (when codesys - (if (functionp codesys) - (setq codesys (funcall codesys 'insert-file-contents filename)) - ) - (cond ((consp codesys) (find-coding-system (car codesys))) - ((find-coding-system codesys)) - )))) - -(define-obsolete-function-alias - 'find-file-coding-system-from-filename - 'find-file-coding-system-for-read-from-filename) - -(defun find-file-coding-system-for-write-from-filename (filename) - "Look up coding system to write a file in `file-coding-system-alist'. -The return value will be nil (no applicable entry) or a coding system -object (the entry specified a coding system)." - (let ((alist file-coding-system-alist) - (found nil) - (codesys nil)) - (let ((case-fold-search nil)) - (setq filename (file-name-sans-versions filename)) - (while (and (not found) alist) - (if (string-match (car (car alist)) filename) - (setq codesys (cdr (car alist)) - found t)) - (setq alist (cdr alist)))) - (when codesys - (if (functionp codesys) - (setq codesys (funcall codesys 'write-region filename)) - ) - (cond ((consp codesys) (find-coding-system (cdr codesys))) - ((find-coding-system codesys)) - )))) - -(defun convert-mbox-coding-system (filename visit start end) - "Decoding function for Unix mailboxes. -Does separate detection and decoding on each message, since each -message might be in a different encoding." - (let ((buffer-read-only nil)) - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (not (eobp)) - (let ((start (point)) - end) - (forward-char 1) - (if (re-search-forward "^From" nil 'move) - (beginning-of-line)) - (setq end (point)) - (decode-coding-region start end 'undecided)))))) - -(defun find-coding-system-magic-cookie () - "Look for the coding-system magic cookie in the current buffer.\n" -"The coding-system magic cookie is the exact string\n" -"\";;;###coding system: \" followed by a valid coding system symbol,\n" -"somewhere within the first 3000 characters of the file. If found,\n" -"the coding system symbol is returned; otherwise nil is returned.\n" -"Note that it is extremely unlikely that such a string would occur\n" -"coincidentally as the result of encoding some characters in a non-ASCII\n" -"charset, and that the spaces make it even less likely since the space\n" -"character is not a valid octet in any ISO 2022 encoding of most non-ASCII\n" -"charsets." - (save-excursion - (goto-char (point-min)) - (or (and (looking-at - "^[^\n]*-\\*-[^\n]*coding: \\([^ \t\n;]+\\)[^\n]*-\\*-") - (let ((codesys (intern (buffer-substring - (match-beginning 1)(match-end 1))))) - (if (find-coding-system codesys) codesys))) - ;; (save-excursion - ;; (let (start end) - ;; (and (re-search-forward "^;+[ \t]*Local Variables:" nil t) - ;; (setq start (match-end 0)) - ;; (re-search-forward "\n;+[ \t]*End:") - ;; (setq end (match-beginning 0)) - ;; (save-restriction - ;; (narrow-to-region start end) - ;; (goto-char start) - ;; (re-search-forward "^;;; coding: \\([^\n]+\\)$" nil t) - ;; ) - ;; (let ((codesys - ;; (intern (buffer-substring - ;; (match-beginning 1)(match-end 1))))) - ;; (if (find-coding-system codesys) codesys)) - ;; ))) - (let ((case-fold-search nil)) - (if (search-forward - ";;;###coding system: " (+ (point-min) 3000) t) - (let ((start (point)) - (end (progn - (skip-chars-forward "^ \t\n\r") - (point)))) - (if (> end start) - (let ((codesys (intern (buffer-substring start end)))) - (if (find-coding-system codesys) codesys))) - ))) - ))) - -(defun load (file &optional noerror nomessage nosuffix) - "Execute a file of Lisp code named FILE. -First tries FILE with .elc appended, then tries with .el, - then tries FILE unmodified. Searches directories in load-path. -If optional second arg NOERROR is non-nil, - report no error if FILE doesn't exist. -Print messages at start and end of loading unless - optional third arg NOMESSAGE is non-nil. -If optional fourth arg NOSUFFIX is non-nil, don't try adding - suffixes .elc or .el to the specified name FILE. -Return t if file exists." - (let* ((filename (substitute-in-file-name file)) - (handler (find-file-name-handler filename 'load)) - (path nil)) - (if handler - (funcall handler 'load filename noerror nomessage nosuffix) - (if (or (<= (length filename) 0) - (null (setq path - (locate-file filename load-path - (and (not nosuffix) ".elc:.el:"))))) - (and (null noerror) - (signal 'file-error (list "Cannot open load file" filename))) - ;; now use the internal load to actually load the file. - (load-internal - file noerror nomessage nosuffix - (let ((elc ; use string= instead of string-match to keep match-data. - (string= ".elc" (downcase (substring path -4))))) - (or (and (not elc) coding-system-for-read) ; prefer for source file - ;; find magic-cookie - (save-excursion - (set-buffer (get-buffer-create " *load*")) - (erase-buffer) - (let ((coding-system-for-read 'no-conversion)) - (insert-file-contents path nil 1 3001)) - (find-coding-system-magic-cookie)) - (if elc - ;; if reading a byte-compiled file and we didn't find - ;; a coding-system magic cookie, then use `binary'. - ;; We need to guarantee that we never do autodetection - ;; on byte-compiled files because confusion here would - ;; be a very bad thing. Pre-existing byte-compiled - ;; files are always in the `binary' coding system. - ;; Also, byte-compiled files always use `lf' to terminate - ;; a line; don't risk confusion here either. - 'binary - (or (find-file-coding-system-for-read-from-filename path) - ;; looking up in `file-coding-system-alist'. - ;; otherwise use `buffer-file-coding-system-for-read', - ;; as normal - buffer-file-coding-system-for-read) - ))) - ))))) - -(defvar insert-file-contents-access-hook nil - "A hook to make a file accessible before reading it. -`insert-file-contents' calls this hook before doing anything else. -Called with two arguments: FILENAME and VISIT, the same as the -corresponding arguments in the call to `insert-file-contents'.") - -(defvar insert-file-contents-pre-hook nil - "A special hook to decide the coding system used for reading in a file. - -Before reading a file, `insert-file-contents' calls the functions on -this hook with arguments FILENAME and VISIT, the same as the -corresponding arguments in the call to `insert-file-contents'. In -these functions, you may refer to the global variable -`buffer-file-coding-system-for-read'. - -The return value of the functions should be either - --- nil --- A coding system or a symbol denoting it, indicating the coding system - to be used for reading the file --- A list of two elements (absolute pathname and length of data inserted), - which is used as the return value to `insert-file-contents'. In this - case, `insert-file-contents' assumes that the function has inserted - the file for itself and suppresses further reading. - -If any function returns non-nil, the remaining functions are not called.") - -(defvar insert-file-contents-error-hook nil - "A hook to set `buffer-file-coding-system' when a read error has occurred. - -When a file error (e.g. nonexistent file) occurs while read a file, -`insert-file-contents' calls the functions on this hook with three -arguments: FILENAME and VISIT (the same as the corresponding arguments -in the call to `insert-file-contents') and a cons (SIGNALED-CONDITIONS -. SIGNAL-DATA). - -After calling this hook, the error is signalled for real and -propagates to the caller of `insert-file-contents'.") - -(defvar insert-file-contents-post-hook nil - "A hook to set `buffer-file-coding-system' for the current buffer. - -After successful reading, `insert-file-contents' calls the functions -on this hook with four arguments: FILENAME and VISIT (the same as the -corresponding arguments in the call to `insert-file-contents'), -CODING-SYSTEM (the actual coding system used to decode the file), and -a cons of absolute pathname and length of data inserted (the same -thing as will be returned from `insert-file-contents').") - -(defun insert-file-contents (filename &optional visit beg end replace) - "Insert contents of file FILENAME after point. -Returns list of absolute file name and length of data inserted. -If second argument VISIT is non-nil, the buffer's visited filename -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. - -NOTE: When Mule support is enabled, the REPLACE argument is -currently ignored. - -The coding system used for decoding the file is determined as follows: - -1. `coding-system-for-read', if non-nil. -2. The result of `insert-file-contents-pre-hook', if non-nil. -3. The matching value for this filename from - `file-coding-system-alist', if any. -4. `buffer-file-coding-system-for-read', if non-nil. -5. The coding system 'no-conversion. - -If a local value for `buffer-file-coding-system' in the current buffer -does not exist, it is set to the coding system which was actually used -for reading. - -See also `insert-file-contents-access-hook', -`insert-file-contents-pre-hook', `insert-file-contents-error-hook', -and `insert-file-contents-post-hook'." - (let (return-val coding-system used-codesys) - ;; OK, first load the file. - (condition-case err - (progn - (run-hook-with-args 'insert-file-contents-access-hook - filename visit) - ;; determine the coding system to use, as described above. - (setq coding-system - (or - ;; #1. - coding-system-for-read - ;; #2. - (run-hook-with-args-until-success - 'insert-file-contents-pre-hook - filename visit) - ;; #3. - (find-file-coding-system-for-read-from-filename filename) - ;; #4. - buffer-file-coding-system-for-read - ;; #5. - 'no-conversion)) - (if (consp coding-system) - (setq return-val coding-system) - (if (null (find-coding-system coding-system)) - (progn - (message - "Invalid coding-system (%s), using 'undecided" - coding-system) - (setq coding-system 'undecided))) - (setq return-val - (insert-file-contents-internal filename visit beg end - replace coding-system - ;; store here! - 'used-codesys)) - )) - (file-error - (run-hook-with-args 'insert-file-contents-error-hook - filename visit err) - (signal (car err) (cdr err)))) - (setq coding-system used-codesys) - ;; call any `post-read-conversion' for the coding system that - ;; was used ... - (let ((func - (coding-system-property coding-system 'post-read-conversion)) - (endmark (make-marker))) - (set-marker endmark (+ (point) (nth 1 return-val))) - (if func - (unwind-protect - (save-excursion - (let (buffer-read-only) - (funcall func (point) (marker-position endmark)))) - (if visit - (progn - (set-buffer-auto-saved) - (set-buffer-modified-p nil))))) - (setcar (cdr return-val) (- (marker-position endmark) (point)))) - ;; now finally set the buffer's `buffer-file-coding-system'. - (if (run-hook-with-args-until-success 'insert-file-contents-post-hook - filename visit return-val) - nil - (if (local-variable-p 'buffer-file-coding-system (current-buffer)) - ;; if buffer-file-coding-system is already local, just - ;; set its eol type to what was found, if it wasn't - ;; set already. - (set-buffer-file-coding-system - (subsidiary-coding-system buffer-file-coding-system - (coding-system-eol-type coding-system))) - ;; otherwise actually set buffer-file-coding-system. - (set-buffer-file-coding-system coding-system))) - return-val)) - -(defvar write-region-pre-hook nil - "A special hook to decide the coding system used for writing out a file. - -Before writing a file, `write-region' calls the functions on this hook -with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYSTEM, -the same as the corresponding arguments in the call to -`write-region'. - -The return value of the functions should be either - --- nil --- A coding system or a symbol denoting it, indicating the coding system - to be used for reading the file --- A list of two elements (absolute pathname and length of data written), - which is used as the return value to `write-region'. In this - case, `write-region' assumes that the function has written - the file for itself and suppresses further writing. - -If any function returns non-nil, the remaining functions are not called.") - -(defvar write-region-post-hook nil - "A hook called by `write-region' after a file has been written out. - -The functions on this hook are called with arguments START, END, -FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the -corresponding arguments in the call to `write-region'.") - -(defun write-region (start end filename &optional append visit lockname coding-system) - "Write current region into specified file. -By default the file's existing contents are replaced by the specified region. -When called from a program, takes three arguments: -START, END and FILENAME. START and END are buffer positions. -Optional fourth argument APPEND if non-nil means - append to existing file contents (if any). -Optional fifth argument VISIT if t means - set last-save-file-modtime of buffer to this file's modtime - and mark buffer not modified. -If VISIT is a string, it is a second file name; - the output goes to FILENAME, but the buffer is marked as visiting VISIT. - VISIT is also the file name to lock and unlock for clash detection. -If VISIT is neither t nor nil nor a string, - that means do not print the \"Wrote file\" message. -The optional sixth arg LOCKNAME, if non-nil, specifies the name to - use for locking and unlocking, overriding FILENAME and VISIT. -Kludgy feature: if START is a string, then that string is written -to the file, instead of any buffer contents, and END is ignored. -Optional seventh argument CODING-SYSTEM specifies the coding system - used to encode the text when it is written out, and defaults to - the value of `buffer-file-coding-system' in the current buffer. - Interactively, with a prefix arg, you will be prompted for the - coding system. -See also `write-region-pre-hook' and `write-region-post-hook'." - (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") - (setq coding-system - (or coding-system-for-write - (run-hook-with-args-until-success - 'write-region-pre-hook start end filename append visit lockname) - coding-system - buffer-file-coding-system - (find-file-coding-system-for-write-from-filename filename) - )) - (if (consp coding-system) - coding-system - (let ((func - (coding-system-property coding-system 'pre-write-conversion))) - (if func - (let ((curbuf (current-buffer)) - (tempbuf (generate-new-buffer " *temp-write-buffer*")) - (modif (buffer-modified-p))) - (unwind-protect - (save-excursion - (set-buffer tempbuf) - (erase-buffer) - (insert-buffer-substring curbuf start end) - (funcall func (point-min) (point-max)) - (write-region-internal (point-min) (point-max) filename - append - (if (eq visit t) nil visit) - lockname - coding-system)) - ;; leaving a buffer associated with file will cause problems - ;; when next visiting. - (kill-buffer tempbuf) - (if (or visit (null modif)) - (progn - (set-buffer-auto-saved) - (set-buffer-modified-p nil) - (if (buffer-file-name) (set-visited-file-modtime)))))) - (write-region-internal start end filename append visit lockname - coding-system))) - (run-hook-with-args 'write-region-post-hook - start end filename append visit lockname - coding-system))) - -;;; mule-files.el ends here diff --git a/lisp/code-process.el b/lisp/code-process.el deleted file mode 100644 index d96ecea..0000000 --- a/lisp/code-process.el +++ /dev/null @@ -1,250 +0,0 @@ -;;; code-process.el --- Process coding functions for XEmacs. - -;; Copyright (C) 1985-1987, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Author: Ben Wing -;; MORIOKA Tomohiko -;; Maintainer: XEmacs Development Team -;; Keywords: mule, multilingual, coding system, process - -;; This file is part of XEmacs. - -;; This file is very similar to code-process.el - -;; 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: - -(eval-when-compile - (defvar buffer-file-type) - (defvar binary-process-output)) - -(defvar process-coding-system-alist nil - "Alist to decide a coding system to use for a process I/O operation. -The format is ((PATTERN . VAL) ...), -where PATTERN is a regular expression matching a program name, -VAL is a coding system, a cons of coding systems, or a function symbol. -If VAL is a coding system, it is used for both decoding what received -from the program and encoding what sent to the program. -If VAL is a cons of coding systems, the car part is used for decoding, -and the cdr part is used for encoding. -If VAL is a function symbol, the function must return a coding system -or a cons of coding systems which are used as above.") - -(defun call-process (program &optional infile buffer displayp &rest args) - "Call PROGRAM synchronously in separate process. -The program's input comes from file INFILE (nil means `/dev/null'). -Insert output in BUFFER before point; t means current buffer; - nil for BUFFER means discard it; 0 means discard and don't wait. -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted. -Remaining arguments are strings passed as command arguments to PROGRAM. - -If BUFFER is 0, `call-process' returns immediately with value nil. -Otherwise it waits for PROGRAM to terminate and returns a numeric exit status - or a signal description string. -If you quit, the process is killed with SIGINT, or SIGKILL if you - quit again." - (let* ((coding-system-for-read - (or coding-system-for-read - (let (ret) - (catch 'found - (let ((alist process-coding-system-alist) - (case-fold-search nil)) - (while alist - (if (string-match (car (car alist)) program) - (throw 'found (setq ret (cdr (car alist)))) - ) - (setq alist (cdr alist)) - ))) - (if (functionp ret) - (setq ret (funcall ret 'call-process program)) - ) - (cond ((consp ret) (car ret)) - ((not ret) 'undecided) - ((find-coding-system ret) ret) - ) - )))) - (apply 'call-process-internal program infile buffer displayp args) - )) - -(defun call-process-region (start end program - &optional deletep buffer displayp - &rest args) - "Send text from START to END to a synchronous process running PROGRAM. -Delete the text if fourth arg DELETEP is non-nil. - -Insert output in BUFFER before point; t means current buffer; - nil for BUFFER means discard it; 0 means discard and don't wait. -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted. -Remaining args are passed to PROGRAM at startup as command args. - -If BUFFER is 0, returns immediately with value nil. -Otherwise waits for PROGRAM to terminate -and returns a numeric exit status or a signal description string. -If you quit, the process is first killed with SIGINT, then with SIGKILL if -you quit again before the process exits." - (let ((temp - (make-temp-name - (concat (file-name-as-directory (temp-directory)) - (if (memq system-type '(ms-dos windows-nt)) "em" "emacs"))))) - (unwind-protect - (let (cs-r cs-w) - (let (ret) - (catch 'found - (let ((alist process-coding-system-alist) - (case-fold-search nil)) - (while alist - (if (string-match (car (car alist)) program) - (throw 'found (setq ret (cdr (car alist))))) - (setq alist (cdr alist)) - ))) - (if (functionp ret) - (setq ret (funcall ret 'call-process-region program))) - (cond ((consp ret) - (setq cs-r (car ret) - cs-w (cdr ret))) - ((find-coding-system ret) - (setq cs-r ret - cs-w ret)))) - (let ((coding-system-for-read - (or coding-system-for-read cs-r)) - (coding-system-for-write - (or coding-system-for-write cs-w))) - (if (memq system-type '(ms-dos windows-nt)) - (let ((buffer-file-type binary-process-output)) - (write-region start end temp nil 'silent)) - (write-region start end temp nil 'silent)) - (if deletep (delete-region start end)) - (apply #'call-process program temp buffer displayp args))) - (ignore-file-errors (delete-file temp))))) - -(defun start-process (name buffer program &rest program-args) - "Start a program in a subprocess. Return the process object for it. -Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS -NAME is name for process. It is modified if necessary to make it unique. -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 program file name. It is searched for as in the shell. -Remaining arguments are strings to give program as arguments. -INCODE and OUTCODE specify the coding-system objects used in input/output - from/to the process." - (let (cs-r cs-w) - (let (ret) - (catch 'found - (let ((alist process-coding-system-alist) - (case-fold-search nil)) - (while alist - (if (string-match (car (car alist)) program) - (throw 'found (setq ret (cdr (car alist))))) - (setq alist (cdr alist)) - ))) - (if (functionp ret) - (setq ret (funcall ret 'start-process program))) - (cond ((consp ret) - (setq cs-r (car ret) - cs-w (cdr ret))) - ((find-coding-system ret) - (setq cs-r ret - cs-w ret)))) - (let ((coding-system-for-read - (or coding-system-for-read cs-r 'undecided)) - (coding-system-for-write - (or coding-system-for-write cs-w))) - (apply 'start-process-internal name buffer program program-args) - ))) - -(defvar network-coding-system-alist nil - "Alist to decide a coding system to use for a network I/O operation. -The format is ((PATTERN . VAL) ...), -where PATTERN is a regular expression matching a network service name -or is a port number to connect to, -VAL is a coding system, a cons of coding systems, or a function symbol. -If VAL is a coding system, it is used for both decoding what received -from the network stream and encoding what sent to the network stream. -If VAL is a cons of coding systems, the car part is used for decoding, -and the cdr part is used for encoding. -If VAL is a function symbol, the function must return a coding system -or a cons of coding systems which are used as above. - -See also the function `find-operation-coding-system'.") - -(defun open-network-stream (name buffer host service) - "Open a TCP connection for a service to a host. -Returns a subprocess-object to represent the connection. -Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. -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 SERVICE is name of the service desired, or an integer - specifying a port number to connect to." - (let (cs-r cs-w) - (let (ret) - (catch 'found - (let ((alist network-coding-system-alist) - (case-fold-search nil) - pattern) - (while alist - (setq pattern (car (car alist))) - (and - (cond ((numberp pattern) - (and (numberp service) - (eq pattern service))) - ((stringp pattern) - (or (and (stringp service) - (string-match pattern service)) - (and (numberp service) - (string-match pattern - (number-to-string service)))))) - (throw 'found (setq ret (cdr (car alist))))) - (setq alist (cdr alist)) - ))) - (if (functionp ret) - (setq ret (funcall ret 'open-network-stream service))) - (cond ((consp ret) - (setq cs-r (car ret) - cs-w (cdr ret))) - ((find-coding-system ret) - (setq cs-r ret - cs-w ret)))) - (let ((coding-system-for-read - (or coding-system-for-read cs-r)) - (coding-system-for-write - (or coding-system-for-write cs-w))) - (open-network-stream-internal name buffer host service)))) - -;;; mule-process.el ends here diff --git a/lisp/coding.el b/lisp/coding.el deleted file mode 100644 index 7a5856d..0000000 --- a/lisp/coding.el +++ /dev/null @@ -1,214 +0,0 @@ -;;; coding.el --- Coding-system functions for XEmacs. - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; This file is part of XEmacs. - -;; This file is very similar to mule-coding.el - -;; 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: - -;;; split off of mule.el. - -;;; Code: - -(defalias 'check-coding-system 'get-coding-system) - -(defconst modeline-multibyte-status '("%C") - "Modeline control for showing multibyte extension status.") - -;; override the default value defined in loaddefs.el. -(setq-default modeline-format - (cons (purecopy "") - (cons 'modeline-multibyte-status - (cdr modeline-format)))) - -(defun modify-coding-system-alist (target-type regexp coding-system) - "Modify one of look up tables for finding a coding system on I/O operation. -There are three of such tables, `file-coding-system-alist', -`process-coding-system-alist', and `network-coding-system-alist'. - -TARGET-TYPE specifies which of them to modify. -If it is `file', it affects `file-coding-system-alist' (which see). -If it is `process', it affects `process-coding-system-alist' (which see). -If it is `network', it affects `network-codign-system-alist' (which see). - -REGEXP is a regular expression matching a target of I/O operation. -The target is a file name if TARGET-TYPE is `file', a program name if -TARGET-TYPE is `process', or a network service name or a port number -to connect to if TARGET-TYPE is `network'. - -CODING-SYSTEM is a coding system to perform code conversion on the I/O -operation, or a cons cell (DECODING . ENCODING) specifying the coding systems -for decoding and encoding respectively, -or a function symbol which, when called, returns such a cons cell." - (or (memq target-type '(file process network)) - (error "Invalid target type: %s" target-type)) - (or (stringp regexp) - (and (eq target-type 'network) (integerp regexp)) - (error "Invalid regular expression: %s" regexp)) - (if (symbolp coding-system) - (if (not (fboundp coding-system)) - (progn - (check-coding-system coding-system) - (setq coding-system (cons coding-system coding-system)))) - (check-coding-system (car coding-system)) - (check-coding-system (cdr coding-system))) - (cond ((eq target-type 'file) - (let ((slot (assoc regexp file-coding-system-alist))) - (if slot - (setcdr slot coding-system) - (setq file-coding-system-alist - (cons (cons regexp coding-system) - file-coding-system-alist))))) - ((eq target-type 'process) - (let ((slot (assoc regexp process-coding-system-alist))) - (if slot - (setcdr slot coding-system) - (setq process-coding-system-alist - (cons (cons regexp coding-system) - process-coding-system-alist))))) - (t - (let ((slot (assoc regexp network-coding-system-alist))) - (if slot - (setcdr slot coding-system) - (setq network-coding-system-alist - (cons (cons regexp coding-system) - network-coding-system-alist))))))) - -(defsubst keyboard-coding-system () - "Return coding-system of what is sent from terminal keyboard." - keyboard-coding-system) - -(defun set-keyboard-coding-system (coding-system) - "Set the coding system used for TTY keyboard input. Currently broken." - (interactive "zkeyboard-coding-system: ") - (get-coding-system coding-system) ; correctness check - (setq keyboard-coding-system coding-system) - (redraw-modeline t)) - -(defsubst terminal-coding-system () - "Return coding-system of your terminal." - terminal-coding-system) - -(defun set-terminal-coding-system (coding-system) - "Set the coding system used for TTY display output. Currently broken." - (interactive "zterminal-coding-system: ") - (get-coding-system coding-system) ; correctness check - (setq terminal-coding-system coding-system) - (set-console-tty-coding-system (device-console) terminal-coding-system) - (redraw-modeline t)) - -(defun set-pathname-coding-system (coding-system) - "Set the coding system used for file system path names." - (interactive "zPathname-coding-system: ") - (get-coding-system coding-system) ; correctness check - (setq file-name-coding-system coding-system)) - -(defun what-coding-system (start end &optional arg) - "Show the encoding of text in the region. -This function is meant to be called interactively; -from a Lisp program, use `detect-coding-region' instead." - (interactive "r\nP") - (princ (detect-coding-region start end))) - -(defun decode-coding-string (str coding-system) - "Decode the string STR which is encoded in CODING-SYSTEM. -Does not modify STR. Returns the decoded string on successful conversion." - (with-string-as-buffer-contents - str (decode-coding-region (point-min) (point-max) coding-system))) - -(defun encode-coding-string (str coding-system) - "Encode the string STR using CODING-SYSTEM. -Does not modify STR. Returns the encoded string on successful conversion." - (with-string-as-buffer-contents - str (encode-coding-region (point-min) (point-max) coding-system))) - - -;;;; Coding system accessors - -(defun coding-system-mnemonic (coding-system) - "Return the 'mnemonic property of CODING-SYSTEM." - (coding-system-property coding-system 'mnemonic)) - -(defalias 'coding-system-docstring 'coding-system-doc-string) - -(defun coding-system-eol-type (coding-system) - "Return the 'eol-type property of CODING-SYSTEM." - (coding-system-property coding-system 'eol-type)) - -(defun coding-system-eol-lf (coding-system) - "Return the 'eol-lf property of CODING-SYSTEM." - (coding-system-property coding-system 'eol-lf)) - -(defun coding-system-eol-crlf (coding-system) - "Return the 'eol-crlf property of CODING-SYSTEM." - (coding-system-property coding-system 'eol-crlf)) - -(defun coding-system-eol-cr (coding-system) - "Return the 'eol-cr property of CODING-SYSTEM." - (coding-system-property coding-system 'eol-cr)) - -(defun coding-system-post-read-conversion (coding-system) - "Return the 'post-read-conversion property of CODING-SYSTEM." - (coding-system-property coding-system 'post-read-conversion)) - -(defun coding-system-pre-write-conversion (coding-system) - "Return the 'pre-write-conversion property of CODING-SYSTEM." - (coding-system-property coding-system 'pre-write-conversion)) - -(defun coding-system-base (coding-system) - "Return the base coding system of CODING-SYSTEM." - (if (not (coding-system-eol-type coding-system)) - coding-system - (find-coding-system - (intern - (substring - (symbol-name (coding-system-name coding-system)) - 0 - (string-match "-unix$\\|-dos$\\|-mac$" - (symbol-name (coding-system-name coding-system)))))))) - -;;;; Definitions of predefined coding systems - -(make-coding-system - 'undecided 'undecided - "Automatic conversion." - '(mnemonic "Auto")) - -;; these are so that gnus and friends work when not mule -(or (featurep 'mule) - (progn - (copy-coding-system 'undecided 'iso-8859-1) - (copy-coding-system 'undecided 'iso-8859-2))) - -;; compatibility for old XEmacsen (don't use it) -(copy-coding-system 'undecided 'automatic-conversion) - -(copy-coding-system 'no-conversion 'raw-text) - -(make-compatible-variable 'enable-multibyte-characters "Unimplemented") - -(define-obsolete-variable-alias - 'pathname-coding-system 'file-name-coding-system) - -;;; mule-coding.el ends here diff --git a/lisp/config.el b/lisp/config.el deleted file mode 100644 index 6952081..0000000 --- a/lisp/config.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; config.el --- access configuration parameters - -;; Copyright (C) 1997 Sun Microsystems, Inc. - -;; Author: Martin Buchholz -;; Keywords: 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: - -;;; Code: - - -(defvar config-value-file (expand-file-name "config.values" exec-directory) - "File containing configuration parameters and their values.") - -(defvar config-value-hash-table nil - "Hash table to store configuration parameters and their values.") - -;;;###autoload -(defun config-value-hash-table () - "Return hash table of configuration parameters and their values." - (when (null config-value-hash-table) - (setq config-value-hash-table (make-hash-table :size 300)) - (save-excursion - (let ((buf (get-buffer-create " *Config*"))) - (set-buffer buf) - (erase-buffer) - (insert-file-contents config-value-file) - (goto-char (point-min)) - (condition-case nil - (while t - (let* ((key (read buf)) - (value (read buf)) - (prev (gethash key config-value-hash-table))) - (cond ((null prev) - (puthash key value config-value-hash-table)) - ((atom prev) - (puthash key (list prev value) config-value-hash-table)) - (t - (nconc prev (list value)))))) - (end-of-file nil))) - (kill-buffer " *Config*"))) - config-value-hash-table) - -;;;###autoload -(defun config-value (config-symbol) - "Return the value of the configuration parameter CONFIG_SYMBOL." - (gethash config-symbol (config-value-hash-table))) - -(provide 'config) -;;; config.el ends here diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el deleted file mode 100644 index 8dab0cf..0000000 --- a/lisp/cus-dep.el +++ /dev/null @@ -1,186 +0,0 @@ -;;; cus-dep.el --- Find customization dependencies. -;; -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen , then -;; Richard Stallman , then -;; Hrvoje Niksic (rewritten for XEmacs) -;; Maintainer: Hrvoje Niksic -;; 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 with FSF. - - -;;; Commentary: - -;; This file generates the custom-load files, loaded by cus-load.el. -;; The only entry point is `Custom-make-dependencies'. - -;; It works by scanning all the `.el' files in a directory, and -;; evaluates any `defcustom', `defgroup', or `defface' expression that -;; it finds. The symbol changed by this expression is stored to a -;; hash table as the hash key, file name being the value. - -;; After all the files have been examined, custom-loads.el is -;; generated by mapping all the atoms, and seeing if any of them -;; contains a `custom-group' property. This property is a list whose -;; each element's car is the "child" group symbol. If that property -;; is in the hash-table, the file name will be looked up from the -;; hash-table, and added to cusload-file. Because the hash-table is -;; cleared whenever we process a new directory, we cannot get confused -;; by custom-loads from another directory, or from a previous -;; installation. This is also why it is perfectly safe to have old -;; custom-loads around, and have them loaded by `cus-load.el' (as -;; invoked by `cus-edit.el'). - -;; A trivial, but useful optimization is that if cusload-file exists, -;; and no .el files in the directory are newer than cusload-file, it -;; will not be generated. This means that the directories where -;; nothing has changed will be skipped. - -;; The `custom-add-loads' function, used by files generated by -;; `Custom-make-dependencies', updates the symbol's `custom-loads' -;; property (a list of strings) with a new list of strings, -;; eliminating the duplicates. Additionally, it adds the symbol to -;; `custom-group-hash-table'. It is defined in `cus-load.el'. - -;; Example: - -;; (custom-add-loads 'foo 'custom-loads '("bar" "baz")) -;; (get 'foo 'custom-loads) -;; => ("bar" "baz") -;; -;; (custom-add-loads 'foo 'custom-loads '("hmph" "baz" "quz")) -;; (get 'foo 'custom-loads) -;; => ("bar" "baz" "hmph" "qux") - -;; Obviously, this allows correct incremental loading of custom-load -;; files. This is not necessary under FSF (they simply use `put'), -;; since they have only one file with custom dependencies. With the -;; advent of packages, we cannot afford the same luxury. - - -;;; Code: - -(require 'cl) -(require 'widget) -(require 'cus-face) - -;; Don't change this, unless you plan to change the code in -;; cus-start.el, too. -(defconst cusload-base-file "custom-load.el") - -;; Be very careful when changing this function. It looks easy to -;; understand, but is in fact very easy to break. Be sure to read and -;; understand the commentary above! - -;;;###autoload -(defun Custom-make-dependencies (&optional subdirs) - "Extract custom dependencies from .el files in SUBDIRS. -SUBDIRS is a list of directories. If it is nil, the command-line -arguments are used. If it is a string, only that directory is -processed. This function is especially useful in batch mode. - -Batch usage: xemacs -batch -l cus-dep.el -f Custom-make-dependencies DIRS" - (interactive "DDirectory: ") - (and (stringp subdirs) - (setq subdirs (list subdirs))) - (or subdirs - ;; Usurp the command-line-args - (setq subdirs command-line-args-left - command-line-args-left nil)) - (setq subdirs (mapcar #'expand-file-name subdirs)) - (with-temp-buffer - (let ((enable-local-eval nil) - (hash (make-hash-table :test 'eq))) - (dolist (dir subdirs) - (princ (format "Processing %s\n" dir)) - (let ((cusload-file (expand-file-name cusload-base-file dir)) - (files (directory-files dir t "\\`[^=].*\\.el\\'"))) - ;; A trivial optimization: if no file in the directory is - ;; newer than custom-load.el, no need to do anything! - (if (and (file-exists-p cusload-file) - (dolist (file files t) - (when (file-newer-than-file-p file cusload-file) - (return nil)))) - (princ "(No changes need to be written)\n") - ;; Process directory - (dolist (file files) - (when (file-exists-p file) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (let ((name (file-name-sans-extension - (file-name-nondirectory file)))) - ;; Search for defcustom/defface/defgroup - ;; expressions, and evaluate them. - (while (re-search-forward - "^(defcustom\\|^(defface\\|^(defgroup" - nil t) - (beginning-of-line) - (let ((expr (read (current-buffer)))) - ;; We need to ignore errors here, so that - ;; defcustoms with :set don't bug out. Of - ;; course, their values will not be assigned in - ;; case of errors, but their `custom-group' - ;; properties will by that time be in place, and - ;; that's all we care about. - (ignore-errors - (eval expr)) - ;; Hash the file of the affected symbol. - (setf (gethash (nth 1 expr) hash) name)))))) - (cond - ((zerop (hash-table-count hash)) - (princ "(No customization dependencies") - (when (file-exists-p cusload-file) - (princ (format ", deleting %s" cusload-file)) - (delete-file cusload-file)) - (princ ")\n")) - (t - (princ (format "Generating %s...\n" cusload-base-file)) - (with-temp-file cusload-file - (insert ";;; " cusload-base-file - " --- automatically extracted custom dependencies\n" - "\n;;; Code:\n\n") - (mapatoms - (lambda (sym) - (let ((members (get sym 'custom-group)) - item where found) - (when members - (while members - (setq item (car (car members)) - members (cdr members) - where (gethash item hash)) - (unless (or (null where) - (member where found)) - (if found - (insert " ") - (insert "(custom-add-loads '" - (symbol-name sym) " '(")) - (prin1 where (current-buffer)) - (push where found))) - (when found - (insert "))\n")))))) - (insert "\n;;; custom-load.el ends here\n")) - (clrhash hash))))))))) - -(provide 'cus-dep) - -;;; cus-dep.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el deleted file mode 100644 index f7ebcea..0000000 --- a/lisp/cus-edit.el +++ /dev/null @@ -1,3269 +0,0 @@ -;;; cus-edit.el --- Tools for customizating Emacs and Lisp packages. -;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic -;; Keywords: help, faces -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -;; 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 file implements the code to create and edit customize buffers. -;; -;; See `custom.el'. - -;; No commands should have names starting with `custom-' because -;; that interferes with completion. Use `customize-' for commands -;; that the user will run with M-x, and `Custom-' for interactive commands. - -;; NOTE: In many places within this file we use `mapatoms', which is -;; very slow in an average XEmacs because of the large number of -;; symbols requiring a large number of funcalls -- XEmacs with Gnus -;; can grow to some 17000 symbols without ever doing anything fancy. -;; It would probably pay off to make a hash table of symbols known to -;; Custom, similar to custom-group-hash-table. - -;; This is not top priority, because none of the functions that do -;; mapatoms are speed-critical (the one that was now uses -;; custom-group-hash-table), but it would be nice to have. - - -;;; Code: - -(require 'cus-face) -(require 'wid-edit) -(require 'easymenu) - -(require 'cus-load) -(require 'cus-start) - -;; Huh? This looks dirty! -(put 'custom-define-hook 'custom-type 'hook) -(put 'custom-define-hook 'standard-value '(nil)) -(custom-add-to-group 'customize 'custom-define-hook 'custom-variable) - -;;; Customization Groups. - -(defgroup emacs nil - "Customization of the One True Editor." - :link '(custom-manual "(XEmacs)Top")) - -;; Most of these groups are stolen from `finder.el', -(defgroup editing nil - "Basic text editing facilities." - :group 'emacs) - -(defgroup matching nil - "Various sorts of searching and matching." - :group 'editing) - -(defgroup emulations nil - "Emulations of other editors." - :group 'editing) - -(defgroup outlines nil - "Support for hierarchical outlining." - :group 'editing) - -(defgroup external nil - "Interfacing to external utilities." - :group 'emacs) - -(defgroup bib nil - "Code related to the `bib' bibliography processor." - :tag "Bibliography" - :group 'external) - -(defgroup programming nil - "Support for programming in other languages." - :group 'emacs) - -(defgroup languages nil - "Specialized modes for editing programming languages." - :group 'programming) - -;; #### This should be in cc-vars.el -(defgroup c nil - "Support for the C language and related languages." - :group 'languages) - -(defgroup tools nil - "Programming tools." - :group 'programming) - -(defgroup oop nil - "Support for object-oriented programming." - :group 'programming) - -(defgroup applications nil - "Applications written in Emacs." - :group 'emacs) - -;; #### This should be in calendar.el -(defgroup calendar nil - "Calendar and time management support." - :group 'applications) - -(defgroup mail nil - "Modes for electronic-mail handling." - :group 'applications) - -(defgroup news nil - "Support for netnews reading and posting." - :group 'applications) - -(defgroup games nil - "Games, jokes and amusements." - :group 'applications) - -(defgroup development nil - "Support for further development of Emacs." - :group 'emacs) - -(defgroup docs nil - "Support for Emacs documentation." - :group 'development) - -(defgroup extensions nil - "Emacs Lisp language extensions." - :group 'development) - -(defgroup internal nil - "Code for Emacs internals, build process, defaults." - :group 'development) - -(defgroup maint nil - "Maintenance aids for the Emacs development group." - :tag "Maintenance" - :group 'development) - -(defgroup environment nil - "Fitting Emacs with its environment." - :group 'emacs) - -(defgroup comm nil - "Communications, networking, remote access to files." - :tag "Communication" - :group 'environment) - -(defgroup hardware nil - "Support for interfacing with exotic hardware." - :group 'environment) - -(defgroup terminals nil - "Support for terminal types." - :group 'environment) - -(defgroup unix nil - "Front-ends/assistants for, or emulators of, UNIX features." - :group 'environment) - -(defgroup i18n nil - "Internationalization and alternate character-set support." - :group 'environment - :group 'editing) - -(defgroup data nil - "Support editing files of data." - :group 'emacs) - -(defgroup wp nil - "Word processing." - :group 'emacs) - -(defgroup tex nil - "Code related to the TeX formatter." - :group 'wp) - -(defgroup hypermedia nil - "Support for links between text or other media types." - :group 'emacs) - -(defgroup local nil - "Code local to your site." - :group 'emacs) - -(defgroup customize '((widgets custom-group)) - "Customization of the Customization support." - :link '(custom-manual "(custom)Top") - :link '(url-link :tag "Development Page" - "http://www.dina.kvl.dk/~abraham/custom/") - :prefix "custom-" - :group 'help) - -(defgroup custom-faces nil - "Faces used by customize." - :group 'customize - :group 'faces) - -(defgroup custom-browse nil - "Control customize browser." - :prefix "custom-" - :group 'customize) - -(defgroup custom-buffer nil - "Control customize buffers." - :prefix "custom-" - :group 'customize) - -(defgroup custom-menu nil - "Control customize menus." - :prefix "custom-" - :group 'customize) - -(defgroup alloc nil - "Storage allocation and gc for GNU Emacs Lisp interpreter." - :tag "Storage Allocation" - :group 'internal) - -(defgroup undo nil - "Undoing changes in buffers." - :group 'editing) - -(defgroup editing-basics nil - "Most basic editing facilities." - :group 'editing) - -(defgroup display nil - "How characters are displayed in buffers." - :group 'environment) - -(defgroup installation nil - "The Emacs installation." - :group 'environment) - -(defgroup limits nil - "Internal Emacs limits." - :group 'internal) - -(defgroup debug nil - "Debugging Emacs itself." - :group 'development) - -(defgroup mule nil - "Mule XEmacs internationalization." - :group 'i18n) - - -;;; Utilities. - -(defun custom-quote (sexp) - "Quote SEXP iff it is not self quoting." - (if (or (memq sexp '(t nil)) - (keywordp sexp) - (eq (car-safe sexp) 'lambda) - (stringp sexp) - (numberp sexp) - (characterp sexp) - (vectorp sexp) - (bit-vector-p sexp)) - sexp - (list 'quote sexp))) - -(defun custom-split-regexp-maybe (regexp) - "If REGEXP is a string, split it to a list at `\\|'. -You can get the original back with from the result with: - (mapconcat #'identity result \"\\|\") - -IF REGEXP is not a string, return it unchanged." - (if (stringp regexp) - (split-string regexp "\\\\|") - regexp)) - -(defun custom-variable-prompt () - ;; Code stolen from `help.el'. - "Prompt for a variable, defaulting to the variable at point. -Return a list suitable for use in `interactive'." - (let ((v (variable-at-point)) - (enable-recursive-minibuffers t) - val) - (setq val (completing-read - (if (symbolp v) - (format "Customize variable: (default %s) " v) - "Customize variable: ") - obarray (lambda (symbol) - (and (boundp symbol) - (or (get symbol 'custom-type) - (user-variable-p symbol)))) t)) - (list (if (equal val "") - (if (symbolp v) v nil) - (intern val))))) - -;; Here we take not only the actual groups, but the loads, too. -(defun custom-group-prompt (prompt) - "Read group from minibuffer." - (let ((completion-ignore-case t)) - (list (completing-read - prompt obarray - (lambda (symbol) - (or (get symbol 'custom-group) - (get symbol 'custom-loads))) - t)))) - -(defun custom-menu-filter (menu widget) - "Convert MENU to the form used by `widget-choose'. -MENU should be in the same format as `custom-variable-menu'. -WIDGET is the widget to apply the filter entries of MENU on." - (let ((result nil) - current name action filter) - (while menu - (setq current (car menu) - name (nth 0 current) - action (nth 1 current) - filter (nth 2 current) - menu (cdr menu)) - (if (or (null filter) (funcall filter widget)) - (push (cons name action) result) - (push name result))) - (nreverse result))) - - -;;; Unlispify. - -(defvar custom-prefix-list nil - "List of prefixes that should be ignored by `custom-unlispify'") - -(defcustom custom-unlispify-menu-entries t - "Display menu entries as words instead of symbols if non nil." - :group 'custom-menu - :type 'boolean) - -(defcustom custom-unlispify-remove-prefixes t - "Non-nil means remove group prefixes from option names in buffers and menus. -This only has an effect when `custom-unlispify-tag-names' or -`custom-unlispify-menu-entries' is on." - :group 'custom-menu - :type 'boolean) - -(defun custom-unlispify-menu-entry (symbol &optional no-suffix) - "Convert symbol into a menu entry." - (cond ((not custom-unlispify-menu-entries) - (symbol-name symbol)) - ((get symbol 'custom-tag) - (if no-suffix - (get symbol 'custom-tag) - (concat (get symbol 'custom-tag) "..."))) - (t - (with-current-buffer (get-buffer-create " *Custom-Work*") - (erase-buffer) - (princ symbol (current-buffer)) - (goto-char (point-min)) - (when (and (eq (get symbol 'custom-type) 'boolean) - (re-search-forward "-p\\'" nil t)) - (replace-match "" t t) - (goto-char (point-min))) - (when custom-unlispify-remove-prefixes - (let ((prefixes custom-prefix-list) - prefix) - (while prefixes - (setq prefix (car prefixes)) - (if (search-forward prefix (+ (point) (length prefix)) t) - (progn - (setq prefixes nil) - (delete-region (point-min) (point))) - (setq prefixes (cdr prefixes)))))) - (subst-char-in-region (point-min) (point-max) ?- ?\ t) - (capitalize-region (point-min) (point-max)) - (unless no-suffix - (goto-char (point-max)) - (insert "...")) - (buffer-string))))) - -(defcustom custom-unlispify-tag-names t - "Display tag names as words instead of symbols if non nil." - :group 'custom-buffer - :type 'boolean) - -(defun custom-unlispify-tag-name (symbol) - "Convert symbol into a menu entry." - (let ((custom-unlispify-menu-entries custom-unlispify-tag-names)) - (custom-unlispify-menu-entry symbol t))) - -(defun custom-prefix-add (symbol prefixes) - ;; Addd SYMBOL to list of ignored PREFIXES. - (cons (or (get symbol 'custom-prefix) - (concat (symbol-name symbol) "-")) - prefixes)) - - -;;; Guess. - -(defcustom custom-guess-name-alist - '(("-p\\'" boolean) - ("-hooks?\\'" hook) - ("-face\\'" face) - ("-file\\'" file) - ("-function\\'" function) - ("-functions\\'" (repeat function)) - ("-list\\'" (repeat sexp)) - ("-alist\\'" (repeat (cons sexp sexp)))) - "Alist of (MATCH TYPE). - -MATCH should be a regexp matching the name of a symbol, and TYPE should -be a widget suitable for editing the value of that symbol. The TYPE -of the first entry where MATCH matches the name of the symbol will be -used. - -This is used for guessing the type of variables not declared with -customize." - :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type"))) - :group 'customize) - -(defcustom custom-guess-doc-alist - '(("\\`\\*?Non-nil " boolean)) - "Alist of (MATCH TYPE). - -MATCH should be a regexp matching a documentation string, and TYPE -should be a widget suitable for editing the value of a variable with -that documentation string. The TYPE of the first entry where MATCH -matches the name of the symbol will be used. - -This is used for guessing the type of variables not declared with -customize." - :type '(repeat (group (regexp :tag "Match") (sexp :tag "Type"))) - :group 'customize) - -(defun custom-guess-type (symbol) - "Guess a widget suitable for editing the value of SYMBOL. -This is done by matching SYMBOL with `custom-guess-name-alist' and -if that fails, the doc string with `custom-guess-doc-alist'." - (let ((name (symbol-name symbol)) - (names custom-guess-name-alist) - current found) - (while names - (setq current (car names) - names (cdr names)) - (when (string-match (nth 0 current) name) - (setq found (nth 1 current) - names nil))) - (unless found - (let ((doc (documentation-property symbol 'variable-documentation)) - (docs custom-guess-doc-alist)) - (when doc - (while docs - (setq current (car docs) - docs (cdr docs)) - (when (string-match (nth 0 current) doc) - (setq found (nth 1 current) - docs nil)))))) - found)) - - -;;; Sorting. - -(defcustom custom-browse-sort-alphabetically nil - "If non-nil, sort members of each customization group alphabetically." - :type 'boolean - :group 'custom-browse) - -(defcustom custom-browse-order-groups nil - "If non-nil, order group members within each customization group. -If `first', order groups before non-groups. -If `last', order groups after non-groups." - :type '(choice (const first) - (const last) - (const :tag "none" nil)) - :group 'custom-browse) - -(defcustom custom-browse-only-groups nil - "If non-nil, show group members only within each customization group." - :type 'boolean - :group 'custom-browse) - -(defcustom custom-buffer-sort-alphabetically nil - "If non-nil, sort members of each customization group alphabetically." - :type 'boolean - :group 'custom-buffer) - -(defcustom custom-buffer-order-groups 'last - "If non-nil, order group members within each customization group. -If `first', order groups before non-groups. -If `last', order groups after non-groups." - :type '(choice (const first) - (const last) - (const :tag "none" nil)) - :group 'custom-buffer) - -(defcustom custom-menu-sort-alphabetically nil - "If non-nil, sort members of each customization group alphabetically." - :type 'boolean - :group 'custom-menu) - -(defcustom custom-menu-order-groups 'first - "If non-nil, order group members within each customization group. -If `first', order groups before non-groups. -If `last', order groups after non-groups." - :type '(choice (const first) - (const last) - (const :tag "none" nil)) - :group 'custom-menu) - -(defun custom-sort-items (items sort-alphabetically order-groups) - "Return a sorted copy of ITEMS. -ITEMS should be a `custom-group' property. -If SORT-ALPHABETICALLY non-nil, sort alphabetically. -If ORDER-GROUPS is `first' order groups before non-groups, if `last' order -groups after non-groups, if nil do not order groups at all." - (sort (copy-sequence items) - (lambda (a b) - (let ((typea (nth 1 a)) (typeb (nth 1 b)) - (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b)))) - (cond ((not order-groups) - ;; Since we don't care about A and B order, maybe sort. - (when sort-alphabetically - (string-lessp namea nameb))) - ((eq typea 'custom-group) - ;; If B is also a group, maybe sort. Otherwise, order A and B. - (if (eq typeb 'custom-group) - (when sort-alphabetically - (string-lessp namea nameb)) - (eq order-groups 'first))) - ((eq typeb 'custom-group) - ;; Since A cannot be a group, order A and B. - (eq order-groups 'last)) - (sort-alphabetically - ;; Since A and B cannot be groups, sort. - (string-lessp namea nameb))))))) - - -;;; Custom Mode Commands. - -(defvar custom-options nil - "Customization widgets in the current buffer.") - -(defun Custom-set () - "Set changes in all modified options." - (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children))) - -(defun Custom-save () - "Set all modified group members and save them." - (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) - children)) - (custom-save-all)) - -(defvar custom-reset-menu - '(("Current" . Custom-reset-current) - ("Saved" . Custom-reset-saved) - ("Standard Settings" . Custom-reset-standard)) - "Alist of actions for the `Reset' button. -The key is a string containing the name of the action, the value is a -lisp function taking the widget as an element which will be called -when the action is chosen.") - -(defun custom-reset (event) - "Select item from reset menu." - (let* ((completion-ignore-case t) - (answer (widget-choose "Reset to" - custom-reset-menu - event))) - (if answer - (funcall answer)))) - -(defun Custom-reset-current (&rest ignore) - "Reset all modified group members to their current value." - (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) - children))) - -(defun Custom-reset-saved (&rest ignore) - "Reset all modified or set group members to their saved value." - (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-saved))) - children))) - -(defun Custom-reset-standard (&rest ignore) - "Reset all modified, set, or saved group members to their standard settings." - (interactive) - (let ((children custom-options)) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-standard))) - children))) - - -;;; The Customize Commands - -(defun custom-prompt-variable (prompt-var prompt-val) - "Prompt for a variable and a value and return them as a list. -PROMPT-VAR is the prompt for the variable, and PROMPT-VAL is the -prompt for the value. The %s escape in PROMPT-VAL is replaced with -the name of the variable. - -If the variable has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If the variable has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." - (let* ((var (read-variable prompt-var)) - (minibuffer-help-form '(describe-variable var))) - (list var - (let ((prop (get var 'variable-interactive)) - (type (get var 'custom-type)) - (prompt (format prompt-val var))) - (unless (listp type) - (setq type (list type))) - (cond (prop - ;; Use VAR's `variable-interactive' property - ;; as an interactive spec for prompting. - (call-interactively (list 'lambda '(arg) - (list 'interactive prop) - 'arg))) - (type - (widget-prompt-value type - prompt - (if (boundp var) - (symbol-value var)) - (not (boundp var)))) - (t - (eval-minibuffer prompt))))))) - -;;;###autoload -(defun customize-set-value (var val) - "Set VARIABLE to VALUE. VALUE is a Lisp object. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value." - (interactive (custom-prompt-variable "Set variable: " - "Set %s to value: ")) - - (set var val)) - -;;;###autoload -(defun customize-set-variable (var val) - "Set the default for VARIABLE to VALUE. VALUE is a Lisp object. - -If VARIABLE has a `custom-set' property, that is used for setting -VARIABLE, otherwise `set-default' is used. - -The `customized-value' property of the VARIABLE will be set to a list -with a quoted VALUE as its sole list member. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " - (interactive (custom-prompt-variable "Set variable: " - "Set customized value for %s to: ")) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'customized-value (list (custom-quote val)))) - -;;;###autoload -(defun customize-save-variable (var val) - "Set the default for VARIABLE to VALUE, and save it for future sessions. -If VARIABLE has a `custom-set' property, that is used for setting -VARIABLE, otherwise `set-default' is used. - -The `customized-value' property of the VARIABLE will be set to a list -with a quoted VALUE as its sole list member. - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value. - -If VARIABLE has a `custom-type' property, it must be a widget and the -`:prompt-value' property of that widget will be used for reading the value. " - (interactive (custom-prompt-variable "Set and ave variable: " - "Set and save value for %s as: ")) - (funcall (or (get var 'custom-set) 'set-default) var val) - (put var 'saved-value (list (custom-quote val))) - (custom-save-all)) - -;;;###autoload -(defun customize (group) - "Select a customization buffer which you can use to set user options. -User options are structured into \"groups\". -The default group is `Emacs'." - (interactive (custom-group-prompt - "Customize group: (default emacs) ")) - (when (stringp group) - (if (string-equal "" group) - (setq group 'emacs) - (setq group (intern group)))) - (let ((name (format "*Customize Group: %s*" - (custom-unlispify-tag-name group)))) - (if (get-buffer name) - (switch-to-buffer name) - (custom-buffer-create (list (list group 'custom-group)) - name - (concat " for group " - (custom-unlispify-tag-name group)))))) - -;;;###autoload -(defalias 'customize-group 'customize) - -;;;###autoload -(defun customize-other-window (symbol) - "Customize SYMBOL, which must be a customization group." - (interactive (custom-group-prompt - "Customize group: (default emacs) ")) - (when (stringp symbol) - (if (string-equal "" symbol) - (setq symbol 'emacs) - (setq symbol (intern symbol)))) - (custom-buffer-create-other-window - (list (list symbol 'custom-group)) - (format "*Customize Group: %s*" (custom-unlispify-tag-name symbol)))) - -;;;###autoload -(defalias 'customize-group-other-window 'customize-other-window) - -;;;###autoload -(defalias 'customize-option 'customize-variable) - -;;;###autoload -(defun customize-variable (symbol) - "Customize SYMBOL, which must be a user option variable." - (interactive (custom-variable-prompt)) - (custom-buffer-create (list (list symbol 'custom-variable)) - (format "*Customize Variable: %s*" - (custom-unlispify-tag-name symbol)))) - -;;;###autoload -(defun customize-changed-options (since-version) - "Customize all user option variables whose default values changed recently. -This means, in other words, variables defined with a `:version' keyword." - (interactive "sCustomize options changed, since version (default all versions): ") - (if (equal since-version "") - (setq since-version nil)) - (let ((found nil)) - (mapatoms (lambda (symbol) - (and (boundp symbol) - (let ((version (get symbol 'custom-version))) - (and version - (or (null since-version) - (customize-version-lessp since-version version)))) - (push (list symbol 'custom-variable) found)))) - (unless found - (error "No user options have changed defaults %s" - (if since-version - (format "since XEmacs %s" since-version) - "in recent Emacs versions"))) - (custom-buffer-create (custom-sort-items found t nil) - "*Customize Changed Options*"))) - -(defun customize-version-lessp (version1 version2) - (let (major1 major2 minor1 minor2) - (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1) - (setq major1 (read (match-string 1 version1))) - (setq minor1 (read (match-string 2 version1))) - (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2) - (setq major2 (read (match-string 1 version2))) - (setq minor2 (read (match-string 2 version2))) - (or (< major1 major2) - (and (= major1 major2) - (< minor1 minor2))))) - -;;;###autoload -(defalias 'customize-variable-other-window 'customize-option-other-window) - -;;;###autoload -(defun customize-option-other-window (symbol) - "Customize SYMBOL, which must be a user option variable. -Show the buffer in another window, but don't select it." - (interactive (custom-variable-prompt)) - (custom-buffer-create-other-window - (list (list symbol 'custom-variable)) - (format "*Customize Option: %s*" (custom-unlispify-tag-name symbol)))) - -;;;###autoload -(defun customize-face (&optional symbol) - "Customize SYMBOL, which should be a face name or nil. -If SYMBOL is nil, customize all faces." - (interactive (list (completing-read "Customize face: (default all) " - obarray 'find-face))) - (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) - (custom-buffer-create (custom-sort-items - (mapcar (lambda (symbol) - (list symbol 'custom-face)) - (face-list)) - t nil) - "*Customize Faces*") - (when (stringp symbol) - (setq symbol (intern symbol))) - (check-argument-type 'symbolp symbol) - (custom-buffer-create (list (list symbol 'custom-face)) - (format "*Customize Face: %s*" - (custom-unlispify-tag-name symbol))))) - -;;;###autoload -(defun customize-face-other-window (&optional symbol) - "Show customization buffer for FACE in other window." - (interactive (list (completing-read "Customize face: " - obarray 'find-face))) - (if (or (null symbol) (and (stringp symbol) (zerop (length symbol)))) - () - (if (stringp symbol) - (setq symbol (intern symbol))) - (check-argument-type 'symbolp symbol) - (custom-buffer-create-other-window - (list (list symbol 'custom-face)) - (format "*Customize Face: %s*" (custom-unlispify-tag-name symbol))))) - -;;;###autoload -(defun customize-customized () - "Customize all user options set since the last save in this session." - (interactive) - (let ((found nil)) - (mapatoms (lambda (symbol) - (and (get symbol 'customized-face) - (find-face symbol) - (push (list symbol 'custom-face) found)) - (and (get symbol 'customized-value) - (boundp symbol) - (push (list symbol 'custom-variable) found)))) - (if (not found) - (error "No customized user options") - (custom-buffer-create (custom-sort-items found t nil) - "*Customize Customized*")))) - -;;;###autoload -(defun customize-saved () - "Customize all already saved user options." - (interactive) - (let ((found nil)) - (mapatoms (lambda (symbol) - (and (get symbol 'saved-face) - (find-face symbol) - (push (list symbol 'custom-face) found)) - (and (get symbol 'saved-value) - (boundp symbol) - (push (list symbol 'custom-variable) found)))) - (if (not found ) - (error "No saved user options") - (custom-buffer-create (custom-sort-items found t nil) - "*Customize Saved*")))) - -;;;###autoload -(defun customize-apropos (regexp &optional all) - "Customize all user options matching REGEXP. -If ALL is `options', include only options. -If ALL is `faces', include only faces. -If ALL is `groups', include only groups. -If ALL is t (interactively, with prefix arg), include options which are not -user-settable, as well as faces and groups." - (interactive "sCustomize regexp: \nP") - (let ((found nil)) - (mapatoms (lambda (symbol) - (when (string-match regexp (symbol-name symbol)) - (when (and (not (memq all '(faces options))) - (get symbol 'custom-group)) - (push (list symbol 'custom-group) found)) - (when (and (not (memq all '(options groups))) - (find-face symbol)) - (push (list symbol 'custom-face) found)) - (when (and (not (memq all '(groups faces))) - (boundp symbol) - (or (get symbol 'saved-value) - (get symbol 'standard-value) - (if (memq all '(nil options)) - (user-variable-p symbol) - (get symbol 'variable-documentation)))) - (push (list symbol 'custom-variable) found))))) - (if (not found) - (error "No matches") - (custom-buffer-create (custom-sort-items found t - custom-buffer-order-groups) - "*Customize Apropos*")))) - -;;;###autoload -(defun customize-apropos-options (regexp &optional arg) - "Customize all user options matching REGEXP. -With prefix arg, include options which are not user-settable." - (interactive "sCustomize regexp: \nP") - (customize-apropos regexp (or arg 'options))) - -;;;###autoload -(defun customize-apropos-faces (regexp) - "Customize all user faces matching REGEXP." - (interactive "sCustomize regexp: \n") - (customize-apropos regexp 'faces)) - -;;;###autoload -(defun customize-apropos-groups (regexp) - "Customize all user groups matching REGEXP." - (interactive "sCustomize regexp: \n") - (customize-apropos regexp 'groups)) - - -;;; Buffer. - -(defcustom custom-buffer-style 'links - "*Control the presentation style for customization buffers. -The value should be a symbol, one of: - -brackets: groups nest within each other with big horizontal brackets. -links: groups have links to subgroups." - :type '(radio (const :tag "brackets: Groups nest within each others" brackets) - (const :tag "links: Group have links to subgroups" links)) - :group 'custom-buffer) - -(defcustom custom-buffer-done-function 'kill-buffer - "*Function to be used to remove the buffer when the user is done with it. -Choices include `kill-buffer' (the default) and `bury-buffer'. -The function will be called with one argument, the buffer to remove." - :type '(radio (function-item kill-buffer) - (function-item bury-buffer) - (function :tag "Other" nil)) - :group 'custom-buffer) - -(defcustom custom-buffer-indent 3 - "Number of spaces to indent nested groups." - :type 'integer - :group 'custom-buffer) - -;;;###autoload -(defun custom-buffer-create (options &optional name description) - "Create a buffer containing OPTIONS. -Optional NAME is the name of the buffer. -OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where -SYMBOL is a customization option, and WIDGET is a widget for editing -that option." - (unless name (setq name "*Customization*")) - (kill-buffer (get-buffer-create name)) - (switch-to-buffer (get-buffer-create name)) - (custom-buffer-create-internal options description)) - -;;;###autoload -(defun custom-buffer-create-other-window (options &optional name description) - "Create a buffer containing OPTIONS. -Optional NAME is the name of the buffer. -OPTIONS should be an alist of the form ((SYMBOL WIDGET)...), where -SYMBOL is a customization option, and WIDGET is a widget for editing -that option." - (unless name (setq name "*Customization*")) - (kill-buffer (get-buffer-create name)) - (let ((window (selected-window))) - (switch-to-buffer-other-window (get-buffer-create name)) - (custom-buffer-create-internal options description) - (select-window window))) - -(defcustom custom-reset-button-menu t - "If non-nil, only show a single reset button in customize buffers. -This button will have a menu with all three reset operations." - :type 'boolean - :group 'custom-buffer) - -(defconst custom-skip-messages 5) - -(defun Custom-buffer-done () - "Remove current buffer. -This works by calling the function specified by - `custom-buffer-done-function'." - (interactive) - (funcall custom-buffer-done-function (current-buffer))) - -(defun custom-buffer-create-buttons () - (message "Creating customization buttons...") - (widget-insert "\nOperate on everything in this buffer:\n ") - (widget-create 'push-button - :tag "Set" - :tag-glyph '("set-up" "set-down") - :help-echo "\ -Make your editing in this buffer take effect for this session" - :action (lambda (widget &optional event) - (Custom-set))) - (widget-insert " ") - (widget-create 'push-button - :tag "Save" - :tag-glyph '("save-up" "save-down") - :help-echo "\ -Make your editing in this buffer take effect for future Emacs sessions" - :action (lambda (widget &optional event) - (Custom-save))) - (if custom-reset-button-menu - (progn - (widget-insert " ") - (widget-create 'push-button - :tag "Reset" - :tag-glyph '("reset-up" "reset-down") - :help-echo "Show a menu with reset operations" - :mouse-down-action (lambda (&rest junk) t) - :action (lambda (widget &optional event) - (custom-reset event)))) - (widget-insert " ") - (widget-create 'push-button - :tag "Reset" - :help-echo "\ -Reset all edited text in this buffer to reflect current values" - :action 'Custom-reset-current) - (widget-insert " ") - (widget-create 'push-button - :tag "Reset to Saved" - :help-echo "\ -Reset all values in this buffer to their saved settings" - :action 'Custom-reset-saved) - (widget-insert " ") - (widget-create 'push-button - :tag "Reset to Standard" - :help-echo "\ -Reset all values in this buffer to their standard settings" - :action 'Custom-reset-standard)) - (widget-insert " ") - (widget-create 'push-button - :tag "Done" - :tag-glyph '("done-up" "done-down") - :help-echo "Remove the buffer" - :action (lambda (widget &optional event) - (Custom-buffer-done))) - (widget-insert "\n")) - -(defcustom custom-novice t - "If non-nil, show help message at top of customize buffers." - :type 'boolean - :group 'custom-buffer) - -(defcustom custom-display-global-buttons 'top - "If `nil' don't display the global buttons. If `top' display at the -beginning of custom buffers. If `bottom', display at the end." - :type '(choice (const top) - (const bottom) - (const :tag "don't" nil)) - :group 'custom-buffer) - -(defun custom-buffer-create-internal (options &optional description) - (message "Creating customization buffer...") - (custom-mode) - (widget-insert "This is a customization buffer") - (if description - (widget-insert description)) - (when custom-novice - (widget-insert ".\n\ -Type RET or click button2 on an active field to invoke its action. -Invoke ") - (widget-create 'info-link - :tag "Help" - :help-echo "Read the online help" - "(XEmacs)Easy Customization") - (widget-insert " for more information.")) - (widget-insert "\n") - (if (equal custom-display-global-buttons 'top) - (custom-buffer-create-buttons)) - (widget-insert "\n") - (message "Creating customization items...") - (setq custom-options - (if (= (length options) 1) - (mapcar (lambda (entry) - (widget-create (nth 1 entry) - :documentation-shown t - :custom-state 'unknown - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :value (nth 0 entry))) - options) - (let ((count 0) - (length (length options))) - (mapcar (lambda (entry) - (prog2 - (display-message - 'progress - (format "Creating customization items %2d%%..." - (/ (* 100.0 count) length))) - (widget-create (nth 1 entry) - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :value (nth 0 entry)) - (incf count) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - (widget-insert "\n"))) - options)))) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - (if (equal custom-display-global-buttons 'bottom) - (custom-buffer-create-buttons)) - (display-message 'progress - (format - "Creating customization items %2d%%...done" 100)) - (unless (eq custom-buffer-style 'tree) - (mapc 'custom-magic-reset custom-options)) - (message "Creating customization setup...") - (widget-setup) - (goto-char (point-min)) - (message "Creating customization buffer...done")) - - -;;; The Tree Browser. - -;;;###autoload -(defun customize-browse (&optional group) - "Create a tree browser for the customize hierarchy." - (interactive) - (unless group - (setq group 'emacs)) - (let ((name "*Customize Browser*")) - (kill-buffer (get-buffer-create name)) - (switch-to-buffer (get-buffer-create name))) - (custom-mode) - (widget-insert "\ -Square brackets show active fields; type RET or click button2 -on an active field to invoke its action. -Invoke [+] below to expand a group, and [-] to collapse an expanded group.\n") - (if custom-browse-only-groups - (widget-insert "\ -Invoke the [Group] button below to edit that item in another window.\n\n") - (widget-insert "Invoke the ") - (widget-create 'item - :format "%t" - :tag "[Group]" - :tag-glyph "folder") - (widget-insert ", ") - (widget-create 'item - :format "%t" - :tag "[Face]" - :tag-glyph "face") - (widget-insert ", and ") - (widget-create 'item - :format "%t" - :tag "[Option]" - :tag-glyph "option") - (widget-insert " buttons below to edit that -item in another window.\n\n")) - (let ((custom-buffer-style 'tree)) - (widget-create 'custom-group - :custom-last t - :custom-state 'unknown - :tag (custom-unlispify-tag-name group) - :value group)) - (widget-add-change) - (goto-char (point-min))) - -(define-widget 'custom-browse-visibility 'item - "Control visibility of of items in the customize tree browser." - :format "%[[%t]%]" - :action 'custom-browse-visibility-action) - -(defun custom-browse-visibility-action (widget &rest ignore) - (let ((custom-buffer-style 'tree)) - (custom-toggle-parent widget))) - -(define-widget 'custom-browse-group-tag 'push-button - "Show parent in other window when activated." - :tag "Group" - :tag-glyph "folder" - :action 'custom-browse-group-tag-action) - -(defun custom-browse-group-tag-action (widget &rest ignore) - (let ((parent (widget-get widget :parent))) - (customize-group-other-window (widget-value parent)))) - -(define-widget 'custom-browse-variable-tag 'push-button - "Show parent in other window when activated." - :tag "Option" - :tag-glyph "option" - :action 'custom-browse-variable-tag-action) - -(defun custom-browse-variable-tag-action (widget &rest ignore) - (let ((parent (widget-get widget :parent))) - (customize-variable-other-window (widget-value parent)))) - -(define-widget 'custom-browse-face-tag 'push-button - "Show parent in other window when activated." - :tag "Face" - :tag-glyph "face" - :action 'custom-browse-face-tag-action) - -(defun custom-browse-face-tag-action (widget &rest ignore) - (let ((parent (widget-get widget :parent))) - (customize-face-other-window (widget-value parent)))) - -(defconst custom-browse-alist '((" " "space") - (" | " "vertical") - ("-\\ " "top") - (" |-" "middle") - (" `-" "bottom"))) - -(defun custom-browse-insert-prefix (prefix) - "Insert PREFIX. On XEmacs convert it to line graphics." - ;; ### Unfinished. - (if nil ; (string-match "XEmacs" emacs-version) - (progn - (insert "*") - (while (not (string-equal prefix "")) - (let ((entry (substring prefix 0 3))) - (setq prefix (substring prefix 3)) - (let ((overlay (make-overlay (1- (point)) (point) nil t nil)) - (name (nth 1 (assoc entry custom-browse-alist)))) - (overlay-put overlay 'end-glyph (widget-glyph-find name entry)) - (overlay-put overlay 'start-open t) - (overlay-put overlay 'end-open t))))) - (insert prefix))) - - -;;; Modification of Basic Widgets. -;; -;; We add extra properties to the basic widgets needed here. This is -;; fine, as long as we are careful to stay within out own namespace. -;; -;; We want simple widgets to be displayed by default, but complex -;; widgets to be hidden. - -(widget-put (get 'item 'widget-type) :custom-show t) -(widget-put (get 'editable-field 'widget-type) - :custom-show (lambda (widget value) - ;; This used to call pp-to-string - (let ((pp (widget-prettyprint-to-string value))) - (cond ((string-match "\n" pp) - nil) - ((> (length pp) 40) - nil) - (t t))))) -(widget-put (get 'menu-choice 'widget-type) :custom-show t) - -;;; The `custom-manual' Widget. - -(define-widget 'custom-manual 'info-link - "Link to the manual entry for this customization option." - :tag "Manual") - -;;; The `custom-magic' Widget. - -(defgroup custom-magic-faces nil - "Faces used by the magic button." - :group 'custom-faces - :group 'custom-buffer) - -(defface custom-invalid-face '((((class color)) - (:foreground "yellow" :background "red")) - (t - (:bold t :italic t :underline t))) - "Face used when the customize item is invalid." - :group 'custom-magic-faces) - -(defface custom-rogue-face '((((class color)) - (:foreground "pink" :background "black")) - (t - (:underline t))) - "Face used when the customize item is not defined for customization." - :group 'custom-magic-faces) - -(defface custom-modified-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:italic t :bold))) - "Face used when the customize item has been modified." - :group 'custom-magic-faces) - -(defface custom-set-face '((((class color)) - (:foreground "blue" :background "white")) - (t - (:italic t))) - "Face used when the customize item has been set." - :group 'custom-magic-faces) - -(defface custom-changed-face '((((class color)) - (:foreground "white" :background "blue")) - (t - (:italic t))) - "Face used when the customize item has been changed." - :group 'custom-magic-faces) - -(defface custom-saved-face '((t (:underline t))) - "Face used when the customize item has been saved." - :group 'custom-magic-faces) - -(defconst custom-magic-alist '((nil "#" underline "\ -uninitialized, you should not see this.") - (unknown "?" italic "\ -unknown, you should not see this.") - (hidden "-" default "\ -hidden, invoke \"Show\" button in the previous line to show." "\ -group now hidden, invoke the above \"Show\" button to show contents.") - (invalid "x" custom-invalid-face "\ -the value displayed for this %c is invalid and cannot be set.") - (modified "*" custom-modified-face "\ -you have edited the value as text, but you have not set the %c." "\ -you have edited something in this group, but not set it.") - (set "+" custom-set-face "\ -you have set this %c, but not saved it for future sessions." "\ -something in this group has been set, but not saved.") - (changed ":" custom-changed-face "\ -this %c has been changed outside the customize buffer." "\ -something in this group has been changed outside customize.") - (saved "!" custom-saved-face "\ -this %c has been set and saved." "\ -something in this group has been set and saved.") - (rogue "@" custom-rogue-face "\ -this %c has not been changed with customize." "\ -something in this group is not prepared for customization.") - (standard " " nil "\ -this %c is unchanged from its standard setting." "\ -visible group members are all at standard settings.")) - "Alist of customize option states. -Each entry is of the form (STATE MAGIC FACE ITEM-DESC [ GROUP-DESC ]), where - -STATE is one of the following symbols: - -`nil' - For internal use, should never occur. -`unknown' - For internal use, should never occur. -`hidden' - This item is not being displayed. -`invalid' - This item is modified, but has an invalid form. -`modified' - This item is modified, and has a valid form. -`set' - This item has been set but not saved. -`changed' - The current value of this item has been changed temporarily. -`saved' - This item is marked for saving. -`rogue' - This item has no customization information. -`standard' - This item is unchanged from the standard setting. - -MAGIC is a string used to present that state. - -FACE is a face used to present the state. - -ITEM-DESC is a string describing the state for options. - -GROUP-DESC is a string describing the state for groups. If this is -left out, ITEM-DESC will be used. - -The string %c in either description will be replaced with the -category of the item. These are `group'. `option', and `face'. - -The list should be sorted most significant first.") - -(defcustom custom-magic-show 'long - "If non-nil, show textual description of the state. -If `long', show a full-line description, not just one word." - :type '(choice (const :tag "no" nil) - (const short) - (const long)) - :group 'custom-buffer) - -(defcustom custom-magic-show-hidden '(option face) - "Control whether the State button is shown for hidden items. -The value should be a list with the custom categories where the State -button should be visible. Possible categories are `group', `option', -and `face'." - :type '(set (const group) (const option) (const face)) - :group 'custom-buffer) - -(defcustom custom-magic-show-button nil - "Show a \"magic\" button indicating the state of each customization option." - :type 'boolean - :group 'custom-buffer) - -(define-widget 'custom-magic 'default - "Show and manipulate state for a customization option." - :format "%v" - :action 'widget-parent-action - :notify 'ignore - :value-get 'ignore - :value-create 'custom-magic-value-create - :value-delete 'widget-children-value-delete) - -(defun widget-magic-mouse-down-action (widget &optional event) - ;; Non-nil unless hidden. - (not (eq (widget-get (widget-get (widget-get widget :parent) :parent) - :custom-state) - 'hidden))) - -(defun custom-magic-value-create (widget) - ;; Create compact status report for WIDGET. - (let* ((parent (widget-get widget :parent)) - (state (widget-get parent :custom-state)) - (hidden (eq state 'hidden)) - (entry (assq state custom-magic-alist)) - (magic (nth 1 entry)) - (face (nth 2 entry)) - (category (widget-get parent :custom-category)) - (text (or (and (eq category 'group) - (nth 4 entry)) - (nth 3 entry))) - (form (widget-get parent :custom-form)) - children) - (while (string-match "\\`\\(.*\\)%c\\(.*\\)\\'" text) - (setq text (concat (match-string 1 text) - (symbol-name category) - (match-string 2 text)))) - (when (and custom-magic-show - (or (not hidden) - (memq category custom-magic-show-hidden))) - (insert " ") - (when (and (eq category 'group) - (not (and (eq custom-buffer-style 'links) - (> (widget-get parent :custom-level) 1)))) - (insert-char ?\ (* custom-buffer-indent - (widget-get parent :custom-level)))) - (push (widget-create-child-and-convert - widget 'choice-item - :help-echo "Change the state of this item" - :format (if hidden "%t" "%[%t%]") - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :mouse-down-action 'widget-magic-mouse-down-action - :tag "State" - ;;:tag-glyph (or hidden '("state-up" "state-down")) - ) - children) - (insert ": ") - (let ((start (point))) - (if (eq custom-magic-show 'long) - (insert text) - (insert (symbol-name state))) - (cond ((eq form 'lisp) - (insert " (lisp)")) - ((eq form 'mismatch) - (insert " (mismatch)"))) - (put-text-property start (point) 'face 'custom-state-face)) - (insert "\n")) - (when (and (eq category 'group) - (not (and (eq custom-buffer-style 'links) - (> (widget-get parent :custom-level) 1)))) - (insert-char ?\ (* custom-buffer-indent - (widget-get parent :custom-level)))) - (when custom-magic-show-button - (when custom-magic-show - (let ((indent (widget-get parent :indent))) - (when indent - (insert-char ?\ indent)))) - (push (widget-create-child-and-convert - widget 'choice-item - :mouse-down-action 'widget-magic-mouse-down-action - :button-face face - :button-prefix "" - :button-suffix "" - :help-echo "Change the state" - :format (if hidden "%t" "%[%t%]") - :tag (if (memq form '(lisp mismatch)) - (concat "(" magic ")") - (concat "[" magic "]"))) - children) - (insert " ")) - (widget-put widget :children children))) - -(defun custom-magic-reset (widget) - "Redraw the :custom-magic property of WIDGET." - (let ((magic (widget-get widget :custom-magic))) - (widget-value-set magic (widget-value magic)))) - -;;; The `custom' Widget. - -(defface custom-button-face '((t (:bold t))) - "Face used for buttons in customization buffers." - :group 'custom-faces) - -(defface custom-documentation-face nil - "Face used for documentation strings in customization buffers." - :group 'custom-faces) - -(defface custom-state-face '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) - "Face used for State descriptions in the customize buffer." - :group 'custom-faces) - -(define-widget 'custom 'default - "Customize a user option." - :format "%v" - :convert-widget 'custom-convert-widget - :notify 'custom-notify - :custom-prefix "" - :custom-level 1 - :custom-state 'hidden - :documentation-property 'widget-subclass-responsibility - :value-create 'widget-subclass-responsibility - :value-delete 'widget-children-value-delete - :value-get 'widget-value-value-get - :validate 'widget-children-validate - :match (lambda (widget value) (symbolp value))) - -(defun custom-convert-widget (widget) - ;; Initialize :value and :tag from :args in WIDGET. - (let ((args (widget-get widget :args))) - (when args - (widget-put widget :value (widget-apply widget - :value-to-internal (car args))) - (widget-put widget :tag (custom-unlispify-tag-name (car args))) - (widget-put widget :args nil))) - widget) - -(defun custom-notify (widget &rest args) - "Keep track of changes." - (let ((state (widget-get widget :custom-state))) - (unless (eq state 'modified) - (unless (memq state '(nil unknown hidden)) - (widget-put widget :custom-state 'modified)) - (custom-magic-reset widget) - (apply 'widget-default-notify widget args)))) - -(defun custom-redraw (widget) - "Redraw WIDGET with current settings." - (let ((line (count-lines (point-min) (point))) - (column (current-column)) - (pos (point)) - (from (marker-position (widget-get widget :from))) - (to (marker-position (widget-get widget :to)))) - (save-excursion - (widget-value-set widget (widget-value widget)) - (custom-redraw-magic widget)) - (when (and (>= pos from) (<= pos to)) - (condition-case nil - (progn - (if (> column 0) - (goto-line line) - (goto-line (1+ line))) - (move-to-column column)) - (error nil))))) - -(defun custom-redraw-magic (widget) - "Redraw WIDGET state with current settings." - (while widget - (let ((magic (widget-get widget :custom-magic))) - (cond (magic - (widget-value-set magic (widget-value magic)) - (when (setq widget (widget-get widget :group)) - (custom-group-state-update widget))) - (t - (setq widget nil))))) - (widget-setup)) - -(defun custom-show (widget value) - "Non-nil if WIDGET should be shown with VALUE by default." - (let ((show (widget-get widget :custom-show))) - (cond ((null show) - nil) - ((eq t show) - t) - (t - (funcall show widget value))))) - -(defvar custom-load-recursion nil - "Hack to avoid recursive dependencies.") - -(defun custom-load-symbol (symbol) - "Load all dependencies for SYMBOL." - (unless custom-load-recursion - (let ((custom-load-recursion t) - (loads (get symbol 'custom-loads)) - load) - (while loads - (setq load (car loads) - loads (cdr loads)) - (cond ((symbolp load) - (condition-case nil - (require load) - (error nil))) - ;; Don't reload a file already loaded. - ((and (boundp 'preloaded-file-list) - (member load preloaded-file-list))) - ((assoc load load-history)) - ((assoc (locate-library load) load-history)) - (t - (condition-case nil - ;; Without this, we would load cus-edit recursively. - ;; We are still loading it when we call this, - ;; and it is not in load-history yet. - (or (equal load "cus-edit") - (load-library load)) - (error nil)))))))) - -(defun custom-load-widget (widget) - "Load all dependencies for WIDGET." - (custom-load-symbol (widget-value widget))) - -(defun custom-unloaded-symbol-p (symbol) - "Return non-nil if the dependencies of SYMBOL has not yet been loaded." - (let ((found nil) - (loads (get symbol 'custom-loads)) - load) - (while loads - (setq load (car loads) - loads (cdr loads)) - (cond ((symbolp load) - (unless (featurep load) - (setq found t))) - ((assoc load load-history)) - ((assoc (locate-library load) load-history) - ;; #### WTF??? - (message nil)) - (t - (setq found t)))) - found)) - -(defun custom-unloaded-widget-p (widget) - "Return non-nil if the dependencies of WIDGET has not yet been loaded." - (custom-unloaded-symbol-p (widget-value widget))) - -(defun custom-toggle-hide (widget) - "Toggle visibility of WIDGET." - (custom-load-widget widget) - (let ((state (widget-get widget :custom-state))) - (cond ((memq state '(invalid modified)) - (error "There are unset changes")) - ((eq state 'hidden) - (widget-put widget :custom-state 'unknown)) - (t - (widget-put widget :documentation-shown nil) - (widget-put widget :custom-state 'hidden))) - (custom-redraw widget) - (widget-setup))) - -(defun custom-toggle-parent (widget &rest ignore) - "Toggle visibility of parent of WIDGET." - (custom-toggle-hide (widget-get widget :parent))) - -(defun custom-add-see-also (widget &optional prefix) - "Add `See also ...' to WIDGET if there are any links. -Insert PREFIX first if non-nil." - (let* ((symbol (widget-get widget :value)) - (links (get symbol 'custom-links)) - (many (> (length links) 2)) - (buttons (widget-get widget :buttons)) - (indent (widget-get widget :indent))) - (when links - (when indent - (insert-char ?\ indent)) - (when prefix - (insert prefix)) - (insert "See also ") - (while links - (push (widget-create-child-and-convert widget (car links)) - buttons) - (setq links (cdr links)) - (cond ((null links) - (insert ".\n")) - ((null (cdr links)) - (if many - (insert ", and ") - (insert " and "))) - (t - (insert ", ")))) - (widget-put widget :buttons buttons)))) - -(defun custom-add-parent-links (widget &optional initial-string) - "Add \"Parent groups: ...\" to WIDGET if the group has parents. -The value if non-nil if any parents were found. -If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." - (let ((name (widget-value widget)) - (type (widget-type widget)) - (buttons (widget-get widget :buttons)) - (start (point)) - found) - (insert (or initial-string "Parent groups:")) - (maphash (lambda (group ignore) - (let ((entry (assq name (get group 'custom-group)))) - (when (eq (nth 1 entry) type) - (insert " ") - (push (widget-create-child-and-convert - widget 'custom-group-link - :tag (custom-unlispify-tag-name group) - group) - buttons) - (setq found t)))) - custom-group-hash-table) - (widget-put widget :buttons buttons) - (if found - (insert "\n") - (delete-region start (point))) - found)) - -;;; The `custom-variable' Widget. - -(defface custom-variable-tag-face '((((class color) - (background dark)) - (:foreground "light blue" :underline t)) - (((class color) - (background light)) - (:foreground "blue" :underline t)) - (t (:underline t))) - "Face used for unpushable variable tags." - :group 'custom-faces) - -(defface custom-variable-button-face '((t (:underline t :bold t))) - "Face used for pushable variable tags." - :group 'custom-faces) - -(defcustom custom-variable-default-form 'edit - "Default form of displaying variable values." - :type '(choice (const edit) - (const lisp)) - :group 'custom-buffer) - -(define-widget 'custom-variable 'custom - "Customize variable." - :format "%v" - :help-echo "Set or reset this variable" - :documentation-property 'variable-documentation - :custom-category 'option - :custom-state nil - :custom-menu 'custom-variable-menu-create - :custom-form nil ; defaults to value of `custom-variable-default-form' - :value-create 'custom-variable-value-create - :action 'custom-variable-action - :custom-set 'custom-variable-set - :custom-save 'custom-variable-save - :custom-reset-current 'custom-redraw - :custom-reset-saved 'custom-variable-reset-saved - :custom-reset-standard 'custom-variable-reset-standard) - -(defun custom-variable-type (symbol) - "Return a widget suitable for editing the value of SYMBOL. -If SYMBOL has a `custom-type' property, use that. -Otherwise, look up symbol in `custom-guess-type-alist'." - (let* ((type (or (get symbol 'custom-type) - (and (not (get symbol 'standard-value)) - (custom-guess-type symbol)) - 'sexp)) - (options (get symbol 'custom-options)) - (tmp (if (listp type) - (copy-sequence type) - (list type)))) - (when options - (widget-put tmp :options options)) - tmp)) - -(defun custom-variable-value-create (widget) - "Here is where you edit the variables value." - (custom-load-widget widget) - (unless (widget-get widget :custom-form) - (widget-put widget :custom-form custom-variable-default-form)) - (let* ((buttons (widget-get widget :buttons)) - (children (widget-get widget :children)) - (form (widget-get widget :custom-form)) - (state (widget-get widget :custom-state)) - (symbol (widget-get widget :value)) - (tag (widget-get widget :tag)) - (type (custom-variable-type symbol)) - (conv (widget-convert type)) - (get (or (get symbol 'custom-get) 'default-value)) - (prefix (widget-get widget :custom-prefix)) - (last (widget-get widget :custom-last)) - (value (if (default-boundp symbol) - (funcall get symbol) - (widget-get conv :value)))) - ;; If the widget is new, the child determine whether it is hidden. - (cond (state) - ((custom-show type value) - (setq state 'unknown)) - (t - (setq state 'hidden))) - ;; If we don't know the state, see if we need to edit it in lisp form. - (when (eq state 'unknown) - (unless (widget-apply conv :match value) - ;; (widget-apply (widget-convert type) :match value) - (setq form 'mismatch))) - ;; Now we can create the child widget. - (cond ((eq custom-buffer-style 'tree) - (insert prefix (if last " `--- " " |--- ")) - (push (widget-create-child-and-convert - widget 'custom-browse-variable-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons)) - ((eq state 'hidden) - ;; Indicate hidden value. - (push (widget-create-child-and-convert - widget 'item - :format "%{%t%}: " - :sample-face 'custom-variable-tag-face - :tag tag - :parent widget) - buttons) - (push (widget-create-child-and-convert - widget 'visibility - :help-echo "Show the value of this option" - :action 'custom-toggle-parent - nil) - buttons)) - ((memq form '(lisp mismatch)) - ;; In lisp mode edit the saved value when possible. - (let* ((value (cond ((get symbol 'saved-value) - (car (get symbol 'saved-value))) - ((get symbol 'standard-value) - (car (get symbol 'standard-value))) - ((default-boundp symbol) - (custom-quote (funcall get symbol))) - (t - (custom-quote (widget-get conv :value)))))) - (insert (symbol-name symbol) ": ") - (push (widget-create-child-and-convert - widget 'visibility - :help-echo "Hide the value of this option" - :action 'custom-toggle-parent - t) - buttons) - (insert " ") - (push (widget-create-child-and-convert - widget 'sexp - :button-face 'custom-variable-button-face - :format "%v" - :tag (symbol-name symbol) - :parent widget - :value value) - children))) - (t - ;; Edit mode. - (let* ((format (widget-get type :format)) - tag-format value-format) - (while (not (string-match ":" format)) - (setq format (signal 'error (list "Bad format" format)))) - (setq tag-format (substring format 0 (match-end 0))) - (setq value-format (substring format (match-end 0))) - (push (widget-create-child-and-convert - widget 'item - :format tag-format - :action 'custom-tag-action - :help-echo "Change value of this option" - :mouse-down-action 'custom-tag-mouse-down-action - :button-face 'custom-variable-button-face - :sample-face 'custom-variable-tag-face - tag) - buttons) - (insert " ") - (push (widget-create-child-and-convert - widget 'visibility - :help-echo "Hide the value of this option" - :action 'custom-toggle-parent - t) - buttons) - (push (widget-create-child-and-convert - widget type - :format value-format - :value value) - children)))) - (unless (eq custom-buffer-style 'tree) - ;; Now update the state. - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")) - (if (eq state 'hidden) - (widget-put widget :custom-state state) - (custom-variable-state-set widget)) - ;; Create the magic button. - (let ((magic (widget-create-child-and-convert - widget 'custom-magic nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) - ;; Update properties. - (widget-put widget :custom-form form) - (widget-put widget :buttons buttons) - (widget-put widget :children children) - ;; Insert documentation. - (widget-default-format-handler widget ?h) - ;; See also. - (unless (eq state 'hidden) - (when (eq (widget-get widget :custom-level) 1) - (custom-add-parent-links widget)) - (custom-add-see-also widget))))) - -(defun custom-tag-action (widget &rest args) - "Pass :action to first child of WIDGET's parent." - (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) - :action args)) - -(defun custom-tag-mouse-down-action (widget &rest args) - "Pass :mouse-down-action to first child of WIDGET's parent." - (apply 'widget-apply (car (widget-get (widget-get widget :parent) :children)) - :mouse-down-action args)) - -(defun custom-variable-state-set (widget) - "Set the state of WIDGET." - (let* ((symbol (widget-value widget)) - (get (or (get symbol 'custom-get) 'default-value)) - (value (if (default-boundp symbol) - (funcall get symbol) - (widget-get widget :value))) - tmp - (state (cond ((setq tmp (get symbol 'customized-value)) - (if (condition-case nil - (equal value (eval (car tmp))) - (error nil)) - 'set - 'changed)) - ((setq tmp (get symbol 'saved-value)) - (if (condition-case nil - (equal value (eval (car tmp))) - (error nil)) - 'saved - 'changed)) - ((setq tmp (get symbol 'standard-value)) - (if (condition-case nil - (equal value (eval (car tmp))) - (error nil)) - 'standard - 'changed)) - (t 'rogue)))) - (widget-put widget :custom-state state))) - -(defvar custom-variable-menu - '(("Set for Current Session" custom-variable-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ("Save for Future Sessions" custom-variable-save - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set changed rogue)))) - ("Reset to Current" custom-redraw - (lambda (widget) - (and (default-boundp (widget-value widget)) - (memq (widget-get widget :custom-state) '(modified changed))))) - ("Reset to Saved" custom-variable-reset-saved - (lambda (widget) - (and (get (widget-value widget) 'saved-value) - (memq (widget-get widget :custom-state) - '(modified set changed rogue))))) - ("Reset to Standard Settings" custom-variable-reset-standard - (lambda (widget) - (and (get (widget-value widget) 'standard-value) - (memq (widget-get widget :custom-state) - '(modified set changed saved rogue))))) - ("---" ignore ignore) - ("Don't show as Lisp expression" custom-variable-edit - (lambda (widget) - (eq (widget-get widget :custom-form) 'lisp))) - ("Show as Lisp expression" custom-variable-edit-lisp - (lambda (widget) - (eq (widget-get widget :custom-form) 'edit)))) - "Alist of actions for the `custom-variable' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-variable' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") - -(defun custom-variable-action (widget &optional event) - "Show the menu for `custom-variable' WIDGET. -Optional EVENT is the location for the menu." - (if (eq (widget-get widget :custom-state) 'hidden) - (custom-toggle-hide widget) - (unless (eq (widget-get widget :custom-state) 'modified) - (custom-variable-state-set widget)) - ;; Redrawing magic also depresses the state glyph. - ;(custom-redraw-magic widget) - (let* ((completion-ignore-case t) - (answer (widget-choose (concat "Operation on " - (custom-unlispify-tag-name - (widget-get widget :value))) - (custom-menu-filter custom-variable-menu - widget) - event))) - (if answer - (funcall answer widget))))) - -(defun custom-variable-edit (widget) - "Edit value of WIDGET." - (widget-put widget :custom-state 'unknown) - (widget-put widget :custom-form 'edit) - (custom-redraw widget)) - -(defun custom-variable-edit-lisp (widget) - "Edit the lisp representation of the value of WIDGET." - (widget-put widget :custom-state 'unknown) - (widget-put widget :custom-form 'lisp) - (custom-redraw widget)) - -(defun custom-variable-set (widget) - "Set the current value for the variable being edited by WIDGET." - (let* ((form (widget-get widget :custom-form)) - (state (widget-get widget :custom-state)) - (child (car (widget-get widget :children))) - (symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - val) - (cond ((eq state 'hidden) - (error "Cannot set hidden variable")) - ((setq val (widget-apply child :validate)) - (goto-char (widget-get val :from)) - (error "%s" (widget-get val :error))) - ((memq form '(lisp mismatch)) - (funcall set symbol (eval (setq val (widget-value child)))) - (put symbol 'customized-value (list val))) - (t - (funcall set symbol (setq val (widget-value child))) - (put symbol 'customized-value (list (custom-quote val))))) - (custom-variable-state-set widget) - (custom-redraw-magic widget))) - -(defun custom-variable-save (widget) - "Set and save the value for the variable being edited by WIDGET." - (let* ((form (widget-get widget :custom-form)) - (state (widget-get widget :custom-state)) - (child (car (widget-get widget :children))) - (symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default)) - val) - (cond ((eq state 'hidden) - (error "Cannot set hidden variable")) - ((setq val (widget-apply child :validate)) - (goto-char (widget-get val :from)) - (error "%s" (widget-get val :error))) - ((memq form '(lisp mismatch)) - (put symbol 'saved-value (list (widget-value child))) - (funcall set symbol (eval (widget-value child)))) - (t - (put symbol - 'saved-value (list (custom-quote (widget-value - child)))) - (funcall set symbol (widget-value child)))) - (put symbol 'customized-value nil) - (custom-save-all) - (custom-variable-state-set widget) - (custom-redraw-magic widget))) - -(defun custom-variable-reset-saved (widget) - "Restore the saved value for the variable being edited by WIDGET." - (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) - (if (get symbol 'saved-value) - (condition-case nil - (funcall set symbol (eval (car (get symbol 'saved-value)))) - (error nil)) - (signal 'error (list "No saved value for variable" symbol))) - (put symbol 'customized-value nil) - (widget-put widget :custom-state 'unknown) - (custom-redraw widget))) - -(defun custom-variable-reset-standard (widget) - "Restore the standard setting for the variable being edited by WIDGET." - (let* ((symbol (widget-value widget)) - (set (or (get symbol 'custom-set) 'set-default))) - (if (get symbol 'standard-value) - (funcall set symbol (eval (car (get symbol 'standard-value)))) - (signal 'error (list "No standard setting known for variable" symbol))) - (put symbol 'customized-value nil) - (when (get symbol 'saved-value) - (put symbol 'saved-value nil) - (custom-save-all)) - (widget-put widget :custom-state 'unknown) - (custom-redraw widget))) - -;;; The `custom-face-edit' Widget. - -(define-widget 'custom-face-edit 'checklist - "Edit face attributes." - :format "%t: %v" - :tag "Attributes" - :extra-offset 12 - :button-args '(:help-echo "Control whether this attribute have any effect") - :args (mapcar (lambda (att) - (list 'group - :inline t - :sibling-args (widget-get (nth 1 att) :sibling-args) - (list 'const :format "" :value (nth 0 att)) - (nth 1 att))) - custom-face-attributes)) - -;;; The `custom-display' Widget. - -(define-widget 'custom-display 'menu-choice - "Select a display type." - :tag "Display" - :value t - :help-echo "Specify frames where the face attributes should be used" - :args '((const :tag "all" t) - (checklist - :offset 0 - :extra-offset 9 - :args ((group :sibling-args (:help-echo "\ -Only match the specified window systems") - (const :format "Type: " - type) - (checklist :inline t - :offset 0 - (const :format "X " - :sibling-args (:help-echo "\ -The X11 Window System") - x) - (const :format "PM " - :sibling-args (:help-echo "\ -OS/2 Presentation Manager") - pm) - (const :format "MSWindows " - :sibling-args (:help-echo "\ -Windows NT/95/97") - mswindows) - (const :format "DOS " - :sibling-args (:help-echo "\ -Plain MS-DOS") - pc) - (const :format "TTY%n" - :sibling-args (:help-echo "\ -Plain text terminals") - tty))) - (group :sibling-args (:help-echo "\ -Only match the frames with the specified color support") - (const :format "Class: " - class) - (checklist :inline t - :offset 0 - (const :format "Color " - :sibling-args (:help-echo "\ -Match color frames") - color) - (const :format "Grayscale " - :sibling-args (:help-echo "\ -Match grayscale frames") - grayscale) - (const :format "Monochrome%n" - :sibling-args (:help-echo "\ -Match frames with no color support") - mono))) - (group :sibling-args (:help-echo "\ -Only match frames with the specified intensity") - (const :format "\ -Background brightness: " - background) - (checklist :inline t - :offset 0 - (const :format "Light " - :sibling-args (:help-echo "\ -Match frames with light backgrounds") - light) - (const :format "Dark\n" - :sibling-args (:help-echo "\ -Match frames with dark backgrounds") - dark))))))) - -;;; The `custom-face' Widget. - -(defface custom-face-tag-face '((t (:underline t))) - "Face used for face tags." - :group 'custom-faces) - -(defcustom custom-face-default-form 'selected - "Default form of displaying face definition." - :type '(choice (const all) - (const selected) - (const lisp)) - :group 'custom-buffer) - -(define-widget 'custom-face 'custom - "Customize face." - :sample-face 'custom-face-tag-face - :help-echo "Set or reset this face" - :documentation-property '(lambda (face) - (face-doc-string face)) - :value-create 'custom-face-value-create - :action 'custom-face-action - :custom-category 'face - :custom-form nil ; defaults to value of `custom-face-default-form' - :custom-set 'custom-face-set - :custom-save 'custom-face-save - :custom-reset-current 'custom-redraw - :custom-reset-saved 'custom-face-reset-saved - :custom-reset-standard 'custom-face-reset-standard - :custom-menu 'custom-face-menu-create) - -(define-widget 'custom-face-all 'editable-list - "An editable list of display specifications and attributes." - :entry-format "%i %d %v" - :insert-button-args '(:help-echo "Insert new display specification here") - :append-button-args '(:help-echo "Append new display specification here") - :delete-button-args '(:help-echo "Delete this display specification") - :args '((group :format "%v" custom-display custom-face-edit))) - -(defconst custom-face-all (widget-convert 'custom-face-all) - "Converted version of the `custom-face-all' widget.") - -(define-widget 'custom-display-unselected 'item - "A display specification that doesn't match the selected display." - :match 'custom-display-unselected-match) - -(defun custom-display-unselected-match (widget value) - "Non-nil if VALUE is an unselected display specification." - (not (face-spec-set-match-display value (selected-frame)))) - -(define-widget 'custom-face-selected 'group - "Edit the attributes of the selected display in a face specification." - :args '((repeat :format "" - :inline t - (group custom-display-unselected sexp)) - (group (sexp :format "") custom-face-edit) - (repeat :format "" - :inline t - sexp))) - -(defconst custom-face-selected (widget-convert 'custom-face-selected) - "Converted version of the `custom-face-selected' widget.") - -(defun custom-face-value-create (widget) - "Create a list of the display specifications for WIDGET." - (let ((buttons (widget-get widget :buttons)) - (symbol (widget-get widget :value)) - (tag (widget-get widget :tag)) - (state (widget-get widget :custom-state)) - (begin (point)) - (is-last (widget-get widget :custom-last)) - (prefix (widget-get widget :custom-prefix))) - (unless tag - (setq tag (prin1-to-string symbol))) - (cond ((eq custom-buffer-style 'tree) - (insert prefix (if is-last " `--- " " |--- ")) - (push (widget-create-child-and-convert - widget 'custom-browse-face-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons)) - (t - ;; Create tag. - (insert tag) - (if (eq custom-buffer-style 'face) - (insert " ") - (widget-specify-sample widget begin (point)) - (insert ": ")) - ;; Sample. - (and (not (find-face symbol)) - ;; XEmacs cannot display uninitialized faces. - (make-face symbol)) - (push (widget-create-child-and-convert widget 'item - :format "(%{%t%})" - :sample-face symbol - :tag "sample") - buttons) - ;; Visibility. - (insert " ") - (push (widget-create-child-and-convert - widget 'visibility - :help-echo "Hide or show this face" - :action 'custom-toggle-parent - (not (eq state 'hidden))) - buttons) - ;; Magic. - (insert "\n") - (let ((magic (widget-create-child-and-convert - widget 'custom-magic nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) - ;; Update buttons. - (widget-put widget :buttons buttons) - ;; Insert documentation. - (widget-default-format-handler widget ?h) - ;; See also. - (unless (eq state 'hidden) - (when (eq (widget-get widget :custom-level) 1) - (custom-add-parent-links widget)) - (custom-add-see-also widget)) - ;; Editor. - (unless (eq (preceding-char) ?\n) - (insert "\n")) - (unless (eq state 'hidden) - (message "Creating face editor...") - (custom-load-widget widget) - (unless (widget-get widget :custom-form) - (widget-put widget :custom-form custom-face-default-form)) - (let* ((symbol (widget-value widget)) - (spec (or (get symbol 'customized-face) - (get symbol 'saved-face) - (get symbol 'face-defface-spec) - ;; Attempt to construct it. - (list (list t (face-custom-attributes-get - symbol (selected-frame)))))) - (form (widget-get widget :custom-form)) - (indent (widget-get widget :indent)) - (edit (widget-create-child-and-convert - widget - (cond ((and (eq form 'selected) - (widget-apply custom-face-selected - :match spec)) - (when indent (insert-char ?\ indent)) - 'custom-face-selected) - ((and (not (eq form 'lisp)) - (widget-apply custom-face-all - :match spec)) - 'custom-face-all) - (t - (when indent (insert-char ?\ indent)) - 'sexp)) - :value spec))) - (custom-face-state-set widget) - (widget-put widget :children (list edit))) - (message "Creating face editor...done")))))) - -(defvar custom-face-menu - '(("Set for Current Session" custom-face-set) - ("Save for Future Sessions" custom-face-save) - ("Reset to Saved" custom-face-reset-saved - (lambda (widget) - (get (widget-value widget) 'saved-face))) - ("Reset to Standard Setting" custom-face-reset-standard - (lambda (widget) - (get (widget-value widget) 'face-defface-spec))) - ("---" ignore ignore) - ("Show all display specs" custom-face-edit-all - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'all)))) - ("Just current attributes" custom-face-edit-selected - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'selected)))) - ("Show as Lisp expression" custom-face-edit-lisp - (lambda (widget) - (not (eq (widget-get widget :custom-form) 'lisp))))) - "Alist of actions for the `custom-face' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-face' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") - -(defun custom-face-edit-selected (widget) - "Edit selected attributes of the value of WIDGET." - (widget-put widget :custom-state 'unknown) - (widget-put widget :custom-form 'selected) - (custom-redraw widget)) - -(defun custom-face-edit-all (widget) - "Edit all attributes of the value of WIDGET." - (widget-put widget :custom-state 'unknown) - (widget-put widget :custom-form 'all) - (custom-redraw widget)) - -(defun custom-face-edit-lisp (widget) - "Edit the lisp representation of the value of WIDGET." - (widget-put widget :custom-state 'unknown) - (widget-put widget :custom-form 'lisp) - (custom-redraw widget)) - -(defun custom-face-state-set (widget) - "Set the state of WIDGET." - (let ((symbol (widget-value widget))) - (widget-put widget :custom-state (cond ((get symbol 'customized-face) - 'set) - ((get symbol 'saved-face) - 'saved) - ((get symbol 'face-defface-spec) - 'standard) - (t - 'rogue))))) - -(defun custom-face-action (widget &optional event) - "Show the menu for `custom-face' WIDGET. -Optional EVENT is the location for the menu." - (if (eq (widget-get widget :custom-state) 'hidden) - (custom-toggle-hide widget) - (let* ((completion-ignore-case t) - (symbol (widget-get widget :value)) - (answer (widget-choose (concat "Operation on " - (custom-unlispify-tag-name symbol)) - (custom-menu-filter custom-face-menu - widget) - event))) - (if answer - (funcall answer widget))))) - -(defun custom-face-set (widget) - "Make the face attributes in WIDGET take effect." - (let* ((symbol (widget-value widget)) - (child (car (widget-get widget :children))) - (value (widget-value child))) - (put symbol 'customized-face value) - (face-spec-set symbol value) - (custom-face-state-set widget) - (custom-redraw-magic widget))) - -(defun custom-face-save (widget) - "Make the face attributes in WIDGET default." - (let* ((symbol (widget-value widget)) - (child (car (widget-get widget :children))) - (value (widget-value child))) - (face-spec-set symbol value) - (put symbol 'saved-face value) - (put symbol 'customized-face nil) - (custom-save-all) - (custom-face-state-set widget) - (custom-redraw-magic widget))) - -(defun custom-face-reset-saved (widget) - "Restore WIDGET to the face's default attributes." - (let* ((symbol (widget-value widget)) - (child (car (widget-get widget :children))) - (value (get symbol 'saved-face))) - (unless value - (signal 'error (list "No saved value for this face" symbol))) - (put symbol 'customized-face nil) - (face-spec-set symbol value) - (widget-value-set child value) - (custom-face-state-set widget) - (custom-redraw-magic widget))) - -(defun custom-face-reset-standard (widget) - "Restore WIDGET to the face's standard settings." - (let* ((symbol (widget-value widget)) - (child (car (widget-get widget :children))) - (value (get symbol 'face-defface-spec))) - (unless value - (signal 'error (list "No standard setting for this face" symbol))) - (put symbol 'customized-face nil) - (when (get symbol 'saved-face) - (put symbol 'saved-face nil) - (custom-save-all)) - (face-spec-set symbol value) - (widget-value-set child value) - (custom-face-state-set widget) - (custom-redraw-magic widget))) - -;;; The `face' Widget. - -(define-widget 'face 'default - "Select and customize a face." - :convert-widget 'widget-value-convert-widget - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :format "%t: %[select face%] %v" - :tag "Face" - :value 'default - :value-create 'widget-face-value-create - :value-delete 'widget-face-value-delete - :value-get 'widget-value-value-get - :validate 'widget-children-validate - :action 'widget-face-action - :match (lambda (widget value) (symbolp value))) - -(defun widget-face-value-create (widget) - ;; Create a `custom-face' child. - (let* ((symbol (widget-value widget)) - (custom-buffer-style 'face) - (child (widget-create-child-and-convert - widget 'custom-face - :custom-level nil - :value symbol))) - (custom-magic-reset child) - (setq custom-options (cons child custom-options)) - (widget-put widget :children (list child)))) - -(defun widget-face-value-delete (widget) - ;; Remove the child from the options. - (let ((child (car (widget-get widget :children)))) - (setq custom-options (delq child custom-options)) - (widget-children-value-delete widget))) - -(defvar face-history nil - "History of entered face names.") - -(defun widget-face-action (widget &optional event) - "Prompt for a face." - (let ((answer (completing-read "Face: " - (mapcar (lambda (face) - (list (symbol-name face))) - (face-list)) - nil nil nil - 'face-history))) - (unless (zerop (length answer)) - (widget-value-set widget (intern answer)) - (widget-apply widget :notify widget event) - (widget-setup)))) - -;;; The `hook' Widget. - -(define-widget 'hook 'list - "A emacs lisp hook" - :value-to-internal (lambda (widget value) - (if (symbolp value) - (list value) - value)) - :match (lambda (widget value) - (or (symbolp value) - (widget-group-match widget value))) - :convert-widget 'custom-hook-convert-widget - :tag "Hook") - -(defun custom-hook-convert-widget (widget) - ;; Handle `:custom-options'. - (let* ((options (widget-get widget :options)) - (other `(editable-list :inline t - :entry-format "%i %d%v" - (function :format " %v"))) - (args (if options - (list `(checklist :inline t - ,@(mapcar (lambda (entry) - `(function-item ,entry)) - options)) - other) - (list other)))) - (widget-put widget :args args) - widget)) - -;;; The `plist' Widget. - -(define-widget 'plist 'list - "A property list." - :match (lambda (widget value) - (valid-plist-p value)) - :convert-widget 'custom-plist-convert-widget - :tag "Property List") - -;; #### Should handle options better. -(defun custom-plist-convert-widget (widget) - (let* ((options (widget-get widget :options)) - (other `(editable-list :inline t - (group :inline t - (symbol :format "%t: %v " - :size 10 - :tag "Property") - (sexp :tag "Value")))) - (args - (if options - `((checklist :inline t - ,@(mapcar 'custom-plist-process-option options)) - ,other) - (list other)))) - (widget-put widget :args args) - widget)) - -(defun custom-plist-process-option (entry) - `(group :inline t - (const :tag "Property" - :format "%t: %v " - :size 10 - ,entry) - (sexp :tag "Value"))) - -;;; The `custom-group-link' Widget. - -(define-widget 'custom-group-link 'link - "Show parent in other window when activated." - :help-echo 'custom-group-link-help-echo - :action 'custom-group-link-action) - -(defun custom-group-link-help-echo (widget) - (concat "Create customization buffer for the `" - (custom-unlispify-tag-name (widget-value widget)) - "' group")) - -(defun custom-group-link-action (widget &rest ignore) - (customize-group (widget-value widget))) - -;;; The `custom-group' Widget. - -(defcustom custom-group-tag-faces nil - ;; In XEmacs, this ought to play games with font size. - "Face used for group tags. -The first member is used for level 1 groups, the second for level 2, -and so forth. The remaining group tags are shown with -`custom-group-tag-face'." - :type '(repeat face) - :group 'custom-faces) - -(defface custom-group-tag-face-1 '((((class color) - (background dark)) - (:foreground "pink" :underline t)) - (((class color) - (background light)) - (:foreground "red" :underline t)) - (t (:underline t))) - "Face used for group tags.") - -(defface custom-group-tag-face '((((class color) - (background dark)) - (:foreground "light blue" :underline t)) - (((class color) - (background light)) - (:foreground "blue" :underline t)) - (t (:underline t))) - "Face used for low level group tags." - :group 'custom-faces) - -(define-widget 'custom-group 'custom - "Customize group." - :format "%v" - :sample-face-get 'custom-group-sample-face-get - :documentation-property 'group-documentation - :help-echo "Set or reset all members of this group" - :value-create 'custom-group-value-create - :action 'custom-group-action - :custom-category 'group - :custom-set 'custom-group-set - :custom-save 'custom-group-save - :custom-reset-current 'custom-group-reset-current - :custom-reset-saved 'custom-group-reset-saved - :custom-reset-standard 'custom-group-reset-standard - :custom-menu 'custom-group-menu-create) - -(defun custom-group-sample-face-get (widget) - ;; Use :sample-face. - (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) - 'custom-group-tag-face)) - -(define-widget 'custom-group-visibility 'visibility - "An indicator and manipulator for hidden group contents." - :create 'custom-group-visibility-create) - -(defun custom-group-visibility-create (widget) - (let ((visible (widget-value widget))) - (if visible - (insert "--------"))) - (widget-default-create widget)) - -(defun custom-group-members (symbol groups-only) - "Return SYMBOL's custom group members. -If GROUPS-ONLY non-nil, return only those members that are groups." - (if (not groups-only) - (get symbol 'custom-group) - (let (members) - (dolist (entry (get symbol 'custom-group) (nreverse members)) - (when (eq (nth 1 entry) 'custom-group) - (push entry members)))))) - -(defun custom-group-value-create (widget) - "Insert a customize group for WIDGET in the current buffer." - (let* ((state (widget-get widget :custom-state)) - (level (widget-get widget :custom-level)) - ;; (indent (widget-get widget :indent)) - (prefix (widget-get widget :custom-prefix)) - (buttons (widget-get widget :buttons)) - (tag (widget-get widget :tag)) - (symbol (widget-value widget)) - (members (custom-group-members symbol - (and (eq custom-buffer-style 'tree) - custom-browse-only-groups)))) - (cond ((and (eq custom-buffer-style 'tree) - (eq state 'hidden) - (or members (custom-unloaded-widget-p widget))) - (custom-browse-insert-prefix prefix) - (push (widget-create-child-and-convert - widget 'custom-browse-visibility - ;; :tag-glyph "plus" - :tag "+") - buttons) - (insert "-- ") - ;; (widget-glyph-insert nil "-- " "horizontal") - (push (widget-create-child-and-convert - widget 'custom-browse-group-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons)) - ((and (eq custom-buffer-style 'tree) - (zerop (length members))) - (custom-browse-insert-prefix prefix) - (insert "[ ]-- ") - ;; (widget-glyph-insert nil "[ ]" "empty") - ;; (widget-glyph-insert nil "-- " "horizontal") - (push (widget-create-child-and-convert - widget 'custom-browse-group-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons)) - ((eq custom-buffer-style 'tree) - (custom-browse-insert-prefix prefix) - (custom-load-widget widget) - (if (zerop (length members)) - (progn - (custom-browse-insert-prefix prefix) - (insert "[ ]-- ") - ;; (widget-glyph-insert nil "[ ]" "empty") - ;; (widget-glyph-insert nil "-- " "horizontal") - (push (widget-create-child-and-convert - widget 'custom-browse-group-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons)) - (push (widget-create-child-and-convert - widget 'custom-browse-visibility - ;; :tag-glyph "minus" - :tag "-") - buttons) - (insert "-\\ ") - ;; (widget-glyph-insert nil "-\\ " "top") - (push (widget-create-child-and-convert - widget 'custom-browse-group-tag) - buttons) - (insert " " tag "\n") - (widget-put widget :buttons buttons) - (message "Creating group...") - (let* ((members (custom-sort-items members - custom-browse-sort-alphabetically - custom-browse-order-groups)) - (prefixes (widget-get widget :custom-prefixes)) - (custom-prefix-list (custom-prefix-add symbol prefixes)) - (extra-prefix (if (widget-get widget :custom-last) - " " - " | ")) - (prefix (concat prefix extra-prefix)) - children entry) - (while members - (setq entry (car members) - members (cdr members)) - (push (widget-create-child-and-convert - widget (nth 1 entry) - :group widget - :tag (custom-unlispify-tag-name (nth 0 entry)) - :custom-prefixes custom-prefix-list - :custom-level (1+ level) - :custom-last (null members) - :value (nth 0 entry) - :custom-prefix prefix) - children)) - (widget-put widget :children (reverse children))) - (message "Creating group...done"))) - ;; Nested style. - ((eq state 'hidden) - ;; Create level indicator. - (unless (eq custom-buffer-style 'links) - (insert-char ?\ (* custom-buffer-indent (1- level))) - (insert "-- ")) - ;; Create link indicator. - (when (eq custom-buffer-style 'links) - (insert " ") - (push (widget-create-child-and-convert - widget 'custom-group-link - :tag "Open" - :tag-glyph '("open-up" "open-down") - symbol) - buttons) - (insert " ")) - ;; Create tag. - (let ((begin (point))) - (insert tag) - (widget-specify-sample widget begin (point))) - (insert " group") - ;; Create visibility indicator. - (unless (eq custom-buffer-style 'links) - (insert ": ") - (push (widget-create-child-and-convert - widget 'custom-group-visibility - :help-echo "Show members of this group" - :action 'custom-toggle-parent - (not (eq state 'hidden))) - buttons)) - (insert " \n") - ;; Create magic button. - (let ((magic (widget-create-child-and-convert - widget 'custom-magic nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) - ;; Update buttons. - (widget-put widget :buttons buttons) - ;; Insert documentation. - (if (and (eq custom-buffer-style 'links) (> level 1)) - (widget-put widget :documentation-indent 0)) - (widget-default-format-handler widget ?h)) - ;; Nested style. - (t ;Visible. - (custom-load-widget widget) - ;; Update members - (setq members (custom-group-members - symbol (and (eq custom-buffer-style 'tree) - custom-browse-only-groups))) - ;; Add parent groups references above the group. - (if t ;;; This should test that the buffer - ;;; was made to display a group. - (when (eq level 1) - (if (custom-add-parent-links widget - "Go to parent group:") - (insert "\n")))) - ;; Create level indicator. - (insert-char ?\ (* custom-buffer-indent (1- level))) - (insert "/- ") - ;; Create tag. - (let ((start (point))) - (insert tag) - (widget-specify-sample widget start (point))) - (insert " group: ") - ;; Create visibility indicator. - (unless (eq custom-buffer-style 'links) - (insert "--------") - (push (widget-create-child-and-convert - widget 'visibility - :help-echo "Hide members of this group" - :action 'custom-toggle-parent - (not (eq state 'hidden))) - buttons) - (insert " ")) - ;; Create more dashes. - ;; Use 76 instead of 75 to compensate for the temporary "<" - ;; added by `widget-insert'. - (insert-char ?- (- 76 (current-column) - (* custom-buffer-indent level))) - (insert "\\\n") - ;; Create magic button. - (let ((magic (widget-create-child-and-convert - widget 'custom-magic - :indent 0 - nil))) - (widget-put widget :custom-magic magic) - (push magic buttons)) - ;; Update buttons. - (widget-put widget :buttons buttons) - ;; Insert documentation. - (widget-default-format-handler widget ?h) - ;; Parent groups. - (if nil ;;; This should test that the buffer - ;;; was not made to display a group. - (when (eq level 1) - (insert-char ?\ custom-buffer-indent) - (custom-add-parent-links widget))) - (custom-add-see-also widget - (make-string (* custom-buffer-indent level) - ?\ )) - ;; Members. - (message "Creating group...") - (let* ((members (custom-sort-items members - custom-buffer-sort-alphabetically - custom-buffer-order-groups)) - (prefixes (widget-get widget :custom-prefixes)) - (custom-prefix-list (custom-prefix-add symbol prefixes)) - (length (length members)) - (count 0) - (children (mapcar - (lambda (entry) - (widget-insert "\n") - (when (zerop (% count custom-skip-messages)) - (display-message - 'progress - (format "\ -Creating group members... %2d%%" - (/ (* 100.0 count) length)))) - (incf count) - (prog1 - (widget-create-child-and-convert - widget (nth 1 entry) - :group widget - :tag (custom-unlispify-tag-name - (nth 0 entry)) - :custom-prefixes custom-prefix-list - :custom-level (1+ level) - :value (nth 0 entry)) - (unless (eq (preceding-char) ?\n) - (widget-insert "\n")))) - members))) - (message "Creating group magic...") - (mapc 'custom-magic-reset children) - (message "Creating group state...") - (widget-put widget :children children) - (custom-group-state-update widget) - (message "Creating group... done")) - ;; End line - (insert "\n") - (insert-char ?\ (* custom-buffer-indent (1- level))) - (insert "\\- " (widget-get widget :tag) " group end ") - (insert-char ?- (- 75 (current-column) (* custom-buffer-indent level))) - (insert "/\n"))))) - -(defvar custom-group-menu - '(("Set for Current Session" custom-group-set - (lambda (widget) - (eq (widget-get widget :custom-state) 'modified))) - ("Save for Future Sessions" custom-group-save - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set)))) - ("Reset to Current" custom-group-reset-current - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified)))) - ("Reset to Saved" custom-group-reset-saved - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set)))) - ("Reset to standard setting" custom-group-reset-standard - (lambda (widget) - (memq (widget-get widget :custom-state) '(modified set saved))))) - "Alist of actions for the `custom-group' widget. -Each entry has the form (NAME ACTION FILTER) where NAME is the name of -the menu entry, ACTION is the function to call on the widget when the -menu is selected, and FILTER is a predicate which takes a `custom-group' -widget as an argument, and returns non-nil if ACTION is valid on that -widget. If FILTER is nil, ACTION is always valid.") - -(defun custom-group-action (widget &optional event) - "Show the menu for `custom-group' WIDGET. -Optional EVENT is the location for the menu." - (if (eq (widget-get widget :custom-state) 'hidden) - (custom-toggle-hide widget) - (let* ((completion-ignore-case t) - (answer (widget-choose (concat "Operation on " - (custom-unlispify-tag-name - (widget-get widget :value))) - (custom-menu-filter custom-group-menu - widget) - event))) - (if answer - (funcall answer widget))))) - -(defun custom-group-set (widget) - "Set changes in all modified group members." - (let ((children (widget-get widget :children))) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-set))) - children))) - -(defun custom-group-save (widget) - "Save all modified group members." - (let ((children (widget-get widget :children))) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-save))) - children))) - -(defun custom-group-reset-current (widget) - "Reset all modified group members." - (let ((children (widget-get widget :children))) - (mapc (lambda (child) - (when (eq (widget-get child :custom-state) 'modified) - (widget-apply child :custom-reset-current))) - children))) - -(defun custom-group-reset-saved (widget) - "Reset all modified or set group members." - (let ((children (widget-get widget :children))) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) '(modified set)) - (widget-apply child :custom-reset-saved))) - children))) - -(defun custom-group-reset-standard (widget) - "Reset all modified, set, or saved group members." - (let ((children (widget-get widget :children))) - (mapc (lambda (child) - (when (memq (widget-get child :custom-state) - '(modified set saved)) - (widget-apply child :custom-reset-standard))) - children))) - -(defun custom-group-state-update (widget) - "Update magic." - (unless (eq (widget-get widget :custom-state) 'hidden) - (let* ((children (widget-get widget :children)) - (states (mapcar (lambda (child) - (widget-get child :custom-state)) - children)) - (magics custom-magic-alist) - (found 'standard)) - (while magics - (let ((magic (car (car magics)))) - (if (and (not (eq magic 'hidden)) - (memq magic states)) - (setq found magic - magics nil) - (setq magics (cdr magics))))) - (widget-put widget :custom-state found))) - (custom-magic-reset widget)) - -;;; The `custom-save-all' Function. -;;;###autoload -(defcustom custom-file "~/.emacs" - "File used for storing customization information. -If you change this from the default \"~/.emacs\" you need to -explicitly load that file for the settings to take effect." - :type 'file - :group 'customize) - -(defun custom-save-delete (symbol) - "Delete the call to SYMBOL form `custom-file'. -Leave point at the location of the call, or after the last expression." - (let ((find-file-hooks nil) - (auto-mode-alist nil)) - (set-buffer (find-file-noselect custom-file))) - (goto-char (point-min)) - (catch 'found - (while t - (let ((sexp (condition-case nil - (read (current-buffer)) - (end-of-file (throw 'found nil))))) - (when (and (listp sexp) - (eq (car sexp) symbol)) - (delete-region (save-excursion - (backward-sexp) - (point)) - (point)) - (throw 'found nil)))))) - -(defun custom-save-variables () - "Save all customized variables in `custom-file'." - (save-excursion - (custom-save-delete 'custom-set-variables) - (let ((standard-output (current-buffer))) - (unless (bolp) - (princ "\n")) - (princ "(custom-set-variables") - (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-value)) - (requests (get symbol 'custom-requests)) - (now (not (or (get symbol 'standard-value) - (and (not (boundp symbol)) - (not (get symbol 'force-value))))))) - (when value - (princ "\n '(") - (princ symbol) - (princ " ") - (prin1 (car value)) - (cond (requests - (if now - (princ " t ") - (princ " nil ")) - (prin1 requests) - (princ ")")) - (now - (princ " t)")) - (t - (princ ")"))))))) - (princ ")") - (unless (looking-at "\n") - (princ "\n"))))) - -(defun custom-save-faces () - "Save all customized faces in `custom-file'." - (save-excursion - (custom-save-delete 'custom-set-faces) - (let ((standard-output (current-buffer))) - (unless (bolp) - (princ "\n")) - (princ "(custom-set-faces") - (let ((value (get 'default 'saved-face))) - ;; The default face must be first, since it affects the others. - (when value - (princ "\n '(default ") - (prin1 value) - (if (or (get 'default 'face-defface-spec) - (and (not (find-face 'default)) - (not (get 'default 'force-face)))) - (princ ")") - (princ " t)")))) - (mapatoms (lambda (symbol) - (let ((value (get symbol 'saved-face))) - (when (and (not (eq symbol 'default)) - ;; Don't print default face here. - value) - (princ "\n '(") - (princ symbol) - (princ " ") - (prin1 value) - (if (or (get symbol 'face-defface-spec) - (and (not (find-face symbol)) - (not (get symbol 'force-face)))) - (princ ")") - (princ " t)")))))) - (princ ")") - (unless (looking-at "\n") - (princ "\n"))))) - -;;;###autoload -(defun customize-save-customized () - "Save all user options which have been set in this session." - (interactive) - (mapatoms (lambda (symbol) - (let ((face (get symbol 'customized-face)) - (value (get symbol 'customized-value))) - (when face - (put symbol 'saved-face face) - (put symbol 'customized-face nil)) - (when value - (put symbol 'saved-value value) - (put symbol 'customized-value nil))))) - ;; We really should update all custom buffers here. - (custom-save-all)) - -;;;###autoload -(defun custom-save-all () - "Save all customizations in `custom-file'." - (let ((inhibit-read-only t)) - (custom-save-variables) - (custom-save-faces) - (let ((find-file-hooks nil) - (auto-mode-alist)) - (with-current-buffer (find-file-noselect custom-file) - (save-buffer))))) - - -;;; The Customize Menu. - -;;; Menu support - -(defun custom-face-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization face SYMBOL." - (vector (custom-unlispify-menu-entry symbol) - `(customize-face ',symbol) - t)) - -(defun custom-variable-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization variable SYMBOL." - (let ((type (get symbol 'custom-type))) - (unless (listp type) - (setq type (list type))) - (if (and type (widget-get type :custom-menu)) - (widget-apply type :custom-menu symbol) - (vector (custom-unlispify-menu-entry symbol) - `(customize-variable ',symbol) - t)))) - -;; Add checkboxes to boolean variable entries. -(widget-put (get 'boolean 'widget-type) - :custom-menu (lambda (widget symbol) - `[,(custom-unlispify-menu-entry symbol) - (customize-variable ',symbol) - :style toggle - :selected ,symbol])) - -;; XEmacs can create menus dynamically. -(defun custom-group-menu-create (widget symbol) - "Ignoring WIDGET, create a menu entry for customization group SYMBOL." - `( ,(custom-unlispify-menu-entry symbol t) - :filter (lambda (&rest junk) - (let ((item (custom-menu-create ',symbol))) - (if (listp item) - (cdr item) - (list item)))))) - -;;;###autoload -(defun custom-menu-create (symbol) - "Create menu for customization group SYMBOL. -The menu is in a format applicable to `easy-menu-define'." - (let* ((item (vector (custom-unlispify-menu-entry symbol) - `(customize-group ',symbol) - t))) - ;; Item is the entry for creating a menu buffer for SYMBOL. - ;; We may nest, if the menu is not too big. - (custom-load-symbol symbol) - (if (< (length (get symbol 'custom-group)) widget-menu-max-size) - ;; The menu is not too big. - (let ((custom-prefix-list (custom-prefix-add symbol - custom-prefix-list)) - (members (custom-sort-items (get symbol 'custom-group) - custom-menu-sort-alphabetically - custom-menu-order-groups))) - ;; Create the menu. - `(,(custom-unlispify-menu-entry symbol t) - ,item - "--" - ,@(mapcar (lambda (entry) - (widget-apply (if (listp (nth 1 entry)) - (nth 1 entry) - (list (nth 1 entry))) - :custom-menu (nth 0 entry))) - members))) - ;; The menu was too big. - item))) - -;;;###autoload -(defun customize-menu-create (symbol &optional name) - "Return a customize menu for customization group SYMBOL. -If optional NAME is given, use that as the name of the menu. -Otherwise the menu will be named `Customize'. -The format is suitable for use with `easy-menu-define'." - (unless name - (setq name "Customize")) - `(,name - :filter (lambda (&rest junk) - (cdr (custom-menu-create ',symbol))))) - -;;; The Custom Mode. - -(defvar custom-mode-map nil - "Keymap for `custom-mode'.") - -(unless custom-mode-map - (setq custom-mode-map (make-sparse-keymap)) - (set-keymap-parents custom-mode-map widget-keymap) - (suppress-keymap custom-mode-map) - (define-key custom-mode-map " " 'scroll-up) - (define-key custom-mode-map [delete] 'scroll-down) - (define-key custom-mode-map "q" 'Custom-buffer-done) - (define-key custom-mode-map "u" 'Custom-goto-parent) - (define-key custom-mode-map "n" 'widget-forward) - (define-key custom-mode-map "p" 'widget-backward)) - -(easy-menu-define Custom-mode-menu - custom-mode-map - "Menu used in customization buffers." - `("Custom" - ,(customize-menu-create 'customize) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t] - ["Info" (Info-goto-node "(xemacs)Easy Customization") t])) - -(defun Custom-goto-parent () - "Go to the parent group listed at the top of this buffer. -If several parents are listed, go to the first of them." - (interactive) - (save-excursion - (goto-char (point-min)) - (if (search-forward "\nGo to parent group: " nil t) - (let* ((button (get-char-property (point) 'button)) - (parent (downcase (widget-get button :tag)))) - (customize-group parent))))) - -(defcustom custom-mode-hook nil - "Hook called when entering custom-mode." - :type 'hook - :group 'custom-buffer ) - -(defun custom-state-buffer-message (widget) - (if (eq (widget-get (widget-get widget :parent) :custom-state) 'modified) - (message - "To install your edits, invoke [State] and choose the Set operation"))) - -(defun custom-mode () - "Major mode for editing customization buffers. - -The following commands are available: - -Move to next button or editable field. \\[widget-forward] -Move to previous button or editable field. \\[widget-backward] -\\\ -Complete content of editable text field. \\[widget-complete] -\\\ -Invoke button under point. \\[widget-button-press] -Set all modifications. \\[Custom-set] -Make all modifications default. \\[Custom-save] -Reset all modified options. \\[Custom-reset-current] -Reset all modified or set options. \\[Custom-reset-saved] -Reset all options. \\[Custom-reset-standard] - -Entry to this mode calls the value of `custom-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'custom-mode - mode-name "Custom") - (use-local-map custom-mode-map) - (easy-menu-add Custom-mode-menu) - (make-local-variable 'custom-options) - (make-local-variable 'widget-documentation-face) - (setq widget-documentation-face 'custom-documentation-face) - (make-local-variable 'widget-button-face) - (setq widget-button-face 'custom-button-face) - (make-local-hook 'widget-edit-functions) - (add-hook 'widget-edit-functions 'custom-state-buffer-message nil t) - (run-hooks 'custom-mode-hook)) - - -;;; The End. - -(provide 'cus-edit) - -;; cus-edit.el ends here diff --git a/lisp/cus-face.el b/lisp/cus-face.el deleted file mode 100644 index 6be65ba..0000000 --- a/lisp/cus-face.el +++ /dev/null @@ -1,275 +0,0 @@ -;;; cus-face.el -- Support for Custom faces. -;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic -;; Keywords: help, faces -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -;;; Commentary: -;; -;; See `custom.el'. - -;; This file should probably be dissolved, and code moved to faces.el, -;; like Stallman did. - -;;; Code: - -(require 'custom) - -;; To elude the warnings for font functions. -(eval-when-compile - (require 'font)) - -;;; Declaring a face. - -;;;###autoload -(defun custom-declare-face (face spec doc &rest args) - "Like `defface', but FACE is evaluated as a normal argument." - ;; (when (fboundp 'pureload) - ;; (error "Attempt to declare a face during dump")) - (unless (get face 'face-defface-spec) - (put face 'face-defface-spec spec) - (unless (find-face face) - ;; If the user has already created the face, respect that. - (let ((value (or (get face 'saved-face) spec)) - (frames (relevant-custom-frames)) - frame) - ;; Create global face. - (make-empty-face face) - (face-display-set face value) - ;; Create frame local faces - (while frames - (setq frame (car frames) - frames (cdr frames)) - (face-display-set face value frame)) - (init-face-from-resources face))) - (when (and doc (null (face-doc-string face))) - (set-face-doc-string face doc)) - (custom-handle-all-keywords face args 'custom-face) - (run-hooks 'custom-define-hook)) - face) - -;;; Font Attributes. - -(defconst custom-face-attributes - '((:foreground (color :tag "Foreground" - :value "" - :help-echo "Set foreground color.") - set-face-foreground face-foreground-name) - (:background (color :tag "Background" - :value "" - :help-echo "Set background color.") - set-face-background face-background-name) - (:size (editable-field :format "Size: %v" - :help-echo "\ -Text size (e.g. 9pt or 2mm).") - custom-set-face-font-size custom-face-font-size) - (:family (editable-field :format "Font Family: %v" - :help-echo "\ -Name of font family to use (e.g. times).") - custom-set-face-font-family custom-face-font-family) - (:background-pixmap (editable-field :format "Background pixmap: %v" - :help-echo "\ -Name of background pixmap file.") - set-face-background-pixmap custom-face-background-pixmap) - (:dim (toggle :format "%[Dim%]: %v\n" - :help-echo "Control whether the text should be dimmed.") - set-face-dim-p face-dim-p) - (:bold (toggle :format "%[Bold%]: %v\n" - :help-echo "Control whether a bold font should be used.") - custom-set-face-bold custom-face-bold) - (:italic (toggle :format "%[Italic%]: %v\n" - :help-echo "\ -Control whether an italic font should be used.") - custom-set-face-italic custom-face-italic) - (:underline (toggle :format "%[Underline%]: %v\n" - :help-echo "\ -Control whether the text should be underlined.") - set-face-underline-p face-underline-p) - (:strikethru (toggle :format "%[Strikethru%]: %v\n" - :help-echo "\ -Control whether the text should be strikethru.") - set-face-strikethru-p face-strikethru-p) - (:inverse-video (toggle :format "%[Inverse Video%]: %v\n" - :help-echo "\ -Control whether the text should be inverted. Works only on TTY-s") - set-face-reverse-p face-reverse-p)) - "Alist of face attributes. - -The elements are of the form (KEY TYPE SET GET) where KEY is a symbol -identifying the attribute, TYPE is a widget type for editing the -attibute, SET is a function for setting the attribute value, and GET is a function for getiing the attribute value. - -The SET function should take three arguments, the face to modify, the -value of the attribute, and optionally the frame where the face should -be changed. - -The GET function should take two arguments, the face to examine, and -optonally the frame where the face should be examined.") - -(defun face-custom-attributes-set (face frame &rest atts) - "For FACE on FRAME set the attributes [KEYWORD VALUE].... -Each keyword should be listed in `custom-face-attributes'. - -If FRAME is nil, set the default face." - (while atts - (let* ((name (nth 0 atts)) - (value (nth 1 atts)) - (fun (nth 2 (assq name custom-face-attributes)))) - (setq atts (cdr (cdr atts))) - (condition-case nil - (funcall fun face value frame) - (error nil))))) - -(defun face-custom-attributes-get (face frame) - "For FACE on FRAME get the attributes [KEYWORD VALUE].... -Each keyword should be listed in `custom-face-attributes'. - -If FRAME is nil, use the default face." - (condition-case nil - ;; Attempt to get `font.el' from w3. - (require 'font) - (error nil)) - (let ((atts custom-face-attributes) - att result get) - (while atts - (setq att (car atts) - atts (cdr atts) - get (nth 3 att)) - (condition-case nil - ;; This may fail if w3 doesn't exist. - (when get - (let ((answer (funcall get face frame))) - (unless (equal answer (funcall get 'default frame)) - (when (widget-apply (nth 1 att) :match answer) - (setq result (cons (nth 0 att) (cons answer result))))))) - (error nil))) - result)) - -(defsubst custom-face-get-spec (symbol) - (or (get symbol 'customized-face) - (get symbol 'saved-face) - (get symbol 'face-defface-spec) - ;; Attempt to construct it. - (list (list t (face-custom-attributes-get - symbol (selected-frame)))))) - -(defun custom-set-face-bold (face value &optional frame) - "Set the bold property of FACE to VALUE." - (if value - (make-face-bold face frame) - (make-face-unbold face frame))) - -;; Really, we should get rid of these font.el dependencies... They -;; are still presenting a problem with dumping the faces (font.el is -;; too bloated for us to dump). I am thinking about hacking up -;; font-like functionality myself for the sake of this file. It will -;; probably be to-the-point and more efficient. - -(defun custom-face-bold (face &rest args) - "Return non-nil if the font of FACE is bold." - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (font-bold-p fontobj))) - -(defun custom-set-face-italic (face value &optional frame) - "Set the italic property of FACE to VALUE." - (if value - (make-face-italic face frame) - (make-face-unitalic face frame))) - -(defun custom-face-italic (face &rest args) - "Return non-nil if the font of FACE is italic." - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (font-italic-p fontobj))) - -(defun custom-face-background-pixmap (face &rest args) - "Return the name of the background pixmap file used for FACE." - (let ((image (apply 'specifier-instance - (face-background-pixmap face) args))) - (and image - (image-instance-file-name image)))) - -(defun custom-set-face-font-size (face size &rest args) - "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (set-font-size fontobj size) - (apply 'font-set-face-font face fontobj args))) - -(defun custom-face-font-size (face &rest args) - "Return the size of the font of FACE as a string." - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (format "%s" (font-size fontobj)))) - -(defun custom-set-face-font-family (face family &rest args) - "Set the font of FACE to FAMILY." - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (set-font-family fontobj family) - (apply 'font-set-face-font face fontobj args))) - -(defun custom-face-font-family (face &rest args) - "Return the name of the font family of FACE." - (let* ((font (apply 'face-font-name face args)) - ;; Gag - (fontobj (font-create-object font))) - (font-family fontobj))) - -;;;###autoload -(defun custom-set-face-update-spec (face display plist) - "Customize the FACE for display types matching DISPLAY, merging - in the new items from PLIST" - (let ((spec (face-spec-update-all-matching (custom-face-get-spec face) - display plist))) - (put face 'customized-face spec) - (face-spec-set face spec))) - -;;; Initializing. - -;;;###autoload -(defun custom-set-faces (&rest args) - "Initialize faces according to user preferences. -The arguments should be a list where each entry has the form: - - (FACE SPEC [NOW]) - -SPEC will be stored as the saved value for FACE. If NOW is present -and non-nil, FACE will also be created according to SPEC. - -See `defface' for the format of SPEC." - (while args - (let ((entry (car args))) - (if (listp entry) - (let ((face (nth 0 entry)) - (spec (nth 1 entry)) - (now (nth 2 entry))) - (put face 'saved-face spec) - (when now - (put face 'force-face t)) - (when (or now (find-face face)) - (unless (find-face face) - (make-empty-face face)) - (face-spec-set face spec)) - (setq args (cdr args))) - ;; Old format, a plist of FACE SPEC pairs. - (let ((face (nth 0 args)) - (spec (nth 1 args))) - (put face 'saved-face spec)) - (setq args (cdr (cdr args))))))) - -;;; The End. - -(provide 'cus-face) - -;; cus-face.el ends here diff --git a/lisp/cus-load.el b/lisp/cus-load.el deleted file mode 100644 index 28bef12..0000000 --- a/lisp/cus-load.el +++ /dev/null @@ -1,63 +0,0 @@ -;;; cus-load.el --- Batch load all available cus-load files - -;; Copyright (C) 1997 by Free Software Foundation, Inc. - -;; Author: Steven L Baur -;; Keywords: internal, 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: - -;; In FSF all of the custom loads are in a single `cus-load' file. -;; However, we have them distributed across directories, with optional -;; incremental loading. Here we simply collect the whole set. - - -;;; Code: - -(require 'custom) - -(defun custom-add-loads (symbol list) - "Update the custom-loads list of a symbol. -This works by adding the elements from LIST to the SYMBOL's -`custom-loads' property, avoiding duplicates. Also, SYMBOL is -added to `custom-group-hash-table'." - (let ((loads (get symbol 'custom-loads))) - (dolist (el list) - (unless (member el loads) - (setq loads (nconc loads (list el))))) - (put symbol 'custom-loads loads) - (puthash symbol t custom-group-hash-table))) - -(message "Loading customization dependencies...") - -;; Garbage-collection seems to be very intensive here, and it slows -;; things down. Nuke it. -(let ((gc-cons-threshold most-positive-fixnum)) - (mapc (lambda (dir) - (load (expand-file-name "custom-load" dir) t t)) - load-path)) - -(message "Loading customization dependencies...done") - -(provide 'cus-load) - -;;; cus-load.el ends here diff --git a/lisp/cus-start.el b/lisp/cus-start.el deleted file mode 100644 index 8dc92d8..0000000 --- a/lisp/cus-start.el +++ /dev/null @@ -1,194 +0,0 @@ -;;; cus-start.el --- define customization properties of builtins. - -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; The following code is used to define the customization properties -;; for builtin variables, and variables in the packages that are -;; preloaded /very/ early, before custom.el itself (replace.el is such -;; an example). The way it handles custom stuff is dirty, and should -;; be regarded as a last resort. DO NOT add variables here, unless -;; you know what you are doing. - -;; Must be run before the user has changed the value of any options! - - -;;; Code: - -(require 'custom) - -(let ((all '(;; boolean - (abbrev-all-caps abbrev boolean) - (allow-deletion-of-last-visible-frame frames boolean) - (debug-on-quit debug boolean) - (delete-auto-save-files auto-save boolean) - (delete-exited-processes processes-basics boolean) - (indent-tabs-mode editing-basics boolean) - (load-ignore-elc-files maint boolean) - (load-warn-when-source-newer maint boolean) - (load-warn-when-source-only maint boolean) - (modifier-keys-are-sticky keyboard boolean) - (no-redraw-on-reenter display boolean) - (scroll-on-clipped-lines display boolean) - (truncate-partial-width-windows display boolean) - (visible-bell sound boolean) - (x-allow-sendevents x boolean) - (zmacs-regions editing-basics boolean) - ;; integer - (auto-save-interval auto-save integer) - (bell-volume sound integer) - (echo-keystrokes keyboard integer) - (gc-cons-threshold alloc integer) - (next-screen-context-lines display integer) - (scroll-conservatively display integer) - (scroll-step windows integer) - (window-min-height windows integer) - (window-min-width windows integer) - ;; object - (auto-save-file-format auto-save - (choice (const :tag "Normal" t) - (repeat (symbol :tag "Format")))) - (completion-ignored-extensions minibuffer - (repeat - (string :format "%v"))) - (debug-ignored-errors debug (repeat (choice :format "%v" - (symbol :tag "Class") - regexp))) - (debug-on-error debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (debug-on-signal debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (exec-path processes-basics (repeat - (choice :tag "Directory" - (const :tag "Default" nil) - (directory :format "%v")))) - (file-name-handler-alist data (repeat - (cons regexp - (function :tag "Handler")))) - (shell-file-name execute file) - (stack-trace-on-error debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - (stack-trace-on-signal debug (choice (const :tag "off" nil) - (const :tag "Always" t) - (repeat :menu-tag "When" - :value (nil) - (symbol - :tag "Condition")))) - ;; buffer-local - (case-fold-search matching boolean) - (ctl-arrow display (choice (integer 160) - (sexp :tag "160 (default)" - :format "%t\n"))) - (fill-column fill integer) - (left-margin fill integer) - (tab-width editing-basics integer) - (truncate-lines display boolean) - (overwrite-mode editing-basics ;; for the options menu - dverna - (choice (const :tag "disabled" nil) - (const :tag "textual" - 'overwrite-mode-textual) - (const :tag "binary" - 'overwrite-mode-binary))) - ;; not documented as user-options, but should still be - ;; customizable: - (bar-cursor display (choice (const :tag "Block Cursor" nil) - (const :tag "Bar Cursor (1 pixel)" t) - (sexp :tag "Bar Cursor (2 pixels)" - :format "%t\n" 'other))) - (default-frame-plist frames plist) - (default-tty-frame-plist frames plist) - (default-x-frame-plist frames plist) - (disable-auto-save-when-buffer-shrinks auto-save boolean) - (find-file-use-truenames find-file boolean) - (find-file-compare-truenames find-file boolean) - (focus-follows-mouse x boolean) - (help-char keyboard (choice character - (sexp :tag "Single key specifier"))) - (max-lisp-eval-depth limits integer) - (max-specpdl-size limits integer) - (meta-prefix-char keyboard character) - (parse-sexp-ignore-comments editing-basics boolean) - (selective-display display - (choice (const :tag "off" nil) - (integer :tag "space" - :format "%v" - 1) - (const :tag "on" t))) - (selective-display-ellipses display boolean) - (signal-error-on-buffer-boundary internal boolean) - (temp-buffer-show-function - windows (radio (function-item :tag "Temp Buffers Always in Same Frame" - :format "%t\n" - show-temp-buffer-in-current-frame) - (const :tag "Temp Buffers Like Other Buffers" nil) - (function :tag "Other"))) - (undo-threshold undo integer) - (undo-high-threshold undo integer) - (words-include-escapes editing-basics boolean) - ;; These are from replace.el, which is loaded too early - ;; to be customizable. - (case-replace matching boolean) - (query-replace-highlight matching boolean) - (list-matching-lines-default-context-lines matching integer))) - this symbol group type) - (while all - (setq this (car all) - all (cdr all) - symbol (nth 0 this) - group (nth 1 this) - type (nth 2 this)) - (if (not (boundp symbol)) - ;; This is loaded so early, there is no message - (if (fboundp 'message) - ;; If variables are removed from C code, give an error here! - (message "Intrinsic `%S' not bound" symbol)) - ;; This is called before any user can have changed the value. - (put symbol 'standard-value - (list (quote-maybe (default-value symbol)))) - ;; Add it to the right group. - (custom-add-to-group group symbol 'custom-variable) - ;; Set the type. - (put symbol 'custom-type type)))) - -;; This is to prevent it from being reloaded by `cus-load.el'. -(provide 'cus-start) - -;;; cus-start.el ends here. diff --git a/lisp/custom-load.el b/lisp/custom-load.el deleted file mode 100644 index cc40648..0000000 --- a/lisp/custom-load.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; custom-load.el --- automatically extracted custom dependencies - -;;; Code: - -(custom-add-loads 'extensions '("auto-show" "wid-edit")) -(custom-add-loads 'info-faces '("info")) -(custom-add-loads 'custom-buffer '("cus-edit")) -(custom-add-loads 'custom-faces '("cus-edit")) -(custom-add-loads 'auto-show '("auto-show")) -(custom-add-loads 'drag-n-drop '("dragdrop")) -(custom-add-loads 'mouse '("mouse" "mwheel")) -(custom-add-loads 'etags '("etags")) -(custom-add-loads 'package-tools '("package-get" "package-ui")) -(custom-add-loads 'widgets '("wid-browse" "wid-edit")) -(custom-add-loads 'menu '("menubar-items")) -(custom-add-loads 'minibuffer '("simple" "minibuf")) -(custom-add-loads 'log-message '("simple")) -(custom-add-loads 'environment '("frame" "keydefs" "minibuf" "modeline" "window-xemacs" "menubar" "x-init" "toolbar-items" "cus-edit" "gnuserv" "sound")) -(custom-add-loads 'sound '("sound")) -(custom-add-loads 'pui '("package-ui")) -(custom-add-loads 'terminals '("gnuserv")) -(custom-add-loads 'auto-save '("files" "auto-save")) -(custom-add-loads 'mail '("simple")) -(custom-add-loads 'custom-menu '("cus-edit")) -(custom-add-loads 'docs '("hyper-apropos" "info")) -(custom-add-loads 'tools '("etags" "hyper-apropos")) -(custom-add-loads 'editing-basics '("cmdloop" "simple" "files" "lisp")) -(custom-add-loads 'internal '("cus-edit")) -(custom-add-loads 'help-appearance '("help" "help-macro")) -(custom-add-loads 'build-report '("build-report")) -(custom-add-loads 'buffers-menu '("menubar-items")) -(custom-add-loads 'hypermedia '("wid-edit")) -(custom-add-loads 'lisp '("lisp" "lisp-mode" "hyper-apropos")) -(custom-add-loads 'applications '("cus-edit")) -(custom-add-loads 'help '("help" "cus-edit" "hyper-apropos" "info")) -(custom-add-loads 'keyboard '("cmdloop")) -(custom-add-loads 'hyper-apropos-faces '("hyper-apropos")) -(custom-add-loads 'ldap '("ldap")) -(custom-add-loads 'widget-browse '("wid-browse")) -(custom-add-loads 'data '("auto-save")) -(custom-add-loads 'warnings '("simple")) -(custom-add-loads 'widget-documentation '("wid-edit")) -(custom-add-loads 'comm '("ldap")) -(custom-add-loads 'backup '("files")) -(custom-add-loads 'frames '("frame" "window-xemacs" "gui" "gnuserv")) -(custom-add-loads 'customize '("cus-edit" "wid-edit")) -(custom-add-loads 'custom-browse '("cus-edit")) -(custom-add-loads 'abbrev '("abbrev" "files")) -(custom-add-loads 'programming '("cus-edit")) -(custom-add-loads 'toolbar '("toolbar-items")) -(custom-add-loads 'dired '("files")) -(custom-add-loads 'dnd-debug '("dragdrop")) -(custom-add-loads 'package-get '("package-get")) -(custom-add-loads 'killing '("simple")) -(custom-add-loads 'widget-button '("wid-edit")) -(custom-add-loads 'paren-blinking '("simple")) -(custom-add-loads 'find-file '("files")) -(custom-add-loads 'files '("files")) -(custom-add-loads 'build '("build-report")) -(custom-add-loads 'font-lock '("font-lock")) -(custom-add-loads 'external '("process" "cus-edit")) -(custom-add-loads 'development '("process" "lisp-mode" "cus-edit")) -(custom-add-loads 'gnuserv '("gnuserv")) -(custom-add-loads 'fill-comments '("simple")) -(custom-add-loads 'windows '("window" "window-xemacs")) -(custom-add-loads 'widget-faces '("wid-edit")) -(custom-add-loads 'languages '("lisp-mode" "cus-edit" "font-lock")) -(custom-add-loads 'fill '("simple" "fill")) -(custom-add-loads 'custom-magic-faces '("cus-edit")) -(custom-add-loads 'display '("toolbar" "scrollbar" "auto-show")) -(custom-add-loads 'faces '("faces" "cus-edit" "font-lock" "font" "hyper-apropos" "info" "wid-edit")) -(custom-add-loads 'emacs '("faces" "help" "files" "cus-edit" "package-get")) -(custom-add-loads 'processes '("process" "gnuserv")) -(custom-add-loads 'hyper-apropos '("hyper-apropos")) -(custom-add-loads 'wp '("cus-edit")) -(custom-add-loads 'vc '("files")) -(custom-add-loads 'isearch '("isearch-mode")) -(custom-add-loads 'font-lock-faces '("font-lock")) -(custom-add-loads 'modeline '("modeline")) -(custom-add-loads 'editing '("simple" "abbrev" "fill" "mouse" "cus-edit" "dragdrop")) -(custom-add-loads 'matching '("simple" "isearch-mode" "hyper-apropos")) -(custom-add-loads 'i18n '("cus-edit")) -(custom-add-loads 'info '("toolbar-items" "info")) -(custom-add-loads 'x '("x-faces" "x-font-menu")) - -;;; custom-load.el ends here diff --git a/lisp/custom.el b/lisp/custom.el deleted file mode 100644 index 77dd59d..0000000 --- a/lisp/custom.el +++ /dev/null @@ -1,404 +0,0 @@ -;;; custom.el -- Tools for declaring and initializing options. - -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic -;; Keywords: help, faces, dumped -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -;; 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 file is dumped with XEmacs. - -;; This file only contain the code needed to declare and initialize -;; user options. The code to customize options is autoloaded from -;; `cus-edit.el'. -;; -;; The code implementing face declarations is in `cus-face.el' - -;;; Code: - -(require 'widget) - -(defvar custom-define-hook nil - ;; Customize information for this option is in `cus-edit.el'. - "Hook called after defining each customize option.") - -;;; The `defcustom' Macro. - -(defun custom-initialize-default (symbol value) - "Initialize SYMBOL with VALUE. -This will do nothing if symbol already has a default binding. -Otherwise, if symbol has a `saved-value' property, it will evaluate -the car of that and used as the default binding for symbol. -Otherwise, VALUE will be evaluated and used as the default binding for -symbol." - (unless (default-boundp symbol) - ;; Use the saved value if it exists, otherwise the standard setting. - (set-default symbol (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) - -(defun custom-initialize-set (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-default', but use the function specified by -`:set' to initialize SYMBOL." - (unless (default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (if (get symbol 'saved-value) - (eval (car (get symbol 'saved-value))) - (eval value))))) - -(defun custom-initialize-reset (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-set', but use the function specified by -`:get' to reinitialize SYMBOL if it is already bound." - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-get) 'default-value) - symbol)) - ((get symbol 'saved-value) - (eval (car (get symbol 'saved-value)))) - (t - (eval value))))) - -(defun custom-initialize-changed (symbol value) - "Initialize SYMBOL with VALUE. -Like `custom-initialize-reset', but only use the `:set' function if the -not using the standard setting. Otherwise, use the `set-default'." - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (funcall (or (get symbol 'custom-get) 'default-value) - symbol))) - ((get symbol 'saved-value) - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (eval (car (get symbol 'saved-value))))) - (t - (set-default symbol (eval value))))) - -(defun custom-declare-variable (symbol value doc &rest args) - "Like `defcustom', but SYMBOL and VALUE are evaluated as normal arguments." - ;; Remember the standard setting. - (put symbol 'standard-value (list value)) - ;; Maybe this option was rogue in an earlier version. It no longer is. - (when (get symbol 'force-value) - ;; It no longer is. - (put symbol 'force-value nil)) - (when doc - (put symbol 'variable-documentation doc)) - (let ((initialize 'custom-initialize-reset) - (requests nil)) - (while args - (let ((arg (car args))) - (setq args (cdr args)) - (check-argument-type 'keywordp arg) - (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (cond ((eq keyword :initialize) - (setq initialize value)) - ((eq keyword :set) - (put symbol 'custom-set value)) - ((eq keyword :get) - (put symbol 'custom-get value)) - ((eq keyword :require) - (setq requests (cons value requests))) - ((eq keyword :type) - (put symbol 'custom-type value)) - ((eq keyword :options) - (if (get symbol 'custom-options) - ;; Slow safe code to avoid duplicates. - (mapc (lambda (option) - (custom-add-option symbol option)) - value) - ;; Fast code for the common case. - (put symbol 'custom-options (copy-sequence value)))) - (t - (custom-handle-keyword symbol keyword value - 'custom-variable)))))) - (put symbol 'custom-requests requests) - ;; Do the actual initialization. - (funcall initialize symbol value)) - ;; #### This is a rough equivalent of LOADHIST_ATTACH. However, - ;; LOADHIST_ATTACH also checks for `initialized'. - (push symbol current-load-list) - (run-hooks 'custom-define-hook) - symbol) - -(defmacro defcustom (symbol value doc &rest args) - "Declare SYMBOL as a customizable variable that defaults to VALUE. -DOC is the variable documentation. - -Neither SYMBOL nor VALUE needs to be quoted. -If SYMBOL is not already bound, initialize it to VALUE. -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORD's are defined: - -:type VALUE should be a widget type for editing the symbols value. - The default is `sexp'. -:options VALUE should be a list of valid members of the widget type. -:group VALUE should be a customization group. - Add SYMBOL to that group. -:initialize VALUE should be a function used to initialize the - variable. It takes two arguments, the symbol and value - given in the `defcustom' call. The default is - `custom-initialize-set' -:set VALUE should be a function to set the value of the symbol. - It takes two arguments, the symbol to set and the value to - give it. The default is `set-default'. -:get VALUE should be a function to extract the value of symbol. - The function takes one argument, a symbol, and should return - the current value for that symbol. The default is - `default-value'. -:require VALUE should be a feature symbol. Each feature will be - required after initialization, of the the user have saved this - option. - -Read the section about customization in the Emacs Lisp manual for more -information." - `(custom-declare-variable (quote ,symbol) (quote ,value) ,doc ,@args)) - -;;; The `defface' Macro. - -(defmacro defface (face spec doc &rest args) - "Declare FACE as a customizable face that defaults to SPEC. -FACE does not need to be quoted. - -Third argument DOC is the face documentation. - -If FACE has been set with `custom-set-face', set the face attributes -as specified by that function, otherwise set the face attributes -according to SPEC. - -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORDs are defined: - -:group VALUE should be a customization group. - Add FACE to that group. - -SPEC should be an alist of the form ((DISPLAY ATTS)...). - -ATTS is a list of face attributes and their values. The possible -attributes are defined in the variable `custom-face-attributes'. - -The ATTS of the first entry in SPEC where the DISPLAY matches the -frame should take effect in that frame. DISPLAY can either be the -symbol t, which will match all frames, or an alist of the form -\((REQ ITEM...)...) - -For the DISPLAY to match a FRAME, the REQ property of the frame must -match one of the ITEM. The following REQ are defined: - -`type' (the value of `window-system') - Should be one of `x' or `tty'. - -`class' (the frame's color support) - Should be one of `color', `grayscale', or `mono'. - -`background' (what color is used for the background text) - Should be one of `light' or `dark'. - -Read the section about customization in the Emacs Lisp manual for more -information." - `(custom-declare-face (quote ,face) ,spec ,doc ,@args)) - -;;; The `defgroup' Macro. - -(defun custom-declare-group (symbol members doc &rest args) - "Like `defgroup', but SYMBOL is evaluated as a normal argument." - (while members - (apply 'custom-add-to-group symbol (car members)) - (pop members)) - (put symbol 'custom-group (nconc members (get symbol 'custom-group))) - (when doc - (put symbol 'group-documentation doc)) - (while args - (let ((arg (car args))) - (setq args (cdr args)) - (check-argument-type 'keywordp arg) - (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (cond ((eq keyword :prefix) - (put symbol 'custom-prefix value)) - (t - (custom-handle-keyword symbol keyword value - 'custom-group)))))) - (run-hooks 'custom-define-hook) - symbol) - -(defmacro defgroup (symbol members doc &rest args) - "Declare SYMBOL as a customization group containing MEMBERS. -SYMBOL does not need to be quoted. - -Third arg DOC is the group documentation. - -MEMBERS should be an alist of the form ((NAME WIDGET)...) where NAME -is a symbol and WIDGET is a widget for editing that symbol. Useful -widgets are `custom-variable' for editing variables, `custom-face' for -edit faces, and `custom-group' for editing groups. - -The remaining arguments should have the form - - [KEYWORD VALUE]... - -The following KEYWORD's are defined: - -:group VALUE should be a customization group. - Add SYMBOL to that group. - -Read the section about customization in the Emacs Lisp manual for more -information." - `(custom-declare-group (quote ,symbol) ,members ,doc ,@args)) - -(defvar custom-group-hash-table (make-hash-table :size 300 :test 'eq) - "Hash-table of non-empty groups.") - -(defun custom-add-to-group (group option widget) - "To existing GROUP add a new OPTION of type WIDGET. -If there already is an entry for that option, overwrite it." - (let* ((members (get group 'custom-group)) - (old (assq option members))) - (if old - (setcar (cdr old) widget) - (put group 'custom-group (nconc members (list (list option widget)))))) - (puthash group t custom-group-hash-table)) - -;;; Properties. - -(defun custom-handle-all-keywords (symbol args type) - "For customization option SYMBOL, handle keyword arguments ARGS. -Third argument TYPE is the custom option type." - (while args - (let ((arg (car args))) - (setq args (cdr args)) - (check-argument-type 'keywordp arg) - (let ((keyword arg) - (value (car args))) - (unless args - (signal 'error (list "Keyword is missing an argument" keyword))) - (setq args (cdr args)) - (custom-handle-keyword symbol keyword value type))))) - -(defun custom-handle-keyword (symbol keyword value type) - "For customization option SYMBOL, handle KEYWORD with VALUE. -Fourth argument TYPE is the custom option type." - (cond ((eq keyword :group) - (custom-add-to-group value symbol type)) - ((eq keyword :version) - (custom-add-version symbol value)) - ((eq keyword :link) - (custom-add-link symbol value)) - ((eq keyword :load) - (custom-add-load symbol value)) - ((eq keyword :tag) - (put symbol 'custom-tag value)) - (t - (signal 'error (list "Unknown keyword" keyword))))) - -(defun custom-add-option (symbol option) - "To the variable SYMBOL add OPTION. - -If SYMBOL is a hook variable, OPTION should be a hook member. -For other types variables, the effect is undefined." - (let ((options (get symbol 'custom-options))) - (unless (member option options) - (put symbol 'custom-options (cons option options))))) - -(defun custom-add-link (symbol widget) - "To the custom option SYMBOL add the link WIDGET." - (let ((links (get symbol 'custom-links))) - (unless (member widget links) - (put symbol 'custom-links (cons widget links))))) - -(defun custom-add-version (symbol version) - "To the custom option SYMBOL add the version VERSION." - (put symbol 'custom-version version)) - -(defun custom-add-load (symbol load) - "To the custom option SYMBOL add the dependency LOAD. -LOAD should be either a library file name, or a feature name." - (puthash symbol t custom-group-hash-table) - (let ((loads (get symbol 'custom-loads))) - (unless (member load loads) - (put symbol 'custom-loads (cons load loads))))) - -;;; Initializing. - -(defun custom-set-variables (&rest args) - "Initialize variables according to user preferences. - -The arguments should be a list where each entry has the form: - - (SYMBOL VALUE [NOW]) - -The unevaluated VALUE is stored as the saved value for SYMBOL. -If NOW is present and non-nil, VALUE is also evaluated and bound as -the default value for the SYMBOL." - (while args - (let ((entry (car args))) - (if (listp entry) - (let* ((symbol (nth 0 entry)) - (value (nth 1 entry)) - (now (nth 2 entry)) - (requests (nth 3 entry)) - (set (or (get symbol 'custom-set) 'set-default))) - (put symbol 'saved-value (list value)) - (cond (now - ;; Rogue variable, set it now. - (put symbol 'force-value t) - (funcall set symbol (eval value))) - ((default-boundp symbol) - ;; Something already set this, overwrite it. - (funcall set symbol (eval value)))) - (when requests - (put symbol 'custom-requests requests) - (mapc 'require requests)) - (setq args (cdr args))) - ;; Old format, a plist of SYMBOL VALUE pairs. - (message "Warning: old format `custom-set-variables'") - (ding) - (sit-for 2) - (let ((symbol (nth 0 args)) - (value (nth 1 args))) - (put symbol 'saved-value (list value))) - (setq args (cdr (cdr args))))))) - -;;; The End. - -(provide 'custom) - -;; custom.el ends here diff --git a/lisp/derived.el b/lisp/derived.el deleted file mode 100644 index a2c6a5c..0000000 --- a/lisp/derived.el +++ /dev/null @@ -1,363 +0,0 @@ -;;; derived.el --- allow inheritance of major modes. - -;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc. - -;; Author: David Megginson (dmeggins@aix1.uottawa.ca) -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 file is dumped with XEmacs. - -;; GNU Emacs is already, in a sense, object oriented -- each object -;; (buffer) belongs to a class (major mode), and that class defines -;; the relationship between messages (input events) and methods -;; (commands) by means of a keymap. -;; -;; The only thing missing is a good scheme of inheritance. It is -;; possible to simulate a single level of inheritance with generous -;; use of hooks and a bit of work -- sgml-mode, for example, also runs -;; the hooks for text-mode, and keymaps can inherit from other keymaps -;; -- but generally, each major mode ends up reinventing the wheel. -;; Ideally, someone should redesign all of Emacs's major modes to -;; follow a more conventional object-oriented system: when defining a -;; new major mode, the user should need only to name the existing mode -;; it is most similar to, then list the (few) differences. -;; -;; In the mean time, this package offers most of the advantages of -;; full inheritance with the existing major modes. The macro -;; `define-derived-mode' allows the user to make a variant of an existing -;; major mode, with its own keymap. The new mode will inherit the key -;; bindings of its parent, and will, in fact, run its parent first -;; every time it is called. For example, the commands -;; -;; (define-derived-mode hypertext-mode text-mode "Hypertext" -;; "Major mode for hypertext.\n\n\\{hypertext-mode-map}" -;; (setq case-fold-search nil)) -;; -;; (define-key hypertext-mode-map [down-mouse-3] 'do-hyper-link) -;; -;; will create a function `hypertext-mode' with its own (sparse) -;; keymap `hypertext-mode-map.' The command M-x hypertext-mode will -;; perform the following actions: -;; -;; - run the command (text-mode) to get its default setup -;; - replace the current keymap with 'hypertext-mode-map,' which will -;; inherit from 'text-mode-map'. -;; - replace the current syntax table with -;; 'hypertext-mode-syntax-table', which will borrow its defaults -;; from the current text-mode-syntax-table. -;; - replace the current abbrev table with -;; 'hypertext-mode-abbrev-table', which will borrow its defaults -;; from the current text-mode-abbrev table -;; - change the mode line to read "Hypertext" -;; - assign the value 'hypertext-mode' to the 'major-mode' variable -;; - run the body of commands provided in the macro -- in this case, -;; set the local variable `case-fold-search' to nil. -;; - **run the command (hypertext-mode-setup), which is empty by -;; default, but may be redefined by the user to contain special -;; commands (ie. setting local variables like 'outline-regexp') -;; **NOTE: do not use this option -- it will soon be obsolete. -;; - run anything assigned to 'hypertext-mode-hooks' (obsolete, but -;; supported for the sake of compatibility). -;; -;; The advantages of this system are threefold. First, text mode is -;; untouched -- if you had added the new keystroke to `text-mode-map,' -;; possibly using hooks, you would have added it to all text buffers -;; -- here, it appears only in hypertext buffers, where it makes -;; sense. Second, it is possible to build even further, and make -;; a derived mode from a derived mode. The commands -;; -;; (define-derived-mode html-mode hypertext-mode "HTML") -;; [various key definitions] -;; -;; will add a new major mode for HTML with very little fuss. -;; -;; Note also the function `derived-mode-class,' which returns the non-derived -;; major mode which a derived mode is based on (ie. NOT necessarily the -;; immediate parent). -;; -;; (derived-mode-class 'text-mode) ==> text-mode -;; (derived-mode-class 'hypertext-mode) ==> text-mode -;; (derived-mode-class 'html-mode) ==> text-mode - -;;; Code: - -;; PUBLIC: define a new major mode which inherits from an existing one. - -;; XEmacs -- no autoload -(defmacro define-derived-mode (child parent name &optional docstring &rest body) - "Create a new mode as a variant of an existing mode. - -The arguments to this command are as follow: - -CHILD: the name of the command for the derived mode. -PARENT: the name of the command for the parent mode (ie. text-mode). -NAME: a string which will appear in the status line (ie. \"Hypertext\") -DOCSTRING: an optional documentation string--if you do not supply one, - the function will attempt to invent something useful. -BODY: forms to execute just before running the - hooks for the new mode. - -Here is how you could define LaTeX-Thesis mode as a variant of LaTeX mode: - - (define-derived-mode LaTeX-thesis-mode LaTeX-mode \"LaTeX-Thesis\") - -You could then make new key bindings for `LaTeX-thesis-mode-map' -without changing regular LaTeX mode. In this example, BODY is empty, -and DOCSTRING is generated by default. - -On a more complicated level, the following command uses sgml-mode as -the parent, and then sets the variable `case-fold-search' to nil: - - (define-derived-mode article-mode sgml-mode \"Article\" - \"Major mode for editing technical articles.\" - (setq case-fold-search nil)) - -Note that if the documentation string had been left out, it would have -been generated automatically, with a reference to the keymap." - - ; Some trickiness, since what - ; appears to be the docstring - ; may really be the first - ; element of the body. - (if (and docstring (not (stringp docstring))) - (progn (setq body (cons docstring body)) - (setq docstring nil))) - (setq docstring (or docstring (derived-mode-make-docstring parent child))) - - `(progn - (derived-mode-init-mode-variables (quote ,child)) - (defun ,child () - ,docstring - (interactive) - ; Run the parent. - (,parent) - ; Identify special modes. - (if (get (quote ,parent) 'special) - (put (quote ,child) 'special t)) - ;; XEmacs addition - (let ((mode-class (get (quote ,parent) 'mode-class))) - (if mode-class - (put (quote ,child) 'mode-class mode-class))) - ; Identify the child mode. - (setq major-mode (quote ,child)) - (setq mode-name ,name) - ; Set up maps and tables. - (derived-mode-set-keymap (quote ,child)) - (derived-mode-set-syntax-table (quote ,child)) - (derived-mode-set-abbrev-table (quote ,child)) - ; Splice in the body (if any). - ,@body -;;; ; Run the setup function, if -;;; ; any -- this will soon be -;;; ; obsolete. -;;; (derived-mode-run-setup-function (quote ,child)) - ; Run the hooks, if any. - (derived-mode-run-hooks (quote ,child))))) - - -;; PUBLIC: find the ultimate class of a derived mode. - -(defun derived-mode-class (mode) - "Find the class of a major mode. -A mode's class is the first ancestor which is NOT a derived mode. -Use the `derived-mode-parent' property of the symbol to trace backwards." - (while (get mode 'derived-mode-parent) - (setq mode (get mode 'derived-mode-parent))) - mode) - - -;; Inline functions to construct various names from a mode name. - -(defsubst derived-mode-setup-function-name (mode) - "Construct a setup-function name based on a mode name." - (intern (concat (symbol-name mode) "-setup"))) - -(defsubst derived-mode-hooks-name (mode) - "Construct a hooks name based on a mode name." - ;; XEmacs change from -hooks - (intern (concat (symbol-name mode) "-hook"))) - -(defsubst derived-mode-map-name (mode) - "Construct a map name based on a mode name." - (intern (concat (symbol-name mode) "-map"))) - -(defsubst derived-mode-syntax-table-name (mode) - "Construct a syntax-table name based on a mode name." - (intern (concat (symbol-name mode) "-syntax-table"))) - -(defsubst derived-mode-abbrev-table-name (mode) - "Construct an abbrev-table name based on a mode name." - (intern (concat (symbol-name mode) "-abbrev-table"))) - - -;; Utility functions for defining a derived mode. - -;; XEmacs -- don't autoload -(defun derived-mode-init-mode-variables (mode) - "Initialize variables for a new mode. -Right now, if they don't already exist, set up a blank keymap, an -empty syntax table, and an empty abbrev table -- these will be merged -the first time the mode is used." - - (if (boundp (derived-mode-map-name mode)) - t - (eval `(defvar ,(derived-mode-map-name mode) - ;; XEmacs change - (make-sparse-keymap (derived-mode-map-name mode)) - ,(format "Keymap for %s." mode))) - (put (derived-mode-map-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-syntax-table-name mode)) - t - (eval `(defvar ,(derived-mode-syntax-table-name mode) - ;; XEmacs change - ;; Make a syntax table which doesn't specify anything - ;; for any char. Valid data will be merged in by - ;; derived-mode-merge-syntax-tables. - ;; (make-char-table 'syntax-table nil) - (make-syntax-table) - ,(format "Syntax table for %s." mode))) - (put (derived-mode-syntax-table-name mode) 'derived-mode-unmerged t)) - - (if (boundp (derived-mode-abbrev-table-name mode)) - t - (eval `(defvar ,(derived-mode-abbrev-table-name mode) - (progn (define-abbrev-table (derived-mode-abbrev-table-name mode) nil) - (make-abbrev-table)) - ,(format "Abbrev table for %s." mode))))) - -(defun derived-mode-make-docstring (parent child) - "Construct a docstring for a new mode if none is provided." - - (format "This major mode is a variant of `%s', created by `define-derived-mode'. -It inherits all of the parent's attributes, but has its own keymap, -abbrev table and syntax table: - - `%s-map' and `%s-syntax-table' - -which more-or-less shadow - - `%s-map' and `%s-syntax-table' - -\\{%s-map}" parent child child parent parent child)) - - -;; Utility functions for running a derived mode. - -(defun derived-mode-set-keymap (mode) - "Set the keymap of the new mode, maybe merging with the parent." - (let* ((map-name (derived-mode-map-name mode)) - (new-map (eval map-name)) - (old-map (current-local-map))) - (and old-map - (get map-name 'derived-mode-unmerged) - (derived-mode-merge-keymaps old-map new-map)) - (put map-name 'derived-mode-unmerged nil) - (use-local-map new-map))) - -(defun derived-mode-set-syntax-table (mode) - "Set the syntax table of the new mode, maybe merging with the parent." - (let* ((table-name (derived-mode-syntax-table-name mode)) - (old-table (syntax-table)) - (new-table (eval table-name))) - (if (get table-name 'derived-mode-unmerged) - (derived-mode-merge-syntax-tables old-table new-table)) - (put table-name 'derived-mode-unmerged nil) - (set-syntax-table new-table))) - -(defun derived-mode-set-abbrev-table (mode) - "Set the abbrev table if it exists. -Always merge its parent into it, since the merge is non-destructive." - (let* ((table-name (derived-mode-abbrev-table-name mode)) - (old-table local-abbrev-table) - (new-table (eval table-name))) - (derived-mode-merge-abbrev-tables old-table new-table) - (setq local-abbrev-table new-table))) - -;;;(defun derived-mode-run-setup-function (mode) -;;; "Run the setup function if it exists." - -;;; (let ((fname (derived-mode-setup-function-name mode))) -;;; (if (fboundp fname) -;;; (funcall fname)))) - -(defun derived-mode-run-hooks (mode) - "Run the hooks if they exist." - - (let ((hooks-name (derived-mode-hooks-name mode))) - (if (boundp hooks-name) - (run-hooks hooks-name)))) - -;; Functions to merge maps and tables. - -(defun derived-mode-merge-keymaps (old new) - "Merge an old keymap into a new one. -The old keymap is set to be the parent of the new one, so that there will -be automatic inheritance." - ;; XEmacs change. FSF 19.30 & 19.34 has a whole bunch of weird crap here - ;; for merging prefix keys and such. Hopefully none of this is - ;; necessary in XEmacs. - (set-keymap-parents new (list old))) - -(defun derived-mode-merge-syntax-tables (old new) - "Merge an old syntax table into a new one. -Where the new table already has an entry, nothing is copied from the old one." - ;; 20.x - (if (fboundp 'map-char-table) - ;; we use map-char-table not map-syntax-table so we can explicitly - ;; check for inheritance. - (map-char-table - #'(lambda (key value) - (if (eq ?@ (char-syntax-from-code value)) - (map-char-table #'(lambda (key1 value1) - (put-char-table key1 value1 new)) - old - key))) - new) - ;; pre-20.0 - (let ((idx 0) - (end (min (length new) (length old)))) - (while (< idx end) - (if (not (aref new idx)) - (aset new idx (aref old idx))) - (setq idx (1+ idx)))))) - -;; Merge an old abbrev table into a new one. -;; This function requires internal knowledge of how abbrev tables work, -;; presuming that they are obarrays with the abbrev as the symbol, the expansion -;; as the value of the symbol, and the hook as the function definition. -(defun derived-mode-merge-abbrev-tables (old new) - (if old - (mapatoms - (function - (lambda (symbol) - (or (intern-soft (symbol-name symbol) new) - (define-abbrev new (symbol-name symbol) - (symbol-value symbol) (symbol-function symbol))))) - old))) - -(provide 'derived) - -;;; derived.el ends here diff --git a/lisp/device.el b/lisp/device.el deleted file mode 100644 index 6d40d5f..0000000 --- a/lisp/device.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; device.el --- miscellaneous device functions not written in C - -;; Copyright (C) 1994-5, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun device-list () - "Return a list of all devices." - (apply 'nconc (mapcar 'console-device-list (console-list)))) - -(defun device-type (&optional device) - "Return the type of the specified device (e.g. `x' or `tty'). -This is equivalent to the type of the device's console. -Value is `tty' for a tty device (a character-only terminal), -`x' for a device that is a screen on an X display, -`ns' for a device that is a NeXTstep connection (not yet implemented), -`mswindows' for a device that is a Windows or Windows NT connection, -`pc' for a device that is a direct-write MS-DOS screen (not yet implemented), -`stream' for a stream device (which acts like a stdio stream), and -`dead' for a deleted device." - (or device (setq device (selected-device))) - (if (not (device-live-p device)) 'dead - (console-type (device-console device)))) - -(defun make-tty-device (&optional tty terminal-type controlling-process) - "Create a new device on TTY. - TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under -SunOS et al.), as returned by the `tty' command. A value of nil means -use the stdin and stdout as passed to XEmacs from the shell. - If TERMINAL-TYPE is non-nil, it should be a string specifying the -type of the terminal attached to the specified tty. If it is nil, -the terminal type will be inferred from the TERM environment variable. - If CONTROLLING-PROCESS is non-nil, it should be an integer -specifying the process id of the process in control of the specified tty. If -it is nil, it is assumes to be the value returned by emacs-pid." - (make-device 'tty tty (list 'terminal-type terminal-type - 'controlling-process controlling-process))) - -(defun device-pixel-width (&optional device) - "Return the width in pixels of DEVICE, or nil if unknown." - (let ((ds (device-system-metric device 'size-device))) - (and ds (car ds)))) - -(defun device-pixel-height (&optional device) - "Return the height in pixels of DEVICE, or nil if unknown." - (let ((ds (device-system-metric device 'size-device))) - (and ds (cdr ds)))) - -(defun device-mm-width (&optional device) - "Return the width in millimeters of DEVICE, or nil if unknown." - (let ((ds (device-system-metric device 'size-device-mm))) - (and ds (car ds)))) - -(defun device-mm-height (&optional device) - "Return the height in millimeters of DEVICE, or nil if unknown." - (let ((ds (device-system-metric device 'size-device-mm))) - (and ds (cdr ds)))) - -(defun device-bitplanes (&optional device) - "Return the number of bitplanes of DEVICE, or nil if unknown." - (device-system-metric device 'num-bit-planes)) - -(defun device-color-cells (&optional device) - "Return the number of color cells of DEVICE, or nil if unknown." - (device-system-metric device 'num-color-cells)) - -(defun make-x-device (&optional display) - "Create a new device connected to DISPLAY." - (make-device 'x display)) - -(defun make-mswindows-device () - "Create a new mswindows device." - (make-device 'mswindows nil)) - -(defun device-on-window-system-p (&optional device) - "Return non-nil if DEVICE is on a window system. -This generally means that there is support for the mouse, the menubar, -the toolbar, glyphs, etc." - (or device (setq device (selected-device))) - (console-on-window-system-p (device-console device))) - -(defalias 'valid-device-type-p 'valid-console-type-p) -(defalias 'device-type-list 'console-type-list) -(defalias 'device-pixel-depth 'device-bitplanes) - -;;; device.el ends here diff --git a/lisp/dialog.el b/lisp/dialog.el deleted file mode 100644 index 740ff72..0000000 --- a/lisp/dialog.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; dialog.el --- Dialog-box support for XEmacs - -;; Copyright (C) 1991-4, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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: - -;; This file is dumped with XEmacs (when dialog boxes are compiled in). - -;;; Code: -(defun yes-or-no-p-dialog-box (prompt) - "Ask user a \"y or n\" question with a popup dialog box. -Returns t if answer is \"yes\". -Takes one argument, which is the string to display to ask the question." - (let ((echo-keystrokes 0) - event) - (popup-dialog-box - ;; "Non-violent language please!" says Robin. - (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t]))) -; (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t]))) - (catch 'ynp-done - (while t - (setq event (next-command-event event)) - (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes)) - (throw 'ynp-done t)) - ((and (misc-user-event-p event) (eq (event-object event) 'no)) - (throw 'ynp-done nil)) - ((and (misc-user-event-p event) - (or (eq (event-object event) 'abort) - (eq (event-object event) 'menu-no-selection-hook))) - (signal 'quit nil)) - ((button-release-event-p event) ;; don't beep twice - nil) - (t - (beep) - (message "please answer the dialog box"))))))) - -(defun yes-or-no-p-maybe-dialog-box (prompt) - "Ask user a yes-or-no question. Return t if answer is yes. -The question is asked with a dialog box or the minibuffer, as appropriate. -Takes one argument, which is the string to display to ask the question. -It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it. -The user must confirm the answer with RET, -and can edit it until it as been confirmed." - (if (should-use-dialog-box-p) - (yes-or-no-p-dialog-box prompt) - (yes-or-no-p-minibuf prompt))) - -(defun y-or-n-p-maybe-dialog-box (prompt) - "Ask user a \"y or n\" question. Return t if answer is \"y\". -Takes one argument, which is the string to display to ask the question. -The question is asked with a dialog box or the minibuffer, as appropriate. -It should end in a space; `y-or-n-p' adds `(y or n) ' to it. -No confirmation of the answer is requested; a single character is enough. -Also accepts Space to mean yes, or Delete to mean no." - (if (should-use-dialog-box-p) - (yes-or-no-p-dialog-box prompt) - (y-or-n-p-minibuf prompt))) - -(if (fboundp 'popup-dialog-box) - (progn - (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box) - (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box))) - -;; this is call-compatible with the horribly-named FSF Emacs function -;; `x-popup-dialog'. I refuse to use that name. -(defun get-dialog-box-response (position contents) - ;; by Stig@hackvan.com - ;; modified by pez@atlantic2.sbi.com - "Pop up a dialog box and return user's selection. -POSITION specifies which frame to use. -This is normally an event or a window or frame. -If POSITION is t or nil, it means to use the frame the mouse is on. -The dialog box appears in the middle of the specified frame. - -CONTENTS specifies the alternatives to display in the dialog box. -It is a list of the form (TITLE ITEM1 ITEM2...). -Each ITEM is a cons cell (STRING . VALUE). -The return value is VALUE from the chosen item. - -An ITEM may also be just a string--that makes a nonselectable item. -An ITEM may also be nil--that means to put all preceding items -on the left of the dialog box and all following items on the right." - (cond - ((eventp position) - (select-frame (event-frame position))) - ((framep position) - (select-frame position)) - ((windowp position) - (select-window position))) - (let ((dbox (cons (car contents) - (mapcar #'(lambda (x) - (cond - ((null x) - nil) - ((stringp x) - `[,x 'ignore nil]) ;this will never get - ;selected - (t - `[,(car x) (throw 'result ',(cdr x)) t]))) - (cdr contents)) - ))) - (catch 'result - (popup-dialog-box dbox) - (dispatch-event (next-command-event))))) - -(defun message-box (fmt &rest args) - "Display a message, in a dialog box if possible. -If the selected device has no dialog-box support, use the echo area. -The arguments are the same as to `format'. - -If the only argument is nil, clear any existing message; let the -minibuffer contents show." - (if (and (null fmt) (null args)) - (progn - (clear-message nil) - nil) - (let ((str (apply 'format fmt args))) - (if (device-on-window-system-p) - (get-dialog-box-response nil (list str (cons "OK" t))) - (display-message 'message str)) - str))) - -(defun message-or-box (fmt &rest args) - "Display a message in a dialog box or in the echo area.\n\ -If this command was invoked with the mouse, use a dialog box.\n\ -Otherwise, use the echo area. -The arguments are the same as to `format'. - -If the only argument is nil, clear any existing message; let the -minibuffer contents show." - (if (should-use-dialog-box-p) - (apply 'message-box fmt args) - (apply 'message fmt args))) - -;;; dialog.el ends here diff --git a/lisp/disass.el b/lisp/disass.el deleted file mode 100644 index 9992f07..0000000 --- a/lisp/disass.el +++ /dev/null @@ -1,266 +0,0 @@ -;;; disass.el --- disassembler for compiled Emacs Lisp code - -;;; Copyright (C) 1986, 1991-1994 Free Software Foundation, Inc. - -;; Author: Doug Cutting -;; Jamie Zawinski -;; Maintainer: Jamie Zawinski -;; 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: FSF 19.28. - -;;; Commentary: - -;; The single entry point, `disassemble', disassembles a code object generated -;; by the Emacs Lisp byte-compiler. This doesn't invert the compilation -;; operation, not by a long shot, but it's useful for debugging. - -;; -;; Original version by Doug Cutting (doug@csli.stanford.edu) -;; Substantially modified by Jamie Zawinski for -;; the new lapcode-based byte compiler. - -;;; Code: - -(require 'byte-optimize) - -(defvar disassemble-column-1-indent 8 "*") -(defvar disassemble-column-2-indent 10 "*") -(defvar disassemble-recursive-indent 3 "*") - -;;;###autoload -(defun disassemble (object &optional buffer indent interactive-p) - "Print disassembled code for OBJECT in (optional) BUFFER. -OBJECT can be a symbol defined as a function, or a function itself -\(a lambda expression or a compiled-function object). -If OBJECT is not already compiled, we compile it, but do not -redefine OBJECT if it is a symbol." - (interactive (list (intern (completing-read "Disassemble function: " - obarray 'fboundp t)) - nil 0 t)) - (if (eq (car-safe object) 'byte-code) - (setq object (list 'lambda () object))) - (or indent (setq indent 0)) ;Default indent to zero - (save-excursion - (if (or interactive-p (null buffer)) - (with-output-to-temp-buffer "*Disassemble*" - (set-buffer "*Disassemble*") - (disassemble-internal object indent (not interactive-p))) - (set-buffer buffer) - (disassemble-internal object indent nil))) - nil) - - -(defun disassemble-internal (obj indent interactive-p) - (let ((macro nil) - (name nil) - args) - (while (symbolp obj) - (setq name obj - obj (symbol-function obj))) - (if (subrp obj) - (error "Can't disassemble #" name)) - (if (eq (car-safe obj) 'autoload) - (progn - (load (elt obj 1)) - (setq obj (symbol-function name)))) - (if (eq (car-safe obj) 'macro) ;handle macros - (setq macro t - obj (cdr obj))) - (if (and (listp obj) (eq (car obj) 'byte-code)) - (setq obj (list 'lambda nil obj))) - (if (and (listp obj) (not (eq (car obj) 'lambda))) - (error "not a function")) - (if (consp obj) - (if (assq 'byte-code obj) - nil - (if interactive-p (message (if name - "Compiling %s's definition..." - "Compiling definition...") - name)) - (setq obj (byte-compile obj)) - (if interactive-p (message "Done compiling. Disassembling...")))) - (cond ((consp obj) - (setq obj (cdr obj)) ;throw lambda away - (setq args (car obj)) ;save arg list - (setq obj (cdr obj))) - (t - (setq args (compiled-function-arglist obj)))) - (if (zerop indent) ; not a nested function - (progn - (indent-to indent) - (insert (format "byte code%s%s%s:\n" - (if (or macro name) " for" "") - (if macro " macro" "") - (if name (format " %s" name) ""))))) - (let ((doc (if (consp obj) - (and (stringp (car obj)) (car obj)) - (condition-case error - (documentation obj) - (error (format "%S" error)))))) - (if (and doc (stringp doc)) - (progn (and (consp obj) (setq obj (cdr obj))) - (indent-to indent) - (princ " doc: " (current-buffer)) - (let ((frobbed nil)) - (if (string-match "\n" doc) - (setq doc (substring doc 0 (match-beginning 0)) - frobbed t)) - (if (> (length doc) 70) - (setq doc (substring doc 0 65) frobbed t)) - (if frobbed (setq doc (concat doc " ...")))) - (insert doc "\n")))) - (indent-to indent) - (insert " args: ") - (prin1 args (current-buffer)) - (insert "\n") - (if (condition-case () - (commandp obj) ; ie interactivep - (error nil)) - (let ((interactive (if (consp obj) - (elt (assq 'interactive obj) 1) - (elt (compiled-function-interactive obj) 1)))) - (if (eq (car-safe (car-safe obj)) 'interactive) - (setq obj (cdr obj))) - (indent-to indent) - (insert " interactive: ") - (if (eq (car-safe interactive) 'byte-code) - (progn - (insert "\n") - (disassemble-1 interactive - (+ indent disassemble-recursive-indent))) - (let ((print-escape-newlines t)) - (prin1 interactive (current-buffer)))) - (insert "\n"))) - (cond ((and (consp obj) (assq 'byte-code obj)) - (disassemble-1 (assq 'byte-code obj) indent)) - ((compiled-function-p obj) - (disassemble-1 obj indent)) - (t - (insert "Uncompiled body: ") - (let ((print-escape-newlines t)) - (prin1 (if (cdr obj) (cons 'progn obj) (car obj)) - (current-buffer)))))) - (if interactive-p - (message nil))) - - -(defun disassemble-1 (obj indent) - "Print the byte-code call OBJ in the current buffer. -OBJ should be a compiled-function object generated by the byte compiler." - (let (bytes constvec) - (if (consp obj) - (setq bytes (car (cdr obj)) ; the byte code - constvec (car (cdr (cdr obj)))) ; constant vector - (setq bytes (compiled-function-instructions obj) - constvec (compiled-function-constants obj))) - (let ((lap (byte-decompile-bytecode bytes constvec)) - op arg opname pc-value) - (let ((tagno 0) - tmp - (lap lap)) - (while (setq tmp (assq 'TAG lap)) - (setcar (cdr tmp) (setq tagno (1+ tagno))) - (setq lap (cdr (memq tmp lap))))) - (while lap - ;; Take off the pc value of the next thing - ;; and put it in pc-value. - (setq pc-value nil) - (if (numberp (car lap)) - (setq pc-value (car lap) - lap (cdr lap))) - ;; Fetch the next op and its arg. - (setq op (car (car lap)) - arg (cdr (car lap))) - (setq lap (cdr lap)) - (indent-to indent) - (if (eq 'TAG op) - (progn - ;; We have a label. Display it, but first its pc value. - (if pc-value - (insert (format "%d:" pc-value))) - (insert (int-to-string (car arg)))) - ;; We have an instruction. Display its pc value first. - (if pc-value - (insert (format "%d" pc-value))) - (indent-to (+ indent disassemble-column-1-indent)) - (if (and op - (string-match "^byte-" (setq opname (symbol-name op)))) - (setq opname (substring opname 5)) - (setq opname "")) - (if (eq op 'byte-constant2) - (insert " #### shouldn't have seen constant2 here!\n ")) - (insert opname) - (indent-to (+ indent disassemble-column-1-indent - disassemble-column-2-indent - -1)) - (insert " ") - (cond ((memq op byte-goto-ops) - (insert (int-to-string (nth 1 arg)))) - ((memq op '(byte-call byte-unbind - byte-listN byte-concatN byte-insertN)) - (insert (int-to-string arg))) - ((memq op '(byte-varref byte-varset byte-varbind)) - (prin1 (car arg) (current-buffer))) - ((memq op '(byte-constant byte-constant2)) - ;; it's a constant - (setq arg (car arg)) - ;; but if the value of the constant is compiled code, then - ;; recursively disassemble it. - (cond ((or (compiled-function-p arg) - (and (eq (car-safe arg) 'lambda) - (assq 'byte-code arg)) - (and (eq (car-safe arg) 'macro) - (or (compiled-function-p (cdr arg)) - (and (eq (car-safe (cdr arg)) 'lambda) - (assq 'byte-code (cdr arg)))))) - (cond ((compiled-function-p arg) - (insert "\n")) - ((eq (car-safe arg) 'lambda) - (insert "")) - (t (insert "\n"))) - (disassemble-internal - arg - (+ indent disassemble-recursive-indent 1) - nil)) - ((eq (car-safe arg) 'byte-code) - (insert "\n") - (disassemble-1 ;recurse on byte-code object - arg - (+ indent disassemble-recursive-indent))) - ((eq (car-safe (car-safe arg)) 'byte-code) - (insert "(...)\n") - (mapcar ;recurse on list of byte-code objects - #'(lambda (obj) - (disassemble-1 - obj - (+ indent disassemble-recursive-indent))) - arg)) - (t - ;; really just a constant - (let ((print-escape-newlines t)) - (prin1 arg (current-buffer)))))) - ) - (insert "\n"))))) - nil) - -(provide 'disass) - -;;; disass.el ends here diff --git a/lisp/dragdrop.el b/lisp/dragdrop.el deleted file mode 100644 index 9c46f55..0000000 --- a/lisp/dragdrop.el +++ /dev/null @@ -1,424 +0,0 @@ -;;; dragdrop.el --- window system-independent Drag'n'Drop support. - -;; Copyright (C) 1998 Oliver Graf - -;; Maintainer: XEmacs Development Team, Oliver Graf -;; Keywords: drag, drop, dumped - -;; 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: - -;; This file is dumped with XEmacs (when drag'n'drop support is compiled in). - -;;; Code: - -;; we need mouse-set-point -(require 'mouse) -(provide 'dragdrop) - -;; I think this is a better name for the custom group -;; looks better in the menu and the group display as dragdrop -;; Anyway: is dragdrop- a good prefix for all this? -;; What if someone trys drop in the minibuffer? -(defgroup drag-n-drop nil - "*{EXPERIMENTAL} Window system-independent drag'n'drop support." - :group 'editing) - -(defcustom dragdrop-drop-at-point nil - "*{EXPERIMENTAL} If non-nil, drop text at the cursor location. -Otherwise, the cursor will be moved to the location of the pointer drop before -text is inserted." - :type 'boolean - :group 'drag-n-drop) - -(defcustom dragdrop-autoload-tm-view nil - "*{EXPERIMENTAL} If non-nil, autoload tm-view to decode MIME data. -Otherwise, the buffer is only decoded if tm-view is already available." - :type 'boolean - :group 'drag-n-drop) - -;; the widget for editing the drop-functions -(define-widget 'dragdrop-function-widget 'list - "*{EXPERIMENTAL} Widget for editing drop dispatch functions." - :args `((choice :tag "Function" - (function-item experimental-dragdrop-drop-url-default) - (function-item experimental-dragdrop-drop-mime-default) - (function-item experimental-dragdrop-drop-log-function) - (function :tag "Other" nil)) - (choice :tag "Button" :value t - (choice-item :tag "Ignore" t) - (choice-item 0) (choice-item 1) (choice-item 2) - (choice-item 3) (choice-item 4) (choice-item 5) - (choice-item 6) (choice-item 7)) - (radio-button-choice :tag "Modifiers" - (const :tag "Ignore Modifier Keys" t) - (checklist :greedy t - :format "Modifier Keys:\n%v" - :extra-offset 6 - (const shift) - (const control) - (const meta) - (const alt) - (const hyper) - (const super))) - (repeat :inline t :value nil :tag "Extra Function Arguments" - (sexp :tag "Arg" :value nil))) - :value '(nil t t)) - -(defcustom experimental-dragdrop-drop-functions '((experimental-dragdrop-drop-url-default t t) - (experimental-dragdrop-drop-mime-default t t)) - "*{EXPERIMENTAL} This is the standart drop function search list. -Each element is a list of a function, a button selector, a modifier -selector and optional argumets to the function call. -The function must accept at least two arguments: first is the event -of the drop, second the object data, followed by any of the optional -arguments provided in this list. -The functions are called in order, until one returns t." - :group 'drag-n-drop - :type '(repeat dragdrop-function-widget)) - -(defgroup dnd-debug nil - "*{EXPERIMENTAL} Drag'n'Drop debugging options." - :group 'drag-n-drop) - -(defcustom dragdrop-drop-log nil - "*{EXPERIMENTAL} If non-nil, every drop is logged. -The name of the buffer is set in the custom 'dragdrop-drop-log-name" - :group 'dnd-debug - :type 'boolean) - -(defcustom dragdrop-drop-log-name "*drop log buffer*" - "*{EXPERIMENTAL} The name of the buffer used to log drops. -Set dragdrop-drop-log to non-nil to enable this feature." - :group 'dnd-debug - :type 'string) - -(defvar dragdrop-drop-log-buffer nil - "*{EXPERIMENTAL} Buffer to log drops in debug mode.") - -;; -;; Drop API -;; -(defun dragdrop-drop-dispatch (object) - "*{EXPERIMENTAL} This function identifies DROP type misc-user-events. -It calls functions which will handle the drag." - (let ((event current-mouse-event)) - (and dragdrop-drop-log - (experimental-dragdrop-drop-log-function event object)) - (dragdrop-drop-find-functions event object))) - -(defun dragdrop-drop-find-functions (event object) - "Finds valid drop-handle functions and executes them to dispose the drop. -It does this by looking for extent-properties called -'experimental-dragdrop-drop-functions and for variables named like this." - (catch 'dragdrop-drop-is-done - (and (event-over-text-area-p event) - ;; let's search the extents - (catch 'dragdrop-extents-done - (let ((window (event-window event)) - (pos (event-point event)) - (cpos (event-closest-point event)) - (buffer nil)) - (or window (throw 'dragdrop-extents-done nil)) - (or pos (setq pos cpos)) - (select-window window) - (setq buffer (window-buffer)) - (let ((ext (extent-at pos buffer 'experimental-dragdrop-drop-functions))) - (while (not (eq ext nil)) - (dragdrop-drop-do-functions - (extent-property ext 'experimental-dragdrop-drop-functions) - event - object) - (setq ext (extent-at pos buffer - 'experimental-dragdrop-drop-functions - ext))))))) - ;; now look into the variable experimental-dragdrop-drop-functions - (dragdrop-drop-do-functions experimental-dragdrop-drop-functions event object))) - -(defun dragdrop-compare-mods (first-mods second-mods) - "Returns t if both first-mods and second-mods contain the same elements. -Order is not important." - (let ((moda (copy-sequence first-mods)) - (modb (copy-sequence second-mods))) - (while (and (not (eq moda ())) - (not (eq modb ()))) - (setq modb (delete (car moda) modb)) - (setq moda (delete (car moda) moda))) - (and (eq moda ()) - (eq modb ())))) - -(defun dragdrop-drop-do-functions (drop-funs event object) - "Calls all functions in drop-funs with object until one returns t. -Returns t if one of drop-funs returns t. Otherwise returns nil." - (let ((flist nil) - (button (event-button event)) - (mods (event-modifiers event))) - (while (not (eq drop-funs ())) - (setq flist (car drop-funs)) - (and (or (eq (cadr flist) t) - (= (cadr flist) button)) - (or (eq (caddr flist) t) - (dragdrop-compare-mods (caddr flist) mods)) - (apply (car flist) `(,event ,object ,@(cdddr flist))) - ;; (funcall (car flist) event object) - (throw 'dragdrop-drop-is-done t)) - (setq drop-funs (cdr drop-funs)))) - nil) - -(defun experimental-dragdrop-drop-log-function (event object &optional message buffer) - "*{EXPERIMENTAL} Logs any drops into a buffer. -If buffer is nil, it inserts the data into a buffer called after -dragdrop-drop-log-name. -If dragdrop-drop-log is non-nil, this is done automatically for each drop. -The function always returns nil." - (save-excursion - (cond ((buffer-live-p buffer) - (set-buffer buffer)) - ((stringp buffer) - (set-buffer (get-buffer-create buffer))) - ((buffer-live-p dragdrop-drop-log-buffer) - (set-buffer dragdrop-drop-log-buffer)) - (t - (setq dragdrop-drop-log-buffer (get-buffer-create dragdrop-drop-log-name)) - (set-buffer dragdrop-drop-log-buffer))) - (insert (format "* %s: %s\n" - (current-time-string) - (if message message "received a drop"))) - (insert (format " at %d,%d (%d,%d) with button %d and mods %s\n" - (event-x event) - (event-y event) - (event-x-pixel event) - (event-y-pixel event) - (event-button event) - (event-modifiers event))) - (insert (format " data is of type %s (%d %s)\n" - (cond ((eq (car object) 'dragdrop-URL) "URL") - ((eq (car object) 'dragdrop-MIME) "MIME") - (t "UNKNOWN")) - (length (cdr object)) - (if (= (length (cdr object)) 1) "element" "elements"))) - (let ((i 1) - (data (cdr object))) - (while (not (eq data ())) - (insert (format " Element %d: %S\n" - i (car data))) - (setq i (1+ i)) - (setq data (cdr data)))) - (insert "----------\n")) - nil) - -(defun experimental-dragdrop-drop-url-default (event object) - "*{EXPERIMENTAL} Default handler for dropped URL data. -Finds files and URLs. Returns nil if object does not contain URL data." - (cond ((eq (car object) 'dragdrop-URL) - (let ((data (cdr object)) - (frame (event-channel event)) - (x pop-up-windows) - (window (event-window event))) - (setq pop-up-windows nil) - (while (not (eq data ())) - (cond ((dragdrop-is-some-url "file" (car data)) - ;; if it is some file, pop it to a buffer - (cond (window - (select-window window))) - (switch-to-buffer (find-file-noselect - (substring (car data) 5)))) - ;; to-do: open ftp URLs with efs... - (t - ;; some other URL, try to fire up some browser for it - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function (car data)) - (display-message 'error - "Can't show URL, no browser selected")))) - (undo-boundary) - (setq data (cdr data))) - (make-frame-visible frame) - (setq pop-up-windows x) - t)) - (t nil))) - -(defun experimental-dragdrop-drop-mime-default (event object) - "*{EXPERIMENTAL} Default handler for dropped MIME data. -Inserts text into buffer, creates MIME buffers for other types. -Returns nil if object does not contain MIME data." - (cond ((eq (car object) 'dragdrop-MIME) - (let ((ldata (cdr object)) - (frame (event-channel event)) - (x pop-up-windows) - (data nil)) - ;; how should this be handled??? - ;; insert drops of text/* into buffer - ;; create new buffer if pointer is outside buffer... - ;; but there are many other ways... - ;; - ;; first thing: check if it's only text/plain and if the - ;; drop happened inside some buffer. if yes insert it into - ;; this buffer (hope it is not encoded in some MIME way) - ;; - ;; Remember: ("text/plain" "dosnotmatter" "somedata") - ;; drops are inserted at mouse-point, if inside a buffer - (while (not (eq ldata ())) - (setq data (car ldata)) - (if (and (listp data) - (= (length data) 3) - (listp (car data)) - (stringp (caar data)) - (string= (caar data) "text/plain") - (event-over-text-area-p event)) - (let ((window (event-window event))) - (and window - (select-window window)) - (and (not dragdrop-drop-at-point) - (mouse-set-point event)) - (insert (caddr data))) - (let ((buf (get-buffer-create "*MIME-Drop data*"))) - (set-buffer buf) - (pop-to-buffer buf nil frame) - (or (featurep 'tm-view) - (and dragdrop-autoload-tm-view - (require 'tm-view))) - (cond ((stringp data) - ;; this is some raw MIME stuff - ;; create some buffer and let tm do the job - ;; - ;; this is always the same buffer!!! - ;; change? - (erase-buffer) - (insert data) - (and (featurep 'tm-view) - (mime/viewer-mode buf))) - ((and (listp data) - (= (length data) 3)) - ;; change the internal content-type representation to the - ;; way tm does it ("content/type" (key . value)*) - ;; but for now list will do the job - ;; - ;; this is always the same buffer!!! - ;; change? - (erase-buffer) - (insert (caddr data)) - (and (featurep 'tm-view) - ;; this list of (car data) should be done before - ;; enqueing the event - (mime/viewer-mode buf (car data) (cadr data)))) - (t - (display-message 'error "Wrong drop data"))))) - (undo-boundary) - (setq ldata (cdr ldata))) - (make-frame-visible frame) - (setq pop-up-windows x)) - t) - (t nil))) - -(defun dragdrop-is-some-url (method url) - "Returns true if method equals the start of url. -If method does not end into ':' this is appended before the -compare." - (cond ((and (stringp url) - (stringp method) - (> (length url) (length method))) - ;; is this ?: check efficient enough? - (if (not (string= (substring method -1) ":")) - (setq method (concat method ":"))) - (string= method (substring url 0 (length method)))) - (t nil))) - -;; -;; Drag API -;; -(defun experimental-dragdrop-drag (event object) - "*{EXPERIMENTAL} The generic drag function. -Tries to do the best with object in the selected protocol. -Object must comply to the standart drag'n'drop object -format." - (error "Not implemented")) - -(defun experimental-dragdrop-drag-region (event begin end) - "*{EXPERIMENTAL} Drag a region. -This function uses special data types if the low-level -protocol requires it. It does so by calling -dragdrop-drag-pure-text." - (experimental-dragdrop-drag-pure-text event - (buffer-substring-no-properties begin end))) - -(defun experimental-dragdrop-drag-pure-text (event text) - "*{EXPERIMENTAL} Drag text-only data. -Takes care of special low-level protocol data types. -Text must be a list of strings." - (error "Not implemented")) - -(defun experimental-dragdrop-drag-pure-file (event file) - "*{EXPERIMENTAL} Drag filepath-only data. -Takes care of special low-level protocol data types. -file must be a list of strings." - (error "Not implemented")) - -;; -;; The following ones come from frame.el but the better belong here -;; until changed -;; -(defun cde-start-drag (event type data) - "Implement the CDE drag operation. -Calls the internal function cde-start-drag-internal to do the actual work." - (interactive "_eXX") - (if (featurep 'cde) - ;; Avoid build-time doc string warning by calling the function - ;; in the following roundabout way: - (funcall (intern "cde-start-drag-internal") - event type data) - (error "CDE functionality not compiled in."))) - -(defun cde-start-drag-region (event begin end) - "Implement the CDE drag operation for a region. -Calls the internal function CDE-start-drag-internal to do the actual work. -This always does buffer transfers." - ;; Oliver Graf - (interactive "_er") - (if (featurep 'cde) - (funcall (intern "cde-start-drag-internal") - event nil (list (buffer-substring-no-properties begin end))) - (error "CDE functionality not compiled in."))) - -;; the OffiX drag stuff will soon move also (perhaps mouse.el) -;; if the drag event is done -(defun offix-start-drag (event data &optional type) - "Implement the OffiX drag operation. -Calls the internal function offix-start-drag-internal to do the actual work. -If type is not given, DndText is assumed." - ;; Oliver Graf - (interactive "esi") - (if (featurep 'offix) - (funcall (intern "offix-start-drag-internal") event data type) - (error "OffiX functionality not compiled in."))) - -(defun offix-start-drag-region (event begin end) - "Implement the OffiX drag operation for a region. -Calls the internal function offix-start-drag-internal to do the actual work. -This always assumes DndText as type." - ;; Oliver Graf - (interactive "_er") - (if (featurep 'offix) - (funcall (intern "offix-start-drag-internal") - event (buffer-substring-no-properties begin end)) - (error "OffiX functionality not compiled in."))) - - -;;; dragdrop.el ends here diff --git a/lisp/dump-paths.el b/lisp/dump-paths.el deleted file mode 100644 index 10117d5..0000000 --- a/lisp/dump-paths.el +++ /dev/null @@ -1,86 +0,0 @@ -;; dump-paths.el --- set up XEmacs paths for dumping - -;; Copyright (C) 1985, 1986, 1992, 1994, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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 sets up the various paths for continuing loading files for -;; dumping. - -(let ((debug-paths (or debug-paths - (and (getenv "EMACSDEBUGPATHS") - t))) - (roots (paths-find-emacs-roots invocation-directory - invocation-name))) - - (if debug-paths - (princ (format "XEmacs thinks the roots of its hierarchy are:\n%S\n" - roots))) - - (let ((stuff (packages-find-packages roots))) - (setq late-packages (car (cdr stuff)))) - - (setq late-package-load-path (packages-find-package-load-path late-packages)) - - (if debug-paths - (progn - (princ (format "configure-package-path:\n%S\n" configure-package-path) - 'external-debugging-output) - (princ (format "late-packages and late-package-load-path:\n%S\n%S\n" - late-packages late-package-load-path) - 'external-debugging-output))) - - (setq lisp-directory (paths-find-lisp-directory roots)) - (if debug-paths - (princ (format "lisp-directory:\n%S\n" lisp-directory) - 'external-debugging-output)) - (setq site-directory (and (null inhibit-site-lisp) - (paths-find-site-lisp-directory roots))) - (if (and debug-paths (null inhibit-site-lisp)) - (princ (format "site-directory:\n%S\n" site-directory) - 'external-debugging-output)) - - (setq load-path (paths-construct-load-path roots - '() - late-package-load-path - '() - lisp-directory - site-directory)) - - (setq module-directory (paths-find-module-directory roots)) - (if debug-paths - (princ (format "module-directory:\n%S\n" module-directory) - 'external-debugging-output)) - (setq site-module-directory (and (null inhibit-site-modules) - (paths-find-site-module-directory roots))) - (if (and debug-paths (null inhibit-site-modules)) - (princ (format "site-module-directory:\n%S\n" site-module-directory) - 'external-debugging-output)) - - (setq module-load-path (paths-construct-module-load-path roots - module-directory - site-module-directory))) - -;;; dump-paths.el ends here diff --git a/lisp/dumped-lisp.el b/lisp/dumped-lisp.el deleted file mode 100644 index 290991b..0000000 --- a/lisp/dumped-lisp.el +++ /dev/null @@ -1,220 +0,0 @@ -(setq preloaded-file-list - (assemble-list - "backquote" ; needed for defsubst etc. - "bytecomp-runtime" ; define defsubst - "Installation.el" - "find-paths" - "packages" ; Bootstrap run-time lisp environment - "setup-paths" - "dump-paths" - "subr" ; load the most basic Lisp functions - "replace" ; match-string used in version.el. - ; Ignore compiled-by-mistake version.elc - "version.el" - "cl" - "cl-extra" - "cl-seq" - "widget" - "custom" ; Before the world so everything can be - ; customized - "cus-start" ; for customization of builtin variables - "cmdloop" - "keymap" - "syntax" - "device" - "console" - "obsolete" - "specifier" - "faces" ; must be loaded before any make-face call -;;(pureload "facemenu") #### not yet ported - "glyphs" - "objects" - "extents" - "events" - "text-props" - "process" ;; This is bad. network-streams may not be defined. - (when-feature multicast "multicast") ; #+network-streams implicitely true - "frame" ; move up here cause some stuff needs it here - "map-ynp" - "simple" - "keydefs" ; Before loaddefs so that keymap vars exist. - "abbrev" - "derived" - "minibuf" - "list-mode" - "modeline" ; needs simple.el to be loaded first -;; If SparcWorks support is included some additional packages are -;; dumped which would normally have autoloads. To avoid -;; duplicate doc string warnings, SparcWorks uses a separate -;; autoloads file with the dumped packages removed. -;; After fixing, eos/loaddefs-eos and loaddefs appear identical?!! -;; So just make loaddefs-eos go away... -;;(pureload (if (featurep 'sparcworks) "eos/loaddefs-eos" "loaddefs")) - "startup" ; For initialization of - ; `emacs-user-extension-dir' - "misc" - ;; (pureload "profile") - (unless-feature mule "help-nomule") - "help" - ;; (pureload "hyper-apropos") Soon... - (unless-feature file-coding "files-nomule") - "files" - "lib-complete" - "format" - "indent" - "isearch-mode" - "buffer" - "buff-menu" - "undo-stack" - "window" - "window-xemacs" - "paths.el" ; don't get confused if paths compiled. - "lisp" - "page" - "register" - "iso8859-1" ; This must be before any modes - ; (sets standard syntax table.) - "paragraphs" - "easymenu" ; Added for 20.3. - "lisp-mode" - "text-mode" - "fill" - "auto-save" ; Added for 20.4 - - (when-feature windows-nt "winnt") - (when-feature lisp-float-type "float-sup") - "itimer" ; for vars auto-save-timeout and - ; auto-gc-threshold - "itimer-autosave" - (when-feature toolbar "toolbar") - (when-feature scrollbar "scrollbar") - (when-feature menubar "menubar") - (when-feature dialog "dialog") - (when-feature mule "mule-charset") - (when-feature file-coding "coding") - (when-feature mule "mule-coding") -;; Handle I/O of files with extended characters. - (when-feature file-coding "code-files") - (when-feature mule "mule-files") -;; Handle process with encoding/decoding non-ascii coding-system. - (when-feature file-coding "code-process") - (when-feature mule "mule-help") -;; Load the remaining basic files. - (when-feature mule "mule-category") - (when-feature mule "mule-ccl") - (when-feature mule "mule-misc") - (when-feature mule "kinsoku") - (when-feature (and mule x) "mule-x-init") - (when-feature (and mule tty) "mule-tty-init") - (when-feature mule "mule-cmds") ; to sync with Emacs 20.1 - -;; after this goes the specific lisp routines for a particular input system -;; 97.2.5 JHod Shouldn't these go into a site-load file to allow site -;; or user switching of input systems??? -;(if (featurep 'wnn) -; (progn -; (pureload "egg") -; (pureload "egg-wnn") -; (setq egg-default-startup-file "eggrc-wnn"))) - -;; (if (and (boundp 'CANNA) CANNA) -;; (pureload "canna") -;; ) - -;; Now load files to set up all the different languages/environments -;; that Mule knows about. - - (when-feature mule "arabic") - (when-feature mule "chinese") - (when-feature mule "mule/cyrillic") ; overloaded in leim/quail - (when-feature mule "english") -;; (when-feature mule "ethiopic") - (when-feature mule "european") - (when-feature mule "mule/greek") ; overloaded in leim/quail - (when-feature mule "hebrew") - (when-feature mule "japanese") - (when-feature mule "korean") - (when-feature mule "misc-lang") -;; (when-feature mule "thai") - (when-feature mule "viet-chars") -;; (when-feature mule "vietnamese") - - ;; Specialized language support - (when-feature (and mule CANNA) "canna-leim") -;; Egg/Its is now a package -; (when-feature (and mule wnn) "egg-leim") -; (when-feature (and mule wnn) "egg-kwnn-leim") -; (when-feature (and mule wnn) "egg-cwnn-leim") -; (when-feature mule "egg-sj3-leim") -;; SKK is now a package -; (when-feature mule "skk-leim") - -;; Set up the XEmacs environment for Mule. -;; Assumes the existence of various stuff above. - (when-feature mule "mule-init") - -;; Enable Mule capability for Gnus, mail, etc... -;; Moved to sunpro-load.el - the default only for Sun. -;;(pureload "mime-setup") -;;; mule-load.el ends here - (when-feature window-system "gui") - (when-feature window-system "mode-motion") - (when-feature window-system "mouse") - (when-feature window-system "select") - (when-feature dragdrop-api "dragdrop") -;; preload the X code, for faster startup. - (when-feature (and (not infodock) - (or x mswindows) menubar) "menubar-items") - (when-feature (and infodock (or x mswindows) menubar) "id-menus") - (when-feature x "x-faces") - (when-feature x "x-iso8859-1") - (when-feature x "x-mouse") - (when-feature x "x-select") - (when-feature (and x scrollbar) "x-scrollbar") - (when-feature x "x-misc") - (when-feature x "x-init") - (when-feature (and (not infodock) - window-system toolbar) "toolbar-items") - (when-feature x "x-win-xfree86") - (when-feature x "x-win-sun") -;; preload the mswindows code. - (when-feature mswindows "msw-glyphs") - (when-feature mswindows "msw-faces") - (when-feature mswindows "msw-mouse") - (when-feature mswindows "msw-init") - (when-feature mswindows "msw-select") -;; preload the TTY init code. - (when-feature tty "tty-init") -;;; Formerly in tooltalk/tooltalk-load.el - ;; Moved to tooltalk package - ;; (when-feature tooltalk "tooltalk-macros") - ;; (when-feature tooltalk "tooltalk-util") - ;; (when-feature tooltalk "tooltalk-init") - ;; "vc-hooks" ; Packaged. Available in two versions. - ;; "ediff-hook" ; Packaged. - "fontl-hooks" - "auto-show" - (when-feature ldap "ldap") - -;; (when-feature energize "energize/energize-load.el") -;;; formerly in sunpro/sunpro-load.el -;; (when-feature (and mule sparcworks) "mime-setup") - - ;; Moved to Sun package - ;; (when-feature sparcworks "cc-mode") ; Requires cc-mode package - ;; (when-feature sparcworks "sunpro-init") - ;; (when-feature sparcworks "ring") - ;; (when-feature sparcworks "comint") ; Requires comint package - ;; (when-feature sparcworks "annotations") - -;;; formerly in eos/sun-eos-load.el -;; (when-feature sparcworks "sun-eos-init") -;; (when-feature sparcworks "sun-eos-common") -;; (when-feature sparcworks "sun-eos-editor") -;; (when-feature sparcworks "sun-eos-browser") -;; (when-feature sparcworks "sun-eos-debugger") -;; (when-feature sparcworks "sun-eos-debugger-extra") -;; (when-feature sparcworks "sun-eos-menubar") - "loadhist" ; Must be dumped before loaddefs is loaded - "loaddefs" ; <=== autoloads get loaded here -)) diff --git a/lisp/easymenu.el b/lisp/easymenu.el deleted file mode 100644 index 906b51d..0000000 --- a/lisp/easymenu.el +++ /dev/null @@ -1,272 +0,0 @@ -;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs. - -;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Maintainer: XEmacs Development Team -;; Keywords: internal, extensions, dumped - -;; 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 synched with FSF but coordinated with the FSF -;;; easymenu maintor for compatability with FSF 20.4. -;;; Please: Coordinate changes with Inge Frick - -;; Commentary: - -;; This file is dumped with XEmacs. - -;; Easymenu allows you to define menus for both Emacs 19 and XEmacs. - -;; This file -;; The advantages of using easymenu are: - -;; - Easier to use than either the Emacs 19 and XEmacs menu syntax. - -;; - Common interface for Emacs 18, Emacs 19, and XEmacs. -;; (The code does nothing when run under Emacs 18). - -;; The public functions are: - -;; - Function: easy-menu-define SYMBOL MAPS DOC MENU -;; SYMBOL is both the name of the variable that holds the menu and -;; the name of a function that will present a the menu. -;; MAPS is a list of keymaps where the menu should appear in the menubar. -;; DOC is the documentation string for the variable. -;; MENU is an XEmacs style menu description. - -;; See the documentation for easy-menu-define for details. - -;; - Function: easy-menu-change PATH NAME ITEMS -;; Change an existing menu. -;; The menu must already exist and be visible on the menu bar. -;; PATH is a list of strings used for locating the menu on the menu bar. -;; NAME is the name of the menu. -;; ITEMS is a list of menu items, as defined in `easy-menu-define'. - -;; - Function: easy-menu-add MENU [ MAP ] -;; Add MENU to the current menubar in MAP. - -;; - Function: easy-menu-remove MENU -;; Remove MENU from the current menubar. - -;; - Function: easy-menu-add-item -;; Add item or submenu to existing menu - -;; - Function: easy-menu-item-present-p -;; Locate item - -;; - Function: easy-menu-remove-item -;; Delete item from menu. - -;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus -;; automatically appear and disappear when the keymaps specified by -;; the MAPS argument to `easy-menu-define' are activated. - -;; XEmacs will bind the map to button3 in each MAPS, but you must -;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and -;; remove menus from the menu bar. - -;;; Code: - -;; ;;;###autoload -(defmacro easy-menu-define (symbol maps doc menu) - "Define a menu bar submenu in maps MAPS, according to MENU. -The arguments SYMBOL and DOC are ignored; they are present for -compatibility only. SYMBOL is not evaluated. In other Emacs versions -these arguments may be used as a variable to hold the menu data, and a -doc string for that variable. - -The first element of MENU must be a string. It is the menu bar item name. -The rest of the elements are menu items. - -A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] - -NAME is a string--the menu item name. - -CALLBACK is a command to run when the item is chosen, -or a list to evaluate when the item is chosen. - -ENABLE is an expression; the item is enabled for selection -whenever this expression's value is non-nil. - -Alternatively, a menu item may have the form: - - [ NAME CALLBACK [ KEYWORD ARG ] ... ] - -Where KEYWORD is one of the symbol defined below. - - :keys KEYS - -KEYS is a string; a complex keyboard equivalent to this menu item. - - :active ENABLE - -ENABLE is an expression; the item is enabled for selection -whenever this expression's value is non-nil. - - :suffix NAME - -NAME is a string; the name of an argument to CALLBACK. - - :style STYLE - -STYLE is a symbol describing the type of menu item. The following are -defined: - -toggle: A checkbox. - Currently just prepend the name with the string \"Toggle \". -radio: A radio button. -nil: An ordinary menu item. - - :selected SELECTED - -SELECTED is an expression; the checkbox or radio button is selected -whenever this expression's value is non-nil. -Currently just disable radio buttons, no effect on checkboxes. - -A menu item can be a string. Then that string appears in the menu as -unselectable text. A string consisting solely of hyphens is displayed -as a solid horizontal line. - -A menu item can be a list. It is treated as a submenu. -The first element should be the submenu name. That's used as the -menu item in the top-level menu. The cdr of the submenu list -is a list of menu items, as above." - `(progn - (defvar ,symbol nil ,doc) - (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) - -(defun easy-menu-do-define (symbol maps doc menu) - (if (featurep 'menubar) - (progn - (set symbol menu) - (fset symbol (list 'lambda '(e) - doc - '(interactive "@e") - '(run-hooks 'activate-menubar-hook) - '(setq zmacs-region-stays 't) - (list 'popup-menu symbol)))))) - -(defun easy-menu-change (&rest args) - (when (featurep 'menubar) - (apply 'add-menu args))) - -;; This variable hold the easy-menu mode menus of all major and -;; minor modes currently in effect in the current buffer. -(defvar easy-menu-all-popups nil) -(make-variable-buffer-local 'easy-menu-all-popups) - -(defun easy-menu-add (menu &optional map) - "Add MENU to the current menu bar." - (if (featurep 'menubar) - (progn - (unless (member menu easy-menu-all-popups) - (push menu easy-menu-all-popups)) - (setq mode-popup-menu (if (> (length easy-menu-all-popups) 1) - (cons (easy-menu-title) - (reverse easy-menu-all-popups)) - (car easy-menu-all-popups))) - - (cond ((null current-menubar) - ;; Don't add it to a non-existing menubar. - nil) - ((assoc (car menu) current-menubar) - ;; Already present. - nil) - ((equal current-menubar '(nil)) - ;; Set at left if only contains right marker. - (set-buffer-menubar (list menu nil))) - (t - ;; Add at right. - (set-buffer-menubar (copy-sequence current-menubar)) - (add-menu nil (car menu) (cdr menu))))))) - -(defun easy-menu-remove (menu) - "Remove MENU from the current menu bar." - (if (featurep 'menubar) - (progn - (setq easy-menu-all-popups (delq menu easy-menu-all-popups) - mode-popup-menu (if (< (length easy-menu-all-popups) 1) - (cons (easy-menu-title) - (reverse easy-menu-all-popups)) - (car easy-menu-all-popups))) - - (and current-menubar - (assoc (car menu) current-menubar) - (delete-menu-item (list (car menu))))))) - -(defsubst easy-menu-normalize (menu) - (if (symbolp menu) - (symbol-value menu) - menu)) - -(defun easy-menu-add-item (menu path item &optional before) - "At the end of the submenu of MENU with path PATH add ITEM. -If ITEM is already present in this submenu, then this item will be changed. -otherwise ITEM will be added at the end of the submenu, unless the optional -argument BEFORE is present, in which case ITEM will instead be added -before the item named BEFORE. -MENU is either a symbol, which have earlier been used as the first -argument in a call to `easy-menu-define', or the value of such a symbol -i.e. a menu, or nil which stands for the current menubar. -PATH is a list of strings for locating the submenu where ITEM is to be -added. If PATH is nil, MENU itself is used. Otherwise, the first -element should be the name of a submenu directly under MENU. This -submenu is then traversed recursively with the remaining elements of PATH. -ITEM is either defined as in `easy-menu-define', a menu defined earlier -by `easy-menu-define' or `easy-menu-create-menu' or an item returned -from `easy-menu-item-present-p' or `easy-menu-remove-item'." - (add-menu-button path item before (easy-menu-normalize menu))) - -(defun easy-menu-item-present-p (menu path name) - "In submenu of MENU with path PATH, return true iff item NAME is present. -MENU and PATH are defined as in `easy-menu-add-item'. -NAME should be a string, the name of the element to be looked for. - -The return value can be used as as an argument to `easy-menu-add-item'." - (car (find-menu-item (or (easy-menu-normalize menu) current-menubar) - (append path (list name))))) - -(defun easy-menu-remove-item (menu path name) - "From submenu of MENU with path PATH remove item NAME. -MENU and PATH are defined as in `easy-menu-add-item'. -NAME should be a string, the name of the element to be removed. - -The return value can be used as as an argument to `easy-menu-add-item'." - (delete-menu-item (append path (list name)) - (easy-menu-normalize menu))) - - - - -;; Think up a good title for the menu. Take the major-mode of the -;; buffer, strip the -mode part, convert hyphens to spaces, and -;; capitalize it. -;; -;; If you can think of something smarter, feel free to replace it. -;; Don't forget to mail the change to xemacs@xemacs.org where everyone -;; can flame, er, praise your changes. -(defun easy-menu-title () - (capitalize (replace-in-string (replace-in-string - (symbol-name major-mode) "-mode$" "") - "-" " "))) - -(provide 'easymenu) - -;;; easymenu.el ends here diff --git a/lisp/etags.el b/lisp/etags.el deleted file mode 100644 index 00180d6..0000000 --- a/lisp/etags.el +++ /dev/null @@ -1,1208 +0,0 @@ -;;; etags.el --- etags facility for Emacs - -;; Copyright 1985, 1986, 1988, 1990, 1997 Free Software Foundation, Inc. - -;; Author: Their Name is Legion (see list below) -;; Maintainer: XEmacs Development Team -;; 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, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: Not synched with FSF. - -;;; Commentary: - -;; This file is completely different from FSF's etags.el. It appears -;; that an early version of this file (tags.el) has been rewritten by -;; two different people; we got one, FSF got the other. Various -;; people have said that our version is better and faster. - -;; TODO: -;; - DOCUMENT! - -;; Derived from the original lisp/tags.el. - -;; Ideas and code from the work of the following people: -;; Andy Norman , author of ange-tags.el -;; Ramana Rao -;; John Sturdy , author of tags-helper.el -;; Henry Kautz , author of tag-completion.el -;; Dan LaLiberte , author of local-tags.el -;; Tom Dietterich , author of quest.el -;; The author(s) of lisp/simple.el -;; Duke Briscoe -;; Lynn Slater , author of location.el -;; Shinichirou Sugou -;; an unidentified anonymous elisp hacker -;; Kyle Jones -;; added "Exact match, then inexact" code -;; added support for include directive. -;; Hrvoje Niksic -;; various changes. - - -;;; User variables. - -(defgroup etags nil - "Etags facility for Emacs. -Using etags, you can create tag tables for any number of files, and -easily access the symbols in those files, using the `\\[find-tag]' -command." - :prefix "tags-" - :group 'tools) - - -(defcustom tags-build-completion-table 'ask - "*If this variable is nil, then tags completion is disabled. -If it is t, then things which prompt for tags will do so with completion - across all known tags. -If it is the symbol `ask', you will be asked whether each tags table - should be added to the completion list as it is read in. (With the - exception that for very small tags tables, you will not be asked, - since they can be parsed quickly.)" - :type '(choice (const :tag "Disabled" nil) - (const :tag "Complete All" t) - (const :tag "Ask" ask)) - :group 'etags) - -(defcustom tags-always-exact nil - "*If this variable is non-nil, then tags always looks for exact matches. -If it is nil (the default), tags will first go through exact matches, -then through the non-exact ones." - :type 'boolean - :group 'etags) - -(defcustom tag-table-alist nil - "*A list which determines which tags files are active for a buffer. -This is not really an association list, in that all elements are -checked. The CAR of each element of this list is a pattern against -which the buffer's file name is compared; if it matches, then the CDR -of the list should be the name of the tags table to use. If more than -one element of this list matches the buffer's file name, then all of -the associated tags tables will be used. Earlier ones will be -searched first. - -If the CAR of elements of this list are strings, then they are treated -as regular-expressions against which the file is compared (like the -auto-mode-alist). If they are not strings, then they are evaluated. -If they evaluate to non-nil, then the current buffer is considered to -match. - -If the CDR of the elements of this list are strings, then they are -assumed to name a TAGS file. If they name a directory, then the string -\"TAGS\" is appended to them to get the file name. If they are not -strings, then they are evaluated, and must return an appropriate string. - -For example: - (setq tag-table-alist - '((\"/usr/src/public/perl/\" . \"/usr/src/public/perl/perl-3.0/\") - (\"\\\\.el$\" . \"/usr/local/emacs/src/\") - (\"/jbw/gnu/\" . \"/usr15/degree/stud/jbw/gnu/\") - (\"\" . \"/usr/local/emacs/src/\") - )) - -This means that anything in the /usr/src/public/perl/ directory should use -the TAGS file /usr/src/public/perl/perl-3.0/TAGS; and file ending in .el should -use the TAGS file /usr/local/emacs/src/TAGS; and anything in or below the -directory /jbw/gnu/ should use the TAGS file /usr15/degree/stud/jbw/gnu/TAGS. -A file called something like \"/usr/jbw/foo.el\" would use both the TAGS files -/usr/local/emacs/src/TAGS and /usr15/degree/stud/jbw/gnu/TAGS (in that order) -because it matches both patterns. - -If the buffer-local variable `buffer-tag-table' is set, then it names a tags -table that is searched before all others when find-tag is executed from this -buffer. - -If there is a file called \"TAGS\" in the same directory as the file in -question, then that tags file will always be used as well (after the -`buffer-tag-table' but before the tables specified by this list.) - -If the variable tags-file-name is set, then the tags file it names will apply -to all buffers (for backwards compatibility.) It is searched first." - :type '(repeat (cons :format "%v" - (choice :value "" - (regexp :tag "Buffer regexp") - sexp) - (choice :value "" - (string :tag "Tag file or directory") - sexp))) - :group 'etags) - -(defvar buffer-tag-table nil - "*The additional name of one TAGS table to be used for this buffer. -You can set this with `\\[set-buffer-tag-table]'. See the documentation -for the variable `tag-table-alist' for more information.") -(make-variable-buffer-local 'buffer-tag-table) - -(defvar tags-file-name nil - "The name of the tags-table used by all buffers. -This is for backwards compatibility, and is largely supplanted by the -variable tag-table-alist.") - -(defcustom tags-auto-read-changed-tag-files nil - "*If non-nil, always re-read changed TAGS file without prompting. -If nil, prompt whether to re-read the changed TAGS file." - :type 'boolean - :group 'etags) - -(defcustom make-tags-files-invisible nil - "*If non-nil, TAGS-files will not show up in buffer-lists or be -selectable (or deletable.)" - :type 'boolean - :group 'etags) - -(defcustom tags-search-nuke-uninteresting-buffers t - "*If non-nil, keep newly-visited files if they contain the search target. -This affects the `tags-search' and `tags-query-replace' commands." - :type 'boolean - :group 'etags) - - -;; Buffer tag tables. - -(defun buffer-tag-table-list () - "Returns a list (ordered) of the tags tables which should be used for -the current buffer." - (let (result) - ;; Explicitly set buffer-tag-table - (when buffer-tag-table - (push buffer-tag-table result)) - ;; Current directory - (when (file-readable-p (concat default-directory "TAGS")) - (push (concat default-directory "TAGS") result)) - ;; Parent directory - (let ((parent-tag-file (expand-file-name "../TAGS" default-directory))) - (when (file-readable-p parent-tag-file) - (push parent-tag-file result))) - ;; tag-table-alist - (let ((key (or buffer-file-name - (concat default-directory (buffer-name)))) - expression) - (dolist (item tag-table-alist) - (setq expression (car item)) - ;; If the car of the alist item is a string, apply it as a regexp - ;; to the buffer-file-name. Otherwise, evaluate it. If the - ;; regexp matches, or the expression evaluates non-nil, then this - ;; item in tag-table-alist applies to this buffer. - (when (if (stringp expression) - (string-match expression key) - (ignore-errors - (eval expression))) - ;; Now evaluate the cdr of the alist item to get the name of - ;; the tag table file. - (setq expression (ignore-errors - (eval (cdr item)))) - (if (stringp expression) - (push expression result) - (error "Expression in tag-table-alist evaluated to non-string"))))) - (setq result - (mapcar - (lambda (name) - (when (file-directory-p name) - (setq name (concat (file-name-as-directory name) "TAGS"))) - (and (file-readable-p name) - ;; get-tag-table-buffer has side-effects - (symbol-value-in-buffer 'buffer-file-name - (get-tag-table-buffer name)))) - result)) - (setq result (delq nil result)) - ;; If no TAGS file has been found, ask the user explicitly. - ;; #### tags-file-name is *evil*. - (or result tags-file-name - (call-interactively 'visit-tags-table)) - (when tags-file-name - (setq result (nconc result (list tags-file-name)))) - (or result (error "Buffer has no associated tag tables")) - (delete-duplicates (nreverse result) :test 'equal))) - -;;;###autoload -(defun visit-tags-table (file) - "Tell tags commands to use tags table file FILE when all else fails. -FILE should be the name of a file created with the `etags' program. -A directory name is ok too; it means file TAGS in that directory." - (interactive (list (read-file-name "Visit tags table: (default TAGS) " - default-directory - (expand-file-name "TAGS" default-directory) - t))) - (if (string-equal file "") - (setq tags-file-name nil) - (setq file (expand-file-name file)) - (when (file-directory-p file) - (setq file (expand-file-name "TAGS" file))) - ;; It used to be that, if a user pressed RET by mistake, the bogus - ;; `tags-file-name' would remain, causing the error at - ;; `buffer-tag-table'. - (when (file-exists-p file) - (setq tags-file-name file)))) - -(defun set-buffer-tag-table (file) - "In addition to the tags tables specified by the variable `tag-table-alist', -each buffer can have one additional table. This command sets that. -See the documentation for the variable `tag-table-alist' for more information." - (interactive - (list - (read-file-name "Visit tags table: (directory sufficient) " - nil default-directory t))) - (or file (error "No TAGS file name supplied")) - (setq file (expand-file-name file)) - (when (file-directory-p file) - (setq file (expand-file-name "TAGS" file))) - (or (file-exists-p file) (error "TAGS file missing: %s" file)) - (setq buffer-tag-table file)) - - -;; Manipulating the tag table buffer - -(defconst tag-table-completion-status nil - "Indicates whether a completion table has been built. -Either nil, t, or `disabled'.") -(make-variable-buffer-local 'tag-table-completion-status) - -(defconst tag-table-files nil - "If the current buffer is a TAGS table, this holds a list of the files -referenced by this file, or nil if that hasn't been computed yet.") -(make-variable-buffer-local 'tag-table-files) - -(defun get-tag-table-buffer (tag-table) - "Returns a buffer visiting the given TAGS table. -If appropriate, reverting the buffer, and possibly build a completion-table." - (or (stringp tag-table) - (error "Bad tags file name supplied: %s" tag-table)) - ;; Remove symbolic links from name. - (setq tag-table (symlink-expand-file-name tag-table)) - (let (buf build-completion check-name) - (setq buf (get-file-buffer tag-table)) - (unless buf - (if (file-readable-p tag-table) - (setq buf (find-file-noselect tag-table) - check-name t) - (error "No such tags file: %s" tag-table))) - (with-current-buffer buf - ;; Make the TAGS buffer invisible. - (when (and check-name - make-tags-files-invisible - (string-match "\\`[^ ]" (buffer-name))) - (rename-buffer (generate-new-buffer-name - (concat " " (buffer-name))))) - (or (verify-visited-file-modtime buf) - (cond ((or tags-auto-read-changed-tag-files - (yes-or-no-p - (format "Tags file %s has changed, read new contents? " - tag-table))) - (when tags-auto-read-changed-tag-files - (message "Tags file %s has changed, reading new contents..." - tag-table)) - (revert-buffer t t) - (when (eq tag-table-completion-status t) - (setq tag-table-completion-status nil)) - (setq tag-table-files nil)))) - (or (eq (char-after 1) ?\f) - (error "File %s not a valid tags file" tag-table)) - (or (memq tag-table-completion-status '(t disabled)) - (setq build-completion t)) - (when build-completion - (if (ecase tags-build-completion-table - ((nil) nil) - ((t) t) - ((ask) - ;; don't bother asking for small ones - (or (< (buffer-size) 20000) - (y-or-n-p - (format "Build tag completion table for %s? " - tag-table))))) - ;; The user wants to build the table: - (condition-case nil - (progn - (add-to-tag-completion-table) - (setq tag-table-completion-status t)) - ;; Allow user to C-g out correctly - (quit - (message "Tags completion table construction aborted") - (setq tag-table-completion-status nil - quit-flag t) - t)) - ;; The table is verboten. - (setq tag-table-completion-status 'disabled)))) - buf)) - -(defun file-of-tag () - "Return the file name of the file whose tags point is within. -Assumes the tag table is the current buffer. -File name returned is relative to tag table file's directory." - (let ((opoint (point)) - prev size) - (save-excursion - (goto-char (point-min)) - (while (< (point) opoint) - (forward-line 1) - (end-of-line) - (skip-chars-backward "^,\n") - (setq prev (point) - size (read (current-buffer))) - (goto-char prev) - (forward-line 1) - ;; New include syntax - ;; filename,include - ;; tacked on to the end of a tag file means use filename - ;; as a tag file before giving up. - ;; Skip it here. - (unless (eq size 'include) - (forward-char size))) - (goto-char (1- prev)) - (buffer-substring (point) (point-at-bol))))) - -(defun tag-table-include-files () - "Return all file names associated with `include' directives in a tag buffer." - ;; New include syntax - ;; filename,include - ;; tacked on to the end of a tag file means use filename as a - ;; tag file before giving up. - (let ((files nil)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\f\n\\(.*\\),include$" nil t) - (push (match-string 1) files))) - files)) - -(defun tag-table-files (tag-table) - "Returns a list of the files referenced by the named TAGS table." - (with-current-buffer (get-tag-table-buffer tag-table) - (unless tag-table-files - (let (files prev size) - (goto-char (point-min)) - (while (not (eobp)) - (forward-line 1) - (end-of-line) - (skip-chars-backward "^,\n") - (setq prev (point) - size (read (current-buffer))) - (goto-char prev) - (push (expand-file-name (buffer-substring (1- (point)) - (point-at-bol)) - default-directory) - files) - (forward-line 1) - (forward-char size)) - (setq tag-table-files (nreverse files)))) - tag-table-files)) - -;; #### should this be on previous page? -(defun buffer-tag-table-files () - "Returns a list of all files referenced by all TAGS tables that -this buffer uses." - (apply #'nconc - (mapcar #'tag-table-files (buffer-tag-table-list)))) - - -;; Building the completion table - -;; Test cases for building completion table; must handle these properly: -;; Lisp_Int, XSETINT, current_column 60,2282 -;; Lisp_Int, XSETINT, point>NumCharacters ? 0 : CharAt(363,9935 -;; Lisp_Int, XSETINT, point<=FirstCharacter ? 0 : CharAt(366,10108 -;; point<=FirstCharacter || CharAt(378,10630 -;; point>NumCharacters || CharAt(382,10825 -;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,191,4562 -;; DEFUN ("x-set-foreground-color", Fx_set_foreground_color,191,4562 -;; DEFUN ("*", Ftimes,1172,32079 -;; DEFUN ("/=", Fneq,1035,28839 -;; defun_internal 4199,101362 -;; int pure[PURESIZE / sizeof 53,1564 -;; char staticvec1[NSTATICS * sizeof 667,17608 -;; Date: 04 May 87 23:53:11 PDT 26,1077 -;; #define anymacroname(324,4344 -;; (define-key ctl-x-map 311,11784 -;; (define-abbrev-table 'c-mode-abbrev-table 24,1016 -;; static char *skip_white(116,3443 -;; static foo 348,11643 -;; (defun texinfo-insert-@code 91,3358 -;; (defvar texinfo-kindex)29,1105 -;; (defun texinfo-format-\. 548,18376 -;; (defvar sm::menu-kludge-y 621,22726 -;; (defvar *mouse-drag-window* 103,3642 -;; (defun simula-back-level(317,11263 -;; } DPxAC,380,14024 -;; } BM_QCB;69,2990 -;; #define MTOS_DONE\t - -;; "^[^ ]+ +\\([^ ]+\\) " - -;; void *find_cactus_segment(116,2444 -;; void *find_pdb_segment(162,3688 -;; void init_dclpool(410,10739 -;; WORD insert_draw_command(342,8881 -;; void *req_pdbmem(579,15574 - -(defvar tag-completion-table (make-vector 511 0)) - -(defvar tag-symbol) -(defvar tag-table-symbol) -(defvar tag-symbol-tables) -(defvar buffer-tag-table-list) - -(defmacro intern-tag-symbol (tag) - `(progn - (setq tag-symbol (intern ,tag tag-completion-table) - tag-symbol-tables (and (boundp tag-symbol) - (symbol-value tag-symbol))) - (or (memq tag-table-symbol tag-symbol-tables) - (set tag-symbol (cons tag-table-symbol tag-symbol-tables))))) - -;; Can't use "\\s " in these patterns because that will include newline -(defconst tags-DEFUN-pattern - "DEFUN[ \t]*(\"\\([^\"]+\\)\",[ \t]*\\(\\(\\sw\\|\\s_\\)+\\),\C-?") -(defconst tags-array-pattern ".*[ \t]+\\([^ \[]+\\)\\[") -(defconst tags-def-pattern - "\\(.*[ \t]+\\)?\\**\\(\\(\\sw\\|\\s_\\)+\\)[ ();,\t]*\C-?" -;; "\\(.*[ \t]+\\)?\\(\\(\\sw\\|\\s_\\)+\\)[ ()]*\C-?" -;; "\\(\\sw\\|\\s_\\)+[ ()]*\C-?" - ) -(defconst tags-file-pattern "^\f\n\\(.+\\),[0-9]+\n") - -;; #### Should make it work with the `include' directive! -(defun add-to-tag-completion-table () - "Sucks the current buffer (a TAGS table) into the completion-table." - (message "Adding %s to tags completion table..." buffer-file-name) - (goto-char (point-min)) - (let ((tag-table-symbol (intern buffer-file-name tag-completion-table)) - ;; tag-table-symbol is used by intern-tag-symbol - filename file-type name name2 tag-symbol - tag-symbol-tables - (case-fold-search nil)) - ;; Loop over the files mentioned in the TAGS file for each file, - ;; try to find its major-mode, then process tags appropriately. - (while (looking-at tags-file-pattern) - (goto-char (match-end 0)) - (setq filename (file-name-sans-versions (match-string 1)) - ;; We used to check auto-mode-alist for the proper - ;; file-type. This was way too slow, as it had to process - ;; an enormous amount of regexps for each time. Now we - ;; use the shotgun approach with only two regexps. - file-type (cond ((string-match "\\.\\([cC]\\|cc\\|cxx\\)\\'" - filename) - 'c-mode) - ((string-match "\\.\\(el\\|cl\\|lisp\\)\\'" - filename) - 'lisp-mode) - ((string-match "\\.scm\\'" filename) - 'scheme-mode) - (t nil))) - (set-syntax-table (cond ((and (eq file-type 'c-mode) - c-mode-syntax-table) - c-mode-syntax-table) - ((eq file-type 'lisp-mode) - lisp-mode-syntax-table) - (t (standard-syntax-table)))) - ;; Clear loop variables. - (setq name nil name2 nil) - (lmessage 'progress "%s..." filename) - ;; Loop over the individual tag lines. - (while (not (or (eobp) (eq (char-after) ?\f))) - (cond ((and (eq file-type 'c-mode) - (looking-at "DEFUN[ \t]")) - ;; DEFUN - (or (looking-at tags-DEFUN-pattern) - (error "DEFUN doesn't fit pattern")) - (setq name (match-string 1) - name2 (match-string 2))) - ;;((looking-at "\\s ") - ;; skip probably bogus entry: - ;;) - ((and (eq file-type 'c-mode) - (looking-at ".*\\[")) - ;; Array - (cond ((not (looking-at tags-array-pattern)) - (message "array definition doesn't fit pattern") - (setq name nil)) - (t - (setq name (match-string 1))))) - ((and (eq file-type 'scheme-mode) - (looking-at "\\s-*(\\s-*def\\sw*\\s-*(?\\s-*\\(\\(\\sw\\|\\s_\\|:\\)+\\))?\\s-*\C-?")) - ;; Something Schemish (is this really necessary??) - (setq name (match-string 1))) - ((looking-at tags-def-pattern) - ;; ??? - (setq name (match-string 2)))) - ;; add the tags we found to the completion table - (and name (intern-tag-symbol name)) - (and name2 (intern-tag-symbol name2)) - (forward-line 1))) - (or (eobp) (error "Bad TAGS file"))) - (message "Adding %s to tags completion table...done" buffer-file-name)) - - -;; Interactive find-tag - -(defvar find-tag-default-hook nil - "Function to call to create a default tag. -Make it buffer-local in a mode hook. The function is called with no - arguments.") - -(defvar find-tag-hook nil - "*Function to call after a tag is found. -Make it buffer-local in a mode hook. The function is called with no - arguments.") - -;; Return a default tag to search for, based on the text at point. -(defun find-tag-default () - (or (and (not (memq find-tag-default-hook '(nil find-tag-default))) - (condition-case data - (funcall find-tag-default-hook) - (error - (warn "Error in find-tag-default-hook signalled error: %s" - (error-message-string data)) - nil))) - (symbol-near-point))) - -;; This function depends on the following symbols being bound properly: -;; buffer-tag-table-list, -;; tag-symbol-tables (value irrelevant, bound outside for efficiency) -(defun tag-completion-predicate (tag-symbol) - (and (boundp tag-symbol) - (setq tag-symbol-tables (symbol-value tag-symbol)) - (catch 'found - (while tag-symbol-tables - (when (memq (car tag-symbol-tables) buffer-tag-table-list) - (throw 'found t)) - (setq tag-symbol-tables (cdr tag-symbol-tables)))))) - -(defun buffer-tag-table-symbol-list () - (mapcar (lambda (table-name) - (intern table-name tag-completion-table)) - (buffer-tag-table-list))) - -(defvar find-tag-history nil "History list for find-tag-tag.") - -(defun find-tag-tag (prompt) - (let* ((default (find-tag-default)) - (buffer-tag-table-list (buffer-tag-table-symbol-list)) - tag-symbol-tables tag-name) - (setq tag-name - (completing-read - (if default - (format "%s(default %s) " prompt default) - prompt) - tag-completion-table 'tag-completion-predicate nil nil - 'find-tag-history)) - (if (string-equal tag-name "") - ;; #### - This is a really LAME way of doing it! --Stig - default ;indicate exact symbol match - tag-name))) - -(defvar last-tag-data nil - "Information for continuing a tag search. -Is of the form (TAG POINT MATCHING-EXACT TAG-TABLE TAG-TABLE ...).") - -(defvar tags-loop-operate nil - "Form for `tags-loop-continue' to eval to change one file.") - -(defvar tags-loop-scan - '(error "%s" (substitute-command-keys - "No \\[tags-search] or \\[tags-query-replace] in progress.")) - "Form for `tags-loop-continue' to eval to scan one file. -If it returns non-nil, this file needs processing by evalling -\`tags-loop-operate'. Otherwise, move on to the next file.") - -(autoload 'get-symbol-syntax-table "symbol-syntax") - -(defun find-tag-internal (tagname) - (let ((next (null tagname)) - (tmpnext (null tagname)) - ;; If tagname is a list: (TAGNAME), this indicates - ;; requiring an exact symbol match. - (exact (or tags-always-exact (consp tagname))) - (normal-syntax-table (syntax-table)) - (exact-syntax-table (get-symbol-syntax-table (syntax-table))) - tag-table-currently-matching-exact - tag-target exact-tagname - tag-tables tag-table-point file linebeg startpos buf - offset found pat syn-tab) - (when (consp tagname) - (setq tagname (car tagname))) - (cond (next - (setq tagname (car last-tag-data)) - (setq tag-table-currently-matching-exact - (car (cdr (cdr last-tag-data))))) - (t - (setq tag-table-currently-matching-exact t))) - ;; \_ in the tagname is used to indicate a symbol boundary. - (setq exact-tagname (concat "\\_" tagname "\\_")) - (while (string-match "\\\\_" exact-tagname) - (aset exact-tagname (1- (match-end 0)) ?b)) - (save-excursion - (catch 'found - ;; Loop searching for exact matches and then inexact matches. - (while (not (eq tag-table-currently-matching-exact 'neither)) - (cond (tmpnext - (setq tag-tables (cdr (cdr (cdr last-tag-data))) - tag-table-point (car (cdr last-tag-data))) - ;; Start from the beginning of the table list on the - ;; next iteration of the loop. - (setq tmpnext nil)) - (t - (setq tag-tables (buffer-tag-table-list) - tag-table-point 1))) - (if tag-table-currently-matching-exact - (setq tag-target exact-tagname - syn-tab exact-syntax-table) - (setq tag-target tagname - syn-tab normal-syntax-table)) - (with-search-caps-disable-folding tag-target t - (while tag-tables - (set-buffer (get-tag-table-buffer (car tag-tables))) - (bury-buffer (current-buffer)) - (goto-char (or tag-table-point (point-min))) - (setq tag-table-point nil) - (letf (((syntax-table) syn-tab) - (case-fold-search nil)) - ;; #### should there be support for non-regexp - ;; tag searches? - (while (re-search-forward tag-target nil t) - (and (save-match-data - (looking-at "[^\n\C-?]*\C-?")) - ;; If we're looking for inexact matches, skip - ;; exact matches since we've visited them - ;; already. - (or tag-table-currently-matching-exact - (letf (((syntax-table) exact-syntax-table)) - (save-excursion - (goto-char (match-beginning 0)) - (not (looking-at exact-tagname))))) - (throw 'found t)))) - (setq tag-tables - (nconc (tag-table-include-files) (cdr tag-tables))))) - (if (and (not exact) (eq tag-table-currently-matching-exact t)) - (setq tag-table-currently-matching-exact nil) - (setq tag-table-currently-matching-exact 'neither))) - (error "No %sentries %s %s" - (if next "more " "") - (if exact "matching" "containing") - tagname)) - (search-forward "\C-?") - (setq file (expand-file-name (file-of-tag) - ;; In XEmacs, this needs to be - ;; relative to: - (or (file-name-directory (car tag-tables)) - "./"))) - (setq linebeg (buffer-substring (1- (point)) (point-at-bol))) - (search-forward ",") - (setq startpos (read (current-buffer))) - (setq last-tag-data - (nconc (list tagname (point) tag-table-currently-matching-exact) - tag-tables)) - (setq buf (find-file-noselect file)) - (with-current-buffer buf - (save-excursion - (save-restriction - (widen) - ;; Here we search for PAT in the range [STARTPOS - OFFSET, - ;; STARTPOS + OFFSET], with increasing values of OFFSET. - ;; - ;; We used to set the initial offset to 1000, but the - ;; actual sources show that finer-grained control is - ;; needed (e.g. two `hash_string's in src/symbols.c.) So, - ;; I changed 100 to 100, and (* 3 offset) to (* 5 offset). - (setq offset 100) - (setq pat (concat "^" (regexp-quote linebeg))) - (or startpos (setq startpos (point-min))) - (while (and (not found) - (progn - (goto-char (- startpos offset)) - (not (bobp)))) - (setq found (re-search-forward pat (+ startpos offset) t)) - (setq offset (* 5 offset))) - ;; Finally, try finding it anywhere in the buffer. - (or found - (re-search-forward pat nil t) - (error "%s not found in %s" pat file)) - (beginning-of-line) - (setq startpos (point))))) - (cons buf startpos)))) - -;;;###autoload -(defun find-tag (tagname &optional other-window) - "*Find tag whose name contains TAGNAME. - Selects the buffer that the tag is contained in -and puts point at its definition. - If TAGNAME is a null string, the expression in the buffer -around or before point is used as the tag name. - If called interactively with a numeric argument, searches for the next tag -in the tag table that matches the tagname used in the previous find-tag. - If second arg OTHER-WINDOW is non-nil, uses another window to display -the tag. - -This version of this function supports multiple active tags tables, -and completion. - -Variables of note: - - tag-table-alist controls which tables apply to which buffers - tags-file-name a default tags table - tags-build-completion-table controls completion behavior - buffer-tag-table another way of specifying a buffer-local table - make-tags-files-invisible whether tags tables should be very hidden - tag-mark-stack-max how many tags-based hops to remember" - (interactive (if current-prefix-arg - '(nil nil) - (list (find-tag-tag "Find tag: ") nil))) - (let* ((local-find-tag-hook find-tag-hook) - (next (null tagname)) - (result (find-tag-internal tagname)) - (tag-buf (car result)) - (tag-point (cdr result))) - ;; Push old position on the tags mark stack. - (if (or (not next) - (not (memq last-command - '(find-tag find-tag-other-window tags-loop-continue)))) - (push-tag-mark)) - (if other-window - (pop-to-buffer tag-buf) - (switch-to-buffer tag-buf)) - (widen) - (push-mark) - (goto-char tag-point) - (if find-tag-hook - (run-hooks 'find-tag-hook) - (if local-find-tag-hook - (run-hooks 'local-find-tag-hook)))) - (setq tags-loop-scan (list 'find-tag nil nil) - tags-loop-operate nil) - ;; Return t in case used as the tags-loop-scan. - t) - -;;;###autoload -(defun find-tag-other-window (tagname &optional next) - "*Find tag whose name contains TAGNAME. - Selects the buffer that the tag is contained in in another window -and puts point at its definition. - If TAGNAME is a null string, the expression in the buffer -around or before point is used as the tag name. - If second arg NEXT is non-nil (interactively, with prefix arg), -searches for the next tag in the tag table -that matches the tagname used in the previous find-tag. - -This version of this function supports multiple active tags tables, -and completion. - -Variables of note: - - tag-table-alist controls which tables apply to which buffers - tags-file-name a default tags table - tags-build-completion-table controls completion behavior - buffer-tag-table another way of specifying a buffer-local table - make-tags-files-invisible whether tags tables should be very hidden - tag-mark-stack-max how many tags-based hops to remember" - (interactive (if current-prefix-arg - '(nil t) - (list (find-tag-tag "Find tag other window: ")))) - (if next - (find-tag nil t) - (find-tag tagname t))) - - -;; Completion on tags in the buffer. - -(defun complete-symbol (&optional table predicate prettify) - (let* ((end (point)) - (beg (save-excursion - (backward-sexp 1) - ;;(while (= (char-syntax (following-char)) ?\') - ;; (forward-char 1)) - (skip-syntax-forward "'") - (point))) - (pattern (buffer-substring beg end)) - (table (or table obarray)) - (completion (try-completion pattern table predicate))) - (cond ((eq completion t)) - ((null completion) - (error "Can't find completion for \"%s\"" pattern)) - ((not (string-equal pattern completion)) - (delete-region beg end) - (insert completion)) - (t - (message "Making completion list...") - (let ((list (all-completions pattern table predicate))) - (if prettify - (setq list (funcall prettify list))) - (with-output-to-temp-buffer "*Help*" - (display-completion-list list))) - (message "Making completion list...%s" "done"))))) - -;;;###autoload -(defun tag-complete-symbol () - "The function used to do tags-completion (using 'tag-completion-predicate)." - (interactive) - (let* ((buffer-tag-table-list (buffer-tag-table-symbol-list)) - tag-symbol-tables) - (complete-symbol tag-completion-table 'tag-completion-predicate))) - - -;; Applying a command to files mentioned in tag tables - -(defvar next-file-list nil - "List of files for next-file to process.") - -;;;###autoload -(defun next-file (&optional initialize novisit) - "Select next file among files in current tag table(s). - -A first argument of t (prefix arg, if interactive) initializes to the -beginning of the list of files in the (first) tags table. If the argument -is neither nil nor t, it is evalled to initialize the list of files. - -Non-nil second argument NOVISIT means use a temporary buffer -to save time and avoid uninteresting warnings. - -Value is nil if the file was already visited; -if the file was newly read in, the value is the filename." - (interactive "P") - (cond ((not initialize) - ;; Not the first run. - ) - ((eq initialize t) - ;; Initialize the list from the tags table. - (setq next-file-list (buffer-tag-table-files))) - (t - ;; Initialize the list by evalling the argument. - (setq next-file-list (eval initialize)))) - (when (null next-file-list) - (and novisit - (get-buffer " *next-file*") - (kill-buffer " *next-file*")) - (error "All files processed")) - (let* ((file (car next-file-list)) - (buf (get-file-buffer file)) - (new (not buf))) - (pop next-file-list) - - (if (not (and new novisit)) - (switch-to-buffer (find-file-noselect file novisit) t) - ;; Like find-file, but avoids random junk. - (set-buffer (get-buffer-create " *next-file*")) - (kill-all-local-variables) - (erase-buffer) - (insert-file-contents file nil)) - (widen) - (when (> (point) (point-min)) - (push-mark nil t) - (goto-char (point-min))) - (and new file))) - -;;;###autoload -(defun tags-loop-continue (&optional first-time) - "Continue last \\[tags-search] or \\[tags-query-replace] command. -Used noninteractively with non-nil argument to begin such a command (the -argument is passed to `next-file', which see). -Two variables control the processing we do on each file: -the value of `tags-loop-scan' is a form to be executed on each file -to see if it is interesting (it returns non-nil if so) -and `tags-loop-operate' is a form to execute to operate on an interesting file -If the latter returns non-nil, we exit; otherwise we scan the next file." - (interactive) - (let ((messaged nil) - (more-files-p t) - new) - (while more-files-p - ;; Scan files quickly for the first or next interesting one. - (while (or first-time - (save-restriction - (widen) - (not (eval tags-loop-scan)))) - (setq new (next-file first-time - tags-search-nuke-uninteresting-buffers)) - ;; If NEW is non-nil, we got a temp buffer, - ;; and NEW is the file name. - (if (or messaged - (and (not first-time) - (> (device-baud-rate) search-slow-speed) - (setq messaged t))) - (lmessage 'progress - "Scanning file %s..." (or new buffer-file-name))) - (setq first-time nil) - (goto-char (point-min))) - - ;; If we visited it in a temp buffer, visit it now for real. - (if (and new tags-search-nuke-uninteresting-buffers) - (let ((pos (point))) - (erase-buffer) - (set-buffer (find-file-noselect new)) - (widen) - (goto-char pos))) - - (switch-to-buffer (current-buffer)) - - ;; Now operate on the file. - ;; If value is non-nil, continue to scan the next file. - (setq more-files-p (eval tags-loop-operate))) - (and messaged - (null tags-loop-operate) - (message "Scanning file %s...found" buffer-file-name)))) - - -;;;###autoload -(defun tags-search (regexp &optional file-list-form) - "Search through all files listed in tags table for match for REGEXP. -Stops when a match is found. -To continue searching for next match, use command \\[tags-loop-continue]. - -See documentation of variable `tag-table-alist'." - (interactive "sTags search (regexp): ") - (if (and (equal regexp "") - (eq (car tags-loop-scan) 'with-search-caps-disable-folding) - (null tags-loop-operate)) - ;; Continue last tags-search as if by `M-,'. - (tags-loop-continue nil) - (setq tags-loop-scan `(with-search-caps-disable-folding ,regexp t - (re-search-forward ,regexp nil t)) - tags-loop-operate nil) - (tags-loop-continue (or file-list-form t)))) - -;;;###autoload -(defun tags-query-replace (from to &optional delimited file-list-form) - "Query-replace-regexp FROM with TO through all files listed in tags table. -Third arg DELIMITED (prefix arg) means replace only word-delimited matches. -If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace -with the command \\[tags-loop-continue]. - -See documentation of variable `tag-table-alist'." - (interactive - "sTags query replace (regexp): \nsTags query replace %s by: \nP") - (setq tags-loop-scan `(with-search-caps-disable-folding ,from t - (if (re-search-forward ,from nil t) - ;; When we find a match, move back - ;; to the beginning of it so perform-replace - ;; will see it. - (progn (goto-char (match-beginning 0)) t))) - tags-loop-operate (list 'perform-replace from to t t - (not (null delimited)))) - (tags-loop-continue (or file-list-form t))) - -;; Miscellaneous - -;;;###autoload -(defun list-tags (file) - "Display list of tags in FILE." - (interactive (list (read-file-name - (if (buffer-file-name) - (format "List tags (in file, %s by default): " - (file-name-nondirectory (buffer-file-name))) - "List tags (in file): ") - nil (buffer-file-name) t))) - (find-file-noselect file) - (with-output-to-temp-buffer "*Tags List*" - (princ "Tags in file ") - (princ file) - (terpri) - (save-excursion - (dolist (tags-file (with-current-buffer (get-file-buffer file) - (buffer-tag-table-list))) - ;; We don't want completions getting in the way. - (let ((tags-build-completion-table nil)) - (set-buffer (get-tag-table-buffer tags-file))) - (goto-char (point-min)) - (when - (search-forward (concat "\f\n" (file-name-nondirectory file) ",") - nil t) - (forward-line 1) - (while (not (or (eobp) (looking-at "\f"))) - (princ (buffer-substring (point) - (progn (skip-chars-forward "^\C-?") - (point)))) - (terpri) - (forward-line 1))))))) - -;;;###autoload -(defun tags-apropos (string) - "Display list of all tags in tag table REGEXP matches." - (interactive "sTag apropos (regexp): ") - (with-output-to-temp-buffer "*Tags List*" - (princ "Tags matching regexp ") - (prin1 string) - (terpri) - (save-excursion - (visit-tags-table-buffer) - (goto-char 1) - (while (re-search-forward string nil t) - (beginning-of-line) - (princ (buffer-substring (point) - (progn (skip-chars-forward "^\C-?") - (point)))) - (terpri) - (forward-line 1))))) - -;; #### copied from tags.el. This function is *very* big in FSF. -(defun visit-tags-table-buffer () - "Select the buffer containing the current tag table." - (or tags-file-name - (call-interactively 'visit-tags-table)) - (set-buffer (or (get-file-buffer tags-file-name) - (progn - (setq tag-table-files nil) - (find-file-noselect tags-file-name)))) - (or (verify-visited-file-modtime (get-file-buffer tags-file-name)) - (cond ((yes-or-no-p "Tags file has changed, read new contents? ") - (revert-buffer t t) - (setq tag-table-files nil)))) - (or (eq (char-after 1) ?\^L) - (error "File %s not a valid tag table" tags-file-name))) - - -;; Sample uses of find-tag-hook and find-tag-default-hook - -;; This is wrong. We should either make this behavior default and -;; back it up, or not use it at all. For now, I've commented it out. -;; --hniksic - -;; Example buffer-local tag finding - -;(add-hook 'emacs-lisp-mode-hook 'setup-emacs-lisp-default-tag-hook) - -;(defun setup-emacs-lisp-default-tag-hook () -; (cond ((eq major-mode 'emacs-lisp-mode) -; (make-variable-buffer-local 'find-tag-default-hook) -; (setq find-tag-default-hook 'emacs-lisp-default-tag)))) -;;; Run it once immediately -;(setup-emacs-lisp-default-tag-hook) -;(when (get-buffer "*scratch*") -; (with-current-buffer "*scratch*" -; (setup-emacs-lisp-default-tag-hook))) - -;(defun emacs-lisp-default-tag () -; "Function to return a default tag for Emacs-Lisp mode." -; (let ((tag (or (variable-at-point) -; (function-at-point)))) -; (if tag (symbol-name tag)))) - - -;; Display short info on tag in minibuffer - -;; Don't pollute `M-?' -- we may need it for more important stuff. --hniksic -;(if (null (lookup-key esc-map "?")) -; (define-key esc-map "?" 'display-tag-info)) - -(defun display-tag-info (tagname) - "Prints a description of the first tag matching TAGNAME in the echo area. -If this is an elisp function, prints something like \"(defun foo (x y z)\". -That is, is prints the first line of the definition of the form. -If this is a C-defined elisp function, it does something more clever." - (interactive (if current-prefix-arg - '(nil) - (list (find-tag-tag "Display tag info: ")))) - (let* ((results (find-tag-internal tagname)) - (tag-buf (car results)) - (tag-point (cdr results)) - info lname min max fname args) - (with-current-buffer tag-buf - (save-excursion - (save-restriction - (widen) - (goto-char tag-point) - (cond ((let ((case-fold-search nil)) - (looking-at "^DEFUN[ \t]")) - (forward-sexp 1) - (down-list 1) - (setq lname (read (current-buffer)) - fname (buffer-substring - (progn (forward-sexp 1) (point)) - (progn (backward-sexp 1) (point))) - min (buffer-substring - (progn (forward-sexp 3) (point)) - (progn (backward-sexp 1) (point))) - max (buffer-substring - (progn (forward-sexp 2) (point)) - (progn (backward-sexp 1) (point)))) - (backward-up-list 1) - (setq args (buffer-substring - (progn (forward-sexp 2) (point)) - (progn (backward-sexp 1) (point)))) - (setq info (format "Elisp: %s, C: %s %s, #args: %s" - lname - fname args - (if (string-equal min max) - min - (format "from %s to %s" min max))))) - (t - (setq info - (buffer-substring - (progn (beginning-of-line) (point)) - (progn (end-of-line) (point))))))))) - (message "%s" info)) - (setq tags-loop-scan '(display-tag-info nil) - tags-loop-operate nil) - ;; Always return non-nil - t) - - -;; Tag mark stack. - -(defvar tag-mark-stack1 nil) -(defvar tag-mark-stack2 nil) - -(defcustom tag-mark-stack-max 16 - "*The maximum number of elements kept on the mark-stack used -by tags-search. See also the commands `\\[push-tag-mark]' and -and `\\[pop-tag-mark]'." - :type 'integer - :group 'etags) - -(defun push-mark-on-stack (stack-symbol &optional max-size) - (let ((stack (symbol-value stack-symbol))) - (push (point-marker) stack) - (cond ((and max-size - (> (length stack) max-size)) - (set-marker (car (nthcdr max-size stack)) nil) - (setcdr (nthcdr (1- max-size) stack) nil))) - (set stack-symbol stack))) - -(defun pop-mark-from-stack (stack-symbol1 stack-symbol2 &optional max-size) - (let* ((stack (or (symbol-value stack-symbol1) - (error "No more tag marks on stack"))) - (marker (car stack)) - (m-buf (marker-buffer marker))) - (set stack-symbol1 (cdr stack)) - (or m-buf - (error "Marker has no buffer")) - (or (buffer-live-p m-buf) - (error "Buffer has been killed")) - (push-mark-on-stack stack-symbol2 max-size) - (switch-to-buffer m-buf) - (widen) - (goto-char marker))) - -(defun push-tag-mark () - (push-mark-on-stack 'tag-mark-stack1 tag-mark-stack-max)) - -;;;###autoload (define-key esc-map "*" 'pop-tag-mark) - -;;;###autoload -(defun pop-tag-mark (arg) - "Go to last tag position. -`find-tag' maintains a mark-stack seperate from the \\[set-mark-command] mark-stack. -This function pops (and moves to) the tag at the top of this stack." - (interactive "P") - (if (not arg) - (pop-mark-from-stack - 'tag-mark-stack1 'tag-mark-stack2 tag-mark-stack-max) - (pop-mark-from-stack - 'tag-mark-stack2 'tag-mark-stack1 tag-mark-stack-max))) - - -(provide 'etags) -(provide 'tags) - -;;; etags.el ends here diff --git a/lisp/extents.el b/lisp/extents.el deleted file mode 100644 index 37f0752..0000000 --- a/lisp/extents.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; extents.el --- miscellaneous extent functions not written in C - -;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc. - -;; Keywords: internal, dumped - -;; 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: - -;; some help from stig@hackvan.com here. - -;;; Code: - -;; an alternative to map-extents. -(defun mapcar-extents (function &optional predicate buffer-or-string from to - flags property value) - "Apply FUNCTION to all extents which overlap a region in BUFFER-OR-STRING. -The region is delimited by FROM and TO. FUNCTION is called with -one argument, the extent. A list of the values returned by FUNCTION -is returned. An optional PREDICATE may be used to further limit the -extents over which FUNCTION is mapped. The optional arguments FLAGS, -PROPERTY, and VALUE may also be used to control the extents passed to -PREDICATE or FUNCTION. See also `map-extents'." - (let (*result*) - (map-extents (if predicate - #'(lambda (ex junk) - (and (funcall predicate ex) - (setq *result* (cons (funcall function ex) - *result*))) - nil) - #'(lambda (ex junk) - (setq *result* (cons (funcall function ex) - *result*)) - nil)) - buffer-or-string from to nil flags property value) - (nreverse *result*))) - -(defun extent-list (&optional buffer-or-string from to flags) - "Return a list of the extents in BUFFER-OR-STRING. -BUFFER-OR-STRING defaults to the current buffer if omitted. -FROM and TO can be used to limit the range over which extents are -returned; if omitted, all extents in the buffer or string are returned. - -More specifically, if a range is specified using FROM and TO, only -extents that overlap the range (i.e. begin or end inside of the range) -are included in the list. FROM and TO default to the beginning and -end of BUFFER-OR-STRING, respectively. - -FLAGS controls how end cases are treated. For a discussion of this, -and exactly what ``overlap'' means, see `map-extents'. - -If you want to map a function over the extents in a buffer or string, -consider using `map-extents' or `mapcar-extents' instead." - (mapcar-extents 'identity nil buffer-or-string from to flags)) - -(defun extent-string (extent) - "Return the string delimited by the bounds of EXTENT." - (let ((object (extent-object extent))) - (if (bufferp object) - (buffer-substring (extent-start-position extent) - (extent-end-position extent) - object) - (substring object - (extent-start-position extent) - (extent-end-position extent))))) - -(defun extent-descendants (extent) - "Return a list of all descendants of EXTENT, including EXTENT. -This recursively applies `extent-children' to any children of -EXTENT, until no more children can be found." - (let ((children (extent-children extent))) - (if children - (apply 'nconc (mapcar 'extent-descendants children)) - (list extent)))) - -(defun set-extent-keymap (extent keymap) - "Set EXTENT's `keymap' property to KEYMAP." - (set-extent-property extent 'keymap keymap)) - -(defun extent-keymap (extent) - "Return EXTENT's `keymap' property." - (extent-property extent 'keymap)) - -;;; extents.el ends here diff --git a/lisp/faces.el b/lisp/faces.el deleted file mode 100644 index a0c193e..0000000 --- a/lisp/faces.el +++ /dev/null @@ -1,1735 +0,0 @@ -;;; faces.el --- Lisp interface to the C "face" structure - -;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois -;; Copyright (C) 1995, 1996 Ben Wing - -;; Author: Ben Wing -;; Keywords: faces, internal, dumped - -;; 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. Almost completely divergent. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; face implementation #1 (used Lisp vectors and parallel C vectors; -;; FSFmacs still uses this) authored by Jamie Zawinski -;; pre Lucid-Emacs 19.0. - -;; face implementation #2 (used one face object per frame per face) -;; authored by Jamie Zawinski for 19.9. - -;; face implementation #3 (use one face object per face) originally -;; authored for 19.12 by Chuck Thompson , -;; rewritten by Ben Wing with the advent of specifiers. - - -;;; Some stuff in FSF's faces.el is in our x-faces.el. - -;;; Code: - -(defgroup faces nil - "Support for multiple text attributes (fonts, colors, ...) -Such a collection of attributes is called a \"face\"." - :group 'emacs) - - -(defun read-face-name (prompt) - (let (face) - (while (= (length face) 0) ; nil or "" - (setq face (completing-read prompt - (mapcar (lambda (x) (list (symbol-name x))) - (face-list)) - nil t))) - (intern face))) - -(defun face-interactive (what &optional bool) - (let* ((fn (intern (concat "face-" what "-instance"))) - (face (read-face-name (format "Set %s of face: " what))) - (default (if (fboundp fn) - ;; #### we should distinguish here between - ;; explicitly setting the value to be the - ;; same as the default face's value, and - ;; not setting a value at all. - (funcall fn face))) - (value (if bool - (y-or-n-p (format "Should face %s be %s? " - (symbol-name face) bool)) - (read-string (format "Set %s of face %s to: " - what (symbol-name face)) - (cond ((font-instance-p default) - (font-instance-name default)) - ((color-instance-p default) - (color-instance-name default)) - ((image-instance-p default) - (image-instance-file-name default)) - (t default)))))) - (list face (if (equal value "") nil value)))) - -(defconst built-in-face-specifiers - (built-in-face-specifiers) - "A list of the built-in face properties that are specifiers.") - -(defun face-property (face property &optional locale tag-set exact-p) - "Return FACE's value of the given PROPERTY. - -If LOCALE is omitted, the FACE's actual value for PROPERTY will be - returned. For built-in properties, this will be a specifier object - of a type appropriate to the property (e.g. a font or color - specifier). For other properties, this could be anything. - -If LOCALE is supplied, then instead of returning the actual value, - the specification(s) for the given locale or locale type will - be returned. This will only work if the actual value of - PROPERTY is a specifier (this will always be the case for built-in - properties, but not or not may apply to user-defined properties). - If the actual value of PROPERTY is not a specifier, this value - will simply be returned regardless of LOCALE. - -The return value will be a list of instantiators (e.g. strings - specifying a font or color name), or a list of specifications, each - of which is a cons of a locale and a list of instantiators. - Specifically, if LOCALE is a particular locale (a buffer, window, - frame, device, or 'global), a list of instantiators for that locale - will be returned. Otherwise, if LOCALE is a locale type (one of - the symbols 'buffer, 'window, 'frame, or 'device), the specifications - for all locales of that type will be returned. Finally, if LOCALE is - 'all, the specifications for all locales of all types will be returned. - -The specifications in a specifier determine what the value of - PROPERTY will be in a particular \"domain\" or set of circumstances, - which is typically a particular Emacs window along with the buffer - it contains and the frame and device it lies within. The value - is derived from the instantiator associated with the most specific - locale (in the order buffer, window, frame, device, and 'global) - that matches the domain in question. In other words, given a domain - (i.e. an Emacs window, usually), the specifier for PROPERTY will first - be searched for a specification whose locale is the buffer contained - within that window; then for a specification whose locale is the window - itself; then for a specification whose locale is the frame that the - window is contained within; etc. The first instantiator that is - valid for the domain (usually this means that the instantiator is - recognized by the device [i.e. the X server or TTY device] that the - domain is on. The function `face-property-instance' actually does - all this, and is used to determine how to display the face. - -See `set-face-property' for the built-in property-names." - - (setq face (get-face face)) - (let ((value (get face property))) - (if (and locale - (or (memq property built-in-face-specifiers) - (specifierp value))) - (setq value (specifier-specs value locale tag-set exact-p))) - value)) - -(defun convert-face-property-into-specifier (face property) - "Convert PROPERTY on FACE into a specifier, if it's not already." - (setq face (get-face face)) - (let ((specifier (get face property))) - ;; if a user-property does not have a specifier but a - ;; locale was specified, put a specifier there. - ;; If there was already a value there, convert it to a - ;; specifier with the value as its 'global instantiator. - (unless (specifierp specifier) - (let ((new-specifier (make-specifier 'generic))) - (if (or (not (null specifier)) - ;; make sure the nil returned from `get' wasn't - ;; actually the value of the property - (null (get face property t))) - (add-spec-to-specifier new-specifier specifier)) - (setq specifier new-specifier) - (put face property specifier))))) - -(defun face-property-instance (face property - &optional domain default no-fallback) - "Return the instance of FACE's PROPERTY in the specified DOMAIN. - -Under most circumstances, DOMAIN will be a particular window, - and the returned instance describes how the specified property - actually is displayed for that window and the particular buffer - in it. Note that this may not be the same as how the property - appears when the buffer is displayed in a different window or - frame, or how the property appears in the same window if you - switch to another buffer in that window; and in those cases, - the returned instance would be different. - -The returned instance will typically be a color-instance, - font-instance, or pixmap-instance object, and you can query - it using the appropriate object-specific functions. For example, - you could use `color-instance-rgb-components' to find out the - RGB (red, green, and blue) components of how the 'background - property of the 'highlight face is displayed in a particular - window. The results might be different from the results - you would get for another window (perhaps the user - specified a different color for the frame that window is on; - or perhaps the same color was specified but the window is - on a different X server, and that X server has different RGB - values for the color from this one). - -DOMAIN defaults to the selected window if omitted. - -DOMAIN can be a frame or device, instead of a window. The value - returned for a such a domain is used in special circumstances - when a more specific domain does not apply; for example, a frame - value might be used for coloring a toolbar, which is conceptually - attached to a frame rather than a particular window. The value - is also useful in determining what the value would be for a - particular window within the frame or device, if it is not - overridden by a more specific specification. - -If PROPERTY does not name a built-in property, its value will - simply be returned unless it is a specifier object, in which case - it will be instanced using `specifier-instance'. - -Optional arguments DEFAULT and NO-FALLBACK are the same as in - `specifier-instance'." - - (setq face (get-face face)) - (let ((value (get face property))) - (if (specifierp value) - (setq value (specifier-instance value domain default no-fallback))) - value)) - -(defun face-property-matching-instance (face property matchspec - &optional domain default - no-fallback) - "Return the instance of FACE's PROPERTY matching MATCHSPEC in DOMAIN. -Currently the only useful value for MATCHSPEC is a charset, when used -in conjunction with the face's font; this allows you to retrieve a -font that can be used to display a particular charset, rather than just -any font. - -Other than MATCHSPEC, this function is identical to `face-property-instance'. -See also `specifier-matching-instance' for a fuller description of the -matching process." - - (setq face (get-face face)) - (let ((value (get face property))) - (if (specifierp value) - (setq value (specifier-matching-instance value matchspec domain - default no-fallback))) - value)) - -(defun set-face-property (face property value &optional locale tag-set - how-to-add) - "Change a property of FACE. - -NOTE: If you want to remove a property from a face, use `remove-face-property' - rather than attempting to set a value of nil for the property. - -For built-in properties, the actual value of the property is a - specifier and you cannot change this; but you can change the - specifications within the specifier, and that is what this function - will do. For user-defined properties, you can use this function - to either change the actual value of the property or, if this value - is a specifier, change the specifications within it. - -If PROPERTY is a built-in property, the specifications to be added to - this property can be supplied in many different ways: - - -- If VALUE is a simple instantiator (e.g. a string naming a font or - color) or a list of instantiators, then the instantiator(s) will - be added as a specification of the property for the given LOCALE - (which defaults to 'global if omitted). - -- If VALUE is a list of specifications (each of which is a cons of - a locale and a list of instantiators), then LOCALE must be nil - (it does not make sense to explicitly specify a locale in this - case), and specifications will be added as given. - -- If VALUE is a specifier (as would be returned by `face-property' - if no LOCALE argument is given), then some or all of the - specifications in the specifier will be added to the property. - In this case, the function is really equivalent to - `copy-specifier' and LOCALE has the same semantics (if it is - a particular locale, the specification for the locale will be - copied; if a locale type, specifications for all locales of - that type will be copied; if nil or 'all, then all - specifications will be copied). - -HOW-TO-ADD should be either nil or one of the symbols 'prepend, - 'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale, - 'remove-locale-type, or 'remove-all. See `copy-specifier' and - `add-spec-to-specifier' for a description of what each of - these means. Most of the time, you do not need to worry about - this argument; the default behavior usually is fine. - -In general, it is OK to pass an instance object (e.g. as returned - by `face-property-instance') as an instantiator in place of - an actual instantiator. In such a case, the instantiator used - to create that instance object will be used (for example, if - you set a font-instance object as the value of the 'font - property, then the font name used to create that object will - be used instead). If some cases, however, doing this - conversion does not make sense, and this will be noted in - the documentation for particular types of instance objects. - -If PROPERTY is not a built-in property, then this function will - simply set its value if LOCALE is nil. However, if LOCALE is - given, then this function will attempt to add VALUE as the - instantiator for the given LOCALE, using `add-spec-to-specifier'. - If the value of the property is not a specifier, it will - automatically be converted into a 'generic specifier. - - -The following symbols have predefined meanings: - - foreground The foreground color of the face. - For valid instantiators, see `color-specifier-p'. - - background The background color of the face. - For valid instantiators, see `color-specifier-p'. - - font The font used to display text covered by this face. - For valid instantiators, see `font-specifier-p'. - - display-table The display table of the face. - This should be a vector of 256 elements. - - background-pixmap The pixmap displayed in the background of the face. - Only used by faces on X devices. - For valid instantiators, see `image-specifier-p'. - - underline Underline all text covered by this face. - For valid instantiators, see `face-boolean-specifier-p'. - - strikethru Draw a line through all text covered by this face. - For valid instantiators, see `face-boolean-specifier-p'. - - highlight Highlight all text covered by this face. - Only used by faces on TTY devices. - For valid instantiators, see `face-boolean-specifier-p'. - - dim Dim all text covered by this face. - For valid instantiators, see `face-boolean-specifier-p'. - - blinking Blink all text covered by this face. - Only used by faces on TTY devices. - For valid instantiators, see `face-boolean-specifier-p'. - - reverse Reverse the foreground and background colors. - Only used by faces on TTY devices. - For valid instantiators, see `face-boolean-specifier-p'. - - doc-string Description of what the face's normal use is. - NOTE: This is not a specifier, unlike all - the other built-in properties, and cannot - contain locale-specific values." - - (setq face (get-face face)) - (if (memq property built-in-face-specifiers) - (set-specifier (get face property) value locale tag-set how-to-add) - - ;; This section adds user defined properties. - (if (not locale) - (put face property value) - (convert-face-property-into-specifier face property) - (add-spec-to-specifier (get face property) value locale tag-set - how-to-add))) - value) - -(defun remove-face-property (face property &optional locale tag-set exact-p) - "Remove a property from FACE. -For built-in properties, this is analogous to `remove-specifier'. -See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P -arguments." - (or locale (setq locale 'all)) - (if (memq property built-in-face-specifiers) - (remove-specifier (face-property face property) locale tag-set exact-p) - (if (eq locale 'all) - (remprop (get-face face) property) - (convert-face-property-into-specifier face property) - (remove-specifier (face-property face property) locale tag-set - exact-p)))) - -(defun reset-face (face &optional locale tag-set exact-p) - "Clear all existing built-in specifications from FACE. -This makes FACE inherit all its display properties from 'default. -WARNING: Be absolutely sure you want to do this!!! It is a dangerous -operation and is not undoable. - -The arguments LOCALE, TAG-SET and EXACT-P are the same as for -`remove-specifier'." - (mapc (lambda (x) - (remove-specifier (face-property face x) locale tag-set exact-p)) - built-in-face-specifiers) - nil) - -(defun set-face-parent (face parent &optional locale tag-set how-to-add) - "Set the parent of FACE to PARENT, for all properties. -This makes all properties of FACE inherit from PARENT." - (setq parent (get-face parent)) - (mapcar (lambda (x) - (set-face-property face x (vector parent) locale tag-set - how-to-add)) - (delq 'display-table - (delq 'background-pixmap - (copy-sequence built-in-face-specifiers)))) - (set-face-background-pixmap face (vector 'inherit ':face parent) - locale tag-set how-to-add) - nil) - -(defun face-doc-string (face) - "Return the documentation string for FACE." - (face-property face 'doc-string)) - -(defun set-face-doc-string (face doc-string) - "Change the documentation string of FACE to DOC-STRING." - (interactive (face-interactive "doc-string")) - (set-face-property face 'doc-string doc-string)) - -(defun face-font-name (face &optional domain charset) - "Return the font name of FACE in DOMAIN, or nil if it is unspecified. -DOMAIN is as in `face-font-instance'." - (let ((f (face-font-instance face domain charset))) - (and f (font-instance-name f)))) - -(defun face-font (face &optional locale tag-set exact-p) - "Return the font of FACE in LOCALE, or nil if it is unspecified. - -FACE may be either a face object or a symbol representing a face. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `face-property' for more information." - (face-property face 'font locale tag-set exact-p)) - -(defun face-font-instance (face &optional domain charset) - "Return the instance of FACE's font in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the font appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (if charset - (face-property-matching-instance face 'font charset domain) - (face-property-instance face 'font domain))) - -(defun set-face-font (face font &optional locale tag-set how-to-add) - "Change the font of FACE to FONT in LOCALE. - -FACE may be either a face object or a symbol representing a face. - -FONT should be an instantiator (see `font-specifier-p'), a list of - instantiators, an alist of specifications (each mapping a - locale to an instantiator list), or a font specifier object. - -If FONT is an alist, LOCALE must be omitted. If FONT is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-face-property' for more information." - (interactive (face-interactive "font")) - (set-face-property face 'font font locale tag-set how-to-add)) - -(defun face-foreground (face &optional locale tag-set exact-p) - "Return the foreground of FACE in LOCALE, or nil if it is unspecified. - -FACE may be either a face object or a symbol representing a face. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `face-property' for more information." - (face-property face 'foreground locale tag-set exact-p)) - -(defun face-foreground-instance (face &optional domain default no-fallback) - "Return the instance of FACE's foreground in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the foreground appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (face-property-instance face 'foreground domain default no-fallback)) - -(defun face-foreground-name (face &optional domain default no-fallback) - "Return the name of FACE's foreground color in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the background appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (color-instance-name (face-foreground-instance - face domain default no-fallback))) - -(defun set-face-foreground (face color &optional locale tag-set how-to-add) - "Change the foreground color of FACE to COLOR in LOCALE. - -FACE may be either a face object or a symbol representing a face. - -COLOR should be an instantiator (see `color-specifier-p'), a list of - instantiators, an alist of specifications (each mapping a locale to - an instantiator list), or a color specifier object. - -If COLOR is an alist, LOCALE must be omitted. If COLOR is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-face-property' for more information." - (interactive (face-interactive "foreground")) - (set-face-property face 'foreground color locale tag-set how-to-add)) - -(defun face-background (face &optional locale tag-set exact-p) - "Return the background color of FACE in LOCALE, or nil if it is unspecified. - -FACE may be either a face object or a symbol representing a face. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `face-property' for more information." - (face-property face 'background locale tag-set exact-p)) - -(defun face-background-instance (face &optional domain default no-fallback) - "Return the instance of FACE's background in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the background appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (face-property-instance face 'background domain default no-fallback)) - -(defun face-background-name (face &optional domain default no-fallback) - "Return the name of FACE's background color in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the background appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (color-instance-name (face-background-instance - face domain default no-fallback))) - -(defun set-face-background (face color &optional locale tag-set how-to-add) - "Change the background color of FACE to COLOR in LOCALE. - -FACE may be either a face object or a symbol representing a face. - -COLOR should be an instantiator (see `color-specifier-p'), a list of - instantiators, an alist of specifications (each mapping a locale to - an instantiator list), or a color specifier object. - -If COLOR is an alist, LOCALE must be omitted. If COLOR is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-face-property' for more information." - (interactive (face-interactive "background")) - (set-face-property face 'background color locale tag-set how-to-add)) - -(defun face-background-pixmap (face &optional locale tag-set exact-p) - "Return the background pixmap of FACE in LOCALE, or nil if it is unspecified. -This property is only used on window system devices. - -FACE may be either a face object or a symbol representing a face. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `face-property' for more information." - (face-property face 'background-pixmap locale tag-set exact-p)) - -(defun face-background-pixmap-instance (face &optional domain default - no-fallback) - "Return the instance of FACE's background pixmap in DOMAIN. - -FACE may be either a face object or a symbol representing a face. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the background appears in that - particular window and buffer will be returned. - -See `face-property-instance' for more information." - (face-property-instance face 'background-pixmap domain default no-fallback)) - -(defun set-face-background-pixmap (face pixmap &optional locale tag-set - how-to-add) - "Change the background pixmap of FACE to PIXMAP in LOCALE. -This property is only used on window system devices. - -FACE may be either a face object or a symbol representing a face. - -PIXMAP should be an instantiator (see `image-specifier-p'), a list - of instantiators, an alist of specifications (each mapping a locale - to an instantiator list), or an image specifier object. - -If PIXMAP is an alist, LOCALE must be omitted. If PIXMAP is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-face-property' for more information." - (interactive (face-interactive "background-pixmap")) - (set-face-property face 'background-pixmap pixmap locale tag-set how-to-add)) - -(defun face-display-table (face &optional locale tag-set exact-p) - "Return the display table of FACE in LOCALE. - -A vector (as returned by `make-display-table') will be returned. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `face-property' for more information." - (face-property face 'display-table locale tag-set exact-p)) - -(defun face-display-table-instance (face &optional domain default no-fallback) - "Return the instance of FACE's display table in DOMAIN. -A vector (as returned by `make-display-table') will be returned. - -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'display-table domain default no-fallback)) - -(defun set-face-display-table (face display-table &optional locale tag-set - how-to-add) - "Change the display table of FACE to DISPLAY-TABLE in LOCALE. -DISPLAY-TABLE should be a vector as returned by `make-display-table'. - -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "display-table")) - (set-face-property face 'display-table display-table locale tag-set - how-to-add)) - -;; The following accessors and mutators are, IMHO, good -;; implementation. Cf. with `make-face-bold'. - -(defun face-underline-p (face &optional domain default no-fallback) - "Return t if FACE is underlined in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'underline domain default no-fallback)) - -(defun set-face-underline-p (face underline-p &optional locale tag-set - how-to-add) - "Change the underline property of FACE to UNDERLINE-P. -UNDERLINE-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "underline-p" "underlined")) - (set-face-property face 'underline underline-p locale tag-set how-to-add)) - -(defun face-strikethru-p (face &optional domain default no-fallback) - "Return t if FACE is strikethru-d (i.e. struck through) in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'strikethru domain default no-fallback)) - -(defun set-face-strikethru-p (face strikethru-p &optional locale tag-set - how-to-add) - "Change whether FACE is strikethru-d (i.e. struck through) in LOCALE. -STRIKETHRU-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "strikethru-p" "strikethru-d")) - (set-face-property face 'strikethru strikethru-p locale tag-set how-to-add)) - -(defun face-highlight-p (face &optional domain default no-fallback) - "Return t if FACE is highlighted in DOMAIN (TTY domains only). -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'highlight domain default no-fallback)) - -(defun set-face-highlight-p (face highlight-p &optional locale tag-set - how-to-add) - "Change whether FACE is highlighted in LOCALE (TTY locales only). -HIGHLIGHT-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "highlight-p" "highlighted")) - (set-face-property face 'highlight highlight-p locale tag-set how-to-add)) - -(defun face-dim-p (face &optional domain default no-fallback) - "Return t if FACE is dimmed in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'dim domain default no-fallback)) - -(defun set-face-dim-p (face dim-p &optional locale tag-set how-to-add) - "Change whether FACE is dimmed in LOCALE. -DIM-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "dim-p" "dimmed")) - (set-face-property face 'dim dim-p locale tag-set how-to-add)) - -(defun face-blinking-p (face &optional domain default no-fallback) - "Return t if FACE is blinking in DOMAIN (TTY domains only). -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'blinking domain default no-fallback)) - -(defun set-face-blinking-p (face blinking-p &optional locale tag-set - how-to-add) - "Change whether FACE is blinking in LOCALE (TTY locales only). -BLINKING-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "blinking-p" "blinking")) - (set-face-property face 'blinking blinking-p locale tag-set how-to-add)) - -(defun face-reverse-p (face &optional domain default no-fallback) - "Return t if FACE is reversed in DOMAIN (TTY domains only). -See `face-property-instance' for the semantics of the DOMAIN argument." - (face-property-instance face 'reverse domain default no-fallback)) - -(defun set-face-reverse-p (face reverse-p &optional locale tag-set how-to-add) - "Change whether FACE is reversed in LOCALE (TTY locales only). -REVERSE-P is normally a face-boolean instantiator; see - `face-boolean-specifier-p'. -See `set-face-property' for the semantics of the LOCALE, TAG-SET, and - HOW-TO-ADD arguments." - (interactive (face-interactive "reverse-p" "reversed")) - (set-face-property face 'reverse reverse-p locale tag-set how-to-add)) - - -(defun face-property-equal (face1 face2 prop domain) - (equal (face-property-instance face1 prop domain) - (face-property-instance face2 prop domain))) - -(defun face-equal-loop (props face1 face2 domain) - (while (and props - (face-property-equal face1 face2 (car props) domain)) - (setq props (cdr props))) - (null props)) - -(defun face-equal (face1 face2 &optional domain) - "Return t if FACE1 and FACE2 will display in the same way in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (if (null domain) (setq domain (selected-window))) - (if (not (valid-specifier-domain-p domain)) - (error "Invalid specifier domain")) - (let ((device (dfw-device domain)) - (common-props '(foreground background font display-table underline - dim)) - (win-props '(background-pixmap strikethru)) - (tty-props '(highlight blinking reverse))) - - ;; First check the properties which are used in common between the - ;; x and tty devices. Then, check those properties specific to - ;; the particular device type. - (and (face-equal-loop common-props face1 face2 domain) - (cond ((eq 'tty (device-type device)) - (face-equal-loop tty-props face1 face2 domain)) - ((or (eq 'x (device-type device)) - (eq 'mswindows (device-type device))) - (face-equal-loop win-props face1 face2 domain)) - (t t))))) - -(defun face-differs-from-default-p (face &optional domain) - "Return t if FACE will display differently from the default face in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (not (face-equal face 'default domain))) - -; moved from x-faces.el -(defun try-font-name (name &optional device) - ;; yes, name really should be here twice. - (and name (make-font-instance name device t) name)) - - -;; This function is a terrible, disgusting hack!!!! Need to -;; separate out the font elements as separate face properties! - -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -;; WE DEMAND LEXICAL SCOPING!!! -(defun frob-face-property (face property func &optional locale) - "Change the specifier for FACE's PROPERTY according to FUNC, in LOCALE. -This function is ugly and messy and is primarily used as an internal -helper function for `make-face-bold' et al., so you probably don't -want to use it or read the rest of the documentation. But if you do ... - -FUNC should be a function of two arguments (an instance and a device) -that returns a modified name that is valid for the given device. -If LOCALE specifies a valid domain (i.e. a window, frame, or device), -this function instantiates the specifier over that domain, applies FUNC -to the resulting instance, and adds the result back as an instantiator -for that locale. Otherwise, LOCALE should be a locale, locale type, or -'all (defaults to 'all if omitted). For each specification thusly -included: if the locale given is a valid domain, FUNC will be -iterated over all valid instantiators for the device of the domain -until a non-nil result is found (if there is no such result, the -first valid instantiator is used), and that result substituted for -the specification; otherwise, the process just outlined is -iterated over each existing device and the concatenated results -substituted for the specification." - (let ((sp (face-property face property))) - (if (valid-specifier-domain-p locale) - ;; this is easy. - (let* ((inst (face-property-instance face property locale)) - (name (and inst (funcall func inst (dfw-device locale))))) - (when name - (add-spec-to-specifier sp name locale))) - ;; otherwise, map over all specifications ... - ;; but first, some further kludging: - ;; (1) if we're frobbing the global property, make sure - ;; that something is there (copy from the default face, - ;; if necessary). Otherwise, something like - ;; (make-face-larger 'modeline) - ;; won't do anything at all if the modeline simply - ;; inherits its font from 'default. - ;; (2) if we're frobbing a particular locale, nothing would - ;; happen if that locale has no instantiators. So signal - ;; an error to indicate this. - (if (and (or (eq locale 'global) (eq locale 'all) (not locale)) - (not (face-property face property 'global))) - (copy-specifier (face-property 'default property) - (face-property face property) - 'global)) - (if (and (valid-specifier-locale-p locale) - (not (face-property face property locale))) - (error "Property must have a specification in locale %S" locale)) - (map-specifier - sp - (lambda (sp locale inst-list func) - (let* ((device (dfw-device locale)) - ;; if a device can be derived from the locale, - ;; call frob-face-property-1 for that device. - ;; Otherwise map frob-face-property-1 over each device. - (result - (if device - (list (frob-face-property-1 sp device inst-list func)) - (mapcar (lambda (device) - (frob-face-property-1 sp device - inst-list func)) - (device-list)))) - new-result) - ;; remove duplicates and nils from the obtained list of - ;; instantiators. - (mapcar (lambda (arg) - (when (and arg (not (member arg new-result))) - (setq new-result (cons arg new-result)))) - result) - ;; add back in. - (add-spec-list-to-specifier sp (list (cons locale new-result))) - ;; tell map-specifier to keep going. - nil)) - locale - func)))) - -(defun frob-face-property-1 (sp device inst-list func) - (let - (first-valid result) - (while (and inst-list (not result)) - (let* ((inst-pair (car inst-list)) - (tag-set (car inst-pair)) - (sp-inst (specifier-instance-from-inst-list - sp device (list inst-pair)))) - (if sp-inst - (progn - (if (not first-valid) - (setq first-valid inst-pair)) - (setq result (funcall func sp-inst device)) - (if result - (setq result (cons tag-set result)))))) - (setq inst-list (cdr inst-list))) - (or result first-valid))) - -(defun frob-face-font-2 (face locale unfrobbed-face frobbed-face - tty-thunk x-thunk standard-face-mapping) - ;; another kludge to make things more intuitive. If we're - ;; inheriting from a standard face in this locale, frob the - ;; inheritance as appropriate. Else, if, after the first X frobbing - ;; pass, the face hasn't changed and still looks like the standard - ;; unfrobbed face (e.g. 'default), make it inherit from the standard - ;; frobbed face (e.g. 'bold). Regardless of things, do the TTY - ;; frobbing. - - ;; yuck -- The LOCALE argument to make-face-bold is not actually a locale, - ;; but is a "locale, locale-type, or nil for all". So ... do our extra - ;; frobbing only if it's actually a locale; or for nil, do the frobbing - ;; on 'global. This specifier stuff needs some rethinking. - (let* ((the-locale (cond ((null locale) 'global) - ((valid-specifier-locale-p locale) locale) - (t nil))) - (specs (and the-locale (face-font face the-locale nil t))) - (change-it (and specs (cdr (assoc specs standard-face-mapping))))) - (if (and change-it - (not (memq (face-name (find-face face)) - '(default bold italic bold-italic)))) - (progn - (or (equal change-it t) - (set-face-property face 'font change-it the-locale)) - (funcall tty-thunk)) - (let* ((domain (cond ((null the-locale) nil) - ((valid-specifier-domain-p the-locale) the-locale) - ;; OK, this next one is truly a kludge, but - ;; it results in more intuitive behavior most - ;; of the time. (really!) - ((or (eq the-locale 'global) (eq the-locale 'all)) - (selected-device)) - (t nil))) - (inst (and domain (face-property-instance face 'font domain)))) - (funcall tty-thunk) - (funcall x-thunk) - ;; If it's reasonable to do the inherit-from-standard-face trick, - ;; and it's called for, then do it now. - (or (null domain) - (not (equal inst (face-property-instance face 'font domain))) - ;; don't do it for standard faces, or you'll get inheritance loops. - ;; #### This makes XEmacs seg fault! fix this bug. - (memq (face-name (find-face face)) - '(default bold italic bold-italic)) - (not (equal (face-property-instance face 'font domain) - (face-property-instance unfrobbed-face 'font domain))) - (set-face-property face 'font (vector frobbed-face) - the-locale)))))) - -(defun make-face-bold (face &optional locale) - "Make FACE bold in LOCALE, if possible. -This will attempt to make the font bold for X locales and will set the -highlight flag for TTY locales. - -If LOCALE is nil, omitted, or `all', this will attempt to frob all -font specifications for FACE to make them appear bold. Similarly, if -LOCALE is a locale type, this frobs all font specifications for locales -of that type. If LOCALE is a particular locale, what happens depends on -what sort of locale is given. If you gave a device, frame, or window, -then it's always possible to determine what the font actually will be, -so this is determined and the resulting font is frobbed and added back as a -specification for this locale. If LOCALE is a buffer, however, you can't -determine what the font will actually be unless there's actually a -specification given for that particular buffer (otherwise, it depends -on what window and frame the buffer appears in, and might not even be -well-defined if the buffer appears multiple times in different places); -therefore you will get an error unless there's a specification for the -buffer. - -Finally, in some cases (specifically, when LOCALE is not a locale type), -if the frobbing didn't actually make the font look any different -\(this happens, for example, if your font specification is already bold -or has no bold equivalent), and currently looks like the font of the -'default face, it is set to inherit from the 'bold face. This is kludgy -but it makes `make-face-bold' have more intuitive behavior in many -circumstances." - (interactive (list (read-face-name "Make which face bold: "))) - (frob-face-font-2 - face locale 'default 'bold - (lambda () - ;; handle TTY specific entries - (when (featurep 'tty) - (set-face-highlight-p face t locale 'tty))) - (lambda () - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold locale)) - ) - '(([default] . [bold]) - ([bold] . t) - ([italic] . [bold-italic]) - ([bold-italic] . t)))) - -(defun make-face-italic (face &optional locale) - "Make FACE italic in LOCALE, if possible. -This will attempt to make the font italic for X locales and will set -the underline flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." - (interactive (list (read-face-name "Make which face italic: "))) - (frob-face-font-2 - face locale 'default 'italic - (lambda () - ;; handle TTY specific entries - (when (featurep 'tty) - (set-face-underline-p face t locale 'tty))) - (lambda () - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-italic locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-italic locale)) - ) - '(([default] . [italic]) - ([bold] . [bold-italic]) - ([italic] . t) - ([bold-italic] . t)))) - -(defun make-face-bold-italic (face &optional locale) - "Make FACE bold and italic in LOCALE, if possible. -This will attempt to make the font bold-italic for X locales and will -set the highlight and underline flags for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." - (interactive (list (read-face-name "Make which face bold-italic: "))) - (frob-face-font-2 - face locale 'default 'bold-italic - (lambda () - ;; handle TTY specific entries - (when (featurep 'tty) - (set-face-highlight-p face t locale 'tty) - (set-face-underline-p face t locale 'tty))) - (lambda () - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-bold-italic locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-bold-italic locale)) - ) - '(([default] . [italic]) - ([bold] . [bold-italic]) - ([italic] . [bold-italic]) - ([bold-italic] . t)))) - -(defun make-face-unbold (face &optional locale) - "Make FACE non-bold in LOCALE, if possible. -This will attempt to make the font non-bold for X locales and will -unset the highlight flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." - (interactive (list (read-face-name "Make which face non-bold: "))) - (frob-face-font-2 - face locale 'bold 'default - (lambda () - ;; handle TTY specific entries - (when (featurep 'tty) - (set-face-highlight-p face nil locale 'tty))) - (lambda () - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unbold locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unbold locale)) - ) - '(([default] . t) - ([bold] . [default]) - ([italic] . t) - ([bold-italic] . [italic])))) - -(defun make-face-unitalic (face &optional locale) - "Make FACE non-italic in LOCALE, if possible. -This will attempt to make the font non-italic for X locales and will -unset the underline flag for TTY locales. -See `make-face-bold' for the semantics of the LOCALE argument and -for more specifics on exactly how this function works." - (interactive (list (read-face-name "Make which face non-italic: "))) - (frob-face-font-2 - face locale 'italic 'default - (lambda () - ;; handle TTY specific entries - (when (featurep 'tty) - (set-face-underline-p face nil locale 'tty))) - (lambda () - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-make-font-unitalic locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-make-font-unitalic locale)) - ) - '(([default] . t) - ([bold] . t) - ([italic] . [default]) - ([bold-italic] . [bold])))) - - -;; Why do the following two functions lose so badly in so many -;; circumstances? - -(defun make-face-smaller (face &optional locale) - "Make the font of FACE be smaller, if possible. -LOCALE works as in `make-face-bold' et al., but the ``inheriting- -from-the-bold-face'' operations described there are not done -because they don't make sense in this context." - (interactive (list (read-face-name "Shrink which face: "))) - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-find-smaller-font locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-find-smaller-font locale))) - -(defun make-face-larger (face &optional locale) - "Make the font of FACE be larger, if possible. -See `make-face-smaller' for the semantics of the LOCALE argument." - (interactive (list (read-face-name "Enlarge which face: "))) - ;; handle X specific entries - (when (featurep 'x) - (frob-face-property face 'font 'x-find-larger-font locale)) - (when (featurep 'mswindows) - (frob-face-property face 'font 'mswindows-find-larger-font locale))) - -(defun invert-face (face &optional locale) - "Swap the foreground and background colors of the face." - (interactive (list (read-face-name "Invert face: "))) - (if (valid-specifier-domain-p locale) - (let ((foreface (face-foreground-instance face locale))) - (set-face-foreground face (face-background-instance face locale) - locale) - (set-face-background face foreface locale)) - (let ((forespec (copy-specifier (face-foreground face) nil locale))) - (copy-specifier (face-background face) (face-foreground face) locale) - (copy-specifier forespec (face-background face) locale)))) - - -;;; Convenience functions - -(defun face-ascent (face &optional domain charset) - "Return the ascent of FACE in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (font-ascent (face-font face) domain charset)) - -(defun face-descent (face &optional domain charset) - "Return the descent of FACE in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (font-descent (face-font face) domain charset)) - -(defun face-width (face &optional domain charset) - "Return the width of FACE in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (font-width (face-font face) domain charset)) - -(defun face-height (face &optional domain charset) - "Return the height of FACE in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (+ (face-ascent face domain charset) (face-descent face domain charset))) - -(defun face-proportional-p (face &optional domain charset) - "Return t if FACE is proportional in DOMAIN. -See `face-property-instance' for the semantics of the DOMAIN argument." - (font-proportional-p (face-font face) domain charset)) - - -;; Functions that used to be in cus-face.el, but logically go here. - -(defcustom frame-background-mode nil - "*The brightness of the background. -Set this to the symbol dark if your background color is dark, light if -your background is light, or nil (default) if you want Emacs to -examine the brightness for you." - :group 'faces - :type '(choice (choice-item dark) - (choice-item light) - (choice-item :tag "Auto" nil))) - -;; The old variable that many people still have in .emacs files. -(define-obsolete-variable-alias 'custom-background-mode - 'frame-background-mode) - -(defun get-frame-background-mode (frame) - "Detect background mode for FRAME." - (let* ((color-instance (face-background-instance 'default frame)) - (mode (condition-case nil - (if (< (apply '+ (color-instance-rgb-components - color-instance)) 65536) - 'dark 'light) - ;; Here, we get an error on a TTY. As we don't have - ;; a good way of detecting whether a TTY is light or - ;; dark, we'll guess it's dark. - (error 'dark)))) - (set-frame-property frame 'background-mode mode) - mode)) - -(defun extract-custom-frame-properties (frame) - "Return a plist with the frame properties of FRAME used by custom." - (list 'type (or (frame-property frame 'display-type) - (device-type (frame-device frame))) - 'class (device-class (frame-device frame)) - 'background (or frame-background-mode - (frame-property frame 'background-mode) - (get-frame-background-mode frame)))) - -(defcustom init-face-from-resources t - "If non nil, attempt to initialize faces from the resource database." - :group 'faces - :type 'boolean) - -;; Old name, used by custom. Also, FSFmacs name. -(defvaralias 'initialize-face-resources 'init-face-from-resources) - -(defun face-spec-set (face spec &optional frame) - "Set FACE's face attributes according to the first matching entry in SPEC. -If optional FRAME is non-nil, set it for that frame only. -If it is nil, then apply SPEC to each frame individually. -See `defface' for information about SPEC." - (if frame - (progn - (reset-face face frame) - (face-display-set face spec frame) - (init-face-from-resources face frame)) - (let ((frames (relevant-custom-frames))) - (reset-face face) - (if (and (eq 'default face) (featurep 'x)) - (x-init-global-faces)) - (face-display-set face spec) - (while frames - (face-display-set face spec (car frames)) - (pop frames)) - (init-face-from-resources face)))) - -(defun face-display-set (face spec &optional frame) - "Set FACE to the attributes to the first matching entry in SPEC. -Iff optional FRAME is non-nil, set it for that frame only. -See `defface' for information about SPEC." - (while spec - (let ((display (caar spec)) - (atts (cadar spec))) - (pop spec) - (when (face-spec-set-match-display display frame) - ;; Avoid creating frame local duplicates of the global face. - (unless (and frame (eq display (get face 'custom-face-display))) - (apply 'face-custom-attributes-set face frame atts)) - (unless frame - (put face 'custom-face-display display)) - (setq spec nil))))) - -(defvar default-custom-frame-properties nil - "The frame properties used for the global faces. -Frames not matching these propertiess should have frame local faces. -The value should be nil, if uninitialized, or a plist otherwise. -See `defface' for a list of valid keys and values for the plist.") - -(defun get-custom-frame-properties (&optional frame) - "Return a plist with the frame properties of FRAME used by custom. -If FRAME is nil, return the default frame properties." - (cond (frame - ;; Try to get from cache. - (let ((cache (frame-property frame 'custom-properties))) - (unless cache - ;; Oh well, get it then. - (setq cache (extract-custom-frame-properties frame)) - ;; and cache it... - (set-frame-property frame 'custom-properties cache)) - cache)) - (default-custom-frame-properties) - (t - (setq default-custom-frame-properties - (extract-custom-frame-properties (selected-frame)))))) - -(defun face-spec-update-all-matching (spec display plist) - "Update all entries in the face spec that could match display to -have the entries from the new plist and return the new spec" - (mapcar - (lambda (e) - (let ((entries (car e)) - (options (cadr e)) - (match t) - dplist - (new-options plist) - ) - (unless (eq display t) - (mapc (lambda (arg) - (setq dplist (plist-put dplist (car arg) (cadr arg)))) - display)) - (unless (eq entries t) - (mapc (lambda (arg) - (setq match (and match (eq (cadr arg) - (plist-get - dplist (car arg) - (cadr arg)))))) - entries)) - (if (not match) - e - (while new-options - (setq options - (plist-put options (car new-options) (cadr new-options))) - (setq new-options (cddr new-options))) - (list entries options)))) - (copy-sequence spec))) - - - -(defun face-spec-set-match-display (display &optional frame) - "Return non-nil if DISPLAY matches FRAME. -DISPLAY is part of a spec such as can be used in `defface'. -If FRAME is nil or omitted, the selected frame is used." - (if (eq display t) - t - (let* ((props (get-custom-frame-properties frame)) - (type (plist-get props 'type)) - (class (plist-get props 'class)) - (background (plist-get props 'background)) - (match t) - (entries display) - entry req options) - (while (and entries match) - (setq entry (car entries) - entries (cdr entries) - req (car entry) - options (cdr entry) - match (case req - (type (memq type options)) - (class (memq class options)) - (background (memq background options)) - (t (warn "Unknown req `%S' with options `%S'" - req options) - nil)))) - match))) - -(defun relevant-custom-frames () - "List of frames whose custom properties differ from the default." - (let ((relevant nil) - (default (get-custom-frame-properties)) - (frames (frame-list)) - frame) - (while frames - (setq frame (car frames) - frames (cdr frames)) - (unless (equal default (get-custom-frame-properties frame)) - (push frame relevant))) - relevant)) - -(defun initialize-custom-faces (&optional frame) - "Initialize all custom faces for FRAME. -If FRAME is nil or omitted, initialize them for all frames." - (mapc (lambda (symbol) - (let ((spec (or (get symbol 'saved-face) - (get symbol 'face-defface-spec)))) - (when spec - ;; No need to init-face-from-resources -- code in - ;; `init-frame-faces' does it already. - (face-display-set symbol spec frame)))) - (face-list))) - -(defun custom-initialize-frame (frame) - "Initialize frame-local custom faces for FRAME if necessary." - (unless (equal (get-custom-frame-properties) - (get-custom-frame-properties frame)) - (initialize-custom-faces frame))) - - -(defun make-empty-face (name &optional doc-string temporary) - "Like `make-face', but doesn't query the resource database." - (let ((init-face-from-resources nil)) - (make-face name doc-string temporary))) - -(defun init-face-from-resources (face &optional locale) - "Initialize FACE from the resource database. -If LOCALE is specified, it should be a frame, device, or 'global, and -the face will be resourced over that locale. Otherwise, the face will -be resourced over all possible locales (i.e. all frames, all devices, -and 'global)." - (cond ((null init-face-from-resources) - ;; Do nothing. - ) - ((not locale) - ;; Global, set for all frames. - (progn - (init-face-from-resources face 'global) - (let ((devices (device-list))) - (while devices - (init-face-from-resources face (car devices)) - (setq devices (cdr devices)))) - (let ((frames (frame-list))) - (while frames - (init-face-from-resources face (car frames)) - (setq frames (cdr frames)))))) - (t - ;; Specific. - (let ((devtype (cond ((devicep locale) (device-type locale)) - ((framep locale) (frame-type locale)) - (t nil)))) - (cond ((or (and (not devtype) (featurep 'x)) (eq 'x devtype)) - (x-init-face-from-resources face locale)) - ((or (not devtype) (eq 'tty devtype)) - ;; Nothing to do for TTYs? - )))))) - -(defun init-device-faces (device) - ;; First, add any device-local face resources. - (when init-face-from-resources - (loop for face in (face-list) do - (init-face-from-resources face device)) - ;; Then do any device-specific initialization. - (cond ((eq 'x (device-type device)) - (x-init-device-faces device)) - ((eq 'mswindows (device-type device)) - (mswindows-init-device-faces device)) - ;; Nothing to do for TTYs? - ) - (init-other-random-faces device))) - -(defun init-frame-faces (frame) - (when init-face-from-resources - ;; First, add any frame-local face resources. - (loop for face in (face-list) do - (init-face-from-resources face frame)) - ;; Then do any frame-specific initialization. - (cond ((eq 'x (frame-type frame)) - (x-init-frame-faces frame)) - ((eq 'mswindows (frame-type frame)) - (mswindows-init-frame-faces frame)) - ;; Is there anything which should be done for TTY's? - ))) - -;; #### This is somewhat X-specific, and is called when the first -;; X device is created (even if there were TTY devices created -;; beforehand). The concept of resources has not been generalized -;; outside of X-specificness, so we have to live with this -;; breach of device-independence. - -(defun init-global-faces () - ;; Look for global face resources. - (loop for face in (face-list) do - (init-face-from-resources face 'global)) - ;; Further X frobbing. - (x-init-global-faces) - ;; for bold and the like, make the global specification be bold etc. - ;; if the user didn't already specify a value. These will also be - ;; frobbed further in init-other-random-faces. - (unless (face-font 'bold 'global) - (make-face-bold 'bold 'global)) - ;; - (unless (face-font 'italic 'global) - (make-face-italic 'italic 'global)) - ;; - (unless (face-font 'bold-italic 'global) - (make-face-bold-italic 'bold-italic 'global) - (unless (face-font 'bold-italic 'global) - (copy-face 'bold 'bold-italic) - (make-face-italic 'bold-italic))) - - (when (face-equal 'bold 'bold-italic) - (copy-face 'italic 'bold-italic) - (make-face-bold 'bold-italic)) - ;; - ;; Nothing more to be done for X or TTY's? - ) - - -;; These warnings are there for a reason. Just specify your fonts -;; correctly. Deal with it. Additionally, one can use -;; `log-warning-minimum-level' instead of this. -;(defvar inhibit-font-complaints nil -; "Whether to suppress complaints about incomplete sets of fonts.") - -(defun face-complain-about-font (face device) - (if (symbolp face) (setq face (symbol-name face))) -;; (if (not inhibit-font-complaints) - (display-warning - 'font - (let ((default-name (face-font-name 'default device))) - (format "%s: couldn't deduce %s %s version of the font -%S. - -Please specify X resources to make the %s face -visually distinguishable from the default face. -For example, you could add one of the following to $HOME/Emacs: - -Emacs.%s.attributeFont: -dt-*-medium-i-* -or -Emacs.%s.attributeForeground: hotpink\n" - invocation-name - (if (string-match "\\`[aeiouAEIOU]" face) "an" "a") - face - default-name - face - face - face - )))) - - -;; #### This is quite a mess. We should use the custom mechanism for -;; most of this stuff. Currently we don't do it, because Custom -;; doesn't use specifiers (yet.) FSF does it the Right Way. - -;; For instance, the definition of `bold' should be something like -;; (defface bold ((t (:bold t))) "Bold text.") -- and `:bold t' should -;; make sure that everything works properly. - -(defun init-other-random-faces (device) - "Initialize the colors and fonts of the bold, italic, bold-italic, -zmacs-region, list-mode-item-selected, highlight, primary-selection, -secondary-selection, and isearch faces when each device is created. If -you want to add code to do stuff like this, use the create-device-hook." - - ;; try to make 'bold look different from the default on this device. - ;; If that doesn't work at all, then issue a warning. - (unless (face-differs-from-default-p 'bold device) - (make-face-bold 'bold device) - (unless (face-differs-from-default-p 'bold device) - (make-face-unbold 'bold device) - (unless (face-differs-from-default-p 'bold device) - ;; the luser specified one of the bogus font names - (face-complain-about-font 'bold device)))) - - ;; Similar for italic. - ;; It's unreasonable to expect to be able to make a font italic all - ;; the time. For many languages, italic is an alien concept. - ;; Basically, because italic is not a globally meaningful concept, - ;; the use of the italic face should really be oboleted. - - ;; I disagree with above. In many languages, the concept of capital - ;; letters is just as alien, and yet we use them. Italic is here to - ;; stay. -hniksic - - ;; In a Solaris Japanese environment, there just aren't any italic - ;; fonts - period. CDE recognizes this reality, and fonts - ;; -dt-interface user-medium-r-normal-*-*-*-*-*-*-*-*-* don't come - ;; in italic versions. So we first try to make the font bold before - ;; complaining. - (unless (face-differs-from-default-p 'italic device) - (make-face-italic 'italic device) - (unless (face-differs-from-default-p 'italic device) - (make-face-bold 'italic device) - (unless (face-differs-from-default-p 'italic device) - (face-complain-about-font 'italic device)))) - - ;; similar for bold-italic. - (unless (face-differs-from-default-p 'bold-italic device) - (make-face-bold-italic 'bold-italic device) - ;; if we couldn't get a bold-italic version, try just bold. - (unless (face-differs-from-default-p 'bold-italic device) - (make-face-bold 'bold-italic device) - ;; if we couldn't get bold or bold-italic, then that's probably because - ;; the default font is bold, so make the `bold-italic' face be unbold. - (unless (face-differs-from-default-p 'bold-italic device) - (make-face-unbold 'bold-italic device) - (make-face-italic 'bold-italic device) - (unless (face-differs-from-default-p 'bold-italic device) - ;; if that didn't work, try plain italic - ;; (can this ever happen? what the hell.) - (make-face-italic 'bold-italic device) - (unless (face-differs-from-default-p 'bold-italic device) - ;; then bitch and moan. - (face-complain-about-font 'bold-italic device)))))) - - ;; Set the text-cursor colors unless already specified. - (when (and (not (eq 'tty (device-type device))) - (not (face-background 'text-cursor 'global)) - (face-property-equal 'text-cursor 'default 'background device)) - (set-face-background 'text-cursor [default foreground] 'global - nil 'append)) - (when (and (not (eq 'tty (device-type device))) - (not (face-foreground 'text-cursor 'global)) - (face-property-equal 'text-cursor 'default 'foreground device)) - (set-face-foreground 'text-cursor [default background] 'global - nil 'append)) - ) - -;; New function with 20.1, suggested by Per Abrahamsen, coded by Kyle Jones. -(defun set-face-stipple (face pixmap &optional frame) - "Change the stipple pixmap of FACE to PIXMAP. -This is an Emacs compatibility function; consider using -set-face-background-pixmap instead. - -PIXMAP should be a string, the name of a file of pixmap data. -The directories listed in the `x-bitmap-file-path' variable are searched. - -Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT -DATA) where WIDTH and HEIGHT are the size in pixels, and DATA is -a string, containing the raw bits of the bitmap. XBM data is -expected in this case, other types of image data will not work. - -If the optional FRAME argument is provided, change only -in that frame; otherwise change each frame." - (while (not (find-face face)) - (setq face (signal 'wrong-type-argument (list 'facep face)))) - (locate-file pixmap x-bitmap-file-path ".xbm:" 4) - (while (cond ((stringp pixmap) - (unless (file-readable-p pixmap) - (setq pixmap `[xbm :file ,pixmap])) - nil) - ((and (consp pixmap) (= (length pixmap) 3)) - (setq pixmap `[xbm :data ,pixmap]) - nil) - (t t)) - (setq pixmap (signal 'wrong-type-argument - (list 'stipple-pixmap-p pixmap)))) - (while (and frame (not (framep frame))) - (setq frame (signal 'wrong-type-argument (list 'framep frame)))) - (set-face-background-pixmap face pixmap frame)) - - -;; Create the remaining standard faces now. This way, packages that we dump -;; can reference these faces as parents. -;; -;; The default, modeline, left-margin, right-margin, text-cursor, -;; and pointer faces are created in C. - -(make-face 'bold "Bold text.") -(make-face 'italic "Italic text.") -(make-face 'bold-italic "Bold-italic text.") -(make-face 'underline "Underlined text.") -(or (face-differs-from-default-p 'underline) - (set-face-underline-p 'underline t 'global '(default))) -(make-face 'zmacs-region "Used on highlightes region between point and mark.") -(make-face 'isearch "Used on region matched by isearch.") -(make-face 'list-mode-item-selected - "Face for the selected list item in list-mode.") -(make-face 'highlight "Highlight face.") -(make-face 'primary-selection "Primary selection face.") -(make-face 'secondary-selection "Secondary selection face.") - -;; Several useful color faces. -(eval-when-compile (load "cl-macs")) -(dolist (color '(red green blue yellow)) - (make-face color (concat (symbol-name color) " text.")) - (set-face-foreground color (symbol-name color) nil 'color)) - -;; Make some useful faces. This happens very early, before creating -;; the first non-stream device. - -(set-face-background 'text-cursor - '(((x default) . "Red3") - ((mswindows default) . "Red3")) - 'global) - -;; some older X servers don't recognize "darkseagreen2" -(set-face-background 'highlight - '(((x default color) . "darkseagreen2") - ((x default color) . "green") - ((x default grayscale) . "gray53") - ((mswindows default color) . "darkseagreen2") - ((mswindows default color) . "green") - ((mswindows default grayscale) . "gray53")) - 'global) -(set-face-background-pixmap 'highlight - '(((x default mono) . "gray1") - ((mswindows default mono) . "gray1")) - 'global) - -(set-face-background 'zmacs-region - '(((x default color) . "gray65") - ((x default grayscale) . "gray65") - ((mswindows default color) . "gray65") - ((mswindows default grayscale) . "gray65")) - 'global) -(set-face-background-pixmap 'zmacs-region - '(((x default mono) . "gray3") - ((mswindows default mono) . "gray3")) - 'global) - -(set-face-background 'list-mode-item-selected - '(((x default color) . "gray68") - ((x default grayscale) . "gray68") - ((x default mono) . [default foreground]) - ((mswindows default color) . "gray68") - ((mswindows default grayscale) . "gray68") - ((mswindows default mono) . [default foreground])) - 'global) -(set-face-foreground 'list-mode-item-selected - '(((x default mono) . [default background]) - ((mswindows default mono) . [default background])) - 'global) - -(set-face-background 'primary-selection - '(((x default color) . "gray65") - ((x default grayscale) . "gray65") - ((mswindows default color) . "gray65") - ((mswindows default grayscale) . "gray65")) - 'global) -(set-face-background-pixmap 'primary-selection - '(((x default mono) . "gray3") - ((mswindows default mono) . "gray3")) - 'global) - -(set-face-background 'secondary-selection - '(((x default color) . "paleturquoise") - ((x default color) . "green") - ((x default grayscale) . "gray53") - ((mswindows default color) . "paleturquoise") - ((mswindows default color) . "green") - ((mswindows default grayscale) . "gray53")) - 'global) -(set-face-background-pixmap 'secondary-selection - '(((x default mono) . "gray1") - ((mswindows default mono) . "gray1")) - 'global) - -(set-face-background 'isearch - '(((x default color) . "paleturquoise") - ((x default color) . "green") - ((mswindows default color) . "paleturquoise") - ((mswindows default color) . "green")) - 'global) - -;; Define some logical color names to be used when reading the pixmap files. -(if (featurep 'xpm) - (setq xpm-color-symbols - (list - (purecopy '("foreground" (face-foreground 'default))) - (purecopy '("background" (face-background 'default))) - (purecopy '("backgroundToolBarColor" - (or - (and - (featurep 'x) - (x-get-resource "backgroundToolBarColor" - "BackgroundToolBarColor" 'string)) - - (face-background 'toolbar)))) - (purecopy '("foregroundToolBarColor" - (or - (and - (featurep 'x) - (x-get-resource "foregroundToolBarColor" - "ForegroundToolBarColor" 'string)) - (face-foreground 'toolbar)))) - ))) - -(when (featurep 'tty) - (set-face-highlight-p 'bold t 'global '(default tty)) - (set-face-underline-p 'italic t 'global '(default tty)) - (set-face-highlight-p 'bold-italic t 'global '(default tty)) - (set-face-underline-p 'bold-italic t 'global '(default tty)) - (set-face-highlight-p 'highlight t 'global '(default tty)) - (set-face-reverse-p 'text-cursor t 'global '(default tty)) - (set-face-reverse-p 'modeline t 'global '(default tty)) - (set-face-reverse-p 'zmacs-region t 'global '(default tty)) - (set-face-reverse-p 'primary-selection t 'global '(default tty)) - (set-face-underline-p 'secondary-selection t 'global '(default tty)) - (set-face-reverse-p 'list-mode-item-selected t 'global '(default tty)) - (set-face-reverse-p 'isearch t 'global '(default tty)) - ) - -;;; faces.el ends here diff --git a/lisp/files-nomule.el b/lisp/files-nomule.el deleted file mode 100644 index cab09cc..0000000 --- a/lisp/files-nomule.el +++ /dev/null @@ -1,96 +0,0 @@ -;;; files-nomule.el --- file I/O stubs when not under Mule. - -;; Copyright (C) 1985-1987, 1992-1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 19.34 (files.el). (Is it? Please check) - -;;; Commentary: - -;; This file is dumped with XEmacs (when Mule is not compiled in). - -;; These stubs were moved from the bottom of files.el. - -;;; Code: - -(defun insert-file-contents (filename &optional visit beg end replace) - "Insert contents of file FILENAME after point. -Returns list of absolute file name and length of data inserted. -If second argument VISIT is non-nil, the buffer's visited filename -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." - (insert-file-contents-internal filename visit beg end replace nil nil)) - -(defun write-region (start end filename &optional append visit lockname coding-system) - "Write current region into specified file. -By default, the file's existing contents are replaced by the specified region. -When called from a program, takes three arguments: -START, END and FILENAME. START and END are buffer positions. -Optional fourth argument APPEND if non-nil means - append to existing file contents (if any). -Optional fifth argument VISIT if t means - set the last-save-file-modtime of buffer to this file's modtime - and mark buffer not modified. -If VISIT is a string, it is a second file name; - the output goes to FILENAME, but the buffer is marked as visiting VISIT. - VISIT is also the file name to lock and unlock for clash detection. -If VISIT is neither t nor nil nor a string, - that means do not print the \"Wrote file\" message. -The optional sixth arg LOCKNAME, if non-nil, specifies the name to - use for locking and unlocking, overriding FILENAME and VISIT. -Kludgy feature: if START is a string, then that string is written -to the file, instead of any buffer contents, and END is ignored. -Optional seventh argument CODING-SYSTEM is meaningful only if support - for Mule is present in XEmacs and specifies the coding system - used to encode the text when it is written out, and defaults to - the value of `buffer-file-coding-system' in the current buffer. - When Mule support is not present, the CODING-SYSTEM argument is - ignored." - (interactive "r\nFWrite region to file: ") - (write-region-internal start end filename append visit lockname nil)) - -(defun load (file &optional noerror nomessage nosuffix) - "Execute a file of Lisp code named FILE. -First try FILE with `.elc' appended, then try with `.el', - then try FILE unmodified. -This function searches the directories in `load-path'. -If optional second arg NOERROR is non-nil, - report no error if FILE doesn't exist. -Print messages at start and end of loading unless - optional third arg NOMESSAGE is non-nil (ignored in -batch mode). -If optional fourth arg NOSUFFIX is non-nil, don't try adding - suffixes `.elc' or `.el' to the specified name FILE. -Return t if file exists." - (load-internal file noerror nomessage nosuffix nil nil)) - -;;; files-nomule.el ends here diff --git a/lisp/files.el b/lisp/files.el deleted file mode 100644 index fd4585a..0000000 --- a/lisp/files.el +++ /dev/null @@ -1,3253 +0,0 @@ -;;; files.el --- file input and output commands for XEmacs. - -;; Copyright (C) 1985-1987, 1992-1995, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 (but diverging) -;;; Warning: Merging this file is tough. Beware. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Defines most of XEmacs's file- and directory-handling functions, -;; including basic file visiting, backup generation, link handling, -;; ITS-id version control, load- and write-hook handling, and the like. - -;;; Code: - -;; XEmacs: Avoid compilation warnings. -(defvar coding-system-for-read) -(defvar buffer-file-coding-system) - -(defgroup files nil - "Support editing files." - :group 'emacs) - -(defgroup backup nil - "Backups of edited data files." - :group 'files) - -(defgroup find-file nil - "Finding and editing files." - :group 'files) - - -;; XEmacs: In buffer.c -;(defconst delete-auto-save-files t -; "*Non-nil means delete auto-save file when a buffer is saved or killed.") - -;; FSF has automount-dir-prefix. Our directory-abbrev-alist is more general. -;; note: tmp_mnt bogosity conversion is established in paths.el. -(defcustom directory-abbrev-alist nil - "*Alist of abbreviations for file directories. -A list of elements of the form (FROM . TO), each meaning to replace -FROM with TO when it appears in a directory name. -This replacement is done when setting up the default directory of a -newly visited file. *Every* FROM string should start with \\\\` or ^. - -Use this feature when you have directories which you normally refer to -via absolute symbolic links or to eliminate automounter mount points -from the beginning of your filenames. Make TO the name of the link, -and FROM the name it is linked to." - :type '(repeat (cons :format "%v" - :value ("\\`" . "") - (regexp :tag "From") - (regexp :tag "To"))) - :group 'find-file) - -(defcustom make-backup-files t - "*Non-nil means make a backup of a file the first time it is saved. -This can be done by renaming the file or by copying. - -Renaming means that XEmacs renames the existing file so that it is a -backup file, then writes the buffer into a new file. Any other names -that the old file had will now refer to the backup file. The new file -is owned by you and its group is defaulted. - -Copying means that XEmacs copies the existing file into the backup -file, then writes the buffer on top of the existing file. Any other -names that the old file had will now refer to the new (edited) file. -The file's owner and group are unchanged. - -The choice of renaming or copying is controlled by the variables -`backup-by-copying', `backup-by-copying-when-linked' and -`backup-by-copying-when-mismatch'. See also `backup-inhibited'." - :type 'boolean - :group 'backup) - -;; Do this so that local variables based on the file name -;; are not overridden by the major mode. -(defvar backup-inhibited nil - "Non-nil means don't make a backup, regardless of the other parameters. -This variable is intended for use by making it local to a buffer. -But it is local only if you make it local.") -(put 'backup-inhibited 'permanent-local t) - -(defcustom backup-by-copying nil - "*Non-nil means always use copying to create backup files. -See documentation of variable `make-backup-files'." - :type 'boolean - :group 'backup) - -(defcustom backup-by-copying-when-linked nil - "*Non-nil means use copying to create backups for files with multiple names. -This causes the alternate names to refer to the latest version as edited. -This variable is relevant only if `backup-by-copying' is nil." - :type 'boolean - :group 'backup) - -(defcustom backup-by-copying-when-mismatch nil - "*Non-nil means create backups by copying if this preserves owner or group. -Renaming may still be used (subject to control of other variables) -when it would not result in changing the owner or group of the file; -that is, for files which are owned by you and whose group matches -the default for a new file created there by you. -This variable is relevant only if `backup-by-copying' is nil." - :type 'boolean - :group 'backup) - -(defvar backup-enable-predicate - #'(lambda (name) - (not (or (null name) - (string-match "^/tmp/" name) - (let ((tmpdir (temp-directory))) - (and tmpdir - (string-match (concat "\\`" (regexp-quote tmpdir) "/") - tmpdir)))))) - "Predicate that looks at a file name and decides whether to make backups. -Called with an absolute file name as argument, it returns t to enable backup.") - -(defcustom buffer-offer-save nil - "*Non-nil in a buffer means offer to save the buffer on exit -even if the buffer is not visiting a file. -Automatically local in all buffers." - :type 'boolean - :group 'find-file) -(make-variable-buffer-local 'buffer-offer-save) - -;; FSF uses normal defconst -(defvaralias 'find-file-visit-truename 'find-file-use-truenames) -(defvaralias 'find-file-existing-other-name 'find-file-compare-truenames) - -(defcustom revert-without-query nil - "*Specify which files should be reverted without query. -The value is a list of regular expressions. -If the file name matches one of these regular expressions, -then `revert-buffer' reverts the file without querying -if the file has changed on disk and you have not edited the buffer." - :type '(repeat (regexp "")) - :group 'find-file) - -(defvar buffer-file-number nil - "The device number and file number of the file visited in the current buffer. -The value is a list of the form (FILENUM DEVNUM). -This pair of numbers uniquely identifies the file. -If the buffer is visiting a new file, the value is nil.") -(make-variable-buffer-local 'buffer-file-number) -(put 'buffer-file-number 'permanent-local t) - -(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) - "Non-nil means that buffer-file-number uniquely identifies files.") - -(defcustom file-precious-flag nil - "*Non-nil means protect against I/O errors while saving files. -Some modes set this non-nil in particular buffers. - -This feature works by writing the new contents into a temporary file -and then renaming the temporary file to replace the original. -In this way, any I/O error in writing leaves the original untouched, -and there is never any instant where the file is nonexistent. - -Note that this feature forces backups to be made by copying. -Yet, at the same time, saving a precious file -breaks any hard links between it and other files." - :type 'boolean - :group 'backup) - -(defcustom version-control nil - "*Control use of version numbers for backup files. -t means make numeric backup versions unconditionally. -nil means make them for files that have some already. -`never' means do not make them." - :type 'boolean - :group 'backup - :group 'vc) - -;; This is now defined in efs. -;(defvar dired-kept-versions 2 -; "*When cleaning directory, number of versions to keep.") - -(defcustom delete-old-versions nil - "*If t, delete excess backup versions silently. -If nil, ask confirmation. Any other value prevents any trimming." - :type '(choice (const :tag "Delete" t) - (const :tag "Ask" nil) - (sexp :tag "Leave" :format "%t\n" other)) - :group 'backup) - -(defcustom kept-old-versions 2 - "*Number of oldest versions to keep when a new numbered backup is made." - :type 'integer - :group 'backup) - -(defcustom kept-new-versions 2 - "*Number of newest versions to keep when a new numbered backup is made. -Includes the new backup. Must be > 0" - :type 'integer - :group 'backup) - -(defcustom require-final-newline nil - "*Value of t says silently ensure a file ends in a newline when it is saved. -Non-nil but not t says ask user whether to add a newline when there isn't one. -nil means don't add newlines." - :type '(choice (const :tag "Off" nil) - (const :tag "Add" t) - (sexp :tag "Ask" :format "%t\n" ask)) - :group 'editing-basics) - -(defcustom auto-save-default t - "*Non-nil says by default do auto-saving of every file-visiting buffer." - :type 'boolean - :group 'auto-save) - -(defcustom auto-save-visited-file-name nil - "*Non-nil says auto-save a buffer in the file it is visiting, when practical. -Normally auto-save files are written under other names." - :type 'boolean - :group 'auto-save) - -(defcustom save-abbrevs nil - "*Non-nil means save word abbrevs too when files are saved. -Loading an abbrev file sets this to t." - :type 'boolean - :group 'abbrev) - -(defcustom find-file-run-dired t - "*Non-nil says run dired if `find-file' is given the name of a directory." - :type 'boolean - :group 'find-file) - -;;;It is not useful to make this a local variable. -;;;(put 'find-file-not-found-hooks 'permanent-local t) -(defvar find-file-not-found-hooks nil - "List of functions to be called for `find-file' on nonexistent file. -These functions are called as soon as the error is detected. -`buffer-file-name' is already set up. -The functions are called in the order given until one of them returns non-nil.") - -;;;It is not useful to make this a local variable. -;;;(put 'find-file-hooks 'permanent-local t) -(defvar find-file-hooks nil - "List of functions to be called after a buffer is loaded from a file. -The buffer's local variables (if any) will have been processed before the -functions are called.") - -(defvar write-file-hooks nil - "List of functions to be called before writing out a buffer to a file. -If one of them returns non-nil, the file is considered already written -and the rest are not called. -These hooks are considered to pertain to the visited file. -So this list is cleared if you change the visited file name. -See also `write-contents-hooks' and `continue-save-buffer'.") -;;; However, in case someone does make it local... -(put 'write-file-hooks 'permanent-local t) - -(defvar local-write-file-hooks nil - "Just like `write-file-hooks', except intended for per-buffer use. -The functions in this list are called before the ones in -`write-file-hooks'. - -This variable is meant to be used for hooks that have to do with a -particular visited file. Therefore, it is a permanent local, so that -changing the major mode does not clear it. However, calling -`set-visited-file-name' does clear it.") -(make-variable-buffer-local 'local-write-file-hooks) -(put 'local-write-file-hooks 'permanent-local t) - - -;; #### think about this (added by Sun). -(put 'after-set-visited-file-name-hooks 'permanent-local t) -(defvar after-set-visited-file-name-hooks nil - "List of functions to be called after \\[set-visited-file-name] -or during \\[write-file]. -You can use this hook to restore local values of write-file-hooks, -after-save-hook, and revert-buffer-function, which pertain -to a specific file and therefore are normally killed by a rename. -Put hooks pertaining to the buffer contents on write-contents-hooks -and revert-buffer-insert-file-contents-function.") - -(defvar write-contents-hooks nil - "List of functions to be called before writing out a buffer to a file. -If one of them returns non-nil, the file is considered already written -and the rest are not called. -These hooks are considered to pertain to the buffer's contents, -not to the particular visited file; thus, `set-visited-file-name' does -not clear this variable, but changing the major mode does clear it. -See also `write-file-hooks' and `continue-save-buffer'.") - -;; XEmacs addition -;; Energize needed this to hook into save-buffer at a lower level; we need -;; to provide a new output method, but don't want to have to duplicate all -;; of the backup file and file modes logic.that does not occur if one uses -;; a write-file-hook which returns non-nil. -(put 'write-file-data-hooks 'permanent-local t) -(defvar write-file-data-hooks nil - "List of functions to be called to put the bytes on disk. -These functions receive the name of the file to write to as argument. -The default behavior is to call - (write-region (point-min) (point-max) filename nil t) -If one of them returns non-nil, the file is considered already written -and the rest are not called. -These hooks are considered to pertain to the visited file. -So this list is cleared if you change the visited file name. -See also `write-file-hooks'.") - -(defcustom enable-local-variables t - "*Control use of local-variables lists in files you visit. -The value can be t, nil or something else. -A value of t means local-variables lists are obeyed; -nil means they are ignored; anything else means query. - -The command \\[normal-mode] always obeys local-variables lists -and ignores this variable." - :type '(choice (const :tag "Obey" t) - (const :tag "Ignore" nil) - (sexp :tag "Query" :format "%t\n" other)) - :group 'find-file) - -(defcustom enable-local-eval 'maybe - "*Control processing of the \"variable\" `eval' in a file's local variables. -The value can be t, nil or something else. -A value of t means obey `eval' variables; -nil means ignore them; anything else means query. - -The command \\[normal-mode] always obeys local-variables lists -and ignores this variable." - :type '(choice (const :tag "Obey" t) - (const :tag "Ignore" nil) - (sexp :tag "Query" :format "%t\n" other)) - :group 'find-file) - -;; Avoid losing in versions where CLASH_DETECTION is disabled. -(or (fboundp 'lock-buffer) - (defalias 'lock-buffer 'ignore)) -(or (fboundp 'unlock-buffer) - (defalias 'unlock-buffer 'ignore)) - -;;FSFmacs bastardized ange-ftp cruft -;; This hook function provides support for ange-ftp host name -;; completion. It runs the usual ange-ftp hook, but only for -;; completion operations. Having this here avoids the need -;; to load ange-ftp when it's not really in use. -;(defun ange-ftp-completion-hook-function (op &rest args) -; (if (memq op '(file-name-completion file-name-all-completions)) -; (apply 'ange-ftp-hook-function op args) -; (let ((inhibit-file-name-handlers -; (cons 'ange-ftp-completion-hook-function -; (and (eq inhibit-file-name-operation op) -; inhibit-file-name-handlers))) -; (inhibit-file-name-operation op)) -; (apply op args)) - -(defun convert-standard-filename (filename) - "Convert a standard file's name to something suitable for the current OS. -This function's standard definition is trivial; it just returns the argument. -However, on some systems, the function is redefined -with a definition that really does change some file names." - filename) - -(defun pwd () - "Show the current default directory." - (interactive nil) - (message "Directory %s" default-directory)) - -(defvar cd-path nil - "Value of the CDPATH environment variable, as a list. -Not actually set up until the first time you use it.") - -(defvar cdpath-previous nil - "Prior value of the CDPATH environment variable.") - -(defun parse-colon-path (cd-path) - "Explode a colon-separated search path into a list of directory names. - -If you think you want to use this, you probably don't. This function -is provided for backward compatibility. A more robust implementation -of the same functionality is available as `split-path', which see." - (and cd-path - (let (cd-list (cd-start 0) cd-colon) - (setq cd-path (concat cd-path path-separator)) - (while (setq cd-colon (string-match path-separator cd-path cd-start)) - (setq cd-list - (nconc cd-list - (list (if (= cd-start cd-colon) - nil - (substitute-in-file-name - (file-name-as-directory - (substring cd-path cd-start cd-colon))))))) - (setq cd-start (+ cd-colon 1))) - cd-list))) - -(defun cd-absolute (dir) - "Change current directory to given absolute file name DIR." - ;; Put the name into directory syntax now, - ;; because otherwise expand-file-name may give some bad results. - (setq dir (file-name-as-directory dir)) - ;; XEmacs change: stig@hackvan.com - (if find-file-use-truenames - (setq dir (file-truename dir))) - (setq dir (abbreviate-file-name (expand-file-name dir))) - (cond ((not (file-directory-p dir)) - (error "%s is not a directory" dir)) - ;; this breaks ange-ftp, which doesn't (can't?) overload `file-executable-p'. - ;;((not (file-executable-p dir)) - ;; (error "Cannot cd to %s: Permission denied" dir)) - (t - (setq default-directory dir)))) - -(defun cd (dir) - "Make DIR become the current buffer's default directory. -If your environment includes a `CDPATH' variable, try each one of that -colon-separated list of directories when resolving a relative directory name." - (interactive - ;; XEmacs change? (read-file-name => read-directory-name) - (list (read-directory-name "Change default directory: " - default-directory default-directory - (and (member cd-path '(nil ("./"))) - (null (getenv "CDPATH")))))) - (if (file-name-absolute-p dir) - (cd-absolute (expand-file-name dir)) - ;; XEmacs - (unless (and cd-path (equal (getenv "CDPATH") cdpath-previous)) - ;;#### Unix-specific - (let ((trypath (parse-colon-path - (setq cdpath-previous (getenv "CDPATH"))))) - (setq cd-path (or trypath (list "./"))))) - (or (catch 'found - (mapcar #'(lambda (x) - (let ((f (expand-file-name (concat x dir)))) - (if (file-directory-p f) - (progn - (cd-absolute f) - (throw 'found t))))) - cd-path) - nil) - ;; jwz: give a better error message to those of us with the - ;; good taste not to use a kludge like $CDPATH. - (if (equal cd-path '("./")) - (error "No such directory: %s" (expand-file-name dir)) - (error "Directory not found in $CDPATH: %s" dir))))) - -(defun load-file (file) - "Load the Lisp file named FILE." - (interactive "fLoad file: ") - (load (expand-file-name file) nil nil t)) - -; We now dump utils/lib-complete.el which has improved versions of this. -;(defun load-library (library) -; "Load the library named LIBRARY. -;This is an interface to the function `load'." -; (interactive "sLoad library: ") -; (load library)) -; -;(defun find-library (library) -; "Find the library of Lisp code named LIBRARY. -;This searches `load-path' for a file named either \"LIBRARY\" or \"LIBRARY.el\"." -; (interactive "sFind library file: ") -; (let ((f (locate-file library load-path ":.el:"))) -; (if f -; (find-file f) -; (error "Couldn't locate library %s" library)))) - -(defun file-local-copy (file &optional buffer) - "Copy the file FILE into a temporary file on this machine. -Returns the name of the local copy, or nil, if FILE is directly -accessible." - (let ((handler (find-file-name-handler file 'file-local-copy))) - (if handler - (funcall handler 'file-local-copy file) - nil))) - -;; XEmacs change block -; We have this in C and use the realpath() system call. - -;(defun file-truename (filename &optional counter prev-dirs) -; [... lots of code snipped ...] -; filename)) - -;; XEmacs addition. Called from `insert-file-contents-internal' -;; at the appropriate time. -(defun compute-buffer-file-truename (&optional buffer) - "Recompute BUFFER's value of `buffer-file-truename' -based on the current value of `buffer-file-name'. -BUFFER defaults to the current buffer if unspecified." - (save-excursion - (set-buffer (or buffer (current-buffer))) - (cond ((null buffer-file-name) - (setq buffer-file-truename nil)) - ((setq buffer-file-truename (file-truename buffer-file-name)) - ;; it exists, we're done. - nil) - (t - ;; the file doesn't exist, but maybe the directory does. - (let* ((dir (file-name-directory buffer-file-name)) - (truedir (file-truename dir))) - (if truedir (setq dir truedir)) - (setq buffer-file-truename - (expand-file-name (file-name-nondirectory buffer-file-name) - dir))))) - (if (and find-file-use-truenames buffer-file-truename) - (setq buffer-file-name (abbreviate-file-name buffer-file-truename) - default-directory (file-name-directory buffer-file-name))) - buffer-file-truename)) -;; End XEmacs change block - -(defun file-chase-links (filename) - "Chase links in FILENAME until a name that is not a link. -Does not examine containing directories for links, -unlike `file-truename'." - (let (tem (count 100) (newname filename)) - (while (setq tem (file-symlink-p newname)) - (save-match-data - (if (= count 0) - (error "Apparent cycle of symbolic links for %s" filename)) - ;; In the context of a link, `//' doesn't mean what XEmacs thinks. - (while (string-match "//+" tem) - (setq tem (concat (substring tem 0 (1+ (match-beginning 0))) - (substring tem (match-end 0))))) - ;; Handle `..' by hand, since it needs to work in the - ;; target of any directory symlink. - ;; This code is not quite complete; it does not handle - ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose. - (while (string-match "\\`\\.\\./" tem) ;#### Unix specific - (setq tem (substring tem 3)) - (setq newname (file-name-as-directory - ;; Do the .. by hand. - (directory-file-name - (file-name-directory - ;; Chase links in the default dir of the symlink. - (file-chase-links - (directory-file-name - (file-name-directory newname)))))))) - (setq newname (expand-file-name tem (file-name-directory newname))) - (setq count (1- count)))) - newname)) - -(defun switch-to-other-buffer (arg) - "Switch to the previous buffer. With a numeric arg, n, switch to the nth -most recent buffer. With an arg of 0, buries the current buffer at the -bottom of the buffer stack." - (interactive "p") - (if (eq arg 0) - (bury-buffer (current-buffer))) - (switch-to-buffer - (if (<= arg 1) (other-buffer (current-buffer)) - (nth (1+ arg) (buffer-list))))) - -(defun switch-to-buffer-other-window (buffer) - "Select buffer BUFFER in another window." - (interactive "BSwitch to buffer in other window: ") - (let ((pop-up-windows t)) - ;; XEmacs: this used to have (selected-frame) as the third argument, - ;; but this is obnoxious. If the user wants the buffer in a - ;; different frame, then it should be this way. - - ;; Change documented above undone --mrb - (pop-to-buffer buffer t (selected-frame)))) - -(defun switch-to-buffer-other-frame (buffer) - "Switch to buffer BUFFER in a newly-created frame." - (interactive "BSwitch to buffer in other frame: ") - (let* ((name (get-frame-name-for-buffer buffer)) - (frame (make-frame (if name - (list (cons 'name (symbol-name name))))))) - (pop-to-buffer buffer t frame) - (make-frame-visible frame) - buffer)) - -(defun find-file (filename &optional codesys) - "Edit file FILENAME. -Switch to a buffer visiting file FILENAME, -creating one if none already exists. -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." - (interactive "FFind file: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (switch-to-buffer (find-file-noselect filename))) - (switch-to-buffer (find-file-noselect filename)))) - -(defun find-file-other-window (filename &optional codesys) - "Edit file FILENAME, in another window. -May create a new window, or reuse an existing one. -See the function `display-buffer'. -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." - (interactive "FFind file in other window: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (switch-to-buffer-other-window (find-file-noselect filename))) - (switch-to-buffer-other-window (find-file-noselect filename)))) - -(defun find-file-other-frame (filename &optional codesys) - "Edit file FILENAME, in a newly-created frame. -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." - (interactive "FFind file in other frame: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (switch-to-buffer-other-frame (find-file-noselect filename))) - (switch-to-buffer-other-frame (find-file-noselect filename)))) - -(defun find-file-read-only (filename &optional codesys) - "Edit file FILENAME but don't allow changes. -Like \\[find-file] but marks buffer as read-only. -Use \\[toggle-read-only] to permit editing. -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." - (interactive "fFind file read-only: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (find-file filename)) - (find-file filename)) - (setq buffer-read-only t) - (current-buffer)) - -(defun find-file-read-only-other-window (filename &optional codesys) - "Edit file FILENAME in another window but don't allow changes. -Like \\[find-file-other-window] but marks buffer as read-only. -Use \\[toggle-read-only] to permit editing. -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." - (interactive "fFind file read-only other window: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (find-file-other-window filename)) - (find-file-other-window filename)) - (setq buffer-read-only t) - (current-buffer)) - -(defun find-file-read-only-other-frame (filename &optional codesys) - "Edit file FILENAME in another frame but don't allow changes. -Like \\[find-file-other-frame] but marks buffer as read-only. -Use \\[toggle-read-only] to permit editing. -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." - (interactive "fFind file read-only other frame: \nZCoding system: ") - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (find-file-other-frame filename)) - (find-file-other-frame filename)) - (setq buffer-read-only t) - (current-buffer)) - -(defun find-alternate-file-other-window (filename &optional codesys) - "Find file FILENAME as a replacement for the file in the next window. -This command does not select that window. -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." - (interactive - (save-selected-window - (other-window 1) - (let ((file buffer-file-name) - (file-name nil) - (file-dir nil)) - (and file - (setq file-name (file-name-nondirectory file) - file-dir (file-name-directory file))) - (list (read-file-name - "Find alternate file: " file-dir nil nil file-name) - (if (and current-prefix-arg (featurep 'mule)) - (read-coding-system "Coding-system: ")))))) - (if (one-window-p) - (find-file-other-window filename) - (save-selected-window - (other-window 1) - (find-alternate-file filename codesys)))) - -(defun find-alternate-file (filename &optional codesys) - "Find file FILENAME, select its buffer, kill previous buffer. -If the current buffer now contains an empty file that you just visited -\(presumably by mistake), use this command to visit the file you really want. -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." - (interactive - (let ((file buffer-file-name) - (file-name nil) - (file-dir nil)) - (and file - (setq file-name (file-name-nondirectory file) - file-dir (file-name-directory file))) - (list (read-file-name - "Find alternate file: " file-dir nil nil file-name) - (if (and current-prefix-arg (featurep 'mule)) - (read-coding-system "Coding-system: "))))) - (and (buffer-modified-p) (buffer-file-name) - ;; (not buffer-read-only) - (not (yes-or-no-p (format - "Buffer %s is modified; kill anyway? " - (buffer-name)))) - (error "Aborted")) - (let ((obuf (current-buffer)) - (ofile buffer-file-name) - (onum buffer-file-number) - (otrue buffer-file-truename) - (oname (buffer-name))) - (if (get-buffer " **lose**") - (kill-buffer " **lose**")) - (rename-buffer " **lose**") - (setq buffer-file-name nil) - (setq buffer-file-number nil) - (setq buffer-file-truename nil) - (unwind-protect - (progn - (unlock-buffer) - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (find-file filename)) - (find-file filename))) - (cond ((eq obuf (current-buffer)) - (setq buffer-file-name ofile) - (setq buffer-file-number onum) - (setq buffer-file-truename otrue) - (lock-buffer) - (rename-buffer oname)))) - (or (eq (current-buffer) obuf) - (kill-buffer obuf)))) - -(defun create-file-buffer (filename) - "Create a suitably named buffer for visiting FILENAME, and return it. -FILENAME (sans directory) is used unchanged if that name is free; -otherwise a string <2> or <3> or ... is appended to get an unused name." - (let ((handler (find-file-name-handler filename 'create-file-buffer))) - (if handler - (funcall handler 'create-file-buffer filename) - (let ((lastname (file-name-nondirectory filename))) - (if (string= lastname "") - (setq lastname filename)) - (generate-new-buffer lastname))))) - -(defun generate-new-buffer (name) - "Create and return a buffer with a name based on NAME. -Choose the buffer's name using `generate-new-buffer-name'." - (get-buffer-create (generate-new-buffer-name name))) - -(defvar abbreviated-home-dir nil - "The user's homedir abbreviated according to `directory-abbrev-alist'.") - -(defun abbreviate-file-name (filename &optional hack-homedir) - "Return a version of FILENAME shortened using `directory-abbrev-alist'. -See documentation of variable `directory-abbrev-alist' for more information. -If optional argument HACK-HOMEDIR is non-nil, then this also substitutes -\"~\" for the user's home directory." - (let ((handler (find-file-name-handler filename 'abbreviate-file-name))) - (if handler - (funcall handler 'abbreviate-file-name filename hack-homedir) - ;; Get rid of the prefixes added by the automounter. - ;;(if (and (string-match automount-dir-prefix filename) - ;; (file-exists-p (file-name-directory - ;; (substring filename (1- (match-end 0)))))) - ;; (setq filename (substring filename (1- (match-end 0))))) - (let ((tail directory-abbrev-alist)) - ;; If any elt of directory-abbrev-alist matches this name, - ;; abbreviate accordingly. - (while tail - (if (string-match (car (car tail)) filename) - (setq filename - (concat (cdr (car tail)) (substring filename (match-end 0))))) - (setq tail (cdr tail)))) - (if hack-homedir - (progn - ;; Compute and save the abbreviated homedir name. - ;; We defer computing this until the first time it's needed, to - ;; give time for directory-abbrev-alist to be set properly. - ;; We include a slash at the end, to avoid spurious matches - ;; such as `/usr/foobar' when the home dir is `/usr/foo'. - (or abbreviated-home-dir - (setq abbreviated-home-dir - (let ((abbreviated-home-dir "$foo")) - (concat "\\`" (regexp-quote (abbreviate-file-name - (expand-file-name "~"))) - "\\(/\\|\\'\\)")))) - ;; If FILENAME starts with the abbreviated homedir, - ;; make it start with `~' instead. - (if (and (string-match abbreviated-home-dir filename) - ;; If the home dir is just /, don't change it. - (not (and (= (match-end 0) 1) ;#### unix-specific - (= (aref filename 0) ?/))) - (not (and (memq system-type '(ms-dos windows-nt)) - (save-match-data - (string-match "^[a-zA-Z]:/$" filename))))) - (setq filename - (concat "~" - (substring filename - (match-beginning 1) (match-end 1)) - (substring filename (match-end 0))))))) - filename))) - -(defcustom find-file-not-true-dirname-list nil - "*List of logical names for which visiting shouldn't save the true dirname." - :type '(repeat (string :tag "Name")) - :group 'find-file) - -;; This function is needed by FSF vc.el. I hope somebody can make it -;; work for XEmacs. -sb. -;; #### In what way does it not work? --hniksic -(defun find-buffer-visiting (filename) - "Return the buffer visiting file FILENAME (a string). -This is like `get-file-buffer', except that it checks for any buffer -visiting the same file, possibly under a different name. -If there is no such live buffer, return nil." - (let ((buf (get-file-buffer filename)) - (truename (abbreviate-file-name (file-truename filename)))) - (or buf - (let ((list (buffer-list)) found) - (while (and (not found) list) - (save-excursion - (set-buffer (car list)) - (if (and buffer-file-name - (string= buffer-file-truename truename)) - (setq found (car list)))) - (setq list (cdr list))) - found) - (let ((number (nthcdr 10 (file-attributes truename))) - (list (buffer-list)) found) - (and buffer-file-numbers-unique - number - (while (and (not found) list) - (save-excursion - (set-buffer (car list)) - (if (and buffer-file-number - (equal buffer-file-number number) - ;; Verify this buffer's file number - ;; still belongs to its file. - (file-exists-p buffer-file-name) - (equal (nthcdr 10 (file-attributes buffer-file-name)) - number)) - (setq found (car list)))) - (setq list (cdr list)))) - found)))) - -(defun insert-file-contents-literally (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ((file-name-handler-alist nil) - (format-alist nil) - (after-insert-file-functions nil) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil))) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (filename) t)) - (insert-file-contents filename visit beg end replace)) - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - -(defun find-file-noselect (filename &optional nowarn rawfile) - "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. -If NOWARN is non-nil, warning messages will be suppressed. -If RAWFILE is non-nil, the file is read literally." - (setq filename (abbreviate-file-name (expand-file-name filename))) - (if (file-directory-p filename) - (if (and (fboundp 'dired-noselect) find-file-run-dired) - (dired-noselect (if find-file-use-truenames - (abbreviate-file-name (file-truename filename)) - 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) (find-buffer-visiting filename))) - (error nil)) - -; ;; Let user know if there is a buffer with the same truename. -; (if (and (not buf) same-truename (not nowarn)) -; (message "%s and %s are the same file (%s)" -; filename (buffer-file-name same-truename) -; truename) -; (if (and (not buf) same-number (not nowarn)) -; (message "%s and %s are the same file" -; filename (buffer-file-name same-number)))) -; ;; Optionally also find that buffer. -; (if (or find-file-existing-other-name find-file-visit-truename) -; (setq buf (or same-truename same-number))) - - (when (and buf - (or find-file-compare-truenames find-file-use-truenames) - (not nowarn)) - (save-excursion - (set-buffer buf) - (if (not (string-equal buffer-file-name filename)) - (message "%s and %s are the same file (%s)" - filename buffer-file-name - buffer-file-truename)))) - - (if buf - (or nowarn - (verify-visited-file-modtime buf) - (cond ((not (file-exists-p filename)) - (error "File %s no longer exists!" filename)) - ;; Certain files should be reverted automatically - ;; if they have changed on disk and not in the buffer. - ((and (not (buffer-modified-p buf)) - (dolist (rx revert-without-query nil) - (when (string-match rx filename) - (return t)))) - (with-current-buffer buf - (message "Reverting file %s..." filename) - (revert-buffer t t) - (message "Reverting file %s... done" filename))) - ((yes-or-no-p - (if (string= (file-name-nondirectory filename) - (buffer-name buf)) - (format - (if (buffer-modified-p buf) - (gettext "File %s changed on disk. Discard your edits? ") - (gettext "File %s changed on disk. Reread from disk? ")) - (file-name-nondirectory filename)) - (format - (if (buffer-modified-p buf) - (gettext "File %s changed on disk. Discard your edits in %s? ") - (gettext "File %s changed on disk. Reread from disk into %s? ")) - (file-name-nondirectory filename) - (buffer-name buf)))) - (with-current-buffer buf - (revert-buffer t t))))) - ;; Else: we must create a new buffer for filename - (save-excursion -;;; The truename stuff makes this obsolete. -;;; (let* ((link-name (car (file-attributes filename))) -;;; (linked-buf (and (stringp link-name) -;;; (get-file-buffer link-name)))) -;;; (if (bufferp linked-buf) -;;; (message "Symbolic link to file in buffer %s" -;;; (buffer-name linked-buf)))) - (setq buf (create-file-buffer filename)) - ;; Catch various signals, such as QUIT, and kill the buffer - ;; in that case. - (condition-case data - (progn - (set-buffer-major-mode buf) - (set-buffer buf) - (erase-buffer) - (condition-case () - (if rawfile - (insert-file-contents-literally filename t) - (insert-file-contents filename t)) - (file-error - (when (and (file-exists-p filename) - (not (file-readable-p filename))) - (signal 'file-error (list "File is not readable" filename))) - (if rawfile - ;; Unconditionally set error - (setq error t) - (or - ;; Run find-file-not-found-hooks until one returns non-nil. - (run-hook-with-args-until-success 'find-file-not-found-hooks) - ;; If they fail too, set error. - (setq error t))))) - ;; Find the file's truename, and maybe use that as visited name. - ;; automatically computed in XEmacs, unless jka-compr was used! - (unless buffer-file-truename - (setq buffer-file-truename truename)) - (setq buffer-file-number number) - (and find-file-use-truenames - ;; This should be in C. Put pathname - ;; abbreviations that have been explicitly - ;; requested back into the pathname. Most - ;; importantly, strip out automounter /tmp_mnt - ;; directories so that auto-save will work - (setq buffer-file-name (abbreviate-file-name buffer-file-name))) - ;; Set buffer's default directory to that of the file. - (setq default-directory (file-name-directory buffer-file-name)) - ;; 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))) - (if rawfile - ;; #### FSF 20.3 sets buffer-file-coding-system to - ;; `no-conversion' here. Should we copy? It also - ;; makes `find-file-literally' a local variable - ;; and sets it to t. - nil - (after-find-file error (not nowarn)) - (setq buf (current-buffer)))) - (t - (kill-buffer buf) - (signal (car data) (cdr data)))))) - buf))) - -;; FSF has `insert-file-literally' and `find-file-literally' here. - -(defvar after-find-file-from-revert-buffer nil) - -(defun after-find-file (&optional error warn noauto - after-find-file-from-revert-buffer - nomodes) - "Called after finding a file and by the default revert function. -Sets buffer mode, parses local variables. -Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an -error in reading the file. WARN non-nil means warn if there -exists an auto-save file more recent than the visited file. -NOAUTO means don't mess with auto-save mode. -Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil - means this call was from `revert-buffer'. -Fifth arg NOMODES non-nil means don't alter the file's modes. -Finishes by calling the functions in `find-file-hooks'." - (setq buffer-read-only (not (file-writable-p buffer-file-name))) - (if noninteractive - nil - (let* (not-serious - (msg - (cond ((and error (file-attributes buffer-file-name)) - (setq buffer-read-only t) - (gettext "File exists, but cannot be read.")) - ((not buffer-read-only) - (if (and warn - (file-newer-than-file-p (make-auto-save-file-name) - buffer-file-name)) - (format "%s has auto save data; consider M-x recover-file" - (file-name-nondirectory buffer-file-name)) - (setq not-serious t) - (if error (gettext "(New file)") nil))) - ((not error) - (setq not-serious t) - (gettext "Note: file is write protected")) - ((file-attributes (directory-file-name default-directory)) - (gettext "File not found and directory write-protected")) - ((file-exists-p (file-name-directory buffer-file-name)) - (setq buffer-read-only nil)) - (t - ;; If the directory the buffer is in doesn't exist, - ;; offer to create it. It's better to do this now - ;; than when we save the buffer, because we want - ;; autosaving to work. - (setq buffer-read-only nil) - ;; XEmacs - (or (file-exists-p (file-name-directory buffer-file-name)) - (condition-case nil - (if (yes-or-no-p - (format - "\ -The directory containing %s does not exist. Create? " - (abbreviate-file-name buffer-file-name))) - (make-directory (file-name-directory - buffer-file-name) - t)) - (quit - (kill-buffer (current-buffer)) - (signal 'quit nil)))) - nil)))) - (if msg - (progn - (message "%s" msg) - (or not-serious (sit-for 1 t))))) - (if (and auto-save-default (not noauto)) - (auto-save-mode t))) - (unless nomodes - (normal-mode t) - (run-hooks 'find-file-hooks))) - -(defun 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, -we may set up specified local variables depending on the value of -`enable-local-variables': if it is t, we do; if it is nil, we don't; -otherwise, we query. `enable-local-variables' is ignored if you -run `normal-mode' explicitly." - (interactive) - (or find-file (funcall (or default-major-mode 'fundamental-mode))) - (and (condition-case err - (progn (set-auto-mode) - t) - (error (message "File mode specification error: %s" - (prin1-to-string err)) - nil)) - (condition-case err - (hack-local-variables (not find-file)) - (error (lwarn 'local-variables 'warning - "File local-variables error: %s" - (error-message-string err)))))) - -;; #### This variable sucks in the package model. There should be a -;; way for new packages to add their entries to auto-mode-alist in a -;; clean way. Per Abrahamsen suggested splitting auto-mode-alist to -;; several distinct variables such as, in order of precedence, -;; `user-auto-mode-alist' for users, `package-auto-mode-alist' for -;; packages and `auto-mode-alist' (which might also be called -;; `default-auto-mode-alist') for default stuff, such as some of the -;; entries below. - -(defvar auto-mode-alist - '(("\\.te?xt\\'" . text-mode) - ("\\.[ch]\\'" . c-mode) - ("\\.el\\'" . emacs-lisp-mode) - ("\\.\\(?:[CH]\\|cc\\|hh\\)\\'" . c++-mode) - ("\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\'" . c++-mode) - ("\\.java\\'" . java-mode) - ("\\.idl\\'" . idl-mode) - ("\\.f\\(?:or\\)?\\'" . fortran-mode) - ("\\.F\\(?:OR\\)?\\'" . fortran-mode) - ("\\.[fF]90\\'" . f90-mode) -;;; Less common extensions come here -;;; so more common ones above are found faster. - ("\\.\\([pP][Llm]\\|al\\)\\'" . perl-mode) - ("\\.py\\'" . python-mode) - ("\\.texi\\(?:nfo\\)?\\'" . texinfo-mode) - ("\\.ad[abs]\\'" . ada-mode) - ("\\.c?l\\(?:i?sp\\)?\\'" . lisp-mode) - ("\\.p\\(?:as\\)?\\'" . pascal-mode) - ("\\.ltx\\'" . latex-mode) - ("\\.[sS]\\'" . asm-mode) - ("[Cc]hange.?[Ll]og?\\(?:.[0-9]+\\)?\\'" . change-log-mode) - ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) - ("\\.scm?\\(?:\\.[0-9]*\\)?\\'" . scheme-mode) - ("\\.e\\'" . eiffel-mode) - ("\\.mss\\'" . scribe-mode) - ("\\.m\\(?:[mes]\\|an\\)\\'" . nroff-mode) - ("\\.icn\\'" . icon-mode) - ("\\.\\(?:[ckz]?sh\\|shar\\)\\'" . sh-mode) - ;; #### Unix-specific! - ("/\\.\\(?:bash_\\|z\\)?\\(profile\\|login\||logout\\)\\'" . sh-mode) - ("/\\.\\(?:[ckz]sh\\|bash\\|tcsh\\|es\\|xinit\\|startx\\)rc\\'" . sh-mode) - ("/\\.\\(?:[kz]shenv\\|xsession\\)\\'" . sh-mode) - ;; The following come after the ChangeLog pattern for the sake of - ;; ChangeLog.1, etc. and after the .scm.[0-9] pattern too. - ("\\.[12345678]\\'" . nroff-mode) - ("\\.[tT]e[xX]\\'" . tex-mode) - ("\\.\\(?:sty\\|cls\\|bbl\\)\\'" . latex-mode) - ("\\.bib\\'" . bibtex-mode) - ("\\.article\\'" . text-mode) - ("\\.letter\\'" . text-mode) - ("\\.\\(?:tcl\\|exp\\)\\'" . tcl-mode) - ("\\.wrl\\'" . vrml-mode) - ("\\.awk\\'" . awk-mode) - ("\\.prolog\\'" . prolog-mode) - ("\\.\\(?:arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) - ;; Mailer puts message to be edited in /tmp/Re.... or Message - ;; #### Unix-specific! - ("\\`/tmp/Re" . text-mode) - ("/Message[0-9]*\\'" . text-mode) - ("/drafts/[0-9]+\\'" . mh-letter-mode) - ;; some news reader is reported to use this - ("^/tmp/fol/" . text-mode) - ("\\.y\\'" . c-mode) - ("\\.lex\\'" . c-mode) - ("\\.m\\'" . objc-mode) - ("\\.oak\\'" . scheme-mode) - ("\\.s?html?\\'" . html-mode) - ("\\.htm?l?3\\'" . html3-mode) - ("\\.\\(?:sgml?\\|dtd\\)\\'" . sgml-mode) - ("\\.c?ps\\'" . postscript-mode) - ;; .emacs following a directory delimiter in either Unix or - ;; Windows syntax. - ("[/\\][._].*emacs\\'" . emacs-lisp-mode) - ("\\.m4\\'" . autoconf-mode) - ("configure\\.in\\'" . autoconf-mode) - ("\\.ml\\'" . lisp-mode) - ("\\.ma?k\\'" . makefile-mode) - ("[Mm]akefile\\(\\.\\|\\'\\)" . makefile-mode) - ("\\.X\\(defaults\\|environment\\|resources\\|modmap\\)\\'" . xrdb-mode) - ;; #### The following three are Unix-specific (but do we care?) - ("/app-defaults/" . xrdb-mode) - ("\\.[^/]*wm2?\\(?:rc\\)?\\'" . winmgr-mode) - ("\\.\\(?:jpe?g\\|JPE?G\\|png\\|PNG\\|gif\\|GIF\\|tiff?\\|TIFF?\\)\\'" . image-mode) - ) -"Alist of filename patterns vs. corresponding major mode functions. -Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). -\(NON-NIL stands for anything that is not nil; the value does not matter.) -Visiting a file whose name matches REGEXP specifies FUNCTION as the -mode function to use. FUNCTION will be called, unless it is nil. - -If the element has the form (REGEXP FUNCTION NON-NIL), then after -calling FUNCTION (if it's not nil), we delete the suffix that matched -REGEXP and search the list again for another match.") - -(defvar interpreter-mode-alist - '(("^#!.*csh" . sh-mode) - ("^#!.*\\b\\(scope\\|wish\\|tcl\\|tclsh\\|expect\\)" . tcl-mode) - ("^#!.*sh\\b" . sh-mode) - ("perl" . perl-mode) - ("python" . python-mode) - ("awk\\b" . awk-mode) - ("rexx" . rexx-mode) - ("scm" . scheme-mode) - ("^:" . sh-mode)) - "Alist mapping interpreter names to major modes. -This alist is used to guess the major mode of a file based on the -contents of the first line. This line often contains something like: -#!/bin/sh -but may contain something more imaginative like -#! /bin/env python -or -eval 'exec perl -w -S $0 ${1+\"$@\"}'. - -Each alist element looks like (INTERPRETER . MODE). -The car of each element is a regular expression which is compared -with the name of the interpreter specified in the first line. -If it matches, mode MODE is selected.") - -(defvar binary-file-regexps - (purecopy - '("\\.\\(?:bz2\\|elc\\|g\\(if\\|z\\)\\|jp\\(eg\\|g\\)\\|png\\|t\\(ar\\|gz\\|iff\\)\\|[Zo]\\)\\'")) - "List of regexps of filenames containing binary (non-text) data.") - -; (eval-when-compile -; (require 'regexp-opt) -; (list -; (format "\\.\\(?:%s\\)\\'" -; (regexp-opt -; '("tar" -; "tgz" -; "gz" -; "bz2" -; "Z" -; "o" -; "elc" -; "png" -; "gif" -; "tiff" -; "jpg" -; "jpeg")))))) - -(defvar inhibit-first-line-modes-regexps - (purecopy binary-file-regexps) - "List of regexps; if one matches a file name, don't look for `-*-'.") - -(defvar inhibit-first-line-modes-suffixes nil - "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'. -When checking `inhibit-first-line-modes-regexps', we first discard -from the end of the file name anything that matches one of these regexps.") - -(defvar user-init-file - "" ; set by command-line - "File name including directory of user's initialization file.") - -(defun set-auto-mode (&optional just-from-file-name) - "Select major mode appropriate for current buffer. -This checks for a -*- mode tag in the buffer's text, -compares the filename against the entries in `auto-mode-alist', -or checks the interpreter that runs this file against -`interpreter-mode-alist'. - -It does not check for the `mode:' local variable in the -Local Variables section of the file; for that, use `hack-local-variables'. - -If `enable-local-variables' is nil, this function does not check for a --*- mode tag. - -If the optional argument JUST-FROM-FILE-NAME is non-nil, -then we do not set anything but the major mode, -and we don't even do that unless it would come from the file name." - (save-excursion - ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*- - ;; Do this by calling the hack-local-variables helper to avoid redundancy. - ;; We bind enable-local-variables to nil this time because we're going to - ;; call hack-local-variables-prop-line again later, "for real." Note that - ;; this temporary binding does not prevent hack-local-variables-prop-line - ;; from setting the major mode. - (or (and enable-local-variables - (let ((enable-local-variables nil)) - (hack-local-variables-prop-line nil)) - ) - ;; It's not in the -*- line, so check the auto-mode-alist, unless - ;; this buffer isn't associated with a file. - (null buffer-file-name) - (let ((name (file-name-sans-versions buffer-file-name)) - (keep-going t)) - (while keep-going - (setq keep-going nil) - (let ((alist auto-mode-alist) - (mode nil)) - ;; Find first matching alist entry. - (let ((case-fold-search - (memq system-type '(windows-nt)))) - (while (and (not mode) alist) - (if (string-match (car (car alist)) name) - (if (and (consp (cdr (car alist))) - (nth 2 (car alist))) - (progn - (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)))) - (unless just-from-file-name - ;; If we can't deduce a mode from the file name, - ;; look for an interpreter specified in the first line. - (if (and (null mode) - (save-excursion ; XEmacs - (goto-char (point-min)) - (looking-at "#!"))) - (let ((firstline - (buffer-substring - (point-min) - (save-excursion - (goto-char (point-min)) (end-of-line) (point))))) - (setq alist interpreter-mode-alist) - (while alist - (if (string-match (car (car alist)) firstline) - (progn - (setq mode (cdr (car alist))) - (setq alist nil)) - (setq alist (cdr alist))))))) - (if mode - (if (not (fboundp mode)) - (let ((name (package-get-package-provider mode))) - (if name - (message "Mode %s is not installed. Download package %s" mode name) - (message "Mode %s either doesn't exist or is not a known package" mode)) - (sit-for 2) - (error "%s" mode)) - (unless (and just-from-file-name - (or - ;; Don't reinvoke major mode. - (eq mode major-mode) - ;; Don't lose on minor modes. - (assq mode minor-mode-alist))) - (funcall mode)))))))))) - -(defvar hack-local-variables-hook nil - "Normal hook run after processing a file's local variables specs. -Major modes can use this to examine user-specified local variables -in order to initialize other data structure based on them. - -This hook runs even if there were no local variables or if their -evaluation was suppressed. See also `enable-local-variables' and -`enable-local-eval'.") - -(defun hack-local-variables (&optional force) - "Parse, and bind or evaluate as appropriate, any local variables -for current buffer." - ;; Don't look for -*- if this file name matches any - ;; of the regexps in inhibit-first-line-modes-regexps. - (if (or (null buffer-file-name) ; don't lose if buffer has no file! - (not (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)) - temp)))) - (progn - ;; Look for variables in the -*- line. - (hack-local-variables-prop-line force) - ;; Look for "Local variables:" block in last page. - (hack-local-variables-last-page force))) - (run-hooks 'hack-local-variables-hook)) - -;;; Local variables may be specified in the last page of the file (within 3k -;;; from the end of the file and after the last ^L) in the form -;;; -;;; Local variables: -;;; variable-name: variable-value -;;; end: -;;; -;;; The lines may begin with a common prefix, like ";;; " in the above -;;; example. They may also have a common suffix (" */" for example). In -;;; this form, the local variable "mode" can be used to change the major -;;; mode, and the local variable "eval" can be used to evaluate an arbitrary -;;; form. -;;; -;;; Local variables may also be specified in the first line of the file. -;;; Embedded in this line are a pair of "-*-" sequences. What lies between -;;; them are variable-name/variable-value pairs, like: -;;; -;;; -*- mode: emacs-lisp -*- -;;; or -*- mode: postscript; version-control: never -*- -;;; or -*- tags-file-name: "/foo/bar/TAGS" -*- -;;; -;;; The local variable "eval" is not used with this form. For hysterical -;;; reasons, the syntax "-*- modename -*-" is allowed as well. -;;; - -(defun hack-local-variables-p (modeline) - (or (eq enable-local-variables t) - (and enable-local-variables - (save-window-excursion - (condition-case nil - (switch-to-buffer (current-buffer)) - (error - ;; If we fail to switch in the selected window, - ;; it is probably a minibuffer. - ;; So try another window. - (condition-case nil - (switch-to-buffer-other-window (current-buffer)) - (error - (switch-to-buffer-other-frame (current-buffer)))))) - (or modeline (save-excursion - (beginning-of-line) - (set-window-start (selected-window) (point)))) - (y-or-n-p (format - "Set local variables as specified %s of %s? " - (if modeline "in -*- line" "at end") - (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (concat "buffer " (buffer-name))))))))) - -(defun hack-local-variables-last-page (&optional force) - ;; Set local variables set in the "Local Variables:" block of the last page. - (save-excursion - (goto-char (point-max)) - (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) - (if (let ((case-fold-search t)) - (and (search-forward "Local Variables:" nil t) - (or force - (hack-local-variables-p nil)))) - (let ((continue t) - prefix prefixlen suffix beg - (enable-local-eval enable-local-eval)) - ;; The prefix is what comes before "local variables:" in its line. - ;; The suffix is what comes after "local variables:" in its line. - (skip-chars-forward " \t") - (or (eolp) - (setq suffix (buffer-substring (point) - (progn (end-of-line) (point))))) - (goto-char (match-beginning 0)) - (or (bolp) - (setq prefix - (buffer-substring (point) - (progn (beginning-of-line) (point))))) - (if prefix (setq prefixlen (length prefix) - prefix (regexp-quote prefix))) - (if suffix (setq suffix (concat (regexp-quote suffix) "$"))) - (while continue - ;; Look at next local variable spec. - (if selective-display (re-search-forward "[\n\C-m]") - (forward-line 1)) - ;; Skip the prefix, if any. - (if prefix - (if (looking-at prefix) - (forward-char prefixlen) - (error "Local variables entry is missing the prefix"))) - ;; Find the variable name; strip whitespace. - (skip-chars-forward " \t") - (setq beg (point)) - (skip-chars-forward "^:\n") - (if (eolp) (error "Missing colon in local variables entry")) - (skip-chars-backward " \t") - (let* ((str (buffer-substring beg (point))) - (var (read str)) - val) - ;; Setting variable named "end" means end of list. - (if (string-equal (downcase str) "end") - (setq continue nil) - ;; Otherwise read the variable value. - (skip-chars-forward "^:") - (forward-char 1) - (setq val (read (current-buffer))) - (skip-chars-backward "\n") - (skip-chars-forward " \t") - (or (if suffix (looking-at suffix) (eolp)) - (error "Local variables entry is terminated incorrectly")) - ;; Set the variable. "Variables" mode and eval are funny. - (hack-one-local-variable var val)))))))) - -;; jwz - New Version 20.1/19.15 -(defun hack-local-variables-prop-line (&optional force) - ;; Set local variables specified in the -*- line. - ;; Returns t if mode was set. - (let ((result nil)) - (save-excursion - (goto-char (point-min)) - (skip-chars-forward " \t\n\r") - (let ((end (save-excursion - ;; If the file begins with "#!" - ;; (un*x 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)))) - ;; Parse the -*- line into the `result' alist. - (cond ((not (search-forward "-*-" end t)) - ;; doesn't have one. - (setq force t)) - ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)") - ;; Antiquated form: "-*- ModeName -*-". - (setq result - (list (cons 'mode - (intern (buffer-substring - (match-beginning 1) - (match-end 1))))) - )) - (t - ;; Usual form: '-*-' [ ':' ';' ]* '-*-' - ;; (last ";" is optional). - (save-excursion - (if (search-forward "-*-" end t) - (setq end (- (point) 3)) - (error "-*- not terminated before end of line"))) - (while (< (point) end) - (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*") - (error "malformed -*- line")) - (goto-char (match-end 0)) - ;; There used to be a downcase here, - ;; but the manual didn't say so, - ;; and people want to set var names that aren't all lc. - (let ((key (intern (buffer-substring - (match-beginning 1) - (match-end 1)))) - (val (save-restriction - (narrow-to-region (point) end) - (read (current-buffer))))) - ;; Case sensitivity! Icepicks in my forehead! - (if (equal (downcase (symbol-name key)) "mode") - (setq key 'mode)) - (setq result (cons (cons key val) result)) - (skip-chars-forward " \t;"))) - (setq result (nreverse result)))))) - - (let ((set-any-p (or force - ;; It's OK to force null specifications. - (null result) - ;; It's OK to force mode-only specifications. - (let ((remaining result) - (mode-specs-only t)) - (while remaining - (if (eq (car (car remaining)) 'mode) - (setq remaining (cdr remaining)) - ;; Otherwise, we have a real local. - (setq mode-specs-only nil - remaining nil)) - ) - mode-specs-only) - ;; Otherwise, check. - (hack-local-variables-p t))) - (mode-p nil)) - (while result - (let ((key (car (car result))) - (val (cdr (car result)))) - (cond ((eq key 'mode) - (setq mode-p t) - (let ((mode (intern (concat (downcase (symbol-name val)) - "-mode")))) - ;; Without this guard, `normal-mode' would potentially run - ;; the major mode function twice: once via `set-auto-mode' - ;; and once via `hack-local-variables'. - (if (not (eq mode major-mode)) - (funcall mode)) - )) - (set-any-p - (hack-one-local-variable key val)) - (t - nil))) - (setq result (cdr result))) - mode-p))) - -(defconst ignored-local-variables - (list 'enable-local-eval) - "Variables to be ignored in a file's local variable spec.") - -;; Get confirmation before setting these variables as locals in a file. -(put 'debugger 'risky-local-variable t) -(put 'enable-local-eval 'risky-local-variable t) -(put 'ignored-local-variables 'risky-local-variable t) -(put 'eval 'risky-local-variable t) -(put 'file-name-handler-alist 'risky-local-variable t) -(put 'minor-mode-map-alist 'risky-local-variable t) -(put 'after-load-alist 'risky-local-variable t) -(put 'buffer-file-name 'risky-local-variable t) -(put 'buffer-auto-save-file-name 'risky-local-variable t) -(put 'buffer-file-truename 'risky-local-variable t) -(put 'exec-path 'risky-local-variable t) -(put 'load-path 'risky-local-variable t) -(put 'exec-directory 'risky-local-variable t) -(put 'process-environment 'risky-local-variable t) -;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. -(put 'outline-level 'risky-local-variable t) -(put 'rmail-output-file-alist 'risky-local-variable t) - -;; This one is safe because the user gets to check it before it is used. -(put 'compile-command 'safe-local-variable t) - -;(defun hack-one-local-variable-quotep (exp) -; (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp)))) - -;; "Set" one variable in a local variables spec. -;; A few variable names are treated specially. -(defun hack-one-local-variable (var val) - (cond ((eq var 'mode) - (funcall (intern (concat (downcase (symbol-name val)) - "-mode")))) - ((memq var ignored-local-variables) - nil) - ;; "Setting" eval means either eval it or do nothing. - ;; Likewise for setting hook variables. - ((or (get var 'risky-local-variable) - (and - (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$" - (symbol-name var)) - (not (get var 'safe-local-variable)))) -; ;; Permit evaling a put of a harmless property -; ;; if the args do nothing tricky. -; (if (or (and (eq var 'eval) -; (consp val) -; (eq (car val) 'put) -; (hack-one-local-variable-quotep (nth 1 val)) -; (hack-one-local-variable-quotep (nth 2 val)) -; ;; Only allow safe values of lisp-indent-hook; -; ;; not functions. -; (or (numberp (nth 3 val)) -; (equal (nth 3 val) ''defun)) -; (memq (nth 1 (nth 2 val)) -; '(lisp-indent-hook))) - (if (and (not (zerop (user-uid))) - (or (eq enable-local-eval t) - (and enable-local-eval - (save-window-excursion - (switch-to-buffer (current-buffer)) - (save-excursion - (beginning-of-line) - (set-window-start (selected-window) (point))) - (setq enable-local-eval - (y-or-n-p (format "Process `eval' or hook local variables in file %s? " - (file-name-nondirectory buffer-file-name)))))))) - (if (eq var 'eval) - (save-excursion (eval val)) - (make-local-variable var) - (set var val)) - (message "Ignoring `eval:' in file's local variables"))) - ;; Ordinary variable, really set it. - (t (make-local-variable var) - (set var val)))) - -(defcustom change-major-mode-with-file-name t - "*Non-nil means \\[write-file] should set the major mode from the file name. -However, the mode will not be changed if -\(1) a local variables list or the `-*-' line specifies a major mode, or -\(2) the current major mode is a \"special\" mode, -\ not suitable for ordinary files, or -\(3) the new file name does not particularly specify any mode." - :type 'boolean - :group 'editing-basics) - -(defun set-visited-file-name (filename &optional no-query along-with-file) - "Change name of file visited in current buffer to FILENAME. -The next time the buffer is saved it will go in the newly specified file. -nil or empty string as argument means make buffer not be visiting any file. -Remember to delete the initial contents of the minibuffer -if you wish to pass an empty string as the argument. - -The optional second argument NO-QUERY, if non-nil, inhibits asking for -confirmation in the case where another buffer is already visiting FILENAME. - -The optional third argument ALONG-WITH-FILE, if non-nil, means that -the old visited file has been renamed to the new name FILENAME." - (interactive "FSet visited file name: ") - (if (buffer-base-buffer) - (error "An indirect buffer cannot visit a file")) - (let (truename) - (if filename - (setq filename - (if (string-equal filename "") - nil - (expand-file-name filename)))) - (if filename - (progn - (setq truename (file-truename filename)) - ;; #### Do we need to check if truename is non-nil? - (if find-file-use-truenames - (setq filename truename)))) - (let ((buffer (and filename (find-buffer-visiting filename)))) - (and buffer (not (eq buffer (current-buffer))) - (not no-query) - (not (y-or-n-p (message "A buffer is visiting %s; proceed? " - filename))) - (error "Aborted"))) - (or (equal filename buffer-file-name) - (progn - (and filename (lock-buffer filename)) - (unlock-buffer))) - (setq buffer-file-name filename) - (if filename ; make buffer name reflect filename. - (let ((new-name (file-name-nondirectory buffer-file-name))) - (if (string= new-name "") - (error "Empty file name")) - (setq default-directory (file-name-directory buffer-file-name)) - (or (string= new-name (buffer-name)) - (rename-buffer new-name t)))) - (setq buffer-backed-up nil) - (or along-with-file - (clear-visited-file-modtime)) - (compute-buffer-file-truename) ; insert-file-contents does this too. -; ;; Abbreviate the file names of the buffer. -; (if truename -; (progn -; (setq buffer-file-truename (abbreviate-file-name truename)) -; (if find-file-visit-truename -; (setq buffer-file-name buffer-file-truename)))) - (setq buffer-file-number - (if filename - (nthcdr 10 (file-attributes buffer-file-name)) - nil))) - ;; write-file-hooks is normally used for things like ftp-find-file - ;; that visit things that are not local files as if they were files. - ;; Changing to visit an ordinary local file instead should flush the hook. - (kill-local-variable 'write-file-hooks) - (kill-local-variable 'after-save-hook) - (kill-local-variable 'local-write-file-hooks) - (kill-local-variable 'write-file-data-hooks) - (kill-local-variable 'revert-buffer-function) - (kill-local-variable 'backup-inhibited) - ;; If buffer was read-only because of version control, - ;; that reason is gone now, so make it writable. - (when (boundp 'vc-mode) - (if vc-mode - (setq buffer-read-only nil)) - (kill-local-variable 'vc-mode)) - ;; Turn off backup files for certain file names. - ;; Since this is a permanent local, the major mode won't eliminate it. - (and buffer-file-name - (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (let ((oauto buffer-auto-save-file-name)) - ;; If auto-save was not already on, turn it on if appropriate. - (if (not buffer-auto-save-file-name) - (and buffer-file-name auto-save-default - (auto-save-mode t)) - ;; If auto save is on, start using a new name. - ;; We deliberately don't rename or delete the old auto save - ;; for the old visited file name. This is because perhaps - ;; the user wants to save the new state and then compare with the - ;; previous state from the auto save file. - (setq buffer-auto-save-file-name - (make-auto-save-file-name))) - ;; Rename the old auto save file if any. - (and oauto buffer-auto-save-file-name - (file-exists-p oauto) - (rename-file oauto buffer-auto-save-file-name t))) - (if buffer-file-name - (not along-with-file) - (set-buffer-modified-p t)) - ;; Update the major mode, if the file name determines it. - (condition-case nil - ;; Don't change the mode if it is special. - (or (not change-major-mode-with-file-name) - (get major-mode 'mode-class) - ;; Don't change the mode if the local variable list specifies it. - (hack-local-variables t) - (set-auto-mode t)) - (error nil)) - ;; #### ?? - (run-hooks 'after-set-visited-file-name-hooks)) - -(defun write-file (filename &optional confirm codesys) - "Write current buffer into file FILENAME. -Makes buffer visit that file, and marks it not modified. -If the buffer is already visiting a file, you can specify -a directory name as FILENAME, to write a file of the same -old name in that directory. -If optional second arg CONFIRM is non-nil, -ask for confirmation for overwriting an existing file. -Under XEmacs/Mule, optional third argument specifies the -coding system to use when encoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." -;; (interactive "FWrite file: ") - (interactive - (list (if buffer-file-name - (read-file-name "Write file: " - nil nil nil nil) - (read-file-name "Write file: " - (cdr (assq 'default-directory - (buffer-local-variables))) - nil nil (buffer-name))) - t - (if (and current-prefix-arg (featurep 'mule)) - (read-coding-system "Coding system: ")))) - (and (eq (current-buffer) mouse-grabbed-buffer) - (error "Can't write minibuffer window")) - (or (null filename) (string-equal filename "") - (progn - ;; If arg is just a directory, - ;; use same file name, but in that directory. - (if (and (file-directory-p filename) buffer-file-name) - (setq filename (concat (file-name-as-directory filename) - (file-name-nondirectory buffer-file-name)))) - (and confirm - (file-exists-p filename) - (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) - (error "Canceled"))) - (set-visited-file-name filename))) - (set-buffer-modified-p t) - (setq buffer-read-only nil) - (if codesys - (let ((buffer-file-coding-system (get-coding-system codesys))) - (save-buffer)) - (save-buffer))) - -(defun backup-buffer () - "Make a backup of the disk file visited by the current buffer, if appropriate. -This is normally done before saving the buffer the first time. -If the value is non-nil, it is the result of `file-modes' on the original file; -this means that the caller, after saving the buffer, should change the modes -of the new file to agree with the old modes." - (if buffer-file-name - (let ((handler (find-file-name-handler buffer-file-name 'backup-buffer))) - (if handler - (funcall handler 'backup-buffer) - (if (and make-backup-files - (not backup-inhibited) - (not buffer-backed-up) - (file-exists-p buffer-file-name) - (memq (aref (elt (file-attributes buffer-file-name) 8) 0) - '(?- ?l))) - (let ((real-file-name buffer-file-name) - backup-info backupname targets setmodes) - ;; If specified name is a symbolic link, chase it to the target. - ;; Thus we make the backups in the directory where the real file is. - (setq real-file-name (file-chase-links real-file-name)) - (setq backup-info (find-backup-file-name real-file-name) - backupname (car backup-info) - targets (cdr backup-info)) -;;; (if (file-directory-p buffer-file-name) -;;; (error "Cannot save buffer in directory %s" buffer-file-name)) - (if backup-info - (condition-case () - (let ((delete-old-versions - ;; If have old versions to maybe delete, - ;; ask the user to confirm now, before doing anything. - ;; But don't actually delete til later. - (and targets - (or (eq delete-old-versions t) - (eq delete-old-versions nil)) - (or delete-old-versions - (y-or-n-p (format "Delete excess backup versions of %s? " - real-file-name)))))) - ;; Actually write the back up file. - (condition-case () - (if (or file-precious-flag - ; (file-symlink-p buffer-file-name) - backup-by-copying - (and backup-by-copying-when-linked - (> (file-nlinks real-file-name) 1)) - (and backup-by-copying-when-mismatch - (let ((attr (file-attributes real-file-name))) - (or (nth 9 attr) - (not (file-ownership-preserved-p real-file-name)))))) - (condition-case () - (copy-file real-file-name backupname t t) - (file-error - ;; If copying fails because file BACKUPNAME - ;; is not writable, delete that file and try again. - (if (and (file-exists-p backupname) - (not (file-writable-p backupname))) - (delete-file backupname)) - (copy-file real-file-name backupname t t))) - ;; rename-file should delete old backup. - (rename-file real-file-name backupname t) - (setq setmodes (file-modes backupname))) - (file-error - ;; If trouble writing the backup, write it in ~. - (setq backupname (expand-file-name "~/%backup%~")) - (message "Cannot write backup file; backing up in ~/%%backup%%~") - (sleep-for 1) - (condition-case () - (copy-file real-file-name backupname t t) - (file-error - ;; If copying fails because file BACKUPNAME - ;; is not writable, delete that file and try again. - (if (and (file-exists-p backupname) - (not (file-writable-p backupname))) - (delete-file backupname)) - (copy-file real-file-name backupname t t))))) - (setq buffer-backed-up t) - ;; Now delete the old versions, if desired. - (if delete-old-versions - (while targets - (ignore-file-errors (delete-file (car targets))) - (setq targets (cdr targets)))) - setmodes) - (file-error nil))))))))) - -(defun file-name-sans-versions (name &optional keep-backup-version) - "Return FILENAME sans backup versions or strings. -This is a separate procedure so your site-init or startup file can -redefine it. -If the optional argument KEEP-BACKUP-VERSION is non-nil, -we do not remove backup version numbers, only true file version numbers." - (let ((handler (find-file-name-handler name 'file-name-sans-versions))) - (if handler - (funcall handler 'file-name-sans-versions name keep-backup-version) - (substring name 0 - (if keep-backup-version - (length name) - (or (string-match "\\.~[0-9.]+~\\'" name) - ;; XEmacs - VC uses extensions like ".~tagname~" or ".~1.1.5.2~" - (let ((pos (string-match "\\.~\\([^.~ \t]+\\|[0-9.]+\\)~\\'" name))) - (and pos - ;; #### - is this filesystem check too paranoid? - (file-exists-p (substring name 0 pos)) - pos)) - (string-match "~\\'" name) - (length name))))))) - -(defun file-ownership-preserved-p (file) - "Return t if deleting FILE and rewriting it would preserve the owner." - (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) - (if handler - (funcall handler 'file-ownership-preserved-p file) - (let ((attributes (file-attributes file))) - ;; 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) (user-uid))))))) - -(defun file-name-sans-extension (filename) - "Return FILENAME sans final \"extension\". -The extension, in a file name, is the part that follows the last `.'." - (save-match-data - (let ((file (file-name-sans-versions (file-name-nondirectory filename))) - directory) - (if (string-match "\\.[^.]*\\'" file) - (if (setq directory (file-name-directory filename)) - (expand-file-name (substring file 0 (match-beginning 0)) - directory) - (substring file 0 (match-beginning 0))) - filename)))) - -(defun file-name-extension (filename &optional period) - "Return FILENAME's final \"extension\". -The extension, in a file name, is the part that follows the last `.'. -Return nil for extensionless file names such as `foo'. -Return the empty string for file names such as `foo.'. - -If PERIOD is non-nil, then the returned value includes the period -that delimits the extension, and if FILENAME has no extension, -the value is \"\"." - (save-match-data - (let ((file (file-name-sans-versions (file-name-nondirectory filename)))) - (if (string-match "\\.[^.]*\\'" file) - (substring file (+ (match-beginning 0) (if period 0 1))) - (if period - ""))))) - -(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 (eq system-type 'ms-dos) - (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 backup-file-name-p (file) - "Return non-nil if FILE is a backup file name (numeric or not). -This is a separate function so you can redefine it for customization. -You may need to redefine `file-name-sans-versions' as well." - (if (eq system-type 'ms-dos) - (string-match "\\.bak\\'" file) - (string-match "~\\'" file))) - -;; This is used in various files. -;; The usage of bv-length is not very clean, -;; but I can't see a good alternative, -;; so as of now I am leaving it alone. -(defun backup-extract-version (fn) - "Given the name of a numeric backup file, return the backup number. -Uses the free variable `bv-length', whose value should be -the index in the name where the version number begins." - (declare (special bv-length)) - (if (and (string-match "[0-9]+~\\'" fn bv-length) - (= (match-beginning 0) bv-length)) - (string-to-int (substring fn bv-length -1)) - 0)) - -(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 file-nlinks (filename) - "Return number of names file FILENAME has." - (car (cdr (file-attributes filename)))) - -(defun file-relative-name (filename &optional directory) - "Convert FILENAME to be relative to DIRECTORY (default: default-directory). -This function returns a relative file name which is equivalent to FILENAME -when used with that default directory as the default. -If this is impossible (which can happen on MSDOS and Windows -when the file name and directory use different drive names) -then it returns FILENAME." - (save-match-data - (let ((fname (expand-file-name filename))) - (setq directory (file-name-as-directory - (expand-file-name (or directory default-directory)))) - ;; On Microsoft OSes, if FILENAME and DIRECTORY have different - ;; drive names, they can't be relative, so return the absolute name. - (if (and (memq system-type '(ms-dos windows-nt)) - (not (string-equal (substring fname 0 2) - (substring directory 0 2)))) - filename - (let ((ancestor ".") - (fname-dir (file-name-as-directory fname))) - (while (and (not (string-match (concat "^" (regexp-quote directory)) - fname-dir)) - (not (string-match (concat "^" (regexp-quote directory)) fname))) - (setq directory (file-name-directory (substring directory 0 -1)) - ancestor (if (equal ancestor ".") - ".." - (concat "../" ancestor)))) - ;; Now ancestor is empty, or .., or ../.., etc. - (if (string-match (concat "^" (regexp-quote directory)) fname) - ;; We matched within FNAME's directory part. - ;; Add the rest of FNAME onto ANCESTOR. - (let ((rest (substring fname (match-end 0)))) - (if (and (equal ancestor ".") - (not (equal rest ""))) - ;; But don't bother with ANCESTOR if it would give us `./'. - rest - (concat (file-name-as-directory ancestor) rest))) - ;; We matched FNAME's directory equivalent. - ancestor)))))) - -(defun save-buffer (&optional args) - "Save current buffer in visited file if modified. Versions described below. - -By default, makes the previous version into a backup file - if previously requested or if this is the first save. -With 1 or 3 \\[universal-argument]'s, marks this version - to become a backup when the next save is done. -With 2 or 3 \\[universal-argument]'s, - unconditionally makes the previous version into a backup file. -With argument of 0, never makes the previous version into a backup file. - -If a file's name is FOO, the names of its numbered backup versions are - FOO.~i~ for various integers i. A non-numbered backup file is called FOO~. -Numeric backups (rather than FOO~) will be made if value of - `version-control' is not the atom `never' and either there are already - numeric versions of the file being backed up, or `version-control' is - non-nil. -We don't want excessive versions piling up, so there are variables - `kept-old-versions', which tells XEmacs how many oldest versions to keep, - and `kept-new-versions', which tells how many newest versions to keep. - Defaults are 2 old versions and 2 new. -`dired-kept-versions' controls dired's clean-directory (.) command. -If `delete-old-versions' is nil, system will query user - before trimming versions. Otherwise it does it silently." - (interactive "_p") - (let ((modp (buffer-modified-p)) - (large (> (buffer-size) 50000)) - (make-backup-files (or (and make-backup-files (not (eq args 0))) - (memq args '(16 64))))) - (and modp (memq args '(16 64)) (setq buffer-backed-up nil)) - (if (and modp large) (display-message - 'progress (format "Saving file %s..." - (buffer-file-name)))) - (basic-save-buffer) - (and modp (memq args '(4 64)) (setq buffer-backed-up nil)))) - -(defun delete-auto-save-file-if-necessary (&optional force) - "Delete auto-save file for current buffer if `delete-auto-save-files' is t. -Normally delete only if the file was written by this XEmacs -since the last real save, but optional arg FORCE non-nil means delete anyway." - (and buffer-auto-save-file-name delete-auto-save-files - (not (string= buffer-file-name buffer-auto-save-file-name)) - (or force (recent-auto-save-p)) - (progn - (ignore-file-errors (delete-file buffer-auto-save-file-name)) - (set-buffer-auto-saved)))) - -;; XEmacs change (from Sun) -;; used to communicate with continue-save-buffer: -(defvar continue-save-buffer-hooks-tail nil) - -;; Not in FSFmacs -(defun basic-write-file-data (realname truename) - ;; call the hooks until the bytes are put - ;; call write-region as a last resort - (let ((region-written nil) - (hooks write-file-data-hooks)) - (while (and hooks (not region-written)) - (setq region-written (funcall (car hooks) realname) - hooks (cdr hooks))) - (if (not region-written) - (write-region (point-min) (point-max) realname nil t truename)))) - -(put 'after-save-hook 'permanent-local t) -(defvar after-save-hook nil - "Normal hook that is run after a buffer is saved to its file. -These hooks are considered to pertain to the visited file. -So this list is cleared if you change the visited file name.") - -(defun files-fetch-hook-value (hook) - (let ((localval (symbol-value hook)) - (globalval (default-value hook))) - (if (memq t localval) - (setq localval (append (delq t localval) (delq t globalval)))) - localval)) - -(defun basic-save-buffer () - "Save the current buffer in its visited file, if it has been modified. -After saving the buffer, run `after-save-hook'." - (interactive) - (save-excursion - ;; In an indirect buffer, save its base buffer instead. - (if (buffer-base-buffer) - (set-buffer (buffer-base-buffer))) - (if (buffer-modified-p) - (let ((recent-save (recent-auto-save-p))) - ;; If buffer has no file name, ask user for one. - (or buffer-file-name - (let ((filename - (expand-file-name - (read-file-name "File to save in: ") nil))) - (and (file-exists-p filename) - (or (y-or-n-p (format "File `%s' exists; overwrite? " - filename)) - (error "Canceled"))) - (set-visited-file-name filename))) - (or (verify-visited-file-modtime (current-buffer)) - (not (file-exists-p buffer-file-name)) - (yes-or-no-p - (format "%s has changed since visited or saved. Save anyway? " - (file-name-nondirectory buffer-file-name))) - (error "Save not confirmed")) - (save-restriction - (widen) - (and (> (point-max) 1) - (/= (char-after (1- (point-max))) ?\n) - (not (and (eq selective-display t) - (= (char-after (1- (point-max))) ?\r))) - (or (eq require-final-newline t) - (and require-final-newline - (y-or-n-p - (format "Buffer %s does not end in newline. Add one? " - (buffer-name))))) - (save-excursion - (goto-char (point-max)) - (insert ?\n))) - ;; - ;; Run the write-file-hooks until one returns non-null. - ;; Bind after-save-hook to nil while running the - ;; write-file-hooks so that if this function is called - ;; recursively (from inside a write-file-hook) the - ;; after-hooks will only get run once (from the - ;; outermost call). - ;; - ;; Ugh, have to duplicate logic of run-hook-with-args-until-success - (let ((hooks (append (files-fetch-hook-value 'write-contents-hooks) - (files-fetch-hook-value - 'local-write-file-hooks) - (files-fetch-hook-value 'write-file-hooks))) - (after-save-hook nil) - (local-write-file-hooks nil) - (write-contents-hooks nil) - (write-file-hooks nil) - done) - (while (and hooks - (let ((continue-save-buffer-hooks-tail hooks)) - (not (setq done (funcall (car hooks)))))) - (setq hooks (cdr hooks))) - ;; If a hook returned t, file is already "written". - ;; Otherwise, write it the usual way now. - (if (not done) - (basic-save-buffer-1))) - ;; XEmacs: next two clauses (buffer-file-number setting and - ;; set-file-modes) moved into basic-save-buffer-1. - ) - ;; If the auto-save file was recent before this command, - ;; delete it now. - (delete-auto-save-file-if-necessary recent-save) - ;; Support VC `implicit' locking. - (when (fboundp 'vc-after-save) - (vc-after-save)) - (run-hooks 'after-save-hook)) - (display-message 'no-log "(No changes need to be saved)")))) - -;; This does the "real job" of writing a buffer into its visited file -;; and making a backup file. This is what is normally done -;; but inhibited if one of write-file-hooks returns non-nil. -;; It returns a value to store in setmodes. -(defun basic-save-buffer-1 () - (let (setmodes tempsetmodes) - (if (not (file-writable-p buffer-file-name)) - (let ((dir (file-name-directory buffer-file-name))) - (if (not (file-directory-p dir)) - (error "%s is not a directory" dir) - (if (not (file-exists-p buffer-file-name)) - (error "Directory %s write-protected" dir) - (if (yes-or-no-p - (format "File %s is write-protected; try to save anyway? " - (file-name-nondirectory - buffer-file-name))) - (setq tempsetmodes t) - (error - "Attempt to save to a file which you aren't allowed to write")))))) - (or buffer-backed-up - (setq setmodes (backup-buffer))) - (let ((dir (file-name-directory buffer-file-name))) - (if (and file-precious-flag - (file-writable-p dir)) - ;; If file is precious, write temp name, then rename it. - ;; This requires write access to the containing dir, - ;; which is why we don't try it if we don't have that access. - (let ((realname buffer-file-name) - tempname nogood i succeed - (old-modtime (visited-file-modtime))) - (setq i 0) - (setq nogood t) - ;; Find the temporary name to write under. - (while nogood - (setq tempname (format "%s#tmp#%d" dir i)) - (setq nogood (file-exists-p tempname)) - (setq i (1+ i))) - (unwind-protect - (progn (clear-visited-file-modtime) - (write-region (point-min) (point-max) - tempname nil realname - buffer-file-truename) - (setq succeed t)) - ;; If writing the temp file fails, - ;; delete the temp file. - (or succeed - (progn - (delete-file tempname) - (set-visited-file-modtime old-modtime)))) - ;; Since we have created an entirely new file - ;; and renamed it, make sure it gets the - ;; right permission bits set. - (setq setmodes (file-modes buffer-file-name)) - ;; We succeeded in writing the temp file, - ;; so rename it. - (rename-file tempname buffer-file-name t)) - ;; If file not writable, see if we can make it writable - ;; temporarily while we write it. - ;; But no need to do so if we have just backed it up - ;; (setmodes is set) because that says we're superseding. - (cond ((and tempsetmodes (not setmodes)) - ;; Change the mode back, after writing. - (setq setmodes (file-modes buffer-file-name)) - (set-file-modes buffer-file-name 511))) - (basic-write-file-data buffer-file-name buffer-file-truename))) - (setq buffer-file-number - (if buffer-file-name - (nth 10 (file-attributes buffer-file-name)) - nil)) - (if setmodes - (condition-case () - (set-file-modes buffer-file-name setmodes) - (error nil))))) - -;; XEmacs change, from Sun -(defun continue-save-buffer () - "Provide a clean way for a write-file-hook to wrap AROUND -the execution of the remaining hooks and writing to disk. -Do not call this function except from a functions -on the write-file-hooks or write-contents-hooks list. -A hook that calls this function must return non-nil, -to signal completion to its caller. continue-save-buffer -always returns non-nil." - (let ((hooks (cdr (or continue-save-buffer-hooks-tail - (error - "continue-save-buffer called outside a write-file-hook!")))) - (done nil)) - ;; Do something like this: - ;; (let ((write-file-hooks hooks)) (basic-save-buffer)) - ;; First run the rest of the hooks. - (while (and hooks - (let ((continue-save-buffer-hooks-tail hooks)) - (not (setq done (funcall (car hooks)))))) - (setq hooks (cdr hooks))) - ;; - ;; If a hook returned t, file is already "written". - (if (not done) - (basic-save-buffer-1)) - 'continue-save-buffer)) - -(defcustom save-some-buffers-query-display-buffer t - "*Non-nil makes `\\[save-some-buffers]' switch to the buffer offered for saving." - :type 'boolean - :group 'editing-basics) - -(defun save-some-buffers (&optional arg exiting) - "Save some modified file-visiting buffers. Asks user about each one. -Optional argument (the prefix) non-nil means save all with no questions. -Optional second argument EXITING means ask about certain non-file buffers - as well as about file buffers." - (interactive "P") - (save-excursion - ;; `delete-other-windows' can bomb during autoloads generation, so - ;; guard it well. - (if (or noninteractive - (eq (selected-window) (minibuffer-window)) - (not save-some-buffers-query-display-buffer)) - ;; If playing with windows is unsafe or undesired, just do the - ;; usual drill. - (save-some-buffers-1 arg exiting nil) - ;; Else, protect the windows. - (when (save-window-excursion - (save-some-buffers-1 arg exiting t)) - ;; Force redisplay. - (sit-for 0))))) - -;; XEmacs - do not use queried flag -(defun save-some-buffers-1 (arg exiting switch-buffer) - (let* ((switched nil) - (files-done - (map-y-or-n-p - (lambda (buffer) - (and (buffer-modified-p buffer) - (not (buffer-base-buffer buffer)) - ;; XEmacs addition: - (not (symbol-value-in-buffer 'save-buffers-skip buffer)) - (or - (buffer-file-name buffer) - (and exiting - (progn - (set-buffer buffer) - (and buffer-offer-save (> (buffer-size) 0))))) - (if arg - t - ;; #### We should provide a per-buffer means to - ;; disable the switching. For instance, you might - ;; want to turn it off for buffers the contents of - ;; which is meaningless to humans, such as - ;; `.newsrc.eld'. - (when switch-buffer - (unless (one-window-p) - (delete-other-windows)) - (setq switched t) - ;; #### Consider using `display-buffer' here for 21.1! - ;;(display-buffer buffer nil (selected-frame))) - (switch-to-buffer buffer t)) - (if (buffer-file-name buffer) - (format "Save file %s? " - (buffer-file-name buffer)) - (format "Save buffer %s? " - (buffer-name buffer)))))) - (lambda (buffer) - (set-buffer buffer) - (condition-case () - (save-buffer) - (error nil))) - (buffer-list) - '("buffer" "buffers" "save") - ;;instead of this we just say "yes all", "no all", etc. - ;;"save all the rest" - ;;"save only this buffer" "save no more buffers") - ;; this is rather bogus. --ben - ;; (it makes the dialog box too big, and you get an error - ;; "wrong type argument: framep, nil" when you hit q after - ;; choosing the option from the dialog box) - - ;; We should fix the dialog box rather than disabling - ;; this! --hniksic - (list (list ?\C-r (lambda (buf) - ;; #### FSF has an EXIT-ACTION argument - ;; to `view-buffer'. - (view-buffer buf) - (setq view-exit-action - (lambda (ignore) - (exit-recursive-edit))) - (recursive-edit) - ;; Return nil to ask about BUF again. - nil) - "display the current buffer")))) - (abbrevs-done - (and save-abbrevs abbrevs-changed - (progn - (if (or arg - (y-or-n-p (format "Save abbrevs in %s? " abbrev-file-name))) - (write-abbrev-file nil)) - ;; Don't keep bothering user if he says no. - (setq abbrevs-changed nil) - t)))) - (or (> files-done 0) abbrevs-done - (display-message 'no-log "(No files need saving)")) - switched)) - - -(defun not-modified (&optional arg) - "Mark current buffer as unmodified, not needing to be saved. -With prefix arg, mark buffer as modified, so \\[save-buffer] will save. - -It is not a good idea to use this function in Lisp programs, because it -prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." - (interactive "_P") - (if arg ;; rewritten for I18N3 snarfing - (display-message 'command "Modification-flag set") - (display-message 'command "Modification-flag cleared")) - (set-buffer-modified-p arg)) - -(defun toggle-read-only (&optional arg) - "Toggle the current buffer's read-only status. -With arg, set read-only iff arg is positive." - (interactive "_P") - (setq buffer-read-only - (if (null arg) - (not buffer-read-only) - (> (prefix-numeric-value arg) 0))) - ;; Force modeline redisplay - (redraw-modeline)) - -(defun insert-file (filename &optional codesys) - "Insert 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)." - (interactive "*fInsert file: \nZCoding system: ") - (if (file-directory-p filename) - (signal 'file-error (list "Opening input file" "file is a directory" - filename))) - (let ((tem - (if codesys - (let ((coding-system-for-read - (get-coding-system codesys))) - (insert-file-contents filename)) - (insert-file-contents filename)))) - (push-mark (+ (point) (car (cdr tem)))))) - -(defun append-to-file (start end filename &optional codesys) - "Append the contents of the region to the end of file FILENAME. -When called from a function, expects three arguments, -START, END and FILENAME. START and END are buffer positions -saying what text to write. -Under XEmacs/Mule, optional fourth argument specifies the -coding system to use when encoding the file. Interactively, -with a prefix argument, you will be prompted for the coding system." - (interactive "r\nFAppend to file: \nZCoding system: ") - (if codesys - (let ((buffer-file-coding-system (get-coding-system codesys))) - (write-region start end filename t)) - (write-region start end filename t))) - -(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) - (while comp - (setq file (concat dir (car comp)) - comp (cdr comp)) - (if (and (backup-file-name-p file) - (or (null newest) (file-newer-than-file-p file newest))) - (setq newest file))) - newest)) - -(defun rename-uniquely () - "Rename current buffer to a similar name not already taken. -This function is useful for creating multiple shell process buffers -or multiple mail buffers, etc." - (interactive) - (save-match-data - (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name)) - (not (and buffer-file-name - (string= (buffer-name) - (file-name-nondirectory - buffer-file-name))))) - ;; If the existing buffer name has a , - ;; which isn't part of the file name (if any), - ;; then get rid of that. - (substring (buffer-name) 0 (match-beginning 0)) - (buffer-name))) - (new-buf (generate-new-buffer base-name)) - (name (buffer-name new-buf))) - (kill-buffer new-buf) - (rename-buffer name) - (redraw-modeline)))) - -(defun make-directory-path (path) - "Create all the directories along path that don't exist yet." - (interactive "Fdirectory path to create: ") - (make-directory path t)) - -(defun make-directory (dir &optional parents) - "Create the directory DIR and any nonexistent parent dirs. -Interactively, the default choice of directory to create -is the current default directory for file names. -That is useful when you have visited a file in a nonexistent directory. - -Noninteractively, the second (optional) argument PARENTS says whether -to create parent directories if they don't exist." - (interactive (list (let ((current-prefix-arg current-prefix-arg)) - (read-directory-name "Create directory: ")) - current-prefix-arg)) - (let ((handler (find-file-name-handler dir 'make-directory))) - (if handler - (funcall handler 'make-directory dir parents) - (if (not parents) - (make-directory-internal dir) - (let ((dir (directory-file-name (expand-file-name dir))) - create-list) - (while (not (file-exists-p dir)) - (setq create-list (cons dir create-list) - dir (directory-file-name (file-name-directory dir)))) - (while create-list - (make-directory-internal (car create-list)) - (setq create-list (cdr create-list)))))))) - -(put 'revert-buffer-function 'permanent-local t) -(defvar revert-buffer-function nil - "Function to use to revert this buffer, or nil to do the default. -The function receives two arguments IGNORE-AUTO and NOCONFIRM, -which are the arguments that `revert-buffer' received.") - -(put 'revert-buffer-insert-file-contents-function 'permanent-local t) -(defvar revert-buffer-insert-file-contents-function nil - "Function to use to insert contents when reverting this buffer. -Gets two args, first the nominal file name to use, -and second, t if reading the auto-save file.") - -(defvar before-revert-hook nil - "Normal hook for `revert-buffer' to run before reverting. -If `revert-buffer-function' is used to override the normal revert -mechanism, this hook is not used.") - -(defvar after-revert-hook nil - "Normal hook for `revert-buffer' to run after reverting. -Note that the hook value that it runs is the value that was in effect -before reverting; that makes a difference if you have buffer-local -hook functions. - -If `revert-buffer-function' is used to override the normal revert -mechanism, this hook is not used.") - -(defvar revert-buffer-internal-hook nil - "Don't use this.") - -(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes) - "Replace the buffer text with the text of the visited file on disk. -This undoes all changes since the file was visited or saved. -With a prefix argument, offer to revert from latest auto-save file, if -that is more recent than the visited file. - -This command also works for special buffers that contain text which -doesn't come from a file, but reflects some other data base instead: -for example, Dired buffers and buffer-list buffers. In these cases, -it reconstructs the buffer contents from the appropriate data base. - -When called from Lisp, the first argument is IGNORE-AUTO; only offer -to revert from the auto-save file when this is nil. Note that the -sense of this argument is the reverse of the prefix argument, for the -sake of backward compatibility. IGNORE-AUTO is optional, defaulting -to nil. - -Optional second argument NOCONFIRM means don't ask for confirmation at -all. - -Optional third argument PRESERVE-MODES non-nil means don't alter -the files modes. Normally we reinitialize them using `normal-mode'. - -If the value of `revert-buffer-function' is non-nil, it is called to -do all the work for this command. Otherwise, the hooks -`before-revert-hook' and `after-revert-hook' are run at the beginning -and the end, and if `revert-buffer-insert-file-contents-function' is -non-nil, it is called instead of rereading visited file contents." - - ;; I admit it's odd to reverse the sense of the prefix argument, but - ;; there is a lot of code out there which assumes that the first - ;; argument should be t to avoid consulting the auto-save file, and - ;; there's no straightforward way to encourage authors to notice a - ;; reversal of the argument sense. So I'm just changing the user - ;; interface, but leaving the programmatic interface the same. - (interactive (list (not current-prefix-arg))) - (if revert-buffer-function - (funcall revert-buffer-function ignore-auto noconfirm) - (let* ((opoint (point)) - (auto-save-p (and (not ignore-auto) - (recent-auto-save-p) - buffer-auto-save-file-name - (file-readable-p buffer-auto-save-file-name) - (y-or-n-p - "Buffer has been auto-saved recently. Revert from auto-save file? "))) - (file-name (if auto-save-p - buffer-auto-save-file-name - buffer-file-name))) - (cond ((null file-name) - (error "Buffer does not seem to be associated with any file")) - ((or noconfirm - (and (not (buffer-modified-p)) - (let (found) - (dolist (rx revert-without-query found) - (when (string-match rx file-name) - (setq found t))))) - (yes-or-no-p (format "Revert buffer from file %s? " - file-name))) - (run-hooks 'before-revert-hook) - ;; If file was backed up but has changed since, - ;; we shd make another backup. - (and (not auto-save-p) - (not (verify-visited-file-modtime (current-buffer))) - (setq buffer-backed-up nil)) - ;; Get rid of all undo records for this buffer. - (or (eq buffer-undo-list t) - (setq buffer-undo-list nil)) - ;; Effectively copy the after-revert-hook status, - ;; since after-find-file will clobber it. - (let ((global-hook (default-value 'after-revert-hook)) - (local-hook-p (local-variable-p 'after-revert-hook - (current-buffer))) - (local-hook (and (local-variable-p 'after-revert-hook - (current-buffer)) - after-revert-hook))) - (let (buffer-read-only - ;; Don't make undo records for the reversion. - (buffer-undo-list t)) - (if revert-buffer-insert-file-contents-function - (funcall revert-buffer-insert-file-contents-function - file-name auto-save-p) - (if (not (file-exists-p file-name)) - (error "File %s no longer exists!" file-name)) - ;; Bind buffer-file-name to nil - ;; so that we don't try to lock the file. - (let ((buffer-file-name nil)) - (or auto-save-p - (unlock-buffer))) - (widen) - (insert-file-contents file-name (not auto-save-p) - nil nil t))) - (goto-char (min opoint (point-max))) - ;; Recompute the truename in case changes in symlinks - ;; have changed the truename. - ;XEmacs: already done by insert-file-contents - ;;(setq buffer-file-truename - ;;(abbreviate-file-name (file-truename buffer-file-name))) - (after-find-file nil nil t t preserve-modes) - ;; Run after-revert-hook as it was before we reverted. - (setq-default revert-buffer-internal-hook global-hook) - (if local-hook-p - (progn - (make-local-variable 'revert-buffer-internal-hook) - (setq revert-buffer-internal-hook local-hook)) - (kill-local-variable 'revert-buffer-internal-hook)) - (run-hooks 'revert-buffer-internal-hook)) - t))))) - -(defun recover-file (file) - "Visit file FILE, but get contents from its last auto-save file." - ;; Actually putting the file name in the minibuffer should be used - ;; only rarely. - ;; Not just because users often use the default. - (interactive "FRecover file: ") - (setq file (expand-file-name file)) - (let ((handler (or (find-file-name-handler file 'recover-file) - (find-file-name-handler - (let ((buffer-file-name file)) - (make-auto-save-file-name)) - 'recover-file)))) - (if handler - (funcall handler 'recover-file file) - (if (auto-save-file-name-p file) - (error "%s is an auto-save file" file)) - (let ((file-name (let ((buffer-file-name file)) - (make-auto-save-file-name)))) - (cond ((if (file-exists-p file) - (not (file-newer-than-file-p file-name file)) - (not (file-exists-p file-name))) - (error "Auto-save file %s not current" file-name)) - ((save-window-excursion - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (call-process "ls" nil standard-output nil - (if (file-symlink-p file) "-lL" "-l") - file file-name)) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (switch-to-buffer (find-file-noselect file t)) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-file-contents file-name nil)) - (after-find-file nil nil t)) - (t (error "Recover-file cancelled."))))))) - -(defun recover-session () - "Recover auto save files from a previous Emacs session. -This command first displays a Dired buffer showing you the -previous sessions that you could recover from. -To choose one, move point to the proper line and then type C-c C-c. -Then you'll be asked about a number of files to recover." - (interactive) - (unless (fboundp 'dired) - (error "recover-session requires dired")) - (if (null auto-save-list-file-prefix) - (error - "You set `auto-save-list-file-prefix' to disable making session files")) - (dired (concat auto-save-list-file-prefix "*")) - (goto-char (point-min)) - (or (looking-at "Move to the session you want to recover,") - (let ((inhibit-read-only t)) - (insert "Move to the session you want to recover,\n" - "then type C-c C-c to select it.\n\n" - "You can also delete some of these files;\n" - "type d on a line to mark that file for deletion.\n\n"))) - (use-local-map (let ((map (make-sparse-keymap))) - (set-keymap-parents map (list (current-local-map))) - map)) - (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) - -(defun recover-session-finish () - "Choose one saved session to recover auto-save files from. -This command is used in the special Dired buffer created by -\\[recover-session]." - (interactive) - ;; Get the name of the session file to recover from. - (let ((file (dired-get-filename)) - files - (buffer (get-buffer-create " *recover*"))) - ;; #### dired-do-flagged-delete in FSF. - ;; This version is for ange-ftp - ;;(dired-do-deletions t) - ;; This version is for efs - (dired-expunge-deletions) - (unwind-protect - (save-excursion - ;; Read in the auto-save-list file. - (set-buffer buffer) - (erase-buffer) - (insert-file-contents file) - ;; Loop thru the text of that file - ;; and get out the names of the files to recover. - (while (not (eobp)) - (let (thisfile autofile) - (if (eolp) - ;; This is a pair of lines for a non-file-visiting buffer. - ;; Get the auto-save file name and manufacture - ;; a "visited file name" from that. - (progn - (forward-line 1) - (setq autofile - (buffer-substring-no-properties - (point) - (save-excursion - (end-of-line) - (point)))) - (setq thisfile - (expand-file-name - (substring - (file-name-nondirectory autofile) - 1 -1) - (file-name-directory autofile))) - (forward-line 1)) - ;; This pair of lines is a file-visiting - ;; buffer. Use the visited file name. - (progn - (setq thisfile - (buffer-substring-no-properties - (point) (progn (end-of-line) (point)))) - (forward-line 1) - (setq autofile - (buffer-substring-no-properties - (point) (progn (end-of-line) (point)))) - (forward-line 1))) - ;; Ignore a file if its auto-save file does not exist now. - (if (file-exists-p autofile) - (setq files (cons thisfile files))))) - (setq files (nreverse files)) - ;; The file contains a pair of line for each auto-saved buffer. - ;; The first line of the pair contains the visited file name - ;; or is empty if the buffer was not visiting a file. - ;; The second line is the auto-save file name. - (if files - (map-y-or-n-p "Recover %s? " - (lambda (file) - (condition-case nil - (save-excursion (recover-file file)) - (error - "Failed to recover `%s'" file))) - files - '("file" "files" "recover")) - (message "No files can be recovered from this session now"))) - (kill-buffer buffer)))) - -(defun kill-some-buffers (&optional list) - "For each buffer in LIST, ask whether to kill it. -LIST defaults to all existing live buffers." - (interactive) - (if (null list) - (setq list (buffer-list))) - (while list - (let* ((buffer (car list)) - (name (buffer-name buffer))) - (and (not (string-equal name "")) - (/= (aref name 0) ?\ ) - (yes-or-no-p - (format - (if (buffer-modified-p buffer) - (gettext "Buffer %s HAS BEEN EDITED. Kill? ") - (gettext "Buffer %s is unmodified. Kill? ")) - name)) - (kill-buffer buffer))) - (setq list (cdr list)))) - -(defun auto-save-mode (arg) - "Toggle auto-saving of contents of current buffer. -With prefix argument ARG, turn auto-saving on if positive, else off." - (interactive "P") - (setq buffer-auto-save-file-name - (and (if (null arg) - (or (not buffer-auto-save-file-name) - ;; If autosave is off because buffer has shrunk, - ;; then toggling should turn it on. - (< buffer-saved-size 0)) - (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0)))) - (if (and buffer-file-name auto-save-visited-file-name - (not buffer-read-only)) - buffer-file-name - (make-auto-save-file-name)))) - ;; If -1 was stored here, to temporarily turn off saving, - ;; turn it back on. - (and (< buffer-saved-size 0) - (setq buffer-saved-size 0)) - (if (interactive-p) - (if buffer-auto-save-file-name ;; rewritten for I18N3 snarfing - (display-message 'command "Auto-save on (in this buffer)") - (display-message 'command "Auto-save off (in this buffer)"))) - buffer-auto-save-file-name) - -(defun rename-auto-save-file () - "Adjust current buffer's auto save file name for current conditions. -Also rename any existing auto save file, if it was made in this session." - (let ((osave buffer-auto-save-file-name)) - (setq buffer-auto-save-file-name - (make-auto-save-file-name)) - (if (and osave buffer-auto-save-file-name - (not (string= buffer-auto-save-file-name buffer-file-name)) - (not (string= buffer-auto-save-file-name osave)) - (file-exists-p osave) - (recent-auto-save-p)) - (rename-file osave buffer-auto-save-file-name t)))) - -;; see also ../packages/auto-save.el -(defun make-auto-save-file-name (&optional filename) - "Return file name to use for auto-saves of current buffer. -Does not consider `auto-save-visited-file-name' as that variable is checked -before calling this function. You can redefine this for customization. -See also `auto-save-file-name-p'." - (let ((fname (or filename buffer-file-name)) - name) - (setq name - (if fname - (concat (file-name-directory fname) - "#" - (file-name-nondirectory fname) - "#") - - ;; Deal with buffers that don't have any associated files. (Mail - ;; mode tends to create a good number of these.) - - (let ((buffer-name (buffer-name)) - (limit 0)) - ;; Use technique from Sebastian Kremer's auto-save - ;; package to turn slashes into \\!. This ensures that - ;; the auto-save buffer name is unique. - - ;; #### - yuck! yuck! yuck! move this functionality - ;; somewhere else and make the name translation customizable. - ;; Using "\!" as part of a filename on a UNIX filesystem is nearly - ;; IMPOSSIBLE to get past a shell parser. -stig - - (while (string-match "[/\\]" buffer-name limit) - (setq buffer-name - (concat (substring buffer-name 0 (match-beginning 0)) - (if (string= (substring buffer-name - (match-beginning 0) - (match-end 0)) - "/") - "\\!" - "\\\\") - (substring buffer-name (match-end 0)))) - (setq limit (1+ (match-end 0)))) - - ;; (expand-file-name (format "#%s#%s#" (buffer-name) (make-temp-name ""))) - - ;; jwz: putting the emacs PID in the auto-save file name - ;; is bad news, because that defeats auto-save-recovery of - ;; *mail* buffers -- the (sensible) code in sendmail.el - ;; calls (make-auto-save-file-name) to determine whether - ;; there is unsent, auto-saved mail to recover. If that - ;; mail came from a previous emacs process (far and away - ;; the most likely case) then this can never succeed as - ;; the pid differs. - - (expand-file-name (format "#%s#" buffer-name))) - )) - ;; don't try to write auto-save files in unwritable places. Unless - ;; there's already an autosave file here, put ours somewhere safe. --Stig - (if (or (file-writable-p name) - (file-exists-p name)) - name - (expand-file-name (concat "~/" (file-name-nondirectory name)))))) - -(defun auto-save-file-name-p (filename) - "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. -FILENAME should lack slashes. -You can redefine this for customization." - (string-match "\\`#.*#\\'" filename)) - -(defun wildcard-to-regexp (wildcard) - "Given a shell file name pattern WILDCARD, return an equivalent regexp. -The generated regexp will match a filename iff the filename -matches that wildcard according to shell rules. Only wildcards known -by `sh' are supported." - (let* ((i (string-match "[[.*+\\^$?]" wildcard)) - ;; Copy the initial run of non-special characters. - (result (substring wildcard 0 i)) - (len (length wildcard))) - ;; If no special characters, we're almost done. - (if i - (while (< i len) - (let ((ch (aref wildcard i)) - j) - (setq - result - (concat result - (cond - ((eq ch ?\[) ; [...] maps to regexp char class - (progn - (setq i (1+ i)) - (concat - (cond - ((eq (aref wildcard i) ?!) ; [!...] -> [^...] - (progn - (setq i (1+ i)) - (if (eq (aref wildcard i) ?\]) - (progn - (setq i (1+ i)) - "[^]") - "[^"))) - ((eq (aref wildcard i) ?^) - ;; Found "[^". Insert a `\0' character - ;; (which cannot happen in a filename) - ;; into the character class, so that `^' - ;; is not the first character after `[', - ;; and thus non-special in a regexp. - (progn - (setq i (1+ i)) - "[\000^")) - ((eq (aref wildcard i) ?\]) - ;; I don't think `]' can appear in a - ;; character class in a wildcard, but - ;; let's be general here. - (progn - (setq i (1+ i)) - "[]")) - (t "[")) - (prog1 ; copy everything upto next `]'. - (substring wildcard - i - (setq j (string-match - "]" wildcard i))) - (setq i (if j (1- j) (1- len))))))) - ((eq ch ?.) "\\.") - ((eq ch ?*) "[^\000]*") - ((eq ch ?+) "\\+") - ((eq ch ?^) "\\^") - ((eq ch ?$) "\\$") - ((eq ch ?\\) "\\\\") ; probably cannot happen... - ((eq ch ??) "[^\000]") - (t (char-to-string ch))))) - (setq i (1+ i))))) - ;; Shell wildcards should match the entire filename, - ;; not its part. Make the regexp say so. - (concat "\\`" result "\\'"))) - -(defcustom list-directory-brief-switches "-CF" - "*Switches for list-directory to pass to `ls' for brief listing." - :type 'string - :group 'dired) - -(defcustom list-directory-verbose-switches "-l" - "*Switches for list-directory to pass to `ls' for verbose listing," - :type 'string - :group 'dired) - -(defun list-directory (dirname &optional verbose) - "Display a list of files in or matching DIRNAME, a la `ls'. -DIRNAME is globbed by the shell if necessary. -Prefix arg (second arg if noninteractive) means supply -l switch to `ls'. -Actions controlled by variables `list-directory-brief-switches' -and `list-directory-verbose-switches'." - (interactive (let ((pfx current-prefix-arg)) - (list (read-file-name (if pfx (gettext "List directory (verbose): ") - (gettext "List directory (brief): ")) - nil default-directory nil) - pfx))) - (let ((switches (if verbose list-directory-verbose-switches - list-directory-brief-switches))) - (or dirname (setq dirname default-directory)) - (setq dirname (expand-file-name dirname)) - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (princ "Directory ") - (princ dirname) - (terpri) - (save-excursion - (set-buffer "*Directory*") - (setq default-directory (file-name-directory dirname)) - (let ((wildcard (not (file-directory-p dirname)))) - (insert-directory dirname switches wildcard (not wildcard))))))) - -(defvar insert-directory-program "ls" - "Absolute or relative name of the `ls' program used by `insert-directory'.") - -;; insert-directory -;; - must insert _exactly_one_line_ describing FILE if WILDCARD and -;; FULL-DIRECTORY-P is nil. -;; The single line of output must display FILE's name as it was -;; given, namely, an absolute path name. -;; - must insert exactly one line for each file if WILDCARD or -;; FULL-DIRECTORY-P is t, plus one optional "total" line -;; before the file lines, plus optional text after the file lines. -;; Lines are delimited by "\n", so filenames containing "\n" are not -;; allowed. -;; File lines should display the basename. -;; - must be consistent with -;; - functions dired-move-to-filename, (these two define what a file line is) -;; dired-move-to-end-of-filename, -;; dired-between-files, (shortcut for (not (dired-move-to-filename))) -;; dired-insert-headerline -;; dired-after-subdir-garbage (defines what a "total" line is) -;; - variable dired-subdir-regexp -(defun insert-directory (file switches &optional wildcard full-directory-p) - "Insert directory listing for FILE, formatted according to SWITCHES. -Leaves point after the inserted text. -SWITCHES may be a string of options, or a list of strings. -Optional third arg WILDCARD means treat FILE as shell wildcard. -Optional fourth arg FULL-DIRECTORY-P means file is a directory and -switches do not contain `d', so that a full listing is expected. - -This works by running a directory listing program -whose name is in the variable `insert-directory-program'. -If WILDCARD, it also runs the shell specified by `shell-file-name'." - ;; We need the directory in order to find the right handler. - (let ((handler (find-file-name-handler (expand-file-name file) - 'insert-directory))) - (if handler - (funcall handler 'insert-directory file switches - wildcard full-directory-p) - (cond - ((and (fboundp 'mswindows-insert-directory) - (eq system-type 'windows-nt)) - (mswindows-insert-directory file switches wildcard full-directory-p)) - (t - (if wildcard - ;; Run ls in the directory of the file pattern we asked for. - (let ((default-directory - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))) - (pattern (file-name-nondirectory file)) - (beg 0)) - ;; Quote some characters that have special meanings in shells; - ;; but don't quote the wildcards--we want them to be special. - ;; We also currently don't quote the quoting characters - ;; in case people want to use them explicitly to quote - ;; wildcard characters. - ;;#### Unix-specific - (while (string-match "[ \t\n;<>&|()#$]" pattern beg) - (setq pattern - (concat (substring pattern 0 (match-beginning 0)) - "\\" - (substring pattern (match-beginning 0))) - beg (1+ (match-end 0)))) - (call-process shell-file-name nil t nil - "-c" (concat "\\" ;; Disregard shell aliases! - insert-directory-program - " -d " - (if (stringp switches) - switches - (mapconcat 'identity switches " ")) - " " - pattern))) - ;; SunOS 4.1.3, SVr4 and others need the "." to list the - ;; directory if FILE is a symbolic link. - (apply 'call-process - insert-directory-program nil t nil - (let (list) - (if (listp switches) - (setq list switches) - (if (not (equal switches "")) - (progn - ;; Split the switches at any spaces - ;; so we can pass separate options as separate args. - (while (string-match " " switches) - (setq list (cons (substring switches 0 (match-beginning 0)) - list) - switches (substring switches (match-end 0)))) - (setq list (cons switches list))))) - (append list - (list - (if full-directory-p - (concat (file-name-as-directory file) - ;;#### Unix-specific - ".") - file))))))))))) - -(defvar kill-emacs-query-functions nil - "Functions to call with no arguments to query about killing XEmacs. -If any of these functions returns nil, killing Emacs is cancelled. -`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions, -but `kill-emacs', the low level primitive, does not. -See also `kill-emacs-hook'.") - -(defun save-buffers-kill-emacs (&optional arg) - "Offer to save each buffer, then kill this XEmacs process. -With prefix arg, silently save all file-visiting buffers, then kill." - (interactive "P") - (save-some-buffers arg t) - (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; 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) - (save-excursion - (save-window-excursion - (delete-other-windows) - (list-processes) - (yes-or-no-p - "Active processes exist; kill them and exit anyway? ")))))) - ;; Query the user for other things, perhaps. - (run-hook-with-args-until-failure 'kill-emacs-query-functions) - (kill-emacs))) - -(defun symlink-expand-file-name (filename) - "If FILENAME is a symlink, return its non-symlink equivalent. -Unlike `file-truename', this doesn't chase symlinks in directory -components of the file or expand a relative pathname into an -absolute one." - (let ((count 20)) - (while (and (> count 0) (file-symlink-p filename)) - (setq filename (file-symlink-p filename) - count (1- count))) - (if (> count 0) - filename - (error "Apparently circular symlink path")))) - -;; Suggested by Michael Kifer -(defun file-remote-p (file-name) - "Test whether FILE-NAME is looked for on a remote system." - (cond ((not allow-remote-paths) nil) - ((featurep 'ange-ftp) (ange-ftp-ftp-path file-name)) - ((fboundp 'efs-ftp-path) (efs-ftp-path file-name)) - (t nil))) - -;; #### FSF has file-name-non-special here. - -;;; files.el ends here diff --git a/lisp/fill.el b/lisp/fill.el deleted file mode 100644 index 780d6e6..0000000 --- a/lisp/fill.el +++ /dev/null @@ -1,1078 +0,0 @@ -;;; fill.el --- fill commands for XEmacs. - -;; Copyright (C) 1985, 86, 92, 94, 95, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: wp, dumped - -;; 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 file is dumped with XEmacs. - -;; All the commands for filling text. These are documented in the XEmacs -;; Reference Manual. - -;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added functions for kinsoku (asian text -;; line break processing) -;; 97/06/11 Steve Baur (steve@altair.xemacs.org) converted broken -;; following-char/preceding-char calls to char-after/char-before. - -;;; Code: - -(defgroup fill nil - "Indenting and filling text." - :group 'editing) - -(defcustom fill-individual-varying-indent nil - "*Controls criterion for a new paragraph in `fill-individual-paragraphs'. -Non-nil means changing indent doesn't end a paragraph. -That mode can handle paragraphs with extra indentation on the first line, -but it requires separator lines between paragraphs. -A value of nil means that any change in indentation starts a new paragraph." - :type 'boolean - :group 'fill) - -(defcustom sentence-end-double-space t - "*Non-nil means a single space does not end a sentence. -This variable applies only to filling, not motion commands. To -change the behavior of motion commands, see `sentence-end'." - :type 'boolean - :group 'fill) - -(defcustom colon-double-space nil - "*Non-nil means put two spaces after a colon when filling." - :type 'boolean - :group 'fill) - -(defvar fill-paragraph-function nil - "Mode-specific function to fill a paragraph, or nil if there is none. -If the function returns nil, then `fill-paragraph' does its normal work.") - -(defun set-fill-prefix () - "Set the fill prefix to the current line up to point. -Filling expects lines to start with the fill prefix and -reinserts the fill prefix in each resulting line." - (interactive) - (setq fill-prefix (buffer-substring - (save-excursion (move-to-left-margin) (point)) - (point))) - (if (equal fill-prefix "") - (setq fill-prefix nil)) - (if fill-prefix - (message "fill-prefix: \"%s\"" fill-prefix) - (message "fill-prefix cancelled"))) - -(defcustom adaptive-fill-mode t - "*Non-nil means determine a paragraph's fill prefix from its text." - :type 'boolean - :group 'fill) - -;; #### - this is still weak. Yeah, there's filladapt, but this should -;; still be better... --Stig -(defcustom adaptive-fill-regexp (purecopy "[ \t]*\\([#;>*]+ +\\)?") - "*Regexp to match text at start of line that constitutes indentation. -If Adaptive Fill mode is enabled, whatever text matches this pattern -on the second line of a paragraph is used as the standard indentation -for the paragraph. If the paragraph has just one line, the indentation -is taken from that line." - :type 'regexp - :group 'fill) - -(defcustom adaptive-fill-function nil - "*Function to call to choose a fill prefix for a paragraph. -This function is used when `adaptive-fill-regexp' does not match." - :type 'function - :group 'fill) - -;; Added for kinsoku processing. Use this instead of -;; (skip-chars-backward "^ \t\n") -;; (skip-chars-backward "^ \n" linebeg) -(defun fill-move-backward-to-break-point (regexp &optional lim) - (let ((opoint (point))) - ;; 93.8.23 by kawamoto@ics.es.osaka-u.ac.jp - ;; case of first 'word' being longer than fill-column - (if (not (re-search-backward regexp lim 'move)) - nil - ;; we have skipped backward SPC or WAN (word-across-newline). So move point forward again. - (forward-char) - (if (< opoint (point)) - (forward-char -1))))) - -;; Added for kinsoku processing. Use instead of -;; (re-search-forward "[ \t]" opoint t) -;; (skip-chars-forward "^ \n") -;; (skip-chars-forward "^ \n") -(defun fill-move-forward-to-break-point (regexp &optional lim) - (let ((opoint (point))) - (if (not (re-search-forward regexp lim 'move)) - nil - (forward-char -1) - (if (< (point) opoint) - (forward-char)))) - (if (featurep 'mule) (kinsoku-process-extend))) - -(defun fill-end-of-sentence-p () - (save-excursion - (skip-chars-backward " ]})\"'") - (memq (char-before (point)) '(?. ?? ?!)))) - -(defun current-fill-column () - "Return the fill-column to use for this line. -The fill-column to use for a buffer is stored in the variable `fill-column', -but can be locally modified by the `right-margin' text property, which is -subtracted from `fill-column'. - -The fill column to use for a line is the first column at which the column -number equals or exceeds the local fill-column - right-margin difference." - (save-excursion - (if fill-column - (let* ((here (progn (beginning-of-line) (point))) - (here-col 0) - (eol (progn (end-of-line) (point))) - margin fill-col change col) - ;; Look separately at each region of line with a different right-margin. - (while (and (setq margin (get-text-property here 'right-margin) - fill-col (- fill-column (or margin 0)) - change (text-property-not-all - here eol 'right-margin margin)) - (progn (goto-char (1- change)) - (setq col (current-column)) - (< col fill-col))) - (setq here change - here-col col)) - (max here-col fill-col))))) - -(defun canonically-space-region (beg end) - "Remove extra spaces between words in region. -Leave one space between words, two at end of sentences or after colons -\(depending on values of `sentence-end-double-space' and `colon-double-space'). -Remove indentation from each line." - (interactive "r") - ;;;### 97/3/14 jhod: Do I have to add anything here for kinsoku? - (save-excursion - (goto-char beg) - ;; XEmacs - (ENE/stig from fa-extras.el): Skip the start of a comment. - (and comment-start-skip - (looking-at comment-start-skip) - (goto-char (match-end 0))) - ;; Nuke tabs; they get screwed up in a fill. - ;; This is quick, but loses when a tab follows the end of a sentence. - ;; Actually, it is difficult to tell that from "Mr.\tSmith". - ;; Blame the typist. - (subst-char-in-region beg end ?\t ?\ ) - (while (and (< (point) end) - (re-search-forward " *" end t)) - (delete-region - (+ (match-beginning 0) - ;; Determine number of spaces to leave: - (save-excursion - (skip-chars-backward " ]})\"'") - (cond ((and sentence-end-double-space - (memq (char-before (point)) '(?. ?? ?!))) 2) - ((and colon-double-space - (eq (char-before (point)) ?:)) 2) - ((char-equal (char-before (point)) ?\n) 0) - (t 1)))) - (match-end 0))) - ;; Make sure sentences ending at end of line get an extra space. - ;; loses on split abbrevs ("Mr.\nSmith") - (goto-char beg) - (while (and (< (point) end) - (re-search-forward "[.?!][])}\"']*$" end t)) - ;; We insert before markers in case a caller such as - ;; do-auto-fill has done a save-excursion with point at the end - ;; of the line and wants it to stay at the end of the line. - (insert ? )))) -;; XEmacs: we don't have this function. -;; (insert-before-markers-and-inherit ? )))) - -;; XEmacs -- added DONT-SKIP-FIRST. Port of older code changes by Stig. -;; #### probably this junk is broken -- do-auto-fill doesn't actually use -;; it. If so, it should be removed. - -(defun fill-context-prefix (from to &optional first-line-regexp - dont-skip-first) - "Compute a fill prefix from the text between FROM and TO. -This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'. -If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the -first line, insist it must match FIRST-LINE-REGEXP." - (save-excursion - (goto-char from) - (if (eolp) (forward-line 1)) - ;; Move to the second line unless there is just one. - (let ((firstline (point)) - ;; Non-nil if we are on the second line. - at-second - result) - ;; XEmacs change - (if (not dont-skip-first) - (forward-line 1)) - (if (>= (point) to) - (goto-char firstline) - (setq at-second t)) - (move-to-left-margin) - ;; XEmacs change - (let ((start (point)) - ; jhod: no longer used? - ;(eol (save-excursion (end-of-line) (point))) - ) - (setq result - (if (not (looking-at paragraph-start)) - (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) - (buffer-substring-no-properties start (match-end 0))) - (adaptive-fill-function (funcall adaptive-fill-function))))) - (and result - (or at-second - (null first-line-regexp) - (string-match first-line-regexp result)) - result))))) - -;; XEmacs (stig) - this is pulled out of fill-region-as-paragraph so that it -;; can also be called from do-auto-fill -;; #### But it's not used there. Chuck pulled it out because it broke things. -(defun maybe-adapt-fill-prefix (&optional from to dont-skip-first) - (if (and adaptive-fill-mode - (or (null fill-prefix) (string= fill-prefix ""))) - (setq fill-prefix (fill-context-prefix from to nil dont-skip-first)))) - -(defun fill-region-as-paragraph (from to &optional justify - nosqueeze squeeze-after) - "Fill the region as one paragraph. -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 - (progn - ;; XEmacs addition: - (barf-if-buffer-read-only nil (region-beginning) (region-end)) - (list (region-beginning) (region-end) - (if current-prefix-arg 'full)))) - ;; Arrange for undoing the fill to restore point. - (if (and buffer-undo-list (not (eq buffer-undo-list t))) - (setq buffer-undo-list (cons (point) buffer-undo-list))) - - ;; Make sure "to" is the endpoint. - (goto-char (min from to)) - (setq to (max from to)) - ;; Ignore blank lines at beginning of region. - (skip-chars-forward " \t\n") - - (let ((from-plus-indent (point)) - (oneleft nil)) - - (beginning-of-line) - (setq from (point)) - - ;; Delete all but one soft newline at end of region. - ;; And leave TO before that one. - (goto-char to) - (while (and (> (point) from) (eq ?\n (char-after (1- (point))))) - (if (and oneleft - (not (and use-hard-newlines - (get-text-property (1- (point)) 'hard)))) - (delete-backward-char 1) - (backward-char 1) - (setq oneleft t))) - (setq to (point)) - - ;; If there was no newline, and there is text in the paragraph, then - ;; create a newline. - (if (and (not oneleft) (> to from-plus-indent)) - (newline)) - (goto-char from-plus-indent)) - - (if (not (> to (point))) - nil ; There is no paragraph, only whitespace: exit now. - - (or justify (setq justify (current-justification))) - - ;; Don't let Adaptive Fill mode alter the fill prefix permanently. - (let ((fill-prefix fill-prefix)) - ;; Figure out how this paragraph is indented, if desired. - ;; XEmacs: move some code here to a separate function. - (maybe-adapt-fill-prefix from to t) - - (save-restriction - (goto-char from) - (beginning-of-line) - (narrow-to-region (point) to) - - (if (not justify) ; filling disabled: just check indentation - (progn - (goto-char from) - (while (not (eobp)) - (if (and (not (eolp)) - (< (current-indentation) (current-left-margin))) - (indent-to-left-margin)) - (forward-line 1))) - - (if use-hard-newlines - (remove-text-properties from (point-max) '(hard nil))) - ;; Make sure first line is indented (at least) to left margin... - (if (or (memq justify '(right center)) - (< (current-indentation) (current-left-margin))) - (indent-to-left-margin)) - ;; Delete the fill prefix from every line except the first. - ;; The first line may not even have a fill prefix. - (goto-char from) - (let ((fpre (and fill-prefix (not (equal fill-prefix "")) - (concat "[ \t]*" - (regexp-quote fill-prefix) - "[ \t]*")))) - (and fpre - (progn - (if (>= (+ (current-left-margin) (length fill-prefix)) - (current-fill-column)) - (error "fill-prefix too long for specified width")) - (goto-char from) - (forward-line 1) - (while (not (eobp)) - (if (looking-at fpre) - (delete-region (point) (match-end 0))) - (forward-line 1)) - (goto-char from) - (if (looking-at fpre) - (goto-char (match-end 0))) - (setq from (point))))) - ;; Remove indentation from lines other than the first. - (beginning-of-line 2) - (indent-region (point) (point-max) 0) - (goto-char from) - - ;; FROM, and point, are now before the text to fill, - ;; but after any fill prefix on the first line. - - ;; Make sure sentences ending at end of line get an extra space. - ;; loses on split abbrevs ("Mr.\nSmith") - (while (re-search-forward "[.?!][])}\"']*$" nil t) - ;; XEmacs change (no insert-and-inherit) - (or (eobp) (insert ?\ ?\ ))) - (goto-char from) - (skip-chars-forward " \t") - ;; Then change all newlines to spaces. - ;;; 97/3/14 jhod: Kinsoku change - ;; Spacing is not necessary for charcters of no word-separater. - ;; The regexp word-across-newline is used for this check. - (defvar word-across-newline) - (if (not (and (featurep 'mule) - (stringp word-across-newline))) - (subst-char-in-region from (point-max) ?\n ?\ ) - ;; - ;; WAN +NL+WAN --> WAN + WAN - ;; not(WAN)+NL+WAN --> not(WAN) + WAN - ;; WAN +NL+not(WAN) --> WAN + not(WAN) - ;; SPC +NL+not(WAN) --> SPC + not(WAN) - ;; not(WAN)+NL+not(WAN) --> not(WAN) + SPC + not(WAN) - ;; - (goto-char from) - (end-of-line) - (while (not (eobp)) - ;; Insert SPC only when point is between nonWAN. Insert - ;; before deleting to preserve marker if possible. - (if (or (prog2 ; check following char. - (forward-char) ; skip newline - (or (eobp) - (looking-at word-across-newline)) - (forward-char -1)) - (prog2 ; check previous char. - (forward-char -1) - (or (eq (char-after (point)) ?\ ) - (looking-at word-across-newline)) - (forward-char))) - nil - (insert ?\ )) - (delete-char 1) ; delete newline - (end-of-line))) - ;; end patch - (goto-char from) - (skip-chars-forward " \t") - (if (and nosqueeze (not (eq justify 'full))) - nil - (canonically-space-region (or squeeze-after (point)) (point-max)) - (goto-char (point-max)) - (delete-horizontal-space) - ;; XEmacs change (no insert-and-inherit) - (insert " ")) - (goto-char (point-min)) - - ;; This is the actual filling loop. - (let ((prefixcol 0) linebeg - (re-break-point (if (featurep 'mule) - (concat "[ \n\t]\\|" word-across-newline) - "[ \n\t]"))) - (while (not (eobp)) - (setq linebeg (point)) - (move-to-column (1+ (current-fill-column))) - (if (eobp) - (or nosqueeze (delete-horizontal-space)) - ;; Move back to start of word. - ;; 97/3/14 jhod: Kinsoku - ;(skip-chars-backward "^ \n" linebeg) - (fill-move-backward-to-break-point re-break-point linebeg) - ;; end patch - ;; Don't break after a period followed by just one space. - ;; Move back to the previous place to break. - ;; The reason is that if a period ends up at the end of a line, - ;; further fills will assume it ends a sentence. - ;; If we now know it does not end a sentence, - ;; avoid putting it at the end of the line. - (if sentence-end-double-space - (while (and (> (point) (+ linebeg 2)) - (eq (char-before (point)) ?\ ) - (not (eq (char-after (point)) ?\ )) - (eq (char-after (- (point) 2)) ?\.)) - (forward-char -2) - ;; 97/3/14 jhod: Kinsoku - ;(skip-chars-backward "^ \n" linebeg))) - (fill-move-backward-to-break-point re-break-point linebeg))) - (if (featurep 'mule) (kinsoku-process)) - ;end patch - - ;; If the left margin and fill prefix by themselves - ;; pass the fill-column. or if they are zero - ;; but we have no room for even one word, - ;; keep at least one word anyway. - ;; This handles ALL BUT the first line of the paragraph. - (if (if (zerop prefixcol) - (save-excursion - (skip-chars-backward " \t" linebeg) - (bolp)) - (>= prefixcol (current-column))) - ;; Ok, skip at least one word. - ;; Meanwhile, don't stop at a period followed by one space. - (let ((first t)) - (move-to-column prefixcol) - (while (and (not (eobp)) - (or first - (and (not (bobp)) - sentence-end-double-space - (save-excursion (forward-char -1) - (and (looking-at "\\. ") - (not (looking-at "\\. "))))))) - (skip-chars-forward " \t") - ;; 94/3/14 jhod: Kinsoku - ;(skip-chars-forward "^ \n\t") - (fill-move-forward-to-break-point re-break-point) - ;; end patch - (setq first nil))) - ;; Normally, move back over the single space between the words. - (if (eq (char-before (point)) ?\ ) - (forward-char -1))) - ;; If the left margin and fill prefix by themselves - ;; pass the fill-column, keep at least one word. - ;; This handles the first line of the paragraph. - (if (and (zerop prefixcol) - (let ((fill-point (point)) nchars) - (save-excursion - (move-to-left-margin) - (setq nchars (- fill-point (point))) - (or (< nchars 0) - (and fill-prefix - (< nchars (length fill-prefix)) - (string= (buffer-substring (point) fill-point) - (substring fill-prefix 0 nchars))))))) - ;; Ok, skip at least one word. But - ;; don't stop at a period followed by just one space. - (let ((first t)) - (while (and (not (eobp)) - (or first - (and (not (bobp)) - sentence-end-double-space - (save-excursion (forward-char -1) - (and (looking-at "\\. ") - (not (looking-at "\\. "))))))) - (skip-chars-forward " \t") - ;; 97/3/14 jhod: Kinsoku - ;(skip-chars-forward "^ \t\n") - (fill-move-forward-to-break-point re-break-point) - ;; end patch - (setq first nil)))) - ;; Check again to see if we got to the end of the paragraph. - (if (save-excursion (skip-chars-forward " \t") (eobp)) - (or nosqueeze (delete-horizontal-space)) - ;; Replace whitespace here with one newline, then indent to left - ;; margin. - (skip-chars-backward " \t") - ;; 97/3/14 jhod: More kinsoku stuff - (if (featurep 'mule) - ;; WAN means chars which match word-across-newline. - ;; (0) | SPC + SPC* --> NL - ;; (1) WAN | SPC + SPC* --> WAN + SPC + NL - ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN - ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC - ;; (4) '.' | SPC + SPC --> '.' + NL - ;; (5) | SPC* --> NL - (let ((start (point)) ; 92.6.30 by K.Handa - (ch (char-after (point)))) - (if (and (= ch ? ) - (progn ; not case (0) -- 92.6.30 by K.Handa - (skip-chars-forward " \t") - (not (eobp))) - (or - (progn ; case (1) - (goto-char start) - (forward-char -1) - (looking-at word-across-newline)) - (progn ; case (2) - (goto-char start) - (skip-chars-forward " \t") - (and (not (eobp)) - (looking-at word-across-newline) - ;; never leave space after the end of sentence - (not (fill-end-of-sentence-p)))) - (progn ; case (3) - (goto-char (1+ start)) - (and (not (eobp)) - (not (eq (char-after (point)) ? )) - (fill-end-of-sentence-p))))) - ;; We should keep one SPACE before NEWLINE. (1),(2),(3) - (goto-char (1+ start)) - ;; We should delete all SPACES around break point. (4),(5) - (goto-char start)))) - ;; end of patch - (insert ?\n) - ;; Give newline the properties of the space(s) it replaces - (set-text-properties (1- (point)) (point) - (text-properties-at (point))) - (indent-to-left-margin) - ;; Insert the fill prefix after indentation. - ;; Set prefixcol so whitespace in the prefix won't get lost. - (and fill-prefix (not (equal fill-prefix "")) - (progn - (insert fill-prefix) - (setq prefixcol (current-column)))))) - ;; Justify the line just ended, if desired. - (if justify - (if (save-excursion (skip-chars-forward " \t") (eobp)) - (progn - (delete-horizontal-space) - (justify-current-line justify t t)) - (forward-line -1) - (justify-current-line justify nil t) - (forward-line 1)))))) - ;; Leave point after final newline. - (goto-char (point-max))) - (forward-char 1)))) - -(defun fill-paragraph (arg) - "Fill paragraph at or after point. Prefix arg means justify as well. -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 (list (if current-prefix-arg 'full))) - (or (and fill-paragraph-function - (let ((function fill-paragraph-function) - fill-paragraph-function) - (funcall function arg))) - (let ((before (point))) - (save-excursion - (forward-paragraph) - (or (bolp) (newline 1)) - (let ((end (point)) - (beg (progn (backward-paragraph) (point)))) - (goto-char before) - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this paragraph may - ;; still contain hard newlines. See fill-region. - (fill-region beg end arg) - (fill-region-as-paragraph beg end arg))))))) - -(defun fill-region (from to &optional justify nosqueeze to-eop) - "Fill each of the paragraphs in the region. -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 - (progn - ;; XEmacs addition: - (barf-if-buffer-read-only nil (region-beginning) (region-end)) - (list (region-beginning) (region-end) - (if current-prefix-arg 'full)))) - (let (end beg) - (save-restriction - (goto-char (max from to)) - (if to-eop - (progn (skip-chars-backward "\n") - (forward-paragraph))) - (setq end (point)) - (goto-char (setq beg (min from to))) - (beginning-of-line) - (narrow-to-region (point) end) - (while (not (eobp)) - (let ((initial (point)) - end) - ;; If using hard newlines, break at every one for filling - ;; purposes rather than using paragraph breaks. - (if use-hard-newlines - (progn - (while (and (setq end (text-property-any (point) (point-max) - 'hard t)) - (not (eq ?\n (char-after end))) - (not (= end (point-max)))) - (goto-char (1+ end))) - (setq end (if end (min (point-max) (1+ end)) (point-max))) - (goto-char initial)) - (forward-paragraph 1) - (setq end (point)) - (forward-paragraph -1)) - (if (< (point) beg) - (goto-char beg)) - (if (>= (point) initial) - (fill-region-as-paragraph (point) end justify nosqueeze) - (goto-char end))))))) - -;; XEmacs addition: from Tim Bradshaw -(defun fill-paragraph-or-region (arg) - "Fill the current region, if it's active; otherwise, fill the paragraph. -See `fill-paragraph' and `fill-region' for more information." - (interactive "*P") - (if (region-active-p) - (fill-region (point) (mark) arg) - (fill-paragraph arg))) - - -(defconst default-justification 'left - "*Method of justifying text not otherwise specified. -Possible values are `left', `right', `full', `center', or `none'. -The requested kind of justification is done whenever lines are filled. -The `justification' text-property can locally override this variable. -This variable automatically becomes buffer-local when set in any fashion.") -(make-variable-buffer-local 'default-justification) - -(defun current-justification () - "How should we justify this line? -This returns the value of the text-property `justification', -or the variable `default-justification' if there is no text-property. -However, it returns nil rather than `none' to mean \"don't justify\"." - (let ((j (or (get-text-property - ;; Make sure we're looking at paragraph body. - (save-excursion (skip-chars-forward " \t") - (if (and (eobp) (not (bobp))) - (1- (point)) (point))) - 'justification) - default-justification))) - (if (eq 'none j) - nil - j))) - -(defun set-justification (begin end value &optional whole-par) - "Set the region's justification style. -The kind of justification to use is prompted for. -If the mark is not active, this command operates on the current paragraph. -If the mark is active, the region is used. However, if the beginning and end -of the region are not at paragraph breaks, they are moved to the beginning and -end of the paragraphs they are in. -If `use-hard-newlines' is true, all hard newlines are taken to be paragraph -breaks. - -When calling from a program, operates just on region between BEGIN and END, -unless optional fourth arg WHOLE-PAR is non-nil. In that case bounds are -extended to include entire paragraphs as in the interactive command." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)) - (let ((s (completing-read - "Set justification to: " - '(("left") ("right") ("full") - ("center") ("none")) - nil t))) - (if (equal s "") (error "")) - (intern s)) - t)) - (save-excursion - (save-restriction - (if whole-par - (let ((paragraph-start (if use-hard-newlines "." paragraph-start)) - (paragraph-ignore-fill-prefix (if use-hard-newlines t - paragraph-ignore-fill-prefix))) - (goto-char begin) - (while (and (bolp) (not (eobp))) (forward-char 1)) - (backward-paragraph) - (setq begin (point)) - (goto-char end) - (skip-chars-backward " \t\n" begin) - (forward-paragraph) - (setq end (point)))) - - (narrow-to-region (point-min) end) - (unjustify-region begin (point-max)) - (put-text-property begin (point-max) 'justification value) - (fill-region begin (point-max) nil t)))) - -(defun set-justification-none (b e) - "Disable automatic filling for paragraphs in the region. -If the mark is not active, this applies to the current paragraph." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)))) - (set-justification b e 'none t)) - -(defun set-justification-left (b e) - "Make paragraphs in the region left-justified. -This is usually the default, but see the variable `default-justification'. -If the mark is not active, this applies to the current paragraph." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)))) - (set-justification b e 'left t)) - -(defun set-justification-right (b e) - "Make paragraphs in the region right-justified: -Flush at the right margin and ragged on the left. -If the mark is not active, this applies to the current paragraph." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)))) - (set-justification b e 'right t)) - -(defun set-justification-full (b e) - "Make paragraphs in the region fully justified: -This makes lines flush on both margins by inserting spaces between words. -If the mark is not active, this applies to the current paragraph." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)))) - (set-justification b e 'full t)) - -(defun set-justification-center (b e) - "Make paragraphs in the region centered. -If the mark is not active, this applies to the current paragraph." - ;; XEmacs change (was mark-active) - (interactive (list (if (region-active-p) (region-beginning) (point)) - (if (region-active-p) (region-end) (point)))) - (set-justification b e 'center t)) - -;; 97/3/14 jhod: This functions are added for Kinsoku support -(defun find-space-insertable-point () - "Search backward for a permissible point for inserting justification spaces" - (if (boundp 'space-insertable) - (if (re-search-backward space-insertable nil t) - (progn (forward-char 1) - t) - nil) - (search-backward " " nil t))) - -;; A line has up to six parts: -;; -;; >>> hello. -;; [Indent-1][FP][ Indent-2 ][text][trailing whitespace][newline] -;; -;; "Indent-1" is the left-margin indentation; normally it ends at column -;; given by the `current-left-margin' function. -;; "FP" is the fill-prefix. It can be any string, including whitespace. -;; "Indent-2" is added to justify a line if the `current-justification' is -;; `center' or `right'. In `left' and `full' justification regions, any -;; whitespace there is part of the line's text, and should not be changed. -;; Trailing whitespace is not counted as part of the line length when -;; center- or right-justifying. -;; -;; All parts of the line are optional, although the final newline can -;; only be missing on the last line of the buffer. - -(defun justify-current-line (&optional how eop nosqueeze) - "Do some kind of justification on this line. -Normally does full justification: adds spaces to the line to make it end at -the column given by `current-fill-column'. -Optional first argument HOW specifies alternate type of justification: -it can be `left', `right', `full', `center', or `none'. -If HOW is t, will justify however the `current-justification' function says to. -If HOW is nil or missing, full justification is done by default. -Second arg EOP non-nil means that this is the last line of the paragraph, so -it will not be stretched by full justification. -Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged, -otherwise it is made canonical." - (interactive) - (if (eq t how) (setq how (or (current-justification) 'none)) - (if (null how) (setq how 'full) - (or (memq how '(none left right center)) - (setq how 'full)))) - (or (memq how '(none left)) ; No action required for these. - (let ((fc (current-fill-column)) - (pos (point-marker)) - fp-end ; point at end of fill prefix - beg ; point at beginning of line's text - end ; point at end of line's text - indent ; column of `beg' - endcol ; column of `end' - ncols) ; new indent point or offset - (end-of-line) - ;; Check if this is the last line of the paragraph. - (if (and use-hard-newlines (null eop) - (get-text-property (point) 'hard)) - (setq eop t)) - (skip-chars-backward " \t") - ;; Quick exit if it appears to be properly justified already - ;; or there is no text. - (if (or (bolp) - (and (memq how '(full right)) - (= (current-column) fc))) - nil - (setq end (point)) - (beginning-of-line) - (skip-chars-forward " \t") - ;; Skip over fill-prefix. - (if (and fill-prefix - (not (string-equal fill-prefix "")) - (equal fill-prefix - (buffer-substring - (point) (min (point-max) (+ (length fill-prefix) - (point)))))) - (forward-char (length fill-prefix)) - (if (and adaptive-fill-mode - (looking-at adaptive-fill-regexp)) - (goto-char (match-end 0)))) - (setq fp-end (point)) - (skip-chars-forward " \t") - ;; This is beginning of the line's text. - (setq indent (current-column)) - (setq beg (point)) - (goto-char end) - (setq endcol (current-column)) - - ;; HOW can't be null or left--we would have exited already - (cond ((eq 'right how) - (setq ncols (- fc endcol)) - (if (< ncols 0) - ;; Need to remove some indentation - (delete-region - (progn (goto-char fp-end) - (if (< (current-column) (+ indent ncols)) - (move-to-column (+ indent ncols) t)) - (point)) - (progn (move-to-column indent) (point))) - ;; Need to add some - (goto-char beg) - (indent-to (+ indent ncols)) - ;; If point was at beginning of text, keep it there. - (if (= beg pos) - (move-marker pos (point))))) - - ((eq 'center how) - ;; Figure out how much indentation is needed - (setq ncols (+ (current-left-margin) - (/ (- fc (current-left-margin) ;avail. space - (- endcol indent)) ;text width - 2))) - (if (< ncols indent) - ;; Have too much indentation - remove some - (delete-region - (progn (goto-char fp-end) - (if (< (current-column) ncols) - (move-to-column ncols t)) - (point)) - (progn (move-to-column indent) (point))) - ;; Have too little - add some - (goto-char beg) - (indent-to ncols) - ;; If point was at beginning of text, keep it there. - (if (= beg pos) - (move-marker pos (point))))) - - ((eq 'full how) - ;; Insert extra spaces between words to justify line - (save-restriction - (narrow-to-region beg end) - (or nosqueeze - (canonically-space-region beg end)) - (goto-char (point-max)) - (setq ncols (- fc endcol)) - ;; Ncols is number of additional spaces needed - (if (> ncols 0) - (if (and (not eop) - ;; 97/3/14 jhod: Kinsoku - (find-space-insertable-point)) ;(search-backward " " nil t)) - (while (> ncols 0) - (let ((nmove (+ 3 (random 3)))) - (while (> nmove 0) - (or (find-space-insertable-point) ;(search-backward " " nil t) - (progn - (goto-char (point-max)) - (find-space-insertable-point))) ;(search-backward " "))) - (skip-chars-backward " ") - (setq nmove (1- nmove)))) - ;; XEmacs change - (insert " ") - (skip-chars-backward " ") - (setq ncols (1- ncols))))))) - (t (error "Unknown justification value")))) - (goto-char pos) - (move-marker pos nil))) - nil) - -(defun unjustify-current-line () - "Remove justification whitespace from current line. -If the line is centered or right-justified, this function removes any -indentation past the left margin. If the line is full-justified, it removes -extra spaces between words. It does nothing in other justification modes." - (let ((justify (current-justification))) - (cond ((eq 'left justify) nil) - ((eq nil justify) nil) - ((eq 'full justify) ; full justify: remove extra spaces - (beginning-of-line-text) - (canonically-space-region - (point) (save-excursion (end-of-line) (point)))) - ((memq justify '(center right)) - (save-excursion - (move-to-left-margin nil t) - ;; Position ourselves after any fill-prefix. - (if (and fill-prefix - (not (string-equal fill-prefix "")) - (equal fill-prefix - (buffer-substring - (point) (min (point-max) (+ (length fill-prefix) - (point)))))) - (forward-char (length fill-prefix))) - (delete-region (point) (progn (skip-chars-forward " \t") - (point)))))))) - -(defun unjustify-region (&optional begin end) - "Remove justification whitespace from region. -For centered or right-justified regions, this function removes any indentation -past the left margin from each line. For full-justified lines, it removes -extra spaces between words. It does nothing in other justification modes. -Arguments BEGIN and END are optional; default is the whole buffer." - (save-excursion - (save-restriction - (if end (narrow-to-region (point-min) end)) - (goto-char (or begin (point-min))) - (while (not (eobp)) - (unjustify-current-line) - (forward-line 1))))) - - -(defun fill-nonuniform-paragraphs (min max &optional justifyp mailp) - "Fill paragraphs within the region, allowing varying indentation within each. -This command divides the region into \"paragraphs\", -only at paragraph-separator lines, then fills each paragraph -using as the fill prefix the smallest indentation of any line -in the paragraph. - -When calling from a program, pass range to fill as first two arguments. - -Optional third and fourth arguments JUSTIFY and MAIL-FLAG: -JUSTIFY to justify paragraphs (prefix arg), -MAIL-FLAG for a mail message, i. e. don't fill header lines." - (interactive (list (region-beginning) (region-end) - (if current-prefix-arg 'full))) - (let ((fill-individual-varying-indent t)) - (fill-individual-paragraphs min max justifyp mailp))) - -(defun fill-individual-paragraphs (min max &optional justify mailp) - "Fill paragraphs of uniform indentation within the region. -This command divides the region into \"paragraphs\", -treating every change in indentation level as a paragraph boundary, -then fills each paragraph using its indentation level as the fill prefix. - -When calling from a program, pass range to fill as first two arguments. - -Optional third and fourth arguments JUSTIFY and MAIL-FLAG: -JUSTIFY to justify paragraphs (prefix arg), -MAIL-FLAG for a mail message, i. e. don't fill header lines." - (interactive (list (region-beginning) (region-end) - (if current-prefix-arg 'full))) - (save-restriction - (save-excursion - (goto-char min) - (beginning-of-line) - (narrow-to-region (point) max) - (if mailp - (while (and (not (eobp)) - (or (looking-at "[ \t]*[^ \t\n]+:") - (looking-at "[ \t]*$"))) - (if (looking-at "[ \t]*[^ \t\n]+:") - (search-forward "\n\n" nil 'move) - (forward-line 1)))) - (narrow-to-region (point) max) - ;; Loop over paragraphs. - (while (progn (skip-chars-forward " \t\n") (not (eobp))) - (move-to-left-margin) - (let ((start (point)) - fill-prefix fill-prefix-regexp) - ;; Find end of paragraph, and compute the smallest fill-prefix - ;; that fits all the lines in this paragraph. - (while (progn - ;; Update the fill-prefix on the first line - ;; and whenever the prefix good so far is too long. - (if (not (and fill-prefix - (looking-at fill-prefix-regexp))) - (setq fill-prefix - (if (and adaptive-fill-mode adaptive-fill-regexp - (looking-at adaptive-fill-regexp)) - (match-string 0) - (buffer-substring - (point) - (save-excursion (skip-chars-forward " \t") - (point)))) - fill-prefix-regexp (regexp-quote fill-prefix))) - (forward-line 1) - (if (bolp) - ;; If forward-line went past a newline - ;; move further to the left margin. - (move-to-left-margin)) - ;; Now stop the loop if end of paragraph. - (and (not (eobp)) - (if fill-individual-varying-indent - ;; If this line is a separator line, with or - ;; without prefix, end the paragraph. - (and - (not (looking-at paragraph-separate)) - (save-excursion - (not (and (looking-at fill-prefix-regexp) - ;; XEmacs change - (progn - (forward-char (length fill-prefix)) - (looking-at paragraph-separate)))))) - ;; If this line has more or less indent - ;; than the fill prefix wants, end the paragraph. - (and (looking-at fill-prefix-regexp) - (save-excursion - (not - (progn - (forward-char (length fill-prefix)) - (or (looking-at paragraph-separate) - (looking-at paragraph-start)))))))))) - ;; Fill this paragraph, but don't add a newline at the end. - (let ((had-newline (bolp))) - (fill-region-as-paragraph start (point) justify) - (or had-newline (delete-char -1)))))))) - -;;; fill.el ends here diff --git a/lisp/find-paths.el b/lisp/find-paths.el deleted file mode 100644 index f5be624..0000000 --- a/lisp/find-paths.el +++ /dev/null @@ -1,302 +0,0 @@ -;;; find-paths.el --- setup various XEmacs paths - -;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. -;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois - -;; Author: Mike Sperber -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; This file contains the library functionality to find paths into the -;; XEmacs hierarchy. - -;;; Code: - -(defvar paths-version-control-filename-regexp - "^\\(RCS\\|CVS\\|SCCS\\)$" - "File bases associated with version control.") - -(defvar paths-lisp-filename-regexp - "^\\(.*\\.elc?\\)$" - "File bases that contain Lisp file.") - -(defvar paths-no-lisp-directory-regexp - (concat "\\(" paths-version-control-filename-regexp "\\)" - "\\|" - "\\(" paths-lisp-filename-regexp "\\)") - "File bases that may not be directories containing Lisp code.") - -(defun paths-find-recursive-path (directories &optional max-depth exclude-regexp) - "Return a list of the directory hierarchy underneath DIRECTORIES. -The returned list is sorted by pre-order and lexicographically. -MAX-DEPTH limits the depth of the search to MAX-DEPTH level, -if it is a number. If MAX-DEPTH is NIL, the search depth is unlimited. -EXCLUDE-REGEXP is a regexp that matches directory names to exclude -from the search." - (let ((path '())) - (while directories - (let ((directory (file-name-as-directory - (expand-file-name - (car directories))))) - (if (paths-file-readable-directory-p directory) - (let ((raw-entries - (if (equal 0 max-depth) - '() - (directory-files directory nil "^[^.-]"))) - (reverse-dirs '())) - (while raw-entries - (if (null (string-match exclude-regexp (car raw-entries))) - (setq reverse-dirs - (cons (expand-file-name (car raw-entries) directory) - reverse-dirs))) - (setq raw-entries (cdr raw-entries))) - - (let ((sub-path - (paths-find-recursive-path (reverse reverse-dirs) - (if (numberp max-depth) - (- max-depth 1) - max-depth) - exclude-regexp))) - (setq path (nconc path - (list directory) - sub-path)))))) - (setq directories (cdr directories))) - path)) - -(defun paths-file-readable-directory-p (filename) - "Check if filename is a readable directory." - (and (file-directory-p filename) - (file-readable-p filename))) - -(defun paths-find-recursive-load-path (directories &optional max-depth) - "Construct a recursive load path underneath DIRECTORIES." - (paths-find-recursive-path directories - max-depth paths-no-lisp-directory-regexp)) - -(defun paths-emacs-root-p (directory) - "Check if DIRECTORY is a plausible installation root for XEmacs." - (or - ;; installed - (paths-file-readable-directory-p (paths-construct-path (list directory - "lib" - emacs-program-name))) - ;; in-place or windows-nt - (and - (paths-file-readable-directory-p (paths-construct-path (list directory "lisp"))) - (paths-file-readable-directory-p (paths-construct-path (list directory "etc")))))) - -(defun paths-chase-symlink (file-name) - "Chase a symlink until the bitter end." - (let ((maybe-symlink (file-symlink-p file-name))) - (if maybe-symlink - (let* ((directory (file-name-directory file-name)) - (destination (expand-file-name maybe-symlink directory))) - (paths-chase-symlink destination)) - file-name))) - -(defun paths-find-emacs-root - (invocation-directory invocation-name) - "Find the run-time root of XEmacs." - (let* ((executable-file-name (paths-chase-symlink - (concat invocation-directory - invocation-name))) - (executable-directory (file-name-directory executable-file-name)) - (maybe-root-1 (file-name-as-directory - (paths-construct-path '("..") executable-directory))) - (maybe-root-2 (file-name-as-directory - (paths-construct-path '(".." "..") executable-directory)))) - (or (and (paths-emacs-root-p maybe-root-1) - maybe-root-1) - (and (paths-emacs-root-p maybe-root-2) - maybe-root-2)))) - -(defun paths-construct-path (components &optional expand-directory) - "Convert list of path components COMPONENTS into a path. -If EXPAND-DIRECTORY is non-NIL, use it as a directory to feed -to EXPAND-FILE-NAME." - (let* ((reverse-components (reverse components)) - (last-component (car reverse-components)) - (first-components (reverse (cdr reverse-components))) - (path - (apply #'concat - (append (mapcar #'file-name-as-directory first-components) - (list last-component))))) - (if expand-directory - (expand-file-name path expand-directory) - path))) - -(defun paths-construct-emacs-directory (root suffix base) - "Construct a directory name within the XEmacs hierarchy." - (file-name-as-directory - (expand-file-name - (concat - (file-name-as-directory root) - suffix - base)))) - -(defun paths-find-emacs-directory (roots suffix base - &optional envvar default keep-suffix) - "Find a directory in the XEmacs hierarchy. -ROOTS must be a list of installation roots. -SUFFIX is the subdirectory from there. -BASE is the base to look for. -ENVVAR is the name of the environment variable that might also -specify the directory. -DEFAULT is the preferred value. -If KEEP-SUFFIX is non-nil, the suffix must be respected in searching -the directory." - (let ((preferred-value (or (and envvar (getenv envvar)) - default))) - (if (and preferred-value - (paths-file-readable-directory-p preferred-value)) - (file-name-as-directory preferred-value) - (catch 'gotcha - (while roots - (let* ((root (car roots)) - ;; installed - (path (paths-construct-emacs-directory root suffix base))) - (if (paths-file-readable-directory-p path) - (throw 'gotcha path) - ;; in-place - (if (null keep-suffix) - (let ((path (paths-construct-emacs-directory root "" base))) - (if (paths-file-readable-directory-p path) - (throw 'gotcha path)))))) - (setq roots (cdr roots))) - nil)))) - -(defun paths-find-site-directory (roots base &optional envvar default) - "Find a site-specific directory in the XEmacs hierarchy." - (paths-find-emacs-directory roots - (file-name-as-directory - (paths-construct-path (list - "lib" - emacs-program-name))) - base - envvar default)) - -(defun paths-find-version-directory (roots base - &optional envvar default enforce-version) - "Find a version-specific directory in the XEmacs hierarchy. -If ENFORCE-VERSION is non-nil, the directory must contain the XEmacs version." - (paths-find-emacs-directory roots - (file-name-as-directory - (paths-construct-path - (list "lib" - (construct-emacs-version-name)))) - base - envvar default - enforce-version)) - -(defun paths-find-architecture-directory (roots base &optional envvar default) - "Find an architecture-specific directory in the XEmacs hierarchy." - (or - ;; from more to less specific - (paths-find-version-directory roots - (concat base system-configuration) - envvar) - (paths-find-version-directory roots - base - envvar) - (paths-find-version-directory roots - system-configuration - envvar default))) - -(defun construct-emacs-version-name () - "Construct the raw XEmacs version number." - (concat emacs-program-name "-" emacs-program-version)) - -(defun paths-directories-which-exist (directories) - "Return the directories among DIRECTORIES." - (let ((reverse-directories '())) - (while directories - (if (paths-file-readable-directory-p (car directories)) - (setq reverse-directories - (cons (car directories) - reverse-directories))) - (setq directories (cdr directories))) - (reverse reverse-directories))) - -(defun paths-uniq-append (list-1 list-2) - "Append LIST-1 and LIST-2, omitting duplicates." - (let ((reverse-survivors '())) - (while list-2 - (if (null (member (car list-2) list-1)) - (setq reverse-survivors (cons (car list-2) reverse-survivors))) - (setq list-2 (cdr list-2))) - (append list-1 - (reverse reverse-survivors)))) - -(defun paths-filter (predicate list) - "Delete all matches of PREDICATE from LIST." - (let ((reverse-result '())) - (while list - (if (funcall predicate (car list)) - (setq reverse-result (cons (car list) reverse-result))) - (setq list (cdr list))) - (nreverse reverse-result))) - -(defun paths-decode-directory-path (string &optional drop-empties) - "Split STRING at path separators into a directory list. -Non-\"\" comonents are converted into directory form. -If DROP-EMPTIES is non-NIL, \"\" components are dropped from the output. -Otherwise, they are left alone." - (let* ((components (split-path string)) - (directories - (mapcar #'(lambda (component) - (if (string-equal "" component) - component - (file-name-as-directory component))) - components))) - (if drop-empties - (paths-filter #'(lambda (component) - (null (string-equal "" component))) - directories) - directories))) - -(defun paths-find-emacs-roots (invocation-directory - invocation-name) - "Find all plausible installation roots for XEmacs." - (let* ((potential-invocation-root - (paths-find-emacs-root invocation-directory invocation-name)) - (invocation-roots - (and potential-invocation-root - (list potential-invocation-root))) - (potential-installation-roots - (paths-uniq-append - (and configure-exec-prefix-directory - (list (file-name-as-directory - configure-exec-prefix-directory))) - (and configure-prefix-directory - (list (file-name-as-directory - configure-prefix-directory))))) - (installation-roots - (paths-filter #'paths-emacs-root-p potential-installation-roots))) - (paths-uniq-append invocation-roots - installation-roots))) - -;;; find-paths.el ends here diff --git a/lisp/finder.el b/lisp/finder.el deleted file mode 100644 index 8c9594a..0000000 --- a/lisp/finder.el +++ /dev/null @@ -1,403 +0,0 @@ -;;; finder.el --- topic & keyword-based code finder - -;; Copyright (C) 1992 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond -;; Created: 16 Jun 1992 -;; Version: 1.0 -;; Keywords: help -;; X-Modified-by: Bob Weiner , 4/18/95, to include Lisp -;; library directory names in finder-program-info, for fast display of -;; Lisp libraries and associated commentaries. Added {v}, finder-view, -;; and {e}, finder-edit commands for displaying libraries. -;; -;; Added user variable, 'finder-abbreviate-directory-list', used to -;; abbreviate directories before they are saved to finder-program-info. -;; Such relative directories can be portable from one Emacs installation -;; to another. Default value is based upon the value of Emacs' -;; data-directory variable. - -;; 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 uses the Keywords library header to provide code-finding -;; services by keyword. -;; -;; Things to do: -;; 1. Support multiple keywords per search. This could be extremely hairy; -;; there doesn't seem to be any way to get completing-read to exit on -;; an EOL with no substring pending, which is what we'd want to end the loop. -;; 2. Search by string in synopsis line? -;; 3. Function to check finder-package-info for unknown keywords. - -;;; Code: - -(require 'lisp-mnt) -(condition-case nil - (require 'finder-inf) - (t nil)) -;; XEmacs addition -(require 'picture) -(require 'mode-motion) - -(defvar finder-emacs-root-directory - (file-name-directory (directory-file-name data-directory)) - "Root directory of current emacs tree.") - -(defvar finder-abbreviate-directory-list - (list finder-emacs-root-directory) - "*List of directory roots to remove from finder-package-info directory entries. -The first element in the list is used when expanding relative package -directories to view or extract information from package source code.") - -(defvar finder-file-regexp "\\.el$" - "Regexp which matches file names but not Emacs Lisp finder keywords.") - -;; Local variable in finder buffer. -(defvar finder-headmark) - -(defvar finder-known-keywords - `( - (abbrev . "abbreviation handling, typing shortcuts, macros") - (bib . "code related to the `bib' bibliography processor") - (c . "C, C++, and Objective-C language support") - (calendar . "calendar and time management support") - (comm . "communications, networking, remote access to files") - (data . "support for editing files of data") - (docs . "support for Emacs documentation") - (dumped . "files preloaded into Emacs") - (emulations . "emulations of other editors") - (extensions . "Emacs Lisp language extensions") - (faces . "support for multiple fonts") - (frames . "support for Emacs frames and window systems") - (games . "games, jokes and amusements") - (hardware . "support for interfacing with exotic hardware") - (help . "support for on-line help systems") - (hypermedia . "support for links between text or other media types") - (i18n . "internationalization and alternate character-set support") - (internal . "code for Emacs internals, build process, defaults") - (languages . "specialized modes for editing programming languages") - (lisp . "Lisp support, including Emacs Lisp") - (local . "code local to your site") - (maint . "maintenance aids for the Emacs development group") - (mail . "modes for electronic-mail handling") - (matching . "various sorts of searching and matching") - (mouse . "mouse support") - ,(when (featurep 'mule) - (cons 'mule "multi-language extensions")) - (news . "support for netnews reading and posting") - (oop . "support for object-oriented programming") - (outlines . "support for hierarchical outlining") - (processes . "process, subshell, compilation, and job control support") - (terminals . "support for terminal types") - (tex . "code related to the TeX formatter") - (tools . "programming tools") - (unix . "front-ends/assistants for, or emulators of, UNIX features") - (vms . "support code for vms") - (wp . "word processing") - )) - -(defvar finder-mode-map nil) -(or finder-mode-map - (let ((map (make-sparse-keymap))) - (define-key map " " 'finder-select) - (define-key map "f" 'finder-select) - (define-key map "\C-m" 'finder-select) - ;; XEmacs changes - (define-key map "e" 'finder-edit) - (define-key map "v" 'finder-view) - (define-key map "?" 'finder-summary) - (define-key map "q" 'finder-exit) - (define-key map "d" 'finder-list-keywords) - ;; XEmacs change - (define-key map [button2] 'finder-mouse-select) - (setq finder-mode-map map))) - - -;;; Code for regenerating the keyword list. - -(defvar finder-package-info nil - "Assoc list mapping file names to description & keyword lists.") - -(defvar finder-compile-keywords-quiet nil - "If non-nil finder-compile-keywords will not print any messages.") - -(defun finder-compile-keywords (&rest dirs) - "Regenerate the keywords association list into the file `finder-inf.el'. -Optional arguments are a list of Emacs Lisp directories to compile from; no -arguments compiles from `load-path'." - (save-excursion - ;; XEmacs change - (find-file "finder-inf.el") - (let ((processed nil) - (directory-abbrev-alist - (append - (mapcar (function (lambda (dir) (cons dir ""))) - finder-abbreviate-directory-list) - directory-abbrev-alist)) - (using-load-path)) - (or dirs (setq dirs load-path)) - (setq using-load-path (equal dirs load-path)) - (erase-buffer) - (insert ";;; finder-inf.el --- keyword-to-package mapping\n") - (insert ";; Keywords: help\n") - (insert ";;; Commentary:\n") - (insert ";; Don't edit this file. It's generated by finder.el\n\n") - (insert ";;; Code:\n") - (insert "\n(defconst finder-package-info '(\n") - (mapcar - (lambda (d) - (mapcar - (lambda (f) - (when (not (member f processed)) - (let (summary keystart keywords) - (setq processed (cons f processed)) - (if (not finder-compile-keywords-quiet) - (message "Processing %s ..." f)) - (save-excursion - (set-buffer (get-buffer-create "*finder-scratch*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents (expand-file-name f d)) - (condition-case err - (setq summary (lm-synopsis) - keywords (lm-keywords)) - (t (message "finder: error processing %s %S" f err)))) - (when summary - (insert (format " (\"%s\"\n " f)) - (prin1 summary (current-buffer)) - (insert "\n ") - (setq keystart (point)) - (insert (if keywords (format "(%s)" keywords) "nil")) - (subst-char-in-region keystart (point) ?, ? ) - (insert "\n ") - (prin1 (abbreviate-file-name d) (current-buffer)) - (insert ")\n"))))) - ;; - ;; Skip null, non-existent or relative pathnames, e.g. "./", if - ;; using load-path, so that they do not interfere with a scan of - ;; library directories only. - (if (and using-load-path - (not (and d (file-name-absolute-p d) (file-exists-p d)))) - nil - (setq d (file-name-as-directory (or d "."))) - (directory-files d nil "^[^=].*\\.el$")))) - dirs) - (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n") - (kill-buffer "*finder-scratch*") - (unless noninteractive - (eval-current-buffer)) ; So we get the new keyword list immediately - (basic-save-buffer)))) - -(defun finder-compile-keywords-make-dist () - "Regenerate `finder-inf.el' for the Emacs distribution." - (finder-compile-keywords default-directory)) - -;;; Now the retrieval code - -(defun finder-insert-at-column (column &rest strings) - "Insert list of STRINGS, at column COLUMN." - (if (>= (current-column) column) (insert "\n")) - (move-to-column column) - (let ((col (current-column))) - (if (< col column) - (indent-to column) - (if (and (/= col column) - (= (preceding-char) ?\t)) - (let (indent-tabs-mode) - (delete-char -1) - (indent-to col) - (move-to-column column))))) - (apply 'insert strings)) - -(defun finder-list-keywords () - "Display descriptions of the keywords in the Finder buffer." - (interactive) - (setq buffer-read-only nil) - (erase-buffer) - (mapcar - (lambda (assoc) - (let ((keyword (car assoc))) - (insert (symbol-name keyword)) - (finder-insert-at-column 14 (concat (cdr assoc) "\n")) - (cons (symbol-name keyword) keyword))) - finder-known-keywords) - (goto-char (point-min)) - (setq finder-headmark (point)) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - ;; XEmacs change - (if (not (one-window-p)) - (balance-windows)) - (finder-summary)) - -(defun finder-list-matches (key) - (setq buffer-read-only nil) - (erase-buffer) - (let ((id (intern key))) - (insert - "The following packages match the keyword `" key "':\n\n") - (setq finder-headmark (point)) - (mapcar - (lambda (x) - (if (memq id (car (cdr (cdr x)))) - (progn - (insert (car x)) - (finder-insert-at-column 16 (concat (car (cdr x)) "\n"))))) - finder-package-info) - (goto-char (point-min)) - (forward-line) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (shrink-window-if-larger-than-buffer) - (finder-summary))) - -;; Search for a file named FILE the same way `load' would search. -(defun finder-find-library (file) - (if (file-name-absolute-p file) - file - (let ((dirs load-path) - found) - (while (and dirs (not found)) - (if (file-exists-p (expand-file-name (concat file ".el") (car dirs))) - (setq found (expand-file-name file (car dirs))) - (if (file-exists-p (expand-file-name file (car dirs))) - (setq found (expand-file-name file (car dirs))))) - (setq dirs (cdr dirs))) - found))) - -(defun finder-commentary (file) - (interactive) - (let* ((str (lm-commentary (finder-find-library file)))) - (if (null str) - (error "Can't find any Commentary section")) - (pop-to-buffer "*Finder*") - ;; XEmacs change - (setq buffer-read-only nil - mode-motion-hook 'mode-motion-highlight-line) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (delete-blank-lines) - (goto-char (point-max)) - (delete-blank-lines) - (goto-char (point-min)) - (while (re-search-forward "^;+ ?" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (shrink-window-if-larger-than-buffer) - (finder-summary))) - -(defun finder-current-item () - (if (and finder-headmark (< (point) finder-headmark)) - (error "No keyword or filename on this line") - (save-excursion - (beginning-of-line) - (current-word)))) - -;; XEmacs change -(defun finder-edit () - (interactive) - (let ((entry (finder-current-item))) - (if (string-match finder-file-regexp entry) - (let ((path (finder-find-library entry))) - (if path - (find-file-other-window path) - (error "Can't find Emacs Lisp library: '%s'" entry))) - ;; a finder keyword - (error "Finder-edit works on Emacs Lisp libraries only")))) - -;; XEmacs change -(defun finder-view () - (interactive) - (let ((entry (finder-current-item))) - (if (string-match finder-file-regexp entry) - (let ((path (finder-find-library entry))) - (if path - (view-file-other-window path) - (error "Can't find Emacs Lisp library: '%s'" entry))) - ;; a finder keyword - (error "Finder-view works on Emacs Lisp libraries only")))) - -(defun finder-select () - (interactive) - (let ((key (finder-current-item))) - ;; XEmacs change - (if (string-match finder-file-regexp key) - (finder-commentary key) - (finder-list-matches key)))) - -;; XEmacs change -(defun finder-mouse-select (ev) - (interactive "e") - (goto-char (event-point ev)) - (finder-select)) - -;; XEmacs change -;;;###autoload -(defun finder-by-keyword () - "Find packages matching a given keyword." - (interactive) - (finder-mode) - (finder-list-keywords)) - -(defun finder-mode () - "Major mode for browsing package documentation. -\\ -\\[finder-select] more help for the item on the current line -\\[finder-edit] edit Lisp library in another window -\\[finder-view] view Lisp library in another window -\\[finder-exit] exit Finder mode and kill the Finder buffer. -" - (interactive) - (pop-to-buffer "*Finder*") - ;; XEmacs change - (setq buffer-read-only nil - mode-motion-hook 'mode-motion-highlight-line) - (erase-buffer) - (use-local-map finder-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq mode-name "Finder") - (setq major-mode 'finder-mode) - (make-local-variable 'finder-headmark) - (setq finder-headmark nil)) - -(defun finder-summary () - "Summarize basic Finder commands." - (interactive) - (message "%s" - (substitute-command-keys - ;; XEmacs change - "\\\\[finder-select] = select, \\[finder-list-keywords] = keywords, \\[finder-edit] = edit, \\[finder-view] = view, \\[finder-exit] = quit, \\[finder-summary] = help"))) - -(defun finder-exit () - "Exit Finder mode and kill the buffer" - (interactive) - ;; XEmacs change - (or (one-window-p t 0) - (delete-window)) - (kill-buffer "*Finder*")) - -(provide 'finder) - -;;; finder.el ends here diff --git a/lisp/float-sup.el b/lisp/float-sup.el deleted file mode 100644 index 11d409d..0000000 --- a/lisp/float-sup.el +++ /dev/null @@ -1,67 +0,0 @@ -;;; float-sup.el --- detect absence of floating-point support in XEmacs runtime - -;; Copyright (C) 1985-7, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; Provide a meaningful error message if we are running on -;; bare (non-float) emacs. -;; Can't test for 'floatp since that may be defined by float-imitation -;; packages like float.el in this very directory. - -;; XEmacs change -(or (featurep 'lisp-float-type) - (error "Floating point was disabled at compile time")) - -;; define pi and e via math-lib calls. (much less prone to killer typos.) -;; XEmacs change (purecopy) -(defconst pi (purecopy (* 4 (atan 1))) "The value of Pi (3.1415926...)") -(defconst e (purecopy (exp 1)) "The value of e (2.7182818...)") - -;; Careful when editing this file ... typos here will be hard to spot. -;; (defconst pi 3.14159265358979323846264338327 -;; "The value of Pi (3.14159265358979323846264338327...)") - -;; XEmacs change (purecopy) -(defconst degrees-to-radians (purecopy (/ pi 180.0)) - "Degrees to radian conversion constant") -(defconst radians-to-degrees (purecopy (/ 180.0 pi)) - "Radian to degree conversion constant") - -;; these expand to a single multiply by a float when byte compiled - -(defmacro degrees-to-radians (x) - "Convert ARG from degrees to radians." - (list '* (/ pi 180.0) x)) -(defmacro radians-to-degrees (x) - "Convert ARG from radians to degrees." - (list '* (/ 180.0 pi) x)) - -;; Provided in C code in XEmacs -;; (provide 'lisp-float-type) - -;;; float-sup.el ends here diff --git a/lisp/font-lock.el b/lisp/font-lock.el deleted file mode 100644 index 2918ef3..0000000 --- a/lisp/font-lock.el +++ /dev/null @@ -1,2583 +0,0 @@ -;;; font-lock.el --- decorating source files with fonts/colors based on syntax - -;; Copyright (C) 1992-1995, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1996 Ben Wing. - -;; Author: Jamie Zawinski , for the LISPM Preservation Society. -;; Minimally merged with FSF 19.34 by Barry Warsaw -;; Then (partially) synched with FSF 19.30, leading to: -;; Next Author: RMS -;; Next Author: Simon Marshall -;; Latest XEmacs Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; 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: FSF 19.30 except for the code to initialize the faces. - -;;; Commentary: - -;; Font-lock-mode is a minor mode that causes your comments to be -;; displayed in one face, strings in another, reserved words in another, -;; documentation strings in another, and so on. -;; -;; Comments will be displayed in `font-lock-comment-face'. -;; Strings will be displayed in `font-lock-string-face'. -;; Doc strings will be displayed in `font-lock-doc-string-face'. -;; Function and variable names (in their defining forms) will be -;; displayed in `font-lock-function-name-face'. -;; Reserved words will be displayed in `font-lock-keyword-face'. -;; -;; Don't let the name fool you: you can highlight things using different -;; colors or background stipples instead of fonts, though that is not the -;; default. See the variables `font-lock-use-colors' and -;; `font-lock-use-fonts' for broad control over this, or see the -;; documentation on faces and how to change their attributes for -;; fine-grained control. -;; -;; To make the text you type be fontified, use M-x font-lock-mode. When -;; this minor mode is on, the fonts of the current line will be updated -;; with every insertion or deletion. -;; -;; By default, font-lock will automatically put newly loaded files -;; into font-lock-mode if it knows about the file's mode. See the -;; variables `font-lock-auto-fontify', `font-lock-mode-enable-list', -;; and `font-lock-mode-disable-list' for control over this. -;; -;; The `font-lock-keywords' variable defines other patterns to highlight. -;; The default font-lock-mode-hook sets it to the value of the variables -;; lisp-font-lock-keywords, c-font-lock-keywords, etc, as appropriate. -;; The easiest way to change the highlighting patterns is to change the -;; values of c-font-lock-keywords and related variables. See the doc -;; string of the variable `font-lock-keywords' for the appropriate syntax. -;; -;; The default value for `lisp-font-lock-keywords' is the value of the variable -;; `lisp-font-lock-keywords-1'. You may like `lisp-font-lock-keywords-2' -;; better; it highlights many more words, but is slower and makes your buffers -;; be very visually noisy. -;; -;; The same is true of `c-font-lock-keywords-1' and `c-font-lock-keywords-2'; -;; the former is subdued, the latter is loud. -;; -;; You can make font-lock default to the gaudier variety of keyword -;; highlighting by setting the variable `font-lock-maximum-decoration' -;; before loading font-lock, or by calling the functions -;; `font-lock-use-default-maximal-decoration' or -;; `font-lock-use-default-minimal-decoration'. -;; -;; On a Sparc10, the initial fontification takes about 6 seconds for a typical -;; 140k file of C code, using the default configuration. The actual speed -;; depends heavily on the type of code in the file, and how many non-syntactic -;; patterns match; for example, Xlib.h takes 23 seconds for 101k, because many -;; patterns match in it. You can speed this up substantially by removing some -;; of the patterns that are highlighted by default. Fontifying lisp code is -;; significantly faster, because lisp has a more regular syntax than C, so the -;; regular expressions don't have to be as complicated. -;; -;; It's called font-lock-mode here because on the Lispms it was called -;; "Electric Font Lock Mode." It was called that because there was an older -;; mode called "Electric Caps Lock Mode" which had the function of causing all -;; of your source code to be in upper case except for strings and comments, -;; without you having to blip the caps lock key by hand all the time (thus the -;; "electric", as in `electric-c-brace'.) - -;; See also the related packages `fast-lock' and `lazy-lock'. Both -;; attempt to speed up the initial fontification. `fast-lock' saves -;; the fontification info when you exit Emacs and reloads it next time -;; you load the file, so that the file doesn't have to be fontified -;; again. `lazy-lock' does "lazy" fontification -- i.e. it only -;; fontifies the text as it becomes visible rather than fontifying -;; the whole file when it's first loaded in. - -;; Further comments from the FSF: - -;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" -;; are made thusly: (regexp-opt '("foo" "fu" "fubar" "bar" "barlo" "lo")) for -;; efficiency. - -;; What is fontification for? You might say, "It's to make my code look nice." -;; I think it should be for adding information in the form of cues. These cues -;; should provide you with enough information to both (a) distinguish between -;; different items, and (b) identify the item meanings, without having to read -;; the items and think about it. Therefore, fontification allows you to think -;; less about, say, the structure of code, and more about, say, why the code -;; doesn't work. Or maybe it allows you to think less and drift off to sleep. -;; -;; So, here are my opinions/advice/guidelines: -;; -;; - Use the same face for the same conceptual object, across all modes. -;; i.e., (b) above, all modes that have items that can be thought of as, say, -;; keywords, should be highlighted with the same face, etc. -;; - Keep the faces distinct from each other as far as possible. -;; i.e., (a) above. -;; - Make the face attributes fit the concept as far as possible. -;; i.e., function names might be a bold color such as blue, comments might -;; be a bright color such as red, character strings might be brown, because, -;; err, strings are brown (that was not the reason, please believe me). -;; - Don't use a non-nil OVERRIDE unless you have a good reason. -;; Only use OVERRIDE for special things that are easy to define, such as the -;; way `...' quotes are treated in strings and comments in Emacs Lisp mode. -;; Don't use it to, say, highlight keywords in commented out code or strings. -;; - Err, that's it. - - -;;; Code: - -(require 'fontl-hooks) - -;;;;;;;;;;;;;;;;;;;;;; user variables ;;;;;;;;;;;;;;;;;;;;;; - -(defgroup font-lock nil - "Decorate source files with fonts/colors based on syntax. -Font-lock-mode is a minor mode that causes your comments to be -displayed in one face, strings in another, reserved words in another, -documentation strings in another, and so on. - -Comments will be displayed in `font-lock-comment-face'. -Strings will be displayed in `font-lock-string-face'. -Doc strings will be displayed in `font-lock-doc-string-face'. -Function and variable names (in their defining forms) will be displayed - in `font-lock-function-name-face'. -Reserved words will be displayed in `font-lock-keyword-face'. -Preprocessor conditionals will be displayed in `font-lock-preprocessor-face'." - :group 'languages) - -(defgroup font-lock-faces nil - "Faces used by the font-lock package." - :group 'font-lock - :group 'faces) - - -(defcustom font-lock-verbose t - "*If non-nil, means show status messages when fontifying. -See also `font-lock-message-threshold'." - :type 'boolean - :group 'font-lock) - -(defcustom font-lock-message-threshold 6000 - "*Minimum size of region being fontified for status messages to appear. - -The size is measured in characters. This affects `font-lock-fontify-region' -but not `font-lock-fontify-buffer'. (In other words, when you first visit -a file and it gets fontified, you will see status messages no matter what -size the file is. However, if you do something else like paste a -chunk of text or revert a buffer, you will see status messages only if the -changed region is large enough.) - -Note that setting `font-lock-verbose' to nil disables the status -messages entirely." - :type 'integer - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-auto-fontify t - "*Whether font-lock should automatically fontify files as they're loaded. -This will only happen if font-lock has fontifying keywords for the major -mode of the file. You can get finer-grained control over auto-fontification -by using this variable in combination with `font-lock-mode-enable-list' or -`font-lock-mode-disable-list'." - :type 'boolean - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-mode-enable-list nil - "*List of modes to auto-fontify, if `font-lock-auto-fontify' is nil." - :type '(repeat (symbol :tag "Mode")) - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-mode-disable-list nil - "*List of modes not to auto-fontify, if `font-lock-auto-fontify' is t." - :type '(repeat (symbol :tag "Mode")) - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-use-colors '(color) - "*Specification for when Font Lock will set up color defaults. -Normally this should be '(color), meaning that Font Lock will set up -color defaults that are only used on color displays. Set this to nil -if you don't want Font Lock to set up color defaults at all. This -should be one of - --- a list of valid tags, meaning that the color defaults will be used - when all of the tags apply. (e.g. '(color x)) --- a list whose first element is 'or and whose remaining elements are - lists of valid tags, meaning that the defaults will be used when - any of the tag lists apply. --- nil, meaning that the defaults should not be set up at all. - -\(If you specify face values in your init file, they will override any -that Font Lock specifies, regardless of whether you specify the face -values before or after loading Font Lock.) - -See also `font-lock-use-fonts'. If you want more control over the faces -used for fontification, see the documentation of `font-lock-mode' for -how to do it." - ;; Hard to do right. - :type 'sexp - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-use-fonts '(or (mono) (grayscale)) - "*Specification for when Font Lock will set up non-color defaults. - -Normally this should be '(or (mono) (grayscale)), meaning that Font -Lock will set up non-color defaults that are only used on either mono -or grayscale displays. Set this to nil if you don't want Font Lock to -set up non-color defaults at all. This should be one of - --- a list of valid tags, meaning that the non-color defaults will be used - when all of the tags apply. (e.g. '(grayscale x)) --- a list whose first element is 'or and whose remaining elements are - lists of valid tags, meaning that the defaults will be used when - any of the tag lists apply. --- nil, meaning that the defaults should not be set up at all. - -\(If you specify face values in your init file, they will override any -that Font Lock specifies, regardless of whether you specify the face -values before or after loading Font Lock.) - -See also `font-lock-use-colors'. If you want more control over the faces -used for fontification, see the documentation of `font-lock-mode' for -how to do it." - :type 'sexp - :group 'font-lock) - -;;;###autoload -(defcustom font-lock-maximum-decoration t - "*If non-nil, the maximum decoration level for fontifying. -If nil, use the minimum decoration (equivalent to level 0). -If t, use the maximum decoration available. -If a number, use that level of decoration (or if not available the maximum). -If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), -where MAJOR-MODE is a symbol or t (meaning the default). For example: - ((c++-mode . 2) (c-mode . t) (t . 1)) -means use level 2 decoration for buffers in `c++-mode', the maximum decoration -available for buffers in `c-mode', and level 1 decoration otherwise." - :type '(choice (const :tag "default" nil) - (const :tag "maximum" t) - (integer :tag "level" 1) - (repeat :menu-tag "mode specific" :tag "mode specific" - :value ((t . t)) - (cons :tag "Instance" - (radio :tag "Mode" - (const :tag "all" t) - (symbol :tag "name")) - (radio :tag "Decoration" - (const :tag "default" nil) - (const :tag "maximum" t) - (integer :tag "level" 1))))) - :group 'font-lock) - -;;;###autoload -(define-obsolete-variable-alias 'font-lock-use-maximal-decoration - 'font-lock-maximum-decoration) - -;;;###autoload -(defcustom font-lock-maximum-size (* 250 1024) - "*If non-nil, the maximum size for buffers for fontifying. -Only buffers less than this can be fontified when Font Lock mode is turned on. -If nil, means size is irrelevant. -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 . 256000) (c-mode . 256000) (rmail-mode . 1048576)) -means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one -megabyte for buffers in `rmail-mode', and size is irrelevant otherwise." - :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 'font-lock) - - -;; Fontification variables: - -;;;###autoload -(defvar font-lock-keywords nil - "A list of the keywords to highlight. -Each element should be of the form: - - MATCHER - (MATCHER . MATCH) - (MATCHER . FACENAME) - (MATCHER . HIGHLIGHT) - (MATCHER HIGHLIGHT ...) - (eval . FORM) - -where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. - -FORM is an expression, whose value should be a keyword element, -evaluated when the keyword is (first) used in a buffer. This feature -can be used to provide a keyword that can only be generated when Font -Lock mode is actually turned on. - -For highlighting single items, typically only MATCH-HIGHLIGHT is required. -However, if an item or (typically) items is to be highlighted following the -instance of another item (the anchor) then MATCH-ANCHORED may be required. - -MATCH-HIGHLIGHT should be of the form: - - (MATCH FACENAME OVERRIDE LAXMATCH) - -Where MATCHER can be either the regexp to search for, a variable -containing the regexp to search for, or the function to call to make -the search (called with one argument, the limit of the search). MATCH -is the subexpression of MATCHER to be highlighted. FACENAME is either -a symbol naming a face, or an expression whose value is the face name -to use. If you want FACENAME to be a symbol that evaluates to a face, -use a form like \"(progn sym)\". - -OVERRIDE and LAXMATCH are flags. If OVERRIDE is t, existing fontification may -be overwritten. If `keep', only parts not already fontified are highlighted. -If `prepend' or `append', existing fontification is merged with the new, in -which the new or existing fontification, respectively, takes precedence. -If LAXMATCH is non-nil, no error is signalled if there is no MATCH in MATCHER. - -For example, an element of the form highlights (if not already highlighted): - - \"\\\\\\=\" Discrete occurrences of \"foo\" in the value of the - variable `font-lock-keyword-face'. - (\"fu\\\\(bar\\\\)\" . 1) Substring \"bar\" within all occurrences of \"fubar\" in - the value of `font-lock-keyword-face'. - (\"fubar\" . fubar-face) Occurrences of \"fubar\" in the value of `fubar-face'. - (\"foo\\\\|bar\" 0 foo-bar-face t) - Occurrences of either \"foo\" or \"bar\" in the value - of `foo-bar-face', even if already highlighted. - -MATCH-ANCHORED should be of the form: - - (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...) - -Where MATCHER is as for MATCH-HIGHLIGHT with one exception; see below. -PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after -the last, instance MATCH-ANCHORED's MATCHER is used. Therefore they can be -used to initialize before, and cleanup after, MATCHER is used. Typically, -PRE-MATCH-FORM is used to move to some position relative to the original -MATCHER, before starting with MATCH-ANCHORED's MATCHER. POST-MATCH-FORM might -be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER. - -For example, an element of the form highlights (if not already highlighted): - - (\"\\\\\\=\" (0 anchor-face) (\"\\\\\\=\" nil nil (0 item-face))) - - Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent - discrete occurrences of \"item\" (on the same line) in the value of `item-face'. - (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil. Therefore \"item\" is - initially searched for starting from the end of the match of \"anchor\", and - searching for subsequent instance of \"anchor\" resumes from where searching - for \"item\" concluded.) - -The above-mentioned exception is as follows. The limit of the MATCHER search -defaults to the end of the line after PRE-MATCH-FORM is evaluated. -However, if PRE-MATCH-FORM returns a position greater than the position after -PRE-MATCH-FORM is evaluated, that position is used as the limit of the search. -It is generally a bad idea to return a position greater than the end of the -line, i.e., cause the MATCHER search to span lines. - -Note that the MATCH-ANCHORED feature is experimental; in the future, we may -replace it with other ways of providing this functionality. - -These regular expressions should not match text which spans lines. While -\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating -when you edit the buffer does not, since it considers text one line at a time. - -Be very careful composing regexps for this list; -the wrong pattern can dramatically slow things down!") -;;;###autoload -(make-variable-buffer-local 'font-lock-keywords) - -(defvar font-lock-defaults nil - "The defaults font Font Lock mode for the current buffer. -Normally, do not set this directly. If you are writing a major mode, -put a property of `font-lock-defaults' on the major-mode symbol with -the desired value. - -It should be a list - -\(KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN) - -KEYWORDS may be a symbol (a variable or function whose value is the keywords -to use for fontification) or a list of symbols. If KEYWORDS-ONLY is non-nil, -syntactic fontification (strings and comments) is not performed. If CASE-FOLD -is non-nil, the case of the keywords is ignored when fontifying. If -SYNTAX-ALIST is non-nil, it should be a list of cons pairs of the form (CHAR -. STRING) used to set the local Font Lock syntax table, for keyword and -syntactic fontification (see `modify-syntax-entry'). - -If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move -backwards outside any enclosing syntactic block, for syntactic fontification. -Typical values are `beginning-of-line' (i.e., the start of the line is known to -be outside a syntactic block), or `beginning-of-defun' for programming modes or -`backward-paragraph' for textual modes (i.e., the mode-dependent function is -known to move outside a syntactic block). If nil, the beginning of the buffer -is used as a position outside of a syntactic block, in the worst case. - -These item elements are used by Font Lock mode to set the variables -`font-lock-keywords', `font-lock-keywords-only', -`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and -`font-lock-beginning-of-syntax-function', respectively. - -Alternatively, if the value is a symbol, it should name a major mode, -and the defaults for that mode will apply.") -(make-variable-buffer-local 'font-lock-defaults) - -;; FSF uses `font-lock-defaults-alist' and expects the major mode to -;; set a value for `font-lock-defaults', but I don't like either of -;; these -- requiring the mode to set `font-lock-defaults' makes it -;; impossible to have defaults for a minor mode, and using an alist is -;; generally a bad idea for information that really should be -;; decentralized. (Who knows what strange modes might want -;; font-locking?) - -(defvar font-lock-keywords-only nil - "Non-nil means Font Lock should not do syntactic fontification. -This is normally set via `font-lock-defaults'. - -This should be nil for all ``language'' modes, but other modes, like -dired, do not have anything useful in the syntax tables (no comment -or string delimiters, etc) and so there is no need to use them and -this variable should have a value of t. - -You should not set this variable directly; its value is computed -from `font-lock-defaults', or (if that does not specify anything) -by examining the syntax table to see whether it appears to contain -anything useful.") -(make-variable-buffer-local 'font-lock-keywords-only) - -(defvar font-lock-keywords-case-fold-search nil - "Whether the strings in `font-lock-keywords' should be case-folded. -This variable is automatically buffer-local, as the correct value depends -on the language in use.") -(make-variable-buffer-local 'font-lock-keywords-case-fold-search) - -(defvar font-lock-after-fontify-buffer-hook nil - "Function or functions to run after completion of font-lock-fontify-buffer.") - -(defvar font-lock-syntax-table nil - "Non-nil means use this syntax table for fontifying. -If this is nil, the major mode's syntax table is used. -This is normally set via `font-lock-defaults'.") -(make-variable-buffer-local 'font-lock-syntax-table) - -;; These are used in the FSF version in syntactic font-locking. -;; We do this all in C. -;;; These record the parse state at a particular position, always the -;;; start of a line. Used to make -;;; `font-lock-fontify-syntactically-region' faster. -;(defvar font-lock-cache-position nil) -;(defvar font-lock-cache-state nil) -;(make-variable-buffer-local 'font-lock-cache-position) -;(make-variable-buffer-local 'font-lock-cache-state) - -;; If this is nil, we only use the beginning of the buffer if we can't use -;; `font-lock-cache-position' and `font-lock-cache-state'. -(defvar font-lock-beginning-of-syntax-function nil - "Non-nil means use this function to move back outside of a syntactic block. -If this is nil, the beginning of the buffer is used (in the worst case). -This is normally set via `font-lock-defaults'.") -(make-variable-buffer-local 'font-lock-beginning-of-syntax-function) - -(defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer - "Function to use for fontifying the buffer. -This is normally set via `font-lock-defaults'.") - -(defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer - "Function to use for unfontifying the buffer. -This is used when turning off Font Lock mode. -This is normally set via `font-lock-defaults'.") - -(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region - "Function to use for fontifying a region. -It should take two args, the beginning and end of the region, and an optional -third arg VERBOSE. If non-nil, the function should print status messages. -This is normally set via `font-lock-defaults'.") - -(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region - "Function to use for unfontifying a region. -It should take two args, the beginning and end of the region. -This is normally set via `font-lock-defaults'.") - -(defvar font-lock-inhibit-thing-lock nil - "List of Font Lock mode related modes that should not be turned on. -Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'. -This is normally set via `font-lock-defaults'.") - -;;;###autoload -(defcustom font-lock-mode nil ;; customized for the option menu. dverna - "Non nil means `font-lock-mode' is on" - :group 'font-lock - :type 'boolean - :initialize 'custom-initialize-default - :require 'font-lock - :set #'(lambda (var val) (font-lock-mode (or val 0))) - ) - -(defvar font-lock-fontified nil) ; whether we have hacked this buffer -(put 'font-lock-fontified 'permanent-local t) - -;;;###autoload -(defvar font-lock-mode-hook nil - "Function or functions to run on entry to font-lock-mode.") - -; whether font-lock-set-defaults has already been run. -(defvar font-lock-defaults-computed nil) -(make-variable-buffer-local 'font-lock-defaults-computed) - - -;;; Initialization of faces. - -;; #### barf gag retch. Horrid FSF lossage that we need to -;; keep around for compatibility with font-lock-keywords that -;; forget to properly quote their faces. -(defvar font-lock-comment-face 'font-lock-comment-face - "Don't even think of using this.") -(defvar font-lock-doc-string-face 'font-lock-doc-string-face - "Don't even think of using this.") -(defvar font-lock-string-face 'font-lock-string-face - "Don't even think of using this.") -(defvar font-lock-keyword-face 'font-lock-keyword-face - "Don't even think of using this.") -(defvar font-lock-function-name-face 'font-lock-function-name-face - "Don't even think of using this.") -(defvar font-lock-variable-name-face 'font-lock-variable-name-face - "Don't even think of using this.") -(defvar font-lock-type-face 'font-lock-type-face - "Don't even think of using this.") -(defvar font-lock-reference-face 'font-lock-reference-face - "Don't even think of using this.") -(defvar font-lock-preprocessor-face 'font-lock-preprocessor-face - "Don't even think of using this.") - -(defconst font-lock-face-list - '(font-lock-comment-face - font-lock-string-face - font-lock-doc-string-face - font-lock-keyword-face - font-lock-function-name-face - font-lock-variable-name-face - font-lock-type-face - font-lock-reference-face - font-lock-preprocessor-face - font-lock-warning-face)) - -;; #### There should be an emulation for the old font-lock-use-* -;; settings! - -(defface font-lock-comment-face - '((((class color) (background dark)) (:foreground "gray80")) - (((class color) (background light)) (:foreground "blue4")) - (((class grayscale) (background light)) - (:foreground "DimGray" :bold t :italic t)) - (((class grayscale) (background dark)) - (:foreground "LightGray" :bold t :italic t)) - (t (:bold t))) - "Font Lock mode face used to highlight comments." - :group 'font-lock-faces) - -(defface font-lock-string-face - '((((class color) (background dark)) (:foreground "tan")) - (((class color) (background light)) (:foreground "green4")) - (((class grayscale) (background light)) (:foreground "DimGray" :italic t)) - (((class grayscale) (background dark)) (:foreground "LightGray" :italic t)) - (t (:bold t))) - "Font Lock mode face used to highlight strings." - :group 'font-lock-faces) - -(defface font-lock-doc-string-face - '((((class color) (background dark)) (:foreground "light coral")) - (((class color) (background light)) (:foreground "green4")) - (t (:bold t))) - "Font Lock mode face used to highlight documentation strings." - :group 'font-lock-faces) - -(defface font-lock-keyword-face - '((((class color) (background dark)) (:foreground "cyan")) - (((class color) (background light)) (:foreground "red4")) - (((class grayscale) (background light)) (:foreground "LightGray" :bold t)) - (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) - (t (:bold t))) - "Font Lock mode face used to highlight keywords." - :group 'font-lock-faces) - -(defface font-lock-function-name-face - '((((class color) (background dark)) (:foreground "aquamarine")) - (((class color) (background light)) (:foreground "brown4")) - (t (:bold t :underline t))) - "Font Lock mode face used to highlight function names." - :group 'font-lock-faces) - -(defface font-lock-variable-name-face - '((((class color) (background dark)) (:foreground "cyan3")) - (((class color) (background light)) (:foreground "magenta4")) - (((class grayscale) (background light)) - (:foreground "Gray90" :bold t :italic t)) - (((class grayscale) (background dark)) - (:foreground "DimGray" :bold t :italic t)) - (t (:underline t))) - "Font Lock mode face used to highlight variable names." - :group 'font-lock-faces) - -(defface font-lock-type-face - '((((class color) (background dark)) (:foreground "wheat")) - (((class color) (background light)) (:foreground "steelblue")) - (((class grayscale) (background light)) (:foreground "Gray90" :bold t)) - (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) - (t (:bold t))) - "Font Lock mode face used to highlight types." - :group 'font-lock-faces) - -(defface font-lock-reference-face - '((((class color) (background dark)) (:foreground "cadetblue2")) - (((class color) (background light)) (:foreground "red3")) - (((class grayscale) (background light)) - (:foreground "LightGray" :bold t :underline t)) - (((class grayscale) (background dark)) - (:foreground "Gray50" :bold t :underline t))) - "Font Lock mode face used to highlight references." - :group 'font-lock-faces) - -;; #### FSF has font-lock-builtin-face. - -(defface font-lock-preprocessor-face - '((((class color) (background dark)) (:foreground "steelblue1")) - (((class color) (background light)) (:foreground "blue3")) - (t (:underline t))) - "Font Lock Mode face used to highlight preprocessor conditionals." - :group 'font-lock-faces) - -;; #### Currently unused -(defface font-lock-warning-face - '((((class color) (background light)) (:foreground "Red" :bold t)) - (((class color) (background dark)) (:foreground "Pink" :bold t)) - (t (:inverse-video t :bold t))) - "Font Lock mode face used to highlight warnings." - :group 'font-lock-faces) - -(defun font-lock-recompute-variables () - ;; Is this a Draconian thing to do? - (mapc #'(lambda (buffer) - (with-current-buffer buffer - (font-lock-mode 0) - (font-lock-set-defaults t))) - (buffer-list))) - -;; Backwards-compatible crud. - -(defun font-lock-reset-all-faces () - (dolist (face font-lock-face-list) - (face-spec-set face (get face 'face-defface-spec)))) - -(defun font-lock-use-default-fonts () - "Reset the font-lock faces to a default set of fonts." - (interactive) - ;; #### !!!! - (font-lock-reset-all-faces)) - -(defun font-lock-use-default-colors () - "Reset the font-lock faces to a default set of colors." - (interactive) - ;; #### !!!! - (font-lock-reset-all-faces)) - -(defun font-lock-use-default-minimal-decoration () - "Reset the font-lock patterns to a fast, minimal set of decorations." - (and font-lock-maximum-decoration - (setq font-lock-maximum-decoration nil) - (font-lock-recompute-variables))) - -(defun font-lock-use-default-maximal-decoration () - "Reset the font-lock patterns to a larger set of decorations." - (and (not (eq t font-lock-maximum-decoration)) - (setq font-lock-maximum-decoration t) - (font-lock-recompute-variables))) - - -;;;;;;;;;;;;;;;;;;;;;; actual code ;;;;;;;;;;;;;;;;;;;;;; - -;;; To fontify the whole buffer by language syntax, we go through it a -;;; character at a time, creating extents on the boundary of each syntactic -;;; unit (that is, one extent for each block comment, one for each line -;;; comment, one for each string, etc.) This is done with the C function -;;; syntactically-sectionize. It's in C for speed (the speed of lisp function -;;; calls was a real bottleneck for this task since it involves examining each -;;; character in turn.) -;;; -;;; Then we make a second pass, to fontify the buffer based on other patterns -;;; specified by regexp. When we find a match for a region of text, we need -;;; to change the fonts on those characters. This is done with the -;;; put-text-property function, which knows how to efficiently share extents. -;;; Conceptually, we are attaching some particular face to each of the -;;; characters in a range, but the implementation of this involves creating -;;; extents, or resizing existing ones. -;;; -;;; Each time a modification happens to a line, we re-fontify the entire line. -;;; We do this by first removing the extents (text properties) on the line, -;;; and then doing the syntactic and keyword passes again on that line. (More -;;; generally, each modified region is extended to include the preceding and -;;; following BOL or EOL.) -;;; -;;; This means that, as the user types, we repeatedly go back to the beginning -;;; of the line, doing more work the longer the line gets. This doesn't cost -;;; much in practice, and if we don't, then we incorrectly fontify things when, -;;; for example, inserting spaces into `intfoo () {}'. -;;; - - -;; The user level functions - -;;;###autoload -(defun font-lock-mode (&optional arg) - "Toggle Font Lock Mode. -With arg, turn font-lock mode on if and only if arg is positive. - -When Font Lock mode is enabled, text is fontified as you type it: - - - Comments are displayed in `font-lock-comment-face'; - - Strings are displayed in `font-lock-string-face'; - - Documentation strings (in Lisp-like languages) are displayed in - `font-lock-doc-string-face'; - - Language keywords (\"reserved words\") are displayed in - `font-lock-keyword-face'; - - Function names in their defining form are displayed in - `font-lock-function-name-face'; - - Variable names in their defining form are displayed in - `font-lock-variable-name-face'; - - Type names are displayed in `font-lock-type-face'; - - References appearing in help files and the like are displayed - in `font-lock-reference-face'; - - Preprocessor declarations are displayed in - `font-lock-preprocessor-face'; - - and - - - Certain other expressions are displayed in other faces according - to the value of the variable `font-lock-keywords'. - -Where modes support different levels of fontification, you can use the variable -`font-lock-maximum-decoration' to specify which level you generally prefer. -When you turn Font Lock mode on/off the buffer is fontified/defontified, though -fontification occurs only if the buffer is less than `font-lock-maximum-size'. -To fontify a buffer without turning on Font Lock mode, and regardless of buffer -size, you can use \\[font-lock-fontify-buffer]. - -See the variable `font-lock-keywords' for customization." - (interactive "P") - (let ((on-p (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode))) - (maximum-size (if (not (consp font-lock-maximum-size)) - font-lock-maximum-size - (cdr (or (assq major-mode font-lock-maximum-size) - (assq t font-lock-maximum-size)))))) - ;; Font-lock mode will refuse to turn itself on if in batch mode, or if - ;; the current buffer is "invisible". The latter is because packages - ;; sometimes put their temporary buffers into some particular major mode - ;; to get syntax tables and variables and whatnot, but we don't want the - ;; fact that the user has font-lock-mode on a mode hook to slow these - ;; things down. - (if (or noninteractive (eq (aref (buffer-name) 0) ?\ )) - (setq on-p nil)) - (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... - (setq on-p nil)) - (cond (on-p - (make-local-hook 'after-change-functions) - (add-hook 'after-change-functions - 'font-lock-after-change-function nil t) - (add-hook 'pre-idle-hook 'font-lock-pre-idle-hook)) - (t - (remove-hook 'after-change-functions - 'font-lock-after-change-function t) - (setq font-lock-defaults-computed nil - font-lock-keywords nil) - ;; We have no business doing this here, since - ;; pre-idle-hook is global. Other buffers may - ;; still be in font-lock mode. -dkindred@cs.cmu.edu - ;; (remove-hook 'pre-idle-hook 'font-lock-pre-idle-hook) - )) - (set (make-local-variable 'font-lock-mode) on-p) - (cond (on-p - (font-lock-set-defaults-1) - (make-local-hook 'before-revert-hook) - (make-local-hook 'after-revert-hook) - ;; If buffer is reverted, must clean up the state. - (add-hook 'before-revert-hook 'font-lock-revert-setup nil t) - (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t) - (run-hooks 'font-lock-mode-hook) - (cond (font-lock-fontified - nil) - ((or (null maximum-size) (<= (buffer-size) maximum-size)) - (font-lock-fontify-buffer)) - (font-lock-verbose - (lmessage 'command "Fontifying %s... buffer too big." - (buffer-name))))) - (font-lock-fontified - (setq font-lock-fontified nil) - (remove-hook 'before-revert-hook 'font-lock-revert-setup t) - (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) - (font-lock-unfontify-region (point-min) (point-max)) - (font-lock-thing-lock-cleanup)) - (t - (remove-hook 'before-revert-hook 'font-lock-revert-setup t) - (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) - (font-lock-thing-lock-cleanup))) - (redraw-modeline))) - -;; For init-file hooks -;;;###autoload -(defun turn-on-font-lock () - "Unconditionally turn on Font Lock mode." - (font-lock-mode 1)) - -;;;###autoload -(defun turn-off-font-lock () - "Unconditionally turn off Font Lock mode." - (font-lock-mode 0)) - -;;; FSF has here: - -;; support for add-keywords, global-font-lock-mode and -;; font-lock-support-mode (unified support for various *-lock modes). - - -;; Fontification functions. - -;; We first define some defsubsts to encapsulate the way we add -;; faces to a region of text. I am planning on modifying the -;; text-property mechanism so that multiple independent classes -;; of text properties can exist. That way, for example, ediff's -;; face text properties don't interfere with font lock's face -;; text properties. Due to the XEmacs implementation of text -;; properties in terms of extents, doing this is fairly trivial: -;; instead of using the `text-prop' property, you just use a -;; specified property. - -(defsubst font-lock-set-face (start end face) - ;; Set the face on the characters in the range. - (put-nonduplicable-text-property start end 'face face) - (put-nonduplicable-text-property start end 'font-lock t)) - -(defsubst font-lock-remove-face (start end) - ;; Remove any syntax highlighting on the characters in the range. - (put-nonduplicable-text-property start end 'face nil) - (put-nonduplicable-text-property start end 'font-lock nil)) - -(defsubst font-lock-any-faces-p (start end) - ;; Return non-nil if we've put any syntax highlighting on - ;; the characters in the range. - ;; - ;; used to look for 'text-prop property, but this has problems if - ;; you put any other text properties in the vicinity. Simon - ;; Marshall suggested looking for the 'face property (this is what - ;; FSF Emacs does) but that's equally bogus. Only reliable way is - ;; for font-lock to specially mark its extents. - ;; - ;; FSF's (equivalent) definition of this defsubst would be - ;; (text-property-not-all start end 'font-lock nil) - ;; - ;; Perhaps our `map-extents' is faster than our definition - ;; of `text-property-not-all'. #### If so, `text-property-not-all' - ;; should be fixed ... - ;; - (map-extents 'extent-property (current-buffer) start (1- end) 'font-lock)) - - -;; Fontification functions. - -;; Rather than the function, e.g., `font-lock-fontify-region' containing the -;; code to fontify a region, the function runs the function whose name is the -;; value of the variable, e.g., `font-lock-fontify-region-function'. Normally, -;; the value of this variable is, e.g., `font-lock-default-fontify-region' -;; which does contain the code to fontify a region. However, the value of the -;; variable could be anything and thus, e.g., `font-lock-fontify-region' could -;; do anything. The indirection of the fontification functions gives major -;; modes the capability of modifying the way font-lock.el fontifies. Major -;; modes can modify the values of, e.g., `font-lock-fontify-region-function', -;; via the variable `font-lock-defaults'. -;; -;; For example, Rmail mode sets the variable `font-lock-defaults' so that -;; font-lock.el uses its own function for buffer fontification. This function -;; makes fontification be on a message-by-message basis and so visiting an -;; RMAIL file is much faster. A clever implementation of the function might -;; fontify the headers differently than the message body. (It should, and -;; correspondingly for Mail mode, but I can't be bothered to do the work. Can -;; you?) This hints at a more interesting use... -;; -;; Languages that contain text normally contained in different major modes -;; could define their own fontification functions that treat text differently -;; depending on its context. For example, Perl mode could arrange that here -;; docs are fontified differently than Perl code. Or Yacc mode could fontify -;; rules one way and C code another. Neat! -;; -;; A further reason to use the fontification indirection feature is when the -;; default syntactual fontification, or the default fontification in general, -;; is not flexible enough for a particular major mode. For example, perhaps -;; comments are just too hairy for `font-lock-fontify-syntactically-region' to -;; cope with. You need to write your own version of that function, e.g., -;; `hairy-fontify-syntactically-region', and make your own version of -;; `hairy-fontify-region' call that function before calling -;; `font-lock-fontify-keywords-region' for the normal regexp fontification -;; pass. And Hairy mode would set `font-lock-defaults' so that font-lock.el -;; would call your region fontification function instead of its own. For -;; example, TeX modes could fontify {\foo ...} and \bar{...} etc. multi-line -;; directives correctly and cleanly. (It is the same problem as fontifying -;; multi-line strings and comments; regexps are not appropriate for the job.) - -;;;###autoload -(defun font-lock-fontify-buffer () - "Fontify the current buffer the way `font-lock-mode' would. -See `font-lock-mode' for details. - -This can take a while for large buffers." - (interactive) - (let ((font-lock-verbose (or font-lock-verbose (interactive-p)))) - (funcall font-lock-fontify-buffer-function))) - -(defun font-lock-unfontify-buffer () - (funcall font-lock-unfontify-buffer-function)) - -(defun font-lock-fontify-region (beg end &optional loudly) - (funcall font-lock-fontify-region-function beg end loudly)) - -(defun font-lock-unfontify-region (beg end &optional loudly) - (funcall font-lock-unfontify-region-function beg end loudly)) - -;; #### In these functions, the FSF is careful to do -;; (save-restriction -;; (widen) -;; before anything else. Should we copy? -(defun font-lock-default-fontify-buffer () - (interactive) - (let ((was-on font-lock-mode) - (font-lock-verbose (or font-lock-verbose (interactive-p))) - (font-lock-message-threshold 0) - (aborted nil)) - ;; Turn it on to run hooks and get the right font-lock-keywords. - (or was-on (font-lock-mode 1)) - (font-lock-unfontify-region (point-min) (point-max) t) -;; (buffer-syntactic-context-flush-cache) - - ;; If a ^G is typed during fontification, abort the fontification, but - ;; return normally (do not signal.) This is to make it easy to abort - ;; fontification if it's taking a long time, without also causing the - ;; buffer not to pop up. If a real abort is desired, the user can ^G - ;; again. - ;; - ;; Possibly this should happen down in font-lock-fontify-region instead - ;; of here, but since that happens from the after-change-hook (meaning - ;; much more frequently) I'm afraid of the bad consequences of stealing - ;; the interrupt character at inopportune times. - ;; - (condition-case nil - (save-excursion - (font-lock-fontify-region (point-min) (point-max))) - (quit - (setq aborted t))) - - (or was-on ; turn it off if it was off. - (let ((font-lock-fontified nil)) ; kludge to prevent defontification - (font-lock-mode 0))) - (set (make-local-variable 'font-lock-fontified) t) - (when (and aborted font-lock-verbose) - (lmessage 'command "Fontifying %s... aborted." (buffer-name)))) - (run-hooks 'font-lock-after-fontify-buffer-hook)) - -(defun font-lock-default-unfontify-buffer () - (font-lock-unfontify-region (point-min) (point-max)) - (set (make-local-variable 'font-lock-fontified) nil)) - -;; This used to be `font-lock-fontify-region', and before that, -;; `font-lock-fontify-region' used to be the name used for what is now -;; `font-lock-fontify-syntactically-region'. -(defun font-lock-default-fontify-region (beg end &optional loudly) - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - (old-syntax-table (syntax-table)) - buffer-file-name buffer-file-truename) - (unwind-protect - (progn - ;; Use the fontification syntax table, if any. - (if font-lock-syntax-table (set-syntax-table font-lock-syntax-table)) - ;; Now do the fontification. - (if font-lock-keywords-only - (font-lock-unfontify-region beg end) - (font-lock-fontify-syntactically-region beg end loudly)) - (font-lock-fontify-keywords-region beg end loudly)) - ;; Clean up. - (set-syntax-table old-syntax-table) - (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) - -;; The following must be rethought, since keywords can override fontification. -; ;; Now scan for keywords, but not if we are inside a comment now. -; (or (and (not font-lock-keywords-only) -; (let ((state (parse-partial-sexp beg end nil nil -; font-lock-cache-state))) -; (or (nth 4 state) (nth 7 state)))) -; (font-lock-fontify-keywords-region beg end)) - -(defun font-lock-default-unfontify-region (beg end &optional maybe-loudly) - (when (and maybe-loudly font-lock-verbose - (>= (- end beg) font-lock-message-threshold)) - (lmessage 'progress "Fontifying %s..." (buffer-name))) - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - buffer-file-name buffer-file-truename) - (font-lock-remove-face beg end) - (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))) - -;; Following is the original FSF version (similar to our original -;; version, before all the crap I added below). -;; -;; Probably that crap should either be fixed up so it works better, -;; or tossed away. -;; -;; I think that lazy-lock v2 tries to do something similar. -;; Those efforts should be merged. - -;; Called when any modification is made to buffer text. -;(defun font-lock-after-change-function (beg end old-len) -; (save-excursion -; (save-match-data -; ;; Rescan between start of line from `beg' and start of line after `end'. -; (font-lock-fontify-region -; (progn (goto-char beg) (beginning-of-line) (point)) -; (progn (goto-char end) (forward-line 1) (point)))))) - -(defvar font-lock-old-extent nil) -(defvar font-lock-old-len 0) - -(defun font-lock-fontify-glumped-region () - ;; even if something goes wrong in the fontification, mark the glumped - ;; region as fontified; otherwise, the same error might get signaled - ;; after every command. - (unwind-protect - ;; buffer/extent may be deleted. - (if (and (extent-live-p font-lock-old-extent) - (buffer-live-p (extent-object font-lock-old-extent))) - (save-excursion - (set-buffer (extent-object font-lock-old-extent)) - (font-lock-after-change-function-1 - (extent-start-position font-lock-old-extent) - (extent-end-position font-lock-old-extent) - font-lock-old-len))) - (detach-extent font-lock-old-extent) - (setq font-lock-old-extent nil))) - -(defun font-lock-pre-idle-hook () - (condition-case nil - (if font-lock-old-extent - (font-lock-fontify-glumped-region)) - (error (warn "Error caught in `font-lock-pre-idle-hook'")))) - -(defvar font-lock-always-fontify-immediately nil - "Set this to non-nil to disable font-lock deferral.") - -;;; called when any modification is made to buffer text. This function -;;; attempts to glump adjacent changes together so that excessive -;;; fontification is avoided. This function could easily be adapted -;;; to other after-change-functions. - -(defun font-lock-after-change-function (beg end old-len) - (let ((obeg (and font-lock-old-extent - (extent-start-position font-lock-old-extent))) - (oend (and font-lock-old-extent - (extent-end-position font-lock-old-extent))) - (bc-end (+ beg old-len))) - - ;; If this change can't be merged into the glumped one, - ;; we need to fontify the glumped one right now. - (if (and font-lock-old-extent - (or (not (eq (current-buffer) - (extent-object font-lock-old-extent))) - (< bc-end obeg) - (> beg oend))) - (font-lock-fontify-glumped-region)) - - (if font-lock-old-extent - ;; Update glumped region. - (progn - ;; Any characters in the before-change region that are - ;; outside the glumped region go into the glumped - ;; before-change region. - (if (> bc-end oend) - (setq font-lock-old-len (+ font-lock-old-len (- bc-end oend)))) - (if (> obeg beg) - (setq font-lock-old-len (+ font-lock-old-len (- obeg beg)))) - ;; New glumped region is the union of the glumped region - ;; and the new region. - (set-extent-endpoints font-lock-old-extent - (min obeg beg) - (max oend end))) - - ;; No glumped region, so create one. - (setq font-lock-old-extent (make-extent beg end)) - (set-extent-property font-lock-old-extent 'detachable nil) - (set-extent-property font-lock-old-extent 'end-open nil) - (setq font-lock-old-len old-len)) - - (if font-lock-always-fontify-immediately - (font-lock-fontify-glumped-region)))) - -(defun font-lock-after-change-function-1 (beg end old-len) - (if (null font-lock-mode) - nil - (save-excursion - (save-restriction - ;; if we don't widen, then fill-paragraph (and any command that - ;; operates on a narrowed region) confuses things, because the C - ;; code will fail to realize that we're inside a comment. - (widen) - (save-match-data - (let ((zmacs-region-stays zmacs-region-stays)) ; protect from change! - (goto-char beg) - ;; Maybe flush the internal cache used by syntactically-sectionize. - ;; (It'd be nice if this was more automatic.) Any deletions mean - ;; the cache is invalid, and insertions at beginning or end of line - ;; mean that the bol cache might be invalid. -;; (if (or (> old-len 0) (bobp) (= (preceding-char) ?\n)) -;; (buffer-syntactic-context-flush-cache)) - - ;; Always recompute the whole line. - (goto-char end) - (forward-line 1) - (setq end (point)) - (goto-char beg) - (beginning-of-line) - (setq beg (point)) - ;; Rescan between start of line from `beg' and start of line after - ;; `end'. - (font-lock-fontify-region beg end))))))) - - -;; Syntactic fontification functions. - -;; Note: Here is the FSF version. Our version is much faster because -;; of the C support we provide. This may be useful for reference, -;; however, and perhaps there is something useful here that should -;; be merged into our version. -;; -;(defun font-lock-fontify-syntactically-region (start end &optional loudly) -; "Put proper face on each string and comment between START and END. -;START should be at the beginning of a line." -; (let ((synstart (if comment-start-skip -; (concat "\\s\"\\|" comment-start-skip) -; "\\s\"")) -; (comstart (if comment-start-skip -; (concat "\\s<\\|" comment-start-skip) -; "\\s<")) -; state prev prevstate) -; (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) -; (save-restriction -; (widen) -; (goto-char start) -; ;; -; ;; Find the state at the `beginning-of-line' before `start'. -; (if (eq start font-lock-cache-position) -; ;; Use the cache for the state of `start'. -; (setq state font-lock-cache-state) -; ;; Find the state of `start'. -; (if (null font-lock-beginning-of-syntax-function) -; ;; Use the state at the previous cache position, if any, or -; ;; otherwise calculate from `point-min'. -; (if (or (null font-lock-cache-position) -; (< start font-lock-cache-position)) -; (setq state (parse-partial-sexp (point-min) start)) -; (setq state (parse-partial-sexp font-lock-cache-position start -; nil nil font-lock-cache-state))) -; ;; Call the function to move outside any syntactic block. -; (funcall font-lock-beginning-of-syntax-function) -; (setq state (parse-partial-sexp (point) start))) -; ;; Cache the state and position of `start'. -; (setq font-lock-cache-state state -; font-lock-cache-position start)) -; ;; -; ;; If the region starts inside a string, show the extent of it. -; (if (nth 3 state) -; (let ((beg (point))) -; (while (and (re-search-forward "\\s\"" end 'move) -; (nth 3 (parse-partial-sexp beg (point) -; nil nil state)))) -; (put-text-property beg (point) 'face font-lock-string-face) -; (setq state (parse-partial-sexp beg (point) nil nil state)))) -; ;; -; ;; Likewise for a comment. -; (if (or (nth 4 state) (nth 7 state)) -; (let ((beg (point))) -; (save-restriction -; (narrow-to-region (point-min) end) -; (condition-case nil -; (progn -; (re-search-backward comstart (point-min) 'move) -; (forward-comment 1) -; ;; forward-comment skips all whitespace, -; ;; so go back to the real end of the comment. -; (skip-chars-backward " \t")) -; (error (goto-char end)))) -; (put-text-property beg (point) 'face font-lock-comment-face) -; (setq state (parse-partial-sexp beg (point) nil nil state)))) -; ;; -; ;; Find each interesting place between here and `end'. -; (while (and (< (point) end) -; (setq prev (point) prevstate state) -; (re-search-forward synstart end t) -; (progn -; ;; Clear out the fonts of what we skip over. -; (remove-text-properties prev (point) '(face nil)) -; ;; Verify the state at that place -; ;; so we don't get fooled by \" or \;. -; (setq state (parse-partial-sexp prev (point) -; nil nil state)))) -; (let ((here (point))) -; (if (or (nth 4 state) (nth 7 state)) -; ;; -; ;; We found a real comment start. -; (let ((beg (match-beginning 0))) -; (goto-char beg) -; (save-restriction -; (narrow-to-region (point-min) end) -; (condition-case nil -; (progn -; (forward-comment 1) -; ;; forward-comment skips all whitespace, -; ;; so go back to the real end of the comment. -; (skip-chars-backward " \t")) -; (error (goto-char end)))) -; (put-text-property beg (point) 'face -; font-lock-comment-face) -; (setq state (parse-partial-sexp here (point) nil nil state))) -; (if (nth 3 state) -; ;; -; ;; We found a real string start. -; (let ((beg (match-beginning 0))) -; (while (and (re-search-forward "\\s\"" end 'move) -; (nth 3 (parse-partial-sexp here (point) -; nil nil state)))) -; (put-text-property beg (point) 'face font-lock-string-face) -; (setq state (parse-partial-sexp here (point) -; nil nil state)))))) -; ;; -; ;; Make sure `prev' is non-nil after the loop -; ;; only if it was set on the very last iteration. -; (setq prev nil))) -; ;; -; ;; Clean up. -; (and prev (remove-text-properties prev end '(face nil))))) - -(defun font-lock-fontify-syntactically-region (start end &optional loudly) - "Put proper face on each string and comment between START and END. -START should be at the beginning of a line." - (if font-lock-keywords-only - nil - (when (and font-lock-verbose - (>= (- end start) font-lock-message-threshold)) - (lmessage 'progress "Fontifying %s... (syntactically...)" - (buffer-name))) - (font-lock-unfontify-region start end loudly) - (goto-char start) - (if (> end (point-max)) (setq end (point-max))) - (syntactically-sectionize - #'(lambda (s e context depth) - (let (face) - (cond ((eq context 'string) - ;;#### Should only do this is Lisp-like modes! - (setq face - (if (= depth 1) - ;; really we should only use this if - ;; in position 3 depth 1, but that's - ;; too expensive to compute. - 'font-lock-doc-string-face - 'font-lock-string-face))) - ((or (eq context 'comment) - (eq context 'block-comment)) - (setq face 'font-lock-comment-face) -; ;; Don't fontify whitespace at the beginning of lines; -; ;; otherwise comment blocks may not line up with code. -; ;; (This is sometimes a good idea, sometimes not; in any -; ;; event it should be in C for speed --jwz) -; (save-excursion -; (goto-char s) -; (while (prog1 (search-forward "\n" (1- e) 'move) -; (setq face 'font-lock-comment-face) -; (setq e (point))) -; (skip-chars-forward " \t\n") -; (setq s (point))) - )) - (font-lock-set-face s e face))) - start end) - )) - -;;; Additional text property functions. - -;; The following three text property functions are not generally available (and -;; it's not certain that they should be) so they are inlined for speed. -;; The case for `fillin-text-property' is simple; it may or not be generally -;; useful. (Since it is used here, it is useful in at least one place.;-) -;; However, the case for `append-text-property' and `prepend-text-property' is -;; more complicated. Should they remove duplicate property values or not? If -;; so, should the first or last duplicate item remain? Or the one that was -;; added? In our implementation, the first duplicate remains. - -;; XEmacs: modified all these functions to use -;; `put-nonduplicable-text-property' instead of `put-text-property', and -;; the first one to take both SETPROP and MARKPROP, in accordance with the -;; changed definitions of `font-lock-any-faces-p' and `font-lock-set-face'. - -(defsubst font-lock-fillin-text-property (start end setprop markprop value &optional object) - "Fill in one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to put where none are -already in place. Therefore existing property values are not overwritten. -Optional argument OBJECT is the string or buffer containing the text." - (let ((start (text-property-any start end markprop nil object)) next) - (while start - (setq next (next-single-property-change start markprop object end)) - (put-nonduplicable-text-property start next setprop value object) - (put-nonduplicable-text-property start next markprop value object) - (setq start (text-property-any next end markprop nil object))))) - -;; This function (from simon's unique.el) is rewritten and inlined for speed. -;(defun unique (list function) -; "Uniquify LIST, deleting elements using FUNCTION. -;Return the list with subsequent duplicate items removed by side effects. -;FUNCTION is called with an element of LIST and a list of elements from LIST, -;and should return the list of elements with occurrences of the element removed, -;i.e., a function such as `delete' or `delq'. -;This function will work even if LIST is unsorted. See also `uniq'." -; (let ((list list)) -; (while list -; (setq list (setcdr list (funcall function (car list) (cdr list)))))) -; list) - -(defsubst font-lock-unique (list) - "Uniquify LIST, deleting elements using `delq'. -Return the list with subsequent duplicate items removed by side effects." - (let ((list list)) - (while list - (setq list (setcdr list (delq (car list) (cdr list)))))) - list) - -;; A generalisation of `facemenu-add-face' for any property, but without the -;; removal of inactive faces via `facemenu-discard-redundant-faces' and special -;; treatment of `default'. Uses `unique' to remove duplicate property values. -(defsubst font-lock-prepend-text-property (start end prop value &optional object) - "Prepend to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to prepend to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (font-lock-unique (append val (if (listp prev) prev (list prev)))) - object) - (setq start next)))) - -(defsubst font-lock-append-text-property (start end prop value &optional object) - "Append to one property of the text from START to END. -Arguments PROP and VALUE specify the property and value to append to the value -already in place. The resulting property values are always lists, and unique. -Optional argument OBJECT is the string or buffer containing the text." - (let ((val (if (listp value) value (list value))) next prev) - (while (/= start end) - (setq next (next-single-property-change start prop object end) - prev (get-text-property start prop object)) - (put-text-property - start next prop - (font-lock-unique (append (if (listp prev) prev (list prev)) val)) - object) - (setq start next)))) - -;;; Regexp fontification functions. - -(defsubst font-lock-apply-highlight (highlight) - "Apply HIGHLIGHT following a match. -HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'." - (let* ((match (nth 0 highlight)) - (start (match-beginning match)) (end (match-end match)) - (override (nth 2 highlight))) - (let ((newface (nth 1 highlight))) - (or (symbolp newface) - (setq newface (eval newface))) - (cond ((not start) - ;; No match but we might not signal an error. - (or (nth 3 highlight) - (error "No match %d in highlight %S" match highlight))) - ((= start end) nil) - ((not override) - ;; Cannot override existing fontification. - (or (font-lock-any-faces-p start end) - (font-lock-set-face start end newface))) - ((eq override t) - ;; Override existing fontification. - (font-lock-set-face start end newface)) - ((eq override 'keep) - ;; Keep existing fontification. - (font-lock-fillin-text-property start end 'face 'font-lock - newface)) - ((eq override 'prepend) - ;; Prepend to existing fontification. - (font-lock-prepend-text-property start end 'face newface)) - ((eq override 'append) - ;; Append to existing fontification. - (font-lock-append-text-property start end 'face newface)))))) - -(defsubst font-lock-fontify-anchored-keywords (keywords limit) - "Fontify according to KEYWORDS until LIMIT. -KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords', -LIMIT can be modified by the value of its PRE-MATCH-FORM." - (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights - ;; Evaluate PRE-MATCH-FORM. - (pre-match-value (eval (nth 1 keywords)))) - ;; Set LIMIT to value of PRE-MATCH-FORM or the end of line. - (if (and (numberp pre-match-value) (> pre-match-value (point))) - (setq limit pre-match-value) - (save-excursion (end-of-line) (setq limit (point)))) - (save-match-data - ;; Find an occurrence of `matcher' before `limit'. - (while (if (stringp matcher) - (re-search-forward matcher limit t) - (funcall matcher limit)) - ;; Apply each highlight to this instance of `matcher'. - (setq highlights lowdarks) - (while highlights - (font-lock-apply-highlight (car highlights)) - (setq highlights (cdr highlights))))) - ;; Evaluate POST-MATCH-FORM. - (eval (nth 2 keywords)))) - -(defun font-lock-fontify-keywords-region (start end &optional loudvar) - "Fontify according to `font-lock-keywords' between START and END. -START should be at the beginning of a line." - (let ((loudly (and font-lock-verbose - (>= (- end start) font-lock-message-threshold)))) - (let ((case-fold-search font-lock-keywords-case-fold-search) - (keywords (cdr (if (eq (car-safe font-lock-keywords) t) - font-lock-keywords - (font-lock-compile-keywords)))) - (bufname (buffer-name)) (count 0) - keyword matcher highlights) - ;; - ;; Fontify each item in `font-lock-keywords' from `start' to `end'. - (while keywords - (when loudly (lmessage 'progress "Fontifying %s... (regexps..%s)" - bufname - (make-string (setq count (1+ count)) ?.))) - ;; - ;; Find an occurrence of `matcher' from `start' to `end'. - (setq keyword (car keywords) matcher (car keyword)) - (goto-char start) - (while (and (< (point) end) - (if (stringp matcher) - (re-search-forward matcher end t) - (funcall matcher end))) - ;; Apply each highlight to this instance of `matcher', which may be - ;; specific highlights or more keywords anchored to `matcher'. - (setq highlights (cdr keyword)) - (while highlights - (if (numberp (car (car highlights))) - (let ((end (match-end (car (car highlights))))) - (font-lock-apply-highlight (car highlights)) - ;; restart search just after the end of the - ;; keyword so keywords can share bracketing - ;; expressions. - (and end (goto-char end))) - (font-lock-fontify-anchored-keywords (car highlights) end)) - (setq highlights (cdr highlights)))) - (setq keywords (cdr keywords)))) - (if loudly (lmessage 'progress "Fontifying %s... done." (buffer-name))))) - - -;; Various functions. - -;; Turn off other related packages if they're on. I prefer a hook. --sm. -;; These explicit calls are easier to understand -;; because people know what they will do. -;; A hook is a mystery because it might do anything whatever. --rms. -(defun font-lock-thing-lock-cleanup () - (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-mode -1)) - ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-mode -1)) - ((and (boundp 'lazy-shot-mode) lazy-shot-mode) - (lazy-shot-mode -1)))) - -;; Do something special for these packages after fontifying. I prefer a hook. -(defun font-lock-after-fontify-buffer () - (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-after-fontify-buffer)) - ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-after-fontify-buffer)))) - -;; If the buffer is about to be reverted, it won't be fontified afterward. -(defun font-lock-revert-setup () - (setq font-lock-fontified nil)) - -;; If the buffer has just been reverted, normally that turns off -;; Font Lock mode. So turn the mode back on if necessary. -(defalias 'font-lock-revert-cleanup 'turn-on-font-lock) - - -;; Various functions. - -(defun font-lock-compile-keywords (&optional keywords) - ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD - ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string. - (let ((keywords (or keywords font-lock-keywords))) - (setq font-lock-keywords - (if (eq (car-safe keywords) t) - keywords - (cons t (mapcar 'font-lock-compile-keyword keywords)))))) - -(defun font-lock-compile-keyword (keyword) - (cond ((nlistp keyword) ; Just MATCHER - (list keyword '(0 font-lock-keyword-face))) - ((eq (car keyword) 'eval) ; Specified (eval . FORM) - (font-lock-compile-keyword (eval (cdr keyword)))) - ((numberp (cdr keyword)) ; Specified (MATCHER . MATCH) - (list (car keyword) (list (cdr keyword) 'font-lock-keyword-face))) - ((symbolp (cdr keyword)) ; Specified (MATCHER . FACENAME) - (list (car keyword) (list 0 (cdr keyword)))) - ((nlistp (nth 1 keyword)) ; Specified (MATCHER . HIGHLIGHT) - (list (car keyword) (cdr keyword))) - (t ; Hopefully (MATCHER HIGHLIGHT ...) - keyword))) - -(defun font-lock-choose-keywords (keywords level) - ;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a - ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)). - (let ((level (if (not (consp level)) - level - (cdr (or (assq major-mode level) (assq t level)))))) - (cond ((symbolp keywords) - keywords) - ((numberp level) - (or (nth level keywords) (car (reverse keywords)))) - ((eq level t) - (car (reverse keywords))) - (t - (car keywords))))) - - -;;; Determining which set of font-lock keywords to use. - -(defun font-lock-find-font-lock-defaults (modesym) - ;; Get the defaults based on the major mode. - (let (raw-defaults) - ;; I want a do-while loop! - (while (progn - (setq raw-defaults (get modesym 'font-lock-defaults)) - (and raw-defaults (symbolp raw-defaults) - (setq modesym raw-defaults))) - ) - raw-defaults)) - -(defun font-lock-examine-syntax-table () - ; Computes the value of font-lock-keywords-only for this buffer. - (if (eq (syntax-table) (standard-syntax-table)) - ;; Assume that modes which haven't bothered to install their own - ;; syntax table don't do anything syntactically interesting. - ;; Really, the standard-syntax-table shouldn't have comments and - ;; strings in it, but changing that now might break things. - nil - ;; else map over the syntax table looking for strings or comments. - (let (got-one) - ;; XEmacs 20.0 ... - (if (fboundp 'map-syntax-table) - (setq got-one - (map-syntax-table - #'(lambda (key value) - (memq (char-syntax-from-code value) - '(?\" ?\< ?\> ?\$))) - (syntax-table))) - ;; older Emacsen. - (let ((i (1- (length (syntax-table))))) - (while (>= i 0) - (if (memq (char-syntax i) '(?\" ?\< ?\> ?\$)) - (setq got-one t i 0)) - (setq i (1- i))))) - (set (make-local-variable 'font-lock-keywords-only) (not got-one))))) - -;; font-lock-set-defaults is in fontl-hooks.el. - -;;;###autoload -(defun font-lock-set-defaults-1 (&optional explicit-defaults) - ;; does everything that font-lock-set-defaults does except - ;; enable font-lock-mode. This is called by `font-lock-mode'. - ;; Note that the return value is used! - - (if (and font-lock-defaults-computed (not explicit-defaults)) - ;; nothing to do. - nil - - (or font-lock-keywords - (let* ((defaults (or (and (not (eq t explicit-defaults)) - explicit-defaults) - ;; in case modes decide to set - ;; `font-lock-defaults' themselves, - ;; as in FSF Emacs. - font-lock-defaults - (font-lock-find-font-lock-defaults major-mode))) - (keywords (font-lock-choose-keywords - (nth 0 defaults) font-lock-maximum-decoration))) - - ;; Keywords? - (setq font-lock-keywords (if (fboundp keywords) - (funcall keywords) - (eval keywords))) - (or font-lock-keywords - ;; older way: - ;; try to look for a variable `foo-mode-font-lock-keywords', - ;; or similar. - (let ((major (symbol-name major-mode)) - (try #'(lambda (n) - (if (stringp n) (setq n (intern-soft n))) - (if (and n - (boundp n)) - n - nil)))) - (setq font-lock-keywords - (symbol-value - (or (funcall try (get major-mode 'font-lock-keywords)) - (funcall try (concat major "-font-lock-keywords")) - (funcall try (and (string-match "-mode\\'" major) - (concat (substring - major 0 - (match-beginning 0)) - "-font-lock-keywords"))) - 'font-lock-keywords))))) - - ;; Case fold? - (if (>= (length defaults) 3) - (setq font-lock-keywords-case-fold-search (nth 2 defaults)) - ;; older way: - ;; look for a property 'font-lock-keywords-case-fold-search on - ;; the major-mode symbol. - (let* ((nonexist (make-symbol "")) - (value (get major-mode 'font-lock-keywords-case-fold-search - nonexist))) - (if (not (eq nonexist value)) - (setq font-lock-keywords-case-fold-search value)))) - - ;; Syntactic? - (if (>= (length defaults) 2) - (setq font-lock-keywords-only (nth 1 defaults)) - ;; older way: - ;; cleverly examine the syntax table. - (font-lock-examine-syntax-table)) - - ;; Syntax table? - (if (nth 3 defaults) - (let ((slist (nth 3 defaults))) - (setq font-lock-syntax-table - (copy-syntax-table (syntax-table))) - (while slist - (modify-syntax-entry (car (car slist)) (cdr (car slist)) - font-lock-syntax-table) - (setq slist (cdr slist))))) - - ;; Syntax function? - (cond (defaults - (setq font-lock-beginning-of-syntax-function - (nth 4 defaults))) - (t - ;; older way: - ;; defaults not specified at all, so use `beginning-of-defun'. - (setq font-lock-beginning-of-syntax-function - 'beginning-of-defun))))) - - (setq font-lock-defaults-computed t))) - - -;;;;;;;;;;;;;;;;;;;;;; keywords ;;;;;;;;;;;;;;;;;;;;;; - -;;; Various major-mode interfaces. -;;; Probably these should go in with the source of the respective major modes. - -;; The defaults and keywords listed here should perhaps be moved into -;; mode-specific files. - -;; For C and Lisp modes we use `beginning-of-defun', rather than nil, -;; for SYNTAX-BEGIN. Thus the calculation of the cache is usually -;; faster but not infallible, so we risk mis-fontification. --sm. - -(put 'c-mode 'font-lock-defaults - '((c-font-lock-keywords - c-font-lock-keywords-1 c-font-lock-keywords-2 c-font-lock-keywords-3) - nil nil ((?_ . "w")) beginning-of-defun)) -(put 'c++-c-mode 'font-lock-defaults 'c-mode) -(put 'elec-c-mode 'font-lock-defaults 'c-mode) - -(put 'c++-mode 'font-lock-defaults - '((c++-font-lock-keywords - c++-font-lock-keywords-1 c++-font-lock-keywords-2 - c++-font-lock-keywords-3) - nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun)) - -(put 'java-mode 'font-lock-defaults - '((java-font-lock-keywords - java-font-lock-keywords-1 java-font-lock-keywords-2 - java-font-lock-keywords-3) - nil nil ((?_ . "w")) beginning-of-defun - (font-lock-mark-block-function . mark-defun))) - -(put 'lisp-mode 'font-lock-defaults - '((lisp-font-lock-keywords - lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) - nil nil - ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") - (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") - (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) - beginning-of-defun)) -(put 'emacs-lisp-mode 'font-lock-defaults 'lisp-mode) -(put 'lisp-interaction-mode 'font-lock-defaults 'lisp-mode) - -(put 'scheme-mode 'font-lock-defaults - '(scheme-font-lock-keywords - nil t - ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") - (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") - (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) - beginning-of-defun)) -(put 'inferior-scheme-mode 'font-lock-defaults 'scheme-mode) -(put 'scheme-interaction-mode 'font-lock-defaults 'scheme-mode) - -(put 'tex-mode 'font-lock-defaults - ;; For TeX modes we could use `backward-paragraph' for the same reason. - '(tex-font-lock-keywords nil nil ((?$ . "\"")))) -;; the nine billion names of TeX mode... -(put 'bibtex-mode 'font-lock-defaults 'tex-mode) -(put 'plain-tex-mode 'font-lock-defaults 'tex-mode) -(put 'slitex-tex-mode 'font-lock-defaults 'tex-mode) -(put 'SliTeX-mode 'font-lock-defaults 'tex-mode) -(put 'slitex-mode 'font-lock-defaults 'tex-mode) -(put 'latex-tex-mode 'font-lock-defaults 'tex-mode) -(put 'LaTex-tex-mode 'font-lock-defaults 'tex-mode) -(put 'latex-mode 'font-lock-defaults 'tex-mode) -(put 'LaTeX-mode 'font-lock-defaults 'tex-mode) -(put 'japanese-LaTeX-mode 'font-lock-defaults 'tex-mode) -(put 'japanese-SliTeX-mode 'font-lock-defaults 'tex-mode) -(put 'FoilTeX-mode 'font-lock-defaults 'tex-mode) -(put 'LATeX-MoDe 'font-lock-defaults 'tex-mode) -(put 'lATEx-mODe 'font-lock-defaults 'tex-mode) -;; ok, this is getting a bit silly ... -(put 'eDOm-xETAl 'font-lock-defaults 'tex-mode) - -;;; Various regexp information shared by several modes. -;;; Information specific to a single mode should go in its load library. - -(defconst lisp-font-lock-keywords-1 - (list - ;; Anything not a variable or type declaration is fontified as a function. - ;; It would be cleaner to allow preceding whitespace, but it would also be - ;; about five times slower. - (list (concat "^(\\(def\\(" - ;; Variable declarations. - "\\(const\\(\\|ant\\)\\|ine-key\\(\\|-after\\)\\|var\\|custom\\)\\|" - ;; Structure declarations. - "\\(class\\|struct\\|type\\)\\|" - ;; Everything else is a function declaration. - "\\([^ \t\n\(\)]+\\)" - "\\)\\)\\>" - ;; Any whitespace and declared object. - "[ \t'\(]*" - "\\([^ \t\n\)]+\\)?") - '(1 font-lock-keyword-face) - '(8 (cond ((match-beginning 3) 'font-lock-variable-name-face) - ((match-beginning 6) 'font-lock-type-face) - (t 'font-lock-function-name-face)) - nil t)) - ) - "Subdued level highlighting Lisp modes.") - -(defconst lisp-font-lock-keywords-2 - (append lisp-font-lock-keywords-1 - (list - ;; - ;; Control structures. ELisp and CLisp combined. - ;; - ;;(regexp-opt - ;; '("cond" "if" "while" "let" "let*" "prog" "progn" "prog1" - ;; "prog2" "progv" "catch" "throw" "save-restriction" - ;; "save-excursion" "save-window-excursion" - ;; "save-current-buffer" "with-current-buffer" - ;; "with-temp-file" "with-temp-buffer" "with-output-to-string" - ;; "with-string-as-buffer-contents" - ;; "save-selected-window" "save-match-data" "unwind-protect" - ;; "condition-case" "track-mouse" "autoload" - ;; "eval-after-load" "eval-and-compile" "eval-when-compile" - ;; "when" "unless" "do" "dolist" "dotimes" "flet" "labels" - ;; "lambda" "return" "return-from")) - (cons - (concat - "(\\(" - "autoload\\|c\\(atch\\|ond\\(ition-case\\)?\\)\\|do\\(list\\|" - "times\\)?\\|eval-\\(a\\(fter-load\\|nd-compile\\)\\|when-compile\\)\\|" - "flet\\|if\\|l\\(a\\(bels\\|mbda\\)\\|et\\*?\\)\\|" - "prog[nv12\\*]?\\|return\\(-from\\)?\\|save-\\(current-buffer\\|" - "excursion\\|match-data\\|restriction\\|selected-window\\|" - "window-excursion\\)\\|t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|" - "wind-protect\\)\\|w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|" - "output-to-string\\|string-as-buffer-contents\\|temp-\\(buffer\\|" - "file\\)\\)\\)" - "\\)\\>") 1) - ;; - ;; Feature symbols as references. - '("(\\(featurep\\|provide\\|require\\)\\>[ \t']*\\(\\sw+\\)?" - (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) - ;; - ;; Words inside \\[] tend to be for `substitute-command-keys'. - '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend) - ;; - ;; Words inside `' tend to be symbol names. - '("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend) - ;; - ;; CLisp `:' keywords as references. - '("\\<:\\sw+\\>" 0 font-lock-reference-face prepend) - ;; - ;; ELisp and CLisp `&' keywords as types. - '("\\<\\&\\(optional\\|rest\\|whole\\)\\>" . font-lock-type-face) - )) - "Gaudy level highlighting for Lisp modes.") - -(defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 - "Default expressions to highlight in Lisp modes.") - -;; The previous version, before replacing it with the FSF version. -;(defconst lisp-font-lock-keywords-1 (purecopy -; '(;; -; ;; highlight defining forms. This doesn't work too nicely for -; ;; (defun (setf foo) ...) but it does work for (defvar foo) which -; ;; is more important. -; ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) -; ;; -; ;; highlight CL keywords (three clauses seems faster than one) -; ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) -; ("(:\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) -; ("':\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) -; ;; -; ;; this is highlights things like (def* (setf foo) (bar baz)), but may -; ;; be slower (I haven't really thought about it) -;; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" -;; 1 font-lock-function-name-face) -; )) -; "For consideration as a value of `lisp-font-lock-keywords'. -;This does fairly subdued highlighting.") -; -;(defconst lisp-font-lock-keywords-2 (purecopy -; (append lisp-font-lock-keywords-1 -; '(;; -; ;; Highlight control structures -; ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) -; ("(\\(while\\|do\\|let\\*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) -; ("(\\(do\\*\\|dotimes\\|dolist\\|loop\\)[ \t\n]" . 1) -; ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) -; ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) -; ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) -; ;; -; ;; highlight function names in emacs-lisp docstrings (in the syntax -; ;; that substitute-command-keys understands.) -; ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) -; ;; -; ;; highlight words inside `' which tend to be function names -; ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" -; 1 font-lock-keyword-face t) -; ))) -; "For consideration as a value of `lisp-font-lock-keywords'. -; -;This does a lot more highlighting.") - -(defvar scheme-font-lock-keywords - (eval-when-compile - (list - ;; - ;; Declarations. Hannes Haug says - ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS. - (list (concat "(\\(define\\(" - ;; Function names. - "\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|" - ;; Macro names, as variable names. A bit dubious, this. - "\\(-syntax\\)\\|" - ;; Class names. - "\\(-class\\)" - "\\)\\)\\>" - ;; Any whitespace and declared object. - "[ \t]*(?" - "\\(\\sw+\\)?") - '(1 font-lock-keyword-face) - '(8 (cond ((match-beginning 3) 'font-lock-function-name-face) - ((match-beginning 6) 'font-lock-variable-name-face) - (t 'font-lock-type-face)) - nil t)) - ;; - ;; Control structures. -;(regexp-opt '("begin" "call-with-current-continuation" "call/cc" -; "call-with-input-file" "call-with-output-file" "case" "cond" -; "do" "else" "for-each" "if" "lambda" -; "let\\*?" "let-syntax" "letrec" "letrec-syntax" -; ;; Hannes Haug wants: -; "and" "or" "delay" -; ;; Stefan Monnier says don't bother: -; ;;"quasiquote" "quote" "unquote" "unquote-splicing" -; "map" "syntax" "syntax-rules")) - (cons - (concat "(\\(" - "and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|" - "input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|" - "d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|" - "l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|" - "map\\|or\\|syntax\\(\\|-rules\\)" - "\\)\\>") 1) - ;; - ;; David Fox for SOS/STklos class specifiers. - '("\\<<\\sw+>\\>" . font-lock-type-face) - ;; - ;; Scheme `:' keywords as references. - '("\\<:\\sw+\\>" . font-lock-reference-face) - )) -"Default expressions to highlight in Scheme modes.") - -;; The previous version, before replacing it with the FSF version. -;(defconst scheme-font-lock-keywords (purecopy -; '(("(define[ \t]+(?\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) -; ("(\\(cond\\|lambda\\|begin\\|if\\|else\\|case\\|do\\)[ \t\n]" . 1) -; ("(\\(\\|letrec\\|let\\*?\\|set!\\|and\\|or\\)[ \t\n]" . 1) -; ("(\\(quote\\|unquote\\|quasiquote\\|unquote-splicing\\)[ \t\n]" . 1) -; ("(\\(syntax\\|syntax-rules\\|define-syntax\\|let-syntax\\|letrec-syntax\\)[ \t\n]" . 1))) -; "Expressions to highlight in Scheme buffers.") - -(defconst c-font-lock-keywords-1 nil - "Subdued level highlighting for C modes.") - -(defconst c-font-lock-keywords-2 nil - "Medium level highlighting for C modes.") - -(defconst c-font-lock-keywords-3 nil - "Gaudy level highlighting for C modes.") - -(defconst c++-font-lock-keywords-1 nil - "Subdued level highlighting for C++ modes.") - -(defconst c++-font-lock-keywords-2 nil - "Medium level highlighting for C++ modes.") - -(defconst c++-font-lock-keywords-3 nil - "Gaudy level highlighting for C++ modes.") - -(defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit) - ;; Match, and move over, any declaration/definition item after point. - ;; The expect syntax of an item is "word" or "word::word", possibly ending - ;; with optional whitespace and a "(". Everything following the item (but - ;; belonging to it) is expected to by skip-able by `forward-sexp', and items - ;; are expected to be separated with a "," or ";". - (if (looking-at "[ \t*&]*\\(\\(?:\\sw\\|\\s_\\)+\\)\\(::\\(\\(?:\\sw\\|\\s_\\)+\\)\\)?[ \t]*\\((\\)?") - (save-match-data - (condition-case nil - (save-restriction - ;; Restrict to the end of line, currently guaranteed to be LIMIT. - (narrow-to-region (point-min) limit) - (goto-char (match-end 1)) - ;; Move over any item value, etc., to the next item. - (while (not (looking-at "[ \t]*\\([,;]\\|$\\)")) - (goto-char (or (scan-sexps (point) 1) (point-max)))) - (goto-char (match-end 0))) - (error t))))) - -(let ((c-keywords -; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while") - "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while") - (c-type-types -; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" -; "signed" "unsigned" "short" "long" "int" "char" "float" "double" -; "void" "volatile" "const") - (concat "auto\\|c\\(har\\|onst\\)\\|double\\|e\\(num\\|xtern\\)\\|" - "float\\|int\\|long\\|register\\|" - "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|" - "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)")) ; 6 ()s deep. - (c++-keywords -; ("break" "continue" "do" "else" "for" "if" "return" "switch" "while" -; "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try" -; "protected" "private" "public") - (concat "asm\\|break\\|c\\(atch\\|ontinue\\)\\|d\\(elete\\|o\\)\\|" - "else\\|for\\|if\\|new\\|" - "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|return\\|" - "s\\(izeof\\|witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while")) - (c++-type-types -; ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum" -; "signed" "unsigned" "short" "long" "int" "char" "float" "double" -; "void" "volatile" "const" "class" "inline" "friend" "bool" -; "virtual" "complex" "template") - (concat "auto\\|bool\\|c\\(har\\|lass\\|o\\(mplex\\|nst\\)\\)\\|" - "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|" - "in\\(line\\|t\\)\\|long\\|register\\|" - "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|" - "t\\(emplate\\|ypedef\\)\\|un\\(ion\\|signed\\)\\|" - "v\\(irtual\\|o\\(id\\|latile\\)\\)")) ; 11 ()s deep. - (ctoken "\\(\\sw\\|\\s_\\|[:~*&]\\)+") - ) - (setq c-font-lock-keywords-1 - (list - ;; - ;; These are all anchored at the beginning of line for speed. - ;; - ;; Fontify function name definitions (GNU style; without type on line). - - ;; In FSF this has the simpler definition of "\\sw+" for ctoken. - ;; I'm not sure if ours is more correct. - ;; This is a subset of the next rule, and is slower when present. --dmoore - ;; (list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) - ;; - ;; fontify the names of functions being defined. - ;; FSF doesn't have this but I think it should be fast for us because - ;; our regexp routines are more intelligent than FSF's about handling - ;; anchored-at-newline. (When I added this hack in regex.c, it halved - ;; the time to do the regexp phase of font-lock for a C file!) Not - ;; including this discriminates against those who don't follow the - ;; GNU coding style. --ben - ;; x?x?x?y?z should always be: (x(xx?)?)?y?z --dmoore - (list (concat - "^\\(" - "\\(" ctoken "[ \t]+\\)" ; type specs; there can be no - "\\(" - "\\(" ctoken "[ \t]+\\)" ; more than 3 tokens, right? - "\\(" ctoken "[ \t]+\\)" - "?\\)?\\)?" - "\\([*&]+[ \t]*\\)?" ; pointer - "\\(" ctoken "\\)[ \t]*(") ; name - 10 'font-lock-function-name-face) - ;; - ;; This is faster but not by much. I don't see why not. - ;(list (concat "^\\(" ctoken "\\)[ \t]*(") 1 'font-lock-function-name-face) - ;; - ;; Added next two; they're both jolly-good fastmatch candidates so - ;; should be fast. --ben - ;; - ;; Fontify structure names (in structure definition form). - (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" - "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") - 2 'font-lock-function-name-face) - ;; - ;; Fontify case clauses. This is fast because its anchored on the left. - '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)[ \t]+:". 1) - ;; - '("\\<\\(default\\):". 1) - ;; Fontify filenames in #include <...> preprocessor directives as strings. - '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) - ;; - ;; Fontify function macro names. - '("^#[ \t]*define[ \t]+\\(\\(\\sw+\\)(\\)" 2 font-lock-function-name-face) - ;; - ;; Fontify symbol names in #if ... defined preprocessor directives. - '("^#[ \t]*if\\>" - ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil - (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t))) - ;; - ;; Fontify symbol names in #elif ... defined preprocessor directives. - '("^#[ \t]*elif\\>" - ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil - (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t))) - ;; - ;; Fontify otherwise as symbol names, and the preprocessor directive names. - '("^\\(#[ \t]*[a-z]+\\)\\>[ \t]*\\(\\sw+\\)?" - (1 font-lock-preprocessor-face) (2 font-lock-variable-name-face nil t)) - )) - - (setq c-font-lock-keywords-2 - (append c-font-lock-keywords-1 - (list - ;; - ;; Simple regexps for speed. - ;; - ;; Fontify all type specifiers. - (cons (concat "\\<\\(" c-type-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify all builtin keywords (except case, default and goto; see below). - (cons (concat "\\<\\(" c-keywords "\\)\\>") 'font-lock-keyword-face) - ;; - ;; Fontify case/goto keywords and targets, and case default/goto tags. - '("\\<\\(case\\|goto\\)\\>[ \t]*\\([^ \t\n:;]+\\)?" - (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) - '("^[ \t]*\\(\\sw+\\)[ \t]*:" 1 font-lock-reference-face) - ))) - - (setq c-font-lock-keywords-3 - (append c-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - ;; We still have to fontify type specifiers individually, as C is so hairy. - (list - ;; - ;; Fontify all storage classes and type specifiers, plus their items. - (list (concat "\\<\\(" c-type-types "\\)\\>" - "\\([ \t*&]+\\sw+\\>\\)*") - ;; Fontify each declaration item. - '(font-lock-match-c++-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (goto-char (or (match-beginning 8) (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)))) - ;; - ;; Fontify structures, or typedef names, plus their items. - '("\\(}\\)[ \t*]*\\sw" - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (goto-char (match-end 1)) nil - (1 (if (match-beginning 4) - font-lock-function-name-face - font-lock-variable-name-face)))) - ;; - ;; Fontify anything at beginning of line as a declaration or definition. - '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" - (1 font-lock-type-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 4) - font-lock-function-name-face - font-lock-variable-name-face)))) - ))) - - (setq c++-font-lock-keywords-1 - (append - ;; - ;; The list `c-font-lock-keywords-1' less that for function names. - ;; the simple function form regexp has been removed. --dmoore - ;;(cdr c-font-lock-keywords-1) - c-font-lock-keywords-1 - ;; - ;; Fontify function name definitions, possibly incorporating class name. - (list - '("^\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*(" - (1 (if (match-beginning 2) - font-lock-type-face - font-lock-function-name-face)) - (3 (if (match-beginning 2) font-lock-function-name-face) nil t)) - ))) - - (setq c++-font-lock-keywords-2 - (append c++-font-lock-keywords-1 - (list - ;; - ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading. - (cons (concat "\\<\\(" c++-type-types "\\)\\>") 'font-lock-type-face) - ;; - ;; Fontify operator function name overloading. - '("\\<\\(operator\\)\\>[ \t]*\\([][)(>[ \t]*\\([^ \t\n:;]+\\)?" - (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)) - '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-reference-face) - ;; - ;; Fontify other builtin keywords. - (cons (concat "\\<\\(" c++-keywords "\\)\\>") 'font-lock-keyword-face) - ))) - - (setq c++-font-lock-keywords-3 - (append c++-font-lock-keywords-2 - ;; - ;; More complicated regexps for more complete highlighting for types. - (list - ;; - ;; Fontify all storage classes and type specifiers, plus their items. - (list (concat "\\<\\(" c++-type-types "\\)\\>" - "\\([ \t*&]+\\sw+\\>\\)*") - ;; Fontify each declaration item. - '(font-lock-match-c++-style-declaration-item-and-skip-to-next - ;; Start with point after all type specifiers. - (goto-char (or (match-beginning 13) (match-end 1))) - ;; Finish with point after first type specifier. - (goto-char (match-end 1)) - ;; Fontify as a variable or function name. - (1 (cond ((match-beginning 2) 'font-lock-type-face) - ((match-beginning 4) 'font-lock-function-name-face) - (t 'font-lock-variable-name-face))) - (3 (if (match-beginning 4) - 'font-lock-function-name-face - 'font-lock-variable-name-face) nil t))) - ;; - ;; Fontify structures, or typedef names, plus their items. - '("\\(}\\)[ \t*]*\\sw" - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (goto-char (match-end 1)) nil - (1 (if (match-beginning 4) - font-lock-function-name-face - font-lock-variable-name-face)))) - ;; - ;; Fontify anything at beginning of line as a declaration or definition. - '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*" - (1 font-lock-type-face) - (font-lock-match-c++-style-declaration-item-and-skip-to-next - (goto-char (or (match-beginning 2) (match-end 1))) nil - (1 (cond ((match-beginning 2) 'font-lock-type-face) - ((match-beginning 4) 'font-lock-function-name-face) - (t 'font-lock-variable-name-face))) - (3 (if (match-beginning 4) - 'font-lock-function-name-face - 'font-lock-variable-name-face) nil t))) - ))) - ) - -(defvar c-font-lock-keywords c-font-lock-keywords-1 - "Default expressions to highlight in C mode.") - -(defvar c++-font-lock-keywords c++-font-lock-keywords-1 - "Default expressions to highlight in C++ mode.") - -;;; Java. - -;; Java support has been written by XEmacs people, and it's apparently -;; totally divergent from the FSF. I don't know if it's better or -;; worse, so I'm leaving it in until someone convinces me the FSF -;; version is better. --hniksic - -(defconst java-font-lock-keywords-1 nil - "For consideration as a value of `java-font-lock-keywords'. -This does fairly subdued highlighting.") - -(defconst java-font-lock-keywords-2 nil - "For consideration as a value of `java-font-lock-keywords'. -This adds highlighting of types and identifier names.") - -(defconst java-font-lock-keywords-3 nil - "For consideration as a value of `java-font-lock-keywords'. -This adds highlighting of Java documentation tags, such as @see.") - -(defvar java-font-lock-type-regexp - (concat "\\<\\(boolean\\|byte\\|char\\|double\\|float\\|int" - "\\|long\\|short\\|void\\)\\>") - "Regexp which should match a primitive type.") - -(let ((capital-letter "A-Z\300-\326\330-\337") - (letter "a-zA-Z_$\300-\326\330-\366\370-\377") - (digit "0-9")) -(defvar java-font-lock-identifier-regexp - (concat "\\<\\([" letter "][" letter digit "]*\\)\\>") - "Regexp which should match all Java identifiers.") - -(defvar java-font-lock-class-name-regexp - (concat "\\<\\([" capital-letter "][" letter digit "]*\\)\\>") - "Regexp which should match a class or an interface name. -The name is assumed to begin with a capital letter.") -) - - -(let ((java-modifier-regexp - (concat "\\<\\(abstract\\|const\\|final\\|native\\|" - "private\\|protected\\|public\\|" - "static\\|synchronized\\|transient\\|volatile\\)\\>"))) - - ;; Basic font-lock support: - (setq java-font-lock-keywords-1 - (list - ;; Keywords: - (list - (concat - "\\<\\(" - "break\\|byvalue\\|" - "case\\|cast\\|catch\\|class\\|continue\\|" - "do\\|else\\|extends\\|" - "finally\\|for\\|future\\|" - "generic\\|goto\\|" - "if\\|implements\\|import\\|" - "instanceof\\|interface\\|" - "new\\|package\\|return\\|switch\\|" - "throws?\\|try\\|while\\)\\>") - 1 'font-lock-keyword-face) - - ;; Modifiers: - (list java-modifier-regexp 1 font-lock-type-face) - - ;; Special constants: - '("\\<\\(this\\|super\\)\\>" (1 font-lock-reference-face)) - '("\\<\\(false\\|null\\|true\\)\\>" (1 font-lock-keyword-face)) - - ;; Class names: - (list (concat "\\\\s *" java-font-lock-identifier-regexp) - 1 'font-lock-function-name-face) - - ;; Package declarations: - (list (concat "\\<\\(package\\|import\\)\\>\\s *" - java-font-lock-identifier-regexp) - '(2 font-lock-reference-face) - (list (concat - "\\=\\.\\(" java-font-lock-identifier-regexp "\\)") - nil nil '(1 (if (equal (char-after (match-end 0)) ?.) - 'font-lock-reference-face - 'font-lock-type-face)))) - - ;; Constructors: - (list (concat - "^\\s *\\(" java-modifier-regexp "\\s +\\)*" - java-font-lock-class-name-regexp "\\s *\(") - (list 3 - '(condition-case nil - (save-excursion - (goto-char (scan-sexps (- (match-end 0) 1) 1)) - (parse-partial-sexp (point) (point-max) nil t) - (and (looking-at "\\($\\|\\\\|{\\)") - 'font-lock-function-name-face)) - (error 'font-lock-function-name-face)))) - - ;; Methods: - (list (concat "\\(" java-font-lock-type-regexp "\\|" - java-font-lock-class-name-regexp "\\)" - "\\s *\\(\\[\\s *\\]\\s *\\)*" - java-font-lock-identifier-regexp "\\s *\(") - 5 - 'font-lock-function-name-face) - - ;; Labels: - (list ":" - (list - (concat "^\\s *" java-font-lock-identifier-regexp "\\s *:") - '(beginning-of-line) '(end-of-line) - '(1 font-lock-reference-face))) - - ;; `break' and continue' destination labels: - (list (concat "\\<\\(break\\|continue\\)\\>\\s *" - java-font-lock-identifier-regexp) - 2 'font-lock-reference-face) - - ;; Case statements: - ;; In Java, any constant expression is allowed. - '("\\\\s *\\(.*\\):" 1 font-lock-reference-face))) - - ;; Types and declared variable names: - (setq java-font-lock-keywords-2 - (append - - java-font-lock-keywords-1 - (list - ;; Keywords followed by a type: - (list (concat "\\<\\(extends\\|instanceof\\|new\\)\\>\\s *" - java-font-lock-identifier-regexp) - '(2 (if (equal (char-after (match-end 0)) ?.) - 'font-lock-reference-face 'font-lock-type-face)) - (list (concat "\\=\\." java-font-lock-identifier-regexp) - '(goto-char (match-end 0)) nil - '(1 (if (equal (char-after (match-end 0)) ?.) - 'font-lock-reference-face 'font-lock-type-face)))) - - ;; Keywords followed by a type list: - (list (concat "\\<\\(implements\\|throws\\)\\>\\ s*" - java-font-lock-identifier-regexp) - '(2 (if (equal (char-after (match-end 0)) ?.) - font-lock-reference-face font-lock-type-face)) - (list (concat "\\=\\(\\.\\|\\s *\\(,\\)\\s *\\)" - java-font-lock-identifier-regexp) - '(goto-char (match-end 0)) nil - '(3 (if (equal (char-after (match-end 0)) ?.) - font-lock-reference-face font-lock-type-face)))) - - ;; primitive types, can't be confused with anything else. - (list java-font-lock-type-regexp - '(1 font-lock-type-face) - '(font-lock-match-java-declarations - (goto-char (match-end 0)) - (goto-char (match-end 0)) - (0 font-lock-variable-name-face))) - - ;; Declarations, class types and capitalized variables: - ;; - ;; Declarations are easy to recognize. Capitalized words - ;; followed by a closing parenthesis are treated as casts if they - ;; also are followed by an expression. Expressions beginning with - ;; a unary numerical operator, e.g. +, can't be cast to an object - ;; type. - ;; - ;; The path of a fully qualified type, e.g. java.lang.Foo, is - ;; fontified in the reference face. - ;; - ;; An access to a static field, e.g. System.out.println, is - ;; not fontified since it can't be distinguished from the - ;; usage of a capitalized variable, e.g. Foo.out.println. - - (list (concat java-font-lock-class-name-regexp - "\\s *\\(\\[\\s *\\]\\s *\\)*" - "\\(\\<\\|$\\|)\\s *\\([\(\"]\\|\\<\\)\\)") - '(1 (save-match-data - (save-excursion - (goto-char - (match-beginning 3)) - (if (not (looking-at "\\")) - 'font-lock-type-face)))) - (list (concat "\\=" java-font-lock-identifier-regexp "\\.") - '(progn - (goto-char (match-beginning 0)) - (while (or (= (preceding-char) ?.) - (= (char-syntax (preceding-char)) ?w)) - (backward-char))) - '(goto-char (match-end 0)) - '(1 font-lock-reference-face) - '(0 nil)) ; Workaround for bug in XEmacs. - '(font-lock-match-java-declarations - (goto-char (match-end 1)) - (goto-char (match-end 0)) - (1 font-lock-variable-name-face)))))) - - ;; Modifier keywords and Java doc tags - (setq java-font-lock-keywords-3 - (append - - '( - ;; Feature scoping: - ;; These must come first or the Modifiers from keywords-1 will - ;; catch them. We don't want to use override fontification here - ;; because then these terms will be fontified within comments. - ("\\" 0 font-lock-string-face) - ("\\" 0 font-lock-preprocessor-face) - ("\\" 0 font-lock-reference-face)) - java-font-lock-keywords-2 - - (list - - ;; Java doc tags - '("@\\(author\\|exception\\|param\\|return\\|see\\|version\\)\\s " - 0 font-lock-keyword-face t) - - ;; Doc tag - Parameter identifiers - (list (concat "@param\\s +" java-font-lock-identifier-regexp) - 1 'font-lock-variable-name-face t) - - ;; Doc tag - Exception types - (list (concat "@exception\\ s*" - java-font-lock-identifier-regexp) - '(1 (if (equal (char-after (match-end 0)) ?.) - font-lock-reference-face font-lock-type-face) t) - (list (concat "\\=\\." java-font-lock-identifier-regexp) - '(goto-char (match-end 0)) nil - '(1 (if (equal (char-after (match-end 0)) ?.) - 'font-lock-reference-face 'font-lock-type-face) t))) - - ;; Doc tag - Cross-references, usually to methods - '("@see\\s +\\(\\S *[^][ \t\n\r\f(){},.;:]\\)" - 1 font-lock-function-name-face t) - - ))) - ) - -(defvar java-font-lock-keywords java-font-lock-keywords-1 - "Additional expressions to highlight in Java mode.") - -;; Match and move over any declaration/definition item after -;; point. Does not match items which look like a type declaration -;; (primitive types and class names, i.e. capitalized words.) -;; Should the variable name be followed by a comma, we reposition -;; the cursor to fontify more identifiers. -(defun font-lock-match-java-declarations (limit) - "Match and skip over variable definitions." - (if (looking-at "\\s *\\(\\[\\s *\\]\\s *\\)*") - (goto-char (match-end 0))) - (and - (looking-at java-font-lock-identifier-regexp) - (save-match-data - (not (string-match java-font-lock-type-regexp - (buffer-substring (match-beginning 1) - (match-end 1))))) - (save-match-data - (save-excursion - (goto-char (match-beginning 1)) - (not (looking-at - (concat java-font-lock-class-name-regexp - "\\s *\\(\\[\\s *\\]\\s *\\)*\\<"))))) - (save-match-data - (condition-case nil - (save-restriction - (narrow-to-region (point-min) limit) - (goto-char (match-end 0)) - ;; Note: Both `scan-sexps' and the second goto-char can - ;; generate an error which is caught by the - ;; `condition-case' expression. - (while (not (looking-at "\\s *\\(\\(,\\)\\|;\\|$\\)")) - (goto-char (or (scan-sexps (point) 1) (point-max)))) - (goto-char (match-end 2))) ; non-nil - (error t))))) - - -(defvar tex-font-lock-keywords -; ;; Regexps updated with help from Ulrik Dickow . -; '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" -; 2 font-lock-function-name-face) -; ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}" -; 2 font-lock-reference-face) -; ;; It seems a bit dubious to use `bold' and `italic' faces since we might -; ;; not be able to display those fonts. -; ("{\\\\bf\\([^}]+\\)}" 1 'bold keep) -; ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep) -; ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face) -; ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep)) - ;; Rewritten and extended for LaTeX2e by Ulrik Dickow . - '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" - 2 font-lock-function-name-face) - ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}" - 2 font-lock-reference-face) - ("^[ \t]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face) - "\\\\\\([a-zA-Z@]+\\|.\\)" - ;; It seems a bit dubious to use `bold' and `italic' faces since we might - ;; not be able to display those fonts. - ;; LaTeX2e: \emph{This is emphasized}. - ("\\\\emph{\\([^}]+\\)}" 1 'italic keep) - ;; LaTeX2e: \textbf{This is bold}, \textit{...}, \textsl{...} - ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}" - 3 (if (match-beginning 2) 'bold 'italic) keep) - ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for good tables. - ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)" - 3 (if (match-beginning 2) 'bold 'italic) keep)) - "Default expressions to highlight in TeX modes.") - -(defconst ksh-font-lock-keywords (purecopy - (list - '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face) - '("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|foreach\\|in\\|end\\|select\\|while\\|repeat\\|time\\|function\\|until\\|exec\\|command\\|coproc\\|noglob\\|nohup\\|nocorrect\\|source\\|autoload\\|alias\\|unalias\\|export\\|set\\|echo\\|eval\\|cd\\|log\\|compctl\\)\\>" . font-lock-keyword-face) - '("\\<\\[\\[.*\\]\\]\\>" . font-lock-type-face) - '("\$\(.*\)" . font-lock-type-face) - )) - "Additional expressions to highlight in ksh-mode.") - -(defconst sh-font-lock-keywords (purecopy - (list - '("\\(^\\|[^\$\\\]\\)#.*" . font-lock-comment-face) - '("\\<\\(if\\|then\\|else\\|elif\\|fi\\|case\\|esac\\|for\\|do\\|done\\|in\\|while\\|exec\\|export\\|set\\|echo\\|eval\\|cd\\)\\>" . font-lock-keyword-face) - '("\\[.*\\]" . font-lock-type-face) - '("`.*`" . font-lock-type-face) - )) - "Additional expressions to highlight in sh-mode.") - - -;; Install ourselves: - -(add-hook 'find-file-hooks 'font-lock-set-defaults t) - -;;;###autoload -(add-minor-mode 'font-lock-mode " Font") - -;; Provide ourselves: - -(provide 'font-lock) - -;;; font-lock.el ends here diff --git a/lisp/font.el b/lisp/font.el deleted file mode 100644 index 28bb05d..0000000 --- a/lisp/font.el +++ /dev/null @@ -1,1390 +0,0 @@ -;;; font.el --- New font model -;; Author: wmperry -;; Created: 1997/09/05 15:44:37 -;; Version: 1.52 -;; Keywords: faces - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) -;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The emacsen compatibility package - load it up before anything else -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(require 'cl) - -(eval-and-compile - (defvar device-fonts-cache) - (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)))) - -(if (not (fboundp 'try-font-name)) - (defun try-font-name (fontname &rest args) - (case window-system - ((x pm) (car-safe (x-list-fonts fontname))) - (mswindows (car-safe (mswindows-list-fonts fontname))) - (ns (car-safe (ns-list-fonts fontname))) - (otherwise nil)))) - -(if (not (fboundp 'facep)) - (defun facep (face) - "Return t if X is a face name or an internal face vector." - (if (not window-system) - nil ; FIXME if FSF ever does TTY faces - (and (or (internal-facep face) - (and (symbolp face) (assq face global-face-data))) - t)))) - -(if (not (fboundp 'set-face-property)) - (defun set-face-property (face property value &optional locale - tag-set how-to-add) - "Change a property of FACE." - (and (symbolp face) - (put face property value)))) - -(if (not (fboundp 'face-property)) - (defun face-property (face property &optional locale tag-set exact-p) - "Return FACE's value of the given PROPERTY." - (and (symbolp face) (get face property)))) - -(require 'disp-table) - -(if (not (fboundp '<<)) (fset '<< 'lsh)) -(if (not (fboundp '&)) (fset '& 'logand)) -(if (not (fboundp '|)) (fset '| 'logior)) -(if (not (fboundp '~)) (fset '~ 'lognot)) -(if (not (fboundp '>>)) (defun >> (value count) (<< value (- count)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Lots of variables / keywords for use later in the program -;;; Not much should need to be modified -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst font-running-xemacs (string-match "XEmacs" (emacs-version)) - "Whether we are running in XEmacs or not.") - -(defmacro define-font-keywords (&rest keys) - `(eval-and-compile - (let ((keywords (quote ,keys))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords)))))) - -(defconst font-window-system-mappings - '((x . (x-font-create-name x-font-create-object)) - (ns . (ns-font-create-name ns-font-create-object)) - (mswindows . (mswindows-font-create-name mswindows-font-create-object)) - (pm . (x-font-create-name x-font-create-object)) ; Change? FIXME - (tty . (tty-font-create-plist tty-font-create-object))) - "An assoc list mapping device types to the function used to create -a font name from a font structure.") - -(defconst ns-font-weight-mappings - '((:extra-light . "extralight") - (:light . "light") - (:demi-light . "demilight") - (:medium . "medium") - (:normal . "medium") - (:demi-bold . "demibold") - (:bold . "bold") - (:extra-bold . "extrabold")) - "An assoc list mapping keywords to actual NeXTstep specific -information to use") - -(defconst x-font-weight-mappings - '((:extra-light . "extralight") - (:light . "light") - (:demi-light . "demilight") - (:demi . "demi") - (:book . "book") - (:medium . "medium") - (:normal . "medium") - (:demi-bold . "demibold") - (:bold . "bold") - (:extra-bold . "extrabold")) - "An assoc list mapping keywords to actual Xwindow specific strings -for use in the 'weight' field of an X font string.") - -(defconst font-possible-weights - (mapcar 'car x-font-weight-mappings)) - -(defvar font-rgb-file nil - "Where the RGB file was found.") - -(defvar font-maximum-slippage "1pt" - "How much a font is allowed to vary from the desired size.") - -(define-font-keywords :family :style :size :registry :encoding) - -(define-font-keywords - :weight :extra-light :light :demi-light :medium :normal :demi-bold - :bold :extra-bold) - -(defvar font-style-keywords nil) - -(defsubst set-font-family (fontobj family) - (aset fontobj 1 family)) - -(defsubst set-font-weight (fontobj weight) - (aset fontobj 3 weight)) - -(defsubst set-font-style (fontobj style) - (aset fontobj 5 style)) - -(defsubst set-font-size (fontobj size) - (aset fontobj 7 size)) - -(defsubst set-font-registry (fontobj reg) - (aset fontobj 9 reg)) - -(defsubst set-font-encoding (fontobj enc) - (aset fontobj 11 enc)) - -(defsubst font-family (fontobj) - (aref fontobj 1)) - -(defsubst font-weight (fontobj) - (aref fontobj 3)) - -(defsubst font-style (fontobj) - (aref fontobj 5)) - -(defsubst font-size (fontobj) - (aref fontobj 7)) - -(defsubst font-registry (fontobj) - (aref fontobj 9)) - -(defsubst font-encoding (fontobj) - (aref fontobj 11)) - -(eval-when-compile - (defmacro define-new-mask (attr mask) - `(progn - (setq font-style-keywords - (cons (cons (quote ,attr) - (cons - (quote ,(intern (format "set-font-%s-p" attr))) - (quote ,(intern (format "font-%s-p" attr))))) - font-style-keywords)) - (defconst ,(intern (format "font-%s-mask" attr)) (<< 1 ,mask) - ,(format - "Bitmask for whether a font is to be rendered in %s or not." - attr)) - (defun ,(intern (format "font-%s-p" attr)) (fontobj) - ,(format "Whether FONTOBJ will be renderd in `%s' or not." attr) - (if (/= 0 (& (font-style fontobj) - ,(intern (format "font-%s-mask" attr)))) - t - nil)) - (defun ,(intern (format "set-font-%s-p" attr)) (fontobj val) - ,(format "Set whether FONTOBJ will be renderd in `%s' or not." - attr) - (cond - (val - (set-font-style fontobj (| (font-style fontobj) - ,(intern - (format "font-%s-mask" attr))))) - ((,(intern (format "font-%s-p" attr)) fontobj) - (set-font-style fontobj (- (font-style fontobj) - ,(intern - (format "font-%s-mask" attr))))))) - ))) - -(let ((mask 0)) - (define-new-mask bold (setq mask (1+ mask))) - (define-new-mask italic (setq mask (1+ mask))) - (define-new-mask oblique (setq mask (1+ mask))) - (define-new-mask dim (setq mask (1+ mask))) - (define-new-mask underline (setq mask (1+ mask))) - (define-new-mask overline (setq mask (1+ mask))) - (define-new-mask linethrough (setq mask (1+ mask))) - (define-new-mask strikethru (setq mask (1+ mask))) - (define-new-mask reverse (setq mask (1+ mask))) - (define-new-mask blink (setq mask (1+ mask))) - (define-new-mask smallcaps (setq mask (1+ mask))) - (define-new-mask bigcaps (setq mask (1+ mask))) - (define-new-mask dropcaps (setq mask (1+ mask)))) - -(defvar font-caps-display-table - (let ((table (make-display-table)) - (i 0)) - ;; Standard ASCII characters - (while (< i 26) - (aset table (+ i ?a) (+ i ?A)) - (setq i (1+ i))) - ;; Now ISO translations - (setq i 224) - (while (< i 247) ;; Agrave - Ouml - (aset table i (- i 32)) - (setq i (1+ i))) - (setq i 248) - (while (< i 255) ;; Oslash - Thorn - (aset table i (- i 32)) - (setq i (1+ i))) - table)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Utility functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defsubst set-font-style-by-keywords (fontobj styles) - (make-local-variable 'font-func) - (declare (special font-func)) - (if (listp styles) - (while styles - (setq font-func (car-safe (cdr-safe (assq (car styles) font-style-keywords))) - styles (cdr styles)) - (and (fboundp font-func) (funcall font-func fontobj t))) - (setq font-func (car-safe (cdr-safe (assq styles font-style-keywords)))) - (and (fboundp font-func) (funcall font-func fontobj t)))) - -(defsubst font-properties-from-style (fontobj) - (let ((style (font-style fontobj)) - (todo font-style-keywords) - type func retval) - (while todo - (setq func (cdr (cdr (car todo))) - type (car (pop todo))) - (if (funcall func fontobj) - (setq retval (cons type retval)))) - retval)) - -(defun font-unique (list) - (let ((retval) - (cur)) - (while list - (setq cur (car list) - list (cdr list)) - (if (member cur retval) - nil - (setq retval (cons cur retval)))) - (nreverse retval))) - -(defun font-higher-weight (w1 w2) - (let ((index1 (length (memq w1 font-possible-weights))) - (index2 (length (memq w2 font-possible-weights)))) - (cond - ((<= index1 index2) - (or w1 w2)) - ((not w2) - w1) - (t - w2)))) - -(defun font-spatial-to-canonical (spec &optional device) - "Convert SPEC (in inches, millimeters, points, or picas) into points" - ;; 1 in = 6 pa = 25.4 mm = 72 pt - (cond - ((numberp spec) - spec) - ((null spec) - nil) - (t - (let ((num nil) - (type nil) - ;; If for any reason we get null for any of this, default - ;; to 1024x768 resolution on a 17" screen - (pix-width (float (or (device-pixel-width device) 1024))) - (mm-width (float (or (device-mm-width device) 293))) - (retval nil)) - (cond - ((string-match "^ *\\([-+*/]\\) *" spec) ; math! whee! - (let ((math-func (intern (match-string 1 spec))) - (other (font-spatial-to-canonical - (substring spec (match-end 0) nil))) - (default (font-spatial-to-canonical - (font-default-size-for-device device)))) - (if (fboundp math-func) - (setq type "px" - spec (int-to-string (funcall math-func default other))) - (setq type "px" - spec (int-to-string other))))) - ((string-match "[^0-9.]+$" spec) - (setq type (substring spec (match-beginning 0)) - spec (substring spec 0 (match-beginning 0)))) - (t - (setq type "px" - spec spec))) - (setq num (string-to-number spec)) - (cond - ((member type '("pixel" "px" "pix")) - (setq retval (* num (/ pix-width mm-width) (/ 25.4 72.0)))) - ((member type '("point" "pt")) - (setq retval num)) - ((member type '("pica" "pa")) - (setq retval (* num 12.0))) - ((member type '("inch" "in")) - (setq retval (* num 72.0))) - ((string= type "mm") - (setq retval (* num (/ 72.0 25.4)))) - ((string= type "cm") - (setq retval (* num 10 (/ 72.0 25.4)))) - (t - (setq retval num)) - ) - retval)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The main interface routines - constructors and accessor functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun make-font (&rest args) - (vector :family - (if (stringp (plist-get args :family)) - (list (plist-get args :family)) - (plist-get args :family)) - :weight - (plist-get args :weight) - :style - (if (numberp (plist-get args :style)) - (plist-get args :style) - 0) - :size - (plist-get args :size) - :registry - (plist-get args :registry) - :encoding - (plist-get args :encoding))) - -(defun font-create-name (fontobj &optional device) - (let* ((type (device-type device)) - (func (car (cdr-safe (assq type font-window-system-mappings))))) - (and func (fboundp func) (funcall func fontobj device)))) - -;;;###autoload -(defun font-create-object (fontname &optional device) - (let* ((type (device-type device)) - (func (car (cdr (cdr-safe (assq type font-window-system-mappings)))))) - (and func (fboundp func) (funcall func fontname device)))) - -(defun font-combine-fonts-internal (fontobj-1 fontobj-2) - (let ((retval (make-font)) - (size-1 (and (font-size fontobj-1) - (font-spatial-to-canonical (font-size fontobj-1)))) - (size-2 (and (font-size fontobj-2) - (font-spatial-to-canonical (font-size fontobj-2))))) - (set-font-weight retval (font-higher-weight (font-weight fontobj-1) - (font-weight fontobj-2))) - (set-font-family retval (font-unique (append (font-family fontobj-1) - (font-family fontobj-2)))) - (set-font-style retval (| (font-style fontobj-1) (font-style fontobj-2))) - (set-font-registry retval (or (font-registry fontobj-1) - (font-registry fontobj-2))) - (set-font-encoding retval (or (font-encoding fontobj-1) - (font-encoding fontobj-2))) - (set-font-size retval (cond - ((and size-1 size-2 (>= size-2 size-1)) - (font-size fontobj-2)) - ((and size-1 size-2) - (font-size fontobj-1)) - (size-1 - (font-size fontobj-1)) - (size-2 - (font-size fontobj-2)) - (t nil))) - - retval)) - -(defun font-combine-fonts (&rest args) - (cond - ((null args) - (error "Wrong number of arguments to font-combine-fonts")) - ((= (length args) 1) - (car args)) - (t - (let ((retval (font-combine-fonts-internal (nth 0 args) (nth 1 args)))) - (setq args (cdr (cdr args))) - (while args - (setq retval (font-combine-fonts-internal retval (car args)) - args (cdr args))) - retval)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (TTY-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun tty-font-create-object (fontname &optional device) - (make-font :size "12pt")) - -(defun tty-font-create-plist (fontobj &optional device) - (list - (cons 'underline (font-underline-p fontobj)) - (cons 'highlight (if (or (font-bold-p fontobj) - (memq (font-weight fontobj) '(:bold :demi-bold))) - t)) - (cons 'dim (font-dim-p fontobj)) - (cons 'blinking (font-blink-p fontobj)) - (cons 'reverse (font-reverse-p fontobj)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (X-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar font-x-font-regexp (or (and font-running-xemacs - (boundp 'x-font-regexp) - x-font-regexp) - (let - ((- "[-?]") - (foundry "[^-]*") - (family "[^-]*") - (weight "\\(bold\\|demibold\\|medium\\|black\\)") - (weight\? "\\([^-]*\\)") - (slant "\\([ior]\\)") - (slant\? "\\([^-]?\\)") - (swidth "\\([^-]*\\)") - (adstyle "\\([^-]*\\)") - (pixelsize "\\(\\*\\|[0-9]+\\)") - (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") - (resx "\\([*0]\\|[0-9][0-9]+\\)") - (resy "\\([*0]\\|[0-9][0-9]+\\)") - (spacing "[cmp?*]") - (avgwidth "\\(\\*\\|[0-9]+\\)") - (registry "[^-]*") - (encoding "[^-]+") - ) - (concat "\\`\\*?[-?*]" - foundry - family - weight\? - slant\? - swidth - adstyle - - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\'" - )))) - -(defvar font-x-registry-and-encoding-regexp - (or (and font-running-xemacs - (boundp 'x-font-regexp-registry-and-encoding) - (symbol-value 'x-font-regexp-registry-and-encoding)) - (let ((- "[-?]") - (registry "[^-]*") - (encoding "[^-]+")) - (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'")))) - -(defvar font-x-family-mappings - '( - ("serif" . ("new century schoolbook" - "utopia" - "charter" - "times" - "lucidabright" - "garamond" - "palatino" - "times new roman" - "baskerville" - "bookman" - "bodoni" - "computer modern" - "rockwell" - )) - ("sans-serif" . ("lucida" - "helvetica" - "gills-sans" - "avant-garde" - "univers" - "optima")) - ("elfin" . ("tymes")) - ("monospace" . ("courier" - "fixed" - "lucidatypewriter" - "clean" - "terminal")) - ("cursive" . ("sirene" - "zapf chancery")) - ) - "A list of font family mappings on X devices.") - -(defun x-font-create-object (fontname &optional device) - (let ((case-fold-search t)) - (if (or (not (stringp fontname)) - (not (string-match font-x-font-regexp fontname))) - (make-font) - (let ((family nil) - (style nil) - (size nil) - (weight (match-string 1 fontname)) - (slant (match-string 2 fontname)) - (swidth (match-string 3 fontname)) - (adstyle (match-string 4 fontname)) - (pxsize (match-string 5 fontname)) - (ptsize (match-string 6 fontname)) - (retval nil) - (case-fold-search t) - ) - (if (not (string-match x-font-regexp-foundry-and-family fontname)) - nil - (setq family (list (downcase (match-string 1 fontname))))) - (if (string= "*" weight) (setq weight nil)) - (if (string= "*" slant) (setq slant nil)) - (if (string= "*" swidth) (setq swidth nil)) - (if (string= "*" adstyle) (setq adstyle nil)) - (if (string= "*" pxsize) (setq pxsize nil)) - (if (string= "*" ptsize) (setq ptsize nil)) - (if ptsize (setq size (/ (string-to-int ptsize) 10))) - (if (and (not size) pxsize) (setq size (concat pxsize "px"))) - (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) - (if (and adstyle (not (equal adstyle ""))) - (setq family (append family (list (downcase adstyle))))) - (setq retval (make-font :family family - :weight weight - :size size)) - (set-font-bold-p retval (eq :bold weight)) - (cond - ((null slant) nil) - ((member slant '("i" "I")) - (set-font-italic-p retval t)) - ((member slant '("o" "O")) - (set-font-oblique-p retval t))) - (when (string-match font-x-registry-and-encoding-regexp fontname) - (set-font-registry retval (match-string 1 fontname)) - (set-font-encoding retval (match-string 2 fontname))) - retval)))) - -(defun x-font-families-for-device (&optional device no-resetp) - (ignore-errors (require 'x-font-menu)) - (or device (setq device (selected-device))) - (if (boundp 'device-fonts-cache) - (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) - (if (and (not menu) (not no-resetp)) - (progn - (reset-device-font-menus device) - (x-font-families-for-device device t)) - (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) - (aref menu 0))) - (normal (mapcar #'(lambda (x) (if x (aref x 0))) - (aref menu 1)))) - (sort (font-unique (nconc scaled normal)) 'string-lessp)))) - (cons "monospace" (mapcar 'car font-x-family-mappings)))) - -(defvar font-default-cache nil) - -;;;###autoload -(defun font-default-font-for-device (&optional device) - (or device (setq device (selected-device))) - (if font-running-xemacs - (font-truename - (make-font-specifier - (face-font-name 'default device))) - (let ((font (cdr-safe (assq 'font (frame-parameters device))))) - (if (and (fboundp 'fontsetp) (fontsetp font)) - (aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2) - font)))) - -;;;###autoload -(defun font-default-object-for-device (&optional device) - (let ((font (font-default-font-for-device device))) - (or (cdr-safe (assoc font font-default-cache)) - (let ((object (font-create-object font))) - (push (cons font object) font-default-cache) - object)))) - -;;;###autoload -(defun font-default-family-for-device (&optional device) - (font-family (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-registry-for-device (&optional device) - (font-registry (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-encoding-for-device (&optional device) - (font-encoding (font-default-object-for-device (or device (selected-device))))) - -;;;###autoload -(defun font-default-size-for-device (&optional device) - ;; face-height isn't the right thing (always 1 pixel too high?) - ;; (if font-running-xemacs - ;; (format "%dpx" (face-height 'default device)) - (font-size (font-default-object-for-device (or device (selected-device))))) - -(defun x-font-create-name (fontobj &optional device) - (if (and (not (or (font-family fontobj) - (font-weight fontobj) - (font-size fontobj) - (font-registry fontobj) - (font-encoding fontobj))) - (= (font-style fontobj) 0)) - (face-font 'default) - (or device (setq device (selected-device))) - (let* ((default (font-default-object-for-device device)) - (family (or (font-family fontobj) - (font-family default) - (x-font-families-for-device device))) - (weight (or (font-weight fontobj) :medium)) - (style (font-style fontobj)) - (size (or (if font-running-xemacs - (font-size fontobj)) - (font-size default))) - (registry (or (font-registry fontobj) - (font-registry default) - "*")) - (encoding (or (font-encoding fontobj) - (font-encoding default) - "*"))) - (if (stringp family) - (setq family (list family))) - (setq weight (font-higher-weight weight - (and (font-bold-p fontobj) :bold))) - (if (stringp size) - (setq size (truncate (font-spatial-to-canonical size device)))) - (setq weight (or (cdr-safe (assq weight x-font-weight-mappings)) "*")) - (let ((done nil) ; Did we find a good font yet? - (font-name nil) ; font name we are currently checking - (cur-family nil) ; current family we are checking - ) - (while (and family (not done)) - (setq cur-family (car family) - family (cdr family)) - (if (assoc cur-family font-x-family-mappings) - ;; If the family name is an alias as defined by - ;; font-x-family-mappings, then append those families - ;; to the front of 'family' and continue in the loop. - (setq family (append - (cdr-safe (assoc cur-family - font-x-family-mappings)) - family)) - ;; Not an alias for a list of fonts, so we just check it. - ;; First, convert all '-' to spaces so that we don't screw up - ;; the oh-so wonderful X font model. Wheee. - (let ((x (length cur-family))) - (while (> x 0) - (if (= ?- (aref cur-family (1- x))) - (aset cur-family (1- x) ? )) - (setq x (1- x)))) - ;; We treat oblique and italic as equivalent. Don't ask. - (let ((slants '("o" "i"))) - (while (and slants (not done)) - (setq font-name (format "-*-%s-%s-%s-*-*-*-%s-*-*-*-*-%s-%s" - cur-family weight - (if (or (font-italic-p fontobj) - (font-oblique-p fontobj)) - (car slants) - "r") - (if size - (int-to-string (* 10 size)) "*") - registry - encoding - ) - slants (cdr slants) - done (try-font-name font-name device)))))) - (if done font-name))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (NS-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun ns-font-families-for-device (&optional device no-resetp) - ;; For right now, assume we are going to have the same storage for - ;; device fonts for NS as we do for X. Is this a valid assumption? - (or device (setq device (selected-device))) - (if (boundp 'device-fonts-cache) - (let ((menu (or (cdr-safe (assq device device-fonts-cache))))) - (if (and (not menu) (not no-resetp)) - (progn - (reset-device-font-menus device) - (ns-font-families-for-device device t)) - (let ((scaled (mapcar #'(lambda (x) (if x (aref x 0))) - (aref menu 0))) - (normal (mapcar #'(lambda (x) (if x (aref x 0))) - (aref menu 1)))) - (sort (font-unique (nconc scaled normal)) 'string-lessp)))))) - -(defun ns-font-create-name (fontobj &optional device) - (let ((family (or (font-family fontobj) - (ns-font-families-for-device device))) - (weight (or (font-weight fontobj) :medium)) - (style (or (font-style fontobj) (list :normal))) - (size (font-size fontobj)) - (registry (or (font-registry fontobj) "*")) - (encoding (or (font-encoding fontobj) "*"))) - ;; Create a font, wow! - (if (stringp family) - (setq family (list family))) - (if (or (symbolp style) (numberp style)) - (setq style (list style))) - (setq weight (font-higher-weight weight (car-safe (memq :bold style)))) - (if (stringp size) - (setq size (font-spatial-to-canonical size device))) - (setq weight (or (cdr-safe (assq weight ns-font-weight-mappings)) - "medium")) - (let ((done nil) ; Did we find a good font yet? - (font-name nil) ; font name we are currently checking - (cur-family nil) ; current family we are checking - ) - (while (and family (not done)) - (setq cur-family (car family) - family (cdr family)) - (if (assoc cur-family font-x-family-mappings) - ;; If the family name is an alias as defined by - ;; font-x-family-mappings, then append those families - ;; to the front of 'family' and continue in the loop. - ;; #### jhar: I don't know about ns font names, so using X mappings - (setq family (append - (cdr-safe (assoc cur-family - font-x-family-mappings)) - family)) - ;; CARL: Need help here - I am not familiar with the NS font - ;; model - (setq font-name "UNKNOWN FORMULA GOES HERE" - done (try-font-name font-name device)))) - (if done font-name)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The window-system dependent code (mswindows-style) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; mswindows fonts look like: -;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset] -;;; A minimal mswindows font spec looks like: -;;; Courier New -;;; A maximal mswindows font spec looks like: -;;; Courier New:Bold Italic:10:underline strikeout:western -;;; Missing parts of the font spec should be filled in with these values: -;;; Courier New:Regular:10::western -;; "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" -(defvar font-mswindows-font-regexp - (let - ((- ":") - (fontname "\\([a-zA-Z ]+\\)") - (weight "\\([a-zA-Z]*\\)") - (style "\\( [a-zA-Z]*\\)?") - (pointsize "\\([0-9]+\\)") - (effects "\\([a-zA-Z ]*\\)") - (charset "\\([a-zA-Z 0-9]*\\)") - ) - (concat "^" - fontname - weight style - pointsize - effects - charset "$"))) - -(defconst mswindows-font-weight-mappings - '((:extra-light . "Extralight") - (:light . "Light") - (:demi-light . "Demilight") - (:demi . "Demi") - (:book . "Book") - (:medium . "Medium") - (:normal . "Normal") - (:demi-bold . "Demibold") - (:bold . "Bold") - (:regular . "Regular") - (:extra-bold . "Extrabold")) - "An assoc list mapping keywords to actual mswindows specific strings -for use in the 'weight' field of an mswindows font string.") - -(defvar font-mswindows-family-mappings - '( - ("serif" . ("times new roman" - "century schoolbook" - "book antiqua" - "bookman old style")) - ("sans-serif" . ("arial" - "verdana" - "lucida sans unicode")) - ("monospace" . ("courier new" - "lucida console" - "courier" - "terminal")) - ("cursive" . ("roman" - "script")) - ) - "A list of font family mappings on mswindows devices.") - -(defun mswindows-font-create-object (fontname &optional device) - (let ((case-fold-search t) - (font (mswindows-font-canonicalize-name fontname))) - (if (or (not (stringp font)) - (not (string-match font-mswindows-font-regexp font))) - (make-font) - (let ((family (match-string 1 font)) - (weight (match-string 2 font)) - (style (match-string 3 font)) - (pointsize (match-string 4 font)) - (effects (match-string 5 font)) - (charset (match-string 6 font)) - (retval nil) - (size nil) - (case-fold-search t) - ) - (if pointsize (setq size (concat pointsize "pt"))) - (if weight (setq weight (intern-soft (concat ":" (downcase weight))))) - (setq retval (make-font :family family - :weight weight - :size size - :encoding charset)) - (set-font-bold-p retval (eq :bold weight)) - (cond - ((null style) nil) - ((string-match "^ *[iI]talic" style) - (set-font-italic-p retval t))) - (cond - ((null effects) nil) - ((string-match "^[uU]nderline [sS]trikeout" effects) - (set-font-underline-p retval t) - (set-font-strikethru-p retval t)) - ((string-match "[uU]nderline" effects) - (set-font-underline-p retval t)) - ((string-match "[sS]trikeout" effects) - (set-font-strikethru-p retval t))) - retval)))) - -(defun mswindows-font-create-name (fontobj &optional device) - (if (and (not (or (font-family fontobj) - (font-weight fontobj) - (font-size fontobj) - (font-registry fontobj) - (font-encoding fontobj))) - (= (font-style fontobj) 0)) - (face-font 'default) - (or device (setq device (selected-device))) - (let* ((default (font-default-object-for-device device)) - (family (or (font-family fontobj) - (font-family default))) - (weight (or (font-weight fontobj) :regular)) - (style (font-style fontobj)) - (size (or (if font-running-xemacs - (font-size fontobj)) - (font-size default))) - (underline-p (font-underline-p fontobj)) - (strikeout-p (font-strikethru-p fontobj)) - (encoding (or (font-encoding fontobj) - (font-encoding default)))) - (if (stringp family) - (setq family (list family))) - (setq weight (font-higher-weight weight - (and (font-bold-p fontobj) :bold))) - (if (stringp size) - (setq size (truncate (font-spatial-to-canonical size device)))) - (setq weight (or (cdr-safe - (assq weight mswindows-font-weight-mappings)) "")) - (let ((done nil) ; Did we find a good font yet? - (font-name nil) ; font name we are currently checking - (cur-family nil) ; current family we are checking - ) - (while (and family (not done)) - (setq cur-family (car family) - family (cdr family)) - (if (assoc cur-family font-mswindows-family-mappings) - ;; If the family name is an alias as defined by - ;; font-mswindows-family-mappings, then append those families - ;; to the front of 'family' and continue in the loop. - (setq family (append - (cdr-safe (assoc cur-family - font-mswindows-family-mappings)) - family)) - ;; We treat oblique and italic as equivalent. Don't ask. - ;; Courier New:Bold Italic:10:underline strikeout:western - (setq font-name (format "%s:%s%s:%s:%s:%s" - cur-family weight - (if (font-italic-p fontobj) - " Italic" "") - (if size - (int-to-string size) "10") - (if underline-p - (if strikeout-p - "underline strikeout" - "underline") - (if strikeout-p "strikeout" "")) - (if encoding - encoding "")) - done (try-font-name font-name device)))) - (if done font-name))))) - - -;;; Cache building code -;;;###autoload -(defun x-font-build-cache (&optional device) - (let ((hash-table (make-hash-table :test 'equal :size 15)) - (fonts (mapcar 'x-font-create-object - (x-list-fonts "-*-*-*-*-*-*-*-*-*-*-*-*-*-*"))) - (plist nil) - (cur nil)) - (while fonts - (setq cur (car fonts) - fonts (cdr fonts) - plist (cl-gethash (car (font-family cur)) hash-table)) - (if (not (memq (font-weight cur) (plist-get plist 'weights))) - (setq plist (plist-put plist 'weights (cons (font-weight cur) - (plist-get plist 'weights))))) - (if (not (member (font-size cur) (plist-get plist 'sizes))) - (setq plist (plist-put plist 'sizes (cons (font-size cur) - (plist-get plist 'sizes))))) - (if (and (font-oblique-p cur) - (not (memq 'oblique (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'oblique (plist-get plist 'styles))))) - (if (and (font-italic-p cur) - (not (memq 'italic (plist-get plist 'styles)))) - (setq plist (plist-put plist 'styles (cons 'italic (plist-get plist 'styles))))) - (cl-puthash (car (font-family cur)) plist hash-table)) - hash-table)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Now overwrite the original copy of set-face-font with our own copy that -;;; can deal with either syntax. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ###autoload -(defun font-set-face-font (&optional face font &rest args) - (cond - ((and (vectorp font) (= (length font) 12)) - (let ((font-name (font-create-name font))) - (set-face-property face 'font-specification font) - (cond - ((null font-name) ; No matching font! - nil) - ((listp font-name) ; For TTYs - (let (cur) - (while font-name - (setq cur (car font-name) - font-name (cdr font-name)) - (apply 'set-face-property face (car cur) (cdr cur) args)))) - (font-running-xemacs - (apply 'set-face-font face font-name args) - (apply 'set-face-underline-p face (font-underline-p font) args) - (if (and (or (font-smallcaps-p font) (font-bigcaps-p font)) - (fboundp 'set-face-display-table)) - (apply 'set-face-display-table - face font-caps-display-table args)) - (apply 'set-face-property face 'strikethru (or - (font-linethrough-p font) - (font-strikethru-p font)) - args)) - (t - (condition-case nil - (apply 'set-face-font face font-name args) - (error - (let ((args (car-safe args))) - (and (or (font-bold-p font) - (memq (font-weight font) '(:bold :demi-bold))) - (make-face-bold face args t)) - (and (font-italic-p font) (make-face-italic face args t))))) - (apply 'set-face-underline-p face (font-underline-p font) args))))) - (t - ;; Let the original set-face-font signal any errors - (set-face-property face 'font-specification nil) - (apply 'set-face-font face font args)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Now for emacsen specific stuff -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun font-update-device-fonts (device) - ;; Update all faces that were created with the 'font' package - ;; to appear correctly on the new device. This should be in the - ;; create-device-hook. This is XEmacs 19.12+ specific - (let ((faces (face-list 2)) - (cur nil) - (font nil) - (font-spec nil)) - (while faces - (setq cur (car faces) - faces (cdr faces) - font-spec (face-property cur 'font-specification)) - (if font-spec - (set-face-font cur font-spec device))))) - -(defun font-update-one-face (face &optional device-list) - ;; Update FACE on all devices in DEVICE-LIST - ;; DEVICE_LIST defaults to a list of all active devices - (setq device-list (or device-list (device-list))) - (if (devicep device-list) - (setq device-list (list device-list))) - (let* ((cur-device nil) - (font-spec (face-property face 'font-specification)) - (font nil)) - (if (not font-spec) - ;; Hey! Don't mess with fonts we didn't create in the - ;; first place. - nil - (while device-list - (setq cur-device (car device-list) - device-list (cdr device-list)) - (if (not (device-live-p cur-device)) - ;; Whoah! - nil - (if font-spec - (set-face-font face font-spec cur-device))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Various color related things -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(cond - ((fboundp 'display-warning) - (fset 'font-warn 'display-warning)) - ((fboundp 'w3-warn) - (fset 'font-warn 'w3-warn)) - ((fboundp 'url-warn) - (fset 'font-warn 'url-warn)) - ((fboundp 'warn) - (defun font-warn (class message &optional level) - (warn "(%s/%s) %s" class (or level 'warning) message))) - (t - (defun font-warn (class message &optional level) - (save-excursion - (set-buffer (get-buffer-create "*W3-WARNINGS*")) - (goto-char (point-max)) - (save-excursion - (insert (format "(%s/%s) %s\n" class (or level 'warning) message))) - (display-buffer (current-buffer)))))) - -(defun font-lookup-rgb-components (color) - "Lookup COLOR (a color name) in rgb.txt and return a list of RGB values. -The list (R G B) is returned, or an error is signaled if the lookup fails." - (let ((lib-list (if (boundp 'x-library-search-path) - x-library-search-path - ;; This default is from XEmacs 19.13 - hope it covers - ;; everyone. - (list "/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/"))) - (file font-rgb-file) - r g b) - (if (not file) - (while lib-list - (setq file (expand-file-name "rgb.txt" (car lib-list))) - (if (file-readable-p file) - (setq lib-list nil - font-rgb-file file) - (setq lib-list (cdr lib-list) - file nil)))) - (if (null file) - (list 0 0 0) - (save-excursion - (set-buffer (find-file-noselect file)) - (if (not (= (aref (buffer-name) 0) ? )) - (rename-buffer (generate-new-buffer-name " *rgb-tmp-buffer*"))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward (format "\t%s$" (regexp-quote color)) nil t) - (progn - (beginning-of-line) - (setq r (* (read (current-buffer)) 256) - g (* (read (current-buffer)) 256) - b (* (read (current-buffer)) 256))) - (font-warn 'color (format "No such color: %s" color)) - (setq r 0 - g 0 - b 0)) - (list r g b) )))))) - -(defun font-hex-string-to-number (string) - "Convert STRING to an integer by parsing it as a hexadecimal number." - (let ((conv-list '((?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))) - (n 0) - (i 0) - (lim (length string))) - (while (< i lim) - (setq n (+ (* n 16) (or (cdr (assq (aref string i) conv-list)) 0)) - i (1+ i))) - n )) - -(defun font-parse-rgb-components (color) - "Parse RGB color specification and return a list of integers (R G B). -#FEFEFE and rgb:fe/fe/fe style specifications are parsed." - (let ((case-fold-search t) - r g b str) - (cond ((string-match "^#[0-9a-f]+$" color) - (cond - ((= (length color) 4) - (setq r (font-hex-string-to-number (substring color 1 2)) - g (font-hex-string-to-number (substring color 2 3)) - b (font-hex-string-to-number (substring color 3 4)) - r (* r 4096) - g (* g 4096) - b (* b 4096))) - ((= (length color) 7) - (setq r (font-hex-string-to-number (substring color 1 3)) - g (font-hex-string-to-number (substring color 3 5)) - b (font-hex-string-to-number (substring color 5 7)) - r (* r 256) - g (* g 256) - b (* b 256))) - ((= (length color) 10) - (setq r (font-hex-string-to-number (substring color 1 4)) - g (font-hex-string-to-number (substring color 4 7)) - b (font-hex-string-to-number (substring color 7 10)) - r (* r 16) - g (* g 16) - b (* b 16))) - ((= (length color) 13) - (setq r (font-hex-string-to-number (substring color 1 5)) - g (font-hex-string-to-number (substring color 5 9)) - b (font-hex-string-to-number (substring color 9 13)))) - (t - (font-warn 'color (format "Invalid RGB color specification: %s" - color)) - (setq r 0 - g 0 - b 0)))) - ((string-match "rgb:\\([0-9a-f]+\\)/\\([0-9a-f]+\\)/\\([0-9a-f]+\\)" - color) - (if (or (> (- (match-end 1) (match-beginning 1)) 4) - (> (- (match-end 2) (match-beginning 2)) 4) - (> (- (match-end 3) (match-beginning 3)) 4)) - (error "Invalid RGB color specification: %s" color) - (setq str (match-string 1 color) - r (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str)))) - str (match-string 2 color) - g (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str)))) - str (match-string 3 color) - b (* (font-hex-string-to-number str) - (expt 16 (- 4 (length str))))))) - (t - (font-warn 'html (format "Invalid RGB color specification: %s" - color)) - (setq r 0 - g 0 - b 0))) - (list r g b) )) - -(defsubst font-rgb-color-p (obj) - (or (and (vectorp obj) - (= (length obj) 4) - (eq (aref obj 0) 'rgb)))) - -(defsubst font-rgb-color-red (obj) (aref obj 1)) -(defsubst font-rgb-color-green (obj) (aref obj 2)) -(defsubst font-rgb-color-blue (obj) (aref obj 3)) - -(defun font-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. -RGB values for color names are looked up in the rgb.txt file. -The variable x-library-search-path is use to locate the rgb.txt file." - (let ((case-fold-search t)) - (cond - ((and (font-rgb-color-p color) (floatp (aref color 1))) - (list (* 65535 (aref color 0)) - (* 65535 (aref color 1)) - (* 65535 (aref color 2)))) - ((font-rgb-color-p color) - (list (font-rgb-color-red color) - (font-rgb-color-green color) - (font-rgb-color-blue color))) - ((and (vectorp color) (= 3 (length color))) - (list (aref color 0) (aref color 1) (aref color 2))) - ((and (listp color) (= 3 (length color)) (floatp (car color))) - (mapcar #'(lambda (x) (* x 65535)) color)) - ((and (listp color) (= 3 (length color))) - color) - ((or (string-match "^#" color) - (string-match "^rgb:" color)) - (font-parse-rgb-components color)) - ((string-match "\\([0-9.]+\\)[ \t]\\([0-9.]+\\)[ \t]\\([0-9.]+\\)" - color) - (let ((r (string-to-number (match-string 1 color))) - (g (string-to-number (match-string 2 color))) - (b (string-to-number (match-string 3 color)))) - (if (floatp r) - (setq r (round (* 255 r)) - g (round (* 255 g)) - b (round (* 255 b)))) - (font-parse-rgb-components (format "#%02x%02x%02x" r g b)))) - (t - (font-lookup-rgb-components color))))) - -(defsubst font-tty-compute-color-delta (col1 col2) - (+ - (* (- (aref col1 0) (aref col2 0)) - (- (aref col1 0) (aref col2 0))) - (* (- (aref col1 1) (aref col2 1)) - (- (aref col1 1) (aref col2 1))) - (* (- (aref col1 2) (aref col2 2)) - (- (aref col1 2) (aref col2 2))))) - -(defun font-tty-find-closest-color (r g b) - ;; This is basically just a lisp copy of allocate_nearest_color - ;; from objects-x.c from Emacs 19 - ;; We really should just check tty-color-list, but unfortunately - ;; that does not include any RGB information at all. - ;; So for now we just hardwire in the default list and call it - ;; good for now. - (setq r (/ r 65535.0) - g (/ g 65535.0) - b (/ b 65535.0)) - (let* ((color_def (vector r g b)) - (colors [([1.0 1.0 1.0] . "white") - ([0.0 1.0 1.0] . "cyan") - ([1.0 0.0 1.0] . "magenta") - ([0.0 0.0 1.0] . "blue") - ([1.0 1.0 0.0] . "yellow") - ([0.0 1.0 0.0] . "green") - ([1.0 0.0 0.0] . "red") - ([0.0 0.0 0.0] . "black")]) - (no_cells (length colors)) - (x 1) - (nearest 0) - (nearest_delta 0) - (trial_delta 0)) - (setq nearest_delta (font-tty-compute-color-delta (car (aref colors 0)) - color_def)) - (while (/= no_cells x) - (setq trial_delta (font-tty-compute-color-delta (car (aref colors x)) - color_def)) - (if (< trial_delta nearest_delta) - (setq nearest x - nearest_delta trial_delta)) - (setq x (1+ x))) - (cdr-safe (aref colors nearest)))) - -(defun font-normalize-color (color &optional device) - "Return an RGB tuple, given any form of input. If an error occurs, black -is returned." - (case (device-type device) - ((x pm) - (apply 'format "#%02x%02x%02x" (font-color-rgb-components color))) - (mswindows - (let* ((rgb (font-color-rgb-components color)) - (color (apply 'format "#%02x%02x%02x" rgb))) - (mswindows-define-rgb-color (nth 0 rgb) (nth 1 rgb) (nth 2 rgb) color) - color)) - (tty - (apply 'font-tty-find-closest-color (font-color-rgb-components color))) - (ns - (let ((vals (mapcar #'(lambda (x) (>> x 8)) - (font-color-rgb-components color)))) - (apply 'format "RGB%02x%02x%02xff" vals))) - (otherwise - color))) - -(defun font-set-face-background (&optional face color &rest args) - (interactive) - (condition-case nil - (cond - ((or (font-rgb-color-p color) - (string-match "^#[0-9a-fA-F]+$" color)) - (apply 'set-face-background face - (font-normalize-color color) args)) - (t - (apply 'set-face-background face color args))) - (error nil))) - -(defun font-set-face-foreground (&optional face color &rest args) - (interactive) - (condition-case nil - (cond - ((or (font-rgb-color-p color) - (string-match "^#[0-9a-fA-F]+$" color)) - (apply 'set-face-foreground face (font-normalize-color color) args)) - (t - (apply 'set-face-foreground face color args))) - (error nil))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Support for 'blinking' fonts -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun font-map-windows (func &optional arg frame) - (let* ((start (selected-window)) - (cur start) - (result nil)) - (push (funcall func start arg) result) - (while (not (eq start (setq cur (next-window cur)))) - (push (funcall func cur arg) result)) - result)) - -(defun font-face-visible-in-window-p (window face) - (let ((st (window-start window)) - (nd (window-end window)) - (found nil) - (face-at nil)) - (setq face-at (get-text-property st 'face (window-buffer window))) - (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) - (setq found t)) - (while (and (not found) - (/= nd - (setq st (next-single-property-change - st 'face - (window-buffer window) nd)))) - (setq face-at (get-text-property st 'face (window-buffer window))) - (if (or (eq face face-at) (and (listp face-at) (memq face face-at))) - (setq found t))) - found)) - -(defun font-blink-callback () - ;; Optimized to never invert the face unless one of the visible windows - ;; is showing it. - (let ((faces (if font-running-xemacs (face-list t) (face-list))) - (obj nil)) - (while faces - (if (and (setq obj (face-property (car faces) 'font-specification)) - (font-blink-p obj) - (memq t - (font-map-windows 'font-face-visible-in-window-p (car faces)))) - (invert-face (car faces))) - (pop faces)))) - -(defcustom font-blink-interval 0.5 - "How often to blink faces" - :type 'number - :group 'faces) - -(defun font-blink-initialize () - (cond - ((featurep 'itimer) - (if (get-itimer "font-blinker") - (delete-itimer (get-itimer "font-blinker"))) - (start-itimer "font-blinker" 'font-blink-callback - font-blink-interval - font-blink-interval)) - ((fboundp 'run-at-time) - (cancel-function-timers 'font-blink-callback) - (run-at-time font-blink-interval - font-blink-interval - 'font-blink-callback)) - (t nil))) - -(provide 'font) diff --git a/lisp/format.el b/lisp/format.el deleted file mode 100644 index 2b4c609..0000000 --- a/lisp/format.el +++ /dev/null @@ -1,987 +0,0 @@ -;;; format.el --- read and save files in multiple formats - -;; Copyright (c) 1994, 1995, 1997 Free Software Foundation - -;; Author: Boris Goldowsky -;; Keywords: extensions, dumped - -;; 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.2. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; This file defines a unified mechanism for saving & loading files stored -;; in different formats. `format-alist' contains information that directs -;; Emacs to call an encoding or decoding function when reading or writing -;; files that match certain conditions. -;; -;; When a file is visited, its format is determined by matching the -;; beginning of the file against regular expressions stored in -;; `format-alist'. If this fails, you can manually translate the buffer -;; using `format-decode-buffer'. In either case, the formats used are -;; listed in the variable `buffer-file-format', and become the default -;; format for saving the buffer. To save a buffer in a different format, -;; change this variable, or use `format-write-file'. -;; -;; Auto-save files are normally created in the same format as the visited -;; file, but the variable `auto-save-file-format' can be set to a -;; particularly fast or otherwise preferred format to be used for -;; auto-saving (or nil to do no encoding on auto-save files, but then you -;; risk losing any text-properties in the buffer). -;; -;; You can manually translate a buffer into or out of a particular format -;; with the functions `format-encode-buffer' and `format-decode-buffer'. -;; To translate just the region use the functions `format-encode-region' -;; and `format-decode-region'. -;; -;; You can define a new format by writing the encoding and decoding -;; functions, and adding an entry to `format-alist'. See enriched.el for -;; an example of how to implement a file format. There are various -;; functions defined in this file that may be useful for writing the -;; encoding and decoding functions: -;; * `format-annotate-region' and `format-deannotate-region' allow a -;; single alist of information to be used for encoding and decoding. -;; The alist defines a correspondence between strings in the file -;; ("annotations") and text-properties in the buffer. -;; * `format-replace-strings' is similarly useful for doing simple -;; string->string translations in a reversible manner. - -;;; Code: - -(put 'buffer-file-format 'permanent-local t) - -(defvar format-alist - '((image/jpeg "JPEG image" "\377\330\377\340\000\020JFIF" - image-decode-jpeg nil t image-mode) - (image/gif "GIF image" "GIF8[79]" - image-decode-gif nil t image-mode) - (image/png "Portable Network Graphics" "\211PNG" - image-decode-png nil t image-mode) - (image/x-xpm "XPM image" "/\\* XPM \\*/" - image-decode-xpm nil t image-mode) - - ;; TIFF files have lousy magic - (image/tiff "TIFF image" "II\\*\000" - image-decode-tiff nil t image-mode) ;; TIFF 6.0 big-endian - (image/tiff "TIFF image" "MM\000\\*" - image-decode-tiff nil t image-mode) ;; TIFF 6.0 little-endian - - (text/enriched "Extended MIME text/enriched format." - "Content-[Tt]ype:[ \t]*text/enriched" - enriched-decode enriched-encode t enriched-mode) - (text/richtext "Extended MIME obsolete text/richtext format." - "Content-[Tt]ype:[ \t]*text/richtext" - richtext-decode richtext-encode t enriched-mode) - (plain "ISO 8859-1 standard format, no text properties." - ;; Plain only exists so that there is an obvious neutral choice in - ;; the completion list. - nil nil nil nil nil) - ;; (ibm "IBM Code Page 850 (DOS)" - ;; "1\\(^\\)" - ;; "recode ibm-pc:latin1" "recode latin1:ibm-pc" t nil) - ;; (mac "Apple Macintosh" - ;; "1\\(^\\)" - ;; "recode mac:latin1" "recode latin1:mac" t nil) - ;; (hp "HP Roman8" - ;; "1\\(^\\)" - ;; "recode roman8:latin1" "recode latin1:roman8" t nil) - ;; (TeX "TeX (encoding)" - ;; "1\\(^\\)" - ;; iso-tex2iso iso-iso2tex t nil) - ;; (gtex "German TeX (encoding)" - ;; "1\\(^\\)" - ;; iso-gtex2iso iso-iso2gtex t nil) - ;; (html "HTML (encoding)" - ;; "1\\(^\\)" - ;; "recode html:latin1" "recode latin1:html" t nil) - ;; (rot13 "rot13" - ;; "1\\(^\\)" - ;; "tr a-mn-z n-za-m" "tr a-mn-z n-za-m" t nil) - ;; (duden "Duden Ersatzdarstellung" - ;; "1\\(^\\)" - ;; "diac" iso-iso2duden t nil) - ;; (de646 "German ASCII (ISO 646)" - ;; "1\\(^\\)" - ;; "recode iso646-ge:latin1" "recode latin1:iso646-ge" t nil) - ;; (denet "net German" - ;; "1\\(^\\)" - ;; iso-german iso-cvt-read-only t nil) - ;; (esnet "net Spanish" - ;; "1\\(^\\)" - ;; iso-spanish iso-cvt-read-only t nil) - ) - "List of information about understood file formats. -Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN). - -NAME is a symbol, which is stored in `buffer-file-format'. - -DOC-STR should be a single line providing more information about the - format. It is currently unused, but in the future will be shown to - the user if they ask for more information. - -REGEXP is a regular expression to match against the beginning of the file; - it should match only files in that format. - -FROM-FN is called to decode files in that format; it gets two args, BEGIN - and END, and can make any modifications it likes, returning the new - end. It must make sure that the beginning of the file no longer - matches REGEXP, or else it will get called again. - Alternatively, FROM-FN can be a string, which specifies a shell command - (including options) to be used as a filter to perform the conversion. - -TO-FN is called to encode a region into that format; it is passed three - arguments: BEGIN, END, and BUFFER. BUFFER is the original buffer that - the data being written came from, which the function could use, for - example, to find the values of local variables. TO-FN should either - return a list of annotations like `write-region-annotate-functions', - or modify the region and return the new end. - Alternatively, TO-FN can be a string, which specifies a shell command - (including options) to be used as a filter to perform the conversion. - -MODIFY, if non-nil, means the TO-FN wants to modify the region. If nil, - TO-FN will not make any changes but will instead return a list of - annotations. - -MODE-FN, if specified, is called when visiting a file with that format.") - -;;; Basic Functions (called from Lisp) - -(defun format-encode-run-method (method from to &optional buffer) - "Translate using function or shell script METHOD the text from FROM to TO. -If METHOD is a string, it is a shell command; -otherwise, it should be a Lisp function. -BUFFER should be the buffer that the output originally came from." - (if (stringp method) - (save-current-buffer - (set-buffer buffer) - (with-output-to-temp-buffer "*Format Errors*" - (shell-command-on-region from to method t nil)) - (point)) - (funcall method from to buffer))) - -(defun format-decode-run-method (method from to &optional buffer) - "Decode using function or shell script METHOD the text from FROM to TO. -If METHOD is a string, it is a shell command; -otherwise, it should be a Lisp function." - (if (stringp method) - (progn - (with-output-to-temp-buffer "*Format Errors*" - (shell-command-on-region from to method t nil)) - (point)) - (funcall method from to))) - -(defun format-annotate-function (format from to orig-buf) - "Return annotations for writing region as FORMAT. -FORMAT is a symbol naming one of the formats defined in `format-alist', -it must be a single symbol, not a list like `buffer-file-format'. -FROM and TO delimit the region to be operated on in the current buffer. -ORIG-BUF is the original buffer that the data came from. -This function works like a function on `write-region-annotate-functions': -it either returns a list of annotations, or returns with a different buffer -current, which contains the modified text to write. - -For most purposes, consider using `format-encode-region' instead." - ;; This function is called by write-region (actually build-annotations) - ;; for each element of buffer-file-format. - (let* ((info (assq format format-alist)) - (to-fn (nth 4 info)) - (modify (nth 5 info))) - (if to-fn - (if modify - ;; To-function wants to modify region. Copy to safe place. - (let ((copy-buf (get-buffer-create " *Format Temp*"))) - (copy-to-buffer copy-buf from to) - (set-buffer copy-buf) - (format-insert-annotations write-region-annotations-so-far from) - (format-encode-run-method to-fn (point-min) (point-max) orig-buf) - nil) - ;; Otherwise just call function, it will return annotations. - (funcall to-fn from to orig-buf))))) - -(defun format-decode (format length &optional visit-flag) - "Decode text from any known FORMAT. -FORMAT is a symbol appearing in `format-alist' or a list of such symbols, -or nil, in which case this function tries to guess the format of the data by -matching against the regular expressions in `format-alist'. After a match is -found and the region decoded, the alist is searched again from the beginning -for another match. - -Second arg LENGTH is the number of characters following point to operate on. -If optional third arg VISIT-FLAG is true, set `buffer-file-format' -to the list of formats used, and call any mode functions defined for those -formats. - -Returns the new length of the decoded region. - -For most purposes, consider using `format-decode-region' instead. - -This function is called by insert-file-contents whenever a file is read." - (let ((mod (buffer-modified-p)) - (begin (point)) - (end (+ (point) length))) - (if (null format) - ;; Figure out which format it is in, remember list in `format'. - (let ((try format-alist)) - (while try - (let* ((f (car try)) - (regexp (nth 2 f)) - (p (point))) - (if (and regexp (looking-at regexp) - (< (match-end 0) (+ begin length))) - (progn - (setq format (cons (car f) format)) - ;; Decode it - (if (nth 3 f) - (setq end (format-decode-run-method (nth 3 f) begin end))) - ;; Call visit function if required - (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) - ;; Safeguard against either of the functions changing pt. - (goto-char p) - ;; Rewind list to look for another format - (setq try format-alist)) - (setq try (cdr try)))))) - ;; Deal with given format(s) - (or (listp format) (setq format (list format))) - (let ((do format) f) - (while do - (or (setq f (assq (car do) format-alist)) - (error "Unknown format" (car do))) - ;; Decode: - (if (nth 3 f) - (setq end (format-decode-run-method (nth 3 f) begin end))) - ;; Call visit function if required - (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1)) - (setq do (cdr do))))) - (if visit-flag - (setq buffer-file-format format)) - (set-buffer-modified-p mod) - ;; Return new length of region - (- end begin))) - -;;; -;;; Interactive functions & entry points -;;; - -(defun format-decode-buffer (&optional format) - "Translate the buffer from some FORMAT. -If the format is not specified, this function attempts to guess. -`buffer-file-format' is set to the format used, and any mode-functions -for the format are called." - (interactive - (list (format-read "Translate buffer from format (default: guess): "))) - (save-excursion - (goto-char (point-min)) - (format-decode format (buffer-size) t))) - -(defun format-decode-region (from to &optional format) - "Decode the region from some format. -Arg FORMAT is optional; if omitted the format will be determined by looking -for identifying regular expressions at the beginning of the region." - (interactive - (list (region-beginning) (region-end) - (format-read "Translate region from format (default: guess): "))) - (save-excursion - (goto-char from) - (format-decode format (- to from) nil))) - -(defun format-encode-buffer (&optional format) - "Translate the buffer into FORMAT. -FORMAT defaults to `buffer-file-format'. It is a symbol naming one of the -formats defined in `format-alist', or a list of such symbols." - (interactive - (list (format-read (format "Translate buffer to format (default %s): " - buffer-file-format)))) - (format-encode-region (point-min) (point-max) format)) - -(defun format-encode-region (beg end &optional format) - "Translate the region into some FORMAT. -FORMAT defaults to `buffer-file-format', it is a symbol naming -one of the formats defined in `format-alist', or a list of such symbols." - (interactive - (list (region-beginning) (region-end) - (format-read (format "Translate region to format (default %s): " - buffer-file-format)))) - (if (null format) (setq format buffer-file-format)) - (if (symbolp format) (setq format (list format))) - (save-excursion - (goto-char end) - (let ( ; (cur-buf (current-buffer)) - (end (point-marker))) - (while format - (let* ((info (assq (car format) format-alist)) - (to-fn (nth 4 info)) - (modify (nth 5 info)) - ;; result - ) - (if to-fn - (if modify - (setq end (format-encode-run-method to-fn beg end - (current-buffer))) - (format-insert-annotations - (funcall to-fn beg end (current-buffer))))) - (setq format (cdr format))))))) - -(defun format-write-file (filename format) - "Write current buffer into a FILE using some FORMAT. -Makes buffer visit that file and sets the format as the default for future -saves. If the buffer is already visiting a file, you can specify a directory -name as FILE, to write a file of the same old name in that directory." - (interactive - ;; Same interactive spec as write-file, plus format question. - (let* ((file (if buffer-file-name - (read-file-name "Write file: " - nil nil nil nil) - (read-file-name "Write file: " - (cdr (assq 'default-directory - (buffer-local-variables))) - nil nil (buffer-name)))) - (fmt (format-read (format "Write file `%s' in format: " - (file-name-nondirectory file))))) - (list file fmt))) - (setq buffer-file-format format) - (write-file filename)) - -(defun format-find-file (filename format) - "Find the file FILE using data format FORMAT. -If FORMAT is nil then do not do any format conversion." - (interactive - ;; Same interactive spec as write-file, plus format question. - (let* ((file (read-file-name "Find file: ")) - (fmt (format-read (format "Read file `%s' in format: " - (file-name-nondirectory file))))) - (list file fmt))) - (let ((format-alist nil)) - (find-file filename)) - (if format - (format-decode-buffer format))) - -(defun format-insert-file (filename format &optional beg end) - "Insert the contents of file FILE using data format FORMAT. -If FORMAT is nil then do not do any format conversion. -The optional third and fourth arguments BEG and END specify -the part of the file to read. - -The return value is like the value of `insert-file-contents': -a list (ABSOLUTE-FILE-NAME . SIZE)." - (interactive - ;; Same interactive spec as write-file, plus format question. - (let* ((file (read-file-name "Find file: ")) - (fmt (format-read (format "Read file `%s' in format: " - (file-name-nondirectory file))))) - (list file fmt))) - (let (value size) - (let ((format-alist nil)) - (setq value (insert-file-contents filename nil beg end)) - (setq size (nth 1 value))) - (if format - (setq size (format-decode format size) - value (cons (car value) size))) - value)) - -(defun format-read (&optional prompt) - "Read and return the name of a format. -Return value is a list, like `buffer-file-format'; it may be nil. -Formats are defined in `format-alist'. Optional arg is the PROMPT to use." - (let* ((table (mapcar (lambda (x) (list (symbol-name (car x)))) - format-alist)) - (ans (completing-read (or prompt "Format: ") table nil t))) - (if (not (equal "" ans)) (list (intern ans))))) - - -;;; -;;; Below are some functions that may be useful in writing encoding and -;;; decoding functions for use in format-alist. -;;; - -(defun format-replace-strings (alist &optional reverse beg end) - "Do multiple replacements on the buffer. -ALIST is a list of (from . to) pairs, which should be proper arguments to -`search-forward' and `replace-match' respectively. -Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that -you can use the same list in both directions if it contains only literal -strings. -Optional args BEGIN and END specify a region of the buffer to operate on." - (save-excursion - (save-restriction - (or beg (setq beg (point-min))) - (if end (narrow-to-region (point-min) end)) - (while alist - (let ((from (if reverse (cdr (car alist)) (car (car alist)))) - (to (if reverse (car (cdr alist)) (cdr (car alist))))) - (goto-char beg) - (while (search-forward from nil t) - (goto-char (match-beginning 0)) - (insert to) - (set-text-properties (- (point) (length to)) (point) - (text-properties-at (point))) - (delete-region (point) (+ (point) (- (match-end 0) - (match-beginning 0))))) - (setq alist (cdr alist))))))) - -;;; Some list-manipulation functions that we need. - -(defun format-delq-cons (cons list) - "Remove the given CONS from LIST by side effect, -and return the new LIST. Since CONS could be the first element -of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of -changing the value of `foo'." - (if (eq cons list) - (cdr list) - (let ((p list)) - (while (not (eq (cdr p) cons)) - (if (null p) (error "format-delq-cons: not an element.")) - (setq p (cdr p))) - ;; Now (cdr p) is the cons to delete - (setcdr p (cdr cons)) - list))) - -(defun format-make-relatively-unique (a b) - "Delete common elements of lists A and B, return as pair. -Compares using `equal'." - (let* ((acopy (copy-sequence a)) - (bcopy (copy-sequence b)) - (tail acopy)) - (while tail - (let ((dup (member (car tail) bcopy)) - (next (cdr tail))) - (if dup (setq acopy (format-delq-cons tail acopy) - bcopy (format-delq-cons dup bcopy))) - (setq tail next))) - (cons acopy bcopy))) - -(defun format-common-tail (a b) - "Given two lists that have a common tail, return it. -Compares with `equal', and returns the part of A that is equal to the -equivalent part of B. If even the last items of the two are not equal, -returns nil." - (let ((la (length a)) - (lb (length b))) - ;; Make sure they are the same length - (if (> la lb) - (setq a (nthcdr (- la lb) a)) - (setq b (nthcdr (- lb la) b)))) - (while (not (equal a b)) - (setq a (cdr a) - b (cdr b))) - a) - -(defun format-reorder (items order) - "Arrange ITEMS to following partial ORDER. -Elements of ITEMS equal to elements of ORDER will be rearranged to follow the -ORDER. Unmatched items will go last." - (if order - (let ((item (member (car order) items))) - (if item - (cons (car item) - (format-reorder (format-delq-cons item items) - (cdr order))) - (format-reorder items (cdr order)))) - items)) - -(put 'face 'format-list-valued t) ; These text-properties take values -(put 'unknown 'format-list-valued t) ; that are lists, the elements of which - ; should be considered separately. - ; See format-deannotate-region and - ; format-annotate-region. - -;;; -;;; Decoding -;;; - -(defun format-deannotate-region (from to translations next-fn) - "Translate annotations in the region into text properties. -This sets text properties between FROM to TO as directed by the -TRANSLATIONS and NEXT-FN arguments. - -NEXT-FN is a function that searches forward from point for an annotation. -It should return a list of 4 elements: \(BEGIN END NAME POSITIVE). BEGIN and -END are buffer positions bounding the annotation, NAME is the name searched -for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks -the beginning of a region with some property, or nil if it ends the region. -NEXT-FN should return nil if there are no annotations after point. - -The basic format of the TRANSLATIONS argument is described in the -documentation for the `format-annotate-region' function. There are some -additional things to keep in mind for decoding, though: - -When an annotation is found, the TRANSLATIONS list is searched for a -text-property name and value that corresponds to that annotation. If the -text-property has several annotations associated with it, it will be used only -if the other annotations are also in effect at that point. The first match -found whose annotations are all present is used. - -The text property thus determined is set to the value over the region between -the opening and closing annotations. However, if the text-property name has a -non-nil `format-list-valued' property, then the value will be consed onto the -surrounding value of the property, rather than replacing that value. - -There are some special symbols that can be used in the \"property\" slot of -the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase). -Annotations listed under the pseudo-property PARAMETER are considered to be -arguments of the immediately surrounding annotation; the text between the -opening and closing parameter annotations is deleted from the buffer but saved -as a string. The surrounding annotation should be listed under the -pseudo-property FUNCTION. Instead of inserting a text-property for this -annotation, the function listed in the VALUE slot is called to make whatever -changes are appropriate. The function's first two arguments are the START and -END locations, and the rest of the arguments are any PARAMETERs found in that -region. - -Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS -are saved as values of the `unknown' text-property \(which is list-valued). -The TRANSLATIONS list should usually contain an entry of the form - \(unknown \(nil format-annotate-value)) -to write these unknown annotations back into the file." - (save-excursion - (save-restriction - (narrow-to-region (point-min) to) - (goto-char from) - (let (next open-ans todo - ;; loc - unknown-ans) - (while (setq next (funcall next-fn)) - (let* ((loc (nth 0 next)) - (end (nth 1 next)) - (name (nth 2 next)) - (positive (nth 3 next)) - (found nil)) - - ;; Delete the annotation - (delete-region loc end) - (cond - ;; Positive annotations are stacked, remembering location - (positive (setq open-ans (cons `(,name ((,loc . nil))) open-ans))) - ;; It is a negative annotation: - ;; Close the top annotation & add its text property. - ;; If the file's nesting is messed up, the close might not match - ;; the top thing on the open-annotations stack. - ;; If no matching annotation is open, just ignore the close. - ((not (assoc name open-ans)) - (message "Extra closing annotation (%s) in file" name)) - ;; If one is open, but not on the top of the stack, close - ;; the things in between as well. Set `found' when the real - ;; one is closed. - (t - (while (not found) - (let* ((top (car open-ans)) ; first on stack: should match. - (top-name (car top)) ; text property name - (top-extents (nth 1 top)) ; property regions - (params (cdr (cdr top))) ; parameters - (aalist translations) - (matched nil)) - (if (equal name top-name) - (setq found t) - (message "Improper nesting in file.")) - ;; Look through property names in TRANSLATIONS - (while aalist - (let ((prop (car (car aalist))) - (alist (cdr (car aalist)))) - ;; And look through values for each property - (while alist - (let ((value (car (car alist))) - (ans (cdr (car alist)))) - (if (member top-name ans) - ;; This annotation is listed, but still have to - ;; check if multiple annotations are satisfied - (if (member nil (mapcar (lambda (r) - (assoc r open-ans)) - ans)) - nil ; multiple ans not satisfied - ;; If there are multiple annotations going - ;; into one text property, split up the other - ;; annotations so they apply individually to - ;; the other regions. - (setcdr (car top-extents) loc) - (let ((to-split ans) this-one extents) - (while to-split - (setq this-one - (assoc (car to-split) open-ans) - extents (nth 1 this-one)) - (if (not (eq this-one top)) - (setcar (cdr this-one) - (format-subtract-regions - extents top-extents))) - (setq to-split (cdr to-split)))) - ;; Set loop variables to nil so loop - ;; will exit. - (setq alist nil aalist nil matched t - ;; pop annotation off stack. - open-ans (cdr open-ans)) - (let ((extents top-extents) - (start (car (car top-extents))) - (loc (cdr (car top-extents)))) - (while extents - (cond - ;; Check for pseudo-properties - ((eq prop 'PARAMETER) - ;; A parameter of the top open ann: - ;; delete text and use as arg. - (if open-ans - ;; (If nothing open, discard). - (setq open-ans - (cons - (append (car open-ans) - (list - (buffer-substring - start loc))) - (cdr open-ans)))) - (delete-region start loc)) - ((eq prop 'FUNCTION) - ;; Not a property, but a function. - (let ((rtn - (apply value start loc params))) - (if rtn (setq todo (cons rtn todo))))) - (t - ;; Normal property/value pair - (setq todo - (cons (list start loc prop value) - todo)))) - (setq extents (cdr extents) - start (car (car extents)) - loc (cdr (car extents)))))))) - (setq alist (cdr alist)))) - (setq aalist (cdr aalist))) - (unless matched - ;; Didn't find any match for the annotation: - ;; Store as value of text-property `unknown'. - (setcdr (car top-extents) loc) - (let ((extents top-extents) - (start (car (car top-extents))) - (loc (cdr (car top-extents)))) - (while extents - (setq open-ans (cdr open-ans) - todo (cons (list start loc 'unknown top-name) - todo) - unknown-ans (cons name unknown-ans) - extents (cdr extents) - start (car (car extents)) - loc (cdr (car extents)))))))))))) - - ;; Once entire file has been scanned, add the properties. - (while todo - (let* ((item (car todo)) - (from (nth 0 item)) - (to (nth 1 item)) - (prop (nth 2 item)) - (val (nth 3 item))) - - (if (numberp val) ; add to ambient value if numeric - (format-property-increment-region from to prop val 0) - (put-text-property - from to prop - (cond ((get prop 'format-list-valued) ; value gets consed onto - ; list-valued properties - (let ((prev (get-text-property from prop))) - (cons val (if (listp prev) prev (list prev))))) - (t val))))) ; normally, just set to val. - (setq todo (cdr todo))) - - (if unknown-ans - (message "Unknown annotations: %s" unknown-ans)))))) - -(defun format-subtract-regions (minu subtra) - "Remove the regions in SUBTRAHEND from the regions in MINUEND. A region -is a dotted pair (from . to). Both parameters are lists of regions. Each -list must contain nonoverlapping, noncontiguous regions, in descending -order. The result is also nonoverlapping, noncontiguous, and in descending -order. The first element of MINUEND can have a cdr of nil, indicating that -the end of that region is not yet known." - (let* ((minuend (copy-alist minu)) - (subtrahend (copy-alist subtra)) - (m (car minuend)) - (s (car subtrahend)) - results) - (while (and minuend subtrahend) - (cond - ;; The minuend starts after the subtrahend ends; keep it. - ((> (car m) (cdr s)) - (setq results (cons m results) - minuend (cdr minuend) - m (car minuend))) - ;; The minuend extends beyond the end of the subtrahend. Chop it off. - ((or (null (cdr m)) (> (cdr m) (cdr s))) - (setq results (cons (cons (1+ (cdr s)) (cdr m)) results)) - (setcdr m (cdr s))) - ;; The subtrahend starts after the minuend ends; throw it away. - ((< (cdr m) (car s)) - (setq subtrahend (cdr subtrahend) s (car subtrahend))) - ;; The subtrahend extends beyond the end of the minuend. Chop it off. - (t ;(<= (cdr m) (cdr s))) - (if (>= (car m) (car s)) - (setq minuend (cdr minuend) m (car minuend)) - (setcdr m (1- (car s))) - (setq subtrahend (cdr subtrahend) s (car subtrahend)))))) - (nconc (nreverse results) minuend))) - -;; This should probably go somewhere other than format.el. Then again, -;; indent.el has alter-text-property. NOTE: We can also use -;; next-single-property-change instead of text-property-not-all, but then -;; we have to see if we passed TO. -(defun format-property-increment-region (from to prop delta default) - "Increment property PROP over the region between FROM and TO by the -amount DELTA (which may be negative). If property PROP is nil anywhere -in the region, it is treated as though it were DEFAULT." - (let ((cur from) val newval next) - (while cur - (setq val (get-text-property cur prop) - newval (+ (or val default) delta) - next (text-property-not-all cur to prop val)) - (put-text-property cur (or next to) prop newval) - (setq cur next)))) - -;;; -;;; Encoding -;;; - -(defun format-insert-annotations (list &optional offset) - "Apply list of annotations to buffer as `write-region' would. -Inserts each element of the given LIST of buffer annotations at its -appropriate place. Use second arg OFFSET if the annotations' locations are -not relative to the beginning of the buffer: annotations will be inserted -at their location-OFFSET+1 \(ie, the offset is treated as the character number -of the first character in the buffer)." - (if (not offset) - (setq offset 0) - (setq offset (1- offset))) - (let ((l (reverse list))) - (while l - (goto-char (- (car (car l)) offset)) - (insert (cdr (car l))) - (setq l (cdr l))))) - -(defun format-annotate-value (old new) - "Return OLD and NEW as a \(close . open) annotation pair. -Useful as a default function for TRANSLATIONS alist when the value of the text -property is the name of the annotation that you want to use, as it is for the -`unknown' text property." - (cons (if old (list old)) - (if new (list new)))) - -(defun format-annotate-region (from to trans format-fn ignore) - "Generate annotations for text properties in the region. -Searches for changes between FROM and TO, and describes them with a list of -annotations as defined by alist TRANSLATIONS and FORMAT-FN. IGNORE lists text -properties not to consider; any text properties that are neither ignored nor -listed in TRANSLATIONS are warned about. -If you actually want to modify the region, give the return value of this -function to `format-insert-annotations'. - -Format of the TRANSLATIONS argument: - -Each element is a list whose car is a PROPERTY, and the following -elements are VALUES of that property followed by the names of zero or more -ANNOTATIONS. Whenever the property takes on that value, the annotations -\(as formatted by FORMAT-FN) are inserted into the file. -When the property stops having that value, the matching negated annotation -will be inserted \(it may actually be closed earlier and reopened, if -necessary, to keep proper nesting). - -If the property's value is a list, then each element of the list is dealt with -separately. - -If a VALUE is numeric, then it is assumed that there is a single annotation -and each occurrence of it increments the value of the property by that number. -Thus, given the entry \(left-margin \(4 \"indent\")), if the left margin -changes from 4 to 12, two annotations will be generated. - -If the VALUE is nil, then instead of annotations, a function should be -specified. This function is used as a default: it is called for all -transitions not explicitly listed in the table. The function is called with -two arguments, the OLD and NEW values of the property. It should return -lists of annotations like `format-annotate-location' does. - - The same structure can be used in reverse for reading files." - (let ((all-ans nil) ; All annotations - becomes return value - (open-ans nil) ; Annotations not yet closed - (loc nil) ; Current location - (not-found nil)) ; Properties that couldn't be saved - (while (or (null loc) - (and (setq loc (next-property-change loc nil to)) - (< loc to))) - (or loc (setq loc from)) - (let* ((ans (format-annotate-location loc (= loc from) ignore trans)) - (neg-ans (format-reorder (aref ans 0) open-ans)) - (pos-ans (aref ans 1)) - (ignored (aref ans 2))) - (setq not-found (append ignored not-found) - ignore (append ignored ignore)) - ;; First do the negative (closing) annotations - (while neg-ans - ;; Check if it's missing. This can happen (eg, a numeric property - ;; going negative can generate closing annotations before there are - ;; any open). Warn user & ignore. - (if (not (member (car neg-ans) open-ans)) - (message "Can't close %s: not open." (car neg-ans)) - (while (not (equal (car neg-ans) (car open-ans))) - ;; To close anno. N, need to first close ans 1 to N-1, - ;; remembering to re-open them later. - (setq pos-ans (cons (car open-ans) pos-ans)) - (setq all-ans - (cons (cons loc (funcall format-fn (car open-ans) nil)) - all-ans)) - (setq open-ans (cdr open-ans))) - ;; Now remove the one we're really interested in from open list. - (setq open-ans (cdr open-ans)) - ;; And put the closing annotation here. - (setq all-ans - (cons (cons loc (funcall format-fn (car neg-ans) nil)) - all-ans))) - (setq neg-ans (cdr neg-ans))) - ;; Now deal with positive (opening) annotations - (let ( ; (p pos-ans) - ) - (while pos-ans - (setq open-ans (cons (car pos-ans) open-ans)) - (setq all-ans - (cons (cons loc (funcall format-fn (car pos-ans) t)) - all-ans)) - (setq pos-ans (cdr pos-ans)))))) - - ;; Close any annotations still open - (while open-ans - (setq all-ans - (cons (cons to (funcall format-fn (car open-ans) nil)) - all-ans)) - (setq open-ans (cdr open-ans))) - (if not-found - (message "These text properties could not be saved:\n %s" - not-found)) - (nreverse all-ans))) - -;;; Internal functions for format-annotate-region. - -(defun format-annotate-location (loc all ignore trans) - "Return annotation(s) needed at LOCATION. -This includes any properties that change between LOC-1 and LOC. -If ALL is true, don't look at previous location, but generate annotations for -all non-nil properties. -Third argument IGNORE is a list of text-properties not to consider. - -Return value is a vector of 3 elements: -1. List of names of the annotations to close -2. List of the names of annotations to open. -3. List of properties that were ignored or couldn't be annotated." - (let* ((prev-loc (1- loc)) - (before-plist (if all nil (text-properties-at prev-loc))) - (after-plist (text-properties-at loc)) - p negatives positives prop props not-found) - ;; make list of all property names involved - (setq p before-plist) - (while p - (if (not (memq (car p) props)) - (setq props (cons (car p) props))) - (setq p (cdr (cdr p)))) - (setq p after-plist) - (while p - (if (not (memq (car p) props)) - (setq props (cons (car p) props))) - (setq p (cdr (cdr p)))) - - (while props - (setq prop (car props) - props (cdr props)) - (if (memq prop ignore) - nil ; If it's been ignored before, ignore it now. - (let ((before (if all nil (car (cdr (memq prop before-plist))))) - (after (car (cdr (memq prop after-plist))))) - (if (equal before after) - nil ; no change; ignore - (let ((result (format-annotate-single-property-change - prop before after trans))) - (if (not result) - (setq not-found (cons prop not-found)) - (setq negatives (nconc negatives (car result)) - positives (nconc positives (cdr result))))))))) - (vector negatives positives not-found))) - -(defun format-annotate-single-property-change (prop old new trans) - "Return annotations for PROPERTY changing from OLD to NEW. -These are searched for in the TRANSLATIONS alist. -If NEW does not appear in the list, but there is a default function, then that -function is called. -Annotations to open and to close are returned as a dotted pair." - (let ((prop-alist (cdr (assoc prop trans))) - ;; default - ) - (if (not prop-alist) - nil - ;; If either old or new is a list, have to treat both that way. - (if (or (consp old) (consp new)) - (let* ((old (if (listp old) old (list old))) - (new (if (listp new) new (list new))) - ;; (tail (format-common-tail old new)) - close open) - (while old - (setq close - (append (car (format-annotate-atomic-property-change - prop-alist (car old) nil)) - close) - old (cdr old))) - (while new - (setq open - (append (cdr (format-annotate-atomic-property-change - prop-alist nil (car new))) - open) - new (cdr new))) - (format-make-relatively-unique close open)) - (format-annotate-atomic-property-change prop-alist old new))))) - -(defun format-annotate-atomic-property-change (prop-alist old new) - "Internal function annotate a single property change. -PROP-ALIST is the relevant segment of a TRANSLATIONS list. -OLD and NEW are the values." - (let (num-ann) - ;; If old and new values are numbers, - ;; look for a number in PROP-ALIST. - (if (and (or (null old) (numberp old)) - (or (null new) (numberp new))) - (progn - (setq num-ann prop-alist) - (while (and num-ann (not (numberp (car (car num-ann))))) - (setq num-ann (cdr num-ann))))) - (if num-ann - ;; Numerical annotation - use difference - (progn - ;; If property is numeric, nil means 0 - (cond ((and (numberp old) (null new)) - (setq new 0)) - ((and (numberp new) (null old)) - (setq old 0))) - - (let* ((entry (car num-ann)) - (increment (car entry)) - (n (ceiling (/ (float (- new old)) (float increment)))) - (anno (car (cdr entry)))) - (if (> n 0) - (cons nil (make-list n anno)) - (cons (make-list (- n) anno) nil)))) - - ;; Standard annotation - (let ((close (and old (cdr (assoc old prop-alist)))) - (open (and new (cdr (assoc new prop-alist))))) - (if (or close open) - (format-make-relatively-unique close open) - ;; Call "Default" function, if any - (let ((default (assq nil prop-alist))) - (if default - (funcall (car (cdr default)) old new)))))))) - -;;; format.el ends here diff --git a/lisp/frame.el b/lisp/frame.el deleted file mode 100644 index 1b98fe3..0000000 --- a/lisp/frame.el +++ /dev/null @@ -1,1290 +0,0 @@ -;;; frame.el --- multi-frame management independent of window systems. - -;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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 19.30. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defgroup frames nil - "Support for Emacs frames and window systems." - :group 'environment) - -; No need for `frame-creation-function'. - -;;; The initial value given here for this must ask for a minibuffer. -;;; There must always exist a frame with a minibuffer, and after we -;;; delete the terminal frame, this will be the only frame. -(defcustom initial-frame-plist '(minibuffer t) - "Plist of frame properties for creating the initial X window frame. -You can set this in your `.emacs' file; for example, - (setq initial-frame-plist '(top 1 left 1 width 80 height 55)) -Properties specified here supersede the values given in `default-frame-plist'. -The format of this can also be an alist for backward compatibility. - -If the value calls for a frame without a minibuffer, and you have not created -a minibuffer frame on your own, one is created according to -`minibuffer-frame-plist'. - -You can specify geometry-related options for just the initial frame -by setting this variable in your `.emacs' file; however, they won't -take effect until Emacs reads `.emacs', which happens after first creating -the frame. If you want the frame to have the proper geometry as soon -as it appears, you need to use this three-step process: -* Specify X resources to give the geometry you want. -* Set `default-frame-plist' to override these options so that they - don't affect subsequent frames. -* Set `initial-frame-plist' in a way that matches the X resources, - to override what you put in `default-frame-plist'." - :type 'plist - :group 'frames) - -(defcustom minibuffer-frame-plist '(width 80 height 2 menubar-visible-p nil - default-toolbar-visible-p nil) - "Plist of frame properties for initially creating a minibuffer frame. -You can set this in your `.emacs' file; for example, - (setq minibuffer-frame-plist '(top 1 left 1 width 80 height 2)) -Properties specified here supersede the values given in -`default-frame-plist'. -The format of this can also be an alist for backward compatibility." - :type 'plist - :group 'frames) - -(defcustom pop-up-frame-plist nil - "Plist of frame properties used when creating pop-up frames. -Pop-up frames are used for completions, help, and the like. -This variable can be set in your init file, like this: - (setq pop-up-frame-plist '(width 80 height 20)) -These supersede the values given in `default-frame-plist'. -The format of this can also be an alist for backward compatibility." - :type 'plist - :group 'frames) - -(setq pop-up-frame-function - (function (lambda () - (make-frame pop-up-frame-plist)))) - -(defcustom special-display-frame-plist '(height 14 width 80 unsplittable t) - "*Plist of frame properties used when creating special frames. -Special frames are used for buffers whose names are in -`special-display-buffer-names' and for buffers whose names match -one of the regular expressions in `special-display-regexps'. -This variable can be set in your init file, like this: - (setq special-display-frame-plist '(width 80 height 20)) -These supersede the values given in `default-frame-plist'. -The format of this can also be an alist for backward compatibility." - :type 'plist - :group 'frames) - -(defun safe-alist-to-plist (cruftiness) - (if (consp (car cruftiness)) - (alist-to-plist cruftiness) - cruftiness)) - -;; Display BUFFER in its own frame, reusing an existing window if any. -;; Return the window chosen. -;; Currently we do not insist on selecting the window within its frame. -;; If ARGS is a plist, use it as a list of frame property specs. -;; #### Change, not compatible with FSF: This stuff is all so incredibly -;; junky anyway that I doubt it makes any difference. -;; If ARGS is a list whose car is t, -;; use (cadr ARGS) as a function to do the work. -;; Pass it BUFFER as first arg, and (cddr ARGS) gives the rest of the args. -(defun special-display-popup-frame (buffer &optional args) - ;; if we can't display simultaneous multiple frames, just return - ;; nil and let the normal behavior take over. - (and (device-on-window-system-p) - (if (and args (eq t (car args))) - (apply (cadr args) buffer (cddr args)) - (let ((window (get-buffer-window buffer t))) - (if window - ;; If we have a window already, make it visible. - (let ((frame (window-frame window))) - (make-frame-visible frame) - (raise-frame frame) - window) - ;; If no window yet, make one in a new frame. - (let ((frame - (make-frame (append (safe-alist-to-plist args) - (safe-alist-to-plist - special-display-frame-plist))))) - (set-window-buffer (frame-selected-window frame) buffer) - (set-window-dedicated-p (frame-selected-window frame) t) - (frame-selected-window frame))))))) - -(setq special-display-function 'special-display-popup-frame) - -;;; Handle delete-frame events from the X server. -;(defun handle-delete-frame (event) -; (interactive "e") -; (let ((frame (posn-window (event-start event))) -; (i 0) -; (tail (frame-list))) -; (while tail -; (and (frame-visible-p (car tail)) -; (not (eq (car tail) frame)) -; (setq i (1+ i))) -; (setq tail (cdr tail))) -; (if (> i 0) -; (delete-frame frame t) -; (kill-emacs)))) - - -;;;; Arrangement of frames at startup - -;;; 1) Load the window system startup file from the lisp library and read the -;;; high-priority arguments (-q and the like). The window system startup -;;; file should create any frames specified in the window system defaults. -;;; -;;; 2) If no frames have been opened, we open an initial text frame. -;;; -;;; 3) Once the init file is done, we apply any newly set properties -;;; in initial-frame-plist to the frame. - -;; These are now called explicitly at the proper times, -;; since that is easier to understand. -;; Actually using hooks within Emacs is bad for future maintenance. --rms. -;; (add-hook 'before-init-hook 'frame-initialize) -;; (add-hook 'window-setup-hook 'frame-notice-user-settings) - -;;; If we create the initial frame, this is it. -(defvar frame-initial-frame nil) - -;; Record the properties used in frame-initialize to make the initial frame. -(defvar frame-initial-frame-plist) - -(defvar frame-initial-geometry-arguments nil) - -(defun canonicalize-frame-plists () - (setq initial-frame-plist (safe-alist-to-plist initial-frame-plist)) - (setq default-frame-plist (safe-alist-to-plist default-frame-plist))) - -;;; startup.el calls this function before loading the user's init -;;; file - if there is no frame with a minibuffer open now, create -;;; one to display messages while loading the init file. -(defun frame-initialize () - ;; In batch mode, we actually use the initial terminal device for output. - (canonicalize-frame-plists) - (if (not (noninteractive)) - (progn - ;; Don't call select-frame here - focus is a matter of WM policy. - - ;; If there is no frame with a minibuffer besides the terminal - ;; frame, then we need to create the opening frame. Make sure - ;; it has a minibuffer, but let initial-frame-plist omit the - ;; minibuffer spec. - (or (delq terminal-frame (minibuffer-frame-list)) - (progn - (setq frame-initial-frame-plist - (append initial-frame-plist default-frame-plist)) - ;; FSFmacs has scroll-bar junk here that we don't need. - (setq default-minibuffer-frame - (setq frame-initial-frame - (make-frame initial-frame-plist - (car (delq terminal-device - (device-list)))))) - ;; Delete any specifications for window geometry properties - ;; so that we won't reapply them in frame-notice-user-settings. - ;; It would be wrong to reapply them then, - ;; because that would override explicit user resizing. - (setq initial-frame-plist - (frame-remove-geometry-props initial-frame-plist)))) - ;; At this point, we know that we have a frame open, so we - ;; can delete the terminal device. - ;; (delete-device terminal-device) - ;; Do it the same way Fkill_emacs does it. -slb - (delete-console terminal-console) - (setq terminal-frame nil) - - ;; FSFmacs sets frame-creation-function here, but no need. - ))) - -;;; startup.el calls this function after loading the user's init -;;; file. Now default-frame-plist and initial-frame-plist contain -;;; information to which we must react; do what needs to be done. -(defun frame-notice-user-settings () - - ;; FSFmacs has menu-bar junk here that we don't need. - - (canonicalize-frame-plists) - - ;; Creating and deleting frames may shift the selected frame around, - ;; and thus the current buffer. Protect against that. We don't - ;; want to use save-excursion here, because that may also try to set - ;; the buffer of the selected window, which fails when the selected - ;; window is the minibuffer. - (let ((old-buffer (current-buffer))) - - ;; If the initial frame is still around, apply initial-frame-plist - ;; and default-frame-plist to it. - (if (frame-live-p frame-initial-frame) - - ;; The initial frame we create above always has a minibuffer. - ;; If the user wants to remove it, or make it a minibuffer-only - ;; frame, then we'll have to delete the selected frame and make a - ;; new one; you can't remove or add a root window to/from an - ;; existing frame. - ;; - ;; NOTE: default-frame-plist was nil when we created the - ;; existing frame. We need to explicitly include - ;; default-frame-plist in the properties of the screen we - ;; create here, so that its new value, gleaned from the user's - ;; .emacs file, will be applied to the existing screen. - (if (not (eq (car - (or (and (lax-plist-member - initial-frame-plist 'minibuffer) - (list (lax-plist-get initial-frame-plist - 'minibuffer))) - (and (lax-plist-member default-frame-plist - 'minibuffer) - (list (lax-plist-get default-frame-plist - 'minibuffer))) - '(t))) - t)) - ;; Create the new frame. - (let (props - ) - ;; If the frame isn't visible yet, wait till it is. - ;; If the user has to position the window, - ;; Emacs doesn't know its real position until - ;; the frame is seen to be visible. - - (if (frame-property frame-initial-frame 'initially-unmapped) - nil - (while (not (frame-visible-p frame-initial-frame)) - (sleep-for 1))) - (setq props (frame-properties frame-initial-frame)) - ;; Get rid of `name' unless it was specified explicitly before. - (or (lax-plist-member frame-initial-frame-plist 'name) - (setq props (lax-plist-remprop props 'name))) - (setq props (append initial-frame-plist default-frame-plist - props - nil)) - ;; Get rid of `reverse', because that was handled - ;; when we first made the frame. - (laxputf props 'reverse nil) - ;; Get rid of `window-id', otherwise make-frame will - ;; think we're trying to setup an external widget. - (laxremf props 'window-id) - (if (lax-plist-member frame-initial-geometry-arguments 'height) - (laxremf props 'height)) - (if (lax-plist-member frame-initial-geometry-arguments 'width) - (laxremf props 'width)) - (if (lax-plist-member frame-initial-geometry-arguments 'left) - (laxremf props 'left)) - (if (lax-plist-member frame-initial-geometry-arguments 'top) - (laxremf props 'top)) - - ;; Now create the replacement initial frame. - (make-frame - ;; Use the geometry args that created the existing - ;; frame, rather than the props we get for it. - (append '(user-size t user-position t) - frame-initial-geometry-arguments - props)) - ;; The initial frame, which we are about to delete, may be - ;; the only frame with a minibuffer. If it is, create a - ;; new one. - (or (delq frame-initial-frame (minibuffer-frame-list)) - (make-initial-minibuffer-frame nil)) - - ;; If the initial frame is serving as a surrogate - ;; minibuffer frame for any frames, we need to wean them - ;; onto a new frame. The default-minibuffer-frame - ;; variable must be handled similarly. - (let ((users-of-initial - (filtered-frame-list - #'(lambda (frame) - (and (not (eq frame frame-initial-frame)) - (eq (window-frame - (minibuffer-window frame)) - frame-initial-frame)))))) - (if (or users-of-initial - (eq default-minibuffer-frame frame-initial-frame)) - - ;; Choose an appropriate frame. Prefer frames which - ;; are only minibuffers. - (let* ((new-surrogate - (car - (or (filtered-frame-list - #'(lambda (frame) - (eq 'only - (frame-property frame 'minibuffer)))) - (minibuffer-frame-list)))) - (new-minibuffer (minibuffer-window new-surrogate))) - - (if (eq default-minibuffer-frame frame-initial-frame) - (setq default-minibuffer-frame new-surrogate)) - - ;; Wean the frames using frame-initial-frame as - ;; their minibuffer frame. - (mapcar - #' - (lambda (frame) - (set-frame-property frame 'minibuffer - new-minibuffer)) - users-of-initial)))) - - ;; Redirect events enqueued at this frame to the new frame. - ;; Is this a good idea? - ;; Probably not, since this whole redirect-frame-focus - ;; stuff is a load of trash, and so is this function we're in. - ;; --ben - ;(redirect-frame-focus frame-initial-frame new) - - ;; Finally, get rid of the old frame. - (delete-frame frame-initial-frame t)) - - ;; Otherwise, we don't need all that rigamarole; just apply - ;; the new properties. - (let (newprops allprops tail) - (setq allprops (append initial-frame-plist - default-frame-plist)) - (if (lax-plist-member frame-initial-geometry-arguments 'height) - (laxremf allprops 'height)) - (if (lax-plist-member frame-initial-geometry-arguments 'width) - (remf allprops 'width)) - (if (lax-plist-member frame-initial-geometry-arguments 'left) - (laxremf allprops 'left)) - (if (lax-plist-member frame-initial-geometry-arguments 'top) - (laxremf allprops 'top)) - (setq tail allprops) - ;; Find just the props that have changed since we first - ;; made this frame. Those are the ones actually set by - ;; the init file. For those props whose values we already knew - ;; (such as those spec'd by command line options) - ;; it is undesirable to specify the parm again - ;; once the user has seen the frame and been able to alter it - ;; manually. - (while tail - (let (newval oldval) - (setq oldval (lax-plist-get frame-initial-frame-plist - (car tail))) - (setq newval (lax-plist-get allprops (car tail))) - (or (eq oldval newval) - (laxputf newprops (car tail) newval))) - (setq tail (cddr tail))) - (set-frame-properties frame-initial-frame newprops) - ;silly FSFmacs junk - ;if (lax-plist-member newprops 'font) - ; (frame-update-faces frame-initial-frame)) - - ))) - - ;; Restore the original buffer. - (set-buffer old-buffer) - - ;; Make sure the initial frame can be GC'd if it is ever deleted. - ;; Make sure frame-notice-user-settings does nothing if called twice. - (setq frame-initial-frame nil))) - -(defun make-initial-minibuffer-frame (device) - (let ((props (append '(minibuffer only) - (safe-alist-to-plist minibuffer-frame-plist)))) - (make-frame props device))) - - -;;;; Creation of additional frames, and other frame miscellanea - -(defun get-other-frame () - "Return some frame other than the selected frame, creating one if necessary." - (let* ((this (selected-frame)) - ;; search visible frames first - (next (next-frame this 'visible-nomini))) - ;; then search iconified frames - (if (eq this next) - (setq next (next-frame 'visible-iconic-nomini))) - (if (eq this next) - ;; otherwise, make a new frame - (make-frame) - next))) - -(defun next-multiframe-window () - "Select the next window, regardless of which frame it is on." - (interactive) - (select-window (next-window (selected-window) - (> (minibuffer-depth) 0) - t))) - -(defun previous-multiframe-window () - "Select the previous window, regardless of which frame it is on." - (interactive) - (select-window (previous-window (selected-window) - (> (minibuffer-depth) 0) - t))) - -(defun make-frame-on-device (type connection &optional props) - "Create a frame of type TYPE on CONNECTION. -TYPE should be a symbol naming the device type, i.e. one of - -x An X display. CONNECTION should be a standard display string - such as \"unix:0\", or nil for the display specified on the - command line or in the DISPLAY environment variable. Only if - support for X was compiled into XEmacs. -tty A standard TTY connection or terminal. CONNECTION should be - a TTY device name such as \"/dev/ttyp2\" (as determined by - the Unix command `tty') or nil for XEmacs' standard input - and output (usually the TTY in which XEmacs started). Only - if support for TTY's was compiled into XEmacs. -ns A connection to a machine running the NeXTstep windowing - system. Not currently implemented. -mswindows A connection to a machine running Microsoft Windows NT or - Windows 95/97. -pc A direct-write MS-DOS frame. Not currently implemented. - -PROPS should be a plist of properties, as in the call to `make-frame'. - -If a connection to CONNECTION already exists, it is reused; otherwise, -a new connection is opened." - (make-frame props (make-device type connection props))) - -;; Alias, kept temporarily. -(defalias 'new-frame 'make-frame) - -; FSFmacs has make-frame here. We have it in C, so no need for -; frame-creation-function. - -(defun filtered-frame-list (predicate &optional device) - "Return a list of all live frames which satisfy PREDICATE. -If optional second arg DEVICE is non-nil, restrict the frames - returned to that device." - (let ((frames (if device (device-frame-list device) - (frame-list))) - good-frames) - (while (consp frames) - (if (funcall predicate (car frames)) - (setq good-frames (cons (car frames) good-frames))) - (setq frames (cdr frames))) - good-frames)) - -(defun minibuffer-frame-list (&optional device) - "Return a list of all frames with their own minibuffers. -If optional second arg DEVICE is non-nil, restrict the frames - returned to that device." - (filtered-frame-list - #'(lambda (frame) - (eq frame (window-frame (minibuffer-window frame)))) - device)) - -(defun frame-minibuffer-only-p (frame) - "Return non-nil if FRAME is a minibuffer-only frame." - (eq (frame-root-window frame) (minibuffer-window frame))) - -(defun frame-remove-geometry-props (plist) - "Return the property list PLIST, but with geometry specs removed. -This deletes all bindings in PLIST for `top', `left', `width', -`height', `user-size' and `user-position' properties. -Emacs uses this to avoid overriding explicit moves and resizings from -the user during startup." - (setq plist (canonicalize-lax-plist (copy-sequence plist))) - (mapcar #'(lambda (propname) - (if (lax-plist-member plist propname) - (progn - (setq frame-initial-geometry-arguments - (cons propname - (cons (lax-plist-get plist propname) - frame-initial-geometry-arguments))) - (setq plist (lax-plist-remprop plist propname))))) - '(height width top left user-size user-position)) - plist) - -(defun other-frame (arg) - "Select the ARG'th different visible frame, and raise it. -All frames are arranged in a cyclic order. -This command selects the frame ARG steps away in that order. -A negative ARG moves in the opposite order. - -This sets the window system focus, regardless of the value -of `focus-follows-mouse'." - (interactive "p") - (let ((frame (selected-frame))) - (while (> arg 0) - (setq frame (next-frame frame 'visible-nomini)) - (setq arg (1- arg))) - (while (< arg 0) - (setq frame (previous-frame frame 'visible-nomini)) - (setq arg (1+ arg))) - (raise-frame frame) - (focus-frame frame) - ;this is a bad idea; you should in general never warp the - ;pointer unless the user asks for this. Furthermore, - ;our version of `set-mouse-position' takes a window, - ;not a frame. - ;(set-mouse-position (selected-frame) (1- (frame-width)) 0) - ;some weird FSFmacs randomness - ;(if (fboundp 'unfocus-frame) - ; (unfocus-frame)))) - )) - -;; XEmacs-added utility functions - -(defmacro save-selected-frame (&rest body) - "Execute forms in BODY, then restore the selected frame. -The value returned is the value of the last form in BODY." - (let ((old-frame (gensym "ssf"))) - `(let ((,old-frame (selected-frame))) - (unwind-protect - (progn ,@body) - (select-frame ,old-frame))))) - -(defmacro with-selected-frame (frame &rest body) - "Execute forms in BODY with FRAME as the selected frame. -The value returned is the value of the last form in BODY." - `(save-selected-frame - (select-frame ,frame) - ,@body)) - -; this is in C in FSFmacs -(defun frame-list () - "Return a list of all frames on all devices/consoles." - ;; Lists are copies, so nconc is safe here. - (apply 'nconc (mapcar 'device-frame-list (device-list)))) - -(defun frame-type (&optional frame) - "Return the type of the specified frame (e.g. `x' or `tty'). -This is equivalent to the type of the frame's device. -Value is `tty' for a tty frame (a character-only terminal), -`x' for a frame that is an X window, -`ns' for a frame that is a NeXTstep window (not yet implemented), -`mswindows' for a frame that is a Windows NT or Windows 95/97 window, -`pc' for a frame that is a direct-write MS-DOS frame (not yet implemented), -`stream' for a stream frame (which acts like a stdio stream), and -`dead' for a deleted frame." - (or frame (setq frame (selected-frame))) - (if (not (frame-live-p frame)) 'dead - (device-type (frame-device frame)))) - -(defun device-or-frame-p (object) - "Return non-nil if OBJECT is a device or frame." - (or (devicep object) - (framep object))) - -(defun device-or-frame-type (device-or-frame) - "Return the type (e.g. `x' or `tty') of DEVICE-OR-FRAME. -DEVICE-OR-FRAME should be a device or a frame object. See `device-type' -for a description of the possible types." - (if (devicep device-or-frame) - (device-type device-or-frame) - (frame-type device-or-frame))) - -(defun fw-frame (obj) - "Given a frame or window, return the associated frame. -Return nil otherwise." - (cond ((windowp obj) (window-frame obj)) - ((framep obj) obj) - (t nil))) - - -;;;; Frame configurations - -(defun current-frame-configuration () - "Return a list describing the positions and states of all frames. -Its car is `frame-configuration'. -Each element of the cdr is a list of the form (FRAME PLIST WINDOW-CONFIG), -where - FRAME is a frame object, - PLIST is a property list specifying some of FRAME's properties, and - WINDOW-CONFIG is a window configuration object for FRAME." - (cons 'frame-configuration - (mapcar (function - (lambda (frame) - (list frame - (frame-properties frame) - (current-window-configuration frame)))) - (frame-list)))) - -(defun set-frame-configuration (configuration &optional nodelete) - "Restore the frames to the state described by CONFIGURATION. -Each frame listed in CONFIGURATION has its position, size, window -configuration, and other properties set as specified in CONFIGURATION. -Ordinarily, this function deletes all existing frames not -listed in CONFIGURATION. But if optional second argument NODELETE -is given and non-nil, the unwanted frames are iconified instead." - (or (frame-configuration-p configuration) - (signal 'wrong-type-argument - (list 'frame-configuration-p configuration))) - (let ((config-plist (cdr configuration)) - frames-to-delete) - (mapc (lambda (frame) - (let ((properties (assq frame config-plist))) - (if properties - (progn - (set-frame-properties - frame - ;; Since we can't set a frame's minibuffer status, - ;; we might as well omit the parameter altogether. - (lax-plist-remprop (nth 1 properties) 'minibuffer)) - (set-window-configuration (nth 2 properties))) - (setq frames-to-delete (cons frame frames-to-delete))))) - (frame-list)) - (if nodelete - ;; Note: making frames invisible here was tried - ;; but led to some strange behavior--each time the frame - ;; was made visible again, the window manager asked afresh - ;; for where to put it. - (mapc 'iconify-frame frames-to-delete) - (mapc 'delete-frame frames-to-delete)))) - -; this function is in subr.el in FSFmacs. -; that's because they don't always include frame.el, while we do. - -(defun frame-configuration-p (object) - "Return non-nil if OBJECT seems to be a frame configuration. -Any list whose car is `frame-configuration' is assumed to be a frame -configuration." - (and (consp object) - (eq (car object) 'frame-configuration))) - - -;; FSFmacs has functions `frame-width', `frame-height' here. -;; We have them in C. - -;; FSFmacs has weird functions `set-default-font', `set-background-color', -;; `set-foreground-color' here. They don't do sensible things like -;; set faces; instead they set frame properties (??!!) and call -;; useless functions such as `frame-update-faces' and -;; `frame-update-face-colors'. - -;; FSFmacs has functions `set-cursor-color', `set-mouse-color', and -;; `set-border-color', which refer to frame properties. -;; #### We need to use specifiers here. - -;(defun auto-raise-mode (arg) -; "Toggle whether or not the selected frame should auto-raise. -;With arg, turn auto-raise mode on if and only if arg is positive. -;Note that this controls Emacs's own auto-raise feature. -;Some window managers allow you to enable auto-raise for certain windows. -;You can use that for Emacs windows if you wish, but if you do, -;that is beyond the control of Emacs and this command has no effect on it." -; (interactive "P") -; (if (null arg) -; (setq arg -; (if (frame-property (selected-frame) 'auto-raise) -; -1 1))) -; (set-frame-property (selected-frame) 'auto-raise (> arg 0))) - -;(defun auto-lower-mode (arg) -; "Toggle whether or not the selected frame should auto-lower. -;With arg, turn auto-lower mode on if and only if arg is positive. -;Note that this controls Emacs's own auto-lower feature. -;Some window managers allow you to enable auto-lower for certain windows. -;You can use that for Emacs windows if you wish, but if you do, -;that is beyond the control of Emacs and this command has no effect on it." -; (interactive "P") -; (if (null arg) -; (setq arg -; (if (frame-property (selected-frame) 'auto-lower) -; -1 1))) -; (set-frame-property (selected-frame) 'auto-lower (> arg 0))) - -;; FSFmacs has silly functions `toggle-scroll-bar', -;; `toggle-horizontal-scrollbar' - -;;; Iconifying emacs. -;;; -;;; The function iconify-emacs replaces every non-iconified emacs window -;;; with a *single* icon. Iconified emacs windows are left alone. When -;;; emacs is in this globally-iconified state, de-iconifying any emacs icon -;;; will uniconify all frames that were visible, and iconify all frames -;;; that were not. This is done by temporarily changing the value of -;;; `map-frame-hook' to `deiconify-emacs' (which should never be called -;;; except from the map-frame-hook while emacs is iconified). -;;; -;;; The title of the icon representing all emacs frames is controlled by -;;; the variable `icon-name'. This is done by temporarily changing the -;;; value of `frame-icon-title-format'. Unfortunately, this changes the -;;; titles of all emacs icons, not just the "big" icon. -;;; -;;; It would be nice if existing icons were removed and restored by -;;; iconifying the emacs process, but I couldn't make that work yet. - -(defvar icon-name nil) ; set this at run time, not load time. - -(defvar iconification-data nil) - -(defun iconify-emacs () - "Replace every non-iconified FRAME with a *single* icon. -Iconified frames are left alone. When XEmacs is in this -globally-iconified state, de-iconifying any emacs icon will uniconify -all frames that were visible, and iconify all frames that were not." - (interactive) - (if iconification-data (error "already iconified?")) - (let* ((frames (frame-list)) - (rest frames) - (me (selected-frame)) - frame) - (while rest - (setq frame (car rest)) - (setcar rest (cons frame (frame-visible-p frame))) -; (if (memq (cdr (car rest)) '(icon nil)) -; (progn -; (make-frame-visible frame) ; deiconify, and process the X event -; (sleep-for 500 t) ; process X events; I really want to XSync() here -; )) - (or (eq frame me) (make-frame-invisible frame)) - (setq rest (cdr rest))) - (or (boundp 'map-frame-hook) (setq map-frame-hook nil)) - (or icon-name - (setq icon-name (concat invocation-name " @ " (system-name)))) - (setq iconification-data - (list frame-icon-title-format map-frame-hook frames) - frame-icon-title-format icon-name - map-frame-hook 'deiconify-emacs) - (iconify-frame me))) - - -(defun deiconify-emacs (&optional ignore) - (or iconification-data (error "not iconified?")) - (setq frame-icon-title-format (car iconification-data) - map-frame-hook (car (cdr iconification-data)) - iconification-data (car (cdr (cdr iconification-data)))) - (while iconification-data - (let ((visibility (cdr (car iconification-data)))) - (cond (visibility ;; JV (Note non-nil means visible in XEmacs) - (make-frame-visible (car (car iconification-data)))) -; (t ;; (eq visibility 'icon) ;; JV Not in XEmacs!!! -; (make-frame-visible (car (car iconification-data))) -; (sleep-for 500 t) ; process X events; I really want to XSync() here -; (iconify-frame (car (car iconification-data)))) - ;; (t nil) - )) - (setq iconification-data (cdr iconification-data)))) - -(defun suspend-or-iconify-emacs () - "Call iconify-emacs if using a window system, otherwise call suspend-emacs." - (interactive) - (cond ((device-on-window-system-p) - (iconify-emacs)) - ((and (eq (device-type) 'tty) - (console-tty-controlling-process (selected-console))) - (suspend-console (selected-console))) - (t - (suspend-emacs)))) - -;; This is quite a mouthful, but it should be descriptive, as it's -;; bound to C-z. FSF takes the easy way out by binding C-z to -;; different things depending on window-system. We can't do the same, -;; because we allow simultaneous X and TTY consoles. -(defun suspend-emacs-or-iconify-frame () - "Iconify the selected frame if using a window system, otherwise suspend Emacs." - (interactive) - (cond ((device-on-window-system-p) - (iconify-frame)) - ((and (eq (frame-type) 'tty) - (console-tty-controlling-process (selected-console))) - (suspend-console (selected-console))) - (t - (suspend-emacs)))) - - -;;; auto-raise and auto-lower - -(defcustom auto-raise-frame nil - "*If true, frames will be raised to the top when selected. -Under X, most ICCCM-compliant window managers will have an option to do this -for you, but this variable is provided in case you're using a broken WM." - :type 'boolean - :group 'frames) - -(defcustom auto-lower-frame nil - "*If true, frames will be lowered to the bottom when no longer selected. -Under X, most ICCCM-compliant window managers will have an option to do this -for you, but this variable is provided in case you're using a broken WM." - :type 'boolean - :group 'frames) - -(defun default-select-frame-hook () - "Implement the `auto-raise-frame' variable. -For use as the value of `select-frame-hook'." - (if auto-raise-frame (raise-frame (selected-frame)))) - -(defun default-deselect-frame-hook () - "Implement the `auto-lower-frame' variable. -For use as the value of `deselect-frame-hook'." - (if auto-lower-frame (lower-frame (selected-frame))) - (highlight-extent nil nil)) - -(or select-frame-hook - (add-hook 'select-frame-hook 'default-select-frame-hook)) - -(or deselect-frame-hook - (add-hook 'deselect-frame-hook 'default-deselect-frame-hook)) - - -;;; Application-specific frame-management - -(defcustom get-frame-for-buffer-default-frame-name nil - "*The default frame to select; see doc of `get-frame-for-buffer'." - :type 'string - :group 'frames) - -(defcustom get-frame-for-buffer-default-instance-limit nil - "*The default instance limit for creating new frames; -see doc of `get-frame-for-buffer'." - :type 'integer - :group 'frames) - -(defun get-frame-name-for-buffer (buffer) - (let ((mode (and (get-buffer buffer) - (save-excursion (set-buffer buffer) - major-mode)))) - (or (get mode 'frame-name) - get-frame-for-buffer-default-frame-name))) - -(defun get-frame-for-buffer-make-new-frame (buffer &optional frame-name plist) - (let* ((fr (make-frame plist)) - (w (frame-root-window fr))) - ;; - ;; Make the one buffer being displayed in this newly created - ;; frame be the buffer of interest, instead of something - ;; random, so that it won't be shown in two-window mode. - ;; Avoid calling switch-to-buffer here, since that's something - ;; people might want to call this routine from. - ;; - ;; (If the root window doesn't have a buffer, then that means - ;; there is more than one window on the frame, which can only - ;; happen if the user has done something funny on the frame- - ;; creation-hook. If that's the case, leave it alone.) - ;; - (if (window-buffer w) - (set-window-buffer w buffer)) - fr)) - -(defcustom get-frame-for-buffer-default-to-current nil - "*When non-nil, `get-frame-for-buffer' will default to the selected frame." - :type 'boolean - :group 'frames) - -(defun get-frame-for-buffer-noselect (buffer - &optional not-this-window-p on-frame) - "Return a frame in which to display BUFFER. -This is a subroutine of `get-frame-for-buffer' (which see)." - (let (name limit) - (cond - ((or on-frame (eq (selected-window) (minibuffer-window))) - ;; don't switch frames if a frame was specified, or to list - ;; completions from the minibuffer, etc. - nil) - - ((setq name (get-frame-name-for-buffer buffer)) - ;; - ;; This buffer's mode expressed a preference for a frame of a particular - ;; name. That always takes priority. - ;; - (let ((limit (get name 'instance-limit)) - (defaults (get name 'frame-defaults)) - (matching-frames '()) - frames frame already-visible) - ;; Sort the list so that iconic frames will be found last. They - ;; will be used too, but mapped frames take precedence. And - ;; fully visible frames come before occluded frames. - ;; Hidden frames come after really visible ones - (setq frames - (sort (frame-list) - #'(lambda (s1 s2) - (cond ((frame-totally-visible-p s2) - nil) - ((not (frame-visible-p s2)) - (frame-visible-p s1)) - ((eq (frame-visible-p s2) 'hidden) - (eq (frame-visible-p s1) t )) - ((not (frame-totally-visible-p s2)) - (and (frame-visible-p s1) - (frame-totally-visible-p s1))))))) - ;; but the selected frame should come first, even if it's occluded, - ;; to minimize thrashing. - (setq frames (cons (selected-frame) - (delq (selected-frame) frames))) - - (setq name (symbol-name name)) - (while frames - (setq frame (car frames)) - (if (equal name (frame-name frame)) - (if (get-buffer-window buffer frame) - (setq already-visible frame - frames nil) - (setq matching-frames (cons frame matching-frames)))) - (setq frames (cdr frames))) - (cond (already-visible - already-visible) - ((or (null matching-frames) - (eq limit 0) ; means create with reckless abandon - (and limit (< (length matching-frames) limit))) - (get-frame-for-buffer-make-new-frame - buffer - name - (alist-to-plist (acons 'name name - (plist-to-alist defaults))))) - (t - ;; do not switch any of the window/buffer associations in an - ;; existing frame; this function only picks a frame; the - ;; determination of which windows on it get reused is up to - ;; display-buffer itself. -;; (or (window-dedicated-p (selected-window)) -;; (switch-to-buffer buffer)) - (car matching-frames))))) - - ((setq limit get-frame-for-buffer-default-instance-limit) - ;; - ;; This buffer's mode did not express a preference for a frame of a - ;; particular name, but the user wants a new frame rather than - ;; reusing the existing one. - (let* ((defname - (or (plist-get default-frame-plist 'name) - default-frame-name)) - (frames - (sort (filtered-frame-list #'(lambda (x) - (or (frame-visible-p x) - (frame-iconified-p x)))) - #'(lambda (s1 s2) - (cond ((and (frame-visible-p s1) - (not (frame-visible-p s2)))) - ((and (eq (frame-visible-p s1) t) - (eq (frame-visible-p s2) 'hidden))) - ((and (frame-visible-p s2) - (not (frame-visible-p s1))) - nil) - ((and (equal (frame-name s1) defname) - (not (equal (frame-name s2) defname)))) - ((and (equal (frame-name s2) defname) - (not (equal (frame-name s1) defname))) - nil) - ((frame-totally-visible-p s2) - nil) - (t)))))) - ;; put the selected frame last. The user wants a new frame, - ;; so don't reuse the existing one unless forced to. - (setq frames (append (delq (selected-frame) frames) (list frames))) - (if (or (eq limit 0) ; means create with reckless abandon - (< (length frames) limit)) - (get-frame-for-buffer-make-new-frame buffer) - (car frames)))) - - (not-this-window-p - (let ((w-list (windows-of-buffer buffer)) - f w - (first-choice nil) - (second-choice (if get-frame-for-buffer-default-to-current - (selected-frame) - nil)) - (last-resort nil)) - (while (and w-list (null first-choice)) - (setq w (car w-list) - f (window-frame w)) - (cond ((eq w (selected-window)) nil) - ((not (frame-visible-p f)) - (if (null last-resort) - (setq last-resort f))) - ((eq f (selected-frame)) - (setq first-choice f)) - ((null second-choice) - (setq second-choice f))) - (setq w-list (cdr w-list))) - (or first-choice second-choice last-resort))) - - (get-frame-for-buffer-default-to-current (selected-frame)) - - (t - ;; - ;; This buffer's mode did not express a preference for a frame of a - ;; particular name. So try to find a frame already displaying this - ;; buffer. - ;; - (let ((w (or (get-buffer-window buffer nil) ; check current first - (get-buffer-window buffer 'visible) ; then visible - (get-buffer-window buffer 0)))) ; then iconic - (cond ((null w) - ;; It's not in any window - return nil, meaning no frame has - ;; preference. - nil) - (t - ;; Otherwise, return the frame of the buffer's window. - (window-frame w)))))))) - - -;; The pre-display-buffer-function is called for effect, so this needs to -;; actually select the frame it wants. Fdisplay_buffer() takes notice of -;; changes to the selected frame. -(defun get-frame-for-buffer (buffer &optional not-this-window-p on-frame) - "Select and return a frame in which to display BUFFER. -Normally, the buffer will simply be displayed in the selected frame. -But if the symbol naming the major-mode of the buffer has a 'frame-name -property (which should be a symbol), then the buffer will be displayed in -a frame of that name. If there is no frame of that name, then one is -created. - -If the major-mode doesn't have a 'frame-name property, then the frame -named by `get-frame-for-buffer-default-frame-name' will be used. If -that is nil (the default) then the currently selected frame will used. - -If the frame-name symbol has an 'instance-limit property (an integer) -then each time a buffer of the mode in question is displayed, a new frame -with that name will be created, until there are `instance-limit' of them. -If instance-limit is 0, then a new frame will be created each time. - -If a buffer is already displayed in a frame, then `instance-limit' is -ignored, and that frame is used. - -If the frame-name symbol has a 'frame-defaults property, then that is -prepended to the `default-frame-plist' when creating a frame for the -first time. - -This function may be used as the value of `pre-display-buffer-function', -to cause the display-buffer function and its callers to exhibit the above -behavior." - (let ((frame (get-frame-for-buffer-noselect - buffer not-this-window-p on-frame))) - (if (not (eq frame (selected-frame))) - frame - (select-frame frame) - (or (frame-visible-p frame) - ;; If the frame was already visible, just focus on it. - ;; If it wasn't visible (it was just created, or it used - ;; to be iconified) then uniconify, raise, etc. - (make-frame-visible frame)) - frame))) - -(defun frames-of-buffer (&optional buffer visible-only) - "Return list of frames that BUFFER is currently being displayed on. -If the buffer is being displayed on the currently selected frame, that frame -is first in the list. VISIBLE-ONLY will only list non-iconified frames." - (let ((list (windows-of-buffer buffer)) - (cur-frame (selected-frame)) - next-frame frames save-frame) - - (while list - (if (memq (setq next-frame (window-frame (car list))) - frames) - nil - (if (eq cur-frame next-frame) - (setq save-frame next-frame) - (and - (or (not visible-only) - (frame-visible-p next-frame)) - (setq frames (append frames (list next-frame)))))) - (setq list (cdr list))) - - (if save-frame - (append (list save-frame) frames) - frames))) - -(defcustom temp-buffer-shrink-to-fit nil - "*When non-nil resize temporary output buffers to minimize blank lines." - :type 'boolean - :group 'frames) - -(defcustom temp-buffer-max-height .5 - "*Proportion of frame to use for temp windows." - :type 'number - :group 'frames) - -(defun show-temp-buffer-in-current-frame (buffer) - "For use as the value of temp-buffer-show-function: -always displays the buffer in the selected frame, regardless of the behavior -that would otherwise be introduced by the `pre-display-buffer-function', which -is normally set to `get-frame-for-buffer' (which see)." - (let ((pre-display-buffer-function nil)) ; turn it off, whatever it is - (let ((window (display-buffer buffer))) - (if (not (eq (last-nonminibuf-frame) (window-frame window))) - ;; only the pre-display-buffer-function should ever do this. - (error "display-buffer switched frames on its own!!")) - (setq minibuffer-scroll-window window) - (set-window-start window 1) ; obeys narrowing - (set-window-point window 1) - (when temp-buffer-shrink-to-fit - (let* ((temp-window-size (round (* temp-buffer-max-height - (frame-height (window-frame window))))) - (size (window-displayed-height window))) - (when (< size temp-window-size) - (enlarge-window (- temp-window-size size) nil window))) - (shrink-window-if-larger-than-buffer window)) - nil))) - -(setq pre-display-buffer-function 'get-frame-for-buffer) -(setq temp-buffer-show-function 'show-temp-buffer-in-current-frame) - - -;; from Bob Weiner , modified by Ben Wing -(defun delete-other-frames (&optional frame) - "Delete all but FRAME (or the selected frame)." - (interactive) - (mapc 'delete-frame (delq (or frame (selected-frame)) (frame-list)))) - -;; By adding primitives to directly access the window hierarchy, -;; we can move many functions into Lisp. We do it this way -;; because the implementations are simpler in Lisp, and because -;; new functions like this can be added without requiring C -;; additions. - -(defun frame-utmost-window-2 (window position left-right-p major-end-p - minor-end-p) - ;; LEFT-RIGHT-P means we're looking for the leftmost or rightmost - ;; window, instead of the highest or lowest. In this case, we - ;; say that the "major axis" goes left-to-right instead of top-to- - ;; bottom. The "minor axis" always goes perpendicularly. - ;; - ;; If MAJOR-END-P is t, we're looking for a windows that abut the - ;; end (i.e. right or bottom) of the major axis, instead of the - ;; start. - ;; - ;; If MINOR-END-P is t, then we want to start counting from the - ;; end of the minor axis instead of the beginning. - ;; - ;; Here's the general idea: Imagine we're trying to count the number - ;; of windows that abut the top; call this function foo(). So, we - ;; start with the root window. If this is a vertical combination - ;; window, then foo() applied to the root window is the same as - ;; foo() applied to the first child. If the root is a horizontal - ;; combination window, then foo() applied to the root is the - ;; same as the sum of foo() applied to each of the children. - ;; Otherwise, the root window is a leaf window, and foo() is 1. - ;; Now it's clear that, each time foo() encounters a leaf window, - ;; it's encountering a different window that abuts the top. - ;; With a little examining, you can see that foo encounters the - ;; top-abutting windows in order from left to right. We can - ;; modify foo() to return the nth top-abutting window by simply - ;; keeping a global variable that is decremented each time - ;; foo() encounters a leaf window and would return 1. If the - ;; global counter gets to zero, we've encountered the window - ;; we were looking for, so we exit right away using a `throw'. - ;; Otherwise, we make sure that all normal paths return nil. - - (let (child) - (cond ((setq child (if left-right-p - (window-first-hchild window) - (window-first-vchild window))) - (if major-end-p - (while (window-next-child child) - (setq child (window-next-child child)))) - (frame-utmost-window-2 child position left-right-p major-end-p - minor-end-p)) - ((setq child (if left-right-p - (window-first-vchild window) - (window-first-hchild window))) - (if minor-end-p - (while (window-next-child child) - (setq child (window-next-child child)))) - (while child - (frame-utmost-window-2 child position left-right-p major-end-p - minor-end-p) - (setq child (if minor-end-p - (window-previous-child child) - (window-next-child child)))) - nil) - (t - (setcar position (1- (car position))) - (if (= (car position) 0) - (throw 'fhw-exit window) - nil))))) - -(defun frame-utmost-window-1 (frame position left-right-p major-end-p) - (let (minor-end-p) - (or frame (setq frame (selected-frame))) - (or position (setq position 0)) - (if (>= position 0) - (setq position (1+ position)) - (setq minor-end-p t) - (setq position (- position))) - (catch 'fhw-exit - ;; we use a cons here as a simple form of call-by-reference. - ;; scheme has "boxes" for the same purpose. - (frame-utmost-window-2 (frame-root-window frame) (list position) - left-right-p major-end-p minor-end-p)))) - - -(defun frame-highest-window (&optional frame position) - "Return the highest window on FRAME which is at POSITION. -If omitted, FRAME defaults to the currently selected frame. -POSITION is used to distinguish between multiple windows that abut - the top of the frame: 0 means the leftmost window abutting the - top of the frame, 1 the next-leftmost, etc. POSITION can also - be less than zero: -1 means the rightmost window abutting the - top of the frame, -2 the next-rightmost, etc. -If omitted, POSITION defaults to 0, i.e. the leftmost highest window. -If there is no window at the given POSITION, return nil." - (frame-utmost-window-1 frame position nil nil)) - -(defun frame-lowest-window (&optional frame position) - "Return the lowest window on FRAME which is at POSITION. -If omitted, FRAME defaults to the currently selected frame. -POSITION is used to distinguish between multiple windows that abut - the bottom of the frame: 0 means the leftmost window abutting the - bottom of the frame, 1 the next-leftmost, etc. POSITION can also - be less than zero: -1 means the rightmost window abutting the - bottom of the frame, -2 the next-rightmost, etc. -If omitted, POSITION defaults to 0, i.e. the leftmost lowest window. -If there is no window at the given POSITION, return nil." - (frame-utmost-window-1 frame position nil t)) - -(defun frame-leftmost-window (&optional frame position) - "Return the leftmost window on FRAME which is at POSITION. -If omitted, FRAME defaults to the currently selected frame. -POSITION is used to distinguish between multiple windows that abut - the left edge of the frame: 0 means the highest window abutting the - left edge of the frame, 1 the next-highest, etc. POSITION can also - be less than zero: -1 means the lowest window abutting the - left edge of the frame, -2 the next-lowest, etc. -If omitted, POSITION defaults to 0, i.e. the highest leftmost window. -If there is no window at the given POSITION, return nil." - (frame-utmost-window-1 frame position t nil)) - -(defun frame-rightmost-window (&optional frame position) - "Return the rightmost window on FRAME which is at POSITION. -If omitted, FRAME defaults to the currently selected frame. -POSITION is used to distinguish between multiple windows that abut - the right edge of the frame: 0 means the highest window abutting the - right edge of the frame, 1 the next-highest, etc. POSITION can also - be less than zero: -1 means the lowest window abutting the - right edge of the frame, -2 the next-lowest, etc. -If omitted, POSITION defaults to 0, i.e. the highest rightmost window. -If there is no window at the given POSITION, return nil." - (frame-utmost-window-1 frame position t t)) - - - -;; frame properties. - -(defun set-frame-property (frame prop val) - "Set property PROP of FRAME to VAL. See `set-frame-properties'." - (set-frame-properties frame (list prop val))) - -(defun frame-height (&optional frame) - "Return number of lines available for display on FRAME." - (frame-property frame 'height)) - -(defun frame-width (&optional frame) - "Return number of columns available for display on FRAME." - (frame-property frame 'width)) - -(put 'cursor-color 'frame-property-alias [text-cursor background]) -(put 'modeline 'frame-property-alias 'has-modeline-p) - - -(provide 'frame) - -;;; frame.el ends here diff --git a/lisp/glyphs.el b/lisp/glyphs.el deleted file mode 100644 index 08a791a..0000000 --- a/lisp/glyphs.el +++ /dev/null @@ -1,699 +0,0 @@ -;;; glyphs.el --- Lisp interface to C glyphs - -;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Chuck Thompson , Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers - -(defun make-image-specifier (spec-list) - "Return a new `image' specifier object with the specification list SPEC-LIST. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for more information about -specifiers." - (make-specifier-and-init 'image spec-list)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; glyphs - -(defconst built-in-glyph-specifiers - '(image contrib-p baseline) - "A list of the built-in face properties that are specifiers.") - -(defun glyph-property (glyph property &optional locale) - "Return GLYPH's value of PROPERTY in LOCALE. - -If LOCALE is omitted, the GLYPH's actual value for PROPERTY will be - returned. For built-in properties, this will be a specifier object - of a type appropriate to the property (e.g. a font or color - specifier). For other properties, this could be anything. - -If LOCALE is supplied, then instead of returning the actual value, - the specification(s) for the given locale or locale type will - be returned. This will only work if the actual value of - PROPERTY is a specifier (this will always be the case for built-in - properties, but not or not may apply to user-defined properties). - If the actual value of PROPERTY is not a specifier, this value - will simply be returned regardless of LOCALE. - -The return value will be a list of instantiators (e.g. strings - specifying a font or color name), or a list of specifications, each - of which is a cons of a locale and a list of instantiators. - Specifically, if LOCALE is a particular locale (a buffer, window, - frame, device, or 'global), a list of instantiators for that locale - will be returned. Otherwise, if LOCALE is a locale type (one of - the symbols 'buffer, 'window, 'frame, 'device, 'device-class, or - 'device-type), the specifications for all locales of that type will - be returned. Finally, if LOCALE is 'all, the specifications for all - locales of all types will be returned. - -The specifications in a specifier determine what the value of - PROPERTY will be in a particular \"domain\" or set of circumstances, - which is typically a particular Emacs window along with the buffer - it contains and the frame and device it lies within. The value - is derived from the instantiator associated with the most specific - locale (in the order buffer, window, frame, device, and 'global) - that matches the domain in question. In other words, given a domain - (i.e. an Emacs window, usually), the specifier for PROPERTY will first - be searched for a specification whose locale is the buffer contained - within that window; then for a specification whose locale is the window - itself; then for a specification whose locale is the frame that the - window is contained within; etc. The first instantiator that is - valid for the domain (usually this means that the instantiator is - recognized by the device [i.e. the X server or TTY device] that the - domain is on. The function `glyph-property-instance' actually does - all this, and is used to determine how to display the glyph. - -See `set-glyph-property' for the built-in property-names." - (check-argument-type 'glyphp glyph) - (let ((value (get glyph property))) - (if (and locale - (or (memq property built-in-glyph-specifiers) - (specifierp value))) - (setq value (specifier-specs value locale))) - value)) - -(defun convert-glyph-property-into-specifier (glyph property) - "Convert PROPERTY on GLYPH into a specifier, if it's not already." - (check-argument-type 'glyphp glyph) - (let ((specifier (get glyph property))) - ;; if a user-property does not have a specifier but a - ;; locale was specified, put a specifier there. - ;; If there was already a value there, convert it to a - ;; specifier with the value as its 'global instantiator. - (if (not (specifierp specifier)) - (let ((new-specifier (make-specifier 'generic))) - (if (or (not (null specifier)) - ;; make sure the nil returned from `get' wasn't - ;; actually the value of the property - (null (get glyph property t))) - (add-spec-to-specifier new-specifier specifier)) - (setq specifier new-specifier) - (put glyph property specifier))))) - -(defun glyph-property-instance (glyph property - &optional domain default no-fallback) - "Return the instance of GLYPH's PROPERTY in the specified DOMAIN. - -Under most circumstances, DOMAIN will be a particular window, - and the returned instance describes how the specified property - actually is displayed for that window and the particular buffer - in it. Note that this may not be the same as how the property - appears when the buffer is displayed in a different window or - frame, or how the property appears in the same window if you - switch to another buffer in that window; and in those cases, - the returned instance would be different. - -DOMAIN defaults to the selected window if omitted. - -DOMAIN can be a frame or device, instead of a window. The value - returned for a such a domain is used in special circumstances - when a more specific domain does not apply; for example, a frame - value might be used for coloring a toolbar, which is conceptually - attached to a frame rather than a particular window. The value - is also useful in determining what the value would be for a - particular window within the frame or device, if it is not - overridden by a more specific specification. - -If PROPERTY does not name a built-in property, its value will - simply be returned unless it is a specifier object, in which case - it will be instanced using `specifier-instance'. - -Optional arguments DEFAULT and NO-FALLBACK are the same as in - `specifier-instance'." - (check-argument-type 'glyphp glyph) - (let ((value (get glyph property))) - (if (specifierp value) - (setq value (specifier-instance value domain default no-fallback))) - value)) - -(defun set-glyph-property (glyph property value &optional locale tag-set - how-to-add) - "Change a property of a GLYPH. - -NOTE: If you want to remove a property from a glyph, use - `remove-glyph-property' rather than attempting to set a value of nil - for the property. - -For built-in properties, the actual value of the property is a - specifier and you cannot change this; but you can change the - specifications within the specifier, and that is what this function - will do. For user-defined properties, you can use this function - to either change the actual value of the property or, if this value - is a specifier, change the specifications within it. - -If PROPERTY is a built-in property, the specifications to be added to - this property can be supplied in many different ways: - - -- If VALUE is a simple instantiator (e.g. a string naming a font or - color) or a list of instantiators, then the instantiator(s) will - be added as a specification of the property for the given LOCALE - (which defaults to 'global if omitted). - -- If VALUE is a list of specifications (each of which is a cons of - a locale and a list of instantiators), then LOCALE must be nil - (it does not make sense to explicitly specify a locale in this - case), and specifications will be added as given. - -- If VALUE is a specifier (as would be returned by `glyph-property' - if no LOCALE argument is given), then some or all of the - specifications in the specifier will be added to the property. - In this case, the function is really equivalent to - `copy-specifier' and LOCALE has the same semantics (if it is - a particular locale, the specification for the locale will be - copied; if a locale type, specifications for all locales of - that type will be copied; if nil or 'all, then all - specifications will be copied). - -HOW-TO-ADD should be either nil or one of the symbols 'prepend, - 'append, 'remove-tag-set-prepend, 'remove-tag-set-append, 'remove-locale, - 'remove-locale-type, or 'remove-all. See `copy-specifier' and - `add-spec-to-specifier' for a description of what each of - these means. Most of the time, you do not need to worry about - this argument; the default behavior usually is fine. - -In general, it is OK to pass an instance object (e.g. as returned - by `glyph-property-instance') as an instantiator in place of - an actual instantiator. In such a case, the instantiator used - to create that instance object will be used (for example, if - you set a font-instance object as the value of the 'font - property, then the font name used to create that object will - be used instead). If some cases, however, doing this - conversion does not make sense, and this will be noted in - the documentation for particular types of instance objects. - -If PROPERTY is not a built-in property, then this function will - simply set its value if LOCALE is nil. However, if LOCALE is - given, then this function will attempt to add VALUE as the - instantiator for the given LOCALE, using `add-spec-to-specifier'. - If the value of the property is not a specifier, it will - automatically be converted into a 'generic specifier. - - -The following symbols have predefined meanings: - - image The image used to display the glyph. - - baseline Percent above baseline that glyph is to be - displayed. - - contrib-p Whether the glyph contributes to the - height of the line it's on. - - face Face of this glyph (*not* a specifier)." - (check-argument-type 'glyphp glyph) - (if (memq property built-in-glyph-specifiers) - (set-specifier (get glyph property) value locale tag-set how-to-add) - - ;; This section adds user defined properties. - (if (not locale) - (put glyph property value) - (convert-glyph-property-into-specifier glyph property) - (add-spec-to-specifier (get glyph property) value locale tag-set - how-to-add))) - value) - -(defun remove-glyph-property (glyph property &optional locale tag-set exact-p) - "Remove a property from a glyph. -For built-in properties, this is analogous to `remove-specifier'. -See `remove-specifier' for the meaning of the LOCALE, TAG-SET, and EXACT-P - arguments." - (or locale (setq locale 'all)) - (if (memq property built-in-glyph-specifiers) - (remove-specifier (glyph-property glyph property) locale tag-set exact-p) - (if (eq locale 'all) - (remprop glyph property) - (convert-glyph-property-into-specifier glyph property) - (remove-specifier (glyph-property glyph property) locale tag-set - exact-p)))) - -(defun glyph-face (glyph) - "Return the face of GLYPH." - (glyph-property glyph 'face)) - -(defun set-glyph-face (glyph face) - "Change the face of GLYPH to FACE." -; (interactive (glyph-interactive "face")) - (set-glyph-property glyph 'face face)) - -(defun glyph-image (glyph &optional locale) - "Return the image of GLYPH in LOCALE, or nil if it is unspecified. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `glyph-property' for more information." - (glyph-property glyph 'image locale)) - -(defun glyph-image-instance (glyph &optional domain default no-fallback) - "Return the instance of GLYPH's image in DOMAIN. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing how the image appears in that - particular window and buffer will be returned. - -See `glyph-property-instance' for more information." - (glyph-property-instance glyph 'image domain default no-fallback)) - -(defun set-glyph-image (glyph spec &optional locale tag-set how-to-add) - "Change the image of GLYPH in LOCALE. - -SPEC should be an instantiator (a string or vector; see - `image-specifier-p' for a description of possible values here), - a list of (possibly tagged) instantiators, an alist of specifications - (each mapping a locale to an instantiator list), or an image specifier - object. - -If SPEC is an alist, LOCALE must be omitted. If SPEC is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-glyph-property' for more information." - ; (interactive (glyph-interactive "image")) - (set-glyph-property glyph 'image spec locale tag-set how-to-add)) - -(defun glyph-contrib-p (glyph &optional locale) - "Return whether GLYPH contributes to its line height. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `glyph-property' for more information." - (glyph-property glyph 'contrib-p locale)) - -(defun glyph-contrib-p-instance (glyph &optional domain default no-fallback) - "Return the instance of GLYPH's 'contrib-p property in DOMAIN. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an instance object describing what the 'contrib-p property is in - that particular window and buffer will be returned. - -See `glyph-property-instance' for more information." - (glyph-property-instance glyph 'contrib-p domain default no-fallback)) - -(defun set-glyph-contrib-p (glyph spec &optional locale tag-set how-to-add) - "Change the contrib-p property of GLYPH in LOCALE. - -SPEC should be an instantiator (t or nil), a list of (possibly - tagged) instantiators, an alist of specifications (each mapping a - locale to an instantiator list), or a boolean specifier object. - -If SPEC is an alist, LOCALE must be omitted. If SPEC is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-glyph-property' for more information." - ; (interactive (glyph-interactive "contrib-p")) - (set-glyph-property glyph 'contrib-p spec locale tag-set how-to-add)) - -(defun glyph-baseline (glyph &optional locale) - "Return the baseline of GLYPH in LOCALE, or nil if it is unspecified. - -LOCALE may be a locale (the instantiators for that particular locale - will be returned), a locale type (the specifications for all locales - of that type will be returned), 'all (all specifications will be - returned), or nil (the actual specifier object will be returned). - -See `glyph-property' for more information." - (glyph-property glyph 'baseline locale)) - -(defun glyph-baseline-instance (glyph &optional domain default no-fallback) - "Return the instance of GLYPH's baseline in DOMAIN. - -Normally DOMAIN will be a window or nil (meaning the selected window), - and an integer or nil (specifying the baseline in that particular - window and buffer) will be returned. - -See `glyph-property-instance' for more information." - (glyph-property-instance glyph 'baseline domain default no-fallback)) - -(defun set-glyph-baseline (glyph spec &optional locale tag-set how-to-add) - "Change the baseline of GLYPH to SPEC in LOCALE. - -SPEC should be an instantiator (an integer [a percentage above the - baseline of the line the glyph is on] or nil), a list of (possibly - tagged) instantiators, an alist of specifications (each mapping a - locale to an instantiator list), or a generic specifier object. - -If SPEC is an alist, LOCALE must be omitted. If SPEC is a - specifier object, LOCALE can be a locale, a locale type, 'all, - or nil; see `copy-specifier' for its semantics. Otherwise LOCALE - specifies the locale under which the specified instantiator(s) - will be added, and defaults to 'global. - -See `set-glyph-property' for more information." - ; (interactive (glyph-interactive "baseline")) - (set-glyph-property glyph 'baseline spec locale tag-set how-to-add)) - -(defun make-glyph (&optional spec-list type) - "Return a new `glyph' object of type TYPE. - -TYPE should be one of `buffer' (used for glyphs in an extent, the modeline, -the toolbar, or elsewhere in a buffer), `pointer' (used for the mouse-pointer), -or `icon' (used for a frame's icon), and defaults to `buffer'. - -SPEC-LIST is used to initialize the glyph's image. It is typically an -image instantiator (a string or a vector; see `image-specifier-p' for -a detailed description of the valid image instantiators), but can also -be a list of such instantiators (each one in turn is tried until an -image is successfully produced), a cons of a locale (frame, buffer, etc.) -and an instantiator, a list of such conses, or any other form accepted -by `canonicalize-spec-list'. See `make-specifier' for more information -about specifiers." - (let ((glyph (make-glyph-internal type))) - (and spec-list (set-glyph-image glyph spec-list)) - glyph)) - -(defun buffer-glyph-p (object) - "Return t if OBJECT is a glyph of type `buffer'." - (and (glyphp object) (eq 'buffer (glyph-type object)))) - -(defun pointer-glyph-p (object) - "Return t if OBJECT is a glyph of type `pointer'." - (and (glyphp object) (eq 'pointer (glyph-type object)))) - -(defun icon-glyph-p (object) - "Return t if OBJECT is a glyph of type `icon'." - (and (glyphp object) (eq 'icon (glyph-type object)))) - -(defun make-pointer-glyph (&optional spec-list) - "Return a new `pointer-glyph' object with the specification list SPEC-LIST. - -This is equivalent to calling `make-glyph', specifying a type of `pointer'. - -SPEC-LIST is used to initialize the glyph's image. It is typically an -image instantiator (a string or a vector; see `image-specifier-p' for -a detailed description of the valid image instantiators), but can also -be a list of such instantiators (each one in turn is tried until an -image is successfully produced), a cons of a locale (frame, buffer, etc.) -and an instantiator, a list of such conses, or any other form accepted -by `canonicalize-spec-list'. See `make-specifier' for more information -about specifiers. - -You can also create a glyph with an empty SPEC-LIST and add image -instantiators afterwards using `set-glyph-image'." - (make-glyph spec-list 'pointer)) - -(defun make-icon-glyph (&optional spec-list) - "Return a new `icon-glyph' object with the specification list SPEC-LIST. - -This is equivalent to calling `make-glyph', specifying a type of `icon'. - -SPEC-LIST is used to initialize the glyph's image. It is typically an -image instantiator (a string or a vector; see `image-specifier-p' for -a detailed description of the valid image instantiators), but can also -be a list of such instantiators (each one in turn is tried until an -image is successfully produced), a cons of a locale (frame, buffer, etc.) -and an instantiator, a list of such conses, or any other form accepted -by `canonicalize-spec-list'. See `make-specifier' for more information -about specifiers. - -You can also create a glyph with an empty SPEC-LIST and add image -instantiators afterwards using `set-glyph-image'." - (make-glyph spec-list 'icon)) - -(defun nothing-image-instance-p (object) - "Return t if OBJECT is an image instance of type `nothing'." - (and (image-instance-p object) (eq 'nothing (image-instance-type object)))) - -(defun text-image-instance-p (object) - "Return t if OBJECT is an image instance of type `text'." - (and (image-instance-p object) (eq 'text (image-instance-type object)))) - -(defun mono-pixmap-image-instance-p (object) - "Return t if OBJECT is an image instance of type `mono-pixmap'." - (and (image-instance-p object) (eq 'mono-pixmap - (image-instance-type object)))) - -(defun color-pixmap-image-instance-p (object) - "Return t if OBJECT is an image instance of type `color-pixmap'." - (and (image-instance-p object) (eq 'color-pixmap - (image-instance-type object)))) - -(defun pointer-image-instance-p (object) - "Return t if OBJECT is an image instance of type `pointer'." - (and (image-instance-p object) (eq 'pointer (image-instance-type object)))) - -(defun subwindow-image-instance-p (object) - "Return t if OBJECT is an image instance of type `subwindow'. -Subwindows are not implemented in this version of XEmacs." - (and (image-instance-p object) (eq 'subwindow (image-instance-type object)))) - -;;;;;;;;;; the built-in glyphs - -(defvar text-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over text. -This is a glyph; use `set-glyph-image' to change it.") -(set-glyph-face text-pointer-glyph 'pointer) - -(defvar nontext-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over a buffer, but not over text. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, `text-pointer-glyph' is used.") -(set-glyph-face nontext-pointer-glyph 'pointer) - -(defvar modeline-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over the modeline. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, `nontext-pointer-glyph' is used.") -(set-glyph-face modeline-pointer-glyph 'pointer) - -(defvar selection-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over a selectable text region. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, `text-pointer-glyph' is used.") -(set-glyph-face selection-pointer-glyph 'pointer) - -(defvar busy-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when XEmacs is busy. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, the pointer is not changed -when XEmacs is busy.") -(set-glyph-face busy-pointer-glyph 'pointer) - -(defvar toolbar-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over a toolbar. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, `nontext-pointer-glyph' is used.") -(set-glyph-face toolbar-pointer-glyph 'pointer) - -(defvar divider-pointer-glyph (make-pointer-glyph) - "*The shape of the mouse-pointer when over a window divider. -This is a glyph; use `set-glyph-image' to change it. -If unspecified in a particular domain, `nontext-pointer-glyph' is used.") -(set-glyph-face divider-pointer-glyph 'pointer) - -;; The following three are in C. -(if (featurep 'menubar) - (set-glyph-face menubar-pointer-glyph 'pointer)) -(if (featurep 'scrollbar) - (set-glyph-face scrollbar-pointer-glyph 'pointer)) -(set-glyph-face gc-pointer-glyph 'pointer) - -;; Now add the magic access/set behavior. - -(defun dontusethis-set-value-glyph-handler (sym args fun harg handler) - (error "Use `set-glyph-image' to set `%s'" sym)) -(defun dontusethis-make-unbound-glyph-handler (sym args fun harg handler) - (error "Can't `makunbound' `%s'" sym)) -(defun dontusethis-make-local-glyph-handler (sym args fun harg handler) - (error "Use `set-glyph-image' to make local values for `%s'" sym)) - -(defun define-constant-glyph (sym) - (dontusethis-set-symbol-value-handler - sym 'set-value - 'dontusethis-set-value-glyph-handler) - (dontusethis-set-symbol-value-handler - sym 'make-unbound - 'dontusethis-make-unbound-glyph-handler) - (dontusethis-set-symbol-value-handler - sym 'make-local - 'dontusethis-make-local-glyph-handler) - ;; Make frame properties magically work with glyph variables. - (put sym 'const-glyph-variable t)) - -(define-constant-glyph 'text-pointer-glyph) -(define-constant-glyph 'nontext-pointer-glyph) -(define-constant-glyph 'modeline-pointer-glyph) -(define-constant-glyph 'selection-pointer-glyph) -(define-constant-glyph 'busy-pointer-glyph) -(define-constant-glyph 'gc-pointer-glyph) -(define-constant-glyph 'divider-pointer-glyph) -(define-constant-glyph 'toolbar-pointer-glyph) -(define-constant-glyph 'menubar-pointer-glyph) -(define-constant-glyph 'scrollbar-pointer-glyph) - -(define-constant-glyph 'octal-escape-glyph) -(define-constant-glyph 'control-arrow-glyph) -(define-constant-glyph 'invisible-text-glyph) -(define-constant-glyph 'hscroll-glyph) -(define-constant-glyph 'truncation-glyph) -(define-constant-glyph 'continuation-glyph) - -(define-constant-glyph 'frame-icon-glyph) - -;; backwards compatibility garbage - -(defun dontusethis-old-pointer-shape-handler (sym args fun harg handler) - (let ((value (car args))) - (if (null value) - (remove-specifier harg 'global) - (set-glyph-image (symbol-value harg) value)))) - -;; It might or might not be garbage, but it's rude. Make these -;; 'compatible instead of 'obsolete. -slb -(defun define-obsolete-pointer-glyph (old new) - (define-compatible-variable-alias old new) - (dontusethis-set-symbol-value-handler - old 'set-value 'dontusethis-old-pointer-shape-handler new)) - -;;; (defvar x-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-pointer-shape 'text-pointer-glyph) - -;;; (defvar x-nontext-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-nontext-pointer-shape 'nontext-pointer-glyph) - -;;; (defvar x-mode-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-mode-pointer-shape 'modeline-pointer-glyph) - -;;; (defvar x-selection-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-selection-pointer-shape - 'selection-pointer-glyph) - -;;; (defvar x-busy-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-busy-pointer-shape 'busy-pointer-glyph) - -;;; (defvar x-gc-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-gc-pointer-shape 'gc-pointer-glyph) - -;;; (defvar x-toolbar-pointer-shape nil) -(define-obsolete-pointer-glyph 'x-toolbar-pointer-shape 'toolbar-pointer-glyph) - -;; for subwindows -(defalias 'subwindow-xid 'image-instance-subwindow-id) -(defalias 'subwindow-width 'image-instance-width) -(defalias 'subwindow-height 'image-instance-height) -;;;;;;;;;; initialization - -(defun init-glyphs () - ;; initialize default image types - (if (featurep 'x) - (set-console-type-image-conversion-list 'x - `(,@(if (featurep 'xpm) '(("\\.xpm\\'" [xpm :file nil] 2))) - ("\\.xbm\\'" [xbm :file nil] 2) - ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2))) - ,@(if (featurep 'xface) '(("\\`X-Face:" [xface :data nil] 2))) - ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2) - ("\\`GIF8[79]" [gif :data nil] 2))) - ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2))) - ;; all of the JFIF-format JPEG's that I've seen begin with - ;; the following. I have no idea if this is standard. - ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF" - [jpeg :data nil] 2))) - ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) - ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) - ("" [autodetect :data nil] 2)))) - ;; #### this should really be formatted-string, not string but we - ;; don't have it implemented yet - ;; - ;; #define could also mean a bitmap as well as a version 1 XPM. Who - ;; cares. We don't want the file contents getting converted to a - ;; string in either case which is why the entry is there. - (if (featurep 'tty) - (progn - (set-console-type-image-conversion-list - 'tty - '(("^#define" [string :data "[xpm]"]) - ("\\`X-Face:" [string :data "[xface]"]) - ("\\`/\\* XPM \\*/" [string :data "[xpm]"]) - ("\\`GIF87" [string :data "[gif]"]) - ("\\`\377\330\340\000\020JFIF" [string :data "[jpeg]"]) - ("" [string :data nil] 2) - ;; this last one is here for pointers and icons and such -- - ;; strings are not allowed so they will be ignored. - ("" [nothing]))) - - ;; finish initializing truncation glyph -- created internally - ;; because it has a built-in bitmap - (set-glyph-image truncation-glyph "$" 'global 'tty) - - ;; finish initializing continuation glyph -- created internally - ;; because it has a built-in bitmap - (set-glyph-image continuation-glyph "\\" 'global 'tty) - - ;; finish initializing hscroll glyph -- created internally - ;; because it has a built-in bitmap - (set-glyph-image hscroll-glyph "$" 'global 'tty))) - - (set-glyph-image octal-escape-glyph "\\") - (set-glyph-image control-arrow-glyph "^") - (set-glyph-image invisible-text-glyph " ...") - ;; (set-glyph-image hscroll-glyph "$") - - (let ((face (make-face 'border-glyph - "Truncation and continuation glyphs face"))) - (set-glyph-face continuation-glyph face) - (set-glyph-face truncation-glyph face) - (set-glyph-face hscroll-glyph face)) - - ;; finish initializing xemacs logo -- created internally because it - ;; has a built-in bitmap - (if (featurep 'xpm) - (set-glyph-image xemacs-logo - (concat "../etc/" - (if emacs-beta-version - "xemacs-beta.xpm" - "xemacs.xpm")) - 'global 'x)) - (cond ((featurep 'xpm) - (set-glyph-image frame-icon-glyph - (concat "../etc/" "xemacs-icon.xpm") - 'global 'x)) - ((featurep 'x) - (set-glyph-image frame-icon-glyph - (concat "../etc/" "xemacs-icon2.xbm") - 'global 'x))) - - (if (featurep 'tty) - (set-glyph-image xemacs-logo - "XEmacs " - 'global 'tty)) -) - -(init-glyphs) - -;;; glyphs.el ends here. diff --git a/lisp/gnuserv.el b/lisp/gnuserv.el deleted file mode 100644 index b670e8d..0000000 --- a/lisp/gnuserv.el +++ /dev/null @@ -1,784 +0,0 @@ -;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv -;; Copyright (C) 1989-1997 Free Software Foundation, Inc. - -;; Version: 3.11 -;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el -;; Hrvoje Niksic -;; Maintainer: Jan Vroonhof , -;; Hrvoje Niksic -;; Keywords: environment, processes, terminals - -;; 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: - -;; Gnuserv is run when Emacs needs to operate as a server for other -;; processes. Specifically, any number of files can be attached for -;; editing to a running XEmacs process using the `gnuclient' program. - -;; Use `M-x gnuserv-start' to start the server and `gnuclient files' -;; to load them to XEmacs. When you are done with a buffer, press -;; `C-x #' (`M-x gnuserv-edit'). You can put (gnuserv-start) to your -;; .emacs, and enable `gnuclient' as your Unix "editor". When all the -;; buffers for a client have been edited and exited with -;; `gnuserv-edit', the client "editor" will return to the program that -;; invoked it. - -;; Your editing commands and Emacs' display output go to and from the -;; terminal or X display in the usual way. If you are running under -;; X, a new X frame will be open for each gnuclient. If you are on a -;; TTY, this TTY will be attached as a new device to the running -;; XEmacs, and will be removed once you are done with the buffer. - -;; To evaluate a Lisp form in a running Emacs, use the `-eval' -;; argument of gnuclient. To simplify this, we provide the `gnudoit' -;; shell script. For example `gnudoit "(+ 2 3)"' will print `5', -;; whereas `gnudoit "(gnus)"' will fire up your favorite newsreader. -;; Like gnuclient, `gnudoit' requires the server to be started prior -;; to using it. - -;; For more information you can refer to man pages of gnuclient, -;; gnudoit and gnuserv, distributed with XEmacs. - -;; gnuserv.el was originally written by Andy Norman as an improvement -;; over William Sommerfeld's server.el. Since then, a number of -;; people have worked on it, including Bob Weiner, Darell Kindred, -;; Arup Mukherjee, Ben Wing and Jan Vroonhof. It was completely -;; rewritten (labeled as version 3) by Hrvoje Niksic in May 1997. The -;; new code will not run on GNU Emacs. - -;; Jan Vroonhof July/1996 -;; ported the server-temp-file-regexp feature from server.el -;; ported server hooks from server.el -;; ported kill-*-query functions from server.el (and made it optional) -;; synced other behavior with server.el -;; -;; Jan Vroonhof -;; Customized. -;; -;; Hrvoje Niksic May/1997 -;; Completely rewritten. Now uses `defstruct' and other CL stuff -;; to define clients cleanly. Many thanks to Dave Gillespie! -;; -;; Mike Scheidler July, 1997 -;; Added 'Done' button to the menubar. - - -;;; Code: - -(defgroup gnuserv nil - "The gnuserv suite of programs to talk to Emacs from outside." - :group 'environment - :group 'processes - :group 'terminals) - - -;; Provide the old variables as aliases, to avoid breaking .emacs -;; files. However, they are obsolete and should be converted to the -;; new forms. This ugly crock must be before the variable -;; declaration, or the scheme fails. - -(define-obsolete-variable-alias 'server-frame 'gnuserv-frame) -(define-obsolete-variable-alias 'server-done-function - 'gnuserv-done-function) -(define-obsolete-variable-alias 'server-done-temp-file-function - 'gnuserv-done-temp-file-function) -(define-obsolete-variable-alias 'server-find-file-function - 'gnuserv-find-file-function) -(define-obsolete-variable-alias 'server-program - 'gnuserv-program) -(define-obsolete-variable-alias 'server-visit-hook - 'gnuserv-visit-hook) -(define-obsolete-variable-alias 'server-done-hook - 'gnuserv-done-hook) -(define-obsolete-variable-alias 'server-kill-quietly - 'gnuserv-kill-quietly) -(define-obsolete-variable-alias 'server-temp-file-regexp - 'gnuserv-temp-file-regexp) -(define-obsolete-variable-alias 'server-make-temp-file-backup - 'gnuserv-make-temp-file-backup) - -;;;###autoload -(defcustom gnuserv-frame nil - "*The frame to be used to display all edited files. -If nil, then a new frame is created for each file edited. -If t, then the currently selected frame will be used. -If a function, then this will be called with a symbol `x' or `tty' as the -only argument, and its return value will be interpreted as above." - :tag "Gnuserv Frame" - :type '(radio (const :tag "Create new frame each time" nil) - (const :tag "Use selected frame" t) - (function-item :tag "Use main Emacs frame" - gnuserv-main-frame-function) - (function-item :tag "Use visible frame, otherwise create new" - gnuserv-visible-frame-function) - (function-item :tag "Create special Gnuserv frame and use it" - gnuserv-special-frame-function) - (function :tag "Other")) - :group 'gnuserv - :group 'frames) - -(defcustom gnuserv-frame-plist nil - "*Plist of frame properties for creating a gnuserv frame." - :type 'plist - :group 'gnuserv - :group 'frames) - -(defcustom gnuserv-done-function 'kill-buffer - "*Function used to remove a buffer after editing. -It is called with one BUFFER argument. Functions such as `kill-buffer' and -`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." - :type '(radio (function-item kill-buffer) - (function-item bury-buffer) - (function :tag "Other")) - :group 'gnuserv) - -(defcustom gnuserv-done-temp-file-function 'kill-buffer - "*Function used to remove a temporary buffer after editing. -It is called with one BUFFER argument. Functions such as `kill-buffer' and -`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'." - :type '(radio (function-item kill-buffer) - (function-item bury-buffer) - (function :tag "Other")) - :group 'gnuserv) - -(defcustom gnuserv-find-file-function 'find-file - "*Function to visit a file with. -It takes one argument, a file name to visit." - :type 'function - :group 'gnuserv) - -(defcustom gnuserv-view-file-function 'view-file - "*Function to view a file with. -It takes one argument, a file name to view." - :type '(radio (function-item view-file) - (function-item find-file-read-only) - (function :tag "Other")) - :group 'gnuserv) - -(defcustom gnuserv-program "gnuserv" - "*Program to use as the editing server." - :type 'string - :group 'gnuserv) - -(defcustom gnuserv-visit-hook nil - "*Hook run after visiting a file." - :type 'hook - :group 'gnuserv) - -(defcustom gnuserv-done-hook nil - "*Hook run when done editing a buffer for the Emacs server. -The hook functions are called after the file has been visited, with the -current buffer set to the visiting buffer." - :type 'hook - :group 'gnuserv) - -(defcustom gnuserv-init-hook nil - "*Hook run after the server is started." - :type 'hook - :group 'gnuserv) - -(defcustom gnuserv-shutdown-hook nil - "*Hook run before the server exits." - :type 'hook - :group 'gnuserv) - -(defcustom gnuserv-kill-quietly nil - "*Non-nil means to kill buffers with clients attached without requiring confirmation." - :type 'boolean - :group 'gnuserv) - -(defcustom gnuserv-temp-file-regexp - (concat "^" (temp-directory) "/Re\\|/draft$") - "*Regexp which should match filenames of temporary files deleted -and reused by the programs that invoke the Emacs server." - :type 'regexp - :group 'gnuserv) - -(defcustom gnuserv-make-temp-file-backup nil - "*Non-nil makes the server backup temporary files also." - :type 'boolean - :group 'gnuserv) - - -;;; Internal variables: - -(defstruct gnuclient - "An object that encompasses several buffers in one. -Normally, a client connecting to Emacs will be assigned an id, and -will request editing of several files. - -ID - Client id (integer). -BUFFERS - List of buffers that \"belong\" to the client. - NOTE: one buffer can belong to several clients. -DEVICE - The device this client is on. If the device was also created. - by a client, it will be placed to `gnuserv-devices' list. -FRAME - Frame created by the client, or nil if the client didn't - create a frame. - -All the slots default to nil." - (id nil) - (buffers nil) - (device nil) - (frame nil)) - -(defvar gnuserv-process nil - "The current gnuserv process.") - -(defvar gnuserv-string "" - "The last input string from the server.") - -(defvar gnuserv-current-client nil - "The client we are currently talking to.") - -(defvar gnuserv-clients nil - "List of current gnuserv clients. -Each element is a gnuclient structure that identifies a client.") - -(defvar gnuserv-devices nil - "List of devices created by clients.") - -(defvar gnuserv-special-frame nil - "Frame created specially for Server.") - -;; We want the client-infested buffers to have some modeline -;; identification, so we'll make a "minor mode". -(defvar gnuserv-minor-mode nil) -(make-variable-buffer-local 'gnuserv-mode) -(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist - :test 'equal) - - -;; Sample gnuserv-frame functions - -(defun gnuserv-main-frame-function (type) - "Return a sensible value for the main Emacs frame." - (if (or (eq type 'x) - (eq type 'mswindows)) - (car (frame-list)) - nil)) - -(defun gnuserv-visible-frame-function (type) - "Return a frame if there is a frame that is truly visible, nil otherwise. -This is meant in the X sense, so it will not return frames that are on another -visual screen. Totally visible frames are preferred. If none found, return nil." - (if (or (eq type 'x) - (eq type 'mswindows)) - (cond ((car (filtered-frame-list 'frame-totally-visible-p - (selected-device)))) - ((car (filtered-frame-list (lambda (frame) - ;; eq t as in not 'hidden - (eq t (frame-visible-p frame))) - (selected-device))))) - nil)) - -(defun gnuserv-special-frame-function (type) - "Create a special frame for Gnuserv and return it on later invocations." - (unless (frame-live-p gnuserv-special-frame) - (setq gnuserv-special-frame (make-frame gnuserv-frame-plist))) - gnuserv-special-frame) - - -;;; Communication functions - -;; We used to restart the server here, but it's too risky -- if -;; something goes awry, it's too easy to wind up in a loop. -(defun gnuserv-sentinel (proc msg) - (let ((msgstring (concat "Gnuserv process %s; restart with `%s'")) - (keystring (substitute-command-keys "\\[gnuserv-start]"))) - (case (process-status proc) - (exit - (message msgstring "exited" keystring) - (gnuserv-prepare-shutdown)) - (signal - (message msgstring "killed" keystring) - (gnuserv-prepare-shutdown)) - (closed - (message msgstring "closed" keystring)) - (gnuserv-prepare-shutdown)))) - -;; This function reads client requests from our current server. Every -;; client is identified by a unique ID within the server -;; (incidentally, the same ID is the file descriptor the server uses -;; to communicate to client). -;; -;; The request string can arrive in several chunks. As the request -;; ends with \C-d, we check for that character at the end of string. -;; If not found, keep reading, and concatenating to former strings. -;; So, if at first read we receive "5 (gn", that text will be stored -;; to gnuserv-string. If we then receive "us)\C-d", the two will be -;; concatenated, `current-client' will be set to 5, and `(gnus)' form -;; will be evaluated. -;; -;; Server will send the following: -;; -;; "ID \C-d" (no quotes) -;; -;; ID - file descriptor of the given client; -;; - the actual contents of the request. -(defun gnuserv-process-filter (proc string) - "Process gnuserv client requests to execute Emacs commands." - (setq gnuserv-string (concat gnuserv-string string)) - ;; C-d means end of request. - (when (string-match "\C-d\\'" gnuserv-string) - (cond ((string-match "^[0-9]+" gnuserv-string) ; client request id - (let ((header (read-from-string gnuserv-string))) - ;; Set the client we are talking to. - (setq gnuserv-current-client (car header)) - ;; Evaluate the expression - (condition-case oops - (eval (car (read-from-string gnuserv-string (cdr header)))) - ;; In case of an error, write the description to the - ;; client, and then signal it. - (error (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) - (setq gnuserv-current-client nil) - (signal (car oops) (cdr oops))) - (quit (setq gnuserv-string "") - (gnuserv-write-to-client gnuserv-current-client oops) - (setq gnuserv-current-client nil) - (signal 'quit nil))) - (setq gnuserv-string ""))) - (t - (error "%s: invalid response from gnuserv" gnuserv-string) - (setq gnuserv-string ""))))) - -;; This function is somewhat of a misnomer. Actually, we write to the -;; server (using `process-send-string' to gnuserv-process), which -;; interprets what we say and forwards it to the client. The -;; incantation server understands is (from gnuserv.c): -;; -;; "FD/LEN:\n" (no quotes) -;; FD - file descriptor of the given client (which we obtained from -;; the server earlier); -;; LEN - length of the stuff we are about to send; -;; - the actual contents of the request. -(defun gnuserv-write-to-client (client-id form) - "Write the given form to the given client via the gnuserv process." - (when (eq (process-status gnuserv-process) 'run) - (let* ((result (format "%s" form)) - (s (format "%s/%d:%s\n" client-id - (length result) result))) - (process-send-string gnuserv-process s)))) - -;; The following two functions are helper functions, used by -;; gnuclient. - -(defun gnuserv-eval (form) - "Evaluate form and return result to client." - (gnuserv-write-to-client gnuserv-current-client (eval form)) - (setq gnuserv-current-client nil)) - -(defun gnuserv-eval-quickly (form) - "Let client know that we've received the request, and then eval the form. -This order is important as not to keep the client waiting." - (gnuserv-write-to-client gnuserv-current-client nil) - (setq gnuserv-current-client nil) - (eval form)) - - -;; "Execute" a client connection, called by gnuclient. This is the -;; backbone of gnuserv.el. -(defun gnuserv-edit-files (type list &rest flags) - "For each (line-number . file) pair in LIST, edit the file at line-number. -The visited buffers are memorized, so that when \\[gnuserv-edit] is invoked -in such a buffer, or when it is killed, or the client's device deleted, the -client will be invoked that the edit is finished. - -TYPE should either be a (tty TTY TERM PID) list, or (x DISPLAY) list. -If a flag is `quick', just edit the files in Emacs. -If a flag is `view', view the files read-only." - (let (quick view) - (mapc (lambda (flag) - (case flag - (quick (setq quick t)) - (view (setq view t)) - (t (error "Invalid flag %s" flag)))) - flags) - (let* ((old-device-num (length (device-list))) - (new-frame nil) - (dest-frame (if (functionp gnuserv-frame) - (funcall gnuserv-frame (car type)) - gnuserv-frame)) - ;; The gnuserv-frame dependencies are ugly, but it's - ;; extremely hard to make that stuff cleaner without - ;; breaking everything in sight. - (device (cond ((frame-live-p dest-frame) - (frame-device dest-frame)) - ((null dest-frame) - (case (car type) - (tty (apply 'make-tty-device (cdr type))) - (x (make-x-device (cadr type))) - (mswindows (make-mswindows-device)) - (t (error "Invalid device type")))) - (t - (selected-device)))) - (frame (cond ((frame-live-p dest-frame) - dest-frame) - ((null dest-frame) - (setq new-frame (make-frame gnuserv-frame-plist - device)) - new-frame) - (t (selected-frame)))) - (client (make-gnuclient :id gnuserv-current-client - :device device - :frame new-frame))) - (setq gnuserv-current-client nil) - ;; If the device was created by this client, push it to the list. - (and (/= old-device-num (length (device-list))) - (push device gnuserv-devices)) - (and (frame-iconified-p frame) - (deiconify-frame frame)) - ;; Visit all the listed files. - (while list - (let ((line (caar list)) (path (cdar list))) - (select-frame frame) - ;; Visit the file. - (funcall (if view - gnuserv-view-file-function - gnuserv-find-file-function) - path) - (goto-line line) - ;; Don't memorize the quick and view buffers. - (unless (or quick view) - (pushnew (current-buffer) (gnuclient-buffers client)) - (setq gnuserv-minor-mode t) - ;; Add the "Done" button to the menubar, only in this buffer. - (if (and (featurep 'menubar) current-menubar) - (progn (set-buffer-menubar current-menubar) - (add-menu-button nil ["Done" gnuserv-edit])) - )) - (run-hooks 'gnuserv-visit-hook) - (pop list))) - (cond - ((and (or quick view) - (device-on-window-system-p device)) - ;; Exit if on X device, and quick or view. NOTE: if the - ;; client is to finish now, it must absolutely /not/ be - ;; included to the list of clients. This way the client-ids - ;; should be unique. - (gnuserv-write-to-client (gnuclient-id client) nil)) - (t - ;; Else, the client gets a vote. - (push client gnuserv-clients) - ;; Explain buffer exit options. If dest-frame is nil, the - ;; user can exit via `delete-frame'. OTOH, if FLAGS are nil - ;; and there are some buffers, the user can exit via - ;; `gnuserv-edit'. - (if (and (not (or quick view)) - (gnuclient-buffers client)) - (message "%s" - (substitute-command-keys - "Type `\\[gnuserv-edit]' to finish editing")) - (or dest-frame - (message "%s" - (substitute-command-keys - "Type `\\[delete-frame]' to finish editing"))))))))) - - -;;; Functions that hook into Emacs in various way to enable operation - -;; Defined later. -(add-hook 'kill-emacs-hook 'gnuserv-kill-all-clients t) - -;; A helper function; used by others. Try avoiding it whenever -;; possible, because it is slow, and conses a list. Use -;; `gnuserv-buffer-p' when appropriate, for instance. -(defun gnuserv-buffer-clients (buffer) - "Return a list of clients to which BUFFER belongs." - (let (res) - (dolist (client gnuserv-clients) - (when (memq buffer (gnuclient-buffers client)) - (push client res))) - res)) - -;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't -;; collect a list. -(defun gnuserv-buffer-p (buffer) - (member* buffer gnuserv-clients - :test 'memq - :key 'gnuclient-buffers)) - -;; This function makes sure that a killed buffer is deleted off the -;; list for the particular client. -;; -;; This hooks into `kill-buffer-hook'. It is *not* a replacement for -;; `kill-buffer' (thanks God). -(defun gnuserv-kill-buffer-function () - "Remove the buffer from the buffer lists of all the clients it belongs to. -Any client that remains \"empty\" after the removal is informed that the -editing has ended." - (let* ((buf (current-buffer))) - (dolist (client (gnuserv-buffer-clients buf)) - (callf2 delq buf (gnuclient-buffers client)) - ;; If no more buffers, kill the client. - (when (null (gnuclient-buffers client)) - (gnuserv-kill-client client))))) - -(add-hook 'kill-buffer-hook 'gnuserv-kill-buffer-function) - -;; Ask for confirmation before killing a buffer that belongs to a -;; living client. -(defun gnuserv-kill-buffer-query-function () - (or gnuserv-kill-quietly - (not (gnuserv-buffer-p (current-buffer))) - (yes-or-no-p - (format "Buffer %s belongs to gnuserv client(s); kill anyway? " - (current-buffer))))) - -(add-hook 'kill-buffer-query-functions - 'gnuserv-kill-buffer-query-function) - -(defun gnuserv-kill-emacs-query-function () - (or gnuserv-kill-quietly - (not (some 'gnuclient-buffers gnuserv-clients)) - (yes-or-no-p "Gnuserv buffers still have clients; exit anyway? "))) - -(add-hook 'kill-emacs-query-functions - 'gnuserv-kill-emacs-query-function) - -;; If the device of a client is to be deleted, the client should die -;; as well. This is why we hook into `delete-device-hook'. -(defun gnuserv-check-device (device) - (when (memq device gnuserv-devices) - (dolist (client gnuserv-clients) - (when (eq device (gnuclient-device client)) - ;; we must make sure that the server kill doesn't result in - ;; killing the device, because it would cause a device-dead - ;; error when `delete-device' tries to do the job later. - (gnuserv-kill-client client t)))) - (callf2 delq device gnuserv-devices)) - -(add-hook 'delete-device-hook 'gnuserv-check-device) - -(defun gnuserv-temp-file-p (buffer) - "Return non-nil if BUFFER contains a file considered temporary. -These are files whose names suggest they are repeatedly -reused to pass information to another program. - -The variable `gnuserv-temp-file-regexp' controls which filenames -are considered temporary." - (and (buffer-file-name buffer) - (string-match gnuserv-temp-file-regexp (buffer-file-name buffer)))) - -(defun gnuserv-kill-client (client &optional leave-frame) - "Kill the gnuclient CLIENT. -This will do away with all the associated buffers. If LEAVE-FRAME, -the function will not remove the frames associated with the client." - ;; Order is important: first delete client from gnuserv-clients, to - ;; prevent gnuserv-buffer-done-1 calling us recursively. - (callf2 delq client gnuserv-clients) - ;; Process the buffers. - (mapc 'gnuserv-buffer-done-1 (gnuclient-buffers client)) - (unless leave-frame - (let ((device (gnuclient-device client))) - ;; kill frame created by this client (if any), unless - ;; specifically requested otherwise. - ;; - ;; note: last frame on a device will not be deleted here. - (when (and (gnuclient-frame client) - (frame-live-p (gnuclient-frame client)) - (second (device-frame-list device))) - (delete-frame (gnuclient-frame client))) - ;; If the device is live, created by a client, and no longer used - ;; by any client, delete it. - (when (and (device-live-p device) - (memq device gnuserv-devices) - (second (device-list)) - (not (member* device gnuserv-clients - :key 'gnuclient-device))) - ;; `gnuserv-check-device' will remove it from `gnuserv-devices'. - (delete-device device)))) - ;; Notify the client. - (gnuserv-write-to-client (gnuclient-id client) nil)) - -;; Do away with the buffer. -(defun gnuserv-buffer-done-1 (buffer) - (dolist (client (gnuserv-buffer-clients buffer)) - (callf2 delq buffer (gnuclient-buffers client)) - (when (null (gnuclient-buffers client)) - (gnuserv-kill-client client))) - ;; Get rid of the buffer. - (save-excursion - (set-buffer buffer) - (run-hooks 'gnuserv-done-hook) - (setq gnuserv-minor-mode nil) - ;; Delete the menu button. - (if (and (featurep 'menubar) current-menubar) - (delete-menu-item '("Done"))) - (funcall (if (gnuserv-temp-file-p buffer) - gnuserv-done-temp-file-function - gnuserv-done-function) - buffer))) - - -;;; Higher-level functions - -;; Choose a `next' server buffer, according to several criteria, and -;; return it. If none are found, return nil. -(defun gnuserv-next-buffer () - (let* ((frame (selected-frame)) - (device (selected-device)) - client) - (cond - ;; If we have a client belonging to this frame, return - ;; the first buffer from it. - ((setq client - (car (member* frame gnuserv-clients :key 'gnuclient-frame))) - (car (gnuclient-buffers client))) - ;; Else, look for a device. - ((and - (memq (selected-device) gnuserv-devices) - (setq client - (car (member* device gnuserv-clients :key 'gnuclient-device)))) - (car (gnuclient-buffers client))) - ;; Else, try to find any client with at least one buffer, and - ;; return its first buffer. - ((setq client - (car (member-if-not #'null gnuserv-clients - :key 'gnuclient-buffers))) - (car (gnuclient-buffers client))) - ;; Oh, give up. - (t nil)))) - -(defun gnuserv-buffer-done (buffer) - "Mark BUFFER as \"done\" for its client(s). -Does the save/backup queries first, and calls `gnuserv-done-function'." - ;; Check whether this is the real thing. - (unless (gnuserv-buffer-p buffer) - (error "%s does not belong to a gnuserv client" buffer)) - ;; Backup/ask query. - (if (gnuserv-temp-file-p buffer) - ;; For a temp file, save, and do NOT make a non-numeric backup - ;; Why does server.el explicitly back up temporary files? - (let ((version-control nil) - (buffer-backed-up (not gnuserv-make-temp-file-backup))) - (save-buffer)) - (if (and (buffer-modified-p) - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer buffer))) - (gnuserv-buffer-done-1 buffer)) - -;; Called by `gnuserv-start-1' to clean everything. Hooked into -;; `kill-emacs-hook', too. -(defun gnuserv-kill-all-clients () - "Kill all the gnuserv clients. Ruthlessly." - (mapc 'gnuserv-kill-client gnuserv-clients)) - -;; This serves to run the hook and reset -;; `allow-deletion-of-last-visible-frame'. -(defun gnuserv-prepare-shutdown () - (setq allow-deletion-of-last-visible-frame nil) - (run-hooks 'gnuserv-shutdown-hook)) - -;; This is a user-callable function, too. -(defun gnuserv-shutdown () - "Shutdown the gnuserv server, if one is currently running. -All the clients will be disposed of via the normal methods." - (interactive) - (gnuserv-kill-all-clients) - (when gnuserv-process - (set-process-sentinel gnuserv-process nil) - (gnuserv-prepare-shutdown) - (condition-case () - (delete-process gnuserv-process) - (error nil)) - (setq gnuserv-process nil))) - -;; Actually start the process. Kills all the clients before-hand. -(defun gnuserv-start-1 (&optional leave-dead) - ;; Shutdown the existing server, if any. - (gnuserv-shutdown) - ;; If we already had a server, clear out associated status. - (unless leave-dead - (setq gnuserv-string "" - gnuserv-current-client nil) - (let ((process-connection-type t)) - (setq gnuserv-process - (start-process "gnuserv" nil gnuserv-program))) - (set-process-sentinel gnuserv-process 'gnuserv-sentinel) - (set-process-filter gnuserv-process 'gnuserv-process-filter) - (process-kill-without-query gnuserv-process) - (setq allow-deletion-of-last-visible-frame t) - (run-hooks 'gnuserv-init-hook))) - - -;;; User-callable functions: - -;;;###autoload -(defun gnuserv-running-p () - "Return non-nil if a gnuserv process is running from this XEmacs session." - (not (not gnuserv-process))) - -;;;###autoload -(defun gnuserv-start (&optional leave-dead) - "Allow this Emacs process to be a server for client processes. -This starts a gnuserv communications subprocess through which -client \"editors\" (gnuclient and gnudoit) can send editing commands to -this Emacs job. See the gnuserv(1) manual page for more details. - -Prefix arg means just kill any existing server communications subprocess." - (interactive "P") - (and gnuserv-process - (not leave-dead) - (message "Restarting gnuserv")) - (gnuserv-start-1 leave-dead)) - -(defun gnuserv-edit (&optional count) - "Mark the current gnuserv editing buffer as \"done\", and switch to next one. - -Run with a numeric prefix argument, repeat the operation that number -of times. If given a universal prefix argument, close all the buffers -of this buffer's clients. - -The `gnuserv-done-function' (bound to `kill-buffer' by default) is -called to dispose of the buffer after marking it as done. - -Files that match `gnuserv-temp-file-regexp' are considered temporary and -are saved unconditionally and backed up if `gnuserv-make-temp-file-backup' -is non-nil. They are disposed of using `gnuserv-done-temp-file-function' -\(also bound to `kill-buffer' by default). - -When all of a client's buffers are marked as \"done\", the client is notified." - (interactive "P") - (when (null count) - (setq count 1)) - (cond ((numberp count) - (while (natnump (decf count)) - (let ((frame (selected-frame))) - (gnuserv-buffer-done (current-buffer)) - (when (eq frame (selected-frame)) - ;; Switch to the next gnuserv buffer. However, do this - ;; only if we remain in the same frame. - (let ((next (gnuserv-next-buffer))) - (when next - (switch-to-buffer next))))))) - (count - (let* ((buf (current-buffer)) - (clients (gnuserv-buffer-clients buf))) - (unless clients - (error "%s does not belong to a gnuserv client" buf)) - (mapc 'gnuserv-kill-client (gnuserv-buffer-clients buf)))))) - -(global-set-key "\C-x#" 'gnuserv-edit) - -(provide 'gnuserv) - -;;; gnuserv.el ends here diff --git a/lisp/gui.el b/lisp/gui.el deleted file mode 100644 index 893efe5..0000000 --- a/lisp/gui.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; gui.el --- Basic GUI functions for XEmacs. - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs (when window system support is compiled in). - -;;; Code: - -(defcustom dialog-frame-plist '(width 60 height 20) - "Plist of frame properties for initially creating a dialog frame. -Properties specified here supersede the values given in -`default-frame-plist'." - :type 'plist - :group 'frames) - -(defun make-dialog-frame (&optional props parent) - "Create a frame suitable for use as a dialog box. -The frame is made a child of PARENT (defaults to the selected frame), -and has additional properties PROPS, as well as `dialog-frame-plist'. -Normally it also has no modelines, menubars, or toolbars." - (or parent (setq parent (selected-frame))) - (let* ((ftop (frame-property parent 'top)) - (fleft (frame-property parent 'left)) - (fwidth (frame-pixel-width parent)) - (fheight (frame-pixel-height parent)) - (fonth (font-height (face-font 'default))) - (fontw (font-width (face-font 'default))) - (props (append props dialog-frame-plist)) - (dfheight (plist-get props 'height)) - (dfwidth (plist-get props 'width)) - ;; under FVWM at least, if I don't specify the initial position, - ;; it ends up always at (0, 0). xwininfo doesn't tell me - ;; that there are any program-specified position hints, so - ;; it must be an FVWM bug. So just be smashing and position - ;; in the center of the selected frame. - (frame (make-frame - (append props - `(popup ,parent initially-unmapped t - menubar-visible-p nil - has-modeline-p nil - default-toolbar-visible-p nil - modeline-shadow-thickness 0 - left ,(+ fleft (- (/ fwidth 2) - (/ (* dfwidth fontw) - 2))) - top ,(+ ftop (- (/ fheight 2) - (/ (* dfheight fonth) - 2)))))))) - (set-face-foreground 'modeline [default foreground] frame) - (set-face-background 'modeline [default background] frame) - (make-frame-visible frame) - frame)) - -(defvar gui-button-shadow-thickness 2) - -(defun gui-button-p (object) - "True if OBJECT is a GUI button." - (and (vectorp object) - (> (length object) 0) - (eq 'gui-button (aref object 0)))) - -(make-face 'gui-button-face "Face used for gui buttons") -(if (not (face-differs-from-default-p 'gui-button-face)) - (progn - (set-face-reverse-p 'gui-button-face t) - (set-face-background 'gui-button-face '(((x color) . "grey75") - ((mswindows color) . "grey75"))) - (set-face-foreground 'gui-button-face '(((x color) . "black") - ((mswindows color) . "black"))))) - -(defun make-gui-button (string &optional action user-data) - "Make a GUI button whose label is STRING and whose action is ACTION. -If the button is inserted in a buffer and then clicked on, and ACTION -is non-nil, ACTION will be called with one argument, USER-DATA." - (vector 'gui-button - (if (featurep 'xpm) - (xpm-button-create - string gui-button-shadow-thickness - (color-instance-name (face-foreground-instance 'gui-button-face)) - (color-instance-name (face-background-instance 'gui-button-face))) - (xbm-button-create string gui-button-shadow-thickness)) - action user-data)) - -(defun insert-gui-button (button &optional pos buffer) - "Insert GUI button BUTTON at POS in BUFFER." - (check-argument-type 'gui-button-p button) - (let ((annotation - (make-annotation (make-glyph (car (aref button 1))) - pos 'text buffer nil - (make-glyph (cadr (aref button 1))))) - (action (aref button 2))) - (and action - (progn - (set-annotation-action annotation action) - (set-annotation-data annotation (aref button 3)))))) - -;;; gui.el ends here diff --git a/lisp/help-macro.el b/lisp/help-macro.el deleted file mode 100644 index b68216d..0000000 --- a/lisp/help-macro.el +++ /dev/null @@ -1,174 +0,0 @@ -;;; help-macro.el --- Makes command line help such as help-for-help - -;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc. - -;; Author: Lynn Slater -;; Maintainer: FSF -;; Created: : Mon Oct 1 11:42:39 1990 -;; Adapted-By: ESR - -;; 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: - -;;; Synched up with: FSF 20.2. - -;; This file supplies the macro make-help-screen which constructs -;; single character dispatching with browsable help such as that provided -;; by help-for-help. This can be used to make many modes easier to use; for -;; example, the Gnu Emacs Empire Tool uses this for every "nested" mode map -;; called from the main mode map. - -;; The name of this package was changed from help-screen.el to -;; help-macro.el in order to fit in a 14-character limit. - -;;-> *********************** Example of use ********************************* - -;;->(make-help-screen help-for-empire-redistribute-map -;;-> "c:civ m:mil p:population f:food ?" -;;-> "You have discovered the GEET redistribution commands -;;-> From here, you can use the following options: -;;-> -;;->c Redistribute civs from overfull sectors into connected underfull ones -;;-> The functions typically named by empire-ideal-civ-fcn control -;;-> based in part on empire-sector-civ-threshold -;;->m Redistribute military using levels given by empire-ideal-mil-fcn -;;->p Redistribute excess population to highways for max pop growth -;;-> Excess is any sector so full babies will not be born. -;;->f Even out food on highways to highway min and leave levels -;;-> This is good to pump max food to all warehouses/dist pts -;;-> -;;-> -;;->Use \\[help-for-empire-redistribute-map] for help on redistribution. -;;->Use \\[help-for-empire-extract-map] for help on data extraction. -;;->Please use \\[describe-key] to find out more about any of the other keys." -;;-> empire-shell-redistribute-map) - -;;-> (define-key c-mp "\C-h" 'help-for-empire-redistribute-map) -;;-> (define-key c-mp help-character 'help-for-empire-redistribute-map) - -;;; Code: - -(provide 'help-macro) - -;;;###autoload -(defcustom three-step-help t - "*Non-nil means give more info about Help command in three steps. -The three steps are simple prompt, prompt with all options, -and window listing and describing the options. -A value of nil means skip the middle step, so that -\\[help-command] \\[help-command] gives the window that lists the options." - :type 'boolean - :group 'help-appearance) - -(defmacro make-help-screen (fname help-line help-text helped-map) - "Construct help-menu function name FNAME. -When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP. -If the command is the help character, FNAME displays HELP-TEXT -and continues trying to read a command using HELPED-MAP. -When FNAME finally does get a command, it executes that command -and then returns." - `(defun ,fname () - ,help-text - (interactive) - (flet ((help-read-key (prompt) - ;; This is in `flet' to avoid problems with autoloading. - ;; #### The function is ill-conceived -- there should be - ;; a way to do it without all the hassle! - (let (events) - (while (not (key-press-event-p - (aref (setq events (read-key-sequence prompt)) 0))) - ;; Mouse clicks are not part of the help feature, so - ;; reexecute them in the standard environment. - (mapc 'dispatch-event events)) - (let ((key (nconc (event-modifiers (aref events 0)) - (list (event-key (aref events 0)))))) - ;; Make the HELP key translate to C-h. - (when (lookup-key function-key-map key) - (setq key (lookup-key function-key-map key))) - (if (eq (length key) 1) - (car key) - key))))) - (let ((line-prompt - (substitute-command-keys ,help-line))) - (when three-step-help - (message "%s" line-prompt)) - (let* ((help-screen (documentation (quote ,fname))) - ;; We bind overriding-local-map for very small - ;; sections, *excluding* where we switch buffers and - ;; where we execute the chosen help command. - (local-map (make-sparse-keymap)) - (minor-mode-map-alist nil) - (prev-frame (selected-frame)) - config new-frame key) - (unwind-protect - (progn - (set-keymap-parents local-map (list ,helped-map)) - (cond (three-step-help - (let* ((overriding-local-map local-map)) - (setq key (help-read-key nil)))) - (t - (setq key ??))) - (when (or (equal key ??) - (equal key (list help-char))) - (setq config (current-window-configuration)) - (switch-to-buffer-other-window "*Help*") - (and (not (eq (window-frame (selected-window)) - prev-frame)) - (setq new-frame (window-frame (selected-window)) - config nil)) - (setq buffer-read-only nil) - (erase-buffer) - (insert help-screen) - (help-mode) - (goto-char (point-min)) - (while (member key `((,help-char) ?? (control v) space ?\177 - delete backspace (meta v))) - (ignore-errors - (cond ((member key '((control v) space)) - (scroll-up)) - ((member key '(?\177 delete (meta v) backspace)) - (scroll-down)))) - (let ((cursor-in-echo-area t) - (overriding-local-map local-map)) - (setq key (help-read-key - (format "Type one of the options listed%s: " - (if (pos-visible-in-window-p - (point-max)) - "" " or Space to scroll"))))))) - ;; We don't need the prompt any more. - (message nil) - (let ((defn (lookup-key local-map key))) - (cond (defn - (when config - (set-window-configuration config) - (setq config nil)) - (when new-frame - (iconify-frame new-frame) - (setq new-frame nil)) - (call-interactively defn)) - (t - (ding))))) - (and (get-buffer "*Help*") - (bury-buffer "*Help*")) - (and new-frame (iconify-frame new-frame)) - (and config - (set-window-configuration config)))))))) - -;;; help-macro.el - diff --git a/lisp/help-nomule.el b/lisp/help-nomule.el deleted file mode 100644 index 1f4a0bb..0000000 --- a/lisp/help-nomule.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; help-nomule.el --- Help functions when not in Mule - -;; Copyright (C) 1997 by Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: help, internal, dumped - -;; 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 is dumped with XEmacs. - -;;; Code: - -(defconst tutorial-supported-languages - '(("French" fr iso-8859-1) - ("German" de iso-8859-1) - ("Norwegian" no iso-8859-1) - ("Croatian" hr iso-8859-2) - ("Polish" pl iso-8859-2) - ("Romanian" ro iso-8859-2)) - "Alist of supported languages in TUTORIAL files. -Add languages here, as more are translated.") - -;; TUTORIAL arg is XEmacs addition -(defun help-with-tutorial (&optional tutorial language) - "Select the XEmacs learn-by-doing tutorial. -Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\". -With a prefix argument, choose the language." - (interactive "i\nP") - (or tutorial - (setq tutorial "TUTORIAL")) - (when (and language (consp language)) - (let ((completion-ignore-case t)) - (setq language (assoc (completing-read "Language: " - tutorial-supported-languages - nil t) - tutorial-supported-languages)))) - (when language - (setq tutorial (format "%s.%s" tutorial (cadr language)))) - (let ((file (expand-file-name tutorial "~"))) - (delete-other-windows) - (let ((buffer (or (get-file-buffer file) - (create-file-buffer file))) - (window-configuration (current-window-configuration))) - (condition-case error-data - (progn - (switch-to-buffer buffer) - (setq buffer-file-name file) - (setq default-directory (expand-file-name "~/")) - (setq buffer-auto-save-file-name nil) - ;; Because of non-Mule users, TUTORIALs are not coded - ;; independently, so we must guess the coding according to - ;; the language. - (let ((coding-system-for-read (nth 2 language))) - (insert-file-contents (locate-data-file tutorial))) - (goto-char (point-min)) - ;; The 'didactic' blank lines: possibly insert blank lines - ;; around <> and replace << >> with [ ]. - (if (re-search-forward "^<<.+>>") - (let ((n (- (window-height (selected-window)) - (count-lines (point-min) (point-at-bol)) - 6))) - (if (< n 12) - (progn (beginning-of-line) (kill-line)) - ;; Some people get confused by the large gap - (delete-backward-char 2) - (insert "]") - (beginning-of-line) - (save-excursion - (delete-char 2) - (insert "[")) - (newline (/ n 2)) - (next-line 1) - (newline (- n (/ n 2)))))) - (goto-char (point-min)) - (set-buffer-modified-p nil)) - ;; TUTORIAL was not found: kill the buffer and restore the - ;; window configuration. - (file-error (kill-buffer buffer) - (set-window-configuration window-configuration) - ;; Now, signal the error - (signal (car error-data) (cdr error-data))))))) - - -(provide 'help-nomule) - -;;; help-nomule.el ends here diff --git a/lisp/help.el b/lisp/help.el deleted file mode 100644 index eb7b1b6..0000000 --- a/lisp/help.el +++ /dev/null @@ -1,1432 +0,0 @@ -;;; help.el --- help commands for XEmacs. - -;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: help, internal, dumped - -;; 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 19.30. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; This code implements XEmacs's on-line help system, the one invoked by -;;`M-x help-for-help'. - -;; 06/11/1997 -- Converted to use char-after instead of broken -;; following-char. -slb - -;;; Code: - -;; Get the macro make-help-screen when this is compiled, -;; or run interpreted, but not when the compiled code is loaded. -(eval-when-compile (require 'help-macro)) - -(defgroup help nil - "Support for on-line help systems." - :group 'emacs) - -(defgroup help-appearance nil - "Appearance of help buffers." - :group 'help) - -(defvar help-map (let ((map (make-sparse-keymap))) - (set-keymap-name map 'help-map) - (set-keymap-prompt - map (purecopy (gettext "(Type ? for further options)"))) - map) - "Keymap for characters following the Help key.") - -;; global-map definitions moved to keydefs.el -(fset 'help-command help-map) - -(define-key help-map (vector help-char) 'help-for-help) -(define-key help-map "?" 'help-for-help) -(define-key help-map 'help 'help-for-help) -(define-key help-map '(f1) 'help-for-help) - -(define-key help-map "\C-l" 'describe-copying) ; on \C-c in FSFmacs -(define-key help-map "\C-d" 'describe-distribution) -(define-key help-map "\C-w" 'describe-no-warranty) -(define-key help-map "a" 'hyper-apropos) ; 'command-apropos in FSFmacs -(define-key help-map "A" 'command-apropos) - -(define-key help-map "b" 'describe-bindings) -(define-key help-map "B" 'describe-beta) -(define-key help-map "\C-p" 'describe-pointer) - -(define-key help-map "C" 'customize) -(define-key help-map "c" 'describe-key-briefly) -(define-key help-map "k" 'describe-key) - -(define-key help-map "d" 'describe-function) -(define-key help-map "e" 'describe-last-error) -(define-key help-map "f" 'describe-function) - -(define-key help-map "F" 'xemacs-local-faq) - -(define-key help-map "i" 'info) -(define-key help-map '(control i) 'Info-query) -;; FSFmacs has Info-goto-emacs-command-node on C-f, no binding -;; for Info-elisp-ref -(define-key help-map '(control c) 'Info-goto-emacs-command-node) -(define-key help-map '(control k) 'Info-goto-emacs-key-command-node) -(define-key help-map '(control f) 'Info-elisp-ref) - -(define-key help-map "l" 'view-lossage) - -(define-key help-map "m" 'describe-mode) - -(define-key help-map "\C-n" 'view-emacs-news) -(define-key help-map "n" 'view-emacs-news) - -(define-key help-map "p" 'finder-by-keyword) - -;; Do this right with an autoload cookie in finder.el. -;;(autoload 'finder-by-keyword "finder" -;; "Find packages matching a given keyword." t) - -(define-key help-map "s" 'describe-syntax) - -(define-key help-map "t" 'help-with-tutorial) - -(define-key help-map "w" 'where-is) - -(define-key help-map "v" 'describe-variable) - -(if (fboundp 'view-last-error) - (define-key help-map "e" 'view-last-error)) - - -(define-key help-map "q" 'help-quit) - -;#### This stuff was an attempt to have font locking and hyperlinks in the -;help buffer, but it doesn't really work. Some of this stuff comes from -;FSF Emacs; but the FSF Emacs implementation is rather broken, as usual. -;What needs to happen is this: -; -; -- we probably need a "hyperlink mode" from which help-mode is derived. -; -- this means we probably need multiple inheritance of modes! -; Thankfully this is not hard to implement; we already have the -; ability for a keymap to have multiple parents. However, we'd -; have to define any multiply-inherited-from modes using a standard -; `define-mode' construction instead of manually doing it, because -; we don't want each guy calling `kill-all-local-variables' and -; messing up the previous one. -; -- we need to scan the buffer ourselves (not from font-lock, because -; the user might not have font-lock enabled) and highlight only -; those words that are *documented* functions and variables (and -; probably excluding words without dashes in them unless enclosed -; in quotes, so that common words like "list" and "point" don't -; become hyperlinks. -; -- we should *not* use font-lock keywords like below. Instead we -; should add the font-lock stuff ourselves during the scanning phase, -; if font-lock is enabled in this buffer. - -;(defun help-follow-reference (event extent user-data) -; (let ((symbol (intern-soft (extent-string extent)))) -; (cond ((and symbol (fboundp symbol)) -; (describe-function symbol)) -; ((and symbol (boundp symbol)) -; (describe-variable symbol)) -; (t nil)))) - -;(defvar help-font-lock-keywords -; (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) -; (list -; ;; -; ;; The symbol itself. -; (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") -; '(1 (if (match-beginning 2) -; 'font-lock-function-name-face -; 'font-lock-variable-name-face) -; nil t)) -; ;; -; ;; Words inside `' which tend to be symbol names. -; (list (concat "`\\(" sym-char sym-char "+\\)'") -; 1 '(prog1 -; 'font-lock-reference-face -; (add-list-mode-item (match-beginning 1) -; (match-end 1) -; nil -; 'help-follow-reference)) -; t) -; ;; -; ;; CLisp `:' keywords as references. -; (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) -; "Default expressions to highlight in Help mode.") - -;(put 'help-mode 'font-lock-defaults '(help-font-lock-keywords)) - -(define-derived-mode help-mode view-major-mode "Help" - "Major mode for viewing help text. -Entry to this mode runs the normal hook `help-mode-hook'. -Commands: -\\{help-mode-map}" - ) - -(define-key help-mode-map "q" 'help-mode-quit) -(define-key help-mode-map "Q" 'help-mode-bury) -(define-key help-mode-map "f" 'find-function-at-point) -(define-key help-mode-map "d" 'describe-function-at-point) -(define-key help-mode-map "v" 'describe-variable-at-point) -(define-key help-mode-map "i" 'Info-elisp-ref) -(define-key help-mode-map "c" 'customize-variable) -(define-key help-mode-map [tab] 'help-next-symbol) -(define-key help-mode-map [(shift tab)] 'help-prev-symbol) -(define-key help-mode-map "n" 'help-next-section) -(define-key help-mode-map "p" 'help-prev-section) - -(defun describe-function-at-point () - "Describe directly the function at point in the other window." - (interactive) - (let ((symb (function-at-point))) - (when symb - (describe-function symb)))) - -(defun describe-variable-at-point () - "Describe directly the variable at point in the other window." - (interactive) - (let ((symb (variable-at-point))) - (when symb - (describe-variable symb)))) - -(defun help-next-symbol () - "Move point to the next quoted symbol." - (interactive) - (search-forward "`" nil t)) - -(defun help-prev-symbol () - "Move point to the previous quoted symbol." - (interactive) - (search-backward "'" nil t)) - -(defun help-next-section () - "Move point to the next quoted symbol." - (interactive) - (search-forward-regexp "^\\w+:" nil t)) - -(defun help-prev-section () - "Move point to the previous quoted symbol." - (interactive) - (search-backward-regexp "^\\w+:" nil t)) - -(defun help-mode-bury () - "Bury the help buffer, possibly restoring the previous window configuration." - (interactive) - (help-mode-quit t)) - -(defun help-mode-quit (&optional bury) - "Exit from help mode, possibly restoring the previous window configuration. -If the optional argument BURY is non-nil, the help buffer is buried, -otherwise it is killed." - (interactive) - (let ((buf (current-buffer))) - (cond ((frame-property (selected-frame) 'help-window-config) - (set-window-configuration - (frame-property (selected-frame) 'help-window-config)) - (set-frame-property (selected-frame) 'help-window-config nil)) - ((not (one-window-p)) - (delete-window))) - (if bury - (bury-buffer buf) - (kill-buffer buf)))) - -(defun help-quit () - (interactive) - nil) - -;; This is a grody hack of the same genotype as `advertised-undo'; if the -;; bindings of Backspace and C-h are the same, we want the menubar to claim -;; that `info' in invoked with `C-h i', not `BS i'. - -(defun deprecated-help-command () - (interactive) - (if (eq 'help-command (key-binding "\C-h")) - (setq unread-command-event (character-to-event ?\C-h)) - (help-for-help))) - -;;(define-key global-map 'backspace 'deprecated-help-command) - -;; This function has been moved to help-nomule.el and mule-help.el. -;; TUTORIAL arg is XEmacs addition -;(defun help-with-tutorial (&optional tutorial) -; "Select the XEmacs learn-by-doing tutorial. -;Optional arg TUTORIAL specifies the tutorial file; default is \"TUTORIAL\"." -; (interactive) -; (if (null tutorial) -; (setq tutorial "TUTORIAL")) -; (let ((file (expand-file-name (concat "~/" tutorial)))) -; (delete-other-windows) -; (if (get-file-buffer file) -; (switch-to-buffer (get-file-buffer file)) -; (switch-to-buffer (create-file-buffer file)) -; (setq buffer-file-name file) -; (setq default-directory (expand-file-name "~/")) -; (setq buffer-auto-save-file-name nil) -; (insert-file-contents (expand-file-name tutorial data-directory)) -; (goto-char (point-min)) -; (search-forward "\n<<") -; (delete-region (point-at-bol) (point-at-eol)) -; (let ((n (- (window-height (selected-window)) -; (count-lines (point-min) (point)) -; 6))) -; (if (< n 12) -; (newline n) -; ;; Some people get confused by the large gap. -; (newline (/ n 2)) -; (insert "[Middle of page left blank for didactic purposes. " -; "Text continues below]") -; (newline (- n (/ n 2))))) -; (goto-char (point-min)) -; (set-buffer-modified-p nil)))) - -;; used by describe-key, describe-key-briefly, insert-key-binding, etc. - -(defun key-or-menu-binding (key &optional menu-flag) - "Return the command invoked by KEY. -Like `key-binding', but handles menu events and toolbar presses correctly. -KEY is any value returned by `next-command-event'. -MENU-FLAG is a symbol that should be set to T if KEY is a menu event, - or NIL otherwise" - (let (defn) - (and menu-flag (set menu-flag nil)) - ;; If the key typed was really a menu selection, grab the form out - ;; of the event object and intuit the function that would be called, - ;; and describe that instead. - (if (and (vectorp key) (= 1 (length key)) - (or (misc-user-event-p (aref key 0)) - (eq (car-safe (aref key 0)) 'menu-selection))) - (let ((event (aref key 0))) - (setq defn (if (eventp event) - (list (event-function event) (event-object event)) - (cdr event))) - (and menu-flag (set menu-flag t)) - (when (eq (car defn) 'eval) - (setq defn (car (cdr defn)))) - (when (eq (car-safe defn) 'call-interactively) - (setq defn (car (cdr defn)))) - (when (and (consp defn) (null (cdr defn))) - (setq defn (car defn)))) - ;; else - (setq defn (key-binding key))) - ;; kludge: if a toolbar button was pressed on, try to find the - ;; binding of the toolbar button. - (if (and (eq defn 'press-toolbar-button) - (vectorp key) - (button-press-event-p (aref key (1- (length key))))) - ;; wait for the button release. We're on shaky ground here ... - (let ((event (next-command-event)) - button) - (if (and (button-release-event-p event) - (event-over-toolbar-p event) - (eq 'release-and-activate-toolbar-button - (key-binding (vector event))) - (setq button (event-toolbar-button event))) - (toolbar-button-callback button) - ;; if anything went wrong, try returning the binding of - ;; the button-up event, of the original binding - (or (key-or-menu-binding (vector event)) - defn))) - ;; no toolbar kludge - defn) - )) - -(defun describe-key-briefly (key &optional insert) - "Print the name of the function KEY invokes. KEY is a string. -If INSERT (the prefix arg) is non-nil, insert the message in the buffer." - (interactive "kDescribe key briefly: \nP") - (let ((standard-output (if insert (current-buffer) t)) - defn menup) - (setq defn (key-or-menu-binding key 'menup)) - (if (or (null defn) (integerp defn)) - (princ (format "%s is undefined" (key-description key))) - ;; If it's a keyboard macro which trivially invokes another command, - ;; document that instead. - (if (or (stringp defn) (vectorp defn)) - (setq defn (or (key-binding defn) - defn))) - (let ((last-event (and (vectorp key) - (aref key (1- (length key)))))) - (princ (format (cond (insert - "%s (%s)") - ((or (button-press-event-p last-event) - (button-release-event-p last-event)) - (gettext "%s at that spot runs the command %s")) - (t - (gettext "%s runs the command %s"))) - ;; This used to say 'This menu item' but it - ;; could also be a scrollbar event. We can't - ;; distinguish at the moment. - (if menup - (if insert "item" "This item") - (key-description key)) - (if (symbolp defn) defn (prin1-to-string defn)))))))) - -;; #### this is a horrible piece of shit function that should -;; not exist. In FSF 19.30 this function has gotten three times -;; as long and has tons and tons of dumb shit checking -;; special-display-buffer-names and such crap. I absolutely -;; refuse to insert that Ebolification here. I wanted to delete -;; this function entirely but Mly bitched. -;; -;; If your user-land code calls this function, rewrite it to -;; call with-displaying-help-buffer. - -(defun print-help-return-message (&optional function) - "Display or return message saying how to restore windows after help command. -Computes a message and applies the optional argument FUNCTION to it. -If FUNCTION is nil, applies `message' to it, thus printing it." - (and (not (get-buffer-window standard-output)) - (funcall - (or function 'message) - (concat - (substitute-command-keys - (if (one-window-p t) - (if pop-up-windows - (gettext "Type \\[delete-other-windows] to remove help window.") - (gettext "Type \\[switch-to-buffer] RET to remove help window.")) - (gettext "Type \\[switch-to-buffer-other-window] RET to restore the other window."))) - (substitute-command-keys - (gettext " \\[scroll-other-window] to scroll the help.")))))) - -(defcustom help-selects-help-window t - "*If nil, use the \"old Emacs\" behavior for Help buffers. -This just displays the buffer in another window, rather than selecting -the window." - :type 'boolean - :group 'help-appearance) - -(defcustom help-max-help-buffers 10 - "*Maximum help buffers to allow before they start getting killed. -If this is a positive integer, before a help buffer is displayed -by `with-displaying-help-buffer', any excess help buffers which -are not being displayed are first killed. Otherwise, if it is -zero or nil, only one help buffer, \"*Help*\" is ever used." - :type '(choice integer (const :tag "None" nil)) - :group 'help-appearance) - -(defvar help-buffer-list nil - "List of help buffers used by `help-register-and-maybe-prune-excess'") - -(defun help-register-and-maybe-prune-excess (newbuf) - "Register use of a help buffer and possibly kill any excess ones." - ;; remove new buffer from list - (setq help-buffer-list (remove newbuf help-buffer-list)) - ;; maybe kill excess help buffers - (if (and (integerp help-max-help-buffers) - (> (length help-buffer-list) help-max-help-buffers)) - (let ((keep-list nil) - (num-kill (- (length help-buffer-list) - help-max-help-buffers))) - (while help-buffer-list - (let ((buf (car help-buffer-list))) - (if (and (or (equal buf newbuf) (get-buffer buf)) - (string-match "^*Help" buf) - (save-excursion (set-buffer buf) - (eq major-mode 'help-mode))) - (if (and (>= num-kill (length help-buffer-list)) - (not (get-buffer-window buf t t))) - (kill-buffer buf) - (setq keep-list (cons buf keep-list))))) - (setq help-buffer-list (cdr help-buffer-list))) - (setq help-buffer-list (nreverse keep-list)))) - ;; push new buffer - (setq help-buffer-list (cons newbuf help-buffer-list))) - -(defvar help-buffer-prefix-string "Help" - "Initial string to use in constructing help buffer names. -You should never set this directory, only let-bind it.") - -(defun help-buffer-name (name) - "Return a name for a Help buffer using string NAME for context." - (if (and (integerp help-max-help-buffers) - (> help-max-help-buffers 0) - (stringp name)) - (format "*%s: %s*" help-buffer-prefix-string name) - (format "*%s*" help-buffer-prefix-string))) - -;; Use this function for displaying help when C-h something is pressed -;; or in similar situations. Do *not* use it when you are displaying -;; a help message and then prompting for input in the minibuffer -- -;; this macro usually selects the help buffer, which is not what you -;; want in those situations. - -;; #### Should really be a macro to eliminate the requirement of -;; caller to code a lambda form in THUNK -- mrb - -;; #### BEFORE you rush to make this a macro, think about backward -;; compatibility. The right way would be to create a macro with -;; another name (which is a shame, because w-d-h-b is a perfect name -;; for a macro) that uses with-displaying-help-buffer internally. - -(defun with-displaying-help-buffer (thunk &optional name) - "Form which makes a help buffer with given NAME and evaluates BODY there. -The actual name of the buffer is generated by the function `help-buffer-name'." - (let* ((winconfig (current-window-configuration)) - (was-one-window (one-window-p)) - (buffer-name (help-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) - (prog1 (with-output-to-temp-buffer buffer-name - (prog1 (funcall thunk) - (save-excursion - (set-buffer standard-output) - (help-mode)))) - (let ((helpwin (get-buffer-window buffer-name))) - (when helpwin - (with-current-buffer (window-buffer helpwin) - ;; If the *Help* buffer is already displayed on this - ;; frame, don't override the previous configuration - (when help-not-visible - (set-frame-property (selected-frame) - '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 help window, \\[scroll-up] to scroll the help."))) - (was-one-window - (display-message 'command - (substitute-command-keys "Type \\[delete-other-windows] to remove help window, \\[scroll-other-window] to scroll the help."))) - (t - (display-message 'command - (substitute-command-keys "Type \\[switch-to-buffer-other-window] to restore the other window, \\[scroll-other-window] to scroll the help."))))))))) - -(defun describe-key (key) - "Display documentation of the function invoked by KEY. -KEY is a string, or vector of events. -When called interactively, KEY may also be a menu selection." - (interactive "kDescribe key: ") - (let ((defn (key-or-menu-binding key)) - (key-string (key-description key))) - (if (or (null defn) (integerp defn)) - (message "%s is undefined" key-string) - (with-displaying-help-buffer - (lambda () - (princ key-string) - (princ " runs ") - (if (symbolp defn) - (princ (format "`%s'" defn)) - (princ defn)) - (princ "\n\n") - (cond ((or (stringp defn) (vectorp defn)) - (let ((cmd (key-binding defn))) - (if (not cmd) - (princ "a keyboard macro") - (progn - (princ "a keyboard macro which runs the command ") - (princ cmd) - (princ ":\n\n") - (if (documentation cmd) (princ (documentation cmd))))))) - ((and (consp defn) (not (eq 'lambda (car-safe defn)))) - (let ((describe-function-show-arglist nil)) - (describe-function-1 (car defn)))) - ((symbolp defn) - (describe-function-1 defn)) - ((documentation defn) - (princ (documentation defn))) - (t - (princ "not documented")))) - (format "key `%s'" key-string))))) - -(defun describe-mode () - "Display documentation of current major mode and minor modes. -For this to work correctly for a minor mode, the mode's indicator variable -\(listed in `minor-mode-alist') must also be a function whose documentation -describes the minor mode." - (interactive) - (with-displaying-help-buffer - (lambda () - ;; XEmacs change: print the major-mode documentation before - ;; the minor modes. - (princ mode-name) - (princ " mode:\n") - (princ (documentation major-mode)) - (princ "\n\n----\n\n") - (let ((minor-modes minor-mode-alist)) - (while minor-modes - (let* ((minor-mode (car (car minor-modes))) - (indicator (car (cdr (car minor-modes))))) - ;; Document a minor mode if it is listed in minor-mode-alist, - ;; bound locally in this buffer, non-nil, and has a function - ;; definition. - (if (and (boundp minor-mode) - (symbol-value minor-mode) - (fboundp minor-mode)) - (let ((pretty-minor-mode minor-mode)) - (if (string-match "-mode\\'" (symbol-name minor-mode)) - (setq pretty-minor-mode - (capitalize - (substring (symbol-name minor-mode) - 0 (match-beginning 0))))) - (while (and (consp indicator) (extentp (car indicator))) - (setq indicator (cdr indicator))) - (while (and indicator (symbolp indicator)) - (setq indicator (symbol-value indicator))) - (princ (format "%s minor mode (indicator%s):\n" - pretty-minor-mode indicator)) - (princ (documentation minor-mode)) - (princ "\n\n----\n\n")))) - (setq minor-modes (cdr minor-modes))))) - (format "%s mode" mode-name))) - -;; So keyboard macro definitions are documented correctly -(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro)) - -(defun describe-distribution () - "Display info on how to obtain the latest version of XEmacs." - (interactive) - (find-file-read-only - (locate-data-file "DISTRIB"))) - -(defun describe-beta () - "Display info on how to deal with Beta versions of XEmacs." - (interactive) - (find-file-read-only - (locate-data-file "BETA")) - (goto-char (point-min))) - -(defun describe-copying () - "Display info on how you may redistribute copies of XEmacs." - (interactive) - (find-file-read-only - (locate-data-file "COPYING")) - (goto-char (point-min))) - -(defun describe-pointer () - "Show a list of all defined mouse buttons, and their definitions." - (interactive) - (describe-bindings nil t)) - -(defun describe-project () - "Display info on the GNU project." - (interactive) - (find-file-read-only - (locate-data-file "GNU")) - (goto-char (point-min))) - -(defun describe-no-warranty () - "Display info on all the kinds of warranty XEmacs does NOT have." - (interactive) - (describe-copying) - (let (case-fold-search) - (search-forward "NO WARRANTY") - (recenter 0))) - -(defun describe-bindings (&optional prefix mouse-only-p) - "Show a list of all defined keys, and their definitions. -The list is put in a buffer, which is displayed. -If the optional argument PREFIX is supplied, only commands which -start with that sequence of keys are described. -If the second argument (prefix arg, interactively) is non-null -then only the mouse bindings are displayed." - (interactive (list nil current-prefix-arg)) - (with-displaying-help-buffer - (lambda () - (describe-bindings-1 prefix mouse-only-p)) - (format "bindings for %s" major-mode))) - -(defun describe-bindings-1 (&optional prefix mouse-only-p) - (let ((heading (if mouse-only-p - (gettext "button binding\n------ -------\n") - (gettext "key binding\n--- -------\n"))) - (buffer (current-buffer)) - (minor minor-mode-map-alist) - (local (current-local-map)) - (shadow '())) - (set-buffer standard-output) - (while minor - (let ((sym (car (car minor))) - (map (cdr (car minor)))) - (if (symbol-value-in-buffer sym buffer nil) - (progn - (insert (format "Minor Mode Bindings for `%s':\n" - sym) - heading) - (describe-bindings-internal map nil shadow prefix mouse-only-p) - (insert "\n") - (setq shadow (cons map shadow)))) - (setq minor (cdr minor)))) - (if local - (progn - (insert "Local Bindings:\n" heading) - (describe-bindings-internal local nil shadow prefix mouse-only-p) - (insert "\n") - (setq shadow (cons local shadow)))) - (insert "Global Bindings:\n" heading) - (describe-bindings-internal (current-global-map) - nil shadow prefix mouse-only-p) - (when (and prefix function-key-map (not mouse-only-p)) - (insert "\nFunction key map translations:\n" heading) - (describe-bindings-internal function-key-map nil nil - prefix mouse-only-p)) - (set-buffer buffer) - standard-output)) - -(defun describe-prefix-bindings () - "Describe the bindings of the prefix used to reach this command. -The prefix described consists of all but the last event -of the key sequence that ran this command." - (interactive) - (let* ((key (this-command-keys)) - (prefix (make-vector (1- (length key)) nil)) - i) - (setq i 0) - (while (< i (length prefix)) - (aset prefix i (aref key i)) - (setq i (1+ i))) - (with-displaying-help-buffer - (lambda () - (princ "Key bindings starting with ") - (princ (key-description prefix)) - (princ ":\n\n") - (describe-bindings-1 prefix nil)) - (format "%s prefix" (key-description prefix))))) - -;; Make C-h after a prefix, when not specifically bound, -;; run describe-prefix-bindings. -(setq prefix-help-command 'describe-prefix-bindings) - -(defun describe-installation () - "Display a buffer showing information about this XEmacs was compiled." - (interactive) - (if (and (boundp 'Installation-string) - (stringp Installation-string)) - (with-displaying-help-buffer - (lambda () - (princ Installation-string)) - "Installation") - (error "No Installation information available."))) - -(defun view-emacs-news () - "Display info on recent changes to XEmacs." - (interactive) - (find-file (locate-data-file "NEWS"))) - -(defun xemacs-www-page () - "Go to the XEmacs World Wide Web page." - (interactive) - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function "http://www.xemacs.org/") - (error "xemacs-www-page requires browse-url"))) - -(defun xemacs-www-faq () - "View the latest and greatest XEmacs FAQ using the World Wide Web." - (interactive) - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function - "http://www.xemacs.org/faq/index.html") - (error "xemacs-www-faq requires browse-url"))) - -(defun xemacs-local-faq () - "View the local copy of the XEmacs FAQ. -If you have access to the World Wide Web, you should use `xemacs-www-faq' -instead, to ensure that you get the most up-to-date information." - (interactive) - (save-window-excursion - (info) - (Info-find-node "xemacs-faq" "Top")) - (switch-to-buffer "*info*")) - -(defcustom view-lossage-key-count 100 - "*Number of keys `view-lossage' shows. -The maximum number of available keys is governed by `recent-keys-ring-size'." - :type 'integer - :group 'help) - -(defcustom view-lossage-message-count 100 - "*Number of minibuffer messages `view-lossage' shows." - :type 'integer - :group 'help) - -(defun print-recent-messages (n) - "Print N most recent messages to standard-output, most recent first. -If N is nil, all messages will be printed." - (save-excursion - (let ((buffer (get-buffer-create " *Message-Log*")) - oldpoint extent) - (goto-char (point-max buffer) buffer) - (set-buffer standard-output) - (while (and (not (bobp buffer)) - (or (null n) (>= (decf n) 0))) - (setq oldpoint (point buffer)) - (setq extent (extent-at oldpoint buffer - 'message-multiline nil 'before)) - ;; If the message was multiline, move all the way to the - ;; beginning. - (if extent - (goto-char (extent-start-position extent) buffer) - (forward-line -1 buffer)) - (insert-buffer-substring buffer (point buffer) oldpoint))))) - -(defun view-lossage () - "Display recent input keystrokes and recent minibuffer messages. -The number of keys shown is controlled by `view-lossage-key-count'. -The number of messages shown is controlled by `view-lossage-message-count'." - (interactive) - (with-displaying-help-buffer - (lambda () - (princ (key-description (recent-keys view-lossage-key-count))) - (save-excursion - (set-buffer standard-output) - (goto-char (point-min)) - (insert "Recent keystrokes:\n\n") - (while (progn (move-to-column 50) (not (eobp))) - (search-forward " " nil t) - (insert "\n"))) - ;; XEmacs addition: copy the messages from " *Message-Log*", - ;; reversing their order and handling multiline messages - ;; correctly. - (princ "\n\n\nRecent minibuffer messages (most recent first):\n\n") - (print-recent-messages view-lossage-message-count)) - "lossage")) - -(define-function 'help 'help-for-help) - -(make-help-screen help-for-help - "A B C F I K L M N P S T V W C-c C-d C-f C-i C-k C-n C-w; ? for more help:" - "Type a Help option: -\(Use SPC or DEL to scroll through this text. Type \\\\[help-quit] to exit the Help command.) - -\\[hyper-apropos] Type a substring; it shows a hypertext list of - functions and variables that contain that substring. - See also the `apropos' command. -\\[command-apropos] Type a substring; it shows a list of commands - (interactively callable functions) that contain that substring. -\\[describe-bindings] Table of all key bindings. -\\[describe-key-briefly] Type a command key sequence; - it displays the function name that sequence runs. -\\[customize] Customize Emacs options. -\\[Info-goto-emacs-command-node] Type a function name; it displays the Info node for that command. -\\[describe-function] Type a function name; it shows its documentation. -\\[Info-elisp-ref] Type a function name; it jumps to the full documentation - in the XEmacs Lisp Programmer's Manual. -\\[xemacs-local-faq] Local copy of the XEmacs FAQ. -\\[info] Info documentation reader. -\\[Info-query] Type an Info file name; it displays it in Info reader. -\\[describe-key] Type a command key sequence; - it displays the documentation for the command bound to that key. -\\[Info-goto-emacs-key-command-node] Type a command key sequence; - it displays the Info node for the command bound to that key. -\\[view-lossage] Recent input keystrokes and minibuffer messages. -\\[describe-mode] Documentation of current major and minor modes. -\\[view-emacs-news] News of recent XEmacs changes. -\\[finder-by-keyword] Type a topic keyword; it finds matching packages. -\\[describe-pointer] Table of all mouse-button bindings. -\\[describe-syntax] Contents of syntax table with explanations. -\\[help-with-tutorial] XEmacs learn-by-doing tutorial. -\\[describe-variable] Type a variable name; it displays its documentation and value. -\\[where-is] Type a command name; it displays which keystrokes invoke that command. -\\[describe-distribution] XEmacs ordering information. -\\[describe-no-warranty] Information on absence of warranty for XEmacs. -\\[describe-copying] XEmacs copying permission (General Public License)." - help-map) - -(defmacro with-syntax-table (syntab &rest body) - "Evaluate BODY with the syntax-table SYNTAB" - `(let ((stab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table (copy-syntax-table ,syntab)) - ,@body) - (set-syntax-table stab)))) -(put 'with-syntax-table 'lisp-indent-function 1) -(put 'with-syntax-table 'edebug-form-spec '(form body)) - -(defun function-called-at-point () - "Return the function which is called by the list containing point. -If that gives no function, return the function whose name is around point. -If that doesn't give a function, return nil." - (or (ignore-errors - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) - (point-max)) - (backward-up-list 1) - (forward-char 1) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj))))) - (ignore-errors - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "`'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))))))) - -(defun function-at-point () - "Return the function whose name is around point. -If that gives no function, return the function which is called by the -list containing point. If that doesn't give a function, return nil." - (or (ignore-errors - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "`'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))))) - (ignore-errors - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) (- (point) 1000)) - (point-max)) - (backward-up-list 1) - (forward-char 1) - (let (obj) - (setq obj (read (current-buffer))) - (and (symbolp obj) (fboundp obj) obj))))))) - -;; Default to nil for the non-hackers? Not until we find a way to -;; distinguish hackers from non-hackers automatically! -(defcustom describe-function-show-arglist t - "*If non-nil, describe-function will show its arglist, -unless the function is autoloaded." - :type 'boolean - :group 'help-appearance) - -(defun describe-symbol-find-file (symbol) - (loop for (file . load-data) in load-history - do (when (memq symbol load-data) - (return file)))) - -(define-obsolete-function-alias - 'describe-function-find-file - 'describe-symbol-find-file) - -(defun describe-function (function) - "Display the full documentation of FUNCTION (a symbol). -When run interactively, it defaults to any function found by -`function-at-point'." - (interactive - (let* ((fn (function-at-point)) - (val (let ((enable-recursive-minibuffers t)) - (completing-read - (if fn - (format (gettext "Describe function (default %s): ") - fn) - (gettext "Describe function: ")) - obarray 'fboundp t nil 'function-history)))) - (list (if (equal val "") fn (intern val))))) - (with-displaying-help-buffer - (lambda () - (describe-function-1 function) - ;; Return the text we displayed. - (buffer-string nil nil standard-output)) - (format "function `%s'" function))) - -(defun function-obsolete-p (function) - "Return non-nil if FUNCTION is obsolete." - (not (null (get function 'byte-obsolete-info)))) - -(defun function-obsoleteness-doc (function) - "If FUNCTION is obsolete, return a string describing this." - (let ((obsolete (get function 'byte-obsolete-info))) - (if obsolete - (format "Obsolete; %s" - (if (stringp (car obsolete)) - (car obsolete) - (format "use `%s' instead." (car obsolete))))))) - -(defun function-compatible-p (function) - "Return non-nil if FUNCTION is present for Emacs compatibility." - (not (null (get function 'byte-compatible-info)))) - -(defun function-compatibility-doc (function) - "If FUNCTION is Emacs compatible, return a string describing this." - (let ((compatible (get function 'byte-compatible-info))) - (if compatible - (format "Emacs Compatible; %s" - (if (stringp (car compatible)) - (car compatible) - (format "use `%s' instead." (car compatible))))))) - -;Here are all the possibilities below spelled out, for the benefit -;of the I18N3 snarfer. -; -;(gettext "a built-in function") -;(gettext "an interactive built-in function") -;(gettext "a built-in macro") -;(gettext "an interactive built-in macro") -;(gettext "a compiled Lisp function") -;(gettext "an interactive compiled Lisp function") -;(gettext "a compiled Lisp macro") -;(gettext "an interactive compiled Lisp macro") -;(gettext "a Lisp function") -;(gettext "an interactive Lisp function") -;(gettext "a Lisp macro") -;(gettext "an interactive Lisp macro") -;(gettext "a mocklisp function") -;(gettext "an interactive mocklisp function") -;(gettext "a mocklisp macro") -;(gettext "an interactive mocklisp macro") -;(gettext "an autoloaded Lisp function") -;(gettext "an interactive autoloaded Lisp function") -;(gettext "an autoloaded Lisp macro") -;(gettext "an interactive autoloaded Lisp macro") - -;; taken out of `describe-function-1' -(defun function-arglist (function) - "Return a string giving the argument list of FUNCTION. -For example: - - (function-arglist 'function-arglist) - => (function-arglist FUNCTION) - -This function is used by `describe-function-1' to list function -arguments in the standard Lisp style." - (let* ((fndef (indirect-function function)) - (arglist - (cond ((compiled-function-p fndef) - (compiled-function-arglist fndef)) - ((eq (car-safe fndef) 'lambda) - (nth 1 fndef)) - ((subrp fndef) - (let* ((doc (documentation function)) - (args (and (string-match - "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" - doc) - (match-string 1 doc)))) - ;; If there are no arguments documented for the - ;; subr, rather don't print anything. - (cond ((null args) t) - ((equal args "") nil) - (args)))) - (t t)))) - (cond ((listp arglist) - (prin1-to-string - (cons function (mapcar (lambda (arg) - (if (memq arg '(&optional &rest)) - arg - (intern (upcase (symbol-name arg))))) - arglist)) - t)) - ((stringp arglist) - (format "(%s %s)" function arglist))))) - -(defun function-documentation (function &optional strip-arglist) - "Return a string giving the documentation for FUNCTION, if any. -If the optional argument STRIP-ARGLIST is non-nil, remove the arglist -part of the documentation of internal subroutines." - (let ((doc (condition-case nil - (or (documentation function) - (gettext "not documented")) - (void-function "")))) - (if (and strip-arglist - (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc)) - (setq doc (substring doc 0 (match-beginning 0)))) - doc)) - -(defun describe-function-1 (function &optional nodoc) - "This function does the work for `describe-function'." - (princ (format "`%s' is " function)) - (let* ((def function) - aliases file-name autoload-file kbd-macro-p fndef macrop) - (while (and (symbolp def) (fboundp def)) - (when (not (eq def function)) - (setq aliases - (if aliases - ;; I18N3 Need gettext due to concat - (concat aliases - (format - "\n which is an alias for `%s', " - (symbol-name def))) - (format "an alias for `%s', " (symbol-name def))))) - (setq def (symbol-function def))) - (if (and (fboundp 'compiled-function-annotation) - (compiled-function-p def)) - (setq file-name (compiled-function-annotation def))) - (if (eq 'macro (car-safe def)) - (setq fndef (cdr def) - file-name (and (compiled-function-p (cdr def)) - (fboundp 'compiled-function-annotation) - (compiled-function-annotation (cdr def))) - macrop t) - (setq fndef def)) - (if aliases (princ aliases)) - (let ((int #'(lambda (string an-p macro-p) - (princ (format - (gettext (concat - (cond ((commandp def) - "an interactive ") - (an-p "an ") - (t "a ")) - "%s" - (if macro-p " macro" " function"))) - string))))) - (cond ((or (stringp def) (vectorp def)) - (princ "a keyboard macro.") - (setq kbd-macro-p t)) - ((subrp fndef) - (funcall int "built-in" nil macrop)) - ((compiled-function-p fndef) - (funcall int "compiled Lisp" nil macrop)) - ((eq (car-safe fndef) 'lambda) - (funcall int "Lisp" nil macrop)) - ((eq (car-safe fndef) 'mocklisp) - (funcall int "mocklisp" nil macrop)) - ((eq (car-safe def) 'autoload) - (setq autoload-file (elt def 1)) - (funcall int "autoloaded Lisp" t (elt def 4))) - ((and (symbolp def) (not (fboundp def))) - (princ "a symbol with a void (unbound) function definition.")) - (t - nil))) - (princ "\n") - (if autoload-file - (princ (format " -- autoloads from \"%s\"\n" autoload-file))) - (or file-name - (setq file-name (describe-symbol-find-file function))) - (if file-name - (princ (format " -- loaded from \"%s\"\n" file-name))) -;; (terpri) - (if describe-function-show-arglist - (let ((arglist (function-arglist function))) - (when arglist - (princ arglist) - (terpri)))) - (terpri) - (cond (kbd-macro-p - (princ "These characters are executed:\n\n\t") - (princ (key-description def)) - (cond ((setq def (key-binding def)) - (princ (format "\n\nwhich executes the command `%s'.\n\n" - def)) - (describe-function-1 def)))) - (nodoc nil) - (t - ;; tell the user about obsoleteness. - ;; If the function is obsolete and is aliased, don't - ;; even bother to report the documentation, as a further - ;; encouragement to use the new function. - (let ((obsolete (function-obsoleteness-doc function)) - (compatible (function-compatibility-doc function))) - (when obsolete - (princ obsolete) - (terpri) - (terpri)) - (when compatible - (princ compatible) - (terpri) - (terpri)) - (unless (and obsolete aliases) - (let ((doc (function-documentation function t))) - (princ "Documentation:\n") - (princ doc) - (unless (or (equal doc "") - (eq ?\n (aref doc (1- (length doc))))) - (terpri))))))))) - - -;;; [Obnoxious, whining people who complain very LOUDLY on Usenet -;;; are binding this to keys.] -(defun describe-function-arglist (function) - (interactive (list (or (function-at-point) - (error "no function call at point")))) - (message nil) - (message (function-arglist function))) - - -(defun variable-at-point () - (ignore-errors - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (char-after (point))) ?w) - (eq (char-syntax (char-after (point))) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (boundp obj) obj)))))) - -(defun variable-obsolete-p (variable) - "Return non-nil if VARIABLE is obsolete." - (not (null (get variable 'byte-obsolete-variable)))) - -(defun variable-obsoleteness-doc (variable) - "If VARIABLE is obsolete, return a string describing this." - (let ((obsolete (get variable 'byte-obsolete-variable))) - (if obsolete - (format "Obsolete; %s" - (if (stringp obsolete) - obsolete - (format "use `%s' instead." obsolete)))))) - -(defun variable-compatible-p (variable) - "Return non-nil if VARIABLE is Emacs compatible." - (not (null (get variable 'byte-compatible-variable)))) - -(defun variable-compatibility-doc (variable) - "If VARIABLE is Emacs compatible, return a string describing this." - (let ((compatible (get variable 'byte-compatible-variable))) - (if compatible - (format "Emacs Compatible; %s" - (if (stringp compatible) - compatible - (format "use `%s' instead." compatible)))))) - -(defun built-in-variable-doc (variable) - "Return a string describing whether VARIABLE is built-in." - (let ((type (built-in-variable-type variable))) - (case type - (integer "a built-in integer variable") - (const-integer "a built-in constant integer variable") - (boolean "a built-in boolean variable") - (const-boolean "a built-in constant boolean variable") - (object "a simple built-in variable") - (const-object "a simple built-in constant variable") - (const-specifier "a built-in constant specifier variable") - (current-buffer "a built-in buffer-local variable") - (const-current-buffer "a built-in constant buffer-local variable") - (default-buffer "a built-in default buffer-local variable") - (selected-console "a built-in console-local variable") - (const-selected-console "a built-in constant console-local variable") - (default-console "a built-in default console-local variable") - (t - (if type "an unknown type of built-in variable?" - "a variable declared in Lisp"))))) - -(defun describe-variable (variable) - "Display the full documentation of VARIABLE (a symbol)." - (interactive - (let* ((v (variable-at-point)) - (val (let ((enable-recursive-minibuffers t)) - (completing-read - (if v - (format "Describe variable (default %s): " v) - (gettext "Describe variable: ")) - obarray 'boundp t nil 'variable-history)))) - (list (if (equal val "") v (intern val))))) - (with-displaying-help-buffer - (lambda () - (let ((origvar variable) - aliases) - (let ((print-escape-newlines t)) - (princ (format "`%s' is " (symbol-name variable))) - (while (variable-alias variable) - (let ((newvar (variable-alias variable))) - (if aliases - ;; I18N3 Need gettext due to concat - (setq aliases - (concat aliases - (format "\n which is an alias for `%s'," - (symbol-name newvar)))) - (setq aliases - (format "an alias for `%s'," - (symbol-name newvar)))) - (setq variable newvar))) - (if aliases - (princ (format "%s" aliases))) - (princ (built-in-variable-doc variable)) - (princ ".\n") - (let ((file-name (describe-symbol-find-file variable))) - (if file-name - (princ (format " -- loaded from \"%s\"\n" file-name)))) - (princ "\nValue: ") - (if (not (boundp variable)) - (princ "void\n") - (prin1 (symbol-value variable)) - (terpri)) - (terpri) - (cond ((local-variable-p variable (current-buffer)) - (let* ((void (cons nil nil)) - (def (condition-case nil - (default-value variable) - (error void)))) - (princ "This value is specific to the current buffer.\n") - (if (local-variable-p variable nil) - (princ "(Its value is local to each buffer.)\n")) - (terpri) - (if (if (eq def void) - (boundp variable) - (not (eq (symbol-value variable) def))) - ;; #### I18N3 doesn't localize properly! - (progn (princ "Default-value: ") - (if (eq def void) - (princ "void\n") - (prin1 def) - (terpri)) - (terpri))))) - ((local-variable-p variable (current-buffer) t) - (princ "Setting it would make its value buffer-local.\n\n")))) - (princ "Documentation:") - (terpri) - (let ((doc (documentation-property variable 'variable-documentation)) - (obsolete (variable-obsoleteness-doc origvar)) - (compatible (variable-compatibility-doc origvar))) - (when obsolete - (princ obsolete) - (terpri) - (terpri)) - (when compatible - (princ compatible) - (terpri) - (terpri)) - ;; don't bother to print anything if variable is obsolete and aliased. - (when (or (not obsolete) (not aliases)) - (if doc - ;; note: documentation-property calls substitute-command-keys. - (princ doc) - (princ "not documented as a variable.")))) - (terpri))) - (format "variable `%s'" variable))) - -(defun sorted-key-descriptions (keys &optional separator) - "Sort and separate the key descriptions for KEYS. -The sorting is done by length (shortest bindings first), and the bindings -are separated with SEPARATOR (\", \" by default)." - (mapconcat 'key-description - (sort keys #'(lambda (x y) - (< (length x) (length y)))) - (or separator ", "))) - -(defun where-is (definition &optional insert) - "Print message listing key sequences that invoke specified command. -Argument is a command definition, usually a symbol with a function definition. -When run interactively, it defaults to any function found by -`function-at-point'. -If INSERT (the prefix arg) is non-nil, insert the message in the buffer." - (interactive - (let ((fn (function-at-point)) - (enable-recursive-minibuffers t) - val) - (setq val (read-command - (if fn (format "Where is command (default %s): " fn) - "Where is command: "))) - (list (if (equal (symbol-name val) "") - fn val) - current-prefix-arg))) - (let ((keys (where-is-internal definition))) - (if keys - (if insert - (princ (format "%s (%s)" (sorted-key-descriptions keys) - definition) (current-buffer)) - (message "%s is on %s" definition (sorted-key-descriptions keys))) - (if insert - (princ (format (if (commandp definition) "M-x %s RET" - "M-: (%s ...)") definition) (current-buffer)) - (message "%s is not on any keys" definition)))) - nil) - -;; `locate-library' moved to "packages.el" - - -;; Functions ported from C into Lisp in XEmacs - -(defun describe-syntax () - "Describe the syntax specifications in the syntax table. -The descriptions are inserted in a buffer, which is then displayed." - (interactive) - (with-displaying-help-buffer - (lambda () - ;; defined in syntax.el - (describe-syntax-table (syntax-table) standard-output)) - (format "syntax-table for %s" major-mode))) - -(defun list-processes () - "Display a list of all processes. -\(Any processes listed as Exited or Signaled are actually eliminated -after the listing is made.)" - (interactive) - (with-output-to-temp-buffer "*Process List*" - (set-buffer standard-output) - (buffer-disable-undo standard-output) - (make-local-variable 'truncate-lines) - (setq truncate-lines t) - ;; 00000000001111111111222222222233333333334444444444 - ;; 01234567890123456789012345678901234567890123456789 - ;; rewritten for I18N3. This one should stay rewritten - ;; so that the dashes will line up properly. - (princ "Proc Status Buffer Tty Command\n---- ------ ------ --- -------\n") - (let ((tail (process-list))) - (while tail - (let* ((p (car tail)) - (pid (process-id p)) - (s (process-status p))) - (setq tail (cdr tail)) - (princ (format "%-13s" (process-name p))) - (princ s) - (if (and (eq s 'exit) (/= (process-exit-status p) 0)) - (princ (format " %d" (process-exit-status p)))) - (if (memq s '(signal exit closed)) - ;; Do delete-exited-processes' work - (delete-process p)) - (indent-to 22 1) ;#### - (let ((b (process-buffer p))) - (cond ((not b) - (princ "(none)")) - ((not (buffer-name b)) - (princ "(killed)")) - (t - (princ (buffer-name b))))) - (indent-to 37 1) ;#### - (let ((tn (process-tty-name p))) - (cond ((not tn) - (princ "(none)")) - (t - (princ (format "%s" tn))))) - (indent-to 49 1) ;#### - (if (not (integerp pid)) - (progn - (princ "network stream connection ") - (princ (car pid)) - (princ "@") - (princ (cdr pid))) - (let ((cmd (process-command p))) - (while cmd - (princ (car cmd)) - (setq cmd (cdr cmd)) - (if cmd (princ " "))))) - (terpri)))))) - -;; Stop gap for 21.0 untill we do help-char etc properly. -(defun help-keymap-with-help-key (keymap form) - "Return a copy of KEYMAP with an help-key binding according to help-char - invoking FORM like help-form. An existing binding is not overridden. - If FORM is nil then no binding is made." - (let ((map (copy-keymap keymap)) - (key (if (characterp help-char) - (vector (character-to-event help-char)) - help-char))) - (when (and form key (not (lookup-key map key))) - (define-key map key - `(lambda () (interactive) (help-print-help-form ,form)))) - map)) - -(defun help-print-help-form (form) - (let ((string (eval form))) - (if (stringp string) - (with-displaying-help-buffer - (insert string))))) - - -;;; help.el ends here diff --git a/lisp/hyper-apropos.el b/lisp/hyper-apropos.el deleted file mode 100644 index 1e34bfa..0000000 --- a/lisp/hyper-apropos.el +++ /dev/null @@ -1,1311 +0,0 @@ -;;; hyper-apropos.el --- Hypertext emacs lisp documentation interface. - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1996 Ben Wing. - -;; Maintainer: Jonathan Stigelman -;; Keywords: lisp, tools, help, docs, 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 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: - -;; based upon emacs-apropos.el by Frank C. Guida -;; -;; Rather than run apropos and print all the documentation at once, -;; I find it easier to view a "table of contents" first, then -;; get the details for symbols as you need them. -;; -;; This version of apropos prints two lists of symbols matching the -;; given regexp: functions/macros and variables/constants. -;; -;; The user can then do the following: -;; -;; - add an additional regexp to narrow the search -;; - display documentation for the current symbol -;; - find the tag for the current symbol -;; - show any keybindings if the current symbol is a command -;; - invoke functions -;; - set variables -;; -;; An additional feature is the ability to search the current tags -;; table, allowing you to interrogate functions not yet loaded (this -;; isn't available with the standard package). -;; -;; Mouse bindings and menus are provided for XEmacs. -;; -;; additions by Ben Wing July 1995: -;; added support for function aliases, made programmer's apropos be the -;; default, various other hacking. -;; Massive changes by Christoph Wedler -;; Some changes for XEmacs 20.3 by hniksic - -;; ### The maintainer is supposed to be stig, but I haven't seen him -;; around for ages. The real maintainer for the moment is Hrvoje -;; Niksic . - -;;; Code: - -(defgroup hyper-apropos nil - "Hypertext emacs lisp documentation interface." - :group 'docs - :group 'lisp - :group 'tools - :group 'help - :group 'matching) - -(defcustom hyper-apropos-show-brief-docs t - "*If non-nil, display some documentation in the \"*Hyper Apropos*\" buffer. -Setting this to nil will speed up searches." - :type 'boolean - :group 'hyper-apropos) -(define-obsolete-variable-alias - 'hypropos-show-brief-docs 'hyper-apropos-show-brief-docs) -;; I changed this to true because I think it's more useful this way. --ben - -(defcustom hyper-apropos-programming-apropos t - "*If non-nil, list all the functions and variables. -This will cause more output to be generated, and take a longer time. - -Otherwise, only the interactive functions and user variables will be listed." - :type 'boolean - :group 'hyper-apropos) -(define-obsolete-variable-alias - 'hypropos-programming-apropos 'hyper-apropos-programming-apropos) - -(defcustom hyper-apropos-shrink-window nil - "*If non-nil, shrink *Hyper Help* buffer if possible." - :type 'boolean - :group 'hyper-apropos) -(define-obsolete-variable-alias - 'hypropos-shrink-window 'hyper-apropos-shrink-window) - -(defcustom hyper-apropos-prettyprint-long-values t - "*If non-nil, then try to beautify the printing of very long values." - :type 'boolean - :group 'hyper-apropos) -(define-obsolete-variable-alias - 'hypropos-prettyprint-long-values 'hyper-apropos-prettyprint-long-values) - -(defgroup hyper-apropos-faces nil - "Faces defined by hyper-apropos." - :prefix "hyper-apropos-" - :group 'faces) - -(defface hyper-apropos-documentation - '((((class color) (background light)) - (:foreground "darkred")) - (((class color) (background dark)) - (:foreground "gray90"))) - "Hyper-apropos documentation." - :group 'hyper-apropos-faces) - -(defface hyper-apropos-hyperlink - '((((class color) (background light)) - (:foreground "blue4")) - (((class color) (background dark)) - (:foreground "lightseagreen")) - (t - (:bold t))) - "Hyper-apropos hyperlinks." - :group 'hyper-apropos-faces) - -(defface hyper-apropos-major-heading '((t (:bold t))) - "Hyper-apropos major heading." - :group 'hyper-apropos-faces) - -(defface hyper-apropos-section-heading '((t (:bold t :italic t))) - "Hyper-apropos section heading." - :group 'hyper-apropos-faces) - -(defface hyper-apropos-heading '((t (:bold t))) - "Hyper-apropos heading." - :group 'hyper-apropos-faces) - -(defface hyper-apropos-warning '((t (:bold t :foreground "red"))) - "Hyper-apropos warning." - :group 'hyper-apropos-faces) - -;;; Internal variables below this point - -(defvar hyper-apropos-ref-buffer) -(defvar hyper-apropos-prev-wconfig) - -(defvar hyper-apropos-help-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (set-keymap-name map 'hyper-apropos-help-map) - ;; movement - (define-key map " " 'scroll-up) - (define-key map "b" 'scroll-down) - (define-key map [delete] 'scroll-down) - (define-key map [backspace] 'scroll-down) - (define-key map "/" 'isearch-forward) - (define-key map "?" 'isearch-backward) - ;; follow links - (define-key map [return] 'hyper-apropos-get-doc) - (define-key map "s" 'hyper-apropos-set-variable) - (define-key map "t" 'hyper-apropos-find-tag) - (define-key map "l" 'hyper-apropos-last-help) - (define-key map "c" 'hyper-apropos-customize-variable) - (define-key map "f" 'hyper-apropos-find-function) - (define-key map [button2] 'hyper-apropos-mouse-get-doc) - (define-key map [button3] 'hyper-apropos-popup-menu) - ;; for the totally hardcore... - (define-key map "D" 'hyper-apropos-disassemble) - ;; administrativa - (define-key map "a" 'hyper-apropos) - (define-key map "n" 'hyper-apropos) - (define-key map "q" 'hyper-apropos-quit) - map) - "Keybindings for the *Hyper Help* buffer and the *Hyper Apropos* buffer") -(define-obsolete-variable-alias - 'hypropos-help-map 'hyper-apropos-help-map) - -(defvar hyper-apropos-map - (let ((map (make-sparse-keymap))) - (set-keymap-name map 'hyper-apropos-map) - (set-keymap-parents map (list hyper-apropos-help-map)) - ;; slightly different scrolling... - (define-key map " " 'hyper-apropos-scroll-up) - (define-key map "b" 'hyper-apropos-scroll-down) - (define-key map [delete] 'hyper-apropos-scroll-down) - (define-key map [backspace] 'hyper-apropos-scroll-down) - ;; act on the current line... - (define-key map "w" 'hyper-apropos-where-is) - (define-key map "i" 'hyper-apropos-invoke-fn) -;; this is already defined in the parent-keymap above, isn't it? -;; (define-key map "s" 'hyper-apropos-set-variable) - ;; more administrativa... - (define-key map "P" 'hyper-apropos-toggle-programming-flag) - (define-key map "k" 'hyper-apropos-add-keyword) - (define-key map "e" 'hyper-apropos-eliminate-keyword) - map) - "Keybindings for the *Hyper Apropos* buffer. -This map inherits from `hyper-apropos-help-map.'") -(define-obsolete-variable-alias - 'hypropos-map 'hyper-apropos-map) - -;;(defvar hyper-apropos-mousable-keymap -;; (let ((map (make-sparse-keymap))) -;; (define-key map [button2] 'hyper-apropos-mouse-get-doc) -;; map)) - -(defvar hyper-apropos-mode-hook nil - "*User function run after hyper-apropos mode initialization. Usage: -\(add-hook 'hyper-apropos-mode-hook #'(lambda () ... your init forms ...)).") - -;; ---------------------------------------------------------------------- ;; - -(defconst hyper-apropos-junk-regexp - "^Apropos\\|^Functions\\|^Variables\\|^$") - -(defvar hyper-apropos-currently-showing nil) ; symbol documented in - ; help buffer now -(defvar hyper-apropos-help-history nil) ; chain of symbols followed as links in - ; help buffer -(defvar hyper-apropos-face-history nil) -;;;(defvar hyper-apropos-variable-history nil) -;;;(defvar hyper-apropos-function-history nil) -(defvar hyper-apropos-regexp-history nil) -(defvar hyper-apropos-last-regexp nil) ; regex used for last apropos -(defconst hyper-apropos-apropos-buf "*Hyper Apropos*") -(defconst hyper-apropos-help-buf "*Hyper Help*") - -;;;###autoload -(defun hyper-apropos (regexp toggle-apropos) - "Display lists of functions and variables matching REGEXP -in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the -value of `hyper-apropos-programming-apropos' is toggled for this search. -See also `hyper-apropos-mode'." - (interactive (list (read-from-minibuffer "List symbols matching regexp: " - nil nil nil 'hyper-apropos-regexp-history) - current-prefix-arg)) - (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) - (setq hyper-apropos-prev-wconfig (current-window-configuration))) - (if (string= "" regexp) - (if (get-buffer hyper-apropos-apropos-buf) - (if toggle-apropos - (hyper-apropos-toggle-programming-flag) - (message "Using last search results")) - (error "Be more specific...")) - (set-buffer (get-buffer-create hyper-apropos-apropos-buf)) - (setq buffer-read-only nil) - (erase-buffer) - (if toggle-apropos - (set (make-local-variable 'hyper-apropos-programming-apropos) - (not (default-value 'hyper-apropos-programming-apropos)))) - (let ((flist (apropos-internal regexp - (if hyper-apropos-programming-apropos - #'fboundp - #'commandp))) - (vlist (apropos-internal regexp - (if hyper-apropos-programming-apropos - #'boundp - #'user-variable-p)))) - (insert-face (format "Apropos search for: %S\n\n" regexp) - 'hyper-apropos-major-heading) - (insert-face "* = command (M-x) or user-variable.\n" - 'hyper-apropos-documentation) - (insert-face "\ -a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro.\n\n" - 'hyper-apropos-documentation) - (insert-face "Functions and Macros:\n\n" 'hyper-apropos-major-heading) - (hyper-apropos-grok-functions flist) - (insert-face "\n\nVariables and Constants:\n\n" - 'hyper-apropos-major-heading) - (hyper-apropos-grok-variables vlist) - (goto-char (point-min)))) - (switch-to-buffer hyper-apropos-apropos-buf) - (hyper-apropos-mode regexp)) - -(defun hyper-apropos-toggle-programming-flag () - (interactive) - (with-current-buffer hyper-apropos-apropos-buf - (set (make-local-variable 'hyper-apropos-programming-apropos) - (not hyper-apropos-programming-apropos))) - (message "Re-running apropos...") - (hyper-apropos hyper-apropos-last-regexp nil)) - -(defun hyper-apropos-grok-functions (fns) - (let (bind doc type) - (dolist (fn fns) - (setq bind (symbol-function fn) - type (cond ((subrp bind) ?i) - ((compiled-function-p bind) ?b) - ((consp bind) (or (cdr - (assq (car bind) '((autoload . ?a) - (lambda . ?l) - (macro . ?m)))) - ??)) - (t ?\ ))) - (insert type (if (commandp fn) "* " " ")) - (let ((e (insert-face (format "%S" fn) 'hyper-apropos-hyperlink))) - (set-extent-property e 'mouse-face 'highlight)) - (insert-char ?\ (let ((l (- 30 (length (format "%S" fn))))) - (if (natnump l) l 0))) - (and hyper-apropos-show-brief-docs - (setq doc - ;; A symbol's function slot can point to an unbound symbol. - ;; In that case, `documentation' will fail. - (ignore-errors - (documentation fn))) - (if (string-match - "^([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" - doc) - (setq doc (substring doc (match-end 0) (string-match "\n" doc))) - t) - (insert-face (if doc - (concat " - " - (substring doc 0 (string-match "\n" doc))) - " Not documented.") - 'hyper-apropos-documentation)) - (insert ?\n)))) - -(defun hyper-apropos-grok-variables (vars) - (let (doc userp) - (dolist (var vars) - (setq userp (user-variable-p var)) - (insert (if userp " * " " ")) - (let ((e (insert-face (format "%S" var) 'hyper-apropos-hyperlink))) - (set-extent-property e 'mouse-face 'highlight)) - (insert-char ?\ (let ((l (- 30 (length (format "%S" var))))) - (if (natnump l) l 0))) - (and hyper-apropos-show-brief-docs - (setq doc (documentation-property var 'variable-documentation)) - (insert-face (if doc - (concat " - " (substring doc (if userp 1 0) - (string-match "\n" doc))) - " - Not documented.") - 'hyper-apropos-documentation)) - (insert ?\n)))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-mode (regexp) - "Improved apropos mode for displaying Emacs documentation. Function and -variable names are displayed in the buffer \"*Hyper Apropos*\". - -Functions are preceded by a single character to indicates their types: - a = autoloaded, b = byte-compiled, i = internal, l = lambda, m = macro. -Interactive functions are also preceded by an asterisk. -Variables are preceded by an asterisk if they are user variables. - -General Commands: - - SPC - scroll documentation or apropos window forward - b - scroll documentation or apropos window backward - k - eliminate all hits that don't contain keyword - n - new search - / - isearch-forward - q - quit and restore previous window configuration - - Operations for Symbol on Current Line: - - RET - toggle display of symbol's documentation - (also on button2 in xemacs) - w - show the keybinding if symbol is a command - i - invoke function on current line - s - set value of variable on current line - t - display the C or lisp source (find-tag)" - (delete-other-windows) - (setq mode-name "Hyper-Apropos" - major-mode 'hyper-apropos-mode - buffer-read-only t - truncate-lines t - hyper-apropos-last-regexp regexp - modeline-buffer-identification - (list (cons modeline-buffer-id-left-extent "Hyper Apropos: ") - (cons modeline-buffer-id-right-extent (concat "\"" regexp "\"")))) - (use-local-map hyper-apropos-map) - (run-hooks 'hyper-apropos-mode-hook)) - -;; ---------------------------------------------------------------------- ;; - -;; similar to `describe-key-briefly', copied from help.el by CW - -;;;###autoload -(defun hyper-describe-key (key) - (interactive "kDescribe key: ") - (hyper-describe-key-briefly key t)) - -;;;###autoload -(defun hyper-describe-key-briefly (key &optional show) - (interactive "kDescribe key briefly: \nP") - (let (menup defn interm final msg) - (setq defn (key-or-menu-binding key 'menup)) - (if (or (null defn) (integerp defn)) - (or (numberp show) (message "%s is undefined" (key-description key))) - (cond ((stringp defn) - (setq interm defn - final (key-binding defn))) - ((vectorp defn) - (setq interm (append defn nil)) - (while (and interm - (member (key-binding (vector (car interm))) - '(universal-argument digit-argument))) - (setq interm (cdr interm))) - (while (and interm - (not (setq final (key-binding (vconcat interm))))) - (setq interm (butlast interm))) - (if final - (setq interm (vconcat interm)) - (setq interm defn - final (key-binding defn))))) - (setq msg (format - "%s runs %s%s%s" - ;; This used to say 'This menu item' but it could also - ;; be a scrollbar event. We can't distinguish at the - ;; moment. - (if menup "This item" (key-description key)) - ;;(if (symbolp defn) defn (key-description defn)) - (if (symbolp defn) defn (prin1-to-string defn)) - (if final (concat ", " (key-description interm) " runs ") "") - (if final - (if (symbolp final) final (prin1-to-string final)) - ""))) - (if (numberp show) - (or (not (symbolp defn)) - (memq (symbol-function defn) - '(zkey-init-kbd-macro zkey-init-kbd-fn)) - (progn (princ msg) (princ "\n"))) - (message "%s" msg) - (if final (setq defn final)) - (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn)))) - defn - show) - (hyper-apropos-get-doc defn t)))))) - -;;;###autoload -(defun hyper-describe-face (symbol &optional this-ref-buffer) - "Describe face.. -See also `hyper-apropos' and `hyper-describe-function'." - ;; #### - perhaps a prefix arg should suppress the prompt... - (interactive - (let (v val) - (setq v (hyper-apropos-this-symbol)) ; symbol under point - (or (find-face v) - (setq v (variable-at-point))) - (setq val (let ((enable-recursive-minibuffers t)) - (completing-read - (concat (if (hyper-apropos-follow-ref-buffer current-prefix-arg) - "Follow face" - "Describe face") - (if v - (format " (default %s): " v) - ": ")) - (mapcar #'(lambda (x) (list (symbol-name x))) - (face-list)) - nil t nil 'hyper-apropos-face-history))) - (list (if (string= val "") - (progn (push (symbol-name v) hyper-apropos-face-history) v) - (intern-soft val)) - current-prefix-arg))) - (if (null symbol) - (message "Sorry, nothing to describe.") - (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) - (setq hyper-apropos-prev-wconfig (current-window-configuration))) - (hyper-apropos-get-doc symbol t nil this-ref-buffer))) - -;;;###autoload -(defun hyper-describe-variable (symbol &optional this-ref-buffer) - "Hypertext drop-in replacement for `describe-variable'. -See also `hyper-apropos' and `hyper-describe-function'." - ;; #### - perhaps a prefix arg should suppress the prompt... - (interactive (list (hyper-apropos-read-variable-symbol - (if (hyper-apropos-follow-ref-buffer current-prefix-arg) - "Follow variable" - "Describe variable")) - current-prefix-arg)) - (if (null symbol) - (message "Sorry, nothing to describe.") - (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) - (setq hyper-apropos-prev-wconfig (current-window-configuration))) - (hyper-apropos-get-doc symbol t nil this-ref-buffer))) - -;;;###autoload -(defun hyper-where-is (symbol) - "Print message listing key sequences that invoke specified command." - (interactive (list (hyper-apropos-read-function-symbol "Where is function"))) - (if (null symbol) - (message "Sorry, nothing to describe.") - (where-is symbol))) - -;;;###autoload -(defun hyper-describe-function (symbol &optional this-ref-buffer) - "Hypertext replacement for `describe-function'. Unlike `describe-function' -in that the symbol under the cursor is the default if it is a function. -See also `hyper-apropos' and `hyper-describe-variable'." - ;; #### - perhaps a prefix arg should suppress the prompt... - (interactive (list (hyper-apropos-read-function-symbol - (if (hyper-apropos-follow-ref-buffer current-prefix-arg) - "Follow function" - "Describe function")) - current-prefix-arg)) - (if (null symbol) - (message "Sorry, nothing to describe.") - (or (memq major-mode '(hyper-apropos-mode hyper-apropos-help-mode)) - (setq hyper-apropos-prev-wconfig (current-window-configuration))) - (hyper-apropos-get-doc symbol t nil this-ref-buffer))) - -;;;###autoload -(defun hyper-apropos-read-variable-symbol (prompt &optional predicate) - "Hypertext drop-in replacement for `describe-variable'. -See also `hyper-apropos' and `hyper-describe-function'." - ;; #### - perhaps a prefix arg should suppress the prompt... - (or predicate (setq predicate 'boundp)) - (let (v val) - (setq v (hyper-apropos-this-symbol)) ; symbol under point - (or (funcall predicate v) - (setq v (variable-at-point))) - (or (funcall predicate v) - (setq v nil)) - (setq val (let ((enable-recursive-minibuffers t)) - (completing-read - (concat prompt - (if v - (format " (default %s): " v) - ": ")) - obarray predicate t nil 'variable-history))) - (if (string= val "") - (progn (push (symbol-name v) variable-history) v) - (intern-soft val)))) -;;;###autoload -(define-obsolete-function-alias - 'hypropos-read-variable-symbol 'hyper-apropos-read-variable-symbol) - -(defun hyper-apropos-read-function-symbol (prompt) - "Read function symbol from minibuffer." - (let ((fn (hyper-apropos-this-symbol)) - val) - (or (fboundp fn) - (setq fn (function-at-point))) - (setq val (let ((enable-recursive-minibuffers t)) - (completing-read (if fn - (format "%s (default %s): " prompt fn) - (format "%s: " prompt)) - obarray 'fboundp t nil - 'function-history))) - (if (equal val "") - (progn (push (symbol-name fn) function-history) fn) - (intern-soft val)))) - -(defun hyper-apropos-last-help (arg) - "Go back to the last symbol documented in the *Hyper Help* buffer." - (interactive "P") - (let ((win (get-buffer-window hyper-apropos-help-buf))) - (or arg (setq arg (if win 1 0))) - (cond ((= arg 0)) - ((<= (length hyper-apropos-help-history) arg) - ;; go back as far as we can... - (setcdr (nreverse hyper-apropos-help-history) nil)) - (t - (setq hyper-apropos-help-history - (nthcdr arg hyper-apropos-help-history)))) - (if (or win (> arg 0)) - (hyper-apropos-get-doc (car hyper-apropos-help-history) t) - (display-buffer hyper-apropos-help-buf)))) - -(defun hyper-apropos-insert-face (string &optional face) - "Insert STRING and fontify some parts with face `hyper-apropos-hyperlink'." - (let ((beg (point)) end) - (insert-face string (or face 'hyper-apropos-documentation)) - (setq end (point)) - (goto-char beg) - (while (re-search-forward - "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" - end 'limit) - (let ((e (make-extent (match-beginning 1) (match-end 1)))) - (set-extent-face e 'hyper-apropos-hyperlink) - (set-extent-property e 'mouse-face 'highlight))) - (goto-char beg) - (while (re-search-forward - "M-x \\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)" - end 'limit) - (let ((e (make-extent (match-beginning 1) (match-end 1)))) - (set-extent-face e 'hyper-apropos-hyperlink) - (set-extent-property e 'mouse-face 'highlight))))) - -(defun hyper-apropos-insert-keybinding (keys string) - (if keys - (insert " (" string " bound to \"" - (mapconcat 'key-description - (sort* keys #'< :key #'length) - "\", \"") - "\")\n"))) - -(defun hyper-apropos-insert-section-heading (alias-desc &optional desc) - (or desc (setq desc alias-desc - alias-desc nil)) - (if alias-desc - (setq desc (concat alias-desc - (if (memq (aref desc 0) - '(?a ?e ?i ?o ?u)) - ", an " ", a ") - desc))) - (aset desc 0 (upcase (aref desc 0))) ; capitalize - (goto-char (point-max)) - (newline 3) (delete-blank-lines) (newline 2) - (hyper-apropos-insert-face desc 'hyper-apropos-section-heading)) - -(defun hyper-apropos-insert-value (string symbol val) - (insert-face string 'hyper-apropos-heading) - (insert (if (symbol-value symbol) - (if (or (null val) (eq val t) (integerp val)) - (prog1 - (symbol-value symbol) - (set symbol nil)) - "see below") - "is void"))) - -(defun hyper-apropos-follow-ref-buffer (this-ref-buffer) - (and (not this-ref-buffer) - (eq major-mode 'hyper-apropos-help-mode) - hyper-apropos-ref-buffer - (buffer-live-p hyper-apropos-ref-buffer))) - -(defun hyper-apropos-get-alias (symbol alias-p next-symbol &optional use) - "Return (TERMINAL-SYMBOL . ALIAS-DESC)." - (let (aliases) - (while (funcall alias-p symbol) - (setq aliases (cons (if use (funcall use symbol) symbol) aliases)) - (setq symbol (funcall next-symbol symbol))) - (cons symbol - (and aliases - (concat "an alias for `" - (mapconcat 'symbol-name - (nreverse aliases) - "',\nwhich is an alias for `") - "'"))))) - -(defun hyper-apropos-get-doc (&optional symbol force type this-ref-buffer) - ;; #### - update this docstring - "Toggle display of documentation for the symbol on the current line." - ;; SYMBOL is the symbol to document. FORCE, if non-nil, means to - ;; regenerate the documentation even if it already seems to be there. And - ;; TYPE, if present, forces the generation of only variable documentation - ;; or only function documentation. Normally, if both are present, then - ;; both will be generated. - ;; - ;; TYPES TO IMPLEMENT: obsolete face - ;; - (interactive) - (or symbol - (setq symbol (hyper-apropos-this-symbol))) - (or type - (setq type '(function variable face))) - (if (and (eq hyper-apropos-currently-showing symbol) - (get-buffer hyper-apropos-help-buf) - (get-buffer-window hyper-apropos-help-buf) - (not force)) - ;; we're already displaying this help, so toggle its display. - (delete-windows-on hyper-apropos-help-buf) - ;; OK, we've got to refresh and display it... - (or (eq symbol (car hyper-apropos-help-history)) - (setq hyper-apropos-help-history - (if (eq major-mode 'hyper-apropos-help-mode) - ;; if we're following a link in the help buffer, then - ;; record that in the help history. - (cons symbol hyper-apropos-help-history) - ;; otherwise clear the history because it's a new search. - (list symbol)))) - (save-excursion - (if (hyper-apropos-follow-ref-buffer this-ref-buffer) - (set-buffer hyper-apropos-ref-buffer) - (setq hyper-apropos-ref-buffer (current-buffer))) - (let (standard-output - ok beg - newsym symtype doc obsolete - (local mode-name) - global local-str global-str - font fore back undl - aliases alias-desc desc) - (save-excursion - (set-buffer (get-buffer-create hyper-apropos-help-buf)) - ;;(setq standard-output (current-buffer)) - (setq buffer-read-only nil) - (erase-buffer) - (insert-face (format "`%s'" symbol) 'hyper-apropos-major-heading) - (insert (format " (buffer: %s, mode: %s)\n" - (buffer-name hyper-apropos-ref-buffer) - local))) - ;; function ---------------------------------------------------------- - (and (memq 'function type) - (fboundp symbol) - (progn - (setq ok t) - (setq aliases (hyper-apropos-get-alias (symbol-function symbol) - 'symbolp - 'symbol-function) - newsym (car aliases) - alias-desc (cdr aliases)) - (if (eq 'macro (car-safe newsym)) - (setq desc "macro" - newsym (cdr newsym)) - (setq desc "function")) - (setq symtype (cond ((subrp newsym) 'subr) - ((compiled-function-p newsym) 'bytecode) - ((eq (car-safe newsym) 'autoload) 'autoload) - ((eq (car-safe newsym) 'lambda) 'lambda)) - desc (concat (if (commandp symbol) "interactive ") - (cdr (assq symtype - '((subr . "built-in ") - (bytecode . "compiled Lisp ") - (autoload . "autoloaded Lisp ") - (lambda . "Lisp ")))) - desc - (case symtype - ((autoload) (format ",\n(autoloaded from \"%s\")" - (nth 1 newsym))) - ((bytecode) (format ",\n(loaded from \"%s\")" - (symbol-file symbol))))) - local (current-local-map) - global (current-global-map) - obsolete (get symbol 'byte-obsolete-info) - doc (or (documentation symbol) "function not documented")) - (save-excursion - (set-buffer hyper-apropos-help-buf) - (goto-char (point-max)) - (setq standard-output (current-buffer)) - (hyper-apropos-insert-section-heading alias-desc desc) - (insert ":\n") - (if local - (hyper-apropos-insert-keybinding - (where-is-internal symbol (list local) nil nil nil) - "locally")) - (hyper-apropos-insert-keybinding - (where-is-internal symbol (list global) nil nil nil) - "globally") - (insert "\n") - (if obsolete - (hyper-apropos-insert-face - (format "%s is an obsolete function; %s\n\n" symbol - (if (stringp (car obsolete)) - (car obsolete) - (format "use `%s' instead." (car obsolete)))) - 'hyper-apropos-warning)) - (setq beg (point)) - (insert-face "arguments: " 'hyper-apropos-heading) - (cond ((eq symtype 'lambda) - (princ (or (nth 1 newsym) "()"))) - ((eq symtype 'bytecode) - (princ (or (compiled-function-arglist newsym) - "()"))) - ((and (eq symtype 'subr) - (string-match - "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" - doc)) - (insert (substring doc - (match-beginning 1) - (match-end 1))) - (setq doc (substring doc 0 (match-beginning 0)))) - ((and (eq symtype 'subr) - (string-match - "\ -\[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" - doc)) - (insert "(" - (if (match-end 1) - (substring doc - (match-beginning 1) - (match-end 1))) - ")") - (setq doc (substring doc (match-end 0)))) - (t (princ "[not available]"))) - (insert "\n\n") - (hyper-apropos-insert-face doc) - (insert "\n") - (indent-rigidly beg (point) 2)))) - ;; variable ---------------------------------------------------------- - (and (memq 'variable type) - (or (boundp symbol) (default-boundp symbol)) - (progn - (setq ok t) - (setq aliases (hyper-apropos-get-alias symbol - 'variable-alias - 'variable-alias - 'variable-alias) - newsym (car aliases) - alias-desc (cdr aliases)) - (setq symtype (or (local-variable-p newsym (current-buffer)) - (and (local-variable-p newsym - (current-buffer) t) - 'auto-local)) - desc (concat (and (get newsym 'custom-type) - "customizable ") - (if (user-variable-p newsym) - "user variable" - "variable") - (cond ((eq symtype t) ", buffer-local") - ((eq symtype 'auto-local) - ", local when set"))) - local (and (boundp newsym) - (symbol-value newsym)) - local-str (and (boundp newsym) - (prin1-to-string local)) - global (and (eq symtype t) - (default-boundp newsym) - (default-value newsym)) - global-str (and (eq symtype t) - (default-boundp newsym) - (prin1-to-string global)) - obsolete (get symbol 'byte-obsolete-variable) - doc (or (documentation-property symbol - 'variable-documentation) - "variable not documented")) - (save-excursion - (set-buffer hyper-apropos-help-buf) - (goto-char (point-max)) - (setq standard-output (current-buffer)) - (hyper-apropos-insert-section-heading alias-desc desc) - (when (and (user-variable-p newsym) - (get newsym 'custom-type)) - (let ((e (make-extent (point-at-bol) (point)))) - (set-extent-property e 'mouse-face 'highlight) - (set-extent-property e 'help-echo - (format "Customize %s" newsym)) - (set-extent-property - e 'hyper-apropos-custom - `(lambda () (customize-variable (quote ,newsym)))))) - (insert ":\n\n") - (setq beg (point)) - (if obsolete - (hyper-apropos-insert-face - (format "%s is an obsolete function; %s\n\n" symbol - (if (stringp obsolete) - obsolete - (format "use `%s' instead." obsolete))) - 'hyper-apropos-warning)) - ;; generally, the value of the variable is short and the - ;; documentation of the variable long, so it's desirable - ;; to see all of the value and the start of the - ;; documentation. Some variables, though, have huge and - ;; nearly meaningless values that force you to page - ;; forward just to find the doc string. That is - ;; undesirable. - (if (and (or (null local-str) (< (length local-str) 69)) - (or (null global-str) (< (length global-str) 69))) - ; 80 cols. docstrings assume this. - (progn (insert-face "value: " 'hyper-apropos-heading) - (insert (or local-str "is void")) - (if (eq symtype t) - (progn - (insert "\n") - (insert-face "default value: " 'hyper-apropos-heading) - (insert (or global-str "is void")))) - (insert "\n\n") - (hyper-apropos-insert-face doc)) - (hyper-apropos-insert-value "value: " 'local-str local) - (if (eq symtype t) - (progn - (insert ", ") - (hyper-apropos-insert-value "default-value: " - 'global-str global))) - (insert "\n\n") - (hyper-apropos-insert-face doc) - (if local-str - (progn - (newline 3) (delete-blank-lines) (newline 1) - (insert-face "value: " 'hyper-apropos-heading) - (if hyper-apropos-prettyprint-long-values - (condition-case nil - (cl-prettyprint local) - (error (insert local-str))) - (insert local-str)))) - (if global-str - (progn - (newline 3) (delete-blank-lines) (newline 1) - (insert-face "default value: " 'hyper-apropos-heading) - (if hyper-apropos-prettyprint-long-values - (condition-case nil - (cl-prettyprint global) - (error (insert global-str))) - (insert global-str))))) - (indent-rigidly beg (point) 2)))) - ;; face -------------------------------------------------------------- - (and (memq 'face type) - (find-face symbol) - (progn - (setq ok t) - (copy-face symbol 'hyper-apropos-temp-face 'global) - (mapcar #'(lambda (property) - (setq symtype (face-property-instance symbol - property)) - (if symtype - (set-face-property 'hyper-apropos-temp-face - property - symtype))) - built-in-face-specifiers) - (setq font (cons (face-property-instance symbol 'font nil 0 t) - (face-property-instance symbol 'font)) - fore (cons (face-foreground-instance symbol nil 0 t) - (face-foreground-instance symbol)) - back (cons (face-background-instance symbol nil 0 t) - (face-background-instance symbol)) - undl (cons (face-underline-p symbol nil 0 t) - (face-underline-p symbol)) - doc (face-doc-string symbol)) - ;; #### - add some code here - (save-excursion - (set-buffer hyper-apropos-help-buf) - (setq standard-output (current-buffer)) - (hyper-apropos-insert-section-heading - (concat "Face" - (when (get symbol 'face-defface-spec) - (let* ((str " (customizable)") - (e (make-extent 1 (length str) str))) - (set-extent-property e 'mouse-face 'highlight) - (set-extent-property e 'help-echo - (format "Customize %s" symbol)) - (set-extent-property e 'unique t) - (set-extent-property e 'duplicable t) - (set-extent-property - e 'hyper-apropos-custom - `(lambda () (customize-face (quote ,symbol)))) - str)) - ":\n\n ")) - (insert-face "\ -ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789" - 'hyper-apropos-temp-face) - (newline 2) - (insert-face " Font: " 'hyper-apropos-heading) - (insert (format (if (numberp (car font)) "(%s)\n" "%s\n") - (and (cdr font) - (font-instance-name (cdr font))))) - (insert-face " Foreground: " 'hyper-apropos-heading) - (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n") - (and (cdr fore) - (color-instance-name (cdr fore))))) - (insert-face " Background: " 'hyper-apropos-heading) - (insert (format (if (numberp (car back)) "(%s)\n" "%s\n") - (and (cdr back) - (color-instance-name (cdr back))))) - (insert-face " Underline: " 'hyper-apropos-heading) - (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n") - (cdr undl))) - (if doc - (progn - (newline) - (setq beg (point)) - (insert doc) - (indent-rigidly beg (point) 2)))))) - ;; not bound & property list ----------------------------------------- - (or ok - (save-excursion - (set-buffer hyper-apropos-help-buf) - (hyper-apropos-insert-section-heading - "symbol is not currently bound\n"))) - (if (and (setq symtype (symbol-plist symbol)) - (or (> (length symtype) 2) - (not (memq 'variable-documentation symtype)))) - (save-excursion - (set-buffer hyper-apropos-help-buf) - (goto-char (point-max)) - (setq standard-output (current-buffer)) - (hyper-apropos-insert-section-heading "property-list:\n\n") - (while symtype - (if (memq (car symtype) - '(variable-documentation byte-obsolete-info)) - (setq symtype (cdr symtype)) - (insert-face (concat " " (symbol-name (car symtype)) - ": ") - 'hyper-apropos-heading) - (setq symtype (cdr symtype)) - (indent-to 32) - (insert (prin1-to-string (car symtype)) "\n")) - (setq symtype (cdr symtype))))))) - (save-excursion - (set-buffer hyper-apropos-help-buf) - (goto-char (point-min)) - ;; pop up window and shrink it if it's wasting space - (if hyper-apropos-shrink-window - (shrink-window-if-larger-than-buffer - (display-buffer (current-buffer))) - (display-buffer (current-buffer))) - (hyper-apropos-help-mode)) - (setq hyper-apropos-currently-showing symbol))) -;;;###autoload -(define-obsolete-function-alias - 'hypropos-get-doc 'hyper-apropos-get-doc) - -; ----------------------------------------------------------------------------- - -(defun hyper-apropos-help-mode () - "Major mode for hypertext XEmacs help. In this mode, you can quickly -follow links between back and forth between the documentation strings for -different variables and functions. Common commands: - -\\{hyper-apropos-help-map}" - (setq buffer-read-only t - major-mode 'hyper-apropos-help-mode - mode-name "Hyper-Help") - (set-syntax-table emacs-lisp-mode-syntax-table) - (use-local-map hyper-apropos-help-map)) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-scroll-up () - "Scroll up the \"*Hyper Help*\" buffer if it's visible. -Otherwise, scroll the selected window up." - (interactive) - (let ((win (get-buffer-window hyper-apropos-help-buf)) - (owin (selected-window))) - (if win - (progn - (select-window win) - (condition-case nil - (scroll-up nil) - (error (goto-char (point-max)))) - (select-window owin)) - (scroll-up nil)))) - -(defun hyper-apropos-scroll-down () - "Scroll down the \"*Hyper Help*\" buffer if it's visible. -Otherwise, scroll the selected window down." - (interactive) - (let ((win (get-buffer-window hyper-apropos-help-buf)) - (owin (selected-window))) - (if win - (progn - (select-window win) - (condition-case nil - (scroll-down nil) - (error (goto-char (point-max)))) - (select-window owin)) - (scroll-down nil)))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-mouse-get-doc (event) - "Get the documentation for the symbol the mouse is on." - (interactive "e") - (mouse-set-point event) - (let ((e (extent-at (point) nil 'hyper-apropos-custom))) - (if e - (funcall (extent-property e 'hyper-apropos-custom)) - (save-excursion - (let ((symbol (hyper-apropos-this-symbol))) - (if symbol - (hyper-apropos-get-doc symbol) - (error "Click on a symbol"))))))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-add-keyword (pattern) - "Use additional keyword to narrow regexp match. -Deletes lines which don't match PATTERN." - (interactive "sAdditional Keyword: ") - (save-excursion - (goto-char (point-min)) - (let (buffer-read-only) - (keep-lines (concat pattern "\\|" hyper-apropos-junk-regexp)) - ))) - -(defun hyper-apropos-eliminate-keyword (pattern) - "Use additional keyword to eliminate uninteresting matches. -Deletes lines which match PATTERN." - (interactive "sKeyword to eliminate: ") - (save-excursion - (goto-char (point-min)) - (let (buffer-read-only) - (flush-lines pattern)) - )) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-this-symbol () - (save-excursion - (cond ((eq major-mode 'hyper-apropos-mode) - (beginning-of-line) - (if (looking-at hyper-apropos-junk-regexp) - nil - (forward-char 3) - (read (point-marker)))) - (t - (let* ((st (progn - (skip-syntax-backward "w_") - ;; !@(*$^%%# stupid backquote implementation!!! - (skip-chars-forward "`") - (point))) - (en (progn - (skip-syntax-forward "w_") - (skip-chars-backward ".':") ; : for Local Variables - (point)))) - (and (not (eq st en)) - (intern-soft (buffer-substring st en)))))))) - -(defun hyper-apropos-where-is (symbol) - "Find keybinding for symbol on current line." - (interactive (list (hyper-apropos-this-symbol))) - (where-is symbol)) - -(defun hyper-apropos-invoke-fn (fn) - "Interactively invoke the function on the current line." - (interactive (list (hyper-apropos-this-symbol))) - (cond ((not (fboundp fn)) - (error "%S is not a function" fn)) - (t (call-interactively fn)))) - -;;;###autoload -(defun hyper-set-variable (var val &optional this-ref-buffer) - (interactive - (let ((var (hyper-apropos-read-variable-symbol - (if (hyper-apropos-follow-ref-buffer current-prefix-arg) - "In ref buffer, set user option" - "Set user option") - 'user-variable-p))) - (list var (hyper-apropos-read-variable-value var) current-prefix-arg))) - (hyper-apropos-set-variable var val this-ref-buffer)) - -;;;###autoload -(defun hyper-apropos-set-variable (var val &optional this-ref-buffer) - "Interactively set the variable on the current line." - (interactive - (let ((var (hyper-apropos-this-symbol))) - (or (and var (boundp var)) - (and (setq var (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol)))) - (boundp var)) - (setq var nil)) - (list var (hyper-apropos-read-variable-value var)))) - (and var - (boundp var) - (progn - (if (hyper-apropos-follow-ref-buffer this-ref-buffer) - (save-excursion - (set-buffer hyper-apropos-ref-buffer) - (set var val)) - (set var val)) - (hyper-apropos-get-doc var t '(variable) this-ref-buffer)))) -;;;###autoload -(define-obsolete-function-alias - 'hypropos-set-variable 'hyper-apropos-set-variable) - -(defun hyper-apropos-read-variable-value (var &optional this-ref-buffer) - (and var - (boundp var) - (let ((prop (get var 'variable-interactive)) - (print-readably t) - val str) - (hyper-apropos-get-doc var t '(variable) current-prefix-arg) - (if prop - (call-interactively (list 'lambda '(arg) - (list 'interactive prop) - 'arg)) - (setq val (if (hyper-apropos-follow-ref-buffer this-ref-buffer) - (save-excursion - (set-buffer hyper-apropos-ref-buffer) - (symbol-value var)) - (symbol-value var)) - str (prin1-to-string val)) - (eval-minibuffer - (format "Set %s `%s' to value (evaluated): " - (if (user-variable-p var) "user option" "Variable") - var) - (condition-case nil - (progn - (read str) - (format (if (or (consp val) - (and (symbolp val) - (not (memq val '(t nil))))) - "'%s" "%s") - str)) - (error nil))))))) - -(defun hyper-apropos-customize-variable () - (interactive) - (let ((var (hyper-apropos-this-symbol))) - (customize-variable var))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-find-tag (&optional tag-name) - "Find the tag for the symbol on the current line in other window. In -order for this to work properly, the variable `tag-table-alist' or -`tags-file-name' must be set so that a TAGS file with tags for the emacs -source is found for the \"*Hyper Apropos*\" buffer." - (interactive) - ;; there ought to be a default tags file for this... - (or tag-name (setq tag-name (symbol-name (hyper-apropos-this-symbol)))) - (find-tag-other-window (list tag-name))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-find-function (fn) - "Find the function for the symbol on the current line in other -window. (See also `find-function'.)" - (interactive - (let ((fn (hyper-apropos-this-symbol))) - (or (fboundp fn) - (and (setq fn (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol)))) - (fboundp fn)) - (setq fn nil)) - (list fn))) - (if fn - (find-function-other-window fn))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-disassemble (sym) - "Disassemble FUN if it is byte-coded. If it's a lambda, prettyprint it." - (interactive (list (hyper-apropos-this-symbol))) - (let ((fun sym) (trail nil) macrop) - (while (and (symbolp fun) (not (memq fun trail))) - (setq trail (cons fun trail) - fun (symbol-function fun))) - (and (symbolp fun) - (error "Loop detected in function binding of `%s'" fun)) - (setq macrop (and (consp fun) - (eq 'macro (car fun)))) - (cond ((compiled-function-p (if macrop (cdr fun) fun)) - (disassemble fun) - (set-buffer "*Disassemble*") - (goto-char (point-min)) - (forward-sexp 2) - (insert (format " for function `%S'" sym)) - ) - ((consp fun) - (with-current-buffer "*Disassemble*" - (cl-prettyprint (if macrop - (cons 'defmacro (cons sym (cdr (cdr fun)))) - (cons 'defun (cons sym (cdr fun)))))) - (set-buffer "*Disassemble*") - (emacs-lisp-mode)) - ((or (vectorp fun) (stringp fun)) - ;; #### - do something fancy here - (with-output-to-temp-buffer "*Disassemble*" - (princ (format "%s is a keyboard macro:\n\n\t" sym)) - (prin1 fun))) - (t - (error "Sorry, cannot disassemble `%s'" sym))))) - -;; ---------------------------------------------------------------------- ;; - -(defun hyper-apropos-quit () - (interactive) - "Quit Hyper Apropos and restore original window config." - (let ((buf (get-buffer hyper-apropos-apropos-buf))) - (and buf (bury-buffer buf))) - (set-window-configuration hyper-apropos-prev-wconfig)) - -;; ---------------------------------------------------------------------- ;; - -;;;###autoload -(defun hyper-apropos-popup-menu (event) - (interactive "e") - (mouse-set-point event) - (let* ((sym (or (hyper-apropos-this-symbol) - (and (eq major-mode 'hyper-apropos-help-mode) - (save-excursion - (goto-char (point-min)) - (hyper-apropos-this-symbol))))) - (notjunk (not (null sym))) - (command-p (if (commandp sym) t)) - (variable-p (and sym (boundp sym))) - (customizable-p (and variable-p - (get sym 'custom-type) - t)) - (function-p (fboundp sym)) - (apropos-p (eq 'hyper-apropos-mode - (save-excursion (set-buffer (event-buffer event)) - major-mode))) - (name (if sym (symbol-name sym) "")) - (hyper-apropos-menu - (delete - nil - (list (concat "Hyper-Help: " name) - (vector "Display documentation" 'hyper-apropos-get-doc notjunk) - (vector "Set variable" 'hyper-apropos-set-variable variable-p) - (vector "Customize variable" 'hyper-apropos-customize-variable - customizable-p) - (vector "Show keys for" 'hyper-apropos-where-is command-p) - (vector "Invoke command" 'hyper-apropos-invoke-fn command-p) - (vector "Find function" 'hyper-apropos-find-function function-p) - (vector "Find tag" 'hyper-apropos-find-tag notjunk) - (and apropos-p - ["Add keyword..." hyper-apropos-add-keyword t]) - (and apropos-p - ["Eliminate keyword..." hyper-apropos-eliminate-keyword t]) - (if apropos-p - ["Programmers' Apropos" hyper-apropos-toggle-programming-flag - :style toggle :selected hyper-apropos-programming-apropos] - ["Programmers' Help" hyper-apropos-toggle-programming-flag - :style toggle :selected hyper-apropos-programming-apropos]) - (and hyper-apropos-programming-apropos - (vector "Disassemble function" - 'hyper-apropos-disassemble - function-p)) - ["Help" describe-mode t] - ["Quit" hyper-apropos-quit t] - )))) - (popup-menu hyper-apropos-menu))) -;;;###autoload -(define-obsolete-function-alias - 'hypropos-popup-menu 'hyper-apropos-popup-menu) - -(provide 'hyper-apropos) - -;; end of hyper-apropos.el diff --git a/lisp/indent.el b/lisp/indent.el deleted file mode 100644 index f93f413..0000000 --- a/lisp/indent.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; indent.el --- indentation commands for XEmacs - -;; Copyright (C) 1985, 1992, 1993, 1995, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: lisp, languages, tools, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; Commands for making and changing indentation in text. These are -;; described in the XEmacs Reference Manual. - -;; 06/11/1997 - Convert (preceding|following)-char to char-(before|after) -slb - -;;; Code: - -(defvar standard-indent 4 "\ -Default number of columns for margin-changing functions to indent.") - -(defvar indent-line-function 'indent-to-left-margin - "Function to indent current line.") - -(defun indent-according-to-mode () - "Indent line in proper way for current major mode." - (interactive) - (funcall indent-line-function)) - -(defun indent-for-tab-command (&optional prefix-arg) - "Indent line in proper way for current major mode." - (interactive "P") - (if (eq indent-line-function 'indent-to-left-margin) - (insert-tab prefix-arg) - (if prefix-arg - (funcall indent-line-function prefix-arg) - (funcall indent-line-function)))) - -(defun insert-tab (&optional prefix-arg) - (let ((count (prefix-numeric-value prefix-arg))) - (if abbrev-mode - (expand-abbrev)) - (if indent-tabs-mode - (insert-char ?\t count) - ;; XEmacs: (Need the `1+') - (indent-to (* tab-width (1+ (/ (current-column) tab-width))))))) - -(defun indent-rigidly (start end arg) - "Indent all lines starting in the region sideways by ARG columns. -Called from a program, takes three arguments, START, END and ARG." - (interactive "r\np") - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (or (bolp) (forward-line 1)) - (while (< (point) end) - (let ((indent (current-indentation)) - eol-flag) - (save-excursion - (skip-chars-forward " \t") - (setq eol-flag (eolp))) - (or eol-flag - (indent-to (max 0 (+ indent arg)) 0)) - (delete-region (point) (progn (skip-chars-forward " \t") (point)))) - (forward-line 1)) - (move-marker end nil) - (setq zmacs-region-stays nil))) ; XEmacs - -(defun indent-line-to (column) - "Indent current line to COLUMN. -This function removes or adds spaces and tabs at beginning of line -only if necessary. It leaves point at end of indentation." - (back-to-indentation) - (let ((cur-col (current-column))) - (cond ((< cur-col column) - (if (> (- column (* (/ cur-col tab-width) tab-width)) tab-width) - (delete-region (point) - (progn (skip-chars-backward " ") (point)))) - (indent-to column)) - ((> cur-col column) ; too far right (after tab?) - (delete-region (progn (move-to-column column t) (point)) - (progn (back-to-indentation) (point))))))) - -(defun current-left-margin () - "Return the left margin to use for this line. -This is the value of the buffer-local variable `left-margin' plus the value -of the `left-margin' text-property at the start of the line." - (save-excursion - (back-to-indentation) - (max 0 - (+ left-margin (or (get-text-property - (if (and (eobp) (not (bobp))) - (1- (point)) (point)) - 'left-margin) 0))))) - -(defun move-to-left-margin (&optional n force) - "Move to the left margin of the current line. -With optional argument, move forward N-1 lines first. -The column moved to is the one given by the `current-left-margin' function. -If the line's indentation appears to be wrong, and this command is called -interactively or with optional argument FORCE, it will be fixed." - (interactive (list (prefix-numeric-value current-prefix-arg) t)) - (beginning-of-line n) - (skip-chars-forward " \t") - (let ((lm (current-left-margin)) - (cc (current-column))) - (cond ((> cc lm) - (if (> (move-to-column lm force) lm) - ;; If lm is in a tab and we are not forcing, move before tab - (backward-char 1))) - ((and force (< cc lm)) - (indent-to-left-margin))))) - -;; This is the default indent-line-function, -;; used in Fundamental Mode, Text Mode, etc. -(defun indent-to-left-margin () - "Indent current line to the column given by `current-left-margin'." - (indent-line-to (current-left-margin))) - -(defun delete-to-left-margin (&optional from to) - "Remove left margin indentation from a region. -This deletes to the column given by `current-left-margin'. -In no case will it delete non-whitespace. -Args FROM and TO are optional; default is the whole buffer." - (save-excursion - (goto-char (or to (point-max))) - (setq to (point-marker)) - (goto-char (or from (point-min))) - (or (bolp) (forward-line 1)) - (while (< (point) to) - (delete-region (point) (progn (move-to-left-margin nil t) (point))) - (forward-line 1)) - (move-marker to nil))) - -(defun set-left-margin (from to lm) - "Set the left margin of the region to WIDTH. -If `auto-fill-mode' is active, re-fill the region to fit the new margin." - (interactive "r\nNSet left margin to column: ") - (if (interactive-p) (setq lm (prefix-numeric-value lm))) - (save-excursion - ;; If inside indentation, start from BOL. - (goto-char from) - (skip-chars-backward " \t") - (if (bolp) (setq from (point))) - ;; Place end after whitespace - (goto-char to) - (skip-chars-forward " \t") - (setq to (point-marker))) - ;; Delete margin indentation first, but keep paragraph indentation. - (delete-to-left-margin from to) - (put-text-property from to 'left-margin lm) - (indent-rigidly from to lm) - (if auto-fill-function (save-excursion (fill-region from to nil t t))) - (move-marker to nil)) - -(defun set-right-margin (from to lm) - "Set the right margin of the region to WIDTH. -If `auto-fill-mode' is active, re-fill the region to fit the new margin." - (interactive "r\nNSet right margin to width: ") - (if (interactive-p) (setq lm (prefix-numeric-value lm))) - (save-excursion - (goto-char from) - (skip-chars-backward " \t") - (if (bolp) (setq from (point)))) - (put-text-property from to 'right-margin lm) - (if auto-fill-function (save-excursion (fill-region from to nil t t)))) - -(defun alter-text-property (from to prop func &optional object) - "Programmatically change value of a text-property. -For each region between FROM and TO that has a single value for PROPERTY, -apply FUNCTION to that value and sets the property to the function's result. -Optional fifth argument OBJECT specifies the string or buffer to operate on." - (let ((begin from) - end val) - (while (setq val (get-text-property begin prop object) - end (text-property-not-all begin to prop val object)) - (put-text-property begin end prop (funcall func val) object) - (setq begin end)) - (if (< begin to) - (put-text-property begin to prop (funcall func val) object)))) - -(defun increase-left-margin (from to inc) - "Increase or decrease the left-margin of the region. -With no prefix argument, this adds `standard-indent' of indentation. -A prefix arg (optional third arg INC noninteractively) specifies the amount -to change the margin by, in characters. -If `auto-fill-mode' is active, re-fill the region to fit the new margin." - (interactive "*r\nP") - (setq inc (if inc (prefix-numeric-value inc) standard-indent)) - (save-excursion - (goto-char from) - (skip-chars-backward " \t") - (if (bolp) (setq from (point))) - (goto-char to) - (setq to (point-marker))) - (alter-text-property from (marker-position to) 'left-margin ; XEmacs - (lambda (v) (max (- left-margin) (+ inc (or v 0))))) - (indent-rigidly from (marker-position to) inc) ; XEmacs - (if auto-fill-function - (save-excursion - (fill-region from (marker-position to) nil t t))) ; XEmacs - (move-marker to nil)) - -(defun decrease-left-margin (from to inc) - "Make the left margin of the region smaller. -With no prefix argument, decrease the indentation by `standard-indent'. -A prefix arg (optional third arg INC noninteractively) specifies the amount -to change the margin by, in characters. -If `auto-fill-mode' is active, re-fill the region to fit the new margin." - (interactive "*r\nP") - (setq inc (if inc (prefix-numeric-value inc) standard-indent)) - (increase-left-margin from to (- inc))) - -(defun increase-right-margin (from to inc) - "Increase the right-margin of the region. -With no prefix argument, increase the right margin by `standard-indent'. -A prefix arg (optional third arg INC noninteractively) specifies the amount -to change the margin by, in characters. A negative argument decreases -the right margin width. -If `auto-fill-mode' is active, re-fill the region to fit the new margin." - (interactive "r\nP") - (if (interactive-p) - (setq inc (if inc (prefix-numeric-value current-prefix-arg) - standard-indent))) - (save-excursion - (alter-text-property from to 'right-margin - (lambda (v) (+ inc (or v 0)))) - (if auto-fill-function - (fill-region from to nil t t)))) - -(defun decrease-right-margin (from to inc) - "Make the right margin of the region smaller. -With no prefix argument, decrease the right margin by `standard-indent'. -A prefix arg (optional third arg INC noninteractively) specifies the amount -of width to remove, in characters. A negative argument increases -the right margin width. -If `auto-fill-mode' is active, re-fills region to fit in new margin." - (interactive "*r\nP") - (setq inc (if inc (prefix-numeric-value inc) standard-indent)) - (increase-right-margin from to (- inc))) - -(defun beginning-of-line-text (&optional n) - "Move to the beginning of the text on this line. -With optional argument, move forward N-1 lines first. -From the beginning of the line, moves past the left-margin indentation, the -fill-prefix, and any indentation used for centering or right-justifying the -line, but does not move past any whitespace that was explicitly inserted -\(such as a tab used to indent the first line of a paragraph)." - (interactive "p") - (beginning-of-line n) - (skip-chars-forward " \t") - ;; Skip over fill-prefix. - (if (and fill-prefix - (not (string-equal fill-prefix ""))) - (if (equal fill-prefix - (buffer-substring - (point) (min (point-max) (+ (length fill-prefix) (point))))) - (forward-char (length fill-prefix))) - (if (and adaptive-fill-mode adaptive-fill-regexp - (looking-at adaptive-fill-regexp)) - (goto-char (match-end 0)))) - ;; Skip centering or flushright indentation - (if (memq (current-justification) '(center right)) - (skip-chars-forward " \t"))) - -(defvar indent-region-function nil - "Short cut function to indent region using `indent-according-to-mode'. -A value of nil means really run `indent-according-to-mode' on each line.") - -(defun indent-region (start end column) - "Indent each nonblank line in the region. -With no argument, indent each line using `indent-according-to-mode', -or use `indent-region-function' to do the whole region if that's non-nil. -If there is a fill prefix, make each line start with the fill prefix. -With argument COLUMN, indent each line to that column. -Called from a program, takes three args: START, END and COLUMN." - (interactive "r\nP") - (if (null column) - (if fill-prefix - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (let ((regexp (regexp-quote fill-prefix))) - (while (< (point) end) - (or (looking-at regexp) - (and (bolp) (eolp)) - (insert fill-prefix)) - (forward-line 1)))) - (if indent-region-function - (funcall indent-region-function start end) - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (or (bolp) (forward-line 1)) - (while (< (point) end) - (or (and (bolp) (eolp)) - (funcall indent-line-function)) - (forward-line 1)) - (move-marker end nil)))) - (setq column (prefix-numeric-value column)) - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (or (bolp) (forward-line 1)) - (while (< (point) end) - (delete-region (point) (progn (skip-chars-forward " \t") (point))) - (or (eolp) - (indent-to column 0)) - (forward-line 1)) - (move-marker end nil)))) - -(defun indent-relative-maybe () - "Indent a new line like previous nonblank line." - (interactive) - (indent-relative t)) - -(defun indent-relative (&optional unindented-ok) - "Space out to under next indent point in previous nonblank line. -An indent point is a non-whitespace character following whitespace. -If the previous nonblank line has no indent points beyond the -column point starts at, `tab-to-tab-stop' is done instead." - (interactive "P") - (if abbrev-mode (expand-abbrev)) - (let ((start-column (current-column)) - indent) - (save-excursion - (beginning-of-line) - (if (re-search-backward "^[^\n]" nil t) - (let ((end (save-excursion (forward-line 1) (point)))) - (move-to-column start-column) - ;; Is start-column inside a tab on this line? - (if (> (current-column) start-column) - (backward-char 1)) - (or (looking-at "[ \t]") - unindented-ok - (skip-chars-forward "^ \t" end)) - (skip-chars-forward " \t" end) - (or (= (point) end) (setq indent (current-column)))))) - (if indent - (let ((opoint (point-marker))) - (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (indent-to indent 0) - (if (> opoint (point)) - (goto-char opoint)) - (move-marker opoint nil)) - (tab-to-tab-stop)))) - -(defvar tab-stop-list - '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120) - "*List of tab stop positions used by `tab-to-tab-stops'. -This should be a list of integers, ordered from smallest to largest.") - -(defvar edit-tab-stops-map nil "Keymap used in `edit-tab-stops'.") -(if edit-tab-stops-map - nil - (setq edit-tab-stops-map (make-sparse-keymap)) - (define-key edit-tab-stops-map "\C-x\C-s" 'edit-tab-stops-note-changes) - (define-key edit-tab-stops-map "\C-c\C-c" 'edit-tab-stops-note-changes)) - -(defvar edit-tab-stops-buffer nil - "Buffer whose tab stops are being edited--in case -the variable `tab-stop-list' is local in that buffer.") - -(defun edit-tab-stops () - "Edit the tab stops used by `tab-to-tab-stop'. -Creates a buffer *Tab Stops* containing text describing the tab stops. -A colon indicates a column where there is a tab stop. -You can add or remove colons and then do \\\\[edit-tab-stops-note-changes] to make changes take effect." - (interactive) - (setq edit-tab-stops-buffer (current-buffer)) - (switch-to-buffer (get-buffer-create "*Tab Stops*")) - ;; #### I18N3 should mark buffer as output-translating - (use-local-map edit-tab-stops-map) - (make-local-variable 'indent-tabs-mode) - (setq indent-tabs-mode nil) - (overwrite-mode 1) - (setq truncate-lines t) - (erase-buffer) - (let ((tabs tab-stop-list)) - (while tabs - (indent-to (car tabs) 0) - (insert ?:) - (setq tabs (cdr tabs)))) - (let ((count 0)) - (insert ?\n) - (while (< count 8) - (insert (+ count ?0)) - (insert " ") - (setq count (1+ count))) - (insert ?\n) - (while (> count 0) - (insert "0123456789") - (setq count (1- count)))) - ;; XEmacs - (insert (substitute-command-keys "\nTo install changes, type \\\\[edit-tab-stops-note-changes]")) - (goto-char (point-min))) - -(defun edit-tab-stops-note-changes () - "Put edited tab stops into effect." - (interactive) - (let (tabs) - (save-excursion - (goto-char 1) - (end-of-line) - (while (search-backward ":" nil t) - (setq tabs (cons (current-column) tabs)))) - (bury-buffer (prog1 (current-buffer) - (switch-to-buffer edit-tab-stops-buffer))) - (setq tab-stop-list tabs)) - (message "Tab stops installed")) - -(defun tab-to-tab-stop () - "Insert spaces or tabs to next defined tab-stop column. -The variable `tab-stop-list' is a list of columns at which there are tab stops. -Use \\[edit-tab-stops] to edit them interactively." - (interactive) - (and abbrev-mode (eq (char-syntax (char-before (point))) ?w) - (expand-abbrev)) - (let ((tabs tab-stop-list)) - (while (and tabs (>= (current-column) (car tabs))) - (setq tabs (cdr tabs))) - (if tabs - (let ((opoint (point))) - (skip-chars-backward " \t") - (delete-region (point) opoint) - (indent-to (car tabs))) - (insert ?\ )))) - -(defun move-to-tab-stop () - "Move point to next defined tab-stop column. -The variable `tab-stop-list' is a list of columns at which there are tab stops. -Use \\[edit-tab-stops] to edit them interactively." - (interactive) - (let ((tabs tab-stop-list)) - (while (and tabs (>= (current-column) (car tabs))) - (setq tabs (cdr tabs))) - (if tabs - (let ((before (point))) - (move-to-column (car tabs) t) - (save-excursion - (goto-char before) - ;; If we just added a tab, or moved over one, - ;; delete any superfluous spaces before the old point. - (if (and (eq (char-before (point)) ?\ ) - (eq (char-after (point)) ?\t)) - (let ((tabend (* (/ (current-column) tab-width) tab-width))) - (while (and (> (current-column) tabend) - (eq (char-before (point)) ?\ )) - (forward-char -1)) - (delete-region (point) before)))))))) - -;(define-key global-map "\t" 'indent-for-tab-command) -;(define-key esc-map "\034" 'indent-region) -;(define-key ctl-x-map "\t" 'indent-rigidly) -;(define-key esc-map "i" 'tab-to-tab-stop) - -;;; indent.el ends here diff --git a/lisp/info.el b/lisp/info.el deleted file mode 100644 index bc245ff..0000000 --- a/lisp/info.el +++ /dev/null @@ -1,3099 +0,0 @@ -;;; info.el --- info package for Emacs. -;; Keywords: help - -;; Copyright (C) 1985, 1986, 1993, 1997 Free Software Foundation, Inc. - -;; Author: Dave Gillespie -;; Richard Stallman -;; Maintainer: Dave Gillespie -;; Version: 1.07 of 7/22/93 -;; Keywords: docs, 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: Not synched with FSF. - -;; Commentary: - -;; This is based on an early Emacs 19 info.el file. -;; -;; Note that Info-directory has been replaced by Info-directory-list, -;; a search path of directories in which to find Info files. -;; Also, Info tries adding ".info" to a file name if the name itself -;; is not found. -;; -;; See the change log below for further details. - - -;; LCD Archive Entry: -;; info-dg|Dave Gillespie|daveg@synaptics.com -;; |Info reader with many enhancements; replaces standard info.el. -;; |93-07-22|1.07|~/modes/info.el - -;; Also available from anonymous FTP on csvax.cs.caltech.edu. - - -;; Change Log: - -;; Modified 3/7/1991 by Dave Gillespie: -;; (Author's address: daveg@synaptics.com or daveg@csvax.cs.caltech.edu) -;; -;; Added keys: i, t, <, >, [, ], {, }, 6, 7, 8, 9, 0. -;; Look at help for info-mode (type ? in Info) for descriptions. -;; -;; If Info-directory-list is undefined and there is no INFOPATH -;; in the environment, use value of Info-directory for compatibility -;; with Emacs 18.57. -;; -;; All files named "localdir" found in the path are appended to "dir", -;; the Info directory. For this to work, "dir" should contain only -;; one node (Top), and each "localdir" should contain no ^_ or ^L -;; characters. Generally they will contain only one or several -;; additional lines for the top-level menu. Note that "dir" is -;; modified in memory each time it is loaded, but not on disk. -;; -;; If "dir" contains a line of the form: "* Locals:" -;; then the "localdir"s are inserted there instead of at the end. - - -;; Modified 4/3/1991 by Dave Gillespie: -;; -;; Added Info-mode-hook (suggested by Sebastian Kremer). -;; Also added epoch-info-startup/select-hooks from Simon Spero's info.el. -;; -;; Added automatic decoding of compressed Info files. -;; See documentation for the variable Info-suffix-list. Default is to -;; run "uncompress" on ".Z" files and "unyabba" on ".Y" files. -;; (See comp.sources.unix v24i073-076 for yabba/unyabba, a free software -;; alternative to compress/uncompress.) -;; Note: "dir" and "localdir" files should not be compressed. -;; -;; Changed variables like Info-enable-edit to be settable by M-x set-variable. -;; -;; Added Info-auto-advance variable. If t, SPC and DEL will act like -;; } and {, i.e., they advance to the next/previous node if at the end -;; of the buffer. -;; -;; Changed `u' to restore point to most recent location in that node. -;; Added `=' to do this manually at any time. (Suggested by David Fox). -;; -;; Changed `m' and `0-9' to try interpreting menu name as a file name -;; if not found as a node name. This allows (dir) menus of the form, -;; Emacs:: Cool text editor -;; as a shorthand for -;; Emacs:(emacs). Cool text editor -;; -;; Enhanced `i' to use line-number information in the index. -;; Added `,' to move among all matches to a previous `i' command. -;; -;; Added `a' (Info-annotate) for adding personal notes to any Info node. -;; Notes are not stored in the actual Info files, but in the user's own -;; ~/.infonotes file. -;; -;; Added Info-footnote-tag, made default be "Ref" instead of "Note". -;; -;; Got mouse-click stuff to work under Emacs version 18. Check it out! -;; Left and right clicks scroll the Info window. -;; Middle click goes to clicked-on node, e.g., "Next:", a menu, or a note. - - -;; Modified 6/29/1991 by Dave Gillespie: -;; -;; Renamed epoch-info-startup/select-hooks to Info-startup/select-hook. -;; -;; Made Info-select-node into a command on the `!' key. -;; -;; Added Info-mouse-support user option. -;; -;; Cleaned up the implementation of some routines. -;; -;; Added special treatment of quoted words in annotations: The `g' -;; command for a nonexistent node name scans for an annotation -;; (in any node of any file) containing that name in quotes: g foo RET -;; looks for an annotation containing: "foo" or: <> -;; If found, it goes to that file and node. -;; -;; Added a call to set up Info-directory-list in Info-find-node to -;; work around a bug in GNUS where it calls Info-goto-node before info. -;; -;; Added completion for `g' command (inspired by Richard Kim's infox.el). -;; Completion knows all node names for the current file, and all annotation -;; tags (see above). It does not complete file names or node names in -;; other files. -;; -;; Added `k' (Info-emacs-key) and `*' (Info-elisp-ref) commands. You may -;; wish to bind these to global keys outside of Info mode. -;; -;; Allowed localdir files to be full dir-like files; only the menu part -;; of each localdir is copied. Also, redundant menu items are omitted. -;; -;; Changed Info-history to hold only one entry at a time for each node, -;; and to be circular so that multiple `l's come back again to the most -;; recent node. Note that the format of Info-history entries has changed, -;; which may interfere with external programs that try to operate on it. -;; (Also inspired by Kim's infox.el). -;; -;; Changed `n', `]', `l', etc. to accept prefix arguments to move several -;; steps at once. Most accept negative arguments to move oppositely. -;; -;; Changed `?' to bury *Help* buffer afterwards to keep it out of the way. -;; -;; Rearranged `?' key's display to be a little better for new users. -;; -;; Changed `a' to save whole window configuration and restore on C-c C-c. -;; -;; Fixed the bug reported by Bill Reynolds on gnu.emacs.bugs. -;; -;; Changed Info-last to restore window-start as well as cursor position. -;; -;; Changed middle mouse button in space after end of node to do Info-last -;; if we got here by following a cross reference, else do Info-global-next. -;; -;; Added some new mouse bindings: shift-left = Info-global-next, -;; shift-right = Info-global-prev, shift-middle = Info-last. -;; -;; Fixed Info-follow-reference not to make assumptions about length -;; of Info-footnote-tag [Linus Tolke]. -;; -;; Changed default for Info-auto-advance mode to be press-twice-for-next-node. -;; -;; Modified x-mouse-ignore to preserve last-command variable, so that -;; press-twice Info-auto-advance mode works with the mouse. - - -;; Modified 3/4/1992 by Dave Gillespie: -;; -;; Added an "autoload" command to help autoload.el. -;; -;; Changed `*' command to look for file `elisp' as well as for `lispref'. -;; -;; Fixed a bug involving footnote names containing regexp special characters. -;; -;; Fixed a bug in completion during `f' (or `r') command. -;; -;; Added TAB (Info-next-reference), M-TAB, and RET keys to Info mode. -;; -;; Added new bindings, `C-h C-k' for Info-emacs-key and `C-h C-f' for -;; Info-elisp-ref. These bindings are made when info.el is loaded, and -;; only if those key sequences were previously unbound. These bindings -;; work at any time, not just when Info is already running. - - -;; Modified 3/8/1992 by Dave Gillespie: -;; -;; Fixed some long lines that were causing trouble with mailers. - - -;; Modified 3/9/1992 by Dave Gillespie: -;; -;; Added `C-h C-i' (Info-query). -;; -;; Added Info-novice mode, warns if the user attempts to switch to -;; a different Info file. -;; -;; Fixed a bug that caused problems using compressed Info files -;; and Info-directory-list at the same time. -;; -;; Disabled Info-mouse-support by default if Epoch or Hyperbole is in use. -;; -;; Added an expand-file-name call to Info-find-node to fix a small bug. - - -;; Modified 5/22/1992 by Dave Gillespie: -;; -;; Added "standalone" operation: "emacs -f info" runs Emacs specifically -;; for use as an Info browser. In this mode, the `q' key quits Emacs -;; itself. Also, "emacs -f info arg" starts in Info file "arg" instead -;; of "dir". -;; -;; Changed to prefer "foo.info" over "foo". If both exist, "foo" is -;; probably a directory or executable program! -;; -;; Made control-mouse act like regular-mouse does in other buffers. -;; (In most systems, this will be set-cursor for left-mouse, x-cut -;; for right-mouse, and x-paste, which will be an error, for -;; middle-mouse.) -;; -;; Improved prompting and searching for `,' key. -;; -;; Fixed a bug where some "* Menu:" lines disappeared when "dir" -;; contained several nodes. - - -;; Modified 9/10/1992 by Dave Gillespie: -;; -;; Mixed in support for XEmacs. Mouse works the same as in -;; the other Emacs versions by default; added Info-lucid-mouse-style -;; variable, which enables mouse operation similar to XEmacs's default. -;; -;; Fixed a bug where RET couldn't understand "* Foo::" if "Foo" was a -;; file name instead of a node name. -;; -;; Added `x' (Info-bookmark), a simple interface to the annotation -;; tags feature. Added `j' (Info-goto-bookmark), like `g' but only -;; completes bookmarks. -;; -;; Added `<>' as alternate to `"tag"' in annotations. -;; -;; Added `v' (Info-visit-file), like Info-goto-node but specialized -;; for going to a new Info file (with file name completion). -;; -;; Added recognition of gzip'd ".z" files. - - -;; Modified 5/9/1993 by Dave Gillespie: -;; -;; Merged in various things from FSF's latest Emacs 19 info.el. - -;; Modified 6/2/1993 by Dave Gillespie: -;; -;; Changed to use new suffix ".gz" for gzip files. - - -;; Modified 7/22/1993 by Dave Gillespie: -;; -;; Changed Info-footnote-tag to "See" instead of "Ref". -;; -;; Extended Info-fontify-node to work with FSF version of Emacs 19. - -;; Modified 7/30/1993 by Jamie Zawinski: -;; -;; Commented out the tty and fsf19 mouse support, because why bother. -;; Commented out the politically incorrect version of XEmacs mouse support. -;; Commented out mouse scrolling bindings because the party line on that -;; is "scrollbars are coming soon." -;; Commented out munging of help-for-help's doc; put it in help.el. -;; Did Info-edit-map the modern XEmacs way. -;; Pruned extra cruft from fontification and mouse handling code. -;; Fixed ASCII-centric bogosity in unreading of events. - -;; Modified 8/11/95 by Chuck Thompson: -;; -;; Removed any pretense of ever referencing Info-directory since it -;; wasn't working anyhow. - -;; Modified 4/5/97 by Tomasz J. Cholewo: -;; -;; Modified Info-search to use with-caps-disable-folding - -;; Modified 6/21/97 by Hrvoje Niksic -;; -;; Fixed up Info-next-reference to work sanely when n < 0. -;; Added S-tab binding. - -;; Modified 1997-07-10 by Karl M. Hegbloom -;; -;; Added `Info-minibuffer-history' -;; (also added to defaults in "lisp/utils/savehist.el") -;; Other changes in main ChangeLog. - -;; Modified 1998-03-29 by Oscar Figueiredo -;; -;; Added automatic dir/localdir (re)building capability for directories that -;; contain none or when it has become older than info files in the same -;; directory. - -;; Modified 1998-09-23 by Didier Verna -;; -;; Use the new macro `with-search-caps-disable-folding' - -;; Code: -(eval-when-compile - (condition-case nil (require 'browse-url) (error nil))) - -(defgroup info nil - "The info package for Emacs." - :group 'help - :group 'docs) - -(defgroup info-faces nil - "The faces used by info browser." - :group 'info - :group 'faces) - - -(defcustom Info-inhibit-toolbar nil - "*Non-nil means don't use the specialized Info toolbar." - :type 'boolean - :group 'info) - -(defcustom Info-novice nil - "*Non-nil means to ask for confirmation before switching Info files." - :type 'boolean - :group 'info) - -(defvar Info-history nil - "List of info nodes user has visited. -Each element of list is a list (\"(FILENAME)NODENAME\" BUFPOS WINSTART).") - -(defvar Info-keeping-history t - "Non-nil if Info-find-node should modify Info-history. -This is for use only by certain internal Info routines.") - -(defvar Info-minibuffer-history nil - "Minibuffer history for Info.") - -(defcustom Info-enable-edit nil - "*Non-nil means the \\\\[Info-edit] command in Info -can edit the current node. -This is convenient if you want to write info files by hand. -However, we recommend that you not do this. -It is better to write a Texinfo file and generate the Info file from that, -because that gives you a printed manual as well." - :type 'boolean - :group 'info) - -(defcustom Info-enable-active-nodes t - "*Non-nil allows Info to execute Lisp code associated with nodes. -The Lisp code is executed when the node is selected." - :type 'boolean - :group 'info) - -(defcustom Info-restoring-point t - "*Non-nil means to restore the cursor position when re-entering a node." - :type 'boolean - :group 'info) - -(defcustom Info-auto-advance 'twice - "*Control what SPC and DEL do when they can't scroll any further. -If nil, they beep and remain in the current node. -If t, they move to the next node (like Info-global-next/prev). -If anything else, they must be pressed twice to move to the next node." - :type '(choice (const :tag "off" nil) - (const :tag "advance" t) - (const :tag "confirm" twice)) - :group 'info) - -(defcustom Info-fontify t - "*Non-nil enables font features in XEmacs. -This variable is ignored unless running under XEmacs." - :type 'boolean - :group 'info) - -(defcustom Info-additional-search-directory-list nil - "*List of additional directories to search for Info documentation -files. These directories are not searched for merging the `dir' -file. An example might be something like: -\"/usr/local/lib/xemacs/packages/lisp/calc/\"" - :type '(repeat directory) - :group 'info) - -(defcustom Info-auto-generate-directory 'if-missing - "*When to auto generate an info directory listing. -Possible values are: -nil or `never' never auto-generate a directory listing, - use any existing `dir' or `localdir' file and ignore info - directories containing none -`always' auto-generate a directory listing ignoring existing - `dir' and `localdir' files -`if-missing', the default, auto-generates a directory listing - if no `dir' or `localdir' file is present. Otherwise the - contents of any of these files is used instead. -`if-outdated' auto-generates a directory listing if the `dir' - and `localdir' are either inexistent or outdated (touched - less recently than an info file in the same directory)." - :type '(choice (const :tag "never" never) - (const :tag "always" always) - (const :tag "if-missing" if-missing) - (const :tag "if-outdated" if-outdated)) - :group 'info) - -(defcustom Info-save-auto-generated-dir nil - "*Whether an auto-generated info directory listing should be saved. -Possible values are: -nil or `never', the default, auto-generated info directory - information will never be saved. -`always', auto-generated info directory information will be saved to - a `dir' file in the same directory overwriting it if it exists -`conservative', auto-generated info directory information will be saved - to a `dir' file in the same directory but the user is asked before - overwriting any existing file." - :type '(choice (const :tag "never" never) - (const :tag "always" always) - (const :tag "conservative" conservative)) - :group 'info) - -(defvar Info-emacs-info-file-name "xemacs.info" - "The filename of the XEmacs info for -`Info-goto-emacs-command-node' (`\\\\[Info-goto-emacs-command-node]')") - -;;;###autoload -(defvar Info-directory-list nil - "List of directories to search for Info documentation files. - -The first directory in this list, the \"dir\" file there will become -the (dir)Top node of the Info documentation tree. If you wish to -modify the info search path, use `M-x customize-variable, -Info-directory-list' to do so.") - -(defcustom Info-localdir-heading-regexp - "^Locally installed XEmacs Packages:?" - "The menu part of localdir files will be inserted below this topic -heading." - :type 'regexp - :group 'info) - -(defface info-node '((t (:bold t :italic t))) - "Face used for node links in info." - :group 'info-faces) - -(defface info-xref '((t (:bold t))) - "Face used for cross-references in info." - :group 'info-faces) - -;; Is this right for NT? .zip, with -c for to stdout, right? -(defvar Info-suffix-list '( ("" . nil) - (".info" . nil) - (".info.gz" . "gzip -dc %s") - (".info-z" . "gzip -dc %s") - (".info.Z" . "uncompress -c %s") - (".bz2" . "bzip2 -dc %s") - (".gz" . "gzip -dc %s") - (".Z" . "uncompress -c %s") - (".zip" . "unzip -c %s") ) - "List of file name suffixes and associated decoding commands. -Each entry should be (SUFFIX . STRING); if STRING contains %s, that is -changed to name of the file to decode, otherwise the file is given to -the command as standard input. If STRING is nil, no decoding is done.") - -(defvar Info-footnote-tag "Note" - "*Symbol that identifies a footnote or cross-reference. -All \"*Note\" references will be changed to use this word instead.") - -(defvar Info-current-file nil - "Info file that Info is now looking at, or nil. -This is the name that was specified in Info, not the actual file name. -It doesn't contain directory names or file name extensions added by Info.") - -(defvar Info-current-subfile nil - "Info subfile that is actually in the *info* buffer now, -or nil if current info file is not split into subfiles.") - -(defvar Info-current-node nil - "Name of node that Info is now looking at, or nil.") - -(defvar Info-tag-table-marker (make-marker) - "Marker pointing at beginning of current Info file's tag table. -Marker points nowhere if file has no tag table.") - -(defvar Info-current-file-completions nil - "Cached completion list for current Info file.") - -(defvar Info-current-annotation-completions nil - "Cached completion list for current annotation files.") - -(defvar Info-index-alternatives nil - "List of possible matches for last Info-index command.") -(defvar Info-index-first-alternative nil) - -(defcustom Info-annotations-path '("~/.xemacs/info.notes" - "~/.infonotes" - "/usr/lib/info.notes") - "*Names of files that contain annotations for different Info nodes. -By convention, the first one should reside in your personal directory. -The last should be a world-writable \"public\" annotations file." - :type '(repeat file) - :group 'info) - -(defcustom Info-button1-follows-hyperlink nil - "*Non-nil means mouse button1 click will follow hyperlink." - :type 'boolean - :group 'info) - -(defvar Info-standalone nil - "Non-nil if Emacs was started solely as an Info browser.") - -(defvar Info-in-cross-reference nil) -(defvar Info-window-configuration nil) - -(defvar Info-dir-prologue "-*- Text -*- -This is the file .../info/dir, which contains the topmost node of the -Info hierarchy. The first time you invoke Info you start off -looking at that node, which is (dir)Top. - -File: dir Node: Top This is the top of the INFO tree - This (the Directory node) gives a menu of major topics. - -* Menu: The list of major topics begins on the next line. - -") - -(defvar Info-no-description-string "[No description available]" - "Description string for info files that have none") - -;;;###autoload -(defun info (&optional file) - "Enter Info, the documentation browser. -Optional argument FILE specifies the file to examine; -the default is the top-level directory of Info. - -In interactive use, a prefix argument directs this command -to read a file name from the minibuffer." - (interactive (if current-prefix-arg - (list (read-file-name "Info file name: " nil nil t)))) - (let ((p command-line-args)) - (while p - (and (string-match "^-[fe]" (car p)) - (equal (nth 1 p) "info") - (not Info-standalone) - (setq Info-standalone t) - (= (length p) 3) - (not (string-match "^-" (nth 2 p))) - (setq file (nth 2 p)) - (setq command-line-args-left nil)) - (setq p (cdr p)))) -; (Info-setup-x) ??? What was this going to be? Can anyone tell karlheg? - (if file - (unwind-protect - (Info-goto-node (concat "(" file ")")) - (and Info-standalone (info))) - (if (get-buffer "*info*") - (switch-to-buffer "*info*") - (Info-directory)))) - -;;;###autoload -(defun Info-query (file) - "Enter Info, the documentation browser. Prompt for name of Info file." - (interactive "sInfo topic (default = menu): ") - (info) - (if (equal file "") - (Info-goto-node "(dir)") - (Info-goto-node (concat "(" file ")")))) - -(defun Info-setup-initial () - (let ((f Info-annotations-path)) - (while f - (if (and (file-exists-p (car f)) (not (get-file-buffer (car f)))) - (bury-buffer (find-file-noselect (car f)))) - (setq f (cdr f))))) - -(defun Info-find-node (filename &optional nodename no-going-back tryfile line) - "Go to an info node specified as separate FILENAME and NODENAME. -Look for a plausible filename, or if not found then look for URL's and -dispatch to the appropriate fn. NO-GOING-BACK is non-nil if -recovering from an error in this function; it says do not attempt -further (recursive) error recovery. TRYFILE is ??" - - (Info-setup-initial) - - (cond - ;; empty filename is simple case - ((null filename) - (Info-find-file-node nil nodename no-going-back tryfile line)) - ;; Convert filename to lower case if not found as specified. - ;; Expand it, look harder... - ((let (temp temp-downcase found - (fname (substitute-in-file-name filename))) - (let ((dirs (cond - ((string-match "^\\./" fname) ; If specified name starts with `./' - (list default-directory)) ; then just try current directory. - ((file-name-absolute-p fname) - '(nil)) ; No point in searching for an absolute file name - (Info-additional-search-directory-list - (append Info-directory-list - Info-additional-search-directory-list)) - (t Info-directory-list)))) - ;; Search the directory list for file FNAME. - (while (and dirs (not found)) - (setq temp (expand-file-name fname (car dirs))) - (setq temp-downcase - (expand-file-name (downcase fname) (car dirs))) - (if (equal temp-downcase temp) (setq temp-downcase nil)) - ;; Try several variants of specified name. - ;; Try downcasing, appending a suffix, or both. - (setq found (Info-suffixed-file temp temp-downcase)) - (setq dirs (cdr dirs))) - (if found - (progn (setq filename (expand-file-name found)) - t)))) - (Info-find-file-node filename nodename no-going-back tryfile line)) - ;; Look for a URL. This pattern is stolen from w3.el to prevent - ;; loading it if we won't need it. - ((string-match (concat "^\\(wais\\|solo\\|x-exec\\|newspost\\|www\\|" - "mailto\\|news\\|tn3270\\|ftp\\|http\\|file\\|" - "telnet\\|gopher\\):") - filename) - (if (fboundp 'browse-url) - (browse-url filename) - (error "Cannot follow URLs in this XEmacs"))) - (t - (error "Info file %s does not exist" filename)))) - -(defun Info-find-file-node (filename nodename - &optional no-going-back tryfile line) - ;; This is the guts of what was Info-find-node. Whoever wrote this - ;; should be locked up where they can't do any more harm. - - ;; Go into info buffer. - (switch-to-buffer "*info*") - (buffer-disable-undo (current-buffer)) - (run-hooks 'Info-startup-hook) - (or (eq major-mode 'Info-mode) - (Info-mode)) - (or (null filename) - (equal Info-current-file filename) - (not Info-novice) - (string= "dir" (file-name-nondirectory Info-current-file)) - (if (y-or-n-p-maybe-dialog-box - (format "Leave Info file `%s'? " - (file-name-nondirectory Info-current-file))) - (message "") - (keyboard-quit))) - ;; Record the node we are leaving. - (if (and Info-current-file (not no-going-back)) - (Info-history-add Info-current-file Info-current-node (point))) - (widen) - (setq Info-current-node nil - Info-in-cross-reference nil) - (unwind-protect - (progn - ;; Switch files if necessary - (or (null filename) - (equal Info-current-file filename) - (let ((buffer-read-only nil)) - (setq Info-current-file nil - Info-current-subfile nil - Info-current-file-completions nil - Info-index-alternatives nil - buffer-file-name nil) - (erase-buffer) - (if (string= "dir" (file-name-nondirectory filename)) - (Info-insert-dir) - (Info-insert-file-contents filename t) - (setq default-directory (file-name-directory filename))) - (set-buffer-modified-p nil) - ;; See whether file has a tag table. Record the location if yes. - (set-marker Info-tag-table-marker nil) - (goto-char (point-max)) - (forward-line -8) - (or (equal nodename "*") - (not (search-forward "\^_\nEnd tag table\n" nil t)) - (let (pos) - ;; We have a tag table. Find its beginning. - ;; Is this an indirect file? - (search-backward "\nTag table:\n") - (setq pos (point)) - (if (save-excursion - (forward-line 2) - (looking-at "(Indirect)\n")) - ;; It is indirect. Copy it to another buffer - ;; and record that the tag table is in that buffer. - (save-excursion - (let ((buf (current-buffer))) - (set-buffer - (get-buffer-create " *info tag table*")) - (buffer-disable-undo (current-buffer)) - (setq case-fold-search t) - (erase-buffer) - (insert-buffer-substring buf) - (set-marker Info-tag-table-marker - (match-end 0)))) - (set-marker Info-tag-table-marker pos)))) - (setq Info-current-file - (file-name-sans-versions buffer-file-name)))) - (if (equal nodename "*") - (progn (setq Info-current-node nodename) - (Info-set-mode-line) - (goto-char (point-min))) - ;; Search file for a suitable node. - (let* ((qnode (regexp-quote nodename)) - (regexp (concat "Node: *" qnode " *[,\t\n\177]")) - (guesspos (point-min)) - (found t)) - ;; First get advice from tag table if file has one. - ;; Also, if this is an indirect info file, - ;; read the proper subfile into this buffer. - (if (marker-position Info-tag-table-marker) - (save-excursion - (set-buffer (marker-buffer Info-tag-table-marker)) - (goto-char Info-tag-table-marker) - (if (re-search-forward regexp nil t) - (progn - (setq guesspos (read (current-buffer))) - ;; If this is an indirect file, - ;; determine which file really holds this node - ;; and read it in. - (if (not (eq (current-buffer) (get-buffer "*info*"))) - (setq guesspos - (Info-read-subfile guesspos))))))) - (goto-char (max (point-min) (- guesspos 1000))) - ;; Now search from our advised position (or from beg of buffer) - ;; to find the actual node. - (catch 'foo - (while (search-forward "\n\^_" nil t) - (forward-line 1) - (let ((beg (point))) - (forward-line 1) - (if (re-search-backward regexp beg t) - (throw 'foo t)))) - (setq found nil) - (let ((bufs (delq nil (mapcar 'get-file-buffer - Info-annotations-path))) - (pattern (if (string-match "\\`<<.*>>\\'" qnode) qnode - (format "\"%s\"\\|<<%s>>" qnode qnode))) - (pat2 (concat "------ *File: *\\([^ ].*[^ ]\\) *Node: " - "*\\([^ ].*[^ ]\\) *Line: *\\([0-9]+\\)")) - (afile nil) anode aline) - (while (and bufs (not anode)) - (save-excursion - (set-buffer (car bufs)) - (goto-char (point-min)) - (if (re-search-forward pattern nil t) - (if (re-search-backward pat2 nil t) - (setq afile (buffer-substring (match-beginning 1) - (match-end 1)) - anode (buffer-substring (match-beginning 2) - (match-end 2)) - aline (string-to-int - (buffer-substring (match-beginning 3) - (match-end 3))))))) - (setq bufs (cdr bufs))) - (if anode - (Info-find-node afile anode t nil aline) - (if tryfile - (condition-case nil - (Info-find-node nodename "Top" t) - (error nil))))) - (or Info-current-node - (error "No such node: %s" nodename))) - (if found - (progn - (Info-select-node) - (goto-char (point-min)) - (if line (forward-line line))))))) - ;; If we did not finish finding the specified node, - ;; go back to the previous one. - (or Info-current-node no-going-back - (let ((hist (car Info-history))) - ;; The following is no longer safe with new Info-history system - ;; (setq Info-history (cdr Info-history)) - (Info-goto-node (car hist) t) - (goto-char (+ (point-min) (nth 1 hist))))))) - -;; Cache the contents of the (virtual) dir file, once we have merged -;; it for the first time, so we can save time subsequently. -(defvar Info-dir-contents nil) - -;; Cache for the directory we decided to use for the default-directory -;; of the merged dir text. -(defvar Info-dir-contents-directory nil) - -;; Record the file attributes of all the files from which we -;; constructed Info-dir-contents. -(defvar Info-dir-file-attributes nil) - -(defun Info-insert-dir () - "Construct the Info directory node by merging the files named -\"dir\" or \"localdir\" from the directories in `Info-directory-list' -The \"dir\" files will take precedence in cases where both exist. It -sets the *info* buffer's `default-directory' to the first directory we -actually get any text from." - (if (and Info-dir-contents Info-dir-file-attributes - ;; Verify that none of the files we used has changed - ;; since we used it. - (eval (cons 'and - (mapcar #'(lambda (elt) - (let ((curr (file-attributes (car elt)))) - ;; Don't compare the access time. - (if curr (setcar (nthcdr 4 curr) 0)) - (setcar (nthcdr 4 (cdr elt)) 0) - (equal (cdr elt) curr))) - Info-dir-file-attributes)))) - (insert Info-dir-contents) - (let ((dirs (reverse Info-directory-list)) - buffers lbuffers buffer others nodes dirs-done) - - (setq Info-dir-file-attributes nil) - - ;; Search the directory list for the directory file. - (while dirs - (let ((truename (file-truename (expand-file-name (car dirs))))) - (or (member truename dirs-done) - (member (directory-file-name truename) dirs-done) - ;; Try several variants of specified name. - ;; Try upcasing, appending `.info', or both. - (let* (buf - file - (attrs - (or - (progn (setq file (expand-file-name "dir" truename)) - (file-attributes file)) - (progn (setq file (expand-file-name "DIR" truename)) - (file-attributes file)) - (progn (setq file (expand-file-name "dir.info" truename)) - (file-attributes file)) - (progn (setq file (expand-file-name "DIR.INFO" truename)) - (file-attributes file)) - (progn (setq file (expand-file-name "localdir" truename)) - (file-attributes file)) - (progn (setq file (expand-file-name "dir" truename)) - nil) - ))) - (setq dirs-done - (cons truename - (cons (directory-file-name truename) - dirs-done))) - (Info-maybe-update-dir file) - (setq attrs (file-attributes file)) - (if (or (setq buf (find-buffer-visiting file)) - attrs) - (save-excursion - (or buffers - (message "Composing main Info directory...")) - (set-buffer (or buf - (generate-new-buffer - (if (string-match "localdir" file) - "localdir" - "info dir")))) - (if (not buf) - (insert-file-contents file)) - (if (string-match "localdir" (buffer-name)) - (setq lbuffers (cons (current-buffer) lbuffers)) - (setq buffers (cons (current-buffer) buffers))) - (if attrs - (setq Info-dir-file-attributes - (cons (cons file attrs) - Info-dir-file-attributes))))))) - (or (cdr dirs) (setq Info-dir-contents-directory (car dirs))) - (setq dirs (cdr dirs)))) - - ;; ensure that the localdir files are inserted last, and reverse - ;; the list of them so that when they get pushed in, they appear - ;; in the same order they got specified in the path, from top to - ;; bottom. - (nconc buffers (reverse lbuffers)) - - (or buffers - (error "Can't find the Info directory node")) - ;; Distinguish the dir file that comes with Emacs from all the - ;; others. Yes, that is really what this is supposed to do. - ;; If it doesn't work, fix it. - (setq buffer (car buffers) - ;; reverse it since they are pushed down from the top. the - ;; `Info-directory-list can be specified in natural order - ;; this way. - others (reverse (cdr buffers))) - - ;; Insert the entire original dir file as a start; note that we've - ;; already saved its default directory to use as the default - ;; directory for the whole concatenation. - (insert-buffer buffer) - - ;; Look at each of the other buffers one by one. - (while others - (let ((other (car others)) - (info-buffer (current-buffer))) - (if (string-match "localdir" (buffer-name other)) - (save-excursion - (set-buffer info-buffer) - (goto-char (point-max)) - (cond - ((re-search-backward "^ *\\* *Locals *: *$" nil t) - (delete-region (match-beginning 0) (match-end 0))) - ;; look for a line like |Local XEmacs packages: - ;; or mismatch on some text ... - ((re-search-backward Info-localdir-heading-regexp nil t) - ;; This is for people who underline topic headings with - ;; equal signs or dashes. - (when (save-excursion - (forward-line 1) - (beginning-of-line) - (looking-at "^[ \t]*[-=*]+")) - (forward-line 1)) - (forward-line 1) - (beginning-of-line)) - (t (search-backward "\^L" nil t))) - ;; Insert menu part of the file - (let* ((pt (point)) - (len (length (buffer-string nil nil other)))) - (insert (buffer-string nil nil other)) - (goto-char (+ pt len)) - (save-excursion - (goto-char pt) - (if (search-forward "* Menu:" (+ pt len) t) - (progn - (forward-line 1) - (delete-region pt (point))))))) - ;; In each, find all the menus. - (save-excursion - (set-buffer other) - (goto-char (point-min)) - ;; Find each menu, and add an elt to NODES for it. - (while (re-search-forward "^\\* Menu:" nil t) - (let (beg nodename end) - (forward-line 1) - (setq beg (point)) - (search-backward "\n\^_") - (search-forward "Node: ") - (setq nodename (Info-following-node-name)) - (search-forward "\n\^_" nil 'move) - (beginning-of-line) - (setq end (point)) - (setq nodes (cons (list nodename other beg end) nodes)))))) - (setq others (cdr others)))) - - ;; Add to the main menu a menu item for each other node. - (re-search-forward "^\\* Menu:" nil t) - (forward-line 1) - (let ((menu-items '("top")) - (nodes nodes) - (case-fold-search t) - (end (save-excursion (search-forward "\^_" nil t) (point)))) - (while nodes - (let ((nodename (car (car nodes)))) - (save-excursion - (or (member (downcase nodename) menu-items) - (re-search-forward (concat "^\\* " - (regexp-quote nodename) - "::") - end t) - (progn - (insert "* " nodename "::" "\n") - (setq menu-items (cons nodename menu-items)))))) - (setq nodes (cdr nodes)))) - ;; Now take each node of each of the other buffers - ;; and merge it into the main buffer. - (while nodes - (let ((nodename (car (car nodes)))) - (goto-char (point-min)) - ;; Find the like-named node in the main buffer. - (if (re-search-forward (concat "\n\^_.*\n.*Node: " - (regexp-quote nodename) - "[,\n\t]") - nil t) - (progn - (search-forward "\n\^_" nil 'move) - (beginning-of-line) - (insert "\n")) - ;; If none exists, add one. - (goto-char (point-max)) - (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n")) - ;; Merge the text from the other buffer's menu - ;; into the menu in the like-named node in the main buffer. - (apply 'insert-buffer-substring (cdr (car nodes)))) - (setq nodes (cdr nodes))) - ;; Kill all the buffers we just made. - (while buffers - (kill-buffer (car buffers)) - (setq buffers (cdr buffers))) - (while lbuffers - (kill-buffer (car lbuffers)) - (setq lbuffers (cdr lbuffers))) - (message "Composing main Info directory...done")) - (setq Info-dir-contents (buffer-string))) - (setq default-directory Info-dir-contents-directory) - (setq buffer-file-name (caar Info-dir-file-attributes))) - -(defun Info-maybe-update-dir (file) - "Rebuild dir or localdir according to `Info-auto-generate-directory'." - (unless (or (not (file-exists-p (file-name-directory file))) - (null (directory-files (file-name-directory file) nil "\\.info"))) - (if (not (find-buffer-visiting file)) - (if (not (file-exists-p file)) - (if (or (eq Info-auto-generate-directory 'always) - (eq Info-auto-generate-directory 'if-missing)) - (Info-build-dir-anew (file-name-directory file))) - (if (or (eq Info-auto-generate-directory 'always) - (and (eq Info-auto-generate-directory 'if-outdated) - (Info-dir-outdated-p file))) - (Info-rebuild-dir file)))))) - -;; Record which *.info files are newer than the dir file -(defvar Info-dir-newer-info-files nil) - -(defun Info-dir-outdated-p (file) - "Return non-nil if dir or localdir is outdated. -dir or localdir are outdated when an info file in the same -directory has been modified more recently." - (let ((dir-mod-time (nth 5 (file-attributes file))) - f-mod-time - newer) - (setq Info-dir-newer-info-files nil) - (mapcar - #'(lambda (f) - (prog2 - (setq f-mod-time (nth 5 (file-attributes f))) - (setq newer (or (> (car f-mod-time) (car dir-mod-time)) - (and (= (car f-mod-time) (car dir-mod-time)) - (> (car (cdr f-mod-time)) (car (cdr dir-mod-time)))))) - (if (and (file-readable-p f) - newer) - (setq Info-dir-newer-info-files - (cons f Info-dir-newer-info-files))))) - (directory-files (file-name-directory file) - 'fullname - ".*\\.info\\(\\.gz\\|\\.bz2\\|\\.Z\\|-z\\|\\.zip\\)?$" - 'nosort - t)) - Info-dir-newer-info-files)) - -(defun Info-extract-dir-entry-from (file) - "Extract the dir entry from the info FILE. -The dir entry is delimited by the markers `START-INFO-DIR-ENTRY' -and `END-INFO-DIR-ENTRY'" - (save-excursion - (set-buffer (get-buffer-create " *Info-tmp*")) - (when (file-readable-p file) - (insert-file-contents file nil nil nil t) - (goto-char (point-min)) - (let (beg) - (unless (null (re-search-forward "^START-INFO-DIR-ENTRY" nil t)) - (forward-line 1) - (setq beg (point)) - (unless (null (re-search-forward "^END-INFO-DIR-ENTRY" nil t)) - (goto-char (match-beginning 0)) - (car (Info-parse-dir-entries beg (point))))))))) - -;; Parse dir entries contained between BEG and END into a list of the form -;; (filename topic node (description-line-1 description-line-2 ...)) -(defun Info-parse-dir-entries (beg end) - (let (entry entries) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (while (re-search-forward "^\\* \\([^:]+\\):\\([ \t]*(\\([^)]*\\))\\w*\\.\\|:\\)" nil t) - (setq entry (list (match-string 2) - (match-string 1) - (downcase (or (match-string 3) - (match-string 1))))) - (setq entry - (cons (nreverse - (cdr - (nreverse - (split-string - (buffer-substring - (re-search-forward "[ \t]*" nil t) - (or (and (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0))) - (point-max))) - "[ \t]*\n[ \t]*")))) - entry)) - (setq entries (cons (nreverse entry) entries))))) - (nreverse entries))) - -(defun Info-dump-dir-entries (entries) - (let ((tab-width 8) - (description-col 0) - len) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (setq len (length (concat (car e) - (car (cdr e))))) - (if (> len description-col) - (setq description-col len))) - entries) - (setq description-col (+ 5 description-col)) - (mapcar #'(lambda (e) - (setq e (cdr e)) ; Drop filename - (insert "* " (car e) ":" (car (cdr e))) - (setq e (car (cdr (cdr e)))) - (while e - (indent-to-column description-col) - (insert (car e) "\n") - (setq e (cdr e)))) - entries) - (insert "\n"))) - - -(defun Info-build-dir-anew (directory) - "Build info directory information for DIRECTORY. -The generated directory listing may be saved to a `dir' according -to the value of `Info-save-auto-generated-dir'" - (save-excursion - (let* ((dirfile (expand-file-name "dir" directory)) - (to-temp (or (null Info-save-auto-generated-dir) - (eq Info-save-auto-generated-dir 'never) - (and (not (file-writable-p dirfile)) - (message "File not writable %s. Using temporary." dirfile)))) - (info-files - (directory-files directory - 'fullname - ".*\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" - nil - t))) - (if to-temp - (message "Creating temporary dir in %s..." directory) - (message "Creating %s..." dirfile)) - (set-buffer (find-file-noselect dirfile t)) - (setq buffer-read-only nil) - (erase-buffer) - (insert Info-dir-prologue - "Info files in " directory ":\n\n") - (Info-dump-dir-entries - (mapcar - #'(lambda (f) - (or (Info-extract-dir-entry-from f) - (list 'dummy - (progn - (string-match "\\(.*\\)\\.info\\(.gz\\|.Z\\|-z\\|.zip\\)?$" - (file-name-nondirectory f)) - (capitalize (match-string 1 (file-name-nondirectory f)))) - ":" - (list Info-no-description-string)))) - info-files)) - (if to-temp - (set-buffer-modified-p nil) - (save-buffer)) - (if to-temp - (message "Creating temporary dir in %s...done" directory) - (message "Creating %s...done" dirfile))))) - - -(defun Info-rebuild-dir (file) - "Build info directory information in the directory of dir FILE. -Description of info files are merged from the info files in the -directory and the contents of FILE with the description in info files -taking precedence over descriptions in FILE. -The generated directory listing may be saved to a `dir' according to -the value of `Info-save-auto-generated-dir' " - (save-excursion - (save-restriction - (let (dir-section-contents dir-full-contents - dir-entry - file-dir-entry - mark next-section - not-first-section - (to-temp - (or (null Info-save-auto-generated-dir) - (eq Info-save-auto-generated-dir 'never) - (and (eq Info-save-auto-generated-dir 'always) - (not (file-writable-p file)) - (message "File not writable %s. Using temporary." file)) - (and (eq Info-save-auto-generated-dir 'conservative) - (or (and (not (file-writable-p file)) - (message "File not writable %s. Using temporary." file)) - (not (y-or-n-p - (message "%s is outdated. Overwrite ? " - file)))))))) - (set-buffer (find-file-noselect file t)) - (setq buffer-read-only nil) - (if to-temp - (message "Rebuilding temporary %s..." file) - (message "Rebuilding %s..." file)) - (catch 'done - (setq buffer-read-only nil) - (goto-char (point-min)) - (unless (and (search-forward "\^_") - (re-search-forward "^\\* Menu:.*$" nil t) - (setq mark (and (re-search-forward "^\\* " nil t) - (match-beginning 0)))) - (throw 'done nil)) - (setq dir-full-contents (Info-parse-dir-entries mark (point-max))) - (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t) - (match-beginning 0)) - (point-max))) - (while next-section - (narrow-to-region mark next-section) - (setq dir-section-contents (nreverse (Info-parse-dir-entries (point-min) - (point-max)))) - (mapcar - #'(lambda (file) - (setq dir-entry (assoc (downcase - (file-name-sans-extension - (file-name-nondirectory file))) - dir-section-contents) - file-dir-entry (Info-extract-dir-entry-from file)) - (if dir-entry - (if file-dir-entry - ;; A dir entry in the info file takes precedence over an - ;; existing entry in the dir file - (setcdr dir-entry (cdr file-dir-entry))) - (unless (or not-first-section - (assoc (downcase - (file-name-sans-extension - (file-name-nondirectory file))) - dir-full-contents)) - (if file-dir-entry - (setq dir-section-contents (cons file-dir-entry - dir-section-contents)) - (setq dir-section-contents - (cons (list 'dummy - (capitalize (file-name-sans-extension - (file-name-nondirectory file))) - ":" - (list Info-no-description-string)) - dir-section-contents)))))) - Info-dir-newer-info-files) - (delete-region (point-min) (point-max)) - (Info-dump-dir-entries (nreverse dir-section-contents)) - (widen) - (if (= next-section (point-max)) - (setq next-section nil) - (or (setq mark (and (re-search-forward "^\\* " nil t) - (match-beginning 0))) - (throw 'done nil)) - (setq next-section (or (and (re-search-forward "^[^* \t].*:[ \t]*$" nil t) - (match-beginning 0)) - (point-max)))) - (setq not-first-section t))) - (if to-temp - (progn - (set-buffer-modified-p nil) - (message "Rebuilding temporary %s...done" file)) - (save-buffer) - (message "Rebuilding %s...done" file)))))) - -;;;###autoload -(defun Info-batch-rebuild-dir () - "(Re)build info `dir' files in the directories remaining on the command line. -Use this from the command line, with `-batch'; -it won't work in an interactive Emacs. -Each file is processed even if an error occurred previously. -For example, invoke \"xemacs -batch -f Info-batch-rebuild-dir /usr/local/info\"" - ;; command-line-args-left is what is left of the command line (from - ;; startup.el) - (defvar command-line-args-left) ; Avoid 'free variable' warning - (if (not noninteractive) - (error "`Info-batch-rebuild-dir' is to be used only with -batch")) - (let ((Info-save-auto-generated-dir 'always) - dir localdir) - (while command-line-args-left - (if (not (file-directory-p (car command-line-args-left))) - (message "Warning: Skipped %s. Not a directory." - (car command-line-args-left)) - (setq dir (expand-file-name "dir" (car command-line-args-left))) - (setq localdir (expand-file-name "localdir" (car command-line-args-left))) - (cond - ((file-exists-p dir) - (Info-rebuild-dir dir)) - ((file-exists-p localdir) - (Info-rebuild-dir localdir)) - (t - (Info-build-dir-anew (car command-line-args-left))))) - (setq command-line-args-left (cdr command-line-args-left))) - (message "Done") - (kill-emacs 0))) - -(defun Info-history-add (file node point) - (if Info-keeping-history - (let* ((name (format "(%s)%s" (Info-file-name-only file) node)) - (found (assoc name Info-history))) - (if found - (setq Info-history (delq found Info-history))) - (setq Info-history (cons (list name (- point (point-min)) - (and (eq (window-buffer) - (current-buffer)) - (- (window-start) (point-min)))) - Info-history))))) - -(defun Info-file-name-only (file) - (let ((dir (file-name-directory file)) - (p Info-directory-list)) - (while (and p (not (equal (car p) dir))) - (setq p (cdr p))) - (if p (file-name-nondirectory file) file))) - -(defun Info-read-subfile (nodepos) - (set-buffer (marker-buffer Info-tag-table-marker)) - (goto-char (point-min)) - (search-forward "\n\^_") - (let (lastfilepos - lastfilename) - (forward-line 2) - (catch 'foo - (while (not (looking-at "\^_")) - (if (not (eolp)) - (let ((beg (point)) - thisfilepos thisfilename) - (search-forward ": ") - (setq thisfilename (buffer-substring beg (- (point) 2))) - (setq thisfilepos (read (current-buffer))) - ;; read in version 19 stops at the end of number. - ;; Advance to the next line. - (if (eolp) - (forward-line 1)) - (if (> thisfilepos nodepos) - (throw 'foo t)) - (setq lastfilename thisfilename) - (setq lastfilepos thisfilepos)) - (throw 'foo t)))) - (set-buffer (get-buffer "*info*")) - (or (equal Info-current-subfile lastfilename) - (let ((buffer-read-only nil)) - (setq buffer-file-name nil) - (widen) - (erase-buffer) - (Info-insert-file-contents (Info-suffixed-file - (expand-file-name lastfilename - (file-name-directory - Info-current-file))) - t) - (set-buffer-modified-p nil) - (setq Info-current-subfile lastfilename))) - (goto-char (point-min)) - (search-forward "\n\^_") - (+ (- nodepos lastfilepos) (point)))) - -(defun Info-suffixed-file (name &optional name2) - "Look for NAME with each of the `Info-suffix-list' extensions in -turn. Optional NAME2 is the name of a fallback info file to check -for; usually a downcased version of NAME." - (let ((suff Info-suffix-list) - (found nil) - file file2) - (while (and suff (not found)) - (setq file (concat name (caar suff)) - file2 (and name2 (concat name2 (caar suff)))) - (cond - ((file-regular-p file) - (setq found file)) - ((and file2 (file-regular-p file2)) - (setq found file2)) - (t - (setq suff (cdr suff))))) - (or found - (and name (when (file-regular-p name) - name)) - (and name2 (when (file-regular-p name2) - name2))))) - -(defun Info-insert-file-contents (file &optional visit) - (setq file (expand-file-name file default-directory)) - (let ((suff Info-suffix-list)) - (while (and suff (or (<= (length file) (length (car (car suff)))) - (not (equal (substring file - (- (length (car (car suff))))) - (car (car suff)))))) - (setq suff (cdr suff))) - (if (stringp (cdr (car suff))) - (let ((command (if (string-match "%s" (cdr (car suff))) - (format (cdr (car suff)) file) - (concat (cdr (car suff)) " < " file)))) - (message "%s..." command) - (call-process shell-file-name nil t nil "-c" command) - (message "") - (when visit - (setq buffer-file-name file) - (set-buffer-modified-p nil) - (clear-visited-file-modtime))) - (insert-file-contents file visit)))) - -(defun Info-select-node () - "Select the node that point is in, after using `g *' to select whole file." - (interactive) - (widen) - (save-excursion - ;; Find beginning of node. - (search-backward "\n\^_") - (forward-line 2) - ;; Get nodename spelled as it is in the node. - (re-search-forward "Node:[ \t]*") - (setq Info-current-node - (buffer-substring (point) - (progn - (skip-chars-forward "^,\t\n") - (point)))) - (Info-set-mode-line) - ;; Find the end of it, and narrow. - (beginning-of-line) - (let (active-expression) - (narrow-to-region (point) - (if (re-search-forward "\n[\^_\f]" nil t) - (prog1 - (1- (point)) - (if (looking-at "[\n\^_\f]*execute: ") - (progn - (goto-char (match-end 0)) - (setq active-expression - (read (current-buffer)))))) - (point-max))) - (or (equal Info-footnote-tag "Note") - (progn - (goto-char (point-min)) - (let ((buffer-read-only nil) - (bufmod (buffer-modified-p)) - (case-fold-search t)) - (while (re-search-forward "\\*[Nn]ote\\([ \n]\\)" nil t) - (replace-match (concat "*" Info-footnote-tag "\ "))) - (set-buffer-modified-p bufmod)))) - (Info-reannotate-node) - ;; XEmacs: remove v19 test - (and Info-fontify - (Info-fontify-node)) - (run-hooks 'Info-select-hook) - (if Info-enable-active-nodes (eval active-expression))))) - -(defun Info-set-mode-line () - (setq modeline-buffer-identification - (list (cons modeline-buffer-id-left-extent "Info: ") - (cons modeline-buffer-id-right-extent - (concat - "(" - (if Info-current-file - (let ((name (file-name-nondirectory Info-current-file))) - (if (string-match "\\.info$" name) - (substring name 0 -5) - name)) - "") - ")" - (or Info-current-node "")))))) - -;; Go to an info node specified with a filename-and-nodename string -;; of the sort that is found in pointers in nodes. - -;;;###autoload -(defun Info-goto-node (nodename &optional no-going-back tryfile) - "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME. -Actually, the following interpretations of NAME are tried in order: - (FILENAME)NODENAME - (FILENAME) (using Top node) - NODENAME (in current file) - TAGNAME (see below) - FILENAME (using Top node) -where TAGNAME is a string that appears in quotes: \"TAGNAME\", in an -annotation for any node of any file. (See `a' and `x' commands.)" - (interactive (list (Info-read-node-name "Goto node, file or tag: ") - nil t)) - (let (filename) - (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" - nodename) - (setq filename (if (= (match-beginning 1) (match-end 1)) - "" - (substring nodename (match-beginning 2) (match-end 2))) - nodename (substring nodename (match-beginning 3) (match-end 3))) - (let ((trim (string-match "\\s *\\'" filename))) - (if trim (setq filename (substring filename 0 trim)))) - (let ((trim (string-match "\\s *\\'" nodename))) - (if trim (setq nodename (substring nodename 0 trim)))) - (Info-find-node (if (equal filename "") nil filename) - (if (equal nodename "") "Top" nodename) - no-going-back (and tryfile (equal filename ""))))) - -(defun Info-goto-bookmark () - (interactive) - (let ((completion-ignore-case nil) - (tag (completing-read "Goto tag: " - (Info-build-annotation-completions) - nil t nil - 'Info-minibuffer-history))) - (or (equal tag "") (Info-find-node nil (format "<<%s>>" tag))))) - -;;;###autoload -(defun Info-visit-file () - "Directly visit an info file." - (interactive) - (let* ((insert-default-directory nil) - (file (read-file-name "Goto Info file: " "" ""))) - (or (equal file "") (Info-find-node (expand-file-name file) "Top")))) - -(defun Info-restore-point (&optional always) - "Restore point to same location it had last time we were in this node." - (interactive "p") - (if (or Info-restoring-point always) - (let* ((name (format "(%s)%s" - (Info-file-name-only Info-current-file) - Info-current-node)) - (p (assoc name Info-history))) - (if p (Info-restore-history-entry p))))) - -(defun Info-restore-history-entry (entry) - (goto-char (+ (nth 1 entry) (point-min))) - (and (nth 2 entry) - (get-buffer-window (current-buffer)) - (set-window-start (get-buffer-window (current-buffer)) - (+ (nth 2 entry) (point-min))))) - -(defun Info-read-node-name (prompt &optional default) - (Info-setup-initial) - (let* ((completion-ignore-case t) - (nodename (completing-read prompt - (Info-build-node-completions) - nil nil nil - 'Info-minibuffer-history))) - (if (equal nodename "") - (or default - (Info-read-node-name prompt)) - nodename))) - -(defun Info-build-annotation-completions () - (or Info-current-annotation-completions - (save-excursion - (let ((bufs (delq nil (mapcar 'get-file-buffer - Info-annotations-path))) - (compl nil)) - (while bufs - (set-buffer (car bufs)) - (goto-char (point-min)) - (while (re-search-forward "<<\\(.*\\)>>" nil t) - (setq compl (cons (list (buffer-substring (match-beginning 1) - (match-end 1))) - compl))) - (setq bufs (cdr bufs))) - (setq Info-current-annotation-completions compl))))) - -(defun Info-build-node-completions () - (or Info-current-file-completions - (let ((compl (Info-build-annotation-completions))) - (save-excursion - (save-restriction - (if (marker-buffer Info-tag-table-marker) - (progn - (set-buffer (marker-buffer Info-tag-table-marker)) - (goto-char Info-tag-table-marker) - (while (re-search-forward "\nNode: \\(.*\\)\177" nil t) - (setq compl - (cons (list (buffer-substring (match-beginning 1) - (match-end 1))) - compl)))) - (widen) - (goto-char (point-min)) - (while (search-forward "\n\^_" nil t) - (forward-line 1) - (let ((beg (point))) - (forward-line 1) - (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]" - beg t) - (setq compl - (cons (list (buffer-substring (match-beginning 1) - (match-end 1))) - compl)))))))) - (setq Info-current-file-completions compl)))) - -(defvar Info-last-search nil - "Default regexp for \\\\[Info-search] command to search for.") - - -;;;###autoload -(defun Info-search (regexp) - "Search for REGEXP, starting from point, and select node it's found in." - (interactive "sSearch (regexp): ") - (if (equal regexp "") - (setq regexp Info-last-search) - (setq Info-last-search regexp)) - (with-search-caps-disable-folding regexp t - (let ((found ()) - (onode Info-current-node) - (ofile Info-current-file) - (opoint (point)) - (osubfile Info-current-subfile)) - (save-excursion - (save-restriction - (widen) - (if (null Info-current-subfile) - (progn (re-search-forward regexp) (setq found (point))) - (condition-case nil - (progn (re-search-forward regexp) (setq found (point))) - (search-failed nil))))) - (if (not found) ;can only happen in subfile case -- else would have erred - (unwind-protect - (let ((list ())) - (set-buffer (marker-buffer Info-tag-table-marker)) - (goto-char (point-min)) - (search-forward "\n\^_\nIndirect:") - (save-restriction - (narrow-to-region (point) - (progn (search-forward "\n\^_") - (1- (point)))) - (goto-char (point-min)) - (search-forward (concat "\n" osubfile ": ")) - (beginning-of-line) - (while (not (eobp)) - (re-search-forward "\\(^.*\\): [0-9]+$") - (goto-char (+ (match-end 1) 2)) - (setq list (cons (cons (read (current-buffer)) - (buffer-substring (match-beginning 1) - (match-end 1))) - list)) - (goto-char (1+ (match-end 0)))) - (setq list (nreverse list) - list (cdr list))) - (while list - (message "Searching subfile %s..." (cdr (car list))) - (Info-read-subfile (car (car list))) - (setq list (cdr list)) - (goto-char (point-min)) - (if (re-search-forward regexp nil t) - (setq found (point) list ()))) - (if found - (message "") - (signal 'search-failed (list regexp)))) - (if (not found) - (progn (Info-read-subfile opoint) - (goto-char opoint) - (Info-select-node))))) - (widen) - (goto-char found) - (Info-select-node) - (or (and (equal onode Info-current-node) - (equal ofile Info-current-file)) - (Info-history-add ofile onode opoint))))) - -;; Extract the value of the node-pointer named NAME. -;; If there is none, use ERRORNAME in the error message; -;; if ERRORNAME is nil, just return nil. -(defun Info-extract-pointer (name &optional errorname) - (save-excursion - (goto-char (point-min)) - (forward-line 4) - (let ((case-fold-search t)) - (if (re-search-backward (concat name ":") nil t) - (progn - (goto-char (match-end 0)) - (Info-following-node-name)) - (if (eq errorname t) - nil - (error (concat "Node has no " (capitalize (or errorname name))))))))) - -;; Return the node name in the buffer following point. -;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp -;; saying which chas may appear in the node name. -(defun Info-following-node-name (&optional allowedchars) - (skip-chars-forward " \t") - (buffer-substring - (point) - (progn - (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]")) - (skip-chars-forward (concat (or allowedchars "^,\t\n") "(")) - (if (looking-at "(") - (skip-chars-forward "^)"))) - (skip-chars-backward " ") - (point)))) - -(defun Info-next (&optional n) - "Go to the next node of this node. -A positive or negative prefix argument moves by multiple nodes." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-prev (- n)) - (while (>= (setq n (1- n)) 0) - (Info-goto-node (Info-extract-pointer "next"))))) - -(defun Info-prev (&optional n) - "Go to the previous node of this node. -A positive or negative prefix argument moves by multiple nodes." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-next (- n)) - (while (>= (setq n (1- n)) 0) - (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous"))))) - -(defun Info-up (&optional n) - "Go to the superior node of this node. -A positive prefix argument moves up several times." - (interactive "p") - (or n (setq n 1)) - (while (>= (setq n (1- n)) 0) - (Info-goto-node (Info-extract-pointer "up"))) - (if (interactive-p) (Info-restore-point))) - -(defun Info-last (&optional n) - "Go back to the last node visited. -With a prefix argument, go to Nth most recently visited node. History is -circular; after oldest node, history comes back around to most recent one. -Argument can be negative to go through the circle in the other direction. -\(In other words, `l' is like \"undo\" and `C-u - l' is like \"redo\".)" - (interactive "p") - (or n (setq n 1)) - (or Info-history - (error "This is the first Info node you looked at")) - (let ((len (1+ (length Info-history)))) - (setq n (% (+ n (* len 100)) len))) - (if (> n 0) - (let ((entry (nth (1- n) Info-history))) - (Info-history-add Info-current-file Info-current-node (point)) - (while (>= (setq n (1- n)) 0) - (setq Info-history (nconc (cdr Info-history) - (list (car Info-history))))) - (setq Info-history (cdr Info-history)) - (let ((Info-keeping-history nil)) - (Info-goto-node (car entry))) - (Info-restore-history-entry entry)))) - -(defun Info-directory () - "Go to the Info directory node." - (interactive) - (Info-find-node "dir" "top")) - -(defun Info-follow-reference (footnotename) - "Follow cross reference named NAME to the node it refers to. -NAME may be an abbreviation of the reference name." - (interactive - (let ((completion-ignore-case t) - completions default (start-point (point)) str i) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward (format "\\*%s[ \n\t]*\\([^:]*\\):" - Info-footnote-tag) - nil t) - (setq str (buffer-substring - (match-beginning 1) - (1- (point)))) - ;; See if this one should be the default. - (and (null default) - (< (match-beginning 0) start-point) - (<= start-point (point)) - (setq default t)) - (setq i 0) - (while (setq i (string-match "[ \n\t]+" str i)) - (setq str (concat (substring str 0 i) " " - (substring str (match-end 0)))) - (setq i (1+ i))) - ;; Record as a completion and perhaps as default. - (if (eq default t) (setq default str)) - (setq completions - (cons (cons str nil) - completions)))) - (if completions - (let ((item (completing-read (if default - (concat "Follow reference named: (" - default ") ") - "Follow reference named: ") - completions nil t nil - 'Info-minibuffer-history))) - (if (and (string= item "") default) - (list default) - (list item))) - (error "No cross-references in this node")))) - (let (target i (str (concat "\\*" Info-footnote-tag " " - (regexp-quote footnotename)))) - (while (setq i (string-match " " str i)) - (setq str (concat (substring str 0 i) "\\([ \t\n]+\\)" - (substring str (1+ i)))) - (setq i (+ i 10))) - (save-excursion - (goto-char (point-min)) - (or (re-search-forward str nil t) - (error "No cross-reference named %s" footnotename)) - (goto-char (match-end 1)) - (setq target - (Info-extract-menu-node-name "Bad format cross reference" t))) - (while (setq i (string-match "[ \t\n]+" target i)) - (setq target (concat (substring target 0 i) " " - (substring target (match-end 0)))) - (setq i (+ i 1))) - (Info-goto-node target) - (setq Info-in-cross-reference t))) - -(defun Info-next-reference (n) - (interactive "p") - (let ((pat (format "\\*%s[ \n\t]*\\([^:]*\\):\\|^\\* .*:\\|<<.*>>" - Info-footnote-tag)) - (old-pt (point)) - wrapped found-nomenu) - (while (< n 0) - (unless (re-search-backward pat nil t) - ;; Don't wrap more than once in a buffer where only the - ;; menu references are found. - (when (and wrapped (not found-nomenu)) - (goto-char old-pt) - (error "No cross references in this node")) - (setq wrapped t) - (goto-char (point-max)) - (unless (re-search-backward pat nil t) - (goto-char old-pt) - (error "No cross references in this node"))) - (unless (save-excursion - (goto-char (match-beginning 0)) - (when (looking-at "\\* Menu:") - (decf n))) - (setq found-nomenu t)) - (incf n)) - (while (> n 0) - (or (eobp) (forward-char 1)) - (unless (re-search-forward pat nil t) - (when (and wrapped (not found-nomenu)) - (goto-char old-pt) - (error "No cross references in this node")) - (setq wrapped t) - (goto-char (point-min)) - (unless (re-search-forward pat nil t) - (goto-char old-pt) - (error "No cross references in this node"))) - (unless (save-excursion - (goto-char (match-beginning 0)) - (when (looking-at "\\* Menu:") - (incf n))) - (setq found-nomenu t)) - (decf n)) - (when (looking-at "\\* Menu:") - (error "No cross references in this node")) - (goto-char (match-beginning 0)))) - -(defun Info-prev-reference (n) - (interactive "p") - (Info-next-reference (- n))) - -(defun Info-extract-menu-node-name (&optional errmessage multi-line) - (skip-chars-forward " \t\n") - (let ((beg (point)) - str i) - (skip-chars-forward "^:") - (forward-char 1) - (setq str - (if (looking-at ":") - (buffer-substring beg (1- (point))) - (skip-chars-forward " \t\n") - (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n")))) - (while (setq i (string-match "\n" str i)) - (aset str i ?\ )) - str)) - -(defun Info-menu (menu-item) - "Go to node for menu item named (or abbreviated) NAME. -Completion is allowed, and the menu item point is on is the default." - (interactive - (let ((completions '()) - ;; If point is within a menu item, use that item as the default - (default nil) - (p (point)) - (last nil)) - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (not (search-forward "\n* menu:" nil t)) - (error "No menu in this node"))) - (while (re-search-forward - "\n\\* \\([^:\t\n]*\\):" nil t) - (if (and (null default) - (prog1 (if last (< last p) nil) - (setq last (match-beginning 0))) - (<= p last)) - (setq default (car (car completions)))) - (setq completions (cons (cons (buffer-substring - (match-beginning 1) - (match-end 1)) - (match-beginning 1)) - completions))) - (if (and (null default) last - (< last p) - (<= p (progn (end-of-line) (point)))) - (setq default (car (car completions))))) - (let ((item nil)) - (while (null item) - (setq item (let ((completion-ignore-case t)) - (completing-read (if default - (format "Menu item (default %s): " - default) - "Menu item: ") - completions nil t nil - 'Info-minibuffer-history))) - ;; we rely on the fact that completing-read accepts an input - ;; of "" even when the require-match argument is true and "" - ;; is not a valid possibility - (if (string= item "") - (if default - (setq item default) - ;; ask again - (setq item nil)))) - (list item)))) - ;; there is a problem here in that if several menu items have the same - ;; name you can only go to the node of the first with this command. - (Info-goto-node (Info-extract-menu-item menu-item) nil t)) - -(defun Info-extract-menu-item (menu-item &optional noerror) - (save-excursion - (goto-char (point-min)) - (if (let ((case-fold-search t)) - (search-forward "\n* menu:" nil t)) - (if (or (search-forward (concat "\n* " menu-item ":") nil t) - (search-forward (concat "\n* " menu-item) nil t)) - (progn - (beginning-of-line) - (forward-char 2) - (Info-extract-menu-node-name)) - (and (not noerror) (error "No such item in menu"))) - (and (not noerror) (error "No menu in this node"))))) - -;; If COUNT is nil, use the last item in the menu. -(defun Info-extract-menu-counting (count &optional noerror noindex) - (save-excursion - (goto-char (point-min)) - (if (let ((case-fold-search t)) - (and (search-forward "\n* menu:" nil t) - (or (not noindex) - (not (string-match "\\" Info-current-node))))) - (if (search-forward "\n* " nil t count) - (progn - (or count - (while (search-forward "\n* " nil t))) - (Info-extract-menu-node-name)) - (and (not noerror) (error "Too few items in menu"))) - (and (not noerror) (error "No menu in this node"))))) - -(defun Info-nth-menu-item (n) - "Go to the node of the Nth menu item." - (interactive "P") - (or n (setq n (- last-command-char ?0))) - (if (< n 1) (error "Index must be at least 1")) - (Info-goto-node (Info-extract-menu-counting n) nil t)) - -(defun Info-last-menu-item () - "Go to the node of the tenth menu item." - (interactive) - (Info-goto-node (Info-extract-menu-counting nil) nil t)) - -(defun Info-top () - "Go to the Top node of this file." - (interactive) - (Info-goto-node "Top")) - -(defun Info-end () - "Go to the final node in this file." - (interactive) - (Info-top) - (let ((Info-keeping-history nil) - node) - (Info-last-menu-item) - (while (setq node (or (Info-extract-pointer "next" t) - (Info-extract-menu-counting nil t t))) - (Info-goto-node node)) - (or (equal (Info-extract-pointer "up" t) "Top") - (let ((executing-kbd-macro "")) ; suppress messages - (condition-case nil - (Info-global-next 10000) - (error nil)))))) - -(defun Info-global-next (&optional n) - "Go to the next node in this file, traversing node structure as necessary. -This works only if the Info file is structured as a hierarchy of nodes. -A positive or negative prefix argument moves by multiple nodes." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-global-prev (- n)) - (while (>= (setq n (1- n)) 0) - (let (node) - (cond ((and (string-match "^Top$" Info-current-node) - (setq node (Info-extract-pointer "next" t)) - (Info-extract-menu-item node t)) - (Info-goto-node node)) - ((setq node (Info-extract-menu-counting 1 t t)) - (message "Going down...") - (Info-goto-node node)) - (t - (let ((Info-keeping-history Info-keeping-history) - (orignode Info-current-node) - (ups "")) - (while (not (Info-extract-pointer "next" t)) - (if (and (setq node (Info-extract-pointer "up" t)) - (not (equal node "Top"))) - (progn - (message "Going%s..." (setq ups (concat ups " up"))) - (Info-goto-node node) - (setq Info-keeping-history nil)) - (if orignode - (let ((Info-keeping-history nil)) - (Info-goto-node orignode))) - (error "Last node in file"))) - (Info-next)))))))) - -(defun Info-page-next (&optional n) - "Scroll forward one screenful, or go to next global node. -A positive or negative prefix argument moves by multiple screenfuls." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-page-prev (- n)) - (while (>= (setq n (1- n)) 0) - (if (pos-visible-in-window-p (point-max)) - (progn - (Info-global-next) - (message "Node: %s" Info-current-node)) - (scroll-up))))) - -(defun Info-scroll-next (arg) - (interactive "P") - (if Info-auto-advance - (if (and (pos-visible-in-window-p (point-max)) - (not (eq Info-auto-advance t)) - (not (eq last-command this-command))) - (message "Hit %s again to go to next node" - (if (= last-command-char 0) - "mouse button" - (key-description (char-to-string last-command-char)))) - (Info-page-next) - (setq this-command 'Info)) - (scroll-up arg))) - -(defun Info-global-prev (&optional n) - "Go to the previous node in this file, traversing structure as necessary. -This works only if the Info file is structured as a hierarchy of nodes. -A positive or negative prefix argument moves by multiple nodes." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-global-next (- n)) - (while (>= (setq n (1- n)) 0) - (let ((upnode (Info-extract-pointer "up" t)) - (prevnode (Info-extract-pointer "prev[ious]*" t))) - (if (or (not prevnode) - (equal prevnode upnode)) - (if (string-match "^Top$" Info-current-node) - (error "First node in file") - (message "Going up...") - (Info-up)) - (Info-goto-node prevnode) - (let ((downs "") - (Info-keeping-history nil) - node) - (while (setq node (Info-extract-menu-counting nil t t)) - (message "Going%s..." (setq downs (concat downs " down"))) - (Info-goto-node node)))))))) - -(defun Info-page-prev (&optional n) - "Scroll backward one screenful, or go to previous global node. -A positive or negative prefix argument moves by multiple screenfuls." - (interactive "p") - (or n (setq n 1)) - (if (< n 0) - (Info-page-next (- n)) - (while (>= (setq n (1- n)) 0) - (if (pos-visible-in-window-p (point-min)) - (progn - (Info-global-prev) - (message "Node: %s" Info-current-node) - (sit-for 0) - ;;(scroll-up 1) ; work around bug in pos-visible-in-window-p - ;;(scroll-down 1) - (while (not (pos-visible-in-window-p (point-max))) - (scroll-up))) - (scroll-down))))) - -(defun Info-scroll-prev (arg) - (interactive "P") - (if Info-auto-advance - (if (and (pos-visible-in-window-p (point-min)) - (not (eq Info-auto-advance t)) - (not (eq last-command this-command))) - (message "Hit %s again to go to previous node" - (if (= last-command-char 0) - "mouse button" - (key-description (char-to-string last-command-char)))) - (Info-page-prev) - (setq this-command 'Info)) - (scroll-down arg))) - -(defun Info-index (topic) - "Look up a string in the index for this file. -The index is defined as the first node in the top-level menu whose -name contains the word \"Index\", plus any immediately following -nodes whose names also contain the word \"Index\". -If there are no exact matches to the specified topic, this chooses -the first match which is a case-insensitive substring of a topic. -Use the `,' command to see the other matches. -Give a blank topic name to go to the Index node itself." - (interactive "sIndex topic: ") - (let ((pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*%s" - (regexp-quote topic) - "\\([^.\n]*\\)\\.[ t]*\\([0-9]*\\)")) - node) - (message "Searching index for `%s'..." topic) - (Info-goto-node "Top") - (let ((case-fold-search t)) - (or (search-forward "\n* menu:" nil t) - (error "No index")) - (or (re-search-forward "\n\\* \\(.*\\\\)" nil t) - (error "No index"))) - (goto-char (match-beginning 1)) - (let ((Info-keeping-history nil) - (Info-fontify (and Info-fontify (equal topic "")))) - (Info-goto-node (Info-extract-menu-node-name))) - (or (equal topic "") - (let ((matches nil) - (exact nil) - (Info-keeping-history nil) - found) - (while - (progn - (goto-char (point-min)) - (while (re-search-forward pattern nil t) - (setq matches - (cons (list (buffer-substring (match-beginning 1) - (match-end 1)) - (buffer-substring (match-beginning 2) - (match-end 2)) - Info-current-node - (string-to-int (concat "0" - (buffer-substring - (match-beginning 3) - (match-end 3))))) - matches))) - (and (setq node (Info-extract-pointer "next" t)) - (string-match "\\" node))) - (let ((Info-fontify nil)) - (Info-goto-node node))) - (or matches - (progn - (Info-last) - (error "No \"%s\" in index" topic))) - ;; Here it is a feature that assoc is case-sensitive. - (while (setq found (assoc topic matches)) - (setq exact (cons found exact) - matches (delq found matches))) - (setq Info-index-alternatives (nconc exact (nreverse matches)) - Info-index-first-alternative (car Info-index-alternatives)) - (Info-index-next 0))))) - -(defun Info-index-next (num) - "Go to the next matching index item from the last `i' command." - (interactive "p") - (or Info-index-alternatives - (error "No previous `i' command in this file")) - (while (< num 0) - (setq num (+ num (length Info-index-alternatives)))) - (while (> num 0) - (setq Info-index-alternatives - (nconc (cdr Info-index-alternatives) - (list (car Info-index-alternatives))) - num (1- num))) - (Info-goto-node (nth 1 (car Info-index-alternatives))) - (if (> (nth 3 (car Info-index-alternatives)) 0) - (forward-line (nth 3 (car Info-index-alternatives))) - (forward-line 3) ; don't search in headers - (let ((name (car (car Info-index-alternatives)))) - (if (or (re-search-forward (format - "\\(Function\\|Command\\): %s\\( \\|$\\)" - (regexp-quote name)) nil t) - (re-search-forward (format "^`%s[ ']" (regexp-quote name)) nil t) - (search-forward (format "`%s'" name) nil t) - (and (string-match "\\`.*\\( (.*)\\)\\'" name) - (search-forward - (format "`%s'" (substring name 0 (match-beginning 1))) - nil t)) - (search-forward name nil t)) - (beginning-of-line) - (goto-char (point-min))))) - (message "Found \"%s\" in %s. %s" - (car (car Info-index-alternatives)) - (nth 2 (car Info-index-alternatives)) - (if (cdr Info-index-alternatives) - (if (eq (car (cdr Info-index-alternatives)) - Info-index-first-alternative) - "(Press `,' to repeat)" - (format "(Press `,' for %d more)" - (- (1- (length Info-index-alternatives)) - (length (memq Info-index-first-alternative - (cdr Info-index-alternatives)))))) - "(Only match)"))) - - -;;;###autoload -(defun Info-emacs-command (command) - "Look up an Emacs command in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." - (interactive "CLook up command in Emacs manual: ") - (save-window-excursion - (info) - (Info-find-node Info-emacs-info-file-name "Top") - (Info-index (symbol-name command))) - (pop-to-buffer "*info*")) - - -;;;###autoload -(defun Info-goto-emacs-command-node (key) - "Look up an Emacs command in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." - (interactive "CLook up command in Emacs manual: ") - (Info-emacs-command key)) - -;;;###autoload -(defun Info-goto-emacs-key-command-node (key) - "Look up an Emacs key sequence in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." - (interactive "kLook up key in Emacs manual: ") - (let ((command (key-binding key))) - (cond ((eq command 'keyboard-quit) - (keyboard-quit)) - ((null command) - (error "%s is undefined" (key-description key))) - ((and (interactive-p) (eq command 'execute-extended-command)) - (call-interactively 'Info-goto-emacs-command-node)) - (t - (Info-goto-emacs-command-node command))))) - -;;;###autoload -(defun Info-emacs-key (key) - "Look up an Emacs key sequence in the Emacs manual in the Info system. -This command is designed to be used whether you are already in Info or not." - (interactive "kLook up key in Emacs manual: ") - (cond ((eq (key-binding key) 'keyboard-quit) - (keyboard-quit)) - ((and (interactive-p) (eq (key-binding key) 'execute-extended-command)) - (call-interactively 'Info-goto-emacs-command-node)) - (t - (save-window-excursion - (info) - (Info-find-node Info-emacs-info-file-name "Top") - (setq key (key-description key)) - (let (p) - (if (setq p (string-match "[@{}]" key)) - (setq key (concat (substring key 0 p) "@" (substring key p)))) - (if (string-match "^ESC " key) - (setq key (concat "M-" (substring key 4)))) - (if (string-match "^M-C-" key) - (setq key (concat "C-M-" (substring key 4))))) - (Info-index key)) - (pop-to-buffer "*info*")))) - -;;;###autoload -(defun Info-elisp-ref (func) - "Look up an Emacs Lisp function in the Elisp manual in the Info system. -This command is designed to be used whether you are already in Info or not." - (interactive (let ((fn (function-at-point)) - (enable-recursive-minibuffers t) - val) - (setq val (completing-read - (format "Look up Emacs Lisp function%s: " - (if fn - (format " (default %s)" fn) - "")) - obarray 'fboundp t)) - (list (if (equal val "") - fn (intern val))))) - (save-window-excursion - (info) - (condition-case nil - (Info-find-node "lispref" "Top") - (error (Info-find-node "elisp" "Top"))) - (Info-index (symbol-name func))) - (pop-to-buffer "*info*")) - -(defun Info-reannotate-node () - (let ((bufs (delq nil (mapcar 'get-file-buffer Info-annotations-path)))) - (if bufs - (let ((ibuf (current-buffer)) - (file (concat "\\(" (regexp-quote - (file-name-nondirectory Info-current-file)) - "\\|" (regexp-quote Info-current-file) "\\)")) - (node (regexp-quote Info-current-node)) - (savept (point))) - (goto-char (point-min)) - (if (search-forward "\n------ NOTE:\n" nil t) - (let ((buffer-read-only nil) - (bufmod (buffer-modified-p)) - top) - (setq savept (copy-marker savept)) - (goto-char (point-min)) - (while (search-forward "\n------ NOTE:" nil t) - (setq top (1+ (match-beginning 0))) - (if (search-forward "\n------\n" nil t) - (delete-region top (point))) - (backward-char 1)) - (set-buffer-modified-p bufmod))) - (save-excursion - (while bufs - (set-buffer (car bufs)) - (goto-char (point-min)) - (while (re-search-forward - (format - "------ *File: *%s *Node: *%s *Line: *\\([0-9]+\\) *\n" - file node) - nil t) - (let ((line (string-to-int - (buffer-substring (match-beginning 2) - (match-end 2)))) - (top (point)) - bot) - (search-forward "\n------\n" nil t) - (setq bot (point)) - (save-excursion - (set-buffer ibuf) - (if (integerp savept) (setq savept (copy-marker savept))) - (if (= line 0) - (goto-char (point-max)) - (goto-char (point-min)) - (forward-line line)) - (let ((buffer-read-only nil) - (bufmod (buffer-modified-p))) - (insert "------ NOTE:\n") - (insert-buffer-substring (car bufs) top bot) - (set-buffer-modified-p bufmod))))) - (setq bufs (cdr bufs)))) - (goto-char savept))))) - -(defvar Info-annotate-map nil - "Local keymap used within `a' command of Info.") -(if Info-annotate-map - nil - ;; (setq Info-annotate-map (nconc (make-sparse-keymap) text-mode-map)) - (setq Info-annotate-map (copy-keymap text-mode-map)) - (define-key Info-annotate-map "\C-c\C-c" 'Info-cease-annotate)) - -(defun Info-annotate-mode () - "Major mode for adding an annotation to an Info node. -Like text mode with the addition of Info-cease-annotate -which returns to Info mode for browsing. -\\{Info-annotate-map}") - -(defun Info-annotate (arg) - "Add a personal annotation to the current Info node. - Only you will be able to see this annotation. Annotations are stored -in the file \"~/.xemacs/info.notes\" by default. If point is inside -an existing annotation, edit that annotation. A prefix argument -specifies which annotations file (from `Info-annotations-path') is to -be edited; default is 1." - (interactive "p") - (setq arg (1- arg)) - (if (or (< arg 0) (not (nth arg Info-annotations-path))) - (if (= arg 0) - (setq Info-annotations-path - (list (read-file-name - "Annotations file: " "~/" "~/.infonotes"))) - (error "File number must be in the range from 1 to %d" - (length Info-annotations-path)))) - (let ((which nil) - (file (file-name-nondirectory Info-current-file)) - (d Info-directory-list) - where pt) - (while (and d (not (equal (expand-file-name file (car d)) - Info-current-file))) - (setq d (cdr d))) - (or d (setq file Info-current-file)) - (if (and (save-excursion - (goto-char (min (point-max) (+ (point) 13))) - (and (search-backward "------ NOTE:\n" nil t) - (setq pt (match-end 0)) - (search-forward "\n------\n" nil t))) - (< (point) (match-end 0))) - (setq which (format "File: *%s *Node: *%s *Line:.*\n%s" - (regexp-quote file) - (regexp-quote Info-current-node) - (regexp-quote - (buffer-substring pt (match-beginning 0)))) - where (max (- (point) pt) 0))) - (let ((node Info-current-node) - (line (if (looking-at "[ \n]*\\'") 0 - (count-lines (point-min) (point))))) - (or which - (let ((buffer-read-only nil) - (bufmod (buffer-modified-p))) - (beginning-of-line) - (if (bobp) (goto-char (point-max))) - (insert "------ NOTE:\n------\n") - (backward-char 20) - (set-buffer-modified-p bufmod))) - ;; (setq Info-window-start (window-start)) - (setq Info-window-configuration (current-window-configuration)) - (pop-to-buffer (find-file-noselect (nth arg Info-annotations-path))) - (use-local-map Info-annotate-map) - (setq major-mode 'Info-annotate-mode) - (setq mode-name "Info Annotate") - (if which - (if (save-excursion - (goto-char (point-min)) - (re-search-forward which nil t)) - (progn - (goto-char (match-beginning 0)) - (forward-line 1) - (forward-char where))) - (let ((bufmod (buffer-modified-p))) - (goto-char (point-max)) - (insert (format "\n------ File: %s Node: %s Line: %d\n" - file node line)) - (setq pt (point)) - (insert "\n------\n" - "\nPress C-c C-c to save and return to Info.\n") - (goto-char pt) - (set-buffer-modified-p bufmod)))))) - -(defun Info-cease-annotate () - (interactive) - (let ((bufmod (buffer-modified-p))) - (while (save-excursion - (goto-char (point-min)) - (re-search-forward "\n\n?Press .* to save and return to Info.\n" - nil t)) - (delete-region (1+ (match-beginning 0)) (match-end 0))) - (while (save-excursion - (goto-char (point-min)) - (re-search-forward "\n------ File:.*Node:.*Line:.*\n+------\n" - nil t)) - (delete-region (match-beginning 0) (match-end 0))) - (set-buffer-modified-p bufmod)) - (save-buffer) - (fundamental-mode) - (bury-buffer) - (or (one-window-p) (delete-window)) - (info) - (setq Info-current-annotation-completions nil) - (set-window-configuration Info-window-configuration) - (Info-reannotate-node)) - -(defun Info-bookmark (arg tag) - (interactive "p\nsBookmark name: ") - (Info-annotate arg) - (if (or (string-match "^\"\\(.*\\)\"$" tag) - (string-match "^<<\\(.*\\)>>$" tag)) - (setq tag (substring tag (match-beginning 1) (match-end 1)))) - (let ((pt (point))) - (search-forward "\n------\n") - (let ((end (- (point) 8))) - (goto-char pt) - (if (re-search-forward "<<[^>\n]*>>" nil t) - (delete-region (match-beginning 0) (match-end 0)) - (goto-char end)) - (or (equal tag "") - (insert "<<" tag ">>")))) - (Info-cease-annotate)) - -(defun Info-exit () - "Exit Info by selecting some other buffer." - (interactive) - (if Info-standalone - (save-buffers-kill-emacs) - (bury-buffer (current-buffer)) - (if (and (featurep 'toolbar) - (boundp 'toolbar-info-frame) - (eq toolbar-info-frame (selected-frame))) - (condition-case () - (delete-frame toolbar-info-frame) - (error (bury-buffer))) - (switch-to-buffer (other-buffer (current-buffer)))))) - -(defun Info-undefined () - "Make command be undefined in Info." - (interactive) - (ding)) - -(defun Info-help () - "Enter the Info tutorial." - (interactive) - (delete-other-windows) - (Info-find-node "info" - (if (< (window-height) 23) - "Help-Small-Screen" - "Help"))) - -(defun Info-summary () - "Display a brief summary of all Info commands." - (interactive) - (save-window-excursion - (switch-to-buffer "*Help*") - (erase-buffer) - (insert (documentation 'Info-mode)) - (goto-char (point-min)) - (let (flag) - (while (progn (setq flag (not (pos-visible-in-window-p (point-max)))) - (message (if flag "Type Space to see more" - "Type Space to return to Info")) - (let ((e (next-command-event))) - (if (/= ?\ (event-to-character e)) - (progn (setq unread-command-event e) nil) - flag))) - (scroll-up))) - (message "") - (bury-buffer "*Help*"))) - -(defun Info-get-token (pos start all &optional errorstring) - "Return the token around POS, -POS must be somewhere inside the token -START is a regular expression which will match the - beginning of the tokens delimited string -ALL is a regular expression with a single - parenthized subpattern which is the token to be - returned. E.g. '{\(.*\)}' would return any string - enclosed in braces around POS. -SIG optional fourth argument, controls action on no match - nil: return nil - t: beep - a string: signal an error, using that string." - (save-excursion - (goto-char (point-min)) - (re-search-backward "\\`") ; Bug fix due to Nicholas J. Foskett. - (goto-char pos) - (re-search-backward start (max (point-min) (- pos 200)) 'yes) - (let (found) - (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes) - (not (setq found (and (<= (match-beginning 0) pos) - (> (match-end 0) pos)))))) - (if (and found (<= (match-beginning 0) pos) - (> (match-end 0) pos)) - (buffer-substring (match-beginning 1) (match-end 1)) - (cond ((null errorstring) - nil) - ((eq errorstring t) - (beep) - nil) - (t - (error "No %s around position %d" errorstring pos))))))) - -(defun Info-follow-clicked-node (event) - "Follow a node reference near clicked point. Like M, F, N, P or U command. -At end of the node's text, moves to the next node." - (interactive "@e") - (or (and (event-point event) - (Info-follow-nearest-node - (max (progn - (select-window (event-window event)) - (event-point event)) - (1+ (point-min))))) - (error "click on a cross-reference to follow"))) - -(defun Info-maybe-follow-clicked-node (event &optional click-count) - "Follow a node reference (if any) near clicked point. -Like M, F, N, P or U command. At end of the node's text, moves to the -next node. No error is given if there is no node to follow." - (interactive "@e") - (and Info-button1-follows-hyperlink - (event-point event) - (Info-follow-nearest-node - (max (progn - (select-window (event-window event)) - (event-point event)) - (1+ (point-min)))))) - -(defun Info-find-nearest-node (point) - (let (node) - (cond - ((= point (point-min)) nil) ; don't trigger on accidental RET. - ((setq node (Info-get-token point - (format "\\*%s[ \n]" Info-footnote-tag) - (format "\\*%s[ \n]\\([^:]*\\):" - Info-footnote-tag))) - (list "Following cross-reference %s..." - (list 'Info-follow-reference node))) - ((setq node (Info-get-token point "\\* " "\\* \\([^:]*\\)::")) - (list "Selecting menu item %s..." - (list 'Info-goto-node node nil t))) - ((setq node (Info-get-token point "\\* " "\\* \\([^:]*\\):")) - (list "Selecting menu item %s..." - (list 'Info-menu node))) - ((setq node (Info-get-token point "Up: " "Up: \\([^,\n\t]*\\)")) - (list "Going up..." - (list 'Info-goto-node node))) - ((setq node (Info-get-token point "Next: " "Next: \\([^,\n\t]*\\)")) - (list "Next node..." - (list 'Info-goto-node node))) - ((setq node (Info-get-token point "File: " "File: \\([^,\n\t]*\\)")) - (list "Top node..." - (list 'Info-goto-node "Top"))) - ((setq node (Info-get-token point "Prev[ious]*: " - "Prev[ious]*: \\([^,\n\t]*\\)")) - (list "Previous node..." - (list 'Info-goto-node node))) - ((setq node (Info-get-token point "Node: " "Node: \\([^,\n\t]*\\)")) - (list "Reselecting %s..." - (list 'Info-goto-node node))) - ((save-excursion (goto-char point) (looking-at "[ \n]*\\'")) - (if Info-in-cross-reference - (list "Back to last node..." - '(Info-last)) - (list "Next node..." - '(Info-global-next))))) - )) - -(defun Info-follow-nearest-node (point) - "Follow a node reference near point. Like M, F, N, P or U command. -At end of the node's text, moves to the next node." - (interactive "d") - (let ((data (Info-find-nearest-node point))) - (if (null data) - nil - (let ((msg (format (car data) (nth 1 (nth 1 data))))) - (message "%s" msg) - (eval (nth 1 data)) - (message "%sdone" msg)) - t))) - -(defun Info-indicated-node (event) - (condition-case () - (save-excursion - (cond ((eventp event) - (set-buffer (event-buffer event)) - (setq event (event-point event)))) - (let* ((data (Info-find-nearest-node event)) - (name (nth 1 (nth 1 data)))) - (and name (nth 1 data)))) - (error nil))) - -(defun Info-mouse-track-double-click-hook (event click-count) - "Handle double-clicks by turning pages, like the `gv' ghostscript viewer" - (if (/= click-count 2) - ;; Return nil so any other hooks are performed. - nil - (let* ((fw (face-width 'default)) - (fh (face-height 'default)) - (x (/ (event-x-pixel event) fw)) - (y (/ (event-y-pixel event) fw)) - (w (/ (window-pixel-width (event-window event)) fw)) - (h (/ (window-pixel-height (event-window event)) fh)) - (bx 3) - (by 2)) - (cond - ((<= y by) (Info-up) t) - ((>= y (- h by)) (Info-nth-menu-item 1) t) - ((<= x bx) (Info-prev) t) - ((>= x (- w bx)) (Info-next) t) - (t nil))))) - -(defvar Info-mode-map nil - "Keymap containing Info commands.") -(if Info-mode-map - nil - (setq Info-mode-map (make-sparse-keymap)) - (suppress-keymap Info-mode-map) - (define-key Info-mode-map "." 'beginning-of-buffer) - (define-key Info-mode-map " " 'Info-scroll-next) - (define-key Info-mode-map "1" 'Info-nth-menu-item) - (define-key Info-mode-map "2" 'Info-nth-menu-item) - (define-key Info-mode-map "3" 'Info-nth-menu-item) - (define-key Info-mode-map "4" 'Info-nth-menu-item) - (define-key Info-mode-map "5" 'Info-nth-menu-item) - (define-key Info-mode-map "6" 'Info-nth-menu-item) - (define-key Info-mode-map "7" 'Info-nth-menu-item) - (define-key Info-mode-map "8" 'Info-nth-menu-item) - (define-key Info-mode-map "9" 'Info-nth-menu-item) - (define-key Info-mode-map "0" 'Info-last-menu-item) - (define-key Info-mode-map "?" 'Info-summary) - (define-key Info-mode-map "a" 'Info-annotate) - (define-key Info-mode-map "b" 'beginning-of-buffer) - (define-key Info-mode-map "d" 'Info-directory) - (define-key Info-mode-map "e" 'Info-edit) - (define-key Info-mode-map "f" 'Info-follow-reference) - (define-key Info-mode-map "g" 'Info-goto-node) - (define-key Info-mode-map "h" 'Info-help) - (define-key Info-mode-map "i" 'Info-index) - (define-key Info-mode-map "j" 'Info-goto-bookmark) - (define-key Info-mode-map "k" 'Info-emacs-key) - (define-key Info-mode-map "l" 'Info-last) - (define-key Info-mode-map "m" 'Info-menu) - (define-key Info-mode-map "n" 'Info-next) - (define-key Info-mode-map "p" 'Info-prev) - (define-key Info-mode-map "q" 'Info-exit) - (define-key Info-mode-map "r" 'Info-follow-reference) - (define-key Info-mode-map "s" 'Info-search) - (define-key Info-mode-map "t" 'Info-top) - (define-key Info-mode-map "u" 'Info-up) - (define-key Info-mode-map "v" 'Info-visit-file) - (define-key Info-mode-map "x" 'Info-bookmark) - (define-key Info-mode-map "<" 'Info-top) - (define-key Info-mode-map ">" 'Info-end) - (define-key Info-mode-map "[" 'Info-global-prev) - (define-key Info-mode-map "]" 'Info-global-next) - (define-key Info-mode-map "{" 'Info-page-prev) - (define-key Info-mode-map "}" 'Info-page-next) - (define-key Info-mode-map "=" 'Info-restore-point) - (define-key Info-mode-map "!" 'Info-select-node) - (define-key Info-mode-map "@" 'Info-follow-nearest-node) - (define-key Info-mode-map "," 'Info-index-next) - (define-key Info-mode-map "*" 'Info-elisp-ref) - (define-key Info-mode-map [tab] 'Info-next-reference) - (define-key Info-mode-map [(meta tab)] 'Info-prev-reference) - (define-key Info-mode-map [(shift tab)] 'Info-prev-reference) - (define-key Info-mode-map "\r" 'Info-follow-nearest-node) - ;; XEmacs addition - (define-key Info-mode-map 'backspace 'Info-scroll-prev) - (define-key Info-mode-map 'delete 'Info-scroll-prev) - (define-key Info-mode-map 'button2 'Info-follow-clicked-node) - (define-key Info-mode-map 'button3 'Info-select-node-menu)) - - -;; Info mode is suitable only for specially formatted data. -(put 'info-mode 'mode-class 'special) - -(defun Info-mode () - "Info mode is for browsing through the Info documentation tree. -Documentation in Info is divided into \"nodes\", each of which -discusses one topic and contains references to other nodes -which discuss related topics. Info has commands to follow -the references and show you other nodes. - -h Invoke the Info tutorial. -q Quit Info: return to the previously selected file or buffer. - -Selecting other nodes: -n Move to the \"next\" node of this node. -p Move to the \"previous\" node of this node. -m Pick menu item specified by name (or abbreviation). -1-9, 0 Pick first..ninth, last item in node's menu. - Menu items select nodes that are \"subsections\" of this node. -u Move \"up\" from this node (i.e., from a subsection to a section). -f or r Follow a cross reference by name (or abbrev). Type `l' to get back. -RET Follow cross reference or menu item indicated by cursor. -i Look up a topic in this file's Index and move to that node. -, (comma) Move to the next match from a previous `i' command. -l (letter L) Move back to the last node you were in. - -Moving within a node: -Space Scroll forward a full screen. DEL Scroll backward. -b Go to beginning of node. Meta-> Go to end of node. -TAB Go to next cross-reference. Meta-TAB Go to previous ref. - -Mouse commands: -Left Button Set point (usual text-mode functionality) -Middle Button Click on a highlighted node reference to go to it. -Right Button Pop up a menu of applicable Info commands. - -Left Button Double Click in window edges: - Top edge: Go up to the parent node, like `u'. - Left edge: Go to the previous node, like `p'. - Right edge: Go to the next node, like `n'. - Bottom edge: Follow first menu item, like `1'. - -Advanced commands: -g Move to node, file, or annotation tag specified by name. - Examples: `g Rectangles' `g (Emacs)Rectangles' `g Emacs'. -v Move to file, with filename completion. -k Look up a key sequence in Emacs manual (also C-h C-k at any time). -* Look up a function name in Emacs Lisp manual (also C-h C-f). -d Go to the main directory of Info files. -< or t Go to Top (first) node of this file. -> Go to last node in this file. -\[ Go to previous node, treating file as one linear document. -\] Go to next node, treating file as one linear document. -{ Scroll backward, or go to previous node if at top. -} Scroll forward, or go to next node if at bottom. -= Restore cursor position from last time in this node. -a Add a private note (annotation) to the current node. -x, j Add, jump to a bookmark (annotation tag). -s Search this Info file for a node containing the specified regexp. -e Edit the contents of the current node." - (kill-all-local-variables) - (setq major-mode 'Info-mode) - (setq mode-name "Info") - (use-local-map Info-mode-map) - (set-syntax-table text-mode-syntax-table) - (setq local-abbrev-table text-mode-abbrev-table) - (setq case-fold-search t) - (setq buffer-read-only t) -; (setq buffer-mouse-map Info-mode-mouse-map) - (make-local-variable 'Info-current-file) - (make-local-variable 'Info-current-subfile) - (make-local-variable 'Info-current-node) - (make-local-variable 'Info-tag-table-marker) - (make-local-variable 'Info-current-file-completions) - (make-local-variable 'Info-current-annotation-completions) - (make-local-variable 'Info-index-alternatives) - (make-local-variable 'Info-history) - ;; Faces are now defined by `defface'... - (make-local-variable 'mouse-track-click-hook) - (add-hook 'mouse-track-click-hook 'Info-maybe-follow-clicked-node) - (add-hook 'mouse-track-click-hook 'Info-mouse-track-double-click-hook) - ;; #### The console-on-window-system-p check is to allow this to - ;; work on tty's. The real problem here is that featurep really - ;; needs to have some device/console domain knowledge added to it. - (defvar info::toolbar) - (if (and (featurep 'toolbar) - (console-on-window-system-p) - (not Info-inhibit-toolbar)) - (set-specifier default-toolbar (cons (current-buffer) info::toolbar))) - (if (featurep 'menubar) - (progn - ;; make a local copy of the menubar, so our modes don't - ;; change the global menubar - (easy-menu-add '("Info" :filter Info-menu-filter)))) - (run-hooks 'Info-mode-hook) - (Info-set-mode-line)) - -(defvar Info-edit-map nil - "Local keymap used within `e' command of Info.") -(if Info-edit-map - nil - ;; XEmacs: remove FSF stuff - (setq Info-edit-map (make-sparse-keymap)) - (set-keymap-name Info-edit-map 'Info-edit-map) - (set-keymap-parents Info-edit-map (list text-mode-map)) - (define-key Info-edit-map "\C-c\C-c" 'Info-cease-edit)) - -;; Info-edit mode is suitable only for specially formatted data. -(put 'info-edit-mode 'mode-class 'special) - -(defun Info-edit-mode () - "Major mode for editing the contents of an Info node. -Like text mode with the addition of `Info-cease-edit' -which returns to Info mode for browsing. -\\{Info-edit-map}" - ) - -(defun Info-edit () - "Edit the contents of this Info node. -Allowed only if variable `Info-enable-edit' is non-nil." - (interactive) - (or Info-enable-edit - (error "Editing info nodes is not enabled")) - (use-local-map Info-edit-map) - (setq major-mode 'Info-edit-mode) - (setq mode-name "Info Edit") - (kill-local-variable 'modeline-buffer-identification) - (setq buffer-read-only nil) - ;; Make mode line update. - (set-buffer-modified-p (buffer-modified-p)) - (message (substitute-command-keys - "Editing: Type \\[Info-cease-edit] to return to info"))) - -(defun Info-cease-edit () - "Finish editing Info node; switch back to Info proper." - (interactive) - ;; Do this first, so nothing has changed if user C-g's at query. - (and (buffer-modified-p) - (y-or-n-p-maybe-dialog-box "Save the file? ") - (save-buffer)) - (use-local-map Info-mode-map) - (setq major-mode 'Info-mode) - (setq mode-name "Info") - (Info-set-mode-line) - (setq buffer-read-only t) - ;; Make mode line update. - (set-buffer-modified-p (buffer-modified-p)) - (and (marker-position Info-tag-table-marker) - (buffer-modified-p) - (message "Tags may have changed. Use Info-tagify if necessary"))) - -(defun Info-find-emacs-command-nodes (command) - "Return a list of locations documenting COMMAND in the XEmacs Info manual. -The locations are of the format used in Info-history, i.e. -\(FILENAME NODENAME BUFFERPOS\)." - (let ((where '()) - (cmd-desc (concat "^\\* " (regexp-quote (symbol-name command)) - ":\\s *\\(.*\\)\\.$"))) - (save-excursion - (Info-find-node "XEmacs" "Command Index") - ;; Take the index node off the Info history. - ;; ??? says this isn't safe someplace else... hmmm. - (setq Info-history (cdr Info-history)) - (goto-char (point-max)) - (while (re-search-backward cmd-desc nil t) - (setq where (cons (list Info-current-file - (buffer-substring - (match-beginning 1) - (match-end 1)) - 0) - where))) - where))) - -;;; fontification and mousability for info - -(defun Info-highlight-region (start end face) - (let ((extent nil) - (splitp (string-match "\n[ \t]+" (buffer-substring start end)))) - (if splitp - (save-excursion - (setq extent (make-extent start (progn (goto-char start) - (end-of-line) - (point)))) - (set-extent-face extent face) - (set-extent-property extent 'info t) - (set-extent-property extent 'highlight t) - (skip-chars-forward "\n\t ") - (setq extent (make-extent (point) end))) - (setq extent (make-extent start end))) - (set-extent-face extent face) - (set-extent-property extent 'info t) - (set-extent-property extent 'highlight t))) - -(defun Info-fontify-node () - (save-excursion - (let ((case-fold-search t) - (xref-regexp (concat "\\*" - (regexp-quote Info-footnote-tag) - "[ \n\t]*\\([^:]*\\):"))) - ;; Clear the old extents - (map-extents #'(lambda (x y) (delete-extent x)) - (current-buffer) (point-min) (point-max) nil) - ;; Break the top line iff it is > 79 characters. Some info nodes - ;; have top lines that span 3 lines because of long node titles. - ;; eg: (Info-find-node "lispref.info" "Window-Level Event Position Info") - (toggle-read-only -1) - (let ((extent nil) - (len 0) - (done nil) - (p (point-min))) - (goto-char (point-min)) - (re-search-forward "Node: *[^,]+, " nil t) - (setq len (- (point) (point-min)) - extent (make-extent (point-min) (point))) - (set-extent-property extent 'invisible t) - (while (not done) - (goto-char p) - (end-of-line) - (if (< (current-column) (+ 78 len)) - (setq done t) - (goto-char p) - (forward-char (+ 79 len)) - (re-search-backward "," nil t) - (forward-char 1) - (insert "\n") - (just-one-space) - (backward-delete-char 1) - (setq p (point) - len 0)))) - (toggle-read-only 1) - ;; Highlight xrefs in the top few lines of the node - (goto-char (point-min)) - (if (looking-at "^File: [^,: \t]+,?[ \t]+") - (progn - (goto-char (match-end 0)) - (while - (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?\n?") - (goto-char (match-end 0)) - (Info-highlight-region (match-beginning 1) (match-end 1) 'info-xref)))) - ;; Now get the xrefs in the body - (goto-char (point-min)) - (while (re-search-forward xref-regexp nil t) - (if (= (char-after (1- (match-beginning 0))) ?\") ; hack - nil - (Info-highlight-region (match-beginning 1) (match-end 1) 'info-xref))) - ;; then highlight the nodes in the menu. - (goto-char (point-min)) - (if (and (search-forward "\n* menu:" nil t)) - (while (re-search-forward - "^\\* \\([^:\t\n]*\\):?:[ \t\n]" nil t) - (Info-highlight-region (match-beginning 1) (match-end 1) 'info-node))) - (set-buffer-modified-p nil)))) - -(defun Info-construct-menu (&optional event) - "Construct a menu of Info commands. -Adds an entry for the node at EVENT, or under point if EVENT is omitted. -Used to construct the menubar submenu and popup menu." - (or event (setq event (point))) - (let ((case-fold-search t) - (xref-regexp (concat "\\*" - (regexp-quote Info-footnote-tag) - "[ \n\t]*\\([^:]*\\):")) - up-p prev-p next-p menu xrefs subnodes in) - (save-excursion - ;; `one-space' fixes "Notes:" xrefs that are split across lines. - (flet - ((one-space (text) - (let (i) - (while (setq i (string-match "[ \n\t]+" text i)) - (setq text (concat (substring text 0 i) " " - (substring text (match-end 0)))) - (setq i (1+ i))) - text))) - (goto-char (point-min)) - (if (looking-at ".*\\bNext:") (setq next-p t)) - (if (looking-at ".*\\bPrev:") (setq prev-p t)) - (if (looking-at ".*Up:") (setq up-p t)) - (setq menu (nconc - (if (setq in (Info-indicated-node event)) - (list (vector (one-space (cadr in)) in t) - "--:shadowEtchedIn")) - (list - ["Goto Info Top-level" Info-directory] - (vector "Next Node" 'Info-next :active next-p) - (vector "Previous Node" 'Info-prev :active prev-p) - (vector "Parent Node (Up)" 'Info-up :active up-p) - ["Goto Node..." Info-goto-node] - ["Goto Last Visited Node " Info-last]))) - ;; Find the xrefs and make a list - (while (re-search-forward xref-regexp nil t) - (setq xrefs (cons (one-space (buffer-substring (match-beginning 1) - (match-end 1))) - xrefs)))) - (setq xrefs (nreverse xrefs)) - (if (> (length xrefs) 21) (setcdr (nthcdr 20 xrefs) '(more))) - ;; Find the subnodes and make a list - (goto-char (point-min)) - (if (search-forward "\n* menu:" nil t) - (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t) - (setq subnodes (cons (buffer-substring (match-beginning 1) - (match-end 1)) - subnodes)))) - (setq subnodes (nreverse subnodes)) - (if (> (length subnodes) 21) (setcdr (nthcdr 20 subnodes) '(more)))) - (if xrefs - (nconc menu (list "--:shadowDoubleEtchedIn" - " Cross-References" - "--:singleLine") - (mapcar #'(lambda (xref) - (if (eq xref 'more) - "...more..." - (vector xref - (list 'Info-follow-reference xref)))) - xrefs))) - (if subnodes - (nconc menu (list "--:shadowDoubleEtchedIn" - " Sub-Nodes" - "--:singleLine") - (mapcar #'(lambda (node) - (if (eq node 'more) - "...more..." - (vector node (list 'Info-menu node)))) - subnodes))) - menu)) - -(defun Info-menu-filter (menu) - "This is the menu filter for the \"Info\" submenu." - (Info-construct-menu)) - -(defun Info-select-node-menu (event) - "Pops up a menu of applicable Info commands." - (interactive "e") - (select-window (event-window event)) - (let ((menu (Info-construct-menu event))) - (setq menu (nconc (list "Info" ; title: not displayed - " Info Commands" - "--:shadowDoubleEtchedOut") - menu)) - (let ((popup-menu-titles nil)) - (popup-menu menu)))) - -;;; Info toolbar support - -;; exit icon taken from GNUS -(defvar info::toolbar-exit-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name (if (featurep 'xpm) "info-exit.xpm" "info-exit.xbm") - toolbar-icon-directory))) - "Exit Info icon") - -(defvar info::toolbar-up-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name (if (featurep 'xpm) "info-up.xpm" "info-up.xbm") - toolbar-icon-directory))) - "Up icon") - -(defvar info::toolbar-next-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name (if (featurep 'xpm) "info-next.xpm" "info-next.xbm") - toolbar-icon-directory))) - "Next icon") - -(defvar info::toolbar-prev-icon - (if (featurep 'toolbar) - (toolbar-make-button-list - (expand-file-name (if (featurep 'xpm) "info-prev.xpm" "info-prev.xbm") - toolbar-icon-directory))) - "Prev icon") - -(defvar info::toolbar - (if (featurep 'toolbar) -; disabled until we get the next/prev-win icons working again. -; (cons (first initial-toolbar-spec) -; (cons (second initial-toolbar-spec) - '([info::toolbar-exit-icon - Info-exit - t - "Exit info"] - [info::toolbar-next-icon - Info-next - t - "Next entry in same section"] - [info::toolbar-prev-icon - Info-prev - t - "Prev entry in same section"] - [info::toolbar-up-icon - Info-up - t - "Up entry to enclosing section"] - ))) -;)) - -(provide 'info) - -(run-hooks 'Info-load-hook) - -;;; info.el ends here diff --git a/lisp/isearch-mode.el b/lisp/isearch-mode.el deleted file mode 100644 index cc5b3fa..0000000 --- a/lisp/isearch-mode.el +++ /dev/null @@ -1,1627 +0,0 @@ -;;; isearch-mode.el --- Incremental search minor mode. - -;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. - -;; Author: Daniel LaLiberte -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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: - -;; LCD Archive Entry: -;; isearch-mode|Daniel LaLiberte|liberte@cs.uiuc.edu -;; |A minor mode replacement for isearch.el. - -;;==================================================================== -;; Instructions - -;; Searching with isearch-mode.el should work just like isearch.el, -;; except it is done in a temporary minor mode that terminates when -;; you finish searching. - -;; Semi-modal searching is supported, using a recursive edit. If -;; isearching is started non-interactively by calling one of the -;; isearch commands (e.g. (isearch-forward), but not like gnus does -;; it: (call-interactively 'isearch-forward)), isearch-mode does not -;; return until the search is completed. You should still be able -;; switch buffers, so be careful not to get things confused. - -;; The key bindings active within isearch-mode are defined below in -;; `isearch-mode-map' which is given bindings close to the default -;; characters of isearch.el for version 19. With `isearch-mode', -;; however, you can bind multi-character keys and it should be easier -;; to add new commands. One bug though: keys with meta-prefix cannot -;; be longer than two chars. Also see minibuffer-local-isearch-map -;; for bindings active during `isearch-edit-string'. - -;; The search ring and completion commands automatically put you in -;; the minibuffer to edit the string. This gives you a chance to -;; modify the search string before executing the search. There are -;; three commands to terminate the editing: C-s and C-r exit the -;; minibuffer and search forward and reverse respectively, while C-m -;; exits and does a nonincremental search. - -;; Exiting immediately from isearch uses isearch-edit-string instead -;; of nonincremental-search, if search-nonincremental-instead is non-nil. -;; The name of this option should probably be changed if we decide to -;; keep the behavior. One difference is that isearch-edit-string does -;; not support word search yet; perhaps isearch-mode should support it -;; even for incremental searches, but how? - -;;==================================================================== -;;; Change History: - -;; Header: /import/kaplan/kaplan/liberte/Isearch/RCS/isearch-mode.el,v 1.3 92/06/29 13:10:08 liberte Exp Locker: liberte -;; Log: isearch-mode.el,v -;; -;; 20-aug-92 Hacked by jwz for Lucid Emacs 19.3. -;; -;; Revision 1.3 92/06/29 13:10:08 liberte -;; Moved modal isearch-mode handling into isearch-mode. -;; Got rid of buffer-local isearch variables. -;; isearch-edit-string used by ring adjustments, completion, and -;; nonincremental searching. C-s and C-r are additional exit commands. -;; Renamed all regex to regexp. -;; Got rid of found-start and found-point globals. -;; Generalized handling of upper-case chars. - -;; Revision 1.2 92/05/27 11:33:57 liberte -;; Emacs version 19 has a search ring, which is supported here. -;; Other fixes found in the version 19 isearch are included here. -;; -;; Also see variables search-caps-disable-folding, -;; search-nonincremental-instead, search-whitespace-regexp, and -;; commands isearch-toggle-regexp, isearch-edit-string. -;; -;; semi-modal isearching is supported. - -;; Changes for 1.1 -;; 3/18/92 Fixed invalid-regexp. -;; 3/18/92 Fixed yanking in regexps. - -;;; Code: - -(defgroup isearch nil - "Incremental search" - :prefix "search-" - :group 'matching) - - -(defun isearch-char-to-string (c) - (if (eventp c) - (make-string 1 (event-to-character c nil nil t)) - (make-string 1 c))) - -;(defun isearch-text-char-description (c) -; (isearch-char-to-string c)) - -(define-function 'isearch-text-char-description 'text-char-description) - - -;;;========================================================================= -;;; User-accessible variables - -(defvar search-last-string "" - "Last string search for by a search command. -This does not include direct calls to the primitive search functions, -and does not include searches that are aborted.") - -(defvar search-last-regexp "" - "Last string searched for by a regexp search command. -This does not include direct calls to the primitive search functions, -and does not include searches that are aborted.") - -(defconst search-exit-option t - "Non-nil means random control characters terminate incremental search.") - -(defcustom search-slow-window-lines 1 - "*Number of lines in slow search display windows. -These are the short windows used during incremental search on slow terminals. -Negative means put the slow search window at the top (normally it's at bottom) -and the value is minus the number of lines." - :type 'integer - :group 'isearch) - -(defcustom search-slow-speed 1200 - "*Highest terminal speed at which to use \"slow\" style incremental search. -This is the style where a one-line window is created to show the line -that the search has reached." - :type 'integer - :group 'isearch) - -(defcustom search-nonincremental-instead t - "*If non-nil, do a nonincremental search instead if exiting immediately." - :type 'boolean - :group 'isearch) - -(defcustom search-whitespace-regexp "\\(\\s \\|[\n\r]\\)+" - "*If non-nil, regular expression to match a sequence of whitespace chars." - :type 'regexp - :group 'isearch) - -;;;================================================================== -;;; Search ring. - -(defvar search-ring nil - "List of search string sequences.") -(defvar regexp-search-ring nil - "List of regular expression search string sequences.") - -(defcustom search-ring-max 16 - "*Maximum length of search ring before oldest elements are thrown away." - :type 'integer - :group 'isearch) -(defcustom regexp-search-ring-max 16 - "*Maximum length of regexp search ring before oldest elements are thrown away." - :type 'integer - :group 'isearch) - -(defvar search-ring-yank-pointer nil - "The tail of the search ring whose car is the last thing searched for.") -(defvar regexp-search-ring-yank-pointer nil - "The tail of the regular expression search ring whose car is the last -thing searched for.") - -;;;==================================================== -;;; Define isearch-mode keymap. - -(defvar isearch-mode-map - (let ((map (make-keymap))) - (set-keymap-name map 'isearch-mode-map) - - ;; Bind all printing characters to `isearch-printing-char'. - ;; This isn't normally necessary, but if a printing character were - ;; bound to something other than self-insert-command in global-map, - ;; then it would terminate the search and be executed without this. - (let ((i 32) - (str (make-string 1 0))) - (while (< i 127) - (aset str 0 i) - (define-key map str 'isearch-printing-char) - (setq i (1+ i)))) - (define-key map "\t" 'isearch-printing-char) - - ;; Several non-printing chars change the searching behavior. - ;; - (define-key map "\C-s" 'isearch-repeat-forward) - (define-key map "\M-\C-s" 'isearch-repeat-forward) - (define-key map "\C-r" 'isearch-repeat-backward) - (define-key map "\C-g" 'isearch-abort) - - (define-key map "\C-q" 'isearch-quote-char) - - (define-key map "\C-m" 'isearch-exit) - (define-key map "\C-j" 'isearch-printing-char) - (define-key map "\t" 'isearch-printing-char) - - (define-key map "\C-w" 'isearch-yank-word) - (define-key map "\C-y" 'isearch-yank-line) - (define-key map "\M-y" 'isearch-yank-kill) - - ;; Define keys for regexp chars * ? | - (define-key map "*" 'isearch-*-char) - (define-key map "?" 'isearch-*-char) - (define-key map "|" 'isearch-|-char) - - ;; Some bindings you may want to put in your isearch-mode-hook. - ;; Suggest some alternates... - ;; (define-key map "\C-t" 'isearch-toggle-regexp) - ;; (define-key map "\C-^" 'isearch-edit-string) - - ;; delete and backspace delete backward, f1 is help, and C-h can be either - (define-key map 'delete 'isearch-delete-char) - (define-key map 'backspace 'isearch-delete-char) - (define-key map '(control h) 'isearch-help-or-delete-char) - (define-key map 'f1 'isearch-mode-help) - (define-key map 'help 'isearch-mode-help) - - (define-key map "\M-n" 'isearch-ring-advance) - (define-key map "\M-p" 'isearch-ring-retreat) - (define-key map "\M- " 'isearch-whitespace-chars) - (define-key map "\M-\t" 'isearch-complete) - - (define-key map 'button2 'isearch-yank-x-selection) - - map) - "Keymap for isearch-mode.") - -(defvar minibuffer-local-isearch-map - (let ((map (make-sparse-keymap))) - ;; #### - this should also be minor-mode-ified - (set-keymap-parents map (list minibuffer-local-map)) - (set-keymap-name map 'minibuffer-local-isearch-map) - - ;;#### This should just arrange to use the usual Emacs minibuffer histories - (define-key map "\r" 'isearch-nonincremental-exit-minibuffer) - (define-key map "\M-n" 'isearch-ring-advance-edit) - (define-key map "\M-p" 'isearch-ring-retreat-edit) - (define-key map "\M-\t" 'isearch-complete-edit) - (define-key map "\C-s" 'isearch-forward-exit-minibuffer) - (define-key map "\C-r" 'isearch-reverse-exit-minibuffer) - map) - "Keymap for editing isearch strings in the minibuffer.") - -;;;======================================================== -;; Internal variables declared globally for byte-compiler. -;; These are all bound locally while editing the search string. - -(defvar isearch-forward nil) ; Searching in the forward direction. -(defvar isearch-regexp nil) ; Searching for a regexp. -(defvar isearch-word nil) ; Searching for words. - -(defvar isearch-cmds nil) ; Stack of search status sets. -(defvar isearch-string "") ; The current search string. -(defvar isearch-message "") ; text-char-description version of isearch-string - -(defvar isearch-success t) ; Searching is currently successful. -(defvar isearch-invalid-regexp nil) ; Regexp not well formed. -(defvar isearch-other-end nil) ; Start (end) of match if forward (backward). -(defvar isearch-wrapped nil) ; Searching restarted from the top (bottom). -(defvar isearch-barrier 0) -(defvar isearch-just-started nil) -(defvar isearch-buffer nil) ; the buffer we've frobbed the keymap of - -(defvar isearch-case-fold-search nil) - -(defvar isearch-adjusted nil) -(defvar isearch-slow-terminal-mode nil) -;;; If t, using a small window. -(defvar isearch-small-window nil) -(defvar isearch-opoint 0) -;;; The window configuration active at the beginning of the search. -(defvar isearch-window-configuration nil) -(defvar isearch-selected-frame nil) - -;; Flag to indicate a yank occurred, so don't move the cursor. -(defvar isearch-yank-flag nil) - -;;; A function to be called after each input character is processed. -;;; (It is not called after characters that exit the search.) -;;; It is only set from an optional argument to `isearch-mode'. -(defvar isearch-op-fun nil) - -;;; Is isearch-mode in a recursive edit for modal searching. -(defvar isearch-recursive-edit nil) - -;;; Should isearch be terminated after doing one search? -(defvar isearch-nonincremental nil) - -;; New value of isearch-forward after isearch-edit-string. -(defvar isearch-new-forward nil) - - -(defvar isearch-mode-hook nil - "Function(s) to call after starting up an incremental search.") - -(defvar isearch-mode-end-hook nil - "Function(s) to call after terminating an incremental search.") - -;;;============================================================== -;; Minor-mode-alist changes - kind of redundant with the -;; echo area, but if isearching in multiple windows, it can be useful. - -(add-minor-mode 'isearch-mode 'isearch-mode) - -(defvar isearch-mode nil) -(make-variable-buffer-local 'isearch-mode) - -;;;=============================================================== -;;; Entry points to isearch-mode. -;;; These four functions should replace those in loaddefs.el -;;; An alternative is to fset isearch-forward etc to isearch-mode, -;;; and look at the last command to set the options accordingly. - -(defun isearch-forward (&optional regexp-p) - "Do incremental search forward. -With a prefix argument, do an incremental regular expression search instead. -\\ -As you type characters, they add to the search string and are found. -The following non-printing keys are bound in `isearch-mode-map'. - -Type \\[isearch-delete-char] to cancel characters from end of search string. -Type \\[isearch-exit] to exit, leaving point at location found. -Type LFD (C-j) to match end of line. -Type \\[isearch-repeat-forward] to search again forward,\ - \\[isearch-repeat-backward] to search again backward. -Type \\[isearch-yank-word] to yank word from buffer onto end of search\ - string and search for it. -Type \\[isearch-yank-line] to yank rest of line onto end of search string\ - and search for it. -Type \\[isearch-quote-char] to quote control character to search for it. -Type \\[isearch-whitespace-chars] to match all whitespace chars in regexp. -\\[isearch-abort] while searching or when search has failed cancels input\ - back to what has - been found successfully. -\\[isearch-abort] when search is successful aborts and moves point to\ - starting point. - -Also supported is a search ring of the previous 16 search strings. -Type \\[isearch-ring-advance] to search for the next item in the search ring. -Type \\[isearch-ring-retreat] to search for the previous item in the search\ - ring. -Type \\[isearch-complete] to complete the search string using the search ring. - -The above keys are bound in the isearch-mode-map. To change the keys which - are special to isearch-mode, simply change the bindings in that map. - -Other control and meta characters terminate the search - and are then executed normally (depending on `search-exit-option'). - -If this function is called non-interactively, it does not return to -the calling function until the search is done. - -The bindings, more precisely: -\\{isearch-mode-map}" - -;; Non-standard bindings -;; Type \\[isearch-toggle-regexp] to toggle regular expression with normal searching. -;; Type \\[isearch-edit-string] to edit the search string in the minibuffer. -;; Terminate editing and return to incremental searching with CR. - - (interactive "_P") - (isearch-mode t (not (null regexp-p)) nil (not (interactive-p)))) - -(defun isearch-forward-regexp () - "\ -Do incremental search forward for regular expression. -Like ordinary incremental search except that your input -is treated as a regexp. See \\[isearch-forward] for more info." - (interactive "_") - (isearch-mode t t nil (not (interactive-p)))) - -(defun isearch-backward (&optional regexp-p) - "\ -Do incremental search backward. -With a prefix argument, do an incremental regular expression search instead. -See \\[isearch-forward] for more information." - (interactive "_P") - (isearch-mode nil (not (null regexp-p)) nil (not (interactive-p)))) - -(defun isearch-backward-regexp () - "\ -Do incremental search backward for regular expression. -Like ordinary incremental search except that your input -is treated as a regexp. See \\[isearch-forward] for more info." - (interactive "_") - (isearch-mode nil t nil (not (interactive-p)))) - -;; This function is way wrong, because you can't scroll the help -;; screen; as soon as you press a key, it's gone. I don't know of a -;; good way to fix it, though. -hniksic -(defun isearch-mode-help () - (interactive "_") - (let ((w (selected-window))) - (describe-function 'isearch-forward) - (select-window w)) - (isearch-update)) - - -;;;================================================================== -;; isearch-mode only sets up incremental search for the minor mode. -;; All the work is done by the isearch-mode commands. - -(defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p) - "Start isearch minor mode. Called by isearch-forward, etc." - - (if executing-kbd-macro (setq recursive-edit nil)) - - (let ((inhibit-quit t)) ; don't leave things in an inconsistent state... - - ;; Initialize global vars. - (setq isearch-buffer (current-buffer) - isearch-forward forward - isearch-regexp regexp - isearch-word word-p - isearch-op-fun op-fun - isearch-case-fold-search case-fold-search - isearch-string "" - isearch-message "" - isearch-cmds nil - isearch-success t - isearch-wrapped nil - isearch-barrier (point) - isearch-adjusted nil - isearch-yank-flag nil - isearch-invalid-regexp nil - isearch-slow-terminal-mode (and (<= (device-baud-rate) - search-slow-speed) - (> (window-height) - (* 4 search-slow-window-lines))) - isearch-other-end nil - isearch-small-window nil - isearch-just-started t - - isearch-opoint (point) - isearch-window-configuration (current-window-configuration) - - ;; #### Should we remember the old value of - ;; overriding-local-map? - overriding-local-map (progn - (set-keymap-parents isearch-mode-map - (nconc (current-minor-mode-maps) - (and (current-local-map) - (list (current-local-map))))) - isearch-mode-map) - isearch-selected-frame (selected-frame) - - isearch-mode (gettext " Isearch") - ) - - ;; XEmacs change: without clearing the match data, sometimes old values - ;; of isearch-other-end get used. Don't ask me why... - (store-match-data nil) - - (add-hook 'pre-command-hook 'isearch-pre-command-hook) - (set-buffer-modified-p (buffer-modified-p)) ; update modeline - (isearch-push-state) - - ) ; inhibit-quit is t before here - - (isearch-update) - (run-hooks 'isearch-mode-hook) - - ;; isearch-mode can be made modal (in the sense of not returning to - ;; the calling function until searching is completed) by entering - ;; a recursive-edit and exiting it when done isearching. - (if recursive-edit - (let ((isearch-recursive-edit t)) - (recursive-edit))) - ) - - -;;;==================================================== -;; Some high level utilities. Others below. - -(defun isearch-update () - ;; Called after each command to update the display. - (if (null unread-command-event) - (progn - (if (not (input-pending-p)) - (isearch-message)) - (if (and isearch-slow-terminal-mode - (not (or isearch-small-window - (pos-visible-in-window-p)))) - (let ((found-point (point))) - (setq isearch-small-window t) - (move-to-window-line 0) - (let ((window-min-height 1)) - (split-window nil (if (< search-slow-window-lines 0) - (1+ (- search-slow-window-lines)) - (- (window-height) - (1+ search-slow-window-lines))))) - (if (< search-slow-window-lines 0) - (progn (vertical-motion (- 1 search-slow-window-lines)) - (set-window-start (next-window) (point)) - (set-window-hscroll (next-window) - (window-hscroll)) - (set-window-hscroll (selected-window) 0)) - (other-window 1)) - (goto-char found-point))) - (if isearch-other-end - (if (< isearch-other-end (point)) - (isearch-highlight isearch-other-end (point)) - (isearch-highlight (point) isearch-other-end)) - (if (extentp isearch-extent) - (isearch-dehighlight nil))) - )) - (setq ;; quit-flag nil not for isearch-mode - isearch-adjusted nil - isearch-yank-flag nil) - ) - - -(defun isearch-done () - ;; Called by all commands that terminate isearch-mode. - (let ((inhibit-quit t)) ; danger danger! - (if (and isearch-buffer (buffer-live-p isearch-buffer)) - (save-excursion - ;; Some loser process filter might have switched the - ;; window's buffer, so be sure to set these variables back - ;; in the buffer we frobbed them in. But only if the buffer - ;; is still alive. - (set-buffer isearch-buffer) - ;; #### Should we restore the old value of - ;; overriding-local-map? - (setq overriding-local-map nil) - ;; Use remove-hook instead of just setting it to our saved value - ;; in case some process filter has created a buffer and modified - ;; the pre-command-hook in that buffer... yeah, this is obscure, - ;; and yeah, I was getting screwed by it. -jwz - (remove-hook 'pre-command-hook 'isearch-pre-command-hook) - (set-keymap-parents isearch-mode-map nil) - (setq isearch-mode nil) - (set-buffer-modified-p (buffer-modified-p));; update modeline - (isearch-dehighlight t))) - - ;; it's not critical that this be inside inhibit-quit, but leaving - ;; things in small-window-mode would be bad. - (let ((found-start (window-start (selected-window))) - (found-point (point))) - (cond ((eq (selected-frame) isearch-selected-frame) - (set-window-configuration isearch-window-configuration) - - (if isearch-small-window - (goto-char found-point) - ;; Exiting the save-window-excursion clobbers - ;; window-start; restore it. - (set-window-start (selected-window) found-start t)))) - ;; If there was movement, mark the starting position. - ;; Maybe should test difference between and set mark iff > threshold. - (if (and (buffer-live-p isearch-buffer) - (/= (point isearch-buffer) isearch-opoint)) - (progn - (push-mark isearch-opoint t nil isearch-buffer) - (or executing-kbd-macro (> (minibuffer-depth) 0) - (display-message 'command "Mark saved where search started")))) - ) - (setq isearch-buffer nil) - ) ; inhibit-quit is t before here - - (if (> (length isearch-string) 0) - ;; Update the ring data. - (if isearch-regexp - (if (not (setq regexp-search-ring-yank-pointer - (member isearch-string regexp-search-ring))) - (progn - (setq regexp-search-ring - (cons isearch-string regexp-search-ring) - regexp-search-ring-yank-pointer regexp-search-ring) - (if (> (length regexp-search-ring) regexp-search-ring-max) - (setcdr (nthcdr (1- regexp-search-ring-max) regexp-search-ring) - nil)))) - (if (not (setq search-ring-yank-pointer - ;; really need equal test instead of eq. - (member isearch-string search-ring))) - (progn - (setq search-ring (cons isearch-string search-ring) - search-ring-yank-pointer search-ring) - (if (> (length search-ring) search-ring-max) - (setcdr (nthcdr (1- search-ring-max) search-ring) nil)))))) - - (run-hooks 'isearch-mode-end-hook) - (if isearch-recursive-edit (exit-recursive-edit))) - - -;;;==================================================== -;; Commands active while inside of the isearch minor mode. - -(defun isearch-exit () - "Exit search normally. -However, if this is the first command after starting incremental -search and `search-nonincremental-instead' is non-nil, do an -incremental search via `isearch-edit-string'." - (interactive) - (if (and search-nonincremental-instead - (= 0 (length isearch-string))) - (let ((isearch-nonincremental t)) - (isearch-edit-string)) - (isearch-done))) - - -(defun isearch-edit-string () - "Edit the search string in the minibuffer. -The following additional command keys are active while editing. -\\ -\\[exit-minibuffer] to exit editing and resume incremental searching. -\\[isearch-forward-exit-minibuffer] to resume isearching forward. -\\[isearch-backward-exit-minibuffer] to resume isearching backward. -\\[isearch-ring-advance-edit] to replace the search string with the next\ - item in the search ring. -\\[isearch-ring-retreat-edit] to replace the search string with the next\ - item in the search ring. -\\[isearch-complete-edit] to complete the search string from the search ring." - - ;; Editing doesn't back up the search point. Should it? - (interactive) - - (condition-case nil - (let ((minibuffer-local-map minibuffer-local-isearch-map) - isearch-nonincremental ; should search nonincrementally? - isearch-new-string - isearch-new-message - (isearch-new-forward isearch-forward) - - ;; Locally bind all isearch global variables to protect them - ;; from recursive isearching. - (isearch-string isearch-string) - (isearch-message isearch-message) - (isearch-forward isearch-forward) ; set by commands below. - - (isearch-forward isearch-forward) - (isearch-regexp isearch-regexp) - (isearch-word isearch-word) - (isearch-op-fun isearch-op-fun) - (isearch-cmds isearch-cmds) - (isearch-success isearch-success) - (isearch-wrapped isearch-wrapped) - (isearch-barrier isearch-barrier) - (isearch-adjusted isearch-adjusted) - (isearch-yank-flag isearch-yank-flag) - (isearch-invalid-regexp isearch-invalid-regexp) - (isearch-other-end isearch-other-end) - (isearch-opoint isearch-opoint) - (isearch-slow-terminal-mode isearch-slow-terminal-mode) - (isearch-small-window isearch-small-window) - (isearch-recursive-edit isearch-recursive-edit) - (isearch-window-configuration (current-window-configuration)) - (isearch-selected-frame (selected-frame)) - ) - ;; Actually terminate isearching until editing is done. - ;; This is so that the user can do anything without failure, - ;; like switch buffers and start another isearch, and return. -;; (condition-case nil - (isearch-done) - ;;#### What does this mean? There is no such condition! -;; (exit nil)) ; was recursive editing - - (unwind-protect - (let ((prompt (isearch-message-prefix nil t)) - event) - ;; If the first character the user types when we prompt them - ;; for a string is the yank-word character, then go into - ;; word-search mode. Otherwise unread that character and - ;; read a string the normal way. - (let ((cursor-in-echo-area t)) - (display-message 'prompt prompt) - (setq event (next-command-event)) - (if (eq 'isearch-yank-word - (lookup-key isearch-mode-map (vector event))) - (setq isearch-word t) - (setq unread-command-event event))) - (setq isearch-new-string -;; (if (fboundp 'gmhist-old-read-from-minibuffer) -;; ;; Eschew gmhist crockery -;; (gmhist-old-read-from-minibuffer prompt isearch-string) - (read-string - prompt isearch-string - 't ;does its own history (but shouldn't) -;; (if isearch-regexp -;; ;; The search-rings aren't exactly minibuffer -;; ;; histories, but they are close enough -;; (cons 'regexp-search-ring -;; (- (length regexp-search-ring-yank-pointer) -;; (length regexp-search-ring))) -;; (cons 'search-ring -;; (- (length search-ring-yank-pointer) -;; (length search-ring)))) - ) -;; ) - isearch-new-message (mapconcat - 'isearch-text-char-description - isearch-new-string "")) - ) - ;; Always resume isearching by restarting it. - (isearch-mode isearch-forward - isearch-regexp - isearch-op-fun - isearch-recursive-edit - isearch-word) - ) - - ;; Copy new values in outer locals to isearch globals - (setq isearch-string isearch-new-string - isearch-message isearch-new-message - isearch-forward isearch-new-forward) - - ;; Empty isearch-string means use default. - (if (= 0 (length isearch-string)) - (setq isearch-string (if isearch-regexp search-last-regexp - search-last-string)) - ;; Set last search string now so it is set even if we fail. - (if search-last-regexp - (setq search-last-regexp isearch-string) - (setq search-last-string isearch-string))) - - ;; Reinvoke the pending search. - (isearch-push-state) - (isearch-search) - (isearch-update) - (if isearch-nonincremental (isearch-done))) - - (quit ; handle abort-recursive-edit - (isearch-abort) ;; outside of let to restore outside global values - ))) - -(defun isearch-nonincremental-exit-minibuffer () - (interactive) - (setq isearch-nonincremental t) - (exit-minibuffer)) - -(defun isearch-forward-exit-minibuffer () - (interactive) - (setq isearch-new-forward t) - (exit-minibuffer)) - -(defun isearch-reverse-exit-minibuffer () - (interactive) - (setq isearch-new-forward nil) - (exit-minibuffer)) - - -(defun isearch-abort () - "Quit incremental search mode if searching is successful, signalling quit. -Otherwise, revert to previous successful search and continue searching. -Use `isearch-exit' to quit without signalling." - (interactive) -;; (ding) signal instead below, if quiting - (discard-input) - (if isearch-success - ;; If search is successful, move back to starting point - ;; and really do quit. - (progn (goto-char isearch-opoint) - (isearch-done) ; exit isearch - (signal 'quit '(isearch))) ; and pass on quit signal - ;; If search is failing, rub out until it is once more successful. - (while (not isearch-success) (isearch-pop-state)) - (isearch-update))) - - -(defun isearch-repeat (direction) - ;; Utility for isearch-repeat-forward and -backward. - (if (eq isearch-forward (eq direction 'forward)) - ;; C-s in forward or C-r in reverse. - (if (equal isearch-string "") - ;; If search string is empty, use last one. - (setq isearch-string - (or (if isearch-regexp - (if regexp-search-ring-yank-pointer - (car regexp-search-ring-yank-pointer) - (car regexp-search-ring)) - (if search-ring-yank-pointer - (car search-ring-yank-pointer) - (car search-ring))) - "") - isearch-message - (mapconcat 'isearch-text-char-description - isearch-string "")) - ;; If already have what to search for, repeat it. - (or isearch-success - (progn - - (goto-char (if isearch-forward (point-min) (point-max))) - (setq isearch-wrapped t)))) - ;; C-s in reverse or C-r in forward, change direction. - (setq isearch-forward (not isearch-forward))) - - (setq isearch-barrier (point)) ; For subsequent \| if regexp. - (if (equal isearch-string "") - (setq isearch-success t) - (if (and (equal (match-end 0) (match-beginning 0)) - isearch-success - (not isearch-just-started)) - ;; If repeating a search that found - ;; an empty string, ensure we advance. - (if (if isearch-forward (eobp) (bobp)) - ;; nowhere to advance to, so fail (and wrap next time) - (progn - (setq isearch-success nil) - (and executing-kbd-macro - (not defining-kbd-macro) - (isearch-done)) - (ding nil 'isearch-failed)) - (forward-char (if isearch-forward 1 -1)) - (isearch-search)) - (isearch-search))) - (isearch-push-state) - (isearch-update)) - -(defun isearch-repeat-forward () - "Repeat incremental search forwards." - (interactive) - (isearch-repeat 'forward)) - -(defun isearch-repeat-backward () - "Repeat incremental search backwards." - (interactive) - (isearch-repeat 'backward)) - -(defun isearch-toggle-regexp () - "Toggle regexp searching on or off." - ;; The status stack is left unchanged. - (interactive) - (setq isearch-regexp (not isearch-regexp)) - (if isearch-regexp (setq isearch-word nil)) - (isearch-update)) - -(defun isearch-toggle-case-fold () - "Toggle case folding in searching on or off." - (interactive) - (setq isearch-case-fold-search - (if isearch-case-fold-search nil 'yes)) - (message "%s%s [case %ssensitive]" - (isearch-message-prefix) - isearch-message - (if isearch-case-fold-search "in" "")) - (setq isearch-adjusted t) - (sit-for 1) - (isearch-update)) - -(defun isearch-delete-char () - "Discard last input item and move point back. -If no previous match was done, just beep." - (interactive) - (if (null (cdr isearch-cmds)) - (ding nil 'isearch-quit) - (isearch-pop-state)) - (isearch-update)) - -(defun isearch-help-or-delete-char () - "Show Isearch help or delete backward in the search string. -Deletes when `delete-key-deletes-forward' is t and C-h is used for deleting -backwards." - (interactive) - (if (and delete-key-deletes-forward - (case (device-type) - ('tty (eq tty-erase-char ?\C-h)) - ('x (not (x-keysym-on-keyboard-sans-modifiers-p 'backspace))))) - (isearch-delete-char) - (isearch-mode-help))) - -(defun isearch-yank (chunk) - ;; Helper for isearch-yank-* functions. CHUNK can be a string or a - ;; function. - (let ((word (if (stringp chunk) - chunk - (save-excursion - (and (not isearch-forward) isearch-other-end - (goto-char isearch-other-end)) - (buffer-substring - (point) - (save-excursion - (funcall chunk) - (point))))))) - ;; if configured so that typing upper-case characters turns off case - ;; folding, then downcase the string so that yanking an upper-case - ;; word doesn't mess with case-foldedness. - (if (and search-caps-disable-folding isearch-case-fold-search) - (setq word (downcase word))) - (if isearch-regexp (setq word (regexp-quote word))) - (setq isearch-string (concat isearch-string word) - isearch-message - (concat isearch-message - (mapconcat 'isearch-text-char-description - word "")) - ;; Don't move cursor in reverse search. - isearch-yank-flag t)) - (isearch-search-and-update)) - - -(defun isearch-yank-word () - "Pull next word from buffer into search string." - (interactive) - (isearch-yank (function (lambda () (forward-word 1))))) - -(defun isearch-yank-line () - "Pull rest of line from buffer into search string." - (interactive) - (isearch-yank 'end-of-line)) - -(defun isearch-yank-kill () - "Pull rest of line from kill ring into search string." - (interactive) - (isearch-yank (current-kill 0))) - -(defun isearch-yank-sexp () - "Pull next expression from buffer into search string." - (interactive) - (isearch-yank 'forward-sexp)) - -(defun isearch-yank-x-selection () - "Pull the current X selection into the search string." - (interactive) - (isearch-yank (x-get-selection))) - -(defun isearch-yank-x-clipboard () - "Pull the current X clipboard selection into the search string." - (interactive) - (isearch-yank (x-get-clipboard))) - -(defun isearch-fix-case () - (if (and isearch-case-fold-search search-caps-disable-folding) - (setq isearch-case-fold-search - (no-upper-case-p isearch-string isearch-regexp))) - (setq isearch-mode (if case-fold-search - (if isearch-case-fold-search - " Isearch" ;As God Intended Mode - " ISeARch") ;Warn about evil case via StuDLYcAps. - "Isearch" -; (if isearch-case-fold-search -; " isearch" ;Presumably case-sensitive losers -; ;will notice this 1-char difference. -; " Isearch") ;Weenie mode. - ))) - -(defun isearch-search-and-update () - ;; Do the search and update the display. - (if (and (not isearch-success) - ;; unsuccessful regexp search may become - ;; successful by addition of characters which - ;; make isearch-string valid - (not isearch-regexp)) - nil - ;; In reverse search, adding stuff at - ;; the end may cause zero or many more chars to be - ;; matched, in the string following point. - ;; Allow all those possibilities without moving point as - ;; long as the match does not extend past search origin. - (if (and (not isearch-forward) (not isearch-adjusted) - (condition-case () - (progn - (isearch-fix-case) - (let ((case-fold-search isearch-case-fold-search)) - (looking-at (if isearch-regexp isearch-string - (regexp-quote isearch-string))))) - (error nil)) - (or isearch-yank-flag - (<= (match-end 0) - (min isearch-opoint isearch-barrier)))) - (setq isearch-success t - isearch-invalid-regexp nil - isearch-other-end (match-end 0)) - ;; Not regexp, not reverse, or no match at point. - (if (and isearch-other-end (not isearch-adjusted)) - (goto-char (if isearch-forward isearch-other-end - (min isearch-opoint - isearch-barrier - (1+ isearch-other-end))))) - (isearch-search) - )) - (isearch-push-state) - (if isearch-op-fun (funcall isearch-op-fun)) - (isearch-update)) - - -;; *, ?, and | chars can make a regexp more liberal. -;; They can make a regexp match sooner -;; or make it succeed instead of failing. -;; So go back to place last successful search started -;; or to the last ^S/^R (barrier), whichever is nearer. - -(defun isearch-*-char () - "Handle * and ? specially in regexps." - (interactive) - (if isearch-regexp - - (progn - (setq isearch-adjusted t) - (let ((cs (nth (if isearch-forward - 5 ; isearch-other-end - 2) ; saved (point) - (car (cdr isearch-cmds))))) - ;; (car isearch-cmds) is after last search; - ;; (car (cdr isearch-cmds)) is from before it. - (setq cs (or cs isearch-barrier)) - (goto-char - (if isearch-forward - (max cs isearch-barrier) - (min cs isearch-barrier)))))) - (isearch-process-search-char last-command-event)) - - - -(defun isearch-|-char () - "If in regexp search, jump to the barrier." - (interactive) - (if isearch-regexp - (progn - (setq isearch-adjusted t) - (goto-char isearch-barrier))) - (isearch-process-search-char last-command-event)) - -(defun isearch-quote-char () - "Quote special characters for incremental search." - (interactive) - (isearch-process-search-char (read-quoted-char (isearch-message t)))) - - -(defun isearch-return-char () - "Convert return into newline for incremental search. -Obsolete." - (interactive) - (isearch-process-search-char ?\n)) - - -(defun isearch-printing-char () - "Any other printing character => add it to the search string and search." - (interactive) - (isearch-process-search-char last-command-event)) - - -(defun isearch-whitespace-chars () - "Match all whitespace chars, if in regexp mode." - (interactive) - (if (and isearch-regexp search-whitespace-regexp) - (isearch-process-search-string search-whitespace-regexp " ") - (beep) - (isearch-process-search-char ?\ ) -; (if isearch-word -; nil -; (setq isearch-word t) -; (goto-char isearch-other-end) -; (isearch-process-search-char ?\ )) - )) - -(defun isearch-process-search-char (char) - ;; Append the char to the search string, update the message and re-search. - (isearch-process-search-string (isearch-char-to-string char) - (isearch-text-char-description char))) - -(defun isearch-process-search-string (string message) - (setq isearch-string (concat isearch-string string) - isearch-message (concat isearch-message message)) - (isearch-search-and-update)) - - -;;=========================================================== -;; Search Ring - -(defcustom search-ring-update nil - "*Non-nil if advancing or retreating in the search ring should cause search. -Default nil means edit the string from the search ring first." - :type 'boolean - :group 'isearch) - -(defun isearch-ring-adjust1 (advance) - ;; Helper for isearch-ring-adjust - (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) - (length (length ring)) - (yank-pointer-name (if isearch-regexp - 'regexp-search-ring-yank-pointer - 'search-ring-yank-pointer)) - (yank-pointer (eval yank-pointer-name))) - (if (zerop length) - () - (set yank-pointer-name - (setq yank-pointer - (nthcdr (% (+ (- length (length yank-pointer)) - (if advance (1- length) 1)) - length) ring))) - (setq isearch-string (car yank-pointer) - isearch-message (mapconcat 'isearch-text-char-description - isearch-string ""))))) - -(defun isearch-ring-adjust (advance) - ;; Helper for isearch-ring-advance and isearch-ring-retreat - (if (cdr isearch-cmds) ;; is there more than one thing on stack? - (isearch-pop-state)) - (isearch-ring-adjust1 advance) - (isearch-push-state) - (if search-ring-update - (progn - (isearch-search) - (isearch-update)) - (isearch-edit-string) - )) - -(defun isearch-ring-advance () - "Advance to the next search string in the ring." - ;; This could be more general to handle a prefix arg, but who would use it. - (interactive) - (isearch-ring-adjust 'advance)) - -(defun isearch-ring-retreat () - "Retreat to the previous search string in the ring." - (interactive) - (isearch-ring-adjust nil)) - -(defun isearch-ring-adjust-edit (advance) - "Use the next or previous search string in the ring while in minibuffer." - (isearch-ring-adjust1 advance) - (erase-buffer) - (insert isearch-string)) - -(defun isearch-ring-advance-edit () - (interactive) - (isearch-ring-adjust-edit 'advance)) - -(defun isearch-ring-retreat-edit () - "Retreat to the previous search string in the ring while in the minibuffer." - (interactive) - (isearch-ring-adjust-edit nil)) - - -(defun isearch-complete1 () - ;; Helper for isearch-complete and isearch-complete-edit - ;; Return t if completion OK, - (let* ((ring (if isearch-regexp regexp-search-ring search-ring)) - (alist (mapcar (function (lambda (string) (list string))) ring)) - (completion-ignore-case case-fold-search) - (completion (try-completion isearch-string alist)) - ) - (cond - ((eq completion t) - ;; isearch-string stays the same - t) - ((or completion ; not nil, must be a string - (= 0 (length isearch-string))) ; shouldn't have to say this - (if (equal completion isearch-string) ;; no extension? - (if completion-auto-help - (with-output-to-temp-buffer "*Isearch completions*" - (display-completion-list - (all-completions isearch-string alist)))) - (setq isearch-string completion)) - t) - (t - (temp-minibuffer-message "No completion") - nil)))) - -(defun isearch-complete () - "Complete the search string from the strings on the search ring. -The completed string is then editable in the minibuffer. -If there is no completion possible, say so and continue searching." - (interactive) - (if (isearch-complete1) - (isearch-edit-string) - ;; else - (sit-for 1) - (isearch-update))) - -(defun isearch-complete-edit () - "Same as `isearch-complete' except in the minibuffer." - (interactive) - (setq isearch-string (buffer-string)) - (if (isearch-complete1) - (progn - (erase-buffer) - (insert isearch-string)))) - - -;;;============================================================== -;; The search status stack (and isearch window-local variables, not used). - -(defun isearch-top-state () -;; (fetch-window-local-variables) - (let ((cmd (car isearch-cmds))) - (setq isearch-string (car cmd) - isearch-message (car (cdr cmd)) - isearch-success (nth 3 cmd) - isearch-forward (nth 4 cmd) - isearch-other-end (nth 5 cmd) - isearch-invalid-regexp (nth 6 cmd) - isearch-wrapped (nth 7 cmd) - isearch-barrier (nth 8 cmd)) - (goto-char (car (cdr (cdr cmd)))))) - -(defun isearch-pop-state () -;; (fetch-window-local-variables) - (setq isearch-cmds (cdr isearch-cmds)) - (isearch-top-state) - ) - -(defun isearch-push-state () - (setq isearch-cmds - (cons (list isearch-string isearch-message (point) - isearch-success isearch-forward isearch-other-end - isearch-invalid-regexp isearch-wrapped isearch-barrier) - isearch-cmds))) - - -;;;================================================================== -;; Message string - -(defun isearch-message (&optional c-q-hack ellipsis) - ;; Generate and print the message string. - (let ((cursor-in-echo-area ellipsis) - (m (concat - (isearch-message-prefix c-q-hack) - isearch-message - (isearch-message-suffix c-q-hack) - ))) - (if c-q-hack m (display-message 'progress (format "%s" m))))) - -(defun isearch-message-prefix (&optional c-q-hack nonincremental) - ;; If about to search, and previous search regexp was invalid, - ;; check that it still is. If it is valid now, - ;; let the message we display while searching say that it is valid. - (and isearch-invalid-regexp - (condition-case () - (progn (re-search-forward isearch-string (point) t) - (setq isearch-invalid-regexp nil)) - (error nil))) - ;; #### - Yo! Emacs assembles strings all over the place, they can't all - ;; be internationalized in the manner proposed below... Add an explicit - ;; call to `gettext' and have the string snarfer pluck the english - ;; strings out of the comment below. XEmacs is on a purespace diet! -Stig - (let ((m (concat (if isearch-success nil "failing ") - (if isearch-wrapped "wrapped ") - (if isearch-word "word ") - (if isearch-regexp "regexp ") - (if nonincremental "search" "I-search") - (if isearch-forward nil " backward") - ": " - ))) - (aset m 0 (upcase (aref m 0))) - (gettext m))) - -(defun isearch-message-suffix (&optional c-q-hack) - (concat (if c-q-hack "^Q" "") - (if isearch-invalid-regexp - (concat " [" isearch-invalid-regexp "]") - ""))) - -;;;;; #### - yuck...this is soooo lame. Is this really worth 4k of purespace??? -;;; -;;;(let ((i (logior (if isearch-success 32 0) -;;; (if isearch-wrapped 16 0) -;;; (if isearch-word 8 0) -;;; (if isearch-regexp 4 0) -;;; (if nonincremental 2 0) -;;; (if isearch-forward 1 0)))) -;;; (cond -;;; ((= i 63) (gettext "Wrapped word regexp search: ")) ; 111111 -;;; ((= i 62) (gettext "Wrapped word regexp search backward: ")) ; 111110 -;;; ((= i 61) (gettext "Wrapped word regexp I-search: ")) ; 111101 -;;; ((= i 60) (gettext "Wrapped word regexp I-search backward: ")) ; 111100 -;;; ((= i 59) (gettext "Wrapped word search: ")) ; 111011 -;;; ((= i 58) (gettext "Wrapped word search backward: ")) ; 111010 -;;; ((= i 57) (gettext "Wrapped word I-search: ")) ; 111001 -;;; ((= i 56) (gettext "Wrapped word I-search backward: ")) ; 111000 -;;; ((= i 55) (gettext "Wrapped regexp search: ")) ; 110111 -;;; ((= i 54) (gettext "Wrapped regexp search backward: ")) ; 110110 -;;; ((= i 53) (gettext "Wrapped regexp I-search: ")) ; 110101 -;;; ((= i 52) (gettext "Wrapped regexp I-search backward: ")) ; 110100 -;;; ((= i 51) (gettext "Wrapped search: ")) ; 110011 -;;; ((= i 50) (gettext "Wrapped search backward: ")) ; 110010 -;;; ((= i 49) (gettext "Wrapped I-search: ")) ; 110001 -;;; ((= i 48) (gettext "Wrapped I-search backward: ")) ; 110000 -;;; ((= i 47) (gettext "Word regexp search: ")) ; 101111 -;;; ((= i 46) (gettext "Word regexp search backward: ")) ; 101110 -;;; ((= i 45) (gettext "Word regexp I-search: ")) ; 101101 -;;; ((= i 44) (gettext "Word regexp I-search backward: ")) ; 101100 -;;; ((= i 43) (gettext "Word search: ")) ; 101011 -;;; ((= i 42) (gettext "Word search backward: ")) ; 101010 -;;; ((= i 41) (gettext "Word I-search: ")) ; 101001 -;;; ((= i 40) (gettext "Word I-search backward: ")) ; 101000 -;;; ((= i 39) (gettext "Regexp search: ")) ; 100111 -;;; ((= i 38) (gettext "Regexp search backward: ")) ; 100110 -;;; ((= i 37) (gettext "Regexp I-search: ")) ; 100101 -;;; ((= i 36) (gettext "Regexp I-search backward: ")) ; 100100 -;;; ((= i 35) (gettext "Search: ")) ; 100011 -;;; ((= i 34) (gettext "Search backward: ")) ; 100010 -;;; ((= i 33) (gettext "I-search: ")) ; 100001 -;;; ((= i 32) (gettext "I-search backward: ")) ; 100000 -;;; ((= i 31) (gettext "Failing wrapped word regexp search: ")) ; 011111 -;;; ((= i 30) (gettext "Failing wrapped word regexp search backward: ")) ; 011110 -;;; ((= i 29) (gettext "Failing wrapped word regexp I-search: ")) ; 011101 -;;; ((= i 28) (gettext "Failing wrapped word regexp I-search backward: ")) ; 011100 -;;; ((= i 27) (gettext "Failing wrapped word search: ")) ; 011011 -;;; ((= i 26) (gettext "Failing wrapped word search backward: ")) ; 011010 -;;; ((= i 25) (gettext "Failing wrapped word I-search: ")) ; 011001 -;;; ((= i 24) (gettext "Failing wrapped word I-search backward: ")) ; 011000 -;;; ((= i 23) (gettext "Failing wrapped regexp search: ")) ; 010111 -;;; ((= i 22) (gettext "Failing wrapped regexp search backward: ")) ; 010110 -;;; ((= i 21) (gettext "Failing wrapped regexp I-search: ")) ; 010101 -;;; ((= i 20) (gettext "Failing wrapped regexp I-search backward: ")) ; 010100 -;;; ((= i 19) (gettext "Failing wrapped search: ")) ; 010011 -;;; ((= i 18) (gettext "Failing wrapped search backward: ")) ; 010010 -;;; ((= i 17) (gettext "Failing wrapped I-search: ")) ; 010001 -;;; ((= i 16) (gettext "Failing wrapped I-search backward: ")) ; 010000 -;;; ((= i 15) (gettext "Failing word regexp search: ")) ; 001111 -;;; ((= i 14) (gettext "Failing word regexp search backward: ")) ; 001110 -;;; ((= i 13) (gettext "Failing word regexp I-search: ")) ; 001101 -;;; ((= i 12) (gettext "Failing word regexp I-search backward: ")) ; 001100 -;;; ((= i 11) (gettext "Failing word search: ")) ; 001011 -;;; ((= i 10) (gettext "Failing word search backward: ")) ; 001010 -;;; ((= i 9) (gettext "Failing word I-search: ")) ; 001001 -;;; ((= i 8) (gettext "Failing word I-search backward: ")) ; 001000 -;;; ((= i 7) (gettext "Failing regexp search: ")) ; 000111 -;;; ((= i 6) (gettext "Failing regexp search backward: ")) ; 000110 -;;; ((= i 5) (gettext "Failing regexp I-search: ")) ; 000101 -;;; ((= i 4) (gettext "Failing regexp I-search backward: ")) ; 000100 -;;; ((= i 3) (gettext "Failing search: ")) ; 000011 -;;; ((= i 2) (gettext "Failing search backward: ")) ; 000010 -;;; ((= i 1) (gettext "Failing I-search: ")) ; 000001 -;;; ((= i 0) (gettext "Failing I-search backward: ")) ; 000000 -;;; (t (error "Something's rotten"))))) - - -;;;======================================================== -;;; Exiting - -(put 'isearch-printing-char 'isearch-command t) -(put 'isearch-return-char 'isearch-command t) -(put 'isearch-repeat-forward 'isearch-command t) -(put 'isearch-repeat-backward 'isearch-command t) -(put 'isearch-delete-char 'isearch-command t) -(put 'isearch-help-or-delete-char 'isearch-command t) -(put 'isearch-abort 'isearch-command t) -(put 'isearch-quote-char 'isearch-command t) -(put 'isearch-exit 'isearch-command t) -(put 'isearch-printing-char 'isearch-command t) -(put 'isearch-printing-char 'isearch-command t) -(put 'isearch-yank-word 'isearch-command t) -(put 'isearch-yank-line 'isearch-command t) -(put 'isearch-yank-kill 'isearch-command t) -(put 'isearch-yank-sexp 'isearch-command t) -(put 'isearch-*-char 'isearch-command t) -(put 'isearch-*-char 'isearch-command t) -(put 'isearch-|-char 'isearch-command t) -(put 'isearch-toggle-regexp 'isearch-command t) -(put 'isearch-toggle-case-fold 'isearch-command t) -(put 'isearch-edit-string 'isearch-command t) -(put 'isearch-mode-help 'isearch-command t) -(put 'isearch-ring-advance 'isearch-command t) -(put 'isearch-ring-retreat 'isearch-command t) -(put 'isearch-ring-advance-edit 'isearch-command t) -(put 'isearch-ring-retreat-edit 'isearch-command t) -(put 'isearch-whitespace-chars 'isearch-command t) -(put 'isearch-complete 'isearch-command t) -(put 'isearch-complete-edit 'isearch-command t) -(put 'isearch-edit-string 'isearch-command t) -(put 'isearch-toggle-regexp 'isearch-command t) -(put 'isearch-forward-exit-minibuffer 'isearch-command t) -(put 'isearch-reverse-exit-minibuffer 'isearch-command t) -(put 'isearch-nonincremental-exit-minibuffer 'isearch-command t) -(put 'isearch-yank-x-selection 'isearch-command t) -(put 'isearch-yank-x-clipboard 'isearch-command t) - -;; scrolling the scrollbar should not terminate isearch. - -;; vertical scrollbar: -(put 'scrollbar-line-up 'isearch-command t) -(put 'scrollbar-line-down 'isearch-command t) -(put 'scrollbar-page-up 'isearch-command t) -(put 'scrollbar-page-down 'isearch-command t) -(put 'scrollbar-to-top 'isearch-command t) -(put 'scrollbar-to-bottom 'isearch-command t) -(put 'scrollbar-vertical-drag 'isearch-command t) - -;; horizontal scrollbar: -(put 'scrollbar-char-left 'isearch-command t) -(put 'scrollbar-char-right 'isearch-command t) -(put 'scrollbar-page-left 'isearch-command t) -(put 'scrollbar-page-right 'isearch-command t) -(put 'scrollbar-to-left 'isearch-command t) -(put 'scrollbar-to-right 'isearch-command t) -(put 'scrollbar-horizontal-drag 'isearch-command t) - -(defun isearch-pre-command-hook () - ;; - ;; For use as the value of `pre-command-hook' when isearch-mode is active. - ;; If the command about to be executed is not one of the isearch commands, - ;; then isearch-mode is turned off before that command is executed. - ;; - ;; If the command about to be executed is self-insert-command, or is a - ;; keyboard macro of a single key sequence which is bound to self-insert- - ;; command, then we add those chars to the search ring instead of inserting - ;; them in the buffer. In this way, the set of self-searching characters - ;; need not be exhaustively enumerated, but is derived from other maps. - ;; - (cond ((not (eq (current-buffer) isearch-buffer)) - ;; If the buffer (likely meaning "frame") has changed, bail. - ;; This can also happen if a proc filter has popped up another - ;; buffer, which is arguably a bad thing for it to have done, - ;; but the way in which isearch would have hosed you in that - ;; case is unarguably even worse. -jwz - (isearch-done)) - (t - (isearch-maybe-frob-keyboard-macros) - (if (and this-command - (symbolp this-command) - (get this-command 'isearch-command)) - nil ; then continue. - (isearch-done))))) - -(defun isearch-maybe-frob-keyboard-macros () - ;; - ;; If the command about to be executed is `self-insert-command' then change - ;; the command to `isearch-printing-char' instead, meaning add the last- - ;; typed character to the search string. - ;; - ;; If `this-command' is a string or a vector (that is, a keyboard macro) - ;; and it contains only one command, which is bound to self-insert-command, - ;; then do the same thing as for self-inserting commands: arrange for that - ;; character to be added to the search string. If we didn't do this, then - ;; typing a compose sequence (a la x-compose.el) would terminate the search - ;; and insert the character, instead of searching for that character. - ;; - ;; We should continue doing this, since it's pretty much the behavior one - ;; would expect, but it will stop being so necessary once key-translation- - ;; map exists and is used by x-compose.el and things like it, since the - ;; translation will have been done before we see the keys. - ;; - (cond ((eq this-command 'self-insert-command) - (setq this-command 'isearch-printing-char)) - ((and (or (stringp this-command) (vectorp this-command)) - (eq (key-binding this-command) 'self-insert-command)) - (setq last-command-event (character-to-event (aref this-command 0)) - last-command-char (and (stringp this-command) - (aref this-command 0)) - this-command 'isearch-printing-char)) - )) - - -;;;======================================================== -;;; Highlighting - -(defcustom isearch-highlight t - "*Whether isearch and query-replace should highlight the text which -currently matches the search-string.") - -(defvar isearch-extent nil) - -;; this face is initialized by x-faces.el since isearch is preloaded. -;; this face is now created in initialize-faces -;;(make-face 'isearch) - -(defun isearch-make-extent (begin end) - (let ((x (make-extent begin end (current-buffer)))) - ;; make the isearch extent always take prescedence over any mouse- - ;; highlighted extents we may be passing through, since isearch, being - ;; modal, is more interesting (there's nothing they could do with a - ;; mouse-highlighted extent while in the midst of a search anyway). - (set-extent-priority x (1+ mouse-highlight-priority)) - (set-extent-face x 'isearch) - (setq isearch-extent x))) - -(defun isearch-highlight (begin end) - (if (null isearch-highlight) - nil - ;; make sure isearch-extent is in the current buffer - (or (extentp isearch-extent) - (isearch-make-extent begin end)) - (set-extent-endpoints isearch-extent begin end (current-buffer)))) - -(defun isearch-dehighlight (totally) - (if (and isearch-highlight isearch-extent) - (if totally - (let ((inhibit-quit t)) - (if (extentp isearch-extent) - (delete-extent isearch-extent)) - (setq isearch-extent nil)) - (if (extentp isearch-extent) - (detach-extent isearch-extent) - (setq isearch-extent nil))))) - - -;;;======================================================== -;;; Searching - -(defun isearch-search () - ;; Do the search with the current search string. - (isearch-message nil t) - (isearch-fix-case) - (condition-case lossage - (let ((inhibit-quit nil) - (case-fold-search isearch-case-fold-search)) - (if isearch-regexp (setq isearch-invalid-regexp nil)) - (setq isearch-success - (funcall - (cond (isearch-word - (if isearch-forward - 'word-search-forward 'word-search-backward)) - (isearch-regexp - (if isearch-forward - 're-search-forward 're-search-backward)) - (t - (if isearch-forward 'search-forward 'search-backward))) - isearch-string nil t)) - (setq isearch-just-started nil) - (if isearch-success - (setq isearch-other-end - (if isearch-forward (match-beginning 0) (match-end 0))))) - - (quit (setq unread-command-event (character-to-event (quit-char))) - (setq isearch-success nil)) - - (invalid-regexp - (setq isearch-invalid-regexp (car (cdr lossage))) - (if (string-match - "\\`Premature \\|\\`Unmatched \\|\\`Invalid " - isearch-invalid-regexp) - (setq isearch-invalid-regexp (gettext "incomplete input"))))) - - (if isearch-success - nil - - ;; If we're being run inside a keyboard macro, then the call to - ;; ding will signal an error (to terminate the macro). We must - ;; turn off isearch-mode first, so that we aren't still in isearch - ;; mode after the macro exits. Note that isearch-recursive-edit - ;; must not be true if a keyboard macro is executing. - (if (and executing-kbd-macro (not defining-kbd-macro)) - (progn - (isearch-done) - (ding nil 'isearch-failed))) - - ;; Ding if failed this time after succeeding last time. - (and (nth 3 (car isearch-cmds)) - (ding nil 'isearch-failed)) - (goto-char (nth 2 (car isearch-cmds))))) - -;;;================================================= -;; This is called from incremental-search -;; if the first input character is the exit character. - -;; We store the search string in `isearch-string' -;; which has been bound already by `isearch-search' -;; so that, when we exit, it is copied into `search-last-string'. - -;(defun nonincremental-search (forward regexp) -; ;; This may be broken. Anyway, it is replaced by the isearch-edit-string. -; ;; Missing features: word search option, command history. -; (setq isearch-forward forward -; isearch-regexp regexp) -; (let (char function -; inhibit-quit -; (cursor-in-echo-area t)) -; ;; Prompt assuming not word search, -; (setq isearch-message -; (if isearch-regexp -; (if isearch-forward "Regexp search: " -; "Regexp search backward: ") -; (if isearch-forward "Search: " "Search backward: "))) -; (message "%s" isearch-message) -; ;; Read 1 char and switch to word search if it is ^W. -; (setq char (read-char)) -; (if (eq char search-yank-word-char) -; (setq isearch-message (if isearch-forward "Word search: " -; "Word search backward: ")) -; ;; Otherwise let that 1 char be part of the search string. -; (setq unread-command-event (character-to-event char)) -; ) -; (setq function -; (if (eq char search-yank-word-char) -; (if isearch-forward 'word-search-forward 'word-search-backward) -; (if isearch-regexp -; (if isearch-forward 're-search-forward 're-search-backward) -; (if isearch-forward 'search-forward 'search-backward)))) -; ;; Read the search string with corrected prompt. -; (setq isearch-string (read-string isearch-message isearch-string)) -; ;; Empty means use default. -; (if (= 0 (length isearch-string)) -; (setq isearch-string search-last-string) -; ;; Set last search string now so it is set even if we fail. -; (setq search-last-string isearch-string)) -; ;; Since we used the minibuffer, we should be available for redo. -; (setq command-history -; (cons (list function isearch-string) command-history)) -; ;; Go ahead and search. -; (if search-caps-disable-folding -; (setq isearch-case-fold-search -; (no-upper-case-p isearch-string isearch-regexp))) -; (let ((case-fold-search isearch-case-fold-search)) -; (funcall function isearch-string)))) - -(defun isearch-no-upper-case-p (string) - "Return t if there are no upper case chars in string. -But upper case chars preceded by \\ do not count since they -have special meaning in a regexp." - ;; this incorrectly returns t for "\\\\A" - (let ((case-fold-search nil)) - (not (string-match "\\(^\\|[^\\]\\)[A-Z]" string)))) -(make-obsolete 'isearch-no-upper-case-p 'no-upper-case-p) - -;; Used by etags.el and info.el -(defmacro with-caps-disable-folding (string &rest body) "\ -Eval BODY with `case-fold-search' let to nil if STRING contains -uppercase letters and `search-caps-disable-folding' is t." - `(let ((case-fold-search - (if (and case-fold-search search-caps-disable-folding) - (isearch-no-upper-case-p ,string) - case-fold-search))) - ,@body)) -(make-obsolete 'with-caps-disable-folding 'with-search-caps-disable-folding) -(put 'with-caps-disable-folding 'lisp-indent-function 1) -(put 'with-caps-disable-folding 'edebug-form-spec '(form body)) - -;;; isearch-mode.el ends here diff --git a/lisp/iso8859-1.el b/lisp/iso8859-1.el deleted file mode 100644 index 50bd40a..0000000 --- a/lisp/iso8859-1.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; iso8859-1.el --- Set case and syntax tables for Latin 1 - -;; Copyright (C) 1992, 1997 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski -;; Created: 19-aug-92 -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; created by jwz, 19-aug-92. -;; Sets the case and syntax tables for the ISO-8859/1 character set. - -;;; Code: - -(let ((table (standard-syntax-table))) - ;; - ;; The symbol characters - ;; - (modify-syntax-entry ?\240 "_" table) ; nobreakspace - (modify-syntax-entry ?\241 "." table) ; exclamdown - (modify-syntax-entry ?\242 "_" table) ; cent - (modify-syntax-entry ?\243 "_" table) ; sterling - (modify-syntax-entry ?\244 "_" table) ; currency - (modify-syntax-entry ?\245 "_" table) ; yen - (modify-syntax-entry ?\246 "_" table) ; brokenbar - (modify-syntax-entry ?\247 "_" table) ; section - (modify-syntax-entry ?\250 "_" table) ; diaeresis - (modify-syntax-entry ?\251 "_" table) ; copyright - (modify-syntax-entry ?\252 "_" table) ; ordfeminine - (modify-syntax-entry ?\253 "(\273" table) ; guillemotleft - (modify-syntax-entry ?\254 "_" table) ; notsign - (modify-syntax-entry ?\255 "_" table) ; hyphen - (modify-syntax-entry ?\256 "_" table) ; registered - (modify-syntax-entry ?\257 "_" table) ; macron - (modify-syntax-entry ?\260 "_" table) ; degree - (modify-syntax-entry ?\261 "_" table) ; plusminus - (modify-syntax-entry ?\262 "_" table) ; twosuperior - (modify-syntax-entry ?\263 "_" table) ; threesuperior - (modify-syntax-entry ?\264 "_" table) ; acute - (modify-syntax-entry ?\265 "_" table) ; mu - (modify-syntax-entry ?\266 "_" table) ; paragraph - (modify-syntax-entry ?\267 "_" table) ; periodcentered - (modify-syntax-entry ?\270 "_" table) ; cedilla - (modify-syntax-entry ?\271 "_" table) ; onesuperior - (modify-syntax-entry ?\272 "_" table) ; masculine - (modify-syntax-entry ?\273 ")\253" table) ; guillemotright - (modify-syntax-entry ?\274 "_" table) ; onequarter - (modify-syntax-entry ?\275 "_" table) ; onehalf - (modify-syntax-entry ?\276 "_" table) ; threequarters - (modify-syntax-entry ?\277 "_" table) ; questiondown - ;; - ;; the upper-case characters (plus "multiply" and "ssharp") - ;; - (modify-syntax-entry ?\300 "w" table) ; Agrave - (modify-syntax-entry ?\301 "w" table) ; Aacute - (modify-syntax-entry ?\302 "w" table) ; Acircumflex - (modify-syntax-entry ?\303 "w" table) ; Atilde - (modify-syntax-entry ?\304 "w" table) ; Adiaeresis - (modify-syntax-entry ?\305 "w" table) ; Aring - (modify-syntax-entry ?\306 "w" table) ; AE - (modify-syntax-entry ?\307 "w" table) ; Ccedilla - (modify-syntax-entry ?\310 "w" table) ; Egrave - (modify-syntax-entry ?\311 "w" table) ; Eacute - (modify-syntax-entry ?\312 "w" table) ; Ecircumflex - (modify-syntax-entry ?\313 "w" table) ; Ediaeresis - (modify-syntax-entry ?\314 "w" table) ; Igrave - (modify-syntax-entry ?\315 "w" table) ; Iacute - (modify-syntax-entry ?\316 "w" table) ; Icircumflex - (modify-syntax-entry ?\317 "w" table) ; Idiaeresis - (modify-syntax-entry ?\320 "w" table) ; ETH - (modify-syntax-entry ?\321 "w" table) ; Ntilde - (modify-syntax-entry ?\322 "w" table) ; Ograve - (modify-syntax-entry ?\323 "w" table) ; Oacute - (modify-syntax-entry ?\324 "w" table) ; Ocircumflex - (modify-syntax-entry ?\325 "w" table) ; Otilde - (modify-syntax-entry ?\326 "w" table) ; Odiaeresis - (modify-syntax-entry ?\327 "_" table) ; multiply - (modify-syntax-entry ?\330 "w" table) ; Ooblique - (modify-syntax-entry ?\331 "w" table) ; Ugrave - (modify-syntax-entry ?\332 "w" table) ; Uacute - (modify-syntax-entry ?\333 "w" table) ; Ucircumflex - (modify-syntax-entry ?\334 "w" table) ; Udiaeresis - (modify-syntax-entry ?\335 "w" table) ; Yacute - (modify-syntax-entry ?\336 "w" table) ; THORN - (modify-syntax-entry ?\337 "w" table) ; ssharp - ;; - ;; the lower-case characters (plus "division" and "ydiaeresis") - ;; - (modify-syntax-entry ?\340 "w" table) ; agrave - (modify-syntax-entry ?\341 "w" table) ; aacute - (modify-syntax-entry ?\342 "w" table) ; acircumflex - (modify-syntax-entry ?\343 "w" table) ; atilde - (modify-syntax-entry ?\344 "w" table) ; adiaeresis - (modify-syntax-entry ?\345 "w" table) ; aring - (modify-syntax-entry ?\346 "w" table) ; ae - (modify-syntax-entry ?\347 "w" table) ; ccedilla - (modify-syntax-entry ?\350 "w" table) ; egrave - (modify-syntax-entry ?\351 "w" table) ; eacute - (modify-syntax-entry ?\352 "w" table) ; ecircumflex - (modify-syntax-entry ?\353 "w" table) ; ediaeresis - (modify-syntax-entry ?\354 "w" table) ; igrave - (modify-syntax-entry ?\355 "w" table) ; iacute - (modify-syntax-entry ?\356 "w" table) ; icircumflex - (modify-syntax-entry ?\357 "w" table) ; idiaeresis - (modify-syntax-entry ?\360 "w" table) ; eth - (modify-syntax-entry ?\361 "w" table) ; ntilde - (modify-syntax-entry ?\362 "w" table) ; ograve - (modify-syntax-entry ?\363 "w" table) ; oacute - (modify-syntax-entry ?\364 "w" table) ; ocircumflex - (modify-syntax-entry ?\365 "w" table) ; otilde - (modify-syntax-entry ?\366 "w" table) ; odiaeresis - (modify-syntax-entry ?\367 "_" table) ; division - (modify-syntax-entry ?\370 "w" table) ; ooblique - (modify-syntax-entry ?\371 "w" table) ; ugrave - (modify-syntax-entry ?\372 "w" table) ; uacute - (modify-syntax-entry ?\373 "w" table) ; ucircumflex - (modify-syntax-entry ?\374 "w" table) ; udiaeresis - (modify-syntax-entry ?\375 "w" table) ; yacute - (modify-syntax-entry ?\376 "w" table) ; thorn - (modify-syntax-entry ?\377 "w" table) ; ydiaeresis - ) - - -(defconst iso8859/1-case-table nil - "The case table for ISO-8859/1 characters.") - -;;; This macro expands into -;;; (setq iso8859/1-case-table (purecopy '("..." nil nil nil))) -;;; doing the computation of the case table at compile-time. - -((macro - . (lambda (&rest pairs) - (let ((downcase (make-string 256 0)) - (i 0)) - (while (< i 256) - (aset downcase i (if (and (>= i ?A) (<= i ?Z)) (+ i 32) i)) - (setq i (1+ i))) - (while pairs - (aset downcase (car (car pairs)) (car (cdr (car pairs)))) - (setq pairs (cdr pairs))) - (cons 'setq - (cons 'iso8859/1-case-table - (list (list 'purecopy - (list 'quote - (list downcase nil nil nil))))))))) - - (?\300 ?\340) ; Agrave - (?\301 ?\341) ; Aacute - (?\302 ?\342) ; Acircumflex - (?\303 ?\343) ; Atilde - (?\304 ?\344) ; Adiaeresis - (?\305 ?\345) ; Aring - (?\306 ?\346) ; AE - (?\307 ?\347) ; Ccedilla - (?\310 ?\350) ; Egrave - (?\311 ?\351) ; Eacute - (?\312 ?\352) ; Ecircumflex - (?\313 ?\353) ; Ediaeresis - (?\314 ?\354) ; Igrave - (?\315 ?\355) ; Iacute - (?\316 ?\356) ; Icircumflex - (?\317 ?\357) ; Idiaeresis - (?\320 ?\360) ; ETH - (?\321 ?\361) ; Ntilde - (?\322 ?\362) ; Ograve - (?\323 ?\363) ; Oacute - (?\324 ?\364) ; Ocircumflex - (?\325 ?\365) ; Otilde - (?\326 ?\366) ; Odiaeresis - (?\330 ?\370) ; Ooblique - (?\331 ?\371) ; Ugrave - (?\332 ?\372) ; Uacute - (?\333 ?\373) ; Ucircumflex - (?\334 ?\374) ; Udiaeresis - (?\335 ?\375) ; Yacute - (?\336 ?\376) ; THORN - ) - -(set-standard-case-table (mapcar 'copy-sequence iso8859/1-case-table)) - -(setq-default ctl-arrow 'iso-8859/1) - -(provide 'iso8859-1) - -;;; iso8859-1.el ends here diff --git a/lisp/itimer.el b/lisp/itimer.el deleted file mode 100644 index aab95e4..0000000 --- a/lisp/itimer.el +++ /dev/null @@ -1,872 +0,0 @@ -;;; Interval timers for GNU Emacs -;;; Copyright (C) 1988, 1991, 1993, 1997, 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 - -(provide 'itimer) - -;; `itimer' feature means Emacs-Lisp programmers get: -;; itimerp -;; itimer-live-p -;; itimer-value -;; itimer-restart -;; itimer-function -;; itimer-uses-arguments -;; itimer-function-arguments -;; set-itimer-value -;; set-itimer-restart -;; set-itimer-function -;; set-itimer-uses-arguments -;; set-itimer-function-arguments -;; get-itimer -;; start-itimer -;; read-itimer -;; delete-itimer -;; activate-itimer -;; -;; Interactive users get these commands: -;; edit-itimers -;; list-itimers -;; start-itimer -;; -;; See the doc strings of these functions for more information. - -(defvar itimer-version "1.07" - "Version number of the itimer package.") - -(defvar itimer-list nil - "List of all active itimers.") - -(defvar itimer-process nil - "Process that drives all itimers, if a subprocess is being used.") - -(defvar itimer-timer nil - "Emacs internal timer that drives the itimer system, if a subprocess -is not being used to drive the system.") - -(defvar itimer-timer-last-wakeup nil - "The time the timer driver function last ran.") - -(defvar itimer-short-interval (if (featurep 'lisp-float-type) 1e-3 1) - "Interval used for scheduling an event a very short time in the future. -Used internally to make the scheduler wake up early. -Unit is seconds.") - -;; This value is maintained internally; it does not determine -;; itimer granularity. Itimer granularity is 1 second if your -;; Emacs doesn't support floats or your system doesn't have a -;; clock with microsecond granularity. Otherwise granularity is -;; to the microsecond, although you can't possibly get timers to be -;; executed with this kind of accuracy in practice. There will -;; be delays due to system and Emacs internal activity that delay -;; dealing with synchronous events and process output. -(defvar itimer-next-wakeup itimer-short-interval - "Itimer process will wakeup to service running itimers within this -many seconds.") - -(defvar itimer-edit-map nil - "Keymap used when in Itimer Edit mode.") - -(if itimer-edit-map - () - (setq itimer-edit-map (make-sparse-keymap)) - (define-key itimer-edit-map "s" 'itimer-edit-set-field) - (define-key itimer-edit-map "d" 'itimer-edit-delete-itimer) - (define-key itimer-edit-map "q" 'itimer-edit-quit) - (define-key itimer-edit-map "\t" 'itimer-edit-next-field) - (define-key itimer-edit-map " " 'next-line) - (define-key itimer-edit-map "n" 'next-line) - (define-key itimer-edit-map "p" 'previous-line) - (define-key itimer-edit-map "\C-?" 'itimer-edit-previous-field) - (define-key itimer-edit-map "x" 'start-itimer) - (define-key itimer-edit-map "?" 'itimer-edit-help)) - -(defvar itimer-inside-driver nil) - -(defvar itimer-edit-start-marker nil) - -;; macros must come first... or byte-compile'd code will throw back its -;; head and scream. - -(defmacro itimer-decrement (variable) - (list 'setq variable (list '1- variable))) - -(defmacro itimer-increment (variable) - (list 'setq variable (list '1+ variable))) - -(defmacro itimer-signum (n) - (list 'if (list '> n 0) 1 - (list 'if (list 'zerop n) 0 -1))) - -;; Itimer access functions should behave as if they were subrs. These -;; macros are used to check the arguments to the itimer functions and -;; signal errors appropriately if the arguments are not valid. - -(defmacro check-itimer (var) - "If VAR is not bound to an itimer, signal wrong-type-argument. -This is a macro." - (list 'setq var - (list 'if (list 'itimerp var) var - (list 'signal ''wrong-type-argument - (list 'list ''itimerp var))))) - -(defmacro check-itimer-coerce-string (var) - "If VAR is not bound to a string, look up the itimer that it names and -bind VAR to it. Otherwise, if VAR is not bound to an itimer, signal -wrong-type-argument. This is a macro." - (list 'setq var - (list 'cond - (list (list 'itimerp var) var) - (list (list 'stringp var) (list 'get-itimer var)) - (list t (list 'signal ''wrong-type-argument - (list 'list ''string-or-itimer-p var)))))) - -(defmacro check-nonnegative-number (var) - "If VAR is not bound to a number, signal wrong-type-argument. -If VAR is not bound to a positive number, signal args-out-of-range. -This is a macro." - (list 'setq var - (list 'if (list 'not (list 'numberp var)) - (list 'signal ''wrong-type-argument - (list 'list ''natnump var)) - (list 'if (list '< var 0) - (list 'signal ''args-out-of-range (list 'list var)) - var)))) - -(defmacro check-string (var) - "If VAR is not bound to a string, signal wrong-type-argument. -This is a macro." - (list 'setq var - (list 'if (list 'stringp var) var - (list 'signal ''wrong-type-argument - (list 'list ''stringp var))))) - -;; Functions to access and modify itimer attributes. - -(defun itimerp (obj) - "Return t if OBJ is an itimer." - (and (consp obj) (eq (length obj) 8))) - -(defun itimer-live-p (obj) - "Return non-nil if OBJ is an itimer and is active. -``Active'' means Emacs will run it when it expires. -`activate-timer' must be called on an itimer to make it active. -Itimers started with `start-itimer' are automatically active." - (and (itimerp obj) (memq obj itimer-list))) - -(defun itimer-name (itimer) - "Return the name of ITIMER." - (check-itimer itimer) - (car itimer)) - -(defun itimer-value (itimer) - "Return the number of seconds until ITIMER expires." - (check-itimer itimer) - (nth 1 itimer)) - -(defun itimer-restart (itimer) - "Return the value to which ITIMER will be set at restart. -Return nil if this itimer doesn't restart." - (check-itimer itimer) - (nth 2 itimer)) - -(defun itimer-function (itimer) - "Return the function of ITIMER. -This function is called each time ITIMER expires." - (check-itimer itimer) - (nth 3 itimer)) - -(defun itimer-is-idle (itimer) - "Return non-nil if ITIMER is an idle timer. -Normal timers expire after a set interval. Idle timers expire -only after Emacs has been idle for a specific interval. -``Idle'' means no command events occur within the interval." - (check-itimer itimer) - (nth 4 itimer)) - -(defun itimer-uses-arguments (itimer) - "Return non-nil if the function of ITIMER will be called with arguments. -ITIMER's function is called with the arguments each time ITIMER expires. -The arguments themselves are retrievable with `itimer-function-arguments'." - (check-itimer itimer) - (nth 5 itimer)) - -(defun itimer-function-arguments (itimer) - "Return the function arguments of ITIMER as a list. -ITIMER's function is called with these argument each time ITIMER expires." - (check-itimer itimer) - (nth 6 itimer)) - -(defun itimer-recorded-run-time (itimer) - (check-itimer itimer) - (nth 7 itimer)) - -(defun set-itimer-value (itimer value) - "Set the timeout value of ITIMER to be VALUE. -Itimer will expire in this many seconds. -If your version of Emacs supports floating point numbers then -VALUE can be a floating point number. Otherwise it -must be an integer. -Returns VALUE." - (check-itimer itimer) - (check-nonnegative-number value) - (let ((inhibit-quit t)) - ;; If the itimer is in the active list, and under the new - ;; timeout value would expire before we would normally - ;; wakeup, wakeup now and recompute a new wakeup time. - (or (and (< value itimer-next-wakeup) - (and (itimer-name itimer) (get-itimer (itimer-name itimer))) - (progn (itimer-driver-wakeup) - (setcar (cdr itimer) value) - (itimer-driver-wakeup) - t )) - (setcar (cdr itimer) value)) - value)) - -;; Same as set-itimer-value but does not wakeup the driver. -;; Only should be used by the drivers when processing expired timers. -(defun set-itimer-value-internal (itimer value) - (check-itimer itimer) - (check-nonnegative-number value) - (setcar (cdr itimer) value)) - -(defun set-itimer-restart (itimer restart) - "Set the restart value of ITIMER to be RESTART. -If RESTART is nil, ITIMER will not restart when it expires. -If your version of Emacs supports floating point numbers then -RESTART can be a floating point number. Otherwise it -must be an integer. -Returns RESTART." - (check-itimer itimer) - (if restart (check-nonnegative-number restart)) - (setcar (cdr (cdr itimer)) restart)) - -(defun set-itimer-function (itimer function) - "Set the function of ITIMER to be FUNCTION. -FUNCTION will be called when itimer expires. -Returns FUNCTION." - (check-itimer itimer) - (setcar (nthcdr 3 itimer) function)) - -(defun set-itimer-is-idle (itimer flag) - "Set flag that says whether ITIMER is an idle timer. -If FLAG is non-nil, then ITIMER will be considered an idle timer. -Returns FLAG." - (check-itimer itimer) - (setcar (nthcdr 4 itimer) flag)) - -(defun set-itimer-uses-arguments (itimer flag) - "Set flag that says whether the function of ITIMER is called with arguments. -If FLAG is non-nil, then the function will be called with one argument, -otherwise the function will be called with no arguments. -Returns FLAG." - (check-itimer itimer) - (setcar (nthcdr 5 itimer) flag)) - -(defun set-itimer-function-arguments (itimer &optional arguments) - "Set the function arguments of ITIMER to be ARGUMENTS. -The function of ITIMER will be called with ARGUMENTS when itimer expires. -Returns ARGUMENTS." - (check-itimer itimer) - (setcar (nthcdr 6 itimer) arguments)) - -(defun set-itimer-recorded-run-time (itimer time) - (check-itimer itimer) - (setcar (nthcdr 7 itimer) time)) - -(defun get-itimer (name) - "Return itimer named NAME, or nil if there is none." - (check-string name) - (assoc name itimer-list)) - -(defun read-itimer (prompt &optional initial-input) - "Read the name of an itimer from the minibuffer and return the itimer -associated with that name. The user is prompted with PROMPT. -Optional second arg INITIAL-INPUT non-nil is inserted into the -minibuffer as initial user input." - (get-itimer (completing-read prompt itimer-list nil 'confirm initial-input))) - -(defun delete-itimer (itimer) - "Delete ITIMER. ITIMER may be an itimer or the name of one." - (check-itimer-coerce-string itimer) - (setq itimer-list (delq itimer itimer-list))) - -(defun start-itimer (name function value &optional restart - is-idle with-args &rest function-arguments) - "Start an itimer. -Arguments are - NAME, FUNCTION, VALUE &optional RESTART, IS-IDLE, WITH-ARGS, &rest FUNCTION-ARGUMENTS. -NAME is an identifier for the itimer. It must be a string. If an itimer - already exists with this name, NAME will be modified slightly to make - it unique. -FUNCTION should be a function (or symbol naming one). It - will be called each time the itimer expires with arguments of - FUNCTION-ARGUMENTS. The function can access the itimer that - invoked it through the variable `current-itimer'. If WITH-ARGS - is nil then FUNCTION is called with no arguments. This is for - backward compatibility with older versions of the itimer - package which always called FUNCTION with no arguments. -VALUE is the number of seconds until this itimer expires. - If your version of Emacs supports floating point numbers then - VALUE can be a floating point number. Otherwise it - must be an integer. -Optional fourth arg RESTART non-nil means that this itimer should be - restarted automatically after its function is called. Normally an itimer - is deleted at expiration after its function has returned. - If non-nil, RESTART should be a number indicating the value at which - the itimer should be set at restart time. -Optional fifth arg IS-IDLE specifies if this is an idle timer. - Normal timers expire after a set interval. Idle timers expire - only after Emacs has been idle for specific interval. - ``Idle'' means no command events occur within the interval. -Returns the newly created itimer." - (interactive - (list (completing-read "Start itimer: " itimer-list) - (read (completing-read "Itimer function: " obarray 'fboundp)) - (let (value) - (while (or (not (numberp value)) (< value 0)) - (setq value (read-from-minibuffer "Itimer value: " nil nil t))) - value) - (let ((restart t)) - (while (and restart (or (not (numberp restart)) (< restart 0))) - (setq restart (read-from-minibuffer "Itimer restart: " - nil nil t))) - restart) - ;; hard to imagine the user specifying these interactively - nil - nil )) - (check-string name) - (check-nonnegative-number value) - (if restart (check-nonnegative-number restart)) - ;; Make proposed itimer name unique if it's not already. - (let ((oname name) - (num 2)) - (while (get-itimer name) - (setq name (format "%s<%d>" oname num)) - (itimer-increment num))) - (activate-itimer (list name value restart function is-idle - with-args function-arguments (list 0 0 0))) - (car itimer-list)) - -(defun make-itimer () - "Create an unactivated itimer. -The itimer will not begin running until activated with `activate-itimer'. -Set the itimer's expire interval with `set-itimer-value'. -Set the itimer's function interval with `set-itimer-function'. -Once this is done, the timer can be activated." - (list nil 0 nil 'ignore nil nil nil (list 0 0 0))) - -(defun activate-itimer (itimer) - "Activate ITIMER, which was previously created with `make-itimer'. -ITIMER will be added to the global list of running itimers, -its FUNCTION will be called when it expires, and so on." - (check-itimer itimer) - (if (memq itimer itimer-list) - (error "itimer already activated")) - (if (not (numberp (itimer-value itimer))) - (error "itimer timeout value not a number: %s" (itimer-value itimer))) - (if (<= (itimer-value itimer) 0) - (error "itimer timeout value not positive: %s" (itimer-value itimer))) - ;; If there's no itimer driver/process, start one now. - ;; Otherwise wake up the itimer driver so that seconds slept before - ;; the new itimer is created won't be counted against it. - (if (or itimer-process itimer-timer) - (itimer-driver-wakeup) - (itimer-driver-start)) - ;; Roll a unique name for the timer if it doesn't have a name - ;; already. - (if (not (stringp (car itimer))) - (let ((name "itimer-0") - (oname "itimer-") - (num 1)) - (while (get-itimer name) - (setq name (format "%s<%d>" oname num)) - (itimer-increment num)) - (setcar itimer name)) - ;; signal an error if the timer's name matches an already - ;; activated timer. - (if (get-itimer (itimer-name itimer)) - (error "itimer named \"%s\" already existing and activated" - (itimer-name itimer)))) - (let ((inhibit-quit t)) - ;; add the itimer to the global list - (setq itimer-list (cons itimer itimer-list)) - ;; If the itimer process is scheduled to wake up too late for - ;; the itimer we wake it up to calculate a correct wakeup - ;; value giving consideration to the newly added itimer. - (if (< (itimer-value itimer) itimer-next-wakeup) - (itimer-driver-wakeup)))) - -;; User level functions to list and modify existing itimers. -;; Itimer Edit major mode, and the editing commands thereof. - -(defun list-itimers () - "Pop up a buffer containing a list of all itimers. -The major mode of the buffer is Itimer Edit mode. This major mode provides -commands to manipulate itimers; see the documentation for -`itimer-edit-mode' for more information." - (interactive) - (let* ((buf (get-buffer-create "*Itimer List*")) - (opoint (point)) - (standard-output buf) - (itimers (reverse itimer-list))) - (set-buffer buf) - (itimer-edit-mode) - (setq buffer-read-only nil) - (erase-buffer) - (insert -"Name Value Restart Function Idle Arguments" -"\n" -"---- ----- ------- -------- ---- --------") - (if (null itimer-edit-start-marker) - (setq itimer-edit-start-marker (point))) - (while itimers - (newline 1) - (prin1 (itimer-name (car itimers))) - (tab-to-tab-stop) - (insert (itimer-truncate-string - (format "%5.5s" (itimer-value (car itimers))) 5)) - (tab-to-tab-stop) - (insert (itimer-truncate-string - (format "%5.5s" (itimer-restart (car itimers))) 5)) - (tab-to-tab-stop) - (insert (itimer-truncate-string - (format "%.19s" (itimer-function (car itimers))) 19)) - (tab-to-tab-stop) - (if (itimer-is-idle (car itimers)) - (insert "yes") - (insert "no")) - (tab-to-tab-stop) - (if (itimer-uses-arguments (car itimers)) - (prin1 (itimer-function-arguments (car itimers))) - (prin1 'NONE)) - (setq itimers (cdr itimers))) - ;; restore point - (goto-char opoint) - (if (< (point) itimer-edit-start-marker) - (goto-char itimer-edit-start-marker)) - (setq buffer-read-only t) - (display-buffer buf))) - -(defun edit-itimers () - "Display a list of all itimers and select it for editing. -The major mode of the buffer containing the listing is Itimer Edit mode. -This major mode provides commands to manipulate itimers; see the documentation -for `itimer-edit-mode' for more information." - (interactive) - ;; since user is editing, make sure displayed data is reasonably up-to-date - (if (or itimer-process itimer-timer) - (itimer-driver-wakeup)) - (list-itimers) - (select-window (get-buffer-window "*Itimer List*")) - (goto-char itimer-edit-start-marker) - (if itimer-list - (progn - (forward-sexp 2) - (backward-sexp))) - (message "type q to quit, ? for help")) - -;; no point in making this interactive. -(defun itimer-edit-mode () - "Major mode for manipulating itimers. -Attributes of running itimers are changed by moving the cursor to the -desired field and typing `s' to set that field. The field will then be -set to the value read from the minibuffer. - -Commands: -TAB move forward a field -DEL move backward a field -s set a field -d delete the selected itimer -x start a new itimer -? help" - (kill-all-local-variables) - (make-local-variable 'tab-stop-list) - (setq major-mode 'itimer-edit-mode - mode-name "Itimer Edit" - truncate-lines t - tab-stop-list '(22 32 40 60 67)) - (abbrev-mode 0) - (auto-fill-mode 0) - (buffer-flush-undo (current-buffer)) - (use-local-map itimer-edit-map) - (set-syntax-table emacs-lisp-mode-syntax-table)) - -(put 'itimer-edit-mode 'mode-class 'special) - -(defun itimer-edit-help () - "Help function for Itimer Edit." - (interactive) - (if (eq last-command 'itimer-edit-help) - (describe-mode) - (message "TAB, DEL select fields, (s)et field, (d)elete itimer (type ? for more help)"))) - -(defun itimer-edit-quit () - "End Itimer Edit." - (interactive) - (bury-buffer (current-buffer)) - (if (one-window-p t) - (switch-to-buffer (other-buffer (current-buffer))) - (delete-window))) - -(defun itimer-edit-set-field () - (interactive) - ;; First two lines in list buffer are headers. - ;; Cry out against the luser who attempts to change a field there. - (if (<= (point) itimer-edit-start-marker) - (error "")) - ;; field-value must be initialized to be something other than a - ;; number, symbol, or list. - (let (itimer field (field-value "")) - (setq itimer (save-excursion - ;; read the name of the itimer from the beginning of - ;; the current line. - (beginning-of-line) - (get-itimer (read (current-buffer)))) - field (save-excursion - (itimer-edit-beginning-of-field) - (let ((opoint (point)) - (n 0)) - ;; count the number of sexprs until we reach the cursor - ;; and use this info to determine which field the user - ;; wants to modify. - (beginning-of-line) - (while (and (>= opoint (point)) (< n 6)) - (forward-sexp 2) - (backward-sexp) - (itimer-increment n)) - (cond ((eq n 1) (error "Cannot change itimer name.")) - ((eq n 2) 'value) - ((eq n 3) 'restart) - ((eq n 4) 'function) - ((eq n 5) 'is-idle) - (t 'function-argument))))) - (cond ((eq field 'value) - (let ((prompt "Set itimer value: ")) - (while (not (natnump field-value)) - (setq field-value (read-from-minibuffer prompt nil nil t))))) - ((eq field 'restart) - (let ((prompt "Set itimer restart: ")) - (while (and field-value (not (natnump field-value))) - (setq field-value (read-from-minibuffer prompt nil nil t))))) - ((eq field 'function) - (let ((prompt "Set itimer function: ")) - (while (not (or (and (symbolp field-value) (fboundp field-value)) - (and (consp field-value) - (memq (car field-value) '(lambda macro))))) - (setq field-value - (read (completing-read prompt obarray 'fboundp nil)))))) - ((eq field 'is-idle) - (setq field-value (not (itimer-is-idle itimer)))) - ((eq field 'function-argument) - (let ((prompt "Set itimer function argument: ")) - (setq field-value (read-expression prompt)) - (cond ((not (listp field-value)) - (setq field-value (list field-value)))) - (if (null field-value) - (set-itimer-uses-arguments itimer nil) - (set-itimer-uses-arguments itimer t))))) - ;; set the itimer field - (funcall (intern (concat "set-itimer-" (symbol-name field))) - itimer field-value) - ;; move to beginning of field to be changed - (itimer-edit-beginning-of-field) - ;; modify the list buffer to reflect the change. - (let (buffer-read-only kill-ring) - (kill-sexp 1) - (kill-region (point) (progn (skip-chars-forward " \t") (point))) - (prin1 field-value (current-buffer)) - (if (not (eolp)) - (tab-to-tab-stop)) - (backward-sexp)))) - -(defun itimer-edit-delete-itimer () - (interactive) - ;; First two lines in list buffer are headers. - ;; Cry out against the luser who attempts to change a field there. - (if (<= (point) itimer-edit-start-marker) - (error "")) - (delete-itimer - (read-itimer "Delete itimer: " - (save-excursion (beginning-of-line) (read (current-buffer))))) - ;; update list information - (list-itimers)) - -(defun itimer-edit-next-field (count) - (interactive "p") - (itimer-edit-beginning-of-field) - (cond ((> (itimer-signum count) 0) - (while (not (zerop count)) - (forward-sexp) - ;; wrap from eob to itimer-edit-start-marker - (if (eobp) - (progn - (goto-char itimer-edit-start-marker) - (forward-sexp))) - (forward-sexp) - (backward-sexp) - ;; treat fields at beginning of line as if they weren't there. - (if (bolp) - (progn - (forward-sexp 2) - (backward-sexp))) - (itimer-decrement count))) - ((< (itimer-signum count) 0) - (while (not (zerop count)) - (backward-sexp) - ;; treat fields at beginning of line as if they weren't there. - (if (bolp) - (backward-sexp)) - ;; wrap from itimer-edit-start-marker to field at eob. - (if (<= (point) itimer-edit-start-marker) - (progn - (goto-char (point-max)) - (backward-sexp))) - (itimer-increment count))))) - -(defun itimer-edit-previous-field (count) - (interactive "p") - (itimer-edit-next-field (- count))) - -(defun itimer-edit-beginning-of-field () - (let ((forw-back (save-excursion (forward-sexp) (backward-sexp) (point))) - (back (save-excursion (backward-sexp) (point)))) - (cond ((eq forw-back back) (backward-sexp)) - ((eq forw-back (point)) t) - (t (backward-sexp))))) - -(defun itimer-truncate-string (str len) - (if (<= (length str) len) - str - (substring str 0 len))) - -;; internals of the itimer implementation. - -(defun itimer-run-expired-timers (time-elapsed) - (let ((itimers (copy-sequence itimer-list)) - (itimer) - (next-wakeup 600) - (idle-time) - (last-event-time) - (recorded-run-time) - ;; process filters can be hit by stray C-g's from the user, - ;; so we must protect this stuff appropriately. - ;; Quit's are allowed from within itimer functions, but we - ;; catch them and print a message. - (inhibit-quit t)) - (setq next-wakeup 600) - (cond ((and (boundp 'last-command-event-time) - (consp 'last-command-event-time)) - (setq last-event-time last-command-event-time - idle-time (itimer-time-difference (current-time) - last-event-time))) - ((and (boundp 'last-input-time) (consp last-input-time)) - (setq last-event-time (list (car last-input-time) - (cdr last-input-time) - 0) - idle-time (itimer-time-difference (current-time) - last-event-time))) - ;; no way to do this under FSF Emacs yet. - (t (setq last-event-time '(0 0 0) - idle-time 0))) - (while itimers - (setq itimer (car itimers)) - (if (itimer-is-idle itimer) - (setq recorded-run-time (itimer-recorded-run-time itimer)) - (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer) - time-elapsed)))) - (if (if (itimer-is-idle itimer) - (or (> (itimer-time-difference recorded-run-time - last-event-time) - 0) - (< idle-time (itimer-value itimer))) - (> (itimer-value itimer) 0)) - (setq next-wakeup - (if (itimer-is-idle itimer) - (if (< idle-time (itimer-value itimer)) - (min next-wakeup (- (itimer-value itimer) idle-time)) - (min next-wakeup (itimer-value itimer))) - (min next-wakeup (itimer-value itimer)))) - (and (itimer-is-idle itimer) - (set-itimer-recorded-run-time itimer (current-time))) - ;; itimer has expired, we must call its function. - ;; protect our local vars from the itimer function. - ;; allow keyboard quit to occur, but catch and report it. - ;; provide the variable `current-itimer' in case the function - ;; is interested. - (unwind-protect - (condition-case condition-data - (save-match-data - (let* ((current-itimer itimer) - (quit-flag nil) - (inhibit-quit nil) - ;; for FSF Emacs timer.el emulation under XEmacs. - ;; eldoc expect this to be done, apparently. - (this-command nil)) - (if (itimer-uses-arguments current-itimer) - (apply (itimer-function current-itimer) - (itimer-function-arguments current-itimer)) - (funcall (itimer-function current-itimer))))) - (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) - (prin1-to-string condition-data))) - (quit (message "itimer \"%s\" quit" (itimer-name itimer)))) - ;; restart the itimer if we should, otherwise delete it. - (if (null (itimer-restart itimer)) - (delete-itimer itimer) - (set-itimer-value-internal itimer (itimer-restart itimer)) - (setq next-wakeup (min next-wakeup (itimer-value itimer)))))) - (setq itimers (cdr itimers))) - ;; make another sweep through the list to catch any timers - ;; that might have been added by timer functions above. - (setq itimers itimer-list) - (while itimers - (setq next-wakeup (min next-wakeup (itimer-value (car itimers))) - itimers (cdr itimers))) - ;; if user is viewing the timer list, update displayed info. - (let ((b (get-buffer "*Itimer List*"))) - (if (and b (get-buffer-window b)) - (save-excursion - (list-itimers)))) - next-wakeup )) - -(defun itimer-process-filter (process string) - ;; If the itimer process dies and generates output while doing - ;; so, we may be called before the process-sentinel. Sanity - ;; check the output just in case... - (if (not (string-match "^[0-9]" string)) - (progn (message "itimer process gave odd output: %s" string) - ;; it may be still alive and waiting for input - (process-send-string itimer-process "3\n")) - ;; if there are no active itimers, return quickly. - (if itimer-list - (let ((wakeup nil)) - (unwind-protect - (setq wakeup (itimer-run-expired-timers (string-to-int string))) - (and (null wakeup) (process-send-string process "1\n"))) - (setq itimer-next-wakeup wakeup)) - (setq itimer-next-wakeup 600)) - ;; tell itimer-process when to wakeup again - (process-send-string itimer-process - (concat (int-to-string itimer-next-wakeup) - "\n")))) - -(defun itimer-process-sentinel (process message) - (let ((inhibit-quit t)) - (if (eq (process-status process) 'stop) - (continue-process process) - ;; not stopped, so it must have died. - ;; cleanup first... - (delete-process process) - (setq itimer-process nil) - ;; now, if there are any active itimers then we need to immediately - ;; start another itimer process, otherwise we can wait until the next - ;; start-itimer call, which will start one automatically. - (if (null itimer-list) - () - ;; there may have been an error message in the echo area; - ;; give the user at least a little time to read it. - (sit-for 2) - (message "itimer process %s... respawning." (substring message 0 -1)) - (itimer-process-start))))) - -(defun itimer-process-start () - (let ((inhibit-quit t) - (process-connection-type nil)) - (setq itimer-process (start-process "itimer" nil "itimer")) - (process-kill-without-query itimer-process) - (set-process-filter itimer-process 'itimer-process-filter) - (set-process-sentinel itimer-process 'itimer-process-sentinel) - ;; Tell itimer process to wake up quickly, so that a correct - ;; wakeup time can be computed. Zero loses because of - ;; underlying itimer implementations that use 0 to mean - ;; `disable the itimer'. - (setq itimer-next-wakeup itimer-short-interval) - (process-send-string itimer-process - (format "%s\n" itimer-next-wakeup)))) - -(defun itimer-process-wakeup () - (interrupt-process itimer-process) - (accept-process-output)) - -(defun itimer-timer-start () - (let ((inhibit-quit t)) - (setq itimer-next-wakeup itimer-short-interval - itimer-timer-last-wakeup (current-time) - itimer-timer (add-timeout itimer-short-interval - 'itimer-timer-driver nil nil)))) - -(defun itimer-disable-timeout (timeout) - ;; Disgusting hack, but necessary because there is no other way - ;; to remove a timer that has a restart value from while that - ;; timer's function is being run. (FSF Emacs only.) - (if (vectorp timeout) - (aset timeout 4 nil)) - (disable-timeout timeout)) - -(defun itimer-timer-wakeup () - (let ((inhibit-quit t)) - (itimer-disable-timeout itimer-timer) - (setq itimer-timer (add-timeout itimer-short-interval - 'itimer-timer-driver nil 5)))) - -(defun itimer-time-difference (t1 t2) - (let (usecs secs 65536-secs carry) - (setq usecs (- (nth 2 t1) (nth 2 t2))) - (if (< usecs 0) - (setq carry 1 - usecs (+ usecs 1000000)) - (setq carry 0)) - (setq secs (- (nth 1 t1) (nth 1 t2) carry)) - (if (< secs 0) - (setq carry 1 - secs (+ secs 65536)) - (setq carry 0)) - (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) - ;; loses for interval larger than the maximum signed Lisp integer. - ;; can't really be helped. - (+ (* 65536-secs 65536) - secs - (/ usecs (if (featurep 'lisp-float-type) 1e6 1000000))))) - -(defun itimer-timer-driver (&rest ignored) - ;; inhibit quit because if the user quits at an inopportune - ;; time, the timer process won't be launched again and the - ;; system stops working. itimer-run-expired-timers allows - ;; individual timer function to be aborted, so the user can - ;; escape a feral timer function. - (if (not itimer-inside-driver) - (let* ((inhibit-quit t) - (itimer-inside-driver t) - (now (current-time)) - (elapsed (itimer-time-difference now itimer-timer-last-wakeup)) - (sleep nil)) - (setq itimer-timer-last-wakeup now - sleep (itimer-run-expired-timers elapsed)) - (itimer-disable-timeout itimer-timer) - (setq itimer-next-wakeup sleep - itimer-timer (add-timeout sleep 'itimer-timer-driver nil 5))))) - -(defun itimer-driver-start () - (if (fboundp 'add-timeout) - (itimer-timer-start) - (itimer-process-start))) - -(defun itimer-driver-wakeup () - (if (fboundp 'add-timeout) - (itimer-timer-wakeup) - (itimer-process-wakeup))) diff --git a/lisp/keydefs.el b/lisp/keydefs.el deleted file mode 100644 index 947ce34..0000000 --- a/lisp/keydefs.el +++ /dev/null @@ -1,637 +0,0 @@ -;;; keydefs.el --- Define standard keybindings. - -;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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. - -;; All the global bindings should be here so that one can reload things -;; like files.el without trashing one's personal bindings. - -;;; Synched up with: Not synched with FSF. - -;;; Commentary: - -;; This file is dumped with XEmacs - -;;; Code: - -(defgroup keyboard nil - "Input from the keyboard." - :group 'environment) - - -;; created by C code -(defvar global-map (current-global-map) "\ -Default global keymap mapping XEmacs keyboard input into commands. -The value is a keymap which is usually (but not necessarily) XEmacs's -global map.") - -;; created by C code -(defvar esc-map (symbol-function 'ESC-prefix) "\ -Default keymap for ESC (meta) commands. -The normal global definition of the character ESC indirects to this keymap.") - -(set-keymap-name global-map 'global-map) -(set-keymap-name esc-map 'ESC-prefix) - -(define-prefix-command 'Control-X-prefix t) -(defvar ctl-x-map (symbol-function 'Control-X-prefix) "\ -Default keymap for C-x commands. -The normal global definition of the character C-x indirects to this keymap.") -(define-key global-map "\C-x" 'Control-X-prefix) - -(define-prefix-command 'ctl-x-4-prefix t) -(defvar ctl-x-4-map (symbol-function 'ctl-x-4-prefix) "\ -Keymap for subcommands of C-x 4") -(define-key global-map "\C-x4" 'ctl-x-4-prefix) - -(define-prefix-command 'ctl-x-5-prefix t) -(defvar ctl-x-5-map (symbol-function 'ctl-x-5-prefix) "\ -Keymap for subcommands of C-x 5") -(define-key global-map "\C-x5" 'ctl-x-5-prefix) - -(define-prefix-command 'mode-specific-command-prefix t) -(defvar mode-specific-map (symbol-function 'mode-specific-command-prefix) "\ -Keymap for characters following C-c.") -(define-key global-map "\C-c" 'mode-specific-command-prefix) - -;; FSFmacs buffer.c - -(define-key global-map "\C-xb" 'switch-to-buffer) -(define-key global-map "\C-xk" 'kill-buffer) -(define-key global-map "\C-x\C-b" 'list-buffers) -(put 'erase-buffer 'disabled t) ;from buffer.c - -;; FSFmacs casefiddle.c - -(define-key global-map "\C-x\C-u" 'upcase-region) -;; This is silly with zmacs regions -;(put 'upcase-region 'disabled t) -(define-key global-map "\C-x\C-l" 'downcase-region) -;; This is silly with zmacs regions -;(put 'downcase-region 'disabled t) -(define-key global-map "\M-u" 'upcase-region-or-word) -(define-key global-map "\M-l" 'downcase-region-or-word) -(define-key global-map "\M-c" 'capitalize-region-or-word) - -;; FSFmacs cmds.c - -(let ((n 33)) - (while (<= n 255) - (if (not (= n 127)) - (define-key global-map n 'self-insert-command)) - (setq n (1+ n)))) -(define-key global-map " " 'self-insert-command) - -(define-key global-map "\C-a" 'beginning-of-line) -(define-key global-map "\C-b" 'backward-char-command) -(define-key global-map "\C-e" 'end-of-line) -(define-key global-map "\C-f" 'forward-char-command) -(define-key global-map "\C-d" 'delete-char) -(define-key global-map 'delete 'backward-or-forward-delete-char) -(define-key global-map '(meta delete) 'backward-or-forward-kill-word) -(define-key global-map [(control x) (delete)] 'backward-or-forward-kill-sentence) - -;; FSFmacs files.el - -(define-key global-map "\C-x\C-f" 'find-file) -(define-key global-map "\C-x\C-q" 'toggle-read-only) -(define-key global-map "\C-x\C-r" 'find-file-read-only) -(define-key global-map "\C-x\C-v" 'find-alternate-file) -(define-key global-map "\C-x\C-s" 'save-buffer) -(define-key global-map "\C-xs" 'save-some-buffers) -(define-key global-map "\C-x\C-w" 'write-file) -(define-key global-map "\C-xi" 'insert-file) -(define-key global-map "\M-~" 'not-modified) -(define-key global-map "\C-x\C-d" 'list-directory) -(define-key global-map "\C-x\C-c" 'save-buffers-kill-emacs) - -(define-key global-map "\C-x4f" 'find-file-other-window) -(define-key global-map "\C-x4r" 'find-file-read-only-other-window) -(define-key global-map "\C-x4\C-f" 'find-file-other-window) -(define-key global-map "\C-x4b" 'switch-to-buffer-other-window) -(define-key global-map "\C-x4\C-o" 'display-buffer) - -(define-key global-map "\C-x5b" 'switch-to-buffer-other-frame) -(define-key global-map "\C-x5f" 'find-file-other-frame) -(define-key global-map "\C-x5\C-f" 'find-file-other-frame) -(define-key global-map "\C-x5r" 'find-file-read-only-other-frame) - -;; FSFmacs frame.c -;FSFmacs has these. It's probably a good idea to provide ways of hooking -;these events, but it's unlikely that it's a good idea to do it this way. -;Just provide a hook, like the existing `select-frame-hook', -;`deselect-frame-hook', `map-frame-hook', and `unmap-frame-hook'. -;#### ergo need hooks for delete-frame and iconify-frame -;(define-key global-map 'switch-frame 'handle-switch-frame) -;(define-key global-map 'delete-frame 'handle-delete-frame) -;(define-key global-map 'iconify-frame 'ignore-event) -;(define-key global-map 'make-frame-visible 'ignore-event) - -;; FSFmacs frame.el - -;; New FSF19 bindings: C-x 5 as prefix for window commands -(define-key global-map "\C-x52" 'make-frame) -(define-key global-map "\C-x50" 'delete-frame) -(define-key global-map "\C-x5o" 'other-frame) - -;; FSFmacs help.el - -(define-key global-map (vector help-char) 'help-command) -(define-key global-map 'help 'help-command) -(define-key global-map 'f1 'help-command) - -;; FSFmacs indent.el - -;;(define-key global-map "\t" 'self-insert-command) -(define-key global-map "\t" 'indent-for-tab-command) -(define-key global-map "\M-\C-\\" 'indent-region) -(define-key global-map "\C-x\t" 'indent-rigidly) -(define-key global-map "\M-i" 'tab-to-tab-stop) -;; XEmacs addition: -(define-key global-map [(shift tab)] 'tab-to-tab-stop) - -;; FSFmacs isearch.el - -(define-key global-map "\C-s" 'isearch-forward) -(define-key global-map "\C-r" 'isearch-backward) -(define-key global-map "\M-\C-s" 'isearch-forward-regexp) -(define-key global-map "\M-\C-r" 'isearch-backward-regexp) - -;; FSFmacs keyboard.c - -(define-key global-map "\C-z" 'suspend-emacs-or-iconify-frame) -(define-key global-map "\C-x\C-z" 'suspend-or-iconify-emacs) - -;; FSFmacs loaddefs.el - -;; New FSF19 bindings: C-x n as a prefix for narrowing commands. -(define-key global-map "\C-xn" (let ((map (make-sparse-keymap))) - (set-keymap-name map 'narrowing-prefix) - map)) -(put 'narrow-to-region 'disabled t) -(define-key global-map "\C-xnn" 'narrow-to-region) -(define-key global-map "\C-xnw" 'widen) -(define-key global-map "\C-xnd" 'narrow-to-defun) -;; Old v18 bindings -;(define-key global-map "\C-xn" 'narrow-to-region) -;(define-key global-map "\C-xw" 'widen) - -(define-key global-map "\C-j" 'newline-and-indent) -(define-key global-map "\C-m" 'newline) -(define-key global-map "\C-o" 'open-line) -(define-key global-map "\M-\C-o" 'split-line) -(define-key global-map "\C-q" 'quoted-insert) -(define-key global-map "\M-^" 'delete-indentation) -(define-key global-map "\M-\\" 'delete-horizontal-space) -(define-key global-map "\M-m" 'back-to-indentation) -(define-key global-map "\C-x\C-o" 'delete-blank-lines) -(define-key global-map "\M- " 'just-one-space) -(define-key global-map "\M-z" 'zap-to-char) -(define-key global-map "\M-=" 'count-lines-region) -(define-key global-map "\C-x=" 'what-cursor-position) -(define-key global-map "\M-:" 'eval-expression) -;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit. -(define-key global-map "\M-\e:" 'eval-expression) -;(define-key global-map "\M-\e" 'eval-expression) -;; Do we really need to disable this now that it is harder to type -;; by accident? -;; (put 'eval-expression 'disabled t) -;; Changed from C-x ESC so that function keys work following C-x. -(define-key global-map "\C-x\e\e" 'repeat-complex-command) -;(define-key global-map "\C-x\e" 'repeat-complex-command) -;; From Emacs 20. -(define-key global-map "\C-x\M-:" 'repeat-complex-command) -(define-key global-map "\C-xu" 'advertised-undo) -;; Many people are used to typing C-/ on X terminals and getting C-_. -(define-key global-map '(control /) 'undo) -(define-key global-map "\C-_" 'undo) -(define-key global-map "\M-!" 'shell-command) -(define-key global-map "\M-|" 'shell-command-on-region) - -(define-key global-map "\C-u" 'universal-argument) -;; Make Control-0 - Control-9 set the prefix argument, like Meta-0. -(let ((i ?0)) - (while (<= i ?9) - (define-key global-map (list 'meta i) 'digit-argument) - (define-key global-map (list 'control i) 'digit-argument) - (define-key global-map (list 'control 'meta i) 'digit-argument) - (setq i (1+ i)))) -(define-key global-map '(meta -) 'negative-argument) -(define-key global-map '(control -) 'negative-argument) -(define-key global-map '(control meta -) 'negative-argument) - -(define-key global-map "\C-k" 'kill-line) -(define-key global-map "\C-w" 'kill-region) -(define-key global-map "\M-w" 'kill-ring-save) -(define-key global-map "\M-\C-w" 'append-next-kill) -(define-key global-map "\C-y" 'yank) -(define-key global-map "\M-y" 'yank-pop) - -;; Old v18 binding -;(define-key global-map "\C-xa" 'append-to-buffer) - -(define-key global-map "\C-@" 'set-mark-command) -;; Many people are used to typing C-SPC and getting C-@. -(define-key global-map '(control ? ) 'set-mark-command) -(define-key global-map "\C-x\C-x" 'exchange-point-and-mark) -(define-key global-map "\C-x\C-@" 'pop-global-mark) -(define-key global-map [(control x) (control ? )] 'pop-global-mark) - -(define-key global-map "\C-n" 'next-line) -(define-key global-map "\C-p" 'previous-line) -;(define-key global-map "\C-x\C-n" 'set-goal-column) -;; XEmacs: -;;; Many people have said they rarely use this feature, and often type -;;; it by accident. Maybe it shouldn't even be on a key. -;;; Done. -hniksic -;(put 'set-goal-column 'disabled t) - -(define-key global-map [menu] 'execute-extended-command) -(define-key global-map [find] 'search-forward) - -(define-key global-map "\C-t" 'transpose-chars) -(define-key global-map "\M-t" 'transpose-words) -(define-key global-map "\M-\C-t" 'transpose-sexps) -(define-key global-map "\C-x\C-t" 'transpose-lines) - -(define-key global-map "\M-;" 'indent-for-comment) -(define-key global-map "\M-j" 'indent-new-comment-line) -(define-key global-map "\M-\C-j" 'indent-new-comment-line) -(define-key global-map "\C-x;" 'set-comment-column) -(define-key global-map "\C-xf" 'set-fill-column) -(define-key global-map "\C-x$" 'set-selective-display) - -(define-key global-map "\M-@" 'mark-word) -(define-key global-map "\M-f" 'forward-word) -(define-key global-map "\M-b" 'backward-word) -(define-key global-map "\M-d" 'kill-word) - -(define-key global-map "\M-<" 'beginning-of-buffer) -(define-key global-map "\M->" 'end-of-buffer) -(define-key global-map "\C-xh" 'mark-whole-buffer) -(define-key global-map "\M-\\" 'delete-horizontal-space) - -(define-key global-map "\M-\C-f" 'forward-sexp) -(define-key global-map "\M-\C-b" 'backward-sexp) -(define-key global-map "\M-\C-u" 'backward-up-list) -(define-key global-map "\M-\C-@" 'mark-sexp) -(define-key global-map "\M-\C-d" 'down-list) -(define-key global-map "\M-\C-k" 'kill-sexp) -(define-key global-map "\M-\C-n" 'forward-list) -(define-key global-map "\M-\C-p" 'backward-list) -(define-key global-map "\M-\C-a" 'beginning-of-defun) -(define-key global-map "\M-\C-e" 'end-of-defun) -(define-key global-map "\M-\C-h" 'mark-defun) -(define-key global-map "\M-\(" 'insert-parentheses) -(define-key global-map "\M-\)" 'move-past-close-and-reindent) -(define-key global-map "\M-\t" 'lisp-complete-symbol) - -(define-key global-map '(control meta backspace) 'backward-kill-sexp) -(define-key global-map '(control meta delete) 'backward-or-forward-kill-sexp) - - -(define-key global-map "\C-x/" 'point-to-register) -(define-key global-map "\C-xj" 'jump-to-register) -(define-key global-map "\C-xx" 'copy-to-register) -(define-key global-map "\C-xg" 'insert-register) -;; Old v18 binding -;(define-key global-map "\C-xr" 'copy-rectangle-to-register) - -;; New FSF19 bindings: C-x r as a prefix for register commands -(define-key global-map "\C-xr" (let ((map (make-sparse-keymap))) - (set-keymap-name map 'rectangle-prefix) - map)) -(define-key global-map "\C-xr\C-@" 'point-to-register) -(define-key global-map "\C-xr " 'point-to-register) -(define-key global-map "\C-xrj" 'jump-to-register) -(define-key global-map "\C-xrs" 'copy-to-register) -(define-key global-map "\C-xrx" 'copy-to-register) -(define-key global-map "\C-xri" 'insert-register) -(define-key global-map "\C-xrg" 'insert-register) -(define-key global-map "\C-xrr" 'copy-rectangle-to-register) -(define-key global-map "\C-xrn" 'number-to-register) -(define-key global-map "\C-xr+" 'increment-register) -(define-key global-map "\C-xrc" 'clear-rectangle) -(define-key global-map "\C-xrk" 'kill-rectangle) -(define-key global-map "\C-xry" 'yank-rectangle) -(define-key global-map "\C-xro" 'open-rectangle) -(define-key global-map "\C-xrt" 'string-rectangle) -(define-key global-map "\C-xrw" 'window-configuration-to-register) -;(define-key global-map "\C-xrf" 'frame-configuration-to-register) - -(define-key global-map "\M-q" 'fill-paragraph-or-region) -;(define-key global-map "\M-q" 'fill-paragraph) -;(define-key global-map "\M-g" 'fill-region) ;now bound to goto-line -(define-key global-map "\C-x." 'set-fill-prefix) - -; Using {} instead of [] is 1) FSF compatible and 2) allows function -; keys to work on ttys. M-[ is the beginning of most the function key -; sequences. -(define-key global-map "\M-{" 'backward-paragraph) -(define-key global-map "\M-}" 'forward-paragraph) -(define-key global-map "\M-h" 'mark-paragraph) -(define-key global-map "\M-a" 'backward-sentence) -(define-key global-map "\M-e" 'forward-sentence) -(define-key global-map "\M-k" 'kill-sentence) -;;(define-key global-map "\C-x\177" 'backward-kill-sentence) - -(define-key global-map "\C-x[" 'backward-page) -(define-key global-map "\C-x]" 'forward-page) -(define-key global-map "\C-x\C-p" 'mark-page) -(define-key global-map "\C-xl" 'count-lines-page) -(define-key global-map "\C-xnp" 'narrow-to-page) -;; Old v18 bindings -;(define-key global-map "\C-xp" 'narrow-to-page) -(put 'narrow-to-page 'disabled t) - -;; Old v18 bindings -;(define-key global-map "\C-x\C-a" 'add-mode-abbrev) -;(define-key global-map "\C-x+" 'add-global-abbrev) -;(define-key global-map "\C-x\C-h" 'inverse-add-mode-abbrev) -;(define-key global-map "\C-x-" 'inverse-add-global-abbrev) - -(define-key global-map "\M-'" 'abbrev-prefix-mark) -(define-key global-map "\C-x'" 'expand-abbrev) - -;; New FSF19 bindings: C-x a as a prefix for abbrev commands -(define-key global-map "\C-xal" 'add-mode-abbrev) -(define-key global-map "\C-xa\C-a" 'add-mode-abbrev) -(define-key global-map "\C-xag" 'add-global-abbrev) -(define-key global-map "\C-xa+" 'add-mode-abbrev) -(define-key global-map "\C-xaig" 'inverse-add-global-abbrev) -(define-key global-map "\C-xail" 'inverse-add-mode-abbrev) -(define-key global-map "\C-xa-" 'inverse-add-global-abbrev) -(define-key global-map "\C-xae" 'expand-abbrev) -(define-key global-map "\C-xa'" 'expand-abbrev) - -(define-key global-map "\M-\C-l" 'switch-to-other-buffer) - -;; Default binding of "Backspace" is no longer the same as delete. -;; Default binding of "Control-h" is help. -(define-key global-map 'backspace 'delete-backward-char) -(define-key global-map '(meta backspace) 'backward-kill-word) - -(define-key global-map "\M-\C-z" 'activate-region) - -;; FSFmacs macros.c - -(define-key global-map "\C-xe" 'call-last-kbd-macro) -(define-key global-map "\C-x\(" 'start-kbd-macro) -(define-key global-map "\C-x\)" 'end-kbd-macro) - -;; FSFmacs macros.el - -(define-key global-map "\C-xq" 'kbd-macro-query) - - -;; FSFmacs minibuffer.c -; see also minibuf.el - -(define-key global-map "\M-\C-c" 'exit-recursive-edit) -(define-key global-map "\C-]" 'abort-recursive-edit) -(define-key global-map "\M-x" 'execute-extended-command) - -;; FSFmacs window.c - -(define-key global-map "\C-x0" 'delete-window) -(define-key global-map "\C-x1" 'delete-other-windows) -(define-key global-map "\C-x2" 'split-window-vertically) -(define-key global-map "\C-x3" 'split-window-horizontally) -;; Old XEmacs binding -;;(define-key global-map "\C-x5" 'split-window-horizontally) -(define-key global-map "\C-xo" 'other-window) -(define-key global-map "\C-x^" 'enlarge-window) -(define-key global-map "\C-x<" 'scroll-left) -(define-key global-map "\C-x>" 'scroll-right) - -(define-key global-map "\C-v" 'scroll-up-command) -(define-key global-map "\M-v" 'scroll-down-command) -(define-key global-map "\M-\C-v" 'scroll-other-window) -; meta-shift-V, that is. -(define-key global-map '(meta V) 'scroll-other-window-down) - -(define-key global-map "\C-l" 'recenter) -(define-key global-map "\M-r" 'move-to-window-line) - -;; FSFmacs window.el - -(define-key global-map "\C-x6" 'window-configuration-to-register) -;(define-key global-map "\C-x7" 'jump-to-register);ie register-to-window-config -(define-key global-map "\C-x}" 'enlarge-window-horizontally) -(define-key global-map "\C-x{" 'shrink-window-horizontally) -;; New FSF19 bindings -(define-key global-map "\C-x-" 'shrink-window-if-larger-than-buffer) -(define-key global-map "\C-x+" 'balance-windows) -(define-key ctl-x-4-map "0" 'kill-buffer-and-window) - -;;(define-key global-map "\C-g" 'keyboard-quit) -(let ((ch (quit-char))) - (if (or (characterp ch) (integerp ch)) - (setq ch (char-to-string ch))) - (define-key global-map ch 'keyboard-quit)) -(define-key global-map "\e\e\e" 'keyboard-escape-quit) - - - -(define-key global-map "\M-%" 'query-replace) - -;; FSF v20 binding -(define-key global-map [(control meta %)] 'query-replace-regexp) - - -; autoloaded -;(define-key global-map "\C-x4a" 'add-change-log-entry-other-window) - -; autoloaded -;(define-key global-map "\C-x`" 'next-error) - -; autoloaded -;(define-key global-map "\M-/" 'dabbrev-expand) - -; autoloaded -;(define-key global-map "\C-xd" 'dired) - -; autoloaded -;(define-key global-map "\C-x4d" 'dired-other-window) - -(define-key global-map "\M-$" 'ispell-word) - -(define-key global-map "\C-xm" 'compose-mail) -(define-key global-map "\C-x4m" 'compose-mail-other-window) -(define-key global-map "\C-x5m" 'compose-mail-other-frame) - -(define-key global-map "\M-." 'find-tag) - -(define-key global-map "\C-x4." 'find-tag-other-window) - -(define-key global-map "\M-," 'tags-loop-continue) - - -(define-key global-map '(control <) 'mark-beginning-of-buffer) -(define-key global-map '(control >) 'mark-end-of-buffer) - -(define-key global-map "\C-x\C-e" 'eval-last-sexp) ;bogus! - - -(define-key global-map "\M-g" 'goto-line) - -;; Keypad type things - -;; I removed all the fkey crap, because where-is is now smart enough -;; to show all bindings. --ben - -;;; These aren't bound to kbd macros like "\C-b" so that they have the -;; expected behavior even in, for example, vi-mode. - -;; We use here symbolic names, assuming that the corresponding keys will -;; generate these keysyms. This is not true on Suns, but x-win-sun.el -;; fixes that. If it turns out that the semantics of these keys should -;; differ from server to server, this should be moved into server-specific -;; files, but these appear to be the standard Motif and PC bindings. - -;; movement by units -(define-key global-map 'left 'backward-char-command) -(define-key global-map 'up 'previous-line) -(define-key global-map 'right 'forward-char-command) -(define-key global-map 'down 'next-line) - -;; movement by pages -(define-key global-map 'prior 'scroll-down-command) -(define-key global-map 'next 'scroll-up-command) - -;; movement to the limits -(define-key global-map 'home 'beginning-of-line) -(define-key global-map 'end 'end-of-line) - -;;; Miscellaneous key bindings -(define-key global-map 'again 'repeat-complex-command) -(define-key global-map 'insert 'overwrite-mode) - -;;; These aren't bound to kbd macros like "\C-b" so that they have the -;; expected behavior even in, for example, vi-mode. - -;; We use here symbolic names, assuming that the corresponding keys will -;; generate these keysyms. This is not true on Suns, but x-win-sun.el -;; fixes that. If it turns out that the semantics of these keys should -;; differ from server to server, this should be moved into server-specific -;; files, but these appear to be the standard Motif and PC bindings. - -;; potential R6isms -(define-key global-map 'kp-left 'backward-char-command) -(define-key global-map 'kp-up 'previous-line) -(define-key global-map 'kp-right 'forward-char-command) -(define-key global-map 'kp-down 'next-line) - - -;; movement by larger blocks -(define-key global-map '(control left) 'backward-word) -(define-key global-map '(control up) #'(lambda () - (interactive "_") - (forward-line -6))) -(define-key global-map '(control right) 'forward-word) -(define-key global-map '(control down) #'(lambda () - (interactive "_") - (forward-line 6))) - -;; context-sensitive movement -(define-key global-map '(meta left) 'backward-sexp) -(define-key global-map '(meta right) 'forward-sexp) -(define-key global-map '(meta up) 'backward-paragraph) -(define-key global-map '(meta down) 'forward-paragraph) - -;; movement by pages -(define-key global-map '(control prior) 'scroll-right) -(define-key global-map '(control next) 'scroll-left) -;; potential R6isms -(define-key global-map 'kp-prior 'scroll-down-command) -(define-key global-map 'kp-next 'scroll-up-command) -(define-key global-map '(control kp-prior) 'scroll-right) -(define-key global-map '(control kp-next) 'scroll-left) - - -;; movement to the limits -(define-key global-map '(control home) 'beginning-of-buffer) -(define-key global-map '(control end) 'end-of-buffer) -(define-key global-map 'begin 'beginning-of-line) -(define-key global-map '(control begin) 'beginning-of-buffer) -;; potential R6isms -(define-key global-map 'kp-home 'beginning-of-line) -(define-key global-map '(control kp-home) 'beginning-of-buffer) -(define-key global-map 'kp-end 'end-of-line) -(define-key global-map '(control kp-end) 'end-of-buffer) - -;; movement between windows -(define-key global-map '(control tab) 'other-window) -(define-key global-map '(control shift tab) 'backward-other-window) - -;; movement in other windows -(define-key global-map '(meta next) 'scroll-other-window) -(define-key global-map '(meta prior) 'scroll-other-window-down) -(define-key global-map '(meta home) 'beginning-of-buffer-other-window) -(define-key global-map '(meta end) 'end-of-buffer-other-window) -;; potential R6isms -(define-key global-map '(meta kp-next) 'scroll-other-window) -(define-key global-map '(meta kp-prior) 'scroll-other-window-down) -(define-key global-map '(meta kp-home) 'beginning-of-buffer-other-window) -(define-key global-map '(meta kp-end) 'end-of-buffer-other-window) - -;; potential R6isms -(define-key global-map 'redo 'repeat-complex-command) -(define-key global-map 'kp-insert 'overwrite-mode) -(define-key global-map 'kp-delete 'backward-delete-char-untabify) - -(define-key global-map 'kp-enter [return]) ; do whatever RET does now -(define-key global-map 'kp-tab [tab]) - -(define-key global-map 'undo 'undo) -(define-key global-map 'help 'help-for-help) - -(define-key global-map 'kp-space 'self-insert-command) -(define-key global-map 'kp-equal 'self-insert-command) -(define-key global-map 'kp-multiply 'self-insert-command) -(define-key global-map 'kp-add 'self-insert-command) -(define-key global-map 'kp-separator 'self-insert-command) -(define-key global-map 'kp-subtract 'self-insert-command) -(define-key global-map 'kp-decimal 'self-insert-command) -(define-key global-map 'kp-divide 'self-insert-command) - -(define-key global-map 'kp-0 'self-insert-command) -(define-key global-map 'kp-1 'self-insert-command) -(define-key global-map 'kp-2 'self-insert-command) -(define-key global-map 'kp-3 'self-insert-command) -(define-key global-map 'kp-4 'self-insert-command) -(define-key global-map 'kp-5 'self-insert-command) -(define-key global-map 'kp-6 'self-insert-command) -(define-key global-map 'kp-7 'self-insert-command) -(define-key global-map 'kp-8 'self-insert-command) -(define-key global-map 'kp-9 'self-insert-command) - -(define-key global-map 'select 'function-key-error) -(define-key global-map 'print 'function-key-error) -(define-key global-map 'execute 'execute-extended-command) -(define-key global-map 'clearline 'function-key-error) -(define-key global-map 'insertline 'open-line) -(define-key global-map 'deleteline 'kill-line) -(define-key global-map 'insertchar 'function-key-error) -(define-key global-map 'deletechar 'delete-char) - -;;; keydefs.el ends here diff --git a/lisp/keymap.el b/lisp/keymap.el deleted file mode 100644 index 9f3f69d..0000000 --- a/lisp/keymap.el +++ /dev/null @@ -1,493 +0,0 @@ -;; keymap.el --- Keymap functions for XEmacs. - -;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -;; Maintainer: XEmacs Development Team -;; Keywords: internals, dumped - -;; 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 19.28. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Note: FSF does not have a file keymap.el. This stuff is -;;; in keymap.c. - -;Prevent the \{...} documentation construct -;from mentioning keys that run this command. - -;;; Code: - -(put 'undefined 'suppress-keymap t) - -(defun undefined () - (interactive) - (ding)) - -(defmacro kbd (keys) - "Convert KEYS to the internal Emacs key representation. -KEYS should be a string in the format used for saving keyboard macros -\(see `insert-kbd-macro')." - (if (or (stringp keys) - (vectorp keys)) - (read-kbd-macro keys) - `(read-kbd-macro ,keys))) - -(defun suppress-keymap (map &optional nodigits) - "Make MAP override all normally self-inserting keys to be undefined. -Normally, as an exception, digits and minus-sign are set to make prefix args, -but optional second arg NODIGITS non-nil treats them like other chars." - (substitute-key-definition 'self-insert-command 'undefined map global-map) - (or nodigits - (let ((string (make-string 1 ?0))) - (define-key map "-" 'negative-argument) - ;; Make plain numbers do numeric args. - (while (<= (aref string 0) ?9) - (define-key map string 'digit-argument) - (incf (aref string 0)))))) - -(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) - "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. -In other words, OLDDEF is replaced with NEWDEF wherever it appears. -Prefix keymaps are checked recursively. If optional fourth argument OLDMAP -is specified, we redefine in KEYMAP as NEWDEF those chars which are defined -as OLDDEF in OLDMAP, unless that keybinding is already present in keymap. -If optional fifth argument PREFIX is defined, then only those occurrences of -OLDDEF found in keymaps accessible through the keymap bound to PREFIX in -KEYMAP are redefined. See also `accessible-keymaps'." - (let ((maps (accessible-keymaps (or oldmap keymap) prefix)) - (shadowing (not (null oldmap))) - prefix map) - (while maps - (setq prefix (car (car maps)) - map (cdr (car maps)) - maps (cdr maps)) - ;; Substitute in this keymap - (map-keymap #'(lambda (key binding) - (if (eq binding olddef) - ;; The new bindings always go in KEYMAP even if we - ;; found them in OLDMAP or one of its children. - ;; If KEYMAP will be shadowing OLDMAP, then do not - ;; redefine the key if there is another binding - ;; in KEYMAP that will shadow OLDDEF. - (or (and shadowing - (lookup-key keymap key)) - ;; define-key will give an error if a prefix - ;; of the key is already defined. Otherwise - ;; it will define the key in the map. - ;; #### - Perhaps this should be protected? - (define-key - keymap - (vconcat prefix (list key)) - newdef)))) - map) - ))) - - -;; From Bill Dubuque - -;; This used to wrap forms into an interactive lambda. It is unclear -;; to me why this is needed in this function. Anyway, -;; `key-or-menu-binding' doesn't do it, so this function no longer -;; does it, either. -(defun insert-key-binding (key) ; modeled after describe-key - "Insert the command bound to KEY." - (interactive "kInsert command bound to key: ") - (let ((defn (key-or-menu-binding key))) - (if (or (null defn) (integerp defn)) - (error "%s is undefined" (key-description key)) - (if (or (stringp defn) (vectorp defn)) - (setq defn (key-binding defn))) ;; a keyboard macro - (insert (format "%s" defn))))) - -;; From Bill Dubuque -(defun read-command-or-command-sexp (prompt) - "Read a command symbol or command sexp. -A command sexp is wrapped in an interactive lambda if needed. -Prompts with PROMPT." - ;; Todo: it would be better if we could reject symbols that are not - ;; commandp (as does 'read-command') but that is not easy to do - ;; because we must supply arg4 = require-match = nil for sexp case. - (let ((result (car (read-from-string - (completing-read prompt obarray 'commandp))))) - (if (and (consp result) - (not (eq (car result) 'lambda))) - `(lambda () - (interactive) - ,result) - result))) - -(defun local-key-binding (keys) - "Return the binding for command KEYS in current local keymap only. -KEYS is a string, a vector of events, or a vector of key-description lists -as described in the documentation for the `define-key' function. -The binding is probably a symbol with a function definition; see -the documentation for `lookup-key' for more information." - (let ((map (current-local-map))) - (if map - (lookup-key map keys) - nil))) - -(defun global-key-binding (keys) - "Return the binding for command KEYS in current global keymap only. -KEYS is a string or vector of events, a sequence of keystrokes. -The binding is probably a symbol with a function definition; see -the documentation for `lookup-key' for more information." - (lookup-key (current-global-map) keys)) - -;; from Bill Dubuque -(defun global-set-key (key command) - "Give KEY a global binding as COMMAND. -COMMAND is a symbol naming an interactively-callable function. -KEY is a string, a vector of events, or a vector of key-description lists -as described in the documentation for the `define-key' function. -Note that if KEY has a local binding in the current buffer -that local binding will continue to shadow any global binding." - ;;(interactive "KSet key globally: \nCSet key %s to command: ") - (interactive (list (setq key (read-key-sequence "Set key globally: ")) - ;; Command sexps are allowed here so that this arg - ;; may be supplied interactively via insert-key-binding. - (read-command-or-command-sexp - (format "Set key %s to command: " - (key-description key))))) - (define-key (current-global-map) key command) - nil) - -;; from Bill Dubuque -(defun local-set-key (key command) - "Give KEY a local binding as COMMAND. -COMMAND is a symbol naming an interactively-callable function. -KEY is a string, a vector of events, or a vector of key-description lists -as described in the documentation for the `define-key' function. -The binding goes in the current buffer's local map, -which is shared with other buffers in the same major mode." - ;;(interactive "KSet key locally: \nCSet key %s locally to command: ") - (interactive (list (setq key (read-key-sequence "Set key locally: ")) - ;; Command sexps are allowed here so that this arg - ;; may be supplied interactively via insert-key-binding. - (read-command-or-command-sexp - (format "Set key %s locally to command: " - (key-description key))))) - (if (null (current-local-map)) - (use-local-map (make-sparse-keymap))) - (define-key (current-local-map) key command) - nil) - -(defun global-unset-key (key) - "Remove global binding of KEY. -KEY is a string, a vector of events, or a vector of key-description lists -as described in the documentation for the `define-key' function." - (interactive "kUnset key globally: ") - (global-set-key key nil)) - -(defun local-unset-key (key) - "Remove local binding of KEY. -KEY is a string, a vector of events, or a vector of key-description lists -as described in the documentation for the `define-key' function." - (interactive "kUnset key locally: ") - (if (current-local-map) - (define-key (current-local-map) key nil))) - - -;; FSF-inherited brain-death. -(defun minor-mode-key-binding (key &optional accept-default) - "Find the visible minor mode bindings of KEY. -Return an alist of pairs (MODENAME . BINDING), where MODENAME is -the symbol which names the minor mode binding KEY, and BINDING is -KEY's definition in that mode. In particular, if KEY has no -minor-mode bindings, return nil. If the first binding is a -non-prefix, all subsequent bindings will be omitted, since they would -be ignored. Similarly, the list doesn't include non-prefix bindings -that come after prefix bindings. - -If optional argument ACCEPT-DEFAULT is non-nil, recognize default -bindings; see the description of `lookup-key' for more details about this." - (let ((tail minor-mode-map-alist) - a s v) - (while tail - (setq a (car tail) - tail (cdr tail)) - (and (consp a) - (symbolp (setq s (car a))) - (boundp s) - (symbol-value s) - ;; indirect-function deals with autoloadable keymaps - (setq v (indirect-function (cdr a))) - (setq v (lookup-key v key accept-default)) - ;; Terminate loop, with v set to non-nil value - (setq tail nil))) - v)) - - -(defun current-minor-mode-maps () - "Return a list of keymaps for the minor modes of the current buffer." - (let ((l '()) - (tail minor-mode-map-alist) - a s v) - (while tail - (setq a (car tail) - tail (cdr tail)) - (and (consp a) - (symbolp (setq s (car a))) - (boundp s) - (symbol-value s) - ;; indirect-function deals with autoloadable keymaps - (setq v (indirect-function (cdr a))) - (setq l (cons v l)))) - (nreverse l))) - - -;;#### What a crock -(defun define-prefix-command (name &optional mapvar) - "Define COMMAND as a prefix command. -A new sparse keymap is stored as COMMAND's function definition. -If second optional argument MAPVAR is not specified, - COMMAND's value (as well as its function definition) is set to the keymap. -If a second optional argument MAPVAR is given and is not `t', - the map is stored as its value. -Regardless of MAPVAR, COMMAND's function-value is always set to the keymap." - (let ((map (make-sparse-keymap name))) - (fset name map) - (cond ((not mapvar) - (set name map)) - ((eq mapvar 't) - ) - (t - (set mapvar map))) - name)) - - -;;; Converting vectors of events to a read-equivalent form. -;;; This is used both by call-interactively (for the command history) -;;; and by macros.el (for saving keyboard macros to a file). - -;; #### why does (events-to-keys [backspace]) return "\C-h"? -;; BTW, this function is a mess, and macros.el does *not* use it, in -;; spite of the above comment. `format-kbd-macro' is used to save -;; keyboard macros to a file. -(defun events-to-keys (events &optional no-mice) - "Given a vector of event objects, returns a vector of key descriptors, -or a string (if they all fit in the ASCII range). -Optional arg NO-MICE means that button events are not allowed." - (if (and events (symbolp events)) (setq events (vector events))) - (cond ((stringp events) - events) - ((not (vectorp events)) - (signal 'wrong-type-argument (list 'vectorp events))) - ((let* ((length (length events)) - (string (make-string length 0)) - c ce - (i 0)) - (while (< i length) - (setq ce (aref events i)) - (or (eventp ce) (setq ce (character-to-event ce))) - ;; Normalize `c' to `?c' and `(control k)' to `?\C-k' - ;; By passing t for the `allow-meta' arg we could get kbd macros - ;; with meta in them to translate to the string form instead of - ;; the list/symbol form; but I expect that would cause confusion, - ;; so let's use the list/symbol form whenever there's - ;; any ambiguity. - (setq c (event-to-character ce)) - (if (and c - character-set-property - (key-press-event-p ce)) - (cond ((symbolp (event-key ce)) - (if (get (event-key ce) character-set-property) - ;; Don't use a string for `backspace' and `tab' to - ;; avoid that unpleasant little ambiguity. - (setq c nil))) - ((and (= (event-modifier-bits ce) 1) ;control - (integerp (event-key ce))) - (let* ((te (character-to-event c))) - (if (and (symbolp (event-key te)) - (get (event-key te) character-set-property)) - ;; Don't "normalize" (control i) to tab - ;; to avoid the ambiguity in the other direction - (setq c nil)) - (deallocate-event te))))) - (if c - (aset string i c) - (setq i length string nil)) - (setq i (1+ i))) - string)) - (t - (let* ((length (length events)) - (new (copy-sequence events)) - event mods key - (i 0)) - (while (< i length) - (setq event (aref events i)) - (cond ((key-press-event-p event) - (setq mods (event-modifiers event) - key (event-key event)) - (if (numberp key) - (setq key (intern (make-string 1 key)))) - (aset new i (if mods - (nconc mods (cons key nil)) - key))) - ((misc-user-event-p event) - (aset new i (list 'menu-selection - (event-function event) - (event-object event)))) - ((or (button-press-event-p event) - (button-release-event-p event)) - (if no-mice - (error - "Mouse events can't be saved in keyboard macros.")) - (setq mods (event-modifiers event) - key (intern (format "button%d%s" - (event-button event) - (if (button-release-event-p event) - "up" "")))) - (aset new i (if mods - (nconc mods (cons key nil)) - key))) - ((or (and event (symbolp event)) - (and (consp event) (symbolp (car event)))) - (aset new i event)) - (t - (signal 'wrong-type-argument (list 'eventp event)))) - (setq i (1+ i))) - new)))) - - -(defun next-key-event () - "Return the next available keyboard event." - (let (event) - (while (not (key-press-event-p (setq event (next-command-event)))) - (dispatch-event event)) - event)) - -(defun key-sequence-list-description (keys) - "Convert a key sequence KEYS to the full [(modifiers... key)...] form. -Argument KEYS can be in any form accepted by `define-key' function." - (let ((vec - (cond ((vectorp keys) - keys) - ((stringp keys) - (vconcat keys)) - (t - (vector keys)))) - (event-to-list - #'(lambda (ev) - (append (event-modifiers ev) (list (event-key ev)))))) - (mapvector - #'(lambda (key) - (cond ((key-press-event-p key) - (funcall event-to-list key)) - ((characterp key) - (funcall event-to-list (character-to-event key))) - ((listp key) - key) - (t - (list key)))) - vec))) - - -;;; Support keyboard commands to turn on various modifiers. - -;;; These functions -- which are not commands -- each add one modifier -;;; to the following event. - -(defun event-apply-alt-modifier (ignore-prompt) - (event-apply-modifier 'alt)) -(defun event-apply-super-modifier (ignore-prompt) - (event-apply-modifier 'super)) -(defun event-apply-hyper-modifier (ignore-prompt) - (event-apply-modifier 'hyper)) -(defun event-apply-shift-modifier (ignore-prompt) - (event-apply-modifier 'shift)) -(defun event-apply-control-modifier (ignore-prompt) - (event-apply-modifier 'control)) -(defun event-apply-meta-modifier (ignore-prompt) - (event-apply-modifier 'meta)) - -;;; #### `key-translate-map' is ignored for now. -(defun event-apply-modifier (symbol) - "Return the next key event, with a modifier flag applied. -SYMBOL is the name of this modifier, as a symbol. -`function-key-map' is scanned for prefix bindings." - (let (events binding) - ;; read keystrokes scanning `function-key-map' - (while (keymapp - (setq binding - (lookup-key - function-key-map - (vconcat - (setq events - (append events (list (next-key-event))))))))) - (if binding ; found a binding - (progn - ;; allow for several modifiers - (if (and (symbolp binding) (fboundp binding)) - (setq binding (funcall binding nil))) - (setq events (append binding nil)) - ;; put remaining keystrokes back into input queue - (setq unread-command-events - (mapcar 'character-to-event (cdr events)))) - (setq unread-command-events (cdr events))) - ;; add a modifier SYMBOL to the first keystroke or event - (vector - (append (list symbol) - (delq symbol - (aref (key-sequence-list-description (car events)) 0)))))) - -(defun synthesize-keysym (ignore-prompt) - "Read a sequence of keys, and returned the corresponding key symbol. -The characters must be from the [-_a-zA-Z0-9]. Reading is terminated - by RET (which is discarded)." - (let ((continuep t) - event char list) - (while continuep - (setq event (next-key-event)) - (cond ((and (setq char (event-to-character event)) - (or (memq char '(?- ?_)) - (eq ?w (char-syntax char (standard-syntax-table))))) - ;; Advance a character. - (push char list)) - ((or (memq char '(?\r ?\n)) - (memq (event-key event) '(return newline))) - ;; Legal termination. - (setq continuep nil)) - (char - ;; Illegal character. - (error "Illegal character in keysym: %c" char)) - (t - ;; Illegal event. - (error "Event has no character equivalent: %s" event)))) - (vector (intern (concat "" (nreverse list)))))) - -;; This looks dirty. The following code should maybe go to another -;; file, and `create-console-hook' should maybe default to nil. -(add-hook - 'create-console-hook - #'(lambda (console) - (letf (((selected-console) console)) - (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) - (define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier) - (define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier) - (define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier) - (define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier) - (define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier) - (define-key function-key-map [?\C-x ?@ ?k] 'synthesize-keysym)))) - -;;; keymap.el ends here diff --git a/lisp/ldap.el b/lisp/ldap.el deleted file mode 100644 index 2e01edb..0000000 --- a/lisp/ldap.el +++ /dev/null @@ -1,173 +0,0 @@ -;;; ldap.el --- LDAP support for Emacs - -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: Oscar Figueiredo -;; Maintainer: Oscar Figueiredo -;; Created: Jan 1998 -;; Version: $Revision: 1.7.2.2 $ -;; Keywords: help 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. - -;;; Commentary: -;; This file provides mid-level and user-level functions to access directory -;; servers using the LDAP protocol (RFC 1777). - -;;; Installation: -;; LDAP support must have been built into XEmacs. - - -;;; Code: - -(defgroup ldap nil - "Lightweight Directory Access Protocol" - :group 'comm) - -(defcustom ldap-default-host nil - "*Default LDAP server." - :type '(choice (string :tag "Host name") - (const :tag "Use library default" nil)) - :group 'ldap) - -(defcustom ldap-default-port nil - "*Default TCP port for LDAP connections. -Initialized from the LDAP library at build time. Default value is 389." - :type '(choice (const :tag "Use library default" nil) - (integer :tag "Port number")) - :group 'ldap) - -(defcustom ldap-default-base nil - "*Default base for LDAP searches. -This is a string using the syntax of RFC 1779. -For instance, \"o=ACME, c=US\" limits the search to the -Acme organization in the United States." - :type '(choice (const :tag "Use library default" nil) - (string :tag "Search base")) - :group 'ldap) - - -(defcustom ldap-host-parameters-alist nil - "*Alist of host-specific options for LDAP transactions. -The format of each list element is: -\(HOST PROP1 VAL1 PROP2 VAL2 ...) -HOST is the name of an LDAP server. PROPn and VALn are property/value -pairs describing parameters for the server. Valid properties include: - `binddn' is the distinguished name of the user to bind as - (in RFC 1779 syntax). - `passwd' is the password to use for simple authentication. - `auth' is the authentication method to use. - Possible values are: `simple', `krbv41' and `krbv42'. - `base' is the base for the search as described in RFC 1779. - `scope' is one of the three symbols `subtree', `base' or `onelevel'. - `deref' is one of the symbols `never', `always', `search' or `find'. - `timelimit' is the timeout limit for the connection in seconds. - `sizelimit' is the maximum number of matches to return." - :type '(repeat :menu-tag "Host parameters" - :tag "Host parameters" - (list :menu-tag "Host parameters" - :tag "Host parameters" - :value nil - (string :tag "Host name") - (checklist :inline t - :greedy t - (list - :tag "Binding DN" - :inline t - (const :tag "Binding DN" binddn) - string) - (list - :tag "Password" - :inline t - (const :tag "Password" passwd) - string) - (list - :tag "Authentication Method" - :inline t - (const :tag "Authentication Method" auth) - (choice - (const :menu-tag "None" :tag "None" nil) - (const :menu-tag "Simple" :tag "Simple" simple) - (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) - (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) - (list - :tag "Search Base" - :inline t - (const :tag "Search Base" base) - string) - (list - :tag "Search Scope" - :inline t - (const :tag "Search Scope" scope) - (choice - (const :menu-tag "Default" :tag "Default" nil) - (const :menu-tag "Subtree" :tag "Subtree" subtree) - (const :menu-tag "Base" :tag "Base" base) - (const :menu-tag "One Level" :tag "One Level" onelevel))) - (list - :tag "Dereferencing" - :inline t - (const :tag "Dereferencing" deref) - (choice - (const :menu-tag "Default" :tag "Default" nil) - (const :menu-tag "Never" :tag "Never" never) - (const :menu-tag "Always" :tag "Always" always) - (const :menu-tag "When searching" :tag "When searching" search) - (const :menu-tag "When locating base" :tag "When locating base" find))) - (list - :tag "Time Limit" - :inline t - (const :tag "Time Limit" timelimit) - (integer :tag "(in seconds)")) - (list - :tag "Size Limit" - :inline t - (const :tag "Size Limit" sizelimit) - (integer :tag "(number of records)"))))) -:group 'ldap) - - -(defun ldap-search (filter &optional host attributes attrsonly) - "Perform an LDAP search. -FILTER is the search filter in RFC1558 syntax, i.e. something that -looks like \"(cn=John Smith)\". -HOST is the LDAP host on which to perform the search. -ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. -If ATTRSONLY is non nil, the attributes will be retrieved without -the associated values. -Additional search parameters can be specified through -`ldap-host-parameters-alist' which see." - (interactive "sFilter:") - (or host - (setq host ldap-default-host)) - (or host - (error "No LDAP host specified")) - (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) - ldap) - (message "Opening LDAP connection to %s..." host) - (setq ldap (ldap-open host host-plist)) - (message "Searching with LDAP on %s..." host) - (prog1 (ldap-search-internal ldap filter - (plist-get host-plist 'base) - (plist-get host-plist 'scope) - attributes attrsonly) - (ldap-close ldap)))) - -(provide 'ldap) - -;;; ldap.el ends here diff --git a/lisp/lib-complete.el b/lisp/lib-complete.el deleted file mode 100644 index 19e66da..0000000 --- a/lisp/lib-complete.el +++ /dev/null @@ -1,339 +0,0 @@ -;;; lib-complete.el --- Completion on the lisp search path - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) Mike Williams 1991 - -;; Author: Mike Williams -;; Maintainer: XEmacs Development Team -;; Keywords: lisp, extensions, dumped -;; Created: Sat Apr 20 17:47:21 1991 - -;; 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 is dumped with XEmacs. - -;; ======================================================================== -;; lib-complete.el -- Completion on a search path -;; Author : Mike Williams -;; Created On : Sat Apr 20 17:47:21 1991 -;; Last Modified By: Heiko M|nkel -;; Additional XEmacs integration By: Chuck Thompson -;; Last Modified On: Thu Jul 1 14:23:00 1994 -;; RCS Info : $Revision: 1.1 $ $Locker: $ -;; ======================================================================== -;; NOTE: XEmacs must be redumped if this file is changed. -;; -;; Copyright (C) Mike Williams 1991 -;; -;; Keywords: utility, lisp - -;; Many thanks to Hallvard Furuseth for his -;; helpful suggestions. - -;; The function locate-file is removed, because of its incompatibility -;; with the buildin function of the lemacs 19.10 (Heiko M|nkel). - -;; There is now the new function find-library in this package. - -;;; ChangeLog: - -;; 4/26/97: sb Mule-ize. - -;;; Code: - -;;=== Determine completions for filename in search path =================== - -(defun library-all-completions (FILE SEARCH-PATH &optional FULL FAST) - "Return all completions for FILE in any directory on SEARCH-PATH. -If optional third argument FULL is non-nil, returned pathnames should be - absolute rather than relative to some directory on the SEARCH-PATH. -If optional fourth argument FAST is non-nil, don't sort the completions, - or remove duplicates." - (setq FILE (or FILE "")) - (if (file-name-absolute-p FILE) - ;; It's an absolute file name, so don't need SEARCH-PATH - (progn - (setq FILE (expand-file-name FILE)) - (file-name-all-completions - (file-name-nondirectory FILE) (file-name-directory FILE))) - (let ((subdir (file-name-directory FILE)) - (file (file-name-nondirectory FILE)) - all-completions) - ;; Make list of completions in each directory on SEARCH-PATH - (while SEARCH-PATH - (let* ((dir (concat (file-name-as-directory - (expand-file-name (car SEARCH-PATH))) - subdir)) - (dir-prefix (if FULL dir subdir))) - (if (file-directory-p dir) - (let ((subdir-completions - (file-name-all-completions file dir))) - (while subdir-completions - (setq all-completions - (cons (concat dir-prefix (car subdir-completions)) - all-completions)) - (setq subdir-completions (cdr subdir-completions)))))) - (setq SEARCH-PATH (cdr SEARCH-PATH))) - (if FAST all-completions - (let ((sorted (nreverse (sort all-completions 'string<))) - compressed) - (while sorted - (if (equal (car sorted) (car compressed)) nil - (setq compressed (cons (car sorted) compressed))) - (setq sorted (cdr sorted))) - compressed))))) - -;;=== Utilities =========================================================== - -(defmacro progn-with-message (message &rest forms) - "(progn-with-message MESSAGE FORMS ...) -Display MESSAGE and evaluate FORMS, returning value of the last one." - ;; based on Hallvard Furuseth's funcall-with-message - `(if (eq (selected-window) (minibuffer-window)) - (save-excursion - (goto-char (point-max)) - (let ((orig-pmax (point-max))) - (unwind-protect - (progn - (insert " " ,message) (goto-char orig-pmax) - (sit-for 0) ; Redisplay - ,@forms) - (delete-region orig-pmax (point-max))))) - (prog2 - (message "%s" ,message) - (progn ,@forms) - (message "")))) - -(put 'progn-with-message 'lisp-indent-hook 1) - -;;=== Completion caching ================================================== - -(defconst lib-complete:cache nil - "Used within read-library and read-library-internal to prevent -costly repeated calls to library-all-completions. -Format is a list of lists of the form - - ([ ] ...) - -where each has the form - - ( )") - -(defun lib-complete:better-root (ROOT1 ROOT2) - "Return non-nil if ROOT1 is a superset of ROOT2." - (and (equal (file-name-directory ROOT1) (file-name-directory ROOT2)) - (string-match - (concat "^" (regexp-quote (file-name-nondirectory ROOT1))) - ROOT2))) - -(defun lib-complete:get-completion-table (FILE PATH FILTER) - (let* ((subdir (file-name-directory FILE)) - (root (file-name-nondirectory FILE)) - (PATH - (mapcar - (function (lambda (dir) (file-name-as-directory - (expand-file-name (or dir ""))))) - PATH)) - (key (vector PATH subdir FILTER)) - (real-dirs - (if subdir - (mapcar (function (lambda (dir) (concat dir subdir))) PATH) - PATH)) - (path-modtimes - (mapcar - (function (lambda (fn) (if fn (nth 5 (file-attributes fn))))) - real-dirs)) - (cache-entry (assoc key lib-complete:cache)) - (cache-records (cdr cache-entry))) - ;; Look for cached entry - (catch 'table - (while cache-records - (if (and - (lib-complete:better-root (nth 0 (car cache-records)) root) - (equal (nth 1 (car cache-records)) path-modtimes)) - (throw 'table (nth 2 (car cache-records)))) - (setq cache-records (cdr cache-records))) - ;; Otherwise build completions - (let ((completion-list - (progn-with-message "(building completion table...)" - (library-all-completions FILE PATH nil 'fast))) - (completion-table (make-vector 127 0))) - (while completion-list - (let ((completion - (if (or (not FILTER) - (file-directory-p (car completion-list))) - (car completion-list) - (funcall FILTER (car completion-list))))) - (if completion - (intern completion completion-table))) - (setq completion-list (cdr completion-list))) - ;; Cache the completions - (lib-complete:cache-completions key root - path-modtimes completion-table) - completion-table)))) - -(defvar lib-complete:max-cache-size 40 - "*Maximum number of search paths which are cached.") - -(defun lib-complete:cache-completions (key root modtimes table) - (let* ((cache-entry (assoc key lib-complete:cache)) - (cache-records (cdr cache-entry)) - (new-cache-records (list (list root modtimes table)))) - (if (not cache-entry) nil - ;; Remove old cache entry - (setq lib-complete:cache (delq cache-entry lib-complete:cache)) - ;; Copy non-redundant entries from old cache entry - (while cache-records - (if (or (equal root (nth 0 (car cache-records))) - (lib-complete:better-root root (nth 0 (car cache-records)))) - nil - (setq new-cache-records - (cons (car cache-records) new-cache-records))) - (setq cache-records (cdr cache-records)))) - ;; Add entry to front of cache - (setq lib-complete:cache - (cons (cons key (nreverse new-cache-records)) lib-complete:cache)) - ;; Trim cache - (let ((tail (nthcdr lib-complete:max-cache-size lib-complete:cache))) - (if tail (setcdr tail nil))))) - -;;=== Read a filename, with completion in a search path =================== -(defvar read-library-internal-search-path) - -(defun read-library-internal (FILE FILTER FLAG) - "Don't call this." - ;; Relies on read-library-internal-search-path being let-bound - (let ((completion-table - (lib-complete:get-completion-table - FILE read-library-internal-search-path FILTER))) - (cond - ((not completion-table) nil) - ;; Completion table is filtered before use, so the PREDICATE - ;; argument is redundant. - ((eq FLAG nil) (try-completion FILE completion-table nil)) - ((eq FLAG t) (all-completions FILE completion-table nil)) - ((eq FLAG 'lambda) (and (intern-soft FILE completion-table) t)) - ))) - -(defun read-library (PROMPT SEARCH-PATH &optional DEFAULT MUST-MATCH - FULL FILTER) - "Read library name, prompting with PROMPT and completing in directories -from SEARCH-PATH. A nil in the search path represents the current -directory. Completions for a given search-path are cached, with the -cache being invalidated whenever one of the directories on the path changes. -Default to DEFAULT if user enters a null string. -Optional fourth arg MUST-MATCH non-nil means require existing file's name. - Non-nil and non-t means also require confirmation after completion. -Optional fifth argument FULL non-nil causes a full pathname, rather than a - relative pathname, to be returned. Note that FULL implies MUST-MATCH. -Optional sixth argument FILTER can be used to provide a function to - filter the completions. This function is passed the filename, and should - return a transformed filename (possibly a null transformation) or nil, - indicating that the filename should not be included in the completions." - (let* ((read-library-internal-search-path SEARCH-PATH) - (library (completing-read PROMPT 'read-library-internal - FILTER (or MUST-MATCH FULL) nil))) - (cond - ((equal library "") DEFAULT) - (FULL (locate-file library read-library-internal-search-path - ;; decompression doesn't work with Mule -slb - (if (featurep 'mule) - ".el:.elc" - ".el:.el.gz:.elc"))) - (t library)))) - -;; NOTE: as a special case, read-library may be used to read a filename -;; relative to the current directory, returning a *relative* pathname -;; (read-file-name returns a full pathname). -;; -;; eg. (read-library "Local header: " '(nil) nil) - -(defun get-library-path () - "Front end to read-library" - (read-library "Find Library file: " load-path nil t t - (function (lambda (fn) - (cond - ;; decompression doesn't work with mule -slb - ((string-match (if (featurep 'mule) - "\\.el$" - "\\.el\\(\\.gz\\)?$") fn) - (substring fn 0 (match-beginning 0)))))) - )) - -;;=== Replacement for load-library with completion ======================== - -(defun load-library (library) - "Load the library named LIBRARY. -This is an interface to the function `load'." - (interactive - (list (read-library "Load Library: " load-path nil nil nil - (function (lambda (fn) - (cond - ((string-match "\\.elc?$" fn) - (substring fn 0 (match-beginning 0)))))) - ))) - (load library)) - -;;=== find-library with completion (Author: Heiko Muenkel) =================== - -(defun find-library (library &optional codesys) - "Find and edit the source for the library named LIBRARY. -The extension of the LIBRARY must be omitted. -Under XEmacs/Mule, the 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 (get-library-path) - (if current-prefix-arg - (read-coding-system "Coding System: ")))) - (find-file library codesys)) - -(defun find-library-other-window (library &optional codesys) - "Load the library named LIBRARY in another window. -Under XEmacs/Mule, the 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 (get-library-path) - (if current-prefix-arg - (read-coding-system "Coding System: ")))) - (find-file-other-window library codesys)) - -(defun find-library-other-frame (library &optional codesys) - "Load the library named LIBRARY in a newly-created frame. -Under XEmacs/Mule, the 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 (get-library-path) - (if current-prefix-arg - (read-coding-system "Coding System: ")))) - (find-file-other-frame library codesys)) - -; This conflicts with an existing binding -;(define-key global-map "\C-xl" 'find-library) -(define-key global-map "\C-x4l" 'find-library-other-window) -(define-key global-map "\C-x5l" 'find-library-other-frame) - -(provide 'lib-complete) - -;;; lib-complete.el ends here diff --git a/lisp/lisp-mnt.el b/lisp/lisp-mnt.el deleted file mode 100644 index 76feeb2..0000000 --- a/lisp/lisp-mnt.el +++ /dev/null @@ -1,577 +0,0 @@ -;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers - -;; Copyright (C) 1992, 1994 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond -;; Maintainer: Eric S. Raymond -;; Created: 14 Jul 1992 -;; Keywords: docs, maint -;; X-Modified-by: Bob Weiner , 4/14/95, to support -;; InfoDock headers. -;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! - -;; 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 minor mode adds some services to Emacs-Lisp editing mode. -;; -;; First, it knows about the header conventions for library packages. -;; One entry point supports generating synopses from a library directory. -;; Another can be used to check for missing headers in library files. -;; -;; Another entry point automatically addresses bug mail to a package's -;; maintainer or author. - -;; This file can be loaded by your lisp-mode-hook. Have it (require 'lisp-mnt) - -;; This file is an example of the header conventions. Note the following -;; features: -;; -;; * Header line --- makes it possible to extract a one-line summary of -;; the package's uses automatically for use in library synopses, KWIC -;; indexes and the like. -;; -;; Format is three semicolons, followed by the filename, followed by -;; three dashes, followed by the summary. All fields space-separated. -;; -;; * Author line --- contains the name and net address of at least -;; the principal author. -;; -;; If there are multiple authors, they should be listed on continuation -;; lines led by ;; (or multiple blanks), like this: -;; -;; ;; Author: Ashwin Ram -;; ;; Dave Sill -;; ;; David Lawrence -;; ;; Noah Friedman -;; ;; Joe Wells -;; ;; Dave Brennan -;; ;; Eric Raymond -;; -;; This field may have some special values; notably "FSF", meaning -;; "Free Software Foundation". -;; -;; * Maintainer line --- should be a single name/address as in the Author -;; line, or an address only, or the string "FSF". If there is no maintainer -;; line, the person(s) in the Author field are presumed to be it. The example -;; in this file is mildly bogus because the maintainer line is redundant. -;; The idea behind these two fields is to be able to write a Lisp function -;; that does "send mail to the author" without having to mine the name out by -;; hand. Please be careful about surrounding the network address with <> if -;; there's also a name in the field. -;; -;; * Created line --- optional, gives the original creation date of the -;; file. For historical interest, basically. -;; -;; * Version line --- intended to give the reader a clue if they're looking -;; at a different version of the file than the one they're accustomed to. This -;; may be an RCS or SCCS header. -;; -;; * Adapted-By line --- this is for FSF's internal use. The person named -;; in this field was the one responsible for installing and adapting the -;; package for the distribution. (This file doesn't have one because the -;; author *is* one of the maintainers.) -;; -;; * Keywords line --- used by the finder code (now under construction) -;; for finding Emacs Lisp code related to a topic. -;; -;; * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example -;; of a comment header. Headers starting with `X-' should never be used -;; for any real purpose; this is the way to safely add random headers -;; without invoking the wrath of any program. -;; -;; * Commentary line --- enables Lisp code to find the developer's and -;; maintainers' explanations of the package internals. -;; -;; * Change log line --- optional, exists to terminate the commentary -;; section and start a change-log part, if one exists. -;; -;; * Code line --- exists so Lisp can know where commentary and/or -;; change-log sections end. -;; -;; * Footer line --- marks end-of-file so it can be distinguished from -;; an expanded formfeed or the results of truncation. - -;;; Change Log: - -;; Tue Jul 14 23:44:17 1992 ESR -;; * Created. - -;;; Code: - -(require 'picture) ; provides move-to-column-force -;(require 'emacsbug) ; XEmacs, not needed for bytecompilation - -;;; Variables: - -(defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?" - "Prefix that is ignored before the tag. -For example, you can write the 1st line synopsis string and headers like this -in your Lisp package: - - ;; @(#) package.el -- package description - ;; - ;; @(#) $Maintainer: Person Foo Bar $ - -The @(#) construct is used by unix what(1) and -then $identifier: doc string $ is used by GNU ident(1)") - -(defvar lm-comment-column 16 - "Column used for placing formatted output.") - -(defvar lm-commentary-header "Commentary\\|Documentation" - "Regexp which matches start of documentation section.") - -(defvar lm-history-header "Change Log\\|History" - "Regexp which matches the start of code log section.") - -;;; Functions: - -;; These functions all parse the headers of the current buffer - -(defsubst lm-get-header-re (header &optional mode) - "Returns regexp for matching HEADER. -If called with optional MODE and with value `section', -return section regexp instead." - (cond ((eq mode 'section) - (concat "^;;;;* " header ":[ \t]*$")) - (t - (concat lm-header-prefix header ":[ \t]*")))) - -(defsubst lm-get-package-name () - "Returns package name by looking at the first line." - (save-excursion - (goto-char (point-min)) - (if (and (looking-at (concat lm-header-prefix)) - (progn (goto-char (match-end 0)) - (looking-at "\\([^\t ]+\\)") - (match-end 1))) - (buffer-substring (match-beginning 1) (match-end 1)) - ))) - -(defun lm-section-mark (header &optional after) - "Return the buffer location of a given section start marker. -The HEADER is the section mark string to search for. -If AFTER is non-nil, return the location of the next line." - (save-excursion - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (re-search-forward (lm-get-header-re header 'section) nil t) - (progn - (beginning-of-line) - (if after (forward-line 1)) - (point)) - nil)))) - -(defsubst lm-code-mark () - "Return the buffer location of the `Code' start marker." - (lm-section-mark "Code")) - -(defsubst lm-commentary-mark () - "Return the buffer location of the `Commentary' start marker." - (lm-section-mark lm-commentary-header)) - -(defsubst lm-history-mark () - "Return the buffer location of the `History' start marker." - (lm-section-mark lm-history-header)) - -(defun lm-header (header) - "Return the contents of the header named HEADER." - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t) - ;; RCS ident likes format "$identifier: data$" - (looking-at "\\([^$\n]+\\)") - (match-end 1)) - (buffer-substring (match-beginning 1) (match-end 1)) - nil))) - -(defun lm-header-multiline (header) - "Return the contents of the header named HEADER, with continuation lines. -The returned value is a list of strings, one per line." - (save-excursion - (goto-char (point-min)) - (let ((res (lm-header header))) - (cond - (res - (setq res (list res)) - (forward-line 1) - - (while (and (looking-at (concat lm-header-prefix "[\t ]+")) - (progn - (goto-char (match-end 0)) - (looking-at "\\(.*\\)")) - (match-end 1)) - (setq res (cons (buffer-substring - (match-beginning 1) - (match-end 1)) - res)) - (forward-line 1)) - )) - res - ))) - -;; These give us smart access to the header fields and commentary - -(defun lm-summary (&optional file) - "Return the one-line summary of file FILE, or current buffer if FILE is nil." - (save-excursion - (if file - (find-file file)) - (goto-char (point-min)) - (prog1 - (if (and - (looking-at lm-header-prefix) - (progn (goto-char (match-end 0)) - (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)"))) - (buffer-substring (match-beginning 1) (match-end 1))) - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-crack-address (x) - "Split up an email address into full name and real email address. -The value is a cons of the form (FULLNAME . ADDRESS)." - (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x) - (cons (substring x (match-beginning 1) (match-end 1)) - (substring x (match-beginning 2) (match-end 2)))) - ((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x) - (cons (substring x (match-beginning 2) (match-end 2)) - (substring x (match-beginning 1) (match-end 1)))) - ((string-match "\\S-+@\\S-+" x) - (cons nil x)) - (t - (cons x nil)))) - -(defun lm-authors (&optional file) - "Return the author list of file FILE, or current buffer if FILE is nil. -Each element of the list is a cons; the car is the full name, -the cdr is an email address." - (save-excursion - (if file - (find-file file)) - ;; XEmacs change (Is E-MAIL an infodock header? -sb) - (let* ((authorlist (lm-header-multiline "author")) - (email-list (lm-header-multiline "E-MAIL")) - (authors authorlist)) - (prog1 - (if (null email-list) - (mapcar 'lm-crack-address authorlist) - (while (and email-list authors) - (setcar authors (cons (car authors) (car email-list))) - (setq email-list (cdr email-list) - authors (cdr authors))) - authorlist) - (if file - (kill-buffer (current-buffer)))) - ))) - -(defun lm-maintainer (&optional file) - "Return the maintainer of file FILE, or current buffer if FILE is nil. -The return value has the form (NAME . ADDRESS)." - (save-excursion - (if file - (find-file file)) - (prog1 - (let ((maint (lm-header "maintainer"))) - (if maint - (lm-crack-address maint) - (car (lm-authors)))) - (if file - (kill-buffer (current-buffer)))))) - -(defun lm-creation-date (&optional file) - "Return the created date given in file FILE, or current buffer if FILE is nil." - (save-excursion - (if file - (find-file file)) - (prog1 - ;; XEmacs change (Is ORIG-DATE an Infodock header? -sb) - (or (lm-header "created") - (let ((date-and-time (lm-header "ORIG-DATE"))) - (if date-and-time - (substring date-and-time 0 - (string-match " " date-and-time))))) - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-last-modified-date (&optional file) - "Return the modify-date given in file FILE, or current buffer if FILE is nil." - (save-excursion - (if file - (find-file file)) - (prog1 - (if (progn - (goto-char (point-min)) - (re-search-forward - "\\$[I]d: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) " - (lm-code-mark) t)) - (format "%s %s %s" - (buffer-substring (match-beginning 3) (match-end 3)) - (nth (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))) - '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" - "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")) - (buffer-substring (match-beginning 1) (match-end 1))) - ;; XEmacs change (Infodock change? -sb) - (let ((date-and-time (lm-header "LAST-MOD"))) - (if date-and-time - (substring date-and-time 0 - (string-match " " date-and-time))))) - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-version (&optional file) - "Return the version listed in file FILE, or current buffer if FILE is nil. -This can befound in an RCS or SCCS header to crack it out of." - (save-excursion - (if file - (find-file file)) - (prog1 - (or - (lm-header "version") - (let ((header-max (lm-code-mark))) - (goto-char (point-min)) - (cond - ;; Look for an RCS header - ((re-search-forward "\\$[I]d: [^ ]+ \\([^ ]+\\) " header-max t) - (buffer-substring (match-beginning 1) (match-end 1))) - - ;; Look for an SCCS header - ((re-search-forward - (concat - (regexp-quote "@(#)") - (regexp-quote (file-name-nondirectory (buffer-file-name))) - "\t\\([012345679.]*\\)") - header-max t) - (buffer-substring (match-beginning 1) (match-end 1))) - - (t nil)))) - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-keywords (&optional file) - "Return the keywords given in file FILE, or current buffer if FILE is nil." - (save-excursion - (if file - (find-file file)) - (prog1 - (let ((keywords (lm-header "keywords"))) - (and keywords (downcase keywords))) - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-adapted-by (&optional file) - "Return the adapted-by names in file FILE, or current buffer if FILE is nil. -This is the name of the person who cleaned up this package for -distribution." - (save-excursion - (if file - (find-file file)) - (prog1 - (lm-header "adapted-by") - (if file - (kill-buffer (current-buffer))) - ))) - -(defun lm-commentary (&optional file) - "Return the commentary in file FILE, or current buffer if FILE is nil. -The value is returned as a string. In the text, the commentary starts -with tag `Commentary' and ends with tag `Change Log' or `History'." - (save-excursion - (if file - (find-file file)) - (prog1 - (let ((commentary (lm-commentary-mark)) - (change-log (lm-history-mark)) - (code (lm-code-mark)) - end) - (cond - ((and commentary change-log) - (buffer-substring commentary change-log)) - ((and commentary code) - (buffer-substring commentary code)) - (t - ;; XEmacs change (Infodock headers? -sb) - (setq commentary (lm-section-mark "DESCRIPTION" t)) - (setq end (lm-section-mark "DESCRIP-END")) - (and commentary end (buffer-substring commentary end))))) - (if file - (kill-buffer (current-buffer))) - ))) - -;;; Verification and synopses - -(defun lm-insert-at-column (col &rest strings) - "Insert list of STRINGS, at column COL." - (if (> (current-column) col) (insert "\n")) - (move-to-column-force col) - (apply 'insert strings)) - -(defun lm-verify (&optional file showok &optional verb) - "Check that the current buffer (or FILE if given) is in proper format. -If FILE is a directory, recurse on its files and generate a report in -a temporary buffer." - (interactive) - (let* ((verb (or verb (interactive-p))) - ret - name - ) - (if verb - (setq ret "Ok.")) ;init value - - (if (and file (file-directory-p file)) - (setq - ret - (progn - (switch-to-buffer (get-buffer-create "*lm-verify*")) - (erase-buffer) - (mapcar - #'(lambda (f) - (if (string-match ".*\\.el$" f) - (let ((status (lm-verify f))) - (if status - (progn - (insert f ":") - (lm-insert-at-column lm-comment-column status "\n")) - (and showok - (progn - (insert f ":") - (lm-insert-at-column lm-comment-column "OK\n"))))))) - (directory-files file)) - )) - (save-excursion - (if file - (find-file file)) - (setq name (lm-get-package-name)) - - (setq - ret - (prog1 - (cond - ((null name) - "Can't find a package NAME") - - ((not (lm-authors)) - "Author: tag missing.") - - ((not (lm-maintainer)) - "Maintainer: tag missing.") - - ((not (lm-summary)) - "Can't find a one-line 'Summary' description") - - ((not (lm-keywords)) - "Keywords: tag missing.") - - ((not (lm-commentary-mark)) - "Can't find a 'Commentary' section marker.") - - ((not (lm-history-mark)) - "Can't find a 'History' section marker.") - - ((not (lm-code-mark)) - "Can't find a 'Code' section marker") - - ((progn - (goto-char (point-max)) - (not - (re-search-backward - (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$" - "\\|^;;;[ \t]+ End of file[ \t]+" name) - nil t - ))) - (format "Can't find a footer line for [%s]" name)) - (t - ret)) - (if file - (kill-buffer (current-buffer))) - )))) - (if verb - (message ret)) - ret - )) - -(defun lm-synopsis (&optional file showall) - "Generate a synopsis listing for the buffer or the given FILE if given. -If FILE is a directory, recurse on its files and generate a report in -a temporary buffer. If SHOWALL is non-nil, also generate a line for files -which do not include a recognizable synopsis." - (interactive - (list - (read-file-name "Synopsis for (file or dir): "))) - - (if (and file (file-directory-p file)) - (progn - (switch-to-buffer (get-buffer-create "*lm-verify*")) - (erase-buffer) - (mapcar - (lambda (f) ; XEmacs - dequote - (if (string-match ".*\\.el$" f) - (let ((syn (lm-synopsis f))) - (if syn - (progn - (insert f ":") - (lm-insert-at-column lm-comment-column syn "\n")) - (and showall - (progn - (insert f ":") - (lm-insert-at-column lm-comment-column "NA\n"))))))) - (directory-files file)) - ) - (save-excursion - (if file - (find-file file)) - (prog1 - (lm-summary) - (if file - (kill-buffer (current-buffer))) - )))) - -(defun lm-report-bug (topic) - "Report a bug in the package currently being visited to its maintainer. -Prompts for bug subject. Leaves you in a mail buffer." - (interactive "sBug Subject: ") - (let ((package (lm-get-package-name)) - (addr (lm-maintainer)) - (version (lm-version))) - (mail nil - (if addr - (concat (car addr) " <" (cdr addr) ">") - (or (and (boundp 'report-emacs-bug-beta-address) - report-emacs-bug-beta-address) - "")) - topic) - (goto-char (point-max)) - (insert "\nIn " - package - (if version (concat " version " version) "") - "\n\n") - (message - (substitute-command-keys "Type \\[mail-send] to send bug report.")))) - -(provide 'lisp-mnt) - -;;; lisp-mnt.el ends here diff --git a/lisp/lisp-mode.el b/lisp/lisp-mode.el deleted file mode 100644 index e5e97ec..0000000 --- a/lisp/lisp-mode.el +++ /dev/null @@ -1,1030 +0,0 @@ -;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands. - -;; Copyright (C) 1985, 1996, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems - -;; Maintainer: FSF -;; Keywords: lisp, languages, dumped - -;; 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 (but starting to diverge). - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; The base major mode for editing Lisp code (used also for Emacs Lisp). -;; This mode is documented in the Emacs manual - -;; July/05/97 slb Converted to use easymenu. - -;;; Code: - -(defgroup lisp nil - "Lisp support, including Emacs Lisp." - :group 'languages - :group 'development) - -(defvar lisp-mode-syntax-table nil) -(defvar emacs-lisp-mode-syntax-table nil) -(defvar lisp-mode-abbrev-table nil) - -;; XEmacs change -(defvar lisp-interaction-mode-popup-menu nil) -(defvar lisp-interaction-mode-popup-menu-1 - (purecopy '("Lisp-Interaction" - ["Evaluate Last S-expression" eval-last-sexp] - ["Evaluate Entire Buffer" eval-current-buffer] - ["Evaluate Region" eval-region - :active (region-exists-p)] - "---" - ["Evaluate This Defun" eval-defun] - ;; FSF says "Instrument Function for Debugging" - ["Debug This Defun" edebug-defun] - "---" - ["Trace a Function" trace-function-background] - ["Untrace All Functions" untrace-all - :active (fboundp 'untrace-all)] - "---" - ["Comment Out Region" comment-region - :active (region-exists-p)] - ["Indent Region" indent-region - :active (region-exists-p)] - ["Indent Line" lisp-indent-line] - "---" - ["Debug On Error" (setq debug-on-error (not debug-on-error)) - :style toggle :selected debug-on-error] - ["Debug On Quit" (setq debug-on-quit (not debug-on-quit)) - :style toggle :selected debug-on-quit] - ["Debug on Signal" (setq debug-on-signal (not debug-on-signal)) - :style toggle :selected debug-on-signal] - ))) - -(defvar emacs-lisp-mode-popup-menu nil) -(defvar emacs-lisp-mode-popup-menu-1 - (purecopy - (nconc - '("Emacs-Lisp" - ["Byte-compile This File" emacs-lisp-byte-compile] - ["Byte-compile/load This" emacs-lisp-byte-compile-and-load] - ["Byte-recompile Directory..." byte-recompile-directory] - "---") - (cdr lisp-interaction-mode-popup-menu-1)))) - -;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the -;*scratch* buffer has a Lisp menubar item! Very confusing. -;(defvar lisp-interaction-mode-menubar-menu -; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu)))) - -(defvar emacs-lisp-mode-menubar-menu nil) -(defvar emacs-lisp-mode-menubar-menu-1 - (purecopy (cons "Lisp" (cdr emacs-lisp-mode-popup-menu-1)))) - -(if (not emacs-lisp-mode-syntax-table) - (let ((i 0)) - (setq emacs-lisp-mode-syntax-table (make-syntax-table)) - (while (< i ?0) - (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?9)) - (while (< i ?A) - (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?Z)) - (while (< i ?a) - (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) - (setq i (1+ i))) - (setq i (1+ ?z)) - (while (< i 128) - (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) - (setq i (1+ i))) - (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\f " " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table) - ;; Give CR the same syntax as newline, for selective-display. - (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table) - ;; Used to be singlequote; changed for flonums. - (modify-syntax-entry ?. "_ " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?# "' " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\" "\" " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\\ "\\ " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\( "() " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\) ")( " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\[ "(] " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\] ")[ " emacs-lisp-mode-syntax-table))) - -(if (not lisp-mode-syntax-table) - (progn (setq lisp-mode-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table)) - (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table) - (modify-syntax-entry ?\[ "_ " lisp-mode-syntax-table) - ;; XEmacs changes - (modify-syntax-entry ?\] "_ " lisp-mode-syntax-table) - ;; - ;; If emacs was compiled with NEW_SYNTAX, then do - ;; CL's #| |# block comments. - (if (= 8 (length (parse-partial-sexp (point) (point)))) - (progn - (modify-syntax-entry ?# "' 58" lisp-mode-syntax-table) - (modify-syntax-entry ?| ". 67" lisp-mode-syntax-table)) - ;; else, old style - (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table)))) - -(define-abbrev-table 'lisp-mode-abbrev-table ()) - -(defvar lisp-imenu-generic-expression - '( - (nil - "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2) - ("Variables" - "^\\s-*(def\\(var\\|const\\|custom\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2) - ("Types" - "^\\s-*(def\\(group\\|type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" - 2)) - - "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.") - -(defun lisp-mode-variables (lisp-syntax) - (cond (lisp-syntax - (set-syntax-table lisp-mode-syntax-table))) - (setq local-abbrev-table lisp-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 'fill-paragraph-function) - (setq fill-paragraph-function 'lisp-fill-paragraph) - ;; Adaptive fill mode gets in the way of auto-fill, - ;; and should make no difference for explicit fill - ;; because lisp-fill-paragraph should do the job. - (make-local-variable 'adaptive-fill-mode) - (setq adaptive-fill-mode nil) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'lisp-indent-line) - (make-local-variable 'indent-region-function) - (setq indent-region-function 'lisp-indent-region) - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'outline-regexp) - (setq outline-regexp ";;; \\|(....") - (make-local-variable 'comment-start) - (setq comment-start ";") - ;; XEmacs change - (set (make-local-variable 'block-comment-start) ";;") - (make-local-variable 'comment-start-skip) - ;; Look within the line for a ; following an even number of backslashes - ;; after either a non-backslash or the line beginning. - (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") - (make-local-variable 'comment-column) - (setq comment-column 40) - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'lisp-comment-indent) - ;; XEmacs change - (set (make-local-variable 'dabbrev-case-fold-search) nil) - (set (make-local-variable 'dabbrev-case-replace) nil) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression lisp-imenu-generic-expression)) - -(defvar shared-lisp-mode-map () - "Keymap for commands shared by all sorts of Lisp modes.") - -(if shared-lisp-mode-map - () - (setq shared-lisp-mode-map (make-sparse-keymap)) - ;; XEmacs changes - (set-keymap-name shared-lisp-mode-map 'shared-lisp-mode-map) - (define-key shared-lisp-mode-map "\M-;" 'lisp-indent-for-comment) - (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)) - -(defvar emacs-lisp-mode-map () - "Keymap for Emacs Lisp mode. -All commands in `shared-lisp-mode-map' are inherited by this map.") - -(if emacs-lisp-mode-map - () - ;; XEmacs: Ignore FSF nconc stuff - (setq emacs-lisp-mode-map (make-sparse-keymap)) - (set-keymap-name emacs-lisp-mode-map 'emacs-lisp-mode-map) - (set-keymap-parents emacs-lisp-mode-map (list shared-lisp-mode-map)) - (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol) - (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) - ;; XEmacs: Not sure what the FSF menu bindings are. I hope XEmacs - ;; doesn't need them. -) - -(defun emacs-lisp-byte-compile () - "Byte compile the file containing the current buffer." - (interactive) - (if buffer-file-name - ;; XEmacs change. Force buffer save first - (progn - (save-buffer) - (byte-compile-file buffer-file-name)) - (error "The buffer must be saved in a file first."))) - -(defun emacs-lisp-byte-compile-and-load () - "Byte-compile the current file (if it has changed), then load compiled code." - (interactive) - (or buffer-file-name - (error "The buffer must be saved in a file first")) - (require 'bytecomp) - ;; Recompile if file or buffer has changed since last compilation. - (if (and (buffer-modified-p) - (y-or-n-p (format "save buffer %s first? " (buffer-name)))) - (save-buffer)) - (let ((compiled-file-name (byte-compile-dest-file buffer-file-name))) - (if (file-newer-than-file-p compiled-file-name buffer-file-name) - (load-file compiled-file-name) - (byte-compile-file buffer-file-name t)))) - -(defun emacs-lisp-mode () - "Major mode for editing Lisp code to run in Emacs. -Commands: -Delete converts tabs to spaces as it moves back. -Blank lines separate paragraphs. Semicolons start comments. -\\{emacs-lisp-mode-map} -Entry to this mode calls the value of `emacs-lisp-mode-hook' -if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map emacs-lisp-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - ;; XEmacs changes - (setq major-mode 'emacs-lisp-mode - ;; mode-popup-menu emacs-lisp-mode-popup-menu - mode-name "Emacs-Lisp") - ;; (if (and (featurep 'menubar) - ;; current-menubar) - ;; (progn - ;; make a local copy of the menubar, so our modes don't - ;; change the global menubar - ;; (set-buffer-menubar current-menubar) - ;; (add-submenu nil emacs-lisp-mode-menubar-menu))) - (unless emacs-lisp-mode-popup-menu - (easy-menu-define emacs-lisp-mode-popup-menu emacs-lisp-mode-map "" - emacs-lisp-mode-popup-menu-1)) - (easy-menu-add emacs-lisp-mode-popup-menu) - (lisp-mode-variables nil) - (run-hooks 'emacs-lisp-mode-hook)) - -(defvar lisp-mode-map () - "Keymap for ordinary Lisp mode. -All commands in `shared-lisp-mode-map' are inherited by this map.") - -(if lisp-mode-map - () - ;; XEmacs changes - (setq lisp-mode-map (make-sparse-keymap)) - (set-keymap-name lisp-mode-map 'lisp-mode-map) - (set-keymap-parents lisp-mode-map (list shared-lisp-mode-map)) - (define-key lisp-mode-map "\e\C-x" 'lisp-send-defun) - ;; gag, no. use ilisp. -jwz -;; (define-key lisp-mode-map "\C-c\C-z" 'run-lisp) - ) - -(defun lisp-mode () - "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp. -Commands: -Delete converts tabs to spaces as it moves back. -Blank lines separate paragraphs. Semicolons start comments. -\\{lisp-mode-map} -Note that `run-lisp' may be used either to start an inferior Lisp job -or to switch back to an existing one. - -Entry to this mode calls the value of `lisp-mode-hook' -if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map lisp-mode-map) - (setq major-mode 'lisp-mode) - (setq mode-name "Lisp") - (lisp-mode-variables t) - (set-syntax-table lisp-mode-syntax-table) - (run-hooks 'lisp-mode-hook)) - -;; This will do unless shell.el is loaded. -;; XEmacs change -(defun lisp-send-defun () - "Send the current defun to the Lisp process made by \\[run-lisp]." - (interactive) - (error "Process lisp does not exist")) - -;; XEmacs change: emacs-lisp-mode-map is a more appropriate parent. -(defvar lisp-interaction-mode-map () - "Keymap for Lisp Interaction mode. -All commands in `shared-lisp-mode-map' are inherited by this map.") - -(if lisp-interaction-mode-map - () - ;; XEmacs set keymap our way - (setq lisp-interaction-mode-map (make-sparse-keymap)) - (set-keymap-name lisp-interaction-mode-map 'lisp-interaction-mode-map) - (set-keymap-parents lisp-interaction-mode-map (list emacs-lisp-mode-map)) - (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun) - (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol) - (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp)) - -(defun lisp-interaction-mode () - "Major mode for typing and evaluating Lisp forms. -Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression -before point, and prints its value into the buffer, advancing point. - -Commands: -Delete converts tabs to spaces as it moves back. -Paragraphs are separated only by blank lines. -Semicolons start comments. -\\{lisp-interaction-mode-map} -Entry to this mode calls the value of `lisp-interaction-mode-hook' -if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map lisp-interaction-mode-map) - (setq major-mode 'lisp-interaction-mode) - (setq mode-name "Lisp Interaction") - ;; XEmacs change - ;; (setq mode-popup-menu lisp-interaction-mode-popup-menu) - (unless lisp-interaction-mode-popup-menu - (easy-menu-define lisp-interaction-mode-popup-menu - lisp-interaction-mode-map - "" - lisp-interaction-mode-popup-menu-1)) - (easy-menu-add lisp-interaction-mode-popup-menu) - - (set-syntax-table emacs-lisp-mode-syntax-table) - (lisp-mode-variables nil) - (run-hooks 'lisp-interaction-mode-hook)) - -(defun eval-print-last-sexp () - "Evaluate sexp before point; print value into current buffer." - (interactive) - (let ((standard-output (current-buffer))) - (terpri) - (eval-last-sexp t) - (terpri))) - -;; XEmacs change -(defcustom eval-interactive-verbose t - "*Non-nil means that interactive evaluation can print messages. -The messages are printed when the expression is treated differently -using `\\[eval-last-sexp]' and `\\[eval-defun]' than it than it would have been -treated noninteractively. - -The printed messages are \"defvar treated as defconst\" and \"defcustom - evaluation forced\". See `eval-interactive' for more details." - :type 'boolean - :group 'lisp) - -(defun eval-interactive (expr) - "Like `eval' except that it transforms defvars to defconsts. -The evaluation of defcustom forms is forced." - (cond ((and (eq (car-safe expr) 'defvar) - (> (length expr) 2)) - (eval (cons 'defconst (cdr expr))) - (when eval-interactive-verbose - (message "defvar treated as defconst") - (sit-for 1) - (message "")) - (nth 1 expr)) - ((and (eq (car-safe expr) 'defcustom) - (> (length expr) 2) - (default-boundp (nth 1 expr))) - ;; Force variable to be bound - ;; #### defcustom might specify a different :set method. - (set-default (nth 1 expr) (eval (nth 2 expr))) - ;; And evaluate the defcustom - (eval expr) - (when eval-interactive-verbose - (message "defcustom evaluation forced") - (sit-for 1) - (message "")) - (nth 1 expr)) - (t - (eval expr)))) - -;; XEmacs change, based on Bob Weiner suggestion -(defun eval-last-sexp (eval-last-sexp-arg-internal) ;dynamic scoping wonderment - "Evaluate sexp before point; print value in minibuffer. -With argument, print output into current buffer." - (interactive "P") - (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) - (opoint (point)) - ignore-quotes) - (prin1 (eval-interactive - (letf (((syntax-table) emacs-lisp-mode-syntax-table)) - (save-excursion - ;; If this sexp appears to be enclosed in `...' then - ;; ignore the surrounding quotes. - (setq ignore-quotes (or (eq (char-after) ?\') - (eq (char-before) ?\'))) - (forward-sexp -1) - ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in - ;; `variable' so that the value is returned, not the - ;; name. - (if (and ignore-quotes - (eq (char-after) ?\`)) - (forward-char)) - (save-restriction - (narrow-to-region (point-min) opoint) - (let ((expr (read (current-buffer)))) - (if (eq (car-safe expr) 'interactive) - ;; If it's an (interactive ...) form, it's - ;; more useful to show how an interactive call - ;; would use it. - `(call-interactively - (lambda (&rest args) - ,expr args)) - expr))))))))) - -(defun eval-defun (eval-defun-arg-internal) - "Evaluate defun that point is in or before. -Print value in minibuffer. -With argument, insert value in current buffer after the defun." - (interactive "P") - (let ((standard-output (if eval-defun-arg-internal (current-buffer) t))) - (prin1 (eval-interactive (save-excursion - (end-of-defun) - (beginning-of-defun) - (read (current-buffer))))))) - - -(defun lisp-comment-indent () - (if (looking-at "\\s<\\s<\\s<") - (current-column) - (if (looking-at "\\s<\\s<") - ;; #### FSF has: - ;; (let ((tem (or (calculate-lisp-indent) (current-column)))) ... - (let ((tem (calculate-lisp-indent))) - (if (listp tem) (car tem) tem)) - (skip-chars-backward " \t") - (max (if (bolp) 0 (1+ (current-column))) - comment-column)))) - -;; XEmacs change -(defun lisp-indent-for-comment () - "Indent this line's comment appropriately, or insert an empty comment. -If adding a new comment on a blank line, use `block-comment-start' instead -of `comment-start' to open the comment." - ;; by Stig@hackvan.com - ;; #### - This functionality, the recognition of block-comment-{start,end}, - ;; will perhaps be standardized across modes and move to indent-for-comment. - (interactive) - (if (and block-comment-start - (save-excursion (beginning-of-line) (looking-at "^[ \t]*$"))) - (insert block-comment-start)) - (indent-for-comment)) - -(defvar lisp-indent-offset nil) -(defvar lisp-indent-function 'lisp-indent-function) - -(defun lisp-indent-line (&optional whole-exp) - "Indent current line as Lisp code. -With argument, indent any additional lines of the same expression -rigidly along with this one." - (interactive "P") - (let ((indent (calculate-lisp-indent)) shift-amt beg end - (pos (- (point-max) (point)))) - (beginning-of-line) - (setq beg (point)) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\s<\\s<") - ;; Don't alter indentation of a ;;; comment line. - (goto-char (- (point-max) pos)) - (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) - ;; Single-semicolon comment lines should be indented - ;; as comment lines, not as code. - (progn (indent-for-comment) (forward-char -1)) - (if (listp indent) (setq indent (car indent))) - (setq shift-amt (- indent (current-column))) - (if (zerop shift-amt) - nil - (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))) - ;; If desired, shift remaining lines of expression the same amount. - (and whole-exp (not (zerop shift-amt)) - (save-excursion - (goto-char beg) - (forward-sexp 1) - (setq end (point)) - (goto-char beg) - (forward-line 1) - (setq beg (point)) - (> end beg)) - (indent-code-rigidly beg end shift-amt))))) - -(defvar calculate-lisp-indent-last-sexp) - -(defun calculate-lisp-indent (&optional parse-start) - "Return appropriate indentation for current line as Lisp code. -In usual case returns an integer: the column to indent to. -Can instead return a list, whose car is the column to indent to. -This means that following lines at the same level of indentation -should not necessarily be indented the same way. -The second element of the list is the buffer position -of the start of the containing expression." - (save-excursion - (beginning-of-line) - (let ((indent-point (point)) - ;; XEmacs change (remove paren-depth) - state ;;paren-depth - ;; setting this to a number inhibits calling hook - (desired-indent nil) - (retry t) - calculate-lisp-indent-last-sexp containing-sexp) - (if parse-start - (goto-char parse-start) - (beginning-of-defun)) - ;; 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 - ;; XEmacs change (remove paren-depth) - (> ;;(setq paren-depth (elt state 0)) - (elt state 0) - 0)) - (setq retry nil) - (setq calculate-lisp-indent-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 calculate-lisp-indent-last-sexp - (> calculate-lisp-indent-last-sexp (point))) - ;; Yes, but is there a containing sexp after that? - (let ((peek (parse-partial-sexp calculate-lisp-indent-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 calculate-lisp-indent-last-sexp) - ;; indent-point immediately follows open paren. - ;; Don't call hook. - (setq desired-indent (current-column)) - ;; Find the start of first element of containing sexp. - (parse-partial-sexp (point) calculate-lisp-indent-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)) - calculate-lisp-indent-last-sexp) - ;; This is the first line to start within the containing sexp. - ;; It's almost certainly a function call. - (if (= (point) calculate-lisp-indent-last-sexp) - ;; Containing sexp has nothing before this line - ;; except the first element. Indent under that element. - nil - ;; Skip the first element, find start of second (the first - ;; argument of the function call) and indent under. - (progn (forward-sexp 1) - (parse-partial-sexp (point) - calculate-lisp-indent-last-sexp - 0 t))) - (backward-prefix-chars)) - (t - ;; Indent beneath first sexp on same line as - ;; calculate-lisp-indent-last-sexp. Again, it's - ;; almost certainly a function call. - (goto-char calculate-lisp-indent-last-sexp) - (beginning-of-line) - (parse-partial-sexp (point) calculate-lisp-indent-last-sexp - 0 t) - (backward-prefix-chars))))) - ;; Point is at the point to indent under unless we are inside a string. - ;; Call indentation hook except when overridden by lisp-indent-offset - ;; or if the desired indentation has already been computed. - (let ((normal-indent (current-column))) - (cond ((elt state 3) - ;; Inside a string, don't change indentation. - (goto-char indent-point) - (skip-chars-forward " \t") - (current-column)) - (desired-indent) - ((and (boundp 'lisp-indent-function) - lisp-indent-function - (not retry)) - (or (funcall lisp-indent-function indent-point state) - normal-indent)) - ;; XEmacs change: - ;; lisp-indent-offset shouldn't override lisp-indent-function ! - ((and (integerp lisp-indent-offset) containing-sexp) - ;; Indent by constant offset - (goto-char containing-sexp) - (+ normal-indent lisp-indent-offset)) - (t - normal-indent)))))) - -(defun lisp-indent-function (indent-point state) - ;; free reference to `calculate-lisp-indent-last-sexp' - ;; in #'calculate-lisp-indent - (let ((normal-indent (current-column))) - (goto-char (1+ (elt state 1))) - (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) - (if (and (elt state 2) - (not (looking-at "\\sw\\|\\s_"))) - ;; car of form doesn't seem to be a a symbol - (progn - (if (not (> (save-excursion (forward-line 1) (point)) - calculate-lisp-indent-last-sexp)) - (progn (goto-char calculate-lisp-indent-last-sexp) - (beginning-of-line) - (parse-partial-sexp (point) - calculate-lisp-indent-last-sexp 0 t))) - ;; Indent under the list or under the first sexp on the same - ;; line as calculate-lisp-indent-last-sexp. Note that first - ;; thing on that line has to be complete sexp since we are - ;; inside the innermost containing sexp. - (backward-prefix-chars) - (current-column)) - (let ((function (buffer-substring (point) - (progn (forward-sexp 1) (point)))) - method) - (setq method (or (get (intern-soft function) 'lisp-indent-function) - (get (intern-soft function) 'lisp-indent-hook))) - (cond ((or (eq method 'defun) - (and (null method) - (> (length function) 3) - (string-match "\\`def" function))) - (lisp-indent-defform state indent-point)) - ((integerp method) - (lisp-indent-specform method state - indent-point normal-indent)) - (method - (funcall method state indent-point))))))) - -(defvar lisp-body-indent 2 - "Number of columns to indent the second line of a `(def...)' form.") - -(defun lisp-indent-specform (count state indent-point normal-indent) - (let ((containing-form-start (elt state 1)) - (i count) - body-indent containing-form-column) - ;; Move to the start of containing form, calculate indentation - ;; to use for non-distinguished forms (> count), and move past the - ;; function symbol. lisp-indent-function guarantees that there is at - ;; least one word or symbol character following open paren of containing - ;; form. - (goto-char containing-form-start) - (setq containing-form-column (current-column)) - (setq body-indent (+ lisp-body-indent containing-form-column)) - (forward-char 1) - (forward-sexp 1) - ;; Now find the start of the last form. - (parse-partial-sexp (point) indent-point 1 t) - (while (and (< (point) indent-point) - (condition-case () - (progn - (setq count (1- count)) - (forward-sexp 1) - (parse-partial-sexp (point) indent-point 1 t)) - (error nil)))) - ;; Point is sitting on first character of last (or count) sexp. - (if (> count 0) - ;; A distinguished form. If it is the first or second form use double - ;; lisp-body-indent, else normal indent. With lisp-body-indent bound - ;; to 2 (the default), this just happens to work the same with if as - ;; the older code, but it makes unwind-protect, condition-case, - ;; with-output-to-temp-buffer, et. al. much more tasteful. The older, - ;; less hacked, behavior can be obtained by replacing below with - ;; (list normal-indent containing-form-start). - (if (<= (- i count) 1) - (list (+ containing-form-column (* 2 lisp-body-indent)) - containing-form-start) - (list normal-indent containing-form-start)) - ;; A non-distinguished form. Use body-indent if there are no - ;; distinguished forms and this is the first undistinguished form, - ;; or if this is the first undistinguished form and the preceding - ;; distinguished form has indentation at least as great as body-indent. - (if (or (and (= i 0) (= count 0)) - (and (= count 0) (<= body-indent normal-indent))) - body-indent - normal-indent)))) - -(defun lisp-indent-defform (state indent-point) - (goto-char (car (cdr state))) - (forward-line 1) - (if (> (point) (car (cdr (cdr state)))) - (progn - (goto-char (car (cdr state))) - (+ lisp-body-indent (current-column))))) - - -;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented -;; like defun if the first form is placed on the next line, otherwise -;; it is indented like any other form (i.e. forms line up under first). - -(put 'lambda 'lisp-indent-function 'defun) -(put 'autoload 'lisp-indent-function 'defun) -(put 'progn 'lisp-indent-function 0) -(put 'prog1 'lisp-indent-function 1) -(put 'prog2 'lisp-indent-function 2) -(put 'save-excursion 'lisp-indent-function 0) -(put 'save-window-excursion 'lisp-indent-function 0) -(put 'save-selected-window 'lisp-indent-function 0) -(put 'save-selected-frame 'lisp-indent-function 0) -(put 'with-selected-frame 'lisp-indent-function 1) -(put 'save-restriction 'lisp-indent-function 0) -(put 'save-match-data 'lisp-indent-function 0) -(put 'let 'lisp-indent-function 1) -(put 'let* 'lisp-indent-function 1) -(put 'let-specifier 'lisp-indent-function 1) -(put 'while 'lisp-indent-function 1) -(put 'if 'lisp-indent-function 2) -(put 'catch 'lisp-indent-function 1) -(put 'condition-case 'lisp-indent-function 2) -(put 'call-with-condition-handler 'lisp-indent-function 2) -(put 'unwind-protect 'lisp-indent-function 1) -(put 'save-current-buffer 'lisp-indent-function 0) -(put 'with-current-buffer 'lisp-indent-function 1) -(put 'with-string-as-buffer-contents 'lisp-indent-function 1) -(put 'with-temp-file 'lisp-indent-function 1) -(put 'with-temp-buffer 'lisp-indent-function 0) -(put 'with-output-to-string 'lisp-indent-function 0) -(put 'with-output-to-temp-buffer 'lisp-indent-function 1) -(put 'eval-after-load 'lisp-indent-function 1) -(put 'display-message 'lisp-indent-function 1) -(put 'display-warning 'lisp-indent-function 1) -(put 'lmessage 'lisp-indent-function 2) -(put 'lwarn 'lisp-indent-function 2) -(put 'global-set-key 'lisp-indent-function 1) - -(defun indent-sexp (&optional endpos) - "Indent each line of the list starting just after point. -If optional arg ENDPOS is given, indent each line, stopping when -ENDPOS is encountered." - (interactive) - (let ((indent-stack (list nil)) - (next-depth 0) - ;; If ENDPOS is non-nil, use nil as STARTING-POINT - ;; so that calculate-lisp-indent will find the beginning of - ;; the defun we are in. - ;; If ENDPOS is nil, it is safe not to scan before point - ;; since every line we indent is more deeply nested than point is. - (starting-point (if endpos nil (point))) - (last-point (point)) - last-depth bol outer-loop-done inner-loop-done state this-indent) - (or endpos - ;; Get error now if we don't have a complete sexp after point. - (save-excursion (forward-sexp 1))) - (save-excursion - (setq outer-loop-done nil) - (while (if endpos (< (point) endpos) - (not outer-loop-done)) - (setq last-depth next-depth - inner-loop-done nil) - ;; Parse this line so we can learn the state - ;; to indent the next line. - ;; This inner loop goes through only once - ;; unless a line ends inside a string. - (while (and (not inner-loop-done) - (not (setq outer-loop-done (eobp)))) - (setq state (parse-partial-sexp (point) (progn (end-of-line) (point)) - nil nil state)) - (setq next-depth (car state)) - ;; If the line contains a comment other than the sort - ;; that is indented like code, - ;; indent it now with indent-for-comment. - ;; Comments indented like code are right already. - ;; In any case clear the in-comment flag in the state - ;; because parse-partial-sexp never sees the newlines. - (if (car (nthcdr 4 state)) - (progn (indent-for-comment) - (end-of-line) - (setcar (nthcdr 4 state) nil))) - ;; If this line ends inside a string, - ;; go straight to next line, remaining within the inner loop, - ;; and turn off the \-flag. - (if (car (nthcdr 3 state)) - (progn - (forward-line 1) - (setcar (nthcdr 5 state) nil)) - (setq inner-loop-done t))) - (and endpos - (<= next-depth 0) - (progn - (setq indent-stack (append indent-stack - (make-list (- next-depth) nil)) - last-depth (- last-depth next-depth) - next-depth 0))) - (or outer-loop-done endpos - (setq outer-loop-done (<= next-depth 0))) - (if outer-loop-done - (forward-line 1) - (while (> last-depth next-depth) - (setq indent-stack (cdr indent-stack) - last-depth (1- last-depth))) - (while (< last-depth next-depth) - (setq indent-stack (cons nil indent-stack) - last-depth (1+ last-depth))) - ;; Now go to the next line and indent it according - ;; to what we learned from parsing the previous one. - (forward-line 1) - (setq bol (point)) - (skip-chars-forward " \t") - ;; But not if the line is blank, or just a comment - ;; (except for double-semi comments; indent them as usual). - (if (or (eobp) (looking-at "\\s<\\|\n")) - nil - (if (and (car indent-stack) - (>= (car indent-stack) 0)) - (setq this-indent (car indent-stack)) - (let ((val (calculate-lisp-indent - (if (car indent-stack) (- (car indent-stack)) - starting-point)))) - (if (integerp val) - (setcar indent-stack - (setq this-indent val)) - (setcar indent-stack (- (car (cdr val)))) - (setq this-indent (car val))))) - (if (/= (current-column) this-indent) - (progn (delete-region bol (point)) - (indent-to this-indent))))) - (or outer-loop-done - (setq outer-loop-done (= (point) last-point)) - (setq last-point (point))))))) - -;; Indent every line whose first char is between START and END inclusive. -(defun lisp-indent-region (start end) - (save-excursion - (let ((endmark (copy-marker end))) - (goto-char start) - (and (bolp) (not (eolp)) - (lisp-indent-line)) - (indent-sexp endmark) - (set-marker endmark nil)))) - -;;;; Lisp paragraph filling commands. - -(defun lisp-fill-paragraph (&optional justify) - "Like \\[fill-paragraph], but handle Emacs Lisp comments. -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 ( - ;; Non-nil if the current line contains a comment. - has-comment - - ;; Non-nil if the current line contains code and a comment. - has-code-and-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 - ;; semi which starts the comment shouldn't be part of a string or - ;; character. - ;; XEmacs Try this the FSF and see if it works. -; ((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) - ((condition-case nil - (save-restriction - (narrow-to-region (point-min) - (save-excursion (end-of-line) (point))) - (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 ]*")) - (error nil)) - (setq has-comment t has-code-and-comment t) - (setq comment-fill-prefix - (concat (make-string (/ (current-column) 8) ?\t) - (make-string (% (current-column) 8) ?\ ) - (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-excursion - (save-restriction - (beginning-of-line) - (narrow-to-region - ;; Find the first line we should include in the region to fill. - (save-excursion - (while (and (zerop (forward-line -1)) - (looking-at "^[ \t]*;"))) - ;; We may have gone too far. Go forward again. - (or (looking-at ".*;") - (forward-line 1)) - (point)) - ;; Find the beginning of the first line past the region to fill. - (save-excursion - (while (progn (forward-line 1) - (looking-at "^[ \t]*;"))) - (point))) - - ;; Lines with only semicolons on them can be paragraph boundaries. - (let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$")) - (paragraph-separate (concat paragraph-start "\\|[ \t;]*$")) - (paragraph-ignore-fill-prefix nil) - (fill-prefix comment-fill-prefix) - (after-line (if has-code-and-comment - (save-excursion - (forward-line 1) (point)))) - (end (progn - (forward-paragraph) - (or (bolp) (newline 1)) - (point))) - ;; If this comment starts on a line with code, - ;; include that like in the filling. - (beg (progn (backward-paragraph) - (if (eq (point) after-line) - (forward-line -1)) - (point)))) - (fill-region-as-paragraph beg end - justify nil - (save-excursion - (goto-char beg) - (if (looking-at fill-prefix) - nil - (re-search-forward comment-start-skip) - (point)))))))) - t)) - -(defun indent-code-rigidly (start end arg &optional nochange-regexp) - "Indent all lines of code, starting in the region, sideways by ARG columns. -Does not affect lines starting inside comments or strings, assuming that -the start of the region is not inside them. - -Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP. -The last is a regexp which, if matched at the beginning of a line, -means don't indent that line." - (interactive "r\np") - (let (state) - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (or (bolp) - (setq state (parse-partial-sexp (point) - (progn - (forward-line 1) (point)) - nil nil state))) - (while (< (point) end) - (or (car (nthcdr 3 state)) - (and nochange-regexp - (looking-at nochange-regexp)) - ;; If line does not start in string, indent it - (let ((indent (current-indentation))) - (delete-region (point) (progn (skip-chars-forward " \t") (point))) - (or (eolp) - (indent-to (max 0 (+ indent arg)) 0)))) - (setq state (parse-partial-sexp (point) - (progn - (forward-line 1) (point)) - nil nil state)))))) - -(provide 'lisp-mode) - -;;; lisp-mode.el ends here diff --git a/lisp/lisp.el b/lisp/lisp.el deleted file mode 100644 index 5878e23..0000000 --- a/lisp/lisp.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; lisp.el --- Lisp editing commands for XEmacs - -;; Copyright (C) 1985, 1986, 1994, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: lisp, languages, dumped - -;; 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/Mule zeta. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Lisp editing commands to go with Lisp major mode. - -;; 06/11/1997 - Use char-(after|before) instead of -;; (following|preceding)-char. -slb - -;;; Code: - -;; Note that this variable is used by non-lisp modes too. -(defcustom defun-prompt-regexp nil - "*Non-nil => regexp to ignore, before the character that starts a defun. -This is only necessary if the opening paren or brace is not in column 0. -See `beginning-of-defun'." - :type '(choice (const :tag "none" nil) - regexp) - :group 'lisp) - -(make-variable-buffer-local 'defun-prompt-regexp) - -(defcustom parens-require-spaces t - "Non-nil => `insert-parentheses' should insert whitespace as needed." - :type 'boolean - :group 'editing-basics - :group 'lisp) - -(defun forward-sexp (&optional arg) - "Move forward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move backward across N balanced expressions." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (or arg (setq arg 1)) - ;; XEmacs: evil hack! The other half of the evil hack below. - (if (and (> arg 0) (looking-at "#s(")) - (goto-char (+ (point) 2))) - (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) - (if (< arg 0) (backward-prefix-chars)) - ;; XEmacs: evil hack! Skip back over #s so that structures are read - ;; properly. the current cheesified syntax tables just aren't up to - ;; this. - (if (and (< arg 0) - (eq (char-after (point)) ?\() - (>= (- (point) (point-min)) 2) - (eq (char-after (- (point) 1)) ?s) - (eq (char-after (- (point) 2)) ?#)) - (goto-char (- (point) 2)))) - -(defun backward-sexp (&optional arg) - "Move backward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move forward across N balanced expressions." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (or arg (setq arg 1)) - (forward-sexp (- arg))) - -(defun mark-sexp (arg) - "Set mark ARG sexps from point. -The place mark goes is the same place \\[forward-sexp] would -move to with the same argument. -Repeat this command to mark more sexps in the same direction." - (interactive "p") - ;; XEmacs change - (mark-something 'mark-sexp 'forward-sexp arg)) - -(defun forward-list (&optional arg) - "Move forward across one balanced group of parentheses. -With argument, do it that many times. -Negative arg -N means move backward across N groups of parentheses." - ;; XEmacs change - (interactive "_p") - (or arg (setq arg 1)) - (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) - -(defun backward-list (&optional arg) - "Move backward across one balanced group of parentheses. -With argument, do it that many times. -Negative arg -N means move forward across N groups of parentheses." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (or arg (setq arg 1)) - (forward-list (- arg))) - -(defun down-list (arg) - "Move forward down one level of parentheses. -With argument, do this that many times. -A negative argument means move backward but still go down a level. -In Lisp programs, an argument is required." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) - (setq arg (- arg inc))))) - -(defun backward-up-list (arg) - "Move backward out of one level of parentheses. -With argument, do this that many times. -A negative argument means move forward but still to a less deep spot. -In Lisp programs, an argument is required." - (interactive "_p") - (up-list (- arg))) - -(defun up-list (arg) - "Move forward out of one level of parentheses. -With argument, do this that many times. -A negative argument means move backward but still to a less deep spot. -In Lisp programs, an argument is required." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) - (setq arg (- arg inc))))) - -(defun kill-sexp (arg) - "Kill the sexp (balanced expression) following the cursor. -With argument, kill that many sexps after the cursor. -Negative arg -N means kill N sexps before the cursor." - (interactive "p") - (let ((opoint (point))) - (forward-sexp arg) - (kill-region opoint (point)))) - -(defun backward-kill-sexp (arg) - "Kill the sexp (balanced expression) preceding the cursor. -With argument, kill that many sexps before the cursor. -Negative arg -N means kill N sexps after the cursor." - (interactive "p") - (kill-sexp (- arg))) - -(defun beginning-of-defun (&optional arg) - "Move backward to the beginning of a defun. -With argument, do it that many times. Negative arg -N -means move forward to Nth following beginning of defun. -Returns t unless search stops due to beginning or end of buffer. - -Normally a defun starts when there is an char with open-parenthesis -syntax at the beginning of a line. If `defun-prompt-regexp' is -non-nil, then a string which matches that regexp may precede the -open-parenthesis, and point ends up at the beginning of the line." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (and (beginning-of-defun-raw arg) - (progn (beginning-of-line) t))) - -(defun beginning-of-defun-raw (&optional arg) - "Move point to the character that starts a defun. -This is identical to beginning-of-defun, except that point does not move -to the beginning of the line when `defun-prompt-regexp' is non-nil." - (interactive "p") - (and arg (< arg 0) (not (eobp)) (forward-char 1)) - (and (re-search-backward (if defun-prompt-regexp - (concat "^\\s(\\|" - "\\(" defun-prompt-regexp "\\)\\s(") - "^\\s(") - nil 'move (or arg 1)) - (progn (goto-char (1- (match-end 0)))) t)) - -;; XEmacs change (optional buffer parameter) -(defun buffer-end (arg &optional buffer) - "Return `point-max' of BUFFER if ARG is > 0; return `point-min' otherwise. -BUFFER defaults to the current buffer if omitted." - (if (> arg 0) (point-max buffer) (point-min buffer))) - -(defun end-of-defun (&optional arg) - "Move forward to next end of defun. With argument, do it that many times. -Negative argument -N means move back to Nth preceding end of defun. - -An end of a defun occurs right after the close-parenthesis that matches -the open-parenthesis that starts a defun; see `beginning-of-defun'." - ;; XEmacs change (for zmacs regions) - (interactive "_p") - (if (or (null arg) (= arg 0)) (setq arg 1)) - (let ((first t)) - (while (and (> arg 0) (< (point) (point-max))) - (let ((pos (point))) ; XEmacs -- remove unused npos. - (while (progn - (if (and first - (progn - (end-of-line 1) - (beginning-of-defun-raw 1))) - nil - (or (bobp) (forward-char -1)) - (beginning-of-defun-raw -1)) - (setq first nil) - (forward-list 1) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1)) - (<= (point) pos)))) - (setq arg (1- arg))) - (while (< arg 0) - (let ((pos (point))) - (beginning-of-defun-raw 1) - (forward-sexp 1) - (forward-line 1) - (if (>= (point) pos) - (if (beginning-of-defun-raw 2) - (progn - (forward-list 1) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1))) - (goto-char (point-min))))) - (setq arg (1+ arg))))) - -(defun mark-defun () - "Put mark at end of this defun, point at beginning. -The defun marked is the one that contains point or follows point." - (interactive) - (push-mark (point)) - (end-of-defun) - (push-mark (point) nil t) - (beginning-of-defun) - (re-search-backward "^\n" (- (point) 1) t)) - -(defun narrow-to-defun (&optional arg) - "Make text outside current defun invisible. -The defun visible is the one that contains point or follows point." - (interactive) - (save-excursion - (widen) - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (narrow-to-region (point) end)))) - -(defun insert-parentheses (arg) - "Enclose following ARG sexps in parentheses. Leave point after open-paren. -A negative ARG encloses the preceding ARG sexps instead. -No argument is equivalent to zero: just insert `()' and leave point between. -If `parens-require-spaces' is non-nil, this command also inserts a space -before and after, depending on the surrounding characters." - (interactive "P") - (if arg (setq arg (prefix-numeric-value arg)) - (setq arg 0)) - (cond ((> arg 0) (skip-chars-forward " \t")) - ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) - (and parens-require-spaces - (not (bobp)) - (memq (char-syntax (char-before (point))) '(?w ?_ ?\) )) - (insert " ")) - (insert ?\() - (save-excursion - (or (eq arg 0) (forward-sexp arg)) - (insert ?\)) - (and parens-require-spaces - (not (eobp)) - (memq (char-syntax (char-after (point))) '(?w ?_ ?\( )) - (insert " ")))) - -(defun move-past-close-and-reindent () - "Move past next `)', delete indentation before it, then indent after it." - (interactive) - (up-list 1) - (forward-char -1) - (while (save-excursion ; this is my contribution - (let ((before-paren (point))) - (back-to-indentation) - (= (point) before-paren))) - (delete-indentation)) - (forward-char 1) - (newline-and-indent)) - -(defun lisp-complete-symbol () - "Perform completion on Lisp symbol preceding point. -Compare that symbol against the known Lisp symbols. - -The context determines which symbols are considered. -If the symbol starts just after an open-parenthesis, only symbols -with function definitions are considered. Otherwise, all symbols with -function definitions, values or properties are considered." - (interactive) - (let* ((end (point)) - (buffer-syntax (syntax-table)) - (beg (unwind-protect - (save-excursion - ;; XEmacs change - (if emacs-lisp-mode-syntax-table - (set-syntax-table emacs-lisp-mode-syntax-table)) - (backward-sexp 1) - (while (eq (char-syntax (char-after (point))) ?\') - (forward-char 1)) - (point)) - (set-syntax-table buffer-syntax))) - (pattern (buffer-substring beg end)) - (predicate - (if (eq (char-after (1- beg)) ?\() - 'fboundp - ;; XEmacs change - #'(lambda (sym) - (or (boundp sym) (fboundp sym) - (symbol-plist sym))))) - (completion (try-completion pattern obarray predicate))) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (insert completion)) - (t - (message "Making completion list...") - (let ((list (all-completions pattern obarray predicate)) - ;FSFmacs crock unnecessary in XEmacs - ;see minibuf.el - ;(completion-fixup-function - ; (function (lambda () (if (save-excursion - ; (goto-char (max (point-min) - ; (- (point) 4))) - ; (looking-at " ")) - ; (forward-char -4)))) - ) - (or (eq predicate 'fboundp) - (let (new) - (while list - (setq new (cons (if (fboundp (intern (car list))) - (list (car list) " ") - (car list)) - new)) - (setq list (cdr list))) - (setq list (nreverse new)))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list))) - (message "Making completion list...%s" "done"))))) - -;;; lisp.el ends here diff --git a/lisp/list-mode.el b/lisp/list-mode.el deleted file mode 100644 index b3603e5..0000000 --- a/lisp/list-mode.el +++ /dev/null @@ -1,595 +0,0 @@ -;;; list-mode.el --- Major mode for buffers containing lists of items - -;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 is dumped with XEmacs. - -;; Cleanup, merging with FSF by Ben Wing, January 1996 - -;;; Code: - -(defvar list-mode-extent nil) -(make-variable-buffer-local 'list-mode-extent) - -(defvar list-mode-map nil - "Local map for buffers containing lists of items.") -(or list-mode-map - (let ((map (setq list-mode-map (make-sparse-keymap 'list-mode-map)))) - (suppress-keymap map) - (define-key map 'button2up 'list-mode-item-mouse-selected) - (define-key map 'button2 'undefined) - (define-key map "\C-m" 'list-mode-item-keyboard-selected) -;; -;; The following calls to `substitute-key-definition' losed because -;; they were based on an incorrect assumption that `forward-char' and -;; `backward-char' are bound to keys in the global map. This might not -;; be the case if a user binds motion keys to different functions, -;; and was not actually the case since 20.5 beta 28 or around. -;; -;; (substitute-key-definition 'forward-char 'next-list-mode-item map -;; global-map) -;; (substitute-key-definition 'backward-char 'previous-list-mode-item map -;; global-map) -;; -;; We bind standard keys to motion commands instead. -;; - (dolist (key '(kp-right right (control ?f))) - (define-key map key 'next-list-mode-item)) - (dolist (key '(kp-left left (control ?b))) - (define-key map key 'previous-list-mode-item)))) - -(defun list-mode () - "Major mode for buffer containing lists of items." - (interactive) - (kill-all-local-variables) - (use-local-map list-mode-map) - (setq mode-name "List") - (setq major-mode 'list-mode) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'set-list-mode-extent nil t) - (make-local-hook 'pre-command-hook) - (add-hook 'pre-command-hook 'list-mode-extent-pre-hook nil t) - (make-local-variable 'next-line-add-newlines) - (setq next-line-add-newlines nil) - (setq list-mode-extent nil) - (set-specifier text-cursor-visible-p nil (current-buffer)) - (setq buffer-read-only t) - (goto-char (point-min)) - (run-hooks 'list-mode-hook)) - -;; List mode is suitable only for specially formatted data. -(put 'list-mode 'mode-class 'special) - -(defvar list-mode-extent-old-point nil - "The value of point when pre-command-hook is called. -Used to determine the direction of motion.") -(make-variable-buffer-local 'list-mode-extent-old-point) - -(defun list-mode-extent-pre-hook () - (setq list-mode-extent-old-point (point)) - ;(setq atomic-extent-goto-char-p nil) -) - -(defun set-list-mode-extent () - "Move to the closest list item and set up the extent for it. -This is called from `post-command-hook'." - (cond ((get-char-property (point) 'list-mode-item)) - ((and (> (point) (point-min)) - (get-char-property (1- (point)) 'list-mode-item)) - (goto-char (1- (point)))) - (t - (let ((pos (point)) - dirflag) - ;this fucks things up more than it helps. - ;atomic-extent-goto-char-p as currently defined is all broken, - ;since it will be triggered if the command *ever* runs goto-char! - ;(if atomic-extent-goto-char-p - ; (setq dirflag 1) - (if (and list-mode-extent-old-point - (> pos list-mode-extent-old-point)) - (setq dirflag 1) - (setq dirflag -1)) - (next-list-mode-item dirflag) - (or (get-char-property (point) 'list-mode-item) - (next-list-mode-item (- dirflag)))))) - (or (and list-mode-extent - (eq (current-buffer) (extent-object list-mode-extent))) - (progn - (setq list-mode-extent (make-extent nil nil (current-buffer))) - (set-extent-face list-mode-extent 'list-mode-item-selected))) - (let ((ex (extent-at (point) nil 'list-mode-item nil 'at))) - (if ex - (progn - (set-extent-endpoints list-mode-extent - (extent-start-position ex) - (extent-end-position ex)) - (auto-show-make-region-visible (extent-start-position ex) - (extent-end-position ex))) - (detach-extent list-mode-extent)))) - -(defun previous-list-mode-item (n) - "Move to the previous item in list-mode." - (interactive "p") - (next-list-mode-item (- n))) - -(defun next-list-mode-item (n) - "Move to the next item in list-mode. -With prefix argument N, move N items (negative N means move backward)." - (interactive "p") - (while (and (> n 0) (not (eobp))) - (let ((extent (extent-at (point) (current-buffer) 'list-mode-item)) - (end (point-max))) - ;; If in a completion, move to the end of it. - (if extent (goto-char (extent-end-position extent))) - ;; Move to start of next one. - (or (extent-at (point) (current-buffer) 'list-mode-item) - (goto-char (next-single-property-change (point) 'list-mode-item - nil end)))) - (setq n (1- n))) - (while (and (< n 0) (not (bobp))) - (let ((extent (extent-at (point) (current-buffer) 'list-mode-item)) - (end (point-min))) - ;; If in a completion, move to the start of it. - (if extent (goto-char (extent-start-position extent))) - ;; Move to the start of that one. - (if (setq extent (extent-at (point) (current-buffer) 'list-mode-item - nil 'before)) - (goto-char (extent-start-position extent)) - (goto-char (previous-single-property-change - (point) 'list-mode-item nil end)) - (if (setq extent (extent-at (point) (current-buffer) 'list-mode-item - nil 'before)) - (goto-char (extent-start-position extent))))) - (setq n (1+ n)))) - -(defun list-mode-item-selected-1 (extent event) - (let ((func (extent-property extent 'list-mode-item-activate-callback)) - (user-data (extent-property extent 'list-mode-item-user-data))) - (if func - (funcall func event extent user-data)))) - -;; we could make these two be just one function, but we want to be -;; able to refer to them in DOC strings. - -(defun list-mode-item-keyboard-selected () - (interactive) - (list-mode-item-selected-1 (extent-at (point) (current-buffer) - 'list-mode-item nil 'at) - nil)) - -(defun list-mode-item-mouse-selected (event) - (interactive "e") - ;; Sometimes event-closest-point returns nil. - ;; So beep instead of bombing. - (let ((point (event-closest-point event))) - (if point - (list-mode-item-selected-1 (extent-at point - (event-buffer event) - 'list-mode-item nil 'at) - event) - (ding)))) - -(defun add-list-mode-item (start end &optional buffer activate-callback - user-data) - "Add a new list item in list-mode, from START to END in BUFFER. -BUFFER defaults to the current buffer. -This works by creating an extent for the span of text in question. -If ACTIVATE-CALLBACK is non-nil, it should be a function of three - arguments (EVENT EXTENT USER-DATA) that will be called when button2 - is pressed on the extent. USER-DATA comes from the optional - USER-DATA argument." - (let ((extent (make-extent start end buffer))) - (set-extent-property extent 'list-mode-item t) - (set-extent-property extent 'start-open t) - (if activate-callback - (progn - (set-extent-property extent 'mouse-face 'highlight) - (set-extent-property extent 'list-mode-item-activate-callback - activate-callback) - (set-extent-property extent 'list-mode-item-user-data user-data))) - extent)) - - -;; Define the major mode for lists of completions. - - -(defvar completion-highlight-first-word-only nil - "*Completion will only highlight the first blank delimited word if t. -If the variable in not t or nil, the string is taken as a regexp to match for end -of highlight") - -(defvar completion-setup-hook nil - "Normal hook run at the end of setting up the text of a completion buffer.") - -; Unnecessary FSFmacs crock. We frob the extents directly in -; display-completion-list, so no "heuristics" like this are necessary. -;(defvar completion-fixup-function nil -; "A function to customize how completions are identified in completion lists. -;`completion-setup-function' calls this function with no arguments -;each time it has found what it thinks is one completion. -;Point is at the end of the completion in the completion list buffer. -;If this function moves point, it can alter the end of that completion.") - -(defvar completion-default-help-string - '(concat - (if (device-on-window-system-p) - (substitute-command-keys - "Click \\\\[list-mode-item-mouse-selected] on a completion to select it.\n") "") - (substitute-command-keys - "Type \\\\[advertised-switch-to-completions] or \\[switch-to-completions] to move to this buffer, for keyboard selection.\n\n")) - "Form the evaluate to get a help string for completion lists. -This string is inserted at the beginning of the buffer. -See `display-completion-list'.") - -(defun display-completion-list (completions &rest cl-keys) - "Display the list of completions, COMPLETIONS, using `standard-output'. -Each element may be just a symbol or string or may be a list of two - strings to be printed as if concatenated. -Frob a mousable extent onto each completion. This extent has properties - 'mouse-face (so it highlights when the mouse passes over it) and - 'list-mode-item (so it can be located). - -Keywords: - :activate-callback (default is `default-choose-completion') - See `add-list-mode-item'. - :user-data - Value passed to activation callback. - :window-width - If non-nil, width to use in displaying the list, instead of the - actual window's width. - :help-string (default is the value of `completion-default-help-string') - Form to evaluate to get a string to insert at the beginning of - the completion list buffer. This is evaluated when that buffer - is the current buffer and after it has been put into - completion-list-mode. - :reference-buffer (default is the current buffer) - This specifies the value of `completion-reference-buffer' in - the completion buffer. This specifies the buffer (normally a - minibuffer) that `default-choose-completion' will insert the - completion into. - -At the end, run the normal hook `completion-setup-hook'. -It can find the completion buffer in `standard-output'. -If `completion-highlight-first-word-only' is non-nil, then only the start - of the string is highlighted." - ;; #### I18N3 should set standard-output to be (temporarily) - ;; output-translating. - (cl-parsing-keywords - ((:activate-callback 'default-choose-completion) - :user-data - :reference-buffer - (:help-string completion-default-help-string) - (:completion-string "Possible completions are:") - :window-width) - () - (let ((old-buffer (current-buffer)) - (bufferp (bufferp standard-output))) - (if bufferp - (set-buffer standard-output)) - (if (null completions) - (princ (gettext - "There are no possible completions of what you have typed.")) - (let ((win-width - (or cl-window-width - (if bufferp - ;; This needs fixing for the case of windows - ;; that aren't the same width's the frame. - ;; Sadly, the window it will appear in is not known - ;; until after the text has been made. - - ;; We have to use last-nonminibuf-frame here - ;; and not selected-frame because if a - ;; minibuffer-only frame is being used it will - ;; be the selected-frame at the point this is - ;; run. We keep the selected-frame call around - ;; just in case. - (frame-width (or (last-nonminibuf-frame) - (selected-frame))) - 80)))) - (let ((count 0) - (max-width 0)) - ;; Find longest completion - (let ((tail completions)) - (while tail - (let* ((elt (car tail)) - (len (cond ((stringp elt) - (length elt)) - ((and (consp elt) - (stringp (car elt)) - (stringp (car (cdr elt)))) - (+ (length (car elt)) - (length (car (cdr elt))))) - (t - (signal 'wrong-type-argument - (list 'stringp elt)))))) - (if (> len max-width) - (setq max-width len)) - (setq count (1+ count) - tail (cdr tail))))) - - (setq max-width (+ 2 max-width)) ; at least two chars between cols - (let ((rows (let ((cols (min (/ win-width max-width) count))) - (if (<= cols 1) - count - (progn - ;; re-space the columns - (setq max-width (/ win-width cols)) - (if (/= (% count cols) 0) ; want ceiling... - (1+ (/ count cols)) - (/ count cols))))))) - (if (stringp cl-completion-string) - (princ (gettext cl-completion-string))) - (let ((tail completions) - (r 0) - (regexp-string - (if (eq t - completion-highlight-first-word-only) - "[ \t]" - completion-highlight-first-word-only))) - (while (< r rows) - (terpri) - (let ((indent 0) - (column 0) - (tail2 tail)) - (while tail2 - (let ((elt (car tail2))) - (if (/= indent 0) - (if bufferp - (indent-to indent 2) - (while (progn (write-char ?\ ) - (setq column (1+ column)) - (< column indent))))) - (setq indent (+ indent max-width)) - (let ((start (point)) - end) - ;; Frob some mousable extents in there too! - (if (consp elt) - (progn - (princ (car elt)) - (princ (car (cdr elt))) - (or bufferp - (setq column - (+ column - (length (car elt)) - (length (car (cdr elt))))))) - (progn - (princ elt) - (or bufferp - (setq column (+ column (length - elt)))))) - (add-list-mode-item - start - (progn - (setq end (point)) - (or - (and completion-highlight-first-word-only - (goto-char start) - (re-search-forward regexp-string end t) - (match-beginning 0)) - end)) - nil cl-activate-callback cl-user-data) - (goto-char end))) - (setq tail2 (nthcdr rows tail2))) - (setq tail (cdr tail) - r (1+ r))))))))) - (if bufferp - (set-buffer old-buffer))) - (save-excursion - (let ((mainbuf (or cl-reference-buffer (current-buffer)))) - (set-buffer standard-output) - (completion-list-mode) - (make-local-variable 'completion-reference-buffer) - (setq completion-reference-buffer mainbuf) -;;; The value 0 is right in most cases, but not for file name completion. -;;; so this has to be turned off. -;;; (setq completion-base-size 0) - (goto-char (point-min)) - (let ((buffer-read-only nil)) - (insert (eval cl-help-string))) - ;; unnecessary FSFmacs crock - ;;(forward-line 1) - ;;(while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t) - ;; (let ((beg (match-beginning 0)) - ;; (end (point))) - ;; (if completion-fixup-function - ;; (funcall completion-fixup-function)) - ;; (put-text-property beg (point) 'mouse-face 'highlight) - ;; (put-text-property beg (point) 'list-mode-item t) - ;; (goto-char end))))) - )) - (run-hooks 'completion-setup-hook))) - -(defvar completion-display-completion-list-function 'display-completion-list - "Function to set up the list of completions in the completion buffer. -The function is called with one argument, the sorted list of completions. -Particular minibuffer interface functions (e.g. `read-file-name') may -want to change this. To do that, set a local value for this variable -in the minibuffer; that ensures that other minibuffer invocations will -not be affected.") - -(defun minibuffer-completion-help () - "Display a list of possible completions of the current minibuffer contents. -The list of completions is determined by calling `all-completions', -passing it the current minibuffer contents, the value of -`minibuffer-completion-table', and the value of -`minibuffer-completion-predicate'. The list is displayed by calling -the value of `completion-display-completion-list-function' on the sorted -list of completions, with the standard output set to the completion -buffer." - (interactive) - (message "Making completion list...") - (let ((completions (all-completions (buffer-string) - minibuffer-completion-table - minibuffer-completion-predicate))) - (message nil) - (if (null completions) - (progn - (ding nil 'no-completion) - (temp-minibuffer-message " [No completions]")) - (with-output-to-temp-buffer "*Completions*" - (funcall completion-display-completion-list-function - (sort completions #'string-lessp)))))) - -(define-derived-mode completion-list-mode list-mode - "Completion List" - "Major mode for buffers showing lists of possible completions. -Type \\\\[choose-completion] in the completion list\ - to select the completion near point. -Use \\\\[mouse-choose-completion] to select one\ - with the mouse." - (make-local-variable 'completion-base-size) - (setq completion-base-size nil)) - -(let ((map completion-list-mode-map)) - (define-key map "\e\e\e" 'delete-completion-window) - (define-key map "\C-g" 'minibuffer-keyboard-quit) - (define-key map "q" 'abort-recursive-edit) - (define-key map " " (lambda () (interactive) - (select-window (minibuffer-window)))) - (define-key map "\t" (lambda () (interactive) - (select-window (minibuffer-window))))) - -(defvar completion-reference-buffer nil - "Record the buffer that was current when the completion list was requested. -This is a local variable in the completion list buffer. -Initial value is nil to avoid some compiler warnings.") - -(defvar completion-base-size nil - "Number of chars at beginning of minibuffer not involved in completion. -This is a local variable in the completion list buffer -but it talks about the buffer in `completion-reference-buffer'. -If this is nil, it means to compare text to determine which part -of the tail end of the buffer's text is involved in completion.") - -(defun delete-completion-window () - "Delete the completion list window. -Go to the window from which completion was requested." - (interactive) - (let ((buf completion-reference-buffer)) - (delete-window (selected-window)) - (if (get-buffer-window buf) - (select-window (get-buffer-window buf))))) - -(defun completion-do-in-minibuffer () - (interactive "_") - (save-excursion - (set-buffer (window-buffer (minibuffer-window))) - (call-interactively (key-binding (this-command-keys))))) - -(defun default-choose-completion (event extent buffer) - "Click on an alternative in the `*Completions*' buffer to choose it." - (and (button-event-p event) - ;; Give temporary modes such as isearch a chance to turn off. - (run-hooks 'mouse-leave-buffer-hook)) - (or buffer (setq buffer (symbol-value-in-buffer - 'completion-reference-buffer - (or (and (button-event-p event) - (event-buffer event)) - (current-buffer))))) - (save-selected-window - (and (button-event-p event) - (select-window (event-window event))) - (if (and (one-window-p t 'selected-frame) - (window-dedicated-p (selected-window))) - ;; This is a special buffer's frame - (iconify-frame (selected-frame)) - (or (window-dedicated-p (selected-window)) - (bury-buffer)))) - (choose-completion-string (extent-string extent) - buffer - completion-base-size)) - -;; Delete the longest partial match for STRING -;; that can be found before POINT. -(defun choose-completion-delete-max-match (string) - (let ((len (min (length string) - (- (point) (point-min))))) - (goto-char (- (point) (length string))) - (if completion-ignore-case - (setq string (downcase string))) - (while (and (> len 0) - (let ((tail (buffer-substring (point) - (+ (point) len)))) - (if completion-ignore-case - (setq tail (downcase tail))) - (not (string= tail (substring string 0 len))))) - (setq len (1- len)) - (forward-char 1)) - (delete-char len))) - -;; Switch to BUFFER and insert the completion choice CHOICE. -;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text -;; to keep. If it is nil, use choose-completion-delete-max-match instead. -(defun choose-completion-string (choice &optional buffer base-size) - (let ((buffer (or buffer completion-reference-buffer))) - ;; If BUFFER is a minibuffer, barf unless it's the currently - ;; active minibuffer. - (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer)) - (or (not (active-minibuffer-window)) - (not (equal buffer - (window-buffer (active-minibuffer-window)))))) - (error "Minibuffer is not active for completion") - ;; Insert the completion into the buffer where completion was requested. - (set-buffer buffer) - (if base-size - (delete-region (+ base-size (point-min)) (point)) - (choose-completion-delete-max-match choice)) - (insert choice) - (remove-text-properties (- (point) (length choice)) (point) - '(highlight nil)) - ;; Update point in the window that BUFFER is showing in. - (let ((window (get-buffer-window buffer t))) - (set-window-point window (point))) - ;; If completing for the minibuffer, exit it with this choice. - (and (equal buffer (window-buffer (minibuffer-window))) - minibuffer-completion-table - (exit-minibuffer))))) - -(define-key minibuffer-local-completion-map [prior] - 'switch-to-completions) -(define-key minibuffer-local-must-match-map [prior] - 'switch-to-completions) -(define-key minibuffer-local-completion-map "\M-v" - 'advertised-switch-to-completions) -(define-key minibuffer-local-must-match-map "\M-v" - 'advertised-switch-to-completions) - -(defalias 'advertised-switch-to-completions 'switch-to-completions) -(defun switch-to-completions () - "Select the completion list window." - (interactive) - ;; Make sure we have a completions window. - (or (get-buffer-window "*Completions*") - (minibuffer-completion-help)) - (if (not (get-buffer-window "*Completions*")) - nil - (select-window (get-buffer-window "*Completions*")) - (goto-char (next-single-property-change (point-min) 'list-mode-item nil - (point-max))))) - -;;; list-mode.el ends here diff --git a/lisp/loaddefs.el b/lisp/loaddefs.el deleted file mode 100644 index 44ab60b..0000000 --- a/lisp/loaddefs.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; loaddefs.el --- define standard autoloads of other files - -;; Copyright (C) 1985-7, 1992-5, 1997 Free Software Foundation, Inc. - -;; 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 synched with FSF. - -;;; Commentary: - -;; The following commentary is completely out of date. I would like to -;; delete it, but it serves as a useful reminder as to how things used to -;; work. - -;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -;; Special formatting conventions are used in this file! - -;; a backslash-newline is used at the beginning of a documentation string -;; when that string should be stored in the file lib-src/DOCnnn, not in core. - -;; Such strings read into Lisp as numbers (during the pure-loading phase). - -;; But you must obey certain rules to make sure the string is understood -;; and goes into lib-src/DOCnnn properly. Otherwise, the string will not go -;; anywhere! - -;; The doc string must appear in the standard place in a call to -;; defun, autoload, defvar or defconst. No Lisp macros are recognized. -;; The open-paren starting the definition must appear in column 0. - -;; In defvar and defconst, there is an additional rule: -;; The double-quote that starts the string must be on the same -;; line as the defvar or defconst. -;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -;; ********************************************************************** -;; You should never need to write autoloads by hand and put them here. - -;; It is no longer necessary. Instead use autoload.el to maintain them -;; for you. Just insert ";;;###autoload" before defuns or defmacros you -;; want to be autoloaded, or other forms you want copied into loaddefs.el -;; (defvars, key definitions, etc.). For example, -;; ;;;###autoload -;; (defun foobar () ....) -;; ;;;###autoload (define-key global-map "f" 'foobar) -;; ;;;###autoload -;; (defvar foobar-var nil "\ -;; This is foobar-var's doc-string.") - -;; Then do M-x update-file-autoloads on the file to update loaddefs.el. - -;; You can also use M-x update-directory-autoloads to update the autoloads -;; in loaddefs.el for all .el files in the lisp/ directory, or M-x -;; update-autoloads-here to update the autoloads for each file that -;; already has an autoload section in this file. -;; ********************************************************************** - - -;;; Code: - -;; These variables are used by autoloadable packages. -;; They are defined here so that they do not get overridden -;; by the loading of those packages. - - -;; Names in directory that end in one of these -;; are ignored in completion, -;; making it more likely you will get a unique match. -(setq completion-ignored-extensions - (mapcar 'purecopy - '(".o" ".elc" "~" ".bin" ".lbin" ".fasl" - ".dvi" ".toc" ".log" ".aux" ".a" ".ln" - ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot" ".fmt" - ".diff" ".oi" ".class"))) - - -;; This needs to be redone better. -slb -;(setq debug-ignored-errors -; '(beginning-of-line -; beginning-of-buffer -; end-of-line -; end-of-buffer -; end-of-file buffer-read-only -; "\\`Previous command was not a yank\\'" -; "\\`Minibuffer is not active for completion\\'" -; "\\`No \\(following\\|preceding\\) item in .*-history\\'" -; "\\`No recursive edit is in progress\\'" -; "\\`Changes to be undone are outside visible portion of buffer\\'" -; "\\`No further undo information\\'" -; "\\`No undo information in this buffer\\'" -; "\\`Buffer modified since last undo/redo, cannot redo" -; "\\`Save not confirmed\\'" -; "\\`Canceled\\'" -; "\\`\\(Revert\\|Steal\\|Recover-file\\) cancelled\\.\\'" - -; ;; comint -; "\\`Not at command line\\'" -; "\\`Empty input ring\\'" -; "\\`No history\\'" -; "\\`Not found\\'" ;; To common? -; "\\`Current buffer has no process\\'" - -; ;; dabbrev -; "\\`No \\(further \\)?dynamic expansion for .* found\\.?\\'" - -; ;; Completion -; "\\`To complete, the point must be after a symbol at least [0-9]* character long\\.\\'" -; "\\`The string \".*\" is too short to be saved as a completion\\.\\'" - -; ;; Compile -; "\\`No more errors\\( yet\\|\\)\\'" - -; ;; Gnus -; ;"\\`NNTP: Connection closed\\.\\'" - -; ;; info -; "\\`Node has no Previous\\'" -; "\\`No \".*\" in index\\'" - -; ;; imenu -; ;"\\`No items suitable for an index found in this buffer\\.\\'" -; ;"\\`The mode \".*\" does not take full advantage of imenu\\.el yet\\.\\'" - -; ;; ispell -; "\\`No word found to check!\\'" - -; ;; man -; "\\`.* not found\\'" -; "\\`No more history\\.\\'" - -; ;; etags -; "\\`File .* is not a valid tag table\\'" -; "\\`File .* is not a valid tags file\\'" -; "\\`All files processed\\.\\'" -; "No TAGS file name supplied\\'" -; "\\`Nothing to complete\\'" - -; ;; BBDB -; "\\`no previous record\\'" -; "\\`no next record\\'")) - -(make-variable-buffer-local 'indent-tabs-mode) - - -;;; Load in generated autoloads (made by autoload.el). - -;; (let ((dir load-path) -;; purify-flag) -;; (while dir -;; (condition-case nil -;; (load (concat (car dir) "auto-autoloads")) -;; (t nil)) -;; (pop dir))) - -;;; Local Variables: -;;; no-byte-compile: t -;;; no-update-autoloads: t -;;; End: -;;; loaddefs.el ends here diff --git a/lisp/loadhist.el b/lisp/loadhist.el deleted file mode 100644 index 7783fd3..0000000 --- a/lisp/loadhist.el +++ /dev/null @@ -1,146 +0,0 @@ -;;; loadhist.el --- lisp functions for working with feature groups - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; Author: Eric S. Raymond -;; Version: 1.0 -;; Keywords: internal, dumped - -;; 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 is dumped with XEmacs. - -;; These functions exploit the load-history system variable. -;; Entry points include `unload-feature', `symbol-file', and `feature-file'. - -;;; Code: - -;; load-history is a list of entries that look like this: -;; ("outline" outline-regexp ... (require . wid-edit) ... (provide . outline) ...) - -(defun symbol-file (sym) - "Return the input source from which SYM was loaded. -This is a file name, or nil if the source was a buffer with no associated file." - (interactive "SFind source file for symbol: ") ; XEmacs - (dolist (entry load-history) - (when (memq sym (cdr entry)) - (return (car entry))))) - -(defun feature-symbols (feature) - "Return the file and list of symbols associated with a given FEATURE." - (let ((pair `(provide . ,feature))) - (dolist (entry load-history) - (when (member pair (cdr entry)) - (return entry))))) - -(defun feature-file (feature) - "Return the file name from which a given FEATURE was loaded. -Actually, return the load argument, if any; this is sometimes the name of a -Lisp file without an extension. If the feature came from an eval-buffer on -a buffer with no associated file, or an eval-region, return nil." - (unless (featurep feature) - (error "%s is not a currently loaded feature" (symbol-name feature))) - (car (feature-symbols feature))) - -(defun file-symbols (file) - "Return the file and list of symbols associated with FILE. -The file name in the returned list is the string used to load the file, -and may not be the same string as FILE, but it will be equivalent." - (or (assoc file load-history) - (assoc (file-name-sans-extension file) load-history) - (assoc (concat file ".el") load-history) - (assoc (concat file ".elc") load-history))) - -(defun file-provides (file) - "Return the list of features provided by FILE." - (let ((provides nil)) - (dolist (x (cdr (file-symbols file))) - (when (eq (car-safe x) 'provide) - (push (cdr x) provides))) - provides)) - -(defun file-requires (file) - "Return the list of features required by FILE." - (let ((requires nil)) - (dolist (x (cdr (file-symbols file))) - (when (eq (car-safe x) 'require) - (push (cdr x) requires))) - requires)) - -(defun file-dependents (file) - "Return the list of loaded libraries that depend on FILE. -This can include FILE itself." - (let ((provides (file-provides file)) - (dependents nil)) - (dolist (entry load-history) - (dolist (x (cdr entry)) - (when (and (eq (car-safe x) 'require) - (memq (cdr-safe x) provides)) - (push (car entry) dependents)))) - dependents)) - -;; FSFmacs -;(defun read-feature (prompt) -; "Read a feature name \(string\) from the minibuffer, -;prompting with PROMPT and completing from `features', and -;return the feature \(symbol\)." -; (intern (completing-read prompt -; (mapcar #'(lambda (feature) -; (list (symbol-name feature))) -; features) -; nil t))) - -;; ;;;###autoload -(defun unload-feature (feature &optional force) - "Unload the library that provided FEATURE, restoring all its autoloads. -If the feature is required by any other loaded code, and optional FORCE -is nil, raise an error." - (interactive "SFeature: ") - (unless (featurep feature) - (error "%s is not a currently loaded feature" (symbol-name feature))) - (when (not force) - (let* ((file (feature-file feature)) - (dependents (delete file (copy-sequence (file-dependents file))))) - (when dependents - (error "Loaded libraries %s depend on %s" - (prin1-to-string dependents) file)))) - (let* ((flist (feature-symbols feature)) (file (car flist))) - (mapcar - #'(lambda (x) - (cond ((stringp x) nil) - ((consp x) - ;; Remove any feature names that this file provided. - (if (eq (car x) 'provide) - (setq features (delq (cdr x) features)))) - ((boundp x) (makunbound x)) - ((fboundp x) - (fmakunbound x) - (let ((aload (get x 'autoload))) - (if aload (fset x (cons 'autoload aload))))))) - (cdr flist)) - ;; Delete the load-history element for this file. - (let ((elt (assoc file load-history))) - (setq load-history (delq elt load-history))))) - -(provide 'loadhist) - -;;; loadhist.el ends here diff --git a/lisp/loadup.el b/lisp/loadup.el deleted file mode 100644 index ee86aa9..0000000 --- a/lisp/loadup.el +++ /dev/null @@ -1,215 +0,0 @@ -;; loadup.el --- load up standardly loaded Lisp files for XEmacs. - -;; Copyright (C) 1985, 1986, 1992, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Richard Mlynarik. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: Last synched with FSF 19.30, with wild divergence since. - -;;; Commentary: - -;; Please do not edit this file. Use site-init.el or site-load.el instead. - -;; This is loaded into a bare XEmacs to make a dumpable one. - -;;; Code: - -(when (fboundp 'error) - (error "loadup.el already loaded!")) - -(defvar running-xemacs t - "Non-nil when the current emacs is XEmacs.") -(defvar preloaded-file-list nil - "List of files preloaded into the XEmacs binary image.") - - -(let ((gc-cons-threshold 30000)) - -;; This is awfully damn early to be getting an error, right? -(call-with-condition-handler 'really-early-error-handler - #'(lambda () - ;; message not defined yet ... - (setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) - (setq module-load-path (split-path (getenv "EMACSBOOTSTRAPMODULEPATH"))) - - (external-debugging-output (format "\nUsing load-path %s" load-path)) - (external-debugging-output (format "\nUsing module-load-path %s" module-load-path)) - - ;; We don't want to have any undo records in the dumped XEmacs. - (buffer-disable-undo (get-buffer "*scratch*")) - - ;; Load our first bootstrap support - (load "very-early-lisp" nil t) - - ;; lread.c (or src/Makefile.in.in) has prepended - ;; "${srcdir}/../lisp/" to load-path, which is how this file - ;; has been found. At this point, enough of XEmacs has been - ;; initialized that we can start dumping "standard" lisp. - ;; Dumped lisp from external packages is added when we search - ;; the package path. - ;; #### This code is duplicated in two other places. - (let ((temp-path (expand-file-name "." (car load-path)))) - (setq load-path (nconc (mapcar - #'(lambda (i) (concat i "/")) - (directory-files temp-path t "^[^-.]" - nil 'dirs-only)) - (cons (file-name-as-directory temp-path) - load-path)))) - - (setq load-warn-when-source-newer t ; Used to be set to nil at the end - load-warn-when-source-only t) ; Set to nil at the end - - ;; garbage collect after loading every file in an attempt to - ;; minimize the size of the dumped image (if we don't do this, - ;; there will be lots of extra space in the data segment filled - ;; with garbage-collected junk) - (defun pureload (file) - (let ((full-path - (locate-file file load-path - (if load-ignore-elc-files ".el:" ".elc:.el:")))) - (if full-path - (prog1 - (load full-path) - (garbage-collect)) - (external-debugging-output (format "\nLoad file %s: not found\n" - file)) - ;; Uncomment in case of trouble - ;;(print (format "late-packages: %S" late-packages)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) - nil))) - - (load (concat default-directory "../lisp/dumped-lisp.el")) - - (let ((files preloaded-file-list) - file) - (while (setq file (car files)) - (unless (pureload file) - (external-debugging-output "Fatal error during load, aborting") - (kill-emacs 1)) - (setq files (cdr files))) - (when (not (featurep 'toolbar)) - ;; else still define a few functions. - (defun toolbar-button-p (obj) "No toolbar support." nil) - (defun toolbar-specifier-p (obj) "No toolbar support." nil)) - (fmakunbound 'pureload)) - - (packages-load-package-dumped-lisps late-package-load-path) - - )) ;; end of call-with-condition-handler - -;; Fix up the preloaded file list -(setq preloaded-file-list (mapcar #'file-name-sans-extension - preloaded-file-list)) - -(setq load-warn-when-source-newer t ; set to t at top of file - load-warn-when-source-only nil) - -(setq debugger 'debug) - -(when (member "no-site-file" command-line-args) - (setq site-start-file nil)) - -;; If you want additional libraries to be preloaded and their -;; doc strings kept in the DOC file rather than in core, -;; you may load them with a "site-load.el" file. -;; But you must also cause them to be scanned when the DOC file -;; is generated. For VMS, you must edit ../../vms/makedoc.com. -;; For other systems, you must edit ../../src/Makefile.in.in. -(when (load "site-load" t) - (garbage-collect)) - -;;FSFmacs randomness -;;(if (fboundp 'x-popup-menu) -;; (precompute-menubar-bindings)) -;;; Turn on recording of which commands get rebound, -;;; for the sake of the next call to precompute-menubar-bindings. -;(setq define-key-rebound-commands nil) - - -;; Note: all compiled Lisp files loaded above this point -;; must be among the ones parsed by make-docfile -;; to construct DOC. Any that are not processed -;; for DOC will not have doc strings in the dumped XEmacs. - -;; Don't bother with these if we're running temacs, i.e. if we're -;; just debugging don't waste time finding doc strings. - -;; purify-flag is nil if called from loadup-el.el. -(when purify-flag - (message "Finding pointers to doc strings...") - (Snarf-documentation "DOC") - (message "Finding pointers to doc strings...done") - (Verify-documentation)) - -;; Note: You can cause additional libraries to be preloaded -;; by writing a site-init.el that loads them. -;; See also "site-load" above. -(when (stringp site-start-file) - (load "site-init" t)) -(setq current-load-list nil) -(garbage-collect) - -;;; At this point, we're ready to resume undo recording for scratch. -(buffer-enable-undo "*scratch*") - -) ;; frequent garbage collection - -;; Dump into the name `xemacs' (only) -(when (member "dump" command-line-args) - (message "Dumping under the name xemacs") - ;; This is handled earlier in the build process. - ;; (condition-case () (delete-file "xemacs") (file-error nil)) - (when (fboundp 'really-free) - (really-free)) - (dump-emacs (if (featurep 'infodock) "infodock" "xemacs") "temacs") - (kill-emacs)) - -;; Avoid error if user loads some more libraries now. -(setq purify-flag nil) - -(when (member "run-temacs" command-line-args) - (message "\nBootstrapping from temacs...") - ;; Remove all args up to and including "run-temacs" - (apply #'run-emacs-from-temacs (cdr (member "run-temacs" command-line-args))) - ;; run-emacs-from-temacs doesn't actually return anyway. - (kill-emacs)) - -;; XEmacs change -;; If you are using 'recompile', then you should have used -l loadup-el.el -;; so that the .el files always get loaded (the .elc files may be out-of- -;; date or bad). -(when (member "recompile" command-line-args) - (setq command-line-args-left (cdr (member "recompile" command-line-args))) - (batch-byte-recompile-directory) - (kill-emacs)) - -;; For machines with CANNOT_DUMP defined in config.h, -;; this file must be loaded each time Emacs is run. -;; So run the startup code now. - -(when (not (fboundp 'dump-emacs)) - ;; Avoid loading loadup.el a second time! - (setq command-line-args (cdr (cdr command-line-args))) - (eval top-level)) - -;;; loadup.el ends here diff --git a/lisp/make-docfile.el b/lisp/make-docfile.el deleted file mode 100644 index c501878..0000000 --- a/lisp/make-docfile.el +++ /dev/null @@ -1,195 +0,0 @@ -;;; make-docfile.el --- Cache docstrings in external file - -;; Copyright (C) 1985, 1986, 1992-1995, 1997 Free Software Foundation, Inc. - -;; Author: Unknown -;; Maintainer: Steven L Baur -;; 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 in FSF - -;;; Commentary: - -;; This is a front-end to the make-docfile program that gathers up all the -;; lisp files that will be dumped with XEmacs. It would probably be best -;; to just move make-docfile.c completely to lisp and be done with it. - -;;; Code: - -(defvar options nil) -(defvar processed nil) -(defvar docfile nil) -(defvar docfile-buffer nil) -(defvar site-file-list nil) -(defvar docfile-out-of-date nil) - -;; Gobble up the stuff we don't wish to pass on. -(setq command-line-args (cdr (cdr (cdr (cdr command-line-args))))) - -;; First gather up the command line options. -(let (done) - (while (and (null done) command-line-args) - (let ((arg (car command-line-args))) - (cond ((or (string-equal arg "-o") ; Specify DOC file name - (string-equal arg "-a") ; Append to DOC file - (string-equal arg "-d")) ; Set working directory - (if (string-equal arg "-o") - (setq docfile (car (cdr command-line-args)))) - (setq options (cons arg options)) - (setq options (cons (car (cdr command-line-args)) options))) - ((string-equal arg "-i") ; Set site files to scan - (setq site-file-list (car (cdr command-line-args)))) - (t (setq done t))) - (if (null done) - (setq command-line-args (cdr (cdr command-line-args))))))) -(setq options (nreverse options)) - -;; (print (concat "Options: " (prin1-to-string options))) - -;; Next process the list of C files. -(while command-line-args - (let ((arg (car command-line-args))) - (if (null (member arg processed)) - (progn - (if (and (null docfile-out-of-date) - (file-newer-than-file-p arg docfile)) - (setq docfile-out-of-date t)) - (setq processed (cons arg processed))))) - (setq command-line-args (cdr command-line-args))) - -;; Then process the list of Lisp files. -(setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) - -(load "very-early-lisp" nil t) - -;; Then process the autoloads -(setq autoload-file-name "auto-autoloads.elc") -(load "find-paths.el") -(load "packages.el") -(load "setup-paths.el") -(load "dump-paths.el") - -(setq - load-path - (nconc load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH")))) - -(let (preloaded-file-list) - (load (concat default-directory "../lisp/dumped-lisp.el")) - - (let ((package-preloaded-file-list - (packages-collect-package-dumped-lisps late-package-load-path))) - - (setq preloaded-file-list - (append package-preloaded-file-list - preloaded-file-list - packages-hardcoded-lisp))) - - (while preloaded-file-list - (let ((arg0 (packages-add-suffix (car preloaded-file-list))) - arg) - (setq arg (locate-library arg0)) - (if (null arg) - (progn - (princ (format "Error: dumped file %s does not exist\n" arg0)) - ;; Uncomment in case of difficulties - ;;(print (format "late-packages: %S" late-packages)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) - ) - (if (null (member arg processed)) - (progn - (if (and (null docfile-out-of-date) - (file-newer-than-file-p arg docfile)) - (setq docfile-out-of-date t)) - (setq processed (cons arg processed))))) - (setq preloaded-file-list (cdr preloaded-file-list))))) - -;; Finally process the list of site-loaded files. -(if site-file-list - (let (site-load-packages) - (load site-file-list t t) - (while site-load-packages - (let ((arg (car site-load-packages))) - (if (null (member arg processed)) - (progn - (if (and (null docfile-out-of-date) - (file-newer-than-file-p arg docfile)) - (setq docfile-out-of-date t)) - (setq processed (cons arg processed))))) - (setq site-load-packages (cdr site-load-packages))))) - -;(let ((autoloads (packages-list-autoloads-path))) -; ;; (print (concat "Autoloads: " (prin1-to-string autoloads))) -; (while autoloads -; (let ((arg (car autoloads))) -; (if (null (member arg processed)) -; (progn -; ;; (print arg) -; (if (and (null docfile-out-of-date) -; (file-newer-than-file-p arg docfile)) -; (setq docfile-out-of-date t)) -; (setq processed (cons arg processed)))) -; (setq autoloads (cdr autoloads))))) - -;; Now fire up make-docfile and we're done - -(setq processed (nreverse processed)) - -;; (print (prin1-to-string (append options processed))) - -(if docfile-out-of-date - (progn - (princ "Spawning make-docfile ...") - ;; (print (prin1-to-string (append options processed))) - - (setq exec-path (list (concat default-directory "../lib-src"))) - - ;; (locate-file-clear-hashing nil) - (if (memq system-type '(berkeley-unix next-mach)) - ;; Suboptimal, but we have a unresolved bug somewhere in the - ;; low-level process code - (call-process-internal - "/bin/csh" - nil - t - nil - "-fc" - (mapconcat - #'identity - (append - (list (concat default-directory "../lib-src/make-docfile")) - options processed) - " ")) - ;; (print (prin1-to-string (append options processed))) - (apply 'call-process-internal - ;; (concat default-directory "../lib-src/make-docfile") - "make-docfile" - nil - t - nil - (append options processed))) - - (princ "Spawning make-docfile ...done\n") - ;; (write-region-internal (point-min) (point-max) "/tmp/DOC") - ) - (princ "DOC file is up to date\n")) - -(kill-emacs) - -;;; make-docfile.el ends here diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el deleted file mode 100644 index 6fef0e9..0000000 --- a/lisp/map-ynp.el +++ /dev/null @@ -1,290 +0,0 @@ -;;; map-ynp.el --- General-purpose boolean question-asker. - -;; Copyright (C) 1991-1995, 1997 Free Software Foundation, Inc. - -;; Author: Roland McGrath -;; Keywords: lisp, extensions, dumped - -;; 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/Mule zeta. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; map-y-or-n-p is a general-purpose question-asking function. -;; It asks a series of y/n questions (a la y-or-n-p), and decides to -;; applies an action to each element of a list based on the answer. -;; The nice thing is that you also get some other possible answers -;; to use, reminiscent of query-replace: ! to answer y to all remaining -;; questions; ESC or q to answer n to all remaining questions; . to answer -;; y once and then n for the remainder; and you can get help with C-h. - -;;; Code: - -(defun map-y-or-n-p (prompter actor list &optional help action-alist - no-cursor-in-echo-area) - "Ask a series of boolean questions. -Takes args PROMPTER ACTOR LIST, and optional args HELP and ACTION-ALIST. - -LIST is a list of objects, or a function of no arguments to return the next -object or nil. - -If PROMPTER is a string, the prompt is \(format PROMPTER OBJECT\). If not -a string, PROMPTER is a function of one arg (an object from LIST), which -returns a string to be used as the prompt for that object. If the return -value is not a string, it may be nil to ignore the object or non-nil to act -on the object without asking the user. - -ACTOR is a function of one arg (an object from LIST), -which gets called with each object that the user answers `yes' for. - -If HELP is given, it is a list (OBJECT OBJECTS ACTION), -where OBJECT is a string giving the singular noun for an elt of LIST; -OBJECTS is the plural noun for elts of LIST, and ACTION is a transitive -verb describing ACTOR. The default is \(\"object\" \"objects\" \"act on\"\). - -At the prompts, the user may enter y, Y, or SPC to act on that object; -n, N, or DEL to skip that object; ! to act on all following objects; -ESC or q to exit (skip all following objects); . (period) to act on the -current object and then exit; or \\[help-command] to get help. - -If ACTION-ALIST is given, it is an alist (KEY FUNCTION HELP) of extra keys -that will be accepted. KEY is a character; FUNCTION is a function of one -arg (an object from LIST); HELP is a string. When the user hits KEY, -FUNCTION is called. If it returns non-nil, the object is considered -\"acted upon\", and the next object from LIST is processed. If it returns -nil, the prompt is repeated for the same object. - -Final optional argument NO-CURSOR-IN-ECHO-AREA non-nil says not to set -`cursor-in-echo-area' while prompting. - -This function uses `query-replace-map' to define the standard responses, -but not all of the responses which `query-replace' understands -are meaningful here. - -Returns the number of actions taken." - (let* ((actions 0) - user-keys mouse-event map prompt char elt def - ;; Non-nil means we should use mouse menus to ask. - ;; use-menus - ;;delayed-switch-frame - (next (if (or (and list (symbolp list)) - (subrp list) - (compiled-function-p list) - (and (consp list) - (eq (car list) 'lambda))) - #'(lambda () (setq elt (funcall list))) - #'(lambda () - (if list - (progn - (setq elt (car list) - list (cdr list)) - t) - nil))))) - (if (should-use-dialog-box-p) - ;; Make a list describing a dialog box. - (let (;; (object (capitalize (or (nth 0 help) "object"))) - ;; (objects (capitalize (or (nth 1 help) "objects"))) - ;; (action (capitalize (or (nth 2 help) "act on"))) - ) - (setq map `(("Yes" . act) ("No" . skip) -; bogus crap. --ben -; ((, (if help -; (capitalize -; (or (nth 3 help) -; (concat action " All " objects))) -; "Do All")) . automatic) -; ((, (if help -; (capitalize -; (or (nth 4 help) -; (concat action " " object " And Quit"))) -; "Do it and Quit")) . act-and-exit) -; ((, (capitalize -; (or (and help (nth 5 help)) "Quit"))) -; . exit) - ("Yes All" . automatic) - ("No All" . exit) - ("Cancel" . quit) - ,@(mapcar #'(lambda (elt) - (cons (capitalize (nth 2 elt)) - (vector (nth 1 elt)))) - action-alist)) - mouse-event last-command-event)) - (setq user-keys (if action-alist - (concat (mapconcat #'(lambda (elt) - (key-description - (if (characterp (car elt)) - ;; XEmacs - (char-to-string (car elt)) - (car elt)))) - action-alist ", ") - " ") - "") - ;; Make a map that defines each user key as a vector containing - ;; its definition. - ;; XEmacs - map (let ((foomap (make-sparse-keymap))) - (mapcar #'(lambda (elt) - (define-key - foomap - (if (characterp (car elt)) - (char-to-string (car elt)) - (car elt)) - (vector (nth 1 elt)))) - action-alist) - (set-keymap-parents foomap (list query-replace-map)) - foomap))) - (unwind-protect - (progn - (if (stringp prompter) - (setq prompter `(lambda (object) - (format ,prompter object)))) - (while (funcall next) - (setq prompt (funcall prompter elt)) - (cond ((stringp prompt) - ;; Prompt the user about this object. - (setq quit-flag nil) - (if mouse-event ; XEmacs - (setq def (or (get-dialog-box-response - mouse-event - (cons prompt map)) - 'quit)) - ;; Prompt in the echo area. - (let ((cursor-in-echo-area (not no-cursor-in-echo-area))) - (display-message - 'prompt - (format "%s(y, n, !, ., q, %sor %s) " - prompt user-keys - (key-description (vector help-char)))) - (setq char (next-command-event)) - ;; Show the answer to the question. - (display-message - 'prompt - (format - "%s(y, n, !, ., q, %sor %s) %s" - prompt user-keys - (key-description (vector help-char)) - (single-key-description char)))) - (setq def (lookup-key map (vector char)))) - (cond ((eq def 'exit) - (setq next #'(lambda () nil))) - ((eq def 'act) - ;; Act on the object. - (funcall actor elt) - (setq actions (1+ actions))) - ((eq def 'skip) - ;; Skip the object. - ) - ((eq def 'act-and-exit) - ;; Act on the object and then exit. - (funcall actor elt) - (setq actions (1+ actions) - next (function (lambda () nil)))) - ((or (eq def 'quit) (eq def 'exit-prefix)) - (setq quit-flag t) - (setq next `(lambda () - (setq next ',next) - ',elt))) - ((eq def 'automatic) - ;; Act on this and all following objects. - ;; (if (funcall prompter elt) ; Emacs - (if (eval (funcall prompter elt)) - (progn - (funcall actor elt) - (setq actions (1+ actions)))) - (while (funcall next) - ;; (funcall prompter elt) ; Emacs - (if (eval (funcall prompter elt)) - (progn - (funcall actor elt) - (setq actions (1+ actions)))))) - ((eq def 'help) - (with-output-to-temp-buffer "*Help*" - (princ - (let ((object (if help (nth 0 help) "object")) - (objects (if help (nth 1 help) "objects")) - (action (if help (nth 2 help) "act on"))) - (concat - (format "Type SPC or `y' to %s the current %s; -DEL or `n' to skip the current %s; -! to %s all remaining %s; -ESC or `q' to exit;\n" - action object object action objects) - (mapconcat (function - (lambda (elt) - (format "%c to %s" - (nth 0 elt) - (nth 2 elt)))) - action-alist - ";\n") - (if action-alist ";\n") - (format "or . (period) to %s \ -the current %s and exit." - action object)))) - (save-excursion - (set-buffer standard-output) - (help-mode))) - - (setq next `(lambda () - (setq next ',next) - ',elt))) - ((vectorp def) - ;; A user-defined key. - (if (funcall (aref def 0) elt) ;Call its function. - ;; The function has eaten this object. - (setq actions (1+ actions)) - ;; Regurgitated; try again. - (setq next `(lambda () - (setq next ',next) - ',elt)))) - ;((and (consp char) ; Emacs - ; (eq (car char) 'switch-frame)) - ; ;; switch-frame event. Put it off until we're done. - ; (setq delayed-switch-frame char) - ; (setq next `(lambda () - ; (setq next ',next) - ; ',elt))) - (t - ;; Random char. - (message "Type %s for help." - (key-description (vector help-char))) - (beep) - (sit-for 1) - (setq next `(lambda () - (setq next ',next) - ',elt))))) - ((eval prompt) - (progn - (funcall actor elt) - (setq actions (1+ actions))))))) - ;;(if delayed-switch-frame - ;; (setq unread-command-events - ;; (cons delayed-switch-frame unread-command-events)))) - ;; ((eval prompt) - ;; (progn - ;; (funcall actor elt) - ;; (setq actions (1+ actions))))) - ) - ;; Clear the last prompt from the minibuffer. - (clear-message 'prompt) - ;; Return the number of actions that were taken. - actions)) - -;;; map-ynp.el ends here diff --git a/lisp/menubar-items.el b/lisp/menubar-items.el deleted file mode 100644 index 462aea8..0000000 --- a/lisp/menubar-items.el +++ /dev/null @@ -1,1498 +0,0 @@ -;;; menubar-items.el --- Menubar and popup-menu content 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 Ben Wing. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Maintainer: XEmacs Development Team -;; Keywords: frames, extensions, internal, dumped - -;; 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 Xmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file is dumped with XEmacs (when window system and menubar support is -;; compiled in). - -;;; Code: - -;;; Warning-free compile -(eval-when-compile - (defvar language-environment-list) - (defvar bookmark-alist) - (defvar language-info-alist) - (defvar current-language-environment) - (defvar tutorial-supported-languages)) - -(defconst default-menubar - (purecopy-menubar - ;; note backquote. - `( - ("File" - ["Open..." find-file] - ["Open in Other Window..." find-file-other-window] - ["Open in New Frame..." find-file-other-frame] - ["Insert File..." insert-file] - ["View File..." view-file] - "------" - ["Save" save-buffer - :active (buffer-modified-p) - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Save As..." write-file] - ["Save Some Buffers" save-some-buffers] - "-----" - ["Print Buffer" lpr-buffer - :active (fboundp 'lpr-buffer) - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Pretty-Print Buffer" ps-print-buffer-with-faces - :active (fboundp 'ps-print-buffer-with-faces) - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - "-----" - ["New Frame" make-frame] - ["Frame on Other Display..." make-frame-on-display] - ["Delete Frame" delete-frame - :active (not (eq (next-frame (selected-frame) 'nomini 'window-system) - (selected-frame)))] - "-----" - ["Split Window" split-window-vertically] - ["Un-Split (Keep This)" delete-other-windows - :active (not (one-window-p t))] - ["Un-Split (Keep Others)" delete-window - :active (not (one-window-p t))] - "-----" - ["Revert Buffer" revert-buffer - :active (or buffer-file-name revert-buffer-function) - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - ["Delete Buffer" kill-this-buffer - :active t - :suffix (if put-buffer-names-in-file-menu (buffer-name) "")] - "-----" - ["Exit XEmacs" save-buffers-kill-emacs] - ) - - ("Edit" - ["Undo" advertised-undo - :active (and (not (eq buffer-undo-list t)) - (or buffer-undo-list pending-undo-list)) - :suffix (if (or (eq last-command 'undo) - (eq last-command 'advertised-undo)) - "More" "")] - ["Redo" redo - :included (fboundp 'redo) - :active (not (or (eq buffer-undo-list t) - (eq last-buffer-undo-list nil) - (not (or (eq last-buffer-undo-list buffer-undo-list) - (and (null (car-safe buffer-undo-list)) - (eq last-buffer-undo-list - (cdr-safe buffer-undo-list))))) - (or (eq buffer-undo-list pending-undo-list) - (eq (cdr buffer-undo-list) pending-undo-list)))) - :suffix (if (eq last-command 'redo) "More" "")] - ["Cut" kill-primary-selection - :active (selection-owner-p)] - ["Copy" copy-primary-selection - :active (selection-owner-p)] - ["Paste" yank-clipboard-selection - :active (selection-exists-p 'CLIPBOARD)] - ["Clear" delete-primary-selection - :active (selection-owner-p)] - "----" - ["Search..." isearch-forward] - ["Search Backward..." isearch-backward] - ["Replace..." query-replace] - "----" - ["Search (Regexp)..." isearch-forward-regexp] - ["Search Backward (Regexp)..." isearch-backward-regexp] - ["Replace (Regexp)..." query-replace-regexp] - "----" - ["Goto Line..." goto-line] - ["What Line" what-line] - ("Bookmarks" - :filter bookmark-menu-filter) - "----" - ["Start Macro Recording" start-kbd-macro - :active (not defining-kbd-macro)] - ["End Macro Recording" end-kbd-macro - :active defining-kbd-macro] - ["Execute Last Macro" call-last-kbd-macro - :active last-kbd-macro] - "----" - ["Show Message Log" show-message-log] - ) - - ,@(if (featurep 'mule) - '(("Mule" - ("Describe language support") - ("Set language environment") - "--" - ["Toggle input method" toggle-input-method] - ["Select input method" select-input-method] - ["Describe input method" describe-input-method] - "--" - ["Describe current coding systems" - describe-current-coding-system] - ["Set coding system of buffer file" - set-buffer-file-coding-system] - ;; not implemented yet - ["Set coding system of terminal" - set-terminal-coding-system :active nil] - ;; not implemented yet - ["Set coding system of keyboard" - set-keyboard-coding-system :active nil] - ;; not implemented yet - ["Set coding system of process" - set-current-process-coding-system :active nil] - "--" - ["Show character table" view-charset-by-menu] - ;; not implemented yet - ["Show diagnosis for MULE" mule-diag :active nil] - ["Show many languages" view-hello-file]))) - - ("Apps" - ["Read Mail (VM)..." vm - :active (fboundp 'vm)] - ["Read Mail (MH)..." (mh-rmail t) - :active (fboundp 'mh-rmail)] - ["Send mail..." compose-mail - :active (fboundp 'compose-mail)] - ["Usenet News" gnus - :active (fboundp 'gnus)] - ["Browse the Web" w3 - :active (fboundp 'w3)] - "----" - ["Spell-Check Buffer" ispell-buffer - :active (fboundp 'ispell-buffer)] - ["Toggle VI emulation" toggle-viper-mode - :active (fboundp 'toggle-viper-mode)] - "----" - ("Calendar" - ["3-Month Calendar" calendar - :active (fboundp 'calendar)] - ["Diary" diary - :active (fboundp 'diary)] - ["Holidays" holidays - :active (fboundp 'holidays)] - ;; we're all pagans at heart ... - ["Phases of the Moon" phases-of-moon - :active (fboundp 'phases-of-moon)] - ["Sunrise/Sunset" sunrise-sunset - :active (fboundp 'sunrise-sunset)]) - - ("Games" - ["Mine Game" xmine - :active (fboundp 'xmine)] - ["Tetris" tetris - :active (fboundp 'tetris)] - ["Sokoban" sokoban - :active (fboundp 'sokoban)] - ["Quote from Zippy" yow - :active (fboundp 'yow)] - ["Psychoanalyst" doctor - :active (fboundp 'doctor)] - ["Psychoanalyze Zippy!" psychoanalyze-pinhead - :active (fboundp 'psychoanalyze-pinhead)] - ["Random Flames" flame - :active (fboundp 'flame)] - ["Dunnet (Adventure)" dunnet - :active (fboundp 'dunnet)] - ["Towers of Hanoi" hanoi - :active (fboundp 'hanoi)] - ["Game of Life" life - :active (fboundp 'life)] - ["Multiplication Puzzle" mpuz - :active (fboundp 'mpuz)])) - - ("Options" - ("Customize" - ("Emacs" :filter (lambda (&rest junk) - (cdr (custom-menu-create 'emacs)))) - ["Group..." customize-group] - ["Variable..." customize-variable] - ["Face..." customize-face] - ["Saved..." customize-saved] - ["Set..." customize-customized] - ["Apropos..." customize-apropos] - ["Browse..." customize-browse]) - - ("Manage Packages" - ("Add Download Site" - :filter (lambda (&rest junk) - (package-get-download-menu))) - ["Update Package Index" package-get-update-base] - ["List & Install" pui-list-packages] - ("Using Custom" - ("Select" :filter (lambda (&rest junk) - (cdr (custom-menu-create 'packages)))) - ["Update" package-get-custom]) - ["Help" (Info-goto-node "(xemacs)Packages")]) - - "---" - - ("Editing Options" - ["Overstrike" - (progn - (setq overwrite-mode (if overwrite-mode nil 'overwrite-mode-textual)) - (customize-set-variable 'overwrite-mode overwrite-mode)) - :style toggle :selected overwrite-mode] - ["Case Sensitive Search" - (customize-set-variable 'case-fold-search - (setq case-fold-search (not case-fold-search))) - :style toggle :selected (not case-fold-search)] - ["Case Matching Replace" - (customize-set-variable 'case-replace (not case-replace)) - :style toggle :selected case-replace] - ["Auto Delete Selection" - (customize-set-variable 'pending-delete-mode (not pending-delete-mode)) - :style toggle - :selected (and (boundp 'pending-delete-mode) pending-delete-mode) - :active (boundp 'pending-delete-mode)] - ["Active Regions" - (customize-set-variable 'zmacs-regions (not zmacs-regions)) - :style toggle :selected zmacs-regions] - ["Mouse Paste At Text Cursor" - (customize-set-variable 'mouse-yank-at-point (not mouse-yank-at-point)) - :style toggle :selected mouse-yank-at-point] - ("Newline at end of file..." - ["Don't require" - (customize-set-variable 'require-final-newline nil) - :style radio :selected (not require-final-newline)] - ["Require" - (customize-set-variable 'require-final-newline t) - :style radio :selected (eq require-final-newline t)] - ["Ask" - (customize-set-variable 'require-final-newline 'ask) - :style radio :selected (and require-final-newline - (not (eq require-final-newline t)))]) - ["Add Newline When Moving Past End" - (customize-set-variable 'next-line-add-newlines - (not next-line-add-newlines)) - :style toggle :selected next-line-add-newlines] - ) - ("General Options" - ["Teach Extended Commands" - (customize-set-variable 'teach-extended-commands-p - (not teach-extended-commands-p)) - :style toggle :selected teach-extended-commands-p] - ["Debug On Error" - (customize-set-variable 'debug-on-error (not debug-on-error)) - :style toggle :selected debug-on-error] - ["Debug On Quit" - (customize-set-variable 'debug-on-quit (not debug-on-quit)) - :style toggle :selected debug-on-quit] - ) - ("Printing Options" - ["Command-Line Switches for `lpr'/`lp'..." - ;; better to directly open a customization buffer, since the value - ;; must be a list of strings, which is somewhat complex to prompt for. - (customize-variable 'lpr-switches) - (boundp 'lpr-switches)] - ("Pretty-Print Paper Size" - ["Letter" - (customize-set-variable 'ps-paper-type 'letter) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'letter)) - :active (boundp 'ps-paper-type)] - ["Letter-small" - (customize-set-variable 'ps-paper-type 'letter-small) - :style radio - :selected (and (boundp 'ps-paper-type) - (eq ps-paper-type 'letter-small)) - :active (boundp 'ps-paper-type)] - ["Legal" - (customize-set-variable 'ps-paper-type 'legal) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'legal)) - :active (boundp 'ps-paper-type)] - ["Statement" - (customize-set-variable 'ps-paper-type 'statement) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'statement)) - :active (boundp 'ps-paper-type)] - ["Executive" - (customize-set-variable 'ps-paper-type 'executive) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'executive)) - :active (boundp 'ps-paper-type)] - ["Tabloid" - (customize-set-variable 'ps-paper-type 'tabloid) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'tabloid)) - :active (boundp 'ps-paper-type)] - ["Ledger" - (customize-set-variable 'ps-paper-type 'ledger) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'ledger)) - :active (boundp 'ps-paper-type)] - ["A3" - (customize-set-variable 'ps-paper-type 'a3) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a3)) - :active (boundp 'ps-paper-type)] - ["A4" - (customize-set-variable 'ps-paper-type 'a4) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4)) - :active (boundp 'ps-paper-type)] - ["A4small" - (customize-set-variable 'ps-paper-type 'a4small) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'a4small)) - :active (boundp 'ps-paper-type)] - ["B4" - (customize-set-variable 'ps-paper-type 'b4) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b4)) - :active (boundp 'ps-paper-type)] - ["B5" - (customize-set-variable 'ps-paper-type 'b5) - :style radio - :selected (and (boundp 'ps-paper-type) (eq ps-paper-type 'b5)) - :active (boundp 'ps-paper-type)] - ) - ["Color Printing" - (cond (ps-print-color-p - (customize-set-variable 'ps-print-color-p nil) - ;; I'm wondering whether all this muck is usefull. - (and (boundp 'original-face-background) - original-face-background - (set-face-background 'default original-face-background))) - (t - (customize-set-variable 'ps-print-color-p t) - (setq original-face-background - (face-background-instance 'default)) - (set-face-background 'default "white"))) - :style toggle - :selected (and (boundp 'ps-print-color-p) ps-print-color-p) - :active (boundp 'ps-print-color-p)]) - ("\"Other Window\" Location" - ["Always in Same Frame" - (customize-set-variable - 'get-frame-for-buffer-default-instance-limit nil) - :style radio - :selected (null get-frame-for-buffer-default-instance-limit)] - ["Other Frame (2 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 2) - :style radio - :selected (eq 2 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (3 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 3) - :style radio - :selected (eq 3 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (4 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 4) - :style radio - :selected (eq 4 get-frame-for-buffer-default-instance-limit)] - ["Other Frame (5 Frames Max)" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 5) - :style radio - :selected (eq 5 get-frame-for-buffer-default-instance-limit)] - ["Always Create New Frame" - (customize-set-variable 'get-frame-for-buffer-default-instance-limit 0) - :style radio - :selected (eq 0 get-frame-for-buffer-default-instance-limit)] - "-----" - ["Temp Buffers Always in Same Frame" - (customize-set-variable 'temp-buffer-show-function - 'show-temp-buffer-in-current-frame) - :style radio - :selected (eq temp-buffer-show-function - 'show-temp-buffer-in-current-frame)] - ["Temp Buffers Like Other Buffers" - (customize-set-variable 'temp-buffer-show-function nil) - :style radio - :selected (null temp-buffer-show-function)] - "-----" - ["Make current frame gnuserv target" - (customize-set-variable 'gnuserv-frame (if (eq gnuserv-frame t) nil t)) - :style toggle - :selected (and (boundp 'gnuserv-frame) (eq gnuserv-frame t)) - :active (boundp 'gnuserv-frame)] - ) - "-----" - ("Syntax Highlighting" - ["In This Buffer" - (progn ;; becomes buffer local - (font-lock-mode) - (customize-set-variable 'font-lock-mode font-lock-mode)) - :style toggle - :selected (and (boundp 'font-lock-mode) font-lock-mode) - :active (boundp 'font-lock-mode)] - ["Automatic" - (customize-set-variable 'font-lock-auto-fontify - (not font-lock-auto-fontify)) - :style toggle - :selected (and (boundp 'font-lock-auto-fontify) font-lock-auto-fontify) - :active (fboundp 'font-lock-mode)] - "-----" - ["Fonts" - (progn - (require 'font-lock) - (font-lock-use-default-fonts) - (customize-set-variable 'font-lock-use-fonts t) - (customize-set-variable 'font-lock-use-colors nil) - (font-lock-mode 1)) - :style radio - :selected (and (boundp 'font-lock-use-fonts) font-lock-use-fonts) - :active (fboundp 'font-lock-mode)] - ["Colors" - (progn - (require 'font-lock) - (font-lock-use-default-colors) - (customize-set-variable 'font-lock-use-colors t) - (customize-set-variable 'font-lock-use-fonts nil) - (font-lock-mode 1)) - :style radio - :selected (and (boundp 'font-lock-use-colors) font-lock-use-colors) - :active (boundp 'font-lock-mode)] - "-----" - ["Least" - (progn - (require 'font-lock) - (if (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))) - nil - (customize-set-variable 'font-lock-maximum-decoration nil) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximium-decoration) - (or (and (not (integerp font-lock-maximum-decoration)) - (not (eq t font-lock-maximum-decoration))) - (and (integerp font-lock-maximum-decoration) - (<= font-lock-maximum-decoration 0))))] - ["More" - (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 1) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximium-decoration) - (integerp font-lock-maximum-decoration) - (= 1 font-lock-maximum-decoration))] - ["Even More" - (progn - (require 'font-lock) - (if (and (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration)) - nil - (customize-set-variable 'font-lock-maximum-decoration 2) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (integerp font-lock-maximum-decoration) - (= 2 font-lock-maximum-decoration))] - ["Most" - (progn - (require 'font-lock) - (if (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))) - nil - (customize-set-variable 'font-lock-maximum-decoration t) - (font-lock-recompute-variables))) - :style radio - :active (fboundp 'font-lock-mode) - :selected (and (boundp 'font-lock-maximum-decoration) - (or (eq font-lock-maximum-decoration t) - (and (integerp font-lock-maximum-decoration) - (>= font-lock-maximum-decoration 3))))] - "-----" - ["Lazy" - (progn ;; becomes buffer local - (lazy-shot-mode) - (customize-set-variable 'lazy-shot-mode lazy-shot-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'lazy-shot-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)] - ["Caching" - (progn ;; becomes buffer local - (fast-lock-mode) - (customize-set-variable 'fast-lock-mode fast-lock-mode) - ;; this shouldn't be necessary so there has to - ;; be a redisplay bug lurking somewhere (or - ;; possibly another event handler bug) - (redraw-modeline)) - :active (and (boundp 'font-lock-mode) (boundp 'fast-lock-mode) - font-lock-mode) - :style toggle - :selected (and (boundp 'fast-lock-mode) fast-lock-mode)] - ) - ("Paren Highlighting" - ["None" - (customize-set-variable 'paren-mode nil) - :style radio - :selected (and (boundp 'paren-mode) (not paren-mode)) - :active (boundp 'paren-mode)] - ["Blinking Paren" - (customize-set-variable 'paren-mode 'blink-paren) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'blink-paren)) - :active (boundp 'paren-mode)] - ["Steady Paren" - (customize-set-variable 'paren-mode 'paren) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'paren)) - :active (boundp 'paren-mode)] - ["Expression" - (customize-set-variable 'paren-mode 'sexp) - :style radio - :selected (and (boundp 'paren-mode) (eq paren-mode 'sexp)) - :active (boundp 'paren-mode)] -;; ["Nested Shading" -;; (customize-set-variable 'paren-mode 'nested) -;; :style radio -;; :selected (and (boundp 'paren-mode) (eq paren-mode 'nested)) -;; :active (boundp 'paren-mode)] - ) - "-----" - ("Frame Appearance" - ["Frame-Local Font Menu" - (customize-set-variable 'font-menu-this-frame-only-p - (not font-menu-this-frame-only-p)) - :style toggle - :selected (and (boundp 'font-menu-this-frame-only-p) - font-menu-this-frame-only-p)] - ,@(if (featurep 'scrollbar) - '(["Scrollbars" - (customize-set-variable 'scrollbars-visible-p - (not scrollbars-visible-p)) - :style toggle - :selected scrollbars-visible-p])) - ;; I don't think this is of any interest. - dverna apr. 98 - ;; #### I beg to differ! Many FSFmacs converts hate the 3D - ;; modeline, and it was perfectly fine to be able to turn them - ;; off through the Options menu. I would have uncommented this - ;; source, but the code for saving options would not save the - ;; modeline 3D-ness. Grrr. --hniksic -;; ["3D Modeline" -;; (progn -;; (if (zerop (specifier-instance modeline-shadow-thickness)) -;; (set-specifier modeline-shadow-thickness 2) -;; (set-specifier modeline-shadow-thickness 0)) -;; (redraw-modeline t)) -;; :style toggle -;; :selected (let ((thickness -;; (specifier-instance modeline-shadow-thickness))) -;; (and (integerp thickness) -;; (> thickness 0)))] - ["Truncate Lines" - (progn ;; becomes buffer-local - (setq truncate-lines (not truncate-lines)) - (customize-set-variable 'truncate-lines truncate-lines)) - :style toggle - :selected truncate-lines] - ["Blinking Cursor" - (customize-set-variable 'blink-cursor-mode (not blink-cursor-mode)) - :style toggle - :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode) - :active (boundp 'blink-cursor-mode)] - "-----" - ["Block cursor" - (progn - (customize-set-variable 'bar-cursor nil) - (force-cursor-redisplay)) - :style radio - :selected (null bar-cursor)] - ["Bar cursor (1 pixel)" - (progn - (customize-set-variable 'bar-cursor t) - (force-cursor-redisplay)) - :style radio - :selected (eq bar-cursor t)] - ["Bar cursor (2 pixels)" - (progn - (customize-set-variable 'bar-cursor 2) - (force-cursor-redisplay)) - :style radio - :selected (and bar-cursor (not (eq bar-cursor t)))] - "------" - ["Line Numbers" - (progn - (customize-set-variable 'line-number-mode (not line-number-mode)) - (redraw-modeline)) - :style toggle :selected line-number-mode] - ["Column Numbers" - (progn - (customize-set-variable 'column-number-mode - (not column-number-mode)) - (redraw-modeline)) - :style toggle :selected column-number-mode] - ) - ("Menubar Appearance" - ["Buffers Menu Length..." - (customize-set-variable - 'buffers-menu-max-size - ;; would it be better to open a customization buffer ? - (let ((val - (read-number - "Enter number of buffers to display (or 0 for unlimited): "))) - (if (eq val 0) nil val)))] - ["Multi-Operation Buffers Sub-Menus" - (customize-set-variable 'complex-buffers-menu-p - (not complex-buffers-menu-p)) - :style toggle - :selected complex-buffers-menu-p] - ("Buffers Menu Sorting" - ["Most Recently Used" - (progn - (customize-set-variable 'buffers-menu-sort-function nil) - (customize-set-variable 'buffers-menu-grouping-function nil)) - :style radio - :selected (null buffers-menu-sort-function)] - ["Alphabetically" - (progn - (customize-set-variable 'buffers-menu-sort-function - 'sort-buffers-menu-alphabetically) - (customize-set-variable 'buffers-menu-grouping-function nil)) - :style radio - :selected (eq 'sort-buffers-menu-alphabetically - buffers-menu-sort-function)] - ["By Major Mode, Then Alphabetically" - (progn - (customize-set-variable - 'buffers-menu-sort-function - 'sort-buffers-menu-by-mode-then-alphabetically) - (customize-set-variable - 'buffers-menu-grouping-function - 'group-buffers-menu-by-mode-then-alphabetically)) - :style radio - :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically - buffers-menu-sort-function)]) - ["Submenus for Buffer Groups" - (customize-set-variable 'buffers-menu-submenus-for-groups-p - (not buffers-menu-submenus-for-groups-p)) - :style toggle - :selected buffers-menu-submenus-for-groups-p] - "---" - ["Ignore Scaled Fonts" - (customize-set-variable 'font-menu-ignore-scaled-fonts - (not font-menu-ignore-scaled-fonts)) - :style toggle - :selected (and (boundp 'font-menu-ignore-scaled-fonts) - font-menu-ignore-scaled-fonts)] - ) - ,@(if (featurep 'toolbar) - '(("Toolbar Appearance" - ["Visible" - (customize-set-variable 'toolbar-visible-p - (not toolbar-visible-p)) - :style toggle - :selected toolbar-visible-p] - ["Captioned" - (customize-set-variable 'toolbar-captioned-p - (not toolbar-captioned-p)) - :style toggle - :selected toolbar-captioned-p] - ("Default Location" - ["Top" - (customize-set-variable 'default-toolbar-position 'top) - :style radio - :selected (eq default-toolbar-position 'top)] - ["Bottom" - (customize-set-variable 'default-toolbar-position 'bottom) - :style radio - :selected (eq default-toolbar-position 'bottom)] - ["Left" - (customize-set-variable 'default-toolbar-position 'left) - :style radio - :selected (eq default-toolbar-position 'left)] - ["Right" - (customize-set-variable 'default-toolbar-position 'right) - :style radio - :selected (eq default-toolbar-position 'right)] - ) - ))) - ("Mouse" - ["Avoid Text..." - (customize-set-variable 'mouse-avoidance-mode - (if mouse-avoidance-mode nil 'banish)) - :style toggle - :selected (and (boundp 'mouse-avoidance-mode) mouse-avoidance-mode) - :active (and (boundp 'mouse-avoidance-mode) - (device-on-window-system-p))] - ["strokes-mode" - (customize-set-variable 'strokes-mode (not strokes-mode)) - :style toggle - :selected (and (boundp 'strokes-mode) strokes-mode) - :active (and (boundp 'strokes-mode) - (device-on-window-system-p))] - ) - ("Open URLs With" - ["Emacs-W3" - (customize-set-variable 'browse-url-browser-function 'browse-url-w3) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-w3)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-w3) - (fboundp 'w3-fetch))] - ["Netscape" - (customize-set-variable 'browse-url-browser-function - 'browse-url-netscape) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-netscape)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-netscape))] - ["Mosaic" - (customize-set-variable 'browse-url-browser-function - 'browse-url-mosaic) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-mosaic)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-mosaic))] - ["Mosaic (CCI)" - (customize-set-variable 'browse-url-browser-function 'browse-url-cci) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-cci)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-cci))] - ["IXI Mosaic" - (customize-set-variable 'browse-url-browser-function - 'browse-url-iximosaic) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-iximosaic)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-iximosaic))] - ["Lynx (xterm)" - (customize-set-variable 'browse-url-browser-function - 'browse-url-lynx-xterm) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-lynx-xterm)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-lynx-xterm))] - ["Lynx (xemacs)" - (customize-set-variable 'browse-url-browser-function - 'browse-url-lynx-emacs) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-lynx-emacs)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-lynx-emacs))] - ["Grail" - (customize-set-variable 'browse-url-browser-function - 'browse-url-grail) - :style radio - :selected (and (boundp 'browse-url-browser-function) - (eq browse-url-browser-function 'browse-url-grail)) - :active (and (boundp 'browse-url-browser-function) - (fboundp 'browse-url-grail))] - ) - "-----" - ["Edit Faces..." (customize-face nil)] - ("Font" :filter font-menu-family-constructor) - ("Size" :filter font-menu-size-constructor) -; ("Weight" :filter font-menu-weight-constructor) - "-----" - ["Save Options" customize-save-customized] - ) - - ("Buffers" - :filter buffers-menu-filter - ["Read Only" (toggle-read-only) - :style toggle :selected buffer-read-only] - ["List All Buffers" list-buffers] - "--" - ) - - ("Tools" - ["Grep..." grep - :active (fboundp 'grep)] - ["Compile..." compile - :active (fboundp 'compile)] - ["Shell" shell - :active (fboundp 'shell)] - ["Shell Command..." shell-command - :active (fboundp 'shell-command)] - ["Shell Command on Region..." shell-command-on-region - :active (and (fboundp 'shell-command-on-region) (region-exists-p))] - ["Debug (GDB)..." gdb - :active (fboundp 'gdb)] - ["Debug (DBX)..." dbx - :active (fboundp 'dbx)] - "-----" - ("Tags" - ["Find Tag..." find-tag] - ["Find Other Window..." find-tag-other-window] - ["Next Tag..." (find-tag nil)] - ["Next Other Window..." (find-tag-other-window nil)] - ["Next File" next-file] - "-----" - ["Tags Search..." tags-search] - ["Tags Replace..." tags-query-replace] - ["Continue Search/Replace" tags-loop-continue] - "-----" - ["Pop stack" pop-tag-mark] - ["Apropos..." tags-apropos] - "-----" - ["Set Tags Table File..." visit-tags-table] - )) - - nil ; the partition: menus after this are flushright - - ("Help" - ["About XEmacs..." about-xemacs] - ("Basics" - ["Installation" describe-installation - :active (boundp 'Installation-string)] - ;; Tutorials. - ,(if (featurep 'mule) - ;; Mule tutorials. - (let ((lang language-info-alist) - submenu tut) - (while lang - (and (setq tut (assq 'tutorial (car lang))) - (not (string= (caar lang) "ASCII")) - (setq - submenu - (cons - `[,(caar lang) (help-with-tutorial nil ,(cdr tut))] - submenu))) - (setq lang (cdr lang))) - (append `("Tutorials" - :filter tutorials-menu-filter - ["Default" help-with-tutorial t - ,(concat "(" current-language-environment ")")]) - submenu)) - ;; Non mule tutorials. - (let ((lang tutorial-supported-languages) - submenu) - (while lang - (setq submenu - (cons - `[,(caar lang) - (help-with-tutorial ,(format "TUTORIAL.%s" - (cadr (car lang))))] - submenu)) - (setq lang (cdr lang))) - (append '("Tutorials" - ["English" help-with-tutorial]) - submenu))) - ["News" view-emacs-news] - ["Packages" finder-by-keyword] - ["Splash" xemacs-splash-buffer]) - "-----" - ("XEmacs FAQ" - ["FAQ (local)" xemacs-local-faq] - ["FAQ via WWW" xemacs-www-faq (boundp 'browse-url-browser-function)] - ["Home Page" xemacs-www-page (boundp 'browse-url-browser-function)]) - ("Samples" - ["Sample .emacs" (find-file (locate-data-file "sample.emacs")) (locate-data-file "sample.emacs")] - ["Sample .Xdefaults" (find-file (locate-data-file "sample.Xdefaults")) (locate-data-file "sample.Xdefaults")] - ["Sample enriched" (find-file (locate-data-file "enriched.doc")) (locate-data-file "enriched.doc")]) - "-----" - ("Lookup in Info" - ["Key Binding..." Info-goto-emacs-key-command-node] - ["Command..." Info-goto-emacs-command-node] - ["Function..." Info-elisp-ref] - ["Topic..." Info-query]) - ("Manuals" - ["Info" info] - ["Unix Manual..." manual-entry]) - ("Commands & Keys" - ["Mode" describe-mode] - ["Apropos..." hyper-apropos] - ["Apropos Docs..." apropos-documentation] - "-----" - ["Key..." describe-key] - ["Bindings" describe-bindings] - ["Mouse Bindings" describe-pointer] - ["Recent Keys" view-lossage] - "-----" - ["Function..." describe-function] - ["Variable..." describe-variable] - ["Locate Command..." where-is]) - "-----" - ["Recent Messages" view-lossage] - ("Misc" - ["No Warranty" describe-no-warranty] - ["XEmacs License" describe-copying] - ["The Latest Version" describe-distribution]) - ["Send Bug Report..." report-emacs-bug])))) - - -(defun maybe-add-init-button () - "Don't call this. -Adds `Load .emacs' button to menubar when starting up with -q." - ;; by Stig@hackvan.com - (cond - (init-file-user nil) - ((file-exists-p (expand-file-name ".emacs" "~")) - (add-menu-button nil - ["Load .emacs" - (progn (delete-menu-item '("Load .emacs")) - (load-user-init-file (user-login-name))) - ] - "Help")) - (t nil))) - -(add-hook 'before-init-hook 'maybe-add-init-button) - - -;;; The File menu - -(defvar put-buffer-names-in-file-menu t) - - -;;; The Bookmarks menu - -(defun bookmark-menu-filter (&rest ignore) - (let ((definedp (and (boundp 'bookmark-alist) - bookmark-alist - t))) - `(,(if definedp - '("Jump to Bookmark" - :filter (lambda (&rest junk) - (mapcar #'(lambda (bmk) - `[,bmk (bookmark-jump ',bmk)]) - (bookmark-all-names)))) - ["Jump to Bookmark" nil nil]) - ["Set bookmark" bookmark-set - :active (fboundp 'bookmark-set)] - "---" - ["Insert contents" bookmark-menu-insert - :active (fboundp 'bookmark-menu-insert)] - ["Insert location" bookmark-menu-locate - :active (fboundp 'bookmark-menu-locate)] - "---" - ["Rename bookmark" bookmark-menu-rename - :active (fboundp 'bookmark-menu-rename)] - ,(if definedp - '("Delete Bookmark" - :filter (lambda (&rest junk) - (mapcar #'(lambda (bmk) - `[,bmk (bookmark-delete ',bmk)]) - (bookmark-all-names)))) - ["Delete Bookmark" nil nil]) - ["Edit Bookmark List" bookmark-bmenu-list ,definedp] - "---" - ["Save bookmarks" bookmark-save ,definedp] - ["Save bookmarks as..." bookmark-write ,definedp] - ["Load a bookmark file" bookmark-load - :active (fboundp 'bookmark-load)]))) - -;;; The Buffers menu - -(defgroup buffers-menu nil - "Customization of `Buffers' menu." - :group 'menu) - -(defcustom buffers-menu-max-size 25 - "*Maximum number of entries which may appear on the \"Buffers\" menu. -If this is 10, then only the ten most-recently-selected buffers will be -shown. If this is nil, then all buffers will be shown. Setting this to -a large number or nil will slow down menu responsiveness." - :type '(choice (const :tag "Show all" nil) - (integer 10)) - :group 'buffers-menu) - -(defcustom complex-buffers-menu-p nil - "*If non-nil, the buffers menu will contain several commands. -Commands will be presented as submenus of each buffer line. If this -is false, then there will be only one command: select that buffer." - :type 'boolean - :group 'buffers-menu) - -(defcustom buffers-menu-submenus-for-groups-p nil - "*If non-nil, the buffers menu will contain one submenu per group of buffers. -The grouping function is specified in `buffers-menu-grouping-function'. -If this is an integer, do not build submenus if the number of buffers -is not larger than this value." - :type '(choice (const :tag "No Subgroups" nil) - (integer :tag "Max. submenus" 10) - (sexp :format "%t\n" :tag "Allow Subgroups" :value t)) - :group 'buffers-menu) - -(defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer - "*The function to call to select a buffer from the buffers menu. -`switch-to-buffer' is a good choice, as is `pop-to-buffer'." - :type '(radio (function-item switch-to-buffer) - (function-item pop-to-buffer) - (function :tag "Other")) - :group 'buffers-menu) - -(defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers - "*If non-nil, a function specifying the buffers to omit from the buffers menu. -This is passed a buffer and should return non-nil if the buffer should be -omitted. The default value `buffers-menu-omit-invisible-buffers' omits -buffers that are normally considered \"invisible\" (those whose name -begins with a space)." - :type '(choice (const :tag "None" nil) - function) - :group 'buffers-menu) - -(defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line - "*The function to call to return a string to represent a buffer in the -buffers menu. The function is passed a buffer and should return a string. -The default value `format-buffers-menu-line' just returns the name of -the buffer. Also check out `slow-format-buffers-menu-line' which -returns a whole bunch of info about a buffer." - :type 'function - :group 'buffers-menu) - -(defcustom buffers-menu-sort-function - 'sort-buffers-menu-by-mode-then-alphabetically - "*If non-nil, a function to sort the list of buffers in the buffers menu. -It will be passed two arguments (two buffers to compare) and should return -T if the first is \"less\" than the second. One possible value is -`sort-buffers-menu-alphabetically'; another is -`sort-buffers-menu-by-mode-then-alphabetically'." - :type '(choice (const :tag "None" nil) - function) - :group 'buffers-menu) - -(defcustom buffers-menu-grouping-function - 'group-buffers-menu-by-mode-then-alphabetically - "*If non-nil, a function to group buffers in the buffers menu together. -It will be passed two arguments, successive members of the sorted buffers -list after being passed through `buffers-menu-sort-function'. It should -return non-nil if the second buffer begins a new group. The return value -should be the name of the old group, which may be used in hierarchical -buffers menus. The last invocation of the function contains nil as the -second argument, so that the name of the last group can be determined. - -The sensible values of this function are dependent on the value specified -for `buffers-menu-sort-function'." - :type '(choice (const :tag "None" nil) - function) - :group 'buffers-menu) - -(defun buffers-menu-omit-invisible-buffers (buf) - "For use as a value of `buffers-menu-omit-function'. -Omits normally invisible buffers (those whose name begins with a space)." - (not (null (string-match "\\` " (buffer-name buf))))) - -(defun sort-buffers-menu-alphabetically (buf1 buf2) - "For use as a value of `buffers-menu-sort-function'. -Sorts the buffers in alphabetical order by name, but puts buffers beginning -with a star at the end of the list." - (let* ((nam1 (buffer-name buf1)) - (nam2 (buffer-name buf2)) - (star1p (not (null (string-match "\\`*" nam1)))) - (star2p (not (null (string-match "\\`*" nam2))))) - (if (not (eq star1p star2p)) - (not star1p) - (string-lessp nam1 nam2)))) - -(defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2) - "For use as a value of `buffers-menu-sort-function'. -Sorts first by major mode and then alphabetically by name, but puts buffers -beginning with a star at the end of the list." - (let* ((nam1 (buffer-name buf1)) - (nam2 (buffer-name buf2)) - (star1p (not (null (string-match "\\`*" nam1)))) - (star2p (not (null (string-match "\\`*" nam2)))) - (mode1 (symbol-value-in-buffer 'major-mode buf1)) - (mode2 (symbol-value-in-buffer 'major-mode buf2))) - (cond ((not (eq star1p star2p)) (not star1p)) - ((and star1p star2p (string-lessp nam1 nam2))) - ((string-lessp mode1 mode2) t) - ((string-lessp mode2 mode1) nil) - (t (string-lessp nam1 nam2))))) - -;; this version is too slow on some machines. -(defun slow-format-buffers-menu-line (buffer) - "For use as a value of `buffers-menu-format-buffer-line-function'. -This returns a string containing a bunch of info about the buffer." - (format "%s%s %-19s %6s %-15s %s" - (if (buffer-modified-p buffer) "*" " ") - (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ") - (buffer-name buffer) - (buffer-size buffer) - (symbol-value-in-buffer 'mode-name buffer) - (or (buffer-file-name buffer) ""))) - -(defun format-buffers-menu-line (buffer) - "For use as a value of `buffers-menu-format-buffer-line-function'. -This just returns the buffer's name." - (buffer-name buffer)) - -(defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2) - "For use as a value of `buffers-menu-grouping-function'. -This groups buffers by major mode. It only really makes sense if -`buffers-menu-sorting-function' is -`sort-buffers-menu-by-mode-then-alphabetically'." - (cond ((string-match "\\`*" (buffer-name buf1)) - (and (null buf2) "*Misc*")) - ((or (null buf2) - (string-match "\\`*" (buffer-name buf2)) - (not (eq (symbol-value-in-buffer 'major-mode buf1) - (symbol-value-in-buffer 'major-mode buf2)))) - (symbol-value-in-buffer 'mode-name buf1)) - (t nil))) - -(defun buffer-menu-save-buffer (buffer) - (save-excursion - (set-buffer buffer) - (save-buffer))) - -(defun buffer-menu-write-file (buffer) - (save-excursion - (set-buffer buffer) - (write-file (read-file-name - (format "Write %s to file: " - (buffer-name (current-buffer))))))) - -(defsubst build-buffers-menu-internal (buffers) - (let (name line) - (mapcar - #'(lambda (buffer) - (if (eq buffer t) - "---" - (setq line (funcall buffers-menu-format-buffer-line-function - buffer)) - (if complex-buffers-menu-p - (delq nil - (list line - (vector "Switch to Buffer" - (list buffers-menu-switch-to-buffer-function - (setq name (buffer-name buffer))) - t) - (if (eq buffers-menu-switch-to-buffer-function - 'switch-to-buffer) - (vector "Switch to Buffer, Other Frame" - (list 'switch-to-buffer-other-frame - (setq name (buffer-name buffer))) - t) - nil) - (if (and (buffer-modified-p buffer) - (buffer-file-name buffer)) - (vector "Save Buffer" - (list 'buffer-menu-save-buffer name) t) - ["Save Buffer" nil nil] - ) - (vector "Save As..." - (list 'buffer-menu-write-file name) t) - (vector "Delete Buffer" (list 'kill-buffer name) - t))) - ;; ### We don't want buffer names to be translated, - ;; ### so we put the buffer name in the suffix. - ;; ### Also, avoid losing with non-ASCII buffer names. - ;; ### We still lose, however, if complex-buffers-menu-p. --mrb - (vector "" - (list buffers-menu-switch-to-buffer-function - (buffer-name buffer)) - t line)))) - buffers))) - -(defun buffers-menu-filter (menu) - "This is the menu filter for the top-level buffers \"Buffers\" menu. -It dynamically creates a list of buffers to use as the contents of the menu. -Only the most-recently-used few buffers will be listed on the menu, for -efficiency reasons. You can control how many buffers will be shown by -setting `buffers-menu-max-size'. You can control the text of the menu -items by redefining the function `format-buffers-menu-line'." - (let ((buffers (delete-if buffers-menu-omit-function (buffer-list)))) - (and (integerp buffers-menu-max-size) - (> buffers-menu-max-size 1) - (> (length buffers) buffers-menu-max-size) - ;; shorten list of buffers (not with submenus!) - (not (and buffers-menu-grouping-function - buffers-menu-submenus-for-groups-p)) - (setcdr (nthcdr buffers-menu-max-size buffers) nil)) - (if buffers-menu-sort-function - (setq buffers (sort buffers buffers-menu-sort-function))) - (if (and buffers-menu-grouping-function - buffers-menu-submenus-for-groups-p - (or (not (integerp buffers-menu-submenus-for-groups-p)) - (> (length buffers) buffers-menu-submenus-for-groups-p))) - (let (groups groupnames current-group) - (mapl - #'(lambda (sublist) - (let ((groupname (funcall buffers-menu-grouping-function - (car sublist) (cadr sublist)))) - (setq current-group (cons (car sublist) current-group)) - (if groupname - (progn - (setq groups (cons (nreverse current-group) - groups)) - (setq groupnames (cons groupname groupnames)) - (setq current-group nil))))) - buffers) - (setq buffers - (mapcar* - #'(lambda (groupname group) - (cons groupname (build-buffers-menu-internal group))) - (nreverse groupnames) - (nreverse groups)))) - (if buffers-menu-grouping-function - (progn - (setq buffers - (mapcon - #'(lambda (sublist) - (cond ((funcall buffers-menu-grouping-function - (car sublist) (cadr sublist)) - (list (car sublist) t)) - (t (list (car sublist))))) - buffers)) - ;; remove a trailing separator. - (and (>= (length buffers) 2) - (let ((lastcdr (nthcdr (- (length buffers) 2) buffers))) - (if (eq t (cadr lastcdr)) - (setcdr lastcdr nil)))))) - (setq buffers (build-buffers-menu-internal buffers))) - (append menu buffers) - )) - -(defun language-environment-menu-filter (menu) - "This is the menu filter for the \"Language Environment\" submenu." - (mapcar (lambda (env-sym) - `[ ,(capitalize (symbol-name env-sym)) - (set-language-environment ',env-sym)]) - language-environment-list)) - - -;;; The Options menu - -;; We'll keep those variables here for a while, in order to provide a -;; function for porting the old options file that a user may own to Custom. - -(defvar options-save-faces nil - "*Non-nil value means save-options will save information about faces. -A nil value means save-options will not save face information. -Set this non-nil only if you use M-x edit-faces to change face -settings. If you use M-x customize-face or the \"Browse Faces...\" -menu entry, you will see a button in the Customize Face buffer that you -can use to permanently save your face changes. - -M-x edit-faces is deprecated. Support for it and this variable will -be discontinued in a future release.") - -(defvar save-options-init-file nil - "File into which to save forms to load the options file (nil for .emacs). -Normally this is nil, which means save into your .emacs file (the value -of `user-init-file'.") - -(defvar save-options-file ".xemacs-options" - "File to save options into. -This file is loaded from your .emacs file. -If this is a relative filename, it is put into the same directory as your -.emacs file.") - - - -;;; The Help menu - -(if (featurep 'mule) - (defun tutorials-menu-filter (menu-items) - ;; If there's a tutorial for the current language environment, make it - ;; appear first as the default one. Otherwise, use the english one. - (let* ((menu menu-items) - (item (pop menu-items))) - (aset - item 3 - (concat "(" - (if (assoc - 'tutorial - (assoc current-language-environment language-info-alist)) - current-language-environment - "English") - ")")) - menu))) - - -(set-menubar default-menubar) - - -;;; Popup menus. - -(defconst default-popup-menu - '("XEmacs Commands" - ["Undo" advertised-undo - :active (and (not (eq buffer-undo-list t)) - (or buffer-undo-list pending-undo-list)) - :suffix (if (or (eq last-command 'undo) - (eq last-command 'advertised-undo)) - "More" "")] - ["Cut" kill-primary-selection - :active (selection-owner-p)] - ["Copy" copy-primary-selection - :active (selection-owner-p)] - ["Paste" yank-clipboard-selection - :active (selection-exists-p 'CLIPBOARD)] - ["Clear" delete-primary-selection - :active (selection-owner-p)] - "-----" - ["Select Block" mark-paragraph] - ["Split Window" split-window-vertically] - ["Unsplit Window" delete-other-windows] - )) - -(defvar global-popup-menu nil - "The global popup menu. This is present in all modes. -See the function `popup-menu' for a description of menu syntax.") - -(defvar mode-popup-menu nil - "The mode-specific popup menu. Automatically buffer local. -This is appended to the default items in `global-popup-menu'. -See the function `popup-menu' for a description of menu syntax.") -(make-variable-buffer-local 'mode-popup-menu) - -;; In an effort to avoid massive menu clutter, this mostly worthless menu is -;; superceded by any local popup menu... -(setq-default mode-popup-menu default-popup-menu) - -(defvar activate-popup-menu-hook nil - "Function or functions run before a mode-specific popup menu is made visible. -These functions are called with no arguments, and should interrogate and -modify the value of `global-popup-menu' or `mode-popup-menu' as desired. -Note: this hook is only run if you use `popup-mode-menu' for activating the -global and mode-specific commands; if you have your own binding for button3, -this hook won't be run.") - -(defun popup-mode-menu () - "Pop up a menu of global and mode-specific commands. -The menu is computed by combining `global-popup-menu' and `mode-popup-menu'." - (interactive "@_") - (run-hooks 'activate-popup-menu-hook) - (popup-menu - (cond ((and global-popup-menu mode-popup-menu) - ;; Merge global-popup-menu and mode-popup-menu - (check-menu-syntax mode-popup-menu) - (let* ((title (car mode-popup-menu)) - (items (cdr mode-popup-menu)) - mode-filters) - ;; Strip keywords from local menu for attaching them at the top - (while (and items - (keywordp (car items))) - ;; Push both keyword and its argument. - (push (pop items) mode-filters) - (push (pop items) mode-filters)) - (setq mode-filters (nreverse mode-filters)) - ;; If mode-filters contains a keyword already present in - ;; `global-popup-menu', you will probably lose. - (append (list (car global-popup-menu)) - mode-filters - (cdr global-popup-menu) - '("---" "---") - (if popup-menu-titles (list title)) - (if popup-menu-titles '("---" "---")) - items))) - (t - (or mode-popup-menu - global-popup-menu - (error "No menu defined in this buffer")))))) - -(defun popup-buffer-menu (event) - "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked." - (interactive "e") - (let ((window (and (event-over-text-area-p event) (event-window event))) - (bmenu nil)) - (or window - (error "Pointer must be in a normal window")) - (select-window window) - (if current-menubar - (setq bmenu (assoc "Buffers" current-menubar))) - (if (null bmenu) - (setq bmenu (assoc "Buffers" default-menubar))) - (if (null bmenu) - (error "Can't find the Buffers menu")) - (popup-menu bmenu))) - -(defun popup-menubar-menu (event) - "Pop up a copy of menu that also appears in the menubar" - ;; by Stig@hackvan.com - (interactive "e") - (let ((window (and (event-over-text-area-p event) (event-window event))) - popup-menubar) - (or window - (error "Pointer must be in a normal window")) - (select-window window) - (and current-menubar (run-hooks 'activate-menubar-hook)) - ;; ##### Instead of having to copy this just to safely get rid of - ;; any nil what we should really do is fix up the internal menubar - ;; code to just ignore nil if generating a popup menu - (setq popup-menubar (delete nil (copy-sequence (or current-menubar - default-menubar)))) - (popup-menu (cons "Menubar Menu" popup-menubar)) - )) - -(global-set-key 'button3 'popup-mode-menu) -;; shift button3 and shift button2 are reserved for Hyperbole -(global-set-key '(meta control button3) 'popup-buffer-menu) -;; The following command is way too dangerous with Custom. -;; (global-set-key '(meta shift button3) 'popup-menubar-menu) - -;; Here's a test of the cool new menu features (from Stig). - -;;(setq mode-popup-menu -;; '("Test Popup Menu" -;; :filter cdr -;; ["this item won't appear because of the menu filter" ding t] -;; "--:singleLine" -;; "singleLine" -;; "--:doubleLine" -;; "doubleLine" -;; "--:singleDashedLine" -;; "singleDashedLine" -;; "--:doubleDashedLine" -;; "doubleDashedLine" -;; "--:noLine" -;; "noLine" -;; "--:shadowEtchedIn" -;; "shadowEtchedIn" -;; "--:shadowEtchedOut" -;; "shadowEtchedOut" -;; "--:shadowDoubleEtchedIn" -;; "shadowDoubleEtchedIn" -;; "--:shadowDoubleEtchedOut" -;; "shadowDoubleEtchedOut" -;; "--:shadowEtchedInDash" -;; "shadowEtchedInDash" -;; "--:shadowEtchedOutDash" -;; "shadowEtchedOutDash" -;; "--:shadowDoubleEtchedInDash" -;; "shadowDoubleEtchedInDash" -;; "--:shadowDoubleEtchedOutDash" -;; "shadowDoubleEtchedOutDash" -;; )) - -(defun xemacs-splash-buffer () - "Redisplay XEmacs splash screen in a buffer." - (interactive) - (let ((buffer (get-buffer-create "*Splash*"))) - (set-buffer buffer) - (erase-buffer buffer) - (startup-splash-frame) - (pop-to-buffer buffer) - (delete-other-windows))) - - -;;; backwards compatibility -(provide 'x-menubar) -(provide 'menubar-items) - -;;; x-menubar.el ends here. diff --git a/lisp/menubar.el b/lisp/menubar.el deleted file mode 100644 index a2f84d5..0000000 --- a/lisp/menubar.el +++ /dev/null @@ -1,542 +0,0 @@ -;;; menubar.el --- Menubar support for XEmacs - -;; Copyright (C) 1991-4, 1997-1998 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, extensions, dumped - -;; 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. (Completely divergent from FSF menu-bar.el) - -;;; Commentary: - -;; This file is dumped with XEmacs (when menubar support is compiled in). - -;; Some stuff in FSF menu-bar.el is in x-menubar.el - -;;; Code: - -(defgroup menu nil - "Input from the menus." - :group 'environment) - -(defvar default-menubar nil) - -;; this function is considered "part of the lexicon" by many, -;; so we'll leave it here. -(defun kill-this-buffer () ; for the menubar - "Kill the current buffer." - (interactive) - (kill-buffer (current-buffer))) - -(defun set-menubar-dirty-flag () - "Tell XEmacs that the menubar has to be updated. -NOTE: XEmacs now recognizes when you set a different value for -`current-menubar'. You *only* need to call this function if you -destructively modify a part of the menubar and don't set `current-menubar'. -Note that all the functions that modify a menu call this automatically." - (setq-default current-menubar (default-value 'current-menubar))) - -;; #### shouldn't this perhaps be `copy-tree'? -(defun set-menubar (menubar) - "Set the default menubar to be MENUBAR. -See `current-menubar' for a description of the syntax of a menubar." - (check-menu-syntax menubar t) - (setq-default current-menubar (copy-sequence menubar))) - -(defun set-buffer-menubar (menubar) - "Set the buffer-local menubar to be MENUBAR. -See `current-menubar' for a description of the syntax of a menubar." - (check-menu-syntax menubar t) - (make-local-variable 'current-menubar) - (setq current-menubar (copy-sequence menubar))) - -(defun check-menu-syntax (menu &optional menubar-p) - ;; The C code does syntax checking on the value of `current-menubar', - ;; but it's better to do it early, before things have gotten messed up. - (if menubar-p - nil - (or (stringp (car menu)) - (signal 'error - (list "menu name (first element) must be a string" menu))) - ;;(or (cdr menu) (signal 'error (list "menu is empty" menu))) - (setq menu (cdr menu))) - (let (menuitem item) - (while (keywordp (setq item (car menu))) - (or (memq item '(:config :included :filter :accelerator)) - (signal 'error - (list "menu keyword must be :config, :included, :accelerator or :filter" - item))) - (if (or (not (cdr menu)) - (vectorp (nth 1 menu)) - (keywordp (nth 1 menu))) - (signal 'error (list "strange keyword value" item (nth 1 menu)))) - (setq menu (nthcdr 2 menu))) - (while menu - (setq menuitem (car menu)) - (cond - ((stringp menuitem) - (and (string-match "^\\(-+\\|=+\\):\\(.*\\)" menuitem) - (setq item (match-string 2 menuitem)) - (or (member item '(;; Motif-compatible - "singleLine" - "doubleLine" - "singleDashedLine" - "doubleDashedLine" - "noLine" - "shadowEtchedIn" - "shadowEtchedOut" - "shadowEtchedInDash" - "shadowEtchedOutDash" - ;; non-Motif (Lucid menubar widget only) - "shadowDoubleEtchedIn" - "shadowDoubleEtchedOut" - "shadowDoubleEtchedInDash" - "shadowDoubleEtchedOutDash" - )) - (signal 'error (list "bogus separator style in menu item" item))) - )) - ((null menuitem) - (or menubar-p - (signal 'error (list "nil is only permitted in the top level of menubars")))) - ((consp menuitem) - (check-menu-syntax menuitem)) - ((vectorp menuitem) - (let ((L (length menuitem)) - plistp) - (and (< L 2) - (signal 'error - (list "button descriptors must be at least 2 long" - menuitem))) - (setq plistp (or (>= L 5) - (and (> L 2) (keywordp (aref menuitem 2))))) - (or (stringp (aref menuitem 0)) - (signal 'error - (list - "first element of a button must be a string (the label)" - menuitem))) - (or plistp - (< L 4) - (null (aref menuitem 3)) - (stringp (aref menuitem 3)) - (signal 'error - (list - "fourth element of a button must be a string (the label suffix)" - menuitem))) - (if plistp - (let ((i 2) - selp - style - item) - (while (< i L) - (setq item (aref menuitem i)) - (cond ((not (memq item '(:active :suffix :keys :style - :full :included :selected - :accelerator))) - (signal 'error - (list (if (keywordp item) - "unknown menu item keyword" - "not a keyword") - item menuitem))) - ((eq item :style) - (setq style (aref menuitem (1+ i))) - (or (memq style '(nil toggle radio button text)) - (signal 'error (list "unknown style" style - menuitem)))) - ((eq item :selected) (setq selp t)) - ) - (setq i (+ i (if (eq item :full) 1 2)))) - (if (and selp (not (memq style '(toggle button radio)))) - (signal 'error - (list - ":selected only makes sense with :style toggle, radio, or button" - menuitem))) - ))) - ) - ;; (t (signal 'error (list "unrecognized menu descriptor" menuitem)))) - (t (message "unrecognized menu descriptor %s" (prin1-to-string menuitem)))) - (setq menu (cdr menu))))) - - -;;; menu manipulation functions - -(defun find-menu-item (menubar item-path-list &optional parent) - "Search MENUBAR for item given by ITEM-PATH-LIST starting from PARENT. -Returns (ITEM . PARENT), where PARENT is the immediate parent of - the item found. -If the item does not exist, the car of the returned value is nil. -If some menu in the ITEM-PATH-LIST does not exist, an error is signalled." - (check-argument-type 'listp item-path-list) - (unless parent - (setq item-path-list (mapcar 'normalize-menu-item-name item-path-list))) - (if (not (consp menubar)) - nil - (let ((rest menubar) - result) - (when (stringp (car rest)) - (setq rest (cdr rest))) - (while (keywordp (car rest)) - (setq rest (cddr rest))) - (while rest - (if (and (car rest) - (equal (car item-path-list) - (normalize-menu-item-name - (cond ((vectorp (car rest)) - (aref (car rest) 0)) - ((stringp (car rest)) - (car rest)) - (t - (caar rest)))))) - (setq result (car rest) - rest nil) - (setq rest (cdr rest)))) - (if (cdr item-path-list) - (cond ((consp result) - (find-menu-item (cdr result) (cdr item-path-list) result)) - (result - (signal 'error (list (gettext "not a submenu") result))) - (t - (signal 'error (list (gettext "no such submenu") - (car item-path-list))))) - (cons result parent))))) - -(defun add-menu-item-1 (leaf-p menu-path new-item before in-menu) - ;; This code looks like it could be cleaned up some more - ;; Do we really need 6 calls to find-menu-item? - (when before (setq before (normalize-menu-item-name before))) - (let* ((item-name - (cond ((vectorp new-item) (aref new-item 0)) - ((consp new-item) (car new-item)) - (t nil))) - (menubar (or in-menu current-menubar)) - (menu (condition-case () - (car (find-menu-item menubar menu-path)) - (error nil))) - (item-found (cond - ((null item-name) - nil) - ((not (listp menu)) - (signal 'error (list (gettext "not a submenu") - menu-path))) - (menu - (find-menu-item (cdr menu) (list item-name))) - (t - (find-menu-item menubar (list item-name))) - ))) - (unless menubar - (error "`current-menubar' is nil: can't add menus to it.")) - (unless menu - (let ((rest menu-path) - (so-far menubar)) - (while rest -;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest))))) - (setq menu - (if (eq so-far menubar) - (car (find-menu-item so-far (list (car rest)))) - (car (find-menu-item (cdr so-far) (list (car rest)))))) - (unless menu - (let ((rest2 so-far)) - (while (and (cdr rest2) (car (cdr rest2))) - (setq rest2 (cdr rest2))) - (setcdr rest2 - (nconc (list (setq menu (list (car rest)))) - (cdr rest2))))) - (setq so-far menu) - (setq rest (cdr rest))))) - (if (and item-found (car item-found)) - ;; hack the item in place. - (if menu - ;; Isn't it very bad form to use nsubstitute for side effects? - (nsubstitute new-item (car item-found) menu) - (setq current-menubar (nsubstitute new-item - (car item-found) - current-menubar))) - ;; OK, we have to add the whole thing... - ;; if BEFORE is specified, try to add it there. - (unless menu (setq menu current-menubar)) - (when before - (setq before (car (find-menu-item menu (list before))))) - (let ((rest menu) - (added-before nil)) - (while rest - (if (eq before (car (cdr rest))) - (progn - (setcdr rest (cons new-item (cdr rest))) - (setq rest nil added-before t)) - (setq rest (cdr rest)))) - (when (not added-before) - ;; adding before the first item on the menubar itself is harder - (if (and (eq menu menubar) (eq before (car menu))) - (setq menu (cons new-item menu) - current-menubar menu) - ;; otherwise, add the item to the end. - (nconc menu (list new-item)))))) - (set-menubar-dirty-flag) - new-item)) - -(defun add-menu-button (menu-path menu-leaf &optional before in-menu) - "Add a menu item to some menu, creating the menu first if necessary. -If the named item exists already, it is changed. -MENU-PATH identifies the menu under which the new menu item 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\". -MENU-LEAF is a menubar leaf node. See the documentation of `current-menubar'. -BEFORE, if provided, is the name of a menu item before which this item should - be added, if this item is not on the menu already. If the item is already - present, it will not be moved. -If IN-MENU is present use that instead of `current-menubar' as the menu to -change. -" - ;; Note easymenu.el uses the fact that menu-leaf can be a submenu. - (add-menu-item-1 t menu-path menu-leaf before in-menu)) - -;; I actually liked the old name better, but the interface has changed too -;; drastically to keep it. --Stig -(defun add-submenu (menu-path submenu &optional before in-menu) - "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." - (check-menu-syntax submenu nil) - (add-menu-item-1 nil menu-path submenu before in-menu)) - -(defun purecopy-menubar (x) - ;; this calls purecopy on the strings, and the contents of the vectors, - ;; but not on the vectors themselves, or the conses - those must be - ;; writable. - (cond ((vectorp x) - (let ((i (length x))) - (while (> i 0) - (aset x (1- i) (purecopy (aref x (1- i)))) - (setq i (1- i)))) - x) - ((consp x) - (let ((rest x)) - (while rest - (setcar rest (purecopy-menubar (car rest))) - (setq rest (cdr rest)))) - x) - (t - (purecopy x)))) - -(defun delete-menu-item (path &optional from-menu) - "Remove the named menu item from the menu hierarchy. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. The documentation of `add-submenu' describes menu-paths." - (let* ((pair (condition-case nil (find-menu-item (or from-menu - current-menubar) path) - (error nil))) - (item (car pair)) - (parent (or (cdr pair) current-menubar))) - (if (not item) - nil - ;; the menubar is the only special case, because other menus begin - ;; with their name. - (if (eq parent current-menubar) - (setq current-menubar (delq item parent)) - (delq item parent)) - (set-menubar-dirty-flag) - item))) - -(defun relabel-menu-item (path new-name) - "Change the string of the specified menu item. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\". -NEW-NAME is the string that the menu item will be printed as from now on." - (or (stringp new-name) - (setq new-name (signal 'wrong-type-argument (list 'stringp new-name)))) - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path)) - (item (car pair)) - (menu (cdr pair))) - (or item - (signal 'error (list (if menu (gettext "No such menu item") - (gettext "No such menu")) - path))) - (if (and (consp item) - (stringp (car item))) - (setcar item new-name) - (aset item 0 new-name)) - (set-menubar-dirty-flag) - item)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; these are all bad style. Why in the world would we put evaluable forms -;; into the menubar if we didn't want people to use 'em? -;; x-font-menu.el is the only known offender right now and that ought to be -;; rehashed a bit. -;; - -(defun enable-menu-item-1 (path toggle-p on-p) - (let (menu item) - (if (and (vectorp path) (> (length path) 2)) ; limited syntax checking... - (setq item path) - (let* ((menubar current-menubar) - (pair (find-menu-item menubar path))) - (setq item (car pair) - menu (cdr pair)) - (or item - (signal 'error (list (if menu - "No such menu item" - "No such menu") - path))) - (if (consp item) - (error "%S is a menu, not a menu item" path)))) - (if (or (> (length item) 4) - (and (symbolp (aref item 2)) - (= ?: (aref (symbol-name (aref item 2)) 0)))) - ;; plist-like syntax - (let ((i 2) - (keyword (if toggle-p :selected :active)) - (ok nil)) - (while (< i (length item)) - (cond ((eq (aref item i) keyword) - (aset item (1+ i) on-p) - (setq ok t))) - (setq i (+ i 2))) - (cond (ok nil) - (toggle-p - (signal 'error (list "not a toggle menu item" item))) - (t - ;; Need to copy the item to extend it, sigh... - (let ((cons (memq item menu)) - (new-item (vconcat item (list keyword on-p)))) - (if cons - (setcar cons (setq item new-item)) - (if menu - (error "couldn't find %S on its parent?" item) - (error "no %S slot to set: %S" keyword item))))))) - ;; positional syntax - (if toggle-p - (signal 'error (list "not a toggle menu item" item)) - (aset item 2 on-p))) - (set-menubar-dirty-flag) - item)) - -(defun enable-menu-item (path) - "Make the named menu item be selectable. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (enable-menu-item-1 path nil t)) - -(defun disable-menu-item (path) - "Make the named menu item be unselectable. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (enable-menu-item-1 path nil nil)) - -(defun select-toggle-menu-item (path) - "Make the named toggle- or radio-style menu item be in the `selected' state. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (enable-menu-item-1 path t t)) - -(defun deselect-toggle-menu-item (path) - "Make the named toggle- or radio-style menu item be in the `unselected' state. -PATH is a list of strings which identify the position of the menu item in -the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\" -under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the -menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"." - (enable-menu-item-1 path t nil)) - - -(defun get-popup-menu-response (menu-desc &optional event) - "Pop up the given menu and wait for a response. -This blocks until the response is received, and returns the misc-user -event that encapsulates the response. To execute it, you can do - (funcall (event-function response) (event-object response)) -If no response was received, nil is returned. - -MENU-DESC and EVENT are as in the call to `popup-menu'." - ;; partially stolen from w3 - (let ((echo-keystrokes 0) - new-event) - (popup-menu menu-desc event) - (catch 'popup-done - (while t - (setq new-event (next-command-event new-event)) - (cond ((misc-user-event-p new-event) - (throw 'popup-done new-event)) - ((not (popup-up-p)) - (setq unread-command-events (cons new-event - unread-command-events)) - (throw 'popup-done nil)) - ((button-release-event-p new-event);; don't beep twice - nil) - ((event-matches-key-specifier-p (quit-char)) - (signal 'quit nil)) - (t - (beep) - (message "please make a choice from the menu."))))))) - -(defun popup-menu-and-execute-in-window (menu-desc event) - "Pop up the given menu and execute its response in EVENT's window. -This blocks until the response is received, temporarily selects -EVENT's window, and executes the command specified in the response. -EVENT can also be a window. See `popup-menu' for the semantics of -MENU-DESC." - (let ((response - (get-popup-menu-response menu-desc - (and (eventp event) event)))) - (and (misc-user-event-p response) - (save-selected-window - (select-window (if (windowp event) event - (event-window event))) - (funcall (event-function response) - (event-object response)))))) - -;; provide default bindings for menu accelerator map -(and (boundp 'menu-accelerator-map) - (keymapp menu-accelerator-map) - (progn - (define-key menu-accelerator-map "\e" 'menu-escape) - (define-key menu-accelerator-map [left] 'menu-left) - (define-key menu-accelerator-map [right] 'menu-right) - (define-key menu-accelerator-map [up] 'menu-up) - (define-key menu-accelerator-map [down] 'menu-down) - (define-key menu-accelerator-map [return] 'menu-select) - (define-key menu-accelerator-map [kp_down] 'menu-down) - (define-key menu-accelerator-map [kp_up] 'menu-down) - (define-key menu-accelerator-map [kp_left] 'menu-left) - (define-key menu-accelerator-map [kp_right] 'menu-right) - (define-key menu-accelerator-map [kp_enter] 'menu-select) - (define-key menu-accelerator-map "\C-g" 'menu-quit))) - - -(provide 'menubar) - -;;; menubar.el ends here diff --git a/lisp/minibuf.el b/lisp/minibuf.el deleted file mode 100644 index 4a8ad96..0000000 --- a/lisp/minibuf.el +++ /dev/null @@ -1,2154 +0,0 @@ -;;; minibuf.el --- Minibuffer functions for XEmacs - -;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems -;; Copyright (C) 1995, 1996 Ben Wing - -;; Author: Richard Mlynarik -;; Created: 2-Oct-92 -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: all the minibuffer history stuff is synched with -;;; 19.30. Not sure about the rest. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Written by Richard Mlynarik 2-Oct-92 - -;; 06/11/1997 - Use char-(after|before) instead of -;; (following|preceding)-char. -slb - -;;; Code: - -(defgroup minibuffer nil - "Controling the behavior of the minibuffer." - :group 'environment) - - -(defcustom insert-default-directory t - "*Non-nil means when reading a filename start with default dir in minibuffer." - :type 'boolean - :group 'minibuffer) - -(defcustom minibuffer-history-uniquify t - "*Non-nil means when adding an item to a minibuffer history, remove -previous occurances of the same item from the history list first, -rather than just consing the new element onto the front of the list." - :type 'boolean - :group 'minibuffer) - -(defvar minibuffer-completion-table nil - "Alist or obarray used for completion in the minibuffer. -This becomes the ALIST argument to `try-completion' and `all-completions'. - -The value may alternatively be a function, which is given 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, nil if there is none, - or t if it is already a unique completion. -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.") - -(defvar minibuffer-completion-predicate nil - "Within call to `completing-read', this holds the PREDICATE argument.") - -(defvar minibuffer-completion-confirm nil - "Non-nil => demand confirmation of completion before exiting minibuffer.") - -(defvar minibuffer-confirm-incomplete nil - "If true, then in contexts where completing-read allows answers which -are not valid completions, an extra RET must be typed to confirm the -response. This is helpful for catching typos, etc.") - -(defcustom completion-auto-help t - "*Non-nil means automatically provide help for invalid completion input." - :type 'boolean - :group 'minibuffer) - -(defcustom enable-recursive-minibuffers nil - "*Non-nil means to allow minibuffer commands while in the minibuffer. -More precisely, this variable makes a difference when the minibuffer window -is the selected window. If you are in some other window, minibuffer commands -are allowed even if a minibuffer is active." - :type 'boolean - :group 'minibuffer) - -(defcustom minibuffer-max-depth 1 - ;; See comment in #'minibuffer-max-depth-exceeded - "*Global maximum number of minibuffers allowed; -compare to enable-recursive-minibuffers, which is only consulted when the -minibuffer is reinvoked while it is the selected window." - :type '(choice integer - (const :tag "Indefinite" nil)) - :group 'minibuffer) - -;; Moved to C. The minibuffer prompt must be setup before this is run -;; and that can only be done from the C side. -;(defvar minibuffer-setup-hook nil -; "Normal hook run just after entry to minibuffer.") - -(defvar minibuffer-exit-hook nil - "Normal hook run just after exit from minibuffer.") - -(defvar minibuffer-help-form nil - "Value that `help-form' takes on inside the minibuffer.") - -(defvar minibuffer-default nil - "Default value for minibuffer input.") - -(defvar minibuffer-local-map - (let ((map (make-sparse-keymap 'minibuffer-local-map))) - map) - "Default keymap to use when reading from the minibuffer.") - -(defvar minibuffer-local-completion-map - (let ((map (make-sparse-keymap 'minibuffer-local-completion-map))) - (set-keymap-parents map (list minibuffer-local-map)) - map) - "Local keymap for minibuffer input with completion.") - -(defvar minibuffer-local-must-match-map - (let ((map (make-sparse-keymap 'minibuffer-must-match-map))) - (set-keymap-parents map (list minibuffer-local-completion-map)) - map) - "Local keymap for minibuffer input with completion, for exact match.") - -;; (define-key minibuffer-local-map "\C-g" 'abort-recursive-edit) -(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) ;; moved here from pending-del.el -(define-key minibuffer-local-map "\r" 'exit-minibuffer) -(define-key minibuffer-local-map "\n" 'exit-minibuffer) - -;; Historical crock. Unused by anything but user code, if even that -;(defvar minibuffer-local-ns-map -; (let ((map (make-sparse-keymap 'minibuffer-local-ns-map))) -; (set-keymap-parents map (list minibuffer-local-map)) -; map) -; "Local keymap for the minibuffer when spaces are not allowed.") -;(define-key minibuffer-local-ns-map [space] 'exit-minibuffer) -;(define-key minibuffer-local-ns-map [tab] 'exit-minibuffer) -;(define-key minibuffer-local-ns-map [?\?] 'self-insert-and-exit) - -(define-key minibuffer-local-completion-map "\t" 'minibuffer-complete) -(define-key minibuffer-local-completion-map " " 'minibuffer-complete-word) -(define-key minibuffer-local-completion-map "?" 'minibuffer-completion-help) -(define-key minibuffer-local-must-match-map "\r" 'minibuffer-complete-and-exit) -(define-key minibuffer-local-must-match-map "\n" 'minibuffer-complete-and-exit) - -(define-key minibuffer-local-map "\M-n" 'next-history-element) -(define-key minibuffer-local-map "\M-p" 'previous-history-element) -(define-key minibuffer-local-map '[next] "\M-n") -(define-key minibuffer-local-map '[prior] "\M-p") -(define-key minibuffer-local-map "\M-r" 'previous-matching-history-element) -(define-key minibuffer-local-map "\M-s" 'next-matching-history-element) -(define-key minibuffer-local-must-match-map [next] - 'next-complete-history-element) -(define-key minibuffer-local-must-match-map [prior] - 'previous-complete-history-element) - -;; This is an experiment--make up and down arrows do history. -(define-key minibuffer-local-map [up] 'previous-history-element) -(define-key minibuffer-local-map [down] 'next-history-element) -(define-key minibuffer-local-completion-map [up] 'previous-history-element) -(define-key minibuffer-local-completion-map [down] 'next-history-element) -(define-key minibuffer-local-must-match-map [up] 'previous-history-element) -(define-key minibuffer-local-must-match-map [down] 'next-history-element) - -(defvar read-expression-map (let ((map (make-sparse-keymap - 'read-expression-map))) - (set-keymap-parents map - (list minibuffer-local-map)) - (define-key map "\M-\t" 'lisp-complete-symbol) - map) - "Minibuffer keymap used for reading Lisp expressions.") - -(defvar read-shell-command-map - (let ((map (make-sparse-keymap 'read-shell-command-map))) - (set-keymap-parents map (list minibuffer-local-map)) - (define-key map "\t" 'comint-dynamic-complete) - (define-key map "\M-\t" 'comint-dynamic-complete) - (define-key map "\M-?" 'comint-dynamic-list-completions) - map) - "Minibuffer keymap used by shell-command and related commands.") - -(defcustom use-dialog-box t - "*Variable controlling usage of the dialog box. -If nil, the dialog box will never be used, even in response to mouse events." - :type 'boolean - :group 'minibuffer) - -(defcustom minibuffer-electric-file-name-behavior t - "*If non-nil, slash and tilde in certain places cause immediate deletion. -These are the same places where this behavior would occur later on anyway, -in `substitute-in-file-name'." - :type 'boolean - :group 'minibuffer) - -;; originally by Stig@hackvan.com -(defun minibuffer-electric-separator () - (interactive) - (let ((c last-command-char)) - (and minibuffer-electric-file-name-behavior - (eq c directory-sep-char) - (eq c (char-before (point))) - (not (save-excursion - (goto-char (point-min)) - (and (looking-at "/.+:~?[^/]*/.+") - (re-search-forward "^/.+:~?[^/]*" nil t) - (progn - (delete-region (point) (point-max)) - t)))) - (not (save-excursion - (goto-char (point-min)) - (and (looking-at ".+://[^/]*/.+") - (re-search-forward "^.+:/" nil t) - (progn - (delete-region (point) (point-max)) - t)))) - ;; permit `//hostname/path/to/file' - (not (eq (point) (1+ (point-min)))) - ;; permit `http://url/goes/here' - (or (not (eq ?: (char-after (- (point) 2)))) - (eq ?/ (char-after (point-min)))) - (delete-region (point-min) (point))) - (insert c))) - -(defun minibuffer-electric-tilde () - (interactive) - (and minibuffer-electric-file-name-behavior - (eq directory-sep-char (char-before (point))) - ;; permit URL's with //, for e.g. http://hostname/~user - (not (save-excursion (search-backward "//" nil t))) - (delete-region (point-min) (point))) - (insert ?~)) - - -(defvar read-file-name-map - (let ((map (make-sparse-keymap 'read-file-name-map))) - (set-keymap-parents map (list minibuffer-local-completion-map)) - (define-key map (vector directory-sep-char) 'minibuffer-electric-separator) - (define-key map "~" 'minibuffer-electric-tilde) - map - )) - -(defvar read-file-name-must-match-map - (let ((map (make-sparse-keymap 'read-file-name-map))) - (set-keymap-parents map (list minibuffer-local-must-match-map)) - (define-key map (vector directory-sep-char) 'minibuffer-electric-separator) - (define-key map "~" 'minibuffer-electric-tilde) - map - )) - -(defun minibuffer-keyboard-quit () - "Abort recursive edit. -If `zmacs-regions' is true, and the zmacs region is active in this buffer, -then this key deactivates the region without beeping." - (interactive) - (if (and (region-active-p) - (eq (current-buffer) (zmacs-region-buffer))) - ;; pseudo-zmacs compatibility: don't beep if this ^G is simply - ;; deactivating the region. If it is inactive, beep. - nil - (abort-recursive-edit))) - -;;;; Guts of minibuffer invocation - -;;#### The only things remaining in C are -;; "Vminibuf_prompt" and the display junk -;; "minibuf_prompt_width" and "minibuf_prompt_pix_width" -;; Also "active_frame", though I suspect I could already -;; hack that in Lisp if I could make any sense of the -;; complete mess of frame/frame code in XEmacs. -;; Vminibuf_prompt could easily be made Lisp-bindable. -;; I suspect that minibuf_prompt*_width are actually recomputed -;; by redisplay as needed -- or could be arranged to be so -- -;; and that there could be need for read-minibuffer-internal to -;; save and restore them. -;;#### The only other thing which read-from-minibuffer-internal does -;; which we can't presently do in Lisp is move the frame cursor -;; to the start of the minibuffer line as it returns. This is -;; a rather nice touch and should be preserved -- probably by -;; providing some Lisp-level mechanism (extension to cursor-in-echo-area ?) -;; to effect it. - - -;; Like reset_buffer in FSF's buffer.c -;; (Except that kill-all-local-variables doesn't nuke 'permanent-local -;; variables -- we preserve them, reset_buffer doesn't.) -(defun reset-buffer (buffer) - (with-current-buffer buffer - ;(if (fboundp 'unlock-buffer) (unlock-buffer)) - (kill-all-local-variables) - (setq buffer-read-only nil) - ;; don't let read only text yanked into the minibuffer - ;; permanently wedge it. - (make-local-variable 'inhibit-read-only) - (setq inhibit-read-only t) - (erase-buffer) - ;(setq default-directory nil) - (setq buffer-file-name nil) - (setq buffer-file-truename nil) - (set-buffer-modified-p nil) - (setq buffer-backed-up nil) - (setq buffer-auto-save-file-name nil) - (set-buffer-dedicated-frame buffer nil) - buffer)) - -(defvar minibuffer-history-variable 'minibuffer-history - "History list symbol to add minibuffer values to. -Each minibuffer output is added with - (set minibuffer-history-variable - (cons STRING (symbol-value minibuffer-history-variable)))") -(defvar minibuffer-history-position) - -;; Added by hniksic: -(defvar initial-minibuffer-history-position) -(defvar current-minibuffer-contents) -(defvar current-minibuffer-point) - -(defcustom minibuffer-history-minimum-string-length nil - "*If this variable is non-nil, a string will not be added to the -minibuffer history if its length is less than that value." - :type '(choice (const :tag "Any" nil) - integer) - :group 'minibuffer) - -(define-error 'input-error "Keyboard input error") - -(put 'input-error 'display-error - #'(lambda (error-object stream) - (princ (cadr error-object) stream))) - -(defun read-from-minibuffer (prompt &optional initial-contents - keymap - readp - history - abbrev-table) - "Read a string from the minibuffer, prompting with string PROMPT. -If optional second arg INITIAL-CONTENTS is non-nil, it is a string - to be inserted into the minibuffer before reading input. - If INITIAL-CONTENTS is (STRING . POSITION), the initial input - is STRING, but point is placed POSITION characters into the string. -Third arg KEYMAP is a keymap to use while reading; - if omitted or nil, the default is `minibuffer-local-map'. -If fourth arg READ is non-nil, then interpret the result as a lisp object - and return that object: - in other words, do `(car (read-from-string INPUT-STRING))' -Fifth arg HISTORY, if non-nil, specifies a history list - and optionally the initial position in the list. - It can be a symbol, which is the history list variable to use, - or it can be a cons cell (HISTVAR . HISTPOS). - In that case, HISTVAR is the history list variable to use, - and HISTPOS is the initial position (the position in the list - which INITIAL-CONTENTS corresponds to). - If HISTORY is `t', no history will be recorded. - Positions are counted starting from 1 at the beginning of the list. -Sixth arg ABBREV-TABLE, if non-nil, becomes the value of `local-abbrev-table' - in the minibuffer. - -See also the variable completion-highlight-first-word-only for control over - completion display." - (if (and (not enable-recursive-minibuffers) - (> (minibuffer-depth) 0) - (eq (selected-window) (minibuffer-window))) - (error "Command attempted to use minibuffer while in minibuffer")) - - (if (and minibuffer-max-depth - (> minibuffer-max-depth 0) - (>= (minibuffer-depth) minibuffer-max-depth)) - (minibuffer-max-depth-exceeded)) - - ;; catch this error before the poor user has typed something... - (if history - (if (symbolp history) - (or (boundp history) - (error "History list %S is unbound" history)) - (or (boundp (car history)) - (error "History list %S is unbound" (car history))))) - - (if (noninteractive) - (progn - ;; XEmacs in -batch mode calls minibuffer: print the prompt. - (message "%s" (gettext prompt)) - ;;#### force-output - - ;;#### Should this even be falling though to the code below? - ;;#### How does this stuff work now, anyway? - )) - (let* ((dir default-directory) - (owindow (selected-window)) - (oframe (selected-frame)) - (window (minibuffer-window)) - (buffer (if (eq (minibuffer-depth) 0) - (window-buffer window) - (get-buffer-create (format " *Minibuf-%d" - (minibuffer-depth))))) - (frame (window-frame window)) - (mconfig (if (eq frame (selected-frame)) - nil (current-window-configuration frame))) - (oconfig (current-window-configuration)) - ;; dynamic scope sucks sucks sucks sucks sucks sucks. - ;; `M-x doctor' makes history a local variable, and thus - ;; our binding above is buffer-local and doesn't apply - ;; once we switch buffers!!!! We demand better scope! - (_history_ history)) - (unwind-protect - (progn - (set-buffer (reset-buffer buffer)) - (setq default-directory dir) - (make-local-variable 'print-escape-newlines) - (setq print-escape-newlines t) - (make-local-variable 'current-minibuffer-contents) - (make-local-variable 'current-minibuffer-point) - (make-local-variable 'initial-minibuffer-history-position) - (setq current-minibuffer-contents "" - current-minibuffer-point 1) - (if (not minibuffer-smart-completion-tracking-behavior) - nil - (make-local-variable 'mode-motion-hook) - (or mode-motion-hook - ;;####disgusting - (setq mode-motion-hook 'minibuffer-smart-mouse-tracker)) - (make-local-variable 'mouse-track-click-hook) - (add-hook 'mouse-track-click-hook - 'minibuffer-smart-maybe-select-highlighted-completion)) - (set-window-buffer window buffer) - (select-window window) - (set-window-hscroll window 0) - (buffer-enable-undo buffer) - (message nil) - (if initial-contents - (if (consp initial-contents) - (progn - (insert (car initial-contents)) - (goto-char (1+ (cdr initial-contents))) - (setq current-minibuffer-contents (car initial-contents) - current-minibuffer-point (cdr initial-contents))) - (insert initial-contents) - (setq current-minibuffer-contents initial-contents - current-minibuffer-point (point)))) - (use-local-map (help-keymap-with-help-key - (or keymap minibuffer-local-map) - minibuffer-help-form)) - (let ((mouse-grabbed-buffer - (and minibuffer-smart-completion-tracking-behavior - (current-buffer))) - (current-prefix-arg current-prefix-arg) -;; (help-form minibuffer-help-form) - (minibuffer-history-variable (cond ((not _history_) - 'minibuffer-history) - ((consp _history_) - (car _history_)) - (t - _history_))) - (minibuffer-history-position (cond ((consp _history_) - (cdr _history_)) - (t - 0))) - (minibuffer-scroll-window owindow)) - (setq initial-minibuffer-history-position - minibuffer-history-position) - (if abbrev-table - (setq local-abbrev-table abbrev-table - abbrev-mode t)) - ;; This is now run from read-minibuffer-internal - ;(if minibuffer-setup-hook - ; (run-hooks 'minibuffer-setup-hook)) - ;(message nil) - (if (eq 't - (catch 'exit - (if (> (recursion-depth) (minibuffer-depth)) - (let ((standard-output t) - (standard-input t)) - (read-minibuffer-internal prompt)) - (read-minibuffer-internal prompt)))) - ;; Translate an "abort" (throw 'exit 't) - ;; into a real quit - (signal 'quit '()) - ;; return value - (let* ((val (progn (set-buffer buffer) - (if minibuffer-exit-hook - (run-hooks 'minibuffer-exit-hook)) - (buffer-string))) - (histval val) - (err nil)) - (if readp - (condition-case e - (let ((v (read-from-string val))) - (if (< (cdr v) (length val)) - (save-match-data - (or (string-match "[ \t\n]*\\'" val (cdr v)) - (error "Trailing garbage following expression")))) - (setq v (car v)) - ;; total total kludge - (if (stringp v) (setq v (list 'quote v))) - (setq val v)) - (end-of-file - (setq err - '(input-error "End of input before end of expression"))) - (error (setq err e)))) - ;; Add the value to the appropriate history list unless - ;; it's already the most recent element, or it's only - ;; two characters long. - (if (and (symbolp minibuffer-history-variable) - (boundp minibuffer-history-variable)) - (let ((list (symbol-value minibuffer-history-variable))) - (or (eq list t) - (null val) - (and list (equal histval (car list))) - (and (stringp val) - minibuffer-history-minimum-string-length - (< (length val) - minibuffer-history-minimum-string-length)) - (set minibuffer-history-variable - (if minibuffer-history-uniquify - (cons histval (remove histval list)) - (cons histval list)))))) - (if err (signal (car err) (cdr err))) - val)))) - ;; stupid display code requires this for some reason - (set-buffer buffer) - (buffer-disable-undo buffer) - (setq buffer-read-only nil) - (erase-buffer) - - ;; restore frame configurations - (if (and mconfig (frame-live-p oframe) - (eq frame (selected-frame))) - ;; if we changed frames (due to surrogate minibuffer), - ;; and we're still on the new frame, go back to the old one. - (select-frame oframe)) - (if mconfig (set-window-configuration mconfig)) - (set-window-configuration oconfig)))) - - -(defun minibuffer-max-depth-exceeded () - ;; - ;; This signals an error if an Nth minibuffer is invoked while N-1 are - ;; already active, whether the minibuffer window is selected or not. - ;; Since, under X, it's easy to jump out of the minibuffer (by doing M-x, - ;; getting distracted, and clicking elsewhere) many many novice users have - ;; had the problem of having multiple minibuffers build up, even to the - ;; point of exceeding max-lisp-eval-depth. Since the variable - ;; enable-recursive-minibuffers historically/crockishly is only consulted - ;; when the minibuffer is currently active (like typing M-x M-x) it doesn't - ;; help in this situation. - ;; - ;; This routine also offers to edit .emacs for you to get rid of this - ;; complaint, like `disabled' commands do, since it's likely that non-novice - ;; users will be annoyed by this change, so we give them an easy way to get - ;; rid of it forever. - ;; - (beep t 'minibuffer-limit-exceeded) - (message - "Minibuffer already active: abort it with `^]', enable new one with `n': ") - (let ((char (let ((cursor-in-echo-area t)) ; #### doesn't always work?? - (read-char)))) - (cond - ((eq char ?n) - (cond - ((y-or-n-p "Enable recursive minibuffers for other sessions too? ") - ;; This is completely disgusting, but it's basically what novice.el - ;; does. This kind of thing should be generalized. - (setq minibuffer-max-depth nil) - (save-excursion - (set-buffer - (find-file-noselect - (substitute-in-file-name custom-file))) - (goto-char (point-min)) - (if (re-search-forward - "^(setq minibuffer-max-depth \\([0-9]+\\|'?nil\\|'?()\\))\n" - nil t) - (delete-region (match-beginning 0 ) (match-end 0)) - ;; Must have been disabled by default. - (goto-char (point-max))) - (insert"\n(setq minibuffer-max-depth nil)\n") - (save-buffer)) - (message "Multiple minibuffers enabled") - (sit-for 1)))) - ((eq char ?) - (abort-recursive-edit)) - (t - (error "Minibuffer already active"))))) - - -;;;; Guts of minibuffer completion - - -;; Used by minibuffer-do-completion -(defvar last-exact-completion) - -(defun temp-minibuffer-message (m) - (let ((savemax (point-max))) - (save-excursion - (goto-char (point-max)) - (message nil) - (insert m)) - (let ((inhibit-quit t)) - (sit-for 2) - (delete-region savemax (point-max)) - ;; If the user types a ^G while we're in sit-for, then quit-flag - ;; gets set. In this case, we want that ^G to be interpreted - ;; as a normal character, and act just like typeahead. - (if (and quit-flag (not unread-command-event)) - (setq unread-command-event (character-to-event (quit-char)) - quit-flag nil))))) - - -;; Determines whether buffer-string is an exact completion -(defun exact-minibuffer-completion-p (buffer-string) - (cond ((not minibuffer-completion-table) - ;; Empty alist - nil) - ((vectorp minibuffer-completion-table) - (let ((tem (intern-soft buffer-string - minibuffer-completion-table))) - (if (or tem - (and (string-equal buffer-string "nil") - ;; intern-soft loses for 'nil - (catch 'found - (mapatoms #'(lambda (s) - (if (string-equal - (symbol-name s) - buffer-string) - (throw 'found t))) - minibuffer-completion-table) - nil))) - (if minibuffer-completion-predicate - (funcall minibuffer-completion-predicate - tem) - t) - nil))) - ((and (consp minibuffer-completion-table) - ;;#### Emacs-Lisp truly sucks! - ;; lambda, autoload, etc - (not (symbolp (car minibuffer-completion-table)))) - (if (not completion-ignore-case) - (assoc buffer-string minibuffer-completion-table) - (let ((s (upcase buffer-string)) - (tail minibuffer-completion-table) - tem) - (while tail - (setq tem (car (car tail))) - (if (or (equal tem buffer-string) - (equal tem s) - (if tem (equal (upcase tem) s))) - (setq s 'win - tail nil) ;exit - (setq tail (cdr tail)))) - (eq s 'win)))) - (t - (funcall minibuffer-completion-table - buffer-string - minibuffer-completion-predicate - 'lambda))) - ) - -;; 0 'none no possible completion -;; 1 'unique was already an exact and unique completion -;; 3 'exact was already an exact (but nonunique) completion -;; NOT USED 'completed-exact-unique completed to an exact and completion -;; 4 'completed-exact completed to an exact (but nonunique) completion -;; 5 'completed some completion happened -;; 6 'uncompleted no completion happened -(defun minibuffer-do-completion-1 (buffer-string completion) - (cond ((not completion) - 'none) - ((eq completion t) - ;; exact and unique match - 'unique) - (t - ;; It did find a match. Do we match some possibility exactly now? - (let ((completedp (not (string-equal completion buffer-string)))) - (if completedp - (progn - ;; Some completion happened - (erase-buffer) - (insert completion) - (setq buffer-string completion))) - (if (exact-minibuffer-completion-p buffer-string) - ;; An exact completion was possible - (if completedp -;; Since no callers need to know the difference, don't bother -;; with this (potentially expensive) discrimination. -;; (if (eq (try-completion completion -;; minibuffer-completion-table -;; minibuffer-completion-predicate) -;; 't) -;; 'completed-exact-unique - 'completed-exact -;; ) - 'exact) - ;; Not an exact match - (if completedp - 'completed - 'uncompleted)))))) - - -(defun minibuffer-do-completion (buffer-string) - (let* ((completion (try-completion buffer-string - minibuffer-completion-table - minibuffer-completion-predicate)) - (status (minibuffer-do-completion-1 buffer-string completion)) - (last last-exact-completion)) - (setq last-exact-completion nil) - (cond ((eq status 'none) - ;; No completions - (ding nil 'no-completion) - (temp-minibuffer-message " [No match]")) - ((eq status 'unique) - ) - (t - ;; It did find a match. Do we match some possibility exactly now? - (if (not (string-equal completion buffer-string)) - (progn - ;; Some completion happened - (erase-buffer) - (insert completion) - (setq buffer-string completion))) - (cond ((eq status 'exact) - ;; If the last exact completion and this one were - ;; the same, it means we've already given a - ;; "Complete but not unique" message and that the - ;; user's hit TAB again, so now we give help. - (setq last-exact-completion completion) - (if (equal buffer-string last) - (minibuffer-completion-help))) - ((eq status 'uncompleted) - (if completion-auto-help - (minibuffer-completion-help) - (temp-minibuffer-message " [Next char not unique]"))) - (t - nil)))) - status)) - - -;;;; completing-read - -(defun completing-read (prompt table - &optional predicate require-match - initial-contents history) - "Read a string in the minibuffer, with completion. -Args: PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-CONTENTS, HISTORY. -PROMPT is a string to prompt with; normally it ends in a colon and a space. -TABLE is an alist whose elements' cars are strings, or an obarray. -PREDICATE limits completion to a subset of TABLE. -See `try-completion' for more details on completion, TABLE, and PREDICATE. -If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of TABLE or is null. - If it is also not t, Return does not exit if it does non-null completion. -If INITIAL-CONTENTS is non-nil, insert it in the minibuffer initially. - If it is (STRING . POSITION), the initial input - is STRING, but point is placed POSITION characters into the string. -HISTORY, if non-nil, specifies a history list - and optionally the initial position in the list. - It can be a symbol, which is the history list variable to use, - or it can be a cons cell (HISTVAR . HISTPOS). - In that case, HISTVAR is the history list variable to use, - and HISTPOS is the initial position (the position in the list - which INITIAL-CONTENTS corresponds to). - If HISTORY is `t', no history will be recorded. - Positions are counted starting from 1 at the beginning of the list. -Completion ignores case if the ambient value of - `completion-ignore-case' is non-nil." - (let ((minibuffer-completion-table table) - (minibuffer-completion-predicate predicate) - (minibuffer-completion-confirm (if (eq require-match 't) nil t)) - (last-exact-completion nil)) - (read-from-minibuffer prompt - initial-contents - (if (not require-match) - minibuffer-local-completion-map - minibuffer-local-must-match-map) - nil - history))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Minibuffer completion commands ;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defun minibuffer-complete () - "Complete the minibuffer contents as far as possible. -Return nil if there is no valid completion, else t. -If no characters can be completed, display a list of possible completions. -If you repeat this command after it displayed such a list, -scroll the window of possible completions." - (interactive) - ;; If the previous command was not this, then mark the completion - ;; buffer obsolete. - (or (eq last-command this-command) - (setq minibuffer-scroll-window nil)) - (let ((window minibuffer-scroll-window)) - (if (and window (windowp window) (window-buffer window) - (buffer-name (window-buffer window))) - ;; If there's a fresh completion window with a live buffer - ;; and this command is repeated, scroll that window. - (let ((obuf (current-buffer))) - (unwind-protect - (progn - (set-buffer (window-buffer window)) - (if (pos-visible-in-window-p (point-max) window) - ;; If end is in view, scroll up to the beginning. - (set-window-start window (point-min)) - ;; Else scroll down one frame. - (scroll-other-window))) - (set-buffer obuf)) - nil) - (let ((status (minibuffer-do-completion (buffer-string)))) - (if (eq status 'none) - nil - (progn - (cond ((eq status 'unique) - (temp-minibuffer-message - " [Sole completion]")) - ((eq status 'exact) - (temp-minibuffer-message - " [Complete, but not unique]"))) - t)))))) - - -(defun minibuffer-complete-and-exit () - "Complete the minibuffer contents, and maybe exit. -Exit if the name is valid with no completion needed. -If name was completed to a valid match, -a repetition of this command will exit." - (interactive) - (if (= (point-min) (point-max)) - ;; Crockishly allow user to specify null string - (throw 'exit nil)) - (let ((buffer-string (buffer-string))) - ;; Short-cut -- don't call minibuffer-do-completion if we already - ;; have an (possibly nonunique) exact completion. - (if (exact-minibuffer-completion-p buffer-string) - (throw 'exit nil)) - (let ((status (minibuffer-do-completion buffer-string))) - (if (or (eq status 'unique) - (eq status 'exact) - (if (or (eq status 'completed-exact) - (eq status 'completed-exact-unique)) - (if minibuffer-completion-confirm - (progn (temp-minibuffer-message " [Confirm]") - nil) - t))) - (throw 'exit nil))))) - - -(defun self-insert-and-exit () - "Terminate minibuffer input." - (interactive) - (self-insert-command 1) - (throw 'exit nil)) - -(defun exit-minibuffer () - "Terminate this minibuffer argument. -If minibuffer-confirm-incomplete is true, and we are in a completing-read -of some kind, and the contents of the minibuffer is not an existing -completion, requires an additional RET before the minibuffer will be exited -\(assuming that RET was the character that invoked this command: -the character in question must be typed again)." - (interactive) - (if (not minibuffer-confirm-incomplete) - (throw 'exit nil)) - (let ((buffer-string (buffer-string))) - (if (exact-minibuffer-completion-p buffer-string) - (throw 'exit nil)) - (let ((completion (if (not minibuffer-completion-table) - t - (try-completion buffer-string - minibuffer-completion-table - minibuffer-completion-predicate)))) - (if (or (eq completion 't) - ;; Crockishly allow user to specify null string - (string-equal buffer-string "")) - (throw 'exit nil)) - (if completion ;; rewritten for I18N3 snarfing - (temp-minibuffer-message " [incomplete; confirm]") - (temp-minibuffer-message " [no completions; confirm]")) - (let ((event (let ((inhibit-quit t)) - (prog1 - (next-command-event) - (setq quit-flag nil))))) - (cond ((equal event last-command-event) - (throw 'exit nil)) - ((equal (quit-char) (event-to-character event)) - ;; Minibuffer abort. - (throw 'exit t))) - (dispatch-event event))))) - -;;;; minibuffer-complete-word - - -;;;#### I think I have done this correctly; it certainly is simpler -;;;#### than what the C code seemed to be trying to do. -(defun minibuffer-complete-word () - "Complete the minibuffer contents at most a single word. -After one word is completed as much as possible, a space or hyphen -is added, provided that matches some possible completion. -Return nil if there is no valid completion, else t." - (interactive) - (let* ((buffer-string (buffer-string)) - (completion (try-completion buffer-string - minibuffer-completion-table - minibuffer-completion-predicate)) - (status (minibuffer-do-completion-1 buffer-string completion))) - (cond ((eq status 'none) - (ding nil 'no-completion) - (temp-minibuffer-message " [No match]") - nil) - ((eq status 'unique) - ;; New message, only in this new Lisp code - (temp-minibuffer-message " [Sole completion]") - t) - (t - (cond ((or (eq status 'uncompleted) - (eq status 'exact)) - (let ((foo #'(lambda (s) - (condition-case nil - (if (try-completion - (concat buffer-string s) - minibuffer-completion-table - minibuffer-completion-predicate) - (progn - (goto-char (point-max)) - (insert s) - t) - nil) - (error nil)))) - (char last-command-char)) - ;; Try to complete by adding a word-delimiter - (or (and (characterp char) (> char 0) - (funcall foo (char-to-string char))) - (and (not (eq char ?\ )) - (funcall foo " ")) - (and (not (eq char ?\-)) - (funcall foo "-")) - (progn - (if completion-auto-help - (minibuffer-completion-help) - ;; New message, only in this new Lisp code - ;; rewritten for I18N3 snarfing - (if (eq status 'exact) - (temp-minibuffer-message - " [Complete, but not unique]") - (temp-minibuffer-message " [Ambiguous]"))) - nil)))) - (t - (erase-buffer) - (insert completion) - ;; First word-break in stuff found by completion - (goto-char (point-min)) - (let ((len (length buffer-string)) - n) - (if (and (< len (length completion)) - (catch 'match - (setq n 0) - (while (< n len) - (if (char-equal - (upcase (aref buffer-string n)) - (upcase (aref completion n))) - (setq n (1+ n)) - (throw 'match nil))) - t) - (progn - (goto-char (point-min)) - (forward-char len) - (re-search-forward "\\W" nil t))) - (delete-region (point) (point-max)) - (goto-char (point-max)))) - t)))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; "Smart minibuffer" hackery ;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; ("Kludgy minibuffer hackery" is perhaps a better name) - -;; This works by setting `mouse-grabbed-buffer' to the minibuffer, -;; defining button2 in the minibuffer keymap to -;; `minibuffer-smart-select-highlighted-completion', and setting the -;; mode-motion-hook of the minibuffer to `minibuffer-mouse-tracker'. -;; By setting `mouse-grabbed-buffer', the minibuffer's keymap and -;; mode-motion-hook apply (for mouse motion and presses) no matter -;; what buffer the mouse is over. Then, `minibuffer-mouse-tracker' -;; examines the text under the mouse looking for something that looks -;; like a completion, and causes it to be highlighted, and -;; `minibuffer-smart-select-highlighted-completion' looks for a -;; flagged completion under the mouse and inserts it. This has the -;; following advantages: -;; -;; -- filenames and such in any buffer can be inserted by clicking, -;; not just completions -;; -;; but the following disadvantages: -;; -;; -- unless you're aware of the "filename in any buffer" feature, -;; the fact that strings in arbitrary buffers get highlighted appears -;; as a bug -;; -- mouse motion can cause ange-ftp actions -- bad bad bad. -;; -;; There's some hackery in minibuffer-mouse-tracker to try to avoid the -;; ange-ftp stuff, but it doesn't work. -;; - -(defcustom minibuffer-smart-completion-tracking-behavior nil - "*If non-nil, look for completions under mouse in all buffers. -This allows you to click on something that looks like a completion -and have it selected, regardless of what buffer it is in. - -This is not enabled by default because - --- The \"mysterious\" highlighting in normal buffers is confusing to - people not expecting it, and looks like a bug --- If ange-ftp is enabled, this tracking sometimes causes ange-ftp - action as a result of mouse motion, which is *bad bad bad*. - Hopefully this bug will be fixed at some point." - :type 'boolean - :group 'minibuffer) - -(defun minibuffer-smart-mouse-tracker (event) - ;; Used as the mode-motion-hook of the minibuffer window, which is the - ;; value of `mouse-grabbed-buffer' while the minibuffer is active. If - ;; the word under the mouse is a valid minibuffer completion, then it - ;; is highlighted. - ;; - ;; We do some special voodoo when we're reading a pathname, because - ;; the way filename completion works is funny. Possibly there's some - ;; more general way this could be dealt with... - ;; - ;; We do some further voodoo when reading a pathname that is an - ;; ange-ftp or efs path, because causing FTP activity as a result of - ;; mouse motion is a really bad time. - ;; - (and minibuffer-smart-completion-tracking-behavior - (event-point event) - ;; avoid conflict with display-completion-list extents - (not (extent-at (event-point event) - (event-buffer event) - 'list-mode-item)) - (let ((filename-kludge-p (eq minibuffer-completion-table - 'read-file-name-internal))) - (mode-motion-highlight-internal - event - #'(lambda () (default-mouse-track-beginning-of-word - (if filename-kludge-p 'nonwhite t))) - #'(lambda () - (let ((p (point)) - (string "")) - (default-mouse-track-end-of-word - (if filename-kludge-p 'nonwhite t)) - (if (and (/= p (point)) minibuffer-completion-table) - (setq string (buffer-substring p (point)))) - (if (string-match "\\`[ \t\n]*\\'" string) - (goto-char p) - (if filename-kludge-p - (setq string (minibuffer-smart-select-kludge-filename - string))) - ;; try-completion bogusly returns a string even when - ;; that string is complete if that string is also a - ;; prefix for other completions. This means that we - ;; can't just do the obvious thing, (eq t - ;; (try-completion ...)). - (let (comp) - (if (and filename-kludge-p - ;; #### evil evil evil evil - (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path string)) - (and (fboundp 'efs-ftp-path) - (efs-ftp-path string)))) - (setq comp t) - (setq comp - (try-completion string - minibuffer-completion-table - minibuffer-completion-predicate))) - (or (eq comp t) - (and (equal comp string) - (or (null minibuffer-completion-predicate) - (stringp - minibuffer-completion-predicate) ; ??? - (funcall minibuffer-completion-predicate - (if (vectorp - minibuffer-completion-table) - (intern-soft - string - minibuffer-completion-table) - string)))) - (goto-char p)))))))))) - -(defun minibuffer-smart-select-kludge-filename (string) - (save-excursion - (set-buffer mouse-grabbed-buffer) ; the minibuf - (let ((kludge-string (concat (buffer-string) string))) - (if (or (and (fboundp 'ange-ftp-ftp-path) - (ange-ftp-ftp-path kludge-string)) - (and (fboundp 'efs-ftp-path) (efs-ftp-path kludge-string))) - ;; #### evil evil evil, but more so. - string - (append-expand-filename (buffer-string) string))))) - -(defun minibuffer-smart-select-highlighted-completion (event) - "Select the highlighted text under the mouse as a minibuffer response. -When the minibuffer is being used to prompt the user for a completion, -any valid completions which are visible on the frame will highlight -when the mouse moves over them. Clicking \\\ -\\[minibuffer-smart-select-highlighted-completion] will select the -highlighted completion under the mouse. - -If the mouse is clicked while not over a highlighted completion, -then the global binding of \\[minibuffer-smart-select-highlighted-completion] \ -will be executed instead. In this\nway you can get at the normal global \ -behavior of \\[minibuffer-smart-select-highlighted-completion] as well as -the special minibuffer behavior." - (interactive "e") - (if minibuffer-smart-completion-tracking-behavior - (minibuffer-smart-select-highlighted-completion-1 event t) - (let ((command (lookup-key global-map - (vector current-mouse-event)))) - (if command (call-interactively command))))) - -(defun minibuffer-smart-select-highlighted-completion-1 (event global-p) - (let* ((filename-kludge-p (eq minibuffer-completion-table - 'read-file-name-internal)) - completion - command-p - (evpoint (event-point event)) - (evextent (and evpoint (extent-at evpoint (event-buffer event) - 'list-mode-item)))) - (if evextent - ;; avoid conflict with display-completion-list extents. - ;; if we find one, do that behavior instead. - (list-mode-item-selected-1 evextent event) - (save-excursion - (let* ((buffer (window-buffer (event-window event))) - (p (event-point event)) - (extent (and p (extent-at p buffer 'mouse-face)))) - (set-buffer buffer) - (if (not (and (extent-live-p extent) - (eq (extent-object extent) (current-buffer)) - (not (extent-detached-p extent)))) - (setq command-p t) - ;; ...else user has selected a highlighted completion. - (setq completion - (buffer-substring (extent-start-position extent) - (extent-end-position extent))) - (if filename-kludge-p - (setq completion (minibuffer-smart-select-kludge-filename - completion))) - ;; remove the extent so that it's not hanging around in - ;; *Completions* - (detach-extent extent) - (set-buffer mouse-grabbed-buffer) - (erase-buffer) - (insert completion)))) - ;; we need to execute the command or do the throw outside of the - ;; save-excursion. - (cond ((and command-p global-p) - (let ((command (lookup-key global-map - (vector current-mouse-event)))) - (if command - (call-interactively command) - (if minibuffer-completion-table - (error - "Highlighted words are valid completions. You may select one.") - (error "no completions"))))) - ((not command-p) - ;; things get confused if the minibuffer is terminated while - ;; not selected. - (select-window (minibuffer-window)) - (if (and filename-kludge-p (file-directory-p completion)) - ;; if the user clicked middle on a directory name, display the - ;; files in that directory. - (progn - (goto-char (point-max)) - (minibuffer-completion-help)) - ;; otherwise, terminate input - (throw 'exit nil))))))) - -(defun minibuffer-smart-maybe-select-highlighted-completion - (event &optional click-count) - "Like minibuffer-smart-select-highlighted-completion but does nothing if -there is no completion (as opposed to executing the global binding). Useful -as the value of `mouse-track-click-hook'." - (interactive "e") - (minibuffer-smart-select-highlighted-completion-1 event nil)) - -(define-key minibuffer-local-map 'button2 - 'minibuffer-smart-select-highlighted-completion) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Minibuffer History ;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar minibuffer-history '() - "Default minibuffer history list. -This is used for all minibuffer input except when an alternate history -list is specified.") - -;; Some other history lists: -;; -(defvar minibuffer-history-search-history '()) -(defvar function-history '()) -(defvar variable-history '()) -(defvar buffer-history '()) -(defvar shell-command-history '()) -(defvar file-name-history '()) - -(defvar read-expression-history nil) - -(defvar minibuffer-history-sexp-flag nil ;weird FSF Emacs kludge - "Non-nil when doing history operations on `command-history'. -More generally, indicates that the history list being acted on -contains expressions rather than strings.") - -(defun previous-matching-history-element (regexp n) - "Find the previous history element that matches REGEXP. -\(Previous history elements refer to earlier actions.) -With prefix argument N, search for Nth previous match. -If N is negative, find the next or Nth next match." - (interactive - (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) - (if (eq 't (symbol-value minibuffer-history-variable)) - (error "History is not being recorded in this context")) - (list (read-from-minibuffer "Previous element matching (regexp): " - (car minibuffer-history-search-history) - minibuffer-local-map - nil - 'minibuffer-history-search-history) - (prefix-numeric-value current-prefix-arg)))) - (let ((history (symbol-value minibuffer-history-variable)) - prevpos - (pos minibuffer-history-position)) - (if (eq history t) - (error "History is not being recorded in this context")) - (while (/= n 0) - (setq prevpos pos) - (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history))) - (if (= pos prevpos) - (if (= pos 1) ;; rewritten for I18N3 snarfing - (error "No later matching history item") - (error "No earlier matching history item"))) - (if (string-match regexp - (if minibuffer-history-sexp-flag - (let ((print-level nil)) - (prin1-to-string (nth (1- pos) history))) - (nth (1- pos) history))) - (setq n (+ n (if (< n 0) 1 -1))))) - (setq minibuffer-history-position pos) - (setq current-minibuffer-contents (buffer-string) - current-minibuffer-point (point)) - (erase-buffer) - (let ((elt (nth (1- pos) history))) - (insert (if minibuffer-history-sexp-flag - (let ((print-level nil)) - (prin1-to-string elt)) - elt))) - (goto-char (point-min))) - (if (or (eq (car (car command-history)) 'previous-matching-history-element) - (eq (car (car command-history)) 'next-matching-history-element)) - (setq command-history (cdr command-history)))) - -(defun next-matching-history-element (regexp n) - "Find the next history element that matches REGEXP. -\(The next history element refers to a more recent action.) -With prefix argument N, search for Nth next match. -If N is negative, find the previous or Nth previous match." - (interactive - (let ((enable-recursive-minibuffers t) - (minibuffer-history-sexp-flag nil)) - (if (eq t (symbol-value minibuffer-history-variable)) - (error "History is not being recorded in this context")) - (list (read-from-minibuffer "Next element matching (regexp): " - (car minibuffer-history-search-history) - minibuffer-local-map - nil - 'minibuffer-history-search-history) - (prefix-numeric-value current-prefix-arg)))) - (previous-matching-history-element regexp (- n))) - -(defun next-history-element (n) - "Insert the next element of the minibuffer history into the minibuffer." - (interactive "p") - (if (eq 't (symbol-value minibuffer-history-variable)) - (error "History is not being recorded in this context")) - (unless (zerop n) - (when (eq minibuffer-history-position - initial-minibuffer-history-position) - (setq current-minibuffer-contents (buffer-string) - current-minibuffer-point (point))) - (let ((narg (- minibuffer-history-position n)) - (minimum (if minibuffer-default -1 0))) - (cond ((< narg minimum) - (error "No following item in %s" minibuffer-history-variable)) - ((> narg (length (symbol-value minibuffer-history-variable))) - (error "No preceding item in %s" minibuffer-history-variable))) - (erase-buffer) - (setq minibuffer-history-position narg) - (if (eq narg initial-minibuffer-history-position) - (progn - (insert current-minibuffer-contents) - (goto-char current-minibuffer-point)) - (let ((elt (if (>= narg 0) - (nth (1- minibuffer-history-position) - (symbol-value minibuffer-history-variable)) - minibuffer-default))) - (insert - (if (not (stringp elt)) - (let ((print-level nil)) - (condition-case nil - (let ((print-readably t) - (print-escape-newlines t)) - (prin1-to-string elt)) - (error (prin1-to-string elt)))) - elt))) - ;; FSF has point-min here. - (goto-char (point-max)))))) - -(defun previous-history-element (n) - "Insert the previous element of the minibuffer history into the minibuffer." - (interactive "p") - (next-history-element (- n))) - -(defun next-complete-history-element (n) - "Get next element of history which is a completion of minibuffer contents." - (interactive "p") - (let ((point-at-start (point))) - (next-matching-history-element - (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n) - ;; next-matching-history-element always puts us at (point-min). - ;; Move to the position we were at before changing the buffer contents. - ;; This is still sensical, because the text before point has not changed. - (goto-char point-at-start))) - -(defun previous-complete-history-element (n) - "Get previous element of history which is a completion of minibuffer contents." - (interactive "p") - (next-complete-history-element (- n))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; reading various things from a minibuffer ;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun read-expression (prompt &optional initial-contents history) - "Return a Lisp object read using the minibuffer. -Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS -is a string to insert in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." - (let ((minibuffer-history-sexp-flag t) - ;; Semi-kludge to get around M-x C-x o M-ESC trying to do completion. - (minibuffer-completion-table nil)) - (read-from-minibuffer prompt - initial-contents - read-expression-map - t - (or history 'read-expression-history) - lisp-mode-abbrev-table))) - -(defun read-string (prompt &optional initial-contents history) - "Return a string from the minibuffer, prompting with string PROMPT. -If non-nil, optional second arg INITIAL-CONTENTS is a string to insert -in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." - (let ((minibuffer-completion-table nil)) - (read-from-minibuffer prompt - initial-contents - minibuffer-local-map - nil history))) - -(defun eval-minibuffer (prompt &optional initial-contents history) - "Return value of Lisp expression read using the minibuffer. -Prompt with PROMPT. If non-nil, optional second arg INITIAL-CONTENTS -is a string to insert in the minibuffer before reading. -Third arg HISTORY, if non-nil, specifies a history list." - (eval (read-expression prompt initial-contents history))) - -;; The name `command-history' is already taken -(defvar read-command-history '()) - -(defun read-command (prompt) - "Read the name of a command and return as a symbol. -Prompts with PROMPT." - (intern (completing-read prompt obarray 'commandp t nil - ;; 'command-history is not right here: that's a - ;; list of evalable forms, not a history list. - 'read-command-history - ))) - -(defun read-function (prompt) - "Read the name of a function and return as a symbol. -Prompts with PROMPT." - (intern (completing-read prompt obarray 'fboundp t nil - 'function-history))) - -(defun read-variable (prompt) - "Read the name of a user variable and return it as a symbol. -Prompts with PROMPT. -A user variable is one whose documentation starts with a `*' character." - (intern (completing-read prompt obarray 'user-variable-p t nil - 'variable-history))) - -(defun read-buffer (prompt &optional default require-match) - "Read the name of a buffer and return as a string. -Prompts with PROMPT. Optional second arg DEFAULT is value to return if user -enters an empty line. If optional third arg REQUIRE-MATCH is non-nil, -only existing buffer names are allowed." - (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)) - (buffer-list))) - result) - (while (progn - (setq result (completing-read prompt alist nil require-match - nil 'buffer-history)) - (cond ((not (equal result "")) - nil) - ((not require-match) - (setq result default) - nil) - ((not default) - t) - ((not (get-buffer default)) - t) - (t - (setq result default) - nil)))) - (if (bufferp result) - (buffer-name result) - result))) - -(defun read-number (prompt &optional integers-only) - "Read a number from the minibuffer." - (let ((pred (if integers-only 'integerp 'numberp)) - 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 - t)) ;no history - (input-error nil) - (invalid-read-syntax nil) - (end-of-file nil))) - (or (funcall pred num) (beep))) - num)) - -(defun read-shell-command (prompt &optional initial-input history) - "Just like read-string, but uses read-shell-command-map: -\\{read-shell-command-map}" - (let ((minibuffer-completion-table nil)) - (read-from-minibuffer prompt initial-input read-shell-command-map - nil (or history 'shell-command-history)))) - - -;;; This read-file-name stuff probably belongs in files.el - -;; Quote "$" as "$$" to get it past substitute-in-file-name -(defun un-substitute-in-file-name (string) - (let ((regexp "\\$") - (olen (length string)) - new - n o ch) - (if (not (string-match regexp string)) - string - (setq n 1) - (while (string-match regexp string (match-end 0)) - (setq n (1+ n))) - (setq new (make-string (+ olen n) ?$)) - (setq n 0 o 0) - (while (< o olen) - (setq ch (aref string o)) - (aset new n ch) - (setq o (1+ o) n (1+ n)) - (if (eq ch ?$) - ;; already aset by make-string initial-value - (setq n (1+ n)))) - new))) - -(defun read-file-name-2 (history prompt dir default - must-match initial-contents - completer) - (if (not dir) - (setq dir default-directory)) - (setq dir (abbreviate-file-name dir t)) - (let* ((insert (cond ((and (not insert-default-directory) - (not initial-contents)) - "") - (initial-contents - (cons (un-substitute-in-file-name - (concat dir initial-contents)) - (length dir))) - (t - (un-substitute-in-file-name dir)))) - (val - ;; Hateful, broken, case-sensitive un*x -;;; (completing-read prompt -;;; completer -;;; dir -;;; must-match -;;; insert -;;; history) - ;; #### - this is essentially the guts of completing read. - ;; There should be an elegant way to pass a pair of keymaps to - ;; completing read, but this will do for now. All sins are - ;; relative. --Stig - (let ((minibuffer-completion-table completer) - (minibuffer-completion-predicate dir) - (minibuffer-completion-confirm (if (eq must-match 't) - nil t)) - (last-exact-completion nil)) - (read-from-minibuffer prompt - insert - (if (not must-match) - read-file-name-map - read-file-name-must-match-map) - nil - history)) - )) -;;; ;; Kludge! Put "/foo/bar" on history rather than "/default//foo/bar" -;;; (let ((hist (cond ((not history) 'minibuffer-history) -;;; ((consp history) (car history)) -;;; (t history)))) -;;; (if (and val -;;; hist -;;; (not (eq hist 't)) -;;; (boundp hist) -;;; (equal (car-safe (symbol-value hist)) val)) -;;; (let ((e (condition-case nil -;;; (expand-file-name val) -;;; (error nil)))) -;;; (if (and e (not (equal e val))) -;;; (set hist (cons e (cdr (symbol-value hist)))))))) - - (cond ((not val) - (error "No file name specified")) - ((and default - (equal val (if (consp insert) (car insert) insert))) - default) - (t - (substitute-in-file-name val))))) - -;; #### this function should use minibuffer-completion-table -;; or something. But that is sloooooow. -;; #### all this shit needs better documentation!!!!!!!! -(defun read-file-name-activate-callback (event extent dir-p) - ;; used as the activate-callback of the filename list items - ;; in the completion buffer, in place of default-choose-completion. - ;; if a regular file was selected, we call default-choose-completion - ;; (which just inserts the string in the minibuffer and calls - ;; exit-minibuffer). If a directory was selected, we display - ;; the contents of the directory. - (let* ((file (extent-string extent)) - (completion-buf (extent-object extent)) - (minibuf (symbol-value-in-buffer 'completion-reference-buffer - completion-buf)) - (in-dir (file-name-directory (buffer-substring nil nil minibuf))) - (full (expand-file-name file in-dir))) - (if (not (file-directory-p full)) - (default-choose-completion event extent minibuf) - (erase-buffer minibuf) - (insert-string (file-name-as-directory - (abbreviate-file-name full t)) minibuf) - (reset-buffer completion-buf) - (let ((standard-output completion-buf)) - (display-completion-list - (delete "." (directory-files full nil nil nil (if dir-p 'directory))) - :user-data dir-p - :reference-buffer minibuf - :activate-callback 'read-file-name-activate-callback) - (goto-char (point-min) completion-buf))))) - -(defun read-file-name-1 (history prompt dir default - must-match initial-contents - completer) - (if (should-use-dialog-box-p) - ;; this calls read-file-name-2 - (mouse-read-file-name-1 history prompt dir default must-match - initial-contents completer) - (let ((rfhookfun - (lambda () - ;; #### SCREAM! Create a `file-system-ignore-case' - ;; function, so this kind of stuff is generalized! - (and (eq system-type 'windows-nt) - (set (make-local-variable 'completion-ignore-case) t)) - (set - (make-local-variable - 'completion-display-completion-list-function) - #'(lambda (completions) - (display-completion-list - completions - :user-data (not (eq completer 'read-file-name-internal)) - :activate-callback - 'read-file-name-activate-callback))) - ;; kludge! - (remove-hook 'minibuffer-setup-hook rfhookfun) - ))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook rfhookfun) - (read-file-name-2 history prompt dir default must-match - initial-contents completer)) - (remove-hook 'minibuffer-setup-hook rfhookfun))))) - -(defun read-file-name (prompt - &optional dir default must-match initial-contents - history) - "Read file name, prompting with PROMPT and completing in directory DIR. -This will prompt with a dialog box if appropriate, according to - `should-use-dialog-box-p'. -Value is not expanded---you must call `expand-file-name' yourself. -Value is subject to interpreted by substitute-in-file-name however. -Default name to DEFAULT if user enters a null string. - (If DEFAULT is omitted, the visited file name is used, - except that if INITIAL-CONTENTS is specified, that combined with DIR is - used.) -Fourth arg MUST-MATCH non-nil means require existing file's name. - Non-nil and non-t means also require confirmation after completion. -Fifth arg INITIAL-CONTENTS specifies text to start with. -Sixth arg HISTORY specifies the history list to use. Default is - `file-name-history'. -DIR defaults to current buffer's directory default." - (read-file-name-1 - (or history 'file-name-history) - prompt dir (or default - (if initial-contents (expand-file-name initial-contents dir) - buffer-file-name)) - must-match initial-contents - ;; A separate function (not an anonymous lambda-expression) - ;; and passed as a symbol because of disgusting kludges in various - ;; places which do stuff like (let ((filename-kludge-p (eq minibuffer-completion-table 'read-file-name-internal))) ...) - 'read-file-name-internal)) - -(defun read-directory-name (prompt - &optional dir default must-match initial-contents - history) - "Read directory name, prompting with PROMPT and completing in directory DIR. -This will prompt with a dialog box if appropriate, according to - `should-use-dialog-box-p'. -Value is not expanded---you must call `expand-file-name' yourself. -Value is subject to interpreted by substitute-in-file-name however. -Default name to DEFAULT if user enters a null string. - (If DEFAULT is omitted, the current buffer's default directory is used.) -Fourth arg MUST-MATCH non-nil means require existing directory's name. - Non-nil and non-t means also require confirmation after completion. -Fifth arg INITIAL-CONTENTS specifies text to start with. -Sixth arg HISTORY specifies the history list to use. Default is - `file-name-history'. -DIR defaults to current buffer's directory default." - (read-file-name-1 - (or history 'file-name-history) - prompt dir (or default default-directory) must-match initial-contents - 'read-directory-name-internal)) - - -;; Environment-variable and ~username completion hack -(defun read-file-name-internal-1 (string dir action completer) - (if (not (string-match - "\\([^$]\\|\\`\\)\\(\\$\\$\\)*\\$\\([A-Za-z0-9_]*\\|{[^}]*\\)\\'" - string)) - ;; Not doing environment-variable completion hack - (let* ((orig (if (equal string "") nil string)) - (sstring (if orig (substitute-in-file-name string) string)) - (specdir (if orig (file-name-directory sstring) nil)) - (name (if orig (file-name-nondirectory sstring) string)) - (direct (if specdir (expand-file-name specdir dir) dir))) - ;; ~username completion - (if (and (fboundp 'user-name-completion-1) - (string-match "^[~]" name)) - (let ((user (substring name 1))) - (cond ((eq action 'lambda) - (file-directory-p name)) - ((eq action 't) - ;; all completions - (mapcar #'(lambda (p) (concat "~" p)) - (user-name-all-completions user))) - (t;; 'nil - ;; complete - (let* ((val+uniq (user-name-completion-1 user)) - (val (car val+uniq)) - (uniq (cdr val+uniq))) - (cond ((stringp val) - (if uniq - (file-name-as-directory (concat "~" val)) - (concat "~" val))) - ((eq val t) - (file-name-as-directory name)) - (t nil)))))) - (funcall completer - action - orig - sstring - specdir - direct - name))) - ;; An odd number of trailing $'s - (let* ((start (match-beginning 3)) - (env (substring string - (cond ((= start (length string)) - ;; "...$" - start) - ((= (aref string start) ?{) - ;; "...${..." - (1+ start)) - (t - start)))) - (head (substring string 0 (1- start))) - (alist #'(lambda () - (mapcar #'(lambda (x) - (cons (substring x 0 (string-match "=" x)) - nil)) - process-environment)))) - - (cond ((eq action 'lambda) - nil) - ((eq action 't) - ;; all completions - (mapcar #'(lambda (p) - (if (and (> (length p) 0) - ;;#### Unix-specific - ;;#### -- need absolute-pathname-p - (/= (aref p 0) ?/)) - (concat "$" p) - (concat head "$" p))) - (all-completions env (funcall alist)))) - (t ;; nil - ;; complete - (let* ((e (funcall alist)) - (val (try-completion env e))) - (cond ((stringp val) - (if (string-match "[^A-Za-z0-9_]" val) - (concat head - "${" val - ;; completed uniquely? - (if (eq (try-completion val e) 't) - "}" "")) - (concat head "$" val))) - ((eql val 't) - (concat head - (un-substitute-in-file-name (getenv env)))) - (t nil)))))))) - - -(defun read-file-name-internal (string dir action) - (read-file-name-internal-1 - string dir action - #'(lambda (action orig string specdir dir name) - (cond ((eq action 'lambda) - (if (not orig) - nil - (let ((sstring (condition-case nil - (expand-file-name string) - (error nil)))) - (if (not sstring) - ;; Some pathname syntax error in string - nil - (file-exists-p sstring))))) - ((eq action 't) - ;; all completions - (mapcar #'un-substitute-in-file-name - (file-name-all-completions name dir))) - (t;; nil - ;; complete - (let* ((d (or dir default-directory)) - (val (file-name-completion name d))) - (if (and (eq val 't) - (not (null completion-ignored-extensions))) - ;;#### (file-name-completion "foo") returns 't - ;; when both "foo" and "foo~" exist and the latter - ;; is "pruned" by completion-ignored-extensions. - ;; I think this is a bug in file-name-completion. - (setq val (let ((completion-ignored-extensions '())) - (file-name-completion name d)))) - (if (stringp val) - (un-substitute-in-file-name (if specdir - (concat specdir val) - val)) - (let ((tem (un-substitute-in-file-name string))) - (if (not (equal tem orig)) - ;; substitute-in-file-name did something - tem - val))))))))) - -(defun read-directory-name-internal (string dir action) - (read-file-name-internal-1 - string dir action - #'(lambda (action orig string specdir dir name) - (let* ((dirs #'(lambda (fn) - (let ((l (if (equal name "") - (directory-files - dir - nil - "" - nil - 'directories) - (directory-files - dir - nil - (concat "\\`" (regexp-quote name)) - nil - 'directories)))) - (mapcar fn - ;; Wretched unix - (delete "." l)))))) - (cond ((eq action 'lambda) - ;; complete? - (if (not orig) - nil - (file-directory-p string))) - ((eq action 't) - ;; all completions - (funcall dirs #'(lambda (n) - (un-substitute-in-file-name - (file-name-as-directory n))))) - (t - ;; complete - (let ((val (try-completion - name - (funcall dirs - #'(lambda (n) - (list (file-name-as-directory - n))))))) - (if (stringp val) - (un-substitute-in-file-name (if specdir - (concat specdir val) - val)) - (let ((tem (un-substitute-in-file-name string))) - (if (not (equal tem orig)) - ;; substitute-in-file-name did something - tem - val)))))))))) - -(defun append-expand-filename (file-string string) - "Append STRING to FILE-STRING differently depending on whether STRING -is a username (~string), an environment variable ($string), -or a filename (/string). The resultant string is returned with the -environment variable or username expanded and resolved to indicate -whether it is a file(/result) or a directory (/result/)." - (let ((file - (cond ((string-match "\\([~$]\\)\\([^~$/]*\\)$" file-string) - (cond ((string= (substring file-string - (match-beginning 1) - (match-end 1)) "~") - (concat (substring file-string 0 (match-end 1)) - string)) - (t (substitute-in-file-name - (concat (substring file-string 0 (match-end 1)) - string))))) - (t (concat (file-name-directory - (substitute-in-file-name file-string)) string)))) - result) - - (cond ((stringp (setq result (and (file-exists-p (expand-file-name file)) - (read-file-name-internal - (condition-case nil - (expand-file-name file) - (error file)) - "" nil)))) - result) - (t file)))) - -(defun mouse-file-display-completion-list (window dir minibuf user-data) - (let ((standard-output (window-buffer window))) - (condition-case nil - (display-completion-list - (directory-files dir nil nil nil t) - :window-width (* 2 (window-width window)) - :activate-callback - 'mouse-read-file-name-activate-callback - :user-data user-data - :reference-buffer minibuf - :help-string "") - (t nil)))) - -(defun mouse-directory-display-completion-list (window dir minibuf user-data) - (let ((standard-output (window-buffer window))) - (condition-case nil - (display-completion-list - (delete "." (directory-files dir nil nil nil 1)) - :window-width (window-width window) - :activate-callback - 'mouse-read-file-name-activate-callback - :user-data user-data - :reference-buffer minibuf - :help-string "") - (t nil)))) - -(defun mouse-read-file-name-activate-callback (event extent user-data) - (let* ((file (extent-string extent)) - (minibuf (symbol-value-in-buffer 'completion-reference-buffer - (extent-object extent))) - (in-dir (buffer-substring nil nil minibuf)) - (full (expand-file-name file in-dir)) - (filebuf (nth 0 user-data)) - (dirbuff (nth 1 user-data)) - (filewin (nth 2 user-data)) - (dirwin (nth 3 user-data))) - (if (file-regular-p full) - (default-choose-completion event extent minibuf) - (erase-buffer minibuf) - (insert-string (file-name-as-directory - (abbreviate-file-name full t)) minibuf) - (reset-buffer filebuf) - (if (not dirbuff) - (mouse-directory-display-completion-list filewin full minibuf - user-data) - (mouse-file-display-completion-list filewin full minibuf user-data) - (reset-buffer dirbuff) - (mouse-directory-display-completion-list dirwin full minibuf - user-data))))) - -;; this is rather cheesified but gets the job done. -(defun mouse-read-file-name-1 (history prompt dir default - must-match initial-contents - completer) - (let* ((file-p (eq 'read-file-name-internal completer)) - (filebuf (get-buffer-create "*Completions*")) - (dirbuff (and file-p (generate-new-buffer " *mouse-read-file*"))) - (butbuff (generate-new-buffer " *mouse-read-file*")) - (frame (make-dialog-frame)) - filewin dirwin - user-data) - (unwind-protect - (progn - (reset-buffer filebuf) - (select-frame frame) - (let ((window-min-height 1)) - ;; #### should be 2 not 3, but that causes - ;; "window too small to split" errors for some - ;; people (but not for me ...) There's a more - ;; fundamental bug somewhere. - (split-window nil (- (frame-height frame) 3))) - (if file-p - (progn - (split-window-horizontally 16) - (setq filewin (frame-rightmost-window frame) - dirwin (frame-leftmost-window frame)) - (set-window-buffer filewin filebuf) - (set-window-buffer dirwin dirbuff)) - (setq filewin (frame-highest-window frame)) - (set-window-buffer filewin filebuf)) - (setq user-data (list filebuf dirbuff filewin dirwin)) - (set-window-buffer (frame-lowest-window frame) butbuff) - (set-buffer butbuff) - (when dir - (setq default-directory dir)) - (when (featurep 'scrollbar) - (set-specifier scrollbar-width 0 butbuff)) - (insert " ") - (insert-gui-button (make-gui-button "OK" - (lambda (foo) - (exit-minibuffer)))) - (insert " ") - (insert-gui-button (make-gui-button "Cancel" - (lambda (foo) - (abort-recursive-edit)))) - (let ((rfhookfun - (lambda () - (if (not file-p) - (mouse-directory-display-completion-list - filewin dir (current-buffer) user-data) - (mouse-file-display-completion-list filewin dir - (current-buffer) - user-data) - (mouse-directory-display-completion-list dirwin dir - (current-buffer) - user-data)) - (set - (make-local-variable - 'completion-display-completion-list-function) - #'(lambda (completions) - (display-completion-list - completions - :help-string "" - :activate-callback - 'mouse-read-file-name-activate-callback - :user-data user-data))) - ;; kludge! - (remove-hook 'minibuffer-setup-hook rfhookfun) - )) - (rfcshookfun - ;; kludge! - ;; #### I really need to flesh out the object - ;; hierarchy better to avoid these kludges. - (lambda () - (save-excursion - (set-buffer standard-output) - (setq truncate-lines t))))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook rfhookfun) - (add-hook 'completion-setup-hook rfcshookfun) - (read-file-name-2 history prompt dir default - must-match initial-contents - completer)) - (remove-hook 'minibuffer-setup-hook rfhookfun) - (remove-hook 'completion-setup-hook rfcshookfun)))) - (delete-frame frame) - (kill-buffer filebuf) - (kill-buffer butbuff) - (and dirbuff (kill-buffer dirbuff))))) - -(defun read-face (prompt &optional must-match) - "Read the name of a face from the minibuffer and return it as a symbol." - (intern (completing-read prompt obarray 'find-face must-match))) - -;; #### - wrong place for this variable? Exactly. We probably want -;; `color-list' to be a console method, so `tty-color-list' becomes -;; obsolete, and `read-color-completion-table' conses (mapcar #'list -;; (color-list)), optionally caching the results. - -;; Ben wanted all of the possibilities from the `configure' script used -;; here, but I think this is way too many. I already trimmed the R4 variants -;; and a few obvious losers from the list. --Stig -(defvar 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/") - "Search path used by `read-color' to find rgb.txt.") - -(defvar x-read-color-completion-table) - -(defun read-color-completion-table () - (case (device-type) - ;; #### Evil device-type dependency - (x - (if (boundp 'x-read-color-completion-table) - x-read-color-completion-table - (let ((rgb-file (locate-file "rgb.txt" x-library-search-path)) - clist color p) - (if (not rgb-file) - ;; prevents multiple searches for rgb.txt if we can't find it - (setq x-read-color-completion-table nil) - (with-current-buffer (get-buffer-create " *colors*") - (reset-buffer (current-buffer)) - (insert-file-contents rgb-file) - (while (not (eobp)) - ;; skip over comments - (while (looking-at "^!") - (end-of-line) - (forward-char 1)) - (skip-chars-forward "0-9 \t") - (setq p (point)) - (end-of-line) - (setq color (buffer-substring p (point)) - clist (cons (list color) clist)) - ;; Ugh. If we want to be able to complete the lowercase form - ;; of the color name, we need to add it twice! Yuck. - (let ((dcase (downcase color))) - (or (string= dcase color) - (push (list dcase) clist))) - (forward-char 1)) - (kill-buffer (current-buffer)))) - (setq x-read-color-completion-table clist) - x-read-color-completion-table))) - (mswindows - (mapcar #'list (mswindows-color-list))) - (tty - (mapcar #'list (tty-color-list))))) - -(defun read-color (prompt &optional must-match initial-contents) - "Read the name of a color from the minibuffer. -On X devices, this uses `x-library-search-path' to find rgb.txt in order - to build a completion table. -On TTY devices, this uses `tty-color-list'. -On mswindows devices, this uses `mswindows-color-list'." - (let ((table (read-color-completion-table))) - (completing-read prompt table nil (and table must-match) - initial-contents))) - - -;; #### The doc string for read-non-nil-coding system gets lost if we -;; only include these if the mule feature is present. Strangely, -;; read-coding-system doesn't. - -;;(if (featurep 'mule) - -(defun read-coding-system (prompt) - "Read a coding-system (or nil) from the minibuffer. -Prompting with string PROMPT." - (intern (completing-read prompt obarray 'find-coding-system t))) - -(defun read-non-nil-coding-system (prompt) - "Read a non-nil coding-system from the minibuffer. -Prompt with string PROMPT." - (let ((retval (intern ""))) - (while (= 0 (length (symbol-name retval))) - (setq retval (intern (completing-read prompt obarray - 'find-coding-system - t)))) - retval)) - -;;) ;; end of (featurep 'mule) - - - -(defcustom force-dialog-box-use nil - "*If non-nil, always use a dialog box for asking questions, if possible. -You should *bind* this, not set it. This is useful if you're doing -something mousy but which wasn't actually invoked using the mouse." - :type 'boolean - :group 'minibuffer) - -;; We include this here rather than dialog.el so it is defined -;; even when dialog boxes are not present. -(defun should-use-dialog-box-p () - "If non-nil, questions should be asked with a dialog box instead of the -minibuffer. This looks at `last-command-event' to see if it was a mouse -event, and checks whether dialog-support exists and the current device -supports dialog boxes. - -The dialog box is totally disabled if the variable `use-dialog-box' -is set to nil." - (and (featurep 'dialog) - (device-on-window-system-p) - use-dialog-box - (or force-dialog-box-use - (button-press-event-p last-command-event) - (button-release-event-p last-command-event) - (misc-user-event-p last-command-event)))) - -;;; minibuf.el ends here diff --git a/lisp/modeline.el b/lisp/modeline.el deleted file mode 100644 index 5311486..0000000 --- a/lisp/modeline.el +++ /dev/null @@ -1,622 +0,0 @@ -;;; modeline.el --- modeline hackery. - -;; Copyright (C) 1988, 1992-1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;;; Code: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; General mouse modeline stuff ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup modeline nil - "Modeline customizations." - :group 'environment) - -(defcustom drag-divider-event-lag 150 - "*The pause (in msecs) between divider drag events before redisplaying. -If this value is too small, dragging will be choppy because redisplay cannot -keep up. If it is too large, dragging will be choppy because of the explicit -redisplay delay specified." - :type 'integer - ;; #### Fix group. - :group 'modeline) - -(define-obsolete-variable-alias - 'drag-modeline-event-lag - 'drag-divider-event-lag) - -(defcustom modeline-click-swaps-buffers nil - "*If non-nil, clicking on the modeline changes the current buffer. -Click on the left half of the modeline cycles forward through the -buffer list and clicking on the right half cycles backward." - :type 'boolean - :group 'modeline) - -(defun mouse-drag-modeline (event) - "Resize a window by dragging its modeline. -This command should be bound to a button-press event in modeline-map. -Holding down a mouse button and moving the mouse up and down will -make the clicked-on window taller or shorter." - (interactive "e") - (or (button-press-event-p event) - (error "%s must be invoked by a mouse-press" this-command)) - (or (event-over-modeline-p event) - (error "not over a modeline")) - ;; Give the modeline a "pressed" look. --hniksic - (let-specifier ((modeline-shadow-thickness - (- (specifier-instance modeline-shadow-thickness - (event-window event))) - (event-window event))) - (let ((done nil) - (depress-line (event-y event)) - (start-event-frame (event-frame event)) - (start-event-window (event-window event)) - (start-nwindows (count-windows t)) -;; (hscroll-delta (face-width 'modeline)) -;; (start-hscroll (modeline-hscroll (event-window event))) -; (start-x-pixel (event-x-pixel event)) - (last-timestamp 0) - default-line-height - modeline-height - should-enlarge-minibuffer - event min-height minibuffer y top bot edges wconfig growth) - (setq minibuffer (minibuffer-window start-event-frame) - default-line-height (face-height 'default start-event-window) - min-height (+ (* window-min-height default-line-height) - ;; Don't let the window shrink by a - ;; non-multiple of the default line - ;; height. (enlarge-window -1) will do - ;; this if the difference between the - ;; current window height and the minimum - ;; window height is less than the height - ;; of the default font. These extra - ;; lost pixels of height don't come back - ;; if you grow the window again. This - ;; can make it impossible to drag back - ;; to the exact original size, which is - ;; disconcerting. - (% (window-pixel-height start-event-window) - default-line-height)) - modeline-height - (if (specifier-instance has-modeline-p start-event-window) - (+ (face-height 'modeline start-event-window) - (* 2 (specifier-instance modeline-shadow-thickness - start-event-window))) - (* 2 (specifier-instance modeline-shadow-thickness - start-event-window)))) - (if (not (eq (window-frame minibuffer) start-event-frame)) - (setq minibuffer nil)) - (if (and (null minibuffer) (one-window-p t)) - (error "Attempt to resize sole window")) - ;; if this is the bottommost ordinary window, then to - ;; move its modeline the minibuffer must be enlarged. - (setq should-enlarge-minibuffer - (and minibuffer (window-lowest-p start-event-window))) - ;; loop reading events - (while (not done) - (setq event (next-event event)) - ;; requeue event and quit if this is a misc-user, eval or - ;; keypress event. - ;; quit if this is a button press or release event, or if the event - ;; occurred in some other frame. - ;; drag if this is a mouse motion event and the time - ;; between this event and the last event is greater than - ;; drag-divider-event-lag. - ;; do nothing if this is any other kind of event. - (cond ((or (misc-user-event-p event) - (key-press-event-p event)) - (setq unread-command-events (nconc unread-command-events - (list event)) - done t)) - ((button-release-event-p event) - (setq done t) - ;; Consider we have a mouse click neither X pos (modeline - ;; scroll) nore Y pos (modeline drag) have changed. - (and modeline-click-swaps-buffers - (= depress-line (event-y event)) -;; (= start-hscroll (modeline-hscroll start-event-window)) - (modeline-swap-buffers event))) - ((button-event-p event) - (setq done t)) - ((not (motion-event-p event)) - (dispatch-event event)) - ((not (eq start-event-frame (event-frame event))) - (setq done t)) - ((< (abs (- (event-timestamp event) last-timestamp)) - drag-divider-event-lag) - nil) - (t -;; (set-modeline-hscroll start-event-window -;; (+ (/ (- (event-x-pixel event) -;; start-x-pixel) -;; hscroll-delta) -;; start-hscroll)) - (setq last-timestamp (event-timestamp event) - y (event-y-pixel event) - edges (window-pixel-edges start-event-window) - top (nth 1 edges) - bot (nth 3 edges)) - ;; scale back a move that would make the - ;; window too short. - (cond ((< (- y top (- modeline-height)) min-height) - (setq y (+ top min-height (- modeline-height))))) - ;; compute size change needed - (setq growth (- y bot (/ (- modeline-height) 2)) - wconfig (current-window-configuration)) - ;; grow/shrink minibuffer? - (if should-enlarge-minibuffer - (progn - ;; yes. scale back shrinkage if it - ;; would make the minibuffer less than 1 - ;; line tall. - ;; - ;; also flip the sign of the computed growth, - ;; since if we want to grow the window with the - ;; modeline we need to shrink the minibuffer - ;; and vice versa. - (if (and (> growth 0) - (< (- (window-pixel-height minibuffer) - growth) - default-line-height)) - (setq growth - (- (window-pixel-height minibuffer) - default-line-height))) - (setq growth (- growth)))) - ;; window grow and shrink by lines not pixels, so - ;; divide the pixel height by the height of the - ;; default face. - (setq growth (/ growth default-line-height)) - ;; grow/shrink the window - (enlarge-window growth nil (if should-enlarge-minibuffer - minibuffer - start-event-window)) - ;; if this window's growth caused another - ;; window to be deleted because it was too - ;; short, rescind the change. - ;; - ;; if size change caused space to be stolen - ;; from a window above this one, rescind the - ;; change, but only if we didn't grow/shrink - ;; the minibuffer. minibuffer size changes - ;; can cause all windows to shrink... no way - ;; around it. - (if (or (/= start-nwindows (count-windows t)) - (and (not should-enlarge-minibuffer) - (/= top (nth 1 (window-pixel-edges - start-event-window))))) - (set-window-configuration wconfig)))))))) - -;; from Bob Weiner (bob_weiner@pts.mot.com) -;; Whether this function should be called is now decided in -;; mouse-drag-modeline - dverna feb. 98 -(defun modeline-swap-buffers (event) - "Handle mouse clicks on modeline by switching buffers. -If click on left half of a frame's modeline, bury current buffer. -If click on right half of a frame's modeline, raise bottommost buffer. -Arg EVENT is the button release event that occurred on the modeline." - (or (event-over-modeline-p event) - (error "not over a modeline")) - (or (button-release-event-p event) - (error "not a button release event")) - (if (< (event-x event) (/ (window-width (event-window event)) 2)) - ;; On left half of modeline, bury current buffer, - ;; displaying second buffer on list. - (mouse-bury-buffer event) - ;; On right half of modeline, raise and display bottommost - ;; buffer in buffer list. - (mouse-unbury-buffer event))) - -(defconst modeline-menu - '("Window Commands" - ["Delete Window Above" delete-window t] - ["Delete Other Windows" delete-other-windows t] - ["Split Window Above" split-window-vertically t] - ["Split Window Horizontally" split-window-horizontally t] - ["Balance Windows" balance-windows t] - )) - -(defun modeline-menu (event) - (interactive "e") - (popup-menu-and-execute-in-window - (cons (format "Window Commands for %S:" - (buffer-name (event-buffer event))) - (cdr modeline-menu)) - event)) - -(defvar modeline-map (make-sparse-keymap 'modeline-map) - "Keymap consulted for mouse-clicks on the modeline of a window. -This variable may be buffer-local; its value will be looked up in -the buffer of the window whose modeline was clicked upon.") - -(define-key modeline-map 'button1 'mouse-drag-modeline) -;; button2 selects the window without setting point -(define-key modeline-map 'button2 (lambda () (interactive "@"))) -(define-key modeline-map 'button3 'modeline-menu) - -(make-face 'modeline-mousable "Face for mousable portions of the modeline.") -(set-face-parent 'modeline-mousable 'modeline nil '(default)) -(when (featurep 'window-system) - (set-face-foreground 'modeline-mousable - '(((default color x) . "firebrick") - ((default color mswindows) . "firebrick")) - 'global)) -(when (featurep 'x) - (set-face-font 'modeline-mousable [bold] nil '(default mono x)) - (set-face-font 'modeline-mousable [bold] nil '(default grayscale x))) - -(defmacro make-modeline-command-wrapper (command) - `#'(lambda (event) - (interactive "e") - (save-selected-window - (select-window (event-window event)) - (call-interactively ',(eval command))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Minor modes ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar minor-mode-alist nil - "Alist saying how to show minor modes in the modeline. -Each element looks like (VARIABLE STRING); -STRING is included in the modeline iff VARIABLE's value is non-nil. - -Actually, STRING need not be a string; any possible modeline element -is okay. See `modeline-format'.") - -;; Used by C code (lookup-key and friends) but defined here. -(defvar minor-mode-map-alist nil - "Alist of keymaps to use for minor modes. -Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read -key sequences and look up bindings iff VARIABLE's value is non-nil. -If two active keymaps bind the same key, the keymap appearing earlier -in the list takes precedence.") - -(make-face 'modeline-mousable-minor-mode - "Face for mousable minor-mode strings in the modeline.") -(set-face-parent 'modeline-mousable-minor-mode 'modeline-mousable nil - '(default)) -(when (featurep 'window-system) - (set-face-foreground 'modeline-mousable-minor-mode - '(((default color x) . "green4") - ((default color x) . "forestgreen") - ((default color mswindows) . "green4") - ((default color mswindows) . "forestgreen")) - 'global)) - -(defvar modeline-mousable-minor-mode-extent (make-extent nil nil) - ;; alliteration at its finest. - "Extent managing the mousable minor mode modeline strings.") -(set-extent-face modeline-mousable-minor-mode-extent - 'modeline-mousable-minor-mode) - -;; This replaces the idiom -;; -;; (or (assq 'isearch-mode minor-mode-alist) -;; (setq minor-mode-alist -;; (purecopy -;; (append minor-mode-alist -;; '((isearch-mode isearch-mode)))))) - -(defun add-minor-mode (toggle name &optional keymap after toggle-fun) - "Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'. - -TOGGLE is a symbol whose value as a variable specifies whether the -minor mode is active. - -NAME is the name that should appear in the modeline. It should either -be a string beginning with a space, or a symbol with a similar string -as its value. - -KEYMAP is a keymap to make active when the minor mode is active. - -AFTER is the toggling symbol used for another minor mode. If AFTER is -non-nil, then it is used to position the new mode in the minor-mode -alists. - -TOGGLE-FUN specifies an interactive function that is called to toggle -the mode on and off; this affects what happens when button2 is pressed -on the mode, and when button3 is pressed somewhere in the list of -modes. If TOGGLE-FUN is nil and TOGGLE names an interactive function, -TOGGLE is used as the toggle function. - -Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)" - (let* ((add-elt #'(lambda (elt sym) - (let (place) - (cond ((null after) ; add to front - (push elt (symbol-value sym))) - ((and (not (eq after t)) - (setq place (memq (assq after - (symbol-value sym)) - (symbol-value sym)))) - (push elt (cdr place))) - (t - (set sym (append (symbol-value sym) - (list elt)))))) - (symbol-value sym))) - el toggle-keymap) - (if toggle-fun - (check-argument-type 'commandp toggle-fun) - (when (commandp toggle) - (setq toggle-fun toggle))) - (when (and toggle-fun name) - (setq toggle-keymap (make-sparse-keymap - (intern (concat "modeline-minor-" - (symbol-name toggle) - "-map")))) - (define-key toggle-keymap 'button2 - ;; defeat the DUMB-ASS byte-compiler, which tries to - ;; expand the macro at compile time and fucks up. - (eval '(make-modeline-command-wrapper toggle-fun))) - (put toggle 'modeline-toggle-function toggle-fun)) - (when name - (let ((hacked-name - (if toggle-keymap - (cons (let ((extent (make-extent nil nil))) - (set-extent-keymap extent toggle-keymap) - (set-extent-property - extent 'help-echo - (concat "button2 turns off " - (if (symbolp toggle-fun) - (symbol-name toggle-fun) - (symbol-name toggle)))) - extent) - (cons modeline-mousable-minor-mode-extent name)) - name))) - (if (setq el (assq toggle minor-mode-alist)) - (setcdr el (list hacked-name)) - (funcall add-elt - (list toggle hacked-name) - 'minor-mode-alist)))) - (when keymap - (if (setq el (assq toggle minor-mode-map-alist)) - (setcdr el keymap) - (funcall add-elt - (cons toggle keymap) - 'minor-mode-map-alist))))) - -;; #### TODO: Add `:menu-tag' keyword to add-minor-mode. Or create a -;; separate function to manage the minor mode menu. - -;(put 'abbrev-mode :menu-tag "Abbreviation Expansion") -(add-minor-mode 'abbrev-mode " Abbrev") -;; only when visiting a file... -(add-minor-mode 'overwrite-mode 'overwrite-mode) -;(put 'auto-fill-function :menu-tag "Auto Fill") -(add-minor-mode 'auto-fill-function " Fill" nil nil 'auto-fill-mode) - -;(put 'defining-kbd-macro :menu-tag "Keyboard Macro") -(add-minor-mode 'defining-kbd-macro " Def" nil nil - (lambda () - (interactive) - (if defining-kbd-macro - (progn - ;; #### This means to disregard the last event. - ;; It is needed because the last recorded - ;; event is usually the mouse event that - ;; invoked the menu item (and this function), - ;; and having it in the macro causes problems. - (zap-last-kbd-macro-event) - (end-kbd-macro nil)) - (start-kbd-macro nil)))) - -(defun modeline-minor-mode-menu (event) - "The menu that pops up when you press `button3' inside the -parentheses on the modeline." - (interactive "e") - (save-excursion - (set-buffer (event-buffer event)) - (popup-menu-and-execute-in-window - (cons - "Minor Mode Toggles" - (sort - (delq nil (mapcar - #'(lambda (x) - (let* ((toggle-sym (car x)) - (toggle-fun (or (get toggle-sym - 'modeline-toggle-function) - (and (commandp toggle-sym) - toggle-sym))) - (menu-tag (symbol-name (if (symbolp toggle-fun) - toggle-fun - toggle-sym)) - ;; Here a function should - ;; maybe be invoked to - ;; beautify the symbol's - ;; menu appearance. - )) - (and toggle-fun - (vector menu-tag - toggle-fun - ;; The following two are wrong - ;; because of possible name - ;; clashes. - ;:active (get toggle-sym :active t) - ;:included (get toggle-sym :included t) - :style 'toggle - :selected (and (boundp toggle-sym) - toggle-sym))))) - minor-mode-alist)) - (lambda (e1 e2) - (string< (aref e1 0) (aref e2 0))))) - event))) - -(defvar modeline-minor-mode-map (make-sparse-keymap 'modeline-minor-mode-map) - "Keymap consulted for mouse-clicks on the minor-mode modeline list.") -(define-key modeline-minor-mode-map 'button3 'modeline-minor-mode-menu) - -(defvar modeline-minor-mode-extent (make-extent nil nil) - "Extent covering the minor mode modeline strings.") -(set-extent-face modeline-minor-mode-extent 'modeline-mousable) -(set-extent-keymap modeline-minor-mode-extent modeline-minor-mode-map) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Other ;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun modeline-buffers-menu (event) - (interactive "e") - (popup-menu-and-execute-in-window - '("Buffers Popup Menu" - :filter buffers-menu-filter - ["List All Buffers" list-buffers t] - "--" - ) - event)) - -(defvar modeline-buffer-id-left-map - (make-sparse-keymap 'modeline-buffer-id-left-map) -"Keymap consulted for mouse-clicks on the left half of the buffer-id string.") - -(defvar modeline-buffer-id-right-map - (make-sparse-keymap 'modeline-buffer-id-right-map) -"Keymap consulted for mouse-clicks on the right half of the buffer-id string.") - -(define-key modeline-buffer-id-left-map 'button2 'mouse-unbury-buffer) -(define-key modeline-buffer-id-right-map 'button2 'mouse-bury-buffer) -(define-key modeline-buffer-id-left-map 'button3 'modeline-buffers-menu) -(define-key modeline-buffer-id-right-map 'button3 'modeline-buffers-menu) - -(make-face 'modeline-buffer-id - "Face for the buffer ID string in the modeline.") -(set-face-parent 'modeline-buffer-id 'modeline nil '(default)) -(when (featurep 'window-system) - (set-face-foreground 'modeline-buffer-id - '(((default color x) . "blue4") - ((default color mswindows) . "blue4")) - 'global)) -(when (featurep 'x) - (set-face-font 'modeline-buffer-id [bold-italic] nil '(default mono x)) - (set-face-font 'modeline-buffer-id [bold-italic] nil '(default grayscale x))) -(when (featurep 'tty) - (set-face-font 'modeline-buffer-id [bold-italic] nil '(default tty))) - -(defvar modeline-buffer-id-extent (make-extent nil nil) - "Extent covering the whole of the buffer-id string.") -(set-extent-face modeline-buffer-id-extent 'modeline-buffer-id) - -(defvar modeline-buffer-id-left-extent (make-extent nil nil) -"Extent covering the left half of the buffer-id string.") -(set-extent-keymap modeline-buffer-id-left-extent - modeline-buffer-id-left-map) -(set-extent-property modeline-buffer-id-left-extent 'help-echo - "button2 cycles to the previous buffer") - -(defvar modeline-buffer-id-right-extent (make-extent nil nil) -"Extent covering the right half of the buffer-id string.") -(set-extent-keymap modeline-buffer-id-right-extent - modeline-buffer-id-right-map) -(set-extent-property modeline-buffer-id-right-extent 'help-echo - "button2 cycles to the next buffer") - -(defconst modeline-buffer-identification - (list (cons modeline-buffer-id-left-extent (purecopy "XEmacs%N:")) - ; this used to be "XEmacs:" - (cons modeline-buffer-id-right-extent (purecopy " %17b"))) - "Modeline control for identifying the buffer being displayed. -Its default value is \"XEmacs: %17b\" (NOT!). Major modes that edit things -other than ordinary files may change this (e.g. Info, Dired,...)") -(make-variable-buffer-local 'modeline-buffer-identification) - -;; These are for the sake of minor mode menu. #### All of this is -;; kind of dirty. `add-minor-mode' started out as a simple substitute -;; for (or (assq ...) ...) FSF stuff, but now is used for all kind of -;; stuff. There should perhaps be a separate function to add toggles -;; to the minor-mode-menu. -(add-minor-mode 'line-number-mode "") -(add-minor-mode 'column-number-mode "") - -(defconst modeline-process nil - "Modeline control for displaying info on process status. -Normally nil in most modes, since there is no process to display.") -(make-variable-buffer-local 'modeline-process) - -(defvar modeline-modified-map (make-sparse-keymap 'modeline-modified-map) - "Keymap consulted for mouse-clicks on the modeline-modified string.") -(define-key modeline-modified-map 'button2 - (make-modeline-command-wrapper 'modeline-toggle-read-only)) - -(defvar modeline-modified-extent (make-extent nil nil) - "Extent covering the modeline-modified string.") -(set-extent-face modeline-modified-extent 'modeline-mousable) -(set-extent-keymap modeline-modified-extent modeline-modified-map) -(set-extent-property modeline-modified-extent 'help-echo - "button2 toggles the buffer's read-only status") - -(defconst modeline-modified (purecopy '("--%1*%1+-")) - "Modeline control for displaying whether current buffer is modified.") -(make-variable-buffer-local 'modeline-modified) - -(defvar modeline-narrowed-map (make-sparse-keymap 'modeline-narrowed-map) - "Keymap consulted for mouse-clicks on the modeline-narrowed string.") -(define-key modeline-narrowed-map 'button2 - (make-modeline-command-wrapper 'widen)) - -(defvar modeline-narrowed-extent (make-extent nil nil) - "Extent covering the modeline-narrowed string.") -(set-extent-face modeline-narrowed-extent 'modeline-mousable) -(set-extent-keymap modeline-narrowed-extent modeline-narrowed-map) -(set-extent-property modeline-narrowed-extent 'help-echo - "button2 widens the buffer") - -(setq-default - modeline-format - (list - (purecopy "") - (cons modeline-modified-extent 'modeline-modified) - (cons modeline-buffer-id-extent 'modeline-buffer-identification) - (purecopy " ") - 'global-mode-string - (purecopy " %[(") - (cons modeline-minor-mode-extent (list "" 'mode-name 'minor-mode-alist)) - (cons modeline-narrowed-extent "%n") - 'modeline-process - (purecopy ")%]----") - (purecopy '(line-number-mode "L%l--")) - (purecopy '(column-number-mode "C%c--")) - (purecopy '(-3 . "%p")) - (purecopy "-%-"))) - -;;; Added for XEmacs 20.3. Provide wrapper for vc since it may not always be -;;; present, and its symbols are not visible this early in the dump if it -;;; is. - -(defun modeline-toggle-read-only () - "Change whether this buffer is visiting its file read-only. -With arg, set read-only iff arg is positive. -This function is designed to be called when the read-only indicator on the -modeline is clicked. It will call `vc-toggle-read-only' if available, -otherwise it will call the usual `toggle-read-only'." - (interactive) - (if (fboundp 'vc-toggle-read-only) - (vc-toggle-read-only) - (toggle-read-only))) - -;;; modeline.el ends here diff --git a/lisp/mouse.el b/lisp/mouse.el deleted file mode 100644 index 5bd4db7..0000000 --- a/lisp/mouse.el +++ /dev/null @@ -1,1529 +0,0 @@ -;;; mouse.el --- window system-independent mouse support. - -;; Copyright (C) 1988, 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: mouse, dumped - -;; 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. Almost completely divergent. - -;;; Commentary: - -;; This file is dumped with XEmacs (when window system support is compiled in). - -;;; Code: - -(provide 'mouse) - -(global-set-key 'button1 'mouse-track) -(global-set-key '(shift button1) 'mouse-track-adjust) -(global-set-key '(control button1) 'mouse-track-insert) -(global-set-key '(control shift button1) 'mouse-track-delete-and-insert) -(global-set-key '(meta button1) 'mouse-track-do-rectangle) - -;; drops are now handled in dragdrop.el (ograf@fga.de) - -;; enable drag regions (ograf@fga.de) -;; if button2 is dragged from within a region, this becomes a drop -;; -;; this must be changed to the new api -(if (featurep '(or offix cde mswindows)) - (global-set-key 'button2 'mouse-drag-or-yank) - (global-set-key 'button2 'mouse-yank)) - -(defgroup mouse nil - "Window system-independent mouse support." - :group 'editing) - -(defcustom mouse-track-rectangle-p nil - "*If true, then dragging out a region with the mouse selects rectangles -instead of simple start/end regions." - :type 'boolean - :group 'mouse) - -(defcustom mouse-yank-at-point nil - "*If non-nil, the function `mouse-yank' will yank text at the cursor location. -Otherwise, the cursor will be moved to the location of the pointer click before -text is inserted." - :type 'boolean - :group 'mouse) - -(defcustom mouse-highlight-text 'context - "*Choose the default double-click highlighting behavior. -If set to `context', double-click will highlight words when the mouse - is at a word character, or a symbol if the mouse is at a symbol - character. -If set to `word', double-click will always attempt to highlight a word. -If set to `symbol', double-click will always attempt to highlight a - symbol (the default behavior in previous XEmacs versions)." - :type '(choice (const context) - (const word) - (const symbol)) - :group 'mouse) - -(defvar mouse-yank-function 'mouse-consolidated-yank - "Function that is called upon by `mouse-yank' to actually insert text.") - -(defun mouse-consolidated-yank () - (interactive) - (case (device-type) - (x (x-yank-function)) - (tty (yank)) - (otherwise (yank)))) - - -(defun mouse-select () - "Select Emacs window the mouse is on." - (interactive "@")) - -(defun mouse-delete-window () - "Delete the Emacs window the mouse is on." - (interactive "@") - (delete-window)) - -(defun mouse-keep-one-window () - "Select Emacs window mouse is on, then kill all other Emacs windows." - (interactive "@") - (delete-other-windows)) - -(defun mouse-select-and-split () - "Select Emacs window mouse is on, then split it vertically in half." - (interactive "@") - (split-window-vertically nil)) - -(defun mouse-set-point (event) - "Select Emacs window mouse is on, and move point to mouse position." - (interactive "@e") - (let ((window (event-window event)) - (pos (event-point event)) - (close-pos (event-closest-point event))) - (or window (error "not in a window")) - (select-window window) - (if (and pos (> pos 0)) - ;; If the event was over a text char, it's easy. - (goto-char (max (min pos (point-max)) (point-min))) - (if (and close-pos (> close-pos 0)) - (goto-char (max (min close-pos (point-max)) (point-min))) - ;; When the event occurs outside of the frame directly to the - ;; left or right of a modeline, close-point is nil, but - ;; event-over-modeline is also nil. That will drop us to this - ;; point. So instead of erroring, just return nil. - nil)))) - -(defun mouse-yank (event) - "Paste text with the mouse. -If the variable `mouse-yank-at-point' is nil, then pasting occurs at the -location of the click; otherwise, pasting occurs at the current cursor -location." - (interactive "e") - (and (not mouse-yank-at-point) - (mouse-set-point event)) - (funcall mouse-yank-function)) - -(defun click-inside-extent-p (click extent) - "Return non-nil if the button event is within the primary selection-extent. -Return nil otherwise." - ;; stig@hackvan.com - (let ((ewin (event-window click)) - (epnt (event-point click))) - (and ewin - epnt - extent - (eq (window-buffer ewin) - (extent-object extent)) - (extent-start-position extent) - (> epnt (extent-start-position extent)) - (> (extent-end-position extent) epnt)))) - -(defun click-inside-selection-p (click) - (or (click-inside-extent-p click primary-selection-extent) - (click-inside-extent-p click zmacs-region-extent) - )) - -(defun point-inside-extent-p (extent) - "Return t if point is within the bounds of the primary selection extent. -Return t is point is at the end position of the extent. -Return nil otherwise." - ;; stig@hackvan.com - (and extent - (eq (current-buffer) - (extent-object extent)) - (> (point) (extent-start-position extent)) - (>= (extent-end-position extent) (point)))) - -(defun point-inside-selection-p () - ;; by Stig@hackvan.com - (or (point-inside-extent-p primary-selection-extent) - (point-inside-extent-p zmacs-region-extent))) - -(defun mouse-drag-or-yank (event) - "Either drag or paste the current selection. -If the variable `mouse-yank-at-point' is non-nil, -move the cursor to the location of the click before pasting. -This functions has to be improved. Currently it is just a (working) test." - ;; by Oliver Graf - (interactive "e") - (if (click-inside-extent-p event zmacs-region-extent) - ;; okay, this is a drag - (cond ((featurep 'offix) - (offix-start-drag-region event - (extent-start-position zmacs-region-extent) - (extent-end-position zmacs-region-extent))) - ((featurep 'cde) - ;; should also work with CDE - (cde-start-drag-region event - (extent-start-position zmacs-region-extent) - (extent-end-position zmacs-region-extent))) - (t (error "No offix or CDE support compiled in"))) - ;; no drag, call region-funct - (and (not mouse-yank-at-point) - (mouse-set-point event)) - (funcall mouse-yank-function)) - ) - -(defun mouse-eval-sexp (click force-window) - "Evaluate the sexp under the mouse. Usually, this is the last sexp before -the click, but if you click on a left paren, then it is the sexp beginning -with the paren that is evaluated. Also, since strings evaluate to themselves, -they're fed to re-search-forward and the matched region is highlighted until -the mouse button is released. - -Perhaps the most useful thing about this function is that the evaluation of -the expression which is clicked upon is relative not to the window where you -click, but to the current window and the current position of point. Thus, -you can use `mouse-eval-sexp' to interactively test code that acts upon a -buffer...something you cannot do with the standard `eval-last-sexp' function. -It's also fantastic for debugging regular expressions." - ;; by Stig@hackvan.com - (interactive "e\nP") - (let (exp val result-str) - (setq exp (save-window-excursion - (save-excursion - (mouse-set-point click) - (save-excursion - (or (looking-at "(") (forward-sexp -1)) - (read (point-marker)))))) - (cond ((stringp exp) - (if (setq val (re-search-forward exp nil t)) - (let* ((oo (make-extent (match-beginning 0) (match-end 0)))) - (set-extent-face oo 'highlight) - (set-extent-priority oo 1000) - ;; wait for button release... - (setq unread-command-event (next-command-event)) - (delete-extent oo)) - (message "Regex \"%s\" not found" exp) - (ding nil 'quiet))) - (t (setq val (if (fboundp 'eval-interactive) - (eval-interactive exp) - (eval exp))))) - (setq result-str (prin1-to-string val)) - ;; #### -- need better test - (if (and (not force-window) - (<= (length result-str) (window-width (selected-window)))) - (message "%s" result-str) - (with-output-to-temp-buffer "*Mouse-Eval*" - (condition-case nil - (pprint val) - (error (prin1 val)))) - ))) - -(defun mouse-line-length (event) - "Print the length of the line indicated by the pointer." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (message "Line length: %d" (- (point-at-eol) (point-at-bol)))) - (sleep-for 1)) - -(defun mouse-set-mark (event) - "Select Emacs window mouse is on, and set mark at mouse position. -Display cursor at that position for a second." - (interactive "@e") - (let ((point-save (point))) - (unwind-protect - (progn (mouse-set-point event) - (push-mark nil t) - (sit-for 1)) - (goto-char point-save)))) - -(defun mouse-scroll (event) - "Scroll point to the mouse position." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (recenter 0) - (scroll-right (event-x event)))) - -(defun mouse-del-char (event) - "Delete the char pointed to by the mouse." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (delete-char 1 nil))) - -(defun mouse-kill-line (event) - "Kill the line pointed to by the mouse." - (interactive "@e") - (save-excursion - (mouse-set-point event) - (kill-line nil))) - -(defun mouse-bury-buffer (event) - "Bury the buffer pointed to by the mouse, thus selecting the next one." - (interactive "e") - (save-selected-window - (select-window (event-window event)) - (bury-buffer))) - -(defun mouse-unbury-buffer (event) - "Unbury and select the most recently buried buffer." - (interactive "e") - (save-selected-window - (select-window (event-window event)) - (let* ((bufs (buffer-list)) - (entry (1- (length bufs))) - val) - (while (not (setq val (nth entry bufs) - val (and (/= (aref (buffer-name val) 0) - ? ) - val))) - (setq entry (1- entry))) - (switch-to-buffer val)))) - -(defun narrow-window-to-region (m n) - "Narrow window to region between point and last mark" - (interactive "r") - (save-excursion - (save-restriction - (if (eq (selected-window) (next-window)) - (split-window)) - (goto-char m) - (recenter 0) - (if (eq (selected-window) - (if (zerop (minibuffer-depth)) - (next-window))) - () - (shrink-window (- (- (window-height) (count-lines m n)) 1)))))) - -(defun mouse-window-to-region (event) - "Narrow window to region between cursor and mouse pointer." - (interactive "@e") - (let ((point-save (point))) - (unwind-protect - (progn (mouse-set-point event) - (push-mark nil t) - (sit-for 1)) - (goto-char point-save) - (narrow-window-to-region (region-beginning) (region-end))))) - -(defun mouse-ignore () - "Don't do anything." - (interactive)) - - -;;; mouse/selection tracking -;;; generalized mouse-track - -(defvar default-mouse-track-normalize-point-function - 'default-mouse-track-normalize-point - "Function called to normalize position of point. -Called with two arguments: TYPE depends on the number of times that the -mouse has been clicked and is a member of `default-mouse-track-type-list', -FORWARDP determines the direction in which the point should be moved.") - -(defvar mouse-track-down-hook nil - "Function or functions called when the user presses the mouse. -This hook is invoked by `mouse-track'; thus, it will not be called -for any buttons with a different binding. The functions will be -called with two arguments: the button-press event and a click -count (see `mouse-track-click-hook'). - -If any function returns non-nil, the remaining functions will not be -called. - -Note that most applications should take action when the mouse is -released, not when it is pressed.'") - -(defvar mouse-track-drag-hook nil - "Function or functions called when the user drags the mouse. -This hook is invoked by `mouse-track'; thus, it will not be called -for any buttons with a different binding. The functions will be -called with three arguments: the mouse-motion event, a click -count (see `mouse-track-click-hook'), and whether the call to -this hook occurred as a result of a drag timeout (see -`mouse-track-scroll-delay'). - -If any function returns non-nil, the remaining functions will not be -called. - -Note that no calls to this function will be made until the user -initiates a drag (i.e. moves the mouse more than a certain -threshold in either the X or the Y direction, as defined by -`mouse-track-x-threshold' and `mouse-track-y-threshold'). - -See also `mouse-track-drag-up-hook'.") - -(defvar mouse-track-drag-up-hook nil - "Function or functions called when the user finishes a drag. -This hook is invoked by `mouse-track'; thus, it will not be called -for any buttons with a different binding. The functions will be -called with two arguments: the button-press event and a click -count (see `mouse-track-click-hook'). - -If any function returns non-nil, the remaining functions will not be -called. - -Note that this hook will not be invoked unless the user has -initiated a drag, i.e. moved the mouse more than a certain threshold -(see `mouse-track-drag-hook'). When this function is invoked, -`mouse-track-drag-hook' will have been invoked at least once. - -See also `mouse-track-click-hook'.") - -(defvar mouse-track-click-hook nil - "Function or functions called when the user clicks the mouse. -`Clicking' means pressing and releasing the mouse without having -initiated a drag (i.e. without having moved more than a certain -threshold -- see `mouse-track-drag-hook'). - -This hook is invoked by `mouse-track'; thus, it will not be called -for any buttons with a different binding. The functions will be -called with two arguments: the button-release event and a click -count, which specifies the number of times that the mouse has been -clicked in a series of clicks, each of which is separated by at most -`mouse-track-multi-click-time'. This can be used to implement actions -that are called on double clicks, triple clicks, etc. - -If any function returns non-nil, the remaining functions will not be -called. - -See also `mouse-track-drag-up-hook.") - -(defvar mouse-track-up-hook nil - "Function or functions called when the user releases the mouse. -This hook is invoked by `mouse-track'; thus, it will not be called -for any buttons with a different binding. The functions will be -called with two arguments: the button-release event and a click -count (see `mouse-track-click-hook'). - -For many applications, it is more appropriate to use one or both -of `mouse-track-click-hook' and `mouse-track-drag-up-hook'.") - -(defvar mouse-track-cleanup-hook nil - "Function or functions called when `mouse-track' terminates. -This hook will be called in all circumstances, even upon a -non-local exit out of `mouse-track', and so is useful for -doing cleanup work such as removing extents that may have -been created during the operation of `mouse-track'. - -Unlike all of the other mouse-track hooks, this is a \"normal\" -hook: the hook functions are called with no arguments, and -all hook functions are called regardless of their return -values.") - -(defcustom mouse-track-multi-click-time 400 - "*Maximum number of milliseconds allowed between clicks for a multi-click. -See `mouse-track-click-hook'." - :type 'integer - :group 'mouse) - -(defcustom mouse-track-scroll-delay 100 - "Maximum of milliseconds between calls to `mouse-track-drag-hook'. -If the user is dragging the mouse (i.e. the button is held down and -a drag has been initiated) and does not move the mouse for this many -milliseconds, the hook will be called with t as the value of the -WAS-TIMEOUT parameter. This can be used to implement scrolling -in a selection when the user drags the mouse out the window it -was in. - -A value of nil disables the timeout feature." - :type '(choice integer (const :tag "Disabled" nil)) - :group 'mouse) - -(defvar mouse-track-x-threshold '(face-width 'default) - "Minimum number of pixels in the X direction for a drag to be initiated. -If the mouse is moved more than either the X or Y threshold while the -button is held down (see also `mouse-track-y-threshold'), then a drag -is initiated; otherwise the gesture is considered to be a click. -See `mouse-track'. - -The value should be either a number of a form to be evaluated to -produce a number.") - -(defvar mouse-track-y-threshold '(face-height 'default) - "Minimum number of pixels in the Y direction for a drag to be initiated. -If the mouse is moved more than either the X or Y threshold while the -button is held down (see also `mouse-track-x-threshold'), then a drag -is initiated; otherwise the gesture is considered to be a click. -See `mouse-track'. - -The value should be either a number of a form to be evaluated to -produce a number.") - -;; these variables are private to mouse-track. -(defvar mouse-track-up-time nil) -(defvar mouse-track-up-x nil) -(defvar mouse-track-up-y nil) -(defvar mouse-track-timeout-id nil) -(defvar mouse-track-click-count nil) - -(defun mouse-track-set-timeout (event) - (if mouse-track-timeout-id - (disable-timeout mouse-track-timeout-id)) - (if mouse-track-scroll-delay - (setq mouse-track-timeout-id - (add-timeout (/ mouse-track-scroll-delay 1000.0) - 'mouse-track-scroll-undefined - (copy-event event))))) - -(defun mouse-track-run-hook (hook event &rest args) - ;; ugh, can't use run-hook-with-args-until-success because we have - ;; to get the value using symbol-value-in-buffer. Doing a - ;; save-excursion/set-buffer is wrong because the hook might want to - ;; change the buffer, but just doing a set-buffer is wrong because - ;; the hook might not want to change the buffer. - ;; #### What we need here is a Lisp interface to - ;; run_hook_with_args_in_buffer. Here is a poor man's version. - (let ((buffer (event-buffer event))) - (and mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer)) - (when buffer - (let ((value (symbol-value-in-buffer hook buffer nil))) - (if (and (listp value) (not (eq (car value) 'lambda))) - ;; List of functions. - (let (retval) - (while (and value (null retval)) - ;; Found `t': should process default value. We could - ;; splice it into the buffer-local value, but that - ;; would cons, which is not a good thing for - ;; mouse-track hooks. - (if (eq (car value) t) - (let ((global (default-value hook))) - (if (and (listp global) (not (eq (car global) 'lambda))) - ;; List of functions. - (while (and global - (null (setq retval - (apply (car global) event args)))) - (pop global)) - ;; lambda - (setq retval (apply (car global) event args)))) - (setq retval (apply (car value) event args))) - (pop value)) - retval) - ;; lambda - (apply value event args)))))) - -(defun mouse-track-scroll-undefined (random) - ;; the old implementation didn't actually define this function, - ;; and in normal use it won't ever be called because the timeout - ;; will either be removed before it fires or will be picked off - ;; with next-event and not dispatched. However, if you're - ;; attempting to debug a click-hook (which is pretty damn - ;; difficult to do), this function may get called. -) - -(defun mouse-track (event) - "Make a selection with the mouse. This should be bound to a mouse button. -The behavior of XEmacs during mouse selection is customizable using various -hooks and variables: see `mouse-track-click-hook', `mouse-track-drag-hook', -`mouse-track-drag-up-hook', `mouse-track-down-hook', `mouse-track-up-hook', -`mouse-track-cleanup-hook', `mouse-track-multi-click-time', -`mouse-track-scroll-delay', `mouse-track-x-threshold', and -`mouse-track-y-threshold'. - -Default handlers are provided to implement standard selecting/positioning -behavior. You can explicitly request this default behavior, and override -any custom-supplied handlers, by using the function `mouse-track-default' -instead of `mouse-track'. - -Default behavior is as follows: - -If you click-and-drag, the selection will be set to the region between the -point of the initial click and the point at which you release the button. -These positions need not be ordered. - -If you click-and-release without moving the mouse, then the point is moved -and the selection is disowned (there will be no selection owner). The mark -will be set to the previous position of point. - -If you double-click, the selection will extend by symbols instead of by -characters. If you triple-click, the selection will extend by lines. - -If you drag the mouse off the top or bottom of the window, you can select -pieces of text which are larger than the visible part of the buffer; the -buffer will scroll as necessary. - -The selected text becomes the current X Selection. The point will be left -at the position at which you released the button, and the mark will be left -at the initial click position." - (interactive "e") - (let ((mouse-down t) - (xthresh (eval mouse-track-x-threshold)) - (ythresh (eval mouse-track-y-threshold)) - (orig-x (event-x-pixel event)) - (orig-y (event-y-pixel event)) - (buffer (event-buffer event)) - (mouse-grabbed-buffer (event-buffer event)) - mouse-moved) - (if (or (not mouse-track-up-x) - (not mouse-track-up-y) - (not mouse-track-up-time) - (> (- (event-timestamp event) mouse-track-up-time) - mouse-track-multi-click-time) - (> (abs (- mouse-track-up-x orig-x)) xthresh) - (> (abs (- mouse-track-up-y orig-y)) ythresh)) - (setq mouse-track-click-count 1) - (setq mouse-track-click-count (1+ mouse-track-click-count))) - (if (not (event-window event)) - (error "Not over a window.")) - (mouse-track-run-hook 'mouse-track-down-hook - event mouse-track-click-count) - (unwind-protect - (while mouse-down - (setq event (next-event event)) - (cond ((motion-event-p event) - (if (and (not mouse-moved) - (or (> (abs (- (event-x-pixel event) orig-x)) - xthresh) - (> (abs (- (event-y-pixel event) orig-y)) - ythresh))) - (setq mouse-moved t)) - (if mouse-moved - (mouse-track-run-hook 'mouse-track-drag-hook - event mouse-track-click-count nil)) - (mouse-track-set-timeout event)) - ((and (timeout-event-p event) - (eq (event-function event) - 'mouse-track-scroll-undefined)) - (if mouse-moved - (mouse-track-run-hook 'mouse-track-drag-hook - (event-object event) mouse-track-click-count t)) - (mouse-track-set-timeout (event-object event))) - ((button-release-event-p event) - (setq mouse-track-up-time (event-timestamp event)) - (setq mouse-track-up-x (event-x-pixel event)) - (setq mouse-track-up-y (event-y-pixel event)) - (setq mouse-down nil) - (mouse-track-run-hook 'mouse-track-up-hook - event mouse-track-click-count) - (if mouse-moved - (mouse-track-run-hook 'mouse-track-drag-up-hook - event mouse-track-click-count) - (mouse-track-run-hook 'mouse-track-click-hook - event mouse-track-click-count))) - ((or (key-press-event-p event) - (and (misc-user-event-p event) - (eq (event-function event) 'cancel-mode-internal))) - (error "Selection aborted")) - (t - (dispatch-event event)))) - ;; protected - (if mouse-track-timeout-id - (disable-timeout mouse-track-timeout-id)) - (setq mouse-track-timeout-id nil) - (and buffer - (save-excursion - (set-buffer buffer) - (run-hooks 'mouse-track-cleanup-hook)))))) - - -;;;;;;;;;;;; default handlers: new version of mouse-track - -(defvar default-mouse-track-type nil) -(defvar default-mouse-track-type-list '(char word line)) -(defvar default-mouse-track-window nil) -(defvar default-mouse-track-extent nil) -(defvar default-mouse-track-adjust nil) -(defvar default-mouse-track-min-anchor nil) -(defvar default-mouse-track-max-anchor nil) -(defvar default-mouse-track-result nil) -(defvar default-mouse-track-down-event nil) - -;; D. Verna Feb. 17 1998 -;; This function used to assume that when (event-window event) differs from -;; window, we have to scroll. This is WRONG, for instance when there are -;; toolbars on the side, in which case window-event returns nil. -(defun default-mouse-track-set-point-in-window (event window) - (if (event-over-modeline-p event) - nil ;; Scroll - ;; Not over a modeline - (if (eq (event-window event) window) - (let ((p (event-closest-point event))) - (if (or (not p) (not (pos-visible-in-window-p p window))) - nil ;; Scroll - (mouse-set-point event) - t)) - ;; Not over a modeline, not the same window. Check if the Y position - ;; is still overlapping the original window. - (let* ((edges (window-pixel-edges window)) - (row (event-y-pixel event)) - (text-start (nth 1 edges)) - (text-end (+ (nth 3 edges)))) - (if (or (< row text-start) - (> row text-end)) - nil ;; Scroll - ;; The Y pos in overlapping the original window. Check however if - ;; the position is really visible, because there could be a - ;; scrollbar or a modeline at this place. - ;; Find the mean line height (height / lines nb), and approximate - ;; the line number for Y pos. - (select-window window) - (let ((line (/ (* (- row text-start) (window-height)) - (- text-end text-start)))) - (if (not (save-excursion - (goto-char (window-start)) - (pos-visible-in-window-p - (point-at-bol (+ 1 line))))) - nil ;; Scroll - ;; OK, we can go to that position - (goto-char (window-start)) - (forward-line line) - ;; On the right side: go to end-of-line. - (when (>= (event-x-pixel event) (nth 2 edges)) - (goto-char (point-at-eol))) - t)))) - ))) - - -(defun default-mouse-track-scroll-and-set-point (event window) - (select-window window) - (let ((edges (window-pixel-edges window)) - (row (event-y-pixel event)) - (height (face-height 'default))) - (cond ((< (abs (- row (nth 1 edges))) (abs (- row (nth 3 edges)))) - ;; closer to window's top than to bottom, so move up - (let ((delta (max 1 (/ (- (nth 1 edges) row) height)))) - (condition-case () (scroll-down delta) (error)) - (goto-char (window-start)))) - ((>= (point) (point-max))) - (t - ;; scroll by one line if over the modeline or a clipped line - (let ((delta (if (or (event-over-modeline-p event) - (< row (nth 3 edges))) - 1 - (+ (/ (- row (nth 3 edges)) height) 1))) - (close-pos (event-closest-point event))) - (condition-case () (scroll-up delta) (error)) - (if (and close-pos (pos-visible-in-window-p close-pos)) - (goto-char close-pos) - (goto-char (window-end)) - (vertical-motion delta) - ;; window-end reports the end of the clipped line, even if - ;; scroll-on-clipped-lines is t. compensate. - ;; (If window-end gets fixed this can be removed.) - (if (not (pos-visible-in-window-p (max (1- (point)) - (point-min)))) - (vertical-motion -1)) - (condition-case () (backward-char 1) - (error (end-of-line))))))))) - - -;; This remembers the last position at which the user clicked, for the -;; benefit of mouse-track-adjust (for example, button1; scroll until the -;; position of the click is off the frame; then Sh-button1 to select the -;; new region. -(defvar default-mouse-track-previous-point nil) - -(defun default-mouse-track-set-point (event window) - (if (default-mouse-track-set-point-in-window event window) - nil - (default-mouse-track-scroll-and-set-point event window))) - -(defsubst default-mouse-track-beginning-of-word (symbolp) - (let ((word-constituent (cond ((eq symbolp t) "\\w\\|\\s_\\|\\s'") - ((null symbolp) "\\w") - (t "[^ \t\n]"))) - (white-space "[ \t]")) - (cond ((bobp) nil) - ((looking-at word-constituent) - (backward-char) - (while (and (not (bobp)) (looking-at word-constituent)) - (backward-char)) - (if (or (not (bobp)) (not (looking-at word-constituent))) - (forward-char))) - ((looking-at white-space) - (backward-char) - (while (looking-at white-space) - (backward-char)) - (forward-char))))) - -(defun default-mouse-track-end-of-word (symbolp) - (let ((word-constituent (cond ((eq symbolp t) "\\w\\|\\s_\\|\\s'") - ((null symbolp) "\\w") - (t "[^ \t\n]"))) - (white-space "[ \t]")) - (cond ((looking-at word-constituent) ; word or symbol constituent - (while (looking-at word-constituent) - (forward-char))) - ((looking-at white-space) ; word or symbol constituent - (while (looking-at white-space) - (forward-char)))))) - -;; Decide what will be the SYMBOLP argument to -;; default-mouse-track-{beginning,end}-of-word, according to the -;; syntax of the current character and value of mouse-highlight-text. -(defsubst default-mouse-track-symbolp (syntax) - (cond ((eq mouse-highlight-text 'context) - (eq syntax ?_)) - ((eq mouse-highlight-text 'symbol) - t) - (t - nil))) - -;; Return t if point is at an opening quote character. This is -;; determined by testing whether the syntax of the following character -;; is `string', which will always be true for opening quotes and -;; always false for closing quotes. -(defun default-mouse-track-point-at-opening-quote-p () - (save-excursion - (forward-char 1) - (eq (buffer-syntactic-context) 'string))) - -(defun default-mouse-track-normalize-point (type forwardp) - (cond ((eq type 'word) - ;; trap the beginning and end of buffer errors - (ignore-errors - (setq type (char-syntax (char-after (point)))) - (if forwardp - (if (or (= type ?\() - (and (= type ?\") - (default-mouse-track-point-at-opening-quote-p))) - (goto-char (scan-sexps (point) 1)) - (default-mouse-track-end-of-word - (default-mouse-track-symbolp type))) - (if (or (= type ?\)) - (and (= type ?\") - (not (default-mouse-track-point-at-opening-quote-p)))) - (goto-char (scan-sexps (1+ (point)) -1)) - (default-mouse-track-beginning-of-word - (default-mouse-track-symbolp type)))))) - ((eq type 'line) - (if forwardp (end-of-line) (beginning-of-line))) - ((eq type 'buffer) - (if forwardp (end-of-buffer) (beginning-of-buffer))))) - -(defun default-mouse-track-next-move (min-anchor max-anchor extent) - (let ((anchor (if (<= (point) min-anchor) max-anchor min-anchor))) - (funcall default-mouse-track-normalize-point-function - default-mouse-track-type (> (point) anchor)) - (if (consp extent) - (default-mouse-track-next-move-rect anchor (point) extent) - (if extent - (if (<= anchor (point)) - (set-extent-endpoints extent anchor (point)) - (set-extent-endpoints extent (point) anchor)))))) - -(defun default-mouse-track-next-move-rect (start end extents &optional pad-p) - (if (< end start) - (let ((tmp start)) (setq start end end tmp))) - (cond - ((= start end) ; never delete the last remaining extent - (mapcar 'delete-extent (cdr extents)) - (setcdr extents nil) - (set-extent-endpoints (car extents) start start)) - (t - (let ((indent-tabs-mode nil) ; if pad-p, don't use tabs - (rest extents) - left right last p) - (save-excursion - (save-restriction - (goto-char end) - (setq right (current-column)) - (goto-char start) - (setq left (current-column)) - (if (< right left) - (let ((tmp left)) - (setq left right right tmp) - (setq start (- start (- right left)) - end (+ end (- right left))))) - ;; End may have been set to a value greater than point-max if drag - ;; or movement extends to end of buffer, so reset it. - (setq end (min end (point-max))) - (beginning-of-line) - (narrow-to-region (point) end) - (goto-char start) - (while (and rest (not (eobp))) - (setq p (point)) - (move-to-column right pad-p) - (set-extent-endpoints (car rest) p (point)) - ;; this code used to look at the return value - ;; of forward-line, but that doesn't work because - ;; forward-line has bogus behavior: If you're on - ;; the last line of a buffer but not at the very - ;; end, forward-line will move you to the very - ;; end and return 0 instead of 1, like it should. - ;; the result was frequent infinite loops here, - ;; creating very large numbers of extents at - ;; the same position. There was an N^2 sorting - ;; algorithm in extents.c for extents at a - ;; particular position, and the result was very - ;; bad news. - (forward-line 1) - (if (not (eobp)) - (move-to-column left pad-p)) - (setq last rest - rest (cdr rest))) - (cond (rest - (mapcar 'delete-extent rest) - (setcdr last nil)) - ((not (eobp)) - (while (not (eobp)) - (setq p (point)) - (move-to-column right pad-p) - (let ((e (make-extent p (point)))) - (set-extent-face e (extent-face (car extents))) - (set-extent-priority e (extent-priority (car extents))) - (setcdr last (cons e nil)) - (setq last (cdr last))) - (forward-line 1) - (if (not (eobp)) - (move-to-column left pad-p)) - ))))) - )))) - -(defun default-mouse-track-has-selection-p (buffer) - (and (selection-owner-p) - (extent-live-p primary-selection-extent) - (not (extent-detached-p primary-selection-extent)) - (eq buffer (extent-object primary-selection-extent)))) - -(defun default-mouse-track-anchor (adjust previous-point) - (if adjust - (if (default-mouse-track-has-selection-p (current-buffer)) - (let ((start (extent-start-position primary-selection-extent)) - (end (extent-end-position primary-selection-extent))) - (cond ((< (point) start) end) - ((> (point) end) start) - ((> (- (point) start) (- end (point))) start) - (t end))) - previous-point) - (point))) - -(defun default-mouse-track-maybe-own-selection (pair type) - (let ((start (car pair)) - (end (cdr pair))) - (or (= start end) (push-mark (if (= (point) start) end start))) - (cond (zmacs-regions - (if (= start end) - nil - ;; #### UTTER KLUDGE. - ;; If we don't have this sit-for here, then triple-clicking - ;; will result in the line not being highlighted as it - ;; should. What appears to be happening is this: - ;; - ;; -- each time the button goes down, the selection is - ;; disowned (see comment "remove the existing selection - ;; to unclutter the display", below). - ;; -- this causes a SelectionClear event to be sent to - ;; XEmacs. - ;; -- each time the button goes up except the first, the - ;; selection is owned again. - ;; -- later, XEmacs processes the SelectionClear event. - ;; The selection code attempts to keep track of the - ;; time that it last asserted the selection, and - ;; compare it to the time of the SelectionClear event, - ;; to see if it's a bogus notification or not (as - ;; is the case here). However, for some unknown - ;; reason this doesn't work in the triple-clicking - ;; case, and the selection code bogusly thinks this - ;; SelectionClear event is the real thing. - ;; -- putting the sit-for in causes the pending - ;; SelectionClear events to get processed before - ;; the selection is reasserted, so everything works - ;; out OK. - ;; - ;; Presumably(?) this means there is a weird timing bug - ;; in the selection code, but there's not a chance in hell - ;; that I have the patience to track it down. Blame the - ;; designers of X for fucking everything up so badly. - ;; - ;; This was originally a sit-for 0 but that wasn't - ;; sufficient to make things work. Even this isn't - ;; always sufficient but it seems to give something - ;; approaching a 99% success rate. Making it higher yet - ;; would help guarantee success with the price that the - ;; delay would start to become noticeable. - ;; - (and (eq (console-type) 'x) - (sit-for 0.15 t)) - (zmacs-activate-region))) - ((console-on-window-system-p) - (if (= start end) - (disown-selection type) - (if (consp default-mouse-track-extent) - ;; own the rectangular region - ;; this is a hack - (let ((r default-mouse-track-extent)) - (save-excursion - (set-buffer (get-buffer-create " *rect yank temp buf*")) - (while r - (insert (extent-string (car r)) "\n") - (setq r (cdr r))) - (own-selection (buffer-substring (point-min) (point-max))) - (kill-buffer (current-buffer)))) - (own-selection (cons (set-marker (make-marker) start) - (set-marker (make-marker) end)) - type))))) - (if (and (eq 'x (console-type)) - (not (= start end))) - ;; I guess cutbuffers should do something with rectangles too. - ;; does anybody use them? - (x-store-cutbuffer (buffer-substring start end))))) - -(defun default-mouse-track-deal-with-down-event (click-count) - (let ((event default-mouse-track-down-event)) - (if (null event) nil - (select-frame (event-frame event)) - (let ((adjust default-mouse-track-adjust) - ;; ####When you click on the splash-screen, - ;; event-{closest-,}point can be out of bounds. Should - ;; event-closest-point really be allowed to return a bad - ;; position like that? Maybe pixel_to_glyph_translation - ;; needs to invalidate its cache when the buffer changes. - ;; -dkindred@cs.cmu.edu - (close-pos (save-excursion - (set-buffer (event-buffer event)) - (let ((p (event-closest-point event))) - (and p (min (max p (point-min)) (point-max)))))) - extent previous-point) - - (if (not (event-window event)) - (error "not over window?")) - (setq default-mouse-track-type - (nth (mod (1- click-count) - (length default-mouse-track-type-list)) - default-mouse-track-type-list)) - (setq default-mouse-track-window (event-window event)) - ;; Note that the extent used here is NOT the extent which - ;; ends up as the value of zmacs-region-extent - this one is used - ;; just during mouse-dragging. - (setq default-mouse-track-extent - (make-extent close-pos close-pos (event-buffer event))) - (setq extent default-mouse-track-extent) - (set-extent-face extent 'zmacs-region) - ;; While the selection is being dragged out, give the selection extent - ;; slightly higher priority than any mouse-highlighted extent, so that - ;; the exact endpoints of the selection will be visible while the mouse - ;; is down. Normally, the selection and mouse highlighting have the - ;; same priority, so that conflicts between the two of them are - ;; resolved by the usual size-and-endpoint-comparison method. - (set-extent-priority extent (1+ mouse-highlight-priority)) - (if mouse-track-rectangle-p - (setq default-mouse-track-extent - (list default-mouse-track-extent))) - - (setq previous-point - (if (and adjust - (markerp default-mouse-track-previous-point) - (eq (current-buffer) - (marker-buffer default-mouse-track-previous-point))) - (marker-position default-mouse-track-previous-point) - (point))) - (default-mouse-track-set-point event default-mouse-track-window) - (if (not adjust) - (if (markerp default-mouse-track-previous-point) - (set-marker default-mouse-track-previous-point (point)) - (setq default-mouse-track-previous-point (point-marker)))) - ;; - ;; adjust point to a word or line boundary if appropriate - (let ((anchor (default-mouse-track-anchor adjust previous-point))) - (setq default-mouse-track-min-anchor - (save-excursion (goto-char anchor) - (funcall - default-mouse-track-normalize-point-function - default-mouse-track-type nil) - (point))) - (setq default-mouse-track-max-anchor - (save-excursion (goto-char anchor) - (funcall - default-mouse-track-normalize-point-function - default-mouse-track-type t) - (point)))) - ;; - ;; remove the existing selection to unclutter the display - (if (not adjust) - (cond (zmacs-regions - (zmacs-deactivate-region)) - ((console-on-window-system-p) - (disown-selection))))) - (setq default-mouse-track-down-event nil)))) - -(defun default-mouse-track-down-hook (event click-count) - (setq default-mouse-track-down-event (copy-event event)) - nil) - -(defun default-mouse-track-cleanup-extents-hook () - (remove-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook) - (let ((extent default-mouse-track-extent)) - (if (consp extent) ; rectangle-p - (mapcar 'delete-extent extent) - (if extent - (delete-extent extent))))) - -(defun default-mouse-track-cleanup-hook () - (if zmacs-regions - (funcall 'default-mouse-track-cleanup-extents-hook) - (let ((extent default-mouse-track-extent) - (func #'(lambda (e) - (and (extent-live-p e) - (set-extent-face e 'primary-selection))))) - (add-hook 'pre-command-hook 'default-mouse-track-cleanup-extents-hook) - (if (consp extent) ; rectangle-p - (mapcar func extent) - (if extent - (funcall func extent)))))) - -(defun default-mouse-track-cleanup-extent () - (let ((dead-func - (function (lambda (x) - (or (not (extent-live-p x)) - (extent-detached-p x))))) - (extent default-mouse-track-extent)) - (if (consp extent) - (if (funcall dead-func extent) - (let (newval) - (mapcar (function (lambda (x) - (if (not (funcall dead-func x)) - (setq newval (cons x newval))))) - extent) - (setq default-mouse-track-extent (nreverse newval)))) - (if (funcall dead-func extent) - (setq default-mouse-track-extent nil))))) - -(defun default-mouse-track-drag-hook (event click-count was-timeout) - (default-mouse-track-deal-with-down-event click-count) - (default-mouse-track-set-point event default-mouse-track-window) - (default-mouse-track-cleanup-extent) - (default-mouse-track-next-move default-mouse-track-min-anchor - default-mouse-track-max-anchor - default-mouse-track-extent) - t) - -(defun default-mouse-track-return-dragged-selection (event) - (default-mouse-track-cleanup-extent) - (let ((extent default-mouse-track-extent) - result) - (default-mouse-track-set-point-in-window event default-mouse-track-window) - (default-mouse-track-next-move default-mouse-track-min-anchor - default-mouse-track-max-anchor - extent) - (cond ((consp extent) ; rectangle-p - (let ((first (car extent)) - (last (car (setq extent (nreverse extent))))) - ;; nreverse is destructive so we need to reset this - (setq default-mouse-track-extent extent) - (setq result (cons (extent-start-position first) - (extent-end-position last))) - ;; kludge to fix up region when dragging backwards... - (if (and (/= (point) (extent-start-position first)) - (/= (point) (extent-end-position last)) - (= (point) (extent-end-position first))) - (goto-char (car result))))) - (extent - (setq result (cons (extent-start-position extent) - (extent-end-position extent))))) - ;; Minor kludge: if we're selecting in line-mode, include the - ;; final newline. It's hard to do this in *-normalize-point. - (if (and result (eq default-mouse-track-type 'line)) - (let ((end-p (= (point) (cdr result)))) - (goto-char (cdr result)) - (if (not (eobp)) - (setcdr result (1+ (cdr result)))) - (goto-char (if end-p (cdr result) (car result))))) -;;; ;; Minor kludge sub 2. If in char mode, and we drag the -;;; ;; mouse past EOL, include the newline. -;;; ;; -;;; ;; Major problem: can't easily distinguish between being -;;; ;; just past the last char on a line, and well past it, -;;; ;; to determine whether or not to include it in the region -;;; ;; -;;; (if nil ; (eq default-mouse-track-type 'char) -;;; (let ((after-end-p (and (not (eobp)) -;;; (eolp) -;;; (> (point) (car result))))) -;;; (if after-end-p -;;; (progn -;;; (setcdr result (1+ (cdr result))) -;;; (goto-char (cdr result)))))) - result)) - -(defun default-mouse-track-drag-up-hook (event click-count) - (let ((result (default-mouse-track-return-dragged-selection event))) - (if result - (default-mouse-track-maybe-own-selection result 'PRIMARY))) - t) - -(defun default-mouse-track-click-hook (event click-count) - (default-mouse-track-drag-hook event click-count nil) - (default-mouse-track-drag-up-hook event click-count) - t) - -(add-hook 'mouse-track-down-hook 'default-mouse-track-down-hook) -(add-hook 'mouse-track-drag-hook 'default-mouse-track-drag-hook) -(add-hook 'mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook) -(add-hook 'mouse-track-click-hook 'default-mouse-track-click-hook) -(add-hook 'mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook) - - -;;;;;;;;;;;; other mouse-track stuff (mostly associated with the -;;;;;;;;;;;; default handlers) - -(defun mouse-track-default (event) - "Invoke `mouse-track' with only the default handlers active." - (interactive "e") - (let ((mouse-track-down-hook 'default-mouse-track-down-hook) - (mouse-track-drag-hook 'default-mouse-track-drag-hook) - (mouse-track-drag-up-hook 'default-mouse-track-drag-up-hook) - (mouse-track-click-hook 'default-mouse-track-click-hook) - (mouse-track-cleanup-hook 'default-mouse-track-cleanup-hook)) - (mouse-track event))) - -(defun mouse-track-do-rectangle (event) - "Like `mouse-track' but selects rectangles instead of regions." - (interactive "e") - (let ((mouse-track-rectangle-p t)) - (mouse-track event))) - -(defun mouse-track-adjust (event) - "Extend the existing selection. This should be bound to a mouse button. -The selection will be enlarged or shrunk so that the point of the mouse -click is one of its endpoints. This function in fact behaves fairly -similarly to `mouse-track', but begins by extending the existing selection -(or creating a new selection from the previous text cursor position to -the current mouse position) instead of creating a new, empty selection. - -The mouse-track handlers are run from this command just like from -`mouse-track'. Therefore, do not call this command from a mouse-track -handler!" - (interactive "e") - (let ((default-mouse-track-adjust t)) - (mouse-track event))) - -(defun mouse-track-adjust-default (event) - "Extend the existing selection, using only the default handlers. -This is just like `mouse-track-adjust' but will override any -custom mouse-track handlers that the user may have installed." - (interactive "e") - (let ((default-mouse-track-adjust t)) - (mouse-track-default event))) - -(defvar mouse-track-insert-selected-region nil) - -(defun mouse-track-insert-drag-up-hook (event click-count) - (setq mouse-track-insert-selected-region - (default-mouse-track-return-dragged-selection event))) - -(defun mouse-track-insert (event &optional delete) - "Make a selection with the mouse and insert it at point. -This is exactly the same as the `mouse-track' command on \\[mouse-track], -except that point is not moved; the selected text is immediately inserted -after being selected\; and the selection is immediately disowned afterwards." - (interactive "*e") - (setq mouse-track-insert-selected-region nil) - (let ((mouse-track-drag-up-hook 'mouse-track-insert-drag-up-hook) - (mouse-track-click-hook 'mouse-track-insert-click-hook) - s) - (save-excursion - (save-window-excursion - (mouse-track event) - (if (consp mouse-track-insert-selected-region) - (let ((pair mouse-track-insert-selected-region)) - (setq s (prog1 - (buffer-substring (car pair) (cdr pair)) - (if delete - (kill-region (car pair) (cdr pair))))))))) - (or (null s) (equal s "") (insert s)))) - -(defun mouse-track-insert-click-hook (event click-count) - (default-mouse-track-drag-hook event click-count nil) - (mouse-track-insert-drag-up-hook event click-count) - t) - -(defun mouse-track-delete-and-insert (event) - "Make a selection with the mouse and insert it at point. -This is exactly the same as the `mouse-track' command on \\[mouse-track], -except that point is not moved; the selected text is immediately inserted -after being selected\; and the text of the selection is deleted." - (interactive "*e") - (mouse-track-insert event t)) - -;;;;;;;;;;;;;;;;;;;;;;;; - - -(defvar inhibit-help-echo nil - "Inhibits display of `help-echo' extent properties in the minibuffer.") -(defvar last-help-echo-object nil) -(defvar help-echo-owns-message nil) - -(defun clear-help-echo (&optional ignored-frame) - (if help-echo-owns-message - (progn - (setq help-echo-owns-message nil - last-help-echo-object nil) - (clear-message 'help-echo)))) - -(defun show-help-echo (mess) - ;; (clear-help-echo) - (setq help-echo-owns-message t) - (display-message 'help-echo mess)) - -(add-hook 'mouse-leave-frame-hook 'clear-help-echo) - -;; It may be a good idea to move this to C, for better performance of -;; extent highlighting and pointer changes. -(defun default-mouse-motion-handler (event) - "For use as the value of `mouse-motion-handler'. -This implements the various pointer-shape variables, -as well as extent highlighting, help-echo, toolbar up/down, -and `mode-motion-hook'." - (let* ((frame (or (event-frame event) (selected-frame))) - (window (event-window event)) - (buffer (event-buffer event)) - (modeline-point (and buffer (event-modeline-position event))) - (modeline-string (and modeline-point - (symbol-value-in-buffer - 'generated-modeline-string buffer))) - ;; point must be invalidated by modeline-point. - (point (and buffer (not modeline-point) - (event-point event))) - (extent (or (and point - (extent-at point buffer 'mouse-face)) - (and modeline-point - (extent-at modeline-point modeline-string - ;; Modeline extents don't have a - ;; mouse-face property set. - 'help-echo)))) - (glyph-extent1 (event-glyph-extent event)) - (glyph-extent (and glyph-extent1 - (extent-live-p glyph-extent1) - glyph-extent1)) - ;; This is an extent: - (user-pointer1 (or (and glyph-extent - (extent-property glyph-extent 'pointer) - glyph-extent) - (and point (extent-at point buffer 'pointer)) - (and modeline-point - (extent-at modeline-point modeline-string - 'pointer)))) - ;; And this should be a glyph: - (user-pointer (and user-pointer1 (extent-live-p user-pointer1) - (extent-property user-pointer1 'pointer))) - (button (event-toolbar-button event)) - (help (or (and glyph-extent (extent-property glyph-extent 'help-echo) - glyph-extent) - (and button (not (null (toolbar-button-help-string button))) - button) - (and point - (extent-at point buffer 'help-echo)) - (and modeline-point - (extent-at modeline-point modeline-string - 'help-echo)))) - ;; vars is a list of glyph variables to check for a pointer - ;; value. - (vars (cond - ;; Checking if button is non-nil is not sufficent - ;; since the pointer could be over a blank portion - ;; of the toolbar. - ((event-over-toolbar-p event) - '(toolbar-pointer-glyph nontext-pointer-glyph - text-pointer-glyph)) - ((or extent glyph-extent) - '(selection-pointer-glyph text-pointer-glyph)) - ((event-over-modeline-p event) - '(modeline-pointer-glyph nontext-pointer-glyph - text-pointer-glyph)) - ((and (event-over-vertical-divider-p event) - ;; #### I disagree with the check below. - ;; Discuss it with Kirill for 21.1. --hniksic - (specifier-instance vertical-divider-always-visible-p - (event-window event))) - '(divider-pointer-glyph nontext-pointer-glyph - text-pointer-glyph)) - (point '(text-pointer-glyph)) - (buffer '(nontext-pointer-glyph text-pointer-glyph)) - (t '(nontext-pointer-glyph text-pointer-glyph)))) - pointer) - (and user-pointer (glyphp user-pointer) - (push 'user-pointer vars)) - (while (and vars (not (pointer-image-instance-p pointer))) - (setq pointer (glyph-image-instance (symbol-value (car vars)) - (or window frame)) - vars (cdr vars))) - - (if (pointer-image-instance-p pointer) - (set-frame-pointer frame pointer)) - - ;; If last-pressed-toolbar-button is not nil, then check and see - ;; if we have moved to a new button and adjust the down flags - ;; accordingly. - (when (and (featurep 'toolbar) toolbar-active) - (unless (eq last-pressed-toolbar-button button) - (release-previous-toolbar-button event) - (and button (press-toolbar-button event)))) - - (cond (extent (highlight-extent extent t)) - (glyph-extent (highlight-extent glyph-extent t)) - (t (highlight-extent nil nil))) - (cond ((extentp help) - (or inhibit-help-echo - (eq help last-help-echo-object) ;save some time - (eq (selected-window) (minibuffer-window)) - (let ((hprop (extent-property help 'help-echo))) - (setq last-help-echo-object help) - (or (stringp hprop) - (setq hprop (funcall hprop help))) - (and hprop (show-help-echo hprop))))) - ((and (featurep 'toolbar) - (toolbar-button-p help) - (toolbar-button-enabled-p help)) - (or (not toolbar-help-enabled) - (eq help last-help-echo-object) ;save some time - (eq (selected-window) (minibuffer-window)) - (let ((hstring (toolbar-button-help-string button))) - (setq last-help-echo-object help) - (or (stringp hstring) - (setq hstring (funcall hstring help))) - (and hstring (show-help-echo hstring))))) - (last-help-echo-object - (clear-help-echo))) - (if mouse-grabbed-buffer (setq buffer mouse-grabbed-buffer)) - (if (and buffer (symbol-value-in-buffer 'mode-motion-hook buffer nil)) - (with-current-buffer buffer - (run-hook-with-args 'mode-motion-hook event) - - ;; If the mode-motion-hook created a highlightable extent around - ;; the mouse-point, highlight it right away. Otherwise it wouldn't - ;; be highlighted until the *next* motion event came in. - (if (and point - (null extent) - (setq extent (extent-at point - (event-buffer event) ; not buffer - 'mouse-face))) - (highlight-extent extent t))))) - nil) - -(setq mouse-motion-handler 'default-mouse-motion-handler) - -;; -;; Vertical divider dragging -;; -(defun drag-window-divider (event) - "Handle resizing windows by dragging window dividers. -This is an intenal function, normally bound to button1 event in -window-divider-map. You would not call it, but you may bind it to -other mouse buttons." - (interactive "e") - ;; #### I disagree with the check below. - ;; Discuss it with Kirill for 21.1. --hniksic - (if (not (specifier-instance vertical-divider-always-visible-p - (event-window event))) - (error "Not over a window")) - (let-specifier ((vertical-divider-shadow-thickness - (- (specifier-instance vertical-divider-shadow-thickness - (event-window event))) - (event-window event))) - (let* ((window (event-window event)) - (frame (event-channel event)) - (last-timestamp (event-timestamp event)) - done) - (while (not done) - (let* ((edges (window-pixel-edges window)) - (old-right (caddr edges)) - (old-left (car edges)) - (backup-conf (current-window-configuration frame)) - (old-edges-all-windows (mapcar 'window-pixel-edges - (window-list)))) - - ;; This is borrowed from modeline.el: - ;; requeue event and quit if this is a misc-user, eval or - ;; keypress event. - ;; quit if this is a button press or release event, or if the event - ;; occurred in some other frame. - ;; drag if this is a mouse motion event and the time - ;; between this event and the last event is greater than - ;; drag-divider-event-lag. - ;; do nothing if this is any other kind of event. - (setq event (next-event event)) - (cond ((or (misc-user-event-p event) - (key-press-event-p event)) - (setq unread-command-events (nconc unread-command-events - (list event)) - done t)) - ((button-release-event-p event) - (setq done t)) - ((button-event-p event) - (setq done t)) - ((not (motion-event-p event)) - (dispatch-event event)) - ((not (eq frame (event-frame event))) - (setq done t)) - ((< (abs (- (event-timestamp event) last-timestamp)) - drag-divider-event-lag)) - (t - (setq last-timestamp (event-timestamp event)) - ;; Enlarge the window, calculating change in characters - ;; of default font. Do not let the window to become - ;; less than alolwed minimum (not because that's critical - ;; for the code performance, just the visual effect is - ;; better: when cursor goes to the left of the next left - ;; divider, the vindow being resized shrinks to minimal - ;; size. - (enlarge-window (max (- window-min-width (window-width window)) - (/ (- (event-x-pixel event) old-right) - (face-width 'default window))) - t window) - ;; Backout the change if some windows got deleted, or - ;; if the change caused more than two windows to resize - ;; (shifting the whole stack right is ugly), or if the - ;; left window side has slipped (right side cannot be - ;; moved any funrther to the right, so enlarge-window - ;; plays bad games with the left edge. - (if (or (/= (count-windows) (length old-edges-all-windows)) - (/= old-left (car (window-pixel-edges window))) - ;; This check is very hairy. We allow any number - ;; of left edges to change, but only to the same - ;; new value. Similar procedure is for the right edges. - (let ((all-that-bad nil) - (new-left-ok nil) - (new-right-ok nil)) - (mapcar* (lambda (window old-edges) - (let ((new (car (window-pixel-edges window)))) - (if (/= new (car old-edges)) - (if (and new-left-ok - (/= new-left-ok new)) - (setq all-that-bad t) - (setq new-left-ok new))))) - (window-list) old-edges-all-windows) - (mapcar* (lambda (window old-edges) - (let ((new (caddr (window-pixel-edges window)))) - (if (/= new (caddr old-edges)) - (if (and new-right-ok - (/= new-right-ok new)) - (setq all-that-bad t) - (setq new-right-ok new))))) - (window-list) old-edges-all-windows) - all-that-bad)) - (set-window-configuration backup-conf))))))))) - -(setq vertical-divider-map (make-keymap)) -(define-key vertical-divider-map 'button1 'drag-window-divider) - -;;; mouse.el ends here diff --git a/lisp/msw-faces.el b/lisp/msw-faces.el deleted file mode 100644 index e77f415..0000000 --- a/lisp/msw-faces.el +++ /dev/null @@ -1,178 +0,0 @@ -;;; msw-faces.el --- mswindows-specific face stuff. - -;;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. -;;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Jamie Zawinski -;; Modified by: Chuck Thompson -;; Modified by: Ben Wing -;; Modified by: Martin Buchholz -;; Rewritten for mswindows by: Jonathan Harris - -;; 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. - -;; This file does the magic to parse mswindows font names, and make sure that -;; the default and modeline attributes of new frames are specified enough. - -;;; Force creation of the default face font so that if it fails we get an -;;; error now instead of a crash at frame creation. -(defun mswindows-init-device-faces (device) - (unless (face-font-instance 'default device) - (error "Can't find a suitable default font"))) - - -(defun mswindows-init-frame-faces (frame) - ) - - -;;; Fill in missing parts of a font spec. This is primarily intended as a -;;; helper function for the functions below. -;;; mswindows fonts look like: -;;; fontname[:[weight][ style][:pointsize[:effects]]][:charset] -;;; A minimal mswindows font spec looks like: -;;; Courier New -;;; A maximal mswindows font spec looks like: -;;; Courier New:Bold Italic:10:underline strikeout:Western -;;; Missing parts of the font spec should be filled in with these values: -;;; Courier New:Regular:10::Western -(defun mswindows-font-canonicalize-name (font) - "Given a mswindows font or font name, this returns its name in -canonical form." - (if (or (font-instance-p font) - (stringp font)) - (let ((name (if (font-instance-p font) - (font-instance-name font) - font))) - (cond ((string-match - "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*:[a-zA-Z 0-9]*$" - name) name) - ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+:[a-zA-Z ]*$" - name) (concat name ":Western")) - ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*:[0-9]+$" name) - (concat name "::Western")) - ((string-match "^[a-zA-Z ]+:[a-zA-Z ]*$" name) - (concat name ":10::Western")) - ((string-match "^[a-zA-Z ]+$" name) - (concat name ":Regular:10::Western")) - (t "Courier New:Regular:10::Western"))))) - -(defun mswindows-make-font-bold (font &optional device) - "Given a mswindows font specification, this attempts to make a bold font. -If it fails, it returns nil." - (if (font-instance-p font) - (let ((name (mswindows-font-canonicalize-name font)) - (oldwidth (font-instance-width font))) - (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (let ((newfont (make-font-instance - (concat (substring name 0 (match-beginning 1)) - "Bold" (substring name (match-end 1))) - device t))) -; Hack! on mswindows, bold fonts (even monospaced) are often wider than the -; equivalent non-bold font. Making the bold font one point smaller usually -; makes it the same width (maybe at the expense of making it one pixel shorter) - (if (font-instance-p newfont) - (if (> (font-instance-width newfont) oldwidth) - (mswindows-find-smaller-font newfont device) - newfont)))))) - -(defun mswindows-make-font-unbold (font &optional device) - "Given a mswindows font specification, this attempts to make a non-bold font. -If it fails, it returns nil." - (if (font-instance-p font) - (let ((name (mswindows-font-canonicalize-name font))) - (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - "Regular" (substring name (match-end 1))) - device t)))) - -(defun mswindows-make-font-italic (font &optional device) - "Given a mswindows font specification, this attempts to make an `italic' -font. If it fails, it returns nil." - (if (font-instance-p font) - (let ((name (mswindows-font-canonicalize-name font))) - (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - "Italic" (substring name (match-end 1))) - device t)))) - -(defun mswindows-make-font-unitalic (font &optional device) - "Given a mswindows font specification, this attempts to make a non-italic -font. If it fails, it returns nil." - (if (font-instance-p font) - (let ((name (mswindows-font-canonicalize-name font))) - (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - "Regular" (substring name (match-end 1))) - device t)))) - -(defun mswindows-make-font-bold-italic (font &optional device) - "Given a mswindows font specification, this attempts to make a `bold-italic' -font. If it fails, it returns nil." - (if (font-instance-p font) - (let ((name (mswindows-font-canonicalize-name font)) - (oldwidth (font-instance-width font))) - (string-match "^[a-zA-Z ]+:\\([a-zA-Z ]*\\):" name) - (let ((newfont (make-font-instance - (concat (substring name 0 (match-beginning 1)) - "Bold Italic" (substring name (match-end 1))) - device t))) -; Hack! on mswindows, bold fonts (even monospaced) are often wider than the -; equivalent non-bold font. Making the bold font one point smaller usually -; makes it the same width (maybe at the expense of making it one pixel shorter) - (if (font-instance-p newfont) - (if (> (font-instance-width newfont) oldwidth) - (mswindows-find-smaller-font newfont device) - newfont)))))) - -(defun mswindows-find-smaller-font (font &optional device) - "Loads a new version of the given font (or font name) 1 point smaller. -Returns the font if it succeeds, nil otherwise." - (if (stringp font) (setq font (make-font-instance font device))) - (if (font-instance-p font) (setq font (font-instance-truename font))) - (if (stringp font) (setq font (make-font-instance font device))) - (if (font-instance-p font) - (let (old-size (name (mswindows-font-canonicalize-name font))) - (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) - (setq old-size (string-to-int - (substring name (match-beginning 1) (match-end 1)))) - (if (> old-size 0) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - (int-to-string (- old-size 1)) - (substring name (match-end 1))) - device t))))) - -(defun mswindows-find-larger-font (font &optional device) - "Loads a new version of the given font (or font name) 1 point larger. -Returns the font if it succeeds, nil otherwise." - (if (stringp font) (setq font (make-font-instance font device))) - (if (font-instance-p font) (setq font (font-instance-truename font))) - (if (stringp font) (setq font (make-font-instance font device))) - (if (font-instance-p font) - (let (old-size (name (mswindows-font-canonicalize-name font))) - (string-match "^[a-zA-Z ]+:[a-zA-Z ]*:\\([0-9]+\\):" name) - (setq old-size (string-to-int - (substring name (match-beginning 1) (match-end 1)))) - (make-font-instance (concat - (substring name 0 (match-beginning 1)) - (int-to-string (+ old-size 1)) - (substring name (match-end 1))) - device t)))) diff --git a/lisp/msw-glyphs.el b/lisp/msw-glyphs.el deleted file mode 100644 index 56904f3..0000000 --- a/lisp/msw-glyphs.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; msw-glyphs.el --- Support for glyphs in ms windows - -;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. - -;; Author: Kirill M. Katsnelson -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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: - -;; This file contains temporary definitions for 'mswindows glyphs. -;; Since there currently is no image support, the glyps are defined -;; TTY-style. This file has to be removed or reworked completely -;; when we have images. - -;; This file is dumped with XEmacs. - -;;; Code: - -(progn - (set-console-type-image-conversion-list - 'mswindows - `(("\\.bmp\\'" [bmp :file nil] 2) - ("\\`BM" [bmp :data nil] 2) - ,@(if (featurep 'xpm) '(("\\.xpm\\'" [xpm :file nil] 2))) - ("\\.xbm\\'" [xbm :file nil] 2) - ,@(if (featurep 'xpm) '(("\\`/\\* XPM \\*/" [xpm :data nil] 2))) - ,@(if (featurep 'gif) '(("\\.gif\\'" [gif :file nil] 2) - ("\\`GIF8[79]" [gif :data nil] 2))) - ,@(if (featurep 'jpeg) '(("\\.jpe?g\\'" [jpeg :file nil] 2))) - ;; all of the JFIF-format JPEG's that I've seen begin with - ;; the following. I have no idea if this is standard. - ,@(if (featurep 'jpeg) '(("\\`\377\330\377\340\000\020JFIF" - [jpeg :data nil] 2))) - ,@(if (featurep 'png) '(("\\.png\\'" [png :file nil] 2))) - ,@(if (featurep 'png) '(("\\`\211PNG" [png :data nil] 2))) - ,@(if (featurep 'tiff) '(("\\.tif?f\\'" [tiff :file nil] 2))) - ("\\`X-Face:" [string :data "[xface]"]) - ("\\`/\\* XPM \\*/" [string :data "[xpm]"]) - ("" [string :data nil] 2) - ;; this last one is here for pointers and icons and such -- - ;; strings are not allowed so they will be ignored. - ("" [nothing]))) - - (set-face-font 'border-glyph "WingDings:Regular:11::Symbol" - 'global 'mswindows) - (set-glyph-image continuation-glyph "\xC3" 'global 'mswindows) - (set-glyph-image truncation-glyph "\xF0" 'global 'mswindows) - (set-glyph-image hscroll-glyph "\xEF" 'global 'mswindows) - - (set-glyph-image octal-escape-glyph "\\") - (set-glyph-image control-arrow-glyph "^") - (set-glyph-image invisible-text-glyph " ...") - - (cond ((featurep 'xpm) - (set-glyph-image frame-icon-glyph - (concat "../etc/" "xemacs-icon3.xpm") - 'global 'mswindows) - (set-glyph-image xemacs-logo - (concat "../etc/" - (if emacs-beta-version - "xemacs-beta.xpm" - "xemacs.xpm")) - 'global 'mswindows)) - (t - (set-glyph-image xemacs-logo - "XEmacs " - 'global 'mswindows))) -) - -;;; msw-glyphs.el ends here diff --git a/lisp/msw-init.el b/lisp/msw-init.el deleted file mode 100644 index de7d823..0000000 --- a/lisp/msw-init.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; msw-init.el --- initialization code for mswindows -;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: various -;; Rewritten for mswindows by: Jonathan Harris - -;; 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. - -(defvar mswindows-win-initted nil) -(defvar mswindows-pre-win-initted nil) -(defvar mswindows-post-win-initted nil) - -(defun init-pre-mswindows-win () - "Initialize mswindows GUI at startup (pre). Don't call this." - (unless mswindows-pre-win-initted - (setq mswindows-pre-win-initted t))) - -(defun init-mswindows-win () - "Initialize mswindows GUI at startup. Don't call this." - (unless mswindows-win-initted - (init-pre-mswindows-win) - (make-mswindows-device) - (init-post-mswindows-win (selected-console)) - (setq mswindows-win-initted t))) - -(defun init-post-mswindows-win (console) - "Initialize mswindows GUI at startup (post). Don't call this." - (unless mswindows-post-win-initted - (if (featurep 'toolbar) - (if (featurep 'infodock) - (require 'id-x-toolbar) - (init-x-toolbar))) - (add-hook 'zmacs-deactivate-region-hook - (lambda () - (if (console-on-window-system-p) - (disown-selection)))) - (add-hook 'zmacs-activate-region-hook - (lambda () - (if (console-on-window-system-p) - (activate-region-as-selection)))) - (add-hook 'zmacs-update-region-hook - (lambda () - (if (console-on-window-system-p) - (activate-region-as-selection)))) - ;; Old-style mswindows bindings. The new-style mswindows bindings - ;; (namely Ctrl-X, Ctrl-C and Ctrl-V) are already spoken for by XEmacs. - (define-key global-map '(shift delete) 'kill-primary-selection) - (define-key global-map '(control delete) 'delete-primary-selection) - (define-key global-map '(shift insert) 'yank-clipboard-selection) - (define-key global-map '(control insert) 'copy-primary-selection) - - ;; Random stuff - (define-key global-map 'menu 'popup-mode-menu) - - (setq mswindows-post-win-initted t))) - diff --git a/lisp/msw-select.el b/lisp/msw-select.el deleted file mode 100644 index cd99854..0000000 --- a/lisp/msw-select.el +++ /dev/null @@ -1,107 +0,0 @@ -;;; msw-select.el --- Lisp interface to mswindows selections. - -;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 is dumped with XEmacs (when mswindows support is compiled in). -;; #### Only copes with copying/pasting text - -;;; Code: - -(defun mswindows-paste-clipboard () - "Insert the current contents of the mswindows clipboard at point, -replacing the active selection if there is one." - (interactive "*") - (setq last-command nil) - (setq this-command 'yank) ; so that yank-pop works. - (let ((clip (mswindows-get-clipboard)) (s (mark-marker)) (e (point-marker))) - (or clip (error "there is no text on the clipboard")) - (if s - (if mouse-track-rectangle-p - (delete-rectangle s e) - (delete-region s e))) - (push-mark) - (if mouse-track-rectangle-p - (insert-rectangle clip) - (insert clip)))) - -(defun mswindows-own-clipboard (string) - "Paste the given string to the mswindows clipboard." - (mswindows-set-clipboard string)) - -(defvar mswindows-selection-owned-p nil - "Whether we have a selection or not. -MS-Windows has no concept of ownership; don't use this.") - -(defun mswindows-own-selection (data &optional type) - "Make an MS-Windows selection of type TYPE and value DATA. -The argument TYPE is ignored, and DATA specifies the contents. -DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). - -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. - -The data may also be a vector of valid non-vector selection values. - -Interactively, the text of the region is used as the selection value." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (substring (region-beginning) (region-end))))) - (or (valid-simple-selection-p data) - (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) - valid)) - (signal 'error (list "invalid selection" data))) - (if data - (setq mswindows-selection-owned-p data) - (setq mswindows-selection-owned-p nil)) - (setq primary-selection-extent - (select-make-extent-for-selection - data primary-selection-extent)) - (setq zmacs-region-stays t) - data) - -(defun mswindows-disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." - (setq mswindows-selection-owned-p nil) - (mswindows-delete-selection)) - -(defun mswindows-selection-owner-p (&optional selection) - "Return t if current emacs process owns the given Selection. -The arg is ignored." - (not (eq mswindows-selection-owned-p nil))) - diff --git a/lisp/mule/chinese.el b/lisp/mule/chinese.el deleted file mode 100644 index a4fd892..0000000 --- a/lisp/mule/chinese.el +++ /dev/null @@ -1,268 +0,0 @@ -;;; chinese.el --- Support for Chinese - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, Chinese - -;; 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: - -;; For Chinese, three character sets GB2312, BIG5, and CNS11643 are -;; supported. - -;;; Code: - -;; Syntax of Chinese characters. -(modify-syntax-entry 'chinese-gb2312 "w") -(loop for row in '(33 34 41) - do (modify-syntax-entry `[chinese-gb2312 ,row] ".")) -;;(loop for row from 35 to 40 -;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w")) -;;(loop for row from 42 to 126 -;; do (modify-syntax-entry `[chinese-gb2312 ,row] "w")) - -(modify-syntax-entry 'chinese-cns11643-1 "w") -(modify-syntax-entry 'chinese-cns11643-2 "w") -(modify-syntax-entry 'chinese-big5-1 "w") -(modify-syntax-entry 'chinese-big5-2 "w") - -;; CNS11643 Plane3 thru Plane7 -;; These represent more and more obscure Chinese characters. -;; By the time you get to Plane 7, we're talking about characters -;; that appear once in some ancient manuscript and whose meaning -;; is unknown. - -(flet - ((make-chinese-cns11643-charset - (name plane final) - (make-charset - name (concat "CNS 11643 Plane " plane " (Chinese traditional)") - `(registry - ,(concat "CNS11643[.-]\\(.*[.-]\\)?" plane "$") - dimension 2 - chars 94 - final ,final - graphic 0)) - (modify-syntax-entry name "w") - (modify-category-entry name ?t) - )) - (make-chinese-cns11643-charset 'chinese-cns11643-3 "3" ?I) - (make-chinese-cns11643-charset 'chinese-cns11643-4 "4" ?J) - (make-chinese-cns11643-charset 'chinese-cns11643-5 "5" ?K) - (make-chinese-cns11643-charset 'chinese-cns11643-6 "6" ?L) - (make-chinese-cns11643-charset 'chinese-cns11643-7 "7" ?M) - ) - -;; ISO-IR-165 (CCITT Extended GB) -;; It is based on CCITT Recommendation T.101, includes GB 2312-80 + -;; GB 8565-88 table A4 + 293 characters. -(make-charset - 'chinese-isoir165 - "ISO-IR-165 (CCITT Extended GB; Chinese simplified)" - `(registry "isoir165" - dimension 2 - chars 94 - final ?E - graphic 0)) - -;; PinYin-ZhuYin -(make-charset 'sisheng "PinYin-ZhuYin" - '(registry "sisheng_cwnn\\|OMRON_UDC_ZH" - dimension 1 - chars 94 - final ?0 - graphic 0 - )) - -;; If you prefer QUAIL to EGG, please modify below as you wish. -;;(when (and (featurep 'egg) (featurep 'wnn)) -;; (setq wnn-server-type 'cserver) -;; (load "pinyin") -;; (setq its:*standard-modes* -;; (cons (its:get-mode-map "PinYin") its:*standard-modes*))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Chinese (general) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (make-coding-system -;; 'chinese-iso-7bit 2 ?C -;; "ISO 2022 based 7bit encoding for Chinese GB and CNS (MIME:ISO-2022-CN)" -;; '(ascii -;; (nil chinese-gb2312 chinese-cns11643-1) -;; (nil chinese-cns11643-2) -;; (nil chinese-cns11643-3 chinese-cns11643-4 chinese-cns11643-5 -;; chinese-cns11643-6 chinese-cns11643-7) -;; nil ascii-eol ascii-cntl seven locking-shift single-shift nil nil nil -;; init-bol)) - -;; (define-coding-system-alias 'iso-2022-cn 'chinese-iso-7bit) -;; (define-coding-system-alias 'iso-2022-cn-ext 'chinese-iso-7bit) - -;; (define-prefix-command 'describe-chinese-environment-map) -;; (define-key-after describe-language-environment-map [Chinese] -;; '("Chinese" . describe-chinese-environment-map) -;; t) - -;; (define-prefix-command 'setup-chinese-environment-map) -;; (define-key-after setup-language-environment-map [Chinese] -;; '("Chinese" . setup-chinese-environment-map) -;; t) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Chinese GB2312 (simplified) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (make-coding-system -;; 'chinese-iso-8bit 2 ?c -;; "ISO 2022 based EUC encoding for Chinese GB2312 (MIME:CN-GB-2312)" -;; '((ascii t) chinese-gb2312 chinese-sisheng nil -;; nil ascii-eol ascii-cntl nil nil single-shift nil)) - -(make-coding-system - 'cn-gb-2312 'iso2022 - "Coding-system of Chinese EUC (Extended Unix Code)." - '(charset-g0 ascii - charset-g1 chinese-gb2312 - charset-g2 sisheng - charset-g3 t - mnemonic "Zh-GB/EUC" - )) - -;; (define-coding-system-alias 'cn-gb-2312 'chinese-iso-8bit) -;; (define-coding-system-alias 'euc-china 'chinese-iso-8bit) - -(copy-coding-system 'cn-gb-2312 'gb2312) -(copy-coding-system 'cn-gb-2312 'chinese-euc) - -;; (make-coding-system -;; 'chinese-hz 0 ?z -;; "Hz/ZW 7-bit encoding for Chinese GB2312 (MIME:HZ-GB-2312)" -;; nil) -;; (put 'chinese-hz 'post-read-conversion 'post-read-decode-hz) -;; (put 'chinese-hz 'pre-write-conversion 'pre-write-encode-hz) - -(make-coding-system - 'hz-gb-2312 'no-conversion - "Coding-system of Hz/ZW used for Chinese." - '(mnemonic "Zh-GB/Hz" - eol-type lf - post-read-conversion post-read-decode-hz - pre-write-conversion pre-write-encode-hz)) - -;; (define-coding-system-alias 'hz-gb-2312 'chinese-hz) -;; (define-coding-system-alias 'hz 'chinese-hz) - -(copy-coding-system 'hz-gb-2312 'hz) -(copy-coding-system 'hz-gb-2312 'chinese-hz) - -(defun post-read-decode-hz (len) - (let ((pos (point))) - (decode-hz-region pos (+ pos len)))) - -(defun pre-write-encode-hz (from to) - (let ((buf (current-buffer)) - (work (get-buffer-create " *pre-write-encoding-work*"))) - (set-buffer work) - (erase-buffer) - (if (stringp from) - (insert from) - (insert-buffer-substring buf from to)) - (encode-hz-region 1 (point-max)) - nil)) - -(set-language-info-alist - "Chinese-GB" '((setup-function . (setup-chinese-gb-environment - . setup-chinese-environment-map)) - (charset . (chinese-gb2312 sisheng)) - (coding-system - . (cn-gb-2312 iso-2022-7bit hz-gb-2312)) - (sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B") - (documentation . ("Support for Chinese GB2312 character set." - . describe-chinese-environment-map)) - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Chinese BIG5 (traditional) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (make-coding-system -;; 'chinese-big5 3 ?B "BIG5 8-bit encoding for Chinese (MIME:CN-BIG5)") - -(make-coding-system - 'big5 'big5 - "Coding-system of BIG5." - '(mnemonic "Zh/Big5")) - -;; (define-coding-system-alias 'big5 'chinese-big5) -;; (define-coding-system-alias 'cn-big5 'chinese-big5) - -(copy-coding-system 'big5 'cn-big5) -(copy-coding-system 'big5 'chinese-big5) - -;; Big5 font requires special encoding. -(define-ccl-program ccl-encode-big5-font - `(0 - ;; In: R0:chinese-big5-1 or chinese-big5-2 - ;; R1:position code 1 - ;; R2:position code 2 - ;; Out: R1:font code point 1 - ;; R2:font code point 2 - ((r2 = ((((r1 - ?\x21) * 94) + r2) - ?\x21)) - (if (r0 == ,(charset-id 'chinese-big5-2)) (r2 += 6280)) - (r1 = ((r2 / 157) + ?\xA1)) - (r2 %= 157) - (if (r2 < ?\x3F) (r2 += ?\x40) (r2 += ?\x62)))) - "CCL program to encode a Big5 code to code point of Big5 font.") - -;; (setq font-ccl-encoder-alist -;; (cons (cons "big5" ccl-encode-big5-font) font-ccl-encoder-alist)) - -(set-charset-ccl-program 'chinese-big5-1 ccl-encode-big5-font) -(set-charset-ccl-program 'chinese-big5-2 ccl-encode-big5-font) - -(set-language-info-alist - "Chinese-BIG5" '((setup-function . (setup-chinese-big5-environment - . setup-chinese-environment-map)) - (charset . (chinese-big5-1 chinese-big5-2)) - (coding-system . (big5 iso-2022-7bit)) - (sample-text . "Cantonese ($(0GnM$(B,$(0N]0*Hd(B) $(0*/=((B, $(0+$)p(B") - (documentation . ("Support for Chinese Big5 character set." - . describe-chinese-environment-map)) - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Chinese CNS11643 (traditional) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (set-language-info-alist -;; "Chinese-CNS" '((setup-function . (setup-chinese-cns-environment -;; . setup-chinese-environment-map)) -;; (charset . (chinese-cns11643-1 chinese-cns11643-2 -;; chinese-cns11643-3 chinese-cns11643-4 -;; chinese-cns11643-5 chinese-cns11643-6 -;; chinese-cns11643-7)) -;; (coding-system . (chinese-iso-7bit)) -;; (documentation . ("Support for Chinese CNS character sets." -;; . describe-chinese-environment-map)) -;; )) - -;;; chinese.el ends here diff --git a/lisp/mule/cyrillic.el b/lisp/mule/cyrillic.el deleted file mode 100644 index 24322f8..0000000 --- a/lisp/mule/cyrillic.el +++ /dev/null @@ -1,294 +0,0 @@ -;;; cyrillic.el --- Support for languages which use Cyrillic characters - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, Cyrillic - -;; 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: - -;; The character set ISO8859-5 is supported. KOI-8 and ALTERNATIVNYJ -;; are converted to ISO8859-5 internally. - -;;; Code: - -;; For syntax of Cyrillic -(modify-syntax-entry 'cyrillic-iso8859-5 "w") -(modify-syntax-entry ?,L-(B ".") -(modify-syntax-entry ?,Lp(B ".") -(modify-syntax-entry ?,L}(B ".") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; CYRILLIC -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (define-prefix-command 'describe-cyrillic-environment-map) -;; (define-key-after describe-language-environment-map [Cyrillic] -;; '("Cyrillic" . describe-cyrillic-environment-map) -;; t) - -;; (define-prefix-command 'setup-cyrillic-environment-map) -;; (define-key-after setup-language-environment-map [Cyrillic] -;; '("Cyrillic" . setup-cyrillic-environment-map) -;; t) - - -;; ISO-8859-5 staff - -;; (make-coding-system -;; 'cyrillic-iso-8bit 2 ?5 -;; "ISO 2022 based 8-bit encoding for Cyrillic script (MIME:ISO-8859-5)" -;; '((ascii t) (cyrillic-iso8859-5 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -;; (define-coding-system-alias 'iso-8859-5 'cyrillic-iso-8bit) - -(make-coding-system - 'iso-8859-5 'iso2022 - "MIME ISO-8859-5" - '(charset-g0 ascii - charset-g1 cyrillic-iso8859-5 - charset-g2 t - charset-g3 t - mnemonic "ISO8/Cyr" - )) - -(set-language-info-alist - "Cyrillic-ISO" '((setup-function . (setup-cyrillic-iso-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) - (tutorial . "TUTORIAL.ru") - (coding-system . (iso-8859-5)) - (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic ISO-8859-5." - . describe-cyrillic-environment-map)))) - -;; KOI-8 staff - -(define-ccl-program ccl-decode-koi8 - '(3 - ((read r0) - (loop - (write-read-repeat - r0 - [0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 - 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 - 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 - 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 - 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 - 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 - 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 - 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 - 32 32 32 ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 ?,L!(B 32 32 32 32 32 32 32 32 32 32 32 32 - ?,Ln(B ?,LP(B ?,LQ(B ?,Lf(B ?,LT(B ?,LU(B ?,Ld(B ?,LS(B ?,Le(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B - ?,L_(B ?,Lo(B ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,LV(B ?,LR(B ?,Ll(B ?,Lk(B ?,LW(B ?,Lh(B ?,Lm(B ?,Li(B ?,Lg(B ?,Lj(B - ?,LN(B ?,L0(B ?,L1(B ?,LF(B ?,L4(B ?,L5(B ?,LD(B ?,L3(B ?,LE(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B - ?,L?(B ?,LO(B ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,L6(B ?,L2(B ?,LL(B ?,LK(B ?,L7(B ?,LH(B ?,LM(B ?,LI(B ?,LG(B ?,LJ(B ])))) - "CCL program to decode KOI8.") - -(define-ccl-program ccl-encode-koi8 - `(1 - ((read r0) - (loop - (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 - 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 - 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 - 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 - 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) - "CCL program to encode KOI8.") - -;(make-coding-system -; 'cyrillic-koi8 4 -; ;; We used to use ?K. It is true that ?K is more strictly correct, -; ;; but it is also used for Korean. -; ;; So people who use koi8 for languages other than Russian -; ;; will have to forgive us. -; ?R "KOI8 8-bit encoding for Cyrillic (MIME: KOI8-R)" -; (cons ccl-decode-koi8 ccl-encode-koi8)) - -;(define-coding-system-alias 'koi8-r 'cyrillic-koi8) -;(define-coding-system-alias 'koi8 'cyrillic-koi8) - -(make-coding-system - 'koi8-r 'ccl - "Coding-system used for KOI8-R." - `(decode ,ccl-decode-koi8 - encode ,ccl-encode-koi8 - mnemonic "KOI8")) - -;(define-coding-system-alias 'koi8-r 'koi8) - -;; (define-ccl-program ccl-encode-koi8-font -;; '(0 -;; ((r1 -= 160) -;; (r1 = r1 -;; [ 32 179 32 32 32 32 32 32 32 32 32 32 32 32 32 32 -;; 225 226 247 231 228 229 246 250 233 234 235 236 237 238 239 240 -;; 242 243 244 245 230 232 227 254 251 253 255 249 248 252 224 241 -;; 193 194 215 199 196 197 214 218 201 202 203 204 205 206 207 208 -;; 210 211 212 213 198 200 195 222 219 221 223 217 216 220 192 209 -;; 32 163 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) -;; )) -;; "CCL program to encode Cyrillic chars to KOI font.") - -;; (setq font-ccl-encoder-alist -;; (cons (cons "koi8" ccl-encode-koi8-font) font-ccl-encoder-alist)) - -(set-language-info-alist - "Cyrillic-KOI8" '((setup-function . (setup-cyrillic-koi8-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) - (coding-system . (koi8-r)) - (tutorial . "TUTORIAL.ru") - (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic KOI-8." - . describe-cyrillic-environment-map)))) - -;;; ALTERNATIVNYJ staff - -(define-ccl-program ccl-decode-alternativnyj - '(3 - ((read r0) - (loop - (write-read-repeat - r0 - [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 - 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 - 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 - 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 - 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 - 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 - 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 - ?,L0(B ?,L1(B ?,L2(B ?,L3(B ?,L4(B ?,L5(B ?,L6(B ?,L7(B ?,L8(B ?,L9(B ?,L:(B ?,L;(B ?,L<(B ?,L=(B ?,L>(B ?,L?(B - ?,L@(B ?,LA(B ?,LB(B ?,LC(B ?,LD(B ?,LE(B ?,LF(B ?,LG(B ?,LH(B ?,LI(B ?,LJ(B ?,LK(B ?,LL(B ?,LM(B ?,LN(B ?,LO(B - ?,LP(B ?,LQ(B ?,LR(B ?,LS(B ?,LT(B ?,LU(B ?,LV(B ?,LW(B ?,LX(B ?,LY(B ?,LZ(B ?,L[(B ?,L\(B ?,L](B ?,L^(B ?,L_(B - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - ?,L`(B ?,La(B ?,Lb(B ?,Lc(B ?,Ld(B ?,Le(B ?,Lf(B ?,Lg(B ?,Lh(B ?,Li(B ?,Lj(B ?,Lk(B ?,Ll(B ?,Lm(B ?,Ln(B ?,Lo(B - ?,L!(B ?,Lq(B 32 32 32 32 32 32 32 32 32 32 32 32 32 ?,Lp(B])))) - "CCL program to decode Alternativnyj.") - -(define-ccl-program ccl-encode-alternativnyj - `(1 - ((read r0) - (loop - (if (r0 != ,(charset-id 'cyrillic-iso8859-5)) - (write-read-repeat r0) - ((read r0) - (r0 -= 160) - (write-read-repeat - r0 - [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 - 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 - 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 - 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 - 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 - 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) - ))))) - "CCL program to encode Alternativnyj.") - -;; (make-coding-system -;; 'alternativnyj 4 -;; ?A "Coding-system used for Alternativnyj" -;; (cons ccl-decode-alternativnyj ccl-encode-alternativnyj)) - -(make-coding-system - 'alternativnyj 'ccl - "Coding-system used for Alternativnyj" - `(decode ,ccl-decode-alternativnyj - encode ,ccl-encode-alternativnyj - mnemonic "Cy.Alt")) - -;; (define-ccl-program ccl-encode-alternativnyj-font -;; '(0 -;; ((r1 -= 160) -;; (r1 = r1 -;; [ 32 240 32 32 32 32 32 32 32 32 32 32 32 32 32 32 -;; 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 -;; 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 -;; 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 -;; 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 -;; 255 241 32 32 32 32 32 32 32 32 32 32 32 32 32 32]) -;; )) -;; "CCL program to encode Cyrillic chars to Alternativnyj font.") - -;; (setq font-ccl-encoder-alist -;; (cons (cons "alternativnyj" ccl-encode-alternativnyj-font) -;; font-ccl-encoder-alist)) - -(set-language-info-alist - "Cyrillic-ALT" '((setup-function . (setup-cyrillic-alternativnyj-environment - . setup-cyrillic-environment-map)) - (charset . (cyrillic-iso8859-5)) - (coding-system . (alternativnyj)) - (tutorial . "TUTORIAL.ru") - (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . ("Support for Cyrillic ALTERNATIVNYJ." - . describe-cyrillic-environment-map)))) - -;;; GENERAL - -(defun setup-cyrillic-environment () - "Setup multilingual environment for Cyrillic users." - (interactive) - (setq primary-language "Cyrillic") - - (setq coding-category-iso-8-1 'iso-8859-5) - - (set-coding-priority - '(coding-category-iso-7 - coding-category-iso-8-1)) - - (setq-default buffer-file-coding-system 'iso-8859-5) - (set-terminal-coding-system 'iso-8859-5) - (set-keyboard-coding-system 'iso-8859-5) - - (setq default-input-method '("Cyrillic" . "quail-yawerty")) - ) - -(defun describe-cyrillic-support () - "Describe how Emacs support Cyrillic." - (interactive) - (describe-language-support-internal "Cyrillic")) - -(set-language-info-alist - "Cyrillic" '((setup-function . setup-cyrillic-environment) - (describe-function . describe-cyrillic-support) - (charset . (cyrillic-iso8859-5)) - (tutorial . "TUTORIAL.ru") - (coding-system . (iso-8859-5 koi8-r alternativnyj)) - (sample-text . "Russian (,L@caaZXY(B) ,L7T`PRabRcYbU(B!") - (documentation . nil))) - -;;; cyrillic.el ends here diff --git a/lisp/mule/english.el b/lisp/mule/english.el deleted file mode 100644 index 60731be..0000000 --- a/lisp/mule/english.el +++ /dev/null @@ -1,125 +0,0 @@ -;;; english.el --- English support - -;; Copyright (C) 1997 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multibyte character, character set, syntax, category - -;; 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: - -;; We need nothing special to support English on Emacs. Selecting -;; English as a language environment is one of the ways to reset -;; various multilingual environment to the original settting. - -;; modified for XEmacs by MORIOKA Tomohiko - -;;; Code - -(defun setup-english-environment () - "Reset multilingual environment of Emacs to the default status. -The default status is as follows. - - The default value of enable-multibyte-characters is t. - - The default value of buffer-file-coding-system is nil. - The coding system for terminal output is nil. - The coding system for keyboard input is nil. - - The order of priorities of coding categories and the coding system - bound to each category are as follows - coding category coding system - -------------------------------------------------- - coding-category-iso-7 iso-2022-7bit - coding-category-iso-8-1 iso-8859-1 - coding-category-iso-8-2 iso-8859-1 - coding-category-iso-7-else iso-2022-7bit-lock - coding-category-iso-8-else iso-2022-8bit-ss2 - coding-category-emacs-mule no-conversion - coding-category-sjis japanese-shift-jis - coding-category-big5 chinese-big5 - coding-category-binarry no-conversion -" - (interactive) - ;; (setq-default enable-multibyte-characters t) - - ;; (setq coding-category-iso-7 'iso-2022-7bit - ;; coding-category-iso-8-1 'iso-8859-1 - ;; coding-category-iso-8-2 'iso-8859-1 - ;; coding-category-iso-7-else 'iso-2022-7bit-lock - ;; coding-category-iso-8-else 'iso-2022-8bit-ss2 - ;; coding-category-emacs-mule 'no-conversion - ;; coding-category-sjis 'japanese-shift-jis - ;; coding-category-big5 'chinese-big5 - ;; coding-category-binary 'binary) - (set-coding-category-system 'iso-7 'iso-2022-7bit) - (set-coding-category-system 'iso-8-1 'iso-8859-1) - (set-coding-category-system 'iso-8-2 'iso-8859-1) - (set-coding-category-system 'iso-lock-shift 'iso-2022-lock) - (set-coding-category-system 'iso-8-designate 'ctext) - (set-coding-category-system 'no-conversion 'no-conversion) - (set-coding-category-system 'shift-jis 'shift_jis) - (set-coding-category-system 'big5 'big5) - - ;; (set-coding-priority - ;; '(coding-category-iso-7 - ;; coding-category-iso-8-2 - ;; coding-category-iso-8-1 - ;; coding-category-iso-7-else - ;; coding-category-iso-8-else - ;; coding-category-emacs-mule - ;; coding-category-raw-text - ;; coding-category-sjis - ;; coding-category-big5 - ;; coding-category-binary)) - (set-coding-priority-list - '(iso-7 - iso-8-2 - iso-8-1 - iso-8-designate - iso-lock-shift - no-conversion - shift-jis - big5)) - - (set-default-coding-systems nil) - ;; Don't alter the terminal and keyboard coding systems here. - ;; The terminal still supports the same coding system - ;; that it supported a minute ago. -;;; (set-terminal-coding-system-internal nil) -;;; (set-keyboard-coding-system-internal nil) - - ;;(setq nonascii-insert-offset 0) - ) - -(set-language-info-alist - "English" '((setup-function . setup-english-environment) - (tutorial . "TUTORIAL") - (charset . (ascii)) - (sample-text . "Hello!, Hi!, How are you?") - (documentation . "\ -Nothing special is needed to handle English.") - )) - -;; Make "ASCII" an alias of "English" language environment. -(set-language-info-alist - "ASCII" (cdr (assoc "English" language-info-alist))) - -;;; english.el ends here diff --git a/lisp/mule/european.el b/lisp/mule/european.el deleted file mode 100644 index 7feb4e4..0000000 --- a/lisp/mule/european.el +++ /dev/null @@ -1,386 +0,0 @@ -;;; european.el --- Support for European languages - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, European - -;; 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: - -;; For Europeans, five character sets ISO8859-1,2,3,4,9 are supported. - -;;; Code: - -;; For syntax of Latin-1 characters. -(loop for c from 64 to 127 ; from ',A@(B' to ',A(B' - do (modify-syntax-entry (make-char 'latin-iso8859-1 c) "w")) - -(modify-syntax-entry (make-char 'latin-iso8859-1 32) "w") ; no-break space -(modify-syntax-entry ?,AW(B "_") -(modify-syntax-entry ?,Aw(B "_") - -;; For syntax of Latin-2 -(loop for c in '(?,B!(B ?,B#(B ?,B%(B ?,B&(B ?,B)(B ?,B*(B ?,B+(B ?,B,(B ?,B.(B ?,B/(B ?,B1(B ?,B3(B ?,B5(B ?,B6(B ?,B9(B ?,B:(B ?,B;(B ?,B<(B) - do (modify-syntax-entry c "w")) - -(loop for c from 62 to 126 - do (modify-syntax-entry (make-char 'latin-iso8859-2 c) "w")) - -(modify-syntax-entry (make-char 'latin-iso8859-2 32) "w") ; no-break space -(modify-syntax-entry ?,BW(B ".") -(modify-syntax-entry ?,Bw(B ".") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; EUROPEANS -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (define-prefix-command 'describe-european-environment-map) -;; (define-key-after describe-language-environment-map [European] -;; '("European" . describe-european-environment-map) -;; t) - -;; (define-prefix-command 'setup-european-environment-map) -;; (define-key-after setup-language-environment-map [European] -;; '("European" . setup-european-environment-map) -;; t) - -;; Setup for LANGAUGE which uses one-byte 8-bit CHARSET, one-byte -;; 8-bit CODING-SYSTEM, and INPUT-METHOD. -(defun setup-8-bit-environment (language charset coding-system input-method) - (setup-english-environment) - (set-default-coding-systems coding-system) - ;; (setq coding-category-iso-8-1 coding-system - ;; coding-category-iso-8-2 coding-system) - (set-coding-category-system 'iso-8-1 coding-system) - (set-coding-category-system 'iso-8-2 coding-system) - - ;; (if charset - ;; (let ((nonascii-offset (- (make-char charset) 128))) - ;; ;; Set up for insertion of characters in this character set - ;; ;; when codes 0200 - 0377 are typed in. - ;; (setq nonascii-insert-offset nonascii-offset))) - - (if input-method - (setq default-input-method input-method)) - - ;; If this is a Latin-N character set, set up syntax for it in - ;; single-byte mode. We can't use require because the file - ;; must be eval'd each time in case we change from one Latin-N to another. - ;; (if (string-match "^Latin-\\([1-9]\\)$" language) - ;; (load (downcase language) nil t)) - ) - -;; Latin-1 (ISO-8859-1) - -;; (make-coding-system -;; 'iso-latin-1 2 ?1 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-1, Compound Text Encoding)" -;; '((ascii t) (latin-iso8859-1 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil nil nil nil nil nil t)) - -;; (define-coding-system-alias 'iso-8859-1 'iso-latin-1) -;; (define-coding-system-alias 'latin-1 'iso-latin-1) -;; (define-coding-system-alias 'ctext 'iso-latin-1) - -(defun setup-latin1-environment () - "Set up multilingual environment (MULE) for European Latin-1 users." - (interactive) - (setup-8-bit-environment "Latin-1" 'latin-iso8859-1 'iso-8859-1 - "latin-1-prefix")) - -(set-language-info-alist - "Latin-1" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "German" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.de") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "French" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.fr") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "Norwegian" '((setup-function . (setup-latin1-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-1)) - (coding-system . (iso-8859-1)) - (tutorial . "TUTORIAL.no") - (sample-text - . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") - (documentation . ("\ -These languages are supported with the Latin-1 (ISO-8859-1) character set: - Danish, Dutch, English, Faeroese, Finnish, French, German, Icelandic, - Irish, Italian, Norwegian, Portuguese, Spanish, and Swedish. -" . describe-european-environment-map)) - )) - -;; Latin-2 (ISO-8859-2) - -;; (make-coding-system -;; 'iso-latin-2 2 ?2 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-2)" -;; '((ascii t) (latin-iso8859-2 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -;; (define-coding-system-alias 'iso-8859-2 'iso-latin-2) -;; (define-coding-system-alias 'latin-2 'iso-latin-2) - -(make-coding-system - 'iso-8859-2 'iso2022 "MIME ISO-8859-2" - '(charset-g0 ascii - charset-g1 latin-iso8859-2 - charset-g2 t - charset-g3 t - mnemonic "MIME/Ltn-2" - )) - -(defun setup-latin2-environment () - "Set up multilingual environment (MULE) for European Latin-2 users." - (interactive) - (setup-8-bit-environment "Latin-2" 'latin-iso8859-2 'iso-8859-2 - "latin-2-prefix")) - -(set-language-info-alist - "Latin-2" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "Croatian" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.hr") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "Polish" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.pl") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) - -(set-language-info-alist - "Romanian" '((setup-function . (setup-latin2-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-2)) - (tutorial . "TUTORIAL.ro") - (coding-system . (iso-8859-2)) - (documentation . ("\ -These languages are supported with the Latin-2 (ISO-8859-2) character set: - Albanian, Czech, English, German, Hungarian, Polish, Romanian, - Serbian, Croatian, Slovak, Slovene, and Swedish. -" . describe-european-environment-map)) - )) - -;; Latin-3 (ISO-8859-3) - -;; (make-coding-system -;; 'iso-latin-3 2 ?3 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-3)" -;; '((ascii t) (latin-iso8859-3 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -;; (define-coding-system-alias 'iso-8859-3 'iso-latin-3) -;; (define-coding-system-alias 'latin-3 'iso-latin-3) - -(make-coding-system - 'iso-8859-3 'iso2022 "MIME ISO-8859-3" - '(charset-g0 ascii - charset-g1 latin-iso8859-3 - charset-g2 t - charset-g3 t - mnemonic "MIME/Ltn-3" - )) - -(defun setup-latin3-environment () - "Set up multilingual environment (MULE) for European Latin-3 users." - (interactive) - (setup-8-bit-environment "Latin-3" 'latin-iso8859-3 'iso-8859-3 - "latin-3-prefix")) - -(set-language-info-alist - "Latin-3" '((setup-function . (setup-latin3-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-3)) - (coding-system . (iso-8859-3)) - (documentation . ("\ -These languages are supported with the Latin-3 (ISO-8859-3) character set: - Afrikaans, Catalan, Dutch, English, Esperanto, French, Galician, - German, Italian, Maltese, Spanish, and Turkish. -" . describe-european-environment-map)) - )) - -;; Latin-4 (ISO-8859-4) - -;; (make-coding-system -;; 'iso-latin-4 2 ?4 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-4)" -;; '((ascii t) (latin-iso8859-4 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -;; (define-coding-system-alias 'iso-8859-4 'iso-latin-4) -;; (define-coding-system-alias 'latin-4 'iso-latin-4) - -(make-coding-system - 'iso-8859-4 'iso2022 "MIME ISO-8859-4" - '(charset-g0 ascii - charset-g1 latin-iso8859-4 - charset-g2 t - charset-g3 t - mnemonic "MIME/Ltn-4" - )) - -(defun setup-latin4-environment () - "Set up multilingual environment (MULE) for European Latin-4 users." - (interactive) - (setup-8-bit-environment "Latin-4" 'latin-iso8859-4 'iso-8859-4 - "latin-4-prefix")) - -(set-language-info-alist - "Latin-4" '((setup-function . (setup-latin4-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-4)) - (coding-system . (iso-8859-4)) - (documentation . ("\ -These languages are supported with the Latin-4 (ISO-8859-4) character set: - Danish, English, Estonian, Finnish, German, Greenlandic, Lappish, - Latvian, Lithuanian, and Norwegian. -" . describe-european-environment-map)) - )) - -;; Latin-5 (ISO-8859-9) - -;; (make-coding-system -;; 'iso-latin-5 2 ?9 -;; "ISO 2022 based 8-bit encoding (MIME:ISO-8859-9)" -;; '((ascii t) (latin-iso8859-9 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -;; (define-coding-system-alias 'iso-8859-9 'iso-latin-5) -;; (define-coding-system-alias 'latin-5 'iso-latin-5) - -(make-coding-system - 'iso-8859-9 'iso2022 "MIME ISO-8859-9" - '(charset-g0 ascii - charset-g1 latin-iso8859-9 - charset-g2 t - charset-g3 t - mnemonic "MIME/Ltn-5" - )) - -(defun setup-latin5-environment () - "Set up multilingual environment (MULE) for European Latin-5 users." - (interactive) - (setup-8-bit-environment "Latin-5" 'latin-iso8859-9 'iso-8859-5 - "latin-5-prefix")) - -(set-language-info-alist - "Latin-5" '((setup-function . (setup-latin5-environment - . setup-european-environment-map)) - (charset . (ascii latin-iso8859-9)) - (coding-system . (iso-8859-5)) - (documentation . ("\ -These languages are supported with the Latin-5 (ISO-8859-9) character set. -" . describe-european-environment-map)) - )) - -;; (defun setup-european-environment () -;; "Setup multilingual environment (MULE) for European languages users. -;; It actually reset MULE to the default status, and -;; set quail-latin-1 as the default input method to be selected. -;; See also the documentation of setup-english-environment." -;; (setup-english-environment) -;; (setq default-input-method '("European" . "quail-latin-1"))) - -;; (defun describe-european-support () -;; "Describe how Emacs support European languages." -;; (interactive) -;; (describe-language-support-internal "European")) - -;; (set-language-info-alist -;; "European" '((setup-function . setup-european-environment) -;; (describe-function . describe-european-support) -;; (charset . (ascii latin-iso8859-1 latin-iso8859-2 -;; latin-iso8859-3 latin-iso8859-4 latin-iso8859-9)) -;; (coding-system . (iso-8859-1 iso-8859-2 iso-8859-3 -;; iso-8859-4 iso-8859-9)) -;; (sample-text -;; . "Hello, Hej, Tere, Hei, Bonjour, Gr,A|_(B Gott, Ciao, ,A!(BHola!") -;; (documentation . "\ -;; Almost all of European languages are supported by the character sets and -;; coding systems listed below. -;; To input them, LEIM (Libraries for Emacs Input Methods) should have been -;; installed.") -;; )) - -;;; european.el ends here diff --git a/lisp/mule/greek.el b/lisp/mule/greek.el deleted file mode 100644 index b878c67..0000000 --- a/lisp/mule/greek.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; greek.el --- Support for Greek - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, Greek - -;; 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: - -;; For Greek, the character set ISO8859-7 is supported. - -;;; Code: - -;; For syntax of Greek -(loop for c from 54 to 126 - do (modify-syntax-entry (make-char 'greek-iso8859-7 c) "w")) -(modify-syntax-entry (make-char 'greek-iso8859-7 32) "w") ; no-break space -(modify-syntax-entry ?,F7(B ".") -(modify-syntax-entry ?,F;(B ".") -(modify-syntax-entry ?,F=(B ".") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; GREEK -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (define-language-environment 'greek -;; "Greek" -;; (lambda () -;; (set-coding-category-system 'iso-8-designate 'iso-8859-7) -;; (set-coding-priority-list '(iso-8-designate iso-8-1)) -;; (set-default-buffer-file-coding-system 'iso-8859-7) -;; (setq terminal-coding-system 'iso-8859-7) -;; (setq keyboard-coding-system 'iso-8859-7) -;; ;; (setq-default quail-current-package -;; ;; (assoc "greek" quail-package-alist)) -;; )) - -;; (make-coding-system -;; 'iso-8859-7 2 ?7 "MIME ISO-8859-7" -;; '((ascii t) (greek-iso8859-7 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil)) - -(make-coding-system - 'iso-8859-7 'iso2022 "MIME ISO-8859-7" - '(charset-g0 ascii - charset-g1 greek-iso8859-7 - charset-g2 t - charset-g3 t - mnemonic "Grk" - )) - -(defun setup-greek-environment () - "Setup multilingual environment (MULE) for Greek." - (interactive) - (setup-8-bit-environment "Greek" 'greek-iso8859-7 'iso-8859-7 "greek") - ) - -(set-language-info-alist - "Greek" '((setup-function . setup-greek-environment) - (charset . (greek-iso8859-7)) - (coding-system . (iso-8859-7)) - (sample-text . "Greek (,FGkk]mija(B) ,FCei\(B ,Fsar(B") - (documentation . t))) - -;;; greek.el ends here diff --git a/lisp/mule/hebrew.el b/lisp/mule/hebrew.el deleted file mode 100644 index 767fc0a..0000000 --- a/lisp/mule/hebrew.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; hebrew.el --- Support for Hebrew - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: multilingual, Hebrew - -;; 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: - -;; For Hebrew, the character sets ISO8859-8 is supported. - -;;; Code: - -;; Syntax of Hebrew characters -(loop for c from 96 to 122 - do (modify-syntax-entry (make-char 'hebrew-iso8859-8 c) "w")) -(modify-syntax-entry (make-char 'hebrew-iso8859-8 32) "w") ; no-break space - - -;; (make-coding-system -;; 'hebrew-iso-8bit 2 ?8 -;; "ISO 2022 based 8-bit encoding for Hebrew (MIME:ISO-8859-8)" -;; '((ascii t) (hebrew-iso8859-8 t) nil nil -;; nil ascii-eol ascii-cntl nil nil nil nil nil t)) - -;; (define-coding-system-alias 'iso-8859-8 'hebrew-iso-8bit) - -(make-coding-system - 'iso-8859-8 'iso2022 - "MIME ISO-8859-8" - '(charset-g0 ascii - charset-g1 hebrew-iso8859-8 - charset-g2 t - charset-g3 t - no-iso6429 t - mnemonic "MIME/Hbrw" -)) - -(make-coding-system - 'ctext-hebrew 'iso2022 - "Coding-system of Hebrew." - '(charset-g0 ascii - charset-g1 hebrew-iso8859-8 - charset-g2 t - charset-g3 t - mnemonic "CText/Hbrw" - )) - -(defun setup-hebrew-environment () - "Setup multilingual environment (MULE) for Hebrew. -But, please note that right-to-left writing is not yet supported." - (interactive) - (setup-8-bit-environment "Hebrew" 'hebrew-iso8859-8 'iso-8859-8 - "hebrew") - (set-coding-category-system 'iso-8-designate 'iso-8859-8) - (set-coding-priority-list - '(iso-8-designate - iso-8-1 - iso-7 - iso-8-2 - iso-lock-shift - no-conversion - shift-jis - big5)) - ) - -(set-language-info-alist - "Hebrew" '((setup-function . setup-hebrew-environment) - (describe-function . describe-hebrew-support) - (charset . (hebrew-iso8859-8)) - (coding-system . (iso-8859-8)) - (sample-text . "Hebrew ,Hylem(B") - (documentation . "Right-to-left writing is not yet supported.") - )) - -;;; hebrew.el ends here diff --git a/lisp/mule/japanese.el b/lisp/mule/japanese.el deleted file mode 100644 index fbc7328..0000000 --- a/lisp/mule/japanese.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; japanese.el --- Japanese support - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, Japanese - -;; 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: - -;; For Japanese, character sets JISX0201, JISX0208, JISX0212 are -;; supported. - -;;; Code: - -;;; Syntax of Japanese characters. -(modify-syntax-entry 'katakana-jisx0201 "w") -(modify-syntax-entry 'japanese-jisx0212 "w") - -(modify-syntax-entry 'japanese-jisx0208 "w") -(loop for row in '(33 34 40) - do (modify-syntax-entry `[japanese-jisx0208 ,row] "_")) -(loop for char in '(?$B!<(B ?$B!+(B ?$B!,(B ?$B!3(B ?$B!4(B ?$B!5(B ?$B!6(B ?$B!7(B ?$B!8(B ?$B!9(B ?$B!:(B ?$B!;(B) - do (modify-syntax-entry char "w")) -(modify-syntax-entry ?\$B!J(B "($B!K(B") -(modify-syntax-entry ?\$B!N(B "($B!O(B") -(modify-syntax-entry ?\$B!P(B "($B!Q(B") -(modify-syntax-entry ?\$B!V(B "($B!W(B") -(modify-syntax-entry ?\$B!X(B "($B!Y(B") -(modify-syntax-entry ?\$B!K(B ")$B!J(B") -(modify-syntax-entry ?\$B!O(B ")$B!N(B") -(modify-syntax-entry ?\$B!Q(B ")$B!P(B") -(modify-syntax-entry ?\$B!W(B ")$B!V(B") -(modify-syntax-entry ?\$B!Y(B ")$B!X(B") - -;;; Character categories S, A, H, K, G, Y, and C -(define-category ?S "Japanese 2-byte symbol character.") -(modify-category-entry [japanese-jisx0208 33] ?S) -(modify-category-entry [japanese-jisx0208 34] ?S) -(modify-category-entry [japanese-jisx0208 40] ?S) -(define-category ?A "Japanese 2-byte Alphanumeric character.") -(modify-category-entry [japanese-jisx0208 35] ?A) -(define-category ?H "Japanese 2-byte Hiragana character.") -(modify-category-entry [japanese-jisx0208 36] ?H) -(define-category ?K "Japanese 2-byte Katakana character.") -(modify-category-entry [japanese-jisx0208 37] ?K) -(define-category ?G "Japanese 2-byte Greek character.") -(modify-category-entry [japanese-jisx0208 38] ?G) -(define-category ?Y "Japanese 2-byte Cyrillic character.") -(modify-category-entry [japanese-jisx0208 39] ?Y) -(define-category ?C "Japanese 2-byte Kanji characters.") -(loop for row from 48 to 126 - do (modify-category-entry `[japanese-jisx0208 ,row] ?C)) -(loop for char in '(?$B!<(B ?$B!+(B ?$B!,(B) - do (modify-category-entry char ?K) - (modify-category-entry char ?H)) -(loop for char in '(?$B!3(B ?$B!4(B ?$B!5(B ?$B!6(B ?$B!7(B ?$B!8(B ?$B!9(B ?$B!:(B ?$B!;(B) - do (modify-category-entry char ?C)) -(modify-category-entry 'japanese-jisx0212 ?C) - -(defvar japanese-word-regexp - "\\cA+\\cH*\\|\\cK+\\cH*\\|\\cC+\\cH*\\|\\cH+\\|\\ck+\\|\\sw+" - "Regular expression used to match a Japanese word.") - -(set-word-regexp japanese-word-regexp) -(setq forward-word-regexp "\\w\\>") -(setq backward-word-regexp "\\<\\w") - -;;; Paragraph setting -(setq sentence-end - (concat - "\\(" - "\\(" - "[.?!][]\"')}]*" - "\\|" - "[$B!%!)!*(B][$B!O!I!G!K!Q!M!S!U!W!Y(B]*" - "\\)" - "\\($\\|\t\\| \\)" - "\\|" - "$B!#(B" - "\\)" - "[ \t\n]*")) -(setq paragraph-start "^[ $B!!(B\t\n\f]") -(setq paragraph-separate "^[ $B!!(B\t\f]*$") - -;; EGG specific setup -(define-egg-environment 'japanese - "Japanese settings for egg." - (lambda () - (when (not (featurep 'egg-jpn)) - (load "its-hira") - (load "its-kata") - (load "its-hankaku") - (load "its-zenkaku") - (setq its:*standard-modes* - (append - (list (its:get-mode-map "roma-kana") - (its:get-mode-map "roma-kata") - (its:get-mode-map "downcase") - (its:get-mode-map "upcase") - (its:get-mode-map "zenkaku-downcase") - (its:get-mode-map "zenkaku-upcase")) - its:*standard-modes*)) - (provide 'egg-jpn)) - (setq wnn-server-type 'jserver) - ;; Can't do this here any more. Must do it when selecting egg-wnn - ;; or egg-sj3 - ;; (setq egg-default-startup-file "eggrc-wnn") - (setq-default its:*current-map* (its:get-mode-map "roma-kana")))) - -;; stuff for providing gramatic processing of Japanese text -;; something like this should probably be created for all environments... - -(defvar aletter (concat "\\(" ascii-char "\\|" kanji-char "\\)")) -(defvar kanji-space-insertable (concat - "$B!"(B" aletter "\\|" - "$B!#(B" aletter "\\|" - aletter "$B!J(B" "\\|" - "$B!K(B" aletter "\\|" - ascii-alphanumeric kanji-kanji-char "\\|" - kanji-kanji-char ascii-alphanumeric )) - -(defvar space-insertable (concat " " aletter "\\|" kanji-space-insertable) - "Regexp for finding points that can have spaces inserted into them for justification") - -;; (make-coding-system -;; 'iso-2022-jp 2 ?J -;; "ISO 2022 based 7bit encoding for Japanese (MIME:ISO-2022-JP)" -;; '((ascii japanese-jisx0208-1978 japanese-jisx0208 -;; latin-jisx0201 japanese-jisx0212 katakana-jisx0201 t) nil nil nil -;; short ascii-eol ascii-cntl seven)) - -;; (define-coding-system-alias 'junet 'iso-2022-jp) - -(make-coding-system - 'iso-2022-jp 'iso2022 - "Coding-system used for communication with mail and news in Japan." - '(charset-g0 ascii - short t - seven t - input-charset-conversion ((latin-jisx0201 ascii) - (japanese-jisx0208-1978 japanese-jisx0208)) - mnemonic "MULE/7bit" - )) - -(copy-coding-system 'iso-2022-jp 'junet) - -;; (make-coding-system -;; 'shift_jis 1 ?S -;; "Coding-system of Shift-JIS used in Japan." t) - -(make-coding-system - 'shift_jis 'shift-jis - "Coding-system of Shift-JIS used in Japan." - '(mnemonic "Ja/SJIS")) - -;;(define-coding-system-alias 'shift_jis 'sjis) - -(copy-coding-system 'shift_jis 'sjis) - -;; (make-coding-system -;; 'iso-2022-jp-1978-irv 2 ?J -;; "Coding-system used for old jis terminal." -;; '((ascii t) nil nil nil -;; short ascii-eol ascii-cntl seven nil nil use-roman use-oldjis)) - -(make-coding-system - 'iso-2022-jp-1978-irv 'iso2022 - "Coding-system used for old JIS terminal." - '(charset-g0 ascii - short t - seven t - output-charset-conversion ((ascii latin-jisx0201) - (japanese-jisx0208 japanese-jisx0208-1978)) - mnemonic "Ja-78/7bit" - )) - -;;(define-coding-system-alias 'iso-2022-jp-1978-irv 'old-jis) - -(copy-coding-system 'iso-2022-jp-1978-irv 'old-jis) - -;; (make-coding-system -;; 'euc-japan-1990 2 ?E -;; "Coding-system of Japanese EUC (Extended Unix Code)." -;; '(ascii japanese-jisx0208 katakana-jisx0201 japanese-jisx0212 -;; short ascii-eol ascii-cntl nil nil single-shift)) - -(make-coding-system - 'euc-jp 'iso2022 - "Coding-system of Japanese EUC (Extended Unix Code)." - '(charset-g0 ascii - charset-g1 japanese-jisx0208 - charset-g2 katakana-jisx0201 - charset-g3 japanese-jisx0212 - short t - mnemonic "Ja/EUC" - )) - -;;(define-coding-system-alias 'euc-japan-1990 'euc-japan) - -(copy-coding-system 'euc-jp 'euc-japan) ; only for w3 -(copy-coding-system 'euc-jp 'japanese-euc) - -(set-language-info-alist - "Japanese" '((setup-function . setup-japanese-environment) - (tutorial . "TUTORIAL.ja") - (charset . (japanese-jisx0208 japanese-jisx0208-1978 - japanese-jisx0212 latin-jisx0201 - katakana-jisx0201)) - (coding-system . (iso-2022-jp euc-jp - shift_jis iso-2022-jp-1978-irv)) - (sample-text . "Japanese ($BF|K\8l(B) $B$3$s$K$A$O(B, (I:]FAJ(B") - (documentation . t))) - -;;; japanese.el ends here diff --git a/lisp/mule/kinsoku.el b/lisp/mule/kinsoku.el deleted file mode 100644 index 94cf414..0000000 --- a/lisp/mule/kinsoku.el +++ /dev/null @@ -1,285 +0,0 @@ -;; kinsoku.el -- Kinsoku (line wrap) processing for XEmacs/Mule - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; This file is part of Mule (MULtilingual Enhancement of XEmacs). -;; This file contains Japanese and Chinese characters. - -;; 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. - -;; Written by Jareth Hein (jhod@po.iijnet.or.jp) based off of -;; code by S.Tomura, Electrotechnical Lab. (tomura@etl.go.jp) from -;; Mule-2.3 - -;;; Special characters for JIS code -;;; "$B!!!"!#!$!%!&!'!'!(!)!*!+!,!-!.!/(B" -;;; "$B!0!1!2!3!4!5!6!7!8!9!:!;!!?(B" -;;; "$B!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O(B" -;;; "$B!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_(B" -;;; "$B!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o(B" -;;; "$B!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~(B" -;;; "$B"!"""#"$"%"&"'"(")"*"+","-".(B " -;;; "$B&!&"&#&$&%&&&'&(&)&*&+&,&-&.&/(B" -;;; "$B&0&1&2&3&4&5&6&7&8(B" -;;; "$B&A&B&C&D&E&F&G&H&I&J&K&L&M&N&O(B" -;;; "$B&P&Q&R&S&T&U&V&W&X(B" -;;; "$B'!'"'#'$'%'&'''(')'*'+','-'.'/(B" -;;; "$B'0'1'2'3'4'5'6'7'8'9':';'<'='>'?(B" -;;; "$B'@'A(B" -;;; "$B'Q'R'S'T'U'V'W'X'Y'Z'['\']'^'_!I(B -;;; "$B'`'a'b'c'd'e'f'g'h'i'j'k'l'm'n'o(B" -;;; "$B'p'q(B" -;;; $B#0#1#2#3#4#5#6#7#8#9#A#B#C#D#E#F(B -;;; "$B$!$#$%$'$)$C$c$e$g$n(B" -;;; "$B%!%#%%%'%)%C%c%e%g%n%u%v(B" - -;;; Special characters for GB -;;; -;;; $A!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/(B -;;;$A!0!1!2!3!4!5!6!7!8!9!:!;!!?(B -;;;$A!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O(B -;;;$A!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_(B -;;;$A!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o(B -;;;$A!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~(B -;;; $A"1"2"3"4"5"6"7"8"9":";"<"=">"?(B -;;;$A"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O(B -;;;$A"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_(B -;;;$A"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o(B -;;;$A"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~(B -;;; $A#!#"###$#%#&#'#(#)#*#+#,#-#.#/(B -;;;$A#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?(B -;;;$A#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O(B -;;;$A#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_(B -;;;$A#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o(B -;;;$A#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~(B -;;; $A$!$"$#$$$%$&$'$($)$*$+$,$-$.$/(B -;;;$A$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?(B -;;;$A$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O(B -;;;$A$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_(B -;;;$A$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o(B -;;;$A$p$q$r$s$t$u$v$w$x$y$z${$|$}$~(B -;;; $A%!%"%#%$%%%&%'%(%)%*%+%,%-%.%/(B -;;;$A%0%1%2%3%4%5%6%7%8%9%:%;%<%=%>%?(B -;;;$A%@%A%B%C%D%E%F%G%H%I%J%K%L%M%N%O(B -;;;$A%P%Q%R%S%T%U%V%W%X%Y%Z%[%\%]%^%_(B -;;;$A%`%a%b%c%d%e%f%g%h%i%j%k%l%m%n%o(B -;;;$A%p%q%r%s%t%u%v%w%x%y%z%{%|%}%~(B -;;; $A&!&"&#&$&%&&&'&(&)&*&+&,&-&.&/(B -;;;$A&0&1&2&3&4&5&6&7&8&9&:&;&<&=&>&?(B -;;;$A&@&A&B&C&D&E&F&G&H&I&J&K&L&M&N&O(B -;;;$A&P&Q&R&S&T&U&V&W&X&Y&Z&[&\&]&^&_(B -;;;$A&`&a&b&c&d&e&f&g&h&i&j&k&l&m&n&o(B -;;;$A&p&q&r&s&t&u&v&w&x&y&z&{&|&}&~(B -;;; $A'!'"'#'$'%'&'''(')'*'+','-'.'/(B -;;;$A'0'1'2'3'4'5'6'7'8'9':';'<'='>'?(B -;;;$A'@'A'B'C'D'E'F'G'H'I'J'K'L'M'N'O(B -;;;$A'P'Q'R'S'T'U'V'W'X'Y'Z'['\']'^'_(B -;;;$A'`'a'b'c'd'e'f'g'h'i'j'k'l'm'n'o(B -;;;$A'p'q'r's't'u'v'w'x'y'z'{'|'}'~(B -;;; $A(!("(#($(%(&('((()(*(+(,(-(.(/(B -;;;$A(0(1(2(3(4(5(6(7(8(9(:(;(<(=(>(?(B -;;;$A(@(A(B(C(D(E(F(G(H(I(J(K(L(M(N(O(B -;;;$A(P(Q(R(S(T(U(V(W(X(Y(Z([(\(](^(_(B -;;;$A(`(a(b(c(d(e(f(g(h(i(j(k(l(m(n(o(B - -;;; Special characters for BIG5 -;;; -;;; $(0!!!"!#!$!%!&!'!(!)!*!+!,!-!.!/(B -;;;$(0!0!1!2!3!4!5!6!7!8!9!:!;!!?(B -;;;$(0!@!A!B!C!D!E!F!G!H!I!J!K!L!M!N!O(B -;;;$(0!P!Q!R!S!T!U!V!W!X!Y!Z![!\!]!^!_(B -;;;$(0!`!a!b!c!d!e!f!g!h!i!j!k!l!m!n!o(B -;;;$(0!p!q!r!s!t!u!v!w!x!y!z!{!|!}!~(B -;;; $(0"!"""#"$"%"&"'"(")"*"+","-"."/(B -;;;$(0"0"1"2"3"4"5"6"7"8"9":";"<"=">"?(B -;;;$(0"@"A"B"C"D"E"F"G"H"I"J"K"L"M"N"O(B -;;;$(0"P"Q"R"S"T"U"V"W"X"Y"Z"["\"]"^"_(B -;;;$(0"`"a"b"c"d"e"f"g"h"i"j"k"l"m"n"o(B -;;;$(0"p"q"r"s"t"u"v"w"x"y"z"{"|"}"~(B -;;; $(0#!#"###$#%#&#'#(#)#*#+#,#-#.#/(B -;;;$(0#0#1#2#3#4#5#6#7#8#9#:#;#<#=#>#?(B -;;;$(0#@#A#B#C#D#E#F#G#H#I#J#K#L#M#N#O(B -;;;$(0#P#Q#R#S#T#U#V#W#X#Y#Z#[#\#]#^#_(B -;;;$(0#`#a#b#c#d#e#f#g#h#i#j#k#l#m#n#o(B -;;;$(0#p#q#r#s#t#u#v#w#x#y#z#{#|#}#~(B -;;; $(0$!$"$#$$$%$&$'$($)$*$+$,$-$.$/(B -;;;$(0$0$1$2$3$4$5$6$7$8$9$:$;$<$=$>$?(B -;;;$(0$@$A$B$C$D$E$F$G$H$I$J$K$L$M$N$O(B -;;;$(0$P$Q$R$S$T$U$V$W$X$Y$Z$[$\$]$^$_(B -;;;$(0$`$a$b$c$d$e$f$g$h$i$j$k$l$m$n$o(B -;;;$(0$p$q$r$s$t$u$v$w$x$y$z${$|$}$~(B -;;; $(0%!%"%#%$%%%&%'%(%)%*%+%,%-%.%/(B -;;;$(0%0%1%2%3%4%5%6%7%8%9%:%;%<%=%>%?(B - -(defvar kinsoku-ascii nil "Do kinsoku-processing for ASCII.") -(make-variable-buffer-local 'kinsoku-ascii) -(set-default 'kinsoku-ascii nil) -(defvar kinsoku-jis t "Do kinsoku-processing for JISX0208.") -(make-variable-buffer-local 'kinsoku-jis) -(set-default 'kinsoku-jis t) -(defvar kinsoku-gb t "Do kinsoku-processing for GB2312.") -(make-variable-buffer-local 'kinsoku-gb) -(set-default 'kinsoku-gb t) -(defvar kinsoku-big5 t "Do kinsoku-processing for Big5..") -(make-variable-buffer-local 'kinsoku-big5) -(set-default 'kinsoku-big5 t) - -(defvar kinsoku-ascii-bol "!)-_~}]:;',.?" "BOL kinsoku for ASCII.") -(defvar kinsoku-ascii-eol "({[" "EOL kinsoku for ASCII.") -(defvar kinsoku-jis-bol - (concat "$B!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2!3!4!5!6!7!8!9!:!;!(B" - "$B!?!@!A!B!C!D!E!G!I!K!M!O!Q!S!U!W!Y![!k!l!m!n(B" - "$B$!$#$%$'$)$C$c$e$g$n%!%#%%%'%)%C%c%e%g%n%u%v(B") - "BOL kinsoku for JISX0208.") -(defvar kinsoku-jis-eol - "$B!F!H!J!L!N!P!R!T!V!X!Z!k!l!m!n!w!x(B" - "EOL kinsoku for JISX0208.") -(defvar kinsoku-gb-bol - (concat "$A!"!##.#,!$!%!&!'!(!)!*!+!,!-!/!1#)!3!5!7!9!;!=(B" - "$A!?#;#:#?#!!@!A!B!C!c!d!e!f#/#\#"#_#~#|(e(B") - "BOL kinsoku for GB2312.") -(defvar kinsoku-gb-eol - (concat "$A!.!0#"#(!2!4!6!8!:!!c!d!e#@!f!l(B" - "$A(E(F(G(H(I(J(K(L(M(N(O(P(Q(R(S(T(U(V(W(X(Y(h(B") - "EOL kinsoku for GB2312.") -(defvar kinsoku-big5-bol - (concat "$(0!"!#!$!%!&!'!(!)!*!+!,!-!.!/!0!1!2(B" - "$(0!3!4!5!6!7!8!9!:!;!!@!B!D!F!H!J!L!N!P!R!T!V!X!Z!\!^!`!b(B" - "$(0!d!f!h!j!k!q!p"i"j"k"n"x$u$v$w$x$y$z${(B" - "$(0$|$}$~%!%"%#%$%%%&%'%(%)%*%+%:(B") - "EOL kinsoku for BIG5.") - -(define-category ?s "Kinsoku forbidden start of line characters") -(define-category ?e "Kinsoku forbidden end of line characters") - -;; kinsoku ascii -(loop for char in (string-to-char-list kinsoku-ascii-bol) - do (modify-category-entry char ?s)) -(loop for char in kinsoku-ascii-eol - do (modify-category-entry char ?e)) -;; kinsoku-jis -(loop for char in (string-to-char-list kinsoku-jis-bol) - do (modify-category-entry char ?s)) -(loop for char in (string-to-char-list kinsoku-jis-eol) - do (modify-category-entry char ?e)) -;; kinsoku-gb -(loop for char in kinsoku-gb-bol - do (modify-category-entry char ?s)) -(loop for char in kinsoku-gb-eol - do (modify-category-entry char ?e)) -;; kinsoku-big5 -(loop for char in kinsoku-big5-bol - do (modify-category-entry char ?s)) -(loop for char in kinsoku-big5-eol - do (modify-category-entry char ?e)) - -(defun kinsoku-bol-p () - "Check if point would break forbidden beginning-of-line rules -Uses category \'s\' to check. -point$B$G2~9T$9$k$H9TF,6XB'$K?($l$k$+$I$&$+$r$+$($9!#(B -$B9TF,6XB'J8;z$O(B\'s\'$B$N(Bcategory$B$G;XDj$9$k!#(B" - (let ((ch (char-after))) - (if (and ch - (or - (and kinsoku-ascii (char-in-category-p ch ?a)) - (and kinsoku-jis (char-in-category-p ch ?j)) - (and kinsoku-gb (char-in-category-p ch ?c)) - (and kinsoku-big5 (char-in-category-p ch ?t)))) - (char-in-category-p ch ?s) - nil))) - -(defun kinsoku-eol-p () - "Check if point would break forbidden end-of-line rules -Uses category \'e\' to check. -point$B$G2~9T$9$k$H9TKv6XB'$K?($l$k$+$I$&$+$r$+$($9!#(B -$B9TKv6XB'J8;z$O(B\'s\'$B$N(Bcategory$B$G;XDj$9$k!#(B" - (let ((ch (char-before))) - (if (and ch - (or - (and kinsoku-ascii (char-in-category-p ch ?a)) - (and kinsoku-jis (char-in-category-p ch ?j)) - (and kinsoku-gb (char-in-category-p ch ?c)) - (and kinsoku-big5 (char-in-category-p ch ?t)))) - (char-in-category-p ch ?e) - nil))) - -(defvar kinsoku-extend-limit nil - "Defines how many characters kinsoku will search forward before giving up. -A value of nil equates to infinity. -$B6XB'=hM}$G9T$r?-$P$7$FNI$$H>3QJ8;z?t$r;XDj$9$k!#(B -$BHsIi@0?t0J30$N>l9g$OL58BBg$r0UL#$9$k!#(B") - -(defun kinsoku-process () - "Move to a point that will not break forbidden line break rules. -$B6XB'$K?($l$J$$E@$X0\F0$9$k!#(B -point$B$,9TF,6XB'$K?($l$k>l9g$O9T$r?-$P$7$F!"6XB'$K?($l$J$$E@$rC5$9!#(B -point$B$,9TKv6XB'$K?($l$k>l9g$O9T$r=L$a$F!"6XB'$K?($l$J$$E@$rC5$9!#(B -$B$?$@$7!"9T?-$P$7H>3QJ8;z?t$,(Bkinsoku-extend-limit$B$r1[$($k$H!"(B -$B9T$r=L$a$F6XB'$K?($l$J$$E@$rC5$9!#(B" - (let ((bol-kin nil) (eol-kin nil)) - (if (and (not (bolp)) - (not (eolp)) - (or (setq bol-kin (kinsoku-bol-p)) - (setq eol-kin (kinsoku-eol-p)))) - (cond(bol-kin (kinsoku-process-extend)) - (eol-kin (kinsoku-process-shrink)))))) - -(defun kinsoku-process-extend () - "Move point forward to a permissable for line-breaking. -$B9T$r?-$P$7$F6XB'$K?($l$J$$E@$X0\F0$9$k!#(B" - (let ((max-column (+ fill-column - (if (and (numberp kinsoku-extend-limit) - (>= kinsoku-extend-limit 0)) - kinsoku-extend-limit - 10000))) ;;; 10000 is deliberatly unreasonably large - ch1 ch2) - (while (and (setq ch1 (char-after)) - (<= (+ (current-column) - (char-width ch1 )) - max-column) - (not (bolp)) - (not (eolp)) - (or (kinsoku-eol-p) - (kinsoku-bol-p) - ;;; don't break in the middle of an English word - (and (char-in-category-p ch1 ?a) - (setq ch2 (char-before)) - (char-in-category-p ch2 ?a) - (= ?w (char-syntax ch2)) - (= ?w (char-syntax ch1))))) - (forward-char)) - (if (or (kinsoku-eol-p) (kinsoku-bol-p)) - (kinsoku-process-shrink)))) - -(defun kinsoku-process-shrink () - "Move point backward to a point permissable for line-breaking. -$B9T$r=L$a$F6XB'$K?($l$J$$E@$X0\F0$9$k!#(B" - (let (ch1 ch2) - (while (and (not (bolp)) - (not (eolp)) - (or (kinsoku-bol-p) - (kinsoku-eol-p) - ;;; don't break in the middle of an English word - (and - (char-in-category-p (setq ch1 (following-char)) ?a) - (char-in-category-p (setq ch2 (preceding-char)) ?a) - (= ?w (char-syntax ch2)) - (= ?w (char-syntax ch1))))) - (backward-char)))) diff --git a/lisp/mule/korean.el b/lisp/mule/korean.el deleted file mode 100644 index 2763262..0000000 --- a/lisp/mule/korean.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; korean.el --- Support for Korean - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, Korean - -;; 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: - -;; For Korean, the character set KSC5601 is supported. - -;;; Code: - -;; Syntax of Korean characters. -(loop for row from 33 to 34 do - (modify-syntax-entry `[korean-ksc5601 ,row] ".")) -(loop for row from 35 to 37 do - (modify-syntax-entry `[korean-ksc5601 ,row] "w")) -(loop for row from 38 to 41 do - (modify-syntax-entry `[korean-ksc5601 ,row] ".")) -(loop for row from 42 to 126 do - (modify-syntax-entry `[korean-ksc5601 ,row] "w")) - -;; Setting for coding-system and quail were moved to -;; language/korean.el. - -(make-coding-system - 'iso-2022-int-1 'iso2022 - "ISO-2022-INT-1" - '(charset-g0 ascii - charset-g1 korean-ksc5601 - short t - seven t - lock-shift t - mnemonic "INT-1")) - -;; EGG specific setup -(define-egg-environment 'korean - "Korean settings for egg" - (lambda () - (when (not (featurep 'egg-kor)) - (load "its-hangul") - (setq its:*standard-modes* - (cons (its:get-mode-map "hangul") its:*standard-modes*)) - (provide 'egg-kor)) - (setq wnn-server-type 'kserver) - (setq egg-default-startup-file "eggrc-wnn") - (setq-default its:*current-map* (its:get-mode-map "hangul")))) - -;; (make-coding-system -;; 'euc-kr 2 ?K -;; "Coding-system of Korean EUC (Extended Unix Code)." -;; '((ascii t) korean-ksc5601 nil nil -;; nil ascii-eol ascii-cntl)) - -(make-coding-system - 'euc-kr 'iso2022 - "Coding-system of Korean EUC (Extended Unix Code)." - '(charset-g0 ascii - charset-g1 korean-ksc5601 - mnemonic "ko/EUC" - eol-type nil)) - -;;(define-coding-system-alias 'euc-kr 'euc-korea) - -(copy-coding-system 'euc-kr 'korean-euc) - -;; (make-coding-system -;; 'iso-2022-kr 2 ?k -;; "MIME ISO-2022-KR" -;; '(ascii (nil korean-ksc5601) nil nil -;; nil ascii-eol ascii-cntl seven locking-shift nil nil nil nil nil -;; designation-bol)) - -(make-coding-system - 'iso-2022-kr 'iso2022 - "Coding-System used for communication with mail in Korea." - '(charset-g0 ascii - charset-g1 korean-ksc5601 - force-g1-on-output t - seven t - lock-shift t - mnemonic "Ko/7bit" - eol-type lf)) - -(defun setup-korean-environment () - "Setup multilingual environment (MULE) for Korean." - (interactive) - (setup-english-environment) - ;; (setq coding-category-iso-8-2 'euc-kr) - (set-coding-category-system 'iso-8-2 'euc-kr) - - ;; (set-coding-priority - ;; '(coding-category-iso-7 - ;; coding-category-iso-8-2 - ;; coding-category-iso-8-1)) - (set-coding-priority-list - '(iso-8-2 - iso-7 - iso-8-1 - iso-8-designate - iso-lock-shift - no-conversion - shift-jis - big5)) - - (set-default-coding-systems 'euc-kr) - - ;; (when (eq 'x (device-type (selected-device))) - ;; (x-use-halfwidth-roman-font 'korean-ksc5601 "ksc5636")) - - ;; EGG specific setup 97.02.05 jhod - (when (featurep 'egg) - (when (not (featurep 'egg-kor)) - (provide 'egg-kor) - (load "its-hangul") - (setq its:*standard-modes* - (cons (its:get-mode-map "hangul") its:*standard-modes*))) - (setq-default its:*current-map* (its:get-mode-map "hangul"))) - - (setq default-input-method "korean-hangul")) - -(set-language-info-alist - "Korean" '((setup-function . setup-korean-environment) - (tutorial . "TUTORIAL.ko") - (charset . (korean-ksc5601)) - (coding-system . (iso-2022-kr euc-kr)) - (sample-text . "Hangul ($(CGQ1[(B) $(C>H3gGO<H3gGO=J4O1n(B") - (documentation . t))) - -;;; korean.el ends here diff --git a/lisp/mule/misc-lang.el b/lisp/mule/misc-lang.el deleted file mode 100644 index 236f9b0..0000000 --- a/lisp/mule/misc-lang.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; misc-lang.el --- support for miscellaneous languages (characters) - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: multilingual, character set, coding system - -;; 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: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; IPA (International Phonetic Alphabet) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(make-charset 'ipa "International Phonetic Alphabet" - '(registry "MuleIPA" - dimension 1 - chars 96 - final ?0 - graphic 1 - )) ; for XEmacs - -(defun setup-ipa-environment () - "Setup multilingual environment (MULE) for IPA." - (interactive) - (setup-english-environment)) - -(set-language-info-alist - "IPA" '((setup-function . setup-ipa-environment) - (charset . (ipa)) - (documentation . "\ -IPA is International Phonetic Alphabet for English, French, German -and Italian."))) - -;;; misc-lang.el ends here diff --git a/lisp/mule/mule-category.el b/lisp/mule/mule-category.el deleted file mode 100644 index bcc1e03..0000000 --- a/lisp/mule/mule-category.el +++ /dev/null @@ -1,286 +0,0 @@ -;;; mule-category.el --- category functions for XEmacs/Mule. - -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 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: - -;; Functions for working with category tables, which are a particular -;; type of char table. Some function names / arguments should be -;; parallel with syntax tables. - -;; Written by Ben Wing . The initialization code -;; at the end of this file comes from Mule. -;; Some bugfixes by Jareth Hein - -;;; Code: - -(defvar defined-category-hashtable (make-hashtable 50)) - -(defun define-category (designator doc-string) - "Make a new category whose designator is DESIGNATOR. -DESIGNATOR should be a visible letter of ' ' thru '~'. -STRING is a doc string for the category. -Letters of 'a' thru 'z' are already used or kept for the system." - (check-argument-type 'category-designator-p designator) - (check-argument-type 'stringp doc-string) - (puthash designator doc-string defined-category-hashtable)) - -(defun undefine-category (designator) - "Undefine DESIGNATOR as a designator for a category." - (check-argument-type 'category-designator-p designator) - (remhash designator defined-category-hashtable)) - -(defun defined-category-p (designator) - "Return non-nil if DESIGNATOR is a designator for a defined category." - (and (category-designator-p designator) - (gethash designator defined-category-hashtable))) - -(defun defined-category-list () - "Return a list of the currently defined categories. -Categories are given by their designators." - (let (list) - (maphash #'(lambda (key value) - (setq list (cons key list))) - defined-category-hashtable) - (nreverse list))) - -(defun undefined-category-designator () - "Return an undefined category designator, or nil if there are none." - (let ((a 32) found) - (while (and (< a 127) (not found)) - (if (gethash a defined-category-hashtable) - (setq found a)) - (setq a (1+ a))) - found)) - -(defun category-doc-string (designator) - "Return the doc-string for the category denoted by DESIGNATOR." - (check-argument-type 'defined-category-p designator) - (gethash designator defined-category-hashtable)) - -(defun modify-category-entry (char-range designator &optional table reset) - "Add a category to the categories associated with CHAR-RANGE. -CHAR-RANGE is a single character or a range of characters, - as per `put-char-table'. -The category is given by a designator character. -The changes are made in TABLE, which defaults to the current buffer's - category table. -If optional fourth argument RESET is non-nil, previous categories associated - with CHAR-RANGE are removed before adding the specified category." - (or table (setq table (category-table))) - (check-argument-type 'category-table-p table) - (check-argument-type 'defined-category-p designator) - (if reset - ;; clear all existing stuff. - (put-char-table char-range nil table)) - (map-char-table - #'(lambda (key value) - ;; make sure that this range has a bit-vector assigned to it - (if (not (bit-vector-p value)) - (setq value (make-bit-vector 95 0)) - (setq value (copy-sequence value))) - ;; set the appropriate bit in that vector. - (aset value (- designator 32) 1) - ;; put the vector back, thus assuring we have a unique setting for this range - (put-char-table key value table)) - table char-range)) - -(defun char-category-list (char &optional table) - "Return a list of the categories that CHAR is in. -TABLE defaults to the current buffer's category table. -The categories are given by their designators." - (or table (setq table (category-table))) - (check-argument-type 'category-table-p table) - (let ((vec (get-char-table char table))) - (if (null vec) nil - (let ((a 32) list) - (while (< a 127) - (if (= 1 (aref vec (- a 32))) - (setq list (cons a list))) - (setq a (1+ a))) - (nreverse list))))) - -;; implimented in c, file chartab.c (97/3/14 jhod@po.iijnet.or.jp) -;(defun char-in-category-p (char category &optional table) -; "Return non-nil if CHAR is in CATEGORY. -;TABLE defaults to the current buffer's category table. -;Categories are specified by their designators." -; (or table (setq table (category-table))) -; (check-argument-type 'category-table-p table) -; (check-argument-type 'category-designator-p category) -; (let ((vec (get-char-table char table))) -; (if (null vec) nil -; (= 1 (aref vec (- category 32)))))) - -(defun describe-category () - "Describe the category specifications in the category table. -The descriptions are inserted in a buffer, which is then displayed." - (interactive) - (with-output-to-temp-buffer "*Help*" - (describe-category-table (category-table) standard-output))) - -(defun describe-category-table (table stream) - (let (first-char - last-char - prev-val - (describe-one - (lambda (first last value stream) - (if (and (bit-vector-p value) - (> (reduce '+ value) 0)) - (progn - (if (equal first last) - (cond ((vectorp first) - (princ (format "%s, row %d" - (charset-name - (aref first 0)) - (aref first 1)) - stream)) - ((charsetp first) - (princ (charset-name first) stream)) - (t (princ first stream))) - (cond ((vectorp first) - (princ (format "%s, rows %d .. %d" - (charset-name - (aref first 0)) - (aref first 1) - (aref last 1)) - stream)) - (t - (princ (format "%s .. %s" first last) - stream)))) - (describe-category-code value stream)))))) - (map-char-table - (lambda (range value) - (if (and (or - (and (characterp range) - (characterp first-char) - (eq (char-charset range) (char-charset first-char)) - (= (char-to-int last-char) (1- (char-to-int range)))) - (and (vectorp range) - (vectorp first-char) - (eq (aref range 0) (aref first-char 0)) - (= (aref last-char 1) (1- (aref range 1)))) - (equal value prev-val))) - (setq last-char range) - (if first-char - (progn - (funcall describe-one first-char last-char prev-val stream) - (setq first-char nil))) - (funcall describe-one range range value stream)) - nil) - table) - (if first-char - (funcall describe-one first-char last-char prev-val stream)))) - -(defun describe-category-code (code stream) - (let ((standard-output (or stream standard-output))) - (princ "\tin categories: ") - (if (not (bit-vector-p code)) - (princ "(none)") - (let ((i 0) - already-matched) - (while (< i 95) - (if (= 1 (aref code i)) - (progn - (if (not already-matched) - (setq already-matched t) - (princ " ")) - (princ (int-to-char (+ 32 i))))) - (setq i (1+ i))) - (if (not already-matched) - (princ "(none)"))) - (let ((i 0)) - (while (< i 95) - (if (= 1 (aref code i)) - (princ (format "\n\t\tmeaning: %s" - (category-doc-string (int-to-char (+ 32 i)))))) - (setq i (1+ i))))) - (terpri))) - -(defconst predefined-category-list - '((latin-iso8859-1 ?l "Latin-1 through Latin-5 character set") - (latin-iso8859-2 ?l) - (latin-iso8859-3 ?l) - (latin-iso8859-4 ?l) - (latin-iso8859-9 ?l) - (cyrillic-iso8859-5 ?y "Cyrillic character set") - (arabic-iso8859-6 ?b "Arabic character set") - (greek-iso8859-7 ?g "Greek character set") - (hebrew-iso8859-8 ?w "Hebrew character set") - (katakana-jisx0201 ?k "Japanese 1-byte Katakana character set") - (latin-jisx0201 ?r "Japanese 1-byte Roman character set") - (japanese-jisx0208-1978 ?j "Japanese 2-byte character set (old)") - (japanese-jisx0208 ?j "Japanese 2-byte character set") - (japanese-jisx0212 ?j) - (chinese-gb2312 ?c "Chinese GB (China, PRC) 2-byte character set") - (chinese-cns11643-1 ?t "Chinese Taiwan (CNS or Big5) 2-byte character set") - (chinese-cns11643-2 ?t) - (chinese-big5-1 ?t) - (chinese-big5-2 ?t) - (korean-ksc5601 ?h "Hangul (Korean) 2-byte character set") - ) - "List of predefined categories. -Each element is a list of a charset, a designator, and maybe a doc string.") - -(let (i l) - (define-category ?a "ASCII character set.") - (setq i 32) - (while (< i 127) - (modify-category-entry i ?a) - (setq i (1+ i))) - (setq l predefined-category-list) - (while l - (if (and (nth 2 (car l)) - (not (defined-category-p (nth 2 (car l))))) - (define-category (nth 1 (car l)) (nth 2 (car l)))) - (modify-category-entry (car (car l)) (nth 1 (car l))) - (setq l (cdr l)))) - -;;; At the present, I know Japanese and Chinese text can -;;; break line at any point under a restriction of 'kinsoku'. -(defvar word-across-newline "\\(\\cj\\|\\cc\\|\\ct\\)" - "Regular expression of such characters which can be a word across newline.") - -(defvar ascii-char "[\40-\176]") -(defvar ascii-space "[ \t]") -(defvar ascii-symbols "[\40-\57\72-\100\133-\140\173-\176]") -(defvar ascii-numeric "[\60-\71]") -(defvar ascii-English-Upper "[\101-\132]") -(defvar ascii-English-Lower "[\141-\172]") -(defvar ascii-alphanumeric "[\60-\71\101-\132\141-\172]") - -(defvar kanji-char "\\cj") -(defvar kanji-space "$B!!(B") -(defvar kanji-symbols "\\cS") -(defvar kanji-numeric "[$B#0(B-$B#9(B]") -(defvar kanji-English-Upper "[$B#A(B-$B#Z(B]") -(defvar kanji-English-Lower "[$B#a(B-$B#z(B]") -(defvar kanji-hiragana "\\cH") -(defvar kanji-katakana "\\cK") -(defvar kanji-Greek-Upper "[$B&!(B-$B&8(B]") -(defvar kanji-Greek-Lower "[$B&A(B-$B&X(B]") -(defvar kanji-Russian-Upper "[$B'!(B-$B'A(B]") -(defvar kanji-Russian-Lower "[$B'Q(B-$B'q(B]") -(defvar kanji-Kanji-1st-Level "[$B0!(B-$BOS(B]") -(defvar kanji-Kanji-2nd-Level "[$BP!(B-$Bt$(B]") - -(defvar kanji-kanji-char "\\(\\cH\\|\\cK\\|\\cC\\)") diff --git a/lisp/mule/mule-ccl.el b/lisp/mule/mule-ccl.el deleted file mode 100644 index 7f28d19..0000000 --- a/lisp/mule/mule-ccl.el +++ /dev/null @@ -1,1110 +0,0 @@ -;;; ccl.el --- CCL (Code Conversion Language) compiler - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. - -;; Keywords: CCL, mule, multilingual, character set, coding-system - -;; This file is part of X 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 20.2 - -;;; Commentary: - -;; CCL (Code Conversion Language) is a simple programming language to -;; be used for various kind of code conversion. CCL program is -;; compiled to CCL code (vector of integers) and executed by CCL -;; interpreter of Emacs. -;; -;; CCL is used for code conversion at process I/O and file I/O for -;; non-standard coding-system. In addition, it is used for -;; calculating a code point of X's font from a character code. -;; However, since CCL is designed as a powerful programming language, -;; it can be used for more generic calculation. For instance, -;; combination of three or more arithmetic operations can be -;; calculated faster than Emacs Lisp. -;; -;; Here's the syntax of CCL program in BNF notation. -;; -;; CCL_PROGRAM := -;; (BUFFER_MAGNIFICATION -;; CCL_MAIN_BLOCK -;; [ CCL_EOF_BLOCK ]) -;; -;; BUFFER_MAGNIFICATION := integer -;; CCL_MAIN_BLOCK := CCL_BLOCK -;; CCL_EOF_BLOCK := CCL_BLOCK -;; -;; CCL_BLOCK := -;; STATEMENT | (STATEMENT [STATEMENT ...]) -;; STATEMENT := -;; SET | IF | BRANCH | LOOP | REPEAT | BREAK | READ | WRITE | CALL -;; -;; SET := -;; (REG = EXPRESSION) -;; | (REG ASSIGNMENT_OPERATOR EXPRESSION) -;; | integer -;; -;; EXPRESSION := ARG | (EXPRESSION OPERATOR ARG) -;; -;; IF := (if EXPRESSION CCL_BLOCK CCL_BLOCK) -;; BRANCH := (branch EXPRESSION CCL_BLOCK [CCL_BLOCK ...]) -;; LOOP := (loop STATEMENT [STATEMENT ...]) -;; BREAK := (break) -;; REPEAT := -;; (repeat) -;; | (write-repeat [REG | integer | string]) -;; | (write-read-repeat REG [integer | ARRAY]) -;; READ := -;; (read REG ...) -;; | (read-if (REG OPERATOR ARG) CCL_BLOCK CCL_BLOCK) -;; | (read-branch REG CCL_BLOCK [CCL_BLOCK ...]) -;; WRITE := -;; (write REG ...) -;; | (write EXPRESSION) -;; | (write integer) | (write string) | (write REG ARRAY) -;; | string -;; CALL := (call ccl-program-name) -;; END := (end) -;; -;; REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 -;; ARG := REG | integer -;; OPERATOR := -;; + | - | * | / | % | & | '|' | ^ | << | >> | <8 | >8 | // -;; | < | > | == | <= | >= | != | de-sjis | en-sjis -;; ASSIGNMENT_OPERATOR := -;; += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>= -;; ARRAY := '[' interger ... ']' - -;;; Code: - -(defconst ccl-command-table - [if branch loop break repeat write-repeat write-read-repeat - read read-if read-branch write call end] - "*Vector of CCL commands (symbols).") - -;; Put a property to each symbol of CCL commands for the compiler. -(let (op (i 0) (len (length ccl-command-table))) - (while (< i len) - (setq op (aref ccl-command-table i)) - (put op 'ccl-compile-function (intern (format "ccl-compile-%s" op))) - (setq i (1+ i)))) - -(defconst ccl-code-table - [set-register - set-short-const - set-const - set-array - jump - jump-cond - write-register-jump - write-register-read-jump - write-const-jump - write-const-read-jump - write-string-jump - write-array-read-jump - read-jump - branch - read-register - write-expr-const - read-branch - write-register - write-expr-register - call - write-const-string - write-array - end - set-assign-expr-const - set-assign-expr-register - set-expr-const - set-expr-register - jump-cond-expr-const - jump-cond-expr-register - read-jump-cond-expr-const - read-jump-cond-expr-register - ] - "*Vector of CCL compiled codes (symbols).") - -;; Put a property to each symbol of CCL codes for the disassembler. -(let (code (i 0) (len (length ccl-code-table))) - (while (< i len) - (setq code (aref ccl-code-table i)) - (put code 'ccl-code i) - (put code 'ccl-dump-function (intern (format "ccl-dump-%s" code))) - (setq i (1+ i)))) - -(defconst ccl-jump-code-list - '(jump jump-cond write-register-jump write-register-read-jump - write-const-jump write-const-read-jump write-string-jump - write-array-read-jump read-jump)) - -;; Put a property `jump-flag' to each CCL code which execute jump in -;; some way. -(let ((l ccl-jump-code-list)) - (while l - (put (car l) 'jump-flag t) - (setq l (cdr l)))) - -(defconst ccl-register-table - [r0 r1 r2 r3 r4 r5 r6 r7] - "*Vector of CCL registers (symbols).") - -;; Put a property to indicate register number to each symbol of CCL. -;; registers. -(let (reg (i 0) (len (length ccl-register-table))) - (while (< i len) - (setq reg (aref ccl-register-table i)) - (put reg 'ccl-register-number i) - (setq i (1+ i)))) - -(defconst ccl-arith-table - [+ - * / % & | ^ << >> <8 >8 // nil nil nil - < > == <= >= != de-sjis en-sjis] - "*Vector of CCL arithmetic/logical operators (symbols).") - -;; Put a property to each symbol of CCL operators for the compiler. -(let (arith (i 0) (len (length ccl-arith-table))) - (while (< i len) - (setq arith (aref ccl-arith-table i)) - (if arith (put arith 'ccl-arith-code i)) - (setq i (1+ i)))) - -(defconst ccl-assign-arith-table - [+= -= *= /= %= &= |= ^= <<= >>= <8= >8= //=] - "*Vector of CCL assignment operators (symbols).") - -;; Put a property to each symbol of CCL assignment operators for the compiler. -(let (arith (i 0) (len (length ccl-assign-arith-table))) - (while (< i len) - (setq arith (aref ccl-assign-arith-table i)) - (put arith 'ccl-self-arith-code i) - (setq i (1+ i)))) - -(defvar ccl-program-vector nil - "Working vector of CCL codes produced by CCL compiler.") -(defvar ccl-current-ic 0 - "The current index for `ccl-program-vector'.") - -;; Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and -;; increment it. If IC is specified, embed DATA at IC. -(defun ccl-embed-data (data &optional ic) - (let ((val (if (characterp data) (char-int data) data))) - (if ic - (aset ccl-program-vector ic val) - (aset ccl-program-vector ccl-current-ic val) - (setq ccl-current-ic (1+ ccl-current-ic))))) - -;; Embed string STR of length LEN in `ccl-program-vector' at -;; `ccl-current-ic'. -(defun ccl-embed-string (len str) - (let ((i 0)) - (while (< i len) - (ccl-embed-data (logior (ash (aref str i) 16) - (if (< (1+ i) len) - (ash (aref str (1+ i)) 8) - 0) - (if (< (+ i 2) len) - (aref str (+ i 2)) - 0))) - (setq i (+ i 3))))) - -;; Embed a relative jump address to `ccl-current-ic' in -;; `ccl-program-vector' at IC without altering the other bit field. -(defun ccl-embed-current-address (ic) - (let ((relative (- ccl-current-ic (1+ ic)))) - (aset ccl-program-vector ic - (logior (aref ccl-program-vector ic) (ash relative 8))))) - -;; Embed CCL code for the operation OP and arguments REG and DATA in -;; `ccl-program-vector' at `ccl-current-ic' in the following format. -;; |----------------- integer (28-bit) ------------------| -;; |------------ 20-bit ------------|- 3-bit --|- 5-bit -| -;; |------------- DATA -------------|-- REG ---|-- OP ---| -;; If REG2 is specified, embed a code in the following format. -;; |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -| -;; |-------- DATA -------|-- REG2 --|-- REG ---|-- OP ---| - -;; If REG is a CCL register symbol (e.g. r0, r1...), the register -;; number is embedded. If OP is one of unconditional jumps, DATA is -;; changed to an relative jump address. - -(defun ccl-embed-code (op reg data &optional reg2) - (if (and (> data 0) (get op 'jump-flag)) - ;; DATA is an absolute jump address. Make it relative to the - ;; next of jump code. - (setq data (- data (1+ ccl-current-ic)))) - (let ((code (logior (get op 'ccl-code) - (ash - (if (symbolp reg) (get reg 'ccl-register-number) reg) 5) - (if reg2 - (logior (ash (get reg2 'ccl-register-number) 8) - (ash data 11)) - (ash data 8))))) - (aset ccl-program-vector ccl-current-ic code) - (setq ccl-current-ic (1+ ccl-current-ic)))) - -;; Just advance `ccl-current-ic' by INC. -(defun ccl-increment-ic (inc) - (setq ccl-current-ic (+ ccl-current-ic inc))) - -;;;###autoload -(defun ccl-program-p (obj) - "T if OBJECT is a valid CCL compiled code." - (and (vectorp obj) - (let ((i 0) (len (length obj)) (flag t)) - (if (> len 1) - (progn - (while (and flag (< i len)) - (setq flag (integerp (aref obj i))) - (setq i (1+ i))) - flag))))) - -;; If non-nil, index of the start of the current loop. -(defvar ccl-loop-head nil) -;; If non-nil, list of absolute addresses of the breaking points of -;; the current loop. -(defvar ccl-breaks nil) - -;;;###autoload -(defun ccl-compile (ccl-program) - "Return a compiled code of CCL-PROGRAM as a vector of integer." - (if (or (null (consp ccl-program)) - (null (integer-or-char-p (car ccl-program))) - (null (listp (car (cdr ccl-program))))) - (error "CCL: Invalid CCL program: %s" ccl-program)) - (if (null (vectorp ccl-program-vector)) - (setq ccl-program-vector (make-vector 8192 0))) - (setq ccl-loop-head nil ccl-breaks nil) - (setq ccl-current-ic 0) - - ;; The first element is the buffer magnification. - (ccl-embed-data (car ccl-program)) - - ;; The second element is the address of the start CCL code for - ;; processing end of input buffer (we call it eof-processor). We - ;; set it later. - (ccl-increment-ic 1) - - ;; Compile the main body of the CCL program. - (ccl-compile-1 (car (cdr ccl-program))) - - ;; Embed the address of eof-processor. - (ccl-embed-data ccl-current-ic 1) - - ;; Then compile eof-processor. - (if (nth 2 ccl-program) - (ccl-compile-1 (nth 2 ccl-program))) - - ;; At last, embed termination code. - (ccl-embed-code 'end 0 0) - - (let ((vec (make-vector ccl-current-ic 0)) - (i 0)) - (while (< i ccl-current-ic) - (aset vec i (aref ccl-program-vector i)) - (setq i (1+ i))) - vec)) - -;; Signal syntax error. -(defun ccl-syntax-error (cmd) - (error "CCL: Syntax error: %s" cmd)) - -;; Check if ARG is a valid CCL register. -(defun ccl-check-register (arg cmd) - (if (get arg 'ccl-register-number) - arg - (error "CCL: Invalid register %s in %s." arg cmd))) - -;; Check if ARG is a valid CCL command. -(defun ccl-check-compile-function (arg cmd) - (or (get arg 'ccl-compile-function) - (error "CCL: Invalid command: %s" cmd))) - -;; In the following code, most ccl-compile-XXXX functions return t if -;; they end with unconditional jump, else return nil. - -;; Compile CCL-BLOCK (see the syntax above). -(defun ccl-compile-1 (ccl-block) - (let (unconditional-jump - cmd) - (if (or (integer-or-char-p ccl-block) - (stringp ccl-block) - (and ccl-block (symbolp (car ccl-block)))) - ;; This block consists of single statement. - (setq ccl-block (list ccl-block))) - - ;; Now CCL-BLOCK is a list of statements. Compile them one by - ;; one. - (while ccl-block - (setq cmd (car ccl-block)) - (setq unconditional-jump - (cond ((integer-or-char-p cmd) - ;; SET statement for the register 0. - (ccl-compile-set (list 'r0 '= cmd))) - - ((stringp cmd) - ;; WRITE statement of string argument. - (ccl-compile-write-string cmd)) - - ((listp cmd) - ;; The other statements. - (cond ((eq (nth 1 cmd) '=) - ;; SET statement of the form `(REG = EXPRESSION)'. - (ccl-compile-set cmd)) - - ((and (symbolp (nth 1 cmd)) - (get (nth 1 cmd) 'ccl-self-arith-code)) - ;; SET statement with an assignment operation. - (ccl-compile-self-set cmd)) - - (t - (funcall (ccl-check-compile-function (car cmd) cmd) - cmd)))) - - (t - (ccl-syntax-error cmd)))) - (setq ccl-block (cdr ccl-block))) - unconditional-jump)) - -(defconst ccl-max-short-const (ash 1 19)) -(defconst ccl-min-short-const (ash -1 19)) - -;; Compile SET statement. -(defun ccl-compile-set (cmd) - (let ((rrr (ccl-check-register (car cmd) cmd)) - (right (nth 2 cmd))) - (cond ((listp right) - ;; CMD has the form `(RRR = (XXX OP YYY))'. - (ccl-compile-expression rrr right)) - - ((integer-or-char-p right) - ;; CMD has the form `(RRR = integer)'. - (if (and (<= right ccl-max-short-const) - (>= right ccl-min-short-const)) - (ccl-embed-code 'set-short-const rrr right) - (ccl-embed-code 'set-const rrr 0) - (ccl-embed-data right))) - - (t - ;; CMD has the form `(RRR = rrr [ array ])'. - (ccl-check-register right cmd) - (let ((ary (nth 3 cmd))) - (if (vectorp ary) - (let ((i 0) (len (length ary))) - (ccl-embed-code 'set-array rrr len right) - (while (< i len) - (ccl-embed-data (aref ary i)) - (setq i (1+ i)))) - (ccl-embed-code 'set-register rrr 0 right)))))) - nil) - -;; Compile SET statement with ASSIGNMENT_OPERATOR. -(defun ccl-compile-self-set (cmd) - (let ((rrr (ccl-check-register (car cmd) cmd)) - (right (nth 2 cmd))) - (if (listp right) - ;; CMD has the form `(RRR ASSIGN_OP (XXX OP YYY))', compile - ;; the right hand part as `(r7 = (XXX OP YYY))' (note: the - ;; register 7 can be used for storing temporary value). - (progn - (ccl-compile-expression 'r7 right) - (setq right 'r7))) - ;; Now CMD has the form `(RRR ASSIGN_OP ARG)'. Compile it as - ;; `(RRR = (RRR OP ARG))'. - (ccl-compile-expression - rrr - (list rrr (intern (substring (symbol-name (nth 1 cmd)) 0 -1)) right))) - nil) - -;; Compile SET statement of the form `(RRR = EXPR)'. -(defun ccl-compile-expression (rrr expr) - (let ((left (car expr)) - (op (get (nth 1 expr) 'ccl-arith-code)) - (right (nth 2 expr))) - (if (listp left) - (progn - ;; EXPR has the form `((EXPR2 OP2 ARG) OP RIGHT)'. Compile - ;; the first term as `(r7 = (EXPR2 OP2 ARG)).' - (ccl-compile-expression 'r7 left) - (setq left 'r7))) - - ;; Now EXPR has the form (LEFT OP RIGHT). - (if (eq rrr left) - ;; Compile this SET statement as `(RRR OP= RIGHT)'. - (if (integer-or-char-p right) - (progn - (ccl-embed-code 'set-assign-expr-const rrr (ash op 3) 'r0) - (ccl-embed-data right)) - (ccl-check-register right expr) - (ccl-embed-code 'set-assign-expr-register rrr (ash op 3) right)) - - ;; Compile this SET statement as `(RRR = (LEFT OP RIGHT))'. - (if (integer-or-char-p right) - (progn - (ccl-embed-code 'set-expr-const rrr (ash op 3) left) - (ccl-embed-data right)) - (ccl-check-register right expr) - (ccl-embed-code 'set-expr-register - rrr - (logior (ash op 3) (get right 'ccl-register-number)) - left))))) - -;; Compile WRITE statement with string argument. -(defun ccl-compile-write-string (str) - (let ((len (length str))) - (ccl-embed-code 'write-const-string 1 len) - (ccl-embed-string len str)) - nil) - -;; Compile IF statement of the form `(if CONDITION TRUE-PART FALSE-PART)'. -;; If READ-FLAG is non-nil, this statement has the form -;; `(read-if (REG OPERATOR ARG) TRUE-PART FALSE-PART)'. -(defun ccl-compile-if (cmd &optional read-flag) - (if (and (/= (length cmd) 3) (/= (length cmd) 4)) - (error "CCL: Invalid number of arguments: %s" cmd)) - (let ((condition (nth 1 cmd)) - (true-cmds (nth 2 cmd)) - (false-cmds (nth 3 cmd)) - jump-cond-address - false-ic) - (if (and (listp condition) - (listp (car condition))) - ;; If CONDITION is a nested expression, the inner expression - ;; should be compiled at first as SET statement, i.e.: - ;; `(if ((X OP2 Y) OP Z) ...)' is compiled into two statements: - ;; `(r7 = (X OP2 Y)) (if (r7 OP Z) ...)'. - (progn - (ccl-compile-expression 'r7 (car condition)) - (setq condition (cons 'r7 (cdr condition))) - (setq cmd (cons (car cmd) - (cons condition (cdr (cdr cmd))))))) - - (setq jump-cond-address ccl-current-ic) - ;; Compile CONDITION. - (if (symbolp condition) - ;; CONDITION is a register. - (progn - (ccl-check-register condition cmd) - (ccl-embed-code 'jump-cond condition 0)) - ;; CONDITION is a simple expression of the form (RRR OP ARG). - (let ((rrr (car condition)) - (op (get (nth 1 condition) 'ccl-arith-code)) - (arg (nth 2 condition))) - (ccl-check-register rrr cmd) - (if (integer-or-char-p arg) - (progn - (ccl-embed-code (if read-flag 'read-jump-cond-expr-const - 'jump-cond-expr-const) - rrr 0) - (ccl-embed-data op) - (ccl-embed-data arg)) - (ccl-check-register arg cmd) - (ccl-embed-code (if read-flag 'read-jump-cond-expr-register - 'jump-cond-expr-register) - rrr 0) - (ccl-embed-data op) - (ccl-embed-data (get arg 'ccl-register-number))))) - - ;; Compile TRUE-PART. - (let ((unconditional-jump (ccl-compile-1 true-cmds))) - (if (null false-cmds) - ;; This is the place to jump to if condition is false. - (ccl-embed-current-address jump-cond-address) - (let (end-true-part-address) - (if (not unconditional-jump) - (progn - ;; If TRUE-PART does not end with unconditional jump, we - ;; have to jump to the end of FALSE-PART from here. - (setq end-true-part-address ccl-current-ic) - (ccl-embed-code 'jump 0 0))) - ;; This is the place to jump to if CONDITION is false. - (ccl-embed-current-address jump-cond-address) - ;; Compile FALSE-PART. - (setq unconditional-jump - (and (ccl-compile-1 false-cmds) unconditional-jump)) - (if end-true-part-address - ;; This is the place to jump to after the end of TRUE-PART. - (ccl-embed-current-address end-true-part-address)))) - unconditional-jump))) - -;; Compile BRANCH statement. -(defun ccl-compile-branch (cmd) - (if (< (length cmd) 3) - (error "CCL: Invalid number of arguments: %s" cmd)) - (ccl-compile-branch-blocks 'branch - (ccl-compile-branch-expression (nth 1 cmd) cmd) - (cdr (cdr cmd)))) - -;; Compile READ statement of the form `(read-branch EXPR BLOCK0 BLOCK1 ...)'. -(defun ccl-compile-read-branch (cmd) - (if (< (length cmd) 3) - (error "CCL: Invalid number of arguments: %s" cmd)) - (ccl-compile-branch-blocks 'read-branch - (ccl-compile-branch-expression (nth 1 cmd) cmd) - (cdr (cdr cmd)))) - -;; Compile EXPRESSION part of BRANCH statement and return register -;; which holds a value of the expression. -(defun ccl-compile-branch-expression (expr cmd) - (if (listp expr) - ;; EXPR has the form `(EXPR2 OP ARG)'. Compile it as SET - ;; statement of the form `(r7 = (EXPR2 OP ARG))'. - (progn - (ccl-compile-expression 'r7 expr) - 'r7) - (ccl-check-register expr cmd))) - -;; Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch. -;; REG is a register which holds a value of EXPRESSION part. BLOCKs -;; is a list of CCL-BLOCKs. -(defun ccl-compile-branch-blocks (code rrr blocks) - (let ((branches (length blocks)) - branch-idx - jump-table-head-address - empty-block-indexes - block-tail-addresses - block-unconditional-jump) - (ccl-embed-code code rrr branches) - (setq jump-table-head-address ccl-current-ic) - ;; The size of jump table is the number of blocks plus 1 (for the - ;; case RRR is out of range). - (ccl-increment-ic (1+ branches)) - (setq empty-block-indexes (list branches)) - ;; Compile each block. - (setq branch-idx 0) - (while blocks - (if (null (car blocks)) - ;; This block is empty. - (setq empty-block-indexes (cons branch-idx empty-block-indexes) - block-unconditional-jump t) - ;; This block is not empty. - (ccl-embed-data (- ccl-current-ic jump-table-head-address) - (+ jump-table-head-address branch-idx)) - (setq block-unconditional-jump (ccl-compile-1 (car blocks))) - (if (not block-unconditional-jump) - (progn - ;; Jump address of the end of branches are embedded later. - ;; For the moment, just remember where to embed them. - (setq block-tail-addresses - (cons ccl-current-ic block-tail-addresses)) - (ccl-embed-code 'jump 0 0)))) - (setq branch-idx (1+ branch-idx)) - (setq blocks (cdr blocks))) - (if (not block-unconditional-jump) - ;; We don't need jump code at the end of the last block. - (setq block-tail-addresses (cdr block-tail-addresses) - ccl-current-ic (1- ccl-current-ic))) - ;; Embed jump address at the tailing jump commands of blocks. - (while block-tail-addresses - (ccl-embed-current-address (car block-tail-addresses)) - (setq block-tail-addresses (cdr block-tail-addresses))) - ;; For empty blocks, make entries in the jump table point directly here. - (while empty-block-indexes - (ccl-embed-data (- ccl-current-ic jump-table-head-address) - (+ jump-table-head-address (car empty-block-indexes))) - (setq empty-block-indexes (cdr empty-block-indexes)))) - ;; Branch command ends by unconditional jump if RRR is out of range. - nil) - -;; Compile LOOP statement. -(defun ccl-compile-loop (cmd) - (if (< (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (let* ((ccl-loop-head ccl-current-ic) - (ccl-breaks nil) - unconditional-jump) - (setq cmd (cdr cmd)) - (if cmd - (progn - (setq unconditional-jump t) - (while cmd - (setq unconditional-jump - (and (ccl-compile-1 (car cmd)) unconditional-jump)) - (setq cmd (cdr cmd))) - (if (not ccl-breaks) - unconditional-jump - ;; Embed jump address for break statements encountered in - ;; this loop. - (while ccl-breaks - (ccl-embed-current-address (car ccl-breaks)) - (setq ccl-breaks (cdr ccl-breaks)))) - nil)))) - -;; Compile BREAK statement. -(defun ccl-compile-break (cmd) - (if (/= (length cmd) 1) - (error "CCL: Invalid number of arguments: %s" cmd)) - (if (null ccl-loop-head) - (error "CCL: No outer loop: %s" cmd)) - (setq ccl-breaks (cons ccl-current-ic ccl-breaks)) - (ccl-embed-code 'jump 0 0) - t) - -;; Compile REPEAT statement. -(defun ccl-compile-repeat (cmd) - (if (/= (length cmd) 1) - (error "CCL: Invalid number of arguments: %s" cmd)) - (if (null ccl-loop-head) - (error "CCL: No outer loop: %s" cmd)) - (ccl-embed-code 'jump 0 ccl-loop-head) - t) - -;; Compile WRITE-REPEAT statement. -(defun ccl-compile-write-repeat (cmd) - (if (/= (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (if (null ccl-loop-head) - (error "CCL: No outer loop: %s" cmd)) - (let ((arg (nth 1 cmd))) - (cond ((integer-or-char-p arg) - (ccl-embed-code 'write-const-jump 0 ccl-loop-head) - (ccl-embed-data arg)) - ((stringp arg) - (let ((len (length arg)) - (i 0)) - (ccl-embed-code 'write-string-jump 0 ccl-loop-head) - (ccl-embed-data len) - (ccl-embed-string len arg))) - (t - (ccl-check-register arg cmd) - (ccl-embed-code 'write-register-jump arg ccl-loop-head)))) - t) - -;; Compile WRITE-READ-REPEAT statement. -(defun ccl-compile-write-read-repeat (cmd) - (if (or (< (length cmd) 2) (> (length cmd) 3)) - (error "CCL: Invalid number of arguments: %s" cmd)) - (if (null ccl-loop-head) - (error "CCL: No outer loop: %s" cmd)) - (let ((rrr (ccl-check-register (nth 1 cmd) cmd)) - (arg (nth 2 cmd))) - (cond ((null arg) - (ccl-embed-code 'write-register-read-jump rrr ccl-loop-head)) - ((integer-or-char-p arg) - (ccl-embed-code 'write-const-read-jump rrr arg ccl-loop-head)) - ((vectorp arg) - (let ((len (length arg)) - (i 0)) - (ccl-embed-code 'write-array-read-jump rrr ccl-loop-head) - (ccl-embed-data len) - (while (< i len) - (ccl-embed-data (aref arg i)) - (setq i (1+ i))))) - (t - (error "CCL: Invalid argument %s: %s" arg cmd))) - (ccl-embed-code 'read-jump rrr ccl-loop-head)) - t) - -;; Compile READ statement. -(defun ccl-compile-read (cmd) - (if (< (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (let* ((args (cdr cmd)) - (i (1- (length args)))) - (while args - (let ((rrr (ccl-check-register (car args) cmd))) - (ccl-embed-code 'read-register rrr i) - (setq args (cdr args) i (1- i))))) - nil) - -;; Compile READ-IF statement. -(defun ccl-compile-read-if (cmd) - (ccl-compile-if cmd 'read)) - -;; Compile WRITE statement. -(defun ccl-compile-write (cmd) - (if (< (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (let ((rrr (nth 1 cmd))) - (cond ((integer-or-char-p rrr) - (ccl-embed-code 'write-const-string 0 rrr)) - ((stringp rrr) - (ccl-compile-write-string rrr)) - ((and (symbolp rrr) (vectorp (nth 2 cmd))) - (ccl-check-register rrr cmd) - ;; CMD has the form `(write REG ARRAY)'. - (let* ((arg (nth 2 cmd)) - (len (length arg)) - (i 0)) - (ccl-embed-code 'write-array rrr len) - (while (< i len) - (if (not (integer-or-char-p (aref arg i))) - (error "CCL: Invalid argument %s: %s" arg cmd)) - (ccl-embed-data (aref arg i)) - (setq i (1+ i))))) - - ((symbolp rrr) - ;; CMD has the form `(write REG ...)'. - (let* ((args (cdr cmd)) - (i (1- (length args)))) - (while args - (setq rrr (ccl-check-register (car args) cmd)) - (ccl-embed-code 'write-register rrr i) - (setq args (cdr args) i (1- i))))) - - ((listp rrr) - ;; CMD has the form `(write (LEFT OP RIGHT))'. - (let ((left (car rrr)) - (op (get (nth 1 rrr) 'ccl-arith-code)) - (right (nth 2 rrr))) - (if (listp left) - (progn - ;; RRR has the form `((EXPR OP2 ARG) OP RIGHT)'. - ;; Compile the first term as `(r7 = (EXPR OP2 ARG))'. - (ccl-compile-expression 'r7 left) - (setq left 'r7))) - ;; Now RRR has the form `(ARG OP RIGHT)'. - (if (integer-or-char-p right) - (progn - (ccl-embed-code 'write-expr-const 0 (ash op 3) left) - (ccl-embed-data right)) - (ccl-check-register right rrr) - (ccl-embed-code 'write-expr-register 0 - (logior (ash op 3) - (get right 'ccl-register-number)))))) - - (t - (error "CCL: Invalid argument: %s" cmd)))) - nil) - -;; Compile CALL statement. -(defun ccl-compile-call (cmd) - (if (/= (length cmd) 2) - (error "CCL: Invalid number of arguments: %s" cmd)) - (if (not (symbolp (nth 1 cmd))) - (error "CCL: Subroutine should be a symbol: %s" cmd)) - (let* ((name (nth 1 cmd)) - (idx (get name 'ccl-program-idx))) - (if (not idx) - (error "CCL: Unknown subroutine name: %s" name)) - (ccl-embed-code 'call 0 idx)) - nil) - -;; Compile END statement. -(defun ccl-compile-end (cmd) - (if (/= (length cmd) 1) - (error "CCL: Invalid number of arguments: %s" cmd)) - (ccl-embed-code 'end 0 0) - t) - -;;; CCL dump staffs - -;; To avoid byte-compiler warning. -(defvar ccl-code) - -;;;###autoload -(defun ccl-dump (ccl-code) - "Disassemble compiled CCL-CODE." - (let ((len (length ccl-code)) - (buffer-mag (aref ccl-code 0))) - (cond ((= buffer-mag 0) - (insert "Don't output anything.\n")) - ((= buffer-mag 1) - (insert "Out-buffer must be as large as in-buffer.\n")) - (t - (insert - (format "Out-buffer must be %d times bigger than in-buffer.\n" - buffer-mag)))) - (insert "Main-body:\n") - (setq ccl-current-ic 2) - (if (> (aref ccl-code 1) 0) - (progn - (while (< ccl-current-ic (aref ccl-code 1)) - (ccl-dump-1)) - (insert "At EOF:\n"))) - (while (< ccl-current-ic len) - (ccl-dump-1)) - )) - -;; Return a CCL code in `ccl-code' at `ccl-current-ic'. -(defun ccl-get-next-code () - (prog1 - (aref ccl-code ccl-current-ic) - (setq ccl-current-ic (1+ ccl-current-ic)))) - -(defun ccl-dump-1 () - (let* ((code (ccl-get-next-code)) - (cmd (aref ccl-code-table (logand code 31))) - (rrr (ash (logand code 255) -5)) - (cc (ash code -8))) - (insert (format "%5d:[%s] " (1- ccl-current-ic) cmd)) - (funcall (get cmd 'ccl-dump-function) rrr cc))) - -(defun ccl-dump-set-register (rrr cc) - (insert (format "r%d = r%d\n" rrr cc))) - -(defun ccl-dump-set-short-const (rrr cc) - (insert (format "r%d = %d\n" rrr cc))) - -(defun ccl-dump-set-const (rrr ignore) - (insert (format "r%d = %d\n" rrr (ccl-get-next-code)))) - -(defun ccl-dump-set-array (rrr cc) - (let ((rrr2 (logand cc 7)) - (len (ash cc -3)) - (i 0)) - (insert (format "r%d = array[r%d] of length %d\n\t" - rrr rrr2 len)) - (while (< i len) - (insert (format "%d " (ccl-get-next-code))) - (setq i (1+ i))) - (insert "\n"))) - -(defun ccl-dump-jump (ignore cc &optional address) - (insert (format "jump to %d(" (+ (or address ccl-current-ic) cc))) - (if (>= cc 0) - (insert "+")) - (insert (format "%d)\n" (1+ cc)))) - -(defun ccl-dump-jump-cond (rrr cc) - (insert (format "if (r%d == 0), " rrr)) - (ccl-dump-jump nil cc)) - -(defun ccl-dump-write-register-jump (rrr cc) - (insert (format "write r%d, " rrr)) - (ccl-dump-jump nil cc)) - -(defun ccl-dump-write-register-read-jump (rrr cc) - (insert (format "write r%d, read r%d, " rrr rrr)) - (ccl-dump-jump nil cc) - (ccl-get-next-code) ; Skip dummy READ-JUMP - ) - -(defun ccl-extract-arith-op (cc) - (aref ccl-arith-table (ash cc -6))) - -(defun ccl-dump-write-expr-const (ignore cc) - (insert (format "write (r%d %s %d)\n" - (logand cc 7) - (ccl-extract-arith-op cc) - (ccl-get-next-code)))) - -(defun ccl-dump-write-expr-register (ignore cc) - (insert (format "write (r%d %s r%d)\n" - (logand cc 7) - (ccl-extract-arith-op cc) - (logand (ash cc -3) 7)))) - -(defun ccl-dump-insert-char (cc) - (cond ((= cc ?\t) (insert " \"^I\"")) - ((= cc ?\n) (insert " \"^J\"")) - (t (insert (format " \"%c\"" cc))))) - -(defun ccl-dump-write-const-jump (ignore cc) - (let ((address ccl-current-ic)) - (insert "write char") - (ccl-dump-insert-char (ccl-get-next-code)) - (insert ", ") - (ccl-dump-jump nil cc address))) - -(defun ccl-dump-write-const-read-jump (rrr cc) - (let ((address ccl-current-ic)) - (insert "write char") - (ccl-dump-insert-char (ccl-get-next-code)) - (insert (format ", read r%d, " rrr)) - (ccl-dump-jump cc address) - (ccl-get-next-code) ; Skip dummy READ-JUMP - )) - -(defun ccl-dump-write-string-jump (ignore cc) - (let ((address ccl-current-ic) - (len (ccl-get-next-code)) - (i 0)) - (insert "write \"") - (while (< i len) - (let ((code (ccl-get-next-code))) - (insert (ash code -16)) - (if (< (1+ i) len) (insert (logand (ash code -8) 255))) - (if (< (+ i 2) len) (insert (logand code 255)))) - (setq i (+ i 3))) - (insert "\", ") - (ccl-dump-jump nil cc address))) - -(defun ccl-dump-write-array-read-jump (rrr cc) - (let ((address ccl-current-ic) - (len (ccl-get-next-code)) - (i 0)) - (insert (format "write array[r%d] of length %d,\n\t" rrr len)) - (while (< i len) - (ccl-dump-insert-char (ccl-get-next-code)) - (setq i (1+ i))) - (insert (format "\n\tthen read r%d, " rrr)) - (ccl-dump-jump nil cc address) - (ccl-get-next-code) ; Skip dummy READ-JUMP. - )) - -(defun ccl-dump-read-jump (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-jump nil cc)) - -(defun ccl-dump-branch (rrr len) - (let ((jump-table-head ccl-current-ic) - (i 0)) - (insert (format "jump to array[r%d] of length %d\n\t" rrr len)) - (while (<= i len) - (insert (format "%d " (+ jump-table-head (ccl-get-next-code)))) - (setq i (1+ i))) - (insert "\n"))) - -(defun ccl-dump-read-register (rrr cc) - (insert (format "read r%d (%d remaining)\n" rrr cc))) - -(defun ccl-dump-read-branch (rrr len) - (insert (format "read r%d, " rrr)) - (ccl-dump-branch rrr len)) - -(defun ccl-dump-write-register (rrr cc) - (insert (format "write r%d (%d remaining)\n" rrr cc))) - -(defun ccl-dump-call (ignore cc) - (insert (format "call subroutine #%d\n" cc))) - -(defun ccl-dump-write-const-string (rrr cc) - (if (= rrr 0) - (progn - (insert "write char") - (ccl-dump-insert-char cc) - (newline)) - (let ((len cc) - (i 0)) - (insert "write \"") - (while (< i len) - (let ((code (ccl-get-next-code))) - (insert (format "%c" (lsh code -16))) - (if (< (1+ i) len) - (insert (format "%c" (logand (lsh code -8) 255)))) - (if (< (+ i 2) len) - (insert (format "%c" (logand code 255)))) - (setq i (+ i 3)))) - (insert "\"\n")))) - -(defun ccl-dump-write-array (rrr cc) - (let ((i 0)) - (insert (format "write array[r%d] of length %d\n\t" rrr cc)) - (while (< i cc) - (ccl-dump-insert-char (ccl-get-next-code)) - (setq i (1+ i))) - (insert "\n"))) - -(defun ccl-dump-end (&rest ignore) - (insert "end\n")) - -(defun ccl-dump-set-assign-expr-const (rrr cc) - (insert (format "r%d %s= %d\n" - rrr - (ccl-extract-arith-op cc) - (ccl-get-next-code)))) - -(defun ccl-dump-set-assign-expr-register (rrr cc) - (insert (format "r%d %s= r%d\n" - rrr - (ccl-extract-arith-op cc) - (logand cc 7)))) - -(defun ccl-dump-set-expr-const (rrr cc) - (insert (format "r%d = r%d %s %d\n" - rrr - (logand cc 7) - (ccl-extract-arith-op cc) - (ccl-get-next-code)))) - -(defun ccl-dump-set-expr-register (rrr cc) - (insert (format "r%d = r%d %s r%d\n" - rrr - (logand cc 7) - (ccl-extract-arith-op cc) - (logand (ash cc -3) 7)))) - -(defun ccl-dump-jump-cond-expr-const (rrr cc) - (let ((address ccl-current-ic)) - (insert (format "if !(r%d %s %d), " - rrr - (aref ccl-arith-table (ccl-get-next-code)) - (ccl-get-next-code))) - (ccl-dump-jump nil cc address))) - -(defun ccl-dump-jump-cond-expr-register (rrr cc) - (let ((address ccl-current-ic)) - (insert (format "if !(r%d %s r%d), " - rrr - (aref ccl-arith-table (ccl-get-next-code)) - (ccl-get-next-code))) - (ccl-dump-jump nil cc address))) - -(defun ccl-dump-read-jump-cond-expr-const (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-jump-cond-expr-const rrr cc)) - -(defun ccl-dump-read-jump-cond-expr-register (rrr cc) - (insert (format "read r%d, " rrr)) - (ccl-dump-jump-cond-expr-register rrr cc)) - -(defun ccl-dump-binary (ccl-code) - (let ((len (length ccl-code)) - (i 2)) - (while (< i len) - (let ((code (aref ccl-code i)) - (j 27)) - (while (>= j 0) - (insert (if (= (logand code (ash 1 j)) 0) ?0 ?1)) - (setq j (1- j))) - (setq code (logand code 31)) - (if (< code (length ccl-code-table)) - (insert (format ":%s" (aref ccl-code-table code)))) - (insert "\n")) - (setq i (1+ i))))) - -;; CCL emulation staffs - -;; Not yet implemented. - -;;;###autoload -(defmacro declare-ccl-program (name) - "Declare NAME as a name of CCL program. - -To compile a CCL program which calls another CCL program not yet -defined, it must be declared as a CCL program in advance." - `(put ',name 'ccl-program-idx (register-ccl-program ',name nil))) - -;;;###autoload -(defmacro define-ccl-program (name ccl-program &optional doc) - "Set NAME the compiled code of CCL-PROGRAM. -CCL-PROGRAM is `eval'ed before being handed to the CCL compiler `ccl-compile'. -The compiled code is a vector of integers." - `(let ((prog ,(ccl-compile (eval ccl-program)))) - (defconst ,name prog ,doc) - (put ',name 'ccl-program-idx (register-ccl-program ',name prog)) - nil)) - -;;;###autoload -(defun ccl-execute-with-args (ccl-prog &rest args) - "Execute CCL-PROGRAM with registers initialized by the remaining args. -The return value is a vector of resulting CCL registeres." - (let ((reg (make-vector 8 0)) - (i 0)) - (while (and args (< i 8)) - (if (not (integerp (car args))) - (error "Arguments should be integer")) - (aset reg i (car args)) - (setq args (cdr args) i (1+ i))) - (ccl-execute ccl-prog reg) - reg)) - -(provide 'ccl) - -;; ccl.el ends here diff --git a/lisp/mule/mule-charset.el b/lisp/mule/mule-charset.el deleted file mode 100644 index 6e3c366..0000000 --- a/lisp/mule/mule-charset.el +++ /dev/null @@ -1,142 +0,0 @@ -;;; mule-charset.el --- Charset functions for Mule. -;; Copyright (C) 1992 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1996 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. - - -;;;; Composite character support - -(defun compose-region (start end &optional buffer) - "Compose characters in the current region into one composite character. -From a Lisp program, pass two arguments, START to END. -The composite character replaces the composed characters. -BUFFER defaults to the current buffer if omitted." - (interactive "r") - (let ((ch (make-composite-char (buffer-substring start end buffer)))) - (delete-region start end buffer) - (insert-char ch nil nil buffer))) - -(defun decompose-region (start end &optional buffer) - "Decompose any composite characters in the current region. -From a Lisp program, pass two arguments, START to END. -This converts each composite character into one or more characters, -the individual characters out of which the composite character was formed. -Non-composite characters are left as-is. BUFFER defaults to the current -buffer if omitted." - (interactive "r") - (save-excursion - (set-buffer buffer) - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (let ((compcharset (get-charset 'composite))) - (while (< (point) (point-max)) - (let ((ch (char-after (point)))) - (if (eq compcharset (char-charset ch)) - (progn - (delete-char 1) - (insert (composite-char-string ch)))))))))) - - -;;;; Classifying text according to charsets - -(defun charsets-in-region (start end &optional buffer) - "Return a list of the charsets in the region between START and END. -BUFFER defaults to the current buffer if omitted." - (let (list) - (save-excursion - (if buffer - (set-buffer buffer)) - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (not (eobp)) - (let* (prev-charset - (ch (char-after (point))) - (charset (char-charset ch))) - (if (not (eq prev-charset charset)) - (progn - (setq prev-charset charset) - (or (memq charset list) - (setq list (cons charset list)))))) - (forward-char)))) - list)) - -(defun charsets-in-string (string) - "Return a list of the charsets in STRING." - (let ((i 0) - (len (length string)) - prev-charset charset list) - (while (< i len) - (setq charset (char-charset (aref string i))) - (if (not (eq prev-charset charset)) - (progn - (setq prev-charset charset) - (or (memq charset list) - (setq list (cons charset list))))) - (setq i (1+ i))) - list)) - - -;;;; Charset accessors - -(defun charset-graphic (charset) - "Return the `graphic' property of CHARSET. -See `make-charset'." - (charset-property charset 'graphic)) - -(defun charset-final (charset) - "Return the final byte of the ISO 2022 escape sequence designating CHARSET." - (charset-property charset 'final)) - -(defun charset-chars (charset) - "Return the number of characters per dimension of CHARSET." - (charset-property charset 'chars)) - -(defun charset-columns (charset) - "Return the number of display columns per character of CHARSET. -This only applies to TTY mode (under X, the actual display width can -be automatically determined)." - (charset-property charset 'columns)) - -(defun charset-direction (charset) - "Return the display direction (`l2r' or `r2l') of CHARSET." - (charset-property charset 'direction)) - -(defun charset-registry (charset) - "Return the registry of CHARSET. -This is a regular expression matching the registry field of fonts -that can display the characters in CHARSET." - (charset-property charset 'registry)) - -(defun charset-ccl-program (charset) - "Return the CCL program of CHARSET. -See `make-charset'." - (charset-property charset 'ccl-program)) - -(defun charset-leading-byte (charset) - "Return the leading byte of CHARSET. -See `make-charset'." - (charset-property charset 'leading-byte)) - -;;;; Define setf methods for all settable Charset properties - -(defsetf charset-registry set-charset-registry) -(defsetf charset-ccl-program set-charset-ccl-program) diff --git a/lisp/mule/mule-cmds.el b/lisp/mule/mule-cmds.el deleted file mode 100644 index 832bf97..0000000 --- a/lisp/mule/mule-cmds.el +++ /dev/null @@ -1,706 +0,0 @@ -;;; mule-cmds.el --- Commands for multilingual environment - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Keywords: mule, multilingual - -;; 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: - -;;; MULE related key bindings and menus. - -(defvar mule-keymap (make-sparse-keymap "MULE") - "Keymap for MULE (Multilingual environment) specific commands.") - -;; Keep "C-x C-m ..." for mule specific commands. -(define-key ctl-x-map "\C-m" mule-keymap) - -(define-key mule-keymap "f" 'set-buffer-file-coding-system) -(define-key mule-keymap "F" 'set-default-buffer-file-coding-system) ; XEmacs -(define-key mule-keymap "t" 'set-terminal-coding-system) -(define-key mule-keymap "k" 'set-keyboard-coding-system) -(define-key mule-keymap "p" 'set-buffer-process-coding-system) -(define-key mule-keymap "\C-\\" 'select-input-method) -(define-key mule-keymap "c" 'universal-coding-system-argument) -;;(define-key mule-keymap "c" 'list-coding-system-briefly) ; XEmacs -(define-key mule-keymap "C" 'list-coding-system) ; XEmacs -(define-key mule-keymap "r" 'toggle-display-direction) ; XEmacs -(define-key mule-keymap "l" 'set-language-environment) - -(define-key help-map "\C-L" 'describe-language-support) -(define-key help-map "L" 'describe-language-environment) -(define-key help-map "\C-\\" 'describe-input-method) -(define-key help-map "I" 'describe-input-method) -(define-key help-map "C" 'describe-coding-system) -(define-key help-map "h" 'view-hello-file) - -;; Menu for XEmacs were moved to menubar-items.el. - - -;; This should be a single character key binding because users use it -;; very frequently while editing multilingual text. Now we can use -;; only two such keys: "\C-\\" and "\C-^", but the latter is not -;; convenient because it requires shifting on most keyboards. An -;; alternative is "\C-\]" which is now bound to `abort-recursive-edit' -;; but it won't be used that frequently. -(define-key global-map "\C-\\" 'toggle-input-method) - -(defun view-hello-file () - "Display the HELLO file which list up many languages and characters." - (interactive) - ;; We have to decode the file in any environment. - (let ((coding-system-for-read 'iso-2022-7)) - (find-file-read-only (expand-file-name "HELLO" data-directory)))) - -(defun universal-coding-system-argument () - "Execute an I/O command using the specified coding system." - (interactive) - (let* ((coding-system - (read-coding-system "Coding system for following command: ")) - (keyseq (read-key-sequence - (format "Command to execute with %s:" coding-system))) - (cmd (key-binding keyseq))) - (let ((coding-system-for-read coding-system) - (coding-system-for-write coding-system)) - (message "") - (call-interactively cmd)))) - -(defun set-default-coding-systems (coding-system) - "Set default value of various coding systems to CODING-SYSTEM. -The follwing coding systems are set: - o coding system of a newly created buffer - o default coding system for terminal output - o default coding system for keyboard input - o default coding system for subprocess I/O" - (check-coding-system coding-system) - ;;(setq-default buffer-file-coding-system coding-system) - (set-default-buffer-file-coding-system coding-system) - ;;(setq default-terminal-coding-system coding-system) - (setq terminal-coding-system coding-system) - ;;(setq default-keyboard-coding-system coding-system) - (setq keyboard-coding-system coding-system) - ;;(setq default-process-coding-system (cons coding-system coding-system)) - (add-hook 'comint-exec-hook - `(lambda () - (let ((proc (get-buffer-process (current-buffer)))) - (set-process-input-coding-system proc ',coding-system) - (set-process-output-coding-system proc ',coding-system))) - 'append) - (setq file-name-coding-system coding-system)) - -(defun prefer-coding-system (coding-system) - "Add CODING-SYSTEM at the front of the priority list for automatic detection. -This also sets the following coding systems to CODING-SYSTEM: - o coding system of a newly created buffer - o default coding system for terminal output - o default coding system for keyboard input - o default coding system for subprocess I/O" - (interactive "zPrefer coding system: ") - (if (not (and coding-system (coding-system-p coding-system))) - (error "Invalid coding system `%s'" coding-system)) - (let ((coding-category (coding-system-category coding-system)) - (parent (coding-system-parent coding-system))) - (if (not coding-category) - ;; CODING-SYSTEM is no-conversion or undecided. - (error "Can't prefer the coding system `%s'" coding-system)) - (set coding-category (or parent coding-system)) - (if (not (eq coding-category (car coding-category-list))) - ;; We must change the order. - (setq coding-category-list - (cons coding-category - (delq coding-category coding-category-list)))) - (if (and parent (interactive-p)) - (message "Highest priority is set to %s (parent of %s)" - parent coding-system)) - (set-default-coding-systems (or parent coding-system)))) - - -;;; Language support staffs. - -(defvar language-info-alist nil - "Alist of language names vs the corresponding information of various kind. -Each element looks like: - (LANGUAGE-NAME . ((KEY . INFO) ...)) -where LANGUAGE-NAME is a string, -KEY is a symbol denoting the kind of information, -INFO is any Lisp object which contains the actual information related -to KEY.") - -(defun get-language-info (language-name key) - "Return the information for LANGUAGE-NAME of the kind KEY. -KEY is a symbol denoting the kind of required information." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (let ((lang-slot (assoc-ignore-case language-name language-info-alist))) - (if lang-slot - (cdr (assq key (cdr lang-slot)))))) - -(defun set-language-info (language-name key info) - "Set for LANGUAGE-NAME the information INFO under KEY. -KEY is a symbol denoting the kind of information. -INFO is any Lisp object which contains the actual information. - -Currently, the following KEYs are used by Emacs: - -charset: list of symbols whose values are charsets specific to the language. - -coding-system: list of coding systems specific to the language. - -tutorial: a tutorial file name written in the language. - -sample-text: one line short text containing characters of the language. - -documentation: t or a string describing how Emacs supports the language. - If a string is specified, it is shown before any other information - of the language by the command `describe-language-environment'. - -setup-function: a function to call for setting up environment - convenient for a user of the language. - -If KEY is documentation or setup-function, you can also specify -a cons cell as INFO, in which case, the car part should be -a normal value as INFO for KEY (as described above), -and the cdr part should be a symbol whose value is a menu keymap -in which an entry for the language is defined. But, only the car part -is actually set as the information. - -We will define more KEYs in the future. To avoid conflict, -if you want to use your own KEY values, make them start with `user-'." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (let (lang-slot key-slot) - (setq lang-slot (assoc language-name language-info-alist)) - (if (null lang-slot) ; If no slot for the language, add it. - (setq lang-slot (list language-name) - language-info-alist (cons lang-slot language-info-alist))) - (setq key-slot (assq key lang-slot)) - (if (null key-slot) ; If no slot for the key, add it. - (progn - (setq key-slot (list key)) - (setcdr lang-slot (cons key-slot (cdr lang-slot))))) - ;; Setup menu. - (cond ((eq key 'documentation) - ;; (define-key-after - ;; (if (consp info) - ;; (prog1 (symbol-value (cdr info)) - ;; (setq info (car info))) - ;; describe-language-environment-map) - ;; (vector (intern language-name)) - ;; (cons language-name 'describe-specified-language-support) - ;; t) - (if (consp info) - (setq info (car info))) - (when (featurep 'menubar) - (eval-after-load - "menubar-items.elc" - `(add-menu-button - '("Mule" "Describe Language Support") - (vector ,language-name - '(describe-language-environment ,language-name) - t)))) - ) - ((eq key 'setup-function) - ;; (define-key-after - ;; (if (consp info) - ;; (prog1 (symbol-value (cdr info)) - ;; (setq info (car info))) - ;; setup-language-environment-map) - ;; (vector (intern language-name)) - ;; (cons language-name 'setup-specified-language-environment) - ;; t) - (if (consp info) - (setq info (car info))) - (when (featurep 'menubar) - (eval-after-load - "menubar-items.elc" - `(add-menu-button - '("Mule" "Set Language Environment") - (vector ,language-name - '(set-language-environment ,language-name) - t)))) - )) - - (setcdr key-slot info) - )) - -(defun set-language-info-alist (language-name alist) - "Set for LANGUAGE-NAME the information in ALIST. -ALIST is an alist of KEY and INFO. See the documentation of -`set-language-info' for the meanings of KEY and INFO." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (while alist - (set-language-info language-name (car (car alist)) (cdr (car alist))) - (setq alist (cdr alist)))) - -(defun read-language-name (key prompt &optional default) - "Read language name which has information for KEY, prompting with PROMPT. -DEFAULT is the default choice of language. -This returns a language name as a string." - (let* ((completion-ignore-case t) - (name (completing-read prompt - language-info-alist - (function (lambda (elm) (assq key elm))) - t nil default))) - (if (and (> (length name) 0) - (get-language-info name key)) - name))) - -;;; Multilingual input methods. - -(defconst leim-list-file-name "leim-list.el" - "Name of LEIM list file. -This file contains a list of libraries of Emacs input methods (LEIM) -in the format of Lisp expression for registering each input method. -Emacs loads this file at startup time.") - -(defvar leim-list-header (format -";;; %s -- list of LEIM (Library of Emacs Input Method) -;; -;; This file contains a list of LEIM (Library of Emacs Input Method) -;; in the same directory as this file. Loading this file registeres -;; the whole input methods in Emacs. -;; -;; Each entry has the form: -;; (register-input-method -;; INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC -;; TITLE DESCRIPTION -;; ARG ...) -;; See the function `register-input-method' for the meanings of arguments. -;; -;; If this directory is included in load-path, Emacs automatically -;; loads this file at startup time. - -" - leim-list-file-name) - "Header to be inserted in LEIM list file.") - -(defvar leim-list-entry-regexp "^(register-input-method" - "Regexp matching head of each entry in LEIM list file. -See also the variable `leim-list-header'") - -(defvar update-leim-list-functions - '(quail-update-leim-list-file) - "List of functions to call to update LEIM list file. -Each function is called with one arg, LEIM directory name.") - -(defun update-leim-list-file (&rest dirs) - "Update LEIM list file in directories DIRS." - (let ((functions update-leim-list-functions)) - (while functions - (apply (car functions) dirs) - (setq functions (cdr functions))))) - -(defvar current-input-method nil - "The current input method for multilingual text. -If nil, that means no input method is activated now.") -(make-variable-buffer-local 'current-input-method) -(put 'current-input-method 'permanent-local t) - -(defvar current-input-method-title nil - "Title string of the current input method shown in mode line.") -(make-variable-buffer-local 'current-input-method-title) -(put 'current-input-method-title 'permanent-local t) - -(defcustom default-input-method nil - "*Default input method for multilingual text. -This is the input method activated automatically by the command -`toggle-input-method' (\\[toggle-input-method])." - :group 'mule) - -(defvar input-method-history nil - "History list for some commands that read input methods.") -(make-variable-buffer-local 'input-method-history) -(put 'input-method-history 'permanent-local t) - -(defvar inactivate-current-input-method-function nil - "Function to call for inactivating the current input method. -Every input method should set this to an appropriate value when activated. -This function is called with no argument. - -This function should never change the value of `current-input-method'. -It is set to nil by the function `inactivate-input-method'.") -(make-variable-buffer-local 'inactivate-current-input-method-function) -(put 'inactivate-current-input-method-function 'permanent-local t) - -(defvar describe-current-input-method-function nil - "Function to call for describing the current input method. -This function is called with no argument.") -(make-variable-buffer-local 'describe-current-input-method-function) -(put 'describe-current-input-method-function 'permanent-local t) - -(defvar input-method-alist nil - "Alist of input method names vs the corresponding information to use it. -Each element has the form: - (INPUT-METHOD LANGUAGE-NAME ACTIVATE-FUNC TITLE DESCRIPTION ...) -See the function `register-input-method' for the meanings of each elements.") - -(defun register-input-method (input-method language-name &rest args) - "Register INPUT-METHOD as an input method for LANGUAGE-NAME. -INPUT-METHOD and LANGUAGE-NAME are symbols or strings. -The remaining arguments are: - ACTIVATE-FUNC, TITLE, DESCRIPTION, and ARG ... - where, -ACTIVATE-FUNC is a function to call for activating this method. -TITLE is a string shown in mode-line while this method is active, -DESCRIPTION is a string describing about this method, -Arguments to ACTIVATE-FUNC are INPUT-METHOD and ARGs." - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (if (symbolp input-method) - (setq input-method (symbol-name input-method))) - (let ((info (cons language-name args)) - (slot (assoc input-method input-method-alist))) - (if slot - (setcdr slot info) - (setq slot (cons input-method info)) - (setq input-method-alist (cons slot input-method-alist))))) - -(defun read-input-method-name (prompt &optional default inhibit-null) - "Read a name of input method from a minibuffer prompting with PROMPT. -If DEFAULT is non-nil, use that as the default, - and substitute it into PROMPT at the first `%s'. -If INHIBIT-NULL is non-nil, null input signals an error. - -The return value is a string." - (if default - (setq prompt (format prompt default))) - (let* ((completion-ignore-case t) - ;; This binding is necessary because input-method-history is - ;; buffer local. - (input-method (completing-read prompt input-method-alist - nil t nil 'input-method-history) - ;;default) - )) - (if (> (length input-method) 0) - input-method - (if inhibit-null - (error "No valid input method is specified"))))) - -(defun activate-input-method (input-method) - "Turn INPUT-METHOD on. -If some input method is already on, turn it off at first." - (if (symbolp input-method) - (setq input-method (symbol-name input-method))) - (if (and current-input-method - (not (string= current-input-method input-method))) - (inactivate-input-method)) - (unless current-input-method - (let ((slot (assoc input-method input-method-alist))) - (if (null slot) - (error "Can't activate input method `%s'" input-method)) - (apply (nth 2 slot) input-method (nthcdr 5 slot)) - (setq current-input-method input-method) - (setq current-input-method-title (nth 3 slot)) - (run-hooks 'input-method-activate-hook)))) - -(defun inactivate-input-method () - "Turn off the current input method." - (when current-input-method - (if input-method-history - (unless (string= current-input-method (car input-method-history)) - (setq input-method-history - (cons current-input-method - (delete current-input-method input-method-history)))) - (setq input-method-history (list current-input-method))) - (unwind-protect - (funcall inactivate-current-input-method-function) - (unwind-protect - (run-hooks 'input-method-inactivate-hook) - (setq current-input-method nil - current-input-method-title nil))))) - -(defun select-input-method (input-method) - "Select and turn on INPUT-METHOD. -This sets the default input method to what you specify, -and turn it on for the current buffer." - (interactive - (let* ((default (or (car input-method-history) default-input-method))) - (list (read-input-method-name - (if default "Select input method (default %s): " "Select input method: ") - default t)))) - (activate-input-method input-method) - (setq default-input-method input-method)) - -(defun toggle-input-method (&optional arg) - "Turn on or off a multilingual text input method for the current buffer. - -With arg, read an input method from minibuffer and turn it on. - -Without arg, if some input method is currently activated, turn it off, -else turn on an input method selected last time -or the default input method (see `default-input-method'). - -When there's no input method to turn on, turn on what read from minibuffer." - (interactive "P") - (let* ((default (or (car input-method-history) default-input-method))) - (if (and current-input-method (not arg)) - (inactivate-input-method) - (activate-input-method - (if (or arg (not default)) - (read-input-method-name - (if default "Input method (default %s): " "Input method: " ) - default t) - default)) - (or default-input-method - (setq default-input-method current-input-method))))) - -(defun describe-input-method (input-method) - "Describe input method INPUT-METHOD." - (interactive - (list (read-input-method-name - "Describe input method (default, current choice): "))) - (if (and input-method (symbolp input-method)) - (setq input-method (symbol-name input-method))) - (if (null input-method) - (describe-current-input-method) - (with-output-to-temp-buffer "*Help*" - (let ((elt (assoc input-method input-method-alist))) - (princ (format "Input method: %s (`%s' in mode line) for %s\n %s\n" - input-method (nth 3 elt) (nth 1 elt) (nth 4 elt))))))) - -(defun describe-current-input-method () - "Describe the input method currently in use." - (if current-input-method - (if (and (symbolp describe-current-input-method-function) - (fboundp describe-current-input-method-function)) - (funcall describe-current-input-method-function) - (message "No way to describe the current input method `%s'" - (cdr current-input-method)) - (ding)) - (error "No input method is activated now"))) - -(defun read-multilingual-string (prompt &optional initial-input - input-method) - "Read a multilingual string from minibuffer, prompting with string PROMPT. -The input method selected last time is activated in minibuffer. -If optional second arg INITIAL-INPUT is non-nil, insert it in the minibuffer -initially. -Optional 3rd argument INPUT-METHOD specifies the input method -to be activated instead of the one selected last time. It is a symbol -or a string." - (setq input-method - (or input-method - default-input-method - (read-input-method-name "Input method: " nil t))) - (if (and input-method (symbolp input-method)) - (setq input-method (symbol-name input-method))) - (let ((current-input-method input-method)) - ;; FSFmacs - ;; (read-string prompt initial-input nil nil t))) - (read-string prompt initial-input nil))) - -;; Variables to control behavior of input methods. All input methods -;; should react to these variables. - -(defcustom input-method-verbose-flag t - "*If this flag is non-nil, input methods give extra guidance. - -The extra guidance is done by showing list of available keys in echo -area. - -For complex input methods such as `chinese-py' and `japanese', -when you use the input method in the minibuffer, the guidance is -shown at the bottom short window (split from the existing window). -For simple input methods, guidance is not shown -when you are in the minibuffer." - :type 'boolean - :group 'mule) - -(defcustom input-method-highlight-flag t - "*If this flag is non-nil, input methods highlight partially-entered text. -For instance, while you are in the middle of a Quail input method sequence, -the text inserted so far is temporarily underlined. -The underlining goes away when you finish or abort the input method sequence." - :type 'boolean - :group 'mule) - -(defvar input-method-activate-hook nil - "Normal hook run just after an input method is activated. - -The variable `current-input-method' keeps the input method name -just activated.") - -(defvar input-method-inactivate-hook nil - "Normal hook run just after an input method is inactivated. - -The variable `current-input-method' still keeps the input method name -just inacitvated.") - -(defvar input-method-after-insert-chunk-hook nil - "Normal hook run just after an input method insert some chunk of text.") - -(defvar input-method-exit-on-invalid-key nil - "This flag controls the behaviour of an input method on invalid key input. -Usually, when a user types a key which doesn't start any character -handled by the input method, the key is handled by turning off the -input method temporalily. After the key is handled, the input method is -back on. -But, if this flag is non-nil, the input method is never back on.") - - -(defun setup-specified-language-environment () - "Set up multi-lingual environment convenient for the specified language." - (interactive) - (let (language-name) - (if (and (symbolp last-command-event) - (or (not (eq last-command-event 'Default)) - (setq last-command-event 'English)) - (setq language-name (symbol-name last-command-event))) - (set-language-environment language-name) - (error "Bogus calling sequence")))) - -(defvar current-language-environment "English" - "The last language environment specified with `set-language-environment'.") - -(defun set-language-environment (language-name) - "Set up multi-lingual environment for using LANGUAGE-NAME. -This sets the coding system priority and the default input method -and sometimes other things." - (interactive (list (read-language-name 'setup-function - "Set language environment: "))) - (if language-name - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (setq language-name "English")) - (if (null (get-language-info language-name 'setup-function)) - (error "Language environment not defined: %S" language-name)) - (funcall (get-language-info language-name 'setup-function)) - (setq current-language-environment language-name) - (force-mode-line-update t)) - -;; Print all arguments with `princ', then print "\n". -(defsubst princ-list (&rest args) - (while args (princ (car args)) (setq args (cdr args))) - (princ "\n")) - -;; Print a language specific information such as input methods, -;; charsets, and coding systems. This function is intended to be -;; called from the menu: -;; [menu-bar mule describe-language-environment LANGUAGE] -;; and should not run it by `M-x describe-current-input-method-function'. -(defun describe-specified-language-support () - "Describe how Emacs supports the specified language environment." - (interactive) - (let (language-name) - (if (not (and (symbolp last-command-event) - (setq language-name (symbol-name last-command-event)))) - (error "Bogus calling sequence")) - (describe-language-environment language-name))) - -(defun describe-language-environment (language-name) - "Describe how Emacs supports language environment LANGUAGE-NAME." - (interactive - (list (read-language-name - 'documentation - "Describe language environment (default, current choise): "))) - (if (null language-name) - (setq language-name current-language-environment)) - (if (or (null language-name) - (null (get-language-info language-name 'documentation))) - (error "No documentation for the specified language")) - (if (symbolp language-name) - (setq language-name (symbol-name language-name))) - (let ((doc (get-language-info language-name 'documentation))) - (with-output-to-temp-buffer "*Help*" - (if (stringp doc) - (progn - (princ-list doc) - (terpri))) - (let ((str (get-language-info language-name 'sample-text))) - (if (stringp str) - (progn - (princ "Sample text:\n") - (princ-list " " str) - (terpri)))) - (princ "Input methods:\n") - (let ((l input-method-alist)) - (while l - (if (string= language-name (nth 1 (car l))) - (princ-list " " (car (car l)) - (format " (`%s' in mode line)" (nth 3 (car l))))) - (setq l (cdr l)))) - (terpri) - (princ "Character sets:\n") - (let ((l (get-language-info language-name 'charset))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ-list " " (car l) ": " - (charset-description (car l))) - (setq l (cdr l))))) - (terpri) - (princ "Coding systems:\n") - (let ((l (get-language-info language-name 'coding-system))) - (if (null l) - (princ-list " nothing specific to " language-name) - (while l - (princ ; (format " %s (`%c' in mode line):\n\t%s\n" - ;; In XEmacs, `coding-system-mnemonic' returns string. - (format " %s (`%s' in mode line):\n\t%s\n" - (car l) - (coding-system-mnemonic (car l)) - (coding-system-doc-string (car l)))) - (setq l (cdr l)))))))) - -;;; Charset property - -;; (defsubst get-charset-property (charset propname) -;; "Return the value of CHARSET's PROPNAME property. -;; This is the last value stored with -;; `(put-charset-property CHARSET PROPNAME VALUE)'." -;; (plist-get (charset-plist charset) propname)) - -;; (defsubst put-charset-property (charset propname value) -;; "Store CHARSETS's PROPNAME property with value VALUE. -;; It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." -;; (set-charset-plist charset -;; (plist-put (charset-plist charset) propname value))) - -(defvar char-code-property-table - (make-char-table 'generic) - "Char-table containing a property list of each character code. -;; -See also the documentation of `get-char-code-property' and -`put-char-code-property'") -;; (let ((plist (aref char-code-property-table char))) -(defun get-char-code-property (char propname) - "Return the value of CHAR's PROPNAME property in `char-code-property-table'." - (let ((plist (get-char-table char char-code-property-table))) - (if (listp plist) - (car (cdr (memq propname plist)))))) - -(defun put-char-code-property (char propname value) - "Store CHAR's PROPNAME property with VALUE in `char-code-property-table'. -It can be retrieved with `(get-char-code-property CHAR PROPNAME)'." - (let ((plist (get-char-table char char-code-property-table))) - (if plist - (let ((slot (memq propname plist))) - (if slot - (setcar (cdr slot) value) - (nconc plist (list propname value)))) - (put-char-table char (list propname value) char-code-property-table) - ))) -;; (setcar (cdr slot) value) -;; (nconc plist (list propname value)))) -;; (aset char-code-property-table char (list propname value))))) - -;;; mule-cmds.el ends here diff --git a/lisp/mule/mule-coding.el b/lisp/mule/mule-coding.el deleted file mode 100644 index 3880c18..0000000 --- a/lisp/mule/mule-coding.el +++ /dev/null @@ -1,188 +0,0 @@ -;;; mule-coding.el --- Coding-system functions for Mule. - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; 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: - -;;; split off of mule.el and mostly moved to coding.el - -;;; Code: - -(defun coding-system-force-on-output (coding-system register) - "Return the 'force-on-output property of CODING-SYSTEM for the specified REGISTER." - (unless (integerp register) - (signal 'wrong-type-argument (list 'integerp register))) - (coding-system-property - coding-system - (case register - (0 'force-g0-on-output) - (1 'force-g1-on-output) - (2 'force-g2-on-output) - (3 'force-g3-on-output) - (t (signal 'args-out-of-range (list register 0 3)))))) - -(defun coding-system-short (coding-system) - "Return the 'short property of CODING-SYSTEM." - (coding-system-property coding-system 'short)) - -(defun coding-system-no-ascii-eol (coding-system) - "Return the 'no-ascii-eol property of CODING-SYSTEM." - (coding-system-property coding-system 'no-ascii-eol)) - -(defun coding-system-no-ascii-cntl (coding-system) - "Return the 'no-ascii-cntl property of CODING-SYSTEM." - (coding-system-property coding-system 'no-ascii-cntl)) - -(defun coding-system-seven (coding-system) - "Return the 'seven property of CODING-SYSTEM." - (coding-system-property coding-system 'seven)) - -(defun coding-system-lock-shift (coding-system) - "Return the 'lock-shift property of CODING-SYSTEM." - (coding-system-property coding-system 'lock-shift)) - -;;(defun coding-system-use-japanese-jisx0201-roman (coding-system) -;; "Return the 'use-japanese-jisx0201-roman property of CODING-SYSTEM." -;; (coding-system-property coding-system 'use-japanese-jisx0201-roman)) - -;;(defun coding-system-use-japanese-jisx0208-1978 (coding-system) -;; "Return the 'use-japanese-jisx0208-1978 property of CODING-SYSTEM." -;; (coding-system-property coding-system 'use-japanese-jisx0208-2978)) - -(defun coding-system-no-iso6429 (coding-system) - "Return the 'no-iso6429 property of CODING-SYSTEM." - (coding-system-property coding-system 'no-iso6429)) - -(defun coding-system-ccl-encode (coding-system) - "Return the CCL 'encode property of CODING-SYSTEM." - (coding-system-property coding-system 'encode)) - -(defun coding-system-ccl-decode (coding-system) - "Return the CCL 'decode property of CODING-SYSTEM." - (coding-system-property coding-system 'decode)) - - -;;;; Definitions of predefined coding systems - -(make-coding-system - 'ctext 'iso2022 - "Coding-system used in X as Compound Text Encoding." - '(charset-g0 ascii - charset-g1 latin-iso8859-1 - eol-type nil - mnemonic "CText")) - -;;; iso-8859-1 and ctext are aliases. - -;; (copy-coding-system 'ctext 'iso-8859-1) -(make-coding-system - 'iso-8859-1 'no-conversion - "Coding-system used in X as Compound Text Encoding." - '(eol-type nil mnemonic "Noconv")) - -(make-coding-system - 'iso-2022-8bit-ss2 'iso2022 - "ISO-2022 coding system using SS2 for 96-charset in 8-bit code." - '(charset-g0 ascii - charset-g1 latin-iso8859-1 - charset-g2 t ;; unspecified but can be used later. - short t - mnemonic "ISO8/SS" - )) - -(make-coding-system - 'iso-2022-7bit-ss2 'iso2022 - "ISO-2022 coding system using SS2 for 96-charset in 7-bit code." - '(charset-g0 ascii - charset-g2 t ;; unspecified but can be used later. - seven t - short t - mnemonic "ISO7/SS" - eol-type nil)) - -;; (copy-coding-system 'iso-2022-7bit-ss2 'iso-2022-jp-2) -(make-coding-system - 'iso-2022-jp-2 'iso2022 - "ISO-2022 coding system using SS2 for 96-charset in 7-bit code." - '(charset-g0 ascii - charset-g2 t ;; unspecified but can be used later. - seven t - short t - mnemonic "ISO7/SS" - eol-type nil)) - -(make-coding-system - 'iso-2022-7bit 'iso2022 - "ISO 2022 based 7-bit encoding using only G0" - '(charset-g0 ascii - seven t - short t - mnemonic "ISO7")) - -;; compatibility for old XEmacsen -(copy-coding-system 'iso-2022-7bit 'iso-2022-7) - -(make-coding-system - 'iso-2022-8 'iso2022 - "ISO-2022 eight-bit coding system. No single-shift or locking-shift." - '(charset-g0 ascii - charset-g1 latin-iso8859-1 - short t - mnemonic "ISO8" - )) - -(make-coding-system - 'escape-quoted 'iso2022 - "ISO-2022 eight-bit coding system with escape quoting; used for .ELC files." - '(charset-g0 ascii - charset-g1 latin-iso8859-1 - eol-type lf - escape-quoted t - mnemonic "ESC/Quot" - )) - -(make-coding-system - 'iso-2022-lock 'iso2022 - "ISO-2022 coding system using Locking-Shift for 96-charset." - '(charset-g0 ascii - charset-g1 t ;; unspecified but can be used later. - seven t - lock-shift t - mnemonic "ISO7/Lock" - )) - -;; initialize the coding categories to something semi-reasonable -;; so that the remaining Lisp files can contain extended characters. -;; (They will be in ISO-7 format) - -(set-coding-priority-list '(iso-8-2 iso-8-designate iso-8-1 - iso-7 iso-lock-shift no-conversion)) - -(set-coding-category-system 'iso-7 'iso-2022-7) -(set-coding-category-system 'iso-8-designate 'ctext) -(set-coding-category-system 'iso-8-1 'ctext) -(set-coding-category-system 'iso-lock-shift 'iso-2022-lock) -(set-coding-category-system 'no-conversion 'no-conversion) - -;;; mule-coding.el ends here diff --git a/lisp/mule/mule-help.el b/lisp/mule/mule-help.el deleted file mode 100644 index 0a330cd..0000000 --- a/lisp/mule/mule-help.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; mule-help.el --- Mule-ized Help functions - -;; Copyright (C) 1997 by Free Software Foundation, Inc. - -;; Author: SL Baur -;; Keywords: help, 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: Emacs 20.1 - -;;; Commentary: - -;; - -;;; Code: - -;; TUTORIAL arg is XEmacs addition -(defun help-with-tutorial (&optional arg tutorial) - "Select the XEmacs learn-by-doing tutorial. -If there is a tutorial version written in the language -of the selected language environment, that version is used. -If there's no tutorial in that language, `TUTORIAL' is selected. -With arg, you are asked to select which language." - (interactive "P") - (let (lang filename file) - (if arg - (or (setq lang (read-language-name 'tutorial "Language: ")) - (error "No tutorial file of the specified language")) - (setq lang current-language-environment)) - ;; The menubar buttons call this function like this: - ;; (help-with-tutorial nil "tutorial.lang") - (setq filename (if (and (not arg) tutorial) - tutorial - (or (get-language-info lang 'tutorial) - (or tutorial "TUTORIAL")))) - (setq file (expand-file-name (concat "~/" filename))) - (delete-other-windows) - (if (get-file-buffer file) - (switch-to-buffer (get-file-buffer file)) - (switch-to-buffer (create-file-buffer file)) - (setq buffer-file-name file) - (setq default-directory (expand-file-name "~/")) - (setq buffer-auto-save-file-name nil) - (insert-file-contents (locate-data-file filename)) - (goto-char (point-min)) - ;; The 'didactic' blank lines: Possibly insert blank lines - ;; around <>, and change << >> to [ ]. - (if (re-search-forward "^<<.+>>" nil t) - (let ((n (- (window-height (selected-window)) - (count-lines (point-min) (point-at-bol)) - 6))) - (if (< n 12) - (progn (beginning-of-line) (kill-line)) - ;; Some people get confused by the large gap - (delete-backward-char 2) - (insert "]") - (beginning-of-line) - (save-excursion - (delete-char 2) - (insert "[")) - (newline (/ n 2)) - (next-line 1) - (newline (- n (/ n 2)))))) - (goto-char (point-min)) - (set-buffer-modified-p nil)))) - - -(provide 'mule-help) - -;;; mule-help.el ends here \ No newline at end of file diff --git a/lisp/mule/mule-init.el b/lisp/mule/mule-init.el deleted file mode 100644 index baf9c57..0000000 --- a/lisp/mule/mule-init.el +++ /dev/null @@ -1,132 +0,0 @@ -;; Mule default configuration 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. - -;;; 87.6.9 created by K.handa -;;; (Note: following comment obsolete -- mrb) - -;;; IMPORTANT NOTICE -- DON'T EDIT THIS FILE!!! -;;; Keep this file unmodified for further patches being applied successfully. -;;; All language specific basic environments are defined here. -;;; By default, Japanese is set as the primary environment. -;;; You can change primary environment in `./lisp/site-init.el by -;;; `set-primary-environment'. For instance, -;;; (set-primary-environment 'chinese) -;;; makes Chinese the primary environment. -;;; If you are still not satisfied with the settings, you can -;;; override them after the above line. For instance, -;;; (set-default-buffer-file-coding-system 'big5) -;;; makes big5 be used for file I/O by default. -;;; If you are not satisfied with other default settings in this file, -;;; override any of them also in `./lisp/site-init.el'. For instance, -;;; (define-program-coding-system nil ".*mail.*" 'iso-8859-1) -;;; makes the coding-system 'iso-8859-1 be used in mail. - - -;;;; GLOBAL ENVIRONMENT SETUP -(require 'cl) - - -;; (setq language-environment-list -;; (sort (language-environment-list) 'string-lessp)) - -;; MULE keymap codes were moved to mule-cmds.el. - -;; Alternative key definitions -;; Original mapping will be altered by set-keyboard-coding-system. -(define-key global-map [(meta \#)] 'ispell-word) ;originally "$" -;; (define-key global-map [(meta {)] 'insert-parentheses) ;originally "(" - -;; Following line isn't mule-specific --mrb -;;(setq-default modeline-buffer-identification '("XEmacs: %17b")) - -;; MULE keymap codes were moved to mule-cmds.el. - -;; (define-key help-map "T" 'help-with-tutorial-for-mule) - -;; (defvar help-with-tutorial-language-alist -;; '(("Japanese" . ".jp") -;; ("Korean" . ".kr") -;; ("Thai" . ".th"))) - -;(defun help-with-tutorial-for-mule (language) -; "Select the Mule learn-by-doing tutorial." -; (interactive (list (let ((completion-ignore-case t) -; lang) -; (completing-read -; "Language: " -; help-with-tutorial-language-alist)))) -; (setq language (cdr (assoc language help-with-tutorial-language-alist))) -; (help-with-tutorial (concat "mule/TUTORIAL" (or language "")))) - -(defvar auto-language-alist - '(("^ja" . "Japanese") - ("^zh" . "Chinese") - ("^ko" . "Korean")) - "Alist of LANG patterns vs. corresponding language environment. -Each element looks like (REGEXP . LANGUAGE-ENVIRONMENT). -It the value of the environment variable LANG matches the regexp REGEXP, -then `set-language-environment' is called with LANGUAGE-ENVIRONMENT.") - -(defun init-mule () - "Initialize MULE environment at startup. Don't call this." - (let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG")))) - (unless (or (null lang) (string-equal "C" lang)) - (let ((case-fold-search t)) - (loop for elt in auto-language-alist - if (string-match (car elt) lang) - return (progn - (setq lang (substring lang 0 (match-end 0))) - (set-language-environment (cdr elt)) - ))) - ;; Load a (localizable) locale-specific init file, if it exists. - (load (format "%s%s/locale-start" - (locate-data-directory "start-files") - lang) t t))) - - (when current-language-environment - ;; Translate remaining args on command line using file-name-coding-system - (loop for arg in-ref command-line-args-left do - (setf arg (decode-coding-string arg file-name-coding-system))) - - ;; rman seems to be incompatible with encoded text - (setq Manual-use-rosetta-man nil) - - ;; Make sure ls -l output is readable by dired and encoded using - ;; file-name-coding-system - (add-hook - 'dired-mode-hook - (lambda () - (make-local-variable 'process-environment) - (setenv "LC_MESSAGES" "C") - (setenv "LC_TIME" "C")))) - - ;; Register avairable input methods by loading LEIM list file. - (load "leim-list.el" 'noerror 'nomessage 'nosuffix) - ) - -(add-hook 'before-init-hook 'init-mule) - -;;;;; Enable the tm package by default -;;(defun init-mule-tm () -;; "Load MIME (TM) support for GNUS, VM, MH-E, and RMAIL." -;; (load "mime-setup")) - -;;(add-hook 'after-init-hook 'init-mule-tm) - -;;; mule-init.el ends here diff --git a/lisp/mule/mule-misc.el b/lisp/mule/mule-misc.el deleted file mode 100644 index 3488781..0000000 --- a/lisp/mule/mule-misc.el +++ /dev/null @@ -1,295 +0,0 @@ -;; mule-misc.el --- Miscellaneous Mule functions. - -;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. -;; Licensed to the Free Software Foundation. -;; Copyright (C) 1992,93,94,95 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 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. - -;;; -;;; protect specified local variables from kill-all-local-variables -;;; - -(defvar self-insert-after-hook nil - "Hook to run when extended self insertion command exits. Should take -two arguments START and END corresponding to character position.") - -(make-variable-buffer-local 'self-insert-after-hook) - -(defun toggle-display-direction () - (interactive) - (setq display-direction (not display-direction)) - (if (interactive-p) (redraw-display))) - -;;; -;;; Utility functions for Mule -;;; - -;(defun string-to-char-list (str) -; (let ((len (length str)) -; (idx 0) -; c l) -; (while (< idx len) -; (setq c (sref str idx)) -; (setq idx (+ idx (charset-dimension (char-charset c)))) -; (setq l (cons c l))) -; (nreverse l))) - -(defun string-to-char-list (str) - (mapcar 'identity str)) - -(defun string-width (string) - "Return number of columns STRING occupies when displayed. -Uses the charset-columns attribute of the characters in STRING, -which may not accurately represent the actual display width when -using a window system." - (let ((col 0) - (len (length string)) - (i 0)) - (while (< i len) - (setq col (+ col (charset-columns (char-charset (aref string i))))) - (setq i (1+ i))) - col)) - -(defalias 'string-columns 'string-width) -(make-obsolete 'string-columns 'string-width) - -(defun delete-text-in-column (from to) - "Delete the text between column FROM and TO (exclusive) of the current line. -Nil of FORM or TO means the current column. - -If there's a character across the borders, the character is replaced -with the same width of spaces before deleting." - (save-excursion - (let (p1 p2) - (if from - (progn - (setq p1 (move-to-column from)) - (if (> p1 from) - (progn - (delete-char -1) - (insert-char ? (- p1 (current-column))) - (forward-char (- from p1)))))) - (setq p1 (point)) - (if to - (progn - (setq p2 (move-to-column to)) - (if (> p2 to) - (progn - (delete-char -1) - (insert-char ? (- p2 (current-column))) - (forward-char (- to p2)))))) - (setq p2 (point)) - (delete-region p1 p2)))) - -;; #### Someone translate this!! - -(defun mc-normal-form-string (str) - "$BJ8;zNs(B STR $B$N4A;zI8=`7AJ8;zNs$rJV$9!%(B" - (let ((i 0)) - (while (setq i (string-match "\n" str i)) - (if (and (<= 1 i) (< i (1- (length str))) - (< (aref str (1- i)) 128) - (< (aref str (1+ i)) 128)) - (aset str i ? )) - (setq i (1+ i))) - (if (string-match "\n" str 0) - (let ((c 0) (i 0) new) - (while (setq i (string-match "\n" str i)) - (setq i (1+ i)) - (setq c (1+ c))) - (setq new (make-string (- (length str) c) 0)) - (setq i 0 c 0) - (while (< i (length str)) - (cond((not (= (aref str i) ?\n )) - (aset new c (aref str i)) - (setq c (1+ c)))) - - (setq i (1+ i)) - ) - new) - str))) - - -(defun string-memq (str list) - "Returns non-nil if STR is an element of LIST. Comparison done with string=. -The value is actually the tail of LIST whose car is STR. -If each element of LIST is not a string, it is converted to string - before comparison." - (let (find elm) - (while (and (not find) list) - (setq elm (car list)) - (if (numberp elm) (setq elm (char-to-string elm))) - (if (string= str elm) - (setq find list) - (setq list (cdr list)))) - find)) - -(defun cancel-undo-boundary () - "Cancel undo boundary." - (if (and (consp buffer-undo-list) - ;; if car is nil. - (null (car buffer-undo-list)) ) - (setq buffer-undo-list (cdr buffer-undo-list)) )) - - -;;; Common API emulation functions for GNU Emacs-merged Mule. -;;; As suggested by MORIOKA Tomohiko - -;; Following definition were imported from Emacs/mule-delta. - -;; Function `truncate-string-to-width' was moved to mule-util.el. - -;; end of imported definition - - -(defalias 'sref 'aref) -(defalias 'map-char-concat 'mapcar) -(defun char-bytes (character) - "Return number of length a CHARACTER occupies in a string or buffer. -It returns only 1 in XEmacs. It is for compatibility with MULE 2.3." - 1) -(defalias 'char-length 'char-bytes) - -(defun char-width (character) - "Return number of columns a CHARACTER occupies when displayed." - (charset-columns (char-charset character))) - -(defalias 'char-columns 'char-width) -(make-obsolete 'char-columns 'char-width) - -(defalias 'charset-description 'charset-doc-string) - -(defalias 'find-charset-string 'charsets-in-string) -(defalias 'find-charset-region 'charsets-in-region) - -(defun find-non-ascii-charset-string (string) - "Return a list of charsets in the STRING except ascii. -It might be available for compatibility with Mule 2.3, -because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (charsets-in-string string))) - -(defun find-non-ascii-charset-region (start end) - "Return a list of charsets except ascii in the region between START and END. -It might be available for compatibility with Mule 2.3, -because its `find-charset-string' ignores ASCII charset." - (delq 'ascii (charsets-in-region start end))) - -(defun split-char (char) - "Return list of charset and one or two position-codes of CHAR." - (let ((charset (char-charset char))) - (if (eq charset 'ascii) - (list charset (char-int char)) - (let ((i 0) - (len (charset-dimension charset)) - (code (if (integerp char) - char - (char-int char))) - dest) - (while (< i len) - (setq dest (cons (logand code 127) dest) - code (lsh code -7) - i (1+ i))) - (cons charset dest) - )))) - - -;;; Commands - -(defun set-buffer-process-coding-system (decoding encoding) - "Set coding systems for the process associated with the current buffer. -DECODING is the coding system to be used to decode input from the process, -ENCODING is the coding system to be used to encode output to the process. - -For a list of possible values of CODING-SYSTEM, use \\[list-coding-systems]." - (interactive - "zCoding-system for process input: \nzCoding-system for process output: ") - (let ((proc (get-buffer-process (current-buffer)))) - (if (null proc) - (error "no process") - (check-coding-system decoding) - (check-coding-system encoding) - (set-process-coding-system proc decoding encoding))) - (force-mode-line-update)) - - -;;; Language environments - -;; (defvar current-language-environment nil) - -;; (defvar language-environment-list nil) - -;; (defun current-language-environment () -;; "Return the current language environment as a symbol. -;; Returns nil if `set-language-environment' has not been called." -;; current-language-environment) - -;; (defun language-environment-list () -;; "Return a list of all currently defined language environments." -;; language-environment-list) - -;; (defun language-environment-p (sym) -;; "True if SYM names a defined language environment." -;; (memq sym (language-environment-list))) - -;; (defun set-language-environment (env) -;; "Set the current language environment to ENV." -;; (interactive -;; (list (intern (completing-read "Language environment: " -;; obarray 'language-environment-p -;; 'require-match)))) -;; (when (not (string= (charset-registry 'ascii) "iso8859-1")) -;; (set-charset-registry 'ascii "iso8859-1")) -;; (let ((func (get env 'set-lang-environ))) -;; (if (not (null func)) -;; (funcall func))) -;; (setq current-language-environment env) -;; (if (featurep 'egg) -;; (egg-lang-switch-callback)) -;; ;; (if (featurep 'quail) -;; ;; (quail-lang-switch-callback)) -;; ) - -;; (defun define-language-environment (env-sym doc-string enable-function) -;; "Define a new language environment, named by ENV-SYM. -;; DOC-STRING should be a string describing the environment. -;; ENABLE-FUNCTION should be a function of no arguments that will be called -;; when the language environment is made current." -;; (put env-sym 'lang-environ-doc-string doc-string) -;; (put env-sym 'set-lang-environ enable-function) -;; (setq language-environment-list (cons env-sym language-environment-list))) - -(defun define-egg-environment (env-sym doc-string enable-function) - "Define a new language environment for egg, named by ENV-SYM. -DOC-STRING should be a string describing the environment. -ENABLE-FUNCTION should be a function of no arguments that will be called -when the language environment is made current." - (put env-sym 'egg-environ-doc-string doc-string) - (put env-sym 'set-egg-environ enable-function)) - -;; (defun define-quail-environment (env-sym doc-string enable-function) -;; "Define a new language environment for quail, named by ENV-SYM. -;; DOC-STRING should be a string describing the environment. -;; ENABLE-FUNCTION should be a function of no arguments that will be called -;; when the language environment is made current." -;; (put env-sym 'quail-environ-doc-string doc-string) -;; (put env-sym 'set-quail-environ enable-function)) - -;;; mule-misc.el ends here diff --git a/lisp/mule/mule-x-init.el b/lisp/mule/mule-x-init.el deleted file mode 100644 index 8bb351c..0000000 --- a/lisp/mule/mule-x-init.el +++ /dev/null @@ -1,126 +0,0 @@ -;;; mule-x-init.el --- initialization code for X Windows under MULE -;; Copyright (C) 1994 Free Software Foundation, Inc. -;; Copyright (C) 1996 Ben Wing - -;; Author: various -;; Keywords: mule X11 - -;; 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: - -;;; Code: - -;;; Work around what is arguably a Sun CDE bug. - -(defun x-use-halfwidth-roman-font (fullwidth-charset roman-registry) - "Maybe set charset registry of the 'ascii charset to ROMAN-REGISTRY. - -Do this only if: - - the current display is an X device - - the displayed width of FULLWIDTH-CHARSET is twice the displayed - width of the 'ascii charset, but only when using ROMAN-REGISTRY. - -Traditionally, Asian characters have been displayed so that they -occupy exactly twice the screen space of ASCII (`halfwidth') -characters. On many systems, e.g. Sun CDE systems, this can only be -achieved by using a national variant roman font to display ASCII." - (let ((charset-font-width - (lambda (charset) - (font-instance-width - (face-font-instance 'default (selected-device) charset)))) - - (twice-as-wide - (lambda (cs1 cs2) - (let ((width1 (funcall charset-font-width cs1)) - (width2 (funcall charset-font-width cs2))) - (and width1 width2 (eq (+ width1 width1) width2)))))) - - (when (eq 'x (device-type)) - (condition-case nil - (unless (funcall twice-as-wide 'ascii fullwidth-charset) - (set-charset-registry 'ascii roman-registry) - (unless (funcall twice-as-wide 'ascii fullwidth-charset) - ;; Restore if roman-registry didn't help - (set-charset-registry 'ascii "iso8859-1"))) - (error (set-charset-registry 'ascii "iso8859-1")))))) - -;;;; - -(defvar mule-x-win-initted nil) - -(defun init-mule-x-win () - "Initialize X Windows for MULE at startup. Don't call this." - (when (not mule-x-win-initted) - (define-specifier-tag 'mule-fonts - (lambda (device) (eq 'x (device-type device)))) - - (set-face-font - 'default - '("-*-fixed-medium-r-*--16-*-iso8859-1" - "-*-fixed-medium-r-*--*-iso8859-1" - "-*-fixed-medium-r-*--*-iso8859-2" - "-*-fixed-medium-r-*--*-iso8859-3" - "-*-fixed-medium-r-*--*-iso8859-4" - "-*-fixed-medium-r-*--*-iso8859-7" - "-*-fixed-medium-r-*--*-iso8859-8" - "-*-fixed-medium-r-*--*-iso8859-5" - "-*-fixed-medium-r-*--*-iso8859-9" - - ;; Following 3 fonts proposed by Teruhiko.Kurosaka@Japan.eng.sun - "-sun-gothic-medium-r-normal--14-120-75-75-c-60-jisx0201.1976-0" - "-sun-gothic-medium-r-normal--14-120-75-75-c-120-jisx0208.1983-0" - "-wadalab-gothic-medium-r-normal--14-120-75-75-c-120-jisx0212.1990-0" - ;; Other Japanese fonts - "-*-fixed-medium-r-*--*-jisx0201.1976-*" - "-*-fixed-medium-r-*--*-jisx0208.1983-*" - "-*-fixed-medium-r-*--*-jisx0212*-*" - - ;; Chinese fonts - "-*-*-medium-r-*--*-gb2312.1980-*" - - ;; Use One font specification for CNS chinese - ;; Too many variations in font naming - "-*-fixed-medium-r-*--*-cns11643*-*" - ;; "-*-fixed-medium-r-*--*-cns11643*2" - ;; "-*-fixed-medium-r-*--*-cns11643*3" - ;; "-*-fixed-medium-r-*--*-cns11643*4" - ;; "-*-fixed-medium-r-*--*-cns11643.5-0" - ;; "-*-fixed-medium-r-*--*-cns11643.6-0" - ;; "-*-fixed-medium-r-*--*-cns11643.7-0" - - "-*-fixed-medium-r-*--*-big5*-*" - "-*-fixed-medium-r-*--*-sisheng_cwnn-0" - - ;; Other fonts - - ;; "-*-fixed-medium-r-*--*-viscii1.1-1" - - ;; "-*-fixed-medium-r-*--*-mulearabic-0" - ;; "-*-fixed-medium-r-*--*-mulearabic-1" - ;; "-*-fixed-medium-r-*--*-mulearabic-2" - - ;; "-*-fixed-medium-r-*--*-muleipa-1" - ;; "-*-fixed-medium-r-*--*-ethio-*" - - "-*-mincho-medium-r-*--*-ksc5601.1987-*" ; Korean - "-*-fixed-medium-r-*--*-tis620.2529-1" ; Thai - ) - 'global '(mule-fonts) 'append) - - (setq mule-x-win-initted t))) diff --git a/lisp/multicast.el b/lisp/multicast.el deleted file mode 100644 index cfedfde..0000000 --- a/lisp/multicast.el +++ /dev/null @@ -1,81 +0,0 @@ -;;; multicast.el --- lisp frontend for multicast connections in XEmacs - -;; Copyright (C) 1997-1998 Didier Verna. - -;; Author: Didier Verna -;; Maintainer: Didier Verna -;; Created: Thu Dec 4 16:37:39 1997 -;; Last Revision: Mon Jan 19 19:10:50 1998 -;; Current Version: 0.4 -;; Keywords: dumped 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: - -;; This file just contains a lisp frontend to the internal function -;; open-multicast-group-internal written in C and belonging to process.c -;; Well, nothing much to say about it ... read the doc string. - - -;;; Change Log: - -;; Rev. of Mon Jan 19 19:04:44 1998 : packaging cleanup -;; Rev. of Thu Dec 11 13:54:26 1997 : updated the docstring -;; Rev. of Mon Dec 8 15:28:47 1997 : Improved the doc string -;; Rev. of Thu Dec 4 16:38:09 1997 : Initial Version. - - -;;; Code: - -(defun open-multicast-group (name buffer address) - "Open a multicast connection on the specified address. -Returns a subprocess-object to represent the connection. -Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER ADDRESS. -NAME is a name for the 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 the 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 -ADDRESS specifies a standard multicast address \"dest/port/ttl\": - dest is an internet address between 224.0.0.0 and 239.255.255.255 - port is a communication port like in traditional unicast - ttl is the time-to-live (15 for site, 63 for region and 127 for world). - -WARNING: it is *strongly* recommended to avoid using groups beginning with - 224 or 239. Such groups are considered 'admin' groups, and may - behave in a surprising way ..." - (let (dest port ttl) - ;; We check only the general form of the multicast address. - ;; The rest will be handled by the internal function. - (string-match "^\\([0-9\\.]+\\)/\\([0-9]+\\)/\\([0-9]+\\)$" address) - (and (not (and (= (match-beginning 0) 0) - (= (match-end 0) (length address)))) - (error "malformed multicast address: %s" address)) - (and (not (setq dest (match-string 1 address))) - (error "invalid destination specification.")) - (and (= 0 (setq port (string-to-int (match-string 2 address)))) - (error "invalid port specification.")) - (and (= 0 (setq ttl (string-to-int (match-string 3 address)))) - (error "invalid ttl specification.")) - (open-multicast-group-internal name buffer dest port ttl) - )) - -;;; multicast.el ends here diff --git a/lisp/mwheel.el b/lisp/mwheel.el deleted file mode 100644 index 57725f2..0000000 --- a/lisp/mwheel.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; mwheel.el --- Mouse support for MS intelli-mouse type mice - -;; Copyright (C) 1998, Free Software Foundation, Inc. -;; Maintainer: William M. Perry -;; Keywords: 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 synched. - -;;; Commentary: - -;; This code will enable the use of the infamous 'wheel' on the new -;; crop of mice. Under XFree86 and the XSuSE X Servers, the wheel -;; events are sent as button4/button5 events. - -;; I for one would prefer some way of converting the button4/button5 -;; events into different event types, like 'mwheel-up' or -;; 'mwheel-down', but I cannot find a way to do this very easily (or -;; portably), so for now I just live with it. - -;; To enable this code, simply put this at the top of your .emacs -;; file: -;; -;; (autoload 'mwheel-install "mwheel" "Enable mouse wheel support.") -;; (mwheel-install) - -;;; Code: - -(require 'custom) -(require 'cl) - -(defcustom mwheel-scroll-amount '(5 . 1) - "Amount to scroll windows by when spinning the mouse wheel. -This is actually a cons cell, where the first item is the amount to scroll -on a normal wheel event, and the second is the amount to scroll when the -wheel is moved with the shift key depressed. - -Each item should be the number of lines to scroll, or `nil' for near -full screen. -A near full screen is `next-screen-context-lines' less than a full screen." - :group 'mouse - :type '(cons - (choice :tag "Normal" - (const :tag "Full screen" :value nil) - (integer :tag "Specific # of lines")) - (choice :tag "Shifted" - (const :tag "Full screen" :value nil) - (integer :tag "Specific # of lines")))) - -(defcustom mwheel-follow-mouse nil - "Whether the mouse wheel should scroll the window that the mouse is over. -This can be slightly disconcerting, but some people may prefer it." - :group 'mouse - :type 'boolean) - -(if (not (fboundp 'event-button)) - (defun mwheel-event-button (event) - (let ((x (symbol-name (event-basic-type event)))) - (if (not (string-match "^mouse-\\([0-9]+\\)" x)) - (error "Not a button event: %S" event)) - (string-to-int (substring x (match-beginning 1) (match-end 1))))) - (fset 'mwheel-event-button 'event-button)) - -(if (not (fboundp 'event-window)) - (defun mwheel-event-window (event) - (posn-window (event-start event))) - (fset 'mwheel-event-window 'event-window)) - -(defun mwheel-scroll (event) - (interactive "e") - (let ((curwin (if mwheel-follow-mouse - (prog1 - (selected-window) - (select-window (mwheel-event-window event))))) - (amt (if (memq 'shift (event-modifiers event)) - (cdr mwheel-scroll-amount) - (car mwheel-scroll-amount)))) - (case (mwheel-event-button event) - (4 (scroll-down amt)) - (5 (scroll-up amt)) - (otherwise (error "Bad binding in mwheel-scroll"))) - (if curwin (select-window curwin)))) - -;;;###autoload -(defun mwheel-install () - "Enable mouse wheel support." - (let ((keys '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)]))) - ;; This condition-case is here because Emacs 19 will throw an error - ;; if you try to define a key that it does not know about. I for one - ;; prefer to just unconditionally do a mwheel-install in my .emacs, so - ;; that if the wheeled-mouse is there, it just works, and this way it - ;; doesn't yell at me if I'm on my laptop or another machine, etc. - (condition-case () - (while keys - (define-key global-map (car keys) 'mwheel-scroll) - (setq keys (cdr keys))) - (error nil)))) - -(provide 'mwheel) - -;;; mwheel.el ends here diff --git a/lisp/objects.el b/lisp/objects.el deleted file mode 100644 index 9c1d690..0000000 --- a/lisp/objects.el +++ /dev/null @@ -1,149 +0,0 @@ -;;; objects.el --- Lisp interface to C window-system objects - -;; Copyright (C) 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing - -;; Author: Chuck Thompson -;; Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: faces, internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun ws-object-property-1 (function object domain &optional matchspec) - (let ((instance (if matchspec - (specifier-matching-instance object matchspec domain) - (specifier-instance object domain)))) - (and instance (funcall function instance)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; font specifiers - -(defun make-font-specifier (spec-list) - "Return a new `font' specifier object with the given specification list. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for more information about -specifiers." - (make-specifier-and-init 'font spec-list)) - -(defun font-name (font &optional domain charset) - "Return the name of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-name' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-name font domain charset)) - -(defun font-ascent (font &optional domain charset) - "Return the ascent of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-ascent' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-ascent font domain charset)) - -(defun font-descent (font &optional domain charset) - "Return the descent of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-descent' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-descent font domain charset)) - -(defun font-width (font &optional domain charset) - "Return the width of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-width' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-width font domain charset)) - -(defun font-height (font &optional domain charset) - "Return the height of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-height' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-height font domain charset)) - -(defun font-proportional-p (font &optional domain charset) - "Return whether FONT is proportional in the specified DOMAIN, if known. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-proportional-p' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-proportional-p font domain charset)) - -(defun font-properties (font &optional domain charset) - "Return the properties of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-properties' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-properties font domain charset)) - -(defun font-truename (font &optional domain charset) - "Return the truename of the FONT in the specified DOMAIN, if any. -FONT should be a font specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `font-instance-truename' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'font-instance-truename font domain charset)) - -(defun font-instance-height (font-instance) - "Return the height in pixels of FONT-INSTANCE. -The returned value is the maximum height for all characters in the font,\n\ -and is equivalent to the sum of the font instance's ascent and descent." - (+ (font-instance-ascent font-instance) - (font-instance-descent font-instance))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; color specifiers - -(defun make-color-specifier (spec-list) - "Return a new `color' specifier object with the given specification list. -SPEC-LIST can be a list of specifications (each of which is a cons of a -locale and a list of instantiators), a single instantiator, or a list -of instantiators. See `make-specifier' for a detailed description of -how specifiers work." - (make-specifier-and-init 'color spec-list)) - -(defun color-name (color &optional domain) - "Return the name of the COLOR in the specified DOMAIN, if any. -COLOR should be a color specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `color-instance-name' to -the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'color-instance-name color domain)) - -(defun color-rgb-components (color &optional domain) - "Return the RGB components of the COLOR in the specified DOMAIN, if any. -COLOR should be a color specifier object and DOMAIN is normally a window -and defaults to the selected window if omitted. This is equivalent -to using `specifier-instance' and applying `color-instance-rgb-components' -to the result. See `make-specifier' for more information about specifiers." - (ws-object-property-1 'color-instance-rgb-components color domain)) - -;;; objects.el ends here. diff --git a/lisp/obsolete.el b/lisp/obsolete.el deleted file mode 100644 index e71fa7a..0000000 --- a/lisp/obsolete.el +++ /dev/null @@ -1,381 +0,0 @@ -;;; obsolete.el --- obsoleteness support - -;; Copyright (C) 1985-1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1994, 1995 Amdahl Corporation. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; The obsoleteness support used to be scattered throughout various -;; source files. We put the stuff in one place to remove the junkiness -;; from other source files and to facilitate creating/updating things -;; like sysdep.el. - -;;; Code: - -(defsubst define-obsolete-function-alias (oldfun newfun) - "Define OLDFUN as an obsolete alias for function NEWFUN. -This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN -as obsolete." - (define-function oldfun newfun) - (make-obsolete oldfun newfun)) - -(defsubst define-compatible-function-alias (oldfun newfun) - "Define OLDFUN as a compatible alias for function NEWFUN. -This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN -as provided for compatibility only." - (define-function oldfun newfun) - (make-compatible oldfun newfun)) - -(defsubst define-obsolete-variable-alias (oldvar newvar) - "Define OLDVAR as an obsolete alias for variable NEWVAR. -This makes referencing or setting OLDVAR equivalent to referencing or -setting NEWVAR and marks OLDVAR as obsolete. -If OLDVAR was bound and NEWVAR was not, Set NEWVAR to OLDVAR. - -Note: Use this before any other references (defvar/defcustom) to NEWVAR" - (let ((needs-setting (and (boundp oldvar) (not (boundp newvar)))) - (value (and (boundp oldvar) (symbol-value oldvar)))) - (defvaralias oldvar newvar) - (make-obsolete-variable oldvar newvar) - (and needs-setting (set newvar value)))) - -(defsubst define-compatible-variable-alias (oldvar newvar) - "Define OLDVAR as a compatible alias for variable NEWVAR. -This makes referencing or setting OLDVAR equivalent to referencing or -setting NEWVAR and marks OLDVAR as provided for compatibility only." - (defvaralias oldvar newvar) - (make-compatible-variable oldvar newvar)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff - -(make-compatible-variable 'window-system "use (console-type)") - -(defun x-display-color-p (&optional device) - "Return t if DEVICE is a color device." - (eq 'color (device-class device))) -(make-compatible 'x-display-color-p 'device-class) - -(define-function 'x-color-display-p 'x-display-color-p) -(make-compatible 'x-display-color-p 'device-class) - -(defun x-display-grayscale-p (&optional device) - "Return t if DEVICE is a grayscale device." - (eq 'grayscale (device-class device))) -(make-compatible 'x-display-grayscale-p 'device-class) - -(define-function 'x-grayscale-display-p 'x-display-grayscale-p) -(make-compatible 'x-display-grayscale-p 'device-class) - -(define-compatible-function-alias 'x-display-pixel-width 'device-pixel-width) -(define-compatible-function-alias 'x-display-pixel-height 'device-pixel-height) -(define-compatible-function-alias 'x-display-planes 'device-bitplanes) -(define-compatible-function-alias 'x-display-color-cells 'device-color-cells) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; events - -(define-obsolete-function-alias 'menu-event-p 'misc-user-event-p) -(make-obsolete-variable 'unread-command-char 'unread-command-events) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; extents - -(make-obsolete 'set-window-dot 'set-window-point) - -(define-obsolete-function-alias 'extent-buffer 'extent-object) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; frames -(defun frame-first-window (frame) - "Return the topmost, leftmost window of FRAME. -If omitted, FRAME defaults to the currently selected frame." - (frame-highest-window frame 0)) -(make-compatible 'frame-first-window 'frame-highest-window) - -(define-obsolete-variable-alias 'initial-frame-alist 'initial-frame-plist) -(define-obsolete-variable-alias 'minibuffer-frame-alist - 'minibuffer-frame-plist) -(define-obsolete-variable-alias 'pop-up-frame-alist 'pop-up-frame-plist) -(define-obsolete-variable-alias 'special-display-frame-alist - 'special-display-frame-plist) - -;; Defined in C. - -(define-obsolete-variable-alias 'default-frame-alist 'default-frame-plist) -(define-obsolete-variable-alias 'default-x-frame-alist 'default-x-frame-plist) -(define-obsolete-variable-alias 'default-tty-frame-alist - 'default-tty-frame-plist) - -(make-compatible 'frame-parameters 'frame-property) -(defun frame-parameters (&optional frame) - "Return the parameters-alist of frame FRAME. -It is a list of elements of the form (PARM . VALUE), where PARM is a symbol. -The meaningful PARMs depend on the kind of frame. -If FRAME is omitted, return information on the currently selected frame. - -See the variables `default-frame-plist', `default-x-frame-plist', and -`default-tty-frame-plist' for a description of the parameters meaningful -for particular types of frames." - (or frame (setq frame (selected-frame))) - ;; #### This relies on a `copy-sequence' of the user properties in - ;; `frame-properties'. Removing that would make `frame-properties' more - ;; efficient but this function less efficient, as we couldn't be - ;; destructive. Since most callers now use `frame-parameters', we'll - ;; do it this way. Should probably change this at some point in the - ;; future. - (destructive-plist-to-alist (frame-properties frame))) - -(make-compatible 'modify-frame-parameters 'set-frame-properties) -(defun modify-frame-parameters (frame alist) - "Modify the properties of frame FRAME according to ALIST. -ALIST is an alist of properties to change and their new values. -Each element of ALIST has the form (PARM . VALUE), where PARM is a symbol. -The meaningful PARMs depend on the kind of frame. - -See `set-frame-properties' for built-in property names." - ;; it would be nice to be destructive here but that's not safe. - (set-frame-properties frame (alist-to-plist alist))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; faces - -(define-obsolete-function-alias 'list-faces-display 'edit-faces) -(define-obsolete-function-alias 'list-faces 'face-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; paths - -(defvar Info-default-directory-list nil - "This used to be the initial value of Info-directory-list. -If you want to change the locations where XEmacs looks for info files, -set Info-directory-list.") -(make-obsolete-variable 'Info-default-directory-list 'Info-directory-list) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; hooks - -(make-compatible-variable 'lisp-indent-hook 'lisp-indent-function) -(make-compatible-variable 'comment-indent-hook 'comment-indent-function) -(make-obsolete-variable 'temp-buffer-show-hook - 'temp-buffer-show-function) -(make-obsolete-variable 'inhibit-local-variables - "use `enable-local-variables' (with the reversed sense).") -(make-obsolete-variable 'suspend-hooks 'suspend-hook) -(make-obsolete-variable 'first-change-function 'first-change-hook) -(make-obsolete-variable 'before-change-function - "use before-change-functions; which is a list of functions rather than a single function.") -(make-obsolete-variable 'after-change-function - "use after-change-functions; which is a list of functions rather than a single function.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; insertion and deletion - -(define-compatible-function-alias 'insert-and-inherit 'insert) -(define-compatible-function-alias 'insert-before-markers-and-inherit - 'insert-before-markers) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; keymaps - -(defun keymap-parent (keymap) - "Return the first parent of the given keymap." - (car (keymap-parents keymap))) -(make-compatible 'keymap-parent 'keymap-parents) - -(defun set-keymap-parent (keymap parent) - "Make the given keymap have (only) the given parent." - (set-keymap-parents keymap (if parent (list parent) '())) - parent) -(make-compatible 'set-keymap-parent 'set-keymap-parents) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; menu stuff - -(defun add-menu-item (menu-path item-name function enabled-p &optional before) - "Obsolete. See the function `add-menu-button'." - (or item-name (error "must specify an item name")) - (add-menu-button menu-path (vector item-name function enabled-p) before)) -(make-obsolete 'add-menu-item 'add-menu-button) - -(defun add-menu (menu-path menu-name menu-items &optional before) - "See the function `add-submenu'." - (or menu-name (error (gettext "must specify a menu name"))) - (or menu-items (error (gettext "must specify some menu items"))) - (add-submenu menu-path (cons menu-name menu-items) before)) -;; Can't make this obsolete. easymenu depends on it. -(make-compatible 'add-menu 'add-submenu) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; minibuffer - -(define-compatible-function-alias 'read-minibuffer - 'read-expression) ; misleading name -(define-compatible-function-alias 'read-input 'read-string) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; misc - -;; (defun user-original-login-name () -;; "Return user's login name from original login. -;; This tries to remain unaffected by `su', by looking in environment variables." -;; (or (getenv "LOGNAME") (getenv "USER") (user-login-name))) -(define-obsolete-function-alias 'user-original-login-name 'user-login-name) - -; old names -(define-obsolete-function-alias 'show-buffer 'set-window-buffer) -(define-obsolete-function-alias 'buffer-flush-undo 'buffer-disable-undo) -(make-compatible 'eval-current-buffer 'eval-buffer) -(define-compatible-function-alias 'byte-code-function-p - 'compiled-function-p) ;FSFmacs - -;; too bad there's not a way to check for aref, assq, and nconc -;; being called on the values of functions known to return keymaps, -;; or known to return vectors of events instead of strings... - -(make-obsolete-variable 'executing-macro 'executing-kbd-macro) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; modeline - -(define-compatible-function-alias 'redraw-mode-line 'redraw-modeline) -(define-compatible-function-alias 'force-mode-line-update - 'redraw-modeline) ;; FSF compatibility -(define-compatible-variable-alias 'mode-line-map 'modeline-map) -(define-compatible-variable-alias 'mode-line-buffer-identification - 'modeline-buffer-identification) -(define-compatible-variable-alias 'mode-line-process 'modeline-process) -(define-compatible-variable-alias 'mode-line-modified 'modeline-modified) -(make-compatible-variable 'mode-line-inverse-video - "use set-face-highlight-p and set-face-reverse-p") -(define-compatible-variable-alias 'default-mode-line-format - 'default-modeline-format) -(define-compatible-variable-alias 'mode-line-format 'modeline-format) -(define-compatible-variable-alias 'mode-line-menu 'modeline-menu) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; mouse - -;;; (defun mouse-eval-last-sexpr (event) -;;; (interactive "@e") -;;; (save-excursion -;;; (mouse-set-point event) -;;; (eval-last-sexp nil))) - -(define-obsolete-function-alias 'mouse-eval-last-sexpr 'mouse-eval-sexp) - -(defun read-mouse-position (frame) - (cdr (mouse-position (frame-device frame)))) -(make-obsolete 'read-mouse-position 'mouse-position) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; redisplay - -(defun redraw-display (&optional device) - (if (eq device t) - (mapcar 'redisplay-device (device-list)) - (redisplay-device device))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; window-system objects - -;; the functionality of column.el has been moved into C -;; Function obsoleted for XEmacs 20.0/February 1997. -(defalias 'display-column-mode 'column-number-mode) - -(defun x-color-values (color &optional frame) - "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is (65280 65280 65280) or (65535 65535 65535). -If FRAME is omitted or nil, use the selected frame." - (color-instance-rgb-components (make-color-instance color))) -(make-compatible 'x-color-values 'color-instance-rgb-components) - -;; Two loser functions which shouldn't be used. -(make-obsolete 'following-char 'char-after) -(make-obsolete 'preceding-char 'char-before) - - -;; The following several functions are useful in GNU Emacs 20 because -;; of the multibyte "characters" the internal representation of which -;; leaks into Lisp. In XEmacs/Mule they are trivial and unnecessary. -;; We provide them for compatibility reasons solely. - -(defun string-to-sequence (string type) - "Convert STRING to a sequence of TYPE which contains characters in STRING. -TYPE should be `list' or `vector'. -Multibyte characters are concerned." - (ecase type - (list - (mapcar #'identity string)) - (vector - (mapvector #'identity string)))) - -(defun string-to-list (string) - "Return a list of characters in STRING." - (mapcar #'identity string)) - -(defun string-to-vector (string) - "Return a vector of characters in STRING." - (mapvector #'identity string)) - -(defun store-substring (string idx obj) - "Embed OBJ (string or character) at index IDX of STRING." - (let* ((str (cond ((stringp obj) obj) - ((characterp obj) (char-to-string obj)) - (t (error - "Invalid argument (should be string or character): %s" - obj)))) - (string-len (length string)) - (len (length str)) - (i 0)) - (while (and (< i len) (< idx string-len)) - (aset string idx (aref str i)) - (setq idx (1+ idx) i (1+ i))) - string)) - -;; ### This function is not compatible with FSF in some cases. Hard -;; to fix, because it is hard to trace the logic of the FSF function. -;; In case we need the exact behavior, we can always copy the FSF -;; version, which is very long and does lots of unnecessary stuff. -(defun truncate-string-to-width (str end-column &optional start-column padding) - "Truncate string STR to end at column END-COLUMN. -The optional 2nd arg START-COLUMN, if non-nil, specifies -the starting column; that means to return the characters occupying -columns START-COLUMN ... END-COLUMN of STR. - -The optional 3rd arg PADDING, if non-nil, specifies a padding character -to add at the end of the result if STR doesn't reach column END-COLUMN, -or if END-COLUMN comes in the middle of a character in STR. -PADDING is also added at the beginning of the result -if column START-COLUMN appears in the middle of a character in STR. - -If PADDING is nil, no padding is added in these cases, so -the resulting string may be narrower than END-COLUMN." - (or start-column - (setq start-column 0)) - (let ((len (length str))) - (concat (substring str (min start-column len) (min end-column len)) - (and padding (> end-column len) - (make-string (- end-column len) padding))))) - -(defalias 'truncate-string 'truncate-string-to-width) -(make-obsolete 'truncate-string 'truncate-string-to-width) - -;; Keywords already do The Right Thing in XEmacs -(make-compatible 'define-widget-keywords "Just use them") - -(make-obsolete 'function-called-at-point 'function-at-point) - -(provide 'obsolete) -;;; obsolete.el ends here diff --git a/lisp/package-admin.el b/lisp/package-admin.el deleted file mode 100644 index d5603ec..0000000 --- a/lisp/package-admin.el +++ /dev/null @@ -1,507 +0,0 @@ -;;; package-admin.el --- Installation and Maintenance of XEmacs packages - -;; Copyright (C) 1997 by Free Software Foundation, Inc. - -;; Author: SL Baur -;; 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 in FSF - -;;; Commentary: - -;; First pass at lisp front end to package maintenance. - -;;; Code: - -(require 'config) - -(defvar package-admin-xemacs (concat invocation-directory invocation-name) - "Location of XEmacs binary to use.") - -(defvar package-admin-temp-buffer "*Package Output*" - "Temporary buffer where output of backend commands is saved.") - -(defvar package-admin-install-function (if (eq system-type 'windows-nt) - 'package-admin-install-function-mswindows - 'package-admin-default-install-function) - "The function to call to install a package. -Three args are passed: FILENAME PKG-DIR BUF -Install package FILENAME into directory PKG-DIR, with any messages output -to buffer BUF.") - -(defvar package-admin-error-messages '( - "No space left on device" - "No such file or directory" - "Filename too long" - "Read-only file system" - "File too large" - "Too many open files" - "Not enough space" - "Permission denied" - "Input/output error" - "Out of memory" - "Unable to create directory" - "Directory checksum error" - "Cannot exclusively open file" - "corrupted file" - "incomplete .* tree" - "Bad table" - "corrupt input" - "invalid compressed data" - "too many leaves in Huffman tree" - "not a valid zip file" - "first entry not deflated or stored" - "encrypted file --" - "unexpected end of file" - ) - "Regular expressions of possible error messages. -After each package extraction, the `package-admin-temp-buffer' buffer is -scanned for these messages. An error code is returned if one of these are -found. - -This is awful, but it exists because error return codes aren't reliable -under MS Windows.") - -(defvar package-admin-tar-filename-regexps - '( - ;; GNU tar: - ;; drwxrwxr-x john/doe 123 1997-02-18 15:48 pathname - "\\S-+\\s-+[-a-z0-9_/]+\\s-+[0-9]+\\s-+[-0-9]+\\s-+[0-9:]+\\s-+\\(\\S-.*\\)" - ;; HP-UX & SunOS tar: - ;; rwxrwxr-x 501/501 123 Feb 18 15:46 1997 pathname - ;; Solaris tar (phooey!): - ;; rwxrwxr-x501/501 123 Feb 18 15:46 1997 pathname - ;; AIX tar: - ;; -rw-r--r-- 147 1019 32919 Mar 26 12:00:09 1992 pathname - "\\S-+\\s-*[-a-z0-9_]+[/ ][-a-z0-9_]+\\s-+[0-9]+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)" - - ;; djtar: - ;; drwx Aug 31 02:01:41 1998 123 pathname - "\\S-+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)" - - ) - "List of regexps to use to search for tar filenames. -Note that \"\\(\" and \"\\)\" must be used to delimit the pathname (as -match #1). Don't put \"^\" to match the beginning of the line; this -is already implicit, as `looking-at' is used. Filenames can, -unfortunately, contain spaces, so be careful in constructing any -regexps.") - -;;;###autoload -(defun package-admin-add-single-file-package (file destdir &optional pkg-dir) - "Install a single file Lisp package into XEmacs package hierarchy. -`file' should be the full path to the lisp file to install. -`destdir' should be a simple directory name. -The optional `pkg-dir' can be used to override the default package hierarchy -\(car \(last late-packages))." - (interactive "fLisp File: \nsDestination: ") - (when (null pkg-dir) - (setq pkg-dir (car (last late-packages)))) - (let ((destination (concat pkg-dir "/lisp/" destdir)) - (buf (get-buffer-create package-admin-temp-buffer))) - (call-process "add-little-package.sh" - nil - buf - t - ;; rest of command line follows - package-admin-xemacs file destination))) - -(defun package-admin-install-function-mswindows (file pkg-dir buf) - "Install function for mswindows" - (let ((default-directory (file-name-as-directory pkg-dir))) - (unless (file-directory-p default-directory) - (make-directory default-directory t)) - (call-process "minitar" nil buf t file))) - -(defun package-admin-default-install-function (file pkg-dir buf) - "Default function to install a package. -Install package FILENAME into directory PKG-DIR, with any messages output -to buffer BUF." - (let* ((pkg-dir (file-name-as-directory pkg-dir)) - (default-directory pkg-dir) - (filename (expand-file-name file))) - (unless (file-directory-p pkg-dir) - (make-directory pkg-dir t)) - ;; Don't assume GNU tar. - (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf) - 0 - 1) - )) - -; (call-process "add-big-package.sh" -; nil -; buf -; t -; ;; rest of command line follows -; package-admin-xemacs file pkg-dir)) - -(defun package-admin-get-install-dir (package pkg-dir &optional mule-related) - "If PKG-DIR is non-nil return that, -else return the current location of the package if it is already installed -or return a location appropriate for the package otherwise." - (if pkg-dir - pkg-dir - (let ((package-feature (intern-soft (concat - (symbol-name package) "-autoloads"))) - autoload-dir) - (when (and (not (eq package 'unknown)) - (featurep package-feature) - (setq autoload-dir (feature-file package-feature)) - (setq autoload-dir (file-name-directory autoload-dir)) - (member autoload-dir late-package-load-path)) - ;; Find the corresonding entry in late-package - (setq pkg-dir - (car-safe (member-if (lambda (h) - (string-match (concat "^" (regexp-quote h)) - autoload-dir)) - late-packages)))) - (if pkg-dir - pkg-dir - ;; Ok we need to guess - (if mule-related - (package-admin-get-install-dir 'mule-base nil nil) - (if (eq package 'xemacs-base) - (car (last late-packages)) - (package-admin-get-install-dir 'xemacs-base nil nil))))))) - - - -(defun package-admin-get-manifest-file (pkg-topdir package) - "Return the name of the MANIFEST file for package PACKAGE. -Note that PACKAGE is a symbol, and not a string." - (let (dir) - (setq dir (expand-file-name "pkginfo" pkg-topdir)) - (expand-file-name (concat "MANIFEST." (symbol-name package)) dir) - )) - -(defun package-admin-check-manifest (pkg-outbuf pkg-topdir) - "Check for a MANIFEST. file in the package distribution. -If it doesn't exist, create and write one. -PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR -is the top-level directory under which the package was installed." - (let ( (manifest-buf " *pkg-manifest*") - old-case-fold-search regexp package-name pathname regexps) - ;; Save and restore the case-fold-search status. - ;; We do this in case we have to screw with it (as it the case of - ;; case-insensitive filesystems such as MS Windows). - (setq old-case-fold-search case-fold-search) - (unwind-protect - (save-excursion ;; Probably redundant. - (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the - ;; current buffer. - (goto-char (point-min)) - - ;; Make filenames case-insensitive, if necessary - (if (eq system-type 'windows-nt) - (setq case-fold-search t)) - - ;; We really should compute the regexp. - ;; However, directory-sep-char is currently broken, but we need - ;; functional code *NOW*. - (setq regexp "\\bpkginfo[\\/]MANIFEST\\...*") - - ;; Look for the manifest. - (if (not (re-search-forward regexp nil t)) - (progn - ;; We didn't find a manifest. Make one. - - ;; Yuk. We weren't passed the package name, and so we have - ;; to dig for it. Look for it as the subdirectory name below - ;; "lisp", "man", "info", or "etc". - ;; Here, we don't use a single regexp because we want to search - ;; the directories for a package name in a particular order. - ;; The problem is that packages could have directories like - ;; "etc/sounds/" or "etc/photos/" and we don't want to get - ;; these confused with the actual package name (although, in - ;; the case of "etc/sounds/", it's probably correct). - (if (catch 'done - (let ( (dirs '("lisp" "info" "man" "etc")) rexp) - (while dirs - (setq rexp (concat "\\b" (car dirs) - "[\\/]\\([^\\/]+\\)[\//]")) - (if (re-search-forward rexp nil t) - (throw 'done t)) - (setq dirs (cdr dirs)) - ))) - (progn - (setq package-name (buffer-substring (match-beginning 1) - (match-end 1))) - - ;; Get and erase the manifest buffer - (setq manifest-buf (get-buffer-create manifest-buf)) - (buffer-disable-undo manifest-buf) - (erase-buffer manifest-buf) - - ;; Now, scan through the output buffer, looking for - ;; file and directory names. - (goto-char (point-min)) - ;; for each line ... - (while (< (point) (point-max)) - (beginning-of-line) - (setq pathname nil) - - ;; scan through the regexps, looking for a pathname - (if (catch 'found-path - (setq regexps package-admin-tar-filename-regexps) - (while regexps - (if (looking-at (car regexps)) - (progn - (setq pathname - (buffer-substring - (match-beginning 1) - (match-end 1))) - (throw 'found-path t) - )) - (setq regexps (cdr regexps)) - ) - ) - (progn - ;; found a pathname -- add it to the manifest - ;; buffer - (save-excursion - (set-buffer manifest-buf) - (goto-char (point-max)) - (insert pathname "\n") - ) - )) - (forward-line 1) - ) - - ;; Processed all lines. - ;; Now, create the file, pkginfo/MANIFEST. - - ;; We use `expand-file-name' instead of `concat', - ;; for portability. - (setq pathname (expand-file-name "pkginfo" - pkg-topdir)) - ;; Create pkginfo, if necessary - (if (not (file-directory-p pathname)) - (make-directory pathname)) - (setq pathname (expand-file-name - (concat "MANIFEST." package-name) - pathname)) - (save-excursion - (set-buffer manifest-buf) - ;; Put the files in sorted order - (sort-lines nil (point-min) (point-max)) - ;; Write the file. - ;; Note that using `write-region' *BYPASSES* any check - ;; to see if XEmacs is currently editing/visiting the - ;; file. - (write-region (point-min) (point-max) pathname) - ) - (kill-buffer manifest-buf) - ) - (progn - ;; We can't determine the package name from an extracted - ;; file in the tar output buffer. - )) - )) - ) - ;; Restore old case-fold-search status - (setq case-fold-search old-case-fold-search)) - )) - -;;;###autoload -(defun package-admin-add-binary-package (file &optional pkg-dir) - "Install a pre-bytecompiled XEmacs package into package hierarchy." - (interactive "fPackage tarball: ") - (let ((buf (get-buffer-create package-admin-temp-buffer)) - (status 1) - start err-list - ) - (setq pkg-dir (package-admin-get-install-dir 'unknown pkg-dir)) - ;; Ensure that the current directory doesn't change - (save-excursion - (set-buffer buf) - ;; This is not really needed - (setq default-directory (file-name-as-directory pkg-dir)) - (setq case-fold-search t) - (buffer-disable-undo) - (goto-char (setq start (point-max))) - (if (= 0 (setq status (funcall package-admin-install-function - file pkg-dir buf))) - (progn - ;; First, check for errors. - ;; We can't necessarily rely upon process error codes. - (catch 'done - (goto-char start) - (setq err-list package-admin-error-messages) - (while err-list - (if (re-search-forward (car err-list) nil t) - (progn - (setq status 1) - (throw 'done nil) - )) - (setq err-list (cdr err-list)) - ) - ) - ;; Make sure that the MANIFEST file exists - (package-admin-check-manifest buf pkg-dir) - )) - ) - status - )) - -(defun package-admin-rmtree (directory) - "Delete a directory and all of its contents, recursively. -This is a feeble attempt at making a portable rmdir." - (setq directory (file-name-as-directory directory)) - (let ((files (directory-files directory nil nil nil t)) - (dirs (directory-files directory nil nil nil 'dirs))) - (while dirs - (if (not (member (car dirs) '("." ".."))) - (let ((dir (expand-file-name (car dirs) directory))) - (condition-case err - (if (file-symlink-p dir) ;; just in case, handle symlinks - (delete-file dir) - (package-admin-rmtree dir)) - (file-error - (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err))))) - (setq dirs (cdr dirs)))) - (while files - (condition-case err - (delete-file (expand-file-name (car files) directory)) - (file-error - (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))) - (setq files (cdr files))) - (condition-case err - (delete-directory directory) - (file-error - (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))))) - -(defun package-admin-get-lispdir (pkg-topdir package) - (let (package-lispdir) - (if (and (setq package-lispdir (expand-file-name "lisp" pkg-topdir)) - (setq package-lispdir (expand-file-name (symbol-name package) - package-lispdir)) - (file-accessible-directory-p package-lispdir)) - package-lispdir) - )) - -(defun package-admin-delete-binary-package (package pkg-topdir) - "Delete a binary installation of PACKAGE below directory PKG-TOPDIR. -PACKAGE is a symbol, not a string." - (let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file) - (setq pkg-topdir (package-admin-get-install-dir package pkg-topdir)) - (setq manifest-file (package-admin-get-manifest-file pkg-topdir package)) - (if (file-exists-p manifest-file) - (progn - ;; The manifest file exists! Use it to delete the old distribution. - (message "Removing old files for package \"%s\" ..." package) - (sit-for 0) - (setq tmpbuf (get-buffer-create tmpbuf)) - (with-current-buffer tmpbuf - (buffer-disable-undo) - (erase-buffer) - (insert-file-contents manifest-file) - (goto-char (point-min)) - - ;; For each entry in the MANIFEST ... - (while (< (point) (point-max)) - (beginning-of-line) - (setq file (expand-file-name (buffer-substring - (point) - (point-at-eol)) - pkg-topdir)) - (if (file-directory-p file) - ;; Keep a record of each directory - (setq dirs (cons file dirs)) - ;; Delete each file. - ;; Make sure that the file is writable. - ;; (This is important under MS Windows.) - ;; I do not know why it important under MS Windows but - ;; 1. It bombs out out when the file does not exist. This can be condition-cased - ;; 2. If I removed the write permissions, I do not want XEmacs to just ignore them. - ;; If it wants to, XEmacs may ask, but that is about all - ;; (set-file-modes file 438) ;; 438 -> #o666 - ;; Note, user might have removed the file! - (condition-case () - (delete-file file) - (error nil))) ;; We may want to turn the error into a Warning? - (forward-line 1)) - - ;; Delete empty directories. - (if dirs - (let ( (orig-default-directory default-directory) - directory files file ) - ;; Make sure we preserve the existing `default-directory'. - ;; JV, why does this change the default directory? Does it indeed? - (unwind-protect - (progn - ;; Warning: destructive sort! - (setq dirs (nreverse (sort dirs 'string<))) -; ;; For each directory ... -; (while dirs -; (setq directory (file-name-as-directory (car dirs))) -; (setq files (directory-files directory)) -; ;; Delete the directory if it's empty. -; (if (catch 'done -; (while files -; (setq file (car files)) -; (if (and (not (string= file ".")) -; (not (string= file ".."))) -; (throw 'done nil)) -; (setq files (cdr files)) -; ) -; t) -; ( -; (delete-directory directory)) -; (setq dirs (cdr dirs)) -; ) - ;; JV, On all OS's that I know of delete-directory fails on - ;; on non-empty dirs anyway - (mapc - (lambda (dir) - (condition-case () - (delete-directory dir))) - dirs)) - (setq default-directory orig-default-directory) - ))) - ) - (kill-buffer tmpbuf) - ;; Delete the MANIFEST file - ;; (set-file-modes manifest-file 438) ;; 438 -> #o666 - ;; Note. Packages can have MANIFEST in MANIFEST. - (condition-case () - (delete-file manifest-file) - (error nil)) ;; Do warning? - (message "Removing old files for package \"%s\" ... done" package)) - ;; The manifest file doesn't exist. Fallback to just deleting the - ;; package-specific lisp directory, if it exists. - ;; - ;; Delete old lisp directory, if any - ;; Gads, this is ugly. However, we're not supposed to use `concat' - ;; in the name of portability. - (when (setq package-lispdir (package-admin-get-lispdir pkg-topdir - package)) - (message "Removing old lisp directory \"%s\" ..." - package-lispdir) - (sit-for 0) - (package-admin-rmtree package-lispdir) - (message "Removing old lisp directory \"%s\" ... done" - package-lispdir) - )) - ;; Delete the package from the database of installed packages. - (package-delete-name package))) - -(provide 'package-admin) - -;;; package-admin.el ends here diff --git a/lisp/package-get.el b/lisp/package-get.el deleted file mode 100644 index 149f531..0000000 --- a/lisp/package-get.el +++ /dev/null @@ -1,1057 +0,0 @@ -;;; package-get.el --- Retrieve XEmacs package - -;; Copyright (C) 1998 by Pete Ware - -;; Author: Pete Ware -;; Heavy-Modifications: Greg Klanderman -;; Jan Vroonhof -;; 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 in FSF - -;;; Commentary: - -;; package-get - -;; Retrieve a package and any other required packages from an archive -;; -;; -;; Note (JV): Most of this no longer aplies! -;; -;; The idea: -;; A new XEmacs lisp-only release is generated with the following steps: -;; 1. The maintainer runs some yet to be written program that -;; generates all the dependency information. This should -;; determine all the require and provide statements and associate -;; them with a package. -;; 2. All the packages are then bundled into their own tar balls -;; (or whatever format) -;; 3. Maintainer automatically generates a new `package-get-base' -;; data structure which contains information such as the -;; package name, the file to be retrieved, an md5 checksum, -;; etc (see `package-get-base'). -;; 4. The maintainer posts an announcement with the new version -;; of `package-get-base'. -;; 5. A user/system manager saves this posting and runs -;; `package-get-update' which uses the previously saved list -;; of packages, `package-get-here' that the user/site -;; wants to determine what new versions to download and -;; install. -;; -;; A user/site manager can generate a new `package-get-here' structure -;; by using `package-get-setup' which generates a customize like -;; interface to the list of packages. The buffer looks something -;; like: -;; -;; gnus - a mail and news reader -;; [] Always install -;; [] Needs updating -;; [] Required by other [packages] -;; version: 2.0 -;; -;; vm - a mail reader -;; [] Always install -;; [] Needs updating -;; [] Required by other [packages] -;; -;; Where `[]' indicates a toggle box -;; -;; - Clicking on "Always install" puts this into -;; `package-get-here' list. "Needs updating" indicates a new -;; version is available. Anything already in -;; `package-get-here' has this enabled. -;; - "Required by other" means some other packages are going to force -;; this to be installed. Clicking on [packages] gives a list -;; of packages that require this. -;; -;; The `package-get-base' should be installed in a file in -;; `data-directory'. The `package-get-here' should be installed in -;; site-lisp. Both are then read at run time. -;; -;; TODO: -;; - Implement `package-get-setup' -;; - Actually put `package-get-base' and `package-get-here' into -;; files that are read. -;; - Allow users to have their own packages that they want installed -;; in ~/.xemacs/. -;; - SOMEONE needs to write the programs that generate the -;; provides/requires database and makes it into a lisp data -;; structure suitable for `package-get-base' -;; - Handle errors such as no package providing a required symbol. -;; - Tie this into the `require' function to download packages -;; transparently. - -;;; Change Log - -;;; Code: - -(require 'package-admin) -;; (require 'package-get-base) - -(defgroup package-tools nil - "Tools to manipulate packages." - :group 'emacs) - -(defgroup package-get nil - "Automatic Package Fetcher and Installer." - :prefix "package-get" - :group 'package-tools) - -(defvar package-get-base nil - "List of packages that are installed at this site. -For each element in the alist, car is the package name and the cdr is -a plist containing information about the package. Typical fields -kept in the plist are: - -version - version of this package -provides - list of symbols provided -requires - list of symbols that are required. - These in turn are provided by other packages. -filename - name of the file. -size - size of the file (aka the bundled package) -md5sum - computed md5 checksum -description - What this package is for. -type - Whether this is a 'binary (default) or 'single file package - -More fields may be added as needed. An example: - -'( - (name - (version \"\" - file \"filename\" - description \"what this package is about.\" - provides () - requires () - size - md5sum \"\" - file \"filename\" - description \"what this package is about.\" - provides () - requires () - size - md5sum \" (if (stringp installed) - (string-to-number installed) - installed) - (if (stringp latest) - (string-to-number latest) - latest)) - (if (not (null version)) - (warn "Installing %s package version %s, you had a newer version %s" - package latest installed) - (warn "Skipping %s package, you have a newer version %s" - package installed) - (throw 'skip-update t)))) - - ;; Contrive a list of possible package filenames. - ;; Ugly. Is there a better way to do this? - (setq filenames (cons base-filename nil)) - (if (string-match "^\\(..*\\)\.tar\.gz$" base-filename) - (setq filenames (append filenames - (list (concat (match-string 1 base-filename) - ".tgz"))))) - - (setq version latest) - (unless (and (eq conflict 'never) - (package-get-installedp package version)) - ;; Find the package from the search list in package-get-remote - ;; and copy it into the staging directory. Then validate - ;; the checksum. Finally, install the package. - (catch 'done - (let (search-filenames current-dir-entry host dir current-filename - dest-filename) - ;; In each search directory ... - (while search-dirs - (setq current-dir-entry (car search-dirs) - host (car current-dir-entry) - dir (car (cdr current-dir-entry)) - search-filenames filenames - ) - - ;; Look for one of the possible package filenames ... - (while search-filenames - (setq current-filename (car search-filenames) - dest-filename (package-get-staging-dir current-filename)) - (cond - ;; No host means look on the current system. - ( (null host) - (setq full-package-filename - (substitute-in-file-name - (expand-file-name current-filename - (file-name-as-directory dir)))) - ) - - ;; If it's already on the disk locally, and the size is - ;; greater than zero ... - ( (and (file-exists-p dest-filename) - (let (attrs) - ;; file-attributes could return -1 for LARGE files, - ;; but, hopefully, packages won't be that large. - (and (setq attrs (file-attributes dest-filename)) - (> (nth 7 attrs) 0)))) - (setq full-package-filename dest-filename) - ) - - ;; If the file exists on the remote system ... - ( (file-exists-p (package-get-remote-filename - current-dir-entry current-filename)) - ;; Get it - (setq full-package-filename dest-filename) - (message "Retrieving package `%s' ..." - current-filename) - (sit-for 0) - (copy-file (package-get-remote-filename current-dir-entry - current-filename) - full-package-filename t) - ) - ) - - ;; If we found it, we're done. - (if (and full-package-filename - (file-exists-p full-package-filename)) - (throw 'done nil)) - ;; Didn't find it. Try the next possible filename. - (setq search-filenames (cdr search-filenames)) - ) - ;; Try looking in the next possible directory ... - (setq search-dirs (cdr search-dirs)) - ) - )) - - (if (or (not full-package-filename) - (not (file-exists-p full-package-filename))) - (if package-get-remote - (error "Unable to find file %s" base-filename) - (error - "No download sites or local package locations specified."))) - ;; Validate the md5 checksum - ;; Doing it with XEmacs removes the need for an external md5 program - (message "Validating checksum for `%s'..." package) (sit-for 0) - (with-temp-buffer - ;; What ever happened to i-f-c-literally - (let (file-name-handler-alist) - (insert-file-contents-internal full-package-filename)) - (if (not (string= (md5 (current-buffer)) - (package-get-info-prop this-package - 'md5sum))) - (error "Package %s does not match md5 checksum" base-filename))) - - (package-admin-delete-binary-package package install-dir) - - (message "Installing package `%s' ..." package) (sit-for 0) - (let ((status - (package-admin-add-binary-package full-package-filename - install-dir))) - (if (= status 0) - (progn - ;; clear messages so that only messages from - ;; package-get-init-package are seen, below. - (clear-message) - (if (package-get-init-package (package-admin-get-lispdir - install-dir package)) - (progn - (message "Added package `%s'" package) - (sit-for 0) - ) - (progn - ;; display message only if there isn't already one. - (if (not (current-message)) - (progn - (message "Added package `%s' (errors occurred)" - package) - (sit-for 0) - )) - (if package-status - (setq package-status 'errors)) - )) - ) - (message "Installation of package %s failed." base-filename) - (sit-for 0) - (switch-to-buffer package-admin-temp-buffer) - (setq package-status nil) - )) - (setq found t)) - (if (and found package-get-remove-copy) - (delete-file full-package-filename)) - package-status - ))) - -(defun package-get-info-find-package (which name) - "Look in WHICH for the package called NAME and return all the info -associated with it. See `package-get-base' for info on the format -returned. - - To access fields returned from this, use -`package-get-info-version' to return information about particular a -version. Use `package-get-info-find-prop' to find particular property -from a version returned by `package-get-info-version'." - (interactive "xPackage list: \nsPackage Name: ") - (if which - (if (eq (caar which) name) - (cdar which) - (if (cdr which) - (package-get-info-find-package (cdr which) name))))) - -(defun package-get-info-version (package version) - "In PACKAGE, return the plist associated with a particular VERSION of the - package. PACKAGE is typically as returned by - `package-get-info-find-package'. If VERSION is nil, then return the - first (aka most recent) version. Use `package-get-info-find-prop' - to retrieve a particular property from the value returned by this." - (interactive (package-get-interactive-package-query t t)) - (while (and version package (not (string= (plist-get (car package) 'version) version))) - (setq package (cdr package))) - (if package (car package))) - -(defun package-get-info-prop (package-version property) - "In PACKAGE-VERSION, return the value associated with PROPERTY. -PACKAGE-VERSION is typically returned by `package-get-info-version' -and PROPERTY is typically (although not limited to) one of the -following: - -version - version of this package -provides - list of symbols provided -requires - list of symbols that are required. - These in turn are provided by other packages. -size - size of the bundled package -md5sum - computed md5 checksum" - (interactive "xPackage Version: \nSProperty") - (plist-get package-version property)) - -(defun package-get-info-version-prop (package-list package version property) - "In PACKAGE-LIST, search for PACKAGE with this VERSION and return - PROPERTY value." - (package-get-info-prop - (package-get-info-version - (package-get-info-find-package package-list package) version) property)) - -(defun package-get-set-version-prop (package-list package version - property value) - "A utility to make it easier to add a VALUE for a specific PROPERTY - in this VERSION of a specific PACKAGE kept in the PACKAGE-LIST. -Returns the modified PACKAGE-LIST. Any missing fields are created." - ) - -(defun package-get-staging-dir (filename) - "Return a good place to stash FILENAME when it is retrieved. -Use `package-get-dir' for directory to store stuff. -Creates `package-get-dir' it it doesn't exist." - (interactive "FPackage filename: ") - (if (not (file-exists-p package-get-dir)) - (make-directory package-get-dir)) - (expand-file-name - (file-name-nondirectory (or (and (fboundp 'efs-ftp-path) - (nth 2 (efs-ftp-path filename))) - filename)) - (file-name-as-directory package-get-dir))) - -(defun package-get-remote-filename (search filename) - "Return FILENAME as a remote filename. -It first checks if FILENAME already is a remote filename. If it is -not, then it uses the (car search) as the remote site-name and the (cadr -search) as the remote-directory and concatenates filename. In other -words - site-name:remote-directory/filename. - -If (car search) is nil, (cadr search is interpreted as a local directory). -" - (if (file-remote-p filename) - filename - (let ((dir (cadr search))) - (concat (when (car search) - (concat - (if (string-match "@" (car search)) - "/" - "/anonymous@") - (car search) ":")) - (if (string-match "/$" dir) - dir - (concat dir "/")) - filename)))) - - -(defun package-get-installedp (package version) - "Determine if PACKAGE with VERSION has already been installed. -I'm not sure if I want to do this by searching directories or checking -some built in variables. For now, use packages-package-list." - ;; Use packages-package-list which contains name and version - (equal (plist-get - (package-get-info-find-package packages-package-list - package) ':version) - (if (floatp version) version (string-to-number version)))) - -;;;###autoload -(defun package-get-package-provider (sym &optional force-current) - "Search for a package that provides SYM and return the name and - version. Searches in `package-get-base' for SYM. If SYM is a - consp, then it must match a corresponding (provide (SYM VERSION)) from - the package. - -If FORCE-CURRENT is non-nil make sure the database is up to date. This might -lead to Emacs accessing remote sites." - (interactive "SSymbol: ") - (package-get-require-base force-current) - (let ((packages package-get-base) - (done nil) - (found nil)) - (while (and (not done) packages) - (let* ((this-name (caar packages)) - (this-package (cdr (car packages)))) ;strip off package name - (while (and (not done) this-package) - (if (or (eq this-name sym) - (eq (cons this-name - (package-get-info-prop (car this-package) 'version)) - sym) - (member sym - (package-get-info-prop (car this-package) 'provides))) - (progn (setq done t) - (setq found - (list (caar packages) - (package-get-info-prop (car this-package) 'version)))) - (setq this-package (cdr this-package))))) - (setq packages (cdr packages))) - found)) - -;; -;; customize interfaces. -;; The group is in this file so that custom loads includes this file. -;; -(defgroup packages nil - "Configure XEmacs packages." - :group 'emacs) - -;;;###autoload -(defun package-get-custom () - "Fetch and install the latest versions of all customized packages." - (interactive) - (package-get-require-base t) - ;; Load a fresh copy - (load "package-get-custom.el") - (mapcar (lambda (pkg) - (if (eval (intern (concat (symbol-name (car pkg)) "-package"))) - (package-get (car pkg) nil)) - t) - package-get-base)) - -(defun package-get-ever-installed-p (pkg &optional notused) - (string-match "-package$" (symbol-name pkg)) - (custom-initialize-set - pkg - (if (package-get-info-find-package - packages-package-list - (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) - t))) - -(defvar package-get-custom-groups nil - "List of package-get-custom groups") - -(defun package-get-custom-add-entry (package props) - (let* ((category (plist-get props 'category)) - (group (intern (concat category "-packages"))) - (custom-var (intern (concat (symbol-name package) "-package"))) - (description (plist-get props 'description))) - (when (not (memq group package-get-custom-groups)) - (setq package-get-custom-groups (cons package - package-get-custom-groups)) - (eval `(defgroup ,group nil - ,(concat category " package group") - :group 'packages))) - (eval `(defcustom ,custom-var nil - ,description - :group ',group - :initialize 'package-get-ever-installed-p - :type 'boolean)))) - - -(provide 'package-get) -;;; package-get.el ends here diff --git a/lisp/package-info.el b/lisp/package-info.el deleted file mode 100644 index 4a9aa2c..0000000 --- a/lisp/package-info.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; package-info.el --- Generate information about an XEmacs package - -;; Copyright (C) 1998 by Free Software Foundation, Inc. - -;; Author: SL Baur -;; 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 in FSF - -;;; Commentary: - -;; This file is used for building package distributions. - -;;; Change Log: - -;;; Code: - -(defvar package-info "package-info" - "File used to write out Package info") - -(defvar package-info-template "package-info.in" - "Template file for package-get info.") - -;; Loses with Mule -;(defun pi-md5sum (file) -; (let (result) -; (with-temp-buffer -; (let ((buffer-file-coding-system-for-read 'binary)) -; (insert-file-contents-literally file)) -; ;; (write-file "/tmp/x.x") -; (setq result (md5 (current-buffer)))) -; result)) - -(defun pi-md5sum (file) - (with-temp-buffer - (call-process "md5sum" file t) - (goto-char (point-min)) - (looking-at "[a-z0-9]+") - (buffer-substring (match-beginning 0) (match-end 0)))) - -(defun pi-update-key (key value) - (save-excursion - (goto-char (point-min)) - (let ((case-fold-search nil)) - (when (search-forward key) - (replace-match value t))))) - -(defun pi-author-version (author-version) - (if (> (length author-version) 0) - (format "\"%s\"" author-version) - (format "\"%d.%d%s\"" emacs-major-version emacs-minor-version - (if (and (boundp 'xemacs-betaname) xemacs-betaname) - (progn - (string-match "[0-9]+" xemacs-betaname) - (concat "b" (match-string 0 xemacs-betaname))) - "")))) - -(defun pi-last-mod-date () - (condition-case nil - (save-excursion - (with-temp-buffer - (insert-file-contents-literally "ChangeLog") - (goto-char (point-min)) - (looking-at "[-0-9]+") - (format "\"%s\"" - (buffer-substring (match-beginning 0) - (match-end 0))))) - ;; Fallback on current date if no valid ChangeLog entry - (t (format-time-string "\"%Y-%m-%d\"")))) - -(defun batch-update-package-info () - "Generate a package-info file for use by package-get.el. -Parameters are: -version -- Package version number -filename -- Filename of tarball to generate info for. -requires -- Packages necessary for bytecompiling. -author-version -- The original Author's version #. -maintainer -- The package maintainer. -category -- The build category." - (unless noninteractive - (error "`batch-update-package-info' is to be used only with -batch")) - (let ((version (nth 0 command-line-args-left)) - (filename (nth 1 command-line-args-left)) - (requires (nth 2 command-line-args-left)) - (author-version (nth 3 command-line-args-left)) - (maintainer (nth 4 command-line-args-left)) - (category (nth 5 command-line-args-left))) - (unless requires - (setq requires "")) - (find-file package-info) - (erase-buffer) - (insert-file-contents-literally package-info-template) - (goto-char (point-min)) - (pi-update-key "VERSION" (format "\"%s\"" version)) - (pi-update-key "MD5SUM" (format "\"%s\"" - (pi-md5sum filename))) - (pi-update-key "FILENAME" (format "\"%s\"" - (file-name-nondirectory filename))) - (pi-update-key "SIZE" (format "%d" - (nth 7 (file-attributes filename)))) - (pi-update-key "REQUIRES" requires) - (pi-update-key "AUTHOR_VERSION" (pi-author-version author-version)) - (pi-update-key "MAINTAINER" (format "\"%s\"" maintainer)) - (pi-update-key "CATEGORY" (format "\"%s\"" category)) - (pi-update-key "BUILD_DATE" (format-time-string "\"%Y-%m-%d\"")) - (pi-update-key "DATE" (pi-last-mod-date)) - (save-buffers-kill-emacs 0))) - -(provide 'package-info) - -;;; package-info.el ends here diff --git a/lisp/package-ui.el b/lisp/package-ui.el deleted file mode 100644 index 7eb73bd..0000000 --- a/lisp/package-ui.el +++ /dev/null @@ -1,708 +0,0 @@ -;;; package-ui.el --- - -;; Copyright (C) 1998 by Darryl Okahata - -;; Author: Darryl Okahata -;; 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 in FSF - -(require 'package-get) ;; which, in turn, requires 'package-admin - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; User-changeable variables: -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defgroup pui nil - "Conventient interface to the package system." - :group 'package-tools - :tag "Package User interface" - :prefix "pui-") - -(defcustom pui-package-install-dest-dir nil - "*If non-nil (Automatic) path to package tree to install packages in. -Otherwise, use old path for installed packages and make a guess for -new ones." - :group 'pui - :tag "Install Location" - :type '(choice (const :tag "Automatic" nil) - (directory))) - -(defcustom pui-list-verbose t - "*If non-nil, display verbose info in the package list buffer." - :group 'pui - :tag "Verbose Listing" - :type 'boolean) - -(defcustom pui-up-to-date-package-face nil - "*The face to use for packages that are up-to-date." - :group 'pui - :type 'face) - -(defcustom pui-selected-package-face 'bold - "*The face to use for selected packages. -Set this to `nil' to use the `default' face." - :group 'pui - :type 'face) - -(defcustom pui-deleted-package-face 'blue - "*The face to use for packages marked for removal. -Set this to `nil' to use the `default' face." - :group 'pui - :type 'face) - -(defcustom pui-outdated-package-face 'red - "*The face to use for outdated packages. -Set this to `nil' to use the `default' face." - :group 'pui - :type 'face) - -(defcustom pui-uninstalled-package-face 'italic - "*The face to use for uninstalled packages. -Set this to `nil' to use the `default' face." - :group 'pui - :type 'face) - - - - -(defvar pui-info-buffer "*Packages*" - "Buffer to use for displaying package information.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; End of user-changeable variables. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar pui-selected-packages nil - "The list of user-selected packages to install.") - -(defvar pui-deleted-packages nil - "The list of user-selected packages to remove.") - -(defvar pui-actual-package "") - -(defvar pui-display-keymap - (let ((m (make-keymap))) - (suppress-keymap m) - (set-keymap-name m 'pui-display-keymap) - (define-key m "q" 'pui-quit) - (define-key m "g" 'pui-list-packages) - (define-key m "i" 'pui-display-info) - (define-key m "?" 'describe-mode) - (define-key m "v" 'pui-toggle-verbosity-redisplay) - (define-key m "d" 'pui-toggle-package-delete-key) - (define-key m "D" 'pui-toggle-package-delete-key) - (define-key m [return] 'pui-toggle-package-key) - (define-key m "x" 'pui-install-selected-packages) - (define-key m "I" 'pui-install-selected-packages) - (define-key m "r" 'pui-add-required-packages) - (define-key m "n" 'next-line) - (define-key m "+" 'pui-toggle-package-key) - (define-key m "p" 'previous-line) - (define-key m " " 'scroll-up-command) - (define-key m [delete] 'scroll-down-command) - m) - "Keymap to use in the `pui-info-buffer' buffer") - -(defvar pui-package-keymap - (let ((m (make-sparse-keymap))) - (set-keymap-name m 'pui-package-keymap) - (define-key m 'button2 'pui-toggle-package-event) -;; We use a popup menu - (define-key m 'button3 'pui-popup-context-sensitive) - m) - "Keymap to use over package names/descriptions.") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; End of variables - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Configuration routines - -(defun pui-directory-exists (dir) - "Check to see if DIR exists in `package-get-remote'." - (let (found) - (mapcar '(lambda (item) - (if (and (null (car item)) - (string-equal (file-name-as-directory (car (cdr item))) - (file-name-as-directory dir))) - (setq found t)) - ) package-get-remote) - found - )) - -(defun pui-package-dir-list (buffer) - "In BUFFER, format the list of package binary paths." - (let ( (count 1) paths sys dir) - (set-buffer buffer) - (buffer-disable-undo buffer) - (erase-buffer buffer) - (insert "Existing package binary paths:\n\n") - (setq paths package-get-remote) - (while paths - (setq sys (car (car paths)) - dir (car (cdr (car paths)))) - (insert (format "%2s. " count)) - (if (null sys) - (insert dir) - (insert sys ":" dir)) - (insert "\n") - (setq count (1+ count)) - (setq paths (cdr paths)) - ) - (insert "\nThese are the places that will be searched for package binaries.\n") - (goto-char (point-min)) - )) - -;;;###autoload -(defun package-ui-add-site (site) - "Add site to package-get-remote and possibly offer to update package list." - (let ((had-none (null package-get-remote))) - (push site package-get-remote) - (when (and had-none package-get-was-current - (y-or-n-p "Update Package list?")) - (setq package-get-was-current nil) - (package-get-require-base t) - (if (get-buffer pui-info-buffer) - (save-window-excursion - (pui-list-packages)))) - (set-menubar-dirty-flag))) - - -;;;###autoload -(defun pui-add-install-directory (dir) - "Add a new package binary directory to the head of `package-get-remote'. -Note that no provision is made for saving any changes made by this function. -It exists mainly as a convenience for one-time package installations from -disk." - (interactive (let ( (tmpbuf (get-buffer-create - "*Existing Package Binary Paths*")) - dir) - (save-window-excursion - (save-excursion - (unwind-protect - (progn - (pui-package-dir-list tmpbuf) - (display-buffer tmpbuf) - (setq dir (read-directory-name - "New package binary directory to add? " - nil nil t)) - ) - (kill-buffer tmpbuf) - ))) - (list dir) - )) - (progn - (if (not (pui-directory-exists dir)) - (progn - (setq package-get-remote (cons (list nil dir) package-get-remote)) - (message "Package directory \"%s\" added." dir) - ) - (message "Directory \"%s\" already exists in `package-get-remote'." dir)) - )) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Package list/installer routines - -(defun pui-quit () - (interactive) - (kill-buffer nil)) - -(defun pui-package-symbol-char (pkg-sym version) - (progn - (if (package-get-info-find-package packages-package-list pkg-sym) - (let ((installed (package-get-key pkg-sym :version))) - (if (>= (if (stringp installed) - (string-to-number installed) - installed) - (if (stringp version) - (string-to-number version) - version)) - (list " " pui-up-to-date-package-face) - (list "*" pui-outdated-package-face))) - (list "-" pui-uninstalled-package-face)) - )) - -(defun pui-update-package-display (extent &optional pkg-sym version) - "Update the package status for EXTENT. -If PKG-SYM or VERSION are not given, they are read from the extent. -These are used to determine whether or not the package is installed, -and whether or not it is up-to-date." - (let (buffer-read-only disp sym-char) - (if (not pkg-sym) - (setq pkg-sym (extent-property extent 'pui-package))) - (if (not version) - (setq version (package-get-info-prop (extent-property extent 'pui-info) - 'version))) - (cond ((member pkg-sym pui-selected-packages) - (if pui-selected-package-face - (set-extent-face extent (get-face pui-selected-package-face)) - (set-extent-face extent (get-face 'default))) - (setq sym-char "+")) - ((member pkg-sym pui-deleted-packages) - (if pui-deleted-package-face - (set-extent-face extent (get-face pui-deleted-package-face)) - (set-extent-face extent (get-face 'default))) - (setq sym-char "D")) - (t - (setq disp (pui-package-symbol-char pkg-sym version)) - (setq sym-char (car disp)) - (if (car (cdr disp)) - (set-extent-face extent (get-face (car (cdr disp)))) - (set-extent-face extent (get-face 'default))))) - (save-excursion - (goto-char (extent-start-position extent)) - (delete-char 1) - (insert sym-char) - (set-buffer-modified-p nil) - ) - )) - -(defun pui-toggle-package (extent) - (let (pkg-sym) - (setq pkg-sym (extent-property extent 'pui-package)) - (if (member pkg-sym pui-selected-packages) - (setq pui-selected-packages - (delete pkg-sym pui-selected-packages)) - (setq pui-selected-packages - (cons pkg-sym pui-selected-packages)) - (setq pui-deleted-packages - (delete pkg-sym pui-deleted-packages))) - (pui-update-package-display extent pkg-sym) - )) - -(defun pui-toggle-package-key () - "Select/unselect package for installation, using the keyboard." - (interactive) - (let (extent) - (if (setq extent (extent-at (point) (current-buffer) 'pui)) - (progn - (pui-toggle-package extent) - (forward-line 1) - ) - (error "No package under cursor!")) - )) - -(defun pui-toggle-package-delete (extent) - (let (pkg-sym) - (setq pkg-sym (extent-property extent 'pui-package)) - (if (member pkg-sym pui-deleted-packages) - (setq pui-deleted-packages - (delete pkg-sym pui-deleted-packages)) - (setq pui-deleted-packages - (cons pkg-sym pui-deleted-packages)) - (setq pui-seleted-packages - (delete pkg-sym pui-selected-packages))) - (pui-update-package-display extent pkg-sym) - )) - - -(defun pui-toggle-package-delete-key () - "Select/unselect package for removal, using the keyboard." - (interactive) - (let (extent) - (if (setq extent (extent-at (point) (current-buffer) 'pui)) - (progn - (pui-toggle-package-delete extent) - (forward-line 1) - ) - (error "No package under cursor!")) - )) - -(defun pui-current-package () - (let ((extent (extent-at (point) (current-buffer) 'pui))) - (if extent - (extent-property extent 'pui-package)))) - -(defun pui-toggle-package-event (event) - "Select/unselect package for installation, using the mouse." - (interactive "e") - (let* ( (ep (event-point event)) - (buffer (window-buffer (event-window event))) - (extent (extent-at ep buffer 'pui-package)) - ) - (pui-toggle-package extent) - )) - -(defun pui-toggle-verbosity-redisplay () - "Toggle verbose package info." - (interactive) - (progn - (setq pui-list-verbose (not pui-list-verbose)) - (pui-list-packages) - )) - -(defun pui-install-selected-packages () - "Install selected packages." - (interactive) - (let ( (tmpbuf "*Packages-To-Remove*") do-delete) - (when pui-deleted-packages - (save-window-excursion - (with-output-to-temp-buffer tmpbuf - (display-completion-list (sort - (mapcar '(lambda (pkg) - (symbol-name pkg) - ) - pui-deleted-packages) - 'string<) - :activate-callback nil - :help-string "Packages selected for removal:\n" - :completion-string t - )) - (setq tmpbuf (get-buffer-create tmpbuf)) - (display-buffer tmpbuf) - (setq do-delete (yes-or-no-p "Remove these packages? ")) - (kill-buffer tmpbuf)) - (when do-delete - (message "Deleting selected packages ...") (sit-for 0) - (when (catch 'done - (mapcar (lambda (pkg) - (if (not - (package-admin-delete-binary-package - pkg (package-admin-get-install-dir pkg nil))) - (throw 'done nil))) - pui-deleted-packages) - t) - (message "Packages deleted") - )))) - - (let ( (tmpbuf "*Packages-To-Install*") do-install) - (if pui-selected-packages - (progn - ;; Don't change window config when asking the user if he really - ;; wants to install the packages. We do this to avoid messing up - ;; the window configuration if errors occur (we don't want to - ;; display random buffers in addition to the error buffer, if - ;; errors occur, which would normally be caused by display-buffer). - (save-window-excursion - (with-output-to-temp-buffer tmpbuf - (display-completion-list (sort - (mapcar '(lambda (pkg) - (symbol-name pkg) - ) - pui-selected-packages) - 'string<) - :activate-callback nil - :help-string "Packages selected for installation:\n" - :completion-string t - )) - (setq tmpbuf (get-buffer-create tmpbuf)) - (display-buffer tmpbuf) - (setq do-install (y-or-n-p "Install these packages? ")) - (kill-buffer tmpbuf) - ) - (if do-install - (progn - (save-excursion - ;; Clear old temp buffer history - (set-buffer (get-buffer-create package-admin-temp-buffer)) - (buffer-disable-undo package-admin-temp-buffer) - (erase-buffer package-admin-temp-buffer) - ) - (message "Installing selected packages ...") (sit-for 0) - (if (catch 'done - (mapcar (lambda (pkg) - (if (not (package-get pkg nil nil - pui-package-install-dest-dir)) - (throw 'done nil))) - pui-selected-packages) - t) - (progn - (pui-list-packages) - (message "Packages installed") - )) - ) - (clear-message) - ) - ) - (if pui-deleted-packages - (pui-list-packages) - (error "No packages have been selected!"))) - )) - -(defun pui-add-required-packages () - "Select packages required by those already selected for installation." - (interactive) - (let ((tmpbuf "*Required-Packages*") do-select) - (if pui-selected-packages - (let ((dependencies - (delq nil (mapcar - (lambda (pkg) - (let ((installed - (package-get-key pkg :version)) - (current - (package-get-info-prop - (package-get-info-version - (package-get-info-find-package - package-get-base pkg) nil) - 'version))) - (if (< (if (stringp installed) - (string-to-number installed) - installed) - (if (stringp current) - (string-to-number current) - current)) - pkg - nil))) - (package-get-dependencies pui-selected-packages))))) - ;; Don't change window config when asking the user if he really - ;; wants to add the packages. We do this to avoid messing up - ;; the window configuration if errors occur (we don't want to - ;; display random buffers in addition to the error buffer, if - ;; errors occur, which would normally be caused by display-buffer). - (save-window-excursion - (with-output-to-temp-buffer tmpbuf - (display-completion-list (sort - (mapcar #'(lambda (pkg) - (symbol-name pkg)) - dependencies) - 'string<) - :activate-callback nil - :help-string "Required packages:\n" - :completion-string t)) - (setq tmpbuf (get-buffer-create tmpbuf)) - (display-buffer tmpbuf) - (setq do-select (y-or-n-p "Select these packages? ")) - (kill-buffer tmpbuf)) - (if do-select - (progn - (setq pui-selected-packages - (union pui-selected-packages dependencies)) - (map-extents #'(lambda (extent maparg) - (pui-update-package-display extent)) - nil nil nil nil nil 'pui) - (message "added dependencies")) - (clear-message))) - (error "No packages have been selected!")))) - -(defun pui-help-echo (extent &optional force-update) - "Display additional package info in the modeline. -EXTENT determines the package to display (the package information is -attached to the extent as properties)." - (let (pkg-sym info inst-ver auth-ver date maintainer) - (if (or force-update (not (current-message)) - (string-match ".*: .*: " (current-message)) - ) - (progn - (setq pkg-sym (extent-property extent 'pui-package) - info (extent-property extent 'pui-info) - inst-ver (package-get-key pkg-sym :version) - auth-ver (package-get-info-prop info 'author-version) - date (package-get-info-prop info 'date) - maintainer (package-get-info-prop info 'maintainer)) - (if (not inst-ver) - (setq inst-ver "")) - (if pui-list-verbose - (format "Author version: %-8s %11s: %s" - auth-ver date maintainer) - (format "%-6s: %-8s %11s: %s" - inst-ver auth-ver date maintainer)) - )) - )) - -(defun pui-display-info (&optional no-error event) - "Display additional package info in the modeline. -Designed to be called interactively (from a keypress)." - (interactive) - (let (extent) - (save-excursion - (beginning-of-line) - (if (setq extent (extent-at (point) (current-buffer) 'pui)) - (message (pui-help-echo extent t)) - (if no-error - (clear-message nil) - (error "No package under cursor!"))) - ))) - -;;; "Why is there no standard function to do this?" -(defun pui-popup-context-sensitive (event) - (interactive "e") - (save-excursion - (set-buffer (event-buffer event)) - (goto-char (event-point event)) - (popup-menu pui-menu event) - ;; I agreee with dired.el this is seriously bogus. - (while (popup-menu-up-p) - (dispatch-event (next-event))))) - -(defvar pui-menu - '("Packages" - ["Toggle install " pui-toggle-package-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] - ["Toggle delete " pui-toggle-package-delete-key :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] - ["Info on" pui-display-info :active (pui-current-package) :suffix (format "`%s'" (or (pui-current-package) "..."))] - "---" - ["Add Required" pui-add-required-packages t] - ["Install/Remove Selected" pui-install-selected-packages t] - "---" - ["Verbose" pui-toggle-verbosity-redisplay - :active t :style toggle :selected pui-list-verbose] - ["Refresh" pui-list-packages t] - ["Help" pui-help t] - ["Quit" pui-quit t])) - - -(defun list-packages-mode () - "Symbols in the leftmost column: - - + The package is marked for installation. - - The package has not been installed. - D The package has been marked for deletion. - * The currently installed package is old, and a newer version is - available. - -Useful keys: - - `\\[pui-toggle-package-key]' to select/unselect the current package for installation. - `\\[pui-toggle-package-delete-key]' to select/unselect the current package for removal. - `\\[pui-add-required-packages]' to add any packages required by those selected. - `\\[pui-install-selected-packages]' to install/delete selected packages. - `\\[pui-display-info]' to display additional information about the package in the modeline. - `\\[pui-list-packages]' to refresh the package list. - `\\[pui-toggle-verbosity-redisplay]' to toggle between a verbose and non-verbose display. - `\\[pui-quit]' to kill this buffer. -" - (error "You cannot enter this mode directly. Use `pui-list-packages'")) - -(put 'list-packages-mode 'mode-class 'special) - -;;;###autoload -(defun pui-list-packages () - "List all packages and package information. -The package name, version, and description are displayed. From the displayed -buffer, the user can see which packages are installed, which are not, and -which are out-of-date (a newer version is available). The user can then -select packages for installation via the keyboard or mouse." - (interactive) - (package-get-require-base t) - (let ( (outbuf (get-buffer-create pui-info-buffer)) - (sep-string "===============================================================================\n") - start ) - (message "Creating package list ...") (sit-for 0) - (set-buffer outbuf) - (setq buffer-read-only nil) - (buffer-disable-undo outbuf) - (erase-buffer outbuf) - (kill-all-local-variables) - (use-local-map pui-display-keymap) - (setq major-mode 'list-packages-mode) - (setq mode-name "Packages") - (setq truncate-lines t) - - (unless package-get-remote - (insert " -Warning: No download sites specified. Package index may be out of date. - If you intend to install packages, specify download sites first. - -")) - - (if pui-list-verbose - (insert " Latest Installed - Package name Vers. Vers. Description -") - (insert " Latest - Package name Vers. Description -")) - (insert sep-string) - (setq start (point)) - (mapcar '(lambda (pkg) - (let (pkg-sym info version desc - b e extent current-vers disp) - (setq pkg-sym (car pkg) - info (package-get-info-version (cdr pkg) nil)) - (setq version (package-get-info-prop info 'version) - desc (package-get-info-prop info 'description)) - - (setq disp (pui-package-symbol-char pkg-sym - version)) - (setq b (point)) - (if pui-list-verbose - (progn - (setq current-vers (package-get-key pkg-sym :version)) - (cond - ( (not current-vers) - (setq current-vers "-----") ) - ( (stringp current-vers) - (setq current-vers - (format "%.2f" - (string-to-number current-vers))) ) - ( (numberp current-vers) - (setq current-vers (format "%.2f" current-vers)) ) - ) - (insert - (format "%s %-15s %-5.2f %-5s %s\n" - (car disp) pkg-sym - (if (stringp version) - (string-to-number version) - version) - current-vers desc)) -;; (insert -;; (format "\t\t %-12s %s\n" -;; (package-get-info-prop info 'author-version) -;; (package-get-info-prop info 'date) -;; )) - ) - (insert (format "%s %-15s %-5s %s\n" - (car disp) - pkg-sym version desc))) - (save-excursion - (setq e (progn - (forward-line -1) - (end-of-line) - (point))) - ) - (setq extent (make-extent b e)) - (if (car (cdr disp)) - (set-extent-face extent (get-face (car (cdr disp)))) - (set-extent-face extent (get-face 'default))) - (set-extent-property extent 'highlight t) - (set-extent-property extent 'pui t) - (set-extent-property extent 'pui-package pkg-sym) - (set-extent-property extent 'pui-info info) - (set-extent-property extent 'help-echo 'pui-help-echo) - (set-extent-property extent 'keymap pui-package-keymap) - )) (sort (copy-sequence package-get-base) - '(lambda (a b) - (string< (symbol-name (car a)) - (symbol-name (car b))) - ))) - (insert sep-string) - (insert (documentation 'list-packages-mode)) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - (pop-to-buffer outbuf) - (delete-other-windows) - (goto-char start) - (setq pui-selected-packages nil) ; Reset list - (setq pui-deleted-packages nil) ; Reset list - (when (featurep 'menubar) - (set-buffer-menubar current-menubar) - (add-submenu '() pui-menu) - (setq mode-popup-menu pui-menu)) - (clear-message) -; (message (substitute-command-keys "Press `\\[pui-help]' for help.")) - )) - -;;;###autoload -(defalias 'list-packages 'pui-list-packages) - -(provide 'package-ui) - -;;; package-ui.el ends here diff --git a/lisp/packages.el b/lisp/packages.el deleted file mode 100644 index 49f4fd4..0000000 --- a/lisp/packages.el +++ /dev/null @@ -1,551 +0,0 @@ -;;; packages.el --- Low level support for XEmacs packages - -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: Steven L Baur -;; Maintainer: Steven L Baur -;; Keywords: internal, lisp, dumped - -;; 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 is dumped with XEmacs. - -;; This file provides low level facilities for XEmacs startup -- -;; particularly regarding the package setup. This code has to run in -;; what we call "bare temacs" -- i.e. XEmacs without the usual Lisp -;; environment. Pay special attention: - -;; - not to use the `lambda' macro. Use #'(lambda ...) instead. -;; (this goes for any package loaded before `subr.el'.) -;; -;; - not to use macros, because they are not yet available (and this -;; file must be loadable uncompiled.) This rules out CL-style -;; macros like `when', for instance. -;; -;; - not to use `defcustom'. If you must add user-customizable -;; variables here, use `defvar', and add the variable to -;; `cus-start.el'. - -;; Because of all this, make sure that the stuff you put here really -;; belongs here. - -;; This file requires find-paths.el. - -;;; Code: - -;;; Package versioning - -(defvar packages-package-list nil - "database of loaded packages and version numbers") - -(defvar packages-hierarchy-depth 1 - "Depth of package hierarchies.") - -(defvar packages-load-path-depth 1 - "Depth of load-path search in package hierarchies.") - -(defvar packages-data-path-depth 1 - "Depth of data-path search in package hierarchies.") - -(defvar early-packages nil - "Packages early in the load path.") - -(defvar early-package-load-path nil - "Load path for packages early in the load path.") - -(defvar late-packages nil - "Packages late in the load path.") - -(defvar late-package-load-path nil - "Load path for packages late in the load path.") - -(defvar last-packages nil - "Packages last in the load path.") - -(defvar last-package-load-path nil - "Load path for packages last in the load path.") - -(defvar package-locations - (list - (list (paths-construct-path '("~" ".xemacs")) - 'early #'(lambda () t)) - (list "site-packages" 'late #'(lambda () t)) - (list "infodock-packages" 'late #'(lambda () (featurep 'infodock))) - (list "mule-packages" 'late #'(lambda () (featurep 'mule))) - (list "xemacs-packages" 'late #'(lambda () t)) - (list "packages" 'late #'(lambda () t))) - "Locations of the various package directories. -This is a list each of whose elements describes one directory. -A directory description is a three-element list. -The first element is either an absolute path or a subdirectory -in the XEmacs hierarchy. -The second component is one of the symbols EARLY, LATE, LAST, -depending on the load-path segment the hierarchy is supposed to -show up in. -The third component is a thunk which, if it returns NIL, causes -the directory to be ignored.") - -(defun package-get-key-1 (info key) - "Locate keyword `key' in list." - (cond ((null info) - nil) - ((eq (car info) key) - (nth 1 info)) - (t (package-get-key-1 (cddr info) key)))) - -(defun package-get-key (name key) - "Get info `key' from package `name'." - (let ((info (assq name packages-package-list))) - (when info - (package-get-key-1 (cdr info) key)))) - -(defun package-provide (name &rest attributes) - (let ((info (if (and attributes (floatp (car attributes))) - (list :version (car attributes)) - attributes))) - (remassq name packages-package-list) - (setq packages-package-list - (cons (cons name info) packages-package-list)))) - -(defun package-require (name version) - (let ((pkg (assq name packages-package-list))) - (cond ((null pkg) - (error "Package %s has not been loaded into this XEmacsen" - name)) - ((< (package-get-key name :version) version) - (error "Need version %g of package %s, got version %g" - version name (cdr pkg))) - (t t)))) - -(defun package-delete-name (name) - (let (pkg) - ;; Delete ALL versions of package. - ;; This is pretty memory-intensive, as we use copy-alist when deleting - ;; package entries, to prevent side-effects in functions that call this - ;; one. - (while (setq pkg (assq name packages-package-list)) - (setq packages-package-list (delete pkg (copy-alist - packages-package-list))) - ) - )) - -;;; Build time stuff - -(defvar autoload-file-name "auto-autoloads.el" - "Filename that autoloads are expected to be found in.") - -(defvar packages-hardcoded-lisp - '( - ;; Nothing at this time - ) - "Lisp packages that are always dumped with XEmacs. -This includes every package that is loaded directly by a package listed -in dumped-lisp.el and is not itself listed.") - -(defvar packages-useful-lisp - '("bytecomp" - "byte-optimize" - "shadow" - "cl-macs") - "Lisp packages that need early byte compilation.") - -(defvar packages-unbytecompiled-lisp - '("paths.el" - "dumped-lisp.el" - "dumped-pkg-lisp.el" - "version.el" - "very-early-lisp.el" - "Installation.el") - "Lisp packages that should not be byte compiled.") - - -;; Copied from help.el, could possibly move it to here permanently. -;; Unlike the FSF version, our `locate-library' uses the `locate-file' -;; primitive, which should make it lightning-fast. - -(defun locate-library (library &optional nosuffix path interactive-call) - "Show the precise file name of Emacs library LIBRARY. -This command searches the directories in `load-path' like `M-x load-library' -to find the file that `M-x load-library RET LIBRARY RET' would load. -Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' -to the specified name LIBRARY. - -If the optional third arg PATH is specified, that list of directories -is used instead of `load-path'." - (interactive (list (read-string "Locate library: ") - nil nil - t)) - (let ((result - (locate-file - library - (or path load-path) - (cond ((or (rassq 'jka-compr-handler file-name-handler-alist) - (and (boundp 'find-file-hooks) - (member 'crypt-find-file-hook find-file-hooks))) - ;; Compression involved. - (if nosuffix - ":.gz:.Z" - ".elc:.elc.gz:elc.Z:.el:.el.gz:.el.Z::.gz:.Z")) - (t - ;; No compression. - (if nosuffix - "" - ".elc:.el:"))) - 4))) - (and interactive-call - (if result - (message "Library is file %s" result) - (message "No library %s in search path" library))) - result)) - -(defun packages-add-suffix (str) - (if (null (string-match "\\.el\\'" str)) - (concat str ".elc") - str)) - -(defun packages-list-autoloads-path () - "List autoloads from precomputed load-path." - (let ((path load-path) - autoloads) - (while path - (if (file-exists-p (concat (car path) - autoload-file-name)) - (setq autoloads (cons (concat (car path) - autoload-file-name) - autoloads))) - (setq path (cdr path))) - autoloads)) - -(defun packages-list-autoloads (source-directory) - "List autoload files in (what will be) the normal lisp search path. -This function is used during build to find where the global symbol files so -they can be perused for their useful information." - (let ((files (directory-files (file-name-as-directory source-directory) - t ".*")) - file autolist) - ;; (print (prin1-to-string source-directory)) - ;; (print (prin1-to-string files)) - (while (setq file (car-safe files)) - (if (and (file-directory-p file) - (file-exists-p (concat (file-name-as-directory file) - autoload-file-name))) - (setq autolist (cons (concat (file-name-as-directory file) - autoload-file-name) - autolist))) - (setq files (cdr files))) - autolist)) - -;; The following function cannot be called from a bare temacs -(defun packages-new-autoloads () - "Return autoloads files that have been added or modified since XEmacs dump." - (require 'loadhist) - (let ((me (concat invocation-directory invocation-name)) - (path load-path) - result dir) - (while path - (setq dir (file-truename (car path))) - (let ((autoload-file (file-name-sans-extension (concat - dir - autoload-file-name)))) - ;; Check for: - ;; 1. An auto-autoload file that hasn't provided a feature (because - ;; it has been installed since XEmacs was dumped). - ;; 2. auto-autoload.el being newer than the executable - ;; 3. auto-autoload.elc being newer than the executable (the .el - ;; could be missing or compressed) - (when (or (and (null (file-provides autoload-file)) - (or (file-exists-p (concat autoload-file ".elc")) - (file-exists-p (concat autoload-file ".el")))) - (and (file-newer-than-file-p (concat autoload-file ".el") me) - (setq autoload-file (concat autoload-file ".el"))) - (and (file-newer-than-file-p (concat autoload-file - ".elc") - me) - (setq autoload-file (concat autoload-file ".elc")))) - (push autoload-file result))) - (setq path (cdr path))) - result)) - -;; The following function cannot be called from a bare temacs -(defun packages-reload-autoloads () - "Reload new or updated auto-autoloads files. -This is an extremely dangerous function to call after the user-init-files -is run. Don't call it or you'll be sorry." - (let ((autoload-list (packages-new-autoloads))) - (while autoload-list - (let* ((autoload-file (car autoload-list)) - (feature (car-safe (file-provides autoload-file)))) - (when feature - ;; (message "(unload-feature %S)" feature) - (unload-feature feature)) - (condition-case nil - (load autoload-file) - (t nil))) - (setq autoload-list (cdr autoload-list))))) - -;; Data-directory is really a list now. Provide something to search it for -;; directories. - -(defun locate-data-directory-list (name &optional dir-list) - "Locate the matching list of directories in a search path DIR-LIST. -If no DIR-LIST is supplied, it defaults to `data-directory-list'." - (unless dir-list - (setq dir-list data-directory-list)) - (let (found found-dir found-dir-list) - (while dir-list - (setq found (file-name-as-directory (concat (car dir-list) name)) - found-dir (file-directory-p found)) - (and found-dir - (setq found-dir-list (cons found found-dir-list))) - (setq dir-list (cdr dir-list))) - (nreverse found-dir-list))) - -;; Data-directory is really a list now. Provide something to search it for -;; a directory. - -(defun locate-data-directory (name &optional dir-list) - "Locate a directory in a search path DIR-LIST (a list of directories). -If no DIR-LIST is supplied, it defaults to `data-directory-list'." - (unless dir-list - (setq dir-list data-directory-list)) - (let (found found-dir) - (while (and (null found-dir) dir-list) - (setq found (file-name-as-directory (concat (car dir-list) name)) - found-dir (file-directory-p found)) - (or found-dir - (setq found nil)) - (setq dir-list (cdr dir-list))) - found)) - -;; Data-directory is really a list now. Provide something to search it for -;; files. - -(defun locate-data-file (name &optional dir-list) - "Locate a file in a search path DIR-LIST (a list of directories). -If no DIR-LIST is supplied, it defaults to `data-directory-list'. -This function is basically a wrapper over `locate-file'." - (unless dir-list - (setq dir-list data-directory-list)) - (locate-file name dir-list)) - -;; Path setup - -(defun packages-find-package-directories (roots base) - "Find a set of package directories." - ;; make sure paths-find-version-directory and paths-find-site-directory - ;; don't both pick up version-independent directories ... - (let ((version-directory (paths-find-version-directory roots base nil nil t)) - (site-directory (paths-find-site-directory roots base))) - (paths-uniq-append - (and version-directory (list version-directory)) - (and site-directory (list site-directory))))) - -(defvar packages-special-base-regexp "^\\(etc\\|info\\|lisp\\|lib-src\\|bin\\|pkginfo\\)$" - "Special subdirectories of packages.") - -(defvar packages-no-package-hierarchy-regexp - (concat "\\(" paths-version-control-filename-regexp "\\)" - "\\|" - "\\(" packages-special-base-regexp "\\)") - "Directories which can't be the roots of package hierarchies.") - -(defun packages-find-packages-in-directories (directories) - "Find all packages underneath directories in DIRECTORIES." - (paths-find-recursive-path directories - packages-hierarchy-depth - packages-no-package-hierarchy-regexp)) - -(defun packages-split-path (path) - "Split PATH at \"\", return pair with two components. -The second component is shared with PATH." - (let ((reverse-tail '()) - (rest path)) - (while (and rest (null (string-equal "" (car rest)))) - (setq reverse-tail (cons (car rest) reverse-tail)) - (setq rest (cdr rest))) - (if (null rest) - (cons path nil) - (cons (nreverse reverse-tail) (cdr rest))))) - -(defun packages-split-package-path (package-path) - "Split up PACKAGE-PATH into early, late and last components. -The separation is by \"\" components. -This returns (LIST EARLY-PACKAGES LATE-PACKAGES LAST-PACKAGES)." - ;; When in doubt, it's late - (let* ((stuff (packages-split-path package-path)) - (early (and (cdr stuff) (car stuff))) - (late+last (or (cdr stuff) (car stuff))) - (stuff (packages-split-path late+last)) - (late (car stuff)) - (last (cdr stuff))) - (list (packages-find-packages-in-directories early) - (packages-find-packages-in-directories late) - (packages-find-packages-in-directories last)))) - -(defun packages-deconstruct (list consumer) - "Deconstruct LIST and feed it to CONSUMER." - (apply consumer list)) - -(defun packages-find-packages-by-name (roots name) - "Find a package hierarchy by its name." - (packages-find-packages-in-directories - (if (and (file-name-absolute-p name) - (file-name-directory (expand-file-name name))) - (list (file-name-as-directory (expand-file-name name))) - (packages-find-package-directories roots name)))) - -(defun packages-find-packages-at-time - (roots package-locations time &optional default) - "Find packages at given time. -For the format of PACKAGE-LOCATIONS, see the global variable of the same name. -TIME is either 'EARLY, 'LATE, or 'LAST. -DEFAULT is a default list of packages." - (or default - (let ((packages '())) - (while package-locations - (packages-deconstruct - (car package-locations) - #'(lambda (name a-time thunk) - (if (and (eq time a-time) - (funcall thunk)) - (setq packages - (nconc packages - (packages-find-packages-by-name roots name)))))) - (setq package-locations (cdr package-locations))) - packages))) - -(defun packages-find-packages (roots) - "Find the packages." - (let ((envvar-value (getenv "EMACSPACKAGEPATH"))) - (if envvar-value - (packages-split-package-path (paths-decode-directory-path envvar-value)) - (packages-deconstruct - (packages-split-package-path configure-package-path) - #'(lambda (configure-early-packages - configure-late-packages - configure-last-packages) - (list (packages-find-packages-at-time roots package-locations 'early - configure-early-packages) - (packages-find-packages-at-time roots package-locations 'late - configure-late-packages) - (packages-find-packages-at-time roots package-locations 'last - configure-last-packages))))))) - -(defun packages-find-package-library-path (packages suffixes) - "Construct a path into a component of the packages hierarchy. -PACKAGES is a list of package directories. -SUFFIXES is a list of names of package subdirectories to look for." - (let ((directories - (apply - #'append - (mapcar #'(lambda (package) - (mapcar #'(lambda (suffix) - (file-name-as-directory (concat package suffix))) - suffixes)) - packages)))) - (paths-directories-which-exist directories))) - -(defun packages-find-package-load-path (packages) - "Construct the load-path component for packages. -PACKAGES is a list of package directories." - (paths-find-recursive-load-path - (packages-find-package-library-path packages - '("lisp")) - packages-load-path-depth)) - -(defun packages-find-package-exec-path (packages) - "Construct the exec-path component for packages. -PACKAGES is a list of package directories." - (packages-find-package-library-path packages - (list (paths-construct-path - (list "bin" system-configuration)) - "lib-src"))) - -(defun packages-find-package-info-path (packages) - "Construct the info-path component for packages. -PACKAGES is a list of package directories." - (packages-find-package-library-path packages '("info"))) - -(defun packages-find-package-data-path (packages) - "Construct the data-path component for packages. -PACKAGES is a list of package directories." - (paths-find-recursive-load-path - (packages-find-package-library-path packages - '("etc")) - packages-data-path-depth)) - -;; Loading package initialization files - -(defun packages-load-package-lisps (package-load-path base) - "Load all Lisp files of a certain name along a load path. -BASE is the base name of the files." - (mapc #'(lambda (dir) - (let ((file-name (expand-file-name base dir))) - (condition-case error - (load file-name t t) - (error - (warn (format "Autoload error in: %s:\n\t%s" - file-name - (with-output-to-string - (display-error error nil)))))))) - package-load-path)) - -(defun packages-load-package-auto-autoloads (package-load-path) - "Load auto-autoload files along a load path." - (packages-load-package-lisps package-load-path - (file-name-sans-extension autoload-file-name))) - -(defun packages-handle-package-dumped-lisps (handle package-load-path) - "Load dumped-lisp.el files along a load path. -Call HANDLE on each file off definitions of PACKAGE-LISP there." - (mapc #'(lambda (dir) - (let ((file-name (expand-file-name "dumped-lisp.el" dir))) - (if (file-exists-p file-name) - (let (package-lisp - ;; 20.4 packages could set this - preloaded-file-list) - (load file-name) - ;; dumped-lisp.el could have set this ... - (if package-lisp - (mapc #'(lambda (base) - (funcall handle base)) - package-lisp)))))) - package-load-path)) - -(defun packages-load-package-dumped-lisps (package-load-path) - "Load dumped-lisp.el files along a load path. -Also load files off PACKAGE-LISP definitions there" - (packages-handle-package-dumped-lisps #'load package-load-path)) - -(defun packages-collect-package-dumped-lisps (package-load-path) - "Load dumped-lisp.el files along a load path. -Return list of files off PACKAGE-LISP definitions there" - (let ((*files* '())) - (packages-handle-package-dumped-lisps - #'(lambda (file) - (setq *files* (cons file *files*))) - package-load-path) - (reverse *files*))) - -(provide 'packages) - -;;; packages.el ends here diff --git a/lisp/page.el b/lisp/page.el deleted file mode 100644 index 196a30a..0000000 --- a/lisp/page.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; page.el --- page motion commands for emacs. - -;; Copyright (C) 1985, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: extensions, dumped - -;; 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 file is dumped with XEmacs. - -;; This code provides the page-oriented movement and selection commands -;; documented in the XEmacs Reference Manual. - -;;; Code: - -(defun forward-page (&optional count) - "Move forward to page boundary. With arg, repeat, or go back if negative. -A page boundary is any line whose beginning matches the regexp -`page-delimiter'." - (interactive "_p") ; XEmacs - (or count (setq count 1)) - (while (and (> count 0) (not (eobp))) - ;; In case the page-delimiter matches the null string, - ;; don't find a match without moving. - (if (bolp) (forward-char 1)) - (if (re-search-forward page-delimiter nil t) - nil - (goto-char (point-max))) - (setq count (1- count))) - (while (and (< count 0) (not (bobp))) - ;; In case the page-delimiter matches the null string, - ;; don't find a match without moving. - (and (save-excursion (re-search-backward page-delimiter nil t)) - (= (match-end 0) (point)) - (goto-char (match-beginning 0))) - (forward-char -1) - (if (re-search-backward page-delimiter nil t) - ;; We found one--move to the end of it. - (goto-char (match-end 0)) - ;; We found nothing--go to beg of buffer. - (goto-char (point-min))) - (setq count (1+ count)))) - -(defun backward-page (&optional count) - "Move backward to page boundary. With arg, repeat, or go fwd if negative. -A page boundary is any line whose beginning matches the regexp -`page-delimiter'." - (interactive "_p") ; XEmacs - (or count (setq count 1)) - (forward-page (- count))) - -(defun mark-page (&optional arg) - "Put mark at end of page, point at beginning. -A numeric arg specifies to move forward or backward by that many pages, -thus marking a page other than the one point was originally in." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (if (> arg 0) - (forward-page arg) - (if (< arg 0) - (forward-page (1- arg)))) - (forward-page) - (push-mark nil t t) - (forward-page -1)) - -(defun narrow-to-page (&optional arg) - "Make text outside current page invisible. -A numeric arg specifies to move forward or backward by that many pages, -thus showing a page other than the one point was originally in." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (save-excursion - (widen) - (if (> arg 0) - (forward-page arg) - (if (< arg 0) - (forward-page (1- arg)))) - ;; Find the end of the page. - (forward-page) - ;; If we stopped due to end of buffer, stay there. - ;; If we stopped after a page delimiter, put end of restriction - ;; at the beginning of that line. - (if (save-excursion - (goto-char (match-beginning 0)) ; was (beginning-of-line) - (looking-at page-delimiter)) - (beginning-of-line)) - (narrow-to-region (point) - (progn - ;; Find the top of the page. - (forward-page -1) - ;; If we found beginning of buffer, stay there. - ;; If extra text follows page delimiter on same line, - ;; include it. - ;; Otherwise, show text starting with following line. - (if (and (eolp) (not (bobp))) - (forward-line 1)) - (point))))) -(put 'narrow-to-page 'disabled t) - -(defun count-lines-page () - "Report number of lines on current page, and how many are before or after point." - (interactive "_") ; XEmacs - (save-excursion - (let ((opoint (point)) beg end - total before after) - (forward-page) - (beginning-of-line) - (or (looking-at page-delimiter) - (end-of-line)) - (setq end (point)) - (backward-page) - (setq beg (point)) - (setq total (count-lines beg end) - before (count-lines beg opoint) - after (count-lines opoint end)) - (message "Page has %d lines (%d + %d)" total before after)))) - -(defun what-page () - "Print page and line number of point." - (interactive "_") ; XEmacs - (save-restriction - (widen) - (save-excursion - (beginning-of-line) - (let ((count 1) - (opoint (point))) - (goto-char 1) - (while (re-search-forward page-delimiter opoint t) - (setq count (1+ count))) - (message "Page %d, line %d" - count - (1+ (count-lines (point) opoint))))))) - -;;; Place `provide' at end of file. -(provide 'page) - -;;; page.el ends here diff --git a/lisp/paragraphs.el b/lisp/paragraphs.el deleted file mode 100644 index cb6025c..0000000 --- a/lisp/paragraphs.el +++ /dev/null @@ -1,411 +0,0 @@ -;;; paragraphs.el --- paragraph and sentence parsing. - -;; Copyright (C) 1985, 86, 87, 91, 94, 95, 97 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: wp, dumped - -;; 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 file is dumped with XEmacs. - -;; This package provides the paragraph-oriented commands documented in the -;; XEmacs Reference Manual. - -;; 06/11/1997 - Use char-(after|before) instead of -;; (following|preceding)-char. -slb - -;;; Code: - -(defvar use-hard-newlines nil - "Non-nil means to distinguish hard and soft newlines. -When this is non-nil, the functions `newline' and `open-line' add the -text-property `hard' to newlines that they insert. Also, a line is -only considered as a candidate to match `paragraph-start' or -`paragraph-separate' if it follows a hard newline. Newlines not -marked hard are called \"soft\", and are always internal to -paragraphs. The fill functions always insert soft newlines. - -Each buffer has its own value of this variable.") -(make-variable-buffer-local 'use-hard-newlines) - -(defun use-hard-newlines (&optional arg insert) - "Minor mode to distinguish hard and soft newlines. -When active, the functions `newline' and `open-line' add the -text-property `hard' to newlines that they insert, and a line is -only considered as a candidate to match `paragraph-start' or -`paragraph-separate' if it follows a hard newline. - -Prefix argument says to turn mode on if positive, off if negative. -When the mode is turned on, if there are newlines in the buffer but no hard -newlines, ask the user whether to mark as hard any newlines preceding a -`paragraph-start' line. From a program, second arg INSERT specifies whether -to do this; it can be `never' to change nothing, t or `always' to force -marking, `guess' to try to do the right thing with no questions, nil -or anything else to ask the user. - -Newlines not marked hard are called \"soft\", and are always internal -to paragraphs. The fill functions insert and delete only soft newlines." - (interactive (list current-prefix-arg nil)) - (if (or (<= (prefix-numeric-value arg) 0) - (and use-hard-newlines (null arg))) - ;; Turn mode off - (setq use-hard-newlines nil) - ;; Turn mode on - ;; Intuit hard newlines -- - ;; mark as hard any newlines preceding a paragraph-start line. - (if (or (eq insert t) (eq insert 'always) - (and (not (eq 'never insert)) - (not use-hard-newlines) - (not (text-property-any (point-min) (point-max) 'hard t)) - (save-excursion - (goto-char (point-min)) - (search-forward "\n" nil t)) - (or (eq insert 'guess) - (y-or-n-p "Make newlines between paragraphs hard? ")))) - (save-excursion - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (let ((pos (point))) - (move-to-left-margin) - (if (looking-at paragraph-start) - (progn - (set-hard-newline-properties (1- pos) pos) - ;; If paragraph-separate, newline after it is hard too. - (if (looking-at paragraph-separate) - (progn - (end-of-line) - (if (not (eobp)) - (set-hard-newline-properties - (point) (1+ (point)))))))))))) - (setq use-hard-newlines t))) - -;; XEmacs - use purecopy -(defconst paragraph-start (purecopy "[ \t\n\f]") "\ -*Regexp for beginning of a line that starts OR separates paragraphs. -This regexp should match lines that separate paragraphs -and should also match lines that start a paragraph -\(and are part of that paragraph). - -This is matched against the text at the left margin, which is not necessarily -the beginning of the line, so it should never use \"^\" as an anchor. This -ensures that the paragraph functions will work equally well within a region -of text indented by a margin setting. - -The variable `paragraph-separate' specifies how to distinguish -lines that start paragraphs from lines that separate them. - -If the variable `use-hard-newlines' is non-nil, then only lines following a -hard newline are considered to match.") - -;; paragraph-start requires a hard newline, but paragraph-separate does not: -;; It is assumed that paragraph-separate is distinctive enough to be believed -;; whenever it occurs, while it is reasonable to set paragraph-start to -;; something very minimal, even including "." (which makes every hard newline -;; start a new paragraph). - -;; XEmacs -- use purecopy -(defconst paragraph-separate (purecopy "[ \t\f]*$") "\ -*Regexp for beginning of a line that separates paragraphs. -If you change this, you may have to change paragraph-start also. - -This is matched against the text at the left margin, which is not necessarily -the beginning of the line, so it should not use \"^\" as an anchor. This -ensures that the paragraph functions will work equally within a region of -text indented by a margin setting.") - -;; XEmacs -- use purecopy -(defconst sentence-end (purecopy "[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)[ \t\n]*") "\ -*Regexp describing the end of a sentence. -All paragraph boundaries also end sentences, regardless. - -In order to be recognized as the end of a sentence, the ending period, -question mark, or exclamation point must be followed by two spaces, -unless it's inside some sort of quotes or parenthesis.") - -;; XEmacs -- use purecopy -(defconst page-delimiter (purecopy "^\014") "\ -*Regexp describing line-beginnings that separate pages.") - -(defvar paragraph-ignore-fill-prefix nil "\ -Non-nil means the paragraph commands are not affected by `fill-prefix'. -This is desirable in modes where blank lines are the paragraph delimiters.") - -(defun forward-paragraph (&optional arg) - "Move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. - -A line which `paragraph-start' matches either separates paragraphs -\(if `paragraph-separate' matches it also) or is the first line of a paragraph. -A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." - (interactive "_p") ; XEmacs - (or arg (setq arg 1)) - (let* ((fill-prefix-regexp - (and fill-prefix (not (equal fill-prefix "")) - (not paragraph-ignore-fill-prefix) - (regexp-quote fill-prefix))) - ;; Remove ^ from paragraph-start and paragraph-sep if they are there. - ;; These regexps shouldn't be anchored, because we look for them - ;; starting at the left-margin. This allows paragraph commands to - ;; work normally with indented text. - ;; This hack will not find problem cases like "whatever\\|^something". - (paragraph-start (if (and (not (equal "" paragraph-start)) - (equal ?^ (aref paragraph-start 0))) - (substring paragraph-start 1) - paragraph-start)) - (paragraph-separate (if (and (not (equal "" paragraph-start)) - (equal ?^ (aref paragraph-separate 0))) - (substring paragraph-separate 1) - paragraph-separate)) - (paragraph-separate - (if fill-prefix-regexp - (concat paragraph-separate "\\|" - fill-prefix-regexp "[ \t]*$") - paragraph-separate)) - ;; This is used for searching. - (sp-paragraph-start (concat "^[ \t]*\\(" paragraph-start "\\)")) - start) - (while (and (< arg 0) (not (bobp))) - (if (and (not (looking-at paragraph-separate)) - (re-search-backward "^\n" (max (1- (point)) (point-min)) t) - (looking-at paragraph-separate)) - nil - (setq start (point)) - ;; Move back over paragraph-separating lines. - (forward-char -1) (beginning-of-line) - (while (and (not (bobp)) - (progn (move-to-left-margin) - (looking-at paragraph-separate))) - (forward-line -1)) - (if (bobp) - nil - ;; Go to end of the previous (non-separating) line. - (end-of-line) - ;; Search back for line that starts or separates paragraphs. - (if (if fill-prefix-regexp - ;; There is a fill prefix; it overrides paragraph-start. - (let (multiple-lines) - (while (and (progn (beginning-of-line) (not (bobp))) - (progn (move-to-left-margin) - (not (looking-at paragraph-separate))) - (looking-at fill-prefix-regexp)) - (if (not (= (point) start)) - (setq multiple-lines t)) - (forward-line -1)) - (move-to-left-margin) - ;; Don't move back over a line before the paragraph - ;; which doesn't start with fill-prefix - ;; unless that is the only line we've moved over. - (and (not (looking-at fill-prefix-regexp)) - multiple-lines - (forward-line 1)) - (not (bobp))) - (while (and (re-search-backward sp-paragraph-start nil 1) - ;; Found a candidate, but need to check if it is a - ;; REAL paragraph-start. - (not (bobp)) - (progn (setq start (point)) - (move-to-left-margin) - (not (looking-at paragraph-separate))) - (or (not (looking-at paragraph-start)) - (and use-hard-newlines - (not (get-text-property (1- start) - 'hard))))) - (goto-char start)) - (> (point) (point-min))) - ;; Found one. - (progn - ;; Move forward over paragraph separators. - ;; We know this cannot reach the place we started - ;; because we know we moved back over a non-separator. - (while (and (not (eobp)) - (progn (move-to-left-margin) - (looking-at paragraph-separate))) - (forward-line 1)) - ;; If line before paragraph is just margin, back up to there. - (end-of-line 0) - (if (> (current-column) (current-left-margin)) - (forward-char 1) - (skip-chars-backward " \t") - (if (not (bolp)) - (forward-line 1)))) - ;; No starter or separator line => use buffer beg. - (goto-char (point-min))))) - (setq arg (1+ arg))) - (while (and (> arg 0) (not (eobp))) - ;; Move forward over separator lines, and one more line. - (while (prog1 (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at paragraph-separate)) - (forward-line 1))) - (if fill-prefix-regexp - ;; There is a fill prefix; it overrides paragraph-start. - (while (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (not (looking-at paragraph-separate)) - (looking-at fill-prefix-regexp)) - (forward-line 1)) - (while (and (re-search-forward sp-paragraph-start nil 1) - (progn (setq start (match-beginning 0)) - (goto-char start) - (not (eobp))) - (progn (move-to-left-margin) - (not (looking-at paragraph-separate))) - (or (not (looking-at paragraph-start)) - (and use-hard-newlines - (not (get-text-property (1- start) 'hard))))) - (forward-char 1)) - (if (< (point) (point-max)) - (goto-char start))) - (setq arg (1- arg))))) - -(defun backward-paragraph (&optional arg) - "Move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. - -A paragraph start is the beginning of a line which is a -`first-line-of-paragraph' or which is ordinary text and follows a -paragraph-separating line; except: if the first real line of a -paragraph is preceded by a blank line, the paragraph starts at that -blank line. - -See `forward-paragraph' for more information." - (interactive "_p") ; XEmacs - (or arg (setq arg 1)) - (forward-paragraph (- arg))) - -(defun mark-paragraph () - "Put point at beginning of this paragraph, mark at end. -The paragraph marked is the one that contains point or follows point." - (interactive) - (forward-paragraph 1) - (push-mark nil t t) - (backward-paragraph 1)) - -(defun kill-paragraph (arg) - "Kill forward to end of paragraph. -With arg N, kill forward to Nth end of paragraph; -negative arg -N means kill backward to Nth start of paragraph." - (interactive "*p") ; XEmacs - (kill-region (point) (progn (forward-paragraph arg) (point)))) - -(defun backward-kill-paragraph (arg) - "Kill back to start of paragraph. -With arg N, kill back to Nth start of paragraph; -negative arg -N means kill forward to Nth end of paragraph." - (interactive "*p") ; XEmacs - (kill-region (point) (progn (backward-paragraph arg) (point)))) - -(defun transpose-paragraphs (arg) - "Interchange this (or next) paragraph with previous one." - (interactive "*p") - (transpose-subr 'forward-paragraph arg)) - -(defun start-of-paragraph-text () - (let ((opoint (point)) npoint) - (forward-paragraph -1) - (setq npoint (point)) - (skip-chars-forward " \t\n") - ;; If the range of blank lines found spans the original start point, - ;; try again from the beginning of it. - ;; Must be careful to avoid infinite loop - ;; when following a single return at start of buffer. - (if (and (>= (point) opoint) (< npoint opoint)) - (progn - (goto-char npoint) - (if (> npoint (point-min)) - (start-of-paragraph-text)))))) - -(defun end-of-paragraph-text () - (let ((opoint (point))) - (forward-paragraph 1) - (if (eq (char-before (point)) ?\n) (forward-char -1)) - (if (<= (point) opoint) - (progn - (forward-char 1) - (if (< (point) (point-max)) - (end-of-paragraph-text)))))) - -(defun forward-sentence (&optional arg) - "Move forward to next `sentence-end'. With argument, repeat. -With negative argument, move backward repeatedly to `sentence-beginning'. - -The variable `sentence-end' is a regular expression that matches ends of -sentences. Also, every paragraph boundary terminates sentences as well." - (interactive "_p") ; XEmacs - (or arg (setq arg 1)) - (while (< arg 0) - (let ((par-beg (save-excursion (start-of-paragraph-text) (point)))) - (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t) - (goto-char (1- (match-end 0))) - (goto-char par-beg))) - (setq arg (1+ arg))) - (while (> arg 0) - (let ((par-end (save-excursion (end-of-paragraph-text) (point)))) - (if (re-search-forward sentence-end par-end t) - (skip-chars-backward " \t\n") - (goto-char par-end))) - (setq arg (1- arg)))) - -(defun backward-sentence (&optional arg) - "Move backward to start of sentence. With arg, do it arg times. -See `forward-sentence' for more information." - (interactive "_p") ; XEmacs - (or arg (setq arg 1)) - (forward-sentence (- arg))) - -(defun kill-sentence (&optional arg) - "Kill from point to end of sentence. -With arg, repeat; negative arg -N means kill back to Nth start of sentence." - (interactive "*p") ; XEmacs - (kill-region (point) (progn (forward-sentence arg) (point)))) - -(defun backward-kill-sentence (&optional arg) - "Kill back from point to start of sentence. -With arg, repeat, or kill forward to Nth end of sentence if negative arg -N." - (interactive "*p") ; XEmacs - (kill-region (point) (progn (backward-sentence arg) (point)))) - -(defun mark-end-of-sentence (arg) - "Put mark at end of sentence. Arg works as in `forward-sentence'." - (interactive "p") - ;; FSF Version: -; (push-mark -; (save-excursion -; (forward-sentence arg) -; (point)) -; nil t)) - (mark-something 'mark-end-of-sentence 'forward-sentence arg)) - -(defun mark-end-of-line (arg) - "Put mark at end of line. Arg works as in `end-of-line'." - (interactive "p") - (mark-something 'mark-end-of-line 'end-of-line arg)) - - -(defun transpose-sentences (arg) - "Interchange this (next) and previous sentence." - (interactive "*p") - (transpose-subr 'forward-sentence arg)) - -;;; paragraphs.el ends here diff --git a/lisp/paths.el b/lisp/paths.el deleted file mode 100644 index 094087b..0000000 --- a/lisp/paths.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; paths.el --- define pathnames for use by various Emacs commands. - -;; Copyright (C) 1986, 1988, 1993, 1994, 1997 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: internal, dumped - -;; 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: FSF 19.30. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; These are default settings for names of certain files and directories -;; that Emacs needs to refer to from time to time. - -;; If these settings are not right, override them with `setq' -;; in site-start.el. Do not change this file. - -;;; Code: - -;Note: FSF's version is: -;(defvar Info-default-directory-list -; (let ((start (list "/usr/local/lib/info/" -; ;; This comes second so that, if it is the same -; ;; as configure-info-directory (which is usually true) -; ;; and Emacs has been installed (also usually true) -; ;; then the list will end with two copies of this; -; ;; which means that the last dir file Info-insert-dir -; ;; finds will be the one in this directory. -; "/usr/local/info/")) -; (configdir (file-name-as-directory configure-info-directory))) -; (setq start (nconc start (list configdir))) -; start) -; "List of directories to search for Info documentation files. -;They are searched in the order they are given in this list. -;Therefore, the directory of Info files that come with Emacs -;normally should come last (so that local files override standard ones).") - -;Our commented-out version is: -;(defvar Info-default-directory-list -; (let ((start (list "/usr/local/info/" -; "/usr/local/lib/info/")) -; (configdir (file-name-as-directory configure-info-directory))) -; (or (member configdir start) -; (setq start (nconc start (list configdir)))) -; (or (member (expand-file-name "../info/" data-directory) start) -; (setq start -; (nconc start -; (list (expand-file-name "../info/" data-directory))))) -; start) -; "List of directories to search for Info documentation files.") - -(defvar news-path "/usr/spool/news/" - "The root directory below which all news files are stored.") - -(defvar news-inews-program nil - "Program to post news.") - -;(defvar gnus-default-nntp-server "" -; ;; set this to your local server -; "The name of the host running an NNTP server. -;If it is a string such as \":DIRECTORY\", then ~/DIRECTORY -;is used as a news spool. `gnus-nntp-server' is initialized from NNTPSERVER -;environment variable or, if none, this value.") - -;(defvar gnus-nntp-service "nntp" -; "NNTP service name, usually \"nntp\" or 119). -;Go to a local news spool if its value is nil, in which case `gnus-nntp-server' -;should be set to `(system-name)'.") - -(defvar gnus-local-domain nil - "*Your domain name without a host name: for example, \"ai.mit.edu\". -The DOMAINNAME environment variable is used instead if defined. -If the function `system-name' returns a fully qualified domain name, -there is no need to set this variable.") - -(defvar gnus-local-organization nil - "*The name of your organization, as a string. -The `ORGANIZATION' environment variable is used instead if defined.") - -(defvar mh-progs nil - "Directory containing MH commands.") - -(defvar mh-lib nil - "Directory of MH library.") - -(defvar rmail-file-name (purecopy "~/RMAIL") - "Name of user's primary mail file.") - -(defvar gnus-startup-file (purecopy "~/.newsrc") - "The file listing groups to which user is subscribed. -Will use `gnus-startup-file'-SERVER instead if exists.") - -(defconst rmail-spool-directory nil - "Name of directory used by system mailer for delivering new mail. -Its name should end with a slash.") - -(defconst sendmail-program nil - "Program used to send messages.") - -(defconst remote-shell-program nil - "Program used to execute shell commands on a remote machine.") - -(defconst term-file-prefix (purecopy "term/") - "If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\"))) -You may set this variable to nil in your `.emacs' file if you do not wish -the terminal-initialization file to be loaded.") - -(defconst manual-program nil - "Program to run to print man pages.") - -(defconst abbrev-file-name (purecopy "~/.abbrev_defs") - "*Default name of file to read abbrevs from.") - -(defconst directory-abbrev-alist nil) - -;; Formerly, the values of these variables were computed once -;; (at dump time). However, with the advent of pre-compiled binaries -;; and homebrewed systems such as Linux where who knows where the -;; hell the various programs may be located (if they even exist at all), -;; it's clear that we need to recompute these values at run time. -;; In typical short-sightedness, site administrators have been told up -;; till now to do `setq's in site-init.el, which is run only once -- -;; at dump time. So we have to do contortions to make sure we don't -;; override values set in site-init.el. - -(defun initialize-xemacs-paths () - "Initialize the XEmacs path variables from the environment. -Called automatically at dump time and run time. Do not call this. -Will not override settings in site-init.el or site-run.el." - (let ((l #'(lambda (var value) - (let ((origsym (intern (concat "paths-el-original-" - (symbol-name var))))) - (if (running-temacs-p) - (progn - (set var value) - (set origsym value)) - (and (eq (symbol-value var) (symbol-value origsym)) - (set var value))))))) - (funcall - l 'news-inews-program - (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews") - ((file-exists-p "/usr/local/inews") "/usr/local/inews") - ((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews") - ((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews") - (t "inews"))) - - (funcall - l 'mh-progs - (cond ((file-directory-p "/usr/bin/mh") "/usr/bin/mh/") ;Ultrix 4.2 - ((file-directory-p "/usr/new/mh") "/usr/new/mh/") ;Ultrix <4.2 - ((file-directory-p "/usr/local/bin/mh") "/usr/local/bin/mh/") - ((file-directory-p "/usr/local/mh") "/usr/local/mh/") - (t "/usr/local/bin/"))) - - (funcall - l 'mh-libs - (cond ((file-directory-p "/usr/lib/mh") "/usr/lib/mh/") ;Ultrix 4.2 - ((file-directory-p "/usr/new/lib/mh") - "/usr/new/lib/mh/") ;Ultrix <4.2 - ((file-directory-p "/usr/local/lib/mh") "/usr/local/lib/mh/") - (t "/usr/local/bin/mh/"))) - - (funcall - l 'rmail-spool-directory - (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration) - "/usr/spool/mail/") - ;; On The Bull DPX/2 /usr/spool/mail is used although - ;; it is usg-unix-v. - ((string-match "^m68k-bull-sysv3" system-configuration) - "/usr/spool/mail/") - ;; SVR4 and recent BSD are said to use this. - ;; Rather than trying to know precisely which systems use it, - ;; let's assume this dir is never used for anything else. - ((file-exists-p "/var/mail") - "/var/mail/") - ((memq system-type '(dgux hpux usg-unix-v unisoft-unix rtu irix)) - "/usr/mail/") - ((memq system-type '(linux)) - "/var/spool/mail/") - (t "/usr/spool/mail/"))) - - (funcall - l 'sendmail-program - (cond - ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") - ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") - ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") - (t "fakemail"))) ;In ../etc, to interface to /bin/mail. - - (funcall - l 'remote-shell-program - (cond - ;; Some systems use rsh for the remote shell; others use that - ;; name for the restricted shell and use remsh for the remote - ;; shell. Let's try to guess based on what we actually find - ;; out there. The restricted shell is almost certainly in - ;; /bin or /usr/bin, so it's probably safe to assume that an - ;; rsh found elsewhere is the remote shell program. The - ;; converse is not true: /usr/bin/rsh could be either one, so - ;; check that last. - ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh") - ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh") - ((file-exists-p "/bin/remsh") "/bin/remsh") - ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh") - ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh") - ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh") - ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh") - ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh") - ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd") - ((file-exists-p "/bin/rcmd") "/bin/rcmd") - ((file-exists-p "/bin/rsh") "/bin/rsh") - ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh") - (t "rsh"))) - - (funcall - l 'manual-program - ;; Solaris 2 has both of these files; prefer /usr/ucb/man - ;; because the other has nonstandard argument conventions. - (if (file-exists-p "/usr/ucb/man") - "/usr/ucb/man" "/usr/bin/man")) - - (funcall - l 'directory-abbrev-alist - ;; Try to match various conventions for automounter temporary - ;; mount points. These temporary mount points may go away, so - ;; it's important that we only try to read files under the - ;; "advertised" mount point, rather than the temporary one, or it - ;; will look like files have been deleted on us. Whoever came up - ;; with this design is clearly a moron of the first order, but - ;; now we're stuck with it, no doubt until the end of time. - ;; - ;; For best results, automounter junk should go near the front of this - ;; list, and other user translations should come after it. - ;; - ;; Our code handles the following empirically observed conventions: - ;; /net is an actual directory! (some systems are not broken!) - ;; /net/HOST -> /tmp_mnt/net/HOST (`standard' old Sun automounter) - ;; /net/HOST -> /tmp_mnt/HOST (BSDI 4.0) - ;; /net/HOST -> /a/HOST (Freebsd 2.2.x) - ;; /net/HOST -> /amd/HOST (seen in amd sample config files) - ;; - ;; If your system has a different convention, you may have to change this. - ;; Don't forget to send in a patch! - (when (file-directory-p "/net") - (append - (when (file-directory-p "/tmp_mnt") - (if (file-directory-p "/tmp_mnt/net") - '(("\\`/tmp_mnt/net/" . "/net/")) - '(("\\`/tmp_mnt/" . "/net/")))) - (when (file-directory-p "/a") - '(("\\`/a/" . "/net/"))) - (when (file-directory-p "/amd") - '(("\\`/amd/" . "/net/"))) - ))) -)) - -(if (running-temacs-p) - (initialize-xemacs-paths)) - -;;; paths.el ends here diff --git a/lisp/picture.el b/lisp/picture.el deleted file mode 100644 index a2b3a21..0000000 --- a/lisp/picture.el +++ /dev/null @@ -1,664 +0,0 @@ -;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model. - -;; Copyright (C) 1985, 1994 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.30. - -;; XEmacs changes: -;; -- set zmacs-region-stays -;; -- set mouse-track-rectangle-p -;; -- deleted useless hscroll-point-visible junk. - - -;;; Commentary: - -;; This code provides the picture-mode commands documented in the Emacs -;; manual. The screen is treated as a semi-infinite quarter-plane with -;; support for rectangle operations and `etch-a-sketch' character -;; insertion in any of eight directions. - -;;; Code: - -(defun move-to-column-force (column) - "Move to column COLUMN in current line. -Differs from `move-to-column' in that it creates or modifies whitespace -if necessary to attain exactly the specified column." - (or (natnump column) (setq column 0)) - (move-to-column column) - (let ((col (current-column))) - (if (< col column) - (indent-to column) - (if (and (/= col column) - (= (preceding-char) ?\t)) - (let (indent-tabs-mode) - (delete-char -1) - (indent-to col) - (move-to-column column)))) - (prog1 - ;; XEmacs addition: - (setq zmacs-region-stays t)))) - - -;; Picture Movement Commands - -(defun picture-beginning-of-line (&optional arg) - "Position point at the beginning of the line. -With ARG not nil, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "P") - (if arg (forward-line (1- (prefix-numeric-value arg)))) - (beginning-of-line) - ) - -(defun picture-end-of-line (&optional arg) - "Position point after last non-blank character on current line. -With ARG not nil, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "P") - (if arg (forward-line (1- (prefix-numeric-value arg)))) - (beginning-of-line) - (skip-chars-backward " \t" (prog1 (point) (end-of-line))) - ) - -(defun picture-forward-column (arg) - "Move cursor right, making whitespace if necessary. -With argument, move that many columns." - (interactive "p") - (let ((target-column (+ (current-column) arg))) - (move-to-column-force target-column) - ;; Picture mode isn't really suited to multi-column characters, - ;; but we might as well let the user move across them. - (and (< arg 0) - (> (current-column) target-column) - (forward-char -1)))) - -(defun picture-backward-column (arg) - "Move cursor left, making whitespace if necessary. -With argument, move that many columns." - (interactive "p") - (picture-forward-column (- arg))) - -(defun picture-move-down (arg) - "Move vertically down, making whitespace if necessary. -With argument, move that many lines." - (interactive "p") - (let ((col (current-column))) - (picture-newline arg) - (move-to-column-force col))) - -(defconst picture-vertical-step 0 - "Amount to move vertically after text character in Picture mode.") - -(defconst picture-horizontal-step 1 - "Amount to move horizontally after text character in Picture mode.") - -(defun picture-move-up (arg) - "Move vertically up, making whitespace if necessary. -With argument, move that many lines." - (interactive "p") - (picture-move-down (- arg))) - -(defun picture-movement-right () - "Move right after self-inserting character in Picture mode." - (interactive) - (picture-set-motion 0 1)) - -(defun picture-movement-left () - "Move left after self-inserting character in Picture mode." - (interactive) - (picture-set-motion 0 -1)) - -(defun picture-movement-up () - "Move up after self-inserting character in Picture mode." - (interactive) - (picture-set-motion -1 0)) - -(defun picture-movement-down () - "Move down after self-inserting character in Picture mode." - (interactive) - (picture-set-motion 1 0)) - -(defun picture-movement-nw () - "Move up and left after self-inserting character in Picture mode." - (interactive) - (picture-set-motion -1 -1)) - -(defun picture-movement-ne () - "Move up and right after self-inserting character in Picture mode." - (interactive) - (picture-set-motion -1 1)) - -(defun picture-movement-sw () - "Move down and left after self-inserting character in Picture mode." - (interactive) - (picture-set-motion 1 -1)) - -(defun picture-movement-se () - "Move down and right after self-inserting character in Picture mode." - (interactive) - (picture-set-motion 1 1)) - -(defun picture-set-motion (vert horiz) - "Set VERTICAL and HORIZONTAL increments for movement in Picture mode. -The modeline is updated to reflect the current direction." - (setq picture-vertical-step vert - picture-horizontal-step horiz) - (setq mode-name - (format "Picture:%s" - (car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2)))) - '(nw up ne left none right sw down se))))) - (redraw-modeline) - (message nil)) - -(defun picture-move () - "Move in direction of `picture-vertical-step' and `picture-horizontal-step'." - (picture-move-down picture-vertical-step) - (picture-forward-column picture-horizontal-step)) - -(defun picture-motion (arg) - "Move point in direction of current picture motion in Picture mode. -With ARG do it that many times. Useful for delineating rectangles in -conjunction with diagonal picture motion. -Do \\[command-apropos] picture-movement to see commands which control motion." - (interactive "p") - (picture-move-down (* arg picture-vertical-step)) - (picture-forward-column (* arg picture-horizontal-step))) - -(defun picture-motion-reverse (arg) - "Move point in direction opposite of current picture motion in Picture mode. -With ARG do it that many times. Useful for delineating rectangles in -conjunction with diagonal picture motion. -Do \\[command-apropos] `picture-movement' to see commands which control motion." - (interactive "p") - (picture-motion (- arg))) - - -;; Picture insertion and deletion. - -(defun picture-self-insert (arg) - "Insert this character in place of character previously at the cursor. -The cursor then moves in the direction you previously specified -with the commands `picture-movement-right', `picture-movement-up', etc. -Do \\[command-apropos] `picture-movement' to see those commands." - (interactive "p") - (while (> arg 0) - (setq arg (1- arg)) - (move-to-column-force (1+ (current-column))) - (delete-char -1) - ;; FSF changes the following to last-command-event. - (insert last-command-char) - (forward-char -1) - (picture-move) - ;; XEmacs addition: - (setq zmacs-region-stays nil))) - -(defun picture-clear-column (arg) - "Clear out ARG columns after point without moving." - (interactive "p") - (let* ((opoint (point)) - (original-col (current-column)) - (target-col (+ original-col arg))) - (move-to-column-force target-col) - (delete-region opoint (point)) - (save-excursion - (indent-to (max target-col original-col))))) - -(defun picture-backward-clear-column (arg) - "Clear out ARG columns before point, moving back over them." - (interactive "p") - (picture-clear-column (- arg))) - -(defun picture-clear-line (arg) - "Clear out rest of line; if at end of line, advance to next line. -Cleared-out line text goes into the kill ring, as do newlines that are -advanced over. With argument, clear out (and save in kill ring) that -many lines." - (interactive "P") - (if arg - (progn - (setq arg (prefix-numeric-value arg)) - (kill-line arg) - (newline (if (> arg 0) arg (- arg)))) - (if (looking-at "[ \t]*$") - (kill-ring-save (point) (progn (forward-line 1) (point))) - (kill-region (point) (progn (end-of-line) (point)))) - ;; XEmacs addition: - (setq zmacs-region-stays nil))) - -(defun picture-newline (arg) - "Move to the beginning of the following line. -With argument, moves that many lines (up, if negative argument); -always moves to the beginning of a line." - (interactive "p") - (if (< arg 0) - (forward-line arg) - (while (> arg 0) - (end-of-line) - (if (eobp) (newline) (forward-char 1)) - (setq arg (1- arg)))) - ) - -(defun picture-open-line (arg) - "Insert an empty line after the current line. -With positive argument insert that many lines." - (interactive "p") - (save-excursion - (end-of-line) - (open-line arg)) - ) - -(defun picture-duplicate-line () - "Insert a duplicate of the current line, below it." - (interactive) - (save-excursion - (let ((contents - (buffer-substring - (progn (beginning-of-line) (point)) - (progn (picture-newline 1) (point))))) - (forward-line -1) - (insert contents)))) - -;; Like replace-match, but overwrites. -(defun picture-replace-match (newtext fixedcase literal) - (let (ocolumn change pos) - (goto-char (setq pos (match-end 0))) - (setq ocolumn (current-column)) - ;; Make the replacement and undo it, to see how it changes the length. - (let ((buffer-undo-list nil) - list1) - (replace-match newtext fixedcase literal) - (setq change (- (current-column) ocolumn)) - (setq list1 buffer-undo-list) - (while list1 - (setq list1 (primitive-undo 1 list1)))) - (goto-char pos) - (if (> change 0) - (delete-region (point) - (progn - (move-to-column-force (+ change (current-column))) - (point)))) - (replace-match newtext fixedcase literal) - (if (< change 0) - (insert-char ?\ (- change))))) - -;; Picture Tabs - -(defvar picture-tab-chars "!-~" - "*A character set which controls behavior of commands -\\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a -regular expression, any regexp special characters will be quoted. -It defines a set of \"interesting characters\" to look for when setting -\(or searching for) tab stops, initially \"!-~\" (all printing characters). -For example, suppose that you are editing a table which is formatted thus: -| foo | bar + baz | 23 * -| bubbles | and + etc | 97 * -and that `picture-tab-chars' is \"|+*\". Then invoking -\\[picture-set-tab-stops] on either of the previous lines would result -in the following tab stops - : : : : -Another example - \"A-Za-z0-9\" would produce the tab stops - : : : : - -Note that if you want the character `-' to be in the set, it must be -included in a range or else appear in a context where it cannot be -taken for indicating a range (e.g. \"-A-Z\" declares the set to be the -letters `A' through `Z' and the character `-'). If you want the -character `\\' in the set it must be preceded by itself: \"\\\\\". - -The command \\[picture-tab-search] is defined to move beneath (or to) a -character belonging to this set independent of the tab stops list.") - -(defun picture-set-tab-stops (&optional arg) - "Set value of `tab-stop-list' according to context of this line. -This controls the behavior of \\[picture-tab]. A tab stop is set at -every column occupied by an \"interesting character\" that is preceded -by whitespace. Interesting characters are defined by the variable -`picture-tab-chars', see its documentation for an example of usage. -With ARG, just (re)set `tab-stop-list' to its default value. The tab -stops computed are displayed in the minibuffer with `:' at each stop." - (interactive "P") - (save-excursion - (let (tabs) - (if arg - (setq tabs (default-value 'tab-stop-list)) - (let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]"))) - (beginning-of-line) - (let ((bol (point))) - (end-of-line) - (while (re-search-backward regexp bol t) - (skip-chars-forward " \t") - (setq tabs (cons (current-column) tabs))) - (if (null tabs) - (error "No characters in set %s on this line." - (regexp-quote picture-tab-chars)))))) - (setq tab-stop-list tabs) - (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ ))) - (while tabs - (aset blurb (car tabs) ?:) - (setq tabs (cdr tabs))) - (message blurb))))) - -(defun picture-tab-search (&optional arg) - "Move to column beneath next interesting char in previous line. -With ARG move to column occupied by next interesting character in this -line. The character must be preceded by whitespace. -\"interesting characters\" are defined by variable `picture-tab-chars'. -If no such character is found, move to beginning of line." - (interactive "P") - (let ((target (current-column))) - (save-excursion - (if (and (not arg) - (progn - (beginning-of-line) - (skip-chars-backward - (concat "^" (regexp-quote picture-tab-chars)) - (point-min)) - (not (bobp)))) - (move-to-column target)) - (if (re-search-forward - (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]") - (save-excursion (end-of-line) (point)) - 'move) - (setq target (1- (current-column))) - (setq target nil))) - (if target - (move-to-column-force target) - (beginning-of-line)))) - -(defun picture-tab (&optional arg) - "Tab transparently (just move point) to next tab stop. -With prefix arg, overwrite the traversed text with spaces. The tab stop -list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops]. -See also documentation for variable `picture-tab-chars'." - (interactive "P") - (let* ((opoint (point))) - (move-to-tab-stop) - (if arg - (let (indent-tabs-mode - (column (current-column))) - (delete-region opoint (point)) - (indent-to column)) - ;; XEmacs addition: - (setq zmacs-region-stays t)))) - -;; Picture Rectangles - -(defconst picture-killed-rectangle nil - "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode. -The contents can be retrieved by \\[picture-yank-rectangle]") - -(defun picture-clear-rectangle (start end &optional killp) - "Clear and save rectangle delineated by point and mark. -The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced -with whitespace. The previously saved rectangle, if any, is lost. With -prefix argument, the rectangle is actually killed, shifting remaining text." - (interactive "r\nP") - (setq picture-killed-rectangle (picture-snarf-rectangle start end killp))) - -(defun picture-clear-rectangle-to-register (start end register &optional killp) - "Clear rectangle delineated by point and mark into REGISTER. -The rectangle is saved in REGISTER and replaced with whitespace. With -prefix argument, the rectangle is actually killed, shifting remaining text." - (interactive "r\ncRectangle to register: \nP") - (set-register register (picture-snarf-rectangle start end killp))) - -(defun picture-snarf-rectangle (start end &optional killp) - (let ((column (current-column)) - (indent-tabs-mode nil)) - (prog1 (save-excursion - (if killp - (delete-extract-rectangle start end) - (prog1 (extract-rectangle start end) - (clear-rectangle start end)))) - (move-to-column-force column) - ;; XEmacs addition: - (setq zmacs-region-stays nil)))) - -(defun picture-yank-rectangle (&optional insertp) - "Overlay rectangle saved by \\[picture-clear-rectangle] -The rectangle is positioned with upper left corner at point, overwriting -existing text. With prefix argument, the rectangle is inserted instead, -shifting existing text. Leaves mark at one corner of rectangle and -point at the other (diagonally opposed) corner." - (interactive "P") - (if (not (consp picture-killed-rectangle)) - (error "No rectangle saved.") - (picture-insert-rectangle picture-killed-rectangle insertp))) - -(defun picture-yank-at-click (click arg) - "Insert the last killed rectangle at the position clicked on. -Also move point to one end of the text thus inserted (normally the end). -Prefix arguments are interpreted as with \\[yank]. -If `mouse-yank-at-point' is non-nil, insert at point -regardless of where you click." - (interactive "e\nP") - (or mouse-yank-at-point (mouse-set-point click)) - (picture-yank-rectangle arg)) - -(defun picture-yank-rectangle-from-register (register &optional insertp) - "Overlay rectangle saved in REGISTER. -The rectangle is positioned with upper left corner at point, overwriting -existing text. With prefix argument, the rectangle is -inserted instead, shifting existing text. Leaves mark at one corner -of rectangle and point at the other (diagonally opposed) corner." - (interactive "cRectangle from register: \nP") - (let ((rectangle (get-register register))) - (if (not (consp rectangle)) - (error "Register %c does not contain a rectangle." register) - (picture-insert-rectangle rectangle insertp)))) - -(defun picture-insert-rectangle (rectangle &optional insertp) - "Overlay RECTANGLE with upper left corner at point. -Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted. -Leaves the region surrounding the rectangle." - (let ((indent-tabs-mode nil)) - (if (not insertp) - (save-excursion - (delete-rectangle (point) - (progn - (picture-forward-column (length (car rectangle))) - (picture-move-down (1- (length rectangle))) - (point))))) - (push-mark) - (insert-rectangle rectangle))) - - -;; Picture Keymap, entry and exit points. - -(defconst picture-mode-map nil) - -(defun picture-substitute (oldfun newfun) - (substitute-key-definition oldfun newfun picture-mode-map global-map)) - -(if (not picture-mode-map) - (progn - (setq picture-mode-map (make-keymap 'picture-mode-map)) - (picture-substitute 'self-insert-command 'picture-self-insert) - (picture-substitute 'forward-char 'picture-forward-column) - (picture-substitute 'backward-char 'picture-backward-column) - (picture-substitute 'delete-char 'picture-clear-column) - ;; There are two possibilities for what is normally on DEL. - (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column) - (picture-substitute 'delete-backward-char 'picture-backward-clear-column) - (picture-substitute 'kill-line 'picture-clear-line) - (picture-substitute 'open-line 'picture-open-line) - (picture-substitute 'newline 'picture-newline) - (picture-substitute 'newline-and-indent 'picture-duplicate-line) - (picture-substitute 'next-line 'picture-move-down) - (picture-substitute 'previous-line 'picture-move-up) - (picture-substitute 'beginning-of-line 'picture-beginning-of-line) - (picture-substitute 'end-of-line 'picture-end-of-line) - - (define-key picture-mode-map "\C-c\C-d" 'delete-char) - (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state) - (define-key picture-mode-map "\t" 'picture-tab) - (define-key picture-mode-map "\e\t" 'picture-tab-search) - (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops) - (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle) - (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register) - (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle) - (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register) - (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit) - (define-key picture-mode-map "\C-c\C-f" 'picture-motion) - (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse) - (define-key picture-mode-map "\C-c<" 'picture-movement-left) - (define-key picture-mode-map "\C-c>" 'picture-movement-right) - (define-key picture-mode-map "\C-c^" 'picture-movement-up) - (define-key picture-mode-map "\C-c." 'picture-movement-down) - (define-key picture-mode-map "\C-c`" 'picture-movement-nw) - (define-key picture-mode-map "\C-c'" 'picture-movement-ne) - (define-key picture-mode-map "\C-c/" 'picture-movement-sw) - (define-key picture-mode-map "\C-c\\" 'picture-movement-se))) - -(defvar picture-mode-hook nil - "If non-nil, its value is called on entry to Picture mode. -Picture mode is invoked by the command \\[picture-mode].") - -(defvar picture-mode-old-local-map) -(defvar picture-mode-old-mode-name) -(defvar picture-mode-old-major-mode) -(defvar picture-mode-old-truncate-lines) - -;;;###autoload -(defun picture-mode () - "Switch to Picture mode, in which a quarter-plane screen model is used. -Printing characters replace instead of inserting themselves with motion -afterwards settable by these commands: - C-c < Move left after insertion. - C-c > Move right after insertion. - C-c ^ Move up after insertion. - C-c . Move down after insertion. - C-c ` Move northwest (nw) after insertion. - C-c ' Move northeast (ne) after insertion. - C-c / Move southwest (sw) after insertion. - C-c \\ Move southeast (se) after insertion. -The current direction is displayed in the modeline. The initial -direction is right. Whitespace is inserted and tabs are changed to -spaces when required by movement. You can move around in the buffer -with these commands: - \\[picture-move-down] Move vertically to SAME column in previous line. - \\[picture-move-up] Move vertically to SAME column in next line. - \\[picture-end-of-line] Move to column following last non-whitespace character. - \\[picture-forward-column] Move right inserting spaces if required. - \\[picture-backward-column] Move left changing tabs to spaces if required. - C-c C-f Move in direction of current picture motion. - C-c C-b Move in opposite direction of current picture motion. - Return Move to beginning of next line. -You can edit tabular text with these commands: - M-Tab Move to column beneath (or at) next interesting character. - `Indents' relative to a previous line. - Tab Move to next stop in tab stop list. - C-c Tab Set tab stops according to context of this line. - With ARG resets tab stops to default (global) value. - See also documentation of variable picture-tab-chars - which defines \"interesting character\". You can manually - change the tab stop list with command \\[edit-tab-stops]. -You can manipulate text with these commands: - C-d Clear (replace) ARG columns after point without moving. - C-c C-d Delete char at point - the command normally assigned to C-d. - \\[picture-backward-clear-column] Clear (replace) ARG columns before point, moving back over them. - \\[picture-clear-line] Clear ARG lines, advancing over them. The cleared - text is saved in the kill ring. - \\[picture-open-line] Open blank line(s) beneath current line. -You can manipulate rectangles with these commands: - C-c C-k Clear (or kill) a rectangle and save it. - C-c C-w Like C-c C-k except rectangle is saved in named register. - C-c C-y Overlay (or insert) currently saved rectangle at point. - C-c C-x Like C-c C-y except rectangle is taken from named register. - \\[copy-rectangle-to-register] Copies a rectangle to a register. - \\[advertised-undo] Can undo effects of rectangle overlay commands - commands if invoked soon enough. -You can return to the previous mode with: - C-c C-c Which also strips trailing whitespace from every line. - Stripping is suppressed by supplying an argument. - -Entry to this mode calls the value of picture-mode-hook if non-nil. - -Note that Picture mode commands will work outside of Picture mode, but -they are not defaultly assigned to keys." - (interactive) - (if (eq major-mode 'picture-mode) - (error "You are already editing a picture.") - (make-local-variable 'picture-mode-old-local-map) - (setq picture-mode-old-local-map (current-local-map)) - (use-local-map picture-mode-map) - (make-local-variable 'picture-mode-old-mode-name) - (setq picture-mode-old-mode-name mode-name) - (make-local-variable 'picture-mode-old-major-mode) - (setq picture-mode-old-major-mode major-mode) - (setq major-mode 'picture-mode) - (make-local-variable 'picture-killed-rectangle) - (setq picture-killed-rectangle nil) - (make-local-variable 'tab-stop-list) - (setq tab-stop-list (default-value 'tab-stop-list)) - (make-local-variable 'picture-tab-chars) - (setq picture-tab-chars (default-value 'picture-tab-chars)) - (make-local-variable 'picture-vertical-step) - (make-local-variable 'picture-horizontal-step) - (make-local-variable 'picture-mode-old-truncate-lines) - (setq picture-mode-old-truncate-lines truncate-lines) - (setq truncate-lines t) - - ;; XEmacs addition: - (make-local-variable 'mouse-track-rectangle-p) - (setq mouse-track-rectangle-p t) - - (picture-set-motion 0 1) - - ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc. - (run-hooks 'edit-picture-hook 'picture-mode-hook) - (message - (substitute-command-keys - "Type \\[picture-mode-exit] in this buffer to return it to %s mode.") - picture-mode-old-mode-name))) - -;;;###autoload -(defalias 'edit-picture 'picture-mode) - -(defun picture-mode-exit (&optional nostrip) - "Undo picture-mode and return to previous major mode. -With no argument strips whitespace from end of every line in Picture buffer - otherwise just return to previous mode." - (interactive "P") - (if (not (eq major-mode 'picture-mode)) - (error "You aren't editing a Picture.") - (if (not nostrip) (picture-clean)) - (setq mode-name picture-mode-old-mode-name) - (use-local-map picture-mode-old-local-map) - (setq major-mode picture-mode-old-major-mode) - (kill-local-variable 'tab-stop-list) - (setq truncate-lines picture-mode-old-truncate-lines) - ;; XEmacs change/addition: - (kill-local-variable 'mouse-track-rectangle-p) - (redraw-modeline))) - -(defun picture-clean () - "Eliminate whitespace at ends of lines." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[ \t][ \t]*$" nil t) - (delete-region (match-beginning 0) (point))))) - -(provide 'picture) - -;;; picture.el ends here diff --git a/lisp/process.el b/lisp/process.el deleted file mode 100644 index 749f99d..0000000 --- a/lisp/process.el +++ /dev/null @@ -1,344 +0,0 @@ -;;; process.el --- commands for subprocesses; split out of simple.el - -;; Copyright (C) 1985-7, 1993,4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Ben Wing. - -;; Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: internal, processes, dumped - -;; 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 19.30. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - - -(defvar binary-process-output) -(defvar buffer-file-type) - -(defgroup processes nil - "Process, subshell, compilation, and job control support." - :group 'external - :group 'development) - -(defgroup processes-basics nil - "Basic stuff dealing with processes." - :group 'processes) - -(defgroup execute nil - "Executing external commands." - :group 'processes) - - -(defvar shell-command-switch "-c" - "Switch used to have the shell execute its command line argument.") - -(defun start-process-shell-command (name buffer &rest args) - "Start a program in a subprocess. Return the process object for it. -Args are NAME BUFFER COMMAND &rest COMMAND-ARGS. -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 command name, the name of a shell command. -Remaining arguments are the arguments for the command. -Wildcards and redirection are handled as usual in the shell." - ;; We used to use `exec' to replace the shell with the command, - ;; but that failed to handle (...) and semicolon, etc. - (start-process name buffer shell-file-name shell-command-switch - (mapconcat #'identity args " "))) - -(defun call-process (program &optional infile buffer displayp &rest args) - "Call PROGRAM synchronously in separate process. -The program's input comes from file INFILE (nil means `/dev/null'). -Insert output in BUFFER before point; t means current buffer; - nil for BUFFER means discard it; 0 means discard and don't wait. -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Fourth arg DISPLAYP non-nil means redisplay buffer as output is inserted. -Remaining arguments are strings passed as command arguments to PROGRAM. - -If BUFFER is 0, `call-process' returns immediately with value nil. -Otherwise it waits for PROGRAM to terminate and returns a numeric exit status - or a signal description string. -If you quit, the process is killed with SIGINT, or SIGKILL if you - quit again." - (apply 'call-process-internal program infile buffer displayp args)) - -(defun call-process-region (start end program - &optional deletep buffer displayp - &rest args) - "Send text from START to END to a synchronous process running PROGRAM. -Delete the text if fourth arg DELETEP is non-nil. - -Insert output in BUFFER before point; t means current buffer; - nil for BUFFER means discard it; 0 means discard and don't wait. -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Sixth arg DISPLAYP non-nil means redisplay buffer as output is inserted. -Remaining args are passed to PROGRAM at startup as command args. - -If BUFFER is 0, returns immediately with value nil. -Otherwise waits for PROGRAM to terminate -and returns a numeric exit status or a signal description string. -If you quit, the process is first killed with SIGINT, then with SIGKILL if -you quit again before the process exits." - (let ((temp - (make-temp-name - (concat (file-name-as-directory (temp-directory)) - (if (memq system-type '(ms-dos windows-nt)) "em" "emacs"))))) - (unwind-protect - (progn - (if (memq system-type '(ms-dos windows-nt)) - (let ((buffer-file-type binary-process-output)) - (write-region start end temp nil 'silent)) - (write-region start end temp nil 'silent)) - (if deletep (delete-region start end)) - (apply #'call-process program temp buffer displayp args)) - (ignore-file-errors (delete-file temp))))) - - -(defun shell-command (command &optional output-buffer) - "Execute string COMMAND in inferior shell; display output, if any. - -If COMMAND ends in ampersand, execute it asynchronously. -The output appears in the buffer `*Async Shell Command*'. -That buffer is in shell mode. - -Otherwise, COMMAND is executed synchronously. The output appears in the -buffer `*Shell Command Output*'. -If the output is one line, it is displayed in the echo area *as well*, -but it is nonetheless available in buffer `*Shell Command Output*', -even though that buffer is not automatically displayed. -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - -The optional second argument OUTPUT-BUFFER, if non-nil, -says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in current buffer. (This cannot be done asynchronously.) -In either case, the output is inserted after point (leaving mark after it)." - (interactive (list (read-shell-command "Shell command: ") - current-prefix-arg)) - (if (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer)))) - (progn (barf-if-buffer-read-only) - (push-mark) - ;; We do not use -f for csh; we will not support broken use of - ;; .cshrcs. Even the BSD csh manual says to use - ;; "if ($?prompt) exit" before things which are not useful - ;; non-interactively. Besides, if someone wants their other - ;; aliases for shell commands then they can still have them. - (call-process shell-file-name nil t nil - shell-command-switch command) - (exchange-point-and-mark t)) - ;; Preserve the match data in case called from a program. - (save-match-data - (if (string-match "[ \t]*&[ \t]*$" command) - ;; Command ending with ampersand means asynchronous. - (progn - (background (substring command 0 (match-beginning 0)))) - (shell-command-on-region (point) (point) command output-buffer))))) - -;; We have a sentinel to prevent insertion of a termination message -;; in the buffer itself. -(defun shell-command-sentinel (process signal) - (if (memq (process-status process) '(exit signal)) - (message "%s: %s." - (car (cdr (cdr (process-command process)))) - (substring signal 0 -1)))) - -(defun shell-command-on-region (start end command - &optional output-buffer replace) - "Execute string COMMAND in inferior shell with region as input. -Normally display output (if any) in temp buffer `*Shell Command Output*'; -Prefix arg means replace the region with it. - -The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE. -If REPLACE is non-nil, that means insert the output -in place of text from START to END, putting point and mark around it. - -If the output is one line, it is displayed in the echo area, -but it is nonetheless available in buffer `*Shell Command Output*' -even though that buffer is not automatically displayed. -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - -If the optional fourth argument OUTPUT-BUFFER is non-nil, -that says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in the current buffer. -In either case, the output is inserted after point (leaving mark after it)." - (interactive (let ((string - ;; Do this before calling region-beginning - ;; and region-end, in case subprocess output - ;; relocates them while we are in the minibuffer. - (read-shell-command "Shell command on region: "))) - ;; call-interactively recognizes region-beginning and - ;; region-end specially, leaving them in the history. - (list (region-beginning) (region-end) - string - current-prefix-arg - current-prefix-arg))) - (if (or replace - (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer))))) - ;; Replace specified region with output from command. - (let ((swap (and replace (< start end)))) - ;; Don't muck with mark unless REPLACE says we should. - (goto-char start) - (and replace (push-mark)) - (call-process-region start end shell-file-name t t nil - shell-command-switch command) - (let ((shell-buffer (get-buffer "*Shell Command Output*"))) - (and shell-buffer (not (eq shell-buffer (current-buffer))) - (kill-buffer shell-buffer))) - ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark t))) - ;; No prefix argument: put the output in a temp buffer, - ;; replacing its entire contents. - (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*"))) - (success nil) - (exit-status nil) - (directory default-directory)) - (unwind-protect - (if (eq buffer (current-buffer)) - ;; If the input is the same buffer as the output, - ;; delete everything but the specified region, - ;; then replace that region with the output. - (progn (setq buffer-read-only nil) - (delete-region (max start end) (point-max)) - (delete-region (point-min) (max start end)) - (setq exit-status - (call-process-region (point-min) (point-max) - shell-file-name t t nil - shell-command-switch command)) - (setq success t)) - ;; Clear the output buffer, - ;; then run the command with output there. - (save-excursion - (set-buffer buffer) - (setq buffer-read-only nil) - ;; XEmacs change - (setq default-directory directory) - (erase-buffer)) - (setq exit-status - (call-process-region start end shell-file-name - nil buffer nil - shell-command-switch command)) - (setq success t)) - ;; Report the amount of output. - (let ((lines (save-excursion - (set-buffer buffer) - (if (= (buffer-size) 0) - 0 - (count-lines (point-min) (point-max)))))) - (cond ((= lines 0) - (if success - (display-message - 'command - (if (eql exit-status 0) - "(Shell command succeeded with no output)" - "(Shell command failed with no output)"))) - (kill-buffer buffer)) - ((and success (= lines 1)) - (message "%s" - (save-excursion - (set-buffer buffer) - (goto-char (point-min)) - (buffer-substring (point) - (progn (end-of-line) - (point)))))) - (t - (set-window-start (display-buffer buffer) 1)))))))) - - -(defun start-process (name buffer program &rest program-args) - "Start a program in a subprocess. Return the process object for it. -Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS -NAME is name for process. It is modified if necessary to make it unique. -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 program file name. It is searched for as in the shell. -Remaining arguments are strings to give program as arguments." - (apply 'start-process-internal name buffer program program-args)) - -(defun open-network-stream (name buffer host service) - "Open a TCP connection for a service to a host. -Returns a subprocess-object to represent the connection. -Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. -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 SERVICE is name of the service desired, or an integer - specifying a port number to connect to." - (open-network-stream-internal name buffer host service)) - -(defun shell-quote-argument (argument) - "Quote an argument for passing as argument to an inferior shell." - (if (eq system-type 'ms-dos) - ;; MS-DOS shells don't have quoting, so don't do any. - argument - (if (eq system-type 'windows-nt) - (concat "\"" argument "\"") - ;; Quote everything except POSIX filename characters. - ;; This should be safe enough even for really weird shells. - (let ((result "") (start 0) end) - (while (string-match "[^-0-9a-zA-Z_./]" argument start) - (setq end (match-beginning 0) - result (concat result (substring argument start end) - "\\" (substring argument end (1+ end))) - start (1+ end))) - (concat result (substring argument start)))))) - -(defun exec-to-string (command) - "Execute COMMAND as an external process and return the output of that -process as a string" - ;; by "William G. Dubuque" - (with-output-to-string - (call-process shell-file-name nil t nil shell-command-switch command))) - -(defalias 'shell-command-to-string 'exec-to-string) - -;;; process.el ends here diff --git a/lisp/rect.el b/lisp/rect.el deleted file mode 100644 index 5b78d6b..0000000 --- a/lisp/rect.el +++ /dev/null @@ -1,256 +0,0 @@ -;;; rect.el --- rectangle functions for XEmacs. - -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; 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: FSF 19.34. - -;;; Commentary: - -;; This package provides the operations on rectangles that are ocumented -;; in the XEmacs Reference Manual. - -;;; Code: - -;; XEmacs: extra-args -(defun operate-on-rectangle (function start end coerce-tabs &rest extra-args) - "Call FUNCTION for each line of rectangle with corners at START, END. -If COERCE-TABS is non-nil, convert multi-column characters -that span the starting or ending columns on any line -to multiple spaces before calling FUNCTION. -FUNCTION is called with three arguments: - position of start of segment of this line within the rectangle, - number of columns that belong to rectangle but are before that position, - number of columns that belong to rectangle but are after point. -Point is at the end of the segment of this line within the rectangle." - (let (startcol startlinepos endcol endlinepos) - (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startlinepos (point))) - (save-excursion - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endlinepos (point-marker))) - (if (< endcol startcol) - ;; XEmacs - (let ((tem startcol)) - (setq startcol endcol endcol tem))) - (save-excursion - (goto-char startlinepos) - (while (< (point) endlinepos) - (let (startpos begextra endextra) - (move-to-column startcol coerce-tabs) - (setq begextra (- (current-column) startcol)) - (setq startpos (point)) - (move-to-column endcol coerce-tabs) - (setq endextra (- endcol (current-column))) - (if (< begextra 0) - (setq endextra (+ endextra begextra) - begextra 0)) - (if (< endextra 0) (setq endextra 0)) - (apply function startpos begextra endextra extra-args)) - (forward-line 1))) - (- endcol startcol))) - -(defun delete-rectangle-line (startdelpos ignore ignore) - (delete-region startdelpos (point))) - -;; XEmacs: added lines arg -(defun delete-extract-rectangle-line (startdelpos begextra endextra lines) - (save-excursion - (extract-rectangle-line startdelpos begextra endextra lines)) - (delete-region startdelpos (point))) - -;; XEmacs: added lines arg -(defun extract-rectangle-line (startdelpos begextra endextra lines) - (let ((line (buffer-substring startdelpos (point))) - (end (point))) - (goto-char startdelpos) - (while (search-forward "\t" end t) - (let ((width (- (current-column) - (save-excursion (forward-char -1) - (current-column))))) - (setq line (concat (substring line 0 (- (point) end 1)) - (spaces-string width) - (substring line (+ (length line) (- (point) end))))))) - (if (or (> begextra 0) (> endextra 0)) - (setq line (concat (spaces-string begextra) - line - (spaces-string endextra)))) - (setcdr lines (cons line (cdr lines))))) ; XEmacs - -(defconst spaces-strings - (purecopy '["" " " " " " " " " " " " " " " " "])) - -(defun spaces-string (n) - (if (<= n 8) (aref spaces-strings n) - (let ((val "")) - (while (> n 8) - (setq val (concat " " val) - n (- n 8))) - (concat val (aref spaces-strings n))))) - -;;;###autoload -(defun delete-rectangle (start end) - "Delete (don't save) text in rectangle with point and mark as corners. -The same range of columns is deleted in each line starting with the line -where the region begins and ending with the line where the region ends." - (interactive "r") - (operate-on-rectangle 'delete-rectangle-line start end t)) - -;;;###autoload -(defun delete-extract-rectangle (start end) - "Delete contents of rectangle and return it as a list of strings. -Arguments START and END are the corners of the rectangle. -The value is list of strings, one for each line of the rectangle." - (let ((lines (list nil))) ; XEmacs change - (operate-on-rectangle 'delete-extract-rectangle-line - start end t lines) - (nreverse (cdr lines)))) - -;;;###autoload -(defun extract-rectangle (start end) - "Return contents of rectangle with corners at START and END. -Value is list of strings, one for each line of the rectangle." - (let ((lines (list nil))) ; XEmacs change - (operate-on-rectangle 'extract-rectangle-line start end nil lines) - (nreverse (cdr lines)))) - -;;;###autoload -(defvar killed-rectangle nil - "Rectangle for yank-rectangle to insert.") - -;;;###autoload -(defun kill-rectangle (start end) - "Delete rectangle with corners at point and mark; save as last killed one. -Calling from program, supply two args START and END, buffer positions. -But in programs you might prefer to use `delete-extract-rectangle'." - (interactive "r") - (if buffer-read-only - (progn - (setq killed-rectangle (extract-rectangle start end)) - (barf-if-buffer-read-only))) - (setq killed-rectangle (delete-extract-rectangle start end))) - -;;;###autoload -(defun yank-rectangle () - "Yank the last killed rectangle with upper left corner at point." - (interactive) - (insert-rectangle killed-rectangle)) - -;;;###autoload -(defun insert-rectangle (rectangle) - "Insert text of RECTANGLE with upper left corner at point. -RECTANGLE's first line is inserted at point, its second -line is inserted at a point vertically under point, etc. -RECTANGLE should be a list of strings. -After this command, the mark is at the upper left corner -and point is at the lower right corner." - (let ((lines rectangle) - (insertcolumn (current-column)) - (first t)) - (push-mark) - (while lines - (or first - (progn - (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) - (setq first nil) - (insert (car lines)) - (setq lines (cdr lines))))) - -;;;###autoload -(defun open-rectangle (start end) - "Blank out rectangle with corners at point and mark, shifting text right. -The text previously in the region is not overwritten by the blanks, -but instead winds up to the right of the rectangle." - (interactive "r") - (operate-on-rectangle 'open-rectangle-line start end nil) - (goto-char start)) - -(defun open-rectangle-line (startpos begextra endextra) - ;; Column where rectangle ends. - (let ((endcol (+ (current-column) endextra)) - whitewidth) - (goto-char startpos) - ;; Column where rectangle begins. - (let ((begcol (- (current-column) begextra))) - (skip-chars-forward " \t") - ;; Width of whitespace to be deleted and recreated. - (setq whitewidth (- (current-column) begcol))) - ;; Delete the whitespace following the start column. - (delete-region startpos (point)) - ;; Open the desired width, plus same amount of whitespace we just deleted. - (indent-to (+ endcol whitewidth)))) - -;;;###autoload -(defun string-rectangle (start end string) - "Insert STRING on each line of the region-rectangle, shifting text right. -The left edge of the rectangle specifies the column for insertion. -This command does not delete or overwrite any existing text. - -Called from a program, takes three args; START, END and STRING." - (interactive "r\nsString rectangle: ") - (operate-on-rectangle 'string-rectangle-line start end t string)) ; XEmacs - -;; XEmacs: add string arg -(defun string-rectangle-line (startpos begextra endextra string) - (let (whitespace) - (goto-char startpos) - ;; Compute horizontal width of following whitespace. - (let ((ocol (current-column))) - (skip-chars-forward " \t") - (setq whitespace (- (current-column) ocol))) - ;; Delete the following whitespace. - (delete-region startpos (point)) - ;; Insert the desired string. - (insert string) - ;; Insert the same width of whitespace that we had before. - (indent-to (+ (current-column) whitespace)))) - -;;;###autoload -(defun clear-rectangle (start end) - "Blank out rectangle with corners at point and mark. -The text previously in the region is overwritten by the blanks. -When called from a program, requires two args which specify the corners." - (interactive "r") - (operate-on-rectangle 'clear-rectangle-line start end t)) - -(defun clear-rectangle-line (startpos begextra endextra) - ;; Find end of whitespace after the rectangle. - (skip-chars-forward " \t") - (let ((column (+ (current-column) endextra))) - ;; Delete the text in the rectangle, and following whitespace. - (delete-region (point) - (progn (goto-char startpos) - (skip-chars-backward " \t") - (point))) - ;; Reindent out to same column that we were at. - (indent-to column))) - -(provide 'rect) - -;;; rect.el ends here diff --git a/lisp/replace.el b/lisp/replace.el deleted file mode 100644 index 3b6165e..0000000 --- a/lisp/replace.el +++ /dev/null @@ -1,876 +0,0 @@ -;;; replace.el --- search and replace commands for XEmacs. - -;; Copyright (C) 1985-7, 1992, 1994, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: dumped, 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 [Partially]. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; This package supplies the string and regular-expression replace functions -;; documented in the XEmacs Reference Manual. - -;; All the gettext calls are for XEmacs I18N3 message catalog support. -;; (This is hopelessly broken and we should remove it. -sb) - -;;; Code: - -(defvar case-replace t "\ -*Non-nil means `query-replace' should preserve case in replacements. -What this means is that `query-replace' will change the case of the -replacement text so that it matches the text that was replaced. -If this variable is nil, the replacement text will be inserted -exactly as it was specified by the user, irrespective of the case -of the text that was replaced. - -Note that this flag has no effect if `case-fold-search' is nil, -or if the replacement text has any uppercase letters in it.") - -(defvar query-replace-history nil) - -(defvar query-replace-interactive nil - "Non-nil means `query-replace' uses the last search string. -That becomes the \"string to replace\".") - -(defvar replace-search-function - (lambda (str limit) - (search-forward str limit t)) - "Function used by perform-replace to search forward for a string. It will be -called with two arguments: the string to search for and a limit bounding the -search.") - -(defvar replace-re-search-function - (lambda (regexp limit) - (re-search-forward regexp limit t)) - "Function used by perform-replace to search forward for a regular -expression. It will be called with two arguments: the regexp to search for and -a limit bounding the search.") - -(defun query-replace-read-args (string regexp-flag) - (let (from to) - (if query-replace-interactive - (setq from (car (if regexp-flag regexp-search-ring search-ring))) - (setq from (read-from-minibuffer (format "%s: " (gettext string)) - nil nil nil - 'query-replace-history))) - (setq to (read-from-minibuffer (format "%s %s with: " (gettext string) - from) - nil nil nil - 'query-replace-history)) - (list from to current-prefix-arg))) - -;; As per suggestion from Per Abrahamsen, limit replacement to the region -;; if the region is active. -(defun query-replace (from-string to-string &optional delimited) - "Replace some occurrences of FROM-STRING with TO-STRING. -As each match is found, the user must type a character saying -what to do with it. For directions, type \\[help-command] at that time. - -If `query-replace-interactive' is non-nil, the last incremental search -string is used as FROM-STRING--you don't have to specify it with the -minibuffer. - -Preserves case in each replacement if `case-replace' and `case-fold-search' -are non-nil and FROM-STRING has no uppercase letters. -\(Preserving case means that if the string matched is all caps, or capitalized, -then its replacement is upcased or capitalized.) - -Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. - -To customize possible responses, change the \"bindings\" in `query-replace-map'." - (interactive (query-replace-read-args "Query replace" nil)) - (perform-replace from-string to-string t nil delimited)) - -(defun query-replace-regexp (regexp to-string &optional delimited) - "Replace some things after point matching REGEXP with TO-STRING. -As each match is found, the user must type a character saying -what to do with it. For directions, type \\[help-command] at that time. - -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the -minibuffer. - -Preserves case in each replacement if `case-replace' and `case-fold-search' -are non-nil and REGEXP has no uppercase letters. -Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. -In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, -and `\\=\\N' (where N is a digit) stands for - whatever what matched the Nth `\\(...\\)' in REGEXP." - (interactive (query-replace-read-args "Query replace regexp" t)) - (perform-replace regexp to-string t t delimited)) - -;;#### Not patently useful -(defun map-query-replace-regexp (regexp to-strings &optional arg) - "Replace some matches for REGEXP with various strings, in rotation. -The second argument TO-STRINGS contains the replacement strings, separated -by spaces. This command works like `query-replace-regexp' except -that each successive replacement uses the next successive replacement string, -wrapping around from the last such string to the first. - -Non-interactively, TO-STRINGS may be a list of replacement strings. - -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the minibuffer. - -A prefix argument N says to use each replacement string N times -before rotating to the next." - (interactive - (let (from to) - (setq from (if query-replace-interactive - (car regexp-search-ring) - (read-from-minibuffer "Map query replace (regexp): " - nil nil nil - 'query-replace-history))) - (setq to (read-from-minibuffer - (format "Query replace %s with (space-separated strings): " - from) - nil nil nil - 'query-replace-history)) - (list from to current-prefix-arg))) - (let (replacements) - (if (listp to-strings) - (setq replacements to-strings) - (while (/= (length to-strings) 0) - (if (string-match " " to-strings) - (setq replacements - (append replacements - (list (substring to-strings 0 - (string-match " " to-strings)))) - to-strings (substring to-strings - (1+ (string-match " " to-strings)))) - (setq replacements (append replacements (list to-strings)) - to-strings "")))) - (perform-replace regexp replacements t t nil arg))) - -(defun replace-string (from-string to-string &optional delimited) - "Replace occurrences of FROM-STRING with TO-STRING. -Preserve case in each match if `case-replace' and `case-fold-search' -are non-nil and FROM-STRING has no uppercase letters. -\(Preserving case means that if the string matched is all caps, or capitalized, -then its replacement is upcased or capitalized.) - -Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. - -If `query-replace-interactive' is non-nil, the last incremental search -string is used as FROM-STRING--you don't have to specify it with the -minibuffer. - -This function is usually the wrong thing to use in a Lisp program. -What you probably want is a loop like this: - (while (search-forward FROM-STRING nil t) - (replace-match TO-STRING nil t)) -which will run faster and will not set the mark or print anything." - (interactive (query-replace-read-args "Replace string" nil)) - (perform-replace from-string to-string nil nil delimited)) - -(defun replace-regexp (regexp to-string &optional delimited) - "Replace things after point matching REGEXP with TO-STRING. -Preserve case in each match if `case-replace' and `case-fold-search' -are non-nil and REGEXP has no uppercase letters. -\(Preserving case means that if the string matched is all caps, or capitalized, -then its replacement is upcased or capitalized.) - -Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace -only matches surrounded by word boundaries. -In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, -and `\\=\\N' (where N is a digit) stands for - whatever what matched the Nth `\\(...\\)' in REGEXP. - -If `query-replace-interactive' is non-nil, the last incremental search -regexp is used as REGEXP--you don't have to specify it with the minibuffer. - -This function is usually the wrong thing to use in a Lisp program. -What you probably want is a loop like this: - (while (re-search-forward REGEXP nil t) - (replace-match TO-STRING nil nil)) -which will run faster and will not set the mark or print anything." - (interactive (query-replace-read-args "Replace regexp" t)) - (perform-replace regexp to-string nil t delimited)) - - -(defvar regexp-history nil - "History list for some commands that read regular expressions.") - -(define-function 'keep-lines 'delete-non-matching-lines) -(defun delete-non-matching-lines (regexp) - "Delete all lines except those containing matches for REGEXP. -A match split across lines preserves all the lines it lies in. -Applies to all lines after point." - (interactive (list (read-from-minibuffer - "Keep lines (containing match for regexp): " - nil nil nil 'regexp-history))) - (with-interactive-search-caps-disable-folding regexp t - (save-excursion - (or (bolp) (forward-line 1)) - (let ((start (point))) - (while (not (eobp)) - ;; Start is first char not preserved by previous match. - (if (not (re-search-forward regexp nil 'move)) - (delete-region start (point-max)) - (let ((end (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line) - (point)))) - ;; Now end is first char preserved by the new match. - (if (< start end) - (delete-region start end)))) - (setq start (save-excursion (forward-line 1) - (point))) - ;; If the match was empty, avoid matching again at same place. - (and (not (eobp)) (= (match-beginning 0) (match-end 0)) - (forward-char 1))))))) - -(define-function 'flush-lines 'delete-matching-lines) -(defun delete-matching-lines (regexp) - "Delete lines containing matches for REGEXP. -If a match is split across lines, all the lines it lies in are deleted. -Applies to lines after point." - (interactive (list (read-from-minibuffer - "Flush lines (containing match for regexp): " - nil nil nil 'regexp-history))) - (with-interactive-search-caps-disable-folding regexp t - (save-excursion - (while (and (not (eobp)) - (re-search-forward regexp nil t)) - (delete-region (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line) - (point)) - (progn (forward-line 1) (point))))))) - -(define-function 'how-many 'count-matches) -(defun count-matches (regexp) - "Print number of matches for REGEXP following point." - (interactive (list (read-from-minibuffer - "How many matches for (regexp): " - nil nil nil 'regexp-history))) - (with-interactive-search-caps-disable-folding regexp t - (let ((count 0) opoint) - (save-excursion - (while (and (not (eobp)) - (progn (setq opoint (point)) - (re-search-forward regexp nil t))) - (if (= opoint (point)) - (forward-char 1) - (setq count (1+ count)))) - (message "%d occurrences" count))))) - - -(defvar occur-mode-map ()) -(if occur-mode-map - () - (setq occur-mode-map (make-sparse-keymap)) - (set-keymap-name occur-mode-map 'occur-mode-map) ; XEmacs - (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) ; XEmacs - (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) - (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)) - -(defvar occur-buffer nil) -(defvar occur-nlines nil) -(defvar occur-pos-list nil) - -(defun occur-mode () - "Major mode for output from \\[occur]. -\\Move point to one of the items in this buffer, then use -\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. -Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. - -\\{occur-mode-map}" - (kill-all-local-variables) - (use-local-map occur-mode-map) - (setq major-mode 'occur-mode) - (setq mode-name (gettext "Occur")) ; XEmacs - (make-local-variable 'occur-buffer) - (make-local-variable 'occur-nlines) - (make-local-variable 'occur-pos-list) - (require 'mode-motion) ; XEmacs - (setq mode-motion-hook 'mode-motion-highlight-line) ; XEmacs - (run-hooks 'occur-mode-hook)) - -;; FSF Version of next function: -; (let (buffer pos) -; (save-excursion -; (set-buffer (window-buffer (posn-window (event-end event)))) -; (save-excursion -; (goto-char (posn-point (event-end event))) -; (setq pos (occur-mode-find-occurrence)) -; (setq buffer occur-buffer))) -; (pop-to-buffer buffer) -; (goto-char (marker-position pos)))) - -(defun occur-mode-mouse-goto (event) - "Go to the occurrence highlighted by mouse. -This function is only reasonable when bound to a mouse key in the occur buffer" - (interactive "e") - (let ((window-save (selected-window)) - (frame-save (selected-frame))) - ;; preserve the window/frame setup - (unwind-protect - (progn - (mouse-set-point event) - (occur-mode-goto-occurrence)) - (select-frame frame-save) - (select-window window-save)))) - -;; Called occur-mode-find-occurrence in FSF -(defun occur-mode-goto-occurrence () - "Go to the occurrence the current line describes." - (interactive) - (if (or (null occur-buffer) - (null (buffer-name occur-buffer))) - (progn - (setq occur-buffer nil - occur-pos-list nil) - (error "Buffer in which occurrences were found is deleted"))) - (let* ((line-count - (count-lines (point-min) - (save-excursion - (beginning-of-line) - (point)))) - (occur-number (save-excursion - (beginning-of-line) - (/ (1- line-count) - (cond ((< occur-nlines 0) - (- 2 occur-nlines)) - ((> occur-nlines 0) - (+ 2 (* 2 occur-nlines))) - (t 1))))) - (pos (nth occur-number occur-pos-list)) - ;; removed t arg from Bob Weiner, 10/6/95 - (window (get-buffer-window occur-buffer)) - (occur-source-buffer occur-buffer)) - (if (< line-count 1) - (error "No occurrence on this line")) - (or pos - (error "No occurrence on this line")) - ;; XEmacs: don't raise window unless it isn't visible - ;; allow for the possibility that the occur buffer is on another frame - (or (and window - (window-live-p window) - (frame-visible-p (window-frame window)) - (set-buffer occur-source-buffer)) - (and (pop-to-buffer occur-source-buffer) - (setq window (get-buffer-window occur-source-buffer)))) - (goto-char pos) - (set-window-point window pos))) - - -(defvar list-matching-lines-default-context-lines 0 - "*Default number of context lines to include around a `list-matching-lines' -match. A negative number means to include that many lines before the match. -A positive number means to include that many lines both before and after.") - -;; XEmacs addition -;;; Damn you Jamie, this is utter trash. -(defvar list-matching-lines-whole-buffer t - "If t, occur operates on whole buffer, otherwise occur starts from point. -default is t.") - -(define-function 'occur 'list-matching-lines) -(defun list-matching-lines (regexp &optional nlines) - "Show all lines in the current buffer containing a match for REGEXP. - -If a match spreads across multiple lines, all those lines are shown. - -If variable `list-matching-lines-whole-buffer' is non-nil, the entire buffer is -searched, otherwise search begins at point. - -Each line is displayed with NLINES lines before and after, or -NLINES -before if NLINES is negative. -NLINES defaults to `list-matching-lines-default-context-lines'. -Interactively it is the prefix arg. - -The lines are shown in a buffer named `*Occur*'. -It serves as a menu to find any of the occurrences in this buffer. -\\[describe-mode] in that buffer will explain how." - (interactive - ;; XEmacs change - (list (let* ((default (or (symbol-near-point) - (and regexp-history - (car regexp-history)))) - (minibuffer-history-minimum-string-length 0) - (input - (if default - ;; rewritten for I18N3 snarfing - (read-from-minibuffer - (format "List lines matching regexp (default `%s'): " - default) nil nil nil 'regexp-history) - (read-from-minibuffer - "List lines matching regexp: " - nil nil nil - 'regexp-history)))) - (if (and (equal input "") default) - (progn - (setq input default) - (setcar regexp-history default))) - ;; clear extra entries - (setcdr regexp-history (delete (car regexp-history) - (cdr regexp-history))) - input) - current-prefix-arg)) - (if (equal regexp "") - (error "Must pass non-empty regexp to `list-matching-lines'")) - (setq nlines (if nlines (prefix-numeric-value nlines) - list-matching-lines-default-context-lines)) - (let ((first t) - (dir default-directory) - (buffer (current-buffer)) - (linenum 1) - (prevpos (point-min)) - ;; The rest of this function is very different from FSF. - ;; Presumably that's due to Jamie's misfeature - (final-context-start (make-marker))) - (if (not list-matching-lines-whole-buffer) - (save-excursion - (beginning-of-line) - (setq linenum (1+ (count-lines (point-min) (point)))) - (setq prevpos (point)))) - (with-output-to-temp-buffer "*Occur*" - (save-excursion - (set-buffer standard-output) - (setq default-directory dir) - ;; We will insert the number of lines, and "lines", later. - ;; #### Needs fixing for I18N3 - (let ((print-escape-newlines t)) - (insert (format " matching %s in buffer %s.\n" - regexp (buffer-name buffer)))) - (occur-mode) - (setq occur-buffer buffer) - (setq occur-nlines nlines) - (setq occur-pos-list ())) - (if (eq buffer standard-output) - (goto-char (point-max))) - (with-interactive-search-caps-disable-folding regexp t - (save-excursion - (if list-matching-lines-whole-buffer - (beginning-of-buffer)) - (message "Searching for %s ..." regexp) - ;; Find next match, but give up if prev match was at end of buffer. - (while (and (not (= prevpos (point-max))) - (re-search-forward regexp nil t)) - (goto-char (match-beginning 0)) - (beginning-of-line) - (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 "%5d" 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) - (set-marker final-context-start - (- (point) (- end (match-end 0)))) - (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)) - (while (< (point) final-context-start) - (if (null tag) - (setq tag (format "%5d" this-linenum))) - (insert tag ?:) - ;; FSFmacs -- - ;; we handle this using mode-motion-highlight-line, above. - ;; (put-text-property (save-excursion - ;; (beginning-of-line) - ;; (point)) - ;; (save-excursion - ;; (end-of-line) - ;; (point)) - ;; 'mouse-face 'highlight) - (forward-line 1) - (setq tag nil) - (setq this-linenum (1+ this-linenum))) - (while (<= (point) final-context-start) - (insert empty ?:) - (forward-line 1) - (setq this-linenum (1+ this-linenum)))) - (while (< tem nlines) - (insert empty ?:) - (forward-line 1) - (setq tem (1+ tem))) - (goto-char (point-max))) - (forward-line 1))) - (set-buffer standard-output) - ;; Put positions in increasing order to go with buffer. - (setq occur-pos-list (nreverse occur-pos-list)) - (goto-char (point-min)) - (if (= (length occur-pos-list) 1) - (insert "1 line") - (insert (format "%d lines" (length occur-pos-list)))) - (if (interactive-p) - (message "%d matching lines." (length occur-pos-list)))))))) - -;; It would be nice to use \\[...], but there is no reasonable way -;; to make that display both SPC and Y. -(defconst query-replace-help - (purecopy - "Type Space or `y' to replace one match, Delete or `n' to skip to next, -RET or `q' to exit, Period to replace one match and exit, -Comma to replace but not move point immediately, -C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), -C-w to delete match and recursive edit, -C-l to clear the frame, redisplay, and offer same replacement again, -! to replace all remaining matches with no more questions, -^ to move point back to previous match." -) - "Help message while in query-replace") - -(defvar query-replace-map nil - "Keymap that defines the responses to questions in `query-replace'. -The \"bindings\" in this map are not commands; they are answers. -The valid answers include `act', `skip', `act-and-show', -`exit', `act-and-exit', `edit', `delete-and-edit', `recenter', -`automatic', `backup', `exit-prefix', and `help'.") - -;; Why does it seem that ever file has a different method of doing this? -(if query-replace-map - nil - (let ((map (make-sparse-keymap))) - (set-keymap-name map 'query-replace-map) - (define-key map " " 'act) - (define-key map "\d" 'skip) - (define-key map [delete] 'skip) - (define-key map [backspace] 'skip) - (define-key map "y" 'act) - (define-key map "n" 'skip) - (define-key map "Y" 'act) - (define-key map "N" 'skip) - (define-key map "," 'act-and-show) - (define-key map [escape] 'exit) - (define-key map "q" 'exit) - (define-key map [return] 'exit) - (define-key map "." 'act-and-exit) - (define-key map "\C-r" 'edit) - (define-key map "\C-w" 'delete-and-edit) - (define-key map "\C-l" 'recenter) - (define-key map "!" 'automatic) - (define-key map "^" 'backup) - (define-key map [(control h)] 'help) ;; XEmacs change - (define-key map [f1] 'help) - (define-key map [help] 'help) - (define-key map "?" 'help) - (define-key map "\C-g" 'quit) - (define-key map "\C-]" 'quit) - ;FSFmacs (define-key map "\e" 'exit-prefix) - (define-key map [escape] 'exit-prefix) - - (setq query-replace-map map))) - -;; isearch-mode is dumped, so don't autoload. -;(autoload 'isearch-highlight "isearch") - -;; XEmacs -(defun perform-replace-next-event (event) - (if isearch-highlight - (let ((aborted t)) - (unwind-protect - (progn - (if (match-beginning 0) - (isearch-highlight (match-beginning 0) (match-end 0))) - (next-command-event event) - (setq aborted nil)) - (isearch-dehighlight aborted))) - (next-command-event event))) - -(defun perform-replace (from-string replacements - query-flag regexp-flag delimited-flag - &optional repeat-count map) - "Subroutine of `query-replace'. Its complexity handles interactive queries. -Don't use this in your own program unless you want to query and set the mark -just as `query-replace' does. Instead, write a simple loop like this: - (while (re-search-forward \"foo[ \t]+bar\" nil t) - (replace-match \"foobar\" nil nil)) -which will run faster and probably do exactly what you want. -When searching for a match, this function use `replace-search-function' and `replace-re-search-function'" - (or map (setq map query-replace-map)) - (let* ((event (make-event)) - (nocasify (not (and case-fold-search case-replace - (string-equal from-string - (downcase from-string))))) - (literal (not regexp-flag)) - (search-function (if regexp-flag - replace-re-search-function - replace-search-function)) - (search-string from-string) - (real-match-data nil) ; the match data for the current match - (next-replacement nil) - (replacement-index 0) - (keep-going t) - (stack nil) - (next-rotate-count 0) - (replace-count 0) - (lastrepl nil) ;Position after last match considered. - ;; If non-nil, it is marker saying where in the buffer to - ;; stop. - (limit nil) - (match-again t) - ;; XEmacs addition - (qr-case-fold-search - (if (and case-fold-search search-caps-disable-folding) - (no-upper-case-p search-string regexp-flag) - case-fold-search)) - (message - (if query-flag - (substitute-command-keys - "Query replacing %s with %s: (\\\\[help] for help) ")))) - ;; If the region is active, operate on region. - (when (region-active-p) - ;; Original Per Abrahamsen's code simply narrowed the region, - ;; thus providing a visual indication of the search boundary. - ;; Stallman, on the other hand, handles it like this. - (setq limit (copy-marker (region-end))) - (goto-char (region-beginning)) - (zmacs-deactivate-region)) - (if (stringp replacements) - (setq next-replacement replacements) - (or repeat-count (setq repeat-count 1))) - (if delimited-flag - (setq search-function replace-re-search-function - search-string (concat "\\b" - (if regexp-flag from-string - (regexp-quote from-string)) - "\\b"))) - (push-mark) - (undo-boundary) - (unwind-protect - ;; Loop finding occurrences that perhaps should be replaced. - (while (and keep-going - (not (eobp)) - (let ((case-fold-search qr-case-fold-search)) - (funcall search-function search-string limit)) - ;; If the search string matches immediately after - ;; the previous match, but it did not match there - ;; before the replacement was done, ignore the match. - (if (or (eq lastrepl (point)) - (and regexp-flag - (eq lastrepl (match-beginning 0)) - (not match-again))) - (if (eobp) - nil - ;; Don't replace the null string - ;; right after end of previous replacement. - (forward-char 1) - (let ((case-fold-search qr-case-fold-search)) - (funcall search-function search-string limit))) - t)) - - ;; Save the data associated with the real match. - (setq real-match-data (match-data)) - - ;; Before we make the replacement, decide whether the search string - ;; can match again just after this match. - (if regexp-flag - (progn - (setq match-again (looking-at search-string)) - ;; XEmacs addition - (store-match-data real-match-data))) - ;; If time for a change, advance to next replacement string. - (if (and (listp replacements) - (= next-rotate-count replace-count)) - (progn - (setq next-rotate-count - (+ next-rotate-count repeat-count)) - (setq next-replacement (nth replacement-index replacements)) - (setq replacement-index (% (1+ replacement-index) (length replacements))))) - (if (not query-flag) - (progn - (store-match-data real-match-data) - (replace-match next-replacement nocasify literal) - (setq replace-count (1+ replace-count))) - (undo-boundary) - (let ((help-form - '(concat (format "Query replacing %s%s with %s.\n\n" - (if regexp-flag (gettext "regexp ") "") - from-string next-replacement) - (substitute-command-keys query-replace-help))) - done replaced def) - ;; Loop reading commands until one of them sets done, - ;; which means it has finished handling this occurrence. - (while (not done) - ;; Don't fill up the message log - ;; with a bunch of identical messages. - ;; XEmacs change - (display-message 'prompt - (format message from-string next-replacement)) - (perform-replace-next-event event) - (setq def (lookup-key map (vector event))) - ;; Restore the match data while we process the command. - (store-match-data real-match-data) - (cond ((eq def 'help) - (with-output-to-temp-buffer (gettext "*Help*") - (princ (concat - (format "Query replacing %s%s with %s.\n\n" - (if regexp-flag "regexp " "") - from-string next-replacement) - (substitute-command-keys - query-replace-help))) - (save-excursion - (set-buffer standard-output) - (help-mode)))) - ((eq def 'exit) - (setq keep-going nil) - (setq done t)) - ((eq def 'backup) - (if stack - (let ((elt (car stack))) - (goto-char (car elt)) - (setq replaced (eq t (cdr elt))) - (or replaced - (store-match-data (cdr elt))) - (setq stack (cdr stack))) - (message "No previous match") - (ding 'no-terminate) - (sit-for 1))) - ((eq def 'act) - (or replaced - (replace-match next-replacement nocasify literal)) - (setq done t replaced t)) - ((eq def 'act-and-exit) - (or replaced - (replace-match next-replacement nocasify literal)) - (setq keep-going nil) - (setq done t replaced t)) - ((eq def 'act-and-show) - (if (not replaced) - (progn - (replace-match next-replacement nocasify literal) - (store-match-data nil) - (setq replaced t)))) - ((eq def 'automatic) - (or replaced - (replace-match next-replacement nocasify literal)) - (setq done t query-flag nil replaced t)) - ((eq def 'skip) - (setq done t)) - ((eq def 'recenter) - (recenter nil)) - ((eq def 'edit) - (store-match-data - (prog1 (match-data) - (save-excursion (recursive-edit)))) - ;; Before we make the replacement, - ;; decide whether the search string - ;; can match again just after this match. - (if regexp-flag - (setq match-again (looking-at search-string)))) - ((eq def 'delete-and-edit) - (delete-region (match-beginning 0) (match-end 0)) - (store-match-data (prog1 (match-data) - (save-excursion (recursive-edit)))) - (setq replaced t)) - ;; Note: we do not need to treat `exit-prefix' - ;; specially here, since we reread - ;; any unrecognized character. - (t - (setq this-command 'mode-exited) - (setq keep-going nil) - (setq unread-command-events - (cons event unread-command-events)) - (setq done t)))) - ;; Record previous position for ^ when we move on. - ;; Change markers to numbers in the match data - ;; since lots of markers slow down editing. - (setq stack - (cons (cons (point) - (or replaced - (match-data t))) - stack)) - (if replaced (setq replace-count (1+ replace-count))))) - (setq lastrepl (point))) - ;; Useless in XEmacs. We handle (de)highlighting through - ;; perform-replace-next-event. - ;(replace-dehighlight) - ) - (or unread-command-events - (message "Replaced %d occurrence%s" - replace-count - (if (= replace-count 1) "" "s"))) - (and keep-going stack))) - -;; FSFmacs code: someone should port it. - -;(defvar query-replace-highlight nil -; "*Non-nil means to highlight words during query replacement.") - -;(defvar replace-overlay nil) - -;(defun replace-dehighlight () -; (and replace-overlay -; (progn -; (delete-overlay replace-overlay) -; (setq replace-overlay nil)))) - -;(defun replace-highlight (start end) -; (and query-replace-highlight -; (progn -; (or replace-overlay -; (progn -; (setq replace-overlay (make-overlay start end)) -; (overlay-put replace-overlay 'face -; (if (internal-find-face 'query-replace) -; 'query-replace 'region)))) -; (move-overlay replace-overlay start end (current-buffer))))) - -(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))))) - -(defmacro save-match-data (&rest body) - "Execute BODY forms, restoring the global value of the match data." - (let ((original (make-symbol "match-data"))) - (list 'let (list (list original '(match-data))) - (list 'unwind-protect - (cons 'progn body) - (list 'store-match-data original))))) - -;;; replace.el ends here diff --git a/lisp/scrollbar.el b/lisp/scrollbar.el deleted file mode 100644 index 3e83e2d..0000000 --- a/lisp/scrollbar.el +++ /dev/null @@ -1,138 +0,0 @@ -;;; scrollbar.el --- Scrollbar support for XEmacs - -;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, extensions, dumped - -;; 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. (Completely divergent from FSF scroll-bar.el) - -;;; Commentary: - -;; This file is dumped with XEmacs (when scrollbar support is compiled in). - -;;; Code: - -;; added for the options menu - dverna -(defcustom scrollbars-visible-p t - "Whether the scrollbars are globally visible. -This variable can be customized through the options menu." - :type 'boolean - :set (lambda (var val) - (set-specifier vertical-scrollbar-visible-p val) - (set-specifier horizontal-scrollbar-visible-p val) - (setq-default scrollbars-visible-p val)) - :group 'display) - -(defun init-scrollbar-from-resources (locale) - (when (and (featurep 'x) - (or (eq locale 'global) - (eq 'x (device-or-frame-type locale)))) - (x-init-scrollbar-from-resources locale)) - (when (and (featurep 'mswindows) - (or (eq locale 'global) - (eq 'mswindows (device-or-frame-type locale)))) - (mswindows-init-scrollbar-metrics locale))) - -;; -;; vertical scrollbar functions -;; - -;;; ### Move functions from C into Lisp here! - -;; -;; horizontal scrollbar functions -;; - -(defun scrollbar-char-left (window) - "Function called when the char-left arrow on the scrollbar is clicked. -This is the little arrow to the left of the scrollbar. One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window (- (window-hscroll window) 1)) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-char-right (window) - "Function called when the char-right arrow on the scrollbar is clicked. -This is the little arrow to the right of the scrollbar. One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window (+ (window-hscroll window) 1)) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-page-left (window) - "Function called when the user gives the \"page-left\" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.\) One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window (- (window-hscroll window) - (- (window-width window) 2))) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-page-right (window) - "Function called when the user gives the \"page-right\" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.\) One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window (+ (window-hscroll window) - (- (window-width window) 2))) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-to-left (window) - "Function called when the user gives the \"to-left\" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.\). One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window 0) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-to-right (window) - "Function called when the user gives the \"to-right\" scrollbar action. -\(The way this is done can vary from scrollbar to scrollbar.\). One argument is -passed, the scrollbar's window. You can advise this function to -change the scrollbar behavior." - (when (window-live-p window) - (scrollbar-set-hscroll window 'max) - (setq zmacs-region-stays t) - nil)) - -(defun scrollbar-horizontal-drag (data) - "Function called when the user drags the horizontal scrollbar thumb. -One argument is passed, a cons containing the scrollbar's window and a value -representing how many columns the thumb is slid over. You can advise -this function to change the scrollbar behavior." - (let ((window (car data)) - (value (cdr data))) - (when (and (window-live-p window) (integerp value)) - (scrollbar-set-hscroll window value) - (setq zmacs-region-stays t) - nil))) - -;;; scrollbar.el ends here diff --git a/lisp/select.el b/lisp/select.el deleted file mode 100644 index df593f8..0000000 --- a/lisp/select.el +++ /dev/null @@ -1,294 +0,0 @@ -;;; select.el --- Lisp interface to windows selections. - -;; Copyright (C) 1998 Andy Piper. -;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 is dumped with XEmacs - -;;; Code: - -(defun copy-primary-selection () - "Copy the selection to the Clipboard and the kill ring." - (interactive) - (and (console-on-window-system-p) - (cut-copy-clear-internal 'copy))) -(define-obsolete-function-alias - 'x-copy-primary-selection - 'copy-primary-selection) - -(defun kill-primary-selection () - "Copy the selection to the Clipboard and the kill ring, then delete it." - (interactive "*") - (and (console-on-window-system-p) - (cut-copy-clear-internal 'cut))) -(define-obsolete-function-alias - 'x-kill-primary-selection - 'kill-primary-selection) - -(defun delete-primary-selection () - "Delete the selection without copying it to the Clipboard or the kill ring." - (interactive "*") - (and (console-on-window-system-p) - (cut-copy-clear-internal 'clear))) -(define-obsolete-function-alias - 'x-delete-primary-selection - 'delete-primary-selection) - -(defun yank-clipboard-selection () - "Insert the current Clipboard selection at point." - (interactive "*") - (case (device-type (selected-device)) - (x (x-yank-clipboard-selection)) - (mswindows (mswindows-paste-clipboard)) - (otherwise nil))) - -(defun selection-owner-p (&optional selection) - "Return t if current XEmacs process owns the given Selection. -The arg should be the name of the selection in question, typically one -of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, -the symbol nil is the same as PRIMARY, and t is the same as -SECONDARY.)" - (interactive) - (case (device-type (selected-device)) - (x (x-selection-owner-p selection)) - (mswindows (mswindows-selection-owner-p selection)) - (otherwise nil))) - -(defun selection-exists-p (&optional selection) - "Whether there is an owner for the given Selection. -The arg should be the name of the selection in question, typically one -of the symbols PRIMARY, SECONDARY, or CLIPBOARD. (For convenience, -the symbol nil is the same as PRIMARY, and t is the same as -SECONDARY." - (interactive) - (case (device-type (selected-device)) - (x (x-selection-exists-p selection)) - (mswindows (mswindows-selection-exists-p)) - (otherwise nil))) - -(defun own-selection (data &optional type) - "Make an Windows selection of type TYPE and value DATA. -The argument TYPE (default `PRIMARY') says which selection, -and DATA specifies the contents. DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). - -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. - -The data may also be a vector of valid non-vector selection values. - -Interactively, the text of the region is used as the selection value." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (substring (region-beginning) (region-end))))) - (case (device-type (selected-device)) - (x (x-own-selection data type)) - (mswindows (mswindows-own-selection data type)) - (otherwise nil))) - -(defun own-clipboard (string) - "Paste the given string to the Clipboard." - (case (device-type (selected-device)) - (x (x-own-clipboard string)) - (mswindows (mswindows-own-clipboard string)) - (otherwise nil))) - -(defun disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." - (case (device-type (selected-device)) - (x (x-disown-selection secondary-p)) - (mswindows (mswindows-disown-selection secondary-p)) - (otherwise nil))) - - -;; from x-init.el -;; selections and active regions - -;; If and only if zmacs-regions is true: - -;; When a mark is pushed and the region goes into the "active" state, we -;; assert it as the Primary selection. This causes it to be hilighted. -;; When the region goes into the "inactive" state, we disown the Primary -;; selection, causing the region to be dehilighted. - -;; Note that it is possible for the region to be in the "active" state -;; and not be hilighted, if it is in the active state and then some other -;; application asserts the selection. This is probably not a big deal. - -(defun activate-region-as-selection () - (if (marker-buffer (mark-marker t)) - (own-selection (cons (point-marker t) (mark-marker t))))) - -; moved from x-select.el -(defvar primary-selection-extent nil - "The extent of the primary selection; don't use this.") - -(defvar secondary-selection-extent nil - "The extent of the secondary selection; don't use this.") - -(defun select-make-extent-for-selection (selection previous-extent) - ;; Given a selection, this makes an extent in the buffer which holds that - ;; selection, for highlighting purposes. If the selection isn't associated - ;; with a buffer, this does nothing. - (let ((buffer nil) - (valid (and (extentp previous-extent) - (extent-object previous-extent) - (buffer-live-p (extent-object previous-extent)))) - start end) - (cond ((stringp selection) - ;; if we're selecting a string, lose the previous extent used - ;; to highlight the selection. - (setq valid nil)) - ((consp selection) - (setq start (min (car selection) (cdr selection)) - end (max (car selection) (cdr selection)) - valid (and valid - (eq (marker-buffer (car selection)) - (extent-object previous-extent))) - buffer (marker-buffer (car selection)))) - ((extentp selection) - (setq start (extent-start-position selection) - end (extent-end-position selection) - valid (and valid - (eq (extent-object selection) - (extent-object previous-extent))) - buffer (extent-object selection))) - (t - (signal 'error (list "invalid selection" selection)))) - - (if valid - nil - (condition-case () - (if (listp previous-extent) - (mapcar 'delete-extent previous-extent) - (delete-extent previous-extent)) - (error nil))) - - (if (not buffer) - ;; string case - nil - ;; normal case - (if valid - (set-extent-endpoints previous-extent start end) - (setq previous-extent (make-extent start end buffer)) - - ;; Make the extent be closed on the right, which means that if - ;; characters are inserted exactly at the end of the extent, the - ;; extent will grow to cover them. This is important for shell - ;; buffers - suppose one makes a selection, and one end is at - ;; point-max. If the shell produces output, that marker will remain - ;; at point-max (its position will increase). So it's important that - ;; the extent exhibit the same behavior, lest the region covered by - ;; the extent (the visual indication), and the region between point - ;; and mark (the actual selection value) become different! - (set-extent-property previous-extent 'end-open nil) - - (cond - (mouse-track-rectangle-p - (setq previous-extent (list previous-extent)) - (default-mouse-track-next-move-rect start end previous-extent) - )) - previous-extent)))) -(define-obsolete-function-alias - 'x-select-make-extent-for-selection - 'select-make-extent-for-selection) - -;; moved from x-select.el -(defun valid-simple-selection-p (data) - (or (stringp data) - ;FSFmacs huh?? (symbolp data) - (integerp data) - (and (consp data) - (integerp (car data)) - (or (integerp (cdr data)) - (and (consp (cdr data)) - (integerp (car (cdr data)))))) - (extentp data) - (and (consp data) - (markerp (car data)) - (markerp (cdr data)) - (marker-buffer (car data)) - (marker-buffer (cdr data)) - (eq (marker-buffer (car data)) - (marker-buffer (cdr data))) - (buffer-live-p (marker-buffer (car data))) - (buffer-live-p (marker-buffer (cdr data)))))) -(define-obsolete-function-alias - 'x-valid-simple-selection-p - 'valid-simple-selection-p) - -(defun cut-copy-clear-internal (mode) - (or (memq mode '(cut copy clear)) (error "unkown mode %S" mode)) - (or (selection-owner-p) - (error "XEmacs does not own the primary selection")) - (setq last-command nil) - (or primary-selection-extent - (error "the primary selection is not an extent?")) - (save-excursion - (let (rect-p b s e) - (cond - ((consp primary-selection-extent) - (setq rect-p t - b (extent-object (car primary-selection-extent)) - s (extent-start-position (car primary-selection-extent)) - e (extent-end-position (car (reverse primary-selection-extent))))) - (t - (setq rect-p nil - b (extent-object primary-selection-extent) - s (extent-start-position primary-selection-extent) - e (extent-end-position primary-selection-extent)))) - (set-buffer b) - (cond ((memq mode '(cut copy)) - (if rect-p - (progn - ;; why is killed-rectangle free? Is it used somewhere? - ;; should it be defvarred? - (setq killed-rectangle (extract-rectangle s e)) - (kill-new (mapconcat #'identity killed-rectangle "\n"))) - (copy-region-as-kill s e)) - ;; Maybe killing doesn't own clipboard. Make sure it happens. - ;; This memq is kind of grody, because they might have done it - ;; some other way, but owning the clipboard twice in that case - ;; wouldn't actually hurt anything. - (or (and (consp kill-hooks) (memq 'own-clipboard kill-hooks)) - (own-clipboard (car kill-ring))))) - (cond ((memq mode '(cut clear)) - (if rect-p - (delete-rectangle s e) - (delete-region s e)))) - (disown-selection nil) - ))) -(define-obsolete-function-alias - 'x-cut-copy-clear-internal - 'cut-copy-clear-internal) - -;;; select.el ends here diff --git a/lisp/setup-paths.el b/lisp/setup-paths.el deleted file mode 100644 index b275db2..0000000 --- a/lisp/setup-paths.el +++ /dev/null @@ -1,192 +0,0 @@ -;;; setup-paths.el --- setup various XEmacs paths - -;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. -;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois - -;; Author: Mike Sperber -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;; This file describes and constructs the various paths into the -;; XEmacs hierarchy from a global viewpoint. - -;; It requires find-paths.el and packages.el. - -;;; Code: - -(defvar paths-load-path-depth 1 - "Depth of load-path searches in core Lisp paths.") - -(defvar paths-default-info-directories - (list (paths-construct-path '("usr" "local" "info") - (char-to-string directory-sep-char)) - (paths-construct-path '("usr" "info") - (char-to-string directory-sep-char))) - "Directories appended to the end of the info path by default.") - -(defun paths-find-site-lisp-directory (roots) - "Find the site Lisp directory of the XEmacs hierarchy." - (paths-find-site-directory roots "site-lisp" - nil - configure-site-directory)) - -(defun paths-find-site-module-directory (roots) - "Find the site modules directory of the XEmacs hierarchy." - (paths-find-site-directory roots "site-modules" - nil - configure-site-module-directory)) - -(defun paths-find-lisp-directory (roots) - "Find the main Lisp directory of the XEmacs hierarchy." - (paths-find-version-directory roots "lisp" - nil - configure-lisp-directory)) - -(defun paths-find-module-directory (roots) - "Find the main modules directory of the XEmacs hierarchy." - (paths-find-architecture-directory roots "modules" - configure-module-directory)) - -(defun paths-construct-load-path - (roots early-package-load-path late-package-load-path last-package-load-path - lisp-directory - &optional site-lisp-directory) - "Construct the load path." - (let* ((envvar-value (getenv "EMACSLOADPATH")) - (env-load-path - (and envvar-value - (paths-decode-directory-path envvar-value 'drop-empties))) - (site-lisp-load-path - (and site-lisp-directory - (paths-find-recursive-load-path (list site-lisp-directory) - paths-load-path-depth))) - (lisp-load-path - (and lisp-directory - (paths-find-recursive-load-path (list lisp-directory) - paths-load-path-depth)))) - (append env-load-path - early-package-load-path - site-lisp-load-path - late-package-load-path - lisp-load-path - last-package-load-path))) - -(defun paths-construct-module-load-path - (root module-directory &optional site-module-directory) - "Construct the modules load path." - (let* ((envvar-value (getenv "EMACSMODULEPATH")) - (env-module-path - (and envvar-value - (paths-decode-directory-path envvar-value 'drop-empties))) - (site-module-load-path - (and site-module-directory - (paths-find-recursive-load-path (list site-module-directory) - paths-load-path-depth))) - (module-load-path - (and module-directory - (paths-find-recursive-load-path (list module-directory) - paths-load-path-depth)))) - (append env-module-path - site-module-load-path - module-load-path))) - -(defun paths-construct-info-path (roots early-packages late-packages last-packages) - "Construct the info path." - (let ((info-path-envval (getenv "INFOPATH"))) - (paths-uniq-append - (append - (let ((info-directory - (paths-find-version-directory roots "info" - nil - configure-info-directory))) - (and info-directory - (list info-directory))) - (packages-find-package-info-path early-packages) - (packages-find-package-info-path late-packages) - (packages-find-package-info-path last-packages) - (and info-path-envval - (paths-decode-directory-path info-path-envval 'drop-empties))) - (and (null info-path-envval) - (paths-uniq-append - (paths-directories-which-exist configure-info-path) - (paths-directories-which-exist paths-default-info-directories)))))) - -(defun paths-find-doc-directory (roots) - "Find the documentation directory." - (paths-find-architecture-directory roots "lib-src")) - -(defun paths-find-lock-directory (roots) - "Find the lock directory." - (defvar configure-lock-directory) - (paths-find-site-directory roots "lock" "EMACSLOCKDIR" configure-lock-directory)) - -(defun paths-find-superlock-file (lock-directory) - "Find the superlock file." - ;; #### There is no such variable configure-superlock-file! - (cond - ((null lock-directory) - nil) - ((and configure-superlock-file - (file-directory-p (file-name-directory configure-superlock-file))) - configure-superlock-file) - (t - (expand-file-name "!!!SuperLock!!!" lock-directory)))) - -(defun paths-find-exec-directory (roots) - "Find the binary directory." - (paths-find-architecture-directory roots "lib-src" configure-exec-directory)) - -(defun paths-construct-exec-path (roots exec-directory - early-packages late-packages last-packages) - "Find the binary path." - (append - (let ((path-envval (getenv "PATH"))) - (if path-envval - (paths-decode-directory-path path-envval 'drop-empties))) - (packages-find-package-exec-path early-packages) - (packages-find-package-exec-path late-packages) - (let ((emacspath-envval (getenv "EMACSPATH"))) - (and emacspath-envval - (split-path emacspath-envval))) - (and exec-directory - (list exec-directory)) - (packages-find-package-exec-path last-packages))) - -(defun paths-find-data-directory (roots) - "Find the data directory." - (paths-find-version-directory roots "etc" "EMACSDATA" configure-data-directory)) - -(defun paths-construct-data-directory-list (data-directory - early-packages late-packages last-packages) - "Find the data path." - (append - (packages-find-package-data-path early-packages) - (packages-find-package-data-path late-packages) - (list data-directory) - (packages-find-package-data-path last-packages))) - -;;; setup-paths.el ends here diff --git a/lisp/shadow.el b/lisp/shadow.el deleted file mode 100644 index 1a27d8d..0000000 --- a/lisp/shadow.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; shadow.el --- Locate Emacs Lisp file shadowings. - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; Author: Terry Jones -;; Keywords: lisp -;; Created: 15 December 1995 - -;; 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. - -;; 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 functions in this file detect (`find-emacs-lisp-shadows') -;; and display (`list-load-path-shadows') potential load-path -;; problems that arise when Emacs Lisp files "shadow" each other. -;; -;; For example, a file XXX.el early in one's load-path will shadow -;; a file with the same name in a later load-path directory. When -;; this is unintentional, it may result in problems that could have -;; been easily avoided. This occurs often (to me) when installing a -;; new version of emacs and something in the site-lisp directory -;; has been updated and added to the emacs distribution. The old -;; version, now outdated, shadows the new one. This is obviously -;; undesirable. -;; -;; The `list-load-path-shadows' function was run when you installed -;; this version of emacs. To run it by hand in emacs: -;; -;; M-x load-library RET shadow RET -;; M-x list-load-path-shadows -;; -;; or run it non-interactively via: -;; -;; emacs -batch -l shadow.el -f list-load-path-shadows -;; -;; Thanks to Francesco Potorti` for suggestions, -;; rewritings & speedups. - -;; 1998-08-15 Martin Buchholz: Speed up using hash tables instead of lists. - -;;; Code: - -(defun find-emacs-lisp-shadows (&optional path) - "Return a list of Emacs Lisp files that create shadows. -This function does the work for `list-load-path-shadows'. - -We traverse PATH looking for shadows, and return a \(possibly empty\) -even-length list of files. A file in this list at position 2i shadows -the file in position 2i+1. Emacs Lisp file suffixes \(.el and .elc\) -are stripped from the file names in the list. - -See the documentation for `list-load-path-shadows' for further information." - - (let (shadows ; List of shadowings, to be returned. - dir ; The dir being currently scanned. - curr-files ; This dir's Emacs Lisp files. - orig-dir ; Where the file was first seen. - (file-dirs ; File names ever seen, with dirs. - (make-hash-table :size 2000 :test 'equal)) - (true-names ; Dirs ever considered. - (make-hash-table :size 50 :test 'equal)) - (files-seen-this-dir ; Files seen so far in this dir. - (make-hash-table :size 100 :test 'equal)) - ) - - (dolist (path-elt (or path load-path)) - - (setq dir (file-truename (or path-elt "."))) - (if (gethash dir true-names) - ;; We have already considered this PATH redundant directory. - ;; Show the redundancy if we are interactive, unless the PATH - ;; dir is nil or "." (these redundant directories are just a - ;; result of the current working directory, and are therefore - ;; not always redundant). - (or noninteractive - (and path-elt - (not (string= path-elt ".")) - (message "Ignoring redundant directory %s" path-elt))) - - (puthash dir t true-names) - (setq dir (or path-elt ".")) - (setq curr-files (if (file-accessible-directory-p dir) - (directory-files dir nil ".\\.elc?$" t))) - (and curr-files - (not noninteractive) - (message "Checking %d files in %s..." (length curr-files) dir)) - - (clrhash files-seen-this-dir) - - (dolist (file curr-files) - - (setq file (substring - file 0 (if (string= (substring file -1) "c") -4 -3))) - - ;; FILE now contains the current file name, with no suffix. - (unless (or (gethash file files-seen-this-dir) - ;; Ignore these files. - (member file - '("subdirs" - "auto-autoloads" - "custom-load" - "dumped-lisp" - "_pkg" - "lpath"))) - ;; File has not been seen yet in this directory. - ;; This test prevents us declaring that XXX.el shadows - ;; XXX.elc (or vice-versa) when they are in the same directory. - (puthash file t files-seen-this-dir) - - (if (setq orig-dir (gethash file file-dirs)) - ;; This file was seen before, we have a shadowing. - (setq shadows - (nconc shadows - (list (concat (file-name-as-directory orig-dir) - file) - (concat (file-name-as-directory dir) - file)))) - - ;; Not seen before, add it to the list of seen files. - (puthash file dir file-dirs)))))) - - ;; Return the list of shadowings. - shadows)) - - -;;;###autoload -(defun list-load-path-shadows () - "Display a list of Emacs Lisp files that shadow other files. - -This function lists potential load-path problems. Directories in the -`load-path' variable are searched, in order, for Emacs Lisp -files. When a previously encountered file name is found again, a -message is displayed indicating that the later file is \"hidden\" by -the earlier. - -For example, suppose `load-path' is set to - -\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\"\) - -and that each of these directories contains a file called XXX.el. Then -XXX.el in the site-lisp directory is referred to by all of: -\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc. - -The first XXX.el file prevents emacs from seeing the second \(unless -the second is loaded explicitly via load-file\). - -When not intended, such shadowings can be the source of subtle -problems. For example, the above situation may have arisen because the -XXX package was not distributed with versions of emacs prior to -19.30. An emacs maintainer downloaded XXX from elsewhere and installed -it. Later, XXX was updated and included in the emacs distribution. -Unless the emacs maintainer checks for this, the new version of XXX -will be hidden behind the old \(which may no longer work with the new -emacs version\). - -This function performs these checks and flags all possible -shadowings. Because a .el file may exist without a corresponding .elc -\(or vice-versa\), these suffixes are essentially ignored. A file -XXX.elc in an early directory \(that does not contain XXX.el\) is -considered to shadow a later file XXX.el, and vice-versa. - -When run interactively, the shadowings \(if any\) are displayed in a -buffer called `*Shadows*'. Shadowings are located by calling the -\(non-interactive\) companion function, `find-emacs-lisp-shadows'." - - (interactive) - (let* ((path (copy-sequence load-path)) - (tem path) - toplevs) - ;; If we can find simple.el in two places, - (while tem - (if (file-exists-p (expand-file-name "simple.el" (car tem))) - (setq toplevs (cons (car tem) toplevs))) - (setq tem (cdr tem))) - (if (> (length toplevs) 1) - ;; Cut off our copy of load-path right before - ;; the second directory which has simple.el in it. - ;; This avoids loads of duplications between the source dir - ;; and the dir where these files were copied by installation. - (let ((break (nth (- (length toplevs) 2) toplevs))) - (setq tem path) - (while tem - (if (eq (nth 1 tem) break) - (progn - (setcdr tem nil) - (setq tem nil))) - (setq tem (cdr tem))))) - - (let* ((shadows (find-emacs-lisp-shadows path)) - (n (/ (length shadows) 2)) - (msg (format "%s Emacs Lisp load-path shadowing%s found" - (if (zerop n) "No" (concat "\n" (number-to-string n))) - (if (= n 1) " was" "s were")))) - (if (interactive-p) - (save-excursion - ;; We are interactive. - ;; Create the *Shadows* buffer and display shadowings there. - (let ((output-buffer (get-buffer-create "*Shadows*"))) - (display-buffer output-buffer) - (set-buffer output-buffer) - (erase-buffer) - (while shadows - (insert (format "%s hides %s\n" (car shadows) - (car (cdr shadows)))) - (setq shadows (cdr (cdr shadows)))) - (insert msg "\n"))) - ;; We are non-interactive, print shadows via message. - (when shadows - (message "This site has duplicate Lisp libraries with the same name. -If a locally-installed Lisp library overrides a library in the Emacs release, -that can cause trouble, and you should probably remove the locally-installed -version unless you know what you are doing.\n") - (while shadows - (message "%s hides %s" (car shadows) (car (cdr shadows))) - (setq shadows (cdr (cdr shadows)))) - (message "%s" msg)))))) - -(provide 'shadow) - -;;; shadow.el ends here diff --git a/lisp/simple.el b/lisp/simple.el deleted file mode 100644 index 74daf55..0000000 --- a/lisp/simple.el +++ /dev/null @@ -1,4096 +0,0 @@ -;;; simple.el --- basic editing commands for XEmacs - -;; Copyright (C) 1985-7, 1993-5, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -;; Maintainer: XEmacs Development Team -;; Keywords: lisp, extensions, internal, dumped - -;; 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 [But not very closely]. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; A grab-bag of basic XEmacs commands not specifically related to some -;; major mode or to file-handling. - -;; Changes for zmacs-style active-regions: -;; -;; beginning-of-buffer, end-of-buffer, count-lines-region, -;; count-lines-buffer, what-line, what-cursor-position, set-goal-column, -;; set-fill-column, prefix-arg-internal, and line-move (which is used by -;; next-line and previous-line) set zmacs-region-stays to t, so that they -;; don't affect the current region-hilighting state. -;; -;; mark-whole-buffer, mark-word, exchange-point-and-mark, and -;; set-mark-command (without an argument) call zmacs-activate-region. -;; -;; mark takes an optional arg like the new Fmark_marker() does. When -;; the region is not active, mark returns nil unless the optional arg is true. -;; -;; push-mark, pop-mark, exchange-point-and-mark, and set-marker, and -;; set-mark-command use (mark t) so that they can access the mark whether -;; the region is active or not. -;; -;; shell-command, shell-command-on-region, yank, and yank-pop (which all -;; push a mark) have been altered to call exchange-point-and-mark with an -;; argument, meaning "don't activate the region". These commands only use -;; exchange-point-and-mark to position the newly-pushed mark correctly, so -;; this isn't a user-visible change. These functions have also been altered -;; to use (mark t) for the same reason. - -;; 97/3/14 Jareth Hein (jhod@po.iijnet.or.jp) added kinsoku processing (support -;; for filling of Asian text) into the fill code. This was ripped bleeding from -;; Mule-2.3, and could probably use some feature additions (like additional wrap -;; styles, etc) - -;; 97/06/11 Steve Baur (steve@altair.xemacs.org) Convert use of -;; (preceding|following)-char to char-(after|before). - -;;; Code: - -(defgroup editing-basics nil - "Most basic editing variables." - :group 'editing) - -(defgroup killing nil - "Killing and yanking commands." - :group 'editing) - -(defgroup fill-comments nil - "Indenting and filling of comments." - :prefix "comment-" - :group 'fill) - -(defgroup paren-matching nil - "Highlight (un)matching of parens and expressions." - :prefix "paren-" - :group 'matching) - -(defgroup log-message nil - "Messages logging and display customizations." - :group 'minibuffer) - -(defgroup warnings nil - "Warnings customizations." - :group 'minibuffer) - - -(defcustom search-caps-disable-folding t - "*If non-nil, upper case chars disable case fold searching. -This does not apply to \"yanked\" strings." - :type 'boolean - :group 'editing-basics) - -;; This is stolen (and slightly modified) from FSF emacs's -;; `isearch-no-upper-case-p'. -(defun no-upper-case-p (string &optional regexp-flag) - "Return t if there are no upper case chars in STRING. -If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\') -since they have special meaning in a regexp." - (let ((case-fold-search nil)) - (not (string-match (if regexp-flag - "\\(^\\|\\\\\\\\\\|[^\\]\\)[A-Z]" - "[A-Z]") - string)) - )) - -(defmacro with-search-caps-disable-folding (string regexp-flag &rest body) "\ -Eval BODY with `case-fold-search' let to nil if `search-caps-disable-folding' -is non-nil, and if STRING (either a string or a regular expression according -to REGEXP-FLAG) contains uppercase letters." - `(let ((case-fold-search - (if (and case-fold-search search-caps-disable-folding) - (no-upper-case-p ,string ,regexp-flag) - case-fold-search))) - ,@body)) -(put 'with-search-caps-disable-folding 'lisp-indent-function 2) -(put 'with-search-caps-disable-folding 'edebug-form-spec - '(sexp sexp &rest form)) - -(defmacro with-interactive-search-caps-disable-folding (string regexp-flag - &rest body) - "Same as `with-search-caps-disable-folding', but only in the case of a -function called interactively." - `(let ((case-fold-search - (if (and (interactive-p) - case-fold-search search-caps-disable-folding) - (no-upper-case-p ,string ,regexp-flag) - case-fold-search))) - ,@body)) -(put 'with-interactive-search-caps-disable-folding 'lisp-indent-function 2) -(put 'with-interactive-search-caps-disable-folding 'edebug-form-spec - '(sexp sexp &rest form)) - -(defun newline (&optional arg) - "Insert a newline, and move to left margin of the new line if it's blank. -The newline is marked with the text-property `hard'. -With arg, insert that many newlines. -In Auto Fill mode, if no numeric arg, break the preceding line if it's long." - (interactive "*P") - (barf-if-buffer-read-only nil (point)) - ;; Inserting a newline at the end of a line produces better redisplay in - ;; try_window_id than inserting at the beginning of a line, and the textual - ;; result is the same. So, if we're at beginning of line, pretend to be at - ;; the end of the previous line. - ;; #### Does this have any relevance in XEmacs? - (let ((flag (and (not (bobp)) - (bolp) - ;; Make sure the newline before point isn't intangible. - (not (get-char-property (1- (point)) 'intangible)) - ;; Make sure the newline before point isn't read-only. - (not (get-char-property (1- (point)) 'read-only)) - ;; Make sure the newline before point isn't invisible. - (not (get-char-property (1- (point)) 'invisible)) - ;; This should probably also test for the previous char - ;; being the *last* character too. - (not (get-char-property (1- (point)) 'end-open)) - ;; Make sure the newline before point has the same - ;; properties as the char before it (if any). - (< (or (previous-extent-change (point)) -2) - (- (point) 2)))) - (was-page-start (and (bolp) - (looking-at page-delimiter))) - (beforepos (point))) - (if flag (backward-char 1)) - ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. - ;; Set last-command-char to tell self-insert what to insert. - (let ((last-command-char ?\n) - ;; Don't auto-fill if we have a numeric argument. - ;; Also not if flag is true (it would fill wrong line); - ;; there is no need to since we're at BOL. - (auto-fill-function (if (or arg flag) nil auto-fill-function))) - (unwind-protect - (self-insert-command (prefix-numeric-value arg)) - ;; If we get an error in self-insert-command, put point at right place. - (if flag (forward-char 1)))) - ;; If we did *not* get an error, cancel that forward-char. - (if flag (backward-char 1)) - ;; Mark the newline(s) `hard'. - (if use-hard-newlines - (let* ((from (- (point) (if arg (prefix-numeric-value arg) 1))) - (sticky (get-text-property from 'end-open))) ; XEmacs - (put-text-property from (point) 'hard 't) - ;; If end-open is not "t", add 'hard to end-open list - (if (and (listp sticky) (not (memq 'hard sticky))) - (put-text-property from (point) 'end-open ; XEmacs - (cons 'hard sticky))))) - ;; If the newline leaves the previous line blank, - ;; and we have a left margin, delete that from the blank line. - (or flag - (save-excursion - (goto-char beforepos) - (beginning-of-line) - (and (looking-at "[ \t]$") - (> (current-left-margin) 0) - (delete-region (point) (progn (end-of-line) (point)))))) - (if flag (forward-char 1)) - ;; Indent the line after the newline, except in one case: - ;; when we added the newline at the beginning of a line - ;; which starts a page. - (or was-page-start - (move-to-left-margin nil t))) - nil) - -(defun set-hard-newline-properties (from to) - (let ((sticky (get-text-property from 'rear-nonsticky))) - (put-text-property from to 'hard 't) - ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list - (if (and (listp sticky) (not (memq 'hard sticky))) - (put-text-property from (point) 'rear-nonsticky - (cons 'hard sticky))))) - -(defun open-line (arg) - "Insert a newline and leave point before it. -If there is a fill prefix and/or a left-margin, insert them on the new line -if the line would have been blank. -With arg N, insert N newlines." - (interactive "*p") - (let* ((do-fill-prefix (and fill-prefix (bolp))) - (do-left-margin (and (bolp) (> (current-left-margin) 0))) - (loc (point))) - (newline arg) - (goto-char loc) - (while (> arg 0) - (cond ((bolp) - (if do-left-margin (indent-to (current-left-margin))) - (if do-fill-prefix (insert fill-prefix)))) - (forward-line 1) - (setq arg (1- arg))) - (goto-char loc) - (end-of-line))) - -(defun split-line () - "Split current line, moving portion beyond point vertically down." - (interactive "*") - (skip-chars-forward " \t") - (let ((col (current-column)) - (pos (point))) - (newline 1) - (indent-to col 0) - (goto-char pos))) - -(defun quoted-insert (arg) - "Read next input character and insert it. -This is useful for inserting control characters. -You may also type up to 3 octal digits, to insert a character with that code. - -In overwrite mode, this function inserts the character anyway, and -does not handle octal digits specially. This means that if you use -overwrite as your normal editing mode, you can use this function to -insert characters when necessary. - -In binary overwrite mode, this function does overwrite, and octal -digits are interpreted as a character code. This is supposed to make -this function useful in editing binary files." - (interactive "*p") - (let ((char (if (or (not overwrite-mode) - (eq overwrite-mode 'overwrite-mode-binary)) - (read-quoted-char) - ;; read-char obeys C-g, so we should protect. FSF - ;; doesn't have the protection here, but it's a bug in - ;; FSF. - (let ((inhibit-quit t)) - (read-char))))) - (if (> arg 0) - (if (eq overwrite-mode 'overwrite-mode-binary) - (delete-char arg))) - (while (> arg 0) - (insert char) - (setq arg (1- arg))))) - -(defun delete-indentation (&optional arg) - "Join this line to previous and fix up whitespace at join. -If there is a fill prefix, delete it from the beginning of this line. -With argument, join this line to following line." - (interactive "*P") - (beginning-of-line) - (if arg (forward-line 1)) - (if (eq (char-before (point)) ?\n) - (progn - (delete-region (point) (1- (point))) - ;; If the second line started with the fill prefix, - ;; delete the prefix. - (if (and fill-prefix - (<= (+ (point) (length fill-prefix)) (point-max)) - (string= fill-prefix - (buffer-substring (point) - (+ (point) (length fill-prefix))))) - (delete-region (point) (+ (point) (length fill-prefix)))) - (fixup-whitespace)))) - -(defun fixup-whitespace () - "Fixup white space between objects around point. -Leave one space or none, according to the context." - (interactive "*") - (save-excursion - (delete-horizontal-space) - (if (or (looking-at "^\\|\\s)") - (save-excursion (forward-char -1) - (looking-at "$\\|\\s(\\|\\s'"))) - nil - (insert ?\ )))) - -(defun delete-horizontal-space () - "Delete all spaces and tabs around point." - (interactive "*") - (skip-chars-backward " \t") - (delete-region (point) (progn (skip-chars-forward " \t") (point)))) - -(defun just-one-space () - "Delete all spaces and tabs around point, leaving one space." - (interactive "*") - (if abbrev-mode ; XEmacs - (expand-abbrev)) - (skip-chars-backward " \t") - (if (eq (char-after (point)) ? ) ; XEmacs - (forward-char 1) - (insert ? )) - (delete-region (point) (progn (skip-chars-forward " \t") (point)))) - -(defun delete-blank-lines () - "On blank line, delete all surrounding blank lines, leaving just one. -On isolated blank line, delete that one. -On nonblank line, delete any immediately following blank lines." - (interactive "*") - (let (thisblank singleblank) - (save-excursion - (beginning-of-line) - (setq thisblank (looking-at "[ \t]*$")) - ;; Set singleblank if there is just one blank line here. - (setq singleblank - (and thisblank - (not (looking-at "[ \t]*\n[ \t]*$")) - (or (bobp) - (progn (forward-line -1) - (not (looking-at "[ \t]*$"))))))) - ;; Delete preceding blank lines, and this one too if it's the only one. - (if thisblank - (progn - (beginning-of-line) - (if singleblank (forward-line 1)) - (delete-region (point) - (if (re-search-backward "[^ \t\n]" nil t) - (progn (forward-line 1) (point)) - (point-min))))) - ;; Delete following blank lines, unless the current line is blank - ;; and there are no following blank lines. - (if (not (and thisblank singleblank)) - (save-excursion - (end-of-line) - (forward-line 1) - (delete-region (point) - (if (re-search-forward "[^ \t\n]" nil t) - (progn (beginning-of-line) (point)) - (point-max))))) - ;; Handle the special case where point is followed by newline and eob. - ;; Delete the line, leaving point at eob. - (if (looking-at "^[ \t]*\n\\'") - (delete-region (point) (point-max))))) - -(defun back-to-indentation () - "Move point to the first non-whitespace character on this line." - ;; XEmacs change - (interactive "_") - (beginning-of-line 1) - (skip-chars-forward " \t")) - -(defun newline-and-indent () - "Insert a newline, then indent according to major mode. -Indentation is done using the value of `indent-line-function'. -In programming language modes, this is the same as TAB. -In some text modes, where TAB inserts a tab, this command indents to the -column specified by the function `current-left-margin'." - (interactive "*") - (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (newline) - (indent-according-to-mode)) - -(defun reindent-then-newline-and-indent () - "Reindent current line, insert newline, then indent the new line. -Indentation of both lines is done according to the current major mode, -which means calling the current value of `indent-line-function'. -In programming language modes, this is the same as TAB. -In some text modes, where TAB inserts a tab, this indents to the -column specified by the function `current-left-margin'." - (interactive "*") - (save-excursion - (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (indent-according-to-mode)) - (newline) - (indent-according-to-mode)) - -;; Internal subroutine of delete-char -(defun kill-forward-chars (arg) - (if (listp arg) (setq arg (car arg))) - (if (eq arg '-) (setq arg -1)) - (kill-region (point) (+ (point) arg))) - -;; Internal subroutine of backward-delete-char -(defun kill-backward-chars (arg) - (if (listp arg) (setq arg (car arg))) - (if (eq arg '-) (setq arg -1)) - (kill-region (point) (- (point) arg))) - -(defun backward-delete-char-untabify (arg &optional killp) - "Delete characters backward, changing tabs into spaces. -Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil. -Interactively, ARG is the prefix arg (default 1) -and KILLP is t if a prefix arg was specified." - (interactive "*p\nP") - (let ((count arg)) - (save-excursion - (while (and (> count 0) (not (bobp))) - (if (eq (char-before (point)) ?\t) ; XEmacs - (let ((col (current-column))) - (forward-char -1) - (setq col (- col (current-column))) - (insert-char ?\ col) - (delete-char 1))) - (forward-char -1) - (setq count (1- count))))) - (delete-backward-char arg killp) - ;; XEmacs: In overwrite mode, back over columns while clearing them out, - ;; unless at end of line. - (and overwrite-mode (not (eolp)) - (save-excursion (insert-char ?\ arg)))) - -(defcustom delete-key-deletes-forward t - "*If non-nil, the DEL key will erase one character forwards. -If nil, the DEL key will erase one character backwards." - :type 'boolean - :group 'editing-basics) - -(defcustom backward-delete-function 'backward-delete-char - "*Function called to delete backwards on a delete keypress. -If `delete-key-deletes-forward' is nil, `backward-or-forward-delete-char' -calls this function to erase one character backwards. Default value -is 'backward-delete-char, with 'backward-delete-char-untabify being a -popular alternate setting." - :type 'function - :group 'editing-basics) - -;; Trash me, baby. -(defsubst delete-forward-p () - (and delete-key-deletes-forward - (or (not (eq (device-type) 'x)) - (x-keysym-on-keyboard-sans-modifiers-p 'backspace)))) - -(defun backward-or-forward-delete-char (arg) - "Delete either one character backwards or one character forwards. -Controlled by the state of `delete-key-deletes-forward' and whether the -BackSpace keysym even exists on your keyboard. If you don't have a -BackSpace keysym, the delete key should always delete one character -backwards." - (interactive "*p") - (if (delete-forward-p) - (delete-char arg) - (funcall backward-delete-function arg))) - -(defun backward-or-forward-kill-word (arg) - "Delete either one word backwards or one word forwards. -Controlled by the state of `delete-key-deletes-forward' and whether the -BackSpace keysym even exists on your keyboard. If you don't have a -BackSpace keysym, the delete key should always delete one character -backwards." - (interactive "*p") - (if (delete-forward-p) - (kill-word arg) - (backward-kill-word arg))) - -(defun backward-or-forward-kill-sentence (arg) - "Delete either one sentence backwards or one sentence forwards. -Controlled by the state of `delete-key-deletes-forward' and whether the -BackSpace keysym even exists on your keyboard. If you don't have a -BackSpace keysym, the delete key should always delete one character -backwards." - (interactive "*P") - (if (delete-forward-p) - (kill-sentence arg) - (backward-kill-sentence (prefix-numeric-value arg)))) - -(defun backward-or-forward-kill-sexp (arg) - "Delete either one sexpr backwards or one sexpr forwards. -Controlled by the state of `delete-key-deletes-forward' and whether the -BackSpace keysym even exists on your keyboard. If you don't have a -BackSpace keysym, the delete key should always delete one character -backwards." - (interactive "*p") - (if (delete-forward-p) - (kill-sexp arg) - (backward-kill-sexp arg))) - -(defun zap-to-char (arg char) - "Kill up to and including ARG'th occurrence of CHAR. -Goes backward if ARG is negative; error if CHAR not found." - (interactive "*p\ncZap to char: ") - (kill-region (point) (with-interactive-search-caps-disable-folding - (char-to-string char) nil - (search-forward (char-to-string char) nil nil arg) - (point)))) - -(defun zap-up-to-char (arg char) - "Kill up to ARG'th occurrence of CHAR. -Goes backward if ARG is negative; error if CHAR not found." - (interactive "*p\ncZap up to char: ") - (kill-region (point) (with-interactive-search-caps-disable-folding - (char-to-string char) nil - (search-forward (char-to-string char) nil nil arg) - (goto-char (if (> arg 0) (1- (point)) (1+ (point)))) - (point)))) - -(defun beginning-of-buffer (&optional arg) - "Move point to the beginning of the buffer; leave mark at previous position. -With arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." - ;; XEmacs change - (interactive "_P") - (push-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (+ (point-min) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) - (point-min)))) - (if arg (forward-line 1))) - -(defun end-of-buffer (&optional arg) - "Move point to the end of the buffer; leave mark at previous position. -With arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster and avoids clobbering the mark." - ;; XEmacs change - (interactive "_P") - (push-mark) - ;; XEmacs changes here. - (let ((scroll-to-end (not (pos-visible-in-window-p (point-max)))) - (size (- (point-max) (point-min)))) - (goto-char (if arg - (- (point-max) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (* size (prefix-numeric-value arg)) 10))) - (point-max))) - (cond (arg - ;; If we went to a place in the middle of the buffer, - ;; adjust it to the beginning of a line. - (forward-line 1)) - ;; XEmacs change - (scroll-to-end - ;; If the end of the buffer is not already on the screen, - ;; then scroll specially to put it near, but not at, the bottom. - (recenter -3))))) - -;; XEmacs (not in FSF) -(defun mark-beginning-of-buffer (&optional arg) - "Push a mark at the beginning of the buffer; leave point where it is. -With arg N, push mark N/10 of the way from the true beginning." - (interactive "P") - (push-mark (if arg - (if (> (buffer-size) 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ (buffer-size) 10)) - (/ (+ 10 (* (buffer-size) (prefix-numeric-value arg))) 10)) - (point-min)) - nil - t)) -(define-function 'mark-bob 'mark-beginning-of-buffer) - -;; XEmacs (not in FSF) -(defun mark-end-of-buffer (&optional arg) - "Push a mark at the end of the buffer; leave point where it is. -With arg N, push mark N/10 of the way from the true end." - (interactive "P") - (push-mark (if arg - (- (1+ (buffer-size)) - (if (> (buffer-size) 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ (buffer-size) 10)) - (/ (* (buffer-size) (prefix-numeric-value arg)) 10))) - (point-max)) - nil - t)) -(define-function 'mark-eob 'mark-end-of-buffer) - -(defun mark-whole-buffer () - "Put point at beginning and mark at end of buffer. -You probably should not use this function in Lisp programs; -it is usually a mistake for a Lisp function to use any subroutine -that uses or sets the mark." - (interactive) - (push-mark (point)) - (push-mark (point-max) nil t) - (goto-char (point-min))) - -;; XEmacs -(defun eval-current-buffer (&optional printflag) - "Evaluate the current buffer as Lisp code. -Programs can pass argument PRINTFLAG which controls printing of output: -nil means discard it; anything else is stream for print." - (interactive) - (eval-buffer (current-buffer) printflag)) - -;; XEmacs -(defun count-words-buffer (&optional buffer) - "Print the number of words in BUFFER. -If called noninteractively, the value is returned rather than printed. -BUFFER defaults to the current buffer." - (interactive) - (let ((words (count-words-region (point-min) (point-max) buffer))) - (when (interactive-p) - (message "Buffer has %d words" words)) - words)) - -;; XEmacs -(defun count-words-region (start end &optional buffer) - "Print the number of words in region between START and END in BUFFER. -If called noninteractively, the value is returned rather than printed. -BUFFER defaults to the current buffer." - (interactive "_r") - (save-excursion - (set-buffer (or buffer (current-buffer))) - (let ((words 0)) - (goto-char start) - (while (< (point) end) - (when (forward-word 1) - (incf words))) - (when (interactive-p) - (message "Region has %d words" words)) - words))) - -(defun count-lines-region (start end) - "Print number of lines and characters in the region." - ;; XEmacs change - (interactive "_r") - (message "Region has %d lines, %d characters" - (count-lines start end) (- end start))) - -;; XEmacs -(defun count-lines-buffer (&optional buffer) - "Print number of lines and characters in BUFFER." - (interactive) - (with-current-buffer (or buffer (current-buffer)) - (let ((cnt (count-lines (point-min) (point-max)))) - (message "Buffer has %d lines, %d characters" - cnt (- (point-max) (point-min))) - cnt))) - -;;; Modified by Bob Weiner, 8/24/95, to print narrowed line number also. -;;; Expanded by Bob Weiner, Altrasoft, on 02/12/1997 -(defun what-line () - "Print the following variants of the line number of point: - Region line - displayed line within the active region - Collapsed line - includes only selectively displayed lines; - Buffer line - physical line in the buffer; - Narrowed line - line number from the start of the buffer narrowing." - ;; XEmacs change - (interactive "_") - (let ((opoint (point)) start) - (save-excursion - (save-restriction - (if (region-active-p) - (goto-char (region-beginning)) - (goto-char (point-min))) - (widen) - (beginning-of-line) - (setq start (point)) - (goto-char opoint) - (beginning-of-line) - (let* ((buffer-line (1+ (count-lines 1 (point)))) - (narrowed-p (or (/= start 1) - (/= (point-max) (1+ (buffer-size))))) - (narrowed-line (if narrowed-p (1+ (count-lines start (point))))) - (selective-line (if selective-display - (1+ (count-lines start (point) t)))) - (region-line (if (region-active-p) - (1+ (count-lines start (point) selective-display))))) - (cond (region-line - (message "Region line %d; Buffer line %d" - region-line buffer-line)) - ((and narrowed-p selective-line (/= selective-line narrowed-line)) - ;; buffer narrowed and some lines selectively displayed - (message "Collapsed line %d; Buffer line %d; Narrowed line %d" - selective-line buffer-line narrowed-line)) - (narrowed-p - ;; buffer narrowed - (message "Buffer line %d; Narrowed line %d" - buffer-line narrowed-line)) - ((and selective-line (/= selective-line buffer-line)) - ;; some lines selectively displayed - (message "Collapsed line %d; Buffer line %d" - selective-line buffer-line)) - (t - ;; give a basic line count - (message "Line %d" buffer-line))))))) - (setq zmacs-region-stays t)) - -;;; Bob Weiner, Altrasoft, 02/12/1998 -;;; Added the 3rd arg in `count-lines' to conditionalize the counting of -;;; collapsed lines. -(defun count-lines (start end &optional ignore-invisible-lines-flag) - "Return number of lines between START and END. -This is usually the number of newlines between them, -but can be one more if START is not equal to END -and the greater of them is not at the start of a line. - -With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with -selective-display are excluded from the line count." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (if (and (not ignore-invisible-lines-flag) (eq selective-display t)) - (save-match-data - (let ((done 0)) - (while (re-search-forward "[\n\C-m]" nil t 40) - (setq done (+ 40 done))) - (while (re-search-forward "[\n\C-m]" nil t 1) - (setq done (+ 1 done))) - (goto-char (point-max)) - (if (and (/= start end) - (not (bolp))) - (1+ done) - done))) - (- (buffer-size) (forward-line (buffer-size))))))) - -(defun what-cursor-position () - "Print info on cursor position (on screen and within buffer)." - ;; XEmacs change - (interactive "_") - (let* ((char (char-after (point))) ; XEmacs - (beg (point-min)) - (end (point-max)) - (pos (point)) - (total (buffer-size)) - (percent (if (> total 50000) - ;; Avoid overflow from multiplying by 100! - (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1)) - (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1)))) - (hscroll (if (= (window-hscroll) 0) - "" - (format " Hscroll=%d" (window-hscroll)))) - (col (+ (current-column) (if column-number-start-at-one 1 0)))) - (if (= pos end) - (if (or (/= beg 1) (/= end (1+ total))) - (message "point=%d of %d(%d%%) <%d - %d> column %d %s" - pos total percent beg end col hscroll) - (message "point=%d of %d(%d%%) column %d %s" - pos total percent col hscroll)) - ;; XEmacs: don't use single-key-description - (if (or (/= beg 1) (/= end (1+ total))) - (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) <%d - %d> column %d %s" - (text-char-description char) char char char pos total - percent beg end col hscroll) - (message "Char: %s (0%o, %d, 0x%x) point=%d of %d(%d%%) column %d %s" - (text-char-description char) char char char pos total - percent col hscroll))))) - -(defun fundamental-mode () - "Major mode not specialized for anything in particular. -Other major modes are defined by comparison with this one." - (interactive) - (kill-all-local-variables)) - -;; XEmacs the following are declared elsewhere -;(defvar read-expression-map (cons 'keymap minibuffer-local-map) -; "Minibuffer keymap used for reading Lisp expressions.") -;(define-key read-expression-map "\M-\t" 'lisp-complete-symbol) - -;(put 'eval-expression 'disabled t) - -;(defvar read-expression-history nil) - -;; We define this, rather than making `eval' interactive, -;; for the sake of completion of names like eval-region, eval-current-buffer. -(defun eval-expression (expression &optional eval-expression-insert-value) - "Evaluate EXPRESSION and print value in minibuffer. -Value is also consed on to front of the variable `values'. -With prefix argument, insert the result to the current buffer." - ;(interactive "xEval: ") - (interactive - (list (read-from-minibuffer "Eval: " - nil read-expression-map t - 'read-expression-history) - current-prefix-arg)) - (setq values (cons (eval expression) values)) - (prin1 (car values) - (if eval-expression-insert-value (current-buffer) t))) - -;; XEmacs -- extra parameter (variant, but equivalent logic) -(defun edit-and-eval-command (prompt command &optional history) - "Prompting with PROMPT, let user edit COMMAND and eval result. -COMMAND is a Lisp expression. Let user edit that expression in -the minibuffer, then read and evaluate the result." - (let ((command (read-expression prompt - ;; first try to format the thing readably; - ;; and if that fails, print it normally. - (condition-case () - (let ((print-readably t)) - (prin1-to-string command)) - (error (prin1-to-string command))) - (or history '(command-history . 1))))) - (or history (setq history 'command-history)) - (if (consp history) - (setq history (car history))) - (if (eq history t) - nil - ;; If command was added to the history as a string, - ;; get rid of that. We want only evallable expressions there. - (if (stringp (car (symbol-value history))) - (set history (cdr (symbol-value history)))) - - ;; If command to be redone does not match front of history, - ;; add it to the history. - (or (equal command (car (symbol-value history))) - (set history (cons command (symbol-value history))))) - (eval command))) - -(defun repeat-complex-command (arg) - "Edit and re-evaluate last complex command, or ARGth from last. -A complex command is one which used the minibuffer. -The command is placed in the minibuffer as a Lisp form for editing. -The result is executed, repeating the command as changed. -If the command has been changed or is not the most recent previous command -it is added to the front of the command history. -You can use the minibuffer history commands \\\\[next-history-element] and \\[previous-history-element] -to get different commands to edit and resubmit." - (interactive "p") - ;; XEmacs: It looks like our version is better -sb - (let ((print-level nil)) - (edit-and-eval-command "Redo: " - (or (nth (1- arg) command-history) - (error "")) - (cons 'command-history arg)))) - -;; XEmacs: Functions moved to minibuf.el -;; previous-matching-history-element -;; next-matching-history-element -;; next-history-element -;; previous-history-element -;; next-complete-history-element -;; previous-complete-history-element - -(defun goto-line (arg) - "Goto line ARG, counting from line 1 at beginning of buffer." - (interactive "NGoto line: ") - (setq arg (prefix-numeric-value arg)) - (save-restriction - (widen) - (goto-char 1) - (if (eq selective-display t) - (re-search-forward "[\n\C-m]" nil 'end (1- arg)) - (forward-line (1- arg))))) - -;Put this on C-x u, so we can force that rather than C-_ into startup msg -(define-function 'advertised-undo 'undo) - -(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") - ;; If we don't get all the way through, make last-command indicate that - ;; for the following command. - (setq this-command t) - (let ((modified (buffer-modified-p)) - (recent-save (recent-auto-save-p))) - (or (eq (selected-window) (minibuffer-window)) - (display-message 'command "Undo!")) - (or (and (eq last-command 'undo) - (eq (current-buffer) last-undo-buffer)) ; XEmacs - (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. - (let ((tail buffer-undo-list) - done) - (while (and tail (not done) (not (null (car tail)))) - (if (integerp (car tail)) - (progn - (setq done t) - (setq buffer-undo-list (delq (car tail) buffer-undo-list)))) - (setq tail (cdr tail)))) - (and modified (not (buffer-modified-p)) - (delete-auto-save-file-if-necessary recent-save))) - ;; If we do get all the way through, make this-command indicate that. - (setq this-command 'undo)) - -(defvar pending-undo-list nil - "Within a run of consecutive undo commands, list remaining to be undone.") - -(defvar last-undo-buffer nil) ; XEmacs - -(defun undo-start () - "Set `pending-undo-list' to the front of the undo list. -The next call to `undo-more' will undo the most recently made change." - (if (eq buffer-undo-list t) - (error "No undo information in this buffer")) - (setq pending-undo-list buffer-undo-list)) - -(defun undo-more (count) - "Undo back N undo-boundaries beyond what was already undone recently. -Call `undo-start' to get ready to undo recent changes, -then call `undo-more' one or more times to undo them." - (or pending-undo-list - (error "No further undo information")) - (setq pending-undo-list (primitive-undo count pending-undo-list) - last-undo-buffer (current-buffer))) ; XEmacs - -;; XEmacs -(defun call-with-transparent-undo (fn &rest args) - "Apply FN to ARGS, and then undo all changes made by FN to the current -buffer. The undo records are processed even if FN returns non-locally. -There is no trace of the changes made by FN in the buffer's undo history. - -You can use this in a write-file-hooks function with continue-save-buffer -to make the contents of a disk file differ from its in-memory buffer." - (let ((buffer-undo-list nil) - ;; Kludge to prevent undo list truncation: - (undo-high-threshold -1) - (undo-threshold -1) - (obuffer (current-buffer))) - (unwind-protect - (apply fn args) - ;; Go to the buffer we will restore and make it writable: - (set-buffer obuffer) - (save-excursion - (let ((buffer-read-only nil)) - (save-restriction - (widen) - ;; Perform all undos, with further undo logging disabled: - (let ((tail buffer-undo-list)) - (setq buffer-undo-list t) - (while tail - (setq tail (primitive-undo (length tail) tail)))))))))) - -;; XEmacs: The following are in other files -;; shell-command-history -;; shell-command-switch -;; shell-command -;; shell-command-sentinel - - -(defconst universal-argument-map - (let ((map (make-sparse-keymap))) - (set-keymap-default-binding map 'universal-argument-other-key) - ;FSFmacs (define-key map [switch-frame] nil) - (define-key map [(t)] 'universal-argument-other-key) - (define-key map [(meta t)] 'universal-argument-other-key) - (define-key map [(control u)] 'universal-argument-more) - (define-key map [?-] 'universal-argument-minus) - (define-key map [?0] 'digit-argument) - (define-key map [?1] 'digit-argument) - (define-key map [?2] 'digit-argument) - (define-key map [?3] 'digit-argument) - (define-key map [?4] 'digit-argument) - (define-key map [?5] 'digit-argument) - (define-key map [?6] 'digit-argument) - (define-key map [?7] 'digit-argument) - (define-key map [?8] 'digit-argument) - (define-key map [?9] 'digit-argument) - map) - "Keymap used while processing \\[universal-argument].") - -(defvar universal-argument-num-events nil - "Number of argument-specifying events read by `universal-argument'. -`universal-argument-other-key' uses this to discard those events -from (this-command-keys), and reread only the final command.") - -(defun universal-argument () - "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) - (setq prefix-arg (list 4)) - (setq zmacs-region-stays t) ; XEmacs - (setq universal-argument-num-events (length (this-command-keys))) - (setq overriding-terminal-local-map universal-argument-map)) - -;; A subsequent C-u means to multiply the factor by 4 if we've typed -;; nothing but C-u's; otherwise it means to terminate the prefix arg. -(defun universal-argument-more (arg) - (interactive "_P") ; XEmacs - (if (consp arg) - (setq prefix-arg (list (* 4 (car arg)))) - (setq prefix-arg arg) - (setq overriding-terminal-local-map nil)) - (setq universal-argument-num-events (length (this-command-keys)))) - -(defun negative-argument (arg) - "Begin a negative numeric argument for the next command. -\\[universal-argument] following digits or minus sign ends the argument." - (interactive "_P") ; XEmacs - (cond ((integerp arg) - (setq prefix-arg (- arg))) - ((eq arg '-) - (setq prefix-arg nil)) - (t - (setq prefix-arg '-))) - (setq universal-argument-num-events (length (this-command-keys))) - (setq overriding-terminal-local-map universal-argument-map)) - -;; XEmacs: This function not synched with FSF -(defun digit-argument (arg) - "Part of the numeric argument for the next command. -\\[universal-argument] following digits or minus sign ends the argument." - (interactive "_P") ; XEmacs - (let* ((event last-command-event) - (key (and (key-press-event-p event) - (event-key event))) - (digit (and key (characterp key) (>= key ?0) (<= key ?9) - (- key ?0)))) - (if (null digit) - (universal-argument-other-key arg) - (cond ((integerp arg) - (setq prefix-arg (+ (* arg 10) - (if (< arg 0) (- digit) digit)))) - ((eq arg '-) - ;; Treat -0 as just -, so that -01 will work. - (setq prefix-arg (if (zerop digit) '- (- digit)))) - (t - (setq prefix-arg digit))) - (setq universal-argument-num-events (length (this-command-keys))) - (setq overriding-terminal-local-map universal-argument-map)))) - -;; For backward compatibility, minus with no modifiers is an ordinary -;; command if digits have already been entered. -(defun universal-argument-minus (arg) - (interactive "_P") ; XEmacs - (if (integerp arg) - (universal-argument-other-key arg) - (negative-argument arg))) - -;; Anything else terminates the argument and is left in the queue to be -;; executed as a command. -(defun universal-argument-other-key (arg) - (interactive "_P") ; XEmacs - (setq prefix-arg arg) - (let* ((key (this-command-keys)) - ;; FSF calls silly function `listify-key-sequence' here. - (keylist (append key nil))) - (setq unread-command-events - (append (nthcdr universal-argument-num-events keylist) - unread-command-events))) - (reset-this-command-lengths) - (setq overriding-terminal-local-map nil)) - - -;; XEmacs -- keep zmacs-region active. -(defun forward-to-indentation (arg) - "Move forward ARG lines and position at first nonblank character." - (interactive "_p") - (forward-line arg) - (skip-chars-forward " \t")) - -(defun backward-to-indentation (arg) - "Move backward ARG lines and position at first nonblank character." - (interactive "_p") - (forward-line (- arg)) - (skip-chars-forward " \t")) - -(defcustom kill-whole-line nil - "*If non-nil, `kill-line' with no arg at beg of line kills the whole line." - :type 'boolean - :group 'killing) - -(defun kill-line (&optional arg) - "Kill the rest of the current line; if no nonblanks there, kill thru newline. -With prefix argument, kill that many lines from point. -Negative arguments kill lines backward. - -When calling from a program, nil means \"no arg\", -a number counts as a prefix arg. - -If `kill-whole-line' is non-nil, then kill the whole line -when given no argument at the beginning of a line." - (interactive "*P") - (kill-region (point) - ;; Don't shift point before doing the delete; that way, - ;; undo will record the right position of point. -;; FSF -; ;; It is better to move point to the other end of the kill -; ;; before killing. That way, in a read-only buffer, point -; ;; moves across the text that is copied to the kill ring. -; ;; The choice has no effect on undo now that undo records -; ;; the value of point from before the command was run. -; (progn - (save-excursion - (if arg - (forward-line (prefix-numeric-value arg)) - (if (eobp) - (signal 'end-of-buffer nil)) - (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp))) - (forward-line 1) - (end-of-line))) - (point)))) - -;; XEmacs -(defun backward-kill-line nil - "Kill back to the beginning of the line." - (interactive) - (let ((point (point))) - (beginning-of-line nil) - (kill-region (point) point))) - - -;;;; Window system cut and paste hooks. -;;; -;;; I think that kill-hooks is a better name and more general mechanism -;;; than interprogram-cut-function (from FSFmacs). I don't like the behavior -;;; of interprogram-paste-function: ^Y should always come from the kill ring, -;;; not the X selection. But if that were provided, it should be called (and -;;; behave as) yank-hooks instead. -- jwz - -;; [... code snipped ...] - -(defcustom kill-hooks nil - "*Functions run when something is added to the XEmacs kill ring. -These functions are called with one argument, the string most recently -cut or copied. You can use this to, for example, make the most recent -kill become the X Clipboard selection." - :type 'hook - :group 'killing) - -;;; `kill-hooks' seems not sufficient because -;;; `interprogram-cut-function' requires more variable about to rotate -;;; the cut buffers. I'm afraid to change interface of `kill-hooks', -;;; so I add it. (1997-11-03 by MORIOKA Tomohiko) - -(defvar interprogram-cut-function nil - "Function to call to make a killed region available to other programs. - -Most window systems provide some sort of facility for cutting and -pasting text between the windows of different programs. -This variable holds a function that Emacs calls whenever text -is put in the kill ring, to make the new kill available to other -programs. - -The function takes one or two arguments. -The first argument, TEXT, is a string containing -the text which should be made available. -The second, PUSH, if non-nil means this is a \"new\" kill; -nil means appending to an \"old\" kill.") - -(defvar interprogram-paste-function nil - "Function to call to get text cut from other programs. - -Most window systems provide some sort of facility for cutting and -pasting text between the windows of different programs. -This variable holds a function that Emacs calls to obtain -text that other programs have provided for pasting. - -The function should be called with no arguments. If the function -returns nil, then no other program has provided such text, and the top -of the Emacs kill ring should be used. If the function returns a -string, that string should be put in the kill ring as the latest kill. - -Note that the function should return a string only if a program other -than Emacs has provided a string for pasting; if Emacs provided the -most recent string, the function should return nil. If it is -difficult to tell whether Emacs or some other program provided the -current string, it is probably good enough to return nil if the string -is equal (according to `string=') to the last text Emacs provided.") - - -;;;; The kill ring data structure. - -(defvar kill-ring nil - "List of killed text sequences. -Since the kill ring is supposed to interact nicely with cut-and-paste -facilities offered by window systems, use of this variable should -interact nicely with `interprogram-cut-function' and -`interprogram-paste-function'. The functions `kill-new', -`kill-append', and `current-kill' are supposed to implement this -interaction; you may want to use them instead of manipulating the kill -ring directly.") - -(defcustom kill-ring-max 30 - "*Maximum length of kill ring before oldest elements are thrown away." - :type 'integer - :group 'killing) - -(defvar kill-ring-yank-pointer nil - "The tail of the kill ring whose car is the last thing yanked.") - -(defun kill-new (string &optional replace) - "Make STRING the latest kill in the kill ring. -Set the kill-ring-yank pointer to point to it. -Run `kill-hooks'. -Optional second argument REPLACE non-nil means that STRING will replace -the front of the kill ring, rather than being added to the list." -; (and (fboundp 'menu-bar-update-yank-menu) -; (menu-bar-update-yank-menu string (and replace (car kill-ring)))) - (if replace - (setcar kill-ring string) - (setq kill-ring (cons string kill-ring)) - (if (> (length kill-ring) kill-ring-max) - (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))) - (setq kill-ring-yank-pointer kill-ring) - (if interprogram-cut-function - (funcall interprogram-cut-function string (not replace))) - (run-hook-with-args 'kill-hooks string)) - -(defun kill-append (string before-p) - "Append STRING to the end of the latest kill in the kill ring. -If BEFORE-P is non-nil, prepend STRING to the kill. -Run `kill-hooks'." - (kill-new (if before-p - (concat string (car kill-ring)) - (concat (car kill-ring) string)) t)) - -(defun current-kill (n &optional do-not-move) - "Rotate the yanking point by N places, and then return that kill. -If N is zero, `interprogram-paste-function' is set, and calling it -returns a string, then that string is added to the front of the -kill ring and returned as the latest kill. -If optional arg DO-NOT-MOVE is non-nil, then don't actually move the -yanking point\; just return the Nth kill forward." - (let ((interprogram-paste (and (= n 0) - interprogram-paste-function - (funcall interprogram-paste-function)))) - (if interprogram-paste - (progn - ;; Disable the interprogram cut function when we add the new - ;; text to the kill ring, so Emacs doesn't try to own the - ;; selection, with identical text. - (let ((interprogram-cut-function nil)) - (kill-new interprogram-paste)) - interprogram-paste) - (or kill-ring (error "Kill ring is empty")) - (let* ((tem (nthcdr (mod (- n (length kill-ring-yank-pointer)) - (length kill-ring)) - kill-ring))) - (or do-not-move - (setq kill-ring-yank-pointer tem)) - (car tem))))) - - - -;;;; Commands for manipulating the kill ring. - -;; In FSF killing read-only text just pastes it into kill-ring. Which -;; is a very bad idea -- see Jamie's comment below. - -;(defvar kill-read-only-ok nil -; "*Non-nil means don't signal an error for killing read-only text.") - -(defun kill-region (beg end &optional verbose) ; verbose is XEmacs addition - "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." - (interactive "*r\np") -; (interactive -; (let ((region-hack (and zmacs-regions (eq last-command 'yank)))) -; ;; This lets "^Y^W" work. I think this is dumb, but zwei did it. -; (if region-hack (zmacs-activate-region)) -; (prog1 -; (list (point) (mark) current-prefix-arg) -; (if region-hack (zmacs-deactivate-region))))) - ;; beg and end can be markers but the rest of this function is - ;; written as if they are only integers - (if (markerp beg) (setq beg (marker-position beg))) - (if (markerp end) (setq end (marker-position end))) - (or (and beg end) (if zmacs-regions ;; rewritten for I18N3 snarfing - (error "The region is not active now") - (error "The mark is not set now"))) - (if verbose (if buffer-read-only - (lmessage 'command "Copying %d characters" - (- (max beg end) (min beg end))) - (lmessage 'command "Killing %d characters" - (- (max beg end) (min beg end))))) - (cond - - ;; I don't like this large change in behavior -- jwz - ;; Read-Only text means it shouldn't be deleted, so I'm restoring - ;; this code, but only for text-properties and not full extents. -sb - ;; If the buffer is read-only, we should beep, in case the person - ;; just isn't aware of this. However, there's no harm in putting - ;; the region's text in the kill ring, anyway. - ((or (and buffer-read-only (not inhibit-read-only)) - (text-property-not-all (min beg end) (max beg end) 'read-only nil)) - ;; This is redundant. - ;; (if verbose (message "Copying %d characters" - ;; (- (max beg end) (min beg end)))) - (copy-region-as-kill beg end) - ;; ;; This should always barf, and give us the correct error. - ;; (if kill-read-only-ok - ;; (message "Read only text copied to kill ring") - (setq this-command 'kill-region) - (barf-if-buffer-read-only) - (signal 'buffer-read-only (list (current-buffer)))) - - ;; In certain cases, we can arrange for the undo list and the kill - ;; ring to share the same string object. This code does that. - ((not (or (eq buffer-undo-list t) - (eq last-command 'kill-region) - ;; Use = since positions may be numbers or markers. - (= beg end))) - ;; Don't let the undo list be truncated before we can even access it. - ;; FSF calls this `undo-strong-limit' - (let ((undo-high-threshold (+ (- end beg) 100)) - ;(old-list buffer-undo-list) - tail) - (delete-region beg end) - ;; Search back in buffer-undo-list for this string, - ;; in case a change hook made property changes. - (setq tail buffer-undo-list) - (while (and tail - (not (stringp (car-safe (car-safe tail))))) ; XEmacs - (pop tail)) - ;; Take the same string recorded for undo - ;; and put it in the kill-ring. - (and tail - (kill-new (car (car tail)))))) - - (t - ;; if undo is not kept, grab the string then delete it (which won't - ;; add another string to the undo list). - (copy-region-as-kill beg end) - (delete-region beg end))) - (setq this-command 'kill-region)) - -;; copy-region-as-kill no longer sets this-command, because it's confusing -;; to get two copies of the text when the user accidentally types M-w and -;; then corrects it with the intended C-w. -(defun copy-region-as-kill (beg end) - "Save the region as if killed, but don't kill it. -Run `kill-hooks'." - (interactive "r") - (if (eq last-command 'kill-region) - (kill-append (buffer-substring beg end) (< end beg)) - (kill-new (buffer-substring beg end))) - nil) - -(defun kill-ring-save (beg end) - "Save the region as if killed, but don't kill it. -This command is similar to `copy-region-as-kill', except that it gives -visual feedback indicating the extent of the region being copied." - (interactive "r") - (copy-region-as-kill beg end) - ;; copy before delay, for xclipboard's benefit - (if (interactive-p) - (let ((other-end (if (= (point) beg) end beg)) - (opoint (point)) - ;; Inhibit quitting so we can make a quit here - ;; look like a C-g typed as a command. - (inhibit-quit t)) - (if (pos-visible-in-window-p other-end (selected-window)) - (progn - ;; FSF (I'm not sure what this does -sb) -; ;; Swap point and mark. -; (set-marker (mark-marker) (point) (current-buffer)) - (goto-char other-end) - (sit-for 1) -; ;; Swap back. -; (set-marker (mark-marker) other-end (current-buffer)) - (goto-char opoint) - ;; If user quit, deactivate the mark - ;; as C-g would as a command. - (and quit-flag (mark) - (zmacs-deactivate-region))) - ;; too noisy. -- jwz -; (let* ((killed-text (current-kill 0)) -; (message-len (min (length killed-text) 40))) -; (if (= (point) beg) -; ;; Don't say "killed"; that is misleading. -; (message "Saved text until \"%s\"" -; (substring killed-text (- message-len))) -; (message "Saved text from \"%s\"" -; (substring killed-text 0 message-len)))) - )))) - -(defun append-next-kill () - "Cause following command, if it kills, to append to previous kill." - ;; XEmacs - (interactive "_") - (if (interactive-p) - (progn - (setq this-command 'kill-region) - (display-message 'command - "If the next command is a kill, it will append")) - (setq last-command 'kill-region))) - -(defun yank-pop (arg) - "Replace just-yanked stretch of killed text with a different stretch. -This command is allowed only immediately after a `yank' or a `yank-pop'. -At such a time, the region contains a stretch of reinserted -previously-killed text. `yank-pop' deletes that text and inserts in its -place a different stretch of killed text. - -With no argument, the previous kill is inserted. -With argument N, insert the Nth previous kill. -If N is negative, this is a more recent kill. - -The sequence of kills wraps around, so that after the oldest one -comes the newest one." - (interactive "*p") - (if (not (eq last-command 'yank)) - (error "Previous command was not a yank")) - (setq this-command 'yank) - (let ((inhibit-read-only t) - (before (< (point) (mark t)))) - (delete-region (point) (mark t)) - ;;(set-marker (mark-marker) (point) (current-buffer)) - (set-mark (point)) - (insert (current-kill arg)) - (if before - ;; 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 t) (point) (current-buffer)))))) - nil) - - -(defun yank (&optional arg) - "Reinsert the last stretch of killed text. -More precisely, reinsert the stretch of killed text most recently -killed OR yanked. Put point at end, and set mark at beginning. -With just C-u as argument, same but put point at beginning (and mark at end). -With argument N, reinsert the Nth most recently killed stretch of killed -text. -See also the command \\[yank-pop]." - (interactive "*P") - ;; If we don't get all the way through, make last-command indicate that - ;; for the following command. - (setq this-command t) - (push-mark (point)) - (insert (current-kill (cond - ((listp arg) 0) - ((eq arg '-) -1) - (t (1- arg))))) - (if (consp arg) - ;; 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. - ;; (But it's an unnecessary kludge in XEmacs.) - ;(goto-char (prog1 (mark t) - ;(set-marker (mark-marker) (point) (current-buffer))))) - (exchange-point-and-mark t)) - ;; If we do get all the way thru, make this-command indicate that. - (setq this-command 'yank) - nil) - -(defun rotate-yank-pointer (arg) - "Rotate the yanking point in the kill ring. -With argument, rotate that many kills forward (or backward, if negative)." - (interactive "p") - (current-kill arg)) - - -(defun insert-buffer (buffer) - "Insert after point the contents of BUFFER. -Puts mark after the inserted text. -BUFFER may be a buffer or a buffer name." - (interactive - (list - (progn - (barf-if-buffer-read-only) - (read-buffer "Insert buffer: " - ;; XEmacs: we have different args - (other-buffer (current-buffer) nil t) - t)))) - (or (bufferp buffer) - (setq buffer (get-buffer buffer))) - (let (start end newmark) - (save-excursion - (save-excursion - (set-buffer buffer) - (setq start (point-min) end (point-max))) - (insert-buffer-substring buffer start end) - (setq newmark (point))) - (push-mark newmark)) - nil) - -(defun append-to-buffer (buffer start end) - "Append to specified buffer the text of the region. -It is inserted into that buffer before its point. - -When calling from a program, give three arguments: -BUFFER (or buffer name), START and END. -START and END specify the portion of the current buffer to be copied." - (interactive - ;; XEmacs: we have different args to other-buffer - (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) - nil t)) - (region-beginning) (region-end))) - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (insert-buffer-substring oldbuf start end)))) - -(defun prepend-to-buffer (buffer start end) - "Prepend to specified buffer the text of the region. -It is inserted into that buffer after its point. - -When calling from a program, give three arguments: -BUFFER (or buffer name), START and END. -START and END specify the portion of the current buffer to be copied." - (interactive "BPrepend to buffer: \nr") - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (save-excursion - (insert-buffer-substring oldbuf start end))))) - -(defun copy-to-buffer (buffer start end) - "Copy to specified buffer the text of the region. -It is inserted into that buffer, replacing existing text there. - -When calling from a program, give three arguments: -BUFFER (or buffer name), START and END. -START and END specify the portion of the current buffer to be copied." - (interactive "BCopy to buffer: \nr") - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (erase-buffer) - (save-excursion - (insert-buffer-substring oldbuf start end))))) - -;FSFmacs -;(put 'mark-inactive 'error-conditions '(mark-inactive error)) -;(put 'mark-inactive 'error-message "The mark is not active now") - -(defun mark (&optional force buffer) - "Return this buffer's mark value as integer, or nil if no mark. - -If `zmacs-regions' is true, then this returns nil unless the region is -currently in the active (highlighted) state. With an argument of t, this -returns the mark (if there is one) regardless of the active-region state. -You should *generally* not use the mark unless the region is active, if -the user has expressed a preference for the active-region model. - -If you are using this in an editing command, you are most likely making -a mistake; see the documentation of `set-mark'." - (setq buffer (decode-buffer buffer)) -;FSFmacs version: -; (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive) -; (marker-position (mark-marker)) -; (signal 'mark-inactive nil))) - (let ((m (mark-marker force buffer))) - (and m (marker-position m)))) - -;;;#### FSFmacs -;;; Many places set mark-active directly, and several of them failed to also -;;; run deactivate-mark-hook. This shorthand should simplify. -;(defsubst deactivate-mark () -; "Deactivate the mark by setting `mark-active' to nil. -;\(That makes a difference only in Transient Mark mode.) -;Also runs the hook `deactivate-mark-hook'." -; (if transient-mark-mode -; (progn -; (setq mark-active nil) -; (run-hooks 'deactivate-mark-hook)))) - -(defun set-mark (pos &optional buffer) - "Set this buffer's mark to POS. Don't use this function! -That is to say, don't use this function unless you want -the user to see that the mark has moved, and you want the previous -mark position to be lost. - -Normally, when a new mark is set, the old one should go on the stack. -This is why most applications should use push-mark, not set-mark. - -Novice Emacs Lisp programmers often try to use the mark for the wrong -purposes. The mark saves a location for the user's convenience. -Most editing commands should not alter the mark. -To remember a location for internal use in the Lisp program, -store it in a Lisp variable. Example: - - (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." - - (setq buffer (decode-buffer buffer)) - (set-marker (mark-marker t buffer) pos buffer)) -;; FSF -; (if pos -; (progn -; (setq mark-active t) -; (run-hooks 'activate-mark-hook) -; (set-marker (mark-marker) pos (current-buffer))) -; ;; Normally we never clear mark-active except in Transient Mark mode. -; ;; But when we actually clear out the mark value too, -; ;; we must clear mark-active in any mode. -; (setq mark-active nil) -; (run-hooks 'deactivate-mark-hook) -; (set-marker (mark-marker) nil))) - -(defvar mark-ring nil - "The list of former marks of the current buffer, most recent first.") -(make-variable-buffer-local 'mark-ring) -(put 'mark-ring 'permanent-local t) - -(defcustom mark-ring-max 16 - "*Maximum size of mark ring. Start discarding off end if gets this big." - :type 'integer - :group 'killing) - -(defvar global-mark-ring nil - "The list of saved global marks, most recent first.") - -(defcustom global-mark-ring-max 16 - "*Maximum size of global mark ring. \ -Start discarding off end if gets this big." - :type 'integer - :group 'killing) - -(defun set-mark-command (arg) - "Set mark at where point is, or jump to mark. -With no prefix argument, set mark, push old mark position on local mark -ring, and push mark on global mark ring. -With argument, jump to mark, and pop a new position for mark off the ring -\(does not affect global mark ring\). - -Novice Emacs Lisp programmers often try to use the mark for the wrong -purposes. See the documentation of `set-mark' for more information." - (interactive "P") - (if (null arg) - (push-mark nil nil t) - (if (null (mark t)) - (error "No mark set in this buffer") - (goto-char (mark t)) - (pop-mark)))) - -;; XEmacs: Extra parameter -(defun push-mark (&optional location nomsg activate-region buffer) - "Set mark at LOCATION (point, by default) and push old mark on mark ring. -If the last global mark pushed was not in the current buffer, -also push LOCATION on the global mark ring. -Display `Mark set' unless the optional second arg NOMSG is non-nil. -Activate mark if optional third arg ACTIVATE-REGION non-nil. - -Novice Emacs Lisp programmers often try to use the mark for the wrong -purposes. See the documentation of `set-mark' for more information." - (setq buffer (decode-buffer buffer)) ; XEmacs - (if (null (mark t buffer)) ; XEmacs - nil - ;; The save-excursion / set-buffer is necessary because mark-ring - ;; is a buffer local variable - (save-excursion - (set-buffer buffer) - (setq mark-ring (cons (copy-marker (mark-marker t buffer)) mark-ring)) - (if (> (length mark-ring) mark-ring-max) - (progn - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil buffer) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))) - (set-mark (or location (point buffer)) buffer) -; (set-marker (mark-marker) (or location (point)) (current-buffer)) ; FSF - ;; Now push the mark on the global mark ring. - (if (or (null global-mark-ring) - (not (eq (marker-buffer (car global-mark-ring)) buffer))) - ;; The last global mark pushed wasn't in this same buffer. - (progn - (setq global-mark-ring (cons (copy-marker (mark-marker t buffer)) - global-mark-ring)) - (if (> (length global-mark-ring) global-mark-ring-max) - (progn - (move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) - nil buffer) - (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))) - (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) - (display-message 'command "Mark set")) - (if activate-region - (progn - (setq zmacs-region-stays t) - (zmacs-activate-region))) -; (if (or activate (not transient-mark-mode)) ; FSF -; (set-mark (mark t))) ; FSF - nil) - -(defun pop-mark () - "Pop off mark ring into the buffer's actual mark. -Does not set point. Does nothing if mark ring is empty." - (if mark-ring - (progn - (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker t))))) - (set-mark (car mark-ring)) - (move-marker (car mark-ring) nil) - (if (null (mark t)) (ding)) - (setq mark-ring (cdr mark-ring))))) - -(define-function 'exchange-dot-and-mark 'exchange-point-and-mark) -(defun exchange-point-and-mark (&optional dont-activate-region) - "Put the mark where point is now, and point where the mark is now. -The mark is activated unless DONT-ACTIVATE-REGION is non-nil." - (interactive nil) - (let ((omark (mark t))) - (if (null omark) - (error "No mark set in this buffer")) - (set-mark (point)) - (goto-char omark) - (or dont-activate-region (zmacs-activate-region)) ; XEmacs - nil)) - -;; XEmacs -(defun mark-something (mark-fn movement-fn arg) - "internal function used by mark-sexp, mark-word, etc." - (let (newmark (pushp t)) - (save-excursion - (if (and (eq last-command mark-fn) (mark)) - ;; Extend the previous state in the same direction: - (progn - (if (< (mark) (point)) (setq arg (- arg))) - (goto-char (mark)) - (setq pushp nil))) - (funcall movement-fn arg) - (setq newmark (point))) - (if pushp - (push-mark newmark nil t) - ;; Do not mess with the mark stack, but merely adjust the previous state: - (set-mark newmark) - (activate-region)))) - -;(defun transient-mark-mode (arg) -; "Toggle Transient Mark mode. -;With arg, turn Transient Mark mode on if arg is positive, off otherwise. -; -;In Transient Mark mode, when the mark is active, the region is highlighted. -;Changing the buffer \"deactivates\" the mark. -;So do certain other operations that set the mark -;but whose main purpose is something else--for example, -;incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]." -; (interactive "P") -; (setq transient-mark-mode -; (if (null arg) -; (not transient-mark-mode) -; (> (prefix-numeric-value arg) 0)))) - -(defun pop-global-mark () - "Pop off global mark ring and jump to the top location." - (interactive) - ;; Pop entries which refer to non-existent buffers. - (while (and global-mark-ring (not (marker-buffer (car global-mark-ring)))) - (setq global-mark-ring (cdr global-mark-ring))) - (or global-mark-ring - (error "No global mark set")) - (let* ((marker (car global-mark-ring)) - (buffer (marker-buffer marker)) - (position (marker-position marker))) - (setq global-mark-ring (nconc (cdr global-mark-ring) - (list (car global-mark-ring)))) - (set-buffer buffer) - (or (and (>= position (point-min)) - (<= position (point-max))) - (widen)) - (goto-char position) - (switch-to-buffer buffer))) - - -(defcustom signal-error-on-buffer-boundary t - "*Non-nil value causes XEmacs to beep or signal an error when certain interactive commands would move point past (point-min) or (point-max). -The commands that honor this variable are - -forward-char-command -backward-char-command -next-line -previous-line -scroll-up-command -scroll-down-command" - :type 'boolean - :group 'editing-basics) - -;;; After 8 years of waiting ... -sb -(defcustom next-line-add-newlines nil ; XEmacs - "*If non-nil, `next-line' inserts newline when the point is at end of buffer. -This behavior used to be the default, and is still default in FSF Emacs. -We think it is an unnecessary and unwanted side-effect." - :type 'boolean - :group 'editing-basics) - -(defun forward-char-command (&optional arg buffer) - "Move point right ARG characters (left if ARG negative) in BUFFER. -On attempt to pass end of buffer, stop and signal `end-of-buffer'. -On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. -Error signaling is suppressed if `signal-error-on-buffer-boundary' -is nil. If BUFFER is nil, the current buffer is assumed." - (interactive "_p") - (if signal-error-on-buffer-boundary - (forward-char arg buffer) - (condition-case nil - (forward-char arg buffer) - (beginning-of-buffer nil) - (end-of-buffer nil)))) - -(defun backward-char-command (&optional arg buffer) - "Move point left ARG characters (right if ARG negative) in BUFFER. -On attempt to pass end of buffer, stop and signal `end-of-buffer'. -On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. -Error signaling is suppressed if `signal-error-on-buffer-boundary' -is nil. If BUFFER is nil, the current buffer is assumed." - (interactive "_p") - (if signal-error-on-buffer-boundary - (backward-char arg buffer) - (condition-case nil - (backward-char arg buffer) - (beginning-of-buffer nil) - (end-of-buffer nil)))) - -(defun scroll-up-command (&optional n) - "Scroll text of current window upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil. -On attempt to scroll past end of buffer, `end-of-buffer' is signaled. -On attempt to scroll past beginning of buffer, `beginning-of-buffer' is -signaled. - -If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer -boundaries do not cause an error to be signaled." - (interactive "_P") - (if signal-error-on-buffer-boundary - (scroll-up n) - (condition-case nil - (scroll-up n) - (beginning-of-buffer nil) - (end-of-buffer nil)))) - -(defun scroll-down-command (&optional n) - "Scroll text of current window downward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil. -On attempt to scroll past end of buffer, `end-of-buffer' is signaled. -On attempt to scroll past beginning of buffer, `beginning-of-buffer' is -signaled. - -If `signal-error-on-buffer-boundary' is nil, attempts to scroll past buffer -boundaries do not cause an error to be signaled." - (interactive "_P") - (if signal-error-on-buffer-boundary - (scroll-down n) - (condition-case nil - (scroll-down n) - (beginning-of-buffer nil) - (end-of-buffer nil)))) - -(defun next-line (arg) - "Move cursor vertically down ARG lines. -If there is no character in the target line exactly under the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -If there is no line in the buffer after this one, behavior depends on the -value of `next-line-add-newlines'. If non-nil, it inserts a newline character -to create a line, and moves the cursor to that line. Otherwise it moves the -cursor to the end of the buffer. - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. This goal column is stored -in `goal-column', which is nil when there is none. - -If you are thinking of using this in a Lisp program, consider -using `forward-line' instead. It is usually easier to use -and more reliable (no dependence on goal column, etc.)." - (interactive "_p") ; XEmacs - (if (and next-line-add-newlines (= arg 1)) - (let ((opoint (point))) - (end-of-line) - (if (eobp) - (newline 1) - (goto-char opoint) - (line-move arg))) - (if (interactive-p) - ;; XEmacs: Not sure what to do about this. It's inconsistent. -sb - (condition-case nil - (line-move arg) - ((beginning-of-buffer end-of-buffer) - (when signal-error-on-buffer-boundary - (ding nil 'buffer-bound)))) - (line-move arg))) - nil) - -(defun previous-line (arg) - "Move cursor vertically up ARG lines. -If there is no character in the target line exactly over the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. - -If you are thinking of using this in a Lisp program, consider using -`forward-line' with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.)." - (interactive "_p") ; XEmacs - (if (interactive-p) - (condition-case nil - (line-move (- arg)) - ((beginning-of-buffer end-of-buffer) - (when signal-error-on-buffer-boundary ; XEmacs - (ding nil 'buffer-bound)))) - (line-move (- arg))) - nil) - -(defcustom track-eol nil - "*Non-nil means vertical motion starting at end of line keeps to ends of lines. -This means moving to the end of each line moved onto. -The beginning of a blank line does not count as the end of a line." - :type 'boolean - :group 'editing-basics) - -(defcustom goal-column nil - "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil." - :type '(choice integer (const :tag "None" nil)) - :group 'editing-basics) -(make-variable-buffer-local 'goal-column) - -(defvar temporary-goal-column 0 - "Current goal column for vertical motion. -It is the column where point was -at the start of current run of vertical motion commands. -When the `track-eol' feature is doing its job, the value is 9999.") -(make-variable-buffer-local 'temporary-goal-column) - -;XEmacs: not yet ported, so avoid compiler warnings -(eval-when-compile - (defvar inhibit-point-motion-hooks)) - -(defcustom line-move-ignore-invisible nil - "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines. -Use with care, as it slows down movement significantly. Outline mode sets this." - :type 'boolean - :group 'editing-basics) - -;; This is the guts of next-line and previous-line. -;; Arg says how many lines to move. -(defun line-move (arg) - ;; Don't run any point-motion hooks, and disregard intangibility, - ;; for intermediate positions. - (let ((inhibit-point-motion-hooks t) - (opoint (point)) - new) - (unwind-protect - (progn - (if (not (or (eq last-command 'next-line) - (eq last-command 'previous-line))) - (setq temporary-goal-column - (if (and track-eol (eolp) - ;; Don't count beg of empty line as end of line - ;; unless we just did explicit end-of-line. - (or (not (bolp)) (eq last-command 'end-of-line))) - 9999 - (current-column)))) - (if (and (not (integerp selective-display)) - (not line-move-ignore-invisible)) - ;; Use just newline characters. - (or (if (> arg 0) - (progn (if (> arg 1) (forward-line (1- arg))) - ;; This way of moving forward ARG lines - ;; verifies that we have a newline after the last one. - ;; It doesn't get confused by intangible text. - (end-of-line) - (zerop (forward-line 1))) - (and (zerop (forward-line arg)) - (bolp))) - (signal (if (< arg 0) - 'beginning-of-buffer - 'end-of-buffer) - nil)) - ;; Move by arg lines, but ignore invisible ones. - (while (> arg 0) - (end-of-line) - (and (zerop (vertical-motion 1)) - (signal 'end-of-buffer nil)) - ;; If the following character is currently invisible, - ;; skip all characters with that same `invisible' property value. - (while (and (not (eobp)) - (let ((prop - (get-char-property (point) 'invisible))) - (if (eq buffer-invisibility-spec t) - prop - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec))))) - (if (get-text-property (point) 'invisible) - (goto-char (next-single-property-change (point) 'invisible)) - (goto-char (next-extent-change (point))))) ; XEmacs - (setq arg (1- arg))) - (while (< arg 0) - (beginning-of-line) - (and (zerop (vertical-motion -1)) - (signal 'beginning-of-buffer nil)) - (while (and (not (bobp)) - (let ((prop - (get-char-property (1- (point)) 'invisible))) - (if (eq buffer-invisibility-spec t) - prop - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec))))) - (if (get-text-property (1- (point)) 'invisible) - (goto-char (previous-single-property-change (point) 'invisible)) - (goto-char (previous-extent-change (point))))) ; XEmacs - (setq arg (1+ arg)))) - (move-to-column (or goal-column temporary-goal-column))) - ;; Remember where we moved to, go back home, - ;; then do the motion over again - ;; in just one step, with intangibility and point-motion hooks - ;; enabled this time. - (setq new (point)) - (goto-char opoint) - (setq inhibit-point-motion-hooks nil) - (goto-char new))) - nil) - -;;; Many people have said they rarely use this feature, and often type -;;; it by accident. Maybe it shouldn't even be on a key. -;; It's not on a key, as of 20.2. So no need for this. -;(put 'set-goal-column 'disabled t) - -(defun set-goal-column (arg) - "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line]. -Those commands will move to this position in the line moved to -rather than trying to keep the same horizontal position. -With a non-nil argument, clears out the goal column -so that \\[next-line] and \\[previous-line] resume vertical motion. -The goal column is stored in the variable `goal-column'." - (interactive "_P") ; XEmacs - (if arg - (progn - (setq goal-column nil) - (display-message 'command "No goal column")) - (setq goal-column (current-column)) - (lmessage 'command - "Goal column %d (use %s with an arg to unset it)" - goal-column - (substitute-command-keys "\\[set-goal-column]"))) - nil) - -;; deleted FSFmacs terminal randomness hscroll-point-visible stuff. -;; hscroll-step -;; hscroll-point-visible -;; hscroll-window-column -;; right-arrow -;; left-arrow - -(defun scroll-other-window-down (lines) - "Scroll the \"other window\" down. -For more details, see the documentation for `scroll-other-window'." - (interactive "P") - (scroll-other-window - ;; Just invert the argument's meaning. - ;; We can do that without knowing which window it will be. - (if (eq lines '-) nil - (if (null lines) '- - (- (prefix-numeric-value lines)))))) -;(define-key esc-map [?\C-\S-v] 'scroll-other-window-down) - -(defun beginning-of-buffer-other-window (arg) - "Move point to the beginning of the buffer in the other window. -Leave mark at previous position. -With arg N, put point N/10 of the way from the true beginning." - (interactive "P") - (let ((orig-window (selected-window)) - (window (other-window-for-scrolling))) - ;; We use unwind-protect rather than save-window-excursion - ;; because the latter would preserve the things we want to change. - (unwind-protect - (progn - (select-window window) - ;; Set point and mark in that window's buffer. - (beginning-of-buffer arg) - ;; Set point accordingly. - (recenter '(t))) - (select-window orig-window)))) - -(defun end-of-buffer-other-window (arg) - "Move point to the end of the buffer in the other window. -Leave mark at previous position. -With arg N, put point N/10 of the way from the true end." - (interactive "P") - ;; See beginning-of-buffer-other-window for comments. - (let ((orig-window (selected-window)) - (window (other-window-for-scrolling))) - (unwind-protect - (progn - (select-window window) - (end-of-buffer arg) - (recenter '(t))) - (select-window orig-window)))) - -(defun transpose-chars (arg) - "Interchange characters around point, moving forward one character. -With prefix arg ARG, effect is to take character before point -and drag it forward past ARG other characters (backward if ARG negative). -If no argument and at end of line, the previous two chars are exchanged." - (interactive "*P") - (and (null arg) (eolp) (forward-char -1)) - (transpose-subr 'forward-char (prefix-numeric-value arg))) - -;;; A very old implementation of transpose-chars from the old days ... -(defun transpose-preceding-chars (arg) - "Interchange characters before point. -With prefix arg ARG, effect is to take character before point -and drag it forward past ARG other characters (backward if ARG negative). -If no argument and not at start of line, the previous two chars are exchanged." - (interactive "*P") - (and (null arg) (not (bolp)) (forward-char -1)) - (transpose-subr 'forward-char (prefix-numeric-value arg))) - - -(defun transpose-words (arg) - "Interchange words around point, leaving point at end of them. -With prefix arg ARG, effect is to take word before or around point -and drag it forward past ARG other words (backward if ARG negative). -If ARG is zero, the words around or after point and around or after mark -are interchanged." - (interactive "*p") - (transpose-subr 'forward-word arg)) - -(defun transpose-sexps (arg) - "Like \\[transpose-words] but applies to sexps. -Does not work on a sexp that point is in the middle of -if it is a list or string." - (interactive "*p") - (transpose-subr 'forward-sexp arg)) - -(defun transpose-lines (arg) - "Exchange current line and previous line, leaving point after both. -With argument ARG, takes previous line and moves it past ARG lines. -With argument 0, interchanges line point is in with line mark is in." - (interactive "*p") - (transpose-subr #'(lambda (arg) - (if (= arg 1) - (progn - ;; Move forward over a line, - ;; but create a newline if none exists yet. - (end-of-line) - (if (eobp) - (newline) - (forward-char 1))) - (forward-line arg))) - arg)) - -(eval-when-compile - ;; avoid byte-compiler warnings... - (defvar start1) - (defvar start2) - (defvar end1) - (defvar end2)) - -; start[12] and end[12] used in transpose-subr-1 below -(defun transpose-subr (mover arg) - (let (start1 end1 start2 end2) - (if (= arg 0) - (progn - (save-excursion - (funcall mover 1) - (setq end2 (point)) - (funcall mover -1) - (setq start2 (point)) - (goto-char (mark t)) ; XEmacs - (funcall mover 1) - (setq end1 (point)) - (funcall mover -1) - (setq start1 (point)) - (transpose-subr-1)) - (exchange-point-and-mark t))) ; XEmacs - (while (> arg 0) - (funcall mover -1) - (setq start1 (point)) - (funcall mover 1) - (setq end1 (point)) - (funcall mover 1) - (setq end2 (point)) - (funcall mover -1) - (setq start2 (point)) - (transpose-subr-1) - (goto-char end2) - (setq arg (1- arg))) - (while (< arg 0) - (funcall mover -1) - (setq start2 (point)) - (funcall mover -1) - (setq start1 (point)) - (funcall mover 1) - (setq end1 (point)) - (funcall mover 1) - (setq end2 (point)) - (transpose-subr-1) - (setq arg (1+ arg))))) - -; start[12] and end[12] used free -(defun transpose-subr-1 () - (if (> (min end1 end2) (max start1 start2)) - (error "Don't have two things to transpose")) - (let ((word1 (buffer-substring start1 end1)) - (word2 (buffer-substring start2 end2))) - (delete-region start2 end2) - (goto-char start2) - (insert word1) - (goto-char (if (< start1 start2) start1 - (+ start1 (- (length word1) (length word2))))) - (delete-char (length word1)) - (insert word2))) - -(defcustom comment-column 32 - "*Column to indent right-margin comments to. -Setting this variable automatically makes it local to the current buffer. -Each mode establishes a different default value for this variable; you -can set the value for a particular mode using that mode's hook." - :type 'integer - :group 'fill-comments) -(make-variable-buffer-local 'comment-column) - -(defcustom comment-start nil - "*String to insert to start a new comment, or nil if no comment syntax." - :type '(choice (const :tag "None" nil) - string) - :group 'fill-comments) - -(defcustom comment-start-skip nil - "*Regexp to match the start of a comment plus everything up to its body. -If there are any \\(...\\) pairs, the comment delimiter text is held to begin -at the place matched by the close of the first pair." - :type '(choice (const :tag "None" nil) - regexp) - :group 'fill-comments) - -(defcustom comment-end "" - "*String to insert to end a new comment. -Should be an empty string if comments are terminated by end-of-line." - :type 'string - :group 'fill-comments) - -(defconst comment-indent-hook nil - "Obsolete variable for function to compute desired indentation for a comment. -Use `comment-indent-function' instead. -This function is called with no args with point at the beginning of -the comment's starting delimiter.") - -(defconst comment-indent-function - ;; XEmacs - add at least one space after the end of the text on the - ;; current line... - (lambda () - (save-excursion - (beginning-of-line) - (let ((eol (save-excursion (end-of-line) (point)))) - (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 (1+ (current-column)))))) - "Function to compute desired indentation for a comment. -This function is called with no args with point at the beginning of -the comment's starting delimiter.") - -(defcustom block-comment-start nil - "*String to insert to start a new comment on a line by itself. -If nil, use `comment-start' instead. -Note that the regular expression `comment-start-skip' should skip this string -as well as the `comment-start' string." - :type '(choice (const :tag "Use `comment-start'" nil) - string) - :group 'fill-comments) - -(defcustom block-comment-end nil - "*String to insert to end a new comment on a line by itself. -Should be an empty string if comments are terminated by end-of-line. -If nil, use `comment-end' instead." - :type '(choice (const :tag "Use `comment-end'" nil) - string) - :group 'fill-comments) - -(defun indent-for-comment () - "Indent this line's comment to comment column, or insert an empty comment." - (interactive "*") - (let* ((empty (save-excursion (beginning-of-line) - (looking-at "[ \t]*$"))) - (starter (or (and empty block-comment-start) comment-start)) - (ender (or (and empty block-comment-end) comment-end))) - (if (null starter) - (error "No comment syntax defined") - (let* ((eolpos (save-excursion (end-of-line) (point))) - cpos indent begpos) - (beginning-of-line) - (if (re-search-forward comment-start-skip eolpos 'move) - (progn (setq cpos (point-marker)) - ;; Find the start of the comment delimiter. - ;; If there were paren-pairs in comment-start-skip, - ;; position at the end of the first pair. - (if (match-end 1) - (goto-char (match-end 1)) - ;; If comment-start-skip matched a string with - ;; internal whitespace (not final whitespace) then - ;; the delimiter start at the end of that - ;; whitespace. Otherwise, it starts at the - ;; beginning of what was matched. - (skip-syntax-backward " " (match-beginning 0)) - (skip-syntax-backward "^ " (match-beginning 0))))) - (setq begpos (point)) - ;; Compute desired indent. - (if (= (current-column) - (setq indent (funcall comment-indent-function))) - (goto-char begpos) - ;; If that's different from current, change it. - (skip-chars-backward " \t") - (delete-region (point) begpos) - (indent-to indent)) - ;; An existing comment? - (if cpos - (progn (goto-char cpos) - (set-marker cpos nil)) - ;; No, insert one. - (insert starter) - (save-excursion - (insert ender))))))) - -(defun set-comment-column (arg) - "Set the comment column based on point. -With no arg, set the comment column to the current column. -With just minus as arg, kill any comment on this line. -With any other arg, set comment column to indentation of the previous comment - and then align or create a comment on this line at that column." - (interactive "P") - (if (eq arg '-) - (kill-comment nil) - (if arg - (progn - (save-excursion - (beginning-of-line) - (re-search-backward comment-start-skip) - (beginning-of-line) - (re-search-forward comment-start-skip) - (goto-char (match-beginning 0)) - (setq comment-column (current-column)) - (lmessage 'command "Comment column set to %d" comment-column)) - (indent-for-comment)) - (setq comment-column (current-column)) - (lmessage 'command "Comment column set to %d" comment-column)))) - -(defun kill-comment (arg) - "Kill the comment on this line, if any. -With argument, kill comments on that many lines starting with this one." - ;; this function loses in a lot of situations. it incorrectly recognizes - ;; comment delimiters sometimes (ergo, inside a string), doesn't work - ;; with multi-line comments, can kill extra whitespace if comment wasn't - ;; through end-of-line, et cetera. - (interactive "*P") - (or comment-start-skip (error "No comment syntax defined")) - (let ((count (prefix-numeric-value arg)) endc) - (while (> count 0) - (save-excursion - (end-of-line) - (setq endc (point)) - (beginning-of-line) - (and (string< "" comment-end) - (setq endc - (progn - (re-search-forward (regexp-quote comment-end) endc 'move) - (skip-chars-forward " \t") - (point)))) - (beginning-of-line) - (if (re-search-forward comment-start-skip endc t) - (progn - (goto-char (match-beginning 0)) - (skip-chars-backward " \t") - (kill-region (point) endc) - ;; to catch comments a line beginnings - (indent-according-to-mode)))) - (if arg (forward-line 1)) - (setq count (1- count))))) - -(defun comment-region (beg end &optional arg) - "Comment or uncomment each line in the region. -With just C-u prefix arg, uncomment each line in region. -Numeric prefix arg ARG means use ARG comment characters. -If ARG is negative, delete that many comment characters instead. -Comments are terminated on each line, even for syntax in which newline does -not end the comment. Blank lines do not get comments." - ;; if someone wants it to only put a comment-start at the beginning and - ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x - ;; is easy enough. No option is made here for other than commenting - ;; every line. - (interactive "r\nP") - (or comment-start (error "No comment syntax is defined")) - (if (> beg end) (let (mid) (setq mid beg beg end end mid))) - (save-excursion - (save-restriction - (let ((cs comment-start) (ce comment-end) - numarg) - (if (consp arg) (setq numarg t) - (setq numarg (prefix-numeric-value arg)) - ;; For positive arg > 1, replicate the comment delims now, - ;; then insert the replicated strings just once. - (while (> numarg 1) - (setq cs (concat cs comment-start) - ce (concat ce comment-end)) - (setq numarg (1- numarg)))) - ;; Loop over all lines from BEG to END. - (narrow-to-region beg end) - (goto-char beg) - (while (not (eobp)) - (if (or (eq numarg t) (< numarg 0)) - (progn - ;; Delete comment start from beginning of line. - (if (eq numarg t) - (while (looking-at (regexp-quote cs)) - (delete-char (length cs))) - (let ((count numarg)) - (while (and (> 1 (setq count (1+ count))) - (looking-at (regexp-quote cs))) - (delete-char (length cs))))) - ;; Delete comment end from end of line. - (if (string= "" ce) - nil - (if (eq numarg t) - (progn - (end-of-line) - ;; This is questionable if comment-end ends in - ;; whitespace. That is pretty brain-damaged, - ;; though. - (skip-chars-backward " \t") - (if (and (>= (- (point) (point-min)) (length ce)) - (save-excursion - (backward-char (length ce)) - (looking-at (regexp-quote ce)))) - (delete-char (- (length ce))))) - (let ((count numarg)) - (while (> 1 (setq count (1+ count))) - (end-of-line) - ;; This is questionable if comment-end ends in - ;; whitespace. That is pretty brain-damaged though - (skip-chars-backward " \t") - (save-excursion - (backward-char (length ce)) - (if (looking-at (regexp-quote ce)) - (delete-char (length ce)))))))) - (forward-line 1)) - ;; Insert at beginning and at end. - (if (looking-at "[ \t]*$") () - (insert cs) - (if (string= "" ce) () - (end-of-line) - (insert ce))) - (search-forward "\n" nil 'move))))))) - -;; XEmacs -(defun prefix-region (prefix) - "Add a prefix string to each line between mark and point." - (interactive "sPrefix string: ") - (if prefix - (let ((count (count-lines (mark) (point)))) - (goto-char (min (mark) (point))) - (while (> count 0) - (setq count (1- count)) - (beginning-of-line 1) - (insert prefix) - (end-of-line 1) - (forward-char 1))))) - - -;; XEmacs - extra parameter -(defun backward-word (arg &optional buffer) - "Move backward until encountering the end of a word. -With argument, do this that many times. -In programs, it is faster to call `forward-word' with negative arg." - (interactive "_p") ; XEmacs - (forward-word (- arg) buffer)) - -(defun mark-word (arg) - "Set mark arg words away from point." - (interactive "p") - (mark-something 'mark-word 'forward-word arg)) - -;; XEmacs modified -(defun kill-word (arg) - "Kill characters forward until encountering the end of a word. -With argument, do this that many times." - (interactive "*p") - (kill-region (point) (save-excursion (forward-word arg) (point)))) - -(defun backward-kill-word (arg) - "Kill characters backward until encountering the end of a word. -With argument, do this that many times." - (interactive "*p") ; XEmacs - (kill-word (- arg))) - -(defun current-word (&optional strict) - "Return the word point is on (or a nearby word) as a string. -If optional arg STRICT is non-nil, return nil unless point is within -or adjacent to a word. -If point is not between two word-constituent characters, but immediately -follows one, move back first. -Otherwise, if point precedes a word constituent, move forward first. -Otherwise, move backwards until a word constituent is found and get that word; -if you a newlines is reached first, move forward instead." - (save-excursion - (let ((oldpoint (point)) (start (point)) (end (point))) - (skip-syntax-backward "w_") (setq start (point)) - (goto-char oldpoint) - (skip-syntax-forward "w_") (setq end (point)) - (if (and (eq start oldpoint) (eq end oldpoint)) - ;; Point is neither within nor adjacent to a word. - (and (not strict) - (progn - ;; Look for preceding word in same line. - (skip-syntax-backward "^w_" - (save-excursion - (beginning-of-line) (point))) - (if (bolp) - ;; No preceding word in same line. - ;; Look for following word in same line. - (progn - (skip-syntax-forward "^w_" - (save-excursion - (end-of-line) (point))) - (setq start (point)) - (skip-syntax-forward "w_") - (setq end (point))) - (setq end (point)) - (skip-syntax-backward "w_") - (setq start (point))) - (buffer-substring start end))) - (buffer-substring start end))))) - -(defcustom fill-prefix nil - "*String for filling to insert at front of new line, or nil for none. -Setting this variable automatically makes it local to the current buffer." - :type '(choice (const :tag "None" nil) - string) - :group 'fill) -(make-variable-buffer-local 'fill-prefix) - -(defcustom auto-fill-inhibit-regexp nil - "*Regexp to match lines which should not be auto-filled." - :type '(choice (const :tag "None" nil) - regexp) - :group 'fill) - -(defvar comment-line-break-function 'indent-new-comment-line - "*Mode-specific function which line breaks and continues a comment. - -This function is only called during auto-filling of a comment section. -The function should take a single optional argument which is a flag -indicating whether soft newlines should be inserted.") - -;; defined in mule-base/mule-category.el -(defvar word-across-newline) - -;; This function is the auto-fill-function of a buffer -;; when Auto-Fill mode is enabled. -;; It returns t if it really did any work. -;; XEmacs: This function is totally different. -(defun do-auto-fill () - (let (give-up) - (or (and auto-fill-inhibit-regexp - (save-excursion (beginning-of-line) - (looking-at auto-fill-inhibit-regexp))) - (while (and (not give-up) (> (current-column) fill-column)) - ;; Determine where to split the line. - (let ((fill-prefix fill-prefix) - (fill-point - (let ((opoint (point)) - bounce - ;; 97/3/14 jhod: Kinsoku - (re-break-point (if (featurep 'mule) - (concat "[ \t\n]\\|" word-across-newline) - "[ \t\n]")) - ;; end patch - (first t)) - (save-excursion - (move-to-column (1+ fill-column)) - ;; Move back to a word boundary. - (while (or first - ;; If this is after period and a single space, - ;; move back once more--we don't want to break - ;; the line there and make it look like a - ;; sentence end. - (and (not (bobp)) - (not bounce) - sentence-end-double-space - (save-excursion (forward-char -1) - (and (looking-at "\\. ") - (not (looking-at "\\. ")))))) - (setq first nil) - ;; 97/3/14 jhod: Kinsoku - ; (skip-chars-backward "^ \t\n")) - (fill-move-backward-to-break-point re-break-point) - ;; end patch - ;; If we find nowhere on the line to break it, - ;; break after one word. Set bounce to t - ;; so we will not keep going in this while loop. - (if (bolp) - (progn - ;; 97/3/14 jhod: Kinsoku - ; (re-search-forward "[ \t]" opoint t) - (fill-move-forward-to-break-point re-break-point - opoint) - ;; end patch - (setq bounce t))) - (skip-chars-backward " \t")) - (if (and (featurep 'mule) - (or bounce (bolp))) (kinsoku-process)) ;; 97/3/14 jhod: Kinsoku - ;; Let fill-point be set to the place where we end up. - (point))))) - - ;; I'm not sure why Stig made this change but it breaks - ;; auto filling in at least C mode so I'm taking it back - ;; out. --cet - ;; XEmacs - adaptive fill. - ;;(maybe-adapt-fill-prefix - ;; (or from (setq from (save-excursion (beginning-of-line) - ;; (point)))) - ;; (or to (setq to (save-excursion (beginning-of-line 2) - ;; (point)))) - ;; t) - - ;; If that place is not the beginning of the line, - ;; break the line there. - (if (save-excursion - (goto-char fill-point) - (not (or (bolp) (eolp)))) ; 97/3/14 jhod: during kinsoku processing it is possible to move beyond - (let ((prev-column (current-column))) - ;; If point is at the fill-point, do not `save-excursion'. - ;; Otherwise, if a comment prefix or fill-prefix is inserted, - ;; point will end up before it rather than after it. - (if (save-excursion - (skip-chars-backward " \t") - (= (point) fill-point)) - ;; 97/3/14 jhod: Kinsoku processing - ;(indent-new-comment-line) - (let ((spacep (memq (char-before (point)) '(?\ ?\t)))) - (funcall comment-line-break-function) - ;; if user type space explicitly, leave SPC - ;; even if there is no WAN. - (if spacep - (save-excursion - (goto-char fill-point) - ;; put SPC except that there is SPC - ;; already or there is sentence end. - (or (memq (char-after (point)) '(?\ ?\t)) - (fill-end-of-sentence-p) - (insert ?\ ))))) - (save-excursion - (goto-char fill-point) - (funcall comment-line-break-function))) - ;; If making the new line didn't reduce the hpos of - ;; the end of the line, then give up now; - ;; trying again will not help. - (if (>= (current-column) prev-column) - (setq give-up t))) - ;; No place to break => stop trying. - (setq give-up t))))))) - -;; Put FSF one in until I can one or the other working properly, then the -;; other one is history. -;(defun fsf:do-auto-fill () -; (let (fc justify -; ;; bol -; give-up -; (fill-prefix fill-prefix)) -; (if (or (not (setq justify (current-justification))) -; (null (setq fc (current-fill-column))) -; (and (eq justify 'left) -; (<= (current-column) fc)) -; (save-excursion (beginning-of-line) -; ;; (setq bol (point)) -; (and auto-fill-inhibit-regexp -; (looking-at auto-fill-inhibit-regexp)))) -; nil ;; Auto-filling not required -; (if (memq justify '(full center right)) -; (save-excursion (unjustify-current-line))) - -; ;; Choose a fill-prefix automatically. -; (if (and adaptive-fill-mode -; (or (null fill-prefix) (string= fill-prefix ""))) -; (let ((prefix -; (fill-context-prefix -; (save-excursion (backward-paragraph 1) (point)) -; (save-excursion (forward-paragraph 1) (point)) -; ;; Don't accept a non-whitespace fill prefix -; ;; from the first line of a paragraph. -; "^[ \t]*$"))) -; (and prefix (not (equal prefix "")) -; (setq fill-prefix prefix)))) - -; (while (and (not give-up) (> (current-column) fc)) -; ;; Determine where to split the line. -; (let ((fill-point -; (let ((opoint (point)) -; bounce -; (first t)) -; (save-excursion -; (move-to-column (1+ fc)) -; ;; Move back to a word boundary. -; (while (or first -; ;; If this is after period and a single space, -; ;; move back once more--we don't want to break -; ;; the line there and make it look like a -; ;; sentence end. -; (and (not (bobp)) -; (not bounce) -; sentence-end-double-space -; (save-excursion (forward-char -1) -; (and (looking-at "\\. ") -; (not (looking-at "\\. ")))))) -; (setq first nil) -; (skip-chars-backward "^ \t\n") -; ;; If we find nowhere on the line to break it, -; ;; break after one word. Set bounce to t -; ;; so we will not keep going in this while loop. -; (if (bolp) -; (progn -; (re-search-forward "[ \t]" opoint t) -; (setq bounce t))) -; (skip-chars-backward " \t")) -; ;; Let fill-point be set to the place where we end up. -; (point))))) -; ;; If that place is not the beginning of the line, -; ;; break the line there. -; (if (save-excursion -; (goto-char fill-point) -; (not (bolp))) -; (let ((prev-column (current-column))) -; ;; If point is at the fill-point, do not `save-excursion'. -; ;; Otherwise, if a comment prefix or fill-prefix is inserted, -; ;; point will end up before it rather than after it. -; (if (save-excursion -; (skip-chars-backward " \t") -; (= (point) fill-point)) -; (funcall comment-line-break-function t) -; (save-excursion -; (goto-char fill-point) -; (funcall comment-line-break-function t))) -; ;; Now do justification, if required -; (if (not (eq justify 'left)) -; (save-excursion -; (end-of-line 0) -; (justify-current-line justify nil t))) -; ;; If making the new line didn't reduce the hpos of -; ;; the end of the line, then give up now; -; ;; trying again will not help. -; (if (>= (current-column) prev-column) -; (setq give-up t))) -; ;; No place to break => stop trying. -; (setq give-up t)))) -; ;; Justify last line. -; (justify-current-line justify t t) -; t))) - -(defvar normal-auto-fill-function 'do-auto-fill - "The function to use for `auto-fill-function' if Auto Fill mode is turned on. -Some major modes set this.") - -(defun auto-fill-mode (&optional arg) - "Toggle auto-fill mode. -With arg, turn auto-fill mode on if and only if arg is positive. -In Auto-Fill mode, inserting a space at a column beyond `current-fill-column' -automatically breaks the line at a previous space. - -The value of `normal-auto-fill-function' specifies the function to use -for `auto-fill-function' when turning Auto Fill mode on." - (interactive "P") - (prog1 (setq auto-fill-function - (if (if (null arg) - (not auto-fill-function) - (> (prefix-numeric-value arg) 0)) - normal-auto-fill-function - nil)) - (redraw-modeline))) - -;; This holds a document string used to document auto-fill-mode. -(defun auto-fill-function () - "Automatically break line at a previous space, in insertion of text." - nil) - -(defun turn-on-auto-fill () - "Unconditionally turn on Auto Fill mode." - (auto-fill-mode 1)) - -(defun set-fill-column (arg) - "Set `fill-column' to specified argument. -Just \\[universal-argument] as argument means to use the current column -The variable `fill-column' has a separate value for each buffer." - (interactive "_P") ; XEmacs - (cond ((integerp arg) - (setq fill-column arg)) - ((consp arg) - (setq fill-column (current-column))) - ;; Disallow missing argument; it's probably a typo for C-x C-f. - (t - (error "set-fill-column requires an explicit argument"))) - (lmessage 'command "fill-column set to %d" fill-column)) - -(defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill - "*Non-nil means \\[indent-new-comment-line] should continue same comment -on new line, with no new terminator or starter. -This is obsolete because you might as well use \\[newline-and-indent]." - :type 'boolean - :group 'fill-comments) - -(defun indent-new-comment-line (&optional soft) - "Break line at point and indent, continuing comment if within one. -This indents the body of the continued comment -under the previous comment line. - -This command is intended for styles where you write a comment per line, -starting a new comment (and terminating it if necessary) on each line. -If you want to continue one comment across several lines, use \\[newline-and-indent]. - -If a fill column is specified, it overrides the use of the comment column -or comment indentation. - -The inserted newline is marked hard if `use-hard-newlines' is true, -unless optional argument SOFT is non-nil." - (interactive) - (let (comcol comstart) - (skip-chars-backward " \t") - ;; 97/3/14 jhod: Kinsoku processing - (if (featurep 'mule) - (kinsoku-process)) - (delete-region (point) - (progn (skip-chars-forward " \t") - (point))) - (if soft (insert ?\n) (newline 1)) - (if fill-prefix - (progn - (indent-to-left-margin) - (insert fill-prefix)) - ;; #### - Eric Eide reverts to v18 semantics for this function in - ;; fa-extras, which I'm not gonna do. His changes are to (1) execute - ;; the save-excursion below unconditionally, and (2) uncomment the check - ;; for (not comment-multi-line) further below. --Stig - ;;#### jhod: probably need to fix this for kinsoku processing - (if (not comment-multi-line) - (save-excursion - (if (and comment-start-skip - (let ((opoint (point))) - (forward-line -1) - (re-search-forward comment-start-skip opoint t))) - ;; The old line is a comment. - ;; Set WIN to the pos of the comment-start. - ;; But if the comment is empty, look at preceding lines - ;; to find one that has a nonempty comment. - - ;; If comment-start-skip contains a \(...\) pair, - ;; the real comment delimiter starts at the end of that pair. - (let ((win (or (match-end 1) (match-beginning 0)))) - (while (and (eolp) (not (bobp)) - (let (opoint) - (beginning-of-line) - (setq opoint (point)) - (forward-line -1) - (re-search-forward comment-start-skip opoint t))) - (setq win (or (match-end 1) (match-beginning 0)))) - ;; Indent this line like what we found. - (goto-char win) - (setq comcol (current-column)) - (setq comstart - (buffer-substring (point) (match-end 0))))))) - (if (and comcol (not fill-prefix)) ; XEmacs - (ENE) from fa-extras. - (let ((comment-column comcol) - (comment-start comstart) - (comment-end comment-end)) - (and comment-end (not (equal comment-end "")) - ; (if (not comment-multi-line) - (progn - (forward-char -1) - (insert comment-end) - (forward-char 1)) - ; (setq comment-column (+ comment-column (length comment-start)) - ; comment-start "") - ; ) - ) - (if (not (eolp)) - (setq comment-end "")) - (insert ?\n) - (forward-char -1) - (indent-for-comment) - (save-excursion - ;; Make sure we delete the newline inserted above. - (end-of-line) - (delete-char 1))) - (indent-according-to-mode))))) - - -(defun set-selective-display (arg) - "Set `selective-display' to ARG; clear it if no arg. -When the value of `selective-display' is a number > 0, -lines whose indentation is >= that value are not displayed. -The variable `selective-display' has a separate value for each buffer." - (interactive "P") - (if (eq selective-display t) - (error "selective-display already in use for marked lines")) - (let ((current-vpos - (save-restriction - (narrow-to-region (point-min) (point)) - (goto-char (window-start)) - (vertical-motion (window-height))))) - (setq selective-display - (and arg (prefix-numeric-value arg))) - (recenter current-vpos)) - (set-window-start (selected-window) (window-start (selected-window))) - ;; #### doesn't localize properly: - (princ "selective-display set to " t) - (prin1 selective-display t) - (princ "." t)) - -;; XEmacs -(defun nuke-selective-display () - "Ensure that the buffer is not in selective-display mode. -If `selective-display' is t, then restore the buffer text to its original -state before disabling selective display." - ;; by Stig@hackvan.com - (interactive) - (and (eq t selective-display) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((mod-p (buffer-modified-p)) - (buffer-read-only nil)) - (while (search-forward "\r" nil t) - (delete-char -1) - (insert "\n")) - (set-buffer-modified-p mod-p) - )))) - (setq selective-display nil)) - -(add-hook 'change-major-mode-hook 'nuke-selective-display) - -(defconst overwrite-mode-textual (purecopy " Ovwrt") - "The string displayed in the mode line when in overwrite mode.") -(defconst overwrite-mode-binary (purecopy " Bin Ovwrt") - "The string displayed in the mode line when in binary overwrite mode.") - -(defun overwrite-mode (arg) - "Toggle overwrite mode. -With arg, turn overwrite mode on iff arg is positive. -In overwrite mode, printing characters typed in replace existing text -on a one-for-one basis, rather than pushing it to the right. At the -end of a line, such characters extend the line. Before a tab, -such characters insert until the tab is filled in. -\\[quoted-insert] still inserts characters in overwrite mode; this -is supposed to make it easier to insert characters when necessary." - (interactive "P") - (setq overwrite-mode - (if (if (null arg) (not overwrite-mode) - (> (prefix-numeric-value arg) 0)) - 'overwrite-mode-textual)) - (redraw-modeline)) - -(defun binary-overwrite-mode (arg) - "Toggle binary overwrite mode. -With arg, turn binary overwrite mode on iff arg is positive. -In binary overwrite mode, printing characters typed in replace -existing text. Newlines are not treated specially, so typing at the -end of a line joins the line to the next, with the typed character -between them. Typing before a tab character simply replaces the tab -with the character typed. -\\[quoted-insert] replaces the text at the cursor, just as ordinary -typing characters do. - -Note that binary overwrite mode is not its own minor mode; it is a -specialization of overwrite-mode, entered by setting the -`overwrite-mode' variable to `overwrite-mode-binary'." - (interactive "P") - (setq overwrite-mode - (if (if (null arg) - (not (eq overwrite-mode 'overwrite-mode-binary)) - (> (prefix-numeric-value arg) 0)) - 'overwrite-mode-binary)) - (redraw-modeline)) - -(defcustom line-number-mode nil - "*Non-nil means display line number in modeline." - :type 'boolean - :group 'editing-basics) - -(defun line-number-mode (arg) - "Toggle Line Number mode. -With arg, turn Line Number mode on iff arg is positive. -When Line Number mode is enabled, the line number appears -in the mode line." - (interactive "P") - (setq line-number-mode - (if (null arg) (not line-number-mode) - (> (prefix-numeric-value arg) 0))) - (redraw-modeline)) - -(defcustom column-number-mode nil - "*Non-nil means display column number in mode line." - :type 'boolean - :group 'editing-basics) - -(defun column-number-mode (arg) - "Toggle Column Number mode. -With arg, turn Column Number mode on iff arg is positive. -When Column Number mode is enabled, the column number appears -in the mode line." - (interactive "P") - (setq column-number-mode - (if (null arg) (not column-number-mode) - (> (prefix-numeric-value arg) 0))) - (redraw-modeline)) - - -(defcustom blink-matching-paren t - "*Non-nil means show matching open-paren when close-paren is inserted." - :type 'boolean - :group 'paren-blinking) - -(defcustom blink-matching-paren-on-screen t - "*Non-nil means show matching open-paren when it is on screen. -nil means don't show it (but the open-paren can still be shown -when it is off screen." - :type 'boolean - :group 'paren-blinking) - -(defcustom blink-matching-paren-distance 12000 - "*If non-nil, is maximum distance to search for matching open-paren." - :type '(choice integer (const nil)) - :group 'paren-blinking) - -(defcustom blink-matching-delay 1 - "*The number of seconds that `blink-matching-open' will delay at a match." - :type 'number - :group 'paren-blinking) - -(defcustom blink-matching-paren-dont-ignore-comments nil - "*Non-nil means `blink-matching-paren' should not ignore comments." - :type 'boolean - :group 'paren-blinking) - -(defun blink-matching-open () - "Move cursor momentarily to the beginning of the sexp before point." - (interactive "_") ; XEmacs - (and (> (point) (1+ (point-min))) - blink-matching-paren - ;; Verify an even number of quoting characters precede the close. - (= 1 (logand 1 (- (point) - (save-excursion - (forward-char -1) - (skip-syntax-backward "/\\") - (point))))) - (let* ((oldpos (point)) - (blinkpos) - (mismatch)) - (save-excursion - (save-restriction - (if blink-matching-paren-distance - (narrow-to-region (max (point-min) - (- (point) blink-matching-paren-distance)) - oldpos)) - (condition-case () - (let ((parse-sexp-ignore-comments - (and parse-sexp-ignore-comments - (not blink-matching-paren-dont-ignore-comments)))) - (setq blinkpos (scan-sexps oldpos -1))) - (error nil))) - (and blinkpos - (/= (char-syntax (char-after blinkpos)) - ?\$) - (setq mismatch - (or (null (matching-paren (char-after blinkpos))) - (/= (char-after (1- oldpos)) - (matching-paren (char-after blinkpos)))))) - (if mismatch (setq blinkpos nil)) - (if blinkpos - (progn - (goto-char blinkpos) - (if (pos-visible-in-window-p) - (and blink-matching-paren-on-screen - (progn - (auto-show-make-point-visible) - (sit-for blink-matching-delay))) - (goto-char blinkpos) - (lmessage 'command "Matches %s" - ;; Show what precedes the open in its line, if anything. - (if (save-excursion - (skip-chars-backward " \t") - (not (bolp))) - (buffer-substring (progn (beginning-of-line) (point)) - (1+ blinkpos)) - ;; Show what follows the open in its line, if anything. - (if (save-excursion - (forward-char 1) - (skip-chars-forward " \t") - (not (eolp))) - (buffer-substring blinkpos - (progn (end-of-line) (point))) - ;; Otherwise show the previous nonblank line, - ;; if there is one. - (if (save-excursion - (skip-chars-backward "\n \t") - (not (bobp))) - (concat - (buffer-substring (progn - (skip-chars-backward "\n \t") - (beginning-of-line) - (point)) - (progn (end-of-line) - (skip-chars-backward " \t") - (point))) - ;; Replace the newline and other whitespace with `...'. - "..." - (buffer-substring blinkpos (1+ blinkpos))) - ;; There is nothing to show except the char itself. - (buffer-substring blinkpos (1+ blinkpos)))))))) - (cond (mismatch - (display-message 'no-log "Mismatched parentheses")) - ((not blink-matching-paren-distance) - (display-message 'no-log "Unmatched parenthesis")))))))) - -;Turned off because it makes dbx bomb out. -(setq blink-paren-function 'blink-matching-open) - -(eval-when-compile (defvar myhelp)) ; suppress compiler warning - -;; XEmacs: Some functions moved to cmdloop.el: -;; keyboard-quit -;; buffer-quit-function -;; keyboard-escape-quit - -(defun assoc-ignore-case (key alist) - "Like `assoc', but assumes KEY is a string and ignores case when comparing." - (setq key (downcase key)) - (let (element) - (while (and alist (not element)) - (if (equal key (downcase (car (car alist)))) - (setq element (car alist))) - (setq alist (cdr alist))) - element)) - - -(defcustom mail-user-agent 'sendmail-user-agent - "*Your preference for a mail composition package. -Various Emacs Lisp packages (e.g. reporter) require you to compose an -outgoing email message. This variable lets you specify which -mail-sending package you prefer. - -Valid values include: - - sendmail-user-agent -- use the default Emacs Mail package - mh-e-user-agent -- use the Emacs interface to the MH mail system - message-user-agent -- use the GNUS mail sending package - -Additional valid symbols may be available; check with the author of -your package for details." - :type '(radio (function-item :tag "Default Emacs mail" - :format "%t\n" - sendmail-user-agent) - (function-item :tag "Gnus mail sending package" - :format "%t\n" - message-user-agent) - (function :tag "Other")) - :group 'mail) - -(defun define-mail-user-agent (symbol composefunc sendfunc - &optional abortfunc hookvar) - "Define a symbol to identify a mail-sending package for `mail-user-agent'. - -SYMBOL can be any Lisp symbol. Its function definition and/or -value as a variable do not matter for this usage; we use only certain -properties on its property list, to encode the rest of the arguments. - -COMPOSEFUNC is program callable function that composes an outgoing -mail message buffer. This function should set up the basics of the -buffer without requiring user interaction. It should populate the -standard mail headers, leaving the `to:' and `subject:' headers blank -by default. - -COMPOSEFUNC should accept several optional arguments--the same -arguments that `compose-mail' takes. See that function's documentation. - -SENDFUNC is the command a user would run to send the message. - -Optional ABORTFUNC is the command a user would run to abort the -message. For mail packages that don't have a separate abort function, -this can be `kill-buffer' (the equivalent of omitting this argument). - -Optional HOOKVAR is a hook variable that gets run before the message -is actually sent. Callers that use the `mail-user-agent' may -install a hook function temporarily on this hook variable. -If HOOKVAR is nil, `mail-send-hook' is used. - -The properties used on SYMBOL are `composefunc', `sendfunc', -`abortfunc', and `hookvar'." - (put symbol 'composefunc composefunc) - (put symbol 'sendfunc sendfunc) - (put symbol 'abortfunc (or abortfunc 'kill-buffer)) - (put symbol 'hookvar (or hookvar 'mail-send-hook))) - -(define-mail-user-agent 'sendmail-user-agent - 'sendmail-user-agent-compose 'mail-send-and-exit) - -(define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook) - -(defun sendmail-user-agent-compose (&optional to subject other-headers continue - switch-function yank-action - send-actions) - (if switch-function - (let ((special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (funcall switch-function "*mail*"))) - (let ((cc (cdr (assoc-ignore-case "cc" other-headers))) - (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers)))) - (or (mail continue to subject in-reply-to cc yank-action send-actions) - continue - (error "Message aborted")) - (save-excursion - (goto-char (point-min)) - (search-forward mail-header-separator) - (beginning-of-line) - (while other-headers - (if (not (member (car (car other-headers)) '("in-reply-to" "cc"))) - (insert (car (car other-headers)) ": " - (cdr (car other-headers)) "\n")) - (setq other-headers (cdr other-headers))) - t))) - -(define-mail-user-agent 'mh-e-user-agent - 'mh-user-agent-compose 'mh-send-letter 'mh-fully-kill-draft - 'mh-before-send-letter-hook) - -(defun compose-mail (&optional to subject other-headers continue - switch-function yank-action send-actions) - "Start composing a mail message to send. -This uses the user's chosen mail composition package -as selected with the variable `mail-user-agent'. -The optional arguments TO and SUBJECT specify recipients -and the initial Subject field, respectively. - -OTHER-HEADERS is an alist specifying additional -header fields. Elements look like (HEADER . VALUE) where both -HEADER and VALUE are strings. - -CONTINUE, if non-nil, says to continue editing a message already -being composed. - -SWITCH-FUNCTION, if non-nil, is a function to use to -switch to and display the buffer used for mail composition. - -YANK-ACTION, if non-nil, is an action to perform, if and when necessary, -to insert the raw text of the message being replied to. -It has the form (FUNCTION . ARGS). The user agent will apply -FUNCTION to ARGS, to insert the raw text of the original message. -\(The user agent will also run `mail-citation-hook', *after* the -original text has been inserted in this way.) - -SEND-ACTIONS is a list of actions to call when the message is sent. -Each action has the form (FUNCTION . ARGS)." - (interactive - (list nil nil nil current-prefix-arg)) - (let ((function (get mail-user-agent 'composefunc))) - (funcall function to subject other-headers continue - switch-function yank-action send-actions))) - -(defun compose-mail-other-window (&optional to subject other-headers continue - yank-action send-actions) - "Like \\[compose-mail], but edit the outgoing message in another window." - (interactive - (list nil nil nil current-prefix-arg)) - (compose-mail to subject other-headers continue - 'switch-to-buffer-other-window yank-action send-actions)) - - -(defun compose-mail-other-frame (&optional to subject other-headers continue - yank-action send-actions) - "Like \\[compose-mail], but edit the outgoing message in another frame." - (interactive - (list nil nil nil current-prefix-arg)) - (compose-mail to subject other-headers continue - 'switch-to-buffer-other-frame yank-action send-actions)) - - -(defun set-variable (var val) - "Set VARIABLE to VALUE. VALUE is a Lisp object. -When using this interactively, supply a Lisp expression for VALUE. -If you want VALUE to be a string, you must surround it with doublequotes. -If VARIABLE is a specifier, VALUE is added to it as an instantiator in -the 'global locale with nil tag set (see `set-specifier'). - -If VARIABLE has a `variable-interactive' property, that is used as if -it were the arg to `interactive' (which see) to interactively read the value." - (interactive - (let* ((var (read-variable "Set variable: ")) - ;; #### - yucky code replication here. This should use something - ;; from help.el or hyper-apropos.el - (minibuffer-help-form - '(funcall myhelp)) - (myhelp - #'(lambda () - (with-output-to-temp-buffer "*Help*" - (prin1 var) - (princ "\nDocumentation:\n") - (princ (substring (documentation-property var 'variable-documentation) - 1)) - (if (boundp var) - (let ((print-length 20)) - (princ "\n\nCurrent value: ") - (prin1 (symbol-value var)))) - (save-excursion - (set-buffer standard-output) - (help-mode)) - nil)))) - (list var - (let ((prop (get var 'variable-interactive))) - (if prop - ;; Use VAR's `variable-interactive' property - ;; as an interactive spec for prompting. - (call-interactively (list 'lambda '(arg) - (list 'interactive prop) - 'arg)) - (eval-minibuffer (format "Set %s to value: " var))))))) - (if (and (boundp var) (specifierp (symbol-value var))) - (set-specifier (symbol-value var) val) - (set var val))) - -;; XEmacs -(defun activate-region () - "Activate the region, if `zmacs-regions' is true. -Setting `zmacs-regions' to true causes LISPM-style active regions to be used. -This function has no effect if `zmacs-regions' is false." - (interactive) - (and zmacs-regions (zmacs-activate-region))) - -;; XEmacs -(defsubst region-exists-p () - "Return t if the region exists. -If active regions are in use (i.e. `zmacs-regions' is true), this means that - the region is active. Otherwise, this means that the user has pushed - a mark in this buffer at some point in the past. -The functions `region-beginning' and `region-end' can be used to find the - limits of the region." - (not (null (mark)))) - -;; XEmacs -(defun region-active-p () - "Return non-nil if the region is active. -If `zmacs-regions' is true, this is equivalent to `region-exists-p'. -Otherwise, this function always returns false." - (and zmacs-regions zmacs-region-extent)) - -;; A bunch of stuff was moved elsewhere: -;; completion-list-mode-map -;; completion-reference-buffer -;; completion-base-size -;; delete-completion-window -;; previous-completion -;; next-completion -;; choose-completion -;; choose-completion-delete-max-match -;; choose-completion-string -;; completion-list-mode -;; completion-fixup-function -;; completion-setup-function -;; switch-to-completions -;; event stuffs -;; keypad stuffs - -;; The rest of this file is not in Lisp in FSF -(defun capitalize-region-or-word (arg) - "Capitalize the selected region or the following word (or ARG words)." - (interactive "p") - (if (region-active-p) - (capitalize-region (region-beginning) (region-end)) - (capitalize-word arg))) - -(defun upcase-region-or-word (arg) - "Upcase the selected region or the following word (or ARG words)." - (interactive "p") - (if (region-active-p) - (upcase-region (region-beginning) (region-end)) - (upcase-word arg))) - -(defun downcase-region-or-word (arg) - "Downcase the selected region or the following word (or ARG words)." - (interactive "p") - (if (region-active-p) - (downcase-region (region-beginning) (region-end)) - (downcase-word arg))) - -;; Most of the zmacs code is now in elisp. The only thing left in C -;; are the variables zmacs-regions, zmacs-region-active-p and -;; zmacs-region-stays plus the function zmacs_update_region which -;; simply calls the lisp level zmacs-update-region. It must remain -;; for convenience, since it is called by core C code. - -(defvar zmacs-activate-region-hook nil - "Function or functions called when the region becomes active; -see the variable `zmacs-regions'.") - -(defvar zmacs-deactivate-region-hook nil - "Function or functions called when the region becomes inactive; -see the variable `zmacs-regions'.") - -(defvar zmacs-update-region-hook nil - "Function or functions called when the active region changes. -This is called after each command that sets `zmacs-region-stays' to t. -See the variable `zmacs-regions'.") - -(defvar zmacs-region-extent nil - "The extent of the zmacs region; don't use this.") - -(defvar zmacs-region-rectangular-p nil - "Whether the zmacs region is a rectangle; don't use this.") - -(defun zmacs-make-extent-for-region (region) - ;; Given a region, this makes an extent in the buffer which holds that - ;; region, for highlighting purposes. If the region isn't associated - ;; with a buffer, this does nothing. - (let ((buffer nil) - (valid (and (extentp zmacs-region-extent) - (extent-object zmacs-region-extent) - (buffer-live-p (extent-object zmacs-region-extent)))) - start end) - (cond ((consp region) - (setq start (min (car region) (cdr region)) - end (max (car region) (cdr region)) - valid (and valid - (eq (marker-buffer (car region)) - (extent-object zmacs-region-extent))) - buffer (marker-buffer (car region)))) - (t - (signal 'error (list "Invalid region" region)))) - - (if valid - nil - ;; The condition case is in case any of the extents are dead or - ;; otherwise incapacitated. - (condition-case () - (if (listp zmacs-region-extent) - (mapc 'delete-extent zmacs-region-extent) - (delete-extent zmacs-region-extent)) - (error nil))) - - (if valid - (set-extent-endpoints zmacs-region-extent start end) - (setq zmacs-region-extent (make-extent start end buffer)) - - ;; Make the extent be closed on the right, which means that if - ;; characters are inserted exactly at the end of the extent, the - ;; extent will grow to cover them. This is important for shell - ;; buffers - suppose one makes a region, and one end is at point-max. - ;; If the shell produces output, that marker will remain at point-max - ;; (its position will increase). So it's important that the extent - ;; exhibit the same behavior, lest the region covered by the extent - ;; (the visual indication), and the region between point and mark - ;; (the actual region value) become different! - (set-extent-property zmacs-region-extent 'end-open nil) - - ;; use same priority as mouse-highlighting so that conflicts between - ;; the region extent and a mouse-highlighted extent are resolved by - ;; the usual size-and-endpoint-comparison method. - (set-extent-priority zmacs-region-extent mouse-highlight-priority) - (set-extent-face zmacs-region-extent 'zmacs-region) - - ;; #### It might be better to actually break - ;; default-mouse-track-next-move-rect out of mouse.el so that we - ;; can use its logic here. - (cond - (zmacs-region-rectangular-p - (setq zmacs-region-extent (list zmacs-region-extent)) - (default-mouse-track-next-move-rect start end zmacs-region-extent) - )) - - zmacs-region-extent))) - -(defun zmacs-region-buffer () - "Return the buffer containing the zmacs region, or nil." - ;; #### this is horrible and kludgy! This stuff needs to be rethought. - (and zmacs-regions zmacs-region-active-p - (or (marker-buffer (mark-marker t)) - (and (extent-live-p zmacs-region-extent) - (buffer-live-p (extent-object zmacs-region-extent)) - (extent-object zmacs-region-extent))))) - -(defun zmacs-activate-region () - "Make the region between `point' and `mark' be active (highlighted), -if `zmacs-regions' is true. Only a very small number of commands -should ever do this. Calling this function will call the hook -`zmacs-activate-region-hook', if the region was previously inactive. -Calling this function ensures that the region stays active after the -current command terminates, even if `zmacs-region-stays' is not set. -Returns t if the region was activated (i.e. if `zmacs-regions' if t)." - (if (not zmacs-regions) - nil - (setq zmacs-region-active-p t - zmacs-region-stays t - zmacs-region-rectangular-p (and (boundp 'mouse-track-rectangle-p) - mouse-track-rectangle-p)) - (if (marker-buffer (mark-marker t)) - (zmacs-make-extent-for-region (cons (point-marker t) (mark-marker t)))) - (run-hooks 'zmacs-activate-region-hook) - t)) - -(defun zmacs-deactivate-region () - "Make the region between `point' and `mark' no longer be active, -if `zmacs-regions' is true. You shouldn't need to call this; the -command loop calls it when appropriate. Calling this function will -call the hook `zmacs-deactivate-region-hook', if the region was -previously active. Returns t if the region had been active, nil -otherwise." - (if (not zmacs-region-active-p) - nil - (setq zmacs-region-active-p nil - zmacs-region-stays nil - zmacs-region-rectangular-p nil) - (if zmacs-region-extent - (let ((inhibit-quit t)) - (if (listp zmacs-region-extent) - (mapc 'delete-extent zmacs-region-extent) - (delete-extent zmacs-region-extent)) - (setq zmacs-region-extent nil))) - (run-hooks 'zmacs-deactivate-region-hook) - t)) - -(defun zmacs-update-region () - "Update the highlighted region between `point' and `mark'. -You shouldn't need to call this; the command loop calls it -when appropriate. Calling this function will call the hook -`zmacs-update-region-hook', if the region is active." - (when zmacs-region-active-p - (when (marker-buffer (mark-marker t)) - (zmacs-make-extent-for-region (cons (point-marker t) - (mark-marker t)))) - (run-hooks 'zmacs-update-region-hook))) - -;;;;;; -;;;;;; echo area stuff -;;;;;; - -;;; #### Should this be moved to a separate file, for clarity? -;;; -hniksic - -;;; The `message-stack' is an alist of labels with messages; the first -;;; message in this list is always in the echo area. A call to -;;; `display-message' inserts a label/message pair at the head of the -;;; list, and removes any other pairs with that label. Calling -;;; `clear-message' causes any pair with matching label to be removed, -;;; and this may cause the displayed message to change or vanish. If -;;; the label arg is nil, the entire message stack is cleared. -;;; -;;; Message/error filtering will be a little tricker to implement than -;;; logging, since messages can be built up incrementally -;;; using clear-message followed by repeated calls to append-message -;;; (this happens with error messages). For messages which aren't -;;; created this way, filtering could be implemented at display-message -;;; very easily. -;;; -;;; Bits of the logging code are borrowed from log-messages.el by -;;; Robert Potter (rpotter@grip.cis.upenn.edu). - -;; need this to terminate the currently-displayed message -;; ("Loading simple ...") -(when (and - (not (fboundp 'display-message)) - (not (featurep 'debug))) - (send-string-to-terminal "\n")) - -(defvar message-stack nil - "An alist of label/string pairs representing active echo-area messages. -The first element in the list is currently displayed in the echo area. -Do not modify this directly--use the `message' or -`display-message'/`clear-message' functions.") - -(defvar remove-message-hook 'log-message - "A function or list of functions to be called when a message is removed -from the echo area at the bottom of the frame. The label of the removed -message is passed as the first argument, and the text of the message -as the second argument.") - -(defcustom log-message-max-size 50000 - "Maximum size of the \" *Message-Log*\" buffer. See `log-message'." - :type 'integer - :group 'log-message) -(make-compatible-variable 'message-log-max 'log-message-max-size) - -;; We used to reject quite a lot of stuff here, but it was a bad idea, -;; for two reasons: -;; -;; a) In most circumstances, you *want* to see the message in the log. -;; The explicitly non-loggable messages should be marked as such by -;; the issuer. Gratuitous non-displaying of random regexps made -;; debugging harder, too (because various reasonable debugging -;; messages would get eaten). -;; -;; b) It slowed things down. Yes, visibly. -;; -;; So, I left only a few of the really useless ones on this kill-list. -;; -;; --hniksic -(defcustom log-message-ignore-regexps - '(;; Note: adding entries to this list slows down messaging - ;; significantly. Wherever possible, use message lables. - - ;; Often-seen messages - "\\`\\'" ; empty message - "\\`\\(Beginning\\|End\\) of buffer\\'" - ;;"^Quit$" - ;; completions - ;; Many packages print this -- impossible to categorize - ;;"^Making completion list" - ;; Gnus - ;; "^No news is no news$" - ;; "^No more\\( unread\\)? newsgroups$" - ;; "^Opening [^ ]+ server\\.\\.\\." - ;; "^[^:]+: Reading incoming mail" - ;; "^Getting mail from " - ;; "^\\(Generating Summary\\|Sorting threads\\|Making sparse threads\\|Scoring\\|Checking new news\\|Expiring articles\\|Sending\\)\\.\\.\\." - ;; "^\\(Fetching headers for\\|Retrieving newsgroup\\|Reading active file\\)" - ;; "^No more\\( unread\\)? articles" - ;; "^Deleting article " - ;; W3 - ;; "^Parsed [0-9]+ of [0-9]+ ([0-9]+%)" - ) - "List of regular expressions matching messages which shouldn't be logged. -See `log-message'. - -Ideally, packages which generate messages which might need to be ignored -should label them with 'progress, 'prompt, or 'no-log, so they can be -filtered by the log-message-ignore-labels." - :type '(repeat regexp) - :group 'log-message) - -(defcustom log-message-ignore-labels - '(help-echo command progress prompt no-log garbage-collecting auto-saving) - "List of symbols indicating labels of messages which shouldn't be logged. -See `display-message' for some common labels. See also `log-message'." - :type '(repeat (symbol :tag "Label")) - :group 'log-message) - -;;Subsumed by view-lossage -;; Not really, I'm adding it back by popular demand. -slb -(defun show-message-log () - "Show the \" *Message-Log*\" buffer, which contains old messages and errors." - (interactive) - (pop-to-buffer (get-buffer-create " *Message-Log*"))) - -(defvar log-message-filter-function 'log-message-filter - "Value must be a function of two arguments: a symbol (label) and -a string (message). It should return non-nil to indicate a message -should be logged. Possible values include 'log-message-filter and -'log-message-filter-errors-only.") - -(defun log-message-filter (label message) - "Default value of `log-message-filter-function'. -Messages whose text matches one of the `log-message-ignore-regexps' -or whose label appears in `log-message-ignore-labels' are not saved." - (let ((r log-message-ignore-regexps) - (ok (not (memq label log-message-ignore-labels)))) - (save-match-data - (while (and r ok) - (when (string-match (car r) message) - (setq ok nil)) - (setq r (cdr r)))) - ok)) - -(defun log-message-filter-errors-only (label message) - "For use as the `log-message-filter-function'. Only logs error messages." - (eq label 'error)) - -(defun log-message (label message) - "Stuff a copy of the message into the \" *Message-Log*\" buffer, -if it satisfies the `log-message-filter-function'. - -For use on `remove-message-hook'." - (when (and (not noninteractive) - (funcall log-message-filter-function label message)) - ;; Use save-excursion rather than save-current-buffer because we - ;; change the value of point. - (save-excursion - (set-buffer (get-buffer-create " *Message-Log*")) - (goto-char (point-max)) - ;(insert (concat (upcase (symbol-name label)) ": " message "\n")) - (let (extent) - ;; Mark multiline message with an extent, which `view-lossage' - ;; will recognize. - (when (string-match "\n" message) - (setq extent (make-extent (point) (point))) - (set-extent-properties extent '(end-open nil message-multiline t))) - (insert message "\n") - (when extent - (set-extent-property extent 'end-open t))) - (when (> (point-max) (max log-message-max-size (point-min))) - ;; Trim log to ~90% of max size. - (goto-char (max (- (point-max) - (truncate (* 0.9 log-message-max-size))) - (point-min))) - (forward-line 1) - (delete-region (point-min) (point)))))) - -(defun message-displayed-p (&optional return-string frame) - "Return a non-nil value if a message is presently displayed in the\n\ -minibuffer's echo area. If optional argument RETURN-STRING is non-nil,\n\ -return a string containing the message, otherwise just return t." - ;; by definition, a message is displayed if the echo area buffer is - ;; non-empty (see also echo_area_active()). It had better also - ;; be the case that message-stack is nil exactly when the echo area - ;; is non-empty. - (let ((buffer (get-buffer " *Echo Area*"))) - (and (< (point-min buffer) (point-max buffer)) - (if return-string - (buffer-substring nil nil buffer) - t)))) - -;;; Returns the string which remains in the echo area, or nil if none. -;;; If label is nil, the whole message stack is cleared. -(defun clear-message (&optional label frame stdout-p no-restore) - "Remove any message with the given LABEL from the message-stack, -erasing it from the echo area if it's currently displayed there. -If a message remains at the head of the message-stack and NO-RESTORE -is nil, it will be displayed. The string which remains in the echo -area will be returned, or nil if the message-stack is now empty. -If LABEL is nil, the entire message-stack is cleared. - -Unless you need the return value or you need to specify a label, -you should just use (message nil)." - (or frame (setq frame (selected-frame))) - (let ((clear-stream (and message-stack (eq 'stream (frame-type frame))))) - (remove-message label frame) - (let ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) ; preserve from change - (erase-buffer " *Echo Area*")) - (if clear-stream - (send-string-to-terminal ?\n stdout-p)) - (if no-restore - nil ; just preparing to put another msg up - (if message-stack - (let ((oldmsg (cdr (car message-stack)))) - (raw-append-message oldmsg frame stdout-p) - oldmsg) - ;; #### Should we (redisplay-echo-area) here? Messes some - ;; things up. - nil)))) - -(defun remove-message (&optional label frame) - ;; If label is nil, we want to remove all matching messages. - ;; Must reverse the stack first to log them in the right order. - (let ((log nil)) - (while (and message-stack - (or (null label) ; null label means clear whole stack - (eq label (car (car message-stack))))) - (push (car message-stack) log) - (setq message-stack (cdr message-stack))) - (let ((s message-stack)) - (while (cdr s) - (let ((msg (car (cdr s)))) - (if (eq label (car msg)) - (progn - (push msg log) - (setcdr s (cdr (cdr s)))) - (setq s (cdr s)))))) - ;; (possibly) log each removed message - (while log - (condition-case e - (run-hook-with-args 'remove-message-hook - (car (car log)) (cdr (car log))) - (error (setq remove-message-hook nil) - (lwarn 'message-log 'warning - "Error caught in `remove-message-hook': %s" - (error-message-string e)) - (let ((inhibit-read-only t)) - (erase-buffer " *Echo Area*")) - (signal (car e) (cdr e)))) - (setq log (cdr log))))) - -(defun append-message (label message &optional frame stdout-p) - (or frame (setq frame (selected-frame))) - ;; Add a new entry to the message-stack, or modify an existing one - (let ((top (car message-stack))) - (if (eq label (car top)) - (setcdr top (concat (cdr top) message)) - (push (cons label message) message-stack))) - (raw-append-message message frame stdout-p)) - -;; Really append the message to the echo area. no fiddling with -;; message-stack. -(defun raw-append-message (message &optional frame stdout-p) - (unless (equal message "") - (let ((inhibit-read-only t) - (zmacs-region-stays zmacs-region-stays)) ; preserve from change - (insert-string message " *Echo Area*") - ;; Conditionalizing on the device type in this way is not that clean, - ;; but neither is having a device method, as I originally implemented - ;; it: all non-stream devices behave in the same way. Perhaps - ;; the cleanest way is to make the concept of a "redisplayable" - ;; device, which stream devices are not. Look into this more if - ;; we ever create another non-redisplayable device type (e.g. - ;; processes? printers?). - - ;; Don't redisplay the echo area if we are executing a macro. - (if (not executing-kbd-macro) - (if (eq 'stream (frame-type frame)) - (send-string-to-terminal message stdout-p (frame-device frame)) - (redisplay-echo-area)))))) - -(defun display-message (label message &optional frame stdout-p) - "Print a one-line message at the bottom of the frame. First argument -LABEL is an identifier for this message. MESSAGE is the string to display. -Use `clear-message' to remove a labelled message. - -Here are some standard labels (those marked with `*' are not logged -by default--see the `log-message-ignore-labels' variable): - message default label used by the `message' function - error default label used for reporting errors - * progress progress indicators like \"Converting... 45%\" - * prompt prompt-like messages like \"I-search: foo\" - * command helper command messages like \"Mark set\" - * no-log messages that should never be logged" - (clear-message label frame stdout-p t) - (append-message label message frame stdout-p)) - -(defun current-message (&optional frame) - "Return the current message in the echo area, or nil. -The FRAME argument is currently unused." - (cdr (car message-stack))) - -;;; may eventually be frame-dependent -(defun current-message-label (&optional frame) - (car (car message-stack))) - -(defun message (fmt &rest args) - "Print a one-line message at the bottom of the frame. -The arguments are the same as to `format'. - -If the only argument is nil, clear any existing message; let the -minibuffer contents show." - ;; questionable junk in the C code - ;; (if (framep default-minibuffer-frame) - ;; (make-frame-visible default-minibuffer-frame)) - (if (and (null fmt) (null args)) - (prog1 nil - (clear-message nil)) - (let ((str (apply 'format fmt args))) - (display-message 'message str) - str))) - -(defun lmessage (label fmt &rest args) - "Print a one-line message at the bottom of the frame. -First argument LABEL is an identifier for this message. The rest of the -arguments are the same as to `format'. - -See `display-message' for a list of standard labels." - (if (and (null fmt) (null args)) - (prog1 nil - (clear-message label nil)) - (let ((str (apply 'format fmt args))) - (display-message label str) - str))) - - -;;;;;; -;;;;;; warning stuff -;;;;;; - -(defcustom log-warning-minimum-level 'info - "Minimum level of warnings that should be logged. -The warnings in levels below this are completely ignored, as if they never -happened. - -The recognized warning levels, in decreasing order of priority, are -'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and -'debug. - -See also `display-warning-minimum-level'. - -You can also control which warnings are displayed on a class-by-class -basis. See `display-warning-suppressed-classes' and -`log-warning-suppressed-classes'." - :type '(choice (const emergency) (const alert) (const critical) - (const error) (const warning) (const notice) - (const info) (const debug)) - :group 'warnings) - -(defcustom display-warning-minimum-level 'info - "Minimum level of warnings that should be displayed. -The warnings in levels below this will be generated, but not -displayed. - -The recognized warning levels, in decreasing order of priority, are -'emergency, 'alert, 'critical, 'error, 'warning, 'notice, 'info, and -'debug. - -See also `log-warning-minimum-level'. - -You can also control which warnings are displayed on a class-by-class -basis. See `display-warning-suppressed-classes' and -`log-warning-suppressed-classes'." - :type '(choice (const emergency) (const alert) (const critical) - (const error) (const warning) (const notice) - (const info) (const debug)) - :group 'warnings) - -(defvar log-warning-suppressed-classes nil - "List of classes of warnings that shouldn't be logged or displayed. -If any of the CLASS symbols associated with a warning is the same as -any of the symbols listed here, the warning will be completely ignored, -as it they never happened. - -NOTE: In most circumstances, you should *not* set this variable. -Set `display-warning-suppressed-classes' instead. That way the suppressed -warnings are not displayed but are still unobtrusively logged. - -See also `log-warning-minimum-level' and `display-warning-minimum-level'.") - -(defcustom display-warning-suppressed-classes nil - "List of classes of warnings that shouldn't be displayed. -If any of the CLASS symbols associated with a warning is the same as -any of the symbols listed here, the warning will not be displayed. -The warning will still logged in the *Warnings* buffer (unless also -contained in `log-warning-suppressed-classes'), but the buffer will -not be automatically popped up. - -See also `log-warning-minimum-level' and `display-warning-minimum-level'." - :type '(repeat symbol) - :group 'warnings) - -(defvar warning-count 0 - "Count of the number of warning messages displayed so far.") - -(defconst warning-level-alist '((emergency . 8) - (alert . 7) - (critical . 6) - (error . 5) - (warning . 4) - (notice . 3) - (info . 2) - (debug . 1))) - -(defun warning-level-p (level) - "Non-nil if LEVEL specifies a warning level." - (and (symbolp level) (assq level warning-level-alist))) - -;; If you're interested in rewriting this function, be aware that it -;; could be called at arbitrary points in a Lisp program (when a -;; built-in function wants to issue a warning, it will call out to -;; this function the next time some Lisp code is evaluated). Therefore, -;; this function *must* not permanently modify any global variables -;; (e.g. the current buffer) except those that specifically apply -;; to the warning system. - -(defvar before-init-deferred-warnings nil) - -(defun after-init-display-warnings () - "Display warnings deferred till after the init file is run. -Warnings that occur before then are deferred so that warning -suppression in the .emacs file will be honored." - (while before-init-deferred-warnings - (apply 'display-warning (car before-init-deferred-warnings)) - (setq before-init-deferred-warnings - (cdr before-init-deferred-warnings)))) - -(add-hook 'after-init-hook 'after-init-display-warnings) - -(defun display-warning (class message &optional level) - "Display a warning message. -CLASS should be a symbol describing what sort of warning this is, such -as `resource' or `key-mapping'. A list of such symbols is also -accepted. (Individual classes can be suppressed; see -`display-warning-suppressed-classes'.) Optional argument LEVEL can -be used to specify a priority for the warning, other than default priority -`warning'. (See `display-warning-minimum-level'). The message is -inserted into the *Warnings* buffer, which is made visible at appropriate -times." - (or level (setq level 'warning)) - (or (listp class) (setq class (list class))) - (check-argument-type 'warning-level-p level) - (if (and (not (featurep 'infodock)) - (not init-file-loaded)) - (push (list class message level) before-init-deferred-warnings) - (catch 'ignored - (let ((display-p t) - (level-num (cdr (assq level warning-level-alist)))) - (if (< level-num (cdr (assq log-warning-minimum-level - warning-level-alist))) - (throw 'ignored nil)) - (if (intersection class log-warning-suppressed-classes) - (throw 'ignored nil)) - - (if (< level-num (cdr (assq display-warning-minimum-level - warning-level-alist))) - (setq display-p nil)) - (if (and display-p - (intersection class display-warning-suppressed-classes)) - (setq display-p nil)) - (let ((buffer (get-buffer-create "*Warnings*"))) - (when display-p - ;; The C code looks at display-warning-tick to determine - ;; when it should call `display-warning-buffer'. Change it - ;; to get the C code's attention. - (incf display-warning-tick)) - (with-current-buffer buffer - (goto-char (point-max)) - (incf warning-count) - (princ (format "(%d) (%s/%s) " - warning-count - (mapconcat 'symbol-name class ",") - level) - buffer) - (princ message buffer) - (terpri buffer) - (terpri buffer))))))) - -(defun warn (&rest args) - "Display a warning message. -The message is constructed by passing all args to `format'. The message -is placed in the *Warnings* buffer, which will be popped up at the next -redisplay. The class of the warning is `warning'. See also -`display-warning'." - (display-warning 'warning (apply 'format args))) - -(defun lwarn (class level &rest args) - "Display a labeled warning message. -CLASS should be a symbol describing what sort of warning this is, such -as `resource' or `key-mapping'. A list of such symbols is also -accepted. (Individual classes can be suppressed; see -`display-warning-suppressed-classes'.) If non-nil, LEVEL can be used -to specify a priority for the warning, other than default priority -`warning'. (See `display-warning-minimum-level'). The message is -inserted into the *Warnings* buffer, which is made visible at appropriate -times. - -The rest of the arguments are passed to `format'." - (display-warning class (apply 'format args) - (or level 'warning))) - -(defvar warning-marker nil) - -;; When this function is called by the C code, all non-local exits are -;; trapped and C-g is inhibited; therefore, it would be a very, very -;; bad idea for this function to get into an infinite loop. - -(defun display-warning-buffer () - "Make the buffer that contains the warnings be visible. -The C code calls this periodically, right before redisplay." - (let ((buffer (get-buffer-create "*Warnings*"))) - (when (or (not warning-marker) - (not (eq (marker-buffer warning-marker) buffer))) - (setq warning-marker (make-marker)) - (set-marker warning-marker 1 buffer)) - (if temp-buffer-show-function - (let ((show-buffer (get-buffer-create "*Warnings-Show*"))) - (save-excursion - (set-buffer show-buffer) - (setq buffer-read-only nil) - (erase-buffer)) - (save-excursion - (set-buffer buffer) - (copy-to-buffer show-buffer - (marker-position warning-marker) - (point-max))) - (funcall temp-buffer-show-function show-buffer)) - (set-window-start (display-buffer buffer) warning-marker)) - (set-marker warning-marker (point-max buffer) buffer))) - -(defun emacs-name () - "Return the printable name of this instance of Emacs." - (cond ((featurep 'infodock) "InfoDock") - ((featurep 'xemacs) "XEmacs") - (t "Emacs"))) - -;;; simple.el ends here diff --git a/lisp/site-load.el b/lisp/site-load.el deleted file mode 100644 index 0fa8cc4..0000000 --- a/lisp/site-load.el +++ /dev/null @@ -1,62 +0,0 @@ -;;; site-load.el --- Template file for site-wide XEmacs customization -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; Keywords: internal - -;; This file is part of XEmacs. - -;;; Commentary: - -;; This is a prototype site-load.el file. -;; The site-load.el mechanism is provided so XEmacs installers can easily -;; dump lisp packages with XEmacs that do not get dumped standardly. - -;; The file `site-packages' if it exists should look something like: -;; (setq site-load-packages '( -;; "../lisp/modes/cc-mode.elc" -;; "../lisp/utils/redo.elc" -;; "../lisp/packages/scroll-in-place.elc" -;; ) -;; ) - -;; The first line and the last line must be exact. Each of the packages -;; listed must be double quoted, have either an absolute path, or a relative -;; to the build src directory path *and* be bytecompiled prior to the attempt -;; to dump. They also must explicitly have the .elc extension. - -;; Because this is a trial implementation and the file is shared with -;; make-docfiles, syntax is strict and unforgiving. So sue me. It -;; is still better than the way it used to be. - -;; Also note that site-packages belongs in the top level directory not the -;; lisp directory for use with --srcdir configurations. - -;;; Code: -(defvar site-load-package-file "../site-packages" - "File name containing the list of extra packages to dump with XEmacs.") -(defvar site-load-packages nil - "A list of .elc files that should be dumped with XEmacs. -This variable should be set by `site-load-package-file'.") - -;; Load site specific packages for dumping with the XEmacs binary. -(when (file-exists-p site-load-package-file) - (let ((file)) - (load site-load-package-file t t t) - ;; The `pureload' macro is provided as a clue that a package is - ;; being loaded in preparation of being dumped into XEmacs. - (defmacro pureload (file) - (list 'prog1 (list 'load file) '(garbage-collect))) - (message "Loading site-wide packages for dumping...") - (while site-load-packages - (setq file (car site-load-packages)) - (pureload file) - (setq site-load-packages (cdr site-load-packages))) - (message "Loading site-wide packages for dumping...done") - (fmakunbound 'pureload))) - -;; This file is intended for end user additions. -;; Put other initialization here, like setting of language-environment, etc. -;; Perhaps this should really be in the site-init.el. - -;;; site-load.el ends here diff --git a/lisp/sound.el b/lisp/sound.el deleted file mode 100644 index af52042..0000000 --- a/lisp/sound.el +++ /dev/null @@ -1,191 +0,0 @@ -;;; sound.el --- Loading sound files in XEmacs - -;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -;; 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: - -;;; Code: -(defgroup sound nil - "Configure XEmacs sounds and properties" - :group 'environment) - -(defcustom sound-default-alist - '((default :sound bass) - (undefined-key :sound drum) - (undefined-click :sound drum) - ;; beginning-of-buffer or end-of-buffer errors. - (buffer-bound :sound drum) - ;; buffer-read-only error - (read-only :sound drum) - ;; non-interactive function or lambda called - (command-error :sound bass) - (y-or-n-p :sound quiet) - (yes-or-no-p :sound quiet) - (auto-save-error :sound whip :volume 100) - (no-completion :sound whip) - (isearch-failed :sound quiet) - (isearch-quit :sound bass) - ;; QUIT: sound generated by ^G and its variants. - (quit :sound quiet :volume 75) - ;; READY: time-consuming task has completed... compile, - ;; cvs-update, etc. - (ready :sound cuckoo) - ;; WARP: XEmacs has changed the selected-window or frame - ;; asynchronously... Especially when it's done by an - ;; asynchronous process filter. Perhaps by a debugger breakpoint - ;; has been hit? - (warp :sound yeep :volume 75) - ;; ALARM: used for reminders... - (alarm :sound cuckoo :volume 100) - ) - "The alist of sounds and associated error symbols. - - Used to set sound-alist in load-default-sounds." - :group 'sound - :type '(repeat - (group (symbol :tag "Name") - (checklist :inline t - :greedy t - (group :inline t - (const :format "" :value :sound) - (symbol :tag "Sound")) - (group :inline t - (const :format "" :value :volume) - (integer :tag "Volume")) - (group :inline t - (const :format "" :value :pitch) - (integer :tag "Pitch")) - (group :inline t - (const :format "" :value :duration) - (integer :tag "Duration")))))) - -(defcustom sound-load-list - '((load-sound-file "drum-beep" 'drum) - (load-sound-file "quiet-beep" 'quiet) - (load-sound-file "bass-snap" 'bass 80) - (load-sound-file "whip" 'whip 70) - (load-sound-file "cuckoo" 'cuckoo) - (load-sound-file "yeep" 'yeep) - (load-sound-file "hype" 'hype 100) - ) - "A list of calls to load-sound-file to be processed by load-default-sounds. - - Reference load-sound-file for more information." - - :group 'sound - :type '(repeat (sexp :tag "Sound") - )) - -(defcustom default-sound-directory (locate-data-directory "sounds") - "Default directory to load a sound file from." - :group 'sound - :type 'directory - ) - -(defcustom sound-extension-list (if (or (eq system-type 'cygwin32) - (eq system-type 'windows-nt)) - ".wav:" ".au:") - "Filename extensions to complete sound file name with. If more than one - extension is used, they should be separated by \":\". " - :group 'sound - :type 'string) - -(defcustom default-sound-directory-list (locate-data-directory-list "sounds") - - "List of directories which to search for sound files" - :group 'sound - :type '(repeat directory ) - ) - -;;;###autoload -(or sound-alist - ;; these should be silent until sounds are loaded - (setq sound-alist '((ready nil) (warp nil)))) - -;;;###autoload -(defun load-sound-file (filename sound-name &optional volume) - "Read in an audio-file and add it to the sound-alist. - -You can only play sound files if you are running on display 0 of the -console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in. - -The sound file must be in the Sun/NeXT U-LAW format, except on Linux, -where .wav files are also supported by the sound card drivers." - (interactive "fSound file name: \n\ -SSymbol to name this sound: \n\ -nVolume (0 for default): ") - (unless (symbolp sound-name) - (error "sound-name not a symbol")) - (unless (or (null volume) (integerp volume)) - (error "volume not an integer or nil")) - (let (buf - data - (file (locate-file filename default-sound-directory-list sound-extension-list))) - (unless file - (error "Couldn't load sound file %s" filename)) - (unwind-protect - (save-excursion - (set-buffer (setq buf (get-buffer-create " *sound-tmp*"))) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (let ((coding-system-for-read 'binary)) - (insert-file-contents file)) - (setq data (buffer-string)) - (erase-buffer)) - (and buf (kill-buffer buf))) - (let ((old (assq sound-name sound-alist))) - ;; some conses in sound-alist might have been dumped with emacs. - (if old (setq sound-alist (delq old (copy-sequence sound-alist))))) - (setq sound-alist (cons - (purecopy - (nconc (list sound-name) - (if (and volume (not (eq 0 volume))) - (list ':volume volume)) - (list ':sound data))) - sound-alist))) - sound-name) - -;;;###autoload -(defun load-default-sounds () - "Load and install some sound files as beep-types, using -`load-sound-file'. This only works if you're on display 0 of the -console of a machine with native sound support or running a NetAudio -server and XEmacs has the necessary sound support compiled in." - (interactive) - ;; #### - this should do NOTHING if the sounds can't be played. - (message "Loading sounds...") - (setq sound-alist nil) - ;; this is where the calls to load-sound-file get done - (mapc 'eval sound-load-list) - (setq sound-alist - (append sound-default-alist - sound-alist)) - (message "Loading sounds...done") - ;; (beep nil 'quiet) - ) - -;;; sound.el ends here. diff --git a/lisp/specifier.el b/lisp/specifier.el deleted file mode 100644 index 3092b38..0000000 --- a/lisp/specifier.el +++ /dev/null @@ -1,524 +0,0 @@ -;;; specifier.el --- Lisp interface to specifiers - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Ben Wing -;; Keywords: internal, dumped - -;;; Synched up with: Not in 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, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defun make-specifier-and-init (type spec-list &optional dont-canonicalize) - "Create and initialize a new specifier. - -This is a front-end onto `make-specifier' that allows you to create a -specifier and add specs to it at the same time. TYPE specifies the -specifier type. SPEC-LIST supplies the specification(s) to be added -to the specifier. Normally, almost any reasonable abbreviation of the -full spec-list form is accepted, and is converted to the full form; -however, if optional argument DONT-CANONICALIZE is non-nil, this -conversion is not performed, and the SPEC-LIST must already be in full -form. See `canonicalize-spec-list'." - (let ((sp (make-specifier type))) - (if (not dont-canonicalize) - (setq spec-list (canonicalize-spec-list spec-list type))) - (add-spec-list-to-specifier sp spec-list) - sp)) - -;; God damn, do I hate dynamic scoping. - -(defun map-specifier (ms-specifier ms-func &optional ms-locale ms-maparg) - "Apply MS-FUNC to the specification(s) for MS-LOCALE in MS-SPECIFIER. - -If MS-LOCALE is a locale, MS-FUNC will be called for that locale. -If MS-LOCALE is a locale type, MS-FUNC will be mapped over all locales -of that type. If MS-LOCALE is 'all or nil, MS-FUNC will be mapped -over all locales in MS-SPECIFIER. - -MS-FUNC is called with four arguments: the MS-SPECIFIER, the locale -being mapped over, the inst-list for that locale, and the -optional MS-MAPARG. If any invocation of MS-FUNC returns non-nil, -the mapping will stop and the returned value becomes the -value returned from `map-specifier'. Otherwise, `map-specifier' -returns nil." - (let ((ms-specs (specifier-spec-list ms-specifier ms-locale)) - ms-result) - (while (and ms-specs (not ms-result)) - (let ((ms-this-spec (car ms-specs))) - (setq ms-result (funcall ms-func ms-specifier (car ms-this-spec) - (cdr ms-this-spec) ms-maparg)) - (setq ms-specs (cdr ms-specs)))) - ms-result)) - -(defun canonicalize-inst-pair (inst-pair specifier-type &optional noerror) - "Canonicalize the given INST-PAIR. - -SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST -will be used for. - -Canonicalizing means converting to the full form for an inst-pair, i.e. -`(TAG-SET . INSTANTIATOR)'. A single, untagged instantiator is given -a tag set of nil (the empty set), and a single tag is converted into -a tag set consisting only of that tag. - -If NOERROR is non-nil, signal an error if the inst-pair is invalid; -otherwise return t." - ;; OK, the possibilities are: - ;; - ;; a) a single instantiator - ;; b) a cons of a tag and an instantiator - ;; c) a cons of a tag set and an instantiator - (cond ((valid-instantiator-p inst-pair specifier-type) - ;; case (a) - (cons nil inst-pair)) - - ((not (consp inst-pair)) - ;; not an inst-pair - (if noerror t - ;; this will signal an appropriate error. - (check-valid-instantiator inst-pair specifier-type))) - - ((and (valid-specifier-tag-p (car inst-pair)) - (valid-instantiator-p (cdr inst-pair) specifier-type)) - ;; case (b) - (cons (list (car inst-pair)) (cdr inst-pair))) - - ((and (valid-specifier-tag-set-p (car inst-pair)) - (valid-instantiator-p (cdr inst-pair) specifier-type)) - ;; case (c) - inst-pair) - - (t - (if noerror t - (signal 'error (list "Invalid specifier tag set" - (car inst-pair))))))) - -(defun canonicalize-inst-list (inst-list specifier-type &optional noerror) - "Canonicalize the given INST-LIST (a list of inst-pairs). - -SPECIFIER-TYPE specifies the type of specifier that this INST-LIST -will be used for. - -Canonicalizing means converting to the full form for an inst-list, i.e. -`((TAG-SET . INSTANTIATOR) ...)'. This function accepts a single -inst-pair or any abbreviation thereof or a list of (possibly -abbreviated) inst-pairs. (See `canonicalize-inst-pair'.) - -If NOERROR is non-nil, signal an error if the inst-list is invalid; -otherwise return t." - - ;; OK, the possibilities are: - ;; - ;; a) an inst-pair or various abbreviations thereof - ;; b) a list of (a) - (let ((result (canonicalize-inst-pair inst-list specifier-type t))) - (if (not (eq result t)) - ;; case (a) - (list result) - - (if (not (consp inst-list)) - ;; not an inst-list. - (if noerror t - ;; this will signal an appropriate error. - (check-valid-instantiator inst-list specifier-type)) - - ;; case (b) - (catch 'cann-inst-list - ;; don't use mapcar here; we need to catch the case of - ;; an invalid list. - (let ((rest inst-list) - (result nil)) - (while rest - (if (not (consp rest)) - (if noerror (throw 'cann-inst-list t) - (signal 'error (list "Invalid list format" inst-list))) - (let ((res2 (canonicalize-inst-pair (car rest) specifier-type - noerror))) - (if (eq res2 t) - ;; at this point, we know we're noerror because - ;; otherwise canonicalize-inst-pair would have - ;; signalled an error. - (throw 'cann-inst-list t) - (setq result (cons res2 result))))) - (setq rest (cdr rest))) - (nreverse result))))))) - -(defun canonicalize-spec (spec specifier-type &optional noerror) - "Canonicalize the given SPEC (a specification). - -SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST -will be used for. - -Canonicalizing means converting to the full form for a spec, i.e. -`(LOCALE (TAG-SET . INSTANTIATOR) ...)'. This function accepts a -possibly abbreviated inst-list or a cons of a locale and a possibly -abbreviated inst-list. (See `canonicalize-inst-list'.) - -If NOERROR is nil, signal an error if the specification is invalid; -otherwise return t." - ;; OK, the possibilities are: - ;; - ;; a) an inst-list or some abbreviation thereof - ;; b) a cons of a locale and an inst-list - (let ((result (canonicalize-inst-list spec specifier-type t))) - (if (not (eq result t)) - ;; case (a) - (cons 'global result) - - (if (not (consp spec)) - ;; not a spec. - (if noerror t - ;; this will signal an appropriate error. - (check-valid-instantiator spec specifier-type)) - - (if (not (valid-specifier-locale-p (car spec))) - ;; invalid locale. - (if noerror t - (signal 'error (list "Invalid specifier locale" (car spec)))) - - ;; case (b) - (let ((result (canonicalize-inst-list (cdr spec) specifier-type - noerror))) - (if (eq result t) - ;; at this point, we know we're noerror because - ;; otherwise canonicalize-inst-list would have - ;; signalled an error. - t - (cons (car spec) result)))))))) - -(defun canonicalize-spec-list (spec-list specifier-type &optional noerror) - "Canonicalize the given SPEC-LIST (a list of specifications). - -SPECIFIER-TYPE specifies the type of specifier that this SPEC-LIST -will be used for. - -Canonicalizing means converting to the full form for a spec-list, i.e. -`((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)'. This function accepts -a possibly abbreviated specification or a list of such things. (See -`canonicalize-spec'.) This is the function used to convert spec-lists -accepted by `set-specifier' and such into a form suitable for -`add-spec-list-to-specifier'. - -This function tries extremely hard to resolve any ambiguities, -and the built-in specifier types (font, image, toolbar, etc.) are -designed so that there won't be any ambiguities. - -If NOERROR is nil, signal an error if the spec-list is invalid; -otherwise return t." - ;; OK, the possibilities are: - ;; - ;; a) a spec or various abbreviations thereof - ;; b) a list of (a) - (let ((result (canonicalize-spec spec-list specifier-type t))) - (if (not (eq result t)) - ;; case (a) - (list result) - - (if (not (consp spec-list)) - ;; not a spec-list. - (if noerror t - ;; this will signal an appropriate error. - (check-valid-instantiator spec-list specifier-type)) - - ;; case (b) - (catch 'cann-spec-list - ;; don't use mapcar here; we need to catch the case of - ;; an invalid list. - (let ((rest spec-list) - (result nil)) - (while rest - (if (not (consp rest)) - (if noerror (throw 'cann-spec-list t) - (signal 'error (list "Invalid list format" spec-list))) - (let ((res2 (canonicalize-spec (car rest) specifier-type - noerror))) - (if (eq res2 t) - ;; at this point, we know we're noerror because - ;; otherwise canonicalize-spec would have - ;; signalled an error. - (throw 'cann-spec-list t) - (setq result (cons res2 result))))) - (setq rest (cdr rest))) - (nreverse result))))))) - -(defun set-specifier (specifier value &optional locale tag-set how-to-add) - "Add a specification or specifications to SPECIFIER. - -This function adds a specification of VALUE in locale LOCALE. -LOCALE indicates where this specification is active, and should be -a buffer, a window, a frame, a device, or the symbol `global' to -indicate that it applies everywhere. LOCALE usually defaults to -`global' if omitted. - -VALUE is usually what is called an \"instantiator\" (which, roughly -speaking, corresponds to the \"value\" of the property governed by -SPECIFIER). The valid instantiators for SPECIFIER depend on the -type of SPECIFIER (which you can determine using `specifier-type'). -The specifier `scrollbar-width', for example, is of type `integer', -meaning its valid instantiators are integers. The specifier -governing the background color of the `default' face (you can -retrieve this specifier using `(face-background 'default)') is -of type `color', meaning its valid instantiators are strings naming -colors and color-instance objects. For some types of specifiers, -such as `image' and `toolbar', the instantiators can be very -complex. Generally this is documented in the appropriate predicate -function -- `color-specifier-p', `image-specifier-p', -`toolbar-specifier-p', etc. - -NOTE: It does *not* work to give a VALUE of nil as a way of -removing the specifications for a locale. Use `remove-specifier' -instead. (And keep in mind that, if you omit the LOCALE argument -to `remove-specifier', it removes *all* specifications! If you -want to remove just the `global' specification, make sure to -specify a LOCALE of `global'.) - -VALUE can also be a list of instantiators. This means basically, -\"try each one in turn until you get one that works\". This allows -you to give funky instantiators that may only work in some cases, -and provide more normal backups for the other cases. (For example, -you might like the color \"darkseagreen2\", but some X servers -don't recognize this color, so you could provide a backup -\"forest green\". Color TTY devices probably won't recognize this -either, so you could provide a second backup \"green\". You'd -do this by specifying this list of instantiators: - -'(\"darkseagreen2\" \"forest green\" \"green\") - -VALUE can also be various more complicated forms; see below. - -Optional argument TAG-SET is a tag or a list of tags, to be associated -with the VALUE. Tags are symbols (usually naming device types, such -as `x' and `tty', or device classes, such as `color', `mono', and -`grayscale'); specifying a TAG-SET restricts the scope of VALUE to -devices that match all specified tags. (You can also create your -own tags using `define-specifier-tag', and use them to identify -specifications added by you, so you can remove them later.) - -Optional argument HOW-TO-ADD should be either nil or one of the -symbols `prepend', `append', `remove-tag-set-prepend', -`remove-tag-set-append', `remove-locale', `remove-locale-type', -or `remove-all'. This specifies what to do with existing -specifications in LOCALE (and possibly elsewhere in the specifier). -Most of the time, you do not need to worry about this argument; -the default behavior of `remove-tag-set-prepend' is usually fine. -See `copy-specifier' and `add-spec-to-specifier' for a full -description of what each of these means. - -VALUE can actually be anything acceptable to `canonicalize-spec-list'; -this includes, among other things: - --- a cons of a locale and an instantiator (or list of instantiators) --- a cons of a tag or tag-set and an instantiator (or list of - instantiators) --- a cons of a locale and the previous type of item --- a list of one or more of any of the previous types of items - -However, in these cases, you cannot give a LOCALE or TAG-SET, -because they do not make sense. (You will probably get an error if -you try this.) - -Finally, VALUE can itself be a specifier (of the same type as -SPECIFIER), if you want to copy specifications from one specifier -to another; this is equivalent to calling `copy-specifier', and -LOCALE, TAG-SET, and HOW-TO-ADD have the same semantics as with -that function. - -Note that `set-specifier' is exactly complementary to `specifier-specs' -except in the case where SPECIFIER has no specs at all in it but nil -is a valid instantiator (in that case, `specifier-specs' will return -nil (meaning no specs) and `set-specifier' will interpret the `nil' -as meaning \"I'm adding a global instantiator and its value is `nil'\"), -or in strange cases where there is an ambiguity between a spec-list -and an inst-list, etc. (The built-in specifier types are designed -in such a way as to avoid any such ambiguities.) - -NOTE: If you want to work with spec-lists, you should probably not -use either `set-specifier' or `specifier-specs', but should use the -lower-level functions `add-spec-list-to-specifier' and `specifier-spec-list'. -These functions always work with fully-qualified spec-lists; thus, there -is no possibility for ambiguity and no need to go through the function -`canonicalize-spec-list', which is potentially time-consuming." - - ;; backward compatibility: the old function had HOW-TO-ADD as the - ;; third argument and no arguments after that. - ;; #### this should disappear at some point. - (if (and (null how-to-add) - (memq locale '(prepend append remove-tag-set-prepend - remove-tag-set-append remove-locale - remove-locale-type remove-all))) - (progn - (setq how-to-add locale) - (setq locale nil))) - - ;; proper beginning of the function. - (let ((is-valid (valid-instantiator-p value (specifier-type specifier))) - (nval value)) - (cond ((and (not is-valid) (specifierp nval)) - (copy-specifier nval specifier locale tag-set nil how-to-add)) - (t - (if tag-set - (progn - (if (not (listp tag-set)) - (setq tag-set (list tag-set))) - ;; You tend to get more accurate errors - ;; for a variety of cases if you call - ;; canonicalize-tag-set here. - (setq tag-set (canonicalize-tag-set tag-set)) - (if (and (not is-valid) (consp nval)) - (setq nval - (mapcar #'(lambda (x) - (check-valid-instantiator - x (specifier-type specifier)) - (cons tag-set x)) - nval)) - (setq nval (cons tag-set nval))))) - (if locale - (setq nval (cons locale nval))) - (add-spec-list-to-specifier - specifier - (canonicalize-spec-list nval (specifier-type specifier)) - how-to-add)))) - value) - -(defmacro let-specifier (specifier-list &rest body) - "Add specifier specs, evaluate forms in BODY and restore the specifiers. -\(let-specifier SPECIFIER-LIST BODY...) - -Each element of SPECIFIER-LIST should look like this: -\(SPECIFIER VALUE &optional LOCALE TAG-SET HOW-TO-ADD). - -SPECIFIER is the specifier to be temporarily modified. VALUE is the -instantiator to be temporarily added to SPECIFIER in LOCALE. LOCALE, -TAG-SET and HOW-TO-ADD have the same meaning as in -`add-spec-to-specifier'. - -The code resulting from macro expansion will add specifications to -specifiers using `add-spec-to-specifier'. After BODY is finished, the -temporary specifications are removed and old spec-lists are restored. - -LOCALE, TAG-SET and HOW-TO-ADD may be omitted, and default to nil. -The value of the last form in BODY is returned. - -NOTE: If you want the specifier's instance to change in all -circumstances, use (selected-window) as the LOCALE. If LOCALE is nil -or omitted, it defaults to `global'. - -Example: - (let-specifier ((modeline-shadow-thickness 0 (selected-window))) - (sit-for 1))" - (check-argument-type 'listp specifier-list) - (flet ((gensym-frob (x name) - (if (or (atom x) (eq (car x) 'quote)) - (list x) - (list (gensym name) x)))) - ;; VARLIST is a list of - ;; ((SPECIFIERSYM SPECIFIER) (VALUE) (LOCALESYM LOCALE) - ;; (TAG-SET) (HOW-TO-ADD)) - ;; If any of these is an atom, then a separate symbol is - ;; unnecessary, the CAR will contain the atom and CDR will be nil. - (let* ((varlist (mapcar #'(lambda (listel) - (or (and (consp listel) - (<= (length listel) 5) - (> (length listel) 1)) - (signal 'error - (list - "should be a list of 2-5 elements" - listel))) - ;; VALUE, TAG-SET and HOW-TO-ADD are - ;; referenced only once, so we needn't - ;; frob them with gensym. - (list (gensym-frob (nth 0 listel) "specifier-") - (list (nth 1 listel)) - (gensym-frob (nth 2 listel) "locale-") - (list (nth 3 listel)) - (list (nth 4 listel)))) - specifier-list)) - ;; OLDVALLIST is a list of (OLDVALSYM OLDVALFORM) - (oldvallist (mapcar #'(lambda (varel) - (list (gensym "old-") - `(specifier-spec-list - ,(car (nth 0 varel)) - ,(car (nth 2 varel))))) - varlist))) - ;; Bind the appropriate variables. - `(let* (,@(mapcan #'(lambda (varel) - (delq nil (mapcar - #'(lambda (varcons) - (and (cdr varcons) varcons)) - varel))) - varlist) - ,@oldvallist) - (unwind-protect - (progn - ,@(mapcar #'(lambda (varel) - `(add-spec-to-specifier - ,(car (nth 0 varel)) ,(car (nth 1 varel)) - ,(car (nth 2 varel)) ,(car (nth 3 varel)) - ,(car (nth 4 varel)))) - varlist) - ,@body) - ;; Reverse the unwinding order, so that using the same - ;; specifier multiple times works. - ,@(apply #'nconc (nreverse (mapcar* - #'(lambda (oldval varel) - `((remove-specifier - ,(car (nth 0 varel)) - ,(car (nth 2 varel))) - (add-spec-list-to-specifier - ,(car (nth 0 varel)) - ,(car oldval)))) - oldvallist varlist)))))))) - -;; Evaluate this for testing: -; (cl-prettyexpand '(let-specifier ((modeline-shadow-thickness 0 (selected-window) 'x) (fubar (value) baz)) (sit-for 1))) - -(define-specifier-tag 'win 'device-on-window-system-p) - -;; Add tags for device types that don't have support compiled -;; into the binary that we're about to dump. This will prevent -;; code like -;; -;; (set-face-foreground 'default "black" nil '(x color)) -;; -;; from producing an error if no X support was compiled in. - -(or (valid-specifier-tag-p 'x) - (define-specifier-tag 'x (lambda (dev) (eq (device-type dev) 'x)))) -(or (valid-specifier-tag-p 'tty) - (define-specifier-tag 'tty (lambda (dev) (eq (device-type dev) 'tty)))) -(or (valid-specifier-tag-p 'mswindows) - (define-specifier-tag 'mswindows (lambda (dev) - (eq (device-type dev) 'mswindows)))) - -;; Add special tag for use by initialization code. Code that -;; sets up default specs should use this tag. Code that needs to -;; override default specs (e.g. the X resource initialization -;; code) can safely clear specs with this tag without worrying -;; about clobbering user settings. - -(define-specifier-tag 'default) - -;;; specifier.el ends here diff --git a/lisp/startup.el b/lisp/startup.el deleted file mode 100644 index f36d12c..0000000 --- a/lisp/startup.el +++ /dev/null @@ -1,1182 +0,0 @@ -;;; startup.el --- process XEmacs shell arguments - -;; Copyright (C) 1985-1986, 1990, 1992-1997 Free Software Foundation, Inc. -;; Copyright (c) 1993, 1994 Sun Microsystems, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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 19.34. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; -batch, -t, and -nw are processed by main() in emacs.c and are -;; never seen by lisp code. - -;; -version and -help are special-cased as well: they imply -batch, -;; but are left on the list for lisp code to process. - -;;; Code: - -(setq top-level '(normal-top-level)) - -(defvar command-line-processed nil "t once command line has been processed") - -(defconst startup-message-timeout 12000) ; More or less disable the timeout - -(defconst inhibit-startup-message nil - "*Non-nil inhibits the initial startup message. -This is for use in your personal init file, once you are familiar -with the contents of the startup message.") - -;; #### FSFmacs randomness -;;(defconst inhibit-startup-echo-area-message nil -;; "*Non-nil inhibits the initial startup echo area message. -;;Inhibition takes effect only if your `.emacs' file contains -;;a line of this form: -;; (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\") -;;If your `.emacs' file is byte-compiled, use the following form instead: -;; (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")) -;;Thus, someone else using a copy of your `.emacs' file will see -;;the startup message unless he personally acts to inhibit it.") - -(defconst inhibit-default-init nil - "*Non-nil inhibits loading the `default' library.") - -(defvar command-line-args-left nil - "List of command-line args not yet processed.") ; bound by `command-line' - -(defvar command-line-default-directory nil - "Default directory to use for command line arguments. -This is normally copied from `default-directory' when XEmacs starts.") - -(defvar before-init-hook nil - "Functions to call after handling urgent options but before init files. -The frame system uses this to open frames to display messages while -XEmacs loads the user's initialization file.") - -(defvar after-init-hook nil - "*Functions to call after loading the init file (`.emacs'). -The call is not protected by a condition-case, so you can set `debug-on-error' -in `.emacs', and put all the actual code on `after-init-hook'.") - -(defvar term-setup-hook nil - "*Functions to be called after loading terminal-specific Lisp code. -See `run-hooks'. This variable exists for users to set, so as to -override the definitions made by the terminal-specific file. XEmacs -never sets this variable itself.") - -(defvar keyboard-type nil - "The brand of keyboard you are using. -This variable is used to define the proper function and keypad keys -for use under X. It is used in a fashion analogous to the environment -value TERM.") - -(defvar window-setup-hook nil - "Normal hook run to initialize window system display. -XEmacs runs this hook after processing the command line arguments and loading -the user's init file.") - -(defconst initial-major-mode 'lisp-interaction-mode - "Major mode command symbol to use for the initial *scratch* buffer.") - -(defvar emacs-roots nil - "List of plausible roots of the XEmacs hierarchy.") - -(defvar init-file-user nil - "Identity of user whose `.emacs' file is or was read. -The value is nil if no init file is being used; otherwise, it may be either -the null string, meaning that the init file was taken from the user that -originally logged in, or it may be a string containing a user's name. - -In either of the latter cases, `(concat \"~\" init-file-user \"/\")' -evaluates to the name of the directory in which the `.emacs' file was -searched for. - -Setting `init-file-user' does not prevent Emacs from loading -`site-start.el'. The only way to do that is to use `--no-site-file'.") - -;; #### called `site-run-file' in FSFmacs - -(defvar site-start-file (purecopy "site-start") - "File containing site-wide run-time initializations. -This file is loaded at run-time before `.emacs'. It -contains inits that need to be in place for the entire site, but -which, due to their higher incidence of change, don't make sense to -load into XEmacs' dumped image. Thus, the run-time load order is: - - 1. file described in this variable, if non-nil; - 2. `.emacs'; - 3. `/path/to/xemacs/lisp/default.el'. - -Don't use the `site-start.el' file for things some users may not like. -Put them in `default.el' instead, so that users can more easily -override them. Users can prevent loading `default.el' with the `-q' -option or by setting `inhibit-default-init' in their own init files, -but inhibiting `site-start.el' requires `--no-site-file', which -is less convenient.") - -;;(defconst iso-8859-1-locale-regexp "8859[-_]?1" -;; "Regexp that specifies when to enable the ISO 8859-1 character set. -;;We do that if this regexp matches the locale name -;;specified by the LC_ALL, LC_CTYPE and LANG environment variables.") - -(defvar mail-host-address nil - "*Name of this machine, for purposes of naming users.") - -(defvar user-mail-address nil - "*Full mailing address of this user. -This is initialized based on `mail-host-address', -after your init file is read, in case it sets `mail-host-address'.") - -(defvar auto-save-list-file-prefix "~/.saves-" - "Prefix for generating auto-save-list-file-name. -Emacs's pid and the system name will be appended to -this prefix to create a unique file name.") - -(defvar init-file-debug nil) - -(defvar init-file-had-error nil) - -(defvar init-file-loaded nil - "True after the user's init file has been loaded (or suppressed with -q). -This will be true when `after-init-hook' is run and at all times -after, and will not be true at any time before.") - -(defvar initial-frame-unmapped-p nil) - - - -(defvar command-switch-alist - (purecopy - '(("-help" . command-line-do-help) - ("-version". command-line-do-version) - ("-V" . command-line-do-version) - ("-funcall". command-line-do-funcall) - ("-f" . command-line-do-funcall) - ("-e" . command-line-do-funcall-1) - ("-eval" . command-line-do-eval) - ("-load" . command-line-do-load) - ("-l" . command-line-do-load) - ("-insert" . command-line-do-insert) - ("-i" . command-line-do-insert) - ("-kill" . command-line-do-kill) - ;; Options like +35 are handled specially. - ;; Window-system, site, or package-specific code might add to this. - ;; X11 handles its options by letting Xt remove args from this list. - )) - "Alist of command-line switches. -Elements look like (SWITCH-STRING . HANDLER-FUNCTION). -HANDLER-FUNCTION receives switch name as sole arg; -remaining command-line args are in the variable `command-line-args-left'.") - -;;; default switches -;;; Note: these doc strings are semi-magical. - -(defun command-line-do-help (arg) - "Print the XEmacs usage message and exit." - (let ((standard-output 'external-debugging-output)) - (princ (concat "\n" (emacs-version) "\n\n")) - (princ - (if (featurep 'x) - (concat (emacs-name) - " accepts all standard X Toolkit command line options.\n" - "In addition, the") - "The")) - (princ " following options are accepted: - - -t Use TTY instead of the terminal for input - and output. This implies the -nw option. - -nw Inhibit the use of any window-system-specific - display code: use the current tty. - -batch Execute noninteractively (messages go to stderr). - -debug-init Enter the debugger if an error in the init file occurs. - -unmapped Do not map the initial frame. - -no-site-file Do not load the site-specific init file (site-start.el). - -no-init-file Do not load the user-specific init file (~/.emacs). - -no-early-packages Do not process early packages. - -no-autoloads Do not load global symbol files (auto-autoloads) at - startup. Also implies `-vanilla'. - -vanilla Equivalent to -q -no-site-file -no-early-packages. - -q Same as -no-init-file. - -user Load user's init file instead of your own. - -u Same as -user.\n") - (let ((l command-switch-alist) - (insert (lambda (&rest x) - (princ " ") - (let ((len 2)) - (while x - (princ (car x)) - (incf len (length (car x))) - (setq x (cdr x))) - (when (>= len 24) - (terpri) (setq len 0)) - (while (< len 24) - (princ " ") - (incf len)))))) - (while l - (let ((name (car (car l))) - (fn (cdr (car l))) - doc arg cons) - (cond - ((and (symbolp fn) (get fn 'undocumented)) nil) - (t - (setq doc (documentation fn)) - (if (member doc '(nil "")) (setq doc "(undocumented)")) - (cond ((string-match "\n\\(<.*>\\)\n?\\'" doc) - ;; Doc of the form "The frobber switch\n " - (setq arg (substring doc (match-beginning 1) (match-end 1)) - doc (substring doc 0 (match-beginning 0)))) - ((string-match "\n+\\'" doc) - (setq doc (substring doc 0 (match-beginning 0))))) - (if (and (setq cons (rassq fn command-switch-alist)) - (not (eq cons (car l)))) - (setq doc (format "Same as %s." (car cons)))) - (if arg - (funcall insert name " " arg) - (funcall insert name)) - (princ doc) - (terpri)))) - (setq l (cdr l)))) - (princ (concat "\ - +N Start displaying at line N. - -Anything else is considered a file name, and is placed into a buffer for -editing. - -" (emacs-name) " has an online tutorial and manuals. Type ^Ht (Control-h t) after -starting XEmacs to run the tutorial. Type ^Hi to enter the manual browser. -Type ^H^H^H (Control-h Control-h Control-h) to get more help options.\n") - - (kill-emacs 0)))) - -(defun command-line-do-funcall (arg) - "Invoke the named lisp function with no arguments. -" - (funcall (intern (pop command-line-args-left)))) -(fset 'command-line-do-funcall-1 'command-line-do-funcall) -(put 'command-line-do-funcall-1 'undocumented t) - -(defun command-line-do-eval (arg) - "Evaluate the lisp form. Quote it carefully. -
" - (eval (read (pop command-line-args-left)))) - -(defun command-line-do-load (arg) - "Load the named file of Lisp code into XEmacs. -" - (let ((file (pop command-line-args-left))) - ;; Take file from default dir if it exists there; - ;; otherwise let `load' search for it. - (if (file-exists-p (expand-file-name file)) - (setq file (expand-file-name file))) - (load file nil t))) - -(defun command-line-do-insert (arg) - "Insert file into the current buffer. -" - (insert-file-contents (pop command-line-args-left))) - -(defun command-line-do-kill (arg) - "Exit XEmacs." - (kill-emacs t)) - -(defun command-line-do-version (arg) - "Print version info and exit." - (princ (concat (emacs-version) "\n")) - (kill-emacs 0)) - - -;;; Processing the command line and loading various init files - -(defun early-error-handler (&rest debugger-args) - "You should probably not be using this." - ;; Used as the debugger during XEmacs initialization; if an error occurs, - ;; print some diagnostics, and kill XEmacs. - - ;; output the contents of the warning buffer, since it won't be seen - ;; otherwise. - ;; #### kludge! The call to Feval forces the pending warnings to - ;; get output. There definitely needs to be a better way. - (let ((buffer (eval (get-buffer-create "*Warnings*")))) - (princ (buffer-substring (point-min buffer) (point-max buffer) buffer) - 'external-debugging-output)) - - (let ((string "Initialization error") - (error (nth 1 debugger-args)) - (debug-on-error nil) - (stream 'external-debugging-output)) - (if (null error) - (princ string stream) - (princ (concat "\n" string ": ") stream) - (condition-case () - (display-error error stream) - (error (princ "<<< error printing error message >>>" stream))) - (princ "\n" stream) - (if (memq (car-safe error) '(void-function void-variable)) - (princ " - This probably means that XEmacs is picking up an old version of - the lisp library, or that some .elc files are not up-to-date.\n" - stream))) - (when (not suppress-early-error-handler-backtrace) - (let ((print-length 1000) - (print-level 1000) - (print-escape-newlines t) - (print-readably nil)) - (when (getenv "EMACSLOADPATH") - (princ (format "\n$EMACSLOADPATH is %s" (getenv "EMACSLOADPATH")) - stream)) - (princ (format "\nexec-directory is %S" exec-directory) stream) - (princ (format "\ndata-directory is %S" data-directory) stream) - (princ (format "\ndata-directory-list is %S" data-directory-list) stream) - (princ (format "\ndoc-directory is %S" doc-directory) stream) - (princ (format "\nload-path is %S" load-path) stream) - (princ "\n\n" stream))) - (when (not suppress-early-error-handler-backtrace) - (backtrace stream t))) - (kill-emacs -1)) - -(defvar lock-directory) -(defvar superlock-file) - -(defun normal-top-level () - (if command-line-processed - (message "Back to top level.") - (setq command-line-processed t) - ;; Canonicalize HOME (PWD is canonicalized by init_buffer in buffer.c) - (let ((value (user-home-directory))) - (if (and value - (< (length value) (length default-directory)) - (equal (file-attributes default-directory) - (file-attributes value))) - (setq default-directory (file-name-as-directory value)))) - (setq default-directory (abbreviate-file-name default-directory)) - (initialize-xemacs-paths) - - (startup-set-invocation-environment) - - (let ((debug-paths (or debug-paths - (and (getenv "EMACSDEBUGPATHS") - t)))) - - (setq emacs-roots (paths-find-emacs-roots invocation-directory - invocation-name)) - - (if debug-paths - (princ (format "emacs-roots:\n%S\n" emacs-roots) - 'external-debugging-output)) - - (if (null emacs-roots) - (startup-find-roots-warning) - (startup-setup-paths emacs-roots - inhibit-early-packages - inhibit-site-lisp - debug-paths)) - (startup-setup-paths-warning)) - - (if (and (not inhibit-autoloads) - lisp-directory) - (load (expand-file-name (file-name-sans-extension autoload-file-name) - lisp-directory) nil t)) - - (if (not inhibit-autoloads) - (progn - (if (not inhibit-early-packages) - (packages-load-package-auto-autoloads early-package-load-path)) - (packages-load-package-auto-autoloads late-package-load-path) - (packages-load-package-auto-autoloads last-package-load-path))) - - (unwind-protect - (command-line) - ;; Do this again, in case .emacs defined more abbreviations. - (setq default-directory (abbreviate-file-name default-directory)) - ;; Specify the file for recording all the auto save files of - ;; this session. This is used by recover-session. - (setq auto-save-list-file-name - (expand-file-name - (format "%s%d-%s" - auto-save-list-file-prefix - (emacs-pid) - (system-name)))) - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook)) - (setq term-setup-hook nil) - ;; ;; Modify the initial frame based on what .emacs puts into - ;; ;; ...-frame-alist. - (frame-notice-user-settings) - ;; ;;####FSFmacs junk - ;; ;; Now we know the user's default font, so add it to the menu. - ;; (if (fboundp 'font-menu-add-default) - ;; (font-menu-add-default)) - (when window-setup-hook - (run-hooks 'window-setup-hook)) - (setq window-setup-hook nil)) - ;;####FSFmacs junk - ;; (or menubar-bindings-done - ;; (precompute-menubar-bindings)) - )) - -;;####FSFmacs junk -;;; Precompute the keyboard equivalents in the menu bar items. -;;(defun precompute-menubar-bindings () -;; (if (eq window-system 'x) -;; (let ((submap (lookup-key global-map [menu-bar]))) -;; (while submap -;; (and (consp (car submap)) -;; (symbolp (car (car submap))) -;; (stringp (car-safe (cdr (car submap)))) -;; (keymapp (cdr (cdr (car submap)))) -;; (x-popup-menu nil (cdr (cdr (car submap))))) -;; (setq submap (cdr submap)))))) - -(defun command-line-early (args) - ;; This processes those switches which need to be processed before - ;; starting up the window system. - - (setq command-line-default-directory default-directory) - - ;; See if we should import version-control from the environment variable. - (let ((vc (getenv "VERSION_CONTROL"))) - (cond ((eq vc nil)) ;don't do anything if not set - ((or (string= vc "t") - (string= vc "numbered")) - (setq version-control t)) - ((or (string= vc "nil") - (string= vc "existing")) - (setq version-control nil)) - ((or (string= vc "never") - (string= vc "simple")) - (setq version-control 'never)))) - - ;;####FSFmacs - ;; (if (let ((ctype - ;; ;; Use the first of these three envvars that has a nonempty value. - ;; (or (let ((string (getenv "LC_ALL"))) - ;; (and (not (equal string "")) string)) - ;; (let ((string (getenv "LC_CTYPE"))) - ;; (and (not (equal string "")) string)) - ;; (let ((string (getenv "LANG"))) - ;; (and (not (equal string "")) string))))) - ;; (and ctype - ;; (string-match iso-8859-1-locale-regexp ctype))) - ;; (progn - ;; (standard-display-european t) - ;; (require 'iso-syntax))) - - ;; Figure out which user's init file to load, - ;; either from the environment or from the options. - (setq init-file-user (if (noninteractive) nil (user-login-name))) - ;; If user has not done su, use current $HOME to find .emacs. - (and init-file-user (string= init-file-user (user-real-login-name)) - (setq init-file-user "")) - - ;; Allow (at least) these arguments anywhere in the command line - (let ((new-args nil) - (arg nil)) - (while args - (setq arg (pop args)) - (cond - ((or (string= arg "-q") - (string= arg "-no-init-file")) - (setq init-file-user nil)) - ((string= arg "-no-site-file") - (setq site-start-file nil)) - ((or (string= arg "-no-early-packages") - (string= arg "--no-early-packages")) - (setq inhibit-early-packages t)) - ((or (string= arg "-vanilla") - (string= arg "--vanilla") - ;; Some work on this one already done in emacs.c. - (string= arg "-no-autoloads") - (string= arg "--no-autoloads")) - (setq init-file-user nil - site-start-file nil)) - ((or (string= arg "-u") - (string= arg "-user")) - (setq init-file-user (pop args))) - ((string= arg "-debug-init") - (setq init-file-debug t)) - ((string= arg "-unmapped") - (setq initial-frame-unmapped-p t)) - ((or (string= arg "-debug-paths") - (string= arg "--debug-paths")) - t) - ((or (string= arg "--") (string= arg "-")) - (while args - (push (pop args) new-args))) - (t (push arg new-args)))) - - (nreverse new-args))) - -(defconst initial-scratch-message "\ -;; This buffer is for notes you don't want to save, and for Lisp evaluation. -;; If you want to create a file, first visit that file with C-x C-f, -;; then enter the text in that file's own buffer. - -" - "Initial message displayed in *scratch* buffer at startup. -If this is nil, no message will be displayed.") - -(defun command-line () - (let ((command-line-args-left (cdr command-line-args))) - - (let ((debugger 'early-error-handler) - (debug-on-error t)) - - ;; Process magic command-line switches like -q and -u. Do this - ;; before creating the first frame because some of these switches - ;; may affect that. I think it's ok to do this before establishing - ;; the X connection, and maybe someday things like -nw can be - ;; handled here instead of down in C. - (setq command-line-args-left (command-line-early command-line-args-left)) - - ;; Setup the toolbar icon directory - (when (featurep 'toolbar) - (init-toolbar-location)) - - ;; Run the window system's init function. tty is considered to be - ;; a type of window system for this purpose. This creates the - ;; initial (non stdio) device. - (when (and initial-window-system (not noninteractive)) - (funcall (intern (concat "init-" - (symbol-name initial-window-system) - "-win")))) - - ;; When not in batch mode, this creates the first visible frame, - ;; and deletes the stdio device. - (frame-initialize)) - - ;; - ;; We have normality, I repeat, we have normality. Anything you still - ;; can't cope with is therefore your own problem. (And we don't need - ;; to kill XEmacs for it.) - ;; - - ;;; Load init files. - (load-init-file) - - (with-current-buffer (get-buffer "*scratch*") - (erase-buffer) - ;; (insert initial-scratch-message) - (set-buffer-modified-p nil) - (when (eq major-mode 'fundamental-mode) - (funcall initial-major-mode))) - - ;; Load library for our terminal type. - ;; User init file can set term-file-prefix to nil to prevent this. - ;; Note that for any TTY's opened subsequently, the TTY init - ;; code will run this. - (when (and (eq 'tty (console-type)) - (not (noninteractive))) - (load-terminal-library)) - - ;; Process the remaining args. - (command-line-1) - - ;; it was turned on by default so that the warnings don't get displayed - ;; until after the splash screen. - (setq inhibit-warning-display nil) - ;; If -batch, terminate after processing the command options. - (when (noninteractive) (kill-emacs t)))) - -(defun load-terminal-library () - (when term-file-prefix - (let ((term (getenv "TERM")) - hyphend) - (while (and term - (not (load (concat term-file-prefix term) t t))) - ;; 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)))))) - -(defconst user-init-directory "/.xemacs/" - "Directory where user-installed packages may go.") -(define-obsolete-variable-alias - 'emacs-user-extension-dir - 'user-init-directory) - -(defun load-user-init-file (init-file-user) - "This function actually reads the init file, .emacs." - (when init-file-user -;; purge references to init.el and options.el -;; convert these to use paths-construct-path for eventual migration to init.el -;; needs to be converted when idiom for constructing "~user" paths is created -; (setq user-init-file -; (paths-construct-path (list (concat "~" init-file-user) -; user-init-directory -; "init.el"))) -; (unless (file-exists-p (expand-file-name user-init-file)) - (setq user-init-file - (paths-construct-path (list (concat "~" init-file-user) - (cond - ((eq system-type 'ms-dos) "_emacs") - (t ".emacs"))))) -; ) - (load user-init-file t t t) -;; This should not be loaded since custom stuff currently goes into .emacs -; (let ((default-custom-file -; (paths-construct-path (list (concat "~" init-file-user) -; user-init-directory -; "options.el"))) -; (when (string= custom-file default-custom-file) -; (load default-custom-file t t))) - (unless inhibit-default-init - (let ((inhibit-startup-message nil)) - ;; Users are supposed to be told their rights. - ;; (Plus how to get help and how to undo.) - ;; Don't you dare turn this off for anyone except yourself. - (load "default" t t))))) - -;;; Load user's init file and default ones. -(defun load-init-file () - (run-hooks 'before-init-hook) - - ;; Run the site-start library if it exists. The point of this file is - ;; that it is run before .emacs. There is no point in doing this after - ;; .emacs; that is useless. - (when site-start-file - (load site-start-file t t)) - - ;; Sites should not disable this. Only individuals should disable - ;; the startup message. - (setq inhibit-startup-message nil) - - (let (debug-on-error-from-init-file - debug-on-error-should-be-set - (debug-on-error-initial - (if (eq init-file-debug t) 'startup init-file-debug))) - (let ((debug-on-error debug-on-error-initial)) - (if init-file-debug - ;; Do this without a condition-case if the user wants to debug. - (load-user-init-file init-file-user) - (condition-case error - (progn - (load-user-init-file init-file-user) - (setq init-file-had-error nil)) - (error - (message "Error in init file: %s" (error-message-string error)) - (display-warning 'initialization - (format "\ -An error has occurred while loading %s: - -%s - -To ensure normal operation, you should investigate the cause of the error -in your initialization file and remove it. Use the `-debug-init' option -to XEmacs to view a complete error backtrace." - user-init-file (error-message-string error)) - 'error) - (setq init-file-had-error t)))) - ;; If we can tell that the init file altered debug-on-error, - ;; arrange to preserve the value that it set up. - (or (eq debug-on-error debug-on-error-initial) - (setq debug-on-error-should-be-set t - debug-on-error-from-init-file debug-on-error))) - (when debug-on-error-should-be-set - (setq debug-on-error debug-on-error-from-init-file))) - - (setq init-file-loaded t) - - ;; Do this here in case the init file sets mail-host-address. - ;; Don't do this here unless noninteractive, it is frequently wrong. -sb - ;; (or user-mail-address - (when noninteractive - (setq user-mail-address (concat (user-login-name) "@" - (or mail-host-address - (system-name))))) - - (run-hooks 'after-init-hook) - nil) - -(defun load-options-file (filename) - "Load the file of saved options (from the Options menu) called FILENAME. -Currently this does nothing but call `load', but it might be redefined -in the future to support automatically converting older options files to -a new format, when variables have changed, etc." - (load filename)) - -(defun command-line-1 () - (cond - ((null command-line-args-left) - (unless noninteractive - ;; If there are no switches to process, run the term-setup-hook - ;; before displaying the copyright notice; there may be some need - ;; to do it before doing any output. If we're not going to - ;; display a copyright notice (because other options are present) - ;; then this is run after those options are processed. - (run-hooks 'term-setup-hook) - ;; Don't let the hook be run twice. - (setq term-setup-hook nil) - - ;; Don't clobber a non-scratch buffer if init file - ;; has selected it. - (when (string= (buffer-name) "*scratch*") - (unless (or inhibit-startup-message - (input-pending-p)) - (let ((timeout nil)) - (unwind-protect - ;; Guts of with-timeout - (catch 'timeout - (setq timeout (add-timeout startup-message-timeout - (lambda (ignore) - (condition-case nil - (throw 'timeout t) - (error nil))) - nil)) - (startup-splash-frame) - (or nil;; (pos-visible-in-window-p (point-min)) - (goto-char (point-min))) - (sit-for 0) - (setq unread-command-event (next-command-event))) - (when timeout (disable-timeout timeout))))) - (with-current-buffer (get-buffer "*scratch*") - ;; In case the XEmacs server has already selected - ;; another buffer, erase the one our message is in. - (erase-buffer) - (when (stringp initial-scratch-message) - (insert initial-scratch-message)) - (set-buffer-modified-p nil))))) - - (t - ;; Command-line-options exist - (let ((dir command-line-default-directory) - (file-count 0) - (line nil) - (end-of-options nil) - first-file-buffer file-p arg tem) - (while command-line-args-left - (setq arg (pop command-line-args-left)) - (cond - (end-of-options - (setq file-p t)) - ((setq tem (when (eq (aref arg 0) ?-) - (or (assoc arg command-switch-alist) - (assoc (substring arg 1) - command-switch-alist)))) - (funcall (cdr tem) arg)) - ((string-match "\\`\\+[0-9]+\\'" arg) - (setq line (string-to-int arg))) - ;; "- file" means don't treat "file" as a switch - ;; ("+0 file" has the same effect; "-" added - ;; for unixoidiality). - ;; This is worthless; the `unixoid' way is "./file". -jwz - ((or (string= arg "-") (string= arg "--")) - (setq end-of-options t)) - (t - (setq file-p t))) - - (when file-p - (setq file-p nil) - (incf file-count) - (setq arg (expand-file-name arg dir)) - (cond - ((= file-count 1) (setq first-file-buffer - (progn (find-file arg) (current-buffer)))) - (noninteractive (find-file arg)) - (t (find-file-other-window arg))) - (when line - (goto-line line) - (setq line nil)))))))) - -(defvar startup-presentation-hack-keymap - (let ((map (make-sparse-keymap))) - (set-keymap-name map 'startup-presentation-hack-keymap) - (define-key map '[button1] 'startup-presentation-hack) - (define-key map '[button2] 'startup-presentation-hack) - map) - "Putting yesterday in the future tomorrow.") - -(defun startup-presentation-hack () - (interactive) - (let ((e last-command-event)) - (and (button-press-event-p e) - (setq e (extent-at (event-point e) - (event-buffer e) - 'startup-presentation-hack)) - (setq e (extent-property e 'startup-presentation-hack)) - (if (consp e) - (apply (car e) (cdr e)) - (while (keymapp (indirect-function e)) - (let ((map e) - (overriding-local-map (indirect-function e))) - (setq e (read-key-sequence - (let ((p (keymap-prompt map t))) - (cond ((symbolp map) - (if p - (format "%s %s " map p) - (format "%s " map))) - (p) - (t - (prin1-to-string map)))))) - (if (and (button-release-event-p (elt e 0)) - (null (key-binding e))) - (setq e map) ; try again - (setq e (key-binding e))))) - (call-interactively e))))) - -(defun startup-presentation-hack-help (e) - (setq e (extent-property e 'startup-presentation-hack)) - (if (consp e) - (format "Evaluate %S" e) - (symbol-name e))) - -(defun splash-frame-present-hack (e v) - ;; (set-extent-property e 'mouse-face 'highlight) - ;; (set-extent-property e 'keymap - ;; startup-presentation-hack-keymap) - ;; (set-extent-property e 'startup-presentation-hack v) - ;; (set-extent-property e 'help-echo - ;; 'startup-presentation-hack-help)) - ) - -(defun splash-hack-version-string () - (save-excursion - (save-restriction - (goto-char (point-min)) - (re-search-forward "^XEmacs" nil t) - (narrow-to-region (point-at-bol) (point-at-eol)) - (goto-char (point-min)) - (when (re-search-forward " \\[Lucid\\]" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (when (re-search-forward "[^(][^)]*-[^)]*-" nil t) - (delete-region (1+ (match-beginning 0)) (match-end 0)) - (insert "(")) - (goto-char (point-max)) - (search-backward " " nil t) - (when (search-forward "." nil t) - (delete-region (1- (point)) (point-max)))))) - -(defun splash-frame-present (l) - (cond ((stringp l) - (insert l)) - ((eq (car-safe l) 'face) - ;; (face name string) - (let ((p (point))) - (splash-frame-present (elt l 2)) - (if (fboundp 'set-extent-face) - (set-extent-face (make-extent p (point)) - (elt l 1))))) - ((eq (car-safe l) 'key) - (let* ((c (elt l 1)) - (p (point)) - (k (where-is-internal c nil t))) - (insert (if k (key-description k) - (format "M-x %s" c))) - (if (fboundp 'set-extent-face) - (let ((e (make-extent p (point)))) - (set-extent-face e 'bold) - (splash-frame-present-hack e c))))) - ((eq (car-safe l) 'funcall) - ;; (funcall (fun . args) string) - (let ((p (point))) - (splash-frame-present (elt l 2)) - (if (fboundp 'set-extent-face) - (splash-frame-present-hack (make-extent p (point)) - (elt l 1))))) - ((consp l) - (mapcar 'splash-frame-present l)) - (t - (error "WTF!?")))) - -(defun startup-center-spaces (glyph) - ;; Return the number of spaces to insert in order to center - ;; the given glyph (may be a string or a pixmap). - ;; Assume spaces are as wide as avg-pixwidth. - ;; Won't be quite right for proportional fonts, but it's the best we can do. - ;; Maybe the new redisplay will export something a glyph-width function. - ;;; #### Yes, there is a glyph-width function but it isn't quite what - ;;; #### this was expecting. Or is it? - ;; (An alternate way to get avg-pixwidth would be to use x-font-properties - ;; and calculate RESOLUTION_X * AVERAGE_WIDTH / 722.7, but it's no better.) - - ;; This function is used in about.el too. - (let* ((avg-pixwidth (round (/ (frame-pixel-width) (frame-width)))) - (fill-area-width (* avg-pixwidth (- fill-column left-margin))) - (glyph-pixwidth (cond ((stringp glyph) - (* avg-pixwidth (length glyph))) - ;; #### the pixmap option should be removed - ;;((pixmapp glyph) - ;; (pixmap-width glyph)) - ((glyphp glyph) - (glyph-width glyph)) - (t - (error "startup-center-spaces: bad arg"))))) - (+ left-margin - (round (/ (/ (- fill-area-width glyph-pixwidth) 2) avg-pixwidth))))) - -(defun startup-splash-frame-body () - `("\n" ,(emacs-version) "\n" - ,@(if (string-match "beta" emacs-version) - `( (face (bold blue) ( "This is an Experimental version of XEmacs. " - " Type " (key describe-beta) - " to see what this means.\n"))) - `( "\n")) - (face bold-italic "\ -Copyright (C) 1985-1998 Free Software Foundation, Inc. -Copyright (C) 1990-1994 Lucid, Inc. -Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. -Copyright (C) 1994-1996 Board of Trustees, University of Illinois -Copyright (C) 1995-1996 Ben Wing\n\n") - - ,@(if (featurep 'sparcworks) - `( "\ -Sun provides support for the WorkShop/XEmacs integration package only. -All other XEmacs packages are provided to you \"AS IS\". -For full details, type " (key describe-no-warranty) -" to refer to the GPL Version 2, dated June 1991.\n\n" -,@(let ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG")))) - (if (and - (not (featurep 'mule)) ; Already got mule? - (not (eq 'tty (console-type))) ; No Mule support on tty's yet - lang ; Non-English locale? - (not (string= lang "C")) - (not (string-match "^en" lang)) - (locate-file "xemacs-mule" exec-path)) ; Comes with Sun WorkShop - '( "\ -This version of XEmacs has been built with support for Latin-1 languages only. -To handle other languages you need to run a Multi-lingual (`Mule') version of -XEmacs, by either running the command `xemacs-mule', or by using the X resource -`ESERVE*defaultXEmacsPath: xemacs-mule' when starting XEmacs from Sun WorkShop.\n\n")))) - - '("XEmacs comes with ABSOLUTELY NO WARRANTY; type " - (key describe-no-warranty) " for full details.\n")) - - "You may give out copies of XEmacs; type " - (key describe-copying) " to see the conditions.\n" - "Type " (key describe-distribution) - " for information on getting the latest version.\n\n" - - "Type " (key help-command) " or use the " (face bold "Help") " menu to get help.\n" - "Type " (key advertised-undo) " to undo changes (`C-' means use the Control key).\n" - "To get out of XEmacs, type " (key save-buffers-kill-emacs) ".\n" - "Type " (key help-with-tutorial) " for a tutorial on using XEmacs.\n" - "Type " (key info) " to enter Info, " - "which you can use to read online documentation.\n" - (face (bold red) ( "\ -For tips and answers to frequently asked questions, see the XEmacs FAQ. -\(It's on the Help menu, or type " (key xemacs-local-faq) " [a capital F!].\)")))) - -;; I really hate global variables, oh well. -;(defvar xemacs-startup-logo-function nil -; "If non-nil, function called to provide the startup logo. -;This function should return an initialized glyph if it is used.") - -(defun startup-splash-frame () - (let ((p (point)) -; (logo (cond (xemacs-startup-logo-function -; (funcall xemacs-startup-logo-function)) -; (t xemacs-logo))) - (logo xemacs-logo) - (cramped-p (eq 'tty (console-type)))) - (unless cramped-p (insert "\n")) - (indent-to (startup-center-spaces logo)) - (set-extent-begin-glyph (make-extent (point) (point)) logo) - (insert (if cramped-p "\n" "\n\n")) - (splash-frame-present-hack (make-extent p (point)) 'about-xemacs)) - - (let ((after-change-functions nil)) ; no font-lock, thank you - (dolist (l (startup-splash-frame-body)) - (splash-frame-present l))) - (splash-hack-version-string) - (set-buffer-modified-p nil)) - -;; (let ((present-file -;; #'(lambda (f) -;; (splash-frame-present -;; (list 'funcall -;; (list 'find-file-other-window -;; (expand-file-name f data-directory)) -;; f))))) -;; (insert "For customization examples, see the files ") -;; (funcall present-file "sample.emacs") -;; (insert " and ") -;; (funcall present-file "sample.Xdefaults") -;; (insert (format "\nin the directory %s." data-directory))) - -(defun startup-set-invocation-environment () - ;; XEmacs -- Steven Baur says invocation directory is nil if you - ;; try to use XEmacs as a login shell. - (or invocation-directory (setq invocation-directory default-directory)) - (setq invocation-directory - ;; don't let /tmp_mnt/... get into the load-path or exec-path. - (abbreviate-file-name invocation-directory))) - -(defun startup-setup-paths (roots &optional - inhibit-early-packages inhibit-site-lisp - debug-paths) - "Setup all the various paths. -ROOTS is a list of plausible roots of the XEmacs directory hierarchy. -If INHIBIT-PACKAGES is non-NIL, don't do packages. -If INHIBIT-SITE-LISP is non-NIL, don't do site-lisp. -If DEBUG-PATHS is non-NIL, print paths as they are detected. -It's idempotent, so call this as often as you like!" - - (apply #'(lambda (early late last) - (setq early-packages (and (not inhibit-early-packages) - early)) - (setq late-packages late) - (setq last-packages last)) - (packages-find-packages roots)) - - (setq early-package-load-path (packages-find-package-load-path early-packages)) - (setq late-package-load-path (packages-find-package-load-path late-packages)) - (setq last-package-load-path (packages-find-package-load-path last-packages)) - - (if debug-paths - (progn - (princ (format "configure-package-path:\n%S\n" configure-package-path) - 'external-debugging-output) - (princ (format "early-packages and early-package-load-path:\n%S\n%S\n" - early-packages early-package-load-path) - 'external-debugging-output) - (princ (format "late-packages and late-package-load-path:\n%S\n%S\n" - late-packages late-package-load-path) - 'external-debugging-output) - (princ (format "last-packages and last-package-load-path:\n%S\n%S\n" - last-packages last-package-load-path) - 'external-debugging-output))) - - (setq lisp-directory (paths-find-lisp-directory roots)) - - (if debug-paths - (princ (format "lisp-directory:\n%S\n" lisp-directory) - 'external-debugging-output)) - - (setq site-directory (and (null inhibit-site-lisp) - (paths-find-site-lisp-directory roots))) - - (if (and debug-paths (null inhibit-site-lisp)) - (princ (format "site-directory:\n%S\n" site-directory) - 'external-debugging-output)) - - (setq load-path (paths-construct-load-path roots - early-package-load-path - late-package-load-path - last-package-load-path - lisp-directory - site-directory)) - - (setq Info-directory-list - (paths-construct-info-path roots - early-packages late-packages last-packages)) - - - (if debug-paths - (princ (format "Info-directory-list:\n%S\n" Info-directory-list) - 'external-debugging-output)) - - (if (boundp 'lock-directory) - (progn - (setq lock-directory (paths-find-lock-directory roots)) - (setq superlock-file (paths-find-superlock-file lock-directory)) - - (if debug-paths - (progn - (princ (format "lock-directory:\n%S\n" lock-directory) - 'external-debugging-output) - (princ (format "superlock-file:\n%S\n" superlock-file) - 'external-debugging-output))))) - - (setq exec-directory (paths-find-exec-directory roots)) - - (if debug-paths - (princ (format "exec-directory:\n%s\n" exec-directory) - 'external-debugging-output)) - - (setq exec-path - (paths-construct-exec-path roots exec-directory - early-packages late-packages last-packages)) - - (if debug-paths - (princ (format "exec-path:\n%S\n" exec-path) - 'external-debugging-output)) - - (setq doc-directory (paths-find-doc-directory roots)) - - (if debug-paths - (princ (format "doc-directory:\n%S\n" doc-directory) - 'external-debugging-output)) - - (setq data-directory (paths-find-data-directory roots)) - - (if debug-paths - (princ (format "data-directory:\n%S\n" data-directory) - 'external-debugging-output)) - - (setq data-directory-list (paths-construct-data-directory-list data-directory - early-packages - late-packages - last-packages)) - (if debug-paths - (princ (format "data-directory-list:\n%S\n" data-directory-list) - 'external-debugging-output))) - -(defun startup-find-roots-warning () - (save-excursion - (set-buffer (get-buffer-create " *warning-tmp*")) - (erase-buffer) - (buffer-disable-undo (current-buffer)) - - (insert "Couldn't find an obvious default for the root of the\n" - "XEmacs hierarchy.") - - (princ "\nWARNING:\n" 'external-debugging-output) - (princ (buffer-string) 'external-debugging-output))) - -(defun startup-setup-paths-warning () - (let ((lock (if (boundp 'lock-directory) lock-directory 't)) - (warnings '())) - (if (and (stringp lock) (null (file-directory-p lock))) - (setq lock nil)) - (cond - ((null (and lisp-directory exec-directory data-directory doc-directory - load-path - lock)) - (save-excursion - (set-buffer (get-buffer-create " *warning-tmp*")) - (erase-buffer) - (buffer-disable-undo (current-buffer)) - (if (null lisp-directory) (push "lisp-directory" warnings)) - (if (null lock) (push "lock-directory" warnings)) - (if (null exec-directory) (push "exec-directory" warnings)) - (if (null data-directory) (push "data-directory" warnings)) - (if (null doc-directory) (push "doc-directory" warnings)) - (if (null load-path) (push "load-path" warnings)) - - (insert "Couldn't find obvious defaults for:\n") - (while warnings - (insert (car warnings) "\n") - (setq warnings (cdr warnings))) - (insert "Perhaps some directories don't exist, " - "or the XEmacs executable,\n" (concat invocation-directory - invocation-name) - "\nis in a strange place?") - - (princ "\nWARNING:\n" 'external-debugging-output) - (princ (buffer-string) 'external-debugging-output) - (erase-buffer) - t))))) - -;;; startup.el ends here diff --git a/lisp/subr.el b/lisp/subr.el deleted file mode 100644 index e1a2a29..0000000 --- a/lisp/subr.el +++ /dev/null @@ -1,672 +0,0 @@ -;;; subr.el --- basic lisp subroutines for XEmacs - -;; Copyright (C) 1985, 1986, 1992, 1994-5, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 file is dumped with XEmacs. - -;; There's not a whole lot in common now with the FSF version, -;; be wary when applying differences. I've left in a number of lines -;; of commentary just to give diff(1) something to synch itself with to -;; provide useful context diffs. -sb - -;;; Code: - - -;;;; Lisp language features. - -(defmacro lambda (&rest cdr) - "Return a lambda expression. -A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is -self-quoting; the result of evaluating the lambda expression is the -expression itself. The lambda expression may then be treated as a -function, i.e., stored as the function value of a symbol, passed to -funcall or mapcar, etc. - -ARGS should take the same form as an argument list for a `defun'. -DOCSTRING is an optional documentation string. - If present, it should describe how to call the function. - But documentation strings are usually not useful in nameless functions. -INTERACTIVE should be a call to the function `interactive', which see. -It may also be omitted. -BODY should be a list of lisp expressions." - `(function (lambda ,@cdr))) - -(defmacro defun-when-void (&rest args) - "Define a function, just like `defun', unless it's already defined. -Used for compatibility among different emacs variants." - `(if (fboundp ',(car args)) - nil - (defun ,@args))) - -(defmacro define-function-when-void (&rest args) - "Define a function, just like `define-function', unless it's already defined. -Used for compatibility among different emacs variants." - `(if (fboundp ,(car args)) - nil - (define-function ,@args))) - - -;;;; Keymap support. -;; XEmacs: removed to keymap.el - -;;;; The global keymap tree. - -;;; global-map, esc-map, and ctl-x-map have their values set up in -;;; keymap.c; we just give them docstrings here. - -;;;; Event manipulation functions. - -;; XEmacs: This stuff is done in C Code. - -;;;; Obsolescent names for functions. -;; XEmacs: not used. - -;; XEmacs: -(defun local-variable-if-set-p (sym buffer) - "Return t if SYM would be local to BUFFER after it is set. -A nil value for BUFFER is *not* the same as (current-buffer), but -can be used to determine whether `make-variable-buffer-local' has been -called on SYM." - (local-variable-p sym buffer t)) - - -;;;; Hook manipulation functions. - -;; (defconst run-hooks 'run-hooks ...) - -(defun make-local-hook (hook) - "Make the hook HOOK local to the current buffer. -When a hook is local, its local and global values -work in concert: running the hook actually runs all the hook -functions listed in *either* the local value *or* the global value -of the hook variable. - -This function works by making `t' a member of the buffer-local value, -which acts as a flag to run the hook functions in the default value as -well. This works for all normal hooks, but does not work for most -non-normal hooks yet. We will be changing the callers of non-normal -hooks so that they can handle localness; this has to be done one by -one. - -This function does nothing if HOOK is already local in the current -buffer. - -Do not use `make-local-variable' to make a hook variable buffer-local." - (if (local-variable-p hook (current-buffer)) ; XEmacs - nil - (or (boundp hook) (set hook nil)) - (make-local-variable hook) - (set hook (list t)))) - -(defun add-hook (hook function &optional append local) - "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. - -The optional fourth argument, LOCAL, if non-nil, says to modify -the hook's buffer-local value rather than its default value. -This makes no difference if the hook is not buffer-local. -To make a hook variable buffer-local, always use -`make-local-hook', not `make-local-variable'. - -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)) - (or (default-boundp hook) (set-default 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)))) - (if (or local - ;; Detect the case where make-local-variable was used on a hook - ;; and do what we used to do. - (and (local-variable-if-set-p hook (current-buffer)) ; XEmacs - (not (memq t (symbol-value hook))))) - ;; Alter the local value only. - (or (if (consp function) - (member function (symbol-value hook)) - (memq function (symbol-value hook))) - (set hook - (if append - (append (symbol-value hook) (list function)) - (cons function (symbol-value hook))))) - ;; Alter the global value (which is also the only value, - ;; if the hook doesn't have a local value). - (or (if (consp function) - (member function (default-value hook)) - (memq function (default-value hook))) - (set-default hook - (if append - (append (default-value hook) (list function)) - (cons function (default-value hook))))))) - -(defun remove-hook (hook function &optional local) - "Remove from the value of HOOK the function FUNCTION. -HOOK should be a symbol, and FUNCTION may be any valid function. If -FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the -list of hooks to run in HOOK, then nothing is done. See `add-hook'. - -The optional third argument, LOCAL, if non-nil, says to modify -the hook's buffer-local value rather than its default value. -This makes no difference if the hook is not buffer-local. -To make a hook variable buffer-local, always use -`make-local-hook', not `make-local-variable'." - (if (or (not (boundp hook)) ;unbound symbol, or - (not (default-boundp 'hook)) - (null (symbol-value hook)) ;value is nil, or - (null function)) ;function is nil, then - nil ;Do nothing. - (if (or local - ;; Detect the case where make-local-variable was used on a hook - ;; and do what we used to do. - (and (local-variable-p hook (current-buffer)) - (not (memq t (symbol-value hook))))) - (let ((hook-value (symbol-value hook))) - (if (and (consp hook-value) (not (functionp hook-value))) - (if (member function hook-value) - (setq hook-value (delete function (copy-sequence hook-value)))) - (if (equal hook-value function) - (setq hook-value nil))) - (set hook hook-value)) - (let ((hook-value (default-value hook))) - (if (and (consp hook-value) (not (functionp hook-value))) - (if (member function hook-value) - (setq hook-value (delete function (copy-sequence hook-value)))) - (if (equal hook-value function) - (setq hook-value nil))) - (set-default hook hook-value))))) - -(defun add-to-list (list-var element) - "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. -The test for presence of ELEMENT is done with `equal'. -If you want to use `add-to-list' on a variable that is not defined -until a certain package is loaded, you should put the call to `add-to-list' -into a hook function that will be run only after loading the package. -`eval-after-load' provides one way to do this. In some cases -other hooks, such as major mode hooks, can do the job." - (or (member element (symbol-value list-var)) - (set list-var (cons element (symbol-value list-var))))) - -;; XEmacs additions -;; called by Fkill_buffer() -(defvar kill-buffer-hook nil - "Function or functions to be called when a buffer is killed. -The value of this variable may be buffer-local. -The buffer about to be killed is current when this hook is run.") - -;; in C in FSFmacs -(defvar kill-emacs-hook nil - "Function or functions to be called when `kill-emacs' is called, -just before emacs is actually killed.") - -;; not obsolete. -;; #### These are a bad idea, because the CL RPLACA and RPLACD -;; return the cons cell, not the new CAR/CDR. -hniksic -;; The proper definition would be: -;; (defun rplaca (conscell newcar) -;; (setcar conscell newcar) -;; conscell) -;; ...and analogously for RPLACD. -(define-function 'rplaca 'setcar) -(define-function 'rplacd 'setcdr) - -;;;; String functions. - -;; XEmacs -(defun replace-in-string (str regexp newtext &optional literal) - "Replace all matches in STR for REGEXP with NEWTEXT string, - and returns the new string. -Optional LITERAL non-nil means do a literal replacement. -Otherwise treat \\ in NEWTEXT string as special: - \\& means substitute original matched text, - \\N means substitute match for \(...\) number N, - \\\\ means insert one \\." - (check-argument-type 'stringp str) - (check-argument-type 'stringp newtext) - (let ((rtn-str "") - (start 0) - (special) - match prev-start) - (while (setq match (string-match regexp str start)) - (setq prev-start start - start (match-end 0) - rtn-str - (concat - rtn-str - (substring str prev-start match) - (cond (literal newtext) - (t (mapconcat - (lambda (c) - (if special - (progn - (setq special nil) - (cond ((eq c ?\\) "\\") - ((eq c ?&) - (substring str - (match-beginning 0) - (match-end 0))) - ((and (>= c ?0) (<= c ?9)) - (if (> c (+ ?0 (length - (match-data)))) - ;; Invalid match num - (error "Invalid match num: %c" c) - (setq c (- c ?0)) - (substring str - (match-beginning c) - (match-end c)))) - (t (char-to-string c)))) - (if (eq c ?\\) (progn (setq special t) nil) - (char-to-string c)))) - newtext "")))))) - (concat rtn-str (substring str start)))) - -(defun split-string (string &optional pattern) - "Return a list of substrings of STRING which are separated by PATTERN. -If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." - (or pattern - (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - -;; #### #### #### AAaargh! Must be in C, because it is used insanely -;; early in the bootstrap process. -;(defun split-path (path) -; "Explode a search path into a list of strings. -;The path components are separated with the characters specified -;with `path-separator'." -; (while (or (not stringp path-separator) -; (/= (length path-separator) 1)) -; (setq path-separator (signal 'error (list "\ -;`path-separator' should be set to a single-character string" -; path-separator)))) -; (split-string-by-char path (aref separator 0))) - -(defmacro with-output-to-string (&rest forms) - "Collect output to `standard-output' while evaluating FORMS and return -it as a string." - ;; by "William G. Dubuque" w/ mods from Stig - `(with-current-buffer (get-buffer-create " *string-output*") - (setq buffer-read-only nil) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (let ((standard-output (current-buffer))) - ,@forms) - (prog1 - (buffer-string) - (erase-buffer)))) - -(defmacro with-current-buffer (buffer &rest body) - "Execute the forms in BODY with BUFFER as the current buffer. -The value returned is the value of the last form in BODY. -See also `with-temp-buffer'." - `(save-current-buffer - (set-buffer ,buffer) - ,@body)) - -(defmacro with-temp-file (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. -The value of the last form in FORMS is returned, like `progn'. -See also `with-temp-buffer'." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer"))) - `(let ((,temp-file ,file) - (,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp file*")))) - (unwind-protect - (prog1 - (with-current-buffer ,temp-buffer - ,@forms) - (with-current-buffer ,temp-buffer - (widen) - (write-region (point-min) (point-max) ,temp-file nil 0))) - (and (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer)))))) - -(defmacro with-temp-buffer (&rest forms) - "Create a temporary buffer, and evaluate FORMS there like `progn'. -See also `with-temp-file' and `with-output-to-string'." - (let ((temp-buffer (make-symbol "temp-buffer"))) - `(let ((,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp*")))) - (unwind-protect - (with-current-buffer ,temp-buffer - ,@forms) - (and (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer)))))) - -;; Moved from mule-coding.el. -(defmacro with-string-as-buffer-contents (str &rest body) - "With the contents of the current buffer being STR, run BODY. -Returns the new contents of the buffer, as modified by BODY. -The original current buffer is restored afterwards." - `(let ((tempbuf (get-buffer-create " *string-as-buffer-contents*"))) - (with-current-buffer tempbuf - (unwind-protect - (progn - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert ,str) - ,@body - (buffer-string)) - (erase-buffer tempbuf))))) - -(defun insert-face (string face) - "Insert STRING and highlight with FACE. Return the extent created." - (let ((p (point)) ext) - (insert string) - (setq ext (make-extent p (point))) - (set-extent-face ext face) - ext)) - -;; not obsolete. -(define-function 'string= 'string-equal) -(define-function 'string< 'string-lessp) -(define-function 'int-to-string 'number-to-string) -(define-function 'string-to-int 'string-to-number) - -;; These two names are a bit awkward, as they conflict with the normal -;; foo-to-bar naming scheme, but CLtL2 has them, so they stay. -(define-function 'char-int 'char-to-int) -(define-function 'int-char 'int-to-char) - - -;; alist/plist functions -(defun plist-to-alist (plist) - "Convert property list PLIST into the equivalent association-list form. -The alist is returned. This converts from - -\(a 1 b 2 c 3) - -into - -\((a . 1) (b . 2) (c . 3)) - -The original plist is not modified. See also `destructive-plist-to-alist'." - (let (alist) - (while plist - (setq alist (cons (cons (car plist) (cadr plist)) alist)) - (setq plist (cddr plist))) - (nreverse alist))) - -(defun destructive-plist-to-alist (plist) - "Convert property list PLIST into the equivalent association-list form. -The alist is returned. This converts from - -\(a 1 b 2 c 3) - -into - -\((a . 1) (b . 2) (c . 3)) - -The original plist is destroyed in the process of constructing the alist. -See also `plist-to-alist'." - (let ((head plist) - next) - (while plist - ;; remember the next plist pair. - (setq next (cddr plist)) - ;; make the cons holding the property value into the alist element. - (setcdr (cdr plist) (cadr plist)) - (setcar (cdr plist) (car plist)) - ;; reattach into alist form. - (setcar plist (cdr plist)) - (setcdr plist next) - (setq plist next)) - head)) - -(defun alist-to-plist (alist) - "Convert association list ALIST into the equivalent property-list form. -The plist is returned. This converts from - -\((a . 1) (b . 2) (c . 3)) - -into - -\(a 1 b 2 c 3) - -The original alist is not modified. See also `destructive-alist-to-plist'." - (let (plist) - (while alist - (let ((el (car alist))) - (setq plist (cons (cdr el) (cons (car el) plist)))) - (setq alist (cdr alist))) - (nreverse plist))) - -;; getf, remf in cl*.el. - -(defmacro putf (plist prop val) - "Add property PROP to plist PLIST with value VAL. -Analogous to (setq PLIST (plist-put PLIST PROP VAL))." - `(setq ,plist (plist-put ,plist ,prop ,val))) - -(defmacro laxputf (lax-plist prop val) - "Add property PROP to lax plist LAX-PLIST with value VAL. -Analogous to (setq LAX-PLIST (lax-plist-put LAX-PLIST PROP VAL))." - `(setq ,lax-plist (lax-plist-put ,lax-plist ,prop ,val))) - -(defmacro laxremf (lax-plist prop) - "Remove property PROP from lax plist LAX-PLIST. -Analogous to (setq LAX-PLIST (lax-plist-remprop LAX-PLIST PROP))." - `(setq ,lax-plist (lax-plist-remprop ,lax-plist ,prop))) - -;;; Error functions - -(defun error (&rest args) - "Signal an error, making error message by passing all args to `format'. -This error is not continuable: you cannot continue execution after the -error using the debugger `r' command. See also `cerror'." - (while t - (apply 'cerror args))) - -(defun cerror (&rest args) - "Like `error' but signals a continuable error." - (signal 'error (list (apply 'format args)))) - -(defmacro check-argument-type (predicate argument) - "Check that ARGUMENT satisfies PREDICATE. -If not, signal a continuable `wrong-type-argument' error until the -returned value satisfies PREDICATE, and assign the returned value -to ARGUMENT." - `(if (not (,(eval predicate) ,argument)) - (setq ,argument - (wrong-type-argument ,predicate ,argument)))) - -(defun signal-error (error-symbol data) - "Signal a non-continuable error. Args are ERROR-SYMBOL, and associated DATA. -An error symbol is a symbol defined using `define-error'. -DATA should be a list. Its elements are printed as part of the error message. -If the signal is handled, DATA is made available to the handler. -See also `signal', and the functions to handle errors: `condition-case' -and `call-with-condition-handler'." - (while t - (signal error-symbol data))) - -(defun define-error (error-sym doc-string &optional inherits-from) - "Define a new error, denoted by ERROR-SYM. -DOC-STRING is an informative message explaining the error, and will be -printed out when an unhandled error occurs. -ERROR-SYM is a sub-error of INHERITS-FROM (which defaults to `error'). - -\[`define-error' internally works by putting on ERROR-SYM an `error-message' -property whose value is DOC-STRING, and an `error-conditions' property -that is a list of ERROR-SYM followed by each of its super-errors, up -to and including `error'. You will sometimes see code that sets this up -directly rather than calling `define-error', but you should *not* do this -yourself.]" - (check-argument-type 'symbolp error-sym) - (check-argument-type 'stringp doc-string) - (put error-sym 'error-message doc-string) - (or inherits-from (setq inherits-from 'error)) - (let ((conds (get inherits-from 'error-conditions))) - (or conds (signal-error 'error (list "Not an error symbol" error-sym))) - (put error-sym 'error-conditions (cons error-sym conds)))) - -;;;; Miscellanea. - -;; This is now in C. -;(defun buffer-substring-no-properties (beg end) -; "Return the text from BEG to END, without text properties, as a string." -; (let ((string (buffer-substring beg end))) -; (set-text-properties 0 (length string) nil string) -; string)) - -(defun get-buffer-window-list (&optional buffer minibuf frame) - "Return windows currently displaying BUFFER, or nil if none. -BUFFER defaults to the current buffer. -See `walk-windows' for the meaning of MINIBUF and FRAME." - (cond ((null buffer) - (setq buffer (current-buffer))) - ((not (bufferp buffer)) - (setq buffer (get-buffer buffer)))) - (let (windows) - (walk-windows (lambda (window) - (if (eq (window-buffer window) buffer) - (push window windows))) - minibuf frame) - windows)) - -(defun ignore (&rest ignore) - "Do nothing and return nil. -This function accepts any number of arguments, but ignores them." - (interactive) - nil) - -(define-function 'mapc-internal 'mapc) -(make-obsolete 'mapc-internal 'mapc) - -(define-function 'eval-in-buffer 'with-current-buffer) -(make-obsolete 'eval-in-buffer 'with-current-buffer) - -;;; The real defn is in abbrev.el but some early callers -;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded... - -(if (not (fboundp 'define-abbrev-table)) - (progn - (setq abbrev-table-name-list '()) - (fset 'define-abbrev-table (function (lambda (name defs) - ;; These are fixed-up when abbrev.el loads. - (setq abbrev-table-name-list - (cons (cons name defs) - abbrev-table-name-list))))))) - -;;; `functionp' has been moved into C. - -;;(defun functionp (object) -;; "Non-nil if OBJECT can be called as a function." -;; (or (and (symbolp object) (fboundp object)) -;; (subrp object) -;; (compiled-function-p object) -;; (eq (car-safe object) 'lambda))) - - - -(defun function-interactive (function) - "Return the interactive specification of FUNCTION. -FUNCTION can be any funcallable object. -The specification will be returned as the list of the symbol `interactive' - and the specs. -If FUNCTION is not interactive, nil will be returned." - (setq function (indirect-function function)) - (cond ((compiled-function-p function) - (compiled-function-interactive function)) - ((subrp function) - (subr-interactive function)) - ((eq (car-safe function) 'lambda) - (let ((spec (if (stringp (nth 2 function)) - (nth 3 function) - (nth 2 function)))) - (and (eq (car-safe spec) 'interactive) - spec))) - (t - (error "Non-funcallable object: %s" function)))) - -;; This was not present before. I think Jamie had some objections -;; to this, so I'm leaving this undefined for now. --ben - -;;; The objection is this: there is more than one way to load the same file. -;;; "foo", "foo.elc", "foo.el", and "/some/path/foo.elc" are all different -;;; ways to load the exact same code. `eval-after-load' is too stupid to -;;; deal with this sort of thing. If this sort of feature is desired, then -;;; it should work off of a hook on `provide'. Features are unique and -;;; the arguments to (load) are not. --Stig - -;; We provide this for FSFmacs compatibility, at least until we devise -;; something better. - -;;;; Specifying things to do after certain files are loaded. - -(defun eval-after-load (file form) - "Arrange that, if FILE is ever loaded, FORM will be run at that time. -This makes or adds to an entry on `after-load-alist'. -If FILE is already loaded, evaluate FORM right now. -It does nothing if FORM is already on the list for FILE. -FILE should be the name of a library, with no directory name." - ;; Make sure there is an element for FILE. - (or (assoc file after-load-alist) - (setq after-load-alist (cons (list file) after-load-alist))) - ;; Add FORM to the element if it isn't there. - (let ((elt (assoc file after-load-alist))) - (or (member form (cdr elt)) - (progn - (nconc elt (list form)) - ;; If the file has been loaded already, run FORM right away. - (and (assoc file load-history) - (eval form))))) - form) -(make-compatible 'eval-after-load "") - -(defun eval-next-after-load (file) - "Read the following input sexp, and run it whenever FILE is loaded. -This makes or adds to an entry on `after-load-alist'. -FILE should be the name of a library, with no directory name." - (eval-after-load file (read))) -(make-compatible 'eval-next-after-load "") - -; alternate names (not obsolete) -(if (not (fboundp 'mod)) (define-function 'mod '%)) -(define-function 'move-marker 'set-marker) -(define-function 'beep 'ding) ; preserve lingual purity -(define-function 'indent-to-column 'indent-to) -(define-function 'backward-delete-char 'delete-backward-char) -(define-function 'search-forward-regexp (symbol-function 're-search-forward)) -(define-function 'search-backward-regexp (symbol-function 're-search-backward)) -(define-function 'remove-directory 'delete-directory) -(define-function 'set-match-data 'store-match-data) -(define-function 'send-string-to-terminal 'external-debugging-output) -(define-function 'buffer-string 'buffer-substring) - -;;; subr.el ends here diff --git a/lisp/symbols.el b/lisp/symbols.el deleted file mode 100644 index c965f6c..0000000 --- a/lisp/symbols.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; symbols.el --- functions for working with symbols and symbol values - -;; Copyright (C) 1996 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: - -;; Not yet dumped into XEmacs. - -;; The idea behind magic variables is that you can specify arbitrary -;; behavior to happen when setting or retrieving a variable's value. The -;; purpose of this is to make it possible to cleanly provide support for -;; obsolete variables (e.g. unread-command-event, which is obsolete for -;; unread-command-events) and variable compatibility -;; (e.g. suggest-key-bindings, the FSF equivalent of -;; teach-extended-commands-p and teach-extended-commands-timeout). - -;; There are a large number of functions pertaining to a variable's -;; value: - -;; boundp -;; globally-boundp -;; makunbound -;; symbol-value -;; set / setq -;; default-boundp -;; default-value -;; set-default / setq-default -;; make-variable-buffer-local -;; make-local-variable -;; kill-local-variable -;; kill-console-local-variable -;; symbol-value-in-buffer -;; symbol-value-in-console -;; local-variable-p / local-variable-if-set-p - -;; Plus some "meta-functions": - -;; defvaralias -;; variable-alias -;; indirect-variable - -;; I wanted an implementation that: - -;; -- would work with all the above functions, but (a) didn't require -;; a separate handler for every function, and (b) would work OK -;; even if more functions are added (e.g. `set-symbol-value-in-buffer' -;; or `makunbound-default') or if more arguments are added to a -;; function. -;; -- avoided consing if at all possible. -;; -- didn't slow down operations on non-magic variables (therefore, -;; storing the magic information using `put' is ruled out). -;; - -;;; Code: - -;; perhaps this should check whether the functions are bound, so that -;; some handlers can be unspecified. That requires that all functions -;; are defined before `define-magic-variable-handlers' is called, -;; though. - -;; perhaps there should be something that combines -;; `define-magic-variable-handlers' with `defvaralias'. - -(defun define-magic-variable-handlers (variable handler-class harg) - "Set the magic variable handles for VARIABLE to those in HANDLER-CLASS. -HANDLER-CLASS should be a symbol. The handlers are constructed by adding -the handler type to HANDLER-CLASS. HARG is passed as the HARG value for -each of the handlers." - (mapcar - #'(lambda (htype) - (set-magic-variable-handler variable htype - (intern (concat (symbol-value handler-class) - "-" - (symbol-value htype))) - harg)) - '(get-value set-value other-predicate other-action))) - -;; unread-command-event - -(defun mvh-first-of-list-get-value (sym fun args harg) - (car (apply fun harg args))) - -(defun mvh-first-of-list-set-value (sym value setfun getfun args harg) - (apply setfun harg (cons value (apply getfun harg args)) args)) - -(defun mvh-first-of-list-other-predicate (sym fun args harg) - (apply fun harg args)) - -(defun mvh-first-of-list-other-action (sym fun args harg) - (apply fun harg args)) - -(define-magic-variable-handlers 'unread-command-event - 'mvh-first-of-list - 'unread-command-events) - -;; last-command-char, last-input-char, unread-command-char - -(defun mvh-char-to-event-get-value (sym fun args harg) - (event-to-character (apply fun harg args))) - -(defun mvh-char-to-event-set-value (sym value setfun getfun args harg) - (let ((event (apply getfun harg args))) - (if (event-live-p event) - nil - (setq event (allocate-event)) - (apply setfun harg event args)) - (character-to-event value event))) - -(defun mvh-char-to-event-other-predicate (sym fun args harg) - (apply fun harg args)) - -(defun mvh-char-to-event-other-action (sym fun args harg) - (apply fun harg args)) - -(define-magic-variable-handlers 'last-command-char - 'mvh-char-to-event - 'last-command-event) - -(define-magic-variable-handlers 'last-input-char - 'mvh-char-to-event - 'last-input-event) - -(define-magic-variable-handlers 'unread-command-char - 'mvh-char-to-event - 'unread-command-event) - -;; suggest-key-bindings - -(set-magic-variable-handler - 'suggest-key-bindings 'get-value - #'(lambda (sym fun args harg) - (and (apply fun 'teach-extended-commands-p args) - (apply fun 'teach-extended-commands-timeout args)))) - -(set-magic-variable-handler - 'suggest-key-bindings 'set-value - #'(lambda (sym value setfun getfun args harg) - (apply setfun 'teach-extended-commands-p (not (null value)) args) - (if value - (apply 'teach-extended-commands-timeout - (if (numberp value) value 2) args)))) - -(set-magic-variable-handler - 'suggest-key-bindings 'other-action - #'(lambda (sym fun args harg) - (apply fun 'teach-extended-commands-p args) - (apply fun 'teach-extended-commands-timeout args))) - -(set-magic-variable-handler - 'suggest-key-bindings 'other-predicate - #'(lambda (sym fun args harg) - (and (apply fun 'teach-extended-commands-p args) - (apply fun 'teach-extended-commands-timeout args)))) - -;;; symbols.el ends here diff --git a/lisp/syntax.el b/lisp/syntax.el deleted file mode 100644 index 8835eab..0000000 --- a/lisp/syntax.el +++ /dev/null @@ -1,418 +0,0 @@ -;; syntax.el --- Syntax-table hacking stuff, moved from syntax.c - -;; Copyright (C) 1993, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 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, 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 19.28. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; Note: FSF does not have a file syntax.el. This stuff is -;; in syntax.c. See comments there about not merging past 19.28. - -;; Significantly hacked upon by Ben Wing. - -;;; Code: - -(defun make-syntax-table (&optional oldtable) - "Return a new syntax table. -It inherits all characters from the standard syntax table." - (make-char-table 'syntax)) - -(defun simple-set-syntax-entry (char spec table) - (put-char-table char spec table)) - -(defun char-syntax-from-code (code) - "Extract the syntax designator from the internal syntax code CODE. -CODE is the value actually contained in the syntax table." - (if (consp code) - (setq code (car code))) - (aref (syntax-designator-chars) (logand code 127))) - -(defun set-char-syntax-in-code (code desig) - "Return a new internal syntax code whose syntax designator is DESIG. -Other characteristics are the same as in CODE." - (let ((newcode (if (consp code) (car code) code))) - (setq newcode (logior (string-match - (regexp-quote (char-to-string desig)) - (syntax-designator-chars)) - (logand newcode (lognot 127)))) - (if (consp code) (cons newcode (cdr code)) - newcode))) - -(defun syntax-code-to-string (code) - "Return a string equivalent to internal syntax code CODE. -The string can be passed to `modify-syntax-entry'. -If CODE is invalid, return nil." - (let ((match (and (consp code) (cdr code))) - (codes (syntax-designator-chars))) - (if (consp code) - (setq code (car code))) - (if (or (not (integerp code)) - (> (logand code 127) (length codes))) - nil - (with-output-to-string - (let* ((spec (elt codes (logand code 127))) - (b3 (lsh code -16)) - (start1 (/= 0 (logand b3 128))) ;logtest! - (start1b (/= 0 (logand b3 64))) - (start2 (/= 0 (logand b3 32))) - (start2b (/= 0 (logand b3 16))) - (end1 (/= 0 (logand b3 8))) - (end1b (/= 0 (logand b3 4))) - (end2 (/= 0 (logand b3 2))) - (end2b (/= 0 (logand b3 1))) - (prefix (/= 0 (logand code 128))) - (single-char-p (or (= spec ?<) (= spec ?>))) - ) - (write-char spec) - (write-char (if match match 32)) -;;; (if start1 (if single-char-p (write-char ?a) (write-char ?1))) - (if start1 (if single-char-p (write-char ? ) (write-char ?1))) - (if start2 (write-char ?2)) -;;; (if end1 (if single-char-p (write-char ?a) (write-char ?3))) - (if end1 (if single-char-p (write-char ? ) (write-char ?3))) - (if end2 (write-char ?4)) - (if start1b (if single-char-p (write-char ?b) (write-char ?5))) - (if start2b (write-char ?6)) - (if end1b (if single-char-p (write-char ?b) (write-char ?7))) - (if end2b (write-char ?8)) - (if prefix (write-char ?p))))))) - -(defun syntax-string-to-code (string) - "Return the internal syntax code equivalent to STRING. -STRING should be something acceptable as the second argument to -`modify-syntax-entry'. -If STRING is invalid, signal an error." - (let* ((bflag nil) - (b3 0) - (ch0 (aref string 0)) - (len (length string)) - (code (string-match (regexp-quote (char-to-string ch0)) - (syntax-designator-chars))) - (i 2) - ch) - (or code - (error "Invalid syntax designator: %S" string)) - (while (< i len) - (setq ch (aref string i)) - (incf i) - (case ch - (?1 (setq b3 (logior b3 128))) - (?2 (setq b3 (logior b3 32))) - (?3 (setq b3 (logior b3 8))) - (?4 (setq b3 (logior b3 2))) - (?5 (setq b3 (logior b3 64))) - (?6 (setq b3 (logior b3 16))) - (?7 (setq b3 (logior b3 4))) - (?8 (setq b3 (logior b3 1))) - (?a (case ch0 - (?< (setq b3 (logior b3 128))) - (?> (setq b3 (logior b3 8))))) - (?b (case ch0 - (?< (setq b3 (logior b3 64) bflag t)) - (?> (setq b3 (logior b3 4) bflag t)))) - (?p (setq code (logior code (lsh 1 7)))) - (?\ nil) ;; ignore for compatibility - (otherwise - (error "Invalid syntax description flag: %S" string)))) - ;; default single char style if `b' has not been seen - (if (not bflag) - (case ch0 - (?< (setq b3 (logior b3 128))) - (?> (setq b3 (logior b3 8))))) - (setq code (logior code (lsh b3 16))) - (if (and (> len 1) - ;; tough luck if you want to make space a paren! - (/= (aref string 1) ?\ )) - (setq code (cons code (aref string 1)))) - code)) - -(defun modify-syntax-entry (char-range spec &optional table) - "Set syntax for the characters CHAR-RANGE according to string SPEC. -CHAR-RANGE is a single character or a range of characters, - as per `put-char-table'. -The syntax is changed only for table TABLE, which defaults to - the current buffer's syntax table. -The first character of SPEC should be one of the following: - Space whitespace syntax. w word constituent. - _ symbol constituent. . punctuation. - \( open-parenthesis. \) close-parenthesis. - \" string quote. \\ character-quote. - $ paired delimiter. ' expression quote or prefix operator. - < comment starter. > comment ender. - / character-quote. @ inherit from `standard-syntax-table'. - -Only single-character comment start and end sequences are represented thus. -Two-character sequences are represented as described below. -The second character of SPEC is the matching parenthesis, - used only if the first character is `(' or `)'. -Any additional characters are flags. -Defined flags are the characters 1, 2, 3, 4, 5, 6, 7, 8, p, a, and b. - 1 means C is the first of a two-char comment start sequence of style a. - 2 means C is the second character of such a sequence. - 3 means C is the first of a two-char comment end sequence of style a. - 4 means C is the second character of such a sequence. - 5 means C is the first of a two-char comment start sequence of style b. - 6 means C is the second character of such a sequence. - 7 means C is the first of a two-char comment end sequence of style b. - 8 means C is the second character of such a sequence. - p means C is a prefix character for `backward-prefix-chars'; - such characters are treated as whitespace when they occur - between expressions. - a means C is comment starter or comment ender for comment style a (default) - b means C is comment starter or comment ender for comment style b." - (interactive - ;; I really don't know why this is interactive - ;; help-form should at least be made useful while reading the second arg - "cSet syntax for character: \nsSet syntax for %c to: ") - (cond ((syntax-table-p table)) - ((not table) - (setq table (syntax-table))) - (t - (setq table - (wrong-type-argument 'syntax-table-p table)))) - (let ((code (syntax-string-to-code spec))) - (simple-set-syntax-entry char-range code table)) - nil) - -(defun map-syntax-table (__function __table &optional __range) - "Map FUNCTION over entries in syntax table TABLE, collapsing inheritance. -This is similar to `map-char-table', but works only on syntax tables, and - collapses any entries that call for inheritance by invisibly substituting - the inherited values from the standard syntax table." - (check-argument-type 'syntax-table-p __table) - (map-char-table #'(lambda (__key __value) - (if (eq ?@ (char-syntax-from-code __value)) - (map-char-table #'(lambda (__key __value) - (funcall __function - __key __value)) - (standard-syntax-table) - __key) - (funcall __function __key __value))) - __table __range)) - -;(defun test-xm () -; (let ((o (copy-syntax-table)) -; (n (copy-syntax-table)) -; (codes (syntax-designator-chars)) -; (flags "12345678abp")) -; (while t -; (let ((spec (concat (char-to-string (elt codes -; (random (length codes)))))) -; (if (= (random 4) 0) -; "b" -; " ") -; (let* ((n (random 4)) -; (s (make-string n 0))) -; (while (> n 0) -; (setq n (1- n)) -; (aset s n (aref flags (random (length flags))))) -; s)))) -; (message "%S..." spec) -; (modify-syntax-entry ?a spec o) -; (xmodify-syntax-entry ?a spec n) -; (or (= (aref o ?a) (aref n ?a)) -; (error "%s" -; (format "fucked with %S: %x %x" -; spec (aref o ?a) (aref n ?a)))))))) - - -(defun describe-syntax-table (table stream) - (let (first-char - last-char - prev-val - (describe-one - (if (featurep 'mule) - #'(lambda (first last value stream) - (if (equal first last) - (cond ((vectorp first) - (princ (format "%s, row %d\t" - (charset-name - (aref first 0)) - (aref first 1)) - stream)) - ((symbolp first) - (princ first stream) - (princ "\t" stream)) - (t - (princ (text-char-description first) stream) - (princ "\t" stream))) - (cond ((vectorp first) - (princ (format "%s, rows %d .. %d\t" - (charset-name - (aref first 0)) - (aref first 1) - (aref last 1)) - stream)) - ((symbolp first) - (princ (format "%s .. %s\t" first last) stream)) - (t - (princ (format "%s .. %s\t" - (text-char-description first) - (text-char-description last)) - stream)))) - (describe-syntax-code value stream)) - #'(lambda (first last value stream) - (let* ((tem (text-char-description first)) - (pos (length tem)) - ;;(limit (cond ((numberp ctl-arrow) ctl-arrow) - ;; ((memq ctl-arrow '(t nil)) 256) - ;; (t 160))) - ) - (princ tem stream) - (if (> last first) - (progn - (princ " .. " stream) - (setq tem (text-char-description last)) - (princ tem stream) - (setq pos (+ pos (length tem) 4)))) - (while (progn (write-char ?\ stream) - (setq pos (1+ pos)) - (< pos 16)))) - (describe-syntax-code value stream))))) - (map-syntax-table - #'(lambda (range value) - (cond - ((not first-char) - (setq first-char range - last-char range - prev-val value)) - ((and (equal value prev-val) - (or - (and (characterp range) - (characterp first-char) - (or (not (featurep 'mule)) - (eq (char-charset range) - (char-charset first-char))) - (= (char-int last-char) (1- (char-int range)))) - (and (vectorp range) - (vectorp first-char) - (eq (aref range 0) (aref first-char 0)) - (= (aref last-char 1) (1- (aref range 1)))))) - (setq last-char range)) - (t - (funcall describe-one first-char last-char prev-val stream) - (setq first-char range - last-char range - prev-val value))) - nil) - table) - (if first-char - (funcall describe-one first-char last-char prev-val stream)))) - -(defun describe-syntax-code (code stream) - (let ((match (and (consp code) (cdr code))) - (invalid (gettext "**invalid**")) ;(empty "") ;constants - (standard-output (or stream standard-output)) - ;; #### I18N3 should temporarily set buffer to output-translatable - (in #'(lambda (string) - (princ ",\n\t\t\t\t ") - (princ string))) - (syntax-string (syntax-code-to-string code))) - (if (consp code) - (setq code (car code))) - (if (null syntax-string) - (princ invalid) - (princ syntax-string) - (princ "\tmeaning: ") - (princ (aref ["whitespace" "punctuation" "word-constituent" - "symbol-constituent" "open-paren" "close-paren" - "expression-prefix" "string-quote" "paired-delimiter" - "escape" "character-quote" "comment-begin" "comment-end" - "inherit" "extended-word-constituent"] - (logand code 127))) - - (if match - (progn - (princ ", matches ") - (princ (text-char-description match)))) - (let* ((spec (elt syntax-string 0)) - (b3 (lsh code -16)) - (start1 (/= 0 (logand b3 128))) ;logtest! - (start1b (/= 0 (logand b3 64))) - (start2 (/= 0 (logand b3 32))) - (start2b (/= 0 (logand b3 16))) - (end1 (/= 0 (logand b3 8))) - (end1b (/= 0 (logand b3 4))) - (end2 (/= 0 (logand b3 2))) - (end2b (/= 0 (logand b3 1))) - (prefix (/= 0 (logand code 128))) - (single-char-p (or (= spec ?<) (= spec ?>)))) - (if start1 - (if single-char-p - (princ ", style A") - (funcall in - (gettext "first character of comment-start sequence A")))) - (if start2 - (funcall in - (gettext "second character of comment-start sequence A"))) - (if end1 - (if single-char-p - (princ ", style A") - (funcall in - (gettext "first character of comment-end sequence A")))) - (if end2 - (funcall in - (gettext "second character of comment-end sequence A"))) - (if start1b - (if single-char-p - (princ ", style B") - (funcall in - (gettext "first character of comment-start sequence B")))) - (if start2b - (funcall in - (gettext "second character of comment-start sequence B"))) - (if end1b - (if single-char-p - (princ ", style B") - (funcall in - (gettext "first character of comment-end sequence B")))) - (if end2b - (funcall in - (gettext "second character of comment-end sequence B"))) - (if prefix - (funcall in - (gettext "prefix character for `backward-prefix-chars'")))) - (terpri stream)))) - -(defun symbol-near-point () - "Return the first textual item to the nearest point." - (interactive) - ;alg stolen from etag.el - (save-excursion - (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) - (regexp-quote - (progn (forward-char 1) - (buffer-substring (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point))))) - nil))) - -;;; syntax.el ends here diff --git a/lisp/term/bg-mouse.el b/lisp/term/bg-mouse.el deleted file mode 100644 index ca3b447..0000000 --- a/lisp/term/bg-mouse.el +++ /dev/null @@ -1,312 +0,0 @@ -;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse. - -;; Copyright (C) Free Software Foundation, Inc. Oct 1985. - -;; Author: John Robinson -;; Stephen Gildea -;; Maintainer: FSF -;; Keywords: hardware - -;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -;;; Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985 -;;; Modularized and enhanced by gildea@bbn.com Nov 1987 -;;; Time stamp <89/03/21 14:27:08 gildea> - -;;; User customization option: - -(defvar bg-mouse-fast-select-window nil - "*Non-nil for mouse hits to select new window, then execute; else just select.") - -;;; These numbers are summed to make the index into the mouse-map. -;;; The low three bits correspond to what the mouse actually sends. -(defconst bg-button-r 1) -(defconst bg-button-m 2) -(defconst bg-button-c 2) -(defconst bg-button-l 4) -(defconst bg-in-modeline 8) -(defconst bg-in-scrollbar 16) -(defconst bg-in-minibuf 24) - -;;; semicolon screws up indenting, so use this instead -(defconst semicolon ?\;) - -;;; Defuns: - -(defun bg-mouse-report (prefix-arg) - "Read, parse, and execute a BBN BitGraph mouse click. - -L-- move point | These apply for mouse click in a window. ---R set mark | If bg-mouse-fast-select-window is nil, -L-R kill region | these commands on a nonselected window --C- move point and yank | just select that window. -LC- yank-pop | --CR or LCR undo | \"Scroll bar\" is right-hand window column. - -on modeline: on \"scroll bar\": in minibuffer: -L-- scroll-up line to top execute-extended-command ---R scroll-down line to bottom eval-expression --C- proportional goto-char line to middle suspend-emacs - -To reinitialize the mouse if the terminal is reset, type ESC : RET" - (interactive "P") - (bg-get-tty-num semicolon) - (let* - ((screen-mouse-x (min (1- (frame-width)) ;don't hit column 86! - (/ (bg-get-tty-num semicolon) 9))) - (screen-mouse-y (- (1- (frame-height)) ;assume default font size. - (/ (bg-get-tty-num semicolon) 16))) - (bg-mouse-buttons (% (bg-get-tty-num ?c) 8)) - (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y)) - (bg-cursor-window (selected-window)) - (edges (window-edges bg-mouse-window)) - (minibuf-p (= screen-mouse-y (1- (screen-height)))) - (in-modeline-p (and (not minibuf-p) - (= screen-mouse-y (1- (nth 3 edges))))) - (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p) - (>= screen-mouse-x (1- (nth 2 edges))))) - (same-window-p (eq bg-mouse-window bg-cursor-window)) - (in-minibuf-p (and minibuf-p - (not bg-mouse-window))) ;minibuf must be inactive - (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0) - (if in-modeline-p bg-in-modeline 0) - (if in-scrollbar-p bg-in-scrollbar 0))) - (bg-command - (lookup-key mouse-map - (char-to-string (+ bg-mode-bits bg-mouse-buttons)))) - (bg-mouse-x (- screen-mouse-x (nth 0 edges))) - (bg-mouse-y (- screen-mouse-y (nth 1 edges)))) - (cond ((or in-modeline-p in-scrollbar-p) - (select-window bg-mouse-window) - (bg-command-execute bg-command) - (select-window bg-cursor-window)) - ((or same-window-p in-minibuf-p) - (bg-command-execute bg-command)) - (t ;in another window - (select-window bg-mouse-window) - (if bg-mouse-fast-select-window - (bg-command-execute bg-command))) - ))) - - -;;; Library of commands: - -(defun bg-set-point () - "Move point to location of BitGraph mouse." - (interactive) - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (setq this-command 'next-line) ;make subsequent line moves work - (setq temporary-goal-column bg-mouse-x)) - -(defun bg-set-mark () - "Set mark at location of BitGraph mouse." - (interactive) - (push-mark) - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (exchange-point-and-mark)) - -(defun bg-yank () - "Move point to location of BitGraph mouse and yank." - (interactive "*") - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (setq this-command 'yank) - (yank)) - -(defun yank-pop-1 () - (interactive "*") - (yank-pop 1)) - -(defun bg-yank-or-pop () - "Move point to location of BitGraph mouse and yank. If last command -was a yank, do a yank-pop." - (interactive "*") - (if (eql last-command 'yank) - (yank-pop 1) - (bg-yank))) - -;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum -(defconst bg-most-positive-fixnum 8388607) - -(defun bg-move-by-percentage () - "Go to location in buffer that is the same percentage of the way -through the buffer as the BitGraph mouse's X position in the window." - (interactive) - ;; check carefully for overflow in intermediate calculations - (goto-char - (cond ((zerop bg-mouse-x) - 0) - ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x)) - ;; no danger of overflow: compute it exactly - (/ (* bg-mouse-x (buffer-size)) - (1- (window-width)))) - (t - ;; overflow possible: approximate - (* (/ (buffer-size) (1- (window-width))) - bg-mouse-x)))) - (beginning-of-line) - (what-cursor-position)) - -(defun bg-mouse-line-to-top () - "Scroll the line pointed to by the BitGraph mouse to the top of the window." - (interactive) - (scroll-up bg-mouse-y)) - -(defun bg-mouse-line-to-center () - "Scroll the line pointed to by the BitGraph mouse to the center -of the window" - (interactive) - (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2))) - -(defun bg-mouse-line-to-bottom () - "Scroll the line pointed to by the mouse to the bottom of the window." - (interactive) - (scroll-up (+ bg-mouse-y (- 2 (window-height))))) - -(defun bg-kill-region () - (interactive "*") - (kill-region (region-beginning) (region-end))) - -(defun bg-insert-moused-sexp () - "Insert a copy of the word (actually sexp) that the mouse is pointing at. -Sexp is inserted into the buffer at point (where the text cursor is)." - (interactive) - (let ((moused-text - (save-excursion - (bg-move-point-to-x-y bg-mouse-x bg-mouse-y) - (if (looking-at "\\s)") - (forward-char 1) - (forward-sexp 1)) - (buffer-substring (save-excursion (backward-sexp 1) (point)) - (point))))) - (select-window bg-cursor-window) - (delete-horizontal-space) - (cond - ((bolp) - (indent-according-to-mode)) - ;; In Lisp assume double-quote is closing; in Text assume opening. - ;; Why? Because it does the right thing most often. - ((save-excursion (forward-char -1) - (and (not (looking-at "\\s\"")) - (looking-at "[`'\"\\]\\|\\s("))) - nil) - (t - (insert-string " "))) - (insert-string moused-text) - (or (eolp) - (looking-at "\\s.\\|\\s)") - (and (looking-at "'") (looking-at "\\sw")) ;hack for text mode - (save-excursion (insert-string " "))))) - -;;; Utility functions: - -(defun bg-get-tty-num (term-char) - "Read from terminal until TERM-CHAR is read, and return intervening number. -If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error." - (let - ((num 0) - (char (- (read-char) 48))) - (while (and (>= char 0) - (<= char 9)) - (setq num (+ (* num 10) char)) - (setq char (- (read-char) 48))) - (or (eq term-char (+ char 48)) - (progn - (bg-program-mouse) - (error - "Invalid data format in bg-mouse command: mouse reinitialized."))) - num)) - -;;; Note that this fails in the minibuf because move-to-column doesn't -;;; allow for the width of the prompt. -(defun bg-move-point-to-x-y (x y) - "Position cursor in window coordinates. -X and Y are 0-based character positions in the window." - (move-to-window-line y) - ;; if not on a wrapped line, zero-column will be 0 - (let ((zero-column (current-column)) - (scroll-offset (window-hscroll))) - ;; scrolling takes up column 0 to display the $ - (if (> scroll-offset 0) - (setq scroll-offset (1- scroll-offset))) - (move-to-column (+ zero-column scroll-offset x)) - )) - -;;; Returns the window that screen position (x, y) is in or nil if none, -;;; meaning we are in the echo area with a non-active minibuffer. -;;; If coordinates-in-window-p were not in an X-windows-specific file -;;; we could use that. In Emacs 19 can even use locate-window-from-coordinates -(defun bg-window-from-x-y (x y) - "Find window corresponding to screen coordinates. -X and Y are 0-based character positions on the screen." - (let ((edges (window-edges)) - (window nil)) - (while (and (not (eq window (selected-window))) - (or (< y (nth 1 edges)) - (>= y (nth 3 edges)) - (< x (nth 0 edges)) - (>= x (nth 2 edges)))) - (setq window (next-window window)) - (setq edges (window-edges window))) - (cond ((eq window (selected-window)) - nil) ;we've looped: not found - ((not window) - (selected-window)) ;just starting: current window - (t - window)) - )) - -(defun bg-command-execute (bg-command) - (if (commandp bg-command) - (command-execute bg-command) - (ding))) - -(defun bg-program-mouse () - (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c")) - -;;; Note that the doc string for mouse-map (as defined in subr.el) -;;; says it is for the X-window mouse. This is wrong; that keymap -;;; should be used for your mouse no matter what terminal you have. - -(or (keymapp mouse-map) - (setq mouse-map (make-keymap))) - -(defun bind-bg-mouse-click (click-code function) - "Bind bg-mouse CLICK-CODE to run FUNCTION." - (define-key mouse-map (char-to-string click-code) function)) - -(bind-bg-mouse-click bg-button-l 'bg-set-point) -(bind-bg-mouse-click bg-button-m 'bg-yank) -(bind-bg-mouse-click bg-button-r 'bg-set-mark) -(bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1) -(bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region) -(bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo) -(bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage) -(bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center) -(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs) -(bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression) - -(provide 'bg-mouse) - -;;; bg-mouse.el ends here diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el deleted file mode 100644 index d8da970..0000000 --- a/lisp/term/pc-win.el +++ /dev/null @@ -1,204 +0,0 @@ -;; pc-win.el -- setup support for `PC windows' (whatever that is). - -;; Copyright (C) 1994 Free Software Foundation, Inc. - -;; Author: Morten Welinder -;; Version: 1,00 - -;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. -;; --------------------------------------------------------------------------- -(load "term/internal" nil t) - -;; Color translation -- doesn't really need to be fast - -(defvar msdos-color-aliases - '(("purple" . "magenta") - ("firebrick" . "red") ; ? - ("pink" . "lightred") - ("royalblue" . "blue") - ("cadetblue" . "blue") - ("forestgreen" . "green") - ("darkolivegreen" . "green") - ("darkgoldenrod" . "brown") - ("goldenrod" . "yellow") - ("grey40" . "darkgray") - ("rosybrown" . "brown") - ("blue" . "lightblue") ;; from here: for Enriched Text - ("darkslategray" . "darkgray") - ("orange" . "brown") - ("light blue" . "lightblue") ;; from here: for cpp-highlight - ("light cyan" . "lightcyan") - ("light yellow" . "yellow") - ("light pink" . "lightred") - ("pale green" . "lightgreen") - ("beige" . "brown") - ("medium purple" . "magenta") - ("turquoise" . "lightgreen") - ("violet" . "magenta")) - "List of alternate names for colors.") - -(defun msdos-color-translate (name) - (setq name (downcase name)) - (let* ((len (length name)) - (val (cdr (assoc name - '(("black" . 0) - ("blue" . 1) - ("green" . 2) - ("cyan" . 3) - ("red" . 4) - ("magenta" . 5) - ("brown" . 6) - ("lightgray" . 7) ("light gray" . 7) - ("darkgray" . 8) ("dark gray" . 8) - ("lightblue" . 9) - ("lightgreen" . 10) - ("lightcyan" . 11) - ("lightred" . 12) - ("lightmagenta" . 13) - ("yellow" . 14) - ("white" . 15))))) - (try)) - (or val - (and (setq try (cdr (assoc name msdos-color-aliases))) - (msdos-color-translate try)) - (and (> len 5) - (string= "light" (substring name 0 4)) - (setq try (msdos-color-translate (substring name 5))) - (logior try 8)) - (and (> len 6) - (string= "light " (substring name 0 5)) - (setq try (msdos-color-translate (substring name 6))) - (logior try 8)) - (and (> len 4) - (string= "dark" (substring name 0 3)) - (msdos-color-translate (substring name 4))) - (and (> len 5) - (string= "dark " (substring name 0 4)) - (msdos-color-translate (substring name 5)))))) -;; --------------------------------------------------------------------------- -;; We want to delay setting frame parameters until the faces are setup -(defvar default-frame-alist nil) - -(defun msdos-face-setup () - (modify-frame-parameters (selected-frame) default-frame-alist) - - (set-face-foreground 'bold "yellow") - (set-face-foreground 'italic "red") - (set-face-foreground 'bold-italic "lightred") - (set-face-foreground 'underline "white") - (set-face-background 'region "green") - - (make-face 'msdos-menu-active-face) - (make-face 'msdos-menu-passive-face) - (make-face 'msdos-menu-select-face) - (set-face-foreground 'msdos-menu-active-face "white") - (set-face-foreground 'msdos-menu-passive-face "lightgray") - (set-face-background 'msdos-menu-active-face "blue") - (set-face-background 'msdos-menu-passive-face "blue") - (set-face-background 'msdos-menu-select-face "red")) - -;; We have only one font, so... -(add-hook 'before-init-hook 'msdos-face-setup) -;; --------------------------------------------------------------------------- -;; More or less useful immitations of certain X-functions. A lot of the -;; values returned are questionable, but usually only the form of the -;; returned value matters. Also, by the way, recall that `ignore' is -;; a useful function for returning 'nil regardless of argument. - -;; From src/xfns.c -(defun x-display-color-p (&optional display) 't) -(fset 'focus-frame 'ignore) -(fset 'unfocus-frame 'ignore) -(defun x-list-fonts (pattern &optional face frame) (list "default")) -(defun x-color-defined-p (color) (numberp (msdos-color-translate color))) -(defun x-display-pixel-width (&optional frame) (* 8 (frame-width frame))) -(defun x-display-pixel-height (&optional frame) (* 8 (frame-height frame))) -(defun x-display-planes (&optional frame) 4) ; 3 for background, actually -(defun x-display-color-cells (&optional frame) 16) ; ??? -(defun x-server-max-request-size (&optional frame) 1000000) ; ??? -(defun x-server-vendor (&optional frame) t "GNU") -(defun x-server-version (&optional frame) '(1 0 0)) -(defun x-display-screens (&optional frame) 1) -(defun x-display-mm-height (&optional frame) 200) ; Guess the size of my -(defun x-display-mm-width (&optional frame) 253) ; monitor, MW... -(defun x-display-backing-store (&optional frame) 'not-useful) -(defun x-display-visual-class (&optional frame) 'static-color) -(fset 'x-display-save-under 'ignore) -(fset 'x-get-resource 'ignore) - -;; From lisp/term/x-win.el -(setq x-display-name "pc") -(setq split-window-keep-point t) - -;; From lisp/select.el -(defun x-get-selection (&rest rest) "") -(fset 'x-set-selection 'ignore) - -;; From lisp/faces.el: we only have one font, so always return -;; it, no matter which variety they've asked for. -(defun x-frob-font-slant (font which) - font) - -;; From lisp/frame.el -(fset 'set-default-font 'ignore) -(fset 'set-mouse-color 'ignore) ; We cannot, I think. -(fset 'set-cursor-color 'ignore) ; Hardware determined by char under. -(fset 'set-border-color 'ignore) ; Not useful. -(fset 'auto-raise-mode 'ignore) -(fset 'auto-lower-mode 'ignore) -(defun set-background-color (color-name) - "Set the background color of the selected frame to COLOR. -When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'background-color color-name)))) -(defun set-foreground-color (color-name) - "Set the foreground color of the selected frame to COLOR. -When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'foreground-color color-name)))) -;; --------------------------------------------------------------------------- -;; Handle the X-like command line parameters "-fg" and "-bg" -(defun msdos-handle-args (args) - (let ((rest nil)) - (while args - (let ((this (car args))) - (setq args (cdr args)) - (cond ((or (string= this "-fg") (string= this "-foreground")) - (if args - (setq default-frame-alist - (cons (cons 'foreground-color (car args)) - default-frame-alist) - args (cdr args)))) - ((or (string= this "-bg") (string= this "-background")) - (if args - (setq default-frame-alist - (cons (cons 'background-color (car args)) - default-frame-alist) - args (cdr args)))) - (t (setq rest (cons this rest)))))) - (nreverse rest))) - -(setq command-line-args (msdos-handle-args command-line-args)) -;; --------------------------------------------------------------------------- -;; XEmacs always has faces -;;(require 'faces) -(if (msdos-mouse-p) - (progn - (require 'menu-bar) - (menu-bar-mode t))) diff --git a/lisp/term/scoansi.el b/lisp/term/scoansi.el deleted file mode 100644 index 6d324f7..0000000 --- a/lisp/term/scoansi.el +++ /dev/null @@ -1,148 +0,0 @@ -;; scoansi.el --- set up key names for SCO ansi console - -;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. - -;; Author: Kean Johnston - -;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;; HISTORY -;; jkj - Jan 18, 1993: Created. -;; jkj - Nov 18, 1993: Mdified to work with Emacs 19.21 - -;; -;; First of all, the normal cursor movement keys. Some of these, if not -;; all, should be set up my termcap/terminfo. We reset them anyway for -;; the sake of completeness. -;; -(define-key function-key-map "\e[A" [up]) -(define-key function-key-map "\e[B" [down]) -(define-key function-key-map "\e[C" [right]) -(define-key function-key-map "\e[D" [left]) -(define-key function-key-map "\e[E" [center]) -(define-key function-key-map "\e[F" [end]) -(define-key function-key-map "\e[G" [next]) -(define-key function-key-map "\e[H" [home]) -(define-key function-key-map "\e[I" [prior]) -(define-key function-key-map "\e[L" [insert]) -(define-key function-key-map "\e[-" [kp-subtract]) -(define-key function-key-map "\e[+" [kp-add]) - -;; -;; And now all the function keys -;; - -;; Normal, unshifted keys -(define-key function-key-map "\e[M" [f1]) -(define-key function-key-map "\e[N" [f2]) -(define-key function-key-map "\e[O" [f3]) -(define-key function-key-map "\e[P" [f4]) -(define-key function-key-map "\e[Q" [f5]) -(define-key function-key-map "\e[R" [f6]) -(define-key function-key-map "\e[S" [f7]) -(define-key function-key-map "\e[T" [f8]) -(define-key function-key-map "\e[U" [f9]) -(define-key function-key-map "\e[V" [f10]) -(define-key function-key-map "\e[W" [f11]) -(define-key function-key-map "\e[X" [f12]) - -;; Shift-function keys -(define-key function-key-map "\e[Y" [(shift f1)]) -(define-key function-key-map "\e[Z" [(shift f2)]) -(define-key function-key-map "\e[a" [(shift f3)]) -(define-key function-key-map "\e[b" [(shift f4)]) -(define-key function-key-map "\e[c" [(shift f5)]) -(define-key function-key-map "\e[d" [(shift f6)]) -(define-key function-key-map "\e[e" [(shift f7)]) -(define-key function-key-map "\e[f" [(shift f8)]) -(define-key function-key-map "\e[g" [(shift f9)]) -(define-key function-key-map "\e[h" [(shift f10)]) -(define-key function-key-map "\e[i" [(shift f11)]) -(define-key function-key-map "\e[j" [(shift f12)]) - -;; Control function keys -(define-key function-key-map "\e[k" [(control f1)]) -(define-key function-key-map "\e[l" [(control f2)]) -(define-key function-key-map "\e[m" [(control f3)]) -(define-key function-key-map "\e[n" [(control f4)]) -(define-key function-key-map "\e[o" [(control f5)]) -(define-key function-key-map "\e[p" [(control f6)]) -(define-key function-key-map "\e[q" [(control f7)]) -(define-key function-key-map "\e[r" [(control f8)]) -(define-key function-key-map "\e[s" [(control f9)]) -(define-key function-key-map "\e[t" [(control f10)]) -(define-key function-key-map "\e[u" [(control f11)]) -(define-key function-key-map "\e[v" [(control f12)]) - -;; Shift-control function keys -(define-key function-key-map "\e[w" [(control shift f1)]) -(define-key function-key-map "\e[x" [(control shift f2)]) -(define-key function-key-map "\e[y" [(control shift f3)]) -(define-key function-key-map "\e[z" [(control shift f4)]) -(define-key function-key-map "\e[@" [(control shift f5)]) -(define-key function-key-map "\e[[" [(control shift f6)]) -(define-key function-key-map "\e[\\" [(control shift f7)]) -(define-key function-key-map "\e[]" [(control shift f8)]) -(define-key function-key-map "\e[^" [(control shift f9)]) -(define-key function-key-map "\e[_" [(control shift f10)]) -(define-key function-key-map "\e[`" [(control shift f11)]) -(define-key function-key-map "\e[{" [(control shift f12)]) - -;;; -;;; Now come the extended key names. Please refer to README.sco for -;;; more information regarding these keys and how to set them up. -;;; -(define-key function-key-map "\e]A" [(shift home)]) -(define-key function-key-map "\e]B" [(shift up)]) -(define-key function-key-map "\e]C" [(shift prior)]) -(define-key function-key-map "\e]D" [(shift left)]) -(define-key function-key-map "\e]E" [(shift right)]) -(define-key function-key-map "\e]F" [(shift end)]) -(define-key function-key-map "\e]G" [(shift down)]) -(define-key function-key-map "\e]H" [(shift next)]) -(define-key function-key-map "\e]I" [(shift insert)]) -(define-key function-key-map "\e]J" [(shift delete)]) - -(define-key function-key-map "\e]K" [(control home)]) -(define-key function-key-map "\e]L" [(control up)]) -(define-key function-key-map "\e]M" [(control prior)]) -(define-key function-key-map "\e]N" [(control left)]) -(define-key function-key-map "\e]O" [(control right)]) -(define-key function-key-map "\e]P" [(control end)]) -(define-key function-key-map "\e]Q" [(control down)]) -(define-key function-key-map "\e]R" [(control next)]) -(define-key function-key-map "\e]S" [(control insert)]) -(define-key function-key-map "\e]T" [(control delete)]) - -(define-key function-key-map "\e]U" [(meta home)]) -(define-key function-key-map "\e]V" [(meta up)]) -(define-key function-key-map "\e]W" [(meta prior)]) -(define-key function-key-map "\e]X" [(meta left)]) -(define-key function-key-map "\e]Y" [(meta right)]) -(define-key function-key-map "\e]Z" [(meta end)]) -(define-key function-key-map "\e]a" [(meta down)]) -(define-key function-key-map "\e]b" [(meta next)]) -(define-key function-key-map "\e]c" [(meta insert)]) -(define-key function-key-map "\e]d" [(meta delete)]) - -(define-key function-key-map "\e]e" [(control center)]) -(define-key function-key-map "\e]f" [(control kp-subtract)]) -(define-key function-key-map "\e]g" [(control kp-add)]) - -(define-key function-key-map "\e]h" [(meta center)]) -(define-key function-key-map "\e]i" [(meta kp-subtract)]) -(define-key function-key-map "\e]j" [(meta kp-add)]) diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el deleted file mode 100644 index 0537147..0000000 --- a/lisp/term/sun-mouse.el +++ /dev/null @@ -1,673 +0,0 @@ -;;; sun-mouse.el --- mouse handling for Sun windows - -;; Copyright (C) 1987, 1997 Free Software Foundation, Inc. - -;; Author: Jeff Peck -;; Maintainer: FSF -;; 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: Unknown - -;;; Commentary: - -;; Jeff Peck, Sun Microsystems, Jan 1987. -;; Original idea by Stan Jefferson - -;; -;; Modelled after the GNUEMACS keymap interface. -;; -;; User Functions: -;; make-mousemap, copy-mousemap, -;; define-mouse, global-set-mouse, local-set-mouse, -;; use-global-mousemap, use-local-mousemap, -;; mouse-lookup, describe-mouse-bindings -;; -;; Options: -;; extra-click-wait, scrollbar-width -;; - -;;; Code: - -(defvar extra-click-wait 150 - "*Number of milliseconds to wait for an extra click. -Set this to zero if you don't want chords or double clicks.") - -(defvar scrollbar-width 5 - "*The character width of the scrollbar. -The cursor is deemed to be in the right edge scrollbar if it is this near the -right edge, and more than two chars past the end of the indicated line. -Setting to nil limits the scrollbar to the edge or vertical dividing bar.") - -;;; -;;; Mousemaps -;;; -(defun make-mousemap () - "Returns a new mousemap." - (cons 'mousemap nil)) - -(defun copy-mousemap (mousemap) - "Return a copy of mousemap." - (copy-alist mousemap)) - -(defun define-mouse (mousemap mouse-list def) - "Args MOUSEMAP, MOUSE-LIST, DEF. Define MOUSE-LIST in MOUSEMAP as DEF. -MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules: - * One of these atoms specifies the active region of the definition. - text, scrollbar, modeline, minibuffer - * One or two or these atoms specify the button or button combination. - left, middle, right, double - * Any combination of these atoms specify the active shift keys. - control, shift, meta - * With a single unshifted button, you can add - up - to indicate an up-click. -The atom `double' is used with a button designator to denote a double click. -Two button chords are denoted by listing the two buttons. -See sun-mouse-handler for the treatment of the form DEF." - (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def)) - -(defun global-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of MOUSE-EVENT-LIST and DEF. -Note that if MOUSE-EVENT-LIST has a local definition in the current buffer, -that local definition will continue to shadow any global definition." - (interactive "xMouse event: \nxDefinition: ") - (define-mouse current-global-mousemap mouse-list def)) - -(defun local-set-mouse (mouse-list def) - "Give MOUSE-EVENT-LIST a local definition of DEF. -See define-mouse for a description of the arguments. -The definition goes in the current buffer's local mousemap. -Normally buffers in the same major mode share a local mousemap." - (interactive "xMouse event: \nxDefinition: ") - (if (null current-local-mousemap) - (setq current-local-mousemap (make-mousemap))) - (define-mouse current-local-mousemap mouse-list def)) - -(defun use-global-mousemap (mousemap) - "Selects MOUSEMAP as the global mousemap." - (setq current-global-mousemap mousemap)) - -(defun use-local-mousemap (mousemap) - "Selects MOUSEMAP as the local mousemap. -nil for MOUSEMAP means no local mousemap." - (setq current-local-mousemap mousemap)) - - -;;; -;;; Interface to the Mouse encoding defined in Emacstool.c -;;; -;;; Called when mouse-prefix is sent to emacs, additional -;;; information is read in as a list (button x y time-delta) -;;; -;;; First, some generally useful functions: -;;; - -(defun logtest (x y) - "True if any bits set in X are also set in Y. -Just like the Common Lisp function of the same name." - (not (zerop (logand x y)))) - - -;;; -;;; Hit accessors. -;;; - -(defconst sm::ButtonBits 7) ; Lowest 3 bits. -(defconst sm::ShiftmaskBits 56) ; Second lowest 3 bits (56 = 63 - 7). -(defconst sm::DoubleBits 64) ; Bit 7. -(defconst sm::UpBits 128) ; Bit 8. - -;;; All the useful code bits -(defmacro sm::hit-code (hit) - `(nth 0 ,hit)) -;;; The button, or buttons if a chord. -(defmacro sm::hit-button (hit) - `(logand sm::ButtonBits (nth 0 ,hit))) -;;; The shift, control, and meta flags. -(defmacro sm::hit-shiftmask (hit) - `(logand sm::ShiftmaskBits (nth 0 ,hit))) -;;; Set if a double click (but not a chord). -(defmacro sm::hit-double (hit) - `(logand sm::DoubleBits (nth 0 ,hit))) -;;; Set on button release (as opposed to button press). -(defmacro sm::hit-up (hit) - `(logand sm::UpBits (nth 0 ,hit))) -;;; Screen x position. -(defmacro sm::hit-x (hit) `(nth 1 ,hit)) -;;; Screen y position. -(defmacro sm::hit-y (hit) `(nth 2 ,hit)) -;;; Milliseconds since last hit. -(defmacro sm::hit-delta (hit) `(nth 3 ,hit)) - -(defmacro sm::hit-up-p (hit) ; A predicate. - `(not (zerop (sm::hit-up ,hit)))) - -;;; -;;; Loc accessors. for sm::window-xy -;;; -(defmacro sm::loc-w (loc) `(nth 0 ,loc)) -(defmacro sm::loc-x (loc) `(nth 1 ,loc)) -(defmacro sm::loc-y (loc) `(nth 2 ,loc)) - -;;; this is used extensively by sun-fns.el -;;; -(defmacro eval-in-window (window &rest forms) - "Switch to WINDOW, evaluate FORMS, return to original window." - `(let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (progn - (select-window ,window) - ,@forms) - (select-window OriginallySelectedWindow)))) -(put 'eval-in-window 'lisp-indent-function 1) - -;;; -;;; handy utility, generalizes window_loop -;;; - -;;; It's a macro (and does not evaluate its arguments). -(defmacro eval-in-windows (form &optional yesmini) - "Switches to each window and evaluates FORM. Optional argument -YESMINI says to include the minibuffer as a window. -This is a macro, and does not evaluate its arguments." - `(let ((OriginallySelectedWindow (selected-window))) - (unwind-protect - (while (progn - ,form - (not (eq OriginallySelectedWindow - (select-window - (next-window nil ,yesmini)))))) - (select-window OriginallySelectedWindow)))) -(put 'eval-in-window 'lisp-indent-function 0) - -(defun move-to-loc (x y) - "Move cursor to window location X, Y. -Handles wrapped and horizontally scrolled lines correctly." - (move-to-window-line y) - ;; window-line-end expects this to return the window column it moved to. - (let ((cc (current-column)) - (nc (move-to-column - (if (zerop (window-hscroll)) - (+ (current-column) - (min (- (window-width) 2) ; To stay on the line. - x)) - (+ (window-hscroll) -1 - (min (1- (window-width)) ; To stay on the line. - x)))))) - (- nc cc))) - - -(defun minibuffer-window-p (window) - "True iff this WINDOW is minibuffer." - (= (frame-height) - (nth 3 (window-edges window)) ; The bottom edge. - )) - - -(defun sun-mouse-handler (&optional hit) - "Evaluates the function or list associated with a mouse hit. -Expecting to read a hit, which is a list: (button x y delta). -A form bound to button by define-mouse is found by mouse-lookup. -The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound. -If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*, -*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp), -the form is eval'ed; if the form is neither of these, it is an error. -Returns nil." - (interactive) - (if (null hit) (setq hit (sm::combined-hits))) - (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit)))) - (let ((*mouse-window* (sm::loc-w loc)) - (*mouse-x* (sm::loc-x loc)) - (*mouse-y* (sm::loc-y loc)) - (mouse-code (mouse-event-code hit loc))) - (let ((form (with-current-buffer (window-buffer *mouse-window*) - (mouse-lookup mouse-code)))) - (cond ((null form) - (if (not (sm::hit-up-p hit)) ; undefined up hits are ok. - (error "Undefined mouse event: %s" - (prin1-to-string - (mouse-code-to-mouse-list mouse-code))))) - ((symbolp form) - (setq this-command form) - (funcall form *mouse-window* *mouse-x* *mouse-y*)) - ((listp form) - (setq this-command (car form)) - (eval form)) - (t - (error "Mouse action must be symbol or list, but was: %s" - form)))))) - ;; Don't let 'sun-mouse-handler get on last-command, - ;; since this function should be transparent. - (if (eq this-command 'sun-mouse-handler) - (setq this-command last-command)) - ;; (message (prin1-to-string this-command)) ; to see what your buttons did - nil) - -(defun sm::combined-hits () - "Read and return next mouse-hit, include possible double click" - (let ((hit1 (mouse-hit-read))) - (if (not (sm::hit-up-p hit1)) ; Up hits dont start doubles or chords. - (let ((hit2 (mouse-second-hit extra-click-wait))) - (if hit2 ; we cons'd it, we can smash it. - ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...)) - (setcar hit1 (logior (sm::hit-code hit1) - (sm::hit-code hit2) - (if (= (sm::hit-button hit1) - (sm::hit-button hit2)) - sm::DoubleBits 0)))))) - hit1)) - -(defun mouse-hit-read () - "Read mouse-hit list from keyboard. Like (read 'read-char), -but that uses minibuffer, and mucks up last-command." - (let ((char-list nil) (char nil)) - (while (not (equal 13 ; Carriage return. - (prog1 (setq char (read-char)) - (setq char-list (cons char char-list)))))) - (read (mapconcat 'char-to-string (nreverse char-list) "")) - )) - -;;; Second Click Hackery.... -;;; if prefix is not mouse-prefix, need a way to unread the char... -;;; or else have mouse flush input queue, or else need a peek at next char. - -;;; There is no peek, but since one character can be unread, we only -;;; have to flush the queue when the command after a mouse click -;;; starts with mouse-prefix1 (see below). -;;; Something to do later: We could buffer the read commands and -;;; execute them ourselves after doing the mouse command (using -;;; lookup-key ??). - -(defvar mouse-prefix1 24 ; C-x - "First char of mouse-prefix. Used to detect double clicks and chords.") - -(defvar mouse-prefix2 0 ; C-@ - "Second char of mouse-prefix. Used to detect double clicks and chords.") - - -(defun mouse-second-hit (hit-wait) - "Returns the next mouse hit occurring within HIT-WAIT milliseconds." - (if (sit-for-millisecs hit-wait) nil ; No input within hit-wait millisecs. - (let ((pc1 (read-char))) - (if (or (not (equal pc1 mouse-prefix1)) - (sit-for-millisecs 3)) ; a mouse prefix will have second char - ;; Can get away with one unread. - (progn (setq unread-command-events (list pc1)) - nil) ; Next input not mouse event. - (let ((pc2 (read-char))) - (if (not (equal pc2 mouse-prefix2)) - (progn (setq unread-command-events (list pc1)) ; put back the ^X -;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2)) -;;; Well, now we can, but I don't understand this code well enough to fix it... - (ding) ; user will have to retype that pc2. - nil) ; This input is not a mouse event. - ;; Next input has mouse prefix and is within time limit. - (let ((new-hit (mouse-hit-read))) ; Read the new hit. - (if (sm::hit-up-p new-hit) ; Ignore up events when timing. - (mouse-second-hit (- hit-wait (sm::hit-delta new-hit))) - new-hit ; New down hit within limit, return it. - )))))))) - -(defun sm::window-xy (x y) - "Find window containing screen coordinates X and Y. -Returns list (window x y) where x and y are relative to window." - (or - (catch 'found - (eval-in-windows - (let ((we (window-edges (selected-window)))) - (let ((le (nth 0 we)) - (te (nth 1 we)) - (re (nth 2 we)) - (be (nth 3 we))) - (if (= re (frame-width)) - ;; include the continuation column with this window - (setq re (1+ re))) - (if (= be (frame-height)) - ;; include partial line at bottom of frame with this window - ;; id est, if window is not multple of char size. - (setq be (1+ be))) - - (if (and (>= x le) (< x re) - (>= y te) (< y be)) - (throw 'found - (list (selected-window) (- x le) (- y te)))))) - t)) ; include minibuffer in eval-in-windows - ;;If x,y from a real mouse click, we shouldn't get here. - (list nil x y) - )) - -(defun sm::window-region (loc) - "Parse LOC into a region symbol. -Returns one of (text scrollbar modeline minibuffer)" - (let ((w (sm::loc-w loc)) - (x (sm::loc-x loc)) - (y (sm::loc-y loc))) - (let ((right (1- (window-width w))) - (bottom (1- (window-height w)))) - (cond ((minibuffer-window-p w) 'minibuffer) - ((>= y bottom) 'modeline) - ((>= x right) 'scrollbar) - ;; far right column (window separator) is always a scrollbar - ((and scrollbar-width - ;; mouse within scrollbar-width of edge. - (>= x (- right scrollbar-width)) - ;; mouse a few chars past the end of line. - (>= x (+ 2 (window-line-end w x y)))) - 'scrollbar) - (t 'text))))) - -(defun window-line-end (w x y) - "Return WINDOW column (ignore X) containing end of line Y" - (eval-in-window w (save-excursion (move-to-loc (frame-width) y)))) - -;;; -;;; The encoding of mouse events into a mousemap. -;;; These values must agree with coding in emacstool: -;;; -(defconst sm::keyword-alist - '((left . 1) (middle . 2) (right . 4) - (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128) - (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048) - )) - -(defun mouse-event-code (hit loc) - "Maps MOUSE-HIT and LOC into a mouse-code." -;;;Region is a code for one of text, modeline, scrollbar, or minibuffer. - (logior (sm::hit-code hit) - (mouse-region-to-code (sm::window-region loc)))) - -(defun mouse-region-to-code (region) - "Returns partial mouse-code for specified REGION." - (cdr (assq region sm::keyword-alist))) - -(defun mouse-list-to-mouse-code (mouse-list) - "Map a MOUSE-LIST to a mouse-code." - (apply 'logior - (mapcar (function (lambda (x) - (cdr (assq x sm::keyword-alist)))) - mouse-list))) - -(defun mouse-code-to-mouse-list (mouse-code) - "Map a MOUSE-CODE to a mouse-list." - (apply 'nconc (mapcar - (function (lambda (x) - (if (logtest mouse-code (cdr x)) - (list (car x))))) - sm::keyword-alist))) - -(defun mousemap-set (code mousemap value) - (let* ((alist (cdr mousemap)) - (assq-result (assq code alist))) - (if assq-result - (setcdr assq-result value) - (setcdr mousemap (cons (cons code value) alist))))) - -(defun mousemap-get (code mousemap) - (cdr (assq code (cdr mousemap)))) - -(defun mouse-lookup (mouse-code) - "Look up MOUSE-EVENT and return the definition. nil means undefined." - (or (mousemap-get mouse-code current-local-mousemap) - (mousemap-get mouse-code current-global-mousemap))) - -;;; -;;; I (jpeck) don't understand the utility of the next four functions -;;; ask Steven Greenbaum -;;; -(defun mouse-mask-lookup (mask list) - "Args MASK (a bit mask) and LIST (a list of (code . form) pairs). -Returns a list of elements of LIST whose code or'ed with MASK is non-zero." - (let ((result nil)) - (while list - (if (logtest mask (car (car list))) - (setq result (cons (car list) result))) - (setq list (cdr list))) - result)) - -(defun mouse-union (l l-unique) - "Return the union of list of mouse (code . form) pairs L and L-UNIQUE, -where L-UNIQUE is considered to be union'ized already." - (let ((result l-unique)) - (while l - (let ((code-form-pair (car l))) - (if (not (assq (car code-form-pair) result)) - (setq result (cons code-form-pair result)))) - (setq l (cdr l))) - result)) - -(defun mouse-union-first-preferred (l1 l2) - "Return the union of lists of mouse (code . form) pairs L1 and L2, -based on the code's, with preference going to elements in L1." - (mouse-union l2 (mouse-union l1 nil))) - -(defun mouse-code-function-pairs-of-region (region) - "Return a list of (code . function) pairs, where each code is -currently set in the REGION." - (let ((mask (mouse-region-to-code region))) - (mouse-union-first-preferred - (mouse-mask-lookup mask (cdr current-local-mousemap)) - (mouse-mask-lookup mask (cdr current-global-mousemap)) - ))) - -;;; -;;; Functions for DESCRIBE-MOUSE-BINDINGS -;;; And other mouse documentation functions -;;; Still need a good procedure to print out a help sheet in readable format. -;;; - -(defun one-line-doc-string (function) - "Returns first line of documentation string for FUNCTION. -If there is no documentation string, then the string -\"No documentation\" is returned." - (while (consp function) (setq function (car function))) - (let ((doc (documentation function))) - (if (null doc) - "No documentation." - (string-match "^.*$" doc) - (substring doc 0 (match-end 0))))) - -(defun print-mouse-format (binding) - (princ (car binding)) - (princ ": ") - (mapcar (function - (lambda (mouse-list) - (princ mouse-list) - (princ " "))) - (cdr binding)) - (terpri) - (princ " ") - (princ (one-line-doc-string (car binding))) - (terpri) - ) - -(defun print-mouse-bindings (region) - "Prints mouse-event bindings for REGION." - (mapcar 'print-mouse-format (sm::event-bindings region))) - -(defun sm::event-bindings (region) - "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION, -where each mouse-list is bound to the function in REGION." - (let ((mouse-bindings (mouse-code-function-pairs-of-region region)) - (result nil)) - (while mouse-bindings - (let* ((code-function-pair (car mouse-bindings)) - (current-entry (assoc (cdr code-function-pair) result))) - (if current-entry - (setcdr current-entry - (cons (mouse-code-to-mouse-list (car code-function-pair)) - (cdr current-entry))) - (setq result (cons (cons (cdr code-function-pair) - (list (mouse-code-to-mouse-list - (car code-function-pair)))) - result)))) - (setq mouse-bindings (cdr mouse-bindings)) - ) - result)) - -(defun describe-mouse-bindings () - "Lists all current mouse-event bindings." - (interactive) - (with-output-to-temp-buffer "*Help*" - (princ "Text Region") (terpri) - (princ "---- ------") (terpri) - (print-mouse-bindings 'text) (terpri) - (princ "Modeline Region") (terpri) - (princ "-------- ------") (terpri) - (print-mouse-bindings 'modeline) (terpri) - (princ "Scrollbar Region") (terpri) - (princ "--------- ------") (terpri) - (print-mouse-bindings 'scrollbar))) - -(defun describe-mouse-briefly (mouse-list) - "Print a short description of the function bound to MOUSE-LIST." - (interactive "xDescibe mouse list briefly: ") - (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list)))) - (if function - (message "%s runs the command %s" mouse-list function) - (message "%s is undefined" mouse-list)))) - -(defun mouse-help-menu (function-and-binding) - (cons (prin1-to-string (car function-and-binding)) - (menu-create ; Two sub-menu items of form ("String" . nil) - (list (list (one-line-doc-string (car function-and-binding))) - (list (prin1-to-string (cdr function-and-binding))))))) - -(defun mouse-help-region (w x y &optional region) - "Displays a menu of mouse functions callable in this region." - (let* ((region (or region (sm::window-region (list w x y)))) - (mlist (mapcar (function mouse-help-menu) - (sm::event-bindings region))) - (menu (menu-create (cons (list (symbol-name region)) mlist))) - (item (sun-menu-evaluate w 0 y menu)) - ))) - -;;; -;;; Menu interface functions -;;; -;;; use defmenu, because this interface is subject to change -;;; really need a menu-p, but we use vectorp and the context... -;;; -(defun menu-create (items) - "Functional form for defmenu, given a list of ITEMS returns a menu. -Each ITEM is a (STRING . VALUE) pair." - (apply 'vector items) - ) - -(defmacro defmenu (menu &rest itemlist) - "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs. -See sun-menu-evaluate for interpretation of ITEMS." - (list 'defconst menu (funcall 'menu-create itemlist)) - ) - -(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu) - "Display a pop-up menu in WINDOW at X Y and evaluate selected item -of MENU. MENU (or its symbol-value) should be a menu defined by defmenu. - A menu ITEM is a (STRING . FORM) pair; -the FORM associated with the selected STRING is evaluated, -and the resulting value is returned. Generally these FORMs are -evaluated for their side-effects rather than their values. - If the selected form is a menu or a symbol whose value is a menu, -then it is displayed and evaluated as a pullright menu item. - If the FORM of the first ITEM is nil, the STRING of the item -is used as a label for the menu, i.e. it's inverted and not selectable." - - (if (symbolp menu) (setq menu (symbol-value menu))) - (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu))) - -(defun sun-get-frame-data (code) - "Sends the tty-sub-window escape sequence CODE to terminal, -and returns a cons of the two numbers in returned escape sequence. -That is it returns (cons ) from \"\\E[n;;t\". -CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars." - (send-string-to-terminal (concat "\033[" (int-to-string code) "t")) - (let (char str x y) - (while (not (equal 116 (setq char (read-char)))) ; #\t = 116 - (setq str (cons char str))) - (setq str (mapconcat 'char-to-string (nreverse str) "")) - (string-match ";[0-9]*" str) - (setq y (substring str (1+ (match-beginning 0)) (match-end 0))) - (setq str (substring str (match-end 0))) - (string-match ";[0-9]*" str) - (setq x (substring str (1+ (match-beginning 0)) (match-end 0))) - (cons (string-to-int y) (string-to-int x)))) - -(defun sm::font-size () - "Returns font size in pixels: (cons Ysize Xsize)" - (let ((pix (sun-get-frame-data 14)) ; returns size in pixels - (chr (sun-get-frame-data 18))) ; returns size in chars - (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr))))) - -(defvar sm::menu-kludge-x nil - "Cached frame-to-window X-Offset for sm::menu-kludge") -(defvar sm::menu-kludge-y nil - "Cached frame-to-window Y-Offset for sm::menu-kludge") - -(defun sm::menu-kludge () - "If sunfns.c uses this function must be here!" - (or sm::menu-kludge-y - (let ((fs (sm::font-size))) - (setq sm::menu-kludge-y (+ 8 (car fs)) ; a title line and borders - sm::menu-kludge-x 4))) ; best values depend on .defaults/Menu - (let ((wl (sun-get-frame-data 13))) ; returns frame location - (cons (+ (car wl) sm::menu-kludge-y) - (+ (cdr wl) sm::menu-kludge-x)))) - -;;; -;;; Function interface to selection/region -;;; primitive functions are defined in sunfns.c -;;; -(defun sun-yank-selection () - "Set mark and yank the contents of the current sunwindows selection. -Insert contents into the current buffer at point." - (interactive "*") - (set-mark-command nil) - (insert-string (sun-get-selection))) - -(defun sun-select-region (beg end) - "Set the sunwindows selection to the region in the current buffer." - (interactive "r") - (sun-set-selection (buffer-substring beg end))) - -;;; -;;; Support for emacstool -;;; This closes the window instead of stopping emacs. -;;; -(defun suspend-emacstool (&optional stuffstring) - "Suspend emacstool. -If running under as a detached process emacstool, -you don't want to suspend (there is no way to resume), -just close the window, and wait for reopening." - (interactive) - (run-hooks 'suspend-hook) - (if stuffstring (send-string-to-terminal stuffstring)) - (send-string-to-terminal "\033[2t") ; To close EmacsTool window. - (run-hooks 'suspend-resume-hook)) -;;; -;;; initialize mouse maps -;;; - -(make-variable-buffer-local 'current-local-mousemap) -(setq-default current-local-mousemap nil) -(defvar current-global-mousemap (make-mousemap)) - -(provide 'sun-mouse) - -;;; sun-mouse.el ends here diff --git a/lisp/term/sun.el b/lisp/term/sun.el deleted file mode 100644 index 94d443c..0000000 --- a/lisp/term/sun.el +++ /dev/null @@ -1,279 +0,0 @@ -;; sun.el --- keybinding for standard default sunterm keys - -;; Author: Jeff Peck -;; Keywords: terminals - -;; Copyright (C) 1987 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, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; The function key sequences for the console have been converted for -;; use with function-key-map, but the *tool stuff hasn't been touched. - -;;; Code: - -(defun ignore-key () - "interactive version of ignore" - (interactive) - (ignore)) - -(defun scroll-down-in-place (n) - (interactive "p") - (previous-line n) - (scroll-down n)) - -(defun scroll-up-in-place (n) - (interactive "p") - (next-line n) - (scroll-up n)) - -(defun kill-region-and-unmark (beg end) - "Like kill-region, but pops the mark [which equals point, anyway.]" - (interactive "r") - (kill-region beg end) - (setq this-command 'kill-region-and-unmark) - (set-mark-command t)) - -(defun select-previous-complex-command () - "Select Previous-complex-command" - (interactive) - (if (zerop (minibuffer-depth)) - (repeat-complex-command 1) - (previous-complex-command 1))) - -(defun rerun-prev-command () - "Repeat Previous-complex-command." - (interactive) - (eval (nth 0 command-history))) - -(defvar grep-arg nil "Default arg for RE-search") -(defun grep-arg () - (if (memq last-command '(research-forward research-backward)) grep-arg - (let* ((command (car command-history)) - (command-name (symbol-name (car command))) - (search-arg (car (cdr command))) - (search-command - (and command-name (string-match "search" command-name))) - ) - (if (and search-command (stringp search-arg)) (setq grep-arg search-arg) - (setq search-command this-command - grep-arg (read-string "REsearch: " grep-arg) - this-command search-command) - grep-arg)))) - -(defun research-forward () - "Repeat RE search forward." - (interactive) - (re-search-forward (grep-arg))) - -(defun research-backward () - "Repeat RE search backward." - (interactive) - (re-search-backward (grep-arg))) - -;;; -;;; handle sun's extra function keys -;;; this version for those who run with standard .ttyswrc and no emacstool -;;; -;;; sunview picks up expose and open on the way UP, -;;; so we ignore them on the way down -;;; - -(defvar sun-esc-bracket nil - "*If non-nil, rebind ESC [ as prefix for Sun function keys.") - -(defvar sun-raw-prefix (make-sparse-keymap)) -(define-key function-key-map "\e[" sun-raw-prefix) - -(define-key sun-raw-prefix "210z" [r3]) -(define-key sun-raw-prefix "213z" [r6]) -(define-key sun-raw-prefix "214z" [r7]) -(define-key sun-raw-prefix "216z" [r9]) -(define-key sun-raw-prefix "218z" [r11]) -(define-key sun-raw-prefix "220z" [r13]) -(define-key sun-raw-prefix "222z" [r15]) -(define-key sun-raw-prefix "193z" [redo]) -(define-key sun-raw-prefix "194z" [props]) -(define-key sun-raw-prefix "195z" [undo]) -; (define-key sun-raw-prefix "196z" 'ignore-key) ; Expose-down -; (define-key sun-raw-prefix "197z" [put]) -; (define-key sun-raw-prefix "198z" 'ignore-key) ; Open-down -; (define-key sun-raw-prefix "199z" [get]) -(define-key sun-raw-prefix "200z" [find]) -; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark) ; Delete -(define-key sun-raw-prefix "226z" [t3]) -(define-key sun-raw-prefix "227z" [t4]) -(define-key sun-raw-prefix "229z" [t6]) -(define-key sun-raw-prefix "230z" [t7]) -(define-key sun-raw-prefix "A" [up]) ; R8 -(define-key sun-raw-prefix "B" [down]) ; R14 -(define-key sun-raw-prefix "C" [right]) ; R12 -(define-key sun-raw-prefix "D" [left]) ; R10 - -(global-set-key [r3] 'backward-page) -(global-set-key [r6] 'forward-page) -(global-set-key [r7] 'beginning-of-buffer) -(global-set-key [r9] 'scroll-down) -(global-set-key [r11] 'recenter) -(global-set-key [r13] 'end-of-buffer) -(global-set-key [r15] 'scroll-up) -(global-set-key [redo] 'redraw-display) -(global-set-key [props] 'list-buffers) -(global-set-key [undo] 'undo) -(global-set-key [put] 'sun-select-region) -(global-set-key [get] 'sun-yank-selection) -(global-set-key [find] 'exchange-point-and-mark) -(global-set-key [t3] 'scroll-down-in-place) -(global-set-key [t4] 'scroll-up-in-place) -(global-set-key [t6] 'shrink-window) -(global-set-key [t7] 'enlarge-window) - - -(if sun-esc-bracket (global-unset-key "\e[")) - -;;; Since .emacs gets loaded before this file, a hook is supplied -;;; for you to put your own bindings in. - -(defvar sun-raw-prefix-hooks nil - "List of forms to evaluate after setting sun-raw-prefix.") - -(let ((hooks sun-raw-prefix-hooks)) - (while hooks - (eval (car hooks)) - (setq hooks (cdr hooks)) - )) - - -;;; This section adds definitions for the emacstool users -;;; emacstool event filter converts function keys to C-x*{c}{lrt} -;;; -;;; for example the Open key (L7) would be encoded as "\C-x*gl" -;;; the control, meta, and shift keys modify the character {lrt} -;;; note that (unshifted) C-l is ",", C-r is "2", and C-t is "4" -;;; -;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT. -;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys) -;;; as ANSI escape sequences. Use the shell command -;;; % setkeys noarrows -;;; if you want these to come through for emacstool. -;;; -;;; If you are not using EmacsTool, -;;; you can also use this by creating a .ttyswrc file to do the conversion. -;;; but it won't include the CONTROL, META, or SHIFT keys! -;;; -;;; Important to define SHIFTed sequence before matching unshifted sequence. -;;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%) -;;; this is worse than C-S/C-Q flow control anyday! -;;; Do *YOU* run in capslock mode? -;;; - -;;; Note: al, el and gl are trapped by EmacsTool, so they never make it here. - -(defvar meta-flag t) - -(defvar suntool-map (make-sparse-keymap) - "*Keymap for Emacstool bindings.") - -(define-key suntool-map "gr" 'beginning-of-buffer) ; r7 -(define-key suntool-map "iR" 'backward-page) ; R9 -(define-key suntool-map "ir" 'scroll-down) ; r9 -(define-key suntool-map "kr" 'recenter) ; r11 -(define-key suntool-map "mr" 'end-of-buffer) ; r13 -(define-key suntool-map "oR" 'forward-page) ; R15 -(define-key suntool-map "or" 'scroll-up) ; r15 -(define-key suntool-map "b\M-L" 'rerun-prev-command) ; M-AGAIN -(define-key suntool-map "b\M-l" 'prev-complex-command) ; M-Again -(define-key suntool-map "bl" 'redraw-display) ; Again -(define-key suntool-map "cl" 'list-buffers) ; Props -(define-key suntool-map "dl" 'undo) ; Undo -(define-key suntool-map "el" 'ignore-key) ; Expose-Open -(define-key suntool-map "fl" 'sun-select-region) ; Put -(define-key suntool-map "f," 'copy-region-as-kill) ; C-Put -(define-key suntool-map "gl" 'ignore-key) ; Open-Open -(define-key suntool-map "hl" 'sun-yank-selection) ; Get -(define-key suntool-map "h," 'yank) ; C-Get -(define-key suntool-map "il" 'research-forward) ; Find -(define-key suntool-map "i," 're-search-forward) ; C-Find -(define-key suntool-map "i\M-l" 'research-backward) ; M-Find -(define-key suntool-map "i\M-," 're-search-backward) ; C-M-Find - -(define-key suntool-map "jL" 'yank) ; DELETE -(define-key suntool-map "jl" 'kill-region-and-unmark) ; Delete -(define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete -(define-key suntool-map "j," - #'(lambda () (interactive) (pop-mark 1))) ; C-Delete - -(define-key suntool-map "fT" 'shrink-window-horizontally) ; T6 -(define-key suntool-map "gT" 'enlarge-window-horizontally) ; T7 -(define-key suntool-map "ft" 'shrink-window) ; t6 -(define-key suntool-map "gt" 'enlarge-window) ; t7 -(define-key suntool-map "cT" #'(lambda(n) (interactive "p") (scroll-down n))) -(define-key suntool-map "dT" #'(lambda(n) (interactive "p") (scroll-up n))) -(define-key suntool-map "ct" 'scroll-down-in-place) ; t3 -(define-key suntool-map "dt" 'scroll-up-in-place) ; t4 -(define-key ctl-x-map "*" suntool-map) - -;;; Since .emacs gets loaded before this file, a hook is supplied -;;; for you to put your own bindings in. - -(defvar suntool-map-hooks nil - "List of forms to evaluate after setting suntool-map.") - -(let ((hooks suntool-map-hooks)) - (while hooks - (eval (car hooks)) - (setq hooks (cdr hooks)) - )) - -;;; -;;; If running under emacstool, arrange to call suspend-emacstool -;;; instead of suspend-emacs. -;;; -;;; First mouse blip is a clue that we are in emacstool. -;;; -;;; C-x C-@ is the mouse command prefix. - -(autoload 'sun-mouse-handler "sun-mouse" - "Sun Emacstool handler for mouse blips (not loaded)." t) - -(defun emacstool-init () - "Set up Emacstool window, if you know you are in an emacstool." - ;; Make sure sun-mouse and sun-fns are loaded. - (require 'sun-fns) - (define-key ctl-x-map "\C-@" 'sun-mouse-handler) - - (if (< (sun-window-init) 0) - (message "Not a Sun Window") - (progn - (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map) - (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map) - (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map)) - (send-string-to-terminal - (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\")) - )) - -(defun sun-mouse-once () - "Converts to emacstool and sun-mouse-handler on first mouse hit." - (interactive) - (emacstool-init) - (sun-mouse-handler) ; Now, execute this mouse blip. - ) -(define-key ctl-x-map "\C-@" 'sun-mouse-once) - -;;; sun.el ends here diff --git a/lisp/text-props.el b/lisp/text-props.el deleted file mode 100644 index e08bbbc..0000000 --- a/lisp/text-props.el +++ /dev/null @@ -1,401 +0,0 @@ -;;; text-props.el --- implements properties of characters - -;; Copyright (C) 1993-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Amdahl Corporation. -;; Copyright (C) 1995 Ben Wing. - -;; Author: Jamie Zawinski -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, wp, faces, dumped - -;; 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 is dumped with XEmacs. - -;; This is a nearly complete implementation of the FSF19 text properties API. -;; Please let me know if you notice any differences in behavior between -;; this implementation and the FSF implementation. - -;; However, keep in mind that this interface has been implemented because it -;; is useful. Compatibility with code written for FSF19 is a secondary goal -;; to having a clean and useful interface. - -;; The cruftier parts of the FSF API, such as the special handling of -;; properties like `mouse-face', `front-sticky', and other properties whose -;; value is a list of names of *other* properties set at this position, are -;; not implemented. The reason for this is that if you feel you need that -;; kind of functionality, it's a good hint that you should be using extents -;; instead of text properties. - -;; When should I use Text Properties, and when should I use Extents? -;; ================================================================== - -;; If you are putting a `button' or `hyperlink' of some kind into a buffer, -;; the most natural interface is one which deals with properties of regions -;; with explicit endpoints that behave more-or-less like markers. That is -;; what `make-extent', `extent-at', and `extent-property' are for. - -;; If you are dealing with styles of text, where things do not have explicit -;; endpoints (as is done in font-lock.el and shell-font.el) or if you want to -;; partition a buffer (that is, change some attribute of a range from one -;; value to another without disturbing the properties outside of that range) -;; then an interface that deals with properties of characters may be most -;; natural. - -;; Another way of thinking of it is, do you care where the endpoints of the -;; region are? If you do, then you should use extents. If it's ok for the -;; region to become divided, and for two regions with identical properties to -;; be merged into one region, then you might want to use text properties. - -;; Some applications want the attributes they add to be copied by the killing -;; and yanking commands, and some do not. This is orthogonal to whether text -;; properties or extents are used. Remember that text properties are -;; implemented in terms of extents, so anything you can do with one you can -;; do with the other. It's just a matter of which way of creating and -;; managing them is most appropriate to your application. - -;; Implementation details: -;; ======================= - -;; This package uses extents with a non-nil 'text-prop property. It assumes -;; free reign over the endpoints of any extent with that property. It will -;; not alter any extent which does not have that property. - -;; Right now, the text-property functions create one extent for each distinct -;; property; that is, if a range of text has two text-properties on it, there -;; will be two extents. As the set of text-properties is going to be small, -;; this is probably not a big deal. It would be possible to share extents. - -;; One tricky bit is that undo/kill/yank must be made to not fragment things: -;; these extents must not be allowed to overlap. We accomplish this by using -;; a custom `paste-function' property on the extents. - -;; shell-font.el and font-lock.el could put-text-property to attach fonts to -;; the buffer. However, what these packages are interested in is the -;; efficient extent partitioning behavior which this code exhibits, not the -;; duplicability aspect of it. In fact, either of these packages could be -;; implemented by creating a one-character non-expandable extent for each -;; character in the buffer, except that that would be extremely wasteful of -;; memory. (Redisplay performance would be fine, however.) - -;; If these packages were to use put-text-property to make the extents, then -;; when one copied text from a shell buffer or a font-locked source buffer -;; and pasted it somewhere else (a sendmail buffer, or a buffer not in -;; font-lock mode) then the fonts would follow, and there's no easy way to -;; get rid of them (other than pounding out a call to put-text-property by -;; hand.) This is annoying. Maybe it wouldn't be so annoying if there was a -;; more general set of commands for handling styles of text (in fact, if -;; there were such a thing, copying the fonts would probably be exactly what -;; one wanted) but we aren't there yet. So these packages use the interface -;; of `put-nonduplicable-text-property' which is the same, except that it -;; doesn't make duplicable extents. - -;; `put-text-property' and `put-nonduplicable-text-property' don't get along: -;; they will interfere with each other, reusing each others' extents without -;; checking that the "duplicableness" is correct. This is a bug, but it's -;; one that I don't care enough to fix this right now. - -;;; Code: - -(defun set-text-properties (start end props &optional buffer-or-string) - "You should NEVER use this function. It is ideologically blasphemous. -It is provided only to ease porting of broken FSF Emacs programs. -Instead, use `remove-text-properties' to remove the specific properties -you do not want. - -Completely replace properties of text from START to END. -The third argument PROPS is the new property list. -The optional fourth argument, BUFFER-OR-STRING, -is the string or buffer containing the text." - (map-extents #'(lambda (extent ignored) - ;; #### dmoore - shouldn't this use - ;; (extent-start-position extent) - ;; (extent-end-position extent) - (remove-text-properties start end - (list (extent-property extent - 'text-prop) - nil) - buffer-or-string) - nil) - buffer-or-string start end nil nil 'text-prop) - (add-text-properties start end props buffer-or-string)) - - -;;; The following functions can probably stay in lisp, since they're so simple. - -;(defun get-text-property (pos prop &optional buffer) -; "Returns the value of the PROP property at the given position." -; (let ((e (extent-at pos buffer prop))) -; (if e -; (extent-property e prop) -; nil))) - -(defun extent-properties-at-1 (position buffer-or-string text-props-only) - (let ((extent nil) - (props nil) - new-props) - (while (setq extent (extent-at position buffer-or-string - (if text-props-only 'text-prop nil) - extent)) - (if text-props-only - ;; Only return the one prop which the `text-prop' property points at. - (let ((prop (extent-property extent 'text-prop))) - (setq new-props (list prop (extent-property extent prop)))) - ;; Return all the properties... - (setq new-props (extent-properties extent)) - ;; ...but! Don't return the `begin-glyph' or `end-glyph' properties - ;; unless the position is exactly at the appropriate endpoint. Yeah, - ;; this is kind of a kludge. - ;; #### Bug, this doesn't work for end-glyphs (on end-open extents) - ;; because we've already passed the extent with the glyph by the time - ;; it's appropriate to return the glyph. We could return the end - ;; glyph one character early I guess... But then next-property-change - ;; would have to stop one character early as well. It could back up - ;; when it hit an end-glyph... - ;; #### Another bug, if there are multiple glyphs at the same position, - ;; we only see the first one. - (cond ((or (extent-begin-glyph extent) (extent-end-glyph extent)) - (if (/= position (if (extent-property extent 'begin-glyph) - (extent-start-position extent) - (extent-end-position extent))) - (let ((rest new-props) - prev) - (while rest - (cond ((or (eq (car rest) 'begin-glyph) - (eq (car rest) 'end-glyph)) - (if prev - (setcdr prev (cdr (cdr rest))) - (setq new-props (cdr (cdr new-props)))) - (setq rest nil))) - (setq prev rest - rest (cdr rest)))))))) - (cond ((null props) - (setq props new-props)) - (t - (while new-props - (or (getf props (car new-props)) - (setq props (cons (car new-props) - (cons (car (cdr new-props)) - props)))) - (setq new-props (cdr (cdr new-props))))))) - props)) - -(defun extent-properties-at (position &optional object) - "Return the properties of the character at the given position in OBJECT. -OBJECT is either a string or a buffer. The properties of overlapping -extents are merged. The returned value is a property list, some of -which may be shared with other structures. You must not modify it. - -If POSITION is at the end of OBJECT, the value is nil. - -This returns all properties on all extents. -See also `text-properties-at'." - (extent-properties-at-1 position object nil)) - -(defun text-properties-at (position &optional object) - "Return the properties of the character at the given position in OBJECT. -OBJECT is either a string or a buffer. The properties of overlapping -extents are merged. The returned value is a property list, some of -which may be shared with other structures. You must not modify it. - -If POSITION is at the end of OBJECT, the value is nil. - -This returns only those properties added with `put-text-property'. -See also `extent-properties-at'." - (extent-properties-at-1 position object t)) - -(defun text-property-any (start end prop value &optional buffer-or-string) - "Check text from START to END to see if PROP is ever `eq' to VALUE. -If so, return the position of the first character whose PROP is `eq' -to VALUE. Otherwise return nil. -The optional fifth argument, BUFFER-OR-STRING, is the buffer or string -containing the text and defaults to the current buffer." - (while (and start (< start end) - (not (eq value (get-text-property start prop buffer-or-string)))) - (setq start (next-single-property-change start prop buffer-or-string end))) - ;; we have to insert a special check for end due to the illogical - ;; definition of next-single-property-change (blame FSF for this). - (if (eq start end) nil start)) - -(defun text-property-not-all (start end prop value &optional buffer-or-string) - "Check text from START to END to see if PROP is ever not `eq' to VALUE. -If so, return the position of the first character whose PROP is not -`eq' to VALUE. Otherwise, return nil. -The optional fifth argument, BUFFER-OR-STRING, is the buffer or string -containing the text and defaults to the current buffer." - (if (not (eq value (get-text-property start prop buffer-or-string))) - start - (let ((retval (next-single-property-change start prop - buffer-or-string end))) - ;; we have to insert a special check for end due to the illogical - ;; definition of previous-single-property-change (blame FSF for this). - (if (eq retval end) nil retval)))) - -;; Older versions that only work sometimes (when VALUE is non-nil -;; for text-property-any, and maybe only when VALUE is nil for -;; text-property-not-all). They might be faster in those cases, -;; but that's not obvious. - -;(defun text-property-any (start end prop value &optional buffer) -; "Check text from START to END to see if PROP is ever `eq' to VALUE. -;If so, return the position of the first character whose PROP is `eq' -;to VALUE. Otherwise return nil." -; ;; #### what should (text-property-any x y 'foo nil) return when there -; ;; is no foo property between x and y? Either t or nil seems sensible, -; ;; since a character with a property of nil is indistinguishable from -; ;; a character without that property set. -; (map-extents -; #'(lambda (e ignore) -; (if (eq value (extent-property e prop)) -; ;; return non-nil to stop mapping -; (max start (extent-start-position e)) -; nil)) -; nil start end buffer)) -; -;(defun text-property-not-all (start end prop value &optional buffer) -; "Check text from START to END to see if PROP is ever not `eq' to VALUE. -;If so, return the position of the first character whose PROP is not -;`eq' to VALUE. Otherwise, return nil." -; (let (maxend) -; (map-extents -; #'(lambda (e ignore) -; ;;### no, actually, this is harder. We need to collect all props -; ;; for a given character, and then determine whether no extent -; ;; contributes the given value. Doing this without consing lots -; ;; of lists is the tricky part. -; (if (eq value (extent-property e prop)) -; (progn -; (setq maxend (extent-end-position e)) -; nil) -; (max start maxend))) -; nil start end buffer))) - -(defun next-property-change (pos &optional buffer-or-string limit) - "Return the position of next property change. -Scans forward from POS in BUFFER-OR-STRING (defaults to the current buffer) - until it finds a change in some text property, then returns the position of - the change. -Returns nil if the properties remain unchanged all the way to the end. -If the value is non-nil, it is a position greater than POS, never equal. -If the optional third argument LIMIT is non-nil, don't search - past position LIMIT; return LIMIT if nothing is found before LIMIT. -If two or more extents with conflicting non-nil values for a property overlap - a particular character, it is undefined which value is considered to be - the value of the property. (Note that this situation will not happen if - you always use the text-property primitives.)" - (let ((limit-was-nil (null limit))) - (or limit (setq limit (if (bufferp buffer-or-string) - (point-max buffer-or-string) - (length buffer-or-string)))) - (let ((value (extent-properties-at pos buffer-or-string))) - (while - (and (< (setq pos (next-extent-change pos buffer-or-string)) limit) - (plists-eq value (extent-properties-at pos buffer-or-string))))) - (if (< pos limit) pos - (if limit-was-nil nil - limit)))) - -(defun previous-property-change (pos &optional buffer-or-string limit) - "Return the position of previous property change. -Scans backward from POS in BUFFER-OR-STRING (defaults to the current buffer) - until it finds a change in some text property, then returns the position of - the change. -Returns nil if the properties remain unchanged all the way to the beginning. -If the value is non-nil, it is a position less than POS, never equal. -If the optional third argument LIMIT is non-nil, don't search back - past position LIMIT; return LIMIT if nothing is found until LIMIT. -If two or more extents with conflicting non-nil values for a property overlap - a particular character, it is undefined which value is considered to be - the value of the property. (Note that this situation will not happen if - you always use the text-property primitives.)" - (let ((limit-was-nil (null limit))) - (or limit (setq limit (if (bufferp buffer-or-string) - (point-min buffer-or-string) - 0))) - (let ((value (extent-properties-at (1- pos) buffer-or-string))) - (while - (and (> (setq pos (previous-extent-change pos buffer-or-string)) - limit) - (plists-eq value (extent-properties-at (1- pos) - buffer-or-string))))) - (if (> pos limit) pos - (if limit-was-nil nil - limit)))) - -(defun text-property-bounds (pos prop &optional object at-flag) - "Return the bounds of property PROP at POS. -This returns a cons (START . END) of the largest region of text containing -POS which has a non-nil value for PROP. The return value is nil if POS -does not have a non-nil value for PROP. OBJECT specifies the buffer -or string to search in. Optional arg AT-FLAG controls what \"at POS\" -means, and has the same meaning as for `extent-at'." - (or object (setq object (current-buffer))) - (and (get-char-property pos prop object at-flag) - (let ((begin (if (stringp object) 0 (point-min object))) - (end (if (stringp object) (length object) (point-max object)))) - (cons (previous-single-property-change (1+ pos) prop object begin) - (next-single-property-change pos prop object end))))) - -(defun next-text-property-bounds (count pos prop &optional object) - "Return the COUNTth bounded property region of property PROP after POS. -If COUNT is less than zero, search backwards. This returns a cons -\(START . END) of the COUNTth maximal region of text that begins after POS -\(starts before POS) and has a non-nil value for PROP. If there aren't -that many regions, nil is returned. OBJECT specifies the buffer or -string to search in." - (or object (setq object (current-buffer))) - (let ((begin (if (stringp object) 0 (point-min object))) - (end (if (stringp object) (length object) (point-max object)))) - (catch 'hit-end - (if (> count 0) - (progn - (while (> count 0) - (if (>= pos end) - (throw 'hit-end nil) - (and (get-char-property pos prop object) - (setq pos (next-single-property-change pos prop - object end))) - (setq pos (next-single-property-change pos prop object end))) - (setq count (1- count))) - (and (< pos end) - (cons pos (next-single-property-change pos prop object end)))) - (while (< count 0) - (if (<= pos begin) - (throw 'hit-end nil) - (and (get-char-property (1- pos) prop object) - (setq pos (previous-single-property-change pos prop - object begin))) - (setq pos (previous-single-property-change pos prop object - begin))) - (setq count (1+ count))) - (and (> pos begin) - (cons (previous-single-property-change pos prop object begin) - pos)))))) - -;(defun detach-all-extents (&optional buffer) -; (map-extents #'(lambda (x i) (detach-extent x) nil) -; buffer)) - - -(provide 'text-props) - -;;; text-props.el ends here diff --git a/lisp/toolbar-items.el b/lisp/toolbar-items.el deleted file mode 100644 index 171141b..0000000 --- a/lisp/toolbar-items.el +++ /dev/null @@ -1,598 +0,0 @@ -;;; toolbar-items.el -- Static initialization of XEmacs toolbar - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1994 Andy Piper -;; Copyright (C) 1995 Board of Trustees, University of Illinois -;; Copyright (C) 1996 Ben Wing - -;; Maintainer: XEmacs development team -;; Keywords: frames, dumped - -;; 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: Not in FSF - -;;; Commentary: - -;; This file is dumped with XEmacs (when window system and toolbar support -;; is compiled in). - -;; Miscellaneous toolbar functions, useful for users to redefine, in -;; order to get different behavior. - -;;; Code: - -;; Suppress warning message from bytecompiler -(eval-when-compile - (defvar pending-delete-mode) - ;; #### The compiler still warns about missing - ;; `pending-delete-pre-hook'. Any way to get rid of the warning? - ) - -(defgroup toolbar nil - "Configure XEmacs Toolbar functions and properties" - :group 'environment) - -;; #### The following function is slightly obnoxious as it stands. I -;; think it should print a message like "Toolbar not configured; press -;; me again to configure it", and when the button is pressed again -;; (within a reasonable period of time), `customize-variable' should -;; be invoked for the appropriate variable. - -(defun toolbar-not-configured () - (interactive) - ;; Note: we don't use `susbtitute-command-keys' here, because - ;; Customize is bound to `C-h C' by default, and that binding is not - ;; familiar to people. This is more descriptive. - (error - "Configure the item via `M-x customize RET toolbar RET'")) - -(defcustom toolbar-open-function 'find-file - "*Function to call when the open icon is selected." - :type '(radio (function-item find-file) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-open () - (interactive) - (call-interactively toolbar-open-function)) - -(defcustom toolbar-dired-function 'dired - "*Function to call when the dired icon is selected." - :type '(radio (function-item dired) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-dired () - (interactive) - (call-interactively toolbar-dired-function)) - -(defcustom toolbar-save-function 'save-buffer - "*Function to call when the save icon is selected." - :type '(radio (function-item save-buffer) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-save () - (interactive) - (call-interactively toolbar-save-function)) - -(defcustom toolbar-print-function 'lpr-buffer - "*Function to call when the print icon is selected." - :type '(radio (function-item lpr-buffer) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-print () - (interactive) - (call-interactively toolbar-print-function)) - -(defcustom toolbar-cut-function 'kill-primary-selection - "*Function to call when the cut icon is selected." - :type '(radio (function-item kill-primary-selection) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-cut () - (interactive) - (call-interactively toolbar-cut-function)) - -(defcustom toolbar-copy-function 'copy-primary-selection - "*Function to call when the copy icon is selected." - :type '(radio (function-item copy-primary-selection) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-copy () - (interactive) - (call-interactively toolbar-copy-function)) - -(defcustom toolbar-paste-function 'yank-clipboard-selection - "*Function to call when the paste icon is selected." - :type '(radio (function-item yank-clipboard-selection) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-paste () - (interactive) - ;; This horrible kludge is for pending-delete to work correctly. - (and (boundp 'pending-delete-mode) - pending-delete-mode - (let ((this-command toolbar-paste-function)) - (pending-delete-pre-hook))) - (call-interactively toolbar-paste-function)) - -(defcustom toolbar-undo-function 'undo - "*Function to call when the undo icon is selected." - :type '(radio (function-item undo) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-undo () - (interactive) - (call-interactively toolbar-undo-function)) - -(defcustom toolbar-replace-function 'query-replace - "*Function to call when the replace icon is selected." - :type '(radio (function-item query-replace) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-replace () - (interactive) - (call-interactively toolbar-replace-function)) - -;; -;; toolbar ispell variables and defuns -;; - -(defun toolbar-ispell-internal () - (interactive) - (cond - ((region-active-p) (ispell-region (region-beginning) (region-end))) - ((eq major-mode 'mail-mode) (ispell-message)) - ((eq major-mode 'message-mode) (ispell-message)) - (t (ispell-buffer)))) - -(defcustom toolbar-ispell-function 'toolbar-ispell-internal - "*Function to call when the ispell icon is selected." - :type '(radio (function-item toolbar-ispell-internal) - (function :tag "Other")) - :group 'toolbar) - -(defun toolbar-ispell () - "Intelligently spell the region or buffer." - (interactive) - (call-interactively toolbar-ispell-function)) - -;; -;; toolbar mail variables and defuns -;; - -;; This used to be a macro that expanded its arguments to a form that -;; called `call-process'. With the advent of customize, it's better -;; to have it as a defun, to make customization easier. -(defun toolbar-external (process &rest args) - (interactive) - (apply 'call-process process nil 0 nil args)) - -(defcustom toolbar-mail-commands-alist - `((not-configured . toolbar-not-configured) - (vm . vm) - (gnus . gnus-no-server) - (rmail . rmail) - (mh . mh-rmail) - (pine . (toolbar-external "xterm" "-e" "pine")) ; *gag* - (elm . (toolbar-external "xterm" "-e" "elm")) - (mutt . (toolbar-external "xterm" "-e" "mutt")) - (exmh . (toolbar-external "exmh")) - (netscape . (toolbar-external "netscape" "mailbox:")) - (send . mail)) - "*Alist of mail readers and their commands. -The car of each alist element is the mail reader, and the cdr is the form -used to start it." - :type '(repeat (cons :format "%v" - (symbol :tag "Mailer") (function :tag "Start with"))) - :group 'toolbar) - -(defcustom toolbar-mail-reader 'not-configured - "*Mail reader toolbar will invoke. -The legal values are the keys from `toolbar-mail-command-alist', which - should be used to add new mail readers. -Mail readers known by default are vm, gnus, rmail, mh, pine, elm, - mutt, exmh, netscape and send." - :type '(choice (const :tag "Not Configured" not-configured) - (const vm) (const gnus) (const rmail) (const mh) - (const pine) (const elm) (const mutt) (const exmh) - (const netscape) - (const send) - (symbol :tag "Other" - :validate (lambda (wid) - (if (assq (widget-value wid) - toolbar-mail-commands-alist) - nil - (widget-put wid :error - "Unknown mail reader") - wid)))) - :group 'toolbar) - - -(defun toolbar-mail () - "Run mail in a separate frame." - (interactive) - (let ((command (cdr (assq toolbar-mail-reader toolbar-mail-commands-alist)))) - (or command - (error "Uknown mail reader %s" toolbar-mail-reader)) - (if (symbolp command) - (call-interactively command) - (eval command)))) - -;; -;; toolbar info variables and defuns -;; - -(defcustom toolbar-info-use-separate-frame t - "*Whether Info is invoked in a separate frame." - :type 'boolean - :group 'toolbar) - -(defcustom toolbar-info-frame-plist - ;; Info pages are 80 characters wide, so it makes a good default. - `(width 80 ,@(let ((h (plist-get default-frame-plist 'height))) - (and h `(height ,h)))) - "*The properties of the frame in which news is displayed." - :type 'plist - :group 'info) - -(define-obsolete-variable-alias 'Info-frame-plist - 'toolbar-info-frame-plist) - -(defvar toolbar-info-frame nil - "The frame in which info is displayed.") - -(defun toolbar-info () - "Run info in a separate frame." - (interactive) - (when toolbar-info-use-separate-frame - (cond ((or (not toolbar-info-frame) - (not (frame-live-p toolbar-info-frame))) - ;; We used to raise frame here, but it's a bad idea, - ;; because raising is a matter of WM policy. However, we - ;; *must* select it, to ensure that the info buffer goes to - ;; the right frame. - (setq toolbar-info-frame (make-frame toolbar-info-frame-plist)) - (select-frame toolbar-info-frame)) - (t - ;; However, if the frame already exists, and the user - ;; clicks on info, it's OK to raise it. - (select-frame toolbar-info-frame) - (raise-frame toolbar-info-frame))) - (when (frame-iconified-p toolbar-info-frame) - (deiconify-frame toolbar-info-frame))) - (info)) - -;; -;; toolbar debug variables and defuns -;; - -(defun toolbar-debug () - (interactive) - (if (featurep 'eos-debugger) - (call-interactively 'eos::start-debugger) - (require 'gdbsrc) - (call-interactively 'gdbsrc))) - -(defvar compile-command) -(defvar toolbar-compile-already-run nil) - -(defun toolbar-compile () - "Run compile without having to touch the keyboard." - (interactive) - (require 'compile) - (if toolbar-compile-already-run - (compile compile-command) - (setq toolbar-compile-already-run t) - (if (should-use-dialog-box-p) - (popup-dialog-box - `(,(concat "Compile:\n " compile-command) - ["Compile" (compile compile-command) t] - ["Edit command" compile t] - nil - ["Cancel" (message "Quit") t])) - (compile compile-command)))) - -;; -;; toolbar news variables and defuns -;; - -(defcustom toolbar-news-commands-alist - `((not-configured . toolbar-not-configured) - (gnus . toolbar-gnus) ; M-x all-hail-gnus - (rn . (toolbar-external "xterm" "-e" "rn")) - (nn . (toolbar-external "xterm" "-e" "nn")) - (trn . (toolbar-external "xterm" "-e" "trn")) - (xrn . (toolbar-external "xrn")) - (slrn . (toolbar-external "xterm" "-e" "slrn")) - (pine . (toolbar-external "xterm" "-e" "pine")) ; *gag* - (tin . (toolbar-external "xterm" "-e" "tin")) ; *gag* - (netscape . (toolbar-external "netscape" "news:"))) - "*Alist of news readers and their commands. -The car of each alist element the pair is the news reader, and the cdr -is the form used to start it." - :type '(repeat (cons :format "%v" - (symbol :tag "Reader") (sexp :tag "Start with"))) - :group 'toolbar) - -(defcustom toolbar-news-reader 'gnus - "*News reader toolbar will invoke. -The legal values are the keys from `toolbar-news-command-alist', which should - be used to add new news readers. -Newsreaders known by default are gnus, rn, nn, trn, xrn, slrn, pine - and netscape." - :type '(choice (const :tag "Not Configured" not-configured) - (const gnus) (const rn) (const nn) (const trn) - (const xrn) (const slrn) (const pine) (const tin) - (const netscape) - (symbol :tag "Other" - :validate (lambda (wid) - (if (assq (widget-value wid) - toolbar-news-commands-alist) - nil - (widget-put wid :error - "Unknown news reader") - wid)))) - :group 'toolbar) - -(defcustom toolbar-news-use-separate-frame t - "*Whether Gnus is invoked in a separate frame." - :type 'boolean - :group 'toolbar) - -(defvar toolbar-news-frame nil - "The frame in which news is displayed.") - -(defcustom toolbar-news-frame-plist nil - "*The properties of the frame in which news is displayed." - :type 'plist - :group 'toolbar) - -(define-obsolete-variable-alias 'toolbar-news-frame-properties - 'toolbar-news-frame-plist) - -(defun toolbar-gnus () - "Run Gnus in a separate frame." - (interactive) - (if (not toolbar-news-use-separate-frame) - (gnus) - (unless (frame-live-p toolbar-news-frame) - (setq toolbar-news-frame (make-frame toolbar-news-frame-plist)) - (add-hook 'gnus-exit-gnus-hook - (lambda () - (when (frame-live-p toolbar-news-frame) - (if (cdr (frame-list)) - (delete-frame toolbar-news-frame)) - (setq toolbar-news-frame nil)))) - (select-frame toolbar-news-frame) - (gnus)) - (when (framep toolbar-news-frame) - (when (frame-iconified-p toolbar-news-frame) - (deiconify-frame toolbar-news-frame)) - (select-frame toolbar-news-frame) - (raise-frame toolbar-news-frame)))) - -(defun toolbar-news () - "Run News." - (interactive) - (let ((command (cdr-safe - (assq toolbar-news-reader toolbar-news-commands-alist)))) - (or command - (error "Unkown news reader %s" toolbar-news-reader)) - (if (symbolp command) - (call-interactively command) - (eval command)))) - -(defvar toolbar-last-win-icon nil "A `last-win' icon set.") -(defvar toolbar-next-win-icon nil "A `next-win' icon set.") -(defvar toolbar-file-icon nil "A `file' icon set.") -(defvar toolbar-folder-icon nil "A `folder' icon set") -(defvar toolbar-disk-icon nil "A `disk' icon set.") -(defvar toolbar-printer-icon nil "A `printer' icon set.") -(defvar toolbar-cut-icon nil "A `cut' icon set.") -(defvar toolbar-copy-icon nil "A `copy' icon set.") -(defvar toolbar-paste-icon nil "A `paste' icon set.") -(defvar toolbar-undo-icon nil "An `undo' icon set.") -(defvar toolbar-spell-icon nil "A `spell' icon set.") -(defvar toolbar-replace-icon nil "A `replace' icon set.") -(defvar toolbar-mail-icon nil "A `mail' icon set.") -(defvar toolbar-info-icon nil "An `info' icon set.") -(defvar toolbar-compile-icon nil "A `compile' icon set.") -(defvar toolbar-debug-icon nil "A `debugger' icon set.") -(defvar toolbar-news-icon nil "A `news' icon set.") - -;;; each entry maps a variable to the prefix used. - -(defvar init-x-toolbar-list - '((toolbar-last-win-icon . "last-win") - (toolbar-next-win-icon . "next-win") - (toolbar-file-icon . "file") - (toolbar-folder-icon . "folder") - (toolbar-disk-icon . "disk") - (toolbar-printer-icon . "printer") - (toolbar-cut-icon . "cut") - (toolbar-copy-icon . "copy") - (toolbar-paste-icon . "paste") - (toolbar-undo-icon . "undo") - (toolbar-spell-icon . "spell") - (toolbar-replace-icon . "replace") - (toolbar-mail-icon . "mail") - (toolbar-info-icon . "info-def") - (toolbar-compile-icon . "compile") - (toolbar-debug-icon . "debug") - (toolbar-news-icon . "news"))) - -(defun init-x-toolbar () - (toolbar-add-item-data init-x-toolbar-list ) - ;; do this now because errors will occur if the icon symbols - ;; are not initted - (set-specifier default-toolbar initial-toolbar-spec)) - -(defun toolbar-add-item-data ( icon-list &optional icon-dir ) - (if (eq icon-dir nil) - (setq icon-dir toolbar-icon-directory)) - (mapcar - (lambda (cons) - (let ((prefix (expand-file-name (cdr cons) icon-dir))) - ;; #### This should use a better mechanism for finding the - ;; glyphs, allowing for formats other than x[pb]m. Look at - ;; `widget-glyph-find' for an example how it might be done. - (set (car cons) - (if (featurep 'xpm) - (toolbar-make-button-list - (concat prefix "-up.xpm") - nil - (concat prefix "-xx.xpm") - (concat prefix "-cap-up.xpm") - nil - (concat prefix "-cap-xx.xpm")) - (toolbar-make-button-list - (concat prefix "-up.xbm") - (concat prefix "-dn.xbm") - (concat prefix "-xx.xbm")))))) - icon-list)) - -(defvar toolbar-vector-open - [toolbar-file-icon toolbar-open t "Open a file"] - "Define the vector for the \"Open\" toolbar button") - -(defvar toolbar-vector-dired - [toolbar-folder-icon toolbar-dired t "Edit a directory"] - "Define the vector for the \"Dired\" toolbar button") - -(defvar toolbar-vector-save - [toolbar-disk-icon toolbar-save t "Save buffer"] - "Define the vector for the \"Save\" toolbar button") - -(defvar toolbar-vector-print - [toolbar-printer-icon toolbar-print t "Print buffer"] - "Define the vector for the \"Printer\" toolbar button") - -(defvar toolbar-vector-cut - [toolbar-cut-icon toolbar-cut t "Kill region"] - "Define the vector for the \"Cut\" toolbar button") - -(defvar toolbar-vector-copy - [toolbar-copy-icon toolbar-copy t "Copy region"] - "Define the vector for the \"Copy\" toolbar button") - -(defvar toolbar-vector-paste - [toolbar-paste-icon toolbar-paste t "Paste from clipboard"] - "Define the vector for the \"Paste\" toolbar button") - -(defvar toolbar-vector-undo - [toolbar-undo-icon toolbar-undo t "Undo edit"] - "Define the vector for the \"Undo\" toolbar button") - -(defvar toolbar-vector-spell - [toolbar-spell-icon toolbar-ispell t "Check spelling"] - "Define the vector for the \"Spell\" toolbar button") - -(defvar toolbar-vector-replace - [toolbar-replace-icon toolbar-replace t "Search & Replace"] - "Define the vector for the \"Replace\" toolbar button") - -(defvar toolbar-vector-mail - [toolbar-mail-icon toolbar-mail t "Read mail"] - "Define the vector for the \"Mail\" toolbar button") - -(defvar toolbar-vector-info - [toolbar-info-icon toolbar-info t "Info documentation"] - "Define the vector for the \"Info\" toolbar button") - -(defvar toolbar-vector-compile - [toolbar-compile-icon toolbar-compile t "Start a compilation"] - "Define the vector for the \"Compile\" toolbar button") - -(defvar toolbar-vector-debug - [toolbar-debug-icon toolbar-debug t "Start a debugger"] - "Define the vector for the \"Debug\" toolbar button") - -(defvar toolbar-vector-news - [toolbar-news-icon toolbar-news t "Read news"] - "Define the vector for the \"News\" toolbar button") - -(defvar initial-toolbar-spec - (list - ;;[toolbar-last-win-icon pop-window-configuration - ;;(frame-property (selected-frame) - ;; 'window-config-stack) t "Most recent window config"] - ;; #### Illicit knowledge? - ;; #### These don't work right - not consistent! - ;; I don't know what's wrong; perhaps `selected-frame' is wrong - ;; sometimes when this is evaluated. Note that I even tried to - ;; kludge-fix this by calls to `set-specifier-dirty-flag' in - ;; pop-window-configuration and such. - - ;;[toolbar-next-win-icon unpop-window-configuration - ;;(frame-property (selected-frame) - ;; 'window-config-unpop-stack) t "Undo \"Most recent window config\""] - ;; #### Illicit knowledge? - toolbar-vector-open - toolbar-vector-dired - toolbar-vector-save - toolbar-vector-print - toolbar-vector-cut - toolbar-vector-copy - toolbar-vector-paste - toolbar-vector-undo - toolbar-vector-spell - toolbar-vector-replace - toolbar-vector-mail - toolbar-vector-info - toolbar-vector-compile - toolbar-vector-debug - toolbar-vector-news - ) - "The initial toolbar for a buffer.") - -(defun x-init-toolbar-from-resources (locale) - (x-init-specifier-from-resources - top-toolbar-height 'natnum locale - '("topToolBarHeight" . "TopToolBarHeight")) - (x-init-specifier-from-resources - bottom-toolbar-height 'natnum locale - '("bottomToolBarHeight" . "BottomToolBarHeight")) - (x-init-specifier-from-resources - left-toolbar-width 'natnum locale - '("leftToolBarWidth" . "LeftToolBarWidth")) - (x-init-specifier-from-resources - right-toolbar-width 'natnum locale - '("rightToolBarWidth" . "RightToolBarWidth")) - (x-init-specifier-from-resources - top-toolbar-border-width 'natnum locale - '("topToolBarBorderWidth" . "TopToolBarBorderWidth")) - (x-init-specifier-from-resources - bottom-toolbar-border-width 'natnum locale - '("bottomToolBarBorderWidth" . "BottomToolBarBorderWidth")) - (x-init-specifier-from-resources - left-toolbar-border-width 'natnum locale - '("leftToolBarBorderWidth" . "LeftToolBarBorderWidth")) - (x-init-specifier-from-resources - right-toolbar-border-width 'natnum locale - '("rightToolBarBorderWidth" . "RightToolBarBorderWidth"))) - -;;; toolbar-items.el ends here diff --git a/lisp/toolbar.el b/lisp/toolbar.el deleted file mode 100644 index 18a0e44..0000000 --- a/lisp/toolbar.el +++ /dev/null @@ -1,201 +0,0 @@ -;;; toolbar.el --- Toolbar support for XEmacs - -;; Copyright (C) 1995, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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: - -;; This file is dumped with XEmacs (when toolbar support is compiled in). - -;;; Code: - -(defcustom toolbar-visible-p ;; added for the options menu - dverna apr. 98 - (specifier-instance default-toolbar-visible-p) - "Whether the default toolbar is globally visible. This option can be -customized through the options menu." - :group 'display - :type 'boolean - :set #'(lambda (var val) - (set-specifier default-toolbar-visible-p val) - (setq toolbar-visible-p val)) - ) - -(defcustom toolbar-captioned-p ;; added for the options menu - dverna apr. 98 - (specifier-instance toolbar-buttons-captioned-p) - "Whether the toolbars buttons are globally captioned. This option can be -customized through the options menu." - :group 'display - :type 'boolean - :set #'(lambda (var val) - (set-specifier toolbar-buttons-captioned-p val) - (setq toolbar-captioned-p val)) - ) - -(defcustom default-toolbar-position ;; added for the options menu - dverna - (default-toolbar-position) - "The location of the default toolbar. It can be 'top, 'bootom, 'left or -'right. This option can be customized through the options menu." - :group 'display - :type '(choice (const :tag "top" 'top) - (const :tag "bottom" 'bottom) - (const :tag "left" 'left) - (const :tag "right" 'right)) - :set #'(lambda (var val) - (set-default-toolbar-position val) - (setq default-toolbar-position val)) - ) - -(defvar toolbar-help-enabled t - "If non-nil help is echoed for toolbar buttons.") - -(defvar toolbar-icon-directory nil - "Location of standard toolbar icon bitmaps.") - -(defun toolbar-make-button-list (up &optional down disabled cap-up cap-down cap-disabled) - "Call make-glyph on each arg and return a list of the results." - (let ((up-glyph (make-glyph up)) - (down-glyph (and down (make-glyph down))) - (disabled-glyph (and disabled (make-glyph disabled))) - (cap-up-glyph (and cap-up (make-glyph cap-up))) - (cap-down-glyph (and cap-down (make-glyph cap-down))) - (cap-disabled-glyph (and cap-disabled (make-glyph cap-disabled)))) - (if cap-disabled - (list up-glyph down-glyph disabled-glyph - cap-up-glyph cap-down-glyph cap-disabled-glyph) - (if cap-down - (list up-glyph down-glyph disabled-glyph - cap-up-glyph cap-down-glyph) - (if cap-up - (list up-glyph down-glyph disabled-glyph cap-up-glyph) - (if disabled-glyph - (list up-glyph down-glyph disabled-glyph) - (if down-glyph - (list up-glyph down-glyph) - (list up-glyph)))))))) - -(defun init-toolbar-location () - (if (not toolbar-icon-directory) - (let ((name (locate-data-directory "toolbar"))) - (if name - (setq toolbar-icon-directory - (file-name-as-directory name)))))) - -(defun init-toolbar-from-resources (locale) - (if (and (featurep 'x) - (not (featurep 'infodock)) - (or (eq locale 'global) - (eq 'x (device-or-frame-type locale)))) - (x-init-toolbar-from-resources locale))) - - -;; #### Is this actually needed or will the code in -;; default-mouse-motion-handler suffice? -(define-key global-map 'button1up 'release-toolbar-button) - -(defvar toolbar-map (let ((m (make-sparse-keymap))) - (set-keymap-name m 'toolbar-map) - m) - "Keymap consulted for mouse-clicks over a toolbar.") - -(define-key toolbar-map 'button1 'press-toolbar-button) -(define-key toolbar-map 'button1up 'release-and-activate-toolbar-button) -(defvar last-pressed-toolbar-button nil) -(defvar toolbar-active nil) - -;; -;; It really sucks that we also have to tie onto -;; default-mouse-motion-handler to make sliding buttons work right. -;; -(defun press-toolbar-button (event) - "Press a toolbar button. This only changes its appearance. -Call function stored in `toolbar-blank-press-function,' if any, with EVENT as -an argument if press is over a blank area of the toolbar." - (interactive "_e") - (setq this-command last-command) - (let ((button (event-toolbar-button event))) - ;; We silently ignore non-buttons. This most likely means we are - ;; over a blank part of the toolbar. - (setq toolbar-active t) - (if (toolbar-button-p button) - (progn - (set-toolbar-button-down-flag button t) - (setq last-pressed-toolbar-button button)) - ;; Added by Bob Weiner, Motorola Inc., 10/6/95, to handle - ;; presses on blank portions of toolbars. - (and (boundp 'toolbar-blank-press-function) - (functionp toolbar-blank-press-function) - (funcall toolbar-blank-press-function event))))) - -(defun release-and-activate-toolbar-button (event) - "Release a toolbar button and activate its callback. -Call function stored in `toolbar-blank-release-function,' if any, with EVENT -as an argument if release is over a blank area of the toolbar." - (interactive "_e") - (or (button-release-event-p event) - (error "%s must be invoked by a mouse-release" this-command)) - (release-toolbar-button event) - (let ((button (event-toolbar-button event))) - (if (and (toolbar-button-p button) - (toolbar-button-enabled-p button) - (toolbar-button-callback button)) - (let ((callback (toolbar-button-callback button))) - (setq this-command callback) - ;; Handle arbitrary functions. - (if (functionp callback) - (if (commandp callback) - (call-interactively callback) - (funcall callback)) - (eval callback)))))) - -;; If current is not t, then only release the toolbar button stored in -;; last-pressed-toolbar-button -(defun release-toolbar-button-internal (event current) - (let ((button (event-toolbar-button event))) - (setq zmacs-region-stays t) - (if (and last-pressed-toolbar-button - (not (eq last-pressed-toolbar-button button)) - (toolbar-button-p last-pressed-toolbar-button)) - (progn - (set-toolbar-button-down-flag last-pressed-toolbar-button nil) - (setq last-pressed-toolbar-button nil))) - (if (and current (toolbar-button-p button)) - (set-toolbar-button-down-flag button nil)))) - -(defun release-toolbar-button (event) - "Release all pressed toolbar buttons." - (interactive "_e") - (or (button-release-event-p event) - (error "%s must be invoked by a mouse-release" this-command)) - (release-toolbar-button-internal event t) - ;; Don't set this-command if we're being called - ;; from release-and-activate-toolbar-button. - (if (interactive-p) - (setq this-command last-command)) - (setq toolbar-active nil)) - -(defun release-previous-toolbar-button (event) - (setq zmacs-region-stays t) - (release-toolbar-button-internal event nil)) - -;;; toolbar.el ends here diff --git a/lisp/update-elc.el b/lisp/update-elc.el deleted file mode 100644 index bddaf12..0000000 --- a/lisp/update-elc.el +++ /dev/null @@ -1,147 +0,0 @@ -;;; update-elc.el --- Bytecompile out-of-date dumped files - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1996 Unknown - -;; 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: - -;; Byte compile the .EL files necessary to dump out xemacs. -;; Use this file like this: - -;; temacs -batch -l ../lisp/update-elc.el $lisp - -;; where $lisp comes from the Makefile. .elc files listed in $lisp will -;; cause the corresponding .el file to be compiled. .el files listed in -;; $lisp will be ignored. - -;; (the idea here is that you can bootstrap if your .ELC files -;; are missing or badly out-of-date) - -;; Currently this code gets the list of files to check passed to it from -;; src/Makefile. This must be fixed. -slb - -;;; Code: - -(defvar processed nil) -(defvar update-elc-files-to-compile nil) - -;(setq update-elc-files-to-compile -; (delq nil -; (mapcar (function -; (lambda (x) -; (if (string-match "\.elc$" x) -; (let ((src (substring x 0 -1))) -; (if (file-newer-than-file-p src x) -; (progn -; (and (file-exists-p x) -; (null (file-writable-p x)) -; (set-file-modes x (logior (file-modes x) 128))) -; src)))))) -; ;; -batch gets filtered out. -; (nthcdr 3 command-line-args)))) - -(setq load-path (split-path (getenv "EMACSBOOTSTRAPLOADPATH"))) - -(load "very-early-lisp" nil t) - -(load "find-paths.el") -(load "packages.el") -(load "setup-paths.el") -(load "dump-paths.el") - -(let ((autol (packages-list-autoloads (concat default-directory "../lisp")))) - ;; (print (prin1-to-string autol)) - (while autol - (let ((src (car autol))) - (if (and (file-exists-p src) - (file-newer-than-file-p src (concat src "c"))) - (setq update-elc-files-to-compile - (cons src update-elc-files-to-compile)))) - (setq autol (cdr autol)))) - -;; (print (prin1-to-string update-elc-files-to-compile)) - -(let (preloaded-file-list site-load-packages) - (load (concat default-directory "../lisp/dumped-lisp.el")) - - ;; Path setup - (let ((package-preloaded-file-list - (packages-collect-package-dumped-lisps late-package-load-path))) - - (setq preloaded-file-list - (append package-preloaded-file-list - preloaded-file-list - packages-hardcoded-lisp))) - - (load (concat default-directory "../site-packages") t t) - (setq preloaded-file-list - (append packages-hardcoded-lisp - preloaded-file-list - packages-useful-lisp - site-load-packages)) - (while preloaded-file-list - (let ((arg (car preloaded-file-list))) - ;; (print (prin1-to-string arg)) - (if (null (member (file-name-nondirectory arg) - packages-unbytecompiled-lisp)) - (progn - (setq arg (locate-library arg)) - (if (null arg) - (progn - (print (format "Error: Library file %s not found" - (car preloaded-file-list))) - ;; Uncomment in case of trouble - ;;(print (format "late-packages: %S" late-packages)) - ;;(print (format "guessed-roots: %S" (paths-find-emacs-roots invocation-directory invocation-name))) - (kill-emacs))) - (if (string-match "\\.elc?\\'" arg) - (setq arg (substring arg 0 (match-beginning 0)))) - (if (and (null (member arg processed)) - (file-exists-p (concat arg ".el")) - (file-newer-than-file-p (concat arg ".el") - (concat arg ".elc"))) - (setq processed (cons (concat arg ".el") processed))))) - (setq preloaded-file-list (cdr preloaded-file-list))))) - -(setq update-elc-files-to-compile (append update-elc-files-to-compile - processed)) - -;; (print (prin1-to-string update-elc-files-to-compile)) - -(if update-elc-files-to-compile - (progn - (setq command-line-args - (append '("-l" "loadup-el.el" "run-temacs" - "-batch" "-q" "-no-site-file" - "-l" "bytecomp" "-f" "batch-byte-compile") - update-elc-files-to-compile)) - (load "loadup-el.el")) - (condition-case nil - (delete-file "./NOBYTECOMPILE") - (file-error nil))) - -(kill-emacs) - -;;; update-elc.el ends here diff --git a/lisp/userlock.el b/lisp/userlock.el deleted file mode 100644 index 446c326..0000000 --- a/lisp/userlock.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; userlock.el --- handle file access contention between multiple users - -;; Copyright (C) 1985, 1986, 1993 Free Software Foundation, inc. - -;; Maintainer: FSF -;; 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: FSF 19.34. - -;;; Commentary: - -;; This file is autoloaded to handle certain conditions -;; detected by the file-locking code within XEmacs. -;; The two entry points are `ask-user-about-lock' and -;; `ask-user-about-supersession-threat'. - -;;; Code: - -(define-error 'file-locked "File is locked" 'file-error) ; XEmacs - -(defun ask-user-about-lock-minibuf (fn opponent) - (save-window-excursion - (let (answer) - (while (null answer) - (message "%s is locking %s: action (s, q, p, ?)? " opponent fn) - (let ((tem (let ((inhibit-quit t) - (cursor-in-echo-area t)) - (prog1 (downcase (read-char)) - (setq quit-flag nil))))) - (if (= tem help-char) - (ask-user-about-lock-help) - (setq answer (assoc tem '((?s . t) - (?q . yield) - (?\C-g . yield) - (?p . nil) - (?? . help)))) - (cond ((null answer) - (beep) - (message "Please type q, s, or p; or ? for help") - (sit-for 3)) - ((eq (cdr answer) 'help) - (ask-user-about-lock-help) - (setq answer nil)) - ((eq (cdr answer) 'yield) - (signal 'file-locked (list "File is locked" fn opponent))))))) - (cdr answer)))) - -(defun ask-user-about-lock-help () - (with-output-to-temp-buffer "*Help*" - (princ "It has been detected that you want to modify a file that someone else has -already started modifying in EMACS. - -You can teal the file; The other user becomes the - intruder if (s)he ever unmodifies the file and then changes it again. -You can

roceed; you edit at your own (and the other user's) risk. -You can uit; don't modify this file.") - (save-excursion - (set-buffer standard-output) - (help-mode)))) - -(define-error 'file-supersession "File changed on disk" 'file-error) ; XEmacs - -(defun ask-user-about-supersession-threat-minibuf (fn) - (save-window-excursion - (let (answer) - (while (null answer) - (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) " - (file-name-nondirectory fn)) - (let ((tem (downcase (let ((cursor-in-echo-area t)) - (read-char))))) - (setq answer - (if (= tem help-char) - 'help - (cdr (assoc tem '((?n . yield) - (?\C-g . yield) - (?y . proceed) - (?r . revert) - (?? . help)))))) - (cond ((null answer) - (beep) - (message "Please type y, n or r; or ? for help") - (sit-for 3)) - ((eq answer 'help) - (ask-user-about-supersession-help) - (setq answer nil)) - ((eq answer 'revert) - (revert-buffer nil (not (buffer-modified-p))) - ; ask confirmation iff buffer modified - (signal 'file-supersession - (list "File reverted" fn))) - ((eq answer 'yield) - (signal 'file-supersession - (list "File changed on disk" fn)))))) - (message - "File on disk now will become a backup file if you save these changes.") - (setq buffer-backed-up nil)))) - -(defun ask-user-about-supersession-help () - (with-output-to-temp-buffer "*Help*" - (princ "You want to modify a buffer whose disk file has changed -since you last read it in or saved it with this buffer. - -If you say `y' to go ahead and modify this buffer, -you risk ruining the work of whoever rewrote the file. -If you say `r' to revert, the contents of the buffer are refreshed -from the file on disk. -If you say `n', the change you started to make will be aborted. - -Usually, you should type `n' and then `M-x revert-buffer', -to get the latest version of the file, then make the change again.") - (save-excursion - (set-buffer standard-output) - (help-mode)))) - -;;; dialog-box versions [XEmacs] - -(defun ask-user-about-lock-dbox (fn opponent) - (let ((echo-keystrokes 0) - (dbox - (cons - (format "%s is locking %s\n - It has been detected that you want to modify a file that - someone else has already started modifying in XEmacs." - opponent fn) - '(["Steal Lock\n\nThe other user will\nbecome the intruder" steal t] - ["Proceed\n\nEdit file at your own\n\(and the other user's) risk" - proceed t] - nil - ["Abort\n\nDon't modify the buffer\n" yield t])))) - (popup-dialog-box dbox) - (catch 'aual-done - (while t - (let ((event (next-command-event))) - (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed)) - (throw 'aual-done nil)) - ((and (misc-user-event-p event) (eq (event-object event) 'steal)) - (throw 'aual-done t)) - ((and (misc-user-event-p event) (eq (event-object event) 'yield)) - (signal 'file-locked (list "File is locked" fn opponent))) - ((and (misc-user-event-p event) - (eq (event-object event) 'menu-no-selection-hook)) - (signal 'quit nil)) - ((button-release-event-p event) ;; don't beep twice - nil) - (t - (beep) - (message "please answer the dialog box")))))))) - -(defun ask-user-about-supersession-threat-dbox (fn) - (let ((echo-keystrokes 0) - (dbox - (cons - (format "File %s has changed on disk -since its buffer was last read in or saved. - -Do you really want to edit the buffer? " fn) - '(["Yes\n\nEdit the buffer anyway,\nignoring the disk file" - proceed t] - ["No\n\nDon't modify the buffer\n" yield t] - nil - ["No\n\nDon't modify the buffer\nbut revert it" revert t] - )))) - (popup-dialog-box dbox) - (catch 'auast-done - (while t - (let ((event (next-command-event))) - (cond ((and (misc-user-event-p event) (eq (event-object event) 'proceed)) - (throw 'auast-done nil)) - ((and (misc-user-event-p event) (eq (event-object event) 'yield)) - (signal 'file-supersession (list fn))) - ((and (misc-user-event-p event) (eq (event-object event) 'revert)) - (or (equal fn (buffer-file-name)) - (error - "ask-user-about-supersession-threat called bogusly")) - (revert-buffer nil t) - (signal 'file-supersession - (list fn "(reverted)"))) - ((and (misc-user-event-p event) - (eq (event-object event) 'menu-no-selection-hook)) - (signal 'quit nil)) - ((button-release-event-p event) ;; don't beep twice - nil) - (t - (beep) - (message "please answer the dialog box")))))))) - - -;;; top-level - -;;;###autoload -(defun ask-user-about-lock (fn opponent) - "Ask user what to do when he wants to edit FILE but it is locked by USER. -This function has a choice of three things to do: - do (signal 'file-locked (list FILE USER)) - to refrain from editing the file - return t (grab the lock on the file) - return nil (edit the file even though it is locked). -You can rewrite it to use any criterion you like to choose which one to do." - (discard-input) - (if (and (fboundp 'popup-dialog-box) - (or (button-press-event-p last-command-event) - (button-release-event-p last-command-event) - (misc-user-event-p last-command-event))) - (ask-user-about-lock-dbox fn opponent) - (ask-user-about-lock-minibuf fn opponent))) - -;;;###autoload -(defun ask-user-about-supersession-threat (fn) - "Ask a user who is about to modify an obsolete buffer what to do. -This function has two choices: it can return, in which case the modification -of the buffer will proceed, or it can (signal 'file-supersession (file)), -in which case the proposed buffer modification will not be made. - -You can rewrite this to use any criterion you like to choose which one to do. -The buffer in question is current when this function is called." - (discard-input) - (if (and (fboundp 'popup-dialog-box) - (or (button-press-event-p last-command-event) - (button-release-event-p last-command-event) - (misc-user-event-p last-command-event))) - (ask-user-about-supersession-threat-dbox fn) - (ask-user-about-supersession-threat-minibuf fn))) - -;;; userlock.el ends here diff --git a/lisp/version.el b/lisp/version.el deleted file mode 100644 index d0ba84c..0000000 --- a/lisp/version.el +++ /dev/null @@ -1,137 +0,0 @@ -;; version.el --- Record version number of Emacs. - -;; Copyright (C) 1985, 1991-1994, 1997 Free Software Foundation, Inc. - -;; Maintainer: XEmacs Development Team -;; Keywords: internal, dumped - -;; 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: - -;; This file is dumped with XEmacs. - -;;; Code: - -(defconst xemacs-betaname - (and emacs-beta-version (format "(beta%d)" emacs-beta-version)) - "Non-nil when this is a test (beta) version of XEmacs. -Warning, this variable did not exist in XEmacs versions prior to 20.3") - -(defconst emacs-version - (purecopy - (format "%d.%d %s%s%s" - emacs-major-version - emacs-minor-version - (if xemacs-codename - (concat "\"" xemacs-codename "\"") - "") - " XEmacs Lucid" - (if xemacs-betaname - (concat " " xemacs-betaname) - ""))) - "Version numbers of this version of XEmacs.") - -(if (featurep 'infodock) - (require 'id-vers)) - -;; Moved to C code as of XEmacs 20.3 -;(defconst emacs-major-version -; (progn (or (string-match "^[0-9]+" emacs-version) -; (error "emacs-version unparsable")) -; (string-to-int (match-string 0 emacs-version))) -; "Major version number of this version of Emacs, as an integer. -;Warning, this variable did not exist in Emacs versions earlier than: -; FSF Emacs: 19.23 -; XEmacs: 19.10") - -;; Moved to C code as of XEmacs 20.3 -;(defconst emacs-minor-version -; (progn (or (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version) -; (error "emacs-version unparsable")) -; (string-to-int (match-string 1 emacs-version))) -; "Minor version number of this version of Emacs, as an integer. -;Warning, this variable did not exist in Emacs versions earlier than: -; FSF Emacs: 19.23 -; XEmacs: 19.10") - -(defconst emacs-build-time (current-time-string) - "Time at which Emacs was dumped out.") - -(defconst emacs-build-system (system-name)) - -(defun emacs-version (&optional arg) - "Return string describing the version of Emacs that is running. -When called interactively with a prefix argument, insert string at point. -Don't use this function in programs to choose actions according -to the system configuration; look at `system-configuration' instead." - (interactive "p") - (save-match-data - (let ((version-string - (format - "XEmacs %s %s(%s%s) of %s %s on %s" - (substring emacs-version 0 (string-match " XEmacs" emacs-version)) - (if (not (featurep 'infodock)) - "[Lucid] " - "") - system-configuration - (cond ((or (and (fboundp 'featurep) - (featurep 'mule)) - (memq 'mule features)) ", Mule") - (t "")) - (substring emacs-build-time 0 - (string-match " *[0-9]*:" emacs-build-time)) - (substring emacs-build-time - (string-match "[0-9]*$" emacs-build-time)) - emacs-build-system))) - (cond - ((null arg) version-string) - ((eq arg 1) (message "%s" version-string)) - (t (insert version-string)))))) - -;; from emacs-vers.el -(defun emacs-version>= (major &optional minor) - "Return true if the Emacs version is >= to the given MAJOR and MINOR numbers. -The MAJOR version number argument is required, but the MINOR version number -argument is optional. If the minor version number is not specified (or is the -symbol `nil') then only the major version numbers are considered in the test." - (if (null minor) - (>= emacs-major-version major) - (or (> emacs-major-version major) - (and (= emacs-major-version major) - (>= emacs-minor-version minor))))) - -;;; We hope that this alias is easier for people to find. -(define-function 'version 'emacs-version) - -;; Put the emacs version number into the `pure[]' array in a form that -;; `what(1)' can extract from the executable or a core file. We don't -;; actually need this to be pointed to from lisp; pure objects can't -;; be GCed. -(or (memq system-type '(windows-nt ms-dos)) - (purecopy (concat "\n@" "(#)" (emacs-version) - "\n@" "(#)" "Configuration: " - system-configuration "\n"))) - -;;Local variables: -;;version-control: never -;;End: - -;;; version.el ends here diff --git a/lisp/very-early-lisp.el b/lisp/very-early-lisp.el deleted file mode 100644 index a6344c4..0000000 --- a/lisp/very-early-lisp.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; very-early-lisp.el --- Lisp support always needed by temacs - -;; Copyright (C) 1998 by Free Software Foundation, Inc. - -;; Author: SL Baur -;; Michael Sperber [Mr. Preprocessor] -;; Keywords: internal, dumped - -;; 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 must be loaded by temacs if temacs is to process bytecode -;; or dumped-lisp.el files. - -;;; Code: - -;;; Macros from Michael Sperber to replace read-time Lisp reader macros #-, #+ -;;; ####fixme duplicated in make-docfile.el and update-elc.el -(defmacro assemble-list (&rest components) - "Assemble a list from COMPONENTS. -This is a poor man's backquote: -COMPONENTS is a list, each element of which is macro-expanded. -Each macro-expanded element either has the form (SPLICE stuff), -in which case stuff must be a list which is spliced into the result. -Otherwise, the component becomes an element of the list." - (cons - 'append - (mapcar #'(lambda (component) - (let ((component (macroexpand-internal component))) - (if (and (consp component) - (eq 'splice (car component))) - (car (cdr component)) - (list 'list component)))) - components))) - -(defmacro when-feature (feature stuff) - "Insert STUFF as a list element if FEATURE is a loaded feature. -This is intended for use as a component of ASSEMBLE-LIST." - (list 'splice - (if (featurep feature) - (list 'list stuff) - '()))) - -(defmacro unless-feature (feature stuff) - "Insert STUFF as a list element if FEATURE is NOT a loaded feature. -This is intended for use as a component of ASSEMBLE-LIST." - (list 'splice - (if (featurep feature) - '() - (list 'list stuff)))) - -(provide 'very-early-lisp) - -;;; very-early-lisp.el ends here diff --git a/lisp/view-less.el b/lisp/view-less.el deleted file mode 100644 index 23296f9..0000000 --- a/lisp/view-less.el +++ /dev/null @@ -1,404 +0,0 @@ -;;; view-less.el --- Minor mode for browsing files with keybindings like `less' - -;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. - -;; Author: Jonathan Stigelman -;; Maintainer: XEmacs Development Team -;; 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 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 mode is for browsing files without changing them. Keybindings -;; similar to those used by the less(1) program are used. -;; -;; Originally written for v18 by David Gudeman (gudeman@arizona.edu) -;; Mods by Bengt Martensson, to closely resemble less (July 1987) -;; -;; If you would like all write-protected files to be visited in view-mode, -;; then add the following to your .emacs file: -;; -;; (add-hook 'find-file-hooks 'auto-view-mode) - -;;; Code: - -(defvar view-search-string "" - "Last string searched for with view-search functions.") - -(defvar view-search-arg 1 - "Argument to last view search.") - -(defvar view-default-lines 10 - "Default value for the \"d\" and \"u\" commands in view-mode") - -(defvar view-minor-mode nil - "Non-nil when view-mode is active. Call `view-mode' to toggle.") -(make-variable-buffer-local 'view-minor-mode) - -;;;###autoload -(defvar view-minor-mode-map - (let ((map (make-keymap))) - (set-keymap-name map 'view-minor-mode-map) - (suppress-keymap map) - (define-key map "-" 'negative-argument) - (define-key map " " 'scroll-up) - (define-key map "f" 'scroll-up) - (define-key map "b" 'scroll-down) - (define-key map 'backspace 'scroll-down) - (define-key map 'delete 'scroll-down) - (define-key map "\r" 'view-scroll-lines-up) - (define-key map "\n" 'view-scroll-lines-up) - (define-key map "e" 'view-scroll-lines-up) - (define-key map "j" 'view-scroll-lines-up) - (define-key map "y" 'view-scroll-lines-down) - (define-key map "k" 'view-scroll-lines-down) - (define-key map "d" 'view-scroll-some-lines-up) - (define-key map "u" 'view-scroll-some-lines-down) - (define-key map "r" 'recenter) - (define-key map "t" 'toggle-truncate-lines) - (define-key map "N" 'view-buffer) - (define-key map "E" 'view-file) - (define-key map "P" 'view-buffer) - (define-key map "!" 'shell-command) - (define-key map "|" 'shell-command-on-region) - (define-key map "=" 'what-line) - (define-key map "?" 'view-search-backward) - (define-key map "h" 'view-mode-describe) - (define-key map "s" 'view-repeat-search) - (define-key map "n" 'view-repeat-search) - (define-key map "/" 'view-search-forward) - (define-key map "\\" 'view-search-backward) - (define-key map "g" 'view-goto-line) - (define-key map "G" 'view-last-windowful) - (define-key map "%" 'view-goto-percent) - (define-key map "p" 'view-goto-percent) - (define-key map "m" 'point-to-register) - (define-key map "'" 'register-to-point) - (define-key map "C" 'view-cleanup-backspaces) - (define-key map "\C-c\C-c" 'view-quit) - ;; #### - should this use substitute-command-keys? - (define-key map "\C-x\C-q" 'view-quit-toggle-ro) - (define-key map "q" 'view-quit) - map - )) - -(add-minor-mode 'view-minor-mode " View" view-minor-mode-map) - -;;;###autoload -(defvar view-mode-map - (let ((map (copy-keymap view-minor-mode-map))) - (set-keymap-name map 'view-mode-map) - map)) - -;;;###autoload -(defun view-file (file &optional other-p) - "Find FILE, enter view mode. With prefix arg OTHER-P, use other window." - (interactive "fView File: \nP") - (let ((old-p (get-file-buffer file)) - (obuf (current-buffer))) - (if other-p - (find-file-other-window file) - (find-file file)) - (view-mode (if other-p nil obuf) - (if old-p nil 'kill-buffer)) - nil)) - -;;;###autoload -(defun view-buffer (buf &optional other-p) - "Switch to BUF, enter view mode. With prefix arg use other window." - (interactive "bView Buffer: \nP") - (let ((obuf (current-buffer))) - (if other-p - (switch-to-buffer-other-window buf) - (switch-to-buffer buf)) - (view-mode (if other-p nil obuf) (if other-p nil 'bury-buffer)))) - -;;;###autoload -(defun view-file-other-window (file) - "Find FILE in other window, and enter view mode." - (interactive "fView File: ") - (view-file file t)) - -;;;###autoload -(defun view-buffer-other-window (buffer) - "Switch to BUFFER in another window, and enter view mode." - (interactive "bView Buffer: ") - (view-buffer buffer t)) - -(defun view-brief-help () - (message - (substitute-command-keys - "\\\\[scroll-up] = page forward; \\[scroll-down] = page back; \ -\\[view-mode-describe] = help; \\[view-quit] = quit."))) - -(defvar view-major-mode) -(defvar view-exit-position) -(defvar view-prev-buffer) -(defvar view-exit-action) -(defvar view-old-buffer-read-only) - -;;;###autoload -(defun view-minor-mode (&optional prev-buffer exit-action) - "Minor mode for viewing text, with bindings like `less'. -Commands are: -\\ -0..9 prefix args -- prefix minus -\\[scroll-up] page forward -\\[scroll-down] page back -\\[view-scroll-lines-up] scroll prefix-arg lines forward, default 1. -\\[view-scroll-lines-down] scroll prefix-arg lines backward, default 1. -\\[view-scroll-some-lines-down] scroll prefix-arg lines backward, default 10. -\\[view-scroll-some-lines-up] scroll prefix-arg lines forward, default 10. -\\[what-line] print line number -\\[view-mode-describe] print this help message -\\[view-search-forward] regexp search, uses previous string if you just hit RET -\\[view-search-backward] as above but searches backward -\\[view-repeat-search] repeat last search -\\[view-goto-line] goto line prefix-arg, default 1 -\\[view-last-windowful] goto line prefix-arg, default last line -\\[view-goto-percent] goto a position by percentage -\\[toggle-truncate-lines] toggle truncate-lines -\\[view-file] view another file -\\[view-buffer] view another buffer -\\[view-cleanup-backspaces] cleanup backspace constructions -\\[shell-command] execute a shell command -\\[shell-command-on-region]\ - execute a shell command with the region as input -\\[view-quit] exit view-mode, and bury the current buffer. - -If invoked with the optional (prefix) arg non-nil, view-mode cleans up -backspace constructions. - -More precisely: -\\{view-minor-mode-map}" - (interactive) - - (make-local-variable 'view-default-lines) - (set (make-local-variable 'view-exit-position) (point)) - (set (make-local-variable 'view-prev-buffer) prev-buffer) - (set (make-local-variable 'view-exit-action) exit-action) - (set (make-local-variable 'view-old-buffer-read-only) buffer-read-only) - (add-hook (make-local-variable 'change-major-mode-hook) - 'view-fixup-read-only) - (setq view-minor-mode t - buffer-read-only t) - (view-brief-help)) - -;;;###autoload -(defun view-mode (&optional prev-buffer exit-action clean-bs) - "View the current buffer using view-minor-mode. This exists to be 99.9% -compatible with the implementations of `view-mode' in view.el and older -versions of view-less.el." - (interactive (list nil 'bury-buffer current-prefix-arg)) - ;; #### - The first two arguments provide compatibility with view.el (and - ;; thus FSFmacs), while the third argument as a prefix argument maintains - ;; interactive compatibility with older versions of view-less. --Stig - (if clean-bs (cleanup-backspaces)) - (view-minor-mode prev-buffer exit-action)) - -;;;###autoload -(defun view-major-mode (&optional prev-buffer exit-action clean-bs) - "View the current buffer using view-mode, as a major mode. -This function has a nonstandard name because `view-mode' is wrongly -named but is like this for compatibility reasons." - ;; #### - The first two arguments provide compatibility with view.el (and - ;; thus FSFmacs), while the third argument as a prefix argument maintains - ;; interactive compatibility with older versions of view-less. --Stig - (interactive (list nil 'bury-buffer current-prefix-arg)) - (kill-all-local-variables) - (use-local-map view-mode-map) - (setq major-mode 'view-mode) - (set (make-local-variable 'view-exit-position) (point)) - (set (make-local-variable 'view-prev-buffer) prev-buffer) - (set (make-local-variable 'view-exit-action) exit-action) - (set (make-local-variable 'view-old-buffer-read-only) buffer-read-only) - (set (make-local-variable 'view-major-mode) t) - (setq buffer-read-only t) - (if clean-bs (cleanup-backspaces)) - (run-hooks 'view-mode-hook)) - -;;;###autoload -(defun auto-view-mode () - "If the file of the current buffer is not writable, call view-mode. -This is meant to be added to `find-file-hooks'." - (or (file-writable-p buffer-file-name) - (view-minor-mode))) - -(defun view-fixup-read-only () - ;; doing M-x normal mode should NOT leave the buffer read-only - (and (boundp 'view-old-buffer-read-only) - (progn (setq buffer-read-only view-old-buffer-read-only) - (kill-local-variable 'view-old-buffer-read-only)))) - -(defun view-quit-toggle-ro () - "Exit view mode and execute the global binding of the key that invoked this -command. Normally, this will toggle the state of `buffer-read-only', perhaps -invoking some version-control mechanism." - (interactive) - (setq view-exit-position nil) - ;; Kludge so this works as advertised. Stig, why can't you write - ;; bug-free code??? - (let ((buffer-read-only buffer-read-only)) - (view-quit t)) - ;; no longer in view-minor-mode, so the keymap has changed... - (call-interactively (key-binding (this-command-keys)))) - -(defun view-quit (&optional no-exit-action) - "Exit view mode. With prefix argument, keep the current buffer selected." - (interactive "P") - (view-fixup-read-only) - (setq view-minor-mode nil) - (if view-exit-position (goto-char view-exit-position)) - (if (and (boundp 'view-major-mode) view-major-mode) - (fundamental-mode) - (let ((pbuf view-prev-buffer) - (exitact view-exit-action)) - (if no-exit-action - nil - (if exitact (funcall exitact (current-buffer))) - (if pbuf (switch-to-buffer pbuf)))))) - -;; #### - similar to what's in man.el and this ought to be written in C anyway... --Stig -(defun cleanup-backspaces () - "Cleanup backspace constructions. -_^H and ^H_ sequences are deleted. x^Hx sequences are turned into x for all -characters x. ^^H| and |^H^ sequences are turned into ^. +^Ho and o^H+ are -turned into (+)." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (= (following-char) ?\C-h) - (delete-char 1)) - (while (search-forward "\C-h" nil t) - (forward-char -2) - (cond ((looking-at "_\C-h\\|\\(.\\)\C-h\\1\\||\C-h\\^") - (delete-char 2)) - ((looking-at ".\C-h_\\|\\^\C-h|") - (forward-char 1) - (delete-char 2)) - ((looking-at "+\C-ho\\|o\C-h+") - (delete-char 3) - (insert "(+)")) - ((looking-at "|\C-h-") - (delete-char 3) - (insert "*")) - (t (forward-char 2)))))) - -(defun view-cleanup-backspaces () - "Cleanup backspaces and if buffer is currently unmodified, don't flag it -as a modified buffer. This works even if the buffer is read-only." - (interactive) - (let ((buffer-read-only) - (buf-mod (buffer-modified-p))) - (cleanup-backspaces) - ;; #### - THIS IS PROBABLY A REALLY DANGEROUS THING TO DO IN A MINOR MODE!! - (set-buffer-modified-p buf-mod))) - -(defun toggle-truncate-lines (&optional p) - "Toggles the values of truncate-lines. -Positive prefix arg sets, negative disables." - (interactive "P") - (setq truncate-lines (if p - (> (prefix-numeric-value p) 0) - (not truncate-lines))) - (recenter)) - -(defun view-scroll-lines-up (p) - "Scroll up prefix-arg lines, default 1." - (interactive "p") - (scroll-up p)) - -(defun view-scroll-lines-down (p) - "Scroll down prefix-arg lines, default 1." - (interactive "p") - (scroll-up (- p))) - -(defun view-scroll-some-lines-down (&optional n) - "Scroll down prefix-arg lines, default 10, or last argument." - (interactive "p") - (if (> n 1) (setq view-default-lines n)) - (scroll-down view-default-lines)) - -(defun view-scroll-some-lines-up (&optional n) - "Scroll up prefix-arg lines, default 10, or last argument." - (interactive "p") - (if (> n 1) (setq view-default-lines n)) - (scroll-up view-default-lines)) - -(defun view-goto-line (&optional n) - "Goto prefix arg line N. N = 1 by default.." - (interactive "p") - (goto-line n)) - -(defun view-last-windowful (&optional n) - "Goto prefix arg line N or the first line of the last windowful in buffer." - (interactive "p") - (if current-prefix-arg - (goto-line n) - (end-of-buffer) - (recenter -1) - (move-to-window-line 0))) - -(defun view-goto-percent (&optional percent) - "Set mark and go to a position PERCENT way into the current buffer." - (interactive "p") - (set-mark-command nil) - (goto-char (+ (point-min) (/ (* percent (- (point-max) (point-min))) 100))) - (beginning-of-line)) - -(defun view-mode-describe () - (interactive) - (let ((mode-name "View") - (major-mode 'view-mode)) - (describe-mode))) - -(defun view-search-forward (s p) - "Search forward for REGEXP. If regexp is empty, use last search string. -With prefix ARG, search forward that many occurrences." - (interactive "sView search: \np") - (unwind-protect - (re-search-forward - (if (string-equal "" s) view-search-string s) nil nil p) - (setq view-search-arg p) - (or (string-equal "" s) - (setq view-search-string s)))) - -(defun view-search-backward (s p) - "Search backward for REGEXP. If regexp is empty, use last search string. -With prefix ARG, search forward that many occurrences." - (interactive "sView search backward: \np") - (view-search-forward s (- p))) - -(defun view-repeat-search (p) - "Repeat last view search command. If a prefix arg is given, use that -instead of the previous arg, if the prefix is just a -, then take the -negative of the last prefix arg." - (interactive "P") - (view-search-forward - view-search-string - (cond ((null p) view-search-arg) - ((eq p '-) (- view-search-arg)) - (t (prefix-numeric-value p))))) - -(provide 'view) -(provide 'view-less) - -;;; view-less.el ends here diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el deleted file mode 100644 index d0cd014..0000000 --- a/lisp/wid-edit.el +++ /dev/null @@ -1,3716 +0,0 @@ -;;; wid-edit.el --- Functions for creating and using widgets. -;; -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. -;; -;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic -;; Keywords: extensions -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -;; 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: -;; -;; See `widget.el'. - - -;;; Code: - -(require 'widget) - -(autoload 'finder-commentary "finder" nil t) - -;;; Customization. - -(defgroup widgets nil - "Customization support for the Widget Library." - :link '(custom-manual "(widget)Top") - :link '(url-link :tag "Development Page" - "http://www.dina.kvl.dk/~abraham/custom/") - :link '(emacs-library-link :tag "Lisp File" "widget.el") - :prefix "widget-" - :group 'extensions - :group 'hypermedia) - -(defgroup widget-documentation nil - "Options controling the display of documentation strings." - :group 'widgets) - -(defgroup widget-faces nil - "Faces used by the widget library." - :group 'widgets - :group 'faces) - -(defvar widget-documentation-face 'widget-documentation-face - "Face used for documentation strings in widges. -This exists as a variable so it can be set locally in certain buffers.") - -(defface widget-documentation-face '((((class color) - (background dark)) - (:foreground "lime green")) - (((class color) - (background light)) - (:foreground "dark green")) - (t nil)) - "Face used for documentation text." - :group 'widget-documentation - :group 'widget-faces) - -(defvar widget-button-face 'widget-button-face - "Face used for buttons in widges. -This exists as a variable so it can be set locally in certain buffers.") - -(defface widget-button-face '((t (:bold t))) - "Face used for widget buttons." - :group 'widget-faces) - -(defcustom widget-mouse-face 'highlight - "Face used for widget buttons when the mouse is above them." - :type 'face - :group 'widget-faces) - -(defface widget-field-face '((((class grayscale color) - (background light)) - (:background "gray85")) - (((class grayscale color) - (background dark)) - (:background "dim gray")) - (t - (:italic t))) - "Face used for editable fields." - :group 'widget-faces) - -;; Currently unused -;(defface widget-single-line-field-face '((((class grayscale color) -; (background light)) -; (:background "gray85")) -; (((class grayscale color) -; (background dark)) -; (:background "dim gray")) -; (t -; (:italic t))) -; "Face used for editable fields spanning only a single line." -; :group 'widget-faces) -; -;(defvar widget-single-line-display-table -; (let ((table (make-display-table))) -; (aset table 9 "^I") -; (aset table 10 "^J") -; table) -; "Display table used for single-line editable fields.") -; -;(set-face-display-table 'widget-single-line-field-face -; widget-single-line-display-table) - - -;; Some functions from this file have been ported to C for speed. -;; Setting this to t (*before* loading wid-edit.el) will make them -;; shadow the subrs. It should be used only for debugging purposes. -(defvar widget-shadow-subrs nil) - - -;;; Utility functions. -;; -;; These are not really widget specific. - -(when (or (not (fboundp 'widget-plist-member)) - widget-shadow-subrs) - ;; Recoded in C, for efficiency. It used to be a defsubst, but old - ;; compiled code won't fail -- it will just be slower. - (defun widget-plist-member (plist prop) - ;; Return non-nil if PLIST has the property PROP. - ;; PLIST is a property list, which is a list of the form - ;; (PROP1 VALUE1 PROP2 VALUE2 ...). PROP is a symbol. - ;; Unlike `plist-get', this allows you to distinguish between a missing - ;; property and a property with the value nil. - ;; The value is actually the tail of PLIST whose car is PROP. - (while (and plist (not (eq (car plist) prop))) - (setq plist (cddr plist))) - plist)) - -(defun widget-princ-to-string (object) - ;; Return string representation of OBJECT, any Lisp object. - ;; No quoting characters are used; no delimiters are printed around - ;; the contents of strings. - (with-current-buffer (get-buffer-create " *widget-tmp*") - (erase-buffer) - (princ object (current-buffer)) - (buffer-string))) - -(defun widget-prettyprint-to-string (object) - ;; Like pp-to-string, but uses `cl-prettyprint' - (with-current-buffer (get-buffer-create " *widget-tmp*") - (erase-buffer) - (cl-prettyprint object) - ;; `cl-prettyprint' always surrounds the text with newlines. - (when (eq (char-after (point-min)) ?\n) - (delete-region (point-min) (1+ (point-min)))) - (when (eq (char-before (point-max)) ?\n) - (delete-region (1- (point-max)) (point-max))) - (buffer-string))) - -(defun widget-clear-undo () - "Clear all undo information." - (buffer-disable-undo) - (buffer-enable-undo)) - -(defcustom widget-menu-max-size 40 - "Largest number of items allowed in a popup-menu. -Larger menus are read through the minibuffer." - :group 'widgets - :type 'integer) - -(defcustom widget-menu-minibuffer-flag nil - "*Control how to ask for a choice from the keyboard. -Non-nil means use the minibuffer; -nil means read a single character." - :group 'widgets - :type 'boolean) - -(defun widget-choose (title items &optional event) - "Choose an item from a list. - -First argument TITLE is the name of the list. -Second argument ITEMS is an list whose members are either - (NAME . VALUE), to indicate selectable items, or just strings to - indicate unselectable items. -Optional third argument EVENT is an input event. - -The user is asked to choose between each NAME from the items alist, -and the VALUE of the chosen element will be returned. If EVENT is a -mouse event, and the number of elements in items is less than -`widget-menu-max-size', a popup menu will be used, otherwise the -minibuffer." - (cond ((and (< (length items) widget-menu-max-size) - event - (console-on-window-system-p)) - ;; Pressed by the mouse. - (let ((val (get-popup-menu-response - (cons title - (mapcar (lambda (x) - (if (stringp x) - (vector x nil nil) - (vector (car x) (list (car x)) t))) - items))))) - (setq val (and val - (listp (event-object val)) - (stringp (car-safe (event-object val))) - (car (event-object val)))) - (cdr (assoc val items)))) - ((and (not widget-menu-minibuffer-flag) - ;; Can't handle more than 10 items (as many digits) - (<= (length items) 10)) - ;; Construct a menu of the choices - ;; and then use it for prompting for a single character. - (let* ((overriding-terminal-local-map (make-sparse-keymap)) - (map (make-sparse-keymap title)) - (next-digit ?0) - some-choice-enabled value) - ;; Define SPC as a prefix char to get to this menu. - (define-key overriding-terminal-local-map " " map) - (with-current-buffer (get-buffer-create " widget-choose") - (erase-buffer) - (insert "Available choices:\n\n") - (dolist (choice items) - (when (consp choice) - (let* ((name (car choice)) - (function (cdr choice))) - (insert (format "%c = %s\n" next-digit name)) - (define-key map (vector next-digit) function) - (setq some-choice-enabled t))) - ;; Allocate digits to disabled alternatives - ;; so that the digit of a given alternative never varies. - (incf next-digit)) - (insert "\nC-g = Quit")) - (or some-choice-enabled - (error "None of the choices is currently meaningful")) - (define-key map [?\C-g] 'keyboard-quit) - (define-key map [t] 'keyboard-quit) - ;(setcdr map (nreverse (cdr map))) - ;; Unread a SPC to lead to our new menu. - (push (character-to-event ?\ ) unread-command-events) - ;; Read a char with the menu, and return the result - ;; that corresponds to it. - (save-window-excursion - (display-buffer (get-buffer " widget-choose")) - (let ((cursor-in-echo-area t)) - (setq value - (lookup-key overriding-terminal-local-map - (read-key-sequence (concat title ": ") t))))) - (message "") - (when (or (eq value 'keyboard-quit) - (null value)) - (error "Canceled")) - value)) - (t - ;; Read the choice of name from the minibuffer. - (setq items (remove-if 'stringp items)) - (let ((val (completing-read (concat title ": ") items nil t))) - (if (stringp val) - (let ((try (try-completion val items))) - (when (stringp try) - (setq val try)) - (cdr (assoc val items))) - nil))))) - - -;;; Widget text specifications. -;; -;; These functions are for specifying text properties. - -(defcustom widget-field-add-space t - ;; Setting this to nil might be available, once some problems are resolved. - "Non-nil means add extra space at the end of editable text fields. - -This is needed on all versions of Emacs. If you don't add the space, -it will become impossible to edit a zero size field." - :type 'boolean - :group 'widgets) - -(defcustom widget-field-use-before-change - (and (or (> emacs-minor-version 34) - (> emacs-major-version 19)) - (not (string-match "XEmacs" emacs-version))) - "Non-nil means use `before-change-functions' to track editable fields. -This enables the use of undo, but doesn't work on Emacs 19.34 and earlier. -Using before hooks also means that the :notify function can't know the -new value." - :type 'boolean - :group 'widgets) - -(defun widget-echo-this-extent (extent) - (let* ((widget (or (extent-property extent 'button) - (extent-property extent 'field) - (extent-property extent 'glyph-widget))) - (help-echo (and widget (widget-get widget :help-echo)))) - (and (functionp help-echo) - (setq help-echo (funcall help-echo widget))) - (when (stringp help-echo) - (setq help-echo-owns-message t) - (display-message 'help-echo help-echo)))) - -(defsubst widget-handle-help-echo (extent help-echo) - (set-extent-property extent 'balloon-help help-echo) - (set-extent-property extent 'help-echo help-echo) - (when (functionp help-echo) - (set-extent-property extent 'balloon-help 'widget-echo-this-extent) - (set-extent-property extent 'help-echo 'widget-echo-this-extent))) - -(defun widget-specify-field (widget from to) - "Specify editable button for WIDGET between FROM and TO." - (save-excursion - (goto-char to) - (cond ((null (widget-get widget :size)) - (forward-char 1)) - ;; Terminating space is not part of the field, but necessary in - ;; order for local-map to work. Remove next sexp if local-map works - ;; at the end of the extent. - (widget-field-add-space - (insert-and-inherit " "))) - (setq to (point))) - (let ((map (widget-get widget :keymap)) - (face (or (widget-get widget :value-face) 'widget-field-face)) - (help-echo (widget-get widget :help-echo)) - (extent (make-extent from to))) - (unless (or (stringp help-echo) (null help-echo)) - (setq help-echo 'widget-mouse-help)) - (widget-put widget :field-extent extent) - (and (or (not widget-field-add-space) - (widget-get widget :size)) - (set-extent-property extent 'end-closed nil)) - (set-extent-property extent 'detachable nil) - (set-extent-property extent 'field widget) - (set-extent-property extent 'button-or-field t) - (set-extent-property extent 'keymap map) - (set-extent-property extent 'face face) - (widget-handle-help-echo extent help-echo)) - (widget-specify-secret widget)) - -(defun widget-specify-secret (field) - "Replace text in FIELD with value of `:secret', if non-nil." - (let ((secret (widget-get field :secret)) - (size (widget-get field :size))) - (when secret - (let ((begin (widget-field-start field)) - (end (widget-field-end field))) - (when size - (while (and (> end begin) - (eq (char-after (1- end)) ?\ )) - (setq end (1- end)))) - (while (< begin end) - (let ((old (char-after begin))) - (unless (eq old secret) - (subst-char-in-region begin (1+ begin) old secret) - (put-text-property begin (1+ begin) 'secret old)) - (setq begin (1+ begin)))))))) - -(defun widget-specify-button (widget from to) - "Specify button for WIDGET between FROM and TO." - (let ((face (widget-apply widget :button-face-get)) - (help-echo (widget-get widget :help-echo)) - (extent (make-extent from to)) - (map (widget-get widget :button-keymap))) - (widget-put widget :button-extent extent) - (unless (or (null help-echo) (stringp help-echo)) - (setq help-echo 'widget-mouse-help)) - (set-extent-property extent 'start-open t) - (set-extent-property extent 'button widget) - (set-extent-property extent 'button-or-field t) - (set-extent-property extent 'mouse-face widget-mouse-face) - (widget-handle-help-echo extent help-echo) - (set-extent-property extent 'face face) - (set-extent-property extent 'keymap map))) - -(defun widget-mouse-help (extent) - "Find mouse help string for button in extent." - (let* ((widget (widget-at (extent-start-position extent))) - (help-echo (and widget (widget-get widget :help-echo)))) - (cond ((stringp help-echo) - help-echo) - ((and (functionp help-echo) - (stringp (setq help-echo (funcall help-echo widget)))) - help-echo) - (t - (format "(widget %S :help-echo %S)" widget help-echo))))) - -(defun widget-specify-sample (widget from to) - ;; Specify sample for WIDGET between FROM and TO. - (let ((face (widget-apply widget :sample-face-get)) - (extent (make-extent from to nil))) - (set-extent-property extent 'start-open t) - (set-extent-property extent 'face face) - (widget-put widget :sample-extent extent))) - -(defun widget-specify-doc (widget from to) - ;; Specify documentation for WIDGET between FROM and TO. - (let ((extent (make-extent from to))) - (set-extent-property extent 'start-open t) - (set-extent-property extent 'widget-doc widget) - (set-extent-property extent 'face widget-documentation-face) - (widget-put widget :doc-extent extent))) - -(defmacro widget-specify-insert (&rest form) - ;; Execute FORM without inheriting any text properties. - `(save-restriction - (let ((inhibit-read-only t) - before-change-functions - after-change-functions) - (insert "<>") - (narrow-to-region (- (point) 2) (point)) - (goto-char (1+ (point-min))) - ;; We use `prog1' instead of a `result' variable, as the latter - ;; confuses the byte-compiler in some cases (a warning). - (prog1 (progn ,@form) - (delete-region (point-min) (1+ (point-min))) - (delete-region (1- (point-max)) (point-max)) - (goto-char (point-max)))))) - -(put 'widget-specify-insert 'edebug-form-spec '(&rest form)) - - -;;; Inactive Widgets. - -(defface widget-inactive-face '((((class grayscale color) - (background dark)) - (:foreground "light gray")) - (((class grayscale color) - (background light)) - (:foreground "dim gray")) - (t - (:italic t))) - "Face used for inactive widgets." - :group 'widget-faces) - -;; For inactiveness to work on complex structures, it is not -;; sufficient to keep track of whether a button/field/glyph is -;; inactive or not -- we must know how many time it was deactivated -;; (inactiveness level). Successive deactivations of the same button -;; increment its inactive-count, and activations decrement it. When -;; inactive-count reaches 0, the button/field/glyph is reactivated. - -(defun widget-activation-widget-mapper (extent action) - "Activate or deactivate EXTENT's widget (button or field). -Suitable for use with `map-extents'." - (ecase action - (:activate - (decf (extent-property extent :inactive-count)) - (when (zerop (extent-property extent :inactive-count)) - (set-extent-properties - extent (extent-property extent :inactive-plist)) - (set-extent-property extent :inactive-plist nil))) - (:deactivate - (incf (extent-property extent :inactive-count 0)) - ;; Store a plist of old properties, which will be fed to - ;; `set-extent-properties'. - (unless (extent-property extent :inactive-plist) - (set-extent-property - extent :inactive-plist - (list 'mouse-face (extent-property extent 'mouse-face) - 'help-echo (extent-property extent 'help-echo) - 'keymap (extent-property extent 'keymap))) - (set-extent-properties - extent '(mouse-face nil help-echo nil keymap nil))))) - nil) - -(defun widget-activation-glyph-mapper (extent action) - (let ((activate-p (if (eq action :activate) t nil))) - (if activate-p - (decf (extent-property extent :inactive-count)) - (incf (extent-property extent :inactive-count 0))) - (when (or (and activate-p - (zerop (extent-property extent :inactive-count))) - (and (not activate-p) - (not (zerop (extent-property extent :inactive-count))))) - (let* ((glyph-widget (extent-property extent 'glyph-widget)) - (up-glyph (widget-get glyph-widget :glyph-up)) - (inactive-glyph (widget-get glyph-widget :glyph-inactive)) - (new-glyph (if activate-p up-glyph inactive-glyph))) - ;; Check that the new glyph exists, and differs from the - ;; default one. - (and up-glyph inactive-glyph (not (eq up-glyph inactive-glyph)) - ;; Check if the glyph is already installed. - (not (eq (extent-end-glyph extent) new-glyph)) - ;; Change it. - (set-extent-end-glyph extent new-glyph))))) - nil) - -(defun widget-specify-inactive (widget from to) - "Make WIDGET inactive for user modifications." - (unless (widget-get widget :inactive) - (let ((extent (make-extent from to))) - ;; It is no longer necessary for the extent to be read-only, as - ;; the inactive editable fields now lose their keymaps. - (set-extent-properties - extent '(start-open t face widget-inactive-face - detachable t priority 2001 widget-inactive t)) - (widget-put widget :inactive extent)) - ;; Deactivate the buttons and fields within the range. In some - ;; cases, the fields are not yet setup at the time this function - ;; is called. Those fields are deactivated explicitly by - ;; `widget-setup'. - (map-extents 'widget-activation-widget-mapper - nil from to :deactivate nil 'button-or-field) - ;; Deactivate glyphs. - (map-extents 'widget-activation-glyph-mapper - nil from to :deactivate nil 'glyph-widget))) - -(defun widget-specify-active (widget) - "Make WIDGET active for user modifications." - (let ((inactive (widget-get widget :inactive))) - (when (and inactive (not (extent-detached-p inactive))) - ;; Reactivate the buttons and fields covered by the extent. - (map-extents 'widget-activation-widget-mapper - inactive nil nil :activate nil 'button-or-field) - ;; Reactivate the glyphs. - (map-extents 'widget-activation-glyph-mapper - inactive nil nil :activate nil 'end-glyph) - (delete-extent inactive) - (widget-put widget :inactive nil)))) - - -;;; Widget Properties. - -(defsubst widget-type (widget) - "Return the type of WIDGET, a symbol." - (car widget)) - -(when (or (not (fboundp 'widget-put)) - widget-shadow-subrs) - (defun widget-put (widget property value) - "In WIDGET set PROPERTY to VALUE. -The value can later be retrieved with `widget-get'." - (setcdr widget (plist-put (cdr widget) property value)))) - -;; Recoded in C, for efficiency: -(when (or (not (fboundp 'widget-get)) - widget-shadow-subrs) - (defun widget-get (widget property) - "In WIDGET, get the value of PROPERTY. -The value could either be specified when the widget was created, or -later with `widget-put'." - (let ((missing t) - value tmp) - (while missing - (cond ((setq tmp (widget-plist-member (cdr widget) property)) - (setq value (car (cdr tmp)) - missing nil)) - ((setq tmp (car widget)) - (setq widget (get tmp 'widget-type))) - (t - (setq missing nil)))) - value))) - -(defun widget-get-indirect (widget property) - "In WIDGET, get the value of PROPERTY. -If the value is a symbol, return its binding. -Otherwise, just return the value." - (let ((value (widget-get widget property))) - (if (symbolp value) - (symbol-value value) - value))) - -(defun widget-member (widget property) - "Non-nil iff there is a definition in WIDGET for PROPERTY." - (cond ((widget-plist-member (cdr widget) property) - t) - ((car widget) - (widget-member (get (car widget) 'widget-type) property)) - (t nil))) - -(when (or (not (fboundp 'widget-apply)) - widget-shadow-subrs) - ;;This is in C, so don't ###utoload - (defun widget-apply (widget property &rest args) - "Apply the value of WIDGET's PROPERTY to the widget itself. -ARGS are passed as extra arguments to the function." - (apply (widget-get widget property) widget args))) - -(defun widget-value (widget) - "Extract the current value of WIDGET." - (widget-apply widget - :value-to-external (widget-apply widget :value-get))) - -(defun widget-value-set (widget value) - "Set the current value of WIDGET to VALUE." - (widget-apply widget - :value-set (widget-apply widget - :value-to-internal value))) - -(defun widget-default-get (widget) - "Extract the defaylt value of WIDGET." - (or (widget-get widget :value) - (widget-apply widget :default-get))) - -(defun widget-match-inline (widget vals) - ;; In WIDGET, match the start of VALS. - (cond ((widget-get widget :inline) - (widget-apply widget :match-inline vals)) - ((and vals - (widget-apply widget :match (car vals))) - (cons (list (car vals)) (cdr vals))) - (t nil))) - -(defun widget-apply-action (widget &optional event) - "Apply :action in WIDGET in response to EVENT." - (if (widget-apply widget :active) - (widget-apply widget :action event) - (error "Attempt to perform action on inactive widget"))) - - -;;; Helper functions. -;; -;; These are widget specific. - -;;;###autoload -(defun widget-prompt-value (widget prompt &optional value unbound) - "Prompt for a value matching WIDGET, using PROMPT. -The current value is assumed to be VALUE, unless UNBOUND is non-nil." - (unless (listp widget) - (setq widget (list widget))) - (setq prompt (format "[%s] %s" (widget-type widget) prompt)) - (setq widget (widget-convert widget)) - (let ((answer (widget-apply widget :prompt-value prompt value unbound))) - (while (not (widget-apply widget :match answer)) - (setq answer (signal 'error (list "Answer does not match type" - answer (widget-type widget))))) - answer)) - -(defun widget-get-sibling (widget) - "Get the item WIDGET is assumed to toggle. -This is only meaningful for radio buttons or checkboxes in a list." - (let* ((parent (widget-get widget :parent)) - (children (widget-get parent :children)) - child) - (catch 'child - (while children - (setq child (car children) - children (cdr children)) - (when (eq (widget-get child :button) widget) - (throw 'child child))) - nil))) - -(defun widget-map-buttons (function &optional buffer maparg) - "Map FUNCTION over the buttons in BUFFER. -FUNCTION is called with the arguments WIDGET and MAPARG. - -If FUNCTION returns non-nil, the walk is cancelled. - -The arguments MAPARG, and BUFFER default to nil and (current-buffer), -respectively." - (map-extents (lambda (extent ignore) - ;; If FUNCTION returns non-nil, we bail out - (funcall function (extent-property extent 'button) maparg)) - nil nil nil nil nil - 'button)) - - -;;; Glyphs. - -(defcustom widget-glyph-directory (locate-data-directory "custom") - "Where widget glyphs are located. -If this variable is nil, widget will try to locate the directory -automatically." - :group 'widgets - :type 'directory) - -(defcustom widget-glyph-enable t - "If non nil, use glyphs in images when available." - :group 'widgets - :type 'boolean) - -(defcustom widget-image-conversion - '((xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg") - (xbm ".xbm")) - "Conversion alist from image formats to file name suffixes." - :group 'widgets - :type '(repeat (cons :format "%v" - (symbol :tag "Image Format" unknown) - (repeat :tag "Suffixes" - (string :format "%v"))))) - -;; Don't use this, because we cannot yet distinguish between widget -;; glyphs associated with user action, and actionless ones. -;(defvar widget-glyph-pointer-glyph -; (make-pointer-glyph [cursor-font :data "hand2"]) -; "Glyph to be used as the mouse pointer shape over glyphs. -;Use `set-glyph-image' to change this.") - -(defvar widget-glyph-cache nil - "Cache of glyphs associated with strings (files).") - -(defun widget-glyph-find (image tag) - "Create a glyph corresponding to IMAGE with string TAG as fallback. -IMAGE can already be a glyph, or a file name sans extension (xpm, - xbm, gif, jpg, or png) located in `widget-glyph-directory', or - in one of the data directories. -It can also be a valid image instantiator, in which case it will be - used to make the glyph, with an additional TAG string fallback." - (cond ((not (and image widget-glyph-enable)) - ;; We don't want to use glyphs. - nil) - ((and (not (console-on-window-system-p)) - ;; We don't use glyphs on TTY consoles, although we - ;; could. However, glyph faces aren't yet working - ;; properly, and movement through glyphs is unintuitive. - ;; As an exception, when TAG is nil, we assume that the - ;; caller knows what he is doing, and that the tag is - ;; encoded within the glyph. - (not (glyphp image))) - nil) - ((glyphp image) - ;; Already a glyph. Use it. - image) - ((stringp image) - ;; A string. Look it up in the cache first... - (or (lax-plist-get widget-glyph-cache image) - ;; ...and then in the relevant directories - (let* ((dirlist (cons (or widget-glyph-directory - (locate-data-directory "custom")) - data-directory-list)) - (formats widget-image-conversion) - file) - (while (and formats (not file)) - ;; This dance is necessary, because XEmacs signals an - ;; error when it encounters an unrecognized image - ;; format. - (when (valid-image-instantiator-format-p (caar formats)) - (setq file (locate-file image dirlist - (mapconcat #'identity (cdar formats) - ":")))) - (unless file - (pop formats))) - (when file - ;; We create a glyph with the file as the default image - ;; instantiator, and the TAG fallback - (let ((glyph (make-glyph `([,(caar formats) :file ,file] - [string :data ,tag])))) - ;; Cache the glyph - (laxputf widget-glyph-cache image glyph) - ;; ...and return it - glyph))))) - ((valid-instantiator-p image 'image) - ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.) - (make-glyph `(,image [string :data ,tag]))) - (t - ;; Oh well. - nil))) - -(defun widget-glyph-insert (widget tag image &optional down inactive) - "In WIDGET, insert the text TAG or, if supported, IMAGE. -IMAGE should either be a glyph, an image instantiator, an image file -name sans extension (xpm, xbm, gif, jpg, or png) located in -`widget-glyph-directory', or anything else allowed by -`widget-glyph-find'. - -If IMAGE is a list, it will be taken as a list of (UP DOWN INACTIVE) -glyphs. The down and inactive glyphs are shown when glyph is pressed -or inactive, respectively. - -The optional DOWN and INACTIVE arguments are deprecated, and exist -only because of compatibility." - ;; Convert between IMAGE being a list, etc. Must use `psetq', - ;; because otherwise change to `image' screws up the rest. - (psetq image (or (and (consp image) - (car image)) - image) - down (or (and (consp image) - (nth 1 image)) - down) - inactive (or (and (consp image) - (nth 2 image)) - inactive)) - (let ((glyph (widget-glyph-find image tag))) - (if glyph - (widget-glyph-insert-glyph widget glyph - (widget-glyph-find down tag) - (widget-glyph-find inactive tag)) - (insert tag)) - glyph)) - -(defun widget-glyph-insert-glyph (widget glyph &optional down inactive) - "In WIDGET, insert GLYPH. -If optional arguments DOWN and INACTIVE are given, they should be -glyphs used when the widget is pushed and inactive, respectively." - (insert "*") - (let ((extent (make-extent (point) (1- (point)))) - (help-echo (and widget (widget-get widget :help-echo))) - (map (and widget (widget-get widget :button-keymap)))) - (set-extent-property extent 'glyph-widget widget) - ;; It would be fun if we could make this extent atomic, so it - ;; doesn't mess with cursor motion. But atomic-extents library is - ;; currently a mess, so I'd rather not use it. - (set-extent-property extent 'invisible t) - (set-extent-property extent 'start-open t) - (set-extent-property extent 'end-open t) - (set-extent-property extent 'keymap map) - ;;(set-extent-property extent 'pointer widget-glyph-pointer-glyph) - (set-extent-end-glyph extent glyph) - (unless (or (stringp help-echo) (null help-echo)) - (setq help-echo 'widget-mouse-help)) - (when help-echo - (widget-handle-help-echo extent help-echo))) - (when widget - (widget-put widget :glyph-up glyph) - (when down (widget-put widget :glyph-down down)) - (when inactive (widget-put widget :glyph-inactive inactive)))) - - -;;; Buttons. - -(defgroup widget-button nil - "The look of various kinds of buttons." - :group 'widgets) - -(defcustom widget-button-prefix "" - "String used as prefix for buttons." - :type 'string - :group 'widget-button) - -(defcustom widget-button-suffix "" - "String used as suffix for buttons." - :type 'string - :group 'widget-button) - - -;;; Creating Widgets. - -;;;###autoload -(defun widget-create (type &rest args) - "Create widget of TYPE. -The optional ARGS are additional keyword arguments." - (let ((widget (apply 'widget-convert type args))) - (widget-apply widget :create) - widget)) - -(defun widget-create-child-and-convert (parent type &rest args) - "As part of the widget PARENT, create a child widget TYPE. -The child is converted, using the keyword arguments ARGS." - (let ((widget (apply 'widget-convert type args))) - (widget-put widget :parent parent) - (unless (widget-get widget :indent) - (widget-put widget :indent (+ (or (widget-get parent :indent) 0) - (or (widget-get widget :extra-offset) 0) - (widget-get parent :offset)))) - (widget-apply widget :create) - widget)) - -(defun widget-create-child (parent type) - "Create widget of TYPE." - (let ((widget (copy-sequence type))) - (widget-put widget :parent parent) - (unless (widget-get widget :indent) - (widget-put widget :indent (+ (or (widget-get parent :indent) 0) - (or (widget-get widget :extra-offset) 0) - (widget-get parent :offset)))) - (widget-apply widget :create) - widget)) - -(defun widget-create-child-value (parent type value) - "Create widget of TYPE with value VALUE." - (let ((widget (copy-sequence type))) - (widget-put widget :value (widget-apply widget :value-to-internal value)) - (widget-put widget :parent parent) - (unless (widget-get widget :indent) - (widget-put widget :indent (+ (or (widget-get parent :indent) 0) - (or (widget-get widget :extra-offset) 0) - (widget-get parent :offset)))) - (widget-apply widget :create) - widget)) - -;;;###autoload -(defun widget-delete (widget) - "Delete WIDGET." - (widget-apply widget :delete)) - -(defun widget-convert (type &rest args) - "Convert TYPE to a widget without inserting it in the buffer. -The optional ARGS are additional keyword arguments." - ;; Don't touch the type. - (let* ((widget (if (symbolp type) - (list type) - (copy-sequence type))) - (current widget) - (keys args)) - ;; First set the :args keyword. - (while (cdr current) ;Look in the type. - (let ((next (car (cdr current)))) - (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:)) - (setq current (cdr (cdr current))) - (setcdr current (list :args (cdr current))) - (setq current nil)))) - (while args ;Look in the args. - (let ((next (nth 0 args))) - (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:)) - (setq args (nthcdr 2 args)) - (widget-put widget :args args) - (setq args nil)))) - ;; Then Convert the widget. - (setq type widget) - (while type - (let ((convert-widget (plist-get (cdr type) :convert-widget))) - (if convert-widget - (setq widget (funcall convert-widget widget)))) - (setq type (get (car type) 'widget-type))) - ;; Finally set the keyword args. - (while keys - (let ((next (nth 0 keys))) - (if (and (symbolp next) (eq (aref (symbol-name next) 0) ?:)) - (progn - (widget-put widget next (nth 1 keys)) - (setq keys (nthcdr 2 keys))) - (setq keys nil)))) - ;; Convert the :value to internal format. - (if (widget-member widget :value) - (let ((value (widget-get widget :value))) - (widget-put widget - :value (widget-apply widget :value-to-internal value)))) - ;; Return the newly created widget. - widget)) - -(defun widget-insert (&rest args) - "Call `insert' with ARGS and make the text read only." - (let ((inhibit-read-only t) - before-change-functions - after-change-functions) - (apply 'insert args))) - -(defun widget-convert-text (type from to - &optional button-from button-to - &rest args) - "Return a widget of type TYPE with endpoint FROM TO. -Optional ARGS are extra keyword arguments for TYPE. -and TO will be used as the widgets end points. If optional arguments -BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets -button end points. -Optional ARGS are extra keyword arguments for TYPE." - (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) - (from (copy-marker from)) - (to (copy-marker to))) - (set-marker-insertion-type from t) - (set-marker-insertion-type to nil) - (widget-put widget :from from) - (widget-put widget :to to) - (when button-from - (widget-specify-button widget button-from button-to)) - widget)) - -(defun widget-convert-button (type from to &rest args) - "Return a widget of type TYPE with endpoint FROM TO. -Optional ARGS are extra keyword arguments for TYPE. -No text will be inserted to the buffer, instead the text between FROM -and TO will be used as the widgets end points, as well as the widgets -button end points." - (apply 'widget-convert-text type from to from to args)) - -(defun widget-leave-text (widget) - "Remove markers and extents from WIDGET and its children." - (let ((from (widget-get widget :from)) - (to (widget-get widget :to)) - (button (widget-get widget :button-extent)) - (sample (widget-get widget :sample-extent)) - (doc (widget-get widget :doc-extent)) - (field (widget-get widget :field-extent)) - (children (widget-get widget :children))) - (set-marker from nil) - (set-marker to nil) - ;; Maybe we should delete the extents here? As this code doesn't - ;; remove them from widget structures, maybe it's safer to just - ;; detach them. That's what `delete-overlay' did. - (when button - (detach-extent button)) - (when sample - (detach-extent sample)) - (when doc - (detach-extent doc)) - (when field - (detach-extent field)) - (mapc 'widget-leave-text children))) - - -;;; Keymap and Commands. - -(defvar widget-keymap nil - "Keymap containing useful binding for buffers containing widgets. -Recommended as a parent keymap for modes using widgets.") - -(unless widget-keymap - (setq widget-keymap (make-sparse-keymap)) - (define-key widget-keymap [tab] 'widget-forward) - (define-key widget-keymap [(shift tab)] 'widget-backward) - (define-key widget-keymap [(meta tab)] 'widget-backward) - (define-key widget-keymap [backtab] 'widget-backward)) - -(defvar widget-global-map global-map - "Keymap used for events the widget does not handle themselves.") -(make-variable-buffer-local 'widget-global-map) - -(defvar widget-field-keymap nil - "Keymap used inside an editable field.") - -(unless widget-field-keymap - (setq widget-field-keymap (make-sparse-keymap)) - (set-keymap-parents widget-field-keymap global-map) - (define-key widget-field-keymap "\C-k" 'widget-kill-line) - (define-key widget-field-keymap [(meta tab)] 'widget-complete) - (define-key widget-field-keymap [tab] 'widget-forward) - (define-key widget-field-keymap [(shift tab)] 'widget-backward) - (define-key widget-field-keymap "\C-m" 'widget-field-activate) - (define-key widget-field-keymap "\C-a" 'widget-beginning-of-line) - (define-key widget-field-keymap "\C-e" 'widget-end-of-line) - (define-key widget-field-keymap "\C-t" 'widget-transpose-chars)) - -(defvar widget-text-keymap nil - "Keymap used inside a text field.") - -(unless widget-text-keymap - (setq widget-text-keymap (make-sparse-keymap)) - (set-keymap-parents widget-field-keymap global-map) - (define-key widget-text-keymap "\C-a" 'widget-beginning-of-line) - (define-key widget-text-keymap "\C-e" 'widget-end-of-line) - (define-key widget-text-keymap "\C-t" 'widget-transpose-chars)) - -(defvar widget-button-keymap nil - "Keymap used inside a button.") - -(unless widget-button-keymap - (setq widget-button-keymap (make-sparse-keymap)) - (set-keymap-parents widget-button-keymap widget-keymap) - (define-key widget-button-keymap "\C-m" 'widget-button-press) - (define-key widget-button-keymap [button2] 'widget-button-click) - ;; Ideally, button3 within a button should invoke a button-specific - ;; menu. - (define-key widget-button-keymap [button3] 'widget-button-click) - ;;Glyph support. - (define-key widget-button-keymap [button1] 'widget-button1-click)) - - -(defun widget-field-activate (pos &optional event) - "Invoke the ediable field at point." - (interactive "@d") - (let ((field (widget-field-find pos))) - (if field - (widget-apply-action field event) - (call-interactively - (lookup-key widget-global-map (this-command-keys)))))) - -(defface widget-button-pressed-face - '((((class color)) - (:foreground "red")) - (t - (:bold t :underline t))) - "Face used for pressed buttons." - :group 'widget-faces) - -(defun widget-event-point (event) - "Character position of the mouse event, or nil." - (and (mouse-event-p event) - (event-point event))) - -(defun widget-button-click (event) - "Invoke button below mouse pointer." - (interactive "e") - (with-current-buffer (event-buffer event) - (cond ((event-glyph event) - (widget-glyph-click event)) - ((widget-event-point event) - (let* ((pos (widget-event-point event)) - (button (get-char-property pos 'button))) - (if button - (let* ((extent (widget-get button :button-extent)) - (face (extent-property extent 'face)) - (mouse-face (extent-property extent 'mouse-face)) - (help-echo (extent-property extent 'help-echo))) - (unwind-protect - (progn - ;; Merge relevant faces, and make the result mouse-face. - (let ((merge `(widget-button-pressed-face ,mouse-face))) - (nconc merge (if (listp face) - face (list face))) - (setq merge (delete-if-not 'find-face merge)) - (set-extent-property extent 'mouse-face merge)) - (unless (widget-apply button :mouse-down-action event) - ;; Wait for button release. - (while (not (button-release-event-p - (setq event (next-event)))) - (dispatch-event event))) - ;; Disallow mouse-face and help-echo. - (set-extent-property extent 'mouse-face nil) - (set-extent-property extent 'help-echo nil) - (setq pos (widget-event-point event)) - (unless (eq (current-buffer) (extent-object extent)) - ;; Barf if dispatch-event tripped us by - ;; changing buffer. - (error "Buffer changed during mouse motion")) - ;; Do the associated action. - (when (and pos (extent-in-region-p extent pos pos)) - (widget-apply-action button event))) - ;; Unwinding: fully release the button. - (set-extent-property extent 'mouse-face mouse-face) - (set-extent-property extent 'help-echo help-echo))) - ;; This should not happen! - (error "`widget-button-click' called outside button")))) - (t - (message "You clicked somewhere weird"))))) - -(defun widget-button1-click (event) - "Invoke glyph below mouse pointer." - (interactive "@e") - (if (event-glyph event) - (widget-glyph-click event) - ;; Should somehow avoid this. - (let ((command (lookup-key widget-global-map (this-command-keys)))) - (and (commandp command) - (call-interactively command))))) - -(defun widget-glyph-click (event) - "Handle click on a glyph." - (let* ((glyph (event-glyph event)) - (extent (event-glyph-extent event)) - (widget (extent-property extent 'glyph-widget)) - (down-glyph (or (and widget (widget-get widget :glyph-down)) glyph)) - (up-glyph (or (and widget (widget-get widget :glyph-up)) glyph)) - (last event)) - (unless (widget-apply widget :active) - (error "This widget is inactive")) - (let ((current-glyph 'down)) - ;; We always know what glyph is drawn currently, to avoid - ;; unnecessary extent changes. Is this any noticeable gain? - (unwind-protect - (progn - ;; Press the glyph. - (set-extent-end-glyph extent down-glyph) - ;; Redisplay (shouldn't be needed, but...) - (sit-for 0) - (unless (widget-apply widget :mouse-down-action event) - ;; Wait for the release. - (while (not (button-release-event-p last)) - (unless (button-press-event-p last) - (dispatch-event last)) - (when (motion-event-p last) - ;; Update glyphs on mouse motion. - (if (eq extent (event-glyph-extent last)) - (unless (eq current-glyph 'down) - (set-extent-end-glyph extent down-glyph) - (setq current-glyph 'down)) - (unless (eq current-glyph 'up) - (set-extent-end-glyph extent up-glyph) - (setq current-glyph 'up)))) - (setq last (next-event event)))) - (unless (eq (current-buffer) (extent-object extent)) - ;; Barf if dispatch-event tripped us by changing buffer. - (error "Buffer changed during mouse motion")) - ;; Apply widget action. - (when (eq extent (event-glyph-extent last)) - (let ((widget (extent-property (event-glyph-extent event) - 'glyph-widget))) - (cond ((null widget) - (message "You clicked on a glyph")) - ((not (widget-apply widget :active)) - (error "This glyph is inactive")) - (t - (widget-apply-action widget event)))))) - ;; Release the glyph. - (and (eq current-glyph 'down) - ;; The extent might have been detached or deleted - (extent-live-p extent) - (not (extent-detached-p extent)) - (set-extent-end-glyph extent up-glyph)))))) - -(defun widget-button-press (pos &optional event) - "Invoke button at POS." - (interactive "@d") - (let ((button (get-char-property pos 'button))) - (if button - (widget-apply-action button event) - (let ((command (lookup-key widget-global-map (this-command-keys)))) - (when (commandp command) - (call-interactively command)))))) - -(defun widget-tabable-at (&optional pos last-tab backwardp) - "Return the tabable widget at POS, or nil. -POS defaults to the value of (point)." - (unless pos - (setq pos (point))) - (let ((widget (widget-at pos))) - (if widget - (let ((order (widget-get widget :tab-order))) - (if order - (if last-tab (and (= order (if backwardp - (1- last-tab) - (1+ last-tab))) - widget) - (and (> order 0) widget)) - widget)) - nil))) - -;; Return the button or field extent at point. -(defun widget-button-or-field-extent (pos) - (or (and (get-char-property pos 'button) - (widget-get (get-char-property pos 'button) - :button-extent)) - (and (get-char-property pos 'field) - (widget-get (get-char-property pos 'field) - :field-extent)))) - -(defun widget-next-button-or-field (pos) - "Find the next button, or field, and return its start position, or nil. -Internal function, don't use it outside `wid-edit'." - (let* ((at-point (widget-button-or-field-extent pos)) - (extent (map-extents - (lambda (ext ignore) - ext) - nil (if at-point (extent-end-position at-point) pos) - nil nil 'start-open 'button-or-field))) - (and extent - (extent-start-position extent)))) - -;; This is too slow in buffers with many buttons (W3). -(defun widget-previous-button-or-field (pos) - "Find the previous button, or field, and return its start position, or nil. -Internal function, don't use it outside `wid-edit'." - (let* ((at-point (widget-button-or-field-extent pos)) - previous-extent) - (map-extents - (lambda (ext ignore) - (if (eq ext at-point) - ;; We reached the extent we were on originally - (if (= pos (extent-start-position at-point)) - previous-extent - (setq previous-extent at-point)) - (setq previous-extent ext) - nil)) - nil nil pos nil 'start-open 'button-or-field) - (and previous-extent - (extent-start-position previous-extent)))) - -(defun widget-move (arg) - "Move point to the ARG next field or button. -ARG may be negative to move backward." - (let ((opoint (point)) (wrapped 0) - (last-tab (widget-get (widget-at (point)) :tab-order)) - nextpos found) - ;; Movement backward - (while (< arg 0) - (setq nextpos (widget-previous-button-or-field (point))) - (if nextpos - (progn - (goto-char nextpos) - (when (and (not (get-char-property nextpos 'widget-inactive)) - (widget-tabable-at nil last-tab t)) - (incf arg) - (setq found t - last-tab (widget-get (widget-at (point)) - :tab-order)))) - (if (and (not found) (> wrapped 1)) - (setq arg 0 - found nil) - (goto-char (point-max)) - (incf wrapped)))) - ;; Movement forward - (while (> arg 0) - (setq nextpos (widget-next-button-or-field (point))) - (if nextpos - (progn - (goto-char nextpos) - (when (and (not (get-char-property nextpos 'widget-inactive)) - (widget-tabable-at nil last-tab)) - (decf arg) - (setq found t - last-tab (widget-get (widget-at (point)) - :tab-order)))) - (if (and (not found) (> wrapped 1)) - (setq arg 0 - found nil) - (goto-char (point-min)) - (incf wrapped)))) - (if (not found) - (goto-char opoint) - (widget-echo-help (point)) - (run-hooks 'widget-move-hook)))) - -(defun widget-forward (arg) - "Move point to the next field or button. -With optional ARG, move across that many fields." - (interactive "p") - (run-hooks 'widget-forward-hook) - (widget-move arg)) - -(defun widget-backward (arg) - "Move point to the previous field or button. -With optional ARG, move across that many fields." - (interactive "p") - (run-hooks 'widget-backward-hook) - (widget-move (- arg))) - -(defun widget-beginning-of-line () - "Go to beginning of field or beginning of line, whichever is first." - (interactive "_") - (let* ((field (widget-field-find (point))) - (start (and field (widget-field-start field)))) - (if (and start (not (eq start (point)))) - (goto-char start) - (call-interactively 'beginning-of-line)))) - -(defun widget-end-of-line () - "Go to end of field or end of line, whichever is first." - (interactive "_") - (let* ((field (widget-field-find (point))) - (end (and field (widget-field-end field)))) - (if (and end (not (eq end (point)))) - (goto-char end) - (call-interactively 'end-of-line)))) - -(defun widget-kill-line () - "Kill to end of field or end of line, whichever is first." - (interactive) - (let* ((field (widget-field-find (point))) - (newline (save-excursion (forward-line 1) (point))) - (end (and field (widget-field-end field)))) - (if (and field (> newline end)) - (kill-region (point) end) - (call-interactively 'kill-line)))) - -(defun widget-transpose-chars (arg) - "Like `transpose-chars', but works correctly at end of widget." - (interactive "*P") - (let* ((field (widget-field-find (point))) - (start (and field (widget-field-start field))) - (end (and field (widget-field-end field))) - (last-non-space (and start end - (save-excursion - (goto-char end) - (skip-chars-backward " \t\n" start) - (point))))) - (cond ((and last-non-space - (or (= last-non-space start) - (= last-non-space (1+ start)))) - ;; empty or one-character field - nil) - ((= (point) start) - ;; at the beginning of the field -- we would get an error here. - (error "Cannot transpose at beginning of field")) - (t - (when (and (null arg) - (= last-non-space (point))) - (forward-char -1)) - (transpose-chars arg))))) - -(defcustom widget-complete-field (lookup-key global-map "\M-\t") - "Default function to call for completion inside fields." - :options '(ispell-complete-word complete-tag lisp-complete-symbol) - :type 'function - :group 'widgets) - -(defun widget-complete () - "Complete content of editable field from point. -When not inside a field, move to the previous button or field." - (interactive) - ;; Somehow, this should make pressing M-TAB twice scroll the - ;; completions window. - (let ((field (widget-field-find (point)))) - (if field - (widget-apply field :complete) - (error "Not in an editable field")))) - - -;;; Setting up the buffer. - -(defvar widget-field-new nil) -;; List of all newly created editable fields in the buffer. -(make-variable-buffer-local 'widget-field-new) - -(defvar widget-field-list nil) -;; List of all editable fields in the buffer. -(make-variable-buffer-local 'widget-field-list) - -(defun widget-setup () - "Setup current buffer so editing string widgets works." - (let ((inhibit-read-only t) - (after-change-functions nil) - before-change-functions - field) - (while widget-field-new - (setq field (car widget-field-new) - widget-field-new (cdr widget-field-new) - widget-field-list (cons field widget-field-list)) - (let ((from (car (widget-get field :field-extent))) - (to (cdr (widget-get field :field-extent)))) - (widget-specify-field field - (marker-position from) (marker-position to)) - (set-marker from nil) - (set-marker to nil)) - ;; If the field is placed within the inactive zone, deactivate it. - (let ((extent (widget-get field :field-extent))) - (when (get-char-property (extent-start-position extent) - 'widget-inactive) - (widget-activation-widget-mapper extent :deactivate))))) - (widget-clear-undo) - (widget-add-change)) - -(defvar widget-field-last nil) -;; Last field containing point. -(make-variable-buffer-local 'widget-field-last) - -(defvar widget-field-was nil) -;; The widget data before the change. -(make-variable-buffer-local 'widget-field-was) - -(defun widget-field-buffer (widget) - "Return the start of WIDGET's editing field." - (let ((extent (widget-get widget :field-extent))) - (and extent (extent-object extent)))) - -(defun widget-field-start (widget) - "Return the start of WIDGET's editing field." - (let ((extent (widget-get widget :field-extent))) - (and extent (extent-start-position extent)))) - -(defun widget-field-end (widget) - "Return the end of WIDGET's editing field." - (let ((extent (widget-get widget :field-extent))) - ;; Don't subtract one if local-map works at the end of the extent. - (and extent (if (or widget-field-add-space - (null (widget-get widget :size))) - (1- (extent-end-position extent)) - (extent-end-position extent))))) - -(defun widget-field-find (pos) - "Return the field at POS. -Unlike (get-char-property POS 'field) this, works with empty fields too." - (let ((field-extent (map-extents (lambda (extent ignore) - extent) - nil pos pos nil nil 'field))) - (and field-extent - (extent-property field-extent 'field)))) - -;; Old version, without `map-extents'. -;(defun widget-field-find (pos) -; (let ((fields widget-field-list) -; field found) -; (while fields -; (setq field (car fields) -; fields (cdr fields)) -; (let ((start (widget-field-start field)) -; (end (widget-field-end field))) -; (when (and (<= start pos) (<= pos end)) -; (when found -; (debug "Overlapping fields")) -; (setq found field)))) -; found)) - -(defun widget-before-change (from to) - ;; Barf if the text changed is outside the editable fields. - (unless inhibit-read-only - (let ((from-field (widget-field-find from)) - (to-field (widget-field-find to))) - (cond ((or (null from-field) - (null to-field)) - ;; Either end of change is not within a field. - (add-hook 'post-command-hook 'widget-add-change nil t) - (error "Attempt to change text outside editable field")) - ((not (eq from-field to-field)) - ;; The change begins in one fields, and ends in another one. - (add-hook 'post-command-hook 'widget-add-change nil t) - (error "Change should be restricted to a single field")) - ((or (and from-field - (get-char-property from 'widget-inactive)) - (and to-field - (get-char-property to 'widget-inactive))) - ;; Trying to change an inactive editable field. - (add-hook 'post-command-hook 'widget-add-change nil t) - (error "Attempt to change an inactive field")) - (widget-field-use-before-change - ;; #### Bletch! This loses because XEmacs get confused - ;; if before-change-functions change the contents of - ;; buffer before from/to. - (condition-case nil - (widget-apply from-field :notify from-field) - (error (debug "Before Change")))))))) - -(defun widget-add-change () - (make-local-hook 'post-command-hook) - (remove-hook 'post-command-hook 'widget-add-change t) - (make-local-hook 'before-change-functions) - (add-hook 'before-change-functions 'widget-before-change nil t) - (make-local-hook 'after-change-functions) - (add-hook 'after-change-functions 'widget-after-change nil t)) - -(defun widget-after-change (from to old) - ;; Adjust field size and text properties. - - ;; Also, notify the widgets (so, for example, a variable changes its - ;; state to `modified'. when it is being edited.) - (condition-case nil - (let ((field (widget-field-find from)) - (other (widget-field-find to))) - (when field - (unless (eq field other) - (debug "Change in different fields")) - (let ((size (widget-get field :size))) - (when size - (let ((begin (widget-field-start field)) - (end (widget-field-end field))) - (cond ((< (- end begin) size) - ;; Field too small. - (save-excursion - (goto-char end) - (insert-char ?\ (- (+ begin size) end)))) - ((> (- end begin) size) - ;; Field too large and - (if (or (< (point) (+ begin size)) - (> (point) end)) - ;; Point is outside extra space. - (setq begin (+ begin size)) - ;; Point is within the extra space. - (setq begin (point))) - (save-excursion - (goto-char end) - (while (and (eq (preceding-char) ?\ ) - (> (point) begin)) - (delete-backward-char 1))))))) - (widget-specify-secret field)) - (widget-apply field :notify field))) - (error (debug "After Change")))) - - -;;; Widget Functions -;; -;; These functions are used in the definition of multiple widgets. - -(defun widget-parent-action (widget &optional event) - "Tell :parent of WIDGET to handle the :action. -Optional EVENT is the event that triggered the action." - (widget-apply (widget-get widget :parent) :action event)) - -(defun widget-children-value-delete (widget) - "Delete all :children and :buttons in WIDGET." - (mapc 'widget-delete (widget-get widget :children)) - (widget-put widget :children nil) - (mapc 'widget-delete (widget-get widget :buttons)) - (widget-put widget :buttons nil)) - -(defun widget-children-validate (widget) - "All the :children must be valid." - (let ((children (widget-get widget :children)) - child found) - (while (and children (not found)) - (setq child (car children) - children (cdr children) - found (widget-apply child :validate))) - found)) - -(defun widget-types-convert-widget (widget) - "Convert :args as widget types in WIDGET." - (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args))) - widget) - -(defun widget-value-convert-widget (widget) - "Initialize :value from :args in WIDGET." - (let ((args (widget-get widget :args))) - (when args - (widget-put widget :value (car args)) - ;; Don't convert :value here, as this is done in `widget-convert'. - ;; (widget-put widget :value (widget-apply widget - ;; :value-to-internal (car args))) - (widget-put widget :args nil))) - widget) - -(defun widget-value-value-get (widget) - "Return the :value property of WIDGET." - (widget-get widget :value)) - -;;; The `default' Widget. - -(define-widget 'default nil - "Basic widget other widgets are derived from." - :value-to-internal (lambda (widget value) value) - :value-to-external (lambda (widget value) value) - :button-prefix 'widget-button-prefix - :button-suffix 'widget-button-suffix - :complete 'widget-default-complete - :create 'widget-default-create - :indent nil - :offset 0 - :format-handler 'widget-default-format-handler - :button-face-get 'widget-default-button-face-get - :sample-face-get 'widget-default-sample-face-get - :button-keymap widget-button-keymap - :delete 'widget-default-delete - :value-set 'widget-default-value-set - :value-inline 'widget-default-value-inline - :default-get 'widget-default-default-get - :menu-tag-get 'widget-default-menu-tag-get - :validate (lambda (widget) nil) - :active 'widget-default-active - :activate 'widget-specify-active - :deactivate 'widget-default-deactivate - :mouse-down-action (lambda (widget event) nil) - :action 'widget-default-action - :notify 'widget-default-notify - :prompt-value 'widget-default-prompt-value) - -(defun widget-default-complete (widget) - "Call the value of the :complete-function property of WIDGET. -If that does not exists, call the value of `widget-complete-field'." - (let ((fun (widget-get widget :complete-function))) - (call-interactively (or fun widget-complete-field)))) - -(defun widget-default-create (widget) - "Create WIDGET at point in the current buffer." - (widget-specify-insert - (let ((from (point)) - button-begin button-end button-glyph - sample-begin sample-end - doc-begin doc-end - value-pos) - (insert (widget-get widget :format)) - (goto-char from) - ;; Parse escapes in format. Coding this in C would speed up - ;; things *a lot*. - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (cond ((eq escape ?%) - (insert "%")) - ((eq escape ?\[) - (setq button-begin (point-marker)) - (set-marker-insertion-type button-begin nil)) - ((eq escape ?\]) - (setq button-end (point-marker)) - (set-marker-insertion-type button-end nil)) - ((eq escape ?\{) - (setq sample-begin (point))) - ((eq escape ?\}) - (setq sample-end (point))) - ((eq escape ?n) - (when (widget-get widget :indent) - (insert "\n") - (insert-char ?\ (widget-get widget :indent)))) - ((eq escape ?t) - (let* ((tag (widget-get widget :tag)) - (glyph (widget-get widget :tag-glyph))) - (cond (glyph - (setq button-glyph - (widget-glyph-insert - widget (or tag "Image") glyph))) - (tag - (insert tag)) - (t - (let ((standard-output (current-buffer))) - (princ (widget-get widget :value))))))) - ((eq escape ?d) - (let ((doc (widget-get widget :doc))) - (when doc - (setq doc-begin (point)) - (insert doc) - (while (eq (preceding-char) ?\n) - (delete-backward-char 1)) - (insert "\n") - (setq doc-end (point))))) - ((eq escape ?v) - (if (and button-begin (not button-end)) - (widget-apply widget :value-create) - (setq value-pos (point-marker)))) - (t - (widget-apply widget :format-handler escape))))) - ;; Specify button, sample, and doc, and insert value. - (when (and button-begin button-end) - (unless button-glyph - (goto-char button-begin) - (insert (widget-get-indirect widget :button-prefix)) - (goto-char button-end) - (set-marker-insertion-type button-end t) - (insert (widget-get-indirect widget :button-suffix))) - (widget-specify-button widget button-begin button-end) - ;; Is this necessary? - (set-marker button-begin nil) - (set-marker button-end nil)) - (and sample-begin sample-end - (widget-specify-sample widget sample-begin sample-end)) - (and doc-begin doc-end - (widget-specify-doc widget doc-begin doc-end)) - (when value-pos - (goto-char value-pos) - (widget-apply widget :value-create))) - (let ((from (point-min-marker)) - (to (point-max-marker))) - (set-marker-insertion-type from t) - (set-marker-insertion-type to nil) - (widget-put widget :from from) - (widget-put widget :to to))) - (widget-clear-undo)) - -(defun widget-default-format-handler (widget escape) - ;; We recognize the %h escape by default. - (let* ((buttons (widget-get widget :buttons))) - (cond ((eq escape ?h) - (let* ((doc-property (widget-get widget :documentation-property)) - (doc-try (cond ((widget-get widget :doc)) - ((symbolp doc-property) - (documentation-property - (widget-get widget :value) - doc-property)) - (t - (funcall doc-property - (widget-get widget :value))))) - (doc-text (and (stringp doc-try) - (> (length doc-try) 1) - doc-try)) - (doc-indent (widget-get widget :documentation-indent))) - (when doc-text - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - ;; The `*' in the beginning is redundant. - (when (eq (aref doc-text 0) ?*) - (setq doc-text (substring doc-text 1))) - ;; Get rid of trailing newlines. - (when (string-match "\n+\\'" doc-text) - (setq doc-text (substring doc-text 0 (match-beginning 0)))) - (push (widget-create-child-and-convert - widget 'documentation-string - :indent (cond ((numberp doc-indent) - doc-indent) - ((null doc-indent) - nil) - (t 0)) - doc-text) - buttons)))) - (t - (signal 'error (list "Unknown escape" escape)))) - (widget-put widget :buttons buttons))) - -(defun widget-default-button-face-get (widget) - ;; Use :button-face or widget-button-face - (or (widget-get widget :button-face) - (let ((parent (widget-get widget :parent))) - (if parent - (widget-apply parent :button-face-get) - widget-button-face)))) - -(defun widget-default-sample-face-get (widget) - ;; Use :sample-face. - (widget-get widget :sample-face)) - -(defun widget-default-delete (widget) - ;; Remove widget from the buffer. - (let ((from (widget-get widget :from)) - (to (widget-get widget :to)) - (inactive-extent (widget-get widget :inactive)) - (button-extent (widget-get widget :button-extent)) - (sample-extent (widget-get widget :sample-extent)) - (doc-extent (widget-get widget :doc-extent)) - before-change-functions - after-change-functions - (inhibit-read-only t)) - (widget-apply widget :value-delete) - (when inactive-extent - (detach-extent inactive-extent)) - (when button-extent - (detach-extent button-extent)) - (when sample-extent - (detach-extent sample-extent)) - (when doc-extent - (detach-extent doc-extent)) - (when (< from to) - ;; Kludge: this doesn't need to be true for empty formats. - (delete-region from to)) - (set-marker from nil) - (set-marker to nil)) - (widget-clear-undo)) - -(defun widget-default-value-set (widget value) - ;; Recreate widget with new value. - (let* ((old-pos (point)) - (from (copy-marker (widget-get widget :from))) - (to (copy-marker (widget-get widget :to))) - (offset (if (and (<= from old-pos) (<= old-pos to)) - (if (>= old-pos (1- to)) - (- old-pos to 1) - (- old-pos from))))) - ;;??? Bug: this ought to insert the new value before deleting the old one, - ;; so that markers on either side of the value automatically - ;; stay on the same side. -- rms. - (save-excursion - (goto-char (widget-get widget :from)) - (widget-apply widget :delete) - (widget-put widget :value value) - (widget-apply widget :create)) - (when offset - (if (< offset 0) - (goto-char (+ (widget-get widget :to) offset 1)) - (goto-char (min (+ from offset) (1- (widget-get widget :to)))))))) - -(defun widget-default-value-inline (widget) - ;; Wrap value in a list unless it is inline. - (if (widget-get widget :inline) - (widget-value widget) - (list (widget-value widget)))) - -(defun widget-default-default-get (widget) - ;; Get `:value'. - (widget-get widget :value)) - -(defun widget-default-menu-tag-get (widget) - ;; Use tag or value for menus. - (or (widget-get widget :menu-tag) - (widget-get widget :tag) - (widget-princ-to-string (widget-get widget :value)))) - -(defun widget-default-active (widget) - "Return t iff this widget active (user modifiable)." - (and (not (widget-get widget :inactive)) - (let ((parent (widget-get widget :parent))) - (or (null parent) - (widget-apply parent :active))))) - -(defun widget-default-deactivate (widget) - "Make WIDGET inactive for user modifications." - (widget-specify-inactive widget - (widget-get widget :from) - (widget-get widget :to))) - -(defun widget-default-action (widget &optional event) - ;; Notify the parent when a widget change - (let ((parent (widget-get widget :parent))) - (when parent - (widget-apply parent :notify widget event)))) - -(defun widget-default-notify (widget child &optional event) - ;; Pass notification to parent. - (widget-default-action widget event)) - -(defun widget-default-prompt-value (widget prompt value unbound) - ;; Read an arbitrary value. Stolen from `set-variable'. -;; (let ((initial (if unbound -;; nil -;; ;; It would be nice if we could do a `(cons val 1)' here. -;; (prin1-to-string (custom-quote value)))))) - (eval-minibuffer prompt )) - -;;; The `item' Widget. - -(define-widget 'item 'default - "Constant items for inclusion in other widgets." - :convert-widget 'widget-value-convert-widget - :value-create 'widget-item-value-create - :value-delete 'ignore - :value-get 'widget-value-value-get - :match 'widget-item-match - :match-inline 'widget-item-match-inline - :action 'widget-item-action - :format "%t\n") - -(defun widget-item-value-create (widget) - ;; Insert the printed representation of the value. - (let ((standard-output (current-buffer))) - (princ (widget-get widget :value)))) - -(defun widget-item-match (widget value) - ;; Match if the value is the same. - (equal (widget-get widget :value) value)) - -(defun widget-item-match-inline (widget values) - ;; Match if the value is the same. - (let ((value (widget-get widget :value))) - (and (listp value) - (<= (length value) (length values)) - (let ((head (widget-sublist values 0 (length value)))) - (and (equal head value) - (cons head (widget-sublist values (length value)))))))) - -(defun widget-sublist (list start &optional end) - "Return the sublist of LIST from START to END. -If END is omitted, it defaults to the length of LIST." - (if (> start 0) (setq list (nthcdr start list))) - (if end - (if (<= end start) - nil - (setq list (copy-sequence list)) - (setcdr (nthcdr (- end start 1) list) nil) - list) - (copy-sequence list))) - -(defun widget-item-action (widget &optional event) - ;; Just notify itself. - (widget-apply widget :notify widget event)) - -;;; The `push-button' Widget. - -(defcustom widget-push-button-gui widget-glyph-enable - "If non nil, use GUI push buttons when available." - :group 'widgets - :type 'boolean) - -;; Cache already created GUI objects. -(defvar widget-push-button-cache nil) - -(defcustom widget-push-button-prefix "[" - "String used as prefix for buttons." - :type 'string - :group 'widget-button) - -(defcustom widget-push-button-suffix "]" - "String used as suffix for buttons." - :type 'string - :group 'widget-button) - -(define-widget 'push-button 'item - "A pushable button." - :button-prefix "" - :button-suffix "" - :value-create 'widget-push-button-value-create - :format "%[%v%]") - -(defun widget-push-button-value-create (widget) - ;; Insert text representing the `on' and `off' states. - (let* ((tag (or (widget-get widget :tag) - (widget-get widget :value))) - (tag-glyph (widget-get widget :tag-glyph)) - (text (concat widget-push-button-prefix - tag widget-push-button-suffix)) - (gui-glyphs (lax-plist-get widget-push-button-cache tag))) - (cond (tag-glyph - (widget-glyph-insert widget text tag-glyph)) - ;; We must check for console-on-window-system-p here, - ;; because GUI will not work otherwise (it needs RGB - ;; components for colors, and they are not known on TTYs). - ((and widget-push-button-gui - (console-on-window-system-p)) - (unless gui-glyphs - (let* ((gui-button-shadow-thickness 1) - (gui (make-gui-button tag 'widget-gui-action widget))) - (setq - gui-glyphs - (list - (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text])) - (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text])))) - (laxputf widget-push-button-cache tag gui-glyphs))) - (widget-glyph-insert-glyph - widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs))) - (t - (insert text))))) - -(defun widget-gui-action (widget) - "Apply :action for WIDGET." - (widget-apply-action widget (this-command-keys))) - -;;; The `link' Widget. - -(defcustom widget-link-prefix "[" - "String used as prefix for links." - :type 'string - :group 'widget-button) - -(defcustom widget-link-suffix "]" - "String used as suffix for links." - :type 'string - :group 'widget-button) - -(define-widget 'link 'item - "An embedded link." - :button-prefix 'widget-link-prefix - :button-suffix 'widget-link-suffix - :help-echo "Follow the link" - :format "%[%t%]") - -;;; The `info-link' Widget. - -(define-widget 'info-link 'link - "A link to an info file." - :help-echo 'widget-info-link-help-echo - :action 'widget-info-link-action) - -(defun widget-info-link-help-echo (widget) - (concat "Read the manual entry `" (widget-value widget) "'")) - -(defun widget-info-link-action (widget &optional event) - "Open the info node specified by WIDGET." - (Info-goto-node (widget-value widget))) - -;;; The `url-link' Widget. - -(define-widget 'url-link 'link - "A link to an www page." - :help-echo 'widget-url-link-help-echo - :action 'widget-url-link-action) - -(defun widget-url-link-help-echo (widget) - (concat "Visit ")) - -(defun widget-url-link-action (widget &optional event) - "Open the url specified by WIDGET." - (if (boundp 'browse-url-browser-function) - (funcall browse-url-browser-function (widget-value widget)) - (error "Cannot follow URLs in this XEmacs"))) - -;;; The `function-link' Widget. - -(define-widget 'function-link 'link - "A link to an Emacs function." - :action 'widget-function-link-action) - -(defun widget-function-link-action (widget &optional event) - "Show the function specified by WIDGET." - (describe-function (widget-value widget))) - -;;; The `variable-link' Widget. - -(define-widget 'variable-link 'link - "A link to an Emacs variable." - :action 'widget-variable-link-action) - -(defun widget-variable-link-action (widget &optional event) - "Show the variable specified by WIDGET." - (describe-variable (widget-value widget))) - -;;; The `file-link' Widget. - -(define-widget 'file-link 'link - "A link to a file." - :action 'widget-file-link-action) - -(defun widget-file-link-action (widget &optional event) - "Find the file specified by WIDGET." - (find-file (widget-value widget))) - -;;; The `emacs-library-link' Widget. - -(define-widget 'emacs-library-link 'link - "A link to an Emacs Lisp library file." - :help-echo 'widget-emacs-library-link-help-echo - :action 'widget-emacs-library-link-action) - -(defun widget-emacs-library-link-help-echo (widget) - (concat "Visit " (widget-value widget))) - -(defun widget-emacs-library-link-action (widget &optional event) - "Find the Emacs Library file specified by WIDGET." - (find-file (locate-library (widget-value widget)))) - -;;; The `emacs-commentary-link' Widget. - -(define-widget 'emacs-commentary-link 'link - "A link to Commentary in an Emacs Lisp library file." - :action 'widget-emacs-commentary-link-action) - -(defun widget-emacs-commentary-link-action (widget &optional event) - "Find the Commentary section of the Emacs file specified by WIDGET." - (finder-commentary (widget-value widget))) - -;;; The `editable-field' Widget. - -(define-widget 'editable-field 'default - "An editable text field." - :convert-widget 'widget-value-convert-widget - :keymap widget-field-keymap - :format "%v" - :value "" - :prompt-internal 'widget-field-prompt-internal - :prompt-history 'widget-field-history - :prompt-value 'widget-field-prompt-value - :action 'widget-field-action - :validate 'widget-field-validate - :valid-regexp "" - :error "No match" - :value-create 'widget-field-value-create - :value-delete 'widget-field-value-delete - :value-get 'widget-field-value-get - :match 'widget-field-match) - -(defvar widget-field-history nil - "History of field minibuffer edits.") - -(defun widget-field-prompt-internal (widget prompt initial history) - ;; Read string for WIDGET prompting with PROMPT. - ;; INITIAL is the initial input and HISTORY is a symbol containing - ;; the earlier input. - (read-string prompt initial history)) - -(defun widget-field-prompt-value (widget prompt value unbound) - ;; Prompt for a string. - (let ((initial (if unbound - nil - (cons (widget-apply widget :value-to-internal - value) 0))) - (history (widget-get widget :prompt-history))) - (let ((answer (widget-apply widget - :prompt-internal prompt initial history))) - (widget-apply widget :value-to-external answer)))) - -(defvar widget-edit-functions nil) - -(defun widget-field-action (widget &optional event) - ;; Edit the value in the minibuffer. - (let* ((invalid (widget-apply widget :validate)) - (prompt (concat (widget-apply widget :menu-tag-get) ": ")) - (value (unless invalid - (widget-value widget))) - (answer (widget-apply widget :prompt-value prompt value invalid))) - (unless (equal value answer) - ;; This is a hack. We can't properly validate the widget - ;; because validation requires the new value to be in the field. - ;; However, widget-field-value-create will not function unless - ;; the new value matches. So, we check whether the thing - ;; matches, and if it does, use either the real or a dummy error - ;; message. - (unless (widget-apply widget :match answer) - (let ((error-message (or (widget-get widget :type-error) - "Invalid field contents"))) - (widget-put widget :error error-message) - (error error-message))) - (widget-value-set widget answer) - (widget-apply widget :notify widget event) - (widget-setup)) - (run-hook-with-args 'widget-edit-functions widget))) - -;(defun widget-field-action (widget &optional event) -; ;; Move to next field. -; (widget-forward 1) -; (run-hook-with-args 'widget-edit-functions widget)) - -(defun widget-field-validate (widget) - ;; Valid if the content matches `:valid-regexp'. - (save-excursion - (let ((value (widget-apply widget :value-get)) - (regexp (widget-get widget :valid-regexp))) - (if (string-match regexp value) - nil - widget)))) - -(defun widget-field-value-create (widget) - ;; Create an editable text field. - (let ((size (widget-get widget :size)) - (value (widget-get widget :value)) - (from (point)) - ;; This is changed to a real extent in `widget-setup'. We - ;; need the end points to behave differently until - ;; `widget-setup' is called. Should probably be replaced with - ;; a genuine extent, but some things break, then. - (extent (cons (make-marker) (make-marker)))) - (widget-put widget :field-extent extent) - (insert value) - (and size - (< (length value) size) - (insert-char ?\ (- size (length value)))) - (unless (memq widget widget-field-list) - (push widget widget-field-new)) - (move-marker (cdr extent) (point)) - (set-marker-insertion-type (cdr extent) nil) - (when (null size) - (insert ?\n)) - (move-marker (car extent) from) - (set-marker-insertion-type (car extent) t))) - -(defun widget-field-value-delete (widget) - ;; Remove the widget from the list of active editing fields. - (setq widget-field-list (delq widget widget-field-list)) - ;; These are nil if the :format string doesn't contain `%v'. - (let ((extent (widget-get widget :field-extent))) - (when extent - (detach-extent extent)))) - -(defun widget-field-value-get (widget) - ;; Return current text in editing field. - (let ((from (widget-field-start widget)) - (to (widget-field-end widget)) - (buffer (widget-field-buffer widget)) - (size (widget-get widget :size)) - (secret (widget-get widget :secret)) - (old (current-buffer))) - (cond - ((and from to) - (set-buffer buffer) - (while (and size - (not (zerop size)) - (> to from) - (eq (char-after (1- to)) ?\ )) - (setq to (1- to))) - (let ((result (buffer-substring-no-properties from to))) - (when secret - (let ((index 0)) - (while (< (+ from index) to) - (aset result index - (get-char-property (+ from index) 'secret)) - (incf index)))) - (set-buffer old) - result)) - (t - (widget-get widget :value))))) - -(defun widget-field-match (widget value) - ;; Match any string. - (stringp value)) - -;;; The `text' Widget. - -(define-widget 'text 'editable-field - :keymap widget-text-keymap - "A multiline text area.") - -;;; The `menu-choice' Widget. - -(define-widget 'menu-choice 'default - "A menu of options." - :convert-widget 'widget-types-convert-widget - :format "%[%t%]: %v" - :case-fold t - :tag "choice" - :void '(item :format "invalid (%t)\n") - :value-create 'widget-choice-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-choice-value-get - :value-inline 'widget-choice-value-inline - :default-get 'widget-choice-default-get - :mouse-down-action 'widget-choice-mouse-down-action - :action 'widget-choice-action - :error "Make a choice" - :validate 'widget-choice-validate - :match 'widget-choice-match - :match-inline 'widget-choice-match-inline) - -(defun widget-choice-value-create (widget) - ;; Insert the first choice that matches the value. - (let ((value (widget-get widget :value)) - (args (widget-get widget :args)) - (explicit (widget-get widget :explicit-choice)) - current) - (if explicit - (progn - (widget-put widget :children (list (widget-create-child-value - widget explicit value))) - (widget-put widget :choice explicit)) - (while args - (setq current (car args) - args (cdr args)) - (when (widget-apply current :match value) - (widget-put widget :children (list (widget-create-child-value - widget current value))) - (widget-put widget :choice current) - (setq args nil - current nil))) - (when current - (let ((void (widget-get widget :void))) - (widget-put widget :children (list (widget-create-child-and-convert - widget void :value value))) - (widget-put widget :choice void)))))) - -(defun widget-choice-value-get (widget) - ;; Get value of the child widget. - (widget-value (car (widget-get widget :children)))) - -(defun widget-choice-value-inline (widget) - ;; Get value of the child widget. - (widget-apply (car (widget-get widget :children)) :value-inline)) - -(defun widget-choice-default-get (widget) - ;; Get default for the first choice. - (widget-default-get (car (widget-get widget :args)))) - -(defcustom widget-choice-toggle nil - "If non-nil, a binary choice will just toggle between the values. -Otherwise, the user will explicitly have to choose between the values -when he invoked the menu." - :type 'boolean - :group 'widgets) - -(defun widget-choice-mouse-down-action (widget &optional event) - ;; Return non-nil if we need a menu. - (let ((args (widget-get widget :args)) - (old (widget-get widget :choice))) - (cond ((not (console-on-window-system-p)) - ;; No place to pop up a menu. - nil) - ((< (length args) 2) - ;; Empty or singleton list, just return the value. - nil) - ((> (length args) widget-menu-max-size) - ;; Too long, prompt. - nil) - ((> (length args) 2) - ;; Reasonable sized list, use menu. - t) - ((and widget-choice-toggle (memq old args)) - ;; We toggle. - nil) - (t - ;; Ask which of the two. - t)))) - -(defun widget-choice-action (widget &optional event) - ;; Make a choice. - (let ((args (widget-get widget :args)) - (old (widget-get widget :choice)) - (tag (widget-apply widget :menu-tag-get)) - (completion-ignore-case (widget-get widget :case-fold)) - current choices) - ;; Remember old value. - (if (and old (not (widget-apply widget :validate))) - (let* ((external (widget-value widget)) - (internal (widget-apply old :value-to-internal external))) - (widget-put old :value internal))) - ;; Find new choice. - (setq current - (cond ((= (length args) 0) - nil) - ((= (length args) 1) - (nth 0 args)) - ((and widget-choice-toggle - (= (length args) 2) - (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) - (t - (while args - (setq current (car args) - args (cdr args)) - (setq choices - (cons (cons (widget-apply current :menu-tag-get) - current) - choices))) - (let ((choice - (widget-choose tag (reverse choices) event))) - (widget-put widget :explicit-choice choice) - choice)))) - (when current - (let ((value (widget-default-get current))) - (widget-value-set widget - (widget-apply current :value-to-external value))) - (widget-setup) - (widget-apply widget :notify widget event))) - (run-hook-with-args 'widget-edit-functions widget)) - -(defun widget-choice-validate (widget) - ;; Valid if we have made a valid choice. - (let ((void (widget-get widget :void)) - (choice (widget-get widget :choice)) - (child (car (widget-get widget :children)))) - (if (eq void choice) - widget - (widget-apply child :validate)))) - -(defun widget-choice-match (widget value) - ;; Matches if one of the choices matches. - (let ((args (widget-get widget :args)) - current found) - (while (and args (not found)) - (setq current (car args) - args (cdr args) - found (widget-apply current :match value))) - found)) - -(defun widget-choice-match-inline (widget values) - ;; Matches if one of the choices matches. - (let ((args (widget-get widget :args)) - current found) - (while (and args (null found)) - (setq current (car args) - args (cdr args) - found (widget-match-inline current values))) - found)) - -;;; The `toggle' Widget. - -(define-widget 'toggle 'item - "Toggle between two states." - :format "%[%v%]\n" - :value-create 'widget-toggle-value-create - :action 'widget-toggle-action - :match (lambda (widget value) t) - :on "on" - :off "off") - -(defun widget-toggle-value-create (widget) - ;; Insert text representing the `on' and `off' states. - (if (widget-value widget) - (widget-glyph-insert widget - (widget-get widget :on) - (widget-get widget :on-glyph)) - (widget-glyph-insert widget - (widget-get widget :off) - (widget-get widget :off-glyph)))) - -(defun widget-toggle-action (widget &optional event) - ;; Toggle value. - (widget-value-set widget (not (widget-value widget))) - (widget-apply widget :notify widget event) - (run-hook-with-args 'widget-edit-functions widget)) - -;;; The `checkbox' Widget. - -(define-widget 'checkbox 'toggle - "A checkbox toggle." - :button-suffix "" - :button-prefix "" - :format "%[%v%]" - :on "[X]" - :on-glyph "check1" - :off "[ ]" - :off-glyph "check0" - :action 'widget-checkbox-action) - -(defun widget-checkbox-action (widget &optional event) - "Toggle checkbox, notify parent, and set active state of sibling." - (widget-toggle-action widget event) - (let ((sibling (widget-get-sibling widget))) - (when sibling - (if (widget-value widget) - (widget-apply sibling :activate) - (widget-apply sibling :deactivate))))) - -;;; The `checklist' Widget. - -(define-widget 'checklist 'default - "A multiple choice widget." - :convert-widget 'widget-types-convert-widget - :format "%v" - :offset 4 - :entry-format "%b %v" - :menu-tag "checklist" - :greedy nil - :value-create 'widget-checklist-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-checklist-value-get - :validate 'widget-checklist-validate - :match 'widget-checklist-match - :match-inline 'widget-checklist-match-inline) - -(defun widget-checklist-value-create (widget) - ;; Insert all values - (let ((alist (widget-checklist-match-find widget (widget-get widget :value))) - (args (widget-get widget :args))) - (while args - (widget-checklist-add-item widget (car args) (assq (car args) alist)) - (setq args (cdr args))) - (widget-put widget :children (nreverse (widget-get widget :children))))) - -(defun widget-checklist-add-item (widget type chosen) - ;; Create checklist item in WIDGET of type TYPE. - ;; If the item is checked, CHOSEN is a cons whose cdr is the value. - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - (widget-specify-insert - (let* ((children (widget-get widget :children)) - (buttons (widget-get widget :buttons)) - (button-args (or (widget-get type :sibling-args) - (widget-get widget :button-args))) - (from (point)) - child button) - (insert (widget-get widget :entry-format)) - (goto-char from) - ;; Parse % escapes in format. - (while (re-search-forward "%\\([bv%]\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (cond ((eq escape ?%) - (insert "%")) - ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert - widget 'checkbox - :value (not (null chosen)) - button-args))) - ((eq escape ?v) - (setq child - (cond ((not chosen) - (let ((child (widget-create-child widget type))) - (widget-apply child :deactivate) - child)) - ((widget-get type :inline) - (widget-create-child-value - widget type (cdr chosen))) - (t - (widget-create-child-value - widget type (car (cdr chosen))))))) - (t - (signal 'error (list "Unknown escape" escape)))))) - ;; Update properties. - (and button child (widget-put child :button button)) - (and button (widget-put widget :buttons (cons button buttons))) - (and child (widget-put widget :children (cons child children)))))) - -(defun widget-checklist-match (widget values) - ;; All values must match a type in the checklist. - (and (listp values) - (null (cdr (widget-checklist-match-inline widget values))))) - -(defun widget-checklist-match-inline (widget values) - ;; Find the values which match a type in the checklist. - (let ((greedy (widget-get widget :greedy)) - (args (copy-sequence (widget-get widget :args))) - found rest) - (while values - (let ((answer (widget-checklist-match-up args values))) - (cond (answer - (let ((vals (widget-match-inline answer values))) - (setq found (append found (car vals)) - values (cdr vals) - args (delq answer args)))) - (greedy - (setq rest (append rest (list (car values))) - values (cdr values))) - (t - (setq rest (append rest values) - values nil))))) - (cons found rest))) - -(defun widget-checklist-match-find (widget vals) - ;; Find the vals which match a type in the checklist. - ;; Return an alist of (TYPE MATCH). - (let ((greedy (widget-get widget :greedy)) - (args (copy-sequence (widget-get widget :args))) - found) - (while vals - (let ((answer (widget-checklist-match-up args vals))) - (cond (answer - (let ((match (widget-match-inline answer vals))) - (setq found (cons (cons answer (car match)) found) - vals (cdr match) - args (delq answer args)))) - (greedy - (setq vals (cdr vals))) - (t - (setq vals nil))))) - found)) - -(defun widget-checklist-match-up (args vals) - ;; Rerturn the first type from ARGS that matches VALS. - (let (current found) - (while (and args (null found)) - (setq current (car args) - args (cdr args) - found (widget-match-inline current vals))) - (if found - current - nil))) - -(defun widget-checklist-value-get (widget) - ;; The values of all selected items. - (let ((children (widget-get widget :children)) - child result) - (while children - (setq child (car children) - children (cdr children)) - (if (widget-value (widget-get child :button)) - (setq result (append result (widget-apply child :value-inline))))) - result)) - -(defun widget-checklist-validate (widget) - ;; Ticked chilren must be valid. - (let ((children (widget-get widget :children)) - child button found) - (while (and children (not found)) - (setq child (car children) - children (cdr children) - button (widget-get child :button) - found (and (widget-value button) - (widget-apply child :validate)))) - found)) - -;;; The `option' Widget - -(define-widget 'option 'checklist - "An widget with an optional item." - :inline t) - -;;; The `choice-item' Widget. - -(define-widget 'choice-item 'item - "Button items that delegate action events to their parents." - :action 'widget-parent-action - :format "%[%t%] \n") - -;;; The `radio-button' Widget. - -(define-widget 'radio-button 'toggle - "A radio button for use in the `radio' widget." - :notify 'widget-radio-button-notify - :format "%[%v%]" - :button-suffix "" - :button-prefix "" - :on "(*)" - :on-glyph '("radio1" nil "radio0") - :off "( )" - :off-glyph "radio0") - -(defun widget-radio-button-notify (widget child &optional event) - ;; Tell daddy. - (widget-apply (widget-get widget :parent) :action widget event)) - -;;; The `radio-button-choice' Widget. - -(define-widget 'radio-button-choice 'default - "Select one of multiple options." - :convert-widget 'widget-types-convert-widget - :offset 4 - :format "%v" - :entry-format "%b %v" - :menu-tag "radio" - :value-create 'widget-radio-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-radio-value-get - :value-inline 'widget-radio-value-inline - :value-set 'widget-radio-value-set - :error "You must push one of the buttons" - :validate 'widget-radio-validate - :match 'widget-choice-match - :match-inline 'widget-choice-match-inline - :action 'widget-radio-action) - -(defun widget-radio-value-create (widget) - ;; Insert all values - (let ((args (widget-get widget :args)) - arg) - (while args - (setq arg (car args) - args (cdr args)) - (widget-radio-add-item widget arg)))) - -(defun widget-radio-add-item (widget type) - "Add to radio widget WIDGET a new radio button item of type TYPE." - ;; (setq type (widget-convert type)) - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - (widget-specify-insert - (let* ((value (widget-get widget :value)) - (children (widget-get widget :children)) - (buttons (widget-get widget :buttons)) - (button-args (or (widget-get type :sibling-args) - (widget-get widget :button-args))) - (from (point)) - (chosen (and (null (widget-get widget :choice)) - (widget-apply type :match value))) - child button) - (insert (widget-get widget :entry-format)) - (goto-char from) - ;; Parse % escapes in format. - (while (re-search-forward "%\\([bv%]\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (cond ((eq escape ?%) - (insert "%")) - ((eq escape ?b) - (setq button (apply 'widget-create-child-and-convert - widget 'radio-button - :value (not (null chosen)) - button-args))) - ((eq escape ?v) - (setq child (if chosen - (widget-create-child-value - widget type value) - (widget-create-child widget type))) - (unless chosen - (widget-apply child :deactivate))) - (t - (signal 'error (list "Unknown escape" escape)))))) - ;; Update properties. - (when chosen - (widget-put widget :choice type)) - (when button - (widget-put child :button button) - (widget-put widget :buttons (nconc buttons (list button)))) - (when child - (widget-put widget :children (nconc children (list child)))) - child))) - -(defun widget-radio-value-get (widget) - ;; Get value of the child widget. - (let ((chosen (widget-radio-chosen widget))) - (and chosen (widget-value chosen)))) - -(defun widget-radio-chosen (widget) - "Return the widget representing the chosen radio button." - (let ((children (widget-get widget :children)) - current found) - (while children - (setq current (car children) - children (cdr children)) - (let* ((button (widget-get current :button)) - (value (widget-apply button :value-get))) - (when value - (setq found current - children nil)))) - found)) - -(defun widget-radio-value-inline (widget) - ;; Get value of the child widget. - (let ((children (widget-get widget :children)) - current found) - (while children - (setq current (car children) - children (cdr children)) - (let* ((button (widget-get current :button)) - (value (widget-apply button :value-get))) - (when value - (setq found (widget-apply current :value-inline) - children nil)))) - found)) - -(defun widget-radio-value-set (widget value) - ;; We can't just delete and recreate a radio widget, since children - ;; can be added after the original creation and won't be recreated - ;; by `:create'. - (let ((children (widget-get widget :children)) - current found) - (while children - (setq current (car children) - children (cdr children)) - (let* ((button (widget-get current :button)) - (match (and (not found) - (widget-apply current :match value)))) - (widget-value-set button match) - (if match - (progn - (widget-value-set current value) - (widget-apply current :activate)) - (widget-apply current :deactivate)) - (setq found (or found match)))))) - -(defun widget-radio-validate (widget) - ;; Valid if we have made a valid choice. - (let ((children (widget-get widget :children)) - current found button) - (while (and children (not found)) - (setq current (car children) - children (cdr children) - button (widget-get current :button) - found (widget-apply button :value-get))) - (if found - (widget-apply current :validate) - widget))) - -(defun widget-radio-action (widget child event) - ;; Check if a radio button was pressed. - (let ((children (widget-get widget :children)) - (buttons (widget-get widget :buttons)) - current) - (when (memq child buttons) - (while children - (setq current (car children) - children (cdr children)) - (let* ((button (widget-get current :button))) - (cond ((eq child button) - (widget-value-set button t) - (widget-apply current :activate)) - ((widget-value button) - (widget-value-set button nil) - (widget-apply current :deactivate))))))) - ;; Pass notification to parent. - (widget-apply widget :notify child event)) - -;;; The `insert-button' Widget. - -(define-widget 'insert-button 'push-button - "An insert button for the `editable-list' widget." - :tag "INS" - :help-echo "Insert a new item into the list at this position" - :action 'widget-insert-button-action) - -(defun widget-insert-button-action (widget &optional event) - ;; Ask the parent to insert a new item. - (widget-apply (widget-get widget :parent) - :insert-before (widget-get widget :widget))) - -;;; The `delete-button' Widget. - -(define-widget 'delete-button 'push-button - "A delete button for the `editable-list' widget." - :tag "DEL" - :help-echo "Delete this item from the list" - :action 'widget-delete-button-action) - -(defun widget-delete-button-action (widget &optional event) - ;; Ask the parent to insert a new item. - (widget-apply (widget-get widget :parent) - :delete-at (widget-get widget :widget))) - -;;; The `editable-list' Widget. - -(defcustom widget-editable-list-gui nil - "If non nil, use GUI push-buttons in editable list when available." - :type 'boolean - :group 'widgets) - -(define-widget 'editable-list 'default - "A variable list of widgets of the same type." - :convert-widget 'widget-types-convert-widget - :offset 12 - :format "%v%i\n" - :format-handler 'widget-editable-list-format-handler - :entry-format "%i %d %v" - :menu-tag "editable-list" - :value-create 'widget-editable-list-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-editable-list-value-get - :validate 'widget-children-validate - :match 'widget-editable-list-match - :match-inline 'widget-editable-list-match-inline - :insert-before 'widget-editable-list-insert-before - :delete-at 'widget-editable-list-delete-at) - -(defun widget-editable-list-format-handler (widget escape) - ;; We recognize the insert button. - (let ((widget-push-button-gui widget-editable-list-gui)) - (cond ((eq escape ?i) - (and (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - (apply 'widget-create-child-and-convert - widget 'insert-button - (widget-get widget :append-button-args))) - (t - (widget-default-format-handler widget escape))))) - -(defun widget-editable-list-value-create (widget) - ;; Insert all values - (let* ((value (widget-get widget :value)) - (type (nth 0 (widget-get widget :args))) - (inlinep (widget-get type :inline)) - children) - (widget-put widget :value-pos (copy-marker (point))) - (set-marker-insertion-type (widget-get widget :value-pos) t) - (while value - (let ((answer (widget-match-inline type value))) - (if answer - (setq children (cons (widget-editable-list-entry-create - widget - (if inlinep - (car answer) - (car (car answer))) - t) - children) - value (cdr answer)) - (setq value nil)))) - (widget-put widget :children (nreverse children)))) - -(defun widget-editable-list-value-get (widget) - ;; Get value of the child widget. - (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline)) - (widget-get widget :children)))) - -(defun widget-editable-list-match (widget value) - ;; Value must be a list and all the members must match the type. - (and (listp value) - (null (cdr (widget-editable-list-match-inline widget value))))) - -(defun widget-editable-list-match-inline (widget value) - (let ((type (nth 0 (widget-get widget :args))) - (ok t) - found) - (while (and value ok) - (let ((answer (widget-match-inline type value))) - (if answer - (setq found (append found (car answer)) - value (cdr answer)) - (setq ok nil)))) - (cons found value))) - -(defun widget-editable-list-insert-before (widget before) - ;; Insert a new child in the list of children. - (save-excursion - (let ((children (widget-get widget :children)) - (inhibit-read-only t) - before-change-functions - after-change-functions) - (cond (before - (goto-char (widget-get before :entry-from))) - (t - (goto-char (widget-get widget :value-pos)))) - (let ((child (widget-editable-list-entry-create - widget nil nil))) - (when (< (widget-get child :entry-from) (widget-get widget :from)) - (set-marker (widget-get widget :from) - (widget-get child :entry-from))) - (if (eq (car children) before) - (widget-put widget :children (cons child children)) - (while (not (eq (car (cdr children)) before)) - (setq children (cdr children))) - (setcdr children (cons child (cdr children))))))) - (widget-setup) - (widget-apply widget :notify widget)) - -(defun widget-editable-list-delete-at (widget child) - ;; Delete child from list of children. - (save-excursion - (let ((buttons (copy-sequence (widget-get widget :buttons))) - button - (inhibit-read-only t) - before-change-functions - after-change-functions) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (when (eq (widget-get button :widget) child) - (widget-put widget - :buttons (delq button (widget-get widget :buttons))) - (widget-delete button)))) - (let ((entry-from (widget-get child :entry-from)) - (entry-to (widget-get child :entry-to)) - (inhibit-read-only t) - before-change-functions - after-change-functions) - (widget-delete child) - (delete-region entry-from entry-to) - (set-marker entry-from nil) - (set-marker entry-to nil)) - (widget-put widget :children (delq child (widget-get widget :children)))) - (widget-setup) - (widget-apply widget :notify widget)) - -(defun widget-editable-list-entry-create (widget value conv) - ;; Create a new entry to the list. - (let ((type (nth 0 (widget-get widget :args))) - (widget-push-button-gui widget-editable-list-gui) - child delete insert) - (widget-specify-insert - (save-excursion - (and (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - (insert (widget-get widget :entry-format))) - ;; Parse % escapes in format. - (while (re-search-forward "%\\(.\\)" nil t) - (let ((escape (aref (match-string 1) 0))) - (replace-match "" t t) - (cond ((eq escape ?%) - (insert "%")) - ((eq escape ?i) - (setq insert (apply 'widget-create-child-and-convert - widget 'insert-button - (widget-get widget :insert-button-args)))) - ((eq escape ?d) - (setq delete (apply 'widget-create-child-and-convert - widget 'delete-button - (widget-get widget :delete-button-args)))) - ((eq escape ?v) - (if conv - (setq child (widget-create-child-value - widget type value)) - (setq child (widget-create-child-value - widget type (widget-default-get type))))) - (t - (signal 'error (list "Unknown escape" escape)))))) - (widget-put widget - :buttons (cons delete - (cons insert - (widget-get widget :buttons)))) - (let ((entry-from (copy-marker (point-min))) - (entry-to (copy-marker (point-max)))) - (set-marker-insertion-type entry-from t) - (set-marker-insertion-type entry-to nil) - (widget-put child :entry-from entry-from) - (widget-put child :entry-to entry-to))) - (widget-put insert :widget child) - (widget-put delete :widget child) - child)) - -;;; The `group' Widget. - -(define-widget 'group 'default - "A widget which group other widgets inside." - :convert-widget 'widget-types-convert-widget - :format "%v" - :value-create 'widget-group-value-create - :value-delete 'widget-children-value-delete - :value-get 'widget-editable-list-value-get - :default-get 'widget-group-default-get - :validate 'widget-children-validate - :match 'widget-group-match - :match-inline 'widget-group-match-inline) - -(defun widget-group-value-create (widget) - ;; Create each component. - (let ((args (widget-get widget :args)) - (value (widget-get widget :value)) - arg answer children) - (while args - (setq arg (car args) - args (cdr args) - answer (widget-match-inline arg value) - value (cdr answer)) - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\ (widget-get widget :indent))) - (push (cond ((null answer) - (widget-create-child widget arg)) - ((widget-get arg :inline) - (widget-create-child-value widget arg (car answer))) - (t - (widget-create-child-value widget arg (car (car answer))))) - children)) - (widget-put widget :children (nreverse children)))) - -(defun widget-group-default-get (widget) - ;; Get the default of the components. - (mapcar 'widget-default-get (widget-get widget :args))) - -(defun widget-group-match (widget values) - ;; Match if the components match. - (and (listp values) - (let ((match (widget-group-match-inline widget values))) - (and match (null (cdr match)))))) - -(defun widget-group-match-inline (widget vals) - ;; Match if the components match. - (let ((args (widget-get widget :args)) - argument answer found) - (while args - (setq argument (car args) - args (cdr args) - answer (widget-match-inline argument vals)) - (if answer - (setq vals (cdr answer) - found (append found (car answer))) - (setq vals nil - args nil))) - (if answer - (cons found vals) - nil))) - -;;; The `visibility' Widget. - -(define-widget 'visibility 'item - "An indicator and manipulator for hidden items." - :format "%[%v%]" - :button-prefix "" - :button-suffix "" - :on "Hide" - :off "Show" - :value-create 'widget-visibility-value-create - :action 'widget-toggle-action - :match (lambda (widget value) t)) - -(defun widget-visibility-value-create (widget) - ;; Insert text representing the `on' and `off' states. - (let ((on (widget-get widget :on)) - (off (widget-get widget :off))) - (if on - (setq on (concat widget-push-button-prefix - on - widget-push-button-suffix)) - (setq on "")) - (if off - (setq off (concat widget-push-button-prefix - off - widget-push-button-suffix)) - (setq off "")) - (if (widget-value widget) - (widget-glyph-insert widget on '("down" "down-pushed")) - (widget-glyph-insert widget off '("right" "right-pushed"))))) - -;;; The `documentation-link' Widget. -;; -;; This is a helper widget for `documentation-string'. - -(define-widget 'documentation-link 'link - "Link type used in documentation strings." - :tab-order -1 - :help-echo 'widget-documentation-link-echo-help - :action 'widget-documentation-link-action) - -(defun widget-documentation-link-echo-help (widget) - "Tell what this link will describe." - (concat "Describe the `" (widget-get widget :value) "' symbol.")) - -(defun widget-documentation-link-action (widget &optional event) - "Display documentation for WIDGET's value. Ignore optional argument EVENT." - (let* ((string (widget-get widget :value)) - (symbol (intern string))) - (if (and (fboundp symbol) (boundp symbol)) - ;; If there are two doc strings, give the user a way to pick one. - (apropos (concat "\\`" (regexp-quote string) "\\'")) - (if (fboundp symbol) - (describe-function symbol) - (describe-variable symbol))))) - -(defcustom widget-documentation-links t - "Add hyperlinks to documentation strings when non-nil." - :type 'boolean - :group 'widget-documentation) - -(defcustom widget-documentation-link-regexp "`\\([^\n`' ]+\\)'" - "Regexp for matching potential links in documentation strings. -The first group should be the link itself." - :type 'regexp - :group 'widget-documentation) - -(defcustom widget-documentation-link-p 'intern-soft - "Predicate used to test if a string is useful as a link. -The value should be a function. The function will be called one -argument, a string, and should return non-nil if there should be a -link for that string." - :type 'function - :options '(widget-documentation-link-p) - :group 'widget-documentation) - -(defcustom widget-documentation-link-type 'documentation-link - "Widget type used for links in documentation strings." - :type 'symbol - :group 'widget-documentation) - -(defun widget-documentation-link-add (widget from to) - (widget-specify-doc widget from to) - (when widget-documentation-links - (let ((regexp widget-documentation-link-regexp) - (predicate widget-documentation-link-p) - (type widget-documentation-link-type) - (buttons (widget-get widget :buttons))) - (save-excursion - (goto-char from) - (while (re-search-forward regexp to t) - (let ((name (match-string 1)) - (begin (match-beginning 1)) - (end (match-end 1))) - (when (funcall predicate name) - (push (widget-convert-button type begin end :value name) - buttons))))) - (widget-put widget :buttons buttons))) - (let ((indent (widget-get widget :indent))) - (when (and indent (not (zerop indent))) - (save-excursion - (save-restriction - (narrow-to-region from to) - (goto-char (point-min)) - (while (search-forward "\n" nil t) - (insert-char ?\ indent))))))) - -;;; The `documentation-string' Widget. - -(define-widget 'documentation-string 'item - "A documentation string." - :format "%v" - :action 'widget-documentation-string-action - :value-delete 'widget-children-value-delete - :value-create 'widget-documentation-string-value-create) - -(defun widget-documentation-string-value-create (widget) - ;; Insert documentation string. - (let ((doc (widget-value widget)) - (indent (widget-get widget :indent)) - (shown (widget-get (widget-get widget :parent) :documentation-shown)) - (start (point))) - (if (string-match "\n" doc) - (let ((before (substring doc 0 (match-beginning 0))) - (after (substring doc (match-beginning 0))) - buttons) - (insert before " ") - (widget-documentation-link-add widget start (point)) - (push (widget-create-child-and-convert - widget 'visibility - :help-echo (lambda (widget) - (concat - (if (widget-value widget) - "Hide" "Show") - " the rest of the documentation")) - :off "More" - :action 'widget-parent-action - shown) - buttons) - (when shown - (setq start (point)) - (when indent - (insert-char ?\ indent)) - (insert after) - (widget-documentation-link-add widget start (point))) - (widget-put widget :buttons buttons)) - (insert doc) - (widget-documentation-link-add widget start (point)))) - (insert "\n")) - -(defun widget-documentation-string-action (widget &rest ignore) - ;; Toggle documentation. - (let ((parent (widget-get widget :parent))) - (widget-put parent :documentation-shown - (not (widget-get parent :documentation-shown)))) - ;; Redraw. - (widget-value-set widget (widget-value widget))) - -;;; The Sexp Widgets. - -(define-widget 'const 'item - "An immutable sexp." - :prompt-value 'widget-const-prompt-value - :format "%t\n%d") - -(defun widget-const-prompt-value (widget prompt value unbound) - ;; Return the value of the const. - (widget-value widget)) - -(define-widget 'function-item 'const - "An immutable function name." - :format "%v\n%h" - :documentation-property (lambda (symbol) - (condition-case nil - (documentation symbol t) - (error nil)))) - -(define-widget 'variable-item 'const - "An immutable variable name." - :format "%v\n%h" - :documentation-property 'variable-documentation) - -(defvar widget-string-prompt-value-history nil - "History of input to `widget-string-prompt-value'.") - -(define-widget 'string 'editable-field - "A string" - :tag "String" - :format "%{%t%}: %v" - :complete-function 'ispell-complete-word - :prompt-history 'widget-string-prompt-value-history) - -(define-widget 'regexp 'string - "A regular expression." - :match 'widget-regexp-match - :validate 'widget-regexp-validate - ;; Doesn't work well with terminating newline. - ;; :value-face 'widget-single-line-field-face - :tag "Regexp") - -(defun widget-regexp-match (widget value) - ;; Match valid regexps. - (and (stringp value) - (condition-case nil - (prog1 t - (string-match value "")) - (error nil)))) - -(defun widget-regexp-validate (widget) - "Check that the value of WIDGET is a valid regexp." - (let ((value (widget-value widget))) - (condition-case data - (prog1 nil - (string-match value "")) - (error (widget-put widget :error (error-message-string data)) - widget)))) - -(define-widget 'file 'string - "A file widget. -It will read a file name from the minibuffer when invoked." - :complete-function 'widget-file-complete - :prompt-value 'widget-file-prompt-value - :format "%{%t%}: %v" - ;; Doesn't work well with terminating newline. - ;; :value-face 'widget-single-line-field-face - :tag "File") - -(defun widget-file-complete () - "Perform completion on file name preceding point." - (interactive) - (let* ((end (point)) - (beg (save-excursion - (skip-chars-backward "^ ") - (point))) - (pattern (buffer-substring beg end)) - (name-part (file-name-nondirectory pattern)) - (directory (file-name-directory pattern)) - (completion (file-name-completion name-part directory))) - (cond ((eq completion t)) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= name-part completion)) - (delete-region beg end) - (insert (expand-file-name completion directory))) - (t - (message "Making completion list...") - (let ((list (file-name-all-completions name-part directory))) - (setq list (sort list 'string<)) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list))) - (message "Making completion list...%s" "done"))))) - -(defun widget-file-prompt-value (widget prompt value unbound) - ;; Read file from minibuffer. - (abbreviate-file-name - (if unbound - (read-file-name prompt) - (let ((prompt2 (format "%s (default %s) " prompt value)) - (dir (file-name-directory value)) - (file (file-name-nondirectory value)) - (must-match (widget-get widget :must-match))) - (read-file-name prompt2 dir nil must-match file))))) - -;;;(defun widget-file-action (widget &optional event) -;;; ;; Read a file name from the minibuffer. -;;; (let* ((value (widget-value widget)) -;;; (dir (file-name-directory value)) -;;; (file (file-name-nondirectory value)) -;;; (menu-tag (widget-apply widget :menu-tag-get)) -;;; (must-match (widget-get widget :must-match)) -;;; (answer (read-file-name (concat menu-tag ": (default `" value "') ") -;;; dir nil must-match file))) -;;; (widget-value-set widget (abbreviate-file-name answer)) -;;; (widget-setup) -;;; (widget-apply widget :notify widget event))) - -(define-widget 'directory 'file - "A directory widget. -It will read a directory name from the minibuffer when invoked." - :tag "Directory") - -(defvar widget-symbol-prompt-value-history nil - "History of input to `widget-symbol-prompt-value'.") - -(define-widget 'symbol 'editable-field - "A lisp symbol." - :value nil - :tag "Symbol" - :format "%{%t%}: %v" - :match (lambda (widget value) (symbolp value)) - :complete-function 'lisp-complete-symbol - :prompt-internal 'widget-symbol-prompt-internal - :prompt-match 'symbolp - :prompt-history 'widget-symbol-prompt-value-history - :value-to-internal (lambda (widget value) - (if (symbolp value) - (symbol-name value) - value)) - :value-to-external (lambda (widget value) - (if (stringp value) - (intern value) - value))) - -(defun widget-symbol-prompt-internal (widget prompt initial history) - ;; Read file from minibuffer. - (let ((answer (completing-read prompt obarray - (widget-get widget :prompt-match) - nil initial history))) - (if (and (stringp answer) - (not (zerop (length answer)))) - answer - (error "No value")))) - -(defvar widget-function-prompt-value-history nil - "History of input to `widget-function-prompt-value'.") - -(define-widget 'function 'sexp - "A lisp function." - :complete-function 'lisp-complete-symbol - :prompt-value 'widget-field-prompt-value - :prompt-internal 'widget-symbol-prompt-internal - :prompt-match 'fboundp - :prompt-history 'widget-function-prompt-value-history - :action 'widget-field-action - :tag "Function") - -(defvar widget-variable-prompt-value-history nil - "History of input to `widget-variable-prompt-value'.") - -(define-widget 'variable 'symbol - ;; Should complete on variables. - "A lisp variable." - :prompt-match 'boundp - :prompt-history 'widget-variable-prompt-value-history - :tag "Variable") - -;; This part issues a warning when compiling without Mule. Is there a -;; way of shutting it up? -;; -;; OK, I'll simply comment the whole thing out, until someone decides -;; to do something with it. -;(defvar widget-coding-system-prompt-value-history nil -; "History of input to `widget-coding-system-prompt-value'.") - -;(define-widget 'coding-system 'symbol -; "A MULE coding-system." -; :format "%{%t%}: %v" -; :tag "Coding system" -; :prompt-history 'widget-coding-system-prompt-value-history -; :prompt-value 'widget-coding-system-prompt-value -; :action 'widget-coding-system-action) - -;(defun widget-coding-system-prompt-value (widget prompt value unbound) -; ;; Read coding-system from minibuffer. -; (intern -; (completing-read (format "%s (default %s) " prompt value) -; (mapcar (lambda (sym) -; (list (symbol-name sym))) -; (coding-system-list))))) - -;(defun widget-coding-system-action (widget &optional event) -; ;; Read a file name from the minibuffer. -; (let ((answer -; (widget-coding-system-prompt-value -; widget -; (widget-apply widget :menu-tag-get) -; (widget-value widget) -; t))) -; (widget-value-set widget answer) -; (widget-apply widget :notify widget event) -; (widget-setup))) - -(define-widget 'sexp 'editable-field - "An arbitrary lisp expression." - :tag "Lisp expression" - :format "%{%t%}: %v" - :value nil - :validate 'widget-sexp-validate - :match (lambda (widget value) t) - :value-to-internal 'widget-sexp-value-to-internal - :value-to-external (lambda (widget value) (read value)) - :prompt-history 'widget-sexp-prompt-value-history - :prompt-value 'widget-sexp-prompt-value) - -(defun widget-sexp-value-to-internal (widget value) - ;; Use cl-prettyprint for printer representation. - (let ((pp (if (symbolp value) - (prin1-to-string value) - (widget-prettyprint-to-string value)))) - (if (> (length pp) 40) - (concat "\n" pp) - pp))) - -(defun widget-sexp-validate (widget) - ;; Valid if we can read the string and there is no junk left after it. - (save-excursion - (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*")))) - (erase-buffer) - (insert (widget-apply widget :value-get)) - (goto-char (point-min)) - (condition-case data - (let ((value (read buffer))) - (if (eobp) - (if (widget-apply widget :match value) - nil - (widget-put widget :error (widget-get widget :type-error)) - widget) - (widget-put widget - :error (format "Junk at end of expression: %s" - (buffer-substring (point) - (point-max)))) - widget)) - (error (widget-put widget :error (error-message-string data)) - widget))))) - -(defvar widget-sexp-prompt-value-history nil - "History of input to `widget-sexp-prompt-value'.") - -(defun widget-sexp-prompt-value (widget prompt value unbound) - ;; Read an arbitrary sexp. - (let ((found (read-string prompt - (if unbound nil (cons (prin1-to-string value) 0)) - (widget-get widget :prompt-history)))) - (save-excursion - (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*")))) - (erase-buffer) - (insert found) - (goto-char (point-min)) - (let ((answer (read buffer))) - (unless (eobp) - (signal 'error - (list "Junk at end of expression" - (buffer-substring (point) (point-max))))) - answer))))) - -(define-widget 'restricted-sexp 'sexp - "A Lisp expression restricted to values that match. -To use this type, you must define :match or :match-alternatives." - :type-error "The specified value is not valid" - :match 'widget-restricted-sexp-match - :value-to-internal (lambda (widget value) - (if (widget-apply widget :match value) - (prin1-to-string value) - value))) - -(defun widget-restricted-sexp-match (widget value) - (let ((alternatives (widget-get widget :match-alternatives)) - matched) - (while (and alternatives (not matched)) - (if (cond ((functionp (car alternatives)) - (funcall (car alternatives) value)) - ((and (consp (car alternatives)) - (eq (car (car alternatives)) 'quote)) - (eq value (nth 1 (car alternatives))))) - (setq matched t)) - (setq alternatives (cdr alternatives))) - matched)) - -(define-widget 'integer 'restricted-sexp - "An integer." - :tag "Integer" - :value 0 - :type-error "This field should contain an integer" - :match-alternatives '(integerp)) - -(define-widget 'number 'restricted-sexp - "A floating point number." - :tag "Number" - :value 0.0 - :type-error "This field should contain a number" - :match-alternatives '(numberp)) - -(define-widget 'character 'editable-field - "A character." - :tag "Character" - :value ?\0 - :format "%{%t%}: %v" - :valid-regexp "\\`[\0-\377]\\'" - :error "This field should contain a single character" - :value-to-internal (lambda (widget value) - (if (stringp value) - value - (char-to-string value))) - :value-to-external (lambda (widget value) - (if (stringp value) - (aref value 0) - value)) - :match (lambda (widget value) - (characterp value))) - -(define-widget 'list 'group - "A lisp list." - :tag "List" - :format "%{%t%}:\n%v") - -(define-widget 'vector 'group - "A lisp vector." - :tag "Vector" - :format "%{%t%}:\n%v" - :match 'widget-vector-match - :value-to-internal (lambda (widget value) (append value nil)) - :value-to-external (lambda (widget value) (vconcat value))) - -(defun widget-vector-match (widget value) - (and (vectorp value) - (widget-group-match widget - (widget-apply widget :value-to-internal value)))) - -(define-widget 'cons 'group - "A cons-cell." - :tag "Cons-cell" - :format "%{%t%}:\n%v" - :match 'widget-cons-match - :value-to-internal (lambda (widget value) - (list (car value) (cdr value))) - :value-to-external (lambda (widget value) - (cons (car value) (cadr value)))) - -(defun widget-cons-match (widget value) - (and (consp value) - (widget-group-match widget - (widget-apply widget :value-to-internal value)))) - -(define-widget 'choice 'menu-choice - "A union of several sexp types." - :tag "Choice" - :format "%{%t%}: %[Value Menu%] %v" - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :prompt-value 'widget-choice-prompt-value) - -(defun widget-choice-prompt-value (widget prompt value unbound) - "Make a choice." - (let ((args (widget-get widget :args)) - (completion-ignore-case (widget-get widget :case-fold)) - current choices old) - ;; Find the first arg that match VALUE. - (let ((look args)) - (while look - (if (widget-apply (car look) :match value) - (setq old (car look) - look nil) - (setq look (cdr look))))) - ;; Find new choice. - (setq current - (cond ((= (length args) 0) - nil) - ((= (length args) 1) - (nth 0 args)) - ((and (= (length args) 2) - (memq old args)) - (if (eq old (nth 0 args)) - (nth 1 args) - (nth 0 args))) - (t - (while args - (setq current (car args) - args (cdr args)) - (setq choices - (cons (cons (widget-apply current :menu-tag-get) - current) - choices))) - (let ((val (completing-read prompt choices nil t))) - (if (stringp val) - (let ((try (try-completion val choices))) - (when (stringp try) - (setq val try)) - (cdr (assoc val choices))) - nil))))) - (if current - (widget-prompt-value current prompt nil t) - value))) - -(define-widget 'radio 'radio-button-choice - "A union of several sexp types." - :tag "Choice" - :format "%{%t%}:\n%v" - :prompt-value 'widget-choice-prompt-value) - -(define-widget 'repeat 'editable-list - "A variable length homogeneous list." - :tag "Repeat" - :format "%{%t%}:\n%v%i\n") - -(define-widget 'set 'checklist - "A list of members from a fixed set." - :tag "Set" - :format "%{%t%}:\n%v") - -(define-widget 'boolean 'toggle - "To be nil or non-nil, that is the question." - :tag "Boolean" - :prompt-value 'widget-boolean-prompt-value - :button-prefix 'widget-push-button-prefix - :button-suffix 'widget-push-button-suffix - :format "%{%t%}: %[Toggle%] %v\n" - :on "on (non-nil)" - :off "off (nil)") - -(defun widget-boolean-prompt-value (widget prompt value unbound) - ;; Toggle a boolean. - (y-or-n-p prompt)) - -;;; The `color' Widget. - -(define-widget 'color 'editable-field - "Choose a color name (with sample)." - :format "%[%t%]: %v (%{sample%})\n" - :size 10 - :tag "Color" - :value "black" - :complete 'widget-color-complete - :sample-face-get 'widget-color-sample-face-get - :notify 'widget-color-notify - :action 'widget-color-action) - -(defun widget-color-complete (widget) - "Complete the color in WIDGET." - (let* ((prefix (buffer-substring-no-properties (widget-field-start widget) - (point))) - (list (read-color-completion-table)) - (completion (try-completion prefix list))) - (cond ((eq completion t) - (message "Exact match")) - ((null completion) - (error "Can't find completion for \"%s\"" prefix)) - ((not (string-equal prefix completion)) - (insert (substring completion (length prefix)))) - (t - (message "Making completion list...") - (let ((list (all-completions prefix list nil))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list))) - (message "Making completion list...done"))))) - -(defun widget-color-sample-face-get (widget) - (or (widget-get widget :sample-face) - (let ((color (widget-value widget)) - (face (make-face (gensym "sample-face-") nil t))) - ;; Use the face object, not its name, to prevent lossage if gc - ;; happens before applying the face. - (widget-put widget :sample-face face) - (and color - (not (equal color "")) - (valid-color-name-p color) - (set-face-foreground face color)) - face))) - -(defvar widget-color-history nil - "History of entered colors.") - -(defun widget-color-action (widget &optional event) - ;; Prompt for a color. - (let* ((tag (widget-apply widget :menu-tag-get)) - (answer (read-color (concat tag ": ")))) - (unless (zerop (length answer)) - (widget-value-set widget answer) - (widget-setup) - (widget-apply widget :notify widget event)))) - -(defun widget-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 (valid-color-name-p color) - (set-face-foreground face color) - (remove-face-property face 'foreground))) - (widget-default-notify widget child event)) - -;; Is this a misnomer? -(defun widget-at (pos) - "The button or field at POS." - (or (get-char-property pos 'button) - (get-char-property pos 'field))) - -(defun widget-echo-help (pos) - "Display the help echo for widget at POS." - (let* ((widget (widget-at pos)) - (help-echo (and widget (widget-get widget :help-echo)))) - (and (functionp help-echo) - (setq help-echo (funcall help-echo widget))) - (when (stringp help-echo) - (display-message 'help-echo help-echo)))) - -;;; The End: - -(provide 'wid-edit) - -;; wid-edit.el ends here diff --git a/lisp/widget.el b/lisp/widget.el deleted file mode 100644 index 0586999..0000000 --- a/lisp/widget.el +++ /dev/null @@ -1,76 +0,0 @@ -;;; widget.el --- a library of user interface components. - -;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Maintainer: Hrvoje Niksic -;; Keywords: help, extensions, faces, hypermedia, dumped -;; Version: 1.9960-x -;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ - -;; 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 file is dumped with XEmacs. - -;; If you want to use this code, please visit the URL above. - -;; This file only contain the code needed to define new widget types. -;; Everything else is autoloaded from `wid-edit.el'. - -;;; Code: - -;; Neither XEmacs, nor latest GNU Emacs need this -- provided for -;; compatibility. -;; (defalias 'define-widget-keywords 'ignore) - -(defmacro define-widget-keywords (&rest keys) - "This doesn't do anything in Emacs 20 or XEmacs." - `(eval-and-compile - (let ((keywords (quote ,keys))) - (while keywords - (or (boundp (car keywords)) - (set (car keywords) (car keywords))) - (setq keywords (cdr keywords)))))) - -(defun define-widget (name class doc &rest args) - "Define a new widget type named NAME from CLASS. - -NAME and CLASS should both be symbols, CLASS should be one of the -existing widget types, or nil to create the widget from scratch. - -After the new widget has been defined, the following two calls will -create identical widgets: - -* (widget-create NAME) - -* (apply 'widget-create CLASS ARGS) - -The third argument DOC is a documentation string for the widget." - (check-argument-type 'symbolp name) - (check-argument-type 'symbolp class) - (put name 'widget-type (cons class args)) - (put name 'widget-documentation doc) - name) - -;;; The End. - -(provide 'widget) - -;;; widget.el ends here diff --git a/lisp/window-xemacs.el b/lisp/window-xemacs.el deleted file mode 100644 index 554ec53..0000000 --- a/lisp/window-xemacs.el +++ /dev/null @@ -1,613 +0,0 @@ -;;; window-xemacs.el --- XEmacs window commands aside from those written in C. - -;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: frames, extensions, dumped - -;; 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. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;; slb - 5/29/97 -;; Split apart from window.el in order to keep that file better in synch -;; with Emacs. - -;;; Code: - -(defgroup windows nil - "Windows within a frame." - :group 'environment) - -(defun recenter (&optional n window) - "Center point in WINDOW and redisplay frame. With N, put point on line N. -The desired position of point is always relative to the window. -Just C-u as prefix means put point in the center of the window. -No N (i.e., it is nil) erases the entire frame and then -redraws with point in the center of the window. -If WINDOW is nil, the selected window is used." - (interactive "_P") - (center-to-window-line (if (consp n) nil n) window) - (when (null n) - (redraw-frame (window-frame window) t))) - -(defun backward-other-window (arg &optional all-frames device) - "Select the ARG'th different window on this frame, going backwards. -This is just like calling `other-window' with the arg negated." - (interactive "p") - (other-window (- arg) all-frames device)) - -(defalias 'windows-of-buffer 'get-buffer-window-list) - -(defun buffer-in-multiple-windows-p (&optional buffer) - "Return t if BUFFER is in multiple windows. -If BUFFER is not specified, the current buffer will be used." - (setq buffer (or buffer - (get-buffer buffer) - (get-file-buffer buffer) - (current-buffer))) - (> (length (windows-of-buffer buffer)) 1)) - -(defun window-list (&optional frame minibuf window) - "Return a list of windows on FRAME, beginning with WINDOW. -FRAME and WINDOW default to the selected ones. -Optional second arg MINIBUF t means count the minibuffer window -even if not active. If MINIBUF is neither t nor nil it means -not to count the minibuffer even if it is active." - (setq window (or window (selected-window)) - frame (or frame (selected-frame))) - (if (not (eq (window-frame window) frame)) - (error "Window must be on frame.")) - (let ((current-frame (selected-frame)) - list) - (unwind-protect - (save-window-excursion - (select-frame frame) - (walk-windows - (function (lambda (cur-window) - (if (not (eq window cur-window)) - (setq list (cons cur-window list))))) - minibuf) - (setq list (cons window list))) - (select-frame current-frame)))) - -;; We used to have set-window-dedicated-p as an obsolete version -;; of set-window-buffer-dedicated, but it really makes more sense -;; this way. - -(make-obsolete 'set-window-buffer-dedicated 'set-window-dedicated-p) -(defun set-window-buffer-dedicated (window buffer) - "Make WINDOW display BUFFER and be dedicated to that buffer. -Then Emacs will not automatically change which buffer appears in WINDOW. -If BUFFER is nil, make WINDOW not be dedicated (but don't change which -buffer appears in it currently)." - (if (bufferp buffer) - (set-window-buffer window (get-buffer-create buffer))) - (set-window-dedicated-p window (not (null buffer)))) - - -;; The window-config stack is stored as a list in frame property -;; 'window-config-stack, with the most recent element at the front. -;; When you pop off an element, the popped off element gets put at the -;; front of frame property 'window-config-unpop-stack, so you can -;; retrieve it using unpop-window-configuration. - -(defcustom window-config-stack-max 16 - "*Maximum size of window configuration stack. -Start discarding off end if it gets this big." - :type 'integer - :group 'windows) - -(defun window-config-stack (&optional frame) - (or frame (setq frame (selected-frame))) - (let ((stack (frame-property frame 'window-config-stack))) - (if stack - (set-undoable-stack-max stack window-config-stack-max) - (progn - (setq stack (make-undoable-stack window-config-stack-max)) - (set-frame-property frame 'window-config-stack stack))) - stack)) - -(defun push-window-configuration (&optional config) - "Push the current window configuration onto the window-config stack. -If CONFIG is specified, push it instead of the current window configuration. -Each frame has its own window-config stack." - (interactive) - (let ((wc (or config (current-window-configuration))) - (stack (window-config-stack))) - (if (or (= 0 (undoable-stack-a-length stack)) - (not (equal (undoable-stack-a-top stack) wc))) - (undoable-stack-push stack wc)))) - -(defun pop-window-configuration () - "Pop the top window configuration off the window-config stack and set it. -Before setting the new window configuration, the current window configuration - is pushed onto the \"unpop\" stack. -`unpop-window-configuration' undoes what this function does. -Each frame has its own window-config and \"unpop\" stack." - (interactive) - (let ((stack (window-config-stack)) - (wc (current-window-configuration)) - popped) - (condition-case nil - (progn - (setq popped (undoable-stack-pop stack)) - (while (equal popped wc) - (setq popped (undoable-stack-pop stack))) - (undoable-stack-push stack wc) - (undoable-stack-undo stack) - (set-window-configuration popped) - popped) - (trunc-stack-bottom - (error "Bottom of window config stack"))))) - -(defun unpop-window-configuration () - "Undo the effect of the most recent `pop-window-configuration'. -This does exactly the inverse of what `pop-window-configuration' does: - i.e. it pops a window configuration off of the \"unpop\" stack and - pushes the current window configuration onto the window-config stack. -Each frame has its own window-config and \"unpop\" stack." - (interactive) - (let ((stack (window-config-stack)) - (wc (current-window-configuration)) - popped) - (condition-case nil - (progn - (setq popped - (progn - (undoable-stack-redo stack) - (undoable-stack-pop stack))) - (while (equal popped wc) - (setq popped - (progn - (undoable-stack-redo stack) - (undoable-stack-pop stack)))) - (undoable-stack-push stack wc) - (set-window-configuration popped) - popped) - (trunc-stack-bottom - (error "Top of window config stack"))))) - - -;;;;;;;;;;;;; display-buffer, moved here from C. Hallelujah. - -(defvar display-buffer-function nil - "If non-nil, function to call to handle `display-buffer'. -It will receive three args: the same as those to `display-buffer'.") - -(defvar pre-display-buffer-function nil - "If non-nil, function that will be called from `display-buffer' -as the first action. It will receive three args: the same as those -to `display-buffer'. -This function may be used to select an appropriate frame for the buffer, -for example. See also the variable `display-buffer-function', which may -be used to completely replace the `display-buffer' function. -If the return value of this function is non-nil, it should be a frame, -and that frame will be used to display the buffer.") - -(defcustom pop-up-frames nil - "*Non-nil means `display-buffer' should make a separate frame." - :type 'boolean - :group 'frames) - -(defvar pop-up-frame-function nil - "Function to call to handle automatic new frame creation. -It is called with no arguments and should return a newly created frame. - -A typical value might be `(lambda () (new-frame pop-up-frame-alist))' -where `pop-up-frame-alist' would hold the default frame parameters.") - -(defcustom special-display-buffer-names nil - "*List of buffer names that should have their own special frames. -Displaying a buffer whose name is in this list makes a special frame for it -using `special-display-function'. - -An element of the list can be a cons cell instead of just a string. -Then the car should be a buffer name, and the cdr specifies frame -parameters for creating the frame for that buffer. -More precisely, the cdr is passed as the second argument to -the function found in `special-display-function', when making that frame. -See also `special-display-regexps'." - :type '(repeat (choice :value "" - (string :tag "Name") - (cons :menu-tag "Properties" - :value ("" . nil) - (string :tag "Name") - (repeat :tag "Properties" - (group :inline t - (symbol :tag "Property") - (sexp :tag "Value")))))) - :group 'frames) - -(defcustom special-display-regexps nil - "*List of regexps saying which buffers should have their own special frames. -If a buffer name matches one of these regexps, it gets its own frame. -Displaying a buffer whose name is in this list makes a special frame for it -using `special-display-function'. - -An element of the list can be a cons cell instead of just a string. -Then the car should be the regexp, and the cdr specifies frame -parameters for creating the frame for buffers that match. -More precisely, the cdr is passed as the second argument to -the function found in `special-display-function', when making that frame. -See also `special-display-buffer-names'." - :type '(repeat (choice :value "" - regexp - (cons :menu-tag "Properties" - :value ("" . nil) - regexp - (repeat :tag "Properties" - (group :inline t - (symbol :tag "Property") - (sexp :tag "Value")))))) - :group 'frames) - -(defvar special-display-function nil - "Function to call to make a new frame for a special buffer. -It is called with two arguments, the buffer and optional buffer specific -data, and should return a window displaying that buffer. -The default value makes a separate frame for the buffer, -using `special-display-frame-alist' to specify the frame parameters. - -A buffer is special if its is listed in `special-display-buffer-names' -or matches a regexp in `special-display-regexps'.") - -(defcustom same-window-buffer-names nil - "*List of buffer names that should appear in the selected window. -Displaying one of these buffers using `display-buffer' or `pop-to-buffer' -switches to it in the selected window, rather than making it appear -in some other window. - -An element of the list can be a cons cell instead of just a string. -Then the car must be a string, which specifies the buffer name. -This is for compatibility with `special-display-buffer-names'; -the cdr of the cons cell is ignored. - -See also `same-window-regexps'." - :type '(repeat (string :tag "Name")) - :group 'windows) - -(defcustom same-window-regexps nil - "*List of regexps saying which buffers should appear in the selected window. -If a buffer name matches one of these regexps, then displaying it -using `display-buffer' or `pop-to-buffer' switches to it -in the selected window, rather than making it appear in some other window. - -An element of the list can be a cons cell instead of just a string. -Then the car must be a string, which specifies the buffer name. -This is for compatibility with `special-display-buffer-names'; -the cdr of the cons cell is ignored. - -See also `same-window-buffer-names'." - :type '(repeat regexp) - :group 'windows) - -(defcustom pop-up-windows t - "*Non-nil means display-buffer should make new windows." - :type 'boolean - :group 'windows) - -(defcustom split-height-threshold 500 - "*display-buffer would prefer to split the largest window if this large. -If there is only one window, it is split regardless of this value." - :type 'integer - :group 'windows) - -(defcustom split-width-threshold 500 - "*display-buffer would prefer to split the largest window if this large. -If there is only one window, it is split regardless of this value." - :type 'integer - :group 'windows) - -;; Deiconify the frame containing the window WINDOW, then return WINDOW. - -(defun display-buffer-1 (window) - (if (frame-iconified-p (window-frame window)) - (make-frame-visible (window-frame window))) - window) - -;; Can you believe that all of this crap was formerly in C? -;; Praise Jesus that it's not there any more. - -(defun display-buffer (buffer &optional not-this-window-p override-frame) - "Make BUFFER appear in some window on the current frame, but don't select it. -BUFFER can be a buffer or a buffer name. -If BUFFER is shown already in some window in the current frame, -just uses that one, unless the window is the selected window and -NOT-THIS-WINDOW-P is non-nil (interactively, with prefix arg). - -If BUFFER has a dedicated frame, display on that frame instead of -the current frame, unless OVERRIDE-FRAME is non-nil. - -If OVERRIDE-FRAME is non-nil, display on that frame instead of -the current frame (or the dedicated frame). - -If `pop-up-windows' is non-nil, always use the -current frame and create a new window regardless of whether the -buffer has a dedicated frame, and regardless of whether -OVERRIDE-FRAME was specified. - -If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER. - -Returns the window displaying BUFFER." - (interactive "BDisplay buffer:\nP") - - (let ((wconfig (current-window-configuration)) - (result - ;; We just simulate a `return' in C. This function is way ugly - ;; and does `returns' all over the place and there's no sense - ;; in trying to rewrite it to be more Lispy. - (catch 'done - (let (window old-frame target-frame explicit-frame) - (setq old-frame (or (last-nonminibuf-frame) (selected-frame))) - (setq buffer (get-buffer buffer)) - (check-argument-type 'bufferp buffer) - - (setq explicit-frame - (if pre-display-buffer-function - (funcall pre-display-buffer-function buffer - not-this-window-p - override-frame))) - - ;; Give the user the ability to completely reimplement - ;; this function via the `display-buffer-function'. - (if display-buffer-function - (throw 'done - (funcall display-buffer-function buffer - not-this-window-p - override-frame))) - - ;; If the buffer has a dedicated frame, that takes - ;; precedence over the current frame, and over what the - ;; pre-display-buffer-function did. - (let ((dedi (buffer-dedicated-frame buffer))) - (if (frame-live-p dedi) (setq explicit-frame dedi))) - - ;; if override-frame is supplied, that takes precedence over - ;; everything. This is gonna look bad if the - ;; pre-display-buffer-function raised some other frame - ;; already. - (if override-frame - (progn - (check-argument-type 'frame-live-p override-frame) - (setq explicit-frame override-frame))) - - (setq target-frame - (or explicit-frame - (last-nonminibuf-frame) - (selected-frame))) - - ;; If we have switched frames, then set not-this-window-p - ;; to false. Switching frames means that selected-window - ;; is no longer the same as it was on entry -- it's the - ;; selected-window of target_frame instead of old_frame, - ;; so it's a fine candidate for display. - (if (not (eq old-frame target-frame)) - (setq not-this-window-p nil)) - - ;; if it's in the selected window, and that's ok, then we're done. - (if (and (not not-this-window-p) - (eq buffer (window-buffer (selected-window)))) - (throw 'done (display-buffer-1 (selected-window)))) - - ;; See if the user has specified this buffer should appear - ;; in the selected window. - - (if not-this-window-p - nil - - (if (or (member (buffer-name buffer) same-window-buffer-names) - (assoc (buffer-name buffer) same-window-buffer-names)) - (progn - (switch-to-buffer buffer) - (throw 'done (display-buffer-1 (selected-window))))) - - (let ((tem same-window-regexps)) - (while tem - (let ((car (car tem))) - (if (or - (and (stringp car) - (string-match car (buffer-name buffer))) - (and (consp car) (stringp (car car)) - (string-match (car car) (buffer-name buffer)))) - (progn - (switch-to-buffer buffer) - (throw 'done (display-buffer-1 - (selected-window)))))) - (setq tem (cdr tem))))) - - ;; If pop-up-frames, look for a window showing BUFFER on - ;; any visible or iconified frame. Otherwise search only - ;; the current frame. - (if (and (not explicit-frame) - (or pop-up-frames (not (last-nonminibuf-frame)))) - (setq target-frame 0)) - - ;; Otherwise, find some window that it's already in, and - ;; return that, unless that window is the selected window - ;; and that isn't ok. What a contorted mess! - (setq window (or (if (not explicit-frame) - ;; search the selected frame - ;; first if the user didn't - ;; specify an explicit frame. - (get-buffer-window buffer nil)) - (get-buffer-window buffer target-frame))) - (if (and window - (or (not not-this-window-p) - (not (eq window (selected-window))))) - (throw 'done (display-buffer-1 window))) - - ;; Certain buffer names get special handling. - (if special-display-function - (progn - (if (member (buffer-name buffer) - special-display-buffer-names) - (throw 'done (funcall special-display-function buffer))) - - (let ((tem (assoc (buffer-name buffer) - special-display-buffer-names))) - (if tem - (throw 'done (funcall special-display-function - buffer (cdr tem))))) - - (let ((tem special-display-regexps)) - (while tem - (let ((car (car tem))) - (if (and (stringp car) - (string-match car (buffer-name buffer))) - (throw 'done - (funcall special-display-function buffer))) - (if (and (consp car) - (stringp (car car)) - (string-match (car car) - (buffer-name buffer))) - (throw 'done (funcall - special-display-function buffer - (cdr car))))) - (setq tem (cdr tem)))))) - - ;; If there are no frames open that have more than a minibuffer, - ;; we need to create a new frame. - (if (or pop-up-frames - (null (last-nonminibuf-frame))) - (progn - (setq window (frame-selected-window - (funcall pop-up-frame-function))) - (set-window-buffer window buffer) - (throw 'done (display-buffer-1 window)))) - - ;; Otherwise, make it be in some window, splitting if - ;; appropriate/possible. Do not split a window if we are - ;; displaying the buffer in a different frame than that which - ;; was current when we were called. (It is already in a - ;; different window by virtue of being in another frame.) - (if (or (and pop-up-windows (eq target-frame old-frame)) - (eq 'only (frame-property (selected-frame) 'minibuffer)) - ;; If the current frame is a special display frame, - ;; don't try to reuse its windows. - (window-dedicated-p (frame-root-window (selected-frame)))) - (progn - (if (eq 'only (frame-property (selected-frame) 'minibuffer)) - (setq target-frame (last-nonminibuf-frame))) - - ;; Don't try to create a window if would get an error with - ;; height. - (if (< split-height-threshold (* 2 window-min-height)) - (setq split-height-threshold (* 2 window-min-height))) - - ;; Same with width. - (if (< split-width-threshold (* 2 window-min-width)) - (setq split-width-threshold (* 2 window-min-width))) - - ;; If the frame we would try to split cannot be split, - ;; try other frames. - (if (frame-property (if (null target-frame) - (selected-frame) - (last-nonminibuf-frame)) - 'unsplittable) - (setq window - ;; Try visible frames first. - (or (get-largest-window 'visible) - ;; If that didn't work, try iconified frames. - (get-largest-window 0) - (get-largest-window t))) - (setq window (get-largest-window target-frame))) - - ;; If we got a tall enough full-width window that - ;; can be split, split it. - (if (and window - (not (frame-property (window-frame window) - 'unsplittable)) - (>= (window-height window) split-height-threshold) - (or (>= (window-width window) - split-width-threshold) - (and (window-leftmost-p window) - (window-rightmost-p window)))) - (setq window (split-window window)) - (let (upper -;; lower - other) - (setq window (get-lru-window target-frame)) - ;; If the LRU window is selected, and big enough, - ;; and can be split, split it. - (if (and window - (not (frame-property (window-frame window) - 'unsplittable)) - (or (eq window (selected-window)) - (not (window-parent window))) - (>= (window-height window) - (* 2 window-min-height))) - (setq window (split-window window))) - ;; If get-lru-window returned nil, try other approaches. - ;; Try visible frames first. - (or window - (setq window (or (get-largest-window 'visible) - ;; If that didn't work, try - ;; iconified frames. - (get-largest-window 0) - ;; Try invisible frames. - (get-largest-window t) - ;; As a last resort, make - ;; a new frame. - (frame-selected-window - (funcall - pop-up-frame-function))))) - ;; If window appears above or below another, - ;; even out their heights. - (if (window-previous-child window) - (setq other (window-previous-child window) -;; lower window - upper other)) - (if (window-next-child window) - (setq other (window-next-child window) -;; lower other - upper window)) - ;; Check that OTHER and WINDOW are vertically arrayed. - (if (and other - (not (= (nth 1 (window-pixel-edges other)) - (nth 1 (window-pixel-edges window)))) - (> (window-pixel-height other) - (window-pixel-height window))) - (enlarge-window (- (/ (+ (window-height other) - (window-height window)) - 2) - (window-height upper)) - nil upper))))) - - (setq window (get-lru-window target-frame))) - - ;; Bring the window's previous buffer to the top of the MRU chain. - (if (window-buffer window) - (save-excursion - (save-selected-window - (select-window window) - (record-buffer (window-buffer window))))) - - (set-window-buffer window buffer) - - (display-buffer-1 window))))) - (or (equal wconfig (current-window-configuration)) - (push-window-configuration wconfig)) - result)) - -;;; window-xemacs.el ends here diff --git a/lisp/window.el b/lisp/window.el deleted file mode 100644 index faac28f..0000000 --- a/lisp/window.el +++ /dev/null @@ -1,355 +0,0 @@ -;;; window.el --- XEmacs window commands aside from those written in C. - -;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: frames, extensions, dumped - -;; 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: Emacs/Mule zeta. - -;;; Commentary: - -;; This file is dumped with XEmacs. - -;;; Code: - -;;;; Window tree functions. - -(defun one-window-p (&optional nomini all-frames device) - "Return non-nil if the selected window is the only window (in its frame). -Optional arg NOMINI non-nil means don't count the minibuffer -even if it is active. - -The optional arg ALL-FRAMES t means count windows on all frames. -If it is `visible', count windows on all visible frames. -ALL-FRAMES nil or omitted means count only the selected frame, -plus the minibuffer it uses (which may be on another frame). -ALL-FRAMES = 0 means count windows on all visible and iconified frames. -If ALL-FRAMES is any other value, count only the selected frame. - -If optional third argument DEVICE is nil or omitted, count frames -on all devices. -If a device, count frames only on that device. -If a device type, count frames only on devices of that type. -Otherwise, count frames only on the selected device." - (let ((base-window (selected-window))) - (if (and nomini (eq base-window (minibuffer-window))) - (setq base-window (next-window base-window))) - (eq base-window - (next-window base-window (if nomini 'arg) all-frames device)))) - -(defun walk-windows (proc &optional minibuf all-frames device) - "Cycle through all visible windows, calling PROC for each one. -PROC is called with a window as argument. - -Optional second arg MINIBUF t means count the minibuffer window even -if not active. MINIBUF nil or omitted means count the minibuffer iff -it is active. MINIBUF neither t nor nil means not to count the -minibuffer even if it is active. - -Several frames may share a single minibuffer; if the minibuffer -counts, all windows on all frames that share that minibuffer count -too. Therefore, when a separate minibuffer frame is active, -`walk-windows' includes the windows in the frame from which you -entered the minibuffer, as well as the minibuffer window. But if the -minibuffer does not count, only windows from WINDOW's frame count. - -ALL-FRAMES is the optional third argument. -ALL-FRAMES nil or omitted means cycle within the frames as specified above. -ALL-FRAMES = `visible' means include windows on all visible frames. -ALL-FRAMES = 0 means include windows on all visible and iconified frames. -ALL-FRAMES = t means include windows on all frames including invisible frames. -Anything else means restrict to WINDOW's frame. - -If optional fourth argument DEVICE is nil or omitted, include frames -on all devices. -If a device, include frames only on that device. -If a device type, include frames only on devices of that type. -Otherwise, include frames only on the selected device." - ;; If we start from the minibuffer window, don't fail to come back to it. - (if (window-minibuffer-p (selected-window)) - (setq minibuf t)) - ;; Note that, like next-window & previous-window, this behaves a little - ;; strangely if the selected window is on an invisible frame: it hits - ;; some of the windows on that frame, and all windows on visible frames. - (let* ((walk-windows-start (selected-window)) - (walk-windows-current walk-windows-start)) - (while (progn - (setq walk-windows-current - (next-window walk-windows-current minibuf all-frames - device)) - (funcall proc walk-windows-current) - (not (eq walk-windows-current walk-windows-start)))))) -;; The old XEmacs definition of the above clause. It's more correct in -;; that it will never hit a window that's already been hit even if you -;; do something odd like `delete-other-windows', but has the problem -;; that it conses. (This may be called repeatedly, from lazy-lock -;; for example.) -; (let* ((walk-windows-history nil) -; (walk-windows-current (selected-window))) -; (while (progn -; (setq walk-windows-current -; (next-window walk-windows-current minibuf all-frames -; device)) -; (not (memq walk-windows-current walk-windows-history))) -; (setq walk-windows-history (cons walk-windows-current -; walk-windows-history)) -; (funcall proc walk-windows-current)))) - -(defun minibuffer-window-active-p (window) - "Return t if WINDOW (a minibuffer window) is now active." - (eq window (active-minibuffer-window))) - -(defmacro save-selected-window (&rest body) - "Execute BODY, then select the window that was selected before BODY." - (list 'let - '((save-selected-window-window (selected-window))) - (list 'unwind-protect - (cons 'progn body) - (list 'and ; XEmacs - (list 'window-live-p 'save-selected-window-window) - (list 'select-window 'save-selected-window-window))))) - -(defun count-windows (&optional minibuf) - "Return the number of visible windows. -Optional arg MINIBUF non-nil means count the minibuffer -even if it is inactive." - (let ((count 0)) - (walk-windows (function (lambda (w) - (setq count (+ count 1)))) - minibuf) - count)) - -(defun balance-windows () - "Make all visible windows the same height (approximately)." - (interactive) - (let ((count -1) levels newsizes size) - ;FSFmacs - ;;; Don't count the lines that are above the uppermost windows. - ;;; (These are the menu bar lines, if any.) - ;(mbl (nth 1 (window-edges (frame-first-window (selected-frame)))))) - ;; Find all the different vpos's at which windows start, - ;; then count them. But ignore levels that differ by only 1. - (save-window-excursion - (let (tops (prev-top -2)) - (walk-windows (function (lambda (w) - (setq tops (cons (nth 1 (window-pixel-edges w)) - tops)))) - 'nomini) - (setq tops (sort tops '<)) - (while tops - (if (> (car tops) (1+ prev-top)) - (setq prev-top (car tops) - count (1+ count))) - (setq levels (cons (cons (car tops) count) levels)) - (setq tops (cdr tops))) - (setq count (1+ count)))) - ;; Subdivide the frame into that many vertical levels. - ;FSFmacs (setq size (/ (- (frame-height) mbl) count)) - (setq size (/ (window-pixel-height (frame-root-window)) count)) - (walk-windows (function - (lambda (w) - (select-window w) - (let ((newtop (cdr (assq (nth 1 (window-pixel-edges)) - levels))) - (newbot (or (cdr (assq - (+ (window-pixel-height) - (nth 1 (window-pixel-edges))) - levels)) - count))) - (setq newsizes - (cons (cons w (* size (- newbot newtop))) - newsizes))))) - 'nomini) - (walk-windows (function (lambda (w) - (select-window w) - (let ((newsize (cdr (assq w newsizes)))) - (enlarge-window - (/ (- newsize (window-pixel-height)) - (face-height 'default)))))) - 'nomini))) - -;;; I think this should be the default; I think people will prefer it--rms. -(defcustom split-window-keep-point t - "*If non-nil, split windows keeps the original point in both children. -This is often more convenient for editing. -If nil, adjust point in each of the two windows to minimize redisplay. -This is convenient on slow terminals, but point can move strangely." - :type 'boolean - :group 'windows) - -(defun split-window-vertically (&optional arg) - "Split current window into two windows, one above the other. -The uppermost window gets ARG lines and the other gets the rest. -Negative arg means select the size of the lowermost window instead. -With no argument, split equally or close to it. -Both windows display the same buffer now current. - -If the variable split-window-keep-point is non-nil, both new windows -will get the same value of point as the current window. This is often -more convenient for editing. - -Otherwise, we chose window starts so as to minimize the amount of -redisplay; this is convenient on slow terminals. The new selected -window is the one that the current value of point appears in. The -value of point can change if the text around point is hidden by the -new mode line. - -Programs should probably use split-window instead of this." - (interactive "P") - (let ((old-w (selected-window)) - (old-point (point)) - (size (and arg (prefix-numeric-value arg))) - (window-full-p nil) - new-w bottom moved) - (and size (< size 0) (setq size (+ (window-height) size))) - (setq new-w (split-window nil size)) - (or split-window-keep-point - (progn - (save-excursion - (set-buffer (window-buffer)) - (goto-char (window-start)) - (setq moved (vertical-motion (window-height))) - (set-window-start new-w (point)) - (if (> (point) (window-point new-w)) - (set-window-point new-w (point))) - (and (= moved (window-height)) - (progn - (setq window-full-p t) - (vertical-motion -1))) - (setq bottom (point))) - (and window-full-p - (<= bottom (point)) - (set-window-point old-w (1- bottom))) - (and window-full-p - (<= (window-start new-w) old-point) - (progn - (set-window-point new-w old-point) - (select-window new-w))))) - new-w)) - -(defun split-window-horizontally (&optional arg) - "Split current window into two windows side by side. -This window becomes the leftmost of the two, and gets ARG columns. -Negative arg means select the size of the rightmost window instead. -No arg means split equally." - (interactive "P") - (let ((size (and arg (prefix-numeric-value arg)))) - (and size (< size 0) - (setq size (+ (window-width) size))) - (split-window nil size t))) - -(defun enlarge-window-horizontally (arg) - "Make current window ARG columns wider." - (interactive "p") - (enlarge-window arg t)) - -(defun shrink-window-horizontally (arg) - "Make current window ARG columns narrower." - (interactive "p") - (shrink-window arg t)) - -(defun shrink-window-if-larger-than-buffer (&optional window) - "Shrink the WINDOW to be as small as possible to display its contents. -Do not shrink to less than `window-min-height' lines. -Do nothing if the buffer contains more lines than the present window height, -or if some of the window's contents are scrolled out of view, -or if the window is not the full width of the frame, -or if the window is the only window of its frame." - (interactive) - (or window (setq window (selected-window))) - (save-excursion - (set-buffer (window-buffer window)) - (let ((n 0) - (test-pos - (- (point-max) - ;; If buffer ends with a newline, ignore it when counting - ;; height unless point is after it. - (if (and (not (eobp)) - (eq ?\n (char-after (1- (point-max))))) - 1 0))) - (mini (frame-property (window-frame window) 'minibuffer)) - (edges (window-pixel-edges (selected-window)))) - (if (and (< 1 (let ((frame (selected-frame))) - (select-frame (window-frame window)) - (unwind-protect - (count-windows) - (select-frame frame)))) - ;; check to make sure that the window is the full width - ;; of the frame - (eq (nth 2 edges) - (frame-pixel-width)) - (zerop (nth 0 edges)) - ;; The whole buffer must be visible. - (pos-visible-in-window-p (point-min) window) - ;; The frame must not be minibuffer-only. - (not (eq mini 'only))) - (progn - (save-window-excursion - (goto-char (point-min)) - (while (and (window-live-p window) - (pos-visible-in-window-p test-pos window)) - (shrink-window 1 nil window) - (setq n (1+ n)))) - (if (> n 0) - (shrink-window (min (1- n) - (- (window-height window) - (1+ window-min-height))) - nil - window))))))) - -(defun kill-buffer-and-window () - "Kill the current buffer and delete the selected window." - (interactive) - (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name))) - (let ((buffer (current-buffer))) - (delete-window (selected-window)) - (kill-buffer buffer)) - (error "Aborted"))) - -;;; New with XEmacs 20.3 -;;; Suggested by Noah Friedman, and tuned by Hrvoje Niksic. -(defun window-list (&optional minibuf all-frames device) - "Return a list of existing windows. -If the optional argument MINIBUF is non-nil, then include minibuffer -windows in the result. - -By default, only the windows in the selected frame are returned. -The optional argument ALL-FRAMES changes this behavior: -ALL-FRAMES = `visible' means include windows on all visible frames. -ALL-FRAMES = 0 means include windows on all visible and iconified frames. -ALL-FRAMES = t means include windows on all frames including invisible frames. -Anything else means restrict to the selected frame. -The optional fourth argument DEVICE further clarifies which frames to -search as specified by ALL-FRAMES. This value is only meaningful if -ALL-FRAMES is non-nil. -If nil or omitted, search only the selected device. -If a device, search frames only on that device. -If a device type, search frames only on devices of that type. -Any other non-nil value means search frames on all devices." - (let ((wins nil)) - (walk-windows (lambda (win) - (push win wins)) - minibuf all-frames device) - wins)) - - -;;; window.el ends here diff --git a/lisp/x-compose.el b/lisp/x-compose.el deleted file mode 100644 index 1500277..0000000 --- a/lisp/x-compose.el +++ /dev/null @@ -1,708 +0,0 @@ -;;; x-compose.el --- Compose-key processing in XEmacs - -;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski -;; Maintainer: XEmacs Development Team -;; Rewritten by Martin Buchholz far too many times. -;; -;; Changed: 11 Jun 1997 by Heiko Muenkel -;; The degree sign couldn't be inserted with the old version. -;; 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: Not in FSF. - -;;; Commentary: - -;; created by jwz, 14-jun-92. -;;; changed by Jan Vroonhof, July 1997: Use function-key-map instead -;;; of global map. -;;; Preliminary support for -;;; XFree86 deadkeys - -;; This file implements DEC-, OpenWindows-, and HP-compatible "Compose" -;; processing for XEmacs. - -;; If you are running a version of X which already does compose processing, -;; then you don't need this file. But the MIT R4 and R5 distributions don't -;; do compose processing, so you may want to fake it by using this code. - -;; The basic idea is that there are several ways to generate keysyms which -;; do not have keys devoted to them on your keyboard. - -;; The first method is by using "dead" keys. A dead key is a key which, -;; when typed, does not insert a character. Instead it modifies the -;; following character typed. So if you typed "dead-tilde" followed by "A", -;; then "A-tilde" would be inserted. Of course, this requires you to modify -;; your keyboard to include a "dead-tilde" key on it somewhere. - -;; The second method is by using a "Compose" key. With a Compose key, you -;; would type "Compose" then "tilde" then "A" to insert "A-tilde". - -;; There are a small number of dead keys: acute, grave, cedilla, diaeresis, -;; circumflex, tilde, and ring. There are a larger number of accented and -;; other characters accessible via the Compose key, so both are useful. - -;; To use this code, you will need to have a Compose key on your keyboard. -;; The default configuration of most X keyboards doesn't contain one. You -;; can, for example, turn the right "Meta" key into a "Compose" key with -;; this command: - -;; xmodmap -e "remove mod1 = Meta_R" -e "keysym Meta_R = Multi_key" - -;; Multi-key is the name that X (and emacs) know the "Compose" key by. -;; The "remove..." command is necessary because the "Compose" key must not -;; have any modifier bits associated with it. This exact command may not -;; work, depending on what system and keyboard you are using. If it -;; doesn't, you'll have to read the man page for xmodmap. You might want -;; to get the "xkeycaps" program from -;; , -;; which is a graphical front end to xmodmap -;; that hides xmodmap's arcane syntax from you. - -;; If for some reason you don't want to have a dedicated compose key on your -;; keyboard, you can use some other key as the prefix. For example, to make -;; "Meta-Shift-C" act as a compose key (so that "M-C , c" would insert the -;; character "ccedilla") you could do - -;; (global-set-key "\M-C" compose-map) - -;; I believe the bindings encoded in this file are the same as those used -;; by OpenWindows versions 2 and 3, and DEC VT320 terminals. Please let me -;; know if you think otherwise. - -;; Much thanks to Justin Bur for helping me understand how -;; this stuff is supposed to work. - -;; You also might want to consider getting Justin's patch for the MIT Xlib -;; that implements compose processing in the library. This will enable -;; compose processing in applications other than emacs as well. You can -;; get it from export.lcs.mit.edu in contrib/compose.tar.Z. - -;; This code has one feature that a more "builtin" Compose mechanism could -;; not have: at any point you can type C-h to get a list of the possible -;; completions of what you have typed so far. - -;;; Code: - -(require 'x-iso8859-1) - -(macrolet - ((define-compose-map (keymap-symbol) - `(progn - (defconst ,keymap-symbol (make-sparse-keymap ',keymap-symbol)) - ;; Required to tell XEmacs the keymaps were actually autoloaded. - ;; #### Make this unnecessary! - (fset ',keymap-symbol ,keymap-symbol)))) - - (define-compose-map compose-map) - (define-compose-map compose-acute-map) - (define-compose-map compose-grave-map) - (define-compose-map compose-cedilla-map) - (define-compose-map compose-diaeresis-map) - (define-compose-map compose-circumflex-map) - (define-compose-map compose-tilde-map) - (define-compose-map compose-ring-map)) - -(define-key compose-map 'acute compose-acute-map) -(define-key compose-map 'grave compose-grave-map) -(define-key compose-map 'cedilla compose-cedilla-map) -(define-key compose-map 'diaeresis compose-diaeresis-map) -(define-key compose-map 'circumflex compose-circumflex-map) -(define-key compose-map 'tilde compose-tilde-map) -(define-key compose-map 'degree compose-ring-map) - -;;(define-key function-key-map [multi-key] compose-map) - -;; The following is necessary, because one can't rebind [degree] -;; and use it to insert the degree sign! -;;(defun compose-insert-degree () -;; "Inserts a degree sign." -;; (interactive) -;; (insert ?\260)) - -(define-key compose-map [acute] compose-acute-map) -(define-key compose-map [?'] compose-acute-map) -(define-key compose-map [grave] compose-grave-map) -(define-key compose-map [?`] compose-grave-map) -(define-key compose-map [cedilla] compose-cedilla-map) -(define-key compose-map [?,] compose-cedilla-map) -(define-key compose-map [diaeresis] compose-diaeresis-map) -(define-key compose-map [?\"] compose-diaeresis-map) -(define-key compose-map [circumflex] compose-circumflex-map) -(define-key compose-map [?^] compose-circumflex-map) -(define-key compose-map [tilde] compose-tilde-map) -(define-key compose-map [~] compose-tilde-map) -(define-key compose-map [degree] compose-ring-map) -(define-key compose-map [?*] compose-ring-map) - - -;;; The contents of the "dead key" maps. These are shared by the -;;; compose-map. - -(define-key compose-acute-map [space] "'") -(define-key compose-acute-map [?'] [acute]) -(define-key compose-acute-map [?A] [Aacute]) -(define-key compose-acute-map [E] [Eacute]) -(define-key compose-acute-map [I] [Iacute]) -(define-key compose-acute-map [O] [Oacute]) -(define-key compose-acute-map [U] [Uacute]) -(define-key compose-acute-map [Y] [Yacute]) -(define-key compose-acute-map [a] [aacute]) -(define-key compose-acute-map [e] [eacute]) -(define-key compose-acute-map [i] [iacute]) -(define-key compose-acute-map [o] [oacute]) -(define-key compose-acute-map [u] [uacute]) -(define-key compose-acute-map [y] [yacute]) - -(define-key compose-grave-map [space] "`") -(define-key compose-grave-map [?`] [grave]) -(define-key compose-grave-map [A] [Agrave]) -(define-key compose-grave-map [E] [Egrave]) -(define-key compose-grave-map [I] [Igrave]) -(define-key compose-grave-map [O] [Ograve]) -(define-key compose-grave-map [U] [Ugrave]) -(define-key compose-grave-map [a] [agrave]) -(define-key compose-grave-map [e] [egrave]) -(define-key compose-grave-map [i] [igrave]) -(define-key compose-grave-map [o] [ograve]) -(define-key compose-grave-map [u] [ugrave]) - -(define-key compose-cedilla-map [space] ",") -(define-key compose-cedilla-map [?,] [cedilla]) -(define-key compose-cedilla-map [C] [Ccedilla]) -(define-key compose-cedilla-map [c] [ccedilla]) - -(define-key compose-diaeresis-map [space] [diaeresis]) -(define-key compose-diaeresis-map [?\"] [diaeresis]) -(define-key compose-diaeresis-map [A] [Adiaeresis]) -(define-key compose-diaeresis-map [E] [Ediaeresis]) -(define-key compose-diaeresis-map [I] [Idiaeresis]) -(define-key compose-diaeresis-map [O] [Odiaeresis]) -(define-key compose-diaeresis-map [U] [Udiaeresis]) -(define-key compose-diaeresis-map [a] [adiaeresis]) -(define-key compose-diaeresis-map [e] [ediaeresis]) -(define-key compose-diaeresis-map [i] [idiaeresis]) -(define-key compose-diaeresis-map [o] [odiaeresis]) -(define-key compose-diaeresis-map [u] [udiaeresis]) -(define-key compose-diaeresis-map [y] [ydiaeresis]) - -(define-key compose-circumflex-map [space] "^") -(define-key compose-circumflex-map [?/] "|") -(define-key compose-circumflex-map [?!] [brokenbar]) -(define-key compose-circumflex-map [?-] [macron]) -(define-key compose-circumflex-map [?_] [macron]) -(define-key compose-circumflex-map [?0] [degree]) -(define-key compose-circumflex-map [?1] [onesuperior]) -(define-key compose-circumflex-map [?2] [twosuperior]) -(define-key compose-circumflex-map [?3] [threesuperior]) -(define-key compose-circumflex-map [?.] [periodcentered]) -(define-key compose-circumflex-map [A] [Acircumflex]) -(define-key compose-circumflex-map [E] [Ecircumflex]) -(define-key compose-circumflex-map [I] [Icircumflex]) -(define-key compose-circumflex-map [O] [Ocircumflex]) -(define-key compose-circumflex-map [U] [Ucircumflex]) -(define-key compose-circumflex-map [a] [acircumflex]) -(define-key compose-circumflex-map [e] [ecircumflex]) -(define-key compose-circumflex-map [i] [icircumflex]) -(define-key compose-circumflex-map [o] [ocircumflex]) -(define-key compose-circumflex-map [u] [ucircumflex]) - -(define-key compose-tilde-map [space] "~") -(define-key compose-tilde-map [A] [Atilde]) -(define-key compose-tilde-map [N] [Ntilde]) -(define-key compose-tilde-map [O] [Otilde]) -(define-key compose-tilde-map [a] [atilde]) -(define-key compose-tilde-map [n] [ntilde]) -(define-key compose-tilde-map [o] [otilde]) - -(define-key compose-ring-map [space] [degree]) -(define-key compose-ring-map [A] [Aring]) -(define-key compose-ring-map [a] [aring]) - - -;;; The rest of the compose-map. These are the composed characters -;;; that are not accessible via "dead" keys. - -(define-key compose-map " '" "'") -(define-key compose-map " ^" "^") -(define-key compose-map " `" "`") -(define-key compose-map " ~" "~") -(define-key compose-map " " [nobreakspace]) -(define-key compose-map " \"" [diaeresis]) -(define-key compose-map " :" [diaeresis]) -(define-key compose-map " *" [degree]) - -(define-key compose-map "!!" [exclamdown]) -(define-key compose-map "!^" [brokenbar]) -(define-key compose-map "!S" [section]) -(define-key compose-map "!s" [section]) -(define-key compose-map "!P" [paragraph]) -(define-key compose-map "!p" [paragraph]) - -(define-key compose-map "((" "[") -(define-key compose-map "(-" "{") - -(define-key compose-map "))" "]") -(define-key compose-map ")-" "}") - -(define-key compose-map "++" "#") -(define-key compose-map "+-" [plusminus]) - -(define-key compose-map "-(" "{") -(define-key compose-map "-)" "}") -(define-key compose-map "--" "-") -(define-key compose-map "-L" [sterling]) -(define-key compose-map "-l" [sterling]) -(define-key compose-map "-Y" [yen]) -(define-key compose-map "-y" [yen]) -(define-key compose-map "-," [notsign]) -(define-key compose-map "-|" [notsign]) -(define-key compose-map "-^" [macron]) -(define-key compose-map "-+" [plusminus]) -(define-key compose-map "-:" [division]) -(define-key compose-map "-D" [ETH]) -(define-key compose-map "-d" [eth]) -(define-key compose-map "-a" [ordfeminine]) - -(define-key compose-map ".^" [periodcentered]) - -(define-key compose-map "//" "\\") -(define-key compose-map "/<" "\\") -(define-key compose-map "/^" "|") -(define-key compose-map "/C" [cent]) -(define-key compose-map "/c" [cent]) -(define-key compose-map "/U" [mu]) -(define-key compose-map "/u" [mu]) -(define-key compose-map "/O" [Ooblique]) -(define-key compose-map "/o" [oslash]) - -(define-key compose-map "0X" [currency]) -(define-key compose-map "0x" [currency]) -(define-key compose-map "0S" [section]) -(define-key compose-map "0s" [section]) -(define-key compose-map "0C" [copyright]) -(define-key compose-map "0c" [copyright]) -(define-key compose-map "0R" [registered]) -(define-key compose-map "0r" [registered]) -(define-key compose-map "0^" [degree]) - -(define-key compose-map "1^" [onesuperior]) -(define-key compose-map "14" [onequarter]) -(define-key compose-map "12" [onehalf]) - -(define-key compose-map "2^" [twosuperior]) - -(define-key compose-map "3^" [threesuperior]) -(define-key compose-map "34" [threequarters]) - -(define-key compose-map ":-" [division]) - -(define-key compose-map ">" [guillemotright]) - -(define-key compose-map "??" [questiondown]) - -(define-key compose-map "AA" "@") -(define-key compose-map "Aa" "@") -(define-key compose-map "A_" [ordfeminine]) -(define-key compose-map "A`" [Agrave]) -(define-key compose-map "A'" [Aacute]) -(define-key compose-map "A^" [Acircumflex]) -(define-key compose-map "A~" [Atilde]) -(define-key compose-map "A\"" [Adiaeresis]) -(define-key compose-map "A*" [Aring]) -(define-key compose-map "AE" [AE]) - -(define-key compose-map "C/" [cent]) -(define-key compose-map "C|" [cent]) -(define-key compose-map "C0" [copyright]) -(define-key compose-map "CO" [copyright]) -(define-key compose-map "Co" [copyright]) -(define-key compose-map "C," [Ccedilla]) - -(define-key compose-map "D-" [ETH]) - -(define-key compose-map "E`" [Egrave]) -(define-key compose-map "E'" [Eacute]) -(define-key compose-map "E^" [Ecircumflex]) -(define-key compose-map "E\"" [Ediaeresis]) - -(define-key compose-map "I`" [Igrave]) -(define-key compose-map "I'" [Iacute]) -(define-key compose-map "I^" [Icircumflex]) -(define-key compose-map "I\"" [Idiaeresis]) - -(define-key compose-map "L-" [sterling]) -(define-key compose-map "L=" [sterling]) - -(define-key compose-map "N~" [Ntilde]) - -(define-key compose-map "OX" [currency]) -(define-key compose-map "Ox" [currency]) -(define-key compose-map "OS" [section]) -(define-key compose-map "Os" [section]) -(define-key compose-map "OC" [copyright]) -(define-key compose-map "Oc" [copyright]) -(define-key compose-map "OR" [registered]) -(define-key compose-map "Or" [registered]) -(define-key compose-map "O_" [masculine]) -(define-key compose-map "O`" [Ograve]) -(define-key compose-map "O'" [Oacute]) -(define-key compose-map "O^" [Ocircumflex]) -(define-key compose-map "O~" [Otilde]) -(define-key compose-map "O\"" [Odiaeresis]) -(define-key compose-map "O/" [Ooblique]) - -(define-key compose-map "P!" [paragraph]) - -(define-key compose-map "R0" [registered]) -(define-key compose-map "RO" [registered]) -(define-key compose-map "Ro" [registered]) - -(define-key compose-map "S!" [section]) -(define-key compose-map "S0" [section]) -(define-key compose-map "SO" [section]) -(define-key compose-map "So" [section]) -(define-key compose-map "SS" [ssharp]) - -(define-key compose-map "TH" [THORN]) - -(define-key compose-map "U`" [Ugrave]) -(define-key compose-map "U'" [Uacute]) -(define-key compose-map "U^" [Ucircumflex]) -(define-key compose-map "U\"" [Udiaeresis]) - -(define-key compose-map "X0" [currency]) -(define-key compose-map "XO" [currency]) -(define-key compose-map "Xo" [currency]) - -(define-key compose-map "Y-" [yen]) -(define-key compose-map "Y=" [yen]) -(define-key compose-map "Y'" [Yacute]) - -(define-key compose-map "_A" [ordfeminine]) -(define-key compose-map "_a" [ordfeminine]) -(define-key compose-map "_^" [macron]) -(define-key compose-map "_O" [masculine]) -(define-key compose-map "_o" [masculine]) - -(define-key compose-map "aA" "@") -(define-key compose-map "aa" "@") -(define-key compose-map "a_" [ordfeminine]) -(define-key compose-map "a-" [ordfeminine]) -(define-key compose-map "a`" [agrave]) -(define-key compose-map "a'" [aacute]) -(define-key compose-map "a^" [acircumflex]) -(define-key compose-map "a~" [atilde]) -(define-key compose-map "a\"" [adiaeresis]) -(define-key compose-map "a*" [aring]) -(define-key compose-map "ae" [ae]) - -(define-key compose-map "c/" [cent]) -(define-key compose-map "c|" [cent]) -(define-key compose-map "c0" [copyright]) -(define-key compose-map "cO" [copyright]) -(define-key compose-map "co" [copyright]) -(define-key compose-map "c," [ccedilla]) - -(define-key compose-map "d-" [eth]) - -(define-key compose-map "e`" [egrave]) -(define-key compose-map "e'" [eacute]) -(define-key compose-map "e^" [ecircumflex]) -(define-key compose-map "e\"" [ediaeresis]) - -(define-key compose-map "i`" [igrave]) -(define-key compose-map "i'" [iacute]) -(define-key compose-map "i^" [icircumflex]) -(define-key compose-map "i\"" [idiaeresis]) -(define-key compose-map "i:" [idiaeresis]) - -(define-key compose-map "l-" [sterling]) -(define-key compose-map "l=" [sterling]) - -(define-key compose-map "n~" [ntilde]) - -(define-key compose-map "oX" [currency]) -(define-key compose-map "ox" [currency]) -(define-key compose-map "oC" [copyright]) -(define-key compose-map "oc" [copyright]) -(define-key compose-map "oR" [registered]) -(define-key compose-map "or" [registered]) -(define-key compose-map "oS" [section]) -(define-key compose-map "os" [section]) -(define-key compose-map "o_" [masculine]) -(define-key compose-map "o`" [ograve]) -(define-key compose-map "o'" [oacute]) -(define-key compose-map "o^" [ocircumflex]) -(define-key compose-map "o~" [otilde]) -(define-key compose-map "o\"" [odiaeresis]) -(define-key compose-map "o/" [oslash]) - -(define-key compose-map "p!" [paragraph]) - -(define-key compose-map "r0" [registered]) -(define-key compose-map "rO" [registered]) -(define-key compose-map "ro" [registered]) - -(define-key compose-map "s!" [section]) -(define-key compose-map "s0" [section]) -(define-key compose-map "sO" [section]) -(define-key compose-map "so" [section]) -(define-key compose-map "ss" [ssharp]) - -(define-key compose-map "th" [thorn]) - -(define-key compose-map "u`" [ugrave]) -(define-key compose-map "u'" [uacute]) -(define-key compose-map "u^" [ucircumflex]) -(define-key compose-map "u\"" [udiaeresis]) -(define-key compose-map "u/" [mu]) - -(define-key compose-map "x0" [currency]) -(define-key compose-map "xO" [currency]) -(define-key compose-map "xo" [currency]) -(define-key compose-map "xx" [multiply]) - -(define-key compose-map "y-" [yen]) -(define-key compose-map "y=" [yen]) -(define-key compose-map "y'" [yacute]) -(define-key compose-map "y\"" [ydiaeresis]) - -(define-key compose-map "|C" [cent]) -(define-key compose-map "|c" [cent]) -(define-key compose-map "||" [brokenbar]) - - -;; Suppose we type these three physical keys: [Multi_key " a] -;; Xlib can deliver these keys as the following sequences of keysyms: -;; -;; - [Multi_key " a] (no surprise here) -;; - [adiaeresis] (OK, Xlib is doing compose processing for us) -;; - [Multi_key " adiaeresis] (Huh?) -;; -;; It is the last possibility that is arguably a bug. Xlib can't -;; decide whether it's really doing compose processing or not (or -;; actually, different parts of Xlib disagree). -;; -;; So we'll just convert [Multi_key " adiaeresis] to [adiaeresis] -(defun xlib-input-method-bug-workaround (keymap) - (map-keymap - (lambda (key value) - (cond - ((keymapp value) - (xlib-input-method-bug-workaround value)) - ((and (sequencep value) - (eq 1 (length value)) - (null (lookup-key keymap value))) - (define-key keymap value value)))) - keymap)) -(xlib-input-method-bug-workaround compose-map) -(unintern 'xlib-input-method-bug-workaround) - -;; While we're at it, a similar mechanism will make colon equivalent -;; to doublequote for diaeresis processing. Some Xlibs do this. -(defun alias-colon-to-doublequote (keymap) - (map-keymap - (lambda (key value) - (when (keymapp value) - (alias-colon-to-doublequote value)) - (when (eq key '\") - (define-key keymap ":" value))) - keymap)) -(alias-colon-to-doublequote compose-map) -(unintern 'alias-colon-to-doublequote) - -;;; Electric dead keys: making a' mean a-acute. - - -(defun electric-diacritic (&optional count) - "Modify the previous character with an accent. -For example, if `:' is bound to this command, then typing `a:' -will first insert `a' and then turn it into `\344' (adiaeresis). -The keys to which this command may be bound (and the accents -which it understands) are: - - ' (acute) \301\311\315\323\332\335 \341\351\355\363\372\375 - ` (grave) \300\310\314\322\331 \340\350\354\362\371 - : (diaeresis) \304\313\317\326\334 \344\353\357\366\374\377 - ^ (circumflex) \302\312\316\324\333 \342\352\356\364\373 - , (cedilla) \307\347 - . (ring) \305\345" - (interactive "p") - (or count (setq count 1)) - - (if (not (eq last-command 'self-insert-command)) - ;; Only do the magic if the two chars were typed in succession. - (self-insert-command count) - - ;; This is so that ``a : C-x u'' will transform `adiaeresis' back into `a:' - (self-insert-command count) - (undo-boundary) - (delete-char (- count)) - - (let* ((c last-command-char) - (map (cond ((eq c ?') compose-acute-map) - ((eq c ?`) compose-grave-map) - ((eq c ?,) compose-cedilla-map) - ((eq c ?:) compose-diaeresis-map) - ((eq c ?^) compose-circumflex-map) - ((eq c ?~) compose-tilde-map) - ((eq c ?.) compose-ring-map) - (t (error "unknown diacritic: %s (%c)" c c)))) - (base-char (preceding-char)) - (mod-char (and (>= (downcase base-char) ?a) ; only do alphabetics? - (<= (downcase base-char) ?z) - (lookup-key map (make-string 1 base-char))))) - (if (and (vectorp mod-char) (= (length mod-char) 1)) - (setq mod-char (aref mod-char 0))) - (if (and mod-char (symbolp mod-char)) - (setq mod-char (or (get mod-char character-set-property) mod-char))) - (if (and mod-char (> count 0)) - (delete-char -1) - (setq mod-char c)) - (while (> count 0) - (insert mod-char) - (setq count (1- count)))))) - -;; should "::" mean "¨" and ": " mean ":"? -;; should we also do -;; (?~ -;; (?A "\303") -;; (?C "\307") -;; (?D "\320") -;; (?N "\321") -;; (?O "\325") -;; (?a "\343") -;; (?c "\347") -;; (?d "\360") -;; (?n "\361") -;; (?o "\365") -;; (?> "\273") -;; (?< "\253") -;; (? "~")) ; no special code -;; (?\/ -;; (?A "\305") ;; A-with-ring (Norwegian and Danish) -;; (?E "\306") ;; AE-ligature (Norwegian and Danish) -;; (?O "\330") -;; (?a "\345") ;; a-with-ring (Norwegian and Danish) -;; (?e "\346") ;; ae-ligature (Norwegian and Danish) -;; (?o "\370") -;; (? "/")) ; no special code - - -;;; Providing help in the middle of a compose sequence. (Way cool.) - -(eval-when-compile - (defsubst next-composable-event () - (let (event) - (while (progn - (setq event (next-command-event)) - (not (or (key-press-event-p event) - (button-press-event-p event)))) - (dispatch-event event)) - event))) - -(defun compose-help (ignore-prompt) - (let* ((keys (apply 'vector (nbutlast (append (this-command-keys) nil)))) - (map (or (lookup-key function-key-map keys) - (error "can't find map? %s %s" keys (this-command-keys)))) - binding) - (save-excursion - (with-output-to-temp-buffer "*Help*" - (set-buffer "*Help*") - (erase-buffer) - (message "Working...") - (setq ctl-arrow 'compose) ; non-t-non-nil - (insert "You are typing a compose sequence. So far you have typed: ") - (insert (key-description keys)) - (insert "\nCompletions from here are:\n\n") - (map-keymap 'compose-help-mapper map t) - (message "? "))) - (while (keymapp map) - (setq binding (lookup-key map (vector (next-composable-event)))) - (if (null binding) - (message "No such key in keymap. Try again.") - (setq map binding))) - binding)) - -(put 'compose-help 'isearch-command t) ; so that it doesn't terminate isearch - -(defun compose-help-mapper (key binding) - (if (and (symbolp key) - (get key character-set-property)) - (setq key (get key character-set-property))) - (if (eq binding 'compose-help) ; suppress that... - nil - (if (keymapp binding) - (let ((p (point))) - (map-keymap 'compose-help-mapper binding t) - (goto-char p) - (while (not (eobp)) - (if (characterp key) - (insert (make-string 1 key)) - (insert (single-key-description key))) - (insert " ") - (forward-line 1))) - (if (characterp key) - (insert (make-string 1 key)) - (insert (single-key-description key))) - (indent-to 16) - (let ((code (and (vectorp binding) - (= 1 (length binding)) - (get (aref binding 0) character-set-property)))) - (if code - (insert (make-string 1 code)) - (if (stringp binding) - (insert binding) - (insert (prin1-to-string binding))))) - (when (and (vectorp binding) (= 1 (length binding))) - (indent-to 32) - (insert (symbol-name (aref binding 0))))) - (insert "\n"))) - -;; define it at top-level in the compose map... -;;(define-key compose-map [(control h)] 'compose-help) -;;(define-key compose-map [help] 'compose-help) -;; and then define it in each sub-map of the compose map. -(map-keymap - (lambda (key binding) - (when (keymapp binding) -;; (define-key binding [(control h)] 'compose-help) -;; (define-key binding [help] 'compose-help) - )) - compose-map nil) - -;; Make redisplay display the accented letters -(if (memq (default-value 'ctl-arrow) '(t nil)) - (setq-default ctl-arrow 'iso-8859/1)) - - -(provide 'x-compose) - -;;; x-compose.el ends here diff --git a/lisp/x-faces.el b/lisp/x-faces.el deleted file mode 100644 index 21895c3..0000000 --- a/lisp/x-faces.el +++ /dev/null @@ -1,742 +0,0 @@ -;;; x-faces.el --- X-specific face frobnication, aka black magic. - -;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Jamie Zawinski -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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 is dumped with XEmacs (when X support is compiled in). - -;; Modified by: Chuck Thompson -;; Modified by: Ben Wing -;; Modified by: Martin Buchholz - -;; This file does the magic to parse X font names, and make sure that the -;; default and modeline attributes of new frames are specified enough. - -;; The resource-manager syntax for faces is - -;; Emacs.bold.attributeFont: font-name -;; Emacs.bold.attributeForeground: fg -;; Emacs.bold.attributeBackground: bg -;; Emacs.bold.attributeBackgroundPixmap: file -;; Emacs.bold.attributeUnderline: true/false -;; Emacs.bold.attributeStrikethru: true/false - -;; You can specify the properties of a face on a per-frame basis. For -;; example, to have the "isearch" face use a red foreground on frames -;; named "emacs" (the default) but use a blue foreground on frames that -;; you create named "debugger", you could do - -;; Emacs*emacs.isearch.attributeForeground: red -;; Emacs*debugger.isearch.attributeForeground: blue - -;; Generally things that make faces won't set any of the face attributes if -;; you have already given them values via the resource database. You can -;; also change this stuff from your .emacs file, by using the functions -;; set-face-foreground, set-face-font, etc. See the code in this file, and -;; in faces.el. - -;;; Code: - -(defconst x-font-regexp nil) -(defconst x-font-regexp-head nil) -(defconst x-font-regexp-head-2 nil) -(defconst x-font-regexp-weight nil) -(defconst x-font-regexp-slant nil) -(defconst x-font-regexp-pixel nil) -(defconst x-font-regexp-point nil) -(defconst x-font-regexp-foundry-and-family nil) -(defconst x-font-regexp-registry-and-encoding nil) -(defconst x-font-regexp-spacing nil) - -;;; Regexps matching font names in "Host Portable Character Representation." -;;; -(let ((- "[-?]") - (foundry "[^-]*") - (family "[^-]*") - (weight "\\(bold\\|demibold\\|medium\\|black\\)") ; 1 -; (weight\? "\\(\\*\\|bold\\|demibold\\|medium\\|\\)") ; 1 - (weight\? "\\([^-]*\\)") ; 1 - (slant "\\([ior]\\)") ; 2 -; (slant\? "\\([ior?*]?\\)") ; 2 - (slant\? "\\([^-]?\\)") ; 2 -; (swidth "\\(\\*\\|normal\\|semicondensed\\|\\)") ; 3 - (swidth "\\([^-]*\\)") ; 3 -; (adstyle "\\(\\*\\|sans\\|\\)") ; 4 - (adstyle "\\([^-]*\\)") ; 4 - (pixelsize "\\(\\*\\|[0-9]+\\)") ; 5 - (pointsize "\\(\\*\\|0\\|[0-9][0-9]+\\)") ; 6 -; (resx "\\(\\*\\|[0-9][0-9]+\\)") ; 7 -; (resy "\\(\\*\\|[0-9][0-9]+\\)") ; 8 - (resx "\\([*0]\\|[0-9][0-9]+\\)") ; 7 - (resy "\\([*0]\\|[0-9][0-9]+\\)") ; 8 - (spacing "[cmp?*]") - (avgwidth "\\(\\*\\|[0-9]+\\)") ; 9 - (registry "[^-]*") ; some fonts have omitted registries -; (encoding ".+") ; note that encoding may contain "-"... - (encoding "[^-]+") ; false! - ) - (setq x-font-regexp - (purecopy - (concat "\\`\\*?[-?*]" - foundry - family - weight\? - slant\? - swidth - adstyle - - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\'" - ))) - (setq x-font-regexp-head - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - "\\([-*?]\\|\\'\\)"))) - (setq x-font-regexp-head-2 - (purecopy - (concat "\\`[-?*]" foundry - family - weight\? - slant\? - - swidth - adstyle - pixelsize - pointsize - "\\([-*?]\\|\\'\\)"))) - (setq x-font-regexp-slant (purecopy (concat - slant -))) - (setq x-font-regexp-weight (purecopy (concat - weight -))) - ;; if we can't match any of the more specific regexps (unfortunate) then - ;; look for digits; assume 2+ digits is 10ths of points, and 1-2 digits - ;; is pixels. Bogus as hell. - (setq x-font-regexp-pixel (purecopy "[-?*]\\([0-9][0-9]?\\)[-?*]")) - (setq x-font-regexp-point (purecopy "[-?*]\\([0-9][0-9]+\\)[-?*]")) - ;; the following two are used by x-font-menu.el. - (setq x-font-regexp-foundry-and-family - (purecopy (concat "\\`[-?*]" foundry - "\\(" family "\\)" -))) - (setq x-font-regexp-registry-and-encoding - (purecopy (concat - "\\(" registry "\\)" - "\\(" encoding "\\)\\'"))) - (setq x-font-regexp-spacing - (purecopy (concat - "\\(" spacing "\\)" - avgwidth - - registry - encoding "\\'"))) - ) - -;; A "loser font" is something like "8x13" -> "8x13bold". -;; These are supported only through extreme generosity. -(defconst x-loser-font-regexp (purecopy "\\`[0-9]+x[0-9]+\\'")) - -(defun x-frob-font-weight (font which) - (if (font-instance-p font) (setq font (font-instance-name font))) - (cond ((null font) nil) - ((or (string-match x-font-regexp font) - (string-match x-font-regexp-head font) - (string-match x-font-regexp-weight font)) - (concat (substring font 0 (match-beginning 1)) which - (substring font (match-end 1)))) - ((string-match x-loser-font-regexp font) - (concat font which)) - (t nil))) - -(defun x-frob-font-slant (font which) - (if (font-instance-p font) (setq font (font-instance-name font))) - (cond ((null font) nil) - ((or (string-match x-font-regexp font) - (string-match x-font-regexp-head font)) - (concat (substring font 0 (match-beginning 2)) which - (substring font (match-end 2)))) - ((string-match x-font-regexp-slant font) - (concat (substring font 0 (match-beginning 1)) which - (substring font (match-end 1)))) - ((string-match x-loser-font-regexp font) - (concat font which)) - (t nil))) - -(defun x-make-font-bold (font &optional device) - "Given an X font specification, this attempts to make a `bold' font. -If it fails, it returns nil." - ;; Certain Type1 fonts know "bold" as "black"... - (or (try-font-name (x-frob-font-weight font "bold") device) - (try-font-name (x-frob-font-weight font "black") device) - (try-font-name (x-frob-font-weight font "demibold") device))) - -(defun x-make-font-unbold (font &optional device) - "Given an X font specification, this attempts to make a non-bold font. -If it fails, it returns nil." - (try-font-name (x-frob-font-weight font "medium") device)) - -(defcustom *try-oblique-before-italic-fonts* nil - "*If nil, italic fonts are searched before oblique fonts. -If non-nil, oblique fonts are tried before italic fonts. This is mostly -applicable to adobe-courier fonts" - :type 'boolean - :tag "Try Oblique Before Italic Fonts" - :group 'x) - -(defun x-make-font-italic (font &optional device) - "Given an X font specification, this attempts to make an `italic' font. -If it fails, it returns nil." - (if *try-oblique-before-italic-fonts* - (or (try-font-name (x-frob-font-slant font "o") device) - (try-font-name (x-frob-font-slant font "i") device)) - (or (try-font-name (x-frob-font-slant font "i") device) - (try-font-name (x-frob-font-slant font "o") device)))) - -(defun x-make-font-unitalic (font &optional device) - "Given an X font specification, this attempts to make a non-italic font. -If it fails, it returns nil." - (try-font-name (x-frob-font-slant font "r") device)) - -(defun x-make-font-bold-italic (font &optional device) - "Given an X font specification, this attempts to make a `bold-italic' font. -If it fails, it returns nil." - ;; This is haired up to avoid loading the "intermediate" fonts. - (or (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "bold") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "black") "o") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "i") device) - (try-font-name - (x-frob-font-slant (x-frob-font-weight font "demibold") "o") device))) - -(defun x-font-size (font) - "Return the nominal size of the given font. -This is done by parsing its name, so it's likely to lose. -X fonts can be specified (by the user) in either pixels or 10ths of points, - and this returns the first one it finds, so you have to decide which units - the returned value is measured in yourself..." - (if (font-instance-p font) (setq font (font-instance-name font))) - (cond ((or (string-match x-font-regexp font) - (string-match x-font-regexp-head-2 font)) - (string-to-int (substring font (match-beginning 6) (match-end 6)))) - ((or (string-match x-font-regexp-pixel font) - (string-match x-font-regexp-point font)) - (string-to-int (substring font (match-beginning 1) (match-end 1)))) - (t nil))) - -;; Given a font name, this function returns a list describing all fonts -;; of all sizes that otherwise match the given font spec. Each element -;; in the list is a list of three items: the pixel size of the font, -;; the point size (in 1/10ths of a point) of the font, and the fully- -;; qualified font name. The first two values may be zero; this -;; refers to a scalable font. - -(defun x-available-font-sizes (font device) - (if (font-instance-p font) (setq font (font-instance-name font))) - (cond ((string-match x-font-regexp font) - ;; turn pixelsize, pointsize, and avgwidth into wildcards - (setq font - (concat (substring font 0 (match-beginning 5)) "*" - (substring font (match-end 5) (match-beginning 6)) "*" - (substring font (match-end 6) (match-beginning 9)) "*" - (substring font (match-end 9) (match-end 0))))) - ((string-match x-font-regexp-head-2 font) - ;; turn pixelsize and pointsize into wildcards - (setq font - (concat (substring font 0 (match-beginning 5)) "*" - (substring font (match-end 5) (match-beginning 6)) "*" - (substring font (match-end 6) (match-end 0))))) - ((string-match "[-?*]\\([0-9]+\\)[-?*]" font) - ;; Turn the first integer we match into a wildcard. - ;; This is pretty dubious... - (setq font - (concat (substring font 0 (match-beginning 1)) "*" - (substring font (match-end 1) (match-end 0)))))) - (sort - (delq nil - (mapcar (function - (lambda (name) - (and (string-match x-font-regexp name) - (list - (string-to-int (substring name (match-beginning 5) - (match-end 5))) - (string-to-int (substring name (match-beginning 6) - (match-end 6))) - name)))) - (list-fonts font device))) - (function (lambda (x y) (if (= (nth 1 x) (nth 1 y)) - (< (nth 0 x) (nth 0 y)) - (< (nth 1 x) (nth 1 y))))))) - -;; Given a font name, this attempts to construct a valid font name for -;; DEVICE whose size is the next smaller (if UP-P is nil) or larger -;; (if UP-P is t) size and whose other characteristics are the same -;; as the given font. - -(defun x-frob-font-size (font up-p device) - (if (stringp font) (setq font (make-font-instance font device))) - (if (font-instance-p font) (setq font (font-instance-truename font))) - (let ((available (and font - (x-available-font-sizes font device)))) - (cond - ((null available) nil) - ((or (= 0 (nth 0 (car available))) - (= 0 (nth 1 (car available)))) - ;; R5 scalable fonts: change size by 1 point. - ;; If they're scalable the first font will have pixel or point = 0. - ;; Sometimes one is 0 and the other isn't (if it's a bitmap font that - ;; can be scaled), sometimes both are (if it's a true outline font). - (let ((name (nth 2 (car available))) - old-size) - (or (string-match x-font-regexp font) (error "can't parse %S" font)) - (setq old-size (string-to-int - (substring font (match-beginning 6) (match-end 6)))) - (or (> old-size 0) (error "font truename has 0 pointsize?")) - (or (string-match x-font-regexp name) (error "can't parse %S" name)) - ;; turn pixelsize into a wildcard, and make pointsize be +/- 10, - ;; which is +/- 1 point. All other fields stay the same as they - ;; were in the "template" font returned by x-available-font-sizes. - ;; - ;; #### But this might return the same font: for example, if the - ;; truename of "-*-courier-medium-r-normal--*-230-75-75-m-0-*" - ;; is "...-240-..." (instead of 230) then this loses, because - ;; the 230 that was passed in as an arg got turned into 240 - ;; by the call to font-instance-truename; then we decrement that - ;; by 10 and return the result which is the same. I think the - ;; way to fix this is to make this be a loop that keeps trying - ;; progressively larger pointsize deltas until it finds one - ;; whose truename differs. Have to be careful to avoid infinite - ;; loops at the upper end... - ;; - (concat (substring name 0 (match-beginning 5)) "*" - (substring name (match-end 5) (match-beginning 6)) - (int-to-string (+ old-size (if up-p 10 -10))) - (substring name (match-end 6) (match-end 0))))) - (t - ;; non-scalable fonts: take the next available size. - (let ((rest available) - (last nil) - result) - (setq font (downcase font)) - (while rest - (cond ((and (not up-p) (equal font (downcase (nth 2 (car rest))))) - (setq result last - rest nil)) - ((and up-p (equal font (and last (downcase (nth 2 last))))) - (setq result (car rest) - rest nil))) - (setq last (car rest)) - (setq rest (cdr rest))) - (nth 2 result)))))) - -(defun x-find-smaller-font (font &optional device) - "Load a new, slightly smaller version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point smaller. -Otherwise, it returns the next smaller version of this font that is defined." - (x-frob-font-size font nil device)) - -(defun x-find-larger-font (font &optional device) - "Load a new, slightly larger version of the given font (or font name). -Returns the font if it succeeds, nil otherwise. -If scalable fonts are available, this returns a font which is 1 point larger. -Otherwise, it returns the next larger version of this font that is defined." - (x-frob-font-size font t device)) - -(defalias 'x-make-face-bold 'make-face-bold) -(defalias 'x-make-face-italic 'make-face-italic) -(defalias 'x-make-face-bold-italic 'make-face-bold-italic) -(defalias 'x-make-face-unbold 'make-face-unbold) -(defalias 'x-make-face-unitalic 'make-face-unitalic) - -(make-obsolete 'x-make-face-bold 'make-face-bold) -(make-obsolete 'x-make-face-italic 'make-face-italic) -(make-obsolete 'x-make-face-bold-italic 'make-face-bold-italic) -(make-obsolete 'x-make-face-unbold 'make-face-unbold) -(make-obsolete 'x-make-face-unitalic 'make-face-unitalic) - - -;;; internal routines - -;;; x-init-face-from-resources is responsible for initializing a -;;; newly-created face from the resource database. -;;; -;;; When a new frame is created, it is called from `x-init-frame-faces' -;;; called from `init-frame-faces' called from init_frame_faces() -;;; from Fmake_frame(). In this case it is called once for each existing -;;; face, with the newly-created frame as the argument. It then initializes -;;; the newly-created faces on that frame. -;;; -;;; It's also called from `init-device-faces' and -;;; `init-global-faces'. -;;; -;;; This had better not signal an error. The frame is in an intermediate -;;; state where signalling an error or entering the debugger would likely -;;; result in a crash. - -(defun x-init-face-from-resources (face &optional locale set-anyway) - - ;; - ;; These are things like "attributeForeground" instead of simply - ;; "foreground" because people tend to do things like "*foreground", - ;; which would cause all faces to be fully qualified, making faces - ;; inherit attributes in a non-useful way. So we've made them slightly - ;; less obvious to specify in order to make them work correctly in - ;; more random environments. - ;; - ;; I think these should be called "face.faceForeground" instead of - ;; "face.attributeForeground", but they're the way they are for - ;; hysterical reasons. (jwz) - - (let* ((append (if set-anyway nil 'append)) - ;; Some faces are initialized before XEmacs is dumped. - ;; In order for the X resources to be able to override - ;; those settings, such initialization always uses the - ;; `default' tag. We remove all specifier specs - ;; containing the `default' tag in the locale before - ;; adding new specs. - (tag-set '(default)) - ;; The tag order matters here. The spec removal - ;; function uses the list cdrs. We want to remove (x - ;; default) and (default) specs, not (default x) and (x) - ;; specs. - (x-tag-set '(x default)) - (tty-tag-set '(tty default)) - (device-class nil) - (face-sym (face-name face)) - (name (symbol-name face-sym)) - (fn (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeFont") - "Face.AttributeFont" - 'string locale)) - (fg (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeForeground") - "Face.AttributeForeground" - 'string locale)) - (bg (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeBackground") - "Face.AttributeBackground" - 'string locale)) - (bgp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeBackgroundPixmap") - "Face.AttributeBackgroundPixmap" - 'string locale)) - (ulp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeUnderline") - "Face.AttributeUnderline" - 'boolean locale)) - (stp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeStrikethru") - "Face.AttributeStrikethru" - 'boolean locale)) - ;; we still resource for these TTY-only resources so that - ;; you can specify resources for TTY frames/devices. This is - ;; useful when you start up your XEmacs on an X display and later - ;; open some TTY frames. - (hp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeHighlight") - "Face.AttributeHighlight" - 'boolean locale)) - (dp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeDim") - "Face.AttributeDim" - 'boolean locale)) - (bp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeBlinking") - "Face.AttributeBlinking" - 'boolean locale)) - (rp (x-get-resource-and-maybe-bogosity-check - (concat name ".attributeReverse") - "Face.AttributeReverse" - 'boolean locale)) - ) - - (cond ((framep locale) - (setq device-class (device-class (frame-device locale)))) - ((devicep locale) - (setq device-class (device-class locale)))) - - (if device-class - (setq tag-set (cons device-class tag-set) - x-tag-set (cons device-class x-tag-set) - tty-tag-set (cons device-class tty-tag-set))) - - ;; - ;; If this is the default face, then any unspecified properties should - ;; be defaulted from the global properties. Can't do this for - ;; frames or devices because then, common resource specs like - ;; "*Foreground: black" will have unwanted effects. - ;; - (if (and (or (eq (face-name face) 'default) - (eq (face-name face) 'gui-element)) - (or (null locale) (eq locale 'global))) - (progn - (or fn (setq fn (x-get-resource - "font" "Font" 'string locale))) - (or fg (setq fg (x-get-resource - "foreground" "Foreground" 'string locale))) - (or bg (setq bg (x-get-resource - "background" "Background" 'string locale))))) - ;; - ;; "*cursorColor: foo" is equivalent to setting the background of the - ;; text-cursor face. - ;; - (if (and (eq (face-name face) 'text-cursor) - (or (null locale) (eq locale 'global))) - (setq bg (or (x-get-resource - "cursorColor" "CursorColor" 'string locale) bg))) - ;; #### should issue warnings? I think this should be - ;; done when the instancing actually happens, but I'm not - ;; sure how it should actually be dealt with. - (when fn - (if device-class - ;; Always use the x-tag-set to remove specs, since we don't - ;; know whether the predumped face was initialized with an - ;; 'x tag or not. - (remove-specifier-specs-matching-tag-set-cdrs (face-font face) - locale - x-tag-set) - ;; If there's no device class then we're initializing - ;; globally. This means we should override global - ;; defaults for all X device classes. - (remove-specifier (face-font face) locale x-tag-set nil)) - (set-face-font face fn locale nil append)) - ;; Kludge-o-rooni. Set the foreground and background resources for - ;; X devices only -- otherwise things tend to get all messed up - ;; if you start up an X frame and then later create a TTY frame. - (when fg - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-foreground face) - locale - x-tag-set) - (remove-specifier (face-foreground face) locale x-tag-set nil)) - (set-face-foreground face fg locale 'x append)) - (when bg - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-background face) - locale - x-tag-set) - (remove-specifier (face-background face) locale x-tag-set nil)) - (set-face-background face bg locale 'x append)) - (when bgp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-background-pixmap - face) - locale - x-tag-set) - (remove-specifier (face-background-pixmap face) locale x-tag-set nil)) - (set-face-background-pixmap face bgp locale nil append)) - (when ulp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'underline) - locale - tty-tag-set) - (remove-specifier (face-property face 'underline) locale - tty-tag-set nil)) - (set-face-underline-p face ulp locale nil append)) - (when stp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'strikethru) - locale - tty-tag-set) - (remove-specifier (face-property face 'strikethru) - locale tty-tag-set nil)) - (set-face-strikethru-p face stp locale nil append)) - (when hp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'highlight) - locale - tty-tag-set) - (remove-specifier (face-property face 'highlight) - locale tty-tag-set nil)) - (set-face-highlight-p face hp locale nil append)) - (when dp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'dim) - locale - tty-tag-set) - (remove-specifier (face-property face 'dim) locale tty-tag-set nil)) - (set-face-dim-p face dp locale nil append)) - (when bp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'blinking) - locale - tty-tag-set) - (remove-specifier (face-property face 'blinking) locale - tty-tag-set nil)) - (set-face-blinking-p face bp locale nil append)) - (when rp - (if device-class - (remove-specifier-specs-matching-tag-set-cdrs (face-property - face 'reverse) - locale - tty-tag-set) - (remove-specifier (face-property face 'reverse) locale - tty-tag-set nil)) - (set-face-reverse-p face rp locale nil append)) - )) - -;; GNU Emacs compatibility. (move to obsolete.el?) -(defalias 'make-face-x-resource-internal 'x-init-face-from-resources) - -(defun remove-specifier-specs-matching-tag-set-cdrs (specifier locale tag-set) - (while tag-set - (remove-specifier specifier locale tag-set t) - (setq tag-set (cdr tag-set)))) - -;;; x-init-global-faces is responsible for ensuring that the -;;; default face has some reasonable fallbacks if nothing else is -;;; specified. -;;; -(defun x-init-global-faces () - (or (face-font 'default 'global) - (set-face-font 'default - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*") - 'global) - (or (face-foreground 'default 'global) - (set-face-foreground 'default "black" 'global 'x)) - (or (face-background 'default 'global) - (set-face-background 'default "gray80" 'global 'x))) - -;;; x-init-device-faces is responsible for initializing default -;;; values for faces on a newly created device. -;;; -(defun x-init-device-faces (device) - ;; - ;; If the "default" face didn't have a font specified, try to pick one. - ;; - (or - (face-font-instance 'default device) - ;; - ;; No font specified in the resource database; try to cope. - ;; - ;; At first I wanted to do this by just putting a font-spec in the - ;; fallback resources passed to XtAppInitialize(), but that fails - ;; if there is an Emacs app-defaults file which doesn't specify a - ;; font: apparently the fallback resources are not consulted when - ;; there is an app-defaults file, which seems pretty bogus to me. - ;; - ;; We should also probably try "*xtDefaultFont", but I think that it - ;; might be legal to specify that as "xtDefaultFont:", that is, at - ;; top level, instead of "*xtDefaultFont:", that is, applicable to - ;; every application. `x-get-resource' can't handle that right now. - ;; Anyway, xtDefaultFont is probably variable-width. - ;; - ;; Some who have LucidaTypewriter think it's a better font than Courier, - ;; but it has the bug that there are no italic and bold italic versions. - ;; We could hair this code up to try and mix-and-match fonts to get a - ;; full complement, but really, why bother. It's just a default. - ;; - (let (new-x-font) - (setq new-x-font (or - ;; - ;; We default to looking for iso8859 fonts. Using a wildcard for the - ;; encoding would be bad, because that can cause English speakers to get - ;; Kanji fonts by default. It is safe to assume that people using a - ;; language other than English have both set $LANG, and have specified - ;; their `font' and `fontList' resources. In any event, it's better to - ;; err on the side of the English speaker in this case because they are - ;; much less likely to have encountered this problem, and are thus less - ;; likely to know what to do about it. - - ;; Try for Courier. Almost everyone has that. (Does anyone not?) - (make-font-instance - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*" device t) - (make-font-instance - "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t) - ;; Next try for any "medium" charcell or monospaced iso8859 font. - (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*" device t) - (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*" device t) - ;; Next try for any charcell or monospaced iso8859 font. - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*" device t) - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*" device t) - ;; Ok, let's at least try to stay in 8859... - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*" device t) - ;; Boy, we sure are losing now. Try the above, but in any encoding. - (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*" device t) - (make-font-instance "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*" device t) - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-m-*-*-*" device t) - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-c-*-*-*" device t) - (make-font-instance "-*-*-*-r-*-*-*-120-*-*-*-*-*-*" device t) - ;; Hello? Please? - (make-font-instance "-*-*-*-*-*-*-*-120-*-*-*-*-*-*" device t) - (make-font-instance "*" device t) - ;; if we get to here we're screwed, and faces.c will fatal()... - )) - (if (not (face-font 'default 'global)) - (set-face-font 'default new-x-font) - (set-face-font 'default new-x-font device)))) - ;; - ;; If the "default" face didn't have both colors specified, then pick - ;; some, taking into account whether one of the colors was specified. - ;; - (let ((fg (face-foreground-instance 'default device)) - (bg (face-background-instance 'default device))) - (if (not (and fg bg)) - (if (or (and fg (equal (downcase (color-instance-name fg)) "white")) - (and bg (equal (downcase (color-instance-name bg)) "black"))) - (progn - (or fg (set-face-foreground 'default "white" device)) - (or bg (set-face-background 'default "black" device))) - (or fg (set-face-foreground 'default "white" device)) - (or bg (set-face-background 'default "black" device))))) - - ;; Don't look at reverseVideo now or initialize the modeline. This - ;; is done on a per-frame basis at the appropriate time. - - ;; - ;; Now let's try to pick some reasonable defaults for a few other faces. - ;; This kind of stuff should normally go on the create-frame-hook, but - ;; this way we won't be in danger of the user screwing things up by not - ;; adding hooks in a safe way. - ;; - (x-init-pointer-shape device) ; from x-mouse.el - ) - -;;; This is called from `init-frame-faces', which is called from -;;; init_frame_faces() which is called from Fmake_frame(), to perform -;;; any device-specific initialization. -;;; -(defun x-init-frame-faces (frame) - ;; - ;; The faces already got initialized (by init-frame-faces) from - ;; the resource database or global, non-frame faces. The default, - ;; bold, bold-italic, and italic faces (plus various other random faces) - ;; got set up then. But modeline didn't so that reverseVideo can be - ;; frame-specific. - ;; - - ;; - ;; If reverseVideo was specified, swap the foreground and background - ;; of the default and modeline faces. - ;; - (cond ((car (x-get-resource "reverseVideo" "ReverseVideo" 'boolean frame)) - ;; First make sure the modeline has fg and bg, inherited from the - ;; current default face - for the case where only one is specified, - ;; so that invert-face doesn't do something weird. - (or (face-foreground 'modeline frame) - (set-face-foreground 'modeline - (face-foreground-instance 'default frame) - frame)) - (or (face-background 'modeline frame) - (set-face-background 'modeline - (face-background-instance 'default frame) - frame)) - ;; Now invert both of them. If they end up looking the same, - ;; make-frame-initial-faces will invert the modeline again later. - (invert-face 'default frame) - (invert-face 'modeline frame) - ))) - -;;; x-faces.el ends here diff --git a/lisp/x-font-menu.el b/lisp/x-font-menu.el deleted file mode 100644 index 9a1db5c..0000000 --- a/lisp/x-font-menu.el +++ /dev/null @@ -1,576 +0,0 @@ -;; x-font-menu.el --- Managing menus of X fonts. - -;; Copyright (C) 1994 Free Software Foundation, Inc. -;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -;; Copyright (C) 1997 Sun Microsystems - -;; Author: Jamie Zawinski -;; Restructured by: Jonathan Stigelman -;; Mule-ized by: Martin Buchholz - -;; 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. - -;;; Commentary: -;;; -;;; Creates three menus, "Font", "Size", and "Weight", and puts them on the -;;; "Options" menu. The contents of these menus are the superset of those -;;; properties available on any fonts, but only the intersection of the three -;;; sets is selectable at one time. -;;; -;;; Known Problems: -;;; =============== -;;; Items on the Font menu are selectable if and only if that font exists in -;;; the same size and weight as the current font. This means that some fonts -;;; are simply not reachable from some other fonts - if only one font comes -;;; in only one point size (like "Nil", which comes only in 2), you will never -;;; be able to select it. It would be better if the items on the Fonts menu -;;; were always selectable, and selecting them would set the size to be the -;;; closest size to the current font's size. -;;; -;;; This attempts to change all other faces in an analagous way to the change -;;; that was made to the default face; if it can't, it will skip over the face. -;;; However, this could leave incongruous font sizes around, which may cause -;;; some nonreversibility problems if further changes are made. Perhaps it -;;; should remember the initial fonts of all faces, and derive all subsequent -;;; fonts from that initial state. -;;; -;;; xfontsel(1) is a lot more flexible (but probably harder to understand). -;;; -;;; The code to construct menus from all of the x11 fonts available from the -;;; server is autoloaded and executed the very first time that one of the Font -;;; menus is selected on each device. That is, if XEmacs has frames on two -;;; different devices, then separate font menu information will be maintained -;;; for each X display. If the font path changes after emacs has already -;;; asked the X server on a particular display for its list of fonts, this -;;; won't notice. Also, the first time that a font menu is posted on each -;;; display will entail a lengthy delay, but that's better than slowing down -;;; XEmacs startup. At any time (i.e.: after a font-path change or -;;; immediately after device creation), you can call -;;; `reset-device-font-menus' to rebuild the menus from all currently -;;; available fonts. -;;; -;;; There is knowledge here about the regexp match numbers in -;;; `x-font-regexp' and `x-font-regexp-foundry-and-family' defined in -;;; x-faces.el. -;;; -;;; There are at least three kinds of fonts under X11r5: -;;; -;;; - bitmap fonts, which can be assumed to look as good as possible; -;;; - bitmap fonts which have been (or can be) automatically scaled to -;;; a new size, and which almost always look awful; -;;; - and true outline fonts, which should look ok at any size, but in -;;; practice (on at least some systems) look awful at any size, and -;;; even in theory are unlikely ever to look as good as non-scaled -;;; bitmap fonts. -;;; -;;; It would be nice to get this code to look for non-scaled bitmap fonts -;;; first, then outline fonts, then scaled bitmap fonts as a last resort. -;;; But it's not clear to me how to tell them apart based on their truenames -;;; and/or the result of XListFonts(). I welcome any and all explanations -;;; of the subtleties involved... -;;; -;;; -;;; If You Think You'Re Seeing A Bug: -;;; ================================= -;;; When reporting problems, send the following information: -;;; -;;; - Exactly what behavior you're seeing; -;;; - The output of the `xlsfonts' program; -;;; - The value of the variable `device-fonts-cache'; -;;; - The values of the following expressions, both before and after -;;; making a selection from any of the fonts-related menus: -;;; (face-font 'default) -;;; (font-truename (face-font 'default)) -;;; (font-properties (face-font 'default)) -;;; - The values of the following variables after making a selection: -;;; font-menu-preferred-resolution -;;; font-menu-registry-encoding -;;; -;;; There is a common misconception that "*-courier-medium-r-*-11-*", also -;;; known as "-adobe-courier-medium-r-normal--11-80-100-100-m-60-iso8859-1", -;;; is an 11-point font. It is not -- it is an 11-pixel font at 100dpi, -;;; which is an 8-point font (the number after -11- is the size in tenths -;;; of points). So if you expect to be seeing an "11" entry in the "Size" -;;; menu and are not, this may be why. -;;; -;;; In the real world (aka Solaris), one has to deal with fonts that -;;; appear to be medium-i but are really light-r, and fonts that -;;; resolve to different resolutions depending on the charset: -;;; -;;; (font-instance-truename -;;; (make-font-instance "-*-mincho-medium-i-normal-*-*-*-*-*-*-*-jisx0201*-*")) -;;; ==> -;;; "-morisawa-ryumin light kl-light-r-normal--10-100-72-72-m-50-jisx0201.1976-0" -;;; -;;; (list-fonts "-dt-interface user-medium-r-normal-s*-*-*-*-*-*-*-*-*") -;;; ==> -;;; ("-dt-interface user-medium-r-normal-s sans-12-120-72-72-m-70-iso8859-1" -;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-120-jisx0208.1983-0" -;;; "-dt-interface user-medium-r-normal-s-14-120-75-75-m-60-jisx0201.1976-0") - -;;; Code: - -;; #### - implement these... -;; -;;; (defvar font-menu-ignore-proportional-fonts nil -;;; "*If non-nil, then the font menu will only show fixed-width fonts.") - -;;;###autoload -(defcustom font-menu-ignore-scaled-fonts t - "*If non-nil, then the font menu will try to show only bitmap fonts." - :type 'boolean - :group 'x) - -;;;###autoload -(defcustom font-menu-this-frame-only-p nil - "*If non-nil, then changing the default font from the font menu will only -affect one frame instead of all frames." - :type 'boolean - :group 'x) - -;; only call XListFonts (and parse) once per device. -;; ( (device . [parsed-list-fonts family-menu size-menu weight-menu]) ...) -(defvar device-fonts-cache nil) - -(defvar font-menu-registry-encoding nil - "Registry and encoding to use with font menu fonts.") - -(defvar font-menu-preferred-resolution "*-*" - "Preferred horizontal and vertical font menu resolution (e.g. \"75-75\").") - -(defvar fonts-menu-junk-families - (purecopy - (mapconcat - #'identity - '("cursor" "glyph" "symbol" ; Obvious losers. - "\\`Ax...\\'" ; FrameMaker fonts - there are just way too - ; many of these, and there is a different - ; font family for each font face! Losers. - ; "Axcor" -> "Applix Courier Roman", - ; "Axcob" -> "Applix Courier Bold", etc. - ) - "\\|")) - "A regexp matching font families which are uninteresting (e.g. cursor fonts).") - -(eval-when-compile - (defsubst device-fonts-cache () - (or (cdr (assq (selected-device) device-fonts-cache)) - (reset-device-font-menus (selected-device))))) - -(defun hack-font-truename (fn) - "Filter the output of `font-instance-truename' to deal with Japanese fontsets." - (if (string-match "," (font-instance-truename fn)) - (let ((fpnt (nth 8 (split-string (font-instance-name fn) "-"))) - (flist (split-string (font-instance-truename fn) ",")) - ret) - (while flist - (if (string-equal fpnt (nth 8 (split-string (car flist) "-"))) - (progn (setq ret (car flist)) (setq flist nil)) - (setq flist (cdr flist)) - )) - ret) - (font-instance-truename fn))) - -;;;###autoload -(fset 'install-font-menus 'reset-device-font-menus) -(make-obsolete 'install-font-menus 'reset-device-font-menus) - -(defvar x-font-regexp-ascii nil - "This is used to filter out font families that can't display ASCII text. -It must be set at run-time.") - -(defun vassoc (key valist) - "Search VALIST for a vector whose first element is equal to KEY. -See also `assoc'." - ;; by Stig@hackvan.com - (let (el) - (catch 'done - (while (setq el (pop valist)) - (and (equal key (aref el 0)) - (throw 'done el)))))) - -;;;###autoload -(defun reset-device-font-menus (&optional device debug) - "Generates the `Font', `Size', and `Weight' submenus for the Options menu. -This is run the first time that a font-menu is needed for each device. -If you don't like the lazy invocation of this function, you can add it to -`create-device-hook' and that will make the font menus respond more quickly -when they are selected for the first time. If you add fonts to your system, -or if you change your font path, you can call this to re-initialize the menus." - ;; by Stig@hackvan.com - ;; #### - this should implement a `menus-only' option, which would - ;; recalculate the menus from the cache w/o having to do list-fonts again. - (message "Getting list of fonts from server... ") - (if (or noninteractive - (not (or device (setq device (selected-device)))) - (not (eq (device-type device) 'x))) - nil - (unless x-font-regexp-ascii - (setq x-font-regexp-ascii (if (featurep 'mule) - (charset-registry 'ascii) - "iso8859-1"))) - (setq font-menu-registry-encoding - (if (featurep 'mule) "*-*" "iso8859-1")) - (let ((case-fold-search t) - family size weight entry monospaced-p - dev-cache cache families sizes weights) - (dolist (name (cond ((null debug) ; debugging kludge - (list-fonts "*-*-*-*-*-*-*-*-*-*-*-*-*-*" device)) - ((stringp debug) (split-string debug "\n")) - (t debug))) - (when (and (string-match x-font-regexp-ascii name) - (string-match x-font-regexp name)) - (setq weight (capitalize (match-string 1 name)) - size (string-to-int (match-string 6 name))) - (or (string-match x-font-regexp-foundry-and-family name) - (error "internal error")) - (setq family (capitalize (match-string 1 name))) - (or (string-match x-font-regexp-spacing name) - (error "internal error")) - (setq monospaced-p (string= "m" (match-string 1 name))) - (unless (string-match fonts-menu-junk-families family) - (setq entry (or (vassoc family cache) - (car (setq cache - (cons (vector family nil nil t) - cache))))) - (or (member family families) (push family families)) - (or (member weight weights) (push weight weights)) - (or (member size sizes) (push size sizes)) - (or (member weight (aref entry 1)) (push weight (aref entry 1))) - (or (member size (aref entry 2)) (push size (aref entry 2))) - (aset entry 3 (and (aref entry 3) monospaced-p))))) - ;; - ;; Hack scalable fonts. - ;; Some fonts come only in scalable versions (the only size is 0) - ;; and some fonts come in both scalable and non-scalable versions - ;; (one size is 0). If there are any scalable fonts at all, make - ;; sure that the union of all point sizes contains at least some - ;; common sizes - it's possible that some sensible sizes might end - ;; up not getting mentioned explicitly. - ;; - (if (member 0 sizes) - (let ((common '(60 80 100 120 140 160 180 240))) - (while common - (or;;(member (car common) sizes) ; not enough slack - (let ((rest sizes) - (done nil)) - (while (and (not done) rest) - (if (and (> (car common) (- (car rest) 5)) - (< (car common) (+ (car rest) 5))) - (setq done t)) - (setq rest (cdr rest))) - done) - (setq sizes (cons (car common) sizes))) - (setq common (cdr common))) - (setq sizes (delq 0 sizes)))) - - (setq families (sort families 'string-lessp) - weights (sort weights 'string-lessp) - sizes (sort sizes '<)) - - (dolist (entry cache) - (aset entry 1 (sort (aref entry 1) 'string-lessp)) - (aset entry 2 (sort (aref entry 2) '<))) - - (message "Getting list of fonts from server... done.") - - (setq dev-cache (assq device device-fonts-cache)) - (or dev-cache - (setq dev-cache (car (push (list device) device-fonts-cache)))) - (setcdr - dev-cache - (vector - cache - (mapcar (lambda (x) - (vector x - (list 'font-menu-set-font x nil nil) - ':style 'radio ':active nil ':selected nil)) - families) - (mapcar (lambda (x) - (vector (if (/= 0 (% x 10)) - ;; works with no LISP_FLOAT_TYPE - (concat (int-to-string (/ x 10)) "." - (int-to-string (% x 10))) - (int-to-string (/ x 10))) - (list 'font-menu-set-font nil nil x) - ':style 'radio ':active nil ':selected nil)) - sizes) - (mapcar (lambda (x) - (vector x - (list 'font-menu-set-font nil x nil) - ':style 'radio ':active nil ':selected nil)) - weights))) - (cdr dev-cache)))) - -;; Extract font information from a face. We examine both the -;; user-specified font name and the canonical (`true') font name. -;; These can appear to have totally different properties. -;; For examples, see the prolog above. - -;; We use the user-specified one if possible, else use the truename. -;; If the user didn't specify one (with "-dt-*-*", for example) -;; get the truename and use the possibly suboptimal data from that. -(defun* font-menu-font-data (face dcache) - (let* ((case-fold-search t) - (domain (if font-menu-this-frame-only-p - (selected-frame) - (selected-device))) - (name (font-instance-name (face-font-instance face domain))) - (truename (font-instance-truename - (face-font-instance face domain - (if (featurep 'mule) 'ascii)))) - family size weight entry slant) - (when (string-match x-font-regexp-foundry-and-family name) - (setq family (capitalize (match-string 1 name))) - (setq entry (vassoc family (aref dcache 0)))) - (when (and (null entry) - (string-match x-font-regexp-foundry-and-family truename)) - (setq family (capitalize (match-string 1 truename))) - (setq entry (vassoc family (aref dcache 0)))) - (when (null entry) - (return-from font-menu-font-data (make-vector 5 nil))) - - (when (string-match x-font-regexp name) - (setq weight (capitalize (match-string 1 name))) - (setq size (string-to-int (match-string 6 name)))) - - (when (string-match x-font-regexp truename) - (when (not (member weight (aref entry 1))) - (setq weight (capitalize (match-string 1 truename)))) - (when (not (member size (aref entry 2))) - (setq size (string-to-int (match-string 6 truename)))) - (setq slant (capitalize (match-string 2 truename)))) - - (vector entry family size weight slant))) - -;;;###autoload -(defun font-menu-family-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - (size (aref font-data 2)) - (weight (aref font-data 3)) - f) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Font menu are enabled iff that font exists in - ;; the same size and weight as the current font (scalable fonts - ;; exist in every size). Only the current font is marked as - ;; selected. - (mapcar - (lambda (item) - (setq f (aref item 0) - entry (vassoc f (aref dcache 0))) - (if (and (member weight (aref entry 1)) - (or (member size (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2))))) - (enable-menu-item item) - (disable-menu-item item)) - (if (string-equal family f) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 1))))) - -;;;###autoload -(defun font-menu-size-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - (size (aref font-data 2)) - ;;(weight (aref font-data 3)) - s) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Size menu are enabled iff current font has - ;; that size. Only the size of the current font is selected. - ;; (If the current font comes in size 0, it is scalable, and - ;; thus has every size.) - (mapcar - (lambda (item) - (setq s (nth 3 (aref item 1))) - (if (or (member s (aref entry 2)) - (and (not font-menu-ignore-scaled-fonts) - (member 0 (aref entry 2)))) - (enable-menu-item item) - (disable-menu-item item)) - (if (eq size s) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 2))))) - -;;;###autoload -(defun font-menu-weight-constructor (ignored) - (catch 'menu - (unless (eq 'x (device-type (selected-device))) - (throw 'menu '(["Cannot parse current font" ding nil]))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (entry (aref font-data 0)) - (family (aref font-data 1)) - ;;(size (aref font-data 2)) - (weight (aref font-data 3)) - w) - (unless family - (throw 'menu '(["Cannot parse current font" ding nil]))) - ;; Items on the Weight menu are enabled iff current font - ;; has that weight. Only the weight of the current font - ;; is selected. - (mapcar - (lambda (item) - (setq w (aref item 0)) - (if (member w (aref entry 1)) - (enable-menu-item item) - (disable-menu-item item)) - (if (string-equal weight w) - (select-toggle-menu-item item) - (deselect-toggle-menu-item item)) - item) - (aref dcache 3))))) - - -;;; Changing font sizes - -(defun font-menu-set-font (family weight size) - ;; This is what gets run when an item is selected from any of the three - ;; fonts menus. It needs to be rather clever. - ;; (size is measured in 10ths of points.) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data 'default dcache)) - (from-family (aref font-data 1)) - (from-size (aref font-data 2)) - (from-weight (aref font-data 3)) - (from-slant (aref font-data 4)) - new-default-face-font - new-props) - (unless from-family - (signal 'error '("couldn't parse font name for default face"))) - (when weight - (signal 'error '("Setting weight currently not supported"))) - (setq new-default-face-font - (font-menu-load-font (or family from-family) - (or weight from-weight) - (or size from-size) - from-slant - font-menu-preferred-resolution)) - (dolist (face (delq 'default (face-list))) - (when (face-font-instance face) - (message "Changing font of `%s'..." face) - (condition-case c - (font-menu-change-face face - from-family from-weight from-size - family weight size) - (error - (display-error c nil) - (sit-for 1))))) - ;; Set the default face's font after hacking the other faces, so that - ;; the frame size doesn't change until we are all done. - - ;; If we need to be frame local we do the changes ourselves. - (if font-menu-this-frame-only-p - ;;; WMP - we need to honor font-menu-this-frame-only-p here! - (set-face-font 'default new-default-face-font - (and font-menu-this-frame-only-p (selected-frame))) - ;; OK Let Customize do it. - (when (and family (not (equal family from-family))) - (setq new-props (append (list :family family) new-props))) - (when (and size (not (equal size from-size))) - (setq new-props (append - (list :size (concat (int-to-string (/ size 10)) "pt")) new-props))) - (custom-set-face-update-spec 'default '((type x)) new-props) - (message "Font %s" (face-font-name 'default))))) - - -(defun font-menu-change-face (face - from-family from-weight from-size - to-family to-weight to-size) - (or (symbolp face) (signal 'wrong-type-argument (list 'symbolp face))) - (let* ((dcache (device-fonts-cache)) - (font-data (font-menu-font-data face dcache)) - (face-family (aref font-data 1)) - (face-size (aref font-data 2)) - (face-weight (aref font-data 3)) - (face-slant (aref font-data 4))) - - (or face-family - (signal 'error (list "couldn't parse font name for face" face))) - - ;; If this face matches the old default face in the attribute we - ;; are changing, then change it to the new attribute along that - ;; dimension. Also, the face must have its own global attribute. - ;; If its value is inherited, we don't touch it. If any of this - ;; is not true, we leave it alone. - (when (and (face-font face 'global) - (cond - (to-family (string-equal face-family from-family)) - (to-weight (string-equal face-weight from-weight)) - (to-size (= face-size from-size)))) - (set-face-font face - (font-menu-load-font (or to-family face-family) - (or to-weight face-weight) - (or to-size face-size) - face-slant - font-menu-preferred-resolution) - (and font-menu-this-frame-only-p - (selected-frame)))))) - -(defun font-menu-load-font (family weight size slant resolution) - "Try to load a font with the requested properties. -The weight, slant and resolution are only hints." - (when (integerp size) (setq size (int-to-string size))) - (let (font) - (catch 'got-font - (dolist (weight (list weight "*")) - (dolist (slant - (cond ((string-equal slant "O") '("O" "I" "*")) - ((string-equal slant "I") '("I" "O" "*")) - ((string-equal slant "*") '("*")) - (t (list slant "*")))) - (dolist (resolution - (if (string-equal resolution "*-*") - (list resolution) - (list resolution "*-*"))) - (when (setq font - (make-font-instance - (concat "-*-" family "-" weight "-" slant "-*-*-*-" - size "-" resolution "-*-*-" - font-menu-registry-encoding) - nil t)) - (throw 'got-font font)))))))) - -(defun flush-device-fonts-cache (device) - ;; by Stig@hackvan.com - (let ((elt (assq device device-fonts-cache))) - (and elt - (setq device-fonts-cache (delq elt device-fonts-cache))))) - -(add-hook 'delete-device-hook 'flush-device-fonts-cache) - -(provide 'x-font-menu) - -;;; x-font-menu.el ends here diff --git a/lisp/x-init.el b/lisp/x-init.el deleted file mode 100644 index 5df11b2..0000000 --- a/lisp/x-init.el +++ /dev/null @@ -1,377 +0,0 @@ -;;; x-init.el --- initialization code for X windows - -;; Copyright (C) 1990, 1993, 1994, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Board of Trustees, University of Illinois. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: terminals, dumped - -;; 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. - -;;; Commentary: - -;; This file is dumped with XEmacs (when X support is compiled in). - -;;; Code: - -;; If you want to change this variable, this is the place you must do it. -;; Do not set it to a string containing periods. X doesn't like that. -;(setq x-emacs-application-class "Emacs") - -(defgroup x nil - "The X Window system." - :group 'environment) - -;; selections and active regions - -;; If and only if zmacs-regions is true: - -;; When a mark is pushed and the region goes into the "active" state, we -;; assert it as the Primary selection. This causes it to be hilighted. -;; When the region goes into the "inactive" state, we disown the Primary -;; selection, causing the region to be dehilighted. - -;; Note that it is possible for the region to be in the "active" state -;; and not be hilighted, if it is in the active state and then some other -;; application asserts the selection. This is probably not a big deal. - -(defun x-activate-region-as-selection () - (if (marker-buffer (mark-marker t)) - (x-own-selection (cons (point-marker t) (mark-marker t))))) - -;; OpenWindows-like "find" processing. These functions are really Sunisms, -;; but we put them here instead of in x-win-sun.el in case someone wants -;; to use them when not running on a Sun console (presumably after binding -;; them to different keys, or putting them on menus.) - -(defvar ow-find-last-string nil) -(defvar ow-find-last-clipboard nil) - -(defun ow-find (&optional backward-p) - "Search forward the next occurrence of the text of the selection." - (interactive) - (let ((sel (condition-case () (x-get-selection) (error nil))) - (clip (condition-case () (x-get-clipboard) (error nil))) - text) - (setq text (cond - (sel) - ((not (equal clip ow-find-last-clipboard)) - (setq ow-find-last-clipboard clip)) - (ow-find-last-string) - (t (error "No selection available")))) - (setq ow-find-last-string text) - (cond (backward-p - (search-backward text) - (set-mark (+ (point) (length text)))) - (t - (search-forward text) - (set-mark (- (point) (length text))))) - (zmacs-activate-region))) - -(defun ow-find-backward () - "Search backward for the previous occurrence of the text of the selection." - (interactive) - (ow-find t)) - -;; Load X-server specific code. -;; Specifically, load some code to repair the grievous damage that MIT and -;; Sun have done to the default keymap for the Sun keyboards. - -(eval-when-compile - (defmacro x-define-dead-key (key map) - `(when (x-keysym-on-keyboard-p ',key) - (define-key function-key-map [,key] ',map)))) - -(defun x-initialize-compose () - "Enable compose key and dead key processing." - (autoload 'compose-map "x-compose" nil t 'keymap) - (autoload 'compose-acute-map "x-compose" nil t 'keymap) - (autoload 'compose-grave-map "x-compose" nil t 'keymap) - (autoload 'compose-cedilla-map "x-compose" nil t 'keymap) - (autoload 'compose-diaeresis-map "x-compose" nil t 'keymap) - (autoload 'compose-circumflex-map "x-compose" nil t 'keymap) - (autoload 'compose-tilde-map "x-compose" nil t 'keymap) - - (when (x-keysym-on-keyboard-p 'multi-key) - (define-key function-key-map [multi-key] 'compose-map)) - - ;; The dead keys might really be called just about anything, depending - ;; on the vendor. MIT thinks that the prefixes are "SunFA_", "D", and - ;; "hpmute_" for Sun, DEC, and HP respectively. However, OpenWindows 3 - ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_". - ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_". - ;; Go figure. - - ;; Presumably if someone is running OpenWindows, they won't be using - ;; the DEC or HP keysyms, but if they are defined then that is possible, - ;; so in that case we accept them all. - - ;; If things seem not to be working, you might want to check your - ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally - ;; mixed up view of what these keys should be called. - - ;; Canonical names: - (x-define-dead-key acute compose-acute-map) - (x-define-dead-key grave compose-grave-map) - (x-define-dead-key cedilla compose-cedilla-map) - (x-define-dead-key diaeresis compose-diaeresis-map) - (x-define-dead-key circumflex compose-circumflex-map) - (x-define-dead-key tilde compose-tilde-map) - (x-define-dead-key degree compose-ring-map) - - ;; Sun according to MIT: - (x-define-dead-key SunFA_Acute compose-acute-map) - (x-define-dead-key SunFA_Grave compose-grave-map) - (x-define-dead-key SunFA_Cedilla compose-cedilla-map) - (x-define-dead-key SunFA_Diaeresis compose-diaeresis-map) - (x-define-dead-key SunFA_Circum compose-circumflex-map) - (x-define-dead-key SunFA_Tilde compose-tilde-map) - - ;; Sun according to OpenWindows 2: - (x-define-dead-key Dead_Grave compose-grave-map) - (x-define-dead-key Dead_Circum compose-circumflex-map) - (x-define-dead-key Dead_Tilde compose-tilde-map) - - ;; Sun according to OpenWindows 3: - (x-define-dead-key SunXK_FA_Acute compose-acute-map) - (x-define-dead-key SunXK_FA_Grave compose-grave-map) - (x-define-dead-key SunXK_FA_Cedilla compose-cedilla-map) - (x-define-dead-key SunXK_FA_Diaeresis compose-diaeresis-map) - (x-define-dead-key SunXK_FA_Circum compose-circumflex-map) - (x-define-dead-key SunXK_FA_Tilde compose-tilde-map) - - ;; DEC according to MIT: - (x-define-dead-key Dacute_accent compose-acute-map) - (x-define-dead-key Dgrave_accent compose-grave-map) - (x-define-dead-key Dcedilla_accent compose-cedilla-map) - (x-define-dead-key Dcircumflex_accent compose-circumflex-map) - (x-define-dead-key Dtilde compose-tilde-map) - (x-define-dead-key Dring_accent compose-ring-map) - - ;; DEC according to OpenWindows 3: - (x-define-dead-key DXK_acute_accent compose-acute-map) - (x-define-dead-key DXK_grave_accent compose-grave-map) - (x-define-dead-key DXK_cedilla_accent compose-cedilla-map) - (x-define-dead-key DXK_circumflex_accent compose-circumflex-map) - (x-define-dead-key DXK_tilde compose-tilde-map) - (x-define-dead-key DXK_ring_accent compose-ring-map) - - ;; HP according to MIT: - (x-define-dead-key hpmute_acute compose-acute-map) - (x-define-dead-key hpmute_grave compose-grave-map) - (x-define-dead-key hpmute_diaeresis compose-diaeresis-map) - (x-define-dead-key hpmute_asciicircum compose-circumflex-map) - (x-define-dead-key hpmute_asciitilde compose-tilde-map) - - ;; Empirically discovered on Linux XFree86 MetroX: - (x-define-dead-key usldead_acute compose-acute-map) - (x-define-dead-key usldead_grave compose-grave-map) - (x-define-dead-key usldead_diaeresis compose-diaeresis-map) - (x-define-dead-key usldead_asciicircum compose-circumflex-map) - (x-define-dead-key usldead_asciitilde compose-tilde-map) - - ;; HP according to OpenWindows 3: - (x-define-dead-key hpXK_mute_acute compose-acute-map) - (x-define-dead-key hpXK_mute_grave compose-grave-map) - (x-define-dead-key hpXK_mute_diaeresis compose-diaeresis-map) - (x-define-dead-key hpXK_mute_asciicircum compose-circumflex-map) - (x-define-dead-key hpXK_mute_asciitilde compose-tilde-map) - - ;; HP according to HP-UX 8.0: - (x-define-dead-key XK_mute_acute compose-acute-map) - (x-define-dead-key XK_mute_grave compose-grave-map) - (x-define-dead-key XK_mute_diaeresis compose-diaeresis-map) - (x-define-dead-key XK_mute_asciicircum compose-circumflex-map) - (x-define-dead-key XK_mute_asciitilde compose-tilde-map) - - ;; Xfree86 seems to use lower case and a hyphen - (x-define-dead-key dead-acute compose-acute-map) - (x-define-dead-key dead-grave compose-grave-map) - (x-define-dead-key dead-cedilla compose-cedilla-map) - (x-define-dead-key dead-diaeresis compose-diaeresis-map) - (x-define-dead-key dead-circum compose-circumflex-map) - (x-define-dead-key dead-circumflex compose-circumflex-map) - (x-define-dead-key dead-tilde compose-tilde-map) - ) - -(eval-when-compile - (load "x-win-sun" nil t) - (load "x-win-xfree86" nil t)) - -(defun x-initialize-keyboard () - "Perform X-Server-specific initializations. Don't call this." - ;; This is some heuristic junk that tries to guess whether this is - ;; a Sun keyboard. - ;; - ;; One way of implementing this (which would require C support) would - ;; be to examine the X keymap itself and see if the layout looks even - ;; remotely like a Sun - check for the Find key on a particular - ;; keycode, for example. It'd be nice to have a table of this to - ;; recognize various keyboards; see also xkeycaps. - ;; - ;; Note that we cannot use most vendor-provided proprietary keyboard - ;; APIs to identify the keyboard - those only work on the console. - ;; xkeycaps has the same problem when running `remotely'. - (let ((vendor (x-server-vendor))) - (cond ((or (string-match "Sun Microsystems" vendor) - ;; MIT losingly fails to tell us what hardware the X server - ;; is managing, so assume all MIT displays are Suns... HA HA! - (string-equal "MIT X Consortium" vendor) - (string-equal "X Consortium" vendor)) - ;; Ok, we think this could be a Sun keyboard. Run the Sun code. - (x-win-init-sun)) - ((string-match "XFree86" vendor) - ;; Those XFree86 people do some weird keysym stuff, too. - (x-win-init-xfree86))))) - - -;; Moved from x-toolbar.el, since InfoDock doesn't dump a x-toolbar.el. -(defun x-init-toolbar-from-resources (locale) - (loop for (specifier . resname) in - `(( ,top-toolbar-height . "topToolBarHeight") - (,bottom-toolbar-height . "bottomToolBarHeight") - ( ,left-toolbar-width . "leftToolBarWidth") - ( ,right-toolbar-width . "rightToolBarWidth") - - ( ,top-toolbar-border-width . "topToolBarBorderWidth") - (,bottom-toolbar-border-width . "bottomToolBarBorderWidth") - ( ,left-toolbar-border-width . "leftToolBarBorderWidth") - ( ,right-toolbar-border-width . "rightToolBarBorderWidth")) - do - (x-init-specifier-from-resources - specifier 'natnum locale (cons resname (upcase-initials resname))))) - -(defvar pre-x-win-initted nil) - -(defun init-pre-x-win () - "Initialize X Windows at startup (pre). Don't call this." - (when (not pre-x-win-initted) - (require 'x-iso8859-1) - (setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el - - (setq initial-frame-plist (if initial-frame-unmapped-p - '(initially-unmapped t) - nil)) - (setq pre-x-win-initted t))) - -(defvar x-win-initted nil) - -(defun init-x-win () - "Initialize X Windows at startup. Don't call this." - (when (not x-win-initted) - (defvar x-app-defaults-directory) - (init-pre-x-win) - - ;; Open the X display when this file is loaded - ;; (Note that the first frame is created later.) - (setq x-initial-argv-list (cons (car command-line-args) - command-line-args-left)) - ;; Locate the app-defaults directory - (when (and (boundp 'x-app-defaults-directory) - (null x-app-defaults-directory)) - (setq x-app-defaults-directory - (locate-data-directory "app-defaults"))) - (make-x-device nil) - (setq command-line-args-left (cdr x-initial-argv-list)) - (setq x-win-initted t))) - -(defvar post-x-win-initted nil) - -(defun init-post-x-win () - "Initialize X Windows at startup (post). Don't call this." - (when (not post-x-win-initted) - ;; We can't load this until after the initial X device is created - ;; because the icon initialization needs to access the display to get - ;; any toolbar-related color resources. - (if (and (not (featurep 'infodock)) (featurep 'toolbar)) - (init-x-toolbar)) - (if (and (featurep 'infodock) (featurep 'toolbar)) - (require 'id-x-toolbar)) - (if (featurep 'mule) - (init-mule-x-win)) - ;; these are only ever called if zmacs-regions is true. - (add-hook 'zmacs-deactivate-region-hook - (lambda () - (when (console-on-window-system-p) - (x-disown-selection)))) - (add-hook 'zmacs-activate-region-hook - (lambda () - (when (console-on-window-system-p) - (x-activate-region-as-selection)))) - (add-hook 'zmacs-update-region-hook - (lambda () - (when (console-on-window-system-p) - (x-activate-region-as-selection)))) - ;; Motif-ish bindings - ;; The following two were generally unliked. - ;;(define-key global-map '(shift delete) 'kill-primary-selection) - ;;(define-key global-map '(control delete) 'delete-primary-selection) - (define-key global-map '(shift insert) 'yank-clipboard-selection) - (define-key global-map '(control insert) 'copy-primary-selection) - ;; These are Sun-isms. - (define-key global-map 'copy 'copy-primary-selection) - (define-key global-map 'paste 'yank-clipboard-selection) - (define-key global-map 'cut 'kill-primary-selection) - - (define-key global-map 'menu 'popup-mode-menu) - ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI - - (setq post-x-win-initted t))) - -;;; Keyboard initialization needs to be done differently for each X -;;; console, so use create-console-hook. -(when (featurep 'x) - (add-hook - 'create-console-hook - (lambda (console) - (letf (((selected-console) console)) - (when (eq 'x (console-type console)) - (x-initialize-keyboard) - (x-initialize-compose)))))) - -(defun make-frame-on-display (display &optional props) - "Create a frame on the X display named DISPLAY. -DISPLAY should be a standard display string such as \"unix:0\", -or nil for the display specified on the command line or in the -DISPLAY environment variable. - -PROPS should be a plist of properties, as in the call to `make-frame'. - -This function opens a connection to the display or reuses an existing -connection. - -This function is a trivial wrapper around `make-frame-on-device'." - (interactive "sMake frame on display: ") - (if (equal display "") (setq display nil)) - (make-frame-on-device 'x display props)) - -;; Character 160 (octal 0240) displays incorrectly under X apparently -;; due to a universally crocked font width specification. Display it -;; as a space since that's what seems to be expected. -;; -;; (make-vector 256 nil) instead of (make-display-table) because -;; make-display-table doesn't exist when this file is loaded. - -(let ((tab (make-vector 256 nil))) - (aset tab 160 " ") - (set-specifier current-display-table tab 'global 'x)) - -;;; x-init.el ends here diff --git a/lisp/x-iso8859-1.el b/lisp/x-iso8859-1.el deleted file mode 100644 index 38788ce..0000000 --- a/lisp/x-iso8859-1.el +++ /dev/null @@ -1,273 +0,0 @@ -;;; x-iso8859-1 --- Mapping between X keysym names and ISO 8859-1 - -;; Copyright (C) 1992, 1993, 1997 Free Software Foundation, Inc. - -;; Author: Jamie Zawinski -;; Created: 15-jun-92 -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, internal, dumped - -;; 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: - -;; created by jwz, 13-jun-92. -;; changed by Heiko Muenkel, 12-jun-1997: Added a grave keysym. - -;; Under X, when the user types a character that is ISO-8859/1 but not ASCII, -;; it comes in as a symbol instead of as a character code. This keeps things -;; nice and character-set independent. This file takes all of those symbols -;; (the symbols that are the X names for the 8859/1 characters) and puts a -;; property on them which holds the character code that should be inserted in -;; the buffer when they are typed. The self-insert-command function will look -;; at this. It also binds them all to self-insert-command. - -;; It puts the same property on the keypad keys, so that (read-char) will -;; think that they are the same as the digit characters. However, those -;; keys are bound to one-character keyboard macros, so that `kp-9' will, by -;; default, do the same thing that `9' does, in whatever the current mode is. - -;; The standard case and syntax tables are set in iso8859-1.el, since -;; that is not X-specific. - -;;; Code: - -(require 'iso8859-1) - -(defconst iso8859/1-code-to-x-keysym-table nil - "Maps iso8859/1 to an X keysym name which corresponds to it. -There may be more than one X name for this keycode; this returns the first one. -Note that this is X specific; one should avoid using this table whenever -possible, in the interest of portability.") - -;; (This esoteric little construct is how you do MACROLET in elisp. It -;; generates the most efficient code for the .elc file by unwinding the -;; loop at compile-time.) - -((macro - . (lambda (&rest syms-and-iso8859/1-codes) - (cons - 'progn - (nconc - ;; - ;; First emit code that puts the `x-iso8859/1' property on all of - ;; the keysym symbols. - ;; - (mapcar '(lambda (sym-and-code) - (list 'put (list 'quote (car sym-and-code)) - ''x-iso8859/1 (car (cdr sym-and-code)))) - syms-and-iso8859/1-codes) - ;; - ;; Then emit code that binds all of those keysym symbols to - ;; `self-insert-command'. - ;; - (mapcar '(lambda (sym-and-code) - (list 'global-set-key (list 'quote (car sym-and-code)) - ''self-insert-command)) - syms-and-iso8859/1-codes) - ;; - ;; Then emit the value of iso8859/1-code-to-x-keysym-table. - ;; - (let ((v (make-vector 256 nil))) - ;; the printing ASCII chars have 1-char names. - (let ((i 33)) - (while (< i 127) - (aset v i (intern (make-string 1 i))) - (setq i (1+ i)))) - ;; these are from the keyboard character set. - (mapcar '(lambda (x) (aset v (car x) (car (cdr x)))) - '((8 backspace) (9 tab) (10 linefeed) (13 return) - (27 escape) (32 space) (127 delete))) - (mapcar '(lambda (sym-and-code) - (or (aref v (car (cdr sym-and-code))) - (aset v (car (cdr sym-and-code)) (car sym-and-code)))) - syms-and-iso8859/1-codes) - (list (list 'setq 'iso8859/1-code-to-x-keysym-table v))) - )))) - - ;; The names and capitalization here are as per the MIT X11R4 and X11R5 - ;; distributions. If a vendor varies from this, adjustments will need - ;; to be made... - - (grave ?\140) - (nobreakspace ?\240) - (exclamdown ?\241) - (cent ?\242) - (sterling ?\243) - (currency ?\244) - (yen ?\245) - (brokenbar ?\246) - (section ?\247) - (diaeresis ?\250) - (copyright ?\251) - (ordfeminine ?\252) - (guillemotleft ?\253) - (notsign ?\254) - (hyphen ?\255) - (registered ?\256) - (macron ?\257) - (degree ?\260) - (plusminus ?\261) - (twosuperior ?\262) - (threesuperior ?\263) - (acute ?\264) ; Why is there an acute keysym that is - (mu ?\265) ; distinct from apostrophe/quote, but - (paragraph ?\266) ; no grave keysym that is distinct from - (periodcentered ?\267) ; backquote? - (cedilla ?\270) ; I've added the grave keysym, because it's - (onesuperior ?\271) ; used in x-compose (Heiko Muenkel). - (masculine ?\272) - (guillemotright ?\273) - (onequarter ?\274) - (onehalf ?\275) - (threequarters ?\276) - (questiondown ?\277) - - (Agrave ?\300) - (Aacute ?\301) - (Acircumflex ?\302) - (Atilde ?\303) - (Adiaeresis ?\304) - (Aring ?\305) - (AE ?\306) - (Ccedilla ?\307) - (Egrave ?\310) - (Eacute ?\311) - (Ecircumflex ?\312) - (Ediaeresis ?\313) - (Igrave ?\314) - (Iacute ?\315) - (Icircumflex ?\316) - (Idiaeresis ?\317) - (ETH ?\320) - (Ntilde ?\321) - (Ograve ?\322) - (Oacute ?\323) - (Ocircumflex ?\324) - (Otilde ?\325) - (Odiaeresis ?\326) - (multiply ?\327) - (Ooblique ?\330) - (Ugrave ?\331) - (Uacute ?\332) - (Ucircumflex ?\333) - (Udiaeresis ?\334) - (Yacute ?\335) - (THORN ?\336) - (ssharp ?\337) - - (agrave ?\340) - (aacute ?\341) - (acircumflex ?\342) - (atilde ?\343) - (adiaeresis ?\344) - (aring ?\345) - (ae ?\346) - (ccedilla ?\347) - (egrave ?\350) - (eacute ?\351) - (ecircumflex ?\352) - (ediaeresis ?\353) - (igrave ?\354) - (iacute ?\355) - (icircumflex ?\356) - (idiaeresis ?\357) - (eth ?\360) - (ntilde ?\361) - (ograve ?\362) - (oacute ?\363) - (ocircumflex ?\364) - (otilde ?\365) - (odiaeresis ?\366) - (division ?\367) - (oslash ?\370) - (ugrave ?\371) - (uacute ?\372) - (ucircumflex ?\373) - (udiaeresis ?\374) - (yacute ?\375) - (thorn ?\376) - (ydiaeresis ?\377) - - ) - -((macro . (lambda (&rest syms-and-iso8859/1-codes) - (cons 'progn - (mapcar '(lambda (sym-and-code) - (list 'put (list 'quote (car sym-and-code)) - ''x-iso8859/1 (car (cdr sym-and-code)))) - syms-and-iso8859/1-codes)))) - ;; - ;; Let's do the appropriate thing for some vendor-specific keysyms too... - ;; Apparently nobody agrees on what the names of these keysyms are. - ;; - (SunFA_Acute ?\264) - (SunXK_FA_Acute ?\264) - (Dacute_accent ?\264) - (DXK_acute_accent ?\264) - (hpmute_acute ?\264) - (hpXK_mute_acute ?\264) - (XK_mute_acute ?\264) - - (SunFA_Grave ?`) - (Dead_Grave ?`) - (SunXK_FA_Grave ?`) - (Dgrave_accent ?`) - (DXK_grave_accent ?`) - (hpmute_grave ?`) - (hpXK_mute_grave ?`) - (XK_mute_grave ?`) - - (SunFA_Cedilla ?\270) - (SunXK_FA_Cedilla ?\270) - (Dcedilla_accent ?\270) - (DXK_cedilla_accent ?\270) - - (SunFA_Diaeresis ?\250) - (SunXK_FA_Diaeresis ?\250) - (hpmute_diaeresis ?\250) - (hpXK_mute_diaeresis ?\250) - (XK_mute_diaeresis ?\250) - - (SunFA_Circum ?^) - (Dead_Circum ?^) - (SunXK_FA_Circum ?^) - (Dcircumflex_accent ?^) - (DXK_circumflex_accent ?^) - (hpmute_asciicircum ?^) - (hpXK_mute_asciicircum ?^) - (XK_mute_asciicircum ?^) - - (SunFA_Tilde ?~) - (Dead_Tilde ?~) - (SunXK_FA_Tilde ?~) - (Dtilde ?~) - (DXK_tilde ?~) - (hpmute_asciitilde ?~) - (hpXK_mute_asciitilde ?~) - (XK_mute_asciitilde ?~) - - (Dring_accent ?\260) - (DXK_ring_accent ?\260) - ) - -(provide 'x-iso8859-1) - -;;; x-iso8859-1.el ends here diff --git a/lisp/x-misc.el b/lisp/x-misc.el deleted file mode 100644 index 96606bf..0000000 --- a/lisp/x-misc.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; x-misc.el --- miscellaneous X functions. - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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. - -;;; Commentary: - -;; This file is dumped with XEmacs (when X support is compiled in). - -;;; Code: - -(defun x-bogosity-check-resource (name class type) - "Check for a bogus resource specification." - (let ((bogus (x-get-resource - (concat "__no-such-friggin-locale__." name) - (concat "__No-such-friggin-widget__." class) - type 'global nil t))) - (if bogus - (display-warning - 'resource - (format "Bad resource specification encountered: something like - Emacs*%s: %s -You should replace the * with a . in order to get proper behavior when -you use the specifier and/or `set-face-*' functions." name bogus))))) - -(defun x-init-specifier-from-resources (specifier type locale - &rest resource-list) - "Initialize a specifier from the resource database. -LOCALE specifies the locale that is to be initialized and should be -a frame, a device, or 'global. TYPE is the type of the resource and -should be one of 'string, 'boolean, 'integer, or 'natnum. The -remaining args should be conses of names and classes of resources -to be examined. The first resource with a value specified becomes -the spec for SPECIFIER in LOCALE. (However, if SPECIFIER already -has a spec in LOCALE, nothing is done.) Finally, if LOCALE is 'global, -a check is done for bogus resource specifications." - (if (eq locale 'global) - (mapcar #'(lambda (x) - (x-bogosity-check-resource (car x) (cdr x) type)) - resource-list)) - (if (not (specifier-spec-list specifier locale)) - (catch 'done - (while resource-list - (let* ((name (caar resource-list)) - (class (cdar resource-list)) - (resource - (x-get-resource name class type locale nil t))) - (if resource - (progn - (add-spec-to-specifier specifier resource locale) - (throw 'done t)))) - (setq resource-list (cdr resource-list)))))) - -(defun x-get-resource-and-bogosity-check (name class type &optional locale) - (x-bogosity-check-resource name class type) - (x-get-resource name class type locale nil t)) - -(defun x-get-resource-and-maybe-bogosity-check (name class type &optional - locale) - (if (eq locale 'global) - (x-bogosity-check-resource name class type)) - (x-get-resource name class type locale nil t)) - -;;; x-misc.el ends here diff --git a/lisp/x-mouse.el b/lisp/x-mouse.el deleted file mode 100644 index f5c06aa..0000000 --- a/lisp/x-mouse.el +++ /dev/null @@ -1,182 +0,0 @@ -;;; x-mouse.el --- Mouse support for X window system. - -;; Copyright (C) 1985, 1992-4, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Maintainer: XEmacs Development Team -;; Keywords: mouse, dumped - -;; 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 is dumped with XEmacs (when X support is compiled in). - -;;; Code: - -;;(define-key global-map 'button2 'x-set-point-and-insert-selection) -;; This is reserved for use by Hyperbole. -;;(define-key global-map '(shift button2) 'x-mouse-kill) -(define-key global-map '(control button2) 'x-set-point-and-move-selection) - -(defun x-mouse-kill (event) - "Kill the text between the point and mouse and copy it to the clipboard and -to the cut buffer" - (interactive "@e") - (let ((old-point (point))) - (mouse-set-point event) - (let ((s (buffer-substring old-point (point)))) - (x-own-clipboard s) - (x-store-cutbuffer s)) - (kill-region old-point (point)))) - -(defun x-yank-function () - "Insert the current X selection or, if there is none, insert the X cutbuffer. -A mark is pushed, so that the inserted text lies between point and mark." - (push-mark) - (if (region-active-p) - (if (consp zmacs-region-extent) - ;; pirated code from insert-rectangle in rect.el - ;; perhaps that code should be modified to handle a list of extents - ;; as the rectangle to be inserted? - (let ((lines zmacs-region-extent) - (insertcolumn (current-column)) - (first t)) - (push-mark) - (while lines - (or first - (progn - (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) - (setq first nil) - (insert (extent-string (car lines))) - (setq lines (cdr lines)))) - (insert (extent-string zmacs-region-extent))) - (x-insert-selection t))) - -(defun x-insert-selection (&optional check-cutbuffer-p move-point-event) - "Insert the current selection into buffer at point." - (interactive "P") - (let ((text (if check-cutbuffer-p - (or (condition-case () (x-get-selection) (error ())) - (x-get-cutbuffer) - (error "No selection or cut buffer available")) - (x-get-selection)))) - (cond (move-point-event - (mouse-set-point move-point-event) - (push-mark (point))) - ((interactive-p) - (push-mark (point)))) - (insert text) - )) - -(make-obsolete 'x-set-point-and-insert-selection 'mouse-yank) -(defun x-set-point-and-insert-selection (event) - "Set point where clicked and insert the primary selection or the cut buffer." - (interactive "e") - (let ((mouse-yank-at-point nil)) - (mouse-yank event))) - -(defun x-set-point-and-move-selection (event) - "Set point where clicked and move the selected text to that location." - (interactive "e") - ;; Don't try to move the selection if x-kill-primary-selection if going - ;; to fail; just let the appropriate error message get issued. (We need - ;; to insert the selection and set point first, or the selection may - ;; get inserted at the wrong place.) - (and (x-selection-owner-p) - primary-selection-extent - (x-insert-selection t event)) - (kill-primary-selection)) - -(defun mouse-track-and-copy-to-cutbuffer (event) - "Make a selection like `mouse-track', but also copy it to the cutbuffer." - (interactive "e") - (mouse-track event) - (cond - ((null primary-selection-extent) - nil) - ((consp primary-selection-extent) - (save-excursion - (set-buffer (extent-object (car primary-selection-extent))) - (x-store-cutbuffer - (mapconcat - #'identity - (extract-rectangle - (extent-start-position (car primary-selection-extent)) - (extent-end-position (car (reverse primary-selection-extent)))) - "\n")))) - (t - (save-excursion - (set-buffer (extent-object primary-selection-extent)) - (x-store-cutbuffer - (buffer-substring (extent-start-position primary-selection-extent) - (extent-end-position primary-selection-extent))))))) - - -(defvar x-pointers-initialized nil) - -(defun x-init-pointer-shape (device) - "Initialize the mouse-pointers of DEVICE from the X resource database." - (if x-pointers-initialized ; only do it when the first device is created - nil - (set-glyph-image text-pointer-glyph - (or (x-get-resource "textPointer" "Cursor" 'string device) - "xterm")) - (set-glyph-image selection-pointer-glyph - (or (x-get-resource "selectionPointer" "Cursor" 'string device) - "top_left_arrow")) - (set-glyph-image nontext-pointer-glyph - (or (x-get-resource "spacePointer" "Cursor" 'string device) - "xterm")) ; was "crosshair" - (set-glyph-image modeline-pointer-glyph - (or (x-get-resource "modeLinePointer" "Cursor" 'string device) -;; "fleur")) - "sb_v_double_arrow")) - (set-glyph-image gc-pointer-glyph - (or (x-get-resource "gcPointer" "Cursor" 'string device) - "watch")) - (when (featurep 'scrollbar) - (set-glyph-image - scrollbar-pointer-glyph - (or (x-get-resource "scrollbarPointer" "Cursor" 'string device) - "top_left_arrow"))) - (set-glyph-image busy-pointer-glyph - (or (x-get-resource "busyPointer" "Cursor" 'string device) - "watch")) - (set-glyph-image toolbar-pointer-glyph - (or (x-get-resource "toolBarPointer" "Cursor" 'string device) - "left_ptr")) - (set-glyph-image divider-pointer-glyph - (or (x-get-resource "dividerPointer" "Cursor" 'string device) - "sb_h_double_arrow")) - (let ((fg - (x-get-resource "pointerColor" "Foreground" 'string device))) - (and fg - (set-face-foreground 'pointer fg))) - (let ((bg - (x-get-resource "pointerBackground" "Background" 'string device))) - (and bg - (set-face-background 'pointer bg))) - (setq x-pointers-initialized t)) - nil) - -;;; x-mouse.el ends here diff --git a/lisp/x-scrollbar.el b/lisp/x-scrollbar.el deleted file mode 100644 index 1038320..0000000 --- a/lisp/x-scrollbar.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; x-scrollbar.el --- scrollbar resourcing and such. - -;; Copyright (C) 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. -;; Copyright (C) 1995, 1996 Ben Wing. - -;; Author: Ben Wing -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 is dumped with XEmacs (when X and menubar support is compiled in). - -;;; Code: - -(defun x-init-scrollbar-from-resources (locale) - (x-init-specifier-from-resources - (specifier-fallback scrollbar-width) 'natnum locale - '("scrollBarWidth" . "ScrollBarWidth") - ;; The name strings are wrong, but the scrollbar name is - ;; non-deterministic so it is a poor way to set a resource - ;; for the scrollbar anyhow. - (cond ((featurep 'athena-scrollbars) - '("scrollbar.thickness" . "ScrollBar.Thickness")) - ((featurep 'lucid-scrollbars) - '("scrollbar.width" . "XlwScrollBar.Width")) - ((featurep 'motif-scrollbars) - '("scrollbar.width" . "XmScrollBar.Width")))) - ;; Athena scrollbars accept either 'thickness' or 'width'. - ;; If any of the previous resources succeeded, the following - ;; call does nothing; so there's no harm in doing it all the - ;; time. - (if (featurep 'athena-scrollbars) - (x-init-specifier-from-resources - (specifier-fallback scrollbar-width) 'natnum locale - '("scrollbar.width" . "ScrollBar.Width"))) - - ;; lather, rinse, repeat. - (x-init-specifier-from-resources - (specifier-fallback scrollbar-height) 'natnum locale - '("scrollBarHeight" . "ScrollBarHeight") - ;; The name strings are wrong, but the scrollbar name is - ;; non-deterministic so it is a poor way to set a resource - ;; for the scrollbar anyhow. - (cond ((featurep 'athena-scrollbars) - '("scrollbar.thickness" . "ScrollBar.Thickness")) - ((featurep 'lucid-scrollbars) - '("scrollbar.height" . "XlwScrollBar.Height")) - ((featurep 'motif-scrollbars) - '("scrollbar.height" . "XmScrollBar.Height")))) - ;; Athena scrollbars accept either 'thickness' or 'height'. - ;; If any of the previous resources succeeded, the following - ;; call does nothing; so there's no harm in doing it all the - ;; time. - (if (featurep 'athena-scrollbars) - (x-init-specifier-from-resources - (specifier-fallback scrollbar-height) 'natnum locale - '("scrollbar.height" . "ScrollBar.Height"))) - - ;; Now do ScrollBarPlacement.scrollBarPlacement - (let ((case-fold-search t) - (resval (x-get-resource "ScrollBarPlacement" "scrollBarPlacement" - 'string locale))) - (cond - ((null resval)) - ((string-match "^top[_-]left$" resval) - (set-specifier scrollbar-on-top-p t locale) - (set-specifier scrollbar-on-left-p t locale)) - ((string-match "^top[_-]right$" resval) - (set-specifier scrollbar-on-top-p t locale) - (set-specifier scrollbar-on-left-p nil locale)) - ((string-match "^bottom[_-]left$" resval) - (set-specifier scrollbar-on-top-p nil locale) - (set-specifier scrollbar-on-left-p t locale)) - ((string-match "^bottom[_-]right$" resval) - (set-specifier scrollbar-on-top-p nil locale) - (set-specifier scrollbar-on-left-p nil locale)) - (t - (display-warning 'resource - (format "Illegal value '%s' for scrollBarPlacement resource" resval))))) - -) - -;;; x-scrollbar.el ends here diff --git a/lisp/x-select.el b/lisp/x-select.el deleted file mode 100644 index 7c2f070..0000000 --- a/lisp/x-select.el +++ /dev/null @@ -1,502 +0,0 @@ -;;; x-select.el --- Lisp interface to X Selections. - -;; Copyright (C) 1990, 1997 Free Software Foundation, Inc. -;; Copyright (C) 1995 Sun Microsystems. - -;; Maintainer: XEmacs Development Team -;; Keywords: extensions, dumped - -;; 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 (select.el). - -;;; Commentary: - -;; This file is dumped with XEmacs (when X support is compiled in). - -;; The selection code requires us to use certain symbols whose names are -;; all upper-case; this may seem tasteless, but it makes there be a 1:1 -;; correspondence between these symbols and X Atoms (which are upcased). - -;;; Code: - -(defvar x-selected-text-type - (if (featurep 'mule) '(COMPOUND_TEXT STRING) 'STRING) - "The type atom used to obtain selections from the X server. -Can be either a valid X selection data type, or a list of such types. -COMPOUND_TEXT and STRING are the most commonly used data types. -If a list is provided, the types are tried in sequence until -there is a successful conversion.") - -(defun x-get-selection (&optional type data-type) - "Return the value of an X Windows selection. -The argument TYPE (default `PRIMARY') says which selection, -and the argument DATA-TYPE (default `STRING', or `COMPOUND_TEXT' under Mule) -says how to convert the data." - (or type (setq type 'PRIMARY)) - (or data-type (setq data-type x-selected-text-type)) - (let ((text - (if (consp data-type) - (condition-case err - (x-get-selection-internal type (car data-type)) - (selection-conversion-error - (if (cdr data-type) - (x-get-selection type (cdr data-type)) - (signal (car err) (cdr err))))) - (x-get-selection-internal type data-type)))) - (when (and (consp text) (symbolp (car text))) - (setq text (cdr text))) - (when (not (stringp text)) - (error "Selection is not a string: %S" text)) - text)) - -(defun x-get-secondary-selection () - "Return text selected from some X window." - (x-get-selection 'SECONDARY)) - -(defun x-get-clipboard () - "Return text pasted to the clipboard." - (x-get-selection 'CLIPBOARD)) - -;; FSFmacs calls this `x-set-selection', and reverses the -;; arguments (duh ...). This order is more logical. -(defun x-own-selection (data &optional type) - "Make an X Windows selection of type TYPE and value DATA. -The argument TYPE (default `PRIMARY') says which selection, -and DATA specifies the contents. DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). - -The selection may also be a cons of two markers pointing to the same buffer, -or an overlay. In these cases, the selection is considered to be the text -between the markers *at whatever time the selection is examined*. -Thus, editing done in the buffer after you specify the selection -can alter the effective value of the selection. - -The data may also be a vector of valid non-vector selection values. - -Interactively, the text of the region is used as the selection value." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (substring (region-beginning) (region-end))))) - ;FSFmacs huh?? It says: - ;; "This is for temporary compatibility with pre-release Emacs 19." - ;(if (stringp type) - ; (setq type (intern type))) - (or (x-valid-simple-selection-p data) - (and (vectorp data) - (let ((valid t) - (i (1- (length data)))) - (while (>= i 0) - (or (x-valid-simple-selection-p (aref data i)) - (setq valid nil)) - (setq i (1- i))) - valid)) - (signal 'error (list "invalid selection" data))) - (or type (setq type 'PRIMARY)) - (if data - (x-own-selection-internal type data) - (x-disown-selection-internal type)) - (cond ((eq type 'PRIMARY) - (setq primary-selection-extent - (select-make-extent-for-selection - data primary-selection-extent))) - ((eq type 'SECONDARY) - (setq secondary-selection-extent - (select-make-extent-for-selection - data secondary-selection-extent)))) - (setq zmacs-region-stays t) - data) - -(defun x-valid-simple-selection-p (data) - (valid-simple-selection-p data)) - -(defun x-own-secondary-selection (selection &optional type) - "Make a secondary X Selection of the given argument. The argument may be a -string or a cons of two markers (in which case the selection is considered to -be the text between those markers)." - (interactive (if (not current-prefix-arg) - (list (read-string "Store text for pasting: ")) - (list (cons ;; these need not be ordered. - (copy-marker (point-marker)) - (copy-marker (mark-marker)))))) - (x-own-selection selection 'SECONDARY)) - - -(defun x-own-clipboard (string) - "Paste the given string to the X Clipboard." - (x-own-selection string 'CLIPBOARD)) - - -(defun x-disown-selection (&optional secondary-p) - "Assuming we own the selection, disown it. With an argument, discard the -secondary selection instead of the primary selection." - (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY))) - -(defun x-dehilight-selection (selection) - "for use as a value of `x-lost-selection-hooks'." - (cond ((eq selection 'PRIMARY) - (if primary-selection-extent - (let ((inhibit-quit t)) - (if (consp primary-selection-extent) - (mapcar 'delete-extent primary-selection-extent) - (delete-extent primary-selection-extent)) - (setq primary-selection-extent nil))) - (if zmacs-regions (zmacs-deactivate-region))) - ((eq selection 'SECONDARY) - (if secondary-selection-extent - (let ((inhibit-quit t)) - (if (consp secondary-selection-extent) - (mapcar 'delete-extent secondary-selection-extent) - (delete-extent secondary-selection-extent)) - (setq secondary-selection-extent nil))))) - nil) - -(setq x-lost-selection-hooks 'x-dehilight-selection) - -(defun x-notice-selection-requests (selection type successful) - "for possible use as the value of x-sent-selection-hooks." - (if (not successful) - (message "Selection request failed to convert %s to %s" - selection type) - (message "Sent selection %s as %s" selection type))) - -(defun x-notice-selection-failures (selection type successful) - "for possible use as the value of x-sent-selection-hooks." - (or successful - (message "Selection request failed to convert %s to %s" - selection type))) - -;(setq x-sent-selection-hooks 'x-notice-selection-requests) -;(setq x-sent-selection-hooks 'x-notice-selection-failures) - - -;;; Selections in killed buffers -;;; this function is called by kill-buffer as if it were on the -;;; kill-buffer-hook (though it isn't really). - -(defun xselect-kill-buffer-hook () - ;; Probably the right thing is to write a C function to return a list - ;; of the selections which emacs owns, since it could conceivably own - ;; a user-defined selection type that we've never heard of. - (xselect-kill-buffer-hook-1 'PRIMARY) - (xselect-kill-buffer-hook-1 'SECONDARY) - (xselect-kill-buffer-hook-1 'CLIPBOARD)) - -(defun xselect-kill-buffer-hook-1 (selection) - (let (value) - (if (and (x-selection-owner-p selection) - (setq value (x-get-selection-internal selection '_EMACS_INTERNAL)) - ;; The _EMACS_INTERNAL selection type has a converter registered - ;; for it that does no translation. This only works if emacs is - ;; requesting the selection from itself. We could have done this - ;; by writing a C function to return the raw selection data, and - ;; that might be the right way to do this, but this was easy. - (or (and (consp value) - (markerp (car value)) - (eq (current-buffer) (marker-buffer (car value)))) - (and (extent-live-p value) - (eq (current-buffer) (extent-object value))) - (and (extentp value) (not (extent-live-p value))))) - (x-disown-selection-internal selection)))) - - -;;; Cut Buffer support - -;;; FSF name x-get-cut-buffer -(defun x-get-cutbuffer (&optional which-one) - "Return the value of one of the 8 X server cut buffers. -Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. -Cut buffers are considered obsolete; you should use selections instead. -This function does nothing if support for cut buffers was not compiled -into Emacs." - (and (fboundp 'x-get-cutbuffer-internal) - (x-get-cutbuffer-internal - (if which-one - (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 - CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] - which-one) - 'CUT_BUFFER0)))) - -;;; FSF name x-set-cut-buffer -(defun x-store-cutbuffer (string &optional push) - "Store STRING into the X server's primary cut buffer. -If PUSH is non-nil, also rotate the cut buffers: -this means the previous value of the primary cut buffer moves the second -cut buffer, and the second to the third, and so on (there are 8 buffers.) -Cut buffers are considered obsolete; you should use selections instead. -This function does nothing if support for cut buffers was not compiled -into Emacs." - (and (fboundp 'x-store-cutbuffer-internal) - (progn - ;; Check the data type of STRING. - (substring string 0 0) - (if push - (x-rotate-cutbuffers-internal 1)) - (x-store-cutbuffer-internal 'CUT_BUFFER0 string)))) - - -;;; Random utility functions - -(defun x-yank-clipboard-selection () - "Insert the current Clipboard selection at point." - (interactive "*") - (setq last-command nil) - (setq this-command 'yank) ; so that yank-pop works. - (let ((clip (x-get-clipboard))) - (or clip (error "there is no clipboard selection")) - (push-mark) - (insert clip))) - -;;; Functions to convert the selection into various other selection types. -;;; Every selection type that emacs handles is implemented this way, except -;;; for TIMESTAMP, which is a special case. - -(defun xselect-convert-to-text (selection type value) - (cond ((stringp value) - value) - ((extentp value) - (save-excursion - (set-buffer (extent-object value)) - (save-restriction - (widen) - (buffer-substring (extent-start-position value) - (extent-end-position value))))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (or (eq (marker-buffer (car value)) (marker-buffer (cdr value))) - (signal 'error - (list "markers must be in the same buffer" - (car value) (cdr value)))) - (save-excursion - (set-buffer (or (marker-buffer (car value)) - (error "selection is in a killed buffer"))) - (save-restriction - (widen) - (buffer-substring (car value) (cdr value))))) - (t nil))) - -(defun xselect-convert-to-string (selection type value) - (let ((outval (xselect-convert-to-text selection type value))) - ;; force the string to be not in Compound Text format. - (if (stringp outval) - (cons 'STRING outval) - outval))) - -(defun xselect-convert-to-compound-text (selection type value) - ;; converts to compound text automatically - (xselect-convert-to-text selection type value)) - -(defun xselect-convert-to-length (selection type value) - (let ((value - (cond ((stringp value) - (length value)) - ((extentp value) - (extent-length value)) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (or (eq (marker-buffer (car value)) - (marker-buffer (cdr value))) - (signal 'error - (list "markers must be in the same buffer" - (car value) (cdr value)))) - (abs (- (car value) (cdr value))))))) - (if value ; force it to be in 32-bit format. - (cons (ash value -16) (logand value 65535)) - nil))) - -(defun xselect-convert-to-targets (selection type value) - ;; return a vector of atoms, but remove duplicates first. - (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist))) - (rest all)) - (while rest - (cond ((memq (car rest) (cdr rest)) - (setcdr rest (delq (car rest) (cdr rest)))) - ((eq (car (cdr rest)) '_EMACS_INTERNAL) ; shh, it's a secret - (setcdr rest (cdr (cdr rest)))) - (t - (setq rest (cdr rest))))) - (apply 'vector all))) - -(defun xselect-convert-to-delete (selection type value) - (x-disown-selection-internal selection) - ;; A return value of nil means that we do not know how to do this conversion, - ;; and replies with an "error". A return value of NULL means that we have - ;; done the conversion (and any side-effects) but have no value to return. - 'NULL) - -(defun xselect-convert-to-filename (selection type value) - (cond ((extentp value) - (buffer-file-name (or (extent-object value) - (error "selection is in a killed buffer")))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (buffer-file-name (or (marker-buffer (car value)) - (error "selection is in a killed buffer")))) - (t nil))) - -(defun xselect-convert-to-charpos (selection type value) - (let (a b tmp) - (cond ((cond ((extentp value) - (setq a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value)))) - (setq a (1- a) b (1- b)) ; zero-based - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-lineno (selection type value) - (let (a b buf tmp) - (cond ((cond ((extentp value) - (setq buf (extent-object value) - a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (marker-position (car value)) - b (marker-position (cdr value)) - buf (marker-buffer (car value))))) - (save-excursion - (set-buffer buf) - (save-restriction - (widen) - (goto-char a) - (beginning-of-line) - (setq a (1+ (count-lines 1 (point)))) - (goto-char b) - (beginning-of-line) - (setq b (1+ (count-lines 1 (point)))))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-colno (selection type value) - (let (a b buf tmp) - (cond ((cond ((extentp value) - (setq buf (extent-object value) - a (extent-start-position value) - b (extent-end-position value))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (car value) - b (cdr value) - buf (marker-buffer a)))) - (save-excursion - (set-buffer buf) - (goto-char a) - (setq a (current-column)) - (goto-char b) - (setq b (current-column))) - (if (< b a) (setq tmp a a b b tmp)) - (cons 'SPAN - (vector (cons (ash a -16) (logand a 65535)) - (cons (ash b -16) (logand b 65535)))))))) - -(defun xselect-convert-to-sourceloc (selection type value) - (let (a b buf file-name tmp) - (cond ((cond ((extentp value) - (setq buf (or (extent-object value) - (error "selection is in a killed buffer")) - a (extent-start-position value) - b (extent-end-position value) - file-name (buffer-file-name buf))) - ((and (consp value) - (markerp (car value)) - (markerp (cdr value))) - (setq a (marker-position (car value)) - b (marker-position (cdr value)) - buf (or (marker-buffer (car value)) - (error "selection is in a killed buffer")) - file-name (buffer-file-name buf)))) - (save-excursion - (set-buffer buf) - (save-restriction - (widen) - (goto-char a) - (beginning-of-line) - (setq a (1+ (count-lines 1 (point)))) - (goto-char b) - (beginning-of-line) - (setq b (1+ (count-lines 1 (point)))))) - (if (< b a) (setq tmp a a b b tmp)) - (format "%s:%d" file-name a))))) - -(defun xselect-convert-to-os (selection type size) - (symbol-name system-type)) - -(defun xselect-convert-to-host (selection type size) - (system-name)) - -(defun xselect-convert-to-user (selection type size) - (user-full-name)) - -(defun xselect-convert-to-class (selection type size) - x-emacs-application-class) - -;; We do not try to determine the name Emacs was invoked with, -;; because it is not clean for a program's behavior to depend on that. -(defun xselect-convert-to-name (selection type size) - ;invocation-name - "xemacs") - -(defun xselect-convert-to-integer (selection type value) - (and (integerp value) - (cons (ash value -16) (logand value 65535)))) - -(defun xselect-convert-to-atom (selection type value) - (and (symbolp value) value)) - -(defun xselect-convert-to-identity (selection type value) ; used internally - (vector value)) - -(setq selection-converter-alist - '((TEXT . xselect-convert-to-text) - (STRING . xselect-convert-to-string) - (COMPOUND_TEXT . xselect-convert-to-compound-text) - (TARGETS . xselect-convert-to-targets) - (LENGTH . xselect-convert-to-length) - (DELETE . xselect-convert-to-delete) - (FILE_NAME . xselect-convert-to-filename) - (CHARACTER_POSITION . xselect-convert-to-charpos) - (SOURCE_LOC . xselect-convert-to-sourceloc) - (LINE_NUMBER . xselect-convert-to-lineno) - (COLUMN_NUMBER . xselect-convert-to-colno) - (OWNER_OS . xselect-convert-to-os) - (HOST_NAME . xselect-convert-to-host) - (USER . xselect-convert-to-user) - (CLASS . xselect-convert-to-class) - (NAME . xselect-convert-to-name) - (ATOM . xselect-convert-to-atom) - (INTEGER . xselect-convert-to-integer) - (_EMACS_INTERNAL . xselect-convert-to-identity) - )) - -;FSFmacs (provide 'select) - -;;; x-select.el ends here. diff --git a/lisp/x-win-sun.el b/lisp/x-win-sun.el deleted file mode 100644 index b59dd82..0000000 --- a/lisp/x-win-sun.el +++ /dev/null @@ -1,254 +0,0 @@ -;;; x-win-sun.el --- runtime initialization for Sun X servers and keyboards -;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. - -;; Authors: jwz, ben, martin -;; Keywords: terminals - -;; 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 file is loaded by x-win.el at run-time when we are sure that XEmacs -;; is running on the display of a Sun. - -;; The Sun X server (both the MIT and OpenWindows varieties) have extremely -;; stupid names for their keypad and function keys. For example, the key -;; labeled 3 / PgDn, with R15 written on the front, is actually called F35. - -;; There are 3 methods of dealing with the Sun key brokenness: -;; -;; - Use xmodmap to give all keys more sensible names for all apps: -;; I use this shell script: -;; -;; for i in 0 1 2 3 4 5 6 7 8 9 Add Subtract Multiply Divide Decimal ; do -;; echo "keysym KP-$i = KP-$i" -;; done | xmodmap -;; -;; Clearly, as a good X11 citizen, we can't do this. -;; -;; - Use keyboard-translate-table to remap the keybindings at a low level. -;; This approach is taken in the function `sun-x11-keyboard-translate'. -;; This is like running xmodmap within XEmacs only. -;; This is not the default, however, so that legacy keybindings in users' -;; .emacs files like (global-set-key [(f35)] 'foo) continue to work -;; -;; - Use keyboard macros to provide indirection for keybindings. -;; If we do (global-set-key [(f35)] [(kp-3)]), then the user's keybindings -;; work whether he uses `f35' or `kp-3'. -;; This is also compatible with FSF Emacs and other X11 apps. -;; Although this has the disadvantage that these remappings -;; only work with the global key map, we use this as the default. -;; -;; - The Right Way to do this remains to be written... - -;; OK, here's another try at doing things the right way. - -;; We use function-key-map, which honors explicit key-bindings for the -;; stupid Sun names, but also allows indirection if no explicit -;; key-binding exists. - -;;; Code: - -;;;###autoload -(defun x-win-init-sun () - - ;; help is ok - ;; num_lock is ok - ;; up is ok - ;; left is ok - ;; right is ok - ;; kp-add is ok - ;; down is ok - ;; insert is ok - ;; delete is ok - ;; kp-enter is ok - ;; Sun Function keys - (loop for (from-key to-key) in - `((f21 pause) - (f22 print) - (f23 scroll_lock) - - ;; X11 R6 mappings - (SunProps props) - (SunFront front) - (SunOpen open) - (SunFind find) - (cancel stop) - (Undo undo) - (SunCopy copy) - (SunPaste paste) - (SunCut cut) - - (f13 props) - (f14 undo) - (f15 front) - (f16 copy) - (f17 open) - (f18 paste) - (f19 find) - (f20 cut) - - (f25 kp-divide) - (f26 kp-multiply) - (f31 kp-5) - - ;; Map f33 and r13 to end or kp-end - ,@(cond - ((not (x-keysym-on-keyboard-sans-modifiers-p 'end)) - '((f33 end) - (r13 end))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-end)) - '((f33 kp-end) - (r13 kp-end)))) - - ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f36) - '((f36 stop) - (f37 again))) - - ;; Type 4 keyboards have a real kp-subtract and a f24 labelled `=' - ;; Type 5 keyboards have no key labelled `=' and a f24 labelled `-' - ,@(when (x-keysym-on-keyboard-sans-modifiers-p 'f24) - `((f24 ,(if (x-keysym-on-keyboard-sans-modifiers-p 'kp-subtract) - 'kp-equal - 'kp-subtract)))) - - ;; Map f27 to home or kp-home, as appropriate - ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'home)) - '((f27 home))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-home)) - '((f27 kp-home)))) - - ;; Map f29 to prior or kp-prior, as appropriate - ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'prior)) - '((f29 prior))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-prior)) - '((f29 kp-prior)))) - - ;; Map f35 to next or kp-next, as appropriate - ,@(cond ((not (x-keysym-on-keyboard-sans-modifiers-p 'next)) - '((f35 next))) - ((not (x-keysym-on-keyboard-sans-modifiers-p 'kp-next)) - '((f35 kp-next)))) - - ,@(cond ((x-keysym-on-keyboard-sans-modifiers-p 'apRead) ; SunOS 4.1.1 - '((apRead f11) (apEdit f12))) - ((x-keysym-on-keyboard-sans-modifiers-p 'SunF36) ; SunOS 5 - '((SunF36 f11) - (SunF37 f12) - (f11 stop) - (f12 again)))) - ) - do (when (x-keysym-on-keyboard-sans-modifiers-p from-key) - (dolist (prefix '(() (shift) (control) (meta) (alt) - (shift control) (shift alt) (shift meta) - (control alt) (control meta) (alt meta) - (shift control alt) (shift control meta) - (shift alt meta) (control alt meta) - (shift control alt meta))) - (define-key function-key-map - (append prefix (list from-key)) - (vector (append prefix (list to-key))))))) - - ;; for each element in the left column of the above table, alias it - ;; to the thing in the right column. Then do the same for many, but - ;; not all, modifier combinations. - ;; - ;; (Well, we omit hyper and super. #### Handle this some other way!) - ;; (while mapping - ;; (let ((mods '(() (shift) (control) (meta) (alt)))) - ;; (while mods - ;; (let ((k1 (vector (append (car mods) (list (car (car mapping)))))) - ;; (k2 (vector (append (car mods) (list (cdr (car mapping))))))) - ;; (define-key global-map k1 k2)) - ;; (setq mods (cdr mods)))) - ;; (setq mapping (cdr mapping)))) - -;;; I've extended keyboard-translate-table to work over keysyms. -;;; [FSF Emacs has something called `system-key-alist' that is -;;; supposed to accomplish approximately the same thing. Unfortunately, -;;; it's brain-dead in the typically FSF way, and associates *numbers* -;;; (who knows where the hell they come from?) with symbols.] --ben - -;;; And I've made it into a function which is NOT called by default --martin - - (defun sun-x11-keyboard-translate () - "Remap Sun's X11 keyboard. -Keys with names like `f35' are remapped, at a low level, -to more mnemonic ones,like `kp-3'." - (interactive) - - (keyboard-translate - 'f11 'stop ; the type4 keyboard Sun/MIT name - 'f36 'stop ; the type5 keyboard Sun name - 'cancel 'stop ; R6 binding - 'f12 'again ; the type4 keyboard Sun/MIT name - 'f37 'again ; the type5 keyboard Sun name - 'f13 'props ; - 'SunProps 'props ; R6 binding - 'f14 'undo ; - 'f15 'front ; - 'SunFront 'front ; R6 binding - 'f16 'copy ; - 'SunCopy 'copy ; R6 binding - 'f17 'open ; - 'SunOpen 'open ; R6 binding - 'f18 'paste ; - 'SunPaste 'paste ; R6 binding - 'f19 'find ; - 'f20 'cut ; - 'SunCut 'cut ; R6 binding - ;; help is ok - 'f21 'pause - 'f22 'prsc - 'f23 'scroll - ;; num_lock is ok - ;;'f24 'kp-equal) ; type4 only! - 'f25 'kp-divide ; - 'f26 'kp-multiply ; - 'f24 'kp-subtract ; type5 only! - 'f27 'kp-7 ; - ;; up is ok - 'f29 'kp-9 - ;; left is ok - 'f31 'kp-5 - ;; right is ok - ;; kp-add is ok - 'f33 'kp-1 ; the Sun name - 'r13 'end ; the MIT name - ;; down is ok - 'f35 'kp-3 - ;; insert is ok - ;; delete is ok - ;; kp-enter is ok - 'SunF36 'f11 ; Type 5 keyboards - 'SunF37 'f12 ; Used to be Stop & Again - )) - - -;;; OpenWindows-like "find" processing. -;;; As far as I know, the `find' key is a Sunism, so we do that binding -;;; here. This is the only Sun-specific keybinding. (The functions -;;; themselves are in x-win.el in case someone wants to use them when -;;; not running on a Sun display.) - - (define-key global-map 'find 'ow-find) - (define-key global-map '(shift find) 'ow-find-backward) - - ) - -;;; x-win-sun.el ends here diff --git a/lwlib/.cvsignore b/lwlib/.cvsignore deleted file mode 100644 index 94ef90a..0000000 --- a/lwlib/.cvsignore +++ /dev/null @@ -1,4 +0,0 @@ -Makefile.in -config.h -Makefile -GNUmakefile diff --git a/lwlib/Makefile.in.in b/lwlib/Makefile.in.in deleted file mode 100644 index 70be7f3..0000000 --- a/lwlib/Makefile.in.in +++ /dev/null @@ -1,105 +0,0 @@ -## Makefile for Lucid Widget Library -## Copyright (C) 1994 Lucid, Inc. -## Copyright (C) 1995 Tinker Systems and INS Engineering Corp. -## Copyright (C) 1994, 1995 Board of Trustees, University of Illinois -## Copyright (C) 1996, 1997 Sun Microsystems, Inc. - -## This file is part of the Lucid Widget Library. - -## The Lucid Widget Library is free software; you can redistribute it and/or -## modify it under the terms of the GNU General Public License as published by -## the Free Software Foundation; either version 2, or (at your option) -## any later version. - -## The Lucid Widget Library is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. - -## For performance and consistency, no built-in rules -.SUFFIXES: -.SUFFIXES: .c .h .o .i .s - -srcdir=@srcdir@ - -@SET_MAKE@ -SHELL=/bin/sh -RM = rm -f -AR = ar cq - -CC=@XEMACS_CC@ -CPP=@CPP@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ -RANLIB=@RANLIB@ - -#define NOT_C_CODE -#include "../src/config.h" - -#ifdef USE_GNU_MAKE -vpath %.c @srcdir@ -vpath %.h @srcdir@ -#else -VPATH=@srcdir@ -#endif - -objs = lwlib.o lwlib-utils.o lwlib-config.o @lwlib_objs@ - -all: liblw.a - -c_switch_all=@c_switch_all@ - -cppflags = $(CPPFLAGS) -I. $(c_switch_all) -cflags = $(CFLAGS) $(cppflags) - -#ifdef SOLARIS2 -%.o : %.c -#else -.c.o: -#endif - $(CC) -c $(cflags) $< - -## Create preprocessor output (debugging purposes only) -.c.i: -#ifdef __GNUC__ - $(CC) -E $(cppflags) -o $@ $< -#else /* works on Solaris; what about other systems? */ - $(CC) -P $(cppflags) $< -#endif /* compiler */ - -## Create assembler output (debugging purposes only) -.c.s: - $(CC) -S -c $(cflags) $< - -liblw.a: $(objs) - $(RM) $@ - $(AR) $@ $(objs) - @-test -n "$(RANLIB)" && $(RANLIB) $@ - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - $(RM) liblw.a liblw_pure_*.a *.o *.i core -clean: mostlyclean -distclean: clean - $(RM) GNUmakefile Makefile Makefile.in config.h TAGS -realclean: distclean -extraclean: distclean - $(RM) *~ \#* - -CONFIG_H = ../src/config.h config.h - -## Following correct as of 19980312 - -lwlib-Xaw.o: $(CONFIG_H) lwlib-Xaw.h lwlib-internal.h lwlib.h xlwmenu.h -lwlib-Xlw.o: $(CONFIG_H) lwlib-Xlw.h lwlib-internal.h lwlib.h xlwmenu.h xlwscrollbar.h -lwlib-Xm.o: $(CONFIG_H) lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h -lwlib-config.o: $(CONFIG_H) lwlib.h xlwmenu.h -lwlib-utils.o: $(CONFIG_H) lwlib-utils.h -lwlib.o: $(CONFIG_H) lwlib-Xaw.h lwlib-Xlw.h lwlib-Xm.h lwlib-internal.h lwlib-utils.h lwlib.h xlwmenu.h -xlwmenu.o: $(CONFIG_H) lwlib.h xlwmenu.h xlwmenuP.h -xlwscrollbar.o: $(CONFIG_H) xlwscrollbar.h xlwscrollbarP.h diff --git a/lwlib/config.h.in b/lwlib/config.h.in deleted file mode 100644 index 84c6efe..0000000 --- a/lwlib/config.h.in +++ /dev/null @@ -1,32 +0,0 @@ -/* Lwlib site configuration template file. -*- C -*- - Copyright (C) 1997 Sun Microsystems, 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. */ - -/* Not in FSF. */ - -#ifndef _LWLIB_CONFIG_H_ -#define _LWLIB_CONFIG_H_ - -#include <../src/config.h> - -#undef NEED_MOTIF -#undef NEED_ATHENA -#undef NEED_LUCID - -#endif /* _LWLIB_CONFIG_H_ */ diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c deleted file mode 100644 index a0198bc..0000000 --- a/lwlib/lwlib-Xaw.c +++ /dev/null @@ -1,625 +0,0 @@ -/* The lwlib interface to Athena widgets. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can 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. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -#include -#include - -#ifdef STDC_HEADERS -#include -#endif - -#include "lwlib-Xaw.h" - -#include -#include -#include -#include - -#ifdef LWLIB_SCROLLBARS_ATHENA -#include -#endif -#ifdef LWLIB_DIALOGS_ATHENA -#include -#include -#include -#include -#endif - -#include - -static void xaw_generic_callback (Widget, XtPointer, XtPointer); - - -Boolean -lw_xaw_widget_p (Widget widget) -{ - return (0 -#ifdef LWLIB_SCROLLBARS_ATHENA - || XtIsSubclass (widget, scrollbarWidgetClass) -#endif -#ifdef LWLIB_DIALOGS_ATHENA - || XtIsSubclass (widget, dialogWidgetClass) -#endif - ); -} - -#ifdef LWLIB_SCROLLBARS_ATHENA -static void -xaw_update_scrollbar (widget_instance *instance, Widget widget, - widget_value *val) -{ - if (val->scrollbar_data) - { - scrollbar_values *data = val->scrollbar_data; - float widget_shown, widget_topOfThumb; - float new_shown, new_topOfThumb; - Arg al [10]; - - /* First size and position the scrollbar widget. */ - XtSetArg (al [0], XtNx, data->scrollbar_x); - XtSetArg (al [1], XtNy, data->scrollbar_y); - XtSetArg (al [2], XtNwidth, data->scrollbar_width); - XtSetArg (al [3], XtNheight, data->scrollbar_height); - XtSetValues (widget, al, 4); - - /* Now size the scrollbar's slider. */ - XtSetArg (al [0], XtNtopOfThumb, &widget_topOfThumb); - XtSetArg (al [1], XtNshown, &widget_shown); - XtGetValues (widget, al, 2); - - new_shown = (double) data->slider_size / - (double) (data->maximum - data->minimum); - - new_topOfThumb = (double) (data->slider_position - data->minimum) / - (double) (data->maximum - data->minimum); - - if (new_shown > 1.0) - new_shown = 1.0; - else if (new_shown < 0) - new_shown = 0; - - if (new_topOfThumb > 1.0) - new_topOfThumb = 1.0; - else if (new_topOfThumb < 0) - new_topOfThumb = 0; - - if (new_shown != widget_shown || new_topOfThumb != widget_topOfThumb) - XawScrollbarSetThumb (widget, new_topOfThumb, new_shown); - } -} -#endif /* LWLIB_SCROLLBARS_ATHENA */ - -void -xaw_update_one_widget (widget_instance *instance, Widget widget, - widget_value *val, Boolean deep_p) -{ - if (0) - ; -#ifdef LWLIB_SCROLLBARS_ATHENA - else if (XtIsSubclass (widget, scrollbarWidgetClass)) - { - xaw_update_scrollbar (instance, widget, val); - } -#endif -#ifdef LWLIB_DIALOGS_ATHENA - else if (XtIsSubclass (widget, dialogWidgetClass)) - { - Arg al [1]; - XtSetArg (al [0], XtNlabel, val->contents->value); - XtSetValues (widget, al, 1); - } - else if (XtIsSubclass (widget, commandWidgetClass)) - { - Dimension bw = 0; - Arg al [3]; - XtSetArg (al [0], XtNborderWidth, &bw); - XtGetValues (widget, al, 1); - -#ifndef LWLIB_DIALOGS_ATHENA3D - if (bw == 0) - /* Don't let buttons end up with 0 borderwidth, that's ugly... - Yeah, all this should really be done through app-defaults files - or fallback resources, but that's a whole different can of worms - that I don't feel like opening right now. Making Athena widgets - not look like shit is just entirely too much work. - */ - { - XtSetArg (al [0], XtNborderWidth, 1); - XtSetValues (widget, al, 1); - } -#endif /* ! LWLIB_DIALOGS_ATHENA3D */ - - XtSetArg (al [0], XtNlabel, val->value); - XtSetArg (al [1], XtNsensitive, val->enabled); - /* Force centered button text. See above. */ - XtSetArg (al [2], XtNjustify, XtJustifyCenter); - XtSetValues (widget, al, 3); - - XtRemoveAllCallbacks (widget, XtNcallback); - XtAddCallback (widget, XtNcallback, xaw_generic_callback, instance); - } -#endif /* LWLIB_DIALOGS_ATHENA */ -} - -void -xaw_update_one_value (widget_instance *instance, Widget widget, - widget_value *val) -{ - /* This function is not used by the scrollbars and those are the only - Athena widget implemented at the moment so do nothing. */ - return; -} - -void -xaw_destroy_instance (widget_instance *instance) -{ -#ifdef LWLIB_DIALOGS_ATHENA - if (XtIsSubclass (instance->widget, dialogWidgetClass)) - /* Need to destroy the Shell too. */ - XtDestroyWidget (XtParent (instance->widget)); - else -#endif - XtDestroyWidget (instance->widget); -} - -void -xaw_popup_menu (Widget widget, XEvent *event) -{ - /* An Athena menubar has not been implemented. */ - return; -} - -void -xaw_pop_instance (widget_instance *instance, Boolean up) -{ - Widget widget = instance->widget; - - if (up) - { -#ifdef LWLIB_DIALOGS_ATHENA - if (XtIsSubclass (widget, dialogWidgetClass)) - { - /* For dialogs, we need to call XtPopup on the parent instead - of calling XtManageChild on the widget. - Also we need to hack the shell's WM_PROTOCOLS to get it to - understand what the close box is supposed to do!! - */ - Display *dpy = XtDisplay (widget); - Widget shell = XtParent (widget); - Atom props [2]; - int i = 0; - props [i++] = XInternAtom (dpy, "WM_DELETE_WINDOW", False); - XChangeProperty (dpy, XtWindow (shell), - XInternAtom (dpy, "WM_PROTOCOLS", False), - XA_ATOM, 32, PropModeAppend, - (unsigned char *) props, i); - - /* Center the widget in its parent. Why isn't this kind of crap - done automatically? I thought toolkits were supposed to make - life easier? - */ - { - unsigned int x, y, w, h; - Widget topmost = instance->parent; - w = shell->core.width; - h = shell->core.height; - while (topmost->core.parent && - XtIsRealized (topmost->core.parent) && - /* HAVE_SESSION adds an unmapped parent widget that - we should ignore here. */ - topmost->core.parent->core.mapped_when_managed) - topmost = topmost->core.parent; - if (topmost->core.width < w) x = topmost->core.x; - else x = topmost->core.x + ((topmost->core.width - w) / 2); - if (topmost->core.height < h) y = topmost->core.y; - else y = topmost->core.y + ((topmost->core.height - h) / 2); - XtMoveWidget (shell, x, y); - } - - /* Finally, pop it up. */ - XtPopup (shell, XtGrabNonexclusive); - } - else -#endif /* LWLIB_DIALOGS_ATHENA */ - XtManageChild (widget); - } - else - { -#ifdef LWLIB_DIALOGS_ATHENA - if (XtIsSubclass (widget, dialogWidgetClass)) - XtUnmanageChild (XtParent (widget)); - else -#endif - XtUnmanageChild (widget); - } -} - - -#ifdef LWLIB_DIALOGS_ATHENA -/* Dialog boxes */ - -static char overrideTrans[] = - "WM_PROTOCOLS: lwlib_delete_dialog()"; -static XtActionProc wm_delete_window (Widget shell, XtPointer closure, - XtPointer call_data); -static XtActionsRec xaw_actions [] = { - {"lwlib_delete_dialog", (XtActionProc) wm_delete_window} -}; -static Boolean actions_initted = False; - -static Widget -make_dialog (CONST char* name, Widget parent, Boolean pop_up_p, - CONST char* shell_title, CONST char* icon_name, - Boolean text_input_slot, - Boolean radio_box, Boolean list, - int left_buttons, int right_buttons) -{ - Arg av [20]; - int ac = 0; - int i, bc; - char button_name [255]; - Widget shell; - Widget dialog; - Widget button; - XtTranslations override; - - if (! pop_up_p) abort (); /* not implemented */ - if (text_input_slot) abort (); /* not implemented */ - if (radio_box) abort (); /* not implemented */ - if (list) abort (); /* not implemented */ - - if (! actions_initted) - { - XtAppContext app = XtWidgetToApplicationContext (parent); - XtAppAddActions (app, xaw_actions, - sizeof (xaw_actions) / sizeof (xaw_actions[0])); - actions_initted = True; - } - - override = XtParseTranslationTable (overrideTrans); - - ac = 0; - XtSetArg (av[ac], XtNtitle, shell_title); ac++; - XtSetArg (av[ac], XtNallowShellResize, True); ac++; - XtSetArg (av[ac], XtNtransientFor, parent); ac++; - shell = XtCreatePopupShell ("dialog", transientShellWidgetClass, - parent, av, ac); - XtOverrideTranslations (shell, override); - - ac = 0; - dialog = XtCreateManagedWidget (name, dialogWidgetClass, shell, av, ac); - - bc = 0; - button = 0; - for (i = 0; i < left_buttons; i++) - { - ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; - XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; - XtSetArg (av [ac], XtNright, XtChainLeft); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; - XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNresizable, True); ac++; - sprintf (button_name, "button%d", ++bc); - button = XtCreateManagedWidget (button_name, commandWidgetClass, - dialog, av, ac); - } - if (right_buttons) - { - /* Create a separator - - I want the separator to take up the slack between the buttons on - the right and the buttons on the left (that is I want the buttons - after the separator to be packed against the right edge of the - window) but I can't seem to make it do it. - */ - ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; -/* XtSetArg (av [ac], XtNfromVert, XtNameToWidget (dialog, "label")); ac++; */ - XtSetArg (av [ac], XtNleft, XtChainLeft); ac++; - XtSetArg (av [ac], XtNright, XtChainRight); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; - XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNlabel, ""); ac++; - XtSetArg (av [ac], XtNwidth, 30); ac++; /* #### aaack!! */ - XtSetArg (av [ac], XtNborderWidth, 0); ac++; - XtSetArg (av [ac], XtNshapeStyle, XmuShapeRectangle); ac++; - XtSetArg (av [ac], XtNresizable, False); ac++; - XtSetArg (av [ac], XtNsensitive, False); ac++; - button = XtCreateManagedWidget ("separator", - /* labelWidgetClass, */ - /* This has to be Command to fake out - the Dialog widget... */ - commandWidgetClass, - dialog, av, ac); - } - for (i = 0; i < right_buttons; i++) - { - ac = 0; - XtSetArg (av [ac], XtNfromHoriz, button); ac++; - XtSetArg (av [ac], XtNleft, XtChainRight); ac++; - XtSetArg (av [ac], XtNright, XtChainRight); ac++; - XtSetArg (av [ac], XtNtop, XtChainBottom); ac++; - XtSetArg (av [ac], XtNbottom, XtChainBottom); ac++; - XtSetArg (av [ac], XtNresizable, True); ac++; - sprintf (button_name, "button%d", ++bc); - button = XtCreateManagedWidget (button_name, commandWidgetClass, - dialog, av, ac); - } - - return dialog; -} - -Widget -xaw_create_dialog (widget_instance* instance) -{ - char *name = instance->info->type; - Widget parent = instance->parent; - Widget widget; - Boolean pop_up_p = instance->pop_up_p; - CONST char *shell_name = 0; - CONST char *icon_name = 0; - Boolean text_input_slot = False; - Boolean radio_box = False; - Boolean list = False; - int total_buttons; - int left_buttons = 0; - int right_buttons = 1; - - switch (name [0]) { - case 'E': case 'e': - icon_name = "dbox-error"; - shell_name = "Error"; - break; - - case 'I': case 'i': - icon_name = "dbox-info"; - shell_name = "Information"; - break; - - case 'L': case 'l': - list = True; - icon_name = "dbox-question"; - shell_name = "Prompt"; - break; - - case 'P': case 'p': - text_input_slot = True; - icon_name = "dbox-question"; - shell_name = "Prompt"; - break; - - case 'Q': case 'q': - icon_name = "dbox-question"; - shell_name = "Question"; - break; - } - - total_buttons = name [1] - '0'; - - if (name [3] == 'T' || name [3] == 't') - { - text_input_slot = False; - radio_box = True; - } - else if (name [3]) - right_buttons = name [4] - '0'; - - left_buttons = total_buttons - right_buttons; - - widget = make_dialog (name, parent, pop_up_p, - shell_name, icon_name, text_input_slot, radio_box, - list, left_buttons, right_buttons); - - return widget; -} -#endif /* LWLIB_DIALOGS_ATHENA */ - - -static void -xaw_generic_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance *) closure; - Widget instance_widget; - LWLIB_ID id; - XtPointer user_data; - - lw_internal_update_other_instances (widget, closure, call_data); - - if (! instance) - return; - if (widget->core.being_destroyed) - return; - - instance_widget = instance->widget; - if (!instance_widget) - return; - - id = instance->info->id; - -#if 0 - user_data = NULL; - { - Arg al [1]; - XtSetArg (al [0], XtNuserData, &user_data); - XtGetValues (widget, al, 1); - } -#else - /* Damn! Athena doesn't give us a way to hang our own data on the - buttons, so we have to go find it... I guess this assumes that - all instances of a button have the same call data. */ - { - widget_value *val = instance->info->val->contents; - char *name = XtName (widget); - while (val) - { - if (val->name && !strcmp (val->name, name)) - break; - val = val->next; - } - if (! val) abort (); - user_data = val->call_data; - } -#endif - - if (instance->info->selection_cb) - instance->info->selection_cb (widget, id, user_data); -} - -#ifdef LWLIB_DIALOGS_ATHENA - -static XtActionProc -wm_delete_window (Widget shell, XtPointer closure, XtPointer call_data) -{ - LWLIB_ID id; - Widget *kids = 0; - Widget widget; - Arg al [1]; - if (! XtIsSubclass (shell, shellWidgetClass)) - abort (); - XtSetArg (al [0], XtNchildren, &kids); - XtGetValues (shell, al, 1); - if (!kids || !*kids) - abort (); - widget = kids [0]; - if (! XtIsSubclass (widget, dialogWidgetClass)) - abort (); - id = lw_get_widget_id (widget); - if (! id) abort (); - - { - widget_info *info = lw_get_widget_info (id); - if (! info) abort (); - if (info->selection_cb) - info->selection_cb (widget, id, (XtPointer) -1); - } - - lw_destroy_all_widgets (id); - return NULL; -} - -#endif /* LWLIB_DIALOGS_ATHENA */ - - -/* Scrollbars */ - -#ifdef LWLIB_SCROLLBARS_ATHENA -static void -xaw_scrollbar_scroll (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance *) closure; - LWLIB_ID id; - scroll_event event_data; - - if (!instance || widget->core.being_destroyed) - return; - - id = instance->info->id; - event_data.slider_value = (int) call_data; - event_data.time = 0; - - if ((int) call_data > 0) - /* event_data.action = SCROLLBAR_PAGE_DOWN;*/ - event_data.action = SCROLLBAR_LINE_DOWN; - else - /* event_data.action = SCROLLBAR_PAGE_UP;*/ - event_data.action = SCROLLBAR_LINE_UP; - - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); -} - -static void -xaw_scrollbar_jump (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance *) closure; - LWLIB_ID id; - scroll_event event_data; - scrollbar_values *val = - (scrollbar_values *) instance->info->val->scrollbar_data; - float percent; - - if (!instance || widget->core.being_destroyed) - return; - - id = instance->info->id; - - percent = * (float *) call_data; - event_data.slider_value = - (int) (percent * (float) (val->maximum - val->minimum)) + val->minimum; - - event_data.time = 0; - event_data.action = SCROLLBAR_DRAG; - - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); -} - -static Widget -xaw_create_scrollbar (widget_instance *instance, int vertical) -{ - Arg av[10]; - int ac = 0; - - static XtCallbackRec jumpCallbacks[2] = - { {xaw_scrollbar_jump, NULL}, {NULL, NULL} }; - - static XtCallbackRec scrollCallbacks[2] = - { {xaw_scrollbar_scroll, NULL}, {NULL, NULL} }; - - jumpCallbacks[0].closure = scrollCallbacks[0].closure = (XtPointer) instance; - - /* #### This is tacked onto the with and height and completely - screws our geometry management. We should probably make the - top-level aware of this so that people could have a border but so - few people use the Athena scrollbar now that it really isn't - worth the effort, at least not at the moment. */ - XtSetArg (av [ac], XtNborderWidth, 0); ac++; - XtSetArg (av [ac], XtNorientation, - vertical ? XtorientVertical : XtorientHorizontal); ac++; - XtSetArg (av [ac], "jumpProc", jumpCallbacks); ac++; - XtSetArg (av [ac], "scrollProc", scrollCallbacks); ac++; - - return XtCreateWidget (instance->info->name, scrollbarWidgetClass, - instance->parent, av, ac); -} - -static Widget -xaw_create_vertical_scrollbar (widget_instance *instance) -{ - return xaw_create_scrollbar (instance, 1); -} - -static Widget -xaw_create_horizontal_scrollbar (widget_instance *instance) -{ - return xaw_create_scrollbar (instance, 0); -} -#endif /* LWLIB_SCROLLBARS_ATHENA */ - -widget_creation_entry -xaw_creation_table [] = -{ -#ifdef LWLIB_SCROLLBARS_ATHENA - {"vertical-scrollbar", xaw_create_vertical_scrollbar}, - {"horizontal-scrollbar", xaw_create_horizontal_scrollbar}, -#endif - {NULL, NULL} -}; diff --git a/lwlib/lwlib-Xaw.h b/lwlib/lwlib-Xaw.h deleted file mode 100644 index 70e72d4..0000000 --- a/lwlib/lwlib-Xaw.h +++ /dev/null @@ -1,31 +0,0 @@ -#ifndef LWLIB_XAW_H -#define LWLIB_XAW_H - -#include "lwlib-internal.h" - -extern widget_creation_entry xaw_creation_table []; - -Widget -xaw_create_dialog (widget_instance* instance); - -Boolean -lw_xaw_widget_p (Widget widget); - -void -xaw_update_one_widget (widget_instance *instance, Widget widget, - widget_value *val, Boolean deep_p); - -void -xaw_update_one_value (widget_instance* instance, Widget widget, - widget_value* val); - -void -xaw_destroy_instance (widget_instance* instance); - -void -xaw_popup_menu (Widget widget, XEvent *event); - -void -xaw_pop_instance (widget_instance* instance, Boolean up); - -#endif /* LWLIB_XAW_H */ diff --git a/lwlib/lwlib-Xlw.c b/lwlib/lwlib-Xlw.c deleted file mode 100644 index 127403a..0000000 --- a/lwlib/lwlib-Xlw.c +++ /dev/null @@ -1,407 +0,0 @@ -/* The lwlib interface to "xlwmenu" menus. - Copyright (C) 1992, 1994 Lucid, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -#include -#include /* for abort () */ -#include - -#include "lwlib-Xlw.h" -#include -#include -#include -#include -#include -#ifdef LWLIB_MENUBARS_LUCID -#include "xlwmenu.h" -#endif -#ifdef LWLIB_SCROLLBARS_LUCID -#include "xlwscrollbar.h" -#endif - - - -#ifdef LWLIB_MENUBARS_LUCID - -/* Menu callbacks */ - -static void -pre_hook (Widget w, XtPointer client_data, XtPointer call_data) -{ - widget_instance* instance = (widget_instance*)client_data; - widget_value* val; - - if (w->core.being_destroyed) - return; - - val = lw_get_widget_value_for_widget (instance, w); -#if 0 - /* #### - this code used to (for some random back_asswards reason) pass - the expression below in the call_data slot. For incremental menu - construction, this needs to go. I can't even figure out why it was done - this way in the first place...it's just a historical weirdism. --Stig */ - call_data = (val ? val->call_data : NULL); -#endif - if (val && val->call_data) - abort(); /* #### - the call_data for the top_level - "menubar" widget_value used to be passed - back to the pre_hook. */ - - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (w, instance->info->id, call_data); -} - -static void -pick_hook (Widget w, XtPointer client_data, XtPointer call_data) -{ - widget_instance* instance = (widget_instance*)client_data; - widget_value* contents_val = (widget_value*)call_data; - widget_value* widget_val; - XtPointer widget_arg; - LWLIB_ID id; - lw_callback post_activate_cb; - - if (w->core.being_destroyed) - return; - - /* Grab these values before running any functions, in case running - the selection_cb causes the widget to be destroyed. */ - id = instance->info->id; - post_activate_cb = instance->info->post_activate_cb; - - widget_val = lw_get_widget_value_for_widget (instance, w); - widget_arg = widget_val ? widget_val->call_data : NULL; - - if (instance->info->selection_cb && - contents_val && - contents_val->enabled && - !contents_val->contents) - instance->info->selection_cb (w, id, contents_val->call_data); - - if (post_activate_cb) - post_activate_cb (w, id, widget_arg); -} - - - -/* creation functions */ -static Widget -xlw_create_menubar (widget_instance* instance) -{ - Arg al [1]; - Widget widget; - - XtSetArg (al [0], XtNmenu, instance->info->val); - widget = XtCreateWidget (instance->info->name, xlwMenuWidgetClass, - instance->parent, al, 1); - XtAddCallback (widget, XtNopen, pre_hook, (XtPointer)instance); - XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); - return widget; -} - -static Widget -xlw_create_popup_menu (widget_instance* instance) -{ - Arg al [2]; - Widget popup_shell, widget; - - popup_shell = XtCreatePopupShell (instance->info->name, - overrideShellWidgetClass, - instance->parent, NULL, 0); - XtSetArg (al [0], XtNmenu, instance->info->val); - XtSetArg (al [1], XtNhorizontal, False); - widget = XtCreateManagedWidget ("popup", xlwMenuWidgetClass, - popup_shell, al, 2); - XtAddCallback (widget, XtNselect, pick_hook, (XtPointer)instance); - - return popup_shell; -} -#endif /* LWLIB_MENUBARS_LUCID */ - -#ifdef LWLIB_SCROLLBARS_LUCID -static void -xlw_scrollbar_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance *) closure; - LWLIB_ID id; - XlwScrollBarCallbackStruct *data = - (XlwScrollBarCallbackStruct *) call_data; - scroll_event event_data; - scrollbar_values *val = - (scrollbar_values *) instance->info->val->scrollbar_data; - double percent; - - if (!instance || widget->core.being_destroyed) - return; - - id = instance->info->id; - - percent = (double) (data->value - 1) / (double) (INT_MAX - 1); - event_data.slider_value = - (int) (percent * (double) (val->maximum - val->minimum)) + val->minimum; - - if (event_data.slider_value > val->maximum - val->slider_size) - event_data.slider_value = val->maximum - val->slider_size; - else if (event_data.slider_value < val->minimum) - event_data.slider_value = val->minimum; - - if (data->event) - { - switch (data->event->type) - { - case KeyPress: - case KeyRelease: - event_data.time = data->event->xkey.time; - break; - case ButtonPress: - case ButtonRelease: - event_data.time = data->event->xbutton.time; - break; - case MotionNotify: - event_data.time = data->event->xmotion.time; - break; - case EnterNotify: - case LeaveNotify: - event_data.time = data->event->xcrossing.time; - break; - default: - event_data.time = 0; - break; - } - } - else - event_data.time = 0; - - switch (data->reason) - { - case XmCR_DECREMENT: event_data.action = SCROLLBAR_LINE_UP; break; - case XmCR_INCREMENT: event_data.action = SCROLLBAR_LINE_DOWN; break; - case XmCR_PAGE_DECREMENT: event_data.action = SCROLLBAR_PAGE_UP; break; - case XmCR_PAGE_INCREMENT: event_data.action = SCROLLBAR_PAGE_DOWN; break; - case XmCR_TO_TOP: event_data.action = SCROLLBAR_TOP; break; - case XmCR_TO_BOTTOM: event_data.action = SCROLLBAR_BOTTOM; break; - case XmCR_DRAG: event_data.action = SCROLLBAR_DRAG; break; - case XmCR_VALUE_CHANGED: event_data.action = SCROLLBAR_CHANGE; break; - default: event_data.action = SCROLLBAR_CHANGE; break; - } - - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); -} - -#define add_scrollbar_callback(resource) \ -XtAddCallback (scrollbar, resource, xlw_scrollbar_callback, (XtPointer) instance) - -/* #### Does not yet support horizontal scrollbars. */ -static Widget -xlw_create_scrollbar (widget_instance *instance, int vertical) -{ - Arg al[20]; - int ac = 0; - static XtCallbackRec callbacks[2] = - { {xlw_scrollbar_callback, NULL}, {NULL, NULL} }; - - callbacks[0].closure = (XtPointer) instance; - - XtSetArg (al[ac], XmNminimum, 1); ac++; - XtSetArg (al[ac], XmNmaximum, INT_MAX); ac++; - XtSetArg (al[ac], XmNincrement, 1); ac++; - XtSetArg (al[ac], XmNpageIncrement, 1); ac++; - XtSetArg (al[ac], XmNorientation, (vertical ? XmVERTICAL : XmHORIZONTAL)); ac++; - - XtSetArg (al[ac], XmNdecrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNdragCallback, callbacks); ac++; - XtSetArg (al[ac], XmNincrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNpageDecrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNpageIncrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNtoBottomCallback, callbacks); ac++; - XtSetArg (al[ac], XmNtoTopCallback, callbacks); ac++; - XtSetArg (al[ac], XmNvalueChangedCallback, callbacks); ac++; - - return XtCreateWidget (instance->info->name, xlwScrollBarWidgetClass, - instance->parent, al, ac); -} - -static Widget -xlw_create_vertical_scrollbar (widget_instance *instance) -{ - return xlw_create_scrollbar (instance, 1); -} - -static Widget -xlw_create_horizontal_scrollbar (widget_instance *instance) -{ - return xlw_create_scrollbar (instance, 0); -} - -static void -xlw_update_scrollbar (widget_instance *instance, Widget widget, - widget_value *val) -{ - if (val->scrollbar_data) - { - scrollbar_values *data = val->scrollbar_data; - int widget_sliderSize, widget_val; - int new_sliderSize, new_value; - double percent; - Arg al [4]; - - /* First size and position the scrollbar widget. */ - XtSetArg (al [0], XtNx, data->scrollbar_x); - XtSetArg (al [1], XtNy, data->scrollbar_y); - XtSetArg (al [2], XtNwidth, data->scrollbar_width); - XtSetArg (al [3], XtNheight, data->scrollbar_height); - XtSetValues (widget, al, 4); - - /* Now size the scrollbar's slider. */ - XtSetArg (al [0], XmNsliderSize, &widget_sliderSize); - XtSetArg (al [1], XmNvalue, &widget_val); - XtGetValues (widget, al, 2); - - percent = (double) data->slider_size / - (double) (data->maximum - data->minimum); - percent = (percent > 1.0 ? 1.0 : percent); - new_sliderSize = (int) ((double) (INT_MAX - 1) * percent); - - percent = (double) (data->slider_position - data->minimum) / - (double) (data->maximum - data->minimum); - percent = (percent > 1.0 ? 1.0 : percent); - new_value = (int) ((double) (INT_MAX - 1) * percent); - - if (new_sliderSize > INT_MAX - 1) - new_sliderSize = INT_MAX - 1; - else if (new_sliderSize < 1) - new_sliderSize = 1; - - if (new_value > (INT_MAX - new_sliderSize)) - new_value = INT_MAX - new_sliderSize; - else if (new_value < 1) - new_value = 1; - - if (new_sliderSize != widget_sliderSize || new_value != widget_val) - XlwScrollBarSetValues (widget, new_value, new_sliderSize, 1, 1, False); - } -} - -#endif /* LWLIB_SCROLLBARS_LUCID */ - -widget_creation_entry -xlw_creation_table [] = -{ -#ifdef LWLIB_MENUBARS_LUCID - {"menubar", xlw_create_menubar}, - {"popup", xlw_create_popup_menu}, -#endif -#ifdef LWLIB_SCROLLBARS_LUCID - {"vertical-scrollbar", xlw_create_vertical_scrollbar}, - {"horizontal-scrollbar", xlw_create_horizontal_scrollbar}, -#endif - {NULL, NULL} -}; - -Boolean -lw_lucid_widget_p (Widget widget) -{ - WidgetClass the_class = XtClass (widget); -#ifdef LWLIB_MENUBARS_LUCID - if (the_class == xlwMenuWidgetClass) - return True; -#endif -#ifdef LWLIB_SCROLLBARS_LUCID - if (the_class == xlwScrollBarWidgetClass) - return True; -#endif -#ifdef LWLIB_MENUBARS_LUCID - if (the_class == overrideShellWidgetClass) - return - XtClass (((CompositeWidget)widget)->composite.children [0]) - == xlwMenuWidgetClass; -#endif - return False; -} - -void -xlw_update_one_widget (widget_instance* instance, Widget widget, - widget_value* val, Boolean deep_p) -{ - WidgetClass class; - - class = XtClass (widget); - - if (0) - ; -#ifdef LWLIB_MENUBARS_LUCID - else if (class == xlwMenuWidgetClass) - { - XlwMenuWidget mw; - Arg al [1]; - if (XtIsShell (widget)) - mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; - else - mw = (XlwMenuWidget)widget; - XtSetArg (al [0], XtNmenu, val); - XtSetValues (widget, al, 1); - } -#endif -#ifdef LWLIB_SCROLLBARS_LUCID - else if (class == xlwScrollBarWidgetClass) - { - xlw_update_scrollbar (instance, widget, val); - } -#endif -} - -void -xlw_update_one_value (widget_instance* instance, Widget widget, - widget_value* val) -{ - return; -} - -void -xlw_pop_instance (widget_instance* instance, Boolean up) -{ -} - -#ifdef LWLIB_MENUBARS_LUCID -void -xlw_popup_menu (Widget widget, XEvent *event) -{ - XlwMenuWidget mw; - - if (!XtIsShell (widget)) - return; - - if (event->type == ButtonPress || event->type == ButtonRelease) - { - mw = (XlwMenuWidget)((CompositeWidget)widget)->composite.children [0]; - xlw_pop_up_menu (mw, (XButtonPressedEvent *)event); - } - else - abort (); -} -#endif /* LWLIB_MENUBARS_LUCID */ - - /* Destruction of instances */ -void -xlw_destroy_instance (widget_instance* instance) -{ - if (instance->widget) - XtDestroyWidget (instance->widget); -} diff --git a/lwlib/lwlib-Xlw.h b/lwlib/lwlib-Xlw.h deleted file mode 100644 index f4fd0ed..0000000 --- a/lwlib/lwlib-Xlw.h +++ /dev/null @@ -1,29 +0,0 @@ -#ifndef LWLIB_XLW_H -#define LWLIB_XLW_H - -#include "lwlib-internal.h" - -extern widget_creation_entry xlw_creation_table []; -extern widget_creation_function xlw_create_dialog; - -Boolean -lw_lucid_widget_p (Widget widget); - -void -xlw_update_one_widget (widget_instance* instance, Widget widget, - widget_value* val, Boolean deep_p); - -void -xlw_update_one_value (widget_instance* instance, Widget widget, - widget_value* val); - -void -xlw_destroy_instance (widget_instance* instance); - -void -xlw_pop_instance (widget_instance* instance, Boolean up); - -void -xlw_popup_menu (Widget widget, XEvent *event); - -#endif /* LWLIB_XLW_H */ diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c deleted file mode 100644 index 80c7b13..0000000 --- a/lwlib/lwlib-Xm.c +++ /dev/null @@ -1,1943 +0,0 @@ -/* The lwlib interface to Motif widgets. - Copyright (C) 1992, 1993, 1994 Lucid, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -#include -#include -#include -#include -#include - -#include "lwlib-Xm.h" -#include "lwlib-utils.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef LWLIB_MENUBARS_MOTIF -static void xm_pull_down_callback (Widget, XtPointer, XtPointer); -#if 0 -static void xm_pop_down_callback (Widget, XtPointer, XtPointer); -#endif /* 0 */ -#endif -static void xm_internal_update_other_instances (Widget, XtPointer, - XtPointer); -static void xm_generic_callback (Widget, XtPointer, XtPointer); -#ifdef LWLIB_DIALOGS_MOTIF -static void xm_nosel_callback (Widget, XtPointer, XtPointer); -#endif -#ifdef LWLIB_SCROLLBARS_MOTIF -static void xm_scrollbar_callback (Widget, XtPointer, XtPointer); -#endif - -#ifdef LWLIB_MENUBARS_MOTIF -static void -xm_update_menu (widget_instance* instance, Widget widget, widget_value* val, - Boolean deep_p); -#endif - - /* Structures to keep destroyed instances */ -typedef struct _destroyed_instance -{ - char* name; - char* type; - Widget widget; - Widget parent; - Boolean pop_up_p; - struct _destroyed_instance* next; -} destroyed_instance; - -static destroyed_instance* -all_destroyed_instances = NULL; - -/* Utility function. */ -static char * -safe_strdup (char* s) -{ - char *result; - if (! s) return 0; - result = (char *) malloc (strlen (s) + 1); - if (! result) - return 0; - strcpy (result, s); - return result; -} - -static destroyed_instance* -make_destroyed_instance (char* name, char* type, Widget widget, Widget parent, - Boolean pop_up_p) -{ - destroyed_instance* instance = - (destroyed_instance*) malloc (sizeof (destroyed_instance)); - instance->name = safe_strdup (name); - instance->type = safe_strdup (type); - instance->widget = widget; - instance->parent = parent; - instance->pop_up_p = pop_up_p; - instance->next = NULL; - return instance; -} - -static void -free_destroyed_instance (destroyed_instance* instance) -{ - free (instance->name); - free (instance->type); - free (instance); -} - - /* motif utility functions */ -Widget -first_child (Widget widget) -{ - return ((CompositeWidget)widget)->composite.children [0]; -} - -Boolean -lw_motif_widget_p (Widget widget) -{ - return -#ifdef LWLIB_DIALOGS_MOTIF - XtClass (widget) == xmDialogShellWidgetClass || -#endif - XmIsPrimitive (widget) || XmIsManager (widget) || XmIsGadget (widget); -} - -static char * -resource_string (Widget widget, char *name) -{ - XtResource resource; - char *result = NULL; - - resource.resource_name = "labelString"; - resource.resource_class = "LabelString"; /* #### should be Xmsomething... */ - resource.resource_type = XtRString; - resource.resource_size = sizeof (String); - resource.resource_offset = 0; - resource.default_type = XtRImmediate; - resource.default_addr = 0; - - XtGetSubresources (widget, (XtPointer)&result, name, - name, &resource, 1, NULL, 0); - return result; -} - -#ifdef LWLIB_MENUBARS_MOTIF - -static void -destroy_all_children (Widget widget) -{ - Widget* children; - unsigned int number; - int i; - - children = XtCompositeChildren (widget, &number); - if (children) - { - /* Unmanage all children and destroy them. They will only be - * really destroyed when we get out of DispatchEvent. */ - for (i = 0; i < number; i++) - { - Widget child = children [i]; - if (!child->core.being_destroyed) - { - XtUnmanageChild (child); - XtDestroyWidget (child); - } - } - XtFree ((char *) children); - } -} - -#endif /* LWLIB_MENUBARS_MOTIF */ - - - -#ifdef LWLIB_DIALOGS_MOTIF - -static Boolean -is_in_dialog_box (Widget w) -{ - Widget wmshell; - - wmshell = XtParent (w); - while (wmshell && (XtClass (wmshell) != xmDialogShellWidgetClass)) - wmshell = XtParent (wmshell); - - if (wmshell && XtClass (wmshell) == xmDialogShellWidgetClass) - return True; - else - return False; -} - -#endif /* LWLIB_DIALOGS_MOTIF */ - -#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) - -/* update the label of anything subclass of a label */ -static void -xm_update_label (widget_instance* instance, Widget widget, widget_value* val) -{ - XmString built_string = NULL; - XmString key_string = NULL; - XmString val_string = NULL; - XmString name_string = NULL; - Arg al [20]; - int ac = 0; - - if (val->value) - { -#ifdef LWLIB_DIALOGS_MOTIF - /* - * Sigh. The main text of a label is the name field for menubar - * entries. The value field is a possible additional field to be - * concatenated on to the name field. HOWEVER, with dialog boxes - * the value field is the complete text which is supposed to be - * displayed as the label. Yuck. - */ - if (is_in_dialog_box (widget)) - { - char *value_name = NULL; - - value_name = resource_string (widget, val->value); - if (!value_name) - value_name = val->value; - - built_string = - XmStringCreateLtoR (value_name, XmSTRING_DEFAULT_CHARSET); - } - else -#endif /* LWLIB_DIALOGS_MOTIF */ - { - char *value_name = NULL; - char *res_name = NULL; - - res_name = resource_string (widget, val->name); - if (!res_name) - res_name = val->name; - - name_string = - XmStringCreateLtoR (res_name, XmSTRING_DEFAULT_CHARSET); - - value_name = XtMalloc (strlen (val->value) + 2); - *value_name = 0; - strcat (value_name, " "); - strcat (value_name, val->value); - - val_string = - XmStringCreateLtoR (value_name, XmSTRING_DEFAULT_CHARSET); - - built_string = - XmStringConcat (name_string, val_string); - - XtFree (value_name); - } - - XtSetArg (al [ac], XmNlabelString, built_string); ac++; - XtSetArg (al [ac], XmNlabelType, XmSTRING); ac++; - } - - if (val->key) - { - key_string = XmStringCreateLtoR (val->key, XmSTRING_DEFAULT_CHARSET); - XtSetArg (al [ac], XmNacceleratorText, key_string); ac++; - } - - if (ac) - XtSetValues (widget, al, ac); - - if (built_string) - XmStringFree (built_string); - - if (key_string) - XmStringFree (key_string); - - if (name_string) - XmStringFree (name_string); -} - -#endif /* defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) */ - - /* update of list */ -static void -xm_update_list (widget_instance* instance, Widget widget, widget_value* val) -{ - widget_value* cur; - int i; - XtRemoveAllCallbacks (widget, XmNsingleSelectionCallback); - XtAddCallback (widget, XmNsingleSelectionCallback, xm_generic_callback, - instance); - for (cur = val->contents, i = 0; cur; cur = cur->next) - if (cur->value) - { - XmString xmstr = XmStringCreate (cur->value, XmSTRING_DEFAULT_CHARSET); - i += 1; - XmListAddItem (widget, xmstr, 0); - if (cur->selected) - XmListSelectPos (widget, i, False); - XmStringFree (xmstr); - } -} - - /* update of buttons */ -static void -xm_update_pushbutton (widget_instance* instance, Widget widget, - widget_value* val) -{ - Arg al [1]; - XtSetArg (al [0], XmNalignment, XmALIGNMENT_CENTER); - XtSetValues (widget, al, 1); - XtRemoveAllCallbacks (widget, XmNactivateCallback); - XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); -} - -#ifdef LWLIB_MENUBARS_MOTIF - -static void -xm_update_cascadebutton (widget_instance* instance, Widget widget, - widget_value* val) -{ - /* Should also rebuild the menu by calling ...update_menu... */ - if (val - && val->type == CASCADE_TYPE - && val->contents - && val->contents->type == INCREMENTAL_TYPE) - { - /* okay, we're now doing a lisp callback to incrementally generate - more of the menu. */ - XtRemoveAllCallbacks (widget, XmNcascadingCallback); - XtAddCallback (widget, XmNcascadingCallback, xm_pull_down_callback, - instance); - XtCallCallbacks ((Widget)widget, - XmNcascadingCallback, - (XtPointer)val->contents); - - } else { - XtRemoveAllCallbacks (widget, XmNcascadingCallback); - XtAddCallback (widget, XmNcascadingCallback, xm_pull_down_callback, - instance); - } -} - -#endif /* LWLIB_MENUBARS_MOTIF */ - - /* update toggle and radiobox */ -static void -xm_update_toggle (widget_instance* instance, Widget widget, widget_value* val) -{ - Arg al [2]; - XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); - XtAddCallback (widget, XmNvalueChangedCallback, xm_generic_callback, - instance); - XtSetArg (al [0], XmNset, val->selected); - XtSetArg (al [1], XmNalignment, XmALIGNMENT_BEGINNING); - XtSetValues (widget, al, 2); -} - -static void -xm_update_radiobox (widget_instance* instance, Widget widget, - widget_value* val) -{ - Widget toggle; - widget_value* cur; - - /* update the callback */ - XtRemoveAllCallbacks (widget, XmNentryCallback); - XtAddCallback (widget, XmNentryCallback, xm_generic_callback, instance); - - /* first update all the toggles */ - /* Energize kernel interface is currently bad. It sets the selected widget - with the selected flag but returns it by its name. So we currently - have to support both setting the selection with the selected slot - of val contents and setting it with the "value" slot of val. The latter - has a higher priority. This to be removed when the kernel is fixed. */ - for (cur = val->contents; cur; cur = cur->next) - { - toggle = XtNameToWidget (widget, cur->value); - if (toggle) - { - Arg al [2]; - XtSetArg (al [0], XmNsensitive, cur->enabled); - XtSetArg (al [1], XmNset, (!val->value && cur->selected ? cur->selected : False)); - XtSetValues (toggle, al, 2); - } - } - - /* The selected was specified by the value slot */ - if (val->value) - { - toggle = XtNameToWidget (widget, val->value); - if (toggle) - { - Arg al [1]; - XtSetArg (al [0], XmNset, True); - XtSetValues (toggle, al, 1); - } - } -} - -#ifdef LWLIB_MENUBARS_MOTIF - - /* update a popup menu, pulldown menu or a menubar */ -static void -make_menu_in_widget (widget_instance* instance, Widget widget, - widget_value* val) -{ - Widget* children = 0; - int num_children; - int child_index; - widget_value* cur; - Widget button = 0; - Widget menu; - Arg al [256]; - int ac; - Boolean menubar_p = False; - - /* Allocate the children array */ - for (num_children = 0, cur = val; cur; num_children++, cur = cur->next); - children = (Widget*)XtMalloc (num_children * sizeof (Widget)); - - /* tricky way to know if this RowColumn is a menubar or a pulldown... */ - XtSetArg (al [0], XmNisHomogeneous, &menubar_p); - XtGetValues (widget, al, 1); - - /* add the unmap callback for popups and pulldowns */ - /*** this sounds bogus ***/ - /* probably because it is -- cet */ -/* - if (!menubar_p) - XtAddCallback (XtParent (widget), XmNpopdownCallback, - xm_pop_down_callback, (XtPointer)instance); -*/ - - num_children = 0; - for (child_index = 0, cur = val; cur; child_index++, cur = cur->next) - { - ac = 0; - button = 0; - XtSetArg (al [ac], XmNsensitive, cur->enabled); ac++; - XtSetArg (al [ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; - XtSetArg (al [ac], XmNuserData, cur->call_data); ac++; - - switch (cur->type) - { - case PUSHRIGHT_TYPE: - /* A pushright marker which is not needed for the real Motif - menubar. */ - break; - case SEPARATOR_TYPE: - ac = 0; - if (cur->value) - { - /* #### - xlwmenu.h supports several types that motif does - not. Also, motif supports pixmaps w/ type NO_LINE and - lwlib provides no way to access that functionality. --Stig */ - XtSetArg (al [ac], XmNseparatorType, cur->value), ac++; - } - button = XmCreateSeparator (widget, "separator", al, ac); - break; - case CASCADE_TYPE: - menu = XmCreatePulldownMenu (widget, "pulldown", NULL, 0); - make_menu_in_widget (instance, menu, cur->contents); - XtSetArg (al [ac], XmNsubMenuId, menu); ac++; - button = XmCreateCascadeButton (widget, cur->name, al, ac); - - xm_update_label (instance, button, cur); - - XtAddCallback (button, XmNcascadingCallback, xm_pull_down_callback, - (XtPointer)instance); - break; - default: - if (menubar_p) - button = XmCreateCascadeButton (widget, cur->name, al, ac); - else if (!cur->call_data) - button = XmCreateLabel (widget, cur->name, al, ac); - else if (cur->type == TOGGLE_TYPE || cur->type == RADIO_TYPE) - { - XtSetArg (al [ac], XmNindicatorType, - (cur->type == TOGGLE_TYPE ? - XmN_OF_MANY : XmONE_OF_MANY)); ac++; - XtSetArg (al [ac], XmNvisibleWhenOff, True); ac++; - button = XmCreateToggleButtonGadget (widget, cur->name, al, ac); - } - else - button = XmCreatePushButtonGadget (widget, cur->name, al, ac); - - xm_update_label (instance, button, cur); - - /* don't add a callback to a simple label */ - if (cur->type == TOGGLE_TYPE || cur->type == RADIO_TYPE) - xm_update_toggle (instance, button, cur); - else if (cur->call_data) - XtAddCallback (button, XmNactivateCallback, xm_generic_callback, - (XtPointer)instance); - } /* switch (cur->type) */ - - if (button) - children [num_children++] = button; - } - - /* Last entry is the help button. This used be done after managing - the buttons. The comment claimed that it had to be done this way - otherwise the menubar ended up only 4 pixels high. That must - have been in the Old World. In the New World it stays the proper - height if you don't manage them until after you set this and as a - bonus the Help menu ends up where it is supposed to. */ - if (button) - { - ac = 0; - XtSetArg (al [ac], XmNmenuHelpWidget, button); ac++; - XtSetValues (widget, al, ac); - } - - if (num_children) - XtManageChildren (children, num_children); - - XtFree ((char *) children); -} - -static void -update_one_menu_entry (widget_instance* instance, Widget widget, - widget_value* val, Boolean deep_p) -{ - Arg al [2]; - int ac; - Widget menu; - widget_value* contents; - - if (val->change == NO_CHANGE) - return; - - /* update the sensitivity and userdata */ - /* Common to all widget types */ - XtSetArg (al [0], XmNsensitive, val->enabled); - XtSetArg (al [1], XmNuserData, val->call_data); - XtSetValues (widget, al, 2); - - /* update the menu button as a label. */ - if (val->change >= VISIBLE_CHANGE) - { - xm_update_label (instance, widget, val); - if (XtClass (widget) == xmToggleButtonWidgetClass - || XtClass (widget) == xmToggleButtonGadgetClass) - { - xm_update_toggle (instance, widget, val); - } - } - - - /* update the pulldown/pullaside as needed */ - menu = NULL; - XtSetArg (al [0], XmNsubMenuId, &menu); - XtGetValues (widget, al, 1); - - contents = val->contents; - - if (!menu) - { - if (contents) - { - menu = XmCreatePulldownMenu (widget, "pulldown", NULL, 0); - make_menu_in_widget (instance, menu, contents); - ac = 0; - XtSetArg (al [ac], XmNsubMenuId, menu); ac++; - XtSetValues (widget, al, ac); - } - } - else if (!contents) - { - ac = 0; - XtSetArg (al [ac], XmNsubMenuId, NULL); ac++; - XtSetValues (widget, al, ac); - XtDestroyWidget (menu); - } - else if (deep_p && contents->change != NO_CHANGE) - xm_update_menu (instance, menu, val, 1); -} - -static void -xm_update_menu (widget_instance* instance, Widget widget, widget_value* val, - Boolean deep_p) -{ - /* Widget is a RowColumn widget whose contents have to be updated - * to reflect the list of items in val->contents */ - if (val->contents->change == STRUCTURAL_CHANGE) - { - destroy_all_children (widget); - make_menu_in_widget (instance, widget, val->contents); - } - else - { - /* Update all the buttons of the RowColumn in order. */ - Widget* children; - unsigned int num_children; - int i; - widget_value *cur = 0; - - children = XtCompositeChildren (widget, &num_children); - if (children) - { - for (i = 0, cur = val->contents; i < num_children; i++) - { - if (!cur) - abort (); - /* skip if this is a pushright marker or a separator */ - if (cur->type == PUSHRIGHT_TYPE || cur->type == SEPARATOR_TYPE) - { - cur = cur->next; -#if 0 - /* #### - this could puke if you have a separator as the - last item on a pullright menu. */ - if (!cur) - abort (); -#else - if (!cur) - continue; -#endif - } - if (children [i]->core.being_destroyed - || strcmp (XtName (children [i]), cur->name)) - continue; - update_one_menu_entry (instance, children [i], cur, deep_p); - cur = cur->next; - } - XtFree ((char *) children); - } - if (cur) - abort (); - } -} - -#endif /* LWLIB_MENUBARS_MOTIF */ - - -#ifdef LWLIB_DIALOGS_MOTIF - -/* update text widgets */ - -static void -xm_update_text (widget_instance* instance, Widget widget, widget_value* val) -{ - XmTextSetString (widget, val->value ? val->value : ""); - XtRemoveAllCallbacks (widget, XmNactivateCallback); - XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); - XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); - XtAddCallback (widget, XmNvalueChangedCallback, - xm_internal_update_other_instances, instance); -} - -static void -xm_update_text_field (widget_instance* instance, Widget widget, - widget_value* val) -{ - XmTextFieldSetString (widget, val->value ? val->value : ""); - XtRemoveAllCallbacks (widget, XmNactivateCallback); - XtAddCallback (widget, XmNactivateCallback, xm_generic_callback, instance); - XtRemoveAllCallbacks (widget, XmNvalueChangedCallback); - XtAddCallback (widget, XmNvalueChangedCallback, - xm_internal_update_other_instances, instance); -} - -#endif /* LWLIB_DIALOGS_MOTIF */ - -#ifdef LWLIB_SCROLLBARS_MOTIF - -/* - * If this function looks like it does a lot more work than it needs to, - * you're right. Blame the Motif scrollbar for not being smart about - * updating its appearance. - */ -static void -xm_update_scrollbar (widget_instance *instance, Widget widget, - widget_value *val) -{ - if (val->scrollbar_data) - { - scrollbar_values *data = val->scrollbar_data; - int widget_sliderSize, widget_val; - int new_sliderSize, new_value; - double percent; - double h_water, l_water; - Arg al [4]; - - /* First size and position the scrollbar widget. */ - XtSetArg (al [0], XtNx, data->scrollbar_x); - XtSetArg (al [1], XtNy, data->scrollbar_y); - XtSetArg (al [2], XtNwidth, data->scrollbar_width); - XtSetArg (al [3], XtNheight, data->scrollbar_height); - XtSetValues (widget, al, 4); - - /* Now size the scrollbar's slider. */ - XtSetArg (al [0], XmNsliderSize, &widget_sliderSize); - XtSetArg (al [1], XmNvalue, &widget_val); - XtGetValues (widget, al, 2); - - percent = (double) data->slider_size / - (double) (data->maximum - data->minimum); - new_sliderSize = (int) ((double) (INT_MAX - 1) * percent); - - percent = (double) (data->slider_position - data->minimum) / - (double) (data->maximum - data->minimum); - new_value = (int) ((double) (INT_MAX - 1) * percent); - - if (new_sliderSize > (INT_MAX - 1)) - new_sliderSize = INT_MAX - 1; - else if (new_sliderSize < 1) - new_sliderSize = 1; - - if (new_value > (INT_MAX - new_sliderSize)) - new_value = INT_MAX - new_sliderSize; - else if (new_value < 1) - new_value = 1; - - h_water = 1.05; - l_water = 0.95; - if (new_sliderSize != widget_sliderSize || new_value != widget_val) - { - int force = ((INT_MAX - widget_sliderSize - widget_val) - ? 0 - : (INT_MAX - new_sliderSize - new_value)); - - if (force - || (double)new_sliderSize < (l_water * (double)widget_sliderSize) - || (double)new_sliderSize > (h_water * (double)widget_sliderSize) - || (double)new_value < (l_water * (double)widget_val) - || (double)new_value > (h_water * (double)widget_val)) - { - XmScrollBarSetValues (widget, new_value, new_sliderSize, 1, 1, - False); - } - } - } -} - -#endif /* LWLIB_SCROLLBARS_MOTIF */ - - -/* update a motif widget */ - -void -xm_update_one_widget (widget_instance* instance, Widget widget, - widget_value* val, Boolean deep_p) -{ - WidgetClass class; - Arg al [2]; - - /* Mark as not edited */ - val->edited = False; - - /* Common to all widget types */ - XtSetArg (al [0], XmNsensitive, val->enabled); - XtSetArg (al [1], XmNuserData, val->call_data); - XtSetValues (widget, al, 2); - -#if defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_MENUBARS_MOTIF) - /* Common to all label like widgets */ - if (XtIsSubclass (widget, xmLabelWidgetClass)) - xm_update_label (instance, widget, val); -#endif - - class = XtClass (widget); - /* Class specific things */ - if (class == xmPushButtonWidgetClass || - class == xmArrowButtonWidgetClass) - { - xm_update_pushbutton (instance, widget, val); - } -#ifdef LWLIB_MENUBARS_MOTIF - else if (class == xmCascadeButtonWidgetClass) - { - xm_update_cascadebutton (instance, widget, val); - } -#endif - else if (class == xmToggleButtonWidgetClass - || class == xmToggleButtonGadgetClass) - { - xm_update_toggle (instance, widget, val); - } - else if (class == xmRowColumnWidgetClass) - { - Boolean radiobox = 0; - - XtSetArg (al [0], XmNradioBehavior, &radiobox); - XtGetValues (widget, al, 1); - - if (radiobox) - xm_update_radiobox (instance, widget, val); -#ifdef LWLIB_MENUBARS_MOTIF - else - xm_update_menu (instance, widget, val, deep_p); -#endif - } -#ifdef LWLIB_DIALOGS_MOTIF - else if (class == xmTextWidgetClass) - { - xm_update_text (instance, widget, val); - } - else if (class == xmTextFieldWidgetClass) - { - xm_update_text_field (instance, widget, val); - } -#endif - else if (class == xmListWidgetClass) - { - xm_update_list (instance, widget, val); - } -#ifdef LWLIB_SCROLLBARS_MOTIF - else if (class == xmScrollBarWidgetClass) - { - xm_update_scrollbar (instance, widget, val); - } -#endif -} - - /* getting the value back */ -void -xm_update_one_value (widget_instance* instance, Widget widget, - widget_value* val) -{ - WidgetClass class = XtClass (widget); - widget_value *old_wv; - - /* copy the call_data slot into the "return" widget_value */ - for (old_wv = instance->info->val->contents; old_wv; old_wv = old_wv->next) - if (!strcmp (val->name, old_wv->name)) - { - val->call_data = old_wv->call_data; - break; - } - - if (class == xmToggleButtonWidgetClass || class == xmToggleButtonGadgetClass) - { - Arg al [1]; - XtSetArg (al [0], XmNset, &val->selected); - XtGetValues (widget, al, 1); - val->edited = True; - } -#ifdef LWLIB_DIALOGS_MOTIF - else if (class == xmTextWidgetClass) - { - if (val->value) - free (val->value); - val->value = XmTextGetString (widget); - val->edited = True; - } - else if (class == xmTextFieldWidgetClass) - { - if (val->value) - free (val->value); - val->value = XmTextFieldGetString (widget); - val->edited = True; - } -#endif - else if (class == xmRowColumnWidgetClass) - { - Boolean radiobox = 0; - { - Arg al [1]; - XtSetArg (al [0], XmNradioBehavior, &radiobox); - XtGetValues (widget, al, 1); - } - - if (radiobox) - { - CompositeWidget radio = (CompositeWidget)widget; - int i; - for (i = 0; i < radio->composite.num_children; i++) - { - int set = False; - Widget toggle = radio->composite.children [i]; - Arg al [1]; - - XtSetArg (al [0], XmNset, &set); - XtGetValues (toggle, al, 1); - if (set) - { - if (val->value) - free (val->value); - val->value = safe_strdup (XtName (toggle)); - } - } - val->edited = True; - } - } - else if (class == xmListWidgetClass) - { - int pos_cnt; - int* pos_list; - if (XmListGetSelectedPos (widget, &pos_list, &pos_cnt)) - { - int i; - widget_value* cur; - for (cur = val->contents, i = 0; cur; cur = cur->next) - if (cur->value) - { - int j; - cur->selected = False; - i += 1; - for (j = 0; j < pos_cnt; j++) - if (pos_list [j] == i) - { - cur->selected = True; - val->value = safe_strdup (cur->name); - } - } - val->edited = 1; - XtFree ((char *) pos_list); - } - } -#ifdef LWLIB_SCROLLBARS_MOTIF - else if (class == xmScrollBarWidgetClass) - { - /* This function is not used by the scrollbar. */ - return; - } -#endif -} - - -/* This function is for activating a button from a program. It's wrong because - we pass a NULL argument in the call_data which is not Motif compatible. - This is used from the XmNdefaultAction callback of the List widgets to - have a dble-click put down a dialog box like the button woudl do. - I could not find a way to do that with accelerators. - */ -static void -activate_button (Widget widget, XtPointer closure, XtPointer call_data) -{ - Widget button = (Widget)closure; - XtCallCallbacks (button, XmNactivateCallback, NULL); -} - -/* creation functions */ - -#ifdef LWLIB_DIALOGS_MOTIF - -/* dialogs */ - -#if (XmVersion >= 1002) -# define ARMANDACTIVATE_KLUDGE -# define DND_KLUDGE -#endif - -#ifdef ARMANDACTIVATE_KLUDGE - /* We want typing Return at a dialog box to select the default button; but - we're satisfied with having it select the leftmost button instead. - - In Motif 1.1.5 we could do this by putting this resource in the - app-defaults file: - - *dialog*button1.accelerators:#override\ - Return: ArmAndActivate()\n\ - KP_Enter: ArmAndActivate()\n\ - Ctrlm: ArmAndActivate()\n - - but that doesn't work with 1.2.1 and I don't understand why. However, - doing the equivalent C code does work, with the notable disadvantage that - the user can't override it. So that's what we do until we figure out - something better.... - */ -static char button_trans[] = "\ -Return: ArmAndActivate()\n\ -KP_Enter: ArmAndActivate()\n\ -Ctrlm: ArmAndActivate()\n"; - -#endif /* ARMANDACTIVATE_KLUDGE */ - - -#ifdef DND_KLUDGE - /* This is a kludge to disable drag-and-drop in dialog boxes. The symptom - was a segv down in libXm somewhere if you used the middle button on a - dialog box to begin a drag; when you released the button to make a drop - things would lose if you were not over the button where you started the - drag (canceling the operation). This was probably due to the fact that - the dialog boxes were not set up to handle a drag but were trying to do - so anyway for some reason. - - So we disable drag-and-drop in dialog boxes by turning off the binding for - Btn2Down which, by default, initiates a drag. Clearly this is a shitty - solution as it only works in default configurations, but... - */ -static char disable_dnd_trans[] = ": "; -#endif /* DND_KLUDGE */ - - -static Widget -make_dialog (char* name, Widget parent, Boolean pop_up_p, - CONST char* shell_title, CONST char* icon_name, - Boolean text_input_slot, Boolean radio_box, Boolean list, - int left_buttons, int right_buttons) -{ - Widget result; - Widget form; - Widget row; - Widget icon; - Widget icon_separator; - Widget message; - Widget value = 0; - Widget separator; - Widget button = 0; - Widget children [16]; /* for the final XtManageChildren */ - int n_children; - Arg al[64]; /* Arg List */ - int ac; /* Arg Count */ - int i; - -#ifdef DND_KLUDGE - XtTranslations dnd_override = XtParseTranslationTable (disable_dnd_trans); -# define DO_DND_KLUDGE(widget) XtOverrideTranslations ((widget), dnd_override) -#else /* ! DND_KLUDGE */ -# define DO_DND_KLUDGE(widget) -#endif /* ! DND_KLUDGE */ - - if (pop_up_p) - { - ac = 0; - XtSetArg(al[ac], XmNtitle, shell_title); ac++; - XtSetArg(al[ac], XtNallowShellResize, True); ac++; - XtSetArg(al[ac], XmNdeleteResponse, XmUNMAP); ac++; - result = XmCreateDialogShell (parent, "dialog", al, ac); - - XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; -/* XtSetArg(al[ac], XmNautoUnmanage, TRUE); ac++; */ /* ####is this ok? */ - XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; - form = XmCreateForm (result, (char *) shell_title, al, ac); - } - else - { - ac = 0; - XtSetArg(al[ac], XmNautoUnmanage, FALSE); ac++; - XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; - form = XmCreateForm (parent, (char *) shell_title, al, ac); - result = form; - } - - ac = 0; - XtSetArg(al[ac], XmNpacking, XmPACK_COLUMN); ac++; - XtSetArg(al[ac], XmNorientation, XmVERTICAL); ac++; - XtSetArg(al[ac], XmNnumColumns, left_buttons + right_buttons + 1); ac++; - XtSetArg(al[ac], XmNmarginWidth, 0); ac++; - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; - XtSetArg(al[ac], XmNspacing, 13); ac++; - XtSetArg(al[ac], XmNadjustLast, False); ac++; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; - XtSetArg(al[ac], XmNisAligned, True); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - row = XmCreateRowColumn (form, "row", al, ac); - - n_children = 0; - for (i = 0; i < left_buttons; i++) - { - char button_name [16]; - sprintf (button_name, "button%d", i + 1); - ac = 0; - if (i == 0) - { - XtSetArg(al[ac], XmNhighlightThickness, 1); ac++; - XtSetArg(al[ac], XmNshowAsDefault, TRUE); ac++; - } - XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; - children [n_children] = XmCreatePushButton (row, button_name, al, ac); - DO_DND_KLUDGE (children [n_children]); - - if (i == 0) - { - button = children [n_children]; - ac = 0; - XtSetArg(al[ac], XmNdefaultButton, button); ac++; - XtSetValues (row, al, ac); - -#ifdef ARMANDACTIVATE_KLUDGE /* See comment above */ - { - XtTranslations losers = XtParseTranslationTable (button_trans); - XtOverrideTranslations (button, losers); - XtFree ((char *) losers); - } -#endif /* ARMANDACTIVATE_KLUDGE */ - } - - n_children++; - } - - /* invisible seperator button */ - ac = 0; - XtSetArg (al[ac], XmNmappedWhenManaged, FALSE); ac++; - children [n_children] = XmCreateLabel (row, "separator_button", - al, ac); - DO_DND_KLUDGE (children [n_children]); - n_children++; - - for (i = 0; i < right_buttons; i++) - { - char button_name [16]; - sprintf (button_name, "button%d", left_buttons + i + 1); - ac = 0; - XtSetArg(al[ac], XmNnavigationType, XmTAB_GROUP); ac++; - children [n_children] = XmCreatePushButton (row, button_name, al, ac); - DO_DND_KLUDGE (children [n_children]); - if (! button) button = children [n_children]; - n_children++; - } - - XtManageChildren (children, n_children); - - ac = 0; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, row); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 0); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 0); ac++; - separator = XmCreateSeparator (form, "", al, ac); - - ac = 0; - XtSetArg(al[ac], XmNlabelType, XmPIXMAP); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNtopOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; - icon = XmCreateLabel (form, (char *) icon_name, al, ac); - DO_DND_KLUDGE (icon); - - ac = 0; - XtSetArg(al[ac], XmNmappedWhenManaged, FALSE); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNtopOffset, 6); ac++; - XtSetArg(al[ac], XmNtopWidget, icon); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 6); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_NONE); ac++; - icon_separator = XmCreateLabel (form, "", al, ac); - DO_DND_KLUDGE (icon_separator); - - if (text_input_slot) - { - ac = 0; - XtSetArg(al[ac], XmNcolumns, 50); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateTextField (form, "value", al, ac); - DO_DND_KLUDGE (value); - } - else if (radio_box) - { - Widget radio_butt; - ac = 0; - XtSetArg(al[ac], XmNmarginWidth, 0); ac++; - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; - XtSetArg(al[ac], XmNspacing, 13); ac++; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_CENTER); ac++; - XtSetArg(al[ac], XmNorientation, XmHORIZONTAL); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateRadioBox (form, "radiobutton1", al, ac); - ac = 0; - i = 0; - radio_butt = XmCreateToggleButtonGadget (value, "radio1", al, ac); - children [i++] = radio_butt; - radio_butt = XmCreateToggleButtonGadget (value, "radio2", al, ac); - children [i++] = radio_butt; - radio_butt = XmCreateToggleButtonGadget (value, "radio3", al, ac); - children [i++] = radio_butt; - XtManageChildren (children, i); - } - else if (list) - { - ac = 0; - XtSetArg(al[ac], XmNvisibleItemCount, 5); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_NONE); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - value = XmCreateScrolledList (form, "list", al, ac); - - /* this is the easiest way I found to have the dble click in the - list activate the default button */ - XtAddCallback (value, XmNdefaultActionCallback, activate_button, button); - } - - ac = 0; - XtSetArg(al[ac], XmNalignment, XmALIGNMENT_BEGINNING); ac++; - XtSetArg(al[ac], XmNtopAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNtopOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNbottomOffset, 13); ac++; - XtSetArg(al[ac], XmNbottomWidget, - text_input_slot || radio_box || list ? value : separator); ac++; - XtSetArg(al[ac], XmNleftAttachment, XmATTACH_WIDGET); ac++; - XtSetArg(al[ac], XmNleftOffset, 13); ac++; - XtSetArg(al[ac], XmNleftWidget, icon); ac++; - XtSetArg(al[ac], XmNrightAttachment, XmATTACH_FORM); ac++; - XtSetArg(al[ac], XmNrightOffset, 13); ac++; - message = XmCreateLabel (form, "message", al, ac); - DO_DND_KLUDGE (message); - - if (list) - XtManageChild (value); - - i = 0; - children [i] = row; i++; - children [i] = separator; i++; - if (text_input_slot || radio_box) - { - children [i] = value; i++; - } - children [i] = message; i++; - children [i] = icon; i++; - children [i] = icon_separator; i++; - XtManageChildren (children, i); - - if (text_input_slot || list) - { - XtInstallAccelerators (value, button); - XmProcessTraversal(value, XmTRAVERSE_CURRENT); - } - else - { - XtInstallAccelerators (form, button); - XmProcessTraversal(value, XmTRAVERSE_CURRENT); - } - -#ifdef DND_KLUDGE - XtFree ((char *) dnd_override); -#endif -#undef DO_DND_KLUDGE - - return result; -} - -static destroyed_instance* -find_matching_instance (widget_instance* instance) -{ - destroyed_instance* cur; - destroyed_instance* prev; - char* type = instance->info->type; - char* name = instance->info->name; - - for (prev = NULL, cur = all_destroyed_instances; - cur; - prev = cur, cur = cur->next) - { - if (!strcmp (cur->name, name) - && !strcmp (cur->type, type) - && cur->parent == instance->parent - && cur->pop_up_p == instance->pop_up_p) - { - if (prev) - prev->next = cur->next; - else - all_destroyed_instances = cur->next; - return cur; - } - /* do some cleanup */ - else if (!cur->widget) - { - if (prev) - prev->next = cur->next; - else - all_destroyed_instances = cur->next; - free_destroyed_instance (cur); - cur = prev ? prev : all_destroyed_instances; - } - } - return NULL; -} - -static void -mark_dead_instance_destroyed (Widget widget, XtPointer closure, - XtPointer call_data) -{ - destroyed_instance* instance = (destroyed_instance*)closure; - instance->widget = NULL; -} - -static void -recenter_widget (Widget widget) -{ - Widget parent = XtParent (widget); - Screen* screen = XtScreen (widget); - Dimension screen_width = WidthOfScreen (screen); - Dimension screen_height = HeightOfScreen (screen); - Dimension parent_width = 0; - Dimension parent_height = 0; - Dimension child_width = 0; - Dimension child_height = 0; - Position x; - Position y; - Arg al [2]; - - XtSetArg (al [0], XtNwidth, &child_width); - XtSetArg (al [1], XtNheight, &child_height); - XtGetValues (widget, al, 2); - - XtSetArg (al [0], XtNwidth, &parent_width); - XtSetArg (al [1], XtNheight, &parent_height); - XtGetValues (parent, al, 2); - - x = (Position) ((parent_width - child_width) / 2); - y = (Position) ((parent_height - child_height) / 2); - - XtTranslateCoords (parent, x, y, &x, &y); - - if ((Dimension) (x + child_width) > screen_width) - x = screen_width - child_width; - if (x < 0) - x = 0; - - if ((Dimension) (y + child_height) > screen_height) - y = screen_height - child_height; - if (y < 0) - y = 0; - - XtSetArg (al [0], XtNx, x); - XtSetArg (al [1], XtNy, y); - XtSetValues (widget, al, 2); -} - -static Widget -recycle_instance (destroyed_instance* instance) -{ - Widget widget = instance->widget; - - /* widget is NULL if the parent was destroyed. */ - if (widget) - { - Widget focus; - Widget separator; - - /* Remove the destroy callback as the instance is not in the list - anymore */ - XtRemoveCallback (instance->parent, XtNdestroyCallback, - mark_dead_instance_destroyed, - (XtPointer)instance); - - /* Give the focus to the initial item */ - focus = XtNameToWidget (widget, "*value"); - if (!focus) - focus = XtNameToWidget (widget, "*button1"); - if (focus) - XmProcessTraversal(focus, XmTRAVERSE_CURRENT); - - /* shrink the separator label back to their original size */ - separator = XtNameToWidget (widget, "*separator_button"); - if (separator) - { - Arg al [2]; - XtSetArg (al [0], XtNwidth, 5); - XtSetArg (al [1], XtNheight, 5); - XtSetValues (separator, al, 2); - } - - /* Center the dialog in its parent */ - recenter_widget (widget); - } - free_destroyed_instance (instance); - return widget; -} - -Widget -xm_create_dialog (widget_instance* instance) -{ - char* name = instance->info->type; - Widget parent = instance->parent; - Widget widget; - Boolean pop_up_p = instance->pop_up_p; - CONST char* shell_name = 0; - CONST char* icon_name = 0; - Boolean text_input_slot = False; - Boolean radio_box = False; - Boolean list = False; - int total_buttons; - int left_buttons = 0; - int right_buttons = 1; - destroyed_instance* dead_one; - - /* try to find a widget to recycle */ - dead_one = find_matching_instance (instance); - if (dead_one) - { - Widget recycled_widget = recycle_instance (dead_one); - if (recycled_widget) - return recycled_widget; - } - - switch (name [0]){ - case 'E': case 'e': - icon_name = "dbox-error"; - shell_name = "Error"; - break; - - case 'I': case 'i': - icon_name = "dbox-info"; - shell_name = "Information"; - break; - - case 'L': case 'l': - list = True; - icon_name = "dbox-question"; - shell_name = "Prompt"; - break; - - case 'P': case 'p': - text_input_slot = True; - icon_name = "dbox-question"; - shell_name = "Prompt"; - break; - - case 'Q': case 'q': - icon_name = "dbox-question"; - shell_name = "Question"; - break; - } - - total_buttons = name [1] - '0'; - - if (name [3] == 'T' || name [3] == 't') - { - text_input_slot = False; - radio_box = True; - } - else if (name [3]) - right_buttons = name [4] - '0'; - - left_buttons = total_buttons - right_buttons; - - widget = make_dialog (name, parent, pop_up_p, - shell_name, icon_name, text_input_slot, radio_box, - list, left_buttons, right_buttons); - - XtAddCallback (widget, XmNpopdownCallback, xm_nosel_callback, - (XtPointer) instance); - return widget; -} - -#endif /* LWLIB_DIALOGS_MOTIF */ - -#ifdef LWLIB_MENUBARS_MOTIF -static Widget -make_menubar (widget_instance* instance) -{ - Arg al[10]; - int ac = 0; - - XtSetArg(al[ac], XmNmarginHeight, 0); ac++; - XtSetArg(al[ac], XmNshadowThickness, 3); ac++; - - return XmCreateMenuBar (instance->parent, instance->info->name, al, ac); -} - -static void -remove_grabs (Widget shell, XtPointer closure, XtPointer call_data) -{ - Widget menu = (Widget) closure; - XmRemoveFromPostFromList (menu, XtParent (XtParent ((Widget) menu))); -} - -static Widget -make_popup_menu (widget_instance* instance) -{ - Widget parent = instance->parent; - Window parent_window = parent->core.window; - Widget result; - - /* sets the parent window to 0 to fool Motif into not generating a grab */ - parent->core.window = 0; - result = XmCreatePopupMenu (parent, instance->info->name, NULL, 0); - XtAddCallback (XtParent (result), XmNpopdownCallback, remove_grabs, - (XtPointer)result); - parent->core.window = parent_window; - return result; -} -#endif /* LWLIB_MENUBARS_MOTIF */ - -#ifdef LWLIB_SCROLLBARS_MOTIF -static Widget -make_scrollbar (widget_instance *instance, int vertical) -{ - Arg al[20]; - int ac = 0; - static XtCallbackRec callbacks[2] = - { {xm_scrollbar_callback, NULL}, {NULL, NULL} }; - - callbacks[0].closure = (XtPointer) instance; - - XtSetArg (al[ac], XmNminimum, 1); ac++; - XtSetArg (al[ac], XmNmaximum, INT_MAX); ac++; - XtSetArg (al[ac], XmNincrement, 1); ac++; - XtSetArg (al[ac], XmNpageIncrement, 1); ac++; - XtSetArg (al[ac], XmNborderWidth, 0); ac++; - XtSetArg (al[ac], XmNorientation, vertical ? XmVERTICAL : XmHORIZONTAL); ac++; - - XtSetArg (al[ac], XmNdecrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNdragCallback, callbacks); ac++; - XtSetArg (al[ac], XmNincrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNpageDecrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNpageIncrementCallback, callbacks); ac++; - XtSetArg (al[ac], XmNtoBottomCallback, callbacks); ac++; - XtSetArg (al[ac], XmNtoTopCallback, callbacks); ac++; - XtSetArg (al[ac], XmNvalueChangedCallback, callbacks); ac++; - - return XmCreateScrollBar (instance->parent, instance->info->name, al, ac); -} - -static Widget -make_vertical_scrollbar (widget_instance *instance) -{ - return make_scrollbar (instance, 1); -} - -static Widget -make_horizontal_scrollbar (widget_instance *instance) -{ - return make_scrollbar (instance, 0); -} - -#endif /* LWLIB_SCROLLBARS_MOTIF */ - - /* Table of functions to create widgets */ - -widget_creation_entry -xm_creation_table [] = -{ -#ifdef LWLIB_MENUBARS_MOTIF - {"menubar", make_menubar}, - {"popup", make_popup_menu}, -#endif -#ifdef LWLIB_SCROLLBARS_MOTIF - {"vertical-scrollbar", make_vertical_scrollbar}, - {"horizontal-scrollbar", make_horizontal_scrollbar}, -#endif - {NULL, NULL} -}; - - /* Destruction of instances */ -void -xm_destroy_instance (widget_instance* instance) -{ -#ifdef LWLIB_DIALOGS_MOTIF - /* It appears that this is used only for dialog boxes. */ - Widget widget = instance->widget; - /* recycle the dialog boxes */ - /* Disable the recycling until we can find a way to have the dialog box - get reasonable layout after we modify its contents. */ - if (0 - && XtClass (widget) == xmDialogShellWidgetClass) - { - destroyed_instance* dead_instance = - make_destroyed_instance (instance->info->name, - instance->info->type, - instance->widget, - instance->parent, - instance->pop_up_p); - dead_instance->next = all_destroyed_instances; - all_destroyed_instances = dead_instance; - XtUnmanageChild (first_child (instance->widget)); - XFlush (XtDisplay (instance->widget)); - XtAddCallback (instance->parent, XtNdestroyCallback, - mark_dead_instance_destroyed, (XtPointer)dead_instance); - } - else - { - /* This might not be necessary now that the nosel is attached to - popdown instead of destroy, but it can't hurt. */ - XtRemoveCallback (instance->widget, XtNdestroyCallback, - xm_nosel_callback, (XtPointer)instance); - - XtDestroyWidget (instance->widget); - } -#endif /* LWLIB_DIALOGS_MOTIF */ -} - - /* popup utility */ -#ifdef LWLIB_MENUBARS_MOTIF - -void -xm_popup_menu (Widget widget, XEvent *event) -{ - if (event->type == ButtonPress || event->type == ButtonRelease) - { - /* This is so totally ridiculous: there's NO WAY to tell Motif - that *any* button can select a menu item. Only one button - can have that honor. - */ - char *trans = 0; - if (event->xbutton.state & Button5Mask) trans = ""; - else if (event->xbutton.state & Button4Mask) trans = ""; - else if (event->xbutton.state & Button3Mask) trans = ""; - else if (event->xbutton.state & Button2Mask) trans = ""; - else if (event->xbutton.state & Button1Mask) trans = ""; - if (trans) - { - Arg al [1]; - XtSetArg (al [0], XmNmenuPost, trans); - XtSetValues (widget, al, 1); - } - XmMenuPosition (widget, (XButtonPressedEvent *) event); - } - XtManageChild (widget); -} - -#endif - -#ifdef LWLIB_DIALOGS_MOTIF - -static void -set_min_dialog_size (Widget w) -{ - short width; - short height; - Arg al [2]; - - XtSetArg (al [0], XmNwidth, &width); - XtSetArg (al [1], XmNheight, &height); - XtGetValues (w, al, 2); - - XtSetArg (al [0], XmNminWidth, width); - XtSetArg (al [1], XmNminHeight, height); - XtSetValues (w, al, 2); -} - -#endif - -void -xm_pop_instance (widget_instance* instance, Boolean up) -{ - Widget widget = instance->widget; - -#ifdef LWLIB_DIALOGS_MOTIF - if (XtClass (widget) == xmDialogShellWidgetClass) - { - Widget widget_to_manage = first_child (widget); - if (up) - { - XtManageChild (widget_to_manage); - set_min_dialog_size (widget); - XmProcessTraversal(widget, XmTRAVERSE_CURRENT); - } - else - XtUnmanageChild (widget_to_manage); - } - else -#endif - { - if (up) - XtManageChild (widget); - else - XtUnmanageChild (widget); - } -} - - -/* motif callback */ - -enum do_call_type { pre_activate, selection, no_selection, post_activate }; - -static void -do_call (Widget widget, XtPointer closure, enum do_call_type type) -{ - XtPointer user_data; - widget_instance* instance = (widget_instance*)closure; - Widget instance_widget; - LWLIB_ID id; - Arg al [1]; - - if (!instance) - return; - if (widget->core.being_destroyed) - return; - - instance_widget = instance->widget; - if (!instance_widget) - return; - - id = instance->info->id; - user_data = NULL; - XtSetArg(al [0], XmNuserData, &user_data); - XtGetValues (widget, al, 1); - switch (type) - { - case pre_activate: - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, user_data); - break; - case selection: - if (instance->info->selection_cb) - instance->info->selection_cb (widget, id, user_data); - break; - case no_selection: - if (instance->info->selection_cb) - instance->info->selection_cb (widget, id, (XtPointer) -1); - break; - case post_activate: - if (instance->info->post_activate_cb) - instance->info->post_activate_cb (widget, id, user_data); - break; - default: - abort (); - } -} - -/* Like lw_internal_update_other_instances except that it does not do - anything if its shell parent is not managed. This is to protect - lw_internal_update_other_instances to dereference freed memory - if the widget was ``destroyed'' by caching it in the all_destroyed_instances - list */ -static void -xm_internal_update_other_instances (Widget widget, XtPointer closure, - XtPointer call_data) -{ - Widget parent; - for (parent = widget; parent; parent = XtParent (parent)) - if (XtIsShell (parent)) - break; - else if (!XtIsManaged (parent)) - return; - lw_internal_update_other_instances (widget, closure, call_data); -} - -static void -xm_generic_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ -#if (defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_DIALOGS_MOTIF)) - /* We want the selected status to change only when we decide it - should change. Yuck but correct. */ - if (XtClass (widget) == xmToggleButtonWidgetClass - || XtClass (widget) == xmToggleButtonGadgetClass) - { - Boolean check; - Arg al [1]; - - XtSetArg (al [0], XmNset, &check); - XtGetValues (widget, al, 1); - - XtSetArg (al [0], XmNset, !check); - XtSetValues (widget, al, 1); - } -#endif - lw_internal_update_other_instances (widget, closure, call_data); - do_call (widget, closure, selection); -} - -#ifdef LWLIB_DIALOGS_MOTIF - -static void -xm_nosel_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - /* This callback is only called when a dialog box is dismissed with the wm's - destroy button (WM_DELETE_WINDOW.) We want the dialog box to be destroyed - in that case, not just unmapped, so that it releases its keyboard grabs. - But there are problems with running our callbacks while the widget is in - the process of being destroyed, so we set XmNdeleteResponse to XmUNMAP - instead of XmDESTROY and then destroy it ourself after having run the - callback. - */ - do_call (widget, closure, no_selection); - XtDestroyWidget (widget); -} - -#endif - -#ifdef LWLIB_MENUBARS_MOTIF - -static void -xm_pull_down_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ -#if 0 - if (call_data) - { - /* new behavior for incremental menu construction */ - - } - else -#endif - do_call (widget, closure, pre_activate); -} - -#if 0 -static void -xm_pop_down_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - do_call (widget, closure, post_activate); -} -#endif /* 0 */ - -#endif /* LWLIB_MENUBARS_MOTIF */ - -#ifdef LWLIB_SCROLLBARS_MOTIF -static void -xm_scrollbar_callback (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance *) closure; - LWLIB_ID id; - XmScrollBarCallbackStruct *data = - (XmScrollBarCallbackStruct *) call_data; - scroll_event event_data; - scrollbar_values *val = - (scrollbar_values *) instance->info->val->scrollbar_data; - double percent; - - if (!instance || widget->core.being_destroyed) - return; - - id = instance->info->id; - - percent = (double) (data->value - 1) / (double) (INT_MAX - 1); - event_data.slider_value = - (int) (percent * (double) (val->maximum - val->minimum)) + val->minimum; - - if (event_data.slider_value > (val->maximum - val->slider_size)) - event_data.slider_value = val->maximum - val->slider_size; - else if (event_data.slider_value < 1) - event_data.slider_value = 1; - - if (data->event) - { - switch (data->event->xany.type) - { - case KeyPress: - case KeyRelease: - event_data.time = data->event->xkey.time; - break; - case ButtonPress: - case ButtonRelease: - event_data.time = data->event->xbutton.time; - break; - case MotionNotify: - event_data.time = data->event->xmotion.time; - break; - case EnterNotify: - case LeaveNotify: - event_data.time = data->event->xcrossing.time; - break; - default: - event_data.time = 0; - break; - } - } - else - event_data.time = 0; - - switch (data->reason) - { - case XmCR_DECREMENT: - event_data.action = SCROLLBAR_LINE_UP; - break; - case XmCR_INCREMENT: - event_data.action = SCROLLBAR_LINE_DOWN; - break; - case XmCR_PAGE_DECREMENT: - event_data.action = SCROLLBAR_PAGE_UP; - break; - case XmCR_PAGE_INCREMENT: - event_data.action = SCROLLBAR_PAGE_DOWN; - break; - case XmCR_TO_TOP: - event_data.action = SCROLLBAR_TOP; - break; - case XmCR_TO_BOTTOM: - event_data.action = SCROLLBAR_BOTTOM; - break; - case XmCR_DRAG: - event_data.action = SCROLLBAR_DRAG; - break; - case XmCR_VALUE_CHANGED: - event_data.action = SCROLLBAR_CHANGE; - break; - default: - event_data.action = SCROLLBAR_CHANGE; - break; - } - - if (instance->info->pre_activate_cb) - instance->info->pre_activate_cb (widget, id, (XtPointer) &event_data); -} -#endif /* LWLIB_SCROLLBARS_MOTIF */ - - -/* set the keyboard focus */ -void -xm_set_keyboard_focus (Widget parent, Widget w) -{ - XmProcessTraversal (w, XmTRAVERSE_CURRENT); - /* At some point we believed that it was necessary to use XtSetKeyboardFocus - instead of XmProcessTraversal when using Motif >= 1.2.1, but that's bogus. - Presumably the problem was elsewhere, and is now gone... - */ -} diff --git a/lwlib/lwlib-Xm.h b/lwlib/lwlib-Xm.h deleted file mode 100644 index 9088838..0000000 --- a/lwlib/lwlib-Xm.h +++ /dev/null @@ -1,36 +0,0 @@ -#ifndef LWLIB_XM_H -#define LWLIB_XM_H - -#include "lwlib-internal.h" - -extern widget_creation_entry xm_creation_table []; - -Widget -xm_create_dialog (widget_instance* instance); - -Boolean -lw_motif_widget_p (Widget widget); - -void -xm_update_one_widget (widget_instance* instance, Widget widget, - widget_value* val, Boolean deep_p); - -void -xm_update_one_value (widget_instance* instance, Widget widget, - widget_value* val); - -void -xm_destroy_instance (widget_instance* instance); - -void -xm_set_keyboard_focus (Widget parent, Widget w); - -void -xm_popup_menu (Widget widget, XEvent *event); - -void -xm_pop_instance (widget_instance* instance, Boolean up); - -extern Widget first_child (Widget); /* garbage */ - -#endif /* LWLIB_XM_H */ diff --git a/lwlib/lwlib-config.c b/lwlib/lwlib-config.c deleted file mode 100644 index f2c6edf..0000000 --- a/lwlib/lwlib-config.c +++ /dev/null @@ -1,90 +0,0 @@ -/* Flags indicating how lwlib was compiled. - Copyright (C) 1994 Lucid, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -/* This is a kludge to make sure emacs can only link against a version of - lwlib that was compiled in the right way. Emacs references symbols which - correspond to the way it thinks lwlib was compiled, and if lwlib wasn't - compiled in that way, then somewhat meaningful link errors will result. - The alternatives to this range from obscure link errors, to obscure - runtime errors that look a lot like bugs. */ - -#include -#include "lwlib.h" - -#include /* to get XlibSpecificationRelease */ -#ifdef NEED_MOTIF -#include /* to get XmVersion */ -#endif - -#if (XlibSpecificationRelease == 4) -int lwlib_uses_x11r4; -#elif (XlibSpecificationRelease == 5) -int lwlib_uses_x11r5; -#elif (XlibSpecificationRelease == 6) -int lwlib_uses_x11r6; -#else -int lwlib_uses_unknown_x11; -#endif - -#ifdef NEED_MOTIF -int lwlib_uses_motif; -#else -int lwlib_does_not_use_motif; -#endif - -#if (XmVersion >= 1002) -int lwlib_uses_motif_1_2; -#else -int lwlib_does_not_use_motif_1_2; -#endif - -#ifdef LWLIB_MENUBARS_LUCID -int lwlib_menubars_lucid; -#else -# ifdef LWLIB_MENUBARS_MOTIF -int lwlib_menubars_motif; -# else -int lwlib_does_not_support_menubars; -# endif -#endif - -#ifdef LWLIB_SCROLLBARS_LUCID -int lwlib_scrollbars_lucid; -#else -# ifdef LWLIB_SCROLLBARS_MOTIF -int lwlib_scrollbars_motif; -# else -# ifdef LWLIB_SCROLLBARS_ATHENA -int lwlib_scrollbars_athena; -# else -int lwlib_does_not_support_scrollbars; -# endif -# endif -#endif - -#ifdef LWLIB_DIALOGS_MOTIF -int lwlib_dialogs_motif; -#else -# ifdef LWLIB_DIALOGS_ATHENA -int lwlib_dialogs_athena; -# else -int lwlib_does_not_support_dialogs; -# endif -#endif diff --git a/lwlib/lwlib-internal.h b/lwlib/lwlib-internal.h deleted file mode 100644 index 1c6ffd9..0000000 --- a/lwlib/lwlib-internal.h +++ /dev/null @@ -1,59 +0,0 @@ -#ifndef LWLIB_INTERNAL_H -#define LWLIB_INTERNAL_H - -#include "lwlib.h" - -/* This represents a single widget within a widget tree. All the - widgets in a widget tree are chained through the `next' field. - `info' is a back pointer to the widget tree. */ - -typedef struct _widget_instance -{ - Widget widget; - Widget parent; - Boolean pop_up_p; - struct _widget_info* info; - struct _widget_instance* next; -} widget_instance; - -/* This represents a single widget tree, such as a single menubar. - The global variable `all_widget_info' lists all widget trees, - chained through the `next' field of this structure. */ - -typedef struct _widget_info -{ - char* type; - char* name; - LWLIB_ID id; - widget_value* val; - Boolean busy; - lw_callback pre_activate_cb; - lw_callback selection_cb; - lw_callback post_activate_cb; - struct _widget_instance* instances; - struct _widget_info* next; -} widget_info; - -typedef Widget -(*widget_creation_function) (widget_instance* instance); - -typedef struct _widget_creation_entry -{ - CONST char* type; - widget_creation_function function; -} widget_creation_entry; - -/* update all other instances of a widget. Can be used in a callback when - a wiget has been used by the user */ -void -lw_internal_update_other_instances (Widget widget, XtPointer closure, - XtPointer call_data); - -/* get the widget_value for a widget in a given instance */ -widget_value* -lw_get_widget_value_for_widget (widget_instance* instance, Widget w); - -widget_info *lw_get_widget_info (LWLIB_ID id); - -#endif /* LWLIB_INTERNAL_H */ - diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c deleted file mode 100644 index 0df97a6..0000000 --- a/lwlib/lwlib-utils.c +++ /dev/null @@ -1,166 +0,0 @@ -/* Defines some widget utility functions. - Copyright (C) 1992 Lucid, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can 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. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -#include -#include -#include -#include "lwlib-utils.h" - -/* Redisplay the contents of the widget, without first clearing it. */ -void -XtNoClearRefreshWidget (Widget widget) -{ - XEvent event; - XExposeEvent* ev = &event.xexpose; - - ev->type = Expose; - ev->serial = 0; - ev->send_event = 0; - ev->display = XtDisplay (widget); - ev->window = XtWindow (widget); - ev->x = 0; - ev->y = 0; - ev->width = widget->core.width; - ev->height = widget->core.height; - ev->count = 0; - - (*widget->core.widget_class->core_class.expose) - (widget, &event, (Region)NULL); -} - - -/* - * Apply a function to all the subwidgets of a given widget recursively. -*/ -void -XtApplyToWidgets (Widget w, XtApplyToWidgetsProc proc, XtPointer arg) -{ - if (XtIsComposite (w)) - { - CompositeWidget cw = (CompositeWidget) w; - /* We have to copy the children list before mapping over it, because - the procedure might add/delete elements, which would lose badly. */ - int nkids = cw->composite.num_children; - Widget *kids = (Widget *) malloc (sizeof (Widget) * nkids); - int i; - memcpy (kids, cw->composite.children, sizeof (Widget) * nkids); - for (i = 0; i < nkids; i++) -/* This prevent us from using gadgets, why is it here? */ -/* if (XtIsWidget (kids [i])) */ - { - /* do the kiddies first in case we're destroying */ - XtApplyToWidgets (kids [i], proc, arg); - proc (kids [i], arg); - } - free (kids); - } -} - - -/* - * Apply a function to all the subwidgets of a given widget recursively. - * Stop as soon as the function returns non NULL and returns this as a value. - */ -void * -XtApplyUntilToWidgets (Widget w, XtApplyUntilToWidgetsProc proc, XtPointer arg) -{ - void* result; - if (XtIsComposite (w)) - { - CompositeWidget cw = (CompositeWidget)w; - int i; - for (i = 0; i < cw->composite.num_children; i++) - if (XtIsWidget (cw->composite.children [i])){ - result = proc (cw->composite.children [i], arg); - if (result) - return result; - result = XtApplyUntilToWidgets (cw->composite.children [i], proc, - arg); - if (result) - return result; - } - } - return NULL; -} - - -/* - * Returns a copy of the list of all children of a composite widget - */ -Widget * -XtCompositeChildren (Widget widget, unsigned int* number) -{ - CompositeWidget cw = (CompositeWidget)widget; - Widget* result; - int n; - int i; - - if (!XtIsComposite (widget)) - { - *number = 0; - return NULL; - } - n = cw->composite.num_children; - result = (Widget*)XtMalloc (n * sizeof (Widget)); - *number = n; - for (i = 0; i < n; i++) - result [i] = cw->composite.children [i]; - return result; -} - -Boolean -XtWidgetBeingDestroyedP (Widget widget) -{ - return widget->core.being_destroyed; -} - -void -XtSafelyDestroyWidget (Widget widget) -{ -#if 0 - - /* this requires IntrinsicI.h (actually, InitialI.h) */ - - XtAppContext app = XtWidgetToApplicationContext(widget); - - if (app->dispatch_level == 0) - { - app->dispatch_level = 1; - XtDestroyWidget (widget); - /* generates an event so that the event loop will be called */ - XChangeProperty (XtDisplay (widget), XtWindow (widget), - XA_STRING, XA_STRING, 32, PropModeAppend, NULL, 0); - app->dispatch_level = 0; - } - else - XtDestroyWidget (widget); - -#else - abort (); -#endif -} diff --git a/lwlib/lwlib-utils.h b/lwlib/lwlib-utils.h deleted file mode 100644 index cfba632..0000000 --- a/lwlib/lwlib-utils.h +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef _LWLIB_UTILS_H_ -#define _LWLIB_UTILS_H_ - -void XtNoClearRefreshWidget (Widget); - -typedef void (*XtApplyToWidgetsProc) (Widget, XtPointer); -typedef void* (*XtApplyUntilToWidgetsProc) (Widget, XtPointer); - -void XtApplyToWidgets (Widget, XtApplyToWidgetsProc, XtPointer); -void *XtApplyUntilToWidgets (Widget, XtApplyUntilToWidgetsProc, XtPointer); - -Widget *XtCompositeChildren (Widget, unsigned int *); - -/* returns True is the widget is being destroyed, False otherwise */ -Boolean -XtWidgetBeingDestroyedP (Widget widget); - -void XtSafelyDestroyWidget (Widget); - -#ifdef USE_DEBUG_MALLOC -#include -#endif -#endif /* _LWLIB_UTILS_H_ */ diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c deleted file mode 100644 index 20c160f..0000000 --- a/lwlib/lwlib.c +++ /dev/null @@ -1,1302 +0,0 @@ -/* A general interface to the widgets of different toolkits. - Copyright (C) 1992, 1993, 1994 Lucid, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -#ifdef NeXT -#undef __STRICT_BSD__ /* ick */ -#endif - -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#include -#include "lwlib-internal.h" -#include "lwlib-utils.h" - -#ifdef NEED_LUCID -#include "lwlib-Xlw.h" -#endif -#ifdef NEED_MOTIF -#include "lwlib-Xm.h" -#endif -#ifdef NEED_ATHENA -#include "lwlib-Xaw.h" -#endif - -/* #### Does a check need to be put back in here to make sure we have - sufficient defines to function properly or are the checks in the - makefile sufficient? */ - -/* List of all widgets managed by the library. Note that each "widget" - listed here may actually be a tree of widgets; for example, a - single entry here might represent a single menubar or popup menu, - each of which might be implemented with a tree of widgets. - */ -static widget_info *all_widget_info = NULL; - -/* boolean flag indicating that the menubar is active */ -int lw_menu_active = 0; - -/* X11 menubar widget */ -Widget lw_menubar_widget = NULL; - -/* whether the last menu operation was a keyboard accelerator */ -int lw_menu_accelerate = False; - - -/* Forward declarations */ -static void -instantiate_widget_instance (widget_instance *instance); - - -/* utility functions for widget_instance and widget_info */ -static char * -safe_strdup (CONST char *s) -{ - char *result; - if (! s) return 0; - result = (char *) malloc (strlen (s) + 1); - if (! result) - return 0; - strcpy (result, s); - return result; -} - -static void -safe_free_str (char *s) -{ - if (s) free (s); -} - -static widget_value *widget_value_free_list = 0; - -widget_value * -malloc_widget_value (void) -{ - widget_value *wv; - if (widget_value_free_list) - { - wv = widget_value_free_list; - widget_value_free_list = wv->free_list; - wv->free_list = 0; - } - else - { - wv = (widget_value *) malloc (sizeof (widget_value)); - } - if (wv) - { - memset (wv, 0, sizeof (widget_value)); - } - return wv; -} - -/* this is analogous to free(). It frees only what was allocated - by malloc_widget_value(), and no substructures. - */ -void -free_widget_value (widget_value *wv) -{ - if (wv->free_list) - abort (); - wv->free_list = widget_value_free_list; - widget_value_free_list = wv; -} - -static void free_widget_value_tree (widget_value *wv); - -static void -free_widget_value_contents (widget_value *wv) -{ - if (wv->name) free (wv->name); - if (wv->value) free (wv->value); - if (wv->key) free (wv->key); - - /* #### - all of this 0xDEADBEEF stuff should be unnecessary - in production code... it should be conditionalized. */ - wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; - - if (wv->toolkit_data && wv->free_toolkit_data) - { - XtFree ((char *) wv->toolkit_data); - wv->toolkit_data = (void *) 0xDEADBEEF; - } -#ifdef NEED_SCROLLBARS - if (wv->scrollbar_data) - { - free (wv->scrollbar_data); - wv->scrollbar_data = NULL; - } -#endif - if (wv->contents && (wv->contents != (widget_value*)1)) - { - free_widget_value_tree (wv->contents); - wv->contents = (widget_value *) 0xDEADBEEF; - } - if (wv->next) - { - free_widget_value_tree (wv->next); - wv->next = (widget_value *) 0xDEADBEEF; - } -} - -static void -free_widget_value_tree (widget_value *wv) -{ - if (!wv) - return; - - free_widget_value_contents (wv); - free_widget_value (wv); -} - -#ifdef NEED_SCROLLBARS - -static void -copy_scrollbar_values (widget_value *val, widget_value *copy) -{ - if (!copy->scrollbar_data) - copy->scrollbar_data = - (scrollbar_values *) malloc (sizeof (scrollbar_values)); - - if (val->scrollbar_data) - *copy->scrollbar_data = *val->scrollbar_data; - else - memset (copy->scrollbar_data, 0, sizeof (scrollbar_values)); -} - -/* - * Return true if old->scrollbar_data were not equivalent - * to new->scrollbar_data. - */ -static Boolean -merge_scrollbar_values (widget_value *old, widget_value *new) -{ - Boolean changed = False; - - if (new->scrollbar_data && !old->scrollbar_data) - { - copy_scrollbar_values (new, old); - changed = True; - } - else if (!new->scrollbar_data && old->scrollbar_data) - { - free (old->scrollbar_data); - old->scrollbar_data = NULL; - } - else if (new->scrollbar_data && old->scrollbar_data) - { - scrollbar_values *old_sb = old->scrollbar_data; - scrollbar_values *new_sb = new->scrollbar_data; - - if ((old_sb->line_increment != new_sb->line_increment) || - (old_sb->page_increment != new_sb->page_increment) || - (old_sb->minimum != new_sb->minimum) || - (old_sb->maximum != new_sb->maximum) || - (old_sb->slider_size != new_sb->slider_size) || - (old_sb->slider_position != new_sb->slider_position) || - (old_sb->scrollbar_width != new_sb->scrollbar_width) || - (old_sb->scrollbar_height != new_sb->scrollbar_height) || - (old_sb->scrollbar_x != new_sb->scrollbar_x) || - (old_sb->scrollbar_y != new_sb->scrollbar_y)) - changed = True; - - *old_sb = *new_sb; - } - - return changed; -} - -#endif /* NEED_SCROLLBARS */ - -/* Make a complete copy of a widget_value tree. Store CHANGE into - the widget_value tree's `change' field. */ - -static widget_value * -copy_widget_value_tree (widget_value *val, change_type change) -{ - widget_value *copy; - - if (!val) - return NULL; - if (val == (widget_value *) 1) - return val; - - copy = malloc_widget_value (); - if (copy) - { - /* #### - don't seg fault *here* if out of memory. Menus will be - truncated inexplicably. */ - copy->type = val->type; - copy->name = safe_strdup (val->name); - copy->value = safe_strdup (val->value); - copy->key = safe_strdup (val->key); - copy->accel = val->accel; - copy->enabled = val->enabled; - copy->selected = val->selected; - copy->edited = False; - copy->change = change; - copy->contents = copy_widget_value_tree (val->contents, change); - copy->call_data = val->call_data; - copy->next = copy_widget_value_tree (val->next, change); - copy->toolkit_data = NULL; - copy->free_toolkit_data = False; -#ifdef NEED_SCROLLBARS - copy_scrollbar_values (val, copy); -#endif - } - return copy; -} - -/* This function is used to implement incremental menu construction. */ - -widget_value * -replace_widget_value_tree (widget_value *node, widget_value *newtree) -{ - widget_value *copy; - - if (!node || !newtree) - abort (); - - copy = copy_widget_value_tree (newtree, STRUCTURAL_CHANGE); - - free_widget_value_contents (node); - *node = *copy; - free_widget_value (copy); /* free the node, but not its contents. */ - return node; -} - -static widget_info * -allocate_widget_info (CONST char *type, CONST char *name, - LWLIB_ID id, widget_value *val, - lw_callback pre_activate_cb, lw_callback selection_cb, - lw_callback post_activate_cb) -{ - widget_info *info = (widget_info *) malloc (sizeof (widget_info)); - info->type = safe_strdup (type); - info->name = safe_strdup (name); - info->id = id; - info->val = copy_widget_value_tree (val, STRUCTURAL_CHANGE); - info->busy = False; - info->pre_activate_cb = pre_activate_cb; - info->selection_cb = selection_cb; - info->post_activate_cb = post_activate_cb; - info->instances = NULL; - - info->next = all_widget_info; - all_widget_info = info; - - return info; -} - -static void -free_widget_info (widget_info *info) -{ - safe_free_str (info->type); - safe_free_str (info->name); - free_widget_value_tree (info->val); - memset ((void*)info, 0xDEADBEEF, sizeof (widget_info)); - free (info); -} - -static void -mark_widget_destroyed (Widget widget, XtPointer closure, XtPointer call_data) -{ - widget_instance *instance = (widget_instance*)closure; - - /* be very conservative */ - if (instance->widget == widget) - instance->widget = NULL; -} - -static widget_instance * -allocate_widget_instance (widget_info *info, Widget parent, Boolean pop_up_p) -{ - widget_instance *instance = - (widget_instance *) malloc (sizeof (widget_instance)); - instance->parent = parent; - instance->pop_up_p = pop_up_p; - instance->info = info; - instance->next = info->instances; - info->instances = instance; - - instantiate_widget_instance (instance); - - XtAddCallback (instance->widget, XtNdestroyCallback, - mark_widget_destroyed, (XtPointer)instance); - return instance; -} - -static void -free_widget_instance (widget_instance *instance) -{ - memset ((void *) instance, 0xDEADBEEF, sizeof (widget_instance)); - free (instance); -} - -static widget_info * -get_widget_info (LWLIB_ID id, Boolean remove_p) -{ - widget_info *info; - widget_info *prev; - for (prev = NULL, info = all_widget_info; - info; - prev = info, info = info->next) - if (info->id == id) - { - if (remove_p) - { - if (prev) - prev->next = info->next; - else - all_widget_info = info->next; - } - return info; - } - return NULL; -} - -/* Internal function used by the library dependent implementation to get the - widget_value for a given widget in an instance */ -widget_info * -lw_get_widget_info (LWLIB_ID id) -{ - return get_widget_info (id, 0); -} - -static int -map_widget_values (widget_value *value, int (*mapfunc) (widget_value *value, - void *closure), - void *closure) -{ - int retval = 0; - - if (value->contents) - retval = map_widget_values (value->contents, mapfunc, closure); - if (retval) - return retval; - - if (value->next) - retval = map_widget_values (value->next, mapfunc, closure); - if (retval) - return retval; - - return (mapfunc) (value, closure); -} - -int -lw_map_widget_values (LWLIB_ID id, int (*mapfunc) (widget_value *value, - void *closure), - void *closure) -{ - widget_info *info = get_widget_info (id, 0); - - if (!info) - abort (); - - if (info->val) - return map_widget_values (info->val, mapfunc, closure); - return 0; -} - -static widget_instance * -get_widget_instance (Widget widget, Boolean remove_p) -{ - widget_info *info; - widget_instance *instance; - widget_instance *prev; - for (info = all_widget_info; info; info = info->next) - for (prev = NULL, instance = info->instances; - instance; - prev = instance, instance = instance->next) - if (instance->widget == widget) - { - if (remove_p) - { - if (prev) - prev->next = instance->next; - else - info->instances = instance->next; - } - return instance; - } - return (widget_instance *) 0; -} - -static widget_instance* -find_instance (LWLIB_ID id, Widget parent, Boolean pop_up_p) -{ - widget_info *info = get_widget_info (id, False); - widget_instance *instance; - - if (info) - for (instance = info->instances; instance; instance = instance->next) - if (instance->parent == parent && instance->pop_up_p == pop_up_p) - return instance; - - return NULL; -} - - -/* utility function for widget_value */ -static Boolean -safe_strcmp (CONST char *s1, CONST char *s2) -{ - if (!!s1 ^ !!s2) return True; - return (s1 && s2) ? strcmp (s1, s2) : s1 ? False : !!s2; -} - -#ifndef WINDOWSNT -static change_type -max (change_type i1, change_type i2) -{ - return (int)i1 > (int)i2 ? i1 : i2; -} -#endif - - -#if 0 -# define EXPLAIN(name, oc, nc, desc, a1, a2) \ - printf ("Change: \"%s\"\tmax(%s=%d,%s=%d)\t%s %d %d\n", \ - name, \ - (oc == NO_CHANGE ? "none" : \ - (oc == INVISIBLE_CHANGE ? "invisible" : \ - (oc == VISIBLE_CHANGE ? "visible" : \ - (oc == STRUCTURAL_CHANGE ? "structural" : "???")))), \ - oc, \ - (nc == NO_CHANGE ? "none" : \ - (nc == INVISIBLE_CHANGE ? "invisible" : \ - (nc == VISIBLE_CHANGE ? "visible" : \ - (nc == STRUCTURAL_CHANGE ? "structural" : "???")))), \ - nc, desc, a1, a2) -#else -# define EXPLAIN(name, oc, nc, desc, a1, a2) -#endif - - -static widget_value * -merge_widget_value (widget_value *val1, widget_value *val2, int level) -{ - change_type change; - widget_value *merged_next; - widget_value *merged_contents; - - if (!val1) - { - if (val2) - return copy_widget_value_tree (val2, STRUCTURAL_CHANGE); - else - return NULL; - } - if (!val2) - { - free_widget_value_tree (val1); - return NULL; - } - - change = NO_CHANGE; - - if (val1->type != val2->type) - { - EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "type change", - val1->type, val2->type); - change = max (change, STRUCTURAL_CHANGE); - val1->type = val2->type; - } - if (safe_strcmp (val1->name, val2->name)) - { - EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "name change", - val1->name, val2->name); - change = max (change, STRUCTURAL_CHANGE); - safe_free_str (val1->name); - val1->name = safe_strdup (val2->name); - } - if (safe_strcmp (val1->value, val2->value)) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "value change", - val1->value, val2->value); - change = max (change, VISIBLE_CHANGE); - safe_free_str (val1->value); - val1->value = safe_strdup (val2->value); - } - if (safe_strcmp (val1->key, val2->key)) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "key change", - val1->key, val2->key); - change = max (change, VISIBLE_CHANGE); - safe_free_str (val1->key); - val1->key = safe_strdup (val2->key); - } - if (val1->accel != val2->accel) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "accelerator change", - val1->accel, val2->accel); - change = max (change, VISIBLE_CHANGE); - val1->accel = val2->accel; - } - if (val1->enabled != val2->enabled) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "enablement change", - val1->enabled, val2->enabled); - change = max (change, VISIBLE_CHANGE); - val1->enabled = val2->enabled; - } - if (val1->selected != val2->selected) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "selection change", - val1->selected, val2->selected); - change = max (change, VISIBLE_CHANGE); - val1->selected = val2->selected; - } - if (val1->call_data != val2->call_data) - { - EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "call-data change", - val1->call_data, val2->call_data); - change = max (change, INVISIBLE_CHANGE); - val1->call_data = val2->call_data; - } -#ifdef NEED_SCROLLBARS - if (merge_scrollbar_values (val1, val2)) - { - EXPLAIN (val1->name, change, VISIBLE_CHANGE, "scrollbar change", 0, 0); - change = max (change, VISIBLE_CHANGE); - } -#endif - - if (level > 0) - { - merged_contents = - merge_widget_value (val1->contents, val2->contents, level - 1); - - if (val1->contents && !merged_contents) - { - EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents gone)", - 0, 0); - change = max (change, INVISIBLE_CHANGE); - } - else if (merged_contents && merged_contents->change != NO_CHANGE) - { - EXPLAIN (val1->name, change, INVISIBLE_CHANGE, "(contents change)", - 0, 0); - change = max (change, INVISIBLE_CHANGE); - } - - val1->contents = merged_contents; - } - - merged_next = merge_widget_value (val1->next, val2->next, level); - - if (val1->next && !merged_next) - { - EXPLAIN (val1->name, change, STRUCTURAL_CHANGE, "(following gone)", - 0, 0); - change = max (change, STRUCTURAL_CHANGE); - } - else if (merged_next) - { - if (merged_next->change) - { - EXPLAIN (val1->name, change, merged_next->change, "(following change)", - 0, 0); - } - change = max (change, merged_next->change); - } - - val1->next = merged_next; - - val1->change = change; - - if (change > NO_CHANGE && val1->toolkit_data) - { - if (val1->free_toolkit_data) - XtFree ((char *) val1->toolkit_data); - val1->toolkit_data = NULL; - } - - return val1; -} - - -/* modifying the widgets */ -static Widget -name_to_widget (widget_instance *instance, CONST char *name) -{ - Widget widget = NULL; - - if (!instance->widget) - return NULL; - - if (!strcmp (XtName (instance->widget), name)) - widget = instance->widget; - else - { - int length = strlen (name) + 2; - char *real_name = (char *) alloca (length); - real_name [0] = '*'; - strcpy (real_name + 1, name); - - widget = XtNameToWidget (instance->widget, real_name); - } - return widget; -} - -static void -set_one_value (widget_instance *instance, widget_value *val, Boolean deep_p) -{ - Widget widget = name_to_widget (instance, val->name); - - if (widget) - { -#ifdef NEED_LUCID - if (lw_lucid_widget_p (instance->widget)) - xlw_update_one_widget (instance, widget, val, deep_p); -#endif -#ifdef NEED_MOTIF - if (lw_motif_widget_p (instance->widget)) - xm_update_one_widget (instance, widget, val, deep_p); -#endif -#ifdef NEED_ATHENA - if (lw_xaw_widget_p (instance->widget)) - xaw_update_one_widget (instance, widget, val, deep_p); -#endif - } -} - -static void -update_one_widget_instance (widget_instance *instance, Boolean deep_p) -{ - widget_value *val; - - if (!instance->widget) - /* the widget was destroyed */ - return; - - for (val = instance->info->val; val; val = val->next) - if (val->change != NO_CHANGE) - set_one_value (instance, val, deep_p); -} - -static void -update_all_widget_values (widget_info *info, Boolean deep_p) -{ - widget_instance *instance; - widget_value *val; - - for (instance = info->instances; instance; instance = instance->next) - update_one_widget_instance (instance, deep_p); - - for (val = info->val; val; val = val->next) - val->change = NO_CHANGE; -} - -void -lw_modify_all_widgets (LWLIB_ID id, widget_value *val, Boolean deep_p) -{ - widget_info *info = get_widget_info (id, False); - widget_value *new_val; - widget_value *next_new_val; - widget_value *cur; - widget_value *prev; - widget_value *next; - int found; - - if (!info) - return; - - for (new_val = val; new_val; new_val = new_val->next) - { - next_new_val = new_val->next; - new_val->next = NULL; - found = False; - for (prev = NULL, cur = info->val; cur; prev = cur, cur = cur->next) - if (!strcmp (cur->name, new_val->name)) - { - found = True; - next = cur->next; - cur->next = NULL; - cur = merge_widget_value (cur, new_val, deep_p ? 1000 : 1); - if (prev) - prev->next = cur ? cur : next; - else - info->val = cur ? cur : next; - if (cur) - cur->next = next; - break; - } - if (!found) - { - /* Could not find it, add it */ - if (prev) - prev->next = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE); - else - info->val = copy_widget_value_tree (new_val, STRUCTURAL_CHANGE); - } - new_val->next = next_new_val; - } - - update_all_widget_values (info, deep_p); -} - - -/* creating the widgets */ - -static void -initialize_widget_instance (widget_instance *instance) -{ - widget_value *val; - - for (val = instance->info->val; val; val = val->next) - val->change = STRUCTURAL_CHANGE; - - update_one_widget_instance (instance, True); - - for (val = instance->info->val; val; val = val->next) - val->change = NO_CHANGE; -} - - -static widget_creation_function -find_in_table (CONST char *type, widget_creation_entry *table) -{ - widget_creation_entry *cur; - for (cur = table; cur->type; cur++) - if (!strcasecmp (type, cur->type)) - return cur->function; - return NULL; -} - -static Boolean -dialog_spec_p (CONST char *name) -{ - /* return True if name matches [EILPQeilpq][1-9][Bb] or - [EILPQeilpq][1-9][Bb][Rr][1-9] */ - if (!name) - return False; - - switch (name [0]) - { - case 'E': case 'I': case 'L': case 'P': case 'Q': - case 'e': case 'i': case 'l': case 'p': case 'q': - if (name [1] >= '0' && name [1] <= '9') - { - if (name [2] != 'B' && name [2] != 'b') - return False; - if (!name [3]) - return True; - if ((name [3] == 'T' || name [3] == 't') && !name [4]) - return True; - if ((name [3] == 'R' || name [3] == 'r') - && name [4] >= '0' && name [4] <= '9' && !name [5]) - return True; - return False; - } - else - return False; - - default: - return False; - } -} - -static void -instantiate_widget_instance (widget_instance *instance) -{ - widget_creation_function function = NULL; - -#ifdef NEED_LUCID - if (!function) - function = find_in_table (instance->info->type, xlw_creation_table); -#endif -#ifdef NEED_MOTIF - if (!function) - function = find_in_table (instance->info->type, xm_creation_table); -#endif -#ifdef NEED_ATHENA - if (!function) - function = find_in_table (instance->info->type, xaw_creation_table); -#endif - - if (!function) - { - if (dialog_spec_p (instance->info->type)) - { -#ifdef LWLIB_DIALOGS_MOTIF - if (!function) - function = xm_create_dialog; -#endif -#ifdef LWLIB_DIALOGS_ATHENA - if (!function) - function = xaw_create_dialog; -#endif -#ifdef LWLIB_DIALOGS_LUCID - /* not yet (not ever?) */ -#endif - } - } - - if (!function) - { - fprintf (stderr, "No creation function for widget type %s\n", - instance->info->type); - abort (); - } - - instance->widget = (*function) (instance); - - if (!instance->widget) - abort (); - - /* XtRealizeWidget (instance->widget);*/ -} - -void -lw_register_widget (CONST char *type, CONST char *name, - LWLIB_ID id, widget_value *val, - lw_callback pre_activate_cb, lw_callback selection_cb, - lw_callback post_activate_cb) -{ - if (!get_widget_info (id, False)) - allocate_widget_info (type, name, id, val, pre_activate_cb, selection_cb, - post_activate_cb); -} - -Widget -lw_get_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p) -{ - widget_instance *instance = find_instance (id, parent, pop_up_p); - return instance ? instance->widget : NULL; -} - -Widget -lw_make_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p) -{ - widget_instance *instance = find_instance (id, parent, pop_up_p); - - if (!instance) - { - widget_info *info = get_widget_info (id, False); - if (!info) - return NULL; - instance = allocate_widget_instance (info, parent, pop_up_p); - initialize_widget_instance (instance); - } - if (!instance->widget) - abort (); - return instance->widget; -} - -Widget -lw_create_widget (CONST char *type, CONST char *name, - LWLIB_ID id, widget_value *val, - Widget parent, Boolean pop_up_p, lw_callback pre_activate_cb, - lw_callback selection_cb, lw_callback post_activate_cb) -{ - lw_register_widget (type, name, id, val, pre_activate_cb, selection_cb, - post_activate_cb); - return lw_make_widget (id, parent, pop_up_p); -} - - -/* destroying the widgets */ -static void -destroy_one_instance (widget_instance *instance) -{ - /* Remove the destroy callback on the widget; that callback will try to - dereference the instance object (to set its widget slot to 0, since the - widget is dead.) Since the instance is now dead, we don't have to worry - about the fact that its widget is dead too. - - This happens in the Phase2Destroy of the widget, so this callback would - not have been run until arbitrarily long after the instance was freed. - */ - if (instance->widget) - XtRemoveCallback (instance->widget, XtNdestroyCallback, - mark_widget_destroyed, (XtPointer)instance); - - if (instance->widget) - { - /* The else are pretty tricky here, including the empty statement - at the end because it would be very bad to destroy a widget - twice. */ -#ifdef NEED_LUCID - if (lw_lucid_widget_p (instance->widget)) - xlw_destroy_instance (instance); - else -#endif -#ifdef NEED_MOTIF - if (lw_motif_widget_p (instance->widget)) - xm_destroy_instance (instance); - else -#endif -#ifdef NEED_ATHENA - if (lw_xaw_widget_p (instance->widget)) - xaw_destroy_instance (instance); - else -#endif - { - /* do not remove the empty statement */ - ; - } - } - - free_widget_instance (instance); -} - -void -lw_destroy_widget (Widget w) -{ - widget_instance *instance = get_widget_instance (w, True); - - if (instance) - { - widget_info *info = instance->info; - /* instance has already been removed from the list; free it */ - destroy_one_instance (instance); - /* if there are no instances left, free the info too */ - if (!info->instances) - lw_destroy_all_widgets (info->id); - } -} - -void -lw_destroy_all_widgets (LWLIB_ID id) -{ - widget_info *info = get_widget_info (id, True); - widget_instance *instance; - widget_instance *next; - - if (info) - { - for (instance = info->instances; instance; ) - { - next = instance->next; - destroy_one_instance (instance); - instance = next; - } - free_widget_info (info); - } -} - -void -lw_destroy_everything () -{ - while (all_widget_info) - lw_destroy_all_widgets (all_widget_info->id); -} - -void -lw_destroy_all_pop_ups () -{ - widget_info *info; - widget_info *next; - widget_instance *instance; - - for (info = all_widget_info; info; info = next) - { - next = info->next; - instance = info->instances; - if (instance && instance->pop_up_p) - lw_destroy_all_widgets (info->id); - } -} - -Widget -lw_raise_all_pop_up_widgets (void) -{ - widget_info *info; - widget_instance *instance; - Widget result = NULL; - - for (info = all_widget_info; info; info = info->next) - for (instance = info->instances; instance; instance = instance->next) - if (instance->pop_up_p) - { - Widget widget = instance->widget; - if (widget) - { - if (XtIsManaged (widget) -#ifdef NEED_MOTIF - /* What a complete load of crap!!!! - When a dialogShell is on the screen, it is not managed! - */ - || (lw_motif_widget_p (instance->widget) && - XtIsManaged (first_child (widget))) -#endif - ) - { - if (!result) - result = widget; - XMapRaised (XtDisplay (widget), XtWindow (widget)); - } - } - } - return result; -} - -static void -lw_pop_all_widgets (LWLIB_ID id, Boolean up) -{ - widget_info *info = get_widget_info (id, False); - widget_instance *instance; - - if (info) - for (instance = info->instances; instance; instance = instance->next) - if (instance->pop_up_p && instance->widget) - { -#ifdef NEED_LUCID - if (lw_lucid_widget_p (instance->widget)) - { - XtRealizeWidget (instance->widget); - xlw_pop_instance (instance, up); - } -#endif -#ifdef NEED_MOTIF - if (lw_motif_widget_p (instance->widget)) - { - XtRealizeWidget (instance->widget); - xm_pop_instance (instance, up); - } -#endif -#ifdef NEED_ATHENA - if (lw_xaw_widget_p (instance->widget)) - { - XtRealizeWidget (XtParent (instance->widget)); - XtRealizeWidget (instance->widget); - xaw_pop_instance (instance, up); - } -#endif - } -} - -void -lw_pop_up_all_widgets (LWLIB_ID id) -{ - lw_pop_all_widgets (id, True); -} - -void -lw_pop_down_all_widgets (LWLIB_ID id) -{ - lw_pop_all_widgets (id, False); -} - -void -lw_popup_menu (Widget widget, XEvent *event) -{ -#ifdef LWLIB_MENUBARS_LUCID - if (lw_lucid_widget_p (widget)) - xlw_popup_menu (widget, event); -#endif -#ifdef LWLIB_MENUBARS_MOTIF - if (lw_motif_widget_p (widget)) - xm_popup_menu (widget, event); -#endif -#ifdef LWLIB_MENUBARS_ATHENA - if (lw_xaw_widget_p (widget)) - xaw_popup_menu (widget, event); /* not implemented */ -#endif -} - - /* get the values back */ -static Boolean -get_one_value (widget_instance *instance, widget_value *val) -{ - Widget widget = name_to_widget (instance, val->name); - - if (widget) - { -#ifdef NEED_LUCID - if (lw_lucid_widget_p (instance->widget)) - xlw_update_one_value (instance, widget, val); -#endif -#ifdef NEED_MOTIF - if (lw_motif_widget_p (instance->widget)) - xm_update_one_value (instance, widget, val); -#endif -#ifdef NEED_ATHENA - if (lw_xaw_widget_p (instance->widget)) - xaw_update_one_value (instance, widget, val); -#endif - return True; - } - else - return False; -} - -Boolean -lw_get_some_values (LWLIB_ID id, widget_value *val_out) -{ - widget_info *info = get_widget_info (id, False); - widget_instance *instance; - widget_value *val; - Boolean result = False; - - if (!info) - return False; - - instance = info->instances; - if (!instance) - return False; - - for (val = val_out; val; val = val->next) - if (get_one_value (instance, val)) - result = True; - - return result; -} - -widget_value* -lw_get_all_values (LWLIB_ID id) -{ - widget_info *info = get_widget_info (id, False); - widget_value *val = info->val; - if (lw_get_some_values (id, val)) - return val; - else - return NULL; -} - -/* internal function used by the library dependent implementation to get the - widget_value for a given widget in an instance */ -widget_value* -lw_get_widget_value_for_widget (widget_instance *instance, Widget w) -{ - char *name = XtName (w); - widget_value *cur; - for (cur = instance->info->val; cur; cur = cur->next) - if (!strcmp (cur->name, name)) - return cur; - return NULL; -} - - -/* update other instances value when one thing changed */ -/* This function can be used as a an XtCallback for the widgets that get - modified to update other instances of the widgets. Closure should be the - widget_instance. */ -void -lw_internal_update_other_instances (Widget widget, XtPointer closure, - XtPointer call_data) -{ - /* To forbid recursive calls */ - static Boolean updating; - - widget_instance *instance = (widget_instance*)closure; - char *name = XtName (widget); - widget_info *info; - widget_instance *cur; - widget_value *val; - - /* never recurse as this could cause infinite recursions. */ - if (updating) - return; - - /* protect against the widget being destroyed */ - if (XtWidgetBeingDestroyedP (widget)) - return; - - /* Return immediately if there are no other instances */ - info = instance->info; - if (!info->instances->next) - return; - - updating = True; - - for (val = info->val; val && strcmp (val->name, name); val = val->next); - - if (val && get_one_value (instance, val)) - for (cur = info->instances; cur; cur = cur->next) - if (cur != instance) - set_one_value (cur, val, True); - - updating = False; -} - - - -/* get the id */ - -LWLIB_ID -lw_get_widget_id (Widget w) -{ - widget_instance *instance = get_widget_instance (w, False); - - return instance ? instance->info->id : 0; -} - - -/* set the keyboard focus */ -void -lw_set_keyboard_focus (Widget parent, Widget w) -{ -#if defined(NEED_MOTIF) && !defined(LESSTIF_VERSION) - /* This loses with Lesstif v0.75a */ - xm_set_keyboard_focus (parent, w); -#else - XtSetKeyboardFocus (parent, w); -#endif -} - - -/* Show busy */ -static void -show_one_widget_busy (Widget w, Boolean flag) -{ - Pixel foreground = 0; - Pixel background = 1; - Widget widget_to_invert = XtNameToWidget (w, "*sheet"); - Arg al [2]; - - if (!widget_to_invert) - widget_to_invert = w; - - XtSetArg (al [0], XtNforeground, &foreground); - XtSetArg (al [1], XtNbackground, &background); - XtGetValues (widget_to_invert, al, 2); - - XtSetArg (al [0], XtNforeground, background); - XtSetArg (al [1], XtNbackground, foreground); - XtSetValues (widget_to_invert, al, 2); -} - -void -lw_show_busy (Widget w, Boolean busy) -{ - widget_instance *instance = get_widget_instance (w, False); - widget_info *info; - widget_instance *next; - - if (instance) - { - info = instance->info; - if (info->busy != busy) - { - for (next = info->instances; next; next = next->next) - if (next->widget) - show_one_widget_busy (next->widget, busy); - info->busy = busy; - } - } -} diff --git a/lwlib/lwlib.h b/lwlib/lwlib.h deleted file mode 100644 index b770831..0000000 --- a/lwlib/lwlib.h +++ /dev/null @@ -1,217 +0,0 @@ -#ifndef LWLIB_H -#define LWLIB_H - -#undef CONST - -#include - -/* To eliminate use of `const' in the lwlib sources, define CONST_IS_LOSING. */ -#ifdef CONST_IS_LOSING -# define CONST -#else -# define CONST const -#endif - -#if defined (LWLIB_MENUBARS_LUCID) || defined (LWLIB_MENUBARS_MOTIF) || defined (LWLIB_MENUBARS_ATHENA) -#define NEED_MENUBARS -#endif -#if defined (LWLIB_SCROLLBARS_LUCID) || defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_ATHENA) -#define NEED_SCROLLBARS -#endif -#if defined (LWLIB_DIALOGS_LUCID) || defined (LWLIB_DIALOGS_MOTIF) || defined (LWLIB_DIALOGS_ATHENA) -#define NEED_DIALOGS -#endif - -/* -** Widget values depend on the Widget type: -** -** widget: (name value key enabled data contents/selected) -** -** label: ("name" "string" NULL NULL NULL NULL) -** BUTTON: ("name" "string" "key" T/F data ) -** CASCADE (button w/menu): -** ("name" "string" "key" T/F data (label|button|button w/menu...)) -** INCREMENTAL (button w/menu construction callback): -** ("name" "string" NULL T/F ) -** menubar: ("name" NULL NULL T/F data (button w/menu)) -** scrollbar:("name" NULL NULL T/F NULL NULL) -** selectable thing: -** ("name" "string" "key" T/F data T/F) -** checkbox: selectable thing -** radio: ("name" NULL NULL T/F data (selectable thing...)) -** strings: ("name" NULL NULL T/F data (selectable thing...)) -** TEXT: ("name" "string" T/F data) -** -** Note that the above is EXTREMELY bogus. The "type" of the various entities -** that a widget_value structure can represent is implicit in the contents of -** half a dozen slots, instead of there simply being a type field. This -** should all be rethunk. I've added a type field, but for now it's only used -** by the new xlwmenu code. -*/ - -typedef unsigned long LWLIB_ID; - -typedef enum _change_type -{ - NO_CHANGE = 0, - INVISIBLE_CHANGE = 1, - VISIBLE_CHANGE = 2, - STRUCTURAL_CHANGE = 3 -} change_type; - -typedef enum _widget_value_type -{ - UNSPECIFIED_TYPE = 0, - BUTTON_TYPE = 1, - TOGGLE_TYPE = 2, - RADIO_TYPE = 3, - TEXT_TYPE = 4, - SEPARATOR_TYPE = 5, - CASCADE_TYPE = 6, - PUSHRIGHT_TYPE = 7, - INCREMENTAL_TYPE = 8 -} widget_value_type; - -typedef enum _scroll_action -{ - SCROLLBAR_LINE_UP = 0, - SCROLLBAR_LINE_DOWN = 1, - SCROLLBAR_PAGE_UP = 2, - SCROLLBAR_PAGE_DOWN = 3, - SCROLLBAR_DRAG = 4, - SCROLLBAR_CHANGE = 5, - SCROLLBAR_TOP = 6, - SCROLLBAR_BOTTOM = 7 -} scroll_action; - -typedef struct _scroll_event -{ - scroll_action action; - int slider_value; - Time time; -} scroll_event; - -typedef struct _scrollbar_values -{ - int line_increment; - int page_increment; - - int minimum; - int maximum; - - int slider_size; - int slider_position; - - int scrollbar_width, scrollbar_height; - int scrollbar_x, scrollbar_y; -} scrollbar_values; - -typedef struct _widget_value -{ - /* This slot is only partially utilized right now. */ - widget_value_type type; - - /* name of widget */ - char* name; - /* value (meaning BOGUSLY depend on widget type) */ - char* value; - /* keyboard equivalent. no implications for XtTranslations */ - char* key; - /* accelerator key. For XEmacs, this should be a Lisp_Object holding a - char or symbol suitable for passing to event_matches_key_specifier_p. - Outside of emacs, this can be anything: an X KeySym is a good idea. - lwlib provides support functions for keyboard traversal of menus. Actual - implementation of those accelerators is up to the application. - */ - XtPointer accel; - /* true if enabled */ - Boolean enabled; - /* true if selected */ - Boolean selected; - /* true if was edited (maintained by get_value) */ - Boolean edited; - /* true if has changed (maintained by lw library) */ - change_type change; - /* Contents of the sub-widgets, also selected slot for checkbox */ - struct _widget_value* contents; - /* data passed to callback */ - XtPointer call_data; - /* next one in the list */ - struct _widget_value* next; - /* slot for the toolkit dependent part. Always initialize to NULL. */ - void* toolkit_data; - /* tell us if we should free the toolkit data slot when freeing the - widget_value itself. */ - Boolean free_toolkit_data; - - /* data defining a scrollbar; only valid if type == "scrollbar" */ - scrollbar_values *scrollbar_data; - - /* we resource the widget_value structures; this points to the next - one on the free list if this one has been deallocated. - */ - struct _widget_value *free_list; -} widget_value; - - -typedef void (*lw_callback) (Widget w, LWLIB_ID id, XtPointer data); - -/* menu stuff */ -/* maybe this should go into a generic lwmenu.h */ - -extern int lw_menu_active; - -#if defined (LWLIB_MENUBARS_LUCID) -#include "xlwmenu.h" -#define lw_set_menu xlw_set_menu -#define lw_push_menu xlw_push_menu -#define lw_pop_menu xlw_pop_menu -#define lw_set_item xlw_set_item -#define lw_map_menu xlw_map_menu -#define lw_display_menu xlw_display_menu -#define lw_kill_menus xlw_kill_menus -#define lw_get_entries xlw_get_entries -#define lw_menu_level xlw_menu_level -#else /* LWLIB_MENUBARS_LUCID */ -/* do this for the other toolkits too */ -#endif /* LWLIB_MENUBARS_LUCID */ - -void lw_register_widget (CONST char* type, CONST char* name, LWLIB_ID id, - widget_value* val, lw_callback pre_activate_cb, - lw_callback selection_cb, - lw_callback post_activate_cb); -Widget lw_get_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p); -Widget lw_make_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p); -Widget lw_create_widget (CONST char* type, CONST char* name, LWLIB_ID id, - widget_value* val, Widget parent, Boolean pop_up_p, - lw_callback pre_activate_cb, - lw_callback selection_cb, - lw_callback post_activate_cb); -LWLIB_ID lw_get_widget_id (Widget w); -int lw_map_widget_values (LWLIB_ID id, int (*mapfunc) (widget_value *value, - void *closure), - void *closure); -void lw_modify_all_widgets (LWLIB_ID id, widget_value* val, Boolean deep_p); -void lw_destroy_widget (Widget w); -void lw_destroy_all_widgets (LWLIB_ID id); -void lw_destroy_everything (void); -void lw_destroy_all_pop_ups (void); -Widget lw_raise_all_pop_up_widgets (void); -widget_value* lw_get_all_values (LWLIB_ID id); -Boolean lw_get_some_values (LWLIB_ID id, widget_value* val); -void lw_pop_up_all_widgets (LWLIB_ID id); -void lw_pop_down_all_widgets (LWLIB_ID id); - -widget_value *malloc_widget_value (void); -void free_widget_value (widget_value *); -widget_value *replace_widget_value_tree (widget_value*, widget_value*); - -void lw_popup_menu (Widget, XEvent *); - -/* Toolkit independent way of focusing on a Widget at the Xt level. */ -void lw_set_keyboard_focus (Widget parent, Widget w); - - /* Silly Energize hack to invert the "sheet" button */ -void lw_show_busy (Widget w, Boolean busy); - -#endif /* LWLIB_H */ diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c deleted file mode 100644 index cf4de8d..0000000 --- a/lwlib/xlwmenu.c +++ /dev/null @@ -1,3628 +0,0 @@ -/* Implements a lightweight menubar widget. - Copyright (C) 1992, 1993, 1994 Lucid, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -/* Created by devin@lucid.com */ - -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -#include -#include -#include -#include -#include - -#ifdef NEED_MOTIF -#include -#if XmVersion < 1002 /* 1.1 or ancient */ -#undef XmFONTLIST_DEFAULT_TAG -#define XmFONTLIST_DEFAULT_TAG XmSTRING_DEFAULT_CHARSET -#endif /* XmVersion < 1.2 */ -#endif -#include "xlwmenuP.h" - -#ifdef USE_DEBUG_MALLOC -#include -#endif - -/* simple, naieve integer maximum */ -#ifndef max -#define max(a,b) ((a)>(b)?(a):(b)) -#endif - -static char -xlwMenuTranslations [] = -": start()\n\ -: drag()\n\ -: select()\n\ -"; - -extern Widget lw_menubar_widget; - -#define offset(field) XtOffset(XlwMenuWidget, field) -static XtResource -xlwMenuResources[] = -{ -#ifdef NEED_MOTIF - /* There are three font list resources, so that we can accept either of - the resources *fontList: or *font:, and so that we can tell the - difference between them being specified, and being defaulted to a - font from the XtRString specified here. */ - {XmNfontList, XmCFontList, XmRFontList, sizeof(XmFontList), - offset(menu.font_list), XtRImmediate, (XtPointer)0}, - {XtNfont, XtCFont, XmRFontList, sizeof(XmFontList), - offset(menu.font_list_2),XtRImmediate, (XtPointer)0}, - {XmNfontList, XmCFontList, XmRFontList, sizeof(XmFontList), - offset(menu.fallback_font_list), - /* We must use an iso8859-1 font here, or people without $LANG set lose. - It's fair to assume that those who do have $LANG set also have the - *fontList resource set, or at least know how to deal with this. */ - XtRString, (XtPointer) "-*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-1"}, -#else - {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), - offset(menu.font), XtRString, (XtPointer) "XtDefaultFont"}, -# ifdef USE_XFONTSET - {XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), - offset(menu.font_set), XtRString, (XtPointer) "XtDefaultFontSet"}, -# endif -#endif - {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), - offset(menu.foreground), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNbuttonForeground, XtCButtonForeground, XtRPixel, sizeof(Pixel), - offset(menu.button_foreground), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNhighlightForeground, XtCHighlightForeground, XtRPixel, sizeof(Pixel), - offset(menu.highlight_foreground), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNtitleForeground, XtCTitleForeground, XtRPixel, sizeof(Pixel), - offset(menu.title_foreground), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNmargin, XtCMargin, XtRDimension, sizeof(Dimension), - offset(menu.margin), XtRImmediate, (XtPointer)2}, - {XmNmarginWidth, XmCMarginWidth, XmRHorizontalDimension, sizeof(Dimension), - offset(menu.horizontal_margin), XtRImmediate, (XtPointer)2}, - {XmNmarginHeight, XmCMarginHeight, XmRVerticalDimension, sizeof(Dimension), - offset(menu.vertical_margin), XtRImmediate, (XtPointer)1}, - {XmNspacing, XmCSpacing, XmRHorizontalDimension, sizeof(Dimension), - offset(menu.column_spacing), XtRImmediate, (XtPointer)4}, - {XmNindicatorSize, XmCIndicatorSize, XtRDimension, sizeof(Dimension), - offset(menu.indicator_size), XtRImmediate, (XtPointer)0}, -#if 0 - {XmNshadowThickness, XmCShadowThickness, XmRHorizontalDimension, - sizeof (Dimension), offset (menu.shadow_thickness), - XtRImmediate, (XtPointer) 2}, -#else - {XmNshadowThickness, XmCShadowThickness, XtRDimension, - sizeof (Dimension), offset (menu.shadow_thickness), - XtRImmediate, (XtPointer) 2}, -#endif - {XmNselectColor, XmCSelectColor, XtRPixel, sizeof (Pixel), - offset (menu.select_color), XtRImmediate, (XtPointer)-1}, - {XmNtopShadowColor, XmCTopShadowColor, XtRPixel, sizeof (Pixel), - offset (menu.top_shadow_color), XtRImmediate, (XtPointer)-1}, - {XmNbottomShadowColor, XmCBottomShadowColor, XtRPixel, sizeof (Pixel), - offset (menu.bottom_shadow_color), XtRImmediate, (XtPointer)-1}, - {XmNtopShadowPixmap, XmCTopShadowPixmap, XtRPixmap, sizeof (Pixmap), - offset (menu.top_shadow_pixmap), XtRImmediate, (XtPointer)None}, - {XmNbottomShadowPixmap, XmCBottomShadowPixmap, XtRPixmap, sizeof (Pixmap), - offset (menu.bottom_shadow_pixmap), XtRImmediate, (XtPointer)None}, - - {XtNopen, XtCCallback, XtRCallback, sizeof(XtPointer), - offset(menu.open), XtRCallback, (XtPointer)NULL}, - {XtNselect, XtCCallback, XtRCallback, sizeof(XtPointer), - offset(menu.select), XtRCallback, (XtPointer)NULL}, - {XtNmenu, XtCMenu, XtRPointer, sizeof(XtPointer), - offset(menu.contents), XtRImmediate, (XtPointer)NULL}, - {XtNcursor, XtCCursor, XtRCursor, sizeof(Cursor), - offset(menu.cursor_shape), XtRString, (XtPointer) "right_ptr"}, - {XtNhorizontal, XtCHorizontal, XtRInt, sizeof(int), - offset(menu.horizontal), XtRImmediate, (XtPointer)True}, - {XtNuseBackingStore, XtCUseBackingStore, XtRBoolean, sizeof (Boolean), - offset (menu.use_backing_store), XtRImmediate, (XtPointer)False}, - {XtNbounceDown, XtCBounceDown, XtRBoolean, sizeof (Boolean), - offset (menu.bounce_down), XtRImmediate, (XtPointer)True}, - {XtNresourceLabels, XtCResourceLabels, XtRBoolean, sizeof (Boolean), - offset (menu.lookup_labels), XtRImmediate, (XtPointer)False}, -}; -#undef offset - -static Boolean XlwMenuSetValues (Widget current, Widget request, Widget new, - ArgList args, Cardinal *num_args); -static void XlwMenuRealize (Widget w, Mask *valueMask, - XSetWindowAttributes *attributes); -static void XlwMenuRedisplay (Widget w, XEvent *ev, Region region); -static void XlwMenuResize (Widget w); -static void XlwMenuInitialize (Widget request, Widget new, ArgList args, - Cardinal *num_args); -static void XlwMenuDestroy (Widget w); -static void XlwMenuClassInitialize (void); -static void Start (Widget w, XEvent *ev, String *params, Cardinal *num_params); -static void Drag (Widget w, XEvent *ev, String *params, Cardinal *num_params); -static void Select(Widget w, XEvent *ev, String *params, Cardinal *num_params); - -#ifdef NEED_MOTIF -static XFontStruct *default_font_of_font_list (XmFontList); -#endif - -static XtActionsRec -xlwMenuActionsList [] = -{ - {"start", Start}, - {"drag", Drag}, - {"select", Select}, -}; - -#define SuperClass ((CoreWidgetClass)&coreClassRec) - -XlwMenuClassRec xlwMenuClassRec = -{ - { /* CoreClass fields initialization */ - (WidgetClass) SuperClass, /* superclass */ - "XlwMenu", /* class_name */ - sizeof(XlwMenuRec), /* size */ - XlwMenuClassInitialize, /* class_initialize */ - NULL, /* class_part_initialize */ - FALSE, /* class_inited */ - XlwMenuInitialize, /* initialize */ - NULL, /* initialize_hook */ - XlwMenuRealize, /* realize */ - xlwMenuActionsList, /* actions */ - XtNumber(xlwMenuActionsList), /* num_actions */ - xlwMenuResources, /* resources */ - XtNumber(xlwMenuResources), /* resource_count */ - NULLQUARK, /* xrm_class */ - TRUE, /* compress_motion */ - TRUE, /* compress_exposure */ - TRUE, /* compress_enterleave */ - FALSE, /* visible_interest */ - XlwMenuDestroy, /* destroy */ - XlwMenuResize, /* resize */ - XlwMenuRedisplay, /* expose */ - XlwMenuSetValues, /* set_values */ - NULL, /* set_values_hook */ - XtInheritSetValuesAlmost, /* set_values_almost */ - NULL, /* get_values_hook */ - NULL, /* #### - should this be set for grabs? accept_focus */ - XtVersion, /* version */ - NULL, /* callback_private */ - xlwMenuTranslations, /* tm_table */ - XtInheritQueryGeometry, /* query_geometry */ - XtInheritDisplayAccelerator, /* display_accelerator */ - NULL /* extension */ - }, /* XlwMenuClass fields initialization */ - { - 0 /* dummy */ - }, -}; - -WidgetClass xlwMenuWidgetClass = (WidgetClass) &xlwMenuClassRec; - -extern int lw_menu_accelerate; - - /* Utilities */ -#if 0 /* Apparently not used anywhere */ - -static char * -safe_strdup (char *s) -{ - char *result; - if (! s) return 0; - result = (char *) malloc (strlen (s) + 1); - if (! result) - return 0; - strcpy (result, s); - return result; -} - -#endif /* 0 */ - -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. From FSF Emacs. */ - -static int -allocate_nearest_color (Display *display, Colormap screen_colormap, - XColor *color_def) -{ - int status = XAllocColor (display, screen_colormap, color_def); - if (status) - return status; - - { - /* If we got to this point, the colormap is full, so we're - going to try to get the next closest color. - The algorithm used is a least-squares matching, which is - what X uses for closest color matching with StaticColor visuals. */ - - int nearest, x; - unsigned long nearest_delta = ULONG_MAX; - - int no_cells = XDisplayCells (display, XDefaultScreen (display)); - /* Don't use alloca here because lwlib doesn't have the - necessary configuration information that src does. */ - XColor *cells = (XColor *) malloc (sizeof (XColor) * no_cells); - - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; - - XQueryColors (display, screen_colormap, cells, no_cells); - - for (nearest = 0, x = 0; x < no_cells; x++) - { - long dred = (color_def->red >> 8) - (cells[x].red >> 8); - long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); - long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); - unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; - - if (delta < nearest_delta) - { - nearest = x; - nearest_delta = delta; - } - } - color_def->red = cells[nearest].red; - color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - free (cells); - return XAllocColor (display, screen_colormap, color_def); - } -} - -static void -push_new_stack (XlwMenuWidget mw, widget_value *val) -{ - if (!mw->menu.new_stack) - { - mw->menu.new_stack_length = 10; - mw->menu.new_stack = - (widget_value**)XtCalloc (mw->menu.new_stack_length, - sizeof (widget_value*)); - } - else if (mw->menu.new_depth == mw->menu.new_stack_length) - { - mw->menu.new_stack_length *= 2; - mw->menu.new_stack = - (widget_value**)XtRealloc ((char *)mw->menu.new_stack, - mw->menu.new_stack_length * - sizeof (widget_value*)); - } - mw->menu.new_stack [mw->menu.new_depth++] = val; -} - -static void -pop_new_stack_if_no_contents (XlwMenuWidget mw) -{ - if (mw->menu.new_depth && - !mw->menu.new_stack [mw->menu.new_depth - 1]->contents) - mw->menu.new_depth -= 1; -} - -static void -make_old_stack_space (XlwMenuWidget mw, int n) -{ - if (!mw->menu.old_stack) - { - mw->menu.old_stack_length = max (10, n); - mw->menu.old_stack = - (widget_value**)XtCalloc (mw->menu.old_stack_length, - sizeof (widget_value*)); - } - else if (mw->menu.old_stack_length < n) - { - while (mw->menu.old_stack_length < n) - mw->menu.old_stack_length *= 2; - - mw->menu.old_stack = - (widget_value**)XtRealloc ((char *)mw->menu.old_stack, - mw->menu.old_stack_length * - sizeof (widget_value*)); - } -} - -static Boolean -close_to_reference_time (Widget w, Time reference_time, XEvent *ev) -{ - return - reference_time && - (ev->xbutton.time - reference_time < XtGetMultiClickTime (XtDisplay (w))); -} - - /* Size code */ -static int -string_width (XlwMenuWidget mw, -#ifdef NEED_MOTIF - XmString s -#else - char *s -#endif - ) -{ -#ifdef NEED_MOTIF - Dimension width, height; - XmStringExtent (mw->menu.font_list, s, &width, &height); - return width; -#else -# ifdef USE_XFONTSET - XRectangle ri, rl; - XmbTextExtents (mw->menu.font_set, s, strlen (s), &ri, &rl); - return rl.width; -# else - XCharStruct xcs; - int drop; - XTextExtents (mw->menu.font, s, strlen (s), &drop, &drop, &drop, &xcs); - return xcs.width; -# endif /* USE_XFONTSET */ -#endif -} - -static char massaged_resource_char[256]; - -static void -initialize_massaged_resource_char (void) -{ - int j; - for (j = 0; j < (int) sizeof (massaged_resource_char); j++) - { - if ((j >= 'a' && j <= 'z') || - (j >= 'A' && j <= 'Z') || - (j >= '0' && j <= '9') || - (j == '_') || - (j >= 0xa0)) - massaged_resource_char[j] = (char) j; - } - massaged_resource_char ['_'] = '_'; - massaged_resource_char ['+'] = 'P'; /* Convert C++ to cPP */ - massaged_resource_char ['.'] = '_'; /* Convert Buffers... to buffers___ */ -} - -static int -string_width_u (XlwMenuWidget mw, -#ifdef NEED_MOTIF - XmString string -#else - char *string -#endif - ) -{ -#ifdef NEED_MOTIF - Dimension width, height; - XmString newstring; -#else -# ifdef USE_XFONTSET - XRectangle ri, rl; -# else /* ! USE_XFONTSET */ - XCharStruct xcs; - int drop; -# endif -#endif - char* newchars; - int charslength; - char *chars; - int i, j; - -#ifdef NEED_MOTIF - if (!XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars)) - { - chars = ""; - } -#else - chars = string; -#endif - charslength = strlen (chars); - newchars = (char *) alloca (charslength + 1); - - for (i = j = 0; chars[i] && (j < charslength); i++) - if (chars[i]=='%'&&chars[i+1]=='_') - i++; - else - newchars[j++] = chars[i]; - newchars[j] = '\0'; - -#ifdef NEED_MOTIF - newstring = XmStringLtoRCreate (newchars, XmFONTLIST_DEFAULT_TAG); - XmStringExtent (mw->menu.font_list, newstring, &width, &height); - XmStringFree (newstring); - XtFree (chars); - return width; -#else -# ifdef USE_XFONTSET - XmbTextExtents (mw->menu.font_set, newchars, j, &ri, &rl); - return rl.width; -# else /* ! USE_XFONTSET */ - XTextExtents (mw->menu.font, newchars, j, &drop, &drop, &drop, &xcs); - return xcs.width; -# endif /* USE_XFONTSET */ -#endif -} - -static void -massage_resource_name (CONST char *in, char *out) -{ - /* Turn a random string into something suitable for using as a resource. - For example: - - "Kill Buffer" -> "killBuffer" - "Find File..." -> "findFile___" - "Search and Replace..." -> "searchAndReplace___" - "C++ Mode Commands" -> "cppModeCommands" - - Valid characters in a resource NAME component are: a-zA-Z0-9_ - */ - -#ifdef PRINT_XLWMENU_RESOURCE_CONVERSIONS - /* Compile with -DPRINT_XLWMENU_RESOURCE_CONVERSIONS to generate a - translation file for menu localizations. */ - char *save_in = in, *save_out = out; -#endif - - Boolean firstp = True; - while (*in) - { - char ch = massaged_resource_char[(unsigned char) *in++]; - if (ch) - { - *out++ = firstp ? tolower (ch) : toupper (ch); - firstp = False; - while ((ch = massaged_resource_char[(unsigned char) *in++]) != '\0') - *out++ = ch; - if (!*(in-1)) /* Overshot the NULL byte? */ - break; - } - } - *out = 0; - -#ifdef PRINT_XLWMENU_RESOURCE_CONVERSIONS - printf ("! Emacs*XlwMenu.%s.labelString:\t%s\n", save_out, save_in); - printf ( "Emacs*XlwMenu.%s.labelString:\n", save_out); -#endif -} - -static XtResource -nameResource[] = -{ - { "labelString", "LabelString", XtRString, sizeof(String), - 0, XtRImmediate, 0 } -}; - -/* - * This function looks through string searching for parameter - * inserts of the form: - * %[padding]1 - * padding is space (' ') or dash ('-') characters meaning - * padding to the left or right of the inserted parameter. - * In essence all %1 strings are replaced by value in the return - * value (which the caller is expected to free). - * %% means insert one % (like printf). - * %1 means insert value. - * %-1 means insert value followed by one space. The latter is - * not inserted if value is a zero length string. - */ -static char* -parameterize_string (CONST char *string, CONST char *value) -{ - char *percent; - char *result; - unsigned int done = 0; - unsigned int ntimes; - - if (!string) - { - result = XtMalloc(1); - result[0] = '\0'; - return (result); - } - - if (!value) - value = ""; - - for (ntimes = 1, result = (char *) string; (percent = strchr(result, '%')); - ntimes++) - result = &percent[1]; - - result = XtMalloc ((ntimes * strlen(value)) + strlen(string) + 4); - result[0] = '\0'; - - while ((percent = strchr(string, '%'))) - { - unsigned int left_pad; - unsigned int right_pad; - char *p; - - if (percent[1] == '%') - { /* it's a real % */ - strncat (result, string, 1 + percent - string); /* incl % */ - string = &percent[2]; /* after the second '%' */ - continue; /* with the while() loop */ - } - - left_pad = 0; - right_pad = 0; - - for (p = &percent[1]; /* test *p inside the loop */ ; p++) - { - if (*p == ' ') - { /* left pad */ - left_pad++; - } - else if (*p == '-') - { /* right pad */ - right_pad++; - } - else if (*p == '1') - { /* param and terminator */ - strncat (result, string, percent - string); - if (value[0] != '\0') - { - unsigned int i; - for (i = 0; i < left_pad; i++) - strcat (result, " "); - strcat (result, value); - for (i = 0; i < right_pad; i++) - strcat (result, " "); - } - string = &p[1]; /* after the '1' */ - done++; /* no need to do old way */ - break; /* out of for() loop */ - } - else - { /* bogus, copy the format as is */ - /* out of for() loop */ - strncat (result, string, 1 + p - string); - string = (*p ? &p[1] : p); - break; - } - } - } - - /* Copy the tail of the string */ - strcat (result, string); - - /* If we have not processed a % string, and we have a value, tail it. */ - if (!done && value[0] != '\0') - { - strcat (result, " "); - strcat (result, value); - } - - return result; -} - -#ifdef NEED_MOTIF - -static XmString -resource_widget_value (XlwMenuWidget mw, widget_value *val) -{ - if (!val->toolkit_data) - { - char *resourced_name = NULL; - char *converted_name, *str; - XmString complete_name; - char massaged_name [1024]; - - if (mw->menu.lookup_labels) - { - /* Convert value style name into resource style name. - eg: "Free Willy" becomes "freeWilly" */ - massage_resource_name (val->name, massaged_name); - - /* If we have a value (parameter) see if we can find a "Named" - resource. */ - if (val->value) - { - char named_name[1024]; - sprintf (named_name, "%sNamed", massaged_name); - XtGetSubresources ((Widget) mw, - (XtPointer) &resourced_name, - named_name, named_name, - nameResource, 1, NULL, 0); - } - - /* If nothing yet, try to load from the massaged name. */ - if (!resourced_name) - { - XtGetSubresources ((Widget) mw, - (XtPointer) &resourced_name, - massaged_name, massaged_name, - nameResource, 1, NULL, 0); - } - } /* if (mw->menu.lookup_labels) */ - - /* Still nothing yet, use the name as the value. */ - if (!resourced_name) - resourced_name = val->name; - - /* Parameterize the string. */ - converted_name = parameterize_string (resourced_name, val->value); - - /* nuke newline characters to prevent menubar screwups */ - for ( str = converted_name ; *str ; str++ ) - { - if (str[0] == '\n') str[0] = ' '; - } - - /* Improve OSF's bottom line. */ -#if (XmVersion >= 1002) - complete_name = XmStringCreateLocalized (converted_name); -#else - complete_name = XmStringCreateLtoR (converted_name, - XmSTRING_DEFAULT_CHARSET); -#endif - XtFree (converted_name); - - val->toolkit_data = complete_name; - val->free_toolkit_data = True; - } - return (XmString) val->toolkit_data; -} - -/* Unused */ -#if 0 -/* These two routines should be a seperate file..djw */ -static char * -xlw_create_localized_string (Widget w, - char *name, - char **args, - unsigned int nargs) -{ - char *string = NULL; - char *arg = NULL; - - if (nargs > 0) - arg = args[0]; - - XtGetSubresources (w, - (XtPointer)&string, - name, - name, - nameResource, 1, - NULL, 0); - - if (!string) - string = name; - - return parameterize_string (string, arg); -} - -static XmString -xlw_create_localized_xmstring (Widget w, - char *name, - char **args, - unsigned int nargs) -{ - char * string = xlw_create_localized_string (w, name, args, nargs); - XmString xm_string = XmStringCreateLtoR (string, XmSTRING_DEFAULT_CHARSET); - XtFree (string); - return xm_string; -} -#endif /* 0 */ - -#else /* !Motif */ - -static char* -resource_widget_value (XlwMenuWidget mw, widget_value *val) -{ - if (!val->toolkit_data) - { - char *resourced_name = NULL; - char *complete_name; - char massaged_name [1024]; - - if (mw->menu.lookup_labels) - { - massage_resource_name (val->name, massaged_name); - - XtGetSubresources ((Widget) mw, - (XtPointer) &resourced_name, - massaged_name, massaged_name, - nameResource, 1, NULL, 0); - } - if (!resourced_name) - resourced_name = val->name; - - complete_name = parameterize_string (resourced_name, val->value); - - val->toolkit_data = complete_name; - /* nuke newline characters to prevent menubar screwups */ - for ( ; *complete_name ; complete_name++ ) - { - if (complete_name[0] == '\n') - complete_name[0] = ' '; - } - val->free_toolkit_data = True; - } - return (char *) val->toolkit_data; -} - -#endif /* !Motif */ - -/* Code for drawing strings. */ -static void -string_draw (XlwMenuWidget mw, - Window window, - int x, int y, - GC gc, -#ifdef NEED_MOTIF - XmString string -#else - char *string -#endif -) -{ -#ifdef NEED_MOTIF - XmStringDraw (XtDisplay (mw), window, - mw->menu.font_list, - string, gc, - x, y, - 1000, /* ???? width */ - XmALIGNMENT_BEGINNING, - 0, /* ???? layout_direction */ - 0); -#else -# ifdef USE_XFONTSET - XmbDrawString (XtDisplay (mw), window, mw->menu.font_set, gc, - x, y + mw->menu.font_ascent, string, strlen (string)); -# else - XDrawString (XtDisplay (mw), window, gc, - x, y + mw->menu.font_ascent, string, strlen (string)); -# endif /* USE_XFONTSET */ - -#endif -} - -static int -string_draw_range ( - XlwMenuWidget mw, - Window window, - int x, int y, - GC gc, - char *string, - int start, - int end -) -{ -#ifdef NEED_MOTIF - Dimension width, height; - XmString newstring; - int c; - - if (end <= start) - return 0; - c = string[end]; - string[end] = '\0'; - newstring = XmStringLtoRCreate (&string[start], XmFONTLIST_DEFAULT_TAG); - XmStringDraw ( - XtDisplay (mw), window, - mw->menu.font_list, - newstring, gc, - x, y, - 1000, /* ???? width */ - XmALIGNMENT_BEGINNING, - 0, /* ???? layout_direction */ - 0 - ); - XmStringExtent (mw->menu.font_list, newstring, &width, &height); - XmStringFree (newstring); - string[end] = c; - return width; -#else -# ifdef USE_XFONTSET - XRectangle ri, rl; - - if (end <= start) - return 0; - XmbDrawString ( - XtDisplay (mw), window, mw->menu.font_set, gc, - x, y + mw->menu.font_ascent, &string[start], end - start); - XmbTextExtents ( - mw->menu.font_set, &string[start], end - start, &ri, &rl); - return rl.width; -# else - XCharStruct xcs; - int drop; - - if (end <= start) - return 0; - XDrawString ( - XtDisplay (mw), window, gc, - x, y + mw->menu.font_ascent, &string[start], end - start); - XTextExtents ( - mw->menu.font, &string[start], end - start, - &drop, &drop, &drop, &xcs); - return xcs.width; -# endif -#endif -} - -static void -string_draw_u (XlwMenuWidget mw, - Window window, - int x, int y, - GC gc, -#ifdef NEED_MOTIF - XmString string -#else - char *string -#endif -) -{ - int i, s = 0; - char *chars; - -#ifdef NEED_MOTIF - XmStringGetLtoR (string, XmFONTLIST_DEFAULT_TAG, &chars); -#else - chars = string; -#endif - for (i=0; chars[i]; ++i) { - if (chars[i] == '%' && chars[i+1] == '_') { - int w; - - x += string_draw_range (mw, window, x, y, gc, chars, s, i); - w = string_draw_range (mw, window, x, y, gc, chars, i+2, i+3); - - /* underline next character */ - XDrawLine (XtDisplay (mw), window, gc, x - 1, - y + mw->menu.font_ascent + 1, - x + w - 1, y + mw->menu.font_ascent + 1 ); - x += w; - s = i + 3; - i += 2; - } - } - x += string_draw_range (mw, window, x, y, gc, chars, s, i); -#ifdef NEED_MOTIF - XtFree (chars); -#endif -} - -static void -binding_draw (XlwMenuWidget mw, Window w, int x, int y, GC gc, char *value) -{ -#ifdef NEED_MOTIF - XmString xm_value = XmStringCreateLtoR(value, XmSTRING_DEFAULT_CHARSET); - string_draw (mw, w, x, y, gc, xm_value); - XmStringFree (xm_value); -#else - string_draw (mw, w, x, y, gc, value); -#endif -} - -/* Low level code for drawing 3-D edges. */ -static void -shadow_rectangle_draw (Display *dpy, - Window window, - GC top_gc, - GC bottom_gc, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int thickness) -{ - XPoint points [4]; - - if (!thickness) - return; - - points [0].x = x; - points [0].y = y; - points [1].x = x + width; - points [1].y = y; - points [2].x = x + width - thickness; - points [2].y = y + thickness; - points [3].x = x; - points [3].y = y + thickness; - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); - points [0].x = x; - points [0].y = y + thickness; - points [1].x = x; - points [1].y = y + height; - points [2].x = x + thickness; - points [2].y = y + height - thickness; - points [3].x = x + thickness; - points [3].y = y + thickness; - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); - points [0].x = x + width; - points [0].y = y; - points [1].x = x + width - thickness; - points [1].y = y + thickness; - points [2].x = x + width - thickness; - points [2].y = y + height - thickness; - points [3].x = x + width; - points [3].y = y + height - thickness; - XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); - points [0].x = x; - points [0].y = y + height; - points [1].x = x + width; - points [1].y = y + height; - points [2].x = x + width; - points [2].y = y + height - thickness; - points [3].x = x + thickness; - points [3].y = y + height - thickness; - XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); -} - -typedef enum e_shadow_type -{ - /* these are Motif compliant */ - SHADOW_BACKGROUND, - SHADOW_OUT, - SHADOW_IN, - SHADOW_ETCHED_OUT, - SHADOW_ETCHED_IN, - SHADOW_ETCHED_OUT_DASH, - SHADOW_ETCHED_IN_DASH, - SHADOW_SINGLE_LINE, - SHADOW_DOUBLE_LINE, - SHADOW_SINGLE_DASHED_LINE, - SHADOW_DOUBLE_DASHED_LINE, - SHADOW_NO_LINE, - /* these are all non-Motif */ - SHADOW_DOUBLE_ETCHED_OUT, - SHADOW_DOUBLE_ETCHED_IN, - SHADOW_DOUBLE_ETCHED_OUT_DASH, - SHADOW_DOUBLE_ETCHED_IN_DASH -} shadow_type; - -static void -shadow_draw (XlwMenuWidget mw, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - shadow_type type) -{ - Display *dpy = XtDisplay (mw); - GC top_gc; - GC bottom_gc; - int thickness = mw->menu.shadow_thickness; -#if 0 - XPoint points [4]; -#endif /* 0 */ - Boolean etched = False; - - switch (type) - { - case SHADOW_BACKGROUND: - top_gc = bottom_gc = mw->menu.background_gc; - break; - case SHADOW_ETCHED_IN: - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - etched = True; - break; - case SHADOW_ETCHED_OUT: - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - etched = True; - break; - case SHADOW_IN: - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - break; - case SHADOW_OUT: - default: - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - break; - } - - if (etched) - { - unsigned int half = thickness/2; - shadow_rectangle_draw (dpy, - window, - top_gc, - top_gc, - x, y, - width - half, height - half, - thickness - half); - shadow_rectangle_draw (dpy, - window, - bottom_gc, - bottom_gc, - x + half, y + half, - width - half , height - half, - half); - } - else - { - shadow_rectangle_draw (dpy, - window, - top_gc, - bottom_gc, - x, y, - width, height, - thickness); - } -} - -static void -arrow_decoration_draw (XlwMenuWidget mw, - Window window, - int x, int y, - unsigned int width, - Boolean raised) -{ - Display *dpy = XtDisplay (mw); - GC top_gc; - GC bottom_gc; - GC select_gc; - int thickness = mw->menu.shadow_thickness; - XPoint points [4]; - int half_width; - int length = (int)((double)width * 0.87); - int thick_med = (int)((double)thickness * 1.73); - - if (width & 0x1) - half_width = width/2 + 1; - else - half_width = width/2; - - select_gc = mw->menu.background_gc; - - if (raised) - { - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - } - else - { - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - } - - /* Fill internal area. We do this first so that the borders have a - nice sharp edge. */ - points [0].x = x + thickness; - points [0].y = y + thickness; - points [1].x = x + length - thickness; - points [1].y = y + half_width; - points [2].x = x + length - thickness; - points [2].y = y + half_width + thickness; - points [3].x = x + thickness; - points [3].y = y + width - thickness; - - XFillPolygon (dpy, - window, - select_gc, - points, - 4, - Convex, - CoordModeOrigin); - - /* left border */ - points [0].x = x; - points [0].y = y; - points [1].x = x + thickness; - points [1].y = y + thick_med; - points [2].x = x + thickness; - points [2].y = y + width - thick_med; - points [3].x = x; - points [3].y = y + width; - - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); - - /* top border */ - points [0].x = x; - points [0].y = y + width; - points [1].x = x + length; - points [1].y = y + half_width; - points [2].x = x + length - (thickness + thickness); - points [2].y = y + half_width; - points [3].x = x + thickness; - points [3].y = y + width - thick_med; - - XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); - - /* bottom shadow */ - points [0].x = x; - points [0].y = y; - points [1].x = x + length; - points [1].y = y + half_width; - points [2].x = x + length - (thickness + thickness); - points [2].y = y + half_width; - points [3].x = x + thickness; - points [3].y = y + thick_med; - - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); -} - -static void -toggle_decoration_draw (XlwMenuWidget mw, - Window window, - int x, int y, - unsigned int width, - Boolean set) -{ - Display *dpy = XtDisplay (mw); - int thickness = mw->menu.shadow_thickness; - shadow_type type; - GC select_gc = mw->menu.select_gc; - - if (set) - type = SHADOW_IN; - else - type = SHADOW_OUT; - - /* Fill internal area. */ - if (set) - XFillRectangle (dpy, - window, - select_gc, - x + thickness, - y + thickness, - width - (2*thickness), - width - (2*thickness)); - - shadow_draw (mw, window, x, y, width, width, type); -} - -static void -radio_decoration_draw (XlwMenuWidget mw, - Window window, - int x, int y, - unsigned int width, - Boolean enabled) -{ - Display *dpy = XtDisplay (mw); - GC top_gc; - GC bottom_gc; - GC select_gc = mw->menu.select_gc; - int thickness = mw->menu.shadow_thickness; - XPoint points[6]; - int half_width; -#if 0 - int npoints; -#endif /* 0 */ - - if (width & 0x1) - width++; - - half_width = width/2; - - if (enabled) - { - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - } - else - { - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - } - -#if 1 - /* Draw the bottom first, just in case the regions overlap. - The top should cast the longer shadow. */ - points [0].x = x; /* left corner */ - points [0].y = y + half_width; - points [1].x = x + half_width; /* bottom corner */ - points [1].y = y + width; - points [2].x = x + half_width; /* bottom inside corner */ - points [2].y = y + width - thickness; - points [3].x = x + thickness; /* left inside corner */ - points [3].y = y + half_width; - - XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); - - points [0].x = x + half_width; /* bottom corner */ - points [0].y = y + width; - points [1].x = x + width; /* right corner */ - points [1].y = y + half_width; - points [2].x = x + width - thickness; /* right inside corner */ - points [2].y = y + half_width; - points [3].x = x + half_width; /* bottom inside corner */ - points [3].y = y + width - thickness; - - XFillPolygon (dpy, window, bottom_gc, points, 4, Convex, CoordModeOrigin); - - points [0].x = x; /* left corner */ - points [0].y = y + half_width; - points [1].x = x + half_width; /* top corner */ - points [1].y = y; - points [2].x = x + half_width; /* top inside corner */ - points [2].y = y + thickness; - points [3].x = x + thickness; /* left inside corner */ - points [3].y = y + half_width; - - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); - - points [0].x = x + half_width; /* top corner */ - points [0].y = y; - points [1].x = x + width; /* right corner */ - points [1].y = y + half_width; - points [2].x = x + width - thickness; /* right inside corner */ - points [2].y = y + half_width; - points [3].x = x + half_width; /* top inside corner */ - points [3].y = y + thickness; - - XFillPolygon (dpy, window, top_gc, points, 4, Convex, CoordModeOrigin); -#else - /* Draw the bottom first, just in case the regions overlap. - The top should cast the longer shadow. */ - npoints = 0; - points [npoints].x = x; /* left corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + half_width; /* bottom corner */ - points [npoints++].y = y + width; - points [npoints].x = x + width; /* right corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + width - thickness; /* right inside corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + half_width; /* bottom inside corner */ - points [npoints++].y = y + width - thickness; - points [npoints].x = x + thickness; /* left inside corner */ - points [npoints++].y = y + half_width; - - XFillPolygon (dpy, window, bottom_gc, - points, npoints, Nonconvex, CoordModeOrigin); - - npoints = 0; - - points [npoints].x = x; /* left corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + half_width; /* top corner */ - points [npoints++].y = y; - points [npoints].x = x + width; /* right corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + width - thickness; /* right inside corner */ - points [npoints++].y = y + half_width; - points [npoints].x = x + half_width; /* top inside corner */ - points [npoints++].y = y + thickness; - points [npoints].x = x + thickness; /* left inside corner */ - points [npoints++].y = y + half_width; - - XFillPolygon (dpy, window, top_gc, points, npoints, Nonconvex, - CoordModeOrigin); -#endif - - - /* Fill internal area. */ - if (enabled) - { - points [0].x = x + thickness; - points [0].y = y + half_width; - points [1].x = x + half_width; - points [1].y = y + thickness; - points [2].x = x + width - thickness; - points [2].y = y + half_width; - points [3].x = x + half_width; - points [3].y = y + width - thickness; - XFillPolygon (dpy, - window, - select_gc, - points, - 4, - Convex, - CoordModeOrigin); - } -} - -static void -separator_decoration_draw (XlwMenuWidget mw, - Window window, - int x, int y, - unsigned int width, - Boolean vertical, - shadow_type type) -{ - Display *dpy = XtDisplay (mw); - GC top_gc; - GC bottom_gc; - unsigned int offset = 0; - unsigned int num_separators = 1; - unsigned int top_line_thickness = 0; - unsigned int bottom_line_thickness = 0; - Boolean dashed = False; - - switch (type) - { - case SHADOW_NO_LINE: /* nothing to do */ - return; - case SHADOW_DOUBLE_LINE: - num_separators = 2; - case SHADOW_SINGLE_LINE: - top_gc = bottom_gc = mw->menu.foreground_gc; - top_line_thickness = 1; - break; - case SHADOW_DOUBLE_DASHED_LINE: - num_separators = 2; - case SHADOW_SINGLE_DASHED_LINE: - top_gc = bottom_gc = mw->menu.foreground_gc; - top_line_thickness = 1; - dashed = True; - break; - case SHADOW_DOUBLE_ETCHED_OUT_DASH: - num_separators = 2; - case SHADOW_ETCHED_OUT_DASH: - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - top_line_thickness = mw->menu.shadow_thickness/2; - bottom_line_thickness = mw->menu.shadow_thickness - top_line_thickness; - dashed = True; - break; - case SHADOW_DOUBLE_ETCHED_IN_DASH: - num_separators = 2; - case SHADOW_ETCHED_IN_DASH: - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - top_line_thickness = mw->menu.shadow_thickness/2; - bottom_line_thickness = mw->menu.shadow_thickness - top_line_thickness; - dashed = True; - break; - case SHADOW_DOUBLE_ETCHED_OUT: - num_separators = 2; - case SHADOW_ETCHED_OUT: - top_gc = mw->menu.shadow_top_gc; - bottom_gc = mw->menu.shadow_bottom_gc; - top_line_thickness = mw->menu.shadow_thickness/2; - bottom_line_thickness = mw->menu.shadow_thickness - top_line_thickness; - break; - case SHADOW_DOUBLE_ETCHED_IN: - num_separators = 2; - case SHADOW_ETCHED_IN: - default: - top_gc = mw->menu.shadow_bottom_gc; - bottom_gc = mw->menu.shadow_top_gc; - top_line_thickness = mw->menu.shadow_thickness/2; - bottom_line_thickness = mw->menu.shadow_thickness - top_line_thickness; - break; - } - - if (dashed) - { - XGCValues values; - values.line_style = LineOnOffDash; - if (top_line_thickness > 0) - XChangeGC (dpy, top_gc, GCLineStyle, &values); - if (bottom_line_thickness > 0 && bottom_gc != top_gc) - XChangeGC (dpy, bottom_gc, GCLineStyle, &values); - } - - while (num_separators--) - { - unsigned int i; - for (i = 0; i < top_line_thickness; i++) - XDrawLine (dpy, window, top_gc, x, y + i, x + width, y + i); - - for (i = 0; i < bottom_line_thickness; i++) - XDrawLine (dpy, window, bottom_gc, - x, y + top_line_thickness + offset + i, - x + width, y + top_line_thickness + offset + i); - y += (top_line_thickness + offset + bottom_line_thickness + 1); - } - - if (dashed) - { - XGCValues values; - values.line_style = LineSolid; - if (top_line_thickness > 0) - XChangeGC (dpy, top_gc, GCLineStyle, &values); - if (bottom_line_thickness > 0 && bottom_gc != top_gc) - XChangeGC (dpy, bottom_gc, GCLineStyle, &values); - } -} - -#define SLOPPY_TYPES 0 /* 0=off, 1=error check, 2=easy to please */ -#if SLOPPY_TYPES -#if SLOPPY_TYPES < 2 - -static char *wv_types[] = -{ - "UNSPECIFIED", - "BUTTON", - "TOGGLE", - "RADIO", - "TEXT", - "SEPARATOR", - "CASCADE", - "PUSHRIGHT", - "INCREMENTAL" -}; - -static void -print_widget_value (widget_value *wv, int just_one, int depth) -{ - char d [200]; - int i; - for (i = 0; i < depth; i++) - d[i] = ' '; - d[depth]=0; - if (!wv) - { - printf ("%s(null widget value pointer)\n", d); - return; - } - printf ("%stype: %s\n", d, wv_types [wv->type]); -#if 0 - printf ("%sname: %s\n", d, (wv->name ? wv->name : "(null)")); -#else - if (wv->name) printf ("%sname: %s\n", d, wv->name); -#endif - if (wv->value) printf ("%svalue: %s\n", d, wv->value); - if (wv->key) printf ("%skey: %s\n", d, wv->key); - printf ("%senabled: %d\n", d, wv->enabled); - if (wv->contents) - { - printf ("\n%scontents: \n", d); - print_widget_value (wv->contents, 0, depth + 5); - } - if (!just_one && wv->next) - { - printf ("\n"); - print_widget_value (wv->next, 0, depth); - } -} -#endif /* SLOPPY_TYPES < 2 */ - -static Boolean -all_dashes_p (char *s) -{ - char *p; - if (!s || s[0] == '\0') - return False; - for (p = s; *p == '-'; p++); - - if (*p == '!' || *p == '\0') - return True; - return False; -} -#endif /* SLOPPY_TYPES */ - -static widget_value_type -menu_item_type (widget_value *val) -{ - if (val->type != UNSPECIFIED_TYPE) - return val->type; -#if SLOPPY_TYPES - else if (all_dashes_p (val->name)) - return SEPARATOR_TYPE; - else if (val->name && val->name[0] == '\0') /* push right */ - return PUSHRIGHT_TYPE; - else if (val->contents) /* cascade */ - return CASCADE_TYPE; - else if (val->call_data) /* push button */ - return BUTTON_TYPE; - else - return TEXT_TYPE; -#else - else - abort(); - return UNSPECIFIED_TYPE; /* Not reached */ -#endif -} - -static void -label_button_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *bindings_width, - unsigned int *height) -{ - *height = (mw->menu.font_ascent + mw->menu.font_descent + - 2 * mw->menu.vertical_margin + - 2 * mw->menu.shadow_thickness); - /* no left column decoration */ - *toggle_width = mw->menu.horizontal_margin + mw->menu.shadow_thickness;; - - *label_width = string_width_u (mw, resource_widget_value (mw, val)); - *bindings_width = mw->menu.horizontal_margin + mw->menu.shadow_thickness; -} - -static void -label_button_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_offset, - unsigned int binding_tab) -{ - int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; - GC gc; - - if (!label_offset) - label_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; - - if (highlighted && (in_menubar || val->contents)) - gc = mw->menu.highlight_gc; - else if (in_menubar || val->contents) - gc = mw->menu.foreground_gc; - else - gc = mw->menu.title_gc; - - /* Draw the label string. */ - string_draw_u (mw, - window, - x + label_offset, y + y_offset, - gc, - resource_widget_value (mw, val)); -} - -static void -push_button_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *bindings_width, - unsigned int *height) -{ - /* inherit */ - label_button_size (mw, val, in_menubar, - toggle_width, label_width, bindings_width, - height); - - /* key bindings to display? */ - if (!in_menubar && val->key) - { - int w; -#ifdef NEED_MOTIF - XmString key = XmStringCreateLtoR (val->key, XmSTRING_DEFAULT_CHARSET); - w = string_width (mw, key); - XmStringFree (key); -#else - char *key = val->key; - w = string_width (mw, key); -#endif - *bindings_width += w + mw->menu.column_spacing; - } -} - -static void -push_button_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_offset, - unsigned int binding_offset) -{ - int y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; - GC gc; - shadow_type type; - Boolean menu_pb = in_menubar && (menu_item_type (val) == BUTTON_TYPE); - - /* Draw the label string. */ - if (!label_offset) - label_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; - - if (highlighted) - { - if (val->enabled) - gc = mw->menu.highlight_gc; - else - gc = mw->menu.inactive_gc; - } - else if (menu_pb) - { - if (val->enabled) - gc = mw->menu.button_gc; - else - gc = mw->menu.inactive_button_gc; - } - else - { - if (val->enabled) - gc = mw->menu.foreground_gc; - else - gc = mw->menu.inactive_gc; - } - - string_draw_u (mw, - window, - x + label_offset, y + y_offset, - gc, - resource_widget_value (mw, val)); - - /* Draw the keybindings */ - if (val->key) - { - if (!binding_offset) - { - unsigned int s_width = - string_width (mw, resource_widget_value (mw, val)); - binding_offset = label_offset + s_width + mw->menu.shadow_thickness; - } - binding_draw (mw, window, - x + binding_offset + mw->menu.column_spacing, - y + y_offset, gc, val->key); - } - - /* Draw the shadow */ - if (menu_pb) - { - if (highlighted) - type = SHADOW_OUT; - else - type = (val->selected ? SHADOW_ETCHED_OUT : SHADOW_ETCHED_IN); - } - else - { - if (highlighted) - type = SHADOW_OUT; - else - type = SHADOW_BACKGROUND; - } - - shadow_draw (mw, window, x, y, width, height, type); -} - -static unsigned int -arrow_decoration_height (XlwMenuWidget mw) -{ - int result = (mw->menu.font_ascent + mw->menu.font_descent) / 2; - - result += 2 * mw->menu.shadow_thickness; - - if (result > (mw->menu.font_ascent + mw->menu.font_descent)) - result = mw->menu.font_ascent + mw->menu.font_descent; - - return result; -} - -static void -cascade_button_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *arrow_width, - unsigned int *height) -{ - /* inherit */ - label_button_size (mw, val, in_menubar, - toggle_width, label_width, arrow_width, - height); - /* we have a pull aside arrow */ - if (!in_menubar) - { - *arrow_width += arrow_decoration_height (mw) + mw->menu.column_spacing; - } -} - -static void -cascade_button_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_offset, - unsigned int binding_offset) -{ - shadow_type type; - - /* Draw the label string. */ - label_button_draw (mw, val, in_menubar, highlighted, - window, x, y, width, height, label_offset, - binding_offset); - - /* Draw the pull aside arrow */ - if (!in_menubar && val->contents) - { - int y_offset; - unsigned int arrow_height = arrow_decoration_height (mw); - - y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin + - (mw->menu.font_ascent+mw->menu.font_descent - arrow_height)/2; - - if (!binding_offset) - { - unsigned int s_width = - string_width (mw, resource_widget_value (mw, val)); - - if (!label_offset) - label_offset = mw->menu.shadow_thickness + - mw->menu.horizontal_margin; - - binding_offset = label_offset + s_width + mw->menu.shadow_thickness; - } - - arrow_decoration_draw (mw, - window, - x + binding_offset + mw->menu.column_spacing, - y + y_offset, - arrow_height, - highlighted); - } - - /* Draw the shadow */ - if (highlighted) - type = SHADOW_OUT; - else - type = SHADOW_BACKGROUND; - - shadow_draw (mw, window, x, y, width, height, type); -} - -static unsigned int -toggle_decoration_height (XlwMenuWidget mw) -{ - int rv; - if (mw->menu.indicator_size > 0) - rv = mw->menu.indicator_size; - else - rv = mw->menu.font_ascent; - - if (rv > (mw->menu.font_ascent + mw->menu.font_descent)) - rv = mw->menu.font_ascent + mw->menu.font_descent; - - /* radio button can't be smaller than its border or a filling - error will occur. */ - if (rv < 2 * mw->menu.shadow_thickness) - rv = 2 * mw->menu.shadow_thickness; - - return rv; -} - -static void -toggle_button_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *bindings_width, - unsigned int *height) -{ - /* inherit */ - push_button_size (mw, val, in_menubar, - toggle_width, label_width, bindings_width, - height); - /* we have a toggle */ - *toggle_width += toggle_decoration_height (mw) + mw->menu.column_spacing; -} - -static void -toggle_button_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_tab, - unsigned int binding_tab) -{ - int x_offset; - int y_offset; - unsigned int t_height = toggle_decoration_height (mw); - - /* Draw a toggle. */ - x_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; - y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; - y_offset += (mw->menu.font_ascent + mw->menu.font_descent - t_height)/2; - - toggle_decoration_draw (mw, window, x + x_offset, y + y_offset, - t_height, val->selected); - - /* Draw the pushbutton parts. */ - push_button_draw (mw, val, in_menubar, highlighted, window, x, y, width, - height, label_tab, binding_tab); -} - -static unsigned int -radio_decoration_height (XlwMenuWidget mw) -{ - return toggle_decoration_height (mw); -} - -static void -radio_button_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_tab, - unsigned int binding_tab) -{ - int x_offset; - int y_offset; - unsigned int r_height = radio_decoration_height (mw); - - /* Draw a toggle. */ - x_offset = mw->menu.shadow_thickness + mw->menu.horizontal_margin; - y_offset = mw->menu.shadow_thickness + mw->menu.vertical_margin; - y_offset += (mw->menu.font_ascent + mw->menu.font_descent - r_height)/2; - - radio_decoration_draw (mw, window, x + x_offset, y + y_offset, r_height, - val->selected); - - /* Draw the pushbutton parts. */ - push_button_draw (mw, val, in_menubar, highlighted, window, x, y, width, - height, label_tab, binding_tab); -} - -static struct _shadow_names -{ - CONST char * name; - shadow_type type; -} shadow_names[] = -{ - /* Motif */ - { "singleLine", SHADOW_SINGLE_LINE }, - { "doubleLine", SHADOW_DOUBLE_LINE }, - { "singleDashedLine", SHADOW_SINGLE_DASHED_LINE }, - { "doubleDashedLine", SHADOW_DOUBLE_DASHED_LINE }, - { "noLine", SHADOW_NO_LINE }, - { "shadowEtchedIn", SHADOW_ETCHED_IN }, - { "shadowEtchedOut", SHADOW_ETCHED_OUT }, - { "shadowEtchedInDash", SHADOW_ETCHED_IN_DASH }, - { "shadowEtchedOutDash", SHADOW_ETCHED_OUT_DASH }, - /* non-Motif */ - { "shadowDoubleEtchedIn", SHADOW_DOUBLE_ETCHED_IN }, - { "shadowDoubleEtchedOut", SHADOW_DOUBLE_ETCHED_OUT }, - { "shadowDoubleEtchedInDash", SHADOW_DOUBLE_ETCHED_IN_DASH }, - { "shadowDoubleEtchedOutDash", SHADOW_DOUBLE_ETCHED_OUT_DASH } -}; - -static shadow_type -separator_type (char *name) -{ - if (name) - { - int i; - for (i = 0; i < (int) (XtNumber (shadow_names)); i++ ) - { - if (strcmp (name, shadow_names[i].name) == 0) - return shadow_names[i].type; - } - } - return SHADOW_BACKGROUND; -} - -static unsigned int -separator_decoration_height (XlwMenuWidget mw, widget_value *val) -{ - - switch (separator_type (val->value)) - { - case SHADOW_NO_LINE: - case SHADOW_SINGLE_LINE: - case SHADOW_SINGLE_DASHED_LINE: - return 1; - case SHADOW_DOUBLE_LINE: - case SHADOW_DOUBLE_DASHED_LINE: - return 3; - case SHADOW_DOUBLE_ETCHED_OUT: - case SHADOW_DOUBLE_ETCHED_IN: - case SHADOW_DOUBLE_ETCHED_OUT_DASH: - case SHADOW_DOUBLE_ETCHED_IN_DASH: - return (1 + 2 * mw->menu.shadow_thickness); - case SHADOW_ETCHED_OUT: - case SHADOW_ETCHED_IN: - default: - return mw->menu.shadow_thickness; - } -} - -static void -separator_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *rest_width, - unsigned int *height) -{ - *height = separator_decoration_height (mw, val); - *label_width = 1; - *toggle_width = *rest_width = 0; -} - -static void -separator_draw (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - Boolean highlighted, - Window window, - int x, int y, - unsigned int width, - unsigned int height, - unsigned int label_tab, - unsigned int binding_tab) -{ - unsigned int sep_width; - - if (in_menubar) - sep_width = height; - else - sep_width = width; - - separator_decoration_draw (mw, - window, - x, - y, - sep_width, - in_menubar, - separator_type(val->value)); -} - -static void -pushright_size (XlwMenuWidget mw, - widget_value *val, - Boolean in_menubar, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *rest_width, - unsigned int *height) -{ - *height = *label_width = *toggle_width = *rest_width = 0; -} - -static void -size_menu_item (XlwMenuWidget mw, - widget_value *val, - int horizontal, - unsigned int *toggle_width, - unsigned int *label_width, - unsigned int *rest_width, - unsigned int *height) -{ - void (*function_ptr) (XlwMenuWidget _mw, - widget_value *_val, - Boolean _in_menubar, - unsigned int *_toggle_width, - unsigned int *_label_width, - unsigned int *_rest_width, - unsigned int *_height); - - switch (menu_item_type (val)) - { - case TOGGLE_TYPE: - case RADIO_TYPE: - function_ptr = toggle_button_size; - break; - case SEPARATOR_TYPE: - function_ptr = separator_size; - break; - case INCREMENTAL_TYPE: - case CASCADE_TYPE: - function_ptr = cascade_button_size; - break; - case BUTTON_TYPE: - function_ptr = push_button_size; - break; - case PUSHRIGHT_TYPE: - function_ptr = pushright_size; - break; - case TEXT_TYPE: - default: - function_ptr = label_button_size; - break; - } - - (*function_ptr) (mw, - val, - horizontal, - toggle_width, - label_width, - rest_width, - height); -} - -static void -display_menu_item (XlwMenuWidget mw, - widget_value *val, - window_state *ws, - XPoint *where, - Boolean highlighted, - Boolean horizontal, - Boolean just_compute) -{ - - int x = where->x /* + mw->menu.shadow_thickness */ ; - int y = where->y /* + mw->menu.shadow_thickness */ ; - unsigned int toggle_width; - unsigned int label_width; - unsigned int binding_width; - unsigned int width; - unsigned int height; - unsigned int label_tab; - unsigned int binding_tab; - void (*function_ptr) (XlwMenuWidget _mw, - widget_value *_val, - Boolean _in_menubar, - Boolean _highlighted, - Window _window, - int _x, int _y, - unsigned int _width, - unsigned int _height, - unsigned int _label_tab, - unsigned int _binding_tab); - - size_menu_item (mw, val, horizontal, - &toggle_width, &label_width, &binding_width, &height); - - if (horizontal) - { - width = toggle_width + label_width + binding_width; - height = ws->height - 2 * mw->menu.shadow_thickness; - } - else - { - width = ws->width - 2 * mw->menu.shadow_thickness; - toggle_width = ws->toggle_width; - label_width = ws->label_width; - } - - where->x += width; - where->y += height; - - if (just_compute) - return; - - label_tab = toggle_width; - binding_tab = toggle_width + label_width; - - switch (menu_item_type (val)) - { - case TOGGLE_TYPE: - function_ptr = toggle_button_draw; - break; - case RADIO_TYPE: - function_ptr = radio_button_draw; - break; - case SEPARATOR_TYPE: - function_ptr = separator_draw; - break; - case INCREMENTAL_TYPE: - case CASCADE_TYPE: - function_ptr = cascade_button_draw; - break; - case BUTTON_TYPE: - function_ptr = push_button_draw; - break; - case TEXT_TYPE: - function_ptr = label_button_draw; - break; - default: /* do no drawing */ - return; - } - - (*function_ptr) (mw, - val, - horizontal, - highlighted, - ws->window, - x, y, - width, height, - label_tab, - binding_tab); -} - -static void -size_menu (XlwMenuWidget mw, int level) -{ - unsigned int toggle_width; - unsigned int label_width; - unsigned int rest_width; - unsigned int height; - unsigned int max_toggle_width = 0; - unsigned int max_label_width = 0; - unsigned int max_rest_width = 0; - unsigned int max_height = 0; - int horizontal_p = mw->menu.horizontal && (level == 0); - widget_value* val; - window_state* ws; - - if (level >= mw->menu.old_depth) - abort (); - - ws = &mw->menu.windows [level]; - - for (val = mw->menu.old_stack [level]->contents; val; val = val->next) - { - size_menu_item (mw, - val, - horizontal_p, - &toggle_width, - &label_width, - &rest_width, - &height); - if (horizontal_p) - { - max_label_width += toggle_width + label_width + rest_width; - if (height > max_height) - max_height = height; - } - else - { - if (max_toggle_width < toggle_width) - max_toggle_width = toggle_width; - if (max_label_width < label_width) - max_label_width = label_width; - if (max_rest_width < rest_width) - max_rest_width = rest_width; - max_height += height; - } - } - - ws->height = max_height; - ws->width = max_label_width + max_rest_width + max_toggle_width; - ws->toggle_width = max_toggle_width; - ws->label_width = max_label_width; - - ws->width += 2 * mw->menu.shadow_thickness; - ws->height += 2 * mw->menu.shadow_thickness; -} - -static void -display_menu (XlwMenuWidget mw, int level, Boolean just_compute_p, - XPoint *highlighted_pos, XPoint *hit, widget_value **hit_return, - widget_value *this, widget_value *that) -{ - widget_value *val; - widget_value *following_item; - window_state *ws; - XPoint where; - int horizontal_p = mw->menu.horizontal && (level == 0); - int highlighted_p; - int just_compute_this_one_p; - - if (level >= mw->menu.old_depth) - abort (); - - if (level < mw->menu.old_depth - 1) - following_item = mw->menu.old_stack [level + 1]; - else - { - if (lw_menu_accelerate - && level == mw->menu.old_depth - 1 - && mw->menu.old_stack [level]->type == CASCADE_TYPE) - just_compute_p = True; - following_item = NULL; - } - -#if SLOPPY_TYPES == 1 - puts("==================================================================="); - print_widget_value (following_item, 1, 0); -#endif - - if (hit) - *hit_return = NULL; - - where.x = mw->menu.shadow_thickness; - where.y = mw->menu.shadow_thickness; - - ws = &mw->menu.windows [level]; - for (val = mw->menu.old_stack [level]->contents; val; val = val->next) - { - XPoint start; - - highlighted_p = (val == following_item); - /* If this is the partition (the dummy item which says that menus - after this should be flushright) then figure out how big the - following items are. This means we walk down the tail of the - list twice, but that's no big deal - it's short. - */ - if (horizontal_p && (menu_item_type (val) == PUSHRIGHT_TYPE)) - { - widget_value *rest; - XPoint flushright_size; - int new_x; - flushright_size.x = 0; - flushright_size.y = 0; - for (rest = val; rest; rest = rest->next) - display_menu_item (mw, rest, ws, &flushright_size, - highlighted_p, horizontal_p, True); - new_x = ws->width - (flushright_size.x + mw->menu.shadow_thickness); - if (new_x > where.x) - where.x = new_x; - /* We know what we need; don't draw this item. */ - continue; - } - - if (highlighted_p && highlighted_pos) - { - if (horizontal_p) - highlighted_pos->x = where.x; - else - highlighted_pos->y = where.y; - } - - just_compute_this_one_p = - just_compute_p || ((this || that) && val != this && val != that); - - start.x = where.x; - start.y = where.y; - display_menu_item (mw, val, ws, &where, highlighted_p, horizontal_p, - just_compute_this_one_p); - - if (highlighted_p && highlighted_pos) - { - if (horizontal_p) - highlighted_pos->y = ws->height; - else - highlighted_pos->x = ws->width; - } - - if (hit && !*hit_return) - { - if (horizontal_p && hit->x > start.x && hit->x <= where.x) - *hit_return = val; - else if (!horizontal_p && hit->y > start.y && hit->y <= where.y) - *hit_return = val; - } - - if (horizontal_p) - where.y = mw->menu.shadow_thickness; - else - where.x = mw->menu.shadow_thickness; - } - - /* Draw slab edges around menu */ - if (!just_compute_p) - shadow_draw(mw, ws->window, 0, 0, ws->width, ws->height, SHADOW_OUT); -} - - /* Motion code */ -static void -set_new_state (XlwMenuWidget mw, widget_value *val, int level) -{ - int i; - - mw->menu.new_depth = 0; - for (i = 0; i < level; i++) - push_new_stack (mw, mw->menu.old_stack [i]); - if (val) - push_new_stack (mw, val); -} - -static void -make_windows_if_needed (XlwMenuWidget mw, int n) -{ - int i; - int start_at; - XSetWindowAttributes xswa; - Widget p; - int mask; - int depth; - Visual *visual; - window_state *windows; - Window root; - - if (mw->menu.windows_length >= n) - return; - - root = RootWindowOfScreen (XtScreen(mw)); - /* grab the visual and depth from the nearest shell ancestor */ - visual = CopyFromParent; - depth = CopyFromParent; - p = XtParent(mw); - while (visual == CopyFromParent && p) - { - if (XtIsShell(p)) - { - visual = ((ShellWidget)p)->shell.visual; - depth = p->core.depth; - } - p = XtParent(p); - } - - xswa.save_under = True; - xswa.override_redirect = True; - xswa.background_pixel = mw->core.background_pixel; - xswa.border_pixel = mw->core.border_pixel; - xswa.event_mask = (ExposureMask | ButtonMotionMask - | ButtonReleaseMask | ButtonPressMask); - xswa.cursor = mw->menu.cursor_shape; - xswa.colormap = mw->core.colormap; - mask = CWSaveUnder | CWOverrideRedirect | CWBackPixel | CWBorderPixel - | CWEventMask | CWCursor | CWColormap; - - if (mw->menu.use_backing_store) - { - xswa.backing_store = Always; - mask |= CWBackingStore; - } - - if (!mw->menu.windows) - { - mw->menu.windows = - (window_state *) XtMalloc (n * sizeof (window_state)); - start_at = 0; - } - else - { - mw->menu.windows = - (window_state *) XtRealloc ((char *) mw->menu.windows, - n * sizeof (window_state)); - start_at = mw->menu.windows_length; - } - mw->menu.windows_length = n; - - windows = mw->menu.windows; - - for (i = start_at; i < n; i++) - { - windows [i].x = 0; - windows [i].y = 0; - windows [i].width = 1; - windows [i].height = 1; - windows [i].window = - XCreateWindow (XtDisplay (mw), - root, - 0, 0, 1, 1, - 0, depth, CopyFromParent, visual, mask, &xswa); - } -} - -/* Make the window fit in the screen */ -static void -fit_to_screen (XlwMenuWidget mw, window_state *ws, window_state *previous_ws, - Boolean horizontal_p) -{ - int screen_width = WidthOfScreen (XtScreen (mw)); - int screen_height = HeightOfScreen (XtScreen (mw)); - - if (ws->x < 0) - ws->x = 0; - else if ((int) (ws->x + ws->width) > screen_width) - { - if (!horizontal_p) - ws->x = previous_ws->x - ws->width; - else - { - ws->x = screen_width - ws->width; - - /* This check is to make sure we cut off the right side - instead of the left side if the menu is wider than the - screen. */ - if (ws->x < 0) - ws->x = 0; - } - } - if (ws->y < 0) - ws->y = 0; - else if ((int) (ws->y + ws->height) > screen_height) - { - if (horizontal_p) - { - /* A pulldown must either be entirely above or below the menubar. - If we're here, the pulldown doesn't fit below the menubar, so - let's determine if it will fit above the menubar. - Only put it above if there is more room above than below. - Note shadow_thickness offset to allow for slab surround. - */ - if (ws->y > (screen_height / 2)) - ws->y = previous_ws->y - ws->height + mw->menu.shadow_thickness; - } - else - { - ws->y = screen_height - ws->height; - /* if it's taller than the screen, display the topmost part - that will fit, beginning at the top of the screen. */ - if (ws->y < 0) - ws->y = 0; - } - } -} - -/* Updates old_stack from new_stack and redisplays. */ -static void -remap_menubar (XlwMenuWidget mw) -{ - int i; - int last_same; - XPoint selection_position; - int old_depth = mw->menu.old_depth; - int new_depth = mw->menu.new_depth; - widget_value **old_stack; - widget_value **new_stack; - window_state *windows; - widget_value *old_selection; - widget_value *new_selection; - - /* Check that enough windows and old_stack are ready. */ - make_windows_if_needed (mw, new_depth); - make_old_stack_space (mw, new_depth); - windows = mw->menu.windows; - old_stack = mw->menu.old_stack; - new_stack = mw->menu.new_stack; - - /* compute the last identical different entry */ - for (i = 1; i < old_depth && i < new_depth; i++) - if (old_stack [i] != new_stack [i]) - break; - last_same = i - 1; - - if (lw_menu_accelerate - && last_same - && last_same == old_depth - 1 - && old_stack [last_same]->contents) - last_same--; - - /* Memorize the previously selected item to be able to refresh it */ - old_selection = last_same + 1 < old_depth ? old_stack [last_same + 1] : NULL; - new_selection = last_same + 1 < new_depth ? new_stack [last_same + 1] : NULL; - - /* updates old_state from new_state. It has to be done now because - display_menu (called below) uses the old_stack to know what to display. */ - for (i = last_same + 1; i < new_depth; i++) - old_stack [i] = new_stack [i]; - - mw->menu.old_depth = new_depth; - - /* refresh the last seletion */ - selection_position.x = 0; - selection_position.y = 0; - display_menu (mw, last_same, new_selection == old_selection, - &selection_position, NULL, NULL, old_selection, new_selection); - - /* Now popup the new menus */ - for (i = last_same + 1; i < new_depth && new_stack [i]->contents; i++) - { - window_state *previous_ws = &windows [i - 1]; - window_state *ws = &windows [i]; - - if (lw_menu_accelerate && i == new_depth - 1) - break; - - ws->x = previous_ws->x + selection_position.x; - ws->y = previous_ws->y + selection_position.y; - - /* take into account the slab around the new menu */ - ws->y -= mw->menu.shadow_thickness; - - { - widget_value *val = mw->menu.old_stack [i]; - if (val->contents->type == INCREMENTAL_TYPE) - { - /* okay, we're now doing a lisp callback to incrementally generate - more of the menu. */ - XtCallCallbackList ((Widget)mw, - mw->menu.open, - (XtPointer)val->contents); - } - } - - size_menu (mw, i); - - fit_to_screen (mw, ws, previous_ws, mw->menu.horizontal && i == 1); - - XClearWindow (XtDisplay (mw), ws->window); - XMoveResizeWindow (XtDisplay (mw), ws->window, ws->x, ws->y, - ws->width, ws->height); - XMapRaised (XtDisplay (mw), ws->window); - display_menu (mw, i, False, &selection_position, NULL, NULL, NULL, NULL); - } - - /* unmap the menus that popped down */ - - last_same = new_depth; - if (lw_menu_accelerate - && last_same > 1 - && new_stack [last_same - 1]->contents) - last_same--; - - for (i = last_same - 1; i < old_depth; i++) - if (i >= last_same || !new_stack [i]->contents) - XUnmapWindow (XtDisplay (mw), windows [i].window); -} - -static Boolean -motion_event_is_in_menu (XlwMenuWidget mw, XMotionEvent *ev, int level, - XPoint *relative_pos) -{ - window_state *ws = &mw->menu.windows [level]; - int x = level == 0 ? ws->x : ws->x + mw->menu.shadow_thickness; - int y = level == 0 ? ws->y : ws->y + mw->menu.shadow_thickness; - relative_pos->x = ev->x_root - x; - relative_pos->y = ev->y_root - y; - return (x < ev->x_root && ev->x_root < (int) (x + ws->width) && - y < ev->y_root && ev->y_root < (int) (y + ws->height)); -} - -static Boolean -map_event_to_widget_value (XlwMenuWidget mw, XMotionEvent *ev, - widget_value **val_ptr, int *level, - Boolean *inside_menu) -{ - int i; - XPoint relative_pos; - window_state* ws; - - *val_ptr = NULL; - *inside_menu = False; - - /* Find the window */ -#if 1 - for (i = mw->menu.old_depth - 1; i >= 0; i--) -#else - for (i = 0; i <= mw->menu.old_depth - 1; i++) -#endif - { - ws = &mw->menu.windows [i]; - if (ws && motion_event_is_in_menu (mw, ev, i, &relative_pos)) - { - *inside_menu = True; /* special logic for menubar below... */ - if ((ev->type == ButtonPress) || - (ev->state != 0)) - { - display_menu (mw, i, True, NULL, &relative_pos, - val_ptr, NULL, NULL); - if (*val_ptr) - { - *level = i + 1; - *inside_menu = True; - return True; - } - else if (mw->menu.horizontal || i == 0) - { - /* if we're clicking on empty part of the menubar, then - unpost the stay-up menu */ - *inside_menu = False; - } - } - } - } - return False; -} - - /* Procedures */ -static void -make_drawing_gcs (XlwMenuWidget mw) -{ - XGCValues xgcv; - unsigned long flags = (GCFont | GCForeground | GCBackground); - -#ifdef NEED_MOTIF - xgcv.font = default_font_of_font_list (mw->menu.font_list)->fid; -#else - xgcv.font = mw->menu.font->fid; -#endif - - xgcv.foreground = mw->core.background_pixel; - xgcv.background = mw->menu.foreground; - mw->menu.background_gc = XtGetGC ((Widget) mw, flags, &xgcv); - - xgcv.foreground = mw->menu.foreground; - xgcv.background = mw->core.background_pixel; - mw->menu.foreground_gc = XtGetGC ((Widget) mw, flags, &xgcv); - - if (mw->menu.select_color != (Pixel)-1) - { - xgcv.foreground = mw->menu.select_color; - } - else - { - Display *dpy = XtDisplay(mw); - if (CellsOfScreen(DefaultScreenOfDisplay(dpy)) <= 2) - { /* mono */ - xgcv.foreground = mw->menu.foreground; - } - else - { /* color */ - XColor xcolor; - Colormap cmap = mw->core.colormap; - xcolor.pixel = mw->core.background_pixel; - XQueryColor (dpy, cmap, &xcolor); - xcolor.red = (xcolor.red * 17) / 20; - xcolor.green = (xcolor.green * 17) / 20; - xcolor.blue = (xcolor.blue * 17) / 20; - if (allocate_nearest_color (dpy, cmap, &xcolor)) - xgcv.foreground = xcolor.pixel; - } - } - xgcv.background = mw->core.background_pixel; - mw->menu.select_gc = XtGetGC ((Widget)mw, flags, &xgcv); - - xgcv.foreground = mw->menu.foreground; - xgcv.background = mw->core.background_pixel; - xgcv.fill_style = FillStippled; - xgcv.stipple = mw->menu.gray_pixmap; - mw->menu.inactive_gc = XtGetGC ((Widget)mw, - (flags | GCFillStyle | GCStipple), - &xgcv); - - xgcv.foreground = mw->menu.highlight_foreground; - xgcv.background = mw->core.background_pixel; - mw->menu.highlight_gc = XtGetGC ((Widget)mw, flags, &xgcv); - - xgcv.foreground = mw->menu.title_foreground; - xgcv.background = mw->core.background_pixel; - mw->menu.title_gc = XtGetGC ((Widget)mw, flags, &xgcv); - - xgcv.foreground = mw->menu.button_foreground; - xgcv.background = mw->core.background_pixel; - mw->menu.button_gc = XtGetGC ((Widget)mw, flags, &xgcv); - - xgcv.fill_style = FillStippled; - xgcv.stipple = mw->menu.gray_pixmap; - mw->menu.inactive_button_gc = XtGetGC ((Widget)mw, - (flags | GCFillStyle | GCStipple), - &xgcv); -} - -static void -release_drawing_gcs (XlwMenuWidget mw) -{ - XtReleaseGC ((Widget) mw, mw->menu.foreground_gc); - XtReleaseGC ((Widget) mw, mw->menu.button_gc); - XtReleaseGC ((Widget) mw, mw->menu.highlight_gc); - XtReleaseGC ((Widget) mw, mw->menu.title_gc); - XtReleaseGC ((Widget) mw, mw->menu.inactive_gc); - XtReleaseGC ((Widget) mw, mw->menu.inactive_button_gc); - XtReleaseGC ((Widget) mw, mw->menu.background_gc); - XtReleaseGC ((Widget) mw, mw->menu.select_gc); - /* let's get some segvs if we try to use these... */ - mw->menu.foreground_gc = (GC) -1; - mw->menu.button_gc = (GC) -1; - mw->menu.highlight_gc = (GC) -1; - mw->menu.title_gc = (GC) -1; - mw->menu.inactive_gc = (GC) -1; - mw->menu.inactive_button_gc = (GC) -1; - mw->menu.background_gc = (GC) -1; - mw->menu.select_gc = (GC) -1; -} - -#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ - ? ((unsigned long) (x)) : ((unsigned long) (y))) - -static void -make_shadow_gcs (XlwMenuWidget mw) -{ - XGCValues xgcv; - unsigned long pm = 0; - Display *dpy = XtDisplay ((Widget) mw); - Colormap cmap = mw->core.colormap; - XColor topc, botc; - int top_frobbed = 0, bottom_frobbed = 0; - - if (mw->menu.top_shadow_color == (Pixel) (-1)) - mw->menu.top_shadow_color = mw->core.background_pixel; - if (mw->menu.bottom_shadow_color == (Pixel) (-1)) - mw->menu.bottom_shadow_color = mw->menu.foreground; - - if (mw->menu.top_shadow_color == mw->core.background_pixel || - mw->menu.top_shadow_color == mw->menu.foreground) - { - topc.pixel = mw->core.background_pixel; - XQueryColor (dpy, cmap, &topc); - /* don't overflow/wrap! */ - topc.red = MINL (65535, topc.red * 1.2); - topc.green = MINL (65535, topc.green * 1.2); - topc.blue = MINL (65535, topc.blue * 1.2); - if (allocate_nearest_color (dpy, cmap, &topc)) - { - if (topc.pixel == mw->core.background_pixel) - { - XFreeColors( dpy, cmap, &topc.pixel, 1, 0); - topc.red = MINL (65535, topc.red + 0x8000); - topc.green = MINL (65535, topc.green + 0x8000); - topc.blue = MINL (65535, topc.blue + 0x8000); - if (allocate_nearest_color (dpy, cmap, &topc)) - { - mw->menu.top_shadow_color = topc.pixel; - } - } - else - { - mw->menu.top_shadow_color = topc.pixel; - } - - top_frobbed = 1; - } - } - if (mw->menu.bottom_shadow_color == mw->menu.foreground || - mw->menu.bottom_shadow_color == mw->core.background_pixel) - { - botc.pixel = mw->core.background_pixel; - XQueryColor (dpy, cmap, &botc); - botc.red = (botc.red * 3) / 5; - botc.green = (botc.green * 3) / 5; - botc.blue = (botc.blue * 3) / 5; - if (allocate_nearest_color (dpy, cmap, &botc)) - { - if (botc.pixel == mw->core.background_pixel) - { - XFreeColors (dpy, cmap, &botc.pixel, 1, 0); - botc.red = MINL (65535, botc.red + 0x4000); - botc.green = MINL (65535, botc.green + 0x4000); - botc.blue = MINL (65535, botc.blue + 0x4000); - if (allocate_nearest_color (dpy, cmap, &botc)) - { - mw->menu.bottom_shadow_color = botc.pixel; - } - } - else - { - mw->menu.bottom_shadow_color = botc.pixel; - } - - bottom_frobbed = 1; - } - } - - if (top_frobbed && bottom_frobbed) - { - int top_avg = ((topc.red / 3) + (topc.green / 3) + (topc.blue / 3)); - int bot_avg = ((botc.red / 3) + (botc.green / 3) + (botc.blue / 3)); - if (bot_avg > top_avg) - { - Pixel tmp = mw->menu.top_shadow_color; - mw->menu.top_shadow_color = mw->menu.bottom_shadow_color; - mw->menu.bottom_shadow_color = tmp; - } - else if (topc.pixel == botc.pixel) - { - if (botc.pixel == mw->menu.foreground) - mw->menu.top_shadow_color = mw->core.background_pixel; - else - mw->menu.bottom_shadow_color = mw->menu.foreground; - } - } - - if (!mw->menu.top_shadow_pixmap && - mw->menu.top_shadow_color == mw->core.background_pixel) - { - mw->menu.top_shadow_pixmap = mw->menu.gray_pixmap; - mw->menu.top_shadow_color = mw->menu.foreground; - } - if (!mw->menu.bottom_shadow_pixmap && - mw->menu.bottom_shadow_color == mw->core.background_pixel) - { - mw->menu.bottom_shadow_pixmap = mw->menu.gray_pixmap; - mw->menu.bottom_shadow_color = mw->menu.foreground; - } - - xgcv.fill_style = FillOpaqueStippled; - xgcv.foreground = mw->menu.top_shadow_color; - xgcv.background = mw->core.background_pixel; -/* xgcv.stipple = mw->menu.top_shadow_pixmap; gtb */ -#ifdef NEED_MOTIF - if (mw->menu.top_shadow_pixmap && - mw->menu.top_shadow_pixmap != XmUNSPECIFIED_PIXMAP) - xgcv.stipple = mw->menu.top_shadow_pixmap; - else - xgcv.stipple = 0; -#else - xgcv.stipple = mw->menu.top_shadow_pixmap; -#endif /* NEED_MOTIF */ - pm = (xgcv.stipple ? GCStipple|GCFillStyle : 0); - mw->menu.shadow_top_gc = - XtGetGC((Widget)mw, GCForeground|GCBackground|pm, &xgcv); - - xgcv.foreground = mw->menu.bottom_shadow_color; -/* xgcv.stipple = mw->menu.bottom_shadow_pixmap; gtb */ -#ifdef NEED_MOTIF - if (mw->menu.top_shadow_pixmap && - mw->menu.top_shadow_pixmap != XmUNSPECIFIED_PIXMAP) - xgcv.stipple = mw->menu.bottom_shadow_pixmap; - else - xgcv.stipple = 0; -#else - xgcv.stipple = mw->menu.bottom_shadow_pixmap; -#endif /* NEED_MOTIF */ - pm = (xgcv.stipple ? GCStipple|GCFillStyle : 0); - mw->menu.shadow_bottom_gc = - XtGetGC ((Widget)mw, GCForeground|GCBackground|pm, &xgcv); -} - - -static void -release_shadow_gcs (XlwMenuWidget mw) -{ - XtReleaseGC ((Widget) mw, mw->menu.shadow_top_gc); - XtReleaseGC ((Widget) mw, mw->menu.shadow_bottom_gc); -} - - -static void -extract_font_extents (XlwMenuWidget mw) -{ -#ifdef NEED_MOTIF - /* Find the maximal ascent/descent of the fonts in the font list - so that all menu items can be the same height... */ - mw->menu.font_ascent = 0; - mw->menu.font_descent = 0; - - { - XmFontContext context; -#if (XmVersion >= 1002) - XmFontListEntry fontentry; -#else - XmStringCharSet charset; -#endif - XFontStruct *font; - - if (! XmFontListInitFontContext (&context, mw->menu.font_list)) - abort (); -#if (XmVersion >= 1002) - /* There is a BUG in the 1.2 version of XmFontListGetNextFont() (or more - specifically, in _XmGetFirstFont()) that can cause a null pointer to be - passed to XFontsOfFontSet. Use XmFontListNextEntry(), which is the - newer equivalent, instead. Also, it supports font sets, and the - older function doesn't. */ - while ((fontentry = XmFontListNextEntry (context))) - { - XmFontType rettype; - - XtPointer one_of_them = XmFontListEntryGetFont (fontentry, &rettype); - if (rettype == XmFONT_IS_FONTSET) - { - XFontSet fontset = (XFontSet) one_of_them; - XFontStruct **fontstruct_list; - char **fontname_list; - int fontcount = XFontsOfFontSet (fontset, &fontstruct_list, - &fontname_list); - while (--fontcount >= 0) - { - font = fontstruct_list[fontcount]; - if (font->ascent > (int) mw->menu.font_ascent) - mw->menu.font_ascent = font->ascent; - if (font->descent > (int) mw->menu.font_descent) - mw->menu.font_descent = font->descent; - } - } - else /* XmFONT_IS_FONT */ - { - font = (XFontStruct *) one_of_them; - if (font->ascent > (int) mw->menu.font_ascent) - mw->menu.font_ascent = font->ascent; - if (font->descent > (int) mw->menu.font_descent) - mw->menu.font_descent = font->descent; - } - } -#else /* motif 1.1 */ - while (XmFontListGetNextFont (context, &charset, &font)) - { - if (font->ascent > (int) mw->menu.font_ascent) - mw->menu.font_ascent = font->ascent; - if (font->descent > (int) mw->menu.font_descent) - mw->menu.font_descent = font->descent; - XtFree (charset); - } -#endif /* Motif version */ - XmFontListFreeFontContext (context); - } -#else /* Not Motif */ -# ifdef USE_XFONTSET - XFontStruct **fontstruct_list; - char **fontname_list; - XFontStruct *font; - int fontcount = XFontsOfFontSet(mw->menu.font_set, &fontstruct_list, - &fontname_list); - mw->menu.font_ascent = 0; - mw->menu.font_descent = 0; -# if 0 /* nasty, personal debug, Kazz */ - fprintf(stderr, "fontSet count is %d\n", fontcount); -# endif - while (--fontcount >= 0) { - font = fontstruct_list[fontcount]; - if (font->ascent > (int) mw->menu.font_ascent) - mw->menu.font_ascent = font->ascent; - if (font->descent > (int) mw->menu.font_descent) - mw->menu.font_descent = font->descent; - } -# else /* ! USE_XFONTSET */ - mw->menu.font_ascent = mw->menu.font->ascent; - mw->menu.font_descent = mw->menu.font->descent; -# endif -#endif /* NEED_MOTIF */ -} - -#ifdef NEED_MOTIF -static XFontStruct * -default_font_of_font_list (XmFontList font_list) -{ - XFontStruct *font = 0; -# if 0 - /* Xm/Label.c does this: */ - _XmFontListGetDefaultFont (font_list, &font); -# else /* !0 */ - { - XmFontContext context; -#if (XmVersion >= 1002) - XmFontListEntry fontentry; - XmFontType rettype; - XtPointer one_of_them; -#else - XmStringCharSet charset; -#endif - - if (! XmFontListInitFontContext (&context, font_list)) - abort (); -#if (XmVersion >= 1002) - /* There is a BUG in the 1.2 version of XmFontListGetNextFont() (or more - specifically, in _XmGetFirstFont()) that can cause a null pointer to be - passed to XFontsOfFontSet. Use XmFontListNextEntry(), which is the - newer equivalent, instead. */ - fontentry = XmFontListNextEntry (context); - one_of_them = XmFontListEntryGetFont (fontentry, &rettype); - if (rettype == XmFONT_IS_FONTSET) - { - XFontSet fontset = (XFontSet) one_of_them; - XFontStruct **fontstruct_list; - char **fontname_list; - (void) XFontsOfFontSet (fontset, &fontstruct_list, &fontname_list); - font = fontstruct_list[0]; - } - else /* XmFONT_IS_FONT */ - { - font = (XFontStruct *) one_of_them; - } -#else - if (! XmFontListGetNextFont (context, &charset, &font)) - abort (); - XtFree (charset); -#endif - XmFontListFreeFontContext (context); - } -# endif /* !0 */ - - if (! font) abort (); - return font; -} -#endif /* NEED_MOTIF */ - -static void -XlwMenuInitialize (Widget request, Widget new, ArgList args, - Cardinal *num_args) -{ - /* Get the GCs and the widget size */ - XlwMenuWidget mw = (XlwMenuWidget)new; - - XSetWindowAttributes xswa; - int mask; - - Window window = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw))); - Display *display = XtDisplay (mw); - -/* mw->menu.cursor = XCreateFontCursor (display, mw->menu.cursor_shape); */ - mw->menu.cursor = mw->menu.cursor_shape; - - mw->menu.gray_pixmap = - XCreatePixmapFromBitmapData (display, window, (char *) gray_bits, - gray_width, gray_height, 1, 0, 1); - -#ifdef NEED_MOTIF - /* The menu.font_list slot came from the *fontList resource (Motif standard.) - The menu.font_list_2 slot came from the *font resource, for backward - compatibility with older versions of this code, and consistency with the - rest of emacs. If both font and fontList are specified, we use font. - If only one is specified, we use that. If neither are specified, we - use the "fallback" value. What a kludge!!! - - Note that this has the bug that a more general wildcard like "*fontList:" - will override a more specific resource like "Emacs*menubar.font:". But - I can't think of a way around that. - */ - if (mw->menu.font_list) /* if *fontList is specified, use that */ - ; - else if (mw->menu.font_list_2) /* else if *font is specified, use that */ - mw->menu.font_list = mw->menu.font_list_2; - else /* otherwise use default */ - mw->menu.font_list = mw->menu.fallback_font_list; -#endif - - make_drawing_gcs (mw); - make_shadow_gcs (mw); - extract_font_extents (mw); - - xswa.background_pixel = mw->core.background_pixel; - xswa.border_pixel = mw->core.border_pixel; - mask = CWBackPixel | CWBorderPixel; - - mw->menu.popped_up = False; - mw->menu.pointer_grabbed = False; - mw->menu.next_release_must_exit = False; - - mw->menu.old_depth = 1; - mw->menu.old_stack = XtNew (widget_value*); - mw->menu.old_stack_length = 1; - mw->menu.old_stack [0] = mw->menu.contents; - - mw->menu.new_depth = 0; - mw->menu.new_stack = 0; - mw->menu.new_stack_length = 0; - push_new_stack (mw, mw->menu.contents); - - mw->menu.windows = XtNew (window_state); - mw->menu.windows_length = 1; - mw->menu.windows [0].x = 0; - mw->menu.windows [0].y = 0; - mw->menu.windows [0].width = 0; - mw->menu.windows [0].height = 0; - size_menu (mw, 0); - - mw->core.width = mw->menu.windows [0].width; - mw->core.height = mw->menu.windows [0].height; -} - -static void -XlwMenuClassInitialize (void) -{ - initialize_massaged_resource_char(); -} - -static void -XlwMenuRealize (Widget w, Mask *valueMask, XSetWindowAttributes *attributes) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - XSetWindowAttributes xswa; - int mask; - - (*xlwMenuWidgetClass->core_class.superclass->core_class.realize) - (w, valueMask, attributes); - - xswa.save_under = True; - xswa.cursor = mw->menu.cursor_shape; - mask = CWSaveUnder | CWCursor; - if (mw->menu.use_backing_store) - { - xswa.backing_store = Always; - mask |= CWBackingStore; - } - XChangeWindowAttributes (XtDisplay (w), XtWindow (w), mask, &xswa); - - mw->menu.windows [0].window = XtWindow (w); - mw->menu.windows [0].x = w->core.x; - mw->menu.windows [0].y = w->core.y; - mw->menu.windows [0].width = w->core.width; - mw->menu.windows [0].height = w->core.height; -} - -/* Only the toplevel menubar/popup is a widget so it's the only one that - receives expose events through Xt. So we repaint all the other panes - when receiving an Expose event. */ -static void -XlwMenuRedisplay (Widget w, XEvent *ev, Region region) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - int i; - - if (mw->core.being_destroyed) return; - - for (i = 0; i < mw->menu.old_depth; i++) - display_menu (mw, i, False, NULL, NULL, NULL, NULL, NULL); - set_new_state (mw, NULL, mw->menu.old_depth); /* #### - ??? */ - remap_menubar (mw); /* #### - do these two lines do anything? */ -} - -static void -XlwMenuDestroy (Widget w) -{ - int i; - XlwMenuWidget mw = (XlwMenuWidget) w; - - if (mw->menu.pointer_grabbed) - { - XtUngrabPointer (w, CurrentTime); - mw->menu.pointer_grabbed = False; - } - - release_drawing_gcs (mw); - release_shadow_gcs (mw); - - /* this doesn't come from the resource db but is created explicitly - so we must free it ourselves. */ - XFreePixmap (XtDisplay (mw), mw->menu.gray_pixmap); - mw->menu.gray_pixmap = (Pixmap) -1; - - /* Don't free mw->menu.contents because that comes from our creator. - The `*_stack' elements are just pointers into `contents' so leave - that alone too. But free the stacks themselves. */ - if (mw->menu.old_stack) XtFree ((char *) mw->menu.old_stack); - if (mw->menu.new_stack) XtFree ((char *) mw->menu.new_stack); - - /* Remember, you can't free anything that came from the resource - database. This includes: - mw->menu.cursor - mw->menu.top_shadow_pixmap - mw->menu.bottom_shadow_pixmap - mw->menu.font - mw->menu.font_set - Also the color cells of top_shadow_color, bottom_shadow_color, - foreground, and button_foreground will never be freed until this - client exits. Nice, eh? - */ - - /* start from 1 because the one in slot 0 is w->core.window */ - for (i = 1; i < mw->menu.windows_length; i++) - XDestroyWindow (XtDisplay (mw), mw->menu.windows [i].window); - if (mw->menu.windows) - XtFree ((char *) mw->menu.windows); -} - -static Boolean -XlwMenuSetValues (Widget current, Widget request, Widget new, ArgList args, - Cardinal *num_args) -{ - XlwMenuWidget oldmw = (XlwMenuWidget)current; - XlwMenuWidget newmw = (XlwMenuWidget)new; - Boolean redisplay = False; - int i; - - if (newmw->menu.contents - && newmw->menu.contents->contents - && newmw->menu.contents->contents->change >= VISIBLE_CHANGE) - redisplay = True; - - if (newmw->core.background_pixel != oldmw->core.background_pixel - || newmw->menu.foreground != oldmw->menu.foreground - /* For the XEditResource protocol, which may want to change the font. */ -#ifdef NEED_MOTIF - || newmw->menu.font_list != oldmw->menu.font_list - || newmw->menu.font_list_2 != oldmw->menu.font_list_2 - || newmw->menu.fallback_font_list != oldmw->menu.fallback_font_list -#else - || newmw->menu.font != oldmw->menu.font -#endif - ) - { - release_drawing_gcs (newmw); - make_drawing_gcs (newmw); - redisplay = True; - - for (i = 0; i < oldmw->menu.windows_length; i++) - { - XSetWindowBackground (XtDisplay (oldmw), - oldmw->menu.windows [i].window, - newmw->core.background_pixel); - /* clear windows and generate expose events */ - XClearArea (XtDisplay (oldmw), oldmw->menu.windows[i].window, - 0, 0, 0, 0, True); - } - } - - return redisplay; -} - -static void -XlwMenuResize (Widget w) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - - mw->menu.windows [0].width = mw->core.width; - mw->menu.windows [0].height = mw->core.height; -} - - /* Action procedures */ -static void -handle_single_motion_event (XlwMenuWidget mw, XMotionEvent *ev, - Boolean select_p) -{ - widget_value *val; - Boolean stay_up; - int level; - - if (!map_event_to_widget_value (mw, ev, &val, &level, &stay_up)) - { - /* we wind up here when: (a) the event is in the menubar, (b) the - event isn't in the menubar or any of the panes, (c) the event is on - a disabled menu item */ - pop_new_stack_if_no_contents (mw); - if (select_p && !stay_up) { - /* pop down all menus and exit */ - mw->menu.next_release_must_exit = True; - set_new_state(mw, (val = NULL), 1); - } - } - else - { - /* we wind up here when: (a) the event pops up a pull_right menu, - (b) a menu item that is not disabled is highlighted */ - if (select_p && mw->menu.bounce_down - && close_to_reference_time((Widget)mw, - mw->menu.menu_bounce_time, - (XEvent *)ev)) - { - /* motion can cause more than one event. Don't bounce right back - up if we've just bounced down. */ - val = NULL; - } - else if (select_p && mw->menu.bounce_down && - mw->menu.last_selected_val && - (mw->menu.last_selected_val == val)) - { - val = NULL; /* assigned to mw->last_selected_val below */ - mw->menu.menu_bounce_time = ev->time; - /* popdown last menu if we're selecting the same menu item as we did - last time and the XlwMenu.bounceDown resource is set, if the - item is on the menubar itself, then exit. */ - if (level == (mw->menu.popped_up ? 0 : 1)) - mw->menu.next_release_must_exit = True; - } - else - mw->menu.menu_bounce_time = 0; - set_new_state (mw, val, level); - } - mw->menu.last_selected_val = val; - remap_menubar (mw); - - /* Sync with the display. Makes it feel better on X terms. */ - XFlush (XtDisplay (mw)); -} - -static void -handle_motion_event (XlwMenuWidget mw, XMotionEvent *ev, - Boolean select_p) -{ - int x = ev->x_root; - int y = ev->y_root; - unsigned int state = ev->state; - XMotionEvent *event= ev, dummy; - - /* allow motion events to be generated again */ - dummy.window = ev->window; - if (ev->is_hint - && XQueryPointer (XtDisplay (mw), dummy.window, - &dummy.root, &dummy.subwindow, - &dummy.x_root, &dummy.y_root, - &dummy.x, &dummy.y, - &dummy.state) - && dummy.state == state - && (dummy.x_root != x || dummy.y_root != y)) - { - /* don't handle the event twice or that breaks bounce_down. --Stig */ - dummy.type = ev->type; - event = &dummy; - } - - lw_menu_accelerate = False; - handle_single_motion_event (mw, event, select_p); -} - -Time x_focus_timestamp_really_sucks_fix_me_better; - -static void -Start (Widget w, XEvent *ev, String *params, Cardinal *num_params) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - - lw_menubar_widget = w; - - lw_menu_active = True; - - if (!mw->menu.pointer_grabbed) - { - mw->menu.menu_post_time = ev->xbutton.time; - mw->menu.menu_bounce_time = 0; - mw->menu.next_release_must_exit = True; - mw->menu.last_selected_val = NULL; - x_focus_timestamp_really_sucks_fix_me_better = - ((XButtonPressedEvent*)ev)->time; - XtCallCallbackList ((Widget)mw, mw->menu.open, NULL); - - /* notes the absolute position of the menubar window */ - mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; - mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; - - XtGrabPointer ((Widget)mw, False, - (ButtonMotionMask | ButtonReleaseMask | ButtonPressMask), - GrabModeAsync, GrabModeAsync, - None, mw->menu.cursor_shape, - ((XButtonPressedEvent*)ev)->time); - mw->menu.pointer_grabbed = True; - } - - /* handles the down like a move, slots are mostly compatible */ - handle_motion_event (mw, &ev->xmotion, True); -} - -static void -Drag (Widget w, XEvent *ev, String *params, Cardinal *num_params) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - handle_motion_event (mw, &ev->xmotion, False); -} - -static void -Select (Widget w, XEvent *ev, String *params, Cardinal *num_params) -{ - XlwMenuWidget mw = (XlwMenuWidget)w; - widget_value *selected_item = mw->menu.old_stack [mw->menu.old_depth - 1]; - - lw_menu_accelerate = False; - - /* If user releases the button quickly, without selecting anything, - after the initial down-click that brought the menu up, - do nothing. */ - if ((selected_item == 0 || selected_item->call_data == 0) - && (!mw->menu.next_release_must_exit - || close_to_reference_time(w, mw->menu.menu_post_time, ev))) - { - mw->menu.next_release_must_exit = False; - return; - } - - /* pop down everything */ - mw->menu.new_depth = 1; - remap_menubar (mw); - - /* Destroy() only gets called for popup menus. Menubar widgets aren't - destroyed when their menu panes get nuked. */ - if (mw->menu.pointer_grabbed) - { - XtUngrabPointer ((Widget)w, ev->xmotion.time); - mw->menu.pointer_grabbed = False; - } - - if (mw->menu.popped_up) - { - mw->menu.popped_up = False; - XtPopdown (XtParent (mw)); - } - - lw_menu_active = False; - - x_focus_timestamp_really_sucks_fix_me_better = - ((XButtonPressedEvent*)ev)->time; - - /* callback */ - XtCallCallbackList ((Widget) mw, mw->menu.select, (XtPointer) selected_item); -} - - /* Action procedures for keyboard accelerators */ - -/* set the menu */ -void -xlw_set_menu (Widget w, widget_value *val) -{ - lw_menubar_widget = w; - set_new_state ((XlwMenuWidget)w, val, 1); -} - -/* prepare the menu structure via the call-backs */ -void -xlw_map_menu (Time t) -{ - XlwMenuWidget mw = (XlwMenuWidget)lw_menubar_widget; - - lw_menu_accelerate = True; - - if (!mw->menu.pointer_grabbed) - { - XWindowAttributes ret; - Window parent,root; - Window *waste; - unsigned int num_waste; - - lw_menu_active = True; - - mw->menu.menu_post_time = t; - mw->menu.menu_bounce_time = 0; - - mw->menu.next_release_must_exit = True; - mw->menu.last_selected_val = NULL; - - XtCallCallbackList ((Widget)mw, mw->menu.open, NULL); - - /* do this for keyboards too! */ - /* notes the absolute position of the menubar window */ - /* - mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; - mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; - */ - - /* get the geometry of the menubar */ - - /* there has to be a better way than this. */ - - mw->menu.windows [0].x = 0; - mw->menu.windows [0].y = 0; - - parent = XtWindow (lw_menubar_widget); - do - { - XGetWindowAttributes (XtDisplay (lw_menubar_widget), parent, &ret); - mw->menu.windows [0].x += ret.x; - mw->menu.windows [0].y += ret.y; - - if (parent) - XQueryTree (XtDisplay (lw_menubar_widget), parent, &root, &parent, &waste, - &num_waste); - if (waste) - { - XFree (waste); - } - } - while (parent != root); - - XtGrabPointer ((Widget)mw, False, - (ButtonMotionMask | ButtonReleaseMask | ButtonPressMask), - GrabModeAsync, GrabModeAsync, - None, mw->menu.cursor_shape, t); - mw->menu.pointer_grabbed = True; - } -} - -/* display the stupid menu already */ -void -xlw_display_menu (Time t) -{ - XlwMenuWidget mw = (XlwMenuWidget)lw_menubar_widget; - - lw_menu_accelerate = True; - - remap_menubar (mw); - - /* Sync with the display. Makes it feel better on X terms. */ - XFlush (XtDisplay (mw)); -} - -/* push a sub menu */ -void -xlw_push_menu (widget_value *val) -{ - push_new_stack ((XlwMenuWidget)lw_menubar_widget, val); -} - -/* pop a sub menu */ -int -xlw_pop_menu (void) -{ - if (((XlwMenuWidget)lw_menubar_widget)->menu.new_depth > 0) - ((XlwMenuWidget)lw_menubar_widget)->menu.new_depth --; - else - return 0; - return 1; -} - -void -xlw_kill_menus (widget_value *val) -{ - XlwMenuWidget mw = (XlwMenuWidget)lw_menubar_widget; - - lw_menu_accelerate = False; - - mw->menu.new_depth = 1; - remap_menubar (mw); - - if (mw->menu.pointer_grabbed) - { - XtUngrabPointer (lw_menubar_widget, CurrentTime); - mw->menu.pointer_grabbed = False; - } - - lw_menu_active = False; - XtCallCallbackList (lw_menubar_widget, mw->menu.select, (XtPointer)val); -} - -/* set the menu item */ -void -xlw_set_item (widget_value *val) -{ - if (((XlwMenuWidget)lw_menubar_widget)->menu.new_depth > 0) - ((XlwMenuWidget) lw_menubar_widget)->menu.new_depth --; - push_new_stack ((XlwMenuWidget) lw_menubar_widget, val); -} - -/* get either the current entry or a list of all entries in the current submenu */ -widget_value * -xlw_get_entries (int allp) -{ - XlwMenuWidget mw = (XlwMenuWidget)lw_menubar_widget; - if (allp) - { - if (mw->menu.new_depth >= 2) - return mw->menu.new_stack [mw->menu.new_depth - 2]->contents; - else - return mw->menu.new_stack[0]; - } - else - if (mw->menu.new_depth >= 1) - return mw->menu.new_stack [mw->menu.new_depth - 1]; - - return NULL; -} - -int -xlw_menu_level (void) -{ - return ((XlwMenuWidget)lw_menubar_widget)->menu.new_depth; -} - - -/* Special code to pop-up a menu */ -void -xlw_pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) -{ - int x = event->x_root; - int y = event->y_root; - int w; - int h; - int borderwidth = mw->menu.shadow_thickness; - Screen* screen = XtScreen (mw); - - mw->menu.menu_post_time = event->time; - mw->menu.menu_bounce_time = 0; - mw->menu.next_release_must_exit = True; - mw->menu.last_selected_val = NULL; - - XtCallCallbackList ((Widget) mw, mw->menu.open, NULL); - - size_menu (mw, 0); - - w = mw->menu.windows [0].width; - h = mw->menu.windows [0].height; - - x -= borderwidth; - y -= borderwidth; - - if (x < borderwidth) - x = borderwidth; - - if (x > WidthOfScreen (screen) - w - 2 * borderwidth) - x = WidthOfScreen (screen) - w - 2 * borderwidth; - - if (y < borderwidth) - y = borderwidth; - - if (y > HeightOfScreen (screen) - h - 2 * borderwidth) - y = HeightOfScreen (screen) - h - 2 * borderwidth; - - mw->menu.popped_up = True; - XtConfigureWidget (XtParent (mw), x, y, w, h, - XtParent (mw)->core.border_width); - XtPopup (XtParent (mw), XtGrabExclusive); - display_menu (mw, 0, False, NULL, NULL, NULL, NULL, NULL); - if (!mw->menu.pointer_grabbed) - { - XtGrabPointer ((Widget)mw, False, - (ButtonMotionMask | ButtonReleaseMask | ButtonPressMask), - GrabModeAsync, GrabModeAsync, - None, mw->menu.cursor_shape, event->time); - mw->menu.pointer_grabbed = True; - } - - mw->menu.windows [0].x = x + borderwidth; - mw->menu.windows [0].y = y + borderwidth; - - handle_motion_event (mw, (XMotionEvent *) event, True); -} - -/* #### unused */ -#if 0 -/* - * This is a horrible function which should not be needed. - * use it to put the resize method back the way the XlwMenu - * class initializer put it. Motif screws with this when - * the XlwMenu class gets instantiated. - */ -void -xlw_unmunge_class_resize (Widget w) -{ - if (w->core.widget_class->core_class.resize != XlwMenuResize) - w->core.widget_class->core_class.resize = XlwMenuResize; -} -#endif /* 0 */ - diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h deleted file mode 100644 index f799fc5..0000000 --- a/lwlib/xlwmenu.h +++ /dev/null @@ -1,93 +0,0 @@ -#ifndef _XlwMenu_h -#define _XlwMenu_h - -/*********************************************************************** - * - * XlwMenu Widget - * - ***********************************************************************/ - -#include "lwlib.h" - -/* Resource names used by the XlwMenu widget */ -#define XtNbuttonForeground "buttonForeground" -#define XtCButtonForeground "ButtonForeground" -#define XtNhighlightForeground "highlightForeground" -#define XtCHighlightForeground "HighlightForeground" -#define XtNtitleForeground "titleForeground" -#define XtCTitleForeground "TitleForeground" -#define XtNmargin "margin" -#define XtNhorizontalSpacing "horizontalSpacing" -#define XtNverticalSpacing "verticalSpacing" -#define XtNarrowSpacing "arrowSpacing" -#define XtNmenu "menu" -#define XtCMenu "Menu" -#define XtNopen "open" -#define XtNselect "select" -#define XtNmenuBorderWidth "menuBorderWidth" -#define XtNhorizontal "horizontal" -#define XtCHorizontal "Horizontal" -#ifndef XtNcursor -#define XtNcursor "cursor" -#endif -#ifndef XtCCursor -#define XtCCursor "Cursor" -#endif -#ifndef XtNuseBackingStore -#define XtNuseBackingStore "useBackingStore" -#endif -#ifndef XtCUseBackingStore -#define XtCUseBackingStore "UseBackingStore" -#endif -#define XtNbounceDown "bounceDown" -#define XtCBounceDown "BounceDown" -#define XtNresourceLabels "resourceLabels" -#define XtCResourceLabels "ResourceLabels" - -/* Motif-compatible resource names */ -#ifndef XmNshadowThickness -# define XmNshadowThickness "shadowThickness" -# define XmCShadowThickness "ShadowThickness" -# define XmNtopShadowColor "topShadowColor" -# define XmCTopShadowColor "TopShadowColor" -# define XmNbottomShadowColor "bottomShadowColor" -# define XmCBottomShadowColor "BottomShadowColor" -# define XmNtopShadowPixmap "topShadowPixmap" -# define XmCTopShadowPixmap "TopShadowPixmap" -# define XmNbottomShadowPixmap "bottomShadowPixmap" -# define XmCBottomShadowPixmap "BottomShadowPixmap" -# define XmRHorizontalDimension "HorizontalDimension" -# define XmNspacing "spacing" -# define XmCSpacing "Spacing" -# define XmNindicatorSize "indicatorSize" -# define XmCIndicatorSize "IndicatorSize" -# define XmNselectColor "selectColor" -# define XmCSelectColor "SelectColor" -# define XmNmarginHeight "marginHeight" -# define XmCMarginHeight "MarginHeight" -# define XmNmarginWidth "marginWidth" -# define XmCMarginWidth "MarginWidth" -# define XmRVerticalDimension "VerticalDimension" -#endif - -typedef struct _XlwMenuRec *XlwMenuWidget; -typedef struct _XlwMenuClassRec *XlwMenuWidgetClass; - -extern WidgetClass xlwMenuWidgetClass; - -void -xlw_pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent* event); - -/* menu accelerator */ - -void xlw_set_menu (Widget w, widget_value *val); -void xlw_push_menu (widget_value *val); -int xlw_pop_menu (void); -void xlw_set_item (widget_value *val); -void xlw_map_menu (Time t); -void xlw_display_menu (Time t); -void xlw_kill_menus (widget_value *val); -widget_value *xlw_get_entries (int allp); -int xlw_menu_level (void); - -#endif /* _XlwMenu_h */ diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h deleted file mode 100644 index 9b87463..0000000 --- a/lwlib/xlwmenuP.h +++ /dev/null @@ -1,120 +0,0 @@ -#ifndef _XlwMenuP_h -#define _XlwMenuP_h - -#include "xlwmenu.h" -#include - -/* Elements in the stack arrays. */ -typedef struct _window_state -{ - Window window; - Position x; - Position y; - Dimension width; - Dimension height; - Dimension label_width; - Dimension toggle_width; -} window_state; - - -/* New fields for the XlwMenu widget instance record */ -typedef struct _XlwMenu_part -{ - /* slots set by the resources */ - -#ifdef NEED_MOTIF - XmFontList font_list; - XmFontList font_list_2; - XmFontList fallback_font_list; -#else - XFontStruct * font; -# ifdef USE_XFONTSET - XFontSet font_set; -# endif -#endif - Dimension font_ascent, font_descent; /* extracted from font/fontlist */ - - Pixel foreground; - Pixel button_foreground; - Pixel highlight_foreground; - Pixel title_foreground; - Dimension margin; - Dimension horizontal_margin; - Dimension vertical_margin; - Dimension column_spacing; - Dimension shadow_thickness; - Dimension indicator_size; - Pixel top_shadow_color; - Pixel bottom_shadow_color; - Pixel select_color; - Pixmap top_shadow_pixmap; - Pixmap bottom_shadow_pixmap; - Cursor cursor_shape; - XtCallbackList open; - XtCallbackList select; - widget_value* contents; - int horizontal; - Boolean use_backing_store; - Boolean bounce_down; - Boolean lookup_labels; - - /* State of the XlwMenu */ - int old_depth; - widget_value** old_stack; - int old_stack_length; - - /* New state after the user moved */ - int new_depth; - widget_value** new_stack; - int new_stack_length; - - /* Window resources */ - window_state* windows; - int windows_length; - - /* Internal part, set by the XlwMenu */ - GC foreground_gc; - GC button_gc; - GC background_gc; - GC inactive_gc; - GC inactive_button_gc; - GC shadow_top_gc; - GC shadow_bottom_gc; - GC select_gc; - GC highlight_gc; - GC title_gc; - Cursor cursor; - Boolean popped_up; - Pixmap gray_pixmap; - - /* Stay-up stuff */ - Boolean pointer_grabbed; - Boolean next_release_must_exit; - Time menu_post_time, menu_bounce_time; - widget_value * last_selected_val; -} XlwMenuPart; - -/* Full instance record declaration */ -typedef struct _XlwMenuRec -{ - CorePart core; - XlwMenuPart menu; -} XlwMenuRec; - -/* New fields for the XlwMenu widget class record */ -typedef struct -{ - int dummy; -} XlwMenuClassPart; - -/* Full class record declaration. */ -typedef struct _XlwMenuClassRec -{ - CoreClassPart core_class; - XlwMenuClassPart menu_class; -} XlwMenuClassRec; - -/* Class pointer. */ -extern XlwMenuClassRec xlwMenuClassRec; - -#endif /* _XlwMenuP_h */ diff --git a/lwlib/xlwscrollbar.c b/lwlib/xlwscrollbar.c deleted file mode 100644 index 81f8cdb..0000000 --- a/lwlib/xlwscrollbar.c +++ /dev/null @@ -1,1919 +0,0 @@ -/* Implements a lightweight scrollbar widget. - Copyright (C) 1992, 1993, 1994 Lucid, Inc. - Copyright (C) 1997 Sun Microsystems, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -/* Created by Douglas Keller */ -/* Lots of hacking by Martin Buchholz */ - -/* - * Athena-style scrollbar button bindings added on Sun Dec 24 22:03:57 1995 - * by Jonathan Stigelman ... Ho ho ho! - * - * To use them, put this resource in your .Xdefaults - * - * Emacs*XlwScrollBar.translations: #override \n\ - * : PageDownOrRight() \n\ - * : PageUpOrLeft() - * - */ - -/* - * Resources Supported: - * XmNforeground - * XmNbackground - * XmNtopShadowColor - * XmNtopShadowPixmap - * XmNbottomShadowColor - * XmNbottomShadowPixmap - * XmNtroughColor - * XmNshadowThickness - * XmNshowArrows - * XmNorientation - * XmNborderWidth - * - * XmNminimum - * XmNmaximum - * XmNvalue - * XmNincrement - * XmNpageIncrement - * - * XmNvalueChangedCallback - * XmNincrementCallback - * XmNdecrementCallback - * XmNpageIncrementCallback - * XmNpageDecrementCallback - * XmNtoTopCallback - * XmNtoBottomCallback - * XmNdragCallback - * - * XmNsliderStyle - values can be: "plain" or "dimple" - * XmNarrowPosition - values can be: "opposite" or "same" - * - */ - -#include -#include -#include -#include - -#include -#include -#include - -#include "xlwscrollbarP.h" -#include "xlwscrollbar.h" - -#ifdef USE_DEBUG_MALLOC -#include -#endif - -#define DBUG(x) - -#define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ - ? ((unsigned long) (x)) : ((unsigned long) (y))) - -#define VERT(w) ((w)->sb.orientation == XmVERTICAL) - -#define SS_MIN 8 - -typedef enum -{ - BUTTON_NONE, - BUTTON_SLIDER, - BUTTON_UP_ARROW, - BUTTON_DOWN_ARROW, - BUTTON_TROUGH_ABOVE, - BUTTON_TROUGH_BELOW -} button_where; - -typedef enum -{ - SLIDER_PLAIN, - SLIDER_DIMPLE -} SliderStyle; - -/*-------------------------- Resources ----------------------------------*/ -#define offset(field) XtOffset(XlwScrollBarWidget, field) - -static XtResource resources[] = { - { XmNforeground, XmCForeground, XtRPixel, sizeof(Pixel), - offset(sb.foreground), XtRImmediate, (XtPointer) XtDefaultForeground }, - - { XmNtopShadowColor, XmCTopShadowColor, XtRPixel, - sizeof(Pixel), offset(sb.topShadowColor), XtRImmediate, (XtPointer) ~0 }, - { XmNbottomShadowColor, XmCBottomShadowColor, XtRPixel, - sizeof(Pixel), offset(sb.bottomShadowColor), XtRImmediate, - (XtPointer)~0 }, - - { XmNtopShadowPixmap, XmCTopShadowPixmap, XtRPixmap, - sizeof (Pixmap), offset(sb.topShadowPixmap), XtRImmediate, - (XtPointer)None}, - { XmNbottomShadowPixmap, XmCBottomShadowPixmap, - XtRPixmap, sizeof (Pixmap), offset(sb.bottomShadowPixmap), - XtRImmediate, (XtPointer)None}, - - { XmNtroughColor, XmCTroughColor, XtRPixel, sizeof(Pixel), - offset(sb.troughColor), XtRImmediate, (XtPointer)~0 }, - - { XmNshadowThickness, XmCShadowThickness, XtRInt, - sizeof(int), offset(sb.shadowThickness), XtRImmediate, (XtPointer)2 }, - - { XmNborderWidth, XmCBorderWidth, XtRDimension, - sizeof(Dimension), offset(core.border_width), XtRImmediate, - (XtPointer)0 }, - - { XmNshowArrows, XmCShowArrows, XtRBoolean, - sizeof(Boolean), offset(sb.showArrows), XtRImmediate, (XtPointer)True }, - - { XmNinitialDelay, XmCInitialDelay, XtRInt, sizeof(int), - offset(sb.initialDelay), XtRImmediate, (XtPointer) 250 }, - { XmNrepeatDelay, XmCRepeatDelay, XtRInt, sizeof(int), - offset(sb.repeatDelay), XtRImmediate, (XtPointer) 50 }, - - { XmNorientation, XmCOrientation, XtROrientation, - sizeof(unsigned char), offset(sb.orientation), XtRImmediate, - (XtPointer) XmVERTICAL }, - - { XmNminimum, XmCMinimum, XtRInt, sizeof(int), - offset(sb.minimum), XtRImmediate, (XtPointer) 0}, - { XmNmaximum, XmCMaximum, XtRInt, sizeof(int), - offset(sb.maximum), XtRImmediate, (XtPointer) 100}, - { XmNvalue, XmCValue, XtRInt, sizeof(int), - offset(sb.value), XtRImmediate, (XtPointer) 0}, - { XmNsliderSize, XmCSliderSize, XtRInt, sizeof(int), - offset(sb.sliderSize), XtRImmediate, (XtPointer) 10}, - { XmNincrement, XmCIncrement, XtRInt, sizeof(int), - offset(sb.increment), XtRImmediate, (XtPointer) 1}, - { XmNpageIncrement, XmCPageIncrement, XtRInt, sizeof(int), - offset(sb.pageIncrement), XtRImmediate, (XtPointer) 10}, - - { XmNvalueChangedCallback, XmCValueChangedCallback, - XtRCallback, sizeof(XtPointer), offset(sb.valueChangedCBL), - XtRCallback, NULL}, - { XmNincrementCallback, XmCIncrementCallback, - XtRCallback, sizeof(XtPointer), offset(sb.incrementCBL), - XtRCallback, NULL}, - { XmNdecrementCallback, XmCDecrementCallback, - XtRCallback, sizeof(XtPointer), offset(sb.decrementCBL), - XtRCallback, NULL}, - { XmNpageIncrementCallback, XmCPageIncrementCallback, - XtRCallback, sizeof(XtPointer), offset(sb.pageIncrementCBL), - XtRCallback, NULL}, - { XmNpageDecrementCallback, XmCPageDecrementCallback, - XtRCallback, sizeof(XtPointer), offset(sb.pageDecrementCBL), - XtRCallback, NULL}, - { XmNtoTopCallback, XmCToTopCallback, XtRCallback, - sizeof(XtPointer), offset(sb.toTopCBL), XtRCallback, NULL}, - { XmNtoBottomCallback, XmCToBottomCallback, XtRCallback, - sizeof(XtPointer), offset(sb.toBottomCBL), XtRCallback, NULL}, - { XmNdragCallback, XmCDragCallback, XtRCallback, - sizeof(XtPointer), offset(sb.dragCBL), XtRCallback, NULL}, - - /* "knob" is obsolete; use "slider" instead. */ - { XmNsliderStyle, XmCSliderStyle, XtRString, sizeof(char *), - offset(sb.sliderStyle), XtRImmediate, NULL}, - { XmNknobStyle, XmCKnobStyle, XtRString, sizeof(char *), - offset(sb.knobStyle), XtRImmediate, NULL}, - - { XmNarrowPosition, XmCArrowPosition, XtRString, sizeof(char *), - offset(sb.arrowPosition), XtRImmediate, NULL}, -}; - -/*-------------------------- Prototypes ---------------------------------*/ - -/* Actions */ -typedef void Action(Widget w, XEvent *event, String *parms, Cardinal *num_parms); -static Action Select, PageUpOrLeft, PageDownOrRight, Drag, Release, Jump, Abort; - -/* Methods */ -static void Initialize(Widget treq, Widget tnew, ArgList args, Cardinal *num_args); -static Boolean SetValues(Widget current, Widget request, Widget nw, ArgList args, Cardinal *num_args); -static void Destroy(Widget widget); -static void Redisplay(Widget widget, XEvent *event, Region region); -static void Resize(Widget widget); -static void Realize(Widget widget, XtValueMask *valuemask, XSetWindowAttributes *attr); - -/* Private */ - -/*-------------------------- Actions Table ------------------------------*/ -static XtActionsRec actions[] = -{ - {"Select", Select}, - {"PageDownOrRight", PageDownOrRight}, - {"PageUpOrLeft", PageUpOrLeft}, - {"Drag", Drag}, - {"Release", Release}, - {"Jump", Jump}, - {"Abort", Abort}, -}; - -/*--------------------- Default Translation Table -----------------------*/ -static char default_translations[] = - ": Select()\n" - ": Drag()\n" - ": Release()\n" - ": Jump()\n" - ": Drag()\n" - ": Release()\n" - "Delete: Abort()" -; - -/*------------------- Class record initialization -----------------------*/ -XlwScrollBarClassRec xlwScrollBarClassRec = { - /* core_class fields */ - { - /* superclass */ (WidgetClass) &coreClassRec, - /* class_name */ "XlwScrollBar", - /* widget_size */ sizeof(XlwScrollBarRec), - /* class_initialize */ NULL, - /* class_part_init */ NULL, - /* class_inited */ False, - /* initialize */ Initialize, - /* initialize_hook */ NULL, - /* realize */ Realize, - /* actions */ actions, - /* num_actions */ XtNumber(actions), - /* resources */ resources, - /* num_resources */ XtNumber(resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ True, - /* compress_exposure */ XtExposeCompressMultiple, - /* compress_enterleave */ True, - /* visible_interest */ False, - /* destroy */ Destroy, - /* resize */ Resize, - /* expose */ Redisplay, - /* set_values */ SetValues, - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, - /* accept_focus */ NULL, - /* version */ XtVersionDontCheck, - /* callback_private */ NULL, - /* tm_table */ default_translations, - /* query_geometry */ NULL, - }, - /* scrollbar_class fields */ - { - /* dummy_field */ 0, - }, -}; - -WidgetClass xlwScrollBarWidgetClass = (WidgetClass) &xlwScrollBarClassRec; - -/*-------------------------- Debug Functions ----------------------------*/ - -#ifdef SHOW_CLEAR -static void -myXClearArea(Display *dpy, Drawable d, int x, int y, int w, int h, - Boolean exp, XlwScrollBarWidget widget) -{ - XFillRectangle (dpy, d, widget->sb.topShadowGC, x, y, w, h); - XSync (dpy, False); - sleep (2); - XClearArea (dpy, d, x, y, w, h, exp); -} - -#define XClearArea(dpy,win,x,y,width,height,exp) myXClearArea(dpy,win,x,y,width,height,exp,w) -#endif - -#ifdef CHECK_VALUES -static void -check(XlwScrollBarWidget w) -{ - int height = widget_h (w); - if (w->sb.showArrows) - height -= (2 * arrow_h (w)); - - if ((w->sb.above + w->sb.ss + w->sb.below > height) || - (w->sb.value < w->sb.minimum) || - (w->sb.value > w->sb.maximum - w->sb.sliderSize)) - { - printf("above=%d ss=%d below=%d height=%d\n", - w->sb.above, w->sb.ss, w->sb.below, height); - printf("value=%d min=%d max=%d ss=%d max-ss=%d\n", - w->sb.value, w->sb.minimum, w->sb.maximum, - w->sb.sliderSize, w->sb.maximum - w->sb.sliderSize); - abort(); - } -} - -# define CHECK(w) check(w) -#else -# define CHECK(w) -#endif - -/*-------------------------- Static functions ---------------------------*/ - -static void -call_callbacks (XlwScrollBarWidget w, int reason, - int value, int pixel, XEvent *event) -{ - XlwScrollBarCallbackStruct cbs; - Boolean called_anything; - - cbs.reason = reason; - cbs.event = event; - cbs.value = value; - cbs.pixel = pixel; - - called_anything = False; - - switch (reason) - { - case XmCR_VALUE_CHANGED: - XtCallCallbackList ((Widget) w, w->sb.valueChangedCBL, &cbs); - called_anything = True; - break; - case XmCR_INCREMENT: - if (w->sb.incrementCBL) - { - XtCallCallbackList ((Widget) w, w->sb.incrementCBL, &cbs); - called_anything = True; - } - break; - case XmCR_DECREMENT: - if (w->sb.decrementCBL) - { - XtCallCallbackList ((Widget) w, w->sb.decrementCBL, &cbs); - called_anything = True; - } - break; - case XmCR_PAGE_INCREMENT: - if (w->sb.incrementCBL) - { - XtCallCallbackList ((Widget) w, w->sb.pageIncrementCBL, &cbs); - called_anything = True; - } - break; - case XmCR_PAGE_DECREMENT: - if (w->sb.decrementCBL) - { - XtCallCallbackList ((Widget) w, w->sb.pageDecrementCBL, &cbs); - called_anything = True; - } - break; - case XmCR_TO_TOP: - if (w->sb.toTopCBL) - { - XtCallCallbackList ((Widget) w, w->sb.toTopCBL, &cbs); - called_anything = True; - } - break; - case XmCR_TO_BOTTOM: - if (w->sb.toBottomCBL) - { - XtCallCallbackList ((Widget) w, w->sb.toBottomCBL, &cbs); - called_anything = True; - } - break; - case XmCR_DRAG: - if (w->sb.dragCBL) - { - XtCallCallbackList ((Widget) w, w->sb.dragCBL, &cbs); - } - called_anything = True; /* Special Case */ - break; - } - - if (!called_anything) - { - cbs.reason = XmCR_VALUE_CHANGED; - XtCallCallbackList ((Widget) w, w->sb.valueChangedCBL, &cbs); - } -} - -/* Widget sizes minus the shadow and highlight area */ - -static int -widget_x (XlwScrollBarWidget w) -{ - return w->sb.shadowThickness; -} - -static int -widget_y (XlwScrollBarWidget w) -{ - return w->sb.shadowThickness; -} - -static int -widget_w (XlwScrollBarWidget w) -{ - int x = w->sb.shadowThickness; - int width = (VERT (w) ? w->core.width : w->core.height) - (2 * x); - return width > 1 ? width : 1; -} - -static int -widget_h (XlwScrollBarWidget w) -{ - int y = w->sb.shadowThickness; - int height = (VERT (w) ? w->core.height : w->core.width) - (2 * y); - - return height > 1 ? height : 1; -} - -static int -arrow_h (XlwScrollBarWidget w) -{ - int width = widget_w (w); - int minimum_size = ((widget_h (w) - SS_MIN) / 2) - 1; - return minimum_size < width ? minimum_size : width; -} - -static int -event_x (XlwScrollBarWidget w, XEvent *event) -{ - return VERT (w) ? event->xbutton.x : event->xbutton.y; -} - -static int -event_y (XlwScrollBarWidget w, XEvent *event) -{ - return VERT (w) ? event->xbutton.y : event->xbutton.x; -} - -/* Safe addition and subtraction */ -static void -increment_value (XlwScrollBarWidget w, int diff) -{ - w->sb.value = w->sb.maximum - diff < w->sb.value ? - w->sb.maximum : - w->sb.value + diff; -} - -static void -decrement_value (XlwScrollBarWidget w, int diff) -{ - w->sb.value = w->sb.minimum + diff > w->sb.value ? - w->sb.minimum : - w->sb.value - diff; -} - -static SliderStyle -slider_style (XlwScrollBarWidget w) -{ - return (w->sb.sliderStyle ? w->sb.sliderStyle[0] == 'd' : - w->sb.knobStyle ? w->sb.knobStyle[0] == 'd' : - 0) ? - SLIDER_DIMPLE : - SLIDER_PLAIN; -} - -static Boolean -arrow_same_end (XlwScrollBarWidget w) -{ - return w->sb.arrowPosition && w->sb.arrowPosition[0] == 's' ? True : False; -} - -/*-------------------------- GC and Pixel allocation --------------------*/ -#ifdef NEED_MOTIF -#ifndef XmUNSPECIFIED_PIXMAP -#define XmUNSPECIFIED_PIXMAP 2 -#endif -#endif /* NEED_MOTIF */ - -static GC -get_gc (XlwScrollBarWidget w, Pixel fg, Pixel bg, Pixmap pm) -{ - XGCValues values; - XtGCMask mask; - - if (pm == w->sb.grayPixmap) - { - /* If we're using the gray pixmap, guarantee white on black ... - * otherwise, we could end up with something odd like grey on white - * when we're on a color display that ran out of color cells - */ - - fg = WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay (w))); - bg = BlackPixelOfScreen (DefaultScreenOfDisplay (XtDisplay (w))); - } - - values.foreground = fg; - values.background = bg; - values.fill_style = FillOpaqueStippled; - values.stipple = pm; -/* mask = GCForeground | GCBackground | - (pm == None ? 0 : GCStipple | GCFillStyle); gtb */ -#ifdef NEED_MOTIF - if (pm != None && pm != 0 && pm != XmUNSPECIFIED_PIXMAP) - values.stipple = pm; - else - values.stipple = None; -#else - values.stipple = pm; -#endif /* NEED_MOTIF */ - mask = GCForeground | GCBackground | - (values.stipple == None ? 0 : GCStipple | GCFillStyle); - - return XtGetGC((Widget) w, mask, &values); -} - -/* Replacement for XAllocColor() that tries to return the nearest - available color if the colormap is full. From FSF Emacs. */ - -static int -allocate_nearest_color (Display *display, Colormap screen_colormap, - XColor *color_def) -{ - int status = XAllocColor (display, screen_colormap, color_def); - if (status) - return status; - - { - /* If we got to this point, the colormap is full, so we're - going to try to get the next closest color. - The algorithm used is a least-squares matching, which is - what X uses for closest color matching with StaticColor visuals. */ - - int nearest, x; - unsigned long nearest_delta = ULONG_MAX; - - int no_cells = XDisplayCells (display, XDefaultScreen (display)); - /* Don't use alloca here because lwlib doesn't have the - necessary configuration information that src does. */ - XColor *cells = (XColor *) malloc (sizeof (XColor) * no_cells); - - for (x = 0; x < no_cells; x++) - cells[x].pixel = x; - - XQueryColors (display, screen_colormap, cells, no_cells); - - for (nearest = 0, x = 0; x < no_cells; x++) - { - long dred = (color_def->red >> 8) - (cells[x].red >> 8); - long dgreen = (color_def->green >> 8) - (cells[x].green >> 8); - long dblue = (color_def->blue >> 8) - (cells[x].blue >> 8); - unsigned long delta = dred * dred + dgreen * dgreen + dblue * dblue; - - if (delta < nearest_delta) - { - nearest = x; - nearest_delta = delta; - } - } - color_def->red = cells[nearest].red; - color_def->green = cells[nearest].green; - color_def->blue = cells[nearest].blue; - free (cells); - return XAllocColor (display, screen_colormap, color_def); - } -} - -static void -make_shadow_pixels (XlwScrollBarWidget w) -{ - Display *dpy = XtDisplay((Widget) w); - Colormap cmap = w->core.colormap; - XColor topc, botc; - int top_frobbed, bottom_frobbed; - Pixel bg, fg; - - top_frobbed = bottom_frobbed = 0; - - bg = w->core.background_pixel; - fg = w->sb.foreground; - - if (w->sb.topShadowColor == (Pixel)~0) w->sb.topShadowColor = bg; - if (w->sb.bottomShadowColor == (Pixel)~0) w->sb.bottomShadowColor = fg; - - if (w->sb.topShadowColor == bg || w->sb.topShadowColor == fg) - { - topc.pixel = bg; - XQueryColor (dpy, cmap, &topc); - /* don't overflow/wrap! */ - topc.red = MINL(65535, topc.red * 1.2); - topc.green = MINL(65535, topc.green * 1.2); - topc.blue = MINL(65535, topc.blue * 1.2); - if (allocate_nearest_color (dpy, cmap, &topc)) - { - if (topc.pixel == bg) - { - XFreeColors (dpy, cmap, &topc.pixel, 1, 0); - topc.red = MINL(65535, topc.red + 0x8000); - topc.green = MINL(65535, topc.green + 0x8000); - topc.blue = MINL(65535, topc.blue + 0x8000); - if (allocate_nearest_color (dpy, cmap, &topc)) - { - w->sb.topShadowColor = topc.pixel; - } - } - else - { - w->sb.topShadowColor = topc.pixel; - } - - top_frobbed = 1; - } - } - - if (w->sb.bottomShadowColor == fg || w->sb.bottomShadowColor == bg) - { - botc.pixel = bg; - XQueryColor (dpy, cmap, &botc); - botc.red = (botc.red * 3) / 5; - botc.green = (botc.green * 3) / 5; - botc.blue = (botc.blue * 3) / 5; - if (allocate_nearest_color (dpy, cmap, &botc)) - { - if (botc.pixel == bg) - { - XFreeColors (dpy, cmap, &botc.pixel, 1, 0); - botc.red = MINL(65535, botc.red + 0x4000); - botc.green = MINL(65535, botc.green + 0x4000); - botc.blue = MINL(65535, botc.blue + 0x4000); - if (allocate_nearest_color (dpy, cmap, &botc)) - { - w->sb.bottomShadowColor = botc.pixel; - } - } - else - { - w->sb.bottomShadowColor = botc.pixel; - } - bottom_frobbed = 1; - } - } - - if (top_frobbed && bottom_frobbed) - { - int top_avg = ((topc.red / 3) + (topc.green / 3) + (topc.blue / 3)); - int bot_avg = ((botc.red / 3) + (botc.green / 3) + (botc.blue / 3)); - if (bot_avg > top_avg) - { - Pixel tmp = w->sb.topShadowColor; - w->sb.topShadowColor = w->sb.bottomShadowColor; - w->sb.bottomShadowColor = tmp; - } - else if (topc.pixel == botc.pixel) - { - if (botc.pixel == bg) - w->sb.topShadowColor = bg; - else - w->sb.bottomShadowColor = fg; - } - } - - if (w->sb.topShadowColor == w->core.background_pixel || - w->sb.bottomShadowColor == w->core.background_pixel) - { - /* Assume we're in mono. This code should be okay even if we're - * really in color but just short on color cells -- We want the - * following behavior, which has been empirically determined to - * work well for all fg/bg combinations in mono: If the trough - * and slider are BOTH black, then use a white top shadow and a - * grey bottom shadow, otherwise use a grey top shadow and a - * black bottom shadow. - */ - - Pixel white = WhitePixelOfScreen (DefaultScreenOfDisplay (XtDisplay (w))); - Pixel black = BlackPixelOfScreen (DefaultScreenOfDisplay (XtDisplay (w))); - - /* Note: core.background_pixel is the color of the slider ... */ - - if (w->core.background_pixel == black && - w->sb.troughColor == black) - { - w->sb.topShadowColor = white; - w->sb.bottomShadowPixmap = w->sb.grayPixmap; - } else { - w->sb.topShadowPixmap = w->sb.grayPixmap; - w->sb.bottomShadowColor = black; - } - } -} - -static void -make_trough_pixel (XlwScrollBarWidget w) -{ - Display *dpy = XtDisplay((Widget) w); - Colormap cmap = w->core.colormap; - XColor troughC; - - if (w->sb.troughColor == (Pixel)~0) w->sb.troughColor = w->core.background_pixel; - - if (w->sb.troughColor == w->core.background_pixel) - { - troughC.pixel = w->core.background_pixel; - XQueryColor (dpy, cmap, &troughC); - troughC.red = (troughC.red * 4) / 5; - troughC.green = (troughC.green * 4) / 5; - troughC.blue = (troughC.blue * 4) / 5; - if (allocate_nearest_color (dpy, cmap, &troughC)) - w->sb.troughColor = troughC.pixel; - } -} - -/*-------------------------- Draw 3D Border -----------------------------*/ -static void -draw_shadows (Display *dpy, Drawable d, GC shine_gc, GC shadow_gc, - int x, int y, int width, int height, int shadowT) -{ - XSegment shine[10], shadow[10]; - int i; - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT <= 0) return; - - for (i = 0; i < shadowT; i++) - { - /* Top segments */ - shine[i].x1 = x; - shine[i].y2 = shine[i].y1 = y + i; - shine[i].x2 = x + width - i - 1; - /* Left segments */ - shine[i + shadowT].x2 = shine[i + shadowT].x1 = x + i; - shine[i + shadowT].y1 = y + shadowT; - shine[i + shadowT].y2 = y + height - i - 1; - - /* Bottom segments */ - shadow[i].x1 = x + i; - shadow[i].y2 = shadow[i].y1 = y + height - i - 1; - shadow[i].x2 = x + width - 1 ; - /* Right segments */ - shadow[i + shadowT].x2 = shadow[i + shadowT].x1 = x + width - i - 1; - shadow[i + shadowT].y1 = y + i + 1; - shadow[i + shadowT].y2 = y + height - 1 ; - } - - XDrawSegments (dpy, d, shine_gc, shine, shadowT * 2); - XDrawSegments (dpy, d, shadow_gc, shadow, shadowT * 2); -} - -/*------------------ Draw 3D Arrows: left, up, down, right --------------*/ -static int -make_vert_seg (XSegment *seg, int x1, int y1, int x2, int y2, int shadowT) -{ - int i; - - for (i=0; ix1 = x1; - seg->y1 = y1++; - seg->x2 = x2; - seg->y2 = y2++; - } - return shadowT; -} - -static int -make_hor_seg (XSegment *seg, int x1, int y1, int x2, int y2, int shadowT) -{ - int i; - - for (i=0; ix1 = x1++; - seg->y1 = y1; - seg->x2 = x2++; - seg->y2 = y2; - } - return shadowT; -} - -static void -draw_arrow_up (Display *dpy, Drawable win, GC bgGC, GC shineGC, GC shadowGC, - int x, int y, int width, int height, int shadowT) -{ - XSegment shine[10], shadow[10]; - XPoint triangle[3]; - int mid; - - mid = width / 2; - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT < 0) shadowT = 0; - - /* / */ - make_vert_seg (shine, - x, y + height - shadowT - 1, - x + mid, y, shadowT); - /* _\ */ - make_vert_seg (shadow, - x, y + height - shadowT - 1, - x + width - 1, y + height - shadowT - 1, shadowT); - make_vert_seg (shadow + shadowT, - x + mid, y, - x + width - 1, y + height - shadowT - 1, shadowT); - - triangle[0].x = x; - triangle[0].y = y + height - 1; - triangle[1].x = x + mid; - triangle[1].y = y; - triangle[2].x = x + width - 1; - triangle[2].y = y + height - 1; - - XFillPolygon (dpy, win, bgGC, triangle, 3, Convex, ArcChord); - - XDrawSegments (dpy, win, shadowGC, shadow, shadowT * 2); - XDrawSegments (dpy, win, shineGC, shine, shadowT); -} - -static void -draw_arrow_left (Display *dpy, Drawable win, GC bgGC, GC shineGC, GC shadowGC, - int x, int y, int width, int height, int shadowT) -{ - XSegment shine[10], shadow[10]; - XPoint triangle[3]; - - int mid = width / 2; - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT < 0) shadowT = 0; - - /* / */ - make_hor_seg (shine, - x, y + mid, - x + width - shadowT - 1, y, shadowT); - /* \| */ - make_hor_seg (shadow, - x, y + mid, - x + width - shadowT - 1, y + height - 1, shadowT); - make_hor_seg (shadow + shadowT, - x + width - shadowT - 1, y, - x + width - shadowT - 1, y + height - 1, shadowT); - - triangle[0].x = x + width - 1; - triangle[0].y = y + height - 1; - triangle[1].x = x; - triangle[1].y = y + mid; - triangle[2].x = x + width - 1; - triangle[2].y = y; - - XFillPolygon (dpy, win, bgGC, triangle, 3, Convex, ArcChord); - - XDrawSegments (dpy, win, shadowGC, shadow, shadowT * 2); - XDrawSegments (dpy, win, shineGC, shine, shadowT); -} - -static void -draw_arrow_down (Display *dpy, Drawable win, GC bgGC, GC shineGC, GC shadowGC, - int x, int y, int width, int height, int shadowT) -{ - XSegment shine[10], shadow[10]; - XPoint triangle[3]; - int mid; - - mid = width / 2; - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT < 0) shadowT = 0; - - /* \- */ - make_vert_seg (shine, - x, y, - x + mid, y + height - shadowT - 1, shadowT); - make_vert_seg (shine + shadowT, - x, y, - x + width - 1, y, shadowT); - /* / */ - make_vert_seg (shadow, - x + width - 1, y, - x + mid, y + height - shadowT - 1, shadowT); - - triangle[0].x = x; - triangle[0].y = y; - triangle[1].x = x + mid; - triangle[1].y = y + height - 1; - triangle[2].x = x + width - 1; - triangle[2].y = y; - - XFillPolygon (dpy, win, bgGC, triangle, 3, Convex, ArcChord); - - XDrawSegments (dpy, win, shadowGC, shadow, shadowT); - XDrawSegments (dpy, win, shineGC, shine, shadowT * 2); -} - -static void -draw_arrow_right (Display *dpy, Drawable win, GC bgGC, GC shineGC, GC shadowGC, - int x, int y, int width, int height, int shadowT) -{ - XSegment shine[10], shadow[10]; - XPoint triangle[3]; - int mid; - - mid = width / 2; - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT < 0) shadowT = 0; - - /* |\ */ - make_hor_seg (shine, - x, y, - x + width - shadowT - 1, y + mid, shadowT); - make_hor_seg (shine + shadowT, - x, y, - x, y + height - 1, shadowT); - /* / */ - make_hor_seg (shadow, - x, y + height - 1, - x + width - shadowT - 1, y + mid, shadowT); - - triangle[0].x = x + 1; - triangle[0].y = y + height - 1; - triangle[1].x = x + width - 1; - triangle[1].y = y + mid; - triangle[2].x = x + 1; - triangle[2].y = y; - - XFillPolygon (dpy, win, bgGC, triangle, 3, Convex, ArcChord); - - XDrawSegments (dpy, win, shadowGC, shadow, shadowT); - XDrawSegments (dpy, win, shineGC, shine, shadowT * 2); -} - -static void -draw_dimple (Display *dpy, Drawable win, GC shine, GC shadow, - int x, int y, int width, int height) -{ - XDrawArc (dpy, win, shine, x, y, width, height, 46*64, 180*64); - XDrawArc (dpy, win, shadow, x, y, width, height, 45*64, -179*64); -} - -/*------- Scrollbar values -> pixels, pixels -> scrollbar values --------*/ - -static void -seg_pixel_sizes (XlwScrollBarWidget w, int *above_return, - int *ss_return, int *below_return) -{ - float total, height, fuz; - int value, above, ss, below; - - height = widget_h (w); - if (w->sb.showArrows) height -= (2 * arrow_h (w)); - - value = w->sb.value - w->sb.minimum; - - total = w->sb.maximum - w->sb.minimum; - fuz = total / 2; - - ss = (int) ((height * w->sb.sliderSize + fuz) / total); - above = (int) ((height * value + fuz) / total); - below = (int) ((height) - (ss + above)); - - /* Don't let slider get smaller than SS_MIN */ - if (ss < SS_MIN) - { - /* add a percent amount for integer rounding */ - float tmp = ((((float) (SS_MIN - ss) * (float) value)) / total) + 0.5; - - above -= (int) tmp; - ss = SS_MIN; - below = (int) ((height) - (ss + above)); - - if (above < 0) - { - above = 0; - below = (int) (height - ss); - } - if (below < 0) - { - above = (int) (height - ss); - below = 0; - } - if (ss > height) - { - above = 0; - ss = (int) height; - below = 0; - } - } - - *above_return = above; - *ss_return = ss; - *below_return = below; - - CHECK (w); -} - -static void -verify_values (XlwScrollBarWidget w) -{ - int total = w->sb.maximum - w->sb.minimum; - - if (w->sb.sliderSize > total) - w->sb.sliderSize = total; - - if (w->sb.pageIncrement > total) - w->sb.pageIncrement = total; - - if (w->sb.increment > total) - w->sb.increment = total; - - if (w->sb.value < w->sb.minimum) - w->sb.value = w->sb.minimum; - - if (w->sb.value > w->sb.maximum) - w->sb.value = w->sb.maximum; - - if (w->sb.sliderSize > w->sb.maximum - w->sb.value) - w->sb.sliderSize = w->sb.maximum - w->sb.value; -} - -static int -value_from_pixel (XlwScrollBarWidget w, int above) -{ - float total, height, fuz; - int value, ss; - - height = widget_h (w); - if (w->sb.showArrows) - height -= (2 * arrow_h (w)); - - total = w->sb.maximum - w->sb.minimum; - fuz = height / 2; - - ss = (int) ((height * w->sb.sliderSize + (total / 2)) / total); - - if (ss < SS_MIN) - { - /* add a percent amount for integer rounding */ - above += (int) ((((SS_MIN - ss) * above) + fuz) / height); - } - - { - /* Prevent SIGFPE's that would occur if we don't truncate the value. */ - float floatval = w->sb.minimum + ((float)(above * total + fuz) / height); - if (floatval >= (float) INT_MAX) - value = INT_MAX; - else if (floatval <= (float) INT_MIN) - value = INT_MIN; - else - value = (int) floatval; - } - - return value; -} - - -static void -redraw_dimple (XlwScrollBarWidget w, Display *dpy, Window win, - int x, int y, int width, int height) -{ - if (SLIDER_DIMPLE == slider_style (w)) - { - int size; - int slider_p = (w->sb.armed == ARM_SLIDER); - GC shine = slider_p ? w->sb.bottomShadowGC : w->sb.topShadowGC; - GC shadow = slider_p ? w->sb.topShadowGC : w->sb.bottomShadowGC; - int shadowT = w->sb.shadowThickness; - - x += shadowT; - y += shadowT; - width -= 2*shadowT; - height -= 2*shadowT; - - size = (width < height ? width : height) * 3 / 4; - - if (size%2 != (width < height ? width : height)%2) size--; - - DBUG (fprintf (stderr, "%d %d\n", - x + (width / 2) - (size / 2) - 2*shadowT, - width - size - shadowT)); - - draw_dimple (dpy, win, shine, shadow, - x + (width / 2) - (size / 2), - y + (height / 2) - (size / 2), - size, size); - } -} - -static void -draw_slider (XlwScrollBarWidget w, int above, int ss, int below) -{ - Display *dpy = XtDisplay ((Widget) w); - Window win = XtWindow ((Widget) w); - - int x = widget_x (w); - int y = widget_y (w); - int width = widget_w (w); - int height = widget_h (w); - int shadowT = w->sb.shadowThickness; - int vert_p = VERT (w); - - if (shadowT > (width / 2)) shadowT = (width / 2); - if (shadowT > (height / 2)) shadowT = (height / 2); - if (shadowT < 0) shadowT = 0; - - if (w->sb.showArrows && !arrow_same_end (w)) - y += arrow_h (w); - - /* trough above slider */ - if (above > 0) - { - if (vert_p) - XClearArea (dpy, win, x, y, width, above, False); - else - XClearArea (dpy, win, y, x, above, width, False); - } - - /* slider */ - if (vert_p) - { - draw_shadows (dpy, win, w->sb.topShadowGC, w->sb.bottomShadowGC, - x, y + above, width, ss, shadowT); - XFillRectangle (dpy, win, w->sb.backgroundGC, - x+shadowT, y + above + shadowT, - width-2*shadowT, ss-2*shadowT); - redraw_dimple (w, dpy, win, x, y + above, width, ss); - } - else - { - draw_shadows (dpy, win, w->sb.topShadowGC, w->sb.bottomShadowGC, - y + above, x, ss, width, shadowT); - XFillRectangle (dpy, win, w->sb.backgroundGC, - y + above + shadowT, x+shadowT, - ss-2*shadowT, width-2*shadowT); - redraw_dimple (w, dpy, win, y + above, x, ss, width); - } - - /* trough below slider */ - if (below > 0) - { - if (vert_p) - XClearArea (dpy, win, x, y + above + ss, width, below, False); - else - XClearArea (dpy, win, y + above + ss, x, below, width, False); - } - - CHECK (w); -} - -static void -redraw_up_arrow (XlwScrollBarWidget w, Boolean armed, Boolean clear_behind) -{ - Display *dpy = XtDisplay ((Widget) w); - Window win = XtWindow ((Widget) w); - - int x = widget_x (w); - int y = widget_y (w); - int width = widget_w (w); - int height = widget_h (w); - int shadowT = w->sb.shadowThickness; - int arrow_height = arrow_h (w); - - GC bg = w->sb.backgroundGC; - GC shine = armed ? w->sb.bottomShadowGC : w->sb.topShadowGC; - GC shadow = armed ? w->sb.topShadowGC : w->sb.bottomShadowGC; - - if (VERT (w)) - { - if (arrow_same_end (w)) - y += height - 2 * arrow_height; - if (clear_behind) - XClearArea (dpy, win, x, y, width, arrow_height + 1, False); - draw_arrow_up (dpy, win, bg, shine, shadow, - x + (width - arrow_height)/2, y, - arrow_height, arrow_height, shadowT); - } - else - { - if (arrow_same_end (w)) - y += height - 2 * arrow_height; - if (clear_behind) - XClearArea (dpy, win, y, x, arrow_height + 1, height, False); - draw_arrow_left (dpy, win, bg, shine, shadow, - y, x + (width - arrow_height)/2, - arrow_height, arrow_height, shadowT); - } -} - -static void -redraw_down_arrow (XlwScrollBarWidget w, Boolean armed, Boolean clear_behind) -{ - Display *dpy = XtDisplay ((Widget) w); - Window win = XtWindow ((Widget) w); - - int x = widget_x (w); - int y = widget_y (w); - int width = widget_w (w); - int height = widget_h (w); - int shadowT = w->sb.shadowThickness; - int arrow_height = arrow_h (w); - - GC bg = w->sb.backgroundGC; - GC shine = armed ? w->sb.bottomShadowGC : w->sb.topShadowGC; - GC shadow = armed ? w->sb.topShadowGC : w->sb.bottomShadowGC; - - if (VERT (w)) - { - if (clear_behind) - XClearArea (dpy, win, x, y + height - arrow_height, width, - arrow_height + 1, False); - draw_arrow_down (dpy, win, bg, shine, shadow, - x + (width - arrow_height)/2, - y + height - arrow_height + 1, - arrow_height, arrow_height, shadowT); - } - else - { - if (clear_behind) - XClearArea (dpy, win, y + height - arrow_height, x, - arrow_height + 1, height, False); - draw_arrow_right (dpy, win, bg, shine, shadow, - y + height - arrow_height + 1, - x + (width - arrow_height)/2, - arrow_height, arrow_height, shadowT); - } -} - -static void -redraw_everything (XlwScrollBarWidget w, Region region, Boolean behind_arrows) -{ - Display *dpy = XtDisplay ((Widget) w); - Window win = XtWindow ((Widget) w); - - if (w->sb.showArrows) - { - if (region == NULL) - { - redraw_up_arrow (w, False, behind_arrows); - redraw_down_arrow (w, False, behind_arrows); - } - else - { - int x = widget_x (w); - int y = widget_y (w); - int width = widget_w (w); - int height = widget_h (w); - int arrow_height = arrow_h (w); - int ax = x, ay = y; - - if (arrow_same_end (w)) - { - if (VERT (w)) - ay = y + height - arrow_height - arrow_height; - else - ax = x + height - arrow_height - arrow_height; - } - if (XRectInRegion (region, ax, ay, width, width)) - redraw_up_arrow (w, False, behind_arrows); - - if (VERT (w)) - ay = y + height - arrow_height; - else - ax = x + height - arrow_height; - if (XRectInRegion (region, ax, ay, width, width)) - redraw_down_arrow (w, False, behind_arrows); - } - } - - draw_shadows (dpy, win, w->sb.bottomShadowGC, w->sb.topShadowGC, 0, 0, - w->core.width, w->core.height, w->sb.shadowThickness); - - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); -} - -/*-------------------------- Method Functions ---------------------------*/ - -static void -Initialize (Widget treq, Widget tnew, ArgList args, Cardinal *num_args) -{ - XlwScrollBarWidget request = (XlwScrollBarWidget) treq; - XlwScrollBarWidget w = (XlwScrollBarWidget) tnew; - Display *dpy = XtDisplay ((Widget) w); - Window win = RootWindowOfScreen (DefaultScreenOfDisplay (dpy)); - - if (request->core.width == 0) w->core.width += (VERT (w) ? 12 : 25); - if (request->core.height == 0) w->core.height += (VERT (w) ? 25 : 12); - - verify_values (w); - - w->sb.lastY = 0; - w->sb.above = 0; - w->sb.ss = 0; - w->sb.below = 0; - w->sb.armed = ARM_NONE; - w->sb.forced_scroll = FORCED_SCROLL_NONE; - - if (w->sb.shadowThickness > 5) w->sb.shadowThickness = 5; - - w->sb.grayPixmap = - XCreatePixmapFromBitmapData (dpy, win, (char *) gray_bits, gray_width, - gray_height, 1, 0, 1); - - make_trough_pixel (w); - - make_shadow_pixels (w); - - w->sb.backgroundGC = - get_gc (w, w->core.background_pixel, w->core.background_pixel, None); - w->sb.topShadowGC = - get_gc (w, w->sb.topShadowColor, w->core.background_pixel, - w->sb.topShadowPixmap); - w->sb.bottomShadowGC = - get_gc (w, w->sb.bottomShadowColor, w->core.background_pixel, - w->sb.bottomShadowPixmap); - - w->sb.fullRedrawNext = True; - - w->sb.timerActive = False; -} - -static void -Destroy (Widget widget) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - Display *dpy = XtDisplay ((Widget) w); - - XtReleaseGC (widget, w->sb.bottomShadowGC); - XtReleaseGC (widget, w->sb.topShadowGC); - XtReleaseGC (widget, w->sb.backgroundGC); - - XFreePixmap (dpy, w->sb.grayPixmap); - - if (w->sb.timerActive) - { - XtRemoveTimeOut (w->sb.timerId); - w->sb.timerActive = False; /* Should be a no-op, but you never know */ - } -} - -static void -Realize (Widget widget, XtValueMask *valuemask, XSetWindowAttributes *attr) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - Display *dpy = XtDisplay ((Widget) w); - Window win; - XSetWindowAttributes win_attr; - - (*coreClassRec.core_class.realize)(widget, valuemask, attr); - - win = XtWindow ((Widget) w); - - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - - XSetWindowBackground (dpy, win, w->sb.troughColor); - - /* Change bit gravity so widget is not cleared on resize */ - win_attr.bit_gravity = NorthWestGravity; - XChangeWindowAttributes (dpy, win, CWBitGravity , &win_attr); - -} - -static void -Resize (Widget widget) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - Display *dpy = XtDisplay ((Widget) w); - Window win = XtWindow ((Widget) w); - - if (XtIsRealized (widget)) - { - DBUG (fprintf (stderr, "Resize = %08lx\n", w)); - - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - - /* redraw_everything (w, NULL, True); */ - - w->sb.fullRedrawNext = True; - /* Force expose event */ - XClearArea (dpy, win, widget_x (w), widget_y (w), 1, 1, True); - } - - if (w->sb.timerActive) - { - XtRemoveTimeOut (w->sb.timerId); - w->sb.timerActive = False; - } -} - -static void -Redisplay (Widget widget, XEvent *event, Region region) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - DBUG (fprintf (stderr, "Redisplay = %08lx\n", w)); - - if (XtIsRealized (widget)) - { - if (w->sb.fullRedrawNext) - redraw_everything (w, NULL, True); - else - redraw_everything (w, region, False); - w->sb.fullRedrawNext = False; - } -} - -static Boolean -SetValues (Widget current, Widget request, Widget neww, - ArgList args, Cardinal *num_args) -{ - XlwScrollBarWidget cur = (XlwScrollBarWidget) current; - XlwScrollBarWidget w = (XlwScrollBarWidget) neww; - Boolean do_redisplay = False; - - if (cur->sb.troughColor != w->sb.troughColor) - { - if (XtIsRealized ((Widget) w)) - { - XSetWindowBackground (XtDisplay((Widget) w), XtWindow ((Widget) w), - w->sb.troughColor); - do_redisplay = True; - } - } - - if (cur->core.background_pixel != w->core.background_pixel) - { - XtReleaseGC ((Widget)cur, cur->sb.backgroundGC); - w->sb.backgroundGC = - get_gc (w, w->core.background_pixel, w->core.background_pixel, None); - do_redisplay = True; - } - - if (cur->sb.topShadowColor != w->sb.topShadowColor || - cur->sb.topShadowPixmap != w->sb.topShadowPixmap) - { - XtReleaseGC ((Widget)cur, cur->sb.topShadowGC); - w->sb.topShadowGC = - get_gc (w, w->sb.topShadowColor, w->core.background_pixel, - w->sb.topShadowPixmap); - do_redisplay = True; - } - - if (cur->sb.bottomShadowColor != w->sb.bottomShadowColor || - cur->sb.bottomShadowPixmap != w->sb.bottomShadowPixmap) - { - XtReleaseGC ((Widget)cur, cur->sb.bottomShadowGC); - w->sb.bottomShadowGC = - get_gc (w, w->sb.bottomShadowColor, w->core.background_pixel, - w->sb.bottomShadowPixmap); - do_redisplay = True; - } - - if (cur->sb.orientation != w->sb.orientation) - do_redisplay = True; - - - if (cur->sb.minimum != w->sb.minimum || - cur->sb.maximum != w->sb.maximum || - cur->sb.sliderSize != w->sb.sliderSize || - cur->sb.value != w->sb.value || - cur->sb.pageIncrement != w->sb.pageIncrement || - cur->sb.increment != w->sb.increment) - { - verify_values (w); - if (XtIsRealized ((Widget) w)) - { - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - } - } - - if (w->sb.shadowThickness > 5) w->sb.shadowThickness = 5; - - return do_redisplay; -} - -void -XlwScrollBarGetValues (Widget widget, int *value, int *sliderSize, - int *increment, int *pageIncrement) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - if (w && XtClass ((Widget) w) == xlwScrollBarWidgetClass) - { - if (value) *value = w->sb.value; - if (sliderSize) *sliderSize = w->sb.sliderSize; - if (increment) *increment = w->sb.increment; - if (pageIncrement) *pageIncrement = w->sb.pageIncrement; - } -} - -void -XlwScrollBarSetValues (Widget widget, int value, int sliderSize, - int increment, int pageIncrement, Boolean notify) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - if (w && XtClass ((Widget) w) == xlwScrollBarWidgetClass && - (w->sb.value != value || - w->sb.sliderSize != sliderSize || - w->sb.increment != increment || - w->sb.pageIncrement != pageIncrement)) - { - int last_value = w->sb.value; - - w->sb.value = value; - w->sb.sliderSize = sliderSize; - w->sb.increment = increment; - w->sb.pageIncrement = pageIncrement; - - verify_values (w); - - if (XtIsRealized (widget)) - { - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - if (w->sb.value != last_value && notify) - call_callbacks (w, XmCR_VALUE_CHANGED, w->sb.value, 0, NULL); - } - } -} - -/*-------------------------- Action Functions ---------------------------*/ - -static void -timer (XtPointer data, XtIntervalId *id) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) data; - w->sb.timerActive = False; - - if (w->sb.armed != ARM_NONE) - { - int last_value = w->sb.value; - int reason; - - switch (w->sb.armed) - { - case ARM_PAGEUP: - decrement_value (w, w->sb.pageIncrement); - reason = XmCR_PAGE_DECREMENT; - break; - case ARM_PAGEDOWN: - increment_value (w, w->sb.pageIncrement); - reason = XmCR_PAGE_INCREMENT; - break; - case ARM_UP: - decrement_value (w, w->sb.increment); - reason = XmCR_DECREMENT; - break; - case ARM_DOWN: - increment_value (w, w->sb.increment); - reason = XmCR_INCREMENT; - break; - default: - reason = XmCR_NONE; - } - - verify_values (w); - - if (last_value != w->sb.value) - { - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - call_callbacks (w, reason, w->sb.value, 0, NULL); - - w->sb.timerId = - XtAppAddTimeOut (XtWidgetToApplicationContext ((Widget) w), - (unsigned long) w->sb.repeatDelay, - timer, (XtPointer) w); - w->sb.timerActive = True; - } - } -} - -static button_where -what_button (XlwScrollBarWidget w, int mouse_x, int mouse_y) -{ - int width = widget_w (w); - int height = widget_h (w); - int arrow_height = arrow_h (w); - - mouse_x -= widget_x (w); - mouse_y -= widget_y (w); - - if (mouse_x < 0 || mouse_x >= width || - mouse_y < 0 || mouse_y >= height) - return BUTTON_NONE; - - if (w->sb.showArrows) - { - if (mouse_y >= (height -= arrow_height)) - return BUTTON_DOWN_ARROW; - - if (arrow_same_end (w)) - { - if (mouse_y >= (height -= arrow_height)) - return BUTTON_UP_ARROW; - } - else - if ( (mouse_y -= arrow_height) < 0) - return BUTTON_UP_ARROW; - } - - if ( (mouse_y -= w->sb.above) < 0) - return BUTTON_TROUGH_ABOVE; - - if ( (mouse_y -= w->sb.ss) < 0) - return BUTTON_SLIDER; - - return BUTTON_TROUGH_BELOW; -} - -static void -Select (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - button_where sb_button; - - int mouse_x = event_x (w, event); - int mouse_y = event_y (w, event); - - int last_value = w->sb.savedValue = w->sb.value; - int reason = XmCR_NONE; - - XtGrabKeyboard ((Widget) w, False, GrabModeAsync, GrabModeAsync, - event->xbutton.time); - - sb_button = what_button (w, mouse_x, mouse_y); - - if (w->sb.forced_scroll != FORCED_SCROLL_NONE) - { - switch (sb_button) - { - case BUTTON_TROUGH_ABOVE: - case BUTTON_TROUGH_BELOW: - case BUTTON_SLIDER: - sb_button= BUTTON_NONE; /* cause next switch to fall through */ - if (w->sb.forced_scroll == FORCED_SCROLL_UPLEFT) - { - decrement_value (w, w->sb.pageIncrement); - w->sb.armed = ARM_PAGEUP; - reason = XmCR_PAGE_DECREMENT; - break; - } - else if (w->sb.forced_scroll == FORCED_SCROLL_DOWNRIGHT) - { - increment_value (w, w->sb.pageIncrement); - w->sb.armed = ARM_PAGEDOWN; - reason = XmCR_PAGE_INCREMENT; - break; - } - abort(); - default: - ; /* Do nothing */ - } - } - - switch (sb_button) - { - case BUTTON_TROUGH_ABOVE: - decrement_value (w, w->sb.pageIncrement); - w->sb.armed = ARM_PAGEUP; - reason = XmCR_PAGE_DECREMENT; - break; - case BUTTON_TROUGH_BELOW: - increment_value (w, w->sb.pageIncrement); - w->sb.armed = ARM_PAGEDOWN; - reason = XmCR_PAGE_INCREMENT; - break; - case BUTTON_SLIDER: - w->sb.lastY = mouse_y; - w->sb.armed = ARM_SLIDER; - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - break; - case BUTTON_UP_ARROW: - if (event->xbutton.state & ControlMask) - { - w->sb.value = w->sb.minimum; - reason = XmCR_TO_TOP; - } - else - { - decrement_value (w, w->sb.increment); - reason = XmCR_DECREMENT; - } - w->sb.armed = ARM_UP; - redraw_up_arrow (w, True, False); - break; - case BUTTON_DOWN_ARROW: - if (event->xbutton.state & ControlMask) - { - w->sb.value = w->sb.maximum; - reason = XmCR_TO_BOTTOM; - } - else - { - increment_value (w, w->sb.increment); - reason = XmCR_INCREMENT; - } - w->sb.armed = ARM_DOWN; - redraw_down_arrow (w, True, False); - break; - case BUTTON_NONE: - ; /* Do nothing */ - } - - verify_values (w); - - if (last_value != w->sb.value) - { - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - call_callbacks (w, reason, w->sb.value, mouse_y, event); - - if (w->sb.timerActive) - XtRemoveTimeOut (w->sb.timerId); - - w->sb.timerId = - XtAppAddTimeOut (XtWidgetToApplicationContext ((Widget) w), - (unsigned long) w->sb.initialDelay, - timer, (XtPointer) w); - w->sb.timerActive = True; - } - - CHECK (w); -} - -static void -PageDownOrRight (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - w->sb.forced_scroll = FORCED_SCROLL_DOWNRIGHT; - Select (widget, event, parms, num_parms); - w->sb.forced_scroll = FORCED_SCROLL_NONE; -} - -static void -PageUpOrLeft (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - w->sb.forced_scroll = FORCED_SCROLL_UPLEFT; - Select (widget, event, parms, num_parms); - w->sb.forced_scroll = FORCED_SCROLL_NONE; -} - -static void -Drag (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - if (w->sb.armed == ARM_SLIDER) - { - int mouse_y = event_y (w, event); - int diff = mouse_y - w->sb.lastY; - - if (diff < -(w->sb.above)) /* up */ - { - mouse_y -= (diff + w->sb.above); - diff = -(w->sb.above); - } - else if (diff > w->sb.below) /* down */ - { - mouse_y -= (diff - w->sb.below); - diff = w->sb.below; - } - - if (diff) - { - w->sb.above += diff; - w->sb.below -= diff; - - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - w->sb.lastY = mouse_y; - - w->sb.value = value_from_pixel (w, w->sb.above); - verify_values (w); - CHECK (w); - - call_callbacks (w, XmCR_DRAG, w->sb.value, event_y (w, event), event); - } - } - CHECK (w); -} - -static void -Release (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - switch (w->sb.armed) - { - case ARM_SLIDER: - call_callbacks (w, XmCR_VALUE_CHANGED, w->sb.value, event_y (w, event), event); - w->sb.armed = ARM_NONE; - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - break; - case ARM_UP: - redraw_up_arrow (w, False, False); - break; - case ARM_DOWN: - redraw_down_arrow (w, False, False); - break; - default: - ; /* Do nothing */ - } - - XtUngrabKeyboard ((Widget) w, event->xbutton.time); - - w->sb.armed = ARM_NONE; -} - -static void -Jump (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - int last_value; - - int mouse_x = event_x (w, event); - int mouse_y = event_y (w, event); - - int scroll_region_y = widget_y (w); - int scroll_region_h = widget_h (w); - - if (w->sb.showArrows) - { - int arrow_height = arrow_h (w); - scroll_region_h -= 2 * arrow_height; - if (!arrow_same_end (w)) - scroll_region_y += arrow_height; - } - - XtGrabKeyboard ((Widget) w, False, GrabModeAsync, GrabModeAsync, - event->xbutton.time); - - switch (what_button (w, mouse_x, mouse_y)) - { - case BUTTON_TROUGH_ABOVE: - case BUTTON_TROUGH_BELOW: - case BUTTON_SLIDER: - w->sb.savedValue = w->sb.value; - - last_value = w->sb.value; - - w->sb.above = mouse_y - (w->sb.ss / 2) - scroll_region_y; - if (w->sb.above < 0) - w->sb.above = 0; - else if (w->sb.above + w->sb.ss > scroll_region_h) - w->sb.above = scroll_region_h - w->sb.ss; - - w->sb.below = scroll_region_h - w->sb.ss - w->sb.above; - - w->sb.armed = ARM_SLIDER; - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - w->sb.value = value_from_pixel (w, w->sb.above); - verify_values (w); - CHECK (w); - - w->sb.lastY = mouse_y; - - if (w->sb.value != last_value) - call_callbacks (w, XmCR_DRAG, w->sb.value, mouse_y, event); - - break; - default: - ; /* Do nothing */ - } - CHECK (w); -} - -static void -Abort (Widget widget, XEvent *event, String *parms, Cardinal *num_parms) -{ - XlwScrollBarWidget w = (XlwScrollBarWidget) widget; - - if (w->sb.armed != ARM_NONE) - { - if (w->sb.value != w->sb.savedValue) - { - w->sb.value = w->sb.savedValue; - - seg_pixel_sizes (w, &w->sb.above, &w->sb.ss, &w->sb.below); - draw_slider (w, w->sb.above, w->sb.ss, w->sb.below); - - call_callbacks (w, XmCR_VALUE_CHANGED, w->sb.value, - event_y (w, event), event); - } - - switch (w->sb.armed) - { - case ARM_UP: redraw_up_arrow (w, False, False); break; - case ARM_DOWN: redraw_down_arrow (w, False, False); break; - default: ; /* Do nothing */ - } - - w->sb.armed = ARM_NONE; - - XtUngrabKeyboard ((Widget) w, event->xbutton.time); - } -} diff --git a/lwlib/xlwscrollbar.h b/lwlib/xlwscrollbar.h deleted file mode 100644 index 1dd4b1b..0000000 --- a/lwlib/xlwscrollbar.h +++ /dev/null @@ -1,143 +0,0 @@ -/* Implements a lightweight scrollbar widget. - Copyright (C) 1992, 1993, 1994 Lucid, Inc. - -This file is part of the Lucid Widget Library. - -The Lucid Widget Library is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The Lucid Widget Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR 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. */ - -/* Created by Douglas Keller */ - -#ifndef _XlwScrollbar_h -#define _XlwScrollbar_h - -#include - -/* Motif-compatible resource names */ -#ifndef _XmStrDefs_h_ - -#define XmNbackground "background" -#define XmNbottomShadowColor "bottomShadowColor" -#define XmNbottomShadowPixmap "bottomShadowPixmap" -#define XmNforeground "foreground" -#define XmNincrement "increment" -#define XmNinitialDelay "initialDelay" -#define XmNmaximum "maximum" -#define XmNminimum "minimum" -#define XmNpageIncrement "pageIncrement" -#define XmNrepeatDelay "repeatDelay" -#define XmNshadowThickness "shadowThickness" -#define XmNborderWidth "borderWidth" -#define XmNshowArrows "showArrows" -#define XmNsliderSize "sliderSize" -#define XmNtopShadowColor "topShadowColor" -#define XmNtopShadowPixmap "topShadowPixmap" -#define XmNtroughColor "troughColor" -#define XmNvalue "value" -#define XmNvalueChangedCallback "valueChangedCallback" -#define XmNincrementCallback "incrementCallback" -#define XmNdecrementCallback "decrementCallback" -#define XmNpageIncrementCallback "pageIncrementCallback" -#define XmNpageDecrementCallback "pageDecrementCallback" -#define XmNtoTopCallback "toTopCallback" -#define XmNtoBottomCallback "toBottomCallback" -#define XmNdragCallback "dragCallback" -#define XmNorientation "orientation" - -#define XmCBackground "Background" -#define XmCBottomShadowColor "BottomShadowColor" -#define XmCBottomShadowPixmap "BottomShadowPixmap" -#define XmCTopShadowPixmap "TopShadowPixmap" -#define XmCForeground "Foreground" -#define XmCIncrement "Increment" -#define XmCInitialDelay "InitialDelay" -#define XmCMaximum "Maximum" -#define XmCMinimum "Minimum" -#define XmCPageIncrement "PageIncrement" -#define XmCRepeatDelay "RepeatDelay" -#define XmCShadowThickness "ShadowThickness" -#define XmCBorderWidth "BorderWidth" -#define XmCShowArrows "ShowArrows" -#define XmCSliderSize "SliderSize" -#define XmCTopShadowColor "TopShadowColor" -#define XmCTroughColor "TroughColor" -#define XmCValue "Value" -#define XmCValueChangedCallback "ValueChangedCallback" -#define XmCIncrementCallback "IncrementCallback" -#define XmCDecrementCallback "DecrementCallback" -#define XmCPageIncrementCallback "PageIncrementCallback" -#define XmCPageDecrementCallback "PageDecrementCallback" -#define XmCToTopCallback "ToTopCallback" -#define XmCToBottomCallback "ToBottomCallback" -#define XmCDragCallback "DragCallback" -#define XmCOrientation "Orientation" - -#endif /* _XmStrDefs_h_ */ - -/* New resources that Motif does not have. - Maybe we should use a different prefix. */ - -/* "knob" is obsolete; use "slider" instead. */ -#define XmNknobStyle "knobStyle" -#define XmCKnobStyle "KnobStyle" - -#define XmNsliderStyle "sliderStyle" -#define XmCSliderStyle "SliderStyle" - -#define XmNarrowPosition "arrowPosition" -#define XmCArrowPosition "ArrowPosition" - -#ifndef _Xm_h - -enum { - XmCR_NONE, - XmCR_VALUE_CHANGED = 2, - XmCR_INCREMENT, - XmCR_DECREMENT, - XmCR_PAGE_INCREMENT, - XmCR_PAGE_DECREMENT, - XmCR_TO_TOP, - XmCR_TO_BOTTOM, - XmCR_DRAG -}; - -enum { - XmNO_ORIENTATION, - XmVERTICAL, - XmHORIZONTAL -}; - -#endif /* ! _Xm_h */ - -extern WidgetClass xlwScrollBarWidgetClass; - -typedef struct _XlwScrollBarClassRec *XlwScrollBarWidgetClass; -typedef struct _XlwScrollBarRec *XlwScrollBarWidget; - -typedef struct -{ - int reason; - XEvent * event; - int value; - int pixel; -} XlwScrollBarCallbackStruct; - -void XlwScrollBarGetValues(Widget widget, int *value, int *sliderSize, - int *increment, int *pageIncrement); - -void XlwScrollBarSetValues(Widget widget, int value, int sliderSize, - int increment, int pageIncrement, Boolean notify); - -#endif diff --git a/man/ChangeLog b/man/ChangeLog deleted file mode 100644 index 06b9a90..0000000 --- a/man/ChangeLog +++ /dev/null @@ -1,834 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-01-14 Adrian Aichner - - * internals\internals.texi (Techniques for XEmacs Developers): - Fixing documentation. - (Basic Lisp Modules): ditto. - -1999-01-10 J. Kean Johnston - - * emodules.texi: New file to describe XEmacs modules. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-11-30 Martin Buchholz - - * xemacs/startup.texi (Startup Paths): - * xemacs/custom.texi (Widgets): - * xemacs-faq.texi (Q3.0.5): - * xemacs-faq.texi (Top): - - * widget.texi (info-link): - - * lispref/objects.texi (Type Predicates): - * lispref/objects.texi (Hash Table Type): - * lispref/objects.texi (Primitive Types): - * lispref/objects.texi (Lisp Data Types): - * lispref/macros.texi (Backquote): - * lispref/hash-tables.texi (Weak Hash Tables): - * lispref/hash-tables.texi: - * lispref/errors.texi (Standard Errors): - * lispref/compile.texi (Disassembly): - * lispref/compile.texi (Compiled-Function Objects): - * lispref/compile.texi (Eval During Compile): - * lispref/compile.texi (Docs and Compilation): - * lispref/compile.texi (Compilation Functions): - * lispref/compile.texi (Speed of Byte-Code): - * lispref/compile.texi (Byte Compilation): - * lispref/building.texi (Garbage Collection): - - * internals/internals.texi (Simple Special Forms): - * internals/internals.texi (Evaluation; Stack Frames; Bindings): - * internals/internals.texi (Specifics of the Event Gathering Mechanism): - * internals/internals.texi (String): - * internals/internals.texi (Introduction to Allocation): - * internals/internals.texi (Allocation of Objects in XEmacs Lisp): - * internals/internals.texi (Modules for Internationalization): - * internals/internals.texi (Modules for Interfacing with X Windows): - * internals/internals.texi (Modules for Interfacing with the Operating System): - * internals/internals.texi (Modules for Other Aspects of the Lisp Interpreter and Object System): - * internals/internals.texi (Modules for Interfacing with the File System): - * internals/internals.texi (Modules for the Redisplay Mechanism): - * internals/internals.texi (Modules for the Basic Displayable Lisp Objects): - * internals/internals.texi (Editor-Level Control Flow Modules): - * internals/internals.texi (Modules for Standard Editing Operations): - * internals/internals.texi (Basic Lisp Modules): - * internals/internals.texi (Low-Level Modules): - * internals/internals.texi (A Summary of the Various XEmacs Modules): - * internals/internals.texi (An Example of Mule-Aware Code): - * internals/internals.texi (Working With Character and Byte Positions): - * internals/internals.texi (Writing Lisp Primitives): - * internals/internals.texi (General Coding Rules): - * internals/internals.texi (How Lisp Objects Are Represented in C): - * internals/internals.texi (The XEmacs Object System (Abstractly Speaking)): - * internals/internals.texi (XEmacs From the Perspective of Building): - * internals/internals.texi (The Lisp Language): - * internals/internals.texi (Top): - * internals/internals.texi: - - rewrite Internals manual - - * cl.texi (Porting Common Lisp): - * cl.texi (Hash Tables): - * cl.texi (Association Lists): - * cl.texi (Declarations): - * cl.texi (For Clauses): - * cl.texi (Basic Setf): - * cl.texi (Equality Predicates): - - mega patch - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-10-09 SL Baur - - * Makefile (MAKEINFO): Undo no-split change. - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-09-20 Hrvoje Niksic - - * lispref/customize.texi: New file. - -1998-09-09 Hrvoje Niksic - - * internals/internals.texi (Coding for Mule): New node and - section. - -1998-09-03 Darryl Okahata - - * xemacs/packages.texi: Document manually installing binary packages. - -1998-09-02 Jeff Miller - - * Synch calendar.texi with Emacs 20.3 - -1998-09-03 Darryl Okahata - - * xemacs/packages.texi: Correct and update package documentation. - Updated the package installation section to mention the visual - package browser/installer. - -1998-08-31 Hrvoje Niksic - - * lispref/buffers.texi (Indirect Buffers): Update with XEmacs - specifics. - -1998-08-21 Greg Klanderman - - * lispref/files.texi (User Name Completion): new section. - -1998-07-23 Adrian Aichner - - * xemacs/packages.texi (Packages): Changing @itemize @emph to - @itemize @bullet (this is what all other files included in - xemacs.texi use) to fix error in texi2dvi (GNU Texinfo 3.12) 0.8. - -1998-07-20 Michael Sperber [Mr. Preprocessor] - - * xemacs/startup.texi: Small fixes, suggested by Hrvoje. - - * xemacs/xemacs.texi: - * xemacs/packages.texi: More packages documentation. - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-12 SL Baur - - * XEmacs 21.0-pre5 is released. - -1998-07-09 SL Baur - - * XEmacs 21.0-pre4 is released. - -1998-07-09 Oliver Graf - - * lispref/dragndrop.texi: added warning to OffiX Protocol section - -1998-07-09 SL Baur - - * lispref/ldap.texi (Syntax of Search Filters): Fix QP encoding - damage in transit. - -1998-07-05 Oscar Figueiredo - - * lispref/tooltalk.texi: Fixed NEXT to @node LDAP - - * lispref/internationalization.texi: Fixed PREV to @node LDAP - - * lispref/lispref.texi: Added LDAP chapter from ldap.texi - - * lispref/Makefile: Added ldap.texi to srcs - -1998-06-29 SL Baur - - * standards.texi (Preface): Revert previous change to @node - because it doesn't pass makeinfo. - -1998-06-27 Adrian Aichner - - * cl.texi: See ALL. - * info-stnd.texi: Fixed @setfilename. - * info.texi: Fixed @setfilename and a typo. - * standards.texi: Added NEXT to @node Preface. See ALL. - * texinfo.texi: Fixed section names, quoted usage of @TeX{}, - changed some occurences of `:' to `colon'. - * xemacs-faq.texi: See ALL. - * internals/internals.texi: See ALL. - * lispref/back.texi: Fixed @setfilename. - * lispref/compile.texi: See ALL. - * lispref/debugging.texi: See ALL. - * lispref/edebug-inc.texi: Added NEXT and UP to @node Edebug. - * lispref/eval.texi: See ALL. - * lispref/extents.texi: See ALL. - * lispref/loading.texi: See ALL. - * lispref/searching.texi: Escaped `(' in - @cindex @samp{(?:} in regex - * lispref/variables.texi: See ALL. - -1998-06-28 SL Baur - - * xemacs/calendar.texi: Massive update. - From Jeff Miller - -1998-06-20 Michael Sperber [Mr. Preprocessor] - - * xemacs/abbrevs.texi: - * xemacs/basic.texi: - * xemacs/buildings.texi: - * xemacs/cmdargs.texi: - * xemacs/files.texi: - * xemacs/adjustments.texi: Adjustments to integrate startup.texi - and packages.texi stuff. - - * xemacs/startup.texi: - * xemacs/packages.texi: Created. - -1998-06-10 Adrian Aichner - - * texinfo.texi: added ../info/ to @setfilename, broke line after - @noindent. Changed @var{arg-not-used-by-@TeX{}} to - @var{arg-not-used-by-@@TeX{}} to make `texinfo-format-buffer' - happy. Fixed refs broken by a previous patch of mine. - -1998-06-18 Darryl Okahata - - * lispref/os.texi (os.texi): Document `user-home-directory'. - -1998-06-13 Greg Klanderman - - * lispref/windows.texi (Resizing Windows): document third optional - WINDOW argument to enlarge-window and shrink-window. - (Selecting Windows): document select-window optional norecord - argument. - (Size of Window): document window-text-area-pixel-height and - window-text-area-pixel-width. - (Size of Window): document window-displayed-text-pixel-height. - (Position of Window): document window-text-area-pixel-edges. - - * lispref/positions.texi (Screen Lines): cleanup docs for - vertical-motion and vertical-motion-pixels. - -1998-06-10 Hrvoje Niksic - - * lispref/windows.texi (Resizing Windows): Document - `enlarge-window-pixels' and `shrink-window-pixels'. - - * lispref/positions.texi (Screen Lines): Update documentation of - `vertical-motion'. - (Screen Lines): Document `vertical-motion-pixels'. - - * lispref/frames.texi (Input Focus): Document `focus-frame', - `save-selected-frame' and `with-selected-frame'. - -1998-06-10 Hrvoje Niksic - - * lispref/searching.texi (Regexp Search): Document `split-path'. - - * lispref/files.texi (Unique File Names): Update docs for - `make-temp-name'; document `temp-directory'. - -1998-06-10 Hrvoje Niksic - - * lispref/os.texi (Recording Input): Update docs for `recent-keys'. - - * lispref/specifiers.texi (Specifier Instancing): Correct - instantiation order. - (Specifier Instancing Functions): Ditto. - -1998-06-11 Oliver Graf - - * lispref/lispref.texi: references to Drag'n'Drop fixed - * lispref/modes.texi: references to Drag'n'Drop fixed - * lispref/scrollbars.texi: references to Drag'n'Drop fixed - * lispref/dragndrop.texi: naming changed to Drag and Drop - added some docu about the drop procedure - -1998-06-09 Adrian Aichner - - * info-stnd.texi: added ../info/ to @setfilename. - * info.texi: added ../info/ to @setfilename. - * lispref/commands.texi: see ALL. - * lispref/frames.texi: see ALL. - * lispref/os.texi: see ALL. - * lispref/text.texi: see ALL. - * new-users-guide/custom1.texi: broke line after enumerated @item. - * new-users-guide/custom2.texi: see ALL. - * new-users-guide/edit.texi: see ALL. - * new-users-guide/enter.texi: see ALL. - * new-users-guide/files.texi: see ALL. - * new-users-guide/help.texi - * new-users-guide/modes.texi: see ALL. - * new-users-guide/new-users-guide.texi: see ALL. - * new-users-guide/region.texi: see ALL. - * new-users-guide/search.texi: see ALL. - * new-users-guide/xmenu.texi: see ALL. - * standards.texi: added ../info/ to @setfilename. - * texinfo.texi: added ../info/ to @setfilename, broke line after - @noindent. Changed @var{arg-not-used-by-@TeX{}} to - @var{arg-not-used-by-@@TeX{}} to make `texinfo-format-buffer' - happy. - * xemacs-faq.texi: added ../info/ to @setfilename. - * ALL: corrected INFO-FILE-NAME to lispref and xemacs in relevant - p?xefs (most were empty, some elisp and emacs), used - PRINTED-MANUAL-TITLE "XEmacs Lisp Reference Manual" and "XEmacs - User's Manual" respectively for all these. - -1998-06-01 Oliver Graf - - * lispref/dragndrop.texi: added experimental - -1998-05-28 Oliver Graf - - * lispref/dragndrop.texi: a warning, and a bit more text this time - -1998-05-26 Oliver Graf - - * lispref/dragndrop.texi: only small changes - -1998-05-15 Christian Nybø - - * xemacs/killing.texi: Properly document `zap-to-char'. - -1998-05-13 Greg Klanderman - - * lispref/frames.texi (Input Focus): cleanup select-frame - documentation. - -1998-05-10 Oliver Graf - - * lispref/dragndrop.texi: new section for the DnD API - * lispref/lispref.texi: added Drag'n'Drop between scrollbars and - modes - * lispref/modes.texi: changed back-ref to Drag'n'Drop - * lispref/scrollbars.texi: changed next-ref to Drag'n'Drop - -1998-05-05 Oliver Graf - - * commands.texi: exchange of dnd-drop with misc-user - -1998-05-04 Martin Buchholz - - * internals.texi (Techniques for XEmacs Developers): Add some more - comments on adding new files, inspired by Olivier Galibert. - -1998-05-02 Hrvoje Niksic - - * lispref/windows.texi (Vertical Scrolling): Fixup docstring for - scroll-conservatively. - - * lispref/loading.texi (Named Features): Document advanced args to - `feature'. - - * lispref/files.texi (File Name Expansion): Document that - expand-file-name does not treat // and ~/ in the middle of file - names specially. - - * lispref/positions.texi (Excursions): Document - `with-current-buffer' and `with-temp-file'. - - * lispref/strings.texi (Formatting Strings): Document `%*' - construct. - - * lispref/os.texi (Time Conversion): Document that TIME may be - omitted from format-time-string. - - * lispref/strings.texi (String Conversion): Document BASE argument - to `string-to-number'. - - * lispref/searching.texi (Syntax of Regexps): Fix up Perl - constructs documentation. - (Regexp Search): Document `split-string'. - - * xemacs/display.texi (Scrolling): Document scroll-conservatively. - - * xemacs/killing.texi (Active Regions): Document that errors no - longer highlight the region. - - * lispref/display.texi (The Echo Area): Document message log - stuff, including `display-message', `lmessage', `clear-message', - (Warnings): Document warning stuff. - - * lispref/commands.texi (Working With Events): Update `make-event' - for misc-user events. - (Using Interactive): Document `function-interactive'. - - * lispref/os.texi (System Environment): Document USE-FLOATS - argument to `load-average'. - (User Identification): Document the new semantics of - `user-full-name'. - - * lispref/strings.texi (Creating Strings): Document `string' - function. - -1998-05-02 Hrvoje Niksic - - * lispref/numbers.texi (Comparison of Numbers): Document multi-arg - comparison functions. - -1998-04-30 Greg Klanderman - - * lispref/frames.texi (Input Focus): Document behavior of - select-frame wrt focus-follows-mouse. - -1998-04-30 Martin Buchholz - - * Makefile: Support generic makes by avoiding `%' syntax. - It breaks my heart to uglify the Makefile like this, but this is - going to be a perpetual FAQ otherwise. - General cleanup. - Comment out w3 and vm info rules. - Use paranoid cd ./$@ syntax to avoid losing with luser's CDPATH. - -1998-03-27 Stephen Turnbull - - * xemacs/frame.texi: Document cursor appearance at end of line. - -1998-03-14 Hrvoje Niksic - - * internals/internals.texi (GCPROing): Explain when it is - necessary to GCPRO function parameters. - -1998-03-13 Hrvoje Niksic - - * internals/internals.texi (Writing Lisp Primitives): Updated - definition of For(). - -1998-03-01 Aki Vehtari - - * lispref/menus.texi: Use recommended forms in examples. - -1998-02-22 Karl M. Hegbloom - - * cl.texi (Creating Symbols): Tell a little bit about the new - handling of gensyms. - -1998-02-21 Greg Klanderman - - * xemacs/custom.texi (X Resources): update to describe automatic - setting of x-emacs-application-class. - - * lispref/x-windows.texi (Resources): update doc for - x-emacs-application-class. - -1998-02-20 Karl M. Hegbloom - - * cl.texi (Equality Predicates): Update to reflect change to - `equalp' made in "cl-extra.el" - now compares characters case - insensitively. - -1998-02-23 Aki Vehtari - - * lispref/menus.texi (Menu Format): Doc fix: suffix can be form. - -1998-02-19 Karl M. Hegbloom - - * lispref/display.texi (Beeping): Linux has sound too. - -1998-02-19 Hrvoje Niksic - - * cl.texi (Argument Lists): Keywords are handled specially by - XEmacs. - (Porting Common Lisp): XEmacs backquotes are OK. - -1998-02-19 Karl M. Hegbloom - - * xemacs/custom.texi (Init Syntax): document #b, #o, and #x reader - syntax for integers. - From Adrian Aichner - * cl.texi (Porting Common Lisp): ' ' - * lispref/numbers.texi (Numbers): ' ' - -1998-02-15 Karl M. Hegbloom - - * lispref/searching.texi (Regular Expressions): Document the - recent regular expression syntax extensions. - -1998-02-10 Olivier Galibert - - * internals/internals.texi: Remove all mocklisp references. - -1997-12-17 SL Baur - - * Makefile (SUBDIR): skk and gnats are packaged. - - * lispref/intro.texi (Acknowledgements): Update to v3.3. - - * lispref/lispref.texi: Update to 20.5/v3.3. - -1997-12-10 SL Baur - - * Makefile: Don't stop on errors. - -1997-12-06 SL Baur - - * Makefile: add skk manual. - -1997-11-29 SL Baur - - * internals/internals.texi (XEmacs): Updated history section. - -1997-11-28 SL Baur - - * lispref/compile.texi (Compilation Functions): Plug in the real - return value. - (Speed of Byte-Code): Ditto. - (Compilation Functions): Ditto. - (Compiled-Function Objects): Ditto. - (Speed of Byte-Code): Increase loop counter by factor of 50 (the - previous value was embarrassing). - -1997-11-21 SL Baur - - * Makefile (srcs): vhdl-mode has been packaged. - -1997-11-15 SL Baur - - * lispref/windows.texi (scroll-conservatively): Fix typo. - -1997-11-12 Hrvoje Niksic - - * lispref/commands.texi (Working With Events): Document fully. - - * lispref/windows.texi (Vertical Scrolling): Document - scroll-conservatively. - -1997-11-09 Hrvoje Niksic - - * lispref/extents.texi (Intro to Extents): Minor correction. - (Extent Properties): Document `extent-keymap'. - -1997-11-03 MORIOKA Tomohiko - - * xemacs/mule.texi (Mule): Modify description about supported - scripts. - -1997-11-02 MORIOKA Tomohiko - - * xemacs/mule.texi: Add description for - `universal-coding-system-argument'. - -1997-10-31 SL Baur - - * internals/internals.texi: XEmacs 19.16 is released. - -1997-10-30 SL Baur - - * Makefile (srcs): Mailcrypt, hm--html-menus, vm, psgml and tm have - been packaged. - -1997-10-22 Hrvoje Niksic - - * xemacs-faq.texi: Added the detailed menu listing. - - * lispref/extents.texi (Extent Properties): Documented - `set-extent-properties'. - - * xemacs/custom.texi (Face Customization): Updated for XEmacs. - -1997-10-07 SL Baur - - * xemacs-faq.texi (Q1.3.7): Update Russion URLs. - From Rebecca Ore - - * lispref/databases.texi (Connecting to a Database): Describe - valid types of `type' and `subtype'. - From Raymond Toy - -1997-10-01 Karl M. Hegbloom - - * lispref/commands.texi (Keyboard Macros): fixed typo. Changed - reference to (emacs) into a reference to (xemacs). - -1997-10-01 Karl M. Hegbloom - - * lispref/keymaps.texi (Keymaps): untabified and reformatted menu - to prevent line wrap. - -1997-09-27 SL Baur - - * gnats/flowchart.eps: New file. - -1997-09-23 Hrvoje Niksic - - * xemacs/custom.texi (Easy Customization): Ditto. - - * xemacs/xemacs.texi (Top): Added pointer to easy customization. - -1997-09-18 SL Baur - - * internals/Makefile (../../info/$(NAME).info): Warn and clean up - if someone hasn't upgraded makeinfo. - - * Makefile (EMACS): Refer to xemacs binary in source tree. - * tm/Makefile (EMACS): Ditto. - -1997-08-15 Karl M. Hegbloom - - * cl.texi (Type Predicates): Update for corrected handling of - `string-char' and `character'. - -Tue Aug 5 21:56:02 1997 Barry A. Warsaw - - * cc-mode.texi: - In FAQ section, document use of c-mode-base-map instead of c-mode-map. - -Fri Aug 1 22:44:49 1997 Barry A. Warsaw - - * cc-mode.texi: Removed the description of c-enable-//-in-c-mode. - -Wed Jul 30 00:01:45 1997 Barry A. Warsaw - - * cc-mode.texi: - Added description of template-args-cont syntactic symbol - -1997-07-25 Barry A. Warsaw - - * cc-mode.texi: Describe support for idl-mode - - * cc-mode.texi: - Document c-initialization-hook. Also rewrite the "Getting Connected" - section on byte compiling the source. - -1997-07-21 Karl M. Hegbloom - - * lispref/streams.texi: "Output Streams", change `last-output' - result list from integers to characters. - - * lispref/minibuf.texi: "Object from Minibuffer", correction. - - * lispref/minibuf.texi: "Minibuffer History", add - `Info-minibuffer-history', `Manual-page-minibuffer-history', and - short paragraph refering to `M-x apropos'. - -1997-07-17 Steven L Baur - - * Makefile: makeinfo-1.68 is verified to work. - - * tm/Makefile (../../info/%-ja.info): Die if not running - XEmacs/Mule. - (../../info/%-en.info): Inherit setting of MAKEINFO. - -Tue Jul 15 04:18:38 1997 Barry A. Warsaw - - * cc-mode.texi: - Describe the variable c-indent-comments-syntactically-p. - -1997-07-15 Steven L Baur - - * internals/internals.texi (Top): Convert Buffer@'s node name to - `Buffer's' because the former confuses makeinfo. - -Thu Jul 3 22:54:03 1997 Barry A. Warsaw - - * cc-mode.texi: Fixed spelling of Texinfo - -Tue May 6 21:33:06 1997 Steven L Baur - - * lispref/files.texi (Writing to Files): Correct docstring of - write-region. - -Sun May 4 14:28:32 1997 Steven L Baur - - * lispref/annotations.texi (Annotation Primitives): - `delete-annotation' does not return the deleted annotation. - -Wed Apr 30 18:13:16 1997 Steven L Baur - - * lispref/lispref.texi: Correct release dates. - -Sat Apr 19 20:48:00 1997 Steven L Baur - - * lispref/files.texi (File Name Expansion): Update documentation - of file-relative-name. - -Mon Apr 7 21:02:39 1997 Steven L Baur - - * lispref/lispref.texi: Update version numbers (with patches from - Hrvoje Niksic). - - * lispref/building.texi (Building XEmacs): Update version numbers - and build identification. - - * lispref/intro.texi (Introduction): Update version number. - -Sun Mar 23 15:47:05 1997 Steven L Baur - - * Makefile (srcs): Add efs.texi. - -Sat Mar 22 16:39:16 1997 Steven L Baur - - * Makefile (srcs): Add hm--html-mode.texi. - -Sun Mar 16 18:48:14 1997 Steven L Baur - - * gnats/Makefile (gnats_srcs): New manuals for GNATS. - -Wed Mar 12 14:39:43 1997 Steven L Baur - - * lispref/strings.texi (Text Comparison): Correct example for - `char-equal'. Add new function `char='. - -Thu Mar 6 13:33:54 1997 Steven L Baur - - * Makefile: Update for new texinfo manual. - -Tue Mar 4 11:37:42 1997 Steven L Baur - - * Makefile (../info/w3.info): Use special version of makeinfo - since this manual is not backwards compatible. - Clean up error handling so we only have to type make once to - rebuild the info tree. - (../info/vm.info): Make sure to continue in the event of error. - -Tue Feb 25 20:17:53 1997 Steven L Baur - - * auctex/Makefile: Added `mostlyclean' and `distclean' target. - -Wed Feb 19 17:57:27 1997 Steven L Baur - - * Makefile (auctex): New subdirectory target. - -Wed Feb 12 12:30:27 1997 Yotam Medini - - * mule/languages.texi: Correct typo. - -Mon Feb 10 08:17:22 1997 Steven L Baur - - * Makefile (srcs): Add custom and widget to srcs. - - * lispref/extents.texi (Intro to Extents): Removed erroneous - reference to `start-glyph' property. - -Sun Feb 9 00:27:22 1997 Per Abrahamsen - - * widget.texi: New file. - - * custom.texi: New file. - -Thu Feb 6 22:57:09 1997 Steven L Baur - - * lispref/extents.texi (Duplicable Extents): replicable extents - are history. - -Wed Jan 29 19:59:41 1997 Steven L Baur - - * xemacs-faq.texi (Q1.1.1): Correct typos. - -Mon Jan 27 22:28:48 1997 Bob Weiner - - * xemacs-faq.texi (Q1.0.14): infodock.com has hardcopies of the - XEmacs manual available. - (Q4.6.1): Updated Infodock Information. - -Sat Dec 28 11:08:07 1996 Martin Buchholz - - * vhdl-mode.texi: Correct typo in email address. - -Mon Dec 23 09:47:24 1996 Martin Buchholz - - * Makefile (srcs): Add vhdl-mode. - -Wed Dec 18 20:21:06 1996 Martin Buchholz - - * Makefile (realclean): Don't delete itself `make distclean' - - * lispref/numbers.texi (Predicates on Numbers): wholenump->natnump. - - * Makefile: New File. - -Tue Dec 10 18:35:21 1996 Rod Whitby - - * vhdl-mode.texi: New file. - -Thu Jan 24 12:41:33 1991 Richard Stallman (rms at mole.ai.mit.edu) - - * texinfo.tex: Delete spurious character at beginning. - -Tue Aug 16 13:09:12 1988 Robert J. Chassell (bob at frosted-flakes.ai.mit.edu) - - * emacs.tex: Corrected two typos. No other changes before - Version 19 will be made. - - * vip.texinfo: Removed menu entry Adding Lisp Code in node - Customization since the menu entry did not point to anything. - Also added an @finalout command to remove overfull hboxes from the - printed output. - - * cl.texinfo: Added @bye, \input line and @settitle to file. - This file is clearly intended to be a chapter of some other work, - but the other work does not yet exist. - -Mon Jul 25 17:47:38 1988 Robert J. Chassell (bob at frosted-flakes.ai.mit.edu) - - * texinfo.texinfo: Three typos corrected. - -Mon Jul 11 18:02:29 1988 Chris Hanson (cph at kleph) - - * texindex.c (indexify): when comparing to initial strings to - decide whether to change the header, must use `strncmp' to avoid - comparing entire strings of which initials are a substring. - -Sun Jun 26 18:46:16 1988 Richard Stallman (rms at sugar-bombs.ai.mit.edu) - - * texindex.c (sort_in_core, sort_offline, parsefile): - Give up on input file if any line doesn't start with backslash. - -Mon May 23 10:41:35 1988 Robert J. Chassell (bob at frosted-flakes.ai.mit.edu) - - * emacs.tex: Update information for obtaining TeX distribution from the - University of Washington. - diff --git a/man/Makefile b/man/Makefile deleted file mode 100644 index 7c013c5..0000000 --- a/man/Makefile +++ /dev/null @@ -1,156 +0,0 @@ -# Makefile for man subdirectory in XEmacs -# Copyright (C) 1995 Board of Trustees, University of Illinois -# Copyright (C) 1994, 1995 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. - -# Avoid trouble on systems where the "SHELL" variable might be -# inherited from the environment. -SHELL = /bin/sh - -EMACS = ../src/xemacs -EMACSFLAGS = -batch -q -no-site-file - -# NOTE: You *must* have makeinfo-1.68 or later to rebuild the -# info tree. -MAKEINFO = makeinfo -TEXI2DVI = texi2dvi - -.SUFFIXES: -.SUFFIXES: .info .texi .dvi - -RECURSIVE_MAKE = $(MAKE) $(MFLAGS) MAKEINFO='$(MAKEINFO)' TEXI2DVI='$(TEXI2DVI)' - -# Ughhh! The things we do to have portable makefiles... - -INFODIR = ../info - -info_files = \ - $(INFODIR)/cl.info \ - $(INFODIR)/custom.info \ - $(INFODIR)/external-widget.info \ - $(INFODIR)/info.info \ - $(INFODIR)/standards.info \ - $(INFODIR)/term.info \ - $(INFODIR)/termcap.info \ - $(INFODIR)/texinfo.info \ - $(INFODIR)/widget.info \ - $(INFODIR)/xemacs-faq.info - -dvi_files = \ - cl.dvi \ - custom.dvi \ - external-widget.dvi \ - info.dvi \ - standards.dvi \ - term.dvi \ - termcap.dvi \ - texinfo.dvi \ - widget.dvi \ - xemacs-faq.dvi - -../info/cl.info : cl.texi - -$(MAKEINFO) cl.texi -o ../info/cl.info - -../info/custom.info : custom.texi - -$(MAKEINFO) custom.texi -o ../info/custom.info - -../info/external-widget.info : external-widget.texi - -$(MAKEINFO) external-widget.texi -o ../info/external-widget.info - -../info/info.info : info.texi - -$(MAKEINFO) info.texi -o ../info/info.info - -../info/standards.info : standards.texi - -$(MAKEINFO) standards.texi -o ../info/standards.info - -../info/term.info : term.texi - -$(MAKEINFO) term.texi -o ../info/term.info - -../info/termcap.info : termcap.texi - -$(MAKEINFO) termcap.texi -o ../info/termcap.info - -../info/texinfo.info : texinfo.texi - -$(MAKEINFO) texinfo.texi -o ../info/texinfo.info - -../info/widget.info : widget.texi - -$(MAKEINFO) widget.texi -o ../info/widget.info - -../info/xemacs-faq.info : xemacs-faq.texi - -$(MAKEINFO) xemacs-faq.texi -o ../info/xemacs-faq.info - - -# ../info/w3.info : w3.texi -# -$(MAKEINFO) w3.texi -o ../info/w3.info - -# ../info/vm.info : vm.texi -# -$(EMACS) $(EMACSFLAGS) -insert vm.texi -l texinfmt \ -# -f texinfo-format-buffer -f save-buffer -# -mv vm.info* ../info - -# special = # ../info/w3.info ../info/vm.info ../info/texinfo.info - -all: info - -# Subdirectories to make recursively. -SUBDIR = xemacs lispref new-users-guide internals -.PHONY: $(SUBDIR) - -info : $(info_files) - -for d in $(SUBDIR) ; do (cd ./$$d && $(RECURSIVE_MAKE) $@) ; done - -.PHONY: info dvi - -xemacs: FRC.xemacs - -cd ./$@ && $(RECURSIVE_MAKE) -lispref: FRC.lispref - -cd ./$@ && $(RECURSIVE_MAKE) -new-users-guide: FRC.new-users-guide - -cd ./$@ && $(RECURSIVE_MAKE) -internals: FRC.internals - -cd ./$@ && $(RECURSIVE_MAKE) -# tm: FRC.tm -# -cd ./$@ && $(RECURSIVE_MAKE) -# gnats: FRC.gnats -# -cd ./$@ && $(RECURSIVE_MAKE) -# FRC.xemacs FRC.lispref FRC.new-users-guide FRC.internals FRC.tm FRC.gnats: -FRC.info FRC.dvi FRC.xemacs FRC.lispref FRC.new-users-guide FRC.internals: - - -.texi.dvi: - $(TEXI2DVI) $< - -dvi : $(dvi_files) - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - - -.PHONY: mostlyclean clean distclean realclean extraclean -mostlyclean: - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - rm -f *.toc *.aux *.log *.op \ - *.cp *.cps *.fn *.fns *.ky *.kys *.pg *.pgs *.vr *.vrs *.tp *.tps -clean: mostlyclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - rm -f *.o core *.dvi -distclean: clean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done -realclean: distclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done -extraclean: distclean - -for d in $(SUBDIR) ; do (cd ./$${d} && $(RECURSIVE_MAKE) $@) ; done - -rm -f *~ \#* diff --git a/man/cl.texi b/man/cl.texi deleted file mode 100644 index f7607c9..0000000 --- a/man/cl.texi +++ /dev/null @@ -1,5754 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@setfilename ../info/cl.info -@settitle Common Lisp Extensions - -@iftex -@finalout -@end iftex - -@ifinfo -This file documents the GNU Emacs Common Lisp emulation package. - -Copyright (C) 1993 Free Software Foundation, Inc. - -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 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 ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the author instead of in the -original English. -@end ifinfo - -@titlepage -@sp 6 -@center @titlefont{Common Lisp Extensions} -@sp 4 -@center For GNU Emacs Lisp -@sp 1 -@center Version 2.02 -@sp 5 -@center Dave Gillespie -@center daveg@@synaptics.com -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1993 Free Software Foundation, Inc. - -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 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 ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the author instead of in the -original English. -@end titlepage - -@node Top, Overview,, (dir) -@chapter Common Lisp Extensions - -@noindent -This document describes a set of Emacs Lisp facilities borrowed from -Common Lisp. All the facilities are described here in detail; for -more discussion and examples, Guy L. Steele's @cite{Common Lisp, the -Language}, second edition, is the definitive book on Common Lisp. -@iftex -Chapter numbers and most section numbers of this document parallel -those of Steele's book. -@end iftex -While this document does not assume any prior knowledge of Common -Lisp, it does assume a basic familiarity with Emacs Lisp. - -@menu -* Overview:: Installation, usage, etc. -* Program Structure:: Arglists, `eval-when', `defalias' -* Predicates:: `typep', `eql', and `equalp' -* Control Structure:: `setf', `when', `do', `loop', etc. -* Macros:: Destructuring, `define-compiler-macro' -* Declarations:: `proclaim', `declare', etc. -* Symbols:: Property lists, `gensym' -* Numbers:: Predicates, functions, random numbers -* Sequences:: Mapping, functions, searching, sorting -* Lists:: `cadr', `sublis', `member*', `assoc*', etc. -* Hash Tables:: `make-hash-table', `gethash', etc. -* Structures:: `defstruct' -* Assertions:: `check-type', `assert', `ignore-errors'. - -* Efficiency Concerns:: Hints and techniques -* Common Lisp Compatibility:: All known differences with Steele -* Old CL Compatibility:: All known differences with old cl.el -* Porting Common Lisp:: Hints for porting Common Lisp code - -* Function Index:: -* Variable Index:: -@end menu - -@node Overview, Program Structure, Top, Top -@ifinfo -@chapter Overview -@end ifinfo -@iftex -@section Overview -@end iftex - -@noindent -Common Lisp is a huge language, and Common Lisp systems tend to be -massive and extremely complex. Emacs Lisp, by contrast, is rather -minimalist in the choice of Lisp features it offers the programmer. -As Emacs Lisp programmers have grown in number, and the applications -they write have grown more ambitious, it has become clear that Emacs -Lisp could benefit from many of the conveniences of Common Lisp. - -The @dfn{CL} package adds a number of Common Lisp functions and -control structures to Emacs Lisp. While not a 100% complete -implementation of Common Lisp, @dfn{CL} adds enough functionality -to make Emacs Lisp programming significantly more convenient. - -Some Common Lisp features have been omitted from this package -for various reasons: - -@itemize @bullet -@item -Some features are too complex or bulky relative to their benefit -to Emacs Lisp programmers. CLOS and Common Lisp streams are fine -examples of this group. - -@item -Other features cannot be implemented without modification to the -Emacs Lisp interpreter itself, such as multiple return values, -lexical scoping, case-insensitive symbols, and complex numbers. -The @dfn{CL} package generally makes no attempt to emulate these -features. - -@item -Some features conflict with existing things in Emacs Lisp. For -example, Emacs' @code{assoc} function is incompatible with the -Common Lisp @code{assoc}. In such cases, this package usually -adds the suffix @samp{*} to the function name of the Common -Lisp version of the function (e.g., @code{assoc*}). -@end itemize - -The package described here was written by Dave Gillespie, -@file{daveg@@synaptics.com}. It is a total rewrite of the original -1986 @file{cl.el} package by Cesar Quiroz. Most features of -the Quiroz package have been retained; any incompatibilities are -noted in the descriptions below. Care has been taken in this -version to ensure that each function is defined efficiently, -concisely, and with minimal impact on the rest of the Emacs -environment. - -@menu -* Usage:: How to use the CL package -* Organization:: The package's five component files -* Installation:: Compiling and installing CL -* Naming Conventions:: Notes on CL function names -@end menu - -@node Usage, Organization, Overview, Overview -@section Usage - -@noindent -Lisp code that uses features from the @dfn{CL} package should -include at the beginning: - -@example -(require 'cl) -@end example - -@noindent -If you want to ensure that the new (Gillespie) version of @dfn{CL} -is the one that is present, add an additional @code{(require 'cl-19)} -call: - -@example -(require 'cl) -(require 'cl-19) -@end example - -@noindent -The second call will fail (with ``@file{cl-19.el} not found'') if -the old @file{cl.el} package was in use. - -It is safe to arrange to load @dfn{CL} at all times, e.g., -in your @file{.emacs} file. But it's a good idea, for portability, -to @code{(require 'cl)} in your code even if you do this. - -@node Organization, Installation, Usage, Overview -@section Organization - -@noindent -The Common Lisp package is organized into four files: - -@table @file -@item cl.el -This is the ``main'' file, which contains basic functions -and information about the package. This file is relatively -compact---about 700 lines. - -@item cl-extra.el -This file contains the larger, more complex or unusual functions. -It is kept separate so that packages which only want to use Common -Lisp fundamentals like the @code{cadr} function won't need to pay -the overhead of loading the more advanced functions. - -@item cl-seq.el -This file contains most of the advanced functions for operating -on sequences or lists, such as @code{delete-if} and @code{assoc*}. - -@item cl-macs.el -This file contains the features of the packages which are macros -instead of functions. Macros expand when the caller is compiled, -not when it is run, so the macros generally only need to be -present when the byte-compiler is running (or when the macros are -used in uncompiled code such as a @file{.emacs} file). Most of -the macros of this package are isolated in @file{cl-macs.el} so -that they won't take up memory unless you are compiling. -@end table - -The file @file{cl.el} includes all necessary @code{autoload} -commands for the functions and macros in the other three files. -All you have to do is @code{(require 'cl)}, and @file{cl.el} -will take care of pulling in the other files when they are -needed. - -There is another file, @file{cl-compat.el}, which defines some -routines from the older @file{cl.el} package that are no longer -present in the new package. This includes internal routines -like @code{setelt} and @code{zip-lists}, deprecated features -like @code{defkeyword}, and an emulation of the old-style -multiple-values feature. @xref{Old CL Compatibility}. - -@node Installation, Naming Conventions, Organization, Overview -@section Installation - -@noindent -Installation of the @dfn{CL} package is simple: Just put the -byte-compiled files @file{cl.elc}, @file{cl-extra.elc}, -@file{cl-seq.elc}, @file{cl-macs.elc}, and @file{cl-compat.elc} -into a directory on your @code{load-path}. - -There are no special requirements to compile this package: -The files do not have to be loaded before they are compiled, -nor do they need to be compiled in any particular order. - -You may choose to put the files into your main @file{lisp/} -directory, replacing the original @file{cl.el} file there. Or, -you could put them into a directory that comes before @file{lisp/} -on your @code{load-path} so that the old @file{cl.el} is -effectively hidden. - -Also, format the @file{cl.texinfo} file and put the resulting -Info files in the @file{info/} directory or another suitable place. - -You may instead wish to leave this package's components all in -their own directory, and then add this directory to your -@code{load-path} and (Emacs 19 only) @code{Info-directory-list}. -Add the directory to the front of the list so the old @dfn{CL} -package and its documentation are hidden. - -@node Naming Conventions, , Installation, Overview -@section Naming Conventions - -@noindent -Except where noted, all functions defined by this package have the -same names and calling conventions as their Common Lisp counterparts. - -Following is a complete list of functions whose names were changed -from Common Lisp, usually to avoid conflicts with Emacs. In each -case, a @samp{*} has been appended to the Common Lisp name to obtain -the Emacs name: - -@example -defun* defsubst* defmacro* function* -member* assoc* rassoc* get* -remove* delete* mapcar* sort* -floor* ceiling* truncate* round* -mod* rem* random* -@end example - -Internal function and variable names in the package are prefixed -by @code{cl-}. Here is a complete list of functions @emph{not} -prefixed by @code{cl-} which were not taken from Common Lisp: - -@example -member delete remove remq -rassoc floatp-safe lexical-let lexical-let* -callf callf2 letf letf* -defsubst* defalias add-hook eval-when-compile -@end example - -@noindent -(Most of these are Emacs 19 features provided to Emacs 18 users, -or introduced, like @code{remq}, for reasons of symmetry -with similar features.) - -The following simple functions and macros are defined in @file{cl.el}; -they do not cause other components like @file{cl-extra} to be loaded. - -@example -eql floatp-safe abs endp -evenp oddp plusp minusp -last butlast nbutlast caar .. cddddr -list* ldiff rest first .. tenth -member [1] copy-list subst mapcar* [2] -adjoin [3] acons pairlis when -unless pop [4] push [4] pushnew [3,4] -incf [4] decf [4] proclaim declaim -add-hook -@end example - -@noindent -[1] This is the Emacs 19-compatible function, not @code{member*}. - -@noindent -[2] Only for one sequence argument or two list arguments. - -@noindent -[3] Only if @code{:test} is @code{eq}, @code{equal}, or unspecified, -and @code{:key} is not used. - -@noindent -[4] Only when @var{place} is a plain variable name. - -@iftex -@chapno=4 -@end iftex - -@node Program Structure, Predicates, Overview, Top -@chapter Program Structure - -@noindent -This section describes features of the @dfn{CL} package which have to -do with programs as a whole: advanced argument lists for functions, -and the @code{eval-when} construct. - -@menu -* Argument Lists:: `&key', `&aux', `defun*', `defmacro*'. -* Time of Evaluation:: The `eval-when' construct. -* Function Aliases:: The `defalias' function. -@end menu - -@iftex -@secno=1 -@end iftex - -@node Argument Lists, Time of Evaluation, Program Structure, Program Structure -@section Argument Lists - -@noindent -Emacs Lisp's notation for argument lists of functions is a subset of -the Common Lisp notation. As well as the familiar @code{&optional} -and @code{&rest} markers, Common Lisp allows you to specify default -values for optional arguments, and it provides the additional markers -@code{&key} and @code{&aux}. - -Since argument parsing is built-in to Emacs, there is no way for -this package to implement Common Lisp argument lists seamlessly. -Instead, this package defines alternates for several Lisp forms -which you must use if you need Common Lisp argument lists. - -@defspec defun* name arglist body... -This form is identical to the regular @code{defun} form, except -that @var{arglist} is allowed to be a full Common Lisp argument -list. Also, the function body is enclosed in an implicit block -called @var{name}; @pxref{Blocks and Exits}. -@end defspec - -@defspec defsubst* name arglist body... -This is just like @code{defun*}, except that the function that -is defined is automatically proclaimed @code{inline}, i.e., -calls to it may be expanded into in-line code by the byte compiler. -This is analogous to the @code{defsubst} form in Emacs 19; -@code{defsubst*} uses a different method (compiler macros) which -works in all version of Emacs, and also generates somewhat more -efficient inline expansions. In particular, @code{defsubst*} -arranges for the processing of keyword arguments, default values, -etc., to be done at compile-time whenever possible. -@end defspec - -@defspec defmacro* name arglist body... -This is identical to the regular @code{defmacro} form, -except that @var{arglist} is allowed to be a full Common Lisp -argument list. The @code{&environment} keyword is supported as -described in Steele. The @code{&whole} keyword is supported only -within destructured lists (see below); top-level @code{&whole} -cannot be implemented with the current Emacs Lisp interpreter. -The macro expander body is enclosed in an implicit block called -@var{name}. -@end defspec - -@defspec function* symbol-or-lambda -This is identical to the regular @code{function} form, -except that if the argument is a @code{lambda} form then that -form may use a full Common Lisp argument list. -@end defspec - -Also, all forms (such as @code{defsetf} and @code{flet}) defined -in this package that include @var{arglist}s in their syntax allow -full Common Lisp argument lists. - -Note that it is @emph{not} necessary to use @code{defun*} in -order to have access to most @dfn{CL} features in your function. -These features are always present; @code{defun*}'s only -difference from @code{defun} is its more flexible argument -lists and its implicit block. - -The full form of a Common Lisp argument list is - -@example -(@var{var}... - &optional (@var{var} @var{initform} @var{svar})... - &rest @var{var} - &key ((@var{keyword} @var{var}) @var{initform} @var{svar})... - &aux (@var{var} @var{initform})...) -@end example - -Each of the five argument list sections is optional. The @var{svar}, -@var{initform}, and @var{keyword} parts are optional; if they are -omitted, then @samp{(@var{var})} may be written simply @samp{@var{var}}. - -The first section consists of zero or more @dfn{required} arguments. -These arguments must always be specified in a call to the function; -there is no difference between Emacs Lisp and Common Lisp as far as -required arguments are concerned. - -The second section consists of @dfn{optional} arguments. These -arguments may be specified in the function call; if they are not, -@var{initform} specifies the default value used for the argument. -(No @var{initform} means to use @code{nil} as the default.) The -@var{initform} is evaluated with the bindings for the preceding -arguments already established; @code{(a &optional (b (1+ a)))} -matches one or two arguments, with the second argument defaulting -to one plus the first argument. If the @var{svar} is specified, -it is an auxiliary variable which is bound to @code{t} if the optional -argument was specified, or to @code{nil} if the argument was omitted. -If you don't use an @var{svar}, then there will be no way for your -function to tell whether it was called with no argument, or with -the default value passed explicitly as an argument. - -The third section consists of a single @dfn{rest} argument. If -more arguments were passed to the function than are accounted for -by the required and optional arguments, those extra arguments are -collected into a list and bound to the ``rest'' argument variable. -Common Lisp's @code{&rest} is equivalent to that of Emacs Lisp. -Common Lisp accepts @code{&body} as a synonym for @code{&rest} in -macro contexts; this package accepts it all the time. - -The fourth section consists of @dfn{keyword} arguments. These -are optional arguments which are specified by name rather than -positionally in the argument list. For example, - -@example -(defun* foo (a &optional b &key c d (e 17))) -@end example - -@noindent -defines a function which may be called with one, two, or more -arguments. The first two arguments are bound to @code{a} and -@code{b} in the usual way. The remaining arguments must be -pairs of the form @code{:c}, @code{:d}, or @code{:e} followed -by the value to be bound to the corresponding argument variable. -(Symbols whose names begin with a colon are called @dfn{keywords}, -and they are self-quoting in the same way as @code{nil} and -@code{t}.) - -For example, the call @code{(foo 1 2 :d 3 :c 4)} sets the five -arguments to 1, 2, 4, 3, and 17, respectively. If the same keyword -appears more than once in the function call, the first occurrence -takes precedence over the later ones. Note that it is not possible -to specify keyword arguments without specifying the optional -argument @code{b} as well, since @code{(foo 1 :c 2)} would bind -@code{b} to the keyword @code{:c}, then signal an error because -@code{2} is not a valid keyword. - -If a @var{keyword} symbol is explicitly specified in the argument -list as shown in the above diagram, then that keyword will be -used instead of just the variable name prefixed with a colon. -You can specify a @var{keyword} symbol which does not begin with -a colon at all, but such symbols will not be self-quoting; you -will have to quote them explicitly with an apostrophe in the -function call. - -Ordinarily it is an error to pass an unrecognized keyword to -a function, e.g., @code{(foo 1 2 :c 3 :goober 4)}. You can ask -Lisp to ignore unrecognized keywords, either by adding the -marker @code{&allow-other-keys} after the keyword section -of the argument list, or by specifying an @code{:allow-other-keys} -argument in the call whose value is non-@code{nil}. If the -function uses both @code{&rest} and @code{&key} at the same time, -the ``rest'' argument is bound to the keyword list as it appears -in the call. For example: - -@smallexample -(defun* find-thing (thing &rest rest &key need &allow-other-keys) - (or (apply 'member* thing thing-list :allow-other-keys t rest) - (if need (error "Thing not found")))) -@end smallexample - -@noindent -This function takes a @code{:need} keyword argument, but also -accepts other keyword arguments which are passed on to the -@code{member*} function. @code{allow-other-keys} is used to -keep both @code{find-thing} and @code{member*} from complaining -about each others' keywords in the arguments. - -As a (significant) performance optimization, this package -implements the scan for keyword arguments by calling @code{memq} -to search for keywords in a ``rest'' argument. Technically -speaking, this is incorrect, since @code{memq} looks at the -odd-numbered values as well as the even-numbered keywords. -The net effect is that if you happen to pass a keyword symbol -as the @emph{value} of another keyword argument, where that -keyword symbol happens to equal the name of a valid keyword -argument of the same function, then the keyword parser will -become confused. This minor bug can only affect you if you -use keyword symbols as general-purpose data in your program; -this practice is strongly discouraged in Emacs Lisp. - -The fifth section of the argument list consists of @dfn{auxiliary -variables}. These are not really arguments at all, but simply -variables which are bound to @code{nil} or to the specified -@var{initforms} during execution of the function. There is no -difference between the following two functions, except for a -matter of stylistic taste: - -@example -(defun* foo (a b &aux (c (+ a b)) d) - @var{body}) - -(defun* foo (a b) - (let ((c (+ a b)) d) - @var{body})) -@end example - -Argument lists support @dfn{destructuring}. In Common Lisp, -destructuring is only allowed with @code{defmacro}; this package -allows it with @code{defun*} and other argument lists as well. -In destructuring, any argument variable (@var{var} in the above -diagram) can be replaced by a list of variables, or more generally, -a recursive argument list. The corresponding argument value must -be a list whose elements match this recursive argument list. -For example: - -@example -(defmacro* dolist ((var listform &optional resultform) - &rest body) - ...) -@end example - -This says that the first argument of @code{dolist} must be a list -of two or three items; if there are other arguments as well as this -list, they are stored in @code{body}. All features allowed in -regular argument lists are allowed in these recursive argument lists. -In addition, the clause @samp{&whole @var{var}} is allowed at the -front of a recursive argument list. It binds @var{var} to the -whole list being matched; thus @code{(&whole all a b)} matches -a list of two things, with @code{a} bound to the first thing, -@code{b} bound to the second thing, and @code{all} bound to the -list itself. (Common Lisp allows @code{&whole} in top-level -@code{defmacro} argument lists as well, but Emacs Lisp does not -support this usage.) - -One last feature of destructuring is that the argument list may be -dotted, so that the argument list @code{(a b . c)} is functionally -equivalent to @code{(a b &rest c)}. - -If the optimization quality @code{safety} is set to 0 -(@pxref{Declarations}), error checking for wrong number of -arguments and invalid keyword arguments is disabled. By default, -argument lists are rigorously checked. - -@node Time of Evaluation, Function Aliases, Argument Lists, Program Structure -@section Time of Evaluation - -@noindent -Normally, the byte-compiler does not actually execute the forms in -a file it compiles. For example, if a file contains @code{(setq foo t)}, -the act of compiling it will not actually set @code{foo} to @code{t}. -This is true even if the @code{setq} was a top-level form (i.e., not -enclosed in a @code{defun} or other form). Sometimes, though, you -would like to have certain top-level forms evaluated at compile-time. -For example, the compiler effectively evaluates @code{defmacro} forms -at compile-time so that later parts of the file can refer to the -macros that are defined. - -@defspec eval-when (situations...) forms... -This form controls when the body @var{forms} are evaluated. -The @var{situations} list may contain any set of the symbols -@code{compile}, @code{load}, and @code{eval} (or their long-winded -ANSI equivalents, @code{:compile-toplevel}, @code{:load-toplevel}, -and @code{:execute}). - -The @code{eval-when} form is handled differently depending on -whether or not it is being compiled as a top-level form. -Specifically, it gets special treatment if it is being compiled -by a command such as @code{byte-compile-file} which compiles files -or buffers of code, and it appears either literally at the -top level of the file or inside a top-level @code{progn}. - -For compiled top-level @code{eval-when}s, the body @var{forms} are -executed at compile-time if @code{compile} is in the @var{situations} -list, and the @var{forms} are written out to the file (to be executed -at load-time) if @code{load} is in the @var{situations} list. - -For non-compiled-top-level forms, only the @code{eval} situation is -relevant. (This includes forms executed by the interpreter, forms -compiled with @code{byte-compile} rather than @code{byte-compile-file}, -and non-top-level forms.) The @code{eval-when} acts like a -@code{progn} if @code{eval} is specified, and like @code{nil} -(ignoring the body @var{forms}) if not. - -The rules become more subtle when @code{eval-when}s are nested; -consult Steele (second edition) for the gruesome details (and -some gruesome examples). - -Some simple examples: - -@example -;; Top-level forms in foo.el: -(eval-when (compile) (setq foo1 'bar)) -(eval-when (load) (setq foo2 'bar)) -(eval-when (compile load) (setq foo3 'bar)) -(eval-when (eval) (setq foo4 'bar)) -(eval-when (eval compile) (setq foo5 'bar)) -(eval-when (eval load) (setq foo6 'bar)) -(eval-when (eval compile load) (setq foo7 'bar)) -@end example - -When @file{foo.el} is compiled, these variables will be set during -the compilation itself: - -@example -foo1 foo3 foo5 foo7 ; `compile' -@end example - -When @file{foo.elc} is loaded, these variables will be set: - -@example -foo2 foo3 foo6 foo7 ; `load' -@end example - -And if @file{foo.el} is loaded uncompiled, these variables will -be set: - -@example -foo4 foo5 foo6 foo7 ; `eval' -@end example - -If these seven @code{eval-when}s had been, say, inside a @code{defun}, -then the first three would have been equivalent to @code{nil} and the -last four would have been equivalent to the corresponding @code{setq}s. - -Note that @code{(eval-when (load eval) @dots{})} is equivalent -to @code{(progn @dots{})} in all contexts. The compiler treats -certain top-level forms, like @code{defmacro} (sort-of) and -@code{require}, as if they were wrapped in @code{(eval-when -(compile load eval) @dots{})}. -@end defspec - -Emacs 19 includes two special forms related to @code{eval-when}. -One of these, @code{eval-when-compile}, is not quite equivalent to -any @code{eval-when} construct and is described below. This package -defines a version of @code{eval-when-compile} for the benefit of -Emacs 18 users. - -The other form, @code{(eval-and-compile @dots{})}, is exactly -equivalent to @samp{(eval-when (compile load eval) @dots{})} and -so is not itself defined by this package. - -@defspec eval-when-compile forms... -The @var{forms} are evaluated at compile-time; at execution time, -this form acts like a quoted constant of the resulting value. Used -at top-level, @code{eval-when-compile} is just like @samp{eval-when -(compile eval)}. In other contexts, @code{eval-when-compile} -allows code to be evaluated once at compile-time for efficiency -or other reasons. - -This form is similar to the @samp{#.} syntax of true Common Lisp. -@end defspec - -@defspec load-time-value form -The @var{form} is evaluated at load-time; at execution time, -this form acts like a quoted constant of the resulting value. - -Early Common Lisp had a @samp{#,} syntax that was similar to -this, but ANSI Common Lisp replaced it with @code{load-time-value} -and gave it more well-defined semantics. - -In a compiled file, @code{load-time-value} arranges for @var{form} -to be evaluated when the @file{.elc} file is loaded and then used -as if it were a quoted constant. In code compiled by -@code{byte-compile} rather than @code{byte-compile-file}, the -effect is identical to @code{eval-when-compile}. In uncompiled -code, both @code{eval-when-compile} and @code{load-time-value} -act exactly like @code{progn}. - -@example -(defun report () - (insert "This function was executed on: " - (current-time-string) - ", compiled on: " - (eval-when-compile (current-time-string)) - ;; or '#.(current-time-string) in real Common Lisp - ", and loaded on: " - (load-time-value (current-time-string)))) -@end example - -@noindent -Byte-compiled, the above defun will result in the following code -(or its compiled equivalent, of course) in the @file{.elc} file: - -@example -(setq --temp-- (current-time-string)) -(defun report () - (insert "This function was executed on: " - (current-time-string) - ", compiled on: " - '"Wed Jun 23 18:33:43 1993" - ", and loaded on: " - --temp--)) -@end example -@end defspec - -@node Function Aliases, , Time of Evaluation, Program Structure -@section Function Aliases - -@noindent -This section describes a feature from GNU Emacs 19 which this -package makes available in other versions of Emacs. - -@defun defalias symbol function -This function sets @var{symbol}'s function cell to @var{function}. -It is equivalent to @code{fset}, except that in GNU Emacs 19 it also -records the setting in @code{load-history} so that it can be undone -by a later @code{unload-feature}. - -In other versions of Emacs, @code{defalias} is a synonym for -@code{fset}. -@end defun - -@node Predicates, Control Structure, Program Structure, Top -@chapter Predicates - -@noindent -This section describes functions for testing whether various -facts are true or false. - -@menu -* Type Predicates:: `typep', `deftype', and `coerce' -* Equality Predicates:: `eql' and `equalp' -@end menu - -@node Type Predicates, Equality Predicates, Predicates, Predicates -@section Type Predicates - -@noindent -The @dfn{CL} package defines a version of the Common Lisp @code{typep} -predicate. - -@defun typep object type -Check if @var{object} is of type @var{type}, where @var{type} is a -(quoted) type name of the sort used by Common Lisp. For example, -@code{(typep foo 'integer)} is equivalent to @code{(integerp foo)}. -@end defun - -The @var{type} argument to the above function is either a symbol -or a list beginning with a symbol. - -@itemize @bullet -@item -If the type name is a symbol, Emacs appends @samp{-p} to the -symbol name to form the name of a predicate function for testing -the type. (Built-in predicates whose names end in @samp{p} rather -than @samp{-p} are used when appropriate.) - -@item -The type symbol @code{t} stands for the union of all types. -@code{(typep @var{object} t)} is always true. Likewise, the -type symbol @code{nil} stands for nothing at all, and -@code{(typep @var{object} nil)} is always false. - -@item -The type symbol @code{null} represents the symbol @code{nil}. -Thus @code{(typep @var{object} 'null)} is equivalent to -@code{(null @var{object})}. - -@item -The type symbol @code{real} is a synonym for @code{number}, and -@code{fixnum} is a synonym for @code{integer}. - -@item -The type symbols @code{character} and @code{string-char} match -characters. In Emacs-19 and XEmacs-19, characters are the same thing as -integers in the range 0-255. In XEmacs-20, where characters are a -first-class data type, this checks for actual characters, and -@code{(typep @var{8bit-integer} 'character)} will return @code{nil}. - -@item -The type symbol @code{float} uses the @code{floatp-safe} predicate -defined by this package rather than @code{floatp}, so it will work -correctly even in Emacs versions without floating-point support. - -@item -The type list @code{(integer @var{low} @var{high})} represents all -integers between @var{low} and @var{high}, inclusive. Either bound -may be a list of a single integer to specify an exclusive limit, -or a @code{*} to specify no limit. The type @code{(integer * *)} -is thus equivalent to @code{integer}. - -@item -Likewise, lists beginning with @code{float}, @code{real}, or -@code{number} represent numbers of that type falling in a particular -range. - -@item -Lists beginning with @code{and}, @code{or}, and @code{not} form -combinations of types. For example, @code{(or integer (float 0 *))} -represents all objects that are integers or non-negative floats. - -@item -Lists beginning with @code{member} or @code{member*} represent -objects @code{eql} to any of the following values. For example, -@code{(member 1 2 3 4)} is equivalent to @code{(integer 1 4)}, -and @code{(member nil)} is equivalent to @code{null}. - -@item -Lists of the form @code{(satisfies @var{predicate})} represent -all objects for which @var{predicate} returns true when called -with that object as an argument. -@end itemize - -The following function and macro (not technically predicates) are -related to @code{typep}. - -@defun coerce object type -This function attempts to convert @var{object} to the specified -@var{type}. If @var{object} is already of that type as determined by -@code{typep}, it is simply returned. Otherwise, certain types of -conversions will be made: If @var{type} is any sequence type -(@code{string}, @code{list}, etc.) then @var{object} will be -converted to that type if possible. If @var{type} is -@code{character}, then strings of length one and symbols with -one-character names can be coerced. If @var{type} is @code{float}, -then integers can be coerced in versions of Emacs that support -floats. In all other circumstances, @code{coerce} signals an -error. -@end defun - -@defspec deftype name arglist forms... -This macro defines a new type called @var{name}. It is similar -to @code{defmacro} in many ways; when @var{name} is encountered -as a type name, the body @var{forms} are evaluated and should -return a type specifier that is equivalent to the type. The -@var{arglist} is a Common Lisp argument list of the sort accepted -by @code{defmacro*}. The type specifier @samp{(@var{name} @var{args}...)} -is expanded by calling the expander with those arguments; the type -symbol @samp{@var{name}} is expanded by calling the expander with -no arguments. The @var{arglist} is processed the same as for -@code{defmacro*} except that optional arguments without explicit -defaults use @code{*} instead of @code{nil} as the ``default'' -default. Some examples: - -@example -(deftype null () '(satisfies null)) ; predefined -(deftype list () '(or null cons)) ; predefined -(deftype unsigned-byte (&optional bits) - (list 'integer 0 (if (eq bits '*) bits (1- (lsh 1 bits))))) -(unsigned-byte 8) @equiv{} (integer 0 255) -(unsigned-byte) @equiv{} (integer 0 *) -unsigned-byte @equiv{} (integer 0 *) -@end example - -@noindent -The last example shows how the Common Lisp @code{unsigned-byte} -type specifier could be implemented if desired; this package does -not implement @code{unsigned-byte} by default. -@end defspec - -The @code{typecase} and @code{check-type} macros also use type -names. @xref{Conditionals}. @xref{Assertions}. The @code{map}, -@code{concatenate}, and @code{merge} functions take type-name -arguments to specify the type of sequence to return. @xref{Sequences}. - -@node Equality Predicates, , Type Predicates, Predicates -@section Equality Predicates - -@noindent -This package defines two Common Lisp predicates, @code{eql} and -@code{equalp}. - -@defun eql a b -This function is almost the same as @code{eq}, except that if @var{a} -and @var{b} are numbers of the same type, it compares them for numeric -equality (as if by @code{equal} instead of @code{eq}). This makes a -difference only for versions of Emacs that are compiled with -floating-point support, such as Emacs 19. Emacs floats are allocated -objects just like cons cells, which means that @code{(eq 3.0 3.0)} -will not necessarily be true---if the two @code{3.0}s were allocated -separately, the pointers will be different even though the numbers are -the same. But @code{(eql 3.0 3.0)} will always be true. - -The types of the arguments must match, so @code{(eql 3 3.0)} is -still false. - -Note that Emacs integers are ``direct'' rather than allocated, which -basically means @code{(eq 3 3)} will always be true. Thus @code{eq} -and @code{eql} behave differently only if floating-point numbers are -involved, and are indistinguishable on Emacs versions that don't -support floats. - -There is a slight inconsistency with Common Lisp in the treatment of -positive and negative zeros. Some machines, notably those with IEEE -standard arithmetic, represent @code{+0} and @code{-0} as distinct -values. Normally this doesn't matter because the standard specifies -that @code{(= 0.0 -0.0)} should always be true, and this is indeed -what Emacs Lisp and Common Lisp do. But the Common Lisp standard -states that @code{(eql 0.0 -0.0)} and @code{(equal 0.0 -0.0)} should -be false on IEEE-like machines; Emacs Lisp does not do this, and in -fact the only known way to distinguish between the two zeros in Emacs -Lisp is to @code{format} them and check for a minus sign. -@end defun - -@defun equalp a b -This function is a more flexible version of @code{equal}. In -particular, it compares strings and characters case-insensitively, and -it compares numbers without regard to type (so that @code{(equalp 3 -3.0)} is true). Vectors and conses are compared recursively. All other -objects are compared as if by @code{equal}. - -This function differs from Common Lisp @code{equalp} in several -respects. In keeping with the idea that strings are less -vector-like in Emacs Lisp, this package's @code{equalp} also will not -compare strings against vectors of integers. -@end defun - -Also note that the Common Lisp functions @code{member} and @code{assoc} -use @code{eql} to compare elements, whereas Emacs Lisp follows the -MacLisp tradition and uses @code{equal} for these two functions. -In Emacs, use @code{member*} and @code{assoc*} to get functions -which use @code{eql} for comparisons. - -@node Control Structure, Macros, Predicates, Top -@chapter Control Structure - -@noindent -The features described in the following sections implement -various advanced control structures, including the powerful -@code{setf} facility and a number of looping and conditional -constructs. - -@menu -* Assignment:: The `psetq' form -* Generalized Variables:: `setf', `incf', `push', etc. -* Variable Bindings:: `progv', `lexical-let', `flet', `macrolet' -* Conditionals:: `when', `unless', `case', `typecase' -* Blocks and Exits:: `block', `return', `return-from' -* Iteration:: `do', `dotimes', `dolist', `do-symbols' -* Loop Facility:: The Common Lisp `loop' macro -* Multiple Values:: `values', `multiple-value-bind', etc. -@end menu - -@node Assignment, Generalized Variables, Control Structure, Control Structure -@section Assignment - -@noindent -The @code{psetq} form is just like @code{setq}, except that multiple -assignments are done in parallel rather than sequentially. - -@defspec psetq [symbol form]@dots{} -This special form (actually a macro) is used to assign to several -variables simultaneously. Given only one @var{symbol} and @var{form}, -it has the same effect as @code{setq}. Given several @var{symbol} -and @var{form} pairs, it evaluates all the @var{form}s in advance -and then stores the corresponding variables afterwards. - -@example -(setq x 2 y 3) -(setq x (+ x y) y (* x y)) -x - @result{} 5 -y ; @r{@code{y} was computed after @code{x} was set.} - @result{} 15 -(setq x 2 y 3) -(psetq x (+ x y) y (* x y)) -x - @result{} 5 -y ; @r{@code{y} was computed before @code{x} was set.} - @result{} 6 -@end example - -The simplest use of @code{psetq} is @code{(psetq x y y x)}, which -exchanges the values of two variables. (The @code{rotatef} form -provides an even more convenient way to swap two variables; -@pxref{Modify Macros}.) - -@code{psetq} always returns @code{nil}. -@end defspec - -@node Generalized Variables, Variable Bindings, Assignment, Control Structure -@section Generalized Variables - -@noindent -A ``generalized variable'' or ``place form'' is one of the many places -in Lisp memory where values can be stored. The simplest place form is -a regular Lisp variable. But the cars and cdrs of lists, elements -of arrays, properties of symbols, and many other locations are also -places where Lisp values are stored. - -The @code{setf} form is like @code{setq}, except that it accepts -arbitrary place forms on the left side rather than just -symbols. For example, @code{(setf (car a) b)} sets the car of -@code{a} to @code{b}, doing the same operation as @code{(setcar a b)} -but without having to remember two separate functions for setting -and accessing every type of place. - -Generalized variables are analogous to ``lvalues'' in the C -language, where @samp{x = a[i]} gets an element from an array -and @samp{a[i] = x} stores an element using the same notation. -Just as certain forms like @code{a[i]} can be lvalues in C, there -is a set of forms that can be generalized variables in Lisp. - -@menu -* Basic Setf:: `setf' and place forms -* Modify Macros:: `incf', `push', `rotatef', `letf', `callf', etc. -* Customizing Setf:: `define-modify-macro', `defsetf', `define-setf-method' -@end menu - -@node Basic Setf, Modify Macros, Generalized Variables, Generalized Variables -@subsection Basic Setf - -@noindent -The @code{setf} macro is the most basic way to operate on generalized -variables. - -@defspec setf [place form]@dots{} -This macro evaluates @var{form} and stores it in @var{place}, which -must be a valid generalized variable form. If there are several -@var{place} and @var{form} pairs, the assignments are done sequentially -just as with @code{setq}. @code{setf} returns the value of the last -@var{form}. - -The following Lisp forms will work as generalized variables, and -so may legally appear in the @var{place} argument of @code{setf}: - -@itemize @bullet -@item -A symbol naming a variable. In other words, @code{(setf x y)} is -exactly equivalent to @code{(setq x y)}, and @code{setq} itself is -strictly speaking redundant now that @code{setf} exists. Many -programmers continue to prefer @code{setq} for setting simple -variables, though, purely for stylistic or historical reasons. -The macro @code{(setf x y)} actually expands to @code{(setq x y)}, -so there is no performance penalty for using it in compiled code. - -@item -A call to any of the following Lisp functions: - -@smallexample -car cdr caar .. cddddr -nth rest first .. tenth -aref elt nthcdr -symbol-function symbol-value symbol-plist -get get* getf -gethash subseq -@end smallexample - -@noindent -Note that for @code{nthcdr} and @code{getf}, the list argument -of the function must itself be a valid @var{place} form. For -example, @code{(setf (nthcdr 0 foo) 7)} will set @code{foo} itself -to 7. Note that @code{push} and @code{pop} on an @code{nthcdr} -place can be used to insert or delete at any position in a list. -The use of @code{nthcdr} as a @var{place} form is an extension -to standard Common Lisp. - -@item -The following Emacs-specific functions are also @code{setf}-able. -(Some of these are defined only in Emacs 19 or only in XEmacs.) - -@smallexample -buffer-file-name marker-position -buffer-modified-p match-data -buffer-name mouse-position -buffer-string overlay-end -buffer-substring overlay-get -current-buffer overlay-start -current-case-table point -current-column point-marker -current-global-map point-max -current-input-mode point-min -current-local-map process-buffer -current-window-configuration process-filter -default-file-modes process-sentinel -default-value read-mouse-position -documentation-property screen-height -extent-data screen-menubar -extent-end-position screen-width -extent-start-position selected-window -face-background selected-screen -face-background-pixmap selected-frame -face-font standard-case-table -face-foreground syntax-table -face-underline-p window-buffer -file-modes window-dedicated-p -frame-height window-display-table -frame-parameters window-height -frame-visible-p window-hscroll -frame-width window-point -get-register window-start -getenv window-width -global-key-binding x-get-cut-buffer -keymap-parent x-get-cutbuffer -local-key-binding x-get-secondary-selection -mark x-get-selection -mark-marker -@end smallexample - -Most of these have directly corresponding ``set'' functions, like -@code{use-local-map} for @code{current-local-map}, or @code{goto-char} -for @code{point}. A few, like @code{point-min}, expand to longer -sequences of code when they are @code{setf}'d (@code{(narrow-to-region -x (point-max))} in this case). - -@item -A call of the form @code{(substring @var{subplace} @var{n} [@var{m}])}, -where @var{subplace} is itself a legal generalized variable whose -current value is a string, and where the value stored is also a -string. The new string is spliced into the specified part of the -destination string. For example: - -@example -(setq a (list "hello" "world")) - @result{} ("hello" "world") -(cadr a) - @result{} "world" -(substring (cadr a) 2 4) - @result{} "rl" -(setf (substring (cadr a) 2 4) "o") - @result{} "o" -(cadr a) - @result{} "wood" -a - @result{} ("hello" "wood") -@end example - -The generalized variable @code{buffer-substring}, listed above, -also works in this way by replacing a portion of the current buffer. - -@item -A call of the form @code{(apply '@var{func} @dots{})} or -@code{(apply (function @var{func}) @dots{})}, where @var{func} -is a @code{setf}-able function whose store function is ``suitable'' -in the sense described in Steele's book; since none of the standard -Emacs place functions are suitable in this sense, this feature is -only interesting when used with places you define yourself with -@code{define-setf-method} or the long form of @code{defsetf}. - -@item -A macro call, in which case the macro is expanded and @code{setf} -is applied to the resulting form. - -@item -Any form for which a @code{defsetf} or @code{define-setf-method} -has been made. -@end itemize - -Using any forms other than these in the @var{place} argument to -@code{setf} will signal an error. - -The @code{setf} macro takes care to evaluate all subforms in -the proper left-to-right order; for example, - -@example -(setf (aref vec (incf i)) i) -@end example - -@noindent -looks like it will evaluate @code{(incf i)} exactly once, before the -following access to @code{i}; the @code{setf} expander will insert -temporary variables as necessary to ensure that it does in fact work -this way no matter what setf-method is defined for @code{aref}. -(In this case, @code{aset} would be used and no such steps would -be necessary since @code{aset} takes its arguments in a convenient -order.) - -However, if the @var{place} form is a macro which explicitly -evaluates its arguments in an unusual order, this unusual order -will be preserved. Adapting an example from Steele, given - -@example -(defmacro wrong-order (x y) (list 'aref y x)) -@end example - -@noindent -the form @code{(setf (wrong-order @var{a} @var{b}) 17)} will -evaluate @var{b} first, then @var{a}, just as in an actual call -to @code{wrong-order}. -@end defspec - -@node Modify Macros, Customizing Setf, Basic Setf, Generalized Variables -@subsection Modify Macros - -@noindent -This package defines a number of other macros besides @code{setf} -that operate on generalized variables. Many are interesting and -useful even when the @var{place} is just a variable name. - -@defspec psetf [place form]@dots{} -This macro is to @code{setf} what @code{psetq} is to @code{setq}: -When several @var{place}s and @var{form}s are involved, the -assignments take place in parallel rather than sequentially. -Specifically, all subforms are evaluated from left to right, then -all the assignments are done (in an undefined order). -@end defspec - -@defspec incf place &optional x -This macro increments the number stored in @var{place} by one, or -by @var{x} if specified. The incremented value is returned. For -example, @code{(incf i)} is equivalent to @code{(setq i (1+ i))}, and -@code{(incf (car x) 2)} is equivalent to @code{(setcar x (+ (car x) 2))}. - -Once again, care is taken to preserve the ``apparent'' order of -evaluation. For example, - -@example -(incf (aref vec (incf i))) -@end example - -@noindent -appears to increment @code{i} once, then increment the element of -@code{vec} addressed by @code{i}; this is indeed exactly what it -does, which means the above form is @emph{not} equivalent to the -``obvious'' expansion, - -@example -(setf (aref vec (incf i)) (1+ (aref vec (incf i)))) ; Wrong! -@end example - -@noindent -but rather to something more like - -@example -(let ((temp (incf i))) - (setf (aref vec temp) (1+ (aref vec temp)))) -@end example - -@noindent -Again, all of this is taken care of automatically by @code{incf} and -the other generalized-variable macros. - -As a more Emacs-specific example of @code{incf}, the expression -@code{(incf (point) @var{n})} is essentially equivalent to -@code{(forward-char @var{n})}. -@end defspec - -@defspec decf place &optional x -This macro decrements the number stored in @var{place} by one, or -by @var{x} if specified. -@end defspec - -@defspec pop place -This macro removes and returns the first element of the list stored -in @var{place}. It is analogous to @code{(prog1 (car @var{place}) -(setf @var{place} (cdr @var{place})))}, except that it takes care -to evaluate all subforms only once. -@end defspec - -@defspec push x place -This macro inserts @var{x} at the front of the list stored in -@var{place}. It is analogous to @code{(setf @var{place} (cons -@var{x} @var{place}))}, except for evaluation of the subforms. -@end defspec - -@defspec pushnew x place @t{&key :test :test-not :key} -This macro inserts @var{x} at the front of the list stored in -@var{place}, but only if @var{x} was not @code{eql} to any -existing element of the list. The optional keyword arguments -are interpreted in the same way as for @code{adjoin}. -@xref{Lists as Sets}. -@end defspec - -@defspec shiftf place@dots{} newvalue -This macro shifts the @var{place}s left by one, shifting in the -value of @var{newvalue} (which may be any Lisp expression, not just -a generalized variable), and returning the value shifted out of -the first @var{place}. Thus, @code{(shiftf @var{a} @var{b} @var{c} -@var{d})} is equivalent to - -@example -(prog1 - @var{a} - (psetf @var{a} @var{b} - @var{b} @var{c} - @var{c} @var{d})) -@end example - -@noindent -except that the subforms of @var{a}, @var{b}, and @var{c} are actually -evaluated only once each and in the apparent order. -@end defspec - -@defspec rotatef place@dots{} -This macro rotates the @var{place}s left by one in circular fashion. -Thus, @code{(rotatef @var{a} @var{b} @var{c} @var{d})} is equivalent to - -@example -(psetf @var{a} @var{b} - @var{b} @var{c} - @var{c} @var{d} - @var{d} @var{a}) -@end example - -@noindent -except for the evaluation of subforms. @code{rotatef} always -returns @code{nil}. Note that @code{(rotatef @var{a} @var{b})} -conveniently exchanges @var{a} and @var{b}. -@end defspec - -The following macros were invented for this package; they have no -analogues in Common Lisp. - -@defspec letf (bindings@dots{}) forms@dots{} -This macro is analogous to @code{let}, but for generalized variables -rather than just symbols. Each @var{binding} should be of the form -@code{(@var{place} @var{value})}; the original contents of the -@var{place}s are saved, the @var{value}s are stored in them, and -then the body @var{form}s are executed. Afterwards, the @var{places} -are set back to their original saved contents. This cleanup happens -even if the @var{form}s exit irregularly due to a @code{throw} or an -error. - -For example, - -@example -(letf (((point) (point-min)) - (a 17)) - ...) -@end example - -@noindent -moves ``point'' in the current buffer to the beginning of the buffer, -and also binds @code{a} to 17 (as if by a normal @code{let}, since -@code{a} is just a regular variable). After the body exits, @code{a} -is set back to its original value and point is moved back to its -original position. - -Note that @code{letf} on @code{(point)} is not quite like a -@code{save-excursion}, as the latter effectively saves a marker -which tracks insertions and deletions in the buffer. Actually, -a @code{letf} of @code{(point-marker)} is much closer to this -behavior. (@code{point} and @code{point-marker} are equivalent -as @code{setf} places; each will accept either an integer or a -marker as the stored value.) - -Since generalized variables look like lists, @code{let}'s shorthand -of using @samp{foo} for @samp{(foo nil)} as a @var{binding} would -be ambiguous in @code{letf} and is not allowed. - -However, a @var{binding} specifier may be a one-element list -@samp{(@var{place})}, which is similar to @samp{(@var{place} -@var{place})}. In other words, the @var{place} is not disturbed -on entry to the body, and the only effect of the @code{letf} is -to restore the original value of @var{place} afterwards. (The -redundant access-and-store suggested by the @code{(@var{place} -@var{place})} example does not actually occur.) - -In most cases, the @var{place} must have a well-defined value on -entry to the @code{letf} form. The only exceptions are plain -variables and calls to @code{symbol-value} and @code{symbol-function}. -If the symbol is not bound on entry, it is simply made unbound by -@code{makunbound} or @code{fmakunbound} on exit. -@end defspec - -@defspec letf* (bindings@dots{}) forms@dots{} -This macro is to @code{letf} what @code{let*} is to @code{let}: -It does the bindings in sequential rather than parallel order. -@end defspec - -@defspec callf @var{function} @var{place} @var{args}@dots{} -This is the ``generic'' modify macro. It calls @var{function}, -which should be an unquoted function name, macro name, or lambda. -It passes @var{place} and @var{args} as arguments, and assigns the -result back to @var{place}. For example, @code{(incf @var{place} -@var{n})} is the same as @code{(callf + @var{place} @var{n})}. -Some more examples: - -@example -(callf abs my-number) -(callf concat (buffer-name) "<" (int-to-string n) ">") -(callf union happy-people (list joe bob) :test 'same-person) -@end example - -@xref{Customizing Setf}, for @code{define-modify-macro}, a way -to create even more concise notations for modify macros. Note -again that @code{callf} is an extension to standard Common Lisp. -@end defspec - -@defspec callf2 @var{function} @var{arg1} @var{place} @var{args}@dots{} -This macro is like @code{callf}, except that @var{place} is -the @emph{second} argument of @var{function} rather than the -first. For example, @code{(push @var{x} @var{place})} is -equivalent to @code{(callf2 cons @var{x} @var{place})}. -@end defspec - -The @code{callf} and @code{callf2} macros serve as building -blocks for other macros like @code{incf}, @code{pushnew}, and -@code{define-modify-macro}. The @code{letf} and @code{letf*} -macros are used in the processing of symbol macros; -@pxref{Macro Bindings}. - -@node Customizing Setf, , Modify Macros, Generalized Variables -@subsection Customizing Setf - -@noindent -Common Lisp defines three macros, @code{define-modify-macro}, -@code{defsetf}, and @code{define-setf-method}, that allow the -user to extend generalized variables in various ways. - -@defspec define-modify-macro name arglist function [doc-string] -This macro defines a ``read-modify-write'' macro similar to -@code{incf} and @code{decf}. The macro @var{name} is defined -to take a @var{place} argument followed by additional arguments -described by @var{arglist}. The call - -@example -(@var{name} @var{place} @var{args}...) -@end example - -@noindent -will be expanded to - -@example -(callf @var{func} @var{place} @var{args}...) -@end example - -@noindent -which in turn is roughly equivalent to - -@example -(setf @var{place} (@var{func} @var{place} @var{args}...)) -@end example - -For example: - -@example -(define-modify-macro incf (&optional (n 1)) +) -(define-modify-macro concatf (&rest args) concat) -@end example - -Note that @code{&key} is not allowed in @var{arglist}, but -@code{&rest} is sufficient to pass keywords on to the function. - -Most of the modify macros defined by Common Lisp do not exactly -follow the pattern of @code{define-modify-macro}. For example, -@code{push} takes its arguments in the wrong order, and @code{pop} -is completely irregular. You can define these macros ``by hand'' -using @code{get-setf-method}, or consult the source file -@file{cl-macs.el} to see how to use the internal @code{setf} -building blocks. -@end defspec - -@defspec defsetf access-fn update-fn -This is the simpler of two @code{defsetf} forms. Where -@var{access-fn} is the name of a function which accesses a place, -this declares @var{update-fn} to be the corresponding store -function. From now on, - -@example -(setf (@var{access-fn} @var{arg1} @var{arg2} @var{arg3}) @var{value}) -@end example - -@noindent -will be expanded to - -@example -(@var{update-fn} @var{arg1} @var{arg2} @var{arg3} @var{value}) -@end example - -@noindent -The @var{update-fn} is required to be either a true function, or -a macro which evaluates its arguments in a function-like way. Also, -the @var{update-fn} is expected to return @var{value} as its result. -Otherwise, the above expansion would not obey the rules for the way -@code{setf} is supposed to behave. - -As a special (non-Common-Lisp) extension, a third argument of @code{t} -to @code{defsetf} says that the @code{update-fn}'s return value is -not suitable, so that the above @code{setf} should be expanded to -something more like - -@example -(let ((temp @var{value})) - (@var{update-fn} @var{arg1} @var{arg2} @var{arg3} temp) - temp) -@end example - -Some examples of the use of @code{defsetf}, drawn from the standard -suite of setf methods, are: - -@example -(defsetf car setcar) -(defsetf symbol-value set) -(defsetf buffer-name rename-buffer t) -@end example -@end defspec - -@defspec defsetf access-fn arglist (store-var) forms@dots{} -This is the second, more complex, form of @code{defsetf}. It is -rather like @code{defmacro} except for the additional @var{store-var} -argument. The @var{forms} should return a Lisp form which stores -the value of @var{store-var} into the generalized variable formed -by a call to @var{access-fn} with arguments described by @var{arglist}. -The @var{forms} may begin with a string which documents the @code{setf} -method (analogous to the doc string that appears at the front of a -function). - -For example, the simple form of @code{defsetf} is shorthand for - -@example -(defsetf @var{access-fn} (&rest args) (store) - (append '(@var{update-fn}) args (list store))) -@end example - -The Lisp form that is returned can access the arguments from -@var{arglist} and @var{store-var} in an unrestricted fashion; -macros like @code{setf} and @code{incf} which invoke this -setf-method will insert temporary variables as needed to make -sure the apparent order of evaluation is preserved. - -Another example drawn from the standard package: - -@example -(defsetf nth (n x) (store) - (list 'setcar (list 'nthcdr n x) store)) -@end example -@end defspec - -@defspec define-setf-method access-fn arglist forms@dots{} -This is the most general way to create new place forms. When -a @code{setf} to @var{access-fn} with arguments described by -@var{arglist} is expanded, the @var{forms} are evaluated and -must return a list of five items: - -@enumerate -@item -A list of @dfn{temporary variables}. - -@item -A list of @dfn{value forms} corresponding to the temporary variables -above. The temporary variables will be bound to these value forms -as the first step of any operation on the generalized variable. - -@item -A list of exactly one @dfn{store variable} (generally obtained -from a call to @code{gensym}). - -@item -A Lisp form which stores the contents of the store variable into -the generalized variable, assuming the temporaries have been -bound as described above. - -@item -A Lisp form which accesses the contents of the generalized variable, -assuming the temporaries have been bound. -@end enumerate - -This is exactly like the Common Lisp macro of the same name, -except that the method returns a list of five values rather -than the five values themselves, since Emacs Lisp does not -support Common Lisp's notion of multiple return values. - -Once again, the @var{forms} may begin with a documentation string. - -A setf-method should be maximally conservative with regard to -temporary variables. In the setf-methods generated by -@code{defsetf}, the second return value is simply the list of -arguments in the place form, and the first return value is a -list of a corresponding number of temporary variables generated -by @code{gensym}. Macros like @code{setf} and @code{incf} which -use this setf-method will optimize away most temporaries that -turn out to be unnecessary, so there is little reason for the -setf-method itself to optimize. -@end defspec - -@defun get-setf-method place &optional env -This function returns the setf-method for @var{place}, by -invoking the definition previously recorded by @code{defsetf} -or @code{define-setf-method}. The result is a list of five -values as described above. You can use this function to build -your own @code{incf}-like modify macros. (Actually, it is -better to use the internal functions @code{cl-setf-do-modify} -and @code{cl-setf-do-store}, which are a bit easier to use and -which also do a number of optimizations; consult the source -code for the @code{incf} function for a simple example.) - -The argument @var{env} specifies the ``environment'' to be -passed on to @code{macroexpand} if @code{get-setf-method} should -need to expand a macro in @var{place}. It should come from -an @code{&environment} argument to the macro or setf-method -that called @code{get-setf-method}. - -See also the source code for the setf-methods for @code{apply} -and @code{substring}, each of which works by calling -@code{get-setf-method} on a simpler case, then massaging -the result in various ways. -@end defun - -Modern Common Lisp defines a second, independent way to specify -the @code{setf} behavior of a function, namely ``@code{setf} -functions'' whose names are lists @code{(setf @var{name})} -rather than symbols. For example, @code{(defun (setf foo) @dots{})} -defines the function that is used when @code{setf} is applied to -@code{foo}. This package does not currently support @code{setf} -functions. In particular, it is a compile-time error to use -@code{setf} on a form which has not already been @code{defsetf}'d -or otherwise declared; in newer Common Lisps, this would not be -an error since the function @code{(setf @var{func})} might be -defined later. - -@iftex -@secno=4 -@end iftex - -@node Variable Bindings, Conditionals, Generalized Variables, Control Structure -@section Variable Bindings - -@noindent -These Lisp forms make bindings to variables and function names, -analogous to Lisp's built-in @code{let} form. - -@xref{Modify Macros}, for the @code{letf} and @code{letf*} forms which -are also related to variable bindings. - -@menu -* Dynamic Bindings:: The `progv' form -* Lexical Bindings:: `lexical-let' and lexical closures -* Function Bindings:: `flet' and `labels' -* Macro Bindings:: `macrolet' and `symbol-macrolet' -@end menu - -@node Dynamic Bindings, Lexical Bindings, Variable Bindings, Variable Bindings -@subsection Dynamic Bindings - -@noindent -The standard @code{let} form binds variables whose names are known -at compile-time. The @code{progv} form provides an easy way to -bind variables whose names are computed at run-time. - -@defspec progv symbols values forms@dots{} -This form establishes @code{let}-style variable bindings on a -set of variables computed at run-time. The expressions -@var{symbols} and @var{values} are evaluated, and must return lists -of symbols and values, respectively. The symbols are bound to the -corresponding values for the duration of the body @var{form}s. -If @var{values} is shorter than @var{symbols}, the last few symbols -are made unbound (as if by @code{makunbound}) inside the body. -If @var{symbols} is shorter than @var{values}, the excess values -are ignored. -@end defspec - -@node Lexical Bindings, Function Bindings, Dynamic Bindings, Variable Bindings -@subsection Lexical Bindings - -@noindent -The @dfn{CL} package defines the following macro which -more closely follows the Common Lisp @code{let} form: - -@defspec lexical-let (bindings@dots{}) forms@dots{} -This form is exactly like @code{let} except that the bindings it -establishes are purely lexical. Lexical bindings are similar to -local variables in a language like C: Only the code physically -within the body of the @code{lexical-let} (after macro expansion) -may refer to the bound variables. - -@example -(setq a 5) -(defun foo (b) (+ a b)) -(let ((a 2)) (foo a)) - @result{} 4 -(lexical-let ((a 2)) (foo a)) - @result{} 7 -@end example - -@noindent -In this example, a regular @code{let} binding of @code{a} actually -makes a temporary change to the global variable @code{a}, so @code{foo} -is able to see the binding of @code{a} to 2. But @code{lexical-let} -actually creates a distinct local variable @code{a} for use within its -body, without any effect on the global variable of the same name. - -The most important use of lexical bindings is to create @dfn{closures}. -A closure is a function object that refers to an outside lexical -variable. For example: - -@example -(defun make-adder (n) - (lexical-let ((n n)) - (function (lambda (m) (+ n m))))) -(setq add17 (make-adder 17)) -(funcall add17 4) - @result{} 21 -@end example - -@noindent -The call @code{(make-adder 17)} returns a function object which adds -17 to its argument. If @code{let} had been used instead of -@code{lexical-let}, the function object would have referred to the -global @code{n}, which would have been bound to 17 only during the -call to @code{make-adder} itself. - -@example -(defun make-counter () - (lexical-let ((n 0)) - (function* (lambda (&optional (m 1)) (incf n m))))) -(setq count-1 (make-counter)) -(funcall count-1 3) - @result{} 3 -(funcall count-1 14) - @result{} 17 -(setq count-2 (make-counter)) -(funcall count-2 5) - @result{} 5 -(funcall count-1 2) - @result{} 19 -(funcall count-2) - @result{} 6 -@end example - -@noindent -Here we see that each call to @code{make-counter} creates a distinct -local variable @code{n}, which serves as a private counter for the -function object that is returned. - -Closed-over lexical variables persist until the last reference to -them goes away, just like all other Lisp objects. For example, -@code{count-2} refers to a function object which refers to an -instance of the variable @code{n}; this is the only reference -to that variable, so after @code{(setq count-2 nil)} the garbage -collector would be able to delete this instance of @code{n}. -Of course, if a @code{lexical-let} does not actually create any -closures, then the lexical variables are free as soon as the -@code{lexical-let} returns. - -Many closures are used only during the extent of the bindings they -refer to; these are known as ``downward funargs'' in Lisp parlance. -When a closure is used in this way, regular Emacs Lisp dynamic -bindings suffice and will be more efficient than @code{lexical-let} -closures: - -@example -(defun add-to-list (x list) - (mapcar (function (lambda (y) (+ x y))) list)) -(add-to-list 7 '(1 2 5)) - @result{} (8 9 12) -@end example - -@noindent -Since this lambda is only used while @code{x} is still bound, -it is not necessary to make a true closure out of it. - -You can use @code{defun} or @code{flet} inside a @code{lexical-let} -to create a named closure. If several closures are created in the -body of a single @code{lexical-let}, they all close over the same -instance of the lexical variable. - -The @code{lexical-let} form is an extension to Common Lisp. In -true Common Lisp, all bindings are lexical unless declared otherwise. -@end defspec - -@defspec lexical-let* (bindings@dots{}) forms@dots{} -This form is just like @code{lexical-let}, except that the bindings -are made sequentially in the manner of @code{let*}. -@end defspec - -@node Function Bindings, Macro Bindings, Lexical Bindings, Variable Bindings -@subsection Function Bindings - -@noindent -These forms make @code{let}-like bindings to functions instead -of variables. - -@defspec flet (bindings@dots{}) forms@dots{} -This form establishes @code{let}-style bindings on the function -cells of symbols rather than on the value cells. Each @var{binding} -must be a list of the form @samp{(@var{name} @var{arglist} -@var{forms}@dots{})}, which defines a function exactly as if -it were a @code{defun*} form. The function @var{name} is defined -accordingly for the duration of the body of the @code{flet}; then -the old function definition, or lack thereof, is restored. - -While @code{flet} in Common Lisp establishes a lexical binding of -@var{name}, Emacs Lisp @code{flet} makes a dynamic binding. The -result is that @code{flet} affects indirect calls to a function as -well as calls directly inside the @code{flet} form itself. - -You can use @code{flet} to disable or modify the behavior of a -function in a temporary fashion. This will even work on Emacs -primitives, although note that some calls to primitive functions -internal to Emacs are made without going through the symbol's -function cell, and so will not be affected by @code{flet}. For -example, - -@example -(flet ((message (&rest args) (push args saved-msgs))) - (do-something)) -@end example - -This code attempts to replace the built-in function @code{message} -with a function that simply saves the messages in a list rather -than displaying them. The original definition of @code{message} -will be restored after @code{do-something} exits. This code will -work fine on messages generated by other Lisp code, but messages -generated directly inside Emacs will not be caught since they make -direct C-language calls to the message routines rather than going -through the Lisp @code{message} function. - -Functions defined by @code{flet} may use the full Common Lisp -argument notation supported by @code{defun*}; also, the function -body is enclosed in an implicit block as if by @code{defun*}. -@xref{Program Structure}. -@end defspec - -@defspec labels (bindings@dots{}) forms@dots{} -The @code{labels} form is a synonym for @code{flet}. (In Common -Lisp, @code{labels} and @code{flet} differ in ways that depend on -their lexical scoping; these distinctions vanish in dynamically -scoped Emacs Lisp.) -@end defspec - -@node Macro Bindings, , Function Bindings, Variable Bindings -@subsection Macro Bindings - -@noindent -These forms create local macros and ``symbol macros.'' - -@defspec macrolet (bindings@dots{}) forms@dots{} -This form is analogous to @code{flet}, but for macros instead of -functions. Each @var{binding} is a list of the same form as the -arguments to @code{defmacro*} (i.e., a macro name, argument list, -and macro-expander forms). The macro is defined accordingly for -use within the body of the @code{macrolet}. - -Because of the nature of macros, @code{macrolet} is lexically -scoped even in Emacs Lisp: The @code{macrolet} binding will -affect only calls that appear physically within the body -@var{forms}, possibly after expansion of other macros in the -body. -@end defspec - -@defspec symbol-macrolet (bindings@dots{}) forms@dots{} -This form creates @dfn{symbol macros}, which are macros that look -like variable references rather than function calls. Each -@var{binding} is a list @samp{(@var{var} @var{expansion})}; -any reference to @var{var} within the body @var{forms} is -replaced by @var{expansion}. - -@example -(setq bar '(5 . 9)) -(symbol-macrolet ((foo (car bar))) - (incf foo)) -bar - @result{} (6 . 9) -@end example - -A @code{setq} of a symbol macro is treated the same as a @code{setf}. -I.e., @code{(setq foo 4)} in the above would be equivalent to -@code{(setf foo 4)}, which in turn expands to @code{(setf (car bar) 4)}. - -Likewise, a @code{let} or @code{let*} binding a symbol macro is -treated like a @code{letf} or @code{letf*}. This differs from true -Common Lisp, where the rules of lexical scoping cause a @code{let} -binding to shadow a @code{symbol-macrolet} binding. In this package, -only @code{lexical-let} and @code{lexical-let*} will shadow a symbol -macro. - -There is no analogue of @code{defmacro} for symbol macros; all symbol -macros are local. A typical use of @code{symbol-macrolet} is in the -expansion of another macro: - -@example -(defmacro* my-dolist ((x list) &rest body) - (let ((var (gensym))) - (list 'loop 'for var 'on list 'do - (list* 'symbol-macrolet (list (list x (list 'car var))) - body)))) - -(setq mylist '(1 2 3 4)) -(my-dolist (x mylist) (incf x)) -mylist - @result{} (2 3 4 5) -@end example - -@noindent -In this example, the @code{my-dolist} macro is similar to @code{dolist} -(@pxref{Iteration}) except that the variable @code{x} becomes a true -reference onto the elements of the list. The @code{my-dolist} call -shown here expands to - -@example -(loop for G1234 on mylist do - (symbol-macrolet ((x (car G1234))) - (incf x))) -@end example - -@noindent -which in turn expands to - -@example -(loop for G1234 on mylist do (incf (car G1234))) -@end example - -@xref{Loop Facility}, for a description of the @code{loop} macro. -This package defines a nonstandard @code{in-ref} loop clause that -works much like @code{my-dolist}. -@end defspec - -@node Conditionals, Blocks and Exits, Variable Bindings, Control Structure -@section Conditionals - -@noindent -These conditional forms augment Emacs Lisp's simple @code{if}, -@code{and}, @code{or}, and @code{cond} forms. - -@defspec when test forms@dots{} -This is a variant of @code{if} where there are no ``else'' forms, -and possibly several ``then'' forms. In particular, - -@example -(when @var{test} @var{a} @var{b} @var{c}) -@end example - -@noindent -is entirely equivalent to - -@example -(if @var{test} (progn @var{a} @var{b} @var{c}) nil) -@end example -@end defspec - -@defspec unless test forms@dots{} -This is a variant of @code{if} where there are no ``then'' forms, -and possibly several ``else'' forms: - -@example -(unless @var{test} @var{a} @var{b} @var{c}) -@end example - -@noindent -is entirely equivalent to - -@example -(when (not @var{test}) @var{a} @var{b} @var{c}) -@end example -@end defspec - -@defspec case keyform clause@dots{} -This macro evaluates @var{keyform}, then compares it with the key -values listed in the various @var{clause}s. Whichever clause matches -the key is executed; comparison is done by @code{eql}. If no clause -matches, the @code{case} form returns @code{nil}. The clauses are -of the form - -@example -(@var{keylist} @var{body-forms}@dots{}) -@end example - -@noindent -where @var{keylist} is a list of key values. If there is exactly -one value, and it is not a cons cell or the symbol @code{nil} or -@code{t}, then it can be used by itself as a @var{keylist} without -being enclosed in a list. All key values in the @code{case} form -must be distinct. The final clauses may use @code{t} in place of -a @var{keylist} to indicate a default clause that should be taken -if none of the other clauses match. (The symbol @code{otherwise} -is also recognized in place of @code{t}. To make a clause that -matches the actual symbol @code{t}, @code{nil}, or @code{otherwise}, -enclose the symbol in a list.) - -For example, this expression reads a keystroke, then does one of -four things depending on whether it is an @samp{a}, a @samp{b}, -a @key{RET} or @key{LFD}, or anything else. - -@example -(case (read-char) - (?a (do-a-thing)) - (?b (do-b-thing)) - ((?\r ?\n) (do-ret-thing)) - (t (do-other-thing))) -@end example -@end defspec - -@defspec ecase keyform clause@dots{} -This macro is just like @code{case}, except that if the key does -not match any of the clauses, an error is signalled rather than -simply returning @code{nil}. -@end defspec - -@defspec typecase keyform clause@dots{} -This macro is a version of @code{case} that checks for types -rather than values. Each @var{clause} is of the form -@samp{(@var{type} @var{body}...)}. @xref{Type Predicates}, -for a description of type specifiers. For example, - -@example -(typecase x - (integer (munch-integer x)) - (float (munch-float x)) - (string (munch-integer (string-to-int x))) - (t (munch-anything x))) -@end example - -The type specifier @code{t} matches any type of object; the word -@code{otherwise} is also allowed. To make one clause match any of -several types, use an @code{(or ...)} type specifier. -@end defspec - -@defspec etypecase keyform clause@dots{} -This macro is just like @code{typecase}, except that if the key does -not match any of the clauses, an error is signalled rather than -simply returning @code{nil}. -@end defspec - -@node Blocks and Exits, Iteration, Conditionals, Control Structure -@section Blocks and Exits - -@noindent -Common Lisp @dfn{blocks} provide a non-local exit mechanism very -similar to @code{catch} and @code{throw}, but lexically rather than -dynamically scoped. This package actually implements @code{block} -in terms of @code{catch}; however, the lexical scoping allows the -optimizing byte-compiler to omit the costly @code{catch} step if the -body of the block does not actually @code{return-from} the block. - -@defspec block name forms@dots{} -The @var{forms} are evaluated as if by a @code{progn}. However, -if any of the @var{forms} execute @code{(return-from @var{name})}, -they will jump out and return directly from the @code{block} form. -The @code{block} returns the result of the last @var{form} unless -a @code{return-from} occurs. - -The @code{block}/@code{return-from} mechanism is quite similar to -the @code{catch}/@code{throw} mechanism. The main differences are -that block @var{name}s are unevaluated symbols, rather than forms -(such as quoted symbols) which evaluate to a tag at run-time; and -also that blocks are lexically scoped whereas @code{catch}/@code{throw} -are dynamically scoped. This means that functions called from the -body of a @code{catch} can also @code{throw} to the @code{catch}, -but the @code{return-from} referring to a block name must appear -physically within the @var{forms} that make up the body of the block. -They may not appear within other called functions, although they may -appear within macro expansions or @code{lambda}s in the body. Block -names and @code{catch} names form independent name-spaces. - -In true Common Lisp, @code{defun} and @code{defmacro} surround -the function or expander bodies with implicit blocks with the -same name as the function or macro. This does not occur in Emacs -Lisp, but this package provides @code{defun*} and @code{defmacro*} -forms which do create the implicit block. - -The Common Lisp looping constructs defined by this package, -such as @code{loop} and @code{dolist}, also create implicit blocks -just as in Common Lisp. - -Because they are implemented in terms of Emacs Lisp @code{catch} -and @code{throw}, blocks have the same overhead as actual -@code{catch} constructs (roughly two function calls). However, -Zawinski and Furuseth's optimizing byte compiler (standard in -Emacs 19) will optimize away the @code{catch} if the block does -not in fact contain any @code{return} or @code{return-from} calls -that jump to it. This means that @code{do} loops and @code{defun*} -functions which don't use @code{return} don't pay the overhead to -support it. -@end defspec - -@defspec return-from name [result] -This macro returns from the block named @var{name}, which must be -an (unevaluated) symbol. If a @var{result} form is specified, it -is evaluated to produce the result returned from the @code{block}. -Otherwise, @code{nil} is returned. -@end defspec - -@defspec return [result] -This macro is exactly like @code{(return-from nil @var{result})}. -Common Lisp loops like @code{do} and @code{dolist} implicitly enclose -themselves in @code{nil} blocks. -@end defspec - -@node Iteration, Loop Facility, Blocks and Exits, Control Structure -@section Iteration - -@noindent -The macros described here provide more sophisticated, high-level -looping constructs to complement Emacs Lisp's basic @code{while} -loop. - -@defspec loop forms@dots{} -The @dfn{CL} package supports both the simple, old-style meaning of -@code{loop} and the extremely powerful and flexible feature known as -the @dfn{Loop Facility} or @dfn{Loop Macro}. This more advanced -facility is discussed in the following section; @pxref{Loop Facility}. -The simple form of @code{loop} is described here. - -If @code{loop} is followed by zero or more Lisp expressions, -then @code{(loop @var{exprs}@dots{})} simply creates an infinite -loop executing the expressions over and over. The loop is -enclosed in an implicit @code{nil} block. Thus, - -@example -(loop (foo) (if (no-more) (return 72)) (bar)) -@end example - -@noindent -is exactly equivalent to - -@example -(block nil (while t (foo) (if (no-more) (return 72)) (bar))) -@end example - -If any of the expressions are plain symbols, the loop is instead -interpreted as a Loop Macro specification as described later. -(This is not a restriction in practice, since a plain symbol -in the above notation would simply access and throw away the -value of a variable.) -@end defspec - -@defspec do (spec@dots{}) (end-test [result@dots{}]) forms@dots{} -This macro creates a general iterative loop. Each @var{spec} is -of the form - -@example -(@var{var} [@var{init} [@var{step}]]) -@end example - -The loop works as follows: First, each @var{var} is bound to the -associated @var{init} value as if by a @code{let} form. Then, in -each iteration of the loop, the @var{end-test} is evaluated; if -true, the loop is finished. Otherwise, the body @var{forms} are -evaluated, then each @var{var} is set to the associated @var{step} -expression (as if by a @code{psetq} form) and the next iteration -begins. Once the @var{end-test} becomes true, the @var{result} -forms are evaluated (with the @var{var}s still bound to their -values) to produce the result returned by @code{do}. - -The entire @code{do} loop is enclosed in an implicit @code{nil} -block, so that you can use @code{(return)} to break out of the -loop at any time. - -If there are no @var{result} forms, the loop returns @code{nil}. -If a given @var{var} has no @var{step} form, it is bound to its -@var{init} value but not otherwise modified during the @code{do} -loop (unless the code explicitly modifies it); this case is just -a shorthand for putting a @code{(let ((@var{var} @var{init})) @dots{})} -around the loop. If @var{init} is also omitted it defaults to -@code{nil}, and in this case a plain @samp{@var{var}} can be used -in place of @samp{(@var{var})}, again following the analogy with -@code{let}. - -This example (from Steele) illustrates a loop which applies the -function @code{f} to successive pairs of values from the lists -@code{foo} and @code{bar}; it is equivalent to the call -@code{(mapcar* 'f foo bar)}. Note that this loop has no body -@var{forms} at all, performing all its work as side effects of -the rest of the loop. - -@example -(do ((x foo (cdr x)) - (y bar (cdr y)) - (z nil (cons (f (car x) (car y)) z))) - ((or (null x) (null y)) - (nreverse z))) -@end example -@end defspec - -@defspec do* (spec@dots{}) (end-test [result@dots{}]) forms@dots{} -This is to @code{do} what @code{let*} is to @code{let}. In -particular, the initial values are bound as if by @code{let*} -rather than @code{let}, and the steps are assigned as if by -@code{setq} rather than @code{psetq}. - -Here is another way to write the above loop: - -@example -(do* ((xp foo (cdr xp)) - (yp bar (cdr yp)) - (x (car xp) (car xp)) - (y (car yp) (car yp)) - z) - ((or (null xp) (null yp)) - (nreverse z)) - (push (f x y) z)) -@end example -@end defspec - -@defspec dolist (var list [result]) forms@dots{} -This is a more specialized loop which iterates across the elements -of a list. @var{list} should evaluate to a list; the body @var{forms} -are executed with @var{var} bound to each element of the list in -turn. Finally, the @var{result} form (or @code{nil}) is evaluated -with @var{var} bound to @code{nil} to produce the result returned by -the loop. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec dotimes (var count [result]) forms@dots{} -This is a more specialized loop which iterates a specified number -of times. The body is executed with @var{var} bound to the integers -from zero (inclusive) to @var{count} (exclusive), in turn. Then -the @code{result} form is evaluated with @var{var} bound to the total -number of iterations that were done (i.e., @code{(max 0 @var{count})}) -to get the return value for the loop form. The loop is surrounded -by an implicit @code{nil} block. -@end defspec - -@defspec do-symbols (var [obarray [result]]) forms@dots{} -This loop iterates over all interned symbols. If @var{obarray} -is specified and is not @code{nil}, it loops over all symbols in -that obarray. For each symbol, the body @var{forms} are evaluated -with @var{var} bound to that symbol. The symbols are visited in -an unspecified order. Afterward the @var{result} form, if any, -is evaluated (with @var{var} bound to @code{nil}) to get the return -value. The loop is surrounded by an implicit @code{nil} block. -@end defspec - -@defspec do-all-symbols (var [result]) forms@dots{} -This is identical to @code{do-symbols} except that the @var{obarray} -argument is omitted; it always iterates over the default obarray. -@end defspec - -@xref{Mapping over Sequences}, for some more functions for -iterating over vectors or lists. - -@node Loop Facility, Multiple Values, Iteration, Control Structure -@section Loop Facility - -@noindent -A common complaint with Lisp's traditional looping constructs is -that they are either too simple and limited, such as Common Lisp's -@code{dotimes} or Emacs Lisp's @code{while}, or too unreadable and -obscure, like Common Lisp's @code{do} loop. - -To remedy this, recent versions of Common Lisp have added a new -construct called the ``Loop Facility'' or ``@code{loop} macro,'' -with an easy-to-use but very powerful and expressive syntax. - -@menu -* Loop Basics:: `loop' macro, basic clause structure -* Loop Examples:: Working examples of `loop' macro -* For Clauses:: Clauses introduced by `for' or `as' -* Iteration Clauses:: `repeat', `while', `thereis', etc. -* Accumulation Clauses:: `collect', `sum', `maximize', etc. -* Other Clauses:: `with', `if', `initially', `finally' -@end menu - -@node Loop Basics, Loop Examples, Loop Facility, Loop Facility -@subsection Loop Basics - -@noindent -The @code{loop} macro essentially creates a mini-language within -Lisp that is specially tailored for describing loops. While this -language is a little strange-looking by the standards of regular Lisp, -it turns out to be very easy to learn and well-suited to its purpose. - -Since @code{loop} is a macro, all parsing of the loop language -takes place at byte-compile time; compiled @code{loop}s are just -as efficient as the equivalent @code{while} loops written longhand. - -@defspec loop clauses@dots{} -A loop construct consists of a series of @var{clause}s, each -introduced by a symbol like @code{for} or @code{do}. Clauses -are simply strung together in the argument list of @code{loop}, -with minimal extra parentheses. The various types of clauses -specify initializations, such as the binding of temporary -variables, actions to be taken in the loop, stepping actions, -and final cleanup. - -Common Lisp specifies a certain general order of clauses in a -loop: - -@example -(loop @var{name-clause} - @var{var-clauses}@dots{} - @var{action-clauses}@dots{}) -@end example - -The @var{name-clause} optionally gives a name to the implicit -block that surrounds the loop. By default, the implicit block -is named @code{nil}. The @var{var-clauses} specify what -variables should be bound during the loop, and how they should -be modified or iterated throughout the course of the loop. The -@var{action-clauses} are things to be done during the loop, such -as computing, collecting, and returning values. - -The Emacs version of the @code{loop} macro is less restrictive about -the order of clauses, but things will behave most predictably if -you put the variable-binding clauses @code{with}, @code{for}, and -@code{repeat} before the action clauses. As in Common Lisp, -@code{initially} and @code{finally} clauses can go anywhere. - -Loops generally return @code{nil} by default, but you can cause -them to return a value by using an accumulation clause like -@code{collect}, an end-test clause like @code{always}, or an -explicit @code{return} clause to jump out of the implicit block. -(Because the loop body is enclosed in an implicit block, you can -also use regular Lisp @code{return} or @code{return-from} to -break out of the loop.) -@end defspec - -The following sections give some examples of the Loop Macro in -action, and describe the particular loop clauses in great detail. -Consult the second edition of Steele's @dfn{Common Lisp, the Language}, -for additional discussion and examples of the @code{loop} macro. - -@node Loop Examples, For Clauses, Loop Basics, Loop Facility -@subsection Loop Examples - -@noindent -Before listing the full set of clauses that are allowed, let's -look at a few example loops just to get a feel for the @code{loop} -language. - -@example -(loop for buf in (buffer-list) - collect (buffer-file-name buf)) -@end example - -@noindent -This loop iterates over all Emacs buffers, using the list -returned by @code{buffer-list}. For each buffer @code{buf}, -it calls @code{buffer-file-name} and collects the results into -a list, which is then returned from the @code{loop} construct. -The result is a list of the file names of all the buffers in -Emacs' memory. The words @code{for}, @code{in}, and @code{collect} -are reserved words in the @code{loop} language. - -@example -(loop repeat 20 do (insert "Yowsa\n")) -@end example - -@noindent -This loop inserts the phrase ``Yowsa'' twenty times in the -current buffer. - -@example -(loop until (eobp) do (munch-line) (forward-line 1)) -@end example - -@noindent -This loop calls @code{munch-line} on every line until the end -of the buffer. If point is already at the end of the buffer, -the loop exits immediately. - -@example -(loop do (munch-line) until (eobp) do (forward-line 1)) -@end example - -@noindent -This loop is similar to the above one, except that @code{munch-line} -is always called at least once. - -@example -(loop for x from 1 to 100 - for y = (* x x) - until (>= y 729) - finally return (list x (= y 729))) -@end example - -@noindent -This more complicated loop searches for a number @code{x} whose -square is 729. For safety's sake it only examines @code{x} -values up to 100; dropping the phrase @samp{to 100} would -cause the loop to count upwards with no limit. The second -@code{for} clause defines @code{y} to be the square of @code{x} -within the loop; the expression after the @code{=} sign is -reevaluated each time through the loop. The @code{until} -clause gives a condition for terminating the loop, and the -@code{finally} clause says what to do when the loop finishes. -(This particular example was written less concisely than it -could have been, just for the sake of illustration.) - -Note that even though this loop contains three clauses (two -@code{for}s and an @code{until}) that would have been enough to -define loops all by themselves, it still creates a single loop -rather than some sort of triple-nested loop. You must explicitly -nest your @code{loop} constructs if you want nested loops. - -@node For Clauses, Iteration Clauses, Loop Examples, Loop Facility -@subsection For Clauses - -@noindent -Most loops are governed by one or more @code{for} clauses. -A @code{for} clause simultaneously describes variables to be -bound, how those variables are to be stepped during the loop, -and usually an end condition based on those variables. - -The word @code{as} is a synonym for the word @code{for}. This -word is followed by a variable name, then a word like @code{from} -or @code{across} that describes the kind of iteration desired. -In Common Lisp, the phrase @code{being the} sometimes precedes -the type of iteration; in this package both @code{being} and -@code{the} are optional. The word @code{each} is a synonym -for @code{the}, and the word that follows it may be singular -or plural: @samp{for x being the elements of y} or -@samp{for x being each element of y}. Which form you use -is purely a matter of style. - -The variable is bound around the loop as if by @code{let}: - -@example -(setq i 'happy) -(loop for i from 1 to 10 do (do-something-with i)) -i - @result{} happy -@end example - -@table @code -@item for @var{var} from @var{expr1} to @var{expr2} by @var{expr3} -This type of @code{for} clause creates a counting loop. Each of -the three sub-terms is optional, though there must be at least one -term so that the clause is marked as a counting clause. - -The three expressions are the starting value, the ending value, and -the step value, respectively, of the variable. The loop counts -upwards by default (@var{expr3} must be positive), from @var{expr1} -to @var{expr2} inclusively. If you omit the @code{from} term, the -loop counts from zero; if you omit the @code{to} term, the loop -counts forever without stopping (unless stopped by some other -loop clause, of course); if you omit the @code{by} term, the loop -counts in steps of one. - -You can replace the word @code{from} with @code{upfrom} or -@code{downfrom} to indicate the direction of the loop. Likewise, -you can replace @code{to} with @code{upto} or @code{downto}. -For example, @samp{for x from 5 downto 1} executes five times -with @code{x} taking on the integers from 5 down to 1 in turn. -Also, you can replace @code{to} with @code{below} or @code{above}, -which are like @code{upto} and @code{downto} respectively except -that they are exclusive rather than inclusive limits: - -@example -(loop for x to 10 collect x) - @result{} (0 1 2 3 4 5 6 7 8 9 10) -(loop for x below 10 collect x) - @result{} (0 1 2 3 4 5 6 7 8 9) -@end example - -The @code{by} value is always positive, even for downward-counting -loops. Some sort of @code{from} value is required for downward -loops; @samp{for x downto 5} is not a legal loop clause all by -itself. - -@item for @var{var} in @var{list} by @var{function} -This clause iterates @var{var} over all the elements of @var{list}, -in turn. If you specify the @code{by} term, then @var{function} -is used to traverse the list instead of @code{cdr}; it must be a -function taking one argument. For example: - -@example -(loop for x in '(1 2 3 4 5 6) collect (* x x)) - @result{} (1 4 9 16 25 36) -(loop for x in '(1 2 3 4 5 6) by 'cddr collect (* x x)) - @result{} (1 9 25) -@end example - -@item for @var{var} on @var{list} by @var{function} -This clause iterates @var{var} over all the cons cells of @var{list}. - -@example -(loop for x on '(1 2 3 4) collect x) - @result{} ((1 2 3 4) (2 3 4) (3 4) (4)) -@end example - -With @code{by}, there is no real reason that the @code{on} expression -must be a list. For example: - -@example -(loop for x on first-animal by 'next-animal collect x) -@end example - -@noindent -where @code{(next-animal x)} takes an ``animal'' @var{x} and returns -the next in the (assumed) sequence of animals, or @code{nil} if -@var{x} was the last animal in the sequence. - -@item for @var{var} in-ref @var{list} by @var{function} -This is like a regular @code{in} clause, but @var{var} becomes -a @code{setf}-able ``reference'' onto the elements of the list -rather than just a temporary variable. For example, - -@example -(loop for x in-ref my-list do (incf x)) -@end example - -@noindent -increments every element of @code{my-list} in place. This clause -is an extension to standard Common Lisp. - -@item for @var{var} across @var{array} -This clause iterates @var{var} over all the elements of @var{array}, -which may be a vector or a string. - -@example -(loop for x across "aeiou" - do (use-vowel (char-to-string x))) -@end example - -@item for @var{var} across-ref @var{array} -This clause iterates over an array, with @var{var} a @code{setf}-able -reference onto the elements; see @code{in-ref} above. - -@item for @var{var} being the elements of @var{sequence} -This clause iterates over the elements of @var{sequence}, which may -be a list, vector, or string. Since the type must be determined -at run-time, this is somewhat less efficient than @code{in} or -@code{across}. The clause may be followed by the additional term -@samp{using (index @var{var2})} to cause @var{var2} to be bound to -the successive indices (starting at 0) of the elements. - -This clause type is taken from older versions of the @code{loop} macro, -and is not present in modern Common Lisp. The @samp{using (sequence ...)} -term of the older macros is not supported. - -@item for @var{var} being the elements of-ref @var{sequence} -This clause iterates over a sequence, with @var{var} a @code{setf}-able -reference onto the elements; see @code{in-ref} above. - -@item for @var{var} being the symbols [of @var{obarray}] -This clause iterates over symbols, either over all interned symbols -or over all symbols in @var{obarray}. The loop is executed with -@var{var} bound to each symbol in turn. The symbols are visited in -an unspecified order. - -As an example, - -@example -(loop for sym being the symbols - when (fboundp sym) - when (string-match "^map" (symbol-name sym)) - collect sym) -@end example - -@noindent -returns a list of all the functions whose names begin with @samp{map}. - -The Common Lisp words @code{external-symbols} and @code{present-symbols} -are also recognized but are equivalent to @code{symbols} in Emacs Lisp. - -Due to a minor implementation restriction, it will not work to have -more than one @code{for} clause iterating over symbols, hash tables, -keymaps, overlays, or intervals in a given @code{loop}. Fortunately, -it would rarely if ever be useful to do so. It @emph{is} legal to mix -one of these types of clauses with other clauses like @code{for ... to} -or @code{while}. - -@item for @var{var} being the hash-keys of @var{hash-table} -This clause iterates over the entries in @var{hash-table}. For each -hash table entry, @var{var} is bound to the entry's key. If you write -@samp{the hash-values} instead, @var{var} is bound to the values -of the entries. The clause may be followed by the additional -term @samp{using (hash-values @var{var2})} (where @code{hash-values} -is the opposite word of the word following @code{the}) to cause -@var{var} and @var{var2} to be bound to the two parts of each -hash table entry. - -@item for @var{var} being the key-codes of @var{keymap} -This clause iterates over the entries in @var{keymap}. In GNU Emacs 18 -and 19, keymaps are either alists or vectors, and key-codes are integers -or symbols. In XEmacs, keymaps are a special new data type, and -key-codes are symbols or lists of symbols. The iteration does not enter -nested keymaps or inherited (parent) keymaps. You can use @samp{the -key-bindings} to access the commands bound to the keys rather than the -key codes, and you can add a @code{using} clause to access both the -codes and the bindings together. - -@item for @var{var} being the key-seqs of @var{keymap} -This clause iterates over all key sequences defined by @var{keymap} -and its nested keymaps, where @var{var} takes on values which are -strings in Emacs 18 or vectors in Emacs 19. The strings or vectors -are reused for each iteration, so you must copy them if you wish to keep -them permanently. You can add a @samp{using (key-bindings ...)} -clause to get the command bindings as well. - -@item for @var{var} being the overlays [of @var{buffer}] @dots{} -This clause iterates over the Emacs 19 ``overlays'' or XEmacs -``extents'' of a buffer (the clause @code{extents} is synonymous with -@code{overlays}). Under Emacs 18, this clause iterates zero times. If -the @code{of} term is omitted, the current buffer is used. This clause -also accepts optional @samp{from @var{pos}} and @samp{to @var{pos}} -terms, limiting the clause to overlays which overlap the specified -region. - -@item for @var{var} being the intervals [of @var{buffer}] @dots{} -This clause iterates over all intervals of a buffer with constant -text properties. The variable @var{var} will be bound to conses -of start and end positions, where one start position is always equal -to the previous end position. The clause allows @code{of}, -@code{from}, @code{to}, and @code{property} terms, where the latter -term restricts the search to just the specified property. The -@code{of} term may specify either a buffer or a string. This -clause is useful only in GNU Emacs 19; in other versions, all -buffers and strings consist of a single interval. - -@item for @var{var} being the frames -This clause iterates over all frames, i.e., X window system windows -open on Emacs files. This clause works only under Emacs 19. The -clause @code{screens} is a synonym for @code{frames}. The frames -are visited in @code{next-frame} order starting from -@code{selected-frame}. - -@item for @var{var} being the windows [of @var{frame}] -This clause iterates over the windows (in the Emacs sense) of -the current frame, or of the specified @var{frame}. (In Emacs 18 -there is only ever one frame, and the @code{of} term is not -allowed there.) - -@item for @var{var} being the buffers -This clause iterates over all buffers in Emacs. It is equivalent -to @samp{for @var{var} in (buffer-list)}. - -@item for @var{var} = @var{expr1} then @var{expr2} -This clause does a general iteration. The first time through -the loop, @var{var} will be bound to @var{expr1}. On the second -and successive iterations it will be set by evaluating @var{expr2} -(which may refer to the old value of @var{var}). For example, -these two loops are effectively the same: - -@example -(loop for x on my-list by 'cddr do ...) -(loop for x = my-list then (cddr x) while x do ...) -@end example - -Note that this type of @code{for} clause does not imply any sort -of terminating condition; the above example combines it with a -@code{while} clause to tell when to end the loop. - -If you omit the @code{then} term, @var{expr1} is used both for -the initial setting and for successive settings: - -@example -(loop for x = (random) when (> x 0) return x) -@end example - -@noindent -This loop keeps taking random numbers from the @code{(random)} -function until it gets a positive one, which it then returns. -@end table - -If you include several @code{for} clauses in a row, they are -treated sequentially (as if by @code{let*} and @code{setq}). -You can instead use the word @code{and} to link the clauses, -in which case they are processed in parallel (as if by @code{let} -and @code{psetq}). - -@example -(loop for x below 5 for y = nil then x collect (list x y)) - @result{} ((0 nil) (1 1) (2 2) (3 3) (4 4)) -(loop for x below 5 and y = nil then x collect (list x y)) - @result{} ((0 nil) (1 0) (2 1) (3 2) (4 3)) -@end example - -@noindent -In the first loop, @code{y} is set based on the value of @code{x} -that was just set by the previous clause; in the second loop, -@code{x} and @code{y} are set simultaneously so @code{y} is set -based on the value of @code{x} left over from the previous time -through the loop. - -Another feature of the @code{loop} macro is @dfn{destructuring}, -similar in concept to the destructuring provided by @code{defmacro}. -The @var{var} part of any @code{for} clause can be given as a list -of variables instead of a single variable. The values produced -during loop execution must be lists; the values in the lists are -stored in the corresponding variables. - -@example -(loop for (x y) in '((2 3) (4 5) (6 7)) collect (+ x y)) - @result{} (5 9 13) -@end example - -In loop destructuring, if there are more values than variables -the trailing values are ignored, and if there are more variables -than values the trailing variables get the value @code{nil}. -If @code{nil} is used as a variable name, the corresponding -values are ignored. Destructuring may be nested, and dotted -lists of variables like @code{(x . y)} are allowed. - -@node Iteration Clauses, Accumulation Clauses, For Clauses, Loop Facility -@subsection Iteration Clauses - -@noindent -Aside from @code{for} clauses, there are several other loop clauses -that control the way the loop operates. They might be used by -themselves, or in conjunction with one or more @code{for} clauses. - -@table @code -@item repeat @var{integer} -This clause simply counts up to the specified number using an -internal temporary variable. The loops - -@example -(loop repeat n do ...) -(loop for temp to n do ...) -@end example - -@noindent -are identical except that the second one forces you to choose -a name for a variable you aren't actually going to use. - -@item while @var{condition} -This clause stops the loop when the specified condition (any Lisp -expression) becomes @code{nil}. For example, the following two -loops are equivalent, except for the implicit @code{nil} block -that surrounds the second one: - -@example -(while @var{cond} @var{forms}@dots{}) -(loop while @var{cond} do @var{forms}@dots{}) -@end example - -@item until @var{condition} -This clause stops the loop when the specified condition is true, -i.e., non-@code{nil}. - -@item always @var{condition} -This clause stops the loop when the specified condition is @code{nil}. -Unlike @code{while}, it stops the loop using @code{return nil} so that -the @code{finally} clauses are not executed. If all the conditions -were non-@code{nil}, the loop returns @code{t}: - -@example -(if (loop for size in size-list always (> size 10)) - (some-big-sizes) - (no-big-sizes)) -@end example - -@item never @var{condition} -This clause is like @code{always}, except that the loop returns -@code{t} if any conditions were false, or @code{nil} otherwise. - -@item thereis @var{condition} -This clause stops the loop when the specified form is non-@code{nil}; -in this case, it returns that non-@code{nil} value. If all the -values were @code{nil}, the loop returns @code{nil}. -@end table - -@node Accumulation Clauses, Other Clauses, Iteration Clauses, Loop Facility -@subsection Accumulation Clauses - -@noindent -These clauses cause the loop to accumulate information about the -specified Lisp @var{form}. The accumulated result is returned -from the loop unless overridden, say, by a @code{return} clause. - -@table @code -@item collect @var{form} -This clause collects the values of @var{form} into a list. Several -examples of @code{collect} appear elsewhere in this manual. - -The word @code{collecting} is a synonym for @code{collect}, and -likewise for the other accumulation clauses. - -@item append @var{form} -This clause collects lists of values into a result list using -@code{append}. - -@item nconc @var{form} -This clause collects lists of values into a result list by -destructively modifying the lists rather than copying them. - -@item concat @var{form} -This clause concatenates the values of the specified @var{form} -into a string. (It and the following clause are extensions to -standard Common Lisp.) - -@item vconcat @var{form} -This clause concatenates the values of the specified @var{form} -into a vector. - -@item count @var{form} -This clause counts the number of times the specified @var{form} -evaluates to a non-@code{nil} value. - -@item sum @var{form} -This clause accumulates the sum of the values of the specified -@var{form}, which must evaluate to a number. - -@item maximize @var{form} -This clause accumulates the maximum value of the specified @var{form}, -which must evaluate to a number. The return value is undefined if -@code{maximize} is executed zero times. - -@item minimize @var{form} -This clause accumulates the minimum value of the specified @var{form}. -@end table - -Accumulation clauses can be followed by @samp{into @var{var}} to -cause the data to be collected into variable @var{var} (which is -automatically @code{let}-bound during the loop) rather than an -unnamed temporary variable. Also, @code{into} accumulations do -not automatically imply a return value. The loop must use some -explicit mechanism, such as @code{finally return}, to return -the accumulated result. - -It is legal for several accumulation clauses of the same type to -accumulate into the same place. From Steele: - -@example -(loop for name in '(fred sue alice joe june) - for kids in '((bob ken) () () (kris sunshine) ()) - collect name - append kids) - @result{} (fred bob ken sue alice joe kris sunshine june) -@end example - -@node Other Clauses, , Accumulation Clauses, Loop Facility -@subsection Other Clauses - -@noindent -This section describes the remaining loop clauses. - -@table @code -@item with @var{var} = @var{value} -This clause binds a variable to a value around the loop, but -otherwise leaves the variable alone during the loop. The following -loops are basically equivalent: - -@example -(loop with x = 17 do ...) -(let ((x 17)) (loop do ...)) -(loop for x = 17 then x do ...) -@end example - -Naturally, the variable @var{var} might be used for some purpose -in the rest of the loop. For example: - -@example -(loop for x in my-list with res = nil do (push x res) - finally return res) -@end example - -This loop inserts the elements of @code{my-list} at the front of -a new list being accumulated in @code{res}, then returns the -list @code{res} at the end of the loop. The effect is similar -to that of a @code{collect} clause, but the list gets reversed -by virtue of the fact that elements are being pushed onto the -front of @code{res} rather than the end. - -If you omit the @code{=} term, the variable is initialized to -@code{nil}. (Thus the @samp{= nil} in the above example is -unnecessary.) - -Bindings made by @code{with} are sequential by default, as if -by @code{let*}. Just like @code{for} clauses, @code{with} clauses -can be linked with @code{and} to cause the bindings to be made by -@code{let} instead. - -@item if @var{condition} @var{clause} -This clause executes the following loop clause only if the specified -condition is true. The following @var{clause} should be an accumulation, -@code{do}, @code{return}, @code{if}, or @code{unless} clause. -Several clauses may be linked by separating them with @code{and}. -These clauses may be followed by @code{else} and a clause or clauses -to execute if the condition was false. The whole construct may -optionally be followed by the word @code{end} (which may be used to -disambiguate an @code{else} or @code{and} in a nested @code{if}). - -The actual non-@code{nil} value of the condition form is available -by the name @code{it} in the ``then'' part. For example: - -@example -(setq funny-numbers '(6 13 -1)) - @result{} (6 13 -1) -(loop for x below 10 - if (oddp x) - collect x into odds - and if (memq x funny-numbers) return (cdr it) end - else - collect x into evens - finally return (vector odds evens)) - @result{} [(1 3 5 7 9) (0 2 4 6 8)] -(setq funny-numbers '(6 7 13 -1)) - @result{} (6 7 13 -1) -(loop <@r{same thing again}>) - @result{} (13 -1) -@end example - -Note the use of @code{and} to put two clauses into the ``then'' -part, one of which is itself an @code{if} clause. Note also that -@code{end}, while normally optional, was necessary here to make -it clear that the @code{else} refers to the outermost @code{if} -clause. In the first case, the loop returns a vector of lists -of the odd and even values of @var{x}. In the second case, the -odd number 7 is one of the @code{funny-numbers} so the loop -returns early; the actual returned value is based on the result -of the @code{memq} call. - -@item when @var{condition} @var{clause} -This clause is just a synonym for @code{if}. - -@item unless @var{condition} @var{clause} -The @code{unless} clause is just like @code{if} except that the -sense of the condition is reversed. - -@item named @var{name} -This clause gives a name other than @code{nil} to the implicit -block surrounding the loop. The @var{name} is the symbol to be -used as the block name. - -@item initially [do] @var{forms}... -This keyword introduces one or more Lisp forms which will be -executed before the loop itself begins (but after any variables -requested by @code{for} or @code{with} have been bound to their -initial values). @code{initially} clauses can appear anywhere; -if there are several, they are executed in the order they appear -in the loop. The keyword @code{do} is optional. - -@item finally [do] @var{forms}... -This introduces Lisp forms which will be executed after the loop -finishes (say, on request of a @code{for} or @code{while}). -@code{initially} and @code{finally} clauses may appear anywhere -in the loop construct, but they are executed (in the specified -order) at the beginning or end, respectively, of the loop. - -@item finally return @var{form} -This says that @var{form} should be executed after the loop -is done to obtain a return value. (Without this, or some other -clause like @code{collect} or @code{return}, the loop will simply -return @code{nil}.) Variables bound by @code{for}, @code{with}, -or @code{into} will still contain their final values when @var{form} -is executed. - -@item do @var{forms}... -The word @code{do} may be followed by any number of Lisp expressions -which are executed as an implicit @code{progn} in the body of the -loop. Many of the examples in this section illustrate the use of -@code{do}. - -@item return @var{form} -This clause causes the loop to return immediately. The following -Lisp form is evaluated to give the return value of the @code{loop} -form. The @code{finally} clauses, if any, are not executed. -Of course, @code{return} is generally used inside an @code{if} or -@code{unless}, as its use in a top-level loop clause would mean -the loop would never get to ``loop'' more than once. - -The clause @samp{return @var{form}} is equivalent to -@samp{do (return @var{form})} (or @code{return-from} if the loop -was named). The @code{return} clause is implemented a bit more -efficiently, though. -@end table - -While there is no high-level way to add user extensions to @code{loop} -(comparable to @code{defsetf} for @code{setf}, say), this package -does offer two properties called @code{cl-loop-handler} and -@code{cl-loop-for-handler} which are functions to be called when -a given symbol is encountered as a top-level loop clause or -@code{for} clause, respectively. Consult the source code in -file @file{cl-macs.el} for details. - -This package's @code{loop} macro is compatible with that of Common -Lisp, except that a few features are not implemented: @code{loop-finish} -and data-type specifiers. Naturally, the @code{for} clauses which -iterate over keymaps, overlays, intervals, frames, windows, and -buffers are Emacs-specific extensions. - -@node Multiple Values, , Loop Facility, Control Structure -@section Multiple Values - -@noindent -Common Lisp functions can return zero or more results. Emacs Lisp -functions, by contrast, always return exactly one result. This -package makes no attempt to emulate Common Lisp multiple return -values; Emacs versions of Common Lisp functions that return more -than one value either return just the first value (as in -@code{compiler-macroexpand}) or return a list of values (as in -@code{get-setf-method}). This package @emph{does} define placeholders -for the Common Lisp functions that work with multiple values, but -in Emacs Lisp these functions simply operate on lists instead. -The @code{values} form, for example, is a synonym for @code{list} -in Emacs. - -@defspec multiple-value-bind (var@dots{}) values-form forms@dots{} -This form evaluates @var{values-form}, which must return a list of -values. It then binds the @var{var}s to these respective values, -as if by @code{let}, and then executes the body @var{forms}. -If there are more @var{var}s than values, the extra @var{var}s -are bound to @code{nil}. If there are fewer @var{var}s than -values, the excess values are ignored. -@end defspec - -@defspec multiple-value-setq (var@dots{}) form -This form evaluates @var{form}, which must return a list of values. -It then sets the @var{var}s to these respective values, as if by -@code{setq}. Extra @var{var}s or values are treated the same as -in @code{multiple-value-bind}. -@end defspec - -The older Quiroz package attempted a more faithful (but still -imperfect) emulation of Common Lisp multiple values. The old -method ``usually'' simulated true multiple values quite well, -but under certain circumstances would leave spurious return -values in memory where a later, unrelated @code{multiple-value-bind} -form would see them. - -Since a perfect emulation is not feasible in Emacs Lisp, this -package opts to keep it as simple and predictable as possible. - -@node Macros, Declarations, Control Structure, Top -@chapter Macros - -@noindent -This package implements the various Common Lisp features of -@code{defmacro}, such as destructuring, @code{&environment}, -and @code{&body}. Top-level @code{&whole} is not implemented -for @code{defmacro} due to technical difficulties. -@xref{Argument Lists}. - -Destructuring is made available to the user by way of the -following macro: - -@defspec destructuring-bind arglist expr forms@dots{} -This macro expands to code which executes @var{forms}, with -the variables in @var{arglist} bound to the list of values -returned by @var{expr}. The @var{arglist} can include all -the features allowed for @code{defmacro} argument lists, -including destructuring. (The @code{&environment} keyword -is not allowed.) The macro expansion will signal an error -if @var{expr} returns a list of the wrong number of arguments -or with incorrect keyword arguments. -@end defspec - -This package also includes the Common Lisp @code{define-compiler-macro} -facility, which allows you to define compile-time expansions and -optimizations for your functions. - -@defspec define-compiler-macro name arglist forms@dots{} -This form is similar to @code{defmacro}, except that it only expands -calls to @var{name} at compile-time; calls processed by the Lisp -interpreter are not expanded, nor are they expanded by the -@code{macroexpand} function. - -The argument list may begin with a @code{&whole} keyword and a -variable. This variable is bound to the macro-call form itself, -i.e., to a list of the form @samp{(@var{name} @var{args}@dots{})}. -If the macro expander returns this form unchanged, then the -compiler treats it as a normal function call. This allows -compiler macros to work as optimizers for special cases of a -function, leaving complicated cases alone. - -For example, here is a simplified version of a definition that -appears as a standard part of this package: - -@example -(define-compiler-macro member* (&whole form a list &rest keys) - (if (and (null keys) - (eq (car-safe a) 'quote) - (not (floatp-safe (cadr a)))) - (list 'memq a list) - form)) -@end example - -@noindent -This definition causes @code{(member* @var{a} @var{list})} to change -to a call to the faster @code{memq} in the common case where @var{a} -is a non-floating-point constant; if @var{a} is anything else, or -if there are any keyword arguments in the call, then the original -@code{member*} call is left intact. (The actual compiler macro -for @code{member*} optimizes a number of other cases, including -common @code{:test} predicates.) -@end defspec - -@defun compiler-macroexpand form -This function is analogous to @code{macroexpand}, except that it -expands compiler macros rather than regular macros. It returns -@var{form} unchanged if it is not a call to a function for which -a compiler macro has been defined, or if that compiler macro -decided to punt by returning its @code{&whole} argument. Like -@code{macroexpand}, it expands repeatedly until it reaches a form -for which no further expansion is possible. -@end defun - -@xref{Macro Bindings}, for descriptions of the @code{macrolet} -and @code{symbol-macrolet} forms for making ``local'' macro -definitions. - -@node Declarations, Symbols, Macros, Top -@chapter Declarations - -@noindent -Common Lisp includes a complex and powerful ``declaration'' -mechanism that allows you to give the compiler special hints -about the types of data that will be stored in particular variables, -and about the ways those variables and functions will be used. This -package defines versions of all the Common Lisp declaration forms: -@code{declare}, @code{locally}, @code{proclaim}, @code{declaim}, -and @code{the}. - -Most of the Common Lisp declarations are not currently useful in -Emacs Lisp, as the byte-code system provides little opportunity -to benefit from type information, and @code{special} declarations -are redundant in a fully dynamically-scoped Lisp. A few -declarations are meaningful when the optimizing Emacs 19 byte -compiler is being used, however. Under the earlier non-optimizing -compiler, these declarations will effectively be ignored. - -@defun proclaim decl-spec -This function records a ``global'' declaration specified by -@var{decl-spec}. Since @code{proclaim} is a function, @var{decl-spec} -is evaluated and thus should normally be quoted. -@end defun - -@defspec declaim decl-specs@dots{} -This macro is like @code{proclaim}, except that it takes any number -of @var{decl-spec} arguments, and the arguments are unevaluated and -unquoted. The @code{declaim} macro also puts an @code{(eval-when -(compile load eval) ...)} around the declarations so that they will -be registered at compile-time as well as at run-time. (This is vital, -since normally the declarations are meant to influence the way the -compiler treats the rest of the file that contains the @code{declaim} -form.) -@end defspec - -@defspec declare decl-specs@dots{} -This macro is used to make declarations within functions and other -code. Common Lisp allows declarations in various locations, generally -at the beginning of any of the many ``implicit @code{progn}s'' -throughout Lisp syntax, such as function bodies, @code{let} bodies, -etc. Currently the only declaration understood by @code{declare} -is @code{special}. -@end defspec - -@defspec locally declarations@dots{} forms@dots{} -In this package, @code{locally} is no different from @code{progn}. -@end defspec - -@defspec the type form -Type information provided by @code{the} is ignored in this package; -in other words, @code{(the @var{type} @var{form})} is equivalent -to @var{form}. Future versions of the optimizing byte-compiler may -make use of this information. - -For example, @code{mapcar} can map over both lists and arrays. It is -hard for the compiler to expand @code{mapcar} into an in-line loop -unless it knows whether the sequence will be a list or an array ahead -of time. With @code{(mapcar 'car (the vector foo))}, a future -compiler would have enough information to expand the loop in-line. -For now, Emacs Lisp will treat the above code as exactly equivalent -to @code{(mapcar 'car foo)}. -@end defspec - -Each @var{decl-spec} in a @code{proclaim}, @code{declaim}, or -@code{declare} should be a list beginning with a symbol that says -what kind of declaration it is. This package currently understands -@code{special}, @code{inline}, @code{notinline}, @code{optimize}, -and @code{warn} declarations. (The @code{warn} declaration is an -extension of standard Common Lisp.) Other Common Lisp declarations, -such as @code{type} and @code{ftype}, are silently ignored. - -@table @code -@item special -Since all variables in Emacs Lisp are ``special'' (in the Common -Lisp sense), @code{special} declarations are only advisory. They -simply tell the optimizing byte compiler that the specified -variables are intentionally being referred to without being -bound in the body of the function. The compiler normally emits -warnings for such references, since they could be typographical -errors for references to local variables. - -The declaration @code{(declare (special @var{var1} @var{var2}))} is -equivalent to @code{(defvar @var{var1}) (defvar @var{var2})} in the -optimizing compiler, or to nothing at all in older compilers (which -do not warn for non-local references). - -In top-level contexts, it is generally better to write -@code{(defvar @var{var})} than @code{(declaim (special @var{var}))}, -since @code{defvar} makes your intentions clearer. But the older -byte compilers can not handle @code{defvar}s appearing inside of -functions, while @code{(declare (special @var{var}))} takes care -to work correctly with all compilers. - -@item inline -The @code{inline} @var{decl-spec} lists one or more functions -whose bodies should be expanded ``in-line'' into calling functions -whenever the compiler is able to arrange for it. For example, -the Common Lisp function @code{cadr} is declared @code{inline} -by this package so that the form @code{(cadr @var{x})} will -expand directly into @code{(car (cdr @var{x}))} when it is called -in user functions, for a savings of one (relatively expensive) -function call. - -The following declarations are all equivalent. Note that the -@code{defsubst} form is a convenient way to define a function -and declare it inline all at once, but it is available only in -Emacs 19. - -@example -(declaim (inline foo bar)) -(eval-when (compile load eval) (proclaim '(inline foo bar))) -(proclaim-inline foo bar) ; XEmacs only -(defsubst foo (...) ...) ; instead of defun; Emacs 19 only -@end example - -@strong{Please note:} This declaration remains in effect after the -containing source file is done. It is correct to use it to -request that a function you have defined should be inlined, -but it is impolite to use it to request inlining of an external -function. - -In Common Lisp, it is possible to use @code{(declare (inline @dots{}))} -before a particular call to a function to cause just that call to -be inlined; the current byte compilers provide no way to implement -this, so @code{(declare (inline @dots{}))} is currently ignored by -this package. - -@item notinline -The @code{notinline} declaration lists functions which should -not be inlined after all; it cancels a previous @code{inline} -declaration. - -@item optimize -This declaration controls how much optimization is performed by -the compiler. Naturally, it is ignored by the earlier non-optimizing -compilers. - -The word @code{optimize} is followed by any number of lists like -@code{(speed 3)} or @code{(safety 2)}. Common Lisp defines several -optimization ``qualities''; this package ignores all but @code{speed} -and @code{safety}. The value of a quality should be an integer from -0 to 3, with 0 meaning ``unimportant'' and 3 meaning ``very important.'' -The default level for both qualities is 1. - -In this package, with the Emacs 19 optimizing compiler, the -@code{speed} quality is tied to the @code{byte-compile-optimize} -flag, which is set to @code{nil} for @code{(speed 0)} and to -@code{t} for higher settings; and the @code{safety} quality is -tied to the @code{byte-compile-delete-errors} flag, which is -set to @code{t} for @code{(safety 3)} and to @code{nil} for all -lower settings. (The latter flag controls whether the compiler -is allowed to optimize out code whose only side-effect could -be to signal an error, e.g., rewriting @code{(progn foo bar)} to -@code{bar} when it is not known whether @code{foo} will be bound -at run-time.) - -Note that even compiling with @code{(safety 0)}, the Emacs -byte-code system provides sufficient checking to prevent real -harm from being done. For example, barring serious bugs in -Emacs itself, Emacs will not crash with a segmentation fault -just because of an error in a fully-optimized Lisp program. - -The @code{optimize} declaration is normally used in a top-level -@code{proclaim} or @code{declaim} in a file; Common Lisp allows -it to be used with @code{declare} to set the level of optimization -locally for a given form, but this will not work correctly with the -current version of the optimizing compiler. (The @code{declare} -will set the new optimization level, but that level will not -automatically be unset after the enclosing form is done.) - -@item warn -This declaration controls what sorts of warnings are generated -by the byte compiler. Again, only the optimizing compiler -generates warnings. The word @code{warn} is followed by any -number of ``warning qualities,'' similar in form to optimization -qualities. The currently supported warning types are -@code{redefine}, @code{callargs}, @code{unresolved}, and -@code{free-vars}; in the current system, a value of 0 will -disable these warnings and any higher value will enable them. -See the documentation for the optimizing byte compiler for details. -@end table - -@node Symbols, Numbers, Declarations, Top -@chapter Symbols - -@noindent -This package defines several symbol-related features that were -missing from Emacs Lisp. - -@menu -* Property Lists:: `get*', `remprop', `getf', `remf' -* Creating Symbols:: `gensym', `gentemp' -@end menu - -@node Property Lists, Creating Symbols, Symbols, Symbols -@section Property Lists - -@noindent -These functions augment the standard Emacs Lisp functions @code{get} -and @code{put} for operating on properties attached to symbols. -There are also functions for working with property lists as -first-class data structures not attached to particular symbols. - -@defun get* symbol property &optional default -This function is like @code{get}, except that if the property is -not found, the @var{default} argument provides the return value. -(The Emacs Lisp @code{get} function always uses @code{nil} as -the default; this package's @code{get*} is equivalent to Common -Lisp's @code{get}.) - -The @code{get*} function is @code{setf}-able; when used in this -fashion, the @var{default} argument is allowed but ignored. -@end defun - -@defun remprop symbol property -This function removes the entry for @var{property} from the property -list of @var{symbol}. It returns a true value if the property was -indeed found and removed, or @code{nil} if there was no such property. -(This function was probably omitted from Emacs originally because, -since @code{get} did not allow a @var{default}, it was very difficult -to distinguish between a missing property and a property whose value -was @code{nil}; thus, setting a property to @code{nil} was close -enough to @code{remprop} for most purposes.) -@end defun - -@defun getf place property &optional default -This function scans the list @var{place} as if it were a property -list, i.e., a list of alternating property names and values. If -an even-numbered element of @var{place} is found which is @code{eq} -to @var{property}, the following odd-numbered element is returned. -Otherwise, @var{default} is returned (or @code{nil} if no default -is given). - -In particular, - -@example -(get sym prop) @equiv{} (getf (symbol-plist sym) prop) -@end example - -It is legal to use @code{getf} as a @code{setf} place, in which case -its @var{place} argument must itself be a legal @code{setf} place. -The @var{default} argument, if any, is ignored in this context. -The effect is to change (via @code{setcar}) the value cell in the -list that corresponds to @var{property}, or to cons a new property-value -pair onto the list if the property is not yet present. - -@example -(put sym prop val) @equiv{} (setf (getf (symbol-plist sym) prop) val) -@end example - -The @code{get} and @code{get*} functions are also @code{setf}-able. -The fact that @code{default} is ignored can sometimes be useful: - -@example -(incf (get* 'foo 'usage-count 0)) -@end example - -Here, symbol @code{foo}'s @code{usage-count} property is incremented -if it exists, or set to 1 (an incremented 0) otherwise. - -When not used as a @code{setf} form, @code{getf} is just a regular -function and its @var{place} argument can actually be any Lisp -expression. -@end defun - -@defspec remf place property -This macro removes the property-value pair for @var{property} from -the property list stored at @var{place}, which is any @code{setf}-able -place expression. It returns true if the property was found. Note -that if @var{property} happens to be first on the list, this will -effectively do a @code{(setf @var{place} (cddr @var{place}))}, -whereas if it occurs later, this simply uses @code{setcdr} to splice -out the property and value cells. -@end defspec - -@iftex -@secno=2 -@end iftex - -@node Creating Symbols, , Property Lists, Symbols -@section Creating Symbols - -@noindent -These functions create unique symbols, typically for use as -temporary variables. - -@defun gensym &optional x -This function creates a new, uninterned symbol (using @code{make-symbol}) -with a unique name. (The name of an uninterned symbol is relevant -only if the symbol is printed.) By default, the name is generated -from an increasing sequence of numbers, @samp{G1000}, @samp{G1001}, -@samp{G1002}, etc. If the optional argument @var{x} is a string, that -string is used as a prefix instead of @samp{G}. Uninterned symbols -are used in macro expansions for temporary variables, to ensure that -their names will not conflict with ``real'' variables in the user's -code. -@end defun - -@defvar *gensym-counter* -This variable holds the counter used to generate @code{gensym} names. -It is incremented after each use by @code{gensym}. In Common Lisp -this is initialized with 0, but this package initializes it with a -random (time-dependent) value to avoid trouble when two files that -each used @code{gensym} in their compilation are loaded together. - -@strong{XEmacs note:} As of XEmacs 21.0, an uninterned symbol remains -uninterned even after being dumped to bytecode. Older versions of Emacs -didn't distinguish the printed representation of interned and uninterned -symbols, so their names had to be treated more carefully. -@end defvar - -@defun gentemp &optional x -This function is like @code{gensym}, except that it produces a new -@emph{interned} symbol. If the symbol that is generated already -exists, the function keeps incrementing the counter and trying -again until a new symbol is generated. -@end defun - -The Quiroz @file{cl.el} package also defined a @code{defkeyword} -form for creating self-quoting keyword symbols. This package -automatically creates all keywords that are called for by -@code{&key} argument specifiers, and discourages the use of -keywords as data unrelated to keyword arguments, so the -@code{defkeyword} form has been discontinued. - -@iftex -@chapno=11 -@end iftex - -@node Numbers, Sequences, Symbols, Top -@chapter Numbers - -@noindent -This section defines a few simple Common Lisp operations on numbers -which were left out of Emacs Lisp. - -@menu -* Predicates on Numbers:: `plusp', `oddp', `floatp-safe', etc. -* Numerical Functions:: `abs', `expt', `floor*', etc. -* Random Numbers:: `random*', `make-random-state' -* Implementation Parameters:: `most-positive-fixnum', `most-positive-float' -@end menu - -@iftex -@secno=1 -@end iftex - -@node Predicates on Numbers, Numerical Functions, Numbers, Numbers -@section Predicates on Numbers - -@noindent -These functions return @code{t} if the specified condition is -true of the numerical argument, or @code{nil} otherwise. - -@defun plusp number -This predicate tests whether @var{number} is positive. It is an -error if the argument is not a number. -@end defun - -@defun minusp number -This predicate tests whether @var{number} is negative. It is an -error if the argument is not a number. -@end defun - -@defun oddp integer -This predicate tests whether @var{integer} is odd. It is an -error if the argument is not an integer. -@end defun - -@defun evenp integer -This predicate tests whether @var{integer} is even. It is an -error if the argument is not an integer. -@end defun - -@defun floatp-safe object -This predicate tests whether @var{object} is a floating-point -number. On systems that support floating-point, this is equivalent -to @code{floatp}. On other systems, this always returns @code{nil}. -@end defun - -@iftex -@secno=3 -@end iftex - -@node Numerical Functions, Random Numbers, Predicates on Numbers, Numbers -@section Numerical Functions - -@noindent -These functions perform various arithmetic operations on numbers. - -@defun abs number -This function returns the absolute value of @var{number}. (Newer -versions of Emacs provide this as a built-in function; this package -defines @code{abs} only for Emacs 18 versions which don't provide -it as a primitive.) -@end defun - -@defun expt base power -This function returns @var{base} raised to the power of @var{number}. -(Newer versions of Emacs provide this as a built-in function; this -package defines @code{expt} only for Emacs 18 versions which don't -provide it as a primitive.) -@end defun - -@defun gcd &rest integers -This function returns the Greatest Common Divisor of the arguments. -For one argument, it returns the absolute value of that argument. -For zero arguments, it returns zero. -@end defun - -@defun lcm &rest integers -This function returns the Least Common Multiple of the arguments. -For one argument, it returns the absolute value of that argument. -For zero arguments, it returns one. -@end defun - -@defun isqrt integer -This function computes the ``integer square root'' of its integer -argument, i.e., the greatest integer less than or equal to the true -square root of the argument. -@end defun - -@defun floor* number &optional divisor -This function implements the Common Lisp @code{floor} function. -It is called @code{floor*} to avoid name conflicts with the -simpler @code{floor} function built-in to Emacs 19. - -With one argument, @code{floor*} returns a list of two numbers: -The argument rounded down (toward minus infinity) to an integer, -and the ``remainder'' which would have to be added back to the -first return value to yield the argument again. If the argument -is an integer @var{x}, the result is always the list @code{(@var{x} 0)}. -If the argument is an Emacs 19 floating-point number, the first -result is a Lisp integer and the second is a Lisp float between -0 (inclusive) and 1 (exclusive). - -With two arguments, @code{floor*} divides @var{number} by -@var{divisor}, and returns the floor of the quotient and the -corresponding remainder as a list of two numbers. If -@code{(floor* @var{x} @var{y})} returns @code{(@var{q} @var{r})}, -then @code{@var{q}*@var{y} + @var{r} = @var{x}}, with @var{r} -between 0 (inclusive) and @var{r} (exclusive). Also, note -that @code{(floor* @var{x})} is exactly equivalent to -@code{(floor* @var{x} 1)}. - -This function is entirely compatible with Common Lisp's @code{floor} -function, except that it returns the two results in a list since -Emacs Lisp does not support multiple-valued functions. -@end defun - -@defun ceiling* number &optional divisor -This function implements the Common Lisp @code{ceiling} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments up toward plus infinity. -The remainder will be between 0 and minus @var{r}. -@end defun - -@defun truncate* number &optional divisor -This function implements the Common Lisp @code{truncate} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments toward zero. Thus it is -equivalent to @code{floor*} if the argument or quotient is -positive, or to @code{ceiling*} otherwise. The remainder has -the same sign as @var{number}. -@end defun - -@defun round* number &optional divisor -This function implements the Common Lisp @code{round} function, -which is analogous to @code{floor} except that it rounds the -argument or quotient of the arguments to the nearest integer. -In the case of a tie (the argument or quotient is exactly -halfway between two integers), it rounds to the even integer. -@end defun - -@defun mod* number divisor -This function returns the same value as the second return value -of @code{floor}. -@end defun - -@defun rem* number divisor -This function returns the same value as the second return value -of @code{truncate}. -@end defun - -These definitions are compatible with those in the Quiroz -@file{cl.el} package, except that this package appends @samp{*} -to certain function names to avoid conflicts with existing -Emacs 19 functions, and that the mechanism for returning -multiple values is different. - -@iftex -@secno=8 -@end iftex - -@node Random Numbers, Implementation Parameters, Numerical Functions, Numbers -@section Random Numbers - -@noindent -This package also provides an implementation of the Common Lisp -random number generator. It uses its own additive-congruential -algorithm, which is much more likely to give statistically clean -random numbers than the simple generators supplied by many -operating systems. - -@defun random* number &optional state -This function returns a random nonnegative number less than -@var{number}, and of the same type (either integer or floating-point). -The @var{state} argument should be a @code{random-state} object -which holds the state of the random number generator. The -function modifies this state object as a side effect. If -@var{state} is omitted, it defaults to the variable -@code{*random-state*}, which contains a pre-initialized -@code{random-state} object. -@end defun - -@defvar *random-state* -This variable contains the system ``default'' @code{random-state} -object, used for calls to @code{random*} that do not specify an -alternative state object. Since any number of programs in the -Emacs process may be accessing @code{*random-state*} in interleaved -fashion, the sequence generated from this variable will be -irreproducible for all intents and purposes. -@end defvar - -@defun make-random-state &optional state -This function creates or copies a @code{random-state} object. -If @var{state} is omitted or @code{nil}, it returns a new copy of -@code{*random-state*}. This is a copy in the sense that future -sequences of calls to @code{(random* @var{n})} and -@code{(random* @var{n} @var{s})} (where @var{s} is the new -random-state object) will return identical sequences of random -numbers. - -If @var{state} is a @code{random-state} object, this function -returns a copy of that object. If @var{state} is @code{t}, this -function returns a new @code{random-state} object seeded from the -date and time. As an extension to Common Lisp, @var{state} may also -be an integer in which case the new object is seeded from that -integer; each different integer seed will result in a completely -different sequence of random numbers. - -It is legal to print a @code{random-state} object to a buffer or -file and later read it back with @code{read}. If a program wishes -to use a sequence of pseudo-random numbers which can be reproduced -later for debugging, it can call @code{(make-random-state t)} to -get a new sequence, then print this sequence to a file. When the -program is later rerun, it can read the original run's random-state -from the file. -@end defun - -@defun random-state-p object -This predicate returns @code{t} if @var{object} is a -@code{random-state} object, or @code{nil} otherwise. -@end defun - -@node Implementation Parameters, , Random Numbers, Numbers -@section Implementation Parameters - -@noindent -This package defines several useful constants having to with numbers. - -@defvar most-positive-fixnum -This constant equals the largest value a Lisp integer can hold. -It is typically @code{2^23-1} or @code{2^25-1}. -@end defvar - -@defvar most-negative-fixnum -This constant equals the smallest (most negative) value a Lisp -integer can hold. -@end defvar - -The following parameters have to do with floating-point numbers. -This package determines their values by exercising the computer's -floating-point arithmetic in various ways. Because this operation -might be slow, the code for initializing them is kept in a separate -function that must be called before the parameters can be used. - -@defun cl-float-limits -This function makes sure that the Common Lisp floating-point -parameters like @code{most-positive-float} have been initialized. -Until it is called, these parameters will be @code{nil}. If this -version of Emacs does not support floats (e.g., most versions of -Emacs 18), the parameters will remain @code{nil}. If the parameters -have already been initialized, the function returns immediately. - -The algorithm makes assumptions that will be valid for most modern -machines, but will fail if the machine's arithmetic is extremely -unusual, e.g., decimal. -@end defun - -Since true Common Lisp supports up to four different floating-point -precisions, it has families of constants like -@code{most-positive-single-float}, @code{most-positive-double-float}, -@code{most-positive-long-float}, and so on. Emacs has only one -floating-point precision, so this package omits the precision word -from the constants' names. - -@defvar most-positive-float -This constant equals the largest value a Lisp float can hold. -For those systems whose arithmetic supports infinities, this is -the largest @emph{finite} value. For IEEE machines, the value -is approximately @code{1.79e+308}. -@end defvar - -@defvar most-negative-float -This constant equals the most-negative value a Lisp float can hold. -(It is assumed to be equal to @code{(- most-positive-float)}.) -@end defvar - -@defvar least-positive-float -This constant equals the smallest Lisp float value greater than zero. -For IEEE machines, it is about @code{4.94e-324} if denormals are -supported or @code{2.22e-308} if not. -@end defvar - -@defvar least-positive-normalized-float -This constant equals the smallest @emph{normalized} Lisp float greater -than zero, i.e., the smallest value for which IEEE denormalization -will not result in a loss of precision. For IEEE machines, this -value is about @code{2.22e-308}. For machines that do not support -the concept of denormalization and gradual underflow, this constant -will always equal @code{least-positive-float}. -@end defvar - -@defvar least-negative-float -This constant is the negative counterpart of @code{least-positive-float}. -@end defvar - -@defvar least-negative-normalized-float -This constant is the negative counterpart of -@code{least-positive-normalized-float}. -@end defvar - -@defvar float-epsilon -This constant is the smallest positive Lisp float that can be added -to 1.0 to produce a distinct value. Adding a smaller number to 1.0 -will yield 1.0 again due to roundoff. For IEEE machines, epsilon -is about @code{2.22e-16}. -@end defvar - -@defvar float-negative-epsilon -This is the smallest positive value that can be subtracted from -1.0 to produce a distinct value. For IEEE machines, it is about -@code{1.11e-16}. -@end defvar - -@iftex -@chapno=13 -@end iftex - -@node Sequences, Lists, Numbers, Top -@chapter Sequences - -@noindent -Common Lisp defines a number of functions that operate on -@dfn{sequences}, which are either lists, strings, or vectors. -Emacs Lisp includes a few of these, notably @code{elt} and -@code{length}; this package defines most of the rest. - -@menu -* Sequence Basics:: Arguments shared by all sequence functions -* Mapping over Sequences:: `mapcar*', `mapcan', `map', `every', etc. -* Sequence Functions:: `subseq', `remove*', `substitute', etc. -* Searching Sequences:: `find', `position', `count', `search', etc. -* Sorting Sequences:: `sort*', `stable-sort', `merge' -@end menu - -@node Sequence Basics, Mapping over Sequences, Sequences, Sequences -@section Sequence Basics - -@noindent -Many of the sequence functions take keyword arguments; @pxref{Argument -Lists}. All keyword arguments are optional and, if specified, -may appear in any order. - -The @code{:key} argument should be passed either @code{nil}, or a -function of one argument. This key function is used as a filter -through which the elements of the sequence are seen; for example, -@code{(find x y :key 'car)} is similar to @code{(assoc* x y)}: -It searches for an element of the list whose @code{car} equals -@code{x}, rather than for an element which equals @code{x} itself. -If @code{:key} is omitted or @code{nil}, the filter is effectively -the identity function. - -The @code{:test} and @code{:test-not} arguments should be either -@code{nil}, or functions of two arguments. The test function is -used to compare two sequence elements, or to compare a search value -with sequence elements. (The two values are passed to the test -function in the same order as the original sequence function -arguments from which they are derived, or, if they both come from -the same sequence, in the same order as they appear in that sequence.) -The @code{:test} argument specifies a function which must return -true (non-@code{nil}) to indicate a match; instead, you may use -@code{:test-not} to give a function which returns @emph{false} to -indicate a match. The default test function is @code{:test 'eql}. - -Many functions which take @var{item} and @code{:test} or @code{:test-not} -arguments also come in @code{-if} and @code{-if-not} varieties, -where a @var{predicate} function is passed instead of @var{item}, -and sequence elements match if the predicate returns true on them -(or false in the case of @code{-if-not}). For example: - -@example -(remove* 0 seq :test '=) @equiv{} (remove-if 'zerop seq) -@end example - -@noindent -to remove all zeros from sequence @code{seq}. - -Some operations can work on a subsequence of the argument sequence; -these function take @code{:start} and @code{:end} arguments which -default to zero and the length of the sequence, respectively. -Only elements between @var{start} (inclusive) and @var{end} -(exclusive) are affected by the operation. The @var{end} argument -may be passed @code{nil} to signify the length of the sequence; -otherwise, both @var{start} and @var{end} must be integers, with -@code{0 <= @var{start} <= @var{end} <= (length @var{seq})}. -If the function takes two sequence arguments, the limits are -defined by keywords @code{:start1} and @code{:end1} for the first, -and @code{:start2} and @code{:end2} for the second. - -A few functions accept a @code{:from-end} argument, which, if -non-@code{nil}, causes the operation to go from right-to-left -through the sequence instead of left-to-right, and a @code{:count} -argument, which specifies an integer maximum number of elements -to be removed or otherwise processed. - -The sequence functions make no guarantees about the order in -which the @code{:test}, @code{:test-not}, and @code{:key} functions -are called on various elements. Therefore, it is a bad idea to depend -on side effects of these functions. For example, @code{:from-end} -may cause the sequence to be scanned actually in reverse, or it may -be scanned forwards but computing a result ``as if'' it were scanned -backwards. (Some functions, like @code{mapcar*} and @code{every}, -@emph{do} specify exactly the order in which the function is called -so side effects are perfectly acceptable in those cases.) - -Strings in GNU Emacs 19 may contain ``text properties'' as well -as character data. Except as noted, it is undefined whether or -not text properties are preserved by sequence functions. For -example, @code{(remove* ?A @var{str})} may or may not preserve -the properties of the characters copied from @var{str} into the -result. - -@node Mapping over Sequences, Sequence Functions, Sequence Basics, Sequences -@section Mapping over Sequences - -@noindent -These functions ``map'' the function you specify over the elements -of lists or arrays. They are all variations on the theme of the -built-in function @code{mapcar}. - -@defun mapcar* function seq &rest more-seqs -This function calls @var{function} on successive parallel sets of -elements from its argument sequences. Given a single @var{seq} -argument it is equivalent to @code{mapcar}; given @var{n} sequences, -it calls the function with the first elements of each of the sequences -as the @var{n} arguments to yield the first element of the result -list, then with the second elements, and so on. The mapping stops as -soon as the shortest sequence runs out. The argument sequences may -be any mixture of lists, strings, and vectors; the return sequence -is always a list. - -Common Lisp's @code{mapcar} accepts multiple arguments but works -only on lists; Emacs Lisp's @code{mapcar} accepts a single sequence -argument. This package's @code{mapcar*} works as a compatible -superset of both. -@end defun - -@defun map result-type function seq &rest more-seqs -This function maps @var{function} over the argument sequences, -just like @code{mapcar*}, but it returns a sequence of type -@var{result-type} rather than a list. @var{result-type} must -be one of the following symbols: @code{vector}, @code{string}, -@code{list} (in which case the effect is the same as for -@code{mapcar*}), or @code{nil} (in which case the results are -thrown away and @code{map} returns @code{nil}). -@end defun - -@defun maplist function list &rest more-lists -This function calls @var{function} on each of its argument lists, -then on the @code{cdr}s of those lists, and so on, until the -shortest list runs out. The results are returned in the form -of a list. Thus, @code{maplist} is like @code{mapcar*} except -that it passes in the list pointers themselves rather than the -@code{car}s of the advancing pointers. -@end defun - -@defun mapc function seq &rest more-seqs -This function is like @code{mapcar*}, except that the values -returned by @var{function} are ignored and thrown away rather -than being collected into a list. The return value of @code{mapc} -is @var{seq}, the first sequence. -@end defun - -@defun mapl function list &rest more-lists -This function is like @code{maplist}, except that it throws away -the values returned by @var{function}. -@end defun - -@defun mapcan function seq &rest more-seqs -This function is like @code{mapcar*}, except that it concatenates -the return values (which must be lists) using @code{nconc}, -rather than simply collecting them into a list. -@end defun - -@defun mapcon function list &rest more-lists -This function is like @code{maplist}, except that it concatenates -the return values using @code{nconc}. -@end defun - -@defun some predicate seq &rest more-seqs -This function calls @var{predicate} on each element of @var{seq} -in turn; if @var{predicate} returns a non-@code{nil} value, -@code{some} returns that value, otherwise it returns @code{nil}. -Given several sequence arguments, it steps through the sequences -in parallel until the shortest one runs out, just as in -@code{mapcar*}. You can rely on the left-to-right order in which -the elements are visited, and on the fact that mapping stops -immediately as soon as @var{predicate} returns non-@code{nil}. -@end defun - -@defun every predicate seq &rest more-seqs -This function calls @var{predicate} on each element of the sequence(s) -in turn; it returns @code{nil} as soon as @var{predicate} returns -@code{nil} for any element, or @code{t} if the predicate was true -for all elements. -@end defun - -@defun notany predicate seq &rest more-seqs -This function calls @var{predicate} on each element of the sequence(s) -in turn; it returns @code{nil} as soon as @var{predicate} returns -a non-@code{nil} value for any element, or @code{t} if the predicate -was @code{nil} for all elements. -@end defun - -@defun notevery predicate seq &rest more-seqs -This function calls @var{predicate} on each element of the sequence(s) -in turn; it returns a non-@code{nil} value as soon as @var{predicate} -returns @code{nil} for any element, or @code{t} if the predicate was -true for all elements. -@end defun - -@defun reduce function seq @t{&key :from-end :start :end :initial-value :key} -This function combines the elements of @var{seq} using an associative -binary operation. Suppose @var{function} is @code{*} and @var{seq} is -the list @code{(2 3 4 5)}. The first two elements of the list are -combined with @code{(* 2 3) = 6}; this is combined with the next -element, @code{(* 6 4) = 24}, and that is combined with the final -element: @code{(* 24 5) = 120}. Note that the @code{*} function happens -to be self-reducing, so that @code{(* 2 3 4 5)} has the same effect as -an explicit call to @code{reduce}. - -If @code{:from-end} is true, the reduction is right-associative instead -of left-associative: - -@example -(reduce '- '(1 2 3 4)) - @equiv{} (- (- (- 1 2) 3) 4) @result{} -8 -(reduce '- '(1 2 3 4) :from-end t) - @equiv{} (- 1 (- 2 (- 3 4))) @result{} -2 -@end example - -If @code{:key} is specified, it is a function of one argument which -is called on each of the sequence elements in turn. - -If @code{:initial-value} is specified, it is effectively added to the -front (or rear in the case of @code{:from-end}) of the sequence. -The @code{:key} function is @emph{not} applied to the initial value. - -If the sequence, including the initial value, has exactly one element -then that element is returned without ever calling @var{function}. -If the sequence is empty (and there is no initial value), then -@var{function} is called with no arguments to obtain the return value. -@end defun - -All of these mapping operations can be expressed conveniently in -terms of the @code{loop} macro. In compiled code, @code{loop} will -be faster since it generates the loop as in-line code with no -function calls. - -@node Sequence Functions, Searching Sequences, Mapping over Sequences, Sequences -@section Sequence Functions - -@noindent -This section describes a number of Common Lisp functions for -operating on sequences. - -@defun subseq sequence start &optional end -This function returns a given subsequence of the argument -@var{sequence}, which may be a list, string, or vector. -The indices @var{start} and @var{end} must be in range, and -@var{start} must be no greater than @var{end}. If @var{end} -is omitted, it defaults to the length of the sequence. The -return value is always a copy; it does not share structure -with @var{sequence}. - -As an extension to Common Lisp, @var{start} and/or @var{end} -may be negative, in which case they represent a distance back -from the end of the sequence. This is for compatibility with -Emacs' @code{substring} function. Note that @code{subseq} is -the @emph{only} sequence function that allows negative -@var{start} and @var{end}. - -You can use @code{setf} on a @code{subseq} form to replace a -specified range of elements with elements from another sequence. -The replacement is done as if by @code{replace}, described below. -@end defun - -@defun concatenate result-type &rest seqs -This function concatenates the argument sequences together to -form a result sequence of type @var{result-type}, one of the -symbols @code{vector}, @code{string}, or @code{list}. The -arguments are always copied, even in cases such as -@code{(concatenate 'list '(1 2 3))} where the result is -identical to an argument. -@end defun - -@defun fill seq item @t{&key :start :end} -This function fills the elements of the sequence (or the specified -part of the sequence) with the value @var{item}. -@end defun - -@defun replace seq1 seq2 @t{&key :start1 :end1 :start2 :end2} -This function copies part of @var{seq2} into part of @var{seq1}. -The sequence @var{seq1} is not stretched or resized; the amount -of data copied is simply the shorter of the source and destination -(sub)sequences. The function returns @var{seq1}. - -If @var{seq1} and @var{seq2} are @code{eq}, then the replacement -will work correctly even if the regions indicated by the start -and end arguments overlap. However, if @var{seq1} and @var{seq2} -are lists which share storage but are not @code{eq}, and the -start and end arguments specify overlapping regions, the effect -is undefined. -@end defun - -@defun remove* item seq @t{&key :test :test-not :key :count :start :end :from-end} -This returns a copy of @var{seq} with all elements matching -@var{item} removed. The result may share storage with or be -@code{eq} to @var{seq} in some circumstances, but the original -@var{seq} will not be modified. The @code{:test}, @code{:test-not}, -and @code{:key} arguments define the matching test that is used; -by default, elements @code{eql} to @var{item} are removed. The -@code{:count} argument specifies the maximum number of matching -elements that can be removed (only the leftmost @var{count} matches -are removed). The @code{:start} and @code{:end} arguments specify -a region in @var{seq} in which elements will be removed; elements -outside that region are not matched or removed. The @code{:from-end} -argument, if true, says that elements should be deleted from the -end of the sequence rather than the beginning (this matters only -if @var{count} was also specified). -@end defun - -@defun delete* item seq @t{&key :test :test-not :key :count :start :end :from-end} -This deletes all elements of @var{seq} which match @var{item}. -It is a destructive operation. Since Emacs Lisp does not support -stretchable strings or vectors, this is the same as @code{remove*} -for those sequence types. On lists, @code{remove*} will copy the -list if necessary to preserve the original list, whereas -@code{delete*} will splice out parts of the argument list. -Compare @code{append} and @code{nconc}, which are analogous -non-destructive and destructive list operations in Emacs Lisp. -@end defun - -@findex remove-if -@findex remove-if-not -@findex delete-if -@findex delete-if-not -The predicate-oriented functions @code{remove-if}, @code{remove-if-not}, -@code{delete-if}, and @code{delete-if-not} are defined similarly. - -@defun delete item list -This MacLisp-compatible function deletes from @var{list} all elements -which are @code{equal} to @var{item}. The @code{delete} function is -built-in to Emacs 19; this package defines it equivalently in Emacs 18. -@end defun - -@defun remove item list -This function removes from @var{list} all elements which are -@code{equal} to @var{item}. This package defines it for symmetry -with @code{delete}, even though @code{remove} is not built-in to -Emacs 19. -@end defun - -@defun remq item list -This function removes from @var{list} all elements which are -@code{eq} to @var{item}. This package defines it for symmetry -with @code{delq}, even though @code{remq} is not built-in to -Emacs 19. -@end defun - -@defun remove-duplicates seq @t{&key :test :test-not :key :start :end :from-end} -This function returns a copy of @var{seq} with duplicate elements -removed. Specifically, if two elements from the sequence match -according to the @code{:test}, @code{:test-not}, and @code{:key} -arguments, only the rightmost one is retained. If @code{:from-end} -is true, the leftmost one is retained instead. If @code{:start} or -@code{:end} is specified, only elements within that subsequence are -examined or removed. -@end defun - -@defun delete-duplicates seq @t{&key :test :test-not :key :start :end :from-end} -This function deletes duplicate elements from @var{seq}. It is -a destructive version of @code{remove-duplicates}. -@end defun - -@defun substitute new old seq @t{&key :test :test-not :key :count :start :end :from-end} -This function returns a copy of @var{seq}, with all elements -matching @var{old} replaced with @var{new}. The @code{:count}, -@code{:start}, @code{:end}, and @code{:from-end} arguments may be -used to limit the number of substitutions made. -@end defun - -@defun nsubstitute new old seq @t{&key :test :test-not :key :count :start :end :from-end} -This is a destructive version of @code{substitute}; it performs -the substitution using @code{setcar} or @code{aset} rather than -by returning a changed copy of the sequence. -@end defun - -@findex substitute-if -@findex substitute-if-not -@findex nsubstitute-if -@findex nsubstitute-if-not -The @code{substitute-if}, @code{substitute-if-not}, @code{nsubstitute-if}, -and @code{nsubstitute-if-not} functions are defined similarly. For -these, a @var{predicate} is given in place of the @var{old} argument. - -@node Searching Sequences, Sorting Sequences, Sequence Functions, Sequences -@section Searching Sequences - -@noindent -These functions search for elements or subsequences in a sequence. -(See also @code{member*} and @code{assoc*}; @pxref{Lists}.) - -@defun find item seq @t{&key :test :test-not :key :start :end :from-end} -This function searches @var{seq} for an element matching @var{item}. -If it finds a match, it returns the matching element. Otherwise, -it returns @code{nil}. It returns the leftmost match, unless -@code{:from-end} is true, in which case it returns the rightmost -match. The @code{:start} and @code{:end} arguments may be used to -limit the range of elements that are searched. -@end defun - -@defun position item seq @t{&key :test :test-not :key :start :end :from-end} -This function is like @code{find}, except that it returns the -integer position in the sequence of the matching item rather than -the item itself. The position is relative to the start of the -sequence as a whole, even if @code{:start} is non-zero. The function -returns @code{nil} if no matching element was found. -@end defun - -@defun count item seq @t{&key :test :test-not :key :start :end} -This function returns the number of elements of @var{seq} which -match @var{item}. The result is always a nonnegative integer. -@end defun - -@findex find-if -@findex find-if-not -@findex position-if -@findex position-if-not -@findex count-if -@findex count-if-not -The @code{find-if}, @code{find-if-not}, @code{position-if}, -@code{position-if-not}, @code{count-if}, and @code{count-if-not} -functions are defined similarly. - -@defun mismatch seq1 seq2 @t{&key :test :test-not :key :start1 :end1 :start2 :end2 :from-end} -This function compares the specified parts of @var{seq1} and -@var{seq2}. If they are the same length and the corresponding -elements match (according to @code{:test}, @code{:test-not}, -and @code{:key}), the function returns @code{nil}. If there is -a mismatch, the function returns the index (relative to @var{seq1}) -of the first mismatching element. This will be the leftmost pair of -elements which do not match, or the position at which the shorter of -the two otherwise-matching sequences runs out. - -If @code{:from-end} is true, then the elements are compared from right -to left starting at @code{(1- @var{end1})} and @code{(1- @var{end2})}. -If the sequences differ, then one plus the index of the rightmost -difference (relative to @var{seq1}) is returned. - -An interesting example is @code{(mismatch str1 str2 :key 'upcase)}, -which compares two strings case-insensitively. -@end defun - -@defun search seq1 seq2 @t{&key :test :test-not :key :from-end :start1 :end1 :start2 :end2} -This function searches @var{seq2} for a subsequence that matches -@var{seq1} (or part of it specified by @code{:start1} and -@code{:end1}.) Only matches which fall entirely within the region -defined by @code{:start2} and @code{:end2} will be considered. -The return value is the index of the leftmost element of the -leftmost match, relative to the start of @var{seq2}, or @code{nil} -if no matches were found. If @code{:from-end} is true, the -function finds the @emph{rightmost} matching subsequence. -@end defun - -@node Sorting Sequences, , Searching Sequences, Sequences -@section Sorting Sequences - -@defun sort* seq predicate @t{&key :key} -This function sorts @var{seq} into increasing order as determined -by using @var{predicate} to compare pairs of elements. @var{predicate} -should return true (non-@code{nil}) if and only if its first argument -is less than (not equal to) its second argument. For example, -@code{<} and @code{string-lessp} are suitable predicate functions -for sorting numbers and strings, respectively; @code{>} would sort -numbers into decreasing rather than increasing order. - -This function differs from Emacs' built-in @code{sort} in that it -can operate on any type of sequence, not just lists. Also, it -accepts a @code{:key} argument which is used to preprocess data -fed to the @var{predicate} function. For example, - -@example -(setq data (sort data 'string-lessp :key 'downcase)) -@end example - -@noindent -sorts @var{data}, a sequence of strings, into increasing alphabetical -order without regard to case. A @code{:key} function of @code{car} -would be useful for sorting association lists. - -The @code{sort*} function is destructive; it sorts lists by actually -rearranging the @code{cdr} pointers in suitable fashion. -@end defun - -@defun stable-sort seq predicate @t{&key :key} -This function sorts @var{seq} @dfn{stably}, meaning two elements -which are equal in terms of @var{predicate} are guaranteed not to -be rearranged out of their original order by the sort. - -In practice, @code{sort*} and @code{stable-sort} are equivalent -in Emacs Lisp because the underlying @code{sort} function is -stable by default. However, this package reserves the right to -use non-stable methods for @code{sort*} in the future. -@end defun - -@defun merge type seq1 seq2 predicate @t{&key :key} -This function merges two sequences @var{seq1} and @var{seq2} by -interleaving their elements. The result sequence, of type @var{type} -(in the sense of @code{concatenate}), has length equal to the sum -of the lengths of the two input sequences. The sequences may be -modified destructively. Order of elements within @var{seq1} and -@var{seq2} is preserved in the interleaving; elements of the two -sequences are compared by @var{predicate} (in the sense of -@code{sort}) and the lesser element goes first in the result. -When elements are equal, those from @var{seq1} precede those from -@var{seq2} in the result. Thus, if @var{seq1} and @var{seq2} are -both sorted according to @var{predicate}, then the result will be -a merged sequence which is (stably) sorted according to -@var{predicate}. -@end defun - -@node Lists, Hash Tables, Sequences, Top -@chapter Lists - -@noindent -The functions described here operate on lists. - -@menu -* List Functions:: `caddr', `first', `last', `list*', etc. -* Substitution of Expressions:: `subst', `sublis', etc. -* Lists as Sets:: `member*', `adjoin', `union', etc. -* Association Lists:: `assoc*', `rassoc*', `acons', `pairlis' -@end menu - -@node List Functions, Substitution of Expressions, Lists, Lists -@section List Functions - -@noindent -This section describes a number of simple operations on lists, -i.e., chains of cons cells. - -@defun caddr x -This function is equivalent to @code{(car (cdr (cdr @var{x})))}. -Likewise, this package defines all 28 @code{c@var{xxx}r} functions -where @var{xxx} is up to four @samp{a}s and/or @samp{d}s. -All of these functions are @code{setf}-able, and calls to them -are expanded inline by the byte-compiler for maximum efficiency. -@end defun - -@defun first x -This function is a synonym for @code{(car @var{x})}. Likewise, -the functions @code{second}, @code{third}, @dots{}, through -@code{tenth} return the given element of the list @var{x}. -@end defun - -@defun rest x -This function is a synonym for @code{(cdr @var{x})}. -@end defun - -@defun endp x -Common Lisp defines this function to act like @code{null}, but -signalling an error if @code{x} is neither a @code{nil} nor a -cons cell. This package simply defines @code{endp} as a synonym -for @code{null}. -@end defun - -@defun list-length x -This function returns the length of list @var{x}, exactly like -@code{(length @var{x})}, except that if @var{x} is a circular -list (where the cdr-chain forms a loop rather than terminating -with @code{nil}), this function returns @code{nil}. (The regular -@code{length} function would get stuck if given a circular list.) -@end defun - -@defun last x &optional n -This function returns the last cons, or the @var{n}th-to-last cons, -of the list @var{x}. If @var{n} is omitted it defaults to 1. -The ``last cons'' means the first cons cell of the list whose -@code{cdr} is not another cons cell. (For normal lists, the -@code{cdr} of the last cons will be @code{nil}.) This function -returns @code{nil} if @var{x} is @code{nil} or shorter than -@var{n}. Note that the last @emph{element} of the list is -@code{(car (last @var{x}))}. -@end defun - -@defun butlast x &optional n -This function returns the list @var{x} with the last element, -or the last @var{n} elements, removed. If @var{n} is greater -than zero it makes a copy of the list so as not to damage the -original list. In general, @code{(append (butlast @var{x} @var{n}) -(last @var{x} @var{n}))} will return a list equal to @var{x}. -@end defun - -@defun nbutlast x &optional n -This is a version of @code{butlast} that works by destructively -modifying the @code{cdr} of the appropriate element, rather than -making a copy of the list. -@end defun - -@defun list* arg &rest others -This function constructs a list of its arguments. The final -argument becomes the @code{cdr} of the last cell constructed. -Thus, @code{(list* @var{a} @var{b} @var{c})} is equivalent to -@code{(cons @var{a} (cons @var{b} @var{c}))}, and -@code{(list* @var{a} @var{b} nil)} is equivalent to -@code{(list @var{a} @var{b})}. - -(Note that this function really is called @code{list*} in Common -Lisp; it is not a name invented for this package like @code{member*} -or @code{defun*}.) -@end defun - -@defun ldiff list sublist -If @var{sublist} is a sublist of @var{list}, i.e., is @code{eq} to -one of the cons cells of @var{list}, then this function returns -a copy of the part of @var{list} up to but not including -@var{sublist}. For example, @code{(ldiff x (cddr x))} returns -the first two elements of the list @code{x}. The result is a -copy; the original @var{list} is not modified. If @var{sublist} -is not a sublist of @var{list}, a copy of the entire @var{list} -is returned. -@end defun - -@defun copy-list list -This function returns a copy of the list @var{list}. It copies -dotted lists like @code{(1 2 . 3)} correctly. -@end defun - -@defun copy-tree x &optional vecp -This function returns a copy of the tree of cons cells @var{x}. -Unlike @code{copy-sequence} (and its alias @code{copy-list}), -which copies only along the @code{cdr} direction, this function -copies (recursively) along both the @code{car} and the @code{cdr} -directions. If @var{x} is not a cons cell, the function simply -returns @var{x} unchanged. If the optional @var{vecp} argument -is true, this function copies vectors (recursively) as well as -cons cells. -@end defun - -@defun tree-equal x y @t{&key :test :test-not :key} -This function compares two trees of cons cells. If @var{x} and -@var{y} are both cons cells, their @code{car}s and @code{cdr}s are -compared recursively. If neither @var{x} nor @var{y} is a cons -cell, they are compared by @code{eql}, or according to the -specified test. The @code{:key} function, if specified, is -applied to the elements of both trees. @xref{Sequences}. -@end defun - -@iftex -@secno=3 -@end iftex - -@node Substitution of Expressions, Lists as Sets, List Functions, Lists -@section Substitution of Expressions - -@noindent -These functions substitute elements throughout a tree of cons -cells. (@xref{Sequence Functions}, for the @code{substitute} -function, which works on just the top-level elements of a list.) - -@defun subst new old tree @t{&key :test :test-not :key} -This function substitutes occurrences of @var{old} with @var{new} -in @var{tree}, a tree of cons cells. It returns a substituted -tree, which will be a copy except that it may share storage with -the argument @var{tree} in parts where no substitutions occurred. -The original @var{tree} is not modified. This function recurses -on, and compares against @var{old}, both @code{car}s and @code{cdr}s -of the component cons cells. If @var{old} is itself a cons cell, -then matching cells in the tree are substituted as usual without -recursively substituting in that cell. Comparisons with @var{old} -are done according to the specified test (@code{eql} by default). -The @code{:key} function is applied to the elements of the tree -but not to @var{old}. -@end defun - -@defun nsubst new old tree @t{&key :test :test-not :key} -This function is like @code{subst}, except that it works by -destructive modification (by @code{setcar} or @code{setcdr}) -rather than copying. -@end defun - -@findex subst-if -@findex subst-if-not -@findex nsubst-if -@findex nsubst-if-not -The @code{subst-if}, @code{subst-if-not}, @code{nsubst-if}, and -@code{nsubst-if-not} functions are defined similarly. - -@defun sublis alist tree @t{&key :test :test-not :key} -This function is like @code{subst}, except that it takes an -association list @var{alist} of @var{old}-@var{new} pairs. -Each element of the tree (after applying the @code{:key} -function, if any), is compared with the @code{car}s of -@var{alist}; if it matches, it is replaced by the corresponding -@code{cdr}. -@end defun - -@defun nsublis alist tree @t{&key :test :test-not :key} -This is a destructive version of @code{sublis}. -@end defun - -@node Lists as Sets, Association Lists, Substitution of Expressions, Lists -@section Lists as Sets - -@noindent -These functions perform operations on lists which represent sets -of elements. - -@defun member item list -This MacLisp-compatible function searches @var{list} for an element -which is @code{equal} to @var{item}. The @code{member} function is -built-in to Emacs 19; this package defines it equivalently in Emacs 18. -See the following function for a Common-Lisp compatible version. -@end defun - -@defun member* item list @t{&key :test :test-not :key} -This function searches @var{list} for an element matching @var{item}. -If a match is found, it returns the cons cell whose @code{car} was -the matching element. Otherwise, it returns @code{nil}. Elements -are compared by @code{eql} by default; you can use the @code{:test}, -@code{:test-not}, and @code{:key} arguments to modify this behavior. -@xref{Sequences}. - -Note that this function's name is suffixed by @samp{*} to avoid -the incompatible @code{member} function defined in Emacs 19. -(That function uses @code{equal} for comparisons; it is equivalent -to @code{(member* @var{item} @var{list} :test 'equal)}.) -@end defun - -@findex member-if -@findex member-if-not -The @code{member-if} and @code{member-if-not} functions -analogously search for elements which satisfy a given predicate. - -@defun tailp sublist list -This function returns @code{t} if @var{sublist} is a sublist of -@var{list}, i.e., if @var{sublist} is @code{eql} to @var{list} or to -any of its @code{cdr}s. -@end defun - -@defun adjoin item list @t{&key :test :test-not :key} -This function conses @var{item} onto the front of @var{list}, -like @code{(cons @var{item} @var{list})}, but only if @var{item} -is not already present on the list (as determined by @code{member*}). -If a @code{:key} argument is specified, it is applied to -@var{item} as well as to the elements of @var{list} during -the search, on the reasoning that @var{item} is ``about'' to -become part of the list. -@end defun - -@defun union list1 list2 @t{&key :test :test-not :key} -This function combines two lists which represent sets of items, -returning a list that represents the union of those two sets. -The result list will contain all items which appear in @var{list1} -or @var{list2}, and no others. If an item appears in both -@var{list1} and @var{list2} it will be copied only once. If -an item is duplicated in @var{list1} or @var{list2}, it is -undefined whether or not that duplication will survive in the -result list. The order of elements in the result list is also -undefined. -@end defun - -@defun nunion list1 list2 @t{&key :test :test-not :key} -This is a destructive version of @code{union}; rather than copying, -it tries to reuse the storage of the argument lists if possible. -@end defun - -@defun intersection list1 list2 @t{&key :test :test-not :key} -This function computes the intersection of the sets represented -by @var{list1} and @var{list2}. It returns the list of items -which appear in both @var{list1} and @var{list2}. -@end defun - -@defun nintersection list1 list2 @t{&key :test :test-not :key} -This is a destructive version of @code{intersection}. It -tries to reuse storage of @var{list1} rather than copying. -It does @emph{not} reuse the storage of @var{list2}. -@end defun - -@defun set-difference list1 list2 @t{&key :test :test-not :key} -This function computes the ``set difference'' of @var{list1} -and @var{list2}, i.e., the set of elements that appear in -@var{list1} but @emph{not} in @var{list2}. -@end defun - -@defun nset-difference list1 list2 @t{&key :test :test-not :key} -This is a destructive @code{set-difference}, which will try -to reuse @var{list1} if possible. -@end defun - -@defun set-exclusive-or list1 list2 @t{&key :test :test-not :key} -This function computes the ``set exclusive or'' of @var{list1} -and @var{list2}, i.e., the set of elements that appear in -exactly one of @var{list1} and @var{list2}. -@end defun - -@defun nset-exclusive-or list1 list2 @t{&key :test :test-not :key} -This is a destructive @code{set-exclusive-or}, which will try -to reuse @var{list1} and @var{list2} if possible. -@end defun - -@defun subsetp list1 list2 @t{&key :test :test-not :key} -This function checks whether @var{list1} represents a subset -of @var{list2}, i.e., whether every element of @var{list1} -also appears in @var{list2}. -@end defun - -@node Association Lists, , Lists as Sets, Lists -@section Association Lists - -@noindent -An @dfn{association list} is a list representing a mapping from -one set of values to another; any list whose elements are cons -cells is an association list. - -@defun assoc* item a-list @t{&key :test :test-not :key} -This function searches the association list @var{a-list} for an -element whose @code{car} matches (in the sense of @code{:test}, -@code{:test-not}, and @code{:key}, or by comparison with @code{eql}) -a given @var{item}. It returns the matching element, if any, -otherwise @code{nil}. It ignores elements of @var{a-list} which -are not cons cells. (This corresponds to the behavior of -@code{assq} and @code{assoc} in Emacs Lisp; Common Lisp's -@code{assoc} ignores @code{nil}s but considers any other non-cons -elements of @var{a-list} to be an error.) -@end defun - -@defun rassoc* item a-list @t{&key :test :test-not :key} -This function searches for an element whose @code{cdr} matches -@var{item}. If @var{a-list} represents a mapping, this applies -the inverse of the mapping to @var{item}. -@end defun - -@defun rassoc item a-list -This function searches like @code{rassoc*} with a @code{:test} -argument of @code{equal}. It is analogous to Emacs Lisp's -standard @code{assoc} function, which derives from the MacLisp -rather than the Common Lisp tradition. -@end defun - -@findex assoc-if -@findex assoc-if-not -@findex rassoc-if -@findex rassoc-if-not -The @code{assoc-if}, @code{assoc-if-not}, @code{rassoc-if}, -and @code{rassoc-if-not} functions are defined similarly. - -Two simple functions for constructing association lists are: - -@defun acons key value alist -This is equivalent to @code{(cons (cons @var{key} @var{value}) @var{alist})}. -@end defun - -@defun pairlis keys values &optional alist -This is equivalent to @code{(nconc (mapcar* 'cons @var{keys} @var{values}) -@var{alist})}. -@end defun - -@node Hash Tables, Structures, Lists, Top -@chapter Hash Tables - -@noindent -Hash tables are now implemented directly in the C code and documented in -@ref{Hash Tables,,, lispref, XEmacs Lisp Programmer's Manual}. - -@ignore -A @dfn{hash table} is a data structure that maps ``keys'' onto -``values.'' Keys and values can be arbitrary Lisp data objects. -Hash tables have the property that the time to search for a given -key is roughly constant; simpler data structures like association -lists take time proportional to the number of entries in the list. - -@defun make-hash-table @t{&key :test :size} -This function creates and returns a hash-table object whose -function for comparing elements is @code{:test} (@code{eql} -by default), and which is allocated to fit about @code{:size} -elements. The @code{:size} argument is purely advisory; the -table will stretch automatically if you store more elements in -it. If @code{:size} is omitted, a reasonable default is used. - -Common Lisp allows only @code{eq}, @code{eql}, @code{equal}, -and @code{equalp} as legal values for the @code{:test} argument. -In this package, any reasonable predicate function will work, -though if you use something else you should check the details of -the hashing function described below to make sure it is suitable -for your predicate. - -Some versions of Emacs (like XEmacs) include a built-in hash -table type; in these versions, @code{make-hash-table} with a test of -@code{eq}, @code{eql}, or @code{equal} will use these built-in hash -tables. In all other cases, it will return a hash-table object which -takes the form of a list with an identifying ``tag'' symbol at the -front. All of the hash table functions in this package can operate on -both types of hash table; normally you will never know which type is -being used. - -This function accepts the additional Common Lisp keywords -@code{:rehash-size} and @code{:rehash-threshold}, but it ignores -their values. -@end defun - -@defun gethash key table &optional default -This function looks up @var{key} in @var{table}. If @var{key} -exists in the table, in the sense that it matches any of the existing -keys according to the table's test function, then the associated value -is returned. Otherwise, @var{default} (or @code{nil}) is returned. - -To store new data in the hash table, use @code{setf} on a call to -@code{gethash}. If @var{key} already exists in the table, the -corresponding value is changed to the stored value. If @var{key} -does not already exist, a new entry is added to the table and the -table is reallocated to a larger size if necessary. The @var{default} -argument is allowed but ignored in this case. The situation is -exactly analogous to that of @code{get*}; @pxref{Property Lists}. -@end defun - -@defun remhash key table -This function removes the entry for @var{key} from @var{table}. -If an entry was removed, it returns @code{t}. If @var{key} does -not appear in the table, it does nothing and returns @code{nil}. -@end defun - -@defun clrhash table -This function removes all the entries from @var{table}, leaving -an empty hash table. -@end defun - -@defun maphash function table -This function calls @var{function} for each entry in @var{table}. -It passes two arguments to @var{function}, the key and the value -of the given entry. The return value of @var{function} is ignored; -@var{maphash} itself returns @code{nil}. @xref{Loop Facility}, for -an alternate way of iterating over hash tables. -@end defun - -@defun hash-table-count table This function returns the number of -entries in @var{table}. @strong{Warning:} The current implementation of -XEmacs hash-tables does not decrement the stored @code{count} -when @code{remhash} removes an entry. Therefore, the return value of -this function is not dependable if you have used @code{remhash} on the -table and the table's test is @code{eq}, @code{eql}, or @code{equal}. -A slower, but reliable, way to count the entries is -@code{(loop for x being the hash-keys of @var{table} count t)}. -@end defun - -@defun hash-table-p object This function returns @code{t} if -@var{object} is a hash table, @code{nil} otherwise. It recognizes both -types of hash tables (both XEmacs built-in tables and tables implemented -with special lists.) -@end defun - -Sometimes when dealing with hash tables it is useful to know the -exact ``hash function'' that is used. This package implements -hash tables using Emacs Lisp ``obarrays,'' which are the same -data structure that Emacs Lisp uses to keep track of symbols. -Each hash table includes an embedded obarray. Key values given -to @code{gethash} are converted by various means into strings, -which are then looked up in the obarray using @code{intern} and -@code{intern-soft}. The symbol, or ``bucket,'' corresponding to -a given key string includes as its @code{symbol-value} an association -list of all key-value pairs which hash to that string. Depending -on the test function, it is possible for many entries to hash to -the same bucket. For example, if the test is @code{eql}, then the -symbol @code{foo} and two separately built strings @code{"foo"} will -create three entries in the same bucket. Search time is linear -within buckets, so hash tables will be most effective if you arrange -not to store too many things that hash the same. - -The following algorithm is used to convert Lisp objects to hash -strings: - -@itemize @bullet -@item -Strings are used directly as hash strings. (However, if the test -function is @code{equalp}, strings are @code{downcase}d first.) - -@item -Symbols are hashed according to their @code{symbol-name}. - -@item -Integers are hashed into one of 16 buckets depending on their value -modulo 16. Floating-point numbers are truncated to integers and -hashed modulo 16. - -@item -Cons cells are hashed according to their @code{car}s; nonempty vectors -are hashed according to their first element. - -@item -All other types of objects hash into a single bucket named @code{"*"}. -@end itemize - -@noindent -Thus, for example, searching among many buffer objects in a hash table -will devolve to a (still fairly fast) linear-time search through a -single bucket, whereas searching for different symbols will be very -fast since each symbol will, in general, hash into its own bucket. - -The size of the obarray in a hash table is automatically adjusted -as the number of elements increases. - -As a special case, @code{make-hash-table} with a @code{:size} argument -of 0 or 1 will create a hash-table object that uses a single association -list rather than an obarray of many lists. For very small tables this -structure will be more efficient since lookup does not require -converting the key to a string or looking it up in an obarray. -However, such tables are guaranteed to take time proportional to -their size to do a search. -@end ignore - -@iftex -@chapno=18 -@end iftex - -@node Structures, Assertions, Hash Tables, Top -@chapter Structures - -@noindent -The Common Lisp @dfn{structure} mechanism provides a general way -to define data types similar to C's @code{struct} types. A -structure is a Lisp object containing some number of @dfn{slots}, -each of which can hold any Lisp data object. Functions are -provided for accessing and setting the slots, creating or copying -structure objects, and recognizing objects of a particular structure -type. - -In true Common Lisp, each structure type is a new type distinct -from all existing Lisp types. Since the underlying Emacs Lisp -system provides no way to create new distinct types, this package -implements structures as vectors (or lists upon request) with a -special ``tag'' symbol to identify them. - -@defspec defstruct name slots@dots{} -The @code{defstruct} form defines a new structure type called -@var{name}, with the specified @var{slots}. (The @var{slots} -may begin with a string which documents the structure type.) -In the simplest case, @var{name} and each of the @var{slots} -are symbols. For example, - -@example -(defstruct person name age sex) -@end example - -@noindent -defines a struct type called @code{person} which contains three -slots. Given a @code{person} object @var{p}, you can access those -slots by calling @code{(person-name @var{p})}, @code{(person-age @var{p})}, -and @code{(person-sex @var{p})}. You can also change these slots by -using @code{setf} on any of these place forms: - -@example -(incf (person-age birthday-boy)) -@end example - -You can create a new @code{person} by calling @code{make-person}, -which takes keyword arguments @code{:name}, @code{:age}, and -@code{:sex} to specify the initial values of these slots in the -new object. (Omitting any of these arguments leaves the corresponding -slot ``undefined,'' according to the Common Lisp standard; in Emacs -Lisp, such uninitialized slots are filled with @code{nil}.) - -Given a @code{person}, @code{(copy-person @var{p})} makes a new -object of the same type whose slots are @code{eq} to those of @var{p}. - -Given any Lisp object @var{x}, @code{(person-p @var{x})} returns -true if @var{x} looks like a @code{person}, false otherwise. (Again, -in Common Lisp this predicate would be exact; in Emacs Lisp the -best it can do is verify that @var{x} is a vector of the correct -length which starts with the correct tag symbol.) - -Accessors like @code{person-name} normally check their arguments -(effectively using @code{person-p}) and signal an error if the -argument is the wrong type. This check is affected by -@code{(optimize (safety @dots{}))} declarations. Safety level 1, -the default, uses a somewhat optimized check that will detect all -incorrect arguments, but may use an uninformative error message -(e.g., ``expected a vector'' instead of ``expected a @code{person}''). -Safety level 0 omits all checks except as provided by the underlying -@code{aref} call; safety levels 2 and 3 do rigorous checking that will -always print a descriptive error message for incorrect inputs. -@xref{Declarations}. - -@example -(setq dave (make-person :name "Dave" :sex 'male)) - @result{} [cl-struct-person "Dave" nil male] -(setq other (copy-person dave)) - @result{} [cl-struct-person "Dave" nil male] -(eq dave other) - @result{} nil -(eq (person-name dave) (person-name other)) - @result{} t -(person-p dave) - @result{} t -(person-p [1 2 3 4]) - @result{} nil -(person-p "Bogus") - @result{} nil -(person-p '[cl-struct-person counterfeit person object]) - @result{} t -@end example - -In general, @var{name} is either a name symbol or a list of a name -symbol followed by any number of @dfn{struct options}; each @var{slot} -is either a slot symbol or a list of the form @samp{(@var{slot-name} -@var{default-value} @var{slot-options}@dots{})}. The @var{default-value} -is a Lisp form which is evaluated any time an instance of the -structure type is created without specifying that slot's value. - -Common Lisp defines several slot options, but the only one -implemented in this package is @code{:read-only}. A non-@code{nil} -value for this option means the slot should not be @code{setf}-able; -the slot's value is determined when the object is created and does -not change afterward. - -@example -(defstruct person - (name nil :read-only t) - age - (sex 'unknown)) -@end example - -Any slot options other than @code{:read-only} are ignored. - -For obscure historical reasons, structure options take a different -form than slot options. A structure option is either a keyword -symbol, or a list beginning with a keyword symbol possibly followed -by arguments. (By contrast, slot options are key-value pairs not -enclosed in lists.) - -@example -(defstruct (person (:constructor create-person) - (:type list) - :named) - name age sex) -@end example - -The following structure options are recognized. - -@table @code -@iftex -@itemmax=0 in -@advance@leftskip-.5@tableindent -@end iftex -@item :conc-name -The argument is a symbol whose print name is used as the prefix for -the names of slot accessor functions. The default is the name of -the struct type followed by a hyphen. The option @code{(:conc-name p-)} -would change this prefix to @code{p-}. Specifying @code{nil} as an -argument means no prefix, so that the slot names themselves are used -to name the accessor functions. - -@item :constructor -In the simple case, this option takes one argument which is an -alternate name to use for the constructor function. The default -is @code{make-@var{name}}, e.g., @code{make-person}. The above -example changes this to @code{create-person}. Specifying @code{nil} -as an argument means that no standard constructor should be -generated at all. - -In the full form of this option, the constructor name is followed -by an arbitrary argument list. @xref{Program Structure}, for a -description of the format of Common Lisp argument lists. All -options, such as @code{&rest} and @code{&key}, are supported. -The argument names should match the slot names; each slot is -initialized from the corresponding argument. Slots whose names -do not appear in the argument list are initialized based on the -@var{default-value} in their slot descriptor. Also, @code{&optional} -and @code{&key} arguments which don't specify defaults take their -defaults from the slot descriptor. It is legal to include arguments -which don't correspond to slot names; these are useful if they are -referred to in the defaults for optional, keyword, or @code{&aux} -arguments which @emph{do} correspond to slots. - -You can specify any number of full-format @code{:constructor} -options on a structure. The default constructor is still generated -as well unless you disable it with a simple-format @code{:constructor} -option. - -@example -(defstruct - (person - (:constructor nil) ; no default constructor - (:constructor new-person (name sex &optional (age 0))) - (:constructor new-hound (&key (name "Rover") - (dog-years 0) - &aux (age (* 7 dog-years)) - (sex 'canine)))) - name age sex) -@end example - -The first constructor here takes its arguments positionally rather -than by keyword. (In official Common Lisp terminology, constructors -that work By Order of Arguments instead of by keyword are called -``BOA constructors.'' No, I'm not making this up.) For example, -@code{(new-person "Jane" 'female)} generates a person whose slots -are @code{"Jane"}, 0, and @code{female}, respectively. - -The second constructor takes two keyword arguments, @code{:name}, -which initializes the @code{name} slot and defaults to @code{"Rover"}, -and @code{:dog-years}, which does not itself correspond to a slot -but which is used to initialize the @code{age} slot. The @code{sex} -slot is forced to the symbol @code{canine} with no syntax for -overriding it. - -@item :copier -The argument is an alternate name for the copier function for -this type. The default is @code{copy-@var{name}}. @code{nil} -means not to generate a copier function. (In this implementation, -all copier functions are simply synonyms for @code{copy-sequence}.) - -@item :predicate -The argument is an alternate name for the predicate which recognizes -objects of this type. The default is @code{@var{name}-p}. @code{nil} -means not to generate a predicate function. (If the @code{:type} -option is used without the @code{:named} option, no predicate is -ever generated.) - -In true Common Lisp, @code{typep} is always able to recognize a -structure object even if @code{:predicate} was used. In this -package, @code{typep} simply looks for a function called -@code{@var{typename}-p}, so it will work for structure types -only if they used the default predicate name. - -@item :include -This option implements a very limited form of C++-style inheritance. -The argument is the name of another structure type previously -created with @code{defstruct}. The effect is to cause the new -structure type to inherit all of the included structure's slots -(plus, of course, any new slots described by this struct's slot -descriptors). The new structure is considered a ``specialization'' -of the included one. In fact, the predicate and slot accessors -for the included type will also accept objects of the new type. - -If there are extra arguments to the @code{:include} option after -the included-structure name, these options are treated as replacement -slot descriptors for slots in the included structure, possibly with -modified default values. Borrowing an example from Steele: - -@example -(defstruct person name (age 0) sex) - @result{} person -(defstruct (astronaut (:include person (age 45))) - helmet-size - (favorite-beverage 'tang)) - @result{} astronaut - -(setq joe (make-person :name "Joe")) - @result{} [cl-struct-person "Joe" 0 nil] -(setq buzz (make-astronaut :name "Buzz")) - @result{} [cl-struct-astronaut "Buzz" 45 nil nil tang] - -(list (person-p joe) (person-p buzz)) - @result{} (t t) -(list (astronaut-p joe) (astronaut-p buzz)) - @result{} (nil t) - -(person-name buzz) - @result{} "Buzz" -(astronaut-name joe) - @result{} error: "astronaut-name accessing a non-astronaut" -@end example - -Thus, if @code{astronaut} is a specialization of @code{person}, -then every @code{astronaut} is also a @code{person} (but not the -other way around). Every @code{astronaut} includes all the slots -of a @code{person}, plus extra slots that are specific to -astronauts. Operations that work on people (like @code{person-name}) -work on astronauts just like other people. - -@item :print-function -In full Common Lisp, this option allows you to specify a function -which is called to print an instance of the structure type. The -Emacs Lisp system offers no hooks into the Lisp printer which would -allow for such a feature, so this package simply ignores -@code{:print-function}. - -@item :type -The argument should be one of the symbols @code{vector} or @code{list}. -This tells which underlying Lisp data type should be used to implement -the new structure type. Vectors are used by default, but -@code{(:type list)} will cause structure objects to be stored as -lists instead. - -The vector representation for structure objects has the advantage -that all structure slots can be accessed quickly, although creating -vectors is a bit slower in Emacs Lisp. Lists are easier to create, -but take a relatively long time accessing the later slots. - -@item :named -This option, which takes no arguments, causes a characteristic ``tag'' -symbol to be stored at the front of the structure object. Using -@code{:type} without also using @code{:named} will result in a -structure type stored as plain vectors or lists with no identifying -features. - -The default, if you don't specify @code{:type} explicitly, is to -use named vectors. Therefore, @code{:named} is only useful in -conjunction with @code{:type}. - -@example -(defstruct (person1) name age sex) -(defstruct (person2 (:type list) :named) name age sex) -(defstruct (person3 (:type list)) name age sex) - -(setq p1 (make-person1)) - @result{} [cl-struct-person1 nil nil nil] -(setq p2 (make-person2)) - @result{} (person2 nil nil nil) -(setq p3 (make-person3)) - @result{} (nil nil nil) - -(person1-p p1) - @result{} t -(person2-p p2) - @result{} t -(person3-p p3) - @result{} error: function person3-p undefined -@end example - -Since unnamed structures don't have tags, @code{defstruct} is not -able to make a useful predicate for recognizing them. Also, -accessors like @code{person3-name} will be generated but they -will not be able to do any type checking. The @code{person3-name} -function, for example, will simply be a synonym for @code{car} in -this case. By contrast, @code{person2-name} is able to verify -that its argument is indeed a @code{person2} object before -proceeding. - -@item :initial-offset -The argument must be a nonnegative integer. It specifies a -number of slots to be left ``empty'' at the front of the -structure. If the structure is named, the tag appears at the -specified position in the list or vector; otherwise, the first -slot appears at that position. Earlier positions are filled -with @code{nil} by the constructors and ignored otherwise. If -the type @code{:include}s another type, then @code{:initial-offset} -specifies a number of slots to be skipped between the last slot -of the included type and the first new slot. -@end table -@end defspec - -Except as noted, the @code{defstruct} facility of this package is -entirely compatible with that of Common Lisp. - -@iftex -@chapno=23 -@end iftex - -@node Assertions, Efficiency Concerns, Structures, Top -@chapter Assertions and Errors - -@noindent -This section describes two macros that test @dfn{assertions}, i.e., -conditions which must be true if the program is operating correctly. -Assertions never add to the behavior of a Lisp program; they simply -make ``sanity checks'' to make sure everything is as it should be. - -If the optimization property @code{speed} has been set to 3, and -@code{safety} is less than 3, then the byte-compiler will optimize -away the following assertions. Because assertions might be optimized -away, it is a bad idea for them to include side-effects. - -@defspec assert test-form [show-args string args@dots{}] -This form verifies that @var{test-form} is true (i.e., evaluates to -a non-@code{nil} value). If so, it returns @code{nil}. If the test -is not satisfied, @code{assert} signals an error. - -A default error message will be supplied which includes @var{test-form}. -You can specify a different error message by including a @var{string} -argument plus optional extra arguments. Those arguments are simply -passed to @code{error} to signal the error. - -If the optional second argument @var{show-args} is @code{t} instead -of @code{nil}, then the error message (with or without @var{string}) -will also include all non-constant arguments of the top-level -@var{form}. For example: - -@example -(assert (> x 10) t "x is too small: %d") -@end example - -This usage of @var{show-args} is an extension to Common Lisp. In -true Common Lisp, the second argument gives a list of @var{places} -which can be @code{setf}'d by the user before continuing from the -error. Since Emacs Lisp does not support continuable errors, it -makes no sense to specify @var{places}. -@end defspec - -@defspec check-type form type [string] -This form verifies that @var{form} evaluates to a value of type -@var{type}. If so, it returns @code{nil}. If not, @code{check-type} -signals a @code{wrong-type-argument} error. The default error message -lists the erroneous value along with @var{type} and @var{form} -themselves. If @var{string} is specified, it is included in the -error message in place of @var{type}. For example: - -@example -(check-type x (integer 1 *) "a positive integer") -@end example - -@xref{Type Predicates}, for a description of the type specifiers -that may be used for @var{type}. - -Note that in Common Lisp, the first argument to @code{check-type} -must be a @var{place} suitable for use by @code{setf}, because -@code{check-type} signals a continuable error that allows the -user to modify @var{place}. -@end defspec - -The following error-related macro is also defined: - -@defspec ignore-errors forms@dots{} -This executes @var{forms} exactly like a @code{progn}, except that -errors are ignored during the @var{forms}. More precisely, if -an error is signalled then @code{ignore-errors} immediately -aborts execution of the @var{forms} and returns @code{nil}. -If the @var{forms} complete successfully, @code{ignore-errors} -returns the result of the last @var{form}. -@end defspec - -@node Efficiency Concerns, Common Lisp Compatibility, Assertions, Top -@appendix Efficiency Concerns - -@appendixsec Macros - -@noindent -Many of the advanced features of this package, such as @code{defun*}, -@code{loop}, and @code{setf}, are implemented as Lisp macros. In -byte-compiled code, these complex notations will be expanded into -equivalent Lisp code which is simple and efficient. For example, -the forms - -@example -(incf i n) -(push x (car p)) -@end example - -@noindent -are expanded at compile-time to the Lisp forms - -@example -(setq i (+ i n)) -(setcar p (cons x (car p))) -@end example - -@noindent -which are the most efficient ways of doing these respective operations -in Lisp. Thus, there is no performance penalty for using the more -readable @code{incf} and @code{push} forms in your compiled code. - -@emph{Interpreted} code, on the other hand, must expand these macros -every time they are executed. For this reason it is strongly -recommended that code making heavy use of macros be compiled. -(The features labelled ``Special Form'' instead of ``Function'' in -this manual are macros.) A loop using @code{incf} a hundred times -will execute considerably faster if compiled, and will also -garbage-collect less because the macro expansion will not have -to be generated, used, and thrown away a hundred times. - -You can find out how a macro expands by using the -@code{cl-prettyexpand} function. - -@defun cl-prettyexpand form &optional full -This function takes a single Lisp form as an argument and inserts -a nicely formatted copy of it in the current buffer (which must be -in Lisp mode so that indentation works properly). It also expands -all Lisp macros which appear in the form. The easiest way to use -this function is to go to the @code{*scratch*} buffer and type, say, - -@example -(cl-prettyexpand '(loop for x below 10 collect x)) -@end example - -@noindent -and type @kbd{C-x C-e} immediately after the closing parenthesis; -the expansion - -@example -(block nil - (let* ((x 0) - (G1004 nil)) - (while (< x 10) - (setq G1004 (cons x G1004)) - (setq x (+ x 1))) - (nreverse G1004))) -@end example - -@noindent -will be inserted into the buffer. (The @code{block} macro is -expanded differently in the interpreter and compiler, so -@code{cl-prettyexpand} just leaves it alone. The temporary -variable @code{G1004} was created by @code{gensym}.) - -If the optional argument @var{full} is true, then @emph{all} -macros are expanded, including @code{block}, @code{eval-when}, -and compiler macros. Expansion is done as if @var{form} were -a top-level form in a file being compiled. For example, - -@example -(cl-prettyexpand '(pushnew 'x list)) - @print{} (setq list (adjoin 'x list)) -(cl-prettyexpand '(pushnew 'x list) t) - @print{} (setq list (if (memq 'x list) list (cons 'x list))) -(cl-prettyexpand '(caddr (member* 'a list)) t) - @print{} (car (cdr (cdr (memq 'a list)))) -@end example - -Note that @code{adjoin}, @code{caddr}, and @code{member*} all -have built-in compiler macros to optimize them in common cases. -@end defun - -@ifinfo -@example - -@end example -@end ifinfo -@appendixsec Error Checking - -@noindent -Common Lisp compliance has in general not been sacrificed for the -sake of efficiency. A few exceptions have been made for cases -where substantial gains were possible at the expense of marginal -incompatibility. One example is the use of @code{memq} (which is -treated very efficiently by the byte-compiler) to scan for keyword -arguments; this can become confused in rare cases when keyword -symbols are used as both keywords and data values at once. This -is extremely unlikely to occur in practical code, and the use of -@code{memq} allows functions with keyword arguments to be nearly -as fast as functions that use @code{&optional} arguments. - -The Common Lisp standard (as embodied in Steele's book) uses the -phrase ``it is an error if'' to indicate a situation which is not -supposed to arise in complying programs; implementations are strongly -encouraged but not required to signal an error in these situations. -This package sometimes omits such error checking in the interest of -compactness and efficiency. For example, @code{do} variable -specifiers are supposed to be lists of one, two, or three forms; -extra forms are ignored by this package rather than signalling a -syntax error. The @code{endp} function is simply a synonym for -@code{null} in this package. Functions taking keyword arguments -will accept an odd number of arguments, treating the trailing -keyword as if it were followed by the value @code{nil}. - -Argument lists (as processed by @code{defun*} and friends) -@emph{are} checked rigorously except for the minor point just -mentioned; in particular, keyword arguments are checked for -validity, and @code{&allow-other-keys} and @code{:allow-other-keys} -are fully implemented. Keyword validity checking is slightly -time consuming (though not too bad in byte-compiled code); -you can use @code{&allow-other-keys} to omit this check. Functions -defined in this package such as @code{find} and @code{member*} -do check their keyword arguments for validity. - -@ifinfo -@example - -@end example -@end ifinfo -@appendixsec Optimizing Compiler - -@noindent -The byte-compiler that comes with Emacs 18 normally fails to expand -macros that appear in top-level positions in the file (i.e., outside -of @code{defun}s or other enclosing forms). This would have -disastrous consequences to programs that used such top-level macros -as @code{defun*}, @code{eval-when}, and @code{defstruct}. To -work around this problem, the @dfn{CL} package patches the Emacs -18 compiler to expand top-level macros. This patch will apply to -your own macros, too, if they are used in a top-level context. -The patch will not harm versions of the Emacs 18 compiler which -have already had a similar patch applied, nor will it affect the -optimizing Emacs 19 byte-compiler written by Jamie Zawinski and -Hallvard Furuseth. The patch is applied to the byte compiler's -code in Emacs' memory, @emph{not} to the @file{bytecomp.elc} file -stored on disk. - -The Emacs 19 compiler (for Emacs 18) is available from various -Emacs Lisp archive sites such as @code{archive.cis.ohio-state.edu}. -Its use is highly recommended; many of the Common Lisp macros emit -code which can be improved by optimization. In particular, -@code{block}s (whether explicit or implicit in constructs like -@code{defun*} and @code{loop}) carry a fair run-time penalty; the -optimizing compiler removes @code{block}s which are not actually -referenced by @code{return} or @code{return-from} inside the block. - -@node Common Lisp Compatibility, Old CL Compatibility, Efficiency Concerns, Top -@appendix Common Lisp Compatibility - -@noindent -Following is a list of all known incompatibilities between this -package and Common Lisp as documented in Steele (2nd edition). - -Certain function names, such as @code{member}, @code{assoc}, and -@code{floor}, were already taken by (incompatible) Emacs Lisp -functions; this package appends @samp{*} to the names of its -Common Lisp versions of these functions. - -The word @code{defun*} is required instead of @code{defun} in order -to use extended Common Lisp argument lists in a function. Likewise, -@code{defmacro*} and @code{function*} are versions of those forms -which understand full-featured argument lists. The @code{&whole} -keyword does not work in @code{defmacro} argument lists (except -inside recursive argument lists). - -In order to allow an efficient implementation, keyword arguments use -a slightly cheesy parser which may be confused if a keyword symbol -is passed as the @emph{value} of another keyword argument. -(Specifically, @code{(memq :@var{keyword} @var{rest-of-arguments})} -is used to scan for @code{:@var{keyword}} among the supplied -keyword arguments.) - -The @code{eql} and @code{equal} predicates do not distinguish -between IEEE floating-point plus and minus zero. The @code{equalp} -predicate has several differences with Common Lisp; @pxref{Predicates}. - -The @code{setf} mechanism is entirely compatible, except that -setf-methods return a list of five values rather than five -values directly. Also, the new ``@code{setf} function'' concept -(typified by @code{(defun (setf foo) @dots{})}) is not implemented. - -The @code{do-all-symbols} form is the same as @code{do-symbols} -with no @var{obarray} argument. In Common Lisp, this form would -iterate over all symbols in all packages. Since Emacs obarrays -are not a first-class package mechanism, there is no way for -@code{do-all-symbols} to locate any but the default obarray. - -The @code{loop} macro is complete except that @code{loop-finish} -and type specifiers are unimplemented. - -The multiple-value return facility treats lists as multiple -values, since Emacs Lisp cannot support multiple return values -directly. The macros will be compatible with Common Lisp if -@code{values} or @code{values-list} is always used to return to -a @code{multiple-value-bind} or other multiple-value receiver; -if @code{values} is used without @code{multiple-value-@dots{}} -or vice-versa the effect will be different from Common Lisp. - -Many Common Lisp declarations are ignored, and others match -the Common Lisp standard in concept but not in detail. For -example, local @code{special} declarations, which are purely -advisory in Emacs Lisp, do not rigorously obey the scoping rules -set down in Steele's book. - -The variable @code{*gensym-counter*} starts out with a pseudo-random -value rather than with zero. This is to cope with the fact that -generated symbols become interned when they are written to and -loaded back from a file. - -The @code{defstruct} facility is compatible, except that structures -are of type @code{:type vector :named} by default rather than some -special, distinct type. Also, the @code{:type} slot option is ignored. - -The second argument of @code{check-type} is treated differently. - -@node Old CL Compatibility, Porting Common Lisp, Common Lisp Compatibility, Top -@appendix Old CL Compatibility - -@noindent -Following is a list of all known incompatibilities between this package -and the older Quiroz @file{cl.el} package. - -This package's emulation of multiple return values in functions is -incompatible with that of the older package. That package attempted -to come as close as possible to true Common Lisp multiple return -values; unfortunately, it could not be 100% reliable and so was prone -to occasional surprises if used freely. This package uses a simpler -method, namely replacing multiple values with lists of values, which -is more predictable though more noticeably different from Common Lisp. - -The @code{defkeyword} form and @code{keywordp} function are not -implemented in this package. - -The @code{member}, @code{floor}, @code{ceiling}, @code{truncate}, -@code{round}, @code{mod}, and @code{rem} functions are suffixed -by @samp{*} in this package to avoid collision with existing -functions in Emacs 18 or Emacs 19. The older package simply -redefined these functions, overwriting the built-in meanings and -causing serious portability problems with Emacs 19. (Some more -recent versions of the Quiroz package changed the names to -@code{cl-member}, etc.; this package defines the latter names as -aliases for @code{member*}, etc.) - -Certain functions in the old package which were buggy or inconsistent -with the Common Lisp standard are incompatible with the conforming -versions in this package. For example, @code{eql} and @code{member} -were synonyms for @code{eq} and @code{memq} in that package, @code{setf} -failed to preserve correct order of evaluation of its arguments, etc. - -Finally, unlike the older package, this package is careful to -prefix all of its internal names with @code{cl-}. Except for a -few functions which are explicitly defined as additional features -(such as @code{floatp-safe} and @code{letf}), this package does not -export any non-@samp{cl-} symbols which are not also part of Common -Lisp. - -@ifinfo -@example - -@end example -@end ifinfo -@appendixsec The @code{cl-compat} package - -@noindent -The @dfn{CL} package includes emulations of some features of the -old @file{cl.el}, in the form of a compatibility package -@code{cl-compat}. To use it, put @code{(require 'cl-compat)} in -your program. - -The old package defined a number of internal routines without -@code{cl-} prefixes or other annotations. Call to these routines -may have crept into existing Lisp code. @code{cl-compat} -provides emulations of the following internal routines: -@code{pair-with-newsyms}, @code{zip-lists}, @code{unzip-lists}, -@code{reassemble-arglists}, @code{duplicate-symbols-p}, -@code{safe-idiv}. - -Some @code{setf} forms translated into calls to internal -functions that user code might call directly. The functions -@code{setnth}, @code{setnthcdr}, and @code{setelt} fall in -this category; they are defined by @code{cl-compat}, but the -best fix is to change to use @code{setf} properly. - -The @code{cl-compat} file defines the keyword functions -@code{keywordp}, @code{keyword-of}, and @code{defkeyword}, -which are not defined by the new @dfn{CL} package because the -use of keywords as data is discouraged. - -The @code{build-klist} mechanism for parsing keyword arguments -is emulated by @code{cl-compat}; the @code{with-keyword-args} -macro is not, however, and in any case it's best to change to -use the more natural keyword argument processing offered by -@code{defun*}. - -Multiple return values are treated differently by the two -Common Lisp packages. The old package's method was more -compatible with true Common Lisp, though it used heuristics -that caused it to report spurious multiple return values in -certain cases. The @code{cl-compat} package defines a set -of multiple-value macros that are compatible with the old -CL package; again, they are heuristic in nature, but they -are guaranteed to work in any case where the old package's -macros worked. To avoid name collision with the ``official'' -multiple-value facilities, the ones in @code{cl-compat} have -capitalized names: @code{Values}, @code{Values-list}, -@code{Multiple-value-bind}, etc. - -The functions @code{cl-floor}, @code{cl-ceiling}, @code{cl-truncate}, -and @code{cl-round} are defined by @code{cl-compat} to use the -old-style multiple-value mechanism, just as they did in the old -package. The newer @code{floor*} and friends return their two -results in a list rather than as multiple values. Note that -older versions of the old package used the unadorned names -@code{floor}, @code{ceiling}, etc.; @code{cl-compat} cannot use -these names because they conflict with Emacs 19 built-ins. - -@node Porting Common Lisp, Function Index, Old CL Compatibility, Top -@appendix Porting Common Lisp - -@noindent -This package is meant to be used as an extension to Emacs Lisp, -not as an Emacs implementation of true Common Lisp. Some of the -remaining differences between Emacs Lisp and Common Lisp make it -difficult to port large Common Lisp applications to Emacs. For -one, some of the features in this package are not fully compliant -with ANSI or Steele; @pxref{Common Lisp Compatibility}. But there -are also quite a few features that this package does not provide -at all. Here are some major omissions that you will want watch out -for when bringing Common Lisp code into Emacs. - -@itemize @bullet -@item -Case-insensitivity. Symbols in Common Lisp are case-insensitive -by default. Some programs refer to a function or variable as -@code{foo} in one place and @code{Foo} or @code{FOO} in another. -Emacs Lisp will treat these as three distinct symbols. - -Some Common Lisp code is written in all upper-case. While Emacs -is happy to let the program's own functions and variables use -this convention, calls to Lisp builtins like @code{if} and -@code{defun} will have to be changed to lower-case. - -@item -Lexical scoping. In Common Lisp, function arguments and @code{let} -bindings apply only to references physically within their bodies -(or within macro expansions in their bodies). Emacs Lisp, by -contrast, uses @dfn{dynamic scoping} wherein a binding to a -variable is visible even inside functions called from the body. - -Variables in Common Lisp can be made dynamically scoped by -declaring them @code{special} or using @code{defvar}. In Emacs -Lisp it is as if all variables were declared @code{special}. - -Often you can use code that was written for lexical scoping -even in a dynamically scoped Lisp, but not always. Here is -an example of a Common Lisp code fragment that would fail in -Emacs Lisp: - -@example -(defun map-odd-elements (func list) - (loop for x in list - for flag = t then (not flag) - collect (if flag x (funcall func x)))) - -(defun add-odd-elements (list x) - (map-odd-elements (function (lambda (a) (+ a x))) list)) -@end example - -@noindent -In Common Lisp, the two functions' usages of @code{x} are completely -independent. In Emacs Lisp, the binding to @code{x} made by -@code{add-odd-elements} will have been hidden by the binding -in @code{map-odd-elements} by the time the @code{(+ a x)} function -is called. - -(This package avoids such problems in its own mapping functions -by using names like @code{cl-x} instead of @code{x} internally; -as long as you don't use the @code{cl-} prefix for your own -variables no collision can occur.) - -@xref{Lexical Bindings}, for a description of the @code{lexical-let} -form which establishes a Common Lisp-style lexical binding, and some -examples of how it differs from Emacs' regular @code{let}. - -@item -Common Lisp allows the shorthand @code{#'x} to stand for -@code{(function x)}, just as @code{'x} stands for @code{(quote x)}. -In Common Lisp, one traditionally uses @code{#'} notation when -referring to the name of a function. In Emacs Lisp, it works -just as well to use a regular quote: - -@example -(loop for x in y by #'cddr collect (mapcar #'plusp x)) ; Common Lisp -(loop for x in y by 'cddr collect (mapcar 'plusp x)) ; Emacs Lisp -@end example - -When @code{#'} introduces a @code{lambda} form, it is best to -write out @code{(function ...)} longhand in Emacs Lisp. You can -use a regular quote, but then the byte-compiler won't know that -the @code{lambda} expression is code that can be compiled. - -@example -(mapcar #'(lambda (x) (* x 2)) list) ; Common Lisp -(mapcar (function (lambda (x) (* x 2))) list) ; Emacs Lisp -@end example - -XEmacs supports @code{#'} notation starting with version 19.8. - -@item -Reader macros. Common Lisp includes a second type of macro that -works at the level of individual characters. For example, Common -Lisp implements the quote notation by a reader macro called @code{'}, -whereas Emacs Lisp's parser just treats quote as a special case. -Some Lisp packages use reader macros to create special syntaxes -for themselves, which the Emacs parser is incapable of reading. - -@item -Other syntactic features. Common Lisp provides a number of -notations beginning with @code{#} that the Emacs Lisp parser -won't understand. For example, @samp{#| ... |#} is an -alternate comment notation, and @samp{#+lucid (foo)} tells -the parser to ignore the @code{(foo)} except in Lucid Common -Lisp. - -The number prefixes `#b', `#o', and `#x', however, are supported -by the Emacs Lisp parser to represent numbers in binary, octal, -and hexadecimal notation (or radix), just like in Common Lisp. - -@item -Packages. In Common Lisp, symbols are divided into @dfn{packages}. -Symbols that are Lisp built-ins are typically stored in one package; -symbols that are vendor extensions are put in another, and each -application program would have a package for its own symbols. -Certain symbols are ``exported'' by a package and others are -internal; certain packages ``use'' or import the exported symbols -of other packages. To access symbols that would not normally be -visible due to this importing and exporting, Common Lisp provides -a syntax like @code{package:symbol} or @code{package::symbol}. - -Emacs Lisp has a single namespace for all interned symbols, and -then uses a naming convention of putting a prefix like @code{cl-} -in front of the name. Some Emacs packages adopt the Common Lisp-like -convention of using @code{cl:} or @code{cl::} as the prefix. -However, the Emacs parser does not understand colons and just -treats them as part of the symbol name. Thus, while @code{mapcar} -and @code{lisp:mapcar} may refer to the same symbol in Common -Lisp, they are totally distinct in Emacs Lisp. Common Lisp -programs which refer to a symbol by the full name sometimes -and the short name other times will not port cleanly to Emacs. - -Emacs Lisp does have a concept of ``obarrays,'' which are -package-like collections of symbols, but this feature is not -strong enough to be used as a true package mechanism. - -@item -Keywords. The notation @code{:test-not} in Common Lisp really -is a shorthand for @code{keyword:test-not}; keywords are just -symbols in a built-in @code{keyword} package with the special -property that all its symbols are automatically self-evaluating. -Common Lisp programs often use keywords liberally to avoid -having to use quotes. - -In Emacs Lisp a keyword is just a symbol whose name begins with -a colon; since the Emacs parser does not treat them specially, -they have to be explicitly made self-evaluating by a statement -like @code{(setq :test-not ':test-not)}. This package arranges -to execute such a statement whenever @code{defun*} or some -other form sees a keyword being used as an argument. Common -Lisp code that assumes that a symbol @code{:mumble} will be -self-evaluating even though it was never introduced by a -@code{defun*} will have to be fixed. - -@item -The @code{format} function is quite different between Common -Lisp and Emacs Lisp. It takes an additional ``destination'' -argument before the format string. A destination of @code{nil} -means to format to a string as in Emacs Lisp; a destination -of @code{t} means to write to the terminal (similar to -@code{message} in Emacs). Also, format control strings are -utterly different; @code{~} is used instead of @code{%} to -introduce format codes, and the set of available codes is -much richer. There are no notations like @code{\n} for -string literals; instead, @code{format} is used with the -``newline'' format code, @code{~%}. More advanced formatting -codes provide such features as paragraph filling, case -conversion, and even loops and conditionals. - -While it would have been possible to implement most of Common -Lisp @code{format} in this package (under the name @code{format*}, -of course), it was not deemed worthwhile. It would have required -a huge amount of code to implement even a decent subset of -@code{format*}, yet the functionality it would provide over -Emacs Lisp's @code{format} would rarely be useful. - -@item -Vector constants use square brackets in Emacs Lisp, but -@code{#(a b c)} notation in Common Lisp. To further complicate -matters, Emacs 19 introduces its own @code{#(} notation for -something entirely different---strings with properties. - -@item -Characters are distinct from integers in Common Lisp. The -notation for character constants is also different: @code{#\A} -instead of @code{?A}. Also, @code{string=} and @code{string-equal} -are synonyms in Emacs Lisp whereas the latter is case-insensitive -in Common Lisp. - -@item -Data types. Some Common Lisp data types do not exist in Emacs -Lisp. Rational numbers and complex numbers are not present, -nor are large integers (all integers are ``fixnums''). All -arrays are one-dimensional. There are no readtables or pathnames; -streams are a set of existing data types rather than a new data -type of their own. Hash tables, random-states, structures, and -packages (obarrays) are built from Lisp vectors or lists rather -than being distinct types. - -@item -The Common Lisp Object System (CLOS) is not implemented, -nor is the Common Lisp Condition System. - -@item -Common Lisp features that are completely redundant with Emacs -Lisp features of a different name generally have not been -implemented. For example, Common Lisp writes @code{defconstant} -where Emacs Lisp uses @code{defconst}. Similarly, @code{make-list} -takes its arguments in different ways in the two Lisps but does -exactly the same thing, so this package has not bothered to -implement a Common Lisp-style @code{make-list}. - -@item -A few more notable Common Lisp features not included in this -package: @code{compiler-let}, @code{tagbody}, @code{prog}, -@code{ldb/dpb}, @code{parse-integer}, @code{cerror}. - -@item -Recursion. While recursion works in Emacs Lisp just like it -does in Common Lisp, various details of the Emacs Lisp system -and compiler make recursion much less efficient than it is in -most Lisps. Some schools of thought prefer to use recursion -in Lisp over other techniques; they would sum a list of -numbers using something like - -@example -(defun sum-list (list) - (if list - (+ (car list) (sum-list (cdr list))) - 0)) -@end example - -@noindent -where a more iteratively-minded programmer might write one of -these forms: - -@example -(let ((total 0)) (dolist (x my-list) (incf total x)) total) -(loop for x in my-list sum x) -@end example - -While this would be mainly a stylistic choice in most Common Lisps, -in Emacs Lisp you should be aware that the iterative forms are -much faster than recursion. Also, Lisp programmers will want to -note that the current Emacs Lisp compiler does not optimize tail -recursion. -@end itemize - -@node Function Index, Variable Index, Porting Common Lisp, Top -@unnumbered Function Index - -@printindex fn - -@node Variable Index, , Function Index, Top -@unnumbered Variable Index - -@printindex vr - -@contents -@bye diff --git a/man/custom.texi b/man/custom.texi deleted file mode 100644 index 909c5a8..0000000 --- a/man/custom.texi +++ /dev/null @@ -1,423 +0,0 @@ -\input texinfo.tex - -@c %**start of header -@setfilename ../info/custom -@settitle The Customization Library -@iftex -@afourpaper -@headings double -@end iftex -@c %**end of header - -@node Top, Declaring Groups, (dir), (dir) -@comment node-name, next, previous, up -@top The Customization Library - -This manual describes how to declare customization groups, variables, -and faces. It doesn't contain any examples, but please look at the file -@file{cus-edit.el} which contains many declarations you can learn from. - -@menu -* Declaring Groups:: -* Declaring Variables:: -* Declaring Faces:: -* Usage for Package Authors:: -* Utilities:: -* The Init File:: -* Wishlist:: -@end menu - -All the customization declarations can be changes by keyword arguments. -Groups, variables, and faces all share these common keywords: - -@table @code -@item :group -@var{value} should be a customization group. -Add @var{symbol} to that group. -@item :link -@var{value} should be a widget type. -Add @var{value} to the external links for this customization option. -Useful widget types include @code{custom-manual}, @code{info-link}, and -@code{url-link}. -@item :load -Add @var{value} to the files that should be loaded before displaying -this customization option. The value should be either a string, which -should be a string which will be loaded with @code{load-library} unless -present in @code{load-history}, or a symbol which will be loaded with -@code{require}. -@item :tag -@var{Value} should be a short string used for identifying the option in -customization menus and buffers. By default the tag will be -automatically created from the options name. -@end table - -@node Declaring Groups, Declaring Variables, Top, Top -@comment node-name, next, previous, up -@section Declaring Groups - -Use @code{defgroup} to declare new customization groups. - -@defun defgroup symbol members doc [keyword value]... -Declare @var{symbol} as a customization group containing @var{members}. -@var{symbol} does not need to be quoted. - -@var{doc} is the group documentation. - -@var{members} should be an alist of the form ((@var{name} -@var{widget})...) where @var{name} is a symbol and @var{widget} is a -widget for editing that symbol. Useful widgets are -@code{custom-variable} for editing variables, @code{custom-face} for -editing faces, and @code{custom-group} for editing groups.@refill - -Internally, custom uses the symbol property @code{custom-group} to keep -track of the group members, and @code{group-documentation} for the -documentation string. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :prefix -@var{value} should be a string. If the string is a prefix for the name -of a member of the group, that prefix will be ignored when creating a -tag for that member. -@end table -@end defun - -@node Declaring Variables, Declaring Faces, Declaring Groups, Top -@comment node-name, next, previous, up -@section Declaring Variables - -Use @code{defcustom} to declare user editable variables. - -@defun defcustom symbol value doc [keyword value]... -Declare @var{symbol} as a customizable variable that defaults to @var{value}. -Neither @var{symbol} nor @var{value} needs to be quoted. -If @var{symbol} is not already bound, initialize it to @var{value}. - -@var{doc} is the variable documentation. - -The following additional @var{keyword}'s are defined: - -@table @code -@item :type -@var{value} should be a widget type. - -@item :options -@var{value} should be a list of possible members of the specified type. -For hooks, this is a list of function names. - -@item :initialize -@var{value} should be a function used to initialize the variable. It -takes two arguments, the symbol and value given in the @code{defcustom} call. -Some predefined functions are: - -@table @code -@item custom-initialize-set -Use the @code{:set} method to initialize the variable. Do not -initialize it if already bound. This is the default @code{:initialize} -method. - -@item custom-initialize-default -Always use @code{set-default} to initialize the variable, even if a -@code{:set} method has been specified. - -@item custom-initialize-reset -If the variable is already bound, reset it by calling the @code{:set} -method with the value returned by the @code{:get} method. - -@item custom-initialize-changed -Like @code{custom-initialize-reset}, but use @code{set-default} to -initialize the variable if it is not bound and has not been set -already. -@end table - -@item :set -@var{value} should be a function to set the value of the symbol. It -takes two arguments, the symbol to set and the value to give it. The -default is @code{set-default}. - -@item :get -@var{value} should be a function to extract the value of symbol. The -function takes one argument, a symbol, and should return the current -value for that symbol. The default is @code{default-value}. - -@item :require -@var{value} should be a feature symbol. Each feature will be required -when the `defcustom' is evaluated, or when Emacs is started if the user -has saved this option. - -@end table - -@xref{Sexp Types,,,widget,The Widget Library}, for information about -widgets to use together with the @code{:type} keyword. -@end defun - -Internally, custom uses the symbol property @code{custom-type} to keep -track of the variables type, @code{standard-value} for the program -specified default value, @code{saved-value} for a value saved by the -user, and @code{variable-documentation} for the documentation string. - -Use @code{custom-add-option} to specify that a specific function is -useful as an member of a hook. - -@defun custom-add-option symbol option -To the variable @var{symbol} add @var{option}. - -If @var{symbol} is a hook variable, @var{option} should be a hook -member. For other types variables, the effect is undefined." -@end defun - -@node Declaring Faces, Usage for Package Authors, Declaring Variables, Top -@comment node-name, next, previous, up -@section Declaring Faces - -Faces are declared with @code{defface}. - -@defun defface face spec doc [keyword value]... - -Declare @var{face} as a customizable face that defaults to @var{spec}. -@var{face} does not need to be quoted. - -If @var{face} has been set with `custom-set-face', set the face attributes -as specified by that function, otherwise set the face attributes -according to @var{spec}. - -@var{doc} is the face documentation. - -@var{spec} should be an alist of the form @samp{((@var{display} @var{atts})...)}. - -@var{atts} is a list of face attributes and their values. The possible -attributes are defined in the variable `custom-face-attributes'. - -The @var{atts} of the first entry in @var{spec} where the @var{display} -matches the frame should take effect in that frame. @var{display} can -either be the symbol `t', which will match all frames, or an alist of -the form @samp{((@var{req} @var{item}...)...)}@refill - -For the @var{display} to match a FRAME, the @var{req} property of the -frame must match one of the @var{item}. The following @var{req} are -defined:@refill - -@table @code -@item type -(the value of (window-system))@* -Should be one of @code{x} or @code{tty}. - -@item class -(the frame's color support)@* -Should be one of @code{color}, @code{grayscale}, or @code{mono}. - -@item background -(what color is used for the background text)@* -Should be one of @code{light} or @code{dark}. -@end table - -Internally, custom uses the symbol property @code{face-defface-spec} for -the program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-documentation} for the -documentation string.@refill - -@end defun - -@node Usage for Package Authors, Utilities, Declaring Faces, Top -@comment node-name, next, previous, up -@section Usage for Package Authors - -The recommended usage for the author of a typical emacs lisp package is -to create one group identifying the package, and make all user options -and faces members of that group. If the package has more than around 20 -such options, they should be divided into a number of subgroups, with -each subgroup being member of the top level group. - -The top level group for the package should itself be member of one or -more of the standard customization groups. There exists a group for -each @emph{finder} keyword. Press @kbd{C-h p} to see a list of finder -keywords, and add you group to each of them, using the @code{:group} -keyword. - -@node Utilities, The Init File, Usage for Package Authors, Top -@comment node-name, next, previous, up -@section Utilities - -These utilities can come in handy when adding customization support. - -@deffn Widget custom-manual -Widget type for specifying the info manual entry for a customization -option. It takes one argument, an info address. -@end deffn - -@defun custom-add-to-group group member widget -To existing @var{group} add a new @var{member} of type @var{widget}, -If there already is an entry for that member, overwrite it. -@end defun - -@defun custom-add-link symbol widget -To the custom option @var{symbol} add the link @var{widget}. -@end defun - -@defun custom-add-load symbol load -To the custom option @var{symbol} add the dependency @var{load}. -@var{load} should be either a library file name, or a feature name. -@end defun - -@defun customize-menu-create symbol &optional name -Create menu for customization group @var{symbol}. -If optional @var{name} is given, use that as the name of the menu. -Otherwise the menu will be named `Customize'. -The menu is in a format applicable to @code{easy-menu-define}. -@end defun - -@node The Init File, Wishlist, Utilities, Top -@comment node-name, next, previous, up -@section The Init File - -When you save the customizations, call to @code{custom-set-variables}, -@code{custom-set-faces} are inserted into the file specified by -@code{custom-file}. By default @code{custom-file} is your @file{.emacs} -file. If you use another file, you must explicitly load it yourself. -The two functions will initialize variables and faces as you have -specified. - -@node Wishlist, , The Init File, Top -@comment node-name, next, previous, up -@section Wishlist - -@itemize @bullet -@item -Better support for keyboard operations in the customize buffer. - -@item -Integrate with @file{w3} so you can get customization buffers with much -better formatting. I'm thinking about adding a name -tag. The latest w3 have some support for this, so come up with a -convincing example. - -@item -Add an `examples' section, with explained examples of custom type -definitions. - -@item -Support selectable color themes. I.e., change many faces by setting one -variable. - -@item -Support undo using lmi's @file{gnus-undo.el}. - - -@item -Make it possible to append to `choice', `radio', and `set' options. - -@item -Ask whether set or modified variables should be saved in -@code{kill-buffer-hook}. - -Ditto for @code{kill-emacs-query-functions}. - -@item -Command to check if there are any customization options that -does not belong to an existing group. - -@item -Optionally disable the point-cursor and instead highlight the selected -item in XEmacs. This is like the *Completions* buffer in XEmacs. -Suggested by Jens Lautenbacher -@samp{}.@refill - -@item -Explain why it is necessary that all choices have different default -values. - -@item -Make it possible to include a comment/remark/annotation when saving an -option. - -@item -Add some direct support for meta variables, i.e. make it possible to -specify that this variable should be reset when that variable is -changed. - -@item -Add tutorial. - -@item -Describe the @code{:type} syntax in this manual. - -@item -Find a place is this manual for the following text: - -@strong{Radio vs. Buttons} - -Use a radio if you can't find a good way to describe the item in the -choice menu text. I.e. it is better to use a radio if you expect the -user would otherwise manually select each item from the choice menu in -turn to see what it expands too. - -Avoid radios if some of the items expands to complex structures. - -I mostly use radios when most of the items are of type -@code{function-item} or @code{variable-item}. - -@item -Update customize buffers when @code{custom-set-variable} or -@code{custom-save-customized} is called. - -@item -Better handling of saved but uninitialized items. - -@item -Detect when faces have been changed outside customize. - -@item -Enable mouse help in Emacs by default. - -@item -Add an easy way to display the standard settings when an item is modified. - -@item -See if it is feasible to scan files for customization information -instead of loading them, - -@item -Add hint message when user push a non-pushable tag. - -Suggest that the user unhide if hidden, and edit the value directly -otherwise. - -@item -Use checkboxes and radio buttons in the state menus. - -@item -Add option to hide @samp{[hide]} for short options. Default, on. - -@item -Add option to hide @samp{[state]} for options with their standard -settings. - -@item -There should be a way to specify site defaults for user options. - -@item -There should be more buffer styles. The default `nested style, the old -`outline' style, a `numeric' style with numbers instead of stars, an -`empty' style with just the group name, and `compact' with only one line -per item. - -@item -Newline and tab should be displayed as @samp{^J} and @samp{^I} in the -@code{regexp} and @code{file} widgets. I think this can be done in -XEmacs by adding a display table to the face. - -@item -Use glyphs to draw the @code{customize-browse} tree. - -Add echo and balloon help. You should be able to read the documentation -simply by moving the mouse pointer above the name. - -Add parent links. - -Add colors. - -@end itemize - -@contents -@bye diff --git a/man/emodules.texi b/man/emodules.texi deleted file mode 100644 index d20ccfb..0000000 --- a/man/emodules.texi +++ /dev/null @@ -1,1006 +0,0 @@ -\input texinfo @c -*-texinfo-*- - -@c %**start of header -@setfilename ../info/emodules.info -@settitle Extending Emacs using C Modules -@c %**end of header - -@c -@c Use some macros so that we can format for either XEmacs -@c or (shudder) GNU Emacs. -@c - -@ifset XEMACS -@macro emacs -XEmacs -@end macro -@clear EMACS -@set HAVE_EMACS -@end ifset - -@ifset EMACS -@macro emacs -Emacs -@end macro -@clear XEMACS -@set HAVE_EMACS -@end ifset - -@ifclear HAVE_EMACS -@set XEMACS -@macro emacs -XEmacs -@end macro -@end ifclear - -@ifinfo -This file documents the module loading technology of @emacs{}. - -Copyright @copyright{} 1998 J. Kean Johnston. - -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 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 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 Foundation. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. -@end ifinfo - -@c Combine indices. -@syncodeindex fn cp -@syncodeindex vr cp -@syncodeindex ky cp -@syncodeindex pg cp -@syncodeindex tp cp - -@setchapternewpage odd -@finalout - -@titlepage -@title Extending @emacs{} using C and C++ -@subtitle Version 1.0, September 1998 - -@author J. Kean Johnston -@page -@vskip 0pt plus 1fill - -@noindent -Copyright @copyright{} 1998 J. Kean Johnston. @* - -@sp 2 -Version 1.0 @* -September, 1998.@* - -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 ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. -@end titlepage -@page - -@ifinfo -@node Top, Introduction, (dir), (dir) -This Info file contains v1.0 of the @emacs{} dynamic loadable module -support documentation. -@menu -* Introduction:: Introducing Emacs Modules -* Annatomy of a Module:: Basic module layout and technology -* Using ellcc:: How to use the module compiler -* Defining Functions:: Creating new Lisp primitives -* Defining Variables:: Creating new Lisp variables -* Index:: Concept Index - - --- The Detailed Node Listing --- - -Annatomy of a Module - -* Required Header File:: Always include -* Required Functions:: Functions you must always provide -* Required Variables:: Variables whose values you must provide -* Loading other Modules:: How to load dependant modules - -Using @code{ellcc} - -* Compile Mode:: Compiling modules using ellcc -* Initialization Mode:: Generating documentation and variables -* Link Mode:: Creating the final loadable module -* Other ellcc options:: Other useful options -* Environment Variables:: How to control ellcc - -Defining Functions - -* Using DEFUN:: Using the DEFUN macro to define functions -* Declaring Functions:: Declaring functions to the Lisp reader -@end menu - -@end ifinfo - -@node Introduction, Annatomy of a Module, Top, Top -@chapter Introduction - - @emacs{} is a powerful, extensible editor. The traditional way of -extending the functionality of @emacs{} is to use its built-in Lisp -language (called Emacs Lisp, or Elisp for short). However, while Elisp -is a full programming language and capable of extending @emacs{} in more -ways than you can imagine, it does have its short-comings. - - Firstly, Elisp is an interpreted language, and this has serious speed -implications. Like all other interpreted languages (like Java), Elisp -is often suitable only for certain types of application or extension. -So although Elisp is a general purpose language, and very ligh level, -there are times when it is desirable to descend to a lower level compiled -language for speed purposes. - - Secondly, Elisp (or Lisp in general) is not a very common language any -more, except for certain circles in the computer industry. C is a far -more commonly known language, and because it is compiled, more suited to -a wider range of applications, especially those that require low level -access to a system or need to be as quick as possible. - -@cindex Emacs Modules -@cindex DLL -@cindex DSO -@cindex shared object - This manual describes a new way of extending @emacs{}, by using dynamic -loadable modules (also knows as dynamicaly loadable libraries (DLLs), -dynamic shared objects (DSOs) or just simply shared objectcs), which can -be written in C or C++ and loaded into @emacs{} at any time. I sometimes -refer to this technology as @dfn{CEmacs}, which is short for @dfn{C -Extensible Emacs}. - - @emacs{} modules are configured into and installed with @emacs{} by -default on all systems that support loading of shared objects. From a -users perspective, the internals of @emacs{} modules are irrelevant. -All a user will ever need to know about shared objects is the name of -the shared object when they want to load a given module. From a -developers perspective though, a lot more is provided. - -@itemize @bullet -@item -@pindex ellcc -@cindex compiler -@cindex linker - Of primary interest is the @code{ellcc} program. This program is -created during compile time, and is intended to abstract compiler -specific characteristics from the developer. This program is called to -compile and link all objects that will make up the final shared object, -and accepts all common C compiler flags. @code{ellcc} also sets up the -correct environment for compiling modules by enabling any special -compiler modes (such as PIC mode), setting the correct include paths for -the location of @emacs{} internal header files etc. The program will also -invoke the linker correctly to created the final shared object which is -loaded into @emacs{}. - -@item -@cindex header files - CEmacs also makes all of the relevant @emacs{} internal header files -availible for module authors to use. This is often required to get data -structure definitions and external variable declarations. The header -files installed include the module specific header file -@file{emodules.h}. Due to the nature of dynamic modules, most of the -internals of @emacs{} are exposed. -@xref{Top,,,internals,@emacs{} Internals Manual}, for a -more complete discussion on how to extend and understand @emacs{}. All of -the rules for C modules are discussed there. - -@item -@cindex samples - Part of the @emacs{} distribution is a set of sample modules. These are -not installed when @emacs{} is, but remain in the @emacs{} source tree. -These modules live in the directory @file{modules}, which is a -sub-directory of the main @emacs{} source code directory. Please look at -the samples carefully, and maybe even use them as a basis for making -your own modules. Most of the concepts required for writing extension -modules are covered in the samples. - -@item -@cindex documentation -@cindex help - Last, but not least is this manual. This can be viewed from within -@emacs{}, and it can be printed out as well. It is the intention of this -document that it will describe everything you need to know about -extending @emacs{} in C. If you do not find this to be the case, please -contact the author(s). -@end itemize - - The rest of this document will discuss the actual mechanics of -@emacs{} modules and work through several of the samples. Please be -sure that you have read the @emacs{} Internals Manual and understand -everything in it. The concepts there apply to all modules. This -document may have some overlap, but it is the internals manual which -should be considered the final authority. It will also help a great -deal to look at the actual @emacs{} source code to see how things are -done. - -@node Annatomy of a Module, Using ellcc, Introduction, Top -@chapter Annatomy of a Module -@cindex annatomy -@cindex module skeleton -@cindex skeleton, module -@cindex module format -@cindex format, module - - Each dynamically loadable @emacs{} extension (hereafter refered to as a -module) has a certain compulsory format, and must contain several -pieces of information and several mandatory functions. This chapter -describes the basic layout of a module, and provides a very simple -sample. The source for this sample can be found in the file -@file{modules/simple/sample.c} in the main @emacs{} source code tree. - -@menu -* Required Header File:: Always include -* Required Functions:: Functions you must always provide -* Required Variables:: Variables whose values you must provide -* Loading other Modules:: How to load dependant modules -@end menu - -@node Required Header File, Required Functions, Annatomy of a Module, Annatomy of a Module -@section Required Header File -@cindex required header -@cindex include files - -@cindex emodules.h -@cindex config.h - Every module must include the file @file{}. This -will include several other @emacs{} internal header files, and will set up -certain vital macros. One of the most important files included by -@file{emodules.h} is the generated @file{config.h} file, which contains -all of the required system abstraction macros and definitions. Most -modules will probably require some pre-processor conditionals based on -constants defined in @file{config.h}. Please read that file to -familiarize yourself with the macros defined there. - - Depending on exactly what your module will be doing, you will probably -need to include one or more of the @emacs{} internal header files. When -you @code{#include }, you will get a few of the most important -@emacs{} header files included automatically for you. The files included -are: - -@table @file -@item lisp.h -This file contains most of the macros required for declaring Lisp object -types, macros for accessing Lisp objects, and global variable -declarations. - -@item sysdep.h -All system dependant declarations and abstraction macros live here. You -should never call low level system functions directly. Rather, you -should use the abstraction macros provided in this header file. - -@item window.h -This header file defines the window structures and Lisp types, and -provides functions and macros for manipulating multiple @emacs{} windows. - -@item buffer.h -All macros and function declarations for manipulating internal and user -visible buffers appear in this file. - -@item insdel.h -This header provides the information required for performing text -insertion and deletion. - -@item frame.h -Provides the required structure, macro and function definitions for -manipulating @emacs{} frames. -@end table - -@node Required Functions, Required Variables, Required Header File, Annatomy of a Module -@section Required Functions -@cindex initialization -@cindex functions, required -@cindex required functions - -Every module requires several initialization functions. It is the -responsibility of these functions to load in any dependant modules, and to -declare all variables and functions which are to be made visibile to the -@emacs{} Lisp reader. Each of these functions performs a very specific -task, and they are executed in the correct order by @emacs{}. All of -these functions are @code{void} functions which take no arguments. -Here, briefly, are the required module functions. Note that the actual -function names do not end with the string @code{_module}, but rather -they end with the abbreviated module name by which the module is known. -More on the module name and its importance later. Just bear in mind -that the text @code{_module} in the functions below is simply a -place-holder, not an actual function name. - -@table @code -@item syms_of_module -@findex syms_of_module -This required function is responsible for introducing to the Lisp reader -all functions that you have defined in your module using -@code{DEFUN()}. Note that @emph{only} functions are declared here, using -the @code{DEFSUBR()} macro. No variables are declared. - -@item vars_of_module -@findex vars_of_module -This required function contains calls to macros such as -@code{DEFVAR_LISP()}, @code{DEFVAR_BOOL()} etc, and its purpose is to -declare and initialize all and any variables that your module defines. -They syntax for declaring variables is identical to the syntax used for -all internal @emacs{} source code. - -@item modules_of_module -@findex modules_of_module -This optional function should be used to load in any modules which your -module depends on. The @emacs{} module loading code makes sure that the -same module is not loaded twice, so several modules can safely call the -module load function for the same module. Only one copy of each module -(at a given version) will ever be loaded. - -@item docs_of_module -@findex docs_of_module -This is a required function, but not one which you need ever write. -This function is created automatically by @code{ellcc} when the module -initialization code is produced. It is required to document all -functions and variables declared in your module. -@end table - -@node Required Variables, Loading other Modules, Required Functions, Annatomy of a Module -@section Required Variables -@cindex initialization -@cindex variables, required -@cindex required variables - -Not only does a module need to declare the initialization functions -mentioned above, it is also required to provide certain variables which -the module loading code searches for in order to determine the viability -of a module. You are @emph{not} required to provide these variables in -your source files. They are automatically set up in the module -initialization file by the @code{ellcc} compiler. These variables are -discussed here simply for the sake of completeness. - -@table @code -@item emodules_compiler -This is a variable of type @code{long}, and is used to indicate the -version of the @emacs{} loading technology that was used to produce the -module being loaded. This version number is completely unrelated to -the @emacs{} version number, as a given module may quite well work -regardless of the version of @emacs{} that was installed at the time the -module was created. - -The @emacs{} modules version is used to differentiate between major -changes in the module loading technology, not versions of @emacs{}. - -@item emodules_name -This is a short (typically 10 characters or less) name for the module, -and it is used as a suffix for all of the required functions. This is -also the name by which the module is recognised when loading dependant -modules. The name does not necessarily have to be the same as the -physical file name, although keeping the two names in sync is a pretty -good idea. The name must not be empty, and it must be a valid part of a -C function name. The value of this variable is appended to the function -names @code{syms_of_}, @code{vars_of_}, @code{modules_of_} and -@code{docs_of_} to form the actual function names that the module -loading code looks for when loading a module. - -This variable is set by the @code{--mod-name} argument to @code{ellcc}. - -@item emodules_version -This string variable is used to load specific versions of a module. -Rarely will two or more versions of a module be left lying around, but -just in case this does happen, this variable can be used to control -exactly which module should be loaded. See the Lisp function -@code{load-module} for more details. This variable is set by the -@code{--mod-version} argument to @code{ellcc}. - -@item emodules_title -This is a string which describes the module, and can contain spaces or -other special characters. It is used solely for descriptive purposes, -and does not affect the loading of the module. The value is set by the -@code{--mod-title} argument to @code{ellcc}. -@end table - -@node Loading other Modules, , Required Variables, Annatomy of a Module -@section Loading other Modules -@cindex dependancies -@findex modules_of_module -@findex emodules_load - -During the loading of a module, it is the responsibility of the function -@code{modules_of_module} to load in any modules which the current module -depends on. If the module is stand-alone, and does not depend on other -modules, then this function can be left empty or even undeclared. -However, if it does have dependnacies, it must call -@code{emodules_load}: - -@example @code -@cartouche -int emodules_load (CONST char *module, - CONST char *modname, - CONST char *modver) -@end cartouche -@end example - -The first argument @var{module} is the name of the actual shared object -or DLL. You can omit the @file{.so}, @file{.ell} or @file{.dll} -extension of you wish. If you do not specify an absolute path name, -then the same rules as apply to loading Lisp modules are applied when -searching for the module. If the module cannot be found in any of the -standard places, and an absolute path name was not specified, -@code{emodules_load} will signal an error and loading of the module -will stop. - -The second argument (@var{modname}) is the module name to load, and -must match the contents of the variable @var{emodule_name} in the -module to be loaded. A mis-match will cause the module load to fail. If -this parameter is @code{NULL} or empty, then no checks are performed -against the target module's @var{emodule_name} variable. - -The last argument, @var{modver}, is the desired version of the module -to load, and is compared to the target module's -@var{emodule_version} value. If this parameter is not @code{NULL} -or empty, and the match fails, then the load of the module will fail. - -@code{emodules_load} can be called recursively. If, at any point -during the loading of modules a failure is encountered, then all modules -that were loaded since the top level call to @code{emodules_load} -will be unloaded. This means that if any child modules fail to load, -then their parents will also fail to load. This does not include -previous successful calls to @code{emodules_load} at the top level. - -@node Using ellcc, Defining Functions, Annatomy of a Module, Top -@chapter Using @code{ellcc} -@cindex @code{ellcc} -@cindex module compiler - -Before discussing the anatomy of a module in greater detail, you should -be aware of the steps required in order to correctly compile and link a -module for use within @emacs{}. There is little difference between -compiling normal C code and compiling a module. In fact, all that -changes is the command used to compile the module, and a few extra -arguments to the compiler. - -@emacs{} now ships with a new user utility, called @code{ellcc}. This -is the @dfn{Emacs Loadable Library C Compiler}. This is a wrapper -program that will invoke the real C compiler with the correct arguments -to compile and link your module. With the exception of a few command -line options, this program can be considered a replacement for your C -compiler. It accepts all of the same flags and arguments that your C -compiler does, so in many cases you can simply set the @code{make} -variable @code{CC} to @code{ellcc} and your code will be compiled as -an Emacs module rather than a static C object. - -@code{ellcc} has three distinct modes of operation. It can be run in -compile, link or initialization mode. These modes are discussed in more -detail below. If you want @code{ellcc} to show the commands it is -executing, you can specify the option @code{--mode=verbose} to -@code{ellcc}. Specifying this option twice will enable certain extra -debugging messages to be displayed on the standard output. - -@menu -* Compile Mode:: Compiling modules using ellcc -* Initialization Mode:: Generating documentation and variables -* Link Mode:: Creating the final loadable module -* Other ellcc options:: Other useful options -* Environment Variables:: How to control ellcc -@end menu - -@node Compile Mode, Initialization Mode, Using ellcc, Using ellcc -@section Compile Mode -@cindex compiling - -By default, @code{ellcc} is in @dfn{compile} mode. This means that it -assumes that all of the command line arguments are C compiler arguments, -and that you want to compile the specified source file or files. You -can force compile mode by specifying the @code{--mode=compile} argument -to @code{ellcc}. - -In this mode, @code{ellcc} is simply a front-end to the same C compiler -that was used to create the @emacs{} binary itself. All @code{ellcc} -does in this mode is insert a few extra command line arguments before -the arguments you specify to @code{ellcc} itself. @code{ellcc} will -then invoke the C compiler to compile your module, and will return the -same exit codes and messages that your C compiler does. - -By far the easiest way to compile modules is to construct a -@file{Makefile} as you would for a normal program, and simply insert, at -some appropriate place something similar to: - -@example @code -@cartouche -CC=ellcc --mode=compile - -.c.o: - $(CC) $(CFLAGS) -c $< -@end cartouche -@end example - -After this, all you need to do is provide simple @code{make} rules for -compiling your module source files. Since modules are most useful when -they are small and self-contained, most modules will have a single -source file, aside from the module specific initialization file (see -below for details). - -@node Initialization Mode, Link Mode, Compile Mode, Using ellcc -@section Initialization Mode -@cindex initialization -@cindex documentation - -@emacs{} uses a rather bizarre way of documenting variables and -functions. Rather than have the documentation for compiled functions -and variables passed as static strings in the source code, the -documentation is included as a C comment. A special program, called -@file{make-docfile}, is used to scan the source code files and extract -the documentation from these comments, producing the @emacs{} @file{DOC} -file, which the internal help engine scans when the documentation for a -function or variable is requested. - -Due to the internal construction of Lisp objects, subrs and other such -things, adding documentation for a compiled function or variable in a -compiled module, at any time after @emacs{} has been @dfn{dumped} is -somewhat problematic. Fortunately, as a module writer you are insulated -from the difficulties thanks to your friend @code{ellcc} and some -internal trickery in the module loading code. This is all done using -the @dfn{initialization} mode of @code{ellcc}. - -The result of running @code{ellcc} in initialization mode is a C source -file which you compile with (you guessed it) @code{ellcc} in compile -mode. Initialization mode is where you set the module name, version, -title and gather together all of the documentaion strings for the -functions and vairables in your module. There are several options that -you are required to pass @code{ellcc} in initialization mode, the first -of which is the mode switch itself, @code{--mode=init}. - -Next, you need to specify the name of the C source code file that -@code{ellcc} will produce, and you specify this using the -@code{--mod-output=FILENAME} argument. @var{FILENAME} is the name of -the C source code file that will contain the module variables and -@code{docs_of_module} function. - -As discussed previously, each module requires a short @dfn{handle} or -module name. This is specified with the @code{--mod-name=NAME} option, -where @var{NAME} is the abbreviated module name. This @var{NAME} must -consist only of characters that are valid in C function and variable -names. - -The module version is specified using @code{--mod-version=VERSION} -argument, with @var{VERSION} being any arbitrary version string. This -version can be passed as an optional second argument to the Lisp -function @code{load-module}, and as the third argument to the internal -module loading command @code{emodules_load}. This version string is -used to distinguish between different versions of the same module, and -to ensure that the module is loaded at a specific version. - -Last, but not least, is the module title. Specified using the -@code{--mod-title=TITLE} option, the specified @var{TITLE} is used when -the list of loaded modules is displayed. The module title serves no -purpose other than to inform the user of the function of the module. -This string should be brief, as it has to be formatted to fit the -screen. - -Following all of these parameters, you need to provide the list of all -source code modules that make up your module. These are the files which -are scanned by @file{make-docfile}, and provide the information required -to populate the @code{docs_of_module} function. Below is a sample -@file{Makefile} fragment which indicates how all of this is used. - -@example @code -@cartouche -CC=ellcc --mode=compile -LD=ellcc --mode=link -MODINIT=ellcc --mode=init -CFLAGS=-O2 -DSOME_STUFF - -.c.o: - $(CC) $(CFLAGS) -c $< - -MODNAME=sample -MODVER=1.0.0 -MODTITLE="Small sample module" - -SRCS=modfile1.c modfile2.c modfile3.c -OBJS=$(SRCS:.c=.o) - -all: sample.ell -clean: - rm -f $(OBJS) sample_init.o sample.ell - -install: all - mkdir `ellcc --mod-location`/mymods > /dev/null - cp sample.ell `ellcc --mod-location`/mymods/sample.ell - -sample.ell: $(OBJS) sample_init.o - $(LD) --mod-output=$@ $(OBJS) sample_init.o - -sample_init.o: sample_init.c -sample_init.c: $(SRCS) - $(MODINIT) --mod-name=$(MODNAME) --mod-version=$(MODVER) \ - --mod-title=$(MODTITLE) --mod-output=$@ $(SRCS) -@end cartouche -@end example - -The above @file{Makefile} is, in fact, complete, and would compile the -sample module, and optionally install it. The @code{--mod-location} -argument to @code{ellcc} will produce, on the standard output, the base -location of the @emacs{} module directory. Each sub-directory of that -directory is automatically searched for for modules when they are loaded -with @code{load-module}. An alternative location would be -@file{/usr/local/lib/xemacs/site-modules}. That path can change -depending on the options the person who compiled @emacs{} chose, so you -can always determine the correct site location using the -@code{--mod-site-location} option. This directory is treated the same -way as the main module directory. Each sub-directory within it is -searched for a given module when the user attempts to load it. The -valid extensions that the loader attempts to use are @file{.so}, -@file{.ell} and @file{.dll}. You can use any of these extensions, -although @file{.ell} is the prefered extension. - -@node Link Mode, Other ellcc options, Initialization Mode, Using ellcc -@section Link Mode -@cindex linking - -Once all of your source code files have been compiled (including the -generated init file) you need to link them all together to created the -loadable module. To do this, you invoke @code{ellcc} in link mode, by -pasing the @code{--mode-link} command. You need to specify the final -output file using the @code{--mod-output=NAME} command, but other than -that all other arguments are passed on directly to the system compiler -or linker, along with any other required arguments to create the -loadable module. - -The module has complete access to all symbols that were present in the -dumped @emacs{}, so you do not need to link against libraries that were -linked in with the main executable. If your library uses some other -extra libraries, you will need to link with those. There is nothing -particularly complicated about link mode. All you need to do is make -sure you invoke it correctly in the @file{Makefile}. See the sample -@file{Makefile} above for an example of a well constructed -@file{Makefile} that invoked the linker correctly. - -@node Other ellcc options, Environment Variables, Link Mode, Using ellcc -@section Other @code{ellcc} options -@cindex paths - -Aside from the three main @code{ellcc} modes described above, -@code{ellcc} can accept several other options. These are typically used -in a @file{Makefile} to determine installation paths. @code{ellcc} also -allows you to over-ride several of its built-in compiler and linker -options using environment variables. Here is the complete list of -options that @code{ellcc} accepts. - -@table @code -@item --mode=compile -Enables compilation mode. Use this to compile source modules. - -@item --mode=link -Enabled link edit mode. Use this to create the final module. - -@item --mode=init -Used to create the documentation function and to initialize other -required variables. Produces a C source file that must be compiled with -@code{ellcc} in compile mode before linking the final module. - -@item --mode=verbose -Enables verbose mode. This will show you the commands that are being -executed, as well as the version number of @code{ellcc}. If you specify -this option twice, then some extra debugging information is displayed. - -@item --mod-name=NAME -Sets the short internaml module @var{NAME} to the string specified, -which must consist only of valid C identifiers. Required during -initialization mode. - -@item --mod-version=VERSION -Sets the internal module @var{VERSION} to the specified string. -Required during initialization mode. - -@item --mod-title=TITLE -Sets the module descriptive @var{TITLE} to the string specified. This -string can contain any printable characters, but should not be too -long. It is required during initialization mode. - -@item --mod-output=FILENAME -Used to control the output file name. This is used during -initialization mode to set the name of the C source file that will be -created to @var{FILENAME}. During link mode, it sets the name of the -final loadable module to @var{FILENAME}. - -@item --mod-location -This will print the name of the standard module installation path on the -standard output and immediately exit @code{ellcc}. Use this option to -determine the directory prefix of where you should install your modules. - -@item --mod-site-location -This will print the name of the site specific module location and exit. - -@item --mod-archdir -Prints the name of the root of the architecture-dependant directory that -@emacs{} searches for architecture-dependant files. - -@item --mod-config -Prints the name of the configuration for which @emacs{} and @code{ellcc} -were compiled. -@end table - -@node Environment Variables, , Other ellcc options, Using ellcc -@section Environment Variables -@cindex environment variables - -During its normal operation, @code{ellcc} uses the compiler and linker -flags that were determined at the time @emacs{} was configured. In -certain rare circumstances you may wish to over-ride the flags passed to -the compiler or linker, and you can do so using environment variables. -The table below lists all of the environment variables that @code{ellcc} -recognises. - -@table @code -@item ELLCC -@cindex @code{ELLCC} -This is used to over-ride the name of the C compiler that is invoked by -@code{ellcc}. - -@item ELLLD -@cindex @code{ELLLD} -Sets the name of the link editor to use to created the final module. - -@item ELLCFLAGS -@cindex @code{ELLCFLAGS} -Sets the compiler flags passed on when compiling source modules. This -only sets the basic C compiler flags. There are certain hard-coded -flags that will always be passed. - -@item ELLLDFLAGS -@cindex @code{ELLLDFLAGS} -Sets the flags passed on to the linker. This does @strong{not} include -the flags for enabling PIC mode. This just sets basic linker flags. - -@item ELLDLLFLAGS -@cindex @code{ELLDLLFLAGS} -Sets the flags passed to the linker that are required to created shared -and loadable objects. - -@item ELLPICFLAGS -@cindex @code{ELLPICFLAGS} -Sets the C compiler option required to produce an object file that is -suitable for including in a shared library. This option should turn on -PIC mode, or the moral equivalent thereof on the target system. - -@item ELLMAKEDOC -@cindex @code{ELLMAKEDOC} -Sets the name of the @file{make-docfile} program to use. Usually -@code{ellcc} will use the version that was compiled and installed with -@emacs{}, but this option allows you to specify an alternative path. -Used during the compile phase of @emacs{} itself. -@end table - -@node Defining Functions, Defining Variables, Using ellcc, Top -@chapter Defining Functions -@cindex defining functions - - One of the main reasons you would ever write a module is to -provide one or more @dfn{functions} for the user or the editor to use. -The term -@dfn{function} is a bit overloaded here, as it refers to both a C -function and the way it appears to Lisp, which is a @dfn{subroutine}, or -simply a @dfn{subr}. A Lisp subr is also known as a Lisp primitive, but -that term applies less to dynamic modules. @xref{Writing Lisp -Primitives,,,internals,@emacs{} Internals Manual}, for details on how to -declare functions. You should familiarize yourself with the -instructions there. The format of the function declaration is identical -in modules. - - Normal Lisp primitives document the functions they defining by including -the documentation as a C comment. During the build process, a program -called @file{make-docfile} is run, which will extract all of these -comments, build up a single large documentation file, and will store -pointers to the start of each documentation entry in the dumped @emacs{}. -This, of course, will not work for dynamic modules, as they are loaded -long after @emacs{} has been dumped. For this reason, we require a -special means for adding documentation for new subrs. This is what the -macro @code{CDOCSUBR} is used for, and this is used extensively during -@code{ellcc} initialization mode. - - When using @code{DEFUN} in normal @emacs{} C code, the sixth -``parameter'' is a C comment which documents the function. For a -dynamic module, we of course need to convert the C comment to a usable -string, and we need to set the documentation pointer of the subr to this -string. As a module programmer, you don't actually need to do any work -for this to happen. It is all taken care of in the -@code{docs_of_module} function created by @code{ellcc}. - -@menu -* Using DEFUN:: Using the DEFUN macro to define functions -* Declaring Functions:: Declaring functions to the Lisp reader -@end menu - -@node Using DEFUN, Declaring Functions, Defining Functions, Defining Functions -@section Using @code{DEFUN} -@cindex subrs -@findex DEFUN -@cindex functions, Lisp -@cindex functions, defining - - Although the full syntax of a function declaration is discussed in the -@emacs{} internals manual in greater depth, what follows is a brief -description of how to define and implement a new Lisp primitive in a -module. This is done using the @code{DEFUN} macro. Here is a small -example: - -@example @code -@cartouche -DEFUN ("my-function", Fmy_function, 1, 1, "FFile name: ", /* -Sample Emacs primitive function. - -The specified FILE is frobricated before it is fnozzled. -*/ - (file)) -@{ - char *filename; - - if (NILP(file)) - return Qnil; - - filename = (char *)XSTRING_DATA(file); - frob(filename); - return Qt; -@} -@end cartouche -@end example - -The first argument is the name of the function as it will appear to the -Lisp reader. This must be provided as a string. The second argument is -the name of the actual C function that will be created. This is -typically the Lisp function name with a preceding capital @code{F}, with -hyphens converted to underscores. This must be a valid C function -name. Next come the minimum and maximum number of arguments, -respectively. This is used to ensure that the correct number of -arguments are passed to the function. Next is the @code{interactive} -definition. If this function is meant to be run by a user -interactively, then you need to specify the argument types and prompts -in this string. Please consult the @emacs{} Lisp manual for more -details. Next comes a C comment that is the documentation for this -function. This comment @strong{must} exist. Last comes the list of -function argument names, if any. - -@node Declaring Functions, , Using DEFUN, Defining Functions -@section Declaring Functions -@findex DEFSUBR -@cindex functions, declaring - -Simply writing the code for a function is not enough to make it -availible to the Lisp reader. You have to, during module -initialization, let the Lisp reader know about the new function. This -is done by calling @code{DEFSUBR} with the name of the function. This -is the sole purpose of the initialization function -@code{syms_of_module}. @xref{Required Functions}, for more details. - -Each call to @code{DEFSUBR} takes as its only argument the name of the -function, which is the same as the second argument to the call to -@code{DEFUN}. Using the example function above, you would insert the -following code in the @code{syms_of_module} function: - -@example @code -@cartouche -DEFSUBR(Fmy_function); -@end cartouche -@end example - -This call will instruct @emacs{} to make the function visible to the Lisp -reader and will prepare for the insertion of the documentation into -the right place. Once this is done, the user can call the Lisp -function @code{my-function}, if it was defined as an interactive -function (which in this case it was). - -Thats all there is to defining and announcing new functions. The rules -for what goes inside the functions, and how to write good modules, is -beyond the scope of this document. Please consult the @emacs{} -internals manual for more details. - -@node Defining Variables, Index, Defining Functions, Top -@chapter Defining Variables -@cindex defining variables -@cindex defining objects -@findex DEFVAR_LISP -@findex DEFVAR_BOOL -@findex DEFVAR_INT -@cindex variables, Lisp -@cindex variables, defining -@cindex objects, defining -@cindex objects, Lisp - - Rarely will you write a module that only contains functions. It is -common to also provide variables which can be used to control the -behaviour of the function, or store the results of the function being -executed. The actual C variable types are the same for modules -and internal @emacs{} primitives, and the declaration of the variables -is identical. - - @xref{Adding Global Lisp Variables,,,internals,XEmacs Internals Manual}, -for more information on variables and naming conventions. - - Once your variables are defined, you need to initialize them and make -the Lisp reader aware of them. This is done in the -@code{vars_of_module} initialization function using special @emacs{} -macros such as @code{DEFVAR_LISP}, @code{DEFVAR_BOOL}, @code{DEFVAR_INT} -etc. The best way to see how to use these macros is to look at existing -source code, or read the internals manual. - - One @emph{very} important difference between @emacs{} variables and -module variables is how you use pure space. Simply put, you -@strong{never} use pure space in @emacs{} modules. The pure space -storage is of a limited size, and is initialized propperly during the -dumping of @emacs{}. Because variables are being added dynamically to -an already running @emacs{} when you load a module, you cannot use pure -space. Be warned: @strong{do not use pure space in modules. Repeat, do -not use pure space in modules.} Once again, to remove all doubts: -@strong{DO NOT USE PURE SPACE IN MODULES!!!} - - Below is a small example which declares and initializes two -variables. You will note that this code takes into account the fact -that this module may very well be compiled into @emacs{} itself. This -is a prudent thing to do. - -@example @code -@cartouche -Lisp_Object Vsample_string; -int sample_boolean; - -void -vars_of_module() -@{ - DEFVAR_LISP ("sample-string", &Vsample_string /* -This is a sample string, declared in a module. - -Nothing magical about it. -*/); - - DEFVAR_BOOL("sample-boolean", &sample_boolean /* -*Sample user-settable boolean. -*/); - - sample_boolean = 0; - Vsample_string = build_string("My string"); -@} -@end cartouche -@end example - -@c Print the tables of contents -@contents -@c That's all - -@node Index, , Defining Variables, Top -@unnumbered Index - -@printindex cp - -@bye - diff --git a/man/external-widget.texi b/man/external-widget.texi deleted file mode 100644 index 40ccb5c..0000000 --- a/man/external-widget.texi +++ /dev/null @@ -1,123 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@setfilename ../info/external-widget.info - -@node Top, Using an External Client Widget,, (dir) - -An @dfn{external client widget} is a widget that is part of another program -but functions as an Emacs frame. This is intended to be a more -powerful replacement for standard text widgets. - -@menu -* Using an External Client Widget:: -* External Client Widget Resource Settings:: -* Motif-Specific Info About the External Client Widget:: -@end menu - - -@node Using an External Client Widget, External Client Widget Resource Settings, Top, Top -@chapter Using an External Client Widget - -There are three different implementations of the external client widget. -One is designed for use in Motif applications and is linked with the -option @code{-lextcli_Xm}. Another is designed for non-Motif -applications that still use the X toolkit; it is linked with the option -@code{-lextcli_Xt}. The third is designed for applications that do not -use the X toolkit; it is linked with the option @code{-lextcli_Xlib}. -In order to use an external client widget in a client program that uses -the X toolkit (i.e. either of the first two options described above), -simply create an instance of widget type ExternalClient and link your -program with the appropriate library. The corresponding header file is -called @file{ExternalClient.h}. - -Documentation still needs to be provided for using the raw Xlib -version of the external client widget. - -The external client widget will not do anything until an instance of -Emacs is told about this particular widget. To do that, call the -function @code{make-frame}, specifying a value for the frame parameter -@code{window-id}. This value should be a string containing the decimal -representation of the widget's X window ID number (this can be obtained -by the Xt function @code{XtWindow()}). In order for the client program -to communicate this information to Emacs, a method such as sending a -ToolTalk message needs to be used. - -Once @code{make-frame} has been called, Emacs will create a frame -that occupies the client widget's window. This frame can be used just -like any other frame in Emacs. - - -@node External Client Widget Resource Settings, Motif-Specific Info About the External Client Widget, Using an External Client Widget, Top -@chapter External Client Widget Resource Settings - -The external client widget is a subclass of the Motif widget XmPrimitive -and thus inherits all its resources. In addition, the following new -resources are defined: - -@table @samp -@item deadShell (class DeadShell) -A boolean resource indicating whether the last request to the -ExternalShell widget that contains the frame corresponding to this -widget timed out. If true, no further requests will be made (all -requests will automatically fail) until a response to the last -request is received. This resource should normally not be set by the -user. - -@item shellTimeout (class ShellTimeout) -A value specifying how long (in milliseconds) the client should wait -for a response when making a request to the corresponding ExternalShell -widget. If this timeout is exceeded, the client will assume that the -shell is dead and will fail the request and all subsequent requests -until a response to the request is received. Default value is 5000, -or 5 seconds. -@end table - -The shell that contains the frame corresponding to an external client -widget is of type ExternalShell, as opposed to standard frames, whose -shell is of type TopLevelShell. The ExternalShell widget is a direct -subclass of Shell and thus inherits its resources. In addition, the -following new resources are defined: - -@table @samp -@item window (class Window) -The X window ID of the widget to use for this Emacs frame. This is -normally set by the call to @code{x-create-frame} and should not be -modified by the user. - -@item deadClient (class DeadClient) -A boolean resource indicating whether the last request to the -corresponding ExternalClient widget timed out. If true, no further -requests will be made (all requests will automatically fail) until a -response to the last request is received. This resource should -normally not be set by the user. - -@item ClientTimeout (class ClientTimeout) -A value specifying how long (in milliseconds) the shell should wait -for a response when making a request to the corresponding ExternalClient -widget. If this timeout is exceeded, the shell will assume that the -client is dead and will fail the request and all subsequent requests -until a response to the request is received. Default value is 5000, -or 5 seconds. -@end table - -Note that the requests that are made between the client and the shell -are primarily for handling query-geometry and geometry-manager requests -made by parent or child widgets. - - -@node Motif-Specific Info About the External Client Widget, , External Client Widget Resource Settings, Top -@chapter Motif-Specific Info About the External Client Widget - -By default, the external client widget has navigation type -@samp{XmTAB_GROUP}. - -The widget traversal keystrokes are modified slightly from the standard -XmPrimitive keystrokes. In particular, @kbd{@key{TAB}} alone does not -traverse to the next widget (@kbd{Ctrl-@key{TAB}} must be used instead), -but functions like a normal @key{TAB} in Emacs. This follows the -semantics of the Motif text widget. The traversal keystrokes -@kbd{Ctrl-@key{TAB}} and @kbd{Shift-@key{TAB}} are silently filtered by -the external client widget and are not seen by Emacs. - -@summarycontents -@contents -@bye diff --git a/man/info.texi b/man/info.texi deleted file mode 100644 index d2fda6f..0000000 --- a/man/info.texi +++ /dev/null @@ -1,911 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@comment %**start of header -@setfilename ../info/info.info -@settitle Info 1.0 -@comment %**end of header -@comment $Id: info.texi,v 1.4 1997/07/10 21:58:11 karl Exp $ - -@dircategory Texinfo documentation system -@direntry -* Info: (info). Documentation browsing system. -@end direntry - -@ifinfo -This file describes how to use Info, -the on-line, menu-driven GNU documentation system. - -Copyright (C) 1989, 92, 96, 97 Free Software Foundation, Inc. - -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 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 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 Info -@subtitle The online, menu-driven GNU documentation system -@author Brian Fox -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1989, 1992, 1993, 1996, 1997 Free Software -Foundation, Inc. -@sp 2 - -Published by the Free Software Foundation @* -59 Temple Place - Suite 330 @* -Boston, MA 02111-1307, USA. - -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 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, Getting Started, , (dir) -@top Info: An Introduction - -Info is a program for reading documentation, which you are using now. - -To learn how to use Info, type the command @kbd{h}. It brings you -to a programmed instruction sequence. - -@c Need to make sure that `Info-help' goes to the right node, -@c which is the first node of the first chapter. (It should.) -@c (Info-find-node "info" -@c (if (< (window-height) 23) -@c "Help-Small-Screen" -@c "Help"))) - -To learn advanced Info commands, type @kbd{n} twice. This brings you to -@cite{Info for Experts}, skipping over the `Getting Started' chapter. -@end ifinfo - -@menu -* Getting Started:: Getting started using an Info reader. -* Advanced Info:: Advanced commands within Info. -* Create an Info File:: How to make your own Info file. -* The Standalone Info Program: (info-stnd.info). -@end menu - -@node Getting Started, Advanced Info, Top, Top -@comment node-name, next, previous, up -@chapter Getting Started - -This first part of the Info manual describes how to get around inside -of Info. The second part of the manual describes various advanced -Info commands, and how to write an Info as distinct from a Texinfo -file. The third part is about how to generate Info files from -Texinfo files. - -@iftex -This manual is primarily designed for use on a computer, so that you can -try Info commands while reading about them. Reading it on paper is less -effective, since you must take it on faith that the commands described -really do what the manual says. By all means go through this manual now -that you have it; but please try going through the on-line version as -well. - -There are two ways of looking at the online version of this manual: - -@enumerate -@item -Type @code{info} at your shell's command line. This approach uses a -small stand-alone program designed just to read Info files. - -@item -Type @code{emacs} at the command line; then type @kbd{C-h i} (Control -@kbd{h}, followed by @kbd{i}). This approach uses the Info mode of the -Emacs program, an editor with many other capabilities. -@end enumerate - -In either case, then type @kbd{mInfo} (just the letters), followed by -@key{RET}---the ``Return'' or ``Enter'' key. At this point, you should -be ready to follow the instructions in this manual as you read them on -the screen. -@c FIXME! (pesch@cygnus.com, 14 dec 1992) -@c Is it worth worrying about what-if the beginner goes to somebody -@c else's Emacs session, which already has an Info running in the middle -@c of something---in which case these simple instructions won't work? -@end iftex - -@menu -* Help-Small-Screen:: Starting Info on a Small Screen -* Help:: How to use Info -* Help-P:: Returning to the Previous node -* Help-^L:: The Space, Rubout, B and ^L commands. -* Help-M:: Menus -* Help-Adv:: Some advanced Info commands -* Help-Q:: Quitting Info -@end menu - -@node Help-Small-Screen, Help, , Getting Started -@comment node-name, next, previous, up -@section Starting Info on a Small Screen - -@iftex -(In Info, you only see this section if your terminal has a small -number of lines; most readers pass by it without seeing it.) -@end iftex - -Since your terminal has an unusually small number of lines on its -screen, it is necessary to give you special advice at the beginning. - -If you see the text @samp{--All----} at near the bottom right corner -of the screen, it means the entire text you are looking at fits on the -screen. If you see @samp{--Top----} instead, it means that there is -more text below that does not fit. To move forward through the text -and see another screen full, press the Space bar, @key{SPC}. To move -back up, press the key labeled @samp{Backspace} or @key{Delete}. - -@ifinfo -Here are 40 lines of junk, so you can try Spaces and Deletes and -see what they do. At the end are instructions of what you should do -next. - -This is line 17 @* -This is line 18 @* -This is line 19 @* -This is line 20 @* -This is line 21 @* -This is line 22 @* -This is line 23 @* -This is line 24 @* -This is line 25 @* -This is line 26 @* -This is line 27 @* -This is line 28 @* -This is line 29 @* -This is line 30 @* -This is line 31 @* -This is line 32 @* -This is line 33 @* -This is line 34 @* -This is line 35 @* -This is line 36 @* -This is line 37 @* -This is line 38 @* -This is line 39 @* -This is line 40 @* -This is line 41 @* -This is line 42 @* -This is line 43 @* -This is line 44 @* -This is line 45 @* -This is line 46 @* -This is line 47 @* -This is line 48 @* -This is line 49 @* -This is line 50 @* -This is line 51 @* -This is line 52 @* -This is line 53 @* -This is line 54 @* -This is line 55 @* -This is line 56 @* - -If you have managed to get here, go back to the beginning with -Delete, and come back here again, then you understand Space and -Delete. So now type an @kbd{n} ---just one character; don't type -the quotes and don't type the Return key afterward--- to -get to the normal start of the course. -@end ifinfo - -@node Help, Help-P, Help-Small-Screen, Getting Started -@comment node-name, next, previous, up -@section How to use Info - -You are talking to the program Info, for reading documentation. - - Right now you are looking at one @dfn{Node} of Information. -A node contains text describing a specific topic at a specific -level of detail. This node's topic is ``how to use Info''. - - The top line of a node is its @dfn{header}. This node's header (look at -it now) says that it is the node named @samp{Help} in the file -@file{info}. It says that the @samp{Next} node after this one is the node -called @samp{Help-P}. An advanced Info command lets you go to any node -whose name you know. - - Besides a @samp{Next}, a node can have a @samp{Previous} or an @samp{Up}. -This node has a @samp{Previous} but no @samp{Up}, as you can see. - - Now it is time to move on to the @samp{Next} node, named @samp{Help-P}. - ->> Type @samp{n} to move there. Type just one character; - do not type the quotes and do not type a @key{RET} afterward. - -@samp{>>} in the margin means it is really time to try a command. - -@node Help-P, Help-^L, Help, Getting Started -@comment node-name, next, previous, up -@section Returning to the Previous node - -This node is called @samp{Help-P}. The @samp{Previous} node, as you see, -is @samp{Help}, which is the one you just came from using the @kbd{n} -command. Another @kbd{n} command now would take you to the next -node, @samp{Help-^L}. - ->> But do not do that yet. First, try the @kbd{p} command, which takes - you to the @samp{Previous} node. When you get there, you can do an - @kbd{n} again to return here. - - This all probably seems insultingly simple so far, but @emph{do not} be -led into skimming. Things will get more complicated soon. Also, -do not try a new command until you are told it is time to. Otherwise, -you may make Info skip past an important warning that was coming up. - ->> Now do an @kbd{n} to get to the node @samp{Help-^L} and learn more. - -@node Help-^L, Help-M, Help-P, Getting Started -@comment node-name, next, previous, up -@section The Space, Delete, B and ^L commands. - - This node's header tells you that you are now at node @samp{Help-^L}, and -that @kbd{p} would get you back to @samp{Help-P}. The node's title is -underlined; it says what the node is about (most nodes have titles). - - This is a big node and it does not all fit on your display screen. -You can tell that there is more that is not visible because you -can see the string @samp{--Top-----} rather than @samp{--All----} near -the bottom right corner of the screen. - - The Space, Delete and @kbd{B} commands exist to allow you to ``move -around'' in a node that does not all fit on the screen at once. -Space moves forward, to show what was below the bottom of the screen. -Delete moves backward, to show what was above the top of the screen -(there is not anything above the top until you have typed some spaces). - ->> Now try typing a Space (afterward, type a Delete to return here). - - When you type the space, the two lines that were at the bottom of -the screen appear at the top, followed by more lines. Delete takes -the two lines from the top and moves them to the bottom, -@emph{usually}, but if there are not a full screen's worth of lines -above them they may not make it all the way to the bottom. - - If you type Space when there is no more to see, it rings the -bell and otherwise does nothing. The same goes for Delete when -the header of the node is visible. - - If your screen is ever garbaged, you can tell Info to print it out -again by typing @kbd{C-l} (@kbd{Control-L}, that is---hold down ``Control'' and -type an @key{L} or @kbd{l}). - ->> Type @kbd{C-l} now. - - To move back to the beginning of the node you are on, you can type -a lot of Deletes. You can also type simply @kbd{b} for beginning. ->> Try that now. (We have put in enough verbiage to push this past -the first screenful, but screens are so big nowadays that perhaps it -isn't enough. You may need to shrink your Emacs or Info window.) -Then come back, with Spaces. - - If your screen is very tall, all of this node might fit at once. -In that case, "b" won't do anything. Sorry; what can we do? - - You have just learned a considerable number of commands. If you -want to use one but have trouble remembering which, you should type -a @key{?} which prints out a brief list of commands. When you are -finished looking at the list, make it go away by pressing @key{SPC} -repeatedly. - ->> Type a @key{?} now. Press @key{SPC} to see consecutive screenfuls of ->> the list until finished. - - From now on, you will encounter large nodes without warning, and -will be expected to know how to use Space and Delete to move -around in them without being told. Since not all terminals have -the same size screen, it would be impossible to warn you anyway. - ->> Now type @kbd{n} to see the description of the @kbd{m} command. - -@node Help-M, Help-Adv, Help-^L, Getting Started -@comment node-name, next, previous, up -@section Menus - -Menus and the @kbd{m} command - - With only the @kbd{n} and @kbd{p} commands for moving between nodes, nodes -are restricted to a linear sequence. Menus allow a branching -structure. A menu is a list of other nodes you can move to. It is -actually just part of the text of the node formatted specially so that -Info can interpret it. The beginning of a menu is always identified -by a line which starts with @samp{* Menu:}. A node contains a menu if and -only if it has a line in it which starts that way. The only menu you -can use at any moment is the one in the node you are in. To use a -menu in any other node, you must move to that node first. - - After the start of the menu, each line that starts with a @samp{*} -identifies one subtopic. The line usually contains a brief name -for the subtopic (followed by a @samp{:}), the name of the node that talks -about that subtopic, and optionally some further description of the -subtopic. Lines in the menu that do not start with a @samp{*} have no -special meaning---they are only for the human reader's benefit and do -not define additional subtopics. Here is an example: - -@example -* Foo: FOO's Node This tells about FOO -@end example - -The subtopic name is Foo, and the node describing it is @samp{FOO's Node}. -The rest of the line is just for the reader's Information. -[[ But this line is not a real menu item, simply because there is -no line above it which starts with @samp{* Menu:}.]] - - When you use a menu to go to another node (in a way that will be -described soon), what you specify is the subtopic name, the first -thing in the menu line. Info uses it to find the menu line, extracts -the node name from it, and goes to that node. The reason that there -is both a subtopic name and a node name is that the node name must be -meaningful to the computer and may therefore have to be ugly looking. -The subtopic name can be chosen just to be convenient for the user to -specify. Often the node name is convenient for the user to specify -and so both it and the subtopic name are the same. There is an -abbreviation for this: - -@example -* Foo:: This tells about FOO -@end example - -@noindent -This means that the subtopic name and node name are the same; they are -both @samp{Foo}. - ->> Now use Spaces to find the menu in this node, then come back to - the front with a @kbd{b} and some Spaces. As you see, a menu is - actually visible in its node. If you cannot find a menu in a node - by looking at it, then the node does not have a menu and the - @kbd{m} command is not available. - - The command to go to one of the subnodes is @kbd{m}---but @emph{do -not do it yet!} Before you use @kbd{m}, you must understand the -difference between commands and arguments. So far, you have learned -several commands that do not need arguments. When you type one, Info -processes it and is instantly ready for another command. The @kbd{m} -command is different: it is incomplete without the @dfn{name of the -subtopic}. Once you have typed @kbd{m}, Info tries to read the -subtopic name. - - Now look for the line containing many dashes near the bottom of the -screen. There is one more line beneath that one, but usually it is -blank. If it is empty, Info is ready for a command, such as @kbd{n} -or @kbd{b} or Space or @kbd{m}. If that line contains text ending -in a colon, it means Info is trying to read the @dfn{argument} to a -command. At such times, commands do not work, because Info tries to -use them as the argument. You must either type the argument and -finish the command you started, or type @kbd{Control-g} to cancel the -command. When you have done one of those things, the line becomes -blank again. - - The command to go to a subnode via a menu is @kbd{m}. After you type -the @kbd{m}, the line at the bottom of the screen says @samp{Menu item: }. -You must then type the name of the subtopic you want, and end it with -a @key{RET}. - - You can abbreviate the subtopic name. If the abbreviation is not -unique, the first matching subtopic is chosen. Some menus put -the shortest possible abbreviation for each subtopic name in capital -letters, so you can see how much you need to type. It does not -matter whether you use upper case or lower case when you type the -subtopic. You should not put any spaces at the end, or inside of the -item name, except for one space where a space appears in the item in -the menu. - - You can also use the @dfn{completion} feature to help enter the subtopic -name. If you type the Tab key after entering part of a name, it will -magically fill in more of the name---as much as follows uniquely from -what you have entered. - - If you move the cursor to one of the menu subtopic lines, then you do -not need to type the argument: you just type a Return, and it stands for -the subtopic of the line you are on. - -Here is a menu to give you a chance to practice. - -* Menu: The menu starts here. - -This menu gives you three ways of going to one place, Help-FOO. - -* Foo: Help-FOO. A node you can visit for fun.@* -* Bar: Help-FOO. Strange! two ways to get to the same place.@* -* Help-FOO:: And yet another!@* - - ->> Now type just an @kbd{m} and see what happens: - - Now you are ``inside'' an @kbd{m} command. Commands cannot be used -now; the next thing you will type must be the name of a subtopic. - - You can change your mind about doing the @kbd{m} by typing Control-g. - ->> Try that now; notice the bottom line clear. - ->> Then type another @kbd{m}. - ->> Now type @samp{BAR} item name. Do not type Return yet. - - While you are typing the item name, you can use the Delete key to -cancel one character at a time if you make a mistake. - ->> Type one to cancel the @samp{R}. You could type another @samp{R} to - replace it. You do not have to, since @samp{BA} is a valid abbreviation. - ->> Now you are ready to go. Type a @key{RET}. - - After visiting Help-FOO, you should return here. - ->> Type @kbd{n} to see more commands. - -@c If a menu appears at the end of this node, remove it. -@c It is an accident of the menu updating command. - -Here is another way to get to Help-FOO, a menu. You can ignore this -if you want, or else try it (but then please come back to here). - -@menu -* Help-FOO:: -@end menu - -@node Help-FOO, , , Help-M -@comment node-name, next, previous, up -@subsection The @kbd{u} command - - Congratulations! This is the node @samp{Help-FOO}. Unlike the other -nodes you have seen, this one has an @samp{Up}: @samp{Help-M}, the node you -just came from via the @kbd{m} command. This is the usual -convention---the nodes you reach from a menu have @samp{Up} nodes that lead -back to the menu. Menus move Down in the tree, and @samp{Up} moves Up. -@samp{Previous}, on the other hand, is usually used to ``stay on the same -level but go backwards'' - - You can go back to the node @samp{Help-M} by typing the command -@kbd{u} for ``Up''. That puts you at the @emph{front} of the -node---to get back to where you were reading you have to type -some @key{SPC}s. - ->> Now type @kbd{u} to move back up to @samp{Help-M}. - -@node Help-Adv, Help-Q, Help-M, Getting Started -@comment node-name, next, previous, up -@section Some advanced Info commands - - The course is almost over, so please stick with it to the end. - - If you have been moving around to different nodes and wish to -retrace your steps, the @kbd{l} command (@kbd{l} for @dfn{last}) will -do that, one node-step at a time. As you move from node to node, Info -records the nodes where you have been in a special history list. The -@kbd{l} command revisits nodes in the history list; each successive -@kbd{l} command moves one step back through the history. - - If you have been following directions, ad @kbd{l} command now will get -you back to @samp{Help-M}. Another @kbd{l} command would undo the -@kbd{u} and get you back to @samp{Help-FOO}. Another @kbd{l} would undo -the @kbd{m} and get you back to @samp{Help-M}. - ->> Try typing three @kbd{l}'s, pausing in between to see what each - @kbd{l} does. - -Then follow directions again and you will end up back here. - - Note the difference between @kbd{l} and @kbd{p}: @kbd{l} moves to -where @emph{you} last were, whereas @kbd{p} always moves to the node -which the header says is the @samp{Previous} node (from this node, to -@samp{Help-M}). - - The @samp{d} command gets you instantly to the Directory node. -This node, which is the first one you saw when you entered Info, -has a menu which leads (directly, or indirectly through other menus), -to all the nodes that exist. - ->> Try doing a @samp{d}, then do an @kbd{l} to return here (yes, - @emph{do} return). - - Sometimes, in Info documentation, you will see a cross reference. -Cross references look like this: @xref{Help-Cross, Cross}. That is a -real, live cross reference which is named @samp{Cross} and points at -the node named @samp{Help-Cross}. - - If you wish to follow a cross reference, you must use the @samp{f} -command. The @samp{f} must be followed by the cross reference name -(in this case, @samp{Cross}). While you enter the name, you can use the -Delete key to edit your input. If you change your mind about following -any reference, you can use @kbd{Control-g} to cancel the command. - - Completion is available in the @samp{f} command; you can complete among -all the cross reference names in the current node by typing a Tab. - ->> Type @samp{f}, followed by @samp{Cross}, and a @key{RET}. - - To get a list of all the cross references in the current node, you can -type @kbd{?} after an @samp{f}. The @samp{f} continues to await a -cross reference name even after printing the list, so if you don't -actually want to follow a reference, you should type a @kbd{Control-g} -to cancel the @samp{f}. - ->> Type "f?" to get a list of the cross references in this node. Then - type a @kbd{Control-g} and see how the @samp{f} gives up. - ->> Now type @kbd{n} to see the last node of the course. - -@c If a menu appears at the end of this node, remove it. -@c It is an accident of the menu updating command. - -@node Help-Cross, , , Help-Adv -@comment node-name, next, previous, up -@unnumberedsubsec The node reached by the cross reference in Info - - This is the node reached by the cross reference named @samp{Cross}. - - While this node is specifically intended to be reached by a cross -reference, most cross references lead to nodes that ``belong'' -someplace else far away in the structure of Info. So you cannot expect -the footnote to have a @samp{Next}, @samp{Previous} or @samp{Up} pointing back to -where you came from. In general, the @kbd{l} (el) command is the only -way to get back there. - ->> Type @kbd{l} to return to the node where the cross reference was. - -@node Help-Q, , Help-Adv, Getting Started -@comment node-name, next, previous, up -@section Quitting Info - - To get out of Info, back to what you were doing before, type @kbd{q} -for @dfn{Quit}. - - This is the end of the course on using Info. There are some other -commands that are meant for experienced users; they are useful, and you -can find them by looking in the directory node for documentation on -Info. Finding them will be a good exercise in using Info in the usual -manner. - ->> Type @samp{d} to go to the Info directory node; then type - @samp{mInfo} and Return, to get to the node about Info and - see what other help is available. - -@node Advanced Info, Create an Info File, Getting Started, Top -@comment node-name, next, previous, up -@chapter Info for Experts - -This chapter describes various advanced Info commands, and how to write -an Info as distinct from a Texinfo file. (However, in most cases, writing a -Texinfo file is better, since you can use it @emph{both} to generate an -Info file and to make a printed manual. @xref{Top,, Overview of -Texinfo, texinfo, Texinfo: The GNU Documentation Format}.) - -@menu -* Expert:: Advanced Info commands: g, s, e, and 1 - 5. -* Add:: Describes how to add new nodes to the hierarchy. - Also tells what nodes look like. -* Menus:: How to add to or create menus in Info nodes. -* Cross-refs:: How to add cross-references to Info nodes. -* Tags:: How to make tag tables for Info files. -* Checking:: Checking an Info File -* Emacs Info Variables:: Variables modifying the behavior of Emacs Info. -@end menu - -@node Expert, Add, , Advanced Info -@comment node-name, next, previous, up -@section Advanced Info Commands - -@kbd{g}, @kbd{s}, @kbd{1}, -- @kbd{9}, and @kbd{e} - -If you know a node's name, you can go there by typing @kbd{g}, the -name, and @key{RET}. Thus, @kbd{gTop@key{RET}} would go to the node -called @samp{Top} in this file (its directory node). -@kbd{gExpert@key{RET}} would come back here. - -Unlike @kbd{m}, @kbd{g} does not allow the use of abbreviations. - -To go to a node in another file, you can include the filename in the -node name by putting it at the front, in parentheses. Thus, -@kbd{g(dir)Top@key{RET}} would go to the Info Directory node, which is -node @samp{Top} in the file @file{dir}. - -The node name @samp{*} specifies the whole file. So you can look at -all of the current file by typing @kbd{g*@key{RET}} or all of any -other file with @kbd{g(FILENAME)@key{RET}}. - -The @kbd{s} command allows you to search a whole file for a string. -It switches to the next node if and when that is necessary. You -type @kbd{s} followed by the string to search for, terminated by -@key{RET}. To search for the same string again, just @kbd{s} followed -by @key{RET} will do. The file's nodes are scanned in the order -they are in in the file, which has no necessary relationship to the -order that they may be in in the tree structure of menus and @samp{next} pointers. -But normally the two orders are not very different. In any case, -you can always do a @kbd{b} to find out what node you have reached, if -the header is not visible (this can happen, because @kbd{s} puts your -cursor at the occurrence of the string, not at the beginning of the -node). - -If you grudge the system each character of type-in it requires, you -might like to use the commands @kbd{1}, @kbd{2}, @kbd{3}, @kbd{4}, ... -@kbd{9}. They are short for the @kbd{m} command together with an -argument. @kbd{1} goes through the first item in the current node's -menu; @kbd{2} goes through the second item, etc. - -If you display supports multiple fonts, and you are using Emacs' Info -mode to read Info files, the @samp{*} for the fifth menu item is -underlines, and so is the @samp{*} for the ninth item; these underlines -make it easy to see at a glance which number to use for an item. - -On ordinary terminals, you won't have underlining. If you need to -actually count items, it is better to use @kbd{m} instead, and specify -the name. - -The Info command @kbd{e} changes from Info mode to an ordinary -Emacs editing mode, so that you can edit the text of the current node. -Type @kbd{C-c C-c} to switch back to Info. The @kbd{e} command is allowed -only if the variable @code{Info-enable-edit} is non-@code{nil}. - -@node Add, Menus, Expert, Advanced Info -@comment node-name, next, previous, up -@section Adding a new node to Info - -To add a new topic to the list in the Info directory, you must: -@enumerate -@item -Create some nodes, in some file, to document that topic. -@item -Put that topic in the menu in the directory. @xref{Menus, Menu}. -@end enumerate - -Usually, the way to create the nodes is with Texinfo @pxref{Top,, Overview of -Texinfo, texinfo, Texinfo: The GNU Documentation Format}); this has the -advantage that you can also make a printed manual from them. However, -if hyou want to edit an Info file, here is how. - - The new node can live in an existing documentation file, or in a new -one. It must have a @key{^_} character before it (invisible to the -user; this node has one but you cannot see it), and it ends with either -a @key{^_}, a @key{^L}, or the end of file. Note: If you put in a -@key{^L} to end a new node, be sure that there is a @key{^_} after it -to start the next one, since @key{^L} cannot @emph{start} a node. -Also, a nicer way to make a node boundary be a page boundary as well -is to put a @key{^L} @emph{right after} the @key{^_}. - - The @key{^_} starting a node must be followed by a newline or a -@key{^L} newline, after which comes the node's header line. The -header line must give the node's name (by which Info finds it), -and state the names of the @samp{Next}, @samp{Previous}, and @samp{Up} nodes (if -there are any). As you can see, this node's @samp{Up} node is the node -@samp{Top}, which points at all the documentation for Info. The @samp{Next} -node is @samp{Menus}. - - The keywords @dfn{Node}, @dfn{Previous}, @dfn{Up}, and @dfn{Next}, -may appear in any order, anywhere in the header line, but the -recommended order is the one in this sentence. Each keyword must be -followed by a colon, spaces and tabs, and then the appropriate name. -The name may be terminated with a tab, a comma, or a newline. A space -does not end it; node names may contain spaces. The case of letters -in the names is insignificant. - - A node name has two forms. A node in the current file is named by -what appears after the @samp{Node: } in that node's first line. For -example, this node's name is @samp{Add}. A node in another file is -named by @samp{(@var{filename})@var{node-within-file}}, as in -@samp{(info)Add} for this node. If the file name starts with ``./'', -then it is relative to the current directory; otherwise, it is relative -starting from the standard Info file directory of your site. -The name @samp{(@var{filename})Top} can be abbreviated to just -@samp{(@var{filename})}. By convention, the name @samp{Top} is used for -the ``highest'' node in any single file---the node whose @samp{Up} points -out of the file. The Directory node is @file{(dir)}. The @samp{Top} node -of a document file listed in the Directory should have an @samp{Up: -(dir)} in it. - - The node name @kbd{*} is special: it refers to the entire file. -Thus, @kbd{g*} shows you the whole current file. The use of the -node @kbd{*} is to make it possible to make old-fashioned, -unstructured files into nodes of the tree. - - The @samp{Node:} name, in which a node states its own name, must not -contain a filename, since Info when searching for a node does not -expect one to be there. The @samp{Next}, @samp{Previous} and @samp{Up} names may -contain them. In this node, since the @samp{Up} node is in the same file, -it was not necessary to use one. - - Note that the nodes in this file have a file name in the header -line. The file names are ignored by Info, but they serve as comments -to help identify the node for the user. - -@node Menus, Cross-refs, Add, Advanced Info -@comment node-name, next, previous, up -@section How to Create Menus - - Any node in the Info hierarchy may have a @dfn{menu}---a list of subnodes. -The @kbd{m} command searches the current node's menu for the topic which it -reads from the terminal. - - A menu begins with a line starting with @samp{* Menu:}. The rest of the -line is a comment. After the starting line, every line that begins -with a @samp{* } lists a single topic. The name of the topic--the -argument that the user must give to the @kbd{m} command to select this -topic---comes right after the star and space, and is followed by a -colon, spaces and tabs, and the name of the node which discusses that -topic. The node name, like node names following @samp{Next}, @samp{Previous} -and @samp{Up}, may be terminated with a tab, comma, or newline; it may also -be terminated with a period. - - If the node name and topic name are the same, then rather than -giving the name twice, the abbreviation @samp{* NAME::} may be used -(and should be used, whenever possible, as it reduces the visual -clutter in the menu). - - It is considerate to choose the topic names so that they differ -from each other very near the beginning---this allows the user to type -short abbreviations. In a long menu, it is a good idea to capitalize -the beginning of each item name which is the minimum acceptable -abbreviation for it (a long menu is more than 5 or so entries). - - The nodes listed in a node's menu are called its ``subnodes'', and -it is their ``superior''. They should each have an @samp{Up:} pointing at -the superior. It is often useful to arrange all or most of the -subnodes in a sequence of @samp{Next} and @samp{Previous} pointers so that someone who -wants to see them all need not keep revisiting the Menu. - - The Info Directory is simply the menu of the node @samp{(dir)Top}---that -is, node @samp{Top} in file @file{.../info/dir}. You can put new entries -in that menu just like any other menu. The Info Directory is @emph{not} the -same as the file directory called @file{info}. It happens that many of -Info's files live on that file directory, but they do not have to; and -files on that directory are not automatically listed in the Info -Directory node. - - Also, although the Info node graph is claimed to be a ``hierarchy'', -in fact it can be @emph{any} directed graph. Shared structures and -pointer cycles are perfectly possible, and can be used if they are -appropriate to the meaning to be expressed. There is no need for all -the nodes in a file to form a connected structure. In fact, this file -has two connected components. You are in one of them, which is under -the node @samp{Top}; the other contains the node @samp{Help} which the -@kbd{h} command goes to. In fact, since there is no garbage -collector, nothing terrible happens if a substructure is not pointed -to, but such a substructure is rather useless since nobody can -ever find out that it exists. - -@node Cross-refs, Tags, Menus, Advanced Info -@comment node-name, next, previous, up -@section Creating Cross References - - A cross reference can be placed anywhere in the text, unlike a menu -item which must go at the front of a line. A cross reference looks -like a menu item except that it has @samp{*note} instead of @kbd{*}. -It @emph{cannot} be terminated by a @samp{)}, because @samp{)}'s are -so often part of node names. If you wish to enclose a cross reference -in parentheses, terminate it with a period first. Here are two -examples of cross references pointers: - -@example -*Note details: commands. (See *note 3: Full Proof.) -@end example - -They are just examples. The places they ``lead to'' do not really exist! - -@node Tags, Checking, Cross-refs, Advanced Info -@comment node-name, next, previous, up -@section Tag Tables for Info Files - - You can speed up the access to nodes of a large Info file by giving -it a tag table. Unlike the tag table for a program, the tag table for -an Info file lives inside the file itself and is used -automatically whenever Info reads in the file. - - To make a tag table, go to a node in the file using Emacs Info mode and type -@kbd{M-x Info-tagify}. Then you must use @kbd{C-x C-s} to save the -file. - - Once the Info file has a tag table, you must make certain it is up -to date. If, as a result of deletion of text, any node moves back -more than a thousand characters in the file from the position -recorded in the tag table, Info will no longer be able to find that -node. To update the tag table, use the @code{Info-tagify} command again. - - An Info file tag table appears at the end of the file and looks like -this: - -@example -^_ -Tag Table: -File: info, Node: Cross-refs^?21419 -File: info, Node: Tags^?22145 -^_ -End Tag Table -@end example - -@noindent -Note that it contains one line per node, and this line contains -the beginning of the node's header (ending just after the node name), -a Delete character, and the character position in the file of the -beginning of the node. - -@node Checking, Emacs Info Variables, Tags, Advanced Info -@comment node-name, next, previous, up -@section Checking an Info File - - When creating an Info file, it is easy to forget the name of a node -when you are making a pointer to it from another node. If you put in -the wrong name for a node, this is not detected until someone -tries to go through the pointer using Info. Verification of the Info -file is an automatic process which checks all pointers to nodes and -reports any pointers which are invalid. Every @samp{Next}, @samp{Previous}, and -@samp{Up} is checked, as is every menu item and every cross reference. In -addition, any @samp{Next} which does not have a @samp{Previous} pointing back is -reported. Only pointers within the file are checked, because checking -pointers to other files would be terribly slow. But those are usually -few. - - To check an Info file, do @kbd{M-x Info-validate} while looking at -any node of the file with Emacs Info mode. - -@node Emacs Info Variables, , Checking, Advanced Info -@section Emacs Info-mode Variables - -The following variables may modify the behaviour of Info-mode in Emacs; -you may wish to set one or several of these variables interactively, or -in your @file{~/.emacs} init file. @xref{Examining, Examining and Setting -Variables, Examining and Setting Variables, emacs, The GNU Emacs -Manual}. - -@vtable @code -@item Info-enable-edit -Set to @code{nil}, disables the @samp{e} (@code{Info-edit}) command. A -non-@code{nil} value enables it. @xref{Add, Edit}. - -@item Info-enable-active-nodes -When set to a non-@code{nil} value, allows Info to execute Lisp code -associated with nodes. The Lisp code is executed when the node is -selected. - -@item Info-directory-list -The list of directories to search for Info files. Each element is a -string (directory name) or @code{nil} (try default directory). - -@item Info-directory -The standard directory for Info documentation files. Only used when the -function @code{Info-directory} is called. -@end vtable - -@node Create an Info File, , Advanced Info, Top -@comment node-name, next, previous, up -@chapter Creating an Info File from a Makeinfo file - -@code{makeinfo} is a utility that converts a Texinfo file into an Info -file; @code{texinfo-format-region} and @code{texinfo-format-buffer} are -GNU Emacs functions that do the same. - -@xref{Create an Info File, , Creating an Info File, texinfo, the Texinfo -Manual}, to learn how to create an Info file from a Texinfo file. - -@xref{Top,, Overview of Texinfo, texinfo, Texinfo: The GNU Documentation -Format}, to learn how to write a Texinfo file. - -@bye diff --git a/man/internals/internals.texi b/man/internals/internals.texi deleted file mode 100644 index f6894c5..0000000 --- a/man/internals/internals.texi +++ /dev/null @@ -1,7932 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@c %**start of header -@setfilename ../../info/internals.info -@settitle XEmacs Internals Manual -@c %**end of header - -@ifinfo - -Copyright @copyright{} 1992 - 1996 Ben Wing. -Copyright @copyright{} 1996, 1997 Sun Microsystems. -Copyright @copyright{} 1994 - 1998 Free Software Foundation. -Copyright @copyright{} 1994, 1995 Board of Trustees, University of Illinois. - - -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 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 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 Foundation. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. -@end ifinfo - -@c Combine indices. -@synindex cp fn -@syncodeindex vr fn -@syncodeindex ky fn -@syncodeindex pg fn -@syncodeindex tp fn - -@setchapternewpage odd -@finalout - -@titlepage -@title XEmacs Internals Manual -@subtitle Version 1.2, October 1998 - -@author Ben Wing -@author Martin Buchholz -@author Hrvoje Niksic -@page -@vskip 0pt plus 1fill - -@noindent -Copyright @copyright{} 1992 - 1996 Ben Wing. @* -Copyright @copyright{} 1996, 1997 Sun Microsystems, Inc. @* -Copyright @copyright{} 1994 - 1998 Free Software Foundation. @* -Copyright @copyright{} 1994, 1995 Board of Trustees, University of Illinois. - -@sp 2 -Version 1.2 @* -October 1998.@* - -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 ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. -@end titlepage -@page - -@node Top, A History of Emacs, (dir), (dir) - -@ifinfo -This Info file contains v1.0 of the XEmacs Internals Manual. -@end ifinfo - -@menu -* A History of Emacs:: Times, dates, important events. -* XEmacs From the Outside:: A broad conceptual overview. -* The Lisp Language:: An overview. -* XEmacs From the Perspective of Building:: -* XEmacs From the Inside:: -* The XEmacs Object System (Abstractly Speaking):: -* How Lisp Objects Are Represented in C:: -* Rules When Writing New C Code:: -* A Summary of the Various XEmacs Modules:: -* Allocation of Objects in XEmacs Lisp:: -* Events and the Event Loop:: -* Evaluation; Stack Frames; Bindings:: -* Symbols and Variables:: -* Buffers and Textual Representation:: -* MULE Character Sets and Encodings:: -* The Lisp Reader and Compiler:: -* Lstreams:: -* Consoles; Devices; Frames; Windows:: -* The Redisplay Mechanism:: -* Extents:: -* Faces and Glyphs:: -* Specifiers:: -* Menus:: -* Subprocesses:: -* Interface to X Windows:: -* Index:: Index including concepts, functions, variables, - and other terms. - - --- The Detailed Node Listing --- - -Here are other nodes that are inferiors of those already listed, -mentioned here so you can get to them in one step: - -A History of Emacs - -* Through Version 18:: Unification prevails. -* Lucid Emacs:: One version 19 Emacs. -* GNU Emacs 19:: The other version 19 Emacs. -* XEmacs:: The continuation of Lucid Emacs. - -Rules When Writing New C Code - -* General Coding Rules:: -* Writing Lisp Primitives:: -* Adding Global Lisp Variables:: -* Techniques for XEmacs Developers:: - -A Summary of the Various XEmacs Modules - -* Low-Level Modules:: -* Basic Lisp Modules:: -* Modules for Standard Editing Operations:: -* Editor-Level Control Flow Modules:: -* Modules for the Basic Displayable Lisp Objects:: -* Modules for other Display-Related Lisp Objects:: -* Modules for the Redisplay Mechanism:: -* Modules for Interfacing with the File System:: -* Modules for Other Aspects of the Lisp Interpreter and Object System:: -* Modules for Interfacing with the Operating System:: -* Modules for Interfacing with X Windows:: -* Modules for Internationalization:: - -Allocation of Objects in XEmacs Lisp - -* Introduction to Allocation:: -* Garbage Collection:: -* GCPROing:: -* Integers and Characters:: -* Allocation from Frob Blocks:: -* lrecords:: -* Low-level allocation:: -* Pure Space:: -* Cons:: -* Vector:: -* Bit Vector:: -* Symbol:: -* Marker:: -* String:: -* Compiled Function:: - -Events and the Event Loop - -* Introduction to Events:: -* Main Loop:: -* Specifics of the Event Gathering Mechanism:: -* Specifics About the Emacs Event:: -* The Event Stream Callback Routines:: -* Other Event Loop Functions:: -* Converting Events:: -* Dispatching Events; The Command Builder:: - -Evaluation; Stack Frames; Bindings - -* Evaluation:: -* Dynamic Binding; The specbinding Stack; Unwind-Protects:: -* Simple Special Forms:: -* Catch and Throw:: - -Symbols and Variables - -* Introduction to Symbols:: -* Obarrays:: -* Symbol Values:: - -Buffers and Textual Representation - -* Introduction to Buffers:: A buffer holds a block of text such as a file. -* The Text in a Buffer:: Representation of the text in a buffer. -* Buffer Lists:: Keeping track of all buffers. -* Markers and Extents:: Tagging locations within a buffer. -* Bufbytes and Emchars:: Representation of individual characters. -* The Buffer Object:: The Lisp object corresponding to a buffer. - -MULE Character Sets and Encodings - -* Character Sets:: -* Encodings:: -* Internal Mule Encodings:: - -Encodings - -* Japanese EUC (Extended Unix Code):: -* JIS7:: - -Internal Mule Encodings - -* Internal String Encoding:: -* Internal Character Encoding:: - -The Lisp Reader and Compiler - -Lstreams - -Consoles; Devices; Frames; Windows - -* Introduction to Consoles; Devices; Frames; Windows:: -* Point:: -* Window Hierarchy:: - -The Redisplay Mechanism - -* Critical Redisplay Sections:: -* Line Start Cache:: - -Extents - -* Introduction to Extents:: Extents are ranges over text, with properties. -* Extent Ordering:: How extents are ordered internally. -* Format of the Extent Info:: The extent information in a buffer or string. -* Zero-Length Extents:: A weird special case. -* Mathematics of Extent Ordering:: A rigorous foundation. -* Extent Fragments:: Cached information useful for redisplay. - -Faces and Glyphs - -Specifiers - -Menus - -Subprocesses - -Interface to X Windows - -@end menu - -@node A History of Emacs, XEmacs From the Outside, Top, Top -@chapter A History of Emacs -@cindex history of Emacs -@cindex Hackers (Steven Levy) -@cindex Levy, Steven -@cindex ITS (Incompatible Timesharing System) -@cindex Stallman, Richard -@cindex RMS -@cindex MIT -@cindex TECO -@cindex FSF -@cindex Free Software Foundation - - XEmacs is a powerful, customizable text editor and development -environment. It began as Lucid Emacs, which was in turn derived from -GNU Emacs, a program written by Richard Stallman of the Free Software -Foundation. GNU Emacs dates back to the 1970's, and was modelled -after a package called ``Emacs'', written in 1976, that was a set of -macros on top of TECO, an old, old text editor written at MIT on the -DEC PDP 10 under one of the earliest time-sharing operating systems, -ITS (Incompatible Timesharing System). (ITS dates back well before -Unix.) ITS, TECO, and Emacs were products of a group of people at MIT -who called themselves ``hackers'', who shared an idealistic belief -system about the free exchange of information and were fanatical in -their devotion to and time spent with computers. (The hacker -subculture dates back to the late 1950's at MIT and is described in -detail in Steven Levy's book @cite{Hackers}. This book also includes -a lot of information about Stallman himself and the development of -Lisp, a programming language developed at MIT that underlies Emacs.) - -@menu -* Through Version 18:: Unification prevails. -* Lucid Emacs:: One version 19 Emacs. -* GNU Emacs 19:: The other version 19 Emacs. -* GNU Emacs 20:: The other version 20 Emacs. -* XEmacs:: The continuation of Lucid Emacs. -@end menu - -@node Through Version 18 -@section Through Version 18 -@cindex Gosling, James -@cindex Great Usenet Renaming - - Although the history of the early versions of GNU Emacs is unclear, -the history is well-known from the middle of 1985. A time line is: - -@itemize @bullet -@item -GNU Emacs version 15 (15.34) was released sometime in 1984 or 1985 and -shared some code with a version of Emacs written by James Gosling (the -same James Gosling who later created the Java language). -@item -GNU Emacs version 16 (first released version was 16.56) was released on -July 15, 1985. All Gosling code was removed due to potential copyright -problems with the code. -@item -version 16.57: released on September 16, 1985. -@item -versions 16.58, 16.59: released on September 17, 1985. -@item -version 16.60: released on September 19, 1985. These later version 16's -incorporated patches from the net, esp. for getting Emacs to work under -System V. -@item -version 17.36 (first official v17 release) released on December 20, -1985. Included a TeX-able user manual. First official unpatched -version that worked on vanilla System V machines. -@item -version 17.43 (second official v17 release) released on January 25, -1986. -@item -version 17.45 released on January 30, 1986. -@item -version 17.46 released on February 4, 1986. -@item -version 17.48 released on February 10, 1986. -@item -version 17.49 released on February 12, 1986. -@item -version 17.55 released on March 18, 1986. -@item -version 17.57 released on March 27, 1986. -@item -version 17.58 released on April 4, 1986. -@item -version 17.61 released on April 12, 1986. -@item -version 17.63 released on May 7, 1986. -@item -version 17.64 released on May 12, 1986. -@item -version 18.24 (a beta version) released on October 2, 1986. -@item -version 18.30 (a beta version) released on November 15, 1986. -@item -version 18.31 (a beta version) released on November 23, 1986. -@item -version 18.32 (a beta version) released on December 7, 1986. -@item -version 18.33 (a beta version) released on December 12, 1986. -@item -version 18.35 (a beta version) released on January 5, 1987. -@item -version 18.36 (a beta version) released on January 21, 1987. -@item -January 27, 1987: The Great Usenet Renaming. net.emacs is now -comp.emacs. -@item -version 18.37 (a beta version) released on February 12, 1987. -@item -version 18.38 (a beta version) released on March 3, 1987. -@item -version 18.39 (a beta version) released on March 14, 1987. -@item -version 18.40 (a beta version) released on March 18, 1987. -@item -version 18.41 (the first ``official'' release) released on March 22, -1987. -@item -version 18.45 released on June 2, 1987. -@item -version 18.46 released on June 9, 1987. -@item -version 18.47 released on June 18, 1987. -@item -version 18.48 released on September 3, 1987. -@item -version 18.49 released on September 18, 1987. -@item -version 18.50 released on February 13, 1988. -@item -version 18.51 released on May 7, 1988. -@item -version 18.52 released on September 1, 1988. -@item -version 18.53 released on February 24, 1989. -@item -version 18.54 released on April 26, 1989. -@item -version 18.55 released on August 23, 1989. This is the earliest version -that is still available by FTP. -@item -version 18.56 released on January 17, 1991. -@item -version 18.57 released late January, 1991. -@item -version 18.58 released ?????. -@item -version 18.59 released October 31, 1992. -@end itemize - -@node Lucid Emacs -@section Lucid Emacs -@cindex Lucid Emacs -@cindex Lucid Inc. -@cindex Energize -@cindex Epoch - - Lucid Emacs was developed by the (now-defunct) Lucid Inc., a maker of -C++ and Lisp development environments. It began when Lucid decided they -wanted to use Emacs as the editor and cornerstone of their C++ -development environment (called ``Energize''). They needed many features -that were not available in the existing version of GNU Emacs (version -18.5something), in particular good and integrated support for GUI -elements such as mouse support, multiple fonts, multiple window-system -windows, etc. A branch of GNU Emacs called Epoch, written at the -University of Illinois, existed that supplied many of these features; -however, Lucid needed more than what existed in Epoch. At the time, the -Free Software Foundation was working on version 19 of Emacs (this was -sometime around 1991), which was planned to have similar features, and -so Lucid decided to work with the Free Software Foundation. Their plan -was to add features that they needed, and coordinate with the FSF so -that the features would get included back into Emacs version 19. - - Delays in the release of version 19 occurred, however (resulting in it -finally being released more than a year after what was initially -planned), and Lucid encountered unexpected technical resistance in -getting their changes merged back into version 19, so they decided to -release their own version of Emacs, which became Lucid Emacs 19.0. - -@cindex Zawinski, Jamie -@cindex Sexton, Harlan -@cindex Benson, Eric -@cindex Devin, Matthieu - The initial authors of Lucid Emacs were Matthieu Devin, Harlan Sexton, -and Eric Benson, and the work was later taken over by Jamie Zawinski, -who became ``Mr. Lucid Emacs'' for many releases. - - A time line for Lucid Emacs/XEmacs is - -@itemize @bullet -@item -version 19.0 shipped with Energize 1.0, April 1992. -@item -version 19.1 released June 4, 1992. -@item -version 19.2 released June 19, 1992. -@item -version 19.3 released September 9, 1992. -@item -version 19.4 released January 21, 1993. -@item -version 19.5 was a repackaging of 19.4 with a few bug fixes and -shipped with Energize 2.0. Never released to the net. -@item -version 19.6 released April 9, 1993. -@item -version 19.7 was a repackaging of 19.6 with a few bug fixes and -shipped with Energize 2.1. Never released to the net. -@item -version 19.8 released September 6, 1993. -@item -version 19.9 released January 12, 1994. -@item -version 19.10 released May 27, 1994. -@item -version 19.11 (first XEmacs) released September 13, 1994. -@item -version 19.12 released June 23, 1995. -@item -version 19.13 released September 1, 1995. -@item -version 19.14 released June 23, 1996. -@item -version 20.0 released February 9, 1997. -@item -version 19.15 released March 28, 1997. -@item -version 20.1 (not released to the net) April 15, 1997. -@item -version 20.2 released May 16, 1997. -@item -version 19.16 released October 31, 1997. -@item -version 20.3 (the first stable version of XEmacs 20.x) released November 30, -1997. -version 20.4 released February 28, 1998. -@end itemize - -@node GNU Emacs 19 -@section GNU Emacs 19 -@cindex GNU Emacs 19 -@cindex FSF Emacs - - About a year after the initial release of Lucid Emacs, the FSF -released a beta of their version of Emacs 19 (referred to here as ``GNU -Emacs''). By this time, the current version of Lucid Emacs was -19.6. (Strangely, the first released beta from the FSF was GNU Emacs -19.7.) A time line for GNU Emacs version 19 is - -@itemize @bullet -@item -version 19.8 (beta) released May 27, 1993. -@item -version 19.9 (beta) released May 27, 1993. -@item -version 19.10 (beta) released May 30, 1993. -@item -version 19.11 (beta) released June 1, 1993. -@item -version 19.12 (beta) released June 2, 1993. -@item -version 19.13 (beta) released June 8, 1993. -@item -version 19.14 (beta) released June 17, 1993. -@item -version 19.15 (beta) released June 19, 1993. -@item -version 19.16 (beta) released July 6, 1993. -@item -version 19.17 (beta) released late July, 1993. -@item -version 19.18 (beta) released August 9, 1993. -@item -version 19.19 (beta) released August 15, 1993. -@item -version 19.20 (beta) released November 17, 1993. -@item -version 19.21 (beta) released November 17, 1993. -@item -version 19.22 (beta) released November 28, 1993. -@item -version 19.23 (beta) released May 17, 1994. -@item -version 19.24 (beta) released May 16, 1994. -@item -version 19.25 (beta) released June 3, 1994. -@item -version 19.26 (beta) released September 11, 1994. -@item -version 19.27 (beta) released September 14, 1994. -@item -version 19.28 (first ``official'' release) released November 1, 1994. -@item -version 19.29 released June 21, 1995. -@item -version 19.30 released November 24, 1995. -@item -version 19.31 released May 25, 1996. -@item -version 19.32 released July 31, 1996. -@item -version 19.33 released August 11, 1996. -@item -version 19.34 released August 21, 1996. -@item -version 19.34b released September 6, 1996. -@end itemize - -@cindex Mlynarik, Richard - In some ways, GNU Emacs 19 was better than Lucid Emacs; in some ways, -worse. Lucid soon began incorporating features from GNU Emacs 19 into -Lucid Emacs; the work was mostly done by Richard Mlynarik, who had been -working on and using GNU Emacs for a long time (back as far as version -16 or 17). - -@node GNU Emacs 20 -@section GNU Emacs 20 -@cindex GNU Emacs 20 -@cindex FSF Emacs - -On February 2, 1997 work began on GNU Emacs to integrate Mule. The first -release was made in September of that year. - -A timeline for Emacs 20 is - -@itemize @bullet -@item -version 20.1 released September 17, 1997. -@item -version 20.2 released September 20, 1997. -@item -version 20.3 released August 19, 1998. -@end itemize - -@node XEmacs -@section XEmacs -@cindex XEmacs - -@cindex Sun Microsystems -@cindex University of Illinois -@cindex Illinois, University of -@cindex SPARCWorks -@cindex Andreessen, Marc -@cindex Baur, Steve -@cindex Buchholz, Martin -@cindex Kaplan, Simon -@cindex Wing, Ben -@cindex Thompson, Chuck -@cindex Win-Emacs -@cindex Epoch -@cindex Amdahl Corporation - Around the time that Lucid was developing Energize, Sun Microsystems -was developing their own development environment (called ``SPARCWorks'') -and also decided to use Emacs. They joined forces with the Epoch team -at the University of Illinois and later with Lucid. The maintainer of -the last-released version of Epoch was Marc Andreessen, but he dropped -out and the Epoch project, headed by Simon Kaplan, lured Chuck Thompson -away from a system administration job to become the primary Lucid Emacs -author for Epoch and Sun. Chuck's area of specialty became the -redisplay engine (he replaced the old Lucid Emacs redisplay engine with -a ported version from Epoch and then later rewrote it from scratch). -Sun also hired Ben Wing (the author of Win-Emacs, a port of Lucid Emacs -to Microsoft Windows 3.1) in 1993, for what was initially a one-month -contract to fix some event problems but later became a many-year -involvement, punctuated by a six-month contract with Amdahl Corporation. - -@cindex rename to XEmacs - In 1994, Sun and Lucid agreed to rename Lucid Emacs to XEmacs (a name -not favorable to either company); the first release called XEmacs was -version 19.11. In June 1994, Lucid folded and Jamie quit to work for -the newly formed Mosaic Communications Corp., later Netscape -Communications Corp. (co-founded by the same Marc Andreessen, who had -quit his Epoch job to work on a graphical browser for the World Wide -Web). Chuck then become the primary maintainer of XEmacs, and put out -versions 19.11 through 19.14 in conjunction with Ben. For 19.12 and -19.13, Chuck added the new redisplay and many other display improvements -and Ben added MULE support (support for Asian and other languages) and -redesigned most of the internal Lisp subsystems to better support the -MULE work and the various other features being added to XEmacs. After -19.14 Chuck retired as primary maintainer and Steve Baur stepped in. - -@cindex MULE merged XEmacs appears - Soon after 19.13 was released, work began in earnest on the MULE -internationalization code and the source tree was divided into two -development paths. The MULE version was initially called 19.20, but was -soon renamed to 20.0. In 1996 Martin Buchholz of Sun Microsystems took -over the care and feeding of it and worked on it in parallel with the -19.14 development that was occurring at the same time. After much work -by Martin, it was decided to release 20.0 ahead of 19.15 in February -1997. The source tree remained divided until 20.2 when the version 19 -source was finally retired at version 19.16. - -@cindex Baur, Steve -@cindex Buchholz, Martin -@cindex Jones, Kyle -@cindex Niksic, Hrvoje -@cindex XEmacs goes it alone - In 1997, Sun finally dropped all pretense of support for XEmacs and -Martin Buchholz left the company in November. Since then, and mostly -for the previous year, because Steve Baur was never paid to work on -XEmacs, XEmacs has existed solely on the contributions of volunteers -from the Free Software Community. Starting from 1997, Hrvoje Niksic and -Kyle Jones have figured prominently in XEmacs development. - -@cindex merging attempts - Many attempts have been made to merge XEmacs and GNU Emacs, but they -have consistently failed. - - A more detailed history is contained in the XEmacs About page. - -@node XEmacs From the Outside, The Lisp Language, A History of Emacs, Top -@chapter XEmacs From the Outside -@cindex read-eval-print - - XEmacs appears to the outside world as an editor, but it is really a -Lisp environment. At its heart is a Lisp interpreter; it also -``happens'' to contain many specialized object types (e.g. buffers, -windows, frames, events) that are useful for implementing an editor. -Some of these objects (in particular windows and frames) have -displayable representations, and XEmacs provides a function -@code{redisplay()} that ensures that the display of all such objects -matches their internal state. Most of the time, a standard Lisp -environment is in a @dfn{read-eval-print} loop -- i.e. ``read some Lisp -code, execute it, and print the results''. XEmacs has a similar loop: - -@itemize @bullet -@item -read an event -@item -dispatch the event (i.e. ``do it'') -@item -redisplay -@end itemize - - Reading an event is done using the Lisp function @code{next-event}, -which waits for something to happen (typically, the user presses a key -or moves the mouse) and returns an event object describing this. -Dispatching an event is done using the Lisp function -@code{dispatch-event}, which looks up the event in a keymap object (a -particular kind of object that associates an event with a Lisp function) -and calls that function. The function ``does'' what the user has -requested by changing the state of particular frame objects, buffer -objects, etc. Finally, @code{redisplay()} is called, which updates the -display to reflect those changes just made. Thus is an ``editor'' born. - -@cindex bridge, playing -@cindex taxes, doing -@cindex pi, calculating - Note that you do not have to use XEmacs as an editor; you could just -as well make it do your taxes, compute pi, play bridge, etc. You'd just -have to write functions to do those operations in Lisp. - -@node The Lisp Language, XEmacs From the Perspective of Building, XEmacs From the Outside, Top -@chapter The Lisp Language -@cindex Lisp vs. C -@cindex C vs. Lisp -@cindex Lisp vs. Java -@cindex Java vs. Lisp -@cindex dynamic scoping -@cindex scoping, dynamic -@cindex dynamic types -@cindex types, dynamic -@cindex Java -@cindex Common Lisp -@cindex Gosling, James - - Lisp is a general-purpose language that is higher-level than C and in -many ways more powerful than C. Powerful dialects of Lisp such as -Common Lisp are probably much better languages for writing very large -applications than is C. (Unfortunately, for many non-technical -reasons C and its successor C++ have become the dominant languages for -application development. These languages are both inadequate for -extremely large applications, which is evidenced by the fact that newer, -larger programs are becoming ever harder to write and are requiring ever -more programmers despite great increases in C development environments; -and by the fact that, although hardware speeds and reliability have been -growing at an exponential rate, most software is still generally -considered to be slow and buggy.) - - The new Java language holds promise as a better general-purpose -development language than C. Java has many features in common with -Lisp that are not shared by C (this is not a coincidence, since -Java was designed by James Gosling, a former Lisp hacker). This -will be discussed more later. - -For those used to C, here is a summary of the basic differences between -C and Lisp: - -@enumerate -@item -Lisp has an extremely regular syntax. Every function, expression, -and control statement is written in the form - -@example - (@var{func} @var{arg1} @var{arg2} ...) -@end example - -This is as opposed to C, which writes functions as - -@example - func(@var{arg1}, @var{arg2}, ...) -@end example - -but writes expressions involving operators as (e.g.) - -@example - @var{arg1} + @var{arg2} -@end example - -and writes control statements as (e.g.) - -@example - while (@var{expr}) @{ @var{statement1}; @var{statement2}; ... @} -@end example - -Lisp equivalents of the latter two would be - -@example - (+ @var{arg1} @var{arg2} ...) -@end example - -and - -@example - (while @var{expr} @var{statement1} @var{statement2} ...) -@end example - -@item -Lisp is a safe language. Assuming there are no bugs in the Lisp -interpreter/compiler, it is impossible to write a program that ``core -dumps'' or otherwise causes the machine to execute an illegal -instruction. This is very different from C, where perhaps the most -common outcome of a bug is exactly such a crash. A corollary of this is that -the C operation of casting a pointer is impossible (and unnecessary) in -Lisp, and that it is impossible to access memory outside the bounds of -an array. - -@item -Programs and data are written in the same form. The -parenthesis-enclosing form described above for statements is the same -form used for the most common data type in Lisp, the list. Thus, it is -possible to represent any Lisp program using Lisp data types, and for -one program to construct Lisp statements and then dynamically -@dfn{evaluate} them, or cause them to execute. - -@item -All objects are @dfn{dynamically typed}. This means that part of every -object is an indication of what type it is. A Lisp program can -manipulate an object without knowing what type it is, and can query an -object to determine its type. This means that, correspondingly, -variables and function parameters can hold objects of any type and are -not normally declared as being of any particular type. This is opposed -to the @dfn{static typing} of C, where variables can hold exactly one -type of object and must be declared as such, and objects do not contain -an indication of their type because it's implicit in the variables they -are stored in. It is possible in C to have a variable hold different -types of objects (e.g. through the use of @code{void *} pointers or -variable-argument functions), but the type information must then be -passed explicitly in some other fashion, leading to additional program -complexity. - -@item -Allocated memory is automatically reclaimed when it is no longer in use. -This operation is called @dfn{garbage collection} and involves looking -through all variables to see what memory is being pointed to, and -reclaiming any memory that is not pointed to and is thus -``inaccessible'' and out of use. This is as opposed to C, in which -allocated memory must be explicitly reclaimed using @code{free()}. If -you simply drop all pointers to memory without freeing it, it becomes -``leaked'' memory that still takes up space. Over a long period of -time, this can cause your program to grow and grow until it runs out of -memory. - -@item -Lisp has built-in facilities for handling errors and exceptions. In C, -when an error occurs, usually either the program exits entirely or the -routine in which the error occurs returns a value indicating this. If -an error occurs in a deeply-nested routine, then every routine currently -called must unwind itself normally and return an error value back up to -the next routine. This means that every routine must explicitly check -for an error in all the routines it calls; if it does not do so, -unexpected and often random behavior results. This is an extremely -common source of bugs in C programs. An alternative would be to do a -non-local exit using @code{longjmp()}, but that is often very dangerous -because the routines that were exited past had no opportunity to clean -up after themselves and may leave things in an inconsistent state, -causing a crash shortly afterwards. - -Lisp provides mechanisms to make such non-local exits safe. When an -error occurs, a routine simply signals that an error of a particular -class has occurred, and a non-local exit takes place. Any routine can -trap errors occurring in routines it calls by registering an error -handler for some or all classes of errors. (If no handler is registered, -a default handler, generally installed by the top-level event loop, is -executed; this prints out the error and continues.) Routines can also -specify cleanup code (called an @dfn{unwind-protect}) that will be -called when control exits from a block of code, no matter how that exit -occurs -- i.e. even if a function deeply nested below it causes a -non-local exit back to the top level. - -Note that this facility has appeared in some recent vintages of C, in -particular Visual C++ and other PC compilers written for the Microsoft -Win32 API. - -@item -In Emacs Lisp, local variables are @dfn{dynamically scoped}. This means -that if you declare a local variable in a particular function, and then -call another function, that subfunction can ``see'' the local variable -you declared. This is actually considered a bug in Emacs Lisp and in -all other early dialects of Lisp, and was corrected in Common Lisp. (In -Common Lisp, you can still declare dynamically scoped variables if you -want to -- they are sometimes useful -- but variables by default are -@dfn{lexically scoped} as in C.) -@end enumerate - -For those familiar with Lisp, Emacs Lisp is modelled after MacLisp, an -early dialect of Lisp developed at MIT (no relation to the Macintosh -computer). There is a Common Lisp compatibility package available for -Emacs that provides many of the features of Common Lisp. - -The Java language is derived in many ways from C, and shares a similar -syntax, but has the following features in common with Lisp (and different -from C): - -@enumerate -@item -Java is a safe language, like Lisp. -@item -Java provides garbage collection, like Lisp. -@item -Java has built-in facilities for handling errors and exceptions, like -Lisp. -@item -Java has a type system that combines the best advantages of both static -and dynamic typing. Objects (except very simple types) are explicitly -marked with their type, as in dynamic typing; but there is a hierarchy -of types and functions are declared to accept only certain types, thus -providing the increased compile-time error-checking of static typing. -@end enumerate - -The Java language also has some negative attributes: - -@enumerate -@item -Java uses the edit/compile/run model of software development. This -makes it hard to use interactively. For example, to use Java like -@code{bc} it is necessary to write a special purpose, albeit tiny, -application. In Emacs Lisp, a calculator comes built-in without any -effort - one can always just type an expression in the @code{*scratch*} -buffer. -@item -Java tries too hard to enforce, not merely enable, portability, making -ordinary access to standard OS facilities painful. Java has an -@dfn{agenda}. I think this is why @code{chdir} is not part of standard -Java, which is inexcusable. -@end enumerate - -Unfortunately, there is no perfect language. Static typing allows a -compiler to catch programmer errors and produce more efficient code, but -makes programming more tedious and less fun. For the forseeable future, -an Ideal Editing and Programming Environment (and that is what XEmacs -aspires to) will be programmable in multiple languages: high level ones -like Lisp for user customization and prototyping, and lower level ones -for infrastructure and industrial strength applications. If I had my -way, XEmacs would be friendly towards the Python, Scheme, C++, ML, -etc... communities. But there are serious technical difficulties to -achieving that goal. - -The word @dfn{application} in the previous paragraph was used -intentionally. XEmacs implements an API for programs written in Lisp -that makes it a full-fledged application platform, very much like an OS -inside the real OS. - -@node XEmacs From the Perspective of Building, XEmacs From the Inside, The Lisp Language, Top -@chapter XEmacs From the Perspective of Building - -The heart of XEmacs is the Lisp environment, which is written in C. -This is contained in the @file{src/} subdirectory. Underneath -@file{src/} are two subdirectories of header files: @file{s/} (header -files for particular operating systems) and @file{m/} (header files for -particular machine types). In practice the distinction between the two -types of header files is blurred. These header files define or undefine -certain preprocessor constants and macros to indicate particular -characteristics of the associated machine or operating system. As part -of the configure process, one @file{s/} file and one @file{m/} file is -identified for the particular environment in which XEmacs is being -built. - -XEmacs also contains a great deal of Lisp code. This implements the -operations that make XEmacs useful as an editor as well as just a Lisp -environment, and also contains many add-on packages that allow XEmacs to -browse directories, act as a mail and Usenet news reader, compile Lisp -code, etc. There is actually more Lisp code than C code associated with -XEmacs, but much of the Lisp code is peripheral to the actual operation -of the editor. The Lisp code all lies in subdirectories underneath the -@file{lisp/} directory. - -The @file{lwlib/} directory contains C code that implements a -generalized interface onto different X widget toolkits and also -implements some widgets of its own that behave like Motif widgets but -are faster, free, and in some cases more powerful. The code in this -directory compiles into a library and is mostly independent from XEmacs. - -The @file{etc/} directory contains various data files associated with -XEmacs. Some of them are actually read by XEmacs at startup; others -merely contain useful information of various sorts. - -The @file{lib-src/} directory contains C code for various auxiliary -programs that are used in connection with XEmacs. Some of them are used -during the build process; others are used to perform certain functions -that cannot conveniently be placed in the XEmacs executable (e.g. the -@file{movemail} program for fetching mail out of @file{/var/spool/mail}, -which must be setgid to @file{mail} on many systems; and the -@file{gnuclient} program, which allows an external script to communicate -with a running XEmacs process). - -The @file{man/} directory contains the sources for the XEmacs -documentation. It is mostly in a form called Texinfo, which can be -converted into either a printed document (by passing it through @TeX{}) -or into on-line documentation called @dfn{info files}. - -The @file{info/} directory contains the results of formatting the XEmacs -documentation as @dfn{info files}, for on-line use. These files are -used when you enter the Info system using @kbd{C-h i} or through the -Help menu. - -The @file{dynodump/} directory contains auxiliary code used to build -XEmacs on Solaris platforms. - -The other directories contain various miscellaneous code and information -that is not normally used or needed. - -The first step of building involves running the @file{configure} program -and passing it various parameters to specify any optional features you -want and compiler arguments and such, as described in the @file{INSTALL} -file. This determines what the build environment is, chooses the -appropriate @file{s/} and @file{m/} file, and runs a series of tests to -determine many details about your environment, such as which library -functions are available and exactly how they work. The reason for -running these tests is that it allows XEmacs to be compiled on a much -wider variety of platforms than those that the XEmacs developers happen -to be familiar with, including various sorts of hybrid platforms. This -is especially important now that many operating systems give you a great -deal of control over exactly what features you want installed, and allow -for easy upgrading of parts of a system without upgrading the rest. It -would be impossible to pre-determine and pre-specify the information for -all possible configurations. - -In fact, the @file{s/} and @file{m/} files are basically @emph{evil}, -since they contain unmaintainable platform-specific hard-coded -information. XEmacs has been moving in the direction of having all -system-specific information be determined dynamically by -@file{configure}. Perhaps someday we can @code{rm -rf src/s src/m}. - -When configure is done running, it generates @file{Makefile}s and -@file{GNUmakefile}s and the file @file{src/config.h} (which describes -the features of your system) from template files. You then run -@file{make}, which compiles the auxiliary code and programs in -@file{lib-src/} and @file{lwlib/} and the main XEmacs executable in -@file{src/}. The result of compiling and linking is an executable -called @file{temacs}, which is @emph{not} the final XEmacs executable. -@file{temacs} by itself is not intended to function as an editor or even -display any windows on the screen, and if you simply run it, it will -exit immediately. The @file{Makefile} runs @file{temacs} with certain -options that cause it to initialize itself, read in a number of basic -Lisp files, and then dump itself out into a new executable called -@file{xemacs}. This new executable has been pre-initialized and -contains pre-digested Lisp code that is necessary for the editor to -function (this includes most basic editing functions, -e.g. @code{kill-line}, that can be defined in terms of other Lisp -primitives; some initialization code that is called when certain -objects, such as frames, are created; and all of the standard -keybindings and code for the actions they result in). This executable, -@file{xemacs}, is the executable that you run to use the XEmacs editor. - -Although @file{temacs} is not intended to be run as an editor, it can, -by using the incantation @code{temacs -batch -l loadup.el run-temacs}. -This is useful when the dumping procedure described above is broken, or -when using certain program debugging tools such as Purify. These tools -get mighty confused by the tricks played by the XEmacs build process, -such as allocation memory in one process, and freeing it in the next. - -@node XEmacs From the Inside, The XEmacs Object System (Abstractly Speaking), XEmacs From the Perspective of Building, Top -@chapter XEmacs From the Inside - -Internally, XEmacs is quite complex, and can be very confusing. To -simplify things, it can be useful to think of XEmacs as containing an -event loop that ``drives'' everything, and a number of other subsystems, -such as a Lisp engine and a redisplay mechanism. Each of these other -subsystems exists simultaneously in XEmacs, and each has a certain -state. The flow of control continually passes in and out of these -different subsystems in the course of normal operation of the editor. - -It is important to keep in mind that, most of the time, the editor is -``driven'' by the event loop. Except during initialization and batch -mode, all subsystems are entered directly or indirectly through the -event loop, and ultimately, control exits out of all subsystems back up -to the event loop. This cycle of entering a subsystem, exiting back out -to the event loop, and starting another iteration of the event loop -occurs once each keystroke, mouse motion, etc. - -If you're trying to understand a particular subsystem (other than the -event loop), think of it as a ``daemon'' process or ``servant'' that is -responsible for one particular aspect of a larger system, and -periodically receives commands or environment changes that cause it to -do something. Ultimately, these commands and environment changes are -always triggered by the event loop. For example: - -@itemize @bullet -@item -The window and frame mechanism is responsible for keeping track of what -windows and frames exist, what buffers are in them, etc. It is -periodically given commands (usually from the user) to make a change to -the current window/frame state: i.e. create a new frame, delete a -window, etc. - -@item -The buffer mechanism is responsible for keeping track of what buffers -exist and what text is in them. It is periodically given commands -(usually from the user) to insert or delete text, create a buffer, etc. -When it receives a text-change command, it notifies the redisplay -mechanism. - -@item -The redisplay mechanism is responsible for making sure that windows and -frames are displayed correctly. It is periodically told (by the event -loop) to actually ``do its job'', i.e. snoop around and see what the -current state of the environment (mostly of the currently-existing -windows, frames, and buffers) is, and make sure that that state matches -what's actually displayed. It keeps lots and lots of information around -(such as what is actually being displayed currently, and what the -environment was last time it checked) so that it can minimize the work -it has to do. It is also helped along in that whenever a relevant -change to the environment occurs, the redisplay mechanism is told about -this, so it has a pretty good idea of where it has to look to find -possible changes and doesn't have to look everywhere. - -@item -The Lisp engine is responsible for executing the Lisp code in which most -user commands are written. It is entered through a call to @code{eval} -or @code{funcall}, which occurs as a result of dispatching an event from -the event loop. The functions it calls issue commands to the buffer -mechanism, the window/frame subsystem, etc. - -@item -The Lisp allocation subsystem is responsible for keeping track of Lisp -objects. It is given commands from the Lisp engine to allocate objects, -garbage collect, etc. -@end itemize - -etc. - - The important idea here is that there are a number of independent -subsystems each with its own responsibility and persistent state, just -like different employees in a company, and each subsystem is -periodically given commands from other subsystems. Commands can flow -from any one subsystem to any other, but there is usually some sort of -hierarchy, with all commands originating from the event subsystem. - - XEmacs is entered in @code{main()}, which is in @file{emacs.c}. When -this is called the first time (in a properly-invoked @file{temacs}), it -does the following: - -@enumerate -@item -It does some very basic environment initializations, such as determining -where it and its directories (e.g. @file{lisp/} and @file{etc/}) reside -and setting up signal handlers. -@item -It initializes the entire Lisp interpreter. -@item -It sets the initial values of many built-in variables (including many -variables that are visible to Lisp programs), such as the global keymap -object and the built-in faces (a face is an object that describes the -display characteristics of text). This involves creating Lisp objects -and thus is dependent on step (2). -@item -It performs various other initializations that are relevant to the -particular environment it is running in, such as retrieving environment -variables, determining the current date and the user who is running the -program, examining its standard input, creating any necessary file -descriptors, etc. -@item -At this point, the C initialization is complete. A Lisp program that -was specified on the command line (usually @file{loadup.el}) is called -(temacs is normally invoked as @code{temacs -batch -l loadup.el dump}). -@file{loadup.el} loads all of the other Lisp files that are needed for -the operation of the editor, calls the @code{dump-emacs} function to -write out @file{xemacs}, and then kills the temacs process. -@end enumerate - - When @file{xemacs} is then run, it only redoes steps (1) and (4) -above; all variables already contain the values they were set to when -the executable was dumped, and all memory that was allocated with -@code{malloc()} is still around. (XEmacs knows whether it is being run -as @file{xemacs} or @file{temacs} because it sets the global variable -@code{initialized} to 1 after step (4) above.) At this point, -@file{xemacs} calls a Lisp function to do any further initialization, -which includes parsing the command-line (the C code can only do limited -command-line parsing, which includes looking for the @samp{-batch} and -@samp{-l} flags and a few other flags that it needs to know about before -initialization is complete), creating the first frame (or @dfn{window} -in standard window-system parlance), running the user's init file -(usually the file @file{.emacs} in the user's home directory), etc. The -function to do this is usually called @code{normal-top-level}; -@file{loadup.el} tells the C code about this function by setting its -name as the value of the Lisp variable @code{top-level}. - - When the Lisp initialization code is done, the C code enters the event -loop, and stays there for the duration of the XEmacs process. The code -for the event loop is contained in @file{keyboard.c}, and is called -@code{Fcommand_loop_1()}. Note that this event loop could very well be -written in Lisp, and in fact a Lisp version exists; but apparently, -doing this makes XEmacs run noticeably slower. - - Notice how much of the initialization is done in Lisp, not in C. -In general, XEmacs tries to move as much code as is possible -into Lisp. Code that remains in C is code that implements the -Lisp interpreter itself, or code that needs to be very fast, or -code that needs to do system calls or other such stuff that -needs to be done in C, or code that needs to have access to -``forbidden'' structures. (One conscious aspect of the design of -Lisp under XEmacs is a clean separation between the external -interface to a Lisp object's functionality and its internal -implementation. Part of this design is that Lisp programs -are forbidden from accessing the contents of the object other -than through using a standard API. In this respect, XEmacs Lisp -is similar to modern Lisp dialects but differs from GNU Emacs, -which tends to expose the implementation and allow Lisp -programs to look at it directly. The major advantage of -hiding the implementation is that it allows the implementation -to be redesigned without affecting any Lisp programs, including -those that might want to be ``clever'' by looking directly at -the object's contents and possibly manipulating them.) - - Moving code into Lisp makes the code easier to debug and maintain and -makes it much easier for people who are not XEmacs developers to -customize XEmacs, because they can make a change with much less chance -of obscure and unwanted interactions occurring than if they were to -change the C code. - -@node The XEmacs Object System (Abstractly Speaking), How Lisp Objects Are Represented in C, XEmacs From the Inside, Top -@chapter The XEmacs Object System (Abstractly Speaking) - - At the heart of the Lisp interpreter is its management of objects. -XEmacs Lisp contains many built-in objects, some of which are -simple and others of which can be very complex; and some of which -are very common, and others of which are rarely used or are only -used internally. (Since the Lisp allocation system, with its -automatic reclamation of unused storage, is so much more convenient -than @code{malloc()} and @code{free()}, the C code makes extensive use of it -in its internal operations.) - - The basic Lisp objects are - -@table @code -@item integer -28 or 31 bits of precision, or 60 or 63 bits on 64-bit machines; the -reason for this is described below when the internal Lisp object -representation is described. -@item float -Same precision as a double in C. -@item cons -A simple container for two Lisp objects, used to implement lists and -most other data structures in Lisp. -@item char -An object representing a single character of text; chars behave like -integers in many ways but are logically considered text rather than -numbers and have a different read syntax. (the read syntax for a char -contains the char itself or some textual encoding of it -- for example, -a Japanese Kanji character might be encoded as @samp{^[$(B#&^[(B} using the -ISO-2022 encoding standard -- rather than the numerical representation -of the char; this way, if the mapping between chars and integers -changes, which is quite possible for Kanji characters and other extended -characters, the same character will still be created. Note that some -primitives confuse chars and integers. The worst culprit is @code{eq}, -which makes a special exception and considers a char to be @code{eq} to -its integer equivalent, even though in no other case are objects of two -different types @code{eq}. The reason for this monstrosity is -compatibility with existing code; the separation of char from integer -came fairly recently.) -@item symbol -An object that contains Lisp objects and is referred to by name; -symbols are used to implement variables and named functions -and to provide the equivalent of preprocessor constants in C. -@item vector -A one-dimensional array of Lisp objects providing constant-time access -to any of the objects; access to an arbitrary object in a vector is -faster than for lists, but the operations that can be done on a vector -are more limited. -@item string -Self-explanatory; behaves much like a vector of chars -but has a different read syntax and is stored and manipulated -more compactly. -@item bit-vector -A vector of bits; similar to a string in spirit. -@item compiled-function -An object containing compiled Lisp code, known as @dfn{byte code}. -@item subr -A Lisp primitive, i.e. a Lisp-callable function implemented in C. -@end table - -@cindex closure -Note that there is no basic ``function'' type, as in more powerful -versions of Lisp (where it's called a @dfn{closure}). XEmacs Lisp does -not provide the closure semantics implemented by Common Lisp and Scheme. -The guts of a function in XEmacs Lisp are represented in one of four -ways: a symbol specifying another function (when one function is an -alias for another), a list (whose first element must be the symbol -@code{lambda}) containing the function's source code, a -compiled-function object, or a subr object. (In other words, given a -symbol specifying the name of a function, calling @code{symbol-function} -to retrieve the contents of the symbol's function cell will return one -of these types of objects.) - -XEmacs Lisp also contains numerous specialized objects used to implement -the editor: - -@table @code -@item buffer -Stores text like a string, but is optimized for insertion and deletion -and has certain other properties that can be set. -@item frame -An object with various properties whose displayable representation is a -@dfn{window} in window-system parlance. -@item window -A section of a frame that displays the contents of a buffer; -often called a @dfn{pane} in window-system parlance. -@item window-configuration -An object that represents a saved configuration of windows in a frame. -@item device -An object representing a screen on which frames can be displayed; -equivalent to a @dfn{display} in the X Window System and a @dfn{TTY} in -character mode. -@item face -An object specifying the appearance of text or graphics; it has -properties such as font, foreground color, and background color. -@item marker -An object that refers to a particular position in a buffer and moves -around as text is inserted and deleted to stay in the same relative -position to the text around it. -@item extent -Similar to a marker but covers a range of text in a buffer; can also -specify properties of the text, such as a face in which the text is to -be displayed, whether the text is invisible or unmodifiable, etc. -@item event -Generated by calling @code{next-event} and contains information -describing a particular event happening in the system, such as the user -pressing a key or a process terminating. -@item keymap -An object that maps from events (described using lists, vectors, and -symbols rather than with an event object because the mapping is for -classes of events, rather than individual events) to functions to -execute or other events to recursively look up; the functions are -described by name, using a symbol, or using lists to specify the -function's code. -@item glyph -An object that describes the appearance of an image (e.g. pixmap) on -the screen; glyphs can be attached to the beginning or end of extents -and in some future version of XEmacs will be able to be inserted -directly into a buffer. -@item process -An object that describes a connection to an externally-running process. -@end table - - There are some other, less-commonly-encountered general objects: - -@table @code -@item hash-table -An object that maps from an arbitrary Lisp object to another arbitrary -Lisp object, using hashing for fast lookup. -@item obarray -A limited form of hash-table that maps from strings to symbols; obarrays -are used to look up a symbol given its name and are not actually their -own object type but are kludgily represented using vectors with hidden -fields (this representation derives from GNU Emacs). -@item specifier -A complex object used to specify the value of a display property; a -default value is given and different values can be specified for -particular frames, buffers, windows, devices, or classes of device. -@item char-table -An object that maps from chars or classes of chars to arbitrary Lisp -objects; internally char tables use a complex nested-vector -representation that is optimized to the way characters are represented -as integers. -@item range-table -An object that maps from ranges of integers to arbitrary Lisp objects. -@end table - - And some strange special-purpose objects: - -@table @code -@item charset -@itemx coding-system -Objects used when MULE, or multi-lingual/Asian-language, support is -enabled. -@item color-instance -@itemx font-instance -@itemx image-instance -An object that encapsulates a window-system resource; instances are -mostly used internally but are exposed on the Lisp level for cleanness -of the specifier model and because it's occasionally useful for Lisp -program to create or query the properties of instances. -@item subwindow -An object that encapsulate a @dfn{subwindow} resource, i.e. a -window-system child window that is drawn into by an external process; -this object should be integrated into the glyph system but isn't yet, -and may change form when this is done. -@item tooltalk-message -@itemx tooltalk-pattern -Objects that represent resources used in the ToolTalk interprocess -communication protocol. -@item toolbar-button -An object used in conjunction with the toolbar. -@end table - - And objects that are only used internally: - -@table @code -@item opaque -A generic object for encapsulating arbitrary memory; this allows you the -generality of @code{malloc()} and the convenience of the Lisp object -system. -@item lstream -A buffering I/O stream, used to provide a unified interface to anything -that can accept output or provide input, such as a file descriptor, a -stdio stream, a chunk of memory, a Lisp buffer, a Lisp string, etc.; -it's a Lisp object to make its memory management more convenient. -@item char-table-entry -Subsidiary objects in the internal char-table representation. -@item extent-auxiliary -@itemx menubar-data -@itemx toolbar-data -Various special-purpose objects that are basically just used to -encapsulate memory for particular subsystems, similar to the more -general ``opaque'' object. -@item symbol-value-forward -@itemx symbol-value-buffer-local -@itemx symbol-value-varalias -@itemx symbol-value-lisp-magic -Special internal-only objects that are placed in the value cell of a -symbol to indicate that there is something special with this variable -- -e.g. it has no value, it mirrors another variable, or it mirrors some C -variable; there is really only one kind of object, called a -@dfn{symbol-value-magic}, but it is sort-of halfway kludged into -semi-different object types. -@end table - -@cindex permanent objects -@cindex temporary objects - Some types of objects are @dfn{permanent}, meaning that once created, -they do not disappear until explicitly destroyed, using a function such -as @code{delete-buffer}, @code{delete-window}, @code{delete-frame}, etc. -Others will disappear once they are not longer used, through the garbage -collection mechanism. Buffers, frames, windows, devices, and processes -are among the objects that are permanent. Note that some objects can go -both ways: Faces can be created either way; extents are normally -permanent, but detached extents (extents not referring to any text, as -happens to some extents when the text they are referring to is deleted) -are temporary. Note that some permanent objects, such as faces and -coding systems, cannot be deleted. Note also that windows are unique in -that they can be @emph{undeleted} after having previously been -deleted. (This happens as a result of restoring a window configuration.) - -@cindex read syntax - Note that many types of objects have a @dfn{read syntax}, i.e. a way of -specifying an object of that type in Lisp code. When you load a Lisp -file, or type in code to be evaluated, what really happens is that the -function @code{read} is called, which reads some text and creates an object -based on the syntax of that text; then @code{eval} is called, which -possibly does something special; then this loop repeats until there's -no more text to read. (@code{eval} only actually does something special -with symbols, which causes the symbol's value to be returned, -similar to referencing a variable; and with conses [i.e. lists], -which cause a function invocation. All other values are returned -unchanged.) - - The read syntax - -@example -17297 -@end example - -converts to an integer whose value is 17297. - -@example -1.983e-4 -@end example - -converts to a float whose value is 1983.23e-4, or .0001983. - -@example -?b -@end example - -converts to a char that represents the lowercase letter b. - -@example -?^[$(B#&^[(B -@end example - -(where @samp{^[} actually is an @samp{ESC} character) converts to a -particular Kanji character when using an ISO2022-based coding system for -input. (To decode this goo: @samp{ESC} begins an escape sequence; -@samp{ESC $ (} is a class of escape sequences meaning ``switch to a -94x94 character set''; @samp{ESC $ ( B} means ``switch to Japanese -Kanji''; @samp{#} and @samp{&} collectively index into a 94-by-94 array -of characters [subtract 33 from the ASCII value of each character to get -the corresponding index]; @samp{ESC (} is a class of escape sequences -meaning ``switch to a 94 character set''; @samp{ESC (B} means ``switch -to US ASCII''. It is a coincidence that the letter @samp{B} is used to -denote both Japanese Kanji and US ASCII. If the first @samp{B} were -replaced with an @samp{A}, you'd be requesting a Chinese Hanzi character -from the GB2312 character set.) - -@example -"foobar" -@end example - -converts to a string. - -@example -foobar -@end example - -converts to a symbol whose name is @code{"foobar"}. This is done by -looking up the string equivalent in the global variable -@code{obarray}, whose contents should be an obarray. If no symbol -is found, a new symbol with the name @code{"foobar"} is automatically -created and added to @code{obarray}; this process is called -@dfn{interning} the symbol. -@cindex interning - -@example -(foo . bar) -@end example - -converts to a cons cell containing the symbols @code{foo} and @code{bar}. - -@example -(1 a 2.5) -@end example - -converts to a three-element list containing the specified objects -(note that a list is actually a set of nested conses; see the -XEmacs Lisp Reference). - -@example -[1 a 2.5] -@end example - -converts to a three-element vector containing the specified objects. - -@example -#[... ... ... ...] -@end example - -converts to a compiled-function object (the actual contents are not -shown since they are not relevant here; look at a file that ends with -@file{.elc} for examples). - -@example -#*01110110 -@end example - -converts to a bit-vector. - -@example -#s(hash-table ... ...) -@end example - -converts to a hash table (the actual contents are not shown). - -@example -#s(range-table ... ...) -@end example - -converts to a range table (the actual contents are not shown). - -@example -#s(char-table ... ...) -@end example - -converts to a char table (the actual contents are not shown). - -Note that the @code{#s()} syntax is the general syntax for structures, -which are not really implemented in XEmacs Lisp but should be. - -When an object is printed out (using @code{print} or a related -function), the read syntax is used, so that the same object can be read -in again. - -The other objects do not have read syntaxes, usually because it does not -really make sense to create them in this fashion (i.e. processes, where -it doesn't make sense to have a subprocess created as a side effect of -reading some Lisp code), or because they can't be created at all -(e.g. subrs). Permanent objects, as a rule, do not have a read syntax; -nor do most complex objects, which contain too much state to be easily -initialized through a read syntax. - -@node How Lisp Objects Are Represented in C, Rules When Writing New C Code, The XEmacs Object System (Abstractly Speaking), Top -@chapter How Lisp Objects Are Represented in C - -Lisp objects are represented in C using a 32-bit or 64-bit machine word -(depending on the processor; i.e. DEC Alphas use 64-bit Lisp objects and -most other processors use 32-bit Lisp objects). The representation -stuffs a pointer together with a tag, as follows: - -@example - [ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 ] - [ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 ] - - <---> ^ <------------------------------------------------------> - tag | a pointer to a structure, or an integer - | - mark bit -@end example - -The tag describes the type of the Lisp object. For integers and chars, -the lower 28 bits contain the value of the integer or char; for all -others, the lower 28 bits contain a pointer. The mark bit is used -during garbage-collection, and is always 0 when garbage collection is -not happening. (The way that garbage collection works, basically, is that it -loops over all places where Lisp objects could exist -- this includes -all global variables in C that contain Lisp objects [including -@code{Vobarray}, the C equivalent of @code{obarray}; through this, all -Lisp variables will get marked], plus various other places -- and -recursively scans through the Lisp objects, marking each object it finds -by setting the mark bit. Then it goes through the lists of all objects -allocated, freeing the ones that are not marked and turning off the mark -bit of the ones that are marked.) - -Lisp objects use the typedef @code{Lisp_Object}, but the actual C type -used for the Lisp object can vary. It can be either a simple type -(@code{long} on the DEC Alpha, @code{int} on other machines) or a -structure whose fields are bit fields that line up properly (actually, a -union of structures is used). Generally the simple integral type is -preferable because it ensures that the compiler will actually use a -machine word to represent the object (some compilers will use more -general and less efficient code for unions and structs even if they can -fit in a machine word). The union type, however, has the advantage of -stricter type checking (if you accidentally pass an integer where a Lisp -object is desired, you get a compile error), and it makes it easier to -decode Lisp objects when debugging. The choice of which type to use is -determined by the preprocessor constant @code{USE_UNION_TYPE} which is -defined via the @code{--use-union-type} option to @code{configure}. - -@cindex record type - -Note that there are only eight types that the tag can represent, but -many more actual types than this. This is handled by having one of the -tag types specify a meta-type called a @dfn{record}; for all such -objects, the first four bytes of the pointed-to structure indicate what -the actual type is. - -Note also that having 28 bits for pointers and integers restricts a lot -of things to 256 megabytes of memory. (Basically, enough pointers and -indices and whatnot get stuffed into Lisp objects that the total amount -of memory used by XEmacs can't grow above 256 megabytes. In older -versions of XEmacs and GNU Emacs, the tag was 5 bits wide, allowing for -32 types, which was more than the actual number of types that existed at -the time, and no ``record'' type was necessary. However, this limited -the editor to 64 megabytes total, which some users who edited large -files might conceivably exceed.) - -Also, note that there is an implicit assumption here that all pointers -are low enough that the top bits are all zero and can just be chopped -off. On standard machines that allocate memory from the bottom up (and -give each process its own address space), this works fine. Some -machines, however, put the data space somewhere else in memory -(e.g. beginning at 0x80000000). Those machines cope by defining -@code{DATA_SEG_BITS} in the corresponding @file{m/} or @file{s/} file to -the proper mask. Then, pointers retrieved from Lisp objects are -automatically OR'ed with this value prior to being used. - -A corollary of the previous paragraph is that @strong{(pointers to) -stack-allocated structures cannot be put into Lisp objects}. The stack -is generally located near the top of memory; if you put such a pointer -into a Lisp object, it will get its top bits chopped off, and you will -lose. - -Actually, there's an alternative representation of a @code{Lisp_Object}, -invented by Kyle Jones, that is used when the -@code{--use-minimal-tagbits} option to @code{configure} is used. In -this case the 2 lower bits are used for the tag bits. This -representation assumes that pointers to structs are always aligned to -multiples of 4, so the lower 2 bits are always zero. - -@example - [ 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 ] - [ 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 ] - - <---------------------------------------------------------> <-> - a pointer to a structure, or an integer tag -@end example - -A tag of 00 is used for all pointer object types, a tag of 10 is used -for characters, and the other two tags 01 and 11 are joined together to -form the integer object type. The markbit is moved to part of the -structure being pointed at (integers and chars do not need to be marked, -since no memory is allocated). This representation has these -advantages: - -@enumerate -@item -31 bits can be used for Lisp Integers. -@item -@emph{Any} pointer can be represented directly, and no bit masking -operations are necessary. -@end enumerate - -The disadvantages are: - -@enumerate -@item -An extra level of indirection is needed when accessing the object types -that were not record types. So checking whether a Lisp object is a cons -cell becomes a slower operation. -@item -Mark bits can no longer be stored directly in Lisp objects, so another -place for them must be found. This means that a cons cell requires more -memory than merely room for 2 lisp objects, leading to extra memory use. -@end enumerate - -Various macros are used to construct Lisp objects and extract the -components. Macros of the form @code{XINT()}, @code{XCHAR()}, -@code{XSTRING()}, @code{XSYMBOL()}, etc. mask out the pointer/integer -field and cast it to the appropriate type. All of the macros that -construct pointers will @code{OR} with @code{DATA_SEG_BITS} if -necessary. @code{XINT()} needs to be a bit tricky so that negative -numbers are properly sign-extended: Usually it does this by shifting the -number four bits to the left and then four bits to the right. This -assumes that the right-shift operator does an arithmetic shift (i.e. it -leaves the most-significant bit as-is rather than shifting in a zero, so -that it mimics a divide-by-two even for negative numbers). Not all -machines/compilers do this, and on the ones that don't, a more -complicated definition is selected by defining -@code{EXPLICIT_SIGN_EXTEND}. - -Note that when @code{ERROR_CHECK_TYPECHECK} is defined, the extractor -macros become more complicated -- they check the tag bits and/or the -type field in the first four bytes of a record type to ensure that the -object is really of the correct type. This is great for catching places -where an incorrect type is being dereferenced -- this typically results -in a pointer being dereferenced as the wrong type of structure, with -unpredictable (and sometimes not easily traceable) results. - -There are similar @code{XSET@var{TYPE}()} macros that construct a Lisp -object. These macros are of the form @code{XSET@var{TYPE} -(@var{lvalue}, @var{result})}, -i.e. they have to be a statement rather than just used in an expression. -The reason for this is that standard C doesn't let you ``construct'' a -structure (but GCC does). Granted, this sometimes isn't too convenient; -for the case of integers, at least, you can use the function -@code{make_int()}, which constructs and @emph{returns} an integer -Lisp object. Note that the @code{XSET@var{TYPE}()} macros are also -affected by @code{ERROR_CHECK_TYPECHECK} and make sure that the -structure is of the right type in the case of record types, where the -type is contained in the structure. - -The C programmer is responsible for @strong{guaranteeing} that a -Lisp_Object is is the correct type before using the @code{X@var{TYPE}} -macros. This is especially important in the case of lists. Use -@code{XCAR} and @code{XCDR} if a Lisp_Object is certainly a cons cell, -else use @code{Fcar()} and @code{Fcdr()}. Trust other C code, but not -Lisp code. On the other hand, if XEmacs has an internal logic error, -it's better to crash immediately, so sprinkle ``unreachable'' -@code{abort()}s liberally about the source code. - -@node Rules When Writing New C Code, A Summary of the Various XEmacs Modules, How Lisp Objects Are Represented in C, Top -@chapter Rules When Writing New C Code - -The XEmacs C Code is extremely complex and intricate, and there are many -rules that are more or less consistently followed throughout the code. -Many of these rules are not obvious, so they are explained here. It is -of the utmost importance that you follow them. If you don't, you may -get something that appears to work, but which will crash in odd -situations, often in code far away from where the actual breakage is. - -@menu -* General Coding Rules:: -* Writing Lisp Primitives:: -* Adding Global Lisp Variables:: -* Coding for Mule:: -* Techniques for XEmacs Developers:: -@end menu - -@node General Coding Rules -@section General Coding Rules - -The C code is actually written in a dialect of C called @dfn{Clean C}, -meaning that it can be compiled, mostly warning-free, with either a C or -C++ compiler. Coding in Clean C has several advantages over plain C. -C++ compilers are more nit-picking, and a number of coding errors have -been found by compiling with C++. The ability to use both C and C++ -tools means that a greater variety of development tools are available to -the developer. - -Almost every module contains a @code{syms_of_*()} function and a -@code{vars_of_*()} function. The former declares any Lisp primitives -you have defined and defines any symbols you will be using. The latter -declares any global Lisp variables you have added and initializes global -C variables in the module. For each such function, declare it in -@file{symsinit.h} and make sure it's called in the appropriate place in -@file{emacs.c}. @strong{Important}: There are stringent requirements on -exactly what can go into these functions. See the comment in -@file{emacs.c}. The reason for this is to avoid obscure unwanted -interactions during initialization. If you don't follow these rules, -you'll be sorry! If you want to do anything that isn't allowed, create -a @code{complex_vars_of_*()} function for it. Doing this is tricky, -though: You have to make sure your function is called at the right time -so that all the initialization dependencies work out. - -Every module includes @file{} (angle brackets so that -@samp{--srcdir} works correctly; @file{config.h} may or may not be in -the same directory as the C sources) and @file{lisp.h}. @file{config.h} -must always be included before any other header files (including -system header files) to ensure that certain tricks played by various -@file{s/} and @file{m/} files work out correctly. - -@strong{All global and static variables that are to be modifiable must -be declared uninitialized.} This means that you may not use the -``declare with initializer'' form for these variables, such as @code{int -some_variable = 0;}. The reason for this has to do with some kludges -done during the dumping process: If possible, the initialized data -segment is re-mapped so that it becomes part of the (unmodifiable) code -segment in the dumped executable. This allows this memory to be shared -among multiple running XEmacs processes. XEmacs is careful to place as -much constant data as possible into initialized variables (in -particular, into what's called the @dfn{pure space} -- see below) during -the @file{temacs} phase. - -@cindex copy-on-write -@strong{Please note:} This kludge only works on a few systems nowadays, -and is rapidly becoming irrelevant because most modern operating systems -provide @dfn{copy-on-write} semantics. All data is initially shared -between processes, and a private copy is automatically made (on a -page-by-page basis) when a process first attempts to write to a page of -memory. - -Formerly, there was a requirement that static variables not be declared -inside of functions. This had to do with another hack along the same -vein as what was just described: old USG systems put statically-declared -variables in the initialized data space, so those header files had a -@code{#define static} declaration. (That way, the data-segment remapping -described above could still work.) This fails badly on static variables -inside of functions, which suddenly become automatic variables; -therefore, you weren't supposed to have any of them. This awful kludge -has been removed in XEmacs because - -@enumerate -@item -almost all of the systems that used this kludge ended up having -to disable the data-segment remapping anyway; -@item -the only systems that didn't were extremely outdated ones; -@item -this hack completely messed up inline functions. -@end enumerate - -The C source code makes heavy use of C preprocessor macros. One popular -macro style is: - -@example -#define FOO(var, value) do @{ \ - Lisp_Object FOO_value = (value); \ - ... /* compute using FOO_value */ \ - (var) = bar; \ -@} while (0) -@end example - -The @code{do @{...@} while (0)} is a standard trick to allow FOO to have -statement semantics, so that it can safely be used within an @code{if} -statement in C, for example. Multiple evaluation is prevented by -copying a supplied argument into a local variable, so that -@code{FOO(var,fun(1))} only calls @code{fun} once. - -Lisp lists are popular data structures in the C code as well as in -Elisp. There are two sets of macros that iterate over lists. -@code{EXTERNAL_LIST_LOOP_@var{n}} should be used when the list has been -supplied by the user, and cannot be trusted to be acyclic and -nil-terminated. A @code{malformed-list} or @code{circular-list} error -will be generated if the list being iterated over is not entirely -kosher. @code{LIST_LOOP_@var{n}}, on the other hand, is faster and less -safe, and can be used only on trusted lists. - -Related macros are @code{GET_EXTERNAL_LIST_LENGTH} and -@code{GET_LIST_LENGTH}, which calculate the length of a list, and in the -case of @code{GET_EXTERNAL_LIST_LENGTH}, validating the properness of -the list. The macros @code{EXTERNAL_LIST_LOOP_DELETE_IF} and -@code{LIST_LOOP_DELETE_IF} delete elements from a lisp list satisfying some -predicate. - -@node Writing Lisp Primitives -@section Writing Lisp Primitives - -Lisp primitives are Lisp functions implemented in C. The details of -interfacing the C function so that Lisp can call it are handled by a few -C macros. The only way to really understand how to write new C code is -to read the source, but we can explain some things here. - -An example of a special form is the definition of @code{prog1}, from -@file{eval.c}. (An ordinary function would have the same general -appearance.) - -@cindex garbage collection protection -@smallexample -@group -DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /* -Similar to `progn', but the value of the first form is returned. -\(prog1 FIRST BODY...): All the arguments are evaluated sequentially. -The value of FIRST is saved during evaluation of the remaining args, -whose values are discarded. -*/ - (args)) -@{ - /* This function can GC */ - REGISTER Lisp_Object val, form, tail; - struct gcpro gcpro1; - - val = Feval (XCAR (args)); - - GCPRO1 (val); - - LIST_LOOP_3 (form, XCDR (args), tail) - Feval (form); - - UNGCPRO; - return val; -@} -@end group -@end smallexample - - Let's start with a precise explanation of the arguments to the -@code{DEFUN} macro. Here is a template for them: - -@example -@group -DEFUN (@var{lname}, @var{fname}, @var{min_args}, @var{max_args}, @var{interactive}, /* -@var{docstring} -*/ - (@var{arglist})) -@end group -@end example - -@table @var -@item lname -This string is the name of the Lisp symbol to define as the function -name; in the example above, it is @code{"prog1"}. - -@item fname -This is the C function name for this function. This is the name that is -used in C code for calling the function. The name is, by convention, -@samp{F} prepended to the Lisp name, with all dashes (@samp{-}) in the -Lisp name changed to underscores. Thus, to call this function from C -code, call @code{Fprog1}. Remember that the arguments are of type -@code{Lisp_Object}; various macros and functions for creating values of -type @code{Lisp_Object} are declared in the file @file{lisp.h}. - -Primitives whose names are special characters (e.g. @code{+} or -@code{<}) are named by spelling out, in some fashion, the special -character: e.g. @code{Fplus()} or @code{Flss()}. Primitives whose names -begin with normal alphanumeric characters but also contain special -characters are spelled out in some creative way, e.g. @code{let*} -becomes @code{FletX()}. - -Each function also has an associated structure that holds the data for -the subr object that represents the function in Lisp. This structure -conveys the Lisp symbol name to the initialization routine that will -create the symbol and store the subr object as its definition. The C -variable name of this structure is always @samp{S} prepended to the -@var{fname}. You hardly ever need to be aware of the existence of this -structure, since @code{DEFUN} plus @code{DEFSUBR} takes care of all the -details. - -@item min_args -This is the minimum number of arguments that the function requires. The -function @code{prog1} allows a minimum of one argument. - -@item max_args -This is the maximum number of arguments that the function accepts, if -there is a fixed maximum. Alternatively, it can be @code{UNEVALLED}, -indicating a special form that receives unevaluated arguments, or -@code{MANY}, indicating an unlimited number of evaluated arguments (the -C equivalent of @code{&rest}). Both @code{UNEVALLED} and @code{MANY} -are macros. If @var{max_args} is a number, it may not be less than -@var{min_args} and it may not be greater than 8. (If you need to add a -function with more than 8 arguments, use the @code{MANY} form. Resist -the urge to edit the definition of @code{DEFUN} in @file{lisp.h}. If -you do it anyways, make sure to also add another clause to the switch -statement in @code{primitive_funcall().}) - -@item interactive -This is an interactive specification, a string such as might be used as -the argument of @code{interactive} in a Lisp function. In the case of -@code{prog1}, it is 0 (a null pointer), indicating that @code{prog1} -cannot be called interactively. A value of @code{""} indicates a -function that should receive no arguments when called interactively. - -@item docstring -This is the documentation string. It is written just like a -documentation string for a function defined in Lisp; in particular, the -first line should be a single sentence. Note how the documentation -string is enclosed in a comment, none of the documentation is placed on -the same lines as the comment-start and comment-end characters, and the -comment-start characters are on the same line as the interactive -specification. @file{make-docfile}, which scans the C files for -documentation strings, is very particular about what it looks for, and -will not properly extract the doc string if it's not in this exact format. - -In order to make both @file{etags} and @file{make-docfile} happy, make -sure that the @code{DEFUN} line contains the @var{lname} and -@var{fname}, and that the comment-start characters for the doc string -are on the same line as the interactive specification, and put a newline -directly after them (and before the comment-end characters). - -@item arglist -This is the comma-separated list of arguments to the C function. For a -function with a fixed maximum number of arguments, provide a C argument -for each Lisp argument. In this case, unlike regular C functions, the -types of the arguments are not declared; they are simply always of type -@code{Lisp_Object}. - -The names of the C arguments will be used as the names of the arguments -to the Lisp primitive as displayed in its documentation, modulo the same -concerns described above for @code{F...} names (in particular, -underscores in the C arguments become dashes in the Lisp arguments). - -There is one additional kludge: A trailing `_' on the C argument is -discarded when forming the Lisp argument. This allows C language -reserved words (like @code{default}) or global symbols (like -@code{dirname}) to be used as argument names without compiler warnings -or errors. - -A Lisp function with @w{@var{max_args} = @code{UNEVALLED}} is a -@w{@dfn{special form}}; its arguments are not evaluated. Instead it -receives one argument of type @code{Lisp_Object}, a (Lisp) list of the -unevaluated arguments, conventionally named @code{(args)}. - -When a Lisp function has no upper limit on the number of arguments, -specify @w{@var{max_args} = @code{MANY}}. In this case its implementation in -C actually receives exactly two arguments: the number of Lisp arguments -(an @code{int}) and the address of a block containing their values (a -@w{@code{Lisp_Object *}}). In this case only are the C types specified -in the @var{arglist}: @w{@code{(int nargs, Lisp_Object *args)}}. - -@end table - -Within the function @code{Fprog1} itself, note the use of the macros -@code{GCPRO1} and @code{UNGCPRO}. @code{GCPRO1} is used to ``protect'' -a variable from garbage collection---to inform the garbage collector -that it must look in that variable and regard the object pointed at by -its contents as an accessible object. This is necessary whenever you -call @code{Feval} or anything that can directly or indirectly call -@code{Feval} (this includes the @code{QUIT} macro!). At such a time, -any Lisp object that you intend to refer to again must be protected -somehow. @code{UNGCPRO} cancels the protection of the variables that -are protected in the current function. It is necessary to do this -explicitly. - -The macro @code{GCPRO1} protects just one local variable. If you want -to protect two, use @code{GCPRO2} instead; repeating @code{GCPRO1} will -not work. Macros @code{GCPRO3} and @code{GCPRO4} also exist. - -These macros implicitly use local variables such as @code{gcpro1}; you -must declare these explicitly, with type @code{struct gcpro}. Thus, if -you use @code{GCPRO2}, you must declare @code{gcpro1} and @code{gcpro2}. - -@cindex caller-protects (@code{GCPRO} rule) -Note also that the general rule is @dfn{caller-protects}; i.e. you are -only responsible for protecting those Lisp objects that you create. Any -objects passed to you as arguments should have been protected by whoever -created them, so you don't in general have to protect them. - -In particular, the arguments to any Lisp primitive are always -automatically @code{GCPRO}ed, when called ``normally'' from Lisp code or -bytecode. So only a few Lisp primitives that are called frequently from -C code, such as @code{Fprogn} protect their arguments as a service to -their caller. You don't need to protect your arguments when writing a -new @code{DEFUN}. - -@code{GCPRO}ing is perhaps the trickiest and most error-prone part of -XEmacs coding. It is @strong{extremely} important that you get this -right and use a great deal of discipline when writing this code. -@xref{GCPROing, ,@code{GCPRO}ing}, for full details on how to do this. - -What @code{DEFUN} actually does is declare a global structure of type -@code{Lisp_Subr} whose name begins with capital @samp{SF} and which -contains information about the primitive (e.g. a pointer to the -function, its minimum and maximum allowed arguments, a string describing -its Lisp name); @code{DEFUN} then begins a normal C function declaration -using the @code{F...} name. The Lisp subr object that is the function -definition of a primitive (i.e. the object in the function slot of the -symbol that names the primitive) actually points to this @samp{SF} -structure; when @code{Feval} encounters a subr, it looks in the -structure to find out how to call the C function. - -Defining the C function is not enough to make a Lisp primitive -available; you must also create the Lisp symbol for the primitive (the -symbol is @dfn{interned}; @pxref{Obarrays}) and store a suitable subr -object in its function cell. (If you don't do this, the primitive won't -be seen by Lisp code.) The code looks like this: - -@example -DEFSUBR (@var{fname}); -@end example - -@noindent -Here @var{fname} is the same name you used as the second argument to -@code{DEFUN}. - -This call to @code{DEFSUBR} should go in the @code{syms_of_*()} function -at the end of the module. If no such function exists, create it and -make sure to also declare it in @file{symsinit.h} and call it from the -appropriate spot in @code{main()}. @xref{General Coding Rules}. - -Note that C code cannot call functions by name unless they are defined -in C. The way to call a function written in Lisp from C is to use -@code{Ffuncall}, which embodies the Lisp function @code{funcall}. Since -the Lisp function @code{funcall} accepts an unlimited number of -arguments, in C it takes two: the number of Lisp-level arguments, and a -one-dimensional array containing their values. The first Lisp-level -argument is the Lisp function to call, and the rest are the arguments to -pass to it. Since @code{Ffuncall} can call the evaluator, you must -protect pointers from garbage collection around the call to -@code{Ffuncall}. (However, @code{Ffuncall} explicitly protects all of -its parameters, so you don't have to protect any pointers passed as -parameters to it.) - -The C functions @code{call0}, @code{call1}, @code{call2}, and so on, -provide handy ways to call a Lisp function conveniently with a fixed -number of arguments. They work by calling @code{Ffuncall}. - -@file{eval.c} is a very good file to look through for examples; -@file{lisp.h} contains the definitions for important macros and -functions. - -@node Adding Global Lisp Variables -@section Adding Global Lisp Variables - -Global variables whose names begin with @samp{Q} are constants whose -value is a symbol of a particular name. The name of the variable should -be derived from the name of the symbol using the same rules as for Lisp -primitives. These variables are initialized using a call to -@code{defsymbol()} in the @code{syms_of_*()} function. (This call -interns a symbol, sets the C variable to the resulting Lisp object, and -calls @code{staticpro()} on the C variable to tell the -garbage-collection mechanism about this variable. What -@code{staticpro()} does is add a pointer to the variable to a large -global array; when garbage-collection happens, all pointers listed in -the array are used as starting points for marking Lisp objects. This is -important because it's quite possible that the only current reference to -the object is the C variable. In the case of symbols, the -@code{staticpro()} doesn't matter all that much because the symbol is -contained in @code{obarray}, which is itself @code{staticpro()}ed. -However, it's possible that a naughty user could do something like -uninterning the symbol out of @code{obarray} or even setting -@code{obarray} to a different value [although this is likely to make -XEmacs crash!].) - - @strong{Please note:} It is potentially deadly if you declare a -@samp{Q...} variable in two different modules. The two calls to -@code{defsymbol()} are no problem, but some linkers will complain about -multiply-defined symbols. The most insidious aspect of this is that -often the link will succeed anyway, but then the resulting executable -will sometimes crash in obscure ways during certain operations! To -avoid this problem, declare any symbols with common names (such as -@code{text}) that are not obviously associated with this particular -module in the module @file{general.c}. - - Global variables whose names begin with @samp{V} are variables that -contain Lisp objects. The convention here is that all global variables -of type @code{Lisp_Object} begin with @samp{V}, and all others don't -(including integer and boolean variables that have Lisp -equivalents). Most of the time, these variables have equivalents in -Lisp, but some don't. Those that do are declared this way by a call to -@code{DEFVAR_LISP()} in the @code{vars_of_*()} initializer for the -module. What this does is create a special @dfn{symbol-value-forward} -Lisp object that contains a pointer to the C variable, intern a symbol -whose name is as specified in the call to @code{DEFVAR_LISP()}, and set -its value to the symbol-value-forward Lisp object; it also calls -@code{staticpro()} on the C variable to tell the garbage-collection -mechanism about the variable. When @code{eval} (or actually -@code{symbol-value}) encounters this special object in the process of -retrieving a variable's value, it follows the indirection to the C -variable and gets its value. @code{setq} does similar things so that -the C variable gets changed. - - Whether or not you @code{DEFVAR_LISP()} a variable, you need to -initialize it in the @code{vars_of_*()} function; otherwise it will end -up as all zeroes, which is the integer 0 (@emph{not} @code{nil}), and -this is probably not what you want. Also, if the variable is not -@code{DEFVAR_LISP()}ed, @strong{you must call} @code{staticpro()} on the -C variable in the @code{vars_of_*()} function. Otherwise, the -garbage-collection mechanism won't know that the object in this variable -is in use, and will happily collect it and reuse its storage for another -Lisp object, and you will be the one who's unhappy when you can't figure -out how your variable got overwritten. - -@node Coding for Mule -@section Coding for Mule -@cindex Coding for Mule - -Although Mule support is not compiled by default in XEmacs, many people -are using it, and we consider it crucial that new code works correctly -with multibyte characters. This is not hard; it is only a matter of -following several simple user-interface guidelines. Even if you never -compile with Mule, with a little practice you will find it quite easy -to code Mule-correctly. - -Note that these guidelines are not necessarily tied to the current Mule -implementation; they are also a good idea to follow on the grounds of -code generalization for future I18N work. - -@menu -* Character-Related Data Types:: -* Working With Character and Byte Positions:: -* Conversion to and from External Data:: -* General Guidelines for Writing Mule-Aware Code:: -* An Example of Mule-Aware Code:: -@end menu - -@node Character-Related Data Types -@subsection Character-Related Data Types - -First, let's review the basic character-related datatypes used by -XEmacs. Note that the separate @code{typedef}s are not mandatory in the -current implementation (all of them boil down to @code{unsigned char} or -@code{int}), but they improve clarity of code a great deal, because one -glance at the declaration can tell the intended use of the variable. - -@table @code -@item Emchar -@cindex Emchar -An @code{Emchar} holds a single Emacs character. - -Obviously, the equality between characters and bytes is lost in the Mule -world. Characters can be represented by one or more bytes in the -buffer, and @code{Emchar} is the C type large enough to hold any -character. - -Without Mule support, an @code{Emchar} is equivalent to an -@code{unsigned char}. - -@item Bufbyte -@cindex Bufbyte -The data representing the text in a buffer or string is logically a set -of @code{Bufbyte}s. - -XEmacs does not work with character formats all the time; when reading -characters from the outside, it decodes them to an internal format, and -likewise encodes them when writing. @code{Bufbyte} (in fact -@code{unsigned char}) is the basic unit of XEmacs internal buffers and -strings format. - -One character can correspond to one or more @code{Bufbyte}s. In the -current implementation, an ASCII character is represented by the same -@code{Bufbyte}, and extended characters are represented by a sequence of -@code{Bufbyte}s. - -Without Mule support, a @code{Bufbyte} is equivalent to an -@code{Emchar}. - -@item Bufpos -@itemx Charcount -@cindex Bufpos -@cindex Charcount -A @code{Bufpos} represents a character position in a buffer or string. -A @code{Charcount} represents a number (count) of characters. -Logically, subtracting two @code{Bufpos} values yields a -@code{Charcount} value. Although all of these are @code{typedef}ed to -@code{int}, we use them in preference to @code{int} to make it clear -what sort of position is being used. - -@code{Bufpos} and @code{Charcount} values are the only ones that are -ever visible to Lisp. - -@item Bytind -@itemx Bytecount -@cindex Bytind -@cindex Bytecount -A @code{Bytind} represents a byte position in a buffer or string. A -@code{Bytecount} represents the distance between two positions in bytes. -The relationship between @code{Bytind} and @code{Bytecount} is the same -as the relationship between @code{Bufpos} and @code{Charcount}. - -@item Extbyte -@itemx Extcount -@cindex Extbyte -@cindex Extcount -When dealing with the outside world, XEmacs works with @code{Extbyte}s, -which are equivalent to @code{unsigned char}. Obviously, an -@code{Extcount} is the distance between two @code{Extbyte}s. Extbytes -and Extcounts are not all that frequent in XEmacs code. -@end table - -@node Working With Character and Byte Positions -@subsection Working With Character and Byte Positions - -Now that we have defined the basic character-related types, we can look -at the macros and functions designed for work with them and for -conversion between them. Most of these macros are defined in -@file{buffer.h}, and we don't discuss all of them here, but only the -most important ones. Examining the existing code is the best way to -learn about them. - -@table @code -@item MAX_EMCHAR_LEN -@cindex MAX_EMCHAR_LEN -This preprocessor constant is the maximum number of buffer bytes per -Emacs character, i.e. the byte length of an @code{Emchar}. It is useful -when allocating temporary strings to keep a known number of characters. -For instance: - -@example -@group -@{ - Charcount cclen; - ... - @{ - /* Allocate place for @var{cclen} characters. */ - Bufbyte *buf = (Bufbyte *)alloca (cclen * MAX_EMCHAR_LEN); -... -@end group -@end example - -If you followed the previous section, you can guess that, logically, -multiplying a @code{Charcount} value with @code{MAX_EMCHAR_LEN} produces -a @code{Bytecount} value. - -In the current Mule implementation, @code{MAX_EMCHAR_LEN} equals 4. -Without Mule, it is 1. - -@item charptr_emchar -@itemx set_charptr_emchar -@cindex charptr_emchar -@cindex set_charptr_emchar -The @code{charptr_emchar} macro takes a @code{Bufbyte} pointer and -returns the @code{Emchar} stored at that position. If it were a -function, its prototype would be: - -@example -Emchar charptr_emchar (Bufbyte *p); -@end example - -@code{set_charptr_emchar} stores an @code{Emchar} to the specified byte -position. It returns the number of bytes stored: - -@example -Bytecount set_charptr_emchar (Bufbyte *p, Emchar c); -@end example - -It is important to note that @code{set_charptr_emchar} is safe only for -appending a character at the end of a buffer, not for overwriting a -character in the middle. This is because the width of characters -varies, and @code{set_charptr_emchar} cannot resize the string if it -writes, say, a two-byte character where a single-byte character used to -reside. - -A typical use of @code{set_charptr_emchar} can be demonstrated by this -example, which copies characters from buffer @var{buf} to a temporary -string of Bufbytes. - -@example -@group -@{ - Bufpos pos; - for (pos = beg; pos < end; pos++) - @{ - Emchar c = BUF_FETCH_CHAR (buf, pos); - p += set_charptr_emchar (buf, c); - @} -@} -@end group -@end example - -Note how @code{set_charptr_emchar} is used to store the @code{Emchar} -and increment the counter, at the same time. - -@item INC_CHARPTR -@itemx DEC_CHARPTR -@cindex INC_CHARPTR -@cindex DEC_CHARPTR -These two macros increment and decrement a @code{Bufbyte} pointer, -respectively. They will adjust the pointer by the appropriate number of -bytes according to the byte length of the character stored there. Both -macros assume that the memory address is located at the beginning of a -valid character. - -Without Mule support, @code{INC_CHARPTR (p)} and @code{DEC_CHARPTR (p)} -simply expand to @code{p++} and @code{p--}, respectively. - -@item bytecount_to_charcount -@cindex bytecount_to_charcount -Given a pointer to a text string and a length in bytes, return the -equivalent length in characters. - -@example -Charcount bytecount_to_charcount (Bufbyte *p, Bytecount bc); -@end example - -@item charcount_to_bytecount -@cindex charcount_to_bytecount -Given a pointer to a text string and a length in characters, return the -equivalent length in bytes. - -@example -Bytecount charcount_to_bytecount (Bufbyte *p, Charcount cc); -@end example - -@item charptr_n_addr -@cindex charptr_n_addr -Return a pointer to the beginning of the character offset @var{cc} (in -characters) from @var{p}. - -@example -Bufbyte *charptr_n_addr (Bufbyte *p, Charcount cc); -@end example -@end table - -@node Conversion to and from External Data -@subsection Conversion to and from External Data - -When an external function, such as a C library function, returns a -@code{char} pointer, you should almost never treat it as @code{Bufbyte}. -This is because these returned strings may contain 8bit characters which -can be misinterpreted by XEmacs, and cause a crash. Likewise, when -exporting a piece of internal text to the outside world, you should -always convert it to an appropriate external encoding, lest the internal -stuff (such as the infamous \201 characters) leak out. - -The interface to conversion between the internal and external -representations of text are the numerous conversion macros defined in -@file{buffer.h}. Before looking at them, we'll look at the external -formats supported by these macros. - -Currently meaningful formats are @code{FORMAT_BINARY}, -@code{FORMAT_FILENAME}, @code{FORMAT_OS}, and @code{FORMAT_CTEXT}. Here -is a description of these. - -@table @code -@item FORMAT_BINARY -Binary format. This is the simplest format and is what we use in the -absence of a more appropriate format. This converts according to the -@code{binary} coding system: - -@enumerate a -@item -On input, bytes 0--255 are converted into characters 0--255. -@item -On output, characters 0--255 are converted into bytes 0--255 and other -characters are converted into `X'. -@end enumerate - -@item FORMAT_FILENAME -Format used for filenames. In the original Mule, this is user-definable -with the @code{pathname-coding-system} variable. For the moment, we -just use the @code{binary} coding system. - -@item FORMAT_OS -Format used for the external Unix environment---@code{argv[]}, stuff -from @code{getenv()}, stuff from the @file{/etc/passwd} file, etc. - -Perhaps should be the same as FORMAT_FILENAME. - -@item FORMAT_CTEXT -Compound--text format. This is the standard X format used for data -stored in properties, selections, and the like. This is an 8-bit -no-lock-shift ISO2022 coding system. -@end table - -The macros to convert between these formats and the internal format, and -vice versa, follow. - -@table @code -@item GET_CHARPTR_INT_DATA_ALLOCA -@itemx GET_CHARPTR_EXT_DATA_ALLOCA -These two are the most basic conversion macros. -@code{GET_CHARPTR_INT_DATA_ALLOCA} converts external data to internal -format, and @code{GET_CHARPTR_EXT_DATA_ALLOCA} converts the other way -around. The arguments each of these receives are @var{ptr} (pointer to -the text in external format), @var{len} (length of texts in bytes), -@var{fmt} (format of the external text), @var{ptr_out} (lvalue to which -new text should be copied), and @var{len_out} (lvalue which will be -assigned the length of the internal text in bytes). The resulting text -is stored to a stack-allocated buffer. If the text doesn't need -changing, these macros will do nothing, except for setting -@var{len_out}. - -The macros above take many arguments which makes them unwieldy. For -this reason, a number of convenience macros are defined with obvious -functionality, but accepting less arguments. The general rule is that -macros with @samp{INT} in their name convert text to internal Emacs -representation, whereas the @samp{EXT} macros convert to external -representation. - -@item GET_C_CHARPTR_INT_DATA_ALLOCA -@itemx GET_C_CHARPTR_EXT_DATA_ALLOCA -As their names imply, these macros work on C char pointers, which are -zero-terminated, and thus do not need @var{len} or @var{len_out} -parameters. - -@item GET_STRING_EXT_DATA_ALLOCA -@itemx GET_C_STRING_EXT_DATA_ALLOCA -These two macros convert a Lisp string into an external representation. -The difference between them is that @code{GET_STRING_EXT_DATA_ALLOCA} -stores its output to a generic string, providing @var{len_out}, the -length of the resulting external string. On the other hand, -@code{GET_C_STRING_EXT_DATA_ALLOCA} assumes that the caller will be -satisfied with output string being zero-terminated. - -Note that for Lisp strings only one conversion direction makes sense. - -@item GET_C_CHARPTR_EXT_BINARY_DATA_ALLOCA -@itemx GET_CHARPTR_EXT_BINARY_DATA_ALLOCA -@itemx GET_STRING_BINARY_DATA_ALLOCA -@itemx GET_C_STRING_BINARY_DATA_ALLOCA -@itemx GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA -@itemx ... -These macros convert internal text to a specific external -representation, with the external format being encoded into the name of -the macro. Note that the @code{GET_STRING_...} and -@code{GET_C_STRING...} macros lack the @samp{EXT} tag, because they -only make sense in that direction. - -@item GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA -@itemx GET_CHARPTR_INT_BINARY_DATA_ALLOCA -@itemx GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA -@itemx ... -These macros convert external text of a specific format to its internal -representation, with the external format being incoded into the name of -the macro. -@end table - -@node General Guidelines for Writing Mule-Aware Code -@subsection General Guidelines for Writing Mule-Aware Code - -This section contains some general guidance on how to write Mule-aware -code, as well as some pitfalls you should avoid. - -@table @emph -@item Never use @code{char} and @code{char *}. -In XEmacs, the use of @code{char} and @code{char *} is almost always a -mistake. If you want to manipulate an Emacs character from ``C'', use -@code{Emchar}. If you want to examine a specific octet in the internal -format, use @code{Bufbyte}. If you want a Lisp-visible character, use a -@code{Lisp_Object} and @code{make_char}. If you want a pointer to move -through the internal text, use @code{Bufbyte *}. Also note that you -almost certainly do not need @code{Emchar *}. - -@item Be careful not to confuse @code{Charcount}, @code{Bytecount}, and @code{Bufpos}. -The whole point of using different types is to avoid confusion about the -use of certain variables. Lest this effect be nullified, you need to be -careful about using the right types. - -@item Always convert external data -It is extremely important to always convert external data, because -XEmacs can crash if unexpected 8bit sequences are copied to its internal -buffers literally. - -This means that when a system function, such as @code{readdir}, returns -a string, you need to convert it using one of the conversion macros -described in the previous chapter, before passing it further to Lisp. -In the case of @code{readdir}, you would use the -@code{GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA} macro. - -Also note that many internal functions, such as @code{make_string}, -accept Bufbytes, which removes the need for them to convert the data -they receive. This increases efficiency because that way external data -needs to be decoded only once, when it is read. After that, it is -passed around in internal format. -@end table - -@node An Example of Mule-Aware Code -@subsection An Example of Mule-Aware Code - -As an example of Mule-aware code, we shall will analyze the -@code{string} function, which conses up a Lisp string from the character -arguments it receives. Here is the definition, pasted from -@code{alloc.c}: - -@example -@group -DEFUN ("string", Fstring, 0, MANY, 0, /* -Concatenate all the argument characters and make the result a string. -*/ - (int nargs, Lisp_Object *args)) -@{ - Bufbyte *storage = alloca_array (Bufbyte, nargs * MAX_EMCHAR_LEN); - Bufbyte *p = storage; - - for (; nargs; nargs--, args++) - @{ - Lisp_Object lisp_char = *args; - CHECK_CHAR_COERCE_INT (lisp_char); - p += set_charptr_emchar (p, XCHAR (lisp_char)); - @} - return make_string (storage, p - storage); -@} -@end group -@end example - -Now we can analyze the source line by line. - -Obviously, string will be as long as there are arguments to the -function. This is why we allocate @code{MAX_EMCHAR_LEN} * @var{nargs} -bytes on the stack, i.e. the worst-case number of bytes for @var{nargs} -@code{Emchar}s to fit in the string. - -Then, the loop checks that each element is a character, converting -integers in the process. Like many other functions in XEmacs, this -function silently accepts integers where characters are expected, for -historical and compatibility reasons. Unless you know what you are -doing, @code{CHECK_CHAR} will also suffice. @code{XCHAR (lisp_char)} -extracts the @code{Emchar} from the @code{Lisp_Object}, and -@code{set_charptr_emchar} stores it to storage, increasing @code{p} in -the process. - -Other instructive examples of correct coding under Mule can be found all -over the XEmacs code. For starters, I recommend -@code{Fnormalize_menu_item_name} in @file{menubar.c}. After you have -understood this section of the manual and studied the examples, you can -proceed writing new Mule-aware code. - -@node Techniques for XEmacs Developers -@section Techniques for XEmacs Developers - -To make a quantified XEmacs, do: @code{make quantmacs}. - -You simply can't dump Quantified and Purified images. Run the image -like so: @code{quantmacs -batch -l loadup.el run-temacs @var{xemacs-args...}}. - -Before you go through the trouble, are you compiling with all -debugging and error-checking off? If not try that first. Be warned -that while Quantify is directly responsible for quite a few -optimizations which have been made to XEmacs, doing a run which -generates results which can be acted upon is not necessarily a trivial -task. - -Also, if you're still willing to do some runs make sure you configure -with the @samp{--quantify} flag. That will keep Quantify from starting -to record data until after the loadup is completed and will shut off -recording right before it shuts down (which generates enough bogus data -to throw most results off). It also enables three additional elisp -commands: @code{quantify-start-recording-data}, -@code{quantify-stop-recording-data} and @code{quantify-clear-data}. - -If you want to make XEmacs faster, target your favorite slow benchmark, -run a profiler like Quantify, @code{gprof}, or @code{tcov}, and figure -out where the cycles are going. Specific projects: - -@itemize @bullet -@item -Make the garbage collector faster. Figure out how to write an -incremental garbage collector. -@item -Write a compiler that takes bytecode and spits out C code. -Unfortunately, you will then need a C compiler and a more fully -developed module system. -@item -Speed up redisplay. -@item -Speed up syntax highlighting. Maybe moving some of the syntax -highlighting capabilities into C would make a difference. -@item -Implement tail recursion in Emacs Lisp (hard!). -@end itemize - -Unfortunately, Emacs Lisp is slow, and is going to stay slow. Function -calls in elisp are especially expensive. Iterating over a long list is -going to be 30 times faster implemented in C than in Elisp. - -To get started debugging XEmacs, take a look at the @file{gdbinit} and -@file{dbxrc} files in the @file{src} directory. -@xref{Q2.1.15 - How to Debug an XEmacs problem with a debugger,,, -xemacs-faq, XEmacs FAQ}. - -After making source code changes, run @code{make check} to ensure that -you haven't introduced any regressions. If you're feeling ambitious, -you can try to improve the test suite in @file{tests/automated}. - -Here are things to know when you create a new source file: - -@itemize @bullet -@item -All @file{.c} files should @code{#include } first. Almost all -@file{.c} files should @code{#include "lisp.h"} second. - -@item -Generated header files should be included using the @code{#include <...>} syntax, -not the @code{#include "..."} syntax. The generated headers are: - -@file{config.h puresize-adjust.h sheap-adjust.h paths.h Emacs.ad.h} - -The basic rule is that you should assume builds using @code{--srcdir} -and the @code{#include <...>} syntax needs to be used when the -to-be-included generated file is in a potentially different directory -@emph{at compile time}. The non-obvious C rule is that @code{#include "..."} -means to search for the included file in the same directory as the -including file, @emph{not} in the current directory. - -@item -Header files should @emph{not} include @code{} and -@code{"lisp.h"}. It is the responsibility of the @file{.c} files that -use it to do so. - -@item -If the header uses @code{INLINE}, either directly or through -@code{DECLARE_LRECORD}, then it must be added to @file{inline.c}'s -includes. - -@item -Try compiling at least once with - -@example -gcc --with-mule --with-union-type --error-checking=all -@end example - -@item -Did I mention that you should run the test suite? -@example -make check -@end example -@end itemize - - -@node A Summary of the Various XEmacs Modules, Allocation of Objects in XEmacs Lisp, Rules When Writing New C Code, Top -@chapter A Summary of the Various XEmacs Modules - - This is accurate as of XEmacs 20.0. - -@menu -* Low-Level Modules:: -* Basic Lisp Modules:: -* Modules for Standard Editing Operations:: -* Editor-Level Control Flow Modules:: -* Modules for the Basic Displayable Lisp Objects:: -* Modules for other Display-Related Lisp Objects:: -* Modules for the Redisplay Mechanism:: -* Modules for Interfacing with the File System:: -* Modules for Other Aspects of the Lisp Interpreter and Object System:: -* Modules for Interfacing with the Operating System:: -* Modules for Interfacing with X Windows:: -* Modules for Internationalization:: -@end menu - -@node Low-Level Modules -@section Low-Level Modules - -@example -config.h -@end example - -This is automatically generated from @file{config.h.in} based on the -results of configure tests and user-selected optional features and -contains preprocessor definitions specifying the nature of the -environment in which XEmacs is being compiled. - - - -@example -paths.h -@end example - -This is automatically generated from @file{paths.h.in} based on supplied -configure values, and allows for non-standard installed configurations -of the XEmacs directories. It's currently broken, though. - - - -@example -emacs.c -signal.c -@end example - -@file{emacs.c} contains @code{main()} and other code that performs the most -basic environment initializations and handles shutting down the XEmacs -process (this includes @code{kill-emacs}, the normal way that XEmacs is -exited; @code{dump-emacs}, which is used during the build process to -write out the XEmacs executable; @code{run-emacs-from-temacs}, which can -be used to start XEmacs directly when temacs has finished loading all -the Lisp code; and emergency code to handle crashes [XEmacs tries to -auto-save all files before it crashes]). - -Low-level code that directly interacts with the Unix signal mechanism, -however, is in @file{signal.c}. Note that this code does not handle system -dependencies in interfacing to signals; that is handled using the -@file{syssignal.h} header file, described in section J below. - - - -@example -unexaix.c -unexalpha.c -unexapollo.c -unexconvex.c -unexec.c -unexelf.c -unexelfsgi.c -unexencap.c -unexenix.c -unexfreebsd.c -unexfx2800.c -unexhp9k3.c -unexhp9k800.c -unexmips.c -unexnext.c -unexsol2.c -unexsunos4.c -@end example - -These modules contain code dumping out the XEmacs executable on various -different systems. (This process is highly machine-specific and -requires intimate knowledge of the executable format and the memory map -of the process.) Only one of these modules is actually used; this is -chosen by @file{configure}. - - - -@example -crt0.c -lastfile.c -pre-crt0.c -@end example - -These modules are used in conjunction with the dump mechanism. On some -systems, an alternative version of the C startup code (the actual code -that receives control from the operating system when the process is -started, and which calls @code{main()}) is required so that the dumping -process works properly; @file{crt0.c} provides this. - -@file{pre-crt0.c} and @file{lastfile.c} should be the very first and -very last file linked, respectively. (Actually, this is not really true. -@file{lastfile.c} should be after all Emacs modules whose initialized -data should be made constant, and before all other Emacs files and all -libraries. In particular, the allocation modules @file{gmalloc.c}, -@file{alloca.c}, etc. are normally placed past @file{lastfile.c}, and -all of the files that implement Xt widget classes @emph{must} be placed -after @file{lastfile.c} because they contain various structures that -must be statically initialized and into which Xt writes at various -times.) @file{pre-crt0.c} and @file{lastfile.c} contain exported symbols -that are used to determine the start and end of XEmacs' initialized -data space when dumping. - - - -@example -alloca.c -free-hook.c -getpagesize.h -gmalloc.c -malloc.c -mem-limits.h -ralloc.c -vm-limit.c -@end example - -These handle basic C allocation of memory. @file{alloca.c} is an emulation of -the stack allocation function @code{alloca()} on machines that lack -this. (XEmacs makes extensive use of @code{alloca()} in its code.) - -@file{gmalloc.c} and @file{malloc.c} are two implementations of the standard C -functions @code{malloc()}, @code{realloc()} and @code{free()}. They are -often used in place of the standard system-provided @code{malloc()} -because they usually provide a much faster implementation, at the -expense of additional memory use. @file{gmalloc.c} is a newer implementation -that is much more memory-efficient for large allocations than @file{malloc.c}, -and should always be preferred if it works. (At one point, @file{gmalloc.c} -didn't work on some systems where @file{malloc.c} worked; but this should be -fixed now.) - -@cindex relocating allocator -@file{ralloc.c} is the @dfn{relocating allocator}. It provides -functions similar to @code{malloc()}, @code{realloc()} and @code{free()} -that allocate memory that can be dynamically relocated in memory. The -advantage of this is that allocated memory can be shuffled around to -place all the free memory at the end of the heap, and the heap can then -be shrunk, releasing the memory back to the operating system. The use -of this can be controlled with the configure option @code{--rel-alloc}; -if enabled, memory allocated for buffers will be relocatable, so that if -a very large file is visited and the buffer is later killed, the memory -can be released to the operating system. (The disadvantage of this -mechanism is that it can be very slow. On systems with the -@code{mmap()} system call, the XEmacs version of @file{ralloc.c} uses -this to move memory around without actually having to block-copy it, -which can speed things up; but it can still cause noticeable performance -degradation.) - -@file{free-hook.c} contains some debugging functions for checking for invalid -arguments to @code{free()}. - -@file{vm-limit.c} contains some functions that warn the user when memory is -getting low. These are callback functions that are called by @file{gmalloc.c} -and @file{malloc.c} at appropriate times. - -@file{getpagesize.h} provides a uniform interface for retrieving the size of a -page in virtual memory. @file{mem-limits.h} provides a uniform interface for -retrieving the total amount of available virtual memory. Both are -similar in spirit to the @file{sys*.h} files described in section J, below. - - - -@example -blocktype.c -blocktype.h -dynarr.c -@end example - -These implement a couple of basic C data types to facilitate memory -allocation. The @code{Blocktype} type efficiently manages the -allocation of fixed-size blocks by minimizing the number of times that -@code{malloc()} and @code{free()} are called. It allocates memory in -large chunks, subdivides the chunks into blocks of the proper size, and -returns the blocks as requested. When blocks are freed, they are placed -onto a linked list, so they can be efficiently reused. This data type -is not much used in XEmacs currently, because it's a fairly new -addition. - -@cindex dynamic array -The @code{Dynarr} type implements a @dfn{dynamic array}, which is -similar to a standard C array but has no fixed limit on the number of -elements it can contain. Dynamic arrays can hold elements of any type, -and when you add a new element, the array automatically resizes itself -if it isn't big enough. Dynarrs are extensively used in the redisplay -mechanism. - - - -@example -inline.c -@end example - -This module is used in connection with inline functions (available in -some compilers). Often, inline functions need to have a corresponding -non-inline function that does the same thing. This module is where they -reside. It contains no actual code, but defines some special flags that -cause inline functions defined in header files to be rendered as actual -functions. It then includes all header files that contain any inline -function definitions, so that each one gets a real function equivalent. - - - -@example -debug.c -debug.h -@end example - -These functions provide a system for doing internal consistency checks -during code development. This system is not currently used; instead the -simpler @code{assert()} macro is used along with the various checks -provided by the @samp{--error-check-*} configuration options. - - - -@example -prefix-args.c -@end example - -This is actually the source for a small, self-contained program -used during building. - - -@example -universe.h -@end example - -This is not currently used. - - - -@node Basic Lisp Modules -@section Basic Lisp Modules - -@example -emacsfns.h -lisp-disunion.h -lisp-union.h -lisp.h -lrecord.h -symsinit.h -@end example - -These are the basic header files for all XEmacs modules. Each module -includes @file{lisp.h}, which brings the other header files in. -@file{lisp.h} contains the definitions of the structures and extractor -and constructor macros for the basic Lisp objects and various other -basic definitions for the Lisp environment, as well as some -general-purpose definitions (e.g. @code{min()} and @code{max()}). -@file{lisp.h} includes either @file{lisp-disunion.h} or -@file{lisp-union.h}, depending on whether @code{USE_UNION_TYPE} is -defined. These files define the typedef of the Lisp object itself (as -described above) and the low-level macros that hide the actual -implementation of the Lisp object. All extractor and constructor macros -for particular types of Lisp objects are defined in terms of these -low-level macros. - -As a general rule, all typedefs should go into the typedefs section of -@file{lisp.h} rather than into a module-specific header file even if the -structure is defined elsewhere. This allows function prototypes that -use the typedef to be placed into other header files. Forward structure -declarations (i.e. a simple declaration like @code{struct foo;} where -the structure itself is defined elsewhere) should be placed into the -typedefs section as necessary. - -@file{lrecord.h} contains the basic structures and macros that implement -all record-type Lisp objects -- i.e. all objects whose type is a field -in their C structure, which includes all objects except the few most -basic ones. - -@file{lisp.h} contains prototypes for most of the exported functions in -the various modules. Lisp primitives defined using @code{DEFUN} that -need to be called by C code should be declared using @code{EXFUN}. -Other function prototypes should be placed either into the appropriate -section of @code{lisp.h}, or into a module-specific header file, -depending on how general-purpose the function is and whether it has -special-purpose argument types requiring definitions not in -@file{lisp.h}.) All initialization functions are prototyped in -@file{symsinit.h}. - - - -@example -alloc.c -pure.c -puresize.h -@end example - -The large module @file{alloc.c} implements all of the basic allocation and -garbage collection for Lisp objects. The most commonly used Lisp -objects are allocated in chunks, similar to the Blocktype data type -described above; others are allocated in individually @code{malloc()}ed -blocks. This module provides the foundation on which all other aspects -of the Lisp environment sit, and is the first module initialized at -startup. - -Note that @file{alloc.c} provides a series of generic functions that are -not dependent on any particular object type, and interfaces to -particular types of objects using a standardized interface of -type-specific methods. This scheme is a fundamental principle of -object-oriented programming and is heavily used throughout XEmacs. The -great advantage of this is that it allows for a clean separation of -functionality into different modules -- new classes of Lisp objects, new -event interfaces, new device types, new stream interfaces, etc. can be -added transparently without affecting code anywhere else in XEmacs. -Because the different subsystems are divided into general and specific -code, adding a new subtype within a subsystem will in general not -require changes to the generic subsystem code or affect any of the other -subtypes in the subsystem; this provides a great deal of robustness to -the XEmacs code. - -@cindex pure space -@file{pure.c} contains the declaration of the @dfn{purespace} array. -Pure space is a hack used to place some constant Lisp data into the code -segment of the XEmacs executable, even though the data needs to be -initialized through function calls. (See above in section VIII for more -info about this.) During startup, certain sorts of data is -automatically copied into pure space, and other data is copied manually -in some of the basic Lisp files by calling the function @code{purecopy}, -which copies the object if possible (this only works in temacs, of -course) and returns the new object. In particular, while temacs is -executing, the Lisp reader automatically copies all compiled-function -objects that it reads into pure space. Since compiled-function objects -are large, are never modified, and typically comprise the majority of -the contents of a compiled-Lisp file, this works well. While XEmacs is -running, any attempt to modify an object that resides in pure space -causes an error. Objects in pure space are never garbage collected -- -almost all of the time, they're intended to be permanent, and in any -case you can't write into pure space to set the mark bits. - -@file{puresize.h} contains the declaration of the size of the pure space -array. This depends on the optional features that are compiled in, any -extra purespace requested by the user at compile time, and certain other -factors (e.g. 64-bit machines need more pure space because their Lisp -objects are larger). The smallest size that suffices should be used, so -that there's no wasted space. If there's not enough pure space, you -will get an error during the build process, specifying how much more -pure space is needed. - - - -@example -eval.c -backtrace.h -@end example - -This module contains all of the functions to handle the flow of control. -This includes the mechanisms of defining functions, calling functions, -traversing stack frames, and binding variables; the control primitives -and other special forms such as @code{while}, @code{if}, @code{eval}, -@code{let}, @code{and}, @code{or}, @code{progn}, etc.; handling of -non-local exits, unwind-protects, and exception handlers; entering the -debugger; methods for the subr Lisp object type; etc. It does -@emph{not} include the @code{read} function, the @code{print} function, -or the handling of symbols and obarrays. - -@file{backtrace.h} contains some structures related to stack frames and the -flow of control. - - - -@example -lread.c -@end example - -This module implements the Lisp reader and the @code{read} function, -which converts text into Lisp objects, according to the read syntax of -the objects, as described above. This is similar to the parser that is -a part of all compilers. - - - -@example -print.c -@end example - -This module implements the Lisp print mechanism and the @code{print} -function and related functions. This is the inverse of the Lisp reader --- it converts Lisp objects to a printed, textual representation. -(Hopefully something that can be read back in using @code{read} to get -an equivalent object.) - - - -@example -general.c -symbols.c -symeval.h -@end example - -@file{symbols.c} implements the handling of symbols, obarrays, and -retrieving the values of symbols. Much of the code is devoted to -handling the special @dfn{symbol-value-magic} objects that define -special types of variables -- this includes buffer-local variables, -variable aliases, variables that forward into C variables, etc. This -module is initialized extremely early (right after @file{alloc.c}), -because it is here that the basic symbols @code{t} and @code{nil} are -created, and those symbols are used everywhere throughout XEmacs. - -@file{symeval.h} contains the definitions of symbol structures and the -@code{DEFVAR_LISP()} and related macros for declaring variables. - - - -@example -data.c -floatfns.c -fns.c -@end example - -These modules implement the methods and standard Lisp primitives for all -the basic Lisp object types other than symbols (which are described -above). @file{data.c} contains all the predicates (primitives that return -whether an object is of a particular type); the integer arithmetic -functions; and the basic accessor and mutator primitives for the various -object types. @file{fns.c} contains all the standard predicates for working -with sequences (where, abstractly speaking, a sequence is an ordered set -of objects, and can be represented by a list, string, vector, or -bit-vector); it also contains @code{equal}, perhaps on the grounds that -bulk of the operation of @code{equal} is comparing sequences. -@file{floatfns.c} contains methods and primitives for floats and floating-point -arithmetic. - - - -@example -bytecode.c -bytecode.h -@end example - -@file{bytecode.c} implements the byte-code interpreter and -compiled-function objects, and @file{bytecode.h} contains associated -structures. Note that the byte-code @emph{compiler} is written in Lisp. - - - - -@node Modules for Standard Editing Operations -@section Modules for Standard Editing Operations - -@example -buffer.c -buffer.h -bufslots.h -@end example - -@file{buffer.c} implements the @dfn{buffer} Lisp object type. This -includes functions that create and destroy buffers; retrieve buffers by -name or by other properties; manipulate lists of buffers (remember that -buffers are permanent objects and stored in various ordered lists); -retrieve or change buffer properties; etc. It also contains the -definitions of all the built-in buffer-local variables (which can be -viewed as buffer properties). It does @emph{not} contain code to -manipulate buffer-local variables (that's in @file{symbols.c}, described -above); or code to manipulate the text in a buffer. - -@file{buffer.h} defines the structures associated with a buffer and the various -macros for retrieving text from a buffer and special buffer positions -(e.g. @code{point}, the default location for text insertion). It also -contains macros for working with buffer positions and converting between -their representations as character offsets and as byte offsets (under -MULE, they are different, because characters can be multi-byte). It is -one of the largest header files. - -@file{bufslots.h} defines the fields in the buffer structure that correspond to -the built-in buffer-local variables. It is its own header file because -it is included many times in @file{buffer.c}, as a way of iterating over all -the built-in buffer-local variables. - - - -@example -insdel.c -insdel.h -@end example - -@file{insdel.c} contains low-level functions for inserting and deleting text in -a buffer, keeping track of changed regions for use by redisplay, and -calling any before-change and after-change functions that may have been -registered for the buffer. It also contains the actual functions that -convert between byte offsets and character offsets. - -@file{insdel.h} contains associated headers. - - - -@example -marker.c -@end example - -This module implements the @dfn{marker} Lisp object type, which -conceptually is a pointer to a text position in a buffer that moves -around as text is inserted and deleted, so as to remain in the same -relative position. This module doesn't actually move the markers around --- that's handled in @file{insdel.c}. This module just creates them and -implements the primitives for working with them. As markers are simple -objects, this does not entail much. - -Note that the standard arithmetic primitives (e.g. @code{+}) accept -markers in place of integers and automatically substitute the value of -@code{marker-position} for the marker, i.e. an integer describing the -current buffer position of the marker. - - - -@example -extents.c -extents.h -@end example - -This module implements the @dfn{extent} Lisp object type, which is like -a marker that works over a range of text rather than a single position. -Extents are also much more complex and powerful than markers and have a -more efficient (and more algorithmically complex) implementation. The -implementation is described in detail in comments in @file{extents.c}. - -The code in @file{extents.c} works closely with @file{insdel.c} so that -extents are properly moved around as text is inserted and deleted. -There is also code in @file{extents.c} that provides information needed -by the redisplay mechanism for efficient operation. (Remember that -extents can have display properties that affect [sometimes drastically, -as in the @code{invisible} property] the display of the text they -cover.) - - - -@example -editfns.c -@end example - -@file{editfns.c} contains the standard Lisp primitives for working with -a buffer's text, and calls the low-level functions in @file{insdel.c}. -It also contains primitives for working with @code{point} (the default -buffer insertion location). - -@file{editfns.c} also contains functions for retrieving various -characteristics from the external environment: the current time, the -process ID of the running XEmacs process, the name of the user who ran -this XEmacs process, etc. It's not clear why this code is in -@file{editfns.c}. - - - -@example -callint.c -cmds.c -commands.h -@end example - -@cindex interactive -These modules implement the basic @dfn{interactive} commands, -i.e. user-callable functions. Commands, as opposed to other functions, -have special ways of getting their parameters interactively (by querying -the user), as opposed to having them passed in a normal function -invocation. Many commands are not really meant to be called from other -Lisp functions, because they modify global state in a way that's often -undesired as part of other Lisp functions. - -@file{callint.c} implements the mechanism for querying the user for -parameters and calling interactive commands. The bulk of this module is -code that parses the interactive spec that is supplied with an -interactive command. - -@file{cmds.c} implements the basic, most commonly used editing commands: -commands to move around the current buffer and insert and delete -characters. These commands are implemented using the Lisp primitives -defined in @file{editfns.c}. - -@file{commands.h} contains associated structure definitions and prototypes. - - - -@example -regex.c -regex.h -search.c -@end example - -@file{search.c} implements the Lisp primitives for searching for text in -a buffer, and some of the low-level algorithms for doing this. In -particular, the fast fixed-string Boyer-Moore search algorithm is -implemented in @file{search.c}. The low-level algorithms for doing -regular-expression searching, however, are implemented in @file{regex.c} -and @file{regex.h}. These two modules are largely independent of -XEmacs, and are similar to (and based upon) the regular-expression -routines used in @file{grep} and other GNU utilities. - - - -@example -doprnt.c -@end example - -@file{doprnt.c} implements formatted-string processing, similar to -@code{printf()} command in C. - - - -@example -undo.c -@end example - -This module implements the undo mechanism for tracking buffer changes. -Most of this could be implemented in Lisp. - - - -@node Editor-Level Control Flow Modules -@section Editor-Level Control Flow Modules - -@example -event-Xt.c -event-stream.c -event-tty.c -events.c -events.h -@end example - -These implement the handling of events (user input and other system -notifications). - -@file{events.c} and @file{events.h} define the @dfn{event} Lisp object -type and primitives for manipulating it. - -@file{event-stream.c} implements the basic functions for working with -event queues, dispatching an event by looking it up in relevant keymaps -and such, and handling timeouts; this includes the primitives -@code{next-event} and @code{dispatch-event}, as well as related -primitives such as @code{sit-for}, @code{sleep-for}, and -@code{accept-process-output}. (@file{event-stream.c} is one of the -hairiest and trickiest modules in XEmacs. Beware! You can easily mess -things up here.) - -@file{event-Xt.c} and @file{event-tty.c} implement the low-level -interfaces onto retrieving events from Xt (the X toolkit) and from TTY's -(using @code{read()} and @code{select()}), respectively. The event -interface enforces a clean separation between the specific code for -interfacing with the operating system and the generic code for working -with events, by defining an API of basic, low-level event methods; -@file{event-Xt.c} and @file{event-tty.c} are two different -implementations of this API. To add support for a new operating system -(e.g. NeXTstep), one merely needs to provide another implementation of -those API functions. - -Note that the choice of whether to use @file{event-Xt.c} or -@file{event-tty.c} is made at compile time! Or at the very latest, it -is made at startup time. @file{event-Xt.c} handles events for -@emph{both} X and TTY frames; @file{event-tty.c} is only used when X -support is not compiled into XEmacs. The reason for this is that there -is only one event loop in XEmacs: thus, it needs to be able to receive -events from all different kinds of frames. - - - -@example -keymap.c -keymap.h -@end example - -@file{keymap.c} and @file{keymap.h} define the @dfn{keymap} Lisp object -type and associated methods and primitives. (Remember that keymaps are -objects that associate event descriptions with functions to be called to -``execute'' those events; @code{dispatch-event} looks up events in the -relevant keymaps.) - - - -@example -keyboard.c -@end example - -@file{keyboard.c} contains functions that implement the actual editor -command loop -- i.e. the event loop that cyclically retrieves and -dispatches events. This code is also rather tricky, just like -@file{event-stream.c}. - - - -@example -macros.c -macros.h -@end example - -These two modules contain the basic code for defining keyboard macros. -These functions don't actually do much; most of the code that handles keyboard -macros is mixed in with the event-handling code in @file{event-stream.c}. - - - -@example -minibuf.c -@end example - -This contains some miscellaneous code related to the minibuffer (most of -the minibuffer code was moved into Lisp by Richard Mlynarik). This -includes the primitives for completion (although filename completion is -in @file{dired.c}), the lowest-level interface to the minibuffer (if the -command loop were cleaned up, this too could be in Lisp), and code for -dealing with the echo area (this, too, was mostly moved into Lisp, and -the only code remaining is code to call out to Lisp or provide simple -bootstrapping implementations early in temacs, before the echo-area Lisp -code is loaded). - - - -@node Modules for the Basic Displayable Lisp Objects -@section Modules for the Basic Displayable Lisp Objects - -@example -device-ns.h -device-stream.c -device-stream.h -device-tty.c -device-tty.h -device-x.c -device-x.h -device.c -device.h -@end example - -These modules implement the @dfn{device} Lisp object type. This -abstracts a particular screen or connection on which frames are -displayed. As with Lisp objects, event interfaces, and other -subsystems, the device code is separated into a generic component that -contains a standardized interface (in the form of a set of methods) onto -particular device types. - -The device subsystem defines all the methods and provides method -services for not only device operations but also for the frame, window, -menubar, scrollbar, toolbar, and other displayable-object subsystems. -The reason for this is that all of these subsystems have the same -subtypes (X, TTY, NeXTstep, Microsoft Windows, etc.) as devices do. - - - -@example -frame-ns.h -frame-tty.c -frame-x.c -frame-x.h -frame.c -frame.h -@end example - -Each device contains one or more frames in which objects (e.g. text) are -displayed. A frame corresponds to a window in the window system; -usually this is a top-level window but it could potentially be one of a -number of overlapping child windows within a top-level window, using the -MDI (Multiple Document Interface) protocol in Microsoft Windows or a -similar scheme. - -The @file{frame-*} files implement the @dfn{frame} Lisp object type and -provide the generic and device-type-specific operations on frames -(e.g. raising, lowering, resizing, moving, etc.). - - - -@example -window.c -window.h -@end example - -@cindex window (in Emacs) -@cindex pane -Each frame consists of one or more non-overlapping @dfn{windows} (better -known as @dfn{panes} in standard window-system terminology) in which a -buffer's text can be displayed. Windows can also have scrollbars -displayed around their edges. - -@file{window.c} and @file{window.h} implement the @dfn{window} Lisp -object type and provide code to manage windows. Since windows have no -associated resources in the window system (the window system knows only -about the frame; no child windows or anything are used for XEmacs -windows), there is no device-type-specific code here; all of that code -is part of the redisplay mechanism or the code for particular object -types such as scrollbars. - - - -@node Modules for other Display-Related Lisp Objects -@section Modules for other Display-Related Lisp Objects - -@example -faces.c -faces.h -@end example - - - -@example -bitmaps.h -glyphs-ns.h -glyphs-x.c -glyphs-x.h -glyphs.c -glyphs.h -@end example - - - -@example -objects-ns.h -objects-tty.c -objects-tty.h -objects-x.c -objects-x.h -objects.c -objects.h -@end example - - - -@example -menubar-x.c -menubar.c -@end example - - - -@example -scrollbar-x.c -scrollbar-x.h -scrollbar.c -scrollbar.h -@end example - - - -@example -toolbar-x.c -toolbar.c -toolbar.h -@end example - - - -@example -font-lock.c -@end example - -This file provides C support for syntax highlighting -- i.e. -highlighting different syntactic constructs of a source file in -different colors, for easy reading. The C support is provided so that -this is fast. - - - -@example -dgif_lib.c -gif_err.c -gif_lib.h -gifalloc.c -@end example - -These modules decode GIF-format image files, for use with glyphs. - - - -@node Modules for the Redisplay Mechanism -@section Modules for the Redisplay Mechanism - -@example -redisplay-output.c -redisplay-tty.c -redisplay-x.c -redisplay.c -redisplay.h -@end example - -These files provide the redisplay mechanism. As with many other -subsystems in XEmacs, there is a clean separation between the general -and device-specific support. - -@file{redisplay.c} contains the bulk of the redisplay engine. These -functions update the redisplay structures (which describe how the screen -is to appear) to reflect any changes made to the state of any -displayable objects (buffer, frame, window, etc.) since the last time -that redisplay was called. These functions are highly optimized to -avoid doing more work than necessary (since redisplay is called -extremely often and is potentially a huge time sink), and depend heavily -on notifications from the objects themselves that changes have occurred, -so that redisplay doesn't explicitly have to check each possible object. -The redisplay mechanism also contains a great deal of caching to further -speed things up; some of this caching is contained within the various -displayable objects. - -@file{redisplay-output.c} goes through the redisplay structures and converts -them into calls to device-specific methods to actually output the screen -changes. - -@file{redisplay-x.c} and @file{redisplay-tty.c} are two implementations -of these redisplay output methods, for X frames and TTY frames, -respectively. - - - -@example -indent.c -@end example - -This module contains various functions and Lisp primitives for -converting between buffer positions and screen positions. These -functions call the redisplay mechanism to do most of the work, and then -examine the redisplay structures to get the necessary information. This -module needs work. - - - -@example -termcap.c -terminfo.c -tparam.c -@end example - -These files contain functions for working with the termcap (BSD-style) -and terminfo (System V style) databases of terminal capabilities and -escape sequences, used when XEmacs is displaying in a TTY. - - - -@example -cm.c -cm.h -@end example - -These files provide some miscellaneous TTY-output functions and should -probably be merged into @file{redisplay-tty.c}. - - - -@node Modules for Interfacing with the File System -@section Modules for Interfacing with the File System - -@example -lstream.c -lstream.h -@end example - -These modules implement the @dfn{stream} Lisp object type. This is an -internal-only Lisp object that implements a generic buffering stream. -The idea is to provide a uniform interface onto all sources and sinks of -data, including file descriptors, stdio streams, chunks of memory, Lisp -buffers, Lisp strings, etc. That way, I/O functions can be written to -the stream interface and can transparently handle all possible sources -and sinks. (For example, the @code{read} function can read data from a -file, a string, a buffer, or even a function that is called repeatedly -to return data, without worrying about where the data is coming from or -what-size chunks it is returned in.) - -@cindex lstream -Note that in the C code, streams are called @dfn{lstreams} (for ``Lisp -streams'') to distinguish them from other kinds of streams, e.g. stdio -streams and C++ I/O streams. - -Similar to other subsystems in XEmacs, lstreams are separated into -generic functions and a set of methods for the different types of -lstreams. @file{lstream.c} provides implementations of many different -types of streams; others are provided, e.g., in @file{mule-coding.c}. - - - -@example -fileio.c -@end example - -This implements the basic primitives for interfacing with the file -system. This includes primitives for reading files into buffers, -writing buffers into files, checking for the presence or accessibility -of files, canonicalizing file names, etc. Note that these primitives -are usually not invoked directly by the user: There is a great deal of -higher-level Lisp code that implements the user commands such as -@code{find-file} and @code{save-buffer}. This is similar to the -distinction between the lower-level primitives in @file{editfns.c} and -the higher-level user commands in @file{commands.c} and -@file{simple.el}. - - - -@example -filelock.c -@end example - -This file provides functions for detecting clashes between different -processes (e.g. XEmacs and some external process, or two different -XEmacs processes) modifying the same file. (XEmacs can optionally use -the @file{lock/} subdirectory to provide a form of ``locking'' between -different XEmacs processes.) This module is also used by the low-level -functions in @file{insdel.c} to ensure that, if the first modification -is being made to a buffer whose corresponding file has been externally -modified, the user is made aware of this so that the buffer can be -synched up with the external changes if necessary. - - -@example -filemode.c -@end example - -This file provides some miscellaneous functions that construct a -@samp{rwxr-xr-x}-type permissions string (as might appear in an -@file{ls}-style directory listing) given the information returned by the -@code{stat()} system call. - - - -@example -dired.c -ndir.h -@end example - -These files implement the XEmacs interface to directory searching. This -includes a number of primitives for determining the files in a directory -and for doing filename completion. (Remember that generic completion is -handled by a different mechanism, in @file{minibuf.c}.) - -@file{ndir.h} is a header file used for the directory-searching -emulation functions provided in @file{sysdep.c} (see section J below), -for systems that don't provide any directory-searching functions. (On -those systems, directories can be read directly as files, and parsed.) - - - -@example -realpath.c -@end example - -This file provides an implementation of the @code{realpath()} function -for expanding symbolic links, on systems that don't implement it or have -a broken implementation. - - - -@node Modules for Other Aspects of the Lisp Interpreter and Object System -@section Modules for Other Aspects of the Lisp Interpreter and Object System - -@example -elhash.c -elhash.h -hash.c -hash.h -@end example - -These files provide two implementations of hash tables. Files -@file{hash.c} and @file{hash.h} provide a generic C implementation of -hash tables which can stand independently of XEmacs. Files -@file{elhash.c} and @file{elhash.h} provide a separate implementation of -hash tables that can store only Lisp objects, and knows about Lispy -things like garbage collection, and implement the @dfn{hash-table} Lisp -object type. - - -@example -specifier.c -specifier.h -@end example - -This module implements the @dfn{specifier} Lisp object type. This is -primarily used for displayable properties, and allows for values that -are specific to a particular buffer, window, frame, device, or device -class, as well as a default value existing. This is used, for example, -to control the height of the horizontal scrollbar or the appearance of -the @code{default}, @code{bold}, or other faces. The specifier object -consists of a number of specifications, each of which maps from a -buffer, window, etc. to a value. The function @code{specifier-instance} -looks up a value given a window (from which a buffer, frame, and device -can be derived). - - -@example -chartab.c -chartab.h -casetab.c -@end example - -@file{chartab.c} and @file{chartab.h} implement the @dfn{char table} -Lisp object type, which maps from characters or certain sorts of -character ranges to Lisp objects. The implementation of this object -type is optimized for the internal representation of characters. Char -tables come in different types, which affect the allowed object types to -which a character can be mapped and also dictate certain other -properties of the char table. - -@cindex case table -@file{casetab.c} implements one sort of char table, the @dfn{case -table}, which maps characters to other characters of possibly different -case. These are used by XEmacs to implement case-changing primitives -and to do case-insensitive searching. - - - -@example -syntax.c -syntax.h -@end example - -@cindex scanner -This module implements @dfn{syntax tables}, another sort of char table -that maps characters into syntax classes that define the syntax of these -characters (e.g. a parenthesis belongs to a class of @samp{open} -characters that have corresponding @samp{close} characters and can be -nested). This module also implements the Lisp @dfn{scanner}, a set of -primitives for scanning over text based on syntax tables. This is used, -for example, to find the matching parenthesis in a command such as -@code{forward-sexp}, and by @file{font-lock.c} to locate quoted strings, -comments, etc. - - - -@example -casefiddle.c -@end example - -This module implements various Lisp primitives for upcasing, downcasing -and capitalizing strings or regions of buffers. - - - -@example -rangetab.c -@end example - -This module implements the @dfn{range table} Lisp object type, which -provides for a mapping from ranges of integers to arbitrary Lisp -objects. - - - -@example -opaque.c -opaque.h -@end example - -This module implements the @dfn{opaque} Lisp object type, an -internal-only Lisp object that encapsulates an arbitrary block of memory -so that it can be managed by the Lisp allocation system. To create an -opaque object, you call @code{make_opaque()}, passing a pointer to a -block of memory. An object is created that is big enough to hold the -memory, which is copied into the object's storage. The object will then -stick around as long as you keep pointers to it, after which it will be -automatically reclaimed. - -@cindex mark method -Opaque objects can also have an arbitrary @dfn{mark method} associated -with them, in case the block of memory contains other Lisp objects that -need to be marked for garbage-collection purposes. (If you need other -object methods, such as a finalize method, you should just go ahead and -create a new Lisp object type -- it's not hard.) - - - -@example -abbrev.c -@end example - -This function provides a few primitives for doing dynamic abbreviation -expansion. In XEmacs, most of the code for this has been moved into -Lisp. Some C code remains for speed and because the primitive -@code{self-insert-command} (which is executed for all self-inserting -characters) hooks into the abbrev mechanism. (@code{self-insert-command} -is itself in C only for speed.) - - - -@example -doc.c -@end example - -This function provides primitives for retrieving the documentation -strings of functions and variables. These documentation strings contain -certain special markers that get dynamically expanded (e.g. a -reverse-lookup is performed on some named functions to retrieve their -current key bindings). Some documentation strings (in particular, for -the built-in primitives and pre-loaded Lisp functions) are stored -externally in a file @file{DOC} in the @file{lib-src/} directory and -need to be fetched from that file. (Part of the build stage involves -building this file, and another part involves constructing an index for -this file and embedding it into the executable, so that the functions in -@file{doc.c} do not have to search the entire @file{DOC} file to find -the appropriate documentation string.) - - - -@example -md5.c -@end example - -This function provides a Lisp primitive that implements the MD5 secure -hashing scheme, used to create a large hash value of a string of data such that -the data cannot be derived from the hash value. This is used for -various security applications on the Internet. - - - - -@node Modules for Interfacing with the Operating System -@section Modules for Interfacing with the Operating System - -@example -callproc.c -process.c -process.h -@end example - -These modules allow XEmacs to spawn and communicate with subprocesses -and network connections. - -@cindex synchronous subprocesses -@cindex subprocesses, synchronous - @file{callproc.c} implements (through the @code{call-process} -primitive) what are called @dfn{synchronous subprocesses}. This means -that XEmacs runs a program, waits till it's done, and retrieves its -output. A typical example might be calling the @file{ls} program to get -a directory listing. - -@cindex asynchronous subprocesses -@cindex subprocesses, asynchronous - @file{process.c} and @file{process.h} implement @dfn{asynchronous -subprocesses}. This means that XEmacs starts a program and then -continues normally, not waiting for the process to finish. Data can be -sent to the process or retrieved from it as it's running. This is used -for the @code{shell} command (which provides a front end onto a shell -program such as @file{csh}), the mail and news readers implemented in -XEmacs, etc. The result of calling @code{start-process} to start a -subprocess is a process object, a particular kind of object used to -communicate with the subprocess. You can send data to the process by -passing the process object and the data to @code{send-process}, and you -can specify what happens to data retrieved from the process by setting -properties of the process object. (When the process sends data, XEmacs -receives a process event, which says that there is data ready. When -@code{dispatch-event} is called on this event, it reads the data from -the process and does something with it, as specified by the process -object's properties. Typically, this means inserting the data into a -buffer or calling a function.) Another property of the process object is -called the @dfn{sentinel}, which is a function that is called when the -process terminates. - -@cindex network connections - Process objects are also used for network connections (connections to a -process running on another machine). Network connections are started -with @code{open-network-stream} but otherwise work just like -subprocesses. - - - -@example -sysdep.c -sysdep.h -@end example - - These modules implement most of the low-level, messy operating-system -interface code. This includes various device control (ioctl) operations -for file descriptors, TTY's, pseudo-terminals, etc. (usually this stuff -is fairly system-dependent; thus the name of this module), and emulation -of standard library functions and system calls on systems that don't -provide them or have broken versions. - - - -@example -sysdir.h -sysfile.h -sysfloat.h -sysproc.h -syspwd.h -syssignal.h -systime.h -systty.h -syswait.h -@end example - -These header files provide consistent interfaces onto system-dependent -header files and system calls. The idea is that, instead of including a -standard header file like @file{} (which may or may not -exist on various systems) or having to worry about whether all system -provide a particular preprocessor constant, or having to deal with the -four different paradigms for manipulating signals, you just include the -appropriate @file{sys*.h} header file, which includes all the right -system header files, defines and missing preprocessor constants, -provides a uniform interface onto system calls, etc. - -@file{sysdir.h} provides a uniform interface onto directory-querying -functions. (In some cases, this is in conjunction with emulation -functions in @file{sysdep.c}.) - -@file{sysfile.h} includes all the necessary header files for standard -system calls (e.g. @code{read()}), ensures that all necessary -@code{open()} and @code{stat()} preprocessor constants are defined, and -possibly (usually) substitutes sugared versions of @code{read()}, -@code{write()}, etc. that automatically restart interrupted I/O -operations. - -@file{sysfloat.h} includes the necessary header files for floating-point -operations. - -@file{sysproc.h} includes the necessary header files for calling -@code{select()}, @code{fork()}, @code{execve()}, socket operations, and -the like, and ensures that the @code{FD_*()} macros for descriptor-set -manipulations are available. - -@file{syspwd.h} includes the necessary header files for obtaining -information from @file{/etc/passwd} (the functions are emulated under -VMS). - -@file{syssignal.h} includes the necessary header files for -signal-handling and provides a uniform interface onto the different -signal-handling and signal-blocking paradigms. - -@file{systime.h} includes the necessary header files and provides -uniform interfaces for retrieving the time of day, setting file -access/modification times, getting the amount of time used by the XEmacs -process, etc. - -@file{systty.h} buffers against the infinitude of different ways of -controlling TTY's. - -@file{syswait.h} provides a uniform way of retrieving the exit status -from a @code{wait()}ed-on process (some systems use a union, others use -an int). - - - -@example -hpplay.c -libsst.c -libsst.h -libst.h -linuxplay.c -nas.c -sgiplay.c -sound.c -sunplay.c -@end example - -These files implement the ability to play various sounds on some types -of computers. You have to configure your XEmacs with sound support in -order to get this capability. - -@file{sound.c} provides the generic interface. It implements various -Lisp primitives and variables that let you specify which sounds should -be played in certain conditions. (The conditions are identified by -symbols, which are passed to @code{ding} to make a sound. Various -standard functions call this function at certain times; if sound support -does not exist, a simple beep results. - -@cindex native sound -@cindex sound, native -@file{sgiplay.c}, @file{sunplay.c}, @file{hpplay.c}, and -@file{linuxplay.c} interface to the machine's speaker for various -different kind of machines. This is called @dfn{native} sound. - -@cindex sound, network -@cindex network sound -@cindex NAS -@file{nas.c} interfaces to a computer somewhere else on the network -using the NAS (Network Audio Server) protocol, playing sounds on that -machine. This allows you to run XEmacs on a remote machine, with its -display set to your local machine, and have the sounds be made on your -local machine, provided that you have a NAS server running on your local -machine. - -@file{libsst.c}, @file{libsst.h}, and @file{libst.h} provide some -additional functions for playing sound on a Sun SPARC but are not -currently in use. - - - -@example -tooltalk.c -tooltalk.h -@end example - -These two modules implement an interface to the ToolTalk protocol, which -is an interprocess communication protocol implemented on some versions -of Unix. ToolTalk is a high-level protocol that allows processes to -register themselves as providers of particular services; other processes -can then request a service without knowing or caring exactly who is -providing the service. It is similar in spirit to the DDE protocol -provided under Microsoft Windows. ToolTalk is a part of the new CDE -(Common Desktop Environment) specification and is used to connect the -parts of the SPARCWorks development environment. - - - -@example -getloadavg.c -@end example - -This module provides the ability to retrieve the system's current load -average. (The way to do this is highly system-specific, unfortunately, -and requires a lot of special-case code.) - - - -@example -sunpro.c -@end example - -This module provides a small amount of code used internally at Sun to -keep statistics on the usage of XEmacs. - - - -@example -broken-sun.h -strcmp.c -strcpy.c -sunOS-fix.c -@end example - -These files provide replacement functions and prototypes to fix numerous -bugs in early releases of SunOS 4.1. - - - -@example -hftctl.c -@end example - -This module provides some terminal-control code necessary on versions of -AIX prior to 4.1. - - - -@example -msdos.c -msdos.h -@end example - -These modules are used for MS-DOS support, which does not work in -XEmacs. - - - -@node Modules for Interfacing with X Windows -@section Modules for Interfacing with X Windows - -@example -Emacs.ad.h -@end example - -A file generated from @file{Emacs.ad}, which contains XEmacs-supplied -fallback resources (so that XEmacs has pretty defaults). - - - -@example -EmacsFrame.c -EmacsFrame.h -EmacsFrameP.h -@end example - -These modules implement an Xt widget class that encapsulates a frame. -This is for ease in integrating with Xt. The EmacsFrame widget covers -the entire X window except for the menubar; the scrollbars are -positioned on top of the EmacsFrame widget. - -@strong{Warning:} Abandon hope, all ye who enter here. This code took -an ungodly amount of time to get right, and is likely to fall apart -mercilessly at the slightest change. Such is life under Xt. - - - -@example -EmacsManager.c -EmacsManager.h -EmacsManagerP.h -@end example - -These modules implement a simple Xt manager (i.e. composite) widget -class that simply lets its children set whatever geometry they want. -It's amazing that Xt doesn't provide this standardly, but on second -thought, it makes sense, considering how amazingly broken Xt is. - - -@example -EmacsShell-sub.c -EmacsShell.c -EmacsShell.h -EmacsShellP.h -@end example - -These modules implement two Xt widget classes that are subclasses of -the TopLevelShell and TransientShell classes. This is necessary to deal -with more brokenness that Xt has sadistically thrust onto the backs of -developers. - - - -@example -xgccache.c -xgccache.h -@end example - -These modules provide functions for maintenance and caching of GC's -(graphics contexts) under the X Window System. This code is junky and -needs to be rewritten. - - - -@example -xselect.c -@end example - -@cindex selections - This module provides an interface to the X Window System's concept of -@dfn{selections}, the standard way for X applications to communicate -with each other. - - - -@example -xintrinsic.h -xintrinsicp.h -xmmanagerp.h -xmprimitivep.h -@end example - -These header files are similar in spirit to the @file{sys*.h} files and buffer -against different implementations of Xt and Motif. - -@itemize @bullet -@item -@file{xintrinsic.h} should be included in place of @file{}. -@item -@file{xintrinsicp.h} should be included in place of @file{}. -@item -@file{xmmanagerp.h} should be included in place of @file{}. -@item -@file{xmprimitivep.h} should be included in place of @file{}. -@end itemize - - - -@example -xmu.c -xmu.h -@end example - -These files provide an emulation of the Xmu library for those systems -(i.e. HPUX) that don't provide it as a standard part of X. - - - -@example -ExternalClient-Xlib.c -ExternalClient.c -ExternalClient.h -ExternalClientP.h -ExternalShell.c -ExternalShell.h -ExternalShellP.h -extw-Xlib.c -extw-Xlib.h -extw-Xt.c -extw-Xt.h -@end example - -@cindex external widget - These files provide the @dfn{external widget} interface, which allows an -XEmacs frame to appear as a widget in another application. To do this, -you have to configure with @samp{--external-widget}. - -@file{ExternalShell*} provides the server (XEmacs) side of the -connection. - -@file{ExternalClient*} provides the client (other application) side of -the connection. These files are not compiled into XEmacs but are -compiled into libraries that are then linked into your application. - -@file{extw-*} is common code that is used for both the client and server. - -Don't touch this code; something is liable to break if you do. - - - -@node Modules for Internationalization -@section Modules for Internationalization - -@example -mule-canna.c -mule-ccl.c -mule-charset.c -mule-charset.h -mule-coding.c -mule-coding.h -mule-mcpath.c -mule-mcpath.h -mule-wnnfns.c -mule.c -@end example - -These files implement the MULE (Asian-language) support. Note that MULE -actually provides a general interface for all sorts of languages, not -just Asian languages (although they are generally the most complicated -to support). This code is still in beta. - -@file{mule-charset.*} and @file{mule-coding.*} provide the heart of the -XEmacs MULE support. @file{mule-charset.*} implements the @dfn{charset} -Lisp object type, which encapsulates a character set (an ordered one- or -two-dimensional set of characters, such as US ASCII or JISX0208 Japanese -Kanji). - -@file{mule-coding.*} implements the @dfn{coding-system} Lisp object -type, which encapsulates a method of converting between different -encodings. An encoding is a representation of a stream of characters, -possibly from multiple character sets, using a stream of bytes or words, -and defines (e.g.) which escape sequences are used to specify particular -character sets, how the indices for a character are converted into bytes -(sometimes this involves setting the high bit; sometimes complicated -rearranging of the values takes place, as in the Shift-JIS encoding), -etc. - -@file{mule-ccl.c} provides the CCL (Code Conversion Language) -interpreter. CCL is similar in spirit to Lisp byte code and is used to -implement converters for custom encodings. - -@file{mule-canna.c} and @file{mule-wnnfns.c} implement interfaces to -external programs used to implement the Canna and WNN input methods, -respectively. This is currently in beta. - -@file{mule-mcpath.c} provides some functions to allow for pathnames -containing extended characters. This code is fragmentary, obsolete, and -completely non-working. Instead, @var{pathname-coding-system} is used -to specify conversions of names of files and directories. The standard -C I/O functions like @samp{open()} are wrapped so that conversion occurs -automatically. - -@file{mule.c} provides a few miscellaneous things that should probably -be elsewhere. - - - -@example -intl.c -@end example - -This provides some miscellaneous internationalization code for -implementing message translation and interfacing to the Ximp input -method. None of this code is currently working. - - - -@example -iso-wide.h -@end example - -This contains leftover code from an earlier implementation of -Asian-language support, and is not currently used. - - - - -@node Allocation of Objects in XEmacs Lisp, Events and the Event Loop, A Summary of the Various XEmacs Modules, Top -@chapter Allocation of Objects in XEmacs Lisp - -@menu -* Introduction to Allocation:: -* Garbage Collection:: -* GCPROing:: -* Integers and Characters:: -* Allocation from Frob Blocks:: -* lrecords:: -* Low-level allocation:: -* Pure Space:: -* Cons:: -* Vector:: -* Bit Vector:: -* Symbol:: -* Marker:: -* String:: -* Compiled Function:: -@end menu - -@node Introduction to Allocation -@section Introduction to Allocation - - Emacs Lisp, like all Lisps, has garbage collection. This means that -the programmer never has to explicitly free (destroy) an object; it -happens automatically when the object becomes inaccessible. Most -experts agree that garbage collection is a necessity in a modern, -high-level language. Its omission from C stems from the fact that C was -originally designed to be a nice abstract layer on top of assembly -language, for writing kernels and basic system utilities rather than -large applications. - - Lisp objects can be created by any of a number of Lisp primitives. -Most object types have one or a small number of basic primitives -for creating objects. For conses, the basic primitive is @code{cons}; -for vectors, the primitives are @code{make-vector} and @code{vector}; for -symbols, the primitives are @code{make-symbol} and @code{intern}; etc. -Some Lisp objects, especially those that are primarily used internally, -have no corresponding Lisp primitives. Every Lisp object, though, -has at least one C primitive for creating it. - - Recall from section (VII) that a Lisp object, as stored in a 32-bit -or 64-bit word, has a mark bit, a few tag bits, and a ``value'' that -occupies the remainder of the bits. We can separate the different -Lisp object types into four broad categories: - -@itemize @bullet -@item -(a) Those for whom the value directly represents the contents of the -Lisp object. Only two types are in this category: integers and -characters. No special allocation or garbage collection is necessary -for such objects. Lisp objects of these types do not need to be -@code{GCPRO}ed. -@end itemize - - In the remaining three categories, the value is a pointer to a -structure. - -@itemize @bullet -@item -@cindex frob block -(b) Those for whom the tag directly specifies the type. Recall that -there are only three tag bits; this means that at most five types can be -specified this way. The most commonly-used types are stored in this -format; this includes conses, strings, vectors, and sometimes symbols. -With the exception of vectors, objects in this category are allocated in -@dfn{frob blocks}, i.e. large blocks of memory that are subdivided into -individual objects. This saves a lot on malloc overhead, since there -are typically quite a lot of these objects around, and the objects are -small. (A cons, for example, occupies 8 bytes on 32-bit machines -- 4 -bytes for each of the two objects it contains.) Vectors are individually -@code{malloc()}ed since they are of variable size. (It would be -possible, and desirable, to allocate vectors of certain small sizes out -of frob blocks, but it isn't currently done.) Strings are handled -specially: Each string is allocated in two parts, a fixed size structure -containing a length and a data pointer, and the actual data of the -string. The former structure is allocated in frob blocks as usual, and -the latter data is stored in @dfn{string chars blocks} and is relocated -during garbage collection to eliminate holes. -@end itemize - - In the remaining two categories, the type is stored in the object -itself. The tag for all such objects is the generic @dfn{lrecord} -(Lisp_Record) tag. The first four bytes (or eight, for 64-bit machines) -of the object's structure are a pointer to a structure that describes -the object's type, which includes method pointers and a pointer to a -string naming the type. Note that it's possible to save some space by -using a one- or two-byte tag, rather than a four- or eight-byte pointer -to store the type, but it's not clear it's worth making the change. - -@itemize @bullet -@item -(c) Those lrecords that are allocated in frob blocks (see above). This -includes the objects that are most common and relatively small, and -includes floats, compiled functions, symbols (when not in category (b)), -extents, events, and markers. With the cleanup of frob blocks done in -19.12, it's not terribly hard to add more objects to this category, but -it's a bit trickier than adding an object type to type (d) (esp. if the -object needs a finalization method), and is not likely to save much -space unless the object is small and there are many of them. (In fact, -if there are very few of them, it might actually waste space.) -@item -(d) Those lrecords that are individually @code{malloc()}ed. These are -called @dfn{lcrecords}. All other types are in this category. Adding a -new type to this category is comparatively easy, and all types added -since 19.8 (when the current allocation scheme was devised, by Richard -Mlynarik), with the exception of the character type, have been in this -category. -@end itemize - - Note that bit vectors are a bit of a special case. They are -simple lrecords as in category (c), but are individually @code{malloc()}ed -like vectors. You can basically view them as exactly like vectors -except that their type is stored in lrecord fashion rather than -in directly-tagged fashion. - - Note that FSF Emacs redesigned their object system in 19.29 to follow -a similar scheme. However, given RMS's expressed dislike for data -abstraction, the FSF scheme is not nearly as clean or as easy to -extend. (FSF calls items of type (c) @code{Lisp_Misc} and items of type -(d) @code{Lisp_Vectorlike}, with separate tags for each, although -@code{Lisp_Vectorlike} is also used for vectors.) - -@node Garbage Collection -@section Garbage Collection -@cindex garbage collection - -@cindex mark and sweep - Garbage collection is simple in theory but tricky to implement. -Emacs Lisp uses the oldest garbage collection method, called -@dfn{mark and sweep}. Garbage collection begins by starting with -all accessible locations (i.e. all variables and other slots where -Lisp objects might occur) and recursively traversing all objects -accessible from those slots, marking each one that is found. -We then go through all of memory and free each object that is -not marked, and unmarking each object that is marked. Note -that ``all of memory'' means all currently allocated objects. -Traversing all these objects means traversing all frob blocks, -all vectors (which are chained in one big list), and all -lcrecords (which are likewise chained). - - Note that, when an object is marked, the mark has to occur -inside of the object's structure, rather than in the 32-bit -@code{Lisp_Object} holding the object's pointer; i.e. you can't just -set the pointer's mark bit. This is because there may be many -pointers to the same object. This means that the method of -marking an object can differ depending on the type. The -different marking methods are approximately as follows: - -@enumerate -@item -For conses, the mark bit of the car is set. -@item -For strings, the mark bit of the string's plist is set. -@item -For symbols when not lrecords, the mark bit of the -symbol's plist is set. -@item -For vectors, the length is negated after adding 1. -@item -For lrecords, the pointer to the structure describing -the type is changed (see below). -@item -Integers and characters do not need to be marked, since -no allocation occurs for them. -@end enumerate - - The details of this are in the @code{mark_object()} function. - - Note that any code that operates during garbage collection has -to be especially careful because of the fact that some objects -may be marked and as such may not look like they normally do. -In particular: - -@itemize @bullet -Some object pointers may have their mark bit set. This will make -@code{FOOBARP()} predicates fail. Use @code{GC_FOOBARP()} to deal with -this. -@item -Even if you clear the mark bit, @code{FOOBARP()} will still fail -for lrecords because the implementation pointer has been -changed (see below). @code{GC_FOOBARP()} will correctly deal with -this. -@item -Vectors have their size field munged, so anything that -looks at this field will fail. -@item -Note that @code{XFOOBAR()} macros @emph{will} work correctly on object -pointers with their mark bit set, because the logical shift operations -that remove the tag also remove the mark bit. -@end itemize - - Finally, note that garbage collection can be invoked explicitly -by calling @code{garbage-collect} but is also called automatically -by @code{eval}, once a certain amount of memory has been allocated -since the last garbage collection (according to @code{gc-cons-threshold}). - -@node GCPROing -@section @code{GCPRO}ing - -@code{GCPRO}ing is one of the ugliest and trickiest parts of Emacs -internals. The basic idea is that whenever garbage collection -occurs, all in-use objects must be reachable somehow or -other from one of the roots of accessibility. The roots -of accessibility are: - -@enumerate -@item -All objects that have been @code{staticpro()}d. This is used for -any global C variables that hold Lisp objects. A call to -@code{staticpro()} happens implicitly as a result of any symbols -declared with @code{defsymbol()} and any variables declared with -@code{DEFVAR_FOO()}. You need to explicitly call @code{staticpro()} -(in the @code{vars_of_foo()} method of a module) for other global -C variables holding Lisp objects. (This typically includes -internal lists and such things.) - -Note that @code{obarray} is one of the @code{staticpro()}d things. -Therefore, all functions and variables get marked through this. -@item -Any shadowed bindings that are sitting on the @code{specpdl} stack. -@item -Any objects sitting in currently active (Lisp) stack frames, -catches, and condition cases. -@item -A couple of special-case places where active objects are -located. -@item -Anything currently marked with @code{GCPRO}. -@end enumerate - - Marking with @code{GCPRO} is necessary because some C functions (quite -a lot, in fact), allocate objects during their operation. Quite -frequently, there will be no other pointer to the object while the -function is running, and if a garbage collection occurs and the object -needs to be referenced again, bad things will happen. The solution is -to mark those objects with @code{GCPRO}. Unfortunately this is easy to -forget, and there is basically no way around this problem. Here are -some rules, though: - -@enumerate -@item -For every @code{GCPRO@var{n}}, there have to be declarations of -@code{struct gcpro gcpro1, gcpro2}, etc. - -@item -You @emph{must} @code{UNGCPRO} anything that's @code{GCPRO}ed, and you -@emph{must not} @code{UNGCPRO} if you haven't @code{GCPRO}ed. Getting -either of these wrong will lead to crashes, often in completely random -places unrelated to where the problem lies. - -@item -The way this actually works is that all currently active @code{GCPRO}s -are chained through the @code{struct gcpro} local variables, with the -variable @samp{gcprolist} pointing to the head of the list and the nth -local @code{gcpro} variable pointing to the first @code{gcpro} variable -in the next enclosing stack frame. Each @code{GCPRO}ed thing is an -lvalue, and the @code{struct gcpro} local variable contains a pointer to -this lvalue. This is why things will mess up badly if you don't pair up -the @code{GCPRO}s and @code{UNGCPRO}s -- you will end up with -@code{gcprolist}s containing pointers to @code{struct gcpro}s or local -@code{Lisp_Object} variables in no-longer-active stack frames. - -@item -It is actually possible for a single @code{struct gcpro} to -protect a contiguous array of any number of values, rather than -just a single lvalue. To effect this, call @code{GCPRO@var{n}} as usual on -the first object in the array and then set @code{gcpro@var{n}.nvars}. - -@item -@strong{Strings are relocated.} What this means in practice is that the -pointer obtained using @code{XSTRING_DATA()} is liable to change at any -time, and you should never keep it around past any function call, or -pass it as an argument to any function that might cause a garbage -collection. This is why a number of functions accept either a -``non-relocatable'' @code{char *} pointer or a relocatable Lisp string, -and only access the Lisp string's data at the very last minute. In some -cases, you may end up having to @code{alloca()} some space and copy the -string's data into it. - -@item -By convention, if you have to nest @code{GCPRO}'s, use @code{NGCPRO@var{n}} -(along with @code{struct gcpro ngcpro1, ngcpro2}, etc.), @code{NNGCPRO@var{n}}, -etc. This avoids compiler warnings about shadowed locals. - -@item -It is @emph{always} better to err on the side of extra @code{GCPRO}s -rather than too few. The extra cycles spent on this are -almost never going to make a whit of difference in the -speed of anything. - -@item -The general rule to follow is that caller, not callee, @code{GCPRO}s. -That is, you should not have to explicitly @code{GCPRO} any Lisp objects -that are passed in as parameters. - -One exception from this rule is if you ever plan to change the parameter -value, and store a new object in it. In that case, you @emph{must} -@code{GCPRO} the parameter, because otherwise the new object will not be -protected. - -So, if you create any Lisp objects (remember, this happens in all sorts -of circumstances, e.g. with @code{Fcons()}, etc.), you are responsible -for @code{GCPRO}ing them, unless you are @emph{absolutely sure} that -there's no possibility that a garbage-collection can occur while you -need to use the object. Even then, consider @code{GCPRO}ing. - -@item -A garbage collection can occur whenever anything calls @code{Feval}, or -whenever a QUIT can occur where execution can continue past -this. (Remember, this is almost anywhere.) - -@item -If you have the @emph{least smidgeon of doubt} about whether -you need to @code{GCPRO}, you should @code{GCPRO}. - -@item -Beware of @code{GCPRO}ing something that is uninitialized. If you have -any shade of doubt about this, initialize all your variables to @code{Qnil}. - -@item -Be careful of traps, like calling @code{Fcons()} in the argument to -another function. By the ``caller protects'' law, you should be -@code{GCPRO}ing the newly-created cons, but you aren't. A certain -number of functions that are commonly called on freshly created stuff -(e.g. @code{nconc2()}, @code{Fsignal()}), break the ``caller protects'' -law and go ahead and @code{GCPRO} their arguments so as to simplify -things, but make sure and check if it's OK whenever doing something like -this. - -@item -Once again, remember to @code{GCPRO}! Bugs resulting from insufficient -@code{GCPRO}ing are intermittent and extremely difficult to track down, -often showing up in crashes inside of @code{garbage-collect} or in -weirdly corrupted objects or even in incorrect values in a totally -different section of code. -@end enumerate - -@cindex garbage collection, conservative -@cindex conservative garbage collection - Given the extremely error-prone nature of the @code{GCPRO} scheme, and -the difficulties in tracking down, it should be considered a deficiency -in the XEmacs code. A solution to this problem would involve -implementing so-called @dfn{conservative} garbage collection for the C -stack. That involves looking through all of stack memory and treating -anything that looks like a reference to an object as a reference. This -will result in a few objects not getting collected when they should, but -it obviates the need for @code{GCPRO}ing, and allows garbage collection -to happen at any point at all, such as during object allocation. - -@node Integers and Characters -@section Integers and Characters - - Integer and character Lisp objects are created from integers using the -macros @code{XSETINT()} and @code{XSETCHAR()} or the equivalent -functions @code{make_int()} and @code{make_char()}. (These are actually -macros on most systems.) These functions basically just do some moving -of bits around, since the integral value of the object is stored -directly in the @code{Lisp_Object}. - - @code{XSETINT()} and the like will truncate values given to them that -are too big; i.e. you won't get the value you expected but the tag bits -will at least be correct. - -@node Allocation from Frob Blocks -@section Allocation from Frob Blocks - -The uninitialized memory required by a @code{Lisp_Object} of a particular type -is allocated using -@code{ALLOCATE_FIXED_TYPE()}. This only occurs inside of the -lowest-level object-creating functions in @file{alloc.c}: -@code{Fcons()}, @code{make_float()}, @code{Fmake_byte_code()}, -@code{Fmake_symbol()}, @code{allocate_extent()}, -@code{allocate_event()}, @code{Fmake_marker()}, and -@code{make_uninit_string()}. The idea is that, for each type, there are -a number of frob blocks (each 2K in size); each frob block is divided up -into object-sized chunks. Each frob block will have some of these -chunks that are currently assigned to objects, and perhaps some that are -free. (If a frob block has nothing but free chunks, it is freed at the -end of the garbage collection cycle.) The free chunks are stored in a -free list, which is chained by storing a pointer in the first four bytes -of the chunk. (Except for the free chunks at the end of the last frob -block, which are handled using an index which points past the end of the -last-allocated chunk in the last frob block.) -@code{ALLOCATE_FIXED_TYPE()} first tries to retrieve a chunk from the -free list; if that fails, it calls -@code{ALLOCATE_FIXED_TYPE_FROM_BLOCK()}, which looks at the end of the -last frob block for space, and creates a new frob block if there is -none. (There are actually two versions of these macros, one of which is -more defensive but less efficient and is used for error-checking.) - -@node lrecords -@section lrecords - - [see @file{lrecord.h}] - - All lrecords have at the beginning of their structure a @code{struct -lrecord_header}. This just contains a pointer to a @code{struct -lrecord_implementation}, which is a structure containing method pointers -and such. There is one of these for each type, and it is a global, -constant, statically-declared structure that is declared in the -@code{DEFINE_LRECORD_IMPLEMENTATION()} macro. (This macro actually -declares an array of two @code{struct lrecord_implementation} -structures. The first one contains all the standard method pointers, -and is used in all normal circumstances. During garbage collection, -however, the lrecord is @dfn{marked} by bumping its implementation -pointer by one, so that it points to the second structure in the array. -This structure contains a special indication in it that it's a -@dfn{marked-object} structure: the finalize method is the special -function @code{this_marks_a_marked_record()}, and all other methods are -null pointers. At the end of garbage collection, all lrecords will -either be reclaimed or unmarked by decrementing their implementation -pointers, so this second structure pointer will never remain past -garbage collection. - - Simple lrecords (of type (c) above) just have a @code{struct -lrecord_header} at their beginning. lcrecords, however, actually have a -@code{struct lcrecord_header}. This, in turn, has a @code{struct -lrecord_header} at its beginning, so sanity is preserved; but it also -has a pointer used to chain all lcrecords together, and a special ID -field used to distinguish one lcrecord from another. (This field is used -only for debugging and could be removed, but the space gain is not -significant.) - - Simple lrecords are created using @code{ALLOCATE_FIXED_TYPE()}, just -like for other frob blocks. The only change is that the implementation -pointer must be initialized correctly. (The implementation structure for -an lrecord, or rather the pointer to it, is named @code{lrecord_float}, -@code{lrecord_extent}, @code{lrecord_buffer}, etc.) - - lcrecords are created using @code{alloc_lcrecord()}. This takes a -size to allocate and an implementation pointer. (The size needs to be -passed because some lcrecords, such as window configurations, are of -variable size.) This basically just @code{malloc()}s the storage, -initializes the @code{struct lcrecord_header}, and chains the lcrecord -onto the head of the list of all lcrecords, which is stored in the -variable @code{all_lcrecords}. The calls to @code{alloc_lcrecord()} -generally occur in the lowest-level allocation function for each lrecord -type. - -Whenever you create an lrecord, you need to call either -@code{DEFINE_LRECORD_IMPLEMENTATION()} or -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()}. This needs to be -specified in a C file, at the top level. What this actually does is -define and initialize the implementation structure for the lrecord. (And -possibly declares a function @code{error_check_foo()} that implements -the @code{XFOO()} macro when error-checking is enabled.) The arguments -to the macros are the actual type name (this is used to construct the C -variable name of the lrecord implementation structure and related -structures using the @samp{##} macro concatenation operator), a string -that names the type on the Lisp level (this may not be the same as the C -type name; typically, the C type name has underscores, while the Lisp -string has dashes), various method pointers, and the name of the C -structure that contains the object. The methods are used to encapsulate -type-specific information about the object, such as how to print it or -mark it for garbage collection, so that it's easy to add new object -types without having to add a specific case for each new type in a bunch -of different places. - - The difference between @code{DEFINE_LRECORD_IMPLEMENTATION()} and -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION()} is that the former is -used for fixed-size object types and the latter is for variable-size -object types. Most object types are fixed-size; some complex -types, however (e.g. window configurations), are variable-size. -Variable-size object types have an extra method, which is called -to determine the actual size of a particular object of that type. -(Currently this is only used for keeping allocation statistics.) - - For the purpose of keeping allocation statistics, the allocation -engine keeps a list of all the different types that exist. Note that, -since @code{DEFINE_LRECORD_IMPLEMENTATION()} is a macro that is -specified at top-level, there is no way for it to add to the list of all -existing types. What happens instead is that each implementation -structure contains in it a dynamically assigned number that is -particular to that type. (Or rather, it contains a pointer to another -structure that contains this number. This evasiveness is done so that -the implementation structure can be declared const.) In the sweep stage -of garbage collection, each lrecord is examined to see if its -implementation structure has its dynamically-assigned number set. If -not, it must be a new type, and it is added to the list of known types -and a new number assigned. The number is used to index into an array -holding the number of objects of each type and the total memory -allocated for objects of that type. The statistics in this array are -also computed during the sweep stage. These statistics are returned by -the call to @code{garbage-collect} and are printed out at the end of the -loadup phase. - - Note that for every type defined with a @code{DEFINE_LRECORD_*()} -macro, there needs to be a @code{DECLARE_LRECORD_IMPLEMENTATION()} -somewhere in a @file{.h} file, and this @file{.h} file needs to be -included by @file{inline.c}. - - Furthermore, there should generally be a set of @code{XFOOBAR()}, -@code{FOOBARP()}, etc. macros in a @file{.h} (or occasionally @file{.c}) -file. To create one of these, copy an existing model and modify as -necessary. - - The various methods in the lrecord implementation structure are: - -@enumerate -@item -@cindex mark method -A @dfn{mark} method. This is called during the marking stage and passed -a function pointer (usually the @code{mark_object()} function), which is -used to mark an object. All Lisp objects that are contained within the -object need to be marked by applying this function to them. The mark -method should also return a Lisp object, which should be either nil or -an object to mark. (This can be used in lieu of calling -@code{mark_object()} on the object, to reduce the recursion depth, and -consequently should be the most heavily nested sub-object, such as a -long list.) - -@strong{Please note:} When the mark method is called, garbage collection -is in progress, and special precautions need to be taken when accessing -objects; see section (B) above. - -If your mark method does not need to do anything, it can be -@code{NULL}. - -@item -A @dfn{print} method. This is called to create a printed representation -of the object, whenever @code{princ}, @code{prin1}, or the like is -called. It is passed the object, a stream to which the output is to be -directed, and an @code{escapeflag} which indicates whether the object's -printed representation should be @dfn{escaped} so that it is -readable. (This corresponds to the difference between @code{princ} and -@code{prin1}.) Basically, @dfn{escaped} means that strings will have -quotes around them and confusing characters in the strings such as -quotes, backslashes, and newlines will be backslashed; and that special -care will be taken to make symbols print in a readable fashion -(e.g. symbols that look like numbers will be backslashed). Other -readable objects should perhaps pass @code{escapeflag} on when -sub-objects are printed, so that readability is preserved when necessary -(or if not, always pass in a 1 for @code{escapeflag}). Non-readable -objects should in general ignore @code{escapeflag}, except that some use -it as an indication that more verbose output should be given. - -Sub-objects are printed using @code{print_internal()}, which takes -exactly the same arguments as are passed to the print method. - -Literal C strings should be printed using @code{write_c_string()}, -or @code{write_string_1()} for non-null-terminated strings. - -Functions that do not have a readable representation should check the -@code{print_readably} flag and signal an error if it is set. - -If you specify NULL for the print method, the -@code{default_object_printer()} will be used. - -@item -A @dfn{finalize} method. This is called at the beginning of the sweep -stage on lcrecords that are about to be freed, and should be used to -perform any extra object cleanup. This typically involves freeing any -extra @code{malloc()}ed memory associated with the object, releasing any -operating-system and window-system resources associated with the object -(e.g. pixmaps, fonts), etc. - -The finalize method can be NULL if nothing needs to be done. - -WARNING #1: The finalize method is also called at the end of the dump -phase; this time with the for_disksave parameter set to non-zero. The -object is @emph{not} about to disappear, so you have to make sure to -@emph{not} free any extra @code{malloc()}ed memory if you're going to -need it later. (Also, signal an error if there are any operating-system -and window-system resources here, because they can't be dumped.) - -Finalize methods should, as a rule, set to zero any pointers after -they've been freed, and check to make sure pointers are not zero before -freeing. Although I'm pretty sure that finalize methods are not called -twice on the same object (except for the @code{for_disksave} proviso), -we've gotten nastily burned in some cases by not doing this. - -WARNING #2: The finalize method is @emph{only} called for -lcrecords, @emph{not} for simply lrecords. If you need a -finalize method for simple lrecords, you have to stick -it in the @code{ADDITIONAL_FREE_foo()} macro in @file{alloc.c}. - -WARNING #3: Things are in an @emph{extremely} bizarre state -when @code{ADDITIONAL_FREE_foo()} is called, so you have to -be incredibly careful when writing one of these functions. -See the comment in @code{gc_sweep()}. If you ever have to add -one of these, consider using an lcrecord or dealing with -the problem in a different fashion. - -@item -An @dfn{equal} method. This compares the two objects for similarity, -when @code{equal} is called. It should compare the contents of the -objects in some reasonable fashion. It is passed the two objects and a -@dfn{depth} value, which is used to catch circular objects. To compare -sub-Lisp-objects, call @code{internal_equal()} and bump the depth value -by one. If this value gets too high, a @code{circular-object} error -will be signaled. - -If this is NULL, objects are @code{equal} only when they are @code{eq}, -i.e. identical. - -@item -A @dfn{hash} method. This is used to hash objects when they are to be -compared with @code{equal}. The rule here is that if two objects are -@code{equal}, they @emph{must} hash to the same value; i.e. your hash -function should use some subset of the sub-fields of the object that are -compared in the ``equal'' method. If you specify this method as -@code{NULL}, the object's pointer will be used as the hash, which will -@emph{fail} if the object has an @code{equal} method, so don't do this. - -To hash a sub-Lisp-object, call @code{internal_hash()}. Bump the -depth by one, just like in the ``equal'' method. - -To convert a Lisp object directly into a hash value (using -its pointer), use @code{LISP_HASH()}. This is what happens when -the hash method is NULL. - -To hash two or more values together into a single value, use -@code{HASH2()}, @code{HASH3()}, @code{HASH4()}, etc. - -@item -@dfn{getprop}, @dfn{putprop}, @dfn{remprop}, and @dfn{plist} methods. -These are used for object types that have properties. I don't feel like -documenting them here. If you create one of these objects, you have to -use different macros to define them, -i.e. @code{DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS()} or -@code{DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS()}. - -@item -A @dfn{size_in_bytes} method, when the object is of variable-size. -(i.e. declared with a @code{_SEQUENCE_IMPLEMENTATION} macro.) This should -simply return the object's size in bytes, exactly as you might expect. -For an example, see the methods for window configurations and opaques. -@end enumerate - -@node Low-level allocation -@section Low-level allocation - - Memory that you want to allocate directly should be allocated using -@code{xmalloc()} rather than @code{malloc()}. This implements -error-checking on the return value, and once upon a time did some more -vital stuff (i.e. @code{BLOCK_INPUT}, which is no longer necessary). -Free using @code{xfree()}, and realloc using @code{xrealloc()}. Note -that @code{xmalloc()} will do a non-local exit if the memory can't be -allocated. (Many functions, however, do not expect this, and thus XEmacs -will likely crash if this happens. @strong{This is a bug.} If you can, -you should strive to make your function handle this OK. However, it's -difficult in the general circumstance, perhaps requiring extra -unwind-protects and such.) - - Note that XEmacs provides two separate replacements for the standard -@code{malloc()} library function. These are called @dfn{old GNU malloc} -(@file{malloc.c}) and @dfn{new GNU malloc} (@file{gmalloc.c}), -respectively. New GNU malloc is better in pretty much every way than -old GNU malloc, and should be used if possible. (It used to be that on -some systems, the old one worked but the new one didn't. I think this -was due specifically to a bug in SunOS, which the new one now works -around; so I don't think the old one ever has to be used any more.) The -primary difference between both of these mallocs and the standard system -malloc is that they are much faster, at the expense of increased space. -The basic idea is that memory is allocated in fixed chunks of powers of -two. This allows for basically constant malloc time, since the various -chunks can just be kept on a number of free lists. (The standard system -malloc typically allocates arbitrary-sized chunks and has to spend some -time, sometimes a significant amount of time, walking the heap looking -for a free block to use and cleaning things up.) The new GNU malloc -improves on things by allocating large objects in chunks of 4096 bytes -rather than in ever larger powers of two, which results in ever larger -wastage. There is a slight speed loss here, but it's of doubtful -significance. - - NOTE: Apparently there is a third-generation GNU malloc that is -significantly better than the new GNU malloc, and should probably -be included in XEmacs. - - There is also the relocating allocator, @file{ralloc.c}. This actually -moves blocks of memory around so that the @code{sbrk()} pointer shrunk -and virtual memory released back to the system. On some systems, -this is a big win. On all systems, it causes a noticeable (and -sometimes huge) speed penalty, so I turn it off by default. -@file{ralloc.c} only works with the new GNU malloc in @file{gmalloc.c}. -There are also two versions of @file{ralloc.c}, one that uses @code{mmap()} -rather than block copies to move data around. This purports to -be faster, although that depends on the amount of data that would -have had to be block copied and the system-call overhead for -@code{mmap()}. I don't know exactly how this works, except that the -relocating-allocation routines are pretty much used only for -the memory allocated for a buffer, which is the biggest consumer -of space, esp. of space that may get freed later. - - Note that the GNU mallocs have some ``memory warning'' facilities. -XEmacs taps into them and issues a warning through the standard -warning system, when memory gets to 75%, 85%, and 95% full. -(On some systems, the memory warnings are not functional.) - - Allocated memory that is going to be used to make a Lisp object -is created using @code{allocate_lisp_storage()}. This calls @code{xmalloc()} -but also verifies that the pointer to the memory can fit into -a Lisp word (remember that some bits are taken away for a type -tag and a mark bit). If not, an error is issued through @code{memory_full()}. -@code{allocate_lisp_storage()} is called by @code{alloc_lcrecord()}, -@code{ALLOCATE_FIXED_TYPE()}, and the vector and bit-vector creation -routines. These routines also call @code{INCREMENT_CONS_COUNTER()} at the -appropriate times; this keeps statistics on how much memory is -allocated, so that garbage-collection can be invoked when the -threshold is reached. - -@node Pure Space -@section Pure Space - - Not yet documented. - -@node Cons -@section Cons - - Conses are allocated in standard frob blocks. The only thing to -note is that conses can be explicitly freed using @code{free_cons()} -and associated functions @code{free_list()} and @code{free_alist()}. This -immediately puts the conses onto the cons free list, and decrements -the statistics on memory allocation appropriately. This is used -to good effect by some extremely commonly-used code, to avoid -generating extra objects and thereby triggering GC sooner. -However, you have to be @emph{extremely} careful when doing this. -If you mess this up, you will get BADLY BURNED, and it has happened -before. - -@node Vector -@section Vector - - As mentioned above, each vector is @code{malloc()}ed individually, and -all are threaded through the variable @code{all_vectors}. Vectors are -marked strangely during garbage collection, by kludging the size field. -Note that the @code{struct Lisp_Vector} is declared with its -@code{contents} field being a @emph{stretchy} array of one element. It -is actually @code{malloc()}ed with the right size, however, and access -to any element through the @code{contents} array works fine. - -@node Bit Vector -@section Bit Vector - - Bit vectors work exactly like vectors, except for more complicated -code to access an individual bit, and except for the fact that bit -vectors are lrecords while vectors are not. (The only difference here is -that there's an lrecord implementation pointer at the beginning and the -tag field in bit vector Lisp words is ``lrecord'' rather than -``vector''.) - -@node Symbol -@section Symbol - - Symbols are also allocated in frob blocks. Note that the code -exists for symbols to be either lrecords (category (c) above) -or simple types (category (b) above), and are lrecords by -default (I think), although there is no good reason for this. - - Note that symbols in the awful horrible obarray structure are -chained through their @code{next} field. - -Remember that @code{intern} looks up a symbol in an obarray, creating -one if necessary. - -@node Marker -@section Marker - - Markers are allocated in frob blocks, as usual. They are kept -in a buffer unordered, but in a doubly-linked list so that they -can easily be removed. (Formerly this was a singly-linked list, -but in some cases garbage collection took an extraordinarily -long time due to the O(N^2) time required to remove lots of -markers from a buffer.) Markers are removed from a buffer in -the finalize stage, in @code{ADDITIONAL_FREE_marker()}. - -@node String -@section String - - As mentioned above, strings are a special case. A string is logically -two parts, a fixed-size object (containing the length, property list, -and a pointer to the actual data), and the actual data in the string. -The fixed-size object is a @code{struct Lisp_String} and is allocated in -frob blocks, as usual. The actual data is stored in special -@dfn{string-chars blocks}, which are 8K blocks of memory. -Currently-allocated strings are simply laid end to end in these -string-chars blocks, with a pointer back to the @code{struct Lisp_String} -stored before each string in the string-chars block. When a new string -needs to be allocated, the remaining space at the end of the last -string-chars block is used if there's enough, and a new string-chars -block is created otherwise. - - There are never any holes in the string-chars blocks due to the string -compaction and relocation that happens at the end of garbage collection. -During the sweep stage of garbage collection, when objects are -reclaimed, the garbage collector goes through all string-chars blocks, -looking for unused strings. Each chunk of string data is preceded by a -pointer to the corresponding @code{struct Lisp_String}, which indicates -both whether the string is used and how big the string is, i.e. how to -get to the next chunk of string data. Holes are compressed by -block-copying the next string into the empty space and relocating the -pointer stored in the corresponding @code{struct Lisp_String}. -@strong{This means you have to be careful with strings in your code.} -See the section above on @code{GCPRO}ing. - - Note that there is one situation not handled: a string that is too big -to fit into a string-chars block. Such strings, called @dfn{big -strings}, are all @code{malloc()}ed as their own block. (#### Although it -would make more sense for the threshold for big strings to be somewhat -lower, e.g. 1/2 or 1/4 the size of a string-chars block. It seems that -this was indeed the case formerly -- indeed, the threshold was set at -1/8 -- but Mly forgot about this when rewriting things for 19.8.) - -Note also that the string data in string-chars blocks is padded as -necessary so that proper alignment constraints on the @code{struct -Lisp_String} back pointers are maintained. - - Finally, strings can be resized. This happens in Mule when a -character is substituted with a different-length character, or during -modeline frobbing. (You could also export this to Lisp, but it's not -done so currently.) Resizing a string is a potentially tricky process. -If the change is small enough that the padding can absorb it, nothing -other than a simple memory move needs to be done. Keep in mind, -however, that the string can't shrink too much because the offset to the -next string in the string-chars block is computed by looking at the -length and rounding to the nearest multiple of four or eight. If the -string would shrink or expand beyond the correct padding, new string -data needs to be allocated at the end of the last string-chars block and -the data moved appropriately. This leaves some dead string data, which -is marked by putting a special marker of 0xFFFFFFFF in the @code{struct -Lisp_String} pointer before the data (there's no real @code{struct -Lisp_String} to point to and relocate), and storing the size of the dead -string data (which would normally be obtained from the now-non-existent -@code{struct Lisp_String}) at the beginning of the dead string data gap. -The string compactor recognizes this special 0xFFFFFFFF marker and -handles it correctly. - -@node Compiled Function -@section Compiled Function - - Not yet documented. - -@node Events and the Event Loop, Evaluation; Stack Frames; Bindings, Allocation of Objects in XEmacs Lisp, Top -@chapter Events and the Event Loop - -@menu -* Introduction to Events:: -* Main Loop:: -* Specifics of the Event Gathering Mechanism:: -* Specifics About the Emacs Event:: -* The Event Stream Callback Routines:: -* Other Event Loop Functions:: -* Converting Events:: -* Dispatching Events; The Command Builder:: -@end menu - -@node Introduction to Events -@section Introduction to Events - - An event is an object that encapsulates information about an -interesting occurrence in the operating system. Events are -generated either by user action, direct (e.g. typing on the -keyboard or moving the mouse) or indirect (moving another -window, thereby generating an expose event on an Emacs frame), -or as a result of some other typically asynchronous action happening, -such as output from a subprocess being ready or a timer expiring. -Events come into the system in an asynchronous fashion (typically -through a callback being called) and are converted into a -synchronous event queue (first-in, first-out) in a process that -we will call @dfn{collection}. - - Note that each application has its own event queue. (It is -immaterial whether the collection process directly puts the -events in the proper application's queue, or puts them into -a single system queue, which is later split up.) - - The most basic level of event collection is done by the -operating system or window system. Typically, XEmacs does -its own event collection as well. Often there are multiple -layers of collection in XEmacs, with events from various -sources being collected into a queue, which is then combined -with other sources to go into another queue (i.e. a second -level of collection), with perhaps another level on top of -this, etc. - - XEmacs has its own types of events (called @dfn{Emacs events}), -which provides an abstract layer on top of the system-dependent -nature of the most basic events that are received. Part of the -complex nature of the XEmacs event collection process involves -converting from the operating-system events into the proper -Emacs events -- there may not be a one-to-one correspondence. - - Emacs events are documented in @file{events.h}; I'll discuss them -later. - -@node Main Loop -@section Main Loop - - The @dfn{command loop} is the top-level loop that the editor is always -running. It loops endlessly, calling @code{next-event} to retrieve an -event and @code{dispatch-event} to execute it. @code{dispatch-event} does -the appropriate thing with non-user events (process, timeout, -magic, eval, mouse motion); this involves calling a Lisp handler -function, redrawing a newly-exposed part of a frame, reading -subprocess output, etc. For user events, @code{dispatch-event} -looks up the event in relevant keymaps or menubars; when a -full key sequence or menubar selection is reached, the appropriate -function is executed. @code{dispatch-event} may have to keep state -across calls; this is done in the ``command-builder'' structure -associated with each console (remember, there's usually only -one console), and the engine that looks up keystrokes and -constructs full key sequences is called the @dfn{command builder}. -This is documented elsewhere. - - The guts of the command loop are in @code{command_loop_1()}. This -function doesn't catch errors, though -- that's the job of -@code{command_loop_2()}, which is a condition-case (i.e. error-trapping) -wrapper around @code{command_loop_1()}. @code{command_loop_1()} never -returns, but may get thrown out of. - - When an error occurs, @code{cmd_error()} is called, which usually -invokes the Lisp error handler in @code{command-error}; however, a -default error handler is provided if @code{command-error} is @code{nil} -(e.g. during startup). The purpose of the error handler is simply to -display the error message and do associated cleanup; it does not need to -throw anywhere. When the error handler finishes, the condition-case in -@code{command_loop_2()} will finish and @code{command_loop_2()} will -reinvoke @code{command_loop_1()}. - - @code{command_loop_2()} is invoked from three places: from -@code{initial_command_loop()} (called from @code{main()} at the end of -internal initialization), from the Lisp function @code{recursive-edit}, -and from @code{call_command_loop()}. - - @code{call_command_loop()} is called when a macro is started and when -the minibuffer is entered; normal termination of the macro or minibuffer -causes a throw out of the recursive command loop. (To -@code{execute-kbd-macro} for macros and @code{exit} for minibuffers. -Note also that the low-level minibuffer-entering function, -@code{read-minibuffer-internal}, provides its own error handling and -does not need @code{command_loop_2()}'s error encapsulation; so it tells -@code{call_command_loop()} to invoke @code{command_loop_1()} directly.) - - Note that both read-minibuffer-internal and recursive-edit set up a -catch for @code{exit}; this is why @code{abort-recursive-edit}, which -throws to this catch, exits out of either one. - - @code{initial_command_loop()}, called from @code{main()}, sets up a -catch for @code{top-level} when invoking @code{command_loop_2()}, -allowing functions to throw all the way to the top level if they really -need to. Before invoking @code{command_loop_2()}, -@code{initial_command_loop()} calls @code{top_level_1()}, which handles -all of the startup stuff (creating the initial frame, handling the -command-line options, loading the user's @file{.emacs} file, etc.). The -function that actually does this is in Lisp and is pointed to by the -variable @code{top-level}; normally this function is -@code{normal-top-level}. @code{top_level_1()} is just an error-handling -wrapper similar to @code{command_loop_2()}. Note also that -@code{initial_command_loop()} sets up a catch for @code{top-level} when -invoking @code{top_level_1()}, just like when it invokes -@code{command_loop_2()}. - -@node Specifics of the Event Gathering Mechanism -@section Specifics of the Event Gathering Mechanism - - Here is an approximate diagram of the collection processes -at work in XEmacs, under TTY's (TTY's are simpler than X -so we'll look at this first): - -@noindent -@example - asynch. asynch. asynch. asynch. [Collectors in -kbd events kbd events process process the OS] - | | output output - | | | | - | | | | SIGINT, [signal handlers - | | | | SIGQUIT, in XEmacs] - V V V V SIGWINCH, - file file file file SIGALRM - desc. desc. desc. desc. | - (TTY) (TTY) (pipe) (pipe) | - | | | | fake timeouts - | | | | file | - | | | | desc. | - | | | | (pipe) | - | | | | | | - | | | | | | - | | | | | | - V V V V V V - ------>-----------<----------------<---------------- - | - | - | [collected using select() in emacs_tty_next_event() - | and converted to the appropriate Emacs event] - | - | - V (above this line is TTY-specific) - Emacs ----------------------------------------------- - event (below this line is the generic event mechanism) - | - | -was there if not, call -a SIGINT? emacs_tty_next_event() - | | - | | - | | - V V - --->------<---- - | - | [collected in event_stream_next_event(); - | SIGINT is converted using maybe_read_quit_event()] - V - Emacs - event - | - \---->------>----- maybe_kbd_translate() ---->---\ - | - | - | - command event queue | - if not from command - (contains events that were event queue, call - read earlier but not processed, event_stream_next_event() - typically when waiting in a | - sit-for, sleep-for, etc. for | - a particular event to be received) | - | | - | | - V V - ---->------------------------------------<---- - | - | [collected in - | next_event_internal()] - | - unread- unread- event from | - command- command- keyboard else, call - events event macro next_event_internal() - | | | | - | | | | - | | | | - V V V V - --------->----------------------<------------ - | - | [collected in `next-event', which may loop - | more than once if the event it gets is on - | a dead frame, device, etc.] - | - | - V - feed into top-level event loop, - which repeatedly calls `next-event' - and then dispatches the event - using `dispatch-event' -@end example - -Notice the separation between TTY-specific and generic event mechanism. -When using the Xt-based event loop, the TTY-specific stuff is replaced -but the rest stays the same. - -It's also important to realize that only one different kind of -system-specific event loop can be operating at a time, and must be able -to receive all kinds of events simultaneously. For the two existing -event loops (implemented in @file{event-tty.c} and @file{event-Xt.c}, -respectively), the TTY event loop @emph{only} handles TTY consoles, -while the Xt event loop handles @emph{both} TTY and X consoles. This -situation is different from all of the output handlers, where you simply -have one per console type. - - Here's the Xt Event Loop Diagram (notice that below a certain point, -it's the same as the above diagram): - -@example -asynch. asynch. asynch. asynch. [Collectors in - kbd kbd process process the OS] -events events output output - | | | | - | | | | asynch. asynch. [Collectors in the - | | | | X X OS and X Window System] - | | | | events events - | | | | | | - | | | | | | - | | | | | | SIGINT, [signal handlers - | | | | | | SIGQUIT, in XEmacs] - | | | | | | SIGWINCH, - | | | | | | SIGALRM - | | | | | | | - | | | | | | | - | | | | | | | timeouts - | | | | | | | | - | | | | | | | | - | | | | | | V | - V V V V V V fake | - file file file file file file file | - desc. desc. desc. desc. desc. desc. desc. | - (TTY) (TTY) (pipe) (pipe) (socket) (socket) (pipe) | - | | | | | | | | - | | | | | | | | - | | | | | | | | - V V V V V V V V - --->----------------------------------------<---------<------ - | | | - | | |[collected using select() in - | | | _XtWaitForSomething(), called - | | | from XtAppProcessEvent(), called - | | | in emacs_Xt_next_event(); - | | | dispatched to various callbacks] - | | | - | | | - emacs_Xt_ p_s_callback(), | [popup_selection_callback] - event_handler() x_u_v_s_callback(),| [x_update_vertical_scrollbar_ - | x_u_h_s_callback(),| callback] - | search_callback() | [x_update_horizontal_scrollbar_ - | | | callback] - | | | - | | | - enqueue_Xt_ signal_special_ | - dispatch_event() Xt_user_event() | - [maybe multiple | | - times, maybe 0 | | - times] | | - | enqueue_Xt_ | - | dispatch_event() | - | | | - | | | - V V | - -->----------<-- | - | | - | | - dispatch Xt_what_callback() - event sets flags - queue | - | | - | | - | | - | | - ---->-----------<-------- - | - | - | [collected and converted as appropriate in - | emacs_Xt_next_event()] - | - | - V (above this line is Xt-specific) - Emacs ------------------------------------------------ - event (below this line is the generic event mechanism) - | - | -was there if not, call -a SIGINT? emacs_Xt_next_event() - | | - | | - | | - V V - --->-------<---- - | - | [collected in event_stream_next_event(); - | SIGINT is converted using maybe_read_quit_event()] - V - Emacs - event - | - \---->------>----- maybe_kbd_translate() -->-----\ - | - | - | - command event queue | - if not from command - (contains events that were event queue, call - read earlier but not processed, event_stream_next_event() - typically when waiting in a | - sit-for, sleep-for, etc. for | - a particular event to be received) | - | | - | | - V V - ---->----------------------------------<------ - | - | [collected in - | next_event_internal()] - | - unread- unread- event from | - command- command- keyboard else, call - events event macro next_event_internal() - | | | | - | | | | - | | | | - V V V V - --------->----------------------<------------ - | - | [collected in `next-event', which may loop - | more than once if the event it gets is on - | a dead frame, device, etc.] - | - | - V - feed into top-level event loop, - which repeatedly calls `next-event' - and then dispatches the event - using `dispatch-event' -@end example - -@node Specifics About the Emacs Event -@section Specifics About the Emacs Event - -@node The Event Stream Callback Routines -@section The Event Stream Callback Routines - -@node Other Event Loop Functions -@section Other Event Loop Functions - - @code{detect_input_pending()} and @code{input-pending-p} look for -input by calling @code{event_stream->event_pending_p} and looking in -@code{[V]unread-command-event} and the @code{command_event_queue} (they -do not check for an executing keyboard macro, though). - - @code{discard-input} cancels any command events pending (and any -keyboard macros currently executing), and puts the others onto the -@code{command_event_queue}. There is a comment about a ``race -condition'', which is not a good sign. - - @code{next-command-event} and @code{read-char} are higher-level -interfaces to @code{next-event}. @code{next-command-event} gets the -next @dfn{command} event (i.e. keypress, mouse event, menu selection, -or scrollbar action), calling @code{dispatch-event} on any others. -@code{read-char} calls @code{next-command-event} and uses -@code{event_to_character()} to return the character equivalent. With -the right kind of input method support, it is possible for (read-char) -to return a Kanji character. - -@node Converting Events -@section Converting Events - - @code{character_to_event()}, @code{event_to_character()}, -@code{event-to-character}, and @code{character-to-event} convert between -characters and keypress events corresponding to the characters. If the -event was not a keypress, @code{event_to_character()} returns -1 and -@code{event-to-character} returns @code{nil}. These functions convert -between character representation and the split-up event representation -(keysym plus mod keys). - -@node Dispatching Events; The Command Builder -@section Dispatching Events; The Command Builder - -Not yet documented. - -@node Evaluation; Stack Frames; Bindings, Symbols and Variables, Events and the Event Loop, Top -@chapter Evaluation; Stack Frames; Bindings - -@menu -* Evaluation:: -* Dynamic Binding; The specbinding Stack; Unwind-Protects:: -* Simple Special Forms:: -* Catch and Throw:: -@end menu - -@node Evaluation -@section Evaluation - - @code{Feval()} evaluates the form (a Lisp object) that is passed to -it. Note that evaluation is only non-trivial for two types of objects: -symbols and conses. A symbol is evaluated simply by calling -@code{symbol-value} on it and returning the value. - - Evaluating a cons means calling a function. First, @code{eval} checks -to see if garbage-collection is necessary, and calls -@code{garbage_collect_1()} if so. It then increases the evaluation -depth by 1 (@code{lisp_eval_depth}, which is always less than -@code{max_lisp_eval_depth}) and adds an element to the linked list of -@code{struct backtrace}'s (@code{backtrace_list}). Each such structure -contains a pointer to the function being called plus a list of the -function's arguments. Originally these values are stored unevalled, and -as they are evaluated, the backtrace structure is updated. Garbage -collection pays attention to the objects pointed to in the backtrace -structures (garbage collection might happen while a function is being -called or while an argument is being evaluated, and there could easily -be no other references to the arguments in the argument list; once an -argument is evaluated, however, the unevalled version is not needed by -eval, and so the backtrace structure is changed). - -At this point, the function to be called is determined by looking at -the car of the cons (if this is a symbol, its function definition is -retrieved and the process repeated). The function should then consist -of either a @code{Lisp_Subr} (built-in function written in C), a -@code{Lisp_Compiled_Function} object, or a cons whose car is one of the -symbols @code{autoload}, @code{macro} or @code{lambda}. - -If the function is a @code{Lisp_Subr}, the lisp object points to a -@code{struct Lisp_Subr} (created by @code{DEFUN()}), which contains a -pointer to the C function, a minimum and maximum number of arguments -(or possibly the special constants @code{MANY} or @code{UNEVALLED}), a -pointer to the symbol referring to that subr, and a couple of other -things. If the subr wants its arguments @code{UNEVALLED}, they are -passed raw as a list. Otherwise, an array of evaluated arguments is -created and put into the backtrace structure, and either passed whole -(@code{MANY}) or each argument is passed as a C argument. - -If the function is a @code{Lisp_Compiled_Function}, -@code{funcall_compiled_function()} is called. If the function is a -lambda list, @code{funcall_lambda()} is called. If the function is a -macro, [..... fill in] is done. If the function is an autoload, -@code{do_autoload()} is called to load the definition and then eval -starts over [explain this more]. - -When @code{Feval()} exits, the evaluation depth is reduced by one, the -debugger is called if appropriate, and the current backtrace structure -is removed from the list. - -Both @code{funcall_compiled_function()} and @code{funcall_lambda()} need -to go through the list of formal parameters to the function and bind -them to the actual arguments, checking for @code{&rest} and -@code{&optional} symbols in the formal parameters and making sure the -number of actual arguments is correct. -@code{funcall_compiled_function()} can do this a little more -efficiently, since the formal parameter list can be checked for sanity -when the compiled function object is created. - -@code{funcall_lambda()} simply calls @code{Fprogn} to execute the code -in the lambda list. - -@code{funcall_compiled_function()} calls the real byte-code interpreter -@code{execute_optimized_program()} on the byte-code instructions, which -are converted into an internal form for faster execution. - -When a compiled function is executed for the first time by -@code{funcall_compiled_function()}, or when it is @code{Fpurecopy()}ed -during the dump phase of building XEmacs, the byte-code instructions are -converted from a @code{Lisp_String} (which is inefficient to access, -especially in the presence of MULE) into a @code{Lisp_Opaque} object -containing an array of unsigned char, which can be directly executed by -the byte-code interpreter. At this time the byte code is also analyzed -for validity and transformed into a more optimized form, so that -@code{execute_optimized_program()} can really fly. - -Here are some of the optimizations performed by the internal byte-code -transformer: -@enumerate -@item -References to the @code{constants} array are checked for out-of-range -indices, so that the byte interpreter doesn't have to. -@item -References to the @code{constants} array that will be used as a Lisp -variable are checked for being correct non-constant (i.e. not @code{t}, -@code{nil}, or @code{keywordp}) symbols, so that the byte interpreter -doesn't have to. -@item -The maxiumum number of variable bindings in the byte-code is -pre-computed, so that space on the @code{specpdl} stack can be -pre-reserved once for the whole function execution. -@item -All byte-code jumps are relative to the current program counter instead -of the start of the program, thereby saving a register. -@item -One-byte relative jumps are converted from the byte-code form of unsigned -chars offset by 127 to machine-friendly signed chars. -@end enumerate - -Of course, this transformation of the @code{instructions} should not be -visible to the user, so @code{Fcompiled_function_instructions()} needs -to know how to convert the optimized opaque object back into a Lisp -string that is identical to the original string from the @file{.elc} -file. (Actually, the resulting string may (rarely) contain slightly -different, yet equivalent, byte code.) - -@code{Ffuncall()} implements Lisp @code{funcall}. @code{(funcall fun -x1 x2 x3 ...)} is equivalent to @code{(eval (list fun (quote x1) (quote -x2) (quote x3) ...))}. @code{Ffuncall()} contains its own code to do -the evaluation, however, and is very similar to @code{Feval()}. - -From the performance point of view, it is worth knowing that most of the -time in Lisp evaluation is spent executing @code{Lisp_Subr} and -@code{Lisp_Compiled_Function} objects via @code{Ffuncall()} (not -@code{Feval()}). - -@code{Fapply()} implements Lisp @code{apply}, which is very similar to -@code{funcall} except that if the last argument is a list, the result is the -same as if each of the arguments in the list had been passed separately. -@code{Fapply()} does some business to expand the last argument if it's a -list, then calls @code{Ffuncall()} to do the work. - -@code{apply1()}, @code{call0()}, @code{call1()}, @code{call2()}, and -@code{call3()} call a function, passing it the argument(s) given (the -arguments are given as separate C arguments rather than being passed as -an array). @code{apply1()} uses @code{Fapply()} while the others use -@code{Ffuncall()} to do the real work. - -@node Dynamic Binding; The specbinding Stack; Unwind-Protects -@section Dynamic Binding; The specbinding Stack; Unwind-Protects - -@example -struct specbinding -@{ - Lisp_Object symbol; - Lisp_Object old_value; - Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */ -@}; -@end example - - @code{struct specbinding} is used for local-variable bindings and -unwind-protects. @code{specpdl} holds an array of @code{struct specbinding}'s, -@code{specpdl_ptr} points to the beginning of the free bindings in the -array, @code{specpdl_size} specifies the total number of binding slots -in the array, and @code{max_specpdl_size} specifies the maximum number -of bindings the array can be expanded to hold. @code{grow_specpdl()} -increases the size of the @code{specpdl} array, multiplying its size by -2 but never exceeding @code{max_specpdl_size} (except that if this -number is less than 400, it is first set to 400). - - @code{specbind()} binds a symbol to a value and is used for local -variables and @code{let} forms. The symbol and its old value (which -might be @code{Qunbound}, indicating no prior value) are recorded in the -specpdl array, and @code{specpdl_size} is increased by 1. - - @code{record_unwind_protect()} implements an @dfn{unwind-protect}, -which, when placed around a section of code, ensures that some specified -cleanup routine will be executed even if the code exits abnormally -(e.g. through a @code{throw} or quit). @code{record_unwind_protect()} -simply adds a new specbinding to the @code{specpdl} array and stores the -appropriate information in it. The cleanup routine can either be a C -function, which is stored in the @code{func} field, or a @code{progn} -form, which is stored in the @code{old_value} field. - - @code{unbind_to()} removes specbindings from the @code{specpdl} array -until the specified position is reached. Each specbinding can be one of -three types: - -@enumerate -@item -an unwind-protect with a C cleanup function (@code{func} is not 0, and -@code{old_value} holds an argument to be passed to the function); -@item -an unwind-protect with a Lisp form (@code{func} is 0, @code{symbol} -is @code{nil}, and @code{old_value} holds the form to be executed with -@code{Fprogn()}); or -@item -a local-variable binding (@code{func} is 0, @code{symbol} is not -@code{nil}, and @code{old_value} holds the old value, which is stored as -the symbol's value). -@end enumerate - -@node Simple Special Forms -@section Simple Special Forms - -@code{or}, @code{and}, @code{if}, @code{cond}, @code{progn}, -@code{prog1}, @code{prog2}, @code{setq}, @code{quote}, @code{function}, -@code{let*}, @code{let}, @code{while} - -All of these are very simple and work as expected, calling -@code{Feval()} or @code{Fprogn()} as necessary and (in the case of -@code{let} and @code{let*}) using @code{specbind()} to create bindings -and @code{unbind_to()} to undo the bindings when finished. - -Note that, with the exeption of @code{Fprogn}, these functions are -typically called in real life only in interpreted code, since the byte -compiler knows how to convert calls to these functions directly into -byte code. - -@node Catch and Throw -@section Catch and Throw - -@example -struct catchtag -@{ - Lisp_Object tag; - Lisp_Object val; - struct catchtag *next; - struct gcpro *gcpro; - jmp_buf jmp; - struct backtrace *backlist; - int lisp_eval_depth; - int pdlcount; -@}; -@end example - - @code{catch} is a Lisp function that places a catch around a body of -code. A catch is a means of non-local exit from the code. When a catch -is created, a tag is specified, and executing a @code{throw} to this tag -will exit from the body of code caught with this tag, and its value will -be the value given in the call to @code{throw}. If there is no such -call, the code will be executed normally. - - Information pertaining to a catch is held in a @code{struct catchtag}, -which is placed at the head of a linked list pointed to by -@code{catchlist}. @code{internal_catch()} is passed a C function to -call (@code{Fprogn()} when Lisp @code{catch} is called) and arguments to -give it, and places a catch around the function. Each @code{struct -catchtag} is held in the stack frame of the @code{internal_catch()} -instance that created the catch. - - @code{internal_catch()} is fairly straightforward. It stores into the -@code{struct catchtag} the tag name and the current values of -@code{backtrace_list}, @code{lisp_eval_depth}, @code{gcprolist}, and the -offset into the @code{specpdl} array, sets a jump point with @code{_setjmp()} -(storing the jump point into the @code{struct catchtag}), and calls the -function. Control will return to @code{internal_catch()} either when -the function exits normally or through a @code{_longjmp()} to this jump -point. In the latter case, @code{throw} will store the value to be -returned into the @code{struct catchtag} before jumping. When it's -done, @code{internal_catch()} removes the @code{struct catchtag} from -the catchlist and returns the proper value. - - @code{Fthrow()} goes up through the catchlist until it finds one with -a matching tag. It then calls @code{unbind_catch()} to restore -everything to what it was when the appropriate catch was set, stores the -return value in the @code{struct catchtag}, and jumps (with -@code{_longjmp()}) to its jump point. - - @code{unbind_catch()} removes all catches from the catchlist until it -finds the correct one. Some of the catches might have been placed for -error-trapping, and if so, the appropriate entries on the handlerlist -must be removed (see ``errors''). @code{unbind_catch()} also restores -the values of @code{gcprolist}, @code{backtrace_list}, and -@code{lisp_eval}, and calls @code{unbind_to()} to undo any specbindings -created since the catch. - - -@node Symbols and Variables, Buffers and Textual Representation, Evaluation; Stack Frames; Bindings, Top -@chapter Symbols and Variables - -@menu -* Introduction to Symbols:: -* Obarrays:: -* Symbol Values:: -@end menu - -@node Introduction to Symbols -@section Introduction to Symbols - - A symbol is basically just an object with four fields: a name (a -string), a value (some Lisp object), a function (some Lisp object), and -a property list (usually a list of alternating keyword/value pairs). -What makes symbols special is that there is usually only one symbol with -a given name, and the symbol is referred to by name. This makes a -symbol a convenient way of calling up data by name, i.e. of implementing -variables. (The variable's value is stored in the @dfn{value slot}.) -Similarly, functions are referenced by name, and the definition of the -function is stored in a symbol's @dfn{function slot}. This means that -there can be a distinct function and variable with the same name. The -property list is used as a more general mechanism of associating -additional values with particular names, and once again the namespace is -independent of the function and variable namespaces. - -@node Obarrays -@section Obarrays - - The identity of symbols with their names is accomplished through a -structure called an obarray, which is just a poorly-implemented hash -table mapping from strings to symbols whose name is that string. (I say -``poorly implemented'' because an obarray appears in Lisp as a vector -with some hidden fields rather than as its own opaque type. This is an -Emacs Lisp artifact that should be fixed.) - - Obarrays are implemented as a vector of some fixed size (which should -be a prime for best results), where each ``bucket'' of the vector -contains one or more symbols, threaded through a hidden @code{next} -field in the symbol. Lookup of a symbol in an obarray, and adding a -symbol to an obarray, is accomplished through standard hash-table -techniques. - - The standard Lisp function for working with symbols and obarrays is -@code{intern}. This looks up a symbol in an obarray given its name; if -it's not found, a new symbol is automatically created with the specified -name, added to the obarray, and returned. This is what happens when the -Lisp reader encounters a symbol (or more precisely, encounters the name -of a symbol) in some text that it is reading. There is a standard -obarray called @code{obarray} that is used for this purpose, although -the Lisp programmer is free to create his own obarrays and @code{intern} -symbols in them. - - Note that, once a symbol is in an obarray, it stays there until -something is done about it, and the standard obarray @code{obarray} -always stays around, so once you use any particular variable name, a -corresponding symbol will stay around in @code{obarray} until you exit -XEmacs. - - Note that @code{obarray} itself is a variable, and as such there is a -symbol in @code{obarray} whose name is @code{"obarray"} and which -contains @code{obarray} as its value. - - Note also that this call to @code{intern} occurs only when in the Lisp -reader, not when the code is executed (at which point the symbol is -already around, stored as such in the definition of the function). - - You can create your own obarray using @code{make-vector} (this is -horrible but is an artifact) and intern symbols into that obarray. -Doing that will result in two or more symbols with the same name. -However, at most one of these symbols is in the standard @code{obarray}: -You cannot have two symbols of the same name in any particular obarray. -Note that you cannot add a symbol to an obarray in any fashion other -than using @code{intern}: i.e. you can't take an existing symbol and put -it in an existing obarray. Nor can you change the name of an existing -symbol. (Since obarrays are vectors, you can violate the consistency of -things by storing directly into the vector, but let's ignore that -possibility.) - - Usually symbols are created by @code{intern}, but if you really want, -you can explicitly create a symbol using @code{make-symbol}, giving it -some name. The resulting symbol is not in any obarray (i.e. it is -@dfn{uninterned}), and you can't add it to any obarray. Therefore its -primary purpose is as a symbol to use in macros to avoid namespace -pollution. It can also be used as a carrier of information, but cons -cells could probably be used just as well. - - You can also use @code{intern-soft} to look up a symbol but not create -a new one, and @code{unintern} to remove a symbol from an obarray. This -returns the removed symbol. (Remember: You can't put the symbol back -into any obarray.) Finally, @code{mapatoms} maps over all of the symbols -in an obarray. - -@node Symbol Values -@section Symbol Values - - The value field of a symbol normally contains a Lisp object. However, -a symbol can be @dfn{unbound}, meaning that it logically has no value. -This is internally indicated by storing a special Lisp object, called -@dfn{the unbound marker} and stored in the global variable -@code{Qunbound}. The unbound marker is of a special Lisp object type -called @dfn{symbol-value-magic}. It is impossible for the Lisp -programmer to directly create or access any object of this type. - - @strong{You must not let any ``symbol-value-magic'' object escape to -the Lisp level.} Printing any of these objects will cause the message -@samp{INTERNAL EMACS BUG} to appear as part of the print representation. -(You may see this normally when you call @code{debug_print()} from the -debugger on a Lisp object.) If you let one of these objects escape to -the Lisp level, you will violate a number of assumptions contained in -the C code and make the unbound marker not function right. - - When a symbol is created, its value field (and function field) are set -to @code{Qunbound}. The Lisp programmer can restore these conditions -later using @code{makunbound} or @code{fmakunbound}, and can query to -see whether the value of function fields are @dfn{bound} (i.e. have a -value other than @code{Qunbound}) using @code{boundp} and -@code{fboundp}. The fields are set to a normal Lisp object using -@code{set} (or @code{setq}) and @code{fset}. - - Other symbol-value-magic objects are used as special markers to -indicate variables that have non-normal properties. This includes any -variables that are tied into C variables (setting the variable magically -sets some global variable in the C code, and likewise for retrieving the -variable's value), variables that magically tie into slots in the -current buffer, variables that are buffer-local, etc. The -symbol-value-magic object is stored in the value cell in place of -a normal object, and the code to retrieve a symbol's value -(i.e. @code{symbol-value}) knows how to do special things with them. -This means that you should not just fetch the value cell directly if you -want a symbol's value. - - The exact workings of this are rather complex and involved and are -well-documented in comments in @file{buffer.c}, @file{symbols.c}, and -@file{lisp.h}. - -@node Buffers and Textual Representation, MULE Character Sets and Encodings, Symbols and Variables, Top -@chapter Buffers and Textual Representation - -@menu -* Introduction to Buffers:: A buffer holds a block of text such as a file. -* The Text in a Buffer:: Representation of the text in a buffer. -* Buffer Lists:: Keeping track of all buffers. -* Markers and Extents:: Tagging locations within a buffer. -* Bufbytes and Emchars:: Representation of individual characters. -* The Buffer Object:: The Lisp object corresponding to a buffer. -@end menu - -@node Introduction to Buffers -@section Introduction to Buffers - - A buffer is logically just a Lisp object that holds some text. -In this, it is like a string, but a buffer is optimized for -frequent insertion and deletion, while a string is not. Furthermore: - -@enumerate -@item -Buffers are @dfn{permanent} objects, i.e. once you create them, they -remain around, and need to be explicitly deleted before they go away. -@item -Each buffer has a unique name, which is a string. Buffers are -normally referred to by name. In this respect, they are like -symbols. -@item -Buffers have a default insertion position, called @dfn{point}. -Inserting text (unless you explicitly give a position) goes at point, -and moves point forward past the text. This is what is going on when -you type text into Emacs. -@item -Buffers have lots of extra properties associated with them. -@item -Buffers can be @dfn{displayed}. What this means is that there -exist a number of @dfn{windows}, which are objects that correspond -to some visible section of your display, and each window has -an associated buffer, and the current contents of the buffer -are shown in that section of the display. The redisplay mechanism -(which takes care of doing this) knows how to look at the -text of a buffer and come up with some reasonable way of displaying -this. Many of the properties of a buffer control how the -buffer's text is displayed. -@item -One buffer is distinguished and called the @dfn{current buffer}. It is -stored in the variable @code{current_buffer}. Buffer operations operate -on this buffer by default. When you are typing text into a buffer, the -buffer you are typing into is always @code{current_buffer}. Switching -to a different window changes the current buffer. Note that Lisp code -can temporarily change the current buffer using @code{set-buffer} (often -enclosed in a @code{save-excursion} so that the former current buffer -gets restored when the code is finished). However, calling -@code{set-buffer} will NOT cause a permanent change in the current -buffer. The reason for this is that the top-level event loop sets -@code{current_buffer} to the buffer of the selected window, each time -it finishes executing a user command. -@end enumerate - - Make sure you understand the distinction between @dfn{current buffer} -and @dfn{buffer of the selected window}, and the distinction between -@dfn{point} of the current buffer and @dfn{window-point} of the selected -window. (This latter distinction is explained in detail in the section -on windows.) - -@node The Text in a Buffer -@section The Text in a Buffer - - The text in a buffer consists of a sequence of zero or more -characters. A @dfn{character} is an integer that logically represents -a letter, number, space, or other unit of text. Most of the characters -that you will typically encounter belong to the ASCII set of characters, -but there are also characters for various sorts of accented letters, -special symbols, Chinese and Japanese ideograms (i.e. Kanji, Katakana, -etc.), Cyrillic and Greek letters, etc. The actual number of possible -characters is quite large. - - For now, we can view a character as some non-negative integer that -has some shape that defines how it typically appears (e.g. as an -uppercase A). (The exact way in which a character appears depends on the -font used to display the character.) The internal type of characters in -the C code is an @code{Emchar}; this is just an @code{int}, but using a -symbolic type makes the code clearer. - - Between every character in a buffer is a @dfn{buffer position} or -@dfn{character position}. We can speak of the character before or after -a particular buffer position, and when you insert a character at a -particular position, all characters after that position end up at new -positions. When we speak of the character @dfn{at} a position, we -really mean the character after the position. (This schizophrenia -between a buffer position being ``between'' a character and ``on'' a -character is rampant in Emacs.) - - Buffer positions are numbered starting at 1. This means that -position 1 is before the first character, and position 0 is not -valid. If there are N characters in a buffer, then buffer -position N+1 is after the last one, and position N+2 is not valid. - - The internal makeup of the Emchar integer varies depending on whether -we have compiled with MULE support. If not, the Emchar integer is an -8-bit integer with possible values from 0 - 255. 0 - 127 are the -standard ASCII characters, while 128 - 255 are the characters from the -ISO-8859-1 character set. If we have compiled with MULE support, an -Emchar is a 19-bit integer, with the various bits having meanings -according to a complex scheme that will be detailed later. The -characters numbered 0 - 255 still have the same meanings as for the -non-MULE case, though. - - Internally, the text in a buffer is represented in a fairly simple -fashion: as a contiguous array of bytes, with a @dfn{gap} of some size -in the middle. Although the gap is of some substantial size in bytes, -there is no text contained within it: From the perspective of the text -in the buffer, it does not exist. The gap logically sits at some buffer -position, between two characters (or possibly at the beginning or end of -the buffer). Insertion of text in a buffer at a particular position is -always accomplished by first moving the gap to that position -(i.e. through some block moving of text), then writing the text into the -beginning of the gap, thereby shrinking the gap. If the gap shrinks -down to nothing, a new gap is created. (What actually happens is that a -new gap is ``created'' at the end of the buffer's text, which requires -nothing more than changing a couple of indices; then the gap is -``moved'' to the position where the insertion needs to take place by -moving up in memory all the text after that position.) Similarly, -deletion occurs by moving the gap to the place where the text is to be -deleted, and then simply expanding the gap to include the deleted text. -(@dfn{Expanding} and @dfn{shrinking} the gap as just described means -just that the internal indices that keep track of where the gap is -located are changed.) - - Note that the total amount of memory allocated for a buffer text never -decreases while the buffer is live. Therefore, if you load up a -20-megabyte file and then delete all but one character, there will be a -20-megabyte gap, which won't get any smaller (except by inserting -characters back again). Once the buffer is killed, the memory allocated -for the buffer text will be freed, but it will still be sitting on the -heap, taking up virtual memory, and will not be released back to the -operating system. (However, if you have compiled XEmacs with rel-alloc, -the situation is different. In this case, the space @emph{will} be -released back to the operating system. However, this tends to result in a -noticeable speed penalty.) - - Astute readers may notice that the text in a buffer is represented as -an array of @emph{bytes}, while (at least in the MULE case) an Emchar is -a 19-bit integer, which clearly cannot fit in a byte. This means (of -course) that the text in a buffer uses a different representation from -an Emchar: specifically, the 19-bit Emchar becomes a series of one to -four bytes. The conversion between these two representations is complex -and will be described later. - - In the non-MULE case, everything is very simple: An Emchar -is an 8-bit value, which fits neatly into one byte. - - If we are given a buffer position and want to retrieve the -character at that position, we need to follow these steps: - -@enumerate -@item -Pretend there's no gap, and convert the buffer position into a @dfn{byte -index} that indexes to the appropriate byte in the buffer's stream of -textual bytes. By convention, byte indices begin at 1, just like buffer -positions. In the non-MULE case, byte indices and buffer positions are -identical, since one character equals one byte. -@item -Convert the byte index into a @dfn{memory index}, which takes the gap -into account. The memory index is a direct index into the block of -memory that stores the text of a buffer. This basically just involves -checking to see if the byte index is past the gap, and if so, adding the -size of the gap to it. By convention, memory indices begin at 1, just -like buffer positions and byte indices, and when referring to the -position that is @dfn{at} the gap, we always use the memory position at -the @emph{beginning}, not at the end, of the gap. -@item -Fetch the appropriate bytes at the determined memory position. -@item -Convert these bytes into an Emchar. -@end enumerate - - In the non-Mule case, (3) and (4) boil down to a simple one-byte -memory access. - - Note that we have defined three types of positions in a buffer: - -@enumerate -@item -@dfn{buffer positions} or @dfn{character positions}, typedef @code{Bufpos} -@item -@dfn{byte indices}, typedef @code{Bytind} -@item -@dfn{memory indices}, typedef @code{Memind} -@end enumerate - - All three typedefs are just @code{int}s, but defining them this way makes -things a lot clearer. - - Most code works with buffer positions. In particular, all Lisp code -that refers to text in a buffer uses buffer positions. Lisp code does -not know that byte indices or memory indices exist. - - Finally, we have a typedef for the bytes in a buffer. This is a -@code{Bufbyte}, which is an unsigned char. Referring to them as -Bufbytes underscores the fact that we are working with a string of bytes -in the internal Emacs buffer representation rather than in one of a -number of possible alternative representations (e.g. EUC-encoded text, -etc.). - -@node Buffer Lists -@section Buffer Lists - - Recall earlier that buffers are @dfn{permanent} objects, i.e. that -they remain around until explicitly deleted. This entails that there is -a list of all the buffers in existence. This list is actually an -assoc-list (mapping from the buffer's name to the buffer) and is stored -in the global variable @code{Vbuffer_alist}. - - The order of the buffers in the list is important: the buffers are -ordered approximately from most-recently-used to least-recently-used. -Switching to a buffer using @code{switch-to-buffer}, -@code{pop-to-buffer}, etc. and switching windows using -@code{other-window}, etc. usually brings the new current buffer to the -front of the list. @code{switch-to-buffer}, @code{other-buffer}, -etc. look at the beginning of the list to find an alternative buffer to -suggest. You can also explicitly move a buffer to the end of the list -using @code{bury-buffer}. - - In addition to the global ordering in @code{Vbuffer_alist}, each frame -has its own ordering of the list. These lists always contain the same -elements as in @code{Vbuffer_alist} although possibly in a different -order. @code{buffer-list} normally returns the list for the selected -frame. This allows you to work in separate frames without things -interfering with each other. - - The standard way to look up a buffer given a name is -@code{get-buffer}, and the standard way to create a new buffer is -@code{get-buffer-create}, which looks up a buffer with a given name, -creating a new one if necessary. These operations correspond exactly -with the symbol operations @code{intern-soft} and @code{intern}, -respectively. You can also force a new buffer to be created using -@code{generate-new-buffer}, which takes a name and (if necessary) makes -a unique name from this by appending a number, and then creates the -buffer. This is basically like the symbol operation @code{gensym}. - -@node Markers and Extents -@section Markers and Extents - - Among the things associated with a buffer are things that are -logically attached to certain buffer positions. This can be used to -keep track of a buffer position when text is inserted and deleted, so -that it remains at the same spot relative to the text around it; to -assign properties to particular sections of text; etc. There are two -such objects that are useful in this regard: they are @dfn{markers} and -@dfn{extents}. - - A @dfn{marker} is simply a flag placed at a particular buffer -position, which is moved around as text is inserted and deleted. -Markers are used for all sorts of purposes, such as the @code{mark} that -is the other end of textual regions to be cut, copied, etc. - - An @dfn{extent} is similar to two markers plus some associated -properties, and is used to keep track of regions in a buffer as text is -inserted and deleted, and to add properties (e.g. fonts) to particular -regions of text. The external interface of extents is explained -elsewhere. - - The important thing here is that markers and extents simply contain -buffer positions in them as integers, and every time text is inserted or -deleted, these positions must be updated. In order to minimize the -amount of shuffling that needs to be done, the positions in markers and -extents (there's one per marker, two per extent) and stored in Meminds. -This means that they only need to be moved when the text is physically -moved in memory; since the gap structure tries to minimize this, it also -minimizes the number of marker and extent indices that need to be -adjusted. Look in @file{insdel.c} for the details of how this works. - - One other important distinction is that markers are @dfn{temporary} -while extents are @dfn{permanent}. This means that markers disappear as -soon as there are no more pointers to them, and correspondingly, there -is no way to determine what markers are in a buffer if you are just -given the buffer. Extents remain in a buffer until they are detached -(which could happen as a result of text being deleted) or the buffer is -deleted, and primitives do exist to enumerate the extents in a buffer. - -@node Bufbytes and Emchars -@section Bufbytes and Emchars - - Not yet documented. - -@node The Buffer Object -@section The Buffer Object - - Buffers contain fields not directly accessible by the Lisp programmer. -We describe them here, naming them by the names used in the C code. -Many are accessible indirectly in Lisp programs via Lisp primitives. - -@table @code -@item name -The buffer name is a string that names the buffer. It is guaranteed to -be unique. @xref{Buffer Names,,, lispref, XEmacs Lisp Programmer's -Manual}. - -@item save_modified -This field contains the time when the buffer was last saved, as an -integer. @xref{Buffer Modification,,, lispref, XEmacs Lisp Programmer's -Manual}. - -@item modtime -This field contains the modification time of the visited file. It is -set when the file is written or read. Every time the buffer is written -to the file, this field is compared to the modification time of the -file. @xref{Buffer Modification,,, lispref, XEmacs Lisp Programmer's -Manual}. - -@item auto_save_modified -This field contains the time when the buffer was last auto-saved. - -@item last_window_start -This field contains the @code{window-start} position in the buffer as of -the last time the buffer was displayed in a window. - -@item undo_list -This field points to the buffer's undo list. @xref{Undo,,, lispref, -XEmacs Lisp Programmer's Manual}. - -@item syntax_table_v -This field contains the syntax table for the buffer. @xref{Syntax -Tables,,, lispref, XEmacs Lisp Programmer's Manual}. - -@item downcase_table -This field contains the conversion table for converting text to lower -case. @xref{Case Tables,,, lispref, XEmacs Lisp Programmer's Manual}. - -@item upcase_table -This field contains the conversion table for converting text to upper -case. @xref{Case Tables,,, lispref, XEmacs Lisp Programmer's Manual}. - -@item case_canon_table -This field contains the conversion table for canonicalizing text for -case-folding search. @xref{Case Tables,,, lispref, XEmacs Lisp -Programmer's Manual}. - -@item case_eqv_table -This field contains the equivalence table for case-folding search. -@xref{Case Tables,,, lispref, XEmacs Lisp Programmer's Manual}. - -@item display_table -This field contains the buffer's display table, or @code{nil} if it -doesn't have one. @xref{Display Tables,,, lispref, XEmacs Lisp -Programmer's Manual}. - -@item markers -This field contains the chain of all markers that currently point into -the buffer. Deletion of text in the buffer, and motion of the buffer's -gap, must check each of these markers and perhaps update it. -@xref{Markers,,, lispref, XEmacs Lisp Programmer's Manual}. - -@item backed_up -This field is a flag that tells whether a backup file has been made for -the visited file of this buffer. - -@item mark -This field contains the mark for the buffer. The mark is a marker, -hence it is also included on the list @code{markers}. @xref{The Mark,,, -lispref, XEmacs Lisp Programmer's Manual}. - -@item mark_active -This field is non-@code{nil} if the buffer's mark is active. - -@item local_var_alist -This field contains the association list describing the variables local -in this buffer, and their values, with the exception of local variables -that have special slots in the buffer object. (Those slots are omitted -from this table.) @xref{Buffer-Local Variables,,, lispref, XEmacs Lisp -Programmer's Manual}. - -@item modeline_format -This field contains a Lisp object which controls how to display the mode -line for this buffer. @xref{Modeline Format,,, lispref, XEmacs Lisp -Programmer's Manual}. - -@item base_buffer -This field holds the buffer's base buffer (if it is an indirect buffer), -or @code{nil}. -@end table - -@node MULE Character Sets and Encodings, The Lisp Reader and Compiler, Buffers and Textual Representation, Top -@chapter MULE Character Sets and Encodings - - Recall that there are two primary ways that text is represented in -XEmacs. The @dfn{buffer} representation sees the text as a series of -bytes (Bufbytes), with a variable number of bytes used per character. -The @dfn{character} representation sees the text as a series of integers -(Emchars), one per character. The character representation is a cleaner -representation from a theoretical standpoint, and is thus used in many -cases when lots of manipulations on a string need to be done. However, -the buffer representation is the standard representation used in both -Lisp strings and buffers, and because of this, it is the ``default'' -representation that text comes in. The reason for using this -representation is that it's compact and is compatible with ASCII. - -@menu -* Character Sets:: -* Encodings:: -* Internal Mule Encodings:: -* CCL:: -@end menu - -@node Character Sets -@section Character Sets - - A character set (or @dfn{charset}) is an ordered set of characters. A -particular character in a charset is indexed using one or more -@dfn{position codes}, which are non-negative integers. The number of -position codes needed to identify a particular character in a charset is -called the @dfn{dimension} of the charset. In XEmacs/Mule, all charsets -have dimension 1 or 2, and the size of all charsets (except for a few -special cases) is either 94, 96, 94 by 94, or 96 by 96. The range of -position codes used to index characters from any of these types of -character sets is as follows: - -@example -Charset type Position code 1 Position code 2 ------------------------------------------------------------- -94 33 - 126 N/A -96 32 - 127 N/A -94x94 33 - 126 33 - 126 -96x96 32 - 127 32 - 127 -@end example - - Note that in the above cases position codes do not start at an -expected value such as 0 or 1. The reason for this will become clear -later. - - For example, Latin-1 is a 96-character charset, and JISX0208 (the -Japanese national character set) is a 94x94-character charset. - - [Note that, although the ranges above define the @emph{valid} position -codes for a charset, some of the slots in a particular charset may in -fact be empty. This is the case for JISX0208, for example, where (e.g.) -all the slots whose first position code is in the range 118 - 127 are -empty.] - - There are three charsets that do not follow the above rules. All of -them have one dimension, and have ranges of position codes as follows: - -@example -Charset name Position code 1 ------------------------------------- -ASCII 0 - 127 -Control-1 0 - 31 -Composite 0 - some large number -@end example - - (The upper bound of the position code for composite characters has not -yet been determined, but it will probably be at least 16,383). - - ASCII is the union of two subsidiary character sets: Printing-ASCII -(the printing ASCII character set, consisting of position codes 33 - -126, like for a standard 94-character charset) and Control-ASCII (the -non-printing characters that would appear in a binary file with codes 0 -- 32 and 127). - - Control-1 contains the non-printing characters that would appear in a -binary file with codes 128 - 159. - - Composite contains characters that are generated by overstriking one -or more characters from other charsets. - - Note that some characters in ASCII, and all characters in Control-1, -are @dfn{control} (non-printing) characters. These have no printed -representation but instead control some other function of the printing -(e.g. TAB or 8 moves the current character position to the next tab -stop). All other characters in all charsets are @dfn{graphic} -(printing) characters. - - When a binary file is read in, the bytes in the file are assigned to -character sets as follows: - -@example -Bytes Character set Range --------------------------------------------------- -0 - 127 ASCII 0 - 127 -128 - 159 Control-1 0 - 31 -160 - 255 Latin-1 32 - 127 -@end example - - This is a bit ad-hoc but gets the job done. - -@node Encodings -@section Encodings - - An @dfn{encoding} is a way of numerically representing characters from -one or more character sets. If an encoding only encompasses one -character set, then the position codes for the characters in that -character set could be used directly. This is not possible, however, if -more than one character set is to be used in the encoding. - - For example, the conversion detailed above between bytes in a binary -file and characters is effectively an encoding that encompasses the -three character sets ASCII, Control-1, and Latin-1 in a stream of 8-bit -bytes. - - Thus, an encoding can be viewed as a way of encoding characters from a -specified group of character sets using a stream of bytes, each of which -contains a fixed number of bits (but not necessarily 8, as in the common -usage of ``byte''). - - Here are descriptions of a couple of common -encodings: - -@menu -* Japanese EUC (Extended Unix Code):: -* JIS7:: -@end menu - -@node Japanese EUC (Extended Unix Code) -@subsection Japanese EUC (Extended Unix Code) - -This encompasses the character sets Printing-ASCII, Japanese-JISX0201, -and Japanese-JISX0208-Kana (half-width katakana, the right half of -JISX0201). It uses 8-bit bytes. - -Note that Printing-ASCII and Japanese-JISX0201-Kana are 94-character -charsets, while Japanese-JISX0208 is a 94x94-character charset. - -The encoding is as follows: - -@example -Character set Representation (PC=position-code) -------------- -------------- -Printing-ASCII PC1 -Japanese-JISX0201-Kana 0x8E | PC1 + 0x80 -Japanese-JISX0208 PC1 + 0x80 | PC2 + 0x80 -Japanese-JISX0212 PC1 + 0x80 | PC2 + 0x80 -@end example - - -@node JIS7 -@subsection JIS7 - -This encompasses the character sets Printing-ASCII, -Japanese-JISX0201-Roman (the left half of JISX0201; this character set -is very similar to Printing-ASCII and is a 94-character charset), -Japanese-JISX0208, and Japanese-JISX0201-Kana. It uses 7-bit bytes. - -Unlike Japanese EUC, this is a @dfn{modal} encoding, which -means that there are multiple states that the encoding can -be in, which affect how the bytes are to be interpreted. -Special sequences of bytes (called @dfn{escape sequences}) -are used to change states. - - The encoding is as follows: - -@example -Character set Representation (PC=position-code) -------------- -------------- -Printing-ASCII PC1 -Japanese-JISX0201-Roman PC1 -Japanese-JISX0201-Kana PC1 -Japanese-JISX0208 PC1 PC2 - - -Escape sequence ASCII equivalent Meaning ---------------- ---------------- ------- -0x1B 0x28 0x4A ESC ( J invoke Japanese-JISX0201-Roman -0x1B 0x28 0x49 ESC ( I invoke Japanese-JISX0201-Kana -0x1B 0x24 0x42 ESC $ B invoke Japanese-JISX0208 -0x1B 0x28 0x42 ESC ( B invoke Printing-ASCII -@end example - - Initially, Printing-ASCII is invoked. - -@node Internal Mule Encodings -@section Internal Mule Encodings - -In XEmacs/Mule, each character set is assigned a unique number, called a -@dfn{leading byte}. This is used in the encodings of a character. -Leading bytes are in the range 0x80 - 0xFF (except for ASCII, which has -a leading byte of 0), although some leading bytes are reserved. - -Charsets whose leading byte is in the range 0x80 - 0x9F are called -@dfn{official} and are used for built-in charsets. Other charsets are -called @dfn{private} and have leading bytes in the range 0xA0 - 0xFF; -these are user-defined charsets. - - More specifically: - -@example -Character set Leading byte -------------- ------------ -ASCII 0 -Composite 0x80 -Dimension-1 Official 0x81 - 0x8D - (0x8E is free) -Control-1 0x8F -Dimension-2 Official 0x90 - 0x99 - (0x9A - 0x9D are free; - 0x9E and 0x9F are reserved) -Dimension-1 Private 0xA0 - 0xEF -Dimension-2 Private 0xF0 - 0xFF -@end example - -There are two internal encodings for characters in XEmacs/Mule. One is -called @dfn{string encoding} and is an 8-bit encoding that is used for -representing characters in a buffer or string. It uses 1 to 4 bytes per -character. The other is called @dfn{character encoding} and is a 19-bit -encoding that is used for representing characters individually in a -variable. - -(In the following descriptions, we'll ignore composite characters for -the moment. We also give a general (structural) overview first, -followed later by the exact details.) - -@menu -* Internal String Encoding:: -* Internal Character Encoding:: -@end menu - -@node Internal String Encoding -@subsection Internal String Encoding - -ASCII characters are encoded using their position code directly. Other -characters are encoded using their leading byte followed by their -position code(s) with the high bit set. Characters in private character -sets have their leading byte prefixed with a @dfn{leading byte prefix}, -which is either 0x9E or 0x9F. (No character sets are ever assigned these -leading bytes.) Specifically: - -@example -Character set Encoding (PC=position-code, LB=leading-byte) -------------- -------- -ASCII PC-1 | -Control-1 LB | PC1 + 0xA0 | -Dimension-1 official LB | PC1 + 0x80 | -Dimension-1 private 0x9E | LB | PC1 + 0x80 | -Dimension-2 official LB | PC1 + 0x80 | PC2 + 0x80 | -Dimension-2 private 0x9F | LB | PC1 + 0x80 | PC2 + 0x80 -@end example - - The basic characteristic of this encoding is that the first byte -of all characters is in the range 0x00 - 0x9F, and the second and -following bytes of all characters is in the range 0xA0 - 0xFF. -This means that it is impossible to get out of sync, or more -specifically: - -@enumerate -@item -Given any byte position, the beginning of the character it is -within can be determined in constant time. -@item -Given any byte position at the beginning of a character, the -beginning of the next character can be determined in constant -time. -@item -Given any byte position at the beginning of a character, the -beginning of the previous character can be determined in constant -time. -@item -Textual searches can simply treat encoded strings as if they -were encoded in a one-byte-per-character fashion rather than -the actual multi-byte encoding. -@end enumerate - - None of the standard non-modal encodings meet all of these -conditions. For example, EUC satisfies only (2) and (3), while -Shift-JIS and Big5 (not yet described) satisfy only (2). (All -non-modal encodings must satisfy (2), in order to be unambiguous.) - -@node Internal Character Encoding -@subsection Internal Character Encoding - - One 19-bit word represents a single character. The word is -separated into three fields: - -@example -Bit number: 18 17 16 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 - <------------> <------------------> <------------------> -Field: 1 2 3 -@end example - - Note that fields 2 and 3 hold 7 bits each, while field 1 holds 5 bits. - -@example -Character set Field 1 Field 2 Field 3 -------------- ------- ------- ------- -ASCII 0 0 PC1 - range: (00 - 7F) -Control-1 0 1 PC1 - range: (00 - 1F) -Dimension-1 official 0 LB - 0x80 PC1 - range: (01 - 0D) (20 - 7F) -Dimension-1 private 0 LB - 0x80 PC1 - range: (20 - 6F) (20 - 7F) -Dimension-2 official LB - 0x8F PC1 PC2 - range: (01 - 0A) (20 - 7F) (20 - 7F) -Dimension-2 private LB - 0xE1 PC1 PC2 - range: (0F - 1E) (20 - 7F) (20 - 7F) -Composite 0x1F ? ? -@end example - - Note that character codes 0 - 255 are the same as the ``binary encoding'' -described above. - -@node CCL -@section CCL - -@example -CCL PROGRAM SYNTAX: - CCL_PROGRAM := (CCL_MAIN_BLOCK - [ CCL_EOF_BLOCK ]) - - CCL_MAIN_BLOCK := CCL_BLOCK - CCL_EOF_BLOCK := CCL_BLOCK - - CCL_BLOCK := STATEMENT | (STATEMENT [STATEMENT ...]) - STATEMENT := - SET | IF | BRANCH | LOOP | REPEAT | BREAK - | READ | WRITE - - SET := (REG = EXPRESSION) | (REG SELF_OP EXPRESSION) - | INT-OR-CHAR - - EXPRESSION := ARG | (EXPRESSION OP ARG) - - IF := (if EXPRESSION CCL_BLOCK CCL_BLOCK) - BRANCH := (branch EXPRESSION CCL_BLOCK [CCL_BLOCK ...]) - LOOP := (loop STATEMENT [STATEMENT ...]) - BREAK := (break) - REPEAT := (repeat) - | (write-repeat [REG | INT-OR-CHAR | string]) - | (write-read-repeat REG [INT-OR-CHAR | string | ARRAY]?) - READ := (read REG) | (read REG REG) - | (read-if REG ARITH_OP ARG CCL_BLOCK CCL_BLOCK) - | (read-branch REG CCL_BLOCK [CCL_BLOCK ...]) - WRITE := (write REG) | (write REG REG) - | (write INT-OR-CHAR) | (write STRING) | STRING - | (write REG ARRAY) - END := (end) - - REG := r0 | r1 | r2 | r3 | r4 | r5 | r6 | r7 - ARG := REG | INT-OR-CHAR - OP := + | - | * | / | % | & | '|' | ^ | << | >> | <8 | >8 | // - | < | > | == | <= | >= | != - SELF_OP := - += | -= | *= | /= | %= | &= | '|=' | ^= | <<= | >>= - ARRAY := '[' INT-OR-CHAR ... ']' - INT-OR-CHAR := INT | CHAR - -MACHINE CODE: - -The machine code consists of a vector of 32-bit words. -The first such word specifies the start of the EOF section of the code; -this is the code executed to handle any stuff that needs to be done -(e.g. designating back to ASCII and left-to-right mode) after all -other encoded/decoded data has been written out. This is not used for -charset CCL programs. - -REGISTER: 0..7 -- refered by RRR or rrr - -OPERATOR BIT FIELD (27-bit): XXXXXXXXXXXXXXX RRR TTTTT - TTTTT (5-bit): operator type - RRR (3-bit): register number - XXXXXXXXXXXXXXXX (15-bit): - CCCCCCCCCCCCCCC: constant or address - 000000000000rrr: register number - -AAAA: 00000 + - 00001 - - 00010 * - 00011 / - 00100 % - 00101 & - 00110 | - 00111 ~ - - 01000 << - 01001 >> - 01010 <8 - 01011 >8 - 01100 // - 01101 not used - 01110 not used - 01111 not used - - 10000 < - 10001 > - 10010 == - 10011 <= - 10100 >= - 10101 != - -OPERATORS: TTTTT RRR XX.. - -SetCS: 00000 RRR C...C RRR = C...C -SetCL: 00001 RRR ..... RRR = c...c - c.............c -SetR: 00010 RRR ..rrr RRR = rrr -SetA: 00011 RRR ..rrr RRR = array[rrr] - C.............C size of array = C...C - c.............c contents = c...c - -Jump: 00100 000 c...c jump to c...c -JumpCond: 00101 RRR c...c if (!RRR) jump to c...c -WriteJump: 00110 RRR c...c Write1 RRR, jump to c...c -WriteReadJump: 00111 RRR c...c Write1, Read1 RRR, jump to c...c -WriteCJump: 01000 000 c...c Write1 C...C, jump to c...c - C...C -WriteCReadJump: 01001 RRR c...c Write1 C...C, Read1 RRR, - C.............C and jump to c...c -WriteSJump: 01010 000 c...c WriteS, jump to c...c - C.............C - S.............S - ... -WriteSReadJump: 01011 RRR c...c WriteS, Read1 RRR, jump to c...c - C.............C - S.............S - ... -WriteAReadJump: 01100 RRR c...c WriteA, Read1 RRR, jump to c...c - C.............C size of array = C...C - c.............c contents = c...c - ... -Branch: 01101 RRR C...C if (RRR >= 0 && RRR < C..) - c.............c branch to (RRR+1)th address -Read1: 01110 RRR ... read 1-byte to RRR -Read2: 01111 RRR ..rrr read 2-byte to RRR and rrr -ReadBranch: 10000 RRR C...C Read1 and Branch - c.............c - ... -Write1: 10001 RRR ..... write 1-byte RRR -Write2: 10010 RRR ..rrr write 2-byte RRR and rrr -WriteC: 10011 000 ..... write 1-char C...CC - C.............C -WriteS: 10100 000 ..... write C..-byte of string - C.............C - S.............S - ... -WriteA: 10101 RRR ..... write array[RRR] - C.............C size of array = C...C - c.............c contents = c...c - ... -End: 10110 000 ..... terminate the execution - -SetSelfCS: 10111 RRR C...C RRR AAAAA= C...C - ..........AAAAA -SetSelfCL: 11000 RRR ..... RRR AAAAA= c...c - c.............c - ..........AAAAA -SetSelfR: 11001 RRR ..Rrr RRR AAAAA= rrr - ..........AAAAA -SetExprCL: 11010 RRR ..Rrr RRR = rrr AAAAA c...c - c.............c - ..........AAAAA -SetExprR: 11011 RRR ..rrr RRR = rrr AAAAA Rrr - ............Rrr - ..........AAAAA -JumpCondC: 11100 RRR c...c if !(RRR AAAAA C..) jump to c...c - C.............C - ..........AAAAA -JumpCondR: 11101 RRR c...c if !(RRR AAAAA rrr) jump to c...c - ............rrr - ..........AAAAA -ReadJumpCondC: 11110 RRR c...c Read1 and JumpCondC - C.............C - ..........AAAAA -ReadJumpCondR: 11111 RRR c...c Read1 and JumpCondR - ............rrr - ..........AAAAA -@end example - -@node The Lisp Reader and Compiler, Lstreams, MULE Character Sets and Encodings, Top -@chapter The Lisp Reader and Compiler - -Not yet documented. - -@node Lstreams, Consoles; Devices; Frames; Windows, The Lisp Reader and Compiler, Top -@chapter Lstreams - - An @dfn{lstream} is an internal Lisp object that provides a generic -buffering stream implementation. Conceptually, you send data to the -stream or read data from the stream, not caring what's on the other end -of the stream. The other end could be another stream, a file -descriptor, a stdio stream, a fixed block of memory, a reallocating -block of memory, etc. The main purpose of the stream is to provide a -standard interface and to do buffering. Macros are defined to read or -write characters, so the calling functions do not have to worry about -blocking data together in order to achieve efficiency. - -@menu -* Creating an Lstream:: Creating an lstream object. -* Lstream Types:: Different sorts of things that are streamed. -* Lstream Functions:: Functions for working with lstreams. -* Lstream Methods:: Creating new lstream types. -@end menu - -@node Creating an Lstream -@section Creating an Lstream - -Lstreams come in different types, depending on what is being interfaced -to. Although the primitive for creating new lstreams is -@code{Lstream_new()}, generally you do not call this directly. Instead, -you call some type-specific creation function, which creates the lstream -and initializes it as appropriate for the particular type. - -All lstream creation functions take a @var{mode} argument, specifying -what mode the lstream should be opened as. This controls whether the -lstream is for input and output, and optionally whether data should be -blocked up in units of MULE characters. Note that some types of -lstreams can only be opened for input; others only for output; and -others can be opened either way. #### Richard Mlynarik thinks that -there should be a strict separation between input and output streams, -and he's probably right. - - @var{mode} is a string, one of - -@table @code -@item "r" - Open for reading. -@item "w" - Open for writing. -@item "rc" - Open for reading, but ``read'' never returns partial MULE characters. -@item "wc" - Open for writing, but never writes partial MULE characters. -@end table - -@node Lstream Types -@section Lstream Types - -@table @asis -@item stdio - -@item filedesc - -@item lisp-string - -@item fixed-buffer - -@item resizing-buffer - -@item dynarr - -@item lisp-buffer - -@item print - -@item decoding - -@item encoding -@end table - -@node Lstream Functions -@section Lstream Functions - -@deftypefun {Lstream *} Lstream_new (Lstream_implementation *@var{imp}, CONST char *@var{mode}) -Allocate and return a new Lstream. This function is not really meant to -be called directly; rather, each stream type should provide its own -stream creation function, which creates the stream and does any other -necessary creation stuff (e.g. opening a file). -@end deftypefun - -@deftypefun void Lstream_set_buffering (Lstream *@var{lstr}, Lstream_buffering @var{buffering}, int @var{buffering_size}) -Change the buffering of a stream. See @file{lstream.h}. By default the -buffering is @code{STREAM_BLOCK_BUFFERED}. -@end deftypefun - -@deftypefun int Lstream_flush (Lstream *@var{lstr}) -Flush out any pending unwritten data in the stream. Clear any buffered -input data. Returns 0 on success, -1 on error. -@end deftypefun - -@deftypefn Macro int Lstream_putc (Lstream *@var{stream}, int @var{c}) -Write out one byte to the stream. This is a macro and so it is very -efficient. The @var{c} argument is only evaluated once but the @var{stream} -argument is evaluated more than once. Returns 0 on success, -1 on -error. -@end deftypefn - -@deftypefn Macro int Lstream_getc (Lstream *@var{stream}) -Read one byte from the stream. This is a macro and so it is very -efficient. The @var{stream} argument is evaluated more than once. Return -value is -1 for EOF or error. -@end deftypefn - -@deftypefn Macro void Lstream_ungetc (Lstream *@var{stream}, int @var{c}) -Push one byte back onto the input queue. This will be the next byte -read from the stream. Any number of bytes can be pushed back and will -be read in the reverse order they were pushed back -- most recent -first. (This is necessary for consistency -- if there are a number of -bytes that have been unread and I read and unread a byte, it needs to be -the first to be read again.) This is a macro and so it is very -efficient. The @var{c} argument is only evaluated once but the @var{stream} -argument is evaluated more than once. -@end deftypefn - -@deftypefun int Lstream_fputc (Lstream *@var{stream}, int @var{c}) -@deftypefunx int Lstream_fgetc (Lstream *@var{stream}) -@deftypefunx void Lstream_fungetc (Lstream *@var{stream}, int @var{c}) -Function equivalents of the above macros. -@end deftypefun - -@deftypefun int Lstream_read (Lstream *@var{stream}, void *@var{data}, int @var{size}) -Read @var{size} bytes of @var{data} from the stream. Return the number -of bytes read. 0 means EOF. -1 means an error occurred and no bytes -were read. -@end deftypefun - -@deftypefun int Lstream_write (Lstream *@var{stream}, void *@var{data}, int @var{size}) -Write @var{size} bytes of @var{data} to the stream. Return the number -of bytes written. -1 means an error occurred and no bytes were written. -@end deftypefun - -@deftypefun void Lstream_unread (Lstream *@var{stream}, void *@var{data}, int @var{size}) -Push back @var{size} bytes of @var{data} onto the input queue. The next -call to @code{Lstream_read()} with the same size will read the same -bytes back. Note that this will be the case even if there is other -pending unread data. -@end deftypefun - -@deftypefun int Lstream_close (Lstream *@var{stream}) -Close the stream. All data will be flushed out. -@end deftypefun - -@deftypefun void Lstream_reopen (Lstream *@var{stream}) -Reopen a closed stream. This enables I/O on it again. This is not -meant to be called except from a wrapper routine that reinitializes -variables and such -- the close routine may well have freed some -necessary storage structures, for example. -@end deftypefun - -@deftypefun void Lstream_rewind (Lstream *@var{stream}) -Rewind the stream to the beginning. -@end deftypefun - -@node Lstream Methods -@section Lstream Methods - -@deftypefn {Lstream Method} int reader (Lstream *@var{stream}, unsigned char *@var{data}, int @var{size}) -Read some data from the stream's end and store it into @var{data}, which -can hold @var{size} bytes. Return the number of bytes read. A return -value of 0 means no bytes can be read at this time. This may be because -of an EOF, or because there is a granularity greater than one byte that -the stream imposes on the returned data, and @var{size} is less than -this granularity. (This will happen frequently for streams that need to -return whole characters, because @code{Lstream_read()} calls the reader -function repeatedly until it has the number of bytes it wants or until 0 -is returned.) The lstream functions do not treat a 0 return as EOF or -do anything special; however, the calling function will interpret any 0 -it gets back as EOF. This will normally not happen unless the caller -calls @code{Lstream_read()} with a very small size. - -This function can be @code{NULL} if the stream is output-only. -@end deftypefn - -@deftypefn {Lstream Method} int writer (Lstream *@var{stream}, CONST unsigned char *@var{data}, int @var{size}) -Send some data to the stream's end. Data to be sent is in @var{data} -and is @var{size} bytes. Return the number of bytes sent. This -function can send and return fewer bytes than is passed in; in that -case, the function will just be called again until there is no data left -or 0 is returned. A return value of 0 means that no more data can be -currently stored, but there is no error; the data will be squirreled -away until the writer can accept data. (This is useful, e.g., if you're -dealing with a non-blocking file descriptor and are getting -@code{EWOULDBLOCK} errors.) This function can be @code{NULL} if the -stream is input-only. -@end deftypefn - -@deftypefn {Lstream Method} int rewinder (Lstream *@var{stream}) -Rewind the stream. If this is @code{NULL}, the stream is not seekable. -@end deftypefn - -@deftypefn {Lstream Method} int seekable_p (Lstream *@var{stream}) -Indicate whether this stream is seekable -- i.e. it can be rewound. -This method is ignored if the stream does not have a rewind method. If -this method is not present, the result is determined by whether a rewind -method is present. -@end deftypefn - -@deftypefn {Lstream Method} int flusher (Lstream *@var{stream}) -Perform any additional operations necessary to flush the data in this -stream. -@end deftypefn - -@deftypefn {Lstream Method} int pseudo_closer (Lstream *@var{stream}) -@end deftypefn - -@deftypefn {Lstream Method} int closer (Lstream *@var{stream}) -Perform any additional operations necessary to close this stream down. -May be @code{NULL}. This function is called when @code{Lstream_close()} -is called or when the stream is garbage-collected. When this function -is called, all pending data in the stream will already have been written -out. -@end deftypefn - -@deftypefn {Lstream Method} Lisp_Object marker (Lisp_Object @var{lstream}, void (*@var{markfun}) (Lisp_Object)) -Mark this object for garbage collection. Same semantics as a standard -@code{Lisp_Object} marker. This function can be @code{NULL}. -@end deftypefn - -@node Consoles; Devices; Frames; Windows, The Redisplay Mechanism, Lstreams, Top -@chapter Consoles; Devices; Frames; Windows - -@menu -* Introduction to Consoles; Devices; Frames; Windows:: -* Point:: -* Window Hierarchy:: -* The Window Object:: -@end menu - -@node Introduction to Consoles; Devices; Frames; Windows -@section Introduction to Consoles; Devices; Frames; Windows - -A window-system window that you see on the screen is called a -@dfn{frame} in Emacs terminology. Each frame is subdivided into one or -more non-overlapping panes, called (confusingly) @dfn{windows}. Each -window displays the text of a buffer in it. (See above on Buffers.) Note -that buffers and windows are independent entities: Two or more windows -can be displaying the same buffer (potentially in different locations), -and a buffer can be displayed in no windows. - - A single display screen that contains one or more frames is called -a @dfn{display}. Under most circumstances, there is only one display. -However, more than one display can exist, for example if you have -a @dfn{multi-headed} console, i.e. one with a single keyboard but -multiple displays. (Typically in such a situation, the various -displays act like one large display, in that the mouse is only -in one of them at a time, and moving the mouse off of one moves -it into another.) In some cases, the different displays will -have different characteristics, e.g. one color and one mono. - - XEmacs can display frames on multiple displays. It can even deal -simultaneously with frames on multiple keyboards (called @dfn{consoles} in -XEmacs terminology). Here is one case where this might be useful: You -are using XEmacs on your workstation at work, and leave it running. -Then you go home and dial in on a TTY line, and you can use the -already-running XEmacs process to display another frame on your local -TTY. - - Thus, there is a hierarchy console -> display -> frame -> window. -There is a separate Lisp object type for each of these four concepts. -Furthermore, there is logically a @dfn{selected console}, -@dfn{selected display}, @dfn{selected frame}, and @dfn{selected window}. -Each of these objects is distinguished in various ways, such as being the -default object for various functions that act on objects of that type. -Note that every containing object rememembers the ``selected'' object -among the objects that it contains: e.g. not only is there a selected -window, but every frame remembers the last window in it that was -selected, and changing the selected frame causes the remembered window -within it to become the selected window. Similar relationships apply -for consoles to devices and devices to frames. - -@node Point -@section Point - - Recall that every buffer has a current insertion position, called -@dfn{point}. Now, two or more windows may be displaying the same buffer, -and the text cursor in the two windows (i.e. @code{point}) can be in -two different places. You may ask, how can that be, since each -buffer has only one value of @code{point}? The answer is that each window -also has a value of @code{point} that is squirreled away in it. There -is only one selected window, and the value of ``point'' in that buffer -corresponds to that window. When the selected window is changed -from one window to another displaying the same buffer, the old -value of @code{point} is stored into the old window's ``point'' and the -value of @code{point} from the new window is retrieved and made the -value of @code{point} in the buffer. This means that @code{window-point} -for the selected window is potentially inaccurate, and if you -want to retrieve the correct value of @code{point} for a window, -you must special-case on the selected window and retrieve the -buffer's point instead. This is related to why @code{save-window-excursion} -does not save the selected window's value of @code{point}. - -@node Window Hierarchy -@section Window Hierarchy -@cindex window hierarchy -@cindex hierarchy of windows - - If a frame contains multiple windows (panes), they are always created -by splitting an existing window along the horizontal or vertical axis. -Terminology is a bit confusing here: to @dfn{split a window -horizontally} means to create two side-by-side windows, i.e. to make a -@emph{vertical} cut in a window. Likewise, to @dfn{split a window -vertically} means to create two windows, one above the other, by making -a @emph{horizontal} cut. - - If you split a window and then split again along the same axis, you -will end up with a number of panes all arranged along the same axis. -The precise way in which the splits were made should not be important, -and this is reflected internally. Internally, all windows are arranged -in a tree, consisting of two types of windows, @dfn{combination} windows -(which have children, and are covered completely by those children) and -@dfn{leaf} windows, which have no children and are visible. Every -combination window has two or more children, all arranged along the same -axis. There are (logically) two subtypes of windows, depending on -whether their children are horizontally or vertically arrayed. There is -always one root window, which is either a leaf window (if the frame -contains only one window) or a combination window (if the frame contains -more than one window). In the latter case, the root window will have -two or more children, either horizontally or vertically arrayed, and -each of those children will be either a leaf window or another -combination window. - - Here are some rules: - -@enumerate -@item -Horizontal combination windows can never have children that are -horizontal combination windows; same for vertical. - -@item -Only leaf windows can be split (obviously) and this splitting does one -of two things: (a) turns the leaf window into a combination window and -creates two new leaf children, or (b) turns the leaf window into one of -the two new leaves and creates the other leaf. Rule (1) dictates which -of these two outcomes happens. - -@item -Every combination window must have at least two children. - -@item -Leaf windows can never become combination windows. They can be deleted, -however. If this results in a violation of (3), the parent combination -window also gets deleted. - -@item -All functions that accept windows must be prepared to accept combination -windows, and do something sane (e.g. signal an error if so). -Combination windows @emph{do} escape to the Lisp level. - -@item -All windows have three fields governing their contents: -these are @dfn{hchild} (a list of horizontally-arrayed children), -@dfn{vchild} (a list of vertically-arrayed children), and @dfn{buffer} -(the buffer contained in a leaf window). Exactly one of -these will be non-nil. Remember that @dfn{horizontally-arrayed} -means ``side-by-side'' and @dfn{vertically-arrayed} means -@dfn{one above the other}. - -@item -Leaf windows also have markers in their @code{start} (the -first buffer position displayed in the window) and @code{pointm} -(the window's stashed value of @code{point} -- see above) fields, -while combination windows have nil in these fields. - -@item -The list of children for a window is threaded through the -@code{next} and @code{prev} fields of each child window. - -@item -@strong{Deleted windows can be undeleted}. This happens as a result of -restoring a window configuration, and is unlike frames, displays, and -consoles, which, once deleted, can never be restored. Deleting a window -does nothing except set a special @code{dead} bit to 1 and clear out the -@code{next}, @code{prev}, @code{hchild}, and @code{vchild} fields, for -GC purposes. - -@item -Most frames actually have two top-level windows -- one for the -minibuffer and one (the @dfn{root}) for everything else. The modeline -(if present) separates these two. The @code{next} field of the root -points to the minibuffer, and the @code{prev} field of the minibuffer -points to the root. The other @code{next} and @code{prev} fields are -@code{nil}, and the frame points to both of these windows. -Minibuffer-less frames have no minibuffer window, and the @code{next} -and @code{prev} of the root window are @code{nil}. Minibuffer-only -frames have no root window, and the @code{next} of the minibuffer window -is @code{nil} but the @code{prev} points to itself. (#### This is an -artifact that should be fixed.) -@end enumerate - -@node The Window Object -@section The Window Object - - Windows have the following accessible fields: - -@table @code -@item frame -The frame that this window is on. - -@item mini_p -Non-@code{nil} if this window is a minibuffer window. - -@item buffer -The buffer that the window is displaying. This may change often during -the life of the window. - -@item dedicated -Non-@code{nil} if this window is dedicated to its buffer. - -@item pointm -@cindex window point internals -This is the value of point in the current buffer when this window is -selected; when it is not selected, it retains its previous value. - -@item start -The position in the buffer that is the first character to be displayed -in the window. - -@item force_start -If this flag is non-@code{nil}, it says that the window has been -scrolled explicitly by the Lisp program. This affects what the next -redisplay does if point is off the screen: instead of scrolling the -window to show the text around point, it moves point to a location that -is on the screen. - -@item last_modified -The @code{modified} field of the window's buffer, as of the last time -a redisplay completed in this window. - -@item last_point -The buffer's value of point, as of the last time -a redisplay completed in this window. - -@item left -This is the left-hand edge of the window, measured in columns. (The -leftmost column on the screen is @w{column 0}.) - -@item top -This is the top edge of the window, measured in lines. (The top line on -the screen is @w{line 0}.) - -@item height -The height of the window, measured in lines. - -@item width -The width of the window, measured in columns. - -@item next -This is the window that is the next in the chain of siblings. It is -@code{nil} in a window that is the rightmost or bottommost of a group of -siblings. - -@item prev -This is the window that is the previous in the chain of siblings. It is -@code{nil} in a window that is the leftmost or topmost of a group of -siblings. - -@item parent -Internally, XEmacs arranges windows in a tree; each group of siblings has -a parent window whose area includes all the siblings. This field points -to a window's parent. - -Parent windows do not display buffers, and play little role in display -except to shape their child windows. Emacs Lisp programs usually have -no access to the parent windows; they operate on the windows at the -leaves of the tree, which actually display buffers. - -@item hscroll -This is the number of columns that the display in the window is scrolled -horizontally to the left. Normally, this is 0. - -@item use_time -This is the last time that the window was selected. The function -@code{get-lru-window} uses this field. - -@item display_table -The window's display table, or @code{nil} if none is specified for it. - -@item update_mode_line -Non-@code{nil} means this window's mode line needs to be updated. - -@item base_line_number -The line number of a certain position in the buffer, or @code{nil}. -This is used for displaying the line number of point in the mode line. - -@item base_line_pos -The position in the buffer for which the line number is known, or -@code{nil} meaning none is known. - -@item region_showing -If the region (or part of it) is highlighted in this window, this field -holds the mark position that made one end of that region. Otherwise, -this field is @code{nil}. -@end table - -@node The Redisplay Mechanism, Extents, Consoles; Devices; Frames; Windows, Top -@chapter The Redisplay Mechanism - - The redisplay mechanism is one of the most complicated sections of -XEmacs, especially from a conceptual standpoint. This is doubly so -because, unlike for the basic aspects of the Lisp interpreter, the -computer science theories of how to efficiently handle redisplay are not -well-developed. - - When working with the redisplay mechanism, remember the Golden Rules -of Redisplay: - -@enumerate -@item -It Is Better To Be Correct Than Fast. -@item -Thou Shalt Not Run Elisp From Within Redisplay. -@item -It Is Better To Be Fast Than Not To Be. -@end enumerate - -@menu -* Critical Redisplay Sections:: -* Line Start Cache:: -@end menu - -@node Critical Redisplay Sections -@section Critical Redisplay Sections -@cindex critical redisplay sections - -Within this section, we are defenseless and assume that the -following cannot happen: - -@enumerate -@item -garbage collection -@item -Lisp code evaluation -@item -frame size changes -@end enumerate - -We ensure (3) by calling @code{hold_frame_size_changes()}, which -will cause any pending frame size changes to get put on hold -till after the end of the critical section. (1) follows -automatically if (2) is met. #### Unfortunately, there are -some places where Lisp code can be called within this section. -We need to remove them. - -If @code{Fsignal()} is called during this critical section, we -will @code{abort()}. - -If garbage collection is called during this critical section, -we simply return. #### We should abort instead. - -#### If a frame-size change does occur we should probably -actually be preempting redisplay. - -@node Line Start Cache -@section Line Start Cache -@cindex line start cache - - The traditional scrolling code in Emacs breaks in a variable height -world. It depends on the key assumption that the number of lines that -can be displayed at any given time is fixed. This led to a complete -separation of the scrolling code from the redisplay code. In order to -fully support variable height lines, the scrolling code must actually be -tightly integrated with redisplay. Only redisplay can determine how -many lines will be displayed on a screen for any given starting point. - - What is ideally wanted is a complete list of the starting buffer -position for every possible display line of a buffer along with the -height of that display line. Maintaining such a full list would be very -expensive. We settle for having it include information for all areas -which we happen to generate anyhow (i.e. the region currently being -displayed) and for those areas we need to work with. - - In order to ensure that the cache accurately represents what redisplay -would actually show, it is necessary to invalidate it in many -situations. If the buffer changes, the starting positions may no longer -be correct. If a face or an extent has changed then the line heights -may have altered. These events happen frequently enough that the cache -can end up being constantly disabled. With this potentially constant -invalidation when is the cache ever useful? - - Even if the cache is invalidated before every single usage, it is -necessary. Scrolling often requires knowledge about display lines which -are actually above or below the visible region. The cache provides a -convenient light-weight method of storing this information for multiple -display regions. This knowledge is necessary for the scrolling code to -always obey the First Golden Rule of Redisplay. - - If the cache already contains all of the information that the scrolling -routines happen to need so that it doesn't have to go generate it, then -we are able to obey the Third Golden Rule of Redisplay. The first thing -we do to help out the cache is to always add the displayed region. This -region had to be generated anyway, so the cache ends up getting the -information basically for free. In those cases where a user is simply -scrolling around viewing a buffer there is a high probability that this -is sufficient to always provide the needed information. The second -thing we can do is be smart about invalidating the cache. - - TODO -- Be smart about invalidating the cache. Potential places: - -@itemize @bullet -@item -Insertions at end-of-line which don't cause line-wraps do not alter the -starting positions of any display lines. These types of buffer -modifications should not invalidate the cache. This is actually a large -optimization for redisplay speed as well. -@item -Buffer modifications frequently only affect the display of lines at and -below where they occur. In these situations we should only invalidate -the part of the cache starting at where the modification occurs. -@end itemize - - In case you're wondering, the Second Golden Rule of Redisplay is not -applicable. - -@node Extents, Faces and Glyphs, The Redisplay Mechanism, Top -@chapter Extents - -@menu -* Introduction to Extents:: Extents are ranges over text, with properties. -* Extent Ordering:: How extents are ordered internally. -* Format of the Extent Info:: The extent information in a buffer or string. -* Zero-Length Extents:: A weird special case. -* Mathematics of Extent Ordering:: A rigorous foundation. -* Extent Fragments:: Cached information useful for redisplay. -@end menu - -@node Introduction to Extents -@section Introduction to Extents - - Extents are regions over a buffer, with a start and an end position -denoting the region of the buffer included in the extent. In -addition, either end can be closed or open, meaning that the endpoint -is or is not logically included in the extent. Insertion of a character -at a closed endpoint causes the character to go inside the extent; -insertion at an open endpoint causes the character to go outside. - - Extent endpoints are stored using memory indices (see @file{insdel.c}), -to minimize the amount of adjusting that needs to be done when -characters are inserted or deleted. - - (Formerly, extent endpoints at the gap could be either before or -after the gap, depending on the open/closedness of the endpoint. -The intent of this was to make it so that insertions would -automatically go inside or out of extents as necessary with no -further work needing to be done. It didn't work out that way, -however, and just ended up complexifying and buggifying all the -rest of the code.) - -@node Extent Ordering -@section Extent Ordering - - Extents are compared using memory indices. There are two orderings -for extents and both orders are kept current at all times. The normal -or @dfn{display} order is as follows: - -@example -Extent A is ``less than'' extent B, -that is, earlier in the display order, - if: A-start < B-start, - or if: A-start = B-start, and A-end > B-end -@end example - - So if two extents begin at the same position, the larger of them is the -earlier one in the display order (@code{EXTENT_LESS} is true). - - For the e-order, the same thing holds: - -@example -Extent A is ``less than'' extent B in e-order, -that is, later in the buffer, - if: A-end < B-end, - or if: A-end = B-end, and A-start > B-start -@end example - - So if two extents end at the same position, the smaller of them is the -earlier one in the e-order (@code{EXTENT_E_LESS} is true). - - The display order and the e-order are complementary orders: any -theorem about the display order also applies to the e-order if you swap -all occurrences of ``display order'' and ``e-order'', ``less than'' and -``greater than'', and ``extent start'' and ``extent end''. - -@node Format of the Extent Info -@section Format of the Extent Info - - An extent-info structure consists of a list of the buffer or string's -extents and a @dfn{stack of extents} that lists all of the extents over -a particular position. The stack-of-extents info is used for -optimization purposes -- it basically caches some info that might -be expensive to compute. Certain otherwise hard computations are easy -given the stack of extents over a particular position, and if the -stack of extents over a nearby position is known (because it was -calculated at some prior point in time), it's easy to move the stack -of extents to the proper position. - - Given that the stack of extents is an optimization, and given that -it requires memory, a string's stack of extents is wiped out each -time a garbage collection occurs. Therefore, any time you retrieve -the stack of extents, it might not be there. If you need it to -be there, use the @code{_force} version. - - Similarly, a string may or may not have an extent_info structure. -(Generally it won't if there haven't been any extents added to the -string.) So use the @code{_force} version if you need the extent_info -structure to be there. - - A list of extents is maintained as a double gap array: one gap array -is ordered by start index (the @dfn{display order}) and the other is -ordered by end index (the @dfn{e-order}). Note that positions in an -extent list should logically be conceived of as referring @emph{to} a -particular extent (as is the norm in programs) rather than sitting -between two extents. Note also that callers of these functions should -not be aware of the fact that the extent list is implemented as an -array, except for the fact that positions are integers (this should be -generalized to handle integers and linked list equally well). - -@node Zero-Length Extents -@section Zero-Length Extents - - Extents can be zero-length, and will end up that way if their endpoints -are explicitly set that way or if their detachable property is nil -and all the text in the extent is deleted. (The exception is open-open -zero-length extents, which are barred from existing because there is -no sensible way to define their properties. Deletion of the text in -an open-open extent causes it to be converted into a closed-open -extent.) Zero-length extents are primarily used to represent -annotations, and behave as follows: - -@enumerate -@item -Insertion at the position of a zero-length extent expands the extent -if both endpoints are closed; goes after the extent if it is closed-open; -and goes before the extent if it is open-closed. - -@item -Deletion of a character on a side of a zero-length extent whose -corresponding endpoint is closed causes the extent to be detached if -it is detachable; if the extent is not detachable or the corresponding -endpoint is open, the extent remains in the buffer, moving as necessary. -@end enumerate - - Note that closed-open, non-detachable zero-length extents behave -exactly like markers and that open-closed, non-detachable zero-length -extents behave like the ``point-type'' marker in Mule. - -@node Mathematics of Extent Ordering -@section Mathematics of Extent Ordering -@cindex extent mathematics -@cindex mathematics of extents -@cindex extent ordering - -@cindex display order of extents -@cindex extents, display order - The extents in a buffer are ordered by ``display order'' because that -is that order that the redisplay mechanism needs to process them in. -The e-order is an auxiliary ordering used to facilitate operations -over extents. The operations that can be performed on the ordered -list of extents in a buffer are - -@enumerate -@item -Locate where an extent would go if inserted into the list. -@item -Insert an extent into the list. -@item -Remove an extent from the list. -@item -Map over all the extents that overlap a range. -@end enumerate - - (4) requires being able to determine the first and last extents -that overlap a range. - - NOTE: @dfn{overlap} is used as follows: - -@itemize @bullet -@item -two ranges overlap if they have at least one point in common. -Whether the endpoints are open or closed makes a difference here. -@item -a point overlaps a range if the point is contained within the -range; this is equivalent to treating a point @math{P} as the range -@math{[P, P]}. -@item -In the case of an @emph{extent} overlapping a point or range, the extent -is normally treated as having closed endpoints. This applies -consistently in the discussion of stacks of extents and such below. -Note that this definition of overlap is not necessarily consistent with -the extents that @code{map-extents} maps over, since @code{map-extents} -sometimes pays attention to whether the endpoints of an extents are open -or closed. But for our purposes, it greatly simplifies things to treat -all extents as having closed endpoints. -@end itemize - -First, define @math{>}, @math{<}, @math{<=}, etc. as applied to extents -to mean comparison according to the display order. Comparison between -an extent @math{E} and an index @math{I} means comparison between -@math{E} and the range @math{[I, I]}. - -Also define @math{e>}, @math{e<}, @math{e<=}, etc. to mean comparison -according to the e-order. - -For any range @math{R}, define @math{R(0)} to be the starting index of -the range and @math{R(1)} to be the ending index of the range. - -For any extent @math{E}, define @math{E(next)} to be the extent directly -following @math{E}, and @math{E(prev)} to be the extent directly -preceding @math{E}. Assume @math{E(next)} and @math{E(prev)} can be -determined from @math{E} in constant time. (This is because we store -the extent list as a doubly linked list.) - -Similarly, define @math{E(e-next)} and @math{E(e-prev)} to be the -extents directly following and preceding @math{E} in the e-order. - -Now: - -Let @math{R} be a range. -Let @math{F} be the first extent overlapping @math{R}. -Let @math{L} be the last extent overlapping @math{R}. - -Theorem 1: @math{R(1)} lies between @math{L} and @math{L(next)}, -i.e. @math{L <= R(1) < L(next)}. - - This follows easily from the definition of display order. The -basic reason that this theorem applies is that the display order -sorts by increasing starting index. - - Therefore, we can determine @math{L} just by looking at where we would -insert @math{R(1)} into the list, and if we know @math{F} and are moving -forward over extents, we can easily determine when we've hit @math{L} by -comparing the extent we're at to @math{R(1)}. - -@example -Theorem 2: @math{F(e-prev) e< [1, R(0)] e<= F}. -@end example - - This is the analog of Theorem 1, and applies because the e-order -sorts by increasing ending index. - - Therefore, @math{F} can be found in the same amount of time as -operation (1), i.e. the time that it takes to locate where an extent -would go if inserted into the e-order list. - - If the lists were stored as balanced binary trees, then operation (1) -would take logarithmic time, which is usually quite fast. However, -currently they're stored as simple doubly-linked lists, and instead we -do some caching to try to speed things up. - - Define a @dfn{stack of extents} (or @dfn{SOE}) as the set of extents -(ordered in the display order) that overlap an index @math{I}, together -with the SOE's @dfn{previous} extent, which is an extent that precedes -@math{I} in the e-order. (Hopefully there will not be very many extents -between @math{I} and the previous extent.) - -Now: - -Let @math{I} be an index, let @math{S} be the stack of extents on -@math{I}, let @math{F} be the first extent in @math{S}, and let @math{P} -be @math{S}'s previous extent. - -Theorem 3: The first extent in @math{S} is the first extent that overlaps -any range @math{[I, J]}. - -Proof: Any extent that overlaps @math{[I, J]} but does not include -@math{I} must have a start index @math{> I}, and thus be greater than -any extent in @math{S}. - -Therefore, finding the first extent that overlaps a range @math{R} is -the same as finding the first extent that overlaps @math{R(0)}. - -Theorem 4: Let @math{I2} be an index such that @math{I2 > I}, and let -@math{F2} be the first extent that overlaps @math{I2}. Then, either -@math{F2} is in @math{S} or @math{F2} is greater than any extent in -@math{S}. - -Proof: If @math{F2} does not include @math{I} then its start index is -greater than @math{I} and thus it is greater than any extent in -@math{S}, including @math{F}. Otherwise, @math{F2} includes @math{I} -and thus is in @math{S}, and thus @math{F2 >= F}. - -@node Extent Fragments -@section Extent Fragments -@cindex extent fragment - - Imagine that the buffer is divided up into contiguous, non-overlapping -@dfn{runs} of text such that no extent starts or ends within a run -(extents that abut the run don't count). - - An extent fragment is a structure that holds data about the run that -contains a particular buffer position (if the buffer position is at the -junction of two runs, the run after the position is used) -- the -beginning and end of the run, a list of all of the extents in that run, -the @dfn{merged face} that results from merging all of the faces -corresponding to those extents, the begin and end glyphs at the -beginning of the run, etc. This is the information that redisplay needs -in order to display this run. - - Extent fragments have to be very quick to update to a new buffer -position when moving linearly through the buffer. They rely on the -stack-of-extents code, which does the heavy-duty algorithmic work of -determining which extents overly a particular position. - -@node Faces and Glyphs, Specifiers, Extents, Top -@chapter Faces and Glyphs - -Not yet documented. - -@node Specifiers, Menus, Faces and Glyphs, Top -@chapter Specifiers - -Not yet documented. - -@node Menus, Subprocesses, Specifiers, Top -@chapter Menus - - A menu is set by setting the value of the variable -@code{current-menubar} (which may be buffer-local) and then calling -@code{set-menubar-dirty-flag} to signal a change. This will cause the -menu to be redrawn at the next redisplay. The format of the data in -@code{current-menubar} is described in @file{menubar.c}. - - Internally the data in current-menubar is parsed into a tree of -@code{widget_value's} (defined in @file{lwlib.h}); this is accomplished -by the recursive function @code{menu_item_descriptor_to_widget_value()}, -called by @code{compute_menubar_data()}. Such a tree is deallocated -using @code{free_widget_value()}. - - @code{update_screen_menubars()} is one of the external entry points. -This checks to see, for each screen, if that screen's menubar needs to -be updated. This is the case if - -@enumerate -@item -@code{set-menubar-dirty-flag} was called since the last redisplay. (This -function sets the C variable menubar_has_changed.) -@item -The buffer displayed in the screen has changed. -@item -The screen has no menubar currently displayed. -@end enumerate - - @code{set_screen_menubar()} is called for each such screen. This -function calls @code{compute_menubar_data()} to create the tree of -widget_value's, then calls @code{lw_create_widget()}, -@code{lw_modify_all_widgets()}, and/or @code{lw_destroy_all_widgets()} -to create the X-Toolkit widget associated with the menu. - - @code{update_psheets()}, the other external entry point, actually -changes the menus being displayed. It uses the widgets fixed by -@code{update_screen_menubars()} and calls various X functions to ensure -that the menus are displayed properly. - - The menubar widget is set up so that @code{pre_activate_callback()} is -called when the menu is first selected (i.e. mouse button goes down), -and @code{menubar_selection_callback()} is called when an item is -selected. @code{pre_activate_callback()} calls the function in -activate-menubar-hook, which can change the menubar (this is described -in @file{menubar.c}). If the menubar is changed, -@code{set_screen_menubars()} is called. -@code{menubar_selection_callback()} enqueues a menu event, putting in it -a function to call (either @code{eval} or @code{call-interactively}) and -its argument, which is the callback function or form given in the menu's -description. - -@node Subprocesses, Interface to X Windows, Menus, Top -@chapter Subprocesses - - The fields of a process are: - -@table @code -@item name -A string, the name of the process. - -@item command -A list containing the command arguments that were used to start this -process. - -@item filter -A function used to accept output from the process instead of a buffer, -or @code{nil}. - -@item sentinel -A function called whenever the process receives a signal, or @code{nil}. - -@item buffer -The associated buffer of the process. - -@item pid -An integer, the Unix process @sc{id}. - -@item childp -A flag, non-@code{nil} if this is really a child process. -It is @code{nil} for a network connection. - -@item mark -A marker indicating the position of the end of the last output from this -process inserted into the buffer. This is often but not always the end -of the buffer. - -@item kill_without_query -If this is non-@code{nil}, killing XEmacs while this process is still -running does not ask for confirmation about killing the process. - -@item raw_status_low -@itemx raw_status_high -These two fields record 16 bits each of the process status returned by -the @code{wait} system call. - -@item status -The process status, as @code{process-status} should return it. - -@item tick -@itemx update_tick -If these two fields are not equal, a change in the status of the process -needs to be reported, either by running the sentinel or by inserting a -message in the process buffer. - -@item pty_flag -Non-@code{nil} if communication with the subprocess uses a @sc{pty}; -@code{nil} if it uses a pipe. - -@item infd -The file descriptor for input from the process. - -@item outfd -The file descriptor for output to the process. - -@item subtty -The file descriptor for the terminal that the subprocess is using. (On -some systems, there is no need to record this, so the value is -@code{-1}.) - -@item tty_name -The name of the terminal that the subprocess is using, -or @code{nil} if it is using pipes. -@end table - -@node Interface to X Windows, Index, Subprocesses, Top -@chapter Interface to X Windows - -Not yet documented. - -@include index.texi - -@c Print the tables of contents -@summarycontents -@contents -@c That's all - -@bye - diff --git a/man/lispref/abbrevs.texi b/man/lispref/abbrevs.texi deleted file mode 100644 index c59e84c..0000000 --- a/man/lispref/abbrevs.texi +++ /dev/null @@ -1,340 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/abbrevs.info -@node Abbrevs, Extents, Syntax Tables, Top -@chapter Abbrevs And Abbrev Expansion -@cindex abbrev -@cindex abbrev table - - An abbreviation or @dfn{abbrev} is a string of characters that may be -expanded to a longer string. The user can insert the abbrev string and -find it replaced automatically with the expansion of the abbrev. This -saves typing. - - The set of abbrevs currently in effect is recorded in an @dfn{abbrev -table}. Each buffer has a local abbrev table, but normally all buffers -in the same major mode share one abbrev table. There is also a global -abbrev table. Normally both are used. - - An abbrev table is represented as an obarray containing a symbol for -each abbreviation. The symbol's name is the abbreviation; its value is -the expansion; its function definition is the hook function to do the -expansion (@pxref{Defining Abbrevs}); its property list cell contains -the use count, the number of times the abbreviation has been expanded. -Because these symbols are not interned in the usual obarray, they will -never appear as the result of reading a Lisp expression; in fact, -normally they are never used except by the code that handles abbrevs. -Therefore, it is safe to use them in an extremely nonstandard way. -@xref{Creating Symbols}. - - For the user-level commands for abbrevs, see @ref{Abbrevs,, Abbrev -Mode, emacs, The XEmacs Reference Manual}. - -@menu -* Abbrev Mode:: Setting up XEmacs for abbreviation. -* Tables: Abbrev Tables. Creating and working with abbrev tables. -* Defining Abbrevs:: Specifying abbreviations and their expansions. -* Files: Abbrev Files. Saving abbrevs in files. -* Expansion: Abbrev Expansion. Controlling expansion; expansion subroutines. -* Standard Abbrev Tables:: Abbrev tables used by various major modes. -@end menu - -@node Abbrev Mode -@section Setting Up Abbrev Mode - - Abbrev mode is a minor mode controlled by the value of the variable -@code{abbrev-mode}. - -@defvar abbrev-mode -A non-@code{nil} value of this variable turns on the automatic expansion -of abbrevs when their abbreviations are inserted into a buffer. -If the value is @code{nil}, abbrevs may be defined, but they are not -expanded automatically. - -This variable automatically becomes local when set in any fashion. -@end defvar - -@defvar default-abbrev-mode -This is the value of @code{abbrev-mode} for buffers that do not override it. -This is the same as @code{(default-value 'abbrev-mode)}. -@end defvar - -@node Abbrev Tables -@section Abbrev Tables - - This section describes how to create and manipulate abbrev tables. - -@defun make-abbrev-table -This function creates and returns a new, empty abbrev table---an obarray -containing no symbols. It is a vector filled with zeros. -@end defun - -@defun clear-abbrev-table table -This function undefines all the abbrevs in abbrev table @var{table}, -leaving it empty. The function returns @code{nil}. -@end defun - -@defun define-abbrev-table tabname definitions -This function defines @var{tabname} (a symbol) as an abbrev table name, -i.e., as a variable whose value is an abbrev table. It defines abbrevs -in the table according to @var{definitions}, a list of elements of the -form @code{(@var{abbrevname} @var{expansion} @var{hook} -@var{usecount})}. The value is always @code{nil}. -@end defun - -@defvar abbrev-table-name-list -This is a list of symbols whose values are abbrev tables. -@code{define-abbrev-table} adds the new abbrev table name to this list. -@end defvar - -@defun insert-abbrev-table-description name &optional human -This function inserts before point a description of the abbrev table -named @var{name}. The argument @var{name} is a symbol whose value is an -abbrev table. The value is always @code{nil}. - -If @var{human} is non-@code{nil}, the description is human-oriented. -Otherwise the description is a Lisp expression---a call to -@code{define-abbrev-table} that would define @var{name} exactly as it -is currently defined. -@end defun - -@node Defining Abbrevs -@section Defining Abbrevs - - These functions define an abbrev in a specified abbrev table. -@code{define-abbrev} is the low-level basic function, while -@code{add-abbrev} is used by commands that ask for information from the -user. - -@defun add-abbrev table type arg -This function adds an abbreviation to abbrev table @var{table} based on -information from the user. The argument @var{type} is a string -describing in English the kind of abbrev this will be (typically, -@code{"global"} or @code{"mode-specific"}); this is used in prompting -the user. The argument @var{arg} is the number of words in the -expansion. - -The return value is the symbol that internally represents the new -abbrev, or @code{nil} if the user declines to confirm redefining an -existing abbrev. -@end defun - -@defun define-abbrev table name expansion hook -This function defines an abbrev in @var{table} named @var{name}, to -expand to @var{expansion}, and call @var{hook}. The return value is an -uninterned symbol that represents the abbrev inside XEmacs; its name is -@var{name}. - -The argument @var{name} should be a string. The argument -@var{expansion} should be a string, or @code{nil} to undefine the -abbrev. - -The argument @var{hook} is a function or @code{nil}. If @var{hook} is -non-@code{nil}, then it is called with no arguments after the abbrev is -replaced with @var{expansion}; point is located at the end of -@var{expansion} when @var{hook} is called. - -The use count of the abbrev is initialized to zero. -@end defun - -@defopt only-global-abbrevs -If this variable is non-@code{nil}, it means that the user plans to use -global abbrevs only. This tells the commands that define mode-specific -abbrevs to define global ones instead. This variable does not alter the -behavior of the functions in this section; it is examined by their -callers. -@end defopt - -@node Abbrev Files -@section Saving Abbrevs in Files - - A file of saved abbrev definitions is actually a file of Lisp code. -The abbrevs are saved in the form of a Lisp program to define the same -abbrev tables with the same contents. Therefore, you can load the file -with @code{load} (@pxref{How Programs Do Loading}). However, the -function @code{quietly-read-abbrev-file} is provided as a more -convenient interface. - - User-level facilities such as @code{save-some-buffers} can save -abbrevs in a file automatically, under the control of variables -described here. - -@defopt abbrev-file-name -This is the default file name for reading and saving abbrevs. -@end defopt - -@defun quietly-read-abbrev-file filename -This function reads abbrev definitions from a file named @var{filename}, -previously written with @code{write-abbrev-file}. If @var{filename} is -@code{nil}, the file specified in @code{abbrev-file-name} is used. -@code{save-abbrevs} is set to @code{t} so that changes will be saved. - -This function does not display any messages. It returns @code{nil}. -@end defun - -@defopt save-abbrevs -A non-@code{nil} value for @code{save-abbrev} means that XEmacs should -save abbrevs when files are saved. @code{abbrev-file-name} specifies -the file to save the abbrevs in. -@end defopt - -@defvar abbrevs-changed -This variable is set non-@code{nil} by defining or altering any -abbrevs. This serves as a flag for various XEmacs commands to offer to -save your abbrevs. -@end defvar - -@deffn Command write-abbrev-file filename -Save all abbrev definitions, in all abbrev tables, in the file -@var{filename}, in the form of a Lisp program that when loaded will -define the same abbrevs. This function returns @code{nil}. -@end deffn - -@node Abbrev Expansion -@section Looking Up and Expanding Abbreviations - - Abbrevs are usually expanded by commands for interactive use, -including @code{self-insert-command}. This section describes the -subroutines used in writing such functions, as well as the variables -they use for communication. - -@defun abbrev-symbol abbrev &optional table -This function returns the symbol representing the abbrev named -@var{abbrev}. The value returned is @code{nil} if that abbrev is not -defined. The optional second argument @var{table} is the abbrev table -to look it up in. If @var{table} is @code{nil}, this function tries -first the current buffer's local abbrev table, and second the global -abbrev table. -@end defun - -@defun abbrev-expansion abbrev &optional table -This function returns the string that @var{abbrev} would expand into (as -defined by the abbrev tables used for the current buffer). The optional -argument @var{table} specifies the abbrev table to use, as in -@code{abbrev-symbol}. -@end defun - -@deffn Command expand-abbrev -This command expands the abbrev before point, if any. -If point does not follow an abbrev, this command does nothing. -The command returns @code{t} if it did expansion, @code{nil} otherwise. -@end deffn - -@deffn Command abbrev-prefix-mark &optional arg -Mark current point as the beginning of an abbrev. The next call to -@code{expand-abbrev} will use the text from here to point (where it is -then) as the abbrev to expand, rather than using the previous word as -usual. -@end deffn - -@defopt abbrev-all-caps -When this is set non-@code{nil}, an abbrev entered entirely in upper -case is expanded using all upper case. Otherwise, an abbrev entered -entirely in upper case is expanded by capitalizing each word of the -expansion. -@end defopt - -@defvar abbrev-start-location -This is the buffer position for @code{expand-abbrev} to use as the start -of the next abbrev to be expanded. (@code{nil} means use the word -before point instead.) @code{abbrev-start-location} is set to -@code{nil} each time @code{expand-abbrev} is called. This variable is -also set by @code{abbrev-prefix-mark}. -@end defvar - -@defvar abbrev-start-location-buffer -The value of this variable is the buffer for which -@code{abbrev-start-location} has been set. Trying to expand an abbrev -in any other buffer clears @code{abbrev-start-location}. This variable -is set by @code{abbrev-prefix-mark}. -@end defvar - -@defvar last-abbrev -This is the @code{abbrev-symbol} of the last abbrev expanded. This -information is left by @code{expand-abbrev} for the sake of the -@code{unexpand-abbrev} command. -@end defvar - -@defvar last-abbrev-location -This is the location of the last abbrev expanded. This contains -information left by @code{expand-abbrev} for the sake of the -@code{unexpand-abbrev} command. -@end defvar - -@defvar last-abbrev-text -This is the exact expansion text of the last abbrev expanded, after case -conversion (if any). Its value is @code{nil} if the abbrev has already -been unexpanded. This contains information left by @code{expand-abbrev} -for the sake of the @code{unexpand-abbrev} command. -@end defvar - -@c Emacs 19 feature -@defvar pre-abbrev-expand-hook -This is a normal hook whose functions are executed, in sequence, just -before any expansion of an abbrev. @xref{Hooks}. Since it is a normal -hook, the hook functions receive no arguments. However, they can find -the abbrev to be expanded by looking in the buffer before point. -@end defvar - - The following sample code shows a simple use of -@code{pre-abbrev-expand-hook}. If the user terminates an abbrev with a -punctuation character, the hook function asks for confirmation. Thus, -this hook allows the user to decide whether to expand the abbrev, and -aborts expansion if it is not confirmed. - -@smallexample -(add-hook 'pre-abbrev-expand-hook 'query-if-not-space) - -;; @r{This is the function invoked by @code{pre-abbrev-expand-hook}.} - -;; @r{If the user terminated the abbrev with a space, the function does} -;; @r{nothing (that is, it returns so that the abbrev can expand). If the} -;; @r{user entered some other character, this function asks whether} -;; @r{expansion should continue.} - -;; @r{If the user answers the prompt with @kbd{y}, the function returns} -;; @r{@code{nil} (because of the @code{not} function), but that is} -;; @r{acceptable; the return value has no effect on expansion.} - -(defun query-if-not-space () - (if (/= ?\ (preceding-char)) - (if (not (y-or-n-p "Do you want to expand this abbrev? ")) - (error "Not expanding this abbrev")))) -@end smallexample - -@node Standard Abbrev Tables -@section Standard Abbrev Tables - - Here we list the variables that hold the abbrev tables for the -preloaded major modes of XEmacs. - -@defvar global-abbrev-table -This is the abbrev table for mode-independent abbrevs. The abbrevs -defined in it apply to all buffers. Each buffer may also have a local -abbrev table, whose abbrev definitions take precedence over those in the -global table. -@end defvar - -@defvar local-abbrev-table -The value of this buffer-local variable is the (mode-specific) -abbreviation table of the current buffer. -@end defvar - -@defvar fundamental-mode-abbrev-table -This is the local abbrev table used in Fundamental mode; in other words, -it is the local abbrev table in all buffers in Fundamental mode. -@end defvar - -@defvar text-mode-abbrev-table -This is the local abbrev table used in Text mode. -@end defvar - -@defvar c-mode-abbrev-table -This is the local abbrev table used in C mode. -@end defvar - -@defvar lisp-mode-abbrev-table -This is the local abbrev table used in Lisp mode and Emacs Lisp mode. -@end defvar diff --git a/man/lispref/annotations.texi b/man/lispref/annotations.texi deleted file mode 100644 index 700375f..0000000 --- a/man/lispref/annotations.texi +++ /dev/null @@ -1,340 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c Copyright (C) 1995 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/annotations.info -@node Annotations, Display, Glyphs, top -@chapter Annotations -@cindex annotation - -An @dfn{annotation} is a pixmap or string that is not part of a buffer's -text but is displayed next to a particular location in a buffer. -Annotations can be displayed intermixed with text, in any whitespace at -the beginning or end of a line, or in a special area at the left or -right side of the frame called a @dfn{margin}, whose size is -controllable. Annotations are implemented using extents -(@pxref{Extents}); but you can work with annotations without knowing how -extents work. - -@menu -* Annotation Basics:: Introduction to annotations. -* Annotation Primitives:: Creating and deleting annotations. -* Annotation Properties:: Retrieving and changing the characteristics - of an annotation. -* Margin Primitives:: Controlling the size of the margins. -* Locating Annotations:: Looking for annotations in a buffer. -* Annotation Hooks:: Hooks called at certain times during an - annotation's lifetime. -@end menu - -@node Annotation Basics -@section Annotation Basics - -@cindex margin -Marginal annotations are notes associated with a particular location in -a buffer. They may be displayed in a margin created on the left-hand or -right-hand side of the frame, in any whitespace at the beginning or end -of a line, or inside of the text itself. Every annotation may have an -associated action to be performed when the annotation is selected. The -term @dfn{annotation} is used to refer to an individual note. The term -@dfn{margin} is generically used to refer to the whitespace before the -first character on a line or after the last character on a line. - -Each annotation has the following characteristics: -@table @var -@item glyph -This is a glyph object and is used as the displayed representation -of the annotation. -@item down-glyph -If given, this glyph is used as the displayed representation -of the annotation when the mouse is pressed down over the annotation. -@item face -The face with which to display the glyph. -@item side -Which side of the text (left or right) the annotation is displayed at. -@item action -If non-@code{nil}, this field must contain a function capable of being -the first argument to @code{funcall}. This function is normally -evaluated with a single argument, the value of the @var{data} field, -each time the annotation is selected. However, if the @var{with-event} -parameter to @code{make-annotation} is non-@code{nil}, the function -is called with two arguments. The first argument is the same as -before, and the second argument is the event (a button-up event, -usually) that activated the annotation. -@item data -Not used internally. This field can contain any E-Lisp object. It is -passed as the first argument to @var{action} described above. -@item menu -A menu displayed when the right mouse button is pressed over the -annotation. -@end table - -@cindex outside margin -@cindex inside margin -The margin is divided into @dfn{outside} and @dfn{inside}. The outside -margin is space on the left or right side of the frame which normal text -cannot be displayed in. The inside margin is that space between the -leftmost or rightmost point at which text can be displayed and where the -first or last character actually is. - -@cindex layout types -There are four different @dfn{layout types} which affect the exact -location an annotation appears. - -@table @code -@item outside-margin -The annotation is placed in the outside margin area. as close as -possible to the edge of the frame. If the outside margin is not wide -enough for an annotation to fit, it is not displayed. - -@item inside-margin -The annotation is placed in the inside margin area, as close as possible -to the edge of the frame. If the inside margin is not wide enough for -the annotation to fit, it will be displayed using any available outside -margin space if and only if the specifier @code{use-left-overflow} or -@code{use-right-overflow} (depending on which side the annotation -appears in) is non-@code{nil}. - -@item whitespace -The annotation is placed in the inside margin area, as close as possible -to the first or last non-whitespace character on a line. If the inside -margin is not wide enough for the annotation to fit, it will be -displayed if and only if the specifier @code{use-left-overflow} or -@code{use-right-overflow} (depending on which side the annotation -appears in) is non-@code{nil}. - -@item text -The annotation is placed at the position it is inserted. It will create -enough space for itself inside of the text area. It does not take up a -place in the logical buffer, only in the display of the buffer. -@end table - -@cindex layout policy -The current layout policy is that all @code{whitespace} annotations are -displayed first. Next, all @code{inside-margin} annotations are -displayed using any remaining space. Finally as many -@code{outside-margin} annotations are displayed as possible. The -@code{text} annotations will always display as they create their own -space to display in. - - -@node Annotation Primitives -@section Annotation Primitives - -@defun make-annotation glyph &optional position layout buffer with-event d-glyph rightp -This function creates a marginal annotation at position @var{pos} in -@var{buffer}. The annotation is displayed using @var{glyph}, which -should be a glyph object or a string, and is positioned using layout -policy @var{layout}. If @var{pos} is @code{nil}, point is used. If -@var{layout} is @code{nil}, @code{whitespace} is used. If @var{buffer} -is @code{nil}, the current buffer is used. - -If @var{with-event} is non-@code{nil}, then when an annotation is -activated, the triggering event is passed as the second arg to the -annotation function. If @var{d-glyph} is non-@code{nil} then it is used -as the glyph that will be displayed when button1 is down. If -@var{rightp} is non-@code{nil} then the glyph will be displayed on the -right side of the buffer instead of the left. - -The newly created annotation is returned. -@end defun - -@defun delete-annotation annotation -This function removes @var{annotation} from its buffer. This does not -modify the buffer text. -@end defun - -@defun annotationp annotation -This function returns @code{t} if @var{annotation} is an annotation, -@code{nil} otherwise. -@end defun - -@node Annotation Properties -@section Annotation Properties - -@defun annotation-glyph annotation -This function returns the glyph object used to display @var{annotation}. -@end defun - -@defun set-annotation-glyph annotation glyph &optional layout side -This function sets the glyph of @var{annotation} to @var{glyph}, which -should be a glyph object. If @var{layout} is non-@code{nil}, set the -layout policy of @var{annotation} to @var{layout}. If @var{side} is -@code{left} or @code{right}, change the side of the buffer at which the -annotation is displayed to the given side. The new value of -@code{annotation-glyph} is returned. -@end defun - -@defun annotation-down-glyph annotation -This function returns the glyph used to display @var{annotation} when -the left mouse button is depressed on the annotation. -@end defun - -@defun set-annotation-down-glyph annotation glyph -This function returns the glyph used to display @var{annotation} when -the left mouse button is depressed on the annotation to @var{glyph}, -which should be a glyph object. -@end defun - -@defun annotation-face annotation -This function returns the face associated with @var{annotation}. -@end defun - -@defun set-annotation-face annotation face -This function sets the face associated with @var{annotation} to -@var{face}. -@end defun - -@defun annotation-layout annotation -This function returns the layout policy of @var{annotation}. -@end defun - -@defun set-annotation-layout annotation layout -This function sets the layout policy of @var{annotation} to -@var{layout}. -@end defun - -@defun annotation-side annotation -This function returns the side of the buffer that @var{annotation} is -displayed on. Return value is a symbol, either @code{left} or -@code{right}. -@end defun - -@defun annotation-data annotation -This function returns the data associated with @var{annotation}. -@end defun - -@defun set-annotation-data annotation data -This function sets the data field of @var{annotation} to @var{data}. -@var{data} is returned. -@end defun - -@defun annotation-action annotation -This function returns the action associated with @var{annotation}. -@end defun - -@defun set-annotation-action annotation action -This function sets the action field of @var{annotation} to @var{action}. -@var{action} is returned.. -@end defun - -@defun annotation-menu annotation -This function returns the menu associated with @var{annotation}. -@end defun - -@defun set-annotation-menu annotation menu -This function sets the menu associated with @var{annotation} to -@var{menu}. This menu will be displayed when the right mouse button is -pressed over the annotation. -@end defun - -@defun annotation-visible annotation -This function returns @code{t} if there is enough available space to -display @var{annotation}, @code{nil} otherwise. -@end defun - -@defun annotation-width annotation -This function returns the width of @var{annotation} in pixels. -@end defun - -@defun hide-annotation annotation -This function removes @var{annotation}'s glyph, making it invisible. -@end defun - -@defun reveal-annotation annotation -This function restores @var{annotation}'s glyph, making it visible. -@end defun - -@node Locating Annotations -@section Locating Annotations - -@defun annotations-in-region start end buffer -This function returns a list of all annotations in @var{buffer} which -are between @var{start} and @var{end} inclusively. -@end defun - -@defun annotations-at &optional position buffer -This function returns a list of all annotations at @var{position} in -@var{buffer}. If @var{position} is @code{nil} point is used. If -@var{buffer} is @code{nil} the current buffer is used. -@end defun - -@defun annotation-list &optional buffer -This function returns a list of all annotations in @var{buffer}. If -@var{buffer} is @code{nil}, the current buffer is used. -@end defun - -@defun all-annotations -This function returns a list of all annotations in all buffers in -existence. -@end defun - -@node Margin Primitives -@section Margin Primitives -@cindex margin width - -The margin widths are controllable on a buffer-local, window-local, -frame-local, device-local, or device-type-local basis through the -use of specifiers. @xref{Specifiers}. - -@defvr Specifier left-margin-width -This is a specifier variable controlling the width of the left outside -margin, in characters. Use @code{set-specifier} to change its value. -@end defvr - -@defvr Specifier right-margin-width -This is a specifier variable controlling the width of the right outside -margin, in characters. Use @code{set-specifier} to change its value. -@end defvr - -@defvr Specifier use-left-overflow -If non-@code{nil}, use the left outside margin as extra whitespace when -displaying @code{whitespace} and @code{inside-margin} annotations. -Defaults to @code{nil}. This is a specifier variable; use -@code{set-specifier} to change its value. -@end defvr - -@defvr Specifier use-right-overflow -If non-@code{nil}, use the right outside margin as extra whitespace when -displaying @code{whitespace} and @code{inside-margin} annotations. -Defaults to @code{nil}. This is a specifier variable; use -@code{set-specifier} to change its value. -@end defvr - -@defun window-left-margin-pixel-width &optional window -This function returns the width in pixels of the left outside margin of -@var{window}. If @var{window} is @code{nil}, the selected window is -assumed. -@end defun - -@defun window-right-margin-pixel-width &optional window -This function returns the width in pixels of the right outside margin of -@var{window}. If @var{window} is @code{nil}, the selected window is -assumed. -@end defun - -The margin colors are controlled by the faces @code{left-margin} and -@code{right-margin}. These can be set using the X resources -@code{Emacs.left-margin.background} and -@code{Emacs.left-margin.foreground}; likewise for the right margin. - - -@node Annotation Hooks -@section Annotation Hooks -@cindex annotation hooks - -The following three hooks are provided for use with the marginal annotations: - -@table @code -@item before-delete-annotation-hook -This hook is called immediately before an annotation is destroyed. It -is passed a single argument, the annotation being destroyed. - -@item after-delete-annotation-hook -This normal hook is called immediately after an annotation is destroyed. - -@item make-annotation-hook -This hook is called immediately after an annotation is created. It is -passed a single argument, the newly created annotation. -@end table diff --git a/man/lispref/backups.texi b/man/lispref/backups.texi deleted file mode 100644 index 59aa856..0000000 --- a/man/lispref/backups.texi +++ /dev/null @@ -1,648 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/backups.info -@node Backups and Auto-Saving, Buffers, Files, Top -@chapter Backups and Auto-Saving - - Backup files and auto-save files are two methods by which XEmacs tries -to protect the user from the consequences of crashes or of the user's -own errors. Auto-saving preserves the text from earlier in the current -editing session; backup files preserve file contents prior to the -current session. - -@menu -* Backup Files:: How backup files are made; how their names are chosen. -* Auto-Saving:: How auto-save files are made; how their names are chosen. -* Reverting:: @code{revert-buffer}, and how to customize what it does. -@end menu - -@node Backup Files -@section Backup Files -@cindex backup file - - A @dfn{backup file} is a copy of the old contents of a file you are -editing. XEmacs makes a backup file the first time you save a buffer -into its visited file. Normally, this means that the backup file -contains the contents of the file as it was before the current editing -session. The contents of the backup file normally remain unchanged once -it exists. - - Backups are usually made by renaming the visited file to a new name. -Optionally, you can specify that backup files should be made by copying -the visited file. This choice makes a difference for files with -multiple names; it also can affect whether the edited file remains owned -by the original owner or becomes owned by the user editing it. - - By default, XEmacs makes a single backup file for each file edited. -You can alternatively request numbered backups; then each new backup -file gets a new name. You can delete old numbered backups when you -don't want them any more, or XEmacs can delete them automatically. - -@menu -* Making Backups:: How XEmacs makes backup files, and when. -* Rename or Copy:: Two alternatives: renaming the old file or copying it. -* Numbered Backups:: Keeping multiple backups for each source file. -* Backup Names:: How backup file names are computed; customization. -@end menu - -@node Making Backups -@subsection Making Backup Files - -@defun backup-buffer - This function makes a backup of the file visited by the current -buffer, if appropriate. It is called by @code{save-buffer} before -saving the buffer the first time. -@end defun - -@defvar buffer-backed-up - This buffer-local variable indicates whether this buffer's file has -been backed up on account of this buffer. If it is non-@code{nil}, then -the backup file has been written. Otherwise, the file should be backed -up when it is next saved (if backups are enabled). This is a -permanent local; @code{kill-local-variables} does not alter it. -@end defvar - -@defopt make-backup-files -This variable determines whether or not to make backup files. If it -is non-@code{nil}, then XEmacs creates a backup of each file when it is -saved for the first time---provided that @code{backup-inhibited} -is @code{nil} (see below). - -The following example shows how to change the @code{make-backup-files} -variable only in the @file{RMAIL} buffer and not elsewhere. Setting it -@code{nil} stops XEmacs from making backups of the @file{RMAIL} file, -which may save disk space. (You would put this code in your -@file{.emacs} file.) - -@smallexample -@group -(add-hook 'rmail-mode-hook - (function (lambda () - (make-local-variable - 'make-backup-files) - (setq make-backup-files nil)))) -@end group -@end smallexample -@end defopt - -@defvar backup-enable-predicate -This variable's value is a function to be called on certain occasions to -decide whether a file should have backup files. The function receives -one argument, a file name to consider. If the function returns -@code{nil}, backups are disabled for that file. Otherwise, the other -variables in this section say whether and how to make backups. - -The default value is this: - -@example -(lambda (name) - (or (< (length name) 5) - (not (string-equal "/tmp/" - (substring name 0 5))))) -@end example -@end defvar - -@defvar backup-inhibited -If this variable is non-@code{nil}, backups are inhibited. It records -the result of testing @code{backup-enable-predicate} on the visited file -name. It can also coherently be used by other mechanisms that inhibit -backups based on which file is visited. For example, VC sets this -variable non-@code{nil} to prevent making backups for files managed -with a version control system. - -This is a permanent local, so that changing the major mode does not lose -its value. Major modes should not set this variable---they should set -@code{make-backup-files} instead. -@end defvar - -@node Rename or Copy -@subsection Backup by Renaming or by Copying? -@cindex backup files, how to make them - - There are two ways that XEmacs can make a backup file: - -@itemize @bullet -@item -XEmacs can rename the original file so that it becomes a backup file, and -then write the buffer being saved into a new file. After this -procedure, any other names (i.e., hard links) of the original file now -refer to the backup file. The new file is owned by the user doing the -editing, and its group is the default for new files written by the user -in that directory. - -@item -XEmacs can copy the original file into a backup file, and then overwrite -the original file with new contents. After this procedure, any other -names (i.e., hard links) of the original file still refer to the current -version of the file. The file's owner and group will be unchanged. -@end itemize - - The first method, renaming, is the default. - - The variable @code{backup-by-copying}, if non-@code{nil}, says to use -the second method, which is to copy the original file and overwrite it -with the new buffer contents. The variable @code{file-precious-flag}, -if non-@code{nil}, also has this effect (as a sideline of its main -significance). @xref{Saving Buffers}. - -@defvar backup-by-copying -If this variable is non-@code{nil}, XEmacs always makes backup files by -copying. -@end defvar - - The following two variables, when non-@code{nil}, cause the second -method to be used in certain special cases. They have no effect on the -treatment of files that don't fall into the special cases. - -@defvar backup-by-copying-when-linked -If this variable is non-@code{nil}, XEmacs makes backups by copying for -files with multiple names (hard links). - -This variable is significant only if @code{backup-by-copying} is -@code{nil}, since copying is always used when that variable is -non-@code{nil}. -@end defvar - -@defvar backup-by-copying-when-mismatch -If this variable is non-@code{nil}, XEmacs makes backups by copying in cases -where renaming would change either the owner or the group of the file. - -The value has no effect when renaming would not alter the owner or -group of the file; that is, for files which are owned by the user and -whose group matches the default for a new file created there by the -user. - -This variable is significant only if @code{backup-by-copying} is -@code{nil}, since copying is always used when that variable is -non-@code{nil}. -@end defvar - -@node Numbered Backups -@subsection Making and Deleting Numbered Backup Files - - If a file's name is @file{foo}, the names of its numbered backup -versions are @file{foo.~@var{v}~}, for various integers @var{v}, like -this: @file{foo.~1~}, @file{foo.~2~}, @file{foo.~3~}, @dots{}, -@file{foo.~259~}, and so on. - -@defopt version-control -This variable controls whether to make a single non-numbered backup -file or multiple numbered backups. - -@table @asis -@item @code{nil} -Make numbered backups if the visited file already has numbered backups; -otherwise, do not. - -@item @code{never} -Do not make numbered backups. - -@item @var{anything else} -Make numbered backups. -@end table -@end defopt - - The use of numbered backups ultimately leads to a large number of -backup versions, which must then be deleted. XEmacs can do this -automatically or it can ask the user whether to delete them. - -@defopt kept-new-versions -The value of this variable is the number of newest versions to keep -when a new numbered backup is made. The newly made backup is included -in the count. The default value is 2. -@end defopt - -@defopt kept-old-versions -The value of this variable is the number of oldest versions to keep -when a new numbered backup is made. The default value is 2. -@end defopt - - If there are backups numbered 1, 2, 3, 5, and 7, and both of these -variables have the value 2, then the backups numbered 1 and 2 are kept -as old versions and those numbered 5 and 7 are kept as new versions; -backup version 3 is excess. The function @code{find-backup-file-name} -(@pxref{Backup Names}) is responsible for determining which backup -versions to delete, but does not delete them itself. - -@defopt trim-versions-without-asking -If this variable is non-@code{nil}, then saving a file deletes excess -backup versions silently. Otherwise, it asks the user whether to delete -them. -@end defopt - -@defopt dired-kept-versions -This variable specifies how many of the newest backup versions to keep -in the Dired command @kbd{.} (@code{dired-clean-directory}). That's the -same thing @code{kept-new-versions} specifies when you make a new backup -file. The default value is 2. -@end defopt - -@node Backup Names -@subsection Naming Backup Files - - The functions in this section are documented mainly because you can -customize the naming conventions for backup files by redefining them. -If you change one, you probably need to change the rest. - -@defun backup-file-name-p filename -This function returns a non-@code{nil} value if @var{filename} is a -possible name for a backup file. A file with the name @var{filename} -need not exist; the function just checks the name. - -@smallexample -@group -(backup-file-name-p "foo") - @result{} nil -@end group -@group -(backup-file-name-p "foo~") - @result{} 3 -@end group -@end smallexample - -The standard definition of this function is as follows: - -@smallexample -@group -(defun backup-file-name-p (file) - "Return non-nil if FILE is a backup file \ -name (numeric or not)..." - (string-match "~$" file)) -@end group -@end smallexample - -@noindent -Thus, the function returns a non-@code{nil} value if the file name ends -with a @samp{~}. (We use a backslash to split the documentation -string's first line into two lines in the text, but produce just one -line in the string itself.) - -This simple expression is placed in a separate function to make it easy -to redefine for customization. -@end defun - -@defun make-backup-file-name filename -This function returns a string that is the name to use for a -non-numbered backup file for file @var{filename}. On Unix, this is just -@var{filename} with a tilde appended. - -The standard definition of this function is as follows: - -@smallexample -@group -(defun make-backup-file-name (file) - "Create the non-numeric backup file name for FILE. -@dots{}" - (concat file "~")) -@end group -@end smallexample - -You can change the backup-file naming convention by redefining this -function. The following example redefines @code{make-backup-file-name} -to prepend a @samp{.} in addition to appending a tilde: - -@smallexample -@group -(defun make-backup-file-name (filename) - (concat "." filename "~")) -@end group - -@group -(make-backup-file-name "backups.texi") - @result{} ".backups.texi~" -@end group -@end smallexample -@end defun - -@defun find-backup-file-name filename -This function computes the file name for a new backup file for -@var{filename}. It may also propose certain existing backup files for -deletion. @code{find-backup-file-name} returns a list whose @sc{car} is -the name for the new backup file and whose @sc{cdr} is a list of backup -files whose deletion is proposed. - -Two variables, @code{kept-old-versions} and @code{kept-new-versions}, -determine which backup versions should be kept. This function keeps -those versions by excluding them from the @sc{cdr} of the value. -@xref{Numbered Backups}. - -In this example, the value says that @file{~rms/foo.~5~} is the name -to use for the new backup file, and @file{~rms/foo.~3~} is an ``excess'' -version that the caller should consider deleting now. - -@smallexample -@group -(find-backup-file-name "~rms/foo") - @result{} ("~rms/foo.~5~" "~rms/foo.~3~") -@end group -@end smallexample -@end defun - -@c Emacs 19 feature -@defun file-newest-backup filename -This function returns the name of the most recent backup file for -@var{filename}, or @code{nil} if that file has no backup files. - -Some file comparison commands use this function so that they can -automatically compare a file with its most recent backup. -@end defun - -@node Auto-Saving -@section Auto-Saving -@cindex auto-saving - - XEmacs periodically saves all files that you are visiting; this is -called @dfn{auto-saving}. Auto-saving prevents you from losing more -than a limited amount of work if the system crashes. By default, -auto-saves happen every 300 keystrokes, or after around 30 seconds of -idle time. @xref{Auto-Save, Auto-Save, Auto-Saving: Protection Against -Disasters, emacs, The XEmacs Reference Manual}, for information on auto-save -for users. Here we describe the functions used to implement auto-saving -and the variables that control them. - -@defvar buffer-auto-save-file-name -This buffer-local variable is the name of the file used for -auto-saving the current buffer. It is @code{nil} if the buffer -should not be auto-saved. - -@example -@group -buffer-auto-save-file-name -=> "/xcssun/users/rms/lewis/#files.texi#" -@end group -@end example -@end defvar - -@deffn Command auto-save-mode arg -When used interactively without an argument, this command is a toggle -switch: it turns on auto-saving of the current buffer if it is off, and -vice-versa. With an argument @var{arg}, the command turns auto-saving -on if the value of @var{arg} is @code{t}, a nonempty list, or a positive -integer. Otherwise, it turns auto-saving off. -@end deffn - -@defun auto-save-file-name-p filename -This function returns a non-@code{nil} value if @var{filename} is a -string that could be the name of an auto-save file. It works based on -knowledge of the naming convention for auto-save files: a name that -begins and ends with hash marks (@samp{#}) is a possible auto-save file -name. The argument @var{filename} should not contain a directory part. - -@example -@group -(make-auto-save-file-name) - @result{} "/xcssun/users/rms/lewis/#files.texi#" -@end group -@group -(auto-save-file-name-p "#files.texi#") - @result{} 0 -@end group -@group -(auto-save-file-name-p "files.texi") - @result{} nil -@end group -@end example - -The standard definition of this function is as follows: - -@example -@group -(defun auto-save-file-name-p (filename) - "Return non-nil if FILENAME can be yielded by..." - (string-match "^#.*#$" filename)) -@end group -@end example - -This function exists so that you can customize it if you wish to -change the naming convention for auto-save files. If you redefine it, -be sure to redefine the function @code{make-auto-save-file-name} -correspondingly. -@end defun - -@defun make-auto-save-file-name -This function returns the file name to use for auto-saving the current -buffer. This is just the file name with hash marks (@samp{#}) appended -and prepended to it. This function does not look at the variable -@code{auto-save-visited-file-name} (described below); you should check -that before calling this function. - -@example -@group -(make-auto-save-file-name) - @result{} "/xcssun/users/rms/lewis/#backup.texi#" -@end group -@end example - -The standard definition of this function is as follows: - -@example -@group -(defun make-auto-save-file-name () - "Return file name to use for auto-saves \ -of current buffer. -@dots{}" - (if buffer-file-name -@end group -@group - (concat - (file-name-directory buffer-file-name) - "#" - (file-name-nondirectory buffer-file-name) - "#") - (expand-file-name - (concat "#%" (buffer-name) "#")))) -@end group -@end example - -This exists as a separate function so that you can redefine it to -customize the naming convention for auto-save files. Be sure to -change @code{auto-save-file-name-p} in a corresponding way. -@end defun - -@defvar auto-save-visited-file-name -If this variable is non-@code{nil}, XEmacs auto-saves buffers in -the files they are visiting. That is, the auto-save is done in the same -file that you are editing. Normally, this variable is @code{nil}, so -auto-save files have distinct names that are created by -@code{make-auto-save-file-name}. - -When you change the value of this variable, the value does not take -effect until the next time auto-save mode is reenabled in any given -buffer. If auto-save mode is already enabled, auto-saves continue to go -in the same file name until @code{auto-save-mode} is called again. -@end defvar - -@defun recent-auto-save-p -This function returns @code{t} if the current buffer has been -auto-saved since the last time it was read in or saved. -@end defun - -@defun set-buffer-auto-saved -This function marks the current buffer as auto-saved. The buffer will -not be auto-saved again until the buffer text is changed again. The -function returns @code{nil}. -@end defun - -@defopt auto-save-interval -The value of this variable is the number of characters that XEmacs -reads from the keyboard between auto-saves. Each time this many more -characters are read, auto-saving is done for all buffers in which it is -enabled. -@end defopt - -@defopt auto-save-timeout -The value of this variable is the number of seconds of idle time that -should cause auto-saving. Each time the user pauses for this long, -XEmacs auto-saves any buffers that need it. (Actually, the specified -timeout is multiplied by a factor depending on the size of the current -buffer.) -@end defopt - -@defvar auto-save-hook -This normal hook is run whenever an auto-save is about to happen. -@end defvar - -@defopt auto-save-default -If this variable is non-@code{nil}, buffers that are visiting files -have auto-saving enabled by default. Otherwise, they do not. -@end defopt - -@deffn Command do-auto-save &optional no-message current-only -This function auto-saves all buffers that need to be auto-saved. It -saves all buffers for which auto-saving is enabled and that have been -changed since the previous auto-save. - -Normally, if any buffers are auto-saved, a message that says -@samp{Auto-saving...} is displayed in the echo area while auto-saving is -going on. However, if @var{no-message} is non-@code{nil}, the message -is inhibited. - -If @var{current-only} is non-@code{nil}, only the current buffer -is auto-saved. -@end deffn - -@defun delete-auto-save-file-if-necessary -This function deletes the current buffer's auto-save file if -@code{delete-auto-save-files} is non-@code{nil}. It is called every -time a buffer is saved. -@end defun - -@defvar delete-auto-save-files -This variable is used by the function -@code{delete-auto-save-file-if-necessary}. If it is non-@code{nil}, -Emacs deletes auto-save files when a true save is done (in the visited -file). This saves disk space and unclutters your directory. -@end defvar - -@defun rename-auto-save-file -This function adjusts the current buffer's auto-save file name if the -visited file name has changed. It also renames an existing auto-save -file. If the visited file name has not changed, this function does -nothing. -@end defun - -@defvar buffer-saved-size -The value of this buffer-local variable is the length of the current -buffer as of the last time it was read in, saved, or auto-saved. This is -used to detect a substantial decrease in size, and turn off auto-saving -in response. - -If it is -1, that means auto-saving is temporarily shut off in this -buffer due to a substantial deletion. Explicitly saving the buffer -stores a positive value in this variable, thus reenabling auto-saving. -Turning auto-save mode off or on also alters this variable. -@end defvar - -@defvar auto-save-list-file-name -This variable (if non-@code{nil}) specifies a file for recording the -names of all the auto-save files. Each time XEmacs does auto-saving, it -writes two lines into this file for each buffer that has auto-saving -enabled. The first line gives the name of the visited file (it's empty -if the buffer has none), and the second gives the name of the auto-save -file. - -If XEmacs exits normally, it deletes this file. If XEmacs crashes, you -can look in the file to find all the auto-save files that might contain -work that was otherwise lost. The @code{recover-session} command uses -these files. - -The default name for this file is in your home directory and starts with -@samp{.saves-}. It also contains the XEmacs process @sc{id} and the host -name. -@end defvar - -@node Reverting -@section Reverting - - If you have made extensive changes to a file and then change your mind -about them, you can get rid of them by reading in the previous version -of the file with the @code{revert-buffer} command. @xref{Reverting, , -Reverting a Buffer, emacs, The XEmacs Reference Manual}. - -@deffn Command revert-buffer &optional check-auto-save noconfirm -This command replaces the buffer text with the text of the visited -file on disk. This action undoes all changes since the file was visited -or saved. - -If the argument @var{check-auto-save} is non-@code{nil}, and the -latest auto-save file is more recent than the visited file, -@code{revert-buffer} asks the user whether to use that instead. -Otherwise, it always uses the text of the visited file itself. -Interactively, @var{check-auto-save} is set if there is a numeric prefix -argument. - -Normally, @code{revert-buffer} asks for confirmation before it changes -the buffer; but if the argument @var{noconfirm} is non-@code{nil}, -@code{revert-buffer} does not ask for confirmation. - -Reverting tries to preserve marker positions in the buffer by using the -replacement feature of @code{insert-file-contents}. If the buffer -contents and the file contents are identical before the revert -operation, reverting preserves all the markers. If they are not -identical, reverting does change the buffer; then it preserves the -markers in the unchanged text (if any) at the beginning and end of the -buffer. Preserving any additional markers would be problematical. -@end deffn - -You can customize how @code{revert-buffer} does its work by setting -these variables---typically, as buffer-local variables. - -@defvar revert-buffer-function -The value of this variable is the function to use to revert this buffer. -If non-@code{nil}, it is called as a function with no arguments to do -the work of reverting. If the value is @code{nil}, reverting works the -usual way. - -Modes such as Dired mode, in which the text being edited does not -consist of a file's contents but can be regenerated in some other -fashion, give this variable a buffer-local value that is a function to -regenerate the contents. -@end defvar - -@defvar revert-buffer-insert-file-contents-function -The value of this variable, if non-@code{nil}, is the function to use to -insert the updated contents when reverting this buffer. The function -receives two arguments: first the file name to use; second, @code{t} if -the user has asked to read the auto-save file. -@end defvar - -@defvar before-revert-hook -This normal hook is run by @code{revert-buffer} before actually -inserting the modified contents---but only if -@code{revert-buffer-function} is @code{nil}. - -Font Lock mode uses this hook to record that the buffer contents are no -longer fontified. -@end defvar - -@defvar after-revert-hook -This normal hook is run by @code{revert-buffer} after actually inserting -the modified contents---but only if @code{revert-buffer-function} is -@code{nil}. - -Font Lock mode uses this hook to recompute the fonts for the updated -buffer contents. -@end defvar - diff --git a/man/lispref/buffers.texi b/man/lispref/buffers.texi deleted file mode 100644 index 24008a5..0000000 --- a/man/lispref/buffers.texi +++ /dev/null @@ -1,958 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/buffers.info -@node Buffers, Windows, Backups and Auto-Saving, Top -@chapter Buffers -@cindex buffer - - A @dfn{buffer} is a Lisp object containing text to be edited. Buffers -are used to hold the contents of files that are being visited; there may -also be buffers that are not visiting files. While several buffers may -exist at one time, exactly one buffer is designated the @dfn{current -buffer} at any time. Most editing commands act on the contents of the -current buffer. Each buffer, including the current buffer, may or may -not be displayed in any windows. - -@menu -* Buffer Basics:: What is a buffer? -* Current Buffer:: Designating a buffer as current - so primitives will access its contents. -* Buffer Names:: Accessing and changing buffer names. -* Buffer File Name:: The buffer file name indicates which file is visited. -* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved. -* Modification Time:: Determining whether the visited file was changed - ``behind XEmacs's back''. -* Read Only Buffers:: Modifying text is not allowed in a read-only buffer. -* The Buffer List:: How to look at all the existing buffers. -* Creating Buffers:: Functions that create buffers. -* Killing Buffers:: Buffers exist until explicitly killed. -* Indirect Buffers:: An indirect buffer shares text with some other buffer. -@end menu - -@node Buffer Basics -@section Buffer Basics - -@ifinfo - A @dfn{buffer} is a Lisp object containing text to be edited. Buffers -are used to hold the contents of files that are being visited; there may -also be buffers that are not visiting files. While several buffers may -exist at one time, exactly one buffer is designated the @dfn{current -buffer} at any time. Most editing commands act on the contents of the -current buffer. Each buffer, including the current buffer, may or may -not be displayed in any windows. -@end ifinfo - - Buffers in Emacs editing are objects that have distinct names and hold -text that can be edited. Buffers appear to Lisp programs as a special -data type. You can think of the contents of a buffer as an extendable -string; insertions and deletions may occur in any part of the buffer. -@xref{Text}. - - A Lisp buffer object contains numerous pieces of information. Some of -this information is directly accessible to the programmer through -variables, while other information is accessible only through -special-purpose functions. For example, the visited file name is -directly accessible through a variable, while the value of point is -accessible only through a primitive function. - - Buffer-specific information that is directly accessible is stored in -@dfn{buffer-local} variable bindings, which are variable values that are -effective only in a particular buffer. This feature allows each buffer -to override the values of certain variables. Most major modes override -variables such as @code{fill-column} or @code{comment-column} in this -way. For more information about buffer-local variables and functions -related to them, see @ref{Buffer-Local Variables}. - - For functions and variables related to visiting files in buffers, see -@ref{Visiting Files} and @ref{Saving Buffers}. For functions and -variables related to the display of buffers in windows, see -@ref{Buffers and Windows}. - -@defun bufferp object -This function returns @code{t} if @var{object} is a buffer, -@code{nil} otherwise. -@end defun - -@node Current Buffer -@section The Current Buffer -@cindex selecting a buffer -@cindex changing to another buffer -@cindex current buffer - - There are, in general, many buffers in an Emacs session. At any time, -one of them is designated as the @dfn{current buffer}. This is the -buffer in which most editing takes place, because most of the primitives -for examining or changing text in a buffer operate implicitly on the -current buffer (@pxref{Text}). Normally the buffer that is displayed on -the screen in the selected window is the current buffer, but this is not -always so: a Lisp program can designate any buffer as current -temporarily in order to operate on its contents, without changing what -is displayed on the screen. - - The way to designate a current buffer in a Lisp program is by calling -@code{set-buffer}. The specified buffer remains current until a new one -is designated. - - When an editing command returns to the editor command loop, the -command loop designates the buffer displayed in the selected window as -current, to prevent confusion: the buffer that the cursor is in when -Emacs reads a command is the buffer that the command will apply to. -(@xref{Command Loop}.) Therefore, @code{set-buffer} is not the way to -switch visibly to a different buffer so that the user can edit it. For -this, you must use the functions described in @ref{Displaying Buffers}. - - However, Lisp functions that change to a different current buffer -should not depend on the command loop to set it back afterwards. -Editing commands written in XEmacs Lisp can be called from other programs -as well as from the command loop. It is convenient for the caller if -the subroutine does not change which buffer is current (unless, of -course, that is the subroutine's purpose). Therefore, you should -normally use @code{set-buffer} within a @code{save-excursion} that will -restore the current buffer when your function is done -(@pxref{Excursions}). Here is an example, the code for the command -@code{append-to-buffer} (with the documentation string abridged): - -@example -@group -(defun append-to-buffer (buffer start end) - "Append to specified buffer the text of the region. -@dots{}" - (interactive "BAppend to buffer: \nr") - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (get-buffer-create buffer)) - (insert-buffer-substring oldbuf start end)))) -@end group -@end example - -@noindent -This function binds a local variable to the current buffer, and then -@code{save-excursion} records the values of point, the mark, and the -original buffer. Next, @code{set-buffer} makes another buffer current. -Finally, @code{insert-buffer-substring} copies the string from the -original current buffer to the new current buffer. - - If the buffer appended to happens to be displayed in some window, -the next redisplay will show how its text has changed. Otherwise, you -will not see the change immediately on the screen. The buffer becomes -current temporarily during the execution of the command, but this does -not cause it to be displayed. - - If you make local bindings (with @code{let} or function arguments) for -a variable that may also have buffer-local bindings, make sure that the -same buffer is current at the beginning and at the end of the local -binding's scope. Otherwise you might bind it in one buffer and unbind -it in another! There are two ways to do this. In simple cases, you may -see that nothing ever changes the current buffer within the scope of the -binding. Otherwise, use @code{save-excursion} to make sure that the -buffer current at the beginning is current again whenever the variable -is unbound. - - It is not reliable to change the current buffer back with -@code{set-buffer}, because that won't do the job if a quit happens while -the wrong buffer is current. Here is what @emph{not} to do: - -@example -@group -(let (buffer-read-only - (obuf (current-buffer))) - (set-buffer @dots{}) - @dots{} - (set-buffer obuf)) -@end group -@end example - -@noindent -Using @code{save-excursion}, as shown below, handles quitting, errors, -and @code{throw}, as well as ordinary evaluation. - -@example -@group -(let (buffer-read-only) - (save-excursion - (set-buffer @dots{}) - @dots{})) -@end group -@end example - -@defun current-buffer -This function returns the current buffer. - -@example -@group -(current-buffer) - @result{} # -@end group -@end example -@end defun - -@defun set-buffer buffer-or-name -This function makes @var{buffer-or-name} the current buffer. It does -not display the buffer in the currently selected window or in any other -window, so the user cannot necessarily see the buffer. But Lisp -programs can in any case work on it. - -This function returns the buffer identified by @var{buffer-or-name}. -An error is signaled if @var{buffer-or-name} does not identify an -existing buffer. -@end defun - -@node Buffer Names -@section Buffer Names -@cindex buffer names - - Each buffer has a unique name, which is a string. Many of the -functions that work on buffers accept either a buffer or a buffer name -as an argument. Any argument called @var{buffer-or-name} is of this -sort, and an error is signaled if it is neither a string nor a buffer. -Any argument called @var{buffer} must be an actual buffer -object, not a name. - - Buffers that are ephemeral and generally uninteresting to the user -have names starting with a space, so that the @code{list-buffers} and -@code{buffer-menu} commands don't mention them. A name starting with -space also initially disables recording undo information; see -@ref{Undo}. - -@defun buffer-name &optional buffer -This function returns the name of @var{buffer} as a string. If -@var{buffer} is not supplied, it defaults to the current buffer. - -If @code{buffer-name} returns @code{nil}, it means that @var{buffer} -has been killed. @xref{Killing Buffers}. - -@example -@group -(buffer-name) - @result{} "buffers.texi" -@end group - -@group -(setq foo (get-buffer "temp")) - @result{} # -@end group -@group -(kill-buffer foo) - @result{} nil -@end group -@group -(buffer-name foo) - @result{} nil -@end group -@group -foo - @result{} # -@end group -@end example -@end defun - -@deffn Command rename-buffer newname &optional unique -This function renames the current buffer to @var{newname}. An error -is signaled if @var{newname} is not a string, or if there is already a -buffer with that name. The function returns @code{nil}. - -@c Emacs 19 feature -Ordinarily, @code{rename-buffer} signals an error if @var{newname} is -already in use. However, if @var{unique} is non-@code{nil}, it modifies -@var{newname} to make a name that is not in use. Interactively, you can -make @var{unique} non-@code{nil} with a numeric prefix argument. - -One application of this command is to rename the @samp{*shell*} buffer -to some other name, thus making it possible to create a second shell -buffer under the name @samp{*shell*}. -@end deffn - -@defun get-buffer buffer-or-name -This function returns the buffer specified by @var{buffer-or-name}. -If @var{buffer-or-name} is a string and there is no buffer with that -name, the value is @code{nil}. If @var{buffer-or-name} is a buffer, it -is returned as given. (That is not very useful, so the argument is usually -a name.) For example: - -@example -@group -(setq b (get-buffer "lewis")) - @result{} # -@end group -@group -(get-buffer b) - @result{} # -@end group -@group -(get-buffer "Frazzle-nots") - @result{} nil -@end group -@end example - -See also the function @code{get-buffer-create} in @ref{Creating Buffers}. -@end defun - -@c Emacs 19 feature -@c IGNORE is only in XEmacs -@defun generate-new-buffer-name starting-name &optional ignore -This function returns a name that would be unique for a new buffer---but -does not create the buffer. It starts with @var{starting-name}, and -produces a name not currently in use for any buffer by appending a -number inside of @samp{<@dots{}>}. - -If @var{ignore} is given, it specifies a name that is okay to use (if it -is in the sequence to be tried), even if a buffer with that name exists. - -See the related function @code{generate-new-buffer} in @ref{Creating -Buffers}. -@end defun - -@node Buffer File Name -@section Buffer File Name -@cindex visited file -@cindex buffer file name -@cindex file name of buffer - - The @dfn{buffer file name} is the name of the file that is visited in -that buffer. When a buffer is not visiting a file, its buffer file name -is @code{nil}. Most of the time, the buffer name is the same as the -nondirectory part of the buffer file name, but the buffer file name and -the buffer name are distinct and can be set independently. -@xref{Visiting Files}. - -@defun buffer-file-name &optional buffer -This function returns the absolute file name of the file that -@var{buffer} is visiting. If @var{buffer} is not visiting any file, -@code{buffer-file-name} returns @code{nil}. If @var{buffer} is not -supplied, it defaults to the current buffer. - -@example -@group -(buffer-file-name (other-buffer)) - @result{} "/usr/user/lewis/manual/files.texi" -@end group -@end example -@end defun - -@defvar buffer-file-name -This buffer-local variable contains the name of the file being visited -in the current buffer, or @code{nil} if it is not visiting a file. It -is a permanent local, unaffected by @code{kill-local-variables}. - -@example -@group -buffer-file-name - @result{} "/usr/user/lewis/manual/buffers.texi" -@end group -@end example - -It is risky to change this variable's value without doing various other -things. See the definition of @code{set-visited-file-name} in -@file{files.el}; some of the things done there, such as changing the -buffer name, are not strictly necessary, but others are essential to -avoid confusing XEmacs. -@end defvar - -@defvar buffer-file-truename -This buffer-local variable holds the truename of the file visited in the -current buffer, or @code{nil} if no file is visited. It is a permanent -local, unaffected by @code{kill-local-variables}. @xref{Truenames}. -@end defvar - -@defvar buffer-file-number -This buffer-local variable holds the file number and directory device -number of the file visited in the current buffer, or @code{nil} if no -file or a nonexistent file is visited. It is a permanent local, -unaffected by @code{kill-local-variables}. @xref{Truenames}. - -The value is normally a list of the form @code{(@var{filenum} -@var{devnum})}. This pair of numbers uniquely identifies the file among -all files accessible on the system. See the function -@code{file-attributes}, in @ref{File Attributes}, for more information -about them. -@end defvar - -@defun get-file-buffer filename -This function returns the buffer visiting file @var{filename}. If -there is no such buffer, it returns @code{nil}. The argument -@var{filename}, which must be a string, is expanded (@pxref{File Name -Expansion}), then compared against the visited file names of all live -buffers. - -@example -@group -(get-file-buffer "buffers.texi") - @result{} # -@end group -@end example - -In unusual circumstances, there can be more than one buffer visiting -the same file name. In such cases, this function returns the first -such buffer in the buffer list. -@end defun - -@deffn Command set-visited-file-name filename -If @var{filename} is a non-empty string, this function changes the -name of the file visited in current buffer to @var{filename}. (If the -buffer had no visited file, this gives it one.) The @emph{next time} -the buffer is saved it will go in the newly-specified file. This -command marks the buffer as modified, since it does not (as far as XEmacs -knows) match the contents of @var{filename}, even if it matched the -former visited file. - -If @var{filename} is @code{nil} or the empty string, that stands for -``no visited file''. In this case, @code{set-visited-file-name} marks -the buffer as having no visited file. - -@c Wordy to avoid overfull hbox. --rjc 16mar92 -When the function @code{set-visited-file-name} is called interactively, it -prompts for @var{filename} in the minibuffer. - -See also @code{clear-visited-file-modtime} and -@code{verify-visited-file-modtime} in @ref{Buffer Modification}. -@end deffn - -@defvar list-buffers-directory -This buffer-local variable records a string to display in a buffer -listing in place of the visited file name, for buffers that don't have a -visited file name. Dired buffers use this variable. -@end defvar - -@node Buffer Modification -@section Buffer Modification -@cindex buffer modification -@cindex modification flag (of buffer) - - XEmacs keeps a flag called the @dfn{modified flag} for each buffer, to -record whether you have changed the text of the buffer. This flag is -set to @code{t} whenever you alter the contents of the buffer, and -cleared to @code{nil} when you save it. Thus, the flag shows whether -there are unsaved changes. The flag value is normally shown in the -modeline (@pxref{Modeline Variables}), and controls saving -(@pxref{Saving Buffers}) and auto-saving (@pxref{Auto-Saving}). - - Some Lisp programs set the flag explicitly. For example, the function -@code{set-visited-file-name} sets the flag to @code{t}, because the text -does not match the newly-visited file, even if it is unchanged from the -file formerly visited. - - The functions that modify the contents of buffers are described in -@ref{Text}. - -@defun buffer-modified-p &optional buffer -This function returns @code{t} if the buffer @var{buffer} has been modified -since it was last read in from a file or saved, or @code{nil} -otherwise. If @var{buffer} is not supplied, the current buffer -is tested. -@end defun - -@defun set-buffer-modified-p flag -This function marks the current buffer as modified if @var{flag} is -non-@code{nil}, or as unmodified if the flag is @code{nil}. - -Another effect of calling this function is to cause unconditional -redisplay of the modeline for the current buffer. In fact, the -function @code{redraw-modeline} works by doing this: - -@example -@group -(set-buffer-modified-p (buffer-modified-p)) -@end group -@end example -@end defun - -@c ARG is only in XEmacs -@deffn Command not-modified &optional arg -This command marks the current buffer as unmodified, and not needing -to be saved. (If @var{arg} is non-@code{nil}, the buffer is instead -marked as modified.) Don't use this function in programs, since it -prints a message in the echo area; use @code{set-buffer-modified-p} -(above) instead. -@end deffn - -@c Emacs 19 feature -@defun buffer-modified-tick &optional buffer -This function returns @var{buffer}`s modification-count. This is a -counter that increments every time the buffer is modified. If -@var{buffer} is @code{nil} (or omitted), the current buffer is used. -@end defun - -@node Modification Time -@section Comparison of Modification Time -@cindex comparison of modification time -@cindex modification time, comparison of - - Suppose that you visit a file and make changes in its buffer, and -meanwhile the file itself is changed on disk. At this point, saving the -buffer would overwrite the changes in the file. Occasionally this may -be what you want, but usually it would lose valuable information. XEmacs -therefore checks the file's modification time using the functions -described below before saving the file. - -@defun verify-visited-file-modtime buffer -This function compares what @var{buffer} has recorded for the -modification time of its visited file against the actual modification -time of the file as recorded by the operating system. The two should be -the same unless some other process has written the file since XEmacs -visited or saved it. - -The function returns @code{t} if the last actual modification time and -XEmacs's recorded modification time are the same, @code{nil} otherwise. -@end defun - -@defun clear-visited-file-modtime -This function clears out the record of the last modification time of -the file being visited by the current buffer. As a result, the next -attempt to save this buffer will not complain of a discrepancy in -file modification times. - -This function is called in @code{set-visited-file-name} and other -exceptional places where the usual test to avoid overwriting a changed -file should not be done. -@end defun - -@c Emacs 19 feature -@defun visited-file-modtime -This function returns the buffer's recorded last file modification time, -as a list of the form @code{(@var{high} . @var{low})}. (This is the -same format that @code{file-attributes} uses to return time values; see -@ref{File Attributes}.) -@end defun - -@c Emacs 19 feature -@defun set-visited-file-modtime &optional time -This function updates the buffer's record of the last modification time -of the visited file, to the value specified by @var{time} if @var{time} -is not @code{nil}, and otherwise to the last modification time of the -visited file. - -If @var{time} is not @code{nil}, it should have the form -@code{(@var{high} . @var{low})} or @code{(@var{high} @var{low})}, in -either case containing two integers, each of which holds 16 bits of the -time. - -This function is useful if the buffer was not read from the file -normally, or if the file itself has been changed for some known benign -reason. -@end defun - -@defun ask-user-about-supersession-threat filename -@cindex obsolete buffer -This function is used to ask a user how to proceed after an attempt to -modify an obsolete buffer visiting file @var{filename}. An -@dfn{obsolete buffer} is an unmodified buffer for which the associated -file on disk is newer than the last save-time of the buffer. This means -some other program has probably altered the file. - -@kindex file-supersession -Depending on the user's answer, the function may return normally, in -which case the modification of the buffer proceeds, or it may signal a -@code{file-supersession} error with data @code{(@var{filename})}, in which -case the proposed buffer modification is not allowed. - -This function is called automatically by XEmacs on the proper -occasions. It exists so you can customize XEmacs by redefining it. -See the file @file{userlock.el} for the standard definition. - -See also the file locking mechanism in @ref{File Locks}. -@end defun - -@node Read Only Buffers -@section Read-Only Buffers -@cindex read-only buffer -@cindex buffer, read-only - - If a buffer is @dfn{read-only}, then you cannot change its contents, -although you may change your view of the contents by scrolling and -narrowing. - - Read-only buffers are used in two kinds of situations: - -@itemize @bullet -@item -A buffer visiting a write-protected file is normally read-only. - -Here, the purpose is to show the user that editing the buffer with the -aim of saving it in the file may be futile or undesirable. The user who -wants to change the buffer text despite this can do so after clearing -the read-only flag with @kbd{C-x C-q}. - -@item -Modes such as Dired and Rmail make buffers read-only when altering the -contents with the usual editing commands is probably a mistake. - -The special commands of these modes bind @code{buffer-read-only} to -@code{nil} (with @code{let}) or bind @code{inhibit-read-only} to -@code{t} around the places where they change the text. -@end itemize - -@defvar buffer-read-only -This buffer-local variable specifies whether the buffer is read-only. -The buffer is read-only if this variable is non-@code{nil}. -@end defvar - -@defvar inhibit-read-only -If this variable is non-@code{nil}, then read-only buffers and read-only -characters may be modified. Read-only characters in a buffer are those -that have non-@code{nil} @code{read-only} properties (either text -properties or extent properties). @xref{Extent Properties}, for more -information about text properties and extent properties. - -If @code{inhibit-read-only} is @code{t}, all @code{read-only} character -properties have no effect. If @code{inhibit-read-only} is a list, then -@code{read-only} character properties have no effect if they are members -of the list (comparison is done with @code{eq}). -@end defvar - -@deffn Command toggle-read-only -This command changes whether the current buffer is read-only. It is -intended for interactive use; don't use it in programs. At any given -point in a program, you should know whether you want the read-only flag -on or off; so you can set @code{buffer-read-only} explicitly to the -proper value, @code{t} or @code{nil}. -@end deffn - -@defun barf-if-buffer-read-only -This function signals a @code{buffer-read-only} error if the current -buffer is read-only. @xref{Interactive Call}, for another way to -signal an error if the current buffer is read-only. -@end defun - -@node The Buffer List -@section The Buffer List -@cindex buffer list - - The @dfn{buffer list} is a list of all live buffers. Creating a -buffer adds it to this list, and killing a buffer deletes it. The order -of the buffers in the list is based primarily on how recently each -buffer has been displayed in the selected window. Buffers move to the -front of the list when they are selected and to the end when they are -buried. Several functions, notably @code{other-buffer}, use this -ordering. A buffer list displayed for the user also follows this order. - -@c XEmacs feature - Every frame has its own order for the buffer list. Switching to a -new buffer inside of a particular frame changes the buffer list order -for that frame, but does not affect the buffer list order of any other -frames. In addition, there is a global, non-frame buffer list order -that is independent of the buffer list orders for any particular frame. - -Note that the different buffer lists all contain the same elements. It -is only the order of those elements that is different. - -@defun buffer-list &optional frame -This function returns a list of all buffers, including those whose -names begin with a space. The elements are actual buffers, not their -names. The order of the list is specific to @var{frame}, which -defaults to the current frame. If @var{frame} is @code{t}, the -global, non-frame ordering is returned instead. - -@example -@group -(buffer-list) - @result{} (# - # # - # #) -@end group - -@group -;; @r{Note that the name of the minibuffer} -;; @r{begins with a space!} -(mapcar (function buffer-name) (buffer-list)) - @result{} ("buffers.texi" " *Minibuf-1*" - "buffer.c" "*Help*" "TAGS") -@end group -@end example - -Buffers appear earlier in the list if they were current more recently. - -This list is a copy of a list used inside XEmacs; modifying it has no -effect on the buffers. -@end defun - -@defun other-buffer &optional buffer-or-name frame visible-ok -This function returns the first buffer in the buffer list other than -@var{buffer-or-name}, in @var{frame}'s ordering for the buffer list. -(@var{frame} defaults to the current frame. If @var{frame} is -@code{t}, then the global, non-frame ordering is used.) Usually this is -the buffer most recently shown in the selected window, aside from -@var{buffer-or-name}. Buffers are moved to the front of the list when -they are selected and to the end when they are buried. Buffers whose -names start with a space are not considered. - -If @var{buffer-or-name} is not supplied (or if it is not a buffer), -then @code{other-buffer} returns the first buffer on the buffer list -that is not visible in any window in a visible frame. - -If the selected frame has a non-@code{nil} @code{buffer-predicate} -property, then @code{other-buffer} uses that predicate to decide which -buffers to consider. It calls the predicate once for each buffer, and -if the value is @code{nil}, that buffer is ignored. @xref{X Frame -Properties}. - -@c Emacs 19 feature -If @var{visible-ok} is @code{nil}, @code{other-buffer} avoids returning -a buffer visible in any window on any visible frame, except as a last -resort. If @var{visible-ok} is non-@code{nil}, then it does not matter -whether a buffer is displayed somewhere or not. - -If no suitable buffer exists, the buffer @samp{*scratch*} is returned -(and created, if necessary). - -Note that in FSF Emacs 19, there is no @var{frame} argument, and -@var{visible-ok} is the second argument instead of the third. -FSF Emacs 19. -@end defun - -@deffn Command list-buffers &optional files-only - This function displays a listing of the names of existing buffers. It -clears the buffer @samp{*Buffer List*}, then inserts the listing into -that buffer and displays it in a window. @code{list-buffers} is -intended for interactive use, and is described fully in @cite{The XEmacs -Reference Manual}. It returns @code{nil}. -@end deffn - -@deffn Command bury-buffer &optional buffer-or-name -This function puts @var{buffer-or-name} at the end of the buffer list -without changing the order of any of the other buffers on the list. -This buffer therefore becomes the least desirable candidate for -@code{other-buffer} to return. - -If @var{buffer-or-name} is @code{nil} or omitted, this means to bury the -current buffer. In addition, if the buffer is displayed in the selected -window, this switches to some other buffer (obtained using -@code{other-buffer}) in the selected window. But if the buffer is -displayed in some other window, it remains displayed there. - -If you wish to replace a buffer in all the windows that display it, use -@code{replace-buffer-in-windows}. @xref{Buffers and Windows}. -@end deffn - -@node Creating Buffers -@section Creating Buffers -@cindex creating buffers -@cindex buffers, creating - - This section describes the two primitives for creating buffers. -@code{get-buffer-create} creates a buffer if it finds no existing buffer -with the specified name; @code{generate-new-buffer} always creates a new -buffer and gives it a unique name. - - Other functions you can use to create buffers include -@code{with-output-to-temp-buffer} (@pxref{Temporary Displays}) and -@code{create-file-buffer} (@pxref{Visiting Files}). Starting a -subprocess can also create a buffer (@pxref{Processes}). - -@defun get-buffer-create name -This function returns a buffer named @var{name}. It returns an existing -buffer with that name, if one exists; otherwise, it creates a new -buffer. The buffer does not become the current buffer---this function -does not change which buffer is current. - -An error is signaled if @var{name} is not a string. - -@example -@group -(get-buffer-create "foo") - @result{} # -@end group -@end example - -The major mode for the new buffer is set to Fundamental mode. The -variable @code{default-major-mode} is handled at a higher level. -@xref{Auto Major Mode}. -@end defun - -@defun generate-new-buffer name -This function returns a newly created, empty buffer, but does not make -it current. If there is no buffer named @var{name}, then that is the -name of the new buffer. If that name is in use, this function adds -suffixes of the form @samp{<@var{n}>} to @var{name}, where @var{n} is an -integer. It tries successive integers starting with 2 until it finds an -available name. - -An error is signaled if @var{name} is not a string. - -@example -@group -(generate-new-buffer "bar") - @result{} # -@end group -@group -(generate-new-buffer "bar") - @result{} #> -@end group -@group -(generate-new-buffer "bar") - @result{} #> -@end group -@end example - -The major mode for the new buffer is set to Fundamental mode. The -variable @code{default-major-mode} is handled at a higher level. -@xref{Auto Major Mode}. - -See the related function @code{generate-new-buffer-name} in @ref{Buffer -Names}. -@end defun - -@node Killing Buffers -@section Killing Buffers -@cindex killing buffers -@cindex buffers, killing - - @dfn{Killing a buffer} makes its name unknown to XEmacs and makes its -text space available for other use. - - The buffer object for the buffer that has been killed remains in -existence as long as anything refers to it, but it is specially marked -so that you cannot make it current or display it. Killed buffers retain -their identity, however; two distinct buffers, when killed, remain -distinct according to @code{eq}. - - If you kill a buffer that is current or displayed in a window, XEmacs -automatically selects or displays some other buffer instead. This means -that killing a buffer can in general change the current buffer. -Therefore, when you kill a buffer, you should also take the precautions -associated with changing the current buffer (unless you happen to know -that the buffer being killed isn't current). @xref{Current Buffer}. - - If you kill a buffer that is the base buffer of one or more indirect -buffers, the indirect buffers are automatically killed as well. - - The @code{buffer-name} of a killed buffer is @code{nil}. To test -whether a buffer has been killed, you can either use this feature -or the function @code{buffer-live-p}. - -@defun buffer-live-p buffer -This function returns @code{nil} if @var{buffer} is deleted, and -@code{t} otherwise. -@end defun - -@deffn Command kill-buffer buffer-or-name -This function kills the buffer @var{buffer-or-name}, freeing all its -memory for use as space for other buffers. (Emacs version 18 and older -was unable to return the memory to the operating system.) It returns -@code{nil}. - -Any processes that have this buffer as the @code{process-buffer} are -sent the @code{SIGHUP} signal, which normally causes them to terminate. -(The basic meaning of @code{SIGHUP} is that a dialup line has been -disconnected.) @xref{Deleting Processes}. - -If the buffer is visiting a file and contains unsaved changes, -@code{kill-buffer} asks the user to confirm before the buffer is killed. -It does this even if not called interactively. To prevent the request -for confirmation, clear the modified flag before calling -@code{kill-buffer}. @xref{Buffer Modification}. - -Killing a buffer that is already dead has no effect. - -@smallexample -(kill-buffer "foo.unchanged") - @result{} nil -(kill-buffer "foo.changed") - ----------- Buffer: Minibuffer ---------- -Buffer foo.changed modified; kill anyway? (yes or no) @kbd{yes} ----------- Buffer: Minibuffer ---------- - - @result{} nil -@end smallexample -@end deffn - -@defvar kill-buffer-query-functions -After confirming unsaved changes, @code{kill-buffer} calls the functions -in the list @code{kill-buffer-query-functions}, in order of appearance, -with no arguments. The buffer being killed is the current buffer when -they are called. The idea is that these functions ask for confirmation -from the user for various nonstandard reasons. If any of them returns -@code{nil}, @code{kill-buffer} spares the buffer's life. -@end defvar - -@defvar kill-buffer-hook -This is a normal hook run by @code{kill-buffer} after asking all the -questions it is going to ask, just before actually killing the buffer. -The buffer to be killed is current when the hook functions run. -@xref{Hooks}. -@end defvar - -@defvar buffer-offer-save -This variable, if non-@code{nil} in a particular buffer, tells -@code{save-buffers-kill-emacs} and @code{save-some-buffers} to offer to -save that buffer, just as they offer to save file-visiting buffers. The -variable @code{buffer-offer-save} automatically becomes buffer-local -when set for any reason. @xref{Buffer-Local Variables}. -@end defvar - -@node Indirect Buffers -@section Indirect Buffers -@cindex indirect buffers -@cindex base buffer - - An @dfn{indirect buffer} shares the text of some other buffer, which -is called the @dfn{base buffer} of the indirect buffer. In some ways it -is the analogue, for buffers, of a symbolic link among files. The base -buffer may not itself be an indirect buffer. One base buffer may have -several @dfn{indirect children}. - - The text of the indirect buffer is always identical to the text of its -base buffer; changes made by editing either one are visible immediately -in the other. - - But in all other respects, the indirect buffer and its base buffer are -completely separate. They have different names, different values of -point and mark, different narrowing, different markers and extents -(though inserting or deleting text in either buffer relocates the -markers and extents for both), different major modes, and different -local variables. Unlike in FSF Emacs, XEmacs indirect buffers do not -automatically share text properties among themselves and their base -buffer. - - An indirect buffer cannot visit a file, but its base buffer can. If -you try to save the indirect buffer, that actually works by saving the -base buffer. - - Killing an indirect buffer has no effect on its base buffer. Killing -the base buffer kills all its indirect children. - -@deffn Command make-indirect-buffer base-buffer name -This creates an indirect buffer named @var{name} whose base buffer -is @var{base-buffer}. The argument @var{base-buffer} may be a buffer -or a string. - -If @var{base-buffer} is an indirect buffer, its base buffer is used as -the base for the new buffer. - -@example -@group -(make-indirect-buffer "*scratch*" "indirect") - @result{} # -@end group -@end example -@end deffn - -@defun buffer-base-buffer &optional buffer -This function returns the base buffer of @var{buffer}. If @var{buffer} -is not indirect, the value is @code{nil}. Otherwise, the value is -another buffer, which is never an indirect buffer. If @var{buffer} is -not supplied, it defaults to the current buffer. - -@example -@group -(buffer-base-buffer (get-buffer "indirect")) - @result{} # -@end group -@end example -@end defun - -@defun buffer-indirect-children &optional buffer -This function returns a list of all indirect buffers whose base buffer -is @var{buffer}. If @var{buffer} is indirect, the return value will -always be nil; see @code{make-indirect-buffer}. If @var{buffer} is not -supplied, it defaults to the current buffer. - -@example -@group -(buffer-indirect-children (get-buffer "*scratch*")) - @result{} (#) -@end group -@end example -@end defun diff --git a/man/lispref/building.texi b/man/lispref/building.texi deleted file mode 100644 index 9f962af..0000000 --- a/man/lispref/building.texi +++ /dev/null @@ -1,492 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/building.info -@node Building XEmacs and Object Allocation, Standard Errors, Tips, Top -@appendix Building XEmacs; Allocation of Objects - - This chapter describes how the runnable XEmacs executable is dumped -with the preloaded Lisp libraries in it and how storage is allocated. - - There is an entire separate document, the @cite{XEmacs Internals -Manual}, devoted to the internals of XEmacs from the perspective of the -C programmer. It contains much more detailed information about the -build process, the allocation and garbage-collection process, and other -aspects related to the internals of XEmacs. - -@menu -* Building XEmacs:: How to preload Lisp libraries into XEmacs. -* Pure Storage:: A kludge to make preloaded Lisp functions sharable. -* Garbage Collection:: Reclaiming space for Lisp objects no longer used. -@end menu - -@node Building XEmacs -@appendixsec Building XEmacs -@cindex building XEmacs -@pindex temacs - - This section explains the steps involved in building the XEmacs -executable. You don't have to know this material to build and install -XEmacs, since the makefiles do all these things automatically. This -information is pertinent to XEmacs maintenance. - - The @cite{XEmacs Internals Manual} contains more information about this. - - Compilation of the C source files in the @file{src} directory -produces an executable file called @file{temacs}, also called a -@dfn{bare impure XEmacs}. It contains the XEmacs Lisp interpreter and I/O -routines, but not the editing commands. - -@cindex @file{loadup.el} - Before XEmacs is actually usable, a number of Lisp files need to be -loaded. These define all the editing commands, plus most of the startup -code and many very basic Lisp primitives. This is accomplished by -loading the file @file{loadup.el}, which in turn loads all of the other -standardly-loaded Lisp files. - - It takes a substantial time to load the standard Lisp files. Luckily, -you don't have to do this each time you run XEmacs; @file{temacs} can -dump out an executable program called @file{xemacs} that has these files -preloaded. @file{xemacs} starts more quickly because it does not need to -load the files. This is the XEmacs executable that is normally -installed. - - To create @file{xemacs}, use the command @samp{temacs -batch -l loadup -dump}. The purpose of @samp{-batch} here is to tell @file{temacs} to run -in non-interactive, command-line mode. (@file{temacs} can @emph{only} run -in this fashion. Part of the code required to initialize frames and faces -is in Lisp, and must be loaded before XEmacs is able to create any frames.) -The argument @samp{dump} tells @file{loadup.el} to dump a new executable -named @file{xemacs}. - - The dumping process is highly system-specific, and some operating -systems don't support dumping. On those systems, you must start XEmacs -with the @samp{temacs -batch -l loadup run-temacs} command each time you -use it. This takes a substantial time, but since you need to start -Emacs once a day at most---or once a week if you never log out---the -extra time is not too severe a problem. (In older versions of Emacs, -you started Emacs from @file{temacs} using @samp{temacs -l loadup}.) - -@cindex runnable @file{temacs} -@cindex bootstrapping XEmacs from @file{temacs} - You are free to start XEmacs directly from @file{temacs} if you want, -even if there is already a dumped @file{xemacs}. Normally you wouldn't -want to do that; but the Makefiles do this when you rebuild XEmacs using -@samp{make all-elc}, which builds XEmacs and simultaneously compiles any -out-of-date Lisp files. (You need @file{xemacs} in order to compile Lisp -files. However, you also need the compiled Lisp files in order to dump -out @file{xemacs}. If both of these are missing or corrupted, you are -out of luck unless you're able to bootstrap @file{xemacs} from -@file{temacs}. Note that @samp{make all-elc} actually loads the -alternative loadup file @file{loadup-el.el}, which works like -@file{loadup.el} but disables the pure-copying process and forces -XEmacs to ignore any compiled Lisp files even if they exist.) - -@cindex @file{site-load.el} - You can specify additional files to preload by writing a library named -@file{site-load.el} that loads them. You may need to increase the value -of @code{PURESIZE}, in @file{src/puresize.h}, to make room for the -additional files. You should @emph{not} modify this file directly, -however; instead, use the @samp{--puresize} configuration option. (If -you run out of pure space while dumping @file{xemacs}, you will be told -how much pure space you actually will need.) However, the advantage of -preloading additional files decreases as machines get faster. On modern -machines, it is often not advisable, especially if the Lisp code is -on a file system local to the machine running XEmacs. - -@cindex @file{site-init.el} - You can specify other Lisp expressions to execute just before dumping -by putting them in a library named @file{site-init.el}. However, if -they might alter the behavior that users expect from an ordinary -unmodified XEmacs, it is better to put them in @file{default.el}, so that -users can override them if they wish. @xref{Start-up Summary}. - - Before @file{loadup.el} dumps the new executable, it finds the -documentation strings for primitive and preloaded functions (and -variables) in the file where they are stored, by calling -@code{Snarf-documentation} (@pxref{Accessing Documentation}). These -strings were moved out of the @file{xemacs} executable to make it -smaller. @xref{Documentation Basics}. - -@defun dump-emacs to-file from-file -@cindex unexec - This function dumps the current state of XEmacs into an executable file -@var{to-file}. It takes symbols from @var{from-file} (this is normally -the executable file @file{temacs}). - -If you use this function in an XEmacs that was already dumped, you must -set @code{command-line-processed} to @code{nil} first for good results. -@xref{Command Line Arguments}. -@end defun - -@defun run-emacs-from-temacs &rest args - This is the function that implements the @file{run-temacs} command-line -argument. It is called from @file{loadup.el} as appropriate. You should -most emphatically @emph{not} call this yourself; it will reinitialize -your XEmacs process and you'll be sorry. -@end defun - -@deffn Command emacs-version - This function returns a string describing the version of XEmacs that is -running. It is useful to include this string in bug reports. - -@example -@group -(emacs-version) - @result{} "XEmacs 20.1 [Lucid] (i586-unknown-linux2.0.29) - of Mon Apr 7 1997 on altair.xemacs.org" -@end group -@end example - -Called interactively, the function prints the same information in the -echo area. -@end deffn - -@defvar emacs-build-time -The value of this variable is the time at which XEmacs was built at the -local site. - -@example -@group -emacs-build-time "Mon Apr 7 20:28:52 1997" - @result{} -@end group -@end example -@end defvar - -@defvar emacs-version -The value of this variable is the version of Emacs being run. It is a -string, e.g. @code{"20.1 XEmacs Lucid"}. -@end defvar - - The following two variables did not exist before FSF GNU Emacs version -19.23 and XEmacs version 19.10, which reduces their usefulness at -present, but we hope they will be convenient in the future. - -@defvar emacs-major-version -The major version number of Emacs, as an integer. For XEmacs version -20.1, the value is 20. -@end defvar - -@defvar emacs-minor-version -The minor version number of Emacs, as an integer. For XEmacs version -20.1, the value is 1. -@end defvar - -@node Pure Storage -@appendixsec Pure Storage -@cindex pure storage - - XEmacs Lisp uses two kinds of storage for user-created Lisp objects: -@dfn{normal storage} and @dfn{pure storage}. Normal storage is where -all the new data created during an XEmacs session is kept; see the -following section for information on normal storage. Pure storage is -used for certain data in the preloaded standard Lisp files---data that -should never change during actual use of XEmacs. - - Pure storage is allocated only while @file{temacs} is loading the -standard preloaded Lisp libraries. In the file @file{xemacs}, it is -marked as read-only (on operating systems that permit this), so that the -memory space can be shared by all the XEmacs jobs running on the machine -at once. Pure storage is not expandable; a fixed amount is allocated -when XEmacs is compiled, and if that is not sufficient for the preloaded -libraries, @file{temacs} aborts with an error message. If that happens, -you must increase the compilation parameter @code{PURESIZE} using the -@samp{--puresize} option to @file{configure}. This normally won't -happen unless you try to preload additional libraries or add features to -the standard ones. - -@defun purecopy object -This function makes a copy of @var{object} in pure storage and returns -it. It copies strings by simply making a new string with the same -characters in pure storage. It recursively copies the contents of -vectors and cons cells. It does not make copies of other objects such -as symbols, but just returns them unchanged. It signals an error if -asked to copy markers. - -This function is a no-op except while XEmacs is being built and dumped; -it is usually called only in the file -@file{xemacs/lisp/prim/loaddefs.el}, but a few packages call it just in -case you decide to preload them. -@end defun - -@defvar pure-bytes-used -The value of this variable is the number of bytes of pure storage -allocated so far. Typically, in a dumped XEmacs, this number is very -close to the total amount of pure storage available---if it were not, -we would preallocate less. -@end defvar - -@defvar purify-flag -This variable determines whether @code{defun} should make a copy of the -function definition in pure storage. If it is non-@code{nil}, then the -function definition is copied into pure storage. - -This flag is @code{t} while loading all of the basic functions for -building XEmacs initially (allowing those functions to be sharable and -non-collectible). Dumping XEmacs as an executable always writes -@code{nil} in this variable, regardless of the value it actually has -before and after dumping. - -You should not change this flag in a running XEmacs. -@end defvar - -@node Garbage Collection -@appendixsec Garbage Collection -@cindex garbage collector - -@cindex memory allocation - When a program creates a list or the user defines a new function (such -as by loading a library), that data is placed in normal storage. If -normal storage runs low, then XEmacs asks the operating system to -allocate more memory in blocks of 2k bytes. Each block is used for one -type of Lisp object, so symbols, cons cells, markers, etc., are -segregated in distinct blocks in memory. (Vectors, long strings, -buffers and certain other editing types, which are fairly large, are -allocated in individual blocks, one per object, while small strings are -packed into blocks of 8k bytes. [More correctly, a string is allocated -in two sections: a fixed size chunk containing the length, list of -extents, etc.; and a chunk containing the actual characters in the -string. It is this latter chunk that is either allocated individually -or packed into 8k blocks. The fixed size chunk is packed into 2k -blocks, as for conses, markers, etc.]) - - It is quite common to use some storage for a while, then release it by -(for example) killing a buffer or deleting the last pointer to an -object. XEmacs provides a @dfn{garbage collector} to reclaim this -abandoned storage. (This name is traditional, but ``garbage recycler'' -might be a more intuitive metaphor for this facility.) - - The garbage collector operates by finding and marking all Lisp objects -that are still accessible to Lisp programs. To begin with, it assumes -all the symbols, their values and associated function definitions, and -any data presently on the stack, are accessible. Any objects that can -be reached indirectly through other accessible objects are also -accessible. - - When marking is finished, all objects still unmarked are garbage. No -matter what the Lisp program or the user does, it is impossible to refer -to them, since there is no longer a way to reach them. Their space -might as well be reused, since no one will miss them. The second -(``sweep'') phase of the garbage collector arranges to reuse them. - -@cindex free list - The sweep phase puts unused cons cells onto a @dfn{free list} for -future allocation; likewise for symbols, markers, extents, events, -floats, compiled-function objects, and the fixed-size portion of -strings. It compacts the accessible small string-chars chunks so they -occupy fewer 8k blocks; then it frees the other 8k blocks. Vectors, -buffers, windows, and other large objects are individually allocated and -freed using @code{malloc} and @code{free}. - -@cindex CL note---allocate more storage -@quotation -@b{Common Lisp note:} unlike other Lisps, XEmacs Lisp does not -call the garbage collector when the free list is empty. Instead, it -simply requests the operating system to allocate more storage, and -processing continues until @code{gc-cons-threshold} bytes have been -used. - -This means that you can make sure that the garbage collector will not -run during a certain portion of a Lisp program by calling the garbage -collector explicitly just before it (provided that portion of the -program does not use so much space as to force a second garbage -collection). -@end quotation - -@deffn Command garbage-collect -This command runs a garbage collection, and returns information on -the amount of space in use. (Garbage collection can also occur -spontaneously if you use more than @code{gc-cons-threshold} bytes of -Lisp data since the previous garbage collection.) - -@code{garbage-collect} returns a list containing the following -information: - -@example -@group -((@var{used-conses} . @var{free-conses}) - (@var{used-syms} . @var{free-syms}) -@end group - (@var{used-markers} . @var{free-markers}) - @var{used-string-chars} - @var{used-vector-slots} - (@var{plist})) - -@group -@result{} ((73362 . 8325) (13718 . 164) -(5089 . 5098) 949121 118677 -(conses-used 73362 conses-free 8329 cons-storage 658168 -symbols-used 13718 symbols-free 164 symbol-storage 335216 -bit-vectors-used 0 bit-vectors-total-length 0 -bit-vector-storage 0 vectors-used 7882 -vectors-total-length 118677 vector-storage 537764 -compiled-functions-used 1336 compiled-functions-free 37 -compiled-function-storage 44440 short-strings-used 28829 -long-strings-used 2 strings-free 7722 -short-strings-total-length 916657 short-string-storage 1179648 -long-strings-total-length 32464 string-header-storage 441504 -floats-used 3 floats-free 43 float-storage 2044 markers-used 5089 -markers-free 5098 marker-storage 245280 events-used 103 -events-free 835 event-storage 110656 extents-used 10519 -extents-free 2718 extent-storage 372736 -extent-auxiliarys-used 111 extent-auxiliarys-freed 3 -extent-auxiliary-storage 4440 window-configurations-used 39 -window-configurations-on-free-list 5 -window-configurations-freed 10 window-configuration-storage 9492 -popup-datas-used 3 popup-data-storage 72 toolbar-buttons-used 62 -toolbar-button-storage 4960 toolbar-datas-used 12 -toolbar-data-storage 240 symbol-value-buffer-locals-used 182 -symbol-value-buffer-local-storage 5824 -symbol-value-lisp-magics-used 22 -symbol-value-lisp-magic-storage 1496 -symbol-value-varaliases-used 43 -symbol-value-varalias-storage 1032 opaque-lists-used 2 -opaque-list-storage 48 color-instances-used 12 -color-instance-storage 288 font-instances-used 5 -font-instance-storage 180 opaques-used 11 opaque-storage 312 -range-tables-used 1 range-table-storage 16 faces-used 34 -face-storage 2584 glyphs-used 124 glyph-storage 4464 -specifiers-used 775 specifier-storage 43869 weak-lists-used 786 -weak-list-storage 18864 char-tables-used 40 -char-table-storage 41920 buffers-used 25 buffer-storage 7000 -extent-infos-used 457 extent-infos-freed 73 -extent-info-storage 9140 keymaps-used 275 keymap-storage 12100 -consoles-used 4 console-storage 384 command-builders-used 2 -command-builder-storage 120 devices-used 2 device-storage 344 -frames-used 3 frame-storage 624 image-instances-used 47 -image-instance-storage 3008 windows-used 27 windows-freed 2 -window-storage 9180 lcrecord-lists-used 15 -lcrecord-list-storage 360 hash-tables-used 631 -hash-table-storage 25240 streams-used 1 streams-on-free-list 3 -streams-freed 12 stream-storage 91)) -@end group -@end example - -Here is a table explaining each element: - -@table @var -@item used-conses -The number of cons cells in use. - -@item free-conses -The number of cons cells for which space has been obtained from the -operating system, but that are not currently being used. - -@item used-syms -The number of symbols in use. - -@item free-syms -The number of symbols for which space has been obtained from the -operating system, but that are not currently being used. - -@item used-markers -The number of markers in use. - -@item free-markers -The number of markers for which space has been obtained from the -operating system, but that are not currently being used. - -@item used-string-chars -The total size of all strings, in characters. - -@item used-vector-slots -The total number of elements of existing vectors. - -@item plist -A list of alternating keyword/value pairs providing more detailed -information. (As you can see above, quite a lot of information is -provided.) -@ignore @c Different in XEmacs - -@item used-floats -@c Emacs 19 feature -The number of floats in use. - -@item free-floats -@c Emacs 19 feature -The number of floats for which space has been obtained from the -operating system, but that are not currently being used. -@end ignore -@end table -@end deffn - -@defopt gc-cons-threshold -The value of this variable is the number of bytes of storage that must -be allocated for Lisp objects after one garbage collection in order to -trigger another garbage collection. A cons cell counts as eight bytes, -a string as one byte per character plus a few bytes of overhead, and so -on; space allocated to the contents of buffers does not count. Note -that the subsequent garbage collection does not happen immediately when -the threshold is exhausted, but only the next time the Lisp evaluator is -called. - -The initial threshold value is 500,000. If you specify a larger -value, garbage collection will happen less often. This reduces the -amount of time spent garbage collecting, but increases total memory use. -You may want to do this when running a program that creates lots of -Lisp data. - -You can make collections more frequent by specifying a smaller value, -down to 10,000. A value less than 10,000 will remain in effect only -until the subsequent garbage collection, at which time -@code{garbage-collect} will set the threshold back to 10,000. (This does -not apply if XEmacs was configured with @samp{--debug}. Therefore, be -careful when setting @code{gc-cons-threshold} in that case!) -@end defopt - -@c Emacs 19 feature -@defun memory-limit -This function returns the address of the last byte XEmacs has allocated, -divided by 1024. We divide the value by 1024 to make sure it fits in a -Lisp integer. - -You can use this to get a general idea of how your actions affect the -memory usage. -@end defun - -@defvar pre-gc-hook -This is a normal hook to be run just before each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, -avoid consing, and do not interact with the user. -@end defvar - -@defvar post-gc-hook -This is a normal hook to be run just after each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, -avoid consing, and do not interact with the user. -@end defvar - -@defvar gc-message -This is a string to print to indicate that a garbage collection is in -progress. This is printed in the echo area. If the selected frame is -on a window system and @code{gc-pointer-glyph} specifies a value (i.e. a -pointer image instance) in the domain of the selected frame, the mouse -cursor will change instead of this message being printed. -@end defvar - -@defvr Glyph gc-pointer-glyph -This holds the pointer glyph used to indicate that a garbage collection -is in progress. If the selected window is on a window system and this -glyph specifies a value (i.e. a pointer image instance) in the domain of -the selected window, the cursor will be changed as specified during -garbage collection. Otherwise, a message will be printed in the echo -area, as controlled by @code{gc-message}. @xref{Glyphs}. -@end defvr - -If XEmacs was configured with @samp{--debug}, you can set the following -two variables to get direct information about all the allocation that -is happening in a segment of Lisp code. - -@defvar debug-allocation -If non-zero, print out information to stderr about all objects -allocated. -@end defvar - -@defvar debug-allocation-backtrace -Length (in stack frames) of short backtrace printed out by -@code{debug-allocation}. -@end defvar diff --git a/man/lispref/commands.texi b/man/lispref/commands.texi deleted file mode 100644 index 49b599c..0000000 --- a/man/lispref/commands.texi +++ /dev/null @@ -1,2422 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/commands.info -@node Command Loop, Keymaps, Minibuffers, Top -@chapter Command Loop -@cindex editor command loop -@cindex command loop - - When you run XEmacs, it enters the @dfn{editor command loop} almost -immediately. This loop reads events, executes their definitions, -and displays the results. In this chapter, we describe how these things -are done, and the subroutines that allow Lisp programs to do them. - -@menu -* Command Overview:: How the command loop reads commands. -* Defining Commands:: Specifying how a function should read arguments. -* Interactive Call:: Calling a command, so that it will read arguments. -* Command Loop Info:: Variables set by the command loop for you to examine. -* Events:: What input looks like when you read it. -* Reading Input:: How to read input events from the keyboard or mouse. -* Waiting:: Waiting for user input or elapsed time. -* Quitting:: How @kbd{C-g} works. How to catch or defer quitting. -* Prefix Command Arguments:: How the commands to set prefix args work. -* Recursive Editing:: Entering a recursive edit, - and why you usually shouldn't. -* Disabling Commands:: How the command loop handles disabled commands. -* Command History:: How the command history is set up, and how accessed. -* Keyboard Macros:: How keyboard macros are implemented. -@end menu - -@node Command Overview -@section Command Loop Overview - - The command loop in XEmacs is a standard event loop, reading events -one at a time with @code{next-event} and handling them with -@code{dispatch-event}. An event is typically a single user action, such -as a keypress, mouse movement, or menu selection; but they can also be -notifications from the window system, informing XEmacs that (for -example) part of its window was just uncovered and needs to be redrawn. -@xref{Events}. Pending events are held in a first-in, first-out list -called the @dfn{event queue}: events are read from the head of the list, -and newly arriving events are added to the tail. In this way, events -are always processed in the order in which they arrive. - - @code{dispatch-event} does most of the work of handling user actions. -The first thing it must do is put the events together into a key -sequence, which is a sequence of events that translates into a command. -It does this by consulting the active keymaps, which specify what the -valid key sequences are and how to translate them into commands. -@xref{Key Lookup}, for information on how this is done. The result of -the translation should be a keyboard macro or an interactively callable -function. If the key is @kbd{M-x}, then it reads the name of another -command, which it then calls. This is done by the command -@code{execute-extended-command} (@pxref{Interactive Call}). - - To execute a command requires first reading the arguments for it. -This is done by calling @code{command-execute} (@pxref{Interactive -Call}). For commands written in Lisp, the @code{interactive} -specification says how to read the arguments. This may use the prefix -argument (@pxref{Prefix Command Arguments}) or may read with prompting -in the minibuffer (@pxref{Minibuffers}). For example, the command -@code{find-file} has an @code{interactive} specification which says to -read a file name using the minibuffer. The command's function body does -not use the minibuffer; if you call this command from Lisp code as a -function, you must supply the file name string as an ordinary Lisp -function argument. - - If the command is a string or vector (i.e., a keyboard macro) then -@code{execute-kbd-macro} is used to execute it. You can call this -function yourself (@pxref{Keyboard Macros}). - - To terminate the execution of a running command, type @kbd{C-g}. This -character causes @dfn{quitting} (@pxref{Quitting}). - -@defvar pre-command-hook -The editor command loop runs this normal hook before each command. At -that time, @code{this-command} contains the command that is about to -run, and @code{last-command} describes the previous command. -@xref{Hooks}. -@end defvar - -@defvar post-command-hook -The editor command loop runs this normal hook after each command. (In -FSF Emacs, it is also run when the command loop is entered, or -reentered after an error or quit.) At that time, -@code{this-command} describes the command that just ran, and -@code{last-command} describes the command before that. @xref{Hooks}. -@end defvar - - Quitting is suppressed while running @code{pre-command-hook} and -@code{post-command-hook}. If an error happens while executing one of -these hooks, it terminates execution of the hook, but that is all it -does. - -@node Defining Commands -@section Defining Commands -@cindex defining commands -@cindex commands, defining -@cindex functions, making them interactive -@cindex interactive function - - A Lisp function becomes a command when its body contains, at top -level, a form that calls the special form @code{interactive}. This -form does nothing when actually executed, but its presence serves as a -flag to indicate that interactive calling is permitted. Its argument -controls the reading of arguments for an interactive call. - -@menu -* Using Interactive:: General rules for @code{interactive}. -* Interactive Codes:: The standard letter-codes for reading arguments - in various ways. -* Interactive Examples:: Examples of how to read interactive arguments. -@end menu - -@node Using Interactive -@subsection Using @code{interactive} - - This section describes how to write the @code{interactive} form that -makes a Lisp function an interactively-callable command. - -@defspec interactive arg-descriptor -@cindex argument descriptors -This special form declares that the function in which it appears is a -command, and that it may therefore be called interactively (via -@kbd{M-x} or by entering a key sequence bound to it). The argument -@var{arg-descriptor} declares how to compute the arguments to the -command when the command is called interactively. - -A command may be called from Lisp programs like any other function, but -then the caller supplies the arguments and @var{arg-descriptor} has no -effect. - -The @code{interactive} form has its effect because the command loop -(actually, its subroutine @code{call-interactively}) scans through the -function definition looking for it, before calling the function. Once -the function is called, all its body forms including the -@code{interactive} form are executed, but at this time -@code{interactive} simply returns @code{nil} without even evaluating its -argument. -@end defspec - -There are three possibilities for the argument @var{arg-descriptor}: - -@itemize @bullet -@item -It may be omitted or @code{nil}; then the command is called with no -arguments. This leads quickly to an error if the command requires one -or more arguments. - -@item -It may be a Lisp expression that is not a string; then it should be a -form that is evaluated to get a list of arguments to pass to the -command. -@cindex argument evaluation form - -If this expression reads keyboard input (this includes using the -minibuffer), keep in mind that the integer value of point or the mark -before reading input may be incorrect after reading input. This is -because the current buffer may be receiving subprocess output; -if subprocess output arrives while the command is waiting for input, -it could relocate point and the mark. - -Here's an example of what @emph{not} to do: - -@smallexample -(interactive - (list (region-beginning) (region-end) - (read-string "Foo: " nil 'my-history))) -@end smallexample - -@noindent -Here's how to avoid the problem, by examining point and the mark only -after reading the keyboard input: - -@smallexample -(interactive - (let ((string (read-string "Foo: " nil 'my-history))) - (list (region-beginning) (region-end) string))) -@end smallexample - -@item -@cindex argument prompt -It may be a string; then its contents should consist of a code character -followed by a prompt (which some code characters use and some ignore). -The prompt ends either with the end of the string or with a newline. -Here is a simple example: - -@smallexample -(interactive "bFrobnicate buffer: ") -@end smallexample - -@noindent -The code letter @samp{b} says to read the name of an existing buffer, -with completion. The buffer name is the sole argument passed to the -command. The rest of the string is a prompt. - -If there is a newline character in the string, it terminates the prompt. -If the string does not end there, then the rest of the string should -contain another code character and prompt, specifying another argument. -You can specify any number of arguments in this way. - -@c Emacs 19 feature -The prompt string can use @samp{%} to include previous argument values -(starting with the first argument) in the prompt. This is done using -@code{format} (@pxref{Formatting Strings}). For example, here is how -you could read the name of an existing buffer followed by a new name to -give to that buffer: - -@smallexample -@group -(interactive "bBuffer to rename: \nsRename buffer %s to: ") -@end group -@end smallexample - -@cindex @samp{*} in interactive -@cindex read-only buffers in interactive -If the first character in the string is @samp{*}, then an error is -signaled if the buffer is read-only. - -@cindex @samp{@@} in interactive -@c Emacs 19 feature -If the first character in the string is @samp{@@}, and if the key -sequence used to invoke the command includes any mouse events, then -the window associated with the first of those events is selected -before the command is run. - -@cindex @samp{_} in interactive -@c XEmacs feature -If the first character in the string is @samp{_}, then this command will -not cause the region to be deactivated when it completes; that is, -@code{zmacs-region-stays} will be set to @code{t} when the command exits -successfully. - -You can use @samp{*}, @samp{@@}, and @samp{_} together; the order does -not matter. Actual reading of arguments is controlled by the rest of -the prompt string (starting with the first character that is not -@samp{*}, @samp{@@}, or @samp{_}). -@end itemize - -@defun function-interactive function -This function retrieves the interactive specification of @var{function}, -which may be any funcallable object. The specification will be returned -as the list of the symbol @code{interactive} and the specs. If -@var{function} is not interactive, @code{nil} will be returned. -@end defun - -@node Interactive Codes -@subsection Code Characters for @code{interactive} -@cindex interactive code description -@cindex description for interactive codes -@cindex codes, interactive, description of -@cindex characters for interactive codes - - The code character descriptions below contain a number of key words, -defined here as follows: - -@table @b -@item Completion -@cindex interactive completion -Provide completion. @key{TAB}, @key{SPC}, and @key{RET} perform name -completion because the argument is read using @code{completing-read} -(@pxref{Completion}). @kbd{?} displays a list of possible completions. - -@item Existing -Require the name of an existing object. An invalid name is not -accepted; the commands to exit the minibuffer do not exit if the current -input is not valid. - -@item Default -@cindex default argument string -A default value of some sort is used if the user enters no text in the -minibuffer. The default depends on the code character. - -@item No I/O -This code letter computes an argument without reading any input. -Therefore, it does not use a prompt string, and any prompt string you -supply is ignored. - -Even though the code letter doesn't use a prompt string, you must follow -it with a newline if it is not the last code character in the string. - -@item Prompt -A prompt immediately follows the code character. The prompt ends either -with the end of the string or with a newline. - -@item Special -This code character is meaningful only at the beginning of the -interactive string, and it does not look for a prompt or a newline. -It is a single, isolated character. -@end table - -@cindex reading interactive arguments - Here are the code character descriptions for use with @code{interactive}: - -@table @samp -@item * -Signal an error if the current buffer is read-only. Special. - -@item @@ -Select the window mentioned in the first mouse event in the key -sequence that invoked this command. Special. - -@item _ -Do not cause the region to be deactivated when this command completes. -Special. - -@item a -A function name (i.e., a symbol satisfying @code{fboundp}). Existing, -Completion, Prompt. - -@item b -The name of an existing buffer. By default, uses the name of the -current buffer (@pxref{Buffers}). Existing, Completion, Default, -Prompt. - -@item B -A buffer name. The buffer need not exist. By default, uses the name of -a recently used buffer other than the current buffer. Completion, -Default, Prompt. - -@item c -A character. The cursor does not move into the echo area. Prompt. - -@item C -A command name (i.e., a symbol satisfying @code{commandp}). Existing, -Completion, Prompt. - -@item d -@cindex position argument -The position of point, as an integer (@pxref{Point}). No I/O. - -@item D -A directory name. The default is the current default directory of the -current buffer, @code{default-directory} (@pxref{System Environment}). -Existing, Completion, Default, Prompt. - -@item e -The last mouse-button or misc-user event in the key sequence that -invoked the command. No I/O. - -You can use @samp{e} more than once in a single command's interactive -specification. If the key sequence that invoked the command has @var{n} -mouse-button or misc-user events, the @var{n}th @samp{e} provides the -@var{n}th such event. - -@item f -A file name of an existing file (@pxref{File Names}). The default -directory is @code{default-directory}. Existing, Completion, Default, -Prompt. - -@item F -A file name. The file need not exist. Completion, Default, Prompt. - -@item k -A key sequence (@pxref{Keymap Terminology}). This keeps reading events -until a command (or undefined command) is found in the current key -maps. The key sequence argument is represented as a vector of events. -The cursor does not move into the echo area. Prompt. - -This kind of input is used by commands such as @code{describe-key} and -@code{global-set-key}. - -@item K -A key sequence, whose definition you intend to change. This works like -@samp{k}, except that it suppresses, for the last input event in the key -sequence, the conversions that are normally used (when necessary) to -convert an undefined key into a defined one. - -@item m -@cindex marker argument -The position of the mark, as an integer. No I/O. - -@item n -A number read with the minibuffer. If the input is not a number, the -user is asked to try again. The prefix argument, if any, is not used. -Prompt. - -@item N -@cindex raw prefix argument usage -The raw prefix argument. If the prefix argument is @code{nil}, then -read a number as with @kbd{n}. Requires a number. @xref{Prefix Command -Arguments}. Prompt. - -@item p -@cindex numeric prefix argument usage -The numeric prefix argument. (Note that this @samp{p} is lower case.) -No I/O. - -@item P -The raw prefix argument. (Note that this @samp{P} is upper case.) No -I/O. - -@item r -@cindex region argument -Point and the mark, as two numeric arguments, smallest first. This is -the only code letter that specifies two successive arguments rather than -one. No I/O. - -@item s -Arbitrary text, read in the minibuffer and returned as a string -(@pxref{Text from Minibuffer}). Terminate the input with either -@key{LFD} or @key{RET}. (@kbd{C-q} may be used to include either of -these characters in the input.) Prompt. - -@item S -An interned symbol whose name is read in the minibuffer. Any whitespace -character terminates the input. (Use @kbd{C-q} to include whitespace in -the string.) Other characters that normally terminate a symbol (e.g., -parentheses and brackets) do not do so here. Prompt. - -@item v -A variable declared to be a user option (i.e., satisfying the predicate -@code{user-variable-p}). @xref{High-Level Completion}. Existing, -Completion, Prompt. - -@item x -A Lisp object, specified with its read syntax, terminated with a -@key{LFD} or @key{RET}. The object is not evaluated. @xref{Object from -Minibuffer}. Prompt. - -@item X -@cindex evaluated expression argument -A Lisp form is read as with @kbd{x}, but then evaluated so that its -value becomes the argument for the command. Prompt. -@end table - -@node Interactive Examples -@subsection Examples of Using @code{interactive} -@cindex examples of using @code{interactive} -@cindex @code{interactive}, examples of using - - Here are some examples of @code{interactive}: - -@example -@group -(defun foo1 () ; @r{@code{foo1} takes no arguments,} - (interactive) ; @r{just moves forward two words.} - (forward-word 2)) - @result{} foo1 -@end group - -@group -(defun foo2 (n) ; @r{@code{foo2} takes one argument,} - (interactive "p") ; @r{which is the numeric prefix.} - (forward-word (* 2 n))) - @result{} foo2 -@end group - -@group -(defun foo3 (n) ; @r{@code{foo3} takes one argument,} - (interactive "nCount:") ; @r{which is read with the Minibuffer.} - (forward-word (* 2 n))) - @result{} foo3 -@end group - -@group -(defun three-b (b1 b2 b3) - "Select three existing buffers. -Put them into three windows, selecting the last one." -@end group - (interactive "bBuffer1:\nbBuffer2:\nbBuffer3:") - (delete-other-windows) - (split-window (selected-window) 8) - (switch-to-buffer b1) - (other-window 1) - (split-window (selected-window) 8) - (switch-to-buffer b2) - (other-window 1) - (switch-to-buffer b3)) - @result{} three-b -@group -(three-b "*scratch*" "declarations.texi" "*mail*") - @result{} nil -@end group -@end example - -@node Interactive Call -@section Interactive Call -@cindex interactive call - - After the command loop has translated a key sequence into a -definition, it invokes that definition using the function -@code{command-execute}. If the definition is a function that is a -command, @code{command-execute} calls @code{call-interactively}, which -reads the arguments and calls the command. You can also call these -functions yourself. - -@defun commandp object -Returns @code{t} if @var{object} is suitable for calling interactively; -that is, if @var{object} is a command. Otherwise, returns @code{nil}. - -The interactively callable objects include strings and vectors (treated -as keyboard macros), lambda expressions that contain a top-level call to -@code{interactive}, compiled-function objects made from such lambda -expressions, autoload objects that are declared as interactive -(non-@code{nil} fourth argument to @code{autoload}), and some of the -primitive functions. - -A symbol is @code{commandp} if its function definition is -@code{commandp}. - -Keys and keymaps are not commands. Rather, they are used to look up -commands (@pxref{Keymaps}). - -See @code{documentation} in @ref{Accessing Documentation}, for a -realistic example of using @code{commandp}. -@end defun - -@defun call-interactively command &optional record-flag -This function calls the interactively callable function @var{command}, -reading arguments according to its interactive calling specifications. -An error is signaled if @var{command} is not a function or if it cannot -be called interactively (i.e., is not a command). Note that keyboard -macros (strings and vectors) are not accepted, even though they are -considered commands, because they are not functions. - -@c XEmacs feature? -If @var{record-flag} is the symbol @code{lambda}, the interactive -calling arguments for @code{command} are read and returned as a list, -but the function is not called on them. - -@cindex record command history -If @var{record-flag} is @code{t}, then this command and its arguments -are unconditionally added to the list @code{command-history}. -Otherwise, the command is added only if it uses the minibuffer to read -an argument. @xref{Command History}. -@end defun - -@defun command-execute command &optional record-flag -@cindex keyboard macro execution -This function executes @var{command} as an editing command. The -argument @var{command} must satisfy the @code{commandp} predicate; i.e., -it must be an interactively callable function or a keyboard macro. - -A string or vector as @var{command} is executed with -@code{execute-kbd-macro}. A function is passed to -@code{call-interactively}, along with the optional @var{record-flag}. - -A symbol is handled by using its function definition in its place. A -symbol with an @code{autoload} definition counts as a command if it was -declared to stand for an interactively callable function. Such a -definition is handled by loading the specified library and then -rechecking the definition of the symbol. -@end defun - -@deffn Command execute-extended-command prefix-argument -@cindex read command name -This function reads a command name from the minibuffer using -@code{completing-read} (@pxref{Completion}). Then it uses -@code{command-execute} to call the specified command. Whatever that -command returns becomes the value of @code{execute-extended-command}. - -@cindex execute with prefix argument -If the command asks for a prefix argument, it receives the value -@var{prefix-argument}. If @code{execute-extended-command} is called -interactively, the current raw prefix argument is used for -@var{prefix-argument}, and thus passed on to whatever command is run. - -@c !!! Should this be @kindex? -@cindex @kbd{M-x} -@code{execute-extended-command} is the normal definition of @kbd{M-x}, -so it uses the string @w{@samp{M-x }} as a prompt. (It would be better -to take the prompt from the events used to invoke -@code{execute-extended-command}, but that is painful to implement.) A -description of the value of the prefix argument, if any, also becomes -part of the prompt. - -@example -@group -(execute-extended-command 1) ----------- Buffer: Minibuffer ---------- -1 M-x forward-word RET ----------- Buffer: Minibuffer ---------- - @result{} t -@end group -@end example -@end deffn - -@defun interactive-p -This function returns @code{t} if the containing function (the one that -called @code{interactive-p}) was called interactively, with the function -@code{call-interactively}. (It makes no difference whether -@code{call-interactively} was called from Lisp or directly from the -editor command loop.) If the containing function was called by Lisp -evaluation (or with @code{apply} or @code{funcall}), then it was not -called interactively. - -The most common use of @code{interactive-p} is for deciding whether to -print an informative message. As a special exception, -@code{interactive-p} returns @code{nil} whenever a keyboard macro is -being run. This is to suppress the informative messages and speed -execution of the macro. - -For example: - -@example -@group -(defun foo () - (interactive) - (and (interactive-p) - (message "foo"))) - @result{} foo -@end group - -@group -(defun bar () - (interactive) - (setq foobar (list (foo) (interactive-p)))) - @result{} bar -@end group - -@group -;; @r{Type @kbd{M-x foo}.} - @print{} foo -@end group - -@group -;; @r{Type @kbd{M-x bar}.} -;; @r{This does not print anything.} -@end group - -@group -foobar - @result{} (nil t) -@end group -@end example -@end defun - -@node Command Loop Info -@section Information from the Command Loop - -The editor command loop sets several Lisp variables to keep status -records for itself and for commands that are run. - -@defvar last-command -This variable records the name of the previous command executed by the -command loop (the one before the current command). Normally the value -is a symbol with a function definition, but this is not guaranteed. - -The value is copied from @code{this-command} when a command returns to -the command loop, except when the command specifies a prefix argument -for the following command. -@end defvar - -@defvar this-command -@cindex current command -This variable records the name of the command now being executed by -the editor command loop. Like @code{last-command}, it is normally a symbol -with a function definition. - -The command loop sets this variable just before running a command, and -copies its value into @code{last-command} when the command finishes -(unless the command specifies a prefix argument for the following -command). - -@cindex kill command repetition -Some commands set this variable during their execution, as a flag for -whatever command runs next. In particular, the functions for killing text -set @code{this-command} to @code{kill-region} so that any kill commands -immediately following will know to append the killed text to the -previous kill. -@end defvar - -If you do not want a particular command to be recognized as the previous -command in the case where it got an error, you must code that command to -prevent this. One way is to set @code{this-command} to @code{t} at the -beginning of the command, and set @code{this-command} back to its proper -value at the end, like this: - -@example -(defun foo (args@dots{}) - (interactive @dots{}) - (let ((old-this-command this-command)) - (setq this-command t) - @r{@dots{}do the work@dots{}} - (setq this-command old-this-command))) -@end example - -@defun this-command-keys -This function returns a vector containing the key and mouse events that -invoked the present command, plus any previous commands that generated -the prefix argument for this command. (Note: this is not the same as in -FSF Emacs, which can return a string.) @xref{Events}. - -This function copies the vector and the events; it is safe to keep and -modify them. - -@example -@group -(this-command-keys) -;; @r{Now use @kbd{C-u C-x C-e} to evaluate that.} - @result{} [# # #] -@end group -@end example -@end defun - -@ignore Not in XEmacs -@defvar last-nonmenu-event -This variable holds the last input event read as part of a key -sequence, not counting events resulting from mouse menus. - -One use of this variable is to figure out a good default location to -pop up another menu. -@end defvar -@end ignore - -@defvar last-command-event -This variable is set to the last input event that was read by the -command loop as part of a command. The principal use of this variable -is in @code{self-insert-command}, which uses it to decide which -character to insert. - -This variable is off limits: you may not set its value or modify the -event that is its value, as it is destructively modified by -@code{read-key-sequence}. If you want to keep a pointer to this value, -you must use @code{copy-event}. - -Note that this variable is an alias for @code{last-command-char} in -FSF Emacs. - -@example -@group -last-command-event -;; @r{Now type @kbd{C-u C-x C-e}.} - @result{} # -@end group -@end example -@end defvar - -@defvar last-command-char - -If the value of @code{last-command-event} is a keyboard event, then this -is the nearest character equivalent to it (or @code{nil} if there is no -character equivalent). @code{last-command-char} is the character that -@code{self-insert-command} will insert in the buffer. Remember that -there is @emph{not} a one-to-one mapping between keyboard events and -XEmacs characters: many keyboard events have no corresponding character, -and when the Mule feature is available, most characters can not be input -on standard keyboards, except possibly with help from an input method. -So writing code that examines this variable to determine what key has -been typed is bad practice, unless you are certain that it will be one -of a small set of characters. - -This variable exists for compatibility with Emacs version 18. - -@example -@group -last-command-char -;; @r{Now use @kbd{C-u C-x C-e} to evaluate that.} - @result{} ?\^E -@end group -@end example - -@end defvar - -@defvar current-mouse-event -This variable holds the mouse-button event which invoked this command, -or @code{nil}. This is what @code{(interactive "e")} returns. -@end defvar - -@defvar echo-keystrokes -This variable determines how much time should elapse before command -characters echo. Its value must be an integer, which specifies the -number of seconds to wait before echoing. If the user types a prefix -key (say @kbd{C-x}) and then delays this many seconds before continuing, -the key @kbd{C-x} is echoed in the echo area. Any subsequent characters -in the same command will be echoed as well. - -If the value is zero, then command input is not echoed. -@end defvar - -@node Events -@section Events -@cindex events -@cindex input events - -The XEmacs command loop reads a sequence of @dfn{events} that -represent keyboard or mouse activity. Unlike in Emacs 18 and in FSF -Emacs, events are a primitive Lisp type that must be manipulated -using their own accessor and settor primitives. This section describes -the representation and meaning of input events in detail. - -A key sequence that starts with a mouse event is read using the keymaps -of the buffer in the window that the mouse was in, not the current -buffer. This does not imply that clicking in a window selects that -window or its buffer---that is entirely under the control of the command -binding of the key sequence. - -For information about how exactly the XEmacs command loop works, -@xref{Reading Input}. - -@defun eventp object -This function returns non-@code{nil} if @var{event} is an input event. -@end defun - -@menu -* Event Types:: Events come in different types. -* Event Contents:: What the contents of each event type are. -* Event Predicates:: Querying whether an event is of a - particular type. -* Accessing Mouse Event Positions:: - Determining where a mouse event occurred, - and over what. -* Accessing Other Event Info:: Accessing non-positional event info. -* Working With Events:: Creating, copying, and destroying events. -* Converting Events:: Converting between events, keys, and - characters. -@end menu - -@node Event Types -@subsection Event Types - -Events represent keyboard or mouse activity or status changes of various -sorts, such as process input being available or a timeout being triggered. -The different event types are as follows: - -@table @asis -@item key-press event - A key was pressed. Note that modifier keys such as ``control'', ``shift'', -and ``alt'' do not generate events; instead, they are tracked internally -by XEmacs, and non-modifier key presses generate events that specify both -the key pressed and the modifiers that were held down at the time. - -@item button-press event -@itemx button-release event - A button was pressed or released. Along with the button that was pressed -or released, button events specify the modifier keys that were held down -at the time and the position of the pointer at the time. - -@item motion event - The pointer was moved. Along with the position of the pointer, these events -also specify the modifier keys that were held down at the time. - -@item misc-user event - A menu item was selected, the scrollbar was used, or a drag or a drop occurred. - -@item process event - Input is available on a process. - -@item timeout event - A timeout has triggered. - -@item magic event - Some window-system-specific action (such as a frame being resized or -a portion of a frame needing to be redrawn) has occurred. The contents -of this event are not accessible at the E-Lisp level, but -@code{dispatch-event} knows what to do with an event of this type. - -@item eval event - This is a special kind of event specifying that a particular function -needs to be called when this event is dispatched. An event of this type -is sometimes placed in the event queue when a magic event is processed. -This kind of event should generally just be passed off to -@code{dispatch-event}. @xref{Dispatching an Event}. -@end table - -@node Event Contents -@subsection Contents of the Different Types of Events - - Every event, no matter what type it is, contains a timestamp (which is -typically an offset in milliseconds from when the X server was started) -indicating when the event occurred. In addition, many events contain -a @dfn{channel}, which specifies which frame the event occurred on, -and/or a value indicating which modifier keys (shift, control, etc.) -were held down at the time of the event. - -The contents of each event are as follows: - -@table @asis -@item key-press event -@table @asis -@item channel -@item timestamp -@item key - Which key was pressed. This is an integer (in the printing @sc{ASCII} -range: >32 and <127) or a symbol such as @code{left} or @code{right}. -Note that many physical keys are actually treated as two separate keys, -depending on whether the shift key is pressed; for example, the ``a'' -key is treated as either ``a'' or ``A'' depending on the state of the -shift key, and the ``1'' key is similarly treated as either ``1'' or -``!'' on most keyboards. In such cases, the shift key does not show up -in the modifier list. For other keys, such as @code{backspace}, the -shift key shows up as a regular modifier. -@item modifiers - Which modifier keys were pressed. As mentioned above, the shift key -is not treated as a modifier for many keys and will not show up in this list -in such cases. -@end table - -@item button-press event -@itemx button-release event -@table @asis -@item channel -@item timestamp -@item button - What button went down or up. Buttons are numbered starting at 1. -@item modifiers - Which modifier keys were pressed. The special business mentioned above -for the shift key does @emph{not} apply to mouse events. -@item x -@itemx y - The position of the pointer (in pixels) at the time of the event. -@end table - -@item pointer-motion event -@table @asis -@item channel -@item timestamp -@item x -@itemx y - The position of the pointer (in pixels) after it moved. -@item modifiers - Which modifier keys were pressed. The special business mentioned above -for the shift key does @emph{not} apply to mouse events. -@end table - -@item misc-user event -@table @asis -@item timestamp -@item function - The E-Lisp function to call for this event. This is normally either -@code{eval} or @code{call-interactively}. -@item object - The object to pass to the function. This is normally the callback that -was specified in the menu description. -@item button - What button went down or up. Buttons are numbered starting at 1. -@item modifiers - Which modifier keys were pressed. The special business mentioned above -for the shift key does @emph{not} apply to mouse events. -@item x -@itemx y - The position of the pointer (in pixels) at the time of the event. -@end table - -@item process_event -@table @asis -@item timestamp -@item process - The Emacs ``process'' object in question. -@end table - -@item timeout event -@table @asis -@item timestamp -@item function - The E-Lisp function to call for this timeout. It is called with one -argument, the event. -@item object - Some Lisp object associated with this timeout, to make it easier to tell -them apart. The function and object for this event were specified when -the timeout was set. -@end table - -@item magic event -@table @asis -@item timestamp -@end table -(The rest of the information in this event is not user-accessible.) - -@item eval event -@table @asis -@item timestamp -@item function - An E-Lisp function to call when this event is dispatched. -@item object - The object to pass to the function. The function and object are set -when the event is created. -@end table -@end table - -@defun event-type event -Return the type of @var{event}. - -This will be a symbol; one of - -@table @code -@item key-press -A key was pressed. -@item button-press -A mouse button was pressed. -@item button-release -A mouse button was released. -@item motion -The mouse moved. -@item misc-user -Some other user action happened; typically, this is -a menu selection, scrollbar action, or drag and drop action. -@item process -Input is available from a subprocess. -@item timeout -A timeout has expired. -@item eval -This causes a specified action to occur when dispatched. -@item magic -Some window-system-specific event has occurred. -@end table -@end defun - -@node Event Predicates -@subsection Event Predicates - -The following predicates return whether an object is an event of a -particular type. - -@defun key-press-event-p object -This is true if @var{object} is a key-press event. -@end defun - -@defun button-event-p object object -This is true if @var{object} is a mouse button-press or button-release -event. -@end defun - -@defun button-press-event-p object -This is true if @var{object} is a mouse button-press event. -@end defun - -@defun button-release-event-p object -This is true if @var{object} is a mouse button-release event. -@end defun - -@defun motion-event-p object -This is true if @var{object} is a mouse motion event. -@end defun - -@defun mouse-event-p object -This is true if @var{object} is a mouse button-press, button-release -or motion event. -@end defun - -@defun eval-event-p object -This is true if @var{object} is an eval event. -@end defun - -@defun misc-user-event-p object -This is true if @var{object} is a misc-user event. -@end defun - -@defun process-event-p object -This is true if @var{object} is a process event. -@end defun - -@defun timeout-event-p object -This is true if @var{object} is a timeout event. -@end defun - -@defun event-live-p object -This is true if @var{object} is any event that has not been deallocated. -@end defun - -@node Accessing Mouse Event Positions -@subsection Accessing the Position of a Mouse Event - -Unlike other events, mouse events (i.e. motion, button-press, -button-release, and drag or drop type misc-user events) occur in a -particular location on the screen. Many primitives are provided for -determining exactly where the event occurred and what is under that -location. - -@menu -* Frame-Level Event Position Info:: -* Window-Level Event Position Info:: -* Event Text Position Info:: -* Event Glyph Position Info:: -* Event Toolbar Position Info:: -* Other Event Position Info:: -@end menu - -@node Frame-Level Event Position Info -@subsubsection Frame-Level Event Position Info - -The following functions return frame-level information about where -a mouse event occurred. - -@defun event-frame event -This function returns the ``channel'' or frame that the given mouse -motion, button press, button release, or misc-user event occurred in. -This will be @code{nil} for non-mouse events. -@end defun - -@defun event-x-pixel event -This function returns the X position in pixels of the given mouse event. -The value returned is relative to the frame the event occurred in. -This will signal an error if the event is not a mouse event. -@end defun - -@defun event-y-pixel event -This function returns the Y position in pixels of the given mouse event. -The value returned is relative to the frame the event occurred in. -This will signal an error if the event is not a mouse event. -@end defun - -@node Window-Level Event Position Info -@subsubsection Window-Level Event Position Info - -The following functions return window-level information about where -a mouse event occurred. - -@defun event-window event -Given a mouse motion, button press, button release, or misc-user event, compute and -return the window on which that event occurred. This may be @code{nil} -if the event occurred in the border or over a toolbar. The modeline is -considered to be within the window it describes. -@end defun - -@defun event-buffer event -Given a mouse motion, button press, button release, or misc-user event, compute and -return the buffer of the window on which that event occurred. This may -be @code{nil} if the event occurred in the border or over a toolbar. -The modeline is considered to be within the window it describes. This is -equivalent to calling @code{event-window} and then calling -@code{window-buffer} on the result if it is a window. -@end defun - -@defun event-window-x-pixel event -This function returns the X position in pixels of the given mouse event. -The value returned is relative to the window the event occurred in. -This will signal an error if the event is not a mouse-motion, button-press, -button-release, or misc-user event. -@end defun - -@defun event-window-y-pixel event -This function returns the Y position in pixels of the given mouse event. -The value returned is relative to the window the event occurred in. -This will signal an error if the event is not a mouse-motion, button-press, -button-release, or misc-user event. -@end defun - -@node Event Text Position Info -@subsubsection Event Text Position Info - -The following functions return information about the text (including the -modeline) that a mouse event occurred over or near. - -@defun event-over-text-area-p event -Given a mouse-motion, button-press, button-release, or misc-user event, this -function returns @code{t} if the event is over the text area of a -window. Otherwise, @code{nil} is returned. The modeline is not -considered to be part of the text area. -@end defun - -@defun event-over-modeline-p event -Given a mouse-motion, button-press, button-release, or misc-user event, this -function returns @code{t} if the event is over the modeline of a window. -Otherwise, @code{nil} is returned. -@end defun - -@defun event-x event -This function returns the X position of the given mouse-motion, -button-press, button-release, or misc-user event in characters. This is relative -to the window the event occurred over. -@end defun - -@defun event-y event -This function returns the Y position of the given mouse-motion, -button-press, button-release, or misc-user event in characters. This is relative -to the window the event occurred over. -@end defun - -@defun event-point event -This function returns the character position of the given mouse-motion, -button-press, button-release, or misc-user event. If the event did not occur over -a window, or did not occur over text, then this returns @code{nil}. -Otherwise, it returns an index into the buffer visible in the event's -window. -@end defun - -@defun event-closest-point event -This function returns the character position of the given mouse-motion, -button-press, button-release, or misc-user event. If the event did not occur over -a window or over text, it returns the closest point to the location of -the event. If the Y pixel position overlaps a window and the X pixel -position is to the left of that window, the closest point is the -beginning of the line containing the Y position. If the Y pixel -position overlaps a window and the X pixel position is to the right of -that window, the closest point is the end of the line containing the Y -position. If the Y pixel position is above a window, 0 is returned. If -it is below a window, the value of @code{(window-end)} is returned. -@end defun - -@node Event Glyph Position Info -@subsubsection Event Glyph Position Info - -The following functions return information about the glyph (if any) that -a mouse event occurred over. - -@defun event-over-glyph-p event -Given a mouse-motion, button-press, button-release, or misc-user event, this -function returns @code{t} if the event is over a glyph. Otherwise, -@code{nil} is returned. -@end defun - -@defun event-glyph-extent event -If the given mouse-motion, button-press, button-release, or misc-user event happened -on top of a glyph, this returns its extent; else @code{nil} is returned. -@end defun - -@defun event-glyph-x-pixel event -Given a mouse-motion, button-press, button-release, or misc-user event over a -glyph, this function returns the X position of the pointer relative to -the upper left of the glyph. If the event is not over a glyph, it returns -@code{nil}. -@end defun - -@defun event-glyph-y-pixel event -Given a mouse-motion, button-press, button-release, or misc-user event over a -glyph, this function returns the Y position of the pointer relative to -the upper left of the glyph. If the event is not over a glyph, it returns -@code{nil}. -@end defun - -@node Event Toolbar Position Info -@subsubsection Event Toolbar Position Info - -@defun event-over-toolbar-p event -Given a mouse-motion, button-press, button-release, or misc-user event, this -function returns @code{t} if the event is over a toolbar. Otherwise, -@code{nil} is returned. -@end defun - -@defun event-toolbar-button event -If the given mouse-motion, button-press, button-release, or misc-user event -happened on top of a toolbar button, this function returns the button. -Otherwise, @code{nil} is returned. -@end defun - -@node Other Event Position Info -@subsubsection Other Event Position Info - -@defun event-over-border-p event -Given a mouse-motion, button-press, button-release, or misc-user event, this -function returns @code{t} if the event is over an internal toolbar. -Otherwise, @code{nil} is returned. -@end defun - -@node Accessing Other Event Info -@subsection Accessing the Other Contents of Events - -The following functions allow access to the contents of events other than -the position info described in the previous section. - -@defun event-timestamp event -This function returns the timestamp of the given event object. -@end defun - -@defun event-device event -This function returns the device that the given event occurred on. -@end defun - -@defun event-key event -This function returns the Keysym of the given key-press event. -This will be the @sc{ASCII} code of a printing character, or a symbol. -@end defun - -@defun event-button event -This function returns the button-number of the given button-press or -button-release event. -@end defun - -@defun event-modifiers event -This function returns a list of symbols, the names of the modifier keys -which were down when the given mouse or keyboard event was produced. -@end defun - -@defun event-modifier-bits event -This function returns a number representing the modifier keys which were down -when the given mouse or keyboard event was produced. -@end defun - -@defun event-function event -This function returns the callback function of the given timeout, misc-user, -or eval event. -@end defun - -@defun event-object event -This function returns the callback function argument of the given timeout, -misc-user, or eval event. -@end defun - -@defun event-process event -This function returns the process of the given process event. -@end defun - -@node Working With Events -@subsection Working With Events - -XEmacs provides primitives for creating, copying, and destroying event -objects. Many functions that return events take an event object as an -argument and fill in the fields of this event; or they make accept -either an event object or @code{nil}, creating the event object first in -the latter case. - -@defun make-event &optional type plist -This function creates a new event structure. If no arguments are -specified, the created event will be empty. To specify the event type, -use the @var{type} argument. The allowed types are @code{empty}, -@code{key-press}, @code{button-press}, @code{button-release}, -@code{motion}, or @code{misc-user}. - -@var{plist} is a property list, the properties being compatible to those -returned by @code{event-properties}. For events other than -@code{empty}, it is mandatory to specify certain properties. For -@code{empty} events, @var{plist} must be @code{nil}. The list is -@dfn{canonicalized}, which means that if a property keyword is present -more than once, only the first instance is taken into account. -Specifying an unknown or illegal property signals an error. - -The following properties are allowed: - -@table @b -@item @code{channel} -The event channel. This is a frame or a console. For mouse events (of -type @code{button-press}, @code{button-release} and @code{motion}), this -must be a frame. For key-press events, it must be a console. If -channel is unspecified by @var{plist}, it will be set to the selected -frame or selected console, as appropriate. - -@item @code{key} -The event key. This is either a symbol or a character. It is allowed -(and required) only for key-press events. - -@item @code{button} -The event button. This an integer, either 1, 2 or 3. It is allowed -only for button-press and button-release events. - -@item @code{modifiers} -The event modifiers. This is a list of modifier symbols. It is allowed -for key-press, button-press, button-release and motion events. - -@item @code{x} -The event X coordinate. This is an integer. It is relative to the -channel's root window, and is allowed for button-press, button-release -and motion events. - -@item @code{y} -The event Y coordinate. This is an integer. It is relative to the -channel's root window, and is allowed for button-press, button-release -and motion events. This means that, for instance, to access the -toolbar, the @code{y} property will have to be negative. - -@item @code{timestamp} -The event timestamp, a non-negative integer. Allowed for all types of -events. -@end table - -@emph{WARNING}: the event object returned by this function may be a -reused one; see the function @code{deallocate-event}. - -The events created by @code{make-event} can be used as non-interactive -arguments to the functions with an @code{(interactive "e")} -specification. - -Here are some basic examples of usage: - -@lisp -@group -;; @r{Create an empty event.} -(make-event) - @result{} # -@end group - -@group -;; @r{Try creating a key-press event.} -(make-event 'key-press) - @error{} Undefined key for keypress event -@end group - -@group -;; @r{Creating a key-press event, try 2} -(make-event 'key-press '(key home)) - @result{} # -@end group - -@group -;; @r{Create a key-press event of dubious fame.} -(make-event 'key-press '(key escape modifiers (meta alt control shift))) - @result{} # -@end group - -@group -;; @r{Create a M-button1 event at coordinates defined by variables} -;; @r{@var{x} and @var{y}.} -(make-event 'button-press `(button 1 modifiers (meta) x ,x y ,y)) - @result{} # -@end group - -@group -;; @r{Create a similar button-release event.} -(make-event 'button-release `(button 1 modifiers (meta) x ,x y ,x)) - @result{} # -@end group - -@group -;; @r{Create a mouse-motion event.} -(make-event 'motion '(x 20 y 30)) - @result{} # - -(event-properties (make-event 'motion '(x 20 y 30))) - @result{} (channel # x 20 y 30 - modifiers nil timestamp 0) -@end group -@end lisp - -In conjunction with @code{event-properties}, you can use -@code{make-event} to create modified copies of existing events. For -instance, the following code will return an @code{equal} copy of -@var{event}: - -@lisp -(make-event (event-type @var{event}) - (event-properties @var{event})) -@end lisp - -Note, however, that you cannot use @code{make-event} as the generic -replacement for @code{copy-event}, because it does not allow creating -all of the event types. - -To create a modified copy of an event, you can use the canonicalization -feature of @var{plist}. The following example creates a copy of -@var{event}, but with @code{modifiers} reset to @code{nil}. - -@lisp -(make-event (event-type @var{event}) - (append '(modifiers nil) - (event-properties @var{event}))) -@end lisp -@end defun - -@defun copy-event event1 &optional event2 -This function makes a copy of the given event object. If a second -argument is given, the first event is copied into the second and the -second is returned. If the second argument is not supplied (or is -@code{nil}) then a new event will be made. -@end defun - -@defun deallocate-event event -This function allows the given event structure to be reused. You -@strong{MUST NOT} use this event object after calling this function with -it. You will lose. It is not necessary to call this function, as event -objects are garbage-collected like all other objects; however, it may be -more efficient to explicitly deallocate events when you are sure that -that is safe. -@end defun - -@node Converting Events -@subsection Converting Events - -XEmacs provides some auxiliary functions for converting between events -and other ways of representing keys. These are useful when working with -@sc{ASCII} strings and with keymaps. - -@defun character-to-event ch &optional event device -This function converts a numeric @sc{ASCII} value to an event structure, -replete with modifier bits. @var{ch} is the character to convert, and -@var{event} is the event object to fill in. This function contains -knowledge about what the codes ``mean'' -- for example, the number 9 is -converted to the character @key{Tab}, not the distinct character -@key{Control-I}. - -Note that @var{ch} does not have to be a numeric value, but can be a -symbol such as @code{clear} or a list such as @code{(control -backspace)}. - -If @code{event} is not @code{nil}, it is modified; otherwise, a -new event object is created. In both cases, the event is returned. - -Optional third arg @var{device} is the device to store in the event; -this also affects whether the high bit is interpreted as a meta key. A -value of @code{nil} means use the selected device but always treat the -high bit as meta. - -Beware that @code{character-to-event} and @code{event-to-character} are -not strictly inverse functions, since events contain much more -information than the @sc{ASCII} character set can encode. -@end defun - -@defun event-to-character event &optional allow-extra-modifiers allow-meta allow-non-ascii -This function returns the closest @sc{ASCII} approximation to -@var{event}. If the event isn't a keypress, this returns @code{nil}. - -If @var{allow-extra-modifiers} is non-@code{nil}, then this is lenient -in its translation; it will ignore modifier keys other than -@key{control} and @key{meta}, and will ignore the @key{shift} modifier -on those characters which have no shifted @sc{ASCII} equivalent -(@key{Control-Shift-A} for example, will be mapped to the same -@sc{ASCII} code as @key{Control-A}). - -If @var{allow-meta} is non-@code{nil}, then the @key{Meta} modifier will -be represented by turning on the high bit of the byte returned; -otherwise, @code{nil} will be returned for events containing the -@key{Meta} modifier. - -If @var{allow-non-ascii} is non-@code{nil}, then characters which are -present in the prevailing character set (@pxref{Keymaps, variable -@code{character-set-property}}) will be returned as their code in that -character set, instead of the return value being restricted to -@sc{ASCII}. - -Note that specifying both @var{allow-meta} and @var{allow-non-ascii} is -ambiguous, as both use the high bit; @key{M-x} and @key{oslash} will be -indistinguishable. -@end defun - -@defun events-to-keys events &optional no-mice -Given a vector of event objects, this function returns a vector of key -descriptors, or a string (if they all fit in the @sc{ASCII} range). -Optional arg @var{no-mice} means that button events are not allowed. -@end defun - -@node Reading Input -@section Reading Input - - The editor command loop reads keyboard input using the function -@code{next-event} and constructs key sequences out of the events using -@code{dispatch-event}. Lisp programs can also use the function -@code{read-key-sequence}, which reads input a key sequence at a time. -See also @code{momentary-string-display} in @ref{Temporary Displays}, -and @code{sit-for} in @ref{Waiting}. @xref{Terminal Input}, for -functions and variables for controlling terminal input modes and -debugging terminal input. - - For higher-level input facilities, see @ref{Minibuffers}. - -@menu -* Key Sequence Input:: How to read one key sequence. -* Reading One Event:: How to read just one event. -* Dispatching an Event:: What to do with an event once it has been read. -* Quoted Character Input:: Asking the user to specify a character. -* Peeking and Discarding:: How to reread or throw away input events. -@end menu - -@node Key Sequence Input -@subsection Key Sequence Input -@cindex key sequence input - -Lisp programs can read input a key sequence at a time by calling -@code{read-key-sequence}; for example, @code{describe-key} uses it to -read the key to describe. - -@defun read-key-sequence prompt -@cindex key sequence -This function reads a sequence of keystrokes or mouse clicks and returns -it as a vector of events. It keeps reading events until it has -accumulated a full key sequence; that is, enough to specify a non-prefix -command using the currently active keymaps. - -The vector and the event objects it contains are freshly created, and -will not be side-effected by subsequent calls to this function. - -The function @code{read-key-sequence} suppresses quitting: @kbd{C-g} -typed while reading with this function works like any other character, -and does not set @code{quit-flag}. @xref{Quitting}. - -The argument @var{prompt} is either a string to be displayed in the echo -area as a prompt, or @code{nil}, meaning not to display a prompt. - -@c XEmacs feature -If the user selects a menu item while we are prompting for a key -sequence, the returned value will be a vector of a single menu-selection -event (a misc-user event). An error will be signalled if you pass this -value to @code{lookup-key} or a related function. - -In the example below, the prompt @samp{?} is displayed in the echo area, -and the user types @kbd{C-x C-f}. - -@example -(read-key-sequence "?") - -@group ----------- Echo Area ---------- -?@kbd{C-x C-f} ----------- Echo Area ---------- - - @result{} [# #] -@end group -@end example -@end defun - -@ignore @c Not in XEmacs -@defvar num-input-keys -@c Emacs 19 feature -This variable's value is the number of key sequences processed so far in -this XEmacs session. This includes key sequences read from the terminal -and key sequences read from keyboard macros being executed. -@end defvar -@end ignore - -@cindex upper case key sequence -@cindex downcasing in @code{lookup-key} -If an input character is an upper-case letter and has no key binding, -but its lower-case equivalent has one, then @code{read-key-sequence} -converts the character to lower case. Note that @code{lookup-key} does -not perform case conversion in this way. - -@node Reading One Event -@subsection Reading One Event - - The lowest level functions for command input are those which read a -single event. These functions often make a distinction between -@dfn{command events}, which are user actions (keystrokes and mouse -actions), and other events, which serve as communication between -XEmacs and the window system. - -@defun next-event &optional event prompt -This function reads and returns the next available event from the window -system or terminal driver, waiting if necessary until an event is -available. Pass this object to @code{dispatch-event} to handle it. If -an event object is supplied, it is filled in and returned; otherwise a -new event object will be created. - -Events can come directly from the user, from a keyboard macro, or from -@code{unread-command-events}. - -In most cases, the function @code{next-command-event} is more -appropriate. -@end defun - -@defun next-command-event &optional event -This function returns the next available ``user'' event from the window -system or terminal driver. Pass this object to @code{dispatch-event} to -handle it. If an event object is supplied, it is filled in and -returned, otherwise a new event object will be created. - -The event returned will be a keyboard, mouse press, or mouse release -event. If there are non-command events available (mouse motion, -sub-process output, etc) then these will be executed (with -@code{dispatch-event}) and discarded. This function is provided as a -convenience; it is equivalent to the Lisp code - -@lisp -@group - (while (progn - (next-event event) - (not (or (key-press-event-p event) - (button-press-event-p event) - (button-release-event-p event) - (menu-event-p event)))) - (dispatch-event event)) -@end group -@end lisp - -Here is what happens if you call @code{next-command-event} and then -press the right-arrow function key: - -@example -@group -(next-command-event) - @result{} # -@end group -@end example -@end defun - -@defun read-char -This function reads and returns a character of command input. If a -mouse click is detected, an error is signalled. The character typed is -returned as an @sc{ASCII} value. This function is retained for -compatibility with Emacs 18, and is most likely the wrong thing for you -to be using: consider using @code{next-command-event} instead. -@end defun - -@defun enqueue-eval-event function object -This function adds an eval event to the back of the queue. The -eval event will be the next event read after all pending events. -@end defun - -@node Dispatching an Event -@subsection Dispatching an Event -@cindex dispatching an event - -@defun dispatch-event event -Given an event object returned by @code{next-event}, this function -executes it. This is the basic function that makes XEmacs respond to -user input; it also deals with notifications from the window system -(such as Expose events). -@end defun - -@node Quoted Character Input -@subsection Quoted Character Input -@cindex quoted character input - - You can use the function @code{read-quoted-char} to ask the user to -specify a character, and allow the user to specify a control or meta -character conveniently, either literally or as an octal character code. -The command @code{quoted-insert} uses this function. - -@defun read-quoted-char &optional prompt -@cindex octal character input -@cindex control characters, reading -@cindex nonprinting characters, reading -This function is like @code{read-char}, except that if the first -character read is an octal digit (0-7), it reads up to two more octal digits -(but stopping if a non-octal digit is found) and returns the -character represented by those digits in octal. - -Quitting is suppressed when the first character is read, so that the -user can enter a @kbd{C-g}. @xref{Quitting}. - -If @var{prompt} is supplied, it specifies a string for prompting the -user. The prompt string is always displayed in the echo area, followed -by a single @samp{-}. - -In the following example, the user types in the octal number 177 (which -is 127 in decimal). - -@example -(read-quoted-char "What character") - -@group ----------- Echo Area ---------- -What character-@kbd{177} ----------- Echo Area ---------- - - @result{} 127 -@end group -@end example -@end defun - -@need 2000 -@node Peeking and Discarding -@subsection Miscellaneous Event Input Features - -This section describes how to ``peek ahead'' at events without using -them up, how to check for pending input, and how to discard pending -input. - -See also the variables @code{last-command-event} and @code{last-command-char} -(@ref{Command Loop Info}). - -@defvar unread-command-events -@cindex next input -@cindex peeking at input -This variable holds a list of events waiting to be read as command -input. The events are used in the order they appear in the list, and -removed one by one as they are used. - -The variable is needed because in some cases a function reads a event -and then decides not to use it. Storing the event in this variable -causes it to be processed normally, by the command loop or by the -functions to read command input. - -@cindex prefix argument unreading -For example, the function that implements numeric prefix arguments reads -any number of digits. When it finds a non-digit event, it must unread -the event so that it can be read normally by the command loop. -Likewise, incremental search uses this feature to unread events with no -special meaning in a search, because these events should exit the search -and then execute normally. - -@ignore FSF Emacs stuff -The reliable and easy way to extract events from a key sequence so as to -put them in @code{unread-command-events} is to use -@code{listify-key-sequence} (@pxref{Strings of Events}). -@end ignore -@end defvar - -@defvar unread-command-event -This variable holds a single event to be read as command input. - -This variable is mostly obsolete now that you can use -@code{unread-command-events} instead; it exists only to support programs -written for versions of XEmacs prior to 19.12. -@end defvar - -@defun input-pending-p -@cindex waiting for command key input -This function determines whether any command input is currently -available to be read. It returns immediately, with value @code{t} if -there is available input, @code{nil} otherwise. On rare occasions it -may return @code{t} when no input is available. -@end defun - -@defvar last-input-event -This variable is set to the last keyboard or mouse button event received. - -This variable is off limits: you may not set its value or modify the -event that is its value, as it is destructively modified by -@code{read-key-sequence}. If you want to keep a pointer to this value, -you must use @code{copy-event}. - -Note that this variable is an alias for @code{last-input-char} in -FSF Emacs. - -In the example below, a character is read (the character @kbd{1}). It -becomes the value of @code{last-input-event}, while @kbd{C-e} (from the -@kbd{C-x C-e} command used to evaluate this expression) remains the -value of @code{last-command-event}. - -@example -@group -(progn (print (next-command-event)) - (print last-command-event) - last-input-event) - @print{} # - @print{} # - @result{} # - -@end group -@end example -@end defvar - -@defvar last-input-char -If the value of @code{last-input-event} is a keyboard event, then this -is the nearest @sc{ASCII} equivalent to it. Remember that there is -@emph{not} a 1:1 mapping between keyboard events and @sc{ASCII} -characters: the set of keyboard events is much larger, so writing code -that examines this variable to determine what key has been typed is bad -practice, unless you are certain that it will be one of a small set of -characters. - -This function exists for compatibility with Emacs version 18. -@end defvar - -@defun discard-input -@cindex flush input -@cindex discard input -@cindex terminate keyboard macro -This function discards the contents of the terminal input buffer and -cancels any keyboard macro that might be in the process of definition. -It returns @code{nil}. - -In the following example, the user may type a number of characters right -after starting the evaluation of the form. After the @code{sleep-for} -finishes sleeping, @code{discard-input} discards any characters typed -during the sleep. - -@example -(progn (sleep-for 2) - (discard-input)) - @result{} nil -@end example -@end defun - -@node Waiting -@section Waiting for Elapsed Time or Input -@cindex pausing -@cindex waiting - - The wait functions are designed to wait for a certain amount of time -to pass or until there is input. For example, you may wish to pause in -the middle of a computation to allow the user time to view the display. -@code{sit-for} pauses and updates the screen, and returns immediately if -input comes in, while @code{sleep-for} pauses without updating the -screen. - -Note that in FSF Emacs, the commands @code{sit-for} and @code{sleep-for} -take two arguments to specify the time (one integer and one float -value), instead of a single argument that can be either an integer or a -float. - -@defun sit-for seconds &optional nodisp -This function performs redisplay (provided there is no pending input -from the user), then waits @var{seconds} seconds, or until input is -available. The result is @code{t} if @code{sit-for} waited the full -time with no input arriving (see @code{input-pending-p} in @ref{Peeking -and Discarding}). Otherwise, the value is @code{nil}. - -The argument @var{seconds} need not be an integer. If it is a floating -point number, @code{sit-for} waits for a fractional number of seconds. -@ignore FSF Emacs stuff -Some systems support only a whole number of seconds; on these systems, -@var{seconds} is rounded down. - -The optional argument @var{millisec} specifies an additional waiting -period measured in milliseconds. This adds to the period specified by -@var{seconds}. If the system doesn't support waiting fractions of a -second, you get an error if you specify nonzero @var{millisec}. -@end ignore - -@cindex forcing redisplay -Redisplay is normally preempted if input arrives, and does not happen at -all if input is available before it starts. (You can force screen -updating in such a case by using @code{force-redisplay}. @xref{Refresh -Screen}.) If there is no input pending, you can force an update with no -delay by using @code{(sit-for 0)}. - -If @var{nodisp} is non-@code{nil}, then @code{sit-for} does not -redisplay, but it still returns as soon as input is available (or when -the timeout elapses). - -@ignore -Iconifying or deiconifying a frame makes @code{sit-for} return, because -that generates an event. @xref{Misc Events}. -@end ignore - -The usual purpose of @code{sit-for} is to give the user time to read -text that you display. -@end defun - -@defun sleep-for seconds -This function simply pauses for @var{seconds} seconds without updating -the display. This function pays no attention to available input. It -returns @code{nil}. - -The argument @var{seconds} need not be an integer. If it is a floating -point number, @code{sleep-for} waits for a fractional number of seconds. -@ignore FSF Emacs stuff -Some systems support only a whole number of seconds; on these systems, -@var{seconds} is rounded down. - -The optional argument @var{millisec} specifies an additional waiting -period measured in milliseconds. This adds to the period specified by -@var{seconds}. If the system doesn't support waiting fractions of a -second, you get an error if you specify nonzero @var{millisec}. -@end ignore - -Use @code{sleep-for} when you wish to guarantee a delay. -@end defun - - @xref{Time of Day}, for functions to get the current time. - -@node Quitting -@section Quitting -@cindex @kbd{C-g} -@cindex quitting - - Typing @kbd{C-g} while a Lisp function is running causes XEmacs to -@dfn{quit} whatever it is doing. This means that control returns to the -innermost active command loop. - - Typing @kbd{C-g} while the command loop is waiting for keyboard input -does not cause a quit; it acts as an ordinary input character. In the -simplest case, you cannot tell the difference, because @kbd{C-g} -normally runs the command @code{keyboard-quit}, whose effect is to quit. -However, when @kbd{C-g} follows a prefix key, the result is an undefined -key. The effect is to cancel the prefix key as well as any prefix -argument. - - In the minibuffer, @kbd{C-g} has a different definition: it aborts out -of the minibuffer. This means, in effect, that it exits the minibuffer -and then quits. (Simply quitting would return to the command loop -@emph{within} the minibuffer.) The reason why @kbd{C-g} does not quit -directly when the command reader is reading input is so that its meaning -can be redefined in the minibuffer in this way. @kbd{C-g} following a -prefix key is not redefined in the minibuffer, and it has its normal -effect of canceling the prefix key and prefix argument. This too -would not be possible if @kbd{C-g} always quit directly. - - When @kbd{C-g} does directly quit, it does so by setting the variable -@code{quit-flag} to @code{t}. XEmacs checks this variable at appropriate -times and quits if it is not @code{nil}. Setting @code{quit-flag} -non-@code{nil} in any way thus causes a quit. - - At the level of C code, quitting cannot happen just anywhere; only at the -special places that check @code{quit-flag}. The reason for this is -that quitting at other places might leave an inconsistency in XEmacs's -internal state. Because quitting is delayed until a safe place, quitting -cannot make XEmacs crash. - - Certain functions such as @code{read-key-sequence} or -@code{read-quoted-char} prevent quitting entirely even though they wait -for input. Instead of quitting, @kbd{C-g} serves as the requested -input. In the case of @code{read-key-sequence}, this serves to bring -about the special behavior of @kbd{C-g} in the command loop. In the -case of @code{read-quoted-char}, this is so that @kbd{C-q} can be used -to quote a @kbd{C-g}. - - You can prevent quitting for a portion of a Lisp function by binding -the variable @code{inhibit-quit} to a non-@code{nil} value. Then, -although @kbd{C-g} still sets @code{quit-flag} to @code{t} as usual, the -usual result of this---a quit---is prevented. Eventually, -@code{inhibit-quit} will become @code{nil} again, such as when its -binding is unwound at the end of a @code{let} form. At that time, if -@code{quit-flag} is still non-@code{nil}, the requested quit happens -immediately. This behavior is ideal when you wish to make sure that -quitting does not happen within a ``critical section'' of the program. - -@cindex @code{read-quoted-char} quitting - In some functions (such as @code{read-quoted-char}), @kbd{C-g} is -handled in a special way that does not involve quitting. This is done -by reading the input with @code{inhibit-quit} bound to @code{t}, and -setting @code{quit-flag} to @code{nil} before @code{inhibit-quit} -becomes @code{nil} again. This excerpt from the definition of -@code{read-quoted-char} shows how this is done; it also shows that -normal quitting is permitted after the first character of input. - -@example -(defun read-quoted-char (&optional prompt) - "@dots{}@var{documentation}@dots{}" - (let ((count 0) (code 0) char) - (while (< count 3) - (let ((inhibit-quit (zerop count)) - (help-form nil)) - (and prompt (message "%s-" prompt)) - (setq char (read-char)) - (if inhibit-quit (setq quit-flag nil))) - @dots{}) - (logand 255 code))) -@end example - -@defvar quit-flag -If this variable is non-@code{nil}, then XEmacs quits immediately, unless -@code{inhibit-quit} is non-@code{nil}. Typing @kbd{C-g} ordinarily sets -@code{quit-flag} non-@code{nil}, regardless of @code{inhibit-quit}. -@end defvar - -@defvar inhibit-quit -This variable determines whether XEmacs should quit when @code{quit-flag} -is set to a value other than @code{nil}. If @code{inhibit-quit} is -non-@code{nil}, then @code{quit-flag} has no special effect. -@end defvar - -@deffn Command keyboard-quit -This function signals the @code{quit} condition with @code{(signal 'quit -nil)}. This is the same thing that quitting does. (See @code{signal} -in @ref{Errors}.) -@end deffn - - You can specify a character other than @kbd{C-g} to use for quitting. -See the function @code{set-input-mode} in @ref{Terminal Input}. - -@node Prefix Command Arguments -@section Prefix Command Arguments -@cindex prefix argument -@cindex raw prefix argument -@cindex numeric prefix argument - - Most XEmacs commands can use a @dfn{prefix argument}, a number -specified before the command itself. (Don't confuse prefix arguments -with prefix keys.) The prefix argument is at all times represented by a -value, which may be @code{nil}, meaning there is currently no prefix -argument. Each command may use the prefix argument or ignore it. - - There are two representations of the prefix argument: @dfn{raw} and -@dfn{numeric}. The editor command loop uses the raw representation -internally, and so do the Lisp variables that store the information, but -commands can request either representation. - - Here are the possible values of a raw prefix argument: - -@itemize @bullet -@item -@code{nil}, meaning there is no prefix argument. Its numeric value is -1, but numerous commands make a distinction between @code{nil} and the -integer 1. - -@item -An integer, which stands for itself. - -@item -A list of one element, which is an integer. This form of prefix -argument results from one or a succession of @kbd{C-u}'s with no -digits. The numeric value is the integer in the list, but some -commands make a distinction between such a list and an integer alone. - -@item -The symbol @code{-}. This indicates that @kbd{M--} or @kbd{C-u -} was -typed, without following digits. The equivalent numeric value is -@minus{}1, but some commands make a distinction between the integer -@minus{}1 and the symbol @code{-}. -@end itemize - -We illustrate these possibilities by calling the following function with -various prefixes: - -@example -@group -(defun display-prefix (arg) - "Display the value of the raw prefix arg." - (interactive "P") - (message "%s" arg)) -@end group -@end example - -@noindent -Here are the results of calling @code{display-prefix} with various -raw prefix arguments: - -@example - M-x display-prefix @print{} nil - -C-u M-x display-prefix @print{} (4) - -C-u C-u M-x display-prefix @print{} (16) - -C-u 3 M-x display-prefix @print{} 3 - -M-3 M-x display-prefix @print{} 3 ; @r{(Same as @code{C-u 3}.)} - -C-3 M-x display-prefix @print{} 3 ; @r{(Same as @code{C-u 3}.)} - -C-u - M-x display-prefix @print{} - - -M-- M-x display-prefix @print{} - ; @r{(Same as @code{C-u -}.)} - -C-- M-x display-prefix @print{} - ; @r{(Same as @code{C-u -}.)} - -C-u - 7 M-x display-prefix @print{} -7 - -M-- 7 M-x display-prefix @print{} -7 ; @r{(Same as @code{C-u -7}.)} - -C-- 7 M-x display-prefix @print{} -7 ; @r{(Same as @code{C-u -7}.)} -@end example - - XEmacs uses two variables to store the prefix argument: -@code{prefix-arg} and @code{current-prefix-arg}. Commands such as -@code{universal-argument} that set up prefix arguments for other -commands store them in @code{prefix-arg}. In contrast, -@code{current-prefix-arg} conveys the prefix argument to the current -command, so setting it has no effect on the prefix arguments for future -commands. - - Normally, commands specify which representation to use for the prefix -argument, either numeric or raw, in the @code{interactive} declaration. -(@xref{Using Interactive}.) Alternatively, functions may look at the -value of the prefix argument directly in the variable -@code{current-prefix-arg}, but this is less clean. - -@defun prefix-numeric-value arg -This function returns the numeric meaning of a valid raw prefix argument -value, @var{arg}. The argument may be a symbol, a number, or a list. -If it is @code{nil}, the value 1 is returned; if it is @code{-}, the -value @minus{}1 is returned; if it is a number, that number is returned; -if it is a list, the @sc{car} of that list (which should be a number) is -returned. -@end defun - -@defvar current-prefix-arg -This variable holds the raw prefix argument for the @emph{current} -command. Commands may examine it directly, but the usual way to access -it is with @code{(interactive "P")}. -@end defvar - -@defvar prefix-arg -The value of this variable is the raw prefix argument for the -@emph{next} editing command. Commands that specify prefix arguments for -the following command work by setting this variable. -@end defvar - - Do not call the functions @code{universal-argument}, -@code{digit-argument}, or @code{negative-argument} unless you intend to -let the user enter the prefix argument for the @emph{next} command. - -@deffn Command universal-argument -This command reads input and specifies a prefix argument for the -following command. Don't call this command yourself unless you know -what you are doing. -@end deffn - -@deffn Command digit-argument arg -This command adds to the prefix argument for the following command. The -argument @var{arg} is the raw prefix argument as it was before this -command; it is used to compute the updated prefix argument. Don't call -this command yourself unless you know what you are doing. -@end deffn - -@deffn Command negative-argument arg -This command adds to the numeric argument for the next command. The -argument @var{arg} is the raw prefix argument as it was before this -command; its value is negated to form the new prefix argument. Don't -call this command yourself unless you know what you are doing. -@end deffn - -@node Recursive Editing -@section Recursive Editing -@cindex recursive command loop -@cindex recursive editing level -@cindex command loop, recursive - - The XEmacs command loop is entered automatically when XEmacs starts up. -This top-level invocation of the command loop never exits; it keeps -running as long as XEmacs does. Lisp programs can also invoke the -command loop. Since this makes more than one activation of the command -loop, we call it @dfn{recursive editing}. A recursive editing level has -the effect of suspending whatever command invoked it and permitting the -user to do arbitrary editing before resuming that command. - - The commands available during recursive editing are the same ones -available in the top-level editing loop and defined in the keymaps. -Only a few special commands exit the recursive editing level; the others -return to the recursive editing level when they finish. (The special -commands for exiting are always available, but they do nothing when -recursive editing is not in progress.) - - All command loops, including recursive ones, set up all-purpose error -handlers so that an error in a command run from the command loop will -not exit the loop. - -@cindex minibuffer input - Minibuffer input is a special kind of recursive editing. It has a few -special wrinkles, such as enabling display of the minibuffer and the -minibuffer window, but fewer than you might suppose. Certain keys -behave differently in the minibuffer, but that is only because of the -minibuffer's local map; if you switch windows, you get the usual XEmacs -commands. - -@cindex @code{throw} example -@kindex exit -@cindex exit recursive editing -@cindex aborting - To invoke a recursive editing level, call the function -@code{recursive-edit}. This function contains the command loop; it also -contains a call to @code{catch} with tag @code{exit}, which makes it -possible to exit the recursive editing level by throwing to @code{exit} -(@pxref{Catch and Throw}). If you throw a value other than @code{t}, -then @code{recursive-edit} returns normally to the function that called -it. The command @kbd{C-M-c} (@code{exit-recursive-edit}) does this. -Throwing a @code{t} value causes @code{recursive-edit} to quit, so that -control returns to the command loop one level up. This is called -@dfn{aborting}, and is done by @kbd{C-]} (@code{abort-recursive-edit}). - - Most applications should not use recursive editing, except as part of -using the minibuffer. Usually it is more convenient for the user if you -change the major mode of the current buffer temporarily to a special -major mode, which should have a command to go back to the previous mode. -(The @kbd{e} command in Rmail uses this technique.) Or, if you wish to -give the user different text to edit ``recursively'', create and select -a new buffer in a special mode. In this mode, define a command to -complete the processing and go back to the previous buffer. (The -@kbd{m} command in Rmail does this.) - - Recursive edits are useful in debugging. You can insert a call to -@code{debug} into a function definition as a sort of breakpoint, so that -you can look around when the function gets there. @code{debug} invokes -a recursive edit but also provides the other features of the debugger. - - Recursive editing levels are also used when you type @kbd{C-r} in -@code{query-replace} or use @kbd{C-x q} (@code{kbd-macro-query}). - -@defun recursive-edit -@cindex suspend evaluation -This function invokes the editor command loop. It is called -automatically by the initialization of XEmacs, to let the user begin -editing. When called from a Lisp program, it enters a recursive editing -level. - - In the following example, the function @code{simple-rec} first -advances point one word, then enters a recursive edit, printing out a -message in the echo area. The user can then do any editing desired, and -then type @kbd{C-M-c} to exit and continue executing @code{simple-rec}. - -@example -(defun simple-rec () - (forward-word 1) - (message "Recursive edit in progress") - (recursive-edit) - (forward-word 1)) - @result{} simple-rec -(simple-rec) - @result{} nil -@end example -@end defun - -@deffn Command exit-recursive-edit -This function exits from the innermost recursive edit (including -minibuffer input). Its definition is effectively @code{(throw 'exit -nil)}. -@end deffn - -@deffn Command abort-recursive-edit -This function aborts the command that requested the innermost recursive -edit (including minibuffer input), by signaling @code{quit} -after exiting the recursive edit. Its definition is effectively -@code{(throw 'exit t)}. @xref{Quitting}. -@end deffn - -@deffn Command top-level -This function exits all recursive editing levels; it does not return a -value, as it jumps completely out of any computation directly back to -the main command loop. -@end deffn - -@defun recursion-depth -This function returns the current depth of recursive edits. When no -recursive edit is active, it returns 0. -@end defun - -@node Disabling Commands -@section Disabling Commands -@cindex disabled command - - @dfn{Disabling a command} marks the command as requiring user -confirmation before it can be executed. Disabling is used for commands -which might be confusing to beginning users, to prevent them from using -the commands by accident. - -@kindex disabled - The low-level mechanism for disabling a command is to put a -non-@code{nil} @code{disabled} property on the Lisp symbol for the -command. These properties are normally set up by the user's -@file{.emacs} file with Lisp expressions such as this: - -@example -(put 'upcase-region 'disabled t) -@end example - -@noindent -For a few commands, these properties are present by default and may be -removed by the @file{.emacs} file. - - If the value of the @code{disabled} property is a string, the message -saying the command is disabled includes that string. For example: - -@example -(put 'delete-region 'disabled - "Text deleted this way cannot be yanked back!\n") -@end example - - @xref{Disabling,,, xemacs, The XEmacs User's Manual}, for the details on -what happens when a disabled command is invoked interactively. -Disabling a command has no effect on calling it as a function from Lisp -programs. - -@deffn Command enable-command command -Allow @var{command} to be executed without special confirmation from now -on, and (if the user confirms) alter the user's @file{.emacs} file so -that this will apply to future sessions. -@end deffn - -@deffn Command disable-command command -Require special confirmation to execute @var{command} from now on, and -(if the user confirms) alter the user's @file{.emacs} file so that this -will apply to future sessions. -@end deffn - -@defvar disabled-command-hook -This normal hook is run instead of a disabled command, when the user -invokes the disabled command interactively. The hook functions can use -@code{this-command-keys} to determine what the user typed to run the -command, and thus find the command itself. @xref{Hooks}. - -By default, @code{disabled-command-hook} contains a function that asks -the user whether to proceed. -@end defvar - -@node Command History -@section Command History -@cindex command history -@cindex complex command -@cindex history of commands - - The command loop keeps a history of the complex commands that have -been executed, to make it convenient to repeat these commands. A -@dfn{complex command} is one for which the interactive argument reading -uses the minibuffer. This includes any @kbd{M-x} command, any -@kbd{M-:} command, and any command whose @code{interactive} -specification reads an argument from the minibuffer. Explicit use of -the minibuffer during the execution of the command itself does not cause -the command to be considered complex. - -@defvar command-history -This variable's value is a list of recent complex commands, each -represented as a form to evaluate. It continues to accumulate all -complex commands for the duration of the editing session, but all but -the first (most recent) thirty elements are deleted when a garbage -collection takes place (@pxref{Garbage Collection}). - -@example -@group -command-history -@result{} ((switch-to-buffer "chistory.texi") - (describe-key "^X^[") - (visit-tags-table "~/emacs/src/") - (find-tag "repeat-complex-command")) -@end group -@end example -@end defvar - - This history list is actually a special case of minibuffer history -(@pxref{Minibuffer History}), with one special twist: the elements are -expressions rather than strings. - - There are a number of commands devoted to the editing and recall of -previous commands. The commands @code{repeat-complex-command}, and -@code{list-command-history} are described in the user manual -(@pxref{Repetition,,, xemacs, The XEmacs User's Manual}). Within the -minibuffer, the history commands used are the same ones available in any -minibuffer. - -@node Keyboard Macros -@section Keyboard Macros -@cindex keyboard macros - - A @dfn{keyboard macro} is a canned sequence of input events that can -be considered a command and made the definition of a key. The Lisp -representation of a keyboard macro is a string or vector containing the -events. Don't confuse keyboard macros with Lisp macros -(@pxref{Macros}). - -@defun execute-kbd-macro macro &optional count -This function executes @var{macro} as a sequence of events. If -@var{macro} is a string or vector, then the events in it are executed -exactly as if they had been input by the user. The sequence is -@emph{not} expected to be a single key sequence; normally a keyboard -macro definition consists of several key sequences concatenated. - -If @var{macro} is a symbol, then its function definition is used in -place of @var{macro}. If that is another symbol, this process repeats. -Eventually the result should be a string or vector. If the result is -not a symbol, string, or vector, an error is signaled. - -The argument @var{count} is a repeat count; @var{macro} is executed that -many times. If @var{count} is omitted or @code{nil}, @var{macro} is -executed once. If it is 0, @var{macro} is executed over and over until it -encounters an error or a failing search. -@end defun - -@defvar executing-macro -This variable contains the string or vector that defines the keyboard -macro that is currently executing. It is @code{nil} if no macro is -currently executing. A command can test this variable to behave -differently when run from an executing macro. Do not set this variable -yourself. -@end defvar - -@defvar defining-kbd-macro -This variable indicates whether a keyboard macro is being defined. A -command can test this variable to behave differently while a macro is -being defined. The commands @code{start-kbd-macro} and -@code{end-kbd-macro} set this variable---do not set it yourself. -@end defvar - -@defvar last-kbd-macro -This variable is the definition of the most recently defined keyboard -macro. Its value is a string or vector, or @code{nil}. -@end defvar - -@c Broke paragraph to prevent overfull hbox. --rjc 15mar92 - The commands are described in the user's manual (@pxref{Keyboard -Macros,,, xemacs, The XEmacs User's Manual}). diff --git a/man/lispref/compile.texi b/man/lispref/compile.texi deleted file mode 100644 index 8d92bd0..0000000 --- a/man/lispref/compile.texi +++ /dev/null @@ -1,780 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/compile.info -@node Byte Compilation, Debugging, Loading, Top -@chapter Byte Compilation -@cindex byte-code -@cindex compilation - - XEmacs Lisp has a @dfn{compiler} that translates functions written -in Lisp into a special representation called @dfn{byte-code} that can be -executed more efficiently. The compiler replaces Lisp function -definitions with byte-code. When a byte-coded function is called, its -definition is evaluated by the @dfn{byte-code interpreter}. - - Because the byte-compiled code is evaluated by the byte-code -interpreter, instead of being executed directly by the machine's -hardware (as true compiled code is), byte-code is completely -transportable from machine to machine without recompilation. It is not, -however, as fast as true compiled code. - -In general, any version of Emacs can run byte-compiled code produced -by recent earlier versions of Emacs, but the reverse is not true. In -particular, if you compile a program with XEmacs 20, the compiled code -may not run in earlier versions. - -The first time a compiled-function object is executed, the byte-code -instructions are validated and the byte-code is further optimized. An -@code{invalid-byte-code} error is signaled if the byte-code is invalid, -for example if it contains invalid opcodes. This usually means a bug in -the byte compiler. - -@iftex -@xref{Docs and Compilation}. -@end iftex - - @xref{Compilation Errors}, for how to investigate errors occurring in -byte compilation. - -@menu -* Speed of Byte-Code:: An example of speedup from byte compilation. -* Compilation Functions:: Byte compilation functions. -* Docs and Compilation:: Dynamic loading of documentation strings. -* Dynamic Loading:: Dynamic loading of individual functions. -* Eval During Compile:: Code to be evaluated when you compile. -* Compiled-Function Objects:: The data type used for byte-compiled functions. -* Disassembly:: Disassembling byte-code; how to read byte-code. -@end menu - -@node Speed of Byte-Code -@section Performance of Byte-Compiled Code - - A byte-compiled function is not as efficient as a primitive function -written in C, but runs much faster than the version written in Lisp. -Here is an example: - -@example -@group -(defun silly-loop (n) - "Return time before and after N iterations of a loop." - (let ((t1 (current-time-string))) - (while (> (setq n (1- n)) - 0)) - (list t1 (current-time-string)))) -@result{} silly-loop -@end group - -@group -(silly-loop 5000000) -@result{} ("Mon Sep 14 15:51:49 1998" - "Mon Sep 14 15:52:07 1998") ; @r{18 seconds} -@end group - -@group -(byte-compile 'silly-loop) -@result{} # -@end group - -@group -(silly-loop 5000000) -@result{} ("Mon Sep 14 15:53:43 1998" - "Mon Sep 14 15:53:49 1998") ; @r{6 seconds} -@end group -@end example - - In this example, the interpreted code required 18 seconds to run, -whereas the byte-compiled code required 6 seconds. These results are -representative, but actual results will vary greatly. - -@node Compilation Functions -@comment node-name, next, previous, up -@section The Compilation Functions -@cindex compilation functions - - You can byte-compile an individual function or macro definition with -the @code{byte-compile} function. You can compile a whole file with -@code{byte-compile-file}, or several files with -@code{byte-recompile-directory} or @code{batch-byte-compile}. - - When you run the byte compiler, you may get warnings in a buffer -called @samp{*Compile-Log*}. These report things in your program that -suggest a problem but are not necessarily erroneous. - -@cindex macro compilation - Be careful when byte-compiling code that uses macros. Macro calls are -expanded when they are compiled, so the macros must already be defined -for proper compilation. For more details, see @ref{Compiling Macros}. - - Normally, compiling a file does not evaluate the file's contents or -load the file. But it does execute any @code{require} calls at top -level in the file. One way to ensure that necessary macro definitions -are available during compilation is to @code{require} the file that defines -them (@pxref{Named Features}). To avoid loading the macro definition files -when someone @emph{runs} the compiled program, write -@code{eval-when-compile} around the @code{require} calls (@pxref{Eval -During Compile}). - -@defun byte-compile symbol -This function byte-compiles the function definition of @var{symbol}, -replacing the previous definition with the compiled one. The function -definition of @var{symbol} must be the actual code for the function; -i.e., the compiler does not follow indirection to another symbol. -@code{byte-compile} returns the new, compiled definition of -@var{symbol}. - - If @var{symbol}'s definition is a compiled-function object, -@code{byte-compile} does nothing and returns @code{nil}. Lisp records -only one function definition for any symbol, and if that is already -compiled, non-compiled code is not available anywhere. So there is no -way to ``compile the same definition again.'' - -@example -@group -(defun factorial (integer) - "Compute factorial of INTEGER." - (if (= 1 integer) 1 - (* integer (factorial (1- integer))))) -@result{} factorial -@end group - -@group -(byte-compile 'factorial) -@result{} # -@end group -@end example - -@noindent -The result is a compiled-function object. The string it contains is -the actual byte-code; each character in it is an instruction or an -operand of an instruction. The vector contains all the constants, -variable names and function names used by the function, except for -certain primitives that are coded as special instructions. -@end defun - -@deffn Command compile-defun &optional arg -This command reads the defun containing point, compiles it, and -evaluates the result. If you use this on a defun that is actually a -function definition, the effect is to install a compiled version of that -function. - -@c XEmacs feature -If @var{arg} is non-@code{nil}, the result is inserted in the current -buffer after the form; otherwise, it is printed in the minibuffer. -@end deffn - -@deffn Command byte-compile-file filename &optional load -This function compiles a file of Lisp code named @var{filename} into -a file of byte-code. The output file's name is made by appending -@samp{c} to the end of @var{filename}. - -@c XEmacs feature - If @code{load} is non-@code{nil}, the file is loaded after having been -compiled. - -Compilation works by reading the input file one form at a time. If it -is a definition of a function or macro, the compiled function or macro -definition is written out. Other forms are batched together, then each -batch is compiled, and written so that its compiled code will be -executed when the file is read. All comments are discarded when the -input file is read. - -This command returns @code{t}. When called interactively, it prompts -for the file name. - -@example -@group -% ls -l push* --rw-r--r-- 1 lewis 791 Oct 5 20:31 push.el -@end group - -@group -(byte-compile-file "~/emacs/push.el") - @result{} t -@end group - -@group -% ls -l push* --rw-r--r-- 1 lewis 791 Oct 5 20:31 push.el --rw-r--r-- 1 lewis 638 Oct 8 20:25 push.elc -@end group -@end example -@end deffn - -@c flag is not optional in FSF Emacs -@deffn Command byte-recompile-directory directory &optional flag -@cindex library compilation -This function recompiles every @samp{.el} file in @var{directory} that -needs recompilation. A file needs recompilation if a @samp{.elc} file -exists but is older than the @samp{.el} file. - -When a @samp{.el} file has no corresponding @samp{.elc} file, then -@var{flag} says what to do. If it is @code{nil}, these files are -ignored. If it is non-@code{nil}, the user is asked whether to compile -each such file. - -The return value of this command is unpredictable. -@end deffn - -@defun batch-byte-compile -This function runs @code{byte-compile-file} on files specified on the -command line. This function must be used only in a batch execution of -Emacs, as it kills Emacs on completion. An error in one file does not -prevent processing of subsequent files. (The file that gets the error -will not, of course, produce any compiled code.) - -@example -% emacs -batch -f batch-byte-compile *.el -@end example -@end defun - -@c XEmacs feature -@defun batch-byte-recompile-directory - This function is similar to @code{batch-byte-compile} but runs the -command @code{byte-recompile-directory} on the files remaining on the -command line. -@end defun - -@c XEmacs feature -@defvar byte-recompile-directory-ignore-errors-p - If non-@code{nil}, this specifies that @code{byte-recompile-directory} -will continue compiling even when an error occurs in a file. This is -normally @code{nil}, but is bound to @code{t} by -@code{batch-byte-recompile-directory}. -@end defvar - -@defun byte-code instructions constants stack-size -@cindex byte-code interpreter -This function actually interprets byte-code. -Don't call this function yourself. Only the byte compiler knows how to -generate valid calls to this function. - -In newer Emacs versions (19 and up), byte code is usually executed as -part of a compiled-function object, and only rarely due to an explicit -call to @code{byte-code}. A byte-compiled function was once actually -defined with a body that calls @code{byte-code}, but in recent versions -of Emacs @code{byte-code} is only used to run isolated fragments of lisp -code without an associated argument list. -@end defun - -@node Docs and Compilation -@section Documentation Strings and Compilation -@cindex dynamic loading of documentation - - Functions and variables loaded from a byte-compiled file access their -documentation strings dynamically from the file whenever needed. This -saves space within Emacs, and makes loading faster because the -documentation strings themselves need not be processed while loading the -file. Actual access to the documentation strings becomes slower as a -result, but normally not enough to bother users. - - Dynamic access to documentation strings does have drawbacks: - -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer access the documentation strings for the functions and variables -in the file. - -@item -If you alter the compiled file (such as by compiling a new version), -then further access to documentation strings in this file will give -nonsense results. -@end itemize - - If your site installs Emacs following the usual procedures, these -problems will never normally occur. Installing a new version uses a new -directory with a different name; as long as the old version remains -installed, its files will remain unmodified in the places where they are -expected to be. - - However, if you have built Emacs yourself and use it from the -directory where you built it, you will experience this problem -occasionally if you edit and recompile Lisp files. When it happens, you -can cure the problem by reloading the file after recompiling it. - - Versions of Emacs up to and including XEmacs 19.14 and FSF Emacs 19.28 -do not support the dynamic docstrings feature, and so will not be able -to load bytecode created by more recent Emacs versions. You can turn -off the dynamic docstring feature by setting -@code{byte-compile-dynamic-docstrings} to @code{nil}. Once this is -done, you can compile files that will load into older Emacs versions. -You can do this globally, or for one source file by specifying a -file-local binding for the variable. Here's one way to do that: - -@example --*-byte-compile-dynamic-docstrings: nil;-*- -@end example - -@defvar byte-compile-dynamic-docstrings -If this is non-@code{nil}, the byte compiler generates compiled files -that are set up for dynamic loading of documentation strings. -@end defvar - -@cindex @samp{#@@@var{count}} -@cindex @samp{#$} - The dynamic documentation string feature writes compiled files that -use a special Lisp reader construct, @samp{#@@@var{count}}. This -construct skips the next @var{count} characters. It also uses the -@samp{#$} construct, which stands for ``the name of this file, as a -string.'' It is best not to use these constructs in Lisp source files. - -@node Dynamic Loading -@section Dynamic Loading of Individual Functions - -@cindex dynamic loading of functions -@cindex lazy loading - When you compile a file, you can optionally enable the @dfn{dynamic -function loading} feature (also known as @dfn{lazy loading}). With -dynamic function loading, loading the file doesn't fully read the -function definitions in the file. Instead, each function definition -contains a place-holder which refers to the file. The first time each -function is called, it reads the full definition from the file, to -replace the place-holder. - - The advantage of dynamic function loading is that loading the file -becomes much faster. This is a good thing for a file which contains -many separate commands, provided that using one of them does not imply -you will soon (or ever) use the rest. A specialized mode which provides -many keyboard commands often has that usage pattern: a user may invoke -the mode, but use only a few of the commands it provides. - - The dynamic loading feature has certain disadvantages: - -@itemize @bullet -@item -If you delete or move the compiled file after loading it, Emacs can no -longer load the remaining function definitions not already loaded. - -@item -If you alter the compiled file (such as by compiling a new version), -then trying to load any function not already loaded will get nonsense -results. -@end itemize - - If you compile a new version of the file, the best thing to do is -immediately load the new compiled file. That will prevent any future -problems. - - The byte compiler uses the dynamic function loading feature if the -variable @code{byte-compile-dynamic} is non-@code{nil} at compilation -time. Do not set this variable globally, since dynamic loading is -desirable only for certain files. Instead, enable the feature for -specific source files with file-local variable bindings, like this: - -@example --*-byte-compile-dynamic: t;-*- -@end example - -@defvar byte-compile-dynamic -If this is non-@code{nil}, the byte compiler generates compiled files -that are set up for dynamic function loading. -@end defvar - -@defun fetch-bytecode function -This immediately finishes loading the definition of @var{function} from -its byte-compiled file, if it is not fully loaded already. The argument -@var{function} may be a compiled-function object or a function name. -@end defun - -@node Eval During Compile -@section Evaluation During Compilation - - These features permit you to write code to be evaluated during -compilation of a program. - -@defspec eval-and-compile body -This form marks @var{body} to be evaluated both when you compile the -containing code and when you run it (whether compiled or not). - -You can get a similar result by putting @var{body} in a separate file -and referring to that file with @code{require}. Using @code{require} is -preferable if there is a substantial amount of code to be executed in -this way. -@end defspec - -@defspec eval-when-compile body -This form marks @var{body} to be evaluated at compile time and not when -the compiled program is loaded. The result of evaluation by the -compiler becomes a constant which appears in the compiled program. When -the program is interpreted, not compiled at all, @var{body} is evaluated -normally. - -At top level, this is analogous to the Common Lisp idiom -@code{(eval-when (compile eval) @dots{})}. Elsewhere, the Common Lisp -@samp{#.} reader macro (but not when interpreting) is closer to what -@code{eval-when-compile} does. -@end defspec - -@node Compiled-Function Objects -@section Compiled-Function Objects -@cindex compiled function -@cindex byte-code function - - Byte-compiled functions have a special data type: they are -@dfn{compiled-function objects}. The evaluator handles this data type -specially when it appears as a function to be called. - - The printed representation for a compiled-function object normally -begins with @samp{#}. However, -if the variable @code{print-readably} is non-@code{nil}, the object is -printed beginning with @samp{#[} and ending with @samp{]}. This -representation can be read directly by the Lisp reader, and is used in -byte-compiled files (those ending in @samp{.elc}). - - In Emacs version 18, there was no compiled-function object data type; -compiled functions used the function @code{byte-code} to run the byte -code. - - A compiled-function object has a number of different attributes. -They are: - -@table @var -@item arglist -The list of argument symbols. - -@item instructions -The string containing the byte-code instructions. - -@item constants -The vector of Lisp objects referenced by the byte code. These include -symbols used as function names and variable names. - -@item stack-size -The maximum stack size this function needs. - -@item doc-string -The documentation string (if any); otherwise, @code{nil}. The value may -be a number or a list, in case the documentation string is stored in a -file. Use the function @code{documentation} to get the real -documentation string (@pxref{Accessing Documentation}). - -@item interactive -The interactive spec (if any). This can be a string or a Lisp -expression. It is @code{nil} for a function that isn't interactive. - -@item domain -The domain (if any). This is only meaningful if I18N3 (message-translation) -support was compiled into XEmacs. This is a string defining which -domain to find the translation for the documentation string and -interactive prompt. @xref{Domain Specification}. -@end table - -Here's an example of a compiled-function object, in printed -representation. It is the definition of the command -@code{backward-sexp}. - -@example -(symbol-function 'backward-sexp) -@result{} # -@end example - - The primitive way to create a compiled-function object is with -@code{make-byte-code}: - -@defun make-byte-code arglist instructions constants stack-size &optional doc-string interactive -This function constructs and returns a compiled-function object -with the specified attributes. - -@emph{Please note:} Unlike all other Emacs-lisp functions, calling this with -five arguments is @emph{not} the same as calling it with six arguments, -the last of which is @code{nil}. If the @var{interactive} arg is -specified as @code{nil}, then that means that this function was defined -with @code{(interactive)}. If the arg is not specified, then that means -the function is not interactive. This is terrible behavior which is -retained for compatibility with old @samp{.elc} files which expected -these semantics. -@end defun - - You should not try to come up with the elements for a compiled-function -object yourself, because if they are inconsistent, XEmacs may crash -when you call the function. Always leave it to the byte compiler to -create these objects; it makes the elements consistent (we hope). - - The following primitives are provided for accessing the elements of -a compiled-function object. - -@defun compiled-function-arglist function -This function returns the argument list of compiled-function object -@var{function}. -@end defun - -@defun compiled-function-instructions function -This function returns a string describing the byte-code instructions -of compiled-function object @var{function}. -@end defun - -@defun compiled-function-constants function -This function returns the vector of Lisp objects referenced by -compiled-function object @var{function}. -@end defun - -@defun compiled-function-stack-size function -This function returns the maximum stack size needed by compiled-function -object @var{function}. -@end defun - -@defun compiled-function-doc-string function -This function returns the doc string of compiled-function object -@var{function}, if available. -@end defun - -@defun compiled-function-interactive function -This function returns the interactive spec of compiled-function object -@var{function}, if any. The return value is @code{nil} or a two-element -list, the first element of which is the symbol @code{interactive} and -the second element is the interactive spec (a string or Lisp form). -@end defun - -@defun compiled-function-domain function -This function returns the domain of compiled-function object -@var{function}, if any. The result will be a string or @code{nil}. -@xref{Domain Specification}. -@end defun - -@node Disassembly -@section Disassembled Byte-Code -@cindex disassembled byte-code - - People do not write byte-code; that job is left to the byte compiler. -But we provide a disassembler to satisfy a cat-like curiosity. The -disassembler converts the byte-compiled code into humanly readable -form. - - The byte-code interpreter is implemented as a simple stack machine. -It pushes values onto a stack of its own, then pops them off to use them -in calculations whose results are themselves pushed back on the stack. -When a byte-code function returns, it pops a value off the stack and -returns it as the value of the function. - - In addition to the stack, byte-code functions can use, bind, and set -ordinary Lisp variables, by transferring values between variables and -the stack. - -@deffn Command disassemble object &optional stream -This function prints the disassembled code for @var{object}. If -@var{stream} is supplied, then output goes there. Otherwise, the -disassembled code is printed to the stream @code{standard-output}. The -argument @var{object} can be a function name or a lambda expression. - -As a special exception, if this function is used interactively, -it outputs to a buffer named @samp{*Disassemble*}. -@end deffn - - Here are two examples of using the @code{disassemble} function. We -have added explanatory comments to help you relate the byte-code to the -Lisp source; these do not appear in the output of @code{disassemble}. - -@example -@group -(defun factorial (integer) - "Compute factorial of an integer." - (if (= 1 integer) 1 - (* integer (factorial (1- integer))))) - @result{} factorial -@end group - -@group -(factorial 4) - @result{} 24 -@end group - -@group -(disassemble 'factorial) - @print{} byte-code for factorial: - doc: Compute factorial of an integer. - args: (integer) -@end group - -@group -0 varref integer ; @r{Get value of @code{integer}} - ; @r{from the environment} - ; @r{and push the value} - ; @r{onto the stack.} - -1 constant 1 ; @r{Push 1 onto stack.} -@end group - -@group -2 eqlsign ; @r{Pop top two values off stack,} - ; @r{compare them,} - ; @r{and push result onto stack.} -@end group - -@group -3 goto-if-nil 1 ; @r{Pop and test top of stack;} - ; @r{if @code{nil},} - ; @r{go to label 1 (which is also byte 7),} - ; @r{else continue.} -@end group - -@group -5 constant 1 ; @r{Push 1 onto top of stack.} - -6 return ; @r{Return the top element} - ; @r{of the stack.} -@end group - -7:1 varref integer ; @r{Push value of @code{integer} onto stack.} - -@group -8 constant factorial ; @r{Push @code{factorial} onto stack.} - -9 varref integer ; @r{Push value of @code{integer} onto stack.} - -10 sub1 ; @r{Pop @code{integer}, decrement value,} - ; @r{push new value onto stack.} -@end group - -@group - ; @r{Stack now contains:} - ; @minus{} @r{decremented value of @code{integer}} - ; @minus{} @r{@code{factorial}} - ; @minus{} @r{value of @code{integer}} -@end group - -@group -15 call 1 ; @r{Call function @code{factorial} using} - ; @r{the first (i.e., the top) element} - ; @r{of the stack as the argument;} - ; @r{push returned value onto stack.} -@end group - -@group - ; @r{Stack now contains:} - ; @minus{} @r{result of recursive} - ; @r{call to @code{factorial}} - ; @minus{} @r{value of @code{integer}} -@end group - -@group -12 mult ; @r{Pop top two values off the stack,} - ; @r{multiply them,} - ; @r{pushing the result onto the stack.} -@end group - -@group -13 return ; @r{Return the top element} - ; @r{of the stack.} - @result{} nil -@end group -@end example - -The @code{silly-loop} function is somewhat more complex: - -@example -@group -(defun silly-loop (n) - "Return time before and after N iterations of a loop." - (let ((t1 (current-time-string))) - (while (> (setq n (1- n)) - 0)) - (list t1 (current-time-string)))) - @result{} silly-loop -@end group - -@group -(disassemble 'silly-loop) - @print{} byte-code for silly-loop: - doc: Return time before and after N iterations of a loop. - args: (n) - -0 constant current-time-string ; @r{Push} - ; @r{@code{current-time-string}} - ; @r{onto top of stack.} -@end group - -@group -1 call 0 ; @r{Call @code{current-time-string}} - ; @r{ with no argument,} - ; @r{ pushing result onto stack.} -@end group - -@group -2 varbind t1 ; @r{Pop stack and bind @code{t1}} - ; @r{to popped value.} -@end group - -@group -3:1 varref n ; @r{Get value of @code{n} from} - ; @r{the environment and push} - ; @r{the value onto the stack.} -@end group - -@group -4 sub1 ; @r{Subtract 1 from top of stack.} -@end group - -@group -5 dup ; @r{Duplicate the top of the stack;} - ; @r{i.e., copy the top of} - ; @r{the stack and push the} - ; @r{copy onto the stack.} - -6 varset n ; @r{Pop the top of the stack,} - ; @r{and set @code{n} to the value.} - - ; @r{In effect, the sequence @code{dup varset}} - ; @r{copies the top of the stack} - ; @r{into the value of @code{n}} - ; @r{without popping it.} -@end group - -@group -7 constant 0 ; @r{Push 0 onto stack.} - -8 gtr ; @r{Pop top two values off stack,} - ; @r{test if @var{n} is greater than 0} - ; @r{and push result onto stack.} -@end group - -@group -9 goto-if-not-nil 1 ; @r{Goto label 1 (byte 3) if @code{n} <= 0} - ; @r{(this exits the while loop).} - ; @r{else pop top of stack} - ; @r{and continue} -@end group - -@group -11 varref t1 ; @r{Push value of @code{t1} onto stack.} -@end group - -@group -12 constant current-time-string ; @r{Push} - ; @r{@code{current-time-string}} - ; @r{onto top of stack.} -@end group - -@group -13 call 0 ; @r{Call @code{current-time-string} again.} - -14 unbind 1 ; @r{Unbind @code{t1} in local environment.} -@end group - -@group -15 list2 ; @r{Pop top two elements off stack,} - ; @r{create a list of them,} - ; @r{and push list onto stack.} -@end group - -@group -16 return ; @r{Return the top element of the stack.} - - @result{} nil -@end group -@end example - - diff --git a/man/lispref/consoles-devices.texi b/man/lispref/consoles-devices.texi deleted file mode 100644 index 9f52610..0000000 --- a/man/lispref/consoles-devices.texi +++ /dev/null @@ -1,272 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995, 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/consoles-devices.info -@node Consoles and Devices, Positions, Frames, top -@chapter Consoles and Devices -@cindex devices -@cindex consoles - - A @dfn{console} is an object representing a single input connection -to XEmacs, such as an X display or a TTY connection. It is possible -for XEmacs to have frames on multiple consoles at once (even on -heterogeneous types -- you can simultaneously have a frame on an -X display and a TTY connection). Normally, there is only one -console in existence. - - A @dfn{device} is an object representing a single output device, such -as a particular screen on an X display. (Usually there is exactly one -device per X console connection, but there may be more than one if you -have a multi-headed X display. For TTY connections, there is always -exactly one device per console.) - - Each device has one or more @dfn{frames} in which text can be -displayed. For X displays and the like, a frame corresponds to the -normal window-system concept of a window. Frames can overlap, be -displayed at various locations within the display, be resized, etc. For -TTY, only one frame can be displayed at a time, and it occupies the -entire TTY display area. - -However, you can still define multiple frames and switch between them. -Their contents are entirely separate from each other. These sorts of -frames resemble the ``virtual console'' capability provided under Linux -or the multiple screens provided by the multiplexing program -@samp{screen} under Unix. - - When you start up XEmacs, an initial console and device are created to -receive input and display frames on. This will either be an X display -or a TTY connection, depending on what mode you started XEmacs in (this -is determined by the @samp{DISPLAY} environment variable, the -@samp{-nw}, @samp{-t} and @samp{-display} command-line options, etc.). - - You can connect to other X displays and TTY connections by creating -new console objects, and to other X screens on an existing display by -creating new device objects, as described below. Many functions (for -example the frame-creation functions) take an optional device argument -specifying which device the function pertains to. If the argument is -omitted, it defaults to the selected device (see below). - -@defun consolep object -This returns non-@code{nil} if @var{object} is a console. -@end defun - -@defun devicep object -This returns non-@code{nil} if @var{object} is a device. -@end defun - -@menu -* Basic Console Functions:: Functions for working with consoles. -* Basic Device Functions:: Functions for working with devices. -* Console Types and Device Classes:: - I/O and color characteristics. -* Connecting to a Console or Device:: -* The Selected Console and Device:: -* Console and Device I/O:: Controlling input and output. -@end menu - -@node Basic Console Functions -@section Basic Console Functions - -@defun console-list -This function returns a list of all existing consoles. -@end defun - -@defun console-device-list &optional console -This function returns a list of all devices on @var{console}. If -@var{console} is @code{nil}, the selected console will be used. -@end defun - -@node Basic Device Functions -@section Basic Device Functions - -@defun device-list -This function returns a list of all existing devices. -@end defun - -@defun device-or-frame-p object -This function returns non-@code{nil} if @var{object} is a device or -frame. This function is useful because devices and frames are similar -in many respects and many functions can operate on either one. -@end defun - -@defun device-frame-list device -This function returns a list of all frames on @var{device}. -@end defun - -@defun frame-device frame -This function returns the device that @var{frame} is on. -@end defun - -@node Console Types and Device Classes -@section Console Types and Device Classes - -Every device is of a particular @dfn{type}, which describes how the -connection to that device is made and how the device operates, and -a particular @dfn{class}, which describes other characteristics of -the device (currently, the color capabilities of the device). - -The currently-defined device types are - -@table @code -@item x -A connection to an X display (such as @samp{willow:0}). - -@item tty -A connection to a tty (such as @samp{/dev/ttyp3}). - -@item stream -A stdio connection. This describes a device for which input and output -is only possible in a stream-like fashion, such as when XEmacs in running -in batch mode. The very first device created by XEmacs is a terminal -device and is used to print out messages of various sorts (for example, -the help message when you use the @samp{-help} command-line option). -@end table - -The currently-defined device classes are -@table @code -@item color -A color device. - -@item grayscale -A grayscale device (a device that can display multiple shades of gray, -but no color). - -@item mono -A device that can only display two colors (e.g. black and white). -@end table - -@defun device-type device -This function returns the type of @var{device}. This is a symbol whose -name is one of the device types mentioned above. -@end defun - -@defun device-or-frame-type device-or-frame -This function returns the type of @var{device-or-frame}. -@end defun - -@defun device-class device -This function returns the class (color behavior) of @var{device}. This -is a symbol whose name is one of the device classes mentioned above. -@end defun - -@defun valid-device-type-p device-type -This function returns whether @var{device-type} (which should be a symbol) -species a valid device type. -@end defun - -@defun valid-device-class-p device-class -This function returns whether @var{device-class} (which should be a symbol) -species a valid device class. -@end defun - -@defvar terminal-device -This variable holds the initial terminal device object, which -represents XEmacs's stdout. -@end defvar - -@node Connecting to a Console or Device -@section Connecting to a Console or Device - -@defun make-device &optional type device-data -This function creates a new device. -@end defun - -The following two functions create devices of specific types and are -written in terms of @code{make-device}. - -@defun make-tty-device &optional tty terminal-type -This function creates a new tty device on @var{tty}. This also creates -the tty's first frame. @var{tty} should be a string giving the name of -a tty device file (e.g. @samp{/dev/ttyp3} under SunOS et al.), as -returned by the @samp{tty} command issued from the Unix shell. A value -of @code{nil} means use the stdin and stdout as passed to XEmacs from -the shell. If @var{terminal-type} is non-@code{nil}, it should be a -string specifying the type of the terminal attached to the specified -tty. If it is @code{nil}, the terminal type will be inferred from the -@samp{TERM} environment variable. -@end defun - -@defun make-x-device &optional display argv-list -This function creates a new device connected to @var{display}. Optional -argument @var{argv-list} is a list of strings describing command line -options. -@end defun - -@defun delete-device device -This function deletes @var{device}, permanently eliminating it from use. -This disconnects XEmacs's connection to the device. -@end defun - -@defvar create-device-hook -This variable, if non-@code{nil}, should contain a list of functions, -which are called when a device is created. -@end defvar - -@defvar delete-device-hook -This variable, if non-@code{nil}, should contain a list of functions, -which are called when a device is deleted. -@end defvar - -@defun console-live-p object -This function returns non-@code{nil} if @var{object} is a console that -has not been deleted. -@end defun - -@defun device-live-p object -This function returns non-@code{nil} if @var{object} is a device that -has not been deleted. -@end defun - -@defun device-x-display device -This function returns the X display which @var{device} is connected to, -if @var{device} is an X device. -@end defun - -@node The Selected Console and Device -@section The Selected Console and Device - -@defun select-console console -This function selects the console @var{console}. Subsequent editing -commands apply to its selected device, selected frame, and selected -window. The selection of @var{console} lasts until the next time the -user does something to select a different console, or until the next -time this function is called. -@end defun - -@defun selected-console -This function returns the console which is currently active. -@end defun - -@defun select-device device -This function selects the device @var{device}. -@end defun - -@defun selected-device &optional console -This function returns the device which is currently active. If optional -@var{console} is non-@code{nil}, this function returns the device that -would be currently active if @var{console} were the selected console. -@end defun - -@node Console and Device I/O -@section Console and Device I/O - -@defun console-disable-input console -This function disables input on console @var{console}. -@end defun - -@defun console-enable-input console -This function enables input on console @var{console}. -@end defun - -Each device has a @dfn{baud rate} value associated with it. -On most systems, changing this value will affect the amount of padding -and other strategic decisions made during redisplay. - -@defun device-baud-rate &optional device -This function returns the output baud rate of @var{device}. -@end defun - -@defun set-device-baud-rate device rate -This function sets the output baud rate of @var{device} to @var{rate}. -@end defun diff --git a/man/lispref/control.texi b/man/lispref/control.texi deleted file mode 100644 index 5ea470f..0000000 --- a/man/lispref/control.texi +++ /dev/null @@ -1,1148 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/control.info -@node Control Structures, Variables, Evaluation, Top -@chapter Control Structures -@cindex special forms for control structures -@cindex control structures - - A Lisp program consists of expressions or @dfn{forms} (@pxref{Forms}). -We control the order of execution of the forms by enclosing them in -@dfn{control structures}. Control structures are special forms which -control when, whether, or how many times to execute the forms they -contain. - - The simplest order of execution is sequential execution: first form -@var{a}, then form @var{b}, and so on. This is what happens when you -write several forms in succession in the body of a function, or at top -level in a file of Lisp code---the forms are executed in the order -written. We call this @dfn{textual order}. For example, if a function -body consists of two forms @var{a} and @var{b}, evaluation of the -function evaluates first @var{a} and then @var{b}, and the function's -value is the value of @var{b}. - - Explicit control structures make possible an order of execution other -than sequential. - - XEmacs Lisp provides several kinds of control structure, including -other varieties of sequencing, conditionals, iteration, and (controlled) -jumps---all discussed below. The built-in control structures are -special forms since their subforms are not necessarily evaluated or not -evaluated sequentially. You can use macros to define your own control -structure constructs (@pxref{Macros}). - -@menu -* Sequencing:: Evaluation in textual order. -* Conditionals:: @code{if}, @code{cond}. -* Combining Conditions:: @code{and}, @code{or}, @code{not}. -* Iteration:: @code{while} loops. -* Nonlocal Exits:: Jumping out of a sequence. -@end menu - -@node Sequencing -@section Sequencing - - Evaluating forms in the order they appear is the most common way -control passes from one form to another. In some contexts, such as in a -function body, this happens automatically. Elsewhere you must use a -control structure construct to do this: @code{progn}, the simplest -control construct of Lisp. - - A @code{progn} special form looks like this: - -@example -@group -(progn @var{a} @var{b} @var{c} @dots{}) -@end group -@end example - -@noindent -and it says to execute the forms @var{a}, @var{b}, @var{c} and so on, in -that order. These forms are called the body of the @code{progn} form. -The value of the last form in the body becomes the value of the entire -@code{progn}. - -@cindex implicit @code{progn} - In the early days of Lisp, @code{progn} was the only way to execute -two or more forms in succession and use the value of the last of them. -But programmers found they often needed to use a @code{progn} in the -body of a function, where (at that time) only one form was allowed. So -the body of a function was made into an ``implicit @code{progn}'': -several forms are allowed just as in the body of an actual @code{progn}. -Many other control structures likewise contain an implicit @code{progn}. -As a result, @code{progn} is not used as often as it used to be. It is -needed now most often inside an @code{unwind-protect}, @code{and}, -@code{or}, or in the @var{then}-part of an @code{if}. - -@defspec progn forms@dots{} -This special form evaluates all of the @var{forms}, in textual -order, returning the result of the final form. - -@example -@group -(progn (print "The first form") - (print "The second form") - (print "The third form")) - @print{} "The first form" - @print{} "The second form" - @print{} "The third form" -@result{} "The third form" -@end group -@end example -@end defspec - - Two other control constructs likewise evaluate a series of forms but return -a different value: - -@defspec prog1 form1 forms@dots{} -This special form evaluates @var{form1} and all of the @var{forms}, in -textual order, returning the result of @var{form1}. - -@example -@group -(prog1 (print "The first form") - (print "The second form") - (print "The third form")) - @print{} "The first form" - @print{} "The second form" - @print{} "The third form" -@result{} "The first form" -@end group -@end example - -Here is a way to remove the first element from a list in the variable -@code{x}, then return the value of that former element: - -@example -(prog1 (car x) (setq x (cdr x))) -@end example -@end defspec - -@defspec prog2 form1 form2 forms@dots{} -This special form evaluates @var{form1}, @var{form2}, and all of the -following @var{forms}, in textual order, returning the result of -@var{form2}. - -@example -@group -(prog2 (print "The first form") - (print "The second form") - (print "The third form")) - @print{} "The first form" - @print{} "The second form" - @print{} "The third form" -@result{} "The second form" -@end group -@end example -@end defspec - -@node Conditionals -@section Conditionals -@cindex conditional evaluation - - Conditional control structures choose among alternatives. XEmacs Lisp -has two conditional forms: @code{if}, which is much the same as in other -languages, and @code{cond}, which is a generalized case statement. - -@defspec if condition then-form else-forms@dots{} -@code{if} chooses between the @var{then-form} and the @var{else-forms} -based on the value of @var{condition}. If the evaluated @var{condition} is -non-@code{nil}, @var{then-form} is evaluated and the result returned. -Otherwise, the @var{else-forms} are evaluated in textual order, and the -value of the last one is returned. (The @var{else} part of @code{if} is -an example of an implicit @code{progn}. @xref{Sequencing}.) - -If @var{condition} has the value @code{nil}, and no @var{else-forms} are -given, @code{if} returns @code{nil}. - -@code{if} is a special form because the branch that is not selected is -never evaluated---it is ignored. Thus, in the example below, -@code{true} is not printed because @code{print} is never called. - -@example -@group -(if nil - (print 'true) - 'very-false) -@result{} very-false -@end group -@end example -@end defspec - -@defspec cond clause@dots{} -@code{cond} chooses among an arbitrary number of alternatives. Each -@var{clause} in the @code{cond} must be a list. The @sc{car} of this -list is the @var{condition}; the remaining elements, if any, the -@var{body-forms}. Thus, a clause looks like this: - -@example -(@var{condition} @var{body-forms}@dots{}) -@end example - -@code{cond} tries the clauses in textual order, by evaluating the -@var{condition} of each clause. If the value of @var{condition} is -non-@code{nil}, the clause ``succeeds''; then @code{cond} evaluates its -@var{body-forms}, and the value of the last of @var{body-forms} becomes -the value of the @code{cond}. The remaining clauses are ignored. - -If the value of @var{condition} is @code{nil}, the clause ``fails'', so -the @code{cond} moves on to the following clause, trying its -@var{condition}. - -If every @var{condition} evaluates to @code{nil}, so that every clause -fails, @code{cond} returns @code{nil}. - -A clause may also look like this: - -@example -(@var{condition}) -@end example - -@noindent -Then, if @var{condition} is non-@code{nil} when tested, the value of -@var{condition} becomes the value of the @code{cond} form. - -The following example has four clauses, which test for the cases where -the value of @code{x} is a number, string, buffer and symbol, -respectively: - -@example -@group -(cond ((numberp x) x) - ((stringp x) x) - ((bufferp x) - (setq temporary-hack x) ; @r{multiple body-forms} - (buffer-name x)) ; @r{in one clause} - ((symbolp x) (symbol-value x))) -@end group -@end example - -Often we want to execute the last clause whenever none of the previous -clauses was successful. To do this, we use @code{t} as the -@var{condition} of the last clause, like this: @code{(t -@var{body-forms})}. The form @code{t} evaluates to @code{t}, which is -never @code{nil}, so this clause never fails, provided the @code{cond} -gets to it at all. - -For example, - -@example -@group -(cond ((eq a 'hack) 'foo) - (t "default")) -@result{} "default" -@end group -@end example - -@noindent -This expression is a @code{cond} which returns @code{foo} if the value -of @code{a} is 1, and returns the string @code{"default"} otherwise. -@end defspec - -Any conditional construct can be expressed with @code{cond} or with -@code{if}. Therefore, the choice between them is a matter of style. -For example: - -@example -@group -(if @var{a} @var{b} @var{c}) -@equiv{} -(cond (@var{a} @var{b}) (t @var{c})) -@end group -@end example - -@node Combining Conditions -@section Constructs for Combining Conditions - - This section describes three constructs that are often used together -with @code{if} and @code{cond} to express complicated conditions. The -constructs @code{and} and @code{or} can also be used individually as -kinds of multiple conditional constructs. - -@defun not condition -This function tests for the falsehood of @var{condition}. It returns -@code{t} if @var{condition} is @code{nil}, and @code{nil} otherwise. -The function @code{not} is identical to @code{null}, and we recommend -using the name @code{null} if you are testing for an empty list. -@end defun - -@defspec and conditions@dots{} -The @code{and} special form tests whether all the @var{conditions} are -true. It works by evaluating the @var{conditions} one by one in the -order written. - -If any of the @var{conditions} evaluates to @code{nil}, then the result -of the @code{and} must be @code{nil} regardless of the remaining -@var{conditions}; so @code{and} returns right away, ignoring the -remaining @var{conditions}. - -If all the @var{conditions} turn out non-@code{nil}, then the value of -the last of them becomes the value of the @code{and} form. - -Here is an example. The first condition returns the integer 1, which is -not @code{nil}. Similarly, the second condition returns the integer 2, -which is not @code{nil}. The third condition is @code{nil}, so the -remaining condition is never evaluated. - -@example -@group -(and (print 1) (print 2) nil (print 3)) - @print{} 1 - @print{} 2 -@result{} nil -@end group -@end example - -Here is a more realistic example of using @code{and}: - -@example -@group -(if (and (consp foo) (eq (car foo) 'x)) - (message "foo is a list starting with x")) -@end group -@end example - -@noindent -Note that @code{(car foo)} is not executed if @code{(consp foo)} returns -@code{nil}, thus avoiding an error. - -@code{and} can be expressed in terms of either @code{if} or @code{cond}. -For example: - -@example -@group -(and @var{arg1} @var{arg2} @var{arg3}) -@equiv{} -(if @var{arg1} (if @var{arg2} @var{arg3})) -@equiv{} -(cond (@var{arg1} (cond (@var{arg2} @var{arg3})))) -@end group -@end example -@end defspec - -@defspec or conditions@dots{} -The @code{or} special form tests whether at least one of the -@var{conditions} is true. It works by evaluating all the -@var{conditions} one by one in the order written. - -If any of the @var{conditions} evaluates to a non-@code{nil} value, then -the result of the @code{or} must be non-@code{nil}; so @code{or} returns -right away, ignoring the remaining @var{conditions}. The value it -returns is the non-@code{nil} value of the condition just evaluated. - -If all the @var{conditions} turn out @code{nil}, then the @code{or} -expression returns @code{nil}. - -For example, this expression tests whether @code{x} is either 0 or -@code{nil}: - -@example -(or (eq x nil) (eq x 0)) -@end example - -Like the @code{and} construct, @code{or} can be written in terms of -@code{cond}. For example: - -@example -@group -(or @var{arg1} @var{arg2} @var{arg3}) -@equiv{} -(cond (@var{arg1}) - (@var{arg2}) - (@var{arg3})) -@end group -@end example - -You could almost write @code{or} in terms of @code{if}, but not quite: - -@example -@group -(if @var{arg1} @var{arg1} - (if @var{arg2} @var{arg2} - @var{arg3})) -@end group -@end example - -@noindent -This is not completely equivalent because it can evaluate @var{arg1} or -@var{arg2} twice. By contrast, @code{(or @var{arg1} @var{arg2} -@var{arg3})} never evaluates any argument more than once. -@end defspec - -@node Iteration -@section Iteration -@cindex iteration -@cindex recursion - - Iteration means executing part of a program repetitively. For -example, you might want to repeat some computation once for each element -of a list, or once for each integer from 0 to @var{n}. You can do this -in XEmacs Lisp with the special form @code{while}: - -@defspec while condition forms@dots{} -@code{while} first evaluates @var{condition}. If the result is -non-@code{nil}, it evaluates @var{forms} in textual order. Then it -reevaluates @var{condition}, and if the result is non-@code{nil}, it -evaluates @var{forms} again. This process repeats until @var{condition} -evaluates to @code{nil}. - -There is no limit on the number of iterations that may occur. The loop -will continue until either @var{condition} evaluates to @code{nil} or -until an error or @code{throw} jumps out of it (@pxref{Nonlocal Exits}). - -The value of a @code{while} form is always @code{nil}. - -@example -@group -(setq num 0) - @result{} 0 -@end group -@group -(while (< num 4) - (princ (format "Iteration %d." num)) - (setq num (1+ num))) - @print{} Iteration 0. - @print{} Iteration 1. - @print{} Iteration 2. - @print{} Iteration 3. - @result{} nil -@end group -@end example - -If you would like to execute something on each iteration before the -end-test, put it together with the end-test in a @code{progn} as the -first argument of @code{while}, as shown here: - -@example -@group -(while (progn - (forward-line 1) - (not (looking-at "^$")))) -@end group -@end example - -@noindent -This moves forward one line and continues moving by lines until it -reaches an empty. It is unusual in that the @code{while} has no body, -just the end test (which also does the real work of moving point). -@end defspec - -@node Nonlocal Exits -@section Nonlocal Exits -@cindex nonlocal exits - - A @dfn{nonlocal exit} is a transfer of control from one point in a -program to another remote point. Nonlocal exits can occur in XEmacs Lisp -as a result of errors; you can also use them under explicit control. -Nonlocal exits unbind all variable bindings made by the constructs being -exited. - -@menu -* Catch and Throw:: Nonlocal exits for the program's own purposes. -* Examples of Catch:: Showing how such nonlocal exits can be written. -* Errors:: How errors are signaled and handled. -* Cleanups:: Arranging to run a cleanup form if an error happens. -@end menu - -@node Catch and Throw -@subsection Explicit Nonlocal Exits: @code{catch} and @code{throw} - - Most control constructs affect only the flow of control within the -construct itself. The function @code{throw} is the exception to this -rule of normal program execution: it performs a nonlocal exit on -request. (There are other exceptions, but they are for error handling -only.) @code{throw} is used inside a @code{catch}, and jumps back to -that @code{catch}. For example: - -@example -@group -(catch 'foo - (progn - @dots{} - (throw 'foo t) - @dots{})) -@end group -@end example - -@noindent -The @code{throw} transfers control straight back to the corresponding -@code{catch}, which returns immediately. The code following the -@code{throw} is not executed. The second argument of @code{throw} is used -as the return value of the @code{catch}. - - The @code{throw} and the @code{catch} are matched through the first -argument: @code{throw} searches for a @code{catch} whose first argument -is @code{eq} to the one specified. Thus, in the above example, the -@code{throw} specifies @code{foo}, and the @code{catch} specifies the -same symbol, so that @code{catch} is applicable. If there is more than -one applicable @code{catch}, the innermost one takes precedence. - - Executing @code{throw} exits all Lisp constructs up to the matching -@code{catch}, including function calls. When binding constructs such as -@code{let} or function calls are exited in this way, the bindings are -unbound, just as they are when these constructs exit normally -(@pxref{Local Variables}). Likewise, @code{throw} restores the buffer -and position saved by @code{save-excursion} (@pxref{Excursions}), and -the narrowing status saved by @code{save-restriction} and the window -selection saved by @code{save-window-excursion} (@pxref{Window -Configurations}). It also runs any cleanups established with the -@code{unwind-protect} special form when it exits that form -(@pxref{Cleanups}). - - The @code{throw} need not appear lexically within the @code{catch} -that it jumps to. It can equally well be called from another function -called within the @code{catch}. As long as the @code{throw} takes place -chronologically after entry to the @code{catch}, and chronologically -before exit from it, it has access to that @code{catch}. This is why -@code{throw} can be used in commands such as @code{exit-recursive-edit} -that throw back to the editor command loop (@pxref{Recursive Editing}). - -@cindex CL note---only @code{throw} in Emacs -@quotation -@b{Common Lisp note:} Most other versions of Lisp, including Common Lisp, -have several ways of transferring control nonsequentially: @code{return}, -@code{return-from}, and @code{go}, for example. XEmacs Lisp has only -@code{throw}. -@end quotation - -@defspec catch tag body@dots{} -@cindex tag on run time stack -@code{catch} establishes a return point for the @code{throw} function. The -return point is distinguished from other such return points by @var{tag}, -which may be any Lisp object. The argument @var{tag} is evaluated normally -before the return point is established. - -With the return point in effect, @code{catch} evaluates the forms of the -@var{body} in textual order. If the forms execute normally, without -error or nonlocal exit, the value of the last body form is returned from -the @code{catch}. - -If a @code{throw} is done within @var{body} specifying the same value -@var{tag}, the @code{catch} exits immediately; the value it returns is -whatever was specified as the second argument of @code{throw}. -@end defspec - -@defun throw tag value -The purpose of @code{throw} is to return from a return point previously -established with @code{catch}. The argument @var{tag} is used to choose -among the various existing return points; it must be @code{eq} to the value -specified in the @code{catch}. If multiple return points match @var{tag}, -the innermost one is used. - -The argument @var{value} is used as the value to return from that -@code{catch}. - -@kindex no-catch -If no return point is in effect with tag @var{tag}, then a @code{no-catch} -error is signaled with data @code{(@var{tag} @var{value})}. -@end defun - -@node Examples of Catch -@subsection Examples of @code{catch} and @code{throw} - - One way to use @code{catch} and @code{throw} is to exit from a doubly -nested loop. (In most languages, this would be done with a ``go to''.) -Here we compute @code{(foo @var{i} @var{j})} for @var{i} and @var{j} -varying from 0 to 9: - -@example -@group -(defun search-foo () - (catch 'loop - (let ((i 0)) - (while (< i 10) - (let ((j 0)) - (while (< j 10) - (if (foo i j) - (throw 'loop (list i j))) - (setq j (1+ j)))) - (setq i (1+ i)))))) -@end group -@end example - -@noindent -If @code{foo} ever returns non-@code{nil}, we stop immediately and return a -list of @var{i} and @var{j}. If @code{foo} always returns @code{nil}, the -@code{catch} returns normally, and the value is @code{nil}, since that -is the result of the @code{while}. - - Here are two tricky examples, slightly different, showing two -return points at once. First, two return points with the same tag, -@code{hack}: - -@example -@group -(defun catch2 (tag) - (catch tag - (throw 'hack 'yes))) -@result{} catch2 -@end group - -@group -(catch 'hack - (print (catch2 'hack)) - 'no) -@print{} yes -@result{} no -@end group -@end example - -@noindent -Since both return points have tags that match the @code{throw}, it goes to -the inner one, the one established in @code{catch2}. Therefore, -@code{catch2} returns normally with value @code{yes}, and this value is -printed. Finally the second body form in the outer @code{catch}, which is -@code{'no}, is evaluated and returned from the outer @code{catch}. - - Now let's change the argument given to @code{catch2}: - -@example -@group -(defun catch2 (tag) - (catch tag - (throw 'hack 'yes))) -@result{} catch2 -@end group - -@group -(catch 'hack - (print (catch2 'quux)) - 'no) -@result{} yes -@end group -@end example - -@noindent -We still have two return points, but this time only the outer one has -the tag @code{hack}; the inner one has the tag @code{quux} instead. -Therefore, @code{throw} makes the outer @code{catch} return the value -@code{yes}. The function @code{print} is never called, and the -body-form @code{'no} is never evaluated. - -@node Errors -@subsection Errors -@cindex errors - - When XEmacs Lisp attempts to evaluate a form that, for some reason, -cannot be evaluated, it @dfn{signals} an @dfn{error}. - - When an error is signaled, XEmacs's default reaction is to print an -error message and terminate execution of the current command. This is -the right thing to do in most cases, such as if you type @kbd{C-f} at -the end of the buffer. - - In complicated programs, simple termination may not be what you want. -For example, the program may have made temporary changes in data -structures, or created temporary buffers that should be deleted before -the program is finished. In such cases, you would use -@code{unwind-protect} to establish @dfn{cleanup expressions} to be -evaluated in case of error. (@xref{Cleanups}.) Occasionally, you may -wish the program to continue execution despite an error in a subroutine. -In these cases, you would use @code{condition-case} to establish -@dfn{error handlers} to recover control in case of error. - - Resist the temptation to use error handling to transfer control from -one part of the program to another; use @code{catch} and @code{throw} -instead. @xref{Catch and Throw}. - -@menu -* Signaling Errors:: How to report an error. -* Processing of Errors:: What XEmacs does when you report an error. -* Handling Errors:: How you can trap errors and continue execution. -* Error Symbols:: How errors are classified for trapping them. -@end menu - -@node Signaling Errors -@subsubsection How to Signal an Error -@cindex signaling errors - - Most errors are signaled ``automatically'' within Lisp primitives -which you call for other purposes, such as if you try to take the -@sc{car} of an integer or move forward a character at the end of the -buffer; you can also signal errors explicitly with the functions -@code{error} and @code{signal}. - - Quitting, which happens when the user types @kbd{C-g}, is not -considered an error, but it is handled almost like an error. -@xref{Quitting}. - -@defun error format-string &rest args -This function signals an error with an error message constructed by -applying @code{format} (@pxref{String Conversion}) to -@var{format-string} and @var{args}. - -These examples show typical uses of @code{error}: - -@example -@group -(error "You have committed an error. - Try something else.") - @error{} You have committed an error. - Try something else. -@end group - -@group -(error "You have committed %d errors." 10) - @error{} You have committed 10 errors. -@end group -@end example - -@code{error} works by calling @code{signal} with two arguments: the -error symbol @code{error}, and a list containing the string returned by -@code{format}. - -If you want to use your own string as an error message verbatim, don't -just write @code{(error @var{string})}. If @var{string} contains -@samp{%}, it will be interpreted as a format specifier, with undesirable -results. Instead, use @code{(error "%s" @var{string})}. -@end defun - -@defun signal error-symbol data -This function signals an error named by @var{error-symbol}. The -argument @var{data} is a list of additional Lisp objects relevant to the -circumstances of the error. - -The argument @var{error-symbol} must be an @dfn{error symbol}---a symbol -bearing a property @code{error-conditions} whose value is a list of -condition names. This is how XEmacs Lisp classifies different sorts of -errors. - -The number and significance of the objects in @var{data} depends on -@var{error-symbol}. For example, with a @code{wrong-type-arg} error, -there are two objects in the list: a predicate that describes the type -that was expected, and the object that failed to fit that type. -@xref{Error Symbols}, for a description of error symbols. - -Both @var{error-symbol} and @var{data} are available to any error -handlers that handle the error: @code{condition-case} binds a local -variable to a list of the form @code{(@var{error-symbol} .@: -@var{data})} (@pxref{Handling Errors}). If the error is not handled, -these two values are used in printing the error message. - -The function @code{signal} never returns (though in older Emacs versions -it could sometimes return). - -@smallexample -@group -(signal 'wrong-number-of-arguments '(x y)) - @error{} Wrong number of arguments: x, y -@end group - -@group -(signal 'no-such-error '("My unknown error condition.")) - @error{} peculiar error: "My unknown error condition." -@end group -@end smallexample -@end defun - -@cindex CL note---no continuable errors -@quotation -@b{Common Lisp note:} XEmacs Lisp has nothing like the Common Lisp -concept of continuable errors. -@end quotation - -@node Processing of Errors -@subsubsection How XEmacs Processes Errors - -When an error is signaled, @code{signal} searches for an active -@dfn{handler} for the error. A handler is a sequence of Lisp -expressions designated to be executed if an error happens in part of the -Lisp program. If the error has an applicable handler, the handler is -executed, and control resumes following the handler. The handler -executes in the environment of the @code{condition-case} that -established it; all functions called within that @code{condition-case} -have already been exited, and the handler cannot return to them. - -If there is no applicable handler for the error, the current command is -terminated and control returns to the editor command loop, because the -command loop has an implicit handler for all kinds of errors. The -command loop's handler uses the error symbol and associated data to -print an error message. - -@cindex @code{debug-on-error} use -An error that has no explicit handler may call the Lisp debugger. The -debugger is enabled if the variable @code{debug-on-error} (@pxref{Error -Debugging}) is non-@code{nil}. Unlike error handlers, the debugger runs -in the environment of the error, so that you can examine values of -variables precisely as they were at the time of the error. - -@node Handling Errors -@subsubsection Writing Code to Handle Errors -@cindex error handler -@cindex handling errors - - The usual effect of signaling an error is to terminate the command -that is running and return immediately to the XEmacs editor command loop. -You can arrange to trap errors occurring in a part of your program by -establishing an error handler, with the special form -@code{condition-case}. A simple example looks like this: - -@example -@group -(condition-case nil - (delete-file filename) - (error nil)) -@end group -@end example - -@noindent -This deletes the file named @var{filename}, catching any error and -returning @code{nil} if an error occurs. - - The second argument of @code{condition-case} is called the -@dfn{protected form}. (In the example above, the protected form is a -call to @code{delete-file}.) The error handlers go into effect when -this form begins execution and are deactivated when this form returns. -They remain in effect for all the intervening time. In particular, they -are in effect during the execution of functions called by this form, in -their subroutines, and so on. This is a good thing, since, strictly -speaking, errors can be signaled only by Lisp primitives (including -@code{signal} and @code{error}) called by the protected form, not by the -protected form itself. - - The arguments after the protected form are handlers. Each handler -lists one or more @dfn{condition names} (which are symbols) to specify -which errors it will handle. The error symbol specified when an error -is signaled also defines a list of condition names. A handler applies -to an error if they have any condition names in common. In the example -above, there is one handler, and it specifies one condition name, -@code{error}, which covers all errors. - - The search for an applicable handler checks all the established handlers -starting with the most recently established one. Thus, if two nested -@code{condition-case} forms offer to handle the same error, the inner of -the two will actually handle it. - - When an error is handled, control returns to the handler. Before this -happens, XEmacs unbinds all variable bindings made by binding constructs -that are being exited and executes the cleanups of all -@code{unwind-protect} forms that are exited. Once control arrives at -the handler, the body of the handler is executed. - - After execution of the handler body, execution continues by returning -from the @code{condition-case} form. Because the protected form is -exited completely before execution of the handler, the handler cannot -resume execution at the point of the error, nor can it examine variable -bindings that were made within the protected form. All it can do is -clean up and proceed. - - @code{condition-case} is often used to trap errors that are -predictable, such as failure to open a file in a call to -@code{insert-file-contents}. It is also used to trap errors that are -totally unpredictable, such as when the program evaluates an expression -read from the user. - - Error signaling and handling have some resemblance to @code{throw} and -@code{catch}, but they are entirely separate facilities. An error -cannot be caught by a @code{catch}, and a @code{throw} cannot be handled -by an error handler (though using @code{throw} when there is no suitable -@code{catch} signals an error that can be handled). - -@defspec condition-case var protected-form handlers@dots{} -This special form establishes the error handlers @var{handlers} around -the execution of @var{protected-form}. If @var{protected-form} executes -without error, the value it returns becomes the value of the -@code{condition-case} form; in this case, the @code{condition-case} has -no effect. The @code{condition-case} form makes a difference when an -error occurs during @var{protected-form}. - -Each of the @var{handlers} is a list of the form @code{(@var{conditions} -@var{body}@dots{})}. Here @var{conditions} is an error condition name -to be handled, or a list of condition names; @var{body} is one or more -Lisp expressions to be executed when this handler handles an error. -Here are examples of handlers: - -@smallexample -@group -(error nil) - -(arith-error (message "Division by zero")) - -((arith-error file-error) - (message - "Either division by zero or failure to open a file")) -@end group -@end smallexample - -Each error that occurs has an @dfn{error symbol} that describes what -kind of error it is. The @code{error-conditions} property of this -symbol is a list of condition names (@pxref{Error Symbols}). Emacs -searches all the active @code{condition-case} forms for a handler that -specifies one or more of these condition names; the innermost matching -@code{condition-case} handles the error. Within this -@code{condition-case}, the first applicable handler handles the error. - -After executing the body of the handler, the @code{condition-case} -returns normally, using the value of the last form in the handler body -as the overall value. - -The argument @var{var} is a variable. @code{condition-case} does not -bind this variable when executing the @var{protected-form}, only when it -handles an error. At that time, it binds @var{var} locally to a list of -the form @code{(@var{error-symbol} . @var{data})}, giving the -particulars of the error. The handler can refer to this list to decide -what to do. For example, if the error is for failure opening a file, -the file name is the second element of @var{data}---the third element of -@var{var}. - -If @var{var} is @code{nil}, that means no variable is bound. Then the -error symbol and associated data are not available to the handler. -@end defspec - -@cindex @code{arith-error} example -Here is an example of using @code{condition-case} to handle the error -that results from dividing by zero. The handler prints out a warning -message and returns a very large number. - -@smallexample -@group -(defun safe-divide (dividend divisor) - (condition-case err - ;; @r{Protected form.} - (/ dividend divisor) - ;; @r{The handler.} - (arith-error ; @r{Condition.} - (princ (format "Arithmetic error: %s" err)) - 1000000))) -@result{} safe-divide -@end group - -@group -(safe-divide 5 0) - @print{} Arithmetic error: (arith-error) -@result{} 1000000 -@end group -@end smallexample - -@noindent -The handler specifies condition name @code{arith-error} so that it will handle only division-by-zero errors. Other kinds of errors will not be handled, at least not by this @code{condition-case}. Thus, - -@smallexample -@group -(safe-divide nil 3) - @error{} Wrong type argument: integer-or-marker-p, nil -@end group -@end smallexample - - Here is a @code{condition-case} that catches all kinds of errors, -including those signaled with @code{error}: - -@smallexample -@group -(setq baz 34) - @result{} 34 -@end group - -@group -(condition-case err - (if (eq baz 35) - t - ;; @r{This is a call to the function @code{error}.} - (error "Rats! The variable %s was %s, not 35" 'baz baz)) - ;; @r{This is the handler; it is not a form.} - (error (princ (format "The error was: %s" err)) - 2)) -@print{} The error was: (error "Rats! The variable baz was 34, not 35") -@result{} 2 -@end group -@end smallexample - -@node Error Symbols -@subsubsection Error Symbols and Condition Names -@cindex error symbol -@cindex error name -@cindex condition name -@cindex user-defined error -@kindex error-conditions - - When you signal an error, you specify an @dfn{error symbol} to specify -the kind of error you have in mind. Each error has one and only one -error symbol to categorize it. This is the finest classification of -errors defined by the XEmacs Lisp language. - - These narrow classifications are grouped into a hierarchy of wider -classes called @dfn{error conditions}, identified by @dfn{condition -names}. The narrowest such classes belong to the error symbols -themselves: each error symbol is also a condition name. There are also -condition names for more extensive classes, up to the condition name -@code{error} which takes in all kinds of errors. Thus, each error has -one or more condition names: @code{error}, the error symbol if that -is distinct from @code{error}, and perhaps some intermediate -classifications. - - In order for a symbol to be an error symbol, it must have an -@code{error-conditions} property which gives a list of condition names. -This list defines the conditions that this kind of error belongs to. -(The error symbol itself, and the symbol @code{error}, should always be -members of this list.) Thus, the hierarchy of condition names is -defined by the @code{error-conditions} properties of the error symbols. - - In addition to the @code{error-conditions} list, the error symbol -should have an @code{error-message} property whose value is a string to -be printed when that error is signaled but not handled. If the -@code{error-message} property exists, but is not a string, the error -message @samp{peculiar error} is used. -@cindex peculiar error - - Here is how we define a new error symbol, @code{new-error}: - -@example -@group -(put 'new-error - 'error-conditions - '(error my-own-errors new-error)) -@result{} (error my-own-errors new-error) -@end group -@group -(put 'new-error 'error-message "A new error") -@result{} "A new error" -@end group -@end example - -@noindent -This error has three condition names: @code{new-error}, the narrowest -classification; @code{my-own-errors}, which we imagine is a wider -classification; and @code{error}, which is the widest of all. - - The error string should start with a capital letter but it should -not end with a period. This is for consistency with the rest of Emacs. - - Naturally, XEmacs will never signal @code{new-error} on its own; only -an explicit call to @code{signal} (@pxref{Signaling Errors}) in your -code can do this: - -@example -@group -(signal 'new-error '(x y)) - @error{} A new error: x, y -@end group -@end example - - This error can be handled through any of the three condition names. -This example handles @code{new-error} and any other errors in the class -@code{my-own-errors}: - -@example -@group -(condition-case foo - (bar nil t) - (my-own-errors nil)) -@end group -@end example - - The significant way that errors are classified is by their condition -names---the names used to match errors with handlers. An error symbol -serves only as a convenient way to specify the intended error message -and list of condition names. It would be cumbersome to give -@code{signal} a list of condition names rather than one error symbol. - - By contrast, using only error symbols without condition names would -seriously decrease the power of @code{condition-case}. Condition names -make it possible to categorize errors at various levels of generality -when you write an error handler. Using error symbols alone would -eliminate all but the narrowest level of classification. - - @xref{Standard Errors}, for a list of all the standard error symbols -and their conditions. - -@node Cleanups -@subsection Cleaning Up from Nonlocal Exits - - The @code{unwind-protect} construct is essential whenever you -temporarily put a data structure in an inconsistent state; it permits -you to ensure the data are consistent in the event of an error or throw. - -@defspec unwind-protect body cleanup-forms@dots{} -@cindex cleanup forms -@cindex protected forms -@cindex error cleanup -@cindex unwinding -@code{unwind-protect} executes the @var{body} with a guarantee that the -@var{cleanup-forms} will be evaluated if control leaves @var{body}, no -matter how that happens. The @var{body} may complete normally, or -execute a @code{throw} out of the @code{unwind-protect}, or cause an -error; in all cases, the @var{cleanup-forms} will be evaluated. - -If the @var{body} forms finish normally, @code{unwind-protect} returns -the value of the last @var{body} form, after it evaluates the -@var{cleanup-forms}. If the @var{body} forms do not finish, -@code{unwind-protect} does not return any value in the normal sense. - -Only the @var{body} is actually protected by the @code{unwind-protect}. -If any of the @var{cleanup-forms} themselves exits nonlocally (e.g., via -a @code{throw} or an error), @code{unwind-protect} is @emph{not} -guaranteed to evaluate the rest of them. If the failure of one of the -@var{cleanup-forms} has the potential to cause trouble, then protect it -with another @code{unwind-protect} around that form. - -The number of currently active @code{unwind-protect} forms counts, -together with the number of local variable bindings, against the limit -@code{max-specpdl-size} (@pxref{Local Variables}). -@end defspec - - For example, here we make an invisible buffer for temporary use, and -make sure to kill it before finishing: - -@smallexample -@group -(save-excursion - (let ((buffer (get-buffer-create " *temp*"))) - (set-buffer buffer) - (unwind-protect - @var{body} - (kill-buffer buffer)))) -@end group -@end smallexample - -@noindent -You might think that we could just as well write @code{(kill-buffer -(current-buffer))} and dispense with the variable @code{buffer}. -However, the way shown above is safer, if @var{body} happens to get an -error after switching to a different buffer! (Alternatively, you could -write another @code{save-excursion} around the body, to ensure that the -temporary buffer becomes current in time to kill it.) - -@findex ftp-login - Here is an actual example taken from the file @file{ftp.el}. It -creates a process (@pxref{Processes}) to try to establish a connection -to a remote machine. As the function @code{ftp-login} is highly -susceptible to numerous problems that the writer of the function cannot -anticipate, it is protected with a form that guarantees deletion of the -process in the event of failure. Otherwise, XEmacs might fill up with -useless subprocesses. - -@smallexample -@group -(let ((win nil)) - (unwind-protect - (progn - (setq process (ftp-setup-buffer host file)) - (if (setq win (ftp-login process host user password)) - (message "Logged in") - (error "Ftp login failed"))) - (or win (and process (delete-process process))))) -@end group -@end smallexample - - This example actually has a small bug: if the user types @kbd{C-g} to -quit, and the quit happens immediately after the function -@code{ftp-setup-buffer} returns but before the variable @code{process} is -set, the process will not be killed. There is no easy way to fix this bug, -but at least it is very unlikely. - - Here is another example which uses @code{unwind-protect} to make sure -to kill a temporary buffer. In this example, the value returned by -@code{unwind-protect} is used. - -@smallexample -(defun shell-command-string (cmd) - "Return the output of the shell command CMD, as a string." - (save-excursion - (set-buffer (generate-new-buffer " OS*cmd")) - (shell-command cmd t) - (unwind-protect - (buffer-string) - (kill-buffer (current-buffer))))) -@end smallexample diff --git a/man/lispref/customize.texi b/man/lispref/customize.texi deleted file mode 100644 index 6d7a3a5..0000000 --- a/man/lispref/customize.texi +++ /dev/null @@ -1,750 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1997, 1998 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../info/customize -@node Customization, , , Top -@chapter Writing Customization Definitions - - This chapter describes how to declare user options for customization, -and also customization groups for classifying them. We use the term -@dfn{customization item} to include both kinds of customization -definitions---as well as face definitions. - -@menu -* Common Keywords:: -* Group Definitions:: -* Variable Definitions:: -* Customization Types:: -@end menu - -@node Common Keywords -@section Common Keywords for All Kinds of Items - - All kinds of customization declarations (for variables and groups, and -for faces) accept keyword arguments for specifying various information. -This section describes some keywords that apply to all kinds. - - All of these keywords, except @code{:tag}, can be used more than once -in a given item. Each use of the keyword has an independent effect. -The keyword @code{:tag} is an exception because any given item can only -display one name. - -@table @code -@item :tag @var{name} -Use @var{name}, a string, instead of the item's name, to label the item -in customization menus and buffers. - -@item :group @var{group} -Put this customization item in group @var{group}. When you use -@code{:group} in a @code{defgroup}, it makes the new group a subgroup of -@var{group}. - -If you use this keyword more than once, you can put a single item into -more than one group. Displaying any of those groups will show this -item. Be careful not to overdo this! - -@item :link @var{link-data} -Include an external link after the documentation string for this item. -This is a sentence containing an active field which references some -other documentation. - -There are three alternatives you can use for @var{link-data}: - -@table @code -@item (custom-manual @var{info-node}) -Link to an Info node; @var{info-node} is a string which specifies the -node name, as in @code{"(emacs)Top"}. The link appears as -@samp{[manual]} in the customization buffer. - -@item (info-link @var{info-node}) -Like @code{custom-manual} except that the link appears -in the customization buffer with the Info node name. - -@item (url-link @var{url}) -Link to a web page; @var{url} is a string which specifies the @sc{url}. -The link appears in the customization buffer as @var{url}. -@end table - -You can specify the text to use in the customization buffer by adding -@code{:tag @var{name}} after the first element of the @var{link-data}; -for example, @code{(info-link :tag "foo" "(emacs)Top")} makes a link to -the Emacs manual which appears in the buffer as @samp{foo}. - -An item can have more than one external link; however, most items have -none at all. - -@item :load @var{file} -Load file @var{file} (a string) before displaying this customization -item. Loading is done with @code{load-library}, and only if the file is -not already loaded. - -@item :require @var{feature} -Require feature @var{feature} (a symbol) when installing a value for -this item (an option or a face) that was saved using the customization -feature. This is done by calling @code{require}. - -The most common reason to use @code{:require} is when a variable enables -a feature such as a minor mode, and just setting the variable won't have -any effect unless the code which implements the mode is loaded. -@end table - -@node Group Definitions -@section Defining Custom Groups - - Each Emacs Lisp package should have one main customization group which -contains all the options, faces and other groups in the package. If the -package has a small number of options and faces, use just one group and -put everything in it. When there are more than twelve or so options and -faces, then you should structure them into subgroups, and put the -subgroups under the package's main customization group. It is OK to -put some of the options and faces in the package's main group alongside -the subgroups. - - The package's main or only group should be a member of one or more of -the standard customization groups. (To display the full list of them, -use @kbd{M-x customize}.) Choose one or more of them (but not too -many), and add your group to each of them using the @code{:group} -keyword. - - The way to declare new customization groups is with @code{defgroup}. - -@tindex defgroup -@defmac defgroup group members doc [keyword value]... -Declare @var{group} as a customization group containing @var{members}. -Do not quote the symbol @var{group}. The argument @var{doc} specifies -the documentation string for the group. - -The argument @var{members} is a list specifying an initial set of -customization items to be members of the group. However, most often -@var{members} is @code{nil}, and you specify the group's members by -using the @code{:group} keyword when defining those members. - -If you want to specify group members through @var{members}, each element -should have the form @code{(@var{name} @var{widget})}. Here @var{name} -is a symbol, and @var{widget} is a widget type for editing that symbol. -Useful widgets are @code{custom-variable} for a variable, -@code{custom-face} for a face, and @code{custom-group} for a group. - -In addition to the common keywords (@pxref{Common Keywords}), you can -use this keyword in @code{defgroup}: - -@table @code -@item :prefix @var{prefix} -If the name of an item in the group starts with @var{prefix}, then the -tag for that item is constructed (by default) by omitting @var{prefix}. - -One group can have any number of prefixes. -@end table -@end defmac - -@c Doesn't apply to XEmacs -@c -@c The prefix-discarding feature is currently turned off, which means -@c that @code{:prefix} currently has no effect. We did this because we -@c found that discarding the specified prefixes often led to confusing -@c names for options. This happened because the people who wrote the -@c @code{defgroup} definitions for various groups added @code{:prefix} -@c keywords whenever they make logical sense---that is, whenever the -@c variables in the library have a common prefix. - -@c In order to obtain good results with @code{:prefix}, it would be -@c necessary to check the specific effects of discarding a particular -@c prefix, given the specific items in a group and their names and -@c documentation. If the resulting text is not clear, then @code{:prefix} -@c should not be used in that case. - -@c It should be possible to recheck all the customization groups, delete -@c the @code{:prefix} specifications which give unclear results, and then -@c turn this feature back on, if someone would like to do the work. - -@node Variable Definitions -@section Defining Customization Variables - - Use @code{defcustom} to declare user-editable variables. - -@tindex defcustom -@defmac defcustom option default doc [keyword value]... -Declare @var{option} as a customizable user option variable. Do not -quote @var{option}. The argument @var{doc} specifies the documentation -string for the variable. - -If @var{option} is void, @code{defcustom} initializes it to -@var{default}. @var{default} should be an expression to compute the -value; be careful in writing it, because it can be evaluated on more -than one occasion. - -The following additional keywords are defined: - -@table @code -@item :type @var{type} -Use @var{type} as the data type for this option. It specifies which -values are legitimate, and how to display the value. -@xref{Customization Types}, for more information. - -@item :options @var{list} -Specify @var{list} as the list of reasonable values for use in this -option. - -Currently this is meaningful only when the type is @code{hook}. In that -case, the elements of @var{list} should be functions that are useful as -elements of the hook value. The user is not restricted to using only -these functions, but they are offered as convenient alternatives. - -@item :version @var{version} -This option specifies that the variable was first introduced, or its -default value was changed, in Emacs version @var{version}. The value -@var{version} must be a string. For example, - -@example -(defcustom foo-max 34 - "*Maximum number of foo's allowed." - :type 'integer - :group 'foo - :version "20.3") -@end example - -@item :set @var{setfunction} -Specify @var{setfunction} as the way to change the value of this option. -The function @var{setfunction} should take two arguments, a symbol and -the new value, and should do whatever is necessary to update the value -properly for this option (which may not mean simply setting the option -as a Lisp variable). The default for @var{setfunction} is -@code{set-default}. - -@item :get @var{getfunction} -Specify @var{getfunction} as the way to extract the value of this -option. The function @var{getfunction} should take one argument, a -symbol, and should return the ``current value'' for that symbol (which -need not be the symbol's Lisp value). The default is -@code{default-value}. - -@item :initialize @var{function} -@var{function} should be a function used to initialize the variable when -the @code{defcustom} is evaluated. It should take two arguments, the -symbol and value. Here are some predefined functions meant for use in -this way: - -@table @code -@item custom-initialize-set -Use the variable's @code{:set} function to initialize the variable, but -do not reinitialize it if it is already non-void. This is the default -@code{:initialize} function. - -@item custom-initialize-default -Like @code{custom-initialize-set}, but use the function -@code{set-default} to set the variable, instead of the variable's -@code{:set} function. This is the usual choice for a variable whose -@code{:set} function enables or disables a minor mode; with this choice, -defining the variable will not call the minor mode function, but -customizing the variable will do so. - -@item custom-initialize-reset -Always use the @code{:set} function to initialize the variable. If the -variable is already non-void, reset it by calling the @code{:set} -function using the current value (returned by the @code{:get} method). - -@item custom-initialize-changed -Use the @code{:set} function to initialize the variable, if it is -already set or has been customized; otherwise, just use -@code{set-default}. -@end table -@end table -@end defmac - - The @code{:require} option is useful for an option that turns on the -operation of a certain feature. Assuming that the package is coded to -check the value of the option, you still need to arrange for the package -to be loaded. You can do that with @code{:require}. @xref{Common -Keywords}. Here is an example, from the library @file{paren.el}: - -@example -(defcustom show-paren-mode nil - "Toggle Show Paren mode@enddots{}" - :set (lambda (symbol value) - (show-paren-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'paren-showing - :require 'paren) -@end example - -@ignore -Use @code{custom-add-option} to specify that a specific function is -useful as an member of a hook. - -@defun custom-add-option symbol option -To the variable @var{symbol} add @var{option}. - -If @var{symbol} is a hook variable, @var{option} should be a hook -member. For other types variables, the effect is undefined." -@end defun -@end ignore - -Internally, @code{defcustom} uses the symbol property -@code{standard-value} to record the expression for the default value, -and @code{saved-value} to record the value saved by the user with the -customization buffer. The @code{saved-value} property is actually a -list whose car is an expression which evaluates to the value. - -@node Customization Types -@section Customization Types - - When you define a user option with @code{defcustom}, you must specify -its @dfn{customization type}. That is a Lisp object which describes (1) -which values are legitimate and (2) how to display the value in the -customization buffer for editing. - - You specify the customization type in @code{defcustom} with the -@code{:type} keyword. The argument of @code{:type} is evaluated; since -types that vary at run time are rarely useful, normally you use a quoted -constant. For example: - -@example -(defcustom diff-command "diff" - "*The command to use to run diff." - :type '(string) - :group 'diff) -@end example - - In general, a customization type is a list whose first element is a -symbol, one of the customization type names defined in the following -sections. After this symbol come a number of arguments, depending on -the symbol. Between the type symbol and its arguments, you can -optionally write keyword-value pairs (@pxref{Type Keywords}). - - Some of the type symbols do not use any arguments; those are called -@dfn{simple types}. For a simple type, if you do not use any -keyword-value pairs, you can omit the parentheses around the type -symbol. For example just @code{string} as a customization type is -equivalent to @code{(string)}. - -@menu -* Simple Types:: -* Composite Types:: -* Splicing into Lists:: -* Type Keywords:: -@end menu - -@node Simple Types -@subsection Simple Types - - This section describes all the simple customization types. - -@table @code -@item sexp -The value may be any Lisp object that can be printed and read back. You -can use @code{sexp} as a fall-back for any option, if you don't want to -take the time to work out a more specific type to use. - -@item integer -The value must be an integer, and is represented textually -in the customization buffer. - -@item number -The value must be a number, and is represented textually in the -customization buffer. - -@item string -The value must be a string, and the customization buffer shows just the -contents, with no delimiting @samp{"} characters and no quoting with -@samp{\}. - -@item regexp -Like @code{string} except that the string must be a valid regular -expression. - -@item character -The value must be a character code. A character code is actually an -integer, but this type shows the value by inserting the character in the -buffer, rather than by showing the number. - -@item file -The value must be a file name, and you can do completion with -@kbd{M-@key{TAB}}. - -@item (file :must-match t) -The value must be a file name for an existing file, and you can do -completion with @kbd{M-@key{TAB}}. - -@item directory -The value must be a directory name, and you can do completion with -@kbd{M-@key{TAB}}. - -@item symbol -The value must be a symbol. It appears in the customization buffer as -the name of the symbol. - -@item function -The value must be either a lambda expression or a function name. When -it is a function name, you can do completion with @kbd{M-@key{TAB}}. - -@item variable -The value must be a variable name, and you can do completion with -@kbd{M-@key{TAB}}. - -@item face -The value must be a symbol which is a face name. - -@item boolean -The value is boolean---either @code{nil} or @code{t}. Note that by -using @code{choice} and @code{const} together (see the next section), -you can specify that the value must be @code{nil} or @code{t}, but also -specify the text to describe each value in a way that fits the specific -meaning of the alternative. -@end table - -@node Composite Types -@subsection Composite Types - - When none of the simple types is appropriate, you can use composite -types, which build new types from other types. Here are several ways of -doing that: - -@table @code -@item (restricted-sexp :match-alternatives @var{criteria}) -The value may be any Lisp object that satisfies one of @var{criteria}. -@var{criteria} should be a list, and each elements should be -one of these possibilities: - -@itemize @bullet -@item -A predicate---that is, a function of one argument that returns non-@code{nil} -if the argument fits a certain type. This means that objects of that type -are acceptable. - -@item -A quoted constant---that is, @code{'@var{object}}. This means that -@var{object} itself is an acceptable value. -@end itemize - -For example, - -@example -(restricted-sexp :match-alternatives (integerp 't 'nil)) -@end example - -@noindent -allows integers, @code{t} and @code{nil} as legitimate values. - -The customization buffer shows all legitimate values using their read -syntax, and the user edits them textually. - -@item (cons @var{car-type} @var{cdr-type}) -The value must be a cons cell, its @sc{car} must fit @var{car-type}, and -its @sc{cdr} must fit @var{cdr-type}. For example, @code{(cons string -symbol)} is a customization type which matches values such as -@code{("foo" . foo)}. - -In the customization buffer, the @sc{car} and the @sc{cdr} are -displayed and edited separately, each according to the type -that you specify for it. - -@item (list @var{element-types}@dots{}) -The value must be a list with exactly as many elements as the -@var{element-types} you have specified; and each element must fit the -corresponding @var{element-type}. - -For example, @code{(list integer string function)} describes a list of -three elements; the first element must be an integer, the second a -string, and the third a function. - -In the customization buffer, the each element is displayed and edited -separately, according to the type specified for it. - -@item (vector @var{element-types}@dots{}) -Like @code{list} except that the value must be a vector instead of a -list. The elements work the same as in @code{list}. - -@item (choice @var{alternative-types}...) -The value must fit at least one of @var{alternative-types}. -For example, @code{(choice integer string)} allows either an -integer or a string. - -In the customization buffer, the user selects one of the alternatives -using a menu, and can then edit the value in the usual way for that -alternative. - -Normally the strings in this menu are determined automatically from the -choices; however, you can specify different strings for the menu by -including the @code{:tag} keyword in the alternatives. For example, if -an integer stands for a number of spaces, while a string is text to use -verbatim, you might write the customization type this way, - -@smallexample -(choice (integer :tag "Number of spaces") - (string :tag "Literal text")) -@end smallexample - -@noindent -so that the menu offers @samp{Number of spaces} and @samp{Literal Text}. - -In any alternative for which @code{nil} is not a valid value, other than -a @code{const}, you should specify a valid default for that alternative -using the @code{:value} keyword. @xref{Type Keywords}. - -@item (const @var{value}) -The value must be @var{value}---nothing else is allowed. - -The main use of @code{const} is inside of @code{choice}. For example, -@code{(choice integer (const nil))} allows either an integer or -@code{nil}. - -@code{:tag} is often used with @code{const}, inside of @code{choice}. -For example, - -@smallexample -(choice (const :tag "Yes" t) - (const :tag "No" nil) - (const :tag "Ask" foo)) -@end smallexample - -@item (function-item @var{function}) -Like @code{const}, but used for values which are functions. This -displays the documentation string as well as the function name. -The documentation string is either the one you specify with -@code{:doc}, or @var{function}'s own documentation string. - -@item (variable-item @var{variable}) -Like @code{const}, but used for values which are variable names. This -displays the documentation string as well as the variable name. The -documentation string is either the one you specify with @code{:doc}, or -@var{variable}'s own documentation string. - -@item (set @var{elements}@dots{}) -The value must be a list and each element of the list must be one of the -@var{elements} specified. This appears in the customization buffer as a -checklist. - -@item (repeat @var{element-type}) -The value must be a list and each element of the list must fit the type -@var{element-type}. This appears in the customization buffer as a -list of elements, with @samp{[INS]} and @samp{[DEL]} buttons for adding -more elements or removing elements. -@end table - -@node Splicing into Lists -@subsection Splicing into Lists - - The @code{:inline} feature lets you splice a variable number of -elements into the middle of a list or vector. You use it in a -@code{set}, @code{choice} or @code{repeat} type which appears among the -element-types of a @code{list} or @code{vector}. - - Normally, each of the element-types in a @code{list} or @code{vector} -describes one and only one element of the list or vector. Thus, if an -element-type is a @code{repeat}, that specifies a list of unspecified -length which appears as one element. - - But when the element-type uses @code{:inline}, the value it matches is -merged directly into the containing sequence. For example, if it -matches a list with three elements, those become three elements of the -overall sequence. This is analogous to using @samp{,@@} in the backquote -construct. - - For example, to specify a list whose first element must be @code{t} -and whose remaining arguments should be zero or more of @code{foo} and -@code{bar}, use this customization type: - -@example -(list (const t) (set :inline t foo bar)) -@end example - -@noindent -This matches values such as @code{(t)}, @code{(t foo)}, @code{(t bar)} -and @code{(t foo bar)}. - - When the element-type is a @code{choice}, you use @code{:inline} not -in the @code{choice} itself, but in (some of) the alternatives of the -@code{choice}. For example, to match a list which must start with a -file name, followed either by the symbol @code{t} or two strings, use -this customization type: - -@example -(list file - (choice (const t) - (list :inline t string string))) -@end example - -@noindent -If the user chooses the first alternative in the choice, then the -overall list has two elements and the second element is @code{t}. If -the user chooses the second alternative, then the overall list has three -elements and the second and third must be strings. - -@node Type Keywords -@subsection Type Keywords - -You can specify keyword-argument pairs in a customization type after the -type name symbol. Here are the keywords you can use, and their -meanings: - -@table @code -@item :value @var{default} -This is used for a type that appears as an alternative inside of -@code{choice}; it specifies the default value to use, at first, if and -when the user selects this alternative with the menu in the -customization buffer. - -Of course, if the actual value of the option fits this alternative, it -will appear showing the actual value, not @var{default}. - -If @code{nil} is not a valid value for the alternative, then it is -essential to specify a valid default with @code{:value}. - -@item :format @var{format-string} -This string will be inserted in the buffer to represent the value -corresponding to the type. The following @samp{%} escapes are available -for use in @var{format-string}: - -@table @samp -@item %[@var{button}%] -Display the text @var{button} marked as a button. The @code{:action} -attribute specifies what the button will do if the user invokes it; -its value is a function which takes two arguments---the widget which -the button appears in, and the event. - -There is no way to specify two different buttons with different -actions. - -@item %@{@var{sample}%@} -Show @var{sample} in a special face specified by @code{:sample-face}. - -@item %v -Substitute the item's value. How the value is represented depends on -the kind of item, and (for variables) on the customization type. - -@item %d -Substitute the item's documentation string. - -@item %h -Like @samp{%d}, but if the documentation string is more than one line, -add an active field to control whether to show all of it or just the -first line. - -@item %t -Substitute the tag here. You specify the tag with the @code{:tag} -keyword. - -@item %% -Display a literal @samp{%}. -@end table - -@item :action @var{action} -Perform @var{action} if the user clicks on a button. - -@item :button-face @var{face} -Use the face @var{face} (a face name or a list of face names) for button -text displayed with @samp{%[@dots{}%]}. - -@item :button-prefix @var{prefix} -@itemx :button-suffix @var{suffix} -These specify the text to display before and after a button. -Each can be: - -@table @asis -@item @code{nil} -No text is inserted. - -@item a string -The string is inserted literally. - -@item a symbol -The symbol's value is used. -@end table - -@item :tag @var{tag} -Use @var{tag} (a string) as the tag for the value (or part of the value) -that corresponds to this type. - -@item :doc @var{doc} -Use @var{doc} as the documentation string for this value (or part of the -value) that corresponds to this type. In order for this to work, you -must specify a value for @code{:format}, and use @samp{%d} or @samp{%h} -in that value. - -The usual reason to specify a documentation string for a type is to -provide more information about the meanings of alternatives inside a -@code{:choice} type or the parts of some other composite type. - -@item :help-echo @var{motion-doc} -When you move to this item with @code{widget-forward} or -@code{widget-backward}, it will display the string @var{motion-doc} -in the echo area. - -@item :match @var{function} -Specify how to decide whether a value matches the type. The -corresponding value, @var{function}, should be a function that accepts -two arguments, a widget and a value; it should return non-@code{nil} if -the value is acceptable. - -@ignore -@item :indent @var{columns} -Indent this item by @var{columns} columns. The indentation is used for -@samp{%n}, and automatically for group names, for checklists and radio -buttons, and for editable lists. It affects the whole of the -item except for the first line. - -@item :offset @var{columns} -An integer indicating how many extra spaces to indent the subitems of -this item. By default, subitems are indented the same as their parent. - -@item :extra-offset -An integer indicating how many extra spaces to add to this item's -indentation, compared to its parent. - -@item :notify -A function called each time the item or a subitem is changed. The -function is called with two or three arguments. The first argument is -the item itself, the second argument is the item that was changed, and -the third argument is the event leading to the change, if any. - -@item :menu-tag -Tag used in the menu when the widget is used as an option in a -@code{menu-choice} widget. - -@item :menu-tag-get -Function used for finding the tag when the widget is used as an option -in a @code{menu-choice} widget. By default, the tag used will be either the -@code{:menu-tag} or @code{:tag} property if present, or the @code{princ} -representation of the @code{:value} property if not. - -@item :validate -A function which takes a widget as an argument, and return nil if the -widgets current value is valid for the widget. Otherwise, it should -return the widget containing the invalid data, and set that widgets -@code{:error} property to a string explaining the error. - -You can use the function @code{widget-children-validate} for this job; -it tests that all children of @var{widget} are valid. - -@item :tab-order -Specify the order in which widgets are traversed with -@code{widget-forward} or @code{widget-backward}. This is only partially -implemented. - -@enumerate a -@item -Widgets with tabbing order @code{-1} are ignored. - -@item -(Unimplemented) When on a widget with tabbing order @var{n}, go to the -next widget in the buffer with tabbing order @var{n+1} or @code{nil}, -whichever comes first. - -@item -When on a widget with no tabbing order specified, go to the next widget -in the buffer with a positive tabbing order, or @code{nil} -@end enumerate - -@item :parent -The parent of a nested widget (e.g. a @code{menu-choice} item or an -element of a @code{editable-list} widget). - -@item :sibling-args -This keyword is only used for members of a @code{radio-button-choice} or -@code{checklist}. The value should be a list of extra keyword -arguments, which will be used when creating the @code{radio-button} or -@code{checkbox} associated with this item. -@end ignore -@end table diff --git a/man/lispref/databases.texi b/man/lispref/databases.texi deleted file mode 100644 index 0b11270..0000000 --- a/man/lispref/databases.texi +++ /dev/null @@ -1,92 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/databases.info -@node Databases, Processes, Range Tables, top -@chapter Databases -@cindex database - -@defun databasep object -This function returns non-@code{nil} if @var{object} is a database. -@end defun - -@menu -* Connecting to a Database:: -* Working With a Database:: -* Other Database Functions:: -@end menu - -@node Connecting to a Database -@section Connecting to a Database - -@defun open-database file &optional type subtype access mode -This function opens database @var{file}, using database method -@var{type} and @var{subtype}, with access rights @var{access} and -permissions @var{mode}. @var{access} can be any combination of @code{r} -@code{w} and @code{+}, for read, write, and creation flags. - -@var{type} can have the value @code{'dbm} or @code{'berkeley_db} to -select the type of database file to use. (Note: XEmacs may not -support both of these types.) - -For a @var{type} of @code{'dbm}, there are no subtypes, so -@var{subtype} should by @code{nil}. - -For a @var{type} of @code{'berkeley_db}, the following subtypes are -available: @code{'hash}, @code{'btree}, and @code{'recno}. See the -manpages for the Berkeley DB functions to more information about these -types. -@end defun - -@defun close-database obj -This function closes database @var{obj}. -@end defun - -@defun database-live-p obj -This function returns @code{t} iff @var{obj} is an active database, else -@code{nil}. -@end defun - -@node Working With a Database -@section Working With a Database - -@defun get-database key dbase &optional default -This function finds the value for @var{key} in @var{database}. If there is no -corresponding value, @var{default} is returned (@code{nil} if @var{default} is -omitted). -@end defun - -@defun map-database function dbase -This function maps @var{function} over entries in @var{database}, -calling it with two args, each key and value in the database. -@end defun - -@defun put-database key val dbase &optional replace -This function stores @var{key} and @var{val} in @var{database}. If -optional fourth arg @var{replace} is non-@code{nil}, replace any -existing entry in the database. -@end defun - -@defun remove-database key dbase -This function removes @var{key} from @var{database}. -@end defun - -@node Other Database Functions -@section Other Database Functions - -@defun database-file-name obj -This function returns the filename associated with the database @var{obj}. -@end defun - -@defun database-last-error &optional obj -This function returns the last error associated with database @var{obj}. -@end defun - -@defun database-subtype obj -This function returns the subtype of database @var{obj}, if any. -@end defun - -@defun database-type obj -This function returns the type of database @var{obj}. -@end defun diff --git a/man/lispref/debugging.texi b/man/lispref/debugging.texi deleted file mode 100644 index 72dd9eb..0000000 --- a/man/lispref/debugging.texi +++ /dev/null @@ -1,753 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/debugging.info -@node Debugging, Read and Print, Byte Compilation, Top -@chapter Debugging Lisp Programs - - There are three ways to investigate a problem in an XEmacs Lisp program, -depending on what you are doing with the program when the problem appears. - -@itemize @bullet -@item -If the problem occurs when you run the program, you can use a Lisp -debugger (either the default debugger or Edebug) to investigate what is -happening during execution. - -@item -If the problem is syntactic, so that Lisp cannot even read the program, -you can use the XEmacs facilities for editing Lisp to localize it. - -@item -If the problem occurs when trying to compile the program with the byte -compiler, you need to know how to examine the compiler's input buffer. -@end itemize - -@menu -* Debugger:: How the XEmacs Lisp debugger is implemented. -* Syntax Errors:: How to find syntax errors. -* Compilation Errors:: How to find errors that show up in byte compilation. -* Edebug:: A source-level XEmacs Lisp debugger. -@end menu - - Another useful debugging tool is the dribble file. When a dribble -file is open, XEmacs copies all keyboard input characters to that file. -Afterward, you can examine the file to find out what input was used. -@xref{Terminal Input}. - - For debugging problems in terminal descriptions, the -@code{open-termscript} function can be useful. @xref{Terminal Output}. - -@node Debugger -@section The Lisp Debugger -@cindex debugger -@cindex Lisp debugger -@cindex break - - The @dfn{Lisp debugger} provides the ability to suspend evaluation of -a form. While evaluation is suspended (a state that is commonly known -as a @dfn{break}), you may examine the run time stack, examine the -values of local or global variables, or change those values. Since a -break is a recursive edit, all the usual editing facilities of XEmacs are -available; you can even run programs that will enter the debugger -recursively. @xref{Recursive Editing}. - -@menu -* Error Debugging:: Entering the debugger when an error happens. -* Infinite Loops:: Stopping and debugging a program that doesn't exit. -* Function Debugging:: Entering it when a certain function is called. -* Explicit Debug:: Entering it at a certain point in the program. -* Using Debugger:: What the debugger does; what you see while in it. -* Debugger Commands:: Commands used while in the debugger. -* Invoking the Debugger:: How to call the function @code{debug}. -* Internals of Debugger:: Subroutines of the debugger, and global variables. -@end menu - -@node Error Debugging -@subsection Entering the Debugger on an Error -@cindex error debugging -@cindex debugging errors - - The most important time to enter the debugger is when a Lisp error -happens. This allows you to investigate the immediate causes of the -error. - - However, entry to the debugger is not a normal consequence of an -error. Many commands frequently get Lisp errors when invoked in -inappropriate contexts (such as @kbd{C-f} at the end of the buffer) and -during ordinary editing it would be very unpleasant to enter the -debugger each time this happens. If you want errors to enter the -debugger, set the variable @code{debug-on-error} to non-@code{nil}. - -@defopt debug-on-error -This variable determines whether the debugger is called when an error is -signaled and not handled. If @code{debug-on-error} is @code{t}, all -errors call the debugger. If it is @code{nil}, none call the debugger. - -The value can also be a list of error conditions that should call the -debugger. For example, if you set it to the list -@code{(void-variable)}, then only errors about a variable that has no -value invoke the debugger. - -When this variable is non-@code{nil}, Emacs does not catch errors that -happen in process filter functions and sentinels. Therefore, these -errors also can invoke the debugger. @xref{Processes}. -@end defopt - -@defopt debug-ignored-errors -This variable specifies certain kinds of errors that should not enter -the debugger. Its value is a list of error condition symbols and/or -regular expressions. If the error has any of those condition symbols, -or if the error message matches any of the regular expressions, then -that error does not enter the debugger, regardless of the value of -@code{debug-on-error}. - -The normal value of this variable lists several errors that happen often -during editing but rarely result from bugs in Lisp programs. -@end defopt - - To debug an error that happens during loading of the @file{.emacs} -file, use the option @samp{-debug-init}, which binds -@code{debug-on-error} to @code{t} while @file{.emacs} is loaded and -inhibits use of @code{condition-case} to catch init file errors. - - If your @file{.emacs} file sets @code{debug-on-error}, the effect may -not last past the end of loading @file{.emacs}. (This is an undesirable -byproduct of the code that implements the @samp{-debug-init} command -line option.) The best way to make @file{.emacs} set -@code{debug-on-error} permanently is with @code{after-init-hook}, like -this: - -@example -(add-hook 'after-init-hook - '(lambda () (setq debug-on-error t))) -@end example - -@defopt debug-on-signal -This variable is similar to @code{debug-on-error} but breaks -whenever an error is signalled, regardless of whether it would be -handled. -@end defopt - -@node Infinite Loops -@subsection Debugging Infinite Loops -@cindex infinite loops -@cindex loops, infinite -@cindex quitting from infinite loop -@cindex stopping an infinite loop - - When a program loops infinitely and fails to return, your first -problem is to stop the loop. On most operating systems, you can do this -with @kbd{C-g}, which causes quit. - - Ordinary quitting gives no information about why the program was -looping. To get more information, you can set the variable -@code{debug-on-quit} to non-@code{nil}. Quitting with @kbd{C-g} is not -considered an error, and @code{debug-on-error} has no effect on the -handling of @kbd{C-g}. Likewise, @code{debug-on-quit} has no effect on -errors. - - Once you have the debugger running in the middle of the infinite loop, -you can proceed from the debugger using the stepping commands. If you -step through the entire loop, you will probably get enough information -to solve the problem. - -@defopt debug-on-quit -This variable determines whether the debugger is called when @code{quit} -is signaled and not handled. If @code{debug-on-quit} is non-@code{nil}, -then the debugger is called whenever you quit (that is, type @kbd{C-g}). -If @code{debug-on-quit} is @code{nil}, then the debugger is not called -when you quit. @xref{Quitting}. -@end defopt - -@node Function Debugging -@subsection Entering the Debugger on a Function Call -@cindex function call debugging -@cindex debugging specific functions - - To investigate a problem that happens in the middle of a program, one -useful technique is to enter the debugger whenever a certain function is -called. You can do this to the function in which the problem occurs, -and then step through the function, or you can do this to a function -called shortly before the problem, step quickly over the call to that -function, and then step through its caller. - -@deffn Command debug-on-entry function-name - This function requests @var{function-name} to invoke the debugger each time -it is called. It works by inserting the form @code{(debug 'debug)} into -the function definition as the first form. - - Any function defined as Lisp code may be set to break on entry, -regardless of whether it is interpreted code or compiled code. If the -function is a command, it will enter the debugger when called from Lisp -and when called interactively (after the reading of the arguments). You -can't debug primitive functions (i.e., those written in C) this way. - - When @code{debug-on-entry} is called interactively, it prompts -for @var{function-name} in the minibuffer. - - If the function is already set up to invoke the debugger on entry, -@code{debug-on-entry} does nothing. - - @strong{Please note:} if you redefine a function after using -@code{debug-on-entry} on it, the code to enter the debugger is lost. - - @code{debug-on-entry} returns @var{function-name}. - -@example -@group -(defun fact (n) - (if (zerop n) 1 - (* n (fact (1- n))))) - @result{} fact -@end group -@group -(debug-on-entry 'fact) - @result{} fact -@end group -@group -(fact 3) -@end group - -@group ------- Buffer: *Backtrace* ------ -Entering: -* fact(3) - eval-region(4870 4878 t) - byte-code("...") - eval-last-sexp(nil) - (let ...) - eval-insert-last-sexp(nil) -* call-interactively(eval-insert-last-sexp) ------- Buffer: *Backtrace* ------ -@end group - -@group -(symbol-function 'fact) - @result{} (lambda (n) - (debug (quote debug)) - (if (zerop n) 1 (* n (fact (1- n))))) -@end group -@end example -@end deffn - -@deffn Command cancel-debug-on-entry function-name -This function undoes the effect of @code{debug-on-entry} on -@var{function-name}. When called interactively, it prompts for -@var{function-name} in the minibuffer. If @var{function-name} is -@code{nil} or the empty string, it cancels debugging for all functions. - -If @code{cancel-debug-on-entry} is called more than once on the same -function, the second call does nothing. @code{cancel-debug-on-entry} -returns @var{function-name}. -@end deffn - -@node Explicit Debug -@subsection Explicit Entry to the Debugger - - You can cause the debugger to be called at a certain point in your -program by writing the expression @code{(debug)} at that point. To do -this, visit the source file, insert the text @samp{(debug)} at the -proper place, and type @kbd{C-M-x}. Be sure to undo this insertion -before you save the file! - - The place where you insert @samp{(debug)} must be a place where an -additional form can be evaluated and its value ignored. (If the value -of @code{(debug)} isn't ignored, it will alter the execution of the -program!) The most common suitable places are inside a @code{progn} or -an implicit @code{progn} (@pxref{Sequencing}). - -@node Using Debugger -@subsection Using the Debugger - - When the debugger is entered, it displays the previously selected -buffer in one window and a buffer named @samp{*Backtrace*} in another -window. The backtrace buffer contains one line for each level of Lisp -function execution currently going on. At the beginning of this buffer -is a message describing the reason that the debugger was invoked (such -as the error message and associated data, if it was invoked due to an -error). - - The backtrace buffer is read-only and uses a special major mode, -Debugger mode, in which letters are defined as debugger commands. The -usual XEmacs editing commands are available; thus, you can switch windows -to examine the buffer that was being edited at the time of the error, -switch buffers, visit files, or do any other sort of editing. However, -the debugger is a recursive editing level (@pxref{Recursive Editing}) -and it is wise to go back to the backtrace buffer and exit the debugger -(with the @kbd{q} command) when you are finished with it. Exiting -the debugger gets out of the recursive edit and kills the backtrace -buffer. - -@cindex current stack frame - The backtrace buffer shows you the functions that are executing and -their argument values. It also allows you to specify a stack frame by -moving point to the line describing that frame. (A stack frame is the -place where the Lisp interpreter records information about a particular -invocation of a function.) The frame whose line point is on is -considered the @dfn{current frame}. Some of the debugger commands -operate on the current frame. - - The debugger itself must be run byte-compiled, since it makes -assumptions about how many stack frames are used for the debugger -itself. These assumptions are false if the debugger is running -interpreted. - -@need 3000 - -@node Debugger Commands -@subsection Debugger Commands -@cindex debugger command list - - Inside the debugger (in Debugger mode), these special commands are -available in addition to the usual cursor motion commands. (Keep in -mind that all the usual facilities of XEmacs, such as switching windows -or buffers, are still available.) - - The most important use of debugger commands is for stepping through -code, so that you can see how control flows. The debugger can step -through the control structures of an interpreted function, but cannot do -so in a byte-compiled function. If you would like to step through a -byte-compiled function, replace it with an interpreted definition of the -same function. (To do this, visit the source file for the function and -type @kbd{C-M-x} on its definition.) - - Here is a list of Debugger mode commands: - -@table @kbd -@item c -Exit the debugger and continue execution. This resumes execution of the -program as if the debugger had never been entered (aside from the -effect of any variables or data structures you may have changed while -inside the debugger). - -Continuing when an error or quit was signalled will cause the normal -action of the signalling to take place. If you do not want this to -happen, but instead want the program execution to continue as if -the call to @code{signal} did not occur, use the @kbd{r} command. - -@item d -Continue execution, but enter the debugger the next time any Lisp -function is called. This allows you to step through the -subexpressions of an expression, seeing what values the subexpressions -compute, and what else they do. - -The stack frame made for the function call which enters the debugger in -this way will be flagged automatically so that the debugger will be -called again when the frame is exited. You can use the @kbd{u} command -to cancel this flag. - -@item b -Flag the current frame so that the debugger will be entered when the -frame is exited. Frames flagged in this way are marked with stars -in the backtrace buffer. - -@item u -Don't enter the debugger when the current frame is exited. This -cancels a @kbd{b} command on that frame. - -@item e -Read a Lisp expression in the minibuffer, evaluate it, and print the -value in the echo area. The debugger alters certain important -variables, and the current buffer, as part of its operation; @kbd{e} -temporarily restores their outside-the-debugger values so you can -examine them. This makes the debugger more transparent. By contrast, -@kbd{M-:} does nothing special in the debugger; it shows you the -variable values within the debugger. - -@item q -Terminate the program being debugged; return to top-level XEmacs -command execution. - -If the debugger was entered due to a @kbd{C-g} but you really want -to quit, and not debug, use the @kbd{q} command. - -@item r -Return a value from the debugger. The value is computed by reading an -expression with the minibuffer and evaluating it. - -The @kbd{r} command is useful when the debugger was invoked due to exit -from a Lisp call frame (as requested with @kbd{b}); then the value -specified in the @kbd{r} command is used as the value of that frame. It -is also useful if you call @code{debug} and use its return value. - -If the debugger was entered at the beginning of a function call, @kbd{r} -has the same effect as @kbd{c}, and the specified return value does not -matter. - -If the debugger was entered through a call to @code{signal} (i.e. as a -result of an error or quit), then returning a value will cause the -call to @code{signal} itself to return, rather than throwing to -top-level or invoking a handler, as is normal. This allows you to -correct an error (e.g. the type of an argument was wrong) or continue -from a @code{debug-on-quit} as if it never happened. - -Note that some errors (e.g. any error signalled using the @code{error} -function, and many errors signalled from a primitive function) are not -continuable. If you return a value from them and continue execution, -then the error will immediately be signalled again. Other errors -(e.g. wrong-type-argument errors) will be continually resignalled -until the problem is corrected. -@end table - -@node Invoking the Debugger -@subsection Invoking the Debugger - - Here we describe fully the function used to invoke the debugger. - -@defun debug &rest debugger-args -This function enters the debugger. It switches buffers to a buffer -named @samp{*Backtrace*} (or @samp{*Backtrace*<2>} if it is the second -recursive entry to the debugger, etc.), and fills it with information -about the stack of Lisp function calls. It then enters a recursive -edit, showing the backtrace buffer in Debugger mode. - -The Debugger mode @kbd{c} and @kbd{r} commands exit the recursive edit; -then @code{debug} switches back to the previous buffer and returns to -whatever called @code{debug}. This is the only way the function -@code{debug} can return to its caller. - -If the first of the @var{debugger-args} passed to @code{debug} is -@code{nil} (or if it is not one of the special values in the table -below), then @code{debug} displays the rest of its arguments at the -top of the @samp{*Backtrace*} buffer. This mechanism is used to display -a message to the user. - -However, if the first argument passed to @code{debug} is one of the -following special values, then it has special significance. Normally, -these values are passed to @code{debug} only by the internals of XEmacs -and the debugger, and not by programmers calling @code{debug}. - -The special values are: - -@table @code -@item lambda -@cindex @code{lambda} in debug -A first argument of @code{lambda} means @code{debug} was called because -of entry to a function when @code{debug-on-next-call} was -non-@code{nil}. The debugger displays @samp{Entering:} as a line of -text at the top of the buffer. - -@item debug -@code{debug} as first argument indicates a call to @code{debug} because -of entry to a function that was set to debug on entry. The debugger -displays @samp{Entering:}, just as in the @code{lambda} case. It also -marks the stack frame for that function so that it will invoke the -debugger when exited. - -@item t -When the first argument is @code{t}, this indicates a call to -@code{debug} due to evaluation of a list form when -@code{debug-on-next-call} is non-@code{nil}. The debugger displays the -following as the top line in the buffer: - -@smallexample -Beginning evaluation of function call form: -@end smallexample - -@item exit -When the first argument is @code{exit}, it indicates the exit of a -stack frame previously marked to invoke the debugger on exit. The -second argument given to @code{debug} in this case is the value being -returned from the frame. The debugger displays @samp{Return value:} on -the top line of the buffer, followed by the value being returned. - -@item error -@cindex @code{error} in debug -When the first argument is @code{error}, the debugger indicates that -it is being entered because an error or @code{quit} was signaled and not -handled, by displaying @samp{Signaling:} followed by the error signaled -and any arguments to @code{signal}. For example, - -@example -@group -(let ((debug-on-error t)) - (/ 1 0)) -@end group - -@group ------- Buffer: *Backtrace* ------ -Signaling: (arith-error) - /(1 0) -... ------- Buffer: *Backtrace* ------ -@end group -@end example - -If an error was signaled, presumably the variable -@code{debug-on-error} is non-@code{nil}. If @code{quit} was signaled, -then presumably the variable @code{debug-on-quit} is non-@code{nil}. - -@item nil -Use @code{nil} as the first of the @var{debugger-args} when you want -to enter the debugger explicitly. The rest of the @var{debugger-args} -are printed on the top line of the buffer. You can use this feature to -display messages---for example, to remind yourself of the conditions -under which @code{debug} is called. -@end table -@end defun - -@need 5000 - -@node Internals of Debugger -@subsection Internals of the Debugger - - This section describes functions and variables used internally by the -debugger. - -@defvar debugger -The value of this variable is the function to call to invoke the -debugger. Its value must be a function of any number of arguments (or, -more typically, the name of a function). Presumably this function will -enter some kind of debugger. The default value of the variable is -@code{debug}. - -The first argument that Lisp hands to the function indicates why it -was called. The convention for arguments is detailed in the description -of @code{debug}. -@end defvar - -@deffn Command backtrace &optional stream detailed -@cindex run time stack -@cindex call stack -This function prints a trace of Lisp function calls currently active. -This is the function used by @code{debug} to fill up the -@samp{*Backtrace*} buffer. It is written in C, since it must have access -to the stack to determine which function calls are active. The return -value is always @code{nil}. - -The backtrace is normally printed to @code{standard-output}, but this -can be changed by specifying a value for @var{stream}. If -@var{detailed} is non-@code{nil}, the backtrace also shows places where -currently active variable bindings, catches, condition-cases, and -unwind-protects were made as well as function calls. - -In the following example, a Lisp expression calls @code{backtrace} -explicitly. This prints the backtrace to the stream -@code{standard-output}: in this case, to the buffer -@samp{backtrace-output}. Each line of the backtrace represents one -function call. The line shows the values of the function's arguments if -they are all known. If they are still being computed, the line says so. -The arguments of special forms are elided. - -@smallexample -@group -(with-output-to-temp-buffer "backtrace-output" - (let ((var 1)) - (save-excursion - (setq var (eval '(progn - (1+ var) - (list 'testing (backtrace)))))))) - - @result{} nil -@end group - -@group ------------ Buffer: backtrace-output ------------ - backtrace() - (list ...computing arguments...) - (progn ...) - eval((progn (1+ var) (list (quote testing) (backtrace)))) - (setq ...) - (save-excursion ...) - (let ...) - (with-output-to-temp-buffer ...) - eval-region(1973 2142 #) - byte-code("... for eval-print-last-sexp ...") - eval-print-last-sexp(nil) -* call-interactively(eval-print-last-sexp) ------------ Buffer: backtrace-output ------------ -@end group -@end smallexample - -The character @samp{*} indicates a frame whose debug-on-exit flag is -set. -@end deffn - -@ignore @c Not worth mentioning -@defopt stack-trace-on-error -@cindex stack trace -This variable controls whether Lisp automatically displays a -backtrace buffer after every error that is not handled. A quit signal -counts as an error for this variable. If it is non-@code{nil} then a -backtrace is shown in a pop-up buffer named @samp{*Backtrace*} on every -error. If it is @code{nil}, then a backtrace is not shown. - -When a backtrace is shown, that buffer is not selected. If either -@code{debug-on-quit} or @code{debug-on-error} is also non-@code{nil}, then -a backtrace is shown in one buffer, and the debugger is popped up in -another buffer with its own backtrace. - -We consider this feature to be obsolete and superseded by the debugger -itself. -@end defopt -@end ignore - -@defvar debug-on-next-call -@cindex @code{eval}, and debugging -@cindex @code{apply}, and debugging -@cindex @code{funcall}, and debugging -If this variable is non-@code{nil}, it says to call the debugger before -the next @code{eval}, @code{apply} or @code{funcall}. Entering the -debugger sets @code{debug-on-next-call} to @code{nil}. - -The @kbd{d} command in the debugger works by setting this variable. -@end defvar - -@defun backtrace-debug level flag -This function sets the debug-on-exit flag of the stack frame @var{level} -levels down the stack, giving it the value @var{flag}. If @var{flag} is -non-@code{nil}, this will cause the debugger to be entered when that -frame later exits. Even a nonlocal exit through that frame will enter -the debugger. - -This function is used only by the debugger. -@end defun - -@defvar command-debug-status -This variable records the debugging status of the current interactive -command. Each time a command is called interactively, this variable is -bound to @code{nil}. The debugger can set this variable to leave -information for future debugger invocations during the same command. - -The advantage, for the debugger, of using this variable rather than -another global variable is that the data will never carry over to a -subsequent command invocation. -@end defvar - -@defun backtrace-frame frame-number -The function @code{backtrace-frame} is intended for use in Lisp -debuggers. It returns information about what computation is happening -in the stack frame @var{frame-number} levels down. - -If that frame has not evaluated the arguments yet (or is a special -form), the value is @code{(nil @var{function} @var{arg-forms}@dots{})}. - -If that frame has evaluated its arguments and called its function -already, the value is @code{(t @var{function} -@var{arg-values}@dots{})}. - -In the return value, @var{function} is whatever was supplied as the -@sc{car} of the evaluated list, or a @code{lambda} expression in the -case of a macro call. If the function has a @code{&rest} argument, that -is represented as the tail of the list @var{arg-values}. - -If @var{frame-number} is out of range, @code{backtrace-frame} returns -@code{nil}. -@end defun - -@node Syntax Errors -@section Debugging Invalid Lisp Syntax - - The Lisp reader reports invalid syntax, but cannot say where the real -problem is. For example, the error ``End of file during parsing'' in -evaluating an expression indicates an excess of open parentheses (or -square brackets). The reader detects this imbalance at the end of the -file, but it cannot figure out where the close parenthesis should have -been. Likewise, ``Invalid read syntax: ")"'' indicates an excess close -parenthesis or missing open parenthesis, but does not say where the -missing parenthesis belongs. How, then, to find what to change? - - If the problem is not simply an imbalance of parentheses, a useful -technique is to try @kbd{C-M-e} at the beginning of each defun, and see -if it goes to the place where that defun appears to end. If it does -not, there is a problem in that defun. - - However, unmatched parentheses are the most common syntax errors in -Lisp, and we can give further advice for those cases. - -@menu -* Excess Open:: How to find a spurious open paren or missing close. -* Excess Close:: How to find a spurious close paren or missing open. -@end menu - -@node Excess Open -@subsection Excess Open Parentheses - - The first step is to find the defun that is unbalanced. If there is -an excess open parenthesis, the way to do this is to insert a -close parenthesis at the end of the file and type @kbd{C-M-b} -(@code{backward-sexp}). This will move you to the beginning of the -defun that is unbalanced. (Then type @kbd{C-@key{SPC} C-_ C-u -C-@key{SPC}} to set the mark there, undo the insertion of the -close parenthesis, and finally return to the mark.) - - The next step is to determine precisely what is wrong. There is no -way to be sure of this except to study the program, but often the -existing indentation is a clue to where the parentheses should have -been. The easiest way to use this clue is to reindent with @kbd{C-M-q} -and see what moves. - - Before you do this, make sure the defun has enough close parentheses. -Otherwise, @kbd{C-M-q} will get an error, or will reindent all the rest -of the file until the end. So move to the end of the defun and insert a -close parenthesis there. Don't use @kbd{C-M-e} to move there, since -that too will fail to work until the defun is balanced. - - Now you can go to the beginning of the defun and type @kbd{C-M-q}. -Usually all the lines from a certain point to the end of the function -will shift to the right. There is probably a missing close parenthesis, -or a superfluous open parenthesis, near that point. (However, don't -assume this is true; study the code to make sure.) Once you have found -the discrepancy, undo the @kbd{C-M-q} with @kbd{C-_}, since the old -indentation is probably appropriate to the intended parentheses. - - After you think you have fixed the problem, use @kbd{C-M-q} again. If -the old indentation actually fit the intended nesting of parentheses, -and you have put back those parentheses, @kbd{C-M-q} should not change -anything. - -@node Excess Close -@subsection Excess Close Parentheses - - To deal with an excess close parenthesis, first insert an open -parenthesis at the beginning of the file, back up over it, and type -@kbd{C-M-f} to find the end of the unbalanced defun. (Then type -@kbd{C-@key{SPC} C-_ C-u C-@key{SPC}} to set the mark there, undo the -insertion of the open parenthesis, and finally return to the mark.) - - Then find the actual matching close parenthesis by typing @kbd{C-M-f} -at the beginning of the defun. This will leave you somewhere short of -the place where the defun ought to end. It is possible that you will -find a spurious close parenthesis in that vicinity. - - If you don't see a problem at that point, the next thing to do is to -type @kbd{C-M-q} at the beginning of the defun. A range of lines will -probably shift left; if so, the missing open parenthesis or spurious -close parenthesis is probably near the first of those lines. (However, -don't assume this is true; study the code to make sure.) Once you have -found the discrepancy, undo the @kbd{C-M-q} with @kbd{C-_}, since the -old indentation is probably appropriate to the intended parentheses. - - After you think you have fixed the problem, use @kbd{C-M-q} again. If -the old indentation actually fit the intended nesting of parentheses, -and you have put back those parentheses, @kbd{C-M-q} should not change -anything. - -@node Compilation Errors, Edebug, Syntax Errors, Debugging -@section Debugging Problems in Compilation - - When an error happens during byte compilation, it is normally due to -invalid syntax in the program you are compiling. The compiler prints a -suitable error message in the @samp{*Compile-Log*} buffer, and then -stops. The message may state a function name in which the error was -found, or it may not. Either way, here is how to find out where in the -file the error occurred. - - What you should do is switch to the buffer @w{@samp{ *Compiler Input*}}. -(Note that the buffer name starts with a space, so it does not show -up in @kbd{M-x list-buffers}.) This buffer contains the program being -compiled, and point shows how far the byte compiler was able to read. - - If the error was due to invalid Lisp syntax, point shows exactly where -the invalid syntax was @emph{detected}. The cause of the error is not -necessarily near by! Use the techniques in the previous section to find -the error. - - If the error was detected while compiling a form that had been read -successfully, then point is located at the end of the form. In this -case, this technique can't localize the error precisely, but can still -show you which function to check. - -@include edebug-inc.texi diff --git a/man/lispref/dialog.texi b/man/lispref/dialog.texi deleted file mode 100644 index 1156308..0000000 --- a/man/lispref/dialog.texi +++ /dev/null @@ -1,67 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/dialog.info -@node Dialog Boxes, Toolbar, Menus, Top -@chapter Dialog Boxes -@cindex dialog box - -@menu -* Dialog Box Format:: -* Dialog Box Functions:: -@end menu - -@node Dialog Box Format -@section Dialog Box Format - -A dialog box description is a list. - -@itemize @bullet -@item -The first element of the list is a string to display in the dialog box. -@item -The rest of the elements are descriptions of the dialog box's buttons. -Each one is a vector of three elements: -@itemize @minus -@item -The first element is the text of the button. -@item -The second element is the @dfn{callback}. -@item -The third element is @code{t} or @code{nil}, whether this button is -selectable. -@end itemize -@end itemize - -If the callback of a button is a symbol, then it must name a command. -It will be invoked with @code{call-interactively}. If it is a list, -then it is evaluated with @code{eval}. - -One (and only one) of the buttons may be @code{nil}. This marker means -that all following buttons should be flushright instead of flushleft. - -The syntax, more precisely: - -@example - form := - command := - callback := command | form - active-p := - name := - partition := 'nil' - button := '[' name callback active-p ']' - dialog := '(' name [ button ]+ [ partition [ button ]+ ] ')' -@end example - -@node Dialog Box Functions -@section Dialog Box Functions - -@defun popup-dialog-box dbox-desc -This function pops up a dialog box. @var{dbox-desc} describes how the -dialog box will appear (@pxref{Dialog Box Format}). -@end defun - -@xref{Yes-or-No Queries}, for functions to ask a yes/no question using -a dialog box. diff --git a/man/lispref/display.texi b/man/lispref/display.texi deleted file mode 100644 index 3d1e992..0000000 --- a/man/lispref/display.texi +++ /dev/null @@ -1,1193 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1998 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/display.info -@node Display, Hash Tables, Annotations, Top -@chapter Emacs Display - - This chapter describes a number of other features related to the display -that XEmacs presents to the user. - -@menu -* Refresh Screen:: Clearing the screen and redrawing everything on it. -* Truncation:: Folding or wrapping long text lines. -* The Echo Area:: Where messages are displayed. -* Warnings:: Display of Warnings. -* Invisible Text:: Hiding part of the buffer text. -* Selective Display:: Hiding part of the buffer text (the old way). -* Overlay Arrow:: Display of an arrow to indicate position. -* Temporary Displays:: Displays that go away automatically. -* Blinking:: How XEmacs shows the matching open parenthesis. -* Usual Display:: The usual conventions for displaying nonprinting chars. -* Display Tables:: How to specify other conventions. -* Beeping:: Audible signal to the user. -@end menu - -@node Refresh Screen -@section Refreshing the Screen - -The function @code{redraw-frame} redisplays the entire contents of a -given frame. @xref{Frames}. - -@c Emacs 19 feature -@defun redraw-frame frame -This function clears and redisplays frame @var{frame}. -@end defun - -Even more powerful is @code{redraw-display}: - -@deffn Command redraw-display &optional device -This function redraws all frames on @var{device} marked as having their -image garbled. @var{device} defaults to the selected device. If -@var{device} is @code{t}, all devices will have their frames checked. -@end deffn - - Processing user input takes absolute priority over redisplay. If you -call these functions when input is available, they do nothing -immediately, but a full redisplay does happen eventually---after all the -input has been processed. - - Normally, suspending and resuming XEmacs also refreshes the screen. -Some terminal emulators record separate contents for display-oriented -programs such as XEmacs and for ordinary sequential display. If you are -using such a terminal, you might want to inhibit the redisplay on -resumption. @xref{Suspending XEmacs}. - -@defvar no-redraw-on-reenter -@cindex suspend (cf. @code{no-redraw-on-reenter}) -@cindex resume (cf. @code{no-redraw-on-reenter}) -This variable controls whether XEmacs redraws the entire screen after it -has been suspended and resumed. Non-@code{nil} means yes, @code{nil} -means no. -@end defvar - -@cindex display update -@cindex update display -@cindex refresh display - The above functions do not actually cause the display to be updated; -rather, they clear out the internal display records that XEmacs -maintains, so that the next time the display is updated it will be -redrawn from scratch. Normally this occurs the next time that -@code{next-event} or @code{sit-for} is called; however, a display update -will not occur if there is input pending. @xref{Command Loop}. - -@defun force-cursor-redisplay -This function causes an immediate update of the cursor on the selected -frame. (This function does not exist in FSF Emacs.) -@end defun - -@node Truncation -@section Truncation -@cindex line wrapping -@cindex continuation lines -@cindex @samp{$} in display -@cindex @samp{\} in display - - When a line of text extends beyond the right edge of a window, the -line can either be truncated or continued on the next line. When a line -is truncated, this is normally shown with a @samp{\} in the rightmost -column of the window on X displays, and with a @samp{$} on TTY devices. -When a line is continued or ``wrapped'' onto the next line, this is -shown with a curved arrow in the rightmost column of the window (or with -a @samp{\} on TTY devices). The additional screen lines used to display -a long text line are called @dfn{continuation} lines. - - Normally, whenever line truncation is in effect for a particular -window, a horizontal scrollbar is displayed in that window if the -device supports scrollbars. @xref{Scrollbars}. - - Note that continuation is different from filling; continuation happens -on the screen only, not in the buffer contents, and it breaks a line -precisely at the right margin, not at a word boundary. @xref{Filling}. - -@defopt truncate-lines -This buffer-local variable controls how XEmacs displays lines that -extend beyond the right edge of the window. If it is non-@code{nil}, -then XEmacs does not display continuation lines; rather each line of -text occupies exactly one screen line, and a backslash appears at the -edge of any line that extends to or beyond the edge of the window. The -default is @code{nil}. - -If the variable @code{truncate-partial-width-windows} is non-@code{nil}, -then truncation is always used for side-by-side windows (within one -frame) regardless of the value of @code{truncate-lines}. -@end defopt - -@defopt default-truncate-lines -This variable is the default value for @code{truncate-lines}, for -buffers that do not have local values for it. -@end defopt - -@defopt truncate-partial-width-windows -This variable controls display of lines that extend beyond the right -edge of the window, in side-by-side windows (@pxref{Splitting Windows}). -If it is non-@code{nil}, these lines are truncated; otherwise, -@code{truncate-lines} says what to do with them. -@end defopt - - The backslash and curved arrow used to indicate truncated or continued -lines are only defaults, and can be changed. These images are actually -glyphs (@pxref{Glyphs}). XEmacs provides a great deal of flexibility -in how glyphs can be controlled. (This differs from FSF Emacs, which -uses display tables to control these images.) - - For details, @ref{Redisplay Glyphs}. - -@ignore Not yet in XEmacs - If your buffer contains @strong{very} long lines, and you use -continuation to display them, just thinking about them can make Emacs -redisplay slow. The column computation and indentation functions also -become slow. Then you might find it advisable to set -@code{cache-long-line-scans} to @code{t}. - -@defvar cache-long-line-scans -If this variable is non-@code{nil}, various indentation and motion -functions, and Emacs redisplay, cache the results of scanning the -buffer, and consult the cache to avoid rescanning regions of the buffer -unless they are modified. - -Turning on the cache slows down processing of short lines somewhat. - -This variable is automatically local in every buffer. -@end defvar -@end ignore - -@node The Echo Area -@section The Echo Area -@cindex error display -@cindex echo area - -The @dfn{echo area} is used for displaying messages made with the -@code{message} primitive, and for echoing keystrokes. It is not the -same as the minibuffer, despite the fact that the minibuffer appears -(when active) in the same place on the screen as the echo area. The -@cite{XEmacs Reference Manual} specifies the rules for resolving conflicts -between the echo area and the minibuffer for use of that screen space -(@pxref{Minibuffer,, The Minibuffer, emacs, The XEmacs Reference Manual}). -Error messages appear in the echo area; see @ref{Errors}. - -You can write output in the echo area by using the Lisp printing -functions with @code{t} as the stream (@pxref{Output Functions}), or as -follows: - -@defun message string &rest arguments -This function displays a one-line message in the echo area. The -argument @var{string} is similar to a C language @code{printf} control -string. See @code{format} in @ref{String Conversion}, for the details -on the conversion specifications. @code{message} returns the -constructed string. - -In batch mode, @code{message} prints the message text on the standard -error stream, followed by a newline. - -@c Emacs 19 feature -If @var{string} is @code{nil}, @code{message} clears the echo area. If -the minibuffer is active, this brings the minibuffer contents back onto -the screen immediately. - -@example -@group -(message "Minibuffer depth is %d." - (minibuffer-depth)) - @print{} Minibuffer depth is 0. -@result{} "Minibuffer depth is 0." -@end group - -@group ----------- Echo Area ---------- -Minibuffer depth is 0. ----------- Echo Area ---------- -@end group -@end example -@end defun - -In addition to only displaying a message, XEmacs allows you to -@dfn{label} your messages, giving you fine-grained control of their -display. Message label is a symbol denoting the message type. Some -standard labels are: - -@itemize @bullet -@item @code{message}---default label used by the @code{message} -function; - -@item @code{error}---default label used for reporting errors; - -@item @code{progress}---progress indicators like -@samp{Converting... 45%} (not logged by default); - -@item @code{prompt}---prompt-like messages like @samp{Isearch: foo} (not -logged by default); - -@item @code{command}---helper command messages like @samp{Mark set} (not -logged by default); - -@item @code{no-log}---messages that should never be logged -@end itemize - -Several messages may be stacked in the echo area at once. Lisp programs -may access these messages, or remove them as appropriate, via the -message stack. - -@defun display-message label message &optional frame stdout-p -This function displays @var{message} (a string) labeled as @var{label}, -as described above. - -The @var{frame} argument specifies the frame to whose minibuffer the -message should be printed. This is currently unimplemented. The -@var{stdout-p} argument is used internally. - -@example -(display-message 'command "Mark set") -@end example -@end defun - -@defun lmessage label string &rest arguments -This function displays a message @var{string} with label @var{label}. -It is similar to @code{message} in that it accepts a @code{printf}-like -strings and any number of arguments. - -@example -@group -;; @r{Display a command message.} -(lmessage 'command "Comment column set to %d" comment-column) -@end group - -@group -;; @r{Display a progress message.} -(lmessage 'progress "Fontifying %s... (%d)" buffer percentage) -@end group - -@group -;; @r{Display a message that should not be logged.} -(lmessage 'no-log "Done") -@end group -@end example -@end defun - -@defun clear-message &optional label frame stdout-p no-restore -This function remove any message with the given @var{label} -from the message-stack, erasing it from the echo area if it's currently -displayed there. - -If a message remains at the head of the message-stack and -@var{no-restore} is @code{nil}, it will be displayed. The string which -remains in the echo area will be returned, or @code{nil} if the -message-stack is now empty. If @var{label} is nil, the entire -message-stack is cleared. - -@example -;; @r{Show a message, wait for 2 seconds, and restore old minibuffer} -;; @r{contents.} -(message "A message") - @print{} A message -@result{} "A Message" -(lmessage 'my-label "Newsflash! Newsflash!") - @print{} Newsflash! Newsflash! -@result{} "Newsflash! Newsflash!" -(sit-for 2) -(clear-message 'my-label) - @print{} A message -@result{} "A message" -@end example - -Unless you need the return value or you need to specify a label, -you should just use @code{(message nil)}. -@end defun - -@defun current-message &optional frame -This function returns the current message in the echo area, or -@code{nil}. The @var{frame} argument is currently unused. -@end defun - -Some of the messages displayed in the echo area are also recorded in the -@samp{ *Message-Log*} buffer. Exactly which messages will be recorded -can be tuned using the following variables. - -@defopt log-message-max-size -This variable specifies the maximum size of the @samp{ *Message-log*} -buffer. -@end defopt - -@defvar log-message-ignore-labels -This variable specifies the labels whose messages will not be logged. -It should be a list of symbols. -@end defvar - -@defvar log-message-ignore-regexps -This variable specifies the regular expressions matching messages that -will not be logged. It should be a list of regular expressions. - -Normally, packages that generate messages that might need to be ignored -should label them with @code{progress}, @code{prompt}, or @code{no-log}, -so they can be filtered by @code{log-message-ignore-labels}. -@end defvar - -@defvar echo-keystrokes -This variable determines how much time should elapse before command -characters echo. Its value must be a number, which specifies the number -of seconds to wait before echoing. If the user types a prefix key (such -as @kbd{C-x}) and then delays this many seconds before continuing, the -prefix key is echoed in the echo area. Any subsequent characters in the -same command will be echoed as well. - -If the value is zero, then command input is not echoed. -@end defvar - -@defvar cursor-in-echo-area -This variable controls where the cursor appears when a message is -displayed in the echo area. If it is non-@code{nil}, then the cursor -appears at the end of the message. Otherwise, the cursor appears at -point---not in the echo area at all. - -The value is normally @code{nil}; Lisp programs bind it to @code{t} -for brief periods of time. -@end defvar - -@node Warnings -@section Warnings - -XEmacs contains a facility for unified display of various warnings. -Unlike errors, warnings are displayed in the situations when XEmacs -encounters a problem that is recoverable, but which should be fixed for -safe future operation. - -For example, warnings are printed by the startup code when it encounters -problems with X keysyms, when there is an error in @file{.emacs}, and in -other problematic situations. Unlike messages, warnings are displayed -in a separate buffer, and include an explanatory message that may span -across several lines. Here is an example of how a warning is displayed: - -@example -(1) (initialization/error) An error has occurred while loading ~/.emacs: - -Symbol's value as variable is void: bogus-variable - -To ensure normal operation, you should investigate the cause of the error -in your initialization file and remove it. Use the `-debug-init' option -to XEmacs to view a complete error backtrace. -@end example - -Each warning has a @dfn{class} and a @dfn{priority level}. The class is -a symbol describing what sort of warning this is, such as -@code{initialization}, @code{resource} or @code{key-mapping}. - -The warning priority level specifies how important the warning is. The -recognized warning levels, in increased order of priority, are: -@code{debug}, @code{info}, @code{notice}, @code{warning}, @code{error}, -@code{critical}, @code{alert} and @code{emergency}. - -@defun display-warning class message &optional level -This function displays a warning message @var{message} (a string). -@var{class} should be a warning class symbol, as described above, or a -list of such symbols. @var{level} describes the warning priority level. -If unspecified, it default to @code{warning}. - -@example -@group -(display-warning 'resource - "Bad resource specification encountered: -something like - - Emacs*foo: bar - -You should replace the * with a . in order to get proper behavior when -you use the specifier and/or `set-face-*' functions.") -@end group - -@group ----------- Warning buffer ---------- -(1) (resource/warning) Bad resource specification encountered: -something like - - Emacs*foo: bar - -You should replace the * with a . in order to get proper behavior when -you use the specifier and/or `set-face-*' functions. ----------- Warning buffer ---------- -@end group -@end example -@end defun - -@defun lwarn class level message &rest args -This function displays a formatted labeled warning message. As above, -@var{class} should be the warning class symbol, or a list of such -symbols, and @var{level} should specify the warning priority level -(@code{warning} by default). - -Unlike in @code{display-warning}, @var{message} may be a formatted -message, which will be, together with the rest of the arguments, passed -to @code{format}. - -@example -(lwarn 'message-log 'warning - "Error caught in `remove-message-hook': %s" - (error-message-string e)) -@end example -@end defun - -@defvar log-warning-minimum-level -This variable specifies the minimum level of warnings that should be -generated. Warnings with level lower than defined by this variable are -completely ignored, as if they never happened. -@end defvar - -@defvar display-warning-minimum-level -This variable specifies the minimum level of warnings that should be -displayed. Unlike @code{log-warning-minimum-level}, setting this -function does not suppress warnings entirely---they are still generated -in the @samp{*Warnings*} buffer, only they are not displayed by default. -@end defvar - -@defvar log-warning-suppressed-classes -This variable specifies a list of classes that should not be logged or -displayed. If any of the class symbols associated with a warning is the -same as any of the symbols listed here, the warning will be completely -ignored, as it they never happened. -@end defvar - -@defvar display-warning-suppressed-classes -This variable specifies a list of classes that should not be logged or -displayed. If any of the class symbols associated with a warning is the -same as any of the symbols listed here, the warning will not be -displayed. The warning will still logged in the *Warnings* buffer -(unless also contained in `log-warning-suppressed-classes'), but the -buffer will not be automatically popped up. -@end defvar - -@node Invisible Text -@section Invisible Text - -@cindex invisible text -You can make characters @dfn{invisible}, so that they do not appear on -the screen, with the @code{invisible} property. This can be either a -text property or a property of an overlay. - -In the simplest case, any non-@code{nil} @code{invisible} property makes -a character invisible. This is the default case---if you don't alter -the default value of @code{buffer-invisibility-spec}, this is how the -@code{invisibility} property works. This feature is much like selective -display (@pxref{Selective Display}), but more general and cleaner. - -More generally, you can use the variable @code{buffer-invisibility-spec} -to control which values of the @code{invisible} property make text -invisible. This permits you to classify the text into different subsets -in advance, by giving them different @code{invisible} values, and -subsequently make various subsets visible or invisible by changing the -value of @code{buffer-invisibility-spec}. - -Controlling visibility with @code{buffer-invisibility-spec} is -especially useful in a program to display the list of entries in a data -base. It permits the implementation of convenient filtering commands to -view just a part of the entries in the data base. Setting this variable -is very fast, much faster than scanning all the text in the buffer -looking for properties to change. - -@defvar buffer-invisibility-spec -This variable specifies which kinds of @code{invisible} properties -actually make a character invisible. - -@table @asis -@item @code{t} -A character is invisible if its @code{invisible} property is -non-@code{nil}. This is the default. - -@item a list -Each element of the list makes certain characters invisible. -Ultimately, a character is invisible if any of the elements of this list -applies to it. The list can have two kinds of elements: - -@table @code -@item @var{atom} -A character is invisible if its @code{invisible} property value -is @var{atom} or if it is a list with @var{atom} as a member. - -@item (@var{atom} . t) -A character is invisible if its @code{invisible} property value -is @var{atom} or if it is a list with @var{atom} as a member. -Moreover, if this character is at the end of a line and is followed -by a visible newline, it displays an ellipsis. -@end table -@end table -@end defvar - - Ordinarily, commands that operate on text or move point do not care -whether the text is invisible. However, the user-level line motion -commands explicitly ignore invisible newlines. - -@node Selective Display -@section Selective Display -@cindex selective display - - @dfn{Selective display} is a pair of features that hide certain -lines on the screen. - - The first variant, explicit selective display, is designed for use in -a Lisp program. The program controls which lines are hidden by altering -the text. Outline mode has traditionally used this variant. It has -been partially replaced by the invisible text feature (@pxref{Invisible -Text}); there is a new version of Outline mode which uses that instead. - - In the second variant, the choice of lines to hide is made -automatically based on indentation. This variant is designed to be a -user-level feature. - - The way you control explicit selective display is by replacing a -newline (control-j) with a carriage return (control-m). The text that -was formerly a line following that newline is now invisible. Strictly -speaking, it is temporarily no longer a line at all, since only newlines -can separate lines; it is now part of the previous line. - - Selective display does not directly affect editing commands. For -example, @kbd{C-f} (@code{forward-char}) moves point unhesitatingly into -invisible text. However, the replacement of newline characters with -carriage return characters affects some editing commands. For example, -@code{next-line} skips invisible lines, since it searches only for -newlines. Modes that use selective display can also define commands -that take account of the newlines, or that make parts of the text -visible or invisible. - - When you write a selectively displayed buffer into a file, all the -control-m's are output as newlines. This means that when you next read -in the file, it looks OK, with nothing invisible. The selective display -effect is seen only within XEmacs. - -@defvar selective-display -This buffer-local variable enables selective display. This means that -lines, or portions of lines, may be made invisible. - -@itemize @bullet -@item -If the value of @code{selective-display} is @code{t}, then any portion -of a line that follows a control-m is not displayed. - -@item -If the value of @code{selective-display} is a positive integer, then -lines that start with more than that many columns of indentation are not -displayed. -@end itemize - -When some portion of a buffer is invisible, the vertical movement -commands operate as if that portion did not exist, allowing a single -@code{next-line} command to skip any number of invisible lines. -However, character movement commands (such as @code{forward-char}) do -not skip the invisible portion, and it is possible (if tricky) to insert -or delete text in an invisible portion. - -In the examples below, we show the @emph{display appearance} of the -buffer @code{foo}, which changes with the value of -@code{selective-display}. The @emph{contents} of the buffer do not -change. - -@example -@group -(setq selective-display nil) - @result{} nil - ----------- Buffer: foo ---------- -1 on this column - 2on this column - 3n this column - 3n this column - 2on this column -1 on this column ----------- Buffer: foo ---------- -@end group - -@group -(setq selective-display 2) - @result{} 2 - ----------- Buffer: foo ---------- -1 on this column - 2on this column - 2on this column -1 on this column ----------- Buffer: foo ---------- -@end group -@end example -@end defvar - -@defvar selective-display-ellipses -If this buffer-local variable is non-@code{nil}, then XEmacs displays -@samp{@dots{}} at the end of a line that is followed by invisible text. -This example is a continuation of the previous one. - -@example -@group -(setq selective-display-ellipses t) - @result{} t - ----------- Buffer: foo ---------- -1 on this column - 2on this column ... - 2on this column -1 on this column ----------- Buffer: foo ---------- -@end group -@end example - -You can use a display table to substitute other text for the ellipsis -(@samp{@dots{}}). @xref{Display Tables}. -@end defvar - -@node Overlay Arrow -@section The Overlay Arrow -@cindex overlay arrow - - The @dfn{overlay arrow} is useful for directing the user's attention -to a particular line in a buffer. For example, in the modes used for -interface to debuggers, the overlay arrow indicates the line of code -about to be executed. - -@defvar overlay-arrow-string -This variable holds the string to display to call attention to a -particular line, or @code{nil} if the arrow feature is not in use. -Despite its name, the value of this variable can be either a string -or a glyph (@pxref{Glyphs}). -@end defvar - -@defvar overlay-arrow-position -This variable holds a marker that indicates where to display the overlay -arrow. It should point at the beginning of a line. The arrow text -appears at the beginning of that line, overlaying any text that would -otherwise appear. Since the arrow is usually short, and the line -usually begins with indentation, normally nothing significant is -overwritten. - -The overlay string is displayed only in the buffer that this marker -points into. Thus, only one buffer can have an overlay arrow at any -given time. -@c !!! overlay-arrow-position: but the overlay string may remain in the display -@c of some other buffer until an update is required. This should be fixed -@c now. Is it? -@end defvar - - You can do the same job by creating an extent with a -@code{begin-glyph} property. @xref{Extent Properties}. - -@node Temporary Displays -@section Temporary Displays - - Temporary displays are used by commands to put output into a buffer -and then present it to the user for perusal rather than for editing. -Many of the help commands use this feature. - -@defspec with-output-to-temp-buffer buffer-name forms@dots{} -This function executes @var{forms} while arranging to insert any -output they print into the buffer named @var{buffer-name}. The buffer -is then shown in some window for viewing, displayed but not selected. - -The string @var{buffer-name} specifies the temporary buffer, which -need not already exist. The argument must be a string, not a buffer. -The buffer is erased initially (with no questions asked), and it is -marked as unmodified after @code{with-output-to-temp-buffer} exits. - -@code{with-output-to-temp-buffer} binds @code{standard-output} to the -temporary buffer, then it evaluates the forms in @var{forms}. Output -using the Lisp output functions within @var{forms} goes by default to -that buffer (but screen display and messages in the echo area, although -they are ``output'' in the general sense of the word, are not affected). -@xref{Output Functions}. - -The value of the last form in @var{forms} is returned. - -@example -@group ----------- Buffer: foo ---------- - This is the contents of foo. ----------- Buffer: foo ---------- -@end group - -@group -(with-output-to-temp-buffer "foo" - (print 20) - (print standard-output)) -@result{} # - ----------- Buffer: foo ---------- -20 - -# - ----------- Buffer: foo ---------- -@end group -@end example -@end defspec - -@defvar temp-buffer-show-function -If this variable is non-@code{nil}, @code{with-output-to-temp-buffer} -calls it as a function to do the job of displaying a help buffer. The -function gets one argument, which is the buffer it should display. - -In Emacs versions 18 and earlier, this variable was called -@code{temp-buffer-show-hook}. -@end defvar - -@defun momentary-string-display string position &optional char message -This function momentarily displays @var{string} in the current buffer at -@var{position}. It has no effect on the undo list or on the buffer's -modification status. - -The momentary display remains until the next input event. If the next -input event is @var{char}, @code{momentary-string-display} ignores it -and returns. Otherwise, that event remains buffered for subsequent use -as input. Thus, typing @var{char} will simply remove the string from -the display, while typing (say) @kbd{C-f} will remove the string from -the display and later (presumably) move point forward. The argument -@var{char} is a space by default. - -The return value of @code{momentary-string-display} is not meaningful. - -You can do the same job in a more general way by creating an extent -with a begin-glyph property. @xref{Extent Properties}. - -If @var{message} is non-@code{nil}, it is displayed in the echo area -while @var{string} is displayed in the buffer. If it is @code{nil}, a -default message says to type @var{char} to continue. - -In this example, point is initially located at the beginning of the -second line: - -@example -@group ----------- Buffer: foo ---------- -This is the contents of foo. -@point{}Second line. ----------- Buffer: foo ---------- -@end group - -@group -(momentary-string-display - "**** Important Message! ****" - (point) ?\r - "Type RET when done reading") -@result{} t -@end group - -@group ----------- Buffer: foo ---------- -This is the contents of foo. -**** Important Message! ****Second line. ----------- Buffer: foo ---------- - ----------- Echo Area ---------- -Type RET when done reading ----------- Echo Area ---------- -@end group -@end example - - This function works by actually changing the text in the buffer. As a -result, if you later undo in this buffer, you will see the message come -and go. -@end defun - -@node Blinking -@section Blinking Parentheses -@cindex parenthesis matching -@cindex blinking -@cindex balancing parentheses -@cindex close parenthesis - - This section describes the mechanism by which XEmacs shows a matching -open parenthesis when the user inserts a close parenthesis. - -@vindex blink-paren-hook -@defvar blink-paren-function -The value of this variable should be a function (of no arguments) to -be called whenever a character with close parenthesis syntax is inserted. -The value of @code{blink-paren-function} may be @code{nil}, in which -case nothing is done. - -@quotation -@strong{Please note:} This variable was named @code{blink-paren-hook} in -older Emacs versions, but since it is not called with the standard -convention for hooks, it was renamed to @code{blink-paren-function} in -version 19. -@end quotation -@end defvar - -@defvar blink-matching-paren -If this variable is @code{nil}, then @code{blink-matching-open} does -nothing. -@end defvar - -@defvar blink-matching-paren-distance -This variable specifies the maximum distance to scan for a matching -parenthesis before giving up. -@end defvar - -@defvar blink-matching-paren-delay -This variable specifies the number of seconds for the cursor to remain -at the matching parenthesis. A fraction of a second often gives -good results, but the default is 1, which works on all systems. -@end defvar - -@defun blink-matching-open -This function is the default value of @code{blink-paren-function}. It -assumes that point follows a character with close parenthesis syntax and -moves the cursor momentarily to the matching opening character. If that -character is not already on the screen, it displays the character's -context in the echo area. To avoid long delays, this function does not -search farther than @code{blink-matching-paren-distance} characters. - -Here is an example of calling this function explicitly. - -@smallexample -@group -(defun interactive-blink-matching-open () -@c Do not break this line! -- rms. -@c The first line of a doc string -@c must stand alone. - "Indicate momentarily the start of sexp before point." - (interactive) -@end group -@group - (let ((blink-matching-paren-distance - (buffer-size)) - (blink-matching-paren t)) - (blink-matching-open))) -@end group -@end smallexample -@end defun - -@node Usual Display -@section Usual Display Conventions - - The usual display conventions define how to display each character -code. You can override these conventions by setting up a display table -(@pxref{Display Tables}). Here are the usual display conventions: - -@itemize @bullet -@item -Character codes 32 through 126 map to glyph codes 32 through 126. -Normally this means they display as themselves. - -@item -Character code 9 is a horizontal tab. It displays as whitespace -up to a position determined by @code{tab-width}. - -@item -Character code 10 is a newline. - -@item -All other codes in the range 0 through 31, and code 127, display in one -of two ways according to the value of @code{ctl-arrow}. If it is -non-@code{nil}, these codes map to sequences of two glyphs, where the -first glyph is the @sc{ASCII} code for @samp{^}. (A display table can -specify a glyph to use instead of @samp{^}.) Otherwise, these codes map -just like the codes in the range 128 to 255. - -@item -Character codes 128 through 255 map to sequences of four glyphs, where -the first glyph is the @sc{ASCII} code for @samp{\}, and the others are -digit characters representing the code in octal. (A display table can -specify a glyph to use instead of @samp{\}.) -@end itemize - - The usual display conventions apply even when there is a display -table, for any character whose entry in the active display table is -@code{nil}. Thus, when you set up a display table, you need only -specify the characters for which you want unusual behavior. - - These variables affect the way certain characters are displayed on the -screen. Since they change the number of columns the characters occupy, -they also affect the indentation functions. - -@defopt ctl-arrow -@cindex control characters in display -This buffer-local variable controls how control characters are -displayed. If it is non-@code{nil}, they are displayed as a caret -followed by the character: @samp{^A}. If it is @code{nil}, they are -displayed as a backslash followed by three octal digits: @samp{\001}. -@end defopt - -@c Following may have overfull hbox. -@defvar default-ctl-arrow -The value of this variable is the default value for @code{ctl-arrow} in -buffers that do not override it. @xref{Default Value}. -@end defvar - -@defopt tab-width -The value of this variable is the spacing between tab stops used for -displaying tab characters in Emacs buffers. The default is 8. Note -that this feature is completely independent from the user-settable tab -stops used by the command @code{tab-to-tab-stop}. @xref{Indent Tabs}. -@end defopt - -@node Display Tables -@section Display Tables - -@cindex display table -You can use the @dfn{display table} feature to control how all 256 -possible character codes display on the screen. This is useful for -displaying European languages that have letters not in the @sc{ASCII} -character set. - -The display table maps each character code into a sequence of -@dfn{runes}, each rune being an image that takes up one character -position on the screen. You can also define how to display each rune -on your terminal, using the @dfn{rune table}. - -@menu -* Display Table Format:: What a display table consists of. -* Active Display Table:: How XEmacs selects a display table to use. -* Character Descriptors:: Format of an individual element of a - display table. -@end menu - -@ignore Not yet working in XEmacs? -* ISO Latin 1:: How to use display tables - to support the ISO Latin 1 character set. -@end ignore - -@node Display Table Format -@subsection Display Table Format - - A display table is an array of 256 elements. (In FSF Emacs, a display -table is 262 elements. The six extra elements specify the truncation -and continuation glyphs, etc. This method is very kludgey, and in -XEmacs the variables @code{truncation-glyph}, @code{continuation-glyph}, -etc. are used. @xref{Truncation}.) - -@defun make-display-table -This creates and returns a display table. The table initially has -@code{nil} in all elements. -@end defun - - The 256 elements correspond to character codes; the @var{n}th -element says how to display the character code @var{n}. The value -should be @code{nil}, a string, a glyph, or a vector of strings and -glyphs (@pxref{Character Descriptors}). If an element is @code{nil}, -it says to display that character according to the usual display -conventions (@pxref{Usual Display}). - - If you use the display table to change the display of newline -characters, the whole buffer will be displayed as one long ``line.'' - - For example, here is how to construct a display table that mimics the -effect of setting @code{ctl-arrow} to a non-@code{nil} value: - -@example -(setq disptab (make-display-table)) -(let ((i 0)) - (while (< i 32) - (or (= i ?\t) (= i ?\n) - (aset disptab i (concat "^" (char-to-string (+ i 64))))) - (setq i (1+ i))) - (aset disptab 127 "^?")) -@end example - -@node Active Display Table -@subsection Active Display Table -@cindex active display table - - The active display table is controlled by the variable -@code{current-display-table}. This is a specifier, which means -that you can specify separate values for it in individual buffers, -windows, frames, and devices, as well as a global value. It also -means that you cannot set this variable using @code{setq}; use -@code{set-specifier} instead. @xref{Specifiers}. (FSF Emacs -uses @code{window-display-table}, @code{buffer-display-table}, -@code{standard-display-table}, etc. to control the display table. -However, specifiers are a cleaner and more powerful way of doing -the same thing. FSF Emacs also uses a different format for -the contents of a display table, using additional indirection -to a ``glyph table'' and such. Note that ``glyph'' has a different -meaning in XEmacs.) - - Individual faces can also specify an overriding display table; -this is set using @code{set-face-display-table}. @xref{Faces}. - - If no display table can be determined for a particular window, -then XEmacs uses the usual display conventions. @xref{Usual Display}. - -@node Character Descriptors -@subsection Character Descriptors - -@cindex character descriptor - Each element of the display-table vector describes how to display -a particular character and is called a @dfn{character descriptor}. -A character descriptor can be: - -@table @asis -@item a string -Display this particular string wherever the character is to be displayed. - -@item a glyph -Display this particular glyph wherever the character is to be displayed. - -@item a vector -The vector may contain strings and/or glyphs. Display the elements of -the vector one after another wherever the character is to be displayed. - -@item @code{nil} -Display according to the standard interpretation (@pxref{Usual Display}). -@end table - -@ignore Not yet working in XEmacs? -@node ISO Latin 1 -@subsection ISO Latin 1 - -If you have a terminal that can handle the entire ISO Latin 1 character -set, you can arrange to use that character set as follows: - -@example -(require 'disp-table) -;; @r{Set char codes 160--255 to display as themselves.} -;; @r{(Codes 128--159 are the additional control characters.)} -(standard-display-8bit 160 255) -@end example - -If you are editing buffers written in the ISO Latin 1 character set and -your terminal doesn't handle anything but @sc{ASCII}, you can load the -file @file{iso-ascii} to set up a display table that displays the other -ISO characters as explanatory sequences of @sc{ASCII} characters. For -example, the character ``o with umlaut'' displays as @samp{@{"o@}}. - -Some European countries have terminals that don't support ISO Latin 1 -but do support the special characters for that country's language. You -can define a display table to work one language using such terminals. -For an example, see @file{lisp/iso-swed.el}, which handles certain -Swedish terminals. - -You can load the appropriate display table for your terminal -automatically by writing a terminal-specific Lisp file for the terminal -type. -@end ignore - -@node Beeping -@section Beeping -@cindex beeping -@cindex bell -@cindex sound - - You can make XEmacs ring a bell, play a sound, or blink the screen to -attract the user's attention. Be conservative about how often you do -this; frequent bells can become irritating. Also be careful not to use -beeping alone when signaling an error is appropriate. (@xref{Errors}.) - -@defun ding &optional dont-terminate sound device -@cindex keyboard macro termination -This function beeps, or flashes the screen (see @code{visible-bell} -below). It also terminates any keyboard macro currently executing -unless @var{dont-terminate} is non-@code{nil}. If @var{sound} is -specified, it should be a symbol specifying which sound to make. This -sound will be played if @code{visible-bell} is @code{nil}. (This only -works if sound support was compiled into the executable and you are -running on the console of a Sun SparcStation, SGI, HP9000s700, or Linux -PC. Otherwise you just get a beep.) The optional third argument -specifies what device to make the sound on, and defaults to the selected -device. -@end defun - -@defun beep &optional dont-terminate sound device -This is a synonym for @code{ding}. -@end defun - -@defopt visible-bell -This variable determines whether XEmacs should flash the screen to -represent a bell. Non-@code{nil} means yes, @code{nil} means no. On -TTY devices, this is effective only if the Termcap entry for the -terminal type has the visible bell flag (@samp{vb}) set. -@end defopt - -@defvar sound-alist - This variable holds an alist associating names with sounds. When -@code{beep} or @code{ding} is called with one of the name symbols, the -associated sound will be generated instead of the standard beep. - - Each element of @code{sound-alist} is a list describing a sound. The -first element of the list is the name of the sound being defined. -Subsequent elements of the list are alternating keyword/value pairs: - -@table @code -@item sound -A string of raw sound data, or the name of another sound to play. The -symbol @code{t} here means use the default X beep. -@item volume -An integer from 0-100, defaulting to @code{bell-volume}. -@item pitch -If using the default X beep, the pitch (Hz) to generate. -@item duration -If using the default X beep, the duration (milliseconds). -@end table - -For compatibility, elements of `sound-alist' may also be: - -@itemize @bullet -@item -@code{( sound-name . )} -@item -@code{( sound-name )} -@end itemize - -You should probably add things to this list by calling the function -@code{load-sound-file}. - -Caveats: - -@itemize @minus -@item -You can only play audio data if running on the console screen of a Sun -SparcStation, SGI, or HP9000s700. - -@item -The pitch, duration, and volume options are available everywhere, but -many X servers ignore the `pitch' option. -@end itemize - -The following beep-types are used by XEmacs itself: - -@table @code -@item auto-save-error -when an auto-save does not succeed -@item command-error -when the XEmacs command loop catches an error -@item undefined-key -when you type a key that is undefined -@item undefined-click -when you use an undefined mouse-click combination -@item no-completion -during completing-read -@item y-or-n-p -when you type something other than 'y' or 'n' -@item yes-or-no-p -when you type something other than 'yes' or 'no' -@item default -used when nothing else is appropriate. -@end table - -Other lisp packages may use other beep types, but these are the ones that -the C kernel of XEmacs uses. -@end defvar - -@defopt bell-volume -This variable specifies the default volume for sounds, from 0 to 100. -@end defopt - -@deffn Command load-default-sounds -This function loads and installs some sound files as beep-types. -@end deffn - -@deffn Command load-sound-file filename sound-name &optional volume -This function reads in an audio file and adds it to @code{sound-alist}. -The sound file must be in the Sun/NeXT U-LAW format. @var{sound-name} -should be a symbol, specifying the name of the sound. If @var{volume} -is specified, the sound will be played at that volume; otherwise, the -value of @var{bell-volume} will be used. -@end deffn - -@defun play-sound sound &optional volume device -This function plays sound @var{sound}, which should be a symbol -mentioned in @code{sound-alist}. If @var{volume} is specified, it -overrides the value (if any) specified in @code{sound-alist}. -@var{device} specifies the device to play the sound on, and defaults -to the selected device. -@end defun - -@deffn Command play-sound-file file &optional volume device -This function plays the named sound file at volume @var{volume}, which -defaults to @code{bell-volume}. @var{device} specifies the device to -play the sound on, and defaults to the selected device. -@end deffn diff --git a/man/lispref/dragndrop.texi b/man/lispref/dragndrop.texi deleted file mode 100644 index ceab662..0000000 --- a/man/lispref/dragndrop.texi +++ /dev/null @@ -1,128 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1998 Oliver Graf -@c Original reference is (c) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/dragndrop.texi -@node Drag and Drop, Modes, Scrollbars, Top -@chapter Drag and Drop -@cindex drag and drop - -@emph{WARNING}: the Drag'n'Drop API is still under development and the -interface may change! The current implementation is considered experimental. - - Drag'n'drop is a way to transfer information between multiple applications. -To do this several GUIs define their own protocols. Examples are OffiX, CDE, -Motif, KDE, MSWindows, GNOME, and many more. To catch all these protocols, -XEmacs provides a generic API. - -One prime idea behind the API is to use a data interface that is -transparent for all systems. The author thinks that this is best -archived by using URL and MIME data, cause any internet enabled system -must support these for email already. XEmacs also already provides -powerful interfaces to support these types of data (tm and w3). - -@menu -* Supported Protocols:: Which low-level protocols are supported. -* Drop Interface:: How XEmacs handles a drop from another application. -* Drag Interface:: Calls to initiate a drag from XEmacs. -@end menu - -@node Supported Protocols -@section Supported Protocols - -The current release of XEmacs only support a small set of Drag'n'drop -protocols. Some of these only support limited options available in the API. - -@menu -* OffiX DND:: A generic X based protocol. -* CDE dt:: Common Desktop Environment used on suns. -* MSWindows OLE:: Mr. Gates way of live. -* Loose ends:: The other protocols. -@end menu - -@node OffiX DND -@subsection OffiX DND -@cindex OffiX DND - -@emph{WARNING}: If you compile in OffiX, you may not be able to use -multiple X displays successfully. If the two servers are from -different vendors, the results may be unpredictable. - -The OffiX Drag'n'Drop protocol is part of a X API/Widget library created by -Cesar Crusius. It is based on X-Atoms and ClientMessage events, and works with -any X platform supporting them. - -OffiX is supported if 'offix is member of the variable dragdrop-protocols, or -the feature 'offix is defined. - -Unfortunately it uses it's own data types. Examples are: File, Files, -Exe, Link, URL, MIME. The API tries to choose the right type for the data that -is dragged from XEmacs (well, not yet...). - -XEmacs supports both MIME and URL drags and drops using this API. No application -interaction is possible while dragging is in progress. - -For information about the OffiX project have a look at http://leb.net/~offix/ - -@node CDE dt -@subsection CDE dt -@cindex CDE dt - -CDE stands for Common Desktop Environment. It is based on the Motif -widget library. It's drag'n'drop protocol is also an abstraction of the -Motif protocol (so it might be possible, that XEmacs will also support -the Motif protocol soon). - -CDE has three different types: file, buffer, and text. XEmacs only uses -file and buffer drags. The API will disallow full URL drags, only file -method URLs are passed through. - -Buffer drags are always converted to plain text. - -@node MSWindows OLE -@subsection MSWindows OLE -@cindex MSWindows OLE - -Only allows file drags and drops. - -@node Loose ends -@subsection Loose ends - -The following protocols will be supported soon: Xdnd, Motif, Xde (if I -get some specs), KDE OffiX (if KDE can find XEmacs windows). - -In particular Xdnd will be one of the protocols that can benefit from -the XEmacs API, cause it also uses MIME types to encode dragged data. - -@node Drop Interface -@section Drop Interface -@cindex drop -@cindex Drop API - -For each activated low-level protocol, a internal routine will catch -incoming drops and convert them to a dragdrop-drop type -misc-user-event. - -This misc-user-event has its function argument set to -@code{dragdrop-drop-dispatch} and the object contains the data of the drop -(converted to URL/MIME specific data). This function will search the variable -@code{experimental-dragdrop-drop-functions} for a function that can handle the -dropped data. - -To modify the drop behavior, the user can modify the variable -@code{experimental-dragdrop-drop-functions}. Each element of this list -specifies a possible handler for dropped data. The first one that can handle -the data will return @code{t} and exit. Another possibility is to set a -extent-property with the same name. Extents are checked prior to the -variable. - -The customization group @code{drag-n-drop} shows all variables of user -interest. - -@node Drag Interface -@section Drag Interface -@cindex drag -@cindex Drag API - -This describes the drag API (not implemented yet). diff --git a/man/lispref/edebug-inc.texi b/man/lispref/edebug-inc.texi deleted file mode 100644 index bce6dbc..0000000 --- a/man/lispref/edebug-inc.texi +++ /dev/null @@ -1,1699 +0,0 @@ -@comment -*-texinfo-*- - -@node Edebug, , Compilation Errors, Top -@section Edebug -@cindex Edebug mode - -@cindex Edebug - Edebug is a source-level debugger for XEmacs Lisp programs that -provides the following features: - -@itemize @bullet -@item -Step through evaluation, stopping before and after each expression. - -@item -Set conditional or unconditional breakpoints, install embedded -breakpoints, or a global break event. - -@item -Trace slow or fast stopping briefly at each stop point, or -each breakpoint. - -@item -Display expression results and evaluate expressions as if outside of -Edebug. Interface with the custom printing package -for printing circular structures. - -@item -Automatically reevaluate a list of expressions and -display their results each time Edebug updates the display. - -@item -Output trace info on function enter and exit. - -@item -Errors stop before the source causing the error. - -@item -Display backtrace without Edebug calls. - -@item -Allow specification of argument evaluation for macros and defining forms. - -@item -Provide rudimentary coverage testing and display of frequency counts. - -@end itemize - -The first three sections should tell you enough about Edebug to enable -you to use it. - -@menu -* Using Edebug:: Introduction to use of Edebug. -* Instrumenting:: You must first instrument code. -* Edebug Execution Modes:: Execution modes, stopping more or less often. -* Jumping:: Commands to jump to a specified place. -* Edebug Misc:: Miscellaneous commands. -* Breakpoints:: Setting breakpoints to make the program stop. -* Trapping Errors:: trapping errors with Edebug. -* Edebug Views:: Views inside and outside of Edebug. -* Edebug Eval:: Evaluating expressions within Edebug. -* Eval List:: Automatic expression evaluation. -* Reading in Edebug:: Customization of reading. -* Printing in Edebug:: Customization of printing. -* Tracing:: How to produce tracing output. -* Coverage Testing:: How to test evaluation coverage. -* The Outside Context:: Data that Edebug saves and restores. -* Instrumenting Macro Calls:: Specifying how to handle macro calls. -* Edebug Options:: Option variables for customizing Edebug. -@end menu - -@node Using Edebug -@subsection Using Edebug - - To debug an XEmacs Lisp program with Edebug, you must first -@dfn{instrument} the Lisp code that you want to debug. If you want to -just try it now, load @file{edebug.el}, move point into a definition and -do @kbd{C-u C-M-x} (@code{eval-defun} with a prefix argument). -See @ref{Instrumenting} for alternative ways to instrument code. - - Once a function is instrumented, any call to the function activates -Edebug. Activating Edebug may stop execution and let you step through -the function, or it may update the display and continue execution while -checking for debugging commands, depending on the selected Edebug -execution mode. The initial execution mode is @code{step}, by default, -which does stop execution. @xref{Edebug Execution Modes}. - - Within Edebug, you normally view an XEmacs buffer showing the source of -the Lisp function you are debugging. This is referred to as the -@dfn{source code buffer}---but note that it is not always the same -buffer depending on which function is currently being executed. - - An arrow at the left margin indicates the line where the function is -executing. Point initially shows where within the line the function is -executing, but you can move point yourself. - - If you instrument the definition of @code{fac} (shown below) and then -execute @code{(fac 3)}, here is what you normally see. Point is at the -open-parenthesis before @code{if}. - -@example -(defun fac (n) -=>@point{}(if (< 0 n) - (* n (fac (1- n))) - 1)) -@end example - -@cindex stop points -The places within a function where Edebug can stop execution are called -@dfn{stop points}. These occur both before and after each subexpression -that is a list, and also after each variable reference. -Here we show with periods the stop points found in the function -@code{fac}: - -@example -(defun fac (n) - .(if .(< 0 n.). - .(* n. .(fac (1- n.).).). - 1).) -@end example - -While the source code buffer is selected, the special commands of Edebug -are available in it, in addition to the commands of XEmacs Lisp mode. -(The buffer is temporarily made read-only, however.) For example, you -can type the Edebug command @key{SPC} to execute until the next stop -point. If you type @key{SPC} once after entry to @code{fac}, here is -the display you will see: - -@example -(defun fac (n) -=>(if @point{}(< 0 n) - (* n (fac (1- n))) - 1)) -@end example - -When Edebug stops execution after an expression, it displays the -expression's value in the echo area. - -Other frequently used commands are @kbd{b} to set a breakpoint at a stop -point, @kbd{g} to execute until a breakpoint is reached, and @kbd{q} to -exit to the top-level command loop. Type @kbd{?} to display a list of -all Edebug commands. - - -@node Instrumenting -@subsection Instrumenting for Edebug - - In order to use Edebug to debug Lisp code, you must first -@dfn{instrument} the code. Instrumenting a form inserts additional code -into it which invokes Edebug at the proper places. Furthermore, if -Edebug detects a syntax error while instrumenting, point is left at the -erroneous code and an @code{invalid-read-syntax} error is signaled. - -@kindex C-M-x -@findex eval-defun (Edebug) -@findex edebug-all-defs - Once you have loaded Edebug, the command @kbd{C-M-x} -(@code{eval-defun}) is redefined so that when invoked with a prefix -argument on a definition, it instruments the definition before -evaluating it. (The source code itself is not modified.) If the -variable @code{edebug-all-defs} is non-@code{nil}, that inverts the -meaning of the prefix argument: then @kbd{C-M-x} instruments the -definition @emph{unless} it has a prefix argument. The default value of -@code{edebug-all-defs} is @code{nil}. The command @kbd{M-x -edebug-all-defs} toggles the value of the variable -@code{edebug-all-defs}. - -@findex edebug-all-forms -@findex eval-region (Edebug) -@findex eval-current-buffer (Edebug) - If @code{edebug-all-defs} is non-@code{nil}, then the commands -@code{eval-region}, @code{eval-current-buffer}, and @code{eval-buffer} -also instrument any definitions they evaluate. Similarly, -@code{edebug-all-forms} controls whether @code{eval-region} should -instrument @emph{any} form, even non-defining forms. This doesn't apply -to loading or evaluations in the minibuffer. The command @kbd{M-x -edebug-all-forms} toggles this option. - -@findex edebug-eval-top-level-form -Another command, @kbd{M-x edebug-eval-top-level-form}, is available to -instrument any top-level form regardless of the value of -@code{edebug-all-defs} or @code{edebug-all-forms}. - -Just before Edebug instruments any code, it calls any functions in the -variable @code{edebug-setup-hook} and resets its value to @code{nil}. -You could use this to load up Edebug specifications associated with a -package you are using but only when you also use Edebug. For example, -@file{my-specs.el} may be loaded automatically when you use -@code{my-package} with Edebug by including the following code in -@file{my-package.el}. - -@example -(add-hook 'edebug-setup-hook - (function (lambda () (require 'my-specs)))) -@end example - -While Edebug is active, the command @kbd{I} -(@code{edebug-instrument-callee}) instruments the definition of the -function or macro called by the list form after point, if is not already -instrumented. If the location of the definition is not known to Edebug, -this command cannot be used. After loading Edebug, @code{eval-region} -records the position of every definition it evaluates, even if not -instrumenting it. Also see the command @kbd{i} (@ref{Jumping}) which -steps into the callee. - -@cindex special forms (Edebug) -@cindex interactive commands (Edebug) -@cindex anonymous lambda expressions (Edebug) -@cindex Common Lisp (Edebug) -@pindex cl.el (Edebug) -@pindex cl-specs.el - Edebug knows how to instrument all the standard special forms, an -interactive form with an expression argument, anonymous lambda -expressions, and other defining forms. (Specifications for macros -defined by @file{cl.el} (version 2.03) are provided in -@file{cl-specs.el}.) Edebug cannot know what a user-defined macro will -do with the arguments of a macro call so you must tell it. See -@ref{Instrumenting Macro Calls} for the details. - -@findex eval-expression (Edebug) - Note that a couple ways remain to evaluate expressions without -instrumenting them. Loading a file via the @code{load} subroutine does -not instrument expressions for Edebug. Evaluations in the minibuffer -via @code{eval-expression} (@kbd{M-ESC}) are not instrumented. - - To remove instrumentation from a definition, simply reevaluate it with -one of the non-instrumenting commands, or reload the file. - -See @ref{Edebug Eval} for other evaluation functions available -inside of Edebug. - - -@node Edebug Execution Modes -@subsection Edebug Execution Modes - -@cindex Edebug execution modes -Edebug supports several execution modes for running the program you are -debugging. We call these alternatives @dfn{Edebug execution modes}; do -not confuse them with major or minor modes. The current Edebug -execution mode determines how Edebug displays the progress of the -evaluation, whether it stops at each stop point, or continues to the -next breakpoint, for example. - -Normally, you specify the Edebug execution mode by typing a command -to continue the program in a certain mode. Here is a table of these -commands. All except for @kbd{S} resume execution of the program, at -least for a certain distance. - -@table @kbd -@item S -Stop: don't execute any more of the program for now, just wait for more -Edebug commands (@code{edebug-stop}). - -@item @key{SPC} -Step: stop at the next stop point encountered (@code{edebug-step-mode}). - -@item n -Next: stop at the next stop point encountered after an expression -(@code{edebug-next-mode}). Also see @code{edebug-forward-sexp} in -@ref{Edebug Misc}. - -@item t -Trace: pause one second at each Edebug stop point (@code{edebug-trace-mode}). - -@item T -Rapid trace: update at each stop point, but don't actually -pause (@code{edebug-Trace-fast-mode}). - -@item g -Go: run until the next breakpoint (@code{edebug-go-mode}). @xref{Breakpoints}. - -@item c -Continue: pause for one second at each breakpoint, but don't stop -(@code{edebug-continue-mode}). - -@item C -Rapid continue: update at each breakpoint, but don't actually pause -(@code{edebug-Continue-fast-mode}). - -@item G -Go non-stop: ignore breakpoints (@code{edebug-Go-nonstop-mode}). You -can still stop the program by hitting any key. -@end table - -In general, the execution modes earlier in the above list run the -program more slowly or stop sooner. - -When you enter a new Edebug level, the initial execution mode comes from -the value of the variable @code{edebug-initial-mode}. By default, this -specifies @code{step} mode. Note that you may reenter the same Edebug -level several times if, for example, an instrumented function is called -several times from one command. - -While executing or tracing, you can interrupt the execution by typing -any Edebug command. Edebug stops the program at the next stop point and -then executes the command that you typed. For example, typing @kbd{t} -during execution switches to trace mode at the next stop point. You can -use @kbd{S} to stop execution without doing anything else. - -If your function happens to read input, a character you hit intending to -interrupt execution may be read by the function instead. You can avoid -such unintended results by paying attention to when your program wants -input. - -@cindex keyboard macros (Edebug) -Keyboard macros containing Edebug commands do not work; when you exit -from Edebug, to resume the program, whether you are defining or -executing a keyboard macro is forgotten. Also, defining or executing a -keyboard macro outside of Edebug does not affect the command loop inside -Edebug. This is usually an advantage. But see -@code{edebug-continue-kbd-macro}. - - -@node Jumping -@subsection Jumping - -Commands described here let you jump to a specified location. -All, except @kbd{i}, use temporary breakpoints to establish the stop -point and then switch to @code{go} mode. Any other breakpoint reached -before the intended stop point will also stop execution. See -@ref{Breakpoints} for the details on breakpoints. - -@table @kbd -@item f -Run the program forward over one expression -(@code{edebug-forward-sexp}). More precisely, set a temporary -breakpoint at the position that @kbd{C-M-f} would reach, then execute in -@code{go} mode so that the program will stop at breakpoints. - -With a prefix argument @var{n}, the temporary breakpoint is placed -@var{n} sexps beyond point. If the containing list ends before @var{n} -more elements, then the place to stop is after the containing -expression. - -Be careful that the position @kbd{C-M-f} finds is a place that the -program will really get to; this may not be true in a -@code{cond}, for example. - -This command does @code{forward-sexp} starting at point rather than the -stop point. If you want to execute one expression from the current stop -point, type @kbd{w} first, to move point there. - -@item o -Continue ``out of'' an expression (@code{edebug-step-out}). It places a -temporary breakpoint at the end of the sexp containing point. - -If the containing sexp is a function definition itself, it continues -until just before the last sexp in the definition. If that is where you -are now, it returns from the function and then stops. In other words, -this command does not exit the currently executing function unless you -are positioned after the last sexp. - -@item I -Step into the function or macro after point after first ensuring that it -is instrumented. It does this by calling @code{edebug-on-entry} and -then switching to @code{go} mode. - -Although the automatic instrumentation is convenient, it is not -later automatically uninstrumented. - -@item h -Proceed to the stop point near where point is using a temporary -breakpoint (@code{edebug-goto-here}). - -@end table - -All the commands in this section may fail to work as expected in case -of nonlocal exit, because a nonlocal exit can bypass the temporary -breakpoint where you expected the program to stop. - -@node Edebug Misc -@subsection Miscellaneous - -Some miscellaneous commands are described here. - -@table @kbd -@item ? -Display the help message for Edebug (@code{edebug-help}). - -@item C-] -Abort one level back to the previous command level -(@code{abort-recursive-edit}). - -@item q -Return to the top level editor command loop (@code{top-level}). This -exits all recursive editing levels, including all levels of Edebug -activity. However, instrumented code protected with -@code{unwind-protect} or @code{condition-case} forms may resume -debugging. - -@item Q -Like @kbd{q} but don't stop even for protected code -(@code{top-level-nonstop}). - -@item r -Redisplay the most recently known expression result in the echo area -(@code{edebug-previous-result}). - -@item d -Display a backtrace, excluding Edebug's own functions for clarity -(@code{edebug-backtrace}). - -You cannot use debugger commands in the backtrace buffer in Edebug as -you would in the standard debugger. - -The backtrace buffer is killed automatically when you continue -execution. -@end table - -From the Edebug recursive edit, you may invoke commands that activate -Edebug again recursively. Any time Edebug is active, you can quit to -the top level with @kbd{q} or abort one recursive edit level with -@kbd{C-]}. You can display a backtrace of all the -pending evaluations with @kbd{d}. - - -@node Breakpoints -@subsection Breakpoints - -@cindex breakpoints -There are three more ways to stop execution once it has started: -breakpoints, the global break condition, and embedded breakpoints. - -While using Edebug, you can specify @dfn{breakpoints} in the program you -are testing: points where execution should stop. You can set a -breakpoint at any stop point, as defined in @ref{Using Edebug}. For -setting and unsetting breakpoints, the stop point that is affected is -the first one at or after point in the source code buffer. Here are the -Edebug commands for breakpoints: - -@table @kbd -@item b -Set a breakpoint at the stop point at or after point -(@code{edebug-set-breakpoint}). If you use a prefix argument, the -breakpoint is temporary (it turns off the first time it stops the -program). - -@item u -Unset the breakpoint (if any) at the stop point at or after the current -point (@code{edebug-unset-breakpoint}). - -@item x @var{condition} @key{RET} -Set a conditional breakpoint which stops the program only if -@var{condition} evaluates to a non-@code{nil} value -(@code{edebug-set-conditional-breakpoint}). If you use a prefix -argument, the breakpoint is temporary (it turns off the first time it -stops the program). - -@item B -Move point to the next breakpoint in the definition -(@code{edebug-next-breakpoint}). -@end table - -While in Edebug, you can set a breakpoint with @kbd{b} and unset one -with @kbd{u}. First you must move point to a position at or before the -desired Edebug stop point, then hit the key to change the breakpoint. -Unsetting a breakpoint that has not been set does nothing. - -Reevaluating or reinstrumenting a definition clears all its breakpoints. - -A @dfn{conditional breakpoint} tests a condition each time the program -gets there. To set a conditional breakpoint, use @kbd{x}, and specify -the condition expression in the minibuffer. Setting a conditional -breakpoint at a stop point that already has a conditional breakpoint -puts the current condition expression in the minibuffer so you can edit -it. - -You can make both conditional and unconditional breakpoints -@dfn{temporary} by using a prefix arg to the command to set the -breakpoint. After breaking at a temporary breakpoint, it is -automatically cleared. - -Edebug always stops or pauses at a breakpoint except when the Edebug -mode is @code{Go-nonstop}. In that mode, it ignores breakpoints entirely. - -To find out where your breakpoints are, use @kbd{B}, which -moves point to the next breakpoint in the definition following point, or -to the first breakpoint if there are no following breakpoints. This -command does not continue execution---it just moves point in the buffer. - -@menu -* Global Break Condition:: Breaking on an event. -* Embedded Breakpoints:: Embedding breakpoints in code. -@end menu - - -@node Global Break Condition -@subsubsection Global Break Condition - -@cindex stopping on events -@cindex global break condition -In contrast to breaking when execution reaches specified locations, -you can also cause a break when a certain event occurs. The @dfn{global -break condition} is a condition that is repeatedly evaluated at every -stop point. If it evaluates to a non-@code{nil} value, then execution -is stopped or paused depending on the execution mode, just like a -breakpoint. Any errors that might occur as a result of evaluating the -condition are ignored, as if the result were @code{nil}. - -@findex edebug-set-global-break-condition -@vindex edebug-global-break-condition -You can set or edit the condition expression, stored in -@code{edebug-global-break-condition}, using @kbd{X} -(@code{edebug-set-global-break-condition}). - -Using the global break condition is perhaps the fastest way -to find where in your code some event occurs, but since it is rather -expensive you should reset the condition to @code{nil} when not in use. - - -@node Embedded Breakpoints -@subsubsection Embedded Breakpoints - -@findex edebug -@cindex embedded breakpoints -Since all breakpoints in a definition are cleared each time you -reinstrument it, you might rather create an @dfn{embedded breakpoint} -which is simply a call to the function @code{edebug}. You can, of -course, make such a call conditional. For example, in the @code{fac} -function, insert the first line as shown below to stop when the argument -reaches zero: - -@example -(defun fac (n) - (if (= n 0) (edebug)) - (if (< 0 n) - (* n (fac (1- n))) - 1)) -@end example - -When the @code{fac} definition is instrumented and the function is -called, Edebug will stop before the call to @code{edebug}. Depending on -the execution mode, Edebug will stop or pause. - -However, if no instrumented code is being executed, calling -@code{edebug} will instead invoke @code{debug}. Calling @code{debug} -will always invoke the standard backtrace debugger. - - -@node Trapping Errors -@subsection Trapping Errors - -@vindex edebug-on-error -@vindex edebug-on-quit -An error may be signaled by subroutines or XEmacs Lisp code. If a signal -is not handled by a @code{condition-case}, this indicates an -unrecognized situation has occurred. If Edebug is not active when an -unhandled error is signaled, @code{debug} is run normally (if -@code{debug-on-error} is non-@code{nil}). But while Edebug is active, -@code{debug-on-error} and @code{debug-on-quit} are bound to -@code{edebug-on-error} and @code{edebug-on-quit}, which are both -@code{t} by default. Actually, if @code{debug-on-error} already has -a non-@code{nil} value, that value is still used. - -It is best to change the values of @code{edebug-on-error} or -@code{edebug-on-quit} when Edebug is not active since their values won't -be used until the next time Edebug is invoked at a deeper command level. -If you only change @code{debug-on-error} or @code{debug-on-quit} while -Edebug is active, these changes will be forgotten when Edebug becomes -inactive. Furthermore, during Edebug's recursive edit, these variables -are bound to the values they had outside of Edebug. - -Edebug shows you the last stop point that it knew about before the -error was signaled. This may be the location of a call to a function -which was not instrumented, within which the error actually occurred. -For an unbound variable error, the last known stop point might be quite -distant from the offending variable. If the cause of the error is not -obvious at first, note that you can also get a full backtrace inside of -Edebug (see @ref{Edebug Misc}). - -Edebug can also trap signals even if they are handled. If -@code{debug-on-error} is a list of signal names, Edebug will stop when -any of these errors are signaled. Edebug shows you the last known stop -point just as for unhandled errors. After you continue execution, the -error is signaled again (but without being caught by Edebug). Edebug -can only trap errors that are handled if they are signaled in Lisp code -(not subroutines) since it does so by temporarily replacing the -@code{signal} function. - - -@node Edebug Views -@subsection Edebug Views - -The following Edebug commands let you view aspects of the buffer and -window status that obtained before entry to Edebug. - -@table @kbd -@item v -View the outside window configuration (@code{edebug-view-outside}). - -@item p -Temporarily display the outside current buffer with point at its outside -position (@code{edebug-bounce-point}). If prefix arg is supplied, sit for -that many seconds instead. - -@item w -Move point back to the current stop point (@code{edebug-where}) in the -source code buffer. Also, if you use this command in another window -displaying the same buffer, this window will be used instead to -display the buffer in the future. - -@item W -Toggle the @code{edebug-save-windows} variable which indicates whether -the outside window configuration is saved and restored -(@code{edebug-toggle-save-windows}). Also, each time it is toggled on, -make the outside window configuration the same as the current window -configuration. - -With a prefix argument, @code{edebug-toggle-save-windows} only toggles -saving and restoring of the selected window. To specify a window that -is not displaying the source code buffer, you must use @kbd{C-xXW} from -the global keymap. - - -@end table - -You can view the outside window configuration with @kbd{v} or just -bounce to the current point in the current buffer with @kbd{p}, even if -it is not normally displayed. After moving point, you may wish to pop -back to the stop point with @kbd{w} from a source code buffer. - -By using @kbd{W} twice, Edebug again saves and restores the -outside window configuration, but to the current configuration. This is -a convenient way to, for example, add another buffer to be displayed -whenever Edebug is active. However, the automatic redisplay of -@samp{*edebug*} and @samp{*edebug-trace*} may conflict with the buffers -you wish to see unless you have enough windows open. - - -@node Edebug Eval -@subsection Evaluation - -While within Edebug, you can evaluate expressions ``as if'' Edebug were -not running. Edebug tries to be invisible to the expression's -evaluation and printing. Evaluation of expressions that cause side -effects will work as expected except for things that Edebug explicitly -saves and restores. See @ref{The Outside Context} for details on this -process. Also see @ref{Reading in Edebug} and @ref{Printing in Edebug} -for topics related to evaluation. - -@table @kbd -@item e @var{exp} @key{RET} -Evaluate expression @var{exp} in the context outside of Edebug -(@code{edebug-eval-expression}). In other words, Edebug tries to avoid -altering the effect of @var{exp}. - -@item M-@key{ESC} @var{exp} @key{RET} -Evaluate expression @var{exp} in the context of Edebug itself. - -@item C-x C-e -Evaluate the expression before point, in the context outside of Edebug -(@code{edebug-eval-last-sexp}). -@end table - -@cindex lexical binding (Edebug) -Edebug supports evaluation of expressions containing references to -lexically bound symbols created by the following constructs in -@file{cl.el} (version 2.03 or later): @code{lexical-let}, -@code{macrolet}, and @code{symbol-macrolet}. - - -@node Eval List -@subsection Evaluation List Buffer - -You can use the @dfn{evaluation list buffer}, called @samp{*edebug*}, to -evaluate expressions interactively. You can also set up the -@dfn{evaluation list} of expressions to be evaluated automatically each -time Edebug updates the display. - -@table @kbd -@item E -Switch to the evaluation list buffer @samp{*edebug*} -(@code{edebug-visit-eval-list}). -@end table - -In the @samp{*edebug*} buffer you can use the commands of Lisp -Interaction as well as these special commands: - -@table @kbd -@item LFD -Evaluate the expression before point, in the outside context, and insert -the value in the buffer (@code{edebug-eval-print-last-sexp}). - -@item C-x C-e -Evaluate the expression before point, in the context outside of Edebug -(@code{edebug-eval-last-sexp}). - -@item C-c C-u -Build a new evaluation list from the first expression of each group, -reevaluate and redisplay (@code{edebug-update-eval-list}). Groups are -separated by comment lines. - -@item C-c C-d -Delete the evaluation list group that point is in -(@code{edebug-delete-eval-item}). - -@item C-c C-w -Switch back to the source code buffer at the current stop point -(@code{edebug-where}). -@end table - -You can evaluate expressions in the evaluation list window with -@kbd{LFD} or @kbd{C-x C-e}, just as you would in @samp{*scratch*}; -but they are evaluated in the context outside of Edebug. - -@cindex evaluation list (Edebug) -The expressions you enter interactively (and their results) are lost -when you continue execution unless you add them to the -evaluation list with @kbd{C-c C-u}. This command builds a new list from -the first expression of each @dfn{evaluation list group}. Groups are -separated by comment lines. Be careful not to add expressions that -execute instrumented code otherwise an infinite loop will result. - -When the evaluation list is redisplayed, each expression is displayed -followed by the result of evaluating it, and a comment line. If an -error occurs during an evaluation, the error message is displayed in a -string as if it were the result. Therefore expressions that, for -example, use variables not currently valid do not interrupt your -debugging. - -Here is an example of what the evaluation list window looks like after -several expressions have been added to it: - -@smallexample -(current-buffer) -# -;--------------------------------------------------------------- -(selected-window) -# -;--------------------------------------------------------------- -(point) -196 -;--------------------------------------------------------------- -bad-var -"Symbol's value as variable is void: bad-var" -;--------------------------------------------------------------- -(recursion-depth) -0 -;--------------------------------------------------------------- -this-command -eval-last-sexp -;--------------------------------------------------------------- -@end smallexample - -To delete a group, move point into it and type @kbd{C-c C-d}, or simply -delete the text for the group and update the evaluation list with -@kbd{C-c C-u}. When you add a new group, be sure it is separated from -its neighbors by a comment line. - -After selecting @samp{*edebug*}, you can return to the source code -buffer with @kbd{C-c C-w}. The @samp{*edebug*} buffer is killed when -you continue execution, and recreated next time it is needed. - - -@node Reading in Edebug -@subsection Reading in Edebug - -@cindex reading (Edebug) -To instrument a form, Edebug first reads the whole form. Edebug -replaces the standard Lisp Reader with its own reader that remembers the -positions of expressions. This reader is used by the Edebug -replacements for @code{eval-region}, @code{eval-defun}, -@code{eval-buffer}, and @code{eval-current-buffer}. - -@pindex cl-read -Another package, @file{cl-read.el}, replaces the standard reader with -one that understands Common Lisp reader macros. If you use that -package, Edebug will automatically load @file{edebug-cl-read.el} to -provide corresponding reader macros that remember positions of -expressions. If you define new reader macros, you will have to define -similar reader macros for Edebug. - - -@node Printing in Edebug -@subsection Printing in Edebug - -@cindex printing (Edebug) -@cindex printing circular structures -@pindex cust-print -If the result of an expression in your program contains a circular -reference, you may get an error when Edebug attempts to print it. You -can set @code{print-length} to a non-zero value to limit the print -length of lists (the number of cdrs), and in Emacs 19, set -@code{print-level} to a non-zero value to limit the print depth of -lists. But you can print such circular structures and structures that -share elements more informatively by using the @file{cust-print} -package. - -To load @file{cust-print} and activate custom printing only for Edebug, -simply use the command @kbd{M-x edebug-install-custom-print}. To -restore the standard print functions, use @kbd{M-x -edebug-uninstall-custom-print}. You can also activate custom printing -for printing in any Lisp code; see the package for details. - -Here is an example of code that creates a circular structure: - -@example -(progn - (edebug-install-custom-print) - (setq a '(x y)) - (setcar a a)) -@end example - -Edebug will print the result of the @code{setcar} as @samp{Result: -#1=(#1# y)}. The @samp{#1=} notation names the structure that follows -it, and the @samp{#1#} notation references the previously named -structure. This notation is used for any shared elements of lists or -vectors. - -@vindex edebug-print-length -@vindex edebug-print-level -@vindex edebug-print-circle -@vindex print-readably -Independent of whether @file{cust-print} is active, while printing -results Edebug binds @code{print-length}, @code{print-level}, and -@code{print-circle} to @code{edebug-print-length} (@code{50}), -@code{edebug-print-level} (@code{50}), and @code{edebug-print-circle} -(@code{t}) respectively, if these values are non-@code{nil}. Also, -@code{print-readably} is bound to @code{nil} since some objects simply -cannot be printed readably. - - -@node Tracing -@subsection Tracing - -@cindex tracing -In addition to automatic stepping through source code, which is also -called @emph{tracing} (see @ref{Edebug Execution Modes}), Edebug can -produce a traditional trace listing of execution in a separate buffer, -@samp{*edebug-trace*}. - -@findex edebug-print-trace-before -@findex edebug-print-trace-after -If the variable @code{edebug-trace} is non-nil, each function entry and -exit adds lines to the trace buffer. On function entry, Edebug prints -@samp{::::@{} followed by the function name and argument values. On -function exit, Edebug prints @samp{::::@}} followed by the function name -and result of the function. The number of @samp{:}s is computed from -the recursion depth. The balanced braces in the trace buffer can be -used to find the matching beginning or end of function calls. These -displays may be customized by replacing the functions -@code{edebug-print-trace-before} and @code{edebug-print-trace-after}, -which take an arbitrary message string to print. - -@findex edebug-tracing -The macro @code{edebug-tracing} provides tracing similar to function -enter and exit tracing, but for arbitrary expressions. This macro -should be explicitly inserted by you around expressions you wish to -trace the execution of. The first argument is a message string -(evaluated), and the rest are expressions to evaluate. The result of -the last expression is returned. - -@findex edebug-trace -Finally, you can insert arbitrary strings into the trace buffer with -explicit calls to @code{edebug-trace}. The arguments of this function -are the same as for @code{message}, but a newline is always inserted -after each string printed in this way. - -@code{edebug-tracing} and @code{edebug-trace} insert lines in the trace -buffer even if Edebug is not active. Every time the trace buffer is -added to, the window is scrolled to show the last lines inserted. -(There may be some display problems if you use tracing along with the -evaluation list.) - - -@node Coverage Testing -@subsection Coverage Testing - -@cindex coverage testing -@cindex frequency counts -@cindex performance analysis -Edebug provides a rudimentary coverage tester and display of execution -frequency. Frequency counts are always accumulated, both before and -after evaluation of each instrumented expression, even if the execution -mode is @code{Go-nonstop}. Coverage testing is only done if the option -@code{edebug-test-coverage} is non-@code{nil} because this is relatively -expensive. Both data sets are displayed by @kbd{M-x -edebug-display-freq-count}. - -@deffn Command edebug-display-freq-count -Display the frequency count data for each line of the current -definition. The frequency counts are inserted as comment lines after -each line, and you can undo all insertions with one @code{undo} command. -The counts are inserted starting under the @kbd{(} before an expression -or the @kbd{)} after an expression, or on the last char of a symbol. -The counts are only displayed when they differ from previous counts on -the same line. - -If coverage is being tested, whenever all known results of an expression -are @code{eq}, the char @kbd{=} will be appended after the count -for that expression. Note that this is always the case for an -expression only evaluated once. - -To clear the frequency count and coverage data for a definition, -reinstrument it. - -@end deffn - -For example, after evaluating @code{(fac 5)} with an embedded -breakpoint, and setting @code{edebug-test-coverage} to @code{t}, when -the breakpoint is reached, the frequency data is looks like this: - -@example -(defun fac (n) - (if (= n 0) (edebug)) -;#6 1 0 =5 - (if (< 0 n) -;#5 = - (* n (fac (1- n))) -;# 5 0 - 1)) -;# 0 -@end example - -The comment lines show that @code{fac} has been called 6 times. The -first @code{if} statement has returned 5 times with the same result each -time, and the same is true for the condition on the second @code{if}. -The recursive call of @code{fac} has not returned at all. - - -@node The Outside Context -@subsection The Outside Context - -Edebug tries to be transparent to the program you are debugging. In -addition, most evaluations you do within Edebug (see @ref{Edebug Eval}) -occur in the same outside context which is temporarily restored for the -evaluation. But Edebug is not completely successful and this section -explains precisely how it fails. Edebug operation unavoidably alters -some data in XEmacs, and this can interfere with debugging certain -programs. Also notice that Edebug's protection against change of -outside data means that any side effects @emph{intended} by the user in -the course of debugging will be defeated. - -@menu -* Checking Whether to Stop:: When Edebug decides what to do. -* Edebug Display Update:: When Edebug updates the display. -* Edebug Recursive Edit:: When Edebug stops execution. -@end menu - - -@node Checking Whether to Stop -@subsubsection Checking Whether to Stop - -Whenever Edebug is entered just to think about whether to take some -action, it needs to save and restore certain data. - -@itemize @bullet -@item -@code{max-lisp-eval-depth} and @code{max-specpdl-size} are both -incremented one time to reduce Edebug's impact on the stack. -You could, however, still run out of stack space when using Edebug. - -@item -The state of keyboard macro execution is saved and restored. While -Edebug is active, @code{executing-macro} is bound to -@code{edebug-continue-kbd-macro}. - -@end itemize - - -@node Edebug Display Update -@subsubsection Edebug Display Update - -When Edebug needs to display something (e.g., in trace mode), it saves -the current window configuration from ``outside'' Edebug. When you exit -Edebug (by continuing the program), it restores the previous window -configuration. - -XEmacs redisplays only when it pauses. Usually, when you continue -execution, the program comes back into Edebug at a breakpoint or after -stepping without pausing or reading input in between. In such cases, -XEmacs never gets a chance to redisplay the ``outside'' configuration. -What you see is the same window configuration as the last time Edebug -was active, with no interruption. - -Entry to Edebug for displaying something also saves and restores the -following data, but some of these are deliberately not restored if an -error or quit signal occurs. - -@itemize @bullet -@item -@cindex current buffer point and mark (Edebug) -Which buffer is current, and where point and mark are in the current -buffer are saved and restored. - -@item -@cindex window configuration (Edebug) -@findex save-excursion (Edebug) -@vindex edebug-save-windows -The Edebug Display Update, is saved and restored if -@code{edebug-save-windows} is non-@code{nil}. It is not restored on -error or quit, but the outside selected window @emph{is} reselected even -on error or quit in case a @code{save-excursion} is active. -If the value of @code{edebug-save-windows} is a list, only the listed -windows are saved and restored. - -The window start and horizontal scrolling of the source code buffer are -not restored, however, so that the display remains coherent. - -@item -@vindex edebug-save-displayed-buffer-points -The value of point in each displayed buffer is saved and restored if -@code{edebug-save-displayed-buffer-points} is non-@code{nil}. - -@item -The variables @code{overlay-arrow-position} and -@code{overlay-arrow-string} are saved and restored. So you can safely -invoke Edebug from the recursive edit elsewhere in the same buffer. - -@item -@code{cursor-in-echo-area} is locally bound to @code{nil} so that -the cursor shows up in the window. - -@end itemize - - -@node Edebug Recursive Edit -@subsubsection Edebug Recursive Edit - -When Edebug is entered and actually reads commands from the user, it -saves (and later restores) these additional data: - -@itemize @bullet -@item -The current match data, for whichever buffer was current. - -@item -@code{last-command}, @code{this-command}, @code{last-command-char}, -@code{last-input-char}, @code{last-input-event}, -@code{last-command-event}, -@code{last-event-frame}, @code{last-nonmenu-event}, and -@code{track-mouse} . Commands used within Edebug do not affect these -variables outside of Edebug. - -The key sequence returned by @code{this-command-keys} is changed by -executing commands within Edebug and there is no way to reset -the key sequence from Lisp. - -For Emacs 18, Edebug cannot save and restore the value of -@code{unread-command-char}. Entering Edebug while this variable has -a nontrivial value can interfere with execution of the program you are -debugging. - -@item -Complex commands executed while in Edebug are added to the variable -@code{command-history}. In rare cases this can alter execution. - -@item -Within Edebug, the recursion depth appears one deeper than the recursion -depth outside Edebug. This is not true of the automatically updated -evaluation list window. - -@item -@code{standard-output} and @code{standard-input} are bound to @code{nil} -by the @code{recursive-edit}, but Edebug temporarily restores them during -evaluations. - -@item -The state of keyboard macro definition is saved and restored. While -Edebug is active, @code{defining-kbd-macro} is bound to -@code{edebug-continue-kbd-macro}. - -@end itemize - - -@node Instrumenting Macro Calls -@subsection Instrumenting Macro Calls - -When Edebug instruments an expression that calls a Lisp macro, it needs -additional advice to do the job properly. This is because there is no -way to tell which subexpressions of the macro call may be evaluated. -(Evaluation may occur explicitly in the macro body, or when the -resulting expansion is evaluated, or any time later.) You must explain -the format of macro call arguments by using @code{def-edebug-spec} to -define an @dfn{Edebug specification} for each macro. - -@deffn Macro def-edebug-spec macro specification -Specify which expressions of a call to macro @var{macro} are forms to be -evaluated. For simple macros, the @var{specification} often looks very -similar to the formal argument list of the macro definition, but -specifications are much more general than macro arguments. - -The @var{macro} argument may actually be any symbol, not just a macro -name. - -Unless you are using Emacs 19 or XEmacs, this macro is only defined -in Edebug, so you may want to use the following which is equivalent: -@code{(put '@var{macro} 'edebug-form-spec '@var{specification})} -@end deffn - -Here is a simple example that defines the specification for the -@code{for} macro described in the XEmacs Lisp Reference Manual, followed -by an alternative, equivalent specification. - -@example -(def-edebug-spec for - (symbolp "from" form "to" form "do" &rest form)) - -(def-edebug-spec for - (symbolp ['from form] ['to form] ['do body])) -@end example - -Here is a table of the possibilities for @var{specification} and how each -directs processing of arguments. - -@table @bullet - -@item @code{t} -All arguments are instrumented for evaluation. - -@item @code{0} -None of the arguments is instrumented. - -@item a symbol -The symbol must have an Edebug specification which is used instead. -This indirection is repeated until another kind of specification is -found. This allows you to inherit the specification for another macro. - -@item a list -The elements of the list describe the types of the arguments of a -calling form. The possible elements of a specification list are -described in the following sections. -@end table - -@menu -* Specification List:: How to specify complex patterns of evaluation. -* Backtracking:: What Edebug does when matching fails. -* Debugging Backquote:: Debugging Backquote -* Specification Examples:: To help understand specifications. -@end menu - - -@node Specification List -@subsubsection Specification List - -@cindex Edebug specification list -A @dfn{specification list} is required for an Edebug specification if -some arguments of a macro call are evaluated while others are not. Some -elements in a specification list match one or more arguments, but others -modify the processing of all following elements. The latter, called -@dfn{keyword specifications}, are symbols beginning with @samp{@code{&}} -(e.g. @code{&optional}). - -A specification list may contain sublists which match arguments that are -themselves lists, or it may contain vectors used for grouping. Sublists -and groups thus subdivide the specification list into a hierarchy of -levels. Keyword specifications only apply to the remainder of the -sublist or group they are contained in and there is an implicit grouping -around a keyword specification and all following elements in the -sublist or group. - -If a specification list fails -at some level, then backtracking may be invoked to find some alternative -at a higher level, or if no alternatives remain, an error will be -signaled. See @ref{Backtracking} for more details. - -Edebug specifications provide at least the power of regular expression -matching. Some context-free constructs are also supported: the matching -of sublists with balanced parentheses, recursive processing of forms, -and recursion via indirect specifications. - -Each element of a specification list may be one of the following, with -the corresponding type of argument: - -@table @code - -@item sexp -A single unevaluated expression. - -@item form -A single evaluated expression, which is instrumented. - -@item place -@findex edebug-unwrap -A place as in the Common Lisp @code{setf} place argument. It will be -instrumented just like a form, but the macro is expected to strip the -instrumentation. Two functions, @code{edebug-unwrap} and -@code{edebug-unwrap*}, are provided to strip the instrumentation one -level or recursively at all levels. - -@item body -Short for @code{&rest form}. See @code{&rest} below. - -@item function-form -A function form: either a quoted function symbol, a quoted lambda expression, -or a form (that should evaluate to a function symbol or lambda -expression). This is useful when function arguments might be quoted -with @code{quote} rather than @code{function} since the body of a lambda -expression will be instrumented either way. - -@item lambda-expr -An unquoted anonymous lambda expression. - -@item &optional -@cindex &optional (Edebug) -All following elements in the specification list are optional; as soon -as one does not match, Edebug stops matching at this level. - -To make just a few elements optional followed by non-optional elements, -use @code{[&optional @var{specs}@dots{}]}. To specify that several -elements should all succeed together, use @code{&optional -[@var{specs}@dots{}]}. See the @code{defun} example below. - -@item &rest -@cindex &rest (Edebug) -All following elements in the specification list are repeated zero or -more times. All the elements need not match in the last repetition, -however. - -To repeat only a few elements, use @code{[&rest @var{specs}@dots{}]}. -To specify all elements must match on every repetition, use @code{&rest -[@var{specs}@dots{}]}. - -@item &or -@cindex &or (Edebug) -Each of the following elements in the specification list is an -alternative, processed left to right until one matches. One of the -alternatives must match otherwise the @code{&or} specification fails. - -Each list element following @code{&or} is a single alternative even if -it is a keyword specification. (This breaks the implicit grouping rule.) -To group two or more list elements as a single alternative, enclose them -in @code{[@dots{}]}. - -@item ¬ -@cindex ¬ (Edebug) -Each of the following elements is matched as alternatives as if by using -@code{&or}, but if any of them match, the specification fails. If none -of them match, nothing is matched, but the @code{¬} specification -succeeds. - -@item &define -@cindex &define (Edebug) -Indicates that the specification is for a defining form. The defining -form itself is not instrumented (i.e. Edebug does not stop before and -after the defining form), but forms inside it typically will be -instrumented. The @code{&define} keyword should be the first element in -a list specification. - -Additional specifications that may only appear after @code{&define} are -described here. See the @code{defun} example below. - -@table @code - -@item name -The argument, a symbol, is the name of the defining form. -But a defining form need not be named at all, in which -case a unique name will be created for it. - -The @code{name} specification may be used more than once in the -specification and each subsequent use will append the corresponding -symbol argument to the previous name with @samp{@code{@@}} between them. -This is useful for generating unique but meaningful names for -definitions such as @code{defadvice} and @code{defmethod}. - -@item :name -The element following @code{:name} should be a symbol; it is used as an -additional name component for the definition. This is useful to add a -unique, static component to the name of the definition. It may be used -more than once. No argument is matched. - -@item arg -The argument, a symbol, is the name of an argument of the defining form. -However, lambda list keywords (symbols starting with @samp{@code{&}}) -are not allowed. See @code{lambda-list} and the example below. - -@item lambda-list -@cindex lambda-list (Edebug) -This matches the whole argument list of an XEmacs Lisp lambda -expression, which is a list of symbols and the keywords -@code{&optional} and @code{&rest} - -@item def-body -The argument is the body of code in a definition. This is like -@code{body}, described above, but a definition body must be instrumented -with a different Edebug call that looks up information associated with -the definition. Use @code{def-body} for the highest level list of forms -within the definition. - -@item def-form -The argument is a single, highest-level form in a definition. This is -like @code{def-body}, except use this to match a single form rather than -a list of forms. As a special case, @code{def-form} also means that -tracing information is not output when the form is executed. See the -@code{interactive} example below. - -@end table - -@item nil -This is successful when there are no more arguments to match at the -current argument list level; otherwise it fails. See sublist -specifications and the backquote example below. - -@item gate -@cindex preventing backtracking -No argument is matched but backtracking through the gate is disabled -while matching the remainder of the specifications at this level. This -is primarily used to generate more specific syntax error messages. See -@ref{Backtracking} for more details. Also see the @code{let} example -below. - -@item @var{other-symbol} -@cindex indirect specifications -Any other symbol in a specification list may be a predicate or an -indirect specification. - -If the symbol has an Edebug specification, this @dfn{indirect -specification} should be either a list specification that is used in -place of the symbol, or a function that is called to process the -arguments. The specification may be defined with @code{def-edebug-spec} -just as for macros. See the @code{defun} example below. - -Otherwise, the symbol should be a predicate. The predicate is called -with the argument and the specification fails if the predicate fails. -The argument is not instrumented. - -@findex keywordp -@findex lambda-list-keywordp -Predicates that may be used include: @code{symbolp}, @code{integerp}, -@code{stringp}, @code{vectorp}, @code{atom} (which matches a number, -string, symbol, or vector), @code{keywordp}, and -@code{lambda-list-keywordp}. The last two, defined in @file{edebug.el}, -test whether the argument is a symbol starting with @samp{@code{:}} and -@samp{@code{&}} respectively. - -@item [@var{elements}@dots{}] -@cindex [@dots{}] (Edebug) -Rather than matching a vector argument, a vector treats -the @var{elements} as a single @dfn{group specification}. - -@item "@var{string}" -The argument should be a symbol named @var{string}. This specification -is equivalent to the quoted symbol, @code{'@var{symbol}}, where the name -of @var{symbol} is the @var{string}, but the string form is preferred. - -@item '@var{symbol} @r{or} (quote @var{symbol}) -The argument should be the symbol @var{symbol}. But use a string -specification instead. - -@item (vector @var{elements}@dots{}) -The argument should be a vector whose elements must match the -@var{elements} in the specification. See the backquote example below. - -@item (@var{elements}@dots{}) -Any other list is a @dfn{sublist specification} and the argument must be -a list whose elements match the specification @var{elements}. - -@cindex dotted lists (Edebug) -A sublist specification may be a dotted list and the corresponding list -argument may then be a dotted list. Alternatively, the last cdr of a -dotted list specification may be another sublist specification (via a -grouping or an indirect specification, e.g. @code{(spec . [(more -specs@dots{})])}) whose elements match the non-dotted list arguments. -This is useful in recursive specifications such as in the backquote -example below. Also see the description of a @code{nil} specification -above for terminating such recursion. - -Note that a sublist specification of the form @code{(specs . nil)} -means the same as @code{(specs)}, and @code{(specs . -(sublist-elements@dots{}))} means the same as @code{(specs -sublist-elements@dots{})}. - -@end table - -@c Need to document extensions with &symbol and :symbol - -@node Backtracking -@subsubsection Backtracking - -@cindex backtracking -@cindex syntax error (Edebug) -If a specification fails to match at some point, this does not -necessarily mean a syntax error will be signaled; instead, -@dfn{backtracking} will take place until all alternatives have been -exhausted. Eventually every element of the argument list must be -matched by some element in the specification, and every required element -in the specification must match some argument. - -Backtracking is disabled for the remainder of a sublist or group when -certain conditions occur, described below. Backtracking is reenabled -when a new alternative is established by @code{&optional}, @code{&rest}, -or @code{&or}. It is also reenabled initially when processing a -sublist or group specification or an indirect specification. - -You might want to disable backtracking to commit to some alternative so -that Edebug can provide a more specific syntax error message. Normally, -if no alternative matches, Edebug reports that none matched, but if one -alternative is committed to, Edebug can report how it failed to match. - -First, backtracking is disabled while matching any of the form -specifications (i.e. @code{form}, @code{body}, @code{def-form}, and -@code{def-body}). These specifications will match any form so any error -must be in the form itself rather than at a higher level. - -Second, backtracking is disabled after successfully matching a quoted -symbol or string specification, since this usually indicates a -recognized construct. If you have a set of alternative constructs that -all begin with the same symbol, you can usually work around this -constraint by factoring the symbol out of the alternatives, e.g., -@code{["foo" &or [first case] [second case] ...]}. - -Third, backtracking may be explicitly disabled by using the -@code{gate} specification. This is useful when you know that -no higher alternatives may apply. - - -@node Debugging Backquote -@subsubsection Debugging Backquote - -@findex ` (Edebug) -@cindex backquote (Edebug) -Backquote (@kbd{`}) is a macro that results in an expression that may or -may not be evaluated. It is often used to simplify the definition of a -macro to return an expression that is evaluated, but Edebug does not know -when this is the case. However, the forms inside unquotes (@code{,} and -@code{,@@}) are evaluated and Edebug instruments them. - -Nested backquotes are supported by Edebug, but there is a limit on the -support of quotes inside of backquotes. Quoted forms (with @code{'}) -are not normally evaluated, but if the quoted form appears immediately -within @code{,} and @code{,@@} forms, Edebug treats this as a backquoted -form at the next higher level (even if there is not a next higher level -- this is difficult to fix). - -@findex edebug-` -If the backquoted forms happen to be code intended to be evaluated, you -can have Edebug instrument them by using @code{edebug-`} instead of the -regular @code{`}. Unquoted forms can always appear inside -@code{edebug-`} anywhere a form is normally allowed. But @code{(, -@var{form})} may be used in two other places specially recognized by -Edebug: wherever a predicate specification would match, and at the head -of a list form in place of a function name or lambda expression. The -@var{form} inside a spliced unquote, @code{(,@@ @var{form})}, will be -wrapped, but the unquote form itself will not be wrapped since this -would interfere with the splicing. - -There is one other complication with using @code{edebug-`}. If the -@code{edebug-`} call is in a macro and the macro may be called from code -that is also instrumented, and if unquoted forms contain any macro -arguments bound to instrumented forms, then you should modify the -specification for the macro as follows: the specifications for those -arguments must use @code{def-form} instead of @code{form}. (This is to -reestablish the Edebugging context for those external forms.) - -For example, the @code{for} macro -@c (@pxref{Problems with Macros}) @c in XEmacs Lisp Reference Manual -(@pxref{Problems with Macros,,,, XEmacs Lisp Reference Manual}) @c Edebug Doc -is shown here but with @code{edebug-`} -substituted for regular @code{`}. - -@example -(defmacro inc (var) - (list 'setq var (list '1+ var))) - -(defmacro for (var from init to final do &rest body) - (let ((tempvar (make-symbol "max"))) - (edebug-` (let (((, var) (, init)) - ((, tempvar) (, final))) - (while (<= (, var) (, tempvar)) - (,@ body) - (inc (, var))))))) -@end example - -Here is the corresponding modified Edebug specification and some code -that calls the macro: - -@example -(def-edebug-spec for - (symbolp "from" def-form "to" def-form "do" &rest def-form)) - -(let ((n 5)) - (for i from n to (* n (+ n 1)) do - (message "%s" i))) -@end example - -After instrumenting the @code{for} macro and the macro call, Edebug -first steps to the beginning of the macro call, then into the macro -body, then through each of the unquoted expressions in the backquote -showing the expressions that will be embedded in the backquote form. -Then when the macro expansion is evaluated, Edebug will step through the -@code{let} form and each time it gets to an unquoted form, it will jump -back to an argument of the macro call to step through that expression. -Finally stepping will continue after the macro call. Even more -convoluted execution paths may result when using anonymous functions. - -@vindex edebug-unwrap-results -When the result of an expression is an instrumented expression, it is -difficult to see the expression inside the instrumentation. So -you may want to set the option @code{edebug-unwrap-results} to a -non-@code{nil} value while debugging such expressions, but it would slow -Edebug down to always do this. - - -@node Specification Examples -@subsubsection Specification Examples - -Here we provide several examples of Edebug specifications to show -many of its capabilities. - -A @code{let} special form has a sequence of bindings and a body. Each -of the bindings is either a symbol or a sublist with a symbol and -optional value. In the specification below, notice the @code{gate} -inside of the sublist to prevent backtracking. - -@example -(def-edebug-spec let - ((&rest - &or symbolp (gate symbolp &optional form)) - body)) -@end example - -Edebug uses the following specifications for @code{defun} and -@code{defmacro} and the associated argument list and @code{interactive} -specifications. It is necessary to handle the expression argument of an -interactive form specially since it is actually evaluated outside of the -function body. - -@example -(def-edebug-spec defmacro defun) ; @r{Indirect ref to @code{defun} spec} -(def-edebug-spec defun - (&define name lambda-list - [&optional stringp] ; @r{Match the doc string, if present.} - [&optional ("interactive" interactive)] - def-body)) - -(def-edebug-spec lambda-list - (([&rest arg] - [&optional ["&optional" arg &rest arg]] - &optional ["&rest" arg] - ))) - -(def-edebug-spec interactive - (&optional &or stringp def-form)) ; @r{Notice: @code{def-form}} -@end example - -The specification for backquote below illustrates how to match -dotted lists and use @code{nil} to terminate recursion. It also -illustrates how components of a vector may be matched. (The actual -specification provided by Edebug does not support dotted lists because -doing so causes very deep recursion that could fail.) - -@example -(def-edebug-spec ` (backquote-form)) ;; alias just for clarity - -(def-edebug-spec backquote-form - (&or ([&or "," ",@@"] &or ("quote" backquote-form) form) - (backquote-form . [&or nil backquote-form]) - (vector &rest backquote-form) - sexp)) -@end example - - -@node Edebug Options -@subsection Edebug Options - -These options affect the behavior of Edebug: - -@defopt edebug-setup-hook -Functions to call before Edebug is used. Each time it is set to a new -value, Edebug will call those functions once and then -@code{edebug-setup-hook} is reset to @code{nil}. You could use this to -load up Edebug specifications associated with a package you are using -but only when you also use Edebug. -See @ref{Instrumenting}. -@end defopt - -@defopt edebug-all-defs -If non-@code{nil}, normal evaluation of any defining forms (e.g. -@code{defun} and @code{defmacro}) will instrument them for Edebug. This -applies to @code{eval-defun}, @code{eval-region}, and -@code{eval-current-buffer}. - -Use the command @kbd{M-x edebug-all-defs} to toggle the value of -this variable. You may want to make this variable local to each -buffer by calling @code{(make-local-variable 'edebug-all-defs)} in your -@code{emacs-lisp-mode-hook}. -See @ref{Instrumenting}. -@end defopt - -@defopt edebug-all-forms -If non-@code{nil}, normal evaluation of any forms by @code{eval-defun}, -@code{eval-region}, and @code{eval-current-buffer} will instrument them -for Edebug. - -Use the command @kbd{M-x edebug-all-forms} to toggle the value of this -option. -See @ref{Instrumenting}. -@end defopt - -@defopt edebug-save-windows -If non-@code{nil}, save and restore window configuration on Edebug -calls. It takes some time to do this, so if your program does not care -what happens to data about windows, you may want to set this variable to -@code{nil}. - -If the value is a list, only the listed windows are saved and -restored. - -@kbd{M-x edebug-toggle-save-windows} may be used to change this variable. -This command is bound to @kbd{W} in source code buffers. -See @ref{Edebug Display Update}. -@end defopt - -@defopt edebug-save-displayed-buffer-points -If non-@code{nil}, save and restore point in all displayed buffers. -This is necessary if you are debugging code that changes the point of a -buffer which is displayed in a non-selected window. If Edebug or the -user then selects the window, the buffer's point will be changed to the -window's point. - -This is an expensive operation since it visits each window and therefore -each displayed buffer twice for each Edebug activation, so it is best to -avoid it if you can. -See @ref{Edebug Display Update}. -@end defopt - - -@defopt edebug-initial-mode -If this variable is non-@code{nil}, it specifies the initial execution -mode for Edebug when it is first activated. Possible values are -@code{step}, @code{next}, @code{go}, @code{Go-nonstop}, @code{trace}, -@code{Trace-fast}, @code{continue}, and @code{Continue-fast}. - -The default value is @code{step}. -See @ref{Edebug Execution Modes}. -@end defopt - -@defopt edebug-trace -@findex edebug-print-trace-before -@findex edebug-print-trace-after -Non-@code{nil} means display a trace of function entry and exit. -Tracing output is displayed in a buffer named @samp{*edebug-trace*}, one -function entry or exit per line, indented by the recursion level. - -The default value is @code{nil}. - -Also see @code{edebug-tracing}. -See @ref{Tracing}. -@end defopt - -@defopt edebug-test-coverage -If non-@code{nil}, Edebug tests coverage of all expressions debugged. -This is done by comparing the result of each expression -with the previous result. Coverage is considered OK if two different -results are found. So to sufficiently test the coverage of your code, -try to execute it under conditions that evaluate all expressions more -than once, and produce different results for each expression. - -Use @kbd{M-x edebug-display-freq-count} to display the frequency count -and coverage information for a definition. -See @ref{Coverage Testing}. -@end defopt - -@defopt edebug-continue-kbd-macro -If non-@code{nil}, continue defining or executing any keyboard macro -that is executing outside of Edebug. Use this with caution since it is not -debugged. -See @ref{Edebug Execution Modes}. -@end defopt - -@defopt edebug-print-length - If non-@code{nil}, bind @code{print-length} to this while printing -results in Edebug. The default value is @code{50}. -See @ref{Printing in Edebug}. -@end defopt - -@defopt edebug-print-level - If non-@code{nil}, bind @code{print-level} to this while printing -results in Edebug. The default value is @code{50}. -@end defopt - -@defopt edebug-print-circle - If non-@code{nil}, bind @code{print-circle} to this while printing -results in Edebug. The default value is @code{nil}. -@end defopt - -@defopt edebug-on-error - @code{debug-on-error} is bound to this while Edebug is active. -See @ref{Trapping Errors}. -@end defopt - -@defopt edebug-on-quit - @code{debug-on-quit} is bound to this while Edebug is active. -See @ref{Trapping Errors}. -@end defopt - -@defopt edebug-unwrap-results - Non-@code{nil} if Edebug should unwrap results of expressions. -This is useful when debugging macros where the results of expressions -are instrumented expressions. But don't do this when results might be -circular or an infinite loop will result. -See @ref{Debugging Backquote}. -@end defopt - -@defopt edebug-global-break-condition - If non-@code{nil}, an expression to test for at every stop point. -If the result is non-nil, then break. Errors are ignored. -See @ref{Global Break Condition}. -@end defopt diff --git a/man/lispref/edebug.texi b/man/lispref/edebug.texi deleted file mode 100644 index 37f5ad4..0000000 --- a/man/lispref/edebug.texi +++ /dev/null @@ -1,310 +0,0 @@ -\input texinfo @comment -*-texinfo-*- -@comment %**start of header -@setfilename ../info/edebug.info -@settitle Edebug User Manual -@comment %**end of header - -@comment ================================================================ -@comment This file has the same style as the XEmacs Lisp Reference Manual. -@comment Run tex using version of `texinfo.tex' that comes with the elisp -@comment manual. Also, run `makeinfo' rather than `texinfo-format-buffer'. -@comment ================================================================ - -@comment smallbook - -@comment tex -@comment \overfullrule=0pt -@comment end tex - -@comment -@comment Combine indices. -@syncodeindex fn cp -@syncodeindex vr cp -@syncodeindex ky cp -@syncodeindex pg cp -@syncodeindex tp cp -@comment texinfo-format-buffer no longer ignores synindex. -@comment - -@ifinfo -This file documents Edebug - -This is edition 1.6 of the Edebug User Manual -for edebug Version 3.4, - -Copyright (C) 1991,1992,1993,1994 Free Software Foundation, Inc. - -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 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 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 Foundation. -@end ifinfo -@comment - -@comment -@setchapternewpage odd - -@titlepage -@title Edebug User Manual -@subtitle A Source Level Debugger for XEmacs Lisp -@subtitle Edition 1.6, February 1994 - -@author by Daniel LaLiberte, liberte@@cs.uiuc.edu -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1991,1992,1993,1994 Daniel LaLiberte - -@sp 2 -This is edition 1.6 of the @cite{Edebug User Manual} -for edebug Version 3.4, February 1994 - - -@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 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 this author. -@end titlepage -@page - - -@node Top, Edebug, (dir), (dir) -@chapter Edebug User Manual - - Edebug is a source-level debugger for XEmacs Lisp programs. - - -@menu -* Edebug:: Edebug -* Bugs and Todo List:: Bugs and Todo List -* Index:: Index -@end menu - -@c from included file: -@c @node Edebug, Bugs and Todo List, Top, Top -@c @section Edebug - -@include edebug-inc.texi - - -@node Bugs and Todo List, Index, Edebug, Top -@section Bugs and Todo List - -A debugger should be as bug free as possible, and I strive to achieve -perfection. But Edebug is fairly complex and I don't understand all of -it any more, so bugs happen. Please report anything suspicious to save -someone else the trouble of finding the same bug. Email to -liberte@@cs.uiuc.edu. There is also a mailing list for Edebug beta -testers: edebug-request@@cs.uiuc.edu. - -@cindex bugs in Edebug -If you want to run Edebug on Edebug itself, often it is easiest to first -copy a reliable version of @file{edebug.el} into another file, say -@file{fdebug.el}, and replace all strings @samp{edebug} with -@samp{fdebug}, then evaluate the fdebug buffer and run Fdebug on -the buggy Edebug. - -The following is a list of things I might do in the future, but often I -do other things not on the list as I discover the need for them. Send -me your suggestions and priorities. - -@itemize @bullet - -@item -Bug: I've noticed that the point of some buffers is reset to the point -of some other buffer, but I haven't been able to repeat it so perhaps -it is fixed. - -@item -There may be a bug in the trace buffer display. It should display as -much as it can of the bottom of the buffer, but I think it scrolls off -sometimes. - -There is a bug in window updating when there is both a trace buffer -and an evaluation list - the source buffer doesn't get displayed. - -@item -Killing and reinserting an instrumented definition or parts of -it leaves marks in the buffer which may confuse Edebug later. - -@item -Design problem: The position of definitions with complex names (e.g. -defmethod) cannot be remembered properly, but nor can the names of such -definitions be determined from calls of them. - -@item -After some errors, with @code{edebug-on-error} non-@code{nil}, continuing -execution succeeds, returning @code{nil}. - -@item -There are some interesting problems with defining or executing keyboard -macros across the Edebug activation boundary. - -@item -There are no other known bugs, so if you find any, please let me know. -There is nothing worse than a buggy debugger! - -@item -I need to rethink locally binding @code{debug-on-error}, -@code{debug-on-quit}, and keyboard macro state variables. Should we -allow the global values to be changed by the user? - -@item -"(" in the first column of doc strings messes up edebug reading. -But no more than normal. - -@item -There could be a command to return a value from the debugger - -particularly useful for errors. - -@item -Let me know if you find any side effects that could be avoided -or at least documented in the manual. -Also @pxref{The Outside Context}. - -@item -@cindex selective display -Make edebug work with selective display - don't stop in hidden lines. - -@item -Debug just one or selected subexpressions of a definition - the rest is -evalled normally. - -@item -Should @code{overlay-arrow-position} and @code{-string} be buffer local? -It would be better if they could be window-local. - -@item -Use copy of @code{current-local-map} instead of @code{emacs-lisp-mode-map} -(but only copy the first time after lower level command - to save time). - -@item -Better integration with standard debug. - -@item -Use @code{inhibit-quit} while edebugging? - -@item -Crawl mode would @code{sit-for} 0 or 1 in the outside window configuration -between each edebug step. -Maybe it should be a separate option that applies to trace as well. - -@item -Customizable @code{sit-for} time. Less than a second would be nice. - -@item -Generalize step, trace, Trace-fast to one command with argument for -@code{sit-for} time. -Generalize go, continue, Continue-fast to another command with argument - -@item -Counting conditions - stop after n iterations. You can do it manually now -with conditional breakpoints. - -@item -Performance monitoring - summarize trace data. - -@item -Preserve breakpoints across instrumenting. -You can now install calls to @code{edebug} in your code. - -@item -After stepping into code not previously instrumented (with -@code{edebug-step-in}), maybe restore to non-instrumented code after -entered. - -@item -Optionally replace expressions with results in a separate buffer from -the source code. This idea is based on discussions with Carl Witty -regarding his stepper debugger. Also, unparse code into its own buffer -if source code is not available, or if user wishes to use -replace-with-results mode. - -@item -Preserve previous bindings of local variables, and allow user to jump -back to previous frames, particularly binding frames (i.e. @code{let}, -@code{condition-case}, function and macro calls) to view values at that -frame. What about buffer local variables? It would be simpler to have -access to the Lisp stack. - -Variables display, like the evaluation list but automatically display -all local variables and values. - -@item -Investigate minimal instrumentation that doesn't call edebug functions -but instead sets edebug index and result variables. Stepping is done -through standard debugger features such as setting -@code{debug-on-next-call}. Breakpoints are done by modifying code as -well as calling @code{backtrace-debug} for active frames. - -@item -Edebugging of uninstrumented code. Similar to above minimal -instrumentation but find out where we are at each edebug call by looking -in a map from each list form in the code to its position. -Problem is symbols are not unique. - -@item -Investigate hiding debugger internal stack frames. This is both to -simplify the standard debugger (which currently must be byte compiled to -work) and to better support the integration of edebug and the standard -debugger. - -@item -Fix Emacs' lack of stack checking. The current workaround of -incrementing @code{max-lisp-eval-depth} and @code{max-specpdl-size} is -unsafe. - -@item -Although variables can't be tracked everywhere, watchpoints would be -nice for variables that edebug can monitor. That is, when the value of -a specific variable changes, edebug would stop. This can be done now -with the @code{edebug-global-break-condition}, though it is awkward. - -@item -How about a command to add the previous sexp (?) to the eval-list? - -@item -Highlight all instrumented code, breakpoints, and subexpressions about -to be evaluated or just evaluated. This should be done in a way that -works with Epoch, XEmacs, and Emacs 19. - -@end itemize - - -@page -@node Index, , Bugs and Todo List, Top -@section Index - -@printindex cp - -@comment To prevent the Concept Index's last page from being numbered "i". -@page - -@contents -@bye diff --git a/man/lispref/errors.texi b/man/lispref/errors.texi deleted file mode 100644 index d246f1b..0000000 --- a/man/lispref/errors.texi +++ /dev/null @@ -1,194 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/errors.info -@node Standard Errors, Standard Buffer-Local Variables, Building XEmacs and Object Allocation, Top -@appendix Standard Errors - - Here is the complete list of the error symbols in standard Emacs, -grouped by concept. The list includes each symbol's message (on the -@code{error-message} property of the symbol) and a cross reference to a -description of how the error can occur. - - Each error symbol has an @code{error-conditions} property that is a -list of symbols. Normally this list includes the error symbol itself -and the symbol @code{error}. Occasionally it includes additional -symbols, which are intermediate classifications, narrower than -@code{error} but broader than a single error symbol. For example, all -the errors in accessing files have the condition @code{file-error}. - - As a special exception, the error symbol @code{quit} does not have the -condition @code{error}, because quitting is not considered an error. - - @xref{Errors}, for an explanation of how errors are generated and -handled. - -@table @code -@item @var{symbol} -@var{string}; @var{reference}. - -@item error -@code{"error"}@* -@xref{Errors}. - -@item quit -@code{"Quit"}@* -@xref{Quitting}. - -@item args-out-of-range -@code{"Args out of range"}@* -@xref{Sequences Arrays Vectors}. - -@item arith-error -@code{"Arithmetic error"}@* -See @code{/} and @code{%} in @ref{Numbers}. - -@item beginning-of-buffer -@code{"Beginning of buffer"}@* -@xref{Motion}. - -@item buffer-read-only -@code{"Buffer is read-only"}@* -@xref{Read Only Buffers}. - -@item cyclic-function-indirection -@code{"Symbol's chain of function indirections contains a loop"}@* -@xref{Function Indirection}. - -@c XEmacs feature -@item domain-error -@code{"Arithmetic domain error"}@* - -@item end-of-buffer -@code{"End of buffer"}@* -@xref{Motion}. - -@item end-of-file -@code{"End of file during parsing"}@* -This is not a @code{file-error}.@* -@xref{Input Functions}. - -@item file-error -This error and its subcategories do not have error-strings, because the -error message is constructed from the data items alone when the error -condition @code{file-error} is present.@* -@xref{Files}. - -@item file-locked -This is a @code{file-error}.@* -@xref{File Locks}. - -@item file-already-exists -This is a @code{file-error}.@* -@xref{Writing to Files}. - -@item file-supersession -This is a @code{file-error}.@* -@xref{Modification Time}. - -@item invalid-byte-code -@code{"Invalid byte code"}@* -@xref{Byte Compilation}. - -@item invalid-function -@code{"Invalid function"}@* -@xref{Classifying Lists}. - -@item invalid-read-syntax -@code{"Invalid read syntax"}@* -@xref{Input Functions}. - -@item invalid-regexp -@code{"Invalid regexp"}@* -@xref{Regular Expressions}. - -@c XEmacs feature -@item mark-inactive -@code{"The mark is not active now"}@* - -@item no-catch -@code{"No catch for tag"}@* -@xref{Catch and Throw}. - -@c XEmacs feature -@item overflow-error -@code{"Arithmetic overflow error"}@* - -@c XEmacs feature -@item protected-field -@code{"Attempt to modify a protected field"}@* - -@c XEmacs feature -@item range-error -@code{"Arithmetic range error"}@* - -@item search-failed -@code{"Search failed"}@* -@xref{Searching and Matching}. - -@item setting-constant -@code{"Attempt to set a constant symbol"}@* -@xref{Constant Variables, , Variables that Never Change}. - -@c XEmacs feature -@item singularity-error -@code{"Arithmetic singularity error"}@* - -@c XEmacs feature -@item tooltalk-error -@code{"ToolTalk error"}@* -@xref{ToolTalk Support}. - -@c XEmacs feature -@item undefined-keystroke-sequence -@code{"Undefined keystroke sequence"}@* - -@ignore FSF Emacs only -@item undefined-color -@code{"Undefined color"}@* -@xref{Color Names}. -@end ignore - -@item void-function -@code{"Symbol's function definition is void"}@* -@xref{Function Cells}. - -@item void-variable -@code{"Symbol's value as variable is void"}@* -@xref{Accessing Variables}. - -@item wrong-number-of-arguments -@code{"Wrong number of arguments"}@* -@xref{Classifying Lists}. - -@item wrong-type-argument -@code{"Wrong type argument"}@* -@xref{Type Predicates}. -@end table - - These error types, which are all classified as special cases of -@code{arith-error}, can occur on certain systems for invalid use of -mathematical functions. - -@table @code -@item domain-error -@code{"Arithmetic domain error"}@* -@xref{Math Functions}. - -@item overflow-error -@code{"Arithmetic overflow error"}@* -@xref{Math Functions}. - -@item range-error -@code{"Arithmetic range error"}@* -@xref{Math Functions}. - -@item singularity-error -@code{"Arithmetic singularity error"}@* -@xref{Math Functions}. - -@item underflow-error -@code{"Arithmetic underflow error"}@* -@xref{Math Functions}. -@end table diff --git a/man/lispref/eval.texi b/man/lispref/eval.texi deleted file mode 100644 index 3caa838..0000000 --- a/man/lispref/eval.texi +++ /dev/null @@ -1,709 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/eval.info -@node Evaluation, Control Structures, Symbols, Top -@chapter Evaluation -@cindex evaluation -@cindex interpreter -@cindex interpreter -@cindex value of expression - - The @dfn{evaluation} of expressions in XEmacs Lisp is performed by the -@dfn{Lisp interpreter}---a program that receives a Lisp object as input -and computes its @dfn{value as an expression}. How it does this depends -on the data type of the object, according to rules described in this -chapter. The interpreter runs automatically to evaluate portions of -your program, but can also be called explicitly via the Lisp primitive -function @code{eval}. - -@ifinfo -@menu -* Intro Eval:: Evaluation in the scheme of things. -* Eval:: How to invoke the Lisp interpreter explicitly. -* Forms:: How various sorts of objects are evaluated. -* Quoting:: Avoiding evaluation (to put constants in the program). -@end menu - -@node Intro Eval -@section Introduction to Evaluation - - The Lisp interpreter, or evaluator, is the program that computes -the value of an expression that is given to it. When a function -written in Lisp is called, the evaluator computes the value of the -function by evaluating the expressions in the function body. Thus, -running any Lisp program really means running the Lisp interpreter. - - How the evaluator handles an object depends primarily on the data -type of the object. -@end ifinfo - -@cindex forms -@cindex expression - A Lisp object that is intended for evaluation is called an -@dfn{expression} or a @dfn{form}. The fact that expressions are data -objects and not merely text is one of the fundamental differences -between Lisp-like languages and typical programming languages. Any -object can be evaluated, but in practice only numbers, symbols, lists -and strings are evaluated very often. - - It is very common to read a Lisp expression and then evaluate the -expression, but reading and evaluation are separate activities, and -either can be performed alone. Reading per se does not evaluate -anything; it converts the printed representation of a Lisp object to the -object itself. It is up to the caller of @code{read} whether this -object is a form to be evaluated, or serves some entirely different -purpose. @xref{Input Functions}. - - Do not confuse evaluation with command key interpretation. The -editor command loop translates keyboard input into a command (an -interactively callable function) using the active keymaps, and then -uses @code{call-interactively} to invoke the command. The execution of -the command itself involves evaluation if the command is written in -Lisp, but that is not a part of command key interpretation itself. -@xref{Command Loop}. - -@cindex recursive evaluation - Evaluation is a recursive process. That is, evaluation of a form may -call @code{eval} to evaluate parts of the form. For example, evaluation -of a function call first evaluates each argument of the function call, -and then evaluates each form in the function body. Consider evaluation -of the form @code{(car x)}: the subform @code{x} must first be evaluated -recursively, so that its value can be passed as an argument to the -function @code{car}. - - Evaluation of a function call ultimately calls the function specified -in it. @xref{Functions}. The execution of the function may itself work -by evaluating the function definition; or the function may be a Lisp -primitive implemented in C, or it may be a byte-compiled function -(@pxref{Byte Compilation}). - -@cindex environment - The evaluation of forms takes place in a context called the -@dfn{environment}, which consists of the current values and bindings of -all Lisp variables.@footnote{This definition of ``environment'' is -specifically not intended to include all the data that can affect the -result of a program.} Whenever the form refers to a variable without -creating a new binding for it, the value of the binding in the current -environment is used. @xref{Variables}. - -@cindex side effect - Evaluation of a form may create new environments for recursive -evaluation by binding variables (@pxref{Local Variables}). These -environments are temporary and vanish by the time evaluation of the form -is complete. The form may also make changes that persist; these changes -are called @dfn{side effects}. An example of a form that produces side -effects is @code{(setq foo 1)}. - - The details of what evaluation means for each kind of form are -described below (@pxref{Forms}). - -@node Eval -@section Eval -@c ??? Perhaps this should be the last section in the chapter. - - Most often, forms are evaluated automatically, by virtue of their -occurrence in a program being run. On rare occasions, you may need to -write code that evaluates a form that is computed at run time, such as -after reading a form from text being edited or getting one from a -property list. On these occasions, use the @code{eval} function. - - @strong{Please note:} it is generally cleaner and more flexible to call -functions that are stored in data structures, rather than to evaluate -expressions stored in data structures. Using functions provides the -ability to pass information to them as arguments. - - The functions and variables described in this section evaluate forms, -specify limits to the evaluation process, or record recently returned -values. Loading a file also does evaluation (@pxref{Loading}). - -@defun eval form -This is the basic function for performing evaluation. It evaluates -@var{form} in the current environment and returns the result. How the -evaluation proceeds depends on the type of the object (@pxref{Forms}). - -Since @code{eval} is a function, the argument expression that appears -in a call to @code{eval} is evaluated twice: once as preparation before -@code{eval} is called, and again by the @code{eval} function itself. -Here is an example: - -@example -@group -(setq foo 'bar) - @result{} bar -@end group -@group -(setq bar 'baz) - @result{} baz -;; @r{@code{eval} receives argument @code{bar}, which is the value of @code{foo}} -(eval foo) - @result{} baz -(eval 'foo) - @result{} bar -@end group -@end example - -The number of currently active calls to @code{eval} is limited to -@code{max-lisp-eval-depth} (see below). -@end defun - -@deffn Command eval-region start end &optional stream -This function evaluates the forms in the current buffer in the region -defined by the positions @var{start} and @var{end}. It reads forms from -the region and calls @code{eval} on them until the end of the region is -reached, or until an error is signaled and not handled. - -If @var{stream} is supplied, @code{standard-output} is bound to it -during the evaluation. - -You can use the variable @code{load-read-function} to specify a function -for @code{eval-region} to use instead of @code{read} for reading -expressions. @xref{How Programs Do Loading}. - -@code{eval-region} always returns @code{nil}. -@end deffn - -@cindex evaluation of buffer contents -@deffn Command eval-buffer buffer &optional stream -This is like @code{eval-region} except that it operates on the whole -contents of @var{buffer}. -@end deffn - -@defvar max-lisp-eval-depth -This variable defines the maximum depth allowed in calls to @code{eval}, -@code{apply}, and @code{funcall} before an error is signaled (with error -message @code{"Lisp nesting exceeds max-lisp-eval-depth"}). This counts -internal uses of those functions, such as for calling the functions -mentioned in Lisp expressions, and recursive evaluation of function call -arguments and function body forms. - -This limit, with the associated error when it is exceeded, is one way -that Lisp avoids infinite recursion on an ill-defined function. -@cindex Lisp nesting error - -The default value of this variable is 200. If you set it to a value -less than 100, Lisp will reset it to 100 if the given value is reached. - -@code{max-specpdl-size} provides another limit on nesting. -@xref{Local Variables}. -@end defvar - -@defvar values -The value of this variable is a list of the values returned by all the -expressions that were read from buffers (including the minibuffer), -evaluated, and printed. The elements are ordered most recent first. - -@example -@group -(setq x 1) - @result{} 1 -@end group -@group -(list 'A (1+ 2) auto-save-default) - @result{} (A 3 t) -@end group -@group -values - @result{} ((A 3 t) 1 @dots{}) -@end group -@end example - -This variable is useful for referring back to values of forms recently -evaluated. It is generally a bad idea to print the value of -@code{values} itself, since this may be very long. Instead, examine -particular elements, like this: - -@example -@group -;; @r{Refer to the most recent evaluation result.} -(nth 0 values) - @result{} (A 3 t) -@end group -@group -;; @r{That put a new element on,} -;; @r{so all elements move back one.} -(nth 1 values) - @result{} (A 3 t) -@end group -@group -;; @r{This gets the element that was next-to-most-recent} -;; @r{before this example.} -(nth 3 values) - @result{} 1 -@end group -@end example -@end defvar - -@node Forms -@section Kinds of Forms - - A Lisp object that is intended to be evaluated is called a @dfn{form}. -How XEmacs evaluates a form depends on its data type. XEmacs has three -different kinds of form that are evaluated differently: symbols, lists, -and ``all other types''. This section describes all three kinds, -starting with ``all other types'' which are self-evaluating forms. - -@menu -* Self-Evaluating Forms:: Forms that evaluate to themselves. -* Symbol Forms:: Symbols evaluate as variables. -* Classifying Lists:: How to distinguish various sorts of list forms. -* Function Indirection:: When a symbol appears as the car of a list, - we find the real function via the symbol. -* Function Forms:: Forms that call functions. -* Macro Forms:: Forms that call macros. -* Special Forms:: ``Special forms'' are idiosyncratic primitives, - most of them extremely important. -* Autoloading:: Functions set up to load files - containing their real definitions. -@end menu - -@node Self-Evaluating Forms -@subsection Self-Evaluating Forms -@cindex vector evaluation -@cindex literal evaluation -@cindex self-evaluating form - - A @dfn{self-evaluating form} is any form that is not a list or symbol. -Self-evaluating forms evaluate to themselves: the result of evaluation -is the same object that was evaluated. Thus, the number 25 evaluates to -25, and the string @code{"foo"} evaluates to the string @code{"foo"}. -Likewise, evaluation of a vector does not cause evaluation of the -elements of the vector---it returns the same vector with its contents -unchanged. - -@example -@group -'123 ; @r{An object, shown without evaluation.} - @result{} 123 -@end group -@group -123 ; @r{Evaluated as usual---result is the same.} - @result{} 123 -@end group -@group -(eval '123) ; @r{Evaluated ``by hand''---result is the same.} - @result{} 123 -@end group -@group -(eval (eval '123)) ; @r{Evaluating twice changes nothing.} - @result{} 123 -@end group -@end example - - It is common to write numbers, characters, strings, and even vectors -in Lisp code, taking advantage of the fact that they self-evaluate. -However, it is quite unusual to do this for types that lack a read -syntax, because there's no way to write them textually. It is possible -to construct Lisp expressions containing these types by means of a Lisp -program. Here is an example: - -@example -@group -;; @r{Build an expression containing a buffer object.} -(setq buffer (list 'print (current-buffer))) - @result{} (print #) -@end group -@group -;; @r{Evaluate it.} -(eval buffer) - @print{} # - @result{} # -@end group -@end example - -@node Symbol Forms -@subsection Symbol Forms -@cindex symbol evaluation - - When a symbol is evaluated, it is treated as a variable. The result -is the variable's value, if it has one. If it has none (if its value -cell is void), an error is signaled. For more information on the use of -variables, see @ref{Variables}. - - In the following example, we set the value of a symbol with -@code{setq}. Then we evaluate the symbol, and get back the value that -@code{setq} stored. - -@example -@group -(setq a 123) - @result{} 123 -@end group -@group -(eval 'a) - @result{} 123 -@end group -@group -a - @result{} 123 -@end group -@end example - - The symbols @code{nil} and @code{t} are treated specially, so that the -value of @code{nil} is always @code{nil}, and the value of @code{t} is -always @code{t}; you cannot set or bind them to any other values. Thus, -these two symbols act like self-evaluating forms, even though -@code{eval} treats them like any other symbol. - -@node Classifying Lists -@subsection Classification of List Forms -@cindex list form evaluation - - A form that is a nonempty list is either a function call, a macro -call, or a special form, according to its first element. These three -kinds of forms are evaluated in different ways, described below. The -remaining list elements constitute the @dfn{arguments} for the function, -macro, or special form. - - The first step in evaluating a nonempty list is to examine its first -element. This element alone determines what kind of form the list is -and how the rest of the list is to be processed. The first element is -@emph{not} evaluated, as it would be in some Lisp dialects such as -Scheme. - -@node Function Indirection -@subsection Symbol Function Indirection -@cindex symbol function indirection -@cindex indirection -@cindex void function - - If the first element of the list is a symbol then evaluation examines -the symbol's function cell, and uses its contents instead of the -original symbol. If the contents are another symbol, this process, -called @dfn{symbol function indirection}, is repeated until it obtains a -non-symbol. @xref{Function Names}, for more information about using a -symbol as a name for a function stored in the function cell of the -symbol. - - One possible consequence of this process is an infinite loop, in the -event that a symbol's function cell refers to the same symbol. Or a -symbol may have a void function cell, in which case the subroutine -@code{symbol-function} signals a @code{void-function} error. But if -neither of these things happens, we eventually obtain a non-symbol, -which ought to be a function or other suitable object. - -@kindex invalid-function -@cindex invalid function - More precisely, we should now have a Lisp function (a lambda -expression), a byte-code function, a primitive function, a Lisp macro, a -special form, or an autoload object. Each of these types is a case -described in one of the following sections. If the object is not one of -these types, the error @code{invalid-function} is signaled. - - The following example illustrates the symbol indirection process. We -use @code{fset} to set the function cell of a symbol and -@code{symbol-function} to get the function cell contents -(@pxref{Function Cells}). Specifically, we store the symbol @code{car} -into the function cell of @code{first}, and the symbol @code{first} into -the function cell of @code{erste}. - -@smallexample -@group -;; @r{Build this function cell linkage:} -;; ------------- ----- ------- ------- -;; | # | <-- | car | <-- | first | <-- | erste | -;; ------------- ----- ------- ------- -@end group -@end smallexample - -@smallexample -@group -(symbol-function 'car) - @result{} # -@end group -@group -(fset 'first 'car) - @result{} car -@end group -@group -(fset 'erste 'first) - @result{} first -@end group -@group -(erste '(1 2 3)) ; @r{Call the function referenced by @code{erste}.} - @result{} 1 -@end group -@end smallexample - - By contrast, the following example calls a function without any symbol -function indirection, because the first element is an anonymous Lisp -function, not a symbol. - -@smallexample -@group -((lambda (arg) (erste arg)) - '(1 2 3)) - @result{} 1 -@end group -@end smallexample - -@noindent -Executing the function itself evaluates its body; this does involve -symbol function indirection when calling @code{erste}. - - The built-in function @code{indirect-function} provides an easy way to -perform symbol function indirection explicitly. - -@c Emacs 19 feature -@defun indirect-function function -This function returns the meaning of @var{function} as a function. If -@var{function} is a symbol, then it finds @var{function}'s function -definition and starts over with that value. If @var{function} is not a -symbol, then it returns @var{function} itself. - -Here is how you could define @code{indirect-function} in Lisp: - -@smallexample -(defun indirect-function (function) - (if (symbolp function) - (indirect-function (symbol-function function)) - function)) -@end smallexample -@end defun - -@node Function Forms -@subsection Evaluation of Function Forms -@cindex function form evaluation -@cindex function call - - If the first element of a list being evaluated is a Lisp function -object, byte-code object or primitive function object, then that list is -a @dfn{function call}. For example, here is a call to the function -@code{+}: - -@example -(+ 1 x) -@end example - - The first step in evaluating a function call is to evaluate the -remaining elements of the list from left to right. The results are the -actual argument values, one value for each list element. The next step -is to call the function with this list of arguments, effectively using -the function @code{apply} (@pxref{Calling Functions}). If the function -is written in Lisp, the arguments are used to bind the argument -variables of the function (@pxref{Lambda Expressions}); then the forms -in the function body are evaluated in order, and the value of the last -body form becomes the value of the function call. - -@node Macro Forms -@subsection Lisp Macro Evaluation -@cindex macro call evaluation - - If the first element of a list being evaluated is a macro object, then -the list is a @dfn{macro call}. When a macro call is evaluated, the -elements of the rest of the list are @emph{not} initially evaluated. -Instead, these elements themselves are used as the arguments of the -macro. The macro definition computes a replacement form, called the -@dfn{expansion} of the macro, to be evaluated in place of the original -form. The expansion may be any sort of form: a self-evaluating -constant, a symbol, or a list. If the expansion is itself a macro call, -this process of expansion repeats until some other sort of form results. - - Ordinary evaluation of a macro call finishes by evaluating the -expansion. However, the macro expansion is not necessarily evaluated -right away, or at all, because other programs also expand macro calls, -and they may or may not evaluate the expansions. - - Normally, the argument expressions are not evaluated as part of -computing the macro expansion, but instead appear as part of the -expansion, so they are computed when the expansion is computed. - - For example, given a macro defined as follows: - -@example -@group -(defmacro cadr (x) - (list 'car (list 'cdr x))) -@end group -@end example - -@noindent -an expression such as @code{(cadr (assq 'handler list))} is a macro -call, and its expansion is: - -@example -(car (cdr (assq 'handler list))) -@end example - -@noindent -Note that the argument @code{(assq 'handler list)} appears in the -expansion. - -@xref{Macros}, for a complete description of XEmacs Lisp macros. - -@node Special Forms -@subsection Special Forms -@cindex special form evaluation - - A @dfn{special form} is a primitive function specially marked so that -its arguments are not all evaluated. Most special forms define control -structures or perform variable bindings---things which functions cannot -do. - - Each special form has its own rules for which arguments are evaluated -and which are used without evaluation. Whether a particular argument is -evaluated may depend on the results of evaluating other arguments. - - Here is a list, in alphabetical order, of all of the special forms in -XEmacs Lisp with a reference to where each is described. - -@table @code -@item and -@pxref{Combining Conditions} - -@item catch -@pxref{Catch and Throw} - -@item cond -@pxref{Conditionals} - -@item condition-case -@pxref{Handling Errors} - -@item defconst -@pxref{Defining Variables} - -@item defmacro -@pxref{Defining Macros} - -@item defun -@pxref{Defining Functions} - -@item defvar -@pxref{Defining Variables} - -@item function -@pxref{Anonymous Functions} - -@item if -@pxref{Conditionals} - -@item interactive -@pxref{Interactive Call} - -@item let -@itemx let* -@pxref{Local Variables} - -@item or -@pxref{Combining Conditions} - -@item prog1 -@itemx prog2 -@itemx progn -@pxref{Sequencing} - -@item quote -@pxref{Quoting} - -@item save-current-buffer -@pxref{Excursions} - -@item save-excursion -@pxref{Excursions} - -@item save-restriction -@pxref{Narrowing} - -@item save-selected-window -@pxref{Excursions} - -@item save-window-excursion -@pxref{Window Configurations} - -@item setq -@pxref{Setting Variables} - -@item setq-default -@pxref{Creating Buffer-Local} - -@item unwind-protect -@pxref{Nonlocal Exits} - -@item while -@pxref{Iteration} - -@item with-output-to-temp-buffer -@pxref{Temporary Displays} -@end table - -@cindex CL note---special forms compared -@quotation -@b{Common Lisp note:} here are some comparisons of special forms in -XEmacs Lisp and Common Lisp. @code{setq}, @code{if}, and -@code{catch} are special forms in both XEmacs Lisp and Common Lisp. -@code{defun} is a special form in XEmacs Lisp, but a macro in Common -Lisp. @code{save-excursion} is a special form in XEmacs Lisp, but -doesn't exist in Common Lisp. @code{throw} is a special form in -Common Lisp (because it must be able to throw multiple values), but it -is a function in XEmacs Lisp (which doesn't have multiple -values).@refill -@end quotation - -@node Autoloading -@subsection Autoloading - - The @dfn{autoload} feature allows you to call a function or macro -whose function definition has not yet been loaded into XEmacs. It -specifies which file contains the definition. When an autoload object -appears as a symbol's function definition, calling that symbol as a -function automatically loads the specified file; then it calls the real -definition loaded from that file. @xref{Autoload}. - -@node Quoting -@section Quoting -@cindex quoting - - The special form @code{quote} returns its single argument, as written, -without evaluating it. This provides a way to include constant symbols -and lists, which are not self-evaluating objects, in a program. (It is -not necessary to quote self-evaluating objects such as numbers, strings, -and vectors.) - -@defspec quote object -This special form returns @var{object}, without evaluating it. -@end defspec - -@cindex @samp{'} for quoting -@cindex quoting using apostrophe -@cindex apostrophe for quoting -Because @code{quote} is used so often in programs, Lisp provides a -convenient read syntax for it. An apostrophe character (@samp{'}) -followed by a Lisp object (in read syntax) expands to a list whose first -element is @code{quote}, and whose second element is the object. Thus, -the read syntax @code{'x} is an abbreviation for @code{(quote x)}. - -Here are some examples of expressions that use @code{quote}: - -@example -@group -(quote (+ 1 2)) - @result{} (+ 1 2) -@end group -@group -(quote foo) - @result{} foo -@end group -@group -'foo - @result{} foo -@end group -@group -''foo - @result{} (quote foo) -@end group -@group -'(quote foo) - @result{} (quote foo) -@end group -@group -['foo] - @result{} [(quote foo)] -@end group -@end example - - Other quoting constructs include @code{function} (@pxref{Anonymous -Functions}), which causes an anonymous lambda expression written in Lisp -to be compiled, and @samp{`} (@pxref{Backquote}), which is used to quote -only part of a list, while computing and substituting other parts. diff --git a/man/lispref/extents.texi b/man/lispref/extents.texi deleted file mode 100644 index 5a40e19..0000000 --- a/man/lispref/extents.texi +++ /dev/null @@ -1,933 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/extents.info -@node Extents, Specifiers, Abbrevs, top -@chapter Extents -@cindex extent - - An @dfn{extent} is a region of text (a start position and an end -position) that is displayed in a particular face and can have certain -other properties such as being read-only. Extents can overlap each -other. XEmacs efficiently handles buffers with large numbers of -extents in them. - -@defun extentp object -This returns @code{t} if @var{object} is an extent. -@end defun - -@menu -* Intro to Extents:: Extents are regions over a buffer or string. -* Creating and Modifying Extents:: - Basic extent functions. -* Extent Endpoints:: Accessing and setting the bounds of an extent. -* Finding Extents:: Determining which extents are in an object. -* Mapping Over Extents:: More sophisticated functions for extent scanning. -* Extent Properties:: Extents have built-in and user-definable properties. -* Detached Extents:: Extents that are not in a buffer. -* Extent Parents:: Inheriting properties from another extent. -* Duplicable Extents:: Extents can be marked to be copied into strings. -* Extents and Events:: Extents can interact with the keyboard and mouse. -* Atomic Extents:: Treating a block of text as a single entity. -@end menu - -@node Intro to Extents -@section Introduction to Extents -@cindex extent priority -@cindex priority of an extent - - An extent is a region of text within a buffer or string that has -certain properties associated with it. The properties of an extent -primarily affect the way the text contained in the extent is displayed. -Extents can freely overlap each other in a buffer or string. Extents -are invisible to functions that merely examine the text of a buffer or -string. - - @emph{Please note:} An alternative way to add properties to a buffer or -string is to use text properties. @xref{Text Properties}. - - An extent is logically a Lisp object consisting of a start position, -an end position, a buffer or string to which these positions refer, and -a property list. As text is inserted into a buffer, the start and end -positions of the extent are automatically adjusted as necessary to keep -the extent referring to the same text in the buffer. If text is -inserted at the boundary of an extent, the extent's @code{start-open} -and @code{end-open} properties control whether the text is included as -part of the extent. If the text bounded by an extent is deleted, the -extent becomes @dfn{detached}; its start and end positions are no longer -meaningful, but it maintains all its other properties and can later be -reinserted into a buffer. (None of these considerations apply to strings, -because text cannot be inserted into or deleted from a string.) - - Each extent has a face or list of faces associated with it, which -controls the way in which the text bounded by the extent is displayed. -If an extent's face is @code{nil} or its properties are partially -undefined, the corresponding properties from the default face for the -frame is used. If two or more extents overlap, or if a list of more -than one face is specified for a particular extent, the corresponding -faces are merged to determine the text's displayed properties. Every -extent has a @dfn{priority} that determines which face takes precedence -if the faces conflict. (If two extents have the same priority, the one -that comes later in the display order takes precedence. @xref{Extent -Endpoints, display order}.) Higher-numbered priority values correspond -to a higher priority, and priority values can be negative. Every extent -is created with a priority of 0, but this can be changed with -@code{set-extent-priority}. Within a single extent with a list of faces, -faces earlier in the list have a higher priority than faces later in -the list. - - Extents can be set to respond specially to key and mouse events within -the extent. An extent's @code{keymap} property controls the effect of -key and mouse strokes within the extent's text, and the @code{mouse-face} -property controls whether the extent is highlighted when the mouse moves -over it. @xref{Extents and Events}. - - An extent can optionally have a @dfn{begin-glyph} or @dfn{end-glyph} -associated with it. A begin-glyph or end-glyph is a pixmap or string -that will be displayed either at the start or end of an extent or in the -margin of the line that the start or end of the extent lies in, -depending on the extent's layout policy. Begin-glyphs and end-glyphs -are used to implement annotations, and you should use the annotation API -functions in preference to the lower-level extent functions. For more -information, @xref{Annotations}. - - If an extent has its @code{detachable} property set, it will become -@dfn{detached} (i.e. no longer in the buffer) when all its text its -deleted. Otherwise, it will simply shrink down to zero-length and -sit it the same place in the buffer. By default, the @code{detachable} -property is set on newly-created extents. @xref{Detached Extents}. - - If an extent has its @code{duplicable} property set, it will be -remembered when a string is created from text bounded by the extent. -When the string is re-inserted into a buffer, the extent will also -be re-inserted. This mechanism is used in the kill, yank, and undo -commands. @xref{Duplicable Extents}. - -@node Creating and Modifying Extents -@section Creating and Modifying Extents - -@defun make-extent from to &optional object -This function makes an extent for the range [@var{from}, @var{to}) in -@var{object} (a buffer or string). @var{object} defaults to the current -buffer. Insertions at point @var{to} will be outside of the extent; -insertions at @var{from} will be inside the extent, causing the extent -to grow (@pxref{Extent Endpoints}). This is the same way that markers -behave. The extent is initially detached if both @var{from} and -@var{to} are @code{nil}, and in this case @var{object} defaults to -@code{nil}, meaning the extent is in no buffer or string -(@pxref{Detached Extents}). -@end defun - -@defun delete-extent extent -This function removes @var{extent} from its buffer and destroys it. -This does not modify the buffer's text, only its display properties. -The extent cannot be used thereafter. To remove an extent in such -a way that it can be re-inserted later, use @code{detach-extent}. -@xref{Detached Extents}. -@end defun - -@defun extent-object extent -This function returns the buffer or string that @var{extent} is in. If -the return value is @code{nil}, this means that the extent is detached; -however, a detached extent will not necessarily return a value of -@code{nil}. -@end defun - -@defun extent-live-p extent -This function returns @code{nil} if @var{extent} is deleted, and -@code{t} otherwise. -@end defun - -@node Extent Endpoints -@section Extent Endpoints -@cindex extent endpoint -@cindex extent start position -@cindex extent end position -@cindex zero-length extent -@cindex display order -@cindex extent order -@cindex order of extents - - Every extent has a start position and an end position, and logically -affects the characters between those positions. Normally the start and -end positions must both be valid positions in the extent's buffer or -string. However, both endpoints can be @code{nil}, meaning the extent -is detached. @xref{Detached Extents}. - - Whether the extent overlaps its endpoints is governed by its -@code{start-open} and @code{end-open} properties. Insertion of a -character at a closed endpoint will expand the extent to include that -character; insertion at an open endpoint will not. Similarly, functions -such as @code{extent-at} that scan over all extents overlapping a -particular position will include extents with a closed endpoint at that -position, but not extents with an open endpoint. - - Note that the @code{start-closed} and @code{end-closed} properties are -equivalent to @code{start-open} and @code{end-open} with the opposite -sense. - - Both endpoints can be equal, in which case the extent includes no -characters but still exists in the buffer or string. Zero-length -extents are used to represent annotations (@pxref{Annotations}) and can -be used as a more powerful form of a marker. Deletion of all the -characters in an extent may or may not result in a zero-length extent; -this depends on the @code{detachable} property (@pxref{Detached -Extents}). Insertion at the position of a zero-length extent expands -the extent if both endpoints are closed; goes before the extent if it -has the @code{start-open} property; and goes after the extent if it has -the @code{end-open} property. Zero-length extents with both the -@code{start-open} and @code{end-open} properties are treated as if their -starting point were closed. Deletion of a character on a side of a -zero-length extent whose corresponding endpoint is closed causes the -extent to be detached if its @code{detachable} property is set; if the -corresponding endpoint is open, the extent remains in the buffer, moving -as necessary. - - Extents are ordered within a buffer or string by increasing start -position, and then by decreasing end position (this is called the -@dfn{display order}). - -@defun extent-start-position extent -This function returns the start position of @var{extent}. -@end defun - -@defun extent-end-position extent -This function returns the end position of @var{extent}. -@end defun - -@defun extent-length extent -This function returns the length of @var{extent} in characters. If -the extent is detached, this returns @code{0}. If the extent is not -detached, this is equivalent to -@example -(- (extent-end-position @var{extent}) (extent-start-position @var{extent})) -@end example -@end defun - -@defun set-extent-endpoints extent start end &optional buffer-or-string -This function sets the start and end position of @var{extent} to -@var{start} and @var{end}. If both are @code{nil}, this is equivalent -to @code{detach-extent}. - -@var{buffer-or-string} specifies the new buffer or string that the -extent should be in, and defaults to @var{extent}'s buffer or -string. (If @code{nil}, and @var{extent} is in no buffer and no string, -it defaults to the current buffer.) - -See documentation on @code{detach-extent} for a discussion of undo -recording. -@end defun - -@node Finding Extents -@section Finding Extents -@cindex extents, locating - - The following functions provide a simple way of determining the -extents in a buffer or string. A number of more sophisticated -primitives for mapping over the extents in a range of a buffer or string -are also provided (@pxref{Mapping Over Extents}). When reading through -this section, keep in mind the way that extents are ordered -(@pxref{Extent Endpoints}). - -@defun extent-list &optional buffer-or-string from to flags -This function returns a list of the extents in @var{buffer-or-string}. -@var{buffer-or-string} defaults to the current buffer if omitted. -@var{from} and @var{to} can be used to limit the range over which -extents are returned; if omitted, all extents in the buffer or string -are returned. - - More specifically, if a range is specified using @var{from} and -@var{to}, only extents that overlap the range (i.e. begin or end inside -of the range) are included in the list. @var{from} and @var{to} default -to the beginning and end of @var{buffer-or-string}, respectively. - - @var{flags} controls how end cases are treated. For a discussion of -this, and exactly what ``overlap'' means, see @code{map-extents}. -@end defun - - Functions that create extents must be prepared for the possibility -that there are other extents in the same area, created by other -functions. To deal with this, functions typically mark their own -extents by setting a particular property on them. The following -function makes it easier to locate those extents. - -@defun extent-at pos &optional object property before at-flag -This function finds the ``smallest'' extent (i.e., the last one in the -display order) at (i.e., overlapping) @var{pos} in @var{object} (a -buffer or string) having @var{property} set. @var{object} defaults to -the current buffer. @var{property} defaults to @code{nil}, meaning that -any extent will do. Returns @code{nil} if there is no matching extent -at @var{pos}. If the fourth argument @var{before} is not @code{nil}, it -must be an extent; any returned extent will precede that extent. This -feature allows @code{extent-at} to be used by a loop over extents. - -@var{at-flag} controls how end cases are handled (i.e. what ``at'' -really means), and should be one of: - -@table @code -@item nil -@item after -An extent is at @var{pos} if it covers the character after @var{pos}. -This is consistent with the way that text properties work. -@item before -An extent is at @var{pos} if it covers the character before @var{pos}. -@item at -An extent is at @var{pos} if it overlaps or abuts @var{pos}. This -includes all zero-length extents at @var{pos}. -@end table - - Note that in all cases, the start-openness and end-openness of the -extents considered is ignored. If you want to pay attention to those -properties, you should use @code{map-extents}, which gives you more -control. -@end defun - - The following low-level functions are provided for explicitly -traversing the extents in a buffer according to the display order. -These functions are mostly intended for debugging -- in normal -operation, you should probably use @code{mapcar-extents} or -@code{map-extents}, or loop using the @var{before} argument to -@code{extent-at}, rather than creating a loop using @code{next-extent}. - -@defun next-extent extent -Given an extent @var{extent}, this function returns the next extent in -the buffer or string's display order. If @var{extent} is a buffer or -string, this returns the first extent in the buffer or string. -@end defun - -@defun previous-extent extent -Given an extent @var{extent}, this function returns the previous extent -in the buffer or string's display order. If @var{extent} is a buffer or -string, this returns the last extent in the buffer or string. -@end defun - -@node Mapping Over Extents -@section Mapping Over Extents -@cindex extents, mapping - - The most basic and general function for mapping over extents is called -@code{map-extents}. You should read through the definition of this -function to familiarize yourself with the concepts and optional -arguments involved. However, in practice you may find it more -convenient to use the function @code{mapcar-extents} or to create a loop -using the @code{before} argument to @code{extent-at} (@pxref{Finding -Extents}). - -@defun map-extents function &optional object from to maparg flags property value - This function maps @var{function} over the extents which overlap a -region in @var{object}. @var{object} is normally a buffer or string but -could be an extent (see below). The region is normally bounded by -[@var{from}, @var{to}) (i.e. the beginning of the region is closed and -the end of the region is open), but this can be changed with the -@var{flags} argument (see below for a complete discussion). - - @var{function} is called with the arguments (extent, @var{maparg}). -The arguments @var{object}, @var{from}, @var{to}, @var{maparg}, and -@var{flags} are all optional and default to the current buffer, the -beginning of @var{object}, the end of @var{object}, @var{nil}, and -@var{nil}, respectively. @code{map-extents} returns the first -non-@code{nil} result produced by @var{function}, and no more calls to -@var{function} are made after it returns non-@code{nil}. - - If @var{object} is an extent, @var{from} and @var{to} default to the -extent's endpoints, and the mapping omits that extent and its -predecessors. This feature supports restarting a loop based on -@code{map-extents}. Note: @var{object} must be attached to a buffer or -string, and the mapping is done over that buffer or string. - - An extent overlaps the region if there is any point in the extent that -is also in the region. (For the purpose of overlap, zero-length extents -and regions are treated as closed on both ends regardless of their -endpoints' specified open/closedness.) Note that the endpoints of an -extent or region are considered to be in that extent or region if and -only if the corresponding end is closed. For example, the extent [5,7] -overlaps the region [2,5] because 5 is in both the extent and the -region. However, (5,7] does not overlap [2,5] because 5 is not in the -extent, and neither [5,7] nor (5,7] overlaps the region [2,5) because 5 -is not in the region. - - The optional @var{flags} can be a symbol or a list of one or more -symbols, modifying the behavior of @code{map-extents}. Allowed symbols -are: - -@table @code -@item end-closed -The region's end is closed. - -@item start-open -The region's start is open. - -@item all-extents-closed -Treat all extents as closed on both ends for the purpose of determining -whether they overlap the region, irrespective of their actual open- or -closedness. -@item all-extents-open -Treat all extents as open on both ends. -@item all-extents-closed-open -Treat all extents as start-closed, end-open. -@item all-extents-open-closed -Treat all extents as start-open, end-closed. - -@item start-in-region -In addition to the above conditions for extent overlap, the extent's -start position must lie within the specified region. Note that, for -this condition, open start positions are treated as if 0.5 was added to -the endpoint's value, and open end positions are treated as if 0.5 was -subtracted from the endpoint's value. -@item end-in-region -The extent's end position must lie within the region. -@item start-and-end-in-region -Both the extent's start and end positions must lie within the region. -@item start-or-end-in-region -Either the extent's start or end position must lie within the region. - -@item negate-in-region -The condition specified by a @code{*-in-region} flag must @emph{not} -hold for the extent to be considered. -@end table - - At most one of @code{all-extents-closed}, @code{all-extents-open}, -@code{all-extents-closed-open}, and @code{all-extents-open-closed} may -be specified. - - At most one of @code{start-in-region}, @code{end-in-region}, -@code{start-and-end-in-region}, and @code{start-or-end-in-region} may be -specified. - - If optional arg @var{property} is non-@code{nil}, only extents with -that property set on them will be visited. If optional arg @var{value} -is non-@code{nil}, only extents whose value for that property is -@code{eq} to @var{value} will be visited. -@end defun - - If you want to map over extents and accumulate a list of results, -the following function may be more convenient than @code{map-extents}. - -@defun mapcar-extents function &optional predicate buffer-or-string from to flags property value -This function applies @var{function} to all extents which overlap a -region in @var{buffer-or-string}. The region is delimited by -@var{from} and @var{to}. @var{function} is called with one argument, -the extent. A list of the values returned by @var{function} is -returned. An optional @var{predicate} may be used to further limit the -extents over which @var{function} is mapped. The optional arguments -@var{flags}, @var{property}, and @var{value} may also be used to control -the extents passed to @var{predicate} or @var{function}, and have the -same meaning as in @code{map-extents}. -@end defun - -@defun map-extent-children function &optional object from to maparg flags property value -This function is similar to @code{map-extents}, but differs in that: - -@itemize @bullet -@item -It only visits extents which start in the given region. -@item -After visiting an extent @var{e}, it skips all other extents which start -inside @var{e} but end before @var{e}'s end. -@end itemize - -Thus, this function may be used to walk a tree of extents in a buffer: -@example -(defun walk-extents (buffer &optional ignore) - (map-extent-children 'walk-extents buffer)) -@end example -@end defun - -@defun extent-in-region-p extent &optional from to flags -This function returns @var{t} if @code{map-extents} would visit -@var{extent} if called with the given arguments. -@end defun - -@node Extent Properties -@section Properties of Extents -@cindex extent property -@cindex property of an extent - - Each extent has a property list associating property names with -values. Some property names have predefined meanings, and can usually -only assume particular values. Assigning other values to such a -property either cause the value to be converted into a legal value -(e.g., assigning anything but @code{nil} to a Boolean property will -cause the value of @code{t} to be assigned to the property) or will -cause an error. Property names without predefined meanings can be -assigned any value. An undefined property is equivalent to a property -with a value of @code{nil}, or with a particular default value in the -case of properties with predefined meanings. Note that, when an extent -is created, the @code{end-open} and @code{detachable} properties are set -on it. - - If an extent has a parent, all of its properties actually derive -from that parent (or from the root ancestor if the parent in turn -has a parent), and setting a property of the extent actually sets -that property on the parent. @xref{Extent Parents}. - -@defun extent-property extent property -This function returns the value of @var{property} in @var{extent}. If -@var{property} is undefined, @code{nil} is returned. -@end defun - -@defun extent-properties extent -This function returns a list of all of @var{extent}'s properties that do -not have the value of @code{nil} (or the default value, for properties -with predefined meanings). -@end defun - -@defun set-extent-property extent property value -This function sets @var{property} to @var{value} in @var{extent}. (If -@var{property} has a predefined meaning, only certain values are -allowed, and some values may be converted to others before being -stored.) -@end defun - -@defun set-extent-properties extent plist -Change some properties of @var{extent}. @var{plist} is a property -list. This is useful to change many extent properties at once. -@end defun - -The following table lists the properties with predefined meanings, along -with their allowable values. - -@table @code -@item detached -(Boolean) Whether the extent is detached. Setting this is the same -as calling @code{detach-extent}. @xref{Detached Extents}. - -@item destroyed -(Boolean) Whether the extent has been deleted. Setting this is the same -as calling @code{delete-extent}. - -@item priority -(integer) The extent's redisplay priority. Defaults to 0. @xref{Intro -to Extents, priority}. This property can also be set with -@code{set-extent-priority} and accessed with @code{extent-priority}. - -@item start-open -(Boolean) Whether the start position of the extent is open, meaning that -characters inserted at that position go outside of the extent. -@xref{Extent Endpoints}. - -@item start-closed -(Boolean) Same as @code{start-open} but with the opposite sense. Setting -this property clears @code{start-open} and vice-versa. - -@item end-open -(Boolean) Whether the end position of the extent is open, meaning that -characters inserted at that position go outside of the extent. This is -@code{t} by default. -@xref{Extent Endpoints}. - -@item end-closed -(Boolean) Same as @code{end-open} but with the opposite sense. Setting -this property clears @code{end-open} and vice-versa. - -@item read-only -(Boolean) Whether text within this extent will be unmodifiable. - -@item face -(face, face name, list of faces or face names, or @code{nil}) The face -in which to display the extent's text. This property can also be set -with @code{set-extent-face} and accessed with @code{extent-face}. -Note that if a list of faces is specified, the faces are merged together, -with faces earlier in the list having priority over faces later in the -list. - -@item mouse-face -(face, face name, list of faces or face names, or @code{nil}) The face -used to display the extent when the mouse moves over it. This property -can also be set with @code{set-extent-mouse-face} and accessed with -@code{extent-mouse-face}. Note that if a list of faces is specified, -the faces are merged together, with faces earlier in the list having -priority over faces later in the list. @xref{Extents and Events}. - -@item pointer -(pointer glyph) The glyph used as the pointer when the mouse moves over -the extent. This takes precedence over the @code{text-pointer-glyph} -and @code{nontext-pointer-glyph} variables. If for any reason this -glyph is an invalid pointer, the standard glyphs will be used as -fallbacks. @xref{Mouse Pointer} - -@item detachable -(Boolean) Whether this extent becomes detached when all of the text it -covers is deleted. This is @code{t} by default. @xref{Detached -Extents}. - -@item duplicable -(Boolean) Whether this extent should be copied into strings, so that -kill, yank, and undo commands will restore or copy it. @xref{Duplicable -Extents}. - -@item unique -(Boolean) Meaningful only in conjunction with @code{duplicable}. -When this is set, there may be only one instance of -this extent attached at a time. @xref{Duplicable Extents}. - -@item invisible -(Boolean) If @code{t}, text under this extent will not be displayed -- -it will look as if the text is not there at all. - -@item keymap -(keymap or @code{nil}) This keymap is consulted for mouse clicks on this -extent or keypresses made while @code{point} is within the extent. -@xref{Extents and Events}. - -@item copy-function -This is a hook that is run when a duplicable extent is about to be -copied from a buffer to a string (or the kill ring). @xref{Duplicable -Extents}. - -@item paste-function -This is a hook that is run when a duplicable extent is about to be -copied from a string (or the kill ring) into a buffer. @xref{Duplicable -Extents}. - -@item begin-glyph -(glyph or @code{nil}) This extent's begin glyph. -@xref{Annotations}. - -@item end-glyph -(glyph or @code{nil}) This extent's end glyph. -@xref{Annotations}. - -@item begin-glyph-layout -(@code{text}, @code{whitespace}, @code{inside-margin}, or -@code{outside-margin}) The layout policy for this extent's begin glyph. -Defaults to @code{text}. @xref{Annotations}. - -@item end-glyph-layout -(@code{text}, @code{whitespace}, @code{inside-margin}, or -@code{outside-margin}) The layout policy for this extent's end glyph. -Defaults to @code{text}. @xref{Annotations}. - -@item initial-redisplay-function -(any funcallable object) The function to be called the first time (a -part of) the extent is redisplayed. It will be called with the extent -as its argument. - -This is used by @code{lazy-shot} to implement lazy font-locking. The -functionality is still experimental, and may change without further -notice. -@end table - -The following convenience functions are provided for accessing -particular properties of an extent. - -@defun extent-face extent -This function returns the @code{face} property of @var{extent}. This -might also return a list of face names. Do not modify this list -directly! Instead, use @code{set-extent-face}. - -Note that you can use @code{eq} to compare lists of faces as returned -by @code{extent-face}. In other words, if you set the face of two -different extents to two lists that are @code{equal} but not @code{eq}, -then the return value of @code{extent-face} on the two extents will -return the identical list. -@end defun - -@defun extent-mouse-face extent -This function returns the @code{mouse-face} property of @var{extent}. -This might also return a list of face names. Do not modify this list -directly! Instead, use @code{set-extent-mouse-face}. - -Note that you can use @code{eq} to compare lists of faces as returned -by @code{extent-mouse-face}, just like for @code{extent-face}. -@end defun - -@defun extent-priority extent -This function returns the @code{priority} property of @var{extent}. -@end defun - -@defun extent-keymap extent -This function returns the @code{keymap} property of @var{extent}. -@end defun - -@defun extent-begin-glyph-layout extent -This function returns the @code{begin-glyph-layout} property of -@var{extent}, i.e. the layout policy associated with the @var{extent}'s -begin glyph. -@end defun - -@defun extent-end-glyph-layout extent -This function returns the @code{end-glyph-layout} property of -@var{extent}, i.e. the layout policy associated with the @var{extent}'s -end glyph. -@end defun - -@defun extent-begin-glyph extent -This function returns the @code{begin-glyph} property of @var{extent}, -i.e. the glyph object displayed at the beginning of @var{extent}. If -there is none, @code{nil} is returned. -@end defun - -@defun extent-end-glyph extent -This function returns the @code{end-glyph} property of @var{extent}, -i.e. the glyph object displayed at the end of @var{extent}. If -there is none, @code{nil} is returned. -@end defun - -The following convenience functions are provided for setting particular -properties of an extent. - -@defun set-extent-priority extent pri -This function sets the @code{priority} property of @var{extent} to -@var{pri}. -@end defun - -@defun set-extent-face extent face -This function sets the @code{face} property of @var{extent} to -@var{face}. -@end defun - -@defun set-extent-mouse-face extent face -This function sets the @code{mouse-face} property of @var{extent} to -@var{face}. -@end defun - -@defun set-extent-keymap extent keymap -This function sets the @code{keymap} property of @var{extent} to -@var{keymap}. @var{keymap} must be either a keymap object, or -@code{nil}. -@end defun - -@defun set-extent-begin-glyph-layout extent layout -This function sets the @code{begin-glyph-layout} property of -@var{extent} to @var{layout}. -@end defun - -@defun set-extent-end-glyph-layout extent layout -This function sets the @code{end-glyph-layout} property of -@var{extent} to @var{layout}. -@end defun - -@defun set-extent-begin-glyph extent begin-glyph &optional layout -This function sets the @code{begin-glyph} and @code{glyph-layout} -properties of @var{extent} to @var{begin-glyph} and @var{layout}, -respectively. (@var{layout} defaults to @code{text} if not specified.) -@end defun - -@defun set-extent-end-glyph extent end-glyph &optional layout -This function sets the @code{end-glyph} and @code{glyph-layout} -properties of @var{extent} to @var{end-glyph} and @var{layout}, -respectively. (@var{layout} defaults to @code{text} if not specified.) -@end defun - -@defun set-extent-initial-redisplay-function extent function -This function sets the @code{initial-redisplay-function} property of the -extent to @var{function}. -@end defun - -@node Detached Extents -@section Detached Extents -@cindex detached extent - -A detached extent is an extent that is not attached to a buffer or -string but can be re-inserted. Detached extents have a start position -and end position of @code{nil}. Extents can be explicitly detached -using @code{detach-extent}. An extent is also detached when all of its -characters are all killed by a deletion, if its @code{detachable} -property is set; if this property is not set, the extent becomes a -zero-length extent. (Zero-length extents with the @code{detachable} -property set behave specially. @xref{Extent Endpoints, zero-length -extents}.) - -@defun detach-extent extent -This function detaches @var{extent} from its buffer or string. If -@var{extent} has the @code{duplicable} property, its detachment is -tracked by the undo mechanism. @xref{Duplicable Extents}. -@end defun - -@defun extent-detached-p extent -This function returns @code{nil} if @var{extent} is detached, and -@code{t} otherwise. -@end defun - -@defun copy-extent extent &optional object -This function makes a copy of @var{extent}. It is initially detached. -Optional argument @var{object} defaults to @var{extent}'s object -(normally a buffer or string, but could be @code{nil}). -@end defun - -@defun insert-extent extent &optional start end no-hooks object -This function inserts @var{extent} from @var{start} to @var{end} in -@var{object} (a buffer or string). If @var{extent} is detached from a -different buffer or string, or in most cases when @var{extent} is -already attached, the extent will first be copied as if with -@code{copy-extent}. This function operates the same as if @code{insert} -were called on a string whose extent data calls for @var{extent} to be -inserted, except that if @var{no-hooks} is non-@code{nil}, -@var{extent}'s @code{paste-function} will not be invoked. -@xref{Duplicable Extents}. -@end defun - -@node Extent Parents -@section Extent Parents -@cindex extent parent -@cindex extent children -@cindex parent, of extent -@cindex children, of extent - - An extent can have a parent extent set for it. If this is the case, -the extent derives all its properties from that extent and has no -properties of its own. The only ``properties'' that the extent keeps -are the buffer or string it refers to and the start and end points. -(More correctly, the extent's own properties are shadowed. If you -later change the extent to have no parent, its own properties will -become visible again.) - - It is possible for an extent's parent to itself have a parent, -and so on. Through this, a whole tree of extents can be created, -all deriving their properties from one root extent. Note, however, -that you cannot create an inheritance loop -- this is explicitly -disallowed. - - Parent extents are used to implement the extents over the modeline. - -@defun set-extent-parent extent parent -This function sets the parent of @var{extent} to @var{parent}. -If @var{parent} is @code{nil}, the extent is set to have no parent. -@end defun - -@defun extent-parent extent -This function return the parents (if any) of @var{extent}, or -@code{nil}. -@end defun - -@defun extent-children extent -This function returns a list of the children (if any) of @var{extent}. -The children of an extent are all those extents whose parent is that -extent. This function does not recursively trace children of children. -@end defun - -@defun extent-descendants extent -This function returns a list of all descendants of @var{extent}, -including @var{extent}. This recursively applies @code{extent-children} -to any children of @var{extent}, until no more children can be found. -@end defun - -@node Duplicable Extents -@section Duplicable Extents -@cindex duplicable extent -@cindex unique extents -@cindex extent replica -@cindex extent, duplicable -@cindex extent, unique - - If an extent has the @code{duplicable} property, it will be copied into -strings, so that kill, yank, and undo commands will restore or copy it. - -Specifically: - -@itemize @bullet -@item -When a string is created using @code{buffer-substring} or -@code{buffer-string}, any duplicable extents in the region corresponding -to the string will be copied into the string (@pxref{Buffer -Contents}). When the string in inserted into a buffer using -@code{insert}, @code{insert-before-markers}, @code{insert-buffer} or -@code{insert-buffer-substring}, the extents in the string will be copied -back into the buffer (@pxref{Insertion}). The extents in a string can, -of course, be retrieved explicitly using the standard extent primitives -over the string. - -@item -Similarly, when text is copied or cut into the kill ring, any duplicable -extents will be remembered and reinserted later when the text is pasted -back into a buffer. - -@item -When @code{concat} is called on strings, the extents in the strings are -copied into the resulting string. - -@item -When @code{substring} is called on a string, the relevant extents -are copied into the resulting string. - -@item -When a duplicable extent is detached by @code{detach-extent} or string -deletion, or inserted by @code{insert-extent} or string insertion, the -action is recorded by the undo mechanism so that it can be undone later. -Note that if an extent gets detached and then a later undo causes the -extent to get reinserted, the new extent will not be `eq' to the original -extent. - -@item -Extent motion, face changes, and attachment via @code{make-extent} are -not recorded by the undo mechanism. This means that extent changes -which are to be undo-able must be performed by character editing, or by -insertion and detachment of duplicable extents. - -@item -A duplicable extent's @code{copy-function} property, if non-@code{nil}, -should be a function, and will be run when a duplicable extent is about -to be copied from a buffer to a string (or the kill ring). It is called -with three arguments: the extent and the buffer positions within it -which are being copied. If this function returns @code{nil}, then the -extent will not be copied; otherwise it will. - -@item -A duplicable extent's @code{paste-function} property, if non-@code{nil}, -should be a function, and will be run when a duplicable extent is about -to be copied from a string (or the kill ring) into a buffer. It is -called with three arguments: the original extent and the buffer -positions which the copied extent will occupy. (This hook is run after -the corresponding text has already been inserted into the buffer.) Note -that the extent argument may be detached when this function is run. If -this function returns @code{nil}, no extent will be inserted. -Otherwise, there will be an extent covering the range in question. - - Note: if the extent to be copied is already attached to the buffer and -overlaps the new range, the extent will simply be extended and the -@code{paste-function} will not be called. -@end itemize - -@node Extents and Events -@section Interaction of Extents with Keyboard and Mouse Events - - If an extent has the @code{mouse-face} property set, it will be -highlighted when the mouse passes over it. Highlighting is accomplished -by merging the extent's face with the face or faces specified by the -@code{mouse-face} property. The effect is as if a pseudo-extent with -the @code{mouse-face} face were inserted after the extent in the display -order (@pxref{Extent Endpoints}, display order). - -@defvar mouse-highlight-priority -This variable holds the priority to use when merging in the highlighting -pseudo-extent. The default is 1000. This is purposely set very high -so that the highlighting pseudo-extent shows up even if there are other -extents with various priorities at the same location. -@end defvar - - You can also explicitly cause an extent to be highlighted. Only one -extent at a time can be highlighted in this fashion, and any other -highlighted extent will be de-highlighted. - -@defun highlight-extent extent &optional highlight-p -This function highlights (if @var{highlight-p} is non-@code{nil}) or -de-highlights (if @var{highlight-p} is @code{nil}) @var{extent}, if -@var{extent} has the @code{mouse-face} property. (Nothing happens if -@var{extent} does not have the @code{mouse-face} property.) -@end defun - -@defun force-highlight-extent extent &optional highlight-p -This function is similar to @code{highlight-extent} but highlights -or de-highlights the extent regardless of whether it has the -@code{mouse-face} property. -@end defun - - If an extent has a @code{keymap} property, this keymap will be -consulted for mouse clicks on the extent and keypresses made while -@code{point} is within the extent. The behavior of mouse clicks and -keystrokes not defined in the keymap is as normal for the buffer. - -@node Atomic Extents -@section Atomic Extents -@cindex atomic extent - - If the Lisp file @file{atomic-extents} is loaded, then the atomic -extent facility is available. An @dfn{atomic extent} is an extent for -which @code{point} cannot be positioned anywhere within it. This -ensures that when selecting text, either all or none of the extent is -selected. - - To make an extent atomic, set its @code{atomic} property. diff --git a/man/lispref/faces.texi b/man/lispref/faces.texi deleted file mode 100644 index eddb7d0..0000000 --- a/man/lispref/faces.texi +++ /dev/null @@ -1,686 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/faces.info -@node Faces and Window-System Objects, Glyphs, Specifiers, top -@chapter Faces and Window-System Objects -@cindex faces -@cindex window-system objects - -@menu -* Faces:: Controlling the way text looks. -* Fonts:: Controlling the typeface of text. -* Colors:: Controlling the color of text and pixmaps. -@end menu - -@node Faces -@section Faces - -A @dfn{face} is a named collection of graphical properties: font, -foreground color, background color, background pixmap, optional -underlining, and (on TTY devices) whether the text is to be highlighted, -dimmed, blinking, or displayed in reverse video. Faces control the -display of text on the screen. Every face has a name, which is a symbol -such as @code{default} or @code{modeline}. - -Each built-in property of a face is controlled using a specifier, -which allows it to have separate values in particular buffers, frames, -windows, and devices and to further vary according to device type -(X or TTY) and device class (color, mono, or grayscale). -@xref{Specifiers} for more information. - -The face named @code{default} is used for ordinary text. The face named -@code{modeline} is used for displaying the modeline. The face named -@code{highlight} is used for highlighted extents (@pxref{Extents}). The -faces named @code{left-margin} and @code{right-margin} are used for the -left and right margin areas, respectively (@pxref{Annotations}). The -face named @code{zmacs-region} is used for the highlighted region -between point and mark. - - -@menu -* Merging Faces:: How XEmacs decides which face to use - for a character. -* Basic Face Functions:: How to define and examine faces. -* Face Properties:: How to access and modify a face's properties. -* Face Convenience Functions:: Convenience functions for accessing - particular properties of a face. -* Other Face Display Functions:: Other functions pertaining to how a - a face appears. -@end menu - -@node Merging Faces -@subsection Merging Faces for Display - - Here are all the ways to specify which face to use for display of text: - -@itemize @bullet -@item -With defaults. Each frame has a @dfn{default face}, which is used for -all text that doesn't somehow specify another face. The face named -@code{default} applies to the text area, while the faces -@code{left-margin} and @code{right-margin} apply to the left and right -margin areas. - -@item -With text properties. A character may have a @code{face} property; if so, -it's displayed with that face. (Text properties are actually implemented -in terms of extents.) @xref{Text Properties}. - -@item -With extents. An extent may have a @code{face} property, which applies -to all the text covered by the extent; in addition, if the -@code{highlight} property is set, the @code{highlight} property applies -when the mouse moves over the extent or if the extent is explicitly -highlighted. @xref{Extents}. - -@item -With annotations. Annotations that are inserted into a buffer can specify -their own face. (Annotations are actually implemented in terms of extents.) -@xref{Annotations}. -@end itemize - - If these various sources together specify more than one face for a -particular character, XEmacs merges the properties of the various faces -specified. Extents, text properties, and annotations all use the same -underlying representation (as extents). When multiple extents cover one -character, an extent with higher priority overrides those with lower -priority. @xref{Extents}. If no extent covers a particular character, -the @code{default} face is used. - -@cindex background pixmap - If a background pixmap is specified, it determines what will be -displayed in the background of text characters. If the background -pixmap is actually a pixmap, with its colors specified, those colors are -used; if it is a bitmap, the face's foreground and background colors are -used to color it. - -@node Basic Face Functions -@subsection Basic Functions for Working with Faces - - The properties a face can specify include the font, the foreground -color, the background color, the background pixmap, the underlining, -the display table, and (for TTY devices) whether the text is to be -highlighted, dimmed, blinking, or displayed in reverse video. -The face can also leave these unspecified, causing them to assume the -value of the corresponding property of the @code{default} face. - - Here are the basic primitives for working with faces. - -@defun make-face name &optional doc-string temporary -This function defines and returns a new face named @var{name}, initially -with all properties unspecified. It does nothing if there is already a -face named @var{name}. Optional argument @var{doc-string} specifies -an explanatory string used for descriptive purposes. If optional -argument @var{temporary} is non-@code{nil}, the face will automatically -disappear when there are no more references to it anywhere in text or -Lisp code (otherwise, the face will continue to exist indefinitely -even if it is not used). -@end defun - -@defun face-list &optional temporary -This function returns a list of the names of all defined faces. If -@var{temporary} is @code{nil}, only the permanent faces are included. -If it is @code{t}, only the temporary faces are included. If it is any -other non-@code{nil} value both permanent and temporary are included. -@end defun - -@defun facep object -This function returns whether the given object is a face. -@end defun - -@defun copy-face old-face new-name &optional locale how-to-add -This function defines a new face named @var{new-name} which is a copy of -the existing face named @var{old-face}. If there is already a face -named @var{new-name}, then it alters the face to have the same -properties as @var{old-face}. @var{locale} and @var{how-to-add} -let you copy just parts of the old face rather than the whole face, -and are as in @code{copy-specifier} (@pxref{Specifiers}). -@end defun - -@node Face Properties -@subsection Face Properties - - You can examine and modify the properties of an existing face with the -following functions. - -The following symbols have predefined meanings: - -@table @code -@item foreground -The foreground color of the face. - -@item background -The background color of the face. - -@item font -The font used to display text covered by this face. - -@item display-table -The display table of the face. - -@item background-pixmap -The pixmap displayed in the background of the face. Only used by faces -on X devices. - -@item underline -Underline all text covered by this face. - -@item highlight -Highlight all text covered by this face. Only used by faces on TTY -devices. - -@item dim -Dim all text covered by this face. Only used by faces on TTY devices. - -@item blinking -Blink all text covered by this face. Only used by faces on TTY devices. - -@item reverse -Reverse the foreground and background colors. Only used by faces on TTY -devices. - -@item doc-string -Description of what the face's normal use is. NOTE: This is not a -specifier, unlike all the other built-in properties, and cannot contain -locale-specific values. -@end table - -@defun set-face-property face property value &optional locale tag how-to-add -This function changes a property of a @var{face}. - -For built-in properties, the actual value of the property is a specifier -and you cannot change this; but you can change the specifications within -the specifier, and that is what this function will do. For user-defined -properties, you can use this function to either change the actual value -of the property or, if this value is a specifier, change the -specifications within it. - -If @var{property} is a built-in property, the specifications to be added -to this property can be supplied in many different ways: - -@itemize @bullet -If @var{value} is a simple instantiator (e.g. a string naming a font or -color) or a list of instantiators, then the instantiator(s) will be -added as a specification of the property for the given @var{locale} -(which defaults to @code{global} if omitted). - -If @var{value} is a list of specifications (each of which is a cons of a -locale and a list of instantiators), then @var{locale} must be -@code{nil} (it does not make sense to explicitly specify a locale in -this case), and specifications will be added as given. - -If @var{value} is a specifier (as would be returned by -@code{face-property} if no @var{locale} argument is given), then some or -all of the specifications in the specifier will be added to the -property. In this case, the function is really equivalent to -@code{copy-specifier} and @var{locale} has the same semantics (if it is -a particular locale, the specification for the locale will be copied; if -a locale type, specifications for all locales of that type will be -copied; if @code{nil} or @code{all}, then all specifications will be -copied). -@end itemize - -@var{how-to-add} should be either @code{nil} or one of the symbols -@code{prepend}, @code{append}, @code{remove-tag-set-prepend}, -@code{remove-tag-set-append}, @code{remove-locale}, -@code{remove-locale-type}, or @code{remove-all}. See -@code{copy-specifier} and @code{add-spec-to-specifier} for a description -of what each of these means. Most of the time, you do not need to worry -about this argument; the default behavior usually is fine. - -In general, it is OK to pass an instance object (e.g. as returned by -@code{face-property-instance}) as an instantiator in place of an actual -instantiator. In such a case, the instantiator used to create that -instance object will be used (for example, if you set a font-instance -object as the value of the @code{font} property, then the font name used -to create that object will be used instead). If some cases, however, -doing this conversion does not make sense, and this will be noted in the -documentation for particular types of instance objects. - -If @var{property} is not a built-in property, then this function will -simply set its value if @var{locale} is @code{nil}. However, if -@var{locale} is given, then this function will attempt to add -@var{value} as the instantiator for the given @var{locale}, using -@code{add-spec-to-specifier}. If the value of the property is not a -specifier, it will automatically be converted into a @code{generic} -specifier. -@end defun - -@defun face-property face property &optional locale -This function returns @var{face}'s value of the given @var{property}. - -If @var{locale} is omitted, the @var{face}'s actual value for -@var{property} will be returned. For built-in properties, this will be -a specifier object of a type appropriate to the property (e.g. a font or -color specifier). For other properties, this could be anything. - -If @var{locale} is supplied, then instead of returning the actual value, -the specification(s) for the given locale or locale type will be -returned. This will only work if the actual value of @var{property} is -a specifier (this will always be the case for built-in properties, but -not or not may apply to user-defined properties). If the actual value -of @var{property} is not a specifier, this value will simply be returned -regardless of @var{locale}. - -The return value will be a list of instantiators (e.g. strings -specifying a font or color name), or a list of specifications, each of -which is a cons of a locale and a list of instantiators. Specifically, -if @var{locale} is a particular locale (a buffer, window, frame, device, -or @code{global}), a list of instantiators for that locale will be -returned. Otherwise, if @var{locale} is a locale type (one of the -symbols @code{buffer}, @code{window}, @code{frame}, or @code{device}), -the specifications for all locales of that type will be returned. -Finally, if @var{locale} is @code{all}, the specifications for all -locales of all types will be returned. - -The specifications in a specifier determine what the value of -@var{property} will be in a particular @dfn{domain} or set of -circumstances, which is typically a particular Emacs window along with -the buffer it contains and the frame and device it lies within. The -value is derived from the instantiator associated with the most specific -locale (in the order buffer, window, frame, device, and @code{global}) -that matches the domain in question. In other words, given a domain -(i.e. an Emacs window, usually), the specifier for @var{property} will -first be searched for a specification whose locale is the buffer -contained within that window; then for a specification whose locale is -the window itself; then for a specification whose locale is the frame -that the window is contained within; etc. The first instantiator that -is valid for the domain (usually this means that the instantiator is -recognized by the device [i.e. the X server or TTY device] that the -domain is on). The function @code{face-property-instance} actually does -all this, and is used to determine how to display the face. -@end defun - -@defun face-property-instance face property &optional domain default no-fallback -This function returns the instance of @var{face}'s @var{property} in the -specified @var{domain}. - -Under most circumstances, @var{domain} will be a particular window, and -the returned instance describes how the specified property actually is -displayed for that window and the particular buffer in it. Note that -this may not be the same as how the property appears when the buffer is -displayed in a different window or frame, or how the property appears in -the same window if you switch to another buffer in that window; and in -those cases, the returned instance would be different. - -The returned instance will typically be a color-instance, font-instance, -or pixmap-instance object, and you can query it using the appropriate -object-specific functions. For example, you could use -@code{color-instance-rgb-components} to find out the RGB (red, green, -and blue) components of how the @code{background} property of the -@code{highlight} face is displayed in a particular window. The results -might be different from the results you would get for another window -(perhaps the user specified a different color for the frame that window -is on; or perhaps the same color was specified but the window is on a -different X server, and that X server has different RGB values for the -color from this one). - -@var{domain} defaults to the selected window if omitted. - -@var{domain} can be a frame or device, instead of a window. The value -returned for a such a domain is used in special circumstances when a -more specific domain does not apply; for example, a frame value might be -used for coloring a toolbar, which is conceptually attached to a frame -rather than a particular window. The value is also useful in -determining what the value would be for a particular window within the -frame or device, if it is not overridden by a more specific -specification. - -If @var{property} does not name a built-in property, its value will -simply be returned unless it is a specifier object, in which case it -will be instanced using @code{specifier-instance}. - -Optional arguments @var{default} and @var{no-fallback} are the same as -in @code{specifier-instance}. @xref{Specifiers}. -@end defun - -@node Face Convenience Functions -@subsection Face Convenience Functions - -@defun set-face-foreground face color &optional locale tag how-to-add -@defunx set-face-background face color &optional locale tag how-to-add -These functions set the foreground (respectively, background) color of -face @var{face} to @var{color}. The argument @var{color} should be a -string (the name of a color) or a color object as returned by -@code{make-color} (@pxref{Colors}). -@end defun - -@defun set-face-background-pixmap face pixmap &optional locale tag how-to-add -This function sets the background pixmap of face @var{face} to -@var{pixmap}. The argument @var{pixmap} should be a string (the name of -a bitmap or pixmap file; the directories listed in the variable -@code{x-bitmap-file-path} will be searched) or a glyph object as -returned by @code{make-glyph} (@pxref{Glyphs}). The argument may also -be a list of the form @code{(@var{width} @var{height} @var{data})} where -@var{width} and @var{height} are the size in pixels, and @var{data} is a -string, containing the raw bits of the bitmap. -@end defun - -@defun set-face-font face font &optional locale tag how-to-add -This function sets the font of face @var{face}. The argument @var{font} -should be a string or a font object as returned by @code{make-font} -(@pxref{Fonts}). -@end defun - -@defun set-face-underline-p face underline-p &optional locale tag how-to-add -This function sets the underline property of face @var{face}. -@end defun - -@defun face-foreground face &optional locale -@defunx face-background face &optional locale -These functions return the foreground (respectively, background) color -specifier of face @var{face}. -@xref{Colors}. -@end defun - -@defun face-background-pixmap face &optional locale -This function return the background-pixmap glyph object of face -@var{face}. -@end defun - -@defun face-font face &optional locale -This function returns the font specifier of face @var{face}. (Note: -This is not the same as the function @code{face-font} in FSF Emacs.) -@xref{Fonts}. -@end defun - -@defun face-font-name face &optional domain -This function returns the name of the font of face @var{face}, or -@code{nil} if it is unspecified. This is basically equivalent to -@code{(font-name (face-font @var{face}) @var{domain})} except that -it does not cause an error if @var{face}'s font is @code{nil}. (This -function is named @code{face-font} in FSF Emacs.) -@end defun - -@defun face-underline-p face &optional locale -This function returns the underline property of face @var{face}. -@end defun - -@defun face-foreground-instance face &optional domain -@defunx face-background-instance face &optional domain -These functions return the foreground (respectively, background) color -specifier of face @var{face}. -@xref{Colors}. -@end defun - -@defun face-background-pixmap-instance face &optional domain -This function return the background-pixmap glyph object of face -@var{face}. -@end defun - -@defun face-font-instance face &optional domain -This function returns the font specifier of face @var{face}. -@xref{Fonts}. -@end defun - -@node Other Face Display Functions -@subsection Other Face Display Functions - -@defun invert-face face &optional locale -Swap the foreground and background colors of face @var{face}. If the -face doesn't specify both foreground and background, then its foreground -and background are set to the default background and foreground. -@end defun - -@defun face-equal face1 face2 &optional domain -This returns @code{t} if the faces @var{face1} and @var{face2} will -display in the same way. @var{domain} is as in -@code{face-property-instance}. -@end defun - -@defun face-differs-from-default-p face &optional domain -This returns @code{t} if the face @var{face} displays differently from -the default face. @var{domain} is as in @code{face-property-instance}. -@end defun - -@node Fonts -@section Fonts -@cindex fonts - - This section describes how to work with font specifier and -font instance objects, which encapsulate fonts in the window system. - -@menu -* Font Specifiers:: Specifying how a font will appear. -* Font Instances:: What a font specifier gets instanced as. -* Font Instance Names:: The name of a font instance. -* Font Instance Size:: The size of a font instance. -* Font Instance Characteristics:: Display characteristics of font instances. -* Font Convenience Functions:: Convenience functions that automatically - instance and retrieve the properties - of a font specifier. -@end menu - -@node Font Specifiers -@subsection Font Specifiers - -@defun font-specifier-p object -This predicate returns @code{t} if @var{object} is a font specifier, and -@code{nil} otherwise. -@end defun - -@node Font Instances -@subsection Font Instances - -@defun font-instance-p object -This predicate returns @code{t} if @var{object} is a font instance, and -@code{nil} otherwise. -@end defun - -@defun make-font-instance name &optional device noerror -This function creates a new font-instance object of the specified name. -@var{device} specifies the device this object applies to and defaults to -the selected device. An error is signalled if the font is unknown or -cannot be allocated; however, if @var{noerror} is non-@code{nil}, -@code{nil} is simply returned in this case. - -The returned object is a normal, first-class lisp object. The way you -``deallocate'' the font is the way you deallocate any other lisp object: -you drop all pointers to it and allow it to be garbage collected. When -these objects are GCed, the underlying X data is deallocated as well. -@end defun - -@node Font Instance Names -@subsection Font Instance Names -@cindex font instance name -@cindex available fonts -@cindex fonts available - -@defun list-fonts pattern &optional device -This function returns a list of font names matching the given pattern. -@var{device} specifies which device to search for names, and defaults to -the currently selected device. -@end defun - -@defun font-instance-name font-instance -This function returns the name used to allocate @var{font-instance}. -@end defun - -@defun font-instance-truename font-instance -This function returns the canonical name of the given font instance. -Font names are patterns which may match any number of fonts, of which -the first found is used. This returns an unambiguous name for that font -(but not necessarily its only unambiguous name). -@end defun - -@node Font Instance Size -@subsection Font Instance Size -@cindex font instance size - -@defun x-font-size font -This function returns the nominal size of the given font. This is done -by parsing its name, so it's likely to lose. X fonts can be specified -(by the user) in either pixels or 10ths of points, and this returns the -first one it finds, so you have to decide which units the returned value -is measured in yourself ... -@end defun - -@defun x-find-larger-font font &optional device -This function loads a new, slightly larger version of the given font (or -font name). Returns the font if it succeeds, @code{nil} otherwise. If -scalable fonts are available, this returns a font which is 1 point -larger. Otherwise, it returns the next larger version of this font that -is defined. -@end defun - -@defun x-find-smaller-font font &optional device -This function loads a new, slightly smaller version of the given font -(or font name). Returns the font if it succeeds, @code{nil} otherwise. -If scalable fonts are available, this returns a font which is 1 point -smaller. Otherwise, it returns the next smaller version of this font -that is defined. -@end defun - -@node Font Instance Characteristics -@subsection Font Instance Characteristics -@cindex font instance characteristics -@cindex characteristics of font instances -@cindex bold -@cindex demibold -@cindex italic -@cindex oblique - -@defun font-instance-properties font -This function returns the properties (an alist or @code{nil}) of -@var{font-instance}. -@end defun - -@defun x-make-font-bold font &optional device -Given an X font specification, this attempts to make a ``bold'' font. -If it fails, it returns @code{nil}. -@end defun - -@defun x-make-font-unbold font &optional device -Given an X font specification, this attempts to make a non-bold font. -If it fails, it returns @code{nil}. -@end defun - -@defun x-make-font-italic font &optional device -Given an X font specification, this attempts to make an ``italic'' font. -If it fails, it returns @code{nil}. -@end defun - -@defun x-make-font-unitalic font &optional device -Given an X font specification, this attempts to make a non-italic font. -If it fails, it returns @code{nil}. -@end defun - -@defun x-make-font-bold-italic font &optional device -Given an X font specification, this attempts to make a ``bold-italic'' -font. If it fails, it returns @code{nil}. -@end defun - -@node Font Convenience Functions -@subsection Font Convenience Functions - -@defun font-name font &optional domain -This function returns the name of the @var{font} in the specified -@var{domain}, if any. @var{font} should be a font specifier object and -@var{domain} is normally a window and defaults to the selected window if -omitted. This is equivalent to using @code{specifier-instance} and -applying @code{font-instance-name} to the result. -@end defun - -@defun font-truename font &optional domain -This function returns the truename of the @var{font} in the specified -@var{domain}, if any. @var{font} should be a font specifier object and -@var{domain} is normally a window and defaults to the selected window if -omitted. This is equivalent to using @code{specifier-instance} and -applying @code{font-instance-truename} to the result. -@end defun - -@defun font-properties font &optional domain -This function returns the properties of the @var{font} in the specified -@var{domain}, if any. @var{font} should be a font specifier object and -@var{domain} is normally a window and defaults to the selected window if -omitted. This is equivalent to using @code{specifier-instance} and -applying @code{font-instance-properties} to the result. -@end defun - -@node Colors -@section Colors -@cindex colors - -@menu -* Color Specifiers:: Specifying how a color will appear. -* Color Instances:: What a color specifier gets instanced as. -* Color Instance Properties:: Properties of color instances. -* Color Convenience Functions:: Convenience functions that automatically - instance and retrieve the properties - of a color specifier. -@end menu - -@node Color Specifiers -@subsection Color Specifiers - -@defun color-specifier-p object -This function returns non-@code{nil} if @var{object} is a color specifier. -@end defun - -@node Color Instances -@subsection Color Instances -@cindex color instances - -A @dfn{color-instance object} is an object describing the way a color -specifier is instanced in a particular domain. Functions such as -@code{face-background-instance} return a color-instance object. For -example, - -@example -(face-background-instance 'default (next-window)) - @result{} # -@end example - -The color-instance object returned describes the way the background -color of the @code{default} face is displayed in the next window after -the selected one. - -@defun color-instance-p object -This function returns non-@code{nil} if @var{object} is a color-instance. -@end defun - -@node Color Instance Properties -@subsection Color Instance Properties - -@defun color-instance-name color-instance -This function returns the name used to allocate @var{color-instance}. -@end defun - -@defun color-instance-rgb-components color-instance -This function returns a three element list containing the red, green, -and blue color components of @var{color-instance}. - -@example -(color-instance-rgb-components - (face-background-instance 'default (next-window))) - @result{} (65535 58596 46517) -@end example -@end defun - -@node Color Convenience Functions -@subsection Color Convenience Functions - -@defun color-name color &optional domain -This function returns the name of the @var{color} in the specified -@var{domain}, if any. @var{color} should be a color specifier object -and @var{domain} is normally a window and defaults to the selected -window if omitted. This is equivalent to using -@code{specifier-instance} and applying @code{color-instance-name} to the -result. -@end defun - -@defun color-rgb-components color &optional domain -This function returns the @sc{RGB} components of the @var{color} in the -specified @var{domain}, if any. @var{color} should be a color specifier -object and @var{domain} is normally a window and defaults to the -selected window if omitted. This is equivalent to using -@code{specifier-instance} and applying -@code{color-instance-rgb-components} to the result. - -@example -(color-rgb-components (face-background 'default (next-window))) - @result{} (65535 58596 46517) -@end example -@end defun diff --git a/man/lispref/files.texi b/man/lispref/files.texi deleted file mode 100644 index 7608b4a..0000000 --- a/man/lispref/files.texi +++ /dev/null @@ -1,2357 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/files.info -@node Files, Backups and Auto-Saving, Documentation, Top -@chapter Files - - In XEmacs, you can find, create, view, save, and otherwise work with -files and file directories. This chapter describes most of the -file-related functions of XEmacs Lisp, but a few others are described in -@ref{Buffers}, and those related to backups and auto-saving are -described in @ref{Backups and Auto-Saving}. - - Many of the file functions take one or more arguments that are file -names. A file name is actually a string. Most of these functions -expand file name arguments using @code{expand-file-name}, so that -@file{~} is handled correctly, as are relative file names (including -@samp{../}). These functions don't recognize environment variable -substitutions such as @samp{$HOME}. @xref{File Name Expansion}. - -@menu -* Visiting Files:: Reading files into Emacs buffers for editing. -* Saving Buffers:: Writing changed buffers back into files. -* Reading from Files:: Reading files into buffers without visiting. -* Writing to Files:: Writing new files from parts of buffers. -* File Locks:: Locking and unlocking files, to prevent - simultaneous editing by two people. -* Information about Files:: Testing existence, accessibility, size of files. -* Changing File Attributes:: Renaming files, changing protection, etc. -* File Names:: Decomposing and expanding file names. -* Contents of Directories:: Getting a list of the files in a directory. -* Create/Delete Dirs:: Creating and Deleting Directories. -* Magic File Names:: Defining "magic" special handling - for certain file names. -* Partial Files:: Treating a section of a buffer as a file. -* Format Conversion:: Conversion to and from various file formats. -* Files and MS-DOS:: Distinguishing text and binary files on MS-DOS. -@end menu - -@node Visiting Files -@section Visiting Files -@cindex finding files -@cindex visiting files - - Visiting a file means reading a file into a buffer. Once this is -done, we say that the buffer is @dfn{visiting} that file, and call the -file ``the visited file'' of the buffer. - - A file and a buffer are two different things. A file is information -recorded permanently in the computer (unless you delete it). A buffer, -on the other hand, is information inside of XEmacs that will vanish at -the end of the editing session (or when you kill the buffer). Usually, -a buffer contains information that you have copied from a file; then we -say the buffer is visiting that file. The copy in the buffer is what -you modify with editing commands. Such changes to the buffer do not -change the file; therefore, to make the changes permanent, you must -@dfn{save} the buffer, which means copying the altered buffer contents -back into the file. - - In spite of the distinction between files and buffers, people often -refer to a file when they mean a buffer and vice-versa. Indeed, we say, -``I am editing a file,'' rather than, ``I am editing a buffer that I -will soon save as a file of the same name.'' Humans do not usually need -to make the distinction explicit. When dealing with a computer program, -however, it is good to keep the distinction in mind. - -@menu -* Visiting Functions:: The usual interface functions for visiting. -* Subroutines of Visiting:: Lower-level subroutines that they use. -@end menu - -@node Visiting Functions -@subsection Functions for Visiting Files - - This section describes the functions normally used to visit files. -For historical reasons, these functions have names starting with -@samp{find-} rather than @samp{visit-}. @xref{Buffer File Name}, for -functions and variables that access the visited file name of a buffer or -that find an existing buffer by its visited file name. - - In a Lisp program, if you want to look at the contents of a file but -not alter it, the fastest way is to use @code{insert-file-contents} in a -temporary buffer. Visiting the file is not necessary and takes longer. -@xref{Reading from Files}. - -@deffn Command find-file filename -This command selects a buffer visiting the file @var{filename}, -using an existing buffer if there is one, and otherwise creating a -new buffer and reading the file into it. It also returns that buffer. - -The body of the @code{find-file} function is very simple and looks -like this: - -@example -(switch-to-buffer (find-file-noselect filename)) -@end example - -@noindent -(See @code{switch-to-buffer} in @ref{Displaying Buffers}.) - -When @code{find-file} is called interactively, it prompts for -@var{filename} in the minibuffer. -@end deffn - -@defun find-file-noselect filename &optional nowarn -This function is the guts of all the file-visiting functions. It finds -or creates a buffer visiting the file @var{filename}, and returns it. -It uses an existing buffer if there is one, and otherwise creates a new -buffer and reads the file into it. You may make the buffer current or -display it in a window if you wish, but this function does not do so. - -When @code{find-file-noselect} uses an existing buffer, it first -verifies that the file has not changed since it was last visited or -saved in that buffer. If the file has changed, then this function asks -the user whether to reread the changed file. If the user says -@samp{yes}, any changes previously made in the buffer are lost. - -If @code{find-file-noselect} needs to create a buffer, and there is no -file named @var{filename}, it displays the message @samp{New file} in -the echo area, and leaves the buffer empty. - -@c XEmacs feature -If @var{no-warn} is non-@code{nil}, various warnings that XEmacs normally -gives (e.g. if another buffer is already visiting @var{filename} but -@var{filename} has been removed from disk since that buffer was created) -are suppressed. - -The @code{find-file-noselect} function calls @code{after-find-file} -after reading the file (@pxref{Subroutines of Visiting}). That function -sets the buffer major mode, parses local variables, warns the user if -there exists an auto-save file more recent than the file just visited, -and finishes by running the functions in @code{find-file-hooks}. - -The @code{find-file-noselect} function returns the buffer that is -visiting the file @var{filename}. - -@example -@group -(find-file-noselect "/etc/fstab") - @result{} # -@end group -@end example -@end defun - -@deffn Command find-file-other-window filename -This command selects a buffer visiting the file @var{filename}, but -does so in a window other than the selected window. It may use another -existing window or split a window; see @ref{Displaying Buffers}. - -When this command is called interactively, it prompts for -@var{filename}. -@end deffn - -@deffn Command find-file-read-only filename -This command selects a buffer visiting the file @var{filename}, like -@code{find-file}, but it marks the buffer as read-only. @xref{Read Only -Buffers}, for related functions and variables. - -When this command is called interactively, it prompts for -@var{filename}. -@end deffn - -@deffn Command view-file filename -This command visits @var{filename} in View mode, and displays it in a -recursive edit, returning to the previous buffer when done. View mode -is a mode that allows you to skim rapidly through the file but does not -let you modify it. Entering View mode runs the normal hook -@code{view-mode-hook}. @xref{Hooks}. - -When @code{view-file} is called interactively, it prompts for -@var{filename}. -@end deffn - -@defvar find-file-hooks -The value of this variable is a list of functions to be called after a -file is visited. The file's local-variables specification (if any) will -have been processed before the hooks are run. The buffer visiting the -file is current when the hook functions are run. - -This variable works just like a normal hook, but we think that renaming -it would not be advisable. -@end defvar - -@defvar find-file-not-found-hooks -The value of this variable is a list of functions to be called when -@code{find-file} or @code{find-file-noselect} is passed a nonexistent -file name. @code{find-file-noselect} calls these functions as soon as -it detects a nonexistent file. It calls them in the order of the list, -until one of them returns non-@code{nil}. @code{buffer-file-name} is -already set up. - -This is not a normal hook because the values of the functions are -used and they may not all be called. -@end defvar - -@node Subroutines of Visiting -@subsection Subroutines of Visiting - - The @code{find-file-noselect} function uses the -@code{create-file-buffer} and @code{after-find-file} functions as -subroutines. Sometimes it is useful to call them directly. - -@defun create-file-buffer filename -This function creates a suitably named buffer for visiting -@var{filename}, and returns it. It uses @var{filename} (sans directory) -as the name if that name is free; otherwise, it appends a string such as -@samp{<2>} to get an unused name. See also @ref{Creating Buffers}. - -@strong{Please note:} @code{create-file-buffer} does @emph{not} -associate the new buffer with a file and does not select the buffer. -It also does not use the default major mode. - -@example -@group -(create-file-buffer "foo") - @result{} # -@end group -@group -(create-file-buffer "foo") - @result{} #> -@end group -@group -(create-file-buffer "foo") - @result{} #> -@end group -@end example - -This function is used by @code{find-file-noselect}. -It uses @code{generate-new-buffer} (@pxref{Creating Buffers}). -@end defun - -@defun after-find-file &optional error warn noauto -This function sets the buffer major mode, and parses local variables -(@pxref{Auto Major Mode}). It is called by @code{find-file-noselect} -and by the default revert function (@pxref{Reverting}). - -@cindex new file message -@cindex file open error -If reading the file got an error because the file does not exist, but -its directory does exist, the caller should pass a non-@code{nil} value -for @var{error}. In that case, @code{after-find-file} issues a warning: -@samp{(New File)}. For more serious errors, the caller should usually not -call @code{after-find-file}. - -If @var{warn} is non-@code{nil}, then this function issues a warning -if an auto-save file exists and is more recent than the visited file. - -@c XEmacs feature -If @var{noauto} is non-@code{nil}, then this function does not turn -on auto-save mode; otherwise, it does. - -The last thing @code{after-find-file} does is call all the functions -in @code{find-file-hooks}. -@end defun - -@node Saving Buffers -@section Saving Buffers - - When you edit a file in XEmacs, you are actually working on a buffer -that is visiting that file---that is, the contents of the file are -copied into the buffer and the copy is what you edit. Changes to the -buffer do not change the file until you @dfn{save} the buffer, which -means copying the contents of the buffer into the file. - -@deffn Command save-buffer &optional backup-option -This function saves the contents of the current buffer in its visited -file if the buffer has been modified since it was last visited or saved. -Otherwise it does nothing. - -@code{save-buffer} is responsible for making backup files. Normally, -@var{backup-option} is @code{nil}, and @code{save-buffer} makes a backup -file only if this is the first save since visiting the file. Other -values for @var{backup-option} request the making of backup files in -other circumstances: - -@itemize @bullet -@item -With an argument of 4 or 64, reflecting 1 or 3 @kbd{C-u}'s, the -@code{save-buffer} function marks this version of the file to be -backed up when the buffer is next saved. - -@item -With an argument of 16 or 64, reflecting 2 or 3 @kbd{C-u}'s, the -@code{save-buffer} function unconditionally backs up the previous -version of the file before saving it. -@end itemize -@end deffn - -@deffn Command save-some-buffers &optional save-silently-p exiting -This command saves some modified file-visiting buffers. Normally it -asks the user about each buffer. But if @var{save-silently-p} is -non-@code{nil}, it saves all the file-visiting buffers without querying -the user. - -The optional @var{exiting} argument, if non-@code{nil}, requests this -function to offer also to save certain other buffers that are not -visiting files. These are buffers that have a non-@code{nil} local -value of @code{buffer-offer-save}. (A user who says yes to saving one -of these is asked to specify a file name to use.) The -@code{save-buffers-kill-emacs} function passes a non-@code{nil} value -for this argument. -@end deffn - -@defvar buffer-offer-save -When this variable is non-@code{nil} in a buffer, XEmacs offers to save -the buffer on exit even if the buffer is not visiting a file. The -variable is automatically local in all buffers. Normally, Mail mode -(used for editing outgoing mail) sets this to @code{t}. -@end defvar - -@deffn Command write-file filename -This function writes the current buffer into file @var{filename}, makes -the buffer visit that file, and marks it not modified. Then it renames -the buffer based on @var{filename}, appending a string like @samp{<2>} -if necessary to make a unique buffer name. It does most of this work by -calling @code{set-visited-file-name} and @code{save-buffer}. -@end deffn - -@defvar write-file-hooks -The value of this variable is a list of functions to be called before -writing out a buffer to its visited file. If one of them returns -non-@code{nil}, the file is considered already written and the rest of -the functions are not called, nor is the usual code for writing the file -executed. - -If a function in @code{write-file-hooks} returns non-@code{nil}, it -is responsible for making a backup file (if that is appropriate). -To do so, execute the following code: - -@example -(or buffer-backed-up (backup-buffer)) -@end example - -You might wish to save the file modes value returned by -@code{backup-buffer} and use that to set the mode bits of the file that -you write. This is what @code{save-buffer} normally does. - -Even though this is not a normal hook, you can use @code{add-hook} and -@code{remove-hook} to manipulate the list. @xref{Hooks}. -@end defvar - -@c Emacs 19 feature -@defvar local-write-file-hooks -This works just like @code{write-file-hooks}, but it is intended -to be made local to particular buffers. It's not a good idea to make -@code{write-file-hooks} local to a buffer---use this variable instead. - -The variable is marked as a permanent local, so that changing the major -mode does not alter a buffer-local value. This is convenient for -packages that read ``file'' contents in special ways, and set up hooks -to save the data in a corresponding way. -@end defvar - -@c Emacs 19 feature -@defvar write-contents-hooks -This works just like @code{write-file-hooks}, but it is intended for -hooks that pertain to the contents of the file, as opposed to hooks that -pertain to where the file came from. Such hooks are usually set up by -major modes, as buffer-local bindings for this variable. Switching to a -new major mode always resets this variable. -@end defvar - -@c Emacs 19 feature -@defvar after-save-hook -This normal hook runs after a buffer has been saved in its visited file. -@end defvar - -@defvar file-precious-flag -If this variable is non-@code{nil}, then @code{save-buffer} protects -against I/O errors while saving by writing the new file to a temporary -name instead of the name it is supposed to have, and then renaming it to -the intended name after it is clear there are no errors. This procedure -prevents problems such as a lack of disk space from resulting in an -invalid file. - -As a side effect, backups are necessarily made by copying. @xref{Rename -or Copy}. Yet, at the same time, saving a precious file always breaks -all hard links between the file you save and other file names. - -Some modes set this variable non-@code{nil} locally in particular -buffers. -@end defvar - -@defopt require-final-newline -This variable determines whether files may be written out that do -@emph{not} end with a newline. If the value of the variable is -@code{t}, then @code{save-buffer} silently adds a newline at the end of -the file whenever the buffer being saved does not already end in one. -If the value of the variable is non-@code{nil}, but not @code{t}, then -@code{save-buffer} asks the user whether to add a newline each time the -case arises. - -If the value of the variable is @code{nil}, then @code{save-buffer} -doesn't add newlines at all. @code{nil} is the default value, but a few -major modes set it to @code{t} in particular buffers. -@end defopt - -@node Reading from Files -@section Reading from Files - - You can copy a file from the disk and insert it into a buffer -using the @code{insert-file-contents} function. Don't use the user-level -command @code{insert-file} in a Lisp program, as that sets the mark. - -@defun insert-file-contents filename &optional visit beg end replace -This function inserts the contents of file @var{filename} into the -current buffer after point. It returns a list of the absolute file name -and the length of the data inserted. An error is signaled if -@var{filename} is not the name of a file that can be read. - -The function @code{insert-file-contents} checks the file contents -against the defined file formats, and converts the file contents if -appropriate. @xref{Format Conversion}. It also calls the functions in -the list @code{after-insert-file-functions}; see @ref{Saving -Properties}. - -If @var{visit} is non-@code{nil}, this function additionally marks the -buffer as unmodified and sets up various fields in the buffer so that it -is visiting the file @var{filename}: these include the buffer's visited -file name and its last save file modtime. This feature is used by -@code{find-file-noselect} and you probably should not use it yourself. - -If @var{beg} and @var{end} are non-@code{nil}, they should be integers -specifying the portion of the file to insert. In this case, @var{visit} -must be @code{nil}. For example, - -@example -(insert-file-contents filename nil 0 500) -@end example - -@noindent -inserts the first 500 characters of a file. - -If the argument @var{replace} is non-@code{nil}, it means to replace the -contents of the buffer (actually, just the accessible portion) with the -contents of the file. This is better than simply deleting the buffer -contents and inserting the whole file, because (1) it preserves some -marker positions and (2) it puts less data in the undo list. -@end defun - -If you want to pass a file name to another process so that another -program can read the file, use the function @code{file-local-copy}; see -@ref{Magic File Names}. - -@node Writing to Files -@section Writing to Files - - You can write the contents of a buffer, or part of a buffer, directly -to a file on disk using the @code{append-to-file} and -@code{write-region} functions. Don't use these functions to write to -files that are being visited; that could cause confusion in the -mechanisms for visiting. - -@deffn Command append-to-file start end filename -This function appends the contents of the region delimited by -@var{start} and @var{end} in the current buffer to the end of file -@var{filename}. If that file does not exist, it is created. If that -file exists it is overwritten. This function returns @code{nil}. - -An error is signaled if @var{filename} specifies a nonwritable file, -or a nonexistent file in a directory where files cannot be created. -@end deffn - -@deffn Command write-region start end filename &optional append visit -This function writes the region delimited by @var{start} and @var{end} -in the current buffer into the file specified by @var{filename}. - -@c Emacs 19 feature -If @var{start} is a string, then @code{write-region} writes or appends -that string, rather than text from the buffer. - -If @var{append} is non-@code{nil}, then the specified text is appended -to the existing file contents (if any). - -If @var{visit} is @code{t}, then XEmacs establishes an association -between the buffer and the file: the buffer is then visiting that file. -It also sets the last file modification time for the current buffer to -@var{filename}'s modtime, and marks the buffer as not modified. This -feature is used by @code{save-buffer}, but you probably should not use -it yourself. - -@c Emacs 19 feature -If @var{visit} is a string, it specifies the file name to visit. This -way, you can write the data to one file (@var{filename}) while recording -the buffer as visiting another file (@var{visit}). The argument -@var{visit} is used in the echo area message and also for file locking; -@var{visit} is stored in @code{buffer-file-name}. This feature is used -to implement @code{file-precious-flag}; don't use it yourself unless you -really know what you're doing. - -The function @code{write-region} converts the data which it writes to -the appropriate file formats specified by @code{buffer-file-format}. -@xref{Format Conversion}. It also calls the functions in the list -@code{write-region-annotate-functions}; see @ref{Saving Properties}. - -Normally, @code{write-region} displays a message @samp{Wrote file -@var{filename}} in the echo area. If @var{visit} is neither @code{t} -nor @code{nil} nor a string, then this message is inhibited. This -feature is useful for programs that use files for internal purposes, -files that the user does not need to know about. -@end deffn - -@node File Locks -@section File Locks -@cindex file locks - - When two users edit the same file at the same time, they are likely to -interfere with each other. XEmacs tries to prevent this situation from -arising by recording a @dfn{file lock} when a file is being modified. -XEmacs can then detect the first attempt to modify a buffer visiting a -file that is locked by another XEmacs process, and ask the user what to do. - - File locks do not work properly when multiple machines can share -file systems, such as with NFS. Perhaps a better file locking system -will be implemented in the future. When file locks do not work, it is -possible for two users to make changes simultaneously, but XEmacs can -still warn the user who saves second. Also, the detection of -modification of a buffer visiting a file changed on disk catches some -cases of simultaneous editing; see @ref{Modification Time}. - -@c Not optional in FSF Emacs 19 -@defun file-locked-p &optional filename - This function returns @code{nil} if the file @var{filename} is not -locked by this XEmacs process. It returns @code{t} if it is locked by -this XEmacs, and it returns the name of the user who has locked it if it -is locked by someone else. - -@example -@group -(file-locked-p "foo") - @result{} nil -@end group -@end example -@end defun - -@defun lock-buffer &optional filename - This function locks the file @var{filename}, if the current buffer is -modified. The argument @var{filename} defaults to the current buffer's -visited file. Nothing is done if the current buffer is not visiting a -file, or is not modified. -@end defun - -@defun unlock-buffer -This function unlocks the file being visited in the current buffer, -if the buffer is modified. If the buffer is not modified, then -the file should not be locked, so this function does nothing. It also -does nothing if the current buffer is not visiting a file. -@end defun - -@defun ask-user-about-lock file other-user -This function is called when the user tries to modify @var{file}, but it -is locked by another user named @var{other-user}. The value it returns -determines what happens next: - -@itemize @bullet -@item -A value of @code{t} says to grab the lock on the file. Then -this user may edit the file and @var{other-user} loses the lock. - -@item -A value of @code{nil} says to ignore the lock and let this -user edit the file anyway. - -@item -@kindex file-locked -This function may instead signal a @code{file-locked} error, in which -case the change that the user was about to make does not take place. - -The error message for this error looks like this: - -@example -@error{} File is locked: @var{file} @var{other-user} -@end example - -@noindent -where @code{file} is the name of the file and @var{other-user} is the -name of the user who has locked the file. -@end itemize - - The default definition of this function asks the user to choose what -to do. If you wish, you can replace the @code{ask-user-about-lock} -function with your own version that decides in another way. The code -for its usual definition is in @file{userlock.el}. -@end defun - -@node Information about Files -@section Information about Files - - The functions described in this section all operate on strings that -designate file names. All the functions have names that begin with the -word @samp{file}. These functions all return information about actual -files or directories, so their arguments must all exist as actual files -or directories unless otherwise noted. - -@menu -* Testing Accessibility:: Is a given file readable? Writable? -* Kinds of Files:: Is it a directory? A symbolic link? -* Truenames:: Eliminating symbolic links from a file name. -* File Attributes:: How large is it? Any other names? Etc. -@end menu - -@node Testing Accessibility -@subsection Testing Accessibility -@cindex accessibility of a file -@cindex file accessibility - - These functions test for permission to access a file in specific ways. - -@defun file-exists-p filename -This function returns @code{t} if a file named @var{filename} appears -to exist. This does not mean you can necessarily read the file, only -that you can find out its attributes. (On Unix, this is true if the -file exists and you have execute permission on the containing -directories, regardless of the protection of the file itself.) - -If the file does not exist, or if fascist access control policies -prevent you from finding the attributes of the file, this function -returns @code{nil}. -@end defun - -@defun file-readable-p filename -This function returns @code{t} if a file named @var{filename} exists -and you can read it. It returns @code{nil} otherwise. - -@example -@group -(file-readable-p "files.texi") - @result{} t -@end group -@group -(file-exists-p "/usr/spool/mqueue") - @result{} t -@end group -@group -(file-readable-p "/usr/spool/mqueue") - @result{} nil -@end group -@end example -@end defun - -@c Emacs 19 feature -@defun file-executable-p filename -This function returns @code{t} if a file named @var{filename} exists and -you can execute it. It returns @code{nil} otherwise. If the file is a -directory, execute permission means you can check the existence and -attributes of files inside the directory, and open those files if their -modes permit. -@end defun - -@defun file-writable-p filename -This function returns @code{t} if the file @var{filename} can be written -or created by you, and @code{nil} otherwise. A file is writable if the -file exists and you can write it. It is creatable if it does not exist, -but the specified directory does exist and you can write in that -directory. - -In the third example below, @file{foo} is not writable because the -parent directory does not exist, even though the user could create such -a directory. - -@example -@group -(file-writable-p "~/foo") - @result{} t -@end group -@group -(file-writable-p "/foo") - @result{} nil -@end group -@group -(file-writable-p "~/no-such-dir/foo") - @result{} nil -@end group -@end example -@end defun - -@c Emacs 19 feature -@defun file-accessible-directory-p dirname -This function returns @code{t} if you have permission to open existing -files in the directory whose name as a file is @var{dirname}; otherwise -(or if there is no such directory), it returns @code{nil}. The value -of @var{dirname} may be either a directory name or the file name of a -directory. - -Example: after the following, - -@example -(file-accessible-directory-p "/foo") - @result{} nil -@end example - -@noindent -we can deduce that any attempt to read a file in @file{/foo/} will -give an error. -@end defun - -@defun file-ownership-preserved-p filename -This function returns @code{t} if deleting the file @var{filename} and -then creating it anew would keep the file's owner unchanged. -@end defun - -@defun file-newer-than-file-p filename1 filename2 -@cindex file age -@cindex file modification time -This function returns @code{t} if the file @var{filename1} is -newer than file @var{filename2}. If @var{filename1} does not -exist, it returns @code{nil}. If @var{filename2} does not exist, -it returns @code{t}. - -In the following example, assume that the file @file{aug-19} was written -on the 19th, @file{aug-20} was written on the 20th, and the file -@file{no-file} doesn't exist at all. - -@example -@group -(file-newer-than-file-p "aug-19" "aug-20") - @result{} nil -@end group -@group -(file-newer-than-file-p "aug-20" "aug-19") - @result{} t -@end group -@group -(file-newer-than-file-p "aug-19" "no-file") - @result{} t -@end group -@group -(file-newer-than-file-p "no-file" "aug-19") - @result{} nil -@end group -@end example - -You can use @code{file-attributes} to get a file's last modification -time as a list of two numbers. @xref{File Attributes}. -@end defun - -@node Kinds of Files -@subsection Distinguishing Kinds of Files - - This section describes how to distinguish various kinds of files, such -as directories, symbolic links, and ordinary files. - -@defun file-symlink-p filename -@cindex file symbolic links -If the file @var{filename} is a symbolic link, the @code{file-symlink-p} -function returns the file name to which it is linked. This may be the -name of a text file, a directory, or even another symbolic link, or it -may be a nonexistent file name. - -If the file @var{filename} is not a symbolic link (or there is no such file), -@code{file-symlink-p} returns @code{nil}. - -@example -@group -(file-symlink-p "foo") - @result{} nil -@end group -@group -(file-symlink-p "sym-link") - @result{} "foo" -@end group -@group -(file-symlink-p "sym-link2") - @result{} "sym-link" -@end group -@group -(file-symlink-p "/bin") - @result{} "/pub/bin" -@end group -@end example - -@c !!! file-symlink-p: should show output of ls -l for comparison -@end defun - -@defun file-directory-p filename -This function returns @code{t} if @var{filename} is the name of an -existing directory, @code{nil} otherwise. - -@example -@group -(file-directory-p "~rms") - @result{} t -@end group -@group -(file-directory-p "~rms/lewis/files.texi") - @result{} nil -@end group -@group -(file-directory-p "~rms/lewis/no-such-file") - @result{} nil -@end group -@group -(file-directory-p "$HOME") - @result{} nil -@end group -@group -(file-directory-p - (substitute-in-file-name "$HOME")) - @result{} t -@end group -@end example -@end defun - -@defun file-regular-p filename -This function returns @code{t} if the file @var{filename} exists and is -a regular file (not a directory, symbolic link, named pipe, terminal, or -other I/O device). -@end defun - -@node Truenames -@subsection Truenames -@cindex truename (of file) - -@c Emacs 19 features - The @dfn{truename} of a file is the name that you get by following -symbolic links until none remain, then expanding to get rid of @samp{.} -and @samp{..} as components. Strictly speaking, a file need not have a -unique truename; the number of distinct truenames a file has is equal to -the number of hard links to the file. However, truenames are useful -because they eliminate symbolic links as a cause of name variation. - -@defun file-truename filename &optional default -The function @code{file-truename} returns the true name of the file -@var{filename}. This is the name that you get by following symbolic -links until none remain. - -@c XEmacs allows relative filenames -If the filename is relative, @var{default} is the directory to start -with. If @var{default} is @code{nil} or missing, the current buffer's -value of @code{default-directory} is used. -@end defun - - @xref{Buffer File Name}, for related information. - -@node File Attributes -@subsection Other Information about Files - - This section describes the functions for getting detailed information -about a file, other than its contents. This information includes the -mode bits that control access permission, the owner and group numbers, -the number of names, the inode number, the size, and the times of access -and modification. - -@defun file-modes filename -@cindex permission -@cindex file attributes -This function returns the mode bits of @var{filename}, as an integer. -The mode bits are also called the file permissions, and they specify -access control in the usual Unix fashion. If the low-order bit is 1, -then the file is executable by all users, if the second-lowest-order bit -is 1, then the file is writable by all users, etc. - -The highest value returnable is 4095 (7777 octal), meaning that -everyone has read, write, and execute permission, that the @sc{suid} bit -is set for both others and group, and that the sticky bit is set. - -@example -@group -(file-modes "~/junk/diffs") - @result{} 492 ; @r{Decimal integer.} -@end group -@group -(format "%o" 492) - @result{} "754" ; @r{Convert to octal.} -@end group - -@group -(set-file-modes "~/junk/diffs" 438) - @result{} nil -@end group - -@group -(format "%o" 438) - @result{} "666" ; @r{Convert to octal.} -@end group - -@group -% ls -l diffs - -rw-rw-rw- 1 lewis 0 3063 Oct 30 16:00 diffs -@end group -@end example -@end defun - -@defun file-nlinks filename -This functions returns the number of names (i.e., hard links) that -file @var{filename} has. If the file does not exist, then this function -returns @code{nil}. Note that symbolic links have no effect on this -function, because they are not considered to be names of the files they -link to. - -@example -@group -% ls -l foo* --rw-rw-rw- 2 rms 4 Aug 19 01:27 foo --rw-rw-rw- 2 rms 4 Aug 19 01:27 foo1 -@end group - -@group -(file-nlinks "foo") - @result{} 2 -@end group -@group -(file-nlinks "doesnt-exist") - @result{} nil -@end group -@end example -@end defun - -@defun file-attributes filename -This function returns a list of attributes of file @var{filename}. If -the specified file cannot be opened, it returns @code{nil}. - -The elements of the list, in order, are: - -@enumerate 0 -@item -@code{t} for a directory, a string for a symbolic link (the name -linked to), or @code{nil} for a text file. - -@c Wordy so as to prevent an overfull hbox. --rjc 15mar92 -@item -The number of names the file has. Alternate names, also known as hard -links, can be created by using the @code{add-name-to-file} function -(@pxref{Changing File Attributes}). - -@item -The file's @sc{uid}. - -@item -The file's @sc{gid}. - -@item -The time of last access, as a list of two integers. -The first integer has the high-order 16 bits of time, -the second has the low 16 bits. (This is similar to the -value of @code{current-time}; see @ref{Time of Day}.) - -@item -The time of last modification as a list of two integers (as above). - -@item -The time of last status change as a list of two integers (as above). - -@item -The size of the file in bytes. - -@item -The file's modes, as a string of ten letters or dashes, -as in @samp{ls -l}. - -@item -@code{t} if the file's @sc{gid} would change if file were -deleted and recreated; @code{nil} otherwise. - -@item -The file's inode number. - -@item -The file system number of the file system that the file is in. This -element and the file's inode number together give enough information to -distinguish any two files on the system---no two files can have the same -values for both of these numbers. -@end enumerate - -For example, here are the file attributes for @file{files.texi}: - -@example -@group -(file-attributes "files.texi") - @result{} (nil - 1 - 2235 - 75 - (8489 20284) - (8489 20284) - (8489 20285) - 14906 - "-rw-rw-rw-" - nil - 129500 - -32252) -@end group -@end example - -@noindent -and here is how the result is interpreted: - -@table @code -@item nil -is neither a directory nor a symbolic link. - -@item 1 -has only one name (the name @file{files.texi} in the current default -directory). - -@item 2235 -is owned by the user with @sc{uid} 2235. - -@item 75 -is in the group with @sc{gid} 75. - -@item (8489 20284) -was last accessed on Aug 19 00:09. Use @code{format-time-string} to -! convert this number into a time string. @xref{Time Conversion}. - -@item (8489 20284) -was last modified on Aug 19 00:09. - -@item (8489 20285) -last had its inode changed on Aug 19 00:09. - -@item 14906 -is 14906 characters long. - -@item "-rw-rw-rw-" -has a mode of read and write access for the owner, group, and world. - -@item nil -would retain the same @sc{gid} if it were recreated. - -@item 129500 -has an inode number of 129500. -@item -32252 -is on file system number -32252. -@end table -@end defun - -@node Changing File Attributes -@section Changing File Names and Attributes -@cindex renaming files -@cindex copying files -@cindex deleting files -@cindex linking files -@cindex setting modes of files - - The functions in this section rename, copy, delete, link, and set the -modes of files. - - In the functions that have an argument @var{newname}, if a file by the -name of @var{newname} already exists, the actions taken depend on the -value of the argument @var{ok-if-already-exists}: - -@itemize @bullet -@item -Signal a @code{file-already-exists} error if -@var{ok-if-already-exists} is @code{nil}. - -@item -Request confirmation if @var{ok-if-already-exists} is a number. - -@item -Replace the old file without confirmation if @var{ok-if-already-exists} -is any other value. -@end itemize - -@deffn Command add-name-to-file oldname newname &optional ok-if-already-exists -@cindex file with multiple names -@cindex file hard link -This function gives the file named @var{oldname} the additional name -@var{newname}. This means that @var{newname} becomes a new ``hard -link'' to @var{oldname}. - -In the first part of the following example, we list two files, -@file{foo} and @file{foo3}. - -@example -@group -% ls -l fo* --rw-rw-rw- 1 rms 29 Aug 18 20:32 foo --rw-rw-rw- 1 rms 24 Aug 18 20:31 foo3 -@end group -@end example - -Then we evaluate the form @code{(add-name-to-file "~/lewis/foo" -"~/lewis/foo2")}. Again we list the files. This shows two names, -@file{foo} and @file{foo2}. - -@example -@group -(add-name-to-file "~/lewis/foo1" "~/lewis/foo2") - @result{} nil -@end group - -@group -% ls -l fo* --rw-rw-rw- 2 rms 29 Aug 18 20:32 foo --rw-rw-rw- 2 rms 29 Aug 18 20:32 foo2 --rw-rw-rw- 1 rms 24 Aug 18 20:31 foo3 -@end group -@end example - -@c !!! Check whether this set of examples is consistent. --rjc 15mar92 - Finally, we evaluate the following: - -@example -(add-name-to-file "~/lewis/foo" "~/lewis/foo3" t) -@end example - -@noindent -and list the files again. Now there are three names -for one file: @file{foo}, @file{foo2}, and @file{foo3}. The old -contents of @file{foo3} are lost. - -@example -@group -(add-name-to-file "~/lewis/foo1" "~/lewis/foo3") - @result{} nil -@end group - -@group -% ls -l fo* --rw-rw-rw- 3 rms 29 Aug 18 20:32 foo --rw-rw-rw- 3 rms 29 Aug 18 20:32 foo2 --rw-rw-rw- 3 rms 29 Aug 18 20:32 foo3 -@end group -@end example - - This function is meaningless on VMS, where multiple names for one file -are not allowed. - - See also @code{file-nlinks} in @ref{File Attributes}. -@end deffn - -@deffn Command rename-file filename newname &optional ok-if-already-exists -This command renames the file @var{filename} as @var{newname}. - -If @var{filename} has additional names aside from @var{filename}, it -continues to have those names. In fact, adding the name @var{newname} -with @code{add-name-to-file} and then deleting @var{filename} has the -same effect as renaming, aside from momentary intermediate states. - -In an interactive call, this function prompts for @var{filename} and -@var{newname} in the minibuffer; also, it requests confirmation if -@var{newname} already exists. -@end deffn - -@deffn Command copy-file oldname newname &optional ok-if-exists time -This command copies the file @var{oldname} to @var{newname}. An -error is signaled if @var{oldname} does not exist. - -If @var{time} is non-@code{nil}, then this functions gives the new -file the same last-modified time that the old one has. (This works on -only some operating systems.) - -In an interactive call, this function prompts for @var{filename} and -@var{newname} in the minibuffer; also, it requests confirmation if -@var{newname} already exists. -@end deffn - -@deffn Command delete-file filename -@pindex rm -This command deletes the file @var{filename}, like the shell command -@samp{rm @var{filename}}. If the file has multiple names, it continues -to exist under the other names. - -A suitable kind of @code{file-error} error is signaled if the file -does not exist, or is not deletable. (On Unix, a file is deletable if -its directory is writable.) - -See also @code{delete-directory} in @ref{Create/Delete Dirs}. -@end deffn - -@deffn Command make-symbolic-link filename newname &optional ok-if-exists -@pindex ln -@kindex file-already-exists -This command makes a symbolic link to @var{filename}, named -@var{newname}. This is like the shell command @samp{ln -s -@var{filename} @var{newname}}. - -In an interactive call, this function prompts for @var{filename} and -@var{newname} in the minibuffer; also, it requests confirmation if -@var{newname} already exists. -@end deffn - -@defun define-logical-name varname string -This function defines the logical name @var{name} to have the value -@var{string}. It is available only on VMS. -@end defun - -@defun set-file-modes filename mode -This function sets mode bits of @var{filename} to @var{mode} (which must -be an integer). Only the low 12 bits of @var{mode} are used. -@end defun - -@c Emacs 19 feature -@defun set-default-file-modes mode -This function sets the default file protection for new files created by -XEmacs and its subprocesses. Every file created with XEmacs initially has -this protection. On Unix, the default protection is the bitwise -complement of the ``umask'' value. - -The argument @var{mode} must be an integer. Only the low 9 bits of -@var{mode} are used. - -Saving a modified version of an existing file does not count as creating -the file; it does not change the file's mode, and does not use the -default file protection. -@end defun - -@defun default-file-modes -This function returns the current default protection value. -@end defun - -@cindex MS-DOS and file modes -@cindex file modes and MS-DOS - On MS-DOS, there is no such thing as an ``executable'' file mode bit. -So Emacs considers a file executable if its name ends in @samp{.com}, -@samp{.bat} or @samp{.exe}. This is reflected in the values returned -by @code{file-modes} and @code{file-attributes}. - -@node File Names -@section File Names -@cindex file names - - Files are generally referred to by their names, in XEmacs as elsewhere. -File names in XEmacs are represented as strings. The functions that -operate on a file all expect a file name argument. - - In addition to operating on files themselves, XEmacs Lisp programs -often need to operate on the names; i.e., to take them apart and to use -part of a name to construct related file names. This section describes -how to manipulate file names. - - The functions in this section do not actually access files, so they -can operate on file names that do not refer to an existing file or -directory. - - On VMS, all these functions understand both VMS file-name syntax and -Unix syntax. This is so that all the standard Lisp libraries can -specify file names in Unix syntax and work properly on VMS without -change. On MS-DOS, these functions understand MS-DOS file-name syntax -as well as Unix syntax. - -@menu -* File Name Components:: The directory part of a file name, and the rest. -* Directory Names:: A directory's name as a directory - is different from its name as a file. -* Relative File Names:: Some file names are relative to a current directory. -* File Name Expansion:: Converting relative file names to absolute ones. -* Unique File Names:: Generating names for temporary files. -* File Name Completion:: Finding the completions for a given file name. -* User Name Completion:: Finding the completions for a given user name. -@end menu - -@node File Name Components -@subsection File Name Components -@cindex directory part (of file name) -@cindex nondirectory part (of file name) -@cindex version number (in file name) - - The operating system groups files into directories. To specify a -file, you must specify the directory and the file's name within that -directory. Therefore, XEmacs considers a file name as having two main -parts: the @dfn{directory name} part, and the @dfn{nondirectory} part -(or @dfn{file name within the directory}). Either part may be empty. -Concatenating these two parts reproduces the original file name. - - On Unix, the directory part is everything up to and including the last -slash; the nondirectory part is the rest. The rules in VMS syntax are -complicated. - - For some purposes, the nondirectory part is further subdivided into -the name proper and the @dfn{version number}. On Unix, only backup -files have version numbers in their names; on VMS, every file has a -version number, but most of the time the file name actually used in -XEmacs omits the version number. Version numbers are found mostly in -directory lists. - -@defun file-name-directory filename - This function returns the directory part of @var{filename} (or -@code{nil} if @var{filename} does not include a directory part). On -Unix, the function returns a string ending in a slash. On VMS, it -returns a string ending in one of the three characters @samp{:}, -@samp{]}, or @samp{>}. - -@example -@group -(file-name-directory "lewis/foo") ; @r{Unix example} - @result{} "lewis/" -@end group -@group -(file-name-directory "foo") ; @r{Unix example} - @result{} nil -@end group -@group -(file-name-directory "[X]FOO.TMP") ; @r{VMS example} - @result{} "[X]" -@end group -@end example -@end defun - -@defun file-name-nondirectory filename - This function returns the nondirectory part of @var{filename}. - -@example -@group -(file-name-nondirectory "lewis/foo") - @result{} "foo" -@end group -@group -(file-name-nondirectory "foo") - @result{} "foo" -@end group -@group -;; @r{The following example is accurate only on VMS.} -(file-name-nondirectory "[X]FOO.TMP") - @result{} "FOO.TMP" -@end group -@end example -@end defun - -@defun file-name-sans-versions filename &optional keep-backup-version - This function returns @var{filename} without any file version numbers, -backup version numbers, or trailing tildes. - -@c XEmacs feature? -If @var{keep-backup-version} is non-@code{nil}, we do not remove backup -version numbers, only true file version numbers. - -@example -@group -(file-name-sans-versions "~rms/foo.~1~") - @result{} "~rms/foo" -@end group -@group -(file-name-sans-versions "~rms/foo~") - @result{} "~rms/foo" -@end group -@group -(file-name-sans-versions "~rms/foo") - @result{} "~rms/foo" -@end group -@group -;; @r{The following example applies to VMS only.} -(file-name-sans-versions "foo;23") - @result{} "foo" -@end group -@end example -@end defun - -@defun file-name-sans-extension filename -This function returns @var{filename} minus its ``extension,'' if any. -The extension, in a file name, is the part that starts with the last -@samp{.} in the last name component. For example, - -@example -(file-name-sans-extension "foo.lose.c") - @result{} "foo.lose" -(file-name-sans-extension "big.hack/foo") - @result{} "big.hack/foo" -@end example -@end defun - -@node Directory Names -@subsection Directory Names -@cindex directory name -@cindex file name of directory - - A @dfn{directory name} is the name of a directory. A directory is a -kind of file, and it has a file name, which is related to the directory -name but not identical to it. (This is not quite the same as the usual -Unix terminology.) These two different names for the same entity are -related by a syntactic transformation. On Unix, this is simple: a -directory name ends in a slash, whereas the directory's name as a file -lacks that slash. On VMS, the relationship is more complicated. - - The difference between a directory name and its name as a file is -subtle but crucial. When an XEmacs variable or function argument is -described as being a directory name, a file name of a directory is not -acceptable. - - The following two functions convert between directory names and file -names. They do nothing special with environment variable substitutions -such as @samp{$HOME}, and the constructs @samp{~}, and @samp{..}. - -@defun file-name-as-directory filename -This function returns a string representing @var{filename} in a form -that the operating system will interpret as the name of a directory. In -Unix, this means appending a slash to the string. On VMS, the function -converts a string of the form @file{[X]Y.DIR.1} to the form -@file{[X.Y]}. - -@example -@group -(file-name-as-directory "~rms/lewis") - @result{} "~rms/lewis/" -@end group -@end example -@end defun - -@defun directory-file-name dirname -This function returns a string representing @var{dirname} in a form -that the operating system will interpret as the name of a file. On -Unix, this means removing a final slash from the string. On VMS, the -function converts a string of the form @file{[X.Y]} to -@file{[X]Y.DIR.1}. - -@example -@group -(directory-file-name "~lewis/") - @result{} "~lewis" -@end group -@end example -@end defun - -@cindex directory name abbreviation - Directory name abbreviations are useful for directories that are -normally accessed through symbolic links. Sometimes the users recognize -primarily the link's name as ``the name'' of the directory, and find it -annoying to see the directory's ``real'' name. If you define the link -name as an abbreviation for the ``real'' name, XEmacs shows users the -abbreviation instead. - - If you wish to convert a directory name to its abbreviation, use this -function: - -@defun abbreviate-file-name dirname &optional hack-homedir -This function applies abbreviations from @code{directory-abbrev-alist} -to its argument, and substitutes @samp{~} for the user's home -directory. - -@c XEmacs feature? -If @var{hack-homedir} is non-@code{nil}, then this also substitutes -@samp{~} for the user's home directory. - -@end defun - -@defvar directory-abbrev-alist -The variable @code{directory-abbrev-alist} contains an alist of -abbreviations to use for file directories. Each element has the form -@code{(@var{from} . @var{to})}, and says to replace @var{from} with -@var{to} when it appears in a directory name. The @var{from} string is -actually a regular expression; it should always start with @samp{^}. -The function @code{abbreviate-file-name} performs these substitutions. - -You can set this variable in @file{site-init.el} to describe the -abbreviations appropriate for your site. - -Here's an example, from a system on which file system @file{/home/fsf} -and so on are normally accessed through symbolic links named @file{/fsf} -and so on. - -@example -(("^/home/fsf" . "/fsf") - ("^/home/gp" . "/gp") - ("^/home/gd" . "/gd")) -@end example -@end defvar - -@c To convert a directory name to its abbreviation, use this -@c function: -@c -@c @defun abbreviate-file-name dirname -@c This function applies abbreviations from @code{directory-abbrev-alist} -@c to its argument, and substitutes @samp{~} for the user's home -@c directory. -@c @end defun - -@node Relative File Names -@subsection Absolute and Relative File Names -@cindex absolute file name -@cindex relative file name - - All the directories in the file system form a tree starting at the -root directory. A file name can specify all the directory names -starting from the root of the tree; then it is called an @dfn{absolute} -file name. Or it can specify the position of the file in the tree -relative to a default directory; then it is called a @dfn{relative} -file name. On Unix, an absolute file name starts with a slash or a -tilde (@samp{~}), and a relative one does not. The rules on VMS are -complicated. - -@defun file-name-absolute-p filename -This function returns @code{t} if file @var{filename} is an absolute -file name, @code{nil} otherwise. On VMS, this function understands both -Unix syntax and VMS syntax. - -@example -@group -(file-name-absolute-p "~rms/foo") - @result{} t -@end group -@group -(file-name-absolute-p "rms/foo") - @result{} nil -@end group -@group -(file-name-absolute-p "/user/rms/foo") - @result{} t -@end group -@end example -@end defun - -@node File Name Expansion -@subsection Functions that Expand Filenames -@cindex expansion of file names - - @dfn{Expansion} of a file name means converting a relative file name -to an absolute one. Since this is done relative to a default directory, -you must specify the default directory name as well as the file name to -be expanded. Expansion also simplifies file names by eliminating -redundancies such as @file{./} and @file{@var{name}/../}. - -@defun expand-file-name filename &optional directory -This function converts @var{filename} to an absolute file name. If -@var{directory} is supplied, it is the directory to start with if -@var{filename} is relative. (The value of @var{directory} should itself -be an absolute directory name; it may start with @samp{~}.) -Otherwise, the current buffer's value of @code{default-directory} is -used. For example: - -@example -@group -(expand-file-name "foo") - @result{} "/xcssun/users/rms/lewis/foo" -@end group -@group -(expand-file-name "../foo") - @result{} "/xcssun/users/rms/foo" -@end group -@group -(expand-file-name "foo" "/usr/spool/") - @result{} "/usr/spool/foo" -@end group -@group -(expand-file-name "$HOME/foo") - @result{} "/xcssun/users/rms/lewis/$HOME/foo" -@end group -@end example - -Filenames containing @samp{.} or @samp{..} are simplified to their -canonical form: - -@example -@group -(expand-file-name "bar/../foo") - @result{} "/xcssun/users/rms/lewis/foo" -@end group -@end example - -@samp{~/} at the beginning is expanded into the user's home directory. -A @samp{/} or @samp{~} following a @samp{/}. - -Note that @code{expand-file-name} does @emph{not} expand environment -variables; only @code{substitute-in-file-name} does that. -@end defun - -@c Emacs 19 feature -@defun file-relative-name filename &optional directory -This function does the inverse of expansion---it tries to return a -relative name that is equivalent to @var{filename} when interpreted -relative to @var{directory}. - -@c XEmacs feature? -If @var{directory} is @code{nil} or omitted, the value of -@code{default-directory} is used. - -@example -(file-relative-name "/foo/bar" "/foo/") - @result{} "bar") -(file-relative-name "/foo/bar" "/hack/") - @result{} "../foo/bar") -@end example -@end defun - -@defvar default-directory -The value of this buffer-local variable is the default directory for the -current buffer. It should be an absolute directory name; it may start -with @samp{~}. This variable is local in every buffer. - -@code{expand-file-name} uses the default directory when its second -argument is @code{nil}. - -On Unix systems, the value is always a string ending with a slash. - -@example -@group -default-directory - @result{} "/user/lewis/manual/" -@end group -@end example -@end defvar - -@defun substitute-in-file-name filename -This function replaces environment variable references in -@var{filename} with the environment variable values. Following standard -Unix shell syntax, @samp{$} is the prefix to substitute an environment -variable value. - -The environment variable name is the series of alphanumeric characters -(including underscores) that follow the @samp{$}. If the character following -the @samp{$} is a @samp{@{}, then the variable name is everything up to the -matching @samp{@}}. - -@c Wordy to avoid overfull hbox. --rjc 15mar92 -Here we assume that the environment variable @code{HOME}, which holds -the user's home directory name, has value @samp{/xcssun/users/rms}. - -@example -@group -(substitute-in-file-name "$HOME/foo") - @result{} "/xcssun/users/rms/foo" -@end group -@end example - -@c If a @samp{~} or a @samp{/} appears following a @samp{/}, after -@c substitution, everything before the following @samp{/} is discarded: - -After substitution, a @samp{/} or @samp{~} following a @samp{/} is taken -to be the start of an absolute file name that overrides what precedes -it, so everything before that @samp{/} or @samp{~} is deleted. For -example: - -@example -@group -(substitute-in-file-name "bar/~/foo") - @result{} "~/foo" -@end group -@group -(substitute-in-file-name "/usr/local/$HOME/foo") - @result{} "/xcssun/users/rms/foo" -@end group -@end example - -On VMS, @samp{$} substitution is not done, so this function does nothing -on VMS except discard superfluous initial components as shown above. -@end defun - -@node Unique File Names -@subsection Generating Unique File Names - - Some programs need to write temporary files. Here is the usual way to -construct a name for such a file: - -@example -(make-temp-name (expand-file-name @var{name-of-application} (temp-directory))) -@end example - -@noindent -Here we use @code{(temp-directory)} to specify a directory for temporary -files---under Unix, it will normally evaluate to @file{"/tmp/"}. The -job of @code{make-temp-name} is to prevent two different users or two -different processes from trying to use the same name. - -@defun temp-directory -This function returns the name of the directory to use for temporary -files. Under Unix, this will be the value of @code{TMPDIR}, defaulting -to @file{/tmp}. On Windows, this will be obtained from the @code{TEMP} -or @code{TMP} environment variables, defaulting to @file{/}. - -Note that the @code{temp-directory} function does not exist under FSF -Emacs. -@end defun - -@defun make-temp-name prefix -This function generates a temporary file name starting with -@var{prefix}. The Emacs process number forms part of the result, so -there is no danger of generating a name being used by another process. - -@example -@group -(make-temp-name "/tmp/foo") - @result{} "/tmp/fooGaAQjC" -@end group -@end example - -In addition, this function makes an attempt to choose a name that does -not specify an existing file. To make this work, @var{prefix} should be -an absolute file name. - -To avoid confusion, each Lisp application should preferably use a unique -@var{prefix} to @code{make-temp-name}. -@end defun - -@node File Name Completion -@subsection File Name Completion -@cindex file name completion subroutines -@cindex completion, file name - - This section describes low-level subroutines for completing a file -name. For other completion functions, see @ref{Completion}. - -@defun file-name-all-completions partial-filename directory -This function returns a list of all possible completions for a file -whose name starts with @var{partial-filename} in directory -@var{directory}. The order of the completions is the order of the files -in the directory, which is unpredictable and conveys no useful -information. - -The argument @var{partial-filename} must be a file name containing no -directory part and no slash. The current buffer's default directory is -prepended to @var{directory}, if @var{directory} is not absolute. - -In the following example, suppose that the current default directory, -@file{~rms/lewis}, has five files whose names begin with @samp{f}: -@file{foo}, @file{file~}, @file{file.c}, @file{file.c.~1~}, and -@file{file.c.~2~}.@refill - -@example -@group -(file-name-all-completions "f" "") - @result{} ("foo" "file~" "file.c.~2~" - "file.c.~1~" "file.c") -@end group - -@group -(file-name-all-completions "fo" "") - @result{} ("foo") -@end group -@end example -@end defun - -@defun file-name-completion filename directory -This function completes the file name @var{filename} in directory -@var{directory}. It returns the longest prefix common to all file names -in directory @var{directory} that start with @var{filename}. - -If only one match exists and @var{filename} matches it exactly, the -function returns @code{t}. The function returns @code{nil} if directory -@var{directory} contains no name starting with @var{filename}. - -In the following example, suppose that the current default directory -has five files whose names begin with @samp{f}: @file{foo}, -@file{file~}, @file{file.c}, @file{file.c.~1~}, and -@file{file.c.~2~}.@refill - -@example -@group -(file-name-completion "fi" "") - @result{} "file" -@end group - -@group -(file-name-completion "file.c.~1" "") - @result{} "file.c.~1~" -@end group - -@group -(file-name-completion "file.c.~1~" "") - @result{} t -@end group - -@group -(file-name-completion "file.c.~3" "") - @result{} nil -@end group -@end example -@end defun - -@defopt completion-ignored-extensions -@code{file-name-completion} usually ignores file names that end in any -string in this list. It does not ignore them when all the possible -completions end in one of these suffixes or when a buffer showing all -possible completions is displayed.@refill - -A typical value might look like this: - -@example -@group -completion-ignored-extensions - @result{} (".o" ".elc" "~" ".dvi") -@end group -@end example -@end defopt - -@node User Name Completion -@subsection User Name Completion -@cindex user name completion subroutines -@cindex completion, user name - - This section describes low-level subroutines for completing a user -name. For other completion functions, see @ref{Completion}. - -@defun user-name-all-completions partial-username -This function returns a list of all possible completions for a user -whose name starts with @var{partial-username}. The order of the -completions is unpredictable and conveys no useful information. - -The argument @var{partial-username} must be a partial user name -containing no tilde character and no slash. -@end defun - -@defun user-name-completion username -This function completes the user name @var{username}. It returns the -longest prefix common to all user names that start with @var{username}. - -If only one match exists and @var{username} matches it exactly, the -function returns @code{t}. The function returns @code{nil} if no user -name starting with @var{username} exists. -@end defun - -@defun user-name-completion-1 username -This function completes the user name @var{username}, like -@code{user-name-completion}, differing only in the return value. -This function returns the cons of the completion returned by -@code{user-name-completion}, and a boolean indicating whether that -completion was unique. -@end defun - - -@node Contents of Directories -@section Contents of Directories -@cindex directory-oriented functions -@cindex file names in directory - - A directory is a kind of file that contains other files entered under -various names. Directories are a feature of the file system. - - XEmacs can list the names of the files in a directory as a Lisp list, -or display the names in a buffer using the @code{ls} shell command. In -the latter case, it can optionally display information about each file, -depending on the value of switches passed to the @code{ls} command. - -@defun directory-files directory &optional full-name match-regexp nosort files-only -This function returns a list of the names of the files in the directory -@var{directory}. By default, the list is in alphabetical order. - -If @var{full-name} is non-@code{nil}, the function returns the files' -absolute file names. Otherwise, it returns just the names relative to -the specified directory. - -If @var{match-regexp} is non-@code{nil}, this function returns only -those file names that contain that regular expression---the other file -names are discarded from the list. - -@c Emacs 19 feature -If @var{nosort} is non-@code{nil}, @code{directory-files} does not sort -the list, so you get the file names in no particular order. Use this if -you want the utmost possible speed and don't care what order the files -are processed in. If the order of processing is visible to the user, -then the user will probably be happier if you do sort the names. - -@c XEmacs feature -If @var{files-only} is the symbol @code{t}, then only the ``files'' in -the directory will be returned; subdirectories will be excluded. If -@var{files-only} is not @code{nil} and not @code{t}, then only the -subdirectories will be returned. Otherwise, if @var{files-only} is -@code{nil} (the default) then both files and subdirectories will be -returned. - -@example -@group -(directory-files "~lewis") - @result{} ("#foo#" "#foo.el#" "." ".." - "dired-mods.el" "files.texi" - "files.texi.~1~") -@end group -@end example - -An error is signaled if @var{directory} is not the name of a directory -that can be read. -@end defun - -@ignore @c Not in XEmacs -@defun file-name-all-versions file dirname - This function returns a list of all versions of the file named -@var{file} in directory @var{dirname}. -@end defun -@end ignore - -@defun insert-directory file switches &optional wildcard full-directory-p -This function inserts (in the current buffer) a directory listing for -directory @var{file}, formatted with @code{ls} according to -@var{switches}. It leaves point after the inserted text. - -The argument @var{file} may be either a directory name or a file -specification including wildcard characters. If @var{wildcard} is -non-@code{nil}, that means treat @var{file} as a file specification with -wildcards. - -If @var{full-directory-p} is non-@code{nil}, that means @var{file} is a -directory and switches do not contain @samp{-d}, so that the listing -should show the full contents of the directory. (The @samp{-d} option -to @code{ls} says to describe a directory itself rather than its -contents.) - -This function works by running a directory listing program whose name is -in the variable @code{insert-directory-program}. If @var{wildcard} is -non-@code{nil}, it also runs the shell specified by -@code{shell-file-name}, to expand the wildcards. -@end defun - -@defvar insert-directory-program -This variable's value is the program to run to generate a directory listing -for the function @code{insert-directory}. -@end defvar - -@node Create/Delete Dirs -@section Creating and Deleting Directories -@c Emacs 19 features - - Most XEmacs Lisp file-manipulation functions get errors when used on -files that are directories. For example, you cannot delete a directory -with @code{delete-file}. These special functions exist to create and -delete directories. - -@deffn Command make-directory dirname &optional parents -This function creates a directory named @var{dirname}. Interactively, -the default choice of directory to create is the current default -directory for file names. That is useful when you have visited a file -in a nonexistent directory. - -@c XEmacs feature -Non-interactively, optional argument @var{parents} says whether to -create parent directories if they don't exist. (Interactively, this -always happens.) -@end deffn - -@deffn Command delete-directory dirname -This function deletes the directory named @var{dirname}. The function -@code{delete-file} does not work for files that are directories; you -must use @code{delete-directory} in that case. -@end deffn - -@node Magic File Names -@section Making Certain File Names ``Magic'' -@cindex magic file names - -@c Emacs 19 feature -You can implement special handling for certain file names. This is -called making those names @dfn{magic}. You must supply a regular -expression to define the class of names (all those that match the -regular expression), plus a handler that implements all the primitive -XEmacs file operations for file names that do match. - -The variable @code{file-name-handler-alist} holds a list of handlers, -together with regular expressions that determine when to apply each -handler. Each element has this form: - -@example -(@var{regexp} . @var{handler}) -@end example - -@noindent -All the XEmacs primitives for file access and file name transformation -check the given file name against @code{file-name-handler-alist}. If -the file name matches @var{regexp}, the primitives handle that file by -calling @var{handler}. - -The first argument given to @var{handler} is the name of the primitive; -the remaining arguments are the arguments that were passed to that -operation. (The first of these arguments is typically the file name -itself.) For example, if you do this: - -@example -(file-exists-p @var{filename}) -@end example - -@noindent -and @var{filename} has handler @var{handler}, then @var{handler} is -called like this: - -@example -(funcall @var{handler} 'file-exists-p @var{filename}) -@end example - -Here are the operations that a magic file name handler gets to handle: - -@noindent -@code{add-name-to-file}, @code{copy-file}, @code{delete-directory}, -@code{delete-file},@* -@code{diff-latest-backup-file}, -@code{directory-file-name}, -@code{directory-files}, -@code{dired-compress-file}, @code{dired-uncache}, -@code{expand-file-name},@* -@code{file-accessible-directory-p}, -@code{file-attributes}, @code{file-directory-p}, -@code{file-executable-p}, @code{file-exists-p}, @code{file-local-copy}, -@code{file-modes}, @code{file-name-all-completions}, -@code{file-name-as-directory}, @code{file-name-completion}, -@code{file-name-directory}, @code{file-name-nondirectory}, -@code{file-name-sans-versions}, @code{file-newer-than-file-p}, -@code{file-readable-p}, @code{file-regular-p}, @code{file-symlink-p}, -@code{file-truename}, @code{file-writable-p}, -@code{get-file-buffer}, -@code{insert-directory}, -@code{insert-file-contents}, @code{load}, @code{make-directory}, -@code{make-symbolic-link}, @code{rename-file}, @code{set-file-modes}, -@code{set-visited-file-modtime}, @code{unhandled-file-name-directory}, -@code{verify-visited-file-modtime}, @code{write-region}. - -Handlers for @code{insert-file-contents} typically need to clear the -buffer's modified flag, with @code{(set-buffer-modified-p nil)}, if the -@var{visit} argument is non-@code{nil}. This also has the effect of -unlocking the buffer if it is locked. - -The handler function must handle all of the above operations, and -possibly others to be added in the future. It need not implement all -these operations itself---when it has nothing special to do for a -certain operation, it can reinvoke the primitive, to handle the -operation ``in the usual way''. It should always reinvoke the primitive -for an operation it does not recognize. Here's one way to do this: - -@smallexample -(defun my-file-handler (operation &rest args) - ;; @r{First check for the specific operations} - ;; @r{that we have special handling for.} - (cond ((eq operation 'insert-file-contents) @dots{}) - ((eq operation 'write-region) @dots{}) - @dots{} - ;; @r{Handle any operation we don't know about.} - (t (let ((inhibit-file-name-handlers - (cons 'my-file-handler - (and (eq inhibit-file-name-operation operation) - inhibit-file-name-handlers))) - (inhibit-file-name-operation operation)) - (apply operation args))))) -@end smallexample - -When a handler function decides to call the ordinary Emacs primitive for -the operation at hand, it needs to prevent the primitive from calling -the same handler once again, thus leading to an infinite recursion. The -example above shows how to do this, with the variables -@code{inhibit-file-name-handlers} and -@code{inhibit-file-name-operation}. Be careful to use them exactly as -shown above; the details are crucial for proper behavior in the case of -multiple handlers, and for operations that have two file names that may -each have handlers. - -@defvar inhibit-file-name-handlers -This variable holds a list of handlers whose use is presently inhibited -for a certain operation. -@end defvar - -@defvar inhibit-file-name-operation -The operation for which certain handlers are presently inhibited. -@end defvar - -@defun find-file-name-handler file operation -This function returns the handler function for file name @var{file}, or -@code{nil} if there is none. The argument @var{operation} should be the -operation to be performed on the file---the value you will pass to the -handler as its first argument when you call it. The operation is needed -for comparison with @code{inhibit-file-name-operation}. -@end defun - -@defun file-local-copy filename -This function copies file @var{filename} to an ordinary non-magic file, -if it isn't one already. - -If @var{filename} specifies a ``magic'' file name, which programs -outside Emacs cannot directly read or write, this copies the contents to -an ordinary file and returns that file's name. - -If @var{filename} is an ordinary file name, not magic, then this function -does nothing and returns @code{nil}. -@end defun - -@defun unhandled-file-name-directory filename -This function returns the name of a directory that is not magic. -It uses the directory part of @var{filename} if that is not magic. -Otherwise, it asks the handler what to do. - -This is useful for running a subprocess; every subprocess must have a -non-magic directory to serve as its current directory, and this function -is a good way to come up with one. -@end defun - -@node Partial Files -@section Partial Files -@cindex partial files - -@menu -* Intro to Partial Files:: -* Creating a Partial File:: -* Detached Partial Files:: -@end menu - -@node Intro to Partial Files -@subsection Intro to Partial Files - -A @dfn{partial file} is a section of a buffer (called the @dfn{master -buffer}) that is placed in its own buffer and treated as its own file. -Changes made to the partial file are not reflected in the master buffer -until the partial file is ``saved'' using the standard buffer save -commands. Partial files can be ``reverted'' (from the master buffer) -just like normal files. When a file part is active on a master buffer, -that section of the master buffer is marked as read-only. Two file -parts on the same master buffer are not allowed to overlap. Partial -file buffers are indicated by the words @samp{File Part} in the -modeline. - -The master buffer knows about all the partial files that are active on -it, and thus killing or reverting the master buffer will be handled -properly. When the master buffer is saved, if there are any unsaved -partial files active on it then the user will be given the opportunity -to first save these files. - -When a partial file buffer is first modified, the master buffer is -automatically marked as modified so that saving the master buffer will -work correctly. - -@node Creating a Partial File -@subsection Creating a Partial File - -@defun make-file-part &optional start end name buffer -Make a file part on buffer @var{buffer} out of the region. Call it -@var{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 @dfn{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, @var{start}, -@var{end}, @var{name}, and @var{buffer}, all of which are optional and -default to the beginning of @var{buffer}, the end of @var{buffer}, a -name generated from @var{buffer} name, and the current buffer, -respectively. -@end defun - -@node Detached Partial Files -@subsection Detached Partial Files - -Every partial file has an extent in the master buffer associated with it -(called the @dfn{master extent}), marking where in the master buffer the -partial file begins and ends. If the text in master buffer that is -contained by the extent is deleted, then the extent becomes -``detached'', meaning that it no longer refers to a specific region of -the master buffer. This can happen either when the text is deleted -directly or when the master buffer is reverted. Neither of these should -happen in normal usage because the master buffer should generally not be -edited directly. - -Before doing any operation that references a partial file's master -extent, XEmacs checks to make sure that the extent is not detached. If -this is the case, XEmacs warns the user of this and the master extent is -deleted out of the master buffer, disconnecting the file part. The file -part's filename is cleared and thus must be explicitly specified if the -detached file part is to be saved. - -@node Format Conversion -@section File Format Conversion - -@cindex file format conversion -@cindex encoding file formats -@cindex decoding file formats - The variable @code{format-alist} defines a list of @dfn{file formats}, -which describe textual representations used in files for the data (text, -text-properties, and possibly other information) in an Emacs buffer. -Emacs performs format conversion if appropriate when reading and writing -files. - -@defvar format-alist -This list contains one format definition for each defined file format. -@end defvar - -@cindex format definition -Each format definition is a list of this form: - -@example -(@var{name} @var{doc-string} @var{regexp} @var{from-fn} @var{to-fn} @var{modify} @var{mode-fn}) -@end example - -Here is what the elements in a format definition mean: - -@table @var -@item name -The name of this format. - -@item doc-string -A documentation string for the format. - -@item regexp -A regular expression which is used to recognize files represented in -this format. - -@item from-fn -A function to call to decode data in this format (to convert file data into -the usual Emacs data representation). - -The @var{from-fn} is called with two args, @var{begin} and @var{end}, -which specify the part of the buffer it should convert. It should convert -the text by editing it in place. Since this can change the length of the -text, @var{from-fn} should return the modified end position. - -One responsibility of @var{from-fn} is to make sure that the beginning -of the file no longer matches @var{regexp}. Otherwise it is likely to -get called again. - -@item to-fn -A function to call to encode data in this format (to convert -the usual Emacs data representation into this format). - -The @var{to-fn} is called with two args, @var{begin} and @var{end}, -which specify the part of the buffer it should convert. There are -two ways it can do the conversion: - -@itemize @bullet -@item -By editing the buffer in place. In this case, @var{to-fn} should -return the end-position of the range of text, as modified. - -@item -By returning a list of annotations. This is a list of elements of the -form @code{(@var{position} . @var{string})}, where @var{position} is an -integer specifying the relative position in the text to be written, and -@var{string} is the annotation to add there. The list must be sorted in -order of position when @var{to-fn} returns it. - -When @code{write-region} actually writes the text from the buffer to the -file, it intermixes the specified annotations at the corresponding -positions. All this takes place without modifying the buffer. -@end itemize - -@item modify -A flag, @code{t} if the encoding function modifies the buffer, and -@code{nil} if it works by returning a list of annotations. - -@item mode -A mode function to call after visiting a file converted from this -format. -@end table - -The function @code{insert-file-contents} automatically recognizes file -formats when it reads the specified file. It checks the text of the -beginning of the file against the regular expressions of the format -definitions, and if it finds a match, it calls the decoding function for -that format. Then it checks all the known formats over again. -It keeps checking them until none of them is applicable. - -Visiting a file, with @code{find-file-noselect} or the commands that use -it, performs conversion likewise (because it calls -@code{insert-file-contents}); it also calls the mode function for each -format that it decodes. It stores a list of the format names in the -buffer-local variable @code{buffer-file-format}. - -@defvar buffer-file-format -This variable states the format of the visited file. More precisely, -this is a list of the file format names that were decoded in the course -of visiting the current buffer's file. It is always local in all -buffers. -@end defvar - -When @code{write-region} writes data into a file, it first calls the -encoding functions for the formats listed in @code{buffer-file-format}, -in the order of appearance in the list. - -@defun format-write-file file format -This command writes the current buffer contents into the file @var{file} -in format @var{format}, and makes that format the default for future -saves of the buffer. The argument @var{format} is a list of format -names. -@end defun - -@defun format-find-file file format -This command finds the file @var{file}, converting it according to -format @var{format}. It also makes @var{format} the default if the -buffer is saved later. - -The argument @var{format} is a list of format names. If @var{format} is -@code{nil}, no conversion takes place. Interactively, typing just -@key{RET} for @var{format} specifies @code{nil}. -@end defun - -@defun format-insert-file file format &optional beg end -This command inserts the contents of file @var{file}, converting it -according to format @var{format}. If @var{beg} and @var{end} are -non-@code{nil}, they specify which part of the file to read, as in -@code{insert-file-contents} (@pxref{Reading from Files}). - -The return value is like what @code{insert-file-contents} returns: a -list of the absolute file name and the length of the data inserted -(after conversion). - -The argument @var{format} is a list of format names. If @var{format} is -@code{nil}, no conversion takes place. Interactively, typing just -@key{RET} for @var{format} specifies @code{nil}. -@end defun - -@defun format-find-file file format -This command finds the file @var{file}, converting it according to -format @var{format}. It also makes @var{format} the default if the -buffer is saved later. - -The argument @var{format} is a list of format names. If @var{format} is -@code{nil}, no conversion takes place. Interactively, typing just -@key{RET} for @var{format} specifies @code{nil}. -@end defun - -@defun format-insert-file file format &optional beg end -This command inserts the contents of file @var{file}, converting it -according to format @var{format}. If @var{beg} and @var{end} are -non-@code{nil}, they specify which part of the file to read, -as in @code{insert-file-contents} (@pxref{Reading from Files}). - -The return value is like what @code{insert-file-contents} returns: a -list of the absolute file name and the length of the data inserted -(after conversion). - -The argument @var{format} is a list of format names. If @var{format} is -@code{nil}, no conversion takes place. Interactively, typing just -@key{RET} for @var{format} specifies @code{nil}. -@end defun - -@defvar auto-save-file-format -This variable specifies the format to use for auto-saving. Its value is -a list of format names, just like the value of -@code{buffer-file-format}; but it is used instead of -@code{buffer-file-format} for writing auto-save files. This variable -is always local in all buffers. -@end defvar - -@node Files and MS-DOS -@section Files and MS-DOS -@cindex MS-DOS file types -@cindex file types on MS-DOS -@cindex text files and binary files -@cindex binary files and text files - - Emacs on MS-DOS makes a distinction between text files and binary -files. This is necessary because ordinary text files on MS-DOS use a -two character sequence between lines: carriage-return and linefeed -(@sc{crlf}). Emacs expects just a newline character (a linefeed) between -lines. When Emacs reads or writes a text file on MS-DOS, it needs to -convert the line separators. This means it needs to know which files -are text files and which are binary. It makes this decision when -visiting a file, and records the decision in the variable -@code{buffer-file-type} for use when the file is saved. - - @xref{MS-DOS Subprocesses}, for a related feature for subprocesses. - -@defvar buffer-file-type -This variable, automatically local in each buffer, records the file type -of the buffer's visited file. The value is @code{nil} for text, -@code{t} for binary. -@end defvar - -@defun find-buffer-file-type filename -This function determines whether file @var{filename} is a text file -or a binary file. It returns @code{nil} for text, @code{t} for binary. -@end defun - -@defopt file-name-buffer-file-type-alist -This variable holds an alist for distinguishing text files from binary -files. Each element has the form (@var{regexp} . @var{type}), where -@var{regexp} is matched against the file name, and @var{type} may be is -@code{nil} for text, @code{t} for binary, or a function to call to -compute which. If it is a function, then it is called with a single -argument (the file name) and should return @code{t} or @code{nil}. -@end defopt - -@defopt default-buffer-file-type -This variable specifies the default file type for files whose names -don't indicate anything in particular. Its value should be @code{nil} -for text, or @code{t} for binary. -@end defopt - -@deffn Command find-file-text filename -Like @code{find-file}, but treat the file as text regardless of its name. -@end deffn - -@deffn Command find-file-binary filename -Like @code{find-file}, but treat the file as binary regardless of its -name. -@end deffn diff --git a/man/lispref/frames.texi b/man/lispref/frames.texi deleted file mode 100644 index fb7e633..0000000 --- a/man/lispref/frames.texi +++ /dev/null @@ -1,946 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c Copyright (C) 1995, 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/frames.info -@node Frames, Consoles and Devices, Windows, Top -@chapter Frames -@cindex frame - - A @var{frame} is a rectangle on the screen that contains one or more -XEmacs windows. A frame initially contains a single main window (plus -perhaps a minibuffer window), which you can subdivide vertically or -horizontally into smaller windows. - -@cindex terminal frame -@cindex X window frame - When XEmacs runs on a text-only terminal, it starts with one -@dfn{TTY frame}. If you create additional ones, XEmacs displays -one and only one at any given time---on the terminal screen, of course. - - When XEmacs communicates directly with an X server, it does not have a -TTY frame; instead, it starts with a single @dfn{X window frame}. -It can display multiple X window frames at the same time, each in its -own X window. - -@defun framep object -This predicate returns @code{t} if @var{object} is a frame, and -@code{nil} otherwise. -@end defun - -@menu -* Creating Frames:: Creating additional frames. -* Frame Properties:: Controlling frame size, position, font, etc. -* Frame Titles:: Automatic updating of frame titles. -* Deleting Frames:: Frames last until explicitly deleted. -* Finding All Frames:: How to examine all existing frames. -* Frames and Windows:: A frame contains windows; - display of text always works through windows. -* Minibuffers and Frames:: How a frame finds the minibuffer to use. -* Input Focus:: Specifying the selected frame. -* Visibility of Frames:: Frames may be visible or invisible, or icons. -* Raising and Lowering:: Raising a frame makes it hide other X windows; - lowering it makes the others hide them. -* Frame Configurations:: Saving the state of all frames. -* Frame Hooks:: Hooks for customizing frame behavior. -@end menu - - @xref{Display}, for related information. - -@node Creating Frames -@section Creating Frames - -To create a new frame, call the function @code{make-frame}. - -@defun make-frame &optional props device -This function creates a new frame on @var{device}, if @var{device} -permits creation of frames. (An X server does; an ordinary terminal -does not (yet).) @var{device} defaults to the selected device if omitted. -@xref{Consoles and Devices}. - -The argument @var{props} is a property list (a list of alternating -keyword-value specifications) of properties for the new frame. (An alist -is accepted for backward compatibility but should not be passed in.) Any -properties not mentioned in @var{props} default according to the value -of the variable @code{default-frame-plist}. For X devices, properties -not specified in @code{default-frame-plist} default in turn from -@code{default-x-frame-plist} and, if not specified there, from the X -resources. For TTY devices, @code{default-tty-frame-plist} is consulted -as well as @code{default-frame-plist}. - -The set of possible properties depends in principle on what kind of -window system XEmacs uses to display its frames. @xref{X Frame -Properties}, for documentation of individual properties you can specify -when creating an X window frame. -@end defun - -@node Frame Properties -@section Frame Properties - -A frame has many properties that control its appearance and behavior. -Just what properties a frame has depends on which display mechanism it -uses. - -Frame properties exist for the sake of window systems. A terminal frame -has few properties, mostly for compatibility's sake; only the height, -width and @code{buffer-predicate} properties really do something. - -@menu -* Property Access:: How to change a frame's properties. -* Initial Properties:: Specifying frame properties when you make a frame. -* X Frame Properties:: List of frame properties. -* Size and Position:: Changing the size and position of a frame. -* Frame Name:: The name of a frame (as opposed to its title). -@end menu - -@node Property Access -@subsection Access to Frame Properties - -These functions let you read and change the properties of a frame. - -@defun frame-properties &optional frame -This function returns a plist listing all the properties of @var{frame} -and their values. -@end defun - -@defun frame-property frame property &optional default -This function returns @var{frame}'s value for the property -@var{property}. -@end defun - -@defun set-frame-properties frame plist -This function alters the properties of frame @var{frame} based on the -elements of property list @var{plist}. If you don't mention a property -in @var{plist}, its value doesn't change. -@end defun - -@defun set-frame-property frame prop val -This function sets the property @var{prop} of frame @var{frame} to the -value @var{val}. -@end defun - -@node Initial Properties -@subsection Initial Frame Properties - -You can specify the properties for the initial startup frame by setting -@code{initial-frame-plist} in your @file{.emacs} file. - -@defvar initial-frame-plist -This variable's value is a plist of alternating property-value pairs -used when creating the initial X window frame. - -XEmacs creates the initial frame before it reads your @file{~/.emacs} -file. After reading that file, XEmacs checks @code{initial-frame-plist}, -and applies the property settings in the altered value to the already -created initial frame. - -If these settings affect the frame geometry and appearance, you'll see -the frame appear with the wrong ones and then change to the specified -ones. If that bothers you, you can specify the same geometry and -appearance with X resources; those do take affect before the frame is -created. @xref{Resources X,, X Resources, xemacs, The XEmacs User's Manual}. - -X resource settings typically apply to all frames. If you want to -specify some X resources solely for the sake of the initial frame, and -you don't want them to apply to subsequent frames, here's how to achieve -this: specify properties in @code{default-frame-plist} to override the X -resources for subsequent frames; then, to prevent these from affecting -the initial frame, specify the same properties in -@code{initial-frame-plist} with values that match the X resources. -@end defvar - -If these properties specify a separate minibuffer-only frame via a -@code{minibuffer} property of @code{nil}, and you have not yet created -one, XEmacs creates one for you. - -@defvar minibuffer-frame-plist -This variable's value is a plist of properties used when creating an -initial minibuffer-only frame---if such a frame is needed, according to -the properties for the main initial frame. -@end defvar - -@defvar default-frame-plist -This is a plist specifying default values of frame properties for -subsequent XEmacs frames (not the initial ones). -@end defvar - -See also @code{special-display-frame-plist}, in @ref{Choosing Window}. - -If you use options that specify window appearance when you invoke XEmacs, -they take effect by adding elements to @code{default-frame-plist}. One -exception is @samp{-geometry}, which adds the specified position to -@code{initial-frame-plist} instead. @xref{Command Arguments,,, xemacs, -The XEmacs User's Manual}. - -@node X Frame Properties -@subsection X Window Frame Properties - -Just what properties a frame has depends on what display mechanism it -uses. Here is a table of the properties of an X window frame; of these, -@code{name}, @code{height}, @code{width}, and @code{buffer-predicate} -provide meaningful information in non-X frames. - -@table @code -@item name -The name of the frame. Most window managers display the frame's name in -the frame's border, at the top of the frame. If you don't specify a -name, and you have more than one frame, XEmacs sets the frame name based -on the buffer displayed in the frame's selected window. - -If you specify the frame name explicitly when you create the frame, the -name is also used (instead of the name of the XEmacs executable) when -looking up X resources for the frame. - -@item display -The display on which to open this frame. It should be a string of the -form @code{"@var{host}:@var{dpy}.@var{screen}"}, just like the -@code{DISPLAY} environment variable. - -@item left -The screen position of the left edge, in pixels, with respect to the -left edge of the screen. The value may be a positive number @var{pos}, -or a list of the form @code{(+ @var{pos})} which permits specifying a -negative @var{pos} value. - -A negative number @minus{}@var{pos}, or a list of the form @code{(- -@var{pos})}, actually specifies the position of the right edge of the -window with respect to the right edge of the screen. A positive value -of @var{pos} counts toward the left. If the property is a negative -integer @minus{}@var{pos} then @var{pos} is positive! - -@item top -The screen position of the top edge, in pixels, with respect to the -top edge of the screen. The value may be a positive number @var{pos}, -or a list of the form @code{(+ @var{pos})} which permits specifying a -negative @var{pos} value. - -A negative number @minus{}@var{pos}, or a list of the form @code{(- -@var{pos})}, actually specifies the position of the bottom edge of the -window with respect to the bottom edge of the screen. A positive value -of @var{pos} counts toward the top. If the property is a negative -integer @minus{}@var{pos} then @var{pos} is positive! - -@item icon-left -The screen position of the left edge @emph{of the frame's icon}, in -pixels, counting from the left edge of the screen. This takes effect if -and when the frame is iconified. - -@item icon-top -The screen position of the top edge @emph{of the frame's icon}, in -pixels, counting from the top edge of the screen. This takes effect if -and when the frame is iconified. - -@item user-position -Non-@code{nil} if the screen position of the frame was explicitly -requested by the user (for example, with the @samp{-geometry} option). -Nothing automatically makes this property non-@code{nil}; it is up to -Lisp programs that call @code{make-frame} to specify this property as -well as specifying the @code{left} and @code{top} properties. - -@item height -The height of the frame contents, in characters. (To get the height in -pixels, call @code{frame-pixel-height}; see @ref{Size and Position}.) - -@item width -The width of the frame contents, in characters. (To get the height in -pixels, call @code{frame-pixel-width}; see @ref{Size and Position}.) - -@item window-id -The number of the X window for the frame. - -@item minibuffer -Whether this frame has its own minibuffer. The value @code{t} means -yes, @code{nil} means no, @code{only} means this frame is just a -minibuffer. If the value is a minibuffer window (in some other frame), -the new frame uses that minibuffer. (Minibuffer-only and minibuffer-less -frames are not yet implemented in XEmacs.) - -@item buffer-predicate -The buffer-predicate function for this frame. The function -@code{other-buffer} uses this predicate (from the selected frame) to -decide which buffers it should consider, if the predicate is not -@code{nil}. It calls the predicate with one arg, a buffer, once for -each buffer; if the predicate returns a non-@code{nil} value, it -considers that buffer. - -@item scroll-bar-width -The width of the vertical scroll bar, in pixels. - -@ignore Not in XEmacs -@item icon-type -The type of icon to use for this frame when it is iconified. If the -value is a string, that specifies a file containing a bitmap to use. -Any other non-@code{nil} value specifies the default bitmap icon (a -picture of a gnu); @code{nil} specifies a text icon. - -@item icon-name -The name to use in the icon for this frame, when and if the icon -appears. If this is @code{nil}, the frame's title is used. -@end ignore - -@item cursor-color -The color for the cursor that shows point. - -@item border-color -The color for the border of the frame. - -@ignore Not in XEmacs -@item cursor-type -The way to display the cursor. The legitimate values are @code{bar}, -@code{box}, and @code{(bar . @var{width})}. The symbol @code{box} -specifies an ordinary black box overlaying the character after point; -that is the default. The symbol @code{bar} specifies a vertical bar -between characters as the cursor. @code{(bar . @var{width})} specifies -a bar @var{width} pixels wide. -@end ignore - -@item border-width -The width in pixels of the window border. - -@item internal-border-width -The distance in pixels between text and border. - -@item unsplittable -If non-@code{nil}, this frame's window is never split automatically. - -@item inter-line-space -The space in pixels between adjacent lines of text. (Not currently -implemented.) - -@item modeline -Whether the frame has a modeline. -@end table - -@node Size and Position -@subsection Frame Size And Position -@cindex size of frame -@cindex frame size -@cindex display lines -@cindex display columns -@cindex resize redisplay -@cindex frame position -@cindex position of frame - - You can read or change the size and position of a frame using the -frame properties @code{left}, @code{top}, @code{height}, and -@code{width}. Whatever geometry properties you don't specify are chosen -by the window manager in its usual fashion. - - Here are some special features for working with sizes and positions: - -@defun set-frame-position frame left top -This function sets the position of the top left corner of @var{frame} to -@var{left} and @var{top}. These arguments are measured in pixels, and -count from the top left corner of the screen. Negative property values -count up or rightward from the top left corner of the screen. -@end defun - -@defun frame-height &optional frame -@defunx frame-width &optional frame -These functions return the height and width of @var{frame}, measured in -lines and columns. If you don't supply @var{frame}, they use the selected -frame. -@end defun - -@defun frame-pixel-height &optional frame -@defunx frame-pixel-width &optional frame -These functions return the height and width of @var{frame}, measured in -pixels. If you don't supply @var{frame}, they use the selected frame. -@end defun - -@defun set-frame-size frame cols rows &optional pretend -This function sets the size of @var{frame}, measured in characters; -@var{cols} and @var{rows} specify the new width and height. (If -@var{pretend} is non-nil, it means that redisplay should act as if -the frame's size is @var{cols} by @var{rows}, but the actual size -of the frame should not be changed. You should not normally use -this option.) -@end defun - - You can also use the functions @code{set-frame-height} and -@code{set-frame-width} to set the height and width individually. -The frame is the first argument and the size (in rows or columns) -is the second. (There is an optional third argument, @var{pretend}, -which has the same purpose as the corresponding argument in -@code{set-frame-size}.) - -@ignore @c Not in XEmacs -@defun x-parse-geometry geom -@cindex geometry specification -The function @code{x-parse-geometry} converts a standard X windows -geometry string to a plist that you can use as part of the argument to -@code{make-frame}. - -The plist describes which properties were specified in @var{geom}, and -gives the values specified for them. Each element looks like -@code{(@var{property} . @var{value})}. The possible @var{property} -values are @code{left}, @code{top}, @code{width}, and @code{height}. - -For the size properties, the value must be an integer. The position -property names @code{left} and @code{top} are not totally accurate, -because some values indicate the position of the right or bottom edges -instead. These are the @var{value} possibilities for the position -properties: - -@table @asis -@item an integer -A positive integer relates the left edge or top edge of the window to -the left or top edge of the screen. A negative integer relates the -right or bottom edge of the window to the right or bottom edge of the -screen. - -@item @code{(+ @var{position})} -This specifies the position of the left or top edge of the window -relative to the left or top edge of the screen. The integer -@var{position} may be positive or negative; a negative value specifies a -position outside the screen. - -@item @code{(- @var{position})} -This specifies the position of the right or bottom edge of the window -relative to the right or bottom edge of the screen. The integer -@var{position} may be positive or negative; a negative value specifies a -position outside the screen. -@end table - -Here is an example: - -@example -(x-parse-geometry "35x70+0-0") - @result{} ((width . 35) (height . 70) - (left . 0) (top - 0)) -@end example -@end defun -@end ignore - -@node Frame Name -@subsection The Name of a Frame (As Opposed to Its Title) -@cindex frame name - -Under X, every frame has a name, which is not the same as the title of -the frame. A frame's name is used to look up its resources and does -not normally change over the lifetime of a frame. It is perfectly -allowable, and quite common, for multiple frames to have the same -name. - -@defun frame-name &optional frame -This function returns the name of @var{frame}, which defaults to the -selected frame if not specified. The name of a frame can also be -obtained from the frame's properties. @xref{Frame Properties}. -@end defun - -@defvar default-frame-name -This variable holds the default name to assign to newly-created frames. -This can be overridden by arguments to @code{make-frame}. This -must be a string. -@end defvar - -@node Frame Titles -@section Frame Titles - -Every frame has a title; most window managers display the frame title at -the top of the frame. You can specify an explicit title with the -@code{name} frame property. But normally you don't specify this -explicitly, and XEmacs computes the title automatically. - -XEmacs computes the frame title based on a template stored in the -variable @code{frame-title-format}. - -@defvar frame-title-format -This variable specifies how to compute a title for a frame -when you have not explicitly specified one. - -The variable's value is actually a modeline construct, just like -@code{modeline-format}. @xref{Modeline Data}. -@end defvar - -@defvar frame-icon-title-format -This variable specifies how to compute the title for an iconified frame, -when you have not explicitly specified the frame title. This title -appears in the icon itself. -@end defvar - -@defun x-set-frame-icon-pixmap frame pixmap &optional mask -This function sets the icon of the given frame to the given image -instance, which should be an image instance object (as returned by -@code{make-image-instance}), a glyph object (as returned by -@code{make-glyph}), or @code{nil}. If a glyph object is given, the -glyph will be instantiated on the frame to produce an image instance -object. - -If the given image instance has a mask, that will be used as the icon mask; -however, not all window managers support this. - -The window manager is also not required to support color pixmaps, -only bitmaps (one plane deep). - -If the image instance does not have a mask, then the optional -third argument may be the image instance to use as the mask (it must be -one plane deep). -@xref{Glyphs}. -@end defun - -@node Deleting Frames -@section Deleting Frames -@cindex deletion of frames - -Frames remain potentially visible until you explicitly @dfn{delete} -them. A deleted frame cannot appear on the screen, but continues to -exist as a Lisp object until there are no references to it. - -@deffn Command delete-frame &optional frame -This function deletes the frame @var{frame}. By default, @var{frame} is -the selected frame. -@end deffn - -@defun frame-live-p frame -The function @code{frame-live-p} returns non-@code{nil} if the frame -@var{frame} has not been deleted. -@end defun - -@ignore Not in XEmacs currently - Some window managers provide a command to delete a window. These work -by sending a special message to the program that operates the window. -When XEmacs gets one of these commands, it generates a -@code{delete-frame} event, whose normal definition is a command that -calls the function @code{delete-frame}. @xref{Misc Events}. -@end ignore - -@node Finding All Frames -@section Finding All Frames - -@defun frame-list -The function @code{frame-list} returns a list of all the frames that -have not been deleted. It is analogous to @code{buffer-list} for -buffers. The list that you get is newly created, so modifying the list -doesn't have any effect on the internals of XEmacs. -@end defun - -@defun device-frame-list &optional device -This function returns a list of all frames on @var{device}. If -@var{device} is @code{nil}, the selected device will be used. -@end defun - -@defun visible-frame-list &optional device -This function returns a list of just the currently visible frames. -If @var{device} is specified only frames on that device will be returned. -@xref{Visibility of Frames}. (TTY frames always count as -``visible'', even though only the selected one is actually displayed.) -@end defun - -@defun next-frame &optional frame minibuf -The function @code{next-frame} lets you cycle conveniently through all -the frames from an arbitrary starting point. It returns the ``next'' -frame after @var{frame} in the cycle. If @var{frame} is omitted or -@code{nil}, it defaults to the selected frame. - -The second argument, @var{minibuf}, says which frames to consider: - -@table @asis -@item @code{nil} -Exclude minibuffer-only frames. -@item @code{visible} -Consider all visible frames. -@item 0 -Consider all visible or iconified frames. -@item a window -Consider only the frames using that particular window as their -minibuffer. -@item the symbol @code{visible} -Include all visible frames. -@item @code{0} -Include all visible and iconified frames. -@item anything else -Consider all frames. -@end table -@end defun - -@defun previous-frame &optional frame minibuf -Like @code{next-frame}, but cycles through all frames in the opposite -direction. -@end defun - - See also @code{next-window} and @code{previous-window}, in @ref{Cyclic -Window Ordering}. - -@node Frames and Windows -@section Frames and Windows - - Each window is part of one and only one frame; you can get the frame -with @code{window-frame}. - -@defun frame-root-window &optional frame -This returns the root window of frame @var{frame}. @var{frame} -defaults to the selected frame if not specified. -@end defun - -@defun window-frame &optional window -This function returns the frame that @var{window} is on. @var{window} -defaults to the selected window if omitted. -@end defun - - All the non-minibuffer windows in a frame are arranged in a cyclic -order. The order runs from the frame's top window, which is at the -upper left corner, down and to the right, until it reaches the window at -the lower right corner (always the minibuffer window, if the frame has -one), and then it moves back to the top. - -@defun frame-top-window frame -This returns the topmost, leftmost window of frame @var{frame}. -@end defun - -At any time, exactly one window on any frame is @dfn{selected within the -frame}. The significance of this designation is that selecting the -frame also selects this window. You can get the frame's current -selected window with @code{frame-selected-window}. - -@defun frame-selected-window &optional frame -This function returns the window on @var{frame} that is selected within -@var{frame}. @var{frame} defaults to the selected frame if not -specified. -@end defun - -Conversely, selecting a window for XEmacs with @code{select-window} also -makes that window selected within its frame. @xref{Selecting Windows}. - -Another function that (usually) returns one of the windows in a frame is -@code{minibuffer-window}. @xref{Minibuffer Misc}. - -@node Minibuffers and Frames -@section Minibuffers and Frames - -Normally, each frame has its own minibuffer window at the bottom, which -is used whenever that frame is selected. If the frame has a minibuffer, -you can get it with @code{minibuffer-window} (@pxref{Minibuffer Misc}). - -However, you can also create a frame with no minibuffer. Such a frame -must use the minibuffer window of some other frame. When you create the -frame, you can specify explicitly the minibuffer window to use (in some -other frame). If you don't, then the minibuffer is found in the frame -which is the value of the variable @code{default-minibuffer-frame}. Its -value should be a frame which does have a minibuffer. - -@ignore Not yet in XEmacs -If you use a minibuffer-only frame, you might want that frame to raise -when you enter the minibuffer. If so, set the variable -@code{minibuffer-auto-raise} to @code{t}. @xref{Raising and Lowering}. -@end ignore - -@defvar default-minibuffer-frame -This variable specifies the frame to use for the minibuffer window, by -default. -@end defvar - -@node Input Focus -@section Input Focus -@cindex input focus -@cindex selected frame - -At any time, one frame in XEmacs is the @dfn{selected frame}. The selected -window always resides on the selected frame. As the focus moves from -device to device, the selected frame on each device is remembered and -restored when the focus moves back to that device. - -@defun selected-frame &optional device -This function returns the selected frame on @var{device}. If -@var{device} is not specified, the selected device will be used. If no -frames exist on the device, @code{nil} is returned. -@end defun - -The X server normally directs keyboard input to the X window that the -mouse is in. Some window managers use mouse clicks or keyboard events -to @dfn{shift the focus} to various X windows, overriding the normal -behavior of the server. - -Lisp programs can switch frames ``temporarily'' by calling -the function @code{select-frame}. This does not override the window -manager; rather, it escapes from the window manager's control until -that control is somehow reasserted. - -When using a text-only terminal, there is no window manager; therefore, -@code{select-frame} is the only way to switch frames, and the effect -lasts until overridden by a subsequent call to @code{select-frame}. -Only the selected terminal frame is actually displayed on the terminal. -Each terminal screen except for the initial one has a number, and the -number of the selected frame appears in the mode line after the word -@samp{XEmacs} (@pxref{Modeline Variables}). - -@defun select-frame frame -This function selects frame @var{frame}, temporarily disregarding the -focus of the X server if any. The selection of @var{frame} lasts until -the next time the user does something to select a different frame, or -until the next time this function is called. - -Note that @code{select-frame} does not actually cause the window-system -focus to be set to this frame, or the @code{select-frame-hook} or -@code{deselect-frame-hook} to be run, until the next time that XEmacs is -waiting for an event. - -Also note that when the variable @code{focus-follows-mouse} is -non-@code{nil}, the frame selection is temporary and is reverted when -the current command terminates, much like the buffer selected by -@code{set-buffer}. In order to effect a permanent focus change use -@code{focus-frame}. -@end defun - -@defun focus-frame frame -This function selects @var{frame} and gives it the window system focus. -The operation of @code{focus-frame} is not affected by the value of -@code{focus-follows-mouse}. -@end defun - -@defmac save-selected-frame forms@dots{} -This macro records the selected frame, executes @var{forms} in sequence, -then restores the earlier selected frame. The value returned is the -value of the last form. -@end defmac - -@defmac with-selected-frame frame forms@dots{} -This macro records the selected frame, then selects @var{frame} and -executes @var{forms} in sequence. After the last form is finished, the -earlier selected frame is restored. The value returned is the value of -the last form. -@end defmac - -@ignore (FSF Emacs, continued from defun select-frame) -XEmacs cooperates with the X server and the window managers by arranging -to select frames according to what the server and window manager ask -for. It does so by generating a special kind of input event, called a -@dfn{focus} event. The command loop handles a focus event by calling -@code{handle-select-frame}. @xref{Focus Events}. - -@deffn Command handle-switch-frame frame -This function handles a focus event by selecting frame @var{frame}. - -Focus events normally do their job by invoking this command. -Don't call it for any other reason. -@end deffn - -@defun redirect-frame-focus frame focus-frame -This function redirects focus from @var{frame} to @var{focus-frame}. -This means that @var{focus-frame} will receive subsequent keystrokes -intended for @var{frame}. After such an event, the value of -@code{last-event-frame} will be @var{focus-frame}. Also, switch-frame -events specifying @var{frame} will instead select @var{focus-frame}. - -If @var{focus-frame} is @code{nil}, that cancels any existing -redirection for @var{frame}, which therefore once again receives its own -events. - -One use of focus redirection is for frames that don't have minibuffers. -These frames use minibuffers on other frames. Activating a minibuffer -on another frame redirects focus to that frame. This puts the focus on -the minibuffer's frame, where it belongs, even though the mouse remains -in the frame that activated the minibuffer. - -Selecting a frame can also change focus redirections. Selecting frame -@code{bar}, when @code{foo} had been selected, changes any redirections -pointing to @code{foo} so that they point to @code{bar} instead. This -allows focus redirection to work properly when the user switches from -one frame to another using @code{select-window}. - -This means that a frame whose focus is redirected to itself is treated -differently from a frame whose focus is not redirected. -@code{select-frame} affects the former but not the latter. - -The redirection lasts until @code{redirect-frame-focus} is called to -change it. -@end defun -@end ignore - -@node Visibility of Frames -@section Visibility of Frames -@cindex visible frame -@cindex invisible frame -@cindex iconified frame -@cindex frame visibility - -An X window frame may be @dfn{visible}, @dfn{invisible}, or -@dfn{iconified}. If it is visible, you can see its contents. If it is -iconified, the frame's contents do not appear on the screen, but an icon -does. If the frame is invisible, it doesn't show on the screen, not -even as an icon. - -Visibility is meaningless for TTY frames, since only the selected -one is actually displayed in any case. - -@deffn Command make-frame-visible &optional frame -This function makes frame @var{frame} visible. If you omit @var{frame}, -it makes the selected frame visible. -@end deffn - -@deffn Command make-frame-invisible &optional frame -This function makes frame @var{frame} invisible. -@end deffn - -@deffn Command iconify-frame &optional frame -This function iconifies frame @var{frame}. -@end deffn - -@deffn Command deiconify-frame &optional frame -This function de-iconifies frame @var{frame}. Under X, this is -equivalent to @code{make-frame-visible}. -@end deffn - -@defun frame-visible-p frame -This returns whether @var{frame} is currently ``visible'' (actually in -use for display). A frame that is not visible is not updated, and, if -it works through a window system, may not show at all. -@end defun - -@defun frame-iconified-p frame -This returns whether @var{frame} is iconified. Not all window managers -use icons; some merely unmap the window, so this function is not the -inverse of @code{frame-visible-p}. It is possible for a frame to not -be visible and not be iconified either. However, if the frame is -iconified, it will not be visible. (Under FSF Emacs, the functionality -of this function is obtained through @code{frame-visible-p}.) -@end defun - -@defun frame-totally-visible-p frame -This returns whether @var{frame} is not obscured by any other X -windows. On TTY frames, this is the same as @code{frame-visible-p}. -@end defun - -@ignore @c Not in XEmacs. - The visibility status of a frame is also available as a frame -property. You can read or change it as such. @xref{X Frame -Properties}. - -The user can iconify and deiconify frames with the window manager. This -happens below the level at which XEmacs can exert any control, but XEmacs -does provide events that you can use to keep track of such changes. -@xref{Misc Events}. -@end ignore - -@node Raising and Lowering -@section Raising and Lowering Frames - -The X Window System uses a desktop metaphor. Part of this metaphor is -the idea that windows are stacked in a notional third dimension -perpendicular to the screen surface, and thus ordered from ``highest'' -to ``lowest''. Where two windows overlap, the one higher up covers the -one underneath. Even a window at the bottom of the stack can be seen if -no other window overlaps it. - -@cindex raising a frame -@cindex lowering a frame -A window's place in this ordering is not fixed; in fact, users tend to -change the order frequently. @dfn{Raising} a window means moving it -``up'', to the top of the stack. @dfn{Lowering} a window means moving -it to the bottom of the stack. This motion is in the notional third -dimension only, and does not change the position of the window on the -screen. - -You can raise and lower XEmacs's X windows with these functions: - -@deffn Command raise-frame &optional frame -This function raises frame @var{frame}. -@end deffn - -@deffn Command lower-frame &optional frame -This function lowers frame @var{frame}. -@end deffn - -You can also specify auto-raise (raising automatically when a frame is -selected) or auto-lower (lowering automatically when it is deselected). -Under X, most ICCCM-compliant window managers will have an option to do -this for you, but the following variables are provided in case you're -using a broken WM. (Under FSF Emacs, the same functionality is -provided through the @code{auto-raise} and @code{auto-lower} -frame properties.) - -@defvar auto-raise-frame -This variable's value is @code{t} if frames will be raised to the top -when selected. -@end defvar - -@ignore Not in XEmacs -@defopt minibuffer-auto-raise -If this is non-@code{nil}, activation of the minibuffer raises the frame -that the minibuffer window is in. -@end defopt -@end ignore - -@defvar auto-lower-frame -This variable's value is @code{t} if frames will be lowered to the bottom -when no longer selected. -@end defvar - -Auto-raising and auto-lowering is implemented through functions attached -to @code{select-frame-hook} and @code{deselect-frame-hook} -(@pxref{Frame Hooks}). Under normal circumstances, you should not call -these functions directly. - -@defun default-select-frame-hook -This hook function implements the @code{auto-raise-frame} variable; it is -for use as the value of @code{select-frame-hook}. -@end defun - -@defun default-deselect-frame-hook -This hook function implements the @code{auto-lower-frame} variable; it is -for use as the value of @code{deselect-frame-hook}. -@end defun - -@node Frame Configurations -@section Frame Configurations -@cindex frame configuration - - A @dfn{frame configuration} records the current arrangement of frames, -all their properties, and the window configuration of each one. - -@defun current-frame-configuration -This function returns a frame configuration list that describes -the current arrangement of frames and their contents. -@end defun - -@defun set-frame-configuration configuration -This function restores the state of frames described in -@var{configuration}. -@end defun - -@node Frame Hooks -@section Hooks for Customizing Frame Behavior -@cindex frame hooks - -XEmacs provides many hooks that are called at various times during a -frame's lifetime. @xref{Hooks}. - -@defvar create-frame-hook -This hook is called each time a frame is created. The functions are called -with one argument, the newly-created frame. -@end defvar - -@defvar delete-frame-hook -This hook is called each time a frame is deleted. The functions are called -with one argument, the about-to-be-deleted frame. -@end defvar - -@defvar select-frame-hook -This is a normal hook that is run just after a frame is selected. The -function @code{default-select-frame-hook}, which implements auto-raising -(@pxref{Raising and Lowering}), is normally attached to this hook. - -Note that calling @code{select-frame} does not necessarily set the -focus: The actual window-system focus will not be changed until the next -time that XEmacs is waiting for an event, and even then, the window -manager may refuse the focus-change request. -@end defvar - -@defvar deselect-frame-hook -This is a normal hook that is run just before a frame is deselected -(and another frame is selected). The function -@code{default-deselect-frame-hook}, which implements auto-lowering -(@pxref{Raising and Lowering}), is normally attached to this hook. -@end defvar - -@defvar map-frame-hook -This hook is called each time a frame is mapped (i.e. made visible). -The functions are called with one argument, the newly mapped frame. -@end defvar - -@defvar unmap-frame-hook -This hook is called each time a frame is unmapped (i.e. made invisible -or iconified). The functions are called with one argument, the -newly unmapped frame. -@end defvar diff --git a/man/lispref/functions.texi b/man/lispref/functions.texi deleted file mode 100644 index e1aa70b..0000000 --- a/man/lispref/functions.texi +++ /dev/null @@ -1,1142 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/functions.info -@node Functions, Macros, Variables, Top -@chapter Functions - - A Lisp program is composed mainly of Lisp functions. This chapter -explains what functions are, how they accept arguments, and how to -define them. - -@menu -* What Is a Function:: Lisp functions vs. primitives; terminology. -* Lambda Expressions:: How functions are expressed as Lisp objects. -* Function Names:: A symbol can serve as the name of a function. -* Defining Functions:: Lisp expressions for defining functions. -* Calling Functions:: How to use an existing function. -* Mapping Functions:: Applying a function to each element of a list, etc. -* Anonymous Functions:: Lambda expressions are functions with no names. -* Function Cells:: Accessing or setting the function definition - of a symbol. -* Inline Functions:: Defining functions that the compiler will open code. -* Related Topics:: Cross-references to specific Lisp primitives - that have a special bearing on how functions work. -@end menu - -@node What Is a Function -@section What Is a Function? - - In a general sense, a function is a rule for carrying on a computation -given several values called @dfn{arguments}. The result of the -computation is called the value of the function. The computation can -also have side effects: lasting changes in the values of variables or -the contents of data structures. - - Here are important terms for functions in XEmacs Lisp and for other -function-like objects. - -@table @dfn -@item function -@cindex function -In XEmacs Lisp, a @dfn{function} is anything that can be applied to -arguments in a Lisp program. In some cases, we use it more -specifically to mean a function written in Lisp. Special forms and -macros are not functions. - -@item primitive -@cindex primitive -@cindex subr -@cindex built-in function -A @dfn{primitive} is a function callable from Lisp that is written in C, -such as @code{car} or @code{append}. These functions are also called -@dfn{built-in} functions or @dfn{subrs}. (Special forms are also -considered primitives.) - -Usually the reason that a function is a primitives is because it is -fundamental, because it provides a low-level interface to operating -system services, or because it needs to run fast. Primitives can be -modified or added only by changing the C sources and recompiling the -editor. See @ref{Writing Lisp Primitives,,, internals, XEmacs -Internals Manual}. - -@item lambda expression -A @dfn{lambda expression} is a function written in Lisp. -These are described in the following section. -@ifinfo -@xref{Lambda Expressions}. -@end ifinfo - -@item special form -A @dfn{special form} is a primitive that is like a function but does not -evaluate all of its arguments in the usual way. It may evaluate only -some of the arguments, or may evaluate them in an unusual order, or -several times. Many special forms are described in @ref{Control -Structures}. - -@item macro -@cindex macro -A @dfn{macro} is a construct defined in Lisp by the programmer. It -differs from a function in that it translates a Lisp expression that you -write into an equivalent expression to be evaluated instead of the -original expression. Macros enable Lisp programmers to do the sorts of -things that special forms can do. @xref{Macros}, for how to define and -use macros. - -@item command -@cindex command -A @dfn{command} is an object that @code{command-execute} can invoke; it -is a possible definition for a key sequence. Some functions are -commands; a function written in Lisp is a command if it contains an -interactive declaration (@pxref{Defining Commands}). Such a function -can be called from Lisp expressions like other functions; in this case, -the fact that the function is a command makes no difference. - -Keyboard macros (strings and vectors) are commands also, even though -they are not functions. A symbol is a command if its function -definition is a command; such symbols can be invoked with @kbd{M-x}. -The symbol is a function as well if the definition is a function. -@xref{Command Overview}. - -@item keystroke command -@cindex keystroke command -A @dfn{keystroke command} is a command that is bound to a key sequence -(typically one to three keystrokes). The distinction is made here -merely to avoid confusion with the meaning of ``command'' in non-Emacs -editors; for Lisp programs, the distinction is normally unimportant. - -@item compiled function -A @dfn{compiled function} is a function that has been compiled by the -byte compiler. @xref{Compiled-Function Type}. -@end table - -@defun subrp object -This function returns @code{t} if @var{object} is a built-in function -(i.e., a Lisp primitive). - -@example -@group -(subrp 'message) ; @r{@code{message} is a symbol,} - @result{} nil ; @r{not a subr object.} -@end group -@group -(subrp (symbol-function 'message)) - @result{} t -@end group -@end example -@end defun - -@defun compiled-function-p object -This function returns @code{t} if @var{object} is a compiled -function. For example: - -@example -@group -(compiled-function-p (symbol-function 'next-line)) - @result{} t -@end group -@end example -@end defun - -@node Lambda Expressions -@section Lambda Expressions -@cindex lambda expression - - A function written in Lisp is a list that looks like this: - -@example -(lambda (@var{arg-variables}@dots{}) - @r{[}@var{documentation-string}@r{]} - @r{[}@var{interactive-declaration}@r{]} - @var{body-forms}@dots{}) -@end example - -@noindent -Such a list is called a @dfn{lambda expression}. In XEmacs Lisp, it -actually is valid as an expression---it evaluates to itself. In some -other Lisp dialects, a lambda expression is not a valid expression at -all. In either case, its main use is not to be evaluated as an -expression, but to be called as a function. - -@menu -* Lambda Components:: The parts of a lambda expression. -* Simple Lambda:: A simple example. -* Argument List:: Details and special features of argument lists. -* Function Documentation:: How to put documentation in a function. -@end menu - -@node Lambda Components -@subsection Components of a Lambda Expression - -@ifinfo - - A function written in Lisp (a ``lambda expression'') is a list that -looks like this: - -@example -(lambda (@var{arg-variables}@dots{}) - [@var{documentation-string}] - [@var{interactive-declaration}] - @var{body-forms}@dots{}) -@end example -@end ifinfo - -@cindex lambda list - The first element of a lambda expression is always the symbol -@code{lambda}. This indicates that the list represents a function. The -reason functions are defined to start with @code{lambda} is so that -other lists, intended for other uses, will not accidentally be valid as -functions. - - The second element is a list of symbols--the argument variable names. -This is called the @dfn{lambda list}. When a Lisp function is called, -the argument values are matched up against the variables in the lambda -list, which are given local bindings with the values provided. -@xref{Local Variables}. - - The documentation string is a Lisp string object placed within the -function definition to describe the function for the XEmacs help -facilities. @xref{Function Documentation}. - - The interactive declaration is a list of the form @code{(interactive -@var{code-string})}. This declares how to provide arguments if the -function is used interactively. Functions with this declaration are called -@dfn{commands}; they can be called using @kbd{M-x} or bound to a key. -Functions not intended to be called in this way should not have interactive -declarations. @xref{Defining Commands}, for how to write an interactive -declaration. - -@cindex body of function - The rest of the elements are the @dfn{body} of the function: the Lisp -code to do the work of the function (or, as a Lisp programmer would say, -``a list of Lisp forms to evaluate''). The value returned by the -function is the value returned by the last element of the body. - -@node Simple Lambda -@subsection A Simple Lambda-Expression Example - - Consider for example the following function: - -@example -(lambda (a b c) (+ a b c)) -@end example - -@noindent -We can call this function by writing it as the @sc{car} of an -expression, like this: - -@example -@group -((lambda (a b c) (+ a b c)) - 1 2 3) -@end group -@end example - -@noindent -This call evaluates the body of the lambda expression with the variable -@code{a} bound to 1, @code{b} bound to 2, and @code{c} bound to 3. -Evaluation of the body adds these three numbers, producing the result 6; -therefore, this call to the function returns the value 6. - - Note that the arguments can be the results of other function calls, as in -this example: - -@example -@group -((lambda (a b c) (+ a b c)) - 1 (* 2 3) (- 5 4)) -@end group -@end example - -@noindent -This evaluates the arguments @code{1}, @code{(* 2 3)}, and @code{(- 5 -4)} from left to right. Then it applies the lambda expression to the -argument values 1, 6 and 1 to produce the value 8. - - It is not often useful to write a lambda expression as the @sc{car} of -a form in this way. You can get the same result, of making local -variables and giving them values, using the special form @code{let} -(@pxref{Local Variables}). And @code{let} is clearer and easier to use. -In practice, lambda expressions are either stored as the function -definitions of symbols, to produce named functions, or passed as -arguments to other functions (@pxref{Anonymous Functions}). - - However, calls to explicit lambda expressions were very useful in the -old days of Lisp, before the special form @code{let} was invented. At -that time, they were the only way to bind and initialize local -variables. - -@node Argument List -@subsection Advanced Features of Argument Lists -@kindex wrong-number-of-arguments -@cindex argument binding -@cindex binding arguments - - Our simple sample function, @code{(lambda (a b c) (+ a b c))}, -specifies three argument variables, so it must be called with three -arguments: if you try to call it with only two arguments or four -arguments, you get a @code{wrong-number-of-arguments} error. - - It is often convenient to write a function that allows certain -arguments to be omitted. For example, the function @code{substring} -accepts three arguments---a string, the start index and the end -index---but the third argument defaults to the @var{length} of the -string if you omit it. It is also convenient for certain functions to -accept an indefinite number of arguments, as the functions @code{list} -and @code{+} do. - -@cindex optional arguments -@cindex rest arguments -@kindex &optional -@kindex &rest - To specify optional arguments that may be omitted when a function -is called, simply include the keyword @code{&optional} before the optional -arguments. To specify a list of zero or more extra arguments, include the -keyword @code{&rest} before one final argument. - - Thus, the complete syntax for an argument list is as follows: - -@example -@group -(@var{required-vars}@dots{} - @r{[}&optional @var{optional-vars}@dots{}@r{]} - @r{[}&rest @var{rest-var}@r{]}) -@end group -@end example - -@noindent -The square brackets indicate that the @code{&optional} and @code{&rest} -clauses, and the variables that follow them, are optional. - - A call to the function requires one actual argument for each of the -@var{required-vars}. There may be actual arguments for zero or more of -the @var{optional-vars}, and there cannot be any actual arguments beyond -that unless the lambda list uses @code{&rest}. In that case, there may -be any number of extra actual arguments. - - If actual arguments for the optional and rest variables are omitted, -then they always default to @code{nil}. There is no way for the -function to distinguish between an explicit argument of @code{nil} and -an omitted argument. However, the body of the function is free to -consider @code{nil} an abbreviation for some other meaningful value. -This is what @code{substring} does; @code{nil} as the third argument to -@code{substring} means to use the length of the string supplied. - -@cindex CL note---default optional arg -@quotation -@b{Common Lisp note:} Common Lisp allows the function to specify what -default value to use when an optional argument is omitted; XEmacs Lisp -always uses @code{nil}. -@end quotation - - For example, an argument list that looks like this: - -@example -(a b &optional c d &rest e) -@end example - -@noindent -binds @code{a} and @code{b} to the first two actual arguments, which are -required. If one or two more arguments are provided, @code{c} and -@code{d} are bound to them respectively; any arguments after the first -four are collected into a list and @code{e} is bound to that list. If -there are only two arguments, @code{c} is @code{nil}; if two or three -arguments, @code{d} is @code{nil}; if four arguments or fewer, @code{e} -is @code{nil}. - - There is no way to have required arguments following optional -ones---it would not make sense. To see why this must be so, suppose -that @code{c} in the example were optional and @code{d} were required. -Suppose three actual arguments are given; which variable would the third -argument be for? Similarly, it makes no sense to have any more -arguments (either required or optional) after a @code{&rest} argument. - - Here are some examples of argument lists and proper calls: - -@smallexample -((lambda (n) (1+ n)) ; @r{One required:} - 1) ; @r{requires exactly one argument.} - @result{} 2 -((lambda (n &optional n1) ; @r{One required and one optional:} - (if n1 (+ n n1) (1+ n))) ; @r{1 or 2 arguments.} - 1 2) - @result{} 3 -((lambda (n &rest ns) ; @r{One required and one rest:} - (+ n (apply '+ ns))) ; @r{1 or more arguments.} - 1 2 3 4 5) - @result{} 15 -@end smallexample - -@node Function Documentation -@subsection Documentation Strings of Functions -@cindex documentation of function - - A lambda expression may optionally have a @dfn{documentation string} just -after the lambda list. This string does not affect execution of the -function; it is a kind of comment, but a systematized comment which -actually appears inside the Lisp world and can be used by the XEmacs help -facilities. @xref{Documentation}, for how the @var{documentation-string} is -accessed. - - It is a good idea to provide documentation strings for all the -functions in your program, even those that are only called from within -your program. Documentation strings are like comments, except that they -are easier to access. - - The first line of the documentation string should stand on its own, -because @code{apropos} displays just this first line. It should consist -of one or two complete sentences that summarize the function's purpose. - - The start of the documentation string is usually indented in the source file, -but since these spaces come before the starting double-quote, they are not part of -the string. Some people make a practice of indenting any additional -lines of the string so that the text lines up in the program source. -@emph{This is a mistake.} The indentation of the following lines is -inside the string; what looks nice in the source code will look ugly -when displayed by the help commands. - - You may wonder how the documentation string could be optional, since -there are required components of the function that follow it (the body). -Since evaluation of a string returns that string, without any side effects, -it has no effect if it is not the last form in the body. Thus, in -practice, there is no confusion between the first form of the body and the -documentation string; if the only body form is a string then it serves both -as the return value and as the documentation. - -@node Function Names -@section Naming a Function -@cindex function definition -@cindex named function -@cindex function name - - In most computer languages, every function has a name; the idea of a -function without a name is nonsensical. In Lisp, a function in the -strictest sense has no name. It is simply a list whose first element is -@code{lambda}, or a primitive subr-object. - - However, a symbol can serve as the name of a function. This happens -when you put the function in the symbol's @dfn{function cell} -(@pxref{Symbol Components}). Then the symbol itself becomes a valid, -callable function, equivalent to the list or subr-object that its -function cell refers to. The contents of the function cell are also -called the symbol's @dfn{function definition}. The procedure of using a -symbol's function definition in place of the symbol is called -@dfn{symbol function indirection}; see @ref{Function Indirection}. - - In practice, nearly all functions are given names in this way and -referred to through their names. For example, the symbol @code{car} works -as a function and does what it does because the primitive subr-object -@code{#} is stored in its function cell. - - We give functions names because it is convenient to refer to them by -their names in Lisp expressions. For primitive subr-objects such as -@code{#}, names are the only way you can refer to them: there -is no read syntax for such objects. For functions written in Lisp, the -name is more convenient to use in a call than an explicit lambda -expression. Also, a function with a name can refer to itself---it can -be recursive. Writing the function's name in its own definition is much -more convenient than making the function definition point to itself -(something that is not impossible but that has various disadvantages in -practice). - - We often identify functions with the symbols used to name them. For -example, we often speak of ``the function @code{car}'', not -distinguishing between the symbol @code{car} and the primitive -subr-object that is its function definition. For most purposes, there -is no need to distinguish. - - Even so, keep in mind that a function need not have a unique name. While -a given function object @emph{usually} appears in the function cell of only -one symbol, this is just a matter of convenience. It is easy to store -it in several symbols using @code{fset}; then each of the symbols is -equally well a name for the same function. - - A symbol used as a function name may also be used as a variable; -these two uses of a symbol are independent and do not conflict. - -@node Defining Functions -@section Defining Functions -@cindex defining a function - - We usually give a name to a function when it is first created. This -is called @dfn{defining a function}, and it is done with the -@code{defun} special form. - -@defspec defun name argument-list body-forms -@code{defun} is the usual way to define new Lisp functions. It -defines the symbol @var{name} as a function that looks like this: - -@example -(lambda @var{argument-list} . @var{body-forms}) -@end example - -@code{defun} stores this lambda expression in the function cell of -@var{name}. It returns the value @var{name}, but usually we ignore this -value. - -As described previously (@pxref{Lambda Expressions}), -@var{argument-list} is a list of argument names and may include the -keywords @code{&optional} and @code{&rest}. Also, the first two forms -in @var{body-forms} may be a documentation string and an interactive -declaration. - -There is no conflict if the same symbol @var{name} is also used as a -variable, since the symbol's value cell is independent of the function -cell. @xref{Symbol Components}. - -Here are some examples: - -@example -@group -(defun foo () 5) - @result{} foo -@end group -@group -(foo) - @result{} 5 -@end group - -@group -(defun bar (a &optional b &rest c) - (list a b c)) - @result{} bar -@end group -@group -(bar 1 2 3 4 5) - @result{} (1 2 (3 4 5)) -@end group -@group -(bar 1) - @result{} (1 nil nil) -@end group -@group -(bar) -@error{} Wrong number of arguments. -@end group - -@group -(defun capitalize-backwards () - "Upcase the last letter of a word." - (interactive) - (backward-word 1) - (forward-word 1) - (backward-char 1) - (capitalize-word 1)) - @result{} capitalize-backwards -@end group -@end example - -Be careful not to redefine existing functions unintentionally. -@code{defun} redefines even primitive functions such as @code{car} -without any hesitation or notification. Redefining a function already -defined is often done deliberately, and there is no way to distinguish -deliberate redefinition from unintentional redefinition. -@end defspec - -@defun define-function name definition -@defunx defalias name definition -These equivalent special forms define the symbol @var{name} as a -function, with definition @var{definition} (which can be any valid Lisp -function). - -The proper place to use @code{define-function} or @code{defalias} is -where a specific function name is being defined---especially where that -name appears explicitly in the source file being loaded. This is -because @code{define-function} and @code{defalias} record which file -defined the function, just like @code{defun}. -(@pxref{Unloading}). - -By contrast, in programs that manipulate function definitions for other -purposes, it is better to use @code{fset}, which does not keep such -records. -@end defun - - See also @code{defsubst}, which defines a function like @code{defun} -and tells the Lisp compiler to open-code it. @xref{Inline Functions}. - -@node Calling Functions -@section Calling Functions -@cindex function invocation -@cindex calling a function - - Defining functions is only half the battle. Functions don't do -anything until you @dfn{call} them, i.e., tell them to run. Calling a -function is also known as @dfn{invocation}. - - The most common way of invoking a function is by evaluating a list. -For example, evaluating the list @code{(concat "a" "b")} calls the -function @code{concat} with arguments @code{"a"} and @code{"b"}. -@xref{Evaluation}, for a description of evaluation. - - When you write a list as an expression in your program, the function -name is part of the program. This means that you choose which function -to call, and how many arguments to give it, when you write the program. -Usually that's just what you want. Occasionally you need to decide at -run time which function to call. To do that, use the functions -@code{funcall} and @code{apply}. - -@defun funcall function &rest arguments -@code{funcall} calls @var{function} with @var{arguments}, and returns -whatever @var{function} returns. - -Since @code{funcall} is a function, all of its arguments, including -@var{function}, are evaluated before @code{funcall} is called. This -means that you can use any expression to obtain the function to be -called. It also means that @code{funcall} does not see the expressions -you write for the @var{arguments}, only their values. These values are -@emph{not} evaluated a second time in the act of calling @var{function}; -@code{funcall} enters the normal procedure for calling a function at the -place where the arguments have already been evaluated. - -The argument @var{function} must be either a Lisp function or a -primitive function. Special forms and macros are not allowed, because -they make sense only when given the ``unevaluated'' argument -expressions. @code{funcall} cannot provide these because, as we saw -above, it never knows them in the first place. - -@example -@group -(setq f 'list) - @result{} list -@end group -@group -(funcall f 'x 'y 'z) - @result{} (x y z) -@end group -@group -(funcall f 'x 'y '(z)) - @result{} (x y (z)) -@end group -@group -(funcall 'and t nil) -@error{} Invalid function: # -@end group -@end example - -Compare these example with the examples of @code{apply}. -@end defun - -@defun apply function &rest arguments -@code{apply} calls @var{function} with @var{arguments}, just like -@code{funcall} but with one difference: the last of @var{arguments} is a -list of arguments to give to @var{function}, rather than a single -argument. We also say that @code{apply} @dfn{spreads} this list so that -each individual element becomes an argument. - -@code{apply} returns the result of calling @var{function}. As with -@code{funcall}, @var{function} must either be a Lisp function or a -primitive function; special forms and macros do not make sense in -@code{apply}. - -@example -@group -(setq f 'list) - @result{} list -@end group -@group -(apply f 'x 'y 'z) -@error{} Wrong type argument: listp, z -@end group -@group -(apply '+ 1 2 '(3 4)) - @result{} 10 -@end group -@group -(apply '+ '(1 2 3 4)) - @result{} 10 -@end group - -@group -(apply 'append '((a b c) nil (x y z) nil)) - @result{} (a b c x y z) -@end group -@end example - -For an interesting example of using @code{apply}, see the description of -@code{mapcar}, in @ref{Mapping Functions}. -@end defun - -@cindex functionals - It is common for Lisp functions to accept functions as arguments or -find them in data structures (especially in hook variables and property -lists) and call them using @code{funcall} or @code{apply}. Functions -that accept function arguments are often called @dfn{functionals}. - - Sometimes, when you call a functional, it is useful to supply a no-op -function as the argument. Here are two different kinds of no-op -function: - -@defun identity arg -This function returns @var{arg} and has no side effects. -@end defun - -@defun ignore &rest args -This function ignores any arguments and returns @code{nil}. -@end defun - -@node Mapping Functions -@section Mapping Functions -@cindex mapping functions - - A @dfn{mapping function} applies a given function to each element of a -list or other collection. XEmacs Lisp has three such functions; -@code{mapcar} and @code{mapconcat}, which scan a list, are described -here. For the third mapping function, @code{mapatoms}, see -@ref{Creating Symbols}. - -@defun mapcar function sequence -@code{mapcar} applies @var{function} to each element of @var{sequence} -in turn, and returns a list of the results. - -The argument @var{sequence} may be a list, a vector, or a string. The -result is always a list. The length of the result is the same as the -length of @var{sequence}. - -@smallexample -@group -@exdent @r{For example:} - -(mapcar 'car '((a b) (c d) (e f))) - @result{} (a c e) -(mapcar '1+ [1 2 3]) - @result{} (2 3 4) -(mapcar 'char-to-string "abc") - @result{} ("a" "b" "c") -@end group - -@group -;; @r{Call each function in @code{my-hooks}.} -(mapcar 'funcall my-hooks) -@end group - -@group -(defun mapcar* (f &rest args) - "Apply FUNCTION to successive cars of all ARGS. -Return the list of results." - ;; @r{If no list is exhausted,} - (if (not (memq 'nil args)) - ;; @r{apply function to @sc{CAR}s.} - (cons (apply f (mapcar 'car args)) - (apply 'mapcar* f - ;; @r{Recurse for rest of elements.} - (mapcar 'cdr args))))) -@end group - -@group -(mapcar* 'cons '(a b c) '(1 2 3 4)) - @result{} ((a . 1) (b . 2) (c . 3)) -@end group -@end smallexample -@end defun - -@defun mapconcat function sequence separator -@code{mapconcat} applies @var{function} to each element of -@var{sequence}: the results, which must be strings, are concatenated. -Between each pair of result strings, @code{mapconcat} inserts the string -@var{separator}. Usually @var{separator} contains a space or comma or -other suitable punctuation. - -The argument @var{function} must be a function that can take one -argument and return a string. - -@smallexample -@group -(mapconcat 'symbol-name - '(The cat in the hat) - " ") - @result{} "The cat in the hat" -@end group - -@group -(mapconcat (function (lambda (x) (format "%c" (1+ x)))) - "HAL-8000" - "") - @result{} "IBM.9111" -@end group -@end smallexample -@end defun - -@node Anonymous Functions -@section Anonymous Functions -@cindex anonymous function - - In Lisp, a function is a list that starts with @code{lambda}, a -byte-code function compiled from such a list, or alternatively a -primitive subr-object; names are ``extra''. Although usually functions -are defined with @code{defun} and given names at the same time, it is -occasionally more concise to use an explicit lambda expression---an -anonymous function. Such a list is valid wherever a function name is. - - Any method of creating such a list makes a valid function. Even this: - -@smallexample -@group -(setq silly (append '(lambda (x)) (list (list '+ (* 3 4) 'x)))) -@result{} (lambda (x) (+ 12 x)) -@end group -@end smallexample - -@noindent -This computes a list that looks like @code{(lambda (x) (+ 12 x))} and -makes it the value (@emph{not} the function definition!) of -@code{silly}. - - Here is how we might call this function: - -@example -@group -(funcall silly 1) -@result{} 13 -@end group -@end example - -@noindent -(It does @emph{not} work to write @code{(silly 1)}, because this function -is not the @emph{function definition} of @code{silly}. We have not given -@code{silly} any function definition, just a value as a variable.) - - Most of the time, anonymous functions are constants that appear in -your program. For example, you might want to pass one as an argument -to the function @code{mapcar}, which applies any given function to each -element of a list. Here we pass an anonymous function that multiplies -a number by two: - -@example -@group -(defun double-each (list) - (mapcar '(lambda (x) (* 2 x)) list)) -@result{} double-each -@end group -@group -(double-each '(2 11)) -@result{} (4 22) -@end group -@end example - -@noindent -In such cases, we usually use the special form @code{function} instead -of simple quotation to quote the anonymous function. - -@defspec function function-object -@cindex function quoting -This special form returns @var{function-object} without evaluating it. -In this, it is equivalent to @code{quote}. However, it serves as a -note to the XEmacs Lisp compiler that @var{function-object} is intended -to be used only as a function, and therefore can safely be compiled. -Contrast this with @code{quote}, in @ref{Quoting}. -@end defspec - - Using @code{function} instead of @code{quote} makes a difference -inside a function or macro that you are going to compile. For example: - -@example -@group -(defun double-each (list) - (mapcar (function (lambda (x) (* 2 x))) list)) -@result{} double-each -@end group -@group -(double-each '(2 11)) -@result{} (4 22) -@end group -@end example - -@noindent -If this definition of @code{double-each} is compiled, the anonymous -function is compiled as well. By contrast, in the previous definition -where ordinary @code{quote} is used, the argument passed to -@code{mapcar} is the precise list shown: - -@example -(lambda (x) (* x 2)) -@end example - -@noindent -The Lisp compiler cannot assume this list is a function, even though it -looks like one, since it does not know what @code{mapcar} does with the -list. Perhaps @code{mapcar} will check that the @sc{car} of the third -element is the symbol @code{*}! The advantage of @code{function} is -that it tells the compiler to go ahead and compile the constant -function. - - We sometimes write @code{function} instead of @code{quote} when -quoting the name of a function, but this usage is just a sort of -comment. - -@example -(function @var{symbol}) @equiv{} (quote @var{symbol}) @equiv{} '@var{symbol} -@end example - - See @code{documentation} in @ref{Accessing Documentation}, for a -realistic example using @code{function} and an anonymous function. - -@node Function Cells -@section Accessing Function Cell Contents - - The @dfn{function definition} of a symbol is the object stored in the -function cell of the symbol. The functions described here access, test, -and set the function cell of symbols. - - See also the function @code{indirect-function} in @ref{Function -Indirection}. - -@defun symbol-function symbol -@kindex void-function -This returns the object in the function cell of @var{symbol}. If the -symbol's function cell is void, a @code{void-function} error is -signaled. - -This function does not check that the returned object is a legitimate -function. - -@example -@group -(defun bar (n) (+ n 2)) - @result{} bar -@end group -@group -(symbol-function 'bar) - @result{} (lambda (n) (+ n 2)) -@end group -@group -(fset 'baz 'bar) - @result{} bar -@end group -@group -(symbol-function 'baz) - @result{} bar -@end group -@end example -@end defun - -@cindex void function cell - If you have never given a symbol any function definition, we say that -that symbol's function cell is @dfn{void}. In other words, the function -cell does not have any Lisp object in it. If you try to call such a symbol -as a function, it signals a @code{void-function} error. - - Note that void is not the same as @code{nil} or the symbol -@code{void}. The symbols @code{nil} and @code{void} are Lisp objects, -and can be stored into a function cell just as any other object can be -(and they can be valid functions if you define them in turn with -@code{defun}). A void function cell contains no object whatsoever. - - You can test the voidness of a symbol's function definition with -@code{fboundp}. After you have given a symbol a function definition, you -can make it void once more using @code{fmakunbound}. - -@defun fboundp symbol -This function returns @code{t} if the symbol has an object in its -function cell, @code{nil} otherwise. It does not check that the object -is a legitimate function. -@end defun - -@defun fmakunbound symbol -This function makes @var{symbol}'s function cell void, so that a -subsequent attempt to access this cell will cause a @code{void-function} -error. (See also @code{makunbound}, in @ref{Local Variables}.) - -@example -@group -(defun foo (x) x) - @result{} x -@end group -@group -(foo 1) - @result{}1 -@end group -@group -(fmakunbound 'foo) - @result{} x -@end group -@group -(foo 1) -@error{} Symbol's function definition is void: foo -@end group -@end example -@end defun - -@defun fset symbol object -This function stores @var{object} in the function cell of @var{symbol}. -The result is @var{object}. Normally @var{object} should be a function -or the name of a function, but this is not checked. - -There are three normal uses of this function: - -@itemize @bullet -@item -Copying one symbol's function definition to another. (In other words, -making an alternate name for a function.) - -@item -Giving a symbol a function definition that is not a list and therefore -cannot be made with @code{defun}. For example, you can use @code{fset} -to give a symbol @code{s1} a function definition which is another symbol -@code{s2}; then @code{s1} serves as an alias for whatever definition -@code{s2} presently has. - -@item -In constructs for defining or altering functions. If @code{defun} -were not a primitive, it could be written in Lisp (as a macro) using -@code{fset}. -@end itemize - -Here are examples of the first two uses: - -@example -@group -;; @r{Give @code{first} the same definition @code{car} has.} -(fset 'first (symbol-function 'car)) - @result{} # -@end group -@group -(first '(1 2 3)) - @result{} 1 -@end group - -@group -;; @r{Make the symbol @code{car} the function definition of @code{xfirst}.} -(fset 'xfirst 'car) - @result{} car -@end group -@group -(xfirst '(1 2 3)) - @result{} 1 -@end group -@group -(symbol-function 'xfirst) - @result{} car -@end group -@group -(symbol-function (symbol-function 'xfirst)) - @result{} # -@end group - -@group -;; @r{Define a named keyboard macro.} -(fset 'kill-two-lines "\^u2\^k") - @result{} "\^u2\^k" -@end group -@end example - -See also the related functions @code{define-function} and -@code{defalias}, in @ref{Defining Functions}. -@end defun - - When writing a function that extends a previously defined function, -the following idiom is sometimes used: - -@example -(fset 'old-foo (symbol-function 'foo)) -(defun foo () - "Just like old-foo, except more so." -@group - (old-foo) - (more-so)) -@end group -@end example - -@noindent -This does not work properly if @code{foo} has been defined to autoload. -In such a case, when @code{foo} calls @code{old-foo}, Lisp attempts -to define @code{old-foo} by loading a file. Since this presumably -defines @code{foo} rather than @code{old-foo}, it does not produce the -proper results. The only way to avoid this problem is to make sure the -file is loaded before moving aside the old definition of @code{foo}. - - But it is unmodular and unclean, in any case, for a Lisp file to -redefine a function defined elsewhere. - -@node Inline Functions -@section Inline Functions -@cindex inline functions - -@findex defsubst -You can define an @dfn{inline function} by using @code{defsubst} instead -of @code{defun}. An inline function works just like an ordinary -function except for one thing: when you compile a call to the function, -the function's definition is open-coded into the caller. - -Making a function inline makes explicit calls run faster. But it also -has disadvantages. For one thing, it reduces flexibility; if you change -the definition of the function, calls already inlined still use the old -definition until you recompile them. Since the flexibility of -redefining functions is an important feature of XEmacs, you should not -make a function inline unless its speed is really crucial. - -Another disadvantage is that making a large function inline can increase -the size of compiled code both in files and in memory. Since the speed -advantage of inline functions is greatest for small functions, you -generally should not make large functions inline. - -It's possible to define a macro to expand into the same code that an -inline function would execute. But the macro would have a limitation: -you can use it only explicitly---a macro cannot be called with -@code{apply}, @code{mapcar} and so on. Also, it takes some work to -convert an ordinary function into a macro. (@xref{Macros}.) To convert -it into an inline function is very easy; simply replace @code{defun} -with @code{defsubst}. Since each argument of an inline function is -evaluated exactly once, you needn't worry about how many times the -body uses the arguments, as you do for macros. (@xref{Argument -Evaluation}.) - -Inline functions can be used and open-coded later on in the same file, -following the definition, just like macros. - -@c Emacs versions prior to 19 did not have inline functions. - -@node Related Topics -@section Other Topics Related to Functions - - Here is a table of several functions that do things related to -function calling and function definitions. They are documented -elsewhere, but we provide cross references here. - -@table @code -@item apply -See @ref{Calling Functions}. - -@item autoload -See @ref{Autoload}. - -@item call-interactively -See @ref{Interactive Call}. - -@item commandp -See @ref{Interactive Call}. - -@item documentation -See @ref{Accessing Documentation}. - -@item eval -See @ref{Eval}. - -@item funcall -See @ref{Calling Functions}. - -@item ignore -See @ref{Calling Functions}. - -@item indirect-function -See @ref{Function Indirection}. - -@item interactive -See @ref{Using Interactive}. - -@item interactive-p -See @ref{Interactive Call}. - -@item mapatoms -See @ref{Creating Symbols}. - -@item mapcar -See @ref{Mapping Functions}. - -@item mapconcat -See @ref{Mapping Functions}. - -@item undefined -See @ref{Key Lookup}. -@end table - diff --git a/man/lispref/glyphs.texi b/man/lispref/glyphs.texi deleted file mode 100644 index 5abe4b6..0000000 --- a/man/lispref/glyphs.texi +++ /dev/null @@ -1,1054 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995, 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/glyphs.info -@node Glyphs, Annotations, Faces and Window-System Objects, top -@chapter Glyphs -@cindex glyphs - - A @dfn{glyph} is an object that is used for pixmaps and images of all -sorts, as well as for things that ``act'' like pixmaps, such as -non-textual strings (@dfn{annotations}) displayed in a buffer or in the -margins. It is used in begin-glyphs and end-glyphs attached to extents, -marginal and textual annotations, overlay arrows (@code{overlay-arrow-*} -variables), toolbar buttons, mouse pointers, frame icons, truncation and -continuation markers, and the like. (Basically, any place there is an -image or something that acts like an image, there will be a glyph object -representing it.) - - The actual image that is displayed (as opposed to its position or -clipping) is defined by an @dfn{image specifier} object contained -within the glyph. The separation between an image specifier object -and a glyph object is made because the glyph includes other properties -than just the actual image: e.g. the face it is displayed in (for text -images), the alignment of the image (when it is in a buffer), etc. - -@defun glyphp object -This function returns @code{t} if @var{object} is a glyph. -@end defun - -@menu -* Glyph Functions:: Functions for working with glyphs. -* Images:: Graphical images displayed in a frame. -* Glyph Types:: Each glyph has a particular type. -* Mouse Pointer:: Controlling the mouse pointer. -* Redisplay Glyphs:: Glyphs controlling various redisplay functions. -* Subwindows:: Inserting an externally-controlled subwindow - into a buffer. -@end menu - -@node Glyph Functions -@section Glyph Functions - -@menu -* Creating Glyphs:: Creating new glyphs. -* Glyph Properties:: Accessing and modifying a glyph's properties. -* Glyph Convenience Functions:: - Convenience functions for accessing particular - properties of a glyph. -* Glyph Dimensions:: Determining the height, width, etc. of a glyph. -@end menu - -@node Creating Glyphs -@subsection Creating Glyphs - -@defun make-glyph &optional spec-list type -This function creates a new glyph object of type @var{type}. - -@var{spec-list} is used to initialize the glyph's image. It is -typically an image instantiator (a string or a vector; @ref{Image -Specifiers}), but can also be a list of such instantiators (each one in -turn is tried until an image is successfully produced), a cons of a -locale (frame, buffer, etc.) and an instantiator, a list of such conses, -or any other form accepted by @code{canonicalize-spec-list}. -@xref{Specifiers} for more information about specifiers. - -@var{type} specifies the type of the glyph, which specifies in which -contexts the glyph can be used, and controls the allowable image types -into which the glyph's image can be instantiated. @var{type} should be -one of @code{buffer} (used for glyphs in an extent, the modeline, the -toolbar, or elsewhere in a buffer), @code{pointer} (used for the -mouse-pointer), or @code{icon} (used for a frame's icon), and defaults -to @code{buffer}. @xref{Glyph Types}. -@end defun - -@defun make-glyph-internal &optional type -This function creates a new, uninitialized glyph of type @var{type}. -@end defun - -@defun make-pointer-glyph &optional spec-list -This function is equivalent to calling @code{make-glyph} with a -@var{type} of @code{pointer}. -@end defun - -@defun make-icon-glyph &optional spec-list -This function is equivalent to calling @code{make-glyph} with a -@var{type} of @code{icon}. -@end defun - -@node Glyph Properties -@subsection Glyph Properties - -Each glyph has a list of properties, which control all of the aspects of -the glyph's appearance. The following symbols have predefined meanings: - -@table @code -@item image -The image used to display the glyph. - -@item baseline -Percent above baseline that glyph is to be displayed. Only for glyphs -displayed inside of a buffer. - -@item contrib-p -Whether the glyph contributes to the height of the line it's on. -Only for glyphs displayed inside of a buffer. - -@item face -Face of this glyph (@emph{not} a specifier). -@end table - -@defun set-glyph-property glyph property value &optional locale tag-set how-to-add -This function changes a property of a @var{glyph}. - -For built-in properties, the actual value of the property is a specifier -and you cannot change this; but you can change the specifications within -the specifier, and that is what this function will do. For user-defined -properties, you can use this function to either change the actual value -of the property or, if this value is a specifier, change the -specifications within it. - -If @var{property} is a built-in property, the specifications to be added -to this property can be supplied in many different ways: - -@itemize @bullet -@item -If @var{value} is a simple instantiator (e.g. a string naming a pixmap -filename) or a list of instantiators, then the instantiator(s) will be -added as a specification of the property for the given @var{locale} -(which defaults to @code{global} if omitted). - -@item -If @var{value} is a list of specifications (each of which is a cons of a -locale and a list of instantiators), then @var{locale} must be -@code{nil} (it does not make sense to explicitly specify a locale in -this case), and specifications will be added as given. - -@item -If @var{value} is a specifier (as would be returned by -@code{glyph-property} if no @var{locale} argument is given), then some -or all of the specifications in the specifier will be added to the -property. In this case, the function is really equivalent to -@code{copy-specifier} and @var{locale} has the same semantics (if it is -a particular locale, the specification for the locale will be copied; if -a locale type, specifications for all locales of that type will be -copied; if @code{nil} or @code{all}, then all specifications will be -copied). -@end itemize - -@var{how-to-add} should be either @code{nil} or one of the symbols -@code{prepend}, @code{append}, @code{remove-tag-set-prepend}, -@code{remove-tag-set-append}, @code{remove-locale}, -@code{remove-locale-type}, or @code{remove-all}. See -@code{copy-specifier} and @code{add-spec-to-specifier} for a description -of what each of these means. Most of the time, you do not need to worry -about this argument; the default behavior usually is fine. - -In general, it is OK to pass an instance object (e.g. as returned by -@code{glyph-property-instance}) as an instantiator in place of an actual -instantiator. In such a case, the instantiator used to create that -instance object will be used (for example, if you set a font-instance -object as the value of the @code{font} property, then the font name used -to create that object will be used instead). If some cases, however, -doing this conversion does not make sense, and this will be noted in the -documentation for particular types of instance objects. - -If @var{property} is not a built-in property, then this function will -simply set its value if @var{locale} is @code{nil}. However, if -@var{locale} is given, then this function will attempt to add -@var{value} as the instantiator for the given @var{locale}, using -@code{add-spec-to-specifier}. If the value of the property is not a -specifier, it will automatically be converted into a @code{generic} -specifier. -@end defun - -@defun glyph-property glyph property &optional locale -This function returns @var{glyph}'s value of the given @var{property}. - -If @var{locale} is omitted, the @var{glyph}'s actual value for -@var{property} will be returned. For built-in properties, this will be -a specifier object of a type appropriate to the property (e.g. a font or -color specifier). For other properties, this could be anything. - -If @var{locale} is supplied, then instead of returning the actual value, -the specification(s) for the given locale or locale type will be -returned. This will only work if the actual value of @var{property} is -a specifier (this will always be the case for built-in properties, but -may or may not apply to user-defined properties). If the actual value -of @var{property} is not a specifier, this value will simply be returned -regardless of @var{locale}. - -The return value will be a list of instantiators (e.g. vectors -specifying pixmap data), or a list of specifications, each of which is a -cons of a locale and a list of instantiators. Specifically, if -@var{locale} is a particular locale (a buffer, window, frame, device, or -@code{global}), a list of instantiators for that locale will be -returned. Otherwise, if @var{locale} is a locale type (one of the -symbols @code{buffer}, @code{window}, @code{frame}, or @code{device}), -the specifications for all locales of that type will be returned. -Finally, if @var{locale} is @code{all}, the specifications for all -locales of all types will be returned. - -The specifications in a specifier determine what the value of -@var{property} will be in a particular @dfn{domain} or set of -circumstances, which is typically a particular Emacs window along with -the buffer it contains and the frame and device it lies within. The -value is derived from the instantiator associated with the most specific -locale (in the order buffer, window, frame, device, and @code{global}) -that matches the domain in question. In other words, given a domain -(i.e. an Emacs window, usually), the specifier for @var{property} will -first be searched for a specification whose locale is the buffer -contained within that window; then for a specification whose locale is -the window itself; then for a specification whose locale is the frame -that the window is contained within; etc. The first instantiator that -is valid for the domain (usually this means that the instantiator is -recognized by the device [i.e. the X server or TTY device] that the -domain is on). The function @code{glyph-property-instance} actually does -all this, and is used to determine how to display the glyph. -@end defun - -@defun glyph-property-instance glyph property &optional domain default no-fallback -This function returns the instance of @var{glyph}'s @var{property} in the -specified @var{domain}. - -Under most circumstances, @var{domain} will be a particular window, and -the returned instance describes how the specified property actually is -displayed for that window and the particular buffer in it. Note that -this may not be the same as how the property appears when the buffer is -displayed in a different window or frame, or how the property appears in -the same window if you switch to another buffer in that window; and in -those cases, the returned instance would be different. - -The returned instance is an image-instance object, and you can query it -using the appropriate image instance functions. For example, you could use -@code{image-instance-depth} to find out the depth (number of color -planes) of a pixmap displayed in a particular window. The results might -be different from the results you would get for another window (perhaps -the user specified a different image for the frame that window is on; or -perhaps the same image was specified but the window is on a different X -server, and that X server has different color capabilities from this -one). - -@var{domain} defaults to the selected window if omitted. - -@var{domain} can be a frame or device, instead of a window. The value -returned for such a domain is used in special circumstances when a -more specific domain does not apply; for example, a frame value might be -used for coloring a toolbar, which is conceptually attached to a frame -rather than a particular window. The value is also useful in -determining what the value would be for a particular window within the -frame or device, if it is not overridden by a more specific -specification. - -If @var{property} does not name a built-in property, its value will -simply be returned unless it is a specifier object, in which case it -will be instanced using @code{specifier-instance}. - -Optional arguments @var{default} and @var{no-fallback} are the same as -in @code{specifier-instance}. @xref{Specifiers}. -@end defun - -@defun remove-glyph-property glyph property &optional locale tag-set exact-p -This function removes a property from a glyph. For built-in properties, -this is analogous to @code{remove-specifier}. @xref{Specifiers, -remove-specifier-p}, for the meaning of the @var{locale}, @var{tag-set}, -and @var{exact-p} arguments. -@end defun - -@node Glyph Convenience Functions -@subsection Glyph Convenience Functions - - The following functions are provided for working with specific -properties of a glyph. Note that these are exactly like calling -the general functions described above and passing in the -appropriate value for @var{property}. - - Remember that if you want to determine the ``value'' of a -specific glyph property, you probably want to use the @code{*-instance} -functions. For example, to determine whether a glyph contributes -to its line height, use @code{glyph-contrib-p-instance}, not -@code{glyph-contrib-p}. (The latter will return a boolean specifier -or a list of specifications, and you probably aren't concerned with -these.) - -@defun glyph-image glyph &optional locale -This function is equivalent to calling @code{glyph-property} with -a property of @code{image}. The return value will be an image -specifier if @var{locale} is @code{nil} or omitted; otherwise, -it will be a specification or list of specifications. -@end defun - -@defun set-glyph-image glyph spec &optional locale tag-set how-to-add -This function is equivalent to calling @code{set-glyph-property} with -a property of @code{image}. -@end defun - -@defun glyph-image-instance glyph &optional domain default no-fallback -This function returns the instance of @var{glyph}'s image in the given -@var{domain}, and is equivalent to calling -@code{glyph-property-instance} with a property of @code{image}. The -return value will be an image instance. - -Normally @var{domain} will be a window or @code{nil} (meaning the -selected window), and an instance object describing how the image -appears in that particular window and buffer will be returned. -@end defun - -@defun glyph-contrib-p glyph &optional locale -This function is equivalent to calling @code{glyph-property} with -a property of @code{contrib-p}. The return value will be a boolean -specifier if @var{locale} is @code{nil} or omitted; otherwise, -it will be a specification or list of specifications. -@end defun - -@defun set-glyph-contrib-p glyph spec &optional locale tag-set how-to-add -This function is equivalent to calling @code{set-glyph-property} with -a property of @code{contrib-p}. -@end defun - -@defun glyph-contrib-p-instance glyph &optional domain default no-fallback -This function returns whether the glyph contributes to its line height -in the given @var{domain}, and is equivalent to calling -@code{glyph-property-instance} with a property of @code{contrib-p}. The -return value will be either @code{nil} or @code{t}. (Normally @var{domain} -will be a window or @code{nil}, meaning the selected window.) -@end defun - -@defun glyph-baseline glyph &optional locale -This function is equivalent to calling @code{glyph-property} with a -property of @code{baseline}. The return value will be a specifier if -@var{locale} is @code{nil} or omitted; otherwise, it will be a -specification or list of specifications. -@end defun - -@defun set-glyph-baseline glyph spec &optional locale tag-set how-to-add -This function is equivalent to calling @code{set-glyph-property} with -a property of @code{baseline}. -@end defun - -@defun glyph-baseline-instance glyph &optional domain default no-fallback -This function returns the instance of @var{glyph}'s baseline value in -the given @var{domain}, and is equivalent to calling -@code{glyph-property-instance} with a property of @code{baseline}. The -return value will be an integer or @code{nil}. - -Normally @var{domain} will be a window or @code{nil} (meaning the -selected window), and an instance object describing the baseline value -appears in that particular window and buffer will be returned. -@end defun - -@defun glyph-face glyph -This function returns the face of @var{glyph}. (Remember, this is -not a specifier, but a simple property.) -@end defun - -@defun set-glyph-face glyph face -This function changes the face of @var{glyph} to @var{face}. -@end defun - -@node Glyph Dimensions -@subsection Glyph Dimensions - -@defun glyph-width glyph &optional window -This function returns the width of @var{glyph} on @var{window}. This -may not be exact as it does not take into account all of the context -that redisplay will. -@end defun - -@defun glyph-ascent glyph &optional window -This function returns the ascent value of @var{glyph} on @var{window}. -This may not be exact as it does not take into account all of the -context that redisplay will. -@end defun - -@defun glyph-descent glyph &optional window -This function returns the descent value of @var{glyph} on @var{window}. -This may not be exact as it does not take into account all of the -context that redisplay will. -@end defun - -@defun glyph-height glyph &optional window -This function returns the height of @var{glyph} on @var{window}. (This -is equivalent to the sum of the ascent and descent values.) This may -not be exact as it does not take into account all of the context that -redisplay will. -@end defun - -@node Images -@section Images - -@menu -* Image Specifiers:: Specifying how an image will appear. -* Image Instantiator Conversion:: - Conversion is applied to image instantiators - at the time they are added to an - image specifier or at the time they - are passed to @code{make-image-instance}. -* Image Instances:: What an image specifier gets instanced as. -@end menu - -@node Image Specifiers -@subsection Image Specifiers -@cindex image specifiers - - An image specifier is used to describe the actual image of a glyph. -It works like other specifiers (@pxref{Specifiers}), in that it contains -a number of specifications describing how the image should appear in a -variety of circumstances. These specifications are called @dfn{image -instantiators}. When XEmacs wants to display the image, it instantiates -the image into an @dfn{image instance}. Image instances are their own -primitive object type (similar to font instances and color instances), -describing how the image appears in a particular domain. (On the other -hand, image instantiators, which are just descriptions of how the image -should appear, are represented using strings or vectors.) - -@defun image-specifier-p object -This function returns non-@code{nil} if @var{object} is an image specifier. -Usually, an image specifier results from calling @code{glyph-image} on -a glyph. -@end defun - -@defun make-image-specifier spec-list -This function creates a new image specifier object and initializes -it according to @var{spec-list}. It is unlikely that you will ever -want to do this, but this function is provided for completeness and -for experimentation purposes. @xref{Specifiers}. -@end defun - - Image instantiators come in many formats: @code{xbm}, @code{xpm}, -@code{gif}, @code{jpeg}, etc. This describes the format of the data -describing the image. The resulting image instances also come in many -types -- @code{mono-pixmap}, @code{color-pixmap}, @code{text}, -@code{pointer}, etc. This refers to the behavior of the image and the -sorts of places it can appear. (For example, a color-pixmap image has -fixed colors specified for it, while a mono-pixmap image comes in two -unspecified shades ``foreground'' and ``background'' that are determined -from the face of the glyph or surrounding text; a text image appears as -a string of text and has an unspecified foreground, background, and -font; a pointer image behaves like a mono-pixmap image but can only be -used as a mouse pointer [mono-pixmap images cannot be used as mouse -pointers]; etc.) It is important to keep the distinction between image -instantiator format and image instance type in mind. Typically, a given -image instantiator format can result in many different image instance -types (for example, @code{xpm} can be instanced as @code{color-pixmap}, -@code{mono-pixmap}, or @code{pointer}; whereas @code{cursor-font} can be -instanced only as @code{pointer}), and a particular image instance type -can be generated by many different image instantiator formats (e.g. -@code{color-pixmap} can be generated by @code{xpm}, @code{gif}, -@code{jpeg}, etc.). - - @xref{Image Instances} for a more detailed discussion of image -instance types. - - An image instantiator should be a string or a vector of the form - -@example - @code{[@var{format} @var{:keyword} @var{value} ...]} -@end example - -i.e. a format symbol followed by zero or more alternating keyword-value -pairs. The @dfn{format} field should be a symbol, one of - -@table @code -@item nothing -(Don't display anything; no keywords are valid for this. Can only be -instanced as @code{nothing}.) -@item string -(Display this image as a text string. Can only be instanced -as @code{text}, although support for instancing as @code{mono-pixmap} -should be added.) -@item formatted-string -(Display this image as a text string with replaceable fields, -similar to a modeline format string; not currently implemented.) -@item xbm -(An X bitmap; only if X support was compiled into this XEmacs. Can be -instanced as @code{mono-pixmap}, @code{color-pixmap}, or -@code{pointer}.) -@item xpm -(An XPM pixmap; only if XPM support was compiled into this XEmacs. Can -be instanced as @code{color-pixmap}, @code{mono-pixmap}, or -@code{pointer}. XPM is an add-on library for X that was designed to -rectify the shortcomings of the XBM format. Most implementations of X -include the XPM library as a standard part. If your vendor does not, it -is highly recommended that you download it and install it. You can get -it from the standard XEmacs FTP site, among other places.) -@item xface -(An X-Face bitmap, used to encode people's faces in e-mail messages; -only if X-Face support was compiled into this XEmacs. Can be instanced -as @code{mono-pixmap}, @code{color-pixmap}, or @code{pointer}.) -@item gif -(A GIF87 or GIF89 image; only if GIF support was compiled into this -XEmacs. Can be instanced as @code{color-pixmap}. Note that XEmacs -includes GIF decoding functions as a standard part of it, so if you have -X support, you will normally have GIF support, unless you explicitly -disable it at configure time.) -@item jpeg -(A JPEG-format image; only if JPEG support was compiled into this -XEmacs. Can be instanced as @code{color-pixmap}. If you have the JPEG -libraries present on your system when XEmacs is built, XEmacs will -automatically detect this and use them, unless you explicitly disable it -at configure time.) -@item png -(A PNG/GIF24 image; only if PNG support was compiled into this XEmacs. -Can be instanced as @code{color-pixmap}.) -@item tiff -(A TIFF-format image; only if TIFF support was compiled into this XEmacs. -Not currently implemented.) -@item cursor-font -(One of the standard cursor-font names, such as @samp{watch} or -@samp{right_ptr} under X. Under X, this is, more specifically, any of -the standard cursor names from appendix B of the Xlib manual [also known -as the file @file{}] minus the @samp{XC_} prefix. On -other window systems, the valid names will be specific to the type of -window system. Can only be instanced as @code{pointer}.) -@item font -(A glyph from a font; i.e. the name of a font, and glyph index into it -of the form @samp{@var{font} fontname index [[mask-font] mask-index]}. -Only if X support was compiled into this XEmacs. Currently can only be -instanced as @code{pointer}, although this should probably be fixed.) -@item subwindow -(An embedded X window; not currently implemented.) -@item autodetect -(XEmacs tries to guess what format the data is in. If X support exists, -the data string will be checked to see if it names a filename. If so, -and this filename contains XBM or XPM data, the appropriate sort of -pixmap or pointer will be created. [This includes picking up any -specified hotspot or associated mask file.] Otherwise, if @code{pointer} -is one of the allowable image-instance types and the string names a -valid cursor-font name, the image will be created as a pointer. -Otherwise, the image will be displayed as text. If no X support exists, -the image will always be displayed as text.) -@end table - -The valid keywords are: - -@table @code -@item :data -(Inline data. For most formats above, this should be a string. For -XBM images, this should be a list of three elements: width, height, and -a string of bit data. This keyword is not valid for instantiator -format @code{nothing}.) - -@item :file -(Data is contained in a file. The value is the name of this file. If -both @code{:data} and @code{:file} are specified, the image is created -from what is specified in @code{:data} and the string in @code{:file} -becomes the value of the @code{image-instance-file-name} function when -applied to the resulting image-instance. This keyword is not valid for -instantiator formats @code{nothing}, @code{string}, -@code{formatted-string}, @code{cursor-font}, @code{font}, and -@code{autodetect}.) - -@item :foreground -@itemx :background -(For @code{xbm}, @code{xface}, @code{cursor-font}, and @code{font}. -These keywords allow you to explicitly specify foreground and background -colors. The argument should be anything acceptable to -@code{make-color-instance}. This will cause what would be a -@code{mono-pixmap} to instead be colorized as a two-color color-pixmap, -and specifies the foreground and/or background colors for a pointer -instead of black and white.) - -@item :mask-data -(For @code{xbm} and @code{xface}. This specifies a mask to be used with the -bitmap. The format is a list of width, height, and bits, like for -@code{:data}.) - -@item :mask-file -(For @code{xbm} and @code{xface}. This specifies a file containing the -mask data. If neither a mask file nor inline mask data is given for an -XBM image, and the XBM image comes from a file, XEmacs will look for a -mask file with the same name as the image file but with @samp{Mask} or -@samp{msk} appended. For example, if you specify the XBM file -@file{left_ptr} [usually located in @file{/usr/include/X11/bitmaps}], -the associated mask file @file{left_ptrmsk} will automatically be picked -up.) - -@item :hotspot-x -@itemx :hotspot-y -(For @code{xbm} and @code{xface}. These keywords specify a hotspot if -the image is instantiated as a @code{pointer}. Note that if the XBM -image file specifies a hotspot, it will automatically be picked up if no -explicit hotspot is given.) - -@item :color-symbols -(Only for @code{xpm}. This specifies an alist that maps strings that -specify symbolic color names to the actual color to be used for that -symbolic color (in the form of a string or a color-specifier object). -If this is not specified, the contents of @code{xpm-color-symbols} are -used to generate the alist.) -@end table - -If instead of a vector, the instantiator is a string, it will be -converted into a vector by looking it up according to the specs in the -@code{console-type-image-conversion-list} for the console type of -the domain (usually a window; sometimes a frame or device) over which -the image is being instantiated. - -If the instantiator specifies data from a file, the data will be read in -at the time that the instantiator is added to the image specifier (which -may be well before the image is actually displayed), and the -instantiator will be converted into one of the inline-data forms, with -the filename retained using a @code{:file} keyword. This implies that -the file must exist when the instantiator is added to the image, but -does not need to exist at any other time (e.g. it may safely be a -temporary file). - -@defun valid-image-instantiator-format-p format -This function returns non-@code{nil} if @var{format} is a valid image -instantiator format. Note that the return value for many formats listed -above depends on whether XEmacs was compiled with support for that format. -@end defun - -@defun image-instantiator-format-list -This function return a list of valid image-instantiator formats. -@end defun - -@defvar xpm-color-symbols -This variable holds definitions of logical color-names used when reading -XPM files. Elements of this list should be of the form -@code{(@var{color-name} @var{form-to-evaluate})}. The @var{color-name} -should be a string, which is the name of the color to define; the -@var{form-to-evaluate} should evaluate to a color specifier object, or a -string to be passed to @code{make-color-instance} (@pxref{Colors}). If -a loaded XPM file references a symbolic color called @var{color-name}, -it will display as the computed color instead. - -The default value of this variable defines the logical color names -@samp{"foreground"} and @samp{"background"} to be the colors of the -@code{default} face. -@end defvar - -@defvar x-bitmap-file-path -A list of the directories in which X bitmap files may be found. If nil, -this is initialized from the @samp{"*bitmapFilePath"} resource. This is -used by the @code{make-image-instance} function (however, note that if -the environment variable @samp{XBMLANGPATH} is set, it is consulted -first). -@end defvar - -@node Image Instantiator Conversion -@subsection Image Instantiator Conversion -@cindex image instantiator conversion -@cindex conversion of image instantiators - -@defun set-console-type-image-conversion-list console-type list -This function sets the image-conversion-list for consoles of the given -@var{console-type}. The image-conversion-list specifies how image -instantiators that are strings should be interpreted. Each element of -the list should be a list of two elements (a regular expression string -and a vector) or a list of three elements (the preceding two plus an -integer index into the vector). The string is converted to the vector -associated with the first matching regular expression. If a vector -index is specified, the string itself is substituted into that position -in the vector. - -Note: The conversion above is applied when the image instantiator is -added to an image specifier, not when the specifier is actually -instantiated. Therefore, changing the image-conversion-list only affects -newly-added instantiators. Existing instantiators in glyphs and image -specifiers will not be affected. -@end defun - -@defun console-type-image-conversion-list console-type -This function returns the image-conversion-list for consoles of the given -@var{console-type}. -@end defun - -@node Image Instances -@subsection Image Instances -@cindex image instances - - Image-instance objects encapsulate the way a particular image (pixmap, -etc.) is displayed on a particular device. - - In most circumstances, you do not need to directly create image -instances; use a glyph instead. However, it may occasionally be useful -to explicitly create image instances, if you want more control over the -instantiation process. - -@defun image-instance-p object -This function returns non-@code{nil} if @var{object} is an image instance. -@end defun - -@menu -* Image Instance Types:: Each image instances has a particular type. -* Image Instance Functions:: Functions for working with image instances. -@end menu - -@node Image Instance Types -@subsubsection Image Instance Types -@cindex image instance types - - Image instances come in a number of different types. The type -of an image instance specifies the nature of the image: Whether -it is a text string, a mono pixmap, a color pixmap, etc. - - The valid image instance types are - -@table @code -@item nothing -Nothing is displayed. - -@item text -Displayed as text. The foreground and background colors and the -font of the text are specified independent of the pixmap. Typically -these attributes will come from the face of the surrounding text, -unless a face is specified for the glyph in which the image appears. - -@item mono-pixmap -Displayed as a mono pixmap (a pixmap with only two colors where the -foreground and background can be specified independent of the pixmap; -typically the pixmap assumes the foreground and background colors of -the text around it, unless a face is specified for the glyph in which -the image appears). -@item color-pixmap - -Displayed as a color pixmap. - -@item pointer -Used as the mouse pointer for a window. - -@item subwindow -A child window that is treated as an image. This allows (e.g.) -another program to be responsible for drawing into the window. -Not currently implemented. -@end table - -@defun valid-image-instance-type-p type -This function returns non-@code{nil} if @var{type} is a valid image -instance type. -@end defun - -@defun image-instance-type-list -This function returns a list of the valid image instance types. -@end defun - -@defun image-instance-type image-instance -This function returns the type of the given image instance. The return -value will be one of @code{nothing}, @code{text}, @code{mono-pixmap}, -@code{color-pixmap}, @code{pointer}, or @code{subwindow}. -@end defun - -@defun text-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{text}. -@end defun - -@defun mono-pixmap-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{mono-pixmap}. -@end defun - -@defun color-pixmap-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{color-pixmap}. -@end defun - -@defun pointer-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{pointer}. -@end defun - -@defun subwindow-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{subwindow}. -@end defun - -@defun nothing-image-instance-p object -This function returns non-@code{nil} if @var{object} is an image -instance of type @code{nothing}. -@end defun - -@node Image Instance Functions -@subsubsection Image Instance Functions - -@defun make-image-instance data &optional device dest-types no-error -This function creates a new image-instance object. - -@var{data} is an image instantiator, which describes the image -(@pxref{Image Specifiers}). - -@var{dest-types} should be a list of allowed image instance types that -can be generated. The @var{dest-types} list is unordered. If multiple -destination types are possible for a given instantiator, the ``most -natural'' type for the instantiator's format is chosen. (For XBM, the -most natural types are @code{mono-pixmap}, followed by -@code{color-pixmap}, followed by @code{pointer}. For the other normal -image formats, the most natural types are @code{color-pixmap}, followed -by @code{mono-pixmap}, followed by @code{pointer}. For the string and -formatted-string formats, the most natural types are @code{text}, -followed by @code{mono-pixmap} (not currently implemented), followed by -@code{color-pixmap} (not currently implemented). The other formats can -only be instantiated as one type. (If you want to control more -specifically the order of the types into which an image is instantiated, -just call @code{make-image-instance} repeatedly until it succeeds, -passing less and less preferred destination types each time. - -If @var{dest-types} is omitted, all possible types are allowed. - -@var{no-error} controls what happens when the image cannot be generated. -If @var{nil}, an error message is generated. If @var{t}, no messages -are generated and this function returns @var{nil}. If anything else, a -warning message is generated and this function returns @var{nil}. -@end defun - -@defun colorize-image-instance image-instance foreground background -This function makes the image instance be displayed in the given -colors. Image instances come in two varieties: bitmaps, which are 1 -bit deep which are rendered in the prevailing foreground and background -colors; and pixmaps, which are of arbitrary depth (including 1) and -which have the colors explicitly specified. This function converts a -bitmap to a pixmap. If the image instance was a pixmap already, -nothing is done (and @code{nil} is returned). Otherwise @code{t} is -returned. -@end defun - -@defun image-instance-name image-instance -This function returns the name of the given image instance. -@end defun - -@defun image-instance-string image-instance -This function returns the string of the given image instance. This will -only be non-@code{nil} for text image instances. -@end defun - -@defun image-instance-file-name image-instance -This function returns the file name from which @var{image-instance} was -read, if known. -@end defun - -@defun image-instance-mask-file-name image-instance -This function returns the file name from which @var{image-instance}'s -mask was read, if known. -@end defun - -@defun image-instance-depth image-instance -This function returns the depth of the image instance. This is 0 for a -mono pixmap, or a positive integer for a color pixmap. -@end defun - -@defun image-instance-height image-instance -This function returns the height of the image instance, in pixels. -@end defun - -@defun image-instance-width image-instance -This function returns the width of the image instance, in pixels. -@end defun - -@defun image-instance-hotspot-x image-instance -This function returns the X coordinate of the image instance's hotspot, -if known. This is a point relative to the origin of the pixmap. When -an image is used as a mouse pointer, the hotspot is the point on the -image that sits over the location that the pointer points to. This is, -for example, the tip of the arrow or the center of the crosshairs. - -This will always be @code{nil} for a non-pointer image instance. -@end defun - -@defun image-instance-hotspot-y image-instance -This function returns the Y coordinate of the image instance's hotspot, -if known. -@end defun - -@defun image-instance-foreground image-instance -This function returns the foreground color of @var{image-instance}, if -applicable. This will be a color instance or @code{nil}. (It will only -be non-@code{nil} for colorized mono pixmaps and for pointers.) -@end defun - -@defun image-instance-background image-instance -This function returns the background color of @var{image-instance}, if -applicable. This will be a color instance or @code{nil}. (It will only -be non-@code{nil} for colorized mono pixmaps and for pointers.) -@end defun - - -@node Glyph Types -@section Glyph Types - - Each glyph has a particular type, which controls how the glyph's image -is generated. Each glyph type has a corresponding list of allowable -image instance types that can be generated. When you call -@code{glyph-image-instance} to retrieve the image instance of a glyph, -XEmacs does the equivalent of calling @code{make-image-instance} and -passing in @var{dest-types} the list of allowable image instance types -for the glyph's type. - -@itemize @bullet -@item -@code{buffer} glyphs can be used as the begin-glyph or end-glyph of an -extent, in the modeline, and in the toolbar. Their image can be -instantiated as @code{nothing}, @code{mono-pixmap}, @code{color-pixmap}, -@code{text}, and @code{subwindow}. - -@item -@code{pointer} glyphs can be used to specify the mouse pointer. Their -image can be instantiated as @code{pointer}. - -@item -@code{icon} glyphs can be used to specify the icon used when a frame is -iconified. Their image can be instantiated as @code{mono-pixmap} and -@code{color-pixmap}. -@end itemize - -@defun glyph-type glyph -This function returns the type of the given glyph. The return value -will be a symbol, one of @code{buffer}, @code{pointer}, or @code{icon}. -@end defun - -@defun valid-glyph-type-p glyph-type -Given a @var{glyph-type}, this function returns non-@code{nil} if it is -valid. -@end defun - -@defun glyph-type-list -This function returns a list of valid glyph types. -@end defun - -@defun buffer-glyph-p object -This function returns non-@code{nil} if @var{object} is a glyph of type -@code{buffer}. -@end defun - -@defun icon-glyph-p object -This function returns non-@code{nil} if @var{object} is a glyph of type -@code{icon}. -@end defun - -@defun pointer-glyph-p object -This function returns non-@code{nil} if @var{object} is a glyph of type -@code{pointer}. -@end defun - -@node Mouse Pointer -@section Mouse Pointer -@cindex mouse cursor -@cindex cursor (mouse) -@cindex pointer (mouse) -@cindex mouse pointer - -The shape of the mouse pointer when over a particular section of a frame -is controlled using various glyph variables. Since the image of a glyph -is a specifier, it can be controlled on a per-buffer, per-frame, per-window, -or per-device basis. - -You should use @code{set-glyph-image} to set the following variables, -@emph{not} @code{setq}. - -@defvr Glyph text-pointer-glyph -This variable specifies the shape of the mouse pointer when over text. -@end defvr - -@defvr Glyph nontext-pointer-glyph -This variable specifies the shape of the mouse pointer when over a -buffer, but not over text. If unspecified in a particular domain, -@code{text-pointer-glyph} is used. -@end defvr - -@defvr Glyph modeline-pointer-glyph -This variable specifies the shape of the mouse pointer when over the modeline. -If unspecified in a particular domain, @code{nontext-pointer-glyph} is used. -@end defvr - -@defvr Glyph selection-pointer-glyph -This variable specifies the shape of the mouse pointer when over a -selectable text region. If unspecified in a particular domain, -@code{text-pointer-glyph} is used. -@end defvr - -@defvr Glyph gc-pointer-glyph -This variable specifies the shape of the mouse pointer when a garbage -collection is in progress. If the selected window is on a window system -and this glyph specifies a value (i.e. a pointer image instance) in the -domain of the selected window, the pointer will be changed as specified -during garbage collection. Otherwise, a message will be printed in the -echo area, as controlled by @code{gc-message}. -@end defvr - -@defvr Glyph busy-pointer-glyph -This variable specifies the shape of the mouse pointer when XEmacs is busy. -If unspecified in a particular domain, the pointer is not changed -when XEmacs is busy. -@end defvr - -@defvr Glyph menubar-pointer-glyph -This variable specifies the shape of the mouse pointer when over the -menubar. If unspecified in a particular domain, the -window-system-provided default pointer is used. -@end defvr - -@defvr Glyph scrollbar-pointer-glyph -This variable specifies the shape of the mouse pointer when over a -scrollbar. If unspecified in a particular domain, the -window-system-provided default pointer is used. -@end defvr - -@defvr Glyph toolbar-pointer-glyph -This variable specifies the shape of the mouse pointer when over a -toolbar. If unspecified in a particular domain, -@code{nontext-pointer-glyph} is used. -@end defvr - -Internally, these variables are implemented in -@code{default-mouse-motion-handler}, and thus only take effect when the -mouse moves. That function calls @code{set-frame-pointer}, which sets -the current mouse pointer for a frame. - -@defun set-frame-pointer frame image-instance -This function sets the mouse pointer of @var{frame} to the given pointer -image instance. You should not call this function directly. -(If you do, the pointer will change again the next time the mouse moves.) -@end defun - -@node Redisplay Glyphs -@section Redisplay Glyphs - -@defvr Glyph truncation-glyph -This variable specifies what is displayed at the end of truncated lines. -@end defvr - -@defvr Glyph continuation-glyph -This variable specifies what is displayed at the end of wrapped lines. -@end defvr - -@defvr Glyph octal-escape-glyph -This variable specifies what to prefix character codes displayed in octal -with. -@end defvr - -@defvr Glyph hscroll-glyph -This variable specifies what to display at the beginning of horizontally -scrolled lines. -@end defvr - -@defvr Glyph invisible-text-glyph -This variable specifies what to use to indicate the presence of -invisible text. This is the glyph that is displayed when an ellipsis is -called for, according to @code{selective-display-ellipses} or -@code{buffer-invisibility-spec}). Normally this is three dots (``...''). -@end defvr - -@defvr Glyph control-arrow-glyph -This variable specifies what to use as an arrow for control characters. -@end defvr - -@node Subwindows -@section Subwindows - -Subwindows are not currently implemented. - -@defun subwindowp object -This function returns non-@code{nil} if @var{object} is a subwindow. -@end defun diff --git a/man/lispref/hash-tables.texi b/man/lispref/hash-tables.texi deleted file mode 100644 index ddf239b..0000000 --- a/man/lispref/hash-tables.texi +++ /dev/null @@ -1,224 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/hash-tables.info -@node Hash Tables, Range Tables, Display, top -@chapter Hash Tables -@cindex hash table - -@defun hash-table-p object -This function returns @code{t} if @var{object} is a hash table, else @code{nil}. -@end defun - -@menu -* Introduction to Hash Tables:: Hash tables are fast data structures for - implementing simple tables (i.e. finite - mappings from keys to values). -* Working With Hash Tables:: Hash table functions. -* Weak Hash Tables:: Hash tables with special garbage-collection - behavior. -@end menu - -@node Introduction to Hash Tables -@section Introduction to Hash Tables - -A @dfn{hash table} is a data structure that provides mappings from -arbitrary Lisp objects called @dfn{keys} to other arbitrary Lisp objects -called @dfn{values}. A key/value pair is sometimes called an -@dfn{entry} in the hash table. There are many ways other than hash -tables of implementing the same sort of mapping, e.g. association lists -(@pxref{Association Lists}) and property lists (@pxref{Property Lists}), -but hash tables provide much faster lookup when there are many entries -in the mapping. Hash tables are an implementation of the abstract data -type @dfn{dictionary}, also known as @dfn{associative array}. - -Internally, hash tables are hashed using the @dfn{linear probing} hash -table implementation method. This method hashes each key to a -particular spot in the hash table, and then scans forward sequentially -until a blank entry is found. To look up a key, hash to the appropriate -spot, then search forward for the key until either a key is found or a -blank entry stops the search. This method is used in preference to -double hashing because of changes in recent hardware. The penalty for -non-sequential access to memory has been increasing, and this -compensates for the problem of clustering that linear probing entails. - -When hash tables are created, the user may (but is not required to) -specify initial properties that influence performance. - -Use the @code{:size} parameter to specify the number of entries that are -likely to be stored in the hash table, to avoid the overhead of resizing -the table. But if the pre-allocated space for the entries is never -used, it is simply wasted and makes XEmacs slower. Excess unused hash -table entries exact a small continuous performance penalty, since they -must be scanned at every garbage collection. If the number of entries -in the hash table is unknown, simply avoid using the @code{:size} -keyword. - -Use the @code{:rehash-size} and @code{:rehash-threshold} keywords to -adjust the algorithm for deciding when to rehash the hash table. For -temporary hash tables that are going to be very heavily used, use a -small rehash threshold, for example, 0.4 and a large rehash size, for -example 2.0. For permanent hash tables that will be infrequently used, -specify a large rehash threshold, for example 0.8. - -Hash tables can also be created by the lisp reader using structure -syntax, for example: -@example -#s(hash-table size 20 data (foo 1 bar 2)) -@end example - -The structure syntax accepts the same keywords as @code{make-hash-table} -(without the @code{:} character), as well as the additional keyword -@code{data}, which specifies the initial hash table contents. - -@defun make-hash-table &key @code{:size} @code{:test} @code{:type} @code{:rehash-size} @code{:rehash-threshold} -This function returns a new empty hash table object. - -Keyword @code{:size} specifies the number of keys likely to be inserted. -This number of entries can be inserted without enlarging the hash table. - -Keyword @code{:test} can be @code{eq}, @code{eql} (default) or @code{equal}. -Comparison between keys is done using this function. -If speed is important, consider using @code{eq}. -When storing strings in the hash table, you will likely need to use @code{equal}. - -Keyword @code{:type} can be @code{non-weak} (default), @code{weak}, -@code{key-weak} or @code{value-weak}. - -A weak hash table is one whose pointers do not count as GC referents: -for any key-value pair in the hash table, if the only remaining pointer -to either the key or the value is in a weak hash table, then the pair -will be removed from the hash table, and the key and value collected. -A non-weak hash table (or any other pointer) would prevent the object -from being collected. - -A key-weak hash table is similar to a fully-weak hash table except that -a key-value pair will be removed only if the key remains unmarked -outside of weak hash tables. The pair will remain in the hash table if -the key is pointed to by something other than a weak hash table, even -if the value is not. - -A value-weak hash table is similar to a fully-weak hash table except -that a key-value pair will be removed only if the value remains -unmarked outside of weak hash tables. The pair will remain in the -hash table if the value is pointed to by something other than a weak -hash table, even if the key is not. - -Keyword @code{:rehash-size} must be a float greater than 1.0, and specifies -the factor by which to increase the size of the hash table when enlarging. - -Keyword @code{:rehash-threshold} must be a float between 0.0 and 1.0, -and specifies the load factor of the hash table which triggers enlarging. -@end defun - -@defun copy-hash-table hash-table -This function returns a new hash table which contains the same keys and -values as @var{hash-table}. The keys and values will not themselves be -copied. -@end defun - -@defun hash-table-count hash-table -This function returns the number of entries in @var{hash-table}. -@end defun - -@defun hash-table-size hash-table -This function returns the current number of slots in @var{hash-table}, -whether occupied or not. -@end defun - -@defun hash-table-type hash-table -This function returns the type of @var{hash-table}. -This can be one of @code{non-weak}, @code{weak}, @code{key-weak} or -@code{value-weak}. -@end defun - -@defun hash-table-test hash-table -This function returns the test function of @var{hash-table}. -This can be one of @code{eq}, @code{eql} or @code{equal}. -@end defun - -@defun hash-table-rehash-size hash-table -This function returns the current rehash size of @var{hash-table}. -This is a float greater than 1.0; the factor by which @var{hash-table} -is enlarged when the rehash threshold is exceeded. -@end defun - -@defun hash-table-rehash-threshold hash-table -This function returns the current rehash threshold of @var{hash-table}. -This is a float between 0.0 and 1.0; the maximum @dfn{load factor} of -@var{hash-table}, beyond which the @var{hash-table} is enlarged by rehashing. -@end defun - -@node Working With Hash Tables -@section Working With Hash Tables - -@defun puthash key value hash-table -This function hashes @var{key} to @var{value} in @var{hash-table}. -@end defun - -@defun gethash key hash-table &optional default -This function finds the hash value for @var{key} in @var{hash-table}. -If there is no entry for @var{key} in @var{hash-table}, @var{default} is -returned (which in turn defaults to @code{nil}). -@end defun - -@defun remhash key hash-table -This function removes the entry for @var{key} from @var{hash-table}. -Does nothing if there is no entry for @var{key} in @var{hash-table}. -@end defun - -@defun clrhash hash-table -This function removes all entries from @var{hash-table}, leaving it empty. -@end defun - -@defun maphash function hash-table -This function maps @var{function} over entries in @var{hash-table}, -calling it with two args, each key and value in the hash table. - -@var{function} may not modify @var{hash-table}, with the one exception -that @var{function} may remhash or puthash the entry currently being -processed by @var{function}. -@end defun - -@node Weak Hash Tables -@section Weak Hash Tables -@cindex hash table, weak -@cindex weak hash table - -A @dfn{weak hash table} is a special variety of hash table whose -elements do not count as GC referents. For any key-value pair in such a -hash table, if either the key or value (or in some cases, if one -particular one of the two) has no references to it outside of weak hash -tables (and similar structures such as weak lists), the pair will be -removed from the table, and the key and value collected. A non-weak -hash table (or any other pointer) would prevent the objects from being -collected. - -Weak hash tables are useful for keeping track of information in a -non-obtrusive way, for example to implement caching. If the cache -contains objects such as buffers, markers, image instances, etc. that -will eventually disappear and get garbage-collected, using a weak hash -table ensures that these objects are collected normally rather than -remaining around forever, long past their actual period of use. -(Otherwise, you'd have to explicitly map over the hash table every so -often and remove unnecessary elements.) - -There are three types of weak hash tables: - -@table @asis -@item fully weak hash tables -In these hash tables, a pair disappears if either the key or the value -is unreferenced outside of the table. -@item key-weak hash tables -In these hash tables, a pair disappears if the key is unreferenced outside -of the table, regardless of how the value is referenced. -@item value-weak hash tables -In these hash tables, a pair disappears if the value is unreferenced outside -of the table, regardless of how the key is referenced. -@end table - -Also see @ref{Weak Lists}. - -Weak hash tables are created by specifying the @code{:type} keyword to -@code{make-hash-table}. diff --git a/man/lispref/help.texi b/man/lispref/help.texi deleted file mode 100644 index 7117fb1..0000000 --- a/man/lispref/help.texi +++ /dev/null @@ -1,734 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/help.info -@node Documentation, Files, Modes, Top -@chapter Documentation -@cindex documentation strings - - XEmacs Lisp has convenient on-line help facilities, most of which -derive their information from the documentation strings associated with -functions and variables. This chapter describes how to write good -documentation strings for your Lisp programs, as well as how to write -programs to access documentation. - - Note that the documentation strings for XEmacs are not the same thing -as the XEmacs manual. Manuals have their own source files, written in -the Texinfo language; documentation strings are specified in the -definitions of the functions and variables they apply to. A collection -of documentation strings is not sufficient as a manual because a good -manual is not organized in that fashion; it is organized in terms of -topics of discussion. - -@menu -* Documentation Basics:: Good style for doc strings. - Where to put them. How XEmacs stores them. -* Accessing Documentation:: How Lisp programs can access doc strings. -* Keys in Documentation:: Substituting current key bindings. -* Describing Characters:: Making printable descriptions of - non-printing characters and key sequences. -* Help Functions:: Subroutines used by XEmacs help facilities. -* Obsoleteness:: Upgrading Lisp functionality over time. -@end menu - -@node Documentation Basics -@section Documentation Basics -@cindex documentation conventions -@cindex writing a documentation string -@cindex string, writing a doc string - - A documentation string is written using the Lisp syntax for strings, -with double-quote characters surrounding the text of the string. This -is because it really is a Lisp string object. The string serves as -documentation when it is written in the proper place in the definition -of a function or variable. In a function definition, the documentation -string follows the argument list. In a variable definition, the -documentation string follows the initial value of the variable. - - When you write a documentation string, make the first line a complete -sentence (or two complete sentences) since some commands, such as -@code{apropos}, show only the first line of a multi-line documentation -string. Also, you should not indent the second line of a documentation -string, if you have one, because that looks odd when you use @kbd{C-h f} -(@code{describe-function}) or @kbd{C-h v} (@code{describe-variable}). -@xref{Documentation Tips}. - - Documentation strings may contain several special substrings, which -stand for key bindings to be looked up in the current keymaps when the -documentation is displayed. This allows documentation strings to refer -to the keys for related commands and be accurate even when a user -rearranges the key bindings. (@xref{Accessing Documentation}.) - - Within the Lisp world, a documentation string is accessible through -the function or variable that it describes: - -@itemize @bullet -@item -The documentation for a function is stored in the function definition -itself (@pxref{Lambda Expressions}). The function -@code{documentation} knows how to extract it. - -@item -@kindex variable-documentation -The documentation for a variable is stored in the variable's property -list under the property name @code{variable-documentation}. The -function @code{documentation-property} knows how to extract it. -@end itemize - -@cindex @file{DOC} (documentation) file -To save space, the documentation for preloaded functions and variables -(including primitive functions and autoloaded functions) is stored in -the @dfn{internal doc file} @file{DOC}. The documentation for functions -and variables loaded during the XEmacs session from byte-compiled files -is stored in those very same byte-compiled files (@pxref{Docs and -Compilation}). - -XEmacs does not keep documentation strings in memory unless necessary. -Instead, XEmacs maintains, for preloaded symbols, an integer offset into -the internal doc file, and for symbols loaded from byte-compiled files, -a list containing the filename of the byte-compiled file and an integer -offset, in place of the documentation string. The functions -@code{documentation} and @code{documentation-property} use that -information to read the documentation from the appropriate file; this is -transparent to the user. - - For information on the uses of documentation strings, see @ref{Help, , -Help, emacs, The XEmacs Reference Manual}. - -@c Wordy to prevent overfull hbox. --rjc 15mar92 - The @file{emacs/lib-src} directory contains two utilities that you can -use to print nice-looking hardcopy for the file -@file{emacs/etc/DOC-@var{version}}. These are @file{sorted-doc.c} and -@file{digest-doc.c}. - -@node Accessing Documentation -@section Access to Documentation Strings - -@defun documentation-property symbol property &optional verbatim -This function returns the documentation string that is recorded in -@var{symbol}'s property list under property @var{property}. It -retrieves the text from a file if necessary, and runs -@code{substitute-command-keys} to substitute actual key bindings. (This -substitution is not done if @var{verbatim} is non-@code{nil}; the -@var{verbatim} argument exists only as of Emacs 19.) - -@smallexample -@group -(documentation-property 'command-line-processed - 'variable-documentation) - @result{} "t once command line has been processed" -@end group -@group -(symbol-plist 'command-line-processed) - @result{} (variable-documentation 188902) -@end group -@end smallexample -@end defun - -@defun documentation function &optional verbatim -This function returns the documentation string of @var{function}. It -reads the text from a file if necessary. Then (unless @var{verbatim} is -non-@code{nil}) it calls @code{substitute-command-keys}, to return a -value containing the actual (current) key bindings. - -The function @code{documentation} signals a @code{void-function} error -if @var{function} has no function definition. However, it is ok if -the function definition has no documentation string. In that case, -@code{documentation} returns @code{nil}. -@end defun - -@c Wordy to prevent overfull hboxes. --rjc 15mar92 -Here is an example of using the two functions, @code{documentation} and -@code{documentation-property}, to display the documentation strings for -several symbols in a @samp{*Help*} buffer. - -@smallexample -@group -(defun describe-symbols (pattern) - "Describe the XEmacs Lisp symbols matching PATTERN. -All symbols that have PATTERN in their name are described -in the `*Help*' buffer." - (interactive "sDescribe symbols matching: ") - (let ((describe-func - (function - (lambda (s) -@end group -@group - ;; @r{Print description of symbol.} - (if (fboundp s) ; @r{It is a function.} - (princ - (format "%s\t%s\n%s\n\n" s - (if (commandp s) - (let ((keys (where-is-internal s))) - (if keys - (concat - "Keys: " - (mapconcat 'key-description - keys " ")) - "Keys: none")) - "Function") -@end group -@group - (or (documentation s) - "not documented")))) - - (if (boundp s) ; @r{It is a variable.} -@end group -@group - (princ - (format "%s\t%s\n%s\n\n" s - (if (user-variable-p s) - "Option " "Variable") -@end group -@group - (or (documentation-property - s 'variable-documentation) - "not documented"))))))) - sym-list) -@end group - -@group - ;; @r{Build a list of symbols that match pattern.} - (mapatoms (function - (lambda (sym) - (if (string-match pattern (symbol-name sym)) - (setq sym-list (cons sym sym-list)))))) -@end group - -@group - ;; @r{Display the data.} - (with-output-to-temp-buffer "*Help*" - (mapcar describe-func (sort sym-list 'string<)) - (print-help-return-message)))) -@end group -@end smallexample - - The @code{describe-symbols} function works like @code{apropos}, -but provides more information. - -@smallexample -@group -(describe-symbols "goal") - ----------- Buffer: *Help* ---------- -goal-column Option -*Semipermanent goal column for vertical motion, as set by C-x C-n, or nil. -@end group -@c Do not blithely break or fill these lines. -@c That makes them incorrect. - -@group -set-goal-column Command: C-x C-n -Set the current horizontal position as a goal for C-n and C-p. -@end group -@c DO NOT put a blank line here! That is factually inaccurate! -@group -Those commands will move to this position in the line moved to -rather than trying to keep the same horizontal position. -With a non-nil argument, clears out the goal column -so that C-n and C-p resume vertical motion. -The goal column is stored in the variable `goal-column'. -@end group - -@group -temporary-goal-column Variable -Current goal column for vertical motion. -It is the column where point was -at the start of current run of vertical motion commands. -When the `track-eol' feature is doing its job, the value is 9999. ----------- Buffer: *Help* ---------- -@end group -@end smallexample - -@defun Snarf-documentation filename - This function is used only during XEmacs initialization, just before -the runnable XEmacs is dumped. It finds the file offsets of the -documentation strings stored in the file @var{filename}, and records -them in the in-core function definitions and variable property lists in -place of the actual strings. @xref{Building XEmacs}. - - XEmacs finds the file @var{filename} in the @file{lib-src} directory. -When the dumped XEmacs is later executed, the same file is found in the -directory @code{doc-directory}. The usual value for @var{filename} is -@file{DOC}, but this can be changed by modifying the variable -@code{internal-doc-file-name}. -@end defun - -@defvar internal-doc-file-name -This variable holds the name of the file containing documentation -strings of built-in symbols, usually @file{DOC}. The full pathname of -the internal doc file is @samp{(concat doc-directory internal-doc-file-name)}. -@end defvar - -@defvar doc-directory -This variable holds the name of the directory which contains the -@dfn{internal doc file} that contains documentation strings for built-in -and preloaded functions and variables. - -In most cases, this is the same as @code{exec-directory}. They may be -different when you run XEmacs from the directory where you built it, -without actually installing it. See @code{exec-directory} in @ref{Help -Functions}. - -In older Emacs versions, @code{exec-directory} was used for this. -@end defvar - -@defvar data-directory -This variable holds the name of the directory in which XEmacs finds -certain system independent documentation and text files that come -with XEmacs. In older Emacs versions, @code{exec-directory} was used for -this. -@end defvar - -@node Keys in Documentation -@section Substituting Key Bindings in Documentation -@cindex documentation, keys in -@cindex keys in documentation strings -@cindex substituting keys in documentation - - When documentation strings refer to key sequences, they should use the -current, actual key bindings. They can do so using certain special text -sequences described below. Accessing documentation strings in the usual -way substitutes current key binding information for these special -sequences. This works by calling @code{substitute-command-keys}. You -can also call that function yourself. - - Here is a list of the special sequences and what they mean: - -@table @code -@item \[@var{command}] -stands for a key sequence that will invoke @var{command}, or @samp{M-x -@var{command}} if @var{command} has no key bindings. - -@item \@{@var{mapvar}@} -stands for a summary of the value of @var{mapvar}, which should be a -keymap. The summary is made by @code{describe-bindings}. - -@item \<@var{mapvar}> -stands for no text itself. It is used for a side effect: it specifies -@var{mapvar} as the keymap for any following @samp{\[@var{command}]} -sequences in this documentation string. - -@item \= -quotes the following character and is discarded; this @samp{\=\=} puts -@samp{\=} into the output, and @samp{\=\[} puts @samp{\[} into the output. -@end table - -@strong{Please note:} Each @samp{\} must be doubled when written in a -string in XEmacs Lisp. - -@defun substitute-command-keys string -This function scans @var{string} for the above special sequences and -replaces them by what they stand for, returning the result as a string. -This permits display of documentation that refers accurately to the -user's own customized key bindings. -@end defun - - Here are examples of the special sequences: - -@smallexample -@group -(substitute-command-keys - "To abort recursive edit, type: \\[abort-recursive-edit]") -@result{} "To abort recursive edit, type: C-]" -@end group - -@group -(substitute-command-keys - "The keys that are defined for the minibuffer here are: - \\@{minibuffer-local-must-match-map@}") -@result{} "The keys that are defined for the minibuffer here are: -@end group - -? minibuffer-completion-help -SPC minibuffer-complete-word -TAB minibuffer-complete -LFD minibuffer-complete-and-exit -RET minibuffer-complete-and-exit -C-g abort-recursive-edit -" - -@group -(substitute-command-keys - "To abort a recursive edit from the minibuffer, type\ -\\\\[abort-recursive-edit].") -@result{} "To abort a recursive edit from the minibuffer, type C-g." -@end group - -@group -(substitute-command-keys - "Substrings of the form \\=\\@{MAPVAR@} are replaced by summaries -\(made by describe-bindings) of the value of MAPVAR, taken as a keymap. -Substrings of the form \\=\\ specify to use the value of MAPVAR -as the keymap for future \\=\\[COMMAND] substrings. -\\=\\= quotes the following character and is discarded; -thus, \\=\\=\\=\\= puts \\=\\= into the output, -and \\=\\=\\=\\[ puts \\=\\[ into the output.") -@result{} "Substrings of the form \@{MAPVAR@} are replaced by summaries -(made by describe-bindings) of the value of MAPVAR, taken as a keymap. -Substrings of the form \ specify to use the value of MAPVAR -as the keymap for future \[COMMAND] substrings. -\= quotes the following character and is discarded; -thus, \=\= puts \= into the output, -and \=\[ puts \[ into the output." -@end group -@end smallexample - -@node Describing Characters -@section Describing Characters for Help Messages - - These functions convert events, key sequences or characters to textual -descriptions. These descriptions are useful for including arbitrary -text characters or key sequences in messages, because they convert -non-printing and whitespace characters to sequences of printing -characters. The description of a non-whitespace printing character is -the character itself. - -@defun key-description sequence -@cindex XEmacs event standard notation -This function returns a string containing the XEmacs standard notation -for the input events in @var{sequence}. The argument @var{sequence} may -be a string, vector or list. @xref{Events}, for more information about -valid events. See also the examples for @code{single-key-description}, -below. -@end defun - -@defun single-key-description key -@cindex event printing -@cindex character printing -@cindex control character printing -@cindex meta character printing -This function returns a string describing @var{key} in the standard -XEmacs notation for keyboard input. A normal printing character appears -as itself, but a control character turns into a string starting with -@samp{C-}, a meta character turns into a string starting with @samp{M-}, -and space, linefeed, etc.@: appear as @samp{SPC}, @samp{LFD}, etc. A -symbol appears as the name of the symbol. An event that is a list -appears as the name of the symbol in the @sc{car} of the list. - -@smallexample -@group -(single-key-description ?\C-x) - @result{} "C-x" -@end group -@group -(key-description "\C-x \M-y \n \t \r \f123") - @result{} "C-x SPC M-y SPC LFD SPC TAB SPC RET SPC C-l 1 2 3" -@end group -@group -(single-key-description 'kp_next) - @result{} "kp_next" -@end group -@group -(single-key-description '(shift button1)) - @result{} "Sh-button1" -@end group -@end smallexample -@end defun - -@defun text-char-description character -This function returns a string describing @var{character} in the -standard XEmacs notation for characters that appear in text---like -@code{single-key-description}, except that control characters are -represented with a leading caret (which is how control characters in -XEmacs buffers are usually displayed). - -@smallexample -@group -(text-char-description ?\C-c) - @result{} "^C" -@end group -@group -(text-char-description ?\M-m) - @result{} "M-m" -@end group -@group -(text-char-description ?\C-\M-m) - @result{} "M-^M" -@end group -@end smallexample -@end defun - -@node Help Functions -@section Help Functions - - XEmacs provides a variety of on-line help functions, all accessible to -the user as subcommands of the prefix @kbd{C-h}, or on some keyboards, -@kbd{help}. For more information about them, see @ref{Help, , Help, -emacs, The XEmacs Reference Manual}. Here we describe some -program-level interfaces to the same information. - -@deffn Command apropos regexp &optional do-all predicate -This function finds all symbols whose names contain a match for the -regular expression @var{regexp}, and returns a list of them -(@pxref{Regular Expressions}). It also displays the symbols in a buffer -named @samp{*Help*}, each with a one-line description. - -@c Emacs 19 feature -If @var{do-all} is non-@code{nil}, then @code{apropos} also shows -key bindings for the functions that are found. - -If @var{predicate} is non-@code{nil}, it should be a function to be -called on each symbol that has matched @var{regexp}. Only symbols for -which @var{predicate} returns a non-@code{nil} value are listed or -displayed. - -In the first of the following examples, @code{apropos} finds all the -symbols with names containing @samp{exec}. In the second example, it -finds and returns only those symbols that are also commands. -(We don't show the output that results in the @samp{*Help*} buffer.) - -@smallexample -@group -(apropos "exec") - @result{} (Buffer-menu-execute command-execute exec-directory - exec-path execute-extended-command execute-kbd-macro - executing-kbd-macro executing-macro) -@end group - -@group -(apropos "exec" nil 'commandp) - @result{} (Buffer-menu-execute execute-extended-command) -@end group -@ignore -@group ----------- Buffer: *Help* ---------- -Buffer-menu-execute - Function: Save and/or delete buffers marked with - M-x Buffer-menu-save or M-x Buffer-menu-delete commands. -execute-extended-command ESC x - Function: Read function name, then read its - arguments and call it. ----------- Buffer: *Help* ---------- -@end group -@end ignore -@end smallexample - -@code{apropos} is used by various user-level commands, such as @kbd{C-h -a} (@code{hyper-apropos}), a graphical front-end to @code{apropos}; and -@kbd{C-h A} (@code{command-apropos}), which does an apropos over only -those functions which are user commands. @code{command-apropos} calls -@code{apropos}, specifying a @var{predicate} to restrict the output to -symbols that are commands. The call to @code{apropos} looks like this: - -@smallexample -(apropos string t 'commandp) -@end smallexample -@end deffn - -@c Emacs 19 feature -@c super-apropos is obsolete - function absorbed by apropos --mrb -@ignore -@deffn Command super-apropos regexp &optional do-all -This function differs from @code{apropos} in that it searches -documentation strings as well as symbol names for matches for -@var{regexp}. By default, it searches the documentation strings only -for preloaded functions and variables. If @var{do-all} is -non-@code{nil}, it scans the names and documentation strings of all -functions and variables. -@end deffn -@end ignore - -@defvar help-map -The value of this variable is a local keymap for characters following the -Help key, @kbd{C-h}. -@end defvar - -@deffn {Prefix Command} help-command -This symbol is not a function; its function definition is actually the -keymap known as @code{help-map}. It is defined in @file{help.el} as -follows: - -@smallexample -@group -(define-key global-map "\C-h" 'help-command) -(fset 'help-command help-map) -@end group -@end smallexample -@end deffn - -@defun print-help-return-message &optional function -This function builds a string that explains how to restore the previous -state of the windows after a help command. After building the message, -it applies @var{function} to it if @var{function} is non-@code{nil}. -Otherwise it calls @code{message} to display it in the echo area. - -This function expects to be called inside a -@code{with-output-to-temp-buffer} special form, and expects -@code{standard-output} to have the value bound by that special form. -For an example of its use, see the long example in @ref{Accessing -Documentation}. -@end defun - -@defvar help-char -The value of this variable is the help character---the character that -XEmacs recognizes as meaning Help. By default, it is the character -@samp{?\^H} (ASCII 8), which is @kbd{C-h}. When XEmacs reads this -character, if @code{help-form} is non-@code{nil} Lisp expression, it -evaluates that expression, and displays the result in a window if it is -a string. - -@code{help-char} can be a character or a key description such as -@code{help} or @code{(meta h)}. - -Usually the value of @code{help-form}'s value is @code{nil}. Then the -help character has no special meaning at the level of command input, and -it becomes part of a key sequence in the normal way. The standard key -binding of @kbd{C-h} is a prefix key for several general-purpose help -features. - -The help character is special after prefix keys, too. If it has no -binding as a subcommand of the prefix key, it runs -@code{describe-prefix-bindings}, which displays a list of all the -subcommands of the prefix key. -@end defvar - -@defvar help-form -If this variable is non-@code{nil}, its value is a form to evaluate -whenever the character @code{help-char} is read. If evaluating the form -produces a string, that string is displayed. - -A command that calls @code{next-command-event} or @code{next-event} -probably should bind @code{help-form} to a non-@code{nil} expression -while it does input. (The exception is when @kbd{C-h} is meaningful -input.) Evaluating this expression should result in a string that -explains what the input is for and how to enter it properly. - -Entry to the minibuffer binds this variable to the value of -@code{minibuffer-help-form} (@pxref{Minibuffer Misc}). -@end defvar - -@defvar prefix-help-command -This variable holds a function to print help for a prefix character. -The function is called when the user types a prefix key followed by the -help character, and the help character has no binding after that prefix. -The variable's default value is @code{describe-prefix-bindings}. -@end defvar - -@defun describe-prefix-bindings -This function calls @code{describe-bindings} to display a list of all -the subcommands of the prefix key of the most recent key sequence. The -prefix described consists of all but the last event of that key -sequence. (The last event is, presumably, the help character.) -@end defun - - The following two functions are found in the library @file{helper}. -They are for modes that want to provide help without relinquishing -control, such as the ``electric'' modes. You must load that library -with @code{(require 'helper)} in order to use them. Their names begin -with @samp{Helper} to distinguish them from the ordinary help functions. - -@deffn Command Helper-describe-bindings -This command pops up a window displaying a help buffer containing a -listing of all of the key bindings from both the local and global keymaps. -It works by calling @code{describe-bindings}. -@end deffn - -@deffn Command Helper-help -This command provides help for the current mode. It prompts the user -in the minibuffer with the message @samp{Help (Type ? for further -options)}, and then provides assistance in finding out what the key -bindings are, and what the mode is intended for. It returns @code{nil}. - -This can be customized by changing the map @code{Helper-help-map}. -@end deffn - -@ignore @c Not in XEmacs currently -@c Emacs 19 feature -@defmac make-help-screen fname help-line help-text help-map -This macro defines a help command named @var{fname} that acts like a -prefix key that shows a list of the subcommands it offers. - -When invoked, @var{fname} displays @var{help-text} in a window, then -reads and executes a key sequence according to @var{help-map}. The -string @var{help-text} should describe the bindings available in -@var{help-map}. - -The command @var{fname} is defined to handle a few events itself, by -scrolling the display of @var{help-text}. When @var{fname} reads one of -those special events, it does the scrolling and then reads another -event. When it reads an event that is not one of those few, and which -has a binding in @var{help-map}, it executes that key's binding and -then returns. - -The argument @var{help-line} should be a single-line summary of the -alternatives in @var{help-map}. In the current version of Emacs, this -argument is used only if you set the option @code{three-step-help} to -@code{t}. -@end defmac - -@defopt three-step-help -If this variable is non-@code{nil}, commands defined with -@code{make-help-screen} display their @var{help-line} strings in the -echo area at first, and display the longer @var{help-text} strings only -if the user types the help character again. -@end defopt -@end ignore - -@node Obsoleteness -@section Obsoleteness - -As you add functionality to a package, you may at times want to -replace an older function with a new one. To preserve compatibility -with existing code, the older function needs to still exist; but -users of that function should be told to use the newer one instead. -XEmacs Lisp lets you mark a function or variable as @dfn{obsolete}, -and indicate what should be used instead. - -@defun make-obsolete function new -This function indicates that @var{function} is an obsolete function, -and the function @var{new} should be used instead. The byte compiler -will issue a warning to this effect when it encounters a usage of the -older function, and the help system will also note this in the function's -documentation. @var{new} can also be a string (if there is not a single -function with the same functionality any more), and should be a descriptive -statement, such as "use @var{foo} or @var{bar} instead" or "this function is -unnecessary". -@end defun - -@defun make-obsolete-variable variable new -This is like @code{make-obsolete} but is for variables instead of functions. -@end defun - -@defun define-obsolete-function-alias oldfun newfun -This function combines @code{make-obsolete} and @code{define-function}, -declaring @var{oldfun} to be an obsolete variant of @var{newfun} and -defining @var{oldfun} as an alias for @var{newfun}. -@end defun - -@defun define-obsolete-variable-alias oldvar newvar -This is like @code{define-obsolete-function-alias} but for variables. -@end defun - -Note that you should not normally put obsoleteness information -explicitly in a function or variable's doc string. The obsoleteness -information that you specify using the above functions will be displayed -whenever the doc string is displayed, and by adding it explicitly the -result is redundancy. - -Also, if an obsolete function is substantially the same as a newer one -but is not actually an alias, you should consider omitting the doc -string entirely (use a null string @samp{""} as the doc string). That -way, the user is told about the obsoleteness and is forced to look at -the documentation of the new function, making it more likely that he -will use the new function. - -@defun function-obsoleteness-doc function -If @var{function} is obsolete, this function returns a string describing -this. This is the message that is printed out during byte compilation -or in the function's documentation. If @var{function} is not obsolete, -@code{nil} is returned. -@end defun - -@defun variable-obsoleteness-doc variable -This is like @code{function-obsoleteness-doc} but for variables. -@end defun - -The obsoleteness information is stored internally by putting a property -@code{byte-obsolete-info} (for functions) or -@code{byte-obsolete-variable} (for variables) on the symbol that -specifies the obsolete function or variable. For more information, see -the implementation of @code{make-obsolete} and -@code{make-obsolete-variable} in -@file{lisp/bytecomp/bytecomp-runtime.el}. diff --git a/man/lispref/hooks.texi b/man/lispref/hooks.texi deleted file mode 100644 index e8a3381..0000000 --- a/man/lispref/hooks.texi +++ /dev/null @@ -1,281 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/hooks.info -@node Standard Hooks, Index, Standard Keymaps, Top -@appendix Standard Hooks - -The following is a list of hook variables that let you provide -functions to be called from within Emacs on suitable occasions. - -Most of these variables have names ending with @samp{-hook}. They are -@dfn{normal hooks}, run by means of @code{run-hooks}. The value of such -a hook is a list of functions. The recommended way to put a new -function on such a hook is to call @code{add-hook}. @xref{Hooks}, for -more information about using hooks. - -The variables whose names end in @samp{-function} have single functions -as their values. Usually there is a specific reason why the variable is -not a normal hook, such as the need to pass arguments to the function. -(In older Emacs versions, some of these variables had names ending in -@samp{-hook} even though they were not normal hooks.) - -The variables whose names end in @samp{-hooks} or @samp{-functions} have -lists of functions as their values, but these functions are called in a -special way (they are passed arguments, or else their values are used). - -@c !!! need xref to where each hook is documented or else document it -@c by specifying what is expected, and when it is called relative to -@c mode initialization.) - -@table @code -@item activate-menubar-hook -@item activate-popup-menu-hook -@item ad-definition-hooks -@item adaptive-fill-function -@item add-log-current-defun-function -@item after-change-functions -@item after-delete-annotation-hook -@item after-init-hook -@item after-insert-file-functions -@item after-revert-hook -@item after-save-hook -@item after-set-visited-file-name-hooks -@item after-write-file-hooks -@item auto-fill-function -@item auto-save-hook -@item before-change-functions -@item before-delete-annotation-hook -@item before-init-hook -@item before-revert-hook -@item blink-paren-function -@item buffers-menu-switch-to-buffer-function -@item c++-mode-hook -@item c-delete-function -@item c-mode-common-hook -@item c-mode-hook -@item c-special-indent-hook -@item calendar-load-hook -@item change-major-mode-hook -@item command-history-hook -@item comment-indent-function -@item compilation-buffer-name-function -@item compilation-exit-message-function -@item compilation-finish-function -@item compilation-parse-errors-function -@item compilation-mode-hook -@item create-console-hook -@item create-device-hook -@item create-frame-hook -@item dabbrev-friend-buffer-function -@item dabbrev-select-buffers-function -@item delete-console-hook -@item delete-device-hook -@item delete-frame-hook -@item deselect-frame-hook -@item diary-display-hook -@item diary-hook -@item dired-after-readin-hook -@item dired-before-readin-hook -@item dired-load-hook -@item dired-mode-hook -@item disabled-command-hook -@item display-buffer-function -@item ediff-after-setup-control-frame-hook -@item ediff-after-setup-windows-hook -@item ediff-before-setup-control-frame-hook -@item ediff-before-setup-windows-hook -@item ediff-brief-help-message-function -@item ediff-cleanup-hook -@item ediff-control-frame-position-function -@item ediff-display-help-hook -@item ediff-focus-on-regexp-matches-function -@item ediff-forward-word-function -@item ediff-hide-regexp-matches-function -@item ediff-keymap-setup-hook -@item ediff-load-hook -@item ediff-long-help-message-function -@item ediff-make-wide-display-function -@item ediff-merge-split-window-function -@item ediff-meta-action-function -@item ediff-meta-redraw-function -@item ediff-mode-hook -@item ediff-prepare-buffer-hook -@item ediff-quit-hook -@item ediff-registry-setup-hook -@item ediff-select-hook -@item ediff-session-action-function -@item ediff-session-group-setup-hook -@item ediff-setup-diff-regions-function -@item ediff-show-registry-hook -@item ediff-show-session-group-hook -@item ediff-skip-diff-region-function -@item ediff-split-window-function -@item ediff-startup-hook -@item ediff-suspend-hook -@item ediff-toggle-read-only-function -@item ediff-unselect-hook -@item ediff-window-setup-function -@item edit-picture-hook -@item electric-buffer-menu-mode-hook -@item electric-command-history-hook -@item electric-help-mode-hook -@item emacs-lisp-mode-hook -@item fill-paragraph-function -@item find-file-hooks -@item find-file-not-found-hooks -@item first-change-hook -@item font-lock-after-fontify-buffer-hook -@item font-lock-beginning-of-syntax-function -@item font-lock-mode-hook -@item fume-found-function-hook -@item fume-list-mode-hook -@item fume-rescan-buffer-hook -@item fume-sort-function -@item gnus-startup-hook -@item hack-local-variables-hook -@item highlight-headers-follow-url-function -@item hyper-apropos-mode-hook -@item indent-line-function -@item indent-mim-hook -@item indent-region-function -@item initial-calendar-window-hook -@item isearch-mode-end-hook -@item isearch-mode-hook -@item java-mode-hook -@item kill-buffer-hook -@item kill-buffer-query-functions -@item kill-emacs-hook -@item kill-emacs-query-functions -@item kill-hooks -@item LaTeX-mode-hook -@item latex-mode-hook -@item ledit-mode-hook -@item lisp-indent-function -@item lisp-interaction-mode-hook -@item lisp-mode-hook -@item list-diary-entries-hook -@item load-read-function -@item log-message-filter-function -@item m2-mode-hook -@item mail-citation-hook -@item mail-mode-hook -@item mail-setup-hook -@item make-annotation-hook -@item makefile-mode-hook -@item map-frame-hook -@item mark-diary-entries-hook -@item medit-mode-hook -@item menu-no-selection-hook -@item mh-compose-letter-hook -@item mh-folder-mode-hook -@item mh-letter-mode-hook -@item mim-mode-hook -@item minibuffer-exit-hook -@item minibuffer-setup-hook -@item mode-motion-hook -@item mouse-enter-frame-hook -@item mouse-leave-frame-hook -@item mouse-track-cleanup-hook -@item mouse-track-click-hook -@item mouse-track-down-hook -@item mouse-track-drag-hook -@item mouse-track-drag-up-hook -@item mouse-track-up-hook -@item mouse-yank-function -@item news-mode-hook -@item news-reply-mode-hook -@item news-setup-hook -@item nongregorian-diary-listing-hook -@item nongregorian-diary-marking-hook -@item nroff-mode-hook -@item objc-mode-hook -@item outline-mode-hook -@item perl-mode-hook -@item plain-TeX-mode-hook -@item post-command-hook -@item post-gc-hook -@item pre-abbrev-expand-hook -@item pre-command-hook -@item pre-display-buffer-function -@item pre-gc-hook -@item pre-idle-hook -@item print-diary-entries-hook -@item prolog-mode-hook -@item protect-innocence-hook -@item remove-message-hook -@item revert-buffer-function -@item revert-buffer-insert-contents-function -@item rmail-edit-mode-hook -@item rmail-mode-hook -@item rmail-retry-setup-hook -@item rmail-summary-mode-hook -@item scheme-indent-hook -@item scheme-mode-hook -@item scribe-mode-hook -@item select-frame-hook -@item send-mail-function -@item shell-mode-hook -@item shell-set-directory-error-hook -@item special-display-function -@item suspend-hook -@item suspend-resume-hook -@item temp-buffer-show-function -@item term-setup-hook -@item terminal-mode-hook -@item terminal-mode-break-hook -@item TeX-mode-hook -@item tex-mode-hook -@item text-mode-hook -@item today-visible-calendar-hook -@item today-invisible-calendar-hook -@item tooltalk-message-handler-hook -@item tooltalk-pattern-handler-hook -@item tooltalk-unprocessed-message-hook -@item unmap-frame-hook -@item vc-checkin-hook -@item vc-checkout-writable-buffer-hook -@item vc-log-after-operation-hook -@item vc-make-buffer-writable-hook -@item view-hook -@item vm-arrived-message-hook -@item vm-arrived-messages-hook -@item vm-chop-full-name-function -@item vm-display-buffer-hook -@item vm-edit-message-hook -@item vm-forward-message-hook -@item vm-iconify-frame-hook -@item vm-inhibit-write-file-hook -@item vm-key-functions -@item vm-mail-hook -@item vm-mail-mode-hook -@item vm-menu-setup-hook -@item vm-mode-hook -@item vm-quit-hook -@item vm-rename-current-buffer-function -@item vm-reply-hook -@item vm-resend-bounced-message-hook -@item vm-resend-message-hook -@item vm-retrieved-spooled-mail-hook -@item vm-select-message-hook -@item vm-select-new-message-hook -@item vm-select-unread-message-hook -@item vm-send-digest-hook -@item vm-summary-mode-hook -@item vm-summary-pointer-update-hook -@item vm-summary-redo-hook -@item vm-summary-update-hook -@item vm-undisplay-buffer-hook -@item vm-visit-folder-hook -@item window-setup-hook -@item write-contents-hooks -@item write-file-data-hooks -@item write-file-hooks -@item write-region-annotate-functions -@item x-lost-selection-hooks -@item x-sent-selection-hooks -@item zmacs-activate-region-hook -@item zmacs-deactivate-region-hook -@item zmacs-update-region-hook -@end table diff --git a/man/lispref/internationalization.texi b/man/lispref/internationalization.texi deleted file mode 100644 index 39eb968..0000000 --- a/man/lispref/internationalization.texi +++ /dev/null @@ -1,197 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/internationalization.info -@node Internationalization, MULE, LDAP Support, top -@chapter Internationalization - -@menu -* I18N Levels 1 and 2:: Support for different time, date, and currency formats. -* I18N Level 3:: Support for localized messages. -* I18N Level 4:: Support for Asian languages. -@end menu - - -@node I18N Levels 1 and 2 -@section I18N Levels 1 and 2 - -XEmacs is now compliant with I18N levels 1 and 2. Specifically, this means -that it is 8-bit clean and correctly handles time and date functions. XEmacs -will correctly display the entire ISO-Latin 1 character set. - -The compose key may now be used to create any character in the ISO-Latin 1 -character set not directly available via the keyboard.. In order for the -compose key to work it is necessary to load the file @file{x-compose.el}. -At any time while composing a character, @code{C-h} will display all valid -completions and the character which would be produced. - - -@node I18N Level 3 -@section I18N Level 3 - -@menu -* Level 3 Basics:: -* Level 3 Primitives:: -* Dynamic Messaging:: -* Domain Specification:: -* Documentation String Extraction:: -@end menu - -@node Level 3 Basics -@subsection Level 3 Basics - -XEmacs now provides alpha-level functionality for I18N Level 3. This means -that everything necessary for full messaging is available, but not every -file has been converted. - -The two message files which have been created are @file{src/emacs.po} and -@file{lisp/packages/mh-e.po}. Both files need to be converted using -@code{msgfmt}, and the resulting @file{.mo} files placed in some locale's -@code{LC_MESSAGES} directory. The test ``translations'' in these files are -the original messages prefixed by @code{TRNSLT_}. - -The domain for a variable is stored on the variable's property list under -the property name @var{variable-domain}. The function -@code{documentation-property} uses this information when translating a -variable's documentation. - - -@node Level 3 Primitives -@subsection Level 3 Primitives - -@defun gettext string -This function looks up @var{string} in the default message domain and -returns its translation. If @code{I18N3} was not enabled when XEmacs was -compiled, it just returns @var{string}. -@end defun - -@defun dgettext domain string -This function looks up @var{string} in the specified message domain and -returns its translation. If @code{I18N3} was not enabled when XEmacs was -compiled, it just returns @var{string}. -@end defun - -@defun bind-text-domain domain pathname -This function associates a pathname with a message domain. -Here's how the path to message file is constructed under SunOS 5.x: - -@example -@code{@{pathname@}/@{LANG@}/LC_MESSAGES/@{domain@}.mo} -@end example - -If @code{I18N3} was not enabled when XEmacs was compiled, this function does -nothing. -@end defun - -@defspec domain string -This function specifies the text domain used for translating documentation -strings and interactive prompts of a function. For example, write: - -@example -(defun foo (arg) "Doc string" (domain "emacs-foo") @dots{}) -@end example - -to specify @code{emacs-foo} as the text domain of the function @code{foo}. -The ``call'' to @code{domain} is actually a declaration rather than a -function; when actually called, @code{domain} just returns @code{nil}. -@end defspec - -@defun domain-of function -This function returns the text domain of @var{function}; it returns -@code{nil} if it is the default domain. If @code{I18N3} was not enabled -when XEmacs was compiled, it always returns @code{nil}. -@end defun - - -@node Dynamic Messaging -@subsection Dynamic Messaging - -The @code{format} function has been extended to permit you to change the -order of parameter insertion. For example, the conversion format -@code{%1$s} inserts parameter one as a string, while @code{%2$s} inserts -parameter two. This is useful when creating translations which require you -to change the word order. - - -@node Domain Specification -@subsection Domain Specification - -The default message domain of XEmacs is `emacs'. For add-on packages, it is -best to use a different domain. For example, let us say we want to convert -the ``gorilla'' package to use the domain `emacs-gorilla'. -To translate the message ``What gorilla?'', use @code{dgettext} as follows: - -@example -(dgettext "emacs-gorilla" "What gorilla?") -@end example - -A function (or macro) which has a documentation string or an interactive -prompt needs to be associated with the domain in order for the documentation -or prompt to be translated. This is done with the @code{domain} special -form as follows: - -@page -@example -(defun scratch (location) - "Scratch the specified location." - (domain "emacs-gorilla") - (interactive "sScratch: ") - @dots{} ) -@end example - -It is most efficient to specify the domain in the first line of the -function body, before the @code{interactive} form. - -For variables and constants which have documentation strings, specify the -domain after the documentation. - -@defspec defvar symbol [value [doc-string [domain]]] -Example: -@example -(defvar weight 250 "Weight of gorilla, in pounds." "emacs-gorilla") -@end example -@end defspec - -@defspec defconst symbol [value [doc-string [domain]]] -Example: -@example -(defconst limbs 4 "Number of limbs" "emacs-gorilla") -@end example -@end defspec - -Autoloaded functions which are specified in @file{loaddefs.el} do not need -to have a domain specification, because their documentation strings are -extracted into the main message base. However, for autoloaded functions -which are specified in a separate package, use following syntax: - -@defun autoload symbol filename &optional docstring interactive macro domain -Example: -@example -(autoload 'explore "jungle" "Explore the jungle." nil nil "emacs-gorilla") -@end example -@end defun - - -@node Documentation String Extraction -@subsection Documentation String Extraction - -The utility @file{etc/make-po} scans the file @code{DOC} to extract -documentation strings and creates a message file @code{doc.po}. This file -may then be inserted within @code{emacs.po}. - -Currently, @code{make-po} is hard-coded to read from @code{DOC} and write -to @code{doc.po}. In order to extract documentation strings from an add-on -package, first run @code{make-docfile} on the package to produce the -@code{DOC} file. Then run @code{make-po -p} with the @code{-p} argument to -indicate that we are extracting documentation for an add-on package. - -(The @code{-p} argument is a kludge to make up for a subtle difference -between pre-loaded documentation and add-on documentation: For add-on -packages, the final carriage returns in the strings produced by -@code{make-docfile} must be ignored.) - -@node I18N Level 4 -@section I18N Level 4 - -The Asian-language support in XEmacs is called ``MULE''. @xref{MULE}. diff --git a/man/lispref/intro.texi b/man/lispref/intro.texi deleted file mode 100644 index 0896fce..0000000 --- a/man/lispref/intro.texi +++ /dev/null @@ -1,876 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/intro.info - -@node Copying, Introduction, Top, Top -@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. - -@node Introduction, Lisp Data Types, Copying, Top -@chapter Introduction - - Most of the XEmacs text editor is written in the programming -language called XEmacs Lisp. You can write new code in XEmacs Lisp and -install it as an extension to the editor. However, XEmacs Lisp is more -than a mere ``extension language''; it is a full computer programming -language in its own right. You can use it as you would any other -programming language. - - Because XEmacs Lisp is designed for use in an editor, it has special -features for scanning and parsing text as well as features for handling -files, buffers, displays, subprocesses, and so on. XEmacs Lisp is -closely integrated with the editing facilities; thus, editing commands -are functions that can also conveniently be called from Lisp programs, -and parameters for customization are ordinary Lisp variables. - - This manual describes XEmacs Lisp, presuming considerable familiarity -with the use of XEmacs for editing. (See @cite{The XEmacs Reference -Manual}, for this basic information.) Generally speaking, the earlier -chapters describe features of XEmacs Lisp that have counterparts in many -programming languages, and later chapters describe features that are -peculiar to XEmacs Lisp or relate specifically to editing. - - This is edition 3.3. - -@menu -* Caveats:: Flaws and a request for help. -* Lisp History:: XEmacs Lisp is descended from Maclisp. -* Conventions:: How the manual is formatted. -* Acknowledgements:: The authors, editors, and sponsors of this manual. -@end menu - -@node Caveats -@section Caveats - - This manual has gone through numerous drafts. It is nearly complete -but not flawless. There are a few topics that are not covered, either -because we consider them secondary (such as most of the individual -modes) or because they are yet to be written. Because we are not able -to deal with them completely, we have left out several parts -intentionally. This includes most information about usage on VMS. - - The manual should be fully correct in what it does cover, and it is -therefore open to criticism on anything it says---from specific examples -and descriptive text, to the ordering of chapters and sections. If -something is confusing, or you find that you have to look at the sources -or experiment to learn something not covered in the manual, then perhaps -the manual should be fixed. Please let us know. - -@iftex - As you use the manual, we ask that you mark pages with corrections so -you can later look them up and send them in. If you think of a simple, -real-life example for a function or group of functions, please make an -effort to write it up and send it in. Please reference any comments to -the chapter name, section name, and function name, as appropriate, since -page numbers and chapter and section numbers will change and we may have -trouble finding the text you are talking about. Also state the number -of the edition you are criticizing. -@end iftex -@ifinfo - -As you use this manual, we ask that you send corrections as soon as you -find them. If you think of a simple, real life example for a function -or group of functions, please make an effort to write it up and send it -in. Please reference any comments to the node name and function or -variable name, as appropriate. Also state the number of the edition -which you are criticizing. -@end ifinfo - -This manual was originally written for FSF Emacs 19 and was updated by -Ben Wing (wing@@666.com) for Lucid Emacs 19.10 and later for XEmacs -19.12, 19.13, 19.14, and 20.0. It was further updated by the XEmacs -Development Team for 19.15 and 20.1. Please send comments and -corrections relating to XEmacs-specific portions of this manual to -@example -xemacs@@xemacs.org -@end example - -or post to the newsgroup -@example -comp.emacs.xemacs -@end example - -@noindent -@display - --Ben Wing -@end display - -@node Lisp History -@section Lisp History -@cindex Lisp history - - Lisp (LISt Processing language) was first developed in the late 1950's -at the Massachusetts Institute of Technology for research in artificial -intelligence. The great power of the Lisp language makes it superior -for other purposes as well, such as writing editing commands. - -@cindex Maclisp -@cindex Common Lisp - Dozens of Lisp implementations have been built over the years, each -with its own idiosyncrasies. Many of them were inspired by Maclisp, -which was written in the 1960's at MIT's Project MAC. Eventually the -implementors of the descendants of Maclisp came together and developed a -standard for Lisp systems, called Common Lisp. - - XEmacs Lisp is largely inspired by Maclisp, and a little by Common -Lisp. If you know Common Lisp, you will notice many similarities. -However, many of the features of Common Lisp have been omitted or -simplified in order to reduce the memory requirements of XEmacs. -Sometimes the simplifications are so drastic that a Common Lisp user -might be very confused. We will occasionally point out how XEmacs -Lisp differs from Common Lisp. If you don't know Common Lisp, don't -worry about it; this manual is self-contained. - -@node Conventions -@section Conventions - -This section explains the notational conventions that are used in this -manual. You may want to skip this section and refer back to it later. - -@menu -* Some Terms:: Explanation of terms we use in this manual. -* nil and t:: How the symbols @code{nil} and @code{t} are used. -* Evaluation Notation:: The format we use for examples of evaluation. -* Printing Notation:: The format we use for examples that print output. -* Error Messages:: The format we use for examples of errors. -* Buffer Text Notation:: The format we use for buffer contents in examples. -* Format of Descriptions:: Notation for describing functions, variables, etc. -@end menu - -@node Some Terms -@subsection Some Terms - - Throughout this manual, the phrases ``the Lisp reader'' and ``the Lisp -printer'' are used to refer to those routines in Lisp that convert -textual representations of Lisp objects into actual Lisp objects, and vice -versa. @xref{Printed Representation}, for more details. You, the -person reading this manual, are thought of as ``the programmer'' and are -addressed as ``you''. ``The user'' is the person who uses Lisp programs, -including those you write. - -@cindex fonts - Examples of Lisp code appear in this font or form: @code{(list 1 2 -3)}. Names that represent arguments or metasyntactic variables appear -in this font or form: @var{first-number}. - -@node nil and t -@subsection @code{nil} and @code{t} -@cindex @code{nil}, uses of -@cindex truth value -@cindex boolean -@cindex false - - In Lisp, the symbol @code{nil} has three separate meanings: it -is a symbol with the name @samp{nil}; it is the logical truth value -@var{false}; and it is the empty list---the list of zero elements. -When used as a variable, @code{nil} always has the value @code{nil}. - - As far as the Lisp reader is concerned, @samp{()} and @samp{nil} are -identical: they stand for the same object, the symbol @code{nil}. The -different ways of writing the symbol are intended entirely for human -readers. After the Lisp reader has read either @samp{()} or @samp{nil}, -there is no way to determine which representation was actually written -by the programmer. - - In this manual, we use @code{()} when we wish to emphasize that it -means the empty list, and we use @code{nil} when we wish to emphasize -that it means the truth value @var{false}. That is a good convention to use -in Lisp programs also. - -@example -(cons 'foo ()) ; @r{Emphasize the empty list} -(not nil) ; @r{Emphasize the truth value @var{false}} -@end example - -@cindex @code{t} and truth -@cindex true - In contexts where a truth value is expected, any non-@code{nil} value -is considered to be @var{true}. However, @code{t} is the preferred way -to represent the truth value @var{true}. When you need to choose a -value which represents @var{true}, and there is no other basis for -choosing, use @code{t}. The symbol @code{t} always has value @code{t}. - - In XEmacs Lisp, @code{nil} and @code{t} are special symbols that always -evaluate to themselves. This is so that you do not need to quote them -to use them as constants in a program. An attempt to change their -values results in a @code{setting-constant} error. @xref{Accessing -Variables}. - -@node Evaluation Notation -@subsection Evaluation Notation -@cindex evaluation notation -@cindex documentation notation - - A Lisp expression that you can evaluate is called a @dfn{form}. -Evaluating a form always produces a result, which is a Lisp object. In -the examples in this manual, this is indicated with @samp{@result{}}: - -@example -(car '(1 2)) - @result{} 1 -@end example - -@noindent -You can read this as ``@code{(car '(1 2))} evaluates to 1''. - - When a form is a macro call, it expands into a new form for Lisp to -evaluate. We show the result of the expansion with -@samp{@expansion{}}. We may or may not show the actual result of the -evaluation of the expanded form. - -@example -(news-cadr '(a b c)) - @expansion{} (car (cdr '(a b c))) - @result{} b -@end example - - Sometimes to help describe one form we show another form that -produces identical results. The exact equivalence of two forms is -indicated with @samp{@equiv{}}. - -@example -(cons 'a nil) @equiv{} (list 'a) -@end example - -@node Printing Notation -@subsection Printing Notation -@cindex printing notation - - Many of the examples in this manual print text when they are -evaluated. If you execute example code in a Lisp Interaction buffer -(such as the buffer @samp{*scratch*}), the printed text is inserted into -the buffer. If you execute the example by other means (such as by -evaluating the function @code{eval-region}), the printed text is -displayed in the echo area. You should be aware that text displayed in -the echo area is truncated to a single line. - - Examples in this manual indicate printed text with @samp{@print{}}, -irrespective of where that text goes. The value returned by evaluating -the form (here @code{bar}) follows on a separate line. - -@example -@group -(progn (print 'foo) (print 'bar)) - @print{} foo - @print{} bar - @result{} bar -@end group -@end example - -@node Error Messages -@subsection Error Messages -@cindex error message notation - - Some examples signal errors. This normally displays an error message -in the echo area. We show the error message on a line starting with -@samp{@error{}}. Note that @samp{@error{}} itself does not appear in -the echo area. - -@example -(+ 23 'x) -@error{} Wrong type argument: integer-or-marker-p, x -@end example - -@node Buffer Text Notation -@subsection Buffer Text Notation -@cindex buffer text notation - - Some examples show modifications to text in a buffer, with ``before'' -and ``after'' versions of the text. These examples show the contents of -the buffer in question between two lines of dashes containing the buffer -name. In addition, @samp{@point{}} indicates the location of point. -(The symbol for point, of course, is not part of the text in the buffer; -it indicates the place @emph{between} two characters where point is -located.) - -@example ----------- Buffer: foo ---------- -This is the @point{}contents of foo. ----------- Buffer: foo ---------- - -(insert "changed ") - @result{} nil ----------- Buffer: foo ---------- -This is the changed @point{}contents of foo. ----------- Buffer: foo ---------- -@end example - -@node Format of Descriptions -@subsection Format of Descriptions -@cindex description format - - Functions, variables, macros, commands, user options, and special -forms are described in this manual in a uniform format. The first -line of a description contains the name of the item followed by its -arguments, if any. -@ifinfo -The category---function, variable, or whatever---appears at the -beginning of the line. -@end ifinfo -@iftex -The category---function, variable, or whatever---is printed next to the -right margin. -@end iftex -The description follows on succeeding lines, sometimes with examples. - -@menu -* A Sample Function Description:: A description of an imaginary - function, @code{foo}. -* A Sample Variable Description:: A description of an imaginary - variable, - @code{electric-future-map}. -@end menu - -@node A Sample Function Description -@subsubsection A Sample Function Description -@cindex function descriptions -@cindex command descriptions -@cindex macro descriptions -@cindex special form descriptions - - In a function description, the name of the function being described -appears first. It is followed on the same line by a list of parameters. -The names used for the parameters are also used in the body of the -description. - - The appearance of the keyword @code{&optional} in the parameter list -indicates that the arguments for subsequent parameters may be omitted -(omitted parameters default to @code{nil}). Do not write -@code{&optional} when you call the function. - - The keyword @code{&rest} (which will always be followed by a single -parameter) indicates that any number of arguments can follow. The value -of the single following parameter will be a list of all these arguments. -Do not write @code{&rest} when you call the function. - - Here is a description of an imaginary function @code{foo}: - -@defun foo integer1 &optional integer2 &rest integers -The function @code{foo} subtracts @var{integer1} from @var{integer2}, -then adds all the rest of the arguments to the result. If @var{integer2} -is not supplied, then the number 19 is used by default. - -@example -(foo 1 5 3 9) - @result{} 16 -(foo 5) - @result{} 14 -@end example - -More generally, - -@example -(foo @var{w} @var{x} @var{y}@dots{}) -@equiv{} -(+ (- @var{x} @var{w}) @var{y}@dots{}) -@end example -@end defun - - Any parameter whose name contains the name of a type (e.g., -@var{integer}, @var{integer1} or @var{buffer}) is expected to be of that -type. A plural of a type (such as @var{buffers}) often means a list of -objects of that type. Parameters named @var{object} may be of any type. -(@xref{Lisp Data Types}, for a list of XEmacs object types.) -Parameters with other sorts of names (e.g., @var{new-file}) are -discussed specifically in the description of the function. In some -sections, features common to parameters of several functions are -described at the beginning. - - @xref{Lambda Expressions}, for a more complete description of optional -and rest arguments. - - Command, macro, and special form descriptions have the same format, -but the word `Function' is replaced by `Command', `Macro', or `Special -Form', respectively. Commands are simply functions that may be called -interactively; macros process their arguments differently from functions -(the arguments are not evaluated), but are presented the same way. - - Special form descriptions use a more complex notation to specify -optional and repeated parameters because they can break the argument -list down into separate arguments in more complicated ways. -@samp{@code{@r{[}@var{optional-arg}@r{]}}} means that @var{optional-arg} is -optional and @samp{@var{repeated-args}@dots{}} stands for zero or more -arguments. Parentheses are used when several arguments are grouped into -additional levels of list structure. Here is an example: - -@defspec count-loop (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} -This imaginary special form implements a loop that executes the -@var{body} forms and then increments the variable @var{var} on each -iteration. On the first iteration, the variable has the value -@var{from}; on subsequent iterations, it is incremented by 1 (or by -@var{inc} if that is given). The loop exits before executing @var{body} -if @var{var} equals @var{to}. Here is an example: - -@example -(count-loop (i 0 10) - (prin1 i) (princ " ") - (prin1 (aref vector i)) (terpri)) -@end example - -If @var{from} and @var{to} are omitted, then @var{var} is bound to -@code{nil} before the loop begins, and the loop exits if @var{var} is -non-@code{nil} at the beginning of an iteration. Here is an example: - -@example -(count-loop (done) - (if (pending) - (fixit) - (setq done t))) -@end example - -In this special form, the arguments @var{from} and @var{to} are -optional, but must both be present or both absent. If they are present, -@var{inc} may optionally be specified as well. These arguments are -grouped with the argument @var{var} into a list, to distinguish them -from @var{body}, which includes all remaining elements of the form. -@end defspec - -@node A Sample Variable Description -@subsubsection A Sample Variable Description -@cindex variable descriptions -@cindex option descriptions - - A @dfn{variable} is a name that can hold a value. Although any -variable can be set by the user, certain variables that exist -specifically so that users can change them are called @dfn{user -options}. Ordinary variables and user options are described using a -format like that for functions except that there are no arguments. - - Here is a description of the imaginary @code{electric-future-map} -variable.@refill - -@defvar electric-future-map -The value of this variable is a full keymap used by Electric Command -Future mode. The functions in this map allow you to edit commands you -have not yet thought about executing. -@end defvar - - User option descriptions have the same format, but `Variable' is -replaced by `User Option'. - -@node Acknowledgements -@section Acknowledgements - - This manual was based on the GNU Emacs Lisp Reference Manual, version -2.4, written by Robert Krawitz, Bil Lewis, Dan LaLiberte, Richard -M. Stallman and Chris Welty, the volunteers of the GNU manual group, in -an effort extending over several years. Robert J. Chassell helped to -review and edit the manual, with the support of the Defense Advanced -Research Projects Agency, ARPA Order 6082, arranged by Warren A. Hunt, -Jr. of Computational Logic, Inc. - - Ben Wing adapted this manual for XEmacs 19.14 and 20.0, and earlier -for Lucid Emacs 19.10, XEmacs 19.12, and XEmacs 19.13. He is the sole -author of many of the manual sections, in particular the XEmacs-specific -sections: events, faces, extents, glyphs, specifiers, toolbar, menubars, -scrollbars, dialog boxes, devices, consoles, hash tables, range tables, -char tables, databases, and others. The section on annotations was -originally written by Chuck Thompson. Corrections to v3.1 and later were -done by Martin Buchholz, Steve Baur, and Hrvoje Niksic. - - Corrections to the original GNU Emacs Lisp Reference Manual were -supplied by Karl Berry, Jim Blandy, Bard Bloom, Stephane Boucher, David -Boyes, Alan Carroll, Richard Davis, Lawrence R. Dodd, Peter Doornbosch, -David A. Duff, Chris Eich, Beverly Erlebacher, David Eckelkamp, Ralf -Fassel, Eirik Fuller, Stephen Gildea, Bob Glickstein, Eric Hanchrow, -George Hartzell, Nathan Hess, Masayuki Ida, Dan Jacobson, Jak Kirman, -Bob Knighten, Frederick M. Korz, Joe Lammens, Glenn M. Lewis, K. Richard -Magill, Brian Marick, Roland McGrath, Skip Montanaro, John Gardiner -Myers, Thomas A. Peterson, Francesco Potorti, Friedrich Pukelsheim, -Arnold D. Robbins, Raul Rockwell, Per Starback, Shinichirou Sugou, Kimmo -Suominen, Edward Tharp, Bill Trost, Rickard Westman, Jean White, Matthew -Wilding, Carl Witty, Dale Worley, Rusty Wright, and David D. Zuhn. diff --git a/man/lispref/keymaps.texi b/man/lispref/keymaps.texi deleted file mode 100644 index 3fd15ff..0000000 --- a/man/lispref/keymaps.texi +++ /dev/null @@ -1,1577 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/keymaps.info -@node Keymaps, Menus, Command Loop, Top -@chapter Keymaps -@cindex keymap - -@c This section is largely different from the one in FSF Emacs. - - The bindings between input events and commands are recorded in data -structures called @dfn{keymaps}. Each binding in a keymap associates -(or @dfn{binds}) an individual event type either with another keymap or -with a command. When an event is bound to a keymap, that keymap is -used to look up the next input event; this continues until a command -is found. The whole process is called @dfn{key lookup}. - -@menu -* Keymap Terminology:: Definitions of terms pertaining to keymaps. -* Format of Keymaps:: What a keymap looks like as a Lisp object. -* Creating Keymaps:: Functions to create and copy keymaps. -* Inheritance and Keymaps:: How one keymap can inherit the bindings - of another keymap. -* Key Sequences:: How to specify key sequences. -* Prefix Keys:: Defining a key with a keymap as its definition. -* Active Keymaps:: Each buffer has a local keymap - to override the standard (global) bindings. - A minor mode can also override them. -* Key Lookup:: How extracting elements from keymaps works. -* Functions for Key Lookup:: How to request key lookup. -* Changing Key Bindings:: Redefining a key in a keymap. -* Key Binding Commands:: Interactive interfaces for redefining keys. -* Scanning Keymaps:: Looking through all keymaps, for printing help. -* Other Keymap Functions:: Miscellaneous keymap functions. -@end menu - -@node Keymap Terminology -@section Keymap Terminology -@cindex key -@cindex keystroke -@cindex key binding -@cindex binding of a key -@cindex complete key -@cindex undefined key - - A @dfn{keymap} is a table mapping event types to definitions (which -can be any Lisp objects, though only certain types are meaningful for -execution by the command loop). Given an event (or an event type) and a -keymap, XEmacs can get the event's definition. Events mapped in keymaps -include keypresses, button presses, and button releases -(@pxref{Events}). - - A sequence of input events that form a unit is called a -@dfn{key sequence}, or @dfn{key} for short. A sequence of one event -is always a key sequence, and so are some multi-event sequences. - - A keymap determines a binding or definition for any key sequence. If -the key sequence is a single event, its binding is the definition of the -event in the keymap. The binding of a key sequence of more than one -event is found by an iterative process: the binding of the first event -is found, and must be a keymap; then the second event's binding is found -in that keymap, and so on until all the events in the key sequence are -used up. - - If the binding of a key sequence is a keymap, we call the key sequence -a @dfn{prefix key}. Otherwise, we call it a @dfn{complete key} (because -no more events can be added to it). If the binding is @code{nil}, -we call the key @dfn{undefined}. Examples of prefix keys are @kbd{C-c}, -@kbd{C-x}, and @kbd{C-x 4}. Examples of defined complete keys are -@kbd{X}, @key{RET}, and @kbd{C-x 4 C-f}. Examples of undefined complete -keys are @kbd{C-x C-g}, and @kbd{C-c 3}. @xref{Prefix Keys}, for more -details. - - The rule for finding the binding of a key sequence assumes that the -intermediate bindings (found for the events before the last) are all -keymaps; if this is not so, the sequence of events does not form a -unit---it is not really a key sequence. In other words, removing one or -more events from the end of any valid key must always yield a prefix -key. For example, @kbd{C-f C-n} is not a key; @kbd{C-f} is not a prefix -key, so a longer sequence starting with @kbd{C-f} cannot be a key. - - Note that the set of possible multi-event key sequences depends on the -bindings for prefix keys; therefore, it can be different for different -keymaps, and can change when bindings are changed. However, a one-event -sequence is always a key sequence, because it does not depend on any -prefix keys for its well-formedness. - - At any time, several primary keymaps are @dfn{active}---that is, in -use for finding key bindings. These are the @dfn{global map}, which is -shared by all buffers; the @dfn{local keymap}, which is usually -associated with a specific major mode; and zero or more @dfn{minor mode -keymaps}, which belong to currently enabled minor modes. (Not all minor -modes have keymaps.) The local keymap bindings shadow (i.e., take -precedence over) the corresponding global bindings. The minor mode -keymaps shadow both local and global keymaps. @xref{Active Keymaps}, -for details. - -@node Format of Keymaps -@section Format of Keymaps -@cindex format of keymaps -@cindex keymap format - - A keymap is a primitive type that associates events with their -bindings. Note that this is different from Emacs 18 and FSF Emacs, -where keymaps are lists. - -@defun keymapp object -This function returns @code{t} if @var{object} is a keymap, @code{nil} -otherwise. -@end defun - -@node Creating Keymaps -@section Creating Keymaps -@cindex creating keymaps - - Here we describe the functions for creating keymaps. - -@defun make-keymap &optional name -This function constructs and returns a new keymap object. All entries -in it are @code{nil}, meaning ``command undefined''. - -Optional argument @var{name} specifies a name to assign to the keymap, -as in @code{set-keymap-name}. This name is only a debugging -convenience; it is not used except when printing the keymap. -@end defun - -@defun make-sparse-keymap &optional name -This function constructs and returns a new keymap object. All entries -in it are @code{nil}, meaning ``command undefined''. The only -difference between this function and @code{make-keymap} is that this -function returns a ``smaller'' keymap (one that is expected to contain -fewer entries). As keymaps dynamically resize, the distinction is not -great. - -Optional argument @var{name} specifies a name to assign to the keymap, -as in @code{set-keymap-name}. This name is only a debugging -convenience; it is not used except when printing the keymap. -@end defun - -@defun set-keymap-name keymap new-name -This function assigns a ``name'' to a keymap. The name is only a -debugging convenience; it is not used except when printing the keymap. -@end defun - -@defun keymap-name keymap -This function returns the ``name'' of a keymap, as assigned using -@code{set-keymap-name}. -@end defun - -@defun copy-keymap keymap -This function returns a copy of @var{keymap}. Any keymaps that -appear directly as bindings in @var{keymap} are also copied recursively, -and so on to any number of levels. However, recursive copying does not -take place when the definition of a character is a symbol whose function -definition is a keymap; the same symbol appears in the new copy. - -@example -@group -(setq map (copy-keymap (current-local-map))) -@result{} # -@end group - -@group -(eq map (current-local-map)) - @result{} nil -@end group -@ignore @c Doesn't work! -@group -(equal map (current-local-map)) - @result{} t -@end group -@end ignore -@end example -@end defun - -@node Inheritance and Keymaps -@section Inheritance and Keymaps -@cindex keymap inheritance -@cindex inheriting a keymap's bindings -@cindex keymap parent -@cindex parent of a keymap - - A keymap can inherit the bindings of other keymaps. The other -keymaps are called the keymap's @dfn{parents}, and are set with -@code{set-keymap-parents}. When searching for a binding for a key -sequence in a particular keymap, that keymap itself will first be -searched; then, if no binding was found in the map and it has parents, -the first parent keymap will be searched; then that keymap's parent will -be searched, and so on, until either a binding for the key sequence is -found, or a keymap without a parent is encountered. At this point, -the search will continue with the next parent of the most recently -encountered keymap that has another parent, etc. Essentially, a -depth-first search of all the ancestors of the keymap is conducted. - -@code{(current-global-map)} is the default parent of all keymaps. - -@defun set-keymap-parents keymap parents -This function sets the parent keymaps of @var{keymap} to the list -@var{parents}. - -If you change the bindings in one of the keymaps in @var{parents} using -@code{define-key} or other key-binding functions, these changes are -visible in @var{keymap} unless shadowed by bindings in that map or in -earlier-searched ancestors. The converse is not true: if you use -@code{define-key} to change @var{keymap}, that affects the bindings in -that map, but has no effect on any of the keymaps in @var{parents}. -@end defun - -@defun keymap-parents keymap -This function returns the list of parent keymaps of @var{keymap}, or -@code{nil} if @var{keymap} has no parents. -@end defun - - As an alternative to specifying a parent, you can also specify a -@dfn{default binding} that is used whenever a key is not otherwise bound -in the keymap. This is useful for terminal emulators, for example, -which may want to trap all keystrokes and pass them on in some modified -format. Note that if you specify a default binding for a keymap, -neither the keymap's parents nor the current global map are searched for -key bindings. - -@defun set-keymap-default-binding keymap command -This function sets the default binding of @var{keymap} to @var{command}, -or @code{nil} if no default is desired. -@end defun - -@defun keymap-default-binding keymap -This function returns the default binding of @var{keymap}, or @code{nil} -if it has none. -@end defun - -@node Key Sequences -@section Key Sequences -@cindex key sequences - - Contrary to popular belief, the world is not @sc{ASCII}. When running -under a window manager, XEmacs can tell the difference between, for -example, the keystrokes @kbd{control-h}, @kbd{control-shift-h}, and -@kbd{backspace}. You can, in fact, bind different commands to each of -these. - - A @dfn{key sequence} is a set of keystrokes. A @dfn{keystroke} is a -keysym and some set of modifiers (such as @key{CONTROL} and @key{META}). -A @dfn{keysym} is what is printed on the keys on your keyboard. - - A keysym may be represented by a symbol, or (if and only if it is -equivalent to an @sc{ASCII} character in the range 32 - 255) by a -character or its equivalent @sc{ASCII} code. The @kbd{A} key may be -represented by the symbol @code{A}, the character @code{?A}, or by the -number 65. The @kbd{break} key may be represented only by the symbol -@code{break}. - - A keystroke may be represented by a list: the last element of the list -is the key (a symbol, character, or number, as above) and the preceding -elements are the symbolic names of modifier keys (@key{CONTROL}, -@key{META}, @key{SUPER}, @key{HYPER}, @key{ALT}, and @key{SHIFT}). -Thus, the sequence @kbd{control-b} is represented by the forms -@code{(control b)}, @code{(control ?b)}, and @code{(control 98)}. A -keystroke may also be represented by an event object, as returned by the -@code{next-command-event} and @code{read-key-sequence} functions. - - Note that in this context, the keystroke @kbd{control-b} is @emph{not} -represented by the number 2 (the @sc{ASCII} code for @samp{^B}) or the -character @code{?\^B}. See below. - - The @key{SHIFT} modifier is somewhat of a special case. You should -not (and cannot) use @code{(meta shift a)} to mean @code{(meta A)}, -since for characters that have @sc{ASCII} equivalents, the state of the -shift key is implicit in the keysym (@samp{a} vs. @samp{A}). You also -cannot say @code{(shift =)} to mean @code{+}, as that sort of thing -varies from keyboard to keyboard. The @key{SHIFT} modifier is for use -only with characters that do not have a second keysym on the same key, -such as @code{backspace} and @code{tab}. - - A key sequence is a vector of keystrokes. As a degenerate case, -elements of this vector may also be keysyms if they have no modifiers. -That is, the @kbd{A} keystroke is represented by all of these forms: - -@example - A ?A 65 (A) (?A) (65) - [A] [?A] [65] [(A)] [(?A)] [(65)] -@end example - -the @kbd{control-a} keystroke is represented by these forms: - -@example - (control A) (control ?A) (control 65) - [(control A)] [(control ?A)] [(control 65)] -@end example - -the key sequence @kbd{control-c control-a} is represented by these -forms: - -@example - [(control c) (control a)] [(control ?c) (control ?a)] - [(control 99) (control 65)] etc. -@end example - - Mouse button clicks work just like keypresses: @code{(control -button1)} means pressing the left mouse button while holding down the -control key. @code{[(control c) (shift button3)]} means -@kbd{control-c}, hold @key{SHIFT}, click right. - - Commands may be bound to the mouse-button up-stroke rather than the -down-stroke as well. @code{button1} means the down-stroke, and -@code{button1up} means the up-stroke. Different commands may be bound -to the up and down strokes, though that is probably not what you want, -so be careful. - - For backward compatibility, a key sequence may also be represented by -a string. In this case, it represents the key sequence(s) that would -produce that sequence of @sc{ASCII} characters in a purely @sc{ASCII} -world. For example, a string containing the @sc{ASCII} backspace -character, @code{"\^H"}, would represent two key sequences: -@code{(control h)} and @code{backspace}. Binding a command to this will -actually bind both of those key sequences. Likewise for the following -pairs: - -@example - control h backspace - control i tab - control m return - control j linefeed - control [ escape - control @@ control space -@end example - - After binding a command to two key sequences with a form like - -@example - (define-key global-map "\^X\^I" 'command-1) -@end example - -@noindent -it is possible to redefine only one of those sequences like so: - -@example - (define-key global-map [(control x) (control i)] 'command-2) - (define-key global-map [(control x) tab] 'command-3) -@end example - - Of course, all of this applies only when running under a window -system. If you're talking to XEmacs through a @sc{TTY} connection, you -don't get any of these features. - -@defun event-matches-key-specifier-p event key-specifier -This function returns non-@code{nil} if @var{event} matches -@var{key-specifier}, which can be any valid form representing a key -sequence. This can be useful, e.g., to determine if the user pressed -@code{help-char} or @code{quit-char}. -@end defun - -@node Prefix Keys -@section Prefix Keys -@cindex prefix key - - A @dfn{prefix key} has an associated keymap that defines what to do -with key sequences that start with the prefix key. For example, -@kbd{C-x} is a prefix key, and it uses a keymap that is also stored in -the variable @code{ctl-x-map}. Here is a list of the standard prefix -keys of XEmacs and their keymaps: - -@itemize @bullet -@item -@cindex @kbd{C-h} -@code{help-map} is used for events that follow @kbd{C-h}. - -@item -@cindex @kbd{C-c} -@vindex mode-specific-map -@code{mode-specific-map} is for events that follow @kbd{C-c}. This -map is not actually mode specific; its name was chosen to be informative -for the user in @kbd{C-h b} (@code{display-bindings}), where it -describes the main use of the @kbd{C-c} prefix key. - -@item -@cindex @kbd{C-x} -@vindex ctl-x-map -@findex Control-X-prefix -@code{ctl-x-map} is the map used for events that follow @kbd{C-x}. This -map is also the function definition of @code{Control-X-prefix}. - -@item -@cindex @kbd{C-x 4} -@vindex ctl-x-4-map -@code{ctl-x-4-map} is used for events that follow @kbd{C-x 4}. - -@c Emacs 19 feature -@item -@cindex @kbd{C-x 5} -@vindex ctl-x-5-map -@code{ctl-x-5-map} is used for events that follow @kbd{C-x 5}. - -@c Emacs 19 feature -@item -@cindex @kbd{C-x n} -@cindex @kbd{C-x r} -@cindex @kbd{C-x a} -The prefix keys @kbd{C-x n}, @kbd{C-x r} and @kbd{C-x a} use keymaps -that have no special name. - -@item -@vindex esc-map -@findex ESC-prefix -@code{esc-map} is an evil hack that is present for compatibility -purposes with Emacs 18. Defining a key in @code{esc-map} is equivalent -to defining the same key in @code{global-map} but with the @key{META} -prefix added. You should @emph{not} use this in your code. (This map is -also the function definition of @code{ESC-prefix}.) -@end itemize - - The binding of a prefix key is the keymap to use for looking up the -events that follow the prefix key. (It may instead be a symbol whose -function definition is a keymap. The effect is the same, but the symbol -serves as a name for the prefix key.) Thus, the binding of @kbd{C-x} is -the symbol @code{Control-X-prefix}, whose function definition is the -keymap for @kbd{C-x} commands. (The same keymap is also the value of -@code{ctl-x-map}.) - - Prefix key definitions can appear in any active keymap. The -definitions of @kbd{C-c}, @kbd{C-x}, @kbd{C-h} and @key{ESC} as prefix -keys appear in the global map, so these prefix keys are always -available. Major and minor modes can redefine a key as a prefix by -putting a prefix key definition for it in the local map or the minor -mode's map. @xref{Active Keymaps}. - - If a key is defined as a prefix in more than one active map, then its -various definitions are in effect merged: the commands defined in the -minor mode keymaps come first, followed by those in the local map's -prefix definition, and then by those from the global map. - - In the following example, we make @kbd{C-p} a prefix key in the local -keymap, in such a way that @kbd{C-p} is identical to @kbd{C-x}. Then -the binding for @kbd{C-p C-f} is the function @code{find-file}, just -like @kbd{C-x C-f}. The key sequence @kbd{C-p 6} is not found in any -active keymap. - -@example -@group -(use-local-map (make-sparse-keymap)) - @result{} nil -@end group -@group -(local-set-key "\C-p" ctl-x-map) - @result{} nil -@end group -@group -(key-binding "\C-p\C-f") - @result{} find-file -@end group - -@group -(key-binding "\C-p6") - @result{} nil -@end group -@end example - -@defun define-prefix-command symbol &optional mapvar -@cindex prefix command -This function defines @var{symbol} as a prefix command: it creates a -keymap and stores it as @var{symbol}'s function definition. -Storing the symbol as the binding of a key makes the key a prefix key -that has a name. If optional argument @var{mapvar} is not specified, -it also sets @var{symbol} as a variable, to have the keymap as its -value. (If @var{mapvar} is given and is not @code{t}, its value is -stored as the value of @var{symbol}.) The function returns @var{symbol}. - - In Emacs version 18, only the function definition of @var{symbol} was -set, not the value as a variable. -@end defun - -@node Active Keymaps -@section Active Keymaps -@cindex active keymap -@cindex global keymap -@cindex local keymap - - XEmacs normally contains many keymaps; at any given time, just a few of -them are @dfn{active} in that they participate in the interpretation -of user input. These are the global keymap, the current buffer's -local keymap, and the keymaps of any enabled minor modes. - - The @dfn{global keymap} holds the bindings of keys that are defined -regardless of the current buffer, such as @kbd{C-f}. The variable -@code{global-map} holds this keymap, which is always active. - - Each buffer may have another keymap, its @dfn{local keymap}, which may -contain new or overriding definitions for keys. The current buffer's -local keymap is always active except when @code{overriding-local-map} or -@code{overriding-terminal-local-map} overrides it. Extents and text -properties can specify an alternative local map for certain parts of the -buffer; see @ref{Extents and Events}. - - Each minor mode may have a keymap; if it does, the keymap is active -when the minor mode is enabled. - - The variable @code{overriding-local-map} and -@code{overriding-terminal-local-map}, if non-@code{nil}, specify other -local keymaps that override the buffer's local map and all the minor -mode keymaps. - - All the active keymaps are used together to determine what command to -execute when a key is entered. XEmacs searches these maps one by one, in -order of decreasing precedence, until it finds a binding in one of the maps. - - More specifically: - - For key-presses, the order of keymaps searched is: - -@itemize @bullet -@item -the @code{keymap} property of any extent(s) or text properties at point; -@item -any applicable minor-mode maps; -@item -the current local map of the current buffer; -@item -the current global map. -@end itemize - - For mouse-clicks, the order of keymaps searched is: - -@itemize @bullet -@item -the current local map of the @code{mouse-grabbed-buffer} if any; -@item -the @code{keymap} property of any extent(s) at the position of the click -(this includes modeline extents); -@item -the @code{modeline-map} of the buffer corresponding to the modeline -under the mouse (if the click happened over a modeline); -@item -the value of @code{toolbar-map} in the current buffer (if the click -happened over a toolbar); -@item -the current local map of the buffer under the mouse (does not -apply to toolbar clicks); -@item -any applicable minor-mode maps; -@item -the current global map. -@end itemize - - Note that if @code{overriding-local-map} or -@code{overriding-terminal-local-map} is non-@code{nil}, @emph{only} -those two maps and the current global map are searched. - - The procedure for searching a single keymap is called -@dfn{key lookup}; see @ref{Key Lookup}. - -@cindex major mode keymap - Since every buffer that uses the same major mode normally uses the -same local keymap, you can think of the keymap as local to the mode. A -change to the local keymap of a buffer (using @code{local-set-key}, for -example) is seen also in the other buffers that share that keymap. - - The local keymaps that are used for Lisp mode, C mode, and several -other major modes exist even if they have not yet been used. These -local maps are the values of the variables @code{lisp-mode-map}, -@code{c-mode-map}, and so on. For most other modes, which are less -frequently used, the local keymap is constructed only when the mode is -used for the first time in a session. - - The minibuffer has local keymaps, too; they contain various completion -and exit commands. @xref{Intro to Minibuffers}. - - @xref{Standard Keymaps}, for a list of standard keymaps. - -@defun current-keymaps &optional event-or-keys -This function returns a list of the current keymaps that will be -searched for bindings. This lists keymaps such as the current local map -and the minor-mode maps, but does not list the parents of those keymaps. -@var{event-or-keys} controls which keymaps will be listed. If -@var{event-or-keys} is a mouse event (or a vector whose last element is -a mouse event), the keymaps for that mouse event will be listed. -Otherwise, the keymaps for key presses will be listed. -@end defun - -@defvar global-map -This variable contains the default global keymap that maps XEmacs -keyboard input to commands. The global keymap is normally this keymap. -The default global keymap is a full keymap that binds -@code{self-insert-command} to all of the printing characters. - -It is normal practice to change the bindings in the global map, but you -should not assign this variable any value other than the keymap it starts -out with. -@end defvar - -@defun current-global-map -This function returns the current global keymap. This is the -same as the value of @code{global-map} unless you change one or the -other. - -@example -@group -(current-global-map) -@result{} # -@end group -@end example -@end defun - -@defun current-local-map -This function returns the current buffer's local keymap, or @code{nil} -if it has none. In the following example, the keymap for the -@samp{*scratch*} buffer (using Lisp Interaction mode) has a number -of entries, including one prefix key, @kbd{C-x}. - -@example -@group -(current-local-map) -@result{} # -(describe-bindings-internal (current-local-map)) -@result{} ; @r{Inserted into the buffer:} -backspace backward-delete-char-untabify -linefeed eval-print-last-sexp -delete delete-char -C-j eval-print-last-sexp -C-x << Prefix Command >> -M-tab lisp-complete-symbol -M-; lisp-indent-for-comment -M-C-i lisp-complete-symbol -M-C-q indent-sexp -M-C-x eval-defun -Alt-backspace backward-kill-sexp -Alt-delete kill-sexp -@end group - -@group -C-x x edebug-defun -@end group -@end example -@end defun - -@defun current-minor-mode-maps -This function returns a list of the keymaps of currently enabled minor modes. -@end defun - -@defun use-global-map keymap -This function makes @var{keymap} the new current global keymap. It -returns @code{nil}. - -It is very unusual to change the global keymap. -@end defun - -@defun use-local-map keymap &optional buffer -This function makes @var{keymap} the new local keymap of @var{buffer}. -@var{buffer} defaults to the current buffer. If @var{keymap} is -@code{nil}, then the buffer has no local keymap. @code{use-local-map} -returns @code{nil}. Most major mode commands use this function. -@end defun - -@c Emacs 19 feature -@defvar minor-mode-map-alist -This variable is an alist describing keymaps that may or may not be -active according to the values of certain variables. Its elements look -like this: - -@example -(@var{variable} . @var{keymap}) -@end example - -The keymap @var{keymap} is active whenever @var{variable} has a -non-@code{nil} value. Typically @var{variable} is the variable that -enables or disables a minor mode. @xref{Keymaps and Minor Modes}. - -Note that elements of @code{minor-mode-map-alist} do not have the same -structure as elements of @code{minor-mode-alist}. The map must be the -@sc{cdr} of the element; a list with the map as the second element will -not do. - -What's more, the keymap itself must appear in the @sc{cdr}. It does not -work to store a variable in the @sc{cdr} and make the map the value of -that variable. - -When more than one minor mode keymap is active, their order of priority -is the order of @code{minor-mode-map-alist}. But you should design -minor modes so that they don't interfere with each other. If you do -this properly, the order will not matter. - -See also @code{minor-mode-key-binding}, above. See @ref{Keymaps and -Minor Modes}, for more information about minor modes. -@end defvar - -@defvar modeline-map -This variable holds the keymap consulted for mouse-clicks on the -modeline of a window. This variable may be buffer-local; its value will -be looked up in the buffer of the window whose modeline was clicked -upon. -@end defvar - -@defvar toolbar-map -This variable holds the keymap consulted for mouse-clicks over a -toolbar. -@end defvar - -@defvar mouse-grabbed-buffer -If non-@code{nil}, a buffer which should be consulted first for all -mouse activity. When a mouse-click is processed, it will first be -looked up in the local-map of this buffer, and then through the normal -mechanism if there is no binding for that click. This buffer's value of -@code{mode-motion-hook} will be consulted instead of the -@code{mode-motion-hook} of the buffer of the window under the mouse. -You should @emph{bind} this, not set it. -@end defvar - -@defvar overriding-local-map -If non-@code{nil}, this variable holds a keymap to use instead of the -buffer's local keymap and instead of all the minor mode keymaps. This -keymap, if any, overrides all other maps that would have been active, -except for the current global map. -@end defvar - -@defvar overriding-terminal-local-map -If non-@code{nil}, this variable holds a keymap to use instead of the -buffer's local keymap and instead of all the minor mode keymaps, but for -the selected console only. (In other words, this variable is always -console-local; putting a keymap here only applies to keystrokes coming -from the selected console. @xref{Consoles and Devices}.) This keymap, -if any, overrides all other maps that would have been active, except for -the current global map. -@end defvar - -@node Key Lookup -@section Key Lookup -@cindex key lookup -@cindex keymap entry - - @dfn{Key lookup} is the process of finding the binding of a key -sequence from a given keymap. Actual execution of the binding is not -part of key lookup. - - Key lookup uses just the event type of each event in the key -sequence; the rest of the event is ignored. In fact, a key sequence -used for key lookup may designate mouse events with just their types -(symbols) instead of with entire mouse events (lists). @xref{Events}. -Such a pseudo-key-sequence is insufficient for @code{command-execute}, -but it is sufficient for looking up or rebinding a key. - - When the key sequence consists of multiple events, key lookup -processes the events sequentially: the binding of the first event is -found, and must be a keymap; then the second event's binding is found in -that keymap, and so on until all the events in the key sequence are used -up. (The binding thus found for the last event may or may not be a -keymap.) Thus, the process of key lookup is defined in terms of a -simpler process for looking up a single event in a keymap. How that is -done depends on the type of object associated with the event in that -keymap. - - Let's use the term @dfn{keymap entry} to describe the value found by -looking up an event type in a keymap. (This doesn't include the item -string and other extra elements in menu key bindings because -@code{lookup-key} and other key lookup functions don't include them in -the returned value.) While any Lisp object may be stored in a keymap as -a keymap entry, not all make sense for key lookup. Here is a list of -the meaningful kinds of keymap entries: - -@table @asis -@item @code{nil} -@cindex @code{nil} in keymap -@code{nil} means that the events used so far in the lookup form an -undefined key. When a keymap fails to mention an event type at all, and -has no default binding, that is equivalent to a binding of @code{nil} -for that event type. - -@item @var{keymap} -@cindex keymap in keymap -The events used so far in the lookup form a prefix key. The next -event of the key sequence is looked up in @var{keymap}. - -@item @var{command} -@cindex command in keymap -The events used so far in the lookup form a complete key, -and @var{command} is its binding. @xref{What Is a Function}. - -@item @var{array} -@cindex string in keymap -The array (either a string or a vector) is a keyboard macro. The events -used so far in the lookup form a complete key, and the array is its -binding. See @ref{Keyboard Macros}, for more information. (Note that -you cannot use a shortened form of a key sequence here, such as -@code{(control y)}; you must use the full form @code{[(control y)]}. -@xref{Key Sequences}.) - -@item @var{list} -@cindex list in keymap -The meaning of a list depends on the types of the elements of the list. - -@itemize @bullet -@item -@cindex @code{lambda} in keymap -If the @sc{car} of @var{list} is @code{lambda}, then the list is a -lambda expression. This is presumed to be a command, and is treated as -such (see above). - -@item -If the @sc{car} of @var{list} is a keymap and the @sc{cdr} is an event -type, then this is an @dfn{indirect entry}: - -@example -(@var{othermap} . @var{othertype}) -@end example - -When key lookup encounters an indirect entry, it looks up instead the -binding of @var{othertype} in @var{othermap} and uses that. - -This feature permits you to define one key as an alias for another key. -For example, an entry whose @sc{car} is the keymap called @code{esc-map} -and whose @sc{cdr} is 32 (the code for @key{SPC}) means, ``Use the global -binding of @kbd{Meta-@key{SPC}}, whatever that may be.'' -@end itemize - -@item @var{symbol} -@cindex symbol in keymap -The function definition of @var{symbol} is used in place of -@var{symbol}. If that too is a symbol, then this process is repeated, -any number of times. Ultimately this should lead to an object that is -a keymap, a command or a keyboard macro. A list is allowed if it is a -keymap or a command, but indirect entries are not understood when found -via symbols. - -Note that keymaps and keyboard macros (strings and vectors) are not -valid functions, so a symbol with a keymap, string, or vector as its -function definition is invalid as a function. It is, however, valid as -a key binding. If the definition is a keyboard macro, then the symbol -is also valid as an argument to @code{command-execute} -(@pxref{Interactive Call}). - -@cindex @code{undefined} in keymap -The symbol @code{undefined} is worth special mention: it means to treat -the key as undefined. Strictly speaking, the key is defined, and its -binding is the command @code{undefined}; but that command does the same -thing that is done automatically for an undefined key: it rings the bell -(by calling @code{ding}) but does not signal an error. - -@cindex preventing prefix key -@code{undefined} is used in local keymaps to override a global key -binding and make the key ``undefined'' locally. A local binding of -@code{nil} would fail to do this because it would not override the -global binding. - -@item @var{anything else} -If any other type of object is found, the events used so far in the -lookup form a complete key, and the object is its binding, but the -binding is not executable as a command. -@end table - - In short, a keymap entry may be a keymap, a command, a keyboard macro, -a symbol that leads to one of them, or an indirection or @code{nil}. - -@node Functions for Key Lookup -@section Functions for Key Lookup - - Here are the functions and variables pertaining to key lookup. - -@defun lookup-key keymap key &optional accept-defaults -This function returns the definition of @var{key} in @var{keymap}. If -the string or vector @var{key} is not a valid key sequence according to -the prefix keys specified in @var{keymap} (which means it is ``too -long'' and has extra events at the end), then the value is a number, the -number of events at the front of @var{key} that compose a complete key. - -@c Emacs 19 feature -If @var{accept-defaults} is non-@code{nil}, then @code{lookup-key} -considers default bindings as well as bindings for the specific events -in @var{key}. Otherwise, @code{lookup-key} reports only bindings for -the specific sequence @var{key}, ignoring default bindings except when -you explicitly ask about them. - -All the other functions described in this chapter that look up keys use -@code{lookup-key}. - -@example -@group -(lookup-key (current-global-map) "\C-x\C-f") - @result{} find-file -@end group -@group -(lookup-key (current-global-map) "\C-x\C-f12345") - @result{} 2 -@end group -@end example - - If @var{key} begins with the character whose value is contained in -@code{meta-prefix-char}, that character is implicitly removed and the -@key{META} modifier added to the key. Thus, the first example below is -handled by conversion into the second example. - -@example -@group -(lookup-key (current-global-map) "\ef") - @result{} forward-word -@end group -@group -(lookup-key (current-global-map) "\M-f") - @result{} forward-word -@end group -@end example - -Unlike @code{read-key-sequence}, this function does not modify the -specified events in ways that discard information (@pxref{Key Sequence -Input}). In particular, it does not convert letters to lower case. -@end defun - -@deffn Command undefined -Used in keymaps to undefine keys. If a key sequence is defined to this, -invoking this key sequence causes a ``key undefined'' error, just as if -the key sequence had no binding. -@end deffn - -@defun key-binding key &optional accept-defaults -This function returns the binding for @var{key} in the current -keymaps, trying all the active keymaps. The result is @code{nil} if -@var{key} is undefined in the keymaps. - -@c Emacs 19 feature -The argument @var{accept-defaults} controls checking for default -bindings, as in @code{lookup-key} (above). - -@example -@group -(key-binding "\C-x\C-f") - @result{} find-file -(key-binding '(control home)) - @result{} beginning-of-buffer -(key-binding [escape escape escape]) - @result{} keyboard-escape-quit -@end group -@end example -@end defun - -@defun local-key-binding key &optional accept-defaults -This function returns the binding for @var{key} in the current -local keymap, or @code{nil} if it is undefined there. - -@c Emacs 19 feature -The argument @var{accept-defaults} controls checking for default bindings, -as in @code{lookup-key} (above). -@end defun - -@defun global-key-binding key &optional accept-defaults -This function returns the binding for command @var{key} in the -current global keymap, or @code{nil} if it is undefined there. - -@c Emacs 19 feature -The argument @var{accept-defaults} controls checking for default bindings, -as in @code{lookup-key} (above). -@end defun - -@c Emacs 19 feature -@defun minor-mode-key-binding key &optional accept-defaults -This function returns a list of all the active minor mode bindings of -@var{key}. More precisely, it returns an alist of pairs -@code{(@var{modename} . @var{binding})}, where @var{modename} is the -variable that enables the minor mode, and @var{binding} is @var{key}'s -binding in that mode. If @var{key} has no minor-mode bindings, the -value is @code{nil}. - -If the first binding is not a prefix command, all subsequent bindings -from other minor modes are omitted, since they would be completely -shadowed. Similarly, the list omits non-prefix bindings that follow -prefix bindings. - -The argument @var{accept-defaults} controls checking for default -bindings, as in @code{lookup-key} (above). -@end defun - -@defvar meta-prefix-char -@cindex @key{ESC} -This variable is the meta-prefix character code. It is used when -translating a two-character sequence to a meta character so it can be -looked up in a keymap. For useful results, the value should be a prefix -event (@pxref{Prefix Keys}). The default value is @code{?\^[} (integer -27), which is the @sc{ASCII} character usually produced by the @key{ESC} -key. - - As long as the value of @code{meta-prefix-char} remains @code{?\^[}, -key lookup translates @kbd{@key{ESC} b} into @kbd{M-b}, which is -normally defined as the @code{backward-word} command. However, if you -set @code{meta-prefix-char} to @code{?\^X} (i.e. the keystroke -@kbd{C-x}) or its equivalent @sc{ASCII} code @code{24}, then XEmacs will -translate @kbd{C-x b} (whose standard binding is the -@code{switch-to-buffer} command) into @kbd{M-b}. - -@smallexample -@group -meta-prefix-char ; @r{The default value.} - @result{} ?\^[ ; @r{Under XEmacs 20.} - @result{} 27 ; @r{Under XEmacs 19.} -@end group -@group -(key-binding "\eb") - @result{} backward-word -@end group -@group -?\C-x ; @r{The print representation} - ; @r{of a character.} - @result{} ?\^X ; @r{Under XEmacs 20.} - @result{} 24 ; @r{Under XEmacs 19.} -@end group -@group -(setq meta-prefix-char 24) - @result{} 24 -@end group -@group -(key-binding "\C-xb") - @result{} backward-word ; @r{Now, typing @kbd{C-x b} is} - ; @r{like typing @kbd{M-b}.} - -(setq meta-prefix-char ?\e) ; @r{Avoid confusion!} - ; @r{Restore the default value!} - @result{} ?\^[ ; @r{Under XEmacs 20.} - @result{} 27 ; @r{Under XEmacs 19.} -@end group -@end smallexample -@end defvar - -@node Changing Key Bindings -@section Changing Key Bindings -@cindex changing key bindings -@cindex rebinding - - The way to rebind a key is to change its entry in a keymap. If you -change a binding in the global keymap, the change is effective in all -buffers (though it has no direct effect in buffers that shadow the -global binding with a local one). If you change the current buffer's -local map, that usually affects all buffers using the same major mode. -The @code{global-set-key} and @code{local-set-key} functions are -convenient interfaces for these operations (@pxref{Key Binding -Commands}). You can also use @code{define-key}, a more general -function; then you must specify explicitly the map to change. - - The way to specify the key sequence that you want to rebind is -described above (@pxref{Key Sequences}). - - For the functions below, an error is signaled if @var{keymap} is not a -keymap or if @var{key} is not a string or vector representing a key -sequence. You can use event types (symbols) as shorthand for events -that are lists. - -@defun define-key keymap key binding -This function sets the binding for @var{key} in @var{keymap}. (If -@var{key} is more than one event long, the change is actually made -in another keymap reached from @var{keymap}.) The argument -@var{binding} can be any Lisp object, but only certain types are -meaningful. (For a list of meaningful types, see @ref{Key Lookup}.) -The value returned by @code{define-key} is @var{binding}. - -@cindex invalid prefix key error -@cindex key sequence error -Every prefix of @var{key} must be a prefix key (i.e., bound to a -keymap) or undefined; otherwise an error is signaled. - -If some prefix of @var{key} is undefined, then @code{define-key} defines -it as a prefix key so that the rest of @var{key} may be defined as -specified. -@end defun - - Here is an example that creates a sparse keymap and makes a number of -bindings in it: - -@smallexample -@group -(setq map (make-sparse-keymap)) - @result{} # -@end group -@group -(define-key map "\C-f" 'forward-char) - @result{} forward-char -@end group -@group -map - @result{} # -(describe-bindings-internal map) -@result{} ; @r{(Inserted in buffer)} -C-f forward-char -@end group - -@group -;; @r{Build sparse submap for @kbd{C-x} and bind @kbd{f} in that.} -(define-key map "\C-xf" 'forward-word) - @result{} forward-word -@end group -@group -map - @result{} # -(describe-bindings-internal map) -@result{} ; @r{(Inserted in buffer)} -C-f forward-char -C-x << Prefix Command >> - -C-x f forward-word -@end group - -@group -;; @r{Bind @kbd{C-p} to the @code{ctl-x-map}.} -(define-key map "\C-p" ctl-x-map) -;; @code{ctl-x-map} -@result{} # -@end group - -@group -;; @r{Bind @kbd{C-f} to @code{foo} in the @code{ctl-x-map}.} -(define-key map "\C-p\C-f" 'foo) -@result{} foo -@end group -@group -map - @result{} # -(describe-bindings-internal map) -@result{} ; @r{(Inserted in buffer)} -C-f forward-char -C-p << Prefix command Control-X-prefix >> -C-x << Prefix Command >> - -C-p tab indent-rigidly -C-p $ set-selective-display -C-p ' expand-abbrev -C-p ( start-kbd-macro -C-p ) end-kbd-macro - @dots{} -C-p C-x exchange-point-and-mark -C-p C-z suspend-or-iconify-emacs -C-p M-escape repeat-complex-command -C-p M-C-[ repeat-complex-command - -C-x f forward-word - -C-p 4 . find-tag-other-window - @dots{} -C-p 4 C-o display-buffer - -C-p 5 0 delete-frame - @dots{} -C-p 5 C-f find-file-other-frame - - @dots{} - -C-p a i g inverse-add-global-abbrev -C-p a i l inverse-add-mode-abbrev -@end group -@end smallexample - -@noindent -Note that storing a new binding for @kbd{C-p C-f} actually works by -changing an entry in @code{ctl-x-map}, and this has the effect of -changing the bindings of both @kbd{C-p C-f} and @kbd{C-x C-f} in the -default global map. - -@defun substitute-key-definition olddef newdef keymap &optional oldmap -@cindex replace bindings -This function replaces @var{olddef} with @var{newdef} for any keys in -@var{keymap} that were bound to @var{olddef}. In other words, -@var{olddef} is replaced with @var{newdef} wherever it appears. The -function returns @code{nil}. - -For example, this redefines @kbd{C-x C-f}, if you do it in an XEmacs with -standard bindings: - -@smallexample -@group -(substitute-key-definition - 'find-file 'find-file-read-only (current-global-map)) -@end group -@end smallexample - -@c Emacs 19 feature -If @var{oldmap} is non-@code{nil}, then its bindings determine which -keys to rebind. The rebindings still happen in @var{newmap}, not in -@var{oldmap}. Thus, you can change one map under the control of the -bindings in another. For example, - -@smallexample -(substitute-key-definition - 'delete-backward-char 'my-funny-delete - my-map global-map) -@end smallexample - -@noindent -puts the special deletion command in @code{my-map} for whichever keys -are globally bound to the standard deletion command. - -@ignore -@c Emacs 18 only -Prefix keymaps that appear within @var{keymap} are not checked -recursively for keys bound to @var{olddef}; they are not changed at all. -Perhaps it would be better to check nested keymaps recursively. -@end ignore - -@ignore @c #### fix this up. -Here is an example showing a keymap before and after substitution: - -@smallexample -@group -(setq map '(keymap - (?1 . olddef-1) - (?2 . olddef-2) - (?3 . olddef-1))) -@result{} (keymap (49 . olddef-1) (50 . olddef-2) (51 . olddef-1)) -@end group - -@group -(substitute-key-definition 'olddef-1 'newdef map) -@result{} nil -@end group -@group -map -@result{} (keymap (49 . newdef) (50 . olddef-2) (51 . newdef)) -@end group -@end smallexample -@end ignore -@end defun - -@defun suppress-keymap keymap &optional nodigits -@cindex @code{self-insert-command} override -This function changes the contents of the full keymap @var{keymap} by -making all the printing characters undefined. More precisely, it binds -them to the command @code{undefined}. This makes ordinary insertion of -text impossible. @code{suppress-keymap} returns @code{nil}. - -If @var{nodigits} is @code{nil}, then @code{suppress-keymap} defines -digits to run @code{digit-argument}, and @kbd{-} to run -@code{negative-argument}. Otherwise it makes them undefined like the -rest of the printing characters. - -@cindex yank suppression -@cindex @code{quoted-insert} suppression -The @code{suppress-keymap} function does not make it impossible to -modify a buffer, as it does not suppress commands such as @code{yank} -and @code{quoted-insert}. To prevent any modification of a buffer, make -it read-only (@pxref{Read Only Buffers}). - -Since this function modifies @var{keymap}, you would normally use it -on a newly created keymap. Operating on an existing keymap -that is used for some other purpose is likely to cause trouble; for -example, suppressing @code{global-map} would make it impossible to use -most of XEmacs. - -Most often, @code{suppress-keymap} is used to initialize local -keymaps of modes such as Rmail and Dired where insertion of text is not -desirable and the buffer is read-only. Here is an example taken from -the file @file{emacs/lisp/dired.el}, showing how the local keymap for -Dired mode is set up: - -@smallexample -@group - @dots{} - (setq dired-mode-map (make-keymap)) - (suppress-keymap dired-mode-map) - (define-key dired-mode-map "r" 'dired-rename-file) - (define-key dired-mode-map "\C-d" 'dired-flag-file-deleted) - (define-key dired-mode-map "d" 'dired-flag-file-deleted) - (define-key dired-mode-map "v" 'dired-view-file) - (define-key dired-mode-map "e" 'dired-find-file) - (define-key dired-mode-map "f" 'dired-find-file) - @dots{} -@end group -@end smallexample -@end defun - -@node Key Binding Commands -@section Commands for Binding Keys - - This section describes some convenient interactive interfaces for -changing key bindings. They work by calling @code{define-key}. - - People often use @code{global-set-key} in their @file{.emacs} file for -simple customization. For example, - -@smallexample -(global-set-key "\C-x\C-\\" 'next-line) -@end smallexample - -@noindent -or - -@smallexample -(global-set-key [(control ?x) (control ?\\)] 'next-line) -@end smallexample - -@noindent -or - -@smallexample -(global-set-key [?\C-x ?\C-\\] 'next-line) -@end smallexample - -@noindent -redefines @kbd{C-x C-\} to move down a line. - -@smallexample -(global-set-key [(meta button1)] 'mouse-set-point) -@end smallexample - -@noindent -redefines the first (leftmost) mouse button, typed with the Meta key, to -set point where you click. - -@deffn Command global-set-key key definition -This function sets the binding of @var{key} in the current global map -to @var{definition}. - -@smallexample -@group -(global-set-key @var{key} @var{definition}) -@equiv{} -(define-key (current-global-map) @var{key} @var{definition}) -@end group -@end smallexample -@end deffn - -@deffn Command global-unset-key key -@cindex unbinding keys -This function removes the binding of @var{key} from the current -global map. - -One use of this function is in preparation for defining a longer key -that uses @var{key} as a prefix---which would not be allowed if -@var{key} has a non-prefix binding. For example: - -@smallexample -@group -(global-unset-key "\C-l") - @result{} nil -@end group -@group -(global-set-key "\C-l\C-l" 'redraw-display) - @result{} nil -@end group -@end smallexample - -This function is implemented simply using @code{define-key}: - -@smallexample -@group -(global-unset-key @var{key}) -@equiv{} -(define-key (current-global-map) @var{key} nil) -@end group -@end smallexample -@end deffn - -@deffn Command local-set-key key definition -This function sets the binding of @var{key} in the current local -keymap to @var{definition}. - -@smallexample -@group -(local-set-key @var{key} @var{definition}) -@equiv{} -(define-key (current-local-map) @var{key} @var{definition}) -@end group -@end smallexample -@end deffn - -@deffn Command local-unset-key key -This function removes the binding of @var{key} from the current -local map. - -@smallexample -@group -(local-unset-key @var{key}) -@equiv{} -(define-key (current-local-map) @var{key} nil) -@end group -@end smallexample -@end deffn - -@node Scanning Keymaps -@section Scanning Keymaps - - This section describes functions used to scan all the current keymaps, -or all keys within a keymap, for the sake of printing help information. - -@defun accessible-keymaps keymap &optional prefix -This function returns a list of all the keymaps that can be accessed -(via prefix keys) from @var{keymap}. The value is an association list -with elements of the form @code{(@var{key} .@: @var{map})}, where -@var{key} is a prefix key whose definition in @var{keymap} is -@var{map}. - -The elements of the alist are ordered so that the @var{key} increases -in length. The first element is always @code{([] .@: @var{keymap})}, -because the specified keymap is accessible from itself with a prefix of -no events. - -If @var{prefix} is given, it should be a prefix key sequence; then -@code{accessible-keymaps} includes only the submaps whose prefixes start -with @var{prefix}. These elements look just as they do in the value of -@code{(accessible-keymaps)}; the only difference is that some elements -are omitted. - - In the example below, the returned alist indicates that the key -@kbd{C-x}, which is displayed as @samp{[(control x)]}, is a prefix key -whose definition is the keymap @code{#) 1 entry 0x8a2>}. (The strange -notation for the keymap's name indicates that this is an internal submap -of @code{emacs-lisp-mode-map}. This is because -@code{lisp-interaction-mode-map} has set up @code{emacs-lisp-mode-map} -as its parent, and @code{lisp-interaction-mode-map} defines no key -sequences beginning with @kbd{C-x}.) - -@smallexample -@group -(current-local-map) -@result{} # -(accessible-keymaps (current-local-map)) -@result{}(([] . #) - ([(control x)] . - #) - 1 entry 0x8a2>)) -@end group -@end smallexample - - The following example shows the results of calling -@code{accessible-keymaps} on a large, complex keymap. Notice how -some keymaps were given explicit names using @code{set-keymap-name}; -those submaps without explicit names are given descriptive names -indicating their relationship to their enclosing keymap. - -@smallexample -@group -(accessible-keymaps (current-global-map)) -@result{} (([] . #) - ([(control c)] . #) - ([(control h)] . #) - ([(control x)] . #) - ([(meta escape)] . - #) - 3 entries 0x3e0>) - ([(meta control \[)] . - #) - 3 entries 0x3e0>) - ([f1] . #) - ([(control x) \4] . #) - ([(control x) \5] . #) - ([(control x) \6] . #) - ([(control x) a] . - #) - 8 entries 0x3ef>) - ([(control x) n] . #) - ([(control x) r] . #) - ([(control x) v] . #) - ([(control x) a i] . - #) - 8 entries 0x3ef>) - 2 entries 0x3f5>)) -@end group -@end smallexample -@end defun - -@defun map-keymap function keymap &optional sort-first -This function applies @var{function} to each element of @code{KEYMAP}. -@var{function} will be called with two arguments: a key-description -list, and the binding. The order in which the elements of the keymap -are passed to the function is unspecified. If the function inserts new -elements into the keymap, it may or may not be called with them later. -No element of the keymap will ever be passed to the function more than -once. - -The function will not be called on elements of this keymap's parents -(@pxref{Inheritance and Keymaps}) or upon keymaps which are contained -within this keymap (multi-character definitions). It will be called on -@key{META} characters since they are not really two-character sequences. - -If the optional third argument @var{sort-first} is non-@code{nil}, then -the elements of the keymap will be passed to the mapper function in a -canonical order. Otherwise, they will be passed in hash (that is, -random) order, which is faster. -@end defun - -@defun keymap-fullness keymap -This function returns the number of bindings in the keymap. -@end defun - -@defun where-is-internal definition &optional keymaps firstonly noindirect event-or-keys -This function returns a list of key sequences (of any length) that are -bound to @var{definition} in a set of keymaps. - -The argument @var{definition} can be any object; it is compared with all -keymap entries using @code{eq}. - -KEYMAPS can be either a keymap (meaning search in that keymap and the -current global keymap) or a list of keymaps (meaning search in exactly -those keymaps and no others). If KEYMAPS is nil, search in the currently -applicable maps for EVENT-OR-KEYS. - -If @var{keymap} is a keymap, then the maps searched are @var{keymap} and -the global keymap. If @var{keymap} is a list of keymaps, then the maps -searched are exactly those keymaps, and no others. If @var{keymap} is -@code{nil}, then the maps used are the current active keymaps for -@var{event-or-keys} (this is equivalent to specifying -@code{(current-keymaps @var{event-or-keys})} as the argument to -@var{keymaps}). - -If @var{firstonly} is non-@code{nil}, then the value is a single -vector representing the first key sequence found, rather than a list of -all possible key sequences. -@ignore @c #### Should fix where-is to be more like FSF -If @var{firstonly} is @code{non-ascii}, then the value is a single -string representing the first key sequence found, rather than a list of -all possible key sequences. If @var{firstonly} is @code{t}, then the -value is the first key sequence, except that key sequences consisting -entirely of @sc{ASCII} characters (or meta variants of @sc{ASCII} -characters) are preferred to all other key sequences. -@end ignore - -If @var{noindirect} is non-@code{nil}, @code{where-is-internal} doesn't -follow indirect keymap bindings. This makes it possible to search for -an indirect definition itself. - -This function is used by @code{where-is} (@pxref{Help, , Help, emacs, -The XEmacs Reference Manual}). - -@smallexample -@group -(where-is-internal 'describe-function) - @result{} ([(control h) d] [(control h) f] [f1 d] [f1 f]) -@end group -@end smallexample -@end defun - -@defun describe-bindings-internal map &optional all shadow prefix mouse-only-p -This function inserts (into the current buffer) a list of all defined -keys and their definitions in @var{map}. Optional second argument -@var{all} says whether to include even ``uninteresting'' definitions, -i.e. symbols with a non-@code{nil} @code{suppress-keymap} property. -Third argument @var{shadow} is a list of keymaps whose bindings shadow -those of map; if a binding is present in any shadowing map, it is not -printed. Fourth argument @var{prefix}, if non-@code{nil}, should be a -key sequence; only bindings which start with that key sequence will be -printed. Fifth argument @var{mouse-only-p} says to only print bindings -for mouse clicks. -@end defun - - @code{describe-bindings-internal} is used to implement the -help command @code{describe-bindings}. - -@deffn Command describe-bindings prefix mouse-only-p -This function creates a listing of all defined keys and their -definitions. It writes the listing in a buffer named @samp{*Help*} and -displays it in a window. - -If @var{prefix} is non-@code{nil}, it should be a prefix key; then the -listing includes only keys that start with @var{prefix}. - -When several characters with consecutive @sc{ASCII} codes have the -same definition, they are shown together, as -@samp{@var{firstchar}..@var{lastchar}}. In this instance, you need to -know the @sc{ASCII} codes to understand which characters this means. -For example, in the default global map, the characters @samp{@key{SPC} -..@: ~} are described by a single line. @key{SPC} is @sc{ASCII} 32, -@kbd{~} is @sc{ASCII} 126, and the characters between them include all -the normal printing characters, (e.g., letters, digits, punctuation, -etc.@:); all these characters are bound to @code{self-insert-command}. - -If the second argument (prefix arg, interactively) is non-@code{nil} -then only the mouse bindings are displayed. -@end deffn - -@node Other Keymap Functions -@section Other Keymap Functions - -@defun set-keymap-prompt keymap new-prompt -This function sets the ``prompt'' of @var{keymap} to string -@var{new-prompt}, or @code{nil} if no prompt is desired. The prompt is -shown in the echo-area when reading a key-sequence to be looked-up in -this keymap. -@end defun - -@defun keymap-prompt keymap &optional use-inherited -This function returns the ``prompt'' of the given keymap. -If @var{use-inherited} is non-@code{nil}, any parent keymaps -will also be searched for a prompt. -@end defun diff --git a/man/lispref/ldap.texi b/man/lispref/ldap.texi deleted file mode 100644 index a2990f1..0000000 --- a/man/lispref/ldap.texi +++ /dev/null @@ -1,299 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1998 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/ldap.info -@node LDAP Support, Internationalization, ToolTalk Support, top -@chapter LDAP Support -@cindex LDAP - -XEmacs can be linked with a LDAP client library to provide Elisp primitives -to access directory servers using the Lightweight Directory Access Protocol. - -@menu -* Building XEmacs with LDAP support:: How to add LDAP support to XEmacs -* XEmacs LDAP API:: Lisp access to LDAP functions -* Syntax of Search Filters:: A brief summary of RFC 1558 -@end menu - -@node Building XEmacs with LDAP support, XEmacs LDAP API, LDAP Support, LDAP Support -@comment node-name, next, previous, up -@section Building XEmacs with LDAP support - -LDAP support must be added to XEmacs at build time since it requires -linking to an external LDAP client library. As of 21.0, XEmacs has been -successfully built and tested with - -@itemize @bullet -@item University of Michigan's LDAP 3.3 (@url{http://www.umich.edu/~dirsvcs/ldap/}) -@item LDAP SDK 1.0 from Netscape Corp. (@url{http://developer.netscape.com/}) -@end itemize - -Other libraries conforming to RFC 1823 will probably work also but may -require some minor tweaking at C level. - -The standard XEmacs configure script autodetects an installed LDAP -library provided the library itself and the corresponding header files -can be found in the library and include paths. A successful detection -will be signalled in the final output of the configure script. - - - -@node XEmacs LDAP API, Syntax of Search Filters, Building XEmacs with LDAP support, LDAP Support -@comment node-name, next, previous, up -@section XEmacs LDAP API - -XEmacs LDAP API consists of two layers: a low-level layer which tries -to stay as close as possible to the C API (where practical) and a -higher-level layer which provides more convenient primitives to -effectively use LDAP. - -As of XEmacs 21.0, only interfaces to basic LDAP search functions are -provided, broader support is planned in future versions. - -@menu -* LDAP Variables:: Lisp variables related to LDAP -* The High-Level LDAP API:: High-level LDAP lisp functions -* The Low-Level LDAP API:: Low-level LDAP lisp primitives -@end menu - - -@node LDAP Variables, The High-Level LDAP API, XEmacs LDAP API, XEmacs LDAP API -@comment node-name, next, previous, up -@subsection LDAP Variables - -@defvar ldap-default-host -The default LDAP server -@end defvar - -@defvar ldap-default-port -Default TCP port for LDAP connections. -Initialized from the LDAP library. Default value is 389. -@end defvar - -@defvar ldap-default-base -Default base for LDAP searches. -This is a string using the syntax of RFC 1779. -For instance, "o¬ME, cÿ" limits the search to the -Acme organization in the United States. -@end defvar - -@defvar ldap-host-parameters-alist -An alist of per host options for LDAP transactions. -The list elements look like @code{(HOST PROP1 VAL1 PROP2 VAL2 ...)} -@var{host} is the name of an LDAP server. @var{propn} and @var{valn} are -property/value pairs describing parameters for the server. Valid -properties: -@table @code -@item binddn -The distinguished name of the user to bind as. This may look like -@samp{cÿ, o¬me, cnÿnny Bugs}, see RFC 1779 for details. -@item passwd -The password to use for authentication. -@item auth -The authentication method to use, possible values depend on the LDAP -library XEmacs was compiled with, they may include @code{simple}, -@code{krbv41} and @code{krbv42}. -@item base -The base for the search. This may look like @samp{cÿ, o¬me}, see -RFC 1779 for syntax details. -@item scope -One of the symbols @code{base}, @code{onelevel} or @code{subtree} -indicating the scope of the search limited to a base -object, to a single level or to the whole subtree. -@item deref -The dereference policy is one of the symbols @code{never}, -@code{always}, @code{search} or @code{find} and defines how aliases are -dereferenced. -@table @code -@item never -Aliases are never dereferenced -@item always -Aliases are always dereferenced -@item search -Aliases are dereferenced when searching -@item find -Aliases are dereferenced when locating the base object for the search -@end table -@item timelimit -The timeout limit for the connection in seconds. -@item sizelimit -The maximum number of matches to return for searches performed on this connection. -@end table -@end defvar - - - -@node The High-Level LDAP API, The Low-Level LDAP API, LDAP Variables, XEmacs LDAP API -@comment node-name, next, previous, up -@subsection The High-Level LDAP API - -As of this writing the high-level Lisp LDAP API only provides for LDAP -searches. Further support is planned in the future. - -The @code{ldap-search} function provides the most convenient interface -to perform LDAP searches. It opens a connection to a host, performs the -query and cleanly closes the connection thus insulating the user from -all the details of the low-level interface such as LDAP Lisp objects -@pxref{The Low-Level LDAP API} - -@defun ldap-search filter &optional host attributes attrsonly -Perform an LDAP search. -@var{filter} is the search filter @pxref{Syntax of Search Filters} -@var{host} is the LDAP host on which to perform the search -@var{attributes} is the specific attributes to retrieve, @code{nil} means -retrieve all -@var{attrsonly} if non-@code{nil} retrieves the attributes only without -their associated values. -Additional search parameters can be specified through -@code{ldap-host-parameters-alist}. -@end defun - -@node The Low-Level LDAP API, , The High-Level LDAP API, XEmacs LDAP API -@comment node-name, next, previous, up -@subsection The Low-Level LDAP API - -@menu -* The LDAP Lisp Object:: -* Opening and Closing a LDAP Connection:: -* Searching on a LDAP Server (Low-level):: -@end menu - -@node The LDAP Lisp Object, Opening and Closing a LDAP Connection, The Low-Level LDAP API, The Low-Level LDAP API -@comment node-name, next, previous, up -@subsubsection The LDAP Lisp Object - -An internal built-in @code{ldap} lisp object represents a LDAP -connection. - -@defun ldapp object -This function returns non-@code{nil} if @var{object} is a @code{ldap} object. -@end defun - -@defun ldap-host ldap -Return the server host of the connection represented by @var{ldap} -@end defun - -@defun ldap-live-p ldap -Return non-@code{nil} if @var{ldap} is an active LDAP connection -@end defun - - -@node Opening and Closing a LDAP Connection, Searching on a LDAP Server (Low-level), The LDAP Lisp Object, The Low-Level LDAP API -@comment node-name, next, previous, up -@subsubsection Opening and Closing a LDAP Connection - -@defun ldap-open host &optional plist -Open a LDAP connection to @var{host}. -@var{plist} is a property list containing additional parameters for the connection. -Valid keys in that list are: -@table @code -@item port -The TCP port to use for the connection if different from -@code{ldap-default-port} or the library builtin value -@item auth -The authentication method to use, possible values depend on the LDAP -library XEmacs was compiled with, they may include @code{simple}, -@code{krbv41} and @code{krbv42}. -@item binddn -The distinguished name of the user to bind as. This may look like -@samp{cÿ, o¬me, cnÿnny Bugs}, see RFC 1779 for details. -@item passwd -The password to use for authentication. -@item deref -The dereference policy is one of the symbols @code{never}, -@code{always}, @code{search} or @code{find} and defines how aliases are -dereferenced. -@table @code -@item never -Aliases are never dereferenced -@item always -Aliases are always dereferenced -@item search -Aliases are dereferenced when searching -@item find -Aliases are dereferenced when locating the base object for the search -@end table -The default is @code{never}. -@item timelimit -The timeout limit for the connection in seconds. -@item sizelimit -The maximum number of matches to return for searches performed on this connection. -@end table -@end defun - -@defun ldap-close ldap -Close the connection represented by @var{ldap} -@end defun - - -@node Searching on a LDAP Server (Low-level), , Opening and Closing a LDAP Connection, The Low-Level LDAP API -@comment node-name, next, previous, up -@subsubsection Searching on a LDAP Server (Low-level) - -@code{ldap-search-internal} is the low-level primitive to perform a -search on a LDAP server. It works directly on an open LDAP connection -thus requiring a preliminary call to @code{ldap-open}. Multiple -searches can be made on the same connection, then the session must be -closed with @code{ldap-close}. - - -@defun ldap-search-internal ldap filter base scope attrs attrsonly -Perform a search on an open connection @var{ldap} created with @code{ldap-open}. -@var{filter} is a filter string for the search @pxref{Syntax of Search Filters} -@var{base} is the distinguished name at which to start the search. -@var{scope} is one of the symbols @code{base}, @code{onelevel} or -@code{subtree} indicating the scope of the search limited to a base -object, to a single level or to the whole subtree. The default is -@code{subtree}. -@code{attrs} is a list of strings indicating which attributes to retrieve -for each matching entry. If @code{nil} all available attributes are returned. -If @code{attrsonly} is non-@code{nil} then only the attributes are retrieved, not -their associated values -The function returns a list of matching entries. Each entry being itself -an alist of attribute/values. -@end defun - - - - - -@node Syntax of Search Filters, , XEmacs LDAP API, LDAP Support -@comment node-name, next, previous, up -@section Syntax of Search Filters - -LDAP search functions use RFC1558 syntax to describe the search filter. -In that syntax simple filters have the form: - -@example -( ) -@end example - -@code{} is an attribute name such as @code{cn} for Common Name, -@code{o} for Organization, etc... - -@code{} is the corresponding value. This is generally an exact -string but may also contain @code{*} characters as wildcards - -@code{filtertype} is one @code{=} @code{~=}, @code{<=}, @code{>=} which -respectively describe equality, approximate equality, inferiority and -superiority. - -Thus @code{(cn=John Smith)} matches all records having a canonical name -equal to John Smith. - -A special case is the presence filter @code{(=*} which matches -records containing a particular attribute. For instance @code{(mail=*)} -matches all records containing a @code{mail} attribute. - -Simple filters can be connected together with the logical operators -@code{&}, @code{|} and @code{!} which stand for the usual and, or and -not operators. - -@code{(&(objectClass=Person)(mail=*)(|(sn=Smith)(givenname=John)))} -matches records of class @code{Person} containing a @code{mail} -attribute and corresponding to people whose last name is @code{Smith} or -whose first name is @code{John}. - - - diff --git a/man/lispref/lispref.texi b/man/lispref/lispref.texi deleted file mode 100644 index ff9f0d9..0000000 --- a/man/lispref/lispref.texi +++ /dev/null @@ -1,1225 +0,0 @@ -\input ../texinfo @c -*-texinfo-*- -@c %**start of header -@setfilename ../../info/lispref.info -@c @smallbook -@settitle XEmacs Lisp Reference Manual -@c %**end of header - -@ifinfo -Edition History: - -GNU Emacs Lisp Reference Manual Second Edition (v2.01), May 1993 -GNU Emacs Lisp Reference Manual Further Revised (v2.02), August 1993 -Lucid Emacs Lisp Reference Manual (for 19.10) First Edition, March 1994 -XEmacs Lisp Programmer's Manual (for 19.12) Second Edition, April 1995 -GNU Emacs Lisp Reference Manual v2.4, June 1995 -XEmacs Lisp Programmer's Manual (for 19.13) Third Edition, July 1995 -XEmacs Lisp Reference Manual (for 19.14 and 20.0) v3.1, March 1996 -XEmacs Lisp Reference Manual (for 19.15 and 20.1, 20.2, 20.3) v3.2, April, May, November 1997 -XEmacs Lisp Reference Manual (for 21.0) v3.3, April 1998 -@c Please REMEMBER to update edition number in *four* places in this file -@c and also in *one* place in intro.texi - -Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. -Copyright (C) 1994, 1995 Sun Microsystems, Inc. -Copyright (C) 1995, 1996 Ben Wing. - - -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 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 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 Foundation. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. -@end ifinfo - -@c Combine indices. -@synindex cp fn -@syncodeindex vr fn -@syncodeindex ky fn -@syncodeindex pg fn -@syncodeindex tp fn - -@setchapternewpage odd -@finalout - -@titlepage -@title XEmacs Lisp Reference Manual -@c The edition number appears in several places in this file -@c and also in the file intro.texi. -@c This manual documents XEmacs 19.14 and 20.0 and was based on the -@c documentation for FSF Emacs 19.29 (v2.4). -@subtitle Version 3.3 (for XEmacs 21.0), April 1998 - -@author by Ben Wing -@author -@author Based on the GNU Emacs Lisp Reference Manual -@author by Bil Lewis, Dan LaLiberte, Richard Stallman -@author and the GNU Manual Group -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. -Copyright @copyright{} 1994, 1995 Sun Microsystems, Inc. -Copyright @copyright{} 1995, 1996 Ben Wing. -@sp 2 -Version 3.3 @* -Revised for XEmacs Versions 21.0,@* -April 1998.@* - -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 ``GNU General Public License'' 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 the section entitled ``GNU General Public License'' may be -included in a translation approved by the Free Software Foundation -instead of in the original English. - -Cover art by Etienne Suvasa. -@end titlepage -@page - -@node Top, Copying, (dir), (dir) - -@ifinfo -This Info file contains the third edition of the XEmacs Lisp -Reference Manual, corresponding to XEmacs version 21.0. -@end ifinfo - -@menu -* Copying:: Conditions for copying and changing XEmacs. -* Introduction:: Introduction and conventions used. - -* Lisp Data Types:: Data types of objects in XEmacs Lisp. -* Numbers:: Numbers and arithmetic functions. -* Strings and Characters:: Strings, and functions that work on them. -* Lists:: Lists, cons cells, and related functions. -* Sequences Arrays Vectors:: Lists, strings and vectors are called sequences. - Certain functions act on any kind of sequence. - The description of vectors is here as well. -* Symbols:: Symbols represent names, uniquely. - -* Evaluation:: How Lisp expressions are evaluated. -* Control Structures:: Conditionals, loops, nonlocal exits. -* Variables:: Using symbols in programs to stand for values. -* Functions:: A function is a Lisp program - that can be invoked from other functions. -* Macros:: Macros are a way to extend the Lisp language. -* Customization:: Writing customization declarations. - -* Loading:: Reading files of Lisp code into Lisp. -* Byte Compilation:: Compilation makes programs run faster. -* Debugging:: Tools and tips for debugging Lisp programs. - -* Read and Print:: Converting Lisp objects to text and back. -* Minibuffers:: Using the minibuffer to read input. -* Command Loop:: How the editor command loop works, - and how you can call its subroutines. -* Keymaps:: Defining the bindings from keys to commands. -* Menus:: Defining pull-down and pop-up menus. -* Dialog Boxes:: Creating dialog boxes. -* Toolbar:: Controlling the toolbar. -* Scrollbars:: Controlling the scrollbars. -* Drag and Drop:: Generic API to inter-application communication - via specific protocols. -* Modes:: Defining major and minor modes. -* Documentation:: Writing and using documentation strings. - -* Files:: Accessing files. -* Backups and Auto-Saving:: Controlling how backups and auto-save - files are made. -* Buffers:: Creating and using buffer objects. -* Windows:: Manipulating windows and displaying buffers. -* Frames:: Making multiple X windows. -* Consoles and Devices:: Opening frames on multiple TTY's or X displays. -* Positions:: Buffer positions and motion functions. -* Markers:: Markers represent positions and update - automatically when the text is changed. - -* Text:: Examining and changing text in buffers. -* Searching and Matching:: Searching buffers for strings or regexps. -* Syntax Tables:: The syntax table controls word and list parsing. -* Abbrevs:: How Abbrev mode works, and its data structures. - -* Extents:: Extents are regions of text with particular - display characteristics. -* Specifiers:: How faces and glyphs are specified. -* Faces and Window-System Objects:: - A face is a set of display characteristics - specifying how text is to be displayed. -* Glyphs:: General interface to pixmaps displayed in a - buffer or frame. -* Annotations:: Higher-level interface to glyphs in a buffer. -* Display:: Parameters controlling screen usage. - The bell. Waiting for input. - -* Hash Tables:: Fast data structures for mappings. -* Range Tables:: Keeping track of ranges of numbers. -* Databases:: An interface to standard DBM and DB databases. - -* Processes:: Running and communicating with subprocesses. -* System Interface:: Getting the user id, system type, environment - variables, and other such things. -* X-Windows:: Functions specific to the X Window System. -* ToolTalk Support:: Interfacing with the ToolTalk message service. -* LDAP Support:: Interfacing with the Lightweight Directory - Access Protocol. -* Internationalization:: How Emacs supports different languages and - cultural conventions. -* MULE:: Specifics of the Asian-language support. - -Appendices - -* Tips:: Advice for writing Lisp programs. -* Building XEmacs and Object Allocation:: - Behind-the-scenes information about XEmacs. -* Standard Errors:: List of all error symbols. -* Standard Buffer-Local Variables:: List of variables local in all buffers. -* Standard Keymaps:: List of standard keymaps. -* Standard Hooks:: List of standard hook variables. - -* Index:: Index including concepts, functions, variables, - and other terms. - - --- The Detailed Node Listing --- - -Here are other nodes that are inferiors of those already listed, -mentioned here so you can get to them in one step: - -Introduction - -* Caveats:: Flaws and a request for help. -* Lisp History:: XEmacs Lisp is descended from Maclisp. -* Conventions:: How the manual is formatted. -* Acknowledgements:: The authors, editors, and sponsors of this manual. - -Conventions - -* Some Terms:: Explanation of terms we use in this manual. -* nil and t:: How the symbols @code{nil} and @code{t} are used. -* Evaluation Notation:: The format we use for examples of evaluation. -* Printing Notation:: The format we use for examples that print output. -* Error Messages:: The format we use for examples of errors. -* Buffer Text Notation:: The format we use for buffer contents in examples. -* Format of Descriptions:: Notation for describing functions, variables, etc. - -Format of Descriptions - -* A Sample Function Description:: -* A Sample Variable Description:: - -Lisp Data Types - -* Printed Representation:: How Lisp objects are represented as text. -* Comments:: Comments and their formatting conventions. -* Programming Types:: Types found in all Lisp systems. -* Editing Types:: Types specific to XEmacs. -* Type Predicates:: Tests related to types. -* Equality Predicates:: Tests of equality between any two objects. - -Programming Types - -* Integer Type:: Numbers without fractional parts. -* Floating Point Type:: Numbers with fractional parts and with a large range. -* Character Type:: The representation of letters, numbers and - control characters. -* Sequence Type:: Both lists and arrays are classified as sequences. -* Cons Cell Type:: Cons cells, and lists (which are made from cons cells). -* Array Type:: Arrays include strings and vectors. -* String Type:: An (efficient) array of characters. -* Vector Type:: One-dimensional arrays. -* Symbol Type:: A multi-use object that refers to a function, - variable, property list, or itself. -* Function Type:: A piece of executable code you can call from elsewhere. -* Macro Type:: A method of expanding an expression into another - expression, more fundamental but less pretty. -* Primitive Function Type:: A function written in C, callable from Lisp. -* Compiled-Function Type:: A function written in Lisp, then compiled. -* Autoload Type:: A type used for automatically loading seldom-used - functions. - -Cons Cell Type - -* Dotted Pair Notation:: An alternative syntax for lists. -* Association List Type:: A specially constructed list. - -Editing Types - -* Buffer Type:: The basic object of editing. -* Window Type:: What makes buffers visible. -* Window Configuration Type::Save what the screen looks like. -* Marker Type:: A position in a buffer. -* Process Type:: A process running on the underlying OS. -* Stream Type:: Receive or send characters. -* Keymap Type:: What function a keystroke invokes. -* Syntax Table Type:: What a character means. - -Numbers - -* Integer Basics:: Representation and range of integers. -* Float Basics:: Representation and range of floating point. -* Predicates on Numbers:: Testing for numbers. -* Comparison of Numbers:: Equality and inequality predicates. -* Arithmetic Operations:: How to add, subtract, multiply and divide. -* Bitwise Operations:: Logical and, or, not, shifting. -* Numeric Conversions:: Converting float to integer and vice versa. -* Math Functions:: Trig, exponential and logarithmic functions. -* Random Numbers:: Obtaining random integers, predictable or not. - -Strings and Characters - -* Basics: String Basics. Basic properties of strings and characters. -* Predicates for Strings:: Testing whether an object is a string or char. -* Creating Strings:: Functions to allocate new strings. -* Predicates for Characters:: Testing whether an object is a character. -* Character Codes:: Each character has an equivalent integer. -* Text Comparison:: Comparing characters or strings. -* String Conversion:: Converting characters or strings and vice versa. -* Modifying Strings:: Changing characters in a string. -* String Properties:: Additional information attached to strings. -* Formatting Strings:: @code{format}: XEmacs's analog of @code{printf}. -* Character Case:: Case conversion functions. -* Char Tables:: Mapping from characters to Lisp objects. -* Case Tables:: Customizing case conversion. - -Lists - -* Cons Cells:: How lists are made out of cons cells. -* Lists as Boxes:: Graphical notation to explain lists. -* List-related Predicates:: Is this object a list? Comparing two lists. -* List Elements:: Extracting the pieces of a list. -* Building Lists:: Creating list structure. -* Modifying Lists:: Storing new pieces into an existing list. -* Sets And Lists:: A list can represent a finite mathematical set. -* Association Lists:: A list can represent a finite relation or mapping. -* Property Lists:: A different way to represent a finite mapping. -* Weak Lists:: A list with special garbage-collection behavior. - -Modifying Existing List Structure - -* Setcar:: Replacing an element in a list. -* Setcdr:: Replacing part of the list backbone. - This can be used to remove or add elements. -* Rearrangement:: Reordering the elements in a list; combining lists. - -Sequences, Arrays, and Vectors - -* Sequence Functions:: Functions that accept any kind of sequence. -* Arrays:: Characteristics of arrays in XEmacs Lisp. -* Array Functions:: Functions specifically for arrays. -* Vectors:: Functions specifically for vectors. - -Symbols - -* Symbol Components:: Symbols have names, values, function definitions - and property lists. -* Definitions:: A definition says how a symbol will be used. -* Creating Symbols:: How symbols are kept unique. -* Symbol Properties:: Each symbol has a property list - for recording miscellaneous information. - -Evaluation - -* Intro Eval:: Evaluation in the scheme of things. -* Eval:: How to invoke the Lisp interpreter explicitly. -* Forms:: How various sorts of objects are evaluated. -* Quoting:: Avoiding evaluation (to put constants in - the program). - -Kinds of Forms - -* Self-Evaluating Forms:: Forms that evaluate to themselves. -* Symbol Forms:: Symbols evaluate as variables. -* Classifying Lists:: How to distinguish various sorts of list forms. -* Function Forms:: Forms that call functions. -* Macro Forms:: Forms that call macros. -* Special Forms:: ``Special forms'' are idiosyncratic primitives, - most of them extremely important. -* Autoloading:: Functions set up to load files - containing their real definitions. - -Control Structures - -* Sequencing:: Evaluation in textual order. -* Conditionals:: @code{if}, @code{cond}. -* Combining Conditions:: @code{and}, @code{or}, @code{not}. -* Iteration:: @code{while} loops. -* Nonlocal Exits:: Jumping out of a sequence. - -Nonlocal Exits - -* Catch and Throw:: Nonlocal exits for the program's own purposes. -* Examples of Catch:: Showing how such nonlocal exits can be written. -* Errors:: How errors are signaled and handled. -* Cleanups:: Arranging to run a cleanup form if an - error happens. - -Errors - -* Signaling Errors:: How to report an error. -* Processing of Errors:: What XEmacs does when you report an error. -* Handling Errors:: How you can trap errors and continue execution. -* Error Symbols:: How errors are classified for trapping them. - -Variables - -* Global Variables:: Variable values that exist permanently, everywhere. -* Constant Variables:: Certain "variables" have values that never change. -* Local Variables:: Variable values that exist only temporarily. -* Void Variables:: Symbols that lack values. -* Defining Variables:: A definition says a symbol is used as a variable. -* Accessing Variables:: Examining values of variables whose names - are known only at run time. -* Setting Variables:: Storing new values in variables. -* Variable Scoping:: How Lisp chooses among local and global values. -* Buffer-Local Variables:: Variable values in effect only in one buffer. - -Scoping Rules for Variable Bindings - -* Scope:: Scope means where in the program a value - is visible. Comparison with other languages. -* Extent:: Extent means how long in time a value exists. -* Impl of Scope:: Two ways to implement dynamic scoping. -* Using Scoping:: How to use dynamic scoping carefully and - avoid problems. - -Buffer-Local Variables - -* Intro to Buffer-Local:: Introduction and concepts. -* Creating Buffer-Local:: Creating and destroying buffer-local bindings. -* Default Value:: The default value is seen in buffers - that don't have their own local values. - -Functions - -* What Is a Function:: Lisp functions vs primitives; terminology. -* Lambda Expressions:: How functions are expressed as Lisp objects. -* Function Names:: A symbol can serve as the name of a function. -* Defining Functions:: Lisp expressions for defining functions. -* Calling Functions:: How to use an existing function. -* Mapping Functions:: Applying a function to each element of a list, etc. -* Anonymous Functions:: Lambda-expressions are functions with no names. -* Function Cells:: Accessing or setting the function definition - of a symbol. -* Related Topics:: Cross-references to specific Lisp primitives - that have a special bearing on how - functions work. - -Lambda Expressions - -* Lambda Components:: The parts of a lambda expression. -* Simple Lambda:: A simple example. -* Argument List:: Details and special features of argument lists. -* Function Documentation:: How to put documentation in a function. - -Macros - -* Simple Macro:: A basic example. -* Expansion:: How, when and why macros are expanded. -* Compiling Macros:: How macros are expanded by the compiler. -* Defining Macros:: How to write a macro definition. -* Backquote:: Easier construction of list structure. -* Problems with Macros:: Don't evaluate the macro arguments too many times. - Don't hide the user's variables. - -Loading - -* How Programs Do Loading:: The @code{load} function and others. -* Autoload:: Setting up a function to autoload. -* Named Features:: Loading a library if it isn't already loaded. -* Repeated Loading:: Precautions about loading a file twice. - -Byte Compilation - -* Compilation Functions:: Byte compilation functions. -* Disassembly:: Disassembling byte-code; how to read byte-code. - -Debugging Lisp Programs - -* Debugger:: How the XEmacs Lisp debugger is implemented. -* Syntax Errors:: How to find syntax errors. -* Compilation Errors:: How to find errors that show up in - byte compilation. -* Edebug:: A source-level XEmacs Lisp debugger. - -The Lisp Debugger - -* Error Debugging:: Entering the debugger when an error happens. -* Function Debugging:: Entering it when a certain function is called. -* Explicit Debug:: Entering it at a certain point in the program. -* Using Debugger:: What the debugger does; what you see while in it. -* Debugger Commands:: Commands used while in the debugger. -* Invoking the Debugger:: How to call the function @code{debug}. -* Internals of Debugger:: Subroutines of the debugger, and global variables. - -Debugging Invalid Lisp Syntax - -* Excess Open:: How to find a spurious open paren or missing close. -* Excess Close:: How to find a spurious close paren or missing open. - -Reading and Printing Lisp Objects - -* Streams Intro:: Overview of streams, reading and printing. -* Input Streams:: Various data types that can be used as - input streams. -* Input Functions:: Functions to read Lisp objects from text. -* Output Streams:: Various data types that can be used as - output streams. -* Output Functions:: Functions to print Lisp objects as text. - -Minibuffers - -* Intro to Minibuffers:: Basic information about minibuffers. -* Text from Minibuffer:: How to read a straight text string. -* Object from Minibuffer:: How to read a Lisp object or expression. -* Completion:: How to invoke and customize completion. -* Yes-or-No Queries:: Asking a question with a simple answer. -* Minibuffer Misc:: Various customization hooks and variables. - -Completion - -* Basic Completion:: Low-level functions for completing strings. - (These are too low level to use the minibuffer.) -* Minibuffer Completion:: Invoking the minibuffer with completion. -* Completion Commands:: Minibuffer commands that do completion. -* High-Level Completion:: Convenient special cases of completion - (reading buffer name, file name, etc.) -* Reading File Names:: Using completion to read file names. -* Programmed Completion:: Finding the completions for a given file name. - -Command Loop - -* Command Overview:: How the command loop reads commands. -* Defining Commands:: Specifying how a function should read arguments. -* Interactive Call:: Calling a command, so that it will read arguments. -* Command Loop Info:: Variables set by the command loop for you to examine. -* Events:: What input looks like when you read it. -* Reading Input:: How to read input events from the keyboard or mouse. -* Waiting:: Waiting for user input or elapsed time. -* Quitting:: How @kbd{C-g} works. How to catch or defer quitting. -* Prefix Command Arguments:: How the commands to set prefix args work. -* Recursive Editing:: Entering a recursive edit, - and why you usually shouldn't. -* Disabling Commands:: How the command loop handles disabled commands. -* Command History:: How the command history is set up, and how accessed. -* Keyboard Macros:: How keyboard macros are implemented. - -Defining Commands - -* Using Interactive:: General rules for @code{interactive}. -* Interactive Codes:: The standard letter-codes for reading arguments - in various ways. -* Interactive Examples:: Examples of how to read interactive arguments. - -Events - -* Event Types:: Events come in different types. -* Event Contents:: What the contents of each event type are. -* Event Predicates:: Querying whether an event is of a - particular type. -* Accessing Mouse Event Positions:: - Determining where a mouse event occurred, - and over what. -* Accessing Other Event Info:: Accessing non-positional event info. -* Working With Events:: Creating, copying, and destroying events. -* Converting Events:: Converting between events, keys, and - characters. - -Accessing Mouse Event Positions - -* Frame-Level Event Position Info:: -* Window-Level Event Position Info:: -* Event Text Position Info:: -* Event Glyph Position Info:: -* Event Toolbar Position Info:: -* Other Event Position Info:: - -Reading Input - -* Key Sequence Input:: How to read one key sequence. -* Reading One Event:: How to read just one event. -* Dispatching an Event:: What to do with an event once it has been read. -* Quoted Character Input:: Asking the user to specify a character. -* Peeking and Discarding:: How to reread or throw away input events. - -Keymaps - -* Keymap Terminology:: Definitions of terms pertaining to keymaps. -* Format of Keymaps:: What a keymap looks like as a Lisp object. -* Creating Keymaps:: Functions to create and copy keymaps. -* Inheritance and Keymaps:: How one keymap can inherit the bindings - of another keymap. -* Key Sequences:: How to specify key sequences. -* Prefix Keys:: Defining a key with a keymap as its definition. -* Active Keymaps:: Each buffer has a local keymap - to override the standard (global) bindings. - Each minor mode can also override them. -* Key Lookup:: How extracting elements from keymaps works. -* Functions for Key Lookup:: How to request key lookup. -* Changing Key Bindings:: Redefining a key in a keymap. -* Key Binding Commands:: Interactive interfaces for redefining keys. -* Scanning Keymaps:: Looking through all keymaps, for printing help. -* Other Keymap Functions:: Miscellaneous keymap functions. - -Menus - -* Menu Format:: Format of a menu description. -* Menubar Format:: How to specify a menubar. -* Menubar:: Functions for controlling the menubar. -* Modifying Menus:: Modifying a menu description. -* Pop-Up Menus:: Functions for specifying pop-up menus. -* Menu Filters:: Filter functions for the default menubar. -* Buffers Menu:: The menu that displays the list of buffers. - -Dialog Boxes - -* Dialog Box Format:: -* Dialog Box Functions:: - -Toolbar - -* Toolbar Intro:: An introduction. -* Toolbar Descriptor Format:: How to create a toolbar. -* Specifying the Toolbar:: Setting a toolbar. -* Other Toolbar Variables:: Controlling the size of toolbars. - -Scrollbars - -Major and Minor Modes - -* Major Modes:: Defining major modes. -* Minor Modes:: Defining minor modes. -* Modeline Format:: Customizing the text that appears in the modeline. -* Hooks:: How to use hooks; how to write code that - provides hooks. - -Major Modes - -* Major Mode Conventions:: Coding conventions for keymaps, etc. -* Example Major Modes:: Text mode and Lisp modes. -* Auto Major Mode:: How XEmacs chooses the major mode automatically. -* Mode Help:: Finding out how to use a mode. - -Minor Modes - -* Minor Mode Conventions:: Tips for writing a minor mode. -* Keymaps and Minor Modes:: How a minor mode can have its own keymap. - -Modeline Format - -* Modeline Data:: The data structure that controls the modeline. -* Modeline Variables:: Variables used in that data structure. -* %-Constructs:: Putting information into a modeline. - -Documentation - -* Documentation Basics:: Good style for doc strings. - Where to put them. How XEmacs stores them. -* Accessing Documentation:: How Lisp programs can access doc strings. -* Keys in Documentation:: Substituting current key bindings. -* Describing Characters:: Making printable descriptions of - non-printing characters and key sequences. -* Help Functions:: Subroutines used by XEmacs help facilities. - -Files - -* Visiting Files:: Reading files into Emacs buffers for editing. -* Saving Buffers:: Writing changed buffers back into files. -* Reading from Files:: Reading files into other buffers. -* Writing to Files:: Writing new files from parts of buffers. -* File Locks:: Locking and unlocking files, to prevent - simultaneous editing by two people. -* Information about Files:: Testing existence, accessibility, size of files. -* Contents of Directories:: Getting a list of the files in a directory. -* Changing File Attributes:: Renaming files, changing protection, etc. -* File Names:: Decomposing and expanding file names. - -Visiting Files - -* Visiting Functions:: The usual interface functions for visiting. -* Subroutines of Visiting:: Lower-level subroutines that they use. - -Information about Files - -* Testing Accessibility:: Is a given file readable? Writable? -* Kinds of Files:: Is it a directory? A link? -* File Attributes:: How large is it? Any other names? Etc. - -File Names - -* File Name Components:: The directory part of a file name, and the rest. -* Directory Names:: A directory's name as a directory - is different from its name as a file. -* Relative File Names:: Some file names are relative to a - current directory. -* File Name Expansion:: Converting relative file names to absolute ones. -* Unique File Names:: Generating names for temporary files. -* File Name Completion:: Finding the completions for a given file name. - -Backups and Auto-Saving - -* Backup Files:: How backup files are made; how their names - are chosen. -* Auto-Saving:: How auto-save files are made; how their - names are chosen. -* Reverting:: @code{revert-buffer}, and how to customize - what it does. - -Backup Files - -* Making Backups:: How XEmacs makes backup files, and when. -* Rename or Copy:: Two alternatives: renaming the old file - or copying it. -* Numbered Backups:: Keeping multiple backups for each source file. -* Backup Names:: How backup file names are computed; customization. - -Buffers - -* Buffer Basics:: What is a buffer? -* Buffer Names:: Accessing and changing buffer names. -* Buffer File Name:: The buffer file name indicates which file - is visited. -* Buffer Modification:: A buffer is @dfn{modified} if it needs to be saved. -* Modification Time:: Determining whether the visited file was changed - ``behind XEmacs's back''. -* Read Only Buffers:: Modifying text is not allowed in a - read-only buffer. -* The Buffer List:: How to look at all the existing buffers. -* Creating Buffers:: Functions that create buffers. -* Killing Buffers:: Buffers exist until explicitly killed. -* Current Buffer:: Designating a buffer as current - so primitives will access its contents. - -Windows - -* Basic Windows:: Basic information on using windows. -* Splitting Windows:: Splitting one window into two windows. -* Deleting Windows:: Deleting a window gives its space to other windows. -* Selecting Windows:: The selected window is the one that you edit in. -* Cyclic Window Ordering:: Moving around the existing windows. -* Buffers and Windows:: Each window displays the contents of a buffer. -* Displaying Buffers:: Higher-lever functions for displaying a buffer - and choosing a window for it. -* Window Point:: Each window has its own location of point. -* Window Start:: The display-start position controls which text - is on-screen in the window. -* Vertical Scrolling:: Moving text up and down in the window. -* Horizontal Scrolling:: Moving text sideways on the window. -* Size of Window:: Accessing the size of a window. -* Resizing Windows:: Changing the size of a window. -* Window Configurations:: Saving and restoring the state of the screen. - -Frames - -* Creating Frames:: Creating additional frames. -* Frame Properties:: Controlling frame size, position, font, etc. -* Frame Titles:: Automatic updating of frame titles. -* Deleting Frames:: Frames last until explicitly deleted. -* Finding All Frames:: How to examine all existing frames. -* Frames and Windows:: A frame contains windows; - display of text always works through windows. -* Minibuffers and Frames:: How a frame finds the minibuffer to use. -* Input Focus:: Specifying the selected frame. -* Visibility of Frames:: Frames may be visible or invisible, or icons. -* Raising and Lowering:: Raising a frame makes it hide other X windows; - lowering it makes the others hide them. -* Frame Hooks:: Hooks for customizing frame behavior. - -Positions - -* Point:: The special position where editing takes place. -* Motion:: Changing point. -* Excursions:: Temporary motion and buffer changes. -* Narrowing:: Restricting editing to a portion of the buffer. - -Motion - -* Character Motion:: Moving in terms of characters. -* Word Motion:: Moving in terms of words. -* Buffer End Motion:: Moving to the beginning or end of the buffer. -* Text Lines:: Moving in terms of lines of text. -* Screen Lines:: Moving in terms of lines as displayed. -* List Motion:: Moving by parsing lists and sexps. -* Skipping Characters:: Skipping characters belonging to a certain set. - -Markers - -* Overview of Markers:: The components of a marker, and how it relocates. -* Predicates on Markers:: Testing whether an object is a marker. -* Creating Markers:: Making empty markers or markers at certain places. -* Information from Markers:: Finding the marker's buffer or character - position. -* Changing Markers:: Moving the marker to a new buffer or position. -* The Mark:: How ``the mark'' is implemented with a marker. -* The Region:: How to access ``the region''. - -Text - -* Near Point:: Examining text in the vicinity of point. -* Buffer Contents:: Examining text in a general fashion. -* Comparing Text:: Comparing substrings of buffers. -* Insertion:: Adding new text to a buffer. -* Commands for Insertion:: User-level commands to insert text. -* Deletion:: Removing text from a buffer. -* User-Level Deletion:: User-level commands to delete text. -* The Kill Ring:: Where removed text sometimes is saved for later use. -* Undo:: Undoing changes to the text of a buffer. -* Maintaining Undo:: How to enable and disable undo information. - How to control how much information is kept. -* Filling:: Functions for explicit filling. -* Margins:: How to specify margins for filling commands. -* Auto Filling:: How auto-fill mode is implemented to break lines. -* Sorting:: Functions for sorting parts of the buffer. -* Columns:: Computing horizontal positions, and using them. -* Indentation:: Functions to insert or adjust indentation. -* Case Changes:: Case conversion of parts of the buffer. -* Text Properties:: Assigning Lisp property lists to text characters. -* Substitution:: Replacing a given character wherever it appears. -* Registers:: How registers are implemented. Accessing the text or - position stored in a register. -* Transposition:: Swapping two portions of a buffer. -* Change Hooks:: Supplying functions to be run when text is changed. - -The Kill Ring - -* Kill Ring Concepts:: What text looks like in the kill ring. -* Kill Functions:: Functions that kill text. -* Yank Commands:: Commands that access the kill ring. -* Low-Level Kill Ring:: Functions and variables for kill ring access. -* Internals of Kill Ring:: Variables that hold kill-ring data. - -Indentation - -* Primitive Indent:: Functions used to count and insert indentation. -* Mode-Specific Indent:: Customize indentation for different modes. -* Region Indent:: Indent all the lines in a region. -* Relative Indent:: Indent the current line based on previous lines. -* Indent Tabs:: Adjustable, typewriter-like tab stops. -* Motion by Indent:: Move to first non-blank character. - -Searching and Matching - -* String Search:: Search for an exact match. -* Regular Expressions:: Describing classes of strings. -* Regexp Search:: Searching for a match for a regexp. -* Match Data:: Finding out which part of the text matched - various parts of a regexp, after regexp search. -* Saving Match Data:: Saving and restoring this information. -* Standard Regexps:: Useful regexps for finding sentences, pages,... -* Searching and Case:: Case-independent or case-significant searching. - -Regular Expressions - -* Syntax of Regexps:: Rules for writing regular expressions. -* Regexp Example:: Illustrates regular expression syntax. - -Syntax Tables - -* Syntax Descriptors:: How characters are classified. -* Syntax Table Functions:: How to create, examine and alter syntax tables. -* Parsing Expressions:: Parsing balanced expressions - using the syntax table. -* Standard Syntax Tables:: Syntax tables used by various major modes. -* Syntax Table Internals:: How syntax table information is stored. - -Syntax Descriptors - -* Syntax Class Table:: Table of syntax classes. -* Syntax Flags:: Additional flags each character can have. - -Abbrevs And Abbrev Expansion - -* Abbrev Mode:: Setting up XEmacs for abbreviation. -* Tables: Abbrev Tables. Creating and working with abbrev tables. -* Defining Abbrevs:: Specifying abbreviations and their expansions. -* Files: Abbrev Files. Saving abbrevs in files. -* Expansion: Abbrev Expansion. Controlling expansion; expansion subroutines. -* Standard Abbrev Tables:: Abbrev tables used by various major modes. - -Extents - -* Intro to Extents:: Extents are regions over a buffer or string. -* Creating and Modifying Extents:: - Basic extent functions. -* Extent Endpoints:: Accessing and setting the bounds of an extent. -* Finding Extents:: Determining which extents are in an object. -* Mapping Over Extents:: More sophisticated functions for extent scanning. -* Extent Properties:: Extents have built-in and user-definable properties. -* Detached Extents:: Extents that are not in a buffer. -* Extent Parents:: Inheriting properties from another extent. -* Duplicable Extents:: Extents can be marked to be copied into strings. -* Extents and Events:: Extents can interact with the keyboard and mouse. -* Atomic Extents:: Treating a block of text as a single entity. - -Specifiers - -* Introduction to Specifiers:: Specifiers provide a clean way for - display and other properties to vary - (under user control) in a wide variety - of contexts. -* Specifiers In-Depth:: Gory details about specifier innards. -* Specifier Instancing:: Instancing means obtaining the ``value'' of - a specifier in a particular context. -* Specifier Types:: Specifiers come in different flavors. -* Adding Specifications:: Specifications control a specifier's ``value'' - by giving conditions under which a - particular value is valid. -* Retrieving Specifications:: Querying a specifier's specifications. -* Specifier Instancing Functions:: - Functions to instance a specifier. -* Specifier Example:: Making all this stuff clearer. -* Creating Specifiers:: Creating specifiers for your own use. -* Specifier Validation Functions:: - Validating the components of a specifier. -* Other Specification Functions:: - Other ways of working with specifications. - -Faces and Window-System Objects - -* Faces:: Controlling the way text looks. -* Fonts:: Controlling the typeface of text. -* Colors:: Controlling the color of text and pixmaps. - -Faces - -* Merging Faces:: How XEmacs decides which face to use - for a character. -* Basic Face Functions:: How to define and examine faces. -* Face Properties:: How to access and modify a face's properties. -* Face Convenience Functions:: Convenience functions for accessing - particular properties of a face. -* Other Face Display Functions:: Other functions pertaining to how a - a face appears. - -Fonts - -* Font Specifiers:: Specifying how a font will appear. -* Font Instances:: What a font specifier gets instanced as. -* Font Instance Names:: The name of a font instance. -* Font Instance Size:: The size of a font instance. -* Font Instance Characteristics:: Display characteristics of font instances. -* Font Convenience Functions:: Convenience functions that automatically - instance and retrieve the properties - of a font specifier. - -Colors - -* Color Specifiers:: Specifying how a color will appear. -* Color Instances:: What a color specifier gets instanced as. -* Color Instance Properties:: Properties of color instances. -* Color Convenience Functions:: Convenience functions that automatically - instance and retrieve the properties - of a color specifier. - -Glyphs - -* Glyph Functions:: Functions for working with glyphs. -* Images:: Graphical images displayed in a frame. -* Glyph Types:: Each glyph has a particular type. -* Mouse Pointer:: Controlling the mouse pointer. -* Redisplay Glyphs:: Glyphs controlling various redisplay functions. -* Subwindows:: Inserting an externally-controlled subwindow - into a buffer. - -Glyph Functions - -* Creating Glyphs:: Creating new glyphs. -* Glyph Properties:: Accessing and modifying a glyph's properties. -* Glyph Convenience Functions:: - Convenience functions for accessing particular - properties of a glyph. -* Glyph Dimensions:: Determining the height, width, etc. of a glyph. - -Images - -* Image Specifiers:: Specifying how an image will appear. -* Image Instantiator Conversion:: - Conversion is applied to image instantiators - at the time they are added to an - image specifier or at the time they - are passed to @code{make-image-instance}. -* Image Instances:: What an image specifier gets instanced as. - -Image Instances - -* Image Instance Types:: Each image instances has a particular type. -* Image Instance Functions:: Functions for working with image instances. - -Annotations - -* Annotation Basics:: Introduction to annotations. -* Annotation Primitives:: Creating and deleting annotations. -* Annotation Properties:: Retrieving and changing the characteristics - of an annotation. -* Margin Primitives:: Controlling the size of the margins. -* Locating Annotations:: Looking for annotations in a buffer. -* Annotation Hooks:: Hooks called at certain times during an - annotation's lifetime. - -Hash Tables - -* Introduction to Hash Tables:: Hash tables are fast data structures for - implementing simple tables (i.e. finite - mappings from keys to values). -* Working With Hash Tables:: Hash table functions. -* Weak Hash Tables:: Hash tables with special garbage-collection - behavior. - -Range Tables - -* Introduction to Range Tables:: Range tables efficiently map ranges of - integers to values. -* Working With Range Tables:: Range table functions. - - -XEmacs Display - -* Refresh Screen:: Clearing the screen and redrawing everything on it. -* Truncation:: Folding or wrapping long text lines. -* The Echo Area:: Where messages are displayed. -* Selective Display:: Hiding part of the buffer text. -* Overlay Arrow:: Display of an arrow to indicate position. -* Temporary Displays:: Displays that go away automatically. -* Blinking:: How XEmacs shows the matching open parenthesis. -* Usual Display:: The usual conventions for displaying nonprinting chars. -* Display Tables:: How to specify other conventions. -* Beeping:: Audible signal to the user. - -Processes - -* Subprocess Creation:: Functions that start subprocesses. -* Synchronous Processes:: Details of using synchronous subprocesses. -* Asynchronous Processes:: Starting up an asynchronous subprocess. -* Deleting Processes:: Eliminating an asynchronous subprocess. -* Process Information:: Accessing run-status and other attributes. -* Input to Processes:: Sending input to an asynchronous subprocess. -* Signals to Processes:: Stopping, continuing or interrupting - an asynchronous subprocess. -* Output from Processes:: Collecting output from an asynchronous subprocess. -* Sentinels:: Sentinels run when process run-status changes. -* Network:: Opening network connections. - -Receiving Output from Processes - -* Process Buffers:: If no filter, output is put in a buffer. -* Filter Functions:: Filter functions accept output from the process. -* Accepting Output:: How to wait until process output arrives. - -Operating System Interface - -* Starting Up:: Customizing XEmacs start-up processing. -* Getting Out:: How exiting works (permanent or temporary). -* System Environment:: Distinguish the name and kind of system. -* Terminal Input:: Recording terminal input for debugging. -* Terminal Output:: Recording terminal output for debugging. -* Flow Control:: How to turn output flow control on or off. -* Batch Mode:: Running XEmacs without terminal interaction. - -Starting Up XEmacs - -* Start-up Summary:: Sequence of actions XEmacs performs at start-up. -* Init File:: Details on reading the init file (@file{.emacs}). -* Terminal-Specific:: How the terminal-specific Lisp file is read. -* Command Line Arguments:: How command line arguments are processed, - and how you can customize them. - -Getting out of XEmacs - -* Killing XEmacs:: Exiting XEmacs irreversibly. -* Suspending XEmacs:: Exiting XEmacs reversibly. - -X-Windows - -* X Selections:: Transferring text to and from other X clients. -* X Server:: Information about the X server connected to - a particular device. -* Resources:: Getting resource values from the server. -* Server Data:: Getting info about the X server. -* Grabs:: Restricting access to the server by other apps. -* X Miscellaneous:: Other X-specific functions and variables. - -ToolTalk Support - -* XEmacs ToolTalk API Summary:: -* Sending Messages:: -* Receiving Messages:: - -LDAP Support - -* Building XEmacs with LDAP support:: How to add LDAP support to XEmacs -* XEmacs LDAP API:: Lisp access to LDAP functions -* Syntax of Search Filters:: A brief summary of RFC 1558 - -XEmacs LDAP API - -* LDAP Variables:: Lisp variables related to LDAP -* The High-Level LDAP API:: High-level LDAP lisp functions -* The Low-Level LDAP API:: Low-level LDAP lisp primitives - -The Low-Level LDAP API - -* The LDAP Lisp Object:: -* Opening and Closing a LDAP Connection:: -* Searching on a LDAP Server (Low-level):: - -Internationalization - -* I18N Levels 1 and 2:: Support for different time, date, and currency formats. -* I18N Level 3:: Support for localized messages. -* I18N Level 4:: Support for Asian languages. - -MULE - -* Internationalization Terminology:: - Definition of various internationalization terms. -* Charsets:: Sets of related characters. -* MULE Characters:: Working with characters in XEmacs/MULE. -* Composite Characters:: Making new characters by overstriking other ones. -* ISO 2022:: An international standard for charsets and encodings. -* Coding Systems:: Ways of representing a string of chars using integers. -* CCL:: A special language for writing fast converters. -* Category Tables:: Subdividing charsets into groups. - -Tips - -* Style Tips:: Writing clean and robust programs. -* Compilation Tips:: Making compiled code run fast. -* Documentation Tips:: Writing readable documentation strings. -* Comment Tips:: Conventions for writing comments. -* Library Headers:: Standard headers for library packages. - -Building XEmacs and Object Allocation - -* Building XEmacs:: How to preload Lisp libraries into XEmacs. -* Pure Storage:: A kludge to make preloaded Lisp functions sharable. -* Garbage Collection:: Reclaiming space for Lisp objects no longer used. - -@end menu - -@include intro.texi -@include objects.texi -@include numbers.texi -@include strings.texi - -@include lists.texi -@include sequences.texi -@include symbols.texi -@include eval.texi - -@include control.texi -@include variables.texi -@include functions.texi -@include macros.texi -@include customize.texi - -@include loading.texi -@include compile.texi -@include debugging.texi -@include streams.texi - -@include minibuf.texi -@include commands.texi -@include keymaps.texi -@include menus.texi -@include dialog.texi -@include toolbar.texi -@include scrollbars.texi -@include dragndrop.texi -@include modes.texi - -@include help.texi -@include files.texi -@include backups.texi -@include buffers.texi - -@include windows.texi -@include frames.texi -@include consoles-devices.texi -@include positions.texi -@include markers.texi -@include text.texi - -@include searching.texi -@include syntax.texi -@include abbrevs.texi - -@include extents.texi -@include specifiers.texi -@include faces.texi -@include glyphs.texi -@include annotations.texi -@include display.texi - -@include hash-tables.texi -@include range-tables.texi -@include databases.texi - -@include processes.texi -@include os.texi -@include x-windows.texi -@include tooltalk.texi -@include ldap.texi -@include internationalization.texi -@include mule.texi - -@c MOVE to User's Manual: include calendar.texi - -@c MOVE to User's Manual: include misc-modes.texi - -@c appendices - -@c REMOVE this: include non-hacker.texi - -@include tips.texi -@include building.texi -@include errors.texi -@include locals.texi -@include maps.texi -@include hooks.texi - -@include index.texi - -@c Print the tables of contents -@summarycontents -@contents -@c That's all - -@bye - - -These words prevent "local variables" above from confusing XEmacs. diff --git a/man/lispref/lists.texi b/man/lispref/lists.texi deleted file mode 100644 index be8bc92..0000000 --- a/man/lispref/lists.texi +++ /dev/null @@ -1,1819 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/lists.info -@node Lists, Sequences Arrays Vectors, Strings and Characters, Top -@chapter Lists -@cindex list -@cindex element (of list) - - A @dfn{list} represents a sequence of zero or more elements (which may -be any Lisp objects). The important difference between lists and -vectors is that two or more lists can share part of their structure; in -addition, you can insert or delete elements in a list without copying -the whole list. - -@menu -* Cons Cells:: How lists are made out of cons cells. -* Lists as Boxes:: Graphical notation to explain lists. -* List-related Predicates:: Is this object a list? Comparing two lists. -* List Elements:: Extracting the pieces of a list. -* Building Lists:: Creating list structure. -* Modifying Lists:: Storing new pieces into an existing list. -* Sets And Lists:: A list can represent a finite mathematical set. -* Association Lists:: A list can represent a finite relation or mapping. -* Property Lists:: A different way to represent a finite mapping. -* Weak Lists:: A list with special garbage-collection behavior. -@end menu - -@node Cons Cells -@section Lists and Cons Cells -@cindex lists and cons cells -@cindex @code{nil} and lists - - Lists in Lisp are not a primitive data type; they are built up from -@dfn{cons cells}. A cons cell is a data object that represents an -ordered pair. It records two Lisp objects, one labeled as the @sc{car}, -and the other labeled as the @sc{cdr}. These names are traditional; see -@ref{Cons Cell Type}. @sc{cdr} is pronounced ``could-er.'' - - A list is a series of cons cells chained together, one cons cell per -element of the list. By convention, the @sc{car}s of the cons cells are -the elements of the list, and the @sc{cdr}s are used to chain the list: -the @sc{cdr} of each cons cell is the following cons cell. The @sc{cdr} -of the last cons cell is @code{nil}. This asymmetry between the -@sc{car} and the @sc{cdr} is entirely a matter of convention; at the -level of cons cells, the @sc{car} and @sc{cdr} slots have the same -characteristics. - -@cindex list structure - Because most cons cells are used as part of lists, the phrase -@dfn{list structure} has come to mean any structure made out of cons -cells. - - The symbol @code{nil} is considered a list as well as a symbol; it is -the list with no elements. For convenience, the symbol @code{nil} is -considered to have @code{nil} as its @sc{cdr} (and also as its -@sc{car}). - - The @sc{cdr} of any nonempty list @var{l} is a list containing all the -elements of @var{l} except the first. - -@node Lists as Boxes -@section Lists as Linked Pairs of Boxes -@cindex box representation for lists -@cindex lists represented as boxes -@cindex cons cell as box - - A cons cell can be illustrated as a pair of boxes. The first box -represents the @sc{car} and the second box represents the @sc{cdr}. -Here is an illustration of the two-element list, @code{(tulip lily)}, -made from two cons cells: - -@example -@group - --------------- --------------- -| car | cdr | | car | cdr | -| tulip | o---------->| lily | nil | -| | | | | | - --------------- --------------- -@end group -@end example - - Each pair of boxes represents a cons cell. Each box ``refers to'', -``points to'' or ``contains'' a Lisp object. (These terms are -synonymous.) The first box, which is the @sc{car} of the first cons -cell, contains the symbol @code{tulip}. The arrow from the @sc{cdr} of -the first cons cell to the second cons cell indicates that the @sc{cdr} -of the first cons cell points to the second cons cell. - - The same list can be illustrated in a different sort of box notation -like this: - -@example -@group - ___ ___ ___ ___ - |___|___|--> |___|___|--> nil - | | - | | - --> tulip --> lily -@end group -@end example - - Here is a more complex illustration, showing the three-element list, -@code{((pine needles) oak maple)}, the first element of which is a -two-element list: - -@example -@group - ___ ___ ___ ___ ___ ___ - |___|___|--> |___|___|--> |___|___|--> nil - | | | - | | | - | --> oak --> maple - | - | ___ ___ ___ ___ - --> |___|___|--> |___|___|--> nil - | | - | | - --> pine --> needles -@end group -@end example - - The same list represented in the first box notation looks like this: - -@example -@group - -------------- -------------- -------------- -| car | cdr | | car | cdr | | car | cdr | -| o | o------->| oak | o------->| maple | nil | -| | | | | | | | | | - -- | --------- -------------- -------------- - | - | - | -------------- ---------------- - | | car | cdr | | car | cdr | - ------>| pine | o------->| needles | nil | - | | | | | | - -------------- ---------------- -@end group -@end example - - @xref{Cons Cell Type}, for the read and print syntax of cons cells and -lists, and for more ``box and arrow'' illustrations of lists. - -@node List-related Predicates -@section Predicates on Lists - - The following predicates test whether a Lisp object is an atom, is a -cons cell or is a list, or whether it is the distinguished object -@code{nil}. (Many of these predicates can be defined in terms of the -others, but they are used so often that it is worth having all of them.) - -@defun consp object -This function returns @code{t} if @var{object} is a cons cell, @code{nil} -otherwise. @code{nil} is not a cons cell, although it @emph{is} a list. -@end defun - -@defun atom object -@cindex atoms -This function returns @code{t} if @var{object} is an atom, @code{nil} -otherwise. All objects except cons cells are atoms. The symbol -@code{nil} is an atom and is also a list; it is the only Lisp object -that is both. - -@example -(atom @var{object}) @equiv{} (not (consp @var{object})) -@end example -@end defun - -@defun listp object -This function returns @code{t} if @var{object} is a cons cell or -@code{nil}. Otherwise, it returns @code{nil}. - -@example -@group -(listp '(1)) - @result{} t -@end group -@group -(listp '()) - @result{} t -@end group -@end example -@end defun - -@defun nlistp object -This function is the opposite of @code{listp}: it returns @code{t} if -@var{object} is not a list. Otherwise, it returns @code{nil}. - -@example -(listp @var{object}) @equiv{} (not (nlistp @var{object})) -@end example -@end defun - -@defun null object -This function returns @code{t} if @var{object} is @code{nil}, and -returns @code{nil} otherwise. This function is identical to @code{not}, -but as a matter of clarity we use @code{null} when @var{object} is -considered a list and @code{not} when it is considered a truth value -(see @code{not} in @ref{Combining Conditions}). - -@example -@group -(null '(1)) - @result{} nil -@end group -@group -(null '()) - @result{} t -@end group -@end example -@end defun - -@need 2000 - -@node List Elements -@section Accessing Elements of Lists -@cindex list elements - -@defun car cons-cell -This function returns the value pointed to by the first pointer of the -cons cell @var{cons-cell}. Expressed another way, this function -returns the @sc{car} of @var{cons-cell}. - -As a special case, if @var{cons-cell} is @code{nil}, then @code{car} -is defined to return @code{nil}; therefore, any list is a valid argument -for @code{car}. An error is signaled if the argument is not a cons cell -or @code{nil}. - -@example -@group -(car '(a b c)) - @result{} a -@end group -@group -(car '()) - @result{} nil -@end group -@end example -@end defun - -@defun cdr cons-cell -This function returns the value pointed to by the second pointer of -the cons cell @var{cons-cell}. Expressed another way, this function -returns the @sc{cdr} of @var{cons-cell}. - -As a special case, if @var{cons-cell} is @code{nil}, then @code{cdr} -is defined to return @code{nil}; therefore, any list is a valid argument -for @code{cdr}. An error is signaled if the argument is not a cons cell -or @code{nil}. - -@example -@group -(cdr '(a b c)) - @result{} (b c) -@end group -@group -(cdr '()) - @result{} nil -@end group -@end example -@end defun - -@defun car-safe object -This function lets you take the @sc{car} of a cons cell while avoiding -errors for other data types. It returns the @sc{car} of @var{object} if -@var{object} is a cons cell, @code{nil} otherwise. This is in contrast -to @code{car}, which signals an error if @var{object} is not a list. - -@example -@group -(car-safe @var{object}) -@equiv{} -(let ((x @var{object})) - (if (consp x) - (car x) - nil)) -@end group -@end example -@end defun - -@defun cdr-safe object -This function lets you take the @sc{cdr} of a cons cell while -avoiding errors for other data types. It returns the @sc{cdr} of -@var{object} if @var{object} is a cons cell, @code{nil} otherwise. -This is in contrast to @code{cdr}, which signals an error if -@var{object} is not a list. - -@example -@group -(cdr-safe @var{object}) -@equiv{} -(let ((x @var{object})) - (if (consp x) - (cdr x) - nil)) -@end group -@end example -@end defun - -@defun nth n list -This function returns the @var{n}th element of @var{list}. Elements -are numbered starting with zero, so the @sc{car} of @var{list} is -element number zero. If the length of @var{list} is @var{n} or less, -the value is @code{nil}. - -If @var{n} is negative, @code{nth} returns the first element of -@var{list}. - -@example -@group -(nth 2 '(1 2 3 4)) - @result{} 3 -@end group -@group -(nth 10 '(1 2 3 4)) - @result{} nil -@end group -@group -(nth -3 '(1 2 3 4)) - @result{} 1 - -(nth n x) @equiv{} (car (nthcdr n x)) -@end group -@end example -@end defun - -@defun nthcdr n list -This function returns the @var{n}th @sc{cdr} of @var{list}. In other -words, it removes the first @var{n} links of @var{list} and returns -what follows. - -If @var{n} is zero or negative, @code{nthcdr} returns all of -@var{list}. If the length of @var{list} is @var{n} or less, -@code{nthcdr} returns @code{nil}. - -@example -@group -(nthcdr 1 '(1 2 3 4)) - @result{} (2 3 4) -@end group -@group -(nthcdr 10 '(1 2 3 4)) - @result{} nil -@end group -@group -(nthcdr -3 '(1 2 3 4)) - @result{} (1 2 3 4) -@end group -@end example -@end defun - -Many convenience functions are provided to make it easier for you to -access particular elements in a nested list. All of these can be -rewritten in terms of the functions just described. - -@defun caar cons-cell -@defunx cadr cons-cell -@defunx cdar cons-cell -@defunx cddr cons-cell -@defunx caaar cons-cell -@defunx caadr cons-cell -@defunx cadar cons-cell -@defunx caddr cons-cell -@defunx cdaar cons-cell -@defunx cdadr cons-cell -@defunx cddar cons-cell -@defunx cdddr cons-cell -@defunx caaaar cons-cell -@defunx caaadr cons-cell -@defunx caadar cons-cell -@defunx caaddr cons-cell -@defunx cadaar cons-cell -@defunx cadadr cons-cell -@defunx caddar cons-cell -@defunx cadddr cons-cell -@defunx cdaaar cons-cell -@defunx cdaadr cons-cell -@defunx cdadar cons-cell -@defunx cdaddr cons-cell -@defunx cddaar cons-cell -@defunx cddadr cons-cell -@defunx cdddar cons-cell -@defunx cddddr cons-cell -Each of these functions is equivalent to one or more applications of -@code{car} and/or @code{cdr}. For example, - -@example -(cadr x) -@end example - -is equivalent to - -@example -(car (cdr x)) -@end example - -and - -@example -(cdaddr x) -@end example - -is equivalent to - -@example -(cdr (car (cdr (cdr x)))) -@end example - -That is to say, read the a's and d's from right to left and apply -a @code{car} or @code{cdr} for each a or d found, respectively. -@end defun - -@defun first list -This is equivalent to @code{(nth 0 @var{list})}, i.e. the first element -of @var{list}. (Note that this is also equivalent to @code{car}.) -@end defun - -@defun second list -This is equivalent to @code{(nth 1 @var{list})}, i.e. the second element -of @var{list}. -@end defun - -@defun third list -@defunx fourth list -@defunx fifth list -@defunx sixth list -@defunx seventh list -@defunx eighth list -@defunx ninth list -@defunx tenth list -These are equivalent to @code{(nth 2 @var{list})} through -@code{(nth 9 @var{list})} respectively, i.e. the third through tenth -elements of @var{list}. -@end defun - -@node Building Lists -@section Building Cons Cells and Lists -@cindex cons cells -@cindex building lists - - Many functions build lists, as lists reside at the very heart of Lisp. -@code{cons} is the fundamental list-building function; however, it is -interesting to note that @code{list} is used more times in the source -code for Emacs than @code{cons}. - -@defun cons object1 object2 -This function is the fundamental function used to build new list -structure. It creates a new cons cell, making @var{object1} the -@sc{car}, and @var{object2} the @sc{cdr}. It then returns the new cons -cell. The arguments @var{object1} and @var{object2} may be any Lisp -objects, but most often @var{object2} is a list. - -@example -@group -(cons 1 '(2)) - @result{} (1 2) -@end group -@group -(cons 1 '()) - @result{} (1) -@end group -@group -(cons 1 2) - @result{} (1 . 2) -@end group -@end example - -@cindex consing -@code{cons} is often used to add a single element to the front of a -list. This is called @dfn{consing the element onto the list}. For -example: - -@example -(setq list (cons newelt list)) -@end example - -Note that there is no conflict between the variable named @code{list} -used in this example and the function named @code{list} described below; -any symbol can serve both purposes. -@end defun - -@defun list &rest objects -This function creates a list with @var{objects} as its elements. The -resulting list is always @code{nil}-terminated. If no @var{objects} -are given, the empty list is returned. - -@example -@group -(list 1 2 3 4 5) - @result{} (1 2 3 4 5) -@end group -@group -(list 1 2 '(3 4 5) 'foo) - @result{} (1 2 (3 4 5) foo) -@end group -@group -(list) - @result{} nil -@end group -@end example -@end defun - -@defun make-list length object -This function creates a list of length @var{length}, in which all the -elements have the identical value @var{object}. Compare -@code{make-list} with @code{make-string} (@pxref{Creating Strings}). - -@example -@group -(make-list 3 'pigs) - @result{} (pigs pigs pigs) -@end group -@group -(make-list 0 'pigs) - @result{} nil -@end group -@end example -@end defun - -@defun append &rest sequences -@cindex copying lists -This function returns a list containing all the elements of -@var{sequences}. The @var{sequences} may be lists, vectors, or strings, -but the last one should be a list. All arguments except the last one -are copied, so none of them are altered. - -More generally, the final argument to @code{append} may be any Lisp -object. The final argument is not copied or converted; it becomes the -@sc{cdr} of the last cons cell in the new list. If the final argument -is itself a list, then its elements become in effect elements of the -result list. If the final element is not a list, the result is a -``dotted list'' since its final @sc{cdr} is not @code{nil} as required -in a true list. - -See @code{nconc} in @ref{Rearrangement}, for a way to join lists with no -copying. - -Here is an example of using @code{append}: - -@example -@group -(setq trees '(pine oak)) - @result{} (pine oak) -(setq more-trees (append '(maple birch) trees)) - @result{} (maple birch pine oak) -@end group - -@group -trees - @result{} (pine oak) -more-trees - @result{} (maple birch pine oak) -@end group -@group -(eq trees (cdr (cdr more-trees))) - @result{} t -@end group -@end example - -You can see how @code{append} works by looking at a box diagram. The -variable @code{trees} is set to the list @code{(pine oak)} and then the -variable @code{more-trees} is set to the list @code{(maple birch pine -oak)}. However, the variable @code{trees} continues to refer to the -original list: - -@smallexample -@group -more-trees trees -| | -| ___ ___ ___ ___ -> ___ ___ ___ ___ - --> |___|___|--> |___|___|--> |___|___|--> |___|___|--> nil - | | | | - | | | | - --> maple -->birch --> pine --> oak -@end group -@end smallexample - -An empty sequence contributes nothing to the value returned by -@code{append}. As a consequence of this, a final @code{nil} argument -forces a copy of the previous argument. - -@example -@group -trees - @result{} (pine oak) -@end group -@group -(setq wood (append trees ())) - @result{} (pine oak) -@end group -@group -wood - @result{} (pine oak) -@end group -@group -(eq wood trees) - @result{} nil -@end group -@end example - -@noindent -This once was the usual way to copy a list, before the function -@code{copy-sequence} was invented. @xref{Sequences Arrays Vectors}. - -With the help of @code{apply}, we can append all the lists in a list of -lists: - -@example -@group -(apply 'append '((a b c) nil (x y z) nil)) - @result{} (a b c x y z) -@end group -@end example - -If no @var{sequences} are given, @code{nil} is returned: - -@example -@group -(append) - @result{} nil -@end group -@end example - -Here are some examples where the final argument is not a list: - -@example -(append '(x y) 'z) - @result{} (x y . z) -(append '(x y) [z]) - @result{} (x y . [z]) -@end example - -@noindent -The second example shows that when the final argument is a sequence but -not a list, the sequence's elements do not become elements of the -resulting list. Instead, the sequence becomes the final @sc{cdr}, like -any other non-list final argument. - -The @code{append} function also allows integers as arguments. It -converts them to strings of digits, making up the decimal print -representation of the integer, and then uses the strings instead of the -original integers. @strong{Don't use this feature; we plan to eliminate -it. If you already use this feature, change your programs now!} The -proper way to convert an integer to a decimal number in this way is with -@code{format} (@pxref{Formatting Strings}) or @code{number-to-string} -(@pxref{String Conversion}). -@end defun - -@defun reverse list -This function creates a new list whose elements are the elements of -@var{list}, but in reverse order. The original argument @var{list} is -@emph{not} altered. - -@example -@group -(setq x '(1 2 3 4)) - @result{} (1 2 3 4) -@end group -@group -(reverse x) - @result{} (4 3 2 1) -x - @result{} (1 2 3 4) -@end group -@end example -@end defun - -@node Modifying Lists -@section Modifying Existing List Structure - - You can modify the @sc{car} and @sc{cdr} contents of a cons cell with the -primitives @code{setcar} and @code{setcdr}. - -@cindex CL note---@code{rplaca} vrs @code{setcar} -@quotation -@findex rplaca -@findex rplacd -@b{Common Lisp note:} Common Lisp uses functions @code{rplaca} and -@code{rplacd} to alter list structure; they change structure the same -way as @code{setcar} and @code{setcdr}, but the Common Lisp functions -return the cons cell while @code{setcar} and @code{setcdr} return the -new @sc{car} or @sc{cdr}. -@end quotation - -@menu -* Setcar:: Replacing an element in a list. -* Setcdr:: Replacing part of the list backbone. - This can be used to remove or add elements. -* Rearrangement:: Reordering the elements in a list; combining lists. -@end menu - -@node Setcar -@subsection Altering List Elements with @code{setcar} - - Changing the @sc{car} of a cons cell is done with @code{setcar}. When -used on a list, @code{setcar} replaces one element of a list with a -different element. - -@defun setcar cons object -This function stores @var{object} as the new @sc{car} of @var{cons}, -replacing its previous @sc{car}. It returns the value @var{object}. -For example: - -@example -@group -(setq x '(1 2)) - @result{} (1 2) -@end group -@group -(setcar x 4) - @result{} 4 -@end group -@group -x - @result{} (4 2) -@end group -@end example -@end defun - - When a cons cell is part of the shared structure of several lists, -storing a new @sc{car} into the cons changes one element of each of -these lists. Here is an example: - -@example -@group -;; @r{Create two lists that are partly shared.} -(setq x1 '(a b c)) - @result{} (a b c) -(setq x2 (cons 'z (cdr x1))) - @result{} (z b c) -@end group - -@group -;; @r{Replace the @sc{car} of a shared link.} -(setcar (cdr x1) 'foo) - @result{} foo -x1 ; @r{Both lists are changed.} - @result{} (a foo c) -x2 - @result{} (z foo c) -@end group - -@group -;; @r{Replace the @sc{car} of a link that is not shared.} -(setcar x1 'baz) - @result{} baz -x1 ; @r{Only one list is changed.} - @result{} (baz foo c) -x2 - @result{} (z foo c) -@end group -@end example - - Here is a graphical depiction of the shared structure of the two lists -in the variables @code{x1} and @code{x2}, showing why replacing @code{b} -changes them both: - -@example -@group - ___ ___ ___ ___ ___ ___ -x1---> |___|___|----> |___|___|--> |___|___|--> nil - | --> | | - | | | | - --> a | --> b --> c - | - ___ ___ | -x2--> |___|___|-- - | - | - --> z -@end group -@end example - - Here is an alternative form of box diagram, showing the same relationship: - -@example -@group -x1: - -------------- -------------- -------------- -| car | cdr | | car | cdr | | car | cdr | -| a | o------->| b | o------->| c | nil | -| | | -->| | | | | | - -------------- | -------------- -------------- - | -x2: | - -------------- | -| car | cdr | | -| z | o---- -| | | - -------------- -@end group -@end example - -@node Setcdr -@subsection Altering the CDR of a List - - The lowest-level primitive for modifying a @sc{cdr} is @code{setcdr}: - -@defun setcdr cons object -This function stores @var{object} as the new @sc{cdr} of @var{cons}, -replacing its previous @sc{cdr}. It returns the value @var{object}. -@end defun - - Here is an example of replacing the @sc{cdr} of a list with a -different list. All but the first element of the list are removed in -favor of a different sequence of elements. The first element is -unchanged, because it resides in the @sc{car} of the list, and is not -reached via the @sc{cdr}. - -@example -@group -(setq x '(1 2 3)) - @result{} (1 2 3) -@end group -@group -(setcdr x '(4)) - @result{} (4) -@end group -@group -x - @result{} (1 4) -@end group -@end example - - You can delete elements from the middle of a list by altering the -@sc{cdr}s of the cons cells in the list. For example, here we delete -the second element, @code{b}, from the list @code{(a b c)}, by changing -the @sc{cdr} of the first cell: - -@example -@group -(setq x1 '(a b c)) - @result{} (a b c) -(setcdr x1 (cdr (cdr x1))) - @result{} (c) -x1 - @result{} (a c) -@end group -@end example - -@need 4000 - Here is the result in box notation: - -@example -@group - -------------------- - | | - -------------- | -------------- | -------------- -| car | cdr | | | car | cdr | -->| car | cdr | -| a | o----- | b | o-------->| c | nil | -| | | | | | | | | - -------------- -------------- -------------- -@end group -@end example - -@noindent -The second cons cell, which previously held the element @code{b}, still -exists and its @sc{car} is still @code{b}, but it no longer forms part -of this list. - - It is equally easy to insert a new element by changing @sc{cdr}s: - -@example -@group -(setq x1 '(a b c)) - @result{} (a b c) -(setcdr x1 (cons 'd (cdr x1))) - @result{} (d b c) -x1 - @result{} (a d b c) -@end group -@end example - - Here is this result in box notation: - -@smallexample -@group - -------------- ------------- ------------- -| car | cdr | | car | cdr | | car | cdr | -| a | o | -->| b | o------->| c | nil | -| | | | | | | | | | | - --------- | -- | ------------- ------------- - | | - ----- -------- - | | - | --------------- | - | | car | cdr | | - -->| d | o------ - | | | - --------------- -@end group -@end smallexample - -@node Rearrangement -@subsection Functions that Rearrange Lists -@cindex rearrangement of lists -@cindex modification of lists - - Here are some functions that rearrange lists ``destructively'' by -modifying the @sc{cdr}s of their component cons cells. We call these -functions ``destructive'' because they chew up the original lists passed -to them as arguments, to produce a new list that is the returned value. - -@ifinfo - See @code{delq}, in @ref{Sets And Lists}, for another function -that modifies cons cells. -@end ifinfo -@iftex - The function @code{delq} in the following section is another example -of destructive list manipulation. -@end iftex - -@defun nconc &rest lists -@cindex concatenating lists -@cindex joining lists -This function returns a list containing all the elements of @var{lists}. -Unlike @code{append} (@pxref{Building Lists}), the @var{lists} are -@emph{not} copied. Instead, the last @sc{cdr} of each of the -@var{lists} is changed to refer to the following list. The last of the -@var{lists} is not altered. For example: - -@example -@group -(setq x '(1 2 3)) - @result{} (1 2 3) -@end group -@group -(nconc x '(4 5)) - @result{} (1 2 3 4 5) -@end group -@group -x - @result{} (1 2 3 4 5) -@end group -@end example - - Since the last argument of @code{nconc} is not itself modified, it is -reasonable to use a constant list, such as @code{'(4 5)}, as in the -above example. For the same reason, the last argument need not be a -list: - -@example -@group -(setq x '(1 2 3)) - @result{} (1 2 3) -@end group -@group -(nconc x 'z) - @result{} (1 2 3 . z) -@end group -@group -x - @result{} (1 2 3 . z) -@end group -@end example - -A common pitfall is to use a quoted constant list as a non-last -argument to @code{nconc}. If you do this, your program will change -each time you run it! Here is what happens: - -@smallexample -@group -(defun add-foo (x) ; @r{We want this function to add} - (nconc '(foo) x)) ; @r{@code{foo} to the front of its arg.} -@end group - -@group -(symbol-function 'add-foo) - @result{} (lambda (x) (nconc (quote (foo)) x)) -@end group - -@group -(setq xx (add-foo '(1 2))) ; @r{It seems to work.} - @result{} (foo 1 2) -@end group -@group -(setq xy (add-foo '(3 4))) ; @r{What happened?} - @result{} (foo 1 2 3 4) -@end group -@group -(eq xx xy) - @result{} t -@end group - -@group -(symbol-function 'add-foo) - @result{} (lambda (x) (nconc (quote (foo 1 2 3 4) x))) -@end group -@end smallexample -@end defun - -@defun nreverse list -@cindex reversing a list - This function reverses the order of the elements of @var{list}. -Unlike @code{reverse}, @code{nreverse} alters its argument by reversing -the @sc{cdr}s in the cons cells forming the list. The cons cell that -used to be the last one in @var{list} becomes the first cell of the -value. - - For example: - -@example -@group -(setq x '(1 2 3 4)) - @result{} (1 2 3 4) -@end group -@group -x - @result{} (1 2 3 4) -(nreverse x) - @result{} (4 3 2 1) -@end group -@group -;; @r{The cell that was first is now last.} -x - @result{} (1) -@end group -@end example - - To avoid confusion, we usually store the result of @code{nreverse} -back in the same variable which held the original list: - -@example -(setq x (nreverse x)) -@end example - - Here is the @code{nreverse} of our favorite example, @code{(a b c)}, -presented graphically: - -@smallexample -@group -@r{Original list head:} @r{Reversed list:} - ------------- ------------- ------------ -| car | cdr | | car | cdr | | car | cdr | -| a | nil |<-- | b | o |<-- | c | o | -| | | | | | | | | | | | | - ------------- | --------- | - | -------- | - - | | | | - ------------- ------------ -@end group -@end smallexample -@end defun - -@defun sort list predicate -@cindex stable sort -@cindex sorting lists -This function sorts @var{list} stably, though destructively, and -returns the sorted list. It compares elements using @var{predicate}. A -stable sort is one in which elements with equal sort keys maintain their -relative order before and after the sort. Stability is important when -successive sorts are used to order elements according to different -criteria. - -The argument @var{predicate} must be a function that accepts two -arguments. It is called with two elements of @var{list}. To get an -increasing order sort, the @var{predicate} should return @code{t} if the -first element is ``less than'' the second, or @code{nil} if not. - -The destructive aspect of @code{sort} is that it rearranges the cons -cells forming @var{list} by changing @sc{cdr}s. A nondestructive sort -function would create new cons cells to store the elements in their -sorted order. If you wish to make a sorted copy without destroying the -original, copy it first with @code{copy-sequence} and then sort. - -Sorting does not change the @sc{car}s of the cons cells in @var{list}; -the cons cell that originally contained the element @code{a} in -@var{list} still has @code{a} in its @sc{car} after sorting, but it now -appears in a different position in the list due to the change of -@sc{cdr}s. For example: - -@example -@group -(setq nums '(1 3 2 6 5 4 0)) - @result{} (1 3 2 6 5 4 0) -@end group -@group -(sort nums '<) - @result{} (0 1 2 3 4 5 6) -@end group -@group -nums - @result{} (1 2 3 4 5 6) -@end group -@end example - -@noindent -Note that the list in @code{nums} no longer contains 0; this is the same -cons cell that it was before, but it is no longer the first one in the -list. Don't assume a variable that formerly held the argument now holds -the entire sorted list! Instead, save the result of @code{sort} and use -that. Most often we store the result back into the variable that held -the original list: - -@example -(setq nums (sort nums '<)) -@end example - -@xref{Sorting}, for more functions that perform sorting. -See @code{documentation} in @ref{Accessing Documentation}, for a -useful example of @code{sort}. -@end defun - -@node Sets And Lists -@section Using Lists as Sets -@cindex lists as sets -@cindex sets - - A list can represent an unordered mathematical set---simply consider a -value an element of a set if it appears in the list, and ignore the -order of the list. To form the union of two sets, use @code{append} (as -long as you don't mind having duplicate elements). Other useful -functions for sets include @code{memq} and @code{delq}, and their -@code{equal} versions, @code{member} and @code{delete}. - -@cindex CL note---lack @code{union}, @code{set} -@quotation -@b{Common Lisp note:} Common Lisp has functions @code{union} (which -avoids duplicate elements) and @code{intersection} for set operations, -but XEmacs Lisp does not have them. You can write them in Lisp if -you wish. -@end quotation - -@defun memq object list -@cindex membership in a list -This function tests to see whether @var{object} is a member of -@var{list}. If it is, @code{memq} returns a list starting with the -first occurrence of @var{object}. Otherwise, it returns @code{nil}. -The letter @samp{q} in @code{memq} says that it uses @code{eq} to -compare @var{object} against the elements of the list. For example: - -@example -@group -(memq 'b '(a b c b a)) - @result{} (b c b a) -@end group -@group -(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.} - @result{} nil -@end group -@end example -@end defun - -@defun delq object list -@cindex deletion of elements -This function destructively removes all elements @code{eq} to -@var{object} from @var{list}. The letter @samp{q} in @code{delq} says -that it uses @code{eq} to compare @var{object} against the elements of -the list, like @code{memq}. -@end defun - -When @code{delq} deletes elements from the front of the list, it does so -simply by advancing down the list and returning a sublist that starts -after those elements: - -@example -@group -(delq 'a '(a b c)) @equiv{} (cdr '(a b c)) -@end group -@end example - -When an element to be deleted appears in the middle of the list, -removing it involves changing the @sc{cdr}s (@pxref{Setcdr}). - -@example -@group -(setq sample-list '(a b c (4))) - @result{} (a b c (4)) -@end group -@group -(delq 'a sample-list) - @result{} (b c (4)) -@end group -@group -sample-list - @result{} (a b c (4)) -@end group -@group -(delq 'c sample-list) - @result{} (a b (4)) -@end group -@group -sample-list - @result{} (a b (4)) -@end group -@end example - -Note that @code{(delq 'c sample-list)} modifies @code{sample-list} to -splice out the third element, but @code{(delq 'a sample-list)} does not -splice anything---it just returns a shorter list. Don't assume that a -variable which formerly held the argument @var{list} now has fewer -elements, or that it still holds the original list! Instead, save the -result of @code{delq} and use that. Most often we store the result back -into the variable that held the original list: - -@example -(setq flowers (delq 'rose flowers)) -@end example - -In the following example, the @code{(4)} that @code{delq} attempts to match -and the @code{(4)} in the @code{sample-list} are not @code{eq}: - -@example -@group -(delq '(4) sample-list) - @result{} (a c (4)) -@end group -@end example - -The following two functions are like @code{memq} and @code{delq} but use -@code{equal} rather than @code{eq} to compare elements. They are new in -Emacs 19. - -@defun member object list -The function @code{member} tests to see whether @var{object} is a member -of @var{list}, comparing members with @var{object} using @code{equal}. -If @var{object} is a member, @code{member} returns a list starting with -its first occurrence in @var{list}. Otherwise, it returns @code{nil}. - -Compare this with @code{memq}: - -@example -@group -(member '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are @code{equal}.} - @result{} ((2)) -@end group -@group -(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.} - @result{} nil -@end group -@group -;; @r{Two strings with the same contents are @code{equal}.} -(member "foo" '("foo" "bar")) - @result{} ("foo" "bar") -@end group -@end example -@end defun - -@defun delete object list -This function destructively removes all elements @code{equal} to -@var{object} from @var{list}. It is to @code{delq} as @code{member} is -to @code{memq}: it uses @code{equal} to compare elements with -@var{object}, like @code{member}; when it finds an element that matches, -it removes the element just as @code{delq} would. For example: - -@example -@group -(delete '(2) '((2) (1) (2))) - @result{} '((1)) -@end group -@end example -@end defun - -@quotation -@b{Common Lisp note:} The functions @code{member} and @code{delete} in -XEmacs Lisp are derived from Maclisp, not Common Lisp. The Common -Lisp versions do not use @code{equal} to compare elements. -@end quotation - - See also the function @code{add-to-list}, in @ref{Setting Variables}, -for another way to add an element to a list stored in a variable. - -@node Association Lists -@section Association Lists -@cindex association list -@cindex alist - - An @dfn{association list}, or @dfn{alist} for short, records a mapping -from keys to values. It is a list of cons cells called -@dfn{associations}: the @sc{car} of each cell is the @dfn{key}, and the -@sc{cdr} is the @dfn{associated value}.@footnote{This usage of ``key'' -is not related to the term ``key sequence''; it means a value used to -look up an item in a table. In this case, the table is the alist, and -the alist associations are the items.} - - Here is an example of an alist. The key @code{pine} is associated with -the value @code{cones}; the key @code{oak} is associated with -@code{acorns}; and the key @code{maple} is associated with @code{seeds}. - -@example -@group -'((pine . cones) - (oak . acorns) - (maple . seeds)) -@end group -@end example - - The associated values in an alist may be any Lisp objects; so may the -keys. For example, in the following alist, the symbol @code{a} is -associated with the number @code{1}, and the string @code{"b"} is -associated with the @emph{list} @code{(2 3)}, which is the @sc{cdr} of -the alist element: - -@example -((a . 1) ("b" 2 3)) -@end example - - Sometimes it is better to design an alist to store the associated -value in the @sc{car} of the @sc{cdr} of the element. Here is an -example: - -@example -'((rose red) (lily white) (buttercup yellow)) -@end example - -@noindent -Here we regard @code{red} as the value associated with @code{rose}. One -advantage of this method is that you can store other related -information---even a list of other items---in the @sc{cdr} of the -@sc{cdr}. One disadvantage is that you cannot use @code{rassq} (see -below) to find the element containing a given value. When neither of -these considerations is important, the choice is a matter of taste, as -long as you are consistent about it for any given alist. - - Note that the same alist shown above could be regarded as having the -associated value in the @sc{cdr} of the element; the value associated -with @code{rose} would be the list @code{(red)}. - - Association lists are often used to record information that you might -otherwise keep on a stack, since new associations may be added easily to -the front of the list. When searching an association list for an -association with a given key, the first one found is returned, if there -is more than one. - - In XEmacs Lisp, it is @emph{not} an error if an element of an -association list is not a cons cell. The alist search functions simply -ignore such elements. Many other versions of Lisp signal errors in such -cases. - - Note that property lists are similar to association lists in several -respects. A property list behaves like an association list in which -each key can occur only once. @xref{Property Lists}, for a comparison -of property lists and association lists. - -@defun assoc key alist -This function returns the first association for @var{key} in -@var{alist}. It compares @var{key} against the alist elements using -@code{equal} (@pxref{Equality Predicates}). It returns @code{nil} if no -association in @var{alist} has a @sc{car} @code{equal} to @var{key}. -For example: - -@smallexample -(setq trees '((pine . cones) (oak . acorns) (maple . seeds))) - @result{} ((pine . cones) (oak . acorns) (maple . seeds)) -(assoc 'oak trees) - @result{} (oak . acorns) -(cdr (assoc 'oak trees)) - @result{} acorns -(assoc 'birch trees) - @result{} nil -@end smallexample - -Here is another example, in which the keys and values are not symbols: - -@smallexample -(setq needles-per-cluster - '((2 "Austrian Pine" "Red Pine") - (3 "Pitch Pine") - (5 "White Pine"))) - -(cdr (assoc 3 needles-per-cluster)) - @result{} ("Pitch Pine") -(cdr (assoc 2 needles-per-cluster)) - @result{} ("Austrian Pine" "Red Pine") -@end smallexample -@end defun - -@defun rassoc value alist -This function returns the first association with value @var{value} in -@var{alist}. It returns @code{nil} if no association in @var{alist} has -a @sc{cdr} @code{equal} to @var{value}. - -@code{rassoc} is like @code{assoc} except that it compares the @sc{cdr} of -each @var{alist} association instead of the @sc{car}. You can think of -this as ``reverse @code{assoc}'', finding the key for a given value. -@end defun - -@defun assq key alist -This function is like @code{assoc} in that it returns the first -association for @var{key} in @var{alist}, but it makes the comparison -using @code{eq} instead of @code{equal}. @code{assq} returns @code{nil} -if no association in @var{alist} has a @sc{car} @code{eq} to @var{key}. -This function is used more often than @code{assoc}, since @code{eq} is -faster than @code{equal} and most alists use symbols as keys. -@xref{Equality Predicates}. - -@smallexample -(setq trees '((pine . cones) (oak . acorns) (maple . seeds))) - @result{} ((pine . cones) (oak . acorns) (maple . seeds)) -(assq 'pine trees) - @result{} (pine . cones) -@end smallexample - -On the other hand, @code{assq} is not usually useful in alists where the -keys may not be symbols: - -@smallexample -(setq leaves - '(("simple leaves" . oak) - ("compound leaves" . horsechestnut))) - -(assq "simple leaves" leaves) - @result{} nil -(assoc "simple leaves" leaves) - @result{} ("simple leaves" . oak) -@end smallexample -@end defun - -@defun rassq value alist -This function returns the first association with value @var{value} in -@var{alist}. It returns @code{nil} if no association in @var{alist} has -a @sc{cdr} @code{eq} to @var{value}. - -@code{rassq} is like @code{assq} except that it compares the @sc{cdr} of -each @var{alist} association instead of the @sc{car}. You can think of -this as ``reverse @code{assq}'', finding the key for a given value. - -For example: - -@smallexample -(setq trees '((pine . cones) (oak . acorns) (maple . seeds))) - -(rassq 'acorns trees) - @result{} (oak . acorns) -(rassq 'spores trees) - @result{} nil -@end smallexample - -Note that @code{rassq} cannot search for a value stored in the @sc{car} -of the @sc{cdr} of an element: - -@smallexample -(setq colors '((rose red) (lily white) (buttercup yellow))) - -(rassq 'white colors) - @result{} nil -@end smallexample - -In this case, the @sc{cdr} of the association @code{(lily white)} is not -the symbol @code{white}, but rather the list @code{(white)}. This -becomes clearer if the association is written in dotted pair notation: - -@smallexample -(lily white) @equiv{} (lily . (white)) -@end smallexample -@end defun - -@defun remassoc key alist -This function deletes by side effect any associations with key @var{key} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose -@code{car} is @code{equal} to @var{key}. The modified @var{alist} is -returned. - -If the first member of @var{alist} has a @code{car} that is @code{equal} -to @var{key}, there is no way to remove it by side effect; therefore, -write @code{(setq foo (remassoc key foo))} to be sure of changing the -value of @code{foo}. -@end defun - -@defun remassq key alist -This function deletes by side effect any associations with key @var{key} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose -@code{car} is @code{eq} to @var{key}. The modified @var{alist} is -returned. - -This function is exactly like @code{remassoc}, but comparisons between -@var{key} and keys in @var{alist} are done using @code{eq} instead of -@code{equal}. -@end defun - -@defun remrassoc value alist -This function deletes by side effect any associations with value @var{value} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose -@code{cdr} is @code{equal} to @var{value}. The modified @var{alist} is -returned. - -If the first member of @var{alist} has a @code{car} that is @code{equal} -to @var{value}, there is no way to remove it by side effect; therefore, -write @code{(setq foo (remassoc value foo))} to be sure of changing the -value of @code{foo}. - -@code{remrassoc} is like @code{remassoc} except that it compares the -@sc{cdr} of each @var{alist} association instead of the @sc{car}. You -can think of this as ``reverse @code{remassoc}'', removing an association -based on its value instead of its key. -@end defun - -@defun remrassq value alist -This function deletes by side effect any associations with value @var{value} -in @var{alist} -- i.e. it removes any elements from @var{alist} whose -@code{cdr} is @code{eq} to @var{value}. The modified @var{alist} is -returned. - -This function is exactly like @code{remrassoc}, but comparisons between -@var{value} and values in @var{alist} are done using @code{eq} instead of -@code{equal}. -@end defun - -@defun copy-alist alist -@cindex copying alists -This function returns a two-level deep copy of @var{alist}: it creates a -new copy of each association, so that you can alter the associations of -the new alist without changing the old one. - -@smallexample -@group -(setq needles-per-cluster - '((2 . ("Austrian Pine" "Red Pine")) - (3 . ("Pitch Pine")) -@end group - (5 . ("White Pine")))) -@result{} -((2 "Austrian Pine" "Red Pine") - (3 "Pitch Pine") - (5 "White Pine")) - -(setq copy (copy-alist needles-per-cluster)) -@result{} -((2 "Austrian Pine" "Red Pine") - (3 "Pitch Pine") - (5 "White Pine")) - -(eq needles-per-cluster copy) - @result{} nil -(equal needles-per-cluster copy) - @result{} t -(eq (car needles-per-cluster) (car copy)) - @result{} nil -(cdr (car (cdr needles-per-cluster))) - @result{} ("Pitch Pine") -@group -(eq (cdr (car (cdr needles-per-cluster))) - (cdr (car (cdr copy)))) - @result{} t -@end group -@end smallexample - - This example shows how @code{copy-alist} makes it possible to change -the associations of one copy without affecting the other: - -@smallexample -@group -(setcdr (assq 3 copy) '("Martian Vacuum Pine")) -(cdr (assq 3 needles-per-cluster)) - @result{} ("Pitch Pine") -@end group -@end smallexample -@end defun - -@node Property Lists -@section Property Lists -@cindex property list -@cindex plist - -A @dfn{property list} (or @dfn{plist}) is another way of representing a -mapping from keys to values. Instead of the list consisting of conses -of a key and a value, the keys and values alternate as successive -entries in the list. Thus, the association list - -@example -((a . 1) (b . 2) (c . 3)) -@end example - -has the equivalent property list form - -@example -(a 1 b 2 c 3) -@end example - -Property lists are used to represent the properties associated with -various sorts of objects, such as symbols, strings, frames, etc. -The convention is that property lists can be modified in-place, -while association lists generally are not. - -Plists come in two varieties: @dfn{normal} plists, whose keys are -compared with @code{eq}, and @dfn{lax} plists, whose keys are compared -with @code{equal}, - -@defun valid-plist-p plist -Given a plist, this function returns non-@code{nil} if its format is -correct. If it returns @code{nil}, @code{check-valid-plist} will signal -an error when given the plist; that means it's a malformed or circular -plist or has non-symbols as keywords. -@end defun - -@defun check-valid-plist plist -Given a plist, this function signals an error if there is anything wrong -with it. This means that it's a malformed or circular plist. -@end defun - -@menu -* Working With Normal Plists:: Functions for normal plists. -* Working With Lax Plists:: Functions for lax plists. -* Converting Plists To/From Alists:: Alist to plist and vice-versa. -@end menu - -@node Working With Normal Plists -@subsection Working With Normal Plists - -@defun plist-get plist prop &optional default -This function extracts a value from a property list. The function -returns the value corresponding to the given @var{prop}, or -@var{default} if @var{prop} is not one of the properties on the list. -@end defun - -@defun plist-put plist prop val -This function changes the value in @var{plist} of @var{prop} to -@var{val}. If @var{prop} is already a property on the list, its value is -set to @var{val}, otherwise the new @var{prop} @var{val} pair is added. -The new plist is returned; use @code{(setq x (plist-put x prop val))} to -be sure to use the new value. The @var{plist} is modified by side -effects. -@end defun - -@defun plist-remprop plist prop -This function removes from @var{plist} the property @var{prop} and its -value. The new plist is returned; use @code{(setq x (plist-remprop x -prop val))} to be sure to use the new value. The @var{plist} is -modified by side effects. -@end defun - -@defun plist-member plist prop -This function returns @code{t} if @var{prop} has a value specified in -@var{plist}. -@end defun - -In the following functions, if optional arg @var{nil-means-not-present} -is non-@code{nil}, then a property with a @code{nil} value is ignored or -removed. This feature is a virus that has infected old Lisp -implementations (and thus E-Lisp, due to @sc{RMS}'s enamorment with old -Lisps), but should not be used except for backward compatibility. - -@defun plists-eq a b &optional nil-means-not-present -This function returns non-@code{nil} if property lists A and B are -@code{eq} (i.e. their values are @code{eq}). -@end defun - -@defun plists-equal a b &optional nil-means-not-present -This function returns non-@code{nil} if property lists A and B are -@code{equal} (i.e. their values are @code{equal}; their keys are -still compared using @code{eq}). -@end defun - -@defun canonicalize-plist plist &optional nil-means-not-present -This function destructively removes any duplicate entries from a plist. -In such cases, the first entry applies. - -The new plist is returned. If @var{nil-means-not-present} is given, the -return value may not be @code{eq} to the passed-in value, so make sure -to @code{setq} the value back into where it came from. -@end defun - -@node Working With Lax Plists -@subsection Working With Lax Plists - -Recall that a @dfn{lax plist} is a property list whose keys are compared -using @code{equal} instead of @code{eq}. - -@defun lax-plist-get lax-plist prop &optional default -This function extracts a value from a lax property list. The function -returns the value corresponding to the given @var{prop}, or -@var{default} if @var{prop} is not one of the properties on the list. -@end defun - -@defun lax-plist-put lax-plist prop val -This function changes the value in @var{lax-plist} of @var{prop} to @var{val}. -@end defun - -@defun lax-plist-remprop lax-plist prop -This function removes from @var{lax-plist} the property @var{prop} and -its value. The new plist is returned; use @code{(setq x -(lax-plist-remprop x prop val))} to be sure to use the new value. The -@var{lax-plist} is modified by side effects. -@end defun - -@defun lax-plist-member lax-plist prop -This function returns @code{t} if @var{prop} has a value specified in -@var{lax-plist}. -@end defun - -In the following functions, if optional arg @var{nil-means-not-present} -is non-@code{nil}, then a property with a @code{nil} value is ignored or -removed. This feature is a virus that has infected old Lisp -implementations (and thus E-Lisp, due to @sc{RMS}'s enamorment with old -Lisps), but should not be used except for backward compatibility. - -@defun lax-plists-eq a b &optional nil-means-not-present -This function returns non-@code{nil} if lax property lists A and B are -@code{eq} (i.e. their values are @code{eq}; their keys are still -compared using @code{equal}). -@end defun - -@defun lax-plists-equal a b &optional nil-means-not-present -This function returns non-@code{nil} if lax property lists A and B are -@code{equal} (i.e. their values are @code{equal}). -@end defun - -@defun canonicalize-lax-plist lax-plist &optional nil-means-not-present -This function destructively removes any duplicate entries from a lax -plist. In such cases, the first entry applies. - -The new plist is returned. If @var{nil-means-not-present} is given, the -return value may not be @code{eq} to the passed-in value, so make sure -to @code{setq} the value back into where it came from. -@end defun - -@node Converting Plists To/From Alists -@subsection Converting Plists To/From Alists - -@defun alist-to-plist alist -This function converts association list @var{alist} into the equivalent -property-list form. The plist is returned. This converts from - -@example -((a . 1) (b . 2) (c . 3)) -@end example - -into - -@example -(a 1 b 2 c 3) -@end example - -The original alist is not modified. -@end defun - -@defun plist-to-alist plist -This function converts property list @var{plist} into the equivalent -association-list form. The alist is returned. This converts from - -@example -(a 1 b 2 c 3) -@end example - -into - -@example -((a . 1) (b . 2) (c . 3)) -@end example - -The original plist is not modified. -@end defun - -The following two functions are equivalent to the preceding two except -that they destructively modify their arguments, using cons cells from -the original list to form the new list rather than allocating new -cons cells. - -@defun destructive-alist-to-plist alist -This function destructively converts association list @var{alist} into -the equivalent property-list form. The plist is returned. -@end defun - -@defun destructive-plist-to-alist plist -This function destructively converts property list @var{plist} into the -equivalent association-list form. The alist is returned. -@end defun - -@node Weak Lists -@section Weak Lists -@cindex weak list - -A @dfn{weak list} is a special sort of list whose members are not counted -as references for the purpose of garbage collection. This means that, -for any object in the list, if there are no references to the object -anywhere outside of the list (or other weak list or weak hash table), -that object will disappear the next time a garbage collection happens. -Weak lists can be useful for keeping track of things such as unobtrusive -lists of another function's buffers or markers. When that function is -done with the elements, they will automatically disappear from the list. - -Weak lists are used internally, for example, to manage the list holding -the children of an extent -- an extent that is unused but has a parent -will still be reclaimed, and will automatically be removed from its -parent's list of children. - -Weak lists are similar to weak hash tables (@pxref{Weak Hash Tables}). - -@defun weak-list-p object -This function returns non-@code{nil} if @var{object} is a weak list. -@end defun - -Weak lists come in one of four types: - -@table @code -@item simple -Objects in the list disappear if not referenced outside of the list. - -@item assoc -Objects in the list disappear if they are conses and either the car or -the cdr of the cons is not referenced outside of the list. - -@item key-assoc -Objects in the list disappear if they are conses and the car is not -referenced outside of the list. - -@item value-assoc -Objects in the list disappear if they are conses and the cdr is not -referenced outside of the list. -@end table - -@defun make-weak-list &optional type -This function creates a new weak list of type @var{type}. @var{type} is -a symbol (one of @code{simple}, @code{assoc}, @code{key-assoc}, or -@code{value-assoc}, as described above) and defaults to @code{simple}. -@end defun - -@defun weak-list-type weak -This function returns the type of the given weak-list object. -@end defun - -@defun weak-list-list weak -This function returns the list contained in a weak-list object. -@end defun - -@defun set-weak-list-list weak new-list -This function changes the list contained in a weak-list object. -@end defun diff --git a/man/lispref/loading.texi b/man/lispref/loading.texi deleted file mode 100644 index c8fc6b4..0000000 --- a/man/lispref/loading.texi +++ /dev/null @@ -1,779 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/loading.info -@node Loading, Byte Compilation, Macros, Top -@chapter Loading -@cindex loading -@cindex library -@cindex Lisp library - - Loading a file of Lisp code means bringing its contents into the Lisp -environment in the form of Lisp objects. XEmacs finds and opens the -file, reads the text, evaluates each form, and then closes the file. - - The load functions evaluate all the expressions in a file just -as the @code{eval-current-buffer} function evaluates all the -expressions in a buffer. The difference is that the load functions -read and evaluate the text in the file as found on disk, not the text -in an Emacs buffer. - -@cindex top-level form - The loaded file must contain Lisp expressions, either as source code -or as byte-compiled code. Each form in the file is called a -@dfn{top-level form}. There is no special format for the forms in a -loadable file; any form in a file may equally well be typed directly -into a buffer and evaluated there. (Indeed, most code is tested this -way.) Most often, the forms are function definitions and variable -definitions. - - A file containing Lisp code is often called a @dfn{library}. Thus, -the ``Rmail library'' is a file containing code for Rmail mode. -Similarly, a ``Lisp library directory'' is a directory of files -containing Lisp code. - -@menu -* How Programs Do Loading:: The @code{load} function and others. -* Autoload:: Setting up a function to autoload. -* Repeated Loading:: Precautions about loading a file twice. -* Named Features:: Loading a library if it isn't already loaded. -* Unloading:: How to ``unload'' a library that was loaded. -* Hooks for Loading:: Providing code to be run when - particular libraries are loaded. -@end menu - -@node How Programs Do Loading -@section How Programs Do Loading - - XEmacs Lisp has several interfaces for loading. For example, -@code{autoload} creates a placeholder object for a function in a file; -trying to call the autoloading function loads the file to get the -function's real definition (@pxref{Autoload}). @code{require} loads a -file if it isn't already loaded (@pxref{Named Features}). Ultimately, all -these facilities call the @code{load} function to do the work. - -@defun load filename &optional missing-ok nomessage nosuffix -This function finds and opens a file of Lisp code, evaluates all the -forms in it, and closes the file. - -To find the file, @code{load} first looks for a file named -@file{@var{filename}.elc}, that is, for a file whose name is -@var{filename} with @samp{.elc} appended. If such a file exists, it is -loaded. If there is no file by that name, then @code{load} looks for a -file named @file{@var{filename}.el}. If that file exists, it is loaded. -Finally, if neither of those names is found, @code{load} looks for a -file named @var{filename} with nothing appended, and loads it if it -exists. (The @code{load} function is not clever about looking at -@var{filename}. In the perverse case of a file named @file{foo.el.el}, -evaluation of @code{(load "foo.el")} will indeed find it.) - -If the optional argument @var{nosuffix} is non-@code{nil}, then the -suffixes @samp{.elc} and @samp{.el} are not tried. In this case, you -must specify the precise file name you want. - -If @var{filename} is a relative file name, such as @file{foo} or -@file{baz/foo.bar}, @code{load} searches for the file using the variable -@code{load-path}. It appends @var{filename} to each of the directories -listed in @code{load-path}, and loads the first file it finds whose name -matches. The current default directory is tried only if it is specified -in @code{load-path}, where @code{nil} stands for the default directory. -@code{load} tries all three possible suffixes in the first directory in -@code{load-path}, then all three suffixes in the second directory, and -so on. - -If you get a warning that @file{foo.elc} is older than @file{foo.el}, it -means you should consider recompiling @file{foo.el}. @xref{Byte -Compilation}. - -Messages like @samp{Loading foo...} and @samp{Loading foo...done} appear -in the echo area during loading unless @var{nomessage} is -non-@code{nil}. - -@cindex load errors -Any unhandled errors while loading a file terminate loading. If the -load was done for the sake of @code{autoload}, any function definitions -made during the loading are undone. - -@kindex file-error -If @code{load} can't find the file to load, then normally it signals the -error @code{file-error} (with @samp{Cannot open load file -@var{filename}}). But if @var{missing-ok} is non-@code{nil}, then -@code{load} just returns @code{nil}. - -You can use the variable @code{load-read-function} to specify a function -for @code{load} to use instead of @code{read} for reading expressions. -See below. - -@code{load} returns @code{t} if the file loads successfully. -@end defun - -@ignore -@deffn Command load-file filename -This function loads the file @var{filename}. If @var{filename} is an -absolute file name, then it is loaded. If it is relative, then the -current default directory is assumed. @code{load-path} is not used, and -suffixes are not appended. Use this function if you wish to specify -the file to be loaded exactly. -@end deffn - -@deffn Command load-library library -This function loads the library named @var{library}. A library is -nothing more than a file that may be loaded as described earlier. This -function is identical to @code{load}, save that it reads a file name -interactively with completion. -@end deffn -@end ignore - -@defopt load-path -@cindex @code{EMACSLOADPATH} environment variable -The value of this variable is a list of directories to search when -loading files with @code{load}. Each element is a string (which must be -a directory name) or @code{nil} (which stands for the current working -directory). The value of @code{load-path} is initialized from the -environment variable @code{EMACSLOADPATH}, if that exists; otherwise its -default value is specified in @file{emacs/src/paths.h} when XEmacs is -built. - -The syntax of @code{EMACSLOADPATH} is the same as used for @code{PATH}; -@samp{:} (or @samp{;}, according to the operating system) separates -directory names, and @samp{.} is used for the current default directory. -Here is an example of how to set your @code{EMACSLOADPATH} variable from -a @code{csh} @file{.login} file: - -@c This overfull hbox is OK. --rjc 16mar92 -@smallexample -setenv EMACSLOADPATH .:/user/bil/emacs:/usr/lib/emacs/lisp -@end smallexample - -Here is how to set it using @code{sh}: - -@smallexample -export EMACSLOADPATH -EMACSLOADPATH=.:/user/bil/emacs:/usr/local/lib/emacs/lisp -@end smallexample - -Here is an example of code you can place in a @file{.emacs} file to add -several directories to the front of your default @code{load-path}: - -@smallexample -@group -(setq load-path - (append (list nil "/user/bil/emacs" - "/usr/local/lisplib" - "~/emacs") - load-path)) -@end group -@end smallexample - -@c Wordy to rid us of an overfull hbox. --rjc 15mar92 -@noindent -In this example, the path searches the current working directory first, -followed then by the @file{/user/bil/emacs} directory, the -@file{/usr/local/lisplib} directory, and the @file{~/emacs} directory, -which are then followed by the standard directories for Lisp code. - -The command line options @samp{-l} or @samp{-load} specify a Lisp -library to load as part of Emacs startup. Since this file might be in -the current directory, Emacs 18 temporarily adds the current directory -to the front of @code{load-path} so the file can be found there. Newer -Emacs versions also find such files in the current directory, but -without altering @code{load-path}. - -Dumping Emacs uses a special value of @code{load-path}. If the value of -@code{load-path} at the end of dumping is unchanged (that is, still the -same special value), the dumped Emacs switches to the ordinary -@code{load-path} value when it starts up, as described above. But if -@code{load-path} has any other value at the end of dumping, that value -is used for execution of the dumped Emacs also. - -Therefore, if you want to change @code{load-path} temporarily for -loading a few libraries in @file{site-init.el} or @file{site-load.el}, -you should bind @code{load-path} locally with @code{let} around the -calls to @code{load}. -@end defopt - -@defun locate-file filename path-list &optional suffixes mode -This function searches for a file in the same way that @code{load} does, -and returns the file found (if any). (In fact, @code{load} uses this -function to search through @code{load-path}.) It searches for -@var{filename} through @var{path-list}, expanded by one of the optional -@var{suffixes} (string of suffixes separated by @samp{:}s), checking for -access @var{mode} (0|1|2|4 = exists|executable|writeable|readable), -default readable. - -@code{locate-file} keeps hash tables of the directories it searches -through, in order to speed things up. It tries valiantly to not get -confused in the face of a changing and unpredictable environment, but -can occasionally get tripped up. In this case, you will have to call -@code{locate-file-clear-hashing} to get it back on track. See that -function for details. -@end defun - -@defun locate-file-clear-hashing path -This function clears the hash records for the specified list of -directories. @code{locate-file} uses a hashing scheme to speed lookup, and -will correctly track the following environmental changes: - -@itemize @bullet -@item -changes of any sort to the list of directories to be searched. -@item -addition and deletion of non-shadowing files (see below) from the -directories in the list. -@item -byte-compilation of a .el file into a .elc file. -@end itemize - -@code{locate-file} will primarily get confused if you add a file that -shadows (i.e. has the same name as) another file further down in the -directory list. In this case, you must call -@code{locate-file-clear-hashing}. -@end defun - -@defvar load-in-progress -This variable is non-@code{nil} if Emacs is in the process of loading a -file, and it is @code{nil} otherwise. -@end defvar - -@defvar load-read-function -This variable specifies an alternate expression-reading function for -@code{load} and @code{eval-region} to use instead of @code{read}. -The function should accept one argument, just as @code{read} does. - -Normally, the variable's value is @code{nil}, which means those -functions should use @code{read}. -@end defvar - -@defopt load-warn-when-source-newer -This variable specifies whether @code{load} should check whether the -source is newer than the binary. If this variable is true, then when a -@samp{.elc} file is being loaded and the corresponding @samp{.el} is -newer, a warning message will be printed. The default is @code{nil}, -but it is bound to @code{t} during the initial loadup. -@end defopt - -@defopt load-warn-when-source-only -This variable specifies whether @code{load} should warn when loading a -@samp{.el} file instead of an @samp{.elc}. If this variable is true, -then when @code{load} is called with a filename without an extension, -and the @samp{.elc} version doesn't exist but the @samp{.el} version -does, then a message will be printed. If an explicit extension is -passed to @code{load}, no warning will be printed. The default is -@code{nil}, but it is bound to @code{t} during the initial loadup. -@end defopt - -@defopt load-ignore-elc-files -This variable specifies whether @code{load} should ignore @samp{.elc} -files when a suffix is not given. This is normally used only to -bootstrap the @samp{.elc} files when building XEmacs, when you use the -command @samp{make all-elc}. (This forces the @samp{.el} versions to be -loaded in the process of compiling those same files, so that existing -out-of-date @samp{.elc} files do not make it mess things up.) -@end defopt - - To learn how @code{load} is used to build XEmacs, see @ref{Building XEmacs}. - -@node Autoload -@section Autoload -@cindex autoload - - The @dfn{autoload} facility allows you to make a function or macro -known in Lisp, but put off loading the file that defines it. The first -call to the function automatically reads the proper file to install the -real definition and other associated code, then runs the real definition -as if it had been loaded all along. - - There are two ways to set up an autoloaded function: by calling -@code{autoload}, and by writing a special ``magic'' comment in the -source before the real definition. @code{autoload} is the low-level -primitive for autoloading; any Lisp program can call @code{autoload} at -any time. Magic comments do nothing on their own; they serve as a guide -for the command @code{update-file-autoloads}, which constructs calls to -@code{autoload} and arranges to execute them when Emacs is built. Magic -comments are the most convenient way to make a function autoload, but -only for packages installed along with Emacs. - -@defun autoload function filename &optional docstring interactive type -This function defines the function (or macro) named @var{function} so as -to load automatically from @var{filename}. The string @var{filename} -specifies the file to load to get the real definition of @var{function}. - -The argument @var{docstring} is the documentation string for the -function. Normally, this is the identical to the documentation string -in the function definition itself. Specifying the documentation string -in the call to @code{autoload} makes it possible to look at the -documentation without loading the function's real definition. - -If @var{interactive} is non-@code{nil}, then the function can be called -interactively. This lets completion in @kbd{M-x} work without loading -the function's real definition. The complete interactive specification -need not be given here; it's not needed unless the user actually calls -@var{function}, and when that happens, it's time to load the real -definition. - -You can autoload macros and keymaps as well as ordinary functions. -Specify @var{type} as @code{macro} if @var{function} is really a macro. -Specify @var{type} as @code{keymap} if @var{function} is really a -keymap. Various parts of Emacs need to know this information without -loading the real definition. - -An autoloaded keymap loads automatically during key lookup when a prefix -key's binding is the symbol @var{function}. Autoloading does not occur -for other kinds of access to the keymap. In particular, it does not -happen when a Lisp program gets the keymap from the value of a variable -and calls @code{define-key}; not even if the variable name is the same -symbol @var{function}. - -@cindex function cell in autoload -If @var{function} already has a non-void function definition that is not -an autoload object, @code{autoload} does nothing and returns @code{nil}. -If the function cell of @var{function} is void, or is already an autoload -object, then it is defined as an autoload object like this: - -@example -(autoload @var{filename} @var{docstring} @var{interactive} @var{type}) -@end example - -For example, - -@example -@group -(symbol-function 'run-prolog) - @result{} (autoload "prolog" 169681 t nil) -@end group -@end example - -@noindent -In this case, @code{"prolog"} is the name of the file to load, 169681 -refers to the documentation string in the @file{DOC} file -(@pxref{Documentation Basics}), @code{t} means the function is -interactive, and @code{nil} that it is not a macro or a keymap. -@end defun - -@cindex autoload errors - The autoloaded file usually contains other definitions and may require -or provide one or more features. If the file is not completely loaded -(due to an error in the evaluation of its contents), any function -definitions or @code{provide} calls that occurred during the load are -undone. This is to ensure that the next attempt to call any function -autoloading from this file will try again to load the file. If not for -this, then some of the functions in the file might appear defined, but -they might fail to work properly for the lack of certain subroutines -defined later in the file and not loaded successfully. - - XEmacs as distributed comes with many autoloaded functions. -The calls to @code{autoload} are in the file @file{loaddefs.el}. -There is a convenient way of updating them automatically. - - If the autoloaded file fails to define the desired Lisp function or -macro, then an error is signaled with data @code{"Autoloading failed to -define function @var{function-name}"}. - -@findex update-file-autoloads -@findex update-directory-autoloads - A magic autoload comment looks like @samp{;;;###autoload}, on a line -by itself, just before the real definition of the function in its -autoloadable source file. The command @kbd{M-x update-file-autoloads} -writes a corresponding @code{autoload} call into @file{loaddefs.el}. -Building Emacs loads @file{loaddefs.el} and thus calls @code{autoload}. -@kbd{M-x update-directory-autoloads} is even more powerful; it updates -autoloads for all files in the current directory. - - The same magic comment can copy any kind of form into -@file{loaddefs.el}. If the form following the magic comment is not a -function definition, it is copied verbatim. You can also use a magic -comment to execute a form at build time @emph{without} executing it when -the file itself is loaded. To do this, write the form @dfn{on the same -line} as the magic comment. Since it is in a comment, it does nothing -when you load the source file; but @code{update-file-autoloads} copies -it to @file{loaddefs.el}, where it is executed while building Emacs. - - The following example shows how @code{doctor} is prepared for -autoloading with a magic comment: - -@smallexample -;;;###autoload -(defun doctor () - "Switch to *doctor* buffer and start giving psychotherapy." - (interactive) - (switch-to-buffer "*doctor*") - (doctor-mode)) -@end smallexample - -@noindent -Here's what that produces in @file{loaddefs.el}: - -@smallexample -(autoload 'doctor "doctor" - "\ -Switch to *doctor* buffer and start giving psychotherapy." - t) -@end smallexample - -@noindent -The backslash and newline immediately following the double-quote are a -convention used only in the preloaded Lisp files such as -@file{loaddefs.el}; they tell @code{make-docfile} to put the -documentation string in the @file{DOC} file. @xref{Building XEmacs}. - -@node Repeated Loading -@section Repeated Loading -@cindex repeated loading - - You may load one file more than once in an Emacs session. For -example, after you have rewritten and reinstalled a function definition -by editing it in a buffer, you may wish to return to the original -version; you can do this by reloading the file it came from. - - When you load or reload files, bear in mind that the @code{load} and -@code{load-library} functions automatically load a byte-compiled file -rather than a non-compiled file of similar name. If you rewrite a file -that you intend to save and reinstall, remember to byte-compile it if -necessary; otherwise you may find yourself inadvertently reloading the -older, byte-compiled file instead of your newer, non-compiled file! - - When writing the forms in a Lisp library file, keep in mind that the -file might be loaded more than once. For example, the choice of -@code{defvar} vs.@: @code{defconst} for defining a variable depends on -whether it is desirable to reinitialize the variable if the library is -reloaded: @code{defconst} does so, and @code{defvar} does not. -(@xref{Defining Variables}.) - - The simplest way to add an element to an alist is like this: - -@example -(setq minor-mode-alist - (cons '(leif-mode " Leif") minor-mode-alist)) -@end example - -@noindent -But this would add multiple elements if the library is reloaded. -To avoid the problem, write this: - -@example -(or (assq 'leif-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(leif-mode " Leif") minor-mode-alist))) -@end example - - To add an element to a list just once, use @code{add-to-list} -(@pxref{Setting Variables}). - - Occasionally you will want to test explicitly whether a library has -already been loaded. Here's one way to test, in a library, whether it -has been loaded before: - -@example -(defvar foo-was-loaded) - -(if (not (boundp 'foo-was-loaded)) - @var{execute-first-time-only}) - -(setq foo-was-loaded t) -@end example - -@noindent -If the library uses @code{provide} to provide a named feature, you can -use @code{featurep} to test whether the library has been loaded. -@ifinfo -@xref{Named Features}. -@end ifinfo - -@node Named Features -@section Features -@cindex features -@cindex requiring features -@cindex providing features - - @code{provide} and @code{require} are an alternative to -@code{autoload} for loading files automatically. They work in terms of -named @dfn{features}. Autoloading is triggered by calling a specific -function, but a feature is loaded the first time another program asks -for it by name. - - A feature name is a symbol that stands for a collection of functions, -variables, etc. The file that defines them should @dfn{provide} the -feature. Another program that uses them may ensure they are defined by -@dfn{requiring} the feature. This loads the file of definitions if it -hasn't been loaded already. - - To require the presence of a feature, call @code{require} with the -feature name as argument. @code{require} looks in the global variable -@code{features} to see whether the desired feature has been provided -already. If not, it loads the feature from the appropriate file. This -file should call @code{provide} at the top level to add the feature to -@code{features}; if it fails to do so, @code{require} signals an error. -@cindex load error with require - - Features are normally named after the files that provide them, so that -@code{require} need not be given the file name. - - For example, in @file{emacs/lisp/prolog.el}, -the definition for @code{run-prolog} includes the following code: - -@smallexample -(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)) -@end smallexample - -@noindent -The expression @code{(require 'comint)} loads the file @file{comint.el} -if it has not yet been loaded. This ensures that @code{make-comint} is -defined. - -The @file{comint.el} file contains the following top-level expression: - -@smallexample -(provide 'comint) -@end smallexample - -@noindent -This adds @code{comint} to the global @code{features} list, so that -@code{(require 'comint)} will henceforth know that nothing needs to be -done. - -@cindex byte-compiling @code{require} - When @code{require} is used at top level in a file, it takes effect -when you byte-compile that file (@pxref{Byte Compilation}) as well as -when you load it. This is in case the required package contains macros -that the byte compiler must know about. - - Although top-level calls to @code{require} are evaluated during -byte compilation, @code{provide} calls are not. Therefore, you can -ensure that a file of definitions is loaded before it is byte-compiled -by including a @code{provide} followed by a @code{require} for the same -feature, as in the following example. - -@smallexample -@group -(provide 'my-feature) ; @r{Ignored by byte compiler,} - ; @r{evaluated by @code{load}.} -(require 'my-feature) ; @r{Evaluated by byte compiler.} -@end group -@end smallexample - -@noindent -The compiler ignores the @code{provide}, then processes the -@code{require} by loading the file in question. Loading the file does -execute the @code{provide} call, so the subsequent @code{require} call -does nothing while loading. - -@defun provide feature -This function announces that @var{feature} is now loaded, or being -loaded, into the current XEmacs session. This means that the facilities -associated with @var{feature} are or will be available for other Lisp -programs. - -The direct effect of calling @code{provide} is to add @var{feature} to -the front of the list @code{features} if it is not already in the list. -The argument @var{feature} must be a symbol. @code{provide} returns -@var{feature}. - -@smallexample -features - @result{} (bar bish) - -(provide 'foo) - @result{} foo -features - @result{} (foo bar bish) -@end smallexample - -When a file is loaded to satisfy an autoload, and it stops due to an -error in the evaluating its contents, any function definitions or -@code{provide} calls that occurred during the load are undone. -@xref{Autoload}. -@end defun - -@defun require feature &optional filename -This function checks whether @var{feature} is present in the current -XEmacs session (using @code{(featurep @var{feature})}; see below). If it -is not, then @code{require} loads @var{filename} with @code{load}. If -@var{filename} is not supplied, then the name of the symbol -@var{feature} is used as the file name to load. - -If loading the file fails to provide @var{feature}, @code{require} -signals an error, @samp{Required feature @var{feature} was not -provided}. -@end defun - -@defun featurep fexp -This function returns @code{t} if feature @var{fexp} is present in this -Emacs. Use this to conditionalize execution of lisp code based on the -presence or absence of emacs or environment extensions. - -@var{fexp} can be a symbol, a number, or a list. - -If @var{fexp} is a symbol, it is looked up in the `features' variable, -and @code{t} is returned if it is found, @code{nil} otherwise. - -If @var{fexp} is a number, the function returns @code{t} if this Emacs -has an equal or greater number than @code{fexp}, @code{nil} otherwise. -Note that minor Emacs version is expected to be 2 decimal places wide, -so @code{(featurep 20.4)} will return @code{nil} on XEmacs 20.4---you -must write @code{(featurep 20.04)}, unless you wish to match for XEmacs -20.40. - -If @var{fexp} is a list whose car is the symbol @code{and}, the function -returns @code{t} if all the features in its cdr are present, @code{nil} -otherwise. - -If @var{fexp} is a list whose car is the symbol @code{or}, the function -returns @code{t} if any the features in its cdr are present, @code{nil} -otherwise. - -If @var{fexp} is a list whose car is the symbol @code{not}, the function -returns @code{t} if the feature is not present, @code{nil} otherwise. - -Examples: - -@example -(featurep 'xemacs) - @result{} ; @r{t on XEmacs.} - -(featurep '(and xemacs gnus)) - @result{} ; @r{t on XEmacs with Gnus loaded.} - -(featurep '(or tty-frames (and emacs 19.30))) - @result{} ; @r{t if this Emacs supports TTY frames.} - -(featurep '(or (and xemacs 19.15) (and emacs 19.34))) - @result{} ; @r{t on XEmacs 19.15 and later, or on} - ; @r{FSF Emacs 19.34 and later.} -@end example - -@strong{Please note:} The advanced arguments of this function (anything other than a -symbol) are not yet supported by FSF Emacs. If you feel they are useful -for supporting multiple Emacs variants, lobby Richard Stallman at -@samp{}. -@end defun - -@defvar features -The value of this variable is a list of symbols that are the features -loaded in the current XEmacs session. Each symbol was put in this list -with a call to @code{provide}. The order of the elements in the -@code{features} list is not significant. -@end defvar - -@node Unloading -@section Unloading -@cindex unloading - -@c Emacs 19 feature - You can discard the functions and variables loaded by a library to -reclaim memory for other Lisp objects. To do this, use the function -@code{unload-feature}: - -@deffn Command unload-feature feature &optional force -This command unloads the library that provided feature @var{feature}. -It undefines all functions, macros, and variables defined in that -library with @code{defconst}, @code{defvar}, @code{defun}, -@code{defmacro}, @code{defsubst}, @code{definf-function} and -@code{defalias}. It then restores any autoloads formerly associated -with those symbols. (Loading saves these in the @code{autoload} -property of the symbol.) - -Ordinarily, @code{unload-feature} refuses to unload a library on which -other loaded libraries depend. (A library @var{a} depends on library -@var{b} if @var{a} contains a @code{require} for @var{b}.) If the -optional argument @var{force} is non-@code{nil}, dependencies are -ignored and you can unload any library. -@end deffn - - The @code{unload-feature} function is written in Lisp; its actions are -based on the variable @code{load-history}. - -@defvar load-history -This variable's value is an alist connecting library names with the -names of functions and variables they define, the features they provide, -and the features they require. - -Each element is a list and describes one library. The @sc{car} of the -list is the name of the library, as a string. The rest of the list is -composed of these kinds of objects: - -@itemize @bullet -@item -Symbols that were defined by this library. -@item -Lists of the form @code{(require . @var{feature})} indicating -features that were required. -@item -Lists of the form @code{(provide . @var{feature})} indicating -features that were provided. -@end itemize - -The value of @code{load-history} may have one element whose @sc{car} is -@code{nil}. This element describes definitions made with -@code{eval-buffer} on a buffer that is not visiting a file. -@end defvar - - The command @code{eval-region} updates @code{load-history}, but does so -by adding the symbols defined to the element for the file being visited, -rather than replacing that element. - -@node Hooks for Loading -@section Hooks for Loading -@cindex loading hooks -@cindex hooks for loading - -@ignore @c Not currently in XEmacs. JWZ hates it. -You can ask for code to be executed if and when a particular library is -loaded, by calling @code{eval-after-load}. - -@defun eval-after-load library form -This function arranges to evaluate @var{form} at the end of loading the -library @var{library}, if and when @var{library} is loaded. If -@var{library} is already loaded, it evaluates @var{form} right away. - -The library name @var{library} must exactly match the argument of -@code{load}. To get the proper results when an installed library is -found by searching @code{load-path}, you should not include any -directory names in @var{library}. - -An error in @var{form} does not undo the load, but does prevent -execution of the rest of @var{form}. -@end defun - -In general, well-designed Lisp programs should not use this feature. -The clean and modular ways to interact with a Lisp library are (1) -examine and set the library's variables (those which are meant for -outside use), and (2) call the library's functions. If you wish to -do (1), you can do it immediately---there is no need to wait for when -the library is loaded. To do (2), you must load the library (preferably -with @code{require}). - -But it is ok to use @code{eval-after-load} in your personal customizations -if you don't feel they must meet the design standards of programs to be -released. -@end ignore - -@defvar after-load-alist -An alist of expressions to evaluate if and when particular libraries are -loaded. Each element looks like this: - -@example -(@var{filename} @var{forms}@dots{}) -@end example - -When @code{load} is run and the file-name argument is @var{filename}, -the @var{forms} in the corresponding element are executed at the end of -loading. - -@var{filename} must match exactly! Normally @var{filename} is the name -of a library, with no directory specified, since that is how @code{load} -is normally called. An error in @var{forms} does not undo the load, but -does prevent execution of the rest of the @var{forms}. - -@ignore @c eval-after-load not in XEmacs -The function @code{load} checks @code{after-load-alist} in order to -implement @code{eval-after-load}. -@end ignore -@end defvar - -@c Emacs 19 feature diff --git a/man/lispref/locals.texi b/man/lispref/locals.texi deleted file mode 100644 index ef9359d..0000000 --- a/man/lispref/locals.texi +++ /dev/null @@ -1,153 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/locals.info -@node Standard Buffer-Local Variables, Standard Keymaps, Standard Errors, Top -@appendix Buffer-Local Variables -@c The title "Standard Buffer-Local Variables" is too long for -@c smallbook. --rjc 30mar92 - - The table below lists the general-purpose Emacs variables that are -automatically local (when set) in each buffer. Many Lisp packages -define such variables for their internal use; we don't list them here. - -@table @code -@item abbrev-mode -@pxref{Abbrevs} - -@item auto-fill-function -@pxref{Auto Filling} - -@item buffer-auto-save-file-name -@pxref{Auto-Saving} - -@item buffer-backed-up -@pxref{Backup Files} - -@item buffer-display-table -@pxref{Display Tables} - -@item buffer-file-format -@pxref{Format Conversion} - -@item buffer-file-name -@pxref{Buffer File Name} - -@item buffer-file-number -@pxref{Buffer File Name} - -@item buffer-file-truename -@pxref{Buffer File Name} - -@item buffer-file-type -@pxref{Files and MS-DOS} - -@item buffer-invisibility-spec -@pxref{Invisible Text} - -@item buffer-offer-save -@pxref{Saving Buffers} - -@item buffer-read-only -@pxref{Read Only Buffers} - -@item buffer-saved-size -@pxref{Point} - -@item buffer-undo-list -@pxref{Undo} - -@item cache-long-line-scans -@pxref{Text Lines} - -@item case-fold-search -@pxref{Searching and Case} - -@item ctl-arrow -@pxref{Usual Display} - -@item comment-column -@pxref{Comments,,, emacs, The XEmacs User's Manual} - -@item default-directory -@pxref{System Environment} - -@item defun-prompt-regexp -@pxref{List Motion} - -@item fill-column -@pxref{Auto Filling} - -@item goal-column -@pxref{Moving Point,,, emacs, The XEmacs User's Manual} - -@item left-margin -@pxref{Indentation} - -@item local-abbrev-table -@pxref{Abbrevs} - -@item local-write-file-hooks -@pxref{Saving Buffers} - -@item major-mode -@pxref{Mode Help} - -@item mark-active -@pxref{The Mark} - -@item mark-ring -@pxref{The Mark} - -@item minor-modes -@pxref{Minor Modes} - -@item modeline-format -@pxref{Modeline Data} - -@item modeline-buffer-identification -@pxref{Modeline Variables} - -@item modeline-format -@pxref{Modeline Data} - -@item modeline-modified -@pxref{Modeline Variables} - -@item modeline-process -@pxref{Modeline Variables} - -@item mode-name -@pxref{Modeline Variables} - -@item overwrite-mode -@pxref{Insertion} - -@item paragraph-separate -@pxref{Standard Regexps} - -@item paragraph-start -@pxref{Standard Regexps} - -@item point-before-scroll -Used for communication between mouse commands and scroll-bar commands. - -@item require-final-newline -@pxref{Insertion} - -@item selective-display -@pxref{Selective Display} - -@item selective-display-ellipses -@pxref{Selective Display} - -@item tab-width -@pxref{Usual Display} - -@item truncate-lines -@pxref{Truncation} - -@item vc-mode -@pxref{Modeline Variables} -@end table diff --git a/man/lispref/macros.texi b/man/lispref/macros.texi deleted file mode 100644 index 92c6dbf..0000000 --- a/man/lispref/macros.texi +++ /dev/null @@ -1,579 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/macros.info -@node Macros, Loading, Functions, Top -@chapter Macros -@cindex macros - - @dfn{Macros} enable you to define new control constructs and other -language features. A macro is defined much like a function, but instead -of telling how to compute a value, it tells how to compute another Lisp -expression which will in turn compute the value. We call this -expression the @dfn{expansion} of the macro. - - Macros can do this because they operate on the unevaluated expressions -for the arguments, not on the argument values as functions do. They can -therefore construct an expansion containing these argument expressions -or parts of them. - - If you are using a macro to do something an ordinary function could -do, just for the sake of speed, consider using an inline function -instead. @xref{Inline Functions}. - -@menu -* Simple Macro:: A basic example. -* Expansion:: How, when and why macros are expanded. -* Compiling Macros:: How macros are expanded by the compiler. -* Defining Macros:: How to write a macro definition. -* Backquote:: Easier construction of list structure. -* Problems with Macros:: Don't evaluate the macro arguments too many times. - Don't hide the user's variables. -@end menu - -@node Simple Macro -@section A Simple Example of a Macro - - Suppose we would like to define a Lisp construct to increment a -variable value, much like the @code{++} operator in C. We would like to -write @code{(inc x)} and have the effect of @code{(setq x (1+ x))}. -Here's a macro definition that does the job: - -@findex inc -@example -@group -(defmacro inc (var) - (list 'setq var (list '1+ var))) -@end group -@end example - - When this is called with @code{(inc x)}, the argument @code{var} has -the value @code{x}---@emph{not} the @emph{value} of @code{x}. The body -of the macro uses this to construct the expansion, which is @code{(setq -x (1+ x))}. Once the macro definition returns this expansion, Lisp -proceeds to evaluate it, thus incrementing @code{x}. - -@node Expansion -@section Expansion of a Macro Call -@cindex expansion of macros -@cindex macro call - - A macro call looks just like a function call in that it is a list which -starts with the name of the macro. The rest of the elements of the list -are the arguments of the macro. - - Evaluation of the macro call begins like evaluation of a function call -except for one crucial difference: the macro arguments are the actual -expressions appearing in the macro call. They are not evaluated before -they are given to the macro definition. By contrast, the arguments of a -function are results of evaluating the elements of the function call -list. - - Having obtained the arguments, Lisp invokes the macro definition just -as a function is invoked. The argument variables of the macro are bound -to the argument values from the macro call, or to a list of them in the -case of a @code{&rest} argument. And the macro body executes and -returns its value just as a function body does. - - The second crucial difference between macros and functions is that the -value returned by the macro body is not the value of the macro call. -Instead, it is an alternate expression for computing that value, also -known as the @dfn{expansion} of the macro. The Lisp interpreter -proceeds to evaluate the expansion as soon as it comes back from the -macro. - - Since the expansion is evaluated in the normal manner, it may contain -calls to other macros. It may even be a call to the same macro, though -this is unusual. - - You can see the expansion of a given macro call by calling -@code{macroexpand}. - -@defun macroexpand form &optional environment -@cindex macro expansion -This function expands @var{form}, if it is a macro call. If the result -is another macro call, it is expanded in turn, until something which is -not a macro call results. That is the value returned by -@code{macroexpand}. If @var{form} is not a macro call to begin with, it -is returned as given. - -Note that @code{macroexpand} does not look at the subexpressions of -@var{form} (although some macro definitions may do so). Even if they -are macro calls themselves, @code{macroexpand} does not expand them. - -The function @code{macroexpand} does not expand calls to inline functions. -Normally there is no need for that, since a call to an inline function is -no harder to understand than a call to an ordinary function. - -If @var{environment} is provided, it specifies an alist of macro -definitions that shadow the currently defined macros. Byte compilation -uses this feature. - -@smallexample -@group -(defmacro inc (var) - (list 'setq var (list '1+ var))) - @result{} inc -@end group - -@group -(macroexpand '(inc r)) - @result{} (setq r (1+ r)) -@end group - -@group -(defmacro inc2 (var1 var2) - (list 'progn (list 'inc var1) (list 'inc var2))) - @result{} inc2 -@end group - -@group -(macroexpand '(inc2 r s)) - @result{} (progn (inc r) (inc s)) ; @r{@code{inc} not expanded here.} -@end group -@end smallexample -@end defun - -@node Compiling Macros -@section Macros and Byte Compilation -@cindex byte-compiling macros - - You might ask why we take the trouble to compute an expansion for a -macro and then evaluate the expansion. Why not have the macro body -produce the desired results directly? The reason has to do with -compilation. - - When a macro call appears in a Lisp program being compiled, the Lisp -compiler calls the macro definition just as the interpreter would, and -receives an expansion. But instead of evaluating this expansion, it -compiles the expansion as if it had appeared directly in the program. -As a result, the compiled code produces the value and side effects -intended for the macro, but executes at full compiled speed. This would -not work if the macro body computed the value and side effects -itself---they would be computed at compile time, which is not useful. - - In order for compilation of macro calls to work, the macros must be -defined in Lisp when the calls to them are compiled. The compiler has a -special feature to help you do this: if a file being compiled contains a -@code{defmacro} form, the macro is defined temporarily for the rest of -the compilation of that file. To use this feature, you must define the -macro in the same file where it is used and before its first use. - - Byte-compiling a file executes any @code{require} calls at top-level -in the file. This is in case the file needs the required packages for -proper compilation. One way to ensure that necessary macro definitions -are available during compilation is to require the files that define -them (@pxref{Named Features}). To avoid loading the macro definition files -when someone @emph{runs} the compiled program, write -@code{eval-when-compile} around the @code{require} calls (@pxref{Eval -During Compile}). - -@node Defining Macros -@section Defining Macros - - A Lisp macro is a list whose @sc{car} is @code{macro}. Its @sc{cdr} should -be a function; expansion of the macro works by applying the function -(with @code{apply}) to the list of unevaluated argument-expressions -from the macro call. - - It is possible to use an anonymous Lisp macro just like an anonymous -function, but this is never done, because it does not make sense to pass -an anonymous macro to functionals such as @code{mapcar}. In practice, -all Lisp macros have names, and they are usually defined with the -special form @code{defmacro}. - -@defspec defmacro name argument-list body-forms@dots{} -@code{defmacro} defines the symbol @var{name} as a macro that looks -like this: - -@example -(macro lambda @var{argument-list} . @var{body-forms}) -@end example - -This macro object is stored in the function cell of @var{name}. The -value returned by evaluating the @code{defmacro} form is @var{name}, but -usually we ignore this value. - -The shape and meaning of @var{argument-list} is the same as in a -function, and the keywords @code{&rest} and @code{&optional} may be used -(@pxref{Argument List}). Macros may have a documentation string, but -any @code{interactive} declaration is ignored since macros cannot be -called interactively. -@end defspec - -@node Backquote -@section Backquote -@cindex backquote (list substitution) -@cindex ` (list substitution) -@findex ` - - Macros often need to construct large list structures from a mixture of -constants and nonconstant parts. To make this easier, use the macro -@samp{`} (often called @dfn{backquote}). - - Backquote allows you to quote a list, but selectively evaluate -elements of that list. In the simplest case, it is identical to the -special form @code{quote} (@pxref{Quoting}). For example, these -two forms yield identical results: - -@example -@group -`(a list of (+ 2 3) elements) - @result{} (a list of (+ 2 3) elements) -@end group -@group -'(a list of (+ 2 3) elements) - @result{} (a list of (+ 2 3) elements) -@end group -@end example - -@findex , @r{(with Backquote)} -The special marker @samp{,} inside of the argument to backquote -indicates a value that isn't constant. Backquote evaluates the -argument of @samp{,} and puts the value in the list structure: - -@example -@group -(list 'a 'list 'of (+ 2 3) 'elements) - @result{} (a list of 5 elements) -@end group -@group -`(a list of ,(+ 2 3) elements) - @result{} (a list of 5 elements) -@end group -@end example - -@findex ,@@ @r{(with Backquote)} -@cindex splicing (with backquote) -You can also @dfn{splice} an evaluated value into the resulting list, -using the special marker @samp{,@@}. The elements of the spliced list -become elements at the same level as the other elements of the resulting -list. The equivalent code without using @samp{`} is often unreadable. -Here are some examples: - -@example -@group -(setq some-list '(2 3)) - @result{} (2 3) -@end group -@group -(cons 1 (append some-list '(4) some-list)) - @result{} (1 2 3 4 2 3) -@end group -@group -`(1 ,@@some-list 4 ,@@some-list) - @result{} (1 2 3 4 2 3) -@end group - -@group -(setq list '(hack foo bar)) - @result{} (hack foo bar) -@end group -@group -(cons 'use - (cons 'the - (cons 'words (append (cdr list) '(as elements))))) - @result{} (use the words foo bar as elements) -@end group -@group -`(use the words ,@@(cdr list) as elements) - @result{} (use the words foo bar as elements) -@end group -@end example - -@quotation -In older versions of Emacs (before XEmacs 19.12 or FSF Emacs version -19.29), @samp{`} used a different syntax which required an extra level -of parentheses around the entire backquote construct. Likewise, each -@samp{,} or @samp{,@@} substitution required an extra level of -parentheses surrounding both the @samp{,} or @samp{,@@} and the -following expression. The old syntax required whitespace between the -@samp{`}, @samp{,} or @samp{,@@} and the following expression. - -This syntax is still accepted, but no longer recommended except for -compatibility with old Emacs versions. -@end quotation - -@node Problems with Macros -@section Common Problems Using Macros - - The basic facts of macro expansion have counterintuitive consequences. -This section describes some important consequences that can lead to -trouble, and rules to follow to avoid trouble. - -@menu -* Argument Evaluation:: The expansion should evaluate each macro arg once. -* Surprising Local Vars:: Local variable bindings in the expansion - require special care. -* Eval During Expansion:: Don't evaluate them; put them in the expansion. -* Repeated Expansion:: Avoid depending on how many times expansion is done. -@end menu - -@node Argument Evaluation -@subsection Evaluating Macro Arguments Repeatedly - - When defining a macro you must pay attention to the number of times -the arguments will be evaluated when the expansion is executed. The -following macro (used to facilitate iteration) illustrates the problem. -This macro allows us to write a simple ``for'' loop such as one might -find in Pascal. - -@findex for -@smallexample -@group -(defmacro for (var from init to final do &rest body) - "Execute a simple \"for\" loop. -For example, (for i from 1 to 10 do (print i))." - (list 'let (list (list var init)) - (cons 'while (cons (list '<= var final) - (append body (list (list 'inc var))))))) -@end group -@result{} for - -@group -(for i from 1 to 3 do - (setq square (* i i)) - (princ (format "\n%d %d" i square))) -@expansion{} -@end group -@group -(let ((i 1)) - (while (<= i 3) - (setq square (* i i)) - (princ (format "%d %d" i square)) - (inc i))) -@end group -@group - - @print{}1 1 - @print{}2 4 - @print{}3 9 -@result{} nil -@end group -@end smallexample - -@noindent -(The arguments @code{from}, @code{to}, and @code{do} in this macro are -``syntactic sugar''; they are entirely ignored. The idea is that you -will write noise words (such as @code{from}, @code{to}, and @code{do}) -in those positions in the macro call.) - -Here's an equivalent definition simplified through use of backquote: - -@smallexample -@group -(defmacro for (var from init to final do &rest body) - "Execute a simple \"for\" loop. -For example, (for i from 1 to 10 do (print i))." - `(let ((,var ,init)) - (while (<= ,var ,final) - ,@@body - (inc ,var)))) -@end group -@end smallexample - -Both forms of this definition (with backquote and without) suffer from -the defect that @var{final} is evaluated on every iteration. If -@var{final} is a constant, this is not a problem. If it is a more -complex form, say @code{(long-complex-calculation x)}, this can slow -down the execution significantly. If @var{final} has side effects, -executing it more than once is probably incorrect. - -@cindex macro argument evaluation -A well-designed macro definition takes steps to avoid this problem by -producing an expansion that evaluates the argument expressions exactly -once unless repeated evaluation is part of the intended purpose of the -macro. Here is a correct expansion for the @code{for} macro: - -@smallexample -@group -(let ((i 1) - (max 3)) - (while (<= i max) - (setq square (* i i)) - (princ (format "%d %d" i square)) - (inc i))) -@end group -@end smallexample - -Here is a macro definition that creates this expansion: - -@smallexample -@group -(defmacro for (var from init to final do &rest body) - "Execute a simple for loop: (for i from 1 to 10 do (print i))." - `(let ((,var ,init) - (max ,final)) - (while (<= ,var max) - ,@@body - (inc ,var)))) -@end group -@end smallexample - - Unfortunately, this introduces another problem. -@ifinfo -Proceed to the following node. -@end ifinfo - -@node Surprising Local Vars -@subsection Local Variables in Macro Expansions - -@ifinfo - In the previous section, the definition of @code{for} was fixed as -follows to make the expansion evaluate the macro arguments the proper -number of times: - -@smallexample -@group -(defmacro for (var from init to final do &rest body) - "Execute a simple for loop: (for i from 1 to 10 do (print i))." -@end group -@group - `(let ((,var ,init) - (max ,final)) - (while (<= ,var max) - ,@@body - (inc ,var)))) -@end group -@end smallexample -@end ifinfo - - The new definition of @code{for} has a new problem: it introduces a -local variable named @code{max} which the user does not expect. This -causes trouble in examples such as the following: - -@smallexample -@group -(let ((max 0)) - (for x from 0 to 10 do - (let ((this (frob x))) - (if (< max this) - (setq max this))))) -@end group -@end smallexample - -@noindent -The references to @code{max} inside the body of the @code{for}, which -are supposed to refer to the user's binding of @code{max}, really access -the binding made by @code{for}. - -The way to correct this is to use an uninterned symbol instead of -@code{max} (@pxref{Creating Symbols}). The uninterned symbol can be -bound and referred to just like any other symbol, but since it is -created by @code{for}, we know that it cannot already appear in the -user's program. Since it is not interned, there is no way the user can -put it into the program later. It will never appear anywhere except -where put by @code{for}. Here is a definition of @code{for} that works -this way: - -@smallexample -@group -(defmacro for (var from init to final do &rest body) - "Execute a simple for loop: (for i from 1 to 10 do (print i))." - (let ((tempvar (make-symbol "max"))) - `(let ((,var ,init) - (,tempvar ,final)) - (while (<= ,var ,tempvar) - ,@@body - (inc ,var))))) -@end group -@end smallexample - -@noindent -This creates an uninterned symbol named @code{max} and puts it in the -expansion instead of the usual interned symbol @code{max} that appears -in expressions ordinarily. - -@node Eval During Expansion -@subsection Evaluating Macro Arguments in Expansion - - Another problem can happen if you evaluate any of the macro argument -expressions during the computation of the expansion, such as by calling -@code{eval} (@pxref{Eval}). If the argument is supposed to refer to the -user's variables, you may have trouble if the user happens to use a -variable with the same name as one of the macro arguments. Inside the -macro body, the macro argument binding is the most local binding of this -variable, so any references inside the form being evaluated do refer -to it. Here is an example: - -@example -@group -(defmacro foo (a) - (list 'setq (eval a) t)) - @result{} foo -@end group -@group -(setq x 'b) -(foo x) @expansion{} (setq b t) - @result{} t ; @r{and @code{b} has been set.} -;; @r{but} -(setq a 'c) -(foo a) @expansion{} (setq a t) - @result{} t ; @r{but this set @code{a}, not @code{c}.} - -@end group -@end example - - It makes a difference whether the user's variable is named @code{a} or -@code{x}, because @code{a} conflicts with the macro argument variable -@code{a}. - - Another reason not to call @code{eval} in a macro definition is that -it probably won't do what you intend in a compiled program. The -byte-compiler runs macro definitions while compiling the program, when -the program's own computations (which you might have wished to access -with @code{eval}) don't occur and its local variable bindings don't -exist. - - The safe way to work with the run-time value of an expression is to -put the expression into the macro expansion, so that its value is -computed as part of executing the expansion. - -@node Repeated Expansion -@subsection How Many Times is the Macro Expanded? - - Occasionally problems result from the fact that a macro call is -expanded each time it is evaluated in an interpreted function, but is -expanded only once (during compilation) for a compiled function. If the -macro definition has side effects, they will work differently depending -on how many times the macro is expanded. - - In particular, constructing objects is a kind of side effect. If the -macro is called once, then the objects are constructed only once. In -other words, the same structure of objects is used each time the macro -call is executed. In interpreted operation, the macro is reexpanded -each time, producing a fresh collection of objects each time. Usually -this does not matter---the objects have the same contents whether they -are shared or not. But if the surrounding program does side effects -on the objects, it makes a difference whether they are shared. Here is -an example: - -@lisp -@group -(defmacro empty-object () - (list 'quote (cons nil nil))) -@end group - -@group -(defun initialize (condition) - (let ((object (empty-object))) - (if condition - (setcar object condition)) - object)) -@end group -@end lisp - -@noindent -If @code{initialize} is interpreted, a new list @code{(nil)} is -constructed each time @code{initialize} is called. Thus, no side effect -survives between calls. If @code{initialize} is compiled, then the -macro @code{empty-object} is expanded during compilation, producing a -single ``constant'' @code{(nil)} that is reused and altered each time -@code{initialize} is called. - -One way to avoid pathological cases like this is to think of -@code{empty-object} as a funny kind of constant, not as a memory -allocation construct. You wouldn't use @code{setcar} on a constant such -as @code{'(nil)}, so naturally you won't use it on @code{(empty-object)} -either. diff --git a/man/lispref/maps.texi b/man/lispref/maps.texi deleted file mode 100644 index 1421e91..0000000 --- a/man/lispref/maps.texi +++ /dev/null @@ -1,183 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/maps.info -@node Standard Keymaps, Standard Hooks, Standard Buffer-Local Variables, Top -@appendix Standard Keymaps - -The following symbols are used as the names for various keymaps. -Some of these exist when XEmacs is first started, others are -loaded only when their respective mode is used. This is not -an exhaustive list. - -Almost all of these maps are used as local maps. Indeed, of the modes -that presently exist, only Vip mode and Terminal mode ever change the -global keymap. - -@table @code -@item bookmark-map -@vindex bookmark-map -A keymap containing bindings to bookmark functions. - -@item Buffer-menu-mode-map -@vindex Buffer-menu-mode-map -A keymap used by Buffer Menu mode. - -@item c++-mode-map -@vindex c++-mode-map -A keymap used by C++ mode. - -@item c-mode-map -@vindex c-mode-map -A keymap used by C mode. -A sparse keymap used by C mode. - -@item command-history-map -@vindex command-history-map -A keymap used by Command History mode. - -@item ctl-x-4-map -@vindex ctl-x-4-map -A keymap for subcommands of the prefix @kbd{C-x 4}. - -@item ctl-x-5-map -@vindex ctl-x-5-map -A keymap for subcommands of the prefix @kbd{C-x 5}. - -@item ctl-x-map -@vindex ctl-x-map -A keymap for @kbd{C-x} commands. - -@item debugger-mode-map -@vindex debugger-mode-map -A keymap used by Debugger mode. - -@item dired-mode-map -@vindex dired-mode-map -A keymap for @code{dired-mode} buffers. - -@item edit-abbrevs-map -@vindex edit-abbrevs-map -A keymap used in @code{edit-abbrevs}. - -@item edit-tab-stops-map -@vindex edit-tab-stops-map -A keymap used in @code{edit-tab-stops}. - -@item electric-buffer-menu-mode-map -@vindex electric-buffer-menu-mode-map -A keymap used by Electric Buffer Menu mode. - -@item electric-history-map -@vindex electric-history-map -A keymap used by Electric Command History mode. - -@item emacs-lisp-mode-map -@vindex emacs-lisp-mode-map -A keymap used by Emacs Lisp mode. - -@item help-map -@vindex help-map -A keymap for characters following the Help key. - -@item Helper-help-map -@vindex Helper-help-map -A keymap used by the help utility package.@* -It has the same keymap in its value cell and in its function -cell. - -@item Info-edit-map -@vindex Info-edit-map -A keymap used by the @kbd{e} command of Info. - -@item Info-mode-map -@vindex Info-mode-map -A keymap containing Info commands. - -@item isearch-mode-map -@vindex isearch-mode-map -A keymap that defines the characters you can type within incremental -search. - -@item itimer-edit-map -@vindex itimer-edit-map -A keymap used when in Itimer Edit mode. - -@item lisp-interaction-mode-map -@vindex lisp-interaction-mode-map -A keymap used by Lisp mode. - -@item lisp-mode-map -@vindex lisp-mode-map -A keymap used by Lisp mode. - -@vindex minibuffer-local-completion-map -A keymap for minibuffer input with completion. - -@item minibuffer-local-isearch-map -@vindex minibuffer-local-isearch-map -A keymap for editing isearch strings in the minibuffer. - -@item minibuffer-local-map -@vindex minibuffer-local-map -Default keymap to use when reading from the minibuffer. - -@item minibuffer-local-must-match-map -@vindex minibuffer-local-must-match-map -A keymap for minibuffer input with completion, for exact match. - -@item mode-specific-map -@vindex mode-specific-map -The keymap for characters following @kbd{C-c}. Note, this is in the -global map. This map is not actually mode specific: its name was chosen -to be informative for the user in @kbd{C-h b} (@code{display-bindings}), -where it describes the main use of the @kbd{C-c} prefix key. - -@item modeline-map -@vindex modeline-map -The keymap consulted for mouse-clicks on the modeline of a window. - -@item objc-mode-map -@vindex objc-mode-map -A keymap used in Objective C mode as a local map. - -@item occur-mode-map -@vindex occur-mode-map -A local keymap used by Occur mode. - -@item overriding-local-map -@vindex overriding-local-map -A keymap that overrides all other local keymaps. - -@item query-replace-map -@vindex query-replace-map -A local keymap used for responses in @code{query-replace} and related -commands; also for @code{y-or-n-p} and @code{map-y-or-n-p}. The functions -that use this map do not support prefix keys; they look up one event at a -time. - -@item read-expression-map -@vindex read-expression-map -The minibuffer keymap used for reading Lisp expressions. - -@item read-shell-command-map -@vindex read-shell-command-map -The minibuffer keymap used by shell-command and related commands. - -@item shared-lisp-mode-map -@vindex shared-lisp-mode-map -A keymap for commands shared by all sorts of Lisp modes. - -@item text-mode-map -@vindex text-mode-map -A keymap used by Text mode. - -@item toolbar-map -@vindex toolbar-map -The keymap consulted for mouse-clicks over a toolbar. - -@item view-mode-map -@vindex view-mode-map -A keymap used by View mode. -@end table diff --git a/man/lispref/markers.texi b/man/lispref/markers.texi deleted file mode 100644 index 2ba1c5d..0000000 --- a/man/lispref/markers.texi +++ /dev/null @@ -1,784 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/markers.info -@node Markers, Text, Positions, Top -@chapter Markers -@cindex markers - - A @dfn{marker} is a Lisp object used to specify a position in a buffer -relative to the surrounding text. A marker changes its offset from the -beginning of the buffer automatically whenever text is inserted or -deleted, so that it stays with the two characters on either side of it. - -@menu -* Overview of Markers:: The components of a marker, and how it relocates. -* Predicates on Markers:: Testing whether an object is a marker. -* Creating Markers:: Making empty markers or markers at certain places. -* Information from Markers:: Finding the marker's buffer or character position. -* Changing Markers:: Moving the marker to a new buffer or position. -* The Mark:: How ``the mark'' is implemented with a marker. -* The Region:: How to access ``the region''. -@end menu - -@node Overview of Markers -@section Overview of Markers - - A marker specifies a buffer and a position in that buffer. The marker -can be used to represent a position in the functions that require one, -just as an integer could be used. @xref{Positions}, for a complete -description of positions. - - A marker has two attributes: the marker position, and the marker -buffer. The marker position is an integer that is equivalent (at a -given time) to the marker as a position in that buffer. But the -marker's position value can change often during the life of the marker. -Insertion and deletion of text in the buffer relocate the marker. The -idea is that a marker positioned between two characters remains between -those two characters despite insertion and deletion elsewhere in the -buffer. Relocation changes the integer equivalent of the marker. - -@cindex marker relocation - Deleting text around a marker's position leaves the marker between the -characters immediately before and after the deleted text. Inserting -text at the position of a marker normally leaves the marker in front of -the new text---unless it is inserted with @code{insert-before-markers} -(@pxref{Insertion}). - -@cindex marker garbage collection - Insertion and deletion in a buffer must check all the markers and -relocate them if necessary. This slows processing in a buffer with a -large number of markers. For this reason, it is a good idea to make a -marker point nowhere if you are sure you don't need it any more. -Unreferenced markers are garbage collected eventually, but until then -will continue to use time if they do point somewhere. - -@cindex markers as numbers - Because it is common to perform arithmetic operations on a marker -position, most of the arithmetic operations (including @code{+} and -@code{-}) accept markers as arguments. In such cases, the marker -stands for its current position. - -@cindex markers vs. extents - Note that you can use extents to achieve the same functionality, and -more, as markers. (Markers were defined before extents, which is why -they both continue to exist.) A zero-length extent with the -@code{detachable} property removed is almost identical to a marker. -(@xref{Extent Endpoints}, for more information on zero-length extents.) - -In particular: - -@itemize @bullet -@item -In order to get marker-like behavior in a zero-length extent, the -@code{detachable} property must be removed (otherwise, the extent -will disappear when text near it is deleted) and exactly one -endpoint must be closed (if both endpoints are closed, the extent -will expand to contain text inserted where it is located). -@item -If a zero-length extent has the @code{end-open} property but not -the @code{start-open} property (this is the default), text inserted -at the extent's location causes the extent to move forward, just -like a marker. -@item -If a zero-length extent has the @code{start-open} property but not -the @code{end-open} property, text inserted at the extent's location -causes the extent to remain before the text, like what happens to -markers when @code{insert-before-markers} is used. -@item -Markers end up after or before inserted text depending on whether -@code{insert} or @code{insert-before-markers} was called. These -functions do not affect zero-length extents differently; instead, -the presence or absence of the @code{start-open} and @code{end-open} -extent properties determines this, as just described. -@item -Markers are automatically removed from a buffer when they are no -longer in use. Extents remain around until explicitly removed -from a buffer. -@item -Many functions are provided for listing the extents in a buffer or -in a region of a buffer. No such functions exist for markers. -@end itemize - -Here are examples of creating markers, setting markers, and moving point -to markers: - -@example -@group -;; @r{Make a new marker that initially does not point anywhere:} -(setq m1 (make-marker)) - @result{} # -@end group - -@group -;; @r{Set @code{m1} to point between the 99th and 100th characters} -;; @r{in the current buffer:} -(set-marker m1 100) - @result{} # -@end group - -@group -;; @r{Now insert one character at the beginning of the buffer:} -(goto-char (point-min)) - @result{} 1 -(insert "Q") - @result{} nil -@end group - -@group -;; @r{@code{m1} is updated appropriately.} -m1 - @result{} # -@end group - -@group -;; @r{Two markers that point to the same position} -;; @r{are not @code{eq}, but they are @code{equal}.} -(setq m2 (copy-marker m1)) - @result{} # -(eq m1 m2) - @result{} nil -(equal m1 m2) - @result{} t -@end group - -@group -;; @r{When you are finished using a marker, make it point nowhere.} -(set-marker m1 nil) - @result{} # -@end group -@end example - -@node Predicates on Markers -@section Predicates on Markers - - You can test an object to see whether it is a marker, or whether it is -either an integer or a marker or either an integer, a character, or a -marker. The latter tests are useful in connection with the arithmetic -functions that work with any of markers, integers, or characters. - -@defun markerp object -This function returns @code{t} if @var{object} is a marker, @code{nil} -otherwise. Note that integers are not markers, even though many -functions will accept either a marker or an integer. -@end defun - -@defun integer-or-marker-p object -This function returns @code{t} if @var{object} is an integer or a marker, -@code{nil} otherwise. -@end defun - -@defun integer-char-or-marker-p object -This function returns @code{t} if @var{object} is an integer, a -character, or a marker, @code{nil} otherwise. -@end defun - -@defun number-or-marker-p object -This function returns @code{t} if @var{object} is a number (either kind) -or a marker, @code{nil} otherwise. -@end defun - -@defun number-char-or-marker-p object -This function returns @code{t} if @var{object} is a number (either -kind), a character, or a marker, @code{nil} otherwise. -@end defun - -@node Creating Markers -@section Functions That Create Markers - - When you create a new marker, you can make it point nowhere, or point -to the present position of point, or to the beginning or end of the -accessible portion of the buffer, or to the same place as another given -marker. - -@defun make-marker -This functions returns a newly created marker that does not point -anywhere. - -@example -@group -(make-marker) - @result{} # -@end group -@end example -@end defun - -@defun point-marker &optional dont-copy-p buffer -This function returns a marker that points to the present position of -point in @var{buffer}, which defaults to the current buffer. -@xref{Point}. For an example, see @code{copy-marker}, below. - -Internally, a marker corresponding to point is always maintained. -Normally the marker returned by @code{point-marker} is a copy; you -may modify it with reckless abandon. However, if optional argument -@var{dont-copy-p} is non-@code{nil}, then the real point-marker is -returned; modifying the position of this marker will move point. -It is illegal to change the buffer of it, or make it point nowhere. -@end defun - -@defun point-min-marker &optional buffer -This function returns a new marker that points to the beginning of the -accessible portion of @var{buffer}, which defaults to the current -buffer. This will be the beginning of the buffer unless narrowing is in -effect. @xref{Narrowing}. -@end defun - -@defun point-max-marker &optional buffer -@cindex end of buffer marker -This function returns a new marker that points to the end of the -accessible portion of @var{buffer}, which defaults to the current -buffer. This will be the end of the buffer unless narrowing is in -effect. @xref{Narrowing}. - -Here are examples of this function and @code{point-min-marker}, shown in -a buffer containing a version of the source file for the text of this -chapter. - -@example -@group -(point-min-marker) - @result{} # -(point-max-marker) - @result{} # -@end group - -@group -(narrow-to-region 100 200) - @result{} nil -@end group -@group -(point-min-marker) - @result{} # -@end group -@group -(point-max-marker) - @result{} # -@end group -@end example -@end defun - -@defun copy-marker marker-or-integer -If passed a marker as its argument, @code{copy-marker} returns a -new marker that points to the same place and the same buffer as does -@var{marker-or-integer}. If passed an integer as its argument, -@code{copy-marker} returns a new marker that points to position -@var{marker-or-integer} in the current buffer. - -If passed an integer argument less than 1, @code{copy-marker} returns a -new marker that points to the beginning of the current buffer. If -passed an integer argument greater than the length of the buffer, -@code{copy-marker} returns a new marker that points to the end of the -buffer. - -An error is signaled if @var{marker} is neither a marker nor an -integer. - -@example -@group -(setq p (point-marker)) - @result{} # -@end group - -@group -(setq q (copy-marker p)) - @result{} # -@end group - -@group -(eq p q) - @result{} nil -@end group - -@group -(equal p q) - @result{} t -@end group - -@group -(point) - @result{} 2139 -@end group - -@group -(set-marker p 3000) - @result{} # -@end group - -@group -(point) - @result{} 2139 -@end group - -@group -(setq p (point-marker t)) - @result{} # -@end group - -@group -(set-marker p 3000) - @result{} # -@end group - -@group -(point) - @result{} 3000 -@end group - -@group -(copy-marker 0) - @result{} # -@end group - -@group -(copy-marker 20000) - @result{} # -@end group -@end example -@end defun - -@node Information from Markers -@section Information from Markers - - This section describes the functions for accessing the components of a -marker object. - -@defun marker-position marker -This function returns the position that @var{marker} points to, or -@code{nil} if it points nowhere. -@end defun - -@defun marker-buffer marker -This function returns the buffer that @var{marker} points into, or -@code{nil} if it points nowhere. - -@example -@group -(setq m (make-marker)) - @result{} # -@end group -@group -(marker-position m) - @result{} nil -@end group -@group -(marker-buffer m) - @result{} nil -@end group - -@group -(set-marker m 3770 (current-buffer)) - @result{} # -@end group -@group -(marker-buffer m) - @result{} # -@end group -@group -(marker-position m) - @result{} 3770 -@end group -@end example -@end defun - - Two distinct markers are considered @code{equal} (even though not -@code{eq}) to each other if they have the same position and buffer, or -if they both point nowhere. - -@node Changing Markers -@section Changing Marker Positions - - This section describes how to change the position of an existing -marker. When you do this, be sure you know whether the marker is used -outside of your program, and, if so, what effects will result from -moving it---otherwise, confusing things may happen in other parts of -Emacs. - -@defun set-marker marker position &optional buffer -This function moves @var{marker} to @var{position} -in @var{buffer}. If @var{buffer} is not provided, it defaults to -the current buffer. - -If @var{position} is less than 1, @code{set-marker} moves @var{marker} -to the beginning of the buffer. If @var{position} is greater than the -size of the buffer, @code{set-marker} moves marker to the end of the -buffer. If @var{position} is @code{nil} or a marker that points -nowhere, then @var{marker} is set to point nowhere. - -The value returned is @var{marker}. - -@example -@group -(setq m (point-marker)) - @result{} # -@end group -@group -(set-marker m 55) - @result{} # -@end group -@group -(setq b (get-buffer "foo")) - @result{} # -@end group -@group -(set-marker m 0 b) - @result{} # -@end group -@end example -@end defun - -@defun move-marker marker position &optional buffer -This is another name for @code{set-marker}. -@end defun - -@node The Mark -@section The Mark -@cindex mark, the -@cindex mark ring -@cindex global mark ring - - One special marker in each buffer is designated @dfn{the mark}. It -records a position for the user for the sake of commands such as -@kbd{C-w} and @kbd{C-x @key{TAB}}. Lisp programs should set the mark -only to values that have a potential use to the user, and never for -their own internal purposes. For example, the @code{replace-regexp} -command sets the mark to the value of point before doing any -replacements, because this enables the user to move back there -conveniently after the replace is finished. - - Once the mark ``exists'' in a buffer, it normally never ceases to -exist. However, it may become @dfn{inactive}, and usually does so -after each command (other than simple motion commands and some -commands that explicitly activate the mark). When the mark is active, -the region between point and the mark is called the @dfn{active region} -and is highlighted specially. - - Many commands are designed so that when called interactively they -operate on the text between point and the mark. Such commands work -only when an active region exists, i.e. when the mark is active. -(The reason for this is to prevent you from accidentally deleting -or changing large chunks of your text.) If you are writing such -a command, don't examine the mark directly; instead, use -@code{interactive} with the @samp{r} specification. This provides the -values of point and the mark as arguments to the command in an -interactive call, but permits other Lisp programs to specify arguments -explicitly, and automatically signals an error if the command is called -interactively when no active region exists. @xref{Interactive Codes}. - - Each buffer has its own value of the mark that is independent of the -value of the mark in other buffers. (When a buffer is created, the mark -exists but does not point anywhere. We consider this state as ``the -absence of a mark in that buffer.'') However, only one active region can -exist at a time. Activating the mark in one buffer automatically -deactivates an active mark in any other buffer. Note that the user can -explicitly activate a mark at any time by using the command -@code{activate-region} (normally bound to @kbd{M-C-z}) or by using the -command @code{exchange-point-and-mark} (normally bound to @kbd{C-x C-x}), -which has the side effect of activating the mark. - - Some people do not like active regions, so they disable this behavior -by setting the variable @code{zmacs-regions} to @code{nil}. This makes -the mark always active (except when a buffer is just created and the -mark points nowhere), and turns off the highlighting of the region -between point and the mark. Commands that explicitly retrieve the value -of the mark should make sure that they behave correctly and consistently -irrespective of the setting of @code{zmacs-regions}; some primitives are -provided to ensure this behavior. - - In addition to the mark, each buffer has a @dfn{mark ring} which is a -list of markers containing previous values of the mark. When editing -commands change the mark, they should normally save the old value of the -mark on the mark ring. The variable @code{mark-ring-max} specifies the -maximum number of entries in the mark ring; once the list becomes this -long, adding a new element deletes the last element. - -@defun mark &optional force buffer -@cindex current buffer mark -This function returns @var{buffer}'s mark position as an integer. -@var{buffer} defaults to the current buffer if omitted. - -If the mark is inactive, @code{mark} normally returns @code{nil}. -However, if @var{force} is non-@code{nil}, then @code{mark} returns the -mark position anyway---or @code{nil}, if the mark is not yet set for -the buffer. - -(Remember that if @var{zmacs-regions} is @code{nil}, the mark is -always active as long as it exists, and the @var{force} argument -will have no effect.) - -If you are using this in an editing command, you are most likely making -a mistake; see the documentation of @code{set-mark} below. -@end defun - -@defun mark-marker inactive-p buffer -This function returns @var{buffer}'s mark. @var{buffer} defaults to the -current buffer if omitted. This is the very marker that records the -mark location inside XEmacs, not a copy. Therefore, changing this -marker's position will directly affect the position of the mark. Don't -do it unless that is the effect you want. - -If the mark is inactive, @code{mark-marker} normally returns @code{nil}. -However, if @var{force} is non-@code{nil}, then @code{mark-marker} -returns the mark anyway. -@example -@group -(setq m (mark-marker)) - @result{} # -@end group -@group -(set-marker m 100) - @result{} # -@end group -@group -(mark-marker) - @result{} # -@end group -@end example - -Like any marker, this marker can be set to point at any buffer you like. -We don't recommend that you make it point at any buffer other than the -one of which it is the mark. If you do, it will yield perfectly -consistent, but rather odd, results. -@end defun - -@ignore -@deffn Command set-mark-command jump -If @var{jump} is @code{nil}, this command sets the mark to the value -of point and pushes the previous value of the mark on the mark ring. The -message @samp{Mark set} is also displayed in the echo area. - -If @var{jump} is not @code{nil}, this command sets point to the value -of the mark, and sets the mark to the previous saved mark value, which -is popped off the mark ring. - -This function is @emph{only} intended for interactive use. -@end deffn -@end ignore - -@defun set-mark position &optional buffer -This function sets @code{buffer}'s mark to @var{position}, and activates -the mark. @var{buffer} defaults to the current buffer if omitted. The -old value of the mark is @emph{not} pushed onto the mark ring. - -@strong{Please note:} Use this function only if you want the user to -see that the mark has moved, and you want the previous mark position to -be lost. Normally, when a new mark is set, the old one should go on the -@code{mark-ring}. For this reason, most applications should use -@code{push-mark} and @code{pop-mark}, not @code{set-mark}. - -Novice XEmacs Lisp programmers often try to use the mark for the wrong -purposes. The mark saves a location for the user's convenience. An -editing command should not alter the mark unless altering the mark is -part of the user-level functionality of the command. (And, in that -case, this effect should be documented.) To remember a location for -internal use in the Lisp program, store it in a Lisp variable. For -example: - -@example -@group -(let ((beg (point))) - (forward-line 1) - (delete-region beg (point))). -@end group -@end example -@end defun - -@deffn Command exchange-point-and-mark &optional dont-activate-region -This function exchanges the positions of point and the mark. -It is intended for interactive use. The mark is also activated -unless @var{dont-activate-region} is non-@code{nil}. -@end deffn - -@defun push-mark &optional position nomsg activate buffer -This function sets @var{buffer}'s mark to @var{position}, and pushes a -copy of the previous mark onto @code{mark-ring}. @var{buffer} defaults -to the current buffer if omitted. If @var{position} is @code{nil}, then -the value of point is used. @code{push-mark} returns @code{nil}. - -If the last global mark pushed was not in @var{buffer}, also push -@var{position} on the global mark ring (see below). - -The function @code{push-mark} normally @emph{does not} activate the -mark. To do that, specify @code{t} for the argument @var{activate}. - -A @samp{Mark set} message is displayed unless @var{nomsg} is -non-@code{nil}. -@end defun - -@defun pop-mark -This function pops off the top element of @code{mark-ring} and makes -that mark become the buffer's actual mark. This does not move point in -the buffer, and it does nothing if @code{mark-ring} is empty. It -deactivates the mark. - -The return value is not meaningful. -@end defun - -@defvar mark-ring -The value of this buffer-local variable is the list of saved former -marks of the current buffer, most recent first. - -@example -@group -mark-ring -@result{} (# - # - @dots{}) -@end group -@end example -@end defvar - -@defopt mark-ring-max -The value of this variable is the maximum size of @code{mark-ring}. If -more marks than this are pushed onto the @code{mark-ring}, -@code{push-mark} discards an old mark when it adds a new one. -@end defopt - -In additional to a per-buffer mark ring, there is a @dfn{global mark -ring}. Marks are pushed onto the global mark ring the first time you -set a mark after switching buffers. - -@defvar global-mark-ring -The value of this variable is the list of saved former global marks, -most recent first. -@end defvar - -@defopt mark-ring-max -The value of this variable is the maximum size of -@code{global-mark-ring}. If more marks than this are pushed onto the -@code{global-mark-ring}, @code{push-mark} discards an old mark when it -adds a new one. -@end defopt - -@deffn Command pop-global-mark -This function pops a mark off the global mark ring and jumps to that -location. -@end deffn - -@node The Region -@section The Region -@cindex region, the - - The text between point and the mark is known as @dfn{the region}. -Various functions operate on text delimited by point and the mark, but -only those functions specifically related to the region itself are -described here. - - When @code{zmacs-regions} is non-@code{nil} (this is the default), the -concept of an @dfn{active region} exists. The region is active when the -corresponding mark is active. Note that only one active region at a -time can exist -- i.e. only one buffer's region is active at a time. -@xref{The Mark} for more information about active regions. - -@defopt zmacs-regions -If non-@code{nil} (the default), active regions are used. @xref{The Mark}, -for a detailed explanation of what this means. -@end defopt - - A number of functions are provided for explicitly determining the -bounds of the region and whether it is active. Few programs need to use -these functions, however. A command designed to operate on a region -should normally use @code{interactive} with the @samp{r} specification -to find the beginning and end of the region. This lets other Lisp -programs specify the bounds explicitly as arguments and automatically -respects the user's setting for @var{zmacs-regions}. (@xref{Interactive -Codes}.) - -@defun region-beginning &optional buffer -This function returns the position of the beginning of @var{buffer}'s -region (as an integer). This is the position of either point or the -mark, whichever is smaller. @var{buffer} defaults to the current buffer -if omitted. - -If the mark does not point anywhere, an error is signaled. Note that -this function ignores whether the region is active. -@end defun - -@defun region-end &optional buffer -This function returns the position of the end of @var{buffer}'s region -(as an integer). This is the position of either point or the mark, -whichever is larger. @var{buffer} defaults to the current buffer if -omitted. - -If the mark does not point anywhere, an error is signaled. Note that -this function ignores whether the region is active. -@end defun - -@defun region-exists-p -This function is non-@code{nil} if the region exists. If active regions -are in use (i.e. @code{zmacs-regions} is true), this means that the -region is active. Otherwise, this means that the user has pushed a mark -in this buffer at some point in the past. If this function returns @code{nil}, -a function that uses the @samp{r} interactive specification will cause -an error when called interactively. -@end defun - -@defun region-active-p -If @code{zmacs-regions} is true, this is equivalent to -@code{region-exists-p}. Otherwise, this function always returns false. -This function is used by commands such as @code{fill-paragraph-or-region} -and @code{capitalize-region-or-word}, which operate either on the active -region or on something else (e.g. the word or paragraph at point). -@end defun - -@defvar zmacs-region-stays -If a command sets this variable to true, the currently active region -will remain activated when the command finishes. (Normally the region is -deactivated when each command terminates.) If @var{zmacs-regions} is -false, however, this has no effect. Under normal circumstances, you do -not need to set this; use the interactive specification @samp{_} -instead, if you want the region to remain active. -@end defvar - -@defun zmacs-activate-region -This function activates the region in the current buffer (this is -equivalent to activating the current buffer's mark). This will normally -also highlight the text in the active region and set -@var{zmacs-region-stays} to @code{t}. (If @var{zmacs-regions} is false, -however, this function has no effect.) -@end defun - -@defun zmacs-deactivate-region -This function deactivates the region in the current buffer (this is -equivalent to deactivating the current buffer's mark). This will -normally also unhighlight the text in the active region and set -@var{zmacs-region-stays} to @code{nil}. (If @var{zmacs-regions} is -false, however, this function has no effect.) -@end defun - -@defun zmacs-update-region -This function updates the active region, if it's currently active. (If -there is no active region, this function does nothing.) This has the -effect of updating the highlighting on the text in the region; but you -should never need to call this except under rather strange -circumstances. The command loop automatically calls it when -appropriate. Calling this function will call the hook -@code{zmacs-update-region-hook}, if the region is active. -@end defun - -@defvar zmacs-activate-region-hook -This normal hook is called when a region becomes active. (Usually this -happens as a result of a command that activates the region, such as -@code{set-mark-command}, @code{activate-region}, or -@code{exchange-point-and-mark}.) Note that calling -@file{zmacs-activate-region} will call this hook, even if the region is -already active. If @var{zmacs-regions} is false, however, this hook -will never get called under any circumstances. -@end defvar - -@defvar zmacs-deactivate-region-hook -This normal hook is called when an active region becomes inactive. -(Calling @file{zmacs-deactivate-region} when the region is inactive will -@emph{not} cause this hook to be called.) If @var{zmacs-regions} is -false, this hook will never get called. -@end defvar - -@defvar zmacs-update-region-hook -This normal hook is called when an active region is "updated" by -@code{zmacs-update-region}. This normally gets called at the end -of each command that sets @var{zmacs-region-stays} to @code{t}, -indicating that the region should remain activated. The motion -commands do this. -@end defvar - - diff --git a/man/lispref/menus.texi b/man/lispref/menus.texi deleted file mode 100644 index 713aef1..0000000 --- a/man/lispref/menus.texi +++ /dev/null @@ -1,754 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1997 Free Software Foundation, Inc. -@c Copyright (C) 1995 Sun Microsystems. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/menu.info -@node Menus, Dialog Boxes, Keymaps, Top -@chapter Menus -@cindex menu - -@menu -* Menu Format:: Format of a menu description. -* Menubar Format:: How to specify a menubar. -* Menubar:: Functions for controlling the menubar. -* Modifying Menus:: Modifying a menu description. -* Pop-Up Menus:: Functions for specifying pop-up menus. -* Menu Filters:: Filter functions for the default menubar. -* Menu Accelerators:: Using and controlling menu accelerator keys -* Buffers Menu:: The menu that displays the list of buffers. -@end menu - -@node Menu Format -@section Format of Menus -@cindex menu format -@cindex format of menus - -A menu is described using a @dfn{menu description}, which is a list of -menu items, keyword-value pairs, strings, and submenus. The menu -description specifies which items are present in the menu, what function -each item invokes, and whether the item is selectable or not. Pop-up -menus are directly described with a menu description, while menubars are -described slightly differently (see below). - -The first element of a menu must be a string, which is the name of the -menu. This is the string that will be displayed in the parent menu or -menubar, if any. This string is not displayed in the menu itself, -except in the case of the top level pop-up menu, where there is no -parent. In this case, the string will be displayed at the top of the -menu if @code{popup-menu-titles} is non-@code{nil}. - -Immediately following the first element there may optionally be up -to four keyword-value pairs, as follows: - -@table @code -@item :included @var{form} -This can be used to control the visibility of a menu. The form is -evaluated and the menu will be omitted if the result is @code{nil}. - -@item :config @var{symbol} -This is an efficient shorthand for @code{:included (memq @var{symbol} -menubar-configuration)}. See the variable @code{menubar-configuration}. - -@item :filter @var{function} -A menu filter is used to sensitize or incrementally create a submenu -only when it is selected by the user and not every time the menubar is -activated. The filter function is passed the list of menu items in the -submenu and must return a list of menu items to be used for the menu. -It is called only when the menu is about to be displayed, so other menus -may already be displayed. Vile and terrible things will happen if a -menu filter function changes the current buffer, window, or frame. It -also should not raise, lower, or iconify any frames. Basically, the -filter function should have no side-effects. - -@item :accelerator @var{key} -A menu accelerator is a keystroke which can be pressed while the menu is -visible which will immediately activate the item. @var{key} must be a char -or the symbol name of a key. @xref{Menu Accelerators}. -@end table - -The rest of the menu consists of elements as follows: - -@itemize @bullet -@item -A @dfn{menu item}, which is a vector in the following form: - -@example -@code{[ @var{name} @var{callback} @var{:keyword} @var{value} @var{:keyword} @var{value} ... ]} -@end example - -@var{name} is a string, the name of the menu item; it is the string to -display on the menu. It is filtered through the resource database, so -it is possible for resources to override what string is actually -displayed. - -@var{callback} is a form that will be invoked when the menu item is -selected. If the callback of a menu item is a symbol, then it must name -a command. It will be invoked with @code{call-interactively}. If it is -a list, then it is evaluated with @code{eval}. - -The valid keywords and their meanings are described below. - -Note that for compatibility purposes, the form - -@example -@code{[ @var{name} @var{callback} @var{active-p} ]} -@end example - -is also accepted and is equivalent to - -@example -@code{[ @var{name} @var{callback} :active @var{active-p} ]} -@end example - -and the form - -@example -@code{[ @var{name} @var{callback} @var{active-p} @var{suffix}]} -@end example - -is accepted and is equivalent to - -@example -@code{[ @var{name} @var{callback} :active @var{active-p} :suffix @var{suffix}]} -@end example - -However, these older forms are deprecated and should generally not be used. - -@item -If an element of a menu is a string, then that string will be presented -in the menu as unselectable text. - -@item -If an element of a menu is a string consisting solely of hyphens, then -that item will be presented as a solid horizontal line. - -@item -If an element of a menu is a string beginning with @samp{--:}, then -a particular sort of horizontal line will be displayed, as follows: - -@table @samp -@item "--:singleLine" -A solid horizontal line. This is equivalent to a string consisting -solely of hyphens. -@item "--:doubleLine" -A solid double horizontal line. -@item "--:singleDashedLine" -A dashed horizontal line. -@item "--:doubleDashedLine" -A dashed double horizontal line. -@item "--:noLine" -No line (but a small space is left). -@item "--:shadowEtchedIn" -A solid horizontal line with a 3-d recessed appearance. -@item "--:shadowEtchedOut" -A solid horizontal line with a 3-d pushed-out appearance. -@item "--:shadowDoubleEtchedIn" -A solid double horizontal line with a 3-d recessed appearance. -@item "--:shadowDoubleEtchedOut" -A solid double horizontal line with a 3-d pushed-out appearance. -@item "--:shadowEtchedInDash" -A dashed horizontal line with a 3-d recessed appearance. -@item "--:shadowEtchedOutDash" -A dashed horizontal line with a 3-d pushed-out appearance. -@item "--:shadowDoubleEtchedInDash" -A dashed double horizontal line with a 3-d recessed appearance. -@item "--:shadowDoubleEtchedOutDash" -A dashed double horizontal line with a 3-d pushed-out appearance. -@end table - -@item -If an element of a menu is a list, it is treated as a submenu. The name -of that submenu (the first element in the list) will be used as the name -of the item representing this menu on the parent. -@end itemize - -The possible keywords are as follows: - -@table @asis -@item :active @var{form} -@var{form} will be evaluated when the menu that this item is a part of -is about to be displayed, and the item will be selectable only if the -result is non-@code{nil}. If the item is unselectable, it will -usually be displayed grayed-out to indicate this. - -@item :suffix @var{form} -@var{form} will be evaluated when the menu that this item is a part of -is about to be displayed, and the resulting string is appended to the -displayed name. This provides a convenient way of adding the name of a -command's ``argument'' to the menu, like @samp{Kill Buffer NAME}. - -@item :keys @var{string} -Normally, the keyboard equivalents of commands in menus are displayed -when the ``callback'' is a symbol. This can be used to specify keys for -more complex menu items. It is passed through -@code{substitute-command-keys} first. - -@item :style @var{style} -Specifies what kind of object this menu item is. @var{style} be one -of the symbols - -@table @code -@item nil -A normal menu item. -@item toggle -A toggle button. -@item radio -A radio button. -@item button -A menubar button. -@end table - -The only difference between toggle and radio buttons is how they are -displayed. But for consistency, a toggle button should be used when -there is one option whose value can be turned on or off, and radio -buttons should be used when there is a set of mutually exclusive options. -When using a group of radio buttons, you should arrange for no more than -one to be marked as selected at a time. - -@item :selected @var{form} -Meaningful only when @var{style} is @code{toggle}, @code{radio} or -@code{button}. This specifies whether the button will be in the -selected or unselected state. @var{form} is evaluated, as for -@code{:active}. - -@item :included @var{form} -This can be used to control the visibility of a menu item. The form is -evaluated and the menu item is only displayed if the result is -non-@code{nil}. Note that this is different from @code{:active}: If -@code{:active} evaluates to @code{nil}, the item will be displayed -grayed out, while if @code{:included} evaluates to @code{nil}, the item -will be omitted entirely. - -@item :config @var{symbol} -This is an efficient shorthand for @code{:included (memq @var{symbol} -menubar-configuration)}. See the variable @code{menubar-configuration}. - -@item :accelerator @var{key} -A menu accelerator is a keystroke which can be pressed while the menu is -visible which will immediately activate the item. @var{key} must be a char -or the symbol name of a key. @xref{Menu Accelerators}. -@end table - -@defvar menubar-configuration -This variable holds a list of symbols, against which the value of the -@code{:config} tag for each menubar item will be compared. If a menubar -item has a @code{:config} tag, then it is omitted from the menubar if -that tag is not a member of the @code{menubar-configuration} list. -@end defvar - -For example: - -@example - ("File" - :filter file-menu-filter ; file-menu-filter is a function that takes - ; one argument (a list of menu items) and - ; returns a list of menu items - [ "Save As..." write-file] - [ "Revert Buffer" revert-buffer :active (buffer-modified-p) ] - [ "Read Only" toggle-read-only :style toggle :selected buffer-read-only ] - ) -@end example - -@node Menubar Format -@section Format of the Menubar -@cindex menubar format -@cindex format of the menubar - -A menubar is a list of menus, menu items, and strings. The format is -similar to that of a menu, except: - -@itemize @bullet -@item -The first item need not be a string, and is not treated specially. - -@item -A string consisting solely of hyphens is not treated specially. - -@item -If an element of a menubar is @code{nil}, then it is used to represent -the division between the set of menubar items which are flush-left and -those which are flush-right. (Note: this isn't completely implemented -yet.) -@end itemize - -@node Menubar -@section Menubar -@cindex menubar - -@defvar current-menubar -This variable holds the description of the current menubar. This may be -buffer-local. When the menubar is changed, the function -@code{set-menubar-dirty-flag} has to be called in order for the menubar -to be updated on the screen. -@end defvar - -@defvr Constant default-menubar -This variable holds the menubar description of the menubar that is -visible at startup. This is the value that @code{current-menubar} -has at startup. -@end defvr - -@defun set-menubar-dirty-flag -This function tells XEmacs that the menubar widget has to be updated. -Changes to the menubar will generally not be visible until this function -is called. -@end defun - -The following convenience functions are provided for setting the -menubar. They are equivalent to doing the appropriate action to change -@code{current-menubar}, and then calling @code{set-menubar-dirty-flag}. -Note that these functions copy their argument using -@code{copy-sequence}. - -@defun set-menubar menubar -This function sets the default menubar to be @var{menubar} (@pxref{Menu -Format}). This is the menubar that will be visible in buffers that -have not defined their own, buffer-local menubar. -@end defun - -@defun set-buffer-menubar menubar -This function sets the buffer-local menubar to be @var{menubar}. This -does not change the menubar in any buffers other than the current one. -@end defun - -Miscellaneous: - -@defvar menubar-show-keybindings -If true, the menubar will display keyboard equivalents. If false, only -the command names will be displayed. -@end defvar - -@defvar activate-menubar-hook -Function or functions called before a menubar menu is pulled down. -These functions are called with no arguments, and should interrogate and -modify the value of @code{current-menubar} as desired. - -The functions on this hook are invoked after the mouse goes down, but -before the menu is mapped, and may be used to activate, deactivate, add, -or delete items from the menus. However, using a filter (with the -@code{:filter} keyword in a menu description) is generally a more -efficient way of accomplishing the same thing, because the filter is -invoked only when the actual menu goes down. With a complex menu, -there can be a quite noticeable and sometimes aggravating delay if -all menu modification is implemented using the @code{activate-menubar-hook}. -See above. - -These functions may return the symbol @code{t} to assert that they have -made no changes to the menubar. If any other value is returned, the -menubar is recomputed. If @code{t} is returned but the menubar has been -changed, then the changes may not show up right away. Returning -@code{nil} when the menubar has not changed is not so bad; more -computation will be done, but redisplay of the menubar will still be -performed optimally. -@end defvar - -@defvar menu-no-selection-hook -Function or functions to call when a menu or dialog box is dismissed -without a selection having been made. -@end defvar - -@node Modifying Menus -@section Modifying Menus - -The following functions are provided to modify the menubar of one of its -submenus. Note that these functions modify the menu in-place, rather -than copying it and making a new menu. - -Some of these functions take a @dfn{menu path}, which is a list of -strings identifying the menu to be modified. For example, -@code{("File")} names the top-level ``File'' menu. @code{("File" -"Foo")} names a hypothetical submenu of ``File''. - -Others take a @dfn{menu item path}, which is similar to a menu path but -also specifies a particular item to be modified. For example, -@code{("File" "Save")} means the menu item called ``Save'' under the -top-level ``File'' menu. @code{("Menu" "Foo" "Item")} means the menu -item called ``Item'' under the ``Foo'' submenu of ``Menu''. - -@defun add-submenu menu-path submenu &optional before -This function adds a menu to the menubar or one of its submenus. If the -named menu exists already, it is changed. - -@var{menu-path} identifies the menu under which the new menu should be -inserted. If @var{menu-path} is @code{nil}, then the menu will be added -to the menubar itself. - -@var{submenu} is the new menu to add (@pxref{Menu Format}). - -@var{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. -@end defun - -@defun add-menu-button menu-path menu-leaf &optional before -This function adds a menu item to some menu, creating the menu first if -necessary. If the named item exists already, it is changed. - -@var{menu-path} identifies the menu under which the new menu item should -be inserted. - -@var{menu-leaf} is a menubar leaf node (@pxref{Menu Format}). - -@var{before}, if provided, is the name of a menu before which this item -should be added, if this item is not on the menu already. If the item -is already present, it will not be moved. -@end defun - -@defun delete-menu-item menu-item-path -This function removes the menu item specified by @var{menu-item-path} -from the menu hierarchy. -@end defun - -@defun enable-menu-item menu-item-path -This function makes the menu item specified by @var{menu-item-path} be -selectable. -@end defun - -@defun disable-menu-item menu-item-path -This function makes the menu item specified by @var{menu-item-path} be -unselectable. -@end defun - -@defun relabel-menu-item menu-item-path new-name -This function changes the string of the menu item specified by -@var{menu-item-path}. @var{new-name} is the string that the menu item -will be printed as from now on. -@end defun - -The following function can be used to search for a particular item in -a menubar specification, given a path to the item. - -@defun find-menu-item menubar menu-item-path &optional parent -This function searches @var{menubar} for the item given by -@var{menu-item-path} starting from @var{parent} (@code{nil} means start -at the top of @var{menubar}). This function returns @code{(@var{item} -. @var{parent})}, where @var{parent} is the immediate parent of the item -found (a menu description), and @var{item} is either a vector, list, or -string, depending on the nature of the menu item. - -This function signals an error if the item is not found. -@end defun - -The following deprecated functions are also documented, so that -existing code can be understood. You should not use these functions -in new code. - -@defun add-menu menu-path menu-name menu-items &optional before -This function adds a menu to the menubar or one of its submenus. If the -named menu exists already, it is changed. This is obsolete; use -@code{add-submenu} instead. - -@var{menu-path} identifies the menu under which the new menu should be -inserted. If @var{menu-path} is @code{nil}, then the menu will be added -to the menubar itself. - -@var{menu-name} is the string naming the menu to be added; -@var{menu-items} is a list of menu items, strings, and submenus. These -two arguments are the same as the first and following elements of a menu -description (@pxref{Menu Format}). - -@var{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. -@end defun - -@defun add-menu-item menu-path item-name function enabled-p &optional before -This function adds a menu item to some menu, creating the menu first if -necessary. If the named item exists already, it is changed. This is -obsolete; use @code{add-menu-button} instead. - -@var{menu-path} identifies the menu under which the new menu item should -be inserted. @var{item-name}, @var{function}, and @var{enabled-p} are -the first, second, and third elements of a menu item vector (@pxref{Menu -Format}). - -@var{before}, if provided, is the name of a menu item before which this -item should be added, if this item is not on the menu already. If the -item is already present, it will not be moved. -@end defun - -@node Menu Filters -@section Menu Filters -@cindex menu filters - -The following filter functions are provided for use in -@code{default-menubar}. You may want to use them in your own menubar -description. - -@defun file-menu-filter menu-items -This function changes the arguments and sensitivity of these File menu items: - -@table @samp -@item Delete Buffer -Has the name of the current buffer appended to it. -@item Print Buffer -Has the name of the current buffer appended to it. -@item Pretty-Print Buffer -Has the name of the current buffer appended to it. -@item Save Buffer -Has the name of the current buffer appended to it, and is sensitive only -when the current buffer is modified. -@item Revert Buffer -Has the name of the current buffer appended to it, and is sensitive only -when the current buffer has a file. -@item Delete Frame -Sensitive only when there is more than one visible frame. -@end table -@end defun - -@defun edit-menu-filter menu-items -This function changes the arguments and sensitivity of these Edit menu items: - -@table @samp -@item Cut -Sensitive only when XEmacs owns the primary X Selection (if -@code{zmacs-regions} is @code{t}, this is equivalent to saying that -there is a region selected). -@item Copy -Sensitive only when XEmacs owns the primary X Selection. -@item Clear -Sensitive only when XEmacs owns the primary X Selection. -@item Paste -Sensitive only when there is an owner for the X Clipboard Selection. -@item Undo -Sensitive only when there is undo information. While in the midst of an -undo, this is changed to @samp{Undo More}. -@end table -@end defun - -@defun buffers-menu-filter menu-items -This function sets up the Buffers menu. @xref{Buffers Menu} for -more information. -@end defun - -@node Pop-Up Menus -@section Pop-Up Menus -@cindex pop-up menu - -@defun popup-menu menu-desc -This function pops up a menu specified by @var{menu-desc}, which is a -menu description (@pxref{Menu Format}). The menu is displayed at the -current mouse position. -@end defun - -@defun popup-menu-up-p -This function returns @code{t} if a pop-up menu is up, @code{nil} -otherwise. -@end defun - -@defvar popup-menu-titles -If true (the default), pop-up menus will have title bars at the top. -@end defvar - -Some machinery is provided that attempts to provide a higher-level -mechanism onto pop-up menus. This only works if you do not redefine -the binding for button3. - -@deffn Command popup-mode-menu -This function pops up a menu of global and mode-specific commands. The -menu is computed by combining @code{global-popup-menu} and -@code{mode-popup-menu}. This is the default binding for button3. -You should generally not change this binding. -@end deffn - -@defvar global-popup-menu -This holds the global popup menu. This is present in all modes. -(This is @code{nil} by default.) -@end defvar - -@defvar mode-popup-menu -The mode-specific popup menu. Automatically buffer local. -This is appended to the default items in @code{global-popup-menu}. -@end defvar - -@defvr Constant default-popup-menu -This holds the default value of @code{mode-popup-menu}. -@end defvr - -@defvar activate-popup-menu-hook -Function or functions run before a mode-specific popup menu is made -visible. These functions are called with no arguments, and should -interrogate and modify the value of @code{global-popup-menu} or -@code{mode-popup-menu} as desired. Note: this hook is only run if you -use @code{popup-mode-menu} for activating the global and mode-specific -commands; if you have your own binding for button3, this hook won't be -run. -@end defvar - -The following convenience functions are provided for displaying -pop-up menus. - -@defun popup-buffer-menu event -This function pops up a copy of the @samp{Buffers} menu (from the menubar) -where the mouse is clicked. -@end defun - -@defun popup-menubar-menu event -This function pops up a copy of menu that also appears in the menubar. -@end defun - -@node Menu Accelerators -@section Menu Accelerators -@cindex menu accelerators -@cindex keyboard menu accelerators - -Menu accelerators are keyboard shortcuts for accessing the menubar. -Accelerator keys can be specified for menus as well as for menu items. An -accelerator key for a menu is used to activate that menu when it appears as a -submenu of another menu. An accelerator key for a menu item is used to -activate that item. - -@menu -* Creating Menu Accelerators:: How to add accelerator keys to a menu. -* Keyboard Menu Traversal:: How to use and modify the keys which are used - to traverse the menu structure. -* Menu Accelerator Functions:: Functions for working with menu accelerators. -@end menu - -@node Creating Menu Accelerators -@subsection Creating Menu Accelerators - -Menu accelerators are specified as part of the menubar format using the -:accelerator tag to specify a key or by placing "%_" in the menu or menu item -name prior to the letter which is to be used as the accelerator key. The -advantage of the second method is that the menu rendering code then knows to -draw an underline under that character, which is the canonical way of -indicating an accelerator key to a user. - -For example, the command - -@example -(add-submenu nil '("%_Test" - ["One" (insert "1") :accelerator ?1 :active t] - ["%_Two" (insert "2")] - ["%_3" (insert "3")])) -@end example - -will add a new menu to the top level menubar. The new menu can be reached -by pressing "t" while the top level menubar is active. When the menu is -active, pressing "1" will activate the first item and insert the character -"1" into the buffer. Pressing "2" will activate the second item and insert -the character "2" into the buffer. Pressing "3" will activate the third item -and insert the character "3" into the buffer. - -It is possible to activate the top level menubar itself using accelerator keys. -@xref{Menu Accelerator Functions}. - -@node Keyboard Menu Traversal -@subsection Keyboard Menu Traversal - -In addition to immediately activating a menu or menu item, the keyboard can -be used to traverse the menus without activating items. The keyboard arrow -keys, the return key and the escape key are defined to traverse the menus in a -way that should be familiar to users of any of a certain family of popular PC -operating systems. - -This behavior can be changed by modifying the bindings in -menu-accelerator-map. At this point, the online help is your best bet -for more information about how to modify the menu traversal keys. - -@node Menu Accelerator Functions -@subsection Menu Accelerator Functions - -@defun accelerate-menu -Make the menubar immediately active and place the cursor on the left most entry -in the top level menu. Menu items can be selected as usual. -@end defun - -@defvar menu-accelerator-enabled -Whether menu accelerator keys can cause the menubar to become active. - -If @code{menu-force} or @code{menu-fallback}, then menu accelerator keys can -be used to activate the top level menu. Once the menubar becomes active, the -accelerator keys can be used regardless of the value of this variable. - -@code{menu-force} is used to indicate that the menu accelerator key takes -precedence over bindings in the current keymap(s). @code{menu-fallback} means -that bindings in the current keymap take precedence over menu accelerator keys. -Thus a top level menu with an accelerator of "T" would be activated on a -keypress of Meta-t if @var{menu-accelerator-enabled} is @code{menu-force}. -However, if @var{menu-accelerator-enabled} is @code{menu-fallback}, then -Meta-t will not activate the menubar and will instead run the function -transpose-words, to which it is normally bound. - -The default value is @code{nil}. - -See also @var{menu-accelerator-modifiers} and @var{menu-accelerator-prefix}. -@end defvar - -@defvar menu-accelerator-map -Keymap consulted to determine the commands to run in response to keypresses -occurring while the menubar is active. @xref{Keyboard Menu Traversal}. -@end defvar - -@defvar menu-accelerator-modifiers -A list of modifier keys which must be pressed in addition to a valid menu -accelerator in order for the top level menu to be activated in response to -a keystroke. The default value of @code{(meta)} mirrors the usage of the alt key -as a menu accelerator in popular PC operating systems. - -The modifier keys in @var{menu-accelerator-modifiers} must match exactly the -modifiers present in the keypress. The only exception is that the shift -modifier is accepted in conjunction with alphabetic keys even if it is not -a menu accelerator modifier. - -See also @var{menu-accelerator-enabled} and @var{menu-accelerator-prefix}. -@end defvar - -@defvar menu-accelerator-prefix -Prefix key(s) that must be typed before menu accelerators will be activated. -Must be a valid key descriptor. - -The default value is @code{nil}. -@end defvar - -@example -(setq menu-accelerator-prefix ?\C-x) -(setq menu-accelerator-modifiers '(meta control)) -(setq menu-accelerator-enabled 'menu-force) -(add-submenu nil '("%_Test" - ["One" (insert "1") :accelerator ?1 :active t] - ["%_Two" (insert "2")] - ["%_3" (insert "3")])) -@end example - -will add the menu "Test" to the top level menubar. Pressing C-x followed by -C-M-T will activate the menubar and display the "Test" menu. Pressing -C-M-T by itself will not activate the menubar. Neither will pressing C-x -followed by anything else. - -@node Buffers Menu -@section Buffers Menu -@cindex buffers menu - -The following options control how the @samp{Buffers} menu is displayed. -This is a list of all (or a subset of) the buffers currently in existence, -and is updated dynamically. - -@defopt buffers-menu-max-size -This user option holds the maximum number of entries which may appear on -the @samp{Buffers} menu. If this is 10, then only the ten -most-recently-selected buffers will be shown. If this is @code{nil}, -then all buffers will be shown. Setting this to a large number or -@code{nil} will slow down menu responsiveness. -@end defopt - -@defun format-buffers-menu-line buffer -This function returns a string to represent @var{buffer} in the -@samp{Buffers} menu. @code{nil} means the buffer shouldn't be listed. -You can redefine this. -@end defun - -@defopt complex-buffers-menu-p -If true, the @samp{Buffers} menu will contain several commands, as submenus -of each buffer line. If this is false, then there will be only one command: -select that buffer. -@end defopt - -@defopt buffers-menu-switch-to-buffer-function -This user option holds the function to call to select a buffer from the -@samp{Buffers} menu. @code{switch-to-buffer} is a good choice, as is -@code{pop-to-buffer}. -@end defopt - diff --git a/man/lispref/minibuf.texi b/man/lispref/minibuf.texi deleted file mode 100644 index 4e66083..0000000 --- a/man/lispref/minibuf.texi +++ /dev/null @@ -1,1479 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/minibuf.info -@node Minibuffers, Command Loop, Read and Print, Top -@chapter Minibuffers -@cindex arguments, reading -@cindex complex arguments -@cindex minibuffer - - A @dfn{minibuffer} is a special buffer that XEmacs commands use to read -arguments more complicated than the single numeric prefix argument. -These arguments include file names, buffer names, and command names (as -in @kbd{M-x}). The minibuffer is displayed on the bottom line of the -frame, in the same place as the echo area, but only while it is in -use for reading an argument. - -@menu -* Intro to Minibuffers:: Basic information about minibuffers. -* Text from Minibuffer:: How to read a straight text string. -* Object from Minibuffer:: How to read a Lisp object or expression. -* Minibuffer History:: Recording previous minibuffer inputs - so the user can reuse them. -* Completion:: How to invoke and customize completion. -* Yes-or-No Queries:: Asking a question with a simple answer. -* Multiple Queries:: Asking a series of similar questions. -* Minibuffer Misc:: Various customization hooks and variables. -@end menu - -@node Intro to Minibuffers -@section Introduction to Minibuffers - - In most ways, a minibuffer is a normal XEmacs buffer. Most operations -@emph{within} a buffer, such as editing commands, work normally in a -minibuffer. However, many operations for managing buffers do not apply -to minibuffers. The name of a minibuffer always has the form @w{@samp{ -*Minibuf-@var{number}}}, and it cannot be changed. Minibuffers are -displayed only in special windows used only for minibuffers; these -windows always appear at the bottom of a frame. (Sometime frames have -no minibuffer window, and sometimes a special kind of frame contains -nothing but a minibuffer window; see @ref{Minibuffers and Frames}.) - - The minibuffer's window is normally a single line. You can resize it -temporarily with the window sizing commands; it reverts to its normal -size when the minibuffer is exited. You can resize it permanently by -using the window sizing commands in the frame's other window, when the -minibuffer is not active. If the frame contains just a minibuffer, you -can change the minibuffer's size by changing the frame's size. - - If a command uses a minibuffer while there is an active minibuffer, -this is called a @dfn{recursive minibuffer}. The first minibuffer is -named @w{@samp{ *Minibuf-0*}}. Recursive minibuffers are named by -incrementing the number at the end of the name. (The names begin with a -space so that they won't show up in normal buffer lists.) Of several -recursive minibuffers, the innermost (or most recently entered) is the -active minibuffer. We usually call this ``the'' minibuffer. You can -permit or forbid recursive minibuffers by setting the variable -@code{enable-recursive-minibuffers}. - - Like other buffers, a minibuffer may use any of several local keymaps -(@pxref{Keymaps}); these contain various exit commands and in some cases -completion commands (@pxref{Completion}). - -@itemize @bullet -@item -@code{minibuffer-local-map} is for ordinary input (no completion). - -@item -@code{minibuffer-local-ns-map} is similar, except that @key{SPC} exits -just like @key{RET}. This is used mainly for Mocklisp compatibility. - -@item -@code{minibuffer-local-completion-map} is for permissive completion. - -@item -@code{minibuffer-local-must-match-map} is for strict completion and -for cautious completion. -@end itemize - -@node Text from Minibuffer -@section Reading Text Strings with the Minibuffer - - Most often, the minibuffer is used to read text as a string. It can -also be used to read a Lisp object in textual form. The most basic -primitive for minibuffer input is @code{read-from-minibuffer}; it can do -either one. - - In most cases, you should not call minibuffer input functions in the -middle of a Lisp function. Instead, do all minibuffer input as part of -reading the arguments for a command, in the @code{interactive} spec. -@xref{Defining Commands}. - -@defun read-from-minibuffer prompt-string &optional initial-contents keymap read hist -This function is the most general way to get input through the -minibuffer. By default, it accepts arbitrary text and returns it as a -string; however, if @var{read} is non-@code{nil}, then it uses -@code{read} to convert the text into a Lisp object (@pxref{Input -Functions}). - -The first thing this function does is to activate a minibuffer and -display it with @var{prompt-string} as the prompt. This value must be a -string. - -Then, if @var{initial-contents} is a string, @code{read-from-minibuffer} -inserts it into the minibuffer, leaving point at the end. The -minibuffer appears with this text as its contents. - -@c Emacs 19 feature -The value of @var{initial-contents} may also be a cons cell of the form -@code{(@var{string} . @var{position})}. This means to insert -@var{string} in the minibuffer but put point @var{position} characters -from the beginning, rather than at the end. - -If @var{keymap} is non-@code{nil}, that keymap is the local keymap to -use in the minibuffer. If @var{keymap} is omitted or @code{nil}, the -value of @code{minibuffer-local-map} is used as the keymap. Specifying -a keymap is the most important way to customize the minibuffer for -various applications such as completion. - -The argument @var{hist} specifies which history list variable to use -for saving the input and for history commands used in the minibuffer. -It defaults to @code{minibuffer-history}. @xref{Minibuffer History}. - -When the user types a command to exit the minibuffer, -@code{read-from-minibuffer} uses the text in the minibuffer to produce -its return value. Normally it simply makes a string containing that -text. However, if @var{read} is non-@code{nil}, -@code{read-from-minibuffer} reads the text and returns the resulting -Lisp object, unevaluated. (@xref{Input Functions}, for information -about reading.) -@end defun - -@defun read-string prompt &optional initial -This function reads a string from the minibuffer and returns it. The -arguments @var{prompt} and @var{initial} are used as in -@code{read-from-minibuffer}. The keymap used is -@code{minibuffer-local-map}. - -This is a simplified interface to the -@code{read-from-minibuffer} function: - -@smallexample -@group -(read-string @var{prompt} @var{initial}) -@equiv{} -(read-from-minibuffer @var{prompt} @var{initial} nil nil nil) -@end group -@end smallexample -@end defun - -@defvar minibuffer-local-map -This is the default local keymap for reading from the minibuffer. By -default, it makes the following bindings: - -@table @asis -@item @key{LFD} -@code{exit-minibuffer} - -@item @key{RET} -@code{exit-minibuffer} - -@item @kbd{C-g} -@code{abort-recursive-edit} - -@item @kbd{M-n} -@code{next-history-element} - -@item @kbd{M-p} -@code{previous-history-element} - -@item @kbd{M-r} -@code{next-matching-history-element} - -@item @kbd{M-s} -@code{previous-matching-history-element} -@end table -@end defvar - -@c In version 18, initial is required -@c Emacs 19 feature -@defun read-no-blanks-input prompt &optional initial -This function reads a string from the minibuffer, but does not allow -whitespace characters as part of the input: instead, those characters -terminate the input. The arguments @var{prompt} and @var{initial} are -used as in @code{read-from-minibuffer}. - -This is a simplified interface to the @code{read-from-minibuffer} -function, and passes the value of the @code{minibuffer-local-ns-map} -keymap as the @var{keymap} argument for that function. Since the keymap -@code{minibuffer-local-ns-map} does not rebind @kbd{C-q}, it @emph{is} -possible to put a space into the string, by quoting it. - -@smallexample -@group -(read-no-blanks-input @var{prompt} @var{initial}) -@equiv{} -(read-from-minibuffer @var{prompt} @var{initial} minibuffer-local-ns-map) -@end group -@end smallexample -@end defun - -@defvar minibuffer-local-ns-map -This built-in variable is the keymap used as the minibuffer local keymap -in the function @code{read-no-blanks-input}. By default, it makes the -following bindings, in addition to those of @code{minibuffer-local-map}: - -@table @asis -@item @key{SPC} -@cindex @key{SPC} in minibuffer -@code{exit-minibuffer} - -@item @key{TAB} -@cindex @key{TAB} in minibuffer -@code{exit-minibuffer} - -@item @kbd{?} -@cindex @kbd{?} in minibuffer -@code{self-insert-and-exit} -@end table -@end defvar - -@node Object from Minibuffer -@section Reading Lisp Objects with the Minibuffer - - This section describes functions for reading Lisp objects with the -minibuffer. - -@defun read-minibuffer prompt &optional initial -This function reads a Lisp object in the minibuffer and returns it, -without evaluating it. The arguments @var{prompt} and @var{initial} are -used as in @code{read-from-minibuffer}. - -This is a simplified interface to the -@code{read-from-minibuffer} function: - -@smallexample -@group -(read-minibuffer @var{prompt} @var{initial}) -@equiv{} -(read-from-minibuffer @var{prompt} @var{initial} nil t) -@end group -@end smallexample - -Here is an example in which we supply the string @code{"(testing)"} as -initial input: - -@smallexample -@group -(read-minibuffer - "Enter an expression: " (format "%s" '(testing))) - -;; @r{Here is how the minibuffer is displayed:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -Enter an expression: (testing)@point{} ----------- Buffer: Minibuffer ---------- -@end group -@end smallexample - -@noindent -The user can type @key{RET} immediately to use the initial input as a -default, or can edit the input. -@end defun - -@defun eval-minibuffer prompt &optional initial -This function reads a Lisp expression in the minibuffer, evaluates it, -then returns the result. The arguments @var{prompt} and @var{initial} -are used as in @code{read-from-minibuffer}. - -This function simply evaluates the result of a call to -@code{read-minibuffer}: - -@smallexample -@group -(eval-minibuffer @var{prompt} @var{initial}) -@equiv{} -(eval (read-minibuffer @var{prompt} @var{initial})) -@end group -@end smallexample -@end defun - -@defun edit-and-eval-command prompt form -This function reads a Lisp expression in the minibuffer, and then -evaluates it. The difference between this command and -@code{eval-minibuffer} is that here the initial @var{form} is not -optional and it is treated as a Lisp object to be converted to printed -representation rather than as a string of text. It is printed with -@code{prin1}, so if it is a string, double-quote characters (@samp{"}) -appear in the initial text. @xref{Output Functions}. - -The first thing @code{edit-and-eval-command} does is to activate the -minibuffer with @var{prompt} as the prompt. Then it inserts the printed -representation of @var{form} in the minibuffer, and lets the user edit. -When the user exits the minibuffer, the edited text is read with -@code{read} and then evaluated. The resulting value becomes the value -of @code{edit-and-eval-command}. - -In the following example, we offer the user an expression with initial -text which is a valid form already: - -@smallexample -@group -(edit-and-eval-command "Please edit: " '(forward-word 1)) - -;; @r{After evaluation of the preceding expression,} -;; @r{the following appears in the minibuffer:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -Please edit: (forward-word 1)@point{} ----------- Buffer: Minibuffer ---------- -@end group -@end smallexample - -@noindent -Typing @key{RET} right away would exit the minibuffer and evaluate the -expression, thus moving point forward one word. -@code{edit-and-eval-command} returns @code{t} in this example. -@end defun - -@node Minibuffer History -@section Minibuffer History -@cindex minibuffer history -@cindex history list - -A @dfn{minibuffer history list} records previous minibuffer inputs so -the user can reuse them conveniently. A history list is actually a -symbol, not a list; it is a variable whose value is a list of strings -(previous inputs), most recent first. - -There are many separate history lists, used for different kinds of -inputs. It's the Lisp programmer's job to specify the right history -list for each use of the minibuffer. - -The basic minibuffer input functions @code{read-from-minibuffer} and -@code{completing-read} both accept an optional argument named @var{hist} -which is how you specify the history list. Here are the possible -values: - -@table @asis -@item @var{variable} -Use @var{variable} (a symbol) as the history list. - -@item (@var{variable} . @var{startpos}) -Use @var{variable} (a symbol) as the history list, and assume that the -initial history position is @var{startpos} (an integer, counting from -zero which specifies the most recent element of the history). - -If you specify @var{startpos}, then you should also specify that element -of the history as the initial minibuffer contents, for consistency. -@end table - -If you don't specify @var{hist}, then the default history list -@code{minibuffer-history} is used. For other standard history lists, -see below. You can also create your own history list variable; just -initialize it to @code{nil} before the first use. - -Both @code{read-from-minibuffer} and @code{completing-read} add new -elements to the history list automatically, and provide commands to -allow the user to reuse items on the list. The only thing your program -needs to do to use a history list is to initialize it and to pass its -name to the input functions when you wish. But it is safe to modify the -list by hand when the minibuffer input functions are not using it. - -@defvar minibuffer-history -The default history list for minibuffer history input. -@end defvar - -@defvar query-replace-history -A history list for arguments to @code{query-replace} (and similar -arguments to other commands). -@end defvar - -@defvar file-name-history -A history list for file name arguments. -@end defvar - -@defvar regexp-history -A history list for regular expression arguments. -@end defvar - -@defvar extended-command-history -A history list for arguments that are names of extended commands. -@end defvar - -@defvar shell-command-history -A history list for arguments that are shell commands. -@end defvar - -@defvar read-expression-history -A history list for arguments that are Lisp expressions to evaluate. -@end defvar - -@defvar Info-minibuffer-history -A history list for Info mode's minibuffer. -@end defvar - -@defvar Manual-page-minibuffer-history -A history list for @code{manual-entry}. -@end defvar - - There are many other minibuffer history lists, defined by various -libraries. An @kbd{M-x apropos} search for @samp{history} should prove -fruitful in discovering them. - -@node Completion -@section Completion -@cindex completion - - @dfn{Completion} is a feature that fills in the rest of a name -starting from an abbreviation for it. Completion works by comparing the -user's input against a list of valid names and determining how much of -the name is determined uniquely by what the user has typed. For -example, when you type @kbd{C-x b} (@code{switch-to-buffer}) and then -type the first few letters of the name of the buffer to which you wish -to switch, and then type @key{TAB} (@code{minibuffer-complete}), Emacs -extends the name as far as it can. - - Standard XEmacs commands offer completion for names of symbols, files, -buffers, and processes; with the functions in this section, you can -implement completion for other kinds of names. - - The @code{try-completion} function is the basic primitive for -completion: it returns the longest determined completion of a given -initial string, with a given set of strings to match against. - - The function @code{completing-read} provides a higher-level interface -for completion. A call to @code{completing-read} specifies how to -determine the list of valid names. The function then activates the -minibuffer with a local keymap that binds a few keys to commands useful -for completion. Other functions provide convenient simple interfaces -for reading certain kinds of names with completion. - -@menu -* Basic Completion:: Low-level functions for completing strings. - (These are too low level to use the minibuffer.) -* Minibuffer Completion:: Invoking the minibuffer with completion. -* Completion Commands:: Minibuffer commands that do completion. -* High-Level Completion:: Convenient special cases of completion - (reading buffer name, file name, etc.) -* Reading File Names:: Using completion to read file names. -* Programmed Completion:: Finding the completions for a given file name. -@end menu - -@node Basic Completion -@subsection Basic Completion Functions - - The two functions @code{try-completion} and @code{all-completions} -have nothing in themselves to do with minibuffers. We describe them in -this chapter so as to keep them near the higher-level completion -features that do use the minibuffer. - -@defun try-completion string collection &optional predicate -This function returns the longest common substring of all possible -completions of @var{string} in @var{collection}. The value of -@var{collection} must be an alist, an obarray, or a function that -implements a virtual set of strings (see below). - -Completion compares @var{string} against each of the permissible -completions specified by @var{collection}; if the beginning of the -permissible completion equals @var{string}, it matches. If no permissible -completions match, @code{try-completion} returns @code{nil}. If only -one permissible completion matches, and the match is exact, then -@code{try-completion} returns @code{t}. Otherwise, the value is the -longest initial sequence common to all the permissible completions that -match. - -If @var{collection} is an alist (@pxref{Association Lists}), the -@sc{car}s of the alist elements form the set of permissible completions. - -@cindex obarray in completion -If @var{collection} is an obarray (@pxref{Creating Symbols}), the names -of all symbols in the obarray form the set of permissible completions. The -global variable @code{obarray} holds an obarray containing the names of -all interned Lisp symbols. - -Note that the only valid way to make a new obarray is to create it -empty and then add symbols to it one by one using @code{intern}. -Also, you cannot intern a given symbol in more than one obarray. - -If the argument @var{predicate} is non-@code{nil}, then it must be a -function of one argument. It is used to test each possible match, and -the match is accepted only if @var{predicate} returns non-@code{nil}. -The argument given to @var{predicate} is either a cons cell from the alist -(the @sc{car} of which is a string) or else it is a symbol (@emph{not} a -symbol name) from the obarray. - -You can also use a symbol that is a function as @var{collection}. Then -the function is solely responsible for performing completion; -@code{try-completion} returns whatever this function returns. The -function is called with three arguments: @var{string}, @var{predicate} -and @code{nil}. (The reason for the third argument is so that the same -function can be used in @code{all-completions} and do the appropriate -thing in either case.) @xref{Programmed Completion}. - -In the first of the following examples, the string @samp{foo} is -matched by three of the alist @sc{car}s. All of the matches begin with -the characters @samp{fooba}, so that is the result. In the second -example, there is only one possible match, and it is exact, so the value -is @code{t}. - -@smallexample -@group -(try-completion - "foo" - '(("foobar1" 1) ("barfoo" 2) ("foobaz" 3) ("foobar2" 4))) - @result{} "fooba" -@end group - -@group -(try-completion "foo" '(("barfoo" 2) ("foo" 3))) - @result{} t -@end group -@end smallexample - -In the following example, numerous symbols begin with the characters -@samp{forw}, and all of them begin with the word @samp{forward}. In -most of the symbols, this is followed with a @samp{-}, but not in all, -so no more than @samp{forward} can be completed. - -@smallexample -@group -(try-completion "forw" obarray) - @result{} "forward" -@end group -@end smallexample - -Finally, in the following example, only two of the three possible -matches pass the predicate @code{test} (the string @samp{foobaz} is -too short). Both of those begin with the string @samp{foobar}. - -@smallexample -@group -(defun test (s) - (> (length (car s)) 6)) - @result{} test -@end group -@group -(try-completion - "foo" - '(("foobar1" 1) ("barfoo" 2) ("foobaz" 3) ("foobar2" 4)) - 'test) - @result{} "foobar" -@end group -@end smallexample -@end defun - -@defun all-completions string collection &optional predicate nospace -This function returns a list of all possible completions of -@var{string}. The parameters to this function are the same as to -@code{try-completion}. - -If @var{collection} is a function, it is called with three arguments: -@var{string}, @var{predicate} and @code{t}; then @code{all-completions} -returns whatever the function returns. @xref{Programmed Completion}. - -If @var{nospace} is non-@code{nil}, completions that start with a space -are ignored unless @var{string} also starts with a space. - -Here is an example, using the function @code{test} shown in the -example for @code{try-completion}: - -@smallexample -@group -(defun test (s) - (> (length (car s)) 6)) - @result{} test -@end group - -@group -(all-completions - "foo" - '(("foobar1" 1) ("barfoo" 2) ("foobaz" 3) ("foobar2" 4)) - 'test) - @result{} ("foobar1" "foobar2") -@end group -@end smallexample -@end defun - -@defvar completion-ignore-case -If the value of this variable is -non-@code{nil}, XEmacs does not consider case significant in completion. -@end defvar - -@node Minibuffer Completion -@subsection Completion and the Minibuffer - - This section describes the basic interface for reading from the -minibuffer with completion. - -@defun completing-read prompt collection &optional predicate require-match initial hist -This function reads a string in the minibuffer, assisting the user by -providing completion. It activates the minibuffer with prompt -@var{prompt}, which must be a string. If @var{initial} is -non-@code{nil}, @code{completing-read} inserts it into the minibuffer as -part of the input. Then it allows the user to edit the input, providing -several commands to attempt completion. - -The actual completion is done by passing @var{collection} and -@var{predicate} to the function @code{try-completion}. This happens in -certain commands bound in the local keymaps used for completion. - -If @var{require-match} is @code{t}, the usual minibuffer exit commands -won't exit unless the input completes to an element of @var{collection}. -If @var{require-match} is neither @code{nil} nor @code{t}, then the exit -commands won't exit unless the input typed is itself an element of -@var{collection}. If @var{require-match} is @code{nil}, the exit -commands work regardless of the input in the minibuffer. - -The user can exit with null input by typing @key{RET} with an empty -minibuffer. Then @code{completing-read} returns @code{nil}. This is -how the user requests whatever default the command uses for the value -being read. The user can return using @key{RET} in this way regardless -of the value of @var{require-match}. - -The function @code{completing-read} works by calling -@code{read-minibuffer}. It uses @code{minibuffer-local-completion-map} -as the keymap if @var{require-match} is @code{nil}, and uses -@code{minibuffer-local-must-match-map} if @var{require-match} is -non-@code{nil}. @xref{Completion Commands}. - -The argument @var{hist} specifies which history list variable to use for -saving the input and for minibuffer history commands. It defaults to -@code{minibuffer-history}. @xref{Minibuffer History}. - -Completion ignores case when comparing the input against the possible -matches, if the built-in variable @code{completion-ignore-case} is -non-@code{nil}. @xref{Basic Completion}. - -Here's an example of using @code{completing-read}: - -@smallexample -@group -(completing-read - "Complete a foo: " - '(("foobar1" 1) ("barfoo" 2) ("foobaz" 3) ("foobar2" 4)) - nil t "fo") -@end group - -@group -;; @r{After evaluation of the preceding expression,} -;; @r{the following appears in the minibuffer:} - ----------- Buffer: Minibuffer ---------- -Complete a foo: fo@point{} ----------- Buffer: Minibuffer ---------- -@end group -@end smallexample - -@noindent -If the user then types @kbd{@key{DEL} @key{DEL} b @key{RET}}, -@code{completing-read} returns @code{barfoo}. - -The @code{completing-read} function binds three variables to pass -information to the commands that actually do completion. These -variables are @code{minibuffer-completion-table}, -@code{minibuffer-completion-predicate} and -@code{minibuffer-completion-confirm}. For more information about them, -see @ref{Completion Commands}. -@end defun - -@node Completion Commands -@subsection Minibuffer Commands That Do Completion - - This section describes the keymaps, commands and user options used in -the minibuffer to do completion. - -@defvar minibuffer-local-completion-map -@code{completing-read} uses this value as the local keymap when an -exact match of one of the completions is not required. By default, this -keymap makes the following bindings: - -@table @asis -@item @kbd{?} -@code{minibuffer-completion-help} - -@item @key{SPC} -@code{minibuffer-complete-word} - -@item @key{TAB} -@code{minibuffer-complete} -@end table - -@noindent -with other characters bound as in @code{minibuffer-local-map} -(@pxref{Text from Minibuffer}). -@end defvar - -@defvar minibuffer-local-must-match-map -@code{completing-read} uses this value as the local keymap when an -exact match of one of the completions is required. Therefore, no keys -are bound to @code{exit-minibuffer}, the command that exits the -minibuffer unconditionally. By default, this keymap makes the following -bindings: - -@table @asis -@item @kbd{?} -@code{minibuffer-completion-help} - -@item @key{SPC} -@code{minibuffer-complete-word} - -@item @key{TAB} -@code{minibuffer-complete} - -@item @key{LFD} -@code{minibuffer-complete-and-exit} - -@item @key{RET} -@code{minibuffer-complete-and-exit} -@end table - -@noindent -with other characters bound as in @code{minibuffer-local-map}. -@end defvar - -@defvar minibuffer-completion-table -The value of this variable is the alist or obarray used for completion -in the minibuffer. This is the global variable that contains what -@code{completing-read} passes to @code{try-completion}. It is used by -minibuffer completion commands such as @code{minibuffer-complete-word}. -@end defvar - -@defvar minibuffer-completion-predicate -This variable's value is the predicate that @code{completing-read} -passes to @code{try-completion}. The variable is also used by the other -minibuffer completion functions. -@end defvar - -@deffn Command minibuffer-complete-word -This function completes the minibuffer contents by at most a single -word. Even if the minibuffer contents have only one completion, -@code{minibuffer-complete-word} does not add any characters beyond the -first character that is not a word constituent. @xref{Syntax Tables}. -@end deffn - -@deffn Command minibuffer-complete -This function completes the minibuffer contents as far as possible. -@end deffn - -@deffn Command minibuffer-complete-and-exit -This function completes the minibuffer contents, and exits if -confirmation is not required, i.e., if -@code{minibuffer-completion-confirm} is non-@code{nil}. If confirmation -@emph{is} required, it is given by repeating this command -immediately---the command is programmed to work without confirmation -when run twice in succession. -@end deffn - -@defvar minibuffer-completion-confirm -When the value of this variable is non-@code{nil}, XEmacs asks for -confirmation of a completion before exiting the minibuffer. The -function @code{minibuffer-complete-and-exit} checks the value of this -variable before it exits. -@end defvar - -@deffn Command minibuffer-completion-help -This function creates a list of the possible completions of the -current minibuffer contents. It works by calling @code{all-completions} -using the value of the variable @code{minibuffer-completion-table} as -the @var{collection} argument, and the value of -@code{minibuffer-completion-predicate} as the @var{predicate} argument. -The list of completions is displayed as text in a buffer named -@samp{*Completions*}. -@end deffn - -@defun display-completion-list completions -This function displays @var{completions} to the stream in -@code{standard-output}, usually a buffer. (@xref{Read and Print}, for more -information about streams.) The argument @var{completions} is normally -a list of completions just returned by @code{all-completions}, but it -does not have to be. Each element may be a symbol or a string, either -of which is simply printed, or a list of two strings, which is printed -as if the strings were concatenated. - -This function is called by @code{minibuffer-completion-help}. The -most common way to use it is together with -@code{with-output-to-temp-buffer}, like this: - -@example -(with-output-to-temp-buffer "*Completions*" - (display-completion-list - (all-completions (buffer-string) my-alist))) -@end example -@end defun - -@defopt completion-auto-help -If this variable is non-@code{nil}, the completion commands -automatically display a list of possible completions whenever nothing -can be completed because the next character is not uniquely determined. -@end defopt - -@node High-Level Completion -@subsection High-Level Completion Functions - - This section describes the higher-level convenient functions for -reading certain sorts of names with completion. - - In most cases, you should not call these functions in the middle of a -Lisp function. When possible, do all minibuffer input as part of -reading the arguments for a command, in the @code{interactive} spec. -@xref{Defining Commands}. - -@defun read-buffer prompt &optional default existing -This function reads the name of a buffer and returns it as a string. -The argument @var{default} is the default name to use, the value to -return if the user exits with an empty minibuffer. If non-@code{nil}, -it should be a string or a buffer. It is mentioned in the prompt, but -is not inserted in the minibuffer as initial input. - -If @var{existing} is non-@code{nil}, then the name specified must be -that of an existing buffer. The usual commands to exit the minibuffer -do not exit if the text is not valid, and @key{RET} does completion to -attempt to find a valid name. (However, @var{default} is not checked -for validity; it is returned, whatever it is, if the user exits with the -minibuffer empty.) - -In the following example, the user enters @samp{minibuffer.t}, and -then types @key{RET}. The argument @var{existing} is @code{t}, and the -only buffer name starting with the given input is -@samp{minibuffer.texi}, so that name is the value. - -@example -(read-buffer "Buffer name? " "foo" t) -@group -;; @r{After evaluation of the preceding expression,} -;; @r{the following prompt appears,} -;; @r{with an empty minibuffer:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -Buffer name? (default foo) @point{} ----------- Buffer: Minibuffer ---------- -@end group - -@group -;; @r{The user types @kbd{minibuffer.t @key{RET}}.} - @result{} "minibuffer.texi" -@end group -@end example -@end defun - -@defun read-command prompt -This function reads the name of a command and returns it as a Lisp -symbol. The argument @var{prompt} is used as in -@code{read-from-minibuffer}. Recall that a command is anything for -which @code{commandp} returns @code{t}, and a command name is a symbol -for which @code{commandp} returns @code{t}. @xref{Interactive Call}. - -@example -(read-command "Command name? ") - -@group -;; @r{After evaluation of the preceding expression,} -;; @r{the following prompt appears with an empty minibuffer:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -Command name? ----------- Buffer: Minibuffer ---------- -@end group -@end example - -@noindent -If the user types @kbd{forward-c @key{RET}}, then this function returns -@code{forward-char}. - -The @code{read-command} function is a simplified interface to the -function @code{completing-read}. It uses the variable @code{obarray} so -as to complete in the set of extant Lisp symbols, and it uses the -@code{commandp} predicate so as to accept only command names: - -@cindex @code{commandp} example -@example -@group -(read-command @var{prompt}) -@equiv{} -(intern (completing-read @var{prompt} obarray - 'commandp t nil)) -@end group -@end example -@end defun - -@defun read-variable prompt -This function reads the name of a user variable and returns it as a -symbol. - -@example -@group -(read-variable "Variable name? ") - -;; @r{After evaluation of the preceding expression,} -;; @r{the following prompt appears,} -;; @r{with an empty minibuffer:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -Variable name? @point{} ----------- Buffer: Minibuffer ---------- -@end group -@end example - -@noindent -If the user then types @kbd{fill-p @key{RET}}, @code{read-variable} -returns @code{fill-prefix}. - -This function is similar to @code{read-command}, but uses the -predicate @code{user-variable-p} instead of @code{commandp}: - -@cindex @code{user-variable-p} example -@example -@group -(read-variable @var{prompt}) -@equiv{} -(intern - (completing-read @var{prompt} obarray - 'user-variable-p t nil)) -@end group -@end example -@end defun - -@node Reading File Names -@subsection Reading File Names - - Here is another high-level completion function, designed for reading a -file name. It provides special features including automatic insertion -of the default directory. - -@defun read-file-name prompt &optional directory default existing initial -This function reads a file name in the minibuffer, prompting with -@var{prompt} and providing completion. If @var{default} is -non-@code{nil}, then the function returns @var{default} if the user just -types @key{RET}. @var{default} is not checked for validity; it is -returned, whatever it is, if the user exits with the minibuffer empty. - -If @var{existing} is non-@code{nil}, then the user must specify the name -of an existing file; @key{RET} performs completion to make the name -valid if possible, and then refuses to exit if it is not valid. If the -value of @var{existing} is neither @code{nil} nor @code{t}, then -@key{RET} also requires confirmation after completion. If -@var{existing} is @code{nil}, then the name of a nonexistent file is -acceptable. - -The argument @var{directory} specifies the directory to use for -completion of relative file names. If @code{insert-default-directory} -is non-@code{nil}, @var{directory} is also inserted in the minibuffer as -initial input. It defaults to the current buffer's value of -@code{default-directory}. - -@c Emacs 19 feature -If you specify @var{initial}, that is an initial file name to insert in -the buffer (after with @var{directory}, if that is inserted). In this -case, point goes at the beginning of @var{initial}. The default for -@var{initial} is @code{nil}---don't insert any file name. To see what -@var{initial} does, try the command @kbd{C-x C-v}. - -Here is an example: - -@example -@group -(read-file-name "The file is ") - -;; @r{After evaluation of the preceding expression,} -;; @r{the following appears in the minibuffer:} -@end group - -@group ----------- Buffer: Minibuffer ---------- -The file is /gp/gnu/elisp/@point{} ----------- Buffer: Minibuffer ---------- -@end group -@end example - -@noindent -Typing @kbd{manual @key{TAB}} results in the following: - -@example -@group ----------- Buffer: Minibuffer ---------- -The file is /gp/gnu/elisp/manual.texi@point{} ----------- Buffer: Minibuffer ---------- -@end group -@end example - -@c Wordy to avoid overfull hbox in smallbook mode. -@noindent -If the user types @key{RET}, @code{read-file-name} returns the file name -as the string @code{"/gp/gnu/elisp/manual.texi"}. -@end defun - -@defopt insert-default-directory -This variable is used by @code{read-file-name}. Its value controls -whether @code{read-file-name} starts by placing the name of the default -directory in the minibuffer, plus the initial file name if any. If the -value of this variable is @code{nil}, then @code{read-file-name} does -not place any initial input in the minibuffer (unless you specify -initial input with the @var{initial} argument). In that case, the -default directory is still used for completion of relative file names, -but is not displayed. - -For example: - -@example -@group -;; @r{Here the minibuffer starts out with the default directory.} -(let ((insert-default-directory t)) - (read-file-name "The file is ")) -@end group - -@group ----------- Buffer: Minibuffer ---------- -The file is ~lewis/manual/@point{} ----------- Buffer: Minibuffer ---------- -@end group - -@group -;; @r{Here the minibuffer is empty and only the prompt} -;; @r{appears on its line.} -(let ((insert-default-directory nil)) - (read-file-name "The file is ")) -@end group - -@group ----------- Buffer: Minibuffer ---------- -The file is @point{} ----------- Buffer: Minibuffer ---------- -@end group -@end example -@end defopt - -@node Programmed Completion -@subsection Programmed Completion -@cindex programmed completion - - Sometimes it is not possible to create an alist or an obarray -containing all the intended possible completions. In such a case, you -can supply your own function to compute the completion of a given string. -This is called @dfn{programmed completion}. - - To use this feature, pass a symbol with a function definition as the -@var{collection} argument to @code{completing-read}. The function -@code{completing-read} arranges to pass your completion function along -to @code{try-completion} and @code{all-completions}, which will then let -your function do all the work. - - The completion function should accept three arguments: - -@itemize @bullet -@item -The string to be completed. - -@item -The predicate function to filter possible matches, or @code{nil} if -none. Your function should call the predicate for each possible match, -and ignore the possible match if the predicate returns @code{nil}. - -@item -A flag specifying the type of operation. -@end itemize - - There are three flag values for three operations: - -@itemize @bullet -@item -@code{nil} specifies @code{try-completion}. The completion function -should return the completion of the specified string, or @code{t} if the -string is an exact match already, or @code{nil} if the string matches no -possibility. - -@item -@code{t} specifies @code{all-completions}. The completion function -should return a list of all possible completions of the specified -string. - -@item -@code{lambda} specifies a test for an exact match. The completion -function should return @code{t} if the specified string is an exact -match for some possibility; @code{nil} otherwise. -@end itemize - - It would be consistent and clean for completion functions to allow -lambda expressions (lists that are functions) as well as function -symbols as @var{collection}, but this is impossible. Lists as -completion tables are already assigned another meaning---as alists. It -would be unreliable to fail to handle an alist normally because it is -also a possible function. So you must arrange for any function you wish -to use for completion to be encapsulated in a symbol. - - Emacs uses programmed completion when completing file names. -@xref{File Name Completion}. - -@node Yes-or-No Queries -@section Yes-or-No Queries -@cindex asking the user questions -@cindex querying the user -@cindex yes-or-no questions - - This section describes functions used to ask the user a yes-or-no -question. The function @code{y-or-n-p} can be answered with a single -character; it is useful for questions where an inadvertent wrong answer -will not have serious consequences. @code{yes-or-no-p} is suitable for -more momentous questions, since it requires three or four characters to -answer. Variations of these functions can be used to ask a yes-or-no -question using a dialog box, or optionally using one. - - If either of these functions is called in a command that was invoked -using the mouse, then it uses a dialog box or pop-up menu to ask the -question. Otherwise, it uses keyboard input. - - Strictly speaking, @code{yes-or-no-p} uses the minibuffer and -@code{y-or-n-p} does not; but it seems best to describe them together. - -@defun y-or-n-p prompt -This function asks the user a question, expecting input in the echo -area. It returns @code{t} if the user types @kbd{y}, @code{nil} if the -user types @kbd{n}. This function also accepts @key{SPC} to mean yes -and @key{DEL} to mean no. It accepts @kbd{C-]} to mean ``quit'', like -@kbd{C-g}, because the question might look like a minibuffer and for -that reason the user might try to use @kbd{C-]} to get out. The answer -is a single character, with no @key{RET} needed to terminate it. Upper -and lower case are equivalent. - -``Asking the question'' means printing @var{prompt} in the echo area, -followed by the string @w{@samp{(y or n) }}. If the input is not one of -the expected answers (@kbd{y}, @kbd{n}, @kbd{@key{SPC}}, -@kbd{@key{DEL}}, or something that quits), the function responds -@samp{Please answer y or n.}, and repeats the request. - -This function does not actually use the minibuffer, since it does not -allow editing of the answer. It actually uses the echo area (@pxref{The -Echo Area}), which uses the same screen space as the minibuffer. The -cursor moves to the echo area while the question is being asked. - -The answers and their meanings, even @samp{y} and @samp{n}, are not -hardwired. The keymap @code{query-replace-map} specifies them. -@xref{Search and Replace}. - -In the following example, the user first types @kbd{q}, which is -invalid. At the next prompt the user types @kbd{y}. - -@smallexample -@group -(y-or-n-p "Do you need a lift? ") - -;; @r{After evaluation of the preceding expression,} -;; @r{the following prompt appears in the echo area:} -@end group - -@group ----------- Echo area ---------- -Do you need a lift? (y or n) ----------- Echo area ---------- -@end group - -;; @r{If the user then types @kbd{q}, the following appears:} - -@group ----------- Echo area ---------- -Please answer y or n. Do you need a lift? (y or n) ----------- Echo area ---------- -@end group - -;; @r{When the user types a valid answer,} -;; @r{it is displayed after the question:} - -@group ----------- Echo area ---------- -Do you need a lift? (y or n) y ----------- Echo area ---------- -@end group -@end smallexample - -@noindent -We show successive lines of echo area messages, but only one actually -appears on the screen at a time. -@end defun - -@defun yes-or-no-p prompt -This function asks the user a question, expecting input in the -minibuffer. It returns @code{t} if the user enters @samp{yes}, -@code{nil} if the user types @samp{no}. The user must type @key{RET} to -finalize the response. Upper and lower case are equivalent. - -@code{yes-or-no-p} starts by displaying @var{prompt} in the echo area, -followed by @w{@samp{(yes or no) }}. The user must type one of the -expected responses; otherwise, the function responds @samp{Please answer -yes or no.}, waits about two seconds and repeats the request. - -@code{yes-or-no-p} requires more work from the user than -@code{y-or-n-p} and is appropriate for more crucial decisions. - -Here is an example: - -@smallexample -@group -(yes-or-no-p "Do you really want to remove everything? ") - -;; @r{After evaluation of the preceding expression,} -;; @r{the following prompt appears,} -;; @r{with an empty minibuffer:} -@end group - -@group ----------- Buffer: minibuffer ---------- -Do you really want to remove everything? (yes or no) ----------- Buffer: minibuffer ---------- -@end group -@end smallexample - -@noindent -If the user first types @kbd{y @key{RET}}, which is invalid because this -function demands the entire word @samp{yes}, it responds by displaying -these prompts, with a brief pause between them: - -@smallexample -@group ----------- Buffer: minibuffer ---------- -Please answer yes or no. -Do you really want to remove everything? (yes or no) ----------- Buffer: minibuffer ---------- -@end group -@end smallexample -@end defun - -@c The rest is XEmacs stuff -@defun yes-or-no-p-dialog-box prompt -This function asks the user a ``y or n'' question with a popup dialog -box. It returns @code{t} if the answer is ``yes''. @var{prompt} is the -string to display to ask the question. -@end defun - -The following functions ask a question either in the minibuffer or a -dialog box, depending on whether the last user event (which presumably -invoked this command) was a keyboard or mouse event. When XEmacs is -running on a window system, the functions @code{y-or-n-p} and -@code{yes-or-no-p} are replaced with the following functions, so that -menu items bring up dialog boxes instead of minibuffer questions. - -@defun y-or-n-p-maybe-dialog-box prompt -This function asks user a ``y or n'' question, using either a dialog box -or the minibuffer, as appropriate. -@end defun - -@defun yes-or-no-p-maybe-dialog-box prompt -This function asks user a ``yes or no'' question, using either a dialog -box or the minibuffer, as appropriate. -@end defun - -@node Multiple Queries -@section Asking Multiple Y-or-N Questions - - When you have a series of similar questions to ask, such as ``Do you -want to save this buffer'' for each buffer in turn, you should use -@code{map-y-or-n-p} to ask the collection of questions, rather than -asking each question individually. This gives the user certain -convenient facilities such as the ability to answer the whole series at -once. - -@defun map-y-or-n-p prompter actor list &optional help action-alist -This function, new in Emacs 19, asks the user a series of questions, -reading a single-character answer in the echo area for each one. - -The value of @var{list} specifies the objects to ask questions about. -It should be either a list of objects or a generator function. If it is -a function, it should expect no arguments, and should return either the -next object to ask about, or @code{nil} meaning stop asking questions. - -The argument @var{prompter} specifies how to ask each question. If -@var{prompter} is a string, the question text is computed like this: - -@example -(format @var{prompter} @var{object}) -@end example - -@noindent -where @var{object} is the next object to ask about (as obtained from -@var{list}). - -If not a string, @var{prompter} should be a function of one argument -(the next object to ask about) and should return the question text. If -the value is a string, that is the question to ask the user. The -function can also return @code{t} meaning do act on this object (and -don't ask the user), or @code{nil} meaning ignore this object (and don't -ask the user). - -The argument @var{actor} says how to act on the answers that the user -gives. It should be a function of one argument, and it is called with -each object that the user says yes for. Its argument is always an -object obtained from @var{list}. - -If the argument @var{help} is given, it should be a list of this form: - -@example -(@var{singular} @var{plural} @var{action}) -@end example - -@noindent -where @var{singular} is a string containing a singular noun that -describes the objects conceptually being acted on, @var{plural} is the -corresponding plural noun, and @var{action} is a transitive verb -describing what @var{actor} does. - -If you don't specify @var{help}, the default is @code{("object" -"objects" "act on")}. - -Each time a question is asked, the user may enter @kbd{y}, @kbd{Y}, or -@key{SPC} to act on that object; @kbd{n}, @kbd{N}, or @key{DEL} to skip -that object; @kbd{!} to act on all following objects; @key{ESC} or -@kbd{q} to exit (skip all following objects); @kbd{.} (period) to act on -the current object and then exit; or @kbd{C-h} to get help. These are -the same answers that @code{query-replace} accepts. The keymap -@code{query-replace-map} defines their meaning for @code{map-y-or-n-p} -as well as for @code{query-replace}; see @ref{Search and Replace}. - -You can use @var{action-alist} to specify additional possible answers -and what they mean. It is an alist of elements of the form -@code{(@var{char} @var{function} @var{help})}, each of which defines one -additional answer. In this element, @var{char} is a character (the -answer); @var{function} is a function of one argument (an object from -@var{list}); @var{help} is a string. - -When the user responds with @var{char}, @code{map-y-or-n-p} calls -@var{function}. If it returns non-@code{nil}, the object is considered -``acted upon'', and @code{map-y-or-n-p} advances to the next object in -@var{list}. If it returns @code{nil}, the prompt is repeated for the -same object. - -If @code{map-y-or-n-p} is called in a command that was invoked using the -mouse---more precisely, if @code{last-nonmenu-event} (@pxref{Command -Loop Info}) is either @code{nil} or a list---then it uses a dialog box -or pop-up menu to ask the question. In this case, it does not use -keyboard input or the echo area. You can force use of the mouse or use -of keyboard input by binding @code{last-nonmenu-event} to a suitable -value around the call. - -The return value of @code{map-y-or-n-p} is the number of objects acted on. -@end defun - -@node Minibuffer Misc -@section Minibuffer Miscellany - - This section describes some basic functions and variables related to -minibuffers. - -@deffn Command exit-minibuffer -This command exits the active minibuffer. It is normally bound to -keys in minibuffer local keymaps. -@end deffn - -@deffn Command self-insert-and-exit -This command exits the active minibuffer after inserting the last -character typed on the keyboard (found in @code{last-command-char}; -@pxref{Command Loop Info}). -@end deffn - -@deffn Command previous-history-element n -This command replaces the minibuffer contents with the value of the -@var{n}th previous (older) history element. -@end deffn - -@deffn Command next-history-element n -This command replaces the minibuffer contents with the value of the -@var{n}th more recent history element. -@end deffn - -@deffn Command previous-matching-history-element pattern -This command replaces the minibuffer contents with the value of the -previous (older) history element that matches @var{pattern} (a regular -expression). -@end deffn - -@deffn Command next-matching-history-element pattern -This command replaces the minibuffer contents with the value of the next -(newer) history element that matches @var{pattern} (a regular -expression). -@end deffn - -@defun minibuffer-prompt -This function returns the prompt string of the currently active -minibuffer. If no minibuffer is active, it returns @code{nil}. -@end defun - -@defun minibuffer-prompt-width -This function returns the display width of the prompt string of the -currently active minibuffer. If no minibuffer is active, it returns 0. -@end defun - -@defvar minibuffer-setup-hook -This is a normal hook that is run whenever the minibuffer is entered. -@xref{Hooks}. -@end defvar - -@defvar minibuffer-exit-hook -This is a normal hook that is run whenever the minibuffer is exited. -@xref{Hooks}. -@end defvar - -@defvar minibuffer-help-form -The current value of this variable is used to rebind @code{help-form} -locally inside the minibuffer (@pxref{Help Functions}). -@end defvar - -@defun active-minibuffer-window -This function returns the currently active minibuffer window, or -@code{nil} if none is currently active. -@end defun - -@defun minibuffer-window &optional frame -This function returns the minibuffer window used for frame @var{frame}. -If @var{frame} is @code{nil}, that stands for the current frame. Note -that the minibuffer window used by a frame need not be part of that -frame---a frame that has no minibuffer of its own necessarily uses some -other frame's minibuffer window. -@end defun - -@c Emacs 19 feature -@defun window-minibuffer-p window -This function returns non-@code{nil} if @var{window} is a minibuffer window. -@end defun - -It is not correct to determine whether a given window is a minibuffer by -comparing it with the result of @code{(minibuffer-window)}, because -there can be more than one minibuffer window if there is more than one -frame. - -@defun minibuffer-window-active-p window -This function returns non-@code{nil} if @var{window}, assumed to be -a minibuffer window, is currently active. -@end defun - -@defvar minibuffer-scroll-window -If the value of this variable is non-@code{nil}, it should be a window -object. When the function @code{scroll-other-window} is called in the -minibuffer, it scrolls this window. -@end defvar - -Finally, some functions and variables deal with recursive minibuffers -(@pxref{Recursive Editing}): - -@defun minibuffer-depth -This function returns the current depth of activations of the -minibuffer, a nonnegative integer. If no minibuffers are active, it -returns zero. -@end defun - -@defopt enable-recursive-minibuffers -If this variable is non-@code{nil}, you can invoke commands (such as -@code{find-file}) that use minibuffers even while in the minibuffer -window. Such invocation produces a recursive editing level for a new -minibuffer. The outer-level minibuffer is invisible while you are -editing the inner one. - -This variable only affects invoking the minibuffer while the -minibuffer window is selected. If you switch windows while in the -minibuffer, you can always invoke minibuffer commands while some other -window is selected. -@end defopt - -@c Emacs 19 feature -In FSF Emacs 19, if a command name has a property -@code{enable-recursive-minibuffers} that is non-@code{nil}, then the -command can use the minibuffer to read arguments even if it is invoked -from the minibuffer. The minibuffer command -@code{next-matching-history-element} (normally @kbd{M-s} in the -minibuffer) uses this feature. - -This is not implemented in XEmacs because it is a kludge. If you -want to explicitly set the value of @code{enable-recursive-minibuffers} -in this fashion, just use an evaluated interactive spec and bind -@code{enable-recursive-minibuffers} while reading from the minibuffer. -See the definition of @code{next-matching-history-element} in -@file{lisp/prim/minibuf.el}. diff --git a/man/lispref/modes.texi b/man/lispref/modes.texi deleted file mode 100644 index 0a05e5f..0000000 --- a/man/lispref/modes.texi +++ /dev/null @@ -1,1431 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/modes.info -@node Modes, Documentation, Drag and Drop, Top -@chapter Major and Minor Modes -@cindex mode - - A @dfn{mode} is a set of definitions that customize XEmacs and can be -turned on and off while you edit. There are two varieties of modes: -@dfn{major modes}, which are mutually exclusive and used for editing -particular kinds of text, and @dfn{minor modes}, which provide features -that users can enable individually. - - This chapter describes how to write both major and minor modes, how to -indicate them in the modeline, and how they run hooks supplied by the -user. For related topics such as keymaps and syntax tables, see -@ref{Keymaps}, and @ref{Syntax Tables}. - -@menu -* Major Modes:: Defining major modes. -* Minor Modes:: Defining minor modes. -* Modeline Format:: Customizing the text that appears in the modeline. -* Hooks:: How to use hooks; how to write code that provides hooks. -@end menu - -@node Major Modes -@section Major Modes -@cindex major mode -@cindex Fundamental mode - - Major modes specialize XEmacs for editing particular kinds of text. -Each buffer has only one major mode at a time. - - The least specialized major mode is called @dfn{Fundamental mode}. -This mode has no mode-specific definitions or variable settings, so each -XEmacs command behaves in its default manner, and each option is in its -default state. All other major modes redefine various keys and options. -For example, Lisp Interaction mode provides special key bindings for -@key{LFD} (@code{eval-print-last-sexp}), @key{TAB} -(@code{lisp-indent-line}), and other keys. - - When you need to write several editing commands to help you perform a -specialized editing task, creating a new major mode is usually a good -idea. In practice, writing a major mode is easy (in contrast to -writing a minor mode, which is often difficult). - - If the new mode is similar to an old one, it is often unwise to modify -the old one to serve two purposes, since it may become harder to use and -maintain. Instead, copy and rename an existing major mode definition -and alter the copy---or define a @dfn{derived mode} (@pxref{Derived -Modes}). For example, Rmail Edit mode, which is in -@file{emacs/lisp/rmailedit.el}, is a major mode that is very similar to -Text mode except that it provides three additional commands. Its -definition is distinct from that of Text mode, but was derived from it. - - Rmail Edit mode is an example of a case where one piece of text is put -temporarily into a different major mode so it can be edited in a -different way (with ordinary XEmacs commands rather than Rmail). In such -cases, the temporary major mode usually has a command to switch back to -the buffer's usual mode (Rmail mode, in this case). You might be -tempted to present the temporary redefinitions inside a recursive edit -and restore the usual ones when the user exits; but this is a bad idea -because it constrains the user's options when it is done in more than -one buffer: recursive edits must be exited most-recently-entered first. -Using alternative major modes avoids this limitation. @xref{Recursive -Editing}. - - The standard XEmacs Lisp library directory contains the code for -several major modes, in files including @file{text-mode.el}, -@file{texinfo.el}, @file{lisp-mode.el}, @file{c-mode.el}, and -@file{rmail.el}. You can look at these libraries to see how modes are -written. Text mode is perhaps the simplest major mode aside from -Fundamental mode. Rmail mode is a complicated and specialized mode. - -@menu -* Major Mode Conventions:: Coding conventions for keymaps, etc. -* Example Major Modes:: Text mode and Lisp modes. -* Auto Major Mode:: How XEmacs chooses the major mode automatically. -* Mode Help:: Finding out how to use a mode. -* Derived Modes:: Defining a new major mode based on another major - mode. -@end menu - -@node Major Mode Conventions -@subsection Major Mode Conventions - - The code for existing major modes follows various coding conventions, -including conventions for local keymap and syntax table initialization, -global names, and hooks. Please follow these conventions when you -define a new major mode: - -@itemize @bullet -@item -Define a command whose name ends in @samp{-mode}, with no arguments, -that switches to the new mode in the current buffer. This command -should set up the keymap, syntax table, and local variables in an -existing buffer without changing the buffer's text. - -@item -Write a documentation string for this command that describes the -special commands available in this mode. @kbd{C-h m} -(@code{describe-mode}) in your mode will display this string. - -The documentation string may include the special documentation -substrings, @samp{\[@var{command}]}, @samp{\@{@var{keymap}@}}, and -@samp{\<@var{keymap}>}, that enable the documentation to adapt -automatically to the user's own key bindings. @xref{Keys in -Documentation}. - -@item -The major mode command should start by calling -@code{kill-all-local-variables}. This is what gets rid of the local -variables of the major mode previously in effect. - -@item -The major mode command should set the variable @code{major-mode} to the -major mode command symbol. This is how @code{describe-mode} discovers -which documentation to print. - -@item -The major mode command should set the variable @code{mode-name} to the -``pretty'' name of the mode, as a string. This appears in the mode -line. - -@item -@cindex functions in modes -Since all global names are in the same name space, all the global -variables, constants, and functions that are part of the mode should -have names that start with the major mode name (or with an abbreviation -of it if the name is long). @xref{Style Tips}. - -@item -@cindex keymaps in modes -The major mode should usually have its own keymap, which is used as the -local keymap in all buffers in that mode. The major mode function -should call @code{use-local-map} to install this local map. -@xref{Active Keymaps}, for more information. - -This keymap should be kept in a global variable named -@code{@var{modename}-mode-map}. Normally the library that defines the -mode sets this variable. - -@item -@cindex syntax tables in modes -The mode may have its own syntax table or may share one with other -related modes. If it has its own syntax table, it should store this in -a variable named @code{@var{modename}-mode-syntax-table}. @xref{Syntax -Tables}. - -@item -@cindex abbrev tables in modes -The mode may have its own abbrev table or may share one with other -related modes. If it has its own abbrev table, it should store this in -a variable named @code{@var{modename}-mode-abbrev-table}. @xref{Abbrev -Tables}. - -@item -Use @code{defvar} to set mode-related variables, so that they are not -reinitialized if they already have a value. (Such reinitialization -could discard customizations made by the user.) - -@item -@cindex buffer-local variables in modes -To make a buffer-local binding for an Emacs customization variable, use -@code{make-local-variable} in the major mode command, not -@code{make-variable-buffer-local}. The latter function would make the -variable local to every buffer in which it is subsequently set, which -would affect buffers that do not use this mode. It is undesirable for a -mode to have such global effects. @xref{Buffer-Local Variables}. - -It's ok to use @code{make-variable-buffer-local}, if you wish, for a -variable used only within a single Lisp package. - -@item -@cindex mode hook -@cindex major mode hook -Each major mode should have a @dfn{mode hook} named -@code{@var{modename}-mode-hook}. The major mode command should run that -hook, with @code{run-hooks}, as the very last thing it -does. @xref{Hooks}. - -@item -The major mode command may also run the hooks of some more basic modes. -For example, @code{indented-text-mode} runs @code{text-mode-hook} as -well as @code{indented-text-mode-hook}. It may run these other hooks -immediately before the mode's own hook (that is, after everything else), -or it may run them earlier. - -@item -If something special should be done if the user switches a buffer from -this mode to any other major mode, the mode can set a local value for -@code{change-major-mode-hook}. - -@item -If this mode is appropriate only for specially-prepared text, then the -major mode command symbol should have a property named @code{mode-class} -with value @code{special}, put on as follows: - -@cindex @code{mode-class} property -@cindex @code{special} -@example -(put 'funny-mode 'mode-class 'special) -@end example - -@noindent -This tells XEmacs that new buffers created while the current buffer has -Funny mode should not inherit Funny mode. Modes such as Dired, Rmail, -and Buffer List use this feature. - -@item -If you want to make the new mode the default for files with certain -recognizable names, add an element to @code{auto-mode-alist} to select -the mode for those file names. If you define the mode command to -autoload, you should add this element in the same file that calls -@code{autoload}. Otherwise, it is sufficient to add the element in the -file that contains the mode definition. @xref{Auto Major Mode}. - -@item -@cindex @file{.emacs} customization -In the documentation, you should provide a sample @code{autoload} form -and an example of how to add to @code{auto-mode-alist}, that users can -include in their @file{.emacs} files. - -@item -@cindex mode loading -The top-level forms in the file defining the mode should be written so -that they may be evaluated more than once without adverse consequences. -Even if you never load the file more than once, someone else will. -@end itemize - -@defvar change-major-mode-hook -This normal hook is run by @code{kill-all-local-variables} before it -does anything else. This gives major modes a way to arrange for -something special to be done if the user switches to a different major -mode. For best results, make this variable buffer-local, so that it -will disappear after doing its job and will not interfere with the -subsequent major mode. @xref{Hooks}. -@end defvar - -@node Example Major Modes -@subsection Major Mode Examples - - Text mode is perhaps the simplest mode besides Fundamental mode. -Here are excerpts from @file{text-mode.el} that illustrate many of -the conventions listed above: - -@smallexample -@group -;; @r{Create mode-specific tables.} -(defvar text-mode-syntax-table nil - "Syntax table used while in text mode.") -@end group - -@group -(if text-mode-syntax-table - () ; @r{Do not change the table if it is already set up.} - (setq text-mode-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\" ". " text-mode-syntax-table) - (modify-syntax-entry ?\\ ". " text-mode-syntax-table) - (modify-syntax-entry ?' "w " text-mode-syntax-table)) -@end group - -@group -(defvar text-mode-abbrev-table nil - "Abbrev table used while in text mode.") -(define-abbrev-table 'text-mode-abbrev-table ()) -@end group - -@group -(defvar text-mode-map nil) ; @r{Create a mode-specific keymap.} - -(if text-mode-map - () ; @r{Do not change the keymap if it is already set up.} - (setq text-mode-map (make-sparse-keymap)) - (define-key text-mode-map "\t" 'tab-to-tab-stop) - (define-key text-mode-map "\es" 'center-line) - (define-key text-mode-map "\eS" 'center-paragraph)) -@end group -@end smallexample - - Here is the complete major mode function definition for Text mode: - -@smallexample -@group -(defun text-mode () - "Major mode for editing text intended for humans to read. - Special commands: \\@{text-mode-map@} -@end group -@group -Turning on text-mode runs the hook `text-mode-hook'." - (interactive) - (kill-all-local-variables) -@end group -@group - (use-local-map text-mode-map) ; @r{This provides the local keymap.} - (setq mode-name "Text") ; @r{This name goes into the modeline.} - (setq major-mode 'text-mode) ; @r{This is how @code{describe-mode}} - ; @r{finds the doc string to print.} - (setq local-abbrev-table text-mode-abbrev-table) - (set-syntax-table text-mode-syntax-table) - (run-hooks 'text-mode-hook)) ; @r{Finally, this permits the user to} - ; @r{customize the mode with a hook.} -@end group -@end smallexample - -@cindex @file{lisp-mode.el} - The three Lisp modes (Lisp mode, Emacs Lisp mode, and Lisp -Interaction mode) have more features than Text mode and the code is -correspondingly more complicated. Here are excerpts from -@file{lisp-mode.el} that illustrate how these modes are written. - -@cindex syntax table example -@smallexample -@group -;; @r{Create mode-specific table variables.} -(defvar lisp-mode-syntax-table nil "") -(defvar emacs-lisp-mode-syntax-table nil "") -(defvar lisp-mode-abbrev-table nil "") -@end group - -@group -(if (not emacs-lisp-mode-syntax-table) ; @r{Do not change the table} - ; @r{if it is already set.} - (let ((i 0)) - (setq emacs-lisp-mode-syntax-table (make-syntax-table)) -@end group - -@group - ;; @r{Set syntax of chars up to 0 to class of chars that are} - ;; @r{part of symbol names but not words.} - ;; @r{(The number 0 is @code{48} in the @sc{ASCII} character set.)} - (while (< i ?0) - (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table) - (setq i (1+ i))) - @dots{} -@end group -@group - ;; @r{Set the syntax for other characters.} - (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table) - @dots{} -@end group -@group - (modify-syntax-entry ?\( "() " emacs-lisp-mode-syntax-table) - (modify-syntax-entry ?\) ")( " emacs-lisp-mode-syntax-table) - @dots{})) -;; @r{Create an abbrev table for lisp-mode.} -(define-abbrev-table 'lisp-mode-abbrev-table ()) -@end group -@end smallexample - - Much code is shared among the three Lisp modes. The following -function sets various variables; it is called by each of the major Lisp -mode functions: - -@smallexample -@group -(defun lisp-mode-variables (lisp-syntax) - ;; @r{The @code{lisp-syntax} argument is @code{nil} in Emacs Lisp mode,} - ;; @r{and @code{t} in the other two Lisp modes.} - (cond (lisp-syntax - (if (not lisp-mode-syntax-table) - ;; @r{The Emacs Lisp mode syntax table always exists, but} - ;; @r{the Lisp Mode syntax table is created the first time a} - ;; @r{mode that needs it is called. This is to save space.} -@end group -@group - (progn (setq lisp-mode-syntax-table - (copy-syntax-table emacs-lisp-mode-syntax-table)) - ;; @r{Change some entries for Lisp mode.} - (modify-syntax-entry ?\| "\" " - lisp-mode-syntax-table) - (modify-syntax-entry ?\[ "_ " - lisp-mode-syntax-table) - (modify-syntax-entry ?\] "_ " - lisp-mode-syntax-table))) -@end group -@group - (set-syntax-table lisp-mode-syntax-table))) - (setq local-abbrev-table lisp-mode-abbrev-table) - @dots{}) -@end group -@end smallexample - - Functions such as @code{forward-paragraph} use the value of the -@code{paragraph-start} variable. Since Lisp code is different from -ordinary text, the @code{paragraph-start} variable needs to be set -specially to handle Lisp. Also, comments are indented in a special -fashion in Lisp and the Lisp modes need their own mode-specific -@code{comment-indent-function}. The code to set these variables is the -rest of @code{lisp-mode-variables}. - -@smallexample -@group - (make-local-variable 'paragraph-start) - ;; @r{Having @samp{^} is not clean, but @code{page-delimiter}} - ;; @r{has them too, and removing those is a pain.} - (setq paragraph-start (concat "^$\\|" page-delimiter)) - @dots{} -@end group -@group - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'lisp-comment-indent)) -@end group -@end smallexample - - Each of the different Lisp modes has a slightly different keymap. For -example, Lisp mode binds @kbd{C-c C-l} to @code{run-lisp}, but the other -Lisp modes do not. However, all Lisp modes have some commands in -common. The following function adds these common commands to a given -keymap. - -@smallexample -@group -(defun lisp-mode-commands (map) - (define-key map "\e\C-q" 'indent-sexp) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\t" 'lisp-indent-line)) -@end group -@end smallexample - - Here is an example of using @code{lisp-mode-commands} to initialize a -keymap, as part of the code for Emacs Lisp mode. First we declare a -variable with @code{defvar} to hold the mode-specific keymap. When this -@code{defvar} executes, it sets the variable to @code{nil} if it was -void. Then we set up the keymap if the variable is @code{nil}. - - This code avoids changing the keymap or the variable if it is already -set up. This lets the user customize the keymap. - -@smallexample -@group -(defvar emacs-lisp-mode-map () "") -(if emacs-lisp-mode-map - () - (setq emacs-lisp-mode-map (make-sparse-keymap)) - (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun) - (lisp-mode-commands emacs-lisp-mode-map)) -@end group -@end smallexample - - Finally, here is the complete major mode function definition for -Emacs Lisp mode. - -@smallexample -@group -(defun emacs-lisp-mode () - "Major mode for editing Lisp code to run in XEmacs. -Commands: -Delete converts tabs to spaces as it moves back. -Blank lines separate paragraphs. Semicolons start comments. -\\@{emacs-lisp-mode-map@} -@end group -@group -Entry to this mode runs the hook `emacs-lisp-mode-hook'." - (interactive) - (kill-all-local-variables) - (use-local-map emacs-lisp-mode-map) ; @r{This provides the local keymap.} - (set-syntax-table emacs-lisp-mode-syntax-table) -@end group -@group - (setq major-mode 'emacs-lisp-mode) ; @r{This is how @code{describe-mode}} - ; @r{finds out what to describe.} - (setq mode-name "Emacs-Lisp") ; @r{This goes into the modeline.} - (lisp-mode-variables nil) ; @r{This defines various variables.} - (run-hooks 'emacs-lisp-mode-hook)) ; @r{This permits the user to use a} - ; @r{hook to customize the mode.} -@end group -@end smallexample - -@node Auto Major Mode -@subsection How XEmacs Chooses a Major Mode - - Based on information in the file name or in the file itself, XEmacs -automatically selects a major mode for the new buffer when a file is -visited. - -@deffn Command fundamental-mode - Fundamental mode is a major mode that is not specialized for anything -in particular. Other major modes are defined in effect by comparison -with this one---their definitions say what to change, starting from -Fundamental mode. The @code{fundamental-mode} function does @emph{not} -run any hooks; you're not supposed to customize it. (If you want Emacs -to behave differently in Fundamental mode, change the @emph{global} -state of Emacs.) -@end deffn - -@deffn Command normal-mode &optional find-file -This function establishes the proper major mode and local variable -bindings for the current buffer. First it calls @code{set-auto-mode}, -then it runs @code{hack-local-variables} to parse, and bind or -evaluate as appropriate, any local variables. - -If the @var{find-file} argument to @code{normal-mode} is -non-@code{nil}, @code{normal-mode} assumes that the @code{find-file} -function is calling it. In this case, it may process a local variables -list at the end of the file and in the @samp{-*-} line. The variable -@code{enable-local-variables} controls whether to do so. - -If you run @code{normal-mode} interactively, the argument -@var{find-file} is normally @code{nil}. In this case, -@code{normal-mode} unconditionally processes any local variables list. -@xref{File variables, , Local Variables in Files, emacs, The XEmacs -Reference Manual}, for the syntax of the local variables section of a file. - -@cindex file mode specification error -@code{normal-mode} uses @code{condition-case} around the call to the -major mode function, so errors are caught and reported as a @samp{File -mode specification error}, followed by the original error message. -@end deffn - -@defopt enable-local-variables -This variable controls processing of local variables lists in files -being visited. A value of @code{t} means process the local variables -lists unconditionally; @code{nil} means ignore them; anything else means -ask the user what to do for each file. The default value is @code{t}. -@end defopt - -@defvar ignored-local-variables -This variable holds a list of variables that should not be -set by a local variables list. Any value specified -for one of these variables is ignored. -@end defvar - -In addition to this list, any variable whose name has a non-@code{nil} -@code{risky-local-variable} property is also ignored. - -@defopt enable-local-eval -This variable controls processing of @samp{Eval:} in local variables -lists in files being visited. A value of @code{t} means process them -unconditionally; @code{nil} means ignore them; anything else means ask -the user what to do for each file. The default value is @code{maybe}. -@end defopt - -@defun set-auto-mode -@cindex visited file mode - This function selects the major mode that is appropriate for the -current buffer. It may base its decision on the value of the @w{@samp{-*-}} -line, on the visited file name (using @code{auto-mode-alist}), or on the -value of a local variable. However, this function does not look for -the @samp{mode:} local variable near the end of a file; the -@code{hack-local-variables} function does that. @xref{Choosing Modes, , -How Major Modes are Chosen, emacs, The XEmacs Reference Manual}. -@end defun - -@defopt default-major-mode - This variable holds the default major mode for new buffers. The -standard value is @code{fundamental-mode}. - - If the value of @code{default-major-mode} is @code{nil}, XEmacs uses -the (previously) current buffer's major mode for the major mode of a new -buffer. However, if the major mode symbol has a @code{mode-class} -property with value @code{special}, then it is not used for new buffers; -Fundamental mode is used instead. The modes that have this property are -those such as Dired and Rmail that are useful only with text that has -been specially prepared. -@end defopt - -@defun set-buffer-major-mode buffer -This function sets the major mode of @var{buffer} to the value of -@code{default-major-mode}. If that variable is @code{nil}, it uses -the current buffer's major mode (if that is suitable). - -The low-level primitives for creating buffers do not use this function, -but medium-level commands such as @code{switch-to-buffer} and -@code{find-file-noselect} use it whenever they create buffers. -@end defun - -@defvar initial-major-mode -@cindex @samp{*scratch*} -The value of this variable determines the major mode of the initial -@samp{*scratch*} buffer. The value should be a symbol that is a major -mode command name. The default value is @code{lisp-interaction-mode}. -@end defvar - -@defvar auto-mode-alist -This variable contains an association list of file name patterns -(regular expressions; @pxref{Regular Expressions}) and corresponding -major mode functions. Usually, the file name patterns test for -suffixes, such as @samp{.el} and @samp{.c}, but this need not be the -case. An ordinary element of the alist looks like @code{(@var{regexp} . -@var{mode-function})}. - -For example, - -@smallexample -@group -(("^/tmp/fol/" . text-mode) - ("\\.texinfo\\'" . texinfo-mode) - ("\\.texi\\'" . texinfo-mode) -@end group -@group - ("\\.el\\'" . emacs-lisp-mode) - ("\\.c\\'" . c-mode) - ("\\.h\\'" . c-mode) - @dots{}) -@end group -@end smallexample - -When you visit a file whose expanded file name (@pxref{File Name -Expansion}) matches a @var{regexp}, @code{set-auto-mode} calls the -corresponding @var{mode-function}. This feature enables XEmacs to select -the proper major mode for most files. - -If an element of @code{auto-mode-alist} has the form @code{(@var{regexp} -@var{function} t)}, then after calling @var{function}, XEmacs searches -@code{auto-mode-alist} again for a match against the portion of the file -name that did not match before. - -This match-again feature is useful for uncompression packages: an entry -of the form @code{("\\.gz\\'" . @var{function})} can uncompress the file -and then put the uncompressed file in the proper mode according to the -name sans @samp{.gz}. - -Here is an example of how to prepend several pattern pairs to -@code{auto-mode-alist}. (You might use this sort of expression in your -@file{.emacs} file.) - -@smallexample -@group -(setq auto-mode-alist - (append - ;; @r{File name starts with a dot.} - '(("/\\.[^/]*\\'" . fundamental-mode) - ;; @r{File name has no dot.} - ("[^\\./]*\\'" . fundamental-mode) - ;; @r{File name ends in @samp{.C}.} - ("\\.C\\'" . c++-mode)) - auto-mode-alist)) -@end group -@end smallexample -@end defvar - -@defvar interpreter-mode-alist -This variable specifies major modes to use for scripts that specify a -command interpreter in an @samp{#!} line. Its value is a list of -elements of the form @code{(@var{interpreter} . @var{mode})}; for -example, @code{("perl" . perl-mode)} is one element present by default. -The element says to use mode @var{mode} if the file specifies -@var{interpreter}. - -This variable is applicable only when the @code{auto-mode-alist} does -not indicate which major mode to use. -@end defvar - -@defun hack-local-variables &optional force - This function parses, and binds or evaluates as appropriate, any local -variables for the current buffer. - - The handling of @code{enable-local-variables} documented for -@code{normal-mode} actually takes place here. The argument @var{force} -usually comes from the argument @var{find-file} given to -@code{normal-mode}. -@end defun - -@node Mode Help -@subsection Getting Help about a Major Mode -@cindex mode help -@cindex help for major mode -@cindex documentation for major mode - - The @code{describe-mode} function is used to provide information -about major modes. It is normally called with @kbd{C-h m}. The -@code{describe-mode} function uses the value of @code{major-mode}, -which is why every major mode function needs to set the -@code{major-mode} variable. - -@deffn Command describe-mode -This function displays the documentation of the current major mode. - -The @code{describe-mode} function calls the @code{documentation} -function using the value of @code{major-mode} as an argument. Thus, it -displays the documentation string of the major mode function. -(@xref{Accessing Documentation}.) -@end deffn - -@defvar major-mode -This variable holds the symbol for the current buffer's major mode. -This symbol should have a function definition that is the command to -switch to that major mode. The @code{describe-mode} function uses the -documentation string of the function as the documentation of the major -mode. -@end defvar - -@node Derived Modes -@subsection Defining Derived Modes - - It's often useful to define a new major mode in terms of an existing -one. An easy way to do this is to use @code{define-derived-mode}. - -@defmac define-derived-mode variant parent name docstring body@dots{} -This construct defines @var{variant} as a major mode command, using -@var{name} as the string form of the mode name. - -The new command @var{variant} is defined to call the function -@var{parent}, then override certain aspects of that parent mode: - -@itemize @bullet -@item -The new mode has its own keymap, named @code{@var{variant}-map}. -@code{define-derived-mode} initializes this map to inherit from -@code{@var{parent}-map}, if it is not already set. - -@item -The new mode has its own syntax table, kept in the variable -@code{@var{variant}-syntax-table}. -@code{define-derived-mode} initializes this variable by copying -@code{@var{parent}-syntax-table}, if it is not already set. - -@item -The new mode has its own abbrev table, kept in the variable -@code{@var{variant}-abbrev-table}. -@code{define-derived-mode} initializes this variable by copying -@code{@var{parent}-abbrev-table}, if it is not already set. - -@item -The new mode has its own mode hook, @code{@var{variant}-hook}, -which it runs in standard fashion as the very last thing that it does. -(The new mode also runs the mode hook of @var{parent} as part -of calling @var{parent}.) -@end itemize - -In addition, you can specify how to override other aspects of -@var{parent} with @var{body}. The command @var{variant} -evaluates the forms in @var{body} after setting up all its usual -overrides, just before running @code{@var{variant}-hook}. - -The argument @var{docstring} specifies the documentation string for the -new mode. If you omit @var{docstring}, @code{define-derived-mode} -generates a documentation string. - -Here is a hypothetical example: - -@example -(define-derived-mode hypertext-mode - text-mode "Hypertext" - "Major mode for hypertext. -\\@{hypertext-mode-map@}" - (setq case-fold-search nil)) - -(define-key hypertext-mode-map - [down-mouse-3] 'do-hyper-link) -@end example -@end defmac - -@node Minor Modes -@section Minor Modes -@cindex minor mode - - A @dfn{minor mode} provides features that users may enable or disable -independently of the choice of major mode. Minor modes can be enabled -individually or in combination. Minor modes would be better named -``Generally available, optional feature modes'' except that such a name is -unwieldy. - - A minor mode is not usually a modification of single major mode. For -example, Auto Fill mode may be used in any major mode that permits text -insertion. To be general, a minor mode must be effectively independent -of the things major modes do. - - A minor mode is often much more difficult to implement than a major -mode. One reason is that you should be able to activate and deactivate -minor modes in any order. A minor mode should be able to have its -desired effect regardless of the major mode and regardless of the other -minor modes in effect. - - Often the biggest problem in implementing a minor mode is finding a -way to insert the necessary hook into the rest of XEmacs. Minor mode -keymaps make this easier than it used to be. - -@menu -* Minor Mode Conventions:: Tips for writing a minor mode. -* Keymaps and Minor Modes:: How a minor mode can have its own keymap. -@end menu - -@node Minor Mode Conventions -@subsection Conventions for Writing Minor Modes -@cindex minor mode conventions -@cindex conventions for writing minor modes - - There are conventions for writing minor modes just as there are for -major modes. Several of the major mode conventions apply to minor -modes as well: those regarding the name of the mode initialization -function, the names of global symbols, and the use of keymaps and -other tables. - - In addition, there are several conventions that are specific to -minor modes. - -@itemize @bullet -@item -@cindex mode variable -Make a variable whose name ends in @samp{-mode} to represent the minor -mode. Its value should enable or disable the mode (@code{nil} to -disable; anything else to enable.) We call this the @dfn{mode -variable}. - -This variable is used in conjunction with the @code{minor-mode-alist} to -display the minor mode name in the modeline. It can also enable -or disable a minor mode keymap. Individual commands or hooks can also -check the variable's value. - -If you want the minor mode to be enabled separately in each buffer, -make the variable buffer-local. - -@item -Define a command whose name is the same as the mode variable. -Its job is to enable and disable the mode by setting the variable. - -The command should accept one optional argument. If the argument is -@code{nil}, it should toggle the mode (turn it on if it is off, and off -if it is on). Otherwise, it should turn the mode on if the argument is -a positive integer, a symbol other than @code{nil} or @code{-}, or a -list whose @sc{car} is such an integer or symbol; it should turn the -mode off otherwise. - -Here is an example taken from the definition of @code{transient-mark-mode}. -It shows the use of @code{transient-mark-mode} as a variable that enables or -disables the mode's behavior, and also shows the proper way to toggle, -enable or disable the minor mode based on the raw prefix argument value. - -@smallexample -@group -(setq transient-mark-mode - (if (null arg) (not transient-mark-mode) - (> (prefix-numeric-value arg) 0))) -@end group -@end smallexample - -@item -Add an element to @code{minor-mode-alist} for each minor mode -(@pxref{Modeline Variables}). This element should be a list of the -following form: - -@smallexample -(@var{mode-variable} @var{string}) -@end smallexample - -Here @var{mode-variable} is the variable that controls enabling of the -minor mode, and @var{string} is a short string, starting with a space, -to represent the mode in the modeline. These strings must be short so -that there is room for several of them at once. - -When you add an element to @code{minor-mode-alist}, use @code{assq} to -check for an existing element, to avoid duplication. For example: - -@smallexample -@group -(or (assq 'leif-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(leif-mode " Leif") minor-mode-alist))) -@end group -@end smallexample -@end itemize - -@node Keymaps and Minor Modes -@subsection Keymaps and Minor Modes - - Each minor mode can have its own keymap, which is active when the mode -is enabled. To set up a keymap for a minor mode, add an element to the -alist @code{minor-mode-map-alist}. @xref{Active Keymaps}. - -@cindex @code{self-insert-command}, minor modes -One use of minor mode keymaps is to modify the behavior of certain -self-inserting characters so that they do something else as well as -self-insert. In general, this is the only way to do that, since the -facilities for customizing @code{self-insert-command} are limited to -special cases (designed for abbrevs and Auto Fill mode). (Do not try -substituting your own definition of @code{self-insert-command} for the -standard one. The editor command loop handles this function specially.) - -@node Modeline Format -@section Modeline Format -@cindex modeline - - Each Emacs window (aside from minibuffer windows) includes a modeline, -which displays status information about the buffer displayed in the -window. The modeline contains information about the buffer, such as its -name, associated file, depth of recursive editing, and the major and -minor modes. - - This section describes how the contents of the modeline are -controlled. It is in the chapter on modes because much of the -information displayed in the modeline relates to the enabled major and -minor modes. - - @code{modeline-format} is a buffer-local variable that holds a -template used to display the modeline of the current buffer. All -windows for the same buffer use the same @code{modeline-format} and -their modelines appear the same (except for scrolling percentages and -line numbers). - - The modeline of a window is normally updated whenever a different -buffer is shown in the window, or when the buffer's modified-status -changes from @code{nil} to @code{t} or vice-versa. If you modify any of -the variables referenced by @code{modeline-format} (@pxref{Modeline -Variables}), you may want to force an update of the modeline so as to -display the new information. - -@c Emacs 19 feature -@defun redraw-modeline &optional all -Force redisplay of the current buffer's modeline. If @var{all} is -non-@code{nil}, then force redisplay of all modelines. -@end defun - - The modeline is usually displayed in inverse video. This -is controlled using the @code{modeline} face. @xref{Faces}. - -@menu -* Modeline Data:: The data structure that controls the modeline. -* Modeline Variables:: Variables used in that data structure. -* %-Constructs:: Putting information into a modeline. -@end menu - -@node Modeline Data -@subsection The Data Structure of the Modeline -@cindex modeline construct - - The modeline contents are controlled by a data structure of lists, -strings, symbols, and numbers kept in the buffer-local variable -@code{mode-line-format}. The data structure is called a @dfn{modeline -construct}, and it is built in recursive fashion out of simpler modeline -constructs. The same data structure is used for constructing -frame titles (@pxref{Frame Titles}). - -@defvar modeline-format -The value of this variable is a modeline construct with overall -responsibility for the modeline format. The value of this variable -controls which other variables are used to form the modeline text, and -where they appear. -@end defvar - - A modeline construct may be as simple as a fixed string of text, but -it usually specifies how to use other variables to construct the text. -Many of these variables are themselves defined to have modeline -constructs as their values. - - The default value of @code{modeline-format} incorporates the values -of variables such as @code{mode-name} and @code{minor-mode-alist}. -Because of this, very few modes need to alter @code{modeline-format}. -For most purposes, it is sufficient to alter the variables referenced by -@code{modeline-format}. - - A modeline construct may be a list, a symbol, or a string. If the -value is a list, each element may be a list, a symbol, or a string. - -@table @code -@cindex percent symbol in modeline -@item @var{string} -A string as a modeline construct is displayed verbatim in the mode line -except for @dfn{@code{%}-constructs}. Decimal digits after the @samp{%} -specify the field width for space filling on the right (i.e., the data -is left justified). @xref{%-Constructs}. - -@item @var{symbol} -A symbol as a modeline construct stands for its value. The value of -@var{symbol} is used as a modeline construct, in place of @var{symbol}. -However, the symbols @code{t} and @code{nil} are ignored; so is any -symbol whose value is void. - -There is one exception: if the value of @var{symbol} is a string, it is -displayed verbatim: the @code{%}-constructs are not recognized. - -@item (@var{string} @var{rest}@dots{}) @r{or} (@var{list} @var{rest}@dots{}) -A list whose first element is a string or list means to process all the -elements recursively and concatenate the results. This is the most -common form of mode line construct. - -@item (@var{symbol} @var{then} @var{else}) -A list whose first element is a symbol is a conditional. Its meaning -depends on the value of @var{symbol}. If the value is non-@code{nil}, -the second element, @var{then}, is processed recursively as a modeline -element. But if the value of @var{symbol} is @code{nil}, the third -element, @var{else}, is processed recursively. You may omit @var{else}; -then the mode line element displays nothing if the value of @var{symbol} -is @code{nil}. - -@item (@var{width} @var{rest}@dots{}) -A list whose first element is an integer specifies truncation or -padding of the results of @var{rest}. The remaining elements -@var{rest} are processed recursively as modeline constructs and -concatenated together. Then the result is space filled (if -@var{width} is positive) or truncated (to @minus{}@var{width} columns, -if @var{width} is negative) on the right. - -For example, the usual way to show what percentage of a buffer is above -the top of the window is to use a list like this: @code{(-3 "%p")}. -@end table - - If you do alter @code{modeline-format} itself, the new value should -use the same variables that appear in the default value (@pxref{Modeline -Variables}), rather than duplicating their contents or displaying -the information in another fashion. This way, customizations made by -the user or by Lisp programs (such as @code{display-time} and major -modes) via changes to those variables remain effective. - -@cindex Shell mode @code{modeline-format} - Here is an example of a @code{modeline-format} that might be -useful for @code{shell-mode}, since it contains the hostname and default -directory. - -@example -@group -(setq modeline-format - (list "" - 'modeline-modified - "%b--" -@end group - (getenv "HOST") ; @r{One element is not constant.} - ":" - 'default-directory - " " - 'global-mode-string - " %[(" - 'mode-name - 'modeline-process - 'minor-mode-alist - "%n" - ")%]----" -@group - '(line-number-mode "L%l--") - '(-3 . "%p") - "-%-")) -@end group -@end example - -@node Modeline Variables -@subsection Variables Used in the Modeline - - This section describes variables incorporated by the -standard value of @code{modeline-format} into the text of the mode -line. There is nothing inherently special about these variables; any -other variables could have the same effects on the modeline if -@code{modeline-format} were changed to use them. - -@defvar modeline-modified -This variable holds the value of the modeline construct that displays -whether the current buffer is modified. - -The default value of @code{modeline-modified} is @code{("--%1*%1+-")}. -This means that the modeline displays @samp{--**-} if the buffer is -modified, @samp{-----} if the buffer is not modified, @samp{--%%-} if -the buffer is read only, and @samp{--%*--} if the buffer is read only -and modified. - -Changing this variable does not force an update of the modeline. -@end defvar - -@defvar modeline-buffer-identification -This variable identifies the buffer being displayed in the window. Its -default value is @code{("%F: %17b")}, which means that it usually -displays @samp{Emacs:} followed by seventeen characters of the buffer -name. (In a terminal frame, it displays the frame name instead of -@samp{Emacs}; this has the effect of showing the frame number.) You may -want to change this in modes such as Rmail that do not behave like a -``normal'' XEmacs. -@end defvar - -@defvar global-mode-string -This variable holds a modeline spec that appears in the mode line by -default, just after the buffer name. The command @code{display-time} -sets @code{global-mode-string} to refer to the variable -@code{display-time-string}, which holds a string containing the time and -load information. - -The @samp{%M} construct substitutes the value of -@code{global-mode-string}, but this is obsolete, since the variable is -included directly in the modeline. -@end defvar - -@defvar mode-name -This buffer-local variable holds the ``pretty'' name of the current -buffer's major mode. Each major mode should set this variable so that the -mode name will appear in the modeline. -@end defvar - -@defvar minor-mode-alist -This variable holds an association list whose elements specify how the -modeline should indicate that a minor mode is active. Each element of -the @code{minor-mode-alist} should be a two-element list: - -@example -(@var{minor-mode-variable} @var{modeline-string}) -@end example - -More generally, @var{modeline-string} can be any mode line spec. It -appears in the mode line when the value of @var{minor-mode-variable} is -non-@code{nil}, and not otherwise. These strings should begin with -spaces so that they don't run together. Conventionally, the -@var{minor-mode-variable} for a specific mode is set to a non-@code{nil} -value when that minor mode is activated. - -The default value of @code{minor-mode-alist} is: - -@example -@group -minor-mode-alist -@result{} ((vc-mode vc-mode) - (abbrev-mode " Abbrev") - (overwrite-mode overwrite-mode) - (auto-fill-function " Fill") - (defining-kbd-macro " Def") - (isearch-mode isearch-mode)) -@end group -@end example - -@code{minor-mode-alist} is not buffer-local. The variables mentioned -in the alist should be buffer-local if the minor mode can be enabled -separately in each buffer. -@end defvar - -@defvar modeline-process -This buffer-local variable contains the modeline information on process -status in modes used for communicating with subprocesses. It is -displayed immediately following the major mode name, with no intervening -space. For example, its value in the @samp{*shell*} buffer is -@code{(":@: %s")}, which allows the shell to display its status along -with the major mode as: @samp{(Shell:@: run)}. Normally this variable -is @code{nil}. -@end defvar - -@defvar default-modeline-format -This variable holds the default @code{modeline-format} for buffers -that do not override it. This is the same as @code{(default-value -'modeline-format)}. - -The default value of @code{default-modeline-format} is: - -@example -@group -("" - modeline-modified - modeline-buffer-identification - " " - global-mode-string - " %[(" - mode-name -@end group -@group - modeline-process - minor-mode-alist - "%n" - ")%]----" - (line-number-mode "L%l--") - (-3 . "%p") - "-%-") -@end group -@end example -@end defvar - -@defvar vc-mode -The variable @code{vc-mode}, local in each buffer, records whether the -buffer's visited file is maintained with version control, and, if so, -which kind. Its value is @code{nil} for no version control, or a string -that appears in the mode line. -@end defvar - -@node %-Constructs -@subsection @code{%}-Constructs in the ModeLine - - The following table lists the recognized @code{%}-constructs and what -they mean. In any construct except @samp{%%}, you can add a decimal -integer after the @samp{%} to specify how many characters to display. - -@table @code -@item %b -The current buffer name, obtained with the @code{buffer-name} function. -@xref{Buffer Names}. - -@item %f -The visited file name, obtained with the @code{buffer-file-name} -function. @xref{Buffer File Name}. - -@item %F -The name of the selected frame. - -@item %c -The current column number of point. - -@item %l -The current line number of point. - -@item %* -@samp{%} if the buffer is read only (see @code{buffer-read-only}); @* -@samp{*} if the buffer is modified (see @code{buffer-modified-p}); @* -@samp{-} otherwise. @xref{Buffer Modification}. - -@item %+ -@samp{*} if the buffer is modified (see @code{buffer-modified-p}); @* -@samp{%} if the buffer is read only (see @code{buffer-read-only}); @* -@samp{-} otherwise. This differs from @samp{%*} only for a modified -read-only buffer. @xref{Buffer Modification}. - -@item %& -@samp{*} if the buffer is modified, and @samp{-} otherwise. - -@item %s -The status of the subprocess belonging to the current buffer, obtained with -@code{process-status}. @xref{Process Information}. - -@c The following two may only apply in XEmacs. -@item %l -the current line number. - -@item %S -the name of the selected frame; this is only meaningful under the -X Window System. @xref{Frame Name}. - -@item %t -Whether the visited file is a text file or a binary file. (This is a -meaningful distinction only on certain operating systems.) - -@item %p -The percentage of the buffer text above the @strong{top} of window, or -@samp{Top}, @samp{Bottom} or @samp{All}. - -@item %P -The percentage of the buffer text that is above the @strong{bottom} of -the window (which includes the text visible in the window, as well as -the text above the top), plus @samp{Top} if the top of the buffer is -visible on screen; or @samp{Bottom} or @samp{All}. - -@item %n -@samp{Narrow} when narrowing is in effect; nothing otherwise (see -@code{narrow-to-region} in @ref{Narrowing}). - -@item %[ -An indication of the depth of recursive editing levels (not counting -minibuffer levels): one @samp{[} for each editing level. -@xref{Recursive Editing}. - -@item %] -One @samp{]} for each recursive editing level (not counting minibuffer -levels). - -@item %% -The character @samp{%}---this is how to include a literal @samp{%} in a -string in which @code{%}-constructs are allowed. - -@item %- -Dashes sufficient to fill the remainder of the modeline. -@end table - -The following two @code{%}-constructs are still supported, but they are -obsolete, since you can get the same results with the variables -@code{mode-name} and @code{global-mode-string}. - -@table @code -@item %m -The value of @code{mode-name}. - -@item %M -The value of @code{global-mode-string}. Currently, only -@code{display-time} modifies the value of @code{global-mode-string}. -@end table - -@node Hooks -@section Hooks -@cindex hooks - - A @dfn{hook} is a variable where you can store a function or functions -to be called on a particular occasion by an existing program. XEmacs -provides hooks for the sake of customization. Most often, hooks are set -up in the @file{.emacs} file, but Lisp programs can set them also. -@xref{Standard Hooks}, for a list of standard hook variables. - - Most of the hooks in XEmacs are @dfn{normal hooks}. These variables -contain lists of functions to be called with no arguments. The reason -most hooks are normal hooks is so that you can use them in a uniform -way. You can usually tell when a hook is a normal hook, because its -name ends in @samp{-hook}. - - The recommended way to add a hook function to a normal hook is by -calling @code{add-hook} (see below). The hook functions may be any of -the valid kinds of functions that @code{funcall} accepts (@pxref{What Is -a Function}). Most normal hook variables are initially void; -@code{add-hook} knows how to deal with this. - - As for abnormal hooks, those whose names end in @samp{-function} have -a value that is a single function. Those whose names end in -@samp{-hooks} have a value that is a list of functions. Any hook that -is abnormal is abnormal because a normal hook won't do the job; either -the functions are called with arguments, or their values are meaningful. -The name shows you that the hook is abnormal and that you should look at -its documentation string to see how to use it properly. - - Major mode functions are supposed to run a hook called the @dfn{mode -hook} as the last step of initialization. This makes it easy for a user -to customize the behavior of the mode, by overriding the local variable -assignments already made by the mode. But hooks are used in other -contexts too. For example, the hook @code{suspend-hook} runs just -before XEmacs suspends itself (@pxref{Suspending XEmacs}). - - Here's an expression that uses a mode hook to turn on Auto Fill mode -when in Lisp Interaction mode: - -@example -(add-hook 'lisp-interaction-mode-hook 'turn-on-auto-fill) -@end example - - The next example shows how to use a hook to customize the way XEmacs -formats C code. (People often have strong personal preferences for one -format or another.) Here the hook function is an anonymous lambda -expression. - -@cindex lambda expression in hook -@example -@group -(add-hook 'c-mode-hook - (function (lambda () - (setq c-indent-level 4 - c-argdecl-indent 0 - c-label-offset -4 -@end group -@group - c-continued-statement-indent 0 - c-brace-offset 0 - comment-column 40)))) - -(setq c++-mode-hook c-mode-hook) -@end group -@end example - -The final example shows how the appearance of the modeline can be -modified for a particular class of buffers only. - -@example -@group -(add-hook 'text-mode-hook - (function (lambda () - (setq modeline-format - '(modeline-modified - "Emacs: %14b" - " " -@end group -@group - default-directory - " " - global-mode-string - "%[(" - mode-name - minor-mode-alist - "%n" - modeline-process - ") %]---" - (-3 . "%p") - "-%-"))))) -@end group -@end example - - At the appropriate time, XEmacs uses the @code{run-hooks} function to -run particular hooks. This function calls the hook functions you have -added with @code{add-hooks}. - -@defun run-hooks &rest hookvar -This function takes one or more hook variable names as arguments, and -runs each hook in turn. Each @var{hookvar} argument should be a symbol -that is a hook variable. These arguments are processed in the order -specified. - -If a hook variable has a non-@code{nil} value, that value may be a -function or a list of functions. If the value is a function (either a -lambda expression or a symbol with a function definition), it is -called. If it is a list, the elements are called, in order. -The hook functions are called with no arguments. - -For example, here's how @code{emacs-lisp-mode} runs its mode hook: - -@example -(run-hooks 'emacs-lisp-mode-hook) -@end example -@end defun - -@defun add-hook hook function &optional append local -This function is the handy way to add function @var{function} to hook -variable @var{hook}. The argument @var{function} may be any valid Lisp -function with the proper number of arguments. For example, - -@example -(add-hook 'text-mode-hook 'my-text-hook-function) -@end example - -@noindent -adds @code{my-text-hook-function} to the hook called @code{text-mode-hook}. - -You can use @code{add-hook} for abnormal hooks as well as for normal -hooks. - -It is best to design your hook functions so that the order in which they -are executed does not matter. Any dependence on the order is ``asking -for trouble.'' However, the order is predictable: normally, -@var{function} goes at the front of the hook list, so it will be -executed first (barring another @code{add-hook} call). - -If the optional argument @var{append} is non-@code{nil}, the new hook -function goes at the end of the hook list and will be executed last. - -If @var{local} is non-@code{nil}, that says to make the new hook -function local to the current buffer. Before you can do this, you must -make the hook itself buffer-local by calling @code{make-local-hook} -(@strong{not} @code{make-local-variable}). If the hook itself is not -buffer-local, then the value of @var{local} makes no difference---the -hook function is always global. -@end defun - -@defun remove-hook hook function &optional local -This function removes @var{function} from the hook variable @var{hook}. - -If @var{local} is non-@code{nil}, that says to remove @var{function} -from the local hook list instead of from the global hook list. If the -hook itself is not buffer-local, then the value of @var{local} makes no -difference. -@end defun - -@defun make-local-hook hook -This function makes the hook variable @code{hook} local to the current -buffer. When a hook variable is local, it can have local and global -hook functions, and @code{run-hooks} runs all of them. - -This function works by making @code{t} an element of the buffer-local -value. That serves as a flag to use the hook functions in the default -value of the hook variable as well as those in the local value. Since -@code{run-hooks} understands this flag, @code{make-local-hook} works -with all normal hooks. It works for only some non-normal hooks---those -whose callers have been updated to understand this meaning of @code{t}. - -Do not use @code{make-local-variable} directly for hook variables; it is -not sufficient. -@end defun diff --git a/man/lispref/mouse.texi b/man/lispref/mouse.texi deleted file mode 100644 index 9f9424a..0000000 --- a/man/lispref/mouse.texi +++ /dev/null @@ -1,107 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/mouse.info -@node Mouse -@chapter The Mouse -@cindex mouse - -* Mouse Position:: Asking where the mouse is, or moving it. - -@ignore @c Not in XEmacs. -@node Mouse Tracking -@section Mouse Tracking -@cindex mouse tracking -@cindex tracking the mouse - -(deleted) -@end ignore - -@ignore -@c These are not implemented yet. - -These functions change the screen appearance instantaneously. The -effect is transient, only until the next ordinary XEmacs redisplay. That -is ok for mouse tracking, since it doesn't make sense for mouse tracking -to change the text, and the body of @code{track-mouse} normally reads -the events itself and does not do redisplay. - -@defun x-contour-region window beg end -This function draws lines to make a box around the text from @var{beg} -to @var{end}, in window @var{window}. -@end defun - -@defun x-uncontour-region window beg end -This function erases the lines that would make a box around the text -from @var{beg} to @var{end}, in window @var{window}. Use it to remove -a contour that you previously made by calling @code{x-contour-region}. -@end defun - -@defun x-draw-rectangle frame left top right bottom -This function draws a hollow rectangle on frame @var{frame} with the -specified edge coordinates, all measured in pixels from the inside top -left corner. It uses the cursor color, the one used for indicating the -location of point. -@end defun - -@defun x-erase-rectangle frame left top right bottom -This function erases a hollow rectangle on frame @var{frame} with the -specified edge coordinates, all measured in pixels from the inside top -left corner. Erasure means redrawing the text and background that -normally belong in the specified rectangle. -@end defun -@end ignore - -@node Mouse Position -@section Mouse Position -@cindex mouse position -@cindex position of mouse - -The functions @code{mouse-position}, @code{mouse-pixel-position}, -@code{set-mouse-position} and @code{set-mouse-pixel-position} give -access to the current position of the mouse. - -@defun mouse-position &optional device -This function returns a list (@var{window} @var{x} . @var{y}) giving the -current mouse window and position. The position is given in character -cells, where @samp{(0, 0)} is the upper-left corner. - -@var{device} specifies the device on which to read the mouse position, -and defaults to the selected device. If the device is a mouseless -terminal or XEmacs hasn't been programmed to read its mouse position, it -returns the device's selected window for @var{window} and @code{nil} for -@var{x} and @var{y}. -@end defun - -@defun mouse-pixel-position &optional device -This function returns a list (@var{window} @var{x} . @var{y}) giving the -current mouse window and position. The position is given in pixel -units, where @samp{(0, 0)} is the upper-left corner. - -@var{device} specifies the device on which to read the mouse position, -and defaults to the selected device. If the device is a mouseless -terminal or XEmacs hasn't been programmed to read its mouse position, it -returns the device's selected window for @var{window} and @code{nil} for -@var{x} and @var{y}. -@end defun - -@defun set-mouse-position window x y -This function @dfn{warps the mouse} to the center of character position -@var{x}, @var{y} in frame @var{window}. The arguments @var{x} and -@var{y} are integers, giving the position in characters relative to -the top left corner of @var{window}. - -@cindex warping the mouse -@cindex mouse warping -Warping the mouse means changing the screen position of the mouse as if -the user had moved the physical mouse---thus simulating the effect of -actual mouse motion. -@end defun - -@defun set-mouse-pixel-position window x y -This function @dfn{warps the mouse} to pixel position @var{x}, @var{y} -in frame @var{window}. The arguments @var{x} and @var{y} are integers, -giving the position in pixels relative to the top left corner of -@var{window}. -@end defun diff --git a/man/lispref/mule.texi b/man/lispref/mule.texi deleted file mode 100644 index 4e1a8e7..0000000 --- a/man/lispref/mule.texi +++ /dev/null @@ -1,1198 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/internationalization.info -@node MULE, Tips, Internationalization, top -@chapter MULE - -@dfn{MULE} is the name originally given to the version of GNU Emacs -extended for multi-lingual (and in particular Asian-language) support. -``MULE'' is short for ``MUlti-Lingual Emacs''. It was originally called -Nemacs (``Nihon Emacs'' where ``Nihon'' is the Japanese word for -``Japan''), when it only provided support for Japanese. XEmacs -refers to its multi-lingual support as @dfn{MULE support} since it -is based on @dfn{MULE}. - -@menu -* Internationalization Terminology:: - Definition of various internationalization terms. -* Charsets:: Sets of related characters. -* MULE Characters:: Working with characters in XEmacs/MULE. -* Composite Characters:: Making new characters by overstriking other ones. -* ISO 2022:: An international standard for charsets and encodings. -* Coding Systems:: Ways of representing a string of chars using integers. -* CCL:: A special language for writing fast converters. -* Category Tables:: Subdividing charsets into groups. -@end menu - -@node Internationalization Terminology -@section Internationalization Terminology - - In internationalization terminology, a string of text is divided up -into @dfn{characters}, which are the printable units that make up the -text. A single character is (for example) a capital @samp{A}, the -number @samp{2}, a Katakana character, a Kanji ideograph (an -@dfn{ideograph} is a ``picture'' character, such as is used in Japanese -Kanji, Chinese Hanzi, and Korean Hangul; typically there are thousands -of such ideographs in each language), etc. The basic property of a -character is its shape. Note that the same character may be drawn by -two different people (or in two different fonts) in slightly different -ways, although the basic shape will be the same. - - In some cases, the differences will be significant enough that it is -actually possible to identify two or more distinct shapes that both -represent the same character. For example, the lowercase letters -@samp{a} and @samp{g} each have two distinct possible shapes -- the -@samp{a} can optionally have a curved tail projecting off the top, and -the @samp{g} can be formed either of two loops, or of one loop and a -tail hanging off the bottom. Such distinct possible shapes of a -character are called @dfn{glyphs}. The important characteristic of two -glyphs making up the same character is that the choice between one or -the other is purely stylistic and has no linguistic effect on a word -(this is the reason why a capital @samp{A} and lowercase @samp{a} -are different characters rather than different glyphs -- e.g. -@samp{Aspen} is a city while @samp{aspen} is a kind of tree). - - Note that @dfn{character} and @dfn{glyph} are used differently -here than elsewhere in XEmacs. - - A @dfn{character set} is simply a set of related characters. ASCII, -for example, is a set of 94 characters (or 128, if you count -non-printing characters). Other character sets are ISO8859-1 (ASCII -plus various accented characters and other international symbols), -JISX0201 (ASCII, more or less, plus half-width Katakana), JISX0208 -(Japanese Kanji), JISX0212 (a second set of less-used Japanese Kanji), -GB2312 (Mainland Chinese Hanzi), etc. - - Every character set has one or more @dfn{orderings}, which can be -viewed as a way of assigning a number (or set of numbers) to each -character in the set. For most character sets, there is a standard -ordering, and in fact all of the character sets mentioned above define a -particular ordering. ASCII, for example, places letters in their -``natural'' order, puts uppercase letters before lowercase letters, -numbers before letters, etc. Note that for many of the Asian character -sets, there is no natural ordering of the characters. The actual -orderings are based on one or more salient characteristic, of which -there are many to choose from -- e.g. number of strokes, common -radicals, phonetic ordering, etc. - - The set of numbers assigned to any particular character are called -the character's @dfn{position codes}. The number of position codes -required to index a particular character in a character set is called -the @dfn{dimension} of the character set. ASCII, being a relatively -small character set, is of dimension one, and each character in the -set is indexed using a single position code, in the range 0 through -127 (if non-printing characters are included) or 33 through 126 -(if only the printing characters are considered). JISX0208, i.e. -Japanese Kanji, has thousands of characters, and is of dimension two -- -every character is indexed by two position codes, each in the range -33 through 126. (Note that the choice of the range here is somewhat -arbitrary. Although a character set such as JISX0208 defines an -@emph{ordering} of all its characters, it does not define the actual -mapping between numbers and characters. You could just as easily -index the characters in JISX0208 using numbers in the range 0 through -93, 1 through 94, 2 through 95, etc. The reason for the actual range -chosen is so that the position codes match up with the actual values -used in the common encodings.) - - An @dfn{encoding} is a way of numerically representing characters from -one or more character sets into a stream of like-sized numerical values -called @dfn{words}; typically these are 8-bit, 16-bit, or 32-bit -quantities. If an encoding encompasses only one character set, then the -position codes for the characters in that character set could be used -directly. (This is the case with ASCII, and as a result, most people do -not understand the difference between a character set and an encoding.) -This is not possible, however, if more than one character set is to be -used in the encoding. For example, printed Japanese text typically -requires characters from multiple character sets -- ASCII, JISX0208, and -JISX0212, to be specific. Each of these is indexed using one or more -position codes in the range 33 through 126, so the position codes could -not be used directly or there would be no way to tell which character -was meant. Different Japanese encodings handle this differently -- JIS -uses special escape characters to denote different character sets; EUC -sets the high bit of the position codes for JISX0208 and JISX0212, and -puts a special extra byte before each JISX0212 character; etc. (JIS, -EUC, and most of the other encodings you will encounter are 7-bit or -8-bit encodings. There is one common 16-bit encoding, which is Unicode; -this strives to represent all the world's characters in a single large -character set. 32-bit encodings are generally used internally in -programs to simplify the code that manipulates them; however, they are -not much used externally because they are not very space-efficient.) - - Encodings are classified as either @dfn{modal} or @dfn{non-modal}. In -a @dfn{modal encoding}, there are multiple states that the encoding can be in, -and the interpretation of the values in the stream depends on the -current global state of the encoding. Special values in the encoding, -called @dfn{escape sequences}, are used to change the global state. -JIS, for example, is a modal encoding. The bytes @samp{ESC $ B} -indicate that, from then on, bytes are to be interpreted as position -codes for JISX0208, rather than as ASCII. This effect is cancelled -using the bytes @samp{ESC ( B}, which mean ``switch from whatever the -current state is to ASCII''. To switch to JISX0212, the escape sequence -@samp{ESC $ ( D}. (Note that here, as is common, the escape sequences do -in fact begin with @samp{ESC}. This is not necessarily the case, -however.) - -A @dfn{non-modal encoding} has no global state that extends past the -character currently being interpreted. EUC, for example, is a -non-modal encoding. Characters in JISX0208 are encoded by setting -the high bit of the position codes, and characters in JISX0212 are -encoded by doing the same but also prefixing the character with the -byte 0x8F. - - The advantage of a modal encoding is that it is generally more -space-efficient, and is easily extendable because there are essentially -an arbitrary number of escape sequences that can be created. The -disadvantage, however, is that it is much more difficult to work with -if it is not being processed in a sequential manner. In the non-modal -EUC encoding, for example, the byte 0x41 always refers to the letter -@samp{A}; whereas in JIS, it could either be the letter @samp{A}, or -one of the two position codes in a JISX0208 character, or one of the -two position codes in a JISX0212 character. Determining exactly which -one is meant could be difficult and time-consuming if the previous -bytes in the string have not already been processed. - - Non-modal encodings are further divided into @dfn{fixed-width} and -@dfn{variable-width} formats. A fixed-width encoding always uses -the same number of words per character, whereas a variable-width -encoding does not. EUC is a good example of a variable-width -encoding: one to three bytes are used per character, depending on -the character set. 16-bit and 32-bit encodings are nearly always -fixed-width, and this is in fact one of the main reasons for using -an encoding with a larger word size. The advantages of fixed-width -encodings should be obvious. The advantages of variable-width -encodings are that they are generally more space-efficient and allow -for compatibility with existing 8-bit encodings such as ASCII. - - Note that the bytes in an 8-bit encoding are often referred to -as @dfn{octets} rather than simply as bytes. This terminology -dates back to the days before 8-bit bytes were universal, when -some computers had 9-bit bytes, others had 10-bit bytes, etc. - -@node Charsets -@section Charsets - - A @dfn{charset} in MULE is an object that encapsulates a -particular character set as well as an ordering of those characters. -Charsets are permanent objects and are named using symbols, like -faces. - -@defun charsetp object -This function returns non-@code{nil} if @var{object} is a charset. -@end defun - -@menu -* Charset Properties:: Properties of a charset. -* Basic Charset Functions:: Functions for working with charsets. -* Charset Property Functions:: Functions for accessing charset properties. -* Predefined Charsets:: Predefined charset objects. -@end menu - -@node Charset Properties -@subsection Charset Properties - - Charsets have the following properties: - -@table @code -@item name -A symbol naming the charset. Every charset must have a different name; -this allows a charset to be referred to using its name rather than -the actual charset object. -@item doc-string -A documentation string describing the charset. -@item registry -A regular expression matching the font registry field for this character -set. For example, both the @code{ascii} and @code{latin-iso8859-1} -charsets use the registry @code{"ISO8859-1"}. This field is used to -choose an appropriate font when the user gives a general font -specification such as @samp{-*-courier-medium-r-*-140-*}, i.e. a -14-point upright medium-weight Courier font. -@item dimension -Number of position codes used to index a character in the character set. -XEmacs/MULE can only handle character sets of dimension 1 or 2. -This property defaults to 1. -@item chars -Number of characters in each dimension. In XEmacs/MULE, the only -allowed values are 94 or 96. (There are a couple of pre-defined -character sets, such as ASCII, that do not follow this, but you cannot -define new ones like this.) Defaults to 94. Note that if the dimension -is 2, the character set thus described is 94x94 or 96x96. -@item columns -Number of columns used to display a character in this charset. -Only used in TTY mode. (Under X, the actual width of a character -can be derived from the font used to display the characters.) -If unspecified, defaults to the dimension. (This is almost -always the correct value, because character sets with dimension 2 -are usually ideograph character sets, which need two columns to -display the intricate ideographs.) -@item direction -A symbol, either @code{l2r} (left-to-right) or @code{r2l} -(right-to-left). Defaults to @code{l2r}. This specifies the -direction that the text should be displayed in, and will be -left-to-right for most charsets but right-to-left for Hebrew -and Arabic. (Right-to-left display is not currently implemented.) -@item final -Final byte of the standard ISO 2022 escape sequence designating this -charset. Must be supplied. Each combination of (@var{dimension}, -@var{chars}) defines a separate namespace for final bytes, and each -charset within a particular namespace must have a different final byte. -Note that ISO 2022 restricts the final byte to the range 0x30 - 0x7E if -dimension == 1, and 0x30 - 0x5F if dimension == 2. Note also that final -bytes in the range 0x30 - 0x3F are reserved for user-defined (not -official) character sets. For more information on ISO 2022, see @ref{Coding -Systems}. -@item graphic -0 (use left half of font on output) or 1 (use right half of font on -output). Defaults to 0. This specifies how to convert the position -codes that index a character in a character set into an index into the -font used to display the character set. With @code{graphic} set to 0, -position codes 33 through 126 map to font indices 33 through 126; with -it set to 1, position codes 33 through 126 map to font indices 161 -through 254 (i.e. the same number but with the high bit set). For -example, for a font whose registry is ISO8859-1, the left half of the -font (octets 0x20 - 0x7F) is the @code{ascii} charset, while the right -half (octets 0xA0 - 0xFF) is the @code{latin-iso8859-1} charset. -@item ccl-program -A compiled CCL program used to convert a character in this charset into -an index into the font. This is in addition to the @code{graphic} -property. If a CCL program is defined, the position codes of a -character will first be processed according to @code{graphic} and -then passed through the CCL program, with the resulting values used -to index the font. - -This is used, for example, in the Big5 character set (used in Taiwan). -This character set is not ISO-2022-compliant, and its size (94x157) does -not fit within the maximum 96x96 size of ISO-2022-compliant character -sets. As a result, XEmacs/MULE splits it (in a rather complex fashion, -so as to group the most commonly used characters together) into two -charset objects (@code{big5-1} and @code{big5-2}), each of size 94x94, -and each charset object uses a CCL program to convert the modified -position codes back into standard Big5 indices to retrieve a character -from a Big5 font. -@end table - -Most of the above properties can only be changed when the charset -is created. @xref{Charset Property Functions}. - -@node Basic Charset Functions -@subsection Basic Charset Functions - -@defun find-charset charset-or-name -This function retrieves the charset of the given name. If -@var{charset-or-name} is a charset object, it is simply returned. -Otherwise, @var{charset-or-name} should be a symbol. If there is no -such charset, @code{nil} is returned. Otherwise the associated charset -object is returned. -@end defun - -@defun get-charset name -This function retrieves the charset of the given name. Same as -@code{find-charset} except an error is signalled if there is no such -charset instead of returning @code{nil}. -@end defun - -@defun charset-list -This function returns a list of the names of all defined charsets. -@end defun - -@defun make-charset name doc-string props -This function defines a new character set. This function is for use -with Mule support. @var{name} is a symbol, the name by which the -character set is normally referred. @var{doc-string} is a string -describing the character set. @var{props} is a property list, -describing the specific nature of the character set. The recognized -properties are @code{registry}, @code{dimension}, @code{columns}, -@code{chars}, @code{final}, @code{graphic}, @code{direction}, and -@code{ccl-program}, as previously described. -@end defun - -@defun make-reverse-direction-charset charset new-name -This function makes a charset equivalent to @var{charset} but which goes -in the opposite direction. @var{new-name} is the name of the new -charset. The new charset is returned. -@end defun - -@defun charset-from-attributes dimension chars final &optional direction -This function returns a charset with the given @var{dimension}, -@var{chars}, @var{final}, and @var{direction}. If @var{direction} is -omitted, both directions will be checked (left-to-right will be returned -if character sets exist for both directions). -@end defun - -@defun charset-reverse-direction-charset charset -This function returns the charset (if any) with the same dimension, -number of characters, and final byte as @var{charset}, but which is -displayed in the opposite direction. -@end defun - -@node Charset Property Functions -@subsection Charset Property Functions - -All of these functions accept either a charset name or charset object. - -@defun charset-property charset prop -This function returns property @var{prop} of @var{charset}. -@xref{Charset Properties}. -@end defun - -Convenience functions are also provided for retrieving individual -properties of a charset. - -@defun charset-name charset -This function returns the name of @var{charset}. This will be a symbol. -@end defun - -@defun charset-doc-string charset -This function returns the doc string of @var{charset}. -@end defun - -@defun charset-registry charset -This function returns the registry of @var{charset}. -@end defun - -@defun charset-dimension charset -This function returns the dimension of @var{charset}. -@end defun - -@defun charset-chars charset -This function returns the number of characters per dimension of -@var{charset}. -@end defun - -@defun charset-columns charset -This function returns the number of display columns per character (in -TTY mode) of @var{charset}. -@end defun - -@defun charset-direction charset -This function returns the display direction of @var{charset} -- either -@code{l2r} or @code{r2l}. -@end defun - -@defun charset-final charset -This function returns the final byte of the ISO 2022 escape sequence -designating @var{charset}. -@end defun - -@defun charset-graphic charset -This function returns either 0 or 1, depending on whether the position -codes of characters in @var{charset} map to the left or right half -of their font, respectively. -@end defun - -@defun charset-ccl-program charset -This function returns the CCL program, if any, for converting -position codes of characters in @var{charset} into font indices. -@end defun - -The only property of a charset that can currently be set after -the charset has been created is the CCL program. - -@defun set-charset-ccl-program charset ccl-program -This function sets the @code{ccl-program} property of @var{charset} to -@var{ccl-program}. -@end defun - -@node Predefined Charsets -@subsection Predefined Charsets - -The following charsets are predefined in the C code. - -@example -Name Type Fi Gr Dir Registry --------------------------------------------------------------- -ascii 94 B 0 l2r ISO8859-1 -control-1 94 0 l2r --- -latin-iso8859-1 94 A 1 l2r ISO8859-1 -latin-iso8859-2 96 B 1 l2r ISO8859-2 -latin-iso8859-3 96 C 1 l2r ISO8859-3 -latin-iso8859-4 96 D 1 l2r ISO8859-4 -cyrillic-iso8859-5 96 L 1 l2r ISO8859-5 -arabic-iso8859-6 96 G 1 r2l ISO8859-6 -greek-iso8859-7 96 F 1 l2r ISO8859-7 -hebrew-iso8859-8 96 H 1 r2l ISO8859-8 -latin-iso8859-9 96 M 1 l2r ISO8859-9 -thai-tis620 96 T 1 l2r TIS620 -katakana-jisx0201 94 I 1 l2r JISX0201.1976 -latin-jisx0201 94 J 0 l2r JISX0201.1976 -japanese-jisx0208-1978 94x94 @@ 0 l2r JISX0208.1978 -japanese-jisx0208 94x94 B 0 l2r JISX0208.19(83|90) -japanese-jisx0212 94x94 D 0 l2r JISX0212 -chinese-gb2312 94x94 A 0 l2r GB2312 -chinese-cns11643-1 94x94 G 0 l2r CNS11643.1 -chinese-cns11643-2 94x94 H 0 l2r CNS11643.2 -chinese-big5-1 94x94 0 0 l2r Big5 -chinese-big5-2 94x94 1 0 l2r Big5 -korean-ksc5601 94x94 C 0 l2r KSC5601 -composite 96x96 0 l2r --- -@end example - -The following charsets are predefined in the Lisp code. - -@example -Name Type Fi Gr Dir Registry --------------------------------------------------------------- -arabic-digit 94 2 0 l2r MuleArabic-0 -arabic-1-column 94 3 0 r2l MuleArabic-1 -arabic-2-column 94 4 0 r2l MuleArabic-2 -sisheng 94 0 0 l2r sisheng_cwnn\|OMRON_UDC_ZH -chinese-cns11643-3 94x94 I 0 l2r CNS11643.1 -chinese-cns11643-4 94x94 J 0 l2r CNS11643.1 -chinese-cns11643-5 94x94 K 0 l2r CNS11643.1 -chinese-cns11643-6 94x94 L 0 l2r CNS11643.1 -chinese-cns11643-7 94x94 M 0 l2r CNS11643.1 -ethiopic 94x94 2 0 l2r Ethio -ascii-r2l 94 B 0 r2l ISO8859-1 -ipa 96 0 1 l2r MuleIPA -vietnamese-lower 96 1 1 l2r VISCII1.1 -vietnamese-upper 96 2 1 l2r VISCII1.1 -@end example - -For all of the above charsets, the dimension and number of columns are -the same. - -Note that ASCII, Control-1, and Composite are handled specially. -This is why some of the fields are blank; and some of the filled-in -fields (e.g. the type) are not really accurate. - -@node MULE Characters -@section MULE Characters - -@defun make-char charset arg1 &optional arg2 -This function makes a multi-byte character from @var{charset} and octets -@var{arg1} and @var{arg2}. -@end defun - -@defun char-charset ch -This function returns the character set of char @var{ch}. -@end defun - -@defun char-octet ch &optional n -This function returns the octet (i.e. position code) numbered @var{n} -(should be 0 or 1) of char @var{ch}. @var{n} defaults to 0 if omitted. -@end defun - -@defun find-charset-region start end &optional buffer -This function returns a list of the charsets in the region between -@var{start} and @var{end}. @var{buffer} defaults to the current buffer -if omitted. -@end defun - -@defun find-charset-string string -This function returns a list of the charsets in @var{string}. -@end defun - -@node Composite Characters -@section Composite Characters - -Composite characters are not yet completely implemented. - -@defun make-composite-char string -This function converts a string into a single composite character. The -character is the result of overstriking all the characters in the -string. -@end defun - -@defun composite-char-string ch -This function returns a string of the characters comprising a composite -character. -@end defun - -@defun compose-region start end &optional buffer -This function composes the characters in the region from @var{start} to -@var{end} in @var{buffer} into one composite character. The composite -character replaces the composed characters. @var{buffer} defaults to -the current buffer if omitted. -@end defun - -@defun decompose-region start end &optional buffer -This function decomposes any composite characters in the region from -@var{start} to @var{end} in @var{buffer}. This converts each composite -character into one or more characters, the individual characters out of -which the composite character was formed. Non-composite characters are -left as-is. @var{buffer} defaults to the current buffer if omitted. -@end defun - -@node ISO 2022 -@section ISO 2022 - -This section briefly describes the ISO 2022 encoding standard. For more -thorough understanding, please refer to the original document of ISO -2022. - -Character sets (@dfn{charsets}) are classified into the following four -categories, according to the number of characters of charset: -94-charset, 96-charset, 94x94-charset, and 96x96-charset. - -@need 1000 -@table @asis -@item 94-charset - ASCII(B), left(J) and right(I) half of JISX0201, ... -@item 96-charset - Latin-1(A), Latin-2(B), Latin-3(C), ... -@item 94x94-charset - GB2312(A), JISX0208(B), KSC5601(C), ... -@item 96x96-charset - none for the moment -@end table - -The character in parentheses after the name of each charset -is the @dfn{final character} @var{F}, which can be regarded as -the identifier of the charset. ECMA allocates @var{F} to each -charset. @var{F} is in the range of 0x30..0x7F, but 0x30..0x3F -are only for private use. - -Note: @dfn{ECMA} = European Computer Manufacturers Association - -There are four @dfn{registers of charsets}, called G0 thru G3. -You can designate (or assign) any charset to one of these -registers. - -The code space contained within one octet (of size 256) is divided into -4 areas: C0, GL, C1, and GR. GL and GR are the areas into which a -register of charset can be invoked into. - -@example -@group - C0: 0x00 - 0x1F - GL: 0x20 - 0x7F - C1: 0x80 - 0x9F - GR: 0xA0 - 0xFF -@end group -@end example - -Usually, in the initial state, G0 is invoked into GL, and G1 -is invoked into GR. - -ISO 2022 distinguishes 7-bit environments and 8-bit environments. In -7-bit environments, only C0 and GL are used. - -Charset designation is done by escape sequences of the form: - -@example - ESC [@var{I}] @var{I} @var{F} -@end example - -where @var{I} is an intermediate character in the range 0x20 - 0x2F, and -@var{F} is the final character identifying this charset. - -The meaning of intermediate characters are: - -@example -@group - $ [0x24]: indicate charset of dimension 2 (94x94 or 96x96). - ( [0x28]: designate to G0 a 94-charset whose final byte is @var{F}. - ) [0x29]: designate to G1 a 94-charset whose final byte is @var{F}. - * [0x2A]: designate to G2 a 94-charset whose final byte is @var{F}. - + [0x2B]: designate to G3 a 94-charset whose final byte is @var{F}. - - [0x2D]: designate to G1 a 96-charset whose final byte is @var{F}. - . [0x2E]: designate to G2 a 96-charset whose final byte is @var{F}. - / [0x2F]: designate to G3 a 96-charset whose final byte is @var{F}. -@end group -@end example - -The following rule is not allowed in ISO 2022 but can be used in Mule. - -@example - , [0x2C]: designate to G0 a 96-charset whose final byte is @var{F}. -@end example - -Here are examples of designations: - -@example -@group - ESC ( B : designate to G0 ASCII - ESC - A : designate to G1 Latin-1 - ESC $ ( A or ESC $ A : designate to G0 GB2312 - ESC $ ( B or ESC $ B : designate to G0 JISX0208 - ESC $ ) C : designate to G1 KSC5601 -@end group -@end example - -To use a charset designated to G2 or G3, and to use a charset designated -to G1 in a 7-bit environment, you must explicitly invoke G1, G2, or G3 -into GL. There are two types of invocation, Locking Shift (forever) and -Single Shift (one character only). - -Locking Shift is done as follows: - -@example - LS0 or SI (0x0F): invoke G0 into GL - LS1 or SO (0x0E): invoke G1 into GL - LS2: invoke G2 into GL - LS3: invoke G3 into GL - LS1R: invoke G1 into GR - LS2R: invoke G2 into GR - LS3R: invoke G3 into GR -@end example - -Single Shift is done as follows: - -@example -@group - SS2 or ESC N: invoke G2 into GL - SS3 or ESC O: invoke G3 into GL -@end group -@end example - -(#### Ben says: I think the above is slightly incorrect. It appears that -SS2 invokes G2 into GR and SS3 invokes G3 into GR, whereas ESC N and -ESC O behave as indicated. The above definitions will not parse -EUC-encoded text correctly, and it looks like the code in mule-coding.c -has similar problems.) - -You may realize that there are a lot of ISO-2022-compliant ways of -encoding multilingual text. Now, in the world, there exist many coding -systems such as X11's Compound Text, Japanese JUNET code, and so-called -EUC (Extended UNIX Code); all of these are variants of ISO 2022. - -In Mule, we characterize ISO 2022 by the following attributes: - -@enumerate -@item -Initial designation to G0 thru G3. -@item -Allow designation of short form for Japanese and Chinese. -@item -Should we designate ASCII to G0 before control characters? -@item -Should we designate ASCII to G0 at the end of line? -@item -7-bit environment or 8-bit environment. -@item -Use Locking Shift or not. -@item -Use ASCII or JIS0201-1976-Roman. -@item -Use JISX0208-1983 or JISX0208-1976. -@end enumerate - -(The last two are only for Japanese.) - -By specifying these attributes, you can create any variant -of ISO 2022. - -Here are several examples: - -@example -@group -junet -- Coding system used in JUNET. - 1. G0 <- ASCII, G1..3 <- never used - 2. Yes. - 3. Yes. - 4. Yes. - 5. 7-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 -@end group - -@group -ctext -- Compound Text - 1. G0 <- ASCII, G1 <- Latin-1, G2,3 <- never used - 2. No. - 3. No. - 4. Yes. - 5. 8-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 -@end group - -@group -euc-china -- Chinese EUC. Although many people call this -as "GB encoding", the name may cause misunderstanding. - 1. G0 <- ASCII, G1 <- GB2312, G2,3 <- never used - 2. No. - 3. Yes. - 4. Yes. - 5. 8-bit environment - 6. No. - 7. Use ASCII - 8. Use JISX0208-1983 -@end group - -@group -korean-mail -- Coding system used in Korean network. - 1. G0 <- ASCII, G1 <- KSC5601, G2,3 <- never used - 2. No. - 3. Yes. - 4. Yes. - 5. 7-bit environment - 6. Yes. - 7. No. - 8. No. -@end group -@end example - -Mule creates all these coding systems by default. - -@node Coding Systems -@section Coding Systems - -A coding system is an object that defines how text containing multiple -character sets is encoded into a stream of (typically 8-bit) bytes. The -coding system is used to decode the stream into a series of characters -(which may be from multiple charsets) when the text is read from a file -or process, and is used to encode the text back into the same format -when it is written out to a file or process. - -For example, many ISO-2022-compliant coding systems (such as Compound -Text, which is used for inter-client data under the X Window System) use -escape sequences to switch between different charsets -- Japanese Kanji, -for example, is invoked with @samp{ESC $ ( B}; ASCII is invoked with -@samp{ESC ( B}; and Cyrillic is invoked with @samp{ESC - L}. See -@code{make-coding-system} for more information. - -Coding systems are normally identified using a symbol, and the symbol is -accepted in place of the actual coding system object whenever a coding -system is called for. (This is similar to how faces and charsets work.) - -@defun coding-system-p object -This function returns non-@code{nil} if @var{object} is a coding system. -@end defun - -@menu -* Coding System Types:: Classifying coding systems. -* EOL Conversion:: Dealing with different ways of denoting - the end of a line. -* Coding System Properties:: Properties of a coding system. -* Basic Coding System Functions:: Working with coding systems. -* Coding System Property Functions:: Retrieving a coding system's properties. -* Encoding and Decoding Text:: Encoding and decoding text. -* Detection of Textual Encoding:: Determining how text is encoded. -* Big5 and Shift-JIS Functions:: Special functions for these non-standard - encodings. -@end menu - -@node Coding System Types -@subsection Coding System Types - -@table @code -@item nil -@itemx autodetect -Automatic conversion. XEmacs attempts to detect the coding system used -in the file. -@item no-conversion -No conversion. Use this for binary files and such. On output, graphic -characters that are not in ASCII or Latin-1 will be replaced by a -@samp{?}. (For a no-conversion-encoded buffer, these characters will -only be present if you explicitly insert them.) -@item shift-jis -Shift-JIS (a Japanese encoding commonly used in PC operating systems). -@item iso2022 -Any ISO-2022-compliant encoding. Among other things, this includes JIS -(the Japanese encoding commonly used for e-mail), national variants of -EUC (the standard Unix encoding for Japanese and other languages), and -Compound Text (an encoding used in X11). You can specify more specific -information about the conversion with the @var{flags} argument. -@item big5 -Big5 (the encoding commonly used for Taiwanese). -@item ccl -The conversion is performed using a user-written pseudo-code program. -CCL (Code Conversion Language) is the name of this pseudo-code. -@item internal -Write out or read in the raw contents of the memory representing the -buffer's text. This is primarily useful for debugging purposes, and is -only enabled when XEmacs has been compiled with @code{DEBUG_XEMACS} set -(the @samp{--debug} configure option). @strong{Warning}: Reading in a -file using @code{internal} conversion can result in an internal -inconsistency in the memory representing a buffer's text, which will -produce unpredictable results and may cause XEmacs to crash. Under -normal circumstances you should never use @code{internal} conversion. -@end table - -@node EOL Conversion -@subsection EOL Conversion - -@table @code -@item nil -Automatically detect the end-of-line type (LF, CRLF, or CR). Also -generate subsidiary coding systems named @code{@var{name}-unix}, -@code{@var{name}-dos}, and @code{@var{name}-mac}, that are identical to -this coding system but have an EOL-TYPE value of @code{lf}, @code{crlf}, -and @code{cr}, respectively. -@item lf -The end of a line is marked externally using ASCII LF. Since this is -also the way that XEmacs represents an end-of-line internally, -specifying this option results in no end-of-line conversion. This is -the standard format for Unix text files. -@item crlf -The end of a line is marked externally using ASCII CRLF. This is the -standard format for MS-DOS text files. -@item cr -The end of a line is marked externally using ASCII CR. This is the -standard format for Macintosh text files. -@item t -Automatically detect the end-of-line type but do not generate subsidiary -coding systems. (This value is converted to @code{nil} when stored -internally, and @code{coding-system-property} will return @code{nil}.) -@end table - -@node Coding System Properties -@subsection Coding System Properties - -@table @code -@item mnemonic -String to be displayed in the modeline when this coding system is -active. - -@item eol-type -End-of-line conversion to be used. It should be one of the types -listed in @ref{EOL Conversion}. - -@item post-read-conversion -Function called after a file has been read in, to perform the decoding. -Called with two arguments, @var{beg} and @var{end}, denoting a region of -the current buffer to be decoded. - -@item pre-write-conversion -Function called before a file is written out, to perform the encoding. -Called with two arguments, @var{beg} and @var{end}, denoting a region of -the current buffer to be encoded. -@end table - -The following additional properties are recognized if @var{type} is -@code{iso2022}: - -@table @code -@item charset-g0 -@itemx charset-g1 -@itemx charset-g2 -@itemx charset-g3 -The character set initially designated to the G0 - G3 registers. -The value should be one of - -@itemize @bullet -@item -A charset object (designate that character set) -@item -@code{nil} (do not ever use this register) -@item -@code{t} (no character set is initially designated to the register, but -may be later on; this automatically sets the corresponding -@code{force-g*-on-output} property) -@end itemize - -@item force-g0-on-output -@itemx force-g1-on-output -@itemx force-g2-on-output -@itemx force-g3-on-output -If non-@code{nil}, send an explicit designation sequence on output -before using the specified register. - -@item short -If non-@code{nil}, use the short forms @samp{ESC $ @@}, @samp{ESC $ A}, -and @samp{ESC $ B} on output in place of the full designation sequences -@samp{ESC $ ( @@}, @samp{ESC $ ( A}, and @samp{ESC $ ( B}. - -@item no-ascii-eol -If non-@code{nil}, don't designate ASCII to G0 at each end of line on -output. Setting this to non-@code{nil} also suppresses other -state-resetting that normally happens at the end of a line. - -@item no-ascii-cntl -If non-@code{nil}, don't designate ASCII to G0 before control chars on -output. - -@item seven -If non-@code{nil}, use 7-bit environment on output. Otherwise, use 8-bit -environment. - -@item lock-shift -If non-@code{nil}, use locking-shift (SO/SI) instead of single-shift or -designation by escape sequence. - -@item no-iso6429 -If non-@code{nil}, don't use ISO6429's direction specification. - -@item escape-quoted -If non-nil, literal control characters that are the same as the -beginning of a recognized ISO 2022 or ISO 6429 escape sequence (in -particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E), SS3 (0x8F), -and CSI (0x9B)) are ``quoted'' with an escape character so that they can -be properly distinguished from an escape sequence. (Note that doing -this results in a non-portable encoding.) This encoding flag is used for -byte-compiled files. Note that ESC is a good choice for a quoting -character because there are no escape sequences whose second byte is a -character from the Control-0 or Control-1 character sets; this is -explicitly disallowed by the ISO 2022 standard. - -@item input-charset-conversion -A list of conversion specifications, specifying conversion of characters -in one charset to another when decoding is performed. Each -specification is a list of two elements: the source charset, and the -destination charset. - -@item output-charset-conversion -A list of conversion specifications, specifying conversion of characters -in one charset to another when encoding is performed. The form of each -specification is the same as for @code{input-charset-conversion}. -@end table - -The following additional properties are recognized (and required) if -@var{type} is @code{ccl}: - -@table @code -@item decode -CCL program used for decoding (converting to internal format). - -@item encode -CCL program used for encoding (converting to external format). -@end table - -@node Basic Coding System Functions -@subsection Basic Coding System Functions - -@defun find-coding-system coding-system-or-name -This function retrieves the coding system of the given name. - -If @var{coding-system-or-name} is a coding-system object, it is simply -returned. Otherwise, @var{coding-system-or-name} should be a symbol. -If there is no such coding system, @code{nil} is returned. Otherwise -the associated coding system object is returned. -@end defun - -@defun get-coding-system name -This function retrieves the coding system of the given name. Same as -@code{find-coding-system} except an error is signalled if there is no -such coding system instead of returning @code{nil}. -@end defun - -@defun coding-system-list -This function returns a list of the names of all defined coding systems. -@end defun - -@defun coding-system-name coding-system -This function returns the name of the given coding system. -@end defun - -@defun make-coding-system name type &optional doc-string props -This function registers symbol @var{name} as a coding system. - -@var{type} describes the conversion method used and should be one of -the types listed in @ref{Coding System Types}. - -@var{doc-string} is a string describing the coding system. - -@var{props} is a property list, describing the specific nature of the -character set. Recognized properties are as in @ref{Coding System -Properties}. -@end defun - -@defun copy-coding-system old-coding-system new-name -This function copies @var{old-coding-system} to @var{new-name}. If -@var{new-name} does not name an existing coding system, a new one will -be created. -@end defun - -@defun subsidiary-coding-system coding-system eol-type -This function returns the subsidiary coding system of -@var{coding-system} with eol type @var{eol-type}. -@end defun - -@node Coding System Property Functions -@subsection Coding System Property Functions - -@defun coding-system-doc-string coding-system -This function returns the doc string for @var{coding-system}. -@end defun - -@defun coding-system-type coding-system -This function returns the type of @var{coding-system}. -@end defun - -@defun coding-system-property coding-system prop -This function returns the @var{prop} property of @var{coding-system}. -@end defun - -@node Encoding and Decoding Text -@subsection Encoding and Decoding Text - -@defun decode-coding-region start end coding-system &optional buffer -This function decodes the text between @var{start} and @var{end} which -is encoded in @var{coding-system}. This is useful if you've read in -encoded text from a file without decoding it (e.g. you read in a -JIS-formatted file but used the @code{binary} or @code{no-conversion} coding -system, so that it shows up as @samp{^[$B! number &rest more-numbers -This function returns @code{t} if the sequence of its arguments is -monotonically decreasing, @code{nil} otherwise. -@end defun - -@defun >= number &rest more-numbers -This function returns @code{t} if the sequence of its arguments is -monotonically nonincreasing, @code{nil} otherwise. -@end defun - -@defun max number &rest more-numbers -This function returns the largest of its arguments. - -@example -(max 20) - @result{} 20 -(max 1 2.5) - @result{} 2.5 -(max 1 3 2.5) - @result{} 3 -@end example -@end defun - -@defun min number &rest more-numbers -This function returns the smallest of its arguments. - -@example -(min -4 1) - @result{} -4 -@end example -@end defun - -@node Numeric Conversions -@section Numeric Conversions -@cindex rounding in conversions - -To convert an integer to floating point, use the function @code{float}. - -@defun float number -This returns @var{number} converted to floating point. -If @var{number} is already a floating point number, @code{float} returns -it unchanged. -@end defun - -There are four functions to convert floating point numbers to integers; -they differ in how they round. These functions accept integer arguments -also, and return such arguments unchanged. - -@defun truncate number -This returns @var{number}, converted to an integer by rounding towards -zero. -@end defun - -@defun floor number &optional divisor -This returns @var{number}, converted to an integer by rounding downward -(towards negative infinity). - -If @var{divisor} is specified, @var{number} is divided by @var{divisor} -before the floor is taken; this is the division operation that -corresponds to @code{mod}. An @code{arith-error} results if -@var{divisor} is 0. -@end defun - -@defun ceiling number -This returns @var{number}, converted to an integer by rounding upward -(towards positive infinity). -@end defun - -@defun round number -This returns @var{number}, converted to an integer by rounding towards the -nearest integer. Rounding a value equidistant between two integers -may choose the integer closer to zero, or it may prefer an even integer, -depending on your machine. -@end defun - -@node Arithmetic Operations -@section Arithmetic Operations - - XEmacs Lisp provides the traditional four arithmetic operations: -addition, subtraction, multiplication, and division. Remainder and modulus -functions supplement the division functions. The functions to -add or subtract 1 are provided because they are traditional in Lisp and -commonly used. - - All of these functions except @code{%} return a floating point value -if any argument is floating. - - It is important to note that in XEmacs Lisp, arithmetic functions -do not check for overflow. Thus @code{(1+ 134217727)} may evaluate to -@minus{}134217728, depending on your hardware. - -@defun 1+ number-or-marker -This function returns @var{number-or-marker} plus 1. -For example, - -@example -(setq foo 4) - @result{} 4 -(1+ foo) - @result{} 5 -@end example - -This function is not analogous to the C operator @code{++}---it does not -increment a variable. It just computes a sum. Thus, if we continue, - -@example -foo - @result{} 4 -@end example - -If you want to increment the variable, you must use @code{setq}, -like this: - -@example -(setq foo (1+ foo)) - @result{} 5 -@end example - -Now that the @code{cl} package is always available from lisp code, a -more convenient and natural way to increment a variable is -@w{@code{(incf foo)}}. -@end defun - -@defun 1- number-or-marker -This function returns @var{number-or-marker} minus 1. -@end defun - -@defun abs number -This returns the absolute value of @var{number}. -@end defun - -@defun + &rest numbers-or-markers -This function adds its arguments together. When given no arguments, -@code{+} returns 0. - -@example -(+) - @result{} 0 -(+ 1) - @result{} 1 -(+ 1 2 3 4) - @result{} 10 -@end example -@end defun - -@defun - &optional number-or-marker &rest other-numbers-or-markers -The @code{-} function serves two purposes: negation and subtraction. -When @code{-} has a single argument, the value is the negative of the -argument. When there are multiple arguments, @code{-} subtracts each of -the @var{other-numbers-or-markers} from @var{number-or-marker}, -cumulatively. If there are no arguments, the result is 0. - -@example -(- 10 1 2 3 4) - @result{} 0 -(- 10) - @result{} -10 -(-) - @result{} 0 -@end example -@end defun - -@defun * &rest numbers-or-markers -This function multiplies its arguments together, and returns the -product. When given no arguments, @code{*} returns 1. - -@example -(*) - @result{} 1 -(* 1) - @result{} 1 -(* 1 2 3 4) - @result{} 24 -@end example -@end defun - -@defun / dividend divisor &rest divisors -This function divides @var{dividend} by @var{divisor} and returns the -quotient. If there are additional arguments @var{divisors}, then it -divides @var{dividend} by each divisor in turn. Each argument may be a -number or a marker. - -If all the arguments are integers, then the result is an integer too. -This means the result has to be rounded. On most machines, the result -is rounded towards zero after each division, but some machines may round -differently with negative arguments. This is because the Lisp function -@code{/} is implemented using the C division operator, which also -permits machine-dependent rounding. As a practical matter, all known -machines round in the standard fashion. - -@cindex @code{arith-error} in division -If you divide by 0, an @code{arith-error} error is signaled. -(@xref{Errors}.) - -@example -@group -(/ 6 2) - @result{} 3 -@end group -(/ 5 2) - @result{} 2 -(/ 25 3 2) - @result{} 4 -(/ -17 6) - @result{} -2 -@end example - -The result of @code{(/ -17 6)} could in principle be -3 on some -machines. -@end defun - -@defun % dividend divisor -@cindex remainder -This function returns the integer remainder after division of @var{dividend} -by @var{divisor}. The arguments must be integers or markers. - -For negative arguments, the remainder is in principle machine-dependent -since the quotient is; but in practice, all known machines behave alike. - -An @code{arith-error} results if @var{divisor} is 0. - -@example -(% 9 4) - @result{} 1 -(% -9 4) - @result{} -1 -(% 9 -4) - @result{} 1 -(% -9 -4) - @result{} -1 -@end example - -For any two integers @var{dividend} and @var{divisor}, - -@example -@group -(+ (% @var{dividend} @var{divisor}) - (* (/ @var{dividend} @var{divisor}) @var{divisor})) -@end group -@end example - -@noindent -always equals @var{dividend}. -@end defun - -@defun mod dividend divisor -@cindex modulus -This function returns the value of @var{dividend} modulo @var{divisor}; -in other words, the remainder after division of @var{dividend} -by @var{divisor}, but with the same sign as @var{divisor}. -The arguments must be numbers or markers. - -Unlike @code{%}, @code{mod} returns a well-defined result for negative -arguments. It also permits floating point arguments; it rounds the -quotient downward (towards minus infinity) to an integer, and uses that -quotient to compute the remainder. - -An @code{arith-error} results if @var{divisor} is 0. - -@example -@group -(mod 9 4) - @result{} 1 -@end group -@group -(mod -9 4) - @result{} 3 -@end group -@group -(mod 9 -4) - @result{} -3 -@end group -@group -(mod -9 -4) - @result{} -1 -@end group -@group -(mod 5.5 2.5) - @result{} .5 -@end group -@end example - -For any two numbers @var{dividend} and @var{divisor}, - -@example -@group -(+ (mod @var{dividend} @var{divisor}) - (* (floor @var{dividend} @var{divisor}) @var{divisor})) -@end group -@end example - -@noindent -always equals @var{dividend}, subject to rounding error if either -argument is floating point. For @code{floor}, see @ref{Numeric -Conversions}. -@end defun - -@node Rounding Operations -@section Rounding Operations -@cindex rounding without conversion - -The functions @code{ffloor}, @code{fceiling}, @code{fround} and -@code{ftruncate} take a floating point argument and return a floating -point result whose value is a nearby integer. @code{ffloor} returns the -nearest integer below; @code{fceiling}, the nearest integer above; -@code{ftruncate}, the nearest integer in the direction towards zero; -@code{fround}, the nearest integer. - -@defun ffloor float -This function rounds @var{float} to the next lower integral value, and -returns that value as a floating point number. -@end defun - -@defun fceiling float -This function rounds @var{float} to the next higher integral value, and -returns that value as a floating point number. -@end defun - -@defun ftruncate float -This function rounds @var{float} towards zero to an integral value, and -returns that value as a floating point number. -@end defun - -@defun fround float -This function rounds @var{float} to the nearest integral value, -and returns that value as a floating point number. -@end defun - -@node Bitwise Operations -@section Bitwise Operations on Integers - - In a computer, an integer is represented as a binary number, a -sequence of @dfn{bits} (digits which are either zero or one). A bitwise -operation acts on the individual bits of such a sequence. For example, -@dfn{shifting} moves the whole sequence left or right one or more places, -reproducing the same pattern ``moved over''. - - The bitwise operations in XEmacs Lisp apply only to integers. - -@defun lsh integer1 count -@cindex logical shift -@code{lsh}, which is an abbreviation for @dfn{logical shift}, shifts the -bits in @var{integer1} to the left @var{count} places, or to the right -if @var{count} is negative, bringing zeros into the vacated bits. If -@var{count} is negative, @code{lsh} shifts zeros into the leftmost -(most-significant) bit, producing a positive result even if -@var{integer1} is negative. Contrast this with @code{ash}, below. - -Here are two examples of @code{lsh}, shifting a pattern of bits one -place to the left. We show only the low-order eight bits of the binary -pattern; the rest are all zero. - -@example -@group -(lsh 5 1) - @result{} 10 -;; @r{Decimal 5 becomes decimal 10.} -00000101 @result{} 00001010 - -(lsh 7 1) - @result{} 14 -;; @r{Decimal 7 becomes decimal 14.} -00000111 @result{} 00001110 -@end group -@end example - -@noindent -As the examples illustrate, shifting the pattern of bits one place to -the left produces a number that is twice the value of the previous -number. - -Shifting a pattern of bits two places to the left produces results -like this (with 8-bit binary numbers): - -@example -@group -(lsh 3 2) - @result{} 12 -;; @r{Decimal 3 becomes decimal 12.} -00000011 @result{} 00001100 -@end group -@end example - -On the other hand, shifting one place to the right looks like this: - -@example -@group -(lsh 6 -1) - @result{} 3 -;; @r{Decimal 6 becomes decimal 3.} -00000110 @result{} 00000011 -@end group - -@group -(lsh 5 -1) - @result{} 2 -;; @r{Decimal 5 becomes decimal 2.} -00000101 @result{} 00000010 -@end group -@end example - -@noindent -As the example illustrates, shifting one place to the right divides the -value of a positive integer by two, rounding downward. - -The function @code{lsh}, like all XEmacs Lisp arithmetic functions, does -not check for overflow, so shifting left can discard significant bits -and change the sign of the number. For example, left shifting -134,217,727 produces @minus{}2 on a 28-bit machine: - -@example -(lsh 134217727 1) ; @r{left shift} - @result{} -2 -@end example - -In binary, in the 28-bit implementation, the argument looks like this: - -@example -@group -;; @r{Decimal 134,217,727} -0111 1111 1111 1111 1111 1111 1111 -@end group -@end example - -@noindent -which becomes the following when left shifted: - -@example -@group -;; @r{Decimal @minus{}2} -1111 1111 1111 1111 1111 1111 1110 -@end group -@end example -@end defun - -@defun ash integer1 count -@cindex arithmetic shift -@code{ash} (@dfn{arithmetic shift}) shifts the bits in @var{integer1} -to the left @var{count} places, or to the right if @var{count} -is negative. - -@code{ash} gives the same results as @code{lsh} except when -@var{integer1} and @var{count} are both negative. In that case, -@code{ash} puts ones in the empty bit positions on the left, while -@code{lsh} puts zeros in those bit positions. - -Thus, with @code{ash}, shifting the pattern of bits one place to the right -looks like this: - -@example -@group -(ash -6 -1) @result{} -3 -;; @r{Decimal @minus{}6 becomes decimal @minus{}3.} -1111 1111 1111 1111 1111 1111 1010 - @result{} -1111 1111 1111 1111 1111 1111 1101 -@end group -@end example - -In contrast, shifting the pattern of bits one place to the right with -@code{lsh} looks like this: - -@example -@group -(lsh -6 -1) @result{} 134217725 -;; @r{Decimal @minus{}6 becomes decimal 134,217,725.} -1111 1111 1111 1111 1111 1111 1010 - @result{} -0111 1111 1111 1111 1111 1111 1101 -@end group -@end example - -Here are other examples: - -@c !!! Check if lined up in smallbook format! XDVI shows problem -@c with smallbook but not with regular book! --rjc 16mar92 -@smallexample -@group - ; @r{ 28-bit binary values} - -(lsh 5 2) ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - @result{} 20 ; = @r{0000 0000 0000 0000 0000 0001 0100} -@end group -@group -(ash 5 2) - @result{} 20 -(lsh -5 2) ; -5 = @r{1111 1111 1111 1111 1111 1111 1011} - @result{} -20 ; = @r{1111 1111 1111 1111 1111 1110 1100} -(ash -5 2) - @result{} -20 -@end group -@group -(lsh 5 -2) ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - @result{} 1 ; = @r{0000 0000 0000 0000 0000 0000 0001} -@end group -@group -(ash 5 -2) - @result{} 1 -@end group -@group -(lsh -5 -2) ; -5 = @r{1111 1111 1111 1111 1111 1111 1011} - @result{} 4194302 ; = @r{0011 1111 1111 1111 1111 1111 1110} -@end group -@group -(ash -5 -2) ; -5 = @r{1111 1111 1111 1111 1111 1111 1011} - @result{} -2 ; = @r{1111 1111 1111 1111 1111 1111 1110} -@end group -@end smallexample -@end defun - -@defun logand &rest ints-or-markers -@cindex logical and -@cindex bitwise and -This function returns the ``logical and'' of the arguments: the -@var{n}th bit is set in the result if, and only if, the @var{n}th bit is -set in all the arguments. (``Set'' means that the value of the bit is 1 -rather than 0.) - -For example, using 4-bit binary numbers, the ``logical and'' of 13 and -12 is 12: 1101 combined with 1100 produces 1100. -In both the binary numbers, the leftmost two bits are set (i.e., they -are 1's), so the leftmost two bits of the returned value are set. -However, for the rightmost two bits, each is zero in at least one of -the arguments, so the rightmost two bits of the returned value are 0's. - -@noindent -Therefore, - -@example -@group -(logand 13 12) - @result{} 12 -@end group -@end example - -If @code{logand} is not passed any argument, it returns a value of -@minus{}1. This number is an identity element for @code{logand} -because its binary representation consists entirely of ones. If -@code{logand} is passed just one argument, it returns that argument. - -@smallexample -@group - ; @r{ 28-bit binary values} - -(logand 14 13) ; 14 = @r{0000 0000 0000 0000 0000 0000 1110} - ; 13 = @r{0000 0000 0000 0000 0000 0000 1101} - @result{} 12 ; 12 = @r{0000 0000 0000 0000 0000 0000 1100} -@end group - -@group -(logand 14 13 4) ; 14 = @r{0000 0000 0000 0000 0000 0000 1110} - ; 13 = @r{0000 0000 0000 0000 0000 0000 1101} - ; 4 = @r{0000 0000 0000 0000 0000 0000 0100} - @result{} 4 ; 4 = @r{0000 0000 0000 0000 0000 0000 0100} -@end group - -@group -(logand) - @result{} -1 ; -1 = @r{1111 1111 1111 1111 1111 1111 1111} -@end group -@end smallexample -@end defun - -@defun logior &rest ints-or-markers -@cindex logical inclusive or -@cindex bitwise or -This function returns the ``inclusive or'' of its arguments: the @var{n}th bit -is set in the result if, and only if, the @var{n}th bit is set in at least -one of the arguments. If there are no arguments, the result is zero, -which is an identity element for this operation. If @code{logior} is -passed just one argument, it returns that argument. - -@smallexample -@group - ; @r{ 28-bit binary values} - -(logior 12 5) ; 12 = @r{0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - @result{} 13 ; 13 = @r{0000 0000 0000 0000 0000 0000 1101} -@end group - -@group -(logior 12 5 7) ; 12 = @r{0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - ; 7 = @r{0000 0000 0000 0000 0000 0000 0111} - @result{} 15 ; 15 = @r{0000 0000 0000 0000 0000 0000 1111} -@end group -@end smallexample -@end defun - -@defun logxor &rest ints-or-markers -@cindex bitwise exclusive or -@cindex logical exclusive or -This function returns the ``exclusive or'' of its arguments: the -@var{n}th bit is set in the result if, and only if, the @var{n}th bit is -set in an odd number of the arguments. If there are no arguments, the -result is 0, which is an identity element for this operation. If -@code{logxor} is passed just one argument, it returns that argument. - -@smallexample -@group - ; @r{ 28-bit binary values} - -(logxor 12 5) ; 12 = @r{0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - @result{} 9 ; 9 = @r{0000 0000 0000 0000 0000 0000 1001} -@end group - -@group -(logxor 12 5 7) ; 12 = @r{0000 0000 0000 0000 0000 0000 1100} - ; 5 = @r{0000 0000 0000 0000 0000 0000 0101} - ; 7 = @r{0000 0000 0000 0000 0000 0000 0111} - @result{} 14 ; 14 = @r{0000 0000 0000 0000 0000 0000 1110} -@end group -@end smallexample -@end defun - -@defun lognot integer -@cindex logical not -@cindex bitwise not -This function returns the logical complement of its argument: the @var{n}th -bit is one in the result if, and only if, the @var{n}th bit is zero in -@var{integer}, and vice-versa. - -@example -(lognot 5) - @result{} -6 -;; 5 = @r{0000 0000 0000 0000 0000 0000 0101} -;; @r{becomes} -;; -6 = @r{1111 1111 1111 1111 1111 1111 1010} -@end example -@end defun - -@node Math Functions -@section Standard Mathematical Functions -@cindex transcendental functions -@cindex mathematical functions - -These mathematical functions are available if floating point is -supported (which is the normal state of affairs). They allow integers -as well as floating point numbers as arguments. - -@defun sin arg -@defunx cos arg -@defunx tan arg -These are the ordinary trigonometric functions, with argument measured -in radians. -@end defun - -@defun asin arg -The value of @code{(asin @var{arg})} is a number between @minus{}pi/2 -and pi/2 (inclusive) whose sine is @var{arg}; if, however, @var{arg} -is out of range (outside [-1, 1]), then the result is a NaN. -@end defun - -@defun acos arg -The value of @code{(acos @var{arg})} is a number between 0 and pi -(inclusive) whose cosine is @var{arg}; if, however, @var{arg} -is out of range (outside [-1, 1]), then the result is a NaN. -@end defun - -@defun atan arg -The value of @code{(atan @var{arg})} is a number between @minus{}pi/2 -and pi/2 (exclusive) whose tangent is @var{arg}. -@end defun - -@defun sinh arg -@defunx cosh arg -@defunx tanh arg -These are the ordinary hyperbolic trigonometric functions. -@end defun - -@defun asinh arg -@defunx acosh arg -@defunx atanh arg -These are the inverse hyperbolic trigonometric functions. -@end defun - -@defun exp arg -This is the exponential function; it returns @i{e} to the power -@var{arg}. @i{e} is a fundamental mathematical constant also called the -base of natural logarithms. -@end defun - -@defun log arg &optional base -This function returns the logarithm of @var{arg}, with base @var{base}. -If you don't specify @var{base}, the base @var{e} is used. If @var{arg} -is negative, the result is a NaN. -@end defun - -@ignore -@defun expm1 arg -This function returns @code{(1- (exp @var{arg}))}, but it is more -accurate than that when @var{arg} is negative and @code{(exp @var{arg})} -is close to 1. -@end defun - -@defun log1p arg -This function returns @code{(log (1+ @var{arg}))}, but it is more -accurate than that when @var{arg} is so small that adding 1 to it would -lose accuracy. -@end defun -@end ignore - -@defun log10 arg -This function returns the logarithm of @var{arg}, with base 10. If -@var{arg} is negative, the result is a NaN. @code{(log10 @var{x})} -@equiv{} @code{(log @var{x} 10)}, at least approximately. -@end defun - -@defun expt x y -This function returns @var{x} raised to power @var{y}. If both -arguments are integers and @var{y} is positive, the result is an -integer; in this case, it is truncated to fit the range of possible -integer values. -@end defun - -@defun sqrt arg -This returns the square root of @var{arg}. If @var{arg} is negative, -the value is a NaN. -@end defun - -@defun cube-root arg -This returns the cube root of @var{arg}. -@end defun - -@node Random Numbers -@section Random Numbers -@cindex random numbers - -A deterministic computer program cannot generate true random numbers. -For most purposes, @dfn{pseudo-random numbers} suffice. A series of -pseudo-random numbers is generated in a deterministic fashion. The -numbers are not truly random, but they have certain properties that -mimic a random series. For example, all possible values occur equally -often in a pseudo-random series. - -In XEmacs, pseudo-random numbers are generated from a ``seed'' number. -Starting from any given seed, the @code{random} function always -generates the same sequence of numbers. XEmacs always starts with the -same seed value, so the sequence of values of @code{random} is actually -the same in each XEmacs run! For example, in one operating system, the -first call to @code{(random)} after you start XEmacs always returns --1457731, and the second one always returns -7692030. This -repeatability is helpful for debugging. - -If you want truly unpredictable random numbers, execute @code{(random -t)}. This chooses a new seed based on the current time of day and on -XEmacs's process @sc{id} number. - -@defun random &optional limit -This function returns a pseudo-random integer. Repeated calls return a -series of pseudo-random integers. - -If @var{limit} is a positive integer, the value is chosen to be -nonnegative and less than @var{limit}. - -If @var{limit} is @code{t}, it means to choose a new seed based on the -current time of day and on XEmacs's process @sc{id} number. -@c "XEmacs'" is incorrect usage! - -On some machines, any integer representable in Lisp may be the result -of @code{random}. On other machines, the result can never be larger -than a certain maximum or less than a certain (negative) minimum. -@end defun diff --git a/man/lispref/objects.texi b/man/lispref/objects.texi deleted file mode 100644 index e3eca51..0000000 --- a/man/lispref/objects.texi +++ /dev/null @@ -1,2367 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/objects.info -@node Lisp Data Types, Numbers, Introduction, Top -@chapter Lisp Data Types -@cindex object -@cindex Lisp object -@cindex type -@cindex data type - - A Lisp @dfn{object} is a piece of data used and manipulated by Lisp -programs. For our purposes, a @dfn{type} or @dfn{data type} is a set of -possible objects. - - Every object belongs to at least one type. Objects of the same type -have similar structures and may usually be used in the same contexts. -Types can overlap, and objects can belong to two or more types. -Consequently, we can ask whether an object belongs to a particular type, -but not for ``the'' type of an object. - -@cindex primitive type - A few fundamental object types are built into XEmacs. These, from -which all other types are constructed, are called @dfn{primitive types}. -Each object belongs to one and only one primitive type. These types -include @dfn{integer}, @dfn{character} (starting with XEmacs 20.0), -@dfn{float}, @dfn{cons}, @dfn{symbol}, @dfn{string}, @dfn{vector}, -@dfn{bit-vector}, @dfn{subr}, @dfn{compiled-function}, @dfn{hash-table}, -@dfn{range-table}, @dfn{char-table}, @dfn{weak-list}, and several -special types, such as @dfn{buffer}, that are related to editing. -(@xref{Editing Types}.) - - Each primitive type has a corresponding Lisp function that checks -whether an object is a member of that type. - - Note that Lisp is unlike many other languages in that Lisp objects are -@dfn{self-typing}: the primitive type of the object is implicit in the -object itself. For example, if an object is a vector, nothing can treat -it as a number; Lisp knows it is a vector, not a number. - - In most languages, the programmer must declare the data type of each -variable, and the type is known by the compiler but not represented in -the data. Such type declarations do not exist in XEmacs Lisp. A Lisp -variable can have any type of value, and it remembers whatever value -you store in it, type and all. - - This chapter describes the purpose, printed representation, and read -syntax of each of the standard types in Emacs Lisp. Details on how -to use these types can be found in later chapters. - -@menu -* Printed Representation:: How Lisp objects are represented as text. -* Comments:: Comments and their formatting conventions. -* Primitive Types:: List of all primitive types in XEmacs. -* Programming Types:: Types found in all Lisp systems. -* Editing Types:: Types specific to XEmacs. -* Window-System Types:: Types specific to windowing systems. -* Type Predicates:: Tests related to types. -* Equality Predicates:: Tests of equality between any two objects. -@end menu - -@node Printed Representation -@section Printed Representation and Read Syntax -@cindex printed representation -@cindex read syntax - - The @dfn{printed representation} of an object is the format of the -output generated by the Lisp printer (the function @code{prin1}) for -that object. The @dfn{read syntax} of an object is the format of the -input accepted by the Lisp reader (the function @code{read}) for that -object. Most objects have more than one possible read syntax. Some -types of object have no read syntax; except for these cases, the printed -representation of an object is also a read syntax for it. - - In other languages, an expression is text; it has no other form. In -Lisp, an expression is primarily a Lisp object and only secondarily the -text that is the object's read syntax. Often there is no need to -emphasize this distinction, but you must keep it in the back of your -mind, or you will occasionally be very confused. - -@cindex hash notation - Every type has a printed representation. Some types have no read -syntax, since it may not make sense to enter objects of these types -directly in a Lisp program. For example, the buffer type does not have -a read syntax. Objects of these types are printed in @dfn{hash -notation}: the characters @samp{#<} followed by a descriptive string -(typically the type name followed by the name of the object), and closed -with a matching @samp{>}. Hash notation cannot be read at all, so the -Lisp reader signals the error @code{invalid-read-syntax} whenever it -encounters @samp{#<}. -@kindex invalid-read-syntax - -@example -(current-buffer) - @result{} # -@end example - - When you evaluate an expression interactively, the Lisp interpreter -first reads the textual representation of it, producing a Lisp object, -and then evaluates that object (@pxref{Evaluation}). However, -evaluation and reading are separate activities. Reading returns the -Lisp object represented by the text that is read; the object may or may -not be evaluated later. @xref{Input Functions}, for a description of -@code{read}, the basic function for reading objects. - -@node Comments -@section Comments -@cindex comments -@cindex @samp{;} in comment - - A @dfn{comment} is text that is written in a program only for the sake -of humans that read the program, and that has no effect on the meaning -of the program. In Lisp, a semicolon (@samp{;}) starts a comment if it -is not within a string or character constant. The comment continues to -the end of line. The Lisp reader discards comments; they do not become -part of the Lisp objects which represent the program within the Lisp -system. - - The @samp{#@@@var{count}} construct, which skips the next @var{count} -characters, is useful for program-generated comments containing binary -data. The XEmacs Lisp byte compiler uses this in its output files -(@pxref{Byte Compilation}). It isn't meant for source files, however. - - @xref{Comment Tips}, for conventions for formatting comments. - -@node Primitive Types -@section Primitive Types -@cindex primitive types - - For reference, here is a list of all the primitive types that may -exist in XEmacs. Note that some of these types may not exist -in some XEmacs executables; that depends on the options that -XEmacs was configured with. - -@itemize @bullet -@item -bit-vector -@item -buffer -@item -char-table -@item -character -@item -charset -@item -coding-system -@item -cons -@item -color-instance -@item -compiled-function -@item -console -@item -database -@item -device -@item -event -@item -extent -@item -face -@item -float -@item -font-instance -@item -frame -@item -glyph -@item -hash-table -@item -image-instance -@item -integer -@item -keymap -@item -marker -@item -process -@item -range-table -@item -specifier -@item -string -@item -subr -@item -subwindow -@item -symbol -@item -toolbar-button -@item -tooltalk-message -@item -tooltalk-pattern -@item -vector -@item -weak-list -@item -window -@item -window-configuration -@item -x-resource -@end itemize - -In addition, the following special types are created internally -but will never be seen by Lisp code. You may encounter them, -however, if you are debugging XEmacs. The printed representation -of these objects begins @samp{#@{@}} are -less often used but also require no special punctuation. Any other -characters may be included in a symbol's name by escaping them with a -backslash. In contrast to its use in strings, however, a backslash in -the name of a symbol simply quotes the single character that follows the -backslash. For example, in a string, @samp{\t} represents a tab -character; in the name of a symbol, however, @samp{\t} merely quotes the -letter @kbd{t}. To have a symbol with a tab character in its name, you -must actually use a tab (preceded with a backslash). But it's rare to -do such a thing. - -@cindex CL note---case of letters -@quotation -@b{Common Lisp note:} In Common Lisp, lower case letters are always -``folded'' to upper case, unless they are explicitly escaped. In Emacs -Lisp, upper case and lower case letters are distinct. -@end quotation - - Here are several examples of symbol names. Note that the @samp{+} in -the fifth example is escaped to prevent it from being read as a number. -This is not necessary in the sixth example because the rest of the name -makes it invalid as a number. - -@example -@group -foo ; @r{A symbol named @samp{foo}.} -FOO ; @r{A symbol named @samp{FOO}, different from @samp{foo}.} -char-to-string ; @r{A symbol named @samp{char-to-string}.} -@end group -@group -1+ ; @r{A symbol named @samp{1+}} - ; @r{(not @samp{+1}, which is an integer).} -@end group -@group -\+1 ; @r{A symbol named @samp{+1}} - ; @r{(not a very readable name).} -@end group -@group -\(*\ 1\ 2\) ; @r{A symbol named @samp{(* 1 2)} (a worse name).} -@c the @'s in this next line use up three characters, hence the -@c apparent misalignment of the comment. -+-*/_~!@@$%^&=:<>@{@} ; @r{A symbol named @samp{+-*/_~!@@$%^&=:<>@{@}}.} - ; @r{These characters need not be escaped.} -@end group -@end example - -@node Sequence Type -@subsection Sequence Types - - A @dfn{sequence} is a Lisp object that represents an ordered set of -elements. There are two kinds of sequence in XEmacs Lisp, lists and -arrays. Thus, an object of type list or of type array is also -considered a sequence. - - Arrays are further subdivided into strings, vectors, and bit vectors. -Vectors can hold elements of any type, but string elements must be -characters, and bit vector elements must be either 0 or 1. However, the -characters in a string can have extents (@pxref{Extents}) and text -properties (@pxref{Text Properties}) like characters in a buffer; -vectors do not support extents or text properties even when their -elements happen to be characters. - - Lists, strings, vectors, and bit vectors are different, but they have -important similarities. For example, all have a length @var{l}, and all -have elements which can be indexed from zero to @var{l} minus one. -Also, several functions, called sequence functions, accept any kind of -sequence. For example, the function @code{elt} can be used to extract -an element of a sequence, given its index. @xref{Sequences Arrays -Vectors}. - - It is impossible to read the same sequence twice, since sequences are -always created anew upon reading. If you read the read syntax for a -sequence twice, you get two sequences with equal contents. There is one -exception: the empty list @code{()} always stands for the same object, -@code{nil}. - -@node Cons Cell Type -@subsection Cons Cell and List Types -@cindex address field of register -@cindex decrement field of register - - A @dfn{cons cell} is an object comprising two pointers named the -@sc{car} and the @sc{cdr}. Each of them can point to any Lisp object. - - A @dfn{list} is a series of cons cells, linked together so that the -@sc{cdr} of each cons cell points either to another cons cell or to the -empty list. @xref{Lists}, for functions that work on lists. Because -most cons cells are used as part of lists, the phrase @dfn{list -structure} has come to refer to any structure made out of cons cells. - - The names @sc{car} and @sc{cdr} have only historical meaning now. The -original Lisp implementation ran on an @w{IBM 704} computer which -divided words into two parts, called the ``address'' part and the -``decrement''; @sc{car} was an instruction to extract the contents of -the address part of a register, and @sc{cdr} an instruction to extract -the contents of the decrement. By contrast, ``cons cells'' are named -for the function @code{cons} that creates them, which in turn is named -for its purpose, the construction of cells. - -@cindex atom - Because cons cells are so central to Lisp, we also have a word for -``an object which is not a cons cell''. These objects are called -@dfn{atoms}. - -@cindex parenthesis - The read syntax and printed representation for lists are identical, and -consist of a left parenthesis, an arbitrary number of elements, and a -right parenthesis. - - Upon reading, each object inside the parentheses becomes an element -of the list. That is, a cons cell is made for each element. The -@sc{car} of the cons cell points to the element, and its @sc{cdr} points -to the next cons cell of the list, which holds the next element in the -list. The @sc{cdr} of the last cons cell is set to point to @code{nil}. - -@cindex box diagrams, for lists -@cindex diagrams, boxed, for lists - A list can be illustrated by a diagram in which the cons cells are -shown as pairs of boxes. (The Lisp reader cannot read such an -illustration; unlike the textual notation, which can be understood by -both humans and computers, the box illustrations can be understood only -by humans.) The following represents the three-element list @code{(rose -violet buttercup)}: - -@example -@group - ___ ___ ___ ___ ___ ___ - |___|___|--> |___|___|--> |___|___|--> nil - | | | - | | | - --> rose --> violet --> buttercup -@end group -@end example - - In this diagram, each box represents a slot that can refer to any Lisp -object. Each pair of boxes represents a cons cell. Each arrow is a -reference to a Lisp object, either an atom or another cons cell. - - In this example, the first box, the @sc{car} of the first cons cell, -refers to or ``contains'' @code{rose} (a symbol). The second box, the -@sc{cdr} of the first cons cell, refers to the next pair of boxes, the -second cons cell. The @sc{car} of the second cons cell refers to -@code{violet} and the @sc{cdr} refers to the third cons cell. The -@sc{cdr} of the third (and last) cons cell refers to @code{nil}. - -Here is another diagram of the same list, @code{(rose violet -buttercup)}, sketched in a different manner: - -@smallexample -@group - --------------- ---------------- ------------------- -| car | cdr | | car | cdr | | car | cdr | -| rose | o-------->| violet | o-------->| buttercup | nil | -| | | | | | | | | - --------------- ---------------- ------------------- -@end group -@end smallexample - -@cindex @samp{(@dots{})} in lists -@cindex @code{nil} in lists -@cindex empty list - A list with no elements in it is the @dfn{empty list}; it is identical -to the symbol @code{nil}. In other words, @code{nil} is both a symbol -and a list. - - Here are examples of lists written in Lisp syntax: - -@example -(A 2 "A") ; @r{A list of three elements.} -() ; @r{A list of no elements (the empty list).} -nil ; @r{A list of no elements (the empty list).} -("A ()") ; @r{A list of one element: the string @code{"A ()"}.} -(A ()) ; @r{A list of two elements: @code{A} and the empty list.} -(A nil) ; @r{Equivalent to the previous.} -((A B C)) ; @r{A list of one element} - ; @r{(which is a list of three elements).} -@end example - - Here is the list @code{(A ())}, or equivalently @code{(A nil)}, -depicted with boxes and arrows: - -@example -@group - ___ ___ ___ ___ - |___|___|--> |___|___|--> nil - | | - | | - --> A --> nil -@end group -@end example - -@menu -* Dotted Pair Notation:: An alternative syntax for lists. -* Association List Type:: A specially constructed list. -@end menu - -@node Dotted Pair Notation -@subsubsection Dotted Pair Notation -@cindex dotted pair notation -@cindex @samp{.} in lists - - @dfn{Dotted pair notation} is an alternative syntax for cons cells -that represents the @sc{car} and @sc{cdr} explicitly. In this syntax, -@code{(@var{a} .@: @var{b})} stands for a cons cell whose @sc{car} is -the object @var{a}, and whose @sc{cdr} is the object @var{b}. Dotted -pair notation is therefore more general than list syntax. In the dotted -pair notation, the list @samp{(1 2 3)} is written as @samp{(1 . (2 . (3 -. nil)))}. For @code{nil}-terminated lists, the two notations produce -the same result, but list notation is usually clearer and more -convenient when it is applicable. When printing a list, the dotted pair -notation is only used if the @sc{cdr} of a cell is not a list. - - Here's how box notation can illustrate dotted pairs. This example -shows the pair @code{(rose . violet)}: - -@example -@group - ___ ___ - |___|___|--> violet - | - | - --> rose -@end group -@end example - - Dotted pair notation can be combined with list notation to represent a -chain of cons cells with a non-@code{nil} final @sc{cdr}. For example, -@code{(rose violet . buttercup)} is equivalent to @code{(rose . (violet -. buttercup))}. The object looks like this: - -@example -@group - ___ ___ ___ ___ - |___|___|--> |___|___|--> buttercup - | | - | | - --> rose --> violet -@end group -@end example - - These diagrams make it evident why @w{@code{(rose .@: violet .@: -buttercup)}} is invalid syntax; it would require a cons cell that has -three parts rather than two. - - The list @code{(rose violet)} is equivalent to @code{(rose . (violet))} -and looks like this: - -@example -@group - ___ ___ ___ ___ - |___|___|--> |___|___|--> nil - | | - | | - --> rose --> violet -@end group -@end example - - Similarly, the three-element list @code{(rose violet buttercup)} -is equivalent to @code{(rose . (violet . (buttercup)))}. -@ifinfo -It looks like this: - -@example -@group - ___ ___ ___ ___ ___ ___ - |___|___|--> |___|___|--> |___|___|--> nil - | | | - | | | - --> rose --> violet --> buttercup -@end group -@end example -@end ifinfo - -@node Association List Type -@subsubsection Association List Type - - An @dfn{association list} or @dfn{alist} is a specially-constructed -list whose elements are cons cells. In each element, the @sc{car} is -considered a @dfn{key}, and the @sc{cdr} is considered an -@dfn{associated value}. (In some cases, the associated value is stored -in the @sc{car} of the @sc{cdr}.) Association lists are often used as -stacks, since it is easy to add or remove associations at the front of -the list. - - For example, - -@example -(setq alist-of-colors - '((rose . red) (lily . white) (buttercup . yellow))) -@end example - -@noindent -sets the variable @code{alist-of-colors} to an alist of three elements. In the -first element, @code{rose} is the key and @code{red} is the value. - - @xref{Association Lists}, for a further explanation of alists and for -functions that work on alists. - -@node Array Type -@subsection Array Type - - An @dfn{array} is composed of an arbitrary number of slots for -referring to other Lisp objects, arranged in a contiguous block of -memory. Accessing any element of an array takes the same amount of -time. In contrast, accessing an element of a list requires time -proportional to the position of the element in the list. (Elements at -the end of a list take longer to access than elements at the beginning -of a list.) - - XEmacs defines three types of array, strings, vectors, and bit -vectors. A string is an array of characters, a vector is an array of -arbitrary objects, and a bit vector is an array of 1's and 0's. All are -one-dimensional. (Most other programming languages support -multidimensional arrays, but they are not essential; you can get the -same effect with an array of arrays.) Each type of array has its own -read syntax; see @ref{String Type}, @ref{Vector Type}, and @ref{Bit -Vector Type}. - - An array may have any length up to the largest integer; but once -created, it has a fixed size. The first element of an array has index -zero, the second element has index 1, and so on. This is called -@dfn{zero-origin} indexing. For example, an array of four elements has -indices 0, 1, 2, @w{and 3}. - - The array type is contained in the sequence type and contains the -string type, the vector type, and the bit vector type. - -@node String Type -@subsection String Type - - A @dfn{string} is an array of characters. Strings are used for many -purposes in XEmacs, as can be expected in a text editor; for example, as -the names of Lisp symbols, as messages for the user, and to represent -text extracted from buffers. Strings in Lisp are constants: evaluation -of a string returns the same string. - -@cindex @samp{"} in strings -@cindex double-quote in strings -@cindex @samp{\} in strings -@cindex backslash in strings - The read syntax for strings is a double-quote, an arbitrary number of -characters, and another double-quote, @code{"like this"}. The Lisp -reader accepts the same formats for reading the characters of a string -as it does for reading single characters (without the question mark that -begins a character literal). You can enter a nonprinting character such -as tab or @kbd{C-a} using the convenient escape sequences, like this: -@code{"\t, \C-a"}. You can include a double-quote in a string by -preceding it with a backslash; thus, @code{"\""} is a string containing -just a single double-quote character. (@xref{Character Type}, for a -description of the read syntax for characters.) - -@ignore @c More ill-conceived FSF Emacs crap. - If you use the @samp{\M-} syntax to indicate a meta character in a -string constant, this sets the -@iftex -$2^{7}$ -@end iftex -@ifinfo -2**7 -@end ifinfo -bit of the character in the string. -This is not the same representation that the meta modifier has in a -character on its own (not inside a string). @xref{Character Type}. - - Strings cannot hold characters that have the hyper, super, or alt -modifiers; they can hold @sc{ASCII} control characters, but no others. -They do not distinguish case in @sc{ASCII} control characters. -@end ignore - - The printed representation of a string consists of a double-quote, the -characters it contains, and another double-quote. However, you must -escape any backslash or double-quote characters in the string with a -backslash, like this: @code{"this \" is an embedded quote"}. - - The newline character is not special in the read syntax for strings; -if you write a new line between the double-quotes, it becomes a -character in the string. But an escaped newline---one that is preceded -by @samp{\}---does not become part of the string; i.e., the Lisp reader -ignores an escaped newline while reading a string. -@cindex newline in strings - -@example -"It is useful to include newlines -in documentation strings, -but the newline is \ -ignored if escaped." - @result{} "It is useful to include newlines -in documentation strings, -but the newline is ignored if escaped." -@end example - - A string can hold extents and properties of the text it contains, in -addition to the characters themselves. This enables programs that copy -text between strings and buffers to preserve the extents and properties -with no special effort. @xref{Extents}; @xref{Text Properties}. - - Note that FSF GNU Emacs has a special read and print syntax for -strings with text properties, but XEmacs does not currently implement -this. It was judged better not to include this in XEmacs because it -entails that @code{equal} return @code{nil} when passed a string with -text properties and the equivalent string without text properties, which -is often counter-intuitive. - -@ignore @c Not in XEmacs -Strings with text -properties have a special read and print syntax: - -@example -#("@var{characters}" @var{property-data}...) -@end example - -@noindent -where @var{property-data} consists of zero or more elements, in groups -of three as follows: - -@example -@var{beg} @var{end} @var{plist} -@end example - -@noindent -The elements @var{beg} and @var{end} are integers, and together specify -a range of indices in the string; @var{plist} is the property list for -that range. -@end ignore - - @xref{Strings and Characters}, for functions that work on strings. - -@node Vector Type -@subsection Vector Type - - A @dfn{vector} is a one-dimensional array of elements of any type. It -takes a constant amount of time to access any element of a vector. (In -a list, the access time of an element is proportional to the distance of -the element from the beginning of the list.) - - The printed representation of a vector consists of a left square -bracket, the elements, and a right square bracket. This is also the -read syntax. Like numbers and strings, vectors are considered constants -for evaluation. - -@example -[1 "two" (three)] ; @r{A vector of three elements.} - @result{} [1 "two" (three)] -@end example - - @xref{Vectors}, for functions that work with vectors. - -@node Bit Vector Type -@subsection Bit Vector Type - - A @dfn{bit vector} is a one-dimensional array of 1's and 0's. It -takes a constant amount of time to access any element of a bit vector, -as for vectors. Bit vectors have an extremely compact internal -representation (one machine bit per element), which makes them ideal -for keeping track of unordered sets, large collections of boolean values, -etc. - - The printed representation of a bit vector consists of @samp{#*} -followed by the bits in the vector. This is also the read syntax. Like -numbers, strings, and vectors, bit vectors are considered constants for -evaluation. - -@example -#*00101000 ; @r{A bit vector of eight elements.} - @result{} #*00101000 -@end example - - @xref{Bit Vectors}, for functions that work with bit vectors. - -@node Function Type -@subsection Function Type - - Just as functions in other programming languages are executable, -@dfn{Lisp function} objects are pieces of executable code. However, -functions in Lisp are primarily Lisp objects, and only secondarily the -text which represents them. These Lisp objects are lambda expressions: -lists whose first element is the symbol @code{lambda} (@pxref{Lambda -Expressions}). - - In most programming languages, it is impossible to have a function -without a name. In Lisp, a function has no intrinsic name. A lambda -expression is also called an @dfn{anonymous function} (@pxref{Anonymous -Functions}). A named function in Lisp is actually a symbol with a valid -function in its function cell (@pxref{Defining Functions}). - - Most of the time, functions are called when their names are written in -Lisp expressions in Lisp programs. However, you can construct or obtain -a function object at run time and then call it with the primitive -functions @code{funcall} and @code{apply}. @xref{Calling Functions}. - -@node Macro Type -@subsection Macro Type - - A @dfn{Lisp macro} is a user-defined construct that extends the Lisp -language. It is represented as an object much like a function, but with -different parameter-passing semantics. A Lisp macro has the form of a -list whose first element is the symbol @code{macro} and whose @sc{cdr} -is a Lisp function object, including the @code{lambda} symbol. - - Lisp macro objects are usually defined with the built-in -@code{defmacro} function, but any list that begins with @code{macro} is -a macro as far as XEmacs is concerned. @xref{Macros}, for an explanation -of how to write a macro. - -@node Primitive Function Type -@subsection Primitive Function Type -@cindex special forms - - A @dfn{primitive function} is a function callable from Lisp but -written in the C programming language. Primitive functions are also -called @dfn{subrs} or @dfn{built-in functions}. (The word ``subr'' is -derived from ``subroutine''.) Most primitive functions evaluate all -their arguments when they are called. A primitive function that does -not evaluate all its arguments is called a @dfn{special form} -(@pxref{Special Forms}).@refill - - It does not matter to the caller of a function whether the function is -primitive. However, this does matter if you try to substitute a -function written in Lisp for a primitive of the same name. The reason -is that the primitive function may be called directly from C code. -Calls to the redefined function from Lisp will use the new definition, -but calls from C code may still use the built-in definition. - - The term @dfn{function} refers to all Emacs functions, whether written -in Lisp or C. @xref{Function Type}, for information about the -functions written in Lisp. - - Primitive functions have no read syntax and print in hash notation -with the name of the subroutine. - -@example -@group -(symbol-function 'car) ; @r{Access the function cell} - ; @r{of the symbol.} - @result{} # -(subrp (symbol-function 'car)) ; @r{Is this a primitive function?} - @result{} t ; @r{Yes.} -@end group -@end example - -@node Compiled-Function Type -@subsection Compiled-Function Type - - The byte compiler produces @dfn{compiled-function objects}. The -evaluator handles this data type specially when it appears as a function -to be called. @xref{Byte Compilation}, for information about the byte -compiler. - - The printed representation for a compiled-function object is normally -@samp{#}. If @code{print-readably} is true, -however, it is @samp{#[...]}. - -@node Autoload Type -@subsection Autoload Type - - An @dfn{autoload object} is a list whose first element is the symbol -@code{autoload}. It is stored as the function definition of a symbol as -a placeholder for the real definition; it says that the real definition -is found in a file of Lisp code that should be loaded when necessary. -The autoload object contains the name of the file, plus some other -information about the real definition. - - After the file has been loaded, the symbol should have a new function -definition that is not an autoload object. The new definition is then -called as if it had been there to begin with. From the user's point of -view, the function call works as expected, using the function definition -in the loaded file. - - An autoload object is usually created with the function -@code{autoload}, which stores the object in the function cell of a -symbol. @xref{Autoload}, for more details. - -@node Char Table Type -@subsection Char Table Type -@cindex char table type - -(not yet documented) - -@node Hash Table Type -@subsection Hash Table Type -@cindex hash table type - - A @dfn{hash table} is a table providing an arbitrary mapping from -one Lisp object to another, using an internal indexing method -called @dfn{hashing}. Hash tables are very fast (much more efficient -that using an association list, when there are a large number of -elements in the table). - -Hash tables have a special read syntax beginning with -@samp{#s(hash-table} (this is an example of @dfn{structure} read -syntax. This notation is also used for printing when -@code{print-readably} is @code{t}. - -Otherwise they print in hash notation (The ``hash'' in ``hash notation'' -has nothing to do with the ``hash'' in ``hash table''), giving the -number of elements, total space allocated for elements, and a unique -number assigned at the time the hash table was created. (Hash tables -automatically resize as necessary so there is no danger of running out -of space for elements.) - -@example -@group -(make-hash-table :size 50) - @result{} # -@end group -@end example - -@xref{Hash Tables}, for information on how to create and work with hash -tables. - -@node Range Table Type -@subsection Range Table Type -@cindex range table type - - A @dfn{range table} is a table that maps from ranges of integers to -arbitrary Lisp objects. Range tables automatically combine overlapping -ranges that map to the same Lisp object, and operations are provided -for mapping over all of the ranges in a range table. - - Range tables have a special read syntax beginning with -@samp{#s(range-table} (this is an example of @dfn{structure} read syntax, -which is also used for char tables and faces). - -@example -@group -(setq x (make-range-table)) -(put-range-table 20 50 'foo x) -(put-range-table 100 200 "bar" x) -x - @result{} #s(range-table data ((20 50) foo (100 200) "bar")) -@end group -@end example - -@xref{Range Tables}, for information on how to create and work with range -tables. - -@node Weak List Type -@subsection Weak List Type -@cindex weak list type - -(not yet documented) - -@node Editing Types -@section Editing Types -@cindex editing types - - The types in the previous section are common to many Lisp dialects. -XEmacs Lisp provides several additional data types for purposes connected -with editing. - -@menu -* Buffer Type:: The basic object of editing. -* Marker Type:: A position in a buffer. -* Extent Type:: A range in a buffer or string, maybe with properties. -* Window Type:: Buffers are displayed in windows. -* Frame Type:: Windows subdivide frames. -* Device Type:: Devices group all frames on a display. -* Console Type:: Consoles group all devices with the same keyboard. -* Window Configuration Type:: Recording the way a frame is subdivided. -* Event Type:: An interesting occurrence in the system. -* Process Type:: A process running on the underlying OS. -* Stream Type:: Receive or send characters. -* Keymap Type:: What function a keystroke invokes. -* Syntax Table Type:: What a character means. -* Display Table Type:: How display tables are represented. -* Database Type:: A connection to an external DBM or DB database. -* Charset Type:: A character set (e.g. all Kanji characters), - under XEmacs/MULE. -* Coding System Type:: An object encapsulating a way of converting between - different textual encodings, under XEmacs/MULE. -* ToolTalk Message Type:: A message, in the ToolTalk IPC protocol. -* ToolTalk Pattern Type:: A pattern, in the ToolTalk IPC protocol. -@end menu - -@node Buffer Type -@subsection Buffer Type - - A @dfn{buffer} is an object that holds text that can be edited -(@pxref{Buffers}). Most buffers hold the contents of a disk file -(@pxref{Files}) so they can be edited, but some are used for other -purposes. Most buffers are also meant to be seen by the user, and -therefore displayed, at some time, in a window (@pxref{Windows}). But a -buffer need not be displayed in any window. - - The contents of a buffer are much like a string, but buffers are not -used like strings in XEmacs Lisp, and the available operations are -different. For example, insertion of text into a buffer is very -efficient, whereas ``inserting'' text into a string requires -concatenating substrings, and the result is an entirely new string -object. - - Each buffer has a designated position called @dfn{point} -(@pxref{Positions}). At any time, one buffer is the @dfn{current -buffer}. Most editing commands act on the contents of the current -buffer in the neighborhood of point. Many of the standard Emacs -functions manipulate or test the characters in the current buffer; a -whole chapter in this manual is devoted to describing these functions -(@pxref{Text}). - - Several other data structures are associated with each buffer: - -@itemize @bullet -@item -a local syntax table (@pxref{Syntax Tables}); - -@item -a local keymap (@pxref{Keymaps}); - -@item -a local variable binding list (@pxref{Buffer-Local Variables}); - -@item -a list of extents (@pxref{Extents}); - -@item -and various other related properties. -@end itemize - -@noindent -The local keymap and variable list contain entries that individually -override global bindings or values. These are used to customize the -behavior of programs in different buffers, without actually changing the -programs. - - A buffer may be @dfn{indirect}, which means it shares the text -of another buffer. @xref{Indirect Buffers}. - - Buffers have no read syntax. They print in hash notation, showing the -buffer name. - -@example -@group -(current-buffer) - @result{} # -@end group -@end example - -@node Marker Type -@subsection Marker Type - - A @dfn{marker} denotes a position in a specific buffer. Markers -therefore have two components: one for the buffer, and one for the -position. Changes in the buffer's text automatically relocate the -position value as necessary to ensure that the marker always points -between the same two characters in the buffer. - - Markers have no read syntax. They print in hash notation, giving the -current character position and the name of the buffer. - -@example -@group -(point-marker) - @result{} # -@end group -@end example - -@xref{Markers}, for information on how to test, create, copy, and move -markers. - -@node Extent Type -@subsection Extent Type - - An @dfn{extent} specifies temporary alteration of the display -appearance of a part of a buffer (or string). It contains markers -delimiting a range of the buffer, plus a property list (a list whose -elements are alternating property names and values). Extents are used -to present parts of the buffer temporarily in a different display style. -They have no read syntax, and print in hash notation, giving the buffer -name and range of positions. - - Extents can exist over strings as well as buffers; the primary use -of this is to preserve extent and text property information as text -is copied from one buffer to another or between different parts of -a buffer. - - Extents have no read syntax. They print in hash notation, giving the -range of text they cover, the name of the buffer or string they are in, -the address in core, and a summary of some of the properties attached to -the extent. - -@example -@group -(extent-at (point)) - @result{} # -@end group -@end example - - @xref{Extents}, for how to create and use extents. - - Extents are used to implement text properties. @xref{Text Properties}. - -@node Window Type -@subsection Window Type - - A @dfn{window} describes the portion of the frame that XEmacs uses to -display a buffer. (In standard window-system usage, a @dfn{window} is -what XEmacs calls a @dfn{frame}; XEmacs confusingly uses the term -``window'' to refer to what is called a @dfn{pane} in standard -window-system usage.) Every window has one associated buffer, whose -contents appear in the window. By contrast, a given buffer may appear -in one window, no window, or several windows. - - Though many windows may exist simultaneously, at any time one window -is designated the @dfn{selected window}. This is the window where the -cursor is (usually) displayed when XEmacs is ready for a command. The -selected window usually displays the current buffer, but this is not -necessarily the case. - - Windows are grouped on the screen into frames; each window belongs to -one and only one frame. @xref{Frame Type}. - - Windows have no read syntax. They print in hash notation, giving the -name of the buffer being displayed and a unique number assigned at the -time the window was created. (This number can be useful because the -buffer displayed in any given window can change frequently.) - -@example -@group -(selected-window) - @result{} # -@end group -@end example - - @xref{Windows}, for a description of the functions that work on windows. - -@node Frame Type -@subsection Frame Type - - A @var{frame} is a rectangle on the screen (a @dfn{window} in standard -window-system terminology) that contains one or more non-overlapping -Emacs windows (@dfn{panes} in standard window-system terminology). A -frame initially contains a single main window (plus perhaps a minibuffer -window) which you can subdivide vertically or horizontally into smaller -windows. - - Frames have no read syntax. They print in hash notation, giving the -frame's type, name as used for resourcing, and a unique number assigned -at the time the frame was created. - -@example -@group -(selected-frame) - @result{} # -@end group -@end example - - @xref{Frames}, for a description of the functions that work on frames. - -@node Device Type -@subsection Device Type - - A @dfn{device} represents a single display on which frames exist. -Normally, there is only one device object, but there may be more -than one if XEmacs is being run on a multi-headed display (e.g. an -X server with attached color and mono screens) or if XEmacs is -simultaneously driving frames attached to different consoles, e.g. -an X display and a @sc{TTY} connection. - - Devices do not have a read syntax. They print in hash notation, -giving the device's type, connection name, and a unique number assigned -at the time the device was created. - -@example -@group -(selected-device) - @result{} # -@end group -@end example - - @xref{Consoles and Devices}, for a description of several functions -related to devices. - -@node Console Type -@subsection Console Type - - A @dfn{console} represents a single keyboard to which devices -(i.e. displays on which frames exist) are connected. Normally, there is -only one console object, but there may be more than one if XEmacs is -simultaneously driving frames attached to different X servers and/or -@sc{TTY} connections. (XEmacs is capable of driving multiple X and -@sc{TTY} connections at the same time, and provides a robust mechanism -for handling the differing display capabilities of such heterogeneous -environments. A buffer with embedded glyphs and multiple fonts and -colors, for example, will display reasonably if it simultaneously -appears on a frame on a color X display, a frame on a mono X display, -and a frame on a @sc{TTY} connection.) - - Consoles do not have a read syntax. They print in hash notation, -giving the console's type, connection name, and a unique number assigned -at the time the console was created. - -@example -@group -(selected-console) - @result{} # -@end group -@end example - - @xref{Consoles and Devices}, for a description of several functions -related to consoles. - -@node Window Configuration Type -@subsection Window Configuration Type -@cindex screen layout - - A @dfn{window configuration} stores information about the positions, -sizes, and contents of the windows in a frame, so you can recreate the -same arrangement of windows later. - - Window configurations do not have a read syntax. They print in hash -notation, giving a unique number assigned at the time the window -configuration was created. - -@example -@group -(current-window-configuration) - @result{} # -@end group -@end example - - @xref{Window Configurations}, for a description of several functions -related to window configurations. - -@node Event Type -@subsection Event Type - -(not yet documented) - -@node Process Type -@subsection Process Type - - The word @dfn{process} usually means a running program. XEmacs itself -runs in a process of this sort. However, in XEmacs Lisp, a process is a -Lisp object that designates a subprocess created by the XEmacs process. -Programs such as shells, GDB, ftp, and compilers, running in -subprocesses of XEmacs, extend the capabilities of XEmacs. - - An Emacs subprocess takes textual input from Emacs and returns textual -output to Emacs for further manipulation. Emacs can also send signals -to the subprocess. - - Process objects have no read syntax. They print in hash notation, -giving the name of the process, its associated process ID, and the -current state of the process: - -@example -@group -(process-list) - @result{} (#) -@end group -@end example - -@xref{Processes}, for information about functions that create, delete, -return information about, send input or signals to, and receive output -from processes. - -@node Stream Type -@subsection Stream Type - - A @dfn{stream} is an object that can be used as a source or sink for -characters---either to supply characters for input or to accept them as -output. Many different types can be used this way: markers, buffers, -strings, and functions. Most often, input streams (character sources) -obtain characters from the keyboard, a buffer, or a file, and output -streams (character sinks) send characters to a buffer, such as a -@file{*Help*} buffer, or to the echo area. - - The object @code{nil}, in addition to its other meanings, may be used -as a stream. It stands for the value of the variable -@code{standard-input} or @code{standard-output}. Also, the object -@code{t} as a stream specifies input using the minibuffer -(@pxref{Minibuffers}) or output in the echo area (@pxref{The Echo -Area}). - - Streams have no special printed representation or read syntax, and -print as whatever primitive type they are. - - @xref{Read and Print}, for a description of functions -related to streams, including parsing and printing functions. - -@node Keymap Type -@subsection Keymap Type - - A @dfn{keymap} maps keys typed by the user to commands. This mapping -controls how the user's command input is executed. - - NOTE: In XEmacs, a keymap is a separate primitive type. In FSF GNU -Emacs, a keymap is actually a list whose @sc{car} is the symbol -@code{keymap}. - - @xref{Keymaps}, for information about creating keymaps, handling prefix -keys, local as well as global keymaps, and changing key bindings. - -@node Syntax Table Type -@subsection Syntax Table Type - - Under XEmacs 20, a @dfn{syntax table} is a particular type of char -table. Under XEmacs 19, a syntax table a vector of 256 integers. In -both cases, each element defines how one character is interpreted when it -appears in a buffer. For example, in C mode (@pxref{Major Modes}), the -@samp{+} character is punctuation, but in Lisp mode it is a valid -character in a symbol. These modes specify different interpretations by -changing the syntax table entry for @samp{+}. - - Syntax tables are used only for scanning text in buffers, not for -reading Lisp expressions. The table the Lisp interpreter uses to read -expressions is built into the XEmacs source code and cannot be changed; -thus, to change the list delimiters to be @samp{@{} and @samp{@}} -instead of @samp{(} and @samp{)} would be impossible. - - @xref{Syntax Tables}, for details about syntax classes and how to make -and modify syntax tables. - -@node Display Table Type -@subsection Display Table Type - - A @dfn{display table} specifies how to display each character code. -Each buffer and each window can have its own display table. A display -table is actually a vector of length 256, although in XEmacs 20 this may -change to be a particular type of char table. @xref{Display Tables}. - -@node Database Type -@subsection Database Type -@cindex database type - -(not yet documented) - -@node Charset Type -@subsection Charset Type -@cindex charset type - -(not yet documented) - -@node Coding System Type -@subsection Coding System Type -@cindex coding system type - -(not yet documented) - -@node ToolTalk Message Type -@subsection ToolTalk Message Type - -(not yet documented) - -@node ToolTalk Pattern Type -@subsection ToolTalk Pattern Type - -(not yet documented) - -@node Window-System Types -@section Window-System Types -@cindex window system types - - XEmacs also has some types that represent objects such as faces -(collections of display characters), fonts, and pixmaps that are -commonly found in windowing systems. - -@menu -* Face Type:: A collection of display characteristics. -* Glyph Type:: An image appearing in a buffer or elsewhere. -* Specifier Type:: A way of controlling display characteristics on - a per-buffer, -frame, -window, or -device level. -* Font Instance Type:: The way a font appears on a particular device. -* Color Instance Type:: The way a color appears on a particular device. -* Image Instance Type:: The way an image appears on a particular device. -* Toolbar Button Type:: An object representing a button in a toolbar. -* Subwindow Type:: An externally-controlled window-system window - appearing in a buffer. -* X Resource Type:: A miscellaneous X resource, if Epoch support was - compiled into XEmacs. -@end menu - -@node Face Type -@subsection Face Type -@cindex face type - -(not yet documented) - -@node Glyph Type -@subsection Glyph Type -@cindex glyph type - -(not yet documented) - -@node Specifier Type -@subsection Specifier Type -@cindex specifier type - -(not yet documented) - -@node Font Instance Type -@subsection Font Instance Type -@cindex font instance type - -(not yet documented) - -@node Color Instance Type -@subsection Color Instance Type -@cindex color instance type - -(not yet documented) - -@node Image Instance Type -@subsection Image Instance Type -@cindex image instance type - -(not yet documented) - -@node Toolbar Button Type -@subsection Toolbar Button Type -@cindex toolbar button type - -(not yet documented) - -@node Subwindow Type -@subsection Subwindow Type -@cindex subwindow type - -(not yet documented) - -@node X Resource Type -@subsection X Resource Type -@cindex X resource type - -(not yet documented) - -@node Type Predicates -@section Type Predicates -@cindex predicates -@cindex type checking -@kindex wrong-type-argument - - The XEmacs Lisp interpreter itself does not perform type checking on -the actual arguments passed to functions when they are called. It could -not do so, since function arguments in Lisp do not have declared data -types, as they do in other programming languages. It is therefore up to -the individual function to test whether each actual argument belongs to -a type that the function can use. - - All built-in functions do check the types of their actual arguments -when appropriate, and signal a @code{wrong-type-argument} error if an -argument is of the wrong type. For example, here is what happens if you -pass an argument to @code{+} that it cannot handle: - -@example -@group -(+ 2 'a) - @error{} Wrong type argument: integer-or-marker-p, a -@end group -@end example - -@cindex type predicates -@cindex testing types - If you want your program to handle different types differently, you -must do explicit type checking. The most common way to check the type -of an object is to call a @dfn{type predicate} function. Emacs has a -type predicate for each type, as well as some predicates for -combinations of types. - - A type predicate function takes one argument; it returns @code{t} if -the argument belongs to the appropriate type, and @code{nil} otherwise. -Following a general Lisp convention for predicate functions, most type -predicates' names end with @samp{p}. - - Here is an example which uses the predicates @code{listp} to check for -a list and @code{symbolp} to check for a symbol. - -@example -(defun add-on (x) - (cond ((symbolp x) - ;; If X is a symbol, put it on LIST. - (setq list (cons x list))) - ((listp x) - ;; If X is a list, add its elements to LIST. - (setq list (append x list))) -@need 3000 - (t - ;; We only handle symbols and lists. - (error "Invalid argument %s in add-on" x)))) -@end example - - Here is a table of predefined type predicates, in alphabetical order, -with references to further information. - -@table @code -@item annotationp -@xref{Annotation Primitives, annotationp}. - -@item arrayp -@xref{Array Functions, arrayp}. - -@item atom -@xref{List-related Predicates, atom}. - -@item bit-vector-p -@xref{Bit Vector Functions, bit-vector-p}. - -@item bitp -@xref{Bit Vector Functions, bitp}. - -@item boolean-specifier-p -@xref{Specifier Types, boolean-specifier-p}. - -@item buffer-glyph-p -@xref{Glyph Types, buffer-glyph-p}. - -@item buffer-live-p -@xref{Killing Buffers, buffer-live-p}. - -@item bufferp -@xref{Buffer Basics, bufferp}. - -@item button-event-p -@xref{Event Predicates, button-event-p}. - -@item button-press-event-p -@xref{Event Predicates, button-press-event-p}. - -@item button-release-event-p -@xref{Event Predicates, button-release-event-p}. - -@item case-table-p -@xref{Case Tables, case-table-p}. - -@item char-int-p -@xref{Character Codes, char-int-p}. - -@item char-or-char-int-p -@xref{Character Codes, char-or-char-int-p}. - -@item char-or-string-p -@xref{Predicates for Strings, char-or-string-p}. - -@item char-table-p -@xref{Char Tables, char-table-p}. - -@item characterp -@xref{Predicates for Characters, characterp}. - -@item color-instance-p -@xref{Colors, color-instance-p}. - -@item color-pixmap-image-instance-p -@xref{Image Instance Types, color-pixmap-image-instance-p}. - -@item color-specifier-p -@xref{Specifier Types, color-specifier-p}. - -@item commandp -@xref{Interactive Call, commandp}. - -@item compiled-function-p -@xref{Compiled-Function Type, compiled-function-p}. - -@item console-live-p -@xref{Connecting to a Console or Device, console-live-p}. - -@item consolep -@xref{Consoles and Devices, consolep}. - -@item consp -@xref{List-related Predicates, consp}. - -@item database-live-p -@xref{Connecting to a Database, database-live-p}. - -@item databasep -@xref{Databases, databasep}. - -@item device-live-p -@xref{Connecting to a Console or Device, device-live-p}. - -@item device-or-frame-p -@xref{Basic Device Functions, device-or-frame-p}. - -@item devicep -@xref{Consoles and Devices, devicep}. - -@item eval-event-p -@xref{Event Predicates, eval-event-p}. - -@item event-live-p -@xref{Event Predicates, event-live-p}. - -@item eventp -@xref{Events, eventp}. - -@item extent-live-p -@xref{Creating and Modifying Extents, extent-live-p}. - -@item extentp -@xref{Extents, extentp}. - -@item face-boolean-specifier-p -@xref{Specifier Types, face-boolean-specifier-p}. - -@item facep -@xref{Basic Face Functions, facep}. - -@item floatp -@xref{Predicates on Numbers, floatp}. - -@item font-instance-p -@xref{Fonts, font-instance-p}. - -@item font-specifier-p -@xref{Specifier Types, font-specifier-p}. - -@item frame-live-p -@xref{Deleting Frames, frame-live-p}. - -@item framep -@xref{Frames, framep}. - -@item functionp -(not yet documented) - -@item generic-specifier-p -@xref{Specifier Types, generic-specifier-p}. - -@item glyphp -@xref{Glyphs, glyphp}. - -@item hash-table-p -@xref{Hash Tables, hash-table-p}. - -@item icon-glyph-p -@xref{Glyph Types, icon-glyph-p}. - -@item image-instance-p -@xref{Images, image-instance-p}. - -@item image-specifier-p -@xref{Specifier Types, image-specifier-p}. - -@item integer-char-or-marker-p -@xref{Predicates on Markers, integer-char-or-marker-p}. - -@item integer-or-char-p -@xref{Predicates for Characters, integer-or-char-p}. - -@item integer-or-marker-p -@xref{Predicates on Markers, integer-or-marker-p}. - -@item integer-specifier-p -@xref{Specifier Types, integer-specifier-p}. - -@item integerp -@xref{Predicates on Numbers, integerp}. - -@item itimerp -(not yet documented) - -@item key-press-event-p -@xref{Event Predicates, key-press-event-p}. - -@item keymapp -@xref{Creating Keymaps, keymapp}. - -@item keywordp -(not yet documented) - -@item listp -@xref{List-related Predicates, listp}. - -@item markerp -@xref{Predicates on Markers, markerp}. - -@item misc-user-event-p -@xref{Event Predicates, misc-user-event-p}. - -@item mono-pixmap-image-instance-p -@xref{Image Instance Types, mono-pixmap-image-instance-p}. - -@item motion-event-p -@xref{Event Predicates, motion-event-p}. - -@item mouse-event-p -@xref{Event Predicates, mouse-event-p}. - -@item natnum-specifier-p -@xref{Specifier Types, natnum-specifier-p}. - -@item natnump -@xref{Predicates on Numbers, natnump}. - -@item nlistp -@xref{List-related Predicates, nlistp}. - -@item nothing-image-instance-p -@xref{Image Instance Types, nothing-image-instance-p}. - -@item number-char-or-marker-p -@xref{Predicates on Markers, number-char-or-marker-p}. - -@item number-or-marker-p -@xref{Predicates on Markers, number-or-marker-p}. - -@item numberp -@xref{Predicates on Numbers, numberp}. - -@item pointer-glyph-p -@xref{Glyph Types, pointer-glyph-p}. - -@item pointer-image-instance-p -@xref{Image Instance Types, pointer-image-instance-p}. - -@item process-event-p -@xref{Event Predicates, process-event-p}. - -@item processp -@xref{Processes, processp}. - -@item range-table-p -@xref{Range Tables, range-table-p}. - -@item ringp -(not yet documented) - -@item sequencep -@xref{Sequence Functions, sequencep}. - -@item specifierp -@xref{Specifiers, specifierp}. - -@item stringp -@xref{Predicates for Strings, stringp}. - -@item subrp -@xref{Function Cells, subrp}. - -@item subwindow-image-instance-p -@xref{Image Instance Types, subwindow-image-instance-p}. - -@item subwindowp -@xref{Subwindows, subwindowp}. - -@item symbolp -@xref{Symbols, symbolp}. - -@item syntax-table-p -@xref{Syntax Tables, syntax-table-p}. - -@item text-image-instance-p -@xref{Image Instance Types, text-image-instance-p}. - -@item timeout-event-p -@xref{Event Predicates, timeout-event-p}. - -@item toolbar-button-p -@xref{Toolbar, toolbar-button-p}. - -@item toolbar-specifier-p -@xref{Toolbar, toolbar-specifier-p}. - -@item user-variable-p -@xref{Defining Variables, user-variable-p}. - -@item vectorp -@xref{Vectors, vectorp}. - -@item weak-list-p -@xref{Weak Lists, weak-list-p}. - -@ignore -@item wholenump -@xref{Predicates on Numbers, wholenump}. -@end ignore - -@item window-configuration-p -@xref{Window Configurations, window-configuration-p}. - -@item window-live-p -@xref{Deleting Windows, window-live-p}. - -@item windowp -@xref{Basic Windows, windowp}. -@end table - - The most general way to check the type of an object is to call the -function @code{type-of}. Recall that each object belongs to one and -only one primitive type; @code{type-of} tells you which one (@pxref{Lisp -Data Types}). But @code{type-of} knows nothing about non-primitive -types. In most cases, it is more convenient to use type predicates than -@code{type-of}. - -@defun type-of object -This function returns a symbol naming the primitive type of -@var{object}. The value is one of @code{bit-vector}, @code{buffer}, -@code{char-table}, @code{character}, @code{charset}, -@code{coding-system}, @code{cons}, @code{color-instance}, -@code{compiled-function}, @code{console}, @code{database}, -@code{device}, @code{event}, @code{extent}, @code{face}, @code{float}, -@code{font-instance}, @code{frame}, @code{glyph}, @code{hash-table}, -@code{image-instance}, @code{integer}, @code{keymap}, @code{marker}, -@code{process}, @code{range-table}, @code{specifier}, @code{string}, -@code{subr}, @code{subwindow}, @code{symbol}, @code{toolbar-button}, -@code{tooltalk-message}, @code{tooltalk-pattern}, @code{vector}, -@code{weak-list}, @code{window}, @code{window-configuration}, or -@code{x-resource}. - -@example -(type-of 1) - @result{} integer -(type-of 'nil) - @result{} symbol -(type-of '()) ; @r{@code{()} is @code{nil}.} - @result{} symbol -(type-of '(x)) - @result{} cons -@end example -@end defun - -@node Equality Predicates -@section Equality Predicates -@cindex equality - - Here we describe two functions that test for equality between any two -objects. Other functions test equality between objects of specific -types, e.g., strings. For these predicates, see the appropriate chapter -describing the data type. - -@defun eq object1 object2 -This function returns @code{t} if @var{object1} and @var{object2} are -the same object, @code{nil} otherwise. The ``same object'' means that a -change in one will be reflected by the same change in the other. - -@code{eq} returns @code{t} if @var{object1} and @var{object2} are -integers with the same value. Also, since symbol names are normally -unique, if the arguments are symbols with the same name, they are -@code{eq}. For other types (e.g., lists, vectors, strings), two -arguments with the same contents or elements are not necessarily -@code{eq} to each other: they are @code{eq} only if they are the same -object. - -(The @code{make-symbol} function returns an uninterned symbol that is -not interned in the standard @code{obarray}. When uninterned symbols -are in use, symbol names are no longer unique. Distinct symbols with -the same name are not @code{eq}. @xref{Creating Symbols}.) - -NOTE: Under XEmacs 19, characters are really just integers, and thus -characters and integers are @code{eq}. Under XEmacs 20, it was -necessary to preserve remnants of this in function such as @code{old-eq} -in order to maintain byte-code compatibility. Byte code compiled -under any Emacs 19 will automatically have calls to @code{eq} mapped -to @code{old-eq} when executed under XEmacs 20. - -@example -@group -(eq 'foo 'foo) - @result{} t -@end group - -@group -(eq 456 456) - @result{} t -@end group - -@group -(eq "asdf" "asdf") - @result{} nil -@end group - -@group -(eq '(1 (2 (3))) '(1 (2 (3)))) - @result{} nil -@end group - -@group -(setq foo '(1 (2 (3)))) - @result{} (1 (2 (3))) -(eq foo foo) - @result{} t -(eq foo '(1 (2 (3)))) - @result{} nil -@end group - -@group -(eq [(1 2) 3] [(1 2) 3]) - @result{} nil -@end group - -@group -(eq (point-marker) (point-marker)) - @result{} nil -@end group -@end example - -@end defun - -@defun old-eq obj1 obj2 -This function exists under XEmacs 20 and is exactly like @code{eq} -except that it suffers from the char-int confoundance disease. -In other words, it returns @code{t} if given a character and the -equivalent integer, even though the objects are of different types! -You should @emph{not} ever call this function explicitly in your -code. However, be aware that all calls to @code{eq} in byte code -compiled under version 19 map to @code{old-eq} in XEmacs 20. -(Likewise for @code{old-equal}, @code{old-memq}, @code{old-member}, -@code{old-assq} and @code{old-assoc}.) - -@example -@group -;; @r{Remember, this does not apply under XEmacs 19.} -?A - @result{} ?A -(char-int ?A) - @result{} 65 -(old-eq ?A 65) - @result{} t ; @r{Eek, we've been infected.} -(eq ?A 65) - @result{} nil ; @r{We are still healthy.} -@end group -@end example -@end defun - -@defun equal object1 object2 -This function returns @code{t} if @var{object1} and @var{object2} have -equal components, @code{nil} otherwise. Whereas @code{eq} tests if its -arguments are the same object, @code{equal} looks inside nonidentical -arguments to see if their elements are the same. So, if two objects are -@code{eq}, they are @code{equal}, but the converse is not always true. - -@example -@group -(equal 'foo 'foo) - @result{} t -@end group - -@group -(equal 456 456) - @result{} t -@end group - -@group -(equal "asdf" "asdf") - @result{} t -@end group -@group -(eq "asdf" "asdf") - @result{} nil -@end group - -@group -(equal '(1 (2 (3))) '(1 (2 (3)))) - @result{} t -@end group -@group -(eq '(1 (2 (3))) '(1 (2 (3)))) - @result{} nil -@end group - -@group -(equal [(1 2) 3] [(1 2) 3]) - @result{} t -@end group -@group -(eq [(1 2) 3] [(1 2) 3]) - @result{} nil -@end group - -@group -(equal (point-marker) (point-marker)) - @result{} t -@end group - -@group -(eq (point-marker) (point-marker)) - @result{} nil -@end group -@end example - -Comparison of strings is case-sensitive. - -Note that in FSF GNU Emacs, comparison of strings takes into account -their text properties, and you have to use @code{string-equal} if you -want only the strings themselves compared. This difference does not -exist in XEmacs; @code{equal} and @code{string-equal} always return -the same value on the same strings. - -@ignore @c Not true in XEmacs -Comparison of strings is case-sensitive and takes account of text -properties as well as the characters in the strings. To compare -two strings' characters without comparing their text properties, -use @code{string=} (@pxref{Text Comparison}). -@end ignore - -@example -@group -(equal "asdf" "ASDF") - @result{} nil -@end group -@end example - -Two distinct buffers are never @code{equal}, even if their contents -are the same. -@end defun - - The test for equality is implemented recursively, and circular lists may -therefore cause infinite recursion (leading to an error). diff --git a/man/lispref/os.texi b/man/lispref/os.texi deleted file mode 100644 index b79830b..0000000 --- a/man/lispref/os.texi +++ /dev/null @@ -1,1705 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/os.info -@node System Interface, X-Windows, Processes, Top -@chapter Operating System Interface - - This chapter is about starting and getting out of Emacs, access to -values in the operating system environment, and terminal input, output, -and flow control. - - @xref{Building XEmacs}, for related information. See also -@ref{Display}, for additional operating system status information -pertaining to the terminal and the screen. - -@menu -* Starting Up:: Customizing XEmacs start-up processing. -* Getting Out:: How exiting works (permanent or temporary). -* System Environment:: Distinguish the name and kind of system. -* User Identification:: Finding the name and user id of the user. -* Time of Day:: Getting the current time. -* Time Conversion:: Converting a time from numeric form to a string, or - to calendrical data (or vice versa). -* Timers:: Setting a timer to call a function at a certain time. -* Terminal Input:: Recording terminal input for debugging. -* Terminal Output:: Recording terminal output for debugging. -* Flow Control:: How to turn output flow control on or off. -* Batch Mode:: Running XEmacs without terminal interaction. -@end menu -@ignore -* Special Keysyms:: Defining system-specific key symbols for X windows. -@end ignore - -@node Starting Up -@section Starting Up XEmacs - - This section describes what XEmacs does when it is started, and how you -can customize these actions. - -@menu -* Start-up Summary:: Sequence of actions XEmacs performs at start-up. -* Init File:: Details on reading the init file (@file{.emacs}). -* Terminal-Specific:: How the terminal-specific Lisp file is read. -* Command Line Arguments:: How command line arguments are processed, - and how you can customize them. -@end menu - -@node Start-up Summary -@subsection Summary: Sequence of Actions at Start Up -@cindex initialization -@cindex start up of XEmacs -@cindex @file{startup.el} - - The order of operations performed (in @file{startup.el}) by XEmacs when -it is started up is as follows: - -@enumerate -@item -It loads the initialization library for the window system, if you are -using a window system. This library's name is -@file{term/@var{windowsystem}-win.el}. - -@item -It processes the initial options. (Some of them are handled -even earlier than this.) - -@item -It initializes the X window frame and faces, if appropriate. - -@item -It runs the normal hook @code{before-init-hook}. - -@item -It loads the library @file{site-start}, unless the option -@samp{-no-site-file} was specified. The library's file name is usually -@file{site-start.el}. -@cindex @file{site-start.el} - -@item -It loads the file @file{~/.emacs} unless @samp{-q} was specified on -the command line. (This is not done in @samp{-batch} mode.) The @samp{-u} -option can specify the user name whose home directory should be used -instead of @file{~}. - -@item -It loads the library @file{default} unless @code{inhibit-default-init} -is non-@code{nil}. (This is not done in @samp{-batch} mode or if -@samp{-q} was specified on the command line.) The library's file name -is usually @file{default.el}. -@cindex @file{default.el} - -@item -It runs the normal hook @code{after-init-hook}. - -@item -It sets the major mode according to @code{initial-major-mode}, provided -the buffer @samp{*scratch*} is still current and still in Fundamental -mode. - -@item -It loads the terminal-specific Lisp file, if any, except when in batch -mode or using a window system. - -@item -It displays the initial echo area message, unless you have suppressed -that with @code{inhibit-startup-echo-area-message}. - -@item -It processes the action arguments from the command line. - -@item -It runs @code{term-setup-hook}. - -@item -It calls @code{frame-notice-user-settings}, which modifies the -parameters of the selected frame according to whatever the init files -specify. - -@item -It runs @code{window-setup-hook}. @xref{Terminal-Specific}. - -@item -It displays copyleft, nonwarranty, and basic use information, provided -there were no remaining command line arguments (a few steps above) and -the value of @code{inhibit-startup-message} is @code{nil}. -@end enumerate - -@defopt inhibit-startup-message -This variable inhibits the initial startup messages (the nonwarranty, -etc.). If it is non-@code{nil}, then the messages are not printed. - -This variable exists so you can set it in your personal init file, once -you are familiar with the contents of the startup message. Do not set -this variable in the init file of a new user, or in a way that affects -more than one user, because that would prevent new users from receiving -the information they are supposed to see. -@end defopt - -@defopt inhibit-startup-echo-area-message -This variable controls the display of the startup echo area message. -You can suppress the startup echo area message by adding text with this -form to your @file{.emacs} file: - -@example -(setq inhibit-startup-echo-area-message - "@var{your-login-name}") -@end example - -Simply setting @code{inhibit-startup-echo-area-message} to your login -name is not sufficient to inhibit the message; Emacs explicitly checks -whether @file{.emacs} contains an expression as shown above. Your login -name must appear in the expression as a Lisp string constant. - -This way, you can easily inhibit the message for yourself if you wish, -but thoughtless copying of your @file{.emacs} file will not inhibit the -message for someone else. -@end defopt - -@node Init File -@subsection The Init File: @file{.emacs} -@cindex init file -@cindex @file{.emacs} - - When you start XEmacs, it normally attempts to load the file -@file{.emacs} from your home directory. This file, if it exists, must -contain Lisp code. It is called your @dfn{init file}. The command line -switches @samp{-q} and @samp{-u} affect the use of the init file; -@samp{-q} says not to load an init file, and @samp{-u} says to load a -specified user's init file instead of yours. @xref{Entering XEmacs,,, -xemacs, The XEmacs User's Manual}. - -@cindex default init file - A site may have a @dfn{default init file}, which is the library named -@file{default.el}. XEmacs finds the @file{default.el} file through the -standard search path for libraries (@pxref{How Programs Do Loading}). -The XEmacs distribution does not come with this file; sites may provide -one for local customizations. If the default init file exists, it is -loaded whenever you start Emacs, except in batch mode or if @samp{-q} is -specified. But your own personal init file, if any, is loaded first; if -it sets @code{inhibit-default-init} to a non-@code{nil} value, then -XEmacs does not subsequently load the @file{default.el} file. - - Another file for site-customization is @file{site-start.el}. Emacs -loads this @emph{before} the user's init file. You can inhibit the -loading of this file with the option @samp{-no-site-file}. - -@defvar site-run-file -This variable specifies the site-customization file to load -before the user's init file. Its normal value is @code{"site-start"}. -@end defvar - - If there is a great deal of code in your @file{.emacs} file, you -should move it into another file named @file{@var{something}.el}, -byte-compile it (@pxref{Byte Compilation}), and make your @file{.emacs} -file load the other file using @code{load} (@pxref{Loading}). - - @xref{Init File Examples,,, xemacs, The XEmacs User's Manual}, for -examples of how to make various commonly desired customizations in your -@file{.emacs} file. - -@defopt inhibit-default-init -This variable prevents XEmacs from loading the default initialization -library file for your session of XEmacs. If its value is non-@code{nil}, -then the default library is not loaded. The default value is -@code{nil}. -@end defopt - -@defvar before-init-hook -@defvarx after-init-hook -These two normal hooks are run just before, and just after, loading of -the user's init file, @file{default.el}, and/or @file{site-start.el}. -@end defvar - -@node Terminal-Specific -@subsection Terminal-Specific Initialization -@cindex terminal-specific initialization - - Each terminal type can have its own Lisp library that XEmacs loads when -run on that type of terminal. For a terminal type named @var{termtype}, -the library is called @file{term/@var{termtype}}. XEmacs finds the file -by searching the @code{load-path} directories as it does for other -files, and trying the @samp{.elc} and @samp{.el} suffixes. Normally, -terminal-specific Lisp library is located in @file{emacs/lisp/term}, a -subdirectory of the @file{emacs/lisp} directory in which most XEmacs Lisp -libraries are kept.@refill - - The library's name is constructed by concatenating the value of the -variable @code{term-file-prefix} and the terminal type. Normally, -@code{term-file-prefix} has the value @code{"term/"}; changing this -is not recommended. - - The usual function of a terminal-specific library is to enable special -keys to send sequences that XEmacs can recognize. It may also need to -set or add to @code{function-key-map} if the Termcap entry does not -specify all the terminal's function keys. @xref{Terminal Input}. - -@cindex Termcap - When the name of the terminal type contains a hyphen, only the part of -the name before the first hyphen is significant in choosing the library -name. Thus, terminal types @samp{aaa-48} and @samp{aaa-30-rv} both use -the @file{term/aaa} library. If necessary, the library can evaluate -@code{(getenv "TERM")} to find the full name of the terminal -type.@refill - - Your @file{.emacs} file can prevent the loading of the -terminal-specific library by setting the variable -@code{term-file-prefix} to @code{nil}. This feature is useful when -experimenting with your own peculiar customizations. - - You can also arrange to override some of the actions of the -terminal-specific library by setting the variable -@code{term-setup-hook}. This is a normal hook which XEmacs runs using -@code{run-hooks} at the end of XEmacs initialization, after loading both -your @file{.emacs} file and any terminal-specific libraries. You can -use this variable to define initializations for terminals that do not -have their own libraries. @xref{Hooks}. - -@defvar term-file-prefix -@cindex @code{TERM} environment variable -If the @code{term-file-prefix} variable is non-@code{nil}, XEmacs loads -a terminal-specific initialization file as follows: - -@example -(load (concat term-file-prefix (getenv "TERM"))) -@end example - -@noindent -You may set the @code{term-file-prefix} variable to @code{nil} in your -@file{.emacs} file if you do not wish to load the -terminal-initialization file. To do this, put the following in -your @file{.emacs} file: @code{(setq term-file-prefix nil)}. -@end defvar - -@defvar term-setup-hook -This variable is a normal hook that XEmacs runs after loading your -@file{.emacs} file, the default initialization file (if any) and the -terminal-specific Lisp file. - -You can use @code{term-setup-hook} to override the definitions made by a -terminal-specific file. -@end defvar - -@defvar window-setup-hook -This variable is a normal hook which XEmacs runs after loading your -@file{.emacs} file and the default initialization file (if any), after -loading terminal-specific Lisp code, and after running the hook -@code{term-setup-hook}. -@end defvar - -@node Command Line Arguments -@subsection Command Line Arguments -@cindex command line arguments - - You can use command line arguments to request various actions when you -start XEmacs. Since you do not need to start XEmacs more than once per -day, and will often leave your XEmacs session running longer than that, -command line arguments are hardly ever used. As a practical matter, it -is best to avoid making the habit of using them, since this habit would -encourage you to kill and restart XEmacs unnecessarily often. These -options exist for two reasons: to be compatible with other editors (for -invocation by other programs) and to enable shell scripts to run -specific Lisp programs. - - This section describes how Emacs processes command line arguments, -and how you can customize them. - -@ignore - (Note that some other editors require you to start afresh each time -you want to edit a file. With this kind of editor, you will probably -specify the file as a command line argument. The recommended way to -use XEmacs is to start it only once, just after you log in, and do -all your editing in the same XEmacs process. Each time you want to edit -a different file, you visit it with the existing XEmacs, which eventually -comes to have many files in it ready for editing. Usually you do not -kill the XEmacs until you are about to log out.) -@end ignore - -@defun command-line -This function parses the command line that XEmacs was called with, -processes it, loads the user's @file{.emacs} file and displays the -startup messages. -@end defun - -@defvar command-line-processed -The value of this variable is @code{t} once the command line has been -processed. - -If you redump XEmacs by calling @code{dump-emacs}, you may wish to set -this variable to @code{nil} first in order to cause the new dumped XEmacs -to process its new command line arguments. -@end defvar - -@defvar command-switch-alist -@cindex switches on command line -@cindex options on command line -@cindex command line options -The value of this variable is an alist of user-defined command-line -options and associated handler functions. This variable exists so you -can add elements to it. - -A @dfn{command line option} is an argument on the command line of the -form: - -@example --@var{option} -@end example - -The elements of the @code{command-switch-alist} look like this: - -@example -(@var{option} . @var{handler-function}) -@end example - -The @var{handler-function} is called to handle @var{option} and receives -the option name as its sole argument. - -In some cases, the option is followed in the command line by an -argument. In these cases, the @var{handler-function} can find all the -remaining command-line arguments in the variable -@code{command-line-args-left}. (The entire list of command-line -arguments is in @code{command-line-args}.) - -The command line arguments are parsed by the @code{command-line-1} -function in the @file{startup.el} file. See also @ref{Command -Switches, , Command Line Switches and Arguments, xemacs, The XEmacs -User's Manual}. -@end defvar - -@defvar command-line-args -The value of this variable is the list of command line arguments passed -to XEmacs. -@end defvar - -@defvar command-line-functions -This variable's value is a list of functions for handling an -unrecognized command-line argument. Each time the next argument to be -processed has no special meaning, the functions in this list are called, -in order of appearance, until one of them returns a non-@code{nil} -value. - -These functions are called with no arguments. They can access the -command-line argument under consideration through the variable -@code{argi}. The remaining arguments (not including the current one) -are in the variable @code{command-line-args-left}. - -When a function recognizes and processes the argument in @code{argi}, it -should return a non-@code{nil} value to say it has dealt with that -argument. If it has also dealt with some of the following arguments, it -can indicate that by deleting them from @code{command-line-args-left}. - -If all of these functions return @code{nil}, then the argument is used -as a file name to visit. -@end defvar - -@node Getting Out -@section Getting out of XEmacs -@cindex exiting XEmacs - - There are two ways to get out of XEmacs: you can kill the XEmacs job, -which exits permanently, or you can suspend it, which permits you to -reenter the XEmacs process later. As a practical matter, you seldom kill -XEmacs---only when you are about to log out. Suspending is much more -common. - -@menu -* Killing XEmacs:: Exiting XEmacs irreversibly. -* Suspending XEmacs:: Exiting XEmacs reversibly. -@end menu - -@node Killing XEmacs -@subsection Killing XEmacs -@cindex killing XEmacs - - Killing XEmacs means ending the execution of the XEmacs process. The -parent process normally resumes control. The low-level primitive for -killing XEmacs is @code{kill-emacs}. - -@defun kill-emacs &optional exit-data -This function exits the XEmacs process and kills it. - -If @var{exit-data} is an integer, then it is used as the exit status -of the XEmacs process. (This is useful primarily in batch operation; see -@ref{Batch Mode}.) - -If @var{exit-data} is a string, its contents are stuffed into the -terminal input buffer so that the shell (or whatever program next reads -input) can read them. -@end defun - - All the information in the XEmacs process, aside from files that have -been saved, is lost when the XEmacs is killed. Because killing XEmacs -inadvertently can lose a lot of work, XEmacs queries for confirmation -before actually terminating if you have buffers that need saving or -subprocesses that are running. This is done in the function -@code{save-buffers-kill-emacs}. - -@defvar kill-emacs-query-functions -After asking the standard questions, @code{save-buffers-kill-emacs} -calls the functions in the list @code{kill-buffer-query-functions}, in -order of appearance, with no arguments. These functions can ask for -additional confirmation from the user. If any of them returns -non-@code{nil}, XEmacs is not killed. -@end defvar - -@defvar kill-emacs-hook -This variable is a normal hook; once @code{save-buffers-kill-emacs} is -finished with all file saving and confirmation, it runs the functions in -this hook. -@end defvar - -@node Suspending XEmacs -@subsection Suspending XEmacs -@cindex suspending XEmacs - - @dfn{Suspending XEmacs} means stopping XEmacs temporarily and returning -control to its superior process, which is usually the shell. This -allows you to resume editing later in the same XEmacs process, with the -same buffers, the same kill ring, the same undo history, and so on. To -resume XEmacs, use the appropriate command in the parent shell---most -likely @code{fg}. - - Some operating systems do not support suspension of jobs; on these -systems, ``suspension'' actually creates a new shell temporarily as a -subprocess of XEmacs. Then you would exit the shell to return to XEmacs. - - Suspension is not useful with window systems such as X, because the -XEmacs job may not have a parent that can resume it again, and in any -case you can give input to some other job such as a shell merely by -moving to a different window. Therefore, suspending is not allowed -when XEmacs is an X client. - -@defun suspend-emacs string -This function stops XEmacs and returns control to the superior process. -If and when the superior process resumes XEmacs, @code{suspend-emacs} -returns @code{nil} to its caller in Lisp. - -If @var{string} is non-@code{nil}, its characters are sent to be read -as terminal input by XEmacs's superior shell. The characters in -@var{string} are not echoed by the superior shell; only the results -appear. - -Before suspending, @code{suspend-emacs} runs the normal hook -@code{suspend-hook}. In Emacs version 18, @code{suspend-hook} was not a -normal hook; its value was a single function, and if its value was -non-@code{nil}, then @code{suspend-emacs} returned immediately without -actually suspending anything. - -After the user resumes XEmacs, @code{suspend-emacs} runs the normal hook -@code{suspend-resume-hook}. @xref{Hooks}. - -The next redisplay after resumption will redraw the entire screen, -unless the variable @code{no-redraw-on-reenter} is non-@code{nil} -(@pxref{Refresh Screen}). - -In the following example, note that @samp{pwd} is not echoed after -XEmacs is suspended. But it is read and executed by the shell. - -@smallexample -@group -(suspend-emacs) - @result{} nil -@end group - -@group -(add-hook 'suspend-hook - (function (lambda () - (or (y-or-n-p - "Really suspend? ") - (error "Suspend cancelled"))))) - @result{} (lambda nil - (or (y-or-n-p "Really suspend? ") - (error "Suspend cancelled"))) -@end group -@group -(add-hook 'suspend-resume-hook - (function (lambda () (message "Resumed!")))) - @result{} (lambda nil (message "Resumed!")) -@end group -@group -(suspend-emacs "pwd") - @result{} nil -@end group -@group ----------- Buffer: Minibuffer ---------- -Really suspend? @kbd{y} ----------- Buffer: Minibuffer ---------- -@end group - -@group ----------- Parent Shell ---------- -lewis@@slug[23] % /user/lewis/manual -lewis@@slug[24] % fg -@end group - -@group ----------- Echo Area ---------- -Resumed! -@end group -@end smallexample -@end defun - -@defvar suspend-hook -This variable is a normal hook run before suspending. -@end defvar - -@defvar suspend-resume-hook -This variable is a normal hook run after suspending. -@end defvar - -@node System Environment -@section Operating System Environment -@cindex operating system environment - - XEmacs provides access to variables in the operating system environment -through various functions. These variables include the name of the -system, the user's @sc{uid}, and so on. - -@defvar system-type -The value of this variable is a symbol indicating the type of operating -system XEmacs is operating on. Here is a table of the possible values: - -@table @code -@item aix-v3 -AIX. - -@item berkeley-unix -Berkeley BSD. - -@item dgux -Data General DGUX operating system. - -@item gnu -A GNU system using the GNU HURD and Mach. - -@item hpux -Hewlett-Packard HPUX operating system. - -@item irix -Silicon Graphics Irix system. - -@item linux -A GNU system using the Linux kernel. - -@item ms-dos -Microsoft MS-DOS ``operating system.'' - -@item next-mach -NeXT Mach-based system. - -@item rtu -Masscomp RTU, UCB universe. - -@item unisoft-unix -UniSoft UniPlus. - -@item usg-unix-v -AT&T System V. - -@item vax-vms -VAX VMS. - -@item windows-nt -Microsoft windows NT. - -@item xenix -SCO Xenix 386. -@end table - -We do not wish to add new symbols to make finer distinctions unless it -is absolutely necessary! In fact, we hope to eliminate some of these -alternatives in the future. We recommend using -@code{system-configuration} to distinguish between different operating -systems. -@end defvar - -@defvar system-configuration -This variable holds the three-part configuration name for the -hardware/software configuration of your system, as a string. The -convenient way to test parts of this string is with @code{string-match}. -@end defvar - -@defun system-name -This function returns the name of the machine you are running on. -@example -(system-name) - @result{} "prep.ai.mit.edu" -@end example -@end defun - -@vindex system-name - The symbol @code{system-name} is a variable as well as a function. In -fact, the function returns whatever value the variable -@code{system-name} currently holds. Thus, you can set the variable -@code{system-name} in case Emacs is confused about the name of your -system. The variable is also useful for constructing frame titles -(@pxref{Frame Titles}). - -@defvar mail-host-address -If this variable is non-@code{nil}, it is used instead of -@code{system-name} for purposes of generating email addresses. For -example, it is used when constructing the default value of -@code{user-mail-address}. @xref{User Identification}. (Since this is -done when XEmacs starts up, the value actually used is the one saved when -XEmacs was dumped. @xref{Building XEmacs}.) -@end defvar - -@defun getenv var -@cindex environment variable access -This function returns the value of the environment variable @var{var}, -as a string. Within XEmacs, the environment variable values are kept in -the Lisp variable @code{process-environment}. - -@example -@group -(getenv "USER") - @result{} "lewis" -@end group - -@group -lewis@@slug[10] % printenv -PATH=.:/user/lewis/bin:/usr/bin:/usr/local/bin -USER=lewis -@end group -@group -TERM=ibmapa16 -SHELL=/bin/csh -HOME=/user/lewis -@end group -@end example -@end defun - -@c Emacs 19 feature -@deffn Command setenv variable value -This command sets the value of the environment variable named -@var{variable} to @var{value}. Both arguments should be strings. This -function works by modifying @code{process-environment}; binding that -variable with @code{let} is also reasonable practice. -@end deffn - -@defvar process-environment -This variable is a list of strings, each describing one environment -variable. The functions @code{getenv} and @code{setenv} work by means -of this variable. - -@smallexample -@group -process-environment -@result{} ("l=/usr/stanford/lib/gnuemacs/lisp" - "PATH=.:/user/lewis/bin:/usr/class:/nfsusr/local/bin" - "USER=lewis" -@end group -@group - "TERM=ibmapa16" - "SHELL=/bin/csh" - "HOME=/user/lewis") -@end group -@end smallexample -@end defvar - -@defvar path-separator -This variable holds a string which says which character separates -directories in a search path (as found in an environment variable). Its -value is @code{":"} for Unix and GNU systems, and @code{";"} for MS-DOS -and Windows NT. -@end defvar - -@defvar invocation-name -This variable holds the program name under which Emacs was invoked. The -value is a string, and does not include a directory name. -@end defvar - -@defvar invocation-directory -This variable holds the directory from which the Emacs executable was -invoked, or perhaps @code{nil} if that directory cannot be determined. -@end defvar - -@defvar installation-directory -If non-@code{nil}, this is a directory within which to look for the -@file{lib-src} and @file{etc} subdirectories. This is non-@code{nil} -when Emacs can't find those directories in their standard installed -locations, but can find them in a directory related somehow to the one -containing the Emacs executable. -@end defvar - -@defun load-average &optional use-floats -This function returns a list of the current 1-minute, 5-minute and -15-minute load averages. The values are integers that are 100 times the -system load averages. (The load averages indicate the number of -processes trying to run.) - -When @var{use-floats} is non-@code{nil}, floats will be returned instead -of integers. These floats are not multiplied by 100. - -@example -@group -(load-average) - @result{} (169 158 164) -(load-average t) - @result{} (1.69921875 1.58984375 1.640625) -@end group - -@group -lewis@@rocky[5] % uptime - 8:06pm up 16 day(s), 21:57, 40 users, - load average: 1.68, 1.59, 1.64 -@end group -@end example - -If the 5-minute or 15-minute load averages are not available, return a -shortened list, containing only those averages which are available. - -On some systems, this function may require special privileges to run, or -it may be unimplemented for the particular system type. In that case, -the function will signal an error. -@end defun - -@defun emacs-pid -This function returns the process @sc{id} of the Emacs process. -@end defun - -@defun setprv privilege-name &optional setp getprv -This function sets or resets a VMS privilege. (It does not exist on -Unix.) The first arg is the privilege name, as a string. The second -argument, @var{setp}, is @code{t} or @code{nil}, indicating whether the -privilege is to be turned on or off. Its default is @code{nil}. The -function returns @code{t} if successful, @code{nil} otherwise. - - If the third argument, @var{getprv}, is non-@code{nil}, @code{setprv} -does not change the privilege, but returns @code{t} or @code{nil} -indicating whether the privilege is currently enabled. -@end defun - -@node User Identification -@section User Identification - -@defvar user-mail-address -This holds the nominal email address of the user who is using Emacs. -When Emacs starts up, it computes a default value that is usually right, -but users often set this themselves when the default value is not right. -@end defvar - -@defun user-login-name &optional uid -If you don't specify @var{uid}, this function returns the name under -which the user is logged in. If the environment variable @code{LOGNAME} -is set, that value is used. Otherwise, if the environment variable -@code{USER} is set, that value is used. Otherwise, the value is based -on the effective @sc{uid}, not the real @sc{uid}. - -If you specify @var{uid}, the value is the user name that corresponds -to @var{uid} (which should be an integer). - -@example -@group -(user-login-name) - @result{} "lewis" -@end group -@end example -@end defun - -@defun user-real-login-name -This function returns the user name corresponding to Emacs's real -@sc{uid}. This ignores the effective @sc{uid} and ignores the -environment variables @code{LOGNAME} and @code{USER}. -@end defun - -@defvar user-full-name -This variable holds the name of the user running this Emacs. It is -initialized at startup time from the value of @code{NAME} environment -variable. You can change the value of this variable to alter the result -of the @code{user-full-name} function. -@end defvar - -@defun user-full-name &optional user -This function returns the full name of @var{user}. If @var{user} is -@code{nil}, it defaults to the user running this Emacs. In that case, -the value of @code{user-full-name} variable, if non-@code{nil}, will be -used. - -If @var{user} is specified explicitly, @code{user-full-name} variable is -ignored. - -@example -@group -(user-full-name) - @result{} "Hrvoje Niksic" -(setq user-full-name "Hrvoje \"Niksa\" Niksic") -(user-full-name) - @result{} "Hrvoje \"Niksa\" Niksic" -(user-full-name "hniksic") - @result{} "Hrvoje Niksic" -@end group -@end example -@end defun - -@vindex user-full-name -@vindex user-real-login-name -@vindex user-login-name - The symbols @code{user-login-name}, @code{user-real-login-name} and -@code{user-full-name} are variables as well as functions. The functions -return the same values that the variables hold. These variables allow -you to ``fake out'' Emacs by telling the functions what to return. The -variables are also useful for constructing frame titles (@pxref{Frame -Titles}). - -@defun user-real-uid -This function returns the real @sc{uid} of the user. - -@example -@group -(user-real-uid) - @result{} 19 -@end group -@end example -@end defun - -@defun user-uid -This function returns the effective @sc{uid} of the user. -@end defun - -@defun user-home-directory -This function returns the ``@code{HOME}'' directory of the user, and is -intended to replace occurrences of ``@code{(getenv "HOME")}''. Under -Unix systems, the following is done: - -@enumerate -@item -Return the value of ``@code{(getenv "HOME")}'', if set. - -@item -Return ``/'', as a fallback, but issue a warning. (Future versions of -XEmacs will also attempt to lookup the @code{HOME} directory via -@code{getpwent()}, but this has not yet been implemented.) -@end enumerate - -Under MS Windows, this is done: - -@enumerate -@item -Return the value of ``@code{(getenv "HOME")}'', if set. - -@item -If the environment variables @code{HOMEDRIVE} and @code{HOMEDIR} are -both set, return the concatenation (the following description uses MS -Windows environment variable substitution syntax): -@code{%HOMEDRIVE%%HOMEDIR%}. - -@item -Return ``C:\'', as a fallback, but issue a warning. -@end enumerate -@end defun - -@node Time of Day -@section Time of Day - - This section explains how to determine the current time and the time -zone. - -@defun current-time-string &optional time-value -This function returns the current time and date as a humanly-readable -string. The format of the string is unvarying; the number of characters -used for each part is always the same, so you can reliably use -@code{substring} to extract pieces of it. It is wise to count the -characters from the beginning of the string rather than from the end, as -additional information may be added at the end. - -@c Emacs 19 feature -The argument @var{time-value}, if given, specifies a time to format -instead of the current time. The argument should be a list whose first -two elements are integers. Thus, you can use times obtained from -@code{current-time} (see below) and from @code{file-attributes} -(@pxref{File Attributes}). - -@example -@group -(current-time-string) - @result{} "Wed Oct 14 22:21:05 1987" -@end group -@end example -@end defun - -@c Emacs 19 feature -@defun current-time -This function returns the system's time value as a list of three -integers: @code{(@var{high} @var{low} @var{microsec})}. The integers -@var{high} and @var{low} combine to give the number of seconds since -0:00 January 1, 1970, which is -@ifinfo -@var{high} * 2**16 + @var{low}. -@end ifinfo -@tex -$high*2^{16}+low$. -@end tex - -The third element, @var{microsec}, gives the microseconds since the -start of the current second (or 0 for systems that return time only on -the resolution of a second). - -The first two elements can be compared with file time values such as you -get with the function @code{file-attributes}. @xref{File Attributes}. -@end defun - -@c Emacs 19 feature -@defun current-time-zone &optional time-value -This function returns a list describing the time zone that the user is -in. - -The value has the form @code{(@var{offset} @var{name})}. Here -@var{offset} is an integer giving the number of seconds ahead of UTC -(east of Greenwich). A negative value means west of Greenwich. The -second element, @var{name} is a string giving the name of the time -zone. Both elements change when daylight savings time begins or ends; -if the user has specified a time zone that does not use a seasonal time -adjustment, then the value is constant through time. - -If the operating system doesn't supply all the information necessary to -compute the value, both elements of the list are @code{nil}. - -The argument @var{time-value}, if given, specifies a time to analyze -instead of the current time. The argument should be a cons cell -containing two integers, or a list whose first two elements are -integers. Thus, you can use times obtained from @code{current-time} -(see above) and from @code{file-attributes} (@pxref{File Attributes}). -@end defun - -@node Time Conversion -@section Time Conversion - - These functions convert time values (lists of two or three integers) -to strings or to calendrical information. There is also a function to -convert calendrical information to a time value. You can get time -values from the functions @code{current-time} (@pxref{Time of Day}) and -@code{file-attributes} (@pxref{File Attributes}). - -@defun format-time-string format-string &optional time -This function converts @var{time} to a string according to -@var{format-string}. If @var{time} is omitted, it defaults to the -current time. The argument @var{format-string} may contain -@samp{%}-sequences which say to substitute parts of the time. Here is a -table of what the @samp{%}-sequences mean: - -@table @samp -@item %a -This stands for the abbreviated name of the day of week. -@item %A -This stands for the full name of the day of week. -@item %b -This stands for the abbreviated name of the month. -@item %B -This stands for the full name of the month. -@item %c -This is a synonym for @samp{%x %X}. -@item %C -This has a locale-specific meaning. In the default locale (named C), it -is equivalent to @samp{%A, %B %e, %Y}. -@item %d -This stands for the day of month, zero-padded. -@item %D -This is a synonym for @samp{%m/%d/%y}. -@item %e -This stands for the day of month, blank-padded. -@item %h -This is a synonym for @samp{%b}. -@item %H -This stands for the hour (00-23). -@item %I -This stands for the hour (00-12). -@item %j -This stands for the day of the year (001-366). -@item %k -This stands for the hour (0-23), blank padded. -@item %l -This stands for the hour (1-12), blank padded. -@item %m -This stands for the month (01-12). -@item %M -This stands for the minute (00-59). -@item %n -This stands for a newline. -@item %p -This stands for @samp{AM} or @samp{PM}, as appropriate. -@item %r -This is a synonym for @samp{%I:%M:%S %p}. -@item %R -This is a synonym for @samp{%H:%M}. -@item %S -This stands for the seconds (00-60). -@item %t -This stands for a tab character. -@item %T -This is a synonym for @samp{%H:%M:%S}. -@item %U -This stands for the week of the year (01-52), assuming that weeks -start on Sunday. -@item %w -This stands for the numeric day of week (0-6). Sunday is day 0. -@item %W -This stands for the week of the year (01-52), assuming that weeks -start on Monday. -@item %x -This has a locale-specific meaning. In the default locale (named C), it -is equivalent to @samp{%D}. -@item %X -This has a locale-specific meaning. In the default locale (named C), it -is equivalent to @samp{%T}. -@item %y -This stands for the year without century (00-99). -@item %Y -This stands for the year with century. -@item %Z -This stands for the time zone abbreviation. -@end table -@end defun - -@defun decode-time time -This function converts a time value into calendrical information. The -return value is a list of nine elements, as follows: - -@example -(@var{seconds} @var{minutes} @var{hour} @var{day} @var{month} @var{year} @var{dow} @var{dst} @var{zone}) -@end example - -Here is what the elements mean: - -@table @var -@item sec -The number of seconds past the minute, as an integer between 0 and 59. -@item minute -The number of minutes past the hour, as an integer between 0 and 59. -@item hour -The hour of the day, as an integer between 0 and 23. -@item day -The day of the month, as an integer between 1 and 31. -@item month -The month of the year, as an integer between 1 and 12. -@item year -The year, an integer typically greater than 1900. -@item dow -The day of week, as an integer between 0 and 6, where 0 stands for -Sunday. -@item dst -@code{t} if daylight savings time is effect, otherwise @code{nil}. -@item zone -An integer indicating the time zone, as the number of seconds east of -Greenwich. -@end table - -Note that Common Lisp has different meanings for @var{dow} and -@var{zone}. -@end defun - -@defun encode-time seconds minutes hour day month year &optional zone -This function is the inverse of @code{decode-time}. It converts seven -items of calendrical data into a time value. For the meanings of the -arguments, see the table above under @code{decode-time}. - -Year numbers less than 100 are treated just like other year numbers. If -you want them to stand for years above 1900, you must alter them yourself -before you call @code{encode-time}. - -The optional argument @var{zone} defaults to the current time zone and -its daylight savings time rules. If specified, it can be either a list -(as you would get from @code{current-time-zone}) or an integer (as you -would get from @code{decode-time}). The specified zone is used without -any further alteration for daylight savings time. -@end defun - -@node Timers -@section Timers for Delayed Execution - -You can set up a timer to call a function at a specified future time. - -@c All different in FSF 19 -@defun add-timeout secs function object &optional resignal -This function adds a timeout, to be signaled after the timeout period -has elapsed. @var{secs} is a number of seconds, expressed as an integer -or a float. @var{function} will be called after that many seconds have -elapsed, with one argument, the given @var{object}. If the optional -@var{resignal} argument is provided, then after this timeout expires, -`add-timeout' will automatically be called again with @var{resignal} as the -first argument. - -This function returns an object which is the @dfn{id} of this particular -timeout. You can pass that object to @code{disable-timeout} to turn off -the timeout before it has been signalled. - -The number of seconds may be expressed as a floating-point number, in which -case some fractional part of a second will be used. Caveat: the usable -timeout granularity will vary from system to system. - -Adding a timeout causes a timeout event to be returned by -@code{next-event}, and the function will be invoked by -@code{dispatch-event}, so if XEmacs is in a tight loop, the function will -not be invoked until the next call to sit-for or until the return to -top-level (the same is true of process filters). - -WARNING: if you are thinking of calling add-timeout from inside of a -callback function as a way of resignalling a timeout, think again. There -is a race condition. That's why the @var{resignal} argument exists. - -(NOTE: In FSF Emacs, this function is called @code{run-at-time} and -has different semantics.) -@end defun - -@defun disable-timeout id -Cancel the requested action for @var{id}, which should be a value -previously returned by @code{add-timeout}. This cancels the effect of -that call to @code{add-timeout}; the arrival of the specified time will -not cause anything special to happen. -(NOTE: In FSF Emacs, this function is called @code{cancel-timer}.) -@end defun - -@node Terminal Input -@section Terminal Input -@cindex terminal input - - This section describes functions and variables for recording or -manipulating terminal input. See @ref{Display}, for related -functions. - -@menu -* Input Modes:: Options for how input is processed. -* Translating Input:: Low level conversion of some characters or events - into others. -* Recording Input:: Saving histories of recent or all input events. -@end menu - -@node Input Modes -@subsection Input Modes -@cindex input modes -@cindex terminal input modes - -@defun set-input-mode interrupt flow meta quit-char -This function sets the mode for reading keyboard input. If -@var{interrupt} is non-null, then XEmacs uses input interrupts. If it is -@code{nil}, then it uses @sc{cbreak} mode. When XEmacs communicates -directly with X, it ignores this argument and uses interrupts if that is -the way it knows how to communicate. - -If @var{flow} is non-@code{nil}, then XEmacs uses @sc{xon/xoff} (@kbd{C-q}, -@kbd{C-s}) flow control for output to the terminal. This has no effect except -in @sc{cbreak} mode. @xref{Flow Control}. - -The default setting is system dependent. Some systems always use -@sc{cbreak} mode regardless of what is specified. - -@c Emacs 19 feature -The argument @var{meta} controls support for input character codes -above 127. If @var{meta} is @code{t}, XEmacs converts characters with -the 8th bit set into Meta characters. If @var{meta} is @code{nil}, -XEmacs disregards the 8th bit; this is necessary when the terminal uses -it as a parity bit. If @var{meta} is neither @code{t} nor @code{nil}, -XEmacs uses all 8 bits of input unchanged. This is good for terminals -using European 8-bit character sets. - -@c Emacs 19 feature -If @var{quit-char} is non-@code{nil}, it specifies the character to -use for quitting. Normally this character is @kbd{C-g}. -@xref{Quitting}. -@end defun - -The @code{current-input-mode} function returns the input mode settings -XEmacs is currently using. - -@c Emacs 19 feature -@defun current-input-mode -This function returns current mode for reading keyboard input. It -returns a list, corresponding to the arguments of @code{set-input-mode}, -of the form @code{(@var{interrupt} @var{flow} @var{meta} @var{quit})} in -which: -@table @var -@item interrupt -is non-@code{nil} when XEmacs is using interrupt-driven input. If -@code{nil}, Emacs is using @sc{cbreak} mode. -@item flow -is non-@code{nil} if XEmacs uses @sc{xon/xoff} (@kbd{C-q}, @kbd{C-s}) -flow control for output to the terminal. This value has no effect -unless @var{interrupt} is non-@code{nil}. -@item meta -is @code{t} if XEmacs treats the eighth bit of input characters as -the meta bit; @code{nil} means XEmacs clears the eighth bit of every -input character; any other value means XEmacs uses all eight bits as the -basic character code. -@item quit -is the character XEmacs currently uses for quitting, usually @kbd{C-g}. -@end table -@end defun - -@node Translating Input -@subsection Translating Input Events -@cindex translating input events - - This section describes features for translating input events into other -input events before they become part of key sequences. - -@ignore Not in XEmacs yet. -@c Emacs 19 feature -@defvar extra-keyboard-modifiers -This variable lets Lisp programs ``press'' the modifier keys on the -keyboard. The value is a bit mask: - -@table @asis -@item 1 -The @key{SHIFT} key. -@item 2 -The @key{LOCK} key. -@item 4 -The @key{CTL} key. -@item 8 -The @key{META} key. -@end table - -Each time the user types a keyboard key, it is altered as if the -modifier keys specified in the bit mask were held down. - -When using X windows, the program can ``press'' any of the modifier -keys in this way. Otherwise, only the @key{CTL} and @key{META} keys can -be virtually pressed. -@end defvar - -@defvar keyboard-translate-table -This variable is the translate table for keyboard characters. It lets -you reshuffle the keys on the keyboard without changing any command -bindings. Its value must be a string or @code{nil}. - -If @code{keyboard-translate-table} is a string, then each character read -from the keyboard is looked up in this string and the character in the -string is used instead. If the string is of length @var{n}, character codes -@var{n} and up are untranslated. - -In the example below, we set @code{keyboard-translate-table} to a -string of 128 characters. Then we fill it in to swap the characters -@kbd{C-s} and @kbd{C-\} and the characters @kbd{C-q} and @kbd{C-^}. -Subsequently, typing @kbd{C-\} has all the usual effects of typing -@kbd{C-s}, and vice versa. (@xref{Flow Control} for more information on -this subject.) - -@cindex flow control example -@example -@group -(defun evade-flow-control () - "Replace C-s with C-\ and C-q with C-^." - (interactive) -@end group -@group - (let ((the-table (make-string 128 0))) - (let ((i 0)) - (while (< i 128) - (aset the-table i i) - (setq i (1+ i)))) -@end group - ;; @r{Swap @kbd{C-s} and @kbd{C-\}.} - (aset the-table ?\034 ?\^s) - (aset the-table ?\^s ?\034) -@group - ;; @r{Swap @kbd{C-q} and @kbd{C-^}.} - (aset the-table ?\036 ?\^q) - (aset the-table ?\^q ?\036) - (setq keyboard-translate-table the-table))) -@end group -@end example - -Note that this translation is the first thing that happens to a -character after it is read from the terminal. Record-keeping features -such as @code{recent-keys} and dribble files record the characters after -translation. -@end defvar - -@defun keyboard-translate from to -This function modifies @code{keyboard-translate-table} to translate -character code @var{from} into character code @var{to}. It creates -or enlarges the translate table if necessary. -@end defun -@end ignore - -@defvar function-key-map -This variable holds a keymap that describes the character sequences -sent by function keys on an ordinary character terminal. This keymap -uses the same data structure as other keymaps, but is used differently: it -specifies translations to make while reading events. - -If @code{function-key-map} ``binds'' a key sequence @var{k} to a vector -@var{v}, then when @var{k} appears as a subsequence @emph{anywhere} in a -key sequence, it is replaced with the events in @var{v}. - -For example, VT100 terminals send @kbd{@key{ESC} O P} when the -keypad PF1 key is pressed. Therefore, we want XEmacs to translate -that sequence of events into the single event @code{pf1}. We accomplish -this by ``binding'' @kbd{@key{ESC} O P} to @code{[pf1]} in -@code{function-key-map}, when using a VT100. - -Thus, typing @kbd{C-c @key{PF1}} sends the character sequence @kbd{C-c -@key{ESC} O P}; later the function @code{read-key-sequence} translates -this back into @kbd{C-c @key{PF1}}, which it returns as the vector -@code{[?\C-c pf1]}. - -Entries in @code{function-key-map} are ignored if they conflict with -bindings made in the minor mode, local, or global keymaps. The intent -is that the character sequences that function keys send should not have -command bindings in their own right. - -The value of @code{function-key-map} is usually set up automatically -according to the terminal's Terminfo or Termcap entry, but sometimes -those need help from terminal-specific Lisp files. XEmacs comes with -terminal-specific files for many common terminals; their main purpose is -to make entries in @code{function-key-map} beyond those that can be -deduced from Termcap and Terminfo. @xref{Terminal-Specific}. - -Emacs versions 18 and earlier used totally different means of detecting -the character sequences that represent function keys. -@end defvar - -@defvar key-translation-map -This variable is another keymap used just like @code{function-key-map} -to translate input events into other events. It differs from -@code{function-key-map} in two ways: - -@itemize @bullet -@item -@code{key-translation-map} goes to work after @code{function-key-map} is -finished; it receives the results of translation by -@code{function-key-map}. - -@item -@code{key-translation-map} overrides actual key bindings. -@end itemize - -The intent of @code{key-translation-map} is for users to map one -character set to another, including ordinary characters normally bound -to @code{self-insert-command}. -@end defvar - -@cindex key translation function -You can use @code{function-key-map} or @code{key-translation-map} for -more than simple aliases, by using a function, instead of a key -sequence, as the ``translation'' of a key. Then this function is called -to compute the translation of that key. - -The key translation function receives one argument, which is the prompt -that was specified in @code{read-key-sequence}---or @code{nil} if the -key sequence is being read by the editor command loop. In most cases -you can ignore the prompt value. - -If the function reads input itself, it can have the effect of altering -the event that follows. For example, here's how to define @kbd{C-c h} -to turn the character that follows into a Hyper character: - -@example -@group -(defun hyperify (prompt) - (let ((e (read-event))) - (vector (if (numberp e) - (logior (lsh 1 20) e) - (if (memq 'hyper (event-modifiers e)) - e - (add-event-modifier "H-" e)))))) - -(defun add-event-modifier (string e) - (let ((symbol (if (symbolp e) e (car e)))) - (setq symbol (intern (concat string - (symbol-name symbol)))) -@end group -@group - (if (symbolp e) - symbol - (cons symbol (cdr e))))) - -(define-key function-key-map "\C-ch" 'hyperify) -@end group -@end example - -@pindex iso-transl -@cindex Latin-1 character set (input) -@cindex ISO Latin-1 characters (input) -The @file{iso-transl} library uses this feature to provide a way of -inputting non-ASCII Latin-1 characters. - -@node Recording Input -@subsection Recording Input - -@defun recent-keys &optional number -This function returns a vector containing recent input events from the -keyboard or mouse. By default, 100 events are recorded, which is how -many @code{recent-keys} returns. - -All input events are included, whether or not they were used as parts of -key sequences. Thus, you always get the last 100 inputs, not counting -keyboard macros. (Events from keyboard macros are excluded because they -are less interesting for debugging; it should be enough to see the -events that invoked the macros.) - -If @var{number} is specified, not more than @var{number} events will be -returned. You may change the number of stored events using -@code{set-recent-keys-ring-size}. -@end defun - -@defun recent-keys-ring-size -This function returns the number of recent events stored internally. -This is also the maximum number of events @code{recent-keys} can -return. By default, 100 events are stored. -@end defun - -@defun set-recent-keys-ring-size size -This function changes the number of events stored by XEmacs and returned -by @code{recent-keys}. - -For example, @code{(set-recent-keys-ring-size 250)} will make XEmacs -remember last 250 events and will make @code{recent-keys} return last -250 events by default. -@end defun - -@deffn Command open-dribble-file filename -@cindex dribble file -This function opens a @dfn{dribble file} named @var{filename}. When a -dribble file is open, each input event from the keyboard or mouse (but -not those from keyboard macros) is written in that file. A -non-character event is expressed using its printed representation -surrounded by @samp{<@dots{}>}. - -You close the dribble file by calling this function with an argument -of @code{nil}. - -This function is normally used to record the input necessary to -trigger an XEmacs bug, for the sake of a bug report. - -@example -@group -(open-dribble-file "~/dribble") - @result{} nil -@end group -@end example -@end deffn - - See also the @code{open-termscript} function (@pxref{Terminal Output}). - -@node Terminal Output -@section Terminal Output -@cindex terminal output - - The terminal output functions send output to the terminal or keep -track of output sent to the terminal. The function -@code{device-baud-rate} tells you what XEmacs thinks is the output speed -of the terminal. - -@defun device-baud-rate &optional device -This function's value is the output speed of the terminal associated -with @var{device}, as far as XEmacs knows. @var{device} defaults to the -selected device (usually the only device) if omitted. Changing this -value does not change the speed of actual data transmission, but the -value is used for calculations such as padding. This value has no -effect for window-system devices. (This is different in FSF Emacs, where -the baud rate also affects decisions about whether to scroll part of the -screen or repaint, even when using a window system.) - -The value is measured in bits per second. -@end defun - -XEmacs attempts to automatically initialize the baud rate by querying -the terminal. If you are running across a network, however, and -different parts of the network work are at different baud rates, the -value returned by XEmacs may be different from the value used by your -local terminal. Some network protocols communicate the local terminal -speed to the remote machine, so that XEmacs and other programs can get -the proper value, but others do not. If XEmacs has the wrong value, it -makes decisions that are less than optimal. To fix the problem, use -@code{set-device-baud-rate}. - -@defun set-device-baud-rate &optional device -This function sets the output speed of @var{device}. See -@code{device-baud-rate}. @var{device} defaults to the selected device -(usually the only device) if omitted. -@end defun - -@defun send-string-to-terminal char-or-string &optional stdout-p device -This function sends @var{char-or-string} to the terminal without -alteration. Control characters in @var{char-or-string} have -terminal-dependent effects. - -If @var{device} is @code{nil}, this function writes to XEmacs's -stderr, or to stdout if @var{stdout-p} is non-@code{nil}. Otherwise, -@var{device} should be a tty or stream device, and the function writes -to the device's normal or error output, according to @var{stdout-p}. - -One use of this function is to define function keys on terminals that -have downloadable function key definitions. For example, this is how on -certain terminals to define function key 4 to move forward four -characters (by transmitting the characters @kbd{C-u C-f} to the -computer): - -@example -@group -(send-string-to-terminal "\eF4\^U\^F") - @result{} nil -@end group -@end example -@end defun - -@deffn Command open-termscript filename -@cindex termscript file -This function is used to open a @dfn{termscript file} that will record -all the characters sent by XEmacs to the terminal. (If there are -multiple tty or stream devices, all characters sent to all such devices -are recorded.) The function returns @code{nil}. Termscript files are -useful for investigating problems where XEmacs garbles the screen, -problems that are due to incorrect Termcap entries or to undesirable -settings of terminal options more often than to actual XEmacs bugs. -Once you are certain which characters were actually output, you can -determine reliably whether they correspond to the Termcap specifications -in use. - -A @code{nil} value for @var{filename} stops recording terminal output. - -See also @code{open-dribble-file} in @ref{Terminal Input}. - -@example -@group -(open-termscript "../junk/termscript") - @result{} nil -@end group -@end example -@end deffn - -@ignore Not in XEmacs -@node Special Keysyms -@section System-Specific X11 Keysyms - -To define system-specific X11 keysyms, set the variable -@code{system-key-alist}. - -@defvar system-key-alist -This variable's value should be an alist with one element for each -system-specific keysym. An element has this form: @code{(@var{code} -. @var{symbol})}, where @var{code} is the numeric keysym code (not -including the ``vendor specific'' bit, 1 << 28), and @var{symbol} is the -name for the function key. - -For example @code{(168 . mute-acute)} defines a system-specific key used -by HP X servers whose numeric code is (1 << 28) + 168. - -It is not a problem if the alist defines keysyms for other X servers, as -long as they don't conflict with the ones used by the X server actually -in use. - -The variable is always local to the current X terminal and cannot be -buffer-local. @xref{Multiple Displays}. -@end defvar -@end ignore - -@node Flow Control -@section Flow Control -@cindex flow control characters - - This section attempts to answer the question ``Why does XEmacs choose -to use flow-control characters in its command character set?'' For a -second view on this issue, read the comments on flow control in the -@file{emacs/INSTALL} file from the distribution; for help with Termcap -entries and DEC terminal concentrators, see @file{emacs/etc/TERMS}. - -@cindex @kbd{C-s} -@cindex @kbd{C-q} - At one time, most terminals did not need flow control, and none used -@code{C-s} and @kbd{C-q} for flow control. Therefore, the choice of -@kbd{C-s} and @kbd{C-q} as command characters was uncontroversial. -XEmacs, for economy of keystrokes and portability, used nearly all the -@sc{ASCII} control characters, with mnemonic meanings when possible; -thus, @kbd{C-s} for search and @kbd{C-q} for quote. - - Later, some terminals were introduced which required these characters -for flow control. They were not very good terminals for full-screen -editing, so XEmacs maintainers did not pay attention. In later years, -flow control with @kbd{C-s} and @kbd{C-q} became widespread among -terminals, but by this time it was usually an option. And the majority -of users, who can turn flow control off, were unwilling to switch to -less mnemonic key bindings for the sake of flow control. - - So which usage is ``right'', XEmacs's or that of some terminal and -concentrator manufacturers? This question has no simple answer. - - One reason why we are reluctant to cater to the problems caused by -@kbd{C-s} and @kbd{C-q} is that they are gratuitous. There are other -techniques (albeit less common in practice) for flow control that -preserve transparency of the character stream. Note also that their use -for flow control is not an official standard. Interestingly, on the -model 33 teletype with a paper tape punch (which is very old), @kbd{C-s} -and @kbd{C-q} were sent by the computer to turn the punch on and off! - - As X servers and other window systems replace character-only -terminals, this problem is gradually being cured. For the mean time, -XEmacs provides a convenient way of enabling flow control if you want it: -call the function @code{enable-flow-control}. - -@defun enable-flow-control -This function enables use of @kbd{C-s} and @kbd{C-q} for output flow -control, and provides the characters @kbd{C-\} and @kbd{C-^} as aliases -for them using @code{keyboard-translate-table} (@pxref{Translating Input}). -@end defun - -You can use the function @code{enable-flow-control-on} in your -@file{.emacs} file to enable flow control automatically on certain -terminal types. - -@defun enable-flow-control-on &rest termtypes -This function enables flow control, and the aliases @kbd{C-\} and @kbd{C-^}, -if the terminal type is one of @var{termtypes}. For example: - -@smallexample -(enable-flow-control-on "vt200" "vt300" "vt101" "vt131") -@end smallexample -@end defun - - Here is how @code{enable-flow-control} does its job: - -@enumerate -@item -@cindex @sc{cbreak} -It sets @sc{cbreak} mode for terminal input, and tells the operating -system to handle flow control, with @code{(set-input-mode nil t)}. - -@item -It sets up @code{keyboard-translate-table} to translate @kbd{C-\} and -@kbd{C-^} into @kbd{C-s} and @kbd{C-q}. Except at its very -lowest level, XEmacs never knows that the characters typed were anything -but @kbd{C-s} and @kbd{C-q}, so you can in effect type them as @kbd{C-\} -and @kbd{C-^} even when they are input for other commands. -@xref{Translating Input}. -@end enumerate - -If the terminal is the source of the flow control characters, then once -you enable kernel flow control handling, you probably can make do with -less padding than normal for that terminal. You can reduce the amount -of padding by customizing the Termcap entry. You can also reduce it by -setting @code{baud-rate} to a smaller value so that XEmacs uses a smaller -speed when calculating the padding needed. @xref{Terminal Output}. - -@node Batch Mode -@section Batch Mode -@cindex batch mode -@cindex noninteractive use - - The command line option @samp{-batch} causes XEmacs to run -noninteractively. In this mode, XEmacs does not read commands from the -terminal, it does not alter the terminal modes, and it does not expect -to be outputting to an erasable screen. The idea is that you specify -Lisp programs to run; when they are finished, XEmacs should exit. The -way to specify the programs to run is with @samp{-l @var{file}}, which -loads the library named @var{file}, and @samp{-f @var{function}}, which -calls @var{function} with no arguments. - - Any Lisp program output that would normally go to the echo area, -either using @code{message} or using @code{prin1}, etc., with @code{t} -as the stream, goes instead to XEmacs's standard error descriptor when -in batch mode. Thus, XEmacs behaves much like a noninteractive -application program. (The echo area output that XEmacs itself normally -generates, such as command echoing, is suppressed entirely.) - -@defun noninteractive -This function returns non-@code{nil} when XEmacs is running in batch mode. -@end defun - -@defvar noninteractive -This variable is non-@code{nil} when XEmacs is running in batch mode. -Setting this variable to @code{nil}, however, will not change whether -XEmacs is running in batch mode, and will not change the return value -of the @code{noninteractive} function. -@end defvar diff --git a/man/lispref/positions.texi b/man/lispref/positions.texi deleted file mode 100644 index 0030e51..0000000 --- a/man/lispref/positions.texi +++ /dev/null @@ -1,965 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/positions.info -@node Positions, Markers, Consoles and Devices, Top -@chapter Positions -@cindex position (in buffer) - - A @dfn{position} is the index of a character in the text of a buffer. -More precisely, a position identifies the place between two characters -(or before the first character, or after the last character), so we can -speak of the character before or after a given position. However, we -often speak of the character ``at'' a position, meaning the character -after that position. - - Positions are usually represented as integers starting from 1, but can -also be represented as @dfn{markers}---special objects that relocate -automatically when text is inserted or deleted so they stay with the -surrounding characters. @xref{Markers}. - -@menu -* Point:: The special position where editing takes place. -* Motion:: Changing point. -* Excursions:: Temporary motion and buffer changes. -* Narrowing:: Restricting editing to a portion of the buffer. -@end menu - -@node Point -@section Point -@cindex point - - @dfn{Point} is a special buffer position used by many editing -commands, including the self-inserting typed characters and text -insertion functions. Other commands move point through the text -to allow editing and insertion at different places. - - Like other positions, point designates a place between two characters -(or before the first character, or after the last character), rather -than a particular character. Usually terminals display the cursor over -the character that immediately follows point; point is actually before -the character on which the cursor sits. - -@cindex point with narrowing - The value of point is a number between 1 and the buffer size plus 1. -If narrowing is in effect (@pxref{Narrowing}), then point is constrained -to fall within the accessible portion of the buffer (possibly at one end -of it). - - Each buffer has its own value of point, which is independent of the -value of point in other buffers. Each window also has a value of point, -which is independent of the value of point in other windows on the same -buffer. This is why point can have different values in various windows -that display the same buffer. When a buffer appears in only one window, -the buffer's point and the window's point normally have the same value, -so the distinction is rarely important. @xref{Window Point}, for more -details. - -@defun point &optional buffer -@cindex current buffer position -This function returns the value of point in @var{buffer}, as an integer. -@var{buffer} defaults to the current buffer if omitted. - -@need 700 -@example -@group -(point) - @result{} 175 -@end group -@end example -@end defun - -@defun point-min &optional buffer -This function returns the minimum accessible value of point in -@var{buffer}. This is normally 1, but if narrowing is in effect, it is -the position of the start of the region that you narrowed to. -(@xref{Narrowing}.) @var{buffer} defaults to the current buffer if -omitted. -@end defun - -@defun point-max &optional buffer -This function returns the maximum accessible value of point in -@var{buffer}. This is @code{(1+ (buffer-size buffer))}, unless -narrowing is in effect, in which case it is the position of the end of -the region that you narrowed to. (@xref{Narrowing}). @var{buffer} -defaults to the current buffer if omitted. -@end defun - -@defun buffer-end flag &optional buffer -This function returns @code{(point-min buffer)} if @var{flag} is less -than 1, @code{(point-max buffer)} otherwise. The argument @var{flag} -must be a number. @var{buffer} defaults to the current buffer if -omitted. -@end defun - -@defun buffer-size &optional buffer -This function returns the total number of characters in @var{buffer}. -In the absence of any narrowing (@pxref{Narrowing}), @code{point-max} -returns a value one larger than this. @var{buffer} defaults to the -current buffer if omitted. - -@example -@group -(buffer-size) - @result{} 35 -@end group -@group -(point-max) - @result{} 36 -@end group -@end example -@end defun - -@defvar buffer-saved-size - The value of this buffer-local variable is the former length of the -current buffer, as of the last time it was read in, saved or auto-saved. -@end defvar - -@node Motion -@section Motion - - Motion functions change the value of point, either relative to the -current value of point, relative to the beginning or end of the buffer, -or relative to the edges of the selected window. @xref{Point}. - -@menu -* Character Motion:: Moving in terms of characters. -* Word Motion:: Moving in terms of words. -* Buffer End Motion:: Moving to the beginning or end of the buffer. -* Text Lines:: Moving in terms of lines of text. -* Screen Lines:: Moving in terms of lines as displayed. -* List Motion:: Moving by parsing lists and sexps. -* Skipping Characters:: Skipping characters belonging to a certain set. -@end menu - -@node Character Motion -@subsection Motion by Characters - - These functions move point based on a count of characters. -@code{goto-char} is the fundamental primitive; the other functions use -that. - -@deffn Command goto-char position &optional buffer -This function sets point in @code{buffer} to the value @var{position}. -If @var{position} is less than 1, it moves point to the beginning of the -buffer. If @var{position} is greater than the length of the buffer, it -moves point to the end. @var{buffer} defaults to the current buffer if -omitted. - -If narrowing is in effect, @var{position} still counts from the -beginning of the buffer, but point cannot go outside the accessible -portion. If @var{position} is out of range, @code{goto-char} moves -point to the beginning or the end of the accessible portion. - -When this function is called interactively, @var{position} is the -numeric prefix argument, if provided; otherwise it is read from the -minibuffer. - -@code{goto-char} returns @var{position}. -@end deffn - -@deffn Command forward-char &optional count buffer -@c @kindex beginning-of-buffer -@c @kindex end-of-buffer -This function moves point @var{count} characters forward, towards the -end of the buffer (or backward, towards the beginning of the buffer, if -@var{count} is negative). If the function attempts to move point past -the beginning or end of the buffer (or the limits of the accessible -portion, when narrowing is in effect), an error is signaled with error -code @code{beginning-of-buffer} or @code{end-of-buffer}. @var{buffer} -defaults to the current buffer if omitted. - - -In an interactive call, @var{count} is the numeric prefix argument. -@end deffn - -@deffn Command backward-char &optional count buffer -This function moves point @var{count} characters backward, towards the -beginning of the buffer (or forward, towards the end of the buffer, if -@var{count} is negative). If the function attempts to move point past -the beginning or end of the buffer (or the limits of the accessible -portion, when narrowing is in effect), an error is signaled with error -code @code{beginning-of-buffer} or @code{end-of-buffer}. @var{buffer} -defaults to the current buffer if omitted. - - -In an interactive call, @var{count} is the numeric prefix argument. -@end deffn - -@node Word Motion -@subsection Motion by Words - - These functions for parsing words use the syntax table to decide -whether a given character is part of a word. @xref{Syntax Tables}. - -@deffn Command forward-word count &optional buffer -This function moves point forward @var{count} words (or backward if -@var{count} is negative). Normally it returns @code{t}. If this motion -encounters the beginning or end of the buffer, or the limits of the -accessible portion when narrowing is in effect, point stops there and -the value is @code{nil}. @var{buffer} defaults to the current buffer if -omitted. - -In an interactive call, @var{count} is set to the numeric prefix -argument. -@end deffn - -@deffn Command backward-word count &optional buffer -This function is just like @code{forward-word}, except that it moves -backward until encountering the front of a word, rather than forward. -@var{buffer} defaults to the current buffer if omitted. - -In an interactive call, @var{count} is set to the numeric prefix -argument. - -This function is rarely used in programs, as it is more efficient to -call @code{forward-word} with a negative argument. -@end deffn - -@defvar words-include-escapes -@c Emacs 19 feature -This variable affects the behavior of @code{forward-word} and everything -that uses it. If it is non-@code{nil}, then characters in the -``escape'' and ``character quote'' syntax classes count as part of -words. Otherwise, they do not. -@end defvar - -@node Buffer End Motion -@subsection Motion to an End of the Buffer - - To move point to the beginning of the buffer, write: - -@example -@group -(goto-char (point-min)) -@end group -@end example - -@noindent -Likewise, to move to the end of the buffer, use: - -@example -@group -(goto-char (point-max)) -@end group -@end example - - Here are two commands that users use to do these things. They are -documented here to warn you not to use them in Lisp programs, because -they set the mark and display messages in the echo area. - -@deffn Command beginning-of-buffer &optional n -This function moves point to the beginning of the buffer (or the limits -of the accessible portion, when narrowing is in effect), setting the -mark at the previous position. If @var{n} is non-@code{nil}, then it -puts point @var{n} tenths of the way from the beginning of the buffer. - -In an interactive call, @var{n} is the numeric prefix argument, -if provided; otherwise @var{n} defaults to @code{nil}. - -Don't use this function in Lisp programs! -@end deffn - -@deffn Command end-of-buffer &optional n -This function moves point to the end of the buffer (or the limits of -the accessible portion, when narrowing is in effect), setting the mark -at the previous position. If @var{n} is non-@code{nil}, then it puts -point @var{n} tenths of the way from the end of the buffer. - -In an interactive call, @var{n} is the numeric prefix argument, -if provided; otherwise @var{n} defaults to @code{nil}. - -Don't use this function in Lisp programs! -@end deffn - -@node Text Lines -@subsection Motion by Text Lines -@cindex lines - - Text lines are portions of the buffer delimited by newline characters, -which are regarded as part of the previous line. The first text line -begins at the beginning of the buffer, and the last text line ends at -the end of the buffer whether or not the last character is a newline. -The division of the buffer into text lines is not affected by the width -of the window, by line continuation in display, or by how tabs and -control characters are displayed. - -@deffn Command goto-line line -This function moves point to the front of the @var{line}th line, -counting from line 1 at beginning of the buffer. If @var{line} is less -than 1, it moves point to the beginning of the buffer. If @var{line} is -greater than the number of lines in the buffer, it moves point to the -end of the buffer---that is, the @emph{end of the last line} of the -buffer. This is the only case in which @code{goto-line} does not -necessarily move to the beginning of a line. - -If narrowing is in effect, then @var{line} still counts from the -beginning of the buffer, but point cannot go outside the accessible -portion. So @code{goto-line} moves point to the beginning or end of the -accessible portion, if the line number specifies an inaccessible -position. - -The return value of @code{goto-line} is the difference between -@var{line} and the line number of the line to which point actually was -able to move (in the full buffer, before taking account of narrowing). -Thus, the value is positive if the scan encounters the real end of the -buffer. The value is zero if scan encounters the end of the accessible -portion but not the real end of the buffer. - -In an interactive call, @var{line} is the numeric prefix argument if -one has been provided. Otherwise @var{line} is read in the minibuffer. -@end deffn - -@deffn Command beginning-of-line &optional count buffer -This function moves point to the beginning of the current line. With an -argument @var{count} not @code{nil} or 1, it moves forward -@var{count}@minus{}1 lines and then to the beginning of the line. -@var{buffer} defaults to the current buffer if omitted. - -If this function reaches the end of the buffer (or of the accessible -portion, if narrowing is in effect), it positions point there. No error -is signaled. -@end deffn - -@deffn Command end-of-line &optional count buffer -This function moves point to the end of the current line. With an -argument @var{count} not @code{nil} or 1, it moves forward -@var{count}@minus{}1 lines and then to the end of the line. -@var{buffer} defaults to the current buffer if omitted. - -If this function reaches the end of the buffer (or of the accessible -portion, if narrowing is in effect), it positions point there. No error -is signaled. -@end deffn - -@deffn Command forward-line &optional count buffer -@cindex beginning of line -This function moves point forward @var{count} lines, to the beginning of -the line. If @var{count} is negative, it moves point -@minus{}@var{count} lines backward, to the beginning of a line. If -@var{count} is zero, it moves point to the beginning of the current -line. @var{buffer} defaults to the current buffer if omitted. - -If @code{forward-line} encounters the beginning or end of the buffer (or -of the accessible portion) before finding that many lines, it sets point -there. No error is signaled. - -@code{forward-line} returns the difference between @var{count} and the -number of lines actually moved. If you attempt to move down five lines -from the beginning of a buffer that has only three lines, point stops at -the end of the last line, and the value will be 2. - -In an interactive call, @var{count} is the numeric prefix argument. -@end deffn - -@defun count-lines start end -@cindex lines in region -This function returns the number of lines between the positions -@var{start} and @var{end} in the current buffer. If @var{start} and -@var{end} are equal, then it returns 0. Otherwise it returns at least -1, even if @var{start} and @var{end} are on the same line. This is -because the text between them, considered in isolation, must contain at -least one line unless it is empty. - -Here is an example of using @code{count-lines}: - -@example -@group -(defun current-line () - "Return the vertical position of point@dots{}" - (+ (count-lines (window-start) (point)) - (if (= (current-column) 0) 1 0) - -1)) -@end group -@end example -@end defun - -@ignore -@c ================ -The @code{previous-line} and @code{next-line} commands are functions -that should not be used in programs. They are for users and are -mentioned here only for completeness. - -@deffn Command previous-line count -@cindex goal column -This function moves point up @var{count} lines (down if @var{count} -is negative). In moving, it attempts to keep point in the ``goal column'' -(normally the same column that it was at the beginning of the move). - -If there is no character in the target line exactly under the current -column, point is positioned after the character in that line which -spans this column, or at the end of the line if it is not long enough. - -If it attempts to move beyond the top or bottom of the buffer (or clipped -region), then point is positioned in the goal column in the top or -bottom line. No error is signaled. - -In an interactive call, @var{count} will be the numeric -prefix argument. - -The command @code{set-goal-column} can be used to create a semipermanent -goal column to which this command always moves. Then it does not try to -move vertically. - -If you are thinking of using this in a Lisp program, consider using -@code{forward-line} with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.). -@end deffn - -@deffn Command next-line count -This function moves point down @var{count} lines (up if @var{count} -is negative). In moving, it attempts to keep point in the ``goal column'' -(normally the same column that it was at the beginning of the move). - -If there is no character in the target line exactly under the current -column, point is positioned after the character in that line which -spans this column, or at the end of the line if it is not long enough. - -If it attempts to move beyond the top or bottom of the buffer (or clipped -region), then point is positioned in the goal column in the top or -bottom line. No error is signaled. - -In the case where the @var{count} is 1, and point is on the last -line of the buffer (or clipped region), a new empty line is inserted at the -end of the buffer (or clipped region) and point moved there. - -In an interactive call, @var{count} will be the numeric -prefix argument. - -The command @code{set-goal-column} can be used to create a semipermanent -goal column to which this command always moves. Then it does not try to -move vertically. - -If you are thinking of using this in a Lisp program, consider using -@code{forward-line} instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.). -@end deffn - -@c ================ -@end ignore - - Also see the functions @code{bolp} and @code{eolp} in @ref{Near Point}. -These functions do not move point, but test whether it is already at the -beginning or end of a line. - -@node Screen Lines -@subsection Motion by Screen Lines - - The line functions in the previous section count text lines, delimited -only by newline characters. By contrast, these functions count screen -lines, which are defined by the way the text appears on the screen. A -text line is a single screen line if it is short enough to fit the width -of the selected window, but otherwise it may occupy several screen -lines. - - In some cases, text lines are truncated on the screen rather than -continued onto additional screen lines. In these cases, -@code{vertical-motion} moves point much like @code{forward-line}. -@xref{Truncation}. - - Because the width of a given string depends on the flags that control -the appearance of certain characters, @code{vertical-motion} behaves -differently, for a given piece of text, depending on the buffer it is -in, and even on the selected window (because the width, the truncation -flag, and display table may vary between windows). @xref{Usual -Display}. - - These functions scan text to determine where screen lines break, and -thus take time proportional to the distance scanned. If you intend to -use them heavily, Emacs provides caches which may improve the -performance of your code. @xref{Text Lines, cache-long-line-scans}. - - -@defun vertical-motion count &optional window pixels -This function moves point to the start of the frame line @var{count} -frame lines down from the frame line containing point. If @var{count} -is negative, it moves up instead. The optional second argument -@var{window} may be used to specify a window other than the -selected window in which to perform the motion. - -Normally, @code{vertical-motion} returns the number of lines moved. The -value may be less in absolute value than @var{count} if the beginning or -end of the buffer was reached. If the optional third argument, -@var{pixels} is non-@code{nil}, the vertical pixel height of the motion -which took place is returned instead of the actual number of lines -moved. A motion of zero lines returns the height of the current line. - -Note that @code{vertical-motion} sets @var{window}'s buffer's point, not -@var{window}'s point. (This differs from FSF Emacs, which buggily always -sets current buffer's point, regardless of @var{window}.) -@end defun - -@defun vertical-motion-pixels count &optional window how -This function moves point to the start of the frame line @var{pixels} -vertical pixels down from the frame line containing point, or up if -@var{pixels} is negative. The optional second argument @var{window} is -the window to move in, and defaults to the selected window. The -optional third argument @var{how} specifies the stopping condition. A -negative integer indicates that the motion should be no more -than @var{pixels}. A positive value indicates that the -motion should be at least @var{pixels}. Any other value indicates -that the motion should be as close as possible to @var{pixels}. -@end defun - -@deffn Command move-to-window-line count &optional window -This function moves point with respect to the text currently displayed -in @var{window}, which defaults to the selected window. It moves point -to the beginning of the screen line @var{count} screen lines from the -top of the window. If @var{count} is negative, that specifies a -position @w{@minus{}@var{count}} lines from the bottom (or the last line -of the buffer, if the buffer ends above the specified screen position). - -If @var{count} is @code{nil}, then point moves to the beginning of the -line in the middle of the window. If the absolute value of @var{count} -is greater than the size of the window, then point moves to the place -that would appear on that screen line if the window were tall enough. -This will probably cause the next redisplay to scroll to bring that -location onto the screen. - -In an interactive call, @var{count} is the numeric prefix argument. - -The value returned is the window line number point has moved to, with -the top line in the window numbered 0. -@end deffn - -@ignore Not in XEmacs -@defun compute-motion from frompos to topos width offsets window -This function scans the current buffer, calculating screen positions. -It scans the buffer forward from position @var{from}, assuming that is -at screen coordinates @var{frompos}, to position @var{to} or coordinates -@var{topos}, whichever comes first. It returns the ending buffer -position and screen coordinates. - -The coordinate arguments @var{frompos} and @var{topos} are cons cells of -the form @code{(@var{hpos} . @var{vpos})}. - -The argument @var{width} is the number of columns available to display -text; this affects handling of continuation lines. Use the value -returned by @code{window-width} for the window of your choice; -normally, use @code{(window-width @var{window})}. - -The argument @var{offsets} is either @code{nil} or a cons cell of the -form @code{(@var{hscroll} . @var{tab-offset})}. Here @var{hscroll} is -the number of columns not being displayed at the left margin; most -callers get this from @code{window-hscroll}. Meanwhile, -@var{tab-offset} is the offset between column numbers on the screen and -column numbers in the buffer. This can be nonzero in a continuation -line, when the previous screen lines' widths do not add up to a multiple -of @code{tab-width}. It is always zero in a non-continuation line. - -The window @var{window} serves only to specify which display table to -use. @code{compute-motion} always operates on the current buffer, -regardless of what buffer is displayed in @var{window}. - -The return value is a list of five elements: - -@example -(@var{pos} @var{vpos} @var{hpos} @var{prevhpos} @var{contin}) -@end example - -@noindent -Here @var{pos} is the buffer position where the scan stopped, @var{vpos} -is the vertical screen position, and @var{hpos} is the horizontal screen -position. - -The result @var{prevhpos} is the horizontal position one character back -from @var{pos}. The result @var{contin} is @code{t} if the last line -was continued after (or within) the previous character. - -For example, to find the buffer position of column @var{col} of line -@var{line} of a certain window, pass the window's display start location -as @var{from} and the window's upper-left coordinates as @var{frompos}. -Pass the buffer's @code{(point-max)} as @var{to}, to limit the scan to -the end of the accessible portion of the buffer, and pass @var{line} and -@var{col} as @var{topos}. Here's a function that does this: - -@example -(defun coordinates-of-position (col line) - (car (compute-motion (window-start) - '(0 . 0) - (point-max) - (cons col line) - (window-width) - (cons (window-hscroll) 0) - (selected-window)))) -@end example - -When you use @code{compute-motion} for the minibuffer, you need to use -@code{minibuffer-prompt-width} to get the horizontal position of the -beginning of the first screen line. @xref{Minibuffer Misc}. -@end defun -@end ignore - -@node List Motion -@subsection Moving over Balanced Expressions -@cindex sexp motion -@cindex Lisp expression motion -@cindex list motion - - Here are several functions concerned with balanced-parenthesis -expressions (also called @dfn{sexps} in connection with moving across -them in XEmacs). The syntax table controls how these functions interpret -various characters; see @ref{Syntax Tables}. @xref{Parsing -Expressions}, for lower-level primitives for scanning sexps or parts of -sexps. For user-level commands, see @ref{Lists and Sexps,,, emacs, XEmacs -Reference Manual}. - -@deffn Command forward-list &optional arg -This function moves forward across @var{arg} balanced groups of -parentheses. (Other syntactic entities such as words or paired string -quotes are ignored.) @var{arg} defaults to 1 if omitted. If @var{arg} -is negative, move backward across that many groups of parentheses. -@end deffn - -@deffn Command backward-list &optional arg -This function moves backward across @var{arg} balanced groups of -parentheses. (Other syntactic entities such as words or paired string -quotes are ignored.) @var{arg} defaults to 1 if omitted. If @var{arg} -is negative, move forward across that many groups of parentheses. -@end deffn - -@deffn Command up-list arg -This function moves forward out of @var{arg} levels of parentheses. -A negative argument means move backward but still to a less deep spot. -@end deffn - -@deffn Command down-list arg -This function moves forward into @var{arg} levels of parentheses. A -negative argument means move backward but still go -deeper in parentheses (@minus{}@var{arg} levels). -@end deffn - -@deffn Command forward-sexp &optional arg -This function moves forward across @var{arg} balanced expressions. -Balanced expressions include both those delimited by parentheses and -other kinds, such as words and string constants. @var{arg} defaults to -1 if omitted. If @var{arg} is negative, move backward across that many -balanced expressions. For example, - -@example -@group ----------- Buffer: foo ---------- -(concat@point{} "foo " (car x) y z) ----------- Buffer: foo ---------- -@end group - -@group -(forward-sexp 3) - @result{} nil - ----------- Buffer: foo ---------- -(concat "foo " (car x) y@point{} z) ----------- Buffer: foo ---------- -@end group -@end example -@end deffn - -@deffn Command backward-sexp &optional arg -This function moves backward across @var{arg} balanced expressions. -@var{arg} defaults to 1 if omitted. If @var{arg} is negative, move -forward across that many balanced expressions. -@end deffn - -@deffn Command beginning-of-defun &optional arg -This function moves back to the @var{arg}th beginning of a defun. If -@var{arg} is negative, this actually moves forward, but it still moves -to the beginning of a defun, not to the end of one. @var{arg} defaults -to 1 if omitted. -@end deffn - -@deffn Command end-of-defun &optional arg -This function moves forward to the @var{arg}th end of a defun. If -@var{arg} is negative, this actually moves backward, but it still moves -to the end of a defun, not to the beginning of one. @var{arg} defaults -to 1 if omitted. -@end deffn - -@defopt defun-prompt-regexp -If non-@code{nil}, this variable holds a regular expression that -specifies what text can appear before the open-parenthesis that starts a -defun. That is to say, a defun begins on a line that starts with a -match for this regular expression, followed by a character with -open-parenthesis syntax. -@end defopt - -@node Skipping Characters -@subsection Skipping Characters -@cindex skipping characters - - The following two functions move point over a specified set of -characters. For example, they are often used to skip whitespace. For -related functions, see @ref{Motion and Syntax}. - -@defun skip-chars-forward character-set &optional limit buffer -This function moves point in @var{buffer} forward, skipping over a -given set of characters. It examines the character following point, -then advances point if the character matches @var{character-set}. This -continues until it reaches a character that does not match. The -function returns @code{nil}. @var{buffer} defaults to the current -buffer if omitted. - -The argument @var{character-set} is like the inside of a -@samp{[@dots{}]} in a regular expression except that @samp{]} is never -special and @samp{\} quotes @samp{^}, @samp{-} or @samp{\}. Thus, -@code{"a-zA-Z"} skips over all letters, stopping before the first -non-letter, and @code{"^a-zA-Z}" skips non-letters stopping before the -first letter. @xref{Regular Expressions}. - -If @var{limit} is supplied (it must be a number or a marker), it -specifies the maximum position in the buffer that point can be skipped -to. Point will stop at or before @var{limit}. - -In the following example, point is initially located directly before the -@samp{T}. After the form is evaluated, point is located at the end of -that line (between the @samp{t} of @samp{hat} and the newline). The -function skips all letters and spaces, but not newlines. - -@example -@group ----------- Buffer: foo ---------- -I read "@point{}The cat in the hat -comes back" twice. ----------- Buffer: foo ---------- -@end group - -@group -(skip-chars-forward "a-zA-Z ") - @result{} nil - ----------- Buffer: foo ---------- -I read "The cat in the hat@point{} -comes back" twice. ----------- Buffer: foo ---------- -@end group -@end example -@end defun - -@defun skip-chars-backward character-set &optional limit buffer -This function moves point backward, skipping characters that match -@var{character-set}, until @var{limit}. It just like -@code{skip-chars-forward} except for the direction of motion. -@end defun - -@node Excursions -@section Excursions -@cindex excursion - - It is often useful to move point ``temporarily'' within a localized -portion of the program, or to switch buffers temporarily. This is -called an @dfn{excursion}, and it is done with the @code{save-excursion} -special form. This construct saves the current buffer and its values of -point and the mark so they can be restored after the completion of the -excursion. - - The forms for saving and restoring the configuration of windows are -described elsewhere (see @ref{Window Configurations} and @pxref{Frame -Configurations}). - -@defspec save-excursion forms@dots{} -@cindex mark excursion -@cindex point excursion -@cindex current buffer excursion -The @code{save-excursion} special form saves the identity of the current -buffer and the values of point and the mark in it, evaluates -@var{forms}, and finally restores the buffer and its saved values of -point and the mark. All three saved values are restored even in case of -an abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}). - -The @code{save-excursion} special form is the standard way to switch -buffers or move point within one part of a program and avoid affecting -the rest of the program. It is used more than 500 times in the Lisp -sources of XEmacs. - -@code{save-excursion} does not save the values of point and the mark for -other buffers, so changes in other buffers remain in effect after -@code{save-excursion} exits. - -@cindex window excursions -Likewise, @code{save-excursion} does not restore window-buffer -correspondences altered by functions such as @code{switch-to-buffer}. -One way to restore these correspondences, and the selected window, is to -use @code{save-window-excursion} inside @code{save-excursion} -(@pxref{Window Configurations}). - -The value returned by @code{save-excursion} is the result of the last of -@var{forms}, or @code{nil} if no @var{forms} are given. - -@example -@group -(save-excursion - @var{forms}) -@equiv{} -(let ((old-buf (current-buffer)) - (old-pnt (point-marker)) - (old-mark (copy-marker (mark-marker)))) - (unwind-protect - (progn @var{forms}) - (set-buffer old-buf) - (goto-char old-pnt) - (set-marker (mark-marker) old-mark))) -@end group -@end example -@end defspec - -@defspec save-current-buffer forms@dots{} -This special form is similar to @code{save-excursion} but it only -saves and restores the current buffer. Beginning with XEmacs 20.3, -@code{save-current-buffer} is a primitive. -@end defspec - -@defspec with-current-buffer buffer forms@dots{} -This special form evaluates @var{forms} with @var{buffer} as the current -buffer. It returns the value of the last form. -@end defspec - -@defspec with-temp-file file forms@dots{} -This special form creates a new buffer, evaluates @var{forms} there, and -writes the buffer to @var{file}. It returns the value of the last form -evaluated. -@end defspec - -@defspec save-selected-window forms@dots{} -This special form is similar to @code{save-excursion} but it saves and -restores the selected window and nothing else. -@end defspec - -@node Narrowing -@section Narrowing -@cindex narrowing -@cindex restriction (in a buffer) -@cindex accessible portion (of a buffer) - - @dfn{Narrowing} means limiting the text addressable by XEmacs editing -commands to a limited range of characters in a buffer. The text that -remains addressable is called the @dfn{accessible portion} of the -buffer. - - Narrowing is specified with two buffer positions which become the -beginning and end of the accessible portion. For most editing commands -and most Emacs primitives, these positions replace the values of the -beginning and end of the buffer. While narrowing is in effect, no text -outside the accessible portion is displayed, and point cannot move -outside the accessible portion. - - Values such as positions or line numbers, which usually count from the -beginning of the buffer, do so despite narrowing, but the functions -which use them refuse to operate on text that is inaccessible. - - The commands for saving buffers are unaffected by narrowing; they save -the entire buffer regardless of any narrowing. - -@deffn Command narrow-to-region start end &optional buffer -This function sets the accessible portion of @var{buffer} to start at -@var{start} and end at @var{end}. Both arguments should be character -positions. @var{buffer} defaults to the current buffer if omitted. - -In an interactive call, @var{start} and @var{end} are set to the bounds -of the current region (point and the mark, with the smallest first). -@end deffn - -@deffn Command narrow-to-page &optional move-count -This function sets the accessible portion of the current buffer to -include just the current page. An optional first argument -@var{move-count} non-@code{nil} means to move forward or backward by -@var{move-count} pages and then narrow. The variable -@code{page-delimiter} specifies where pages start and end -(@pxref{Standard Regexps}). - -In an interactive call, @var{move-count} is set to the numeric prefix -argument. -@end deffn - -@deffn Command widen &optional buffer -@cindex widening -This function cancels any narrowing in @var{buffer}, so that the -entire contents are accessible. This is called @dfn{widening}. -It is equivalent to the following expression: - -@example -(narrow-to-region 1 (1+ (buffer-size))) -@end example - -@var{buffer} defaults to the current buffer if omitted. -@end deffn - -@defspec save-restriction body@dots{} -This special form saves the current bounds of the accessible portion, -evaluates the @var{body} forms, and finally restores the saved bounds, -thus restoring the same state of narrowing (or absence thereof) formerly -in effect. The state of narrowing is restored even in the event of an -abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}). -Therefore, this construct is a clean way to narrow a buffer temporarily. - -The value returned by @code{save-restriction} is that returned by the -last form in @var{body}, or @code{nil} if no body forms were given. - -@c Wordy to avoid overfull hbox. --rjc 16mar92 -@strong{Caution:} it is easy to make a mistake when using the -@code{save-restriction} construct. Read the entire description here -before you try it. - -If @var{body} changes the current buffer, @code{save-restriction} still -restores the restrictions on the original buffer (the buffer whose -restrictions it saved from), but it does not restore the identity of the -current buffer. - -@code{save-restriction} does @emph{not} restore point and the mark; use -@code{save-excursion} for that. If you use both @code{save-restriction} -and @code{save-excursion} together, @code{save-excursion} should come -first (on the outside). Otherwise, the old point value would be -restored with temporary narrowing still in effect. If the old point -value were outside the limits of the temporary narrowing, this would -fail to restore it accurately. - -The @code{save-restriction} special form records the values of the -beginning and end of the accessible portion as distances from the -beginning and end of the buffer. In other words, it records the amount -of inaccessible text before and after the accessible portion. - -This method yields correct results if @var{body} does further narrowing. -However, @code{save-restriction} can become confused if the body widens -and then make changes outside the range of the saved narrowing. When -this is what you want to do, @code{save-restriction} is not the right -tool for the job. Here is what you must use instead: - -@example -@group -(let ((beg (point-min-marker)) - (end (point-max-marker))) - (unwind-protect - (progn @var{body}) - (save-excursion - (set-buffer (marker-buffer beg)) - (narrow-to-region beg end)))) -@end group -@end example - -Here is a simple example of correct use of @code{save-restriction}: - -@example -@group ----------- Buffer: foo ---------- -This is the contents of foo -This is the contents of foo -This is the contents of foo@point{} ----------- Buffer: foo ---------- -@end group - -@group -(save-excursion - (save-restriction - (goto-char 1) - (forward-line 2) - (narrow-to-region 1 (point)) - (goto-char (point-min)) - (replace-string "foo" "bar"))) - ----------- Buffer: foo ---------- -This is the contents of bar -This is the contents of bar -This is the contents of foo@point{} ----------- Buffer: foo ---------- -@end group -@end example -@end defspec diff --git a/man/lispref/processes.texi b/man/lispref/processes.texi deleted file mode 100644 index fbc71b6..0000000 --- a/man/lispref/processes.texi +++ /dev/null @@ -1,1265 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/processes.info -@node Processes, System Interface, Databases, Top -@chapter Processes -@cindex child process -@cindex parent process -@cindex subprocess -@cindex process - - In the terminology of operating systems, a @dfn{process} is a space in -which a program can execute. XEmacs runs in a process. XEmacs Lisp -programs can invoke other programs in processes of their own. These are -called @dfn{subprocesses} or @dfn{child processes} of the XEmacs process, -which is their @dfn{parent process}. - - A subprocess of XEmacs may be @dfn{synchronous} or @dfn{asynchronous}, -depending on how it is created. When you create a synchronous -subprocess, the Lisp program waits for the subprocess to terminate -before continuing execution. When you create an asynchronous -subprocess, it can run in parallel with the Lisp program. This kind of -subprocess is represented within XEmacs by a Lisp object which is also -called a ``process''. Lisp programs can use this object to communicate -with the subprocess or to control it. For example, you can send -signals, obtain status information, receive output from the process, or -send input to it. - -@defun processp object -This function returns @code{t} if @var{object} is a process, -@code{nil} otherwise. -@end defun - -@menu -* Subprocess Creation:: Functions that start subprocesses. -* Synchronous Processes:: Details of using synchronous subprocesses. -* MS-DOS Subprocesses:: On MS-DOS, you must indicate text vs binary - for data sent to and from a subprocess. -* Asynchronous Processes:: Starting up an asynchronous subprocess. -* Deleting Processes:: Eliminating an asynchronous subprocess. -* Process Information:: Accessing run-status and other attributes. -* Input to Processes:: Sending input to an asynchronous subprocess. -* Signals to Processes:: Stopping, continuing or interrupting - an asynchronous subprocess. -* Output from Processes:: Collecting output from an asynchronous subprocess. -* Sentinels:: Sentinels run when process run-status changes. -* Process Window Size:: Changing the logical window size of a process. -* Transaction Queues:: Transaction-based communication with subprocesses. -* Network:: Opening network connections. -@end menu - -@node Subprocess Creation -@section Functions that Create Subprocesses - - There are three functions that create a new subprocess in which to run -a program. One of them, @code{start-process}, creates an asynchronous -process and returns a process object (@pxref{Asynchronous Processes}). -The other two, @code{call-process} and @code{call-process-region}, -create a synchronous process and do not return a process object -(@pxref{Synchronous Processes}). - - Synchronous and asynchronous processes are explained in following -sections. Since the three functions are all called in a similar -fashion, their common arguments are described here. - -@cindex execute program -@cindex @code{PATH} environment variable -@cindex @code{HOME} environment variable - In all cases, the function's @var{program} argument specifies the -program to be run. An error is signaled if the file is not found or -cannot be executed. If the file name is relative, the variable -@code{exec-path} contains a list of directories to search. Emacs -initializes @code{exec-path} when it starts up, based on the value of -the environment variable @code{PATH}. The standard file name -constructs, @samp{~}, @samp{.}, and @samp{..}, are interpreted as usual -in @code{exec-path}, but environment variable substitutions -(@samp{$HOME}, etc.) are not recognized; use -@code{substitute-in-file-name} to perform them (@pxref{File Name -Expansion}). - - Each of the subprocess-creating functions has a @var{buffer-or-name} -argument which specifies where the standard output from the program will -go. If @var{buffer-or-name} is @code{nil}, that says to discard the -output unless a filter function handles it. (@xref{Filter Functions}, -and @ref{Read and Print}.) Normally, you should avoid having multiple -processes send output to the same buffer because their output would be -intermixed randomly. - -@cindex program arguments - All three of the subprocess-creating functions have a @code{&rest} -argument, @var{args}. The @var{args} must all be strings, and they are -supplied to @var{program} as separate command line arguments. Wildcard -characters and other shell constructs are not allowed in these strings, -since they are passed directly to the specified program. - - @strong{Please note:} The argument @var{program} contains only the -name of the program; it may not contain any command-line arguments. You -must use @var{args} to provide those. - - The subprocess gets its current directory from the value of -@code{default-directory} (@pxref{File Name Expansion}). - -@cindex environment variables, subprocesses - The subprocess inherits its environment from XEmacs; but you can -specify overrides for it with @code{process-environment}. @xref{System -Environment}. - -@defvar exec-directory -@pindex wakeup -The value of this variable is the name of a directory (a string) that -contains programs that come with XEmacs, that are intended for XEmacs -to invoke. The program @code{wakeup} is an example of such a program; -the @code{display-time} command uses it to get a reminder once per -minute. -@end defvar - -@defopt exec-path -The value of this variable is a list of directories to search for -programs to run in subprocesses. Each element is either the name of a -directory (i.e., a string), or @code{nil}, which stands for the default -directory (which is the value of @code{default-directory}). -@cindex program directories - -The value of @code{exec-path} is used by @code{call-process} and -@code{start-process} when the @var{program} argument is not an absolute -file name. -@end defopt - -@node Synchronous Processes -@section Creating a Synchronous Process -@cindex synchronous subprocess - - After a @dfn{synchronous process} is created, XEmacs waits for the -process to terminate before continuing. Starting Dired is an example of -this: it runs @code{ls} in a synchronous process, then modifies the -output slightly. Because the process is synchronous, the entire -directory listing arrives in the buffer before XEmacs tries to do -anything with it. - - While Emacs waits for the synchronous subprocess to terminate, the -user can quit by typing @kbd{C-g}. The first @kbd{C-g} tries to kill -the subprocess with a @code{SIGINT} signal; but it waits until the -subprocess actually terminates before quitting. If during that time the -user types another @kbd{C-g}, that kills the subprocess instantly with -@code{SIGKILL} and quits immediately. @xref{Quitting}. - - The synchronous subprocess functions returned @code{nil} in version -18. In version 19, they return an indication of how the process -terminated. - -@defun call-process program &optional infile destination display &rest args -This function calls @var{program} in a separate process and waits for -it to finish. - -The standard input for the process comes from file @var{infile} if -@var{infile} is not @code{nil} and from @file{/dev/null} otherwise. -The argument @var{destination} says where to put the process output. -Here are the possibilities: - -@table @asis -@item a buffer -Insert the output in that buffer, before point. This includes both the -standard output stream and the standard error stream of the process. - -@item a string -Find or create a buffer with that name, then insert -the output in that buffer, before point. - -@item @code{t} -Insert the output in the current buffer, before point. - -@item @code{nil} -Discard the output. - -@item 0 -Discard the output, and return immediately without waiting -for the subprocess to finish. - -In this case, the process is not truly synchronous, since it can run in -parallel with Emacs; but you can think of it as synchronous in that -Emacs is essentially finished with the subprocess as soon as this -function returns. - -@item (@var{real-destination} @var{error-destination}) -Keep the standard output stream separate from the standard error stream; -deal with the ordinary output as specified by @var{real-destination}, -and dispose of the error output according to @var{error-destination}. -The value @code{nil} means discard it, @code{t} means mix it with the -ordinary output, and a string specifies a file name to redirect error -output into. - -You can't directly specify a buffer to put the error output in; that is -too difficult to implement. But you can achieve this result by sending -the error output to a temporary file and then inserting the file into a -buffer. -@end table - -If @var{display} is non-@code{nil}, then @code{call-process} redisplays -the buffer as output is inserted. Otherwise the function does no -redisplay, and the results become visible on the screen only when XEmacs -redisplays that buffer in the normal course of events. - -The remaining arguments, @var{args}, are strings that specify command -line arguments for the program. - -The value returned by @code{call-process} (unless you told it not to -wait) indicates the reason for process termination. A number gives the -exit status of the subprocess; 0 means success, and any other value -means failure. If the process terminated with a signal, -@code{call-process} returns a string describing the signal. - -In the examples below, the buffer @samp{foo} is current. - -@smallexample -@group -(call-process "pwd" nil t) - @result{} nil - ----------- Buffer: foo ---------- -/usr/user/lewis/manual ----------- Buffer: foo ---------- -@end group - -@group -(call-process "grep" nil "bar" nil "lewis" "/etc/passwd") - @result{} nil - ----------- Buffer: bar ---------- -lewis:5LTsHm66CSWKg:398:21:Bil Lewis:/user/lewis:/bin/csh - ----------- Buffer: bar ---------- -@end group -@end smallexample - -The @code{insert-directory} function contains a good example of the use -of @code{call-process}: - -@smallexample -@group -(call-process insert-directory-program nil t nil switches - (if full-directory-p - (concat (file-name-as-directory file) ".") - file)) -@end group -@end smallexample -@end defun - -@defun call-process-region start end program &optional delete destination display &rest args -This function sends the text between @var{start} to @var{end} as -standard input to a process running @var{program}. It deletes the text -sent if @var{delete} is non-@code{nil}; this is useful when @var{buffer} -is @code{t}, to insert the output in the current buffer. - -The arguments @var{destination} and @var{display} control what to do -with the output from the subprocess, and whether to update the display -as it comes in. For details, see the description of -@code{call-process}, above. If @var{destination} is the integer 0, -@code{call-process-region} discards the output and returns @code{nil} -immediately, without waiting for the subprocess to finish. - -The remaining arguments, @var{args}, are strings that specify command -line arguments for the program. - -The return value of @code{call-process-region} is just like that of -@code{call-process}: @code{nil} if you told it to return without -waiting; otherwise, a number or string which indicates how the -subprocess terminated. - -In the following example, we use @code{call-process-region} to run the -@code{cat} utility, with standard input being the first five characters -in buffer @samp{foo} (the word @samp{input}). @code{cat} copies its -standard input into its standard output. Since the argument -@var{destination} is @code{t}, this output is inserted in the current -buffer. - -@smallexample -@group ----------- Buffer: foo ---------- -input@point{} ----------- Buffer: foo ---------- -@end group - -@group -(call-process-region 1 6 "cat" nil t) - @result{} nil - ----------- Buffer: foo ---------- -inputinput@point{} ----------- Buffer: foo ---------- -@end group -@end smallexample - - The @code{shell-command-on-region} command uses -@code{call-process-region} like this: - -@smallexample -@group -(call-process-region - start end - shell-file-name ; @r{Name of program.} - nil ; @r{Do not delete region.} - buffer ; @r{Send output to @code{buffer}.} - nil ; @r{No redisplay during output.} - "-c" command) ; @r{Arguments for the shell.} -@end group -@end smallexample -@end defun - -@node MS-DOS Subprocesses -@section MS-DOS Subprocesses - - On MS-DOS, you must indicate whether the data going to and from -a synchronous subprocess are text or binary. Text data requires -translation between the end-of-line convention used within Emacs -(a single newline character) and the convention used outside Emacs -(the two-character sequence, @sc{crlf}). - - The variable @code{binary-process-input} applies to input sent to the -subprocess, and @code{binary-process-output} applies to output received -from it. A non-@code{nil} value means the data is non-text; @code{nil} -means the data is text, and calls for conversion. - -@defvar binary-process-input -If this variable is @code{nil}, convert newlines to @sc{crlf} sequences in -the input to a synchronous subprocess. -@end defvar - -@defvar binary-process-output -If this variable is @code{nil}, convert @sc{crlf} sequences to newlines in -the output from a synchronous subprocess. -@end defvar - - @xref{Files and MS-DOS}, for related information. - -@node Asynchronous Processes -@section Creating an Asynchronous Process -@cindex asynchronous subprocess - - After an @dfn{asynchronous process} is created, Emacs and the Lisp -program both continue running immediately. The process may thereafter -run in parallel with Emacs, and the two may communicate with each other -using the functions described in following sections. Here we describe -how to create an asynchronous process with @code{start-process}. - -@defun start-process name buffer-or-name program &rest args -This function creates a new asynchronous subprocess and starts the -program @var{program} running in it. It returns a process object that -stands for the new subprocess in Lisp. The argument @var{name} -specifies the name for the process object; if a process with this name -already exists, then @var{name} is modified (by adding @samp{<1>}, etc.) -to be unique. The buffer @var{buffer-or-name} is the buffer to -associate with the process. - -The remaining arguments, @var{args}, are strings that specify command -line arguments for the program. - -In the example below, the first process is started and runs (rather, -sleeps) for 100 seconds. Meanwhile, the second process is started, and -given the name @samp{my-process<1>} for the sake of uniqueness. It -inserts the directory listing at the end of the buffer @samp{foo}, -before the first process finishes. Then it finishes, and a message to -that effect is inserted in the buffer. Much later, the first process -finishes, and another message is inserted in the buffer for it. - -@smallexample -@group -(start-process "my-process" "foo" "sleep" "100") - @result{} # -@end group - -@group -(start-process "my-process" "foo" "ls" "-l" "/user/lewis/bin") - @result{} #> - ----------- Buffer: foo ---------- -total 2 -lrwxrwxrwx 1 lewis 14 Jul 22 10:12 gnuemacs --> /emacs --rwxrwxrwx 1 lewis 19 Jul 30 21:02 lemon - -Process my-process<1> finished - -Process my-process finished ----------- Buffer: foo ---------- -@end group -@end smallexample -@end defun - -@defun start-process-shell-command name buffer-or-name command &rest command-args -This function is like @code{start-process} except that it uses a shell -to execute the specified command. The argument @var{command} is a shell -command name, and @var{command-args} are the arguments for the shell -command. -@end defun - -@defvar process-connection-type -@cindex pipes -@cindex @sc{pty}s -This variable controls the type of device used to communicate with -asynchronous subprocesses. If it is non-@code{nil}, then @sc{pty}s are -used, when available. Otherwise, pipes are used. - -@sc{pty}s are usually preferable for processes visible to the user, as -in Shell mode, because they allow job control (@kbd{C-c}, @kbd{C-z}, -etc.) to work between the process and its children whereas pipes do not. -For subprocesses used for internal purposes by programs, it is often -better to use a pipe, because they are more efficient. In addition, the -total number of @sc{pty}s is limited on many systems and it is good not -to waste them. - -The value @code{process-connection-type} is used when -@code{start-process} is called. So you can specify how to communicate -with one subprocess by binding the variable around the call to -@code{start-process}. - -@smallexample -@group -(let ((process-connection-type nil)) ; @r{Use a pipe.} - (start-process @dots{})) -@end group -@end smallexample - -To determine whether a given subprocess actually got a pipe or a -@sc{pty}, use the function @code{process-tty-name} (@pxref{Process -Information}). -@end defvar - -@node Deleting Processes -@section Deleting Processes -@cindex deleting processes - - @dfn{Deleting a process} disconnects XEmacs immediately from the -subprocess, and removes it from the list of active processes. It sends -a signal to the subprocess to make the subprocess terminate, but this is -not guaranteed to happen immediately. The process object itself -continues to exist as long as other Lisp objects point to it. - - You can delete a process explicitly at any time. Processes are -deleted automatically after they terminate, but not necessarily right -away. If you delete a terminated process explicitly before it is -deleted automatically, no harm results. - -@defvar delete-exited-processes -This variable controls automatic deletion of processes that have -terminated (due to calling @code{exit} or to a signal). If it is -@code{nil}, then they continue to exist until the user runs -@code{list-processes}. Otherwise, they are deleted immediately after -they exit. -@end defvar - -@defun delete-process name -This function deletes the process associated with @var{name}, killing it -with a @code{SIGHUP} signal. The argument @var{name} may be a process, -the name of a process, a buffer, or the name of a buffer. - -@smallexample -@group -(delete-process "*shell*") - @result{} nil -@end group -@end smallexample -@end defun - -@defun process-kill-without-query process &optional require-query-p -This function declares that XEmacs need not query the user if -@var{process} is still running when XEmacs is exited. The process will -be deleted silently. If @var{require-query-p} is non-@code{nil}, -then XEmacs @emph{will} query the user (this is the default). The -return value is @code{t} if a query was formerly required, and -@code{nil} otherwise. - -@smallexample -@group -(process-kill-without-query (get-process "shell")) - @result{} t -@end group -@end smallexample -@end defun - -@node Process Information -@section Process Information - - Several functions return information about processes. -@code{list-processes} is provided for interactive use. - -@deffn Command list-processes -This command displays a listing of all living processes. In addition, -it finally deletes any process whose status was @samp{Exited} or -@samp{Signaled}. It returns @code{nil}. -@end deffn - -@defun process-list -This function returns a list of all processes that have not been deleted. - -@smallexample -@group -(process-list) - @result{} (# #) -@end group -@end smallexample -@end defun - -@defun get-process name -This function returns the process named @var{name}, or @code{nil} if -there is none. An error is signaled if @var{name} is not a string. - -@smallexample -@group -(get-process "shell") - @result{} # -@end group -@end smallexample -@end defun - -@defun process-command process -This function returns the command that was executed to start -@var{process}. This is a list of strings, the first string being the -program executed and the rest of the strings being the arguments that -were given to the program. - -@smallexample -@group -(process-command (get-process "shell")) - @result{} ("/bin/csh" "-i") -@end group -@end smallexample -@end defun - -@defun process-id process -This function returns the @sc{pid} of @var{process}. This is an -integer that distinguishes the process @var{process} from all other -processes running on the same computer at the current time. The -@sc{pid} of a process is chosen by the operating system kernel when the -process is started and remains constant as long as the process exists. -@end defun - -@defun process-name process -This function returns the name of @var{process}. -@end defun - -@defun process-status process-name -This function returns the status of @var{process-name} as a symbol. -The argument @var{process-name} must be a process, a buffer, a -process name (string) or a buffer name (string). - -The possible values for an actual subprocess are: - -@table @code -@item run -for a process that is running. -@item stop -for a process that is stopped but continuable. -@item exit -for a process that has exited. -@item signal -for a process that has received a fatal signal. -@item open -for a network connection that is open. -@item closed -for a network connection that is closed. Once a connection -is closed, you cannot reopen it, though you might be able to open -a new connection to the same place. -@item nil -if @var{process-name} is not the name of an existing process. -@end table - -@smallexample -@group -(process-status "shell") - @result{} run -@end group -@group -(process-status (get-buffer "*shell*")) - @result{} run -@end group -@group -x - @result{} #> -(process-status x) - @result{} exit -@end group -@end smallexample - -For a network connection, @code{process-status} returns one of the symbols -@code{open} or @code{closed}. The latter means that the other side -closed the connection, or XEmacs did @code{delete-process}. - -In earlier Emacs versions (prior to version 19), the status of a network -connection was @code{run} if open, and @code{exit} if closed. -@end defun - -@defun process-kill-without-query-p process - This function returns whether @var{process} will be killed without -querying the user, if it is running when XEmacs is exited. The default -value is @code{nil}. -@end defun - -@defun process-exit-status process -This function returns the exit status of @var{process} or the signal -number that killed it. (Use the result of @code{process-status} to -determine which of those it is.) If @var{process} has not yet -terminated, the value is 0. -@end defun - -@defun process-tty-name process -This function returns the terminal name that @var{process} is using for -its communication with Emacs---or @code{nil} if it is using pipes -instead of a terminal (see @code{process-connection-type} in -@ref{Asynchronous Processes}). -@end defun - -@node Input to Processes -@section Sending Input to Processes -@cindex process input - - Asynchronous subprocesses receive input when it is sent to them by -XEmacs, which is done with the functions in this section. You must -specify the process to send input to, and the input data to send. The -data appears on the ``standard input'' of the subprocess. - - Some operating systems have limited space for buffered input in a -@sc{pty}. On these systems, Emacs sends an @sc{eof} periodically amidst -the other characters, to force them through. For most programs, -these @sc{eof}s do no harm. - -@defun process-send-string process-name string -This function sends @var{process-name} the contents of @var{string} as -standard input. The argument @var{process-name} must be a process or -the name of a process. If it is @code{nil}, the current buffer's -process is used. - - The function returns @code{nil}. - -@smallexample -@group -(process-send-string "shell<1>" "ls\n") - @result{} nil -@end group - - -@group ----------- Buffer: *shell* ---------- -... -introduction.texi syntax-tables.texi~ -introduction.texi~ text.texi -introduction.txt text.texi~ -... ----------- Buffer: *shell* ---------- -@end group -@end smallexample -@end defun - -@deffn Command process-send-region process-name start end -This function sends the text in the region defined by @var{start} and -@var{end} as standard input to @var{process-name}, which is a process or -a process name. (If it is @code{nil}, the current buffer's process is -used.) - -An error is signaled unless both @var{start} and @var{end} are -integers or markers that indicate positions in the current buffer. (It -is unimportant which number is larger.) -@end deffn - -@defun process-send-eof &optional process-name - This function makes @var{process-name} see an end-of-file in its -input. The @sc{eof} comes after any text already sent to it. - - If @var{process-name} is not supplied, or if it is @code{nil}, then -this function sends the @sc{eof} to the current buffer's process. An -error is signaled if the current buffer has no process. - - The function returns @var{process-name}. - -@smallexample -@group -(process-send-eof "shell") - @result{} "shell" -@end group -@end smallexample -@end defun - -@node Signals to Processes -@section Sending Signals to Processes -@cindex process signals -@cindex sending signals -@cindex signals - - @dfn{Sending a signal} to a subprocess is a way of interrupting its -activities. There are several different signals, each with its own -meaning. The set of signals and their names is defined by the operating -system. For example, the signal @code{SIGINT} means that the user has -typed @kbd{C-c}, or that some analogous thing has happened. - - Each signal has a standard effect on the subprocess. Most signals -kill the subprocess, but some stop or resume execution instead. Most -signals can optionally be handled by programs; if the program handles -the signal, then we can say nothing in general about its effects. - - The set of signals and their names is defined by the operating system; -XEmacs has facilities for sending only a few of the signals that are -defined. XEmacs can send signals only to its own subprocesses. - - You can send signals explicitly by calling the functions in this -section. XEmacs also sends signals automatically at certain times: -killing a buffer sends a @code{SIGHUP} signal to all its associated -processes; killing XEmacs sends a @code{SIGHUP} signal to all remaining -processes. (@code{SIGHUP} is a signal that usually indicates that the -user hung up the phone.) - - Each of the signal-sending functions takes two optional arguments: -@var{process-name} and @var{current-group}. - - The argument @var{process-name} must be either a process, the name of -one, or @code{nil}. If it is @code{nil}, the process defaults to the -process associated with the current buffer. An error is signaled if -@var{process-name} does not identify a process. - - The argument @var{current-group} is a flag that makes a difference -when you are running a job-control shell as an XEmacs subprocess. If it -is non-@code{nil}, then the signal is sent to the current process-group -of the terminal that XEmacs uses to communicate with the subprocess. If -the process is a job-control shell, this means the shell's current -subjob. If it is @code{nil}, the signal is sent to the process group of -the immediate subprocess of XEmacs. If the subprocess is a job-control -shell, this is the shell itself. - - The flag @var{current-group} has no effect when a pipe is used to -communicate with the subprocess, because the operating system does not -support the distinction in the case of pipes. For the same reason, -job-control shells won't work when a pipe is used. See -@code{process-connection-type} in @ref{Asynchronous Processes}. - -@defun interrupt-process &optional process-name current-group -This function interrupts the process @var{process-name} by sending the -signal @code{SIGINT}. Outside of XEmacs, typing the ``interrupt -character'' (normally @kbd{C-c} on some systems, and @code{DEL} on -others) sends this signal. When the argument @var{current-group} is -non-@code{nil}, you can think of this function as ``typing @kbd{C-c}'' -on the terminal by which XEmacs talks to the subprocess. -@end defun - -@defun kill-process &optional process-name current-group -This function kills the process @var{process-name} by sending the -signal @code{SIGKILL}. This signal kills the subprocess immediately, -and cannot be handled by the subprocess. -@end defun - -@defun quit-process &optional process-name current-group -This function sends the signal @code{SIGQUIT} to the process -@var{process-name}. This signal is the one sent by the ``quit -character'' (usually @kbd{C-b} or @kbd{C-\}) when you are not inside -XEmacs. -@end defun - -@defun stop-process &optional process-name current-group -This function stops the process @var{process-name} by sending the -signal @code{SIGTSTP}. Use @code{continue-process} to resume its -execution. - -On systems with job control, the ``stop character'' (usually @kbd{C-z}) -sends this signal (outside of XEmacs). When @var{current-group} is -non-@code{nil}, you can think of this function as ``typing @kbd{C-z}'' -on the terminal XEmacs uses to communicate with the subprocess. -@end defun - -@defun continue-process &optional process-name current-group -This function resumes execution of the process @var{process} by sending -it the signal @code{SIGCONT}. This presumes that @var{process-name} was -stopped previously. -@end defun - -@c Emacs 19 feature -@defun signal-process pid signal -This function sends a signal to process @var{pid}, which need not be -a child of XEmacs. The argument @var{signal} specifies which signal -to send; it should be an integer. -@end defun - -@node Output from Processes -@section Receiving Output from Processes -@cindex process output -@cindex output from processes - - There are two ways to receive the output that a subprocess writes to -its standard output stream. The output can be inserted in a buffer, -which is called the associated buffer of the process, or a function -called the @dfn{filter function} can be called to act on the output. If -the process has no buffer and no filter function, its output is -discarded. - -@menu -* Process Buffers:: If no filter, output is put in a buffer. -* Filter Functions:: Filter functions accept output from the process. -* Accepting Output:: Explicitly permitting subprocess output. - Waiting for subprocess output. -@end menu - -@node Process Buffers -@subsection Process Buffers - - A process can (and usually does) have an @dfn{associated buffer}, -which is an ordinary Emacs buffer that is used for two purposes: storing -the output from the process, and deciding when to kill the process. You -can also use the buffer to identify a process to operate on, since in -normal practice only one process is associated with any given buffer. -Many applications of processes also use the buffer for editing input to -be sent to the process, but this is not built into XEmacs Lisp. - - Unless the process has a filter function (@pxref{Filter Functions}), -its output is inserted in the associated buffer. The position to insert -the output is determined by the @code{process-mark}, which is then -updated to point to the end of the text just inserted. Usually, but not -always, the @code{process-mark} is at the end of the buffer. - -@defun process-buffer process -This function returns the associated buffer of the process -@var{process}. - -@smallexample -@group -(process-buffer (get-process "shell")) - @result{} # -@end group -@end smallexample -@end defun - -@defun process-mark process -This function returns the process marker for @var{process}, which is the -marker that says where to insert output from the process. - -If @var{process} does not have a buffer, @code{process-mark} returns a -marker that points nowhere. - -Insertion of process output in a buffer uses this marker to decide where -to insert, and updates it to point after the inserted text. That is why -successive batches of output are inserted consecutively. - -Filter functions normally should use this marker in the same fashion -as is done by direct insertion of output in the buffer. A good -example of a filter function that uses @code{process-mark} is found at -the end of the following section. - -When the user is expected to enter input in the process buffer for -transmission to the process, the process marker is useful for -distinguishing the new input from previous output. -@end defun - -@defun set-process-buffer process buffer -This function sets the buffer associated with @var{process} to -@var{buffer}. If @var{buffer} is @code{nil}, the process becomes -associated with no buffer. -@end defun - -@defun get-buffer-process buffer-or-name -This function returns the process associated with @var{buffer-or-name}. -If there are several processes associated with it, then one is chosen. -(Presently, the one chosen is the one most recently created.) It is -usually a bad idea to have more than one process associated with the -same buffer. - -@smallexample -@group -(get-buffer-process "*shell*") - @result{} # -@end group -@end smallexample - -Killing the process's buffer deletes the process, which kills the -subprocess with a @code{SIGHUP} signal (@pxref{Signals to Processes}). -@end defun - -@node Filter Functions -@subsection Process Filter Functions -@cindex filter function -@cindex process filter - - A process @dfn{filter function} is a function that receives the -standard output from the associated process. If a process has a filter, -then @emph{all} output from that process is passed to the filter. The -process buffer is used directly for output from the process only when -there is no filter. - - A filter function must accept two arguments: the associated process and -a string, which is the output. The function is then free to do whatever it -chooses with the output. - - A filter function runs only while XEmacs is waiting (e.g., for terminal -input, or for time to elapse, or for process output). This avoids the -timing errors that could result from running filters at random places in -the middle of other Lisp programs. You may explicitly cause Emacs to -wait, so that filter functions will run, by calling @code{sit-for} or -@code{sleep-for} (@pxref{Waiting}), or @code{accept-process-output} -(@pxref{Accepting Output}). Emacs is also waiting when the command loop -is reading input. - - Quitting is normally inhibited within a filter function---otherwise, -the effect of typing @kbd{C-g} at command level or to quit a user -command would be unpredictable. If you want to permit quitting inside a -filter function, bind @code{inhibit-quit} to @code{nil}. -@xref{Quitting}. - - If an error happens during execution of a filter function, it is -caught automatically, so that it doesn't stop the execution of whatever -program was running when the filter function was started. However, if -@code{debug-on-error} is non-@code{nil}, the error-catching is turned -off. This makes it possible to use the Lisp debugger to debug the -filter function. @xref{Debugger}. - - Many filter functions sometimes or always insert the text in the -process's buffer, mimicking the actions of XEmacs when there is no -filter. Such filter functions need to use @code{set-buffer} in order to -be sure to insert in that buffer. To avoid setting the current buffer -semipermanently, these filter functions must use @code{unwind-protect} -to make sure to restore the previous current buffer. They should also -update the process marker, and in some cases update the value of point. -Here is how to do these things: - -@smallexample -@group -(defun ordinary-insertion-filter (proc string) - (let ((old-buffer (current-buffer))) - (unwind-protect - (let (moving) - (set-buffer (process-buffer proc)) - (setq moving (= (point) (process-mark proc))) -@end group -@group - (save-excursion - ;; @r{Insert the text, moving the process-marker.} - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc)))) - (set-buffer old-buffer)))) -@end group -@end smallexample - -@noindent -The reason to use an explicit @code{unwind-protect} rather than letting -@code{save-excursion} restore the current buffer is so as to preserve -the change in point made by @code{goto-char}. - - To make the filter force the process buffer to be visible whenever new -text arrives, insert the following line just before the -@code{unwind-protect}: - -@smallexample -(display-buffer (process-buffer proc)) -@end smallexample - - To force point to move to the end of the new output no matter where -it was previously, eliminate the variable @code{moving} and call -@code{goto-char} unconditionally. - - In earlier Emacs versions, every filter function that did regexp -searching or matching had to explicitly save and restore the match data. -Now Emacs does this automatically; filter functions never need to do it -explicitly. @xref{Match Data}. - - A filter function that writes the output into the buffer of the -process should check whether the buffer is still alive. If it tries to -insert into a dead buffer, it will get an error. If the buffer is dead, -@code{(buffer-name (process-buffer @var{process}))} returns @code{nil}. - - The output to the function may come in chunks of any size. A program -that produces the same output twice in a row may send it as one batch -of 200 characters one time, and five batches of 40 characters the next. - -@defun set-process-filter process filter -This function gives @var{process} the filter function @var{filter}. If -@var{filter} is @code{nil}, then the process will have no filter. If -@var{filter} is @code{t}, then no output from the process will be -accepted until the filter is changed. (Output received during this -time is not discarded, but is queued, and will be processed as soon -as the filter is changed.) -@end defun - -@defun process-filter process -This function returns the filter function of @var{process}, or @code{nil} -if it has none. @code{t} means that output processing has been stopped. -@end defun - - Here is an example of use of a filter function: - -@smallexample -@group -(defun keep-output (process output) - (setq kept (cons output kept))) - @result{} keep-output -@end group -@group -(setq kept nil) - @result{} nil -@end group -@group -(set-process-filter (get-process "shell") 'keep-output) - @result{} keep-output -@end group -@group -(process-send-string "shell" "ls ~/other\n") - @result{} nil -kept - @result{} ("lewis@@slug[8] % " -@end group -@group -"FINAL-W87-SHORT.MSS backup.otl kolstad.mss~ -address.txt backup.psf kolstad.psf -backup.bib~ david.mss resume-Dec-86.mss~ -backup.err david.psf resume-Dec.psf -backup.mss dland syllabus.mss -" -"#backups.mss# backup.mss~ kolstad.mss -") -@end group -@end smallexample - -@ignore @c The code in this example doesn't show the right way to do things. -Here is another, more realistic example, which demonstrates how to use -the process mark to do insertion in the same fashion as is done when -there is no filter function: - -@smallexample -@group -;; @r{Insert input in the buffer specified by @code{my-shell-buffer}} -;; @r{and make sure that buffer is shown in some window.} -(defun my-process-filter (proc str) - (let ((cur (selected-window)) - (pop-up-windows t)) - (pop-to-buffer my-shell-buffer) -@end group -@group - (goto-char (point-max)) - (insert str) - (set-marker (process-mark proc) (point-max)) - (select-window cur))) -@end group -@end smallexample -@end ignore - -@node Accepting Output -@subsection Accepting Output from Processes - - Output from asynchronous subprocesses normally arrives only while -XEmacs is waiting for some sort of external event, such as elapsed time -or terminal input. Occasionally it is useful in a Lisp program to -explicitly permit output to arrive at a specific point, or even to wait -until output arrives from a process. - -@defun accept-process-output &optional process seconds millisec -This function allows XEmacs to read pending output from processes. The -output is inserted in the associated buffers or given to their filter -functions. If @var{process} is non-@code{nil} then this function does -not return until some output has been received from @var{process}. - -@c Emacs 19 feature -The arguments @var{seconds} and @var{millisec} let you specify timeout -periods. The former specifies a period measured in seconds and the -latter specifies one measured in milliseconds. The two time periods -thus specified are added together, and @code{accept-process-output} -returns after that much time whether or not there has been any -subprocess output. Note that @var{seconds} is allowed to be a -floating-point number; thus, there is no need to ever use -@var{millisec}. (It is retained for compatibility purposes.) -@ignore Not in XEmacs - -The argument @var{seconds} need not be an integer. If it is a floating -point number, this function waits for a fractional number of seconds. -Some systems support only a whole number of seconds; on these systems, -@var{seconds} is rounded down. If the system doesn't support waiting -fractions of a second, you get an error if you specify nonzero -@var{millisec}. - -Not all operating systems support waiting periods other than multiples -of a second; on those that do not, you get an error if you specify -nonzero @var{millisec}. -@end ignore - -The function @code{accept-process-output} returns non-@code{nil} if it -did get some output, or @code{nil} if the timeout expired before output -arrived. -@end defun - -@node Sentinels -@section Sentinels: Detecting Process Status Changes -@cindex process sentinel -@cindex sentinel - - A @dfn{process sentinel} is a function that is called whenever the -associated process changes status for any reason, including signals -(whether sent by XEmacs or caused by the process's own actions) that -terminate, stop, or continue the process. The process sentinel is also -called if the process exits. The sentinel receives two arguments: the -process for which the event occurred, and a string describing the type -of event. - - The string describing the event looks like one of the following: - -@itemize @bullet -@item -@code{"finished\n"}. - -@item -@code{"exited abnormally with code @var{exitcode}\n"}. - -@item -@code{"@var{name-of-signal}\n"}. - -@item -@code{"@var{name-of-signal} (core dumped)\n"}. -@end itemize - - A sentinel runs only while XEmacs is waiting (e.g., for terminal input, -or for time to elapse, or for process output). This avoids the timing -errors that could result from running them at random places in the -middle of other Lisp programs. A program can wait, so that sentinels -will run, by calling @code{sit-for} or @code{sleep-for} -(@pxref{Waiting}), or @code{accept-process-output} (@pxref{Accepting -Output}). Emacs is also waiting when the command loop is reading input. - - Quitting is normally inhibited within a sentinel---otherwise, the -effect of typing @kbd{C-g} at command level or to quit a user command -would be unpredictable. If you want to permit quitting inside a -sentinel, bind @code{inhibit-quit} to @code{nil}. @xref{Quitting}. - - A sentinel that writes the output into the buffer of the process -should check whether the buffer is still alive. If it tries to insert -into a dead buffer, it will get an error. If the buffer is dead, -@code{(buffer-name (process-buffer @var{process}))} returns @code{nil}. - - If an error happens during execution of a sentinel, it is caught -automatically, so that it doesn't stop the execution of whatever -programs was running when the sentinel was started. However, if -@code{debug-on-error} is non-@code{nil}, the error-catching is turned -off. This makes it possible to use the Lisp debugger to debug the -sentinel. @xref{Debugger}. - - In earlier Emacs versions, every sentinel that did regexp searching or -matching had to explicitly save and restore the match data. Now Emacs -does this automatically; sentinels never need to do it explicitly. -@xref{Match Data}. - -@defun set-process-sentinel process sentinel -This function associates @var{sentinel} with @var{process}. If -@var{sentinel} is @code{nil}, then the process will have no sentinel. -The default behavior when there is no sentinel is to insert a message in -the process's buffer when the process status changes. - -@smallexample -@group -(defun msg-me (process event) - (princ - (format "Process: %s had the event `%s'" process event))) -(set-process-sentinel (get-process "shell") 'msg-me) - @result{} msg-me -@end group -@group -(kill-process (get-process "shell")) - @print{} Process: # had the event `killed' - @result{} # -@end group -@end smallexample -@end defun - -@defun process-sentinel process -This function returns the sentinel of @var{process}, or @code{nil} if it -has none. -@end defun - -@defun waiting-for-user-input-p -While a sentinel or filter function is running, this function returns -non-@code{nil} if XEmacs was waiting for keyboard input from the user at -the time the sentinel or filter function was called, @code{nil} if it -was not. -@end defun - -@c XEmacs feature -@node Process Window Size -@section Process Window Size -@cindex process window size - -@defun set-process-window-size process height width - This function tells @var{process} that its logical window size is -@var{height} by @var{width} characters. This is principally useful -with pty's. -@end defun - -@node Transaction Queues -@section Transaction Queues -@cindex transaction queue - -You can use a @dfn{transaction queue} for more convenient communication -with subprocesses using transactions. First use @code{tq-create} to -create a transaction queue communicating with a specified process. Then -you can call @code{tq-enqueue} to send a transaction. - -@defun tq-create process -This function creates and returns a transaction queue communicating with -@var{process}. The argument @var{process} should be a subprocess -capable of sending and receiving streams of bytes. It may be a child -process, or it may be a TCP connection to a server, possibly on another -machine. -@end defun - -@defun tq-enqueue queue question regexp closure fn -This function sends a transaction to queue @var{queue}. Specifying the -queue has the effect of specifying the subprocess to talk to. - -The argument @var{question} is the outgoing message that starts the -transaction. The argument @var{fn} is the function to call when the -corresponding answer comes back; it is called with two arguments: -@var{closure}, and the answer received. - -The argument @var{regexp} is a regular expression that should match the -entire answer, but nothing less; that's how @code{tq-enqueue} determines -where the answer ends. - -The return value of @code{tq-enqueue} itself is not meaningful. -@end defun - -@defun tq-close queue -Shut down transaction queue @var{queue}, waiting for all pending transactions -to complete, and then terminate the connection or child process. -@end defun - -Transaction queues are implemented by means of a filter function. -@xref{Filter Functions}. - -@node Network -@section Network Connections -@cindex network connection -@cindex TCP - - XEmacs Lisp programs can open TCP network connections to other processes on -the same machine or other machines. A network connection is handled by Lisp -much like a subprocess, and is represented by a process object. -However, the process you are communicating with is not a child of the -XEmacs process, so you can't kill it or send it signals. All you can do -is send and receive data. @code{delete-process} closes the connection, -but does not kill the process at the other end; that process must decide -what to do about closure of the connection. - - You can distinguish process objects representing network connections -from those representing subprocesses with the @code{process-status} -function. It always returns either @code{open} or @code{closed} for a -network connection, and it never returns either of those values for a -real subprocess. @xref{Process Information}. - -@defun open-network-stream name buffer-or-name host service -This function opens a TCP connection for a service to a host. It -returns a process object to represent the connection. - -The @var{name} argument specifies the name for the process object. It -is modified as necessary to make it unique. - -The @var{buffer-or-name} argument is the buffer to associate with the -connection. Output from the connection is inserted in the buffer, -unless you specify a filter function to handle the output. If -@var{buffer-or-name} is @code{nil}, it means that the connection is not -associated with any buffer. - -The arguments @var{host} and @var{service} specify where to connect to; -@var{host} is the host name or IP address (a string), and @var{service} -is the name of a defined network service (a string) or a port number (an -integer). -@end defun diff --git a/man/lispref/range-tables.texi b/man/lispref/range-tables.texi deleted file mode 100644 index 900eda5..0000000 --- a/man/lispref/range-tables.texi +++ /dev/null @@ -1,72 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/range-tables.info -@node Range Tables, Databases, Hash Tables, top -@chapter Range Tables -@cindex Range Tables - -A range table is a table that efficiently associated values with -ranges of integers. - -Note that range tables have a read syntax, like this: - -@example -#s(range-table data ((-3 2) foo (5 20) bar)) -@end example - -This maps integers in the range (-3, 2) to @code{foo} and integers -in the range (5, 20) to @code{bar}. - -@defun range-table-p object -Return non-@code{nil} if @var{object} is a range table. -@end defun - -@menu -* Introduction to Range Tables:: Range tables efficiently map ranges of - integers to values. -* Working With Range Tables:: Range table functions. -@end menu - -@node Introduction to Range Tables -@section Introduction to Range Tables - -@defun make-range-table -Make a new, empty range table. -@end defun - -@defun copy-range-table old-table -Make a new range table which contains the same values for the same -ranges as the given table. The values will not themselves be copied. -@end defun - -@node Working With Range Tables -@section Working With Range Tables - -@defun get-range-table pos table &optional default -This function finds value for position @var{pos} in @var{table}. If -there is no corresponding value, return @var{default} (defaults to -@code{nil}). -@end defun - -@defun put-range-table start end val table -This function sets the value for range (@var{start}, @var{end}) to be -@var{val} in @var{table}. -@end defun - -@defun remove-range-table start end table -This function removes the value for range (@var{start}, @var{end}) in -@var{table}. -@end defun - -@defun clear-range-table table -This function flushes @var{table}. -@end defun - -@defun map-range-table function table -This function maps @var{function} over entries in @var{table}, calling -it with three args, the beginning and end of the range and the -corresponding value. -@end defun - diff --git a/man/lispref/scrollbars.texi b/man/lispref/scrollbars.texi deleted file mode 100644 index 6fa6cf9..0000000 --- a/man/lispref/scrollbars.texi +++ /dev/null @@ -1,10 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/glyphs.info -@node Scrollbars, Drag and Drop, Toolbar, top -@chapter scrollbars -@cindex scrollbars - -Not yet documented. diff --git a/man/lispref/searching.texi b/man/lispref/searching.texi deleted file mode 100644 index db7eadc..0000000 --- a/man/lispref/searching.texi +++ /dev/null @@ -1,1465 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/searching.info -@node Searching and Matching, Syntax Tables, Text, Top -@chapter Searching and Matching -@cindex searching - - XEmacs provides two ways to search through a buffer for specified -text: exact string searches and regular expression searches. After a -regular expression search, you can examine the @dfn{match data} to -determine which text matched the whole regular expression or various -portions of it. - -@menu -* String Search:: Search for an exact match. -* Regular Expressions:: Describing classes of strings. -* Regexp Search:: Searching for a match for a regexp. -* POSIX Regexps:: Searching POSIX-style for the longest match. -* Search and Replace:: Internals of @code{query-replace}. -* Match Data:: Finding out which part of the text matched - various parts of a regexp, after regexp search. -* Searching and Case:: Case-independent or case-significant searching. -* Standard Regexps:: Useful regexps for finding sentences, pages,... -@end menu - - The @samp{skip-chars@dots{}} functions also perform a kind of searching. -@xref{Skipping Characters}. - -@node String Search -@section Searching for Strings -@cindex string search - - These are the primitive functions for searching through the text in a -buffer. They are meant for use in programs, but you may call them -interactively. If you do so, they prompt for the search string; -@var{limit} and @var{noerror} are set to @code{nil}, and @var{repeat} -is set to 1. - -@deffn Command search-forward string &optional limit noerror repeat - This function searches forward from point for an exact match for -@var{string}. If successful, it sets point to the end of the occurrence -found, and returns the new value of point. If no match is found, the -value and side effects depend on @var{noerror} (see below). -@c Emacs 19 feature - - In the following example, point is initially at the beginning of the -line. Then @code{(search-forward "fox")} moves point after the last -letter of @samp{fox}: - -@example -@group ----------- Buffer: foo ---------- -@point{}The quick brown fox jumped over the lazy dog. ----------- Buffer: foo ---------- -@end group - -@group -(search-forward "fox") - @result{} 20 - ----------- Buffer: foo ---------- -The quick brown fox@point{} jumped over the lazy dog. ----------- Buffer: foo ---------- -@end group -@end example - - The argument @var{limit} specifies the upper bound to the search. (It -must be a position in the current buffer.) No match extending after -that position is accepted. If @var{limit} is omitted or @code{nil}, it -defaults to the end of the accessible portion of the buffer. - -@kindex search-failed - What happens when the search fails depends on the value of -@var{noerror}. If @var{noerror} is @code{nil}, a @code{search-failed} -error is signaled. If @var{noerror} is @code{t}, @code{search-forward} -returns @code{nil} and does nothing. If @var{noerror} is neither -@code{nil} nor @code{t}, then @code{search-forward} moves point to the -upper bound and returns @code{nil}. (It would be more consistent now -to return the new position of point in that case, but some programs -may depend on a value of @code{nil}.) - -If @var{repeat} is supplied (it must be a positive number), then the -search is repeated that many times (each time starting at the end of the -previous time's match). If these successive searches succeed, the -function succeeds, moving point and returning its new value. Otherwise -the search fails. -@end deffn - -@deffn Command search-backward string &optional limit noerror repeat -This function searches backward from point for @var{string}. It is -just like @code{search-forward} except that it searches backwards and -leaves point at the beginning of the match. -@end deffn - -@deffn Command word-search-forward string &optional limit noerror repeat -@cindex word search -This function searches forward from point for a ``word'' match for -@var{string}. If it finds a match, it sets point to the end of the -match found, and returns the new value of point. -@c Emacs 19 feature - -Word matching regards @var{string} as a sequence of words, disregarding -punctuation that separates them. It searches the buffer for the same -sequence of words. Each word must be distinct in the buffer (searching -for the word @samp{ball} does not match the word @samp{balls}), but the -details of punctuation and spacing are ignored (searching for @samp{ball -boy} does match @samp{ball. Boy!}). - -In this example, point is initially at the beginning of the buffer; the -search leaves it between the @samp{y} and the @samp{!}. - -@example -@group ----------- Buffer: foo ---------- -@point{}He said "Please! Find -the ball boy!" ----------- Buffer: foo ---------- -@end group - -@group -(word-search-forward "Please find the ball, boy.") - @result{} 35 - ----------- Buffer: foo ---------- -He said "Please! Find -the ball boy@point{}!" ----------- Buffer: foo ---------- -@end group -@end example - -If @var{limit} is non-@code{nil} (it must be a position in the current -buffer), then it is the upper bound to the search. The match found must -not extend after that position. - -If @var{noerror} is @code{nil}, then @code{word-search-forward} signals -an error if the search fails. If @var{noerror} is @code{t}, then it -returns @code{nil} instead of signaling an error. If @var{noerror} is -neither @code{nil} nor @code{t}, it moves point to @var{limit} (or the -end of the buffer) and returns @code{nil}. - -If @var{repeat} is non-@code{nil}, then the search is repeated that many -times. Point is positioned at the end of the last match. -@end deffn - -@deffn Command word-search-backward string &optional limit noerror repeat -This function searches backward from point for a word match to -@var{string}. This function is just like @code{word-search-forward} -except that it searches backward and normally leaves point at the -beginning of the match. -@end deffn - -@node Regular Expressions -@section Regular Expressions -@cindex regular expression -@cindex regexp - - A @dfn{regular expression} (@dfn{regexp}, for short) is a pattern that -denotes a (possibly infinite) set of strings. Searching for matches for -a regexp is a very powerful operation. This section explains how to write -regexps; the following section says how to search for them. - - To gain a thorough understanding of regular expressions and how to use -them to best advantage, we recommend that you study @cite{Mastering -Regular Expressions, by Jeffrey E.F. Friedl, O'Reilly and Associates, -1997}. (It's known as the "Hip Owls" book, because of the picture on its -cover.) You might also read the manuals to @ref{(gawk)Top}, -@ref{(ed)Top}, @cite{sed}, @cite{grep}, @ref{(perl)Top}, -@ref{(regex)Top}, @ref{(rx)Top}, @cite{pcre}, and @ref{(flex)Top}, which -also make good use of regular expressions. - - The XEmacs regular expression syntax most closely resembles that of -@cite{ed}, or @cite{grep}, the GNU versions of which all utilize the GNU -@cite{regex} library. XEmacs' version of @cite{regex} has recently been -extended with some Perl--like capabilities, described in the next -section. - -@menu -* Syntax of Regexps:: Rules for writing regular expressions. -* Regexp Example:: Illustrates regular expression syntax. -@end menu - -@node Syntax of Regexps -@subsection Syntax of Regular Expressions - - Regular expressions have a syntax in which a few characters are -special constructs and the rest are @dfn{ordinary}. An ordinary -character is a simple regular expression that matches that character and -nothing else. The special characters are @samp{.}, @samp{*}, @samp{+}, -@samp{?}, @samp{[}, @samp{]}, @samp{^}, @samp{$}, and @samp{\}; no new -special characters will be defined in the future. Any other character -appearing in a regular expression is ordinary, unless a @samp{\} -precedes it. - -For example, @samp{f} is not a special character, so it is ordinary, and -therefore @samp{f} is a regular expression that matches the string -@samp{f} and no other string. (It does @emph{not} match the string -@samp{ff}.) Likewise, @samp{o} is a regular expression that matches -only @samp{o}.@refill - -Any two regular expressions @var{a} and @var{b} can be concatenated. The -result is a regular expression that matches a string if @var{a} matches -some amount of the beginning of that string and @var{b} matches the rest of -the string.@refill - -As a simple example, we can concatenate the regular expressions @samp{f} -and @samp{o} to get the regular expression @samp{fo}, which matches only -the string @samp{fo}. Still trivial. To do something more powerful, you -need to use one of the special characters. Here is a list of them: - -@need 1200 -@table @kbd -@item .@: @r{(Period)} -@cindex @samp{.} in regexp -is a special character that matches any single character except a newline. -Using concatenation, we can make regular expressions like @samp{a.b}, which -matches any three-character string that begins with @samp{a} and ends with -@samp{b}.@refill - -@item * -@cindex @samp{*} in regexp -is not a construct by itself; it is a quantifying suffix operator that -means to repeat the preceding regular expression as many times as -possible. In @samp{fo*}, the @samp{*} applies to the @samp{o}, so -@samp{fo*} matches one @samp{f} followed by any number of @samp{o}s. -The case of zero @samp{o}s is allowed: @samp{fo*} does match -@samp{f}.@refill - -@samp{*} always applies to the @emph{smallest} possible preceding -expression. Thus, @samp{fo*} has a repeating @samp{o}, not a -repeating @samp{fo}.@refill - -The matcher processes a @samp{*} construct by matching, immediately, as -many repetitions as can be found; it is "greedy". Then it continues -with the rest of the pattern. If that fails, backtracking occurs, -discarding some of the matches of the @samp{*}-modified construct in -case that makes it possible to match the rest of the pattern. For -example, in matching @samp{ca*ar} against the string @samp{caaar}, the -@samp{a*} first tries to match all three @samp{a}s; but the rest of the -pattern is @samp{ar} and there is only @samp{r} left to match, so this -try fails. The next alternative is for @samp{a*} to match only two -@samp{a}s. With this choice, the rest of the regexp matches -successfully.@refill - -Nested repetition operators can be extremely slow if they specify -backtracking loops. For example, it could take hours for the regular -expression @samp{\(x+y*\)*a} to match the sequence -@samp{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz}. The slowness is because -Emacs must try each imaginable way of grouping the 35 @samp{x}'s before -concluding that none of them can work. To make sure your regular -expressions run fast, check nested repetitions carefully. - -@item + -@cindex @samp{+} in regexp -is a quantifying suffix operator similar to @samp{*} except that the -preceding expression must match at least once. It is also "greedy". -So, for example, @samp{ca+r} matches the strings @samp{car} and -@samp{caaaar} but not the string @samp{cr}, whereas @samp{ca*r} matches -all three strings. - -@item ? -@cindex @samp{?} in regexp -is a quantifying suffix operator similar to @samp{*}, except that the -preceding expression can match either once or not at all. For example, -@samp{ca?r} matches @samp{car} or @samp{cr}, but does not match anything -else. - -@item *? -@cindex @samp{*?} in regexp -works just like @samp{*}, except that rather than matching the longest -match, it matches the shortest match. @samp{*?} is known as a -@dfn{non-greedy} quantifier, a regexp construct borrowed from Perl. -@c Did perl get this from somewhere? What's the real history of *? ? - -This construct very useful for when you want to match the text inside a -pair of delimiters. For instance, @samp{/\*.*?\*/} will match C -comments in a string. This could not be achieved without the use of -greedy quantifier. - -This construct has not been available prior to XEmacs 20.4. It is not -available in FSF Emacs. - -@item +? -@cindex @samp{+?} in regexp -is the @samp{+} analog to @samp{*?}. - -@item \@{n,m\@} -@c Note the spacing after the close brace is deliberate. -@cindex @samp{\@{n,m\@} }in regexp -serves as an interval quantifier, analogous to @samp{*} or @samp{+}, but -specifies that the expression must match at least @var{n} times, but no -more than @var{m} times. This syntax is supported by most Unix regexp -utilities, and has been introduced to XEmacs for the version 20.3. - -@item [ @dots{} ] -@cindex character set (in regexp) -@cindex @samp{[} in regexp -@cindex @samp{]} in regexp -@samp{[} begins a @dfn{character set}, which is terminated by a -@samp{]}. In the simplest case, the characters between the two brackets -form the set. Thus, @samp{[ad]} matches either one @samp{a} or one -@samp{d}, and @samp{[ad]*} matches any string composed of just @samp{a}s -and @samp{d}s (including the empty string), from which it follows that -@samp{c[ad]*r} matches @samp{cr}, @samp{car}, @samp{cdr}, -@samp{caddaar}, etc.@refill - -The usual regular expression special characters are not special inside a -character set. A completely different set of special characters exists -inside character sets: @samp{]}, @samp{-} and @samp{^}.@refill - -@samp{-} is used for ranges of characters. To write a range, write two -characters with a @samp{-} between them. Thus, @samp{[a-z]} matches any -lower case letter. Ranges may be intermixed freely with individual -characters, as in @samp{[a-z$%.]}, which matches any lower case letter -or @samp{$}, @samp{%}, or a period.@refill - -To include a @samp{]} in a character set, make it the first character. -For example, @samp{[]a]} matches @samp{]} or @samp{a}. To include a -@samp{-}, write @samp{-} as the first character in the set, or put it -immediately after a range. (You can replace one individual character -@var{c} with the range @samp{@var{c}-@var{c}} to make a place to put the -@samp{-}.) There is no way to write a set containing just @samp{-} and -@samp{]}. - -To include @samp{^} in a set, put it anywhere but at the beginning of -the set. - -@item [^ @dots{} ] -@cindex @samp{^} in regexp -@samp{[^} begins a @dfn{complement character set}, which matches any -character except the ones specified. Thus, @samp{[^a-z0-9A-Z]} -matches all characters @emph{except} letters and digits.@refill - -@samp{^} is not special in a character set unless it is the first -character. The character following the @samp{^} is treated as if it -were first (thus, @samp{-} and @samp{]} are not special there). - -Note that a complement character set can match a newline, unless -newline is mentioned as one of the characters not to match. - -@item ^ -@cindex @samp{^} in regexp -@cindex beginning of line in regexp -is a special character that matches the empty string, but only at the -beginning of a line in the text being matched. Otherwise it fails to -match anything. Thus, @samp{^foo} matches a @samp{foo} that occurs at -the beginning of a line. - -When matching a string instead of a buffer, @samp{^} matches at the -beginning of the string or after a newline character @samp{\n}. - -@item $ -@cindex @samp{$} in regexp -is similar to @samp{^} but matches only at the end of a line. Thus, -@samp{x+$} matches a string of one @samp{x} or more at the end of a line. - -When matching a string instead of a buffer, @samp{$} matches at the end -of the string or before a newline character @samp{\n}. - -@item \ -@cindex @samp{\} in regexp -has two functions: it quotes the special characters (including -@samp{\}), and it introduces additional special constructs. - -Because @samp{\} quotes special characters, @samp{\$} is a regular -expression that matches only @samp{$}, and @samp{\[} is a regular -expression that matches only @samp{[}, and so on. - -Note that @samp{\} also has special meaning in the read syntax of Lisp -strings (@pxref{String Type}), and must be quoted with @samp{\}. For -example, the regular expression that matches the @samp{\} character is -@samp{\\}. To write a Lisp string that contains the characters -@samp{\\}, Lisp syntax requires you to quote each @samp{\} with another -@samp{\}. Therefore, the read syntax for a regular expression matching -@samp{\} is @code{"\\\\"}.@refill -@end table - -@strong{Please note:} For historical compatibility, special characters -are treated as ordinary ones if they are in contexts where their special -meanings make no sense. For example, @samp{*foo} treats @samp{*} as -ordinary since there is no preceding expression on which the @samp{*} -can act. It is poor practice to depend on this behavior; quote the -special character anyway, regardless of where it appears.@refill - -For the most part, @samp{\} followed by any character matches only -that character. However, there are several exceptions: characters -that, when preceded by @samp{\}, are special constructs. Such -characters are always ordinary when encountered on their own. Here -is a table of @samp{\} constructs: - -@table @kbd -@item \| -@cindex @samp{|} in regexp -@cindex regexp alternative -specifies an alternative. -Two regular expressions @var{a} and @var{b} with @samp{\|} in -between form an expression that matches anything that either @var{a} or -@var{b} matches.@refill - -Thus, @samp{foo\|bar} matches either @samp{foo} or @samp{bar} -but no other string.@refill - -@samp{\|} applies to the largest possible surrounding expressions. Only a -surrounding @samp{\( @dots{} \)} grouping can limit the grouping power of -@samp{\|}.@refill - -Full backtracking capability exists to handle multiple uses of @samp{\|}. - -@item \( @dots{} \) -@cindex @samp{(} in regexp -@cindex @samp{)} in regexp -@cindex regexp grouping -is a grouping construct that serves three purposes: - -@enumerate -@item -To enclose a set of @samp{\|} alternatives for other operations. -Thus, @samp{\(foo\|bar\)x} matches either @samp{foox} or @samp{barx}. - -@item -To enclose an expression for a suffix operator such as @samp{*} to act -on. Thus, @samp{ba\(na\)*} matches @samp{bananana}, etc., with any -(zero or more) number of @samp{na} strings.@refill - -@item -To record a matched substring for future reference. -@end enumerate - -This last application is not a consequence of the idea of a -parenthetical grouping; it is a separate feature that happens to be -assigned as a second meaning to the same @samp{\( @dots{} \)} construct -because there is no conflict in practice between the two meanings. -Here is an explanation of this feature: - -@item \@var{digit} -matches the same text that matched the @var{digit}th occurrence of a -@samp{\( @dots{} \)} construct. - -In other words, after the end of a @samp{\( @dots{} \)} construct. the -matcher remembers the beginning and end of the text matched by that -construct. Then, later on in the regular expression, you can use -@samp{\} followed by @var{digit} to match that same text, whatever it -may have been. - -The strings matching the first nine @samp{\( @dots{} \)} constructs -appearing in a regular expression are assigned numbers 1 through 9 in -the order that the open parentheses appear in the regular expression. -So you can use @samp{\1} through @samp{\9} to refer to the text matched -by the corresponding @samp{\( @dots{} \)} constructs. - -For example, @samp{\(.*\)\1} matches any newline-free string that is -composed of two identical halves. The @samp{\(.*\)} matches the first -half, which may be anything, but the @samp{\1} that follows must match -the same exact text. - -@item \(?: @dots{} \) -@cindex @samp{\(?:} in regexp -@cindex regexp grouping -is called a @dfn{shy} grouping operator, and it is used just like -@samp{\( @dots{} \)}, except that it does not cause the matched -substring to be recorded for future reference. - -This is useful when you need a lot of grouping @samp{\( @dots{} \)} -constructs, but only want to remember one or two. Then you can use -not want to remember them for later use with @code{match-string}. - -Using @samp{\(?: @dots{} \)} rather than @samp{\( @dots{} \)} when you -don't need the captured substrings ought to speed up your programs some, -since it shortens the code path followed by the regular expression -engine, as well as the amount of memory allocation and string copying it -must do. The actual performance gain to be observed has not been -measured or quantified as of this writing. -@c This is used to good advantage by the font-locking code, and by -@c `regexp-opt.el'. ... It will be. It's not yet, but will be. - -The shy grouping operator has been borrowed from Perl, and has not been -available prior to XEmacs 20.3, nor is it available in FSF Emacs. - -@item \w -@cindex @samp{\w} in regexp -matches any word-constituent character. The editor syntax table -determines which characters these are. @xref{Syntax Tables}. - -@item \W -@cindex @samp{\W} in regexp -matches any character that is not a word constituent. - -@item \s@var{code} -@cindex @samp{\s} in regexp -matches any character whose syntax is @var{code}. Here @var{code} is a -character that represents a syntax code: thus, @samp{w} for word -constituent, @samp{-} for whitespace, @samp{(} for open parenthesis, -etc. @xref{Syntax Tables}, for a list of syntax codes and the -characters that stand for them. - -@item \S@var{code} -@cindex @samp{\S} in regexp -matches any character whose syntax is not @var{code}. -@end table - - The following regular expression constructs match the empty string---that is, -they don't use up any characters---but whether they match depends on the -context. - -@table @kbd -@item \` -@cindex @samp{\`} in regexp -matches the empty string, but only at the beginning -of the buffer or string being matched against. - -@item \' -@cindex @samp{\'} in regexp -matches the empty string, but only at the end of -the buffer or string being matched against. - -@item \= -@cindex @samp{\=} in regexp -matches the empty string, but only at point. -(This construct is not defined when matching against a string.) - -@item \b -@cindex @samp{\b} in regexp -matches the empty string, but only at the beginning or -end of a word. Thus, @samp{\bfoo\b} matches any occurrence of -@samp{foo} as a separate word. @samp{\bballs?\b} matches -@samp{ball} or @samp{balls} as a separate word.@refill - -@item \B -@cindex @samp{\B} in regexp -matches the empty string, but @emph{not} at the beginning or -end of a word. - -@item \< -@cindex @samp{\<} in regexp -matches the empty string, but only at the beginning of a word. - -@item \> -@cindex @samp{\>} in regexp -matches the empty string, but only at the end of a word. -@end table - -@kindex invalid-regexp - Not every string is a valid regular expression. For example, a string -with unbalanced square brackets is invalid (with a few exceptions, such -as @samp{[]]}), and so is a string that ends with a single @samp{\}. If -an invalid regular expression is passed to any of the search functions, -an @code{invalid-regexp} error is signaled. - -@defun regexp-quote string -This function returns a regular expression string that matches exactly -@var{string} and nothing else. This allows you to request an exact -string match when calling a function that wants a regular expression. - -@example -@group -(regexp-quote "^The cat$") - @result{} "\\^The cat\\$" -@end group -@end example - -One use of @code{regexp-quote} is to combine an exact string match with -context described as a regular expression. For example, this searches -for the string that is the value of @code{string}, surrounded by -whitespace: - -@example -@group -(re-search-forward - (concat "\\s-" (regexp-quote string) "\\s-")) -@end group -@end example -@end defun - -@node Regexp Example -@subsection Complex Regexp Example - - Here is a complicated regexp, used by XEmacs to recognize the end of a -sentence together with any whitespace that follows. It is the value of -the variable @code{sentence-end}. - - First, we show the regexp as a string in Lisp syntax to distinguish -spaces from tab characters. The string constant begins and ends with a -double-quote. @samp{\"} stands for a double-quote as part of the -string, @samp{\\} for a backslash as part of the string, @samp{\t} for a -tab and @samp{\n} for a newline. - -@example -"[.?!][]\"')@}]*\\($\\| $\\|\t\\| \\)[ \t\n]*" -@end example - - In contrast, if you evaluate the variable @code{sentence-end}, you -will see the following: - -@example -@group -sentence-end -@result{} -"[.?!][]\"')@}]*\\($\\| $\\| \\| \\)[ -]*" -@end group -@end example - -@noindent -In this output, tab and newline appear as themselves. - - This regular expression contains four parts in succession and can be -deciphered as follows: - -@table @code -@item [.?!] -The first part of the pattern is a character set that matches any one of -three characters: period, question mark, and exclamation mark. The -match must begin with one of these three characters. - -@item []\"')@}]* -The second part of the pattern matches any closing braces and quotation -marks, zero or more of them, that may follow the period, question mark -or exclamation mark. The @code{\"} is Lisp syntax for a double-quote in -a string. The @samp{*} at the end indicates that the immediately -preceding regular expression (a character set, in this case) may be -repeated zero or more times. - -@item \\($\\|@ $\\|\t\\|@ @ \\) -The third part of the pattern matches the whitespace that follows the -end of a sentence: the end of a line, or a tab, or two spaces. The -double backslashes mark the parentheses and vertical bars as regular -expression syntax; the parentheses delimit a group and the vertical bars -separate alternatives. The dollar sign is used to match the end of a -line. - -@item [ \t\n]* -Finally, the last part of the pattern matches any additional whitespace -beyond the minimum needed to end a sentence. -@end table - -@node Regexp Search -@section Regular Expression Searching -@cindex regular expression searching -@cindex regexp searching -@cindex searching for regexp - - In XEmacs, you can search for the next match for a regexp either -incrementally or not. Incremental search commands are described in the -@cite{The XEmacs Reference Manual}. @xref{Regexp Search, , Regular Expression -Search, emacs, The XEmacs Reference Manual}. Here we describe only the search -functions useful in programs. The principal one is -@code{re-search-forward}. - -@deffn Command re-search-forward regexp &optional limit noerror repeat -This function searches forward in the current buffer for a string of -text that is matched by the regular expression @var{regexp}. The -function skips over any amount of text that is not matched by -@var{regexp}, and leaves point at the end of the first match found. -It returns the new value of point. - -If @var{limit} is non-@code{nil} (it must be a position in the current -buffer), then it is the upper bound to the search. No match extending -after that position is accepted. - -What happens when the search fails depends on the value of -@var{noerror}. If @var{noerror} is @code{nil}, a @code{search-failed} -error is signaled. If @var{noerror} is @code{t}, -@code{re-search-forward} does nothing and returns @code{nil}. If -@var{noerror} is neither @code{nil} nor @code{t}, then -@code{re-search-forward} moves point to @var{limit} (or the end of the -buffer) and returns @code{nil}. - -If @var{repeat} is supplied (it must be a positive number), then the -search is repeated that many times (each time starting at the end of the -previous time's match). If these successive searches succeed, the -function succeeds, moving point and returning its new value. Otherwise -the search fails. - -In the following example, point is initially before the @samp{T}. -Evaluating the search call moves point to the end of that line (between -the @samp{t} of @samp{hat} and the newline). - -@example -@group ----------- Buffer: foo ---------- -I read "@point{}The cat in the hat -comes back" twice. ----------- Buffer: foo ---------- -@end group - -@group -(re-search-forward "[a-z]+" nil t 5) - @result{} 27 - ----------- Buffer: foo ---------- -I read "The cat in the hat@point{} -comes back" twice. ----------- Buffer: foo ---------- -@end group -@end example -@end deffn - -@deffn Command re-search-backward regexp &optional limit noerror repeat -This function searches backward in the current buffer for a string of -text that is matched by the regular expression @var{regexp}, leaving -point at the beginning of the first text found. - -This function is analogous to @code{re-search-forward}, but they are not -simple mirror images. @code{re-search-forward} finds the match whose -beginning is as close as possible to the starting point. If -@code{re-search-backward} were a perfect mirror image, it would find the -match whose end is as close as possible. However, in fact it finds the -match whose beginning is as close as possible. The reason is that -matching a regular expression at a given spot always works from -beginning to end, and starts at a specified beginning position. - -A true mirror-image of @code{re-search-forward} would require a special -feature for matching regexps from end to beginning. It's not worth the -trouble of implementing that. -@end deffn - -@defun string-match regexp string &optional start -This function returns the index of the start of the first match for -the regular expression @var{regexp} in @var{string}, or @code{nil} if -there is no match. If @var{start} is non-@code{nil}, the search starts -at that index in @var{string}. - -For example, - -@example -@group -(string-match - "quick" "The quick brown fox jumped quickly.") - @result{} 4 -@end group -@group -(string-match - "quick" "The quick brown fox jumped quickly." 8) - @result{} 27 -@end group -@end example - -@noindent -The index of the first character of the -string is 0, the index of the second character is 1, and so on. - -After this function returns, the index of the first character beyond -the match is available as @code{(match-end 0)}. @xref{Match Data}. - -@example -@group -(string-match - "quick" "The quick brown fox jumped quickly." 8) - @result{} 27 -@end group - -@group -(match-end 0) - @result{} 32 -@end group -@end example -@end defun - -@defun split-string string &optional pattern -This function splits @var{string} to substrings delimited by -@var{pattern}, and returns a list of substrings. If @var{pattern} is -omitted, it defaults to @samp{[ \f\t\n\r\v]+}, which means that it -splits @var{string} by white--space. - -@example -@group -(split-string "foo bar") - @result{} ("foo" "bar") -@end group - -@group -(split-string "something") - @result{} ("something") -@end group - -@group -(split-string "a:b:c" ":") - @result{} ("a" "b" "c") -@end group - -@group -(split-string ":a::b:c" ":") - @result{} ("" "a" "" "b" "c") -@end group -@end example -@end defun - -@defun split-path path -This function splits a search path into a list of strings. The path -components are separated with the characters specified with -@code{path-separator}. Under Unix, @code{path-separator} will normally -be @samp{:}, while under Windows, it will be @samp{;}. -@end defun - -@defun looking-at regexp -This function determines whether the text in the current buffer directly -following point matches the regular expression @var{regexp}. ``Directly -following'' means precisely that: the search is ``anchored'' and it can -succeed only starting with the first character following point. The -result is @code{t} if so, @code{nil} otherwise. - -This function does not move point, but it updates the match data, which -you can access using @code{match-beginning} and @code{match-end}. -@xref{Match Data}. - -In this example, point is located directly before the @samp{T}. If it -were anywhere else, the result would be @code{nil}. - -@example -@group ----------- Buffer: foo ---------- -I read "@point{}The cat in the hat -comes back" twice. ----------- Buffer: foo ---------- - -(looking-at "The cat in the hat$") - @result{} t -@end group -@end example -@end defun - -@node POSIX Regexps -@section POSIX Regular Expression Searching - - The usual regular expression functions do backtracking when necessary -to handle the @samp{\|} and repetition constructs, but they continue -this only until they find @emph{some} match. Then they succeed and -report the first match found. - - This section describes alternative search functions which perform the -full backtracking specified by the POSIX standard for regular expression -matching. They continue backtracking until they have tried all -possibilities and found all matches, so they can report the longest -match, as required by POSIX. This is much slower, so use these -functions only when you really need the longest match. - - In Emacs versions prior to 19.29, these functions did not exist, and -the functions described above implemented full POSIX backtracking. - -@defun posix-search-forward regexp &optional limit noerror repeat -This is like @code{re-search-forward} except that it performs the full -backtracking specified by the POSIX standard for regular expression -matching. -@end defun - -@defun posix-search-backward regexp &optional limit noerror repeat -This is like @code{re-search-backward} except that it performs the full -backtracking specified by the POSIX standard for regular expression -matching. -@end defun - -@defun posix-looking-at regexp -This is like @code{looking-at} except that it performs the full -backtracking specified by the POSIX standard for regular expression -matching. -@end defun - -@defun posix-string-match regexp string &optional start -This is like @code{string-match} except that it performs the full -backtracking specified by the POSIX standard for regular expression -matching. -@end defun - -@ignore -@deffn Command delete-matching-lines regexp -This function is identical to @code{delete-non-matching-lines}, save -that it deletes what @code{delete-non-matching-lines} keeps. - -In the example below, point is located on the first line of text. - -@example -@group ----------- Buffer: foo ---------- -We hold these truths -to be self-evident, -that all men are created -equal, and that they are ----------- Buffer: foo ---------- -@end group - -@group -(delete-matching-lines "the") - @result{} nil - ----------- Buffer: foo ---------- -to be self-evident, -that all men are created ----------- Buffer: foo ---------- -@end group -@end example -@end deffn - -@deffn Command flush-lines regexp -This function is the same as @code{delete-matching-lines}. -@end deffn - -@defun delete-non-matching-lines regexp -This function deletes all lines following point which don't -contain a match for the regular expression @var{regexp}. -@end defun - -@deffn Command keep-lines regexp -This function is the same as @code{delete-non-matching-lines}. -@end deffn - -@deffn Command how-many regexp -This function counts the number of matches for @var{regexp} there are in -the current buffer following point. It prints this number in -the echo area, returning the string printed. -@end deffn - -@deffn Command count-matches regexp -This function is a synonym of @code{how-many}. -@end deffn - -@deffn Command list-matching-lines regexp nlines -This function is a synonym of @code{occur}. -Show all lines following point containing a match for @var{regexp}. -Display each line with @var{nlines} lines before and after, -or @code{-}@var{nlines} before if @var{nlines} is negative. -@var{nlines} defaults to @code{list-matching-lines-default-context-lines}. -Interactively it is the prefix arg. - -The lines are shown in a buffer named @samp{*Occur*}. -It serves as a menu to find any of the occurrences in this buffer. -@kbd{C-h m} (@code{describe-mode} in that buffer gives help. -@end deffn - -@defopt list-matching-lines-default-context-lines -Default value is 0. -Default number of context lines to include around a @code{list-matching-lines} -match. A negative number means to include that many lines before the match. -A positive number means to include that many lines both before and after. -@end defopt -@end ignore - -@node Search and Replace -@section Search and Replace -@cindex replacement - -@defun perform-replace from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map -This function is the guts of @code{query-replace} and related commands. -It searches for occurrences of @var{from-string} and replaces some or -all of them. If @var{query-flag} is @code{nil}, it replaces all -occurrences; otherwise, it asks the user what to do about each one. - -If @var{regexp-flag} is non-@code{nil}, then @var{from-string} is -considered a regular expression; otherwise, it must match literally. If -@var{delimited-flag} is non-@code{nil}, then only replacements -surrounded by word boundaries are considered. - -The argument @var{replacements} specifies what to replace occurrences -with. If it is a string, that string is used. It can also be a list of -strings, to be used in cyclic order. - -If @var{repeat-count} is non-@code{nil}, it should be an integer. Then -it specifies how many times to use each of the strings in the -@var{replacements} list before advancing cyclicly to the next one. - -Normally, the keymap @code{query-replace-map} defines the possible user -responses for queries. The argument @var{map}, if non-@code{nil}, is a -keymap to use instead of @code{query-replace-map}. -@end defun - -@defvar query-replace-map -This variable holds a special keymap that defines the valid user -responses for @code{query-replace} and related functions, as well as -@code{y-or-n-p} and @code{map-y-or-n-p}. It is unusual in two ways: - -@itemize @bullet -@item -The ``key bindings'' are not commands, just symbols that are meaningful -to the functions that use this map. - -@item -Prefix keys are not supported; each key binding must be for a single event -key sequence. This is because the functions don't use read key sequence to -get the input; instead, they read a single event and look it up ``by hand.'' -@end itemize -@end defvar - -Here are the meaningful ``bindings'' for @code{query-replace-map}. -Several of them are meaningful only for @code{query-replace} and -friends. - -@table @code -@item act -Do take the action being considered---in other words, ``yes.'' - -@item skip -Do not take action for this question---in other words, ``no.'' - -@item exit -Answer this question ``no,'' and give up on the entire series of -questions, assuming that the answers will be ``no.'' - -@item act-and-exit -Answer this question ``yes,'' and give up on the entire series of -questions, assuming that subsequent answers will be ``no.'' - -@item act-and-show -Answer this question ``yes,'' but show the results---don't advance yet -to the next question. - -@item automatic -Answer this question and all subsequent questions in the series with -``yes,'' without further user interaction. - -@item backup -Move back to the previous place that a question was asked about. - -@item edit -Enter a recursive edit to deal with this question---instead of any -other action that would normally be taken. - -@item delete-and-edit -Delete the text being considered, then enter a recursive edit to replace -it. - -@item recenter -Redisplay and center the window, then ask the same question again. - -@item quit -Perform a quit right away. Only @code{y-or-n-p} and related functions -use this answer. - -@item help -Display some help, then ask again. -@end table - -@node Match Data -@section The Match Data -@cindex match data - - XEmacs keeps track of the positions of the start and end of segments of -text found during a regular expression search. This means, for example, -that you can search for a complex pattern, such as a date in an Rmail -message, and then extract parts of the match under control of the -pattern. - - Because the match data normally describe the most recent search only, -you must be careful not to do another search inadvertently between the -search you wish to refer back to and the use of the match data. If you -can't avoid another intervening search, you must save and restore the -match data around it, to prevent it from being overwritten. - -@menu -* Simple Match Data:: Accessing single items of match data, - such as where a particular subexpression started. -* Replacing Match:: Replacing a substring that was matched. -* Entire Match Data:: Accessing the entire match data at once, as a list. -* Saving Match Data:: Saving and restoring the match data. -@end menu - -@node Simple Match Data -@subsection Simple Match Data Access - - This section explains how to use the match data to find out what was -matched by the last search or match operation. - - You can ask about the entire matching text, or about a particular -parenthetical subexpression of a regular expression. The @var{count} -argument in the functions below specifies which. If @var{count} is -zero, you are asking about the entire match. If @var{count} is -positive, it specifies which subexpression you want. - - Recall that the subexpressions of a regular expression are those -expressions grouped with escaped parentheses, @samp{\(@dots{}\)}. The -@var{count}th subexpression is found by counting occurrences of -@samp{\(} from the beginning of the whole regular expression. The first -subexpression is numbered 1, the second 2, and so on. Only regular -expressions can have subexpressions---after a simple string search, the -only information available is about the entire match. - -@defun match-string count &optional in-string -This function returns, as a string, the text matched in the last search -or match operation. It returns the entire text if @var{count} is zero, -or just the portion corresponding to the @var{count}th parenthetical -subexpression, if @var{count} is positive. If @var{count} is out of -range, or if that subexpression didn't match anything, the value is -@code{nil}. - -If the last such operation was done against a string with -@code{string-match}, then you should pass the same string as the -argument @var{in-string}. Otherwise, after a buffer search or match, -you should omit @var{in-string} or pass @code{nil} for it; but you -should make sure that the current buffer when you call -@code{match-string} is the one in which you did the searching or -matching. -@end defun - -@defun match-beginning count -This function returns the position of the start of text matched by the -last regular expression searched for, or a subexpression of it. - -If @var{count} is zero, then the value is the position of the start of -the entire match. Otherwise, @var{count} specifies a subexpression in -the regular expression, and the value of the function is the starting -position of the match for that subexpression. - -The value is @code{nil} for a subexpression inside a @samp{\|} -alternative that wasn't used in the match. -@end defun - -@defun match-end count -This function is like @code{match-beginning} except that it returns the -position of the end of the match, rather than the position of the -beginning. -@end defun - - Here is an example of using the match data, with a comment showing the -positions within the text: - -@example -@group -(string-match "\\(qu\\)\\(ick\\)" - "The quick fox jumped quickly.") - ;0123456789 - @result{} 4 -@end group - -@group -(match-string 0 "The quick fox jumped quickly.") - @result{} "quick" -(match-string 1 "The quick fox jumped quickly.") - @result{} "qu" -(match-string 2 "The quick fox jumped quickly.") - @result{} "ick" -@end group - -@group -(match-beginning 1) ; @r{The beginning of the match} - @result{} 4 ; @r{with @samp{qu} is at index 4.} -@end group - -@group -(match-beginning 2) ; @r{The beginning of the match} - @result{} 6 ; @r{with @samp{ick} is at index 6.} -@end group - -@group -(match-end 1) ; @r{The end of the match} - @result{} 6 ; @r{with @samp{qu} is at index 6.} - -(match-end 2) ; @r{The end of the match} - @result{} 9 ; @r{with @samp{ick} is at index 9.} -@end group -@end example - - Here is another example. Point is initially located at the beginning -of the line. Searching moves point to between the space and the word -@samp{in}. The beginning of the entire match is at the 9th character of -the buffer (@samp{T}), and the beginning of the match for the first -subexpression is at the 13th character (@samp{c}). - -@example -@group -(list - (re-search-forward "The \\(cat \\)") - (match-beginning 0) - (match-beginning 1)) - @result{} (9 9 13) -@end group - -@group ----------- Buffer: foo ---------- -I read "The cat @point{}in the hat comes back" twice. - ^ ^ - 9 13 ----------- Buffer: foo ---------- -@end group -@end example - -@noindent -(In this case, the index returned is a buffer position; the first -character of the buffer counts as 1.) - -@node Replacing Match -@subsection Replacing the Text That Matched - - This function replaces the text matched by the last search with -@var{replacement}. - -@cindex case in replacements -@defun replace-match replacement &optional fixedcase literal string -This function replaces the text in the buffer (or in @var{string}) that -was matched by the last search. It replaces that text with -@var{replacement}. - -If you did the last search in a buffer, you should specify @code{nil} -for @var{string}. Then @code{replace-match} does the replacement by -editing the buffer; it leaves point at the end of the replacement text, -and returns @code{t}. - -If you did the search in a string, pass the same string as @var{string}. -Then @code{replace-match} does the replacement by constructing and -returning a new string. - -If @var{fixedcase} is non-@code{nil}, then the case of the replacement -text is not changed; otherwise, the replacement text is converted to a -different case depending upon the capitalization of the text to be -replaced. If the original text is all upper case, the replacement text -is converted to upper case. If the first word of the original text is -capitalized, then the first word of the replacement text is capitalized. -If the original text contains just one word, and that word is a capital -letter, @code{replace-match} considers this a capitalized first word -rather than all upper case. - -If @code{case-replace} is @code{nil}, then case conversion is not done, -regardless of the value of @var{fixed-case}. @xref{Searching and Case}. - -If @var{literal} is non-@code{nil}, then @var{replacement} is inserted -exactly as it is, the only alterations being case changes as needed. -If it is @code{nil} (the default), then the character @samp{\} is treated -specially. If a @samp{\} appears in @var{replacement}, then it must be -part of one of the following sequences: - -@table @asis -@item @samp{\&} -@cindex @samp{&} in replacement -@samp{\&} stands for the entire text being replaced. - -@item @samp{\@var{n}} -@cindex @samp{\@var{n}} in replacement -@samp{\@var{n}}, where @var{n} is a digit, stands for the text that -matched the @var{n}th subexpression in the original regexp. -Subexpressions are those expressions grouped inside @samp{\(@dots{}\)}. - -@item @samp{\\} -@cindex @samp{\} in replacement -@samp{\\} stands for a single @samp{\} in the replacement text. -@end table -@end defun - -@node Entire Match Data -@subsection Accessing the Entire Match Data - - The functions @code{match-data} and @code{set-match-data} read or -write the entire match data, all at once. - -@defun match-data -This function returns a newly constructed list containing all the -information on what text the last search matched. Element zero is the -position of the beginning of the match for the whole expression; element -one is the position of the end of the match for the expression. The -next two elements are the positions of the beginning and end of the -match for the first subexpression, and so on. In general, element -@ifinfo -number 2@var{n} -@end ifinfo -@tex -number {\mathsurround=0pt $2n$} -@end tex -corresponds to @code{(match-beginning @var{n})}; and -element -@ifinfo -number 2@var{n} + 1 -@end ifinfo -@tex -number {\mathsurround=0pt $2n+1$} -@end tex -corresponds to @code{(match-end @var{n})}. - -All the elements are markers or @code{nil} if matching was done on a -buffer, and all are integers or @code{nil} if matching was done on a -string with @code{string-match}. (In Emacs 18 and earlier versions, -markers were used even for matching on a string, except in the case -of the integer 0.) - -As always, there must be no possibility of intervening searches between -the call to a search function and the call to @code{match-data} that is -intended to access the match data for that search. - -@example -@group -(match-data) - @result{} (# - # - # - #) -@end group -@end example -@end defun - -@defun set-match-data match-list -This function sets the match data from the elements of @var{match-list}, -which should be a list that was the value of a previous call to -@code{match-data}. - -If @var{match-list} refers to a buffer that doesn't exist, you don't get -an error; that sets the match data in a meaningless but harmless way. - -@findex store-match-data -@code{store-match-data} is an alias for @code{set-match-data}. -@end defun - -@node Saving Match Data -@subsection Saving and Restoring the Match Data - - When you call a function that may do a search, you may need to save -and restore the match data around that call, if you want to preserve the -match data from an earlier search for later use. Here is an example -that shows the problem that arises if you fail to save the match data: - -@example -@group -(re-search-forward "The \\(cat \\)") - @result{} 48 -(foo) ; @r{Perhaps @code{foo} does} - ; @r{more searching.} -(match-end 0) - @result{} 61 ; @r{Unexpected result---not 48!} -@end group -@end example - - You can save and restore the match data with @code{save-match-data}: - -@defmac save-match-data body@dots{} -This special form executes @var{body}, saving and restoring the match -data around it. -@end defmac - - You can use @code{set-match-data} together with @code{match-data} to -imitate the effect of the special form @code{save-match-data}. This is -useful for writing code that can run in Emacs 18. Here is how: - -@example -@group -(let ((data (match-data))) - (unwind-protect - @dots{} ; @r{May change the original match data.} - (set-match-data data))) -@end group -@end example - - Emacs automatically saves and restores the match data when it runs -process filter functions (@pxref{Filter Functions}) and process -sentinels (@pxref{Sentinels}). - -@ignore - Here is a function which restores the match data provided the buffer -associated with it still exists. - -@smallexample -@group -(defun restore-match-data (data) -@c It is incorrect to split the first line of a doc string. -@c If there's a problem here, it should be solved in some other way. - "Restore the match data DATA unless the buffer is missing." - (catch 'foo - (let ((d data)) -@end group - (while d - (and (car d) - (null (marker-buffer (car d))) -@group - ;; @file{match-data} @r{buffer is deleted.} - (throw 'foo nil)) - (setq d (cdr d))) - (set-match-data data)))) -@end group -@end smallexample -@end ignore - -@node Searching and Case -@section Searching and Case -@cindex searching and case - - By default, searches in Emacs ignore the case of the text they are -searching through; if you specify searching for @samp{FOO}, then -@samp{Foo} or @samp{foo} is also considered a match. Regexps, and in -particular character sets, are included: thus, @samp{[aB]} would match -@samp{a} or @samp{A} or @samp{b} or @samp{B}. - - If you do not want this feature, set the variable -@code{case-fold-search} to @code{nil}. Then all letters must match -exactly, including case. This is a buffer-local variable; altering the -variable affects only the current buffer. (@xref{Intro to -Buffer-Local}.) Alternatively, you may change the value of -@code{default-case-fold-search}, which is the default value of -@code{case-fold-search} for buffers that do not override it. - - Note that the user-level incremental search feature handles case -distinctions differently. When given a lower case letter, it looks for -a match of either case, but when given an upper case letter, it looks -for an upper case letter only. But this has nothing to do with the -searching functions Lisp functions use. - -@defopt case-replace -This variable determines whether the replacement functions should -preserve case. If the variable is @code{nil}, that means to use the -replacement text verbatim. A non-@code{nil} value means to convert the -case of the replacement text according to the text being replaced. - -The function @code{replace-match} is where this variable actually has -its effect. @xref{Replacing Match}. -@end defopt - -@defopt case-fold-search -This buffer-local variable determines whether searches should ignore -case. If the variable is @code{nil} they do not ignore case; otherwise -they do ignore case. -@end defopt - -@defvar default-case-fold-search -The value of this variable is the default value for -@code{case-fold-search} in buffers that do not override it. This is the -same as @code{(default-value 'case-fold-search)}. -@end defvar - -@node Standard Regexps -@section Standard Regular Expressions Used in Editing -@cindex regexps used standardly in editing -@cindex standard regexps used in editing - - This section describes some variables that hold regular expressions -used for certain purposes in editing: - -@defvar page-delimiter -This is the regexp describing line-beginnings that separate pages. The -default value is @code{"^\014"} (i.e., @code{"^^L"} or @code{"^\C-l"}); -this matches a line that starts with a formfeed character. -@end defvar - - The following two regular expressions should @emph{not} assume the -match always starts at the beginning of a line; they should not use -@samp{^} to anchor the match. Most often, the paragraph commands do -check for a match only at the beginning of a line, which means that -@samp{^} would be superfluous. When there is a nonzero left margin, -they accept matches that start after the left margin. In that case, a -@samp{^} would be incorrect. However, a @samp{^} is harmless in modes -where a left margin is never used. - -@defvar paragraph-separate -This is the regular expression for recognizing the beginning of a line -that separates paragraphs. (If you change this, you may have to -change @code{paragraph-start} also.) The default value is -@w{@code{"[@ \t\f]*$"}}, which matches a line that consists entirely of -spaces, tabs, and form feeds (after its left margin). -@end defvar - -@defvar paragraph-start -This is the regular expression for recognizing the beginning of a line -that starts @emph{or} separates paragraphs. The default value is -@w{@code{"[@ \t\n\f]"}}, which matches a line starting with a space, tab, -newline, or form feed (after its left margin). -@end defvar - -@defvar sentence-end -This is the regular expression describing the end of a sentence. (All -paragraph boundaries also end sentences, regardless.) The default value -is: - -@example -"[.?!][]\"')@}]*\\($\\| $\\|\t\\| \\)[ \t\n]*" -@end example - -This means a period, question mark or exclamation mark, followed -optionally by a closing parenthetical character, followed by tabs, -spaces or new lines. - -For a detailed explanation of this regular expression, see @ref{Regexp -Example}. -@end defvar diff --git a/man/lispref/sequences.texi b/man/lispref/sequences.texi deleted file mode 100644 index a7e1ad4..0000000 --- a/man/lispref/sequences.texi +++ /dev/null @@ -1,673 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c Copyright (C) 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/sequences.info -@node Sequences Arrays Vectors, Symbols, Lists, Top -@chapter Sequences, Arrays, and Vectors -@cindex sequence - - Recall that the @dfn{sequence} type is the union of four other Lisp -types: lists, vectors, bit vectors, and strings. In other words, any -list is a sequence, any vector is a sequence, any bit vector is a -sequence, and any string is a sequence. The common property that all -sequences have is that each is an ordered collection of elements. - - An @dfn{array} is a single primitive object that has a slot for each -elements. All the elements are accessible in constant time, but the -length of an existing array cannot be changed. Strings, vectors, and -bit vectors are the three types of arrays. - - A list is a sequence of elements, but it is not a single primitive -object; it is made of cons cells, one cell per element. Finding the -@var{n}th element requires looking through @var{n} cons cells, so -elements farther from the beginning of the list take longer to access. -But it is possible to add elements to the list, or remove elements. - - The following diagram shows the relationship between these types: - -@example -@group - ___________________________________ - | | - | Sequence | - | ______ ______________________ | - | | | | | | - | | List | | Array | | - | | | | ________ _______ | | - | |______| | | | | | | | - | | | Vector | | String| | | - | | |________| |_______| | | - | | __________________ | | - | | | | | | - | | | Bit Vector | | | - | | |__________________| | | - | |______________________| | - |___________________________________| -@end group -@end example - - The elements of vectors and lists may be any Lisp objects. The -elements of strings are all characters. The elements of bit vectors -are the numbers 0 and 1. - -@menu -* Sequence Functions:: Functions that accept any kind of sequence. -* Arrays:: Characteristics of arrays in XEmacs Lisp. -* Array Functions:: Functions specifically for arrays. -* Vectors:: Special characteristics of XEmacs Lisp vectors. -* Vector Functions:: Functions specifically for vectors. -* Bit Vectors:: Special characteristics of XEmacs Lisp bit vectors. -* Bit Vector Functions:: Functions specifically for bit vectors. -@end menu - -@node Sequence Functions -@section Sequences - - In XEmacs Lisp, a @dfn{sequence} is either a list, a vector, a bit -vector, or a string. The common property that all sequences have is -that each is an ordered collection of elements. This section describes -functions that accept any kind of sequence. - -@defun sequencep object -Returns @code{t} if @var{object} is a list, vector, bit vector, or -string, @code{nil} otherwise. -@end defun - -@defun copy-sequence sequence -@cindex copying sequences -Returns a copy of @var{sequence}. The copy is the same type of object -as the original sequence, and it has the same elements in the same order. - -Storing a new element into the copy does not affect the original -@var{sequence}, and vice versa. However, the elements of the new -sequence are not copies; they are identical (@code{eq}) to the elements -of the original. Therefore, changes made within these elements, as -found via the copied sequence, are also visible in the original -sequence. - -If the sequence is a string with extents or text properties, the extents -and text properties in the copy are also copied, not shared with the -original. (This means that modifying the extents or text properties of -the original will not affect the copy.) However, the actual values of -the properties are shared. @xref{Extents}; @xref{Text Properties}. - -See also @code{append} in @ref{Building Lists}, @code{concat} in -@ref{Creating Strings}, @code{vconcat} in @ref{Vectors}, and -@code{bvconcat} in @ref{Bit Vectors}, for other ways to copy sequences. - -@example -@group -(setq bar '(1 2)) - @result{} (1 2) -@end group -@group -(setq x (vector 'foo bar)) - @result{} [foo (1 2)] -@end group -@group -(setq y (copy-sequence x)) - @result{} [foo (1 2)] -@end group - -@group -(eq x y) - @result{} nil -@end group -@group -(equal x y) - @result{} t -@end group -@group -(eq (elt x 1) (elt y 1)) - @result{} t -@end group - -@group -;; @r{Replacing an element of one sequence.} -(aset x 0 'quux) -x @result{} [quux (1 2)] -y @result{} [foo (1 2)] -@end group - -@group -;; @r{Modifying the inside of a shared element.} -(setcar (aref x 1) 69) -x @result{} [quux (69 2)] -y @result{} [foo (69 2)] -@end group - -@group -;; @r{Creating a bit vector.} -(bit-vector 1 0 1 1 0 1 0 0) - @result{} #*10110100 -@end group -@end example -@end defun - -@defun length sequence -@cindex string length -@cindex list length -@cindex vector length -@cindex bit vector length -@cindex sequence length -Returns the number of elements in @var{sequence}. If @var{sequence} is -a cons cell that is not a list (because the final @sc{cdr} is not -@code{nil}), a @code{wrong-type-argument} error is signaled. - -@example -@group -(length '(1 2 3)) - @result{} 3 -@end group -@group -(length ()) - @result{} 0 -@end group -@group -(length "foobar") - @result{} 6 -@end group -@group -(length [1 2 3]) - @result{} 3 -@end group -@group -(length #*01101) - @result{} 5 -@end group -@end example -@end defun - -@defun elt sequence index -@cindex elements of sequences -This function returns the element of @var{sequence} indexed by -@var{index}. Legitimate values of @var{index} are integers ranging from -0 up to one less than the length of @var{sequence}. If @var{sequence} -is a list, then out-of-range values of @var{index} return @code{nil}; -otherwise, they trigger an @code{args-out-of-range} error. - -@example -@group -(elt [1 2 3 4] 2) - @result{} 3 -@end group -@group -(elt '(1 2 3 4) 2) - @result{} 3 -@end group -@group -(char-to-string (elt "1234" 2)) - @result{} "3" -@end group -@group -(elt #*00010000 3) - @result{} 1 -@end group -@group -(elt [1 2 3 4] 4) - @error{}Args out of range: [1 2 3 4], 4 -@end group -@group -(elt [1 2 3 4] -1) - @error{}Args out of range: [1 2 3 4], -1 -@end group -@end example - -This function generalizes @code{aref} (@pxref{Array Functions}) and -@code{nth} (@pxref{List Elements}). -@end defun - -@node Arrays -@section Arrays -@cindex array - - An @dfn{array} object has slots that hold a number of other Lisp -objects, called the elements of the array. Any element of an array may -be accessed in constant time. In contrast, an element of a list -requires access time that is proportional to the position of the element -in the list. - - When you create an array, you must specify how many elements it has. -The amount of space allocated depends on the number of elements. -Therefore, it is impossible to change the size of an array once it is -created; you cannot add or remove elements. However, you can replace an -element with a different value. - - XEmacs defines three types of array, all of which are one-dimensional: -@dfn{strings}, @dfn{vectors}, and @dfn{bit vectors}. A vector is a -general array; its elements can be any Lisp objects. A string is a -specialized array; its elements must be characters. A bit vector is -another specialized array; its elements must be bits (an integer, either -0 or 1). Each type of array has its own read syntax. @xref{String -Type}, @ref{Vector Type}, and @ref{Bit Vector Type}. - - All kinds of array share these characteristics: - -@itemize @bullet -@item -The first element of an array has index zero, the second element has -index 1, and so on. This is called @dfn{zero-origin} indexing. For -example, an array of four elements has indices 0, 1, 2, @w{and 3}. - -@item -The elements of an array may be referenced or changed with the functions -@code{aref} and @code{aset}, respectively (@pxref{Array Functions}). -@end itemize - - In principle, if you wish to have an array of text characters, you -could use either a string or a vector. In practice, we always choose -strings for such applications, for four reasons: - -@itemize @bullet -@item -They usually occupy one-fourth the space of a vector of the same -elements. (This is one-eighth the space for 64-bit machines such as the -DEC Alpha, and may also be different when @sc{MULE} support is compiled -into XEmacs.) - -@item -Strings are printed in a way that shows the contents more clearly -as characters. - -@item -Strings can hold extent and text properties. @xref{Extents}; @xref{Text -Properties}. - -@item -Many of the specialized editing and I/O facilities of XEmacs accept only -strings. For example, you cannot insert a vector of characters into a -buffer the way you can insert a string. @xref{Strings and Characters}. -@end itemize - - By contrast, for an array of keyboard input characters (such as a key -sequence), a vector may be necessary, because many keyboard input -characters are non-printable and are represented with symbols rather than -with characters. @xref{Key Sequence Input}. - - Similarly, when representing an array of bits, a bit vector has -the following advantages over a regular vector: - -@itemize @bullet -@item -They occupy 1/32nd the space of a vector of the same elements. -(1/64th on 64-bit machines such as the DEC Alpha.) - -@item -Bit vectors are printed in a way that shows the contents more clearly -as bits. -@end itemize - -@node Array Functions -@section Functions that Operate on Arrays - - In this section, we describe the functions that accept strings, vectors, -and bit vectors. - -@defun arrayp object -This function returns @code{t} if @var{object} is an array (i.e., a -string, vector, or bit vector). - -@example -@group -(arrayp "asdf") -@result{} t -(arrayp [a]) -@result{} t -(arrayp #*101) -@result{} t -@end group -@end example -@end defun - -@defun aref array index -@cindex array elements -This function returns the @var{index}th element of @var{array}. The -first element is at index zero. - -@example -@group -(setq primes [2 3 5 7 11 13]) - @result{} [2 3 5 7 11 13] -(aref primes 4) - @result{} 11 -(elt primes 4) - @result{} 11 -@end group - -@group -(aref "abcdefg" 1) - @result{} ?b -@end group - -@group -(aref #*1101 2) - @result{} 0 -@end group -@end example - -See also the function @code{elt}, in @ref{Sequence Functions}. -@end defun - -@defun aset array index object -This function sets the @var{index}th element of @var{array} to be -@var{object}. It returns @var{object}. - -@example -@group -(setq w [foo bar baz]) - @result{} [foo bar baz] -(aset w 0 'fu) - @result{} fu -w - @result{} [fu bar baz] -@end group - -@group -(setq x "asdfasfd") - @result{} "asdfasfd" -(aset x 3 ?Z) - @result{} ?Z -x - @result{} "asdZasfd" -@end group - -@group -(setq bv #*1111) - @result{} #*1111 -(aset bv 2 0) - @result{} 0 -bv - @result{} #*1101 -@end group -@end example - -If @var{array} is a string and @var{object} is not a character, a -@code{wrong-type-argument} error results. -@end defun - -@defun fillarray array object -This function fills the array @var{array} with @var{object}, so that -each element of @var{array} is @var{object}. It returns @var{array}. - -@example -@group -(setq a [a b c d e f g]) - @result{} [a b c d e f g] -(fillarray a 0) - @result{} [0 0 0 0 0 0 0] -a - @result{} [0 0 0 0 0 0 0] -@end group - -@group -(setq s "When in the course") - @result{} "When in the course" -(fillarray s ?-) - @result{} "------------------" -@end group - -@group -(setq bv #*1101) - @result{} #*1101 -(fillarray bv 0) - @result{} #*0000 -@end group -@end example - -If @var{array} is a string and @var{object} is not a character, a -@code{wrong-type-argument} error results. -@end defun - -The general sequence functions @code{copy-sequence} and @code{length} -are often useful for objects known to be arrays. @xref{Sequence Functions}. - -@node Vectors -@section Vectors -@cindex vector - - Arrays in Lisp, like arrays in most languages, are blocks of memory -whose elements can be accessed in constant time. A @dfn{vector} is a -general-purpose array; its elements can be any Lisp objects. (The other -kind of array in XEmacs Lisp is the @dfn{string}, whose elements must be -characters.) Vectors in XEmacs serve as obarrays (vectors of symbols), -although this is a shortcoming that should be fixed. They are also used -internally as part of the representation of a byte-compiled function; if -you print such a function, you will see a vector in it. - - In XEmacs Lisp, the indices of the elements of a vector start from zero -and count up from there. - - Vectors are printed with square brackets surrounding the elements. -Thus, a vector whose elements are the symbols @code{a}, @code{b} and -@code{a} is printed as @code{[a b a]}. You can write vectors in the -same way in Lisp input. - - A vector, like a string or a number, is considered a constant for -evaluation: the result of evaluating it is the same vector. This does -not evaluate or even examine the elements of the vector. -@xref{Self-Evaluating Forms}. - - Here are examples of these principles: - -@example -@group -(setq avector [1 two '(three) "four" [five]]) - @result{} [1 two (quote (three)) "four" [five]] -(eval avector) - @result{} [1 two (quote (three)) "four" [five]] -(eq avector (eval avector)) - @result{} t -@end group -@end example - -@node Vector Functions -@section Functions That Operate on Vectors - - Here are some functions that relate to vectors: - -@defun vectorp object -This function returns @code{t} if @var{object} is a vector. - -@example -@group -(vectorp [a]) - @result{} t -(vectorp "asdf") - @result{} nil -@end group -@end example -@end defun - -@defun vector &rest objects -This function creates and returns a vector whose elements are the -arguments, @var{objects}. - -@example -@group -(vector 'foo 23 [bar baz] "rats") - @result{} [foo 23 [bar baz] "rats"] -(vector) - @result{} [] -@end group -@end example -@end defun - -@defun make-vector length object -This function returns a new vector consisting of @var{length} elements, -each initialized to @var{object}. - -@example -@group -(setq sleepy (make-vector 9 'Z)) - @result{} [Z Z Z Z Z Z Z Z Z] -@end group -@end example -@end defun - -@defun vconcat &rest sequences -@cindex copying vectors -This function returns a new vector containing all the elements of the -@var{sequences}. The arguments @var{sequences} may be lists, vectors, -or strings. If no @var{sequences} are given, an empty vector is -returned. - -The value is a newly constructed vector that is not @code{eq} to any -existing vector. - -@example -@group -(setq a (vconcat '(A B C) '(D E F))) - @result{} [A B C D E F] -(eq a (vconcat a)) - @result{} nil -@end group -@group -(vconcat) - @result{} [] -(vconcat [A B C] "aa" '(foo (6 7))) - @result{} [A B C 97 97 foo (6 7)] -@end group -@end example - -The @code{vconcat} function also allows integers as arguments. It -converts them to strings of digits, making up the decimal print -representation of the integer, and then uses the strings instead of the -original integers. @strong{Don't use this feature; we plan to eliminate -it. If you already use this feature, change your programs now!} The -proper way to convert an integer to a decimal number in this way is with -@code{format} (@pxref{Formatting Strings}) or @code{number-to-string} -(@pxref{String Conversion}). - -For other concatenation functions, see @code{mapconcat} in @ref{Mapping -Functions}, @code{concat} in @ref{Creating Strings}, @code{append} -in @ref{Building Lists}, and @code{bvconcat} in @ref{Bit Vector Functions}. -@end defun - - The @code{append} function provides a way to convert a vector into a -list with the same elements (@pxref{Building Lists}): - -@example -@group -(setq avector [1 two (quote (three)) "four" [five]]) - @result{} [1 two (quote (three)) "four" [five]] -(append avector nil) - @result{} (1 two (quote (three)) "four" [five]) -@end group -@end example - -@node Bit Vectors -@section Bit Vectors -@cindex bit vector - - Bit vectors are specialized vectors that can only represent arrays -of 1's and 0's. Bit vectors have a very efficient representation -and are useful for representing sets of boolean (true or false) values. - - There is no limit on the size of a bit vector. You could, for example, -create a bit vector with 100,000 elements if you really wanted to. - - Bit vectors have a special printed representation consisting of -@samp{#*} followed by the bits of the vector. For example, a bit vector -whose elements are 0, 1, 1, 0, and 1, respectively, is printed as - -@example -#*01101 -@end example - - Bit vectors are considered constants for evaluation, like vectors, -strings, and numbers. @xref{Self-Evaluating Forms}. - -@node Bit Vector Functions -@section Functions That Operate on Bit Vectors - - Here are some functions that relate to bit vectors: - -@defun bit-vector-p object -This function returns @code{t} if @var{object} is a bit vector. - -@example -@group -(bit-vector-p #*01) - @result{} t -(bit-vector-p [0 1]) - @result{} nil -(bit-vector-p "01") - @result{} nil -@end group -@end example -@end defun - -@defun bitp object -This function returns @code{t} if @var{object} is either 0 or 1. -@end defun - -@defun bit-vector &rest objects -This function creates and returns a bit vector whose elements are the -arguments @var{objects}. The elements must be either of the two -integers 0 or 1. - -@example -@group -(bit-vector 0 0 0 1 0 0 0 0 1 0) - @result{} #*0001000010 -(bit-vector) - @result{} #* -@end group -@end example -@end defun - -@defun make-bit-vector length object -This function creates and returns a bit vector consisting of -@var{length} elements, each initialized to @var{object}. - -@example -@group -(setq picket-fence (make-bit-vector 9 1)) - @result{} #*111111111 -@end group -@end example -@end defun - -@defun bvconcat &rest sequences -@cindex copying bit vectors -This function returns a new bit vector containing all the elements of -the @var{sequences}. The arguments @var{sequences} may be lists, -vectors, or bit vectors, all of whose elements are the integers 0 or 1. -If no @var{sequences} are given, an empty bit vector is returned. - -The value is a newly constructed bit vector that is not @code{eq} to any -existing bit vector. - -@example -@group -(setq a (bvconcat '(1 1 0) '(0 0 1))) - @result{} #*110001 -(eq a (bvconcat a)) - @result{} nil -@end group -@group -(bvconcat) - @result{} #* -(bvconcat [1 0 0 0 0] #*111 '(0 0 0 0 1)) - @result{} #*1000011100001 -@end group -@end example - -For other concatenation functions, see @code{mapconcat} in @ref{Mapping -Functions}, @code{concat} in @ref{Creating Strings}, @code{vconcat} in -@ref{Vector Functions}, and @code{append} in @ref{Building Lists}. -@end defun - - The @code{append} function provides a way to convert a bit vector into a -list with the same elements (@pxref{Building Lists}): - -@example -@group -(setq bv #*00001110) - @result{} #*00001110 -(append bv nil) - @result{} (0 0 0 0 1 1 1 0) -@end group -@end example diff --git a/man/lispref/specifiers.texi b/man/lispref/specifiers.texi deleted file mode 100644 index 43d9088..0000000 --- a/man/lispref/specifiers.texi +++ /dev/null @@ -1,1103 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995, 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/specifiers.info -@node Specifiers, Faces and Window-System Objects, Extents, top -@chapter Specifiers -@cindex specifier - -A specifier is an object used to keep track of a property whose value -may vary depending on the particular situation (e.g. particular buffer -displayed in a particular window) that it is used in. The value of many -built-in properties, such as the font, foreground, background, and such -properties of a face and variables such as -@code{modeline-shadow-thickness} and @code{top-toolbar-height}, is -actually a specifier object. The specifier object, in turn, is -``instanced'' in a particular situation to yield the real value -of the property in that situation. - -@defun specifierp object -This function returns non-@code{nil} if @var{object} is a specifier. -@end defun - -@menu -* Introduction to Specifiers:: Specifiers provide a clean way for - display and other properties to vary - (under user control) in a wide variety - of contexts. -* Specifiers In-Depth:: Gory details about specifier innards. -* Specifier Instancing:: Instancing means obtaining the ``value'' of - a specifier in a particular context. -* Specifier Types:: Specifiers come in different flavors. -* Adding Specifications:: Specifications control a specifier's ``value'' - by giving conditions under which a - particular value is valid. -* Retrieving Specifications:: Querying a specifier's specifications. -* Specifier Tag Functions:: Working with specifier tags. -* Specifier Instancing Functions:: - Functions to instance a specifier. -* Specifier Example:: Making all this stuff clearer. -* Creating Specifiers:: Creating specifiers for your own use. -* Specifier Validation Functions:: - Validating the components of a specifier. -* Other Specification Functions:: - Other ways of working with specifications. -@end menu - -@node Introduction to Specifiers -@section Introduction to Specifiers - -Sometimes you may want the value of a property to vary depending on -the context the property is used in. A simple example of this in XEmacs -is buffer-local variables. For example, the variable -@code{modeline-format}, which controls the format of the modeline, can -have different values depending on the particular buffer being edited. -The variable has a default value which most modes will use, but a -specialized package such as Calendar might change the variable so -as to tailor the modeline to its own purposes. - -Other properties (such as those that can be changed by the -@code{modify-frame-parameters} function, for example the color of the -text cursor) can have frame-local values, although it might also make -sense for them to have buffer-local values. In other cases, you might -want the property to vary depending on the particular window within the -frame that applies (e.g. the top or bottom window in a split frame), the -device type that that frame appears on (X or tty), etc. Perhaps you can -envision some more complicated scenario where you want a particular -value in a specified buffer, another value in all other buffers -displayed on a particular frame, another value in all other buffers -displayed in all other frames on any mono (two-color, e.g. black and -white only) displays, and a default value in all other circumstances. - -A @dfn{specifier} is a generalization of this, allowing a great deal -of flexibility in controlling exactly what value a property has in which -circumstances. It is most commonly used for display properties, such as -an image or the foreground color of a face. As a simple example, you can -specify that the foreground of the default face be - -@itemize @bullet -@item -blue for a particular buffer -@item -green for all other buffers -@end itemize - -As a more complicated example, you could specify that the foreground of -the default face be - -@itemize @bullet -@item -forest green for all buffers displayed in a particular Emacs window, or -green if the X server doesn't recognize the color @samp{forest green} -@item -blue for all buffers displayed in a particular frame -@item -red for all other buffers displayed on a color device -@item -white for all other buffers -@end itemize - -@node Specifiers In-Depth -@section In-Depth Overview of a Specifier -@cindex specification (in a specifier) -@cindex domain (in a specifier) -@cindex locale (in a specifier) -@cindex instantiator (in a specifier) -@cindex instancing (in a specifier) -@cindex instance (in a specifier) -@cindex inst-list (in a specifier) -@cindex inst-pair (in a specifier) -@cindex tag (in a specifier) -@cindex tag set (in a specifier) -@cindex specifier, specification -@cindex specifier, domain -@cindex specifier, locale -@cindex specifier, instantiator -@cindex specifier, instancing -@cindex specifier, instance -@cindex specifier, inst-list -@cindex specifier, inst-pair -@cindex specifier, tag -@cindex specifier, tag set - -A specifier object encapsulates a set of @dfn{specifications}, each of -which says what its value should be if a particular condition applies. -For example, one specification might be ``The value should be -darkseagreen2 on X devices'' another might be ``The value should be blue -in the *Help* buffer''. In specifier terminology, these conditions are -called @dfn{locales} and the values are called @dfn{instantiators}. -Given a specifier, a logical question is ``What is its value in a -particular situation?'' This involves looking through the specifications -to see which ones apply to this particular situation, and perhaps -preferring one over another if more than one applies. In specifier -terminology, a ``particular situation'' is called a @dfn{domain}, and -determining its value in a particular domain is called @dfn{instancing}. -Most of the time, a domain is identified by a particular window. For -example, if the redisplay engine is drawing text in the default face in -a particular window, it retrieves the specifier for the foreground color -of the default face and @dfn{instances} it in the domain given by that -window; in other words, it asks the specifier, ``What is your value in -this window?''. - -More specifically, a specifier contains a set of @dfn{specifications}, -each of which associates a @dfn{locale} (a window object, a buffer -object, a frame object, a device object, or the symbol @code{global}) -with an @dfn{inst-list}, which is a list of one or more -@dfn{inst-pairs}. (For each possible locale, there can be at most one -specification containing that locale.) Each inst-pair is a cons of a -@dfn{tag set} (an unordered list of zero or more symbols, or @dfn{tags}) -and an @dfn{instantiator} (the allowed form of this varies depending on -the type of specifier). In a given specification, there may be more -than one inst-pair with the same tag set; this is unlike for locales. - -The tag set is used to restrict the sorts of devices over which the -instantiator is valid and to uniquely identify instantiators added by a -particular application, so that different applications can work on the -same specifier and not interfere with each other. Each tag can have a -@dfn{predicate} associated with it, which is a function of one argument -(a device) that specifies whether the tag matches that particular -device. (If a tag does not have a predicate, it matches all devices.) -All tags in a tag set must match a device for the associated inst-pair -to be instantiable over that device. (A null tag set is perfectly -valid.) - -The valid device types (normally @code{x}, @code{tty}, and -@code{stream}) and device classes (normally @code{color}, -@code{grayscale}, and @code{mono}) can always be used as tags, and match -devices of the associated type or class (@pxref{Consoles and Devices}). -User-defined tags may be defined, with an optional predicate specified. -An application can create its own tag, use it to mark all its -instantiators, and be fairly confident that it will not interfere with -other applications that modify the same specifier -- Functions that add -a specification to a specifier usually only overwrite existing -inst-pairs with the same tag set as was given, and a particular tag or -tag set can be specified when removing instantiators. - -When a specifier is instanced in a domain, both the locale and the tag -set can be viewed as specifying necessary conditions that must apply in -that domain for an instantiator to be considered as a possible result of -the instancing. More specific locales always override more general -locales (thus, there is no particular ordering of the specifications in -a specifier); however, the tag sets are simply considered in the order -that the inst-pairs occur in the specification's inst-list. - -Note also that the actual object that results from the instancing -(called an @dfn{instance object}) may not be the same as the instantiator -from which it was derived. For some specifier types (such as integer -specifiers and boolean specifiers), the instantiator will be returned -directly as the instance object. For other types, however, this -is not the case. For example, for font specifiers, the instantiator -is a font-description string and the instance object is a font-instance -object, which describes how the font is displayed on a particular device. -A font-instance object encapsulates such things as the actual font name -used to display the font on that device (a font-description string -under X is usually a wildcard specification that may resolve to -different font names, with possibly different foundries, widths, etc., -on different devices), the extra properties of that font on that -device, etc. Furthermore, this conversion (called @dfn{instantiation}) -might fail -- a font or color might not exist on a particular device, -for example. - -@node Specifier Instancing -@section How a Specifier Is Instanced -@cindex fallback (in a specifier) -@cindex specifier, fallback - -Instancing of a specifier in a particular window domain proceeds as -follows: - -@itemize @bullet -@item -First, XEmacs searches for a specification whose locale is the same as -the window. If that fails, the search is repeated, looking for a locale -that is the same as the window's buffer. If that fails, the search is -repeated using the window's frame, then using the device that frame is -on. Finally, the specification whose locale is the symbol @code{global} -(if there is such a specification) is considered. -@item -The inst-pairs contained in the specification that was found are -considered in their order in the inst-list, looking for one whose tag -set matches the device that is derived from the window domain. (The -tag set is an unordered list of zero or more tag symbols. For all -tags that have predicates associated with them, the predicate must -match the device.) -@item -If a matching tag set is found, the corresponding instantiator is passed -to the specifier's instantiation method, which is specific to the type -of the specifier. If it succeeds, the resulting instance object is -returned as the result of the instancing and the instancing is done. -Otherwise, the operation continues, looking for another matching -inst-pair in the current specification. -@item -When there are no more inst-pairs to be considered in the current -specification, the search starts over, looking for another specification -as in the first step above. -@item -If all specifications are exhausted and no instance object can be -derived, the instancing fails. (Actually, this is not completely true. -Some specifier objects for built-in properties have a @dfn{fallback} -value, which is either an inst-list or another specifier object, that is -consulted if the instancing is about to fail. If it is an inst-list, -the searching proceeds using the inst-pairs in that list. If it is a -specifier, the entire instancing starts over using that specifier -instead of the given one. Fallback values are set by the C code and -cannot be modified, except perhaps indirectly, using any Lisp functions. -The purpose of them is to supply some values to make sure that -instancing of built-in properties can't fail and to implement some basic -specifier inheritance, such as the fact that faces inherit their -properties from the @code{default} face.) -@end itemize - -It is also possible to instance a specifier over a frame domain or -device domain instead of over a window domain. The C code, for example, -instances the @code{top-toolbar-height} variable over a frame domain in -order to determine the height of a frame's top toolbar. Instancing over -a frame or device is similar to instancing over a window except that -specifications for locales that cannot be derived from the domain are -ignored. Specifically, instancing over a frame looks first for frame -locales, then device locales, then the @code{global} locale. Instancing -over a device domain looks only for device locales and the @code{global} -locale. - -@node Specifier Types -@section Specifier Types - -There are various different types of specifiers. The type of a -specifier controls what sorts of instantiators are valid, how an -instantiator is instantiated, etc. Here is a list of built-in specifier -types: - -@table @code -@item boolean -The valid instantiators are the symbols @code{t} and @code{nil}. -Instance objects are the same as instantiators so no special -instantiation function is needed. - -@item integer -The valid instantiators are integers. Instance objects are the same as -instantiators so no special instantiation function is needed. -@code{modeline-shadow-thickness} is an example of an integer specifier -(negative thicknesses indicate that the shadow is drawn recessed instead -of raised). - -@item natnum -The valid instantiators are natnums (non-negative integers). Instance -objects are the same as instantiators so no special instantiation -function is needed. Natnum specifiers are used for dimension variables -such as @code{top-toolbar-height}. - -@item generic -All Lisp objects are valid instantiators. Instance objects are the same -as instantiators so no special instantiation function is needed. - -@item font -The valid instantiators are strings describing fonts or vectors -indicating inheritance from the font of some face. Instance objects are -font-instance objects, which are specific to a particular device. The -instantiation method for font specifiers can fail, unlike for integer, -natnum, boolean, and generic specifiers. - -@item color -The valid instantiators are strings describing colors or vectors -indicating inheritance from the foreground or background of some face. -Instance objects are color-instance objects, which are specific to a -particular device. The instantiation method for color specifiers can fail, -as for font specifiers. - -@item image -Images are perhaps the most complicated type of built-in specifier. The -valid instantiators are strings (a filename, inline data for a pixmap, -or text to be displayed in a text glyph) or vectors describing inline -data of various sorts or indicating inheritance from the -background-pixmap property of some face. Instance objects are either -strings (for text images), image-instance objects (for pixmap images), -or subwindow objects (for subwindow images). The instantiation method -for image specifiers can fail, as for font and color specifiers. - -@item face-boolean -The valid instantiators are the symbols @code{t} and @code{nil} and -vectors indicating inheritance from a boolean property of some face. -Specifiers of this sort are used for all of the built-in boolean -properties of faces. Instance objects are either the symbol @code{t} -or the symbol @code{nil}. - -@item toolbar -The valid instantiators are toolbar descriptors, which are lists -of toolbar-button descriptors (each of which is a vector of two -or four elements). @xref{Toolbar} for more information. -@end table - -Color and font instance objects can also be used in turn as -instantiators for a new color or font instance object. Since these -instance objects are device-specific, the instantiator can be used -directly as the new instance object, but only if they are of the same -device. If the devices differ, the base color or font of the -instantiating object is effectively used instead as the instantiator. - -@xref{Faces and Window-System Objects} for more information on fonts, -colors, and face-boolean specifiers. @xref{Glyphs} for more information -about image specifiers. @xref{Toolbar} for more information on toolbar -specifiers. - -@defun specifier-type specifier -This function returns the type of @var{specifier}. The returned value -will be a symbol: one of @code{integer}, @code{boolean}, etc., as -listed in the above table. -@end defun - -Functions are also provided to query whether an object is a particular -kind of specifier: - -@defun boolean-specifier-p object -This function returns non-@code{nil} if @var{object} is a boolean -specifier. -@end defun - -@defun integer-specifier-p object -This function returns non-@code{nil} if @var{object} is an integer -specifier. -@end defun - -@defun natnum-specifier-p object -This function returns non-@code{nil} if @var{object} is a natnum -specifier. -@end defun - -@defun generic-specifier-p object -This function returns non-@code{nil} if @var{object} is a generic -specifier. -@end defun - -@defun face-boolean-specifier-p object -This function returns non-@code{nil} if @var{object} is a face-boolean -specifier. -@end defun - -@defun toolbar-specifier-p object -This function returns non-@code{nil} if @var{object} is a toolbar -specifier. -@end defun - -@defun font-specifier-p object -This function returns non-@code{nil} if @var{object} is a font -specifier. -@end defun - -@defun color-specifier-p object -This function returns non-@code{nil} if @var{object} is a color -specifier. -@end defun - -@defun image-specifier-p object -This function returns non-@code{nil} if @var{object} is an image -specifier. -@end defun - -@node Adding Specifications -@section Adding specifications to a Specifier - -@defun add-spec-to-specifier specifier instantiator &optional locale tag-set how-to-add -This function adds a specification to @var{specifier}. The -specification maps from @var{locale} (which should be a window, buffer, -frame, device, or the symbol @code{global}, and defaults to -@code{global}) to @var{instantiator}, whose allowed values depend on the -type of the specifier. Optional argument @var{tag-set} limits the -instantiator to apply only to the specified tag set, which should be a -list of tags all of which must match the device being instantiated over -(tags are a device type, a device class, or tags defined with -@code{define-specifier-tag}). Specifying a single symbol for -@var{tag-set} is equivalent to specifying a one-element list containing -that symbol. Optional argument @var{how-to-add} specifies what to do if -there are already specifications in the specifier. It should be one of - -@table @code -@item prepend -Put at the beginning of the current list of instantiators for @var{locale}. -@item append -Add to the end of the current list of instantiators for @var{locale}. -@item remove-tag-set-prepend -This is the default. Remove any existing instantiators whose tag set is -the same as @var{tag-set}; then put the new instantiator at the -beginning of the current list. -@item remove-tag-set-append -Remove any existing instantiators whose tag set is the same as -@var{tag-set}; then put the new instantiator at the end of the current -list. -@item remove-locale -Remove all previous instantiators for this locale before adding the new -spec. -@item remove-locale-type -Remove all specifications for all locales of the same type as -@var{locale} (this includes @var{locale} itself) before adding the new -spec. -@item remove-all -Remove all specifications from the specifier before adding the new spec. -@end table - -@code{remove-tag-set-prepend} is the default. - -You can retrieve the specifications for a particular locale or locale type -with the function @code{specifier-spec-list} or @code{specifier-specs}. -@end defun - -@defun add-spec-list-to-specifier specifier spec-list &optional how-to-add -This function adds a @dfn{spec-list} (a list of specifications) to -@var{specifier}. The format of a spec-list is - -@example - @code{((@var{locale} (@var{tag-set} . @var{instantiator}) ...) ...)} -@end example - -where - -@itemize @bullet -@item -@var{locale} := a window, a buffer, a frame, a device, or @code{global} -@item -@var{tag-set} := an unordered list of zero or more @var{tags}, each of -which is a symbol -@item -@var{tag} := a device class (@pxref{Consoles and Devices}), a device type, -or a tag defined with @code{define-specifier-tag} -@item -@var{instantiator} := format determined by the type of specifier -@end itemize - -The pair @code{(@var{tag-set} . @var{instantiator})} is called an -@dfn{inst-pair}. A list of inst-pairs is called an @dfn{inst-list}. -The pair @code{(@var{locale} . @var{inst-list})} is called a -@dfn{specification}. A spec-list, then, can be viewed as a list of -specifications. - -@var{how-to-add} specifies how to combine the new specifications with -the existing ones, and has the same semantics as for -@code{add-spec-to-specifier}. - -In many circumstances, the higher-level function @code{set-specifier} is -more convenient and should be used instead. -@end defun - -@deffn Macro let-specifier specifier-list &rest body -This special form temporarily adds specifications to specifiers, -evaluates forms in @var{body} and restores the specifiers to their -previous states. The specifiers and their temporary specifications are -listed in @var{specifier-list}. - -The format of @var{specifier-list} is - -@example -((@var{specifier} @var{value} &optional @var{locale} @var{tag-set} @var{how-to-add}) ...) -@end example - -@var{specifier} is the specifier to be temporarily modified. -@var{value} is the instantiator to be temporarily added to specifier in -@var{locale}. @var{locale}, @var{tag-set} and @var{how-to-add} have the -same meaning as in @code{add-spec-to-specifier}. - -This special form is implemented as a macro; the code resulting from -macro expansion will add specifications to specifiers using -@code{add-spec-to-specifier}. After forms in @var{body} are evaluated, -the temporary specifications are removed and old specifier spec-lists -are restored. - -@var{locale}, @var{tag-set} and @var{how-to-add} may be omitted, and -default to @code{nil}. The value of the last form in @var{body} is -returned. - -NOTE: If you want the specifier's instance to change in all -circumstances, use @code{(selected-window)} as the @var{locale}. If -@var{locale} is @code{nil} or omitted, it defaults to @code{global}. - -The following example removes the 3D modeline effect in the currently -selected window for the duration of a second: - -@example -(let-specifier ((modeline-shadow-thickness 0 (selected-window))) - (sit-for 1)) -@end example -@end deffn - -@defun set-specifier specifier value &optional how-to-add -This function adds some specifications to @var{specifier}. @var{value} -can be a single instantiator or tagged instantiator (added as a global -specification), a list of tagged and/or untagged instantiators (added as -a global specification), a cons of a locale and instantiator or locale -and instantiator list, a list of such conses, or nearly any other -reasonable form. More specifically, @var{value} can be anything -accepted by @code{canonicalize-spec-list}. - -@var{how-to-add} is the same as in @code{add-spec-to-specifier}. - -Note that @code{set-specifier} is exactly complementary to -@code{specifier-specs} except in the case where @var{specifier} has no -specs at all in it but @code{nil} is a valid instantiator (in that case, -@code{specifier-specs} will return @code{nil} (meaning no specs) and -@code{set-specifier} will interpret the @code{nil} as meaning ``I'm -adding a global instantiator and its value is @code{nil}''), or in -strange cases where there is an ambiguity between a spec-list and an -inst-list, etc. (The built-in specifier types are designed in such a way -as to avoid any such ambiguities.) - -If you want to work with spec-lists, you should probably not use these -functions, but should use the lower-level functions -@code{specifier-spec-list} and @code{add-spec-list-to-specifier}. These -functions always work with fully-qualified spec-lists; thus, there is no -ambiguity. -@end defun - -@defun canonicalize-inst-pair inst-pair specifier-type &optional noerror -This function canonicalizes the given @var{inst-pair}. - -@var{specifier-type} specifies the type of specifier that this -@var{spec-list} will be used for. - -Canonicalizing means converting to the full form for an inst-pair, i.e. -@code{(@var{tag-set} . @var{instantiator})}. A single, untagged -instantiator is given a tag set of @code{nil} (the empty set), and a -single tag is converted into a tag set consisting only of that tag. - -If @var{noerror} is non-@code{nil}, signal an error if the inst-pair is -invalid; otherwise return @code{t}. -@end defun - -@defun canonicalize-inst-list inst-list specifier-type &optional noerror -This function canonicalizes the given @var{inst-list} (a list of -inst-pairs). - -@var{specifier-type} specifies the type of specifier that this @var{inst-list} -will be used for. - -Canonicalizing means converting to the full form for an inst-list, i.e. -@code{((@var{tag-set} . @var{instantiator}) ...)}. This function -accepts a single inst-pair or any abbreviation thereof or a list of -(possibly abbreviated) inst-pairs. (See @code{canonicalize-inst-pair}.) - -If @var{noerror} is non-@code{nil}, signal an error if the inst-list is -invalid; otherwise return @code{t}. -@end defun - -@defun canonicalize-spec spec specifier-type &optional noerror -This function canonicalizes the given @var{spec} (a specification). - -@var{specifier-type} specifies the type of specifier that this -@var{spec-list} will be used for. - -Canonicalizing means converting to the full form for a spec, i.e. -@code{(@var{locale} (@var{tag-set} . @var{instantiator}) ...)}. This -function accepts a possibly abbreviated inst-list or a cons of a locale -and a possibly abbreviated inst-list. (See -@code{canonicalize-inst-list}.) - -If @var{noerror} is @code{nil}, signal an error if the specification is -invalid; otherwise return @code{t}. -@end defun - -@defun canonicalize-spec-list spec-list specifier-type &optional noerror -This function canonicalizes the given @var{spec-list} (a list of -specifications). - -@var{specifier-type} specifies the type of specifier that this -@var{spec-list} will be used for. - -Canonicalizing means converting to the full form for a spec-list, i.e. -@code{((@var{locale} (@var{tag-set} . @var{instantiator}) ...) ...)}. -This function accepts a possibly abbreviated specification or a list of -such things. (See @code{canonicalize-spec}.) This is the function used -to convert spec-lists accepted by @code{set-specifier} and such into a -form suitable for @code{add-spec-list-to-specifier}. - -This function tries extremely hard to resolve any ambiguities, -and the built-in specifier types (font, image, toolbar, etc.) are -designed so that there won't be any ambiguities. - -If @var{noerror} is @code{nil}, signal an error if the spec-list is -invalid; otherwise return @code{t}. -@end defun - -@node Retrieving Specifications -@section Retrieving the Specifications from a Specifier - -@defun specifier-spec-list specifier &optional locale tag-set exact-p -This function returns the spec-list of specifications for -@var{specifier} in @var{locale}. - -If @var{locale} is a particular locale (a window, buffer, frame, device, -or the symbol @code{global}), a spec-list consisting of the -specification for that locale will be returned. - -If @var{locale} is a locale type (i.e. a symbol @code{window}, -@code{buffer}, @code{frame}, or @code{device}), a spec-list of the -specifications for all locales of that type will be returned. - -If @var{locale} is @code{nil} or the symbol @code{all}, a spec-list of -all specifications in @var{specifier} will be returned. - -@var{locale} can also be a list of locales, locale types, and/or -@code{all}; the result is as if @code{specifier-spec-list} were called -on each element of the list and the results concatenated together. - -Only instantiators where @var{tag-set} (a list of zero or more tags) is -a subset of (or possibly equal to) the instantiator's tag set are -returned. (The default value of@code{ nil} is a subset of all tag sets, -so in this case no instantiators will be screened out.) If @var{exact-p} -is non-@code{nil}, however, @var{tag-set} must be equal to an -instantiator's tag set for the instantiator to be returned. -@end defun - -@defun specifier-specs specifier &optional locale tag-set exact-p -This function returns the specification(s) for @var{specifier} in -@var{locale}. - -If @var{locale} is a single locale or is a list of one element -containing a single locale, then a ``short form'' of the instantiators -for that locale will be returned. Otherwise, this function is identical -to @code{specifier-spec-list}. - -The ``short form'' is designed for readability and not for ease of use -in Lisp programs, and is as follows: - -@enumerate -@item -If there is only one instantiator, then an inst-pair (i.e. cons of tag -and instantiator) will be returned; otherwise a list of inst-pairs will -be returned. -@item -For each inst-pair returned, if the instantiator's tag is @code{any}, -the tag will be removed and the instantiator itself will be returned -instead of the inst-pair. -@item -If there is only one instantiator, its value is @code{nil}, and its tag -is @code{any}, a one-element list containing @code{nil} will be returned -rather than just @code{nil}, to distinguish this case from there being -no instantiators at all. -@end enumerate - -@end defun - -@defun specifier-fallback specifier -This function returns the fallback value for @var{specifier}. Fallback -values are provided by the C code for certain built-in specifiers to -make sure that instancing won't fail even if all specs are removed from -the specifier, or to implement simple inheritance behavior (e.g. this -method is used to ensure that faces other than @code{default} inherit -their attributes from @code{default}). By design, you cannot change the -fallback value, and specifiers created with @code{make-specifier} will -never have a fallback (although a similar, Lisp-accessible capability -may be provided in the future to allow for inheritance). - -The fallback value will be an inst-list that is instanced like -any other inst-list, a specifier of the same type as @var{specifier} -(results in inheritance), or @code{nil} for no fallback. - -When you instance a specifier, you can explicitly request that the -fallback not be consulted. (The C code does this, for example, when -merging faces.) See @code{specifier-instance}. -@end defun - -@node Specifier Tag Functions -@section Working With Specifier Tags - -A specifier tag set is an entity that is attached to an instantiator -and can be used to restrict the scope of that instantiator to a -particular device class or device type and/or to mark instantiators -added by a particular package so that they can be later removed. - -A specifier tag set consists of a list of zero of more specifier tags, -each of which is a symbol that is recognized by XEmacs as a tag. (The -valid device types and device classes are always tags, as are any tags -defined by @code{define-specifier-tag}.) It is called a ``tag set'' (as -opposed to a list) because the order of the tags or the number of times -a particular tag occurs does not matter. - -Each tag has a predicate associated with it, which specifies whether -that tag applies to a particular device. The tags which are device -types and classes match devices of that type or class. User-defined -tags can have any predicate, or none (meaning that all devices match). -When attempting to instance a specifier, a particular instantiator is -only considered if the device of the domain being instanced over matches -all tags in the tag set attached to that instantiator. - -Most of the time, a tag set is not specified, and the instantiator gets -a null tag set, which matches all devices. - -@defun valid-specifier-tag-p tag -This function returns non-@code{nil} if @var{tag} is a valid specifier -tag. -@end defun - -@defun valid-specifier-tag-set-p tag-set -This function returns non-@code{nil} if @var{tag-set} is a valid -specifier tag set. -@end defun - -@defun canonicalize-tag-set tag-set -This function canonicalizes the given tag set. Two canonicalized tag -sets can be compared with @code{equal} to see if they represent the same -tag set. (Specifically, canonicalizing involves sorting by symbol name -and removing duplicates.) -@end defun - -@defun device-matches-specifier-tag-set-p device tag-set -This function returns non-@code{nil} if @var{device} matches specifier -tag set @var{tag-set}. This means that @var{device} matches each tag in -the tag set. -@end defun - -@defun define-specifier-tag tag &optional predicate -This function defines a new specifier tag. If @var{predicate} is -specified, it should be a function of one argument (a device) that -specifies whether the tag matches that particular device. If -@var{predicate} is omitted, the tag matches all devices. - -You can redefine an existing user-defined specifier tag. However, you -cannot redefine the built-in specifier tags (the device types and -classes) or the symbols @code{nil}, @code{t}, @code{all}, or -@code{global}. -@end defun - -@defun device-matching-specifier-tag-list &optional device -This function returns a list of all specifier tags matching -@var{device}. @var{device} defaults to the selected device if omitted. -@end defun - -@defun specifier-tag-list -This function returns a list of all currently-defined specifier tags. -This includes the built-in ones (the device types and classes). -@end defun - -@defun specifier-tag-predicate tag -This function returns the predicate for the given specifier tag. -@end defun - -@node Specifier Instancing Functions -@section Functions for Instancing a Specifier - -@defun specifier-instance specifier &optional domain default no-fallback -This function instantiates @var{specifier} (return its value) in -@var{domain}. If no instance can be generated for this domain, return -@var{default}. - -@var{domain} should be a window, frame, or device. Other values that -are legal as a locale (e.g. a buffer) are not valid as a domain because -they do not provide enough information to identify a particular device -(see @code{valid-specifier-domain-p}). @var{domain} defaults to the -selected window if omitted. - -@dfn{Instantiating} a specifier in a particular domain means determining -the specifier's ``value'' in that domain. This is accomplished by -searching through the specifications in the specifier that correspond to -all locales that can be derived from the given domain, from specific to -general. In most cases, the domain is an Emacs window. In that case -specifications are searched for as follows: - -@enumerate -@item -A specification whose locale is the window itself; -@item -A specification whose locale is the window's buffer; -@item -A specification whose locale is the window's frame; -@item -A specification whose locale is the window's frame's device; -@item -A specification whose locale is the symbol @code{global}. -@end enumerate - -If all of those fail, then the C-code-provided fallback value for this -specifier is consulted (see @code{specifier-fallback}). If it is an -inst-list, then this function attempts to instantiate that list just as -when a specification is located in the first five steps above. If the -fallback is a specifier, @code{specifier-instance} is called recursively -on this specifier and the return value used. Note, however, that if the -optional argument @var{no-fallback} is non-@code{nil}, the fallback -value will not be consulted. - -Note that there may be more than one specification matching a particular -locale; all such specifications are considered before looking for any -specifications for more general locales. Any particular specification -that is found may be rejected because it is tagged to a particular -device class (e.g. @code{color}) or device type (e.g. @code{x}) or both -and the device for the given domain does not match this, or because the -specification is not valid for the device of the given domain (e.g. the -font or color name does not exist for this particular X server). - -The returned value is dependent on the type of specifier. For example, -for a font specifier (as returned by the @code{face-font} function), the -returned value will be a font-instance object. For images, the returned -value will be a string, pixmap, or subwindow. -@end defun - -@defun specifier-instance-from-inst-list specifier domain inst-list &optional default -This function attempts to convert a particular inst-list into an -instance. This attempts to instantiate @var{inst-list} in the given -@var{domain}, as if @var{inst-list} existed in a specification in -@var{specifier}. If the instantiation fails, @var{default} is returned. -In most circumstances, you should not use this function; use -@code{specifier-instance} instead. -@end defun - -@node Specifier Example -@section Example of Specifier Usage - -Now let us present an example to clarify the theoretical discussions we -have been through. In this example, we will use the general specifier -functions for clarity. Keep in mind that many types of specifiers, and -some other types of objects that are associated with specifiers -(e.g. faces), provide convenience functions making it easier to work -with objects of that type. - -Let us consider the background color of the default face. A specifier -is used to specify how that color will appear in different domains. -First, let's retrieve the specifier: - -@example -(setq sp (face-property 'default 'background)) - @result{} # -@end example - -@example -(specifier-specs sp) - @result{} ((# (nil . "forest green")) - (# (nil . "hot pink")) - (# (nil . "puke orange") - (nil . "moccasin")) - (# (nil . "magenta")) - (global ((tty) . "cyan") (nil . "white")) - ) -@end example - -Then, say we want to determine what the background color of the default -face is for the window currently displaying the buffer @samp{*scratch*}. -We call - -@example -(get-buffer-window "*scratch*") - @result{} # -(window-frame (get-buffer-window "*scratch*")) - @result{} # -(specifier-instance sp (get-buffer-window "*scratch*")) - @result{} # -@end example - -Note that we passed a window to @code{specifier-instance}, not a buffer. -We cannot pass a buffer because a buffer by itself does not provide enough -information. The buffer might not be displayed anywhere at all, or -could be displayed in many different frames on different devices. - -The result is arrived at like this: - -@enumerate -@item -First, we look for a specification matching the buffer displayed in the -window, i.e. @samp{*scratch}. There are none, so we proceed. -@item -Then, we look for a specification matching the window itself. Again, there -are none. -@item -Then, we look for a specification matching the window's frame. The -specification @code{(# . "puke orange")} is -found. We call the instantiation method for colors, passing it the -locale we were searching over (i.e. the window, in this case) and the -instantiator (@samp{"puke orange"}). However, the particular device -which this window is on (let's say it's an X connection) doesn't -recognize the color @samp{"puke orange"}, so the specification is -rejected. -@item -So we continue looking for a specification matching the window's frame. -We find @samp{(# . "moccasin")}. Again, we -call the instantiation method for colors. This time, the X server -our window is on recognizes the color @samp{moccasin}, and so the -instantiation method succeeds and returns a color instance. -@end enumerate - -@node Creating Specifiers -@section Creating New Specifier Objects - -@defun make-specifier type -This function creates a new specifier. - -A specifier is an object that can be used to keep track of a property -whose value can be per-buffer, per-window, per-frame, or per-device, -and can further be restricted to a particular device-type or device-class. -Specifiers are used, for example, for the various built-in properties of a -face; this allows a face to have different values in different frames, -buffers, etc. For more information, see `specifier-instance', -`specifier-specs', and `add-spec-to-specifier'; or, for a detailed -description of specifiers, including how they are instantiated over a -particular domain (i.e. how their value in that domain is determined), -see the chapter on specifiers in the XEmacs Lisp Reference Manual. - -@var{type} specifies the particular type of specifier, and should be one -of the symbols @code{generic}, @code{integer}, @code{natnum}, -@code{boolean}, @code{color}, @code{font}, @code{image}, -@code{face-boolean}, or @code{toolbar}. - -For more information on particular types of specifiers, see the -functions @code{generic-specifier-p}, @code{integer-specifier-p}, -@code{natnum-specifier-p}, @code{boolean-specifier-p}, -@code{color-specifier-p}, @code{font-specifier-p}, -@code{image-specifier-p}, @code{face-boolean-specifier-p}, and -@code{toolbar-specifier-p}. -@end defun - -@defun make-specifier-and-init type spec-list &optional dont-canonicalize -This function creates and initialize a new specifier. - -This is a front-end onto @code{make-specifier} that allows you to create -a specifier and add specs to it at the same time. @var{type} specifies -the specifier type. @var{spec-list} supplies the specification(s) to be -added to the specifier. Normally, almost any reasonable abbreviation of -the full spec-list form is accepted, and is converted to the full form; -however, if optional argument @var{dont-canonicalize} is non-@code{nil}, -this conversion is not performed, and the @var{spec-list} must already -be in full form. See @code{canonicalize-spec-list}. -@end defun - -@node Specifier Validation Functions -@section Functions for Checking the Validity of Specifier Components - -@defun valid-specifier-domain-p domain -This function returns non-@code{nil} if @var{domain} is a valid -specifier domain. A domain is used to instance a specifier -(i.e. determine the specifier's value in that domain). Valid domains -are a window, frame, or device. (@code{nil} is not valid.) -@end defun - -@defun valid-specifier-locale-p locale -This function returns non-@code{nil} if @var{locale} is a valid -specifier locale. Valid locales are a device, a frame, a window, a -buffer, and @code{global}. (@code{nil} is not valid.) -@end defun - -@defun valid-specifier-locale-type-p locale-type -Given a specifier @var{locale-type}, this function returns non-nil if it -is valid. Valid locale types are the symbols @code{global}, -@code{device}, @code{frame}, @code{window}, and @code{buffer}. (Note, -however, that in functions that accept either a locale or a locale type, -@code{global} is considered an individual locale.) -@end defun - -@defun valid-specifier-type-p specifier-type -Given a @var{specifier-type}, this function returns non-@code{nil} if it -is valid. Valid types are @code{generic}, @code{integer}, -@code{boolean}, @code{color}, @code{font}, @code{image}, -@code{face-boolean}, and @code{toolbar}. -@end defun - -@defun valid-specifier-tag-p tag -This function returns non-@code{nil} if @var{tag} is a valid specifier -tag. -@end defun - -@defun valid-instantiator-p instantiator specifier-type -This function returns non-@code{nil} if @var{instantiator} is valid for -@var{specifier-type}. -@end defun - -@defun valid-inst-list-p inst-list type -This function returns non-@code{nil} if @var{inst-list} is valid for -specifier type @var{type}. -@end defun - -@defun valid-spec-list-p spec-list type -This function returns non-@code{nil} if @var{spec-list} is valid for -specifier type @var{type}. -@end defun - -@defun check-valid-instantiator instantiator specifier-type -This function signals an error if @var{instantiator} is invalid for -@var{specifier-type}. -@end defun - -@defun check-valid-inst-list inst-list type -This function signals an error if @var{inst-list} is invalid for -specifier type @var{type}. -@end defun - -@defun check-valid-spec-list spec-list type -This function signals an error if @var{spec-list} is invalid for -specifier type @var{type}. -@end defun - -@node Other Specification Functions -@section Other Functions for Working with Specifications in a Specifier - -@defun copy-specifier specifier &optional dest locale tag-set exact-p how-to-add -This function copies @var{specifier} to @var{dest}, or creates a new one -if @var{dest} is @code{nil}. - -If @var{dest} is @code{nil} or omitted, a new specifier will be created -and the specifications copied into it. Otherwise, the specifications -will be copied into the existing specifier in @var{dest}. - -If @var{locale} is @code{nil} or the symbol @code{all}, all -specifications will be copied. If @var{locale} is a particular locale, -the specification for that particular locale will be copied. If -@var{locale} is a locale type, the specifications for all locales of -that type will be copied. @var{locale} can also be a list of locales, -locale types, and/or @code{all}; this is equivalent to calling -@code{copy-specifier} for each of the elements of the list. See -@code{specifier-spec-list} for more information about @var{locale}. - -Only instantiators where @var{tag-set} (a list of zero or more tags) is -a subset of (or possibly equal to) the instantiator's tag set are -copied. (The default value of @code{nil} is a subset of all tag sets, -so in this case no instantiators will be screened out.) If @var{exact-p} -is non-@code{nil}, however, @var{tag-set} must be equal to an -instantiator's tag set for the instantiator to be copied. - -Optional argument @var{how-to-add} specifies what to do with existing -specifications in @var{dest}. If nil, then whichever locales or locale -types are copied will first be completely erased in @var{dest}. -Otherwise, it is the same as in @code{add-spec-to-specifier}. -@end defun - -@defun remove-specifier specifier &optional locale tag-set exact-p -This function removes specification(s) for @var{specifier}. - -If @var{locale} is a particular locale (a buffer, window, frame, device, -or the symbol @code{global}), the specification for that locale will be -removed. - -If instead, @var{locale} is a locale type (i.e. a symbol @code{buffer}, -@code{window}, @code{frame}, or @code{device}), the specifications for -all locales of that type will be removed. - -If @var{locale} is @code{nil} or the symbol @code{all}, all -specifications will be removed. - -@var{locale} can also be a list of locales, locale types, and/or -@code{all}; this is equivalent to calling @code{remove-specifier} for -each of the elements in the list. - -Only instantiators where @var{tag-set} (a list of zero or more tags) is -a subset of (or possibly equal to) the instantiator's tag set are -removed. (The default value of @code{nil} is a subset of all tag sets, -so in this case no instantiators will be screened out.) If @var{exact-p} -is non-@code{nil}, however, @var{tag-set} must be equal to an -instantiator's tag set for the instantiator to be removed. -@end defun - -@defun map-specifier specifier func &optional locale maparg -This function applies @var{func} to the specification(s) for -@var{locale} in @var{specifier}. - -If @var{locale} is a locale, @var{func} will be called for that locale. -If @var{locale} is a locale type, @var{func} will be mapped over all -locales of that type. If @var{locale} is @code{nil} or the symbol -@code{all}, @var{func} will be mapped over all locales in -@var{specifier}. - -@var{func} is called with four arguments: the @var{specifier}, the -locale being mapped over, the inst-list for that locale, and the -optional @var{maparg}. If any invocation of @var{func} returns -non-@code{nil}, the mapping will stop and the returned value becomes the -value returned from @code{map-specifier}. Otherwise, -@code{map-specifier} returns @code{nil}. -@end defun - -@defun specifier-locale-type-from-locale locale -Given a specifier @var{locale}, this function returns its type. -@end defun - diff --git a/man/lispref/streams.texi b/man/lispref/streams.texi deleted file mode 100644 index 98b6494..0000000 --- a/man/lispref/streams.texi +++ /dev/null @@ -1,799 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/streams.info -@node Read and Print, Minibuffers, Debugging, Top -@chapter Reading and Printing Lisp Objects - - @dfn{Printing} and @dfn{reading} are the operations of converting Lisp -objects to textual form and vice versa. They use the printed -representations and read syntax described in @ref{Lisp Data Types}. - - This chapter describes the Lisp functions for reading and printing. -It also describes @dfn{streams}, which specify where to get the text (if -reading) or where to put it (if printing). - -@menu -* Streams Intro:: Overview of streams, reading and printing. -* Input Streams:: Various data types that can be used as input streams. -* Input Functions:: Functions to read Lisp objects from text. -* Output Streams:: Various data types that can be used as output streams. -* Output Functions:: Functions to print Lisp objects as text. -* Output Variables:: Variables that control what the printing functions do. -@end menu - -@node Streams Intro -@section Introduction to Reading and Printing -@cindex Lisp reader -@cindex printing -@cindex reading - - @dfn{Reading} a Lisp object means parsing a Lisp expression in textual -form and producing a corresponding Lisp object. This is how Lisp -programs get into Lisp from files of Lisp code. We call the text the -@dfn{read syntax} of the object. For example, the text @samp{(a .@: 5)} -is the read syntax for a cons cell whose @sc{car} is @code{a} and whose -@sc{cdr} is the number 5. - - @dfn{Printing} a Lisp object means producing text that represents that -object---converting the object to its printed representation. Printing -the cons cell described above produces the text @samp{(a .@: 5)}. - - Reading and printing are more or less inverse operations: printing the -object that results from reading a given piece of text often produces -the same text, and reading the text that results from printing an object -usually produces a similar-looking object. For example, printing the -symbol @code{foo} produces the text @samp{foo}, and reading that text -returns the symbol @code{foo}. Printing a list whose elements are -@code{a} and @code{b} produces the text @samp{(a b)}, and reading that -text produces a list (but not the same list) with elements @code{a} -and @code{b}. - - However, these two operations are not precisely inverses. There are -three kinds of exceptions: - -@itemize @bullet -@item -Printing can produce text that cannot be read. For example, buffers, -windows, frames, subprocesses and markers print into text that starts -with @samp{#}; if you try to read this text, you get an error. There is -no way to read those data types. - -@item -One object can have multiple textual representations. For example, -@samp{1} and @samp{01} represent the same integer, and @samp{(a b)} and -@samp{(a .@: (b))} represent the same list. Reading will accept any of -the alternatives, but printing must choose one of them. - -@item -Comments can appear at certain points in the middle of an object's -read sequence without affecting the result of reading it. -@end itemize - -@node Input Streams -@section Input Streams -@cindex stream (for reading) -@cindex input stream - - Most of the Lisp functions for reading text take an @dfn{input stream} -as an argument. The input stream specifies where or how to get the -characters of the text to be read. Here are the possible types of input -stream: - -@table @asis -@item @var{buffer} -@cindex buffer input stream -The input characters are read from @var{buffer}, starting with the -character directly after point. Point advances as characters are read. - -@item @var{marker} -@cindex marker input stream -The input characters are read from the buffer that @var{marker} is in, -starting with the character directly after the marker. The marker -position advances as characters are read. The value of point in the -buffer has no effect when the stream is a marker. - -@item @var{string} -@cindex string input stream -The input characters are taken from @var{string}, starting at the first -character in the string and using as many characters as required. - -@item @var{function} -@cindex function input stream -The input characters are generated by @var{function}, one character per -call. Normally @var{function} is called with no arguments, and should -return a character. - -@cindex unreading -Occasionally @var{function} is called with one argument (always a -character). When that happens, @var{function} should save the argument -and arrange to return it on the next call. This is called -@dfn{unreading} the character; it happens when the Lisp reader reads one -character too many and wants to ``put it back where it came from''. - -@item @code{t} -@cindex @code{t} input stream -@code{t} used as a stream means that the input is read from the -minibuffer. In fact, the minibuffer is invoked once and the text -given by the user is made into a string that is then used as the -input stream. - -@item @code{nil} -@cindex @code{nil} input stream -@code{nil} supplied as an input stream means to use the value of -@code{standard-input} instead; that value is the @dfn{default input -stream}, and must be a non-@code{nil} input stream. - -@item @var{symbol} -A symbol as input stream is equivalent to the symbol's function -definition (if any). -@end table - - Here is an example of reading from a stream that is a buffer, showing -where point is located before and after: - -@example -@group ----------- Buffer: foo ---------- -This@point{} is the contents of foo. ----------- Buffer: foo ---------- -@end group - -@group -(read (get-buffer "foo")) - @result{} is -@end group -@group -(read (get-buffer "foo")) - @result{} the -@end group - -@group ----------- Buffer: foo ---------- -This is the@point{} contents of foo. ----------- Buffer: foo ---------- -@end group -@end example - -@noindent -Note that the first read skips a space. Reading skips any amount of -whitespace preceding the significant text. - - In Emacs 18, reading a symbol discarded the delimiter terminating the -symbol. Thus, point would end up at the beginning of @samp{contents} -rather than after @samp{the}. The Emacs 19 behavior is superior because -it correctly handles input such as @samp{bar(foo)}, where the -open-parenthesis that ends one object is needed as the beginning of -another object. - - Here is an example of reading from a stream that is a marker, -initially positioned at the beginning of the buffer shown. The value -read is the symbol @code{This}. - -@example -@group - ----------- Buffer: foo ---------- -This is the contents of foo. ----------- Buffer: foo ---------- -@end group - -@group -(setq m (set-marker (make-marker) 1 (get-buffer "foo"))) - @result{} # -@end group -@group -(read m) - @result{} This -@end group -@group -m - @result{} # ;; @r{Before the first space.} -@end group -@end example - - Here we read from the contents of a string: - -@example -@group -(read "(When in) the course") - @result{} (When in) -@end group -@end example - - The following example reads from the minibuffer. The -prompt is: @w{@samp{Lisp expression: }}. (That is always the prompt -used when you read from the stream @code{t}.) The user's input is shown -following the prompt. - -@example -@group -(read t) - @result{} 23 ----------- Buffer: Minibuffer ---------- -Lisp expression: @kbd{23 @key{RET}} ----------- Buffer: Minibuffer ---------- -@end group -@end example - - Finally, here is an example of a stream that is a function, named -@code{useless-stream}. Before we use the stream, we initialize the -variable @code{useless-list} to a list of characters. Then each call to -the function @code{useless-stream} obtains the next character in the list -or unreads a character by adding it to the front of the list. - -@example -@group -(setq useless-list (append "XY()" nil)) - @result{} (88 89 40 41) -@end group - -@group -(defun useless-stream (&optional unread) - (if unread - (setq useless-list (cons unread useless-list)) - (prog1 (car useless-list) - (setq useless-list (cdr useless-list))))) - @result{} useless-stream -@end group -@end example - -@noindent -Now we read using the stream thus constructed: - -@example -@group -(read 'useless-stream) - @result{} XY -@end group - -@group -useless-list - @result{} (40 41) -@end group -@end example - -@noindent -Note that the open and close parentheses remains in the list. The Lisp -reader encountered the open parenthesis, decided that it ended the -input, and unread it. Another attempt to read from the stream at this -point would read @samp{()} and return @code{nil}. - -@ignore @c Not in XEmacs -@defun get-file-char -This function is used internally as an input stream to read from the -input file opened by the function @code{load}. Don't use this function -yourself. -@end defun -@end ignore - -@node Input Functions -@section Input Functions - - This section describes the Lisp functions and variables that pertain -to reading. - - In the functions below, @var{stream} stands for an input stream (see -the previous section). If @var{stream} is @code{nil} or omitted, it -defaults to the value of @code{standard-input}. - -@kindex end-of-file - An @code{end-of-file} error is signaled if reading encounters an -unterminated list, vector, or string. - -@defun read &optional stream -This function reads one textual Lisp expression from @var{stream}, -returning it as a Lisp object. This is the basic Lisp input function. -@end defun - -@defun read-from-string string &optional start end -@cindex string to object -This function reads the first textual Lisp expression from the text in -@var{string}. It returns a cons cell whose @sc{car} is that expression, -and whose @sc{cdr} is an integer giving the position of the next -remaining character in the string (i.e., the first one not read). - -If @var{start} is supplied, then reading begins at index @var{start} in -the string (where the first character is at index 0). If @var{end} is -also supplied, then reading stops just before that index, as if the rest -of the string were not there. - -For example: - -@example -@group -(read-from-string "(setq x 55) (setq y 5)") - @result{} ((setq x 55) . 11) -@end group -@group -(read-from-string "\"A short string\"") - @result{} ("A short string" . 16) -@end group - -@group -;; @r{Read starting at the first character.} -(read-from-string "(list 112)" 0) - @result{} ((list 112) . 10) -@end group -@group -;; @r{Read starting at the second character.} -(read-from-string "(list 112)" 1) - @result{} (list . 5) -@end group -@group -;; @r{Read starting at the seventh character,} -;; @r{and stopping at the ninth.} -(read-from-string "(list 112)" 6 8) - @result{} (11 . 8) -@end group -@end example -@end defun - -@defvar standard-input -This variable holds the default input stream---the stream that -@code{read} uses when the @var{stream} argument is @code{nil}. -@end defvar - -@node Output Streams -@section Output Streams -@cindex stream (for printing) -@cindex output stream - - An output stream specifies what to do with the characters produced -by printing. Most print functions accept an output stream as an -optional argument. Here are the possible types of output stream: - -@table @asis -@item @var{buffer} -@cindex buffer output stream -The output characters are inserted into @var{buffer} at point. -Point advances as characters are inserted. - -@item @var{marker} -@cindex marker output stream -The output characters are inserted into the buffer that @var{marker} -points into, at the marker position. The marker position advances as -characters are inserted. The value of point in the buffer has no effect -on printing when the stream is a marker. - -@item @var{function} -@cindex function output stream -The output characters are passed to @var{function}, which is responsible -for storing them away. It is called with a single character as -argument, as many times as there are characters to be output, and is -free to do anything at all with the characters it receives. - -@item @code{t} -@cindex @code{t} output stream -The output characters are displayed in the echo area. - -@item @code{nil} -@cindex @code{nil} output stream -@code{nil} specified as an output stream means to the value of -@code{standard-output} instead; that value is the @dfn{default output -stream}, and must be a non-@code{nil} output stream. - -@item @var{symbol} -A symbol as output stream is equivalent to the symbol's function -definition (if any). -@end table - - Many of the valid output streams are also valid as input streams. The -difference between input and output streams is therefore mostly one of -how you use a Lisp object, not a distinction of types of object. - - Here is an example of a buffer used as an output stream. Point is -initially located as shown immediately before the @samp{h} in -@samp{the}. At the end, point is located directly before that same -@samp{h}. - -@cindex print example -@example -@group ----------- Buffer: foo ---------- -This is t@point{}he contents of foo. ----------- Buffer: foo ---------- -@end group - -(print "This is the output" (get-buffer "foo")) - @result{} "This is the output" - -@group ----------- Buffer: foo ---------- -This is t -"This is the output" -@point{}he contents of foo. ----------- Buffer: foo ---------- -@end group -@end example - - Now we show a use of a marker as an output stream. Initially, the -marker is in buffer @code{foo}, between the @samp{t} and the @samp{h} in -the word @samp{the}. At the end, the marker has advanced over the -inserted text so that it remains positioned before the same @samp{h}. -Note that the location of point, shown in the usual fashion, has no -effect. - -@example -@group ----------- Buffer: foo ---------- -"This is the @point{}output" ----------- Buffer: foo ---------- -@end group - -@group -m - @result{} # -@end group - -@group -(print "More output for foo." m) - @result{} "More output for foo." -@end group - -@group ----------- Buffer: foo ---------- -"This is t -"More output for foo." -he @point{}output" ----------- Buffer: foo ---------- -@end group - -@group -m - @result{} # -@end group -@end example - - The following example shows output to the echo area: - -@example -@group -(print "Echo Area output" t) - @result{} "Echo Area output" ----------- Echo Area ---------- -"Echo Area output" ----------- Echo Area ---------- -@end group -@end example - - Finally, we show the use of a function as an output stream. The -function @code{eat-output} takes each character that it is given and -conses it onto the front of the list @code{last-output} (@pxref{Building -Lists}). At the end, the list contains all the characters output, but -in reverse order. - -@example -@group -(setq last-output nil) - @result{} nil -@end group - -@group -(defun eat-output (c) - (setq last-output (cons c last-output))) - @result{} eat-output -@end group - -@group -(print "This is the output" 'eat-output) - @result{} "This is the output" -@end group - -@group -last-output - @result{} (?\n ?\" ?t ?u ?p ?t ?u ?o ?\ ?e ?h ?t - ?\ ?s ?i ?\ ?s ?i ?h ?T ?\" ?\n) -@end group -@end example - -@noindent -Now we can put the output in the proper order by reversing the list: - -@example -@group -(concat (nreverse last-output)) - @result{} " -\"This is the output\" -" -@end group -@end example - -@noindent -Calling @code{concat} converts the list to a string so you can see its -contents more clearly. - -@node Output Functions -@section Output Functions - - This section describes the Lisp functions for printing Lisp objects. - -@cindex @samp{"} in printing -@cindex @samp{\} in printing -@cindex quoting characters in printing -@cindex escape characters in printing - Some of the XEmacs printing functions add quoting characters to the -output when necessary so that it can be read properly. The quoting -characters used are @samp{"} and @samp{\}; they distinguish strings from -symbols, and prevent punctuation characters in strings and symbols from -being taken as delimiters when reading. @xref{Printed Representation}, -for full details. You specify quoting or no quoting by the choice of -printing function. - - If the text is to be read back into Lisp, then it is best to print -with quoting characters to avoid ambiguity. Likewise, if the purpose is -to describe a Lisp object clearly for a Lisp programmer. However, if -the purpose of the output is to look nice for humans, then it is better -to print without quoting. - - Printing a self-referent Lisp object requires an infinite amount of -text. In certain cases, trying to produce this text leads to a stack -overflow. XEmacs detects such recursion and prints @samp{#@var{level}} -instead of recursively printing an object already being printed. For -example, here @samp{#0} indicates a recursive reference to the object at -level 0 of the current print operation: - -@example -(setq foo (list nil)) - @result{} (nil) -(setcar foo foo) - @result{} (#0) -@end example - - In the functions below, @var{stream} stands for an output stream. -(See the previous section for a description of output streams.) If -@var{stream} is @code{nil} or omitted, it defaults to the value of -@code{standard-output}. - -@defun print object &optional stream -@cindex Lisp printer -The @code{print} function is a convenient way of printing. It outputs -the printed representation of @var{object} to @var{stream}, printing in -addition one newline before @var{object} and another after it. Quoting -characters are used. @code{print} returns @var{object}. For example: - -@example -@group -(progn (print 'The\ cat\ in) - (print "the hat") - (print " came back")) - @print{} - @print{} The\ cat\ in - @print{} - @print{} "the hat" - @print{} - @print{} " came back" - @print{} - @result{} " came back" -@end group -@end example -@end defun - -@defun prin1 object &optional stream -This function outputs the printed representation of @var{object} to -@var{stream}. It does not print newlines to separate output as -@code{print} does, but it does use quoting characters just like -@code{print}. It returns @var{object}. - -@example -@group -(progn (prin1 'The\ cat\ in) - (prin1 "the hat") - (prin1 " came back")) - @print{} The\ cat\ in"the hat"" came back" - @result{} " came back" -@end group -@end example -@end defun - -@defun princ object &optional stream -This function outputs the printed representation of @var{object} to -@var{stream}. It returns @var{object}. - -This function is intended to produce output that is readable by people, -not by @code{read}, so it doesn't insert quoting characters and doesn't -put double-quotes around the contents of strings. It does not add any -spacing between calls. - -@example -@group -(progn - (princ 'The\ cat) - (princ " in the \"hat\"")) - @print{} The cat in the "hat" - @result{} " in the \"hat\"" -@end group -@end example -@end defun - -@defun terpri &optional stream -@cindex newline in print -This function outputs a newline to @var{stream}. The name stands -for ``terminate print''. -@end defun - -@defun write-char character &optional stream -This function outputs @var{character} to @var{stream}. It returns -@var{character}. -@end defun - -@defun prin1-to-string object &optional noescape -@cindex object to string -This function returns a string containing the text that @code{prin1} -would have printed for the same argument. - -@example -@group -(prin1-to-string 'foo) - @result{} "foo" -@end group -@group -(prin1-to-string (mark-marker)) - @result{} "#" -@end group -@end example - -If @var{noescape} is non-@code{nil}, that inhibits use of quoting -characters in the output. (This argument is supported in Emacs versions -19 and later.) - -@example -@group -(prin1-to-string "foo") - @result{} "\"foo\"" -@end group -@group -(prin1-to-string "foo" t) - @result{} "foo" -@end group -@end example - -See @code{format}, in @ref{String Conversion}, for other ways to obtain -the printed representation of a Lisp object as a string. -@end defun - -@node Output Variables -@section Variables Affecting Output - -@defvar standard-output -The value of this variable is the default output stream---the stream -that print functions use when the @var{stream} argument is @code{nil}. -@end defvar - -@defvar print-escape-newlines -@cindex @samp{\n} in print -@cindex escape characters -If this variable is non-@code{nil}, then newline characters in strings -are printed as @samp{\n} and formfeeds are printed as @samp{\f}. -Normally these characters are printed as actual newlines and formfeeds. - -This variable affects the print functions @code{prin1} and @code{print}, -as well as everything that uses them. It does not affect @code{princ}. -Here is an example using @code{prin1}: - -@example -@group -(prin1 "a\nb") - @print{} "a - @print{} b" - @result{} "a -b" -@end group - -@group -(let ((print-escape-newlines t)) - (prin1 "a\nb")) - @print{} "a\nb" - @result{} "a -b" -@end group -@end example - -@noindent -In the second expression, the local binding of -@code{print-escape-newlines} is in effect during the call to -@code{prin1}, but not during the printing of the result. -@end defvar - -@defvar print-readably -@cindex printing readably -If non-@code{nil}, then all objects will be printed in a readable form. -If an object has no readable representation, then an error is signalled. -When @code{print-readably} is true, compiled-function objects will be -written in @samp{#[...]} form instead of in @samp{#} form, and two-element lists of the form @samp{(quote object)} -will be written as the equivalent @samp{'object}. Do not @emph{set} -this variable; bind it instead. -@end defvar - -@defvar print-length -@cindex printing limits -The value of this variable is the maximum number of elements of a list -that will be printed. If a list being printed has more than this many -elements, it is abbreviated with an ellipsis. - -If the value is @code{nil} (the default), then there is no limit. - -@example -@group -(setq print-length 2) - @result{} 2 -@end group -@group -(print '(1 2 3 4 5)) - @print{} (1 2 ...) - @result{} (1 2 ...) -@end group -@end example -@end defvar - -@defvar print-level -The value of this variable is the maximum depth of nesting of -parentheses and brackets when printed. Any list or vector at a depth -exceeding this limit is abbreviated with an ellipsis. A value of -@code{nil} (which is the default) means no limit. - -This variable exists in version 19 and later versions. -@end defvar - -@defvar print-string-length -@cindex string length, maximum when printing -The value of this variable is the maximum number of characters of a string -that will be printed. If a string being printed has more than this many -characters, it is abbreviated with an ellipsis. -@end defvar - -@defvar print-gensym -@cindex printing uninterned symbols -@cindex uninterned symbols, printing -If non-@code{nil}, then uninterned symbols will be printed specially. -Uninterned symbols are those which are not present in @code{obarray}, -that is, those which were made with @code{make-symbol} or by calling -@code{intern} with a second argument. - -When @code{print-gensym} is true, such symbols will be preceded by -@samp{#:}, which causes the reader to create a new symbol instead of -interning and returning an existing one. Beware: The @samp{#:} syntax -creates a new symbol each time it is seen, so if you print an object -which contains two pointers to the same uninterned symbol, @code{read} -will not duplicate that structure. - -Also, since XEmacs has no real notion of packages, there is no way for -the printer to distinguish between symbols interned in no obarray, and -symbols interned in an alternate obarray. -@end defvar - -@defvar float-output-format -@cindex printing floating-point numbers -@cindex floating-point numbers, printing -This variable holds the format descriptor string that Lisp uses to print -floats. This is a @samp{%}-spec like those accepted by @code{printf} in -C, but with some restrictions. It must start with the two characters -@samp{%.}. After that comes an integer precision specification, and -then a letter which controls the format. The letters allowed are -@samp{e}, @samp{f} and @samp{g}. - -@itemize @bullet -@item -Use @samp{e} for exponential notation -@samp{@var{dig}.@var{digits}e@var{expt}}. -@item -Use @samp{f} for decimal point notation @samp{DIGITS.DIGITS}. -@item -Use @samp{g} to choose the shorter of those two formats for the number -at hand. -@end itemize - -The precision in any of these cases is the number of digits following -the decimal point. With @samp{f}, a precision of 0 means to omit the -decimal point. 0 is not allowed with @samp{f} or @samp{g}. - -A value of nil means to use @samp{%.16g}. - -Regardless of the value of @code{float-output-format}, a floating point -number will never be printed in such a way that it is ambiguous with an -integer; that is, a floating-point number will always be printed with a -decimal point and/or an exponent, even if the digits following the -decimal point are all zero. This is to preserve read-equivalence. -@end defvar diff --git a/man/lispref/strings.texi b/man/lispref/strings.texi deleted file mode 100644 index 30565ad..0000000 --- a/man/lispref/strings.texi +++ /dev/null @@ -1,1247 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/strings.info -@node Strings and Characters, Lists, Numbers, Top -@chapter Strings and Characters -@cindex strings -@cindex character arrays -@cindex characters -@cindex bytes - - A string in XEmacs Lisp is an array that contains an ordered sequence -of characters. Strings are used as names of symbols, buffers, and -files, to send messages to users, to hold text being copied between -buffers, and for many other purposes. Because strings are so important, -XEmacs Lisp has many functions expressly for manipulating them. XEmacs -Lisp programs use strings more often than individual characters. - -@menu -* Basics: String Basics. Basic properties of strings and characters. -* Predicates for Strings:: Testing whether an object is a string or char. -* Creating Strings:: Functions to allocate new strings. -* Predicates for Characters:: Testing whether an object is a character. -* Character Codes:: Each character has an equivalent integer. -* Text Comparison:: Comparing characters or strings. -* String Conversion:: Converting characters or strings and vice versa. -* Modifying Strings:: Changing characters in a string. -* String Properties:: Additional information attached to strings. -* Formatting Strings:: @code{format}: XEmacs's analog of @code{printf}. -* Character Case:: Case conversion functions. -* Case Tables:: Customizing case conversion. -* Char Tables:: Mapping from characters to Lisp objects. -@end menu - -@node String Basics -@section String and Character Basics - - Strings in XEmacs Lisp are arrays that contain an ordered sequence of -characters. Characters are their own primitive object type in XEmacs -20. However, in XEmacs 19, characters are represented in XEmacs Lisp as -integers; whether an integer was intended as a character or not is -determined only by how it is used. @xref{Character Type}. - - The length of a string (like any array) is fixed and independent of -the string contents, and cannot be altered. Strings in Lisp are -@emph{not} terminated by a distinguished character code. (By contrast, -strings in C are terminated by a character with @sc{ASCII} code 0.) -This means that any character, including the null character (@sc{ASCII} -code 0), is a valid element of a string.@refill - - Since strings are considered arrays, you can operate on them with the -general array functions. (@xref{Sequences Arrays Vectors}.) For -example, you can access or change individual characters in a string -using the functions @code{aref} and @code{aset} (@pxref{Array -Functions}). - - Strings use an efficient representation for storing the characters -in them, and thus take up much less memory than a vector of the same -length. - - Sometimes you will see strings used to hold key sequences. This -exists for backward compatibility with Emacs 18, but should @emph{not} -be used in new code, since many key chords can't be represented at -all and others (in particular meta key chords) are confused with -accented characters. - -@ignore @c Not accurate any more - Each character in a string is stored in a single byte. Therefore, -numbers not in the range 0 to 255 are truncated when stored into a -string. This means that a string takes up much less memory than a -vector of the same length. - - Sometimes key sequences are represented as strings. When a string is -a key sequence, string elements in the range 128 to 255 represent meta -characters (which are extremely large integers) rather than keyboard -events in the range 128 to 255. - - Strings cannot hold characters that have the hyper, super or alt -modifiers; they can hold @sc{ASCII} control characters, but no other -control characters. They do not distinguish case in @sc{ASCII} control -characters. @xref{Character Type}, for more information about -representation of meta and other modifiers for keyboard input -characters. -@end ignore - - Strings are useful for holding regular expressions. You can also -match regular expressions against strings (@pxref{Regexp Search}). The -functions @code{match-string} (@pxref{Simple Match Data}) and -@code{replace-match} (@pxref{Replacing Match}) are useful for -decomposing and modifying strings based on regular expression matching. - - Like a buffer, a string can contain extents in it. These extents are -created when a function such as @code{buffer-substring} is called on a -region with duplicable extents in it. When the string is inserted into -a buffer, the extents are inserted along with it. @xref{Duplicable -Extents}. - - @xref{Text}, for information about functions that display strings or -copy them into buffers. @xref{Character Type}, and @ref{String Type}, -for information about the syntax of characters and strings. - -@node Predicates for Strings -@section The Predicates for Strings - -For more information about general sequence and array predicates, -see @ref{Sequences Arrays Vectors}, and @ref{Arrays}. - -@defun stringp object - This function returns @code{t} if @var{object} is a string, @code{nil} -otherwise. -@end defun - -@defun char-or-string-p object - This function returns @code{t} if @var{object} is a string or a -character, @code{nil} otherwise. - -In XEmacs addition, this function also returns @code{t} if @var{object} -is an integer that can be represented as a character. This is because -of compatibility with previous XEmacs and should not be depended on. -@end defun - -@node Creating Strings -@section Creating Strings - - The following functions create strings, either from scratch, or by -putting strings together, or by taking them apart. - -@defun string &rest characters - This function returns a new string made up of @var{characters}. - -@example -(string ?X ?E ?m ?a ?c ?s) - @result{} "XEmacs" -(string) - @result{} "" -@end example - -Analogous functions operating on other data types include @code{list}, -@code{cons} (@pxref{Building Lists}), @code{vector} (@pxref{Vectors}) -and @code{bit-vector} (@pxref{Bit Vectors}). This function has not been -available in XEmacs prior to 21.0 and FSF Emacs prior to 20.3. -@end defun - -@defun make-string count character - This function returns a string made up of @var{count} repetitions of -@var{character}. If @var{count} is negative, an error is signaled. - -@example -(make-string 5 ?x) - @result{} "xxxxx" -(make-string 0 ?x) - @result{} "" -@end example - - Other functions to compare with this one include @code{char-to-string} -(@pxref{String Conversion}), @code{make-vector} (@pxref{Vectors}), and -@code{make-list} (@pxref{Building Lists}). -@end defun - -@defun substring string start &optional end -This function returns a new string which consists of those characters -from @var{string} in the range from (and including) the character at the -index @var{start} up to (but excluding) the character at the index -@var{end}. The first character is at index zero. - -@example -@group -(substring "abcdefg" 0 3) - @result{} "abc" -@end group -@end example - -@noindent -Here the index for @samp{a} is 0, the index for @samp{b} is 1, and the -index for @samp{c} is 2. Thus, three letters, @samp{abc}, are copied -from the string @code{"abcdefg"}. The index 3 marks the character -position up to which the substring is copied. The character whose index -is 3 is actually the fourth character in the string. - -A negative number counts from the end of the string, so that @minus{}1 -signifies the index of the last character of the string. For example: - -@example -@group -(substring "abcdefg" -3 -1) - @result{} "ef" -@end group -@end example - -@noindent -In this example, the index for @samp{e} is @minus{}3, the index for -@samp{f} is @minus{}2, and the index for @samp{g} is @minus{}1. -Therefore, @samp{e} and @samp{f} are included, and @samp{g} is excluded. - -When @code{nil} is used as an index, it stands for the length of the -string. Thus, - -@example -@group -(substring "abcdefg" -3 nil) - @result{} "efg" -@end group -@end example - -Omitting the argument @var{end} is equivalent to specifying @code{nil}. -It follows that @code{(substring @var{string} 0)} returns a copy of all -of @var{string}. - -@example -@group -(substring "abcdefg" 0) - @result{} "abcdefg" -@end group -@end example - -@noindent -But we recommend @code{copy-sequence} for this purpose (@pxref{Sequence -Functions}). - -If the characters copied from @var{string} have duplicable extents or -text properties, those are copied into the new string also. -@xref{Duplicable Extents}. - -A @code{wrong-type-argument} error is signaled if either @var{start} or -@var{end} is not an integer or @code{nil}. An @code{args-out-of-range} -error is signaled if @var{start} indicates a character following -@var{end}, or if either integer is out of range for @var{string}. - -Contrast this function with @code{buffer-substring} (@pxref{Buffer -Contents}), which returns a string containing a portion of the text in -the current buffer. The beginning of a string is at index 0, but the -beginning of a buffer is at index 1. -@end defun - -@defun concat &rest sequences -@cindex copying strings -@cindex concatenating strings -This function returns a new string consisting of the characters in the -arguments passed to it (along with their text properties, if any). The -arguments may be strings, lists of numbers, or vectors of numbers; they -are not themselves changed. If @code{concat} receives no arguments, it -returns an empty string. - -@example -(concat "abc" "-def") - @result{} "abc-def" -(concat "abc" (list 120 (+ 256 121)) [122]) - @result{} "abcxyz" -;; @r{@code{nil} is an empty sequence.} -(concat "abc" nil "-def") - @result{} "abc-def" -(concat "The " "quick brown " "fox.") - @result{} "The quick brown fox." -(concat) - @result{} "" -@end example - -@noindent -The second example above shows how characters stored in strings are -taken modulo 256. In other words, each character in the string is -stored in one byte. - -The @code{concat} function always constructs a new string that is -not @code{eq} to any existing string. - -When an argument is an integer (not a sequence of integers), it is -converted to a string of digits making up the decimal printed -representation of the integer. @strong{Don't use this feature; we plan -to eliminate it. If you already use this feature, change your programs -now!} The proper way to convert an integer to a decimal number in this -way is with @code{format} (@pxref{Formatting Strings}) or -@code{number-to-string} (@pxref{String Conversion}). - -@example -@group -(concat 137) - @result{} "137" -(concat 54 321) - @result{} "54321" -@end group -@end example - -For information about other concatenation functions, see the description -of @code{mapconcat} in @ref{Mapping Functions}, @code{vconcat} in -@ref{Vectors}, @code{bvconcat} in @ref{Bit Vectors}, and @code{append} -in @ref{Building Lists}. -@end defun - -@node Predicates for Characters -@section The Predicates for Characters - -@defun characterp object -This function returns @code{t} if @var{object} is a character. - -Some functions that work on integers (e.g. the comparison functions -<, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.) -accept characters and implicitly convert them into integers. In -general, functions that work on characters also accept char-ints and -implicitly convert them into characters. WARNING: Neither of these -behaviors is very desirable, and they are maintained for backward -compatibility with old E-Lisp programs that confounded characters and -integers willy-nilly. These behaviors may change in the future; therefore, -do not rely on them. Instead, convert the characters explicitly -using @code{char-int}. -@end defun - -@defun integer-or-char-p object -This function returns @code{t} if @var{object} is an integer or character. -@end defun - -@node Character Codes -@section Character Codes - -@defun char-int ch -This function converts a character into an equivalent integer. -The resulting integer will always be non-negative. The integers in -the range 0 - 255 map to characters as follows: - -@table @asis -@item 0 - 31 -Control set 0 -@item 32 - 127 -@sc{ASCII} -@item 128 - 159 -Control set 1 -@item 160 - 255 -Right half of ISO-8859-1 -@end table - -If support for @sc{MULE} does not exist, these are the only valid -character values. When @sc{MULE} support exists, the values assigned to -other characters may vary depending on the particular version of XEmacs, -the order in which character sets were loaded, etc., and you should not -depend on them. -@end defun - -@defun int-char integer -This function converts an integer into the equivalent character. Not -all integers correspond to valid characters; use @code{char-int-p} to -determine whether this is the case. If the integer cannot be converted, -@code{nil} is returned. -@end defun - -@defun char-int-p object -This function returns @code{t} if @var{object} is an integer that can be -converted into a character. -@end defun - -@defun char-or-char-int-p object -This function returns @code{t} if @var{object} is a character or an -integer that can be converted into one. -@end defun - -@need 2000 -@node Text Comparison -@section Comparison of Characters and Strings -@cindex string equality - -@defun char-equal character1 character2 -This function returns @code{t} if the arguments represent the same -character, @code{nil} otherwise. This function ignores differences -in case if @code{case-fold-search} is non-@code{nil}. - -@example -(char-equal ?x ?x) - @result{} t -(let ((case-fold-search t)) - (char-equal ?x ?X)) - @result{} t -(let ((case-fold-search nil)) - (char-equal ?x ?X)) - @result{} nil -@end example -@end defun - -@defun char= character1 character2 -This function returns @code{t} if the arguments represent the same -character, @code{nil} otherwise. Case is significant. - -@example -(char= ?x ?x) - @result{} t -(char= ?x ?X) - @result{} nil -(let ((case-fold-search t)) - (char-equal ?x ?X)) - @result{} nil -(let ((case-fold-search nil)) - (char-equal ?x ?X)) - @result{} nil -@end example -@end defun - -@defun string= string1 string2 -This function returns @code{t} if the characters of the two strings -match exactly; case is significant. - -@example -(string= "abc" "abc") - @result{} t -(string= "abc" "ABC") - @result{} nil -(string= "ab" "ABC") - @result{} nil -@end example - -@ignore @c `equal' in XEmacs does not compare text properties -The function @code{string=} ignores the text properties of the -two strings. To compare strings in a way that compares their text -properties also, use @code{equal} (@pxref{Equality Predicates}). -@end ignore -@end defun - -@defun string-equal string1 string2 -@code{string-equal} is another name for @code{string=}. -@end defun - -@cindex lexical comparison -@defun string< string1 string2 -@c (findex string< causes problems for permuted index!!) -This function compares two strings a character at a time. First it -scans both the strings at once to find the first pair of corresponding -characters that do not match. If the lesser character of those two is -the character from @var{string1}, then @var{string1} is less, and this -function returns @code{t}. If the lesser character is the one from -@var{string2}, then @var{string1} is greater, and this function returns -@code{nil}. If the two strings match entirely, the value is @code{nil}. - -Pairs of characters are compared by their @sc{ASCII} codes. Keep in -mind that lower case letters have higher numeric values in the -@sc{ASCII} character set than their upper case counterparts; numbers and -many punctuation characters have a lower numeric value than upper case -letters. - -@example -@group -(string< "abc" "abd") - @result{} t -(string< "abd" "abc") - @result{} nil -(string< "123" "abc") - @result{} t -@end group -@end example - -When the strings have different lengths, and they match up to the -length of @var{string1}, then the result is @code{t}. If they match up -to the length of @var{string2}, the result is @code{nil}. A string of -no characters is less than any other string. - -@example -@group -(string< "" "abc") - @result{} t -(string< "ab" "abc") - @result{} t -(string< "abc" "") - @result{} nil -(string< "abc" "ab") - @result{} nil -(string< "" "") - @result{} nil -@end group -@end example -@end defun - -@defun string-lessp string1 string2 -@code{string-lessp} is another name for @code{string<}. -@end defun - - See also @code{compare-buffer-substrings} in @ref{Comparing Text}, for -a way to compare text in buffers. The function @code{string-match}, -which matches a regular expression against a string, can be used -for a kind of string comparison; see @ref{Regexp Search}. - -@node String Conversion -@section Conversion of Characters and Strings -@cindex conversion of strings - - This section describes functions for conversions between characters, -strings and integers. @code{format} and @code{prin1-to-string} -(@pxref{Output Functions}) can also convert Lisp objects into strings. -@code{read-from-string} (@pxref{Input Functions}) can ``convert'' a -string representation of a Lisp object into an object. - - @xref{Documentation}, for functions that produce textual descriptions -of text characters and general input events -(@code{single-key-description} and @code{text-char-description}). These -functions are used primarily for making help messages. - -@defun char-to-string character -@cindex character to string - This function returns a new string with a length of one character. -The value of @var{character}, modulo 256, is used to initialize the -element of the string. - -This function is similar to @code{make-string} with an integer argument -of 1. (@xref{Creating Strings}.) This conversion can also be done with -@code{format} using the @samp{%c} format specification. -(@xref{Formatting Strings}.) - -@example -(char-to-string ?x) - @result{} "x" -(char-to-string (+ 256 ?x)) - @result{} "x" -(make-string 1 ?x) - @result{} "x" -@end example -@end defun - -@defun string-to-char string -@cindex string to character - This function returns the first character in @var{string}. If the -string is empty, the function returns 0. (Under XEmacs 19, the value is -also 0 when the first character of @var{string} is the null character, -@sc{ASCII} code 0.) - -@example -(string-to-char "ABC") - @result{} ?A ;; @r{Under XEmacs 20.} - @result{} 65 ;; @r{Under XEmacs 19.} -(string-to-char "xyz") - @result{} ?x ;; @r{Under XEmacs 20.} - @result{} 120 ;; @r{Under XEmacs 19.} -(string-to-char "") - @result{} 0 -(string-to-char "\000") - @result{} ?\^@ ;; @r{Under XEmacs 20.} - @result{} 0 ;; @r{Under XEmacs 20.} -@end example - -This function may be eliminated in the future if it does not seem useful -enough to retain. -@end defun - -@defun number-to-string number -@cindex integer to string -@cindex integer to decimal -This function returns a string consisting of the printed -representation of @var{number}, which may be an integer or a floating -point number. The value starts with a sign if the argument is -negative. - -@example -(number-to-string 256) - @result{} "256" -(number-to-string -23) - @result{} "-23" -(number-to-string -23.5) - @result{} "-23.5" -@end example - -@cindex int-to-string -@code{int-to-string} is a semi-obsolete alias for this function. - -See also the function @code{format} in @ref{Formatting Strings}. -@end defun - -@defun string-to-number string &optional base -@cindex string to number -This function returns the numeric value of the characters in -@var{string}, read in @var{base}. It skips spaces and tabs at the -beginning of @var{string}, then reads as much of @var{string} as it can -interpret as a number. (On some systems it ignores other whitespace at -the beginning, not just spaces and tabs.) If the first character after -the ignored whitespace is not a digit or a minus sign, this function -returns 0. - -If @var{base} is not specified, it defaults to ten. With @var{base} -other than ten, only integers can be read. - -@example -(string-to-number "256") - @result{} 256 -(string-to-number "25 is a perfect square.") - @result{} 25 -(string-to-number "X256") - @result{} 0 -(string-to-number "-4.5") - @result{} -4.5 -(string-to-number "ffff" 16) - @result{} 65535 -@end example - -@findex string-to-int -@code{string-to-int} is an obsolete alias for this function. -@end defun - -@node Modifying Strings -@section Modifying Strings -@cindex strings, modifying - -You can modify a string using the general array-modifying primitives. -@xref{Arrays}. The function @code{aset} modifies a single character; -the function @code{fillarray} sets all characters in the string to -a specified character. - -Each string has a tick counter that starts out at zero (when the string -is created) and is incremented each time a change is made to that -string. - -@defun string-modified-tick string -This function returns the tick counter for @samp{string}. -@end defun - -@node String Properties -@section String Properties -@cindex string properties -@cindex properties of strings - -Similar to symbols, extents, faces, and glyphs, you can attach -additional information to strings in the form of @dfn{string -properties}. These differ from text properties, which are logically -attached to particular characters in the string. - -To attach a property to a string, use @code{put}. To retrieve a property -from a string, use @code{get}. You can also use @code{remprop} to remove -a property from a string and @code{object-props} to retrieve a list of -all the properties in a string. - -@node Formatting Strings -@section Formatting Strings -@cindex formatting strings -@cindex strings, formatting them - - @dfn{Formatting} means constructing a string by substitution of -computed values at various places in a constant string. This string -controls how the other values are printed as well as where they appear; -it is called a @dfn{format string}. - - Formatting is often useful for computing messages to be displayed. In -fact, the functions @code{message} and @code{error} provide the same -formatting feature described here; they differ from @code{format} only -in how they use the result of formatting. - -@defun format string &rest objects - This function returns a new string that is made by copying -@var{string} and then replacing any format specification -in the copy with encodings of the corresponding @var{objects}. The -arguments @var{objects} are the computed values to be formatted. -@end defun - -@cindex @samp{%} in format -@cindex format specification - A format specification is a sequence of characters beginning with a -@samp{%}. Thus, if there is a @samp{%d} in @var{string}, the -@code{format} function replaces it with the printed representation of -one of the values to be formatted (one of the arguments @var{objects}). -For example: - -@example -@group -(format "The value of fill-column is %d." fill-column) - @result{} "The value of fill-column is 72." -@end group -@end example - - If @var{string} contains more than one format specification, the -format specifications correspond with successive values from -@var{objects}. Thus, the first format specification in @var{string} -uses the first such value, the second format specification uses the -second such value, and so on. Any extra format specifications (those -for which there are no corresponding values) cause unpredictable -behavior. Any extra values to be formatted are ignored. - - Certain format specifications require values of particular types. -However, no error is signaled if the value actually supplied fails to -have the expected type. Instead, the output is likely to be -meaningless. - - Here is a table of valid format specifications: - -@table @samp -@item %s -Replace the specification with the printed representation of the object, -made without quoting. Thus, strings are represented by their contents -alone, with no @samp{"} characters, and symbols appear without @samp{\} -characters. This is equivalent to printing the object with @code{princ}. - -If there is no corresponding object, the empty string is used. - -@item %S -Replace the specification with the printed representation of the object, -made with quoting. Thus, strings are enclosed in @samp{"} characters, -and @samp{\} characters appear where necessary before special characters. -This is equivalent to printing the object with @code{prin1}. - -If there is no corresponding object, the empty string is used. - -@item %o -@cindex integer to octal -Replace the specification with the base-eight representation of an -integer. - -@item %d -@itemx %i -Replace the specification with the base-ten representation of an -integer. - -@item %x -@cindex integer to hexadecimal -Replace the specification with the base-sixteen representation of an -integer, using lowercase letters. - -@item %X -@cindex integer to hexadecimal -Replace the specification with the base-sixteen representation of an -integer, using uppercase letters. - -@item %c -Replace the specification with the character which is the value given. - -@item %e -Replace the specification with the exponential notation for a floating -point number (e.g. @samp{7.85200e+03}). - -@item %f -Replace the specification with the decimal-point notation for a floating -point number. - -@item %g -Replace the specification with notation for a floating point number, -using a ``pretty format''. Either exponential notation or decimal-point -notation will be used (usually whichever is shorter), and trailing -zeroes are removed from the fractional part. - -@item %% -A single @samp{%} is placed in the string. This format specification is -unusual in that it does not use a value. For example, @code{(format "%% -%d" 30)} returns @code{"% 30"}. -@end table - - Any other format character results in an @samp{Invalid format -operation} error. - - Here are several examples: - -@example -@group -(format "The name of this buffer is %s." (buffer-name)) - @result{} "The name of this buffer is strings.texi." - -(format "The buffer object prints as %s." (current-buffer)) - @result{} "The buffer object prints as #." - -(format "The octal value of %d is %o, - and the hex value is %x." 18 18 18) - @result{} "The octal value of 18 is 22, - and the hex value is 12." -@end group -@end example - - There are many additional flags and specifications that can occur -between the @samp{%} and the format character, in the following order: - -@enumerate -@item -An optional repositioning specification, which is a positive -integer followed by a @samp{$}. - -@item -Zero or more of the optional flag characters @samp{-}, @samp{+}, -@samp{ }, @samp{0}, and @samp{#}. - -@item -An asterisk (@samp{*}, meaning that the field width is now assumed to -have been specified as an argument. - -@item -An optional minimum field width. - -@item -An optional precision, preceded by a @samp{.} character. -@end enumerate - -@cindex repositioning format arguments -@cindex multilingual string formatting - A @dfn{repositioning} specification changes which argument to -@code{format} is used by the current and all following format -specifications. Normally the first specification uses the first -argument, the second specification uses the second argument, etc. Using -a repositioning specification, you can change this. By placing a number -@var{N} followed by a @samp{$} between the @samp{%} and the format -character, you cause the specification to use the @var{N}th argument. -The next specification will use the @var{N}+1'th argument, etc. - -For example: - -@example -@group -(format "Can't find file `%s' in directory `%s'." - "ignatius.c" "loyola/") - @result{} "Can't find file `ignatius.c' in directory `loyola/'." - -(format "In directory `%2$s', the file `%1$s' was not found." - "ignatius.c" "loyola/") - @result{} "In directory `loyola/', the file `ignatius.c' was not found." - -(format - "The numbers %d and %d are %1$x and %x in hex and %1$o and %o in octal." - 37 12) -@result{} "The numbers 37 and 12 are 25 and c in hex and 45 and 14 in octal." -@end group -@end example - -As you can see, this lets you reprocess arguments more than once or -reword a format specification (thereby moving the arguments around) -without having to actually reorder the arguments. This is especially -useful in translating messages from one language to another: Different -languages use different word orders, and this sometimes entails changing -the order of the arguments. By using repositioning specifications, -this can be accomplished without having to embed knowledge of particular -languages into the location in the program's code where the message is -displayed. - -@cindex numeric prefix -@cindex field width -@cindex padding - All the specification characters allow an optional numeric prefix -between the @samp{%} and the character, and following any repositioning -specification or flag. The optional numeric prefix defines the minimum -width for the object. If the printed representation of the object -contains fewer characters than this, then it is padded. The padding is -normally on the left, but will be on the right if the @samp{-} flag -character is given. The padding character is normally a space, but if -the @samp{0} flag character is given, zeros are used for padding. - -@example -(format "%06d is padded on the left with zeros" 123) - @result{} "000123 is padded on the left with zeros" - -(format "%-6d is padded on the right" 123) - @result{} "123 is padded on the right" -@end example - - @code{format} never truncates an object's printed representation, no -matter what width you specify. Thus, you can use a numeric prefix to -specify a minimum spacing between columns with no risk of losing -information. - - In the following three examples, @samp{%7s} specifies a minimum width -of 7. In the first case, the string inserted in place of @samp{%7s} has -only 3 letters, so 4 blank spaces are inserted for padding. In the -second case, the string @code{"specification"} is 13 letters wide but is -not truncated. In the third case, the padding is on the right. - -@smallexample -@group -(format "The word `%7s' actually has %d letters in it." - "foo" (length "foo")) - @result{} "The word ` foo' actually has 3 letters in it." -@end group - -@group -(format "The word `%7s' actually has %d letters in it." - "specification" (length "specification")) - @result{} "The word `specification' actually has 13 letters in it." -@end group - -@group -(format "The word `%-7s' actually has %d letters in it." - "foo" (length "foo")) - @result{} "The word `foo ' actually has 3 letters in it." -@end group -@end smallexample - -@cindex format precision -@cindex precision of formatted numbers - After any minimum field width, a precision may be specified by -preceding it with a @samp{.} character. The precision specifies the -minimum number of digits to appear in @samp{%d}, @samp{%i}, @samp{%o}, -@samp{%x}, and @samp{%X} conversions (the number is padded on the left -with zeroes as necessary); the number of digits printed after the -decimal point for @samp{%f}, @samp{%e}, and @samp{%E} conversions; the -number of significant digits printed in @samp{%g} and @samp{%G} -conversions; and the maximum number of non-padding characters printed in -@samp{%s} and @samp{%S} conversions. The default precision for -floating-point conversions is six. - -The other flag characters have the following meanings: - -@itemize @bullet -@item -The @samp{ } flag means prefix non-negative numbers with a space. - -@item -The @samp{+} flag means prefix non-negative numbers with a plus sign. - -@item -The @samp{#} flag means print numbers in an alternate, more verbose -format: octal numbers begin with zero; hex numbers begin with a -@samp{0x} or @samp{0X}; a decimal point is printed in @samp{%f}, -@samp{%e}, and @samp{%E} conversions even if no numbers are printed -after it; and trailing zeroes are not omitted in @samp{%g} and @samp{%G} -conversions. -@end itemize - -@node Character Case -@section Character Case -@cindex upper case -@cindex lower case -@cindex character case - - The character case functions change the case of single characters or -of the contents of strings. The functions convert only alphabetic -characters (the letters @samp{A} through @samp{Z} and @samp{a} through -@samp{z}); other characters are not altered. The functions do not -modify the strings that are passed to them as arguments. - - The examples below use the characters @samp{X} and @samp{x} which have -@sc{ASCII} codes 88 and 120 respectively. - -@defun downcase string-or-char -This function converts a character or a string to lower case. - -When the argument to @code{downcase} is a string, the function creates -and returns a new string in which each letter in the argument that is -upper case is converted to lower case. When the argument to -@code{downcase} is a character, @code{downcase} returns the -corresponding lower case character. (This value is actually an integer -under XEmacs 19.) If the original character is lower case, or is not a -letter, then the value equals the original character. - -@example -(downcase "The cat in the hat") - @result{} "the cat in the hat" - -(downcase ?X) - @result{} ?x ;; @r{Under XEmacs 20.} - @result{} 120 ;; @r{Under XEmacs 19.} - -@end example -@end defun - -@defun upcase string-or-char -This function converts a character or a string to upper case. - -When the argument to @code{upcase} is a string, the function creates -and returns a new string in which each letter in the argument that is -lower case is converted to upper case. - -When the argument to @code{upcase} is a character, @code{upcase} returns -the corresponding upper case character. (This value is actually an -integer under XEmacs 19.) If the original character is upper case, or -is not a letter, then the value equals the original character. - -@example -(upcase "The cat in the hat") - @result{} "THE CAT IN THE HAT" - -(upcase ?x) - @result{} ?X ;; @r{Under XEmacs 20.} - @result{} 88 ;; @r{Under XEmacs 19.} -@end example -@end defun - -@defun capitalize string-or-char -@cindex capitalization -This function capitalizes strings or characters. If -@var{string-or-char} is a string, the function creates and returns a new -string, whose contents are a copy of @var{string-or-char} in which each -word has been capitalized. This means that the first character of each -word is converted to upper case, and the rest are converted to lower -case. - -The definition of a word is any sequence of consecutive characters that -are assigned to the word constituent syntax class in the current syntax -table (@xref{Syntax Class Table}). - -When the argument to @code{capitalize} is a character, @code{capitalize} -has the same result as @code{upcase}. - -@example -(capitalize "The cat in the hat") - @result{} "The Cat In The Hat" - -(capitalize "THE 77TH-HATTED CAT") - @result{} "The 77th-Hatted Cat" - -@group -(capitalize ?x) - @result{} ?X ;; @r{Under XEmacs 20.} - @result{} 88 ;; @r{Under XEmacs 19.} -@end group -@end example -@end defun - -@node Case Tables -@section The Case Table - - You can customize case conversion by installing a special @dfn{case -table}. A case table specifies the mapping between upper case and lower -case letters. It affects both the string and character case conversion -functions (see the previous section) and those that apply to text in the -buffer (@pxref{Case Changes}). You need a case table if you are using a -language which has letters other than the standard @sc{ASCII} letters. - - A case table is a list of this form: - -@example -(@var{downcase} @var{upcase} @var{canonicalize} @var{equivalences}) -@end example - -@noindent -where each element is either @code{nil} or a string of length 256. The -element @var{downcase} says how to map each character to its lower-case -equivalent. The element @var{upcase} maps each character to its -upper-case equivalent. If lower and upper case characters are in -one-to-one correspondence, use @code{nil} for @var{upcase}; then XEmacs -deduces the upcase table from @var{downcase}. - - For some languages, upper and lower case letters are not in one-to-one -correspondence. There may be two different lower case letters with the -same upper case equivalent. In these cases, you need to specify the -maps for both directions. - - The element @var{canonicalize} maps each character to a canonical -equivalent; any two characters that are related by case-conversion have -the same canonical equivalent character. - - The element @var{equivalences} is a map that cyclicly permutes each -equivalence class (of characters with the same canonical equivalent). -(For ordinary @sc{ASCII}, this would map @samp{a} into @samp{A} and -@samp{A} into @samp{a}, and likewise for each set of equivalent -characters.) - - When you construct a case table, you can provide @code{nil} for -@var{canonicalize}; then Emacs fills in this string from @var{upcase} -and @var{downcase}. You can also provide @code{nil} for -@var{equivalences}; then Emacs fills in this string from -@var{canonicalize}. In a case table that is actually in use, those -components are non-@code{nil}. Do not try to specify @var{equivalences} -without also specifying @var{canonicalize}. - - Each buffer has a case table. XEmacs also has a @dfn{standard case -table} which is copied into each buffer when you create the buffer. -Changing the standard case table doesn't affect any existing buffers. - - Here are the functions for working with case tables: - -@defun case-table-p object -This predicate returns non-@code{nil} if @var{object} is a valid case -table. -@end defun - -@defun set-standard-case-table table -This function makes @var{table} the standard case table, so that it will -apply to any buffers created subsequently. -@end defun - -@defun standard-case-table -This returns the standard case table. -@end defun - -@defun current-case-table -This function returns the current buffer's case table. -@end defun - -@defun set-case-table table -This sets the current buffer's case table to @var{table}. -@end defun - - The following three functions are convenient subroutines for packages -that define non-@sc{ASCII} character sets. They modify a string -@var{downcase-table} provided as an argument; this should be a string to -be used as the @var{downcase} part of a case table. They also modify -the standard syntax table. @xref{Syntax Tables}. - -@defun set-case-syntax-pair uc lc downcase-table -This function specifies a pair of corresponding letters, one upper case -and one lower case. -@end defun - -@defun set-case-syntax-delims l r downcase-table -This function makes characters @var{l} and @var{r} a matching pair of -case-invariant delimiters. -@end defun - -@defun set-case-syntax char syntax downcase-table -This function makes @var{char} case-invariant, with syntax -@var{syntax}. -@end defun - -@deffn Command describe-buffer-case-table -This command displays a description of the contents of the current -buffer's case table. -@end deffn - -@cindex ISO Latin 1 -@pindex iso-syntax -You can load the library @file{iso-syntax} to set up the standard syntax -table and define a case table for the 8-bit ISO Latin 1 character set. - -@node Char Tables -@section The Char Table - -A char table is a table that maps characters (or ranges of characters) -to values. Char tables are specialized for characters, only allowing -particular sorts of ranges to be assigned values. Although this -loses in generality, it makes for extremely fast (constant-time) -lookups, and thus is feasible for applications that do an extremely -large number of lookups (e.g. scanning a buffer for a character in -a particular syntax, where a lookup in the syntax table must occur -once per character). - -Note that char tables as a primitive type, and all of the functions in -this section, exist only in XEmacs 20. In XEmacs 19, char tables are -generally implemented using a vector of 256 elements. - -When @sc{MULE} support exists, the types of ranges that can be assigned -values are - -@itemize @bullet -@item -all characters -@item -an entire charset -@item -a single row in a two-octet charset -@item -a single character -@end itemize - -When @sc{MULE} support is not present, the types of ranges that can be -assigned values are - -@itemize @bullet -@item -all characters -@item -a single character -@end itemize - -@defun char-table-p object -This function returns non-@code{nil} if @var{object} is a char table. -@end defun - -@menu -* Char Table Types:: Char tables have different uses. -* Working With Char Tables:: Creating and working with char tables. -@end menu - -@node Char Table Types -@subsection Char Table Types - -Each char table type is used for a different purpose and allows different -sorts of values. The different char table types are - -@table @code -@item category -Used for category tables, which specify the regexp categories -that a character is in. The valid values are @code{nil} or a -bit vector of 95 elements. Higher-level Lisp functions are -provided for working with category tables. Currently categories -and category tables only exist when @sc{MULE} support is present. -@item char -A generalized char table, for mapping from one character to -another. Used for case tables, syntax matching tables, -@code{keyboard-translate-table}, etc. The valid values are characters. -@item generic -An even more generalized char table, for mapping from a -character to anything. -@item display -Used for display tables, which specify how a particular character -is to appear when displayed. #### Not yet implemented. -@item syntax -Used for syntax tables, which specify the syntax of a particular -character. Higher-level Lisp functions are provided for -working with syntax tables. The valid values are integers. -@end table - -@defun char-table-type table -This function returns the type of char table @var{table}. -@end defun - -@defun char-table-type-list -This function returns a list of the recognized char table types. -@end defun - -@defun valid-char-table-type-p type -This function returns @code{t} if @var{type} if a recognized char table type. -@end defun - -@node Working With Char Tables -@subsection Working With Char Tables - -@defun make-char-table type -This function makes a new, empty char table of type @var{type}. -@var{type} should be a symbol, one of @code{char}, @code{category}, -@code{display}, @code{generic}, or @code{syntax}. -@end defun - -@defun put-char-table range val table -This function sets the value for chars in @var{range} to be @var{val} in -@var{table}. - -@var{range} specifies one or more characters to be affected and should be -one of the following: - -@itemize @bullet -@item -@code{t} (all characters are affected) -@item -A charset (only allowed when @sc{MULE} support is present) -@item -A vector of two elements: a two-octet charset and a row number -(only allowed when @sc{MULE} support is present) -@item -A single character -@end itemize - -@var{val} must be a value appropriate for the type of @var{table}. -@end defun - -@defun get-char-table ch table -This function finds the value for char @var{ch} in @var{table}. -@end defun - -@defun get-range-char-table range table &optional multi -This function finds the value for a range in @var{table}. If there is -more than one value, @var{multi} is returned (defaults to @code{nil}). -@end defun - -@defun reset-char-table table -This function resets a char table to its default state. -@end defun - -@defun map-char-table function table &optional range -This function maps @var{function} over entries in @var{table}, calling -it with two args, each key and value in the table. - -@var{range} specifies a subrange to map over and is in the same format -as the @var{range} argument to @code{put-range-table}. If omitted or -@code{t}, it defaults to the entire table. -@end defun - -@defun valid-char-table-value-p value char-table-type -This function returns non-@code{nil} if @var{value} is a valid value for -@var{char-table-type}. -@end defun - -@defun check-valid-char-table-value value char-table-type -This function signals an error if @var{value} is not a valid value for -@var{char-table-type}. -@end defun diff --git a/man/lispref/symbols.texi b/man/lispref/symbols.texi deleted file mode 100644 index 87315d5..0000000 --- a/man/lispref/symbols.texi +++ /dev/null @@ -1,555 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/symbols.info -@node Symbols, Evaluation, Sequences Arrays Vectors, Top -@chapter Symbols -@cindex symbol - - A @dfn{symbol} is an object with a unique name. This chapter -describes symbols, their components, their property lists, and how they -are created and interned. Separate chapters describe the use of symbols -as variables and as function names; see @ref{Variables}, and -@ref{Functions}. For the precise read syntax for symbols, see -@ref{Symbol Type}. - - You can test whether an arbitrary Lisp object is a symbol -with @code{symbolp}: - -@defun symbolp object -This function returns @code{t} if @var{object} is a symbol, @code{nil} -otherwise. -@end defun - -@menu -* Symbol Components:: Symbols have names, values, function definitions - and property lists. -* Definitions:: A definition says how a symbol will be used. -* Creating Symbols:: How symbols are kept unique. -* Symbol Properties:: Each symbol has a property list - for recording miscellaneous information. -@end menu - -@node Symbol Components -@section Symbol Components -@cindex symbol components - - Each symbol has four components (or ``cells''), each of which -references another object: - -@table @asis -@item Print name -@cindex print name cell -The @dfn{print name cell} holds a string that names the symbol for -reading and printing. See @code{symbol-name} in @ref{Creating Symbols}. - -@item Value -@cindex value cell -The @dfn{value cell} holds the current value of the symbol as a -variable. When a symbol is used as a form, the value of the form is the -contents of the symbol's value cell. See @code{symbol-value} in -@ref{Accessing Variables}. - -@item Function -@cindex function cell -The @dfn{function cell} holds the function definition of the symbol. -When a symbol is used as a function, its function definition is used in -its place. This cell is also used to make a symbol stand for a keymap -or a keyboard macro, for editor command execution. Because each symbol -has separate value and function cells, variables and function names do -not conflict. See @code{symbol-function} in @ref{Function Cells}. - -@item Property list -@cindex property list cell (symbol) -The @dfn{property list cell} holds the property list of the symbol. See -@code{symbol-plist} in @ref{Symbol Properties}. -@end table - - The print name cell always holds a string, and cannot be changed. The -other three cells can be set individually to any specified Lisp object. - - The print name cell holds the string that is the name of the symbol. -Since symbols are represented textually by their names, it is important -not to have two symbols with the same name. The Lisp reader ensures -this: every time it reads a symbol, it looks for an existing symbol with -the specified name before it creates a new one. (In XEmacs Lisp, -this lookup uses a hashing algorithm and an obarray; see @ref{Creating -Symbols}.) - - In normal usage, the function cell usually contains a function or -macro, as that is what the Lisp interpreter expects to see there -(@pxref{Evaluation}). Keyboard macros (@pxref{Keyboard Macros}), -keymaps (@pxref{Keymaps}) and autoload objects (@pxref{Autoloading}) are -also sometimes stored in the function cell of symbols. We often refer -to ``the function @code{foo}'' when we really mean the function stored -in the function cell of the symbol @code{foo}. We make the distinction -only when necessary. - - The property list cell normally should hold a correctly formatted -property list (@pxref{Property Lists}), as a number of functions expect -to see a property list there. - - The function cell or the value cell may be @dfn{void}, which means -that the cell does not reference any object. (This is not the same -thing as holding the symbol @code{void}, nor the same as holding the -symbol @code{nil}.) Examining a cell that is void results in an error, -such as @samp{Symbol's value as variable is void}. - - The four functions @code{symbol-name}, @code{symbol-value}, -@code{symbol-plist}, and @code{symbol-function} return the contents of -the four cells of a symbol. Here as an example we show the contents of -the four cells of the symbol @code{buffer-file-name}: - -@example -(symbol-name 'buffer-file-name) - @result{} "buffer-file-name" -(symbol-value 'buffer-file-name) - @result{} "/gnu/elisp/symbols.texi" -(symbol-plist 'buffer-file-name) - @result{} (variable-documentation 29529) -(symbol-function 'buffer-file-name) - @result{} # -@end example - -@noindent -Because this symbol is the variable which holds the name of the file -being visited in the current buffer, the value cell contents we see are -the name of the source file of this chapter of the XEmacs Lisp Manual. -The property list cell contains the list @code{(variable-documentation -29529)} which tells the documentation functions where to find the -documentation string for the variable @code{buffer-file-name} in the -@file{DOC} file. (29529 is the offset from the beginning of the -@file{DOC} file to where that documentation string begins.) The -function cell contains the function for returning the name of the file. -@code{buffer-file-name} names a primitive function, which has no read -syntax and prints in hash notation (@pxref{Primitive Function Type}). A -symbol naming a function written in Lisp would have a lambda expression -(or a byte-code object) in this cell. - -@node Definitions -@section Defining Symbols -@cindex definition of a symbol - - A @dfn{definition} in Lisp is a special form that announces your -intention to use a certain symbol in a particular way. In XEmacs Lisp, -you can define a symbol as a variable, or define it as a function (or -macro), or both independently. - - A definition construct typically specifies a value or meaning for the -symbol for one kind of use, plus documentation for its meaning when used -in this way. Thus, when you define a symbol as a variable, you can -supply an initial value for the variable, plus documentation for the -variable. - - @code{defvar} and @code{defconst} are special forms that define a -symbol as a global variable. They are documented in detail in -@ref{Defining Variables}. - - @code{defun} defines a symbol as a function, creating a lambda -expression and storing it in the function cell of the symbol. This -lambda expression thus becomes the function definition of the symbol. -(The term ``function definition'', meaning the contents of the function -cell, is derived from the idea that @code{defun} gives the symbol its -definition as a function.) @code{defsubst}, @code{define-function} and -@code{defalias} are other ways of defining a function. -@xref{Functions}. - - @code{defmacro} defines a symbol as a macro. It creates a macro -object and stores it in the function cell of the symbol. Note that a -given symbol can be a macro or a function, but not both at once, because -both macro and function definitions are kept in the function cell, and -that cell can hold only one Lisp object at any given time. -@xref{Macros}. - - In XEmacs Lisp, a definition is not required in order to use a symbol -as a variable or function. Thus, you can make a symbol a global -variable with @code{setq}, whether you define it first or not. The real -purpose of definitions is to guide programmers and programming tools. -They inform programmers who read the code that certain symbols are -@emph{intended} to be used as variables, or as functions. In addition, -utilities such as @file{etags} and @file{make-docfile} recognize -definitions, and add appropriate information to tag tables and the -@file{DOC} file. @xref{Accessing Documentation}. - -@node Creating Symbols -@section Creating and Interning Symbols -@cindex reading symbols - - To understand how symbols are created in XEmacs Lisp, you must know -how Lisp reads them. Lisp must ensure that it finds the same symbol -every time it reads the same set of characters. Failure to do so would -cause complete confusion. - -@cindex symbol name hashing -@cindex hashing -@cindex obarray -@cindex bucket (in obarray) - When the Lisp reader encounters a symbol, it reads all the characters -of the name. Then it ``hashes'' those characters to find an index in a -table called an @dfn{obarray}. Hashing is an efficient method of -looking something up. For example, instead of searching a telephone -book cover to cover when looking up Jan Jones, you start with the J's -and go from there. That is a simple version of hashing. Each element -of the obarray is a @dfn{bucket} which holds all the symbols with a -given hash code; to look for a given name, it is sufficient to look -through all the symbols in the bucket for that name's hash code. - -@cindex interning - If a symbol with the desired name is found, the reader uses that -symbol. If the obarray does not contain a symbol with that name, the -reader makes a new symbol and adds it to the obarray. Finding or adding -a symbol with a certain name is called @dfn{interning} it, and the -symbol is then called an @dfn{interned symbol}. - - Interning ensures that each obarray has just one symbol with any -particular name. Other like-named symbols may exist, but not in the -same obarray. Thus, the reader gets the same symbols for the same -names, as long as you keep reading with the same obarray. - -@cindex symbol equality -@cindex uninterned symbol - No obarray contains all symbols; in fact, some symbols are not in any -obarray. They are called @dfn{uninterned symbols}. An uninterned -symbol has the same four cells as other symbols; however, the only way -to gain access to it is by finding it in some other object or as the -value of a variable. - - In XEmacs Lisp, an obarray is actually a vector. Each element of the -vector is a bucket; its value is either an interned symbol whose name -hashes to that bucket, or 0 if the bucket is empty. Each interned -symbol has an internal link (invisible to the user) to the next symbol -in the bucket. Because these links are invisible, there is no way to -find all the symbols in an obarray except using @code{mapatoms} (below). -The order of symbols in a bucket is not significant. - - In an empty obarray, every element is 0, and you can create an obarray -with @code{(make-vector @var{length} 0)}. @strong{This is the only -valid way to create an obarray.} Prime numbers as lengths tend -to result in good hashing; lengths one less than a power of two are also -good. - - @strong{Do not try to put symbols in an obarray yourself.} This does -not work---only @code{intern} can enter a symbol in an obarray properly. -@strong{Do not try to intern one symbol in two obarrays.} This would -garble both obarrays, because a symbol has just one slot to hold the -following symbol in the obarray bucket. The results would be -unpredictable. - - It is possible for two different symbols to have the same name in -different obarrays; these symbols are not @code{eq} or @code{equal}. -However, this normally happens only as part of the abbrev mechanism -(@pxref{Abbrevs}). - -@cindex CL note---symbol in obarrays -@quotation -@b{Common Lisp note:} In Common Lisp, a single symbol may be interned in -several obarrays. -@end quotation - - Most of the functions below take a name and sometimes an obarray as -arguments. A @code{wrong-type-argument} error is signaled if the name -is not a string, or if the obarray is not a vector. - -@defun symbol-name symbol -This function returns the string that is @var{symbol}'s name. For example: - -@example -@group -(symbol-name 'foo) - @result{} "foo" -@end group -@end example - -Changing the string by substituting characters, etc, does change the -name of the symbol, but fails to update the obarray, so don't do it! -@end defun - -@defun make-symbol name -This function returns a newly-allocated, uninterned symbol whose name is -@var{name} (which must be a string). Its value and function definition -are void, and its property list is @code{nil}. In the example below, -the value of @code{sym} is not @code{eq} to @code{foo} because it is a -distinct uninterned symbol whose name is also @samp{foo}. - -@example -(setq sym (make-symbol "foo")) - @result{} foo -(eq sym 'foo) - @result{} nil -@end example -@end defun - -@defun intern name &optional obarray -This function returns the interned symbol whose name is @var{name}. If -there is no such symbol in the obarray @var{obarray}, @code{intern} -creates a new one, adds it to the obarray, and returns it. If -@var{obarray} is omitted, the value of the global variable -@code{obarray} is used. - -@example -(setq sym (intern "foo")) - @result{} foo -(eq sym 'foo) - @result{} t - -(setq sym1 (intern "foo" other-obarray)) - @result{} foo -(eq sym 'foo) - @result{} nil -@end example -@end defun - -@defun intern-soft name &optional obarray -This function returns the symbol in @var{obarray} whose name is -@var{name}, or @code{nil} if @var{obarray} has no symbol with that name. -Therefore, you can use @code{intern-soft} to test whether a symbol with -a given name is already interned. If @var{obarray} is omitted, the -value of the global variable @code{obarray} is used. - -@smallexample -(intern-soft "frazzle") ; @r{No such symbol exists.} - @result{} nil -(make-symbol "frazzle") ; @r{Create an uninterned one.} - @result{} frazzle -@group -(intern-soft "frazzle") ; @r{That one cannot be found.} - @result{} nil -@end group -@group -(setq sym (intern "frazzle")) ; @r{Create an interned one.} - @result{} frazzle -@end group -@group -(intern-soft "frazzle") ; @r{That one can be found!} - @result{} frazzle -@end group -@group -(eq sym 'frazzle) ; @r{And it is the same one.} - @result{} t -@end group -@end smallexample -@end defun - -@defvar obarray -This variable is the standard obarray for use by @code{intern} and -@code{read}. -@end defvar - -@defun mapatoms function &optional obarray -This function calls @var{function} for each symbol in the obarray -@var{obarray}. It returns @code{nil}. If @var{obarray} is omitted, it -defaults to the value of @code{obarray}, the standard obarray for -ordinary symbols. - -@smallexample -(setq count 0) - @result{} 0 -(defun count-syms (s) - (setq count (1+ count))) - @result{} count-syms -(mapatoms 'count-syms) - @result{} nil -count - @result{} 1871 -@end smallexample - -See @code{documentation} in @ref{Accessing Documentation}, for another -example using @code{mapatoms}. -@end defun - -@defun unintern symbol &optional obarray -This function deletes @var{symbol} from the obarray @var{obarray}. If -@code{symbol} is not actually in the obarray, @code{unintern} does -nothing. If @var{obarray} is @code{nil}, the current obarray is used. - -If you provide a string instead of a symbol as @var{symbol}, it stands -for a symbol name. Then @code{unintern} deletes the symbol (if any) in -the obarray which has that name. If there is no such symbol, -@code{unintern} does nothing. - -If @code{unintern} does delete a symbol, it returns @code{t}. Otherwise -it returns @code{nil}. -@end defun - -@node Symbol Properties -@section Symbol Properties -@cindex property list, symbol -@cindex plist, symbol - - A @dfn{property list} (@dfn{plist} for short) is a list of paired -elements stored in the property list cell of a symbol. Each of the -pairs associates a property name (usually a symbol) with a property or -value. Property lists are generally used to record information about a -symbol, such as its documentation as a variable, the name of the file -where it was defined, or perhaps even the grammatical class of the -symbol (representing a word) in a language-understanding system. - - Many objects other than symbols can have property lists associated -with them, and XEmacs provides a full complement of functions for -working with property lists. @xref{Property Lists}. - - The property names and values in a property list can be any Lisp -objects, but the names are usually symbols. They are compared using -@code{eq}. Here is an example of a property list, found on the symbol -@code{progn} when the compiler is loaded: - -@example -(lisp-indent-function 0 byte-compile byte-compile-progn) -@end example - -@noindent -Here @code{lisp-indent-function} and @code{byte-compile} are property -names, and the other two elements are the corresponding values. - -@menu -* Plists and Alists:: Comparison of the advantages of property - lists and association lists. -* Symbol Plists:: Functions to access symbols' property lists. -* Other Plists:: Accessing property lists stored elsewhere. -@end menu - -@node Plists and Alists -@subsection Property Lists and Association Lists - -@cindex property lists vs association lists - Association lists (@pxref{Association Lists}) are very similar to -property lists. In contrast to association lists, the order of the -pairs in the property list is not significant since the property names -must be distinct. - - Property lists are better than association lists for attaching -information to various Lisp function names or variables. If all the -associations are recorded in one association list, the program will need -to search that entire list each time a function or variable is to be -operated on. By contrast, if the information is recorded in the -property lists of the function names or variables themselves, each -search will scan only the length of one property list, which is usually -short. This is why the documentation for a variable is recorded in a -property named @code{variable-documentation}. The byte compiler -likewise uses properties to record those functions needing special -treatment. - - However, association lists have their own advantages. Depending on -your application, it may be faster to add an association to the front of -an association list than to update a property. All properties for a -symbol are stored in the same property list, so there is a possibility -of a conflict between different uses of a property name. (For this -reason, it is a good idea to choose property names that are probably -unique, such as by including the name of the library in the property -name.) An association list may be used like a stack where associations -are pushed on the front of the list and later discarded; this is not -possible with a property list. - -@node Symbol Plists -@subsection Property List Functions for Symbols - -@defun symbol-plist symbol -This function returns the property list of @var{symbol}. -@end defun - -@defun setplist symbol plist -This function sets @var{symbol}'s property list to @var{plist}. -Normally, @var{plist} should be a well-formed property list, but this is -not enforced. - -@smallexample -(setplist 'foo '(a 1 b (2 3) c nil)) - @result{} (a 1 b (2 3) c nil) -(symbol-plist 'foo) - @result{} (a 1 b (2 3) c nil) -@end smallexample - -For symbols in special obarrays, which are not used for ordinary -purposes, it may make sense to use the property list cell in a -nonstandard fashion; in fact, the abbrev mechanism does so -(@pxref{Abbrevs}). -@end defun - -@defun get symbol property -This function finds the value of the property named @var{property} in -@var{symbol}'s property list. If there is no such property, @code{nil} -is returned. Thus, there is no distinction between a value of -@code{nil} and the absence of the property. - -The name @var{property} is compared with the existing property names -using @code{eq}, so any object is a legitimate property. - -See @code{put} for an example. -@end defun - -@defun put symbol property value -This function puts @var{value} onto @var{symbol}'s property list under -the property name @var{property}, replacing any previous property value. -The @code{put} function returns @var{value}. - -@smallexample -(put 'fly 'verb 'transitive) - @result{}'transitive -(put 'fly 'noun '(a buzzing little bug)) - @result{} (a buzzing little bug) -(get 'fly 'verb) - @result{} transitive -(symbol-plist 'fly) - @result{} (verb transitive noun (a buzzing little bug)) -@end smallexample -@end defun - -@node Other Plists -@subsection Property Lists Outside Symbols - - These functions are useful for manipulating property lists -that are stored in places other than symbols: - -@defun getf plist property &optional default -This returns the value of the @var{property} property -stored in the property list @var{plist}. For example, - -@example -(getf '(foo 4) 'foo) - @result{} 4 -@end example -@end defun - -@defun putf plist property value -This stores @var{value} as the value of the @var{property} property in -the property list @var{plist}. It may modify @var{plist} destructively, -or it may construct a new list structure without altering the old. The -function returns the modified property list, so you can store that back -in the place where you got @var{plist}. For example, - -@example -(setq my-plist '(bar t foo 4)) - @result{} (bar t foo 4) -(setq my-plist (putf my-plist 'foo 69)) - @result{} (bar t foo 69) -(setq my-plist (putf my-plist 'quux '(a))) - @result{} (quux (a) bar t foo 5) -@end example -@end defun - -@defun plists-eq a b -This function returns non-@code{nil} if property lists @var{a} and @var{b} -are @code{eq}. This means that the property lists have the same values -for all the same properties, where comparison between values is done using -@code{eq}. -@end defun - -@defun plists-equal a b -This function returns non-@code{nil} if property lists @var{a} and @var{b} -are @code{equal}. -@end defun - -Both of the above functions do order-insensitive comparisons. - -@example -(plists-eq '(a 1 b 2 c nil) '(b 2 a 1)) - @result{} t -(plists-eq '(foo "hello" bar "goodbye") '(bar "goodbye" foo "hello")) - @result{} nil -(plists-equal '(foo "hello" bar "goodbye") '(bar "goodbye" foo "hello")) - @result{} t -@end example - - - diff --git a/man/lispref/syntax.texi b/man/lispref/syntax.texi deleted file mode 100644 index 82b93a0..0000000 --- a/man/lispref/syntax.texi +++ /dev/null @@ -1,750 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/syntax.info -@node Syntax Tables, Abbrevs, Searching and Matching, Top -@chapter Syntax Tables -@cindex parsing -@cindex syntax table -@cindex text parsing - - A @dfn{syntax table} specifies the syntactic textual function of each -character. This information is used by the parsing commands, the -complex movement commands, and others to determine where words, symbols, -and other syntactic constructs begin and end. The current syntax table -controls the meaning of the word motion functions (@pxref{Word Motion}) -and the list motion functions (@pxref{List Motion}) as well as the -functions in this chapter. - -@menu -* Basics: Syntax Basics. Basic concepts of syntax tables. -* Desc: Syntax Descriptors. How characters are classified. -* Syntax Table Functions:: How to create, examine and alter syntax tables. -* Motion and Syntax:: Moving over characters with certain syntaxes. -* Parsing Expressions:: Parsing balanced expressions - using the syntax table. -* Standard Syntax Tables:: Syntax tables used by various major modes. -* Syntax Table Internals:: How syntax table information is stored. -@end menu - -@node Syntax Basics -@section Syntax Table Concepts - -@ifinfo - A @dfn{syntax table} provides Emacs with the information that -determines the syntactic use of each character in a buffer. This -information is used by the parsing commands, the complex movement -commands, and others to determine where words, symbols, and other -syntactic constructs begin and end. The current syntax table controls -the meaning of the word motion functions (@pxref{Word Motion}) and the -list motion functions (@pxref{List Motion}) as well as the functions in -this chapter. -@end ifinfo - - Under XEmacs 20, a syntax table is a particular subtype of the -primitive char table type (@pxref{Char Tables}), and each element of the -char table is an integer that encodes the syntax of the character in -question, or a cons of such an integer and a matching character (for -characters with parenthesis syntax). - - Under XEmacs 19, a syntax table is a vector of 256 elements; it -contains one entry for each of the 256 possible characters in an 8-bit -byte. Each element is an integer that encodes the syntax of the -character in question. (The matching character, if any, is embedded -in the bits of this integer.) - - Syntax tables are used only for moving across text, not for the Emacs -Lisp reader. XEmacs Lisp uses built-in syntactic rules when reading Lisp -expressions, and these rules cannot be changed. - - Each buffer has its own major mode, and each major mode has its own -idea of the syntactic class of various characters. For example, in Lisp -mode, the character @samp{;} begins a comment, but in C mode, it -terminates a statement. To support these variations, XEmacs makes the -choice of syntax table local to each buffer. Typically, each major -mode has its own syntax table and installs that table in each buffer -that uses that mode. Changing this table alters the syntax in all -those buffers as well as in any buffers subsequently put in that mode. -Occasionally several similar modes share one syntax table. -@xref{Example Major Modes}, for an example of how to set up a syntax -table. - -A syntax table can inherit the data for some characters from the -standard syntax table, while specifying other characters itself. The -``inherit'' syntax class means ``inherit this character's syntax from -the standard syntax table.'' Most major modes' syntax tables inherit -the syntax of character codes 0 through 31 and 128 through 255. This is -useful with character sets such as ISO Latin-1 that have additional -alphabetic characters in the range 128 to 255. Just changing the -standard syntax for these characters affects all major modes. - -@defun syntax-table-p object -This function returns @code{t} if @var{object} is a vector of length 256 -elements. This means that the vector may be a syntax table. However, -according to this test, any vector of length 256 is considered to be a -syntax table, no matter what its contents. -@end defun - -@node Syntax Descriptors -@section Syntax Descriptors -@cindex syntax classes - - This section describes the syntax classes and flags that denote the -syntax of a character, and how they are represented as a @dfn{syntax -descriptor}, which is a Lisp string that you pass to -@code{modify-syntax-entry} to specify the desired syntax. - - XEmacs defines a number of @dfn{syntax classes}. Each syntax table -puts each character into one class. There is no necessary relationship -between the class of a character in one syntax table and its class in -any other table. - - Each class is designated by a mnemonic character, which serves as the -name of the class when you need to specify a class. Usually the -designator character is one that is frequently in that class; however, -its meaning as a designator is unvarying and independent of what syntax -that character currently has. - -@cindex syntax descriptor - A syntax descriptor is a Lisp string that specifies a syntax class, a -matching character (used only for the parenthesis classes) and flags. -The first character is the designator for a syntax class. The second -character is the character to match; if it is unused, put a space there. -Then come the characters for any desired flags. If no matching -character or flags are needed, one character is sufficient. - - For example, the descriptor for the character @samp{*} in C mode is -@samp{@w{. 23}} (i.e., punctuation, matching character slot unused, -second character of a comment-starter, first character of an -comment-ender), and the entry for @samp{/} is @samp{@w{. 14}} (i.e., -punctuation, matching character slot unused, first character of a -comment-starter, second character of a comment-ender). - -@menu -* Syntax Class Table:: Table of syntax classes. -* Syntax Flags:: Additional flags each character can have. -@end menu - -@node Syntax Class Table -@subsection Table of Syntax Classes - - Here is a table of syntax classes, the characters that stand for them, -their meanings, and examples of their use. - -@deffn {Syntax class} @w{whitespace character} -@dfn{Whitespace characters} (designated with @w{@samp{@ }} or @samp{-}) -separate symbols and words from each other. Typically, whitespace -characters have no other syntactic significance, and multiple whitespace -characters are syntactically equivalent to a single one. Space, tab, -newline and formfeed are almost always classified as whitespace. -@end deffn - -@deffn {Syntax class} @w{word constituent} -@dfn{Word constituents} (designated with @samp{w}) are parts of normal -English words and are typically used in variable and command names in -programs. All upper- and lower-case letters, and the digits, are typically -word constituents. -@end deffn - -@deffn {Syntax class} @w{symbol constituent} -@dfn{Symbol constituents} (designated with @samp{_}) are the extra -characters that are used in variable and command names along with word -constituents. For example, the symbol constituents class is used in -Lisp mode to indicate that certain characters may be part of symbol -names even though they are not part of English words. These characters -are @samp{$&*+-_<>}. In standard C, the only non-word-constituent -character that is valid in symbols is underscore (@samp{_}). -@end deffn - -@deffn {Syntax class} @w{punctuation character} -@dfn{Punctuation characters} (@samp{.}) are those characters that are -used as punctuation in English, or are used in some way in a programming -language to separate symbols from one another. Most programming -language modes, including Emacs Lisp mode, have no characters in this -class since the few characters that are not symbol or word constituents -all have other uses. -@end deffn - -@deffn {Syntax class} @w{open parenthesis character} -@deffnx {Syntax class} @w{close parenthesis character} -@cindex parenthesis syntax -Open and close @dfn{parenthesis characters} are characters used in -dissimilar pairs to surround sentences or expressions. Such a grouping -is begun with an open parenthesis character and terminated with a close. -Each open parenthesis character matches a particular close parenthesis -character, and vice versa. Normally, XEmacs indicates momentarily the -matching open parenthesis when you insert a close parenthesis. -@xref{Blinking}. - -The class of open parentheses is designated with @samp{(}, and that of -close parentheses with @samp{)}. - -In English text, and in C code, the parenthesis pairs are @samp{()}, -@samp{[]}, and @samp{@{@}}. In XEmacs Lisp, the delimiters for lists and -vectors (@samp{()} and @samp{[]}) are classified as parenthesis -characters. -@end deffn - -@deffn {Syntax class} @w{string quote} -@dfn{String quote characters} (designated with @samp{"}) are used in -many languages, including Lisp and C, to delimit string constants. The -same string quote character appears at the beginning and the end of a -string. Such quoted strings do not nest. - -The parsing facilities of XEmacs consider a string as a single token. -The usual syntactic meanings of the characters in the string are -suppressed. - -The Lisp modes have two string quote characters: double-quote (@samp{"}) -and vertical bar (@samp{|}). @samp{|} is not used in XEmacs Lisp, but it -is used in Common Lisp. C also has two string quote characters: -double-quote for strings, and single-quote (@samp{'}) for character -constants. - -English text has no string quote characters because English is not a -programming language. Although quotation marks are used in English, -we do not want them to turn off the usual syntactic properties of -other characters in the quotation. -@end deffn - -@deffn {Syntax class} @w{escape} -An @dfn{escape character} (designated with @samp{\}) starts an escape -sequence such as is used in C string and character constants. The -character @samp{\} belongs to this class in both C and Lisp. (In C, it -is used thus only inside strings, but it turns out to cause no trouble -to treat it this way throughout C code.) - -Characters in this class count as part of words if -@code{words-include-escapes} is non-@code{nil}. @xref{Word Motion}. -@end deffn - -@deffn {Syntax class} @w{character quote} -A @dfn{character quote character} (designated with @samp{/}) quotes the -following character so that it loses its normal syntactic meaning. This -differs from an escape character in that only the character immediately -following is ever affected. - -Characters in this class count as part of words if -@code{words-include-escapes} is non-@code{nil}. @xref{Word Motion}. - -This class is used for backslash in @TeX{} mode. -@end deffn - -@deffn {Syntax class} @w{paired delimiter} -@dfn{Paired delimiter characters} (designated with @samp{$}) are like -string quote characters except that the syntactic properties of the -characters between the delimiters are not suppressed. Only @TeX{} mode -uses a paired delimiter presently---the @samp{$} that both enters and -leaves math mode. -@end deffn - -@deffn {Syntax class} @w{expression prefix} -An @dfn{expression prefix operator} (designated with @samp{'}) is used -for syntactic operators that are part of an expression if they appear -next to one. These characters in Lisp include the apostrophe, @samp{'} -(used for quoting), the comma, @samp{,} (used in macros), and @samp{#} -(used in the read syntax for certain data types). -@end deffn - -@deffn {Syntax class} @w{comment starter} -@deffnx {Syntax class} @w{comment ender} -@cindex comment syntax -The @dfn{comment starter} and @dfn{comment ender} characters are used in -various languages to delimit comments. These classes are designated -with @samp{<} and @samp{>}, respectively. - -English text has no comment characters. In Lisp, the semicolon -(@samp{;}) starts a comment and a newline or formfeed ends one. -@end deffn - -@deffn {Syntax class} @w{inherit} -This syntax class does not specify a syntax. It says to look in the -standard syntax table to find the syntax of this character. The -designator for this syntax code is @samp{@@}. -@end deffn - -@node Syntax Flags -@subsection Syntax Flags -@cindex syntax flags - - In addition to the classes, entries for characters in a syntax table -can include flags. There are six possible flags, represented by the -characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b} and -@samp{p}. - - All the flags except @samp{p} are used to describe multi-character -comment delimiters. The digit flags indicate that a character can -@emph{also} be part of a comment sequence, in addition to the syntactic -properties associated with its character class. The flags are -independent of the class and each other for the sake of characters such -as @samp{*} in C mode, which is a punctuation character, @emph{and} the -second character of a start-of-comment sequence (@samp{/*}), @emph{and} -the first character of an end-of-comment sequence (@samp{*/}). - -The flags for a character @var{c} are: - -@itemize @bullet -@item -@samp{1} means @var{c} is the start of a two-character comment-start -sequence. - -@item -@samp{2} means @var{c} is the second character of such a sequence. - -@item -@samp{3} means @var{c} is the start of a two-character comment-end -sequence. - -@item -@samp{4} means @var{c} is the second character of such a sequence. - -@item -@c Emacs 19 feature -@samp{b} means that @var{c} as a comment delimiter belongs to the -alternative ``b'' comment style. - -Emacs supports two comment styles simultaneously in any one syntax -table. This is for the sake of C++. Each style of comment syntax has -its own comment-start sequence and its own comment-end sequence. Each -comment must stick to one style or the other; thus, if it starts with -the comment-start sequence of style ``b'', it must also end with the -comment-end sequence of style ``b''. - -The two comment-start sequences must begin with the same character; only -the second character may differ. Mark the second character of the -``b''-style comment-start sequence with the @samp{b} flag. - -A comment-end sequence (one or two characters) applies to the ``b'' -style if its first character has the @samp{b} flag set; otherwise, it -applies to the ``a'' style. - -The appropriate comment syntax settings for C++ are as follows: - -@table @asis -@item @samp{/} -@samp{124b} -@item @samp{*} -@samp{23} -@item newline -@samp{>b} -@end table - -This defines four comment-delimiting sequences: - -@table @asis -@item @samp{/*} -This is a comment-start sequence for ``a'' style because the -second character, @samp{*}, does not have the @samp{b} flag. - -@item @samp{//} -This is a comment-start sequence for ``b'' style because the second -character, @samp{/}, does have the @samp{b} flag. - -@item @samp{*/} -This is a comment-end sequence for ``a'' style because the first -character, @samp{*}, does not have the @samp{b} flag - -@item newline -This is a comment-end sequence for ``b'' style, because the newline -character has the @samp{b} flag. -@end table - -@item -@c Emacs 19 feature -@samp{p} identifies an additional ``prefix character'' for Lisp syntax. -These characters are treated as whitespace when they appear between -expressions. When they appear within an expression, they are handled -according to their usual syntax codes. - -The function @code{backward-prefix-chars} moves back over these -characters, as well as over characters whose primary syntax class is -prefix (@samp{'}). @xref{Motion and Syntax}. -@end itemize - -@node Syntax Table Functions -@section Syntax Table Functions - - In this section we describe functions for creating, accessing and -altering syntax tables. - -@defun make-syntax-table &optional table -This function creates a new syntax table. Character codes 0 through -31 and 128 through 255 are set up to inherit from the standard syntax -table. The other character codes are set up by copying what the -standard syntax table says about them. - -Most major mode syntax tables are created in this way. -@end defun - -@defun copy-syntax-table &optional table -This function constructs a copy of @var{table} and returns it. If -@var{table} is not supplied (or is @code{nil}), it returns a copy of the -current syntax table. Otherwise, an error is signaled if @var{table} is -not a syntax table. -@end defun - -@deffn Command modify-syntax-entry char syntax-descriptor &optional table -This function sets the syntax entry for @var{char} according to -@var{syntax-descriptor}. The syntax is changed only for @var{table}, -which defaults to the current buffer's syntax table, and not in any -other syntax table. The argument @var{syntax-descriptor} specifies the -desired syntax; this is a string beginning with a class designator -character, and optionally containing a matching character and flags as -well. @xref{Syntax Descriptors}. - -This function always returns @code{nil}. The old syntax information in -the table for this character is discarded. - -An error is signaled if the first character of the syntax descriptor is not -one of the twelve syntax class designator characters. An error is also -signaled if @var{char} is not a character. - -@example -@group -@exdent @r{Examples:} - -;; @r{Put the space character in class whitespace.} -(modify-syntax-entry ?\ " ") - @result{} nil -@end group - -@group -;; @r{Make @samp{$} an open parenthesis character,} -;; @r{with @samp{^} as its matching close.} -(modify-syntax-entry ?$ "(^") - @result{} nil -@end group - -@group -;; @r{Make @samp{^} a close parenthesis character,} -;; @r{with @samp{$} as its matching open.} -(modify-syntax-entry ?^ ")$") - @result{} nil -@end group - -@group -;; @r{Make @samp{/} a punctuation character,} -;; @r{the first character of a start-comment sequence,} -;; @r{and the second character of an end-comment sequence.} -;; @r{This is used in C mode.} -(modify-syntax-entry ?/ ". 14") - @result{} nil -@end group -@end example -@end deffn - -@defun char-syntax character -This function returns the syntax class of @var{character}, represented -by its mnemonic designator character. This @emph{only} returns the -class, not any matching parenthesis or flags. - -An error is signaled if @var{char} is not a character. - -The following examples apply to C mode. The first example shows that -the syntax class of space is whitespace (represented by a space). The -second example shows that the syntax of @samp{/} is punctuation. This -does not show the fact that it is also part of comment-start and -end -sequences. The third example shows that open parenthesis is in the class -of open parentheses. This does not show the fact that it has a matching -character, @samp{)}. - -@example -@group -(char-to-string (char-syntax ?\ )) - @result{} " " -@end group - -@group -(char-to-string (char-syntax ?/)) - @result{} "." -@end group - -@group -(char-to-string (char-syntax ?\()) - @result{} "(" -@end group -@end example -@end defun - -@defun set-syntax-table table &optional buffer -This function makes @var{table} the syntax table for @var{buffer}, which -defaults to the current buffer if omitted. It returns @var{table}. -@end defun - -@defun syntax-table &optional buffer -This function returns the syntax table for @var{buffer}, which defaults -to the current buffer if omitted. -@end defun - -@node Motion and Syntax -@section Motion and Syntax - - This section describes functions for moving across characters in -certain syntax classes. None of these functions exists in Emacs -version 18 or earlier. - -@defun skip-syntax-forward syntaxes &optional limit buffer -This function moves point forward across characters having syntax classes -mentioned in @var{syntaxes}. It stops when it encounters the end of -the buffer, or position @var{limit} (if specified), or a character it is -not supposed to skip. Optional argument @var{buffer} defaults to the -current buffer if omitted. -@ignore @c may want to change this. -The return value is the distance traveled, which is a nonnegative -integer. -@end ignore -@end defun - -@defun skip-syntax-backward syntaxes &optional limit buffer -This function moves point backward across characters whose syntax -classes are mentioned in @var{syntaxes}. It stops when it encounters -the beginning of the buffer, or position @var{limit} (if specified), or a -character it is not supposed to skip. Optional argument @var{buffer} -defaults to the current buffer if omitted. - -@ignore @c may want to change this. -The return value indicates the distance traveled. It is an integer that -is zero or less. -@end ignore -@end defun - -@defun backward-prefix-chars &optional buffer -This function moves point backward over any number of characters with -expression prefix syntax. This includes both characters in the -expression prefix syntax class, and characters with the @samp{p} flag. -Optional argument @var{buffer} defaults to the current buffer if -omitted. -@end defun - -@node Parsing Expressions -@section Parsing Balanced Expressions - - Here are several functions for parsing and scanning balanced -expressions, also known as @dfn{sexps}, in which parentheses match in -pairs. The syntax table controls the interpretation of characters, so -these functions can be used for Lisp expressions when in Lisp mode and -for C expressions when in C mode. @xref{List Motion}, for convenient -higher-level functions for moving over balanced expressions. - -@defun parse-partial-sexp start limit &optional target-depth stop-before state stop-comment buffer -This function parses a sexp in the current buffer starting at -@var{start}, not scanning past @var{limit}. It stops at position -@var{limit} or when certain criteria described below are met, and sets -point to the location where parsing stops. It returns a value -describing the status of the parse at the point where it stops. - -If @var{state} is @code{nil}, @var{start} is assumed to be at the top -level of parenthesis structure, such as the beginning of a function -definition. Alternatively, you might wish to resume parsing in the -middle of the structure. To do this, you must provide a @var{state} -argument that describes the initial status of parsing. - -@cindex parenthesis depth -If the third argument @var{target-depth} is non-@code{nil}, parsing -stops if the depth in parentheses becomes equal to @var{target-depth}. -The depth starts at 0, or at whatever is given in @var{state}. - -If the fourth argument @var{stop-before} is non-@code{nil}, parsing -stops when it comes to any character that starts a sexp. If -@var{stop-comment} is non-@code{nil}, parsing stops when it comes to the -start of a comment. - -@cindex parse state -The fifth argument @var{state} is an eight-element list of the same -form as the value of this function, described below. The return value -of one call may be used to initialize the state of the parse on another -call to @code{parse-partial-sexp}. - -The result is a list of eight elements describing the final state of -the parse: - -@enumerate 0 -@item -The depth in parentheses, counting from 0. - -@item -@cindex innermost containing parentheses -The character position of the start of the innermost parenthetical -grouping containing the stopping point; @code{nil} if none. - -@item -@cindex previous complete subexpression -The character position of the start of the last complete subexpression -terminated; @code{nil} if none. - -@item -@cindex inside string -Non-@code{nil} if inside a string. More precisely, this is the -character that will terminate the string. - -@item -@cindex inside comment -@code{t} if inside a comment (of either style). - -@item -@cindex quote character -@code{t} if point is just after a quote character. - -@item -The minimum parenthesis depth encountered during this scan. - -@item -@code{t} if inside a comment of style ``b''. -@end enumerate - -Elements 0, 3, 4, 5 and 7 are significant in the argument @var{state}. - -@cindex indenting with parentheses -This function is most often used to compute indentation for languages -that have nested parentheses. -@end defun - -@defun scan-lists from count depth &optional buffer noerror -This function scans forward @var{count} balanced parenthetical groupings -from character number @var{from}. It returns the character position -where the scan stops. - -If @var{depth} is nonzero, parenthesis depth counting begins from that -value. The only candidates for stopping are places where the depth in -parentheses becomes zero; @code{scan-lists} counts @var{count} such -places and then stops. Thus, a positive value for @var{depth} means go -out @var{depth} levels of parenthesis. - -Scanning ignores comments if @code{parse-sexp-ignore-comments} is -non-@code{nil}. - -If the scan reaches the beginning or end of the buffer (or its -accessible portion), and the depth is not zero, an error is signaled. -If the depth is zero but the count is not used up, @code{nil} is -returned. - -If optional arg @var{buffer} is non-@code{nil}, scanning occurs in that -buffer instead of in the current buffer. - -If optional arg @var{noerror} is non-@code{nil}, @code{scan-lists} -will return @code{nil} instead of signalling an error. -@end defun - -@defun scan-sexps from count &optional buffer noerror -This function scans forward @var{count} sexps from character position -@var{from}. It returns the character position where the scan stops. - -Scanning ignores comments if @code{parse-sexp-ignore-comments} is -non-@code{nil}. - -If the scan reaches the beginning or end of (the accessible part of) the -buffer in the middle of a parenthetical grouping, an error is signaled. -If it reaches the beginning or end between groupings but before count is -used up, @code{nil} is returned. - -If optional arg @var{buffer} is non-@code{nil}, scanning occurs in -that buffer instead of in the current buffer. - -If optional arg @var{noerror} is non-@code{nil}, @code{scan-sexps} -will return nil instead of signalling an error. -@end defun - -@defvar parse-sexp-ignore-comments -@cindex skipping comments -If the value is non-@code{nil}, then comments are treated as -whitespace by the functions in this section and by @code{forward-sexp}. - -In older Emacs versions, this feature worked only when the comment -terminator is something like @samp{*/}, and appears only to end a -comment. In languages where newlines terminate comments, it was -necessary make this variable @code{nil}, since not every newline is the -end of a comment. This limitation no longer exists. -@end defvar - -You can use @code{forward-comment} to move forward or backward over -one comment or several comments. - -@defun forward-comment count &optional buffer -This function moves point forward across @var{count} comments (backward, -if @var{count} is negative). If it finds anything other than a comment -or whitespace, it stops, leaving point at the place where it stopped. -It also stops after satisfying @var{count}. - - Optional argument @var{buffer} defaults to the current buffer. -@end defun - -To move forward over all comments and whitespace following point, use -@code{(forward-comment (buffer-size))}. @code{(buffer-size)} is a good -argument to use, because the number of comments in the buffer cannot -exceed that many. - -@node Standard Syntax Tables -@section Some Standard Syntax Tables - - Most of the major modes in XEmacs have their own syntax tables. Here -are several of them: - -@defun standard-syntax-table -This function returns the standard syntax table, which is the syntax -table used in Fundamental mode. -@end defun - -@defvar text-mode-syntax-table -The value of this variable is the syntax table used in Text mode. -@end defvar - -@defvar c-mode-syntax-table -The value of this variable is the syntax table for C-mode buffers. -@end defvar - -@defvar emacs-lisp-mode-syntax-table -The value of this variable is the syntax table used in Emacs Lisp mode -by editing commands. (It has no effect on the Lisp @code{read} -function.) -@end defvar - -@node Syntax Table Internals -@section Syntax Table Internals -@cindex syntax table internals - - Each element of a syntax table is an integer that encodes the syntax -of one character: the syntax class, possible matching character, and -flags. Lisp programs don't usually work with the elements directly; the -Lisp-level syntax table functions usually work with syntax descriptors -(@pxref{Syntax Descriptors}). - - The low 8 bits of each element of a syntax table indicate the -syntax class. - -@table @asis -@item @i{Integer} -@i{Class} -@item 0 -whitespace -@item 1 -punctuation -@item 2 -word -@item 3 -symbol -@item 4 -open parenthesis -@item 5 -close parenthesis -@item 6 -expression prefix -@item 7 -string quote -@item 8 -paired delimiter -@item 9 -escape -@item 10 -character quote -@item 11 -comment-start -@item 12 -comment-end -@item 13 -inherit -@end table - - The next 8 bits are the matching opposite parenthesis (if the -character has parenthesis syntax); otherwise, they are not meaningful. -The next 6 bits are the flags. diff --git a/man/lispref/text.texi b/man/lispref/text.texi deleted file mode 100644 index f66bf59..0000000 --- a/man/lispref/text.texi +++ /dev/null @@ -1,2807 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/text.info -@node Text, Searching and Matching, Markers, Top -@chapter Text -@cindex text - - This chapter describes the functions that deal with the text in a -buffer. Most examine, insert, or delete text in the current buffer, -often in the vicinity of point. Many are interactive. All the -functions that change the text provide for undoing the changes -(@pxref{Undo}). - - Many text-related functions operate on a region of text defined by two -buffer positions passed in arguments named @var{start} and @var{end}. -These arguments should be either markers (@pxref{Markers}) or numeric -character positions (@pxref{Positions}). The order of these arguments -does not matter; it is all right for @var{start} to be the end of the -region and @var{end} the beginning. For example, @code{(delete-region 1 -10)} and @code{(delete-region 10 1)} are equivalent. An -@code{args-out-of-range} error is signaled if either @var{start} or -@var{end} is outside the accessible portion of the buffer. In an -interactive call, point and the mark are used for these arguments. - -@cindex buffer contents - Throughout this chapter, ``text'' refers to the characters in the -buffer, together with their properties (when relevant). - -@menu -* Near Point:: Examining text in the vicinity of point. -* Buffer Contents:: Examining text in a general fashion. -* Comparing Text:: Comparing substrings of buffers. -* Insertion:: Adding new text to a buffer. -* Commands for Insertion:: User-level commands to insert text. -* Deletion:: Removing text from a buffer. -* User-Level Deletion:: User-level commands to delete text. -* The Kill Ring:: Where removed text sometimes is saved for later use. -* Undo:: Undoing changes to the text of a buffer. -* Maintaining Undo:: How to enable and disable undo information. - How to control how much information is kept. -* Filling:: Functions for explicit filling. -* Margins:: How to specify margins for filling commands. -* Auto Filling:: How auto-fill mode is implemented to break lines. -* Sorting:: Functions for sorting parts of the buffer. -* Columns:: Computing horizontal positions, and using them. -* Indentation:: Functions to insert or adjust indentation. -* Case Changes:: Case conversion of parts of the buffer. -* Text Properties:: Assigning Lisp property lists to text characters. -* Substitution:: Replacing a given character wherever it appears. -* Registers:: How registers are implemented. Accessing the text or - position stored in a register. -* Transposition:: Swapping two portions of a buffer. -* Change Hooks:: Supplying functions to be run when text is changed. -* Transformations:: MD5 and base64 support. -@end menu - -@node Near Point -@section Examining Text Near Point - - Many functions are provided to look at the characters around point. -Several simple functions are described here. See also @code{looking-at} -in @ref{Regexp Search}. - - Many of these functions take an optional @var{buffer} argument. -In all such cases, the current buffer will be used if this argument -is omitted. (In FSF Emacs, and earlier versions of XEmacs, these -functions usually did not have these optional @var{buffer} arguments -and always operated on the current buffer.) - - -@defun char-after position &optional buffer -This function returns the character in the buffer at (i.e., -immediately after) position @var{position}. If @var{position} is out of -range for this purpose, either before the beginning of the buffer, or at -or beyond the end, then the value is @code{nil}. If optional argument -@var{buffer} is @code{nil}, the current buffer is assumed. - -In the following example, assume that the first character in the -buffer is @samp{@@}: - -@example -@group -(char-to-string (char-after 1)) - @result{} "@@" -@end group -@end example -@end defun - -@defun following-char &optional buffer -This function returns the character following point in the buffer. -This is similar to @code{(char-after (point))}. However, if point is at -the end of the buffer, then the result of @code{following-char} is 0. -If optional argument @var{buffer} is @code{nil}, the current buffer is -assumed. - -Remember that point is always between characters, and the terminal -cursor normally appears over the character following point. Therefore, -the character returned by @code{following-char} is the character the -cursor is over. - -In this example, point is between the @samp{a} and the @samp{c}. - -@example -@group ----------- Buffer: foo ---------- -Gentlemen may cry ``Pea@point{}ce! Peace!,'' -but there is no peace. ----------- Buffer: foo ---------- -@end group - -@group -(char-to-string (preceding-char)) - @result{} "a" -(char-to-string (following-char)) - @result{} "c" -@end group -@end example -@end defun - -@defun preceding-char &optional buffer -This function returns the character preceding point in the buffer. -See above, under @code{following-char}, for an example. If -point is at the beginning of the buffer, @code{preceding-char} returns -0. If optional argument @var{buffer} is @code{nil}, the current buffer -is assumed. -@end defun - -@defun bobp &optional buffer -This function returns @code{t} if point is at the beginning of the -buffer. If narrowing is in effect, this means the beginning of the -accessible portion of the text. If optional argument @var{buffer} is -@code{nil}, the current buffer is assumed. See also @code{point-min} in -@ref{Point}. -@end defun - -@defun eobp &optional buffer -This function returns @code{t} if point is at the end of the buffer. -If narrowing is in effect, this means the end of accessible portion of -the text. If optional argument @var{buffer} is @code{nil}, the current -buffer is assumed. See also @code{point-max} in @xref{Point}. -@end defun - -@defun bolp &optional buffer -This function returns @code{t} if point is at the beginning of a line. -If optional argument @var{buffer} is @code{nil}, the current buffer is -assumed. @xref{Text Lines}. The beginning of the buffer (or its -accessible portion) always counts as the beginning of a line. -@end defun - -@defun eolp &optional buffer -This function returns @code{t} if point is at the end of a line. The -end of the buffer is always considered the end of a line. If optional -argument @var{buffer} is @code{nil}, the current buffer is assumed. -The end of the buffer (or of its accessible portion) is always considered -the end of a line. -@end defun - -@node Buffer Contents -@section Examining Buffer Contents - - This section describes two functions that allow a Lisp program to -convert any portion of the text in the buffer into a string. - -@defun buffer-substring start end &optional buffer -@defunx buffer-string start end &optional buffer -These functions are equivalent and return a string containing a copy of -the text of the region defined by positions @var{start} and @var{end} in -the buffer. If the arguments are not positions in the accessible -portion of the buffer, @code{buffer-substring} signals an -@code{args-out-of-range} error. If optional argument @var{buffer} is -@code{nil}, the current buffer is assumed. - -@c XEmacs feature. - If the region delineated by @var{start} and @var{end} contains -duplicable extents, they will be remembered in the string. -@xref{Duplicable Extents}. - -It is not necessary for @var{start} to be less than @var{end}; the -arguments can be given in either order. But most often the smaller -argument is written first. - -@example -@group ----------- Buffer: foo ---------- -This is the contents of buffer foo - ----------- Buffer: foo ---------- -@end group - -@group -(buffer-substring 1 10) -@result{} "This is t" -@end group -@group -(buffer-substring (point-max) 10) -@result{} "he contents of buffer foo -" -@end group -@end example -@end defun - -@ignore -@c `equal' in XEmacs does not compare text properties on strings -@defun buffer-substring-without-properties start end -This is like @code{buffer-substring}, except that it does not copy text -properties, just the characters themselves. @xref{Text Properties}. -Here's an example of using this function to get a word to look up in an -alist: - -@example -(setq flammable - (assoc (buffer-substring start end) - '(("wood" . t) ("paper" . t) - ("steel" . nil) ("asbestos" . nil)))) -@end example - -If this were written using @code{buffer-substring} instead, it would not -work reliably; any text properties that happened to be in the word -copied from the buffer would make the comparisons fail. -@end defun -@end ignore - -@node Comparing Text -@section Comparing Text -@cindex comparing buffer text - - This function lets you compare portions of the text in a buffer, without -copying them into strings first. - -@defun compare-buffer-substrings buffer1 start1 end1 buffer2 start2 end2 -This function lets you compare two substrings of the same buffer or two -different buffers. The first three arguments specify one substring, -giving a buffer and two positions within the buffer. The last three -arguments specify the other substring in the same way. You can use -@code{nil} for @var{buffer1}, @var{buffer2}, or both to stand for the -current buffer. - -The value is negative if the first substring is less, positive if the -first is greater, and zero if they are equal. The absolute value of -the result is one plus the index of the first differing characters -within the substrings. - -This function ignores case when comparing characters -if @code{case-fold-search} is non-@code{nil}. It always ignores -text properties. - -Suppose the current buffer contains the text @samp{foobarbar -haha!rara!}; then in this example the two substrings are @samp{rbar } -and @samp{rara!}. The value is 2 because the first substring is greater -at the second character. - -@example -(compare-buffer-substring nil 6 11 nil 16 21) - @result{} 2 -@end example -@end defun - -@node Insertion -@section Inserting Text -@cindex insertion of text -@cindex text insertion - - @dfn{Insertion} means adding new text to a buffer. The inserted text -goes at point---between the character before point and the character -after point. - - Insertion relocates markers that point at positions after the -insertion point, so that they stay with the surrounding text -(@pxref{Markers}). When a marker points at the place of insertion, -insertion normally doesn't relocate the marker, so that it points to the -beginning of the inserted text; however, certain special functions such -as @code{insert-before-markers} relocate such markers to point after the -inserted text. - -@cindex insertion before point -@cindex before point, insertion - Some insertion functions leave point before the inserted text, while -other functions leave it after. We call the former insertion @dfn{after -point} and the latter insertion @dfn{before point}. - -@c XEmacs feature. - If a string with non-@code{nil} extent data is inserted, the remembered -extents will also be inserted. @xref{Duplicable Extents}. - - Insertion functions signal an error if the current buffer is -read-only. - - These functions copy text characters from strings and buffers along -with their properties. The inserted characters have exactly the same -properties as the characters they were copied from. By contrast, -characters specified as separate arguments, not part of a string or -buffer, inherit their text properties from the neighboring text. - -@defun insert &rest args -This function inserts the strings and/or characters @var{args} into the -current buffer, at point, moving point forward. In other words, it -inserts the text before point. An error is signaled unless all -@var{args} are either strings or characters. The value is @code{nil}. -@end defun - -@defun insert-before-markers &rest args -This function inserts the strings and/or characters @var{args} into the -current buffer, at point, moving point forward. An error is signaled -unless all @var{args} are either strings or characters. The value is -@code{nil}. - -This function is unlike the other insertion functions in that it -relocates markers initially pointing at the insertion point, to point -after the inserted text. -@end defun - -@defun insert-string string &optional buffer -This function inserts @var{string} into @var{buffer} before point. -@var{buffer} defaults to the current buffer if omitted. This -function is chiefly useful if you want to insert a string in -a buffer other than the current one (otherwise you could just -use @code{insert}). -@end defun - -@defun insert-char character count &optional buffer -This function inserts @var{count} instances of @var{character} into -@var{buffer} before point. @var{count} must be a number, and -@var{character} must be a character. The value is @code{nil}. If -optional argument @var{buffer} is @code{nil}, the current buffer is -assumed. (In FSF Emacs, the third argument is called @var{inherit} -and refers to text properties.) -@end defun - -@defun insert-buffer-substring from-buffer-or-name &optional start end -This function inserts a portion of buffer @var{from-buffer-or-name} -(which must already exist) into the current buffer before point. The -text inserted is the region from @var{start} and @var{end}. (These -arguments default to the beginning and end of the accessible portion of -that buffer.) This function returns @code{nil}. - -In this example, the form is executed with buffer @samp{bar} as the -current buffer. We assume that buffer @samp{bar} is initially empty. - -@example -@group ----------- Buffer: foo ---------- -We hold these truths to be self-evident, that all ----------- Buffer: foo ---------- -@end group - -@group -(insert-buffer-substring "foo" 1 20) - @result{} nil - ----------- Buffer: bar ---------- -We hold these truth@point{} ----------- Buffer: bar ---------- -@end group -@end example -@end defun - -@node Commands for Insertion -@section User-Level Insertion Commands - - This section describes higher-level commands for inserting text, -commands intended primarily for the user but useful also in Lisp -programs. - -@deffn Command insert-buffer from-buffer-or-name -This command inserts the entire contents of @var{from-buffer-or-name} -(which must exist) into the current buffer after point. It leaves -the mark after the inserted text. The value is @code{nil}. -@end deffn - -@deffn Command self-insert-command count -@cindex character insertion -@cindex self-insertion -This command inserts the last character typed; it does so @var{count} -times, before point, and returns @code{nil}. Most printing characters -are bound to this command. In routine use, @code{self-insert-command} -is the most frequently called function in XEmacs, but programs rarely use -it except to install it on a keymap. - -In an interactive call, @var{count} is the numeric prefix argument. - -This command calls @code{auto-fill-function} whenever that is -non-@code{nil} and the character inserted is a space or a newline -(@pxref{Auto Filling}). - -@c Cross refs reworded to prevent overfull hbox. --rjc 15mar92 -This command performs abbrev expansion if Abbrev mode is enabled and -the inserted character does not have word-constituent -syntax. (@xref{Abbrevs}, and @ref{Syntax Class Table}.) - -This is also responsible for calling @code{blink-paren-function} when -the inserted character has close parenthesis syntax (@pxref{Blinking}). -@end deffn - -@deffn Command newline &optional number-of-newlines -This command inserts newlines into the current buffer before point. -If @var{number-of-newlines} is supplied, that many newline characters -are inserted. - -@cindex newline and Auto Fill mode -This function calls @code{auto-fill-function} if the current column -number is greater than the value of @code{fill-column} and -@var{number-of-newlines} is @code{nil}. Typically what -@code{auto-fill-function} does is insert a newline; thus, the overall -result in this case is to insert two newlines at different places: one -at point, and another earlier in the line. @code{newline} does not -auto-fill if @var{number-of-newlines} is non-@code{nil}. - -This command indents to the left margin if that is not zero. -@xref{Margins}. - -The value returned is @code{nil}. In an interactive call, @var{count} -is the numeric prefix argument. -@end deffn - -@deffn Command split-line -This command splits the current line, moving the portion of the line -after point down vertically so that it is on the next line directly -below where it was before. Whitespace is inserted as needed at the -beginning of the lower line, using the @code{indent-to} function. -@code{split-line} returns the position of point. - -Programs hardly ever use this function. -@end deffn - -@defvar overwrite-mode -This variable controls whether overwrite mode is in effect: a -non-@code{nil} value enables the mode. It is automatically made -buffer-local when set in any fashion. -@end defvar - -@node Deletion -@section Deleting Text - -@cindex deletion vs killing - Deletion means removing part of the text in a buffer, without saving -it in the kill ring (@pxref{The Kill Ring}). Deleted text can't be -yanked, but can be reinserted using the undo mechanism (@pxref{Undo}). -Some deletion functions do save text in the kill ring in some special -cases. - - All of the deletion functions operate on the current buffer, and all -return a value of @code{nil}. - -@defun erase-buffer &optional buffer -This function deletes the entire text of @var{buffer}, leaving it -empty. If the buffer is read-only, it signals a @code{buffer-read-only} -error. Otherwise, it deletes the text without asking for any -confirmation. It returns @code{nil}. @var{buffer} defaults to the -current buffer if omitted. - -Normally, deleting a large amount of text from a buffer inhibits further -auto-saving of that buffer ``because it has shrunk''. However, -@code{erase-buffer} does not do this, the idea being that the future -text is not really related to the former text, and its size should not -be compared with that of the former text. -@end defun - -@deffn Command delete-region start end &optional buffer -This command deletes the text in @var{buffer} in the region defined by -@var{start} and @var{end}. The value is @code{nil}. If optional -argument @var{buffer} is @code{nil}, the current buffer is assumed. -@end deffn - -@deffn Command delete-char count &optional killp -This command deletes @var{count} characters directly after point, or -before point if @var{count} is negative. If @var{killp} is -non-@code{nil}, then it saves the deleted characters in the kill ring. - -In an interactive call, @var{count} is the numeric prefix argument, and -@var{killp} is the unprocessed prefix argument. Therefore, if a prefix -argument is supplied, the text is saved in the kill ring. If no prefix -argument is supplied, then one character is deleted, but not saved in -the kill ring. - -The value returned is always @code{nil}. -@end deffn - -@deffn Command delete-backward-char count &optional killp -@cindex delete previous char -This command deletes @var{count} characters directly before point, or -after point if @var{count} is negative. If @var{killp} is -non-@code{nil}, then it saves the deleted characters in the kill ring. - -In an interactive call, @var{count} is the numeric prefix argument, and -@var{killp} is the unprocessed prefix argument. Therefore, if a prefix -argument is supplied, the text is saved in the kill ring. If no prefix -argument is supplied, then one character is deleted, but not saved in -the kill ring. - -The value returned is always @code{nil}. -@end deffn - -@deffn Command backward-delete-char-untabify count &optional killp -@cindex tab deletion -This command deletes @var{count} characters backward, changing tabs -into spaces. When the next character to be deleted is a tab, it is -first replaced with the proper number of spaces to preserve alignment -and then one of those spaces is deleted instead of the tab. If -@var{killp} is non-@code{nil}, then the command saves the deleted -characters in the kill ring. - -Conversion of tabs to spaces happens only if @var{count} is positive. -If it is negative, exactly @minus{}@var{count} characters after point -are deleted. - -In an interactive call, @var{count} is the numeric prefix argument, and -@var{killp} is the unprocessed prefix argument. Therefore, if a prefix -argument is supplied, the text is saved in the kill ring. If no prefix -argument is supplied, then one character is deleted, but not saved in -the kill ring. - -The value returned is always @code{nil}. -@end deffn - -@node User-Level Deletion -@section User-Level Deletion Commands - - This section describes higher-level commands for deleting text, -commands intended primarily for the user but useful also in Lisp -programs. - -@deffn Command delete-horizontal-space -@cindex deleting whitespace -This function deletes all spaces and tabs around point. It returns -@code{nil}. - -In the following examples, we call @code{delete-horizontal-space} four -times, once on each line, with point between the second and third -characters on the line each time. - -@example -@group ----------- Buffer: foo ---------- -I @point{}thought -I @point{} thought -We@point{} thought -Yo@point{}u thought ----------- Buffer: foo ---------- -@end group - -@group -(delete-horizontal-space) ; @r{Four times.} - @result{} nil - ----------- Buffer: foo ---------- -Ithought -Ithought -Wethought -You thought ----------- Buffer: foo ---------- -@end group -@end example -@end deffn - -@deffn Command delete-indentation &optional join-following-p -This function joins the line point is on to the previous line, deleting -any whitespace at the join and in some cases replacing it with one -space. If @var{join-following-p} is non-@code{nil}, -@code{delete-indentation} joins this line to the following line -instead. The value is @code{nil}. - -If there is a fill prefix, and the second of the lines being joined -starts with the prefix, then @code{delete-indentation} deletes the -fill prefix before joining the lines. @xref{Margins}. - -In the example below, point is located on the line starting -@samp{events}, and it makes no difference if there are trailing spaces -in the preceding line. - -@smallexample -@group ----------- Buffer: foo ---------- -When in the course of human -@point{} events, it becomes necessary ----------- Buffer: foo ---------- -@end group - -(delete-indentation) - @result{} nil - -@group ----------- Buffer: foo ---------- -When in the course of human@point{} events, it becomes necessary ----------- Buffer: foo ---------- -@end group -@end smallexample - -After the lines are joined, the function @code{fixup-whitespace} is -responsible for deciding whether to leave a space at the junction. -@end deffn - -@defun fixup-whitespace -This function replaces all the white space surrounding point with either -one space or no space, according to the context. It returns @code{nil}. - -At the beginning or end of a line, the appropriate amount of space is -none. Before a character with close parenthesis syntax, or after a -character with open parenthesis or expression-prefix syntax, no space is -also appropriate. Otherwise, one space is appropriate. @xref{Syntax -Class Table}. - -In the example below, @code{fixup-whitespace} is called the first time -with point before the word @samp{spaces} in the first line. For the -second invocation, point is directly after the @samp{(}. - -@smallexample -@group ----------- Buffer: foo ---------- -This has too many @point{}spaces -This has too many spaces at the start of (@point{} this list) ----------- Buffer: foo ---------- -@end group - -@group -(fixup-whitespace) - @result{} nil -(fixup-whitespace) - @result{} nil -@end group - -@group ----------- Buffer: foo ---------- -This has too many spaces -This has too many spaces at the start of (this list) ----------- Buffer: foo ---------- -@end group -@end smallexample -@end defun - -@deffn Command just-one-space -@comment !!SourceFile simple.el -This command replaces any spaces and tabs around point with a single -space. It returns @code{nil}. -@end deffn - -@deffn Command delete-blank-lines -This function deletes blank lines surrounding point. If point is on a -blank line with one or more blank lines before or after it, then all but -one of them are deleted. If point is on an isolated blank line, then it -is deleted. If point is on a nonblank line, the command deletes all -blank lines following it. - -A blank line is defined as a line containing only tabs and spaces. - -@code{delete-blank-lines} returns @code{nil}. -@end deffn - -@node The Kill Ring -@section The Kill Ring -@cindex kill ring - - @dfn{Kill} functions delete text like the deletion functions, but save -it so that the user can reinsert it by @dfn{yanking}. Most of these -functions have @samp{kill-} in their name. By contrast, the functions -whose names start with @samp{delete-} normally do not save text for -yanking (though they can still be undone); these are ``deletion'' -functions. - - Most of the kill commands are primarily for interactive use, and are -not described here. What we do describe are the functions provided for -use in writing such commands. You can use these functions to write -commands for killing text. When you need to delete text for internal -purposes within a Lisp function, you should normally use deletion -functions, so as not to disturb the kill ring contents. -@xref{Deletion}. - - Killed text is saved for later yanking in the @dfn{kill ring}. This -is a list that holds a number of recent kills, not just the last text -kill. We call this a ``ring'' because yanking treats it as having -elements in a cyclic order. The list is kept in the variable -@code{kill-ring}, and can be operated on with the usual functions for -lists; there are also specialized functions, described in this section, -that treat it as a ring. - - Some people think this use of the word ``kill'' is unfortunate, since -it refers to operations that specifically @emph{do not} destroy the -entities ``killed''. This is in sharp contrast to ordinary life, in -which death is permanent and ``killed'' entities do not come back to -life. Therefore, other metaphors have been proposed. For example, the -term ``cut ring'' makes sense to people who, in pre-computer days, used -scissors and paste to cut up and rearrange manuscripts. However, it -would be difficult to change the terminology now. - -@menu -* Kill Ring Concepts:: What text looks like in the kill ring. -* Kill Functions:: Functions that kill text. -* Yank Commands:: Commands that access the kill ring. -* Low-Level Kill Ring:: Functions and variables for kill ring access. -* Internals of Kill Ring:: Variables that hold kill-ring data. -@end menu - -@node Kill Ring Concepts -@subsection Kill Ring Concepts - - The kill ring records killed text as strings in a list, most recent -first. A short kill ring, for example, might look like this: - -@example -("some text" "a different piece of text" "even older text") -@end example - -@noindent -When the list reaches @code{kill-ring-max} entries in length, adding a -new entry automatically deletes the last entry. - - When kill commands are interwoven with other commands, each kill -command makes a new entry in the kill ring. Multiple kill commands in -succession build up a single entry in the kill ring, which would be -yanked as a unit; the second and subsequent consecutive kill commands -add text to the entry made by the first one. - - For yanking, one entry in the kill ring is designated the ``front'' of -the ring. Some yank commands ``rotate'' the ring by designating a -different element as the ``front.'' But this virtual rotation doesn't -change the list itself---the most recent entry always comes first in the -list. - -@node Kill Functions -@subsection Functions for Killing - - @code{kill-region} is the usual subroutine for killing text. Any -command that calls this function is a ``kill command'' (and should -probably have @samp{kill} in its name). @code{kill-region} puts the -newly killed text in a new element at the beginning of the kill ring or -adds it to the most recent element. It uses the @code{last-command} -variable to determine whether the previous command was a kill command, -and if so appends the killed text to the most recent entry. - -@deffn Command kill-region start end -This function kills the text in the region defined by @var{start} and -@var{end}. The text is deleted but saved in the kill ring, along with -its text properties. The value is always @code{nil}. - -In an interactive call, @var{start} and @var{end} are point and -the mark. - -@c Emacs 19 feature -If the buffer is read-only, @code{kill-region} modifies the kill ring -just the same, then signals an error without modifying the buffer. This -is convenient because it lets the user use all the kill commands to copy -text into the kill ring from a read-only buffer. -@end deffn - -@deffn Command copy-region-as-kill start end -This command saves the region defined by @var{start} and @var{end} on -the kill ring (including text properties), but does not delete the text -from the buffer. It returns @code{nil}. It also indicates the extent -of the text copied by moving the cursor momentarily, or by displaying a -message in the echo area. - -The command does not set @code{this-command} to @code{kill-region}, so a -subsequent kill command does not append to the same kill ring entry. - -Don't call @code{copy-region-as-kill} in Lisp programs unless you aim to -support Emacs 18. For Emacs 19, it is better to use @code{kill-new} or -@code{kill-append} instead. @xref{Low-Level Kill Ring}. -@end deffn - -@node Yank Commands -@subsection Functions for Yanking - - @dfn{Yanking} means reinserting an entry of previously killed text -from the kill ring. The text properties are copied too. - -@deffn Command yank &optional arg -@cindex inserting killed text -This command inserts before point the text in the first entry in the -kill ring. It positions the mark at the beginning of that text, and -point at the end. - -If @var{arg} is a list (which occurs interactively when the user -types @kbd{C-u} with no digits), then @code{yank} inserts the text as -described above, but puts point before the yanked text and puts the mark -after it. - -If @var{arg} is a number, then @code{yank} inserts the @var{arg}th most -recently killed text---the @var{arg}th element of the kill ring list. - -@code{yank} does not alter the contents of the kill ring or rotate it. -It returns @code{nil}. -@end deffn - -@deffn Command yank-pop arg -This command replaces the just-yanked entry from the kill ring with a -different entry from the kill ring. - -This is allowed only immediately after a @code{yank} or another -@code{yank-pop}. At such a time, the region contains text that was just -inserted by yanking. @code{yank-pop} deletes that text and inserts in -its place a different piece of killed text. It does not add the deleted -text to the kill ring, since it is already in the kill ring somewhere. - -If @var{arg} is @code{nil}, then the replacement text is the previous -element of the kill ring. If @var{arg} is numeric, the replacement is -the @var{arg}th previous kill. If @var{arg} is negative, a more recent -kill is the replacement. - -The sequence of kills in the kill ring wraps around, so that after the -oldest one comes the newest one, and before the newest one goes the -oldest. - -The value is always @code{nil}. -@end deffn - -@node Low-Level Kill Ring -@subsection Low-Level Kill Ring - - These functions and variables provide access to the kill ring at a lower -level, but still convenient for use in Lisp programs. They take care of -interaction with X Window selections. They do not exist in Emacs -version 18. - -@defun current-kill n &optional do-not-move -The function @code{current-kill} rotates the yanking pointer which -designates the ``front'' of the kill ring by @var{n} places (from newer -kills to older ones), and returns the text at that place in the ring. - -If the optional second argument @var{do-not-move} is non-@code{nil}, -then @code{current-kill} doesn't alter the yanking pointer; it just -returns the @var{n}th kill, counting from the current yanking pointer. - -If @var{n} is zero, indicating a request for the latest kill, -@code{current-kill} calls the value of -@code{interprogram-paste-function} (documented below) before consulting -the kill ring. -@end defun - -@defun kill-new string -This function puts the text @var{string} into the kill ring as a new -entry at the front of the ring. It discards the oldest entry if -appropriate. It also invokes the value of -@code{interprogram-cut-function} (see below). -@end defun - -@defun kill-append string before-p -This function appends the text @var{string} to the first entry in the -kill ring. Normally @var{string} goes at the end of the entry, but if -@var{before-p} is non-@code{nil}, it goes at the beginning. This -function also invokes the value of @code{interprogram-cut-function} (see -below). -@end defun - -@defvar interprogram-paste-function -This variable provides a way of transferring killed text from other -programs, when you are using a window system. Its value should be -@code{nil} or a function of no arguments. - -If the value is a function, @code{current-kill} calls it to get the -``most recent kill''. If the function returns a non-@code{nil} value, -then that value is used as the ``most recent kill''. If it returns -@code{nil}, then the first element of @code{kill-ring} is used. - -The normal use of this hook is to get the X server's primary selection -as the most recent kill, even if the selection belongs to another X -client. @xref{X Selections}. -@end defvar - -@defvar interprogram-cut-function -This variable provides a way of communicating killed text to other -programs, when you are using a window system. Its value should be -@code{nil} or a function of one argument. - -If the value is a function, @code{kill-new} and @code{kill-append} call -it with the new first element of the kill ring as an argument. - -The normal use of this hook is to set the X server's primary selection -to the newly killed text. -@end defvar - -@node Internals of Kill Ring -@subsection Internals of the Kill Ring - - The variable @code{kill-ring} holds the kill ring contents, in the -form of a list of strings. The most recent kill is always at the front -of the list. - - The @code{kill-ring-yank-pointer} variable points to a link in the -kill ring list, whose @sc{car} is the text to yank next. We say it -identifies the ``front'' of the ring. Moving -@code{kill-ring-yank-pointer} to a different link is called -@dfn{rotating the kill ring}. We call the kill ring a ``ring'' because -the functions that move the yank pointer wrap around from the end of the -list to the beginning, or vice-versa. Rotation of the kill ring is -virtual; it does not change the value of @code{kill-ring}. - - Both @code{kill-ring} and @code{kill-ring-yank-pointer} are Lisp -variables whose values are normally lists. The word ``pointer'' in the -name of the @code{kill-ring-yank-pointer} indicates that the variable's -purpose is to identify one element of the list for use by the next yank -command. - - The value of @code{kill-ring-yank-pointer} is always @code{eq} to one -of the links in the kill ring list. The element it identifies is the -@sc{car} of that link. Kill commands, which change the kill ring, also -set this variable to the value of @code{kill-ring}. The effect is to -rotate the ring so that the newly killed text is at the front. - - Here is a diagram that shows the variable @code{kill-ring-yank-pointer} -pointing to the second entry in the kill ring @code{("some text" "a -different piece of text" "yet older text")}. - -@example -@group -kill-ring kill-ring-yank-pointer - | | - | ___ ___ ---> ___ ___ ___ ___ - --> |___|___|------> |___|___|--> |___|___|--> nil - | | | - | | | - | | -->"yet older text" - | | - | --> "a different piece of text" - | - --> "some text" -@end group -@end example - -@noindent -This state of affairs might occur after @kbd{C-y} (@code{yank}) -immediately followed by @kbd{M-y} (@code{yank-pop}). - -@defvar kill-ring -This variable holds the list of killed text sequences, most recently -killed first. -@end defvar - -@defvar kill-ring-yank-pointer -This variable's value indicates which element of the kill ring is at the -``front'' of the ring for yanking. More precisely, the value is a tail -of the value of @code{kill-ring}, and its @sc{car} is the kill string -that @kbd{C-y} should yank. -@end defvar - -@defopt kill-ring-max -The value of this variable is the maximum length to which the kill -ring can grow, before elements are thrown away at the end. The default -value for @code{kill-ring-max} is 30. -@end defopt - -@node Undo -@section Undo -@cindex redo - - Most buffers have an @dfn{undo list}, which records all changes made -to the buffer's text so that they can be undone. (The buffers that -don't have one are usually special-purpose buffers for which XEmacs -assumes that undoing is not useful.) All the primitives that modify the -text in the buffer automatically add elements to the front of the undo -list, which is in the variable @code{buffer-undo-list}. - -@defvar buffer-undo-list -This variable's value is the undo list of the current buffer. -A value of @code{t} disables the recording of undo information. -@end defvar - -Here are the kinds of elements an undo list can have: - -@table @code -@item @var{integer} -This kind of element records a previous value of point. Ordinary cursor -motion does not get any sort of undo record, but deletion commands use -these entries to record where point was before the command. - -@item (@var{beg} . @var{end}) -This kind of element indicates how to delete text that was inserted. -Upon insertion, the text occupied the range @var{beg}--@var{end} in the -buffer. - -@item (@var{text} . @var{position}) -This kind of element indicates how to reinsert text that was deleted. -The deleted text itself is the string @var{text}. The place to -reinsert it is @code{(abs @var{position})}. - -@item (t @var{high} . @var{low}) -This kind of element indicates that an unmodified buffer became -modified. The elements @var{high} and @var{low} are two integers, each -recording 16 bits of the visited file's modification time as of when it -was previously visited or saved. @code{primitive-undo} uses those -values to determine whether to mark the buffer as unmodified once again; -it does so only if the file's modification time matches those numbers. - -@item (nil @var{property} @var{value} @var{beg} . @var{end}) -This kind of element records a change in a text property. -Here's how you might undo the change: - -@example -(put-text-property @var{beg} @var{end} @var{property} @var{value}) -@end example - -@item @var{position} -This element indicates where point was at an earlier time. Undoing this -element sets point to @var{position}. Deletion normally creates an -element of this kind as well as a reinsertion element. - -@item nil -This element is a boundary. The elements between two boundaries are -called a @dfn{change group}; normally, each change group corresponds to -one keyboard command, and undo commands normally undo an entire group as -a unit. -@end table - -@defun undo-boundary -This function places a boundary element in the undo list. The undo -command stops at such a boundary, and successive undo commands undo -to earlier and earlier boundaries. This function returns @code{nil}. - -The editor command loop automatically creates an undo boundary before -each key sequence is executed. Thus, each undo normally undoes the -effects of one command. Self-inserting input characters are an -exception. The command loop makes a boundary for the first such -character; the next 19 consecutive self-inserting input characters do -not make boundaries, and then the 20th does, and so on as long as -self-inserting characters continue. - -All buffer modifications add a boundary whenever the previous undoable -change was made in some other buffer. This way, a command that modifies -several buffers makes a boundary in each buffer it changes. - -Calling this function explicitly is useful for splitting the effects of -a command into more than one unit. For example, @code{query-replace} -calls @code{undo-boundary} after each replacement, so that the user can -undo individual replacements one by one. -@end defun - -@defun primitive-undo count list -This is the basic function for undoing elements of an undo list. -It undoes the first @var{count} elements of @var{list}, returning -the rest of @var{list}. You could write this function in Lisp, -but it is convenient to have it in C. - -@code{primitive-undo} adds elements to the buffer's undo list when it -changes the buffer. Undo commands avoid confusion by saving the undo -list value at the beginning of a sequence of undo operations. Then the -undo operations use and update the saved value. The new elements added -by undoing are not part of this saved value, so they don't interfere with -continuing to undo. -@end defun - -@node Maintaining Undo -@section Maintaining Undo Lists - - This section describes how to enable and disable undo information for -a given buffer. It also explains how the undo list is truncated -automatically so it doesn't get too big. - - Recording of undo information in a newly created buffer is normally -enabled to start with; but if the buffer name starts with a space, the -undo recording is initially disabled. You can explicitly enable or -disable undo recording with the following two functions, or by setting -@code{buffer-undo-list} yourself. - -@deffn Command buffer-enable-undo &optional buffer-or-name -This command enables recording undo information for buffer -@var{buffer-or-name}, so that subsequent changes can be undone. If no -argument is supplied, then the current buffer is used. This function -does nothing if undo recording is already enabled in the buffer. It -returns @code{nil}. - -In an interactive call, @var{buffer-or-name} is the current buffer. -You cannot specify any other buffer. -@end deffn - -@defun buffer-disable-undo &optional buffer -@defunx buffer-flush-undo &optional buffer -@cindex disable undo -This function discards the undo list of @var{buffer}, and disables -further recording of undo information. As a result, it is no longer -possible to undo either previous changes or any subsequent changes. If -the undo list of @var{buffer} is already disabled, this function -has no effect. - -This function returns @code{nil}. It cannot be called interactively. - -The name @code{buffer-flush-undo} is not considered obsolete, but the -preferred name @code{buffer-disable-undo} is new as of Emacs versions -19. -@end defun - - As editing continues, undo lists get longer and longer. To prevent -them from using up all available memory space, garbage collection trims -them back to size limits you can set. (For this purpose, the ``size'' -of an undo list measures the cons cells that make up the list, plus the -strings of deleted text.) Two variables control the range of acceptable -sizes: @code{undo-limit} and @code{undo-strong-limit}. - -@defvar undo-limit -This is the soft limit for the acceptable size of an undo list. The -change group at which this size is exceeded is the last one kept. -@end defvar - -@defvar undo-strong-limit -This is the upper limit for the acceptable size of an undo list. The -change group at which this size is exceeded is discarded itself (along -with all older change groups). There is one exception: the very latest -change group is never discarded no matter how big it is. -@end defvar - -@node Filling -@section Filling -@cindex filling, explicit - - @dfn{Filling} means adjusting the lengths of lines (by moving the line -breaks) so that they are nearly (but no greater than) a specified -maximum width. Additionally, lines can be @dfn{justified}, which means -inserting spaces to make the left and/or right margins line up -precisely. The width is controlled by the variable @code{fill-column}. -For ease of reading, lines should be no longer than 70 or so columns. - - You can use Auto Fill mode (@pxref{Auto Filling}) to fill text -automatically as you insert it, but changes to existing text may leave -it improperly filled. Then you must fill the text explicitly. - - Most of the commands in this section return values that are not -meaningful. All the functions that do filling take note of the current -left margin, current right margin, and current justification style -(@pxref{Margins}). If the current justification style is -@code{none}, the filling functions don't actually do anything. - - Several of the filling functions have an argument @var{justify}. -If it is non-@code{nil}, that requests some kind of justification. It -can be @code{left}, @code{right}, @code{full}, or @code{center}, to -request a specific style of justification. If it is @code{t}, that -means to use the current justification style for this part of the text -(see @code{current-justification}, below). - - When you call the filling functions interactively, using a prefix -argument implies the value @code{full} for @var{justify}. - -@deffn Command fill-paragraph justify -@cindex filling a paragraph -This command fills the paragraph at or after point. If -@var{justify} is non-@code{nil}, each line is justified as well. -It uses the ordinary paragraph motion commands to find paragraph -boundaries. @xref{Paragraphs,,, xemacs, The XEmacs User's Manual}. -@end deffn - -@deffn Command fill-region start end &optional justify -This command fills each of the paragraphs in the region from @var{start} -to @var{end}. It justifies as well if @var{justify} is -non-@code{nil}. - -The variable @code{paragraph-separate} controls how to distinguish -paragraphs. @xref{Standard Regexps}. -@end deffn - -@deffn Command fill-individual-paragraphs start end &optional justify mail-flag -This command fills each paragraph in the region according to its -individual fill prefix. Thus, if the lines of a paragraph were indented -with spaces, the filled paragraph will remain indented in the same -fashion. - -The first two arguments, @var{start} and @var{end}, are the beginning -and end of the region to be filled. The third and fourth arguments, -@var{justify} and @var{mail-flag}, are optional. If -@var{justify} is non-@code{nil}, the paragraphs are justified as -well as filled. If @var{mail-flag} is non-@code{nil}, it means the -function is operating on a mail message and therefore should not fill -the header lines. - -Ordinarily, @code{fill-individual-paragraphs} regards each change in -indentation as starting a new paragraph. If -@code{fill-individual-varying-indent} is non-@code{nil}, then only -separator lines separate paragraphs. That mode can handle indented -paragraphs with additional indentation on the first line. -@end deffn - -@defopt fill-individual-varying-indent -This variable alters the action of @code{fill-individual-paragraphs} as -described above. -@end defopt - -@deffn Command fill-region-as-paragraph start end &optional justify -This command considers a region of text as a paragraph and fills it. If -the region was made up of many paragraphs, the blank lines between -paragraphs are removed. This function justifies as well as filling when -@var{justify} is non-@code{nil}. - -In an interactive call, any prefix argument requests justification. - -In Adaptive Fill mode, which is enabled by default, -@code{fill-region-as-paragraph} on an indented paragraph when there is -no fill prefix uses the indentation of the second line of the paragraph -as the fill prefix. -@end deffn - -@deffn Command justify-current-line how eop nosqueeze -This command inserts spaces between the words of the current line so -that the line ends exactly at @code{fill-column}. It returns -@code{nil}. - -The argument @var{how}, if non-@code{nil} specifies explicitly the style -of justification. It can be @code{left}, @code{right}, @code{full}, -@code{center}, or @code{none}. If it is @code{t}, that means to do -follow specified justification style (see @code{current-justification}, -below). @code{nil} means to do full justification. - -If @var{eop} is non-@code{nil}, that means do left-justification when -@code{current-justification} specifies full justification. This is used -for the last line of a paragraph; even if the paragraph as a whole is -fully justified, the last line should not be. - -If @var{nosqueeze} is non-@code{nil}, that means do not change interior -whitespace. -@end deffn - -@defopt default-justification -This variable's value specifies the style of justification to use for -text that doesn't specify a style with a text property. The possible -values are @code{left}, @code{right}, @code{full}, @code{center}, or -@code{none}. The default value is @code{left}. -@end defopt - -@defun current-justification -This function returns the proper justification style to use for filling -the text around point. -@end defun - -@defvar fill-paragraph-function -This variable provides a way for major modes to override the filling of -paragraphs. If the value is non-@code{nil}, @code{fill-paragraph} calls -this function to do the work. If the function returns a non-@code{nil} -value, @code{fill-paragraph} assumes the job is done, and immediately -returns that value. - -The usual use of this feature is to fill comments in programming -language modes. If the function needs to fill a paragraph in the usual -way, it can do so as follows: - -@example -(let ((fill-paragraph-function nil)) - (fill-paragraph arg)) -@end example -@end defvar - -@defvar use-hard-newlines -If this variable is non-@code{nil}, the filling functions do not delete -newlines that have the @code{hard} text property. These ``hard -newlines'' act as paragraph separators. -@end defvar - -@node Margins -@section Margins for Filling - -@defopt fill-prefix -This variable specifies a string of text that appears at the beginning -of normal text lines and should be disregarded when filling them. Any -line that fails to start with the fill prefix is considered the start of -a paragraph; so is any line that starts with the fill prefix followed by -additional whitespace. Lines that start with the fill prefix but no -additional whitespace are ordinary text lines that can be filled -together. The resulting filled lines also start with the fill prefix. - -The fill prefix follows the left margin whitespace, if any. -@end defopt - -@defopt fill-column -This buffer-local variable specifies the maximum width of filled -lines. Its value should be an integer, which is a number of columns. -All the filling, justification and centering commands are affected by -this variable, including Auto Fill mode (@pxref{Auto Filling}). - -As a practical matter, if you are writing text for other people to -read, you should set @code{fill-column} to no more than 70. Otherwise -the line will be too long for people to read comfortably, and this can -make the text seem clumsy. -@end defopt - -@defvar default-fill-column -The value of this variable is the default value for @code{fill-column} in -buffers that do not override it. This is the same as -@code{(default-value 'fill-column)}. - -The default value for @code{default-fill-column} is 70. -@end defvar - -@deffn Command set-left-margin from to margin -This sets the @code{left-margin} property on the text from @var{from} to -@var{to} to the value @var{margin}. If Auto Fill mode is enabled, this -command also refills the region to fit the new margin. -@end deffn - -@deffn Command set-right-margin from to margin -This sets the @code{right-margin} property on the text from @var{from} -to @var{to} to the value @var{margin}. If Auto Fill mode is enabled, -this command also refills the region to fit the new margin. -@end deffn - -@defun current-left-margin -This function returns the proper left margin value to use for filling -the text around point. The value is the sum of the @code{left-margin} -property of the character at the start of the current line (or zero if -none), and the value of the variable @code{left-margin}. -@end defun - -@defun current-fill-column -This function returns the proper fill column value to use for filling -the text around point. The value is the value of the @code{fill-column} -variable, minus the value of the @code{right-margin} property of the -character after point. -@end defun - -@deffn Command move-to-left-margin &optional n force -This function moves point to the left margin of the current line. The -column moved to is determined by calling the function -@code{current-left-margin}. If the argument @var{n} is non-@code{nil}, -@code{move-to-left-margin} moves forward @var{n}@minus{}1 lines first. - -If @var{force} is non-@code{nil}, that says to fix the line's -indentation if that doesn't match the left margin value. -@end deffn - -@defun delete-to-left-margin from to -This function removes left margin indentation from the text -between @var{from} and @var{to}. The amount of indentation -to delete is determined by calling @code{current-left-margin}. -In no case does this function delete non-whitespace. -@end defun - -@defun indent-to-left-margin -This is the default @code{indent-line-function}, used in Fundamental -mode, Text mode, etc. Its effect is to adjust the indentation at the -beginning of the current line to the value specified by the variable -@code{left-margin}. This may involve either inserting or deleting -whitespace. -@end defun - -@defvar left-margin -This variable specifies the base left margin column. In Fundamental -mode, @key{LFD} indents to this column. This variable automatically -becomes buffer-local when set in any fashion. -@end defvar - -@node Auto Filling -@section Auto Filling -@cindex filling, automatic -@cindex Auto Fill mode - - Auto Fill mode is a minor mode that fills lines automatically as text -is inserted. This section describes the hook used by Auto Fill mode. -For a description of functions that you can call explicitly to fill and -justify existing text, see @ref{Filling}. - - Auto Fill mode also enables the functions that change the margins and -justification style to refill portions of the text. @xref{Margins}. - -@defvar auto-fill-function -The value of this variable should be a function (of no arguments) to be -called after self-inserting a space or a newline. It may be @code{nil}, -in which case nothing special is done in that case. - -The value of @code{auto-fill-function} is @code{do-auto-fill} when -Auto-Fill mode is enabled. That is a function whose sole purpose is to -implement the usual strategy for breaking a line. - -@quotation -In older Emacs versions, this variable was named @code{auto-fill-hook}, -but since it is not called with the standard convention for hooks, it -was renamed to @code{auto-fill-function} in version 19. -@end quotation -@end defvar - -@node Sorting -@section Sorting Text -@cindex sorting text - - The sorting functions described in this section all rearrange text in -a buffer. This is in contrast to the function @code{sort}, which -rearranges the order of the elements of a list (@pxref{Rearrangement}). -The values returned by these functions are not meaningful. - -@defun sort-subr reverse nextrecfun endrecfun &optional startkeyfun endkeyfun -This function is the general text-sorting routine that divides a buffer -into records and sorts them. Most of the commands in this section use -this function. - -To understand how @code{sort-subr} works, consider the whole accessible -portion of the buffer as being divided into disjoint pieces called -@dfn{sort records}. The records may or may not be contiguous; they may -not overlap. A portion of each sort record (perhaps all of it) is -designated as the sort key. Sorting rearranges the records in order by -their sort keys. - -Usually, the records are rearranged in order of ascending sort key. -If the first argument to the @code{sort-subr} function, @var{reverse}, -is non-@code{nil}, the sort records are rearranged in order of -descending sort key. - -The next four arguments to @code{sort-subr} are functions that are -called to move point across a sort record. They are called many times -from within @code{sort-subr}. - -@enumerate -@item -@var{nextrecfun} is called with point at the end of a record. This -function moves point to the start of the next record. The first record -is assumed to start at the position of point when @code{sort-subr} is -called. Therefore, you should usually move point to the beginning of -the buffer before calling @code{sort-subr}. - -This function can indicate there are no more sort records by leaving -point at the end of the buffer. - -@item -@var{endrecfun} is called with point within a record. It moves point to -the end of the record. - -@item -@var{startkeyfun} is called to move point from the start of a record to -the start of the sort key. This argument is optional; if it is omitted, -the whole record is the sort key. If supplied, the function should -either return a non-@code{nil} value to be used as the sort key, or -return @code{nil} to indicate that the sort key is in the buffer -starting at point. In the latter case, @var{endkeyfun} is called to -find the end of the sort key. - -@item -@var{endkeyfun} is called to move point from the start of the sort key -to the end of the sort key. This argument is optional. If -@var{startkeyfun} returns @code{nil} and this argument is omitted (or -@code{nil}), then the sort key extends to the end of the record. There -is no need for @var{endkeyfun} if @var{startkeyfun} returns a -non-@code{nil} value. -@end enumerate - -As an example of @code{sort-subr}, here is the complete function -definition for @code{sort-lines}: - -@example -@group -;; @r{Note that the first two lines of doc string} -;; @r{are effectively one line when viewed by a user.} -(defun sort-lines (reverse beg end) - "Sort lines in region alphabetically. -Called from a program, there are three arguments: -@end group -@group -REVERSE (non-nil means reverse order), -and BEG and END (the region to sort)." - (interactive "P\nr") - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (sort-subr reverse - 'forward-line - 'end-of-line))) -@end group -@end example - -Here @code{forward-line} moves point to the start of the next record, -and @code{end-of-line} moves point to the end of record. We do not pass -the arguments @var{startkeyfun} and @var{endkeyfun}, because the entire -record is used as the sort key. - -The @code{sort-paragraphs} function is very much the same, except that -its @code{sort-subr} call looks like this: - -@example -@group -(sort-subr reverse - (function - (lambda () - (skip-chars-forward "\n \t\f"))) - 'forward-paragraph) -@end group -@end example -@end defun - -@deffn Command sort-regexp-fields reverse record-regexp key-regexp start end -This command sorts the region between @var{start} and @var{end} -alphabetically as specified by @var{record-regexp} and @var{key-regexp}. -If @var{reverse} is a negative integer, then sorting is in reverse -order. - -Alphabetical sorting means that two sort keys are compared by -comparing the first characters of each, the second characters of each, -and so on. If a mismatch is found, it means that the sort keys are -unequal; the sort key whose character is less at the point of first -mismatch is the lesser sort key. The individual characters are compared -according to their numerical values. Since Emacs uses the @sc{ASCII} -character set, the ordering in that set determines alphabetical order. -@c version 19 change - -The value of the @var{record-regexp} argument specifies how to divide -the buffer into sort records. At the end of each record, a search is -done for this regular expression, and the text that matches it is the -next record. For example, the regular expression @samp{^.+$}, which -matches lines with at least one character besides a newline, would make -each such line into a sort record. @xref{Regular Expressions}, for a -description of the syntax and meaning of regular expressions. - -The value of the @var{key-regexp} argument specifies what part of each -record is the sort key. The @var{key-regexp} could match the whole -record, or only a part. In the latter case, the rest of the record has -no effect on the sorted order of records, but it is carried along when -the record moves to its new position. - -The @var{key-regexp} argument can refer to the text matched by a -subexpression of @var{record-regexp}, or it can be a regular expression -on its own. - -If @var{key-regexp} is: - -@table @asis -@item @samp{\@var{digit}} -then the text matched by the @var{digit}th @samp{\(...\)} parenthesis -grouping in @var{record-regexp} is the sort key. - -@item @samp{\&} -then the whole record is the sort key. - -@item a regular expression -then @code{sort-regexp-fields} searches for a match for the regular -expression within the record. If such a match is found, it is the sort -key. If there is no match for @var{key-regexp} within a record then -that record is ignored, which means its position in the buffer is not -changed. (The other records may move around it.) -@end table - -For example, if you plan to sort all the lines in the region by the -first word on each line starting with the letter @samp{f}, you should -set @var{record-regexp} to @samp{^.*$} and set @var{key-regexp} to -@samp{\}. The resulting expression looks like this: - -@example -@group -(sort-regexp-fields nil "^.*$" "\\" - (region-beginning) - (region-end)) -@end group -@end example - -If you call @code{sort-regexp-fields} interactively, it prompts for -@var{record-regexp} and @var{key-regexp} in the minibuffer. -@end deffn - -@deffn Command sort-lines reverse start end -This command alphabetically sorts lines in the region between -@var{start} and @var{end}. If @var{reverse} is non-@code{nil}, the sort -is in reverse order. -@end deffn - -@deffn Command sort-paragraphs reverse start end -This command alphabetically sorts paragraphs in the region between -@var{start} and @var{end}. If @var{reverse} is non-@code{nil}, the sort -is in reverse order. -@end deffn - -@deffn Command sort-pages reverse start end -This command alphabetically sorts pages in the region between -@var{start} and @var{end}. If @var{reverse} is non-@code{nil}, the sort -is in reverse order. -@end deffn - -@deffn Command sort-fields field start end -This command sorts lines in the region between @var{start} and -@var{end}, comparing them alphabetically by the @var{field}th field -of each line. Fields are separated by whitespace and numbered starting -from 1. If @var{field} is negative, sorting is by the -@w{@minus{}@var{field}th} field from the end of the line. This command -is useful for sorting tables. -@end deffn - -@deffn Command sort-numeric-fields field start end -This command sorts lines in the region between @var{start} and -@var{end}, comparing them numerically by the @var{field}th field of each -line. The specified field must contain a number in each line of the -region. Fields are separated by whitespace and numbered starting from -1. If @var{field} is negative, sorting is by the -@w{@minus{}@var{field}th} field from the end of the line. This command -is useful for sorting tables. -@end deffn - -@deffn Command sort-columns reverse &optional beg end -This command sorts the lines in the region between @var{beg} and -@var{end}, comparing them alphabetically by a certain range of columns. -The column positions of @var{beg} and @var{end} bound the range of -columns to sort on. - -If @var{reverse} is non-@code{nil}, the sort is in reverse order. - -One unusual thing about this command is that the entire line -containing position @var{beg}, and the entire line containing position -@var{end}, are included in the region sorted. - -Note that @code{sort-columns} uses the @code{sort} utility program, -and so cannot work properly on text containing tab characters. Use -@kbd{M-x @code{untabify}} to convert tabs to spaces before sorting. -@end deffn - -@node Columns -@comment node-name, next, previous, up -@section Counting Columns -@cindex columns -@cindex counting columns -@cindex horizontal position - - The column functions convert between a character position (counting -characters from the beginning of the buffer) and a column position -(counting screen characters from the beginning of a line). - - A character counts according to the number of columns it occupies on -the screen. This means control characters count as occupying 2 or 4 -columns, depending upon the value of @code{ctl-arrow}, and tabs count as -occupying a number of columns that depends on the value of -@code{tab-width} and on the column where the tab begins. @xref{Usual Display}. - - Column number computations ignore the width of the window and the -amount of horizontal scrolling. Consequently, a column value can be -arbitrarily high. The first (or leftmost) column is numbered 0. - -@defun current-column -This function returns the horizontal position of point, measured in -columns, counting from 0 at the left margin. The column position is the -sum of the widths of all the displayed representations of the characters -between the start of the current line and point. - -For an example of using @code{current-column}, see the description of -@code{count-lines} in @ref{Text Lines}. -@end defun - -@defun move-to-column column &optional force -This function moves point to @var{column} in the current line. The -calculation of @var{column} takes into account the widths of the -displayed representations of the characters between the start of the -line and point. - -If column @var{column} is beyond the end of the line, point moves to the -end of the line. If @var{column} is negative, point moves to the -beginning of the line. - -If it is impossible to move to column @var{column} because that is in -the middle of a multicolumn character such as a tab, point moves to the -end of that character. However, if @var{force} is non-@code{nil}, and -@var{column} is in the middle of a tab, then @code{move-to-column} -converts the tab into spaces so that it can move precisely to column -@var{column}. Other multicolumn characters can cause anomalies despite -@var{force}, since there is no way to split them. - -The argument @var{force} also has an effect if the line isn't long -enough to reach column @var{column}; in that case, it says to add -whitespace at the end of the line to reach that column. - -If @var{column} is not an integer, an error is signaled. - -The return value is the column number actually moved to. -@end defun - -@node Indentation -@section Indentation -@cindex indentation - - The indentation functions are used to examine, move to, and change -whitespace that is at the beginning of a line. Some of the functions -can also change whitespace elsewhere on a line. Columns and indentation -count from zero at the left margin. - -@menu -* Primitive Indent:: Functions used to count and insert indentation. -* Mode-Specific Indent:: Customize indentation for different modes. -* Region Indent:: Indent all the lines in a region. -* Relative Indent:: Indent the current line based on previous lines. -* Indent Tabs:: Adjustable, typewriter-like tab stops. -* Motion by Indent:: Move to first non-blank character. -@end menu - -@node Primitive Indent -@subsection Indentation Primitives - - This section describes the primitive functions used to count and -insert indentation. The functions in the following sections use these -primitives. - -@defun current-indentation -@comment !!Type Primitive Function -@comment !!SourceFile indent.c -This function returns the indentation of the current line, which is -the horizontal position of the first nonblank character. If the -contents are entirely blank, then this is the horizontal position of the -end of the line. -@end defun - -@deffn Command indent-to column &optional minimum -@comment !!Type Primitive Function -@comment !!SourceFile indent.c -This function indents from point with tabs and spaces until @var{column} -is reached. If @var{minimum} is specified and non-@code{nil}, then at -least that many spaces are inserted even if this requires going beyond -@var{column}. Otherwise the function does nothing if point is already -beyond @var{column}. The value is the column at which the inserted -indentation ends. -@end deffn - -@defopt indent-tabs-mode -@comment !!SourceFile indent.c -If this variable is non-@code{nil}, indentation functions can insert -tabs as well as spaces. Otherwise, they insert only spaces. Setting -this variable automatically makes it local to the current buffer. -@end defopt - -@node Mode-Specific Indent -@subsection Indentation Controlled by Major Mode - - An important function of each major mode is to customize the @key{TAB} -key to indent properly for the language being edited. This section -describes the mechanism of the @key{TAB} key and how to control it. -The functions in this section return unpredictable values. - -@defvar indent-line-function -This variable's value is the function to be used by @key{TAB} (and -various commands) to indent the current line. The command -@code{indent-according-to-mode} does no more than call this function. - -In Lisp mode, the value is the symbol @code{lisp-indent-line}; in C -mode, @code{c-indent-line}; in Fortran mode, @code{fortran-indent-line}. -In Fundamental mode, Text mode, and many other modes with no standard -for indentation, the value is @code{indent-to-left-margin} (which is the -default value). -@end defvar - -@deffn Command indent-according-to-mode -This command calls the function in @code{indent-line-function} to -indent the current line in a way appropriate for the current major mode. -@end deffn - -@deffn Command indent-for-tab-command -This command calls the function in @code{indent-line-function} to indent -the current line; except that if that function is -@code{indent-to-left-margin}, it calls @code{insert-tab} instead. (That -is a trivial command that inserts a tab character.) -@end deffn - -@deffn Command newline-and-indent -@comment !!SourceFile simple.el -This function inserts a newline, then indents the new line (the one -following the newline just inserted) according to the major mode. - -It does indentation by calling the current @code{indent-line-function}. -In programming language modes, this is the same thing @key{TAB} does, -but in some text modes, where @key{TAB} inserts a tab, -@code{newline-and-indent} indents to the column specified by -@code{left-margin}. -@end deffn - -@deffn Command reindent-then-newline-and-indent -@comment !!SourceFile simple.el -This command reindents the current line, inserts a newline at point, -and then reindents the new line (the one following the newline just -inserted). - -This command does indentation on both lines according to the current -major mode, by calling the current value of @code{indent-line-function}. -In programming language modes, this is the same thing @key{TAB} does, -but in some text modes, where @key{TAB} inserts a tab, -@code{reindent-then-newline-and-indent} indents to the column specified -by @code{left-margin}. -@end deffn - -@node Region Indent -@subsection Indenting an Entire Region - - This section describes commands that indent all the lines in the -region. They return unpredictable values. - -@deffn Command indent-region start end to-column -This command indents each nonblank line starting between @var{start} -(inclusive) and @var{end} (exclusive). If @var{to-column} is -@code{nil}, @code{indent-region} indents each nonblank line by calling -the current mode's indentation function, the value of -@code{indent-line-function}. - -If @var{to-column} is non-@code{nil}, it should be an integer -specifying the number of columns of indentation; then this function -gives each line exactly that much indentation, by either adding or -deleting whitespace. - -If there is a fill prefix, @code{indent-region} indents each line -by making it start with the fill prefix. -@end deffn - -@defvar indent-region-function -The value of this variable is a function that can be used by -@code{indent-region} as a short cut. You should design the function so -that it will produce the same results as indenting the lines of the -region one by one, but presumably faster. - -If the value is @code{nil}, there is no short cut, and -@code{indent-region} actually works line by line. - -A short-cut function is useful in modes such as C mode and Lisp mode, -where the @code{indent-line-function} must scan from the beginning of -the function definition: applying it to each line would be quadratic in -time. The short cut can update the scan information as it moves through -the lines indenting them; this takes linear time. In a mode where -indenting a line individually is fast, there is no need for a short cut. - -@code{indent-region} with a non-@code{nil} argument @var{to-column} has -a different meaning and does not use this variable. -@end defvar - -@deffn Command indent-rigidly start end count -@comment !!SourceFile indent.el -This command indents all lines starting between @var{start} -(inclusive) and @var{end} (exclusive) sideways by @var{count} columns. -This ``preserves the shape'' of the affected region, moving it as a -rigid unit. Consequently, this command is useful not only for indenting -regions of unindented text, but also for indenting regions of formatted -code. - -For example, if @var{count} is 3, this command adds 3 columns of -indentation to each of the lines beginning in the region specified. - -In Mail mode, @kbd{C-c C-y} (@code{mail-yank-original}) uses -@code{indent-rigidly} to indent the text copied from the message being -replied to. -@end deffn - -@defun indent-code-rigidly start end columns &optional nochange-regexp -This is like @code{indent-rigidly}, except that it doesn't alter lines -that start within strings or comments. - -In addition, it doesn't alter a line if @var{nochange-regexp} matches at -the beginning of the line (if @var{nochange-regexp} is non-@code{nil}). -@end defun - -@node Relative Indent -@subsection Indentation Relative to Previous Lines - - This section describes two commands that indent the current line -based on the contents of previous lines. - -@deffn Command indent-relative &optional unindented-ok -This command inserts whitespace at point, extending to the same -column as the next @dfn{indent point} of the previous nonblank line. An -indent point is a non-whitespace character following whitespace. The -next indent point is the first one at a column greater than the current -column of point. For example, if point is underneath and to the left of -the first non-blank character of a line of text, it moves to that column -by inserting whitespace. - -If the previous nonblank line has no next indent point (i.e., none at a -great enough column position), @code{indent-relative} either does -nothing (if @var{unindented-ok} is non-@code{nil}) or calls -@code{tab-to-tab-stop}. Thus, if point is underneath and to the right -of the last column of a short line of text, this command ordinarily -moves point to the next tab stop by inserting whitespace. - -The return value of @code{indent-relative} is unpredictable. - -In the following example, point is at the beginning of the second -line: - -@example -@group - This line is indented twelve spaces. -@point{}The quick brown fox jumped. -@end group -@end example - -@noindent -Evaluation of the expression @code{(indent-relative nil)} produces the -following: - -@example -@group - This line is indented twelve spaces. - @point{}The quick brown fox jumped. -@end group -@end example - - In this example, point is between the @samp{m} and @samp{p} of -@samp{jumped}: - -@example -@group - This line is indented twelve spaces. -The quick brown fox jum@point{}ped. -@end group -@end example - -@noindent -Evaluation of the expression @code{(indent-relative nil)} produces the -following: - -@example -@group - This line is indented twelve spaces. -The quick brown fox jum @point{}ped. -@end group -@end example -@end deffn - -@deffn Command indent-relative-maybe -@comment !!SourceFile indent.el -This command indents the current line like the previous nonblank line. -It calls @code{indent-relative} with @code{t} as the @var{unindented-ok} -argument. The return value is unpredictable. - -If the previous nonblank line has no indent points beyond the current -column, this command does nothing. -@end deffn - -@node Indent Tabs -@subsection Adjustable ``Tab Stops'' -@cindex tabs stops for indentation - - This section explains the mechanism for user-specified ``tab stops'' -and the mechanisms that use and set them. The name ``tab stops'' is -used because the feature is similar to that of the tab stops on a -typewriter. The feature works by inserting an appropriate number of -spaces and tab characters to reach the next tab stop column; it does not -affect the display of tab characters in the buffer (@pxref{Usual -Display}). Note that the @key{TAB} character as input uses this tab -stop feature only in a few major modes, such as Text mode. - -@deffn Command tab-to-tab-stop -This command inserts spaces or tabs up to the next tab stop column -defined by @code{tab-stop-list}. It searches the list for an element -greater than the current column number, and uses that element as the -column to indent to. It does nothing if no such element is found. -@end deffn - -@defopt tab-stop-list -This variable is the list of tab stop columns used by -@code{tab-to-tab-stops}. The elements should be integers in increasing -order. The tab stop columns need not be evenly spaced. - -Use @kbd{M-x edit-tab-stops} to edit the location of tab stops -interactively. -@end defopt - -@node Motion by Indent -@subsection Indentation-Based Motion Commands - - These commands, primarily for interactive use, act based on the -indentation in the text. - -@deffn Command back-to-indentation -@comment !!SourceFile simple.el -This command moves point to the first non-whitespace character in the -current line (which is the line in which point is located). It returns -@code{nil}. -@end deffn - -@deffn Command backward-to-indentation arg -@comment !!SourceFile simple.el -This command moves point backward @var{arg} lines and then to the -first nonblank character on that line. It returns @code{nil}. -@end deffn - -@deffn Command forward-to-indentation arg -@comment !!SourceFile simple.el -This command moves point forward @var{arg} lines and then to the first -nonblank character on that line. It returns @code{nil}. -@end deffn - -@node Case Changes -@section Case Changes -@cindex case changes - - The case change commands described here work on text in the current -buffer. @xref{Character Case}, for case conversion commands that work -on strings and characters. @xref{Case Tables}, for how to customize -which characters are upper or lower case and how to convert them. - -@deffn Command capitalize-region start end -This function capitalizes all words in the region defined by -@var{start} and @var{end}. To capitalize means to convert each word's -first character to upper case and convert the rest of each word to lower -case. The function returns @code{nil}. - -If one end of the region is in the middle of a word, the part of the -word within the region is treated as an entire word. - -When @code{capitalize-region} is called interactively, @var{start} and -@var{end} are point and the mark, with the smallest first. - -@example -@group ----------- Buffer: foo ---------- -This is the contents of the 5th foo. ----------- Buffer: foo ---------- -@end group - -@group -(capitalize-region 1 44) -@result{} nil - ----------- Buffer: foo ---------- -This Is The Contents Of The 5th Foo. ----------- Buffer: foo ---------- -@end group -@end example -@end deffn - -@deffn Command downcase-region start end -This function converts all of the letters in the region defined by -@var{start} and @var{end} to lower case. The function returns -@code{nil}. - -When @code{downcase-region} is called interactively, @var{start} and -@var{end} are point and the mark, with the smallest first. -@end deffn - -@deffn Command upcase-region start end -This function converts all of the letters in the region defined by -@var{start} and @var{end} to upper case. The function returns -@code{nil}. - -When @code{upcase-region} is called interactively, @var{start} and -@var{end} are point and the mark, with the smallest first. -@end deffn - -@deffn Command capitalize-word count -This function capitalizes @var{count} words after point, moving point -over as it does. To capitalize means to convert each word's first -character to upper case and convert the rest of each word to lower case. -If @var{count} is negative, the function capitalizes the -@minus{}@var{count} previous words but does not move point. The value -is @code{nil}. - -If point is in the middle of a word, the part of the word before point -is ignored when moving forward. The rest is treated as an entire word. - -When @code{capitalize-word} is called interactively, @var{count} is -set to the numeric prefix argument. -@end deffn - -@deffn Command downcase-word count -This function converts the @var{count} words after point to all lower -case, moving point over as it does. If @var{count} is negative, it -converts the @minus{}@var{count} previous words but does not move point. -The value is @code{nil}. - -When @code{downcase-word} is called interactively, @var{count} is set -to the numeric prefix argument. -@end deffn - -@deffn Command upcase-word count -This function converts the @var{count} words after point to all upper -case, moving point over as it does. If @var{count} is negative, it -converts the @minus{}@var{count} previous words but does not move point. -The value is @code{nil}. - -When @code{upcase-word} is called interactively, @var{count} is set to -the numeric prefix argument. -@end deffn - -@node Text Properties -@section Text Properties -@cindex text properties -@cindex attributes of text -@cindex properties of text - - Text properties are an alternative interface to extents -(@pxref{Extents}), and are built on top of them. They are useful when -you want to view textual properties as being attached to the characters -themselves rather than to intervals of characters. The text property -interface is compatible with FSF Emacs. - - Each character position in a buffer or a string can have a @dfn{text -property list}, much like the property list of a symbol (@pxref{Property -Lists}). The properties belong to a particular character at a -particular place, such as, the letter @samp{T} at the beginning of this -sentence or the first @samp{o} in @samp{foo}---if the same character -occurs in two different places, the two occurrences generally have -different properties. - - Each property has a name and a value. Both of these can be any Lisp -object, but the name is normally a symbol. The usual way to access the -property list is to specify a name and ask what value corresponds to it. - -@ignore - If a character has a @code{category} property, we call it the -@dfn{category} of the character. It should be a symbol. The properties -of the symbol serve as defaults for the properties of the character. -@end ignore - Note that FSF Emacs also looks at the @code{category} property to find -defaults for text properties. We consider this too bogus to implement. - - Copying text between strings and buffers preserves the properties -along with the characters; this includes such diverse functions as -@code{substring}, @code{insert}, and @code{buffer-substring}. - -@menu -* Examining Properties:: Looking at the properties of one character. -* Changing Properties:: Setting the properties of a range of text. -* Property Search:: Searching for where a property changes value. -* Special Properties:: Particular properties with special meanings. -* Saving Properties:: Saving text properties in files, and reading - them back. -@end menu - -@node Examining Properties -@subsection Examining Text Properties - - The simplest way to examine text properties is to ask for the value of -a particular property of a particular character. For that, use -@code{get-text-property}. Use @code{text-properties-at} to get the -entire property list of a character. @xref{Property Search}, for -functions to examine the properties of a number of characters at once. - - These functions handle both strings and buffers. (Keep in mind that -positions in a string start from 0, whereas positions in a buffer start -from 1.) - -@defun get-text-property pos prop &optional object -This function returns the value of the @var{prop} property of the -character after position @var{pos} in @var{object} (a buffer or string). -The argument @var{object} is optional and defaults to the current -buffer. -@ignore @c Bogus as hell! -If there is no @var{prop} property strictly speaking, but the character -has a category that is a symbol, then @code{get-text-property} returns -the @var{prop} property of that symbol. -@end ignore -@end defun - -@defun get-char-property pos prop &optional object -This function is like @code{get-text-property}, except that it checks -all extents, not just text-property extents. - -@ignore Does not apply in XEmacs -The argument @var{object} may be a string, a buffer, or a window. If it -is a window, then the buffer displayed in that window is used for text -properties and overlays, but only the overlays active for that window -are considered. If @var{object} is a buffer, then all overlays in that -buffer are considered, as well as text properties. If @var{object} is a -string, only text properties are considered, since strings never have -overlays. -@end ignore -@end defun - -@defun text-properties-at position &optional object -This function returns the entire property list of the character at -@var{position} in the string or buffer @var{object}. If @var{object} is -@code{nil}, it defaults to the current buffer. -@end defun - -@defvar default-text-properties -This variable holds a property list giving default values for text -properties. Whenever a character does not specify a value for a -property, the value stored in this list is used instead. Here is -an example: - -@example -(setq default-text-properties '(foo 69)) -;; @r{Make sure character 1 has no properties of its own.} -(set-text-properties 1 2 nil) -;; @r{What we get, when we ask, is the default value.} -(get-text-property 1 'foo) - @result{} 69 -@end example -@end defvar - -@node Changing Properties -@subsection Changing Text Properties - - The primitives for changing properties apply to a specified range of -text. The function @code{set-text-properties} (see end of section) sets -the entire property list of the text in that range; more often, it is -useful to add, change, or delete just certain properties specified by -name. - - Since text properties are considered part of the buffer's contents, and -can affect how the buffer looks on the screen, any change in the text -properties is considered a buffer modification. Buffer text property -changes are undoable (@pxref{Undo}). - -@defun put-text-property start end prop value &optional object -This function sets the @var{prop} property to @var{value} for the text -between @var{start} and @var{end} in the string or buffer @var{object}. -If @var{object} is @code{nil}, it defaults to the current buffer. -@end defun - -@defun add-text-properties start end props &optional object -This function modifies the text properties for the text between -@var{start} and @var{end} in the string or buffer @var{object}. If -@var{object} is @code{nil}, it defaults to the current buffer. - -The argument @var{props} specifies which properties to change. It -should have the form of a property list (@pxref{Property Lists}): a list -whose elements include the property names followed alternately by the -corresponding values. - -The return value is @code{t} if the function actually changed some -property's value; @code{nil} otherwise (if @var{props} is @code{nil} or -its values agree with those in the text). - -For example, here is how to set the @code{comment} and @code{face} -properties of a range of text: - -@example -(add-text-properties @var{start} @var{end} - '(comment t face highlight)) -@end example -@end defun - -@defun remove-text-properties start end props &optional object -This function deletes specified text properties from the text between -@var{start} and @var{end} in the string or buffer @var{object}. If -@var{object} is @code{nil}, it defaults to the current buffer. - -The argument @var{props} specifies which properties to delete. It -should have the form of a property list (@pxref{Property Lists}): a list -whose elements are property names alternating with corresponding values. -But only the names matter---the values that accompany them are ignored. -For example, here's how to remove the @code{face} property. - -@example -(remove-text-properties @var{start} @var{end} '(face nil)) -@end example - -The return value is @code{t} if the function actually changed some -property's value; @code{nil} otherwise (if @var{props} is @code{nil} or -if no character in the specified text had any of those properties). -@end defun - -@defun set-text-properties start end props &optional object -This function completely replaces the text property list for the text -between @var{start} and @var{end} in the string or buffer @var{object}. -If @var{object} is @code{nil}, it defaults to the current buffer. - -The argument @var{props} is the new property list. It should be a list -whose elements are property names alternating with corresponding values. - -After @code{set-text-properties} returns, all the characters in the -specified range have identical properties. - -If @var{props} is @code{nil}, the effect is to get rid of all properties -from the specified range of text. Here's an example: - -@example -(set-text-properties @var{start} @var{end} nil) -@end example -@end defun - -See also the function @code{buffer-substring-without-properties} -(@pxref{Buffer Contents}) which copies text from the buffer -but does not copy its properties. - -@node Property Search -@subsection Property Search Functions - -In typical use of text properties, most of the time several or many -consecutive characters have the same value for a property. Rather than -writing your programs to examine characters one by one, it is much -faster to process chunks of text that have the same property value. - -Here are functions you can use to do this. They use @code{eq} for -comparing property values. In all cases, @var{object} defaults to the -current buffer. - -For high performance, it's very important to use the @var{limit} -argument to these functions, especially the ones that search for a -single property---otherwise, they may spend a long time scanning to the -end of the buffer, if the property you are interested in does not change. - -Remember that a position is always between two characters; the position -returned by these functions is between two characters with different -properties. - -@defun next-property-change pos &optional object limit -The function scans the text forward from position @var{pos} in the -string or buffer @var{object} till it finds a change in some text -property, then returns the position of the change. In other words, it -returns the position of the first character beyond @var{pos} whose -properties are not identical to those of the character just after -@var{pos}. - -If @var{limit} is non-@code{nil}, then the scan ends at position -@var{limit}. If there is no property change before that point, -@code{next-property-change} returns @var{limit}. - -The value is @code{nil} if the properties remain unchanged all the way -to the end of @var{object} and @var{limit} is @code{nil}. If the value -is non-@code{nil}, it is a position greater than or equal to @var{pos}. -The value equals @var{pos} only when @var{limit} equals @var{pos}. - -Here is an example of how to scan the buffer by chunks of text within -which all properties are constant: - -@smallexample -(while (not (eobp)) - (let ((plist (text-properties-at (point))) - (next-change - (or (next-property-change (point) (current-buffer)) - (point-max)))) - @r{Process text from point to @var{next-change}@dots{}} - (goto-char next-change))) -@end smallexample -@end defun - -@defun next-single-property-change pos prop &optional object limit -The function scans the text forward from position @var{pos} in the -string or buffer @var{object} till it finds a change in the @var{prop} -property, then returns the position of the change. In other words, it -returns the position of the first character beyond @var{pos} whose -@var{prop} property differs from that of the character just after -@var{pos}. - -If @var{limit} is non-@code{nil}, then the scan ends at position -@var{limit}. If there is no property change before that point, -@code{next-single-property-change} returns @var{limit}. - -The value is @code{nil} if the property remains unchanged all the way to -the end of @var{object} and @var{limit} is @code{nil}. If the value is -non-@code{nil}, it is a position greater than or equal to @var{pos}; it -equals @var{pos} only if @var{limit} equals @var{pos}. -@end defun - -@defun previous-property-change pos &optional object limit -This is like @code{next-property-change}, but scans back from @var{pos} -instead of forward. If the value is non-@code{nil}, it is a position -less than or equal to @var{pos}; it equals @var{pos} only if @var{limit} -equals @var{pos}. -@end defun - -@defun previous-single-property-change pos prop &optional object limit -This is like @code{next-single-property-change}, but scans back from -@var{pos} instead of forward. If the value is non-@code{nil}, it is a -position less than or equal to @var{pos}; it equals @var{pos} only if -@var{limit} equals @var{pos}. -@end defun - -@defun text-property-any start end prop value &optional object -This function returns non-@code{nil} if at least one character between -@var{start} and @var{end} has a property @var{prop} whose value is -@var{value}. More precisely, it returns the position of the first such -character. Otherwise, it returns @code{nil}. - -The optional fifth argument, @var{object}, specifies the string or -buffer to scan. Positions are relative to @var{object}. The default -for @var{object} is the current buffer. -@end defun - -@defun text-property-not-all start end prop value &optional object -This function returns non-@code{nil} if at least one character between -@var{start} and @var{end} has a property @var{prop} whose value differs -from @var{value}. More precisely, it returns the position of the -first such character. Otherwise, it returns @code{nil}. - -The optional fifth argument, @var{object}, specifies the string or -buffer to scan. Positions are relative to @var{object}. The default -for @var{object} is the current buffer. -@end defun - -@node Special Properties -@subsection Properties with Special Meanings - -The predefined properties are the same as those for extents. -@xref{Extent Properties}. - -@ignore Changed in XEmacs -(deleted section describing FSF Emacs special text properties) -@end ignore - -@node Saving Properties -@subsection Saving Text Properties in Files -@cindex text properties in files -@cindex saving text properties - - You can save text properties in files, and restore text properties -when inserting the files, using these two hooks: - -@defvar write-region-annotate-functions -This variable's value is a list of functions for @code{write-region} to -run to encode text properties in some fashion as annotations to the text -being written in the file. @xref{Writing to Files}. - -Each function in the list is called with two arguments: the start and -end of the region to be written. These functions should not alter the -contents of the buffer. Instead, they should return lists indicating -annotations to write in the file in addition to the text in the -buffer. - -Each function should return a list of elements of the form -@code{(@var{position} . @var{string})}, where @var{position} is an -integer specifying the relative position in the text to be written, and -@var{string} is the annotation to add there. - -Each list returned by one of these functions must be already sorted in -increasing order by @var{position}. If there is more than one function, -@code{write-region} merges the lists destructively into one sorted list. - -When @code{write-region} actually writes the text from the buffer to the -file, it intermixes the specified annotations at the corresponding -positions. All this takes place without modifying the buffer. -@end defvar - -@defvar after-insert-file-functions -This variable holds a list of functions for @code{insert-file-contents} -to call after inserting a file's contents. These functions should scan -the inserted text for annotations, and convert them to the text -properties they stand for. - -Each function receives one argument, the length of the inserted text; -point indicates the start of that text. The function should scan that -text for annotations, delete them, and create the text properties that -the annotations specify. The function should return the updated length -of the inserted text, as it stands after those changes. The value -returned by one function becomes the argument to the next function. - -These functions should always return with point at the beginning of -the inserted text. - -The intended use of @code{after-insert-file-functions} is for converting -some sort of textual annotations into actual text properties. But other -uses may be possible. -@end defvar - -We invite users to write Lisp programs to store and retrieve text -properties in files, using these hooks, and thus to experiment with -various data formats and find good ones. Eventually we hope users -will produce good, general extensions we can install in Emacs. - -We suggest not trying to handle arbitrary Lisp objects as property -names or property values---because a program that general is probably -difficult to write, and slow. Instead, choose a set of possible data -types that are reasonably flexible, and not too hard to encode. - -@xref{Format Conversion}, for a related feature. - -@node Substitution -@section Substituting for a Character Code - - The following functions replace characters within a specified region -based on their character codes. - -@defun subst-char-in-region start end old-char new-char &optional noundo -@cindex replace characters -This function replaces all occurrences of the character @var{old-char} -with the character @var{new-char} in the region of the current buffer -defined by @var{start} and @var{end}. - -@cindex Outline mode -@cindex undo avoidance -If @var{noundo} is non-@code{nil}, then @code{subst-char-in-region} does -not record the change for undo and does not mark the buffer as modified. -This feature is used for controlling selective display (@pxref{Selective -Display}). - -@code{subst-char-in-region} does not move point and returns -@code{nil}. - -@example -@group ----------- Buffer: foo ---------- -This is the contents of the buffer before. ----------- Buffer: foo ---------- -@end group - -@group -(subst-char-in-region 1 20 ?i ?X) - @result{} nil - ----------- Buffer: foo ---------- -ThXs Xs the contents of the buffer before. ----------- Buffer: foo ---------- -@end group -@end example -@end defun - -@defun translate-region start end table -This function applies a translation table to the characters in the -buffer between positions @var{start} and @var{end}. - -The translation table @var{table} is a string; @code{(aref @var{table} -@var{ochar})} gives the translated character corresponding to -@var{ochar}. If the length of @var{table} is less than 256, any -characters with codes larger than the length of @var{table} are not -altered by the translation. - -The return value of @code{translate-region} is the number of -characters that were actually changed by the translation. This does -not count characters that were mapped into themselves in the -translation table. -@end defun - -@node Registers -@section Registers -@cindex registers - - A register is a sort of variable used in XEmacs editing that can hold a -marker, a string, a rectangle, a window configuration (of one frame), or -a frame configuration (of all frames). Each register is named by a -single character. All characters, including control and meta characters -(but with the exception of @kbd{C-g}), can be used to name registers. -Thus, there are 255 possible registers. A register is designated in -Emacs Lisp by a character that is its name. - - The functions in this section return unpredictable values unless -otherwise stated. -@c Will change in version 19 - -@defvar register-alist -This variable is an alist of elements of the form @code{(@var{name} . -@var{contents})}. Normally, there is one element for each XEmacs -register that has been used. - -The object @var{name} is a character (an integer) identifying the -register. The object @var{contents} is a string, marker, or list -representing the register contents. A string represents text stored in -the register. A marker represents a position. A list represents a -rectangle; its elements are strings, one per line of the rectangle. -@end defvar - -@defun get-register reg -This function returns the contents of the register -@var{reg}, or @code{nil} if it has no contents. -@end defun - -@defun set-register reg value -This function sets the contents of register @var{reg} to @var{value}. -A register can be set to any value, but the other register functions -expect only certain data types. The return value is @var{value}. -@end defun - -@deffn Command view-register reg -This command displays what is contained in register @var{reg}. -@end deffn - -@ignore -@deffn Command point-to-register reg -This command stores both the current location of point and the current -buffer in register @var{reg} as a marker. -@end deffn - -@deffn Command jump-to-register reg -@deffnx Command register-to-point reg -@comment !!SourceFile register.el -This command restores the status recorded in register @var{reg}. - -If @var{reg} contains a marker, it moves point to the position stored in -the marker. Since both the buffer and the location within the buffer -are stored by the @code{point-to-register} function, this command can -switch you to another buffer. - -If @var{reg} contains a window configuration or a frame configuration. -@code{jump-to-register} restores that configuration. -@end deffn -@end ignore - -@deffn Command insert-register reg &optional beforep -This command inserts contents of register @var{reg} into the current -buffer. - -Normally, this command puts point before the inserted text, and the -mark after it. However, if the optional second argument @var{beforep} -is non-@code{nil}, it puts the mark before and point after. -You can pass a non-@code{nil} second argument @var{beforep} to this -function interactively by supplying any prefix argument. - -If the register contains a rectangle, then the rectangle is inserted -with its upper left corner at point. This means that text is inserted -in the current line and underneath it on successive lines. - -If the register contains something other than saved text (a string) or -a rectangle (a list), currently useless things happen. This may be -changed in the future. -@end deffn - -@ignore -@deffn Command copy-to-register reg start end &optional delete-flag -This command copies the region from @var{start} to @var{end} into -register @var{reg}. If @var{delete-flag} is non-@code{nil}, it deletes -the region from the buffer after copying it into the register. -@end deffn - -@deffn Command prepend-to-register reg start end &optional delete-flag -This command prepends the region from @var{start} to @var{end} into -register @var{reg}. If @var{delete-flag} is non-@code{nil}, it deletes -the region from the buffer after copying it to the register. -@end deffn - -@deffn Command append-to-register reg start end &optional delete-flag -This command appends the region from @var{start} to @var{end} to the -text already in register @var{reg}. If @var{delete-flag} is -non-@code{nil}, it deletes the region from the buffer after copying it -to the register. -@end deffn - -@deffn Command copy-rectangle-to-register reg start end &optional delete-flag -This command copies a rectangular region from @var{start} to @var{end} -into register @var{reg}. If @var{delete-flag} is non-@code{nil}, it -deletes the region from the buffer after copying it to the register. -@end deffn - -@deffn Command window-configuration-to-register reg -This function stores the window configuration of the selected frame in -register @var{reg}. -@end deffn - -@deffn Command frame-configuration-to-register reg -This function stores the current frame configuration in register -@var{reg}. -@end deffn -@end ignore - -@node Transposition -@section Transposition of Text - - This subroutine is used by the transposition commands. - -@defun transpose-regions start1 end1 start2 end2 &optional leave-markers -This function exchanges two nonoverlapping portions of the buffer. -Arguments @var{start1} and @var{end1} specify the bounds of one portion -and arguments @var{start2} and @var{end2} specify the bounds of the -other portion. - -Normally, @code{transpose-regions} relocates markers with the transposed -text; a marker previously positioned within one of the two transposed -portions moves along with that portion, thus remaining between the same -two characters in their new position. However, if @var{leave-markers} -is non-@code{nil}, @code{transpose-regions} does not do this---it leaves -all markers unrelocated. -@end defun - -@node Change Hooks -@section Change Hooks -@cindex change hooks -@cindex hooks for text changes - - These hook variables let you arrange to take notice of all changes in -all buffers (or in a particular buffer, if you make them buffer-local). -@ignore Not in XEmacs -See also @ref{Special Properties}, for how to detect changes to specific -parts of the text. -@end ignore - - The functions you use in these hooks should save and restore the match -data if they do anything that uses regular expressions; otherwise, they -will interfere in bizarre ways with the editing operations that call -them. - - Buffer changes made while executing the following hooks don't -themselves cause any change hooks to be invoked. - -@defvar before-change-functions -This variable holds a list of a functions to call before any buffer -modification. Each function gets two arguments, the beginning and end -of the region that is about to change, represented as integers. The -buffer that is about to change is always the current buffer. -@end defvar - -@defvar after-change-functions -This variable holds a list of a functions to call after any buffer -modification. Each function receives three arguments: the beginning and -end of the region just changed, and the length of the text that existed -before the change. (To get the current length, subtract the region -beginning from the region end.) All three arguments are integers. The -buffer that's about to change is always the current buffer. -@end defvar - -@defvar before-change-function -This obsolete variable holds one function to call before any buffer -modification (or @code{nil} for no function). It is called just like -the functions in @code{before-change-functions}. -@end defvar - -@defvar after-change-function -This obsolete variable holds one function to call after any buffer modification -(or @code{nil} for no function). It is called just like the functions in -@code{after-change-functions}. -@end defvar - -@defvar first-change-hook -This variable is a normal hook that is run whenever a buffer is changed -that was previously in the unmodified state. -@end defvar - -@node Transformations -@section Textual transformations---MD5 and base64 support -@cindex MD5 digests -@cindex base64 - -Some textual operations inherently require examining each character in -turn, and performing arithmetic operations on them. Such operations -can, of course, be implemented in Emacs Lisp, but tend to be very slow -for large portions of text or data. This is why some of them are -implemented in C, with an appropriate interface for Lisp programmers. -Examples of algorithms thus provided are MD5 and base64 support. - -MD5 is an algorithm for calculating message digests, as described in -rfc1321. Given a message of arbitrary length, MD5 produces an 128-bit -``fingerprint'' (``message digest'') corresponding to that message. It -is considered computationally infeasible to produce two messages having -the same MD5 digest, or to produce a message having a prespecified -target digest. MD5 is used heavily by various authentication schemes. - -Emacs Lisp interface to MD5 consists of a single function @code{md5}: - -@defun md5 object &optional start end -This function returns the MD5 message digest of @var{object}, a buffer -or string. - -Optional arguments @var{start} and @var{end} denote positions for -computing the digest of a portion of @var{object}. - -Some examples of usage: - -@example -@group -;; @r{Calculate the digest of the entire buffer} -(md5 (current-buffer)) - @result{} "8842b04362899b1cda8d2d126dc11712" -@end group - -@group -;; @r{Calculate the digest of the current line} -(md5 (current-buffer) (point-at-bol) (point-at-eol)) - @result{} "60614d21e9dee27dfdb01fa4e30d6d00" -@end group - -@group -;; @r{Calculate the digest of your name and email address} -(md5 (concat (format "%s <%s>" (user-full-name) user-mail-address))) - @result{} "0a2188c40fd38922d941fe6032fce516" -@end group -@end example -@end defun - -Base64 is a portable encoding for arbitrary sequences of octets, in a -form that need not be readable by humans. It uses a 65-character subset -of US-ASCII, as described in rfc2045. Base64 is used by MIME to encode -binary bodies, and to encode binary characters in message headers. - -The Lisp interface to base64 consists of four functions: - -@defun base64-encode-region beg end &optional no-line-break -This function encodes the region between @var{beg} and @var{end} of the -current buffer to base64 format. This means that the original region is -deleted, and replaced with its base64 equivalent. - -Normally, encoded base64 output is multi-line, with 76-character lines. -If @var{no-line-break} is non-@code{nil}, newlines will not be inserted, -resulting in single-line output. - -Mule note: you should make sure that you convert the multibyte -characters (those that do not fit into 0--255 range) to something else, -because they cannot be meaningfully converted to base64. If the -@code{base64-encode-region} encounters such characters, it will signal -an error. - -@code{base64-encode-region} returns the length of the encoded text. - -@example -@group -;; @r{Encode the whole buffer in base64} -(base64-encode-region (point-min) (point-max)) -@end group -@end example - -The function can also be used interactively, in which case it works on -the currently active region. -@end defun - -@defun base64-encode-string string -This function encodes @var{string} to base64, and returns the encoded -string. - -For Mule, the same considerations apply as for -@code{base64-encode-region}. - -@example -@group -(base64-encode-string "fubar") - @result{} "ZnViYXI=" -@end group -@end example -@end defun - -@defun base64-decode-region beg end -This function decodes the region between @var{beg} and @var{end} of the -current buffer. The region should be in base64 encoding. - -If the region was decoded correctly, @code{base64-decode-region} returns -the length of the decoded region. If the decoding failed, @code{nil} is -returned. - -@example -@group -;; @r{Decode a base64 buffer, and replace it with the decoded version} -(base64-decode-region (point-min) (point-max)) -@end group -@end example -@end defun - -@defun base64-decode-string string -This function decodes @var{string} to base64, and returns the decoded -string. @var{string} should be valid base64-encoded text. - -If encoding was not possible, @code{nil} is returned. - -@example -@group -(base64-decode-string "ZnViYXI=") - @result{} "fubar" -@end group - -@group -(base64-decode-string "totally bogus") - @result{} nil -@end group -@end example -@end defun diff --git a/man/lispref/tips.texi b/man/lispref/tips.texi deleted file mode 100644 index 5e952ab..0000000 --- a/man/lispref/tips.texi +++ /dev/null @@ -1,658 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/tips.info -@node Tips, Building XEmacs and Object Allocation, MULE, Top -@appendix Tips and Standards -@cindex tips -@cindex standards of coding style -@cindex coding standards - - This chapter describes no additional features of XEmacs Lisp. -Instead it gives advice on making effective use of the features described -in the previous chapters. - -@menu -* Style Tips:: Writing clean and robust programs. -* Compilation Tips:: Making compiled code run fast. -* Documentation Tips:: Writing readable documentation strings. -* Comment Tips:: Conventions for writing comments. -* Library Headers:: Standard headers for library packages. -@end menu - -@node Style Tips -@section Writing Clean Lisp Programs - - Here are some tips for avoiding common errors in writing Lisp code -intended for widespread use: - -@itemize @bullet -@item -Since all global variables share the same name space, and all functions -share another name space, you should choose a short word to distinguish -your program from other Lisp programs. Then take care to begin the -names of all global variables, constants, and functions with the chosen -prefix. This helps avoid name conflicts. - -This recommendation applies even to names for traditional Lisp -primitives that are not primitives in XEmacs Lisp---even to @code{cadr}. -Believe it or not, there is more than one plausible way to define -@code{cadr}. Play it safe; append your name prefix to produce a name -like @code{foo-cadr} or @code{mylib-cadr} instead. - -If you write a function that you think ought to be added to Emacs under -a certain name, such as @code{twiddle-files}, don't call it by that name -in your program. Call it @code{mylib-twiddle-files} in your program, -and send mail to @samp{bug-gnu-emacs@@prep.ai.mit.edu} suggesting we add -it to Emacs. If and when we do, we can change the name easily enough. - -If one prefix is insufficient, your package may use two or three -alternative common prefixes, so long as they make sense. - -Separate the prefix from the rest of the symbol name with a hyphen, -@samp{-}. This will be consistent with XEmacs itself and with most Emacs -Lisp programs. - -@item -It is often useful to put a call to @code{provide} in each separate -library program, at least if there is more than one entry point to the -program. - -@item -If a file requires certain other library programs to be loaded -beforehand, then the comments at the beginning of the file should say -so. Also, use @code{require} to make sure they are loaded. - -@item -If one file @var{foo} uses a macro defined in another file @var{bar}, -@var{foo} should contain this expression before the first use of the -macro: - -@example -(eval-when-compile (require '@var{bar})) -@end example - -@noindent -(And @var{bar} should contain @code{(provide '@var{bar})}, to make the -@code{require} work.) This will cause @var{bar} to be loaded when you -byte-compile @var{foo}. Otherwise, you risk compiling @var{foo} without -the necessary macro loaded, and that would produce compiled code that -won't work right. @xref{Compiling Macros}. - -Using @code{eval-when-compile} avoids loading @var{bar} when -the compiled version of @var{foo} is @emph{used}. - -@item -If you define a major mode, make sure to run a hook variable using -@code{run-hooks}, just as the existing major modes do. @xref{Hooks}. - -@item -If the purpose of a function is to tell you whether a certain condition -is true or false, give the function a name that ends in @samp{p}. If -the name is one word, add just @samp{p}; if the name is multiple words, -add @samp{-p}. Examples are @code{framep} and @code{frame-live-p}. - -@item -If a user option variable records a true-or-false condition, give it a -name that ends in @samp{-flag}. - -@item -Please do not define @kbd{C-c @var{letter}} as a key in your major -modes. These sequences are reserved for users; they are the -@strong{only} sequences reserved for users, so we cannot do without -them. - -Instead, define sequences consisting of @kbd{C-c} followed by a -non-letter. These sequences are reserved for major modes. - -Changing all the major modes in Emacs 18 so they would follow this -convention was a lot of work. Abandoning this convention would make -that work go to waste, and inconvenience users. - -@item -Sequences consisting of @kbd{C-c} followed by @kbd{@{}, @kbd{@}}, -@kbd{<}, @kbd{>}, @kbd{:} or @kbd{;} are also reserved for major modes. - -@item -Sequences consisting of @kbd{C-c} followed by any other punctuation -character are allocated for minor modes. Using them in a major mode is -not absolutely prohibited, but if you do that, the major mode binding -may be shadowed from time to time by minor modes. - -@item -You should not bind @kbd{C-h} following any prefix character (including -@kbd{C-c}). If you don't bind @kbd{C-h}, it is automatically available -as a help character for listing the subcommands of the prefix character. - -@item -You should not bind a key sequence ending in @key{ESC} except following -another @key{ESC}. (That is, it is ok to bind a sequence ending in -@kbd{@key{ESC} @key{ESC}}.) - -The reason for this rule is that a non-prefix binding for @key{ESC} in -any context prevents recognition of escape sequences as function keys in -that context. - -@item -Applications should not bind mouse events based on button 1 with the -shift key held down. These events include @kbd{S-mouse-1}, -@kbd{M-S-mouse-1}, @kbd{C-S-mouse-1}, and so on. They are reserved for -users. - -@item -Modes should redefine @kbd{mouse-2} as a command to follow some sort of -reference in the text of a buffer, if users usually would not want to -alter the text in that buffer by hand. Modes such as Dired, Info, -Compilation, and Occur redefine it in this way. - -@item -When a package provides a modification of ordinary Emacs behavior, it is -good to include a command to enable and disable the feature, Provide a -command named @code{@var{whatever}-mode} which turns the feature on or -off, and make it autoload (@pxref{Autoload}). Design the package so -that simply loading it has no visible effect---that should not enable -the feature. Users will request the feature by invoking the command. - -@item -It is a bad idea to define aliases for the Emacs primitives. Use the -standard names instead. - -@item -Redefining an Emacs primitive is an even worse idea. -It may do the right thing for a particular program, but -there is no telling what other programs might break as a result. - -@item -If a file does replace any of the functions or library programs of -standard XEmacs, prominent comments at the beginning of the file should -say which functions are replaced, and how the behavior of the -replacements differs from that of the originals. - -@item -Please keep the names of your XEmacs Lisp source files to 13 characters -or less. This way, if the files are compiled, the compiled files' names -will be 14 characters or less, which is short enough to fit on all kinds -of Unix systems. - -@item -Don't use @code{next-line} or @code{previous-line} in programs; nearly -always, @code{forward-line} is more convenient as well as more -predictable and robust. @xref{Text Lines}. - -@item -Don't call functions that set the mark, unless setting the mark is one -of the intended features of your program. The mark is a user-level -feature, so it is incorrect to change the mark except to supply a value -for the user's benefit. @xref{The Mark}. - -In particular, don't use these functions: - -@itemize @bullet -@item -@code{beginning-of-buffer}, @code{end-of-buffer} -@item -@code{replace-string}, @code{replace-regexp} -@end itemize - -If you just want to move point, or replace a certain string, without any -of the other features intended for interactive users, you can replace -these functions with one or two lines of simple Lisp code. - -@item -Use lists rather than vectors, except when there is a particular reason -to use a vector. Lisp has more facilities for manipulating lists than -for vectors, and working with lists is usually more convenient. - -Vectors are advantageous for tables that are substantial in size and are -accessed in random order (not searched front to back), provided there is -no need to insert or delete elements (only lists allow that). - -@item -The recommended way to print a message in the echo area is with -the @code{message} function, not @code{princ}. @xref{The Echo Area}. - -@item -When you encounter an error condition, call the function @code{error} -(or @code{signal}). The function @code{error} does not return. -@xref{Signaling Errors}. - -Do not use @code{message}, @code{throw}, @code{sleep-for}, -or @code{beep} to report errors. - -@item -An error message should start with a capital letter but should not end -with a period. - -@item -Try to avoid using recursive edits. Instead, do what the Rmail @kbd{e} -command does: use a new local keymap that contains one command defined -to switch back to the old local keymap. Or do what the -@code{edit-options} command does: switch to another buffer and let the -user switch back at will. @xref{Recursive Editing}. - -@item -In some other systems there is a convention of choosing variable names -that begin and end with @samp{*}. We don't use that convention in Emacs -Lisp, so please don't use it in your programs. (Emacs uses such names -only for program-generated buffers.) The users will find Emacs more -coherent if all libraries use the same conventions. - -@item -Indent each function with @kbd{C-M-q} (@code{indent-sexp}) using the -default indentation parameters. - -@item -Don't make a habit of putting close-parentheses on lines by themselves; -Lisp programmers find this disconcerting. Once in a while, when there -is a sequence of many consecutive close-parentheses, it may make sense -to split them in one or two significant places. - -@item -Please put a copyright notice on the file if you give copies to anyone. -Use the same lines that appear at the top of the Lisp files in XEmacs -itself. If you have not signed papers to assign the copyright to the -Foundation, then place your name in the copyright notice in place of the -Foundation's name. -@end itemize - -@node Compilation Tips -@section Tips for Making Compiled Code Fast -@cindex execution speed -@cindex speedups - - Here are ways of improving the execution speed of byte-compiled -Lisp programs. - -@itemize @bullet -@item -@cindex profiling -@cindex timing programs -@cindex @file{profile.el} -Use the @file{profile} library to profile your program. See the file -@file{profile.el} for instructions. - -@item -Use iteration rather than recursion whenever possible. -Function calls are slow in XEmacs Lisp even when a compiled function -is calling another compiled function. - -@item -Using the primitive list-searching functions @code{memq}, @code{member}, -@code{assq}, or @code{assoc} is even faster than explicit iteration. It -may be worth rearranging a data structure so that one of these primitive -search functions can be used. - -@item -Certain built-in functions are handled specially in byte-compiled code, -avoiding the need for an ordinary function call. It is a good idea to -use these functions rather than alternatives. To see whether a function -is handled specially by the compiler, examine its @code{byte-compile} -property. If the property is non-@code{nil}, then the function is -handled specially. - -For example, the following input will show you that @code{aref} is -compiled specially (@pxref{Array Functions}) while @code{elt} is not -(@pxref{Sequence Functions}): - -@example -@group -(get 'aref 'byte-compile) - @result{} byte-compile-two-args -@end group - -@group -(get 'elt 'byte-compile) - @result{} nil -@end group -@end example - -@item -If calling a small function accounts for a substantial part of your -program's running time, make the function inline. This eliminates -the function call overhead. Since making a function inline reduces -the flexibility of changing the program, don't do it unless it gives -a noticeable speedup in something slow enough that users care about -the speed. @xref{Inline Functions}. -@end itemize - -@node Documentation Tips -@section Tips for Documentation Strings - - Here are some tips for the writing of documentation strings. - -@itemize @bullet -@item -Every command, function, or variable intended for users to know about -should have a documentation string. - -@item -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. - -@item -The first line of the documentation string should consist of one or two -complete sentences that stand on their own as a summary. @kbd{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. - -The documentation string can have additional lines that expand on the -details of how to use the function or variable. The additional lines -should be made up of complete sentences also, but they may be filled if -that looks good. - -@item -For consistency, phrase the verb in the first sentence of a -documentation string 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. - -@item -Write documentation strings in the active voice, not the passive, and in -the present tense, not the future. For instance, use ``Return a list -containing A and B.'' instead of ``A list containing A and B will be -returned.'' - -@item -Avoid using the word ``cause'' (or its equivalents) unnecessarily. -Instead of, ``Cause Emacs to display text in boldface,'' write just -``Display text in boldface.'' - -@item -Do not start or end a documentation string with whitespace. - -@item -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. - -However, rather than simply filling the entire documentation string, you -can make it much more readable by choosing line breaks with care. -Use blank lines between topics if the documentation string is long. - -@item -@strong{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! - -@item -A variable's documentation string should start with @samp{*} if the -variable is one that users would often want to set interactively. If -the value is a long list, or a function, or if the variable would be set -only in init files, then don't start the documentation string with -@samp{*}. @xref{Defining Variables}. - -@item -The documentation string for a variable that is a yes-or-no flag should -start with words such as ``Non-nil means@dots{}'', to make it clear that -all non-@code{nil} values are equivalent and indicate explicitly what -@code{nil} and non-@code{nil} mean. - -@item -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 -@code{/} refers to its second argument as @samp{DIVISOR}, because the -actual argument name is @code{divisor}. - -Also use all caps for meta-syntactic variables, such as when you show -the decomposition of a list or vector into subunits, some of which may -vary. - -@item -@iftex -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: @samp{`lambda'}. There are two exceptions: -write @code{t} and @code{nil} without single-quotes. -@end iftex -@ifinfo -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: @samp{lambda}. There are two exceptions: write -t and nil without single-quotes. (In this manual, we normally do use -single-quotes for those symbols.) -@end ifinfo - -@item -Don't write key sequences directly in documentation strings. Instead, -use the @samp{\\[@dots{}]} construct to stand for them. For example, -instead of writing @samp{C-f}, write @samp{\\[forward-char]}. When -Emacs displays the documentation string, it substitutes whatever key is -currently bound to @code{forward-char}. (This is normally @samp{C-f}, -but it may be some other character if the user has moved key bindings.) -@xref{Keys in Documentation}. - -@item -In documentation strings for a major mode, you will want to refer to the -key bindings of that mode's local map, rather than global ones. -Therefore, use the construct @samp{\\<@dots{}>} once in the -documentation string to specify which key map to use. Do this before -the first use of @samp{\\[@dots{}]}. The text inside the -@samp{\\<@dots{}>} should be the name of the variable containing the -local keymap for the major mode. - -It is not practical to use @samp{\\[@dots{}]} 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 -@samp{\\@{@dots{}@}} to display the rest of the mode's keymap. -@end itemize - -@node Comment Tips -@section Tips on Writing Comments - - We recommend these conventions for where to put comments and how to -indent them: - -@table @samp -@item ; -Comments that start with a single semicolon, @samp{;}, should all be -aligned to the same column on the right of the source code. Such -comments usually explain how the code on the same line does its job. In -Lisp mode and related modes, the @kbd{M-;} (@code{indent-for-comment}) -command automatically inserts such a @samp{;} in the right place, or -aligns such a comment if it is already present. - -This and following examples are taken from the Emacs sources. - -@smallexample -@group -(setq base-version-list ; there was a base - (assoc (substring fn 0 start-vn) ; version to which - file-version-assoc-list)) ; this looks like - ; a subversion -@end group -@end smallexample - -@item ;; -Comments that start with two semicolons, @samp{;;}, should be aligned to -the same level of indentation as the code. Such comments usually -describe the purpose of the following lines or the state of the program -at that point. For example: - -@smallexample -@group -(prog1 (setq auto-fill-function - @dots{} - @dots{} - ;; update modeline - (redraw-modeline))) -@end group -@end smallexample - -Every function that has no documentation string (because it is use only -internally within the package it belongs to), should have instead a -two-semicolon comment right before the function, explaining what the -function does and how to call it properly. Explain precisely what each -argument means and how the function interprets its possible values. - -@item ;;; -Comments that start with three semicolons, @samp{;;;}, should start at -the left margin. Such comments are used outside function definitions to -make general statements explaining the design principles of the program. -For example: - -@smallexample -@group -;;; This Lisp code is run in XEmacs -;;; when it is to operate as a server -;;; for other processes. -@end group -@end smallexample - -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. - -@smallexample -(defun foo (a) -;;; This is no longer necessary. -;;; (force-mode-line-update) - (message "Finished with %s" a)) -@end smallexample - -@item ;;;; -Comments that start with four semicolons, @samp{;;;;}, should be aligned -to the left margin and are used for headings of major sections of a -program. For example: - -@smallexample -;;;; The kill ring -@end smallexample -@end table - -@noindent -The indentation commands of the Lisp modes in XEmacs, such as @kbd{M-;} -(@code{indent-for-comment}) and @key{TAB} (@code{lisp-indent-line}) -automatically indent comments according to these conventions, -depending on the number of semicolons. @xref{Comments,, -Manipulating Comments, emacs, The XEmacs Reference Manual}. - -@node Library Headers -@section Conventional Headers for XEmacs Libraries -@cindex header comments -@cindex library header comments - - XEmacs has conventions for using special comments in Lisp libraries -to divide them into sections and give information such as who wrote -them. This section explains these conventions. First, an example: - -@smallexample -@group -;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers - -;; Copyright (C) 1992 Free Software Foundation, Inc. -@end group - -;; Author: Eric S. Raymond -;; Maintainer: Eric S. Raymond -;; Created: 14 Jul 1992 -;; Version: 1.2 -@group -;; Keywords: docs - -;; This file is part of XEmacs. -@var{copying permissions}@dots{} -@end group -@end smallexample - - The very first line should have this format: - -@example -;;; @var{filename} --- @var{description} -@end example - -@noindent -The description should be complete in one line. - - After the copyright notice come several @dfn{header comment} lines, -each beginning with @samp{;; @var{header-name}:}. Here is a table of -the conventional possibilities for @var{header-name}: - -@table @samp -@item Author -This line states the name and net address of at least the principal -author of the library. - -If there are multiple authors, you can list them on continuation lines -led by @code{;;} and a tab character, like this: - -@smallexample -@group -;; Author: Ashwin Ram -;; Dave Sill -;; Dave Brennan -;; Eric Raymond -@end group -@end smallexample - -@item Maintainer -This line should contain a single name/address as in the Author line, or -an address only, or the string @samp{FSF}. If there is no maintainer -line, the person(s) in the Author field are presumed to be the -maintainers. The example above is mildly bogus because the maintainer -line is redundant. - -The idea behind the @samp{Author} and @samp{Maintainer} lines is to make -possible a Lisp function to ``send mail to the maintainer'' without -having to mine the name out by hand. - -Be sure to surround the network address with @samp{<@dots{}>} if -you include the person's full name as well as the network address. - -@item Created -This optional line gives the original creation date of the -file. For historical interest only. - -@item Version -If you wish to record version numbers for the individual Lisp program, put -them in this line. - -@item Adapted-By -In this header line, place the name of the person who adapted the -library for installation (to make it fit the style conventions, for -example). - -@item Keywords -This line lists keywords for the @code{finder-by-keyword} help command. -This field is important; it's how people will find your package when -they're looking for things by topic area. To separate the keywords, you -can use spaces, commas, or both. -@end table - - Just about every Lisp library ought to have the @samp{Author} and -@samp{Keywords} header comment lines. Use the others if they are -appropriate. You can also put in header lines with other header -names---they have no standard meanings, so they can't do any harm. - - We use additional stylized comments to subdivide the contents of the -library file. Here is a table of them: - -@table @samp -@item ;;; Commentary: -This begins introductory comments that explain how the library works. -It should come right after the copying permissions. - -@item ;;; Change log: -This begins change log information stored in the library file (if you -store the change history there). For most of the Lisp -files distributed with XEmacs, the change history is kept in the file -@file{ChangeLog} and not in the source file at all; these files do -not have a @samp{;;; Change log:} line. - -@item ;;; Code: -This begins the actual code of the program. - -@item ;;; @var{filename} ends here -This is the @dfn{footer line}; it appears at the very end of the file. -Its purpose is to enable people to detect truncated versions of the file -from the lack of a footer line. -@end table diff --git a/man/lispref/toolbar.texi b/man/lispref/toolbar.texi deleted file mode 100644 index 2341bec..0000000 --- a/man/lispref/toolbar.texi +++ /dev/null @@ -1,363 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1995, 1996 Ben Wing. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/toolbar.info -@node Toolbar, Scrollbars, Dialog Boxes, top -@chapter Toolbar -@cindex toolbar - -@menu -* Toolbar Intro:: An introduction. -* Toolbar Descriptor Format:: How to create a toolbar. -* Specifying the Toolbar:: Setting a toolbar's contents. -* Other Toolbar Variables:: Controlling the size of toolbars. -@end menu - -@node Toolbar Intro -@section Toolbar Intro - -A @dfn{toolbar} is a bar of icons displayed along one edge of a frame. -You can view a toolbar as a series of menu shortcuts -- the most -common menu options can be accessed with a single click rather than -a series of clicks and/or drags to select the option from a menu. -Consistent with this, a help string (called the @dfn{help-echo}) -describing what an icon in the toolbar (called a @dfn{toolbar button}) -does, is displayed in the minibuffer when the mouse is over the -button. - -In XEmacs, a toolbar can be displayed along any of the four edges -of the frame, and two or more different edges can be displaying -toolbars simultaneously. The contents, thickness, and visibility of -the toolbars can be controlled separately, and the values can -be per-buffer, per-frame, etc., using specifiers (@pxref{Specifiers}). - -Normally, there is one toolbar displayed in a frame. Usually, this is -the standard toolbar, but certain modes will override this and -substitute their own toolbar. In some cases (e.g. the VM package), a -package will supply its own toolbar along a different edge from the -standard toolbar, so that both can be visible at once. This standard -toolbar is usually positioned along the top of the frame, but this can -be changed using @code{set-default-toolbar-position}. - -Note that, for each of the toolbar properties (contents, thickness, -and visibility), there is a separate specifier for each of the four -toolbar positions (top, bottom, left, and right), and an additional -specifier for the ``default'' toolbar, i.e. the toolbar whose -position is controlled by @code{set-default-toolbar-position}. The -way this works is that @code{set-default-toolbar-position} arranges -things so that the appropriate position-specific specifiers for the -default position inherit from the corresponding default specifiers. -That way, if the position-specific specifier does not give a value -(which it usually doesn't), then the value from the default -specifier applies. If you want to control the default toolbar, you -just change the default specifiers, and everything works. A package -such as VM that wants to put its own toolbar in a different location -from the default just sets the position-specific specifiers, and if -the user sets the default toolbar to the same position, it will just -not be visible. - -@node Toolbar Descriptor Format -@section Toolbar Descriptor Format - -The contents of a toolbar are specified using a @dfn{toolbar descriptor}. -The format of a toolbar descriptor is a list of @dfn{toolbar button -descriptors}. Each toolbar button descriptor is a vector in one of the -following formats: - -@itemize @bullet -@item -@code{[@var{glyph-list} @var{function} @var{enabled-p} @var{help}]} -@item -@code{[:style @var{2d-or-3d}]} -@item -@code{[:style @var{2d-or-3d} :size @var{width-or-height}]} -@item -@code{[:size @var{width-or-height} :style @var{2d-or-3d}]} -@end itemize - -Optionally, one of the toolbar button descriptors may be @code{nil} -instead of a vector; this signifies the division between the toolbar -buttons that are to be displayed flush-left, and the buttons to be -displayed flush-right. - -The first vector format above specifies a normal toolbar button; -the others specify blank areas in the toolbar. - -For the first vector format: - -@itemize @bullet -@item -@var{glyph-list} should be a list of one to six glyphs (as created by -@code{make-glyph}) or a symbol whose value is such a list. The first -glyph, which must be provided, is the glyph used to display the toolbar -button when it is in the ``up'' (not pressed) state. The optional -second glyph is for displaying the button when it is in the ``down'' -(pressed) state. The optional third glyph is for when the button is -disabled. The last three glyphs are for displaying the button in the -``up'', ``down'', and ``disabled'' states, respectively, but are used -when the user has called for captioned toolbar buttons (using -@code{toolbar-buttons-captioned-p}). The function -@code{toolbar-make-button-list} is useful in creating these glyph lists. - -@item -Even if you do not provide separate down-state and disabled-state -glyphs, the user will still get visual feedback to indicate which -state the button is in. Buttons in the up-state are displayed -with a shadowed border that gives a raised appearance to the -button. Buttons in the down-state are displayed with shadows that -give a recessed appearance. Buttons in the disabled state are -displayed with no shadows, giving a 2-d effect. - -@item -If some of the toolbar glyphs are not provided, they inherit as follows: - -@example - UP: up - DOWN: down -> up - DISABLED: disabled -> up - CAP-UP: cap-up -> up - CAP-DOWN: cap-down -> cap-up -> down -> up - CAP-DISABLED: cap-disabled -> cap-up -> disabled -> up -@end example - -@item -The second element @var{function} is a function to be called when the -toolbar button is activated (i.e. when the mouse is released over the -toolbar button, if the press occurred in the toolbar). It can be any -form accepted by @code{call-interactively}, since this is how it is -invoked. - -@item -The third element @var{enabled-p} specifies whether the toolbar button -is enabled (disabled buttons do nothing when they are activated, and are -displayed differently; see above). It should be either a boolean or a -form that evaluates to a boolean. - -@item -The fourth element @var{help}, if non-@code{nil}, should be a string. -This string is displayed in the echo area when the mouse passes over the -toolbar button. -@end itemize - -For the other vector formats (specifying blank areas of the toolbar): - -@itemize @bullet -@item -@var{2d-or-3d} should be one of the symbols @code{2d} or @code{3d}, -indicating whether the area is displayed with shadows (giving it a -raised, 3-d appearance) or without shadows (giving it a flat -appearance). - -@item -@var{width-or-height} specifies the length, in pixels, of the blank -area. If omitted, it defaults to a device-specific value (8 pixels for -X devices). -@end itemize - -@defun toolbar-make-button-list up &optional down disabled cap-up cap-down cap-disabled -This function calls @code{make-glyph} on each arg and returns a list of -the results. This is useful for setting the first argument of a toolbar -button descriptor (typically, the result of this function is assigned -to a symbol, which is specified as the first argument of the toolbar -button descriptor). -@end defun - -@defun check-toolbar-button-syntax button &optional noerror -Verify the syntax of entry @var{button} in a toolbar description list. -If you want to verify the syntax of a toolbar description list as a -whole, use @code{check-valid-instantiator} with a specifier type of -@code{toolbar}. -@end defun - -@node Specifying the Toolbar -@section Specifying the Toolbar - -In order to specify the contents of a toolbar, set one of the specifier -variables @code{default-toolbar}, @code{top-toolbar}, -@code{bottom-toolbar}, @code{left-toolbar}, or @code{right-toolbar}. -These are specifiers, which means you set them with @code{set-specifier} -and query them with @code{specifier-specs} or @code{specifier-instance}. -You will get an error if you try to set them using @code{setq}. The -valid instantiators for these specifiers are toolbar descriptors, as -described above. @xref{Specifiers} for more information. - -Most of the time, you will set @code{default-toolbar}, which allows -the user to choose where the toolbar should go. - -@defvr Specifier default-toolbar -The position of this toolbar is specified in the function -@code{default-toolbar-position}. If the corresponding -position-specific toolbar (e.g. @code{top-toolbar} if -@code{default-toolbar-position} is @code{top}) does not specify a -toolbar in a particular domain, then the value of @code{default-toolbar} -in that domain, of any, will be used instead. -@end defvr - -Note that the toolbar at any particular position will not be displayed -unless its thickness (width or height, depending on orientation) is -non-zero and its visibility status is true. The thickness is controlled -by the specifiers @code{top-toolbar-height}, -@code{bottom-toolbar-height}, @code{left-toolbar-width}, and -@code{right-toolbar-width}, and the visibility status is controlled by -the specifiers @code{top-toolbar-visible-p}, -@code{bottom-toolbar-visible-p}, @code{left-toolbar-visible-p}, and -@code{right-toolbar-visible-p} (@pxref{Other Toolbar Variables}). - -@defun set-default-toolbar-position position -This function sets the position that the @code{default-toolbar} will be -displayed at. Valid positions are the symbols @code{top}, -@code{bottom}, @code{left} and @code{right}. What this actually does is -set the fallback specifier for the position-specific specifier -corresponding to the given position to @code{default-toolbar}, and set -the fallbacks for the other position-specific specifiers to @code{nil}. -It also does the same thing for the position-specific thickness and -visibility specifiers, which inherit from one of -@code{default-toolbar-height} or @code{default-toolbar-width}, and from -@code{default-toolbar-visible-p}, respectively (@pxref{Other Toolbar -Variables}). -@end defun - -@defun default-toolbar-position -This function returns the position that the @code{default-toolbar} will -be displayed at. -@end defun - -You can also explicitly set a toolbar at a particular position. When -redisplay determines what to display at a particular position in a -particular domain (i.e. window), it first consults the position-specific -toolbar. If that does not yield a toolbar descriptor, the -@code{default-toolbar} is consulted if @code{default-toolbar-position} -indicates this position. - -@defvr Specifier top-toolbar -Specifier for the toolbar at the top of the frame. -@end defvr - -@defvr Specifier bottom-toolbar -Specifier for the toolbar at the bottom of the frame. -@end defvr - -@defvr Specifier left-toolbar -Specifier for the toolbar at the left edge of the frame. -@end defvr - -@defvr Specifier right-toolbar -Specifier for the toolbar at the right edge of the frame. -@end defvr - -@defun toolbar-specifier-p object -This function returns non-nil if @var{object} is a toolbar specifier. -Toolbar specifiers are the actual objects contained in the toolbar -variables described above, and their valid instantiators are -toolbar descriptors (@pxref{Toolbar Descriptor Format}). -@end defun - -@node Other Toolbar Variables -@section Other Toolbar Variables - -The variables to control the toolbar thickness, visibility status, and -captioned status are all specifiers. @xref{Specifiers}. - -@defvr Specifier default-toolbar-height -This specifies the height of the default toolbar, if it's oriented -horizontally. The position of the default toolbar is specified by the -function @code{set-default-toolbar-position}. If the corresponding -position-specific toolbar thickness specifier -(e.g. @code{top-toolbar-height} if @code{default-toolbar-position} is -@code{top}) does not specify a thickness in a particular domain (a -window or a frame), then the value of @code{default-toolbar-height} or -@code{default-toolbar-width} (depending on the toolbar orientation) in -that domain, if any, will be used instead. -@end defvr - -@defvr Specifier default-toolbar-width -This specifies the width of the default toolbar, if it's oriented -vertically. This behaves like @code{default-toolbar-height}. -@end defvr - -Note that @code{default-toolbar-height} is only used when -@code{default-toolbar-position} is @code{top} or @code{bottom}, and -@code{default-toolbar-width} is only used when -@code{default-toolbar-position} is @code{left} or @code{right}. - -@defvr Specifier top-toolbar-height -This specifies the height of the top toolbar. -@end defvr - -@defvr Specifier bottom-toolbar-height -This specifies the height of the bottom toolbar. -@end defvr - -@defvr Specifier left-toolbar-width -This specifies the width of the left toolbar. -@end defvr - -@defvr Specifier right-toolbar-width -This specifies the width of the right toolbar. -@end defvr - -Note that all of the position-specific toolbar thickness specifiers -have a fallback value of zero when they do not correspond to the -default toolbar. Therefore, you will have to set a non-zero thickness -value if you want a position-specific toolbar to be displayed. - -@defvr Specifier default-toolbar-visible-p -This specifies whether the default toolbar is visible. The position of -the default toolbar is specified by the function -@code{set-default-toolbar-position}. If the corresponding position-specific -toolbar visibility specifier (e.g. @code{top-toolbar-visible-p} if -@code{default-toolbar-position} is @code{top}) does not specify a -visible-p value in a particular domain (a window or a frame), then the -value of @code{default-toolbar-visible-p} in that domain, if any, will -be used instead. -@end defvr - -@defvr Specifier top-toolbar-visible-p -This specifies whether the top toolbar is visible. -@end defvr - -@defvr Specifier bottom-toolbar-visible-p -This specifies whether the bottom toolbar is visible. -@end defvr - -@defvr Specifier left-toolbar-visible-p -This specifies whether the left toolbar is visible. -@end defvr - -@defvr Specifier right-toolbar-visible-p -This specifies whether the right toolbar is visible. -@end defvr - -@code{default-toolbar-visible-p} and all of the position-specific -toolbar visibility specifiers have a fallback value of true. - -Internally, toolbar thickness and visibility specifiers are instantiated -in both window and frame domains, for different purposes. The value in -the domain of a frame's selected window specifies the actual toolbar -thickness or visibility that you will see in that frame. The value in -the domain of a frame itself specifies the toolbar thickness or -visibility that is used in frame geometry calculations. - -Thus, for example, if you set the frame width to 80 characters and the -left toolbar width for that frame to 68 pixels, then the frame will be -sized to fit 80 characters plus a 68-pixel left toolbar. If you then -set the left toolbar width to 0 for a particular buffer (or if that -buffer does not specify a left toolbar or has a nil value specified for -@code{left-toolbar-visible-p}), you will find that, when that buffer is -displayed in the selected window, the window will have a width of 86 or -87 characters -- the frame is sized for a 68-pixel left toolbar but the -selected window specifies that the left toolbar is not visible, so it is -expanded to take up the slack. - -@defvr Specifier toolbar-buttons-captioned-p -Whether toolbar buttons are captioned. This affects which glyphs from a -toolbar button descriptor are chosen. @xref{Toolbar Descriptor Format}. -@end defvr - -You can also reset the toolbar to what it was when XEmacs started up. - -@defvr Constant initial-toolbar-spec -The toolbar descriptor used to initialize @code{default-toolbar} at -startup. -@end defvr diff --git a/man/lispref/tooltalk.texi b/man/lispref/tooltalk.texi deleted file mode 100644 index d309307..0000000 --- a/man/lispref/tooltalk.texi +++ /dev/null @@ -1,366 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/tooltalk.info -@node ToolTalk Support, LDAP Support, X-Windows, top -@chapter ToolTalk Support -@cindex ToolTalk - -@menu -* XEmacs ToolTalk API Summary:: -* Sending Messages:: -* Receiving Messages:: -@end menu - -@node XEmacs ToolTalk API Summary -@section XEmacs ToolTalk API Summary - -The XEmacs Lisp interface to ToolTalk is similar, at least in spirit, -to the standard C ToolTalk API. Only the message and pattern parts -of the API are supported at present; more of the API could be added -if needed. The Lisp interface departs from the C API in a few ways: - -@itemize @bullet -@item -ToolTalk is initialized automatically at XEmacs startup-time. Messages -can only be sent other ToolTalk applications connected to the same X11 -server that XEmacs is running on. - -@item -There are fewer entry points; polymorphic functions with keyword -arguments are used instead. - -@item -The callback interface is simpler and marginally less functional. -A single callback may be associated with a message or a pattern; -the callback is specified with a Lisp symbol (the symbol should -have a function binding). - -@item -The session attribute for messages and patterns is always -initialized to the default session. - -@item -Anywhere a ToolTalk enum constant, e.g. @samp{TT_SESSION}, is valid, one -can substitute the corresponding symbol, e.g. @code{'TT_SESSION}. This -simplifies building lists that represent messages and patterns. -@end itemize - -@node Sending Messages -@section Sending Messages -@cindex sending ToolTalk messages -@cindex ToolTalk message - -@menu -* Example of Sending Messages:: -* Elisp Interface for Sending Messages:: -@end menu - -@node Example of Sending Messages -@subsection Example of Sending Messages - -Here's a simple example that sends a query to another application -and then displays its reply. Both the query and the reply are -stored in the first argument of the message. - -@example -(defun tooltalk-random-query-handler (msg) - (let ((state (get-tooltalk-message-attribute msg 'state))) - (cond - ((eq state 'TT_HANDLED) - (message (get-tooltalk-message-attribute msg arg_val 0))) - ((memq state '(TT_FAILED TT_REJECTED)) - (message "Random query turns up nothing"))))) - -(defvar random-query-message - '( class TT_REQUEST - scope TT_SESSION - address TT_PROCEDURE - op "random-query" - args '((TT_INOUT "?" "string")) - callback tooltalk-random-query-handler)) - -(let ((m (make-tooltalk-message random-query-message))) - (send-tooltalk-message m)) -@end example - -@node Elisp Interface for Sending Messages -@subsection Elisp Interface for Sending Messages - -@defun make-tooltalk-message attributes -Create a ToolTalk message and initialize its attributes. -The value of @var{attributes} must be a list of alternating keyword/values, -where keywords are symbols that name valid message attributes. -For example: - -@example - (make-tooltalk-message - '(class TT_NOTICE - scope TT_SESSION - address TT_PROCEDURE - op "do-something" - args ("arg1" 12345 (TT_INOUT "arg3" "string")))) -@end example - -Values must always be strings, integers, or symbols that represent -ToolTalk constants. Attribute names are the same as those supported by -@code{set-tooltalk-message-attribute}, plus @code{args}. - -The value of @code{args} should be a list of message arguments where -each message argument has the following form: - -@quotation - @samp{(mode [value [type]])} or just @samp{value} -@end quotation - -Where @var{mode} is one of @code{TT_IN}, @code{TT_OUT}, or -@code{TT_INOUT} and @var{type} is a string. If @var{type} isn't -specified then @code{int} is used if @var{value} is a number; otherwise -@code{string} is used. If @var{type} is @code{string} then @var{value} -is converted to a string (if it isn't a string already) with -@code{prin1-to-string}. If only a value is specified then @var{mode} -defaults to @code{TT_IN}. If @var{mode} is @code{TT_OUT} then -@var{value} and @var{type} don't need to be specified. You can find out -more about the semantics and uses of ToolTalk message arguments in -chapter 4 of the @cite{ToolTalk Programmer's Guide}. -@refill -@end defun - -@defun send-tooltalk-message msg -Send the message on its way. Once the message has been sent it's almost -always a good idea to get rid of it with -@code{destroy-tooltalk-message}. -@refill -@end defun - -@defun return-tooltalk-message msg &optional mode -Send a reply to this message. The second argument can be @code{reply}, -@code{reject} or @code{fail}; the default is @code{reply}. Before -sending a reply, all message arguments whose mode is @code{TT_INOUT} or -@code{TT_OUT} should have been filled in -- see -@code{set-tooltalk-message-attribute}. -@refill -@end defun - -@defun get-tooltalk-message-attribute msg attribute &optional argn -Returns the indicated ToolTalk message attribute. Attributes are -identified by symbols with the same name (underscores and all) as the -suffix of the ToolTalk @samp{tt_message_} function that -extracts the value. String attribute values are copied and enumerated -type values (except disposition) are converted to symbols; -e.g. @samp{TT_HANDLER} is @code{'TT_HANDLER}, @samp{uid} and @samp{gid} -are represented by fixnums (small integers), @samp{opnum} is converted -to a string, and @samp{disposition} is converted to a fixnum. We -convert @samp{opnum} (a C int) to a string (e.g. @code{123} @result{} -@code{"123"}) because there's no guarantee that opnums will fit within -the range of XEmacs Lisp integers. -@refill - -[TBD] Use the @code{plist} attribute instead of C API @code{user} -attribute for user-defined message data. To retrieve the value of a -message property, specify the indicator for @var{argn}. For example, to -get the value of a property called @code{rflag}, use - -@example - (get-tooltalk-message-attribute msg 'plist 'rflag) -@end example - -To get the value of a message argument use one of the @code{arg_val} -(strings), @code{arg_ival} (integers), or @code{arg_bval} (strings with -embedded nulls), attributes. For example, to get the integer value of -the third argument: - -@example - (get-tooltalk-message-attribute msg 'arg_ival 2) -@end example - -As you can see, argument numbers are zero-based. The type of each -arguments can be retrieved with the @code{arg_type} attribute; however -ToolTalk doesn't define any semantics for the string value of -@code{arg_type}. Conventionally @code{string} is used for strings and -@code{int} for 32 bit integers. Note that XEmacs Lisp stores the lengths -of strings explicitly (unlike C) so treating the value returned by -@code{arg_bval} like a string is fine. -@refill -@end defun - -@defun set-tooltalk-message-attribute value msg attribute &optional argn -Initialize one ToolTalk message attribute. - -Attribute names and values are the same as for -@code{get-tooltalk-message-attribute}. A property list is provided for -user data (instead of the @code{user} message attribute); see -@code{get-tooltalk-message-attribute}. -@refill - -Callbacks are handled slightly differently than in the C ToolTalk API. -The value of @var{callback} should be the name of a function of one -argument. It will be called each time the state of the message changes. -This is usually used to notice when the message's state has changed to -@code{TT_HANDLED} (or @code{TT_FAILED}), so that reply argument values -can be used. -@refill - -If one of the argument attributes is specified as @code{arg_val}, -@code{arg_ival}, or @code{arg_bval}, then @var{argn} must be the -number of an already created argument. Arguments can be added to a -message with @code{add-tooltalk-message-arg}. -@refill -@end defun - -@defun add-tooltalk-message-arg msg mode type &optional value -Append one new argument to the message. @var{mode} must be one of -@code{TT_IN}, @code{TT_INOUT}, or @code{TT_OUT}, @var{type} must be a -string, and @var{value} can be a string or an integer. ToolTalk doesn't -define any semantics for @var{type}, so only the participants in the -protocol you're using need to agree what types mean (if anything). -Conventionally @code{string} is used for strings and @code{int} for 32 -bit integers. Arguments can initialized by providing a value or with -@code{set-tooltalk-message-attribute}; the latter is necessary if you -want to initialize the argument with a string that can contain embedded -nulls (use @code{arg_bval}). -@refill -@end defun - -@defun create-tooltalk-message -Create a new ToolTalk message. The message's session attribute is -initialized to the default session. Other attributes can be initialized -with @code{set-tooltalk-message-attribute}. -@code{make-tooltalk-message} is the preferred way to create and -initialize a message. -@refill -@end defun - -@defun destroy-tooltalk-message msg -Apply @samp{tt_message_destroy} to the message. It's not necessary to -destroy messages after they've been processed by a message or pattern -callback, the Lisp/ToolTalk callback machinery does this for you. -@end defun - -@node Receiving Messages -@section Receiving Messages -@cindex ToolTalk pattern -@cindex receiving ToolTalk messages - -@menu -* Example of Receiving Messages:: -* Elisp Interface for Receiving Messages:: -@end menu - -@node Example of Receiving Messages -@subsection Example of Receiving Messages - -Here's a simple example of a handler for a message that tells XEmacs to -display a string in the mini-buffer area. The message operation is -called @samp{emacs-display-string}. Its first (0th) argument is the -string to display. - -@example -(defun tooltalk-display-string-handler (msg) - (message (get-tooltalk-message-attribute msg 'arg_val 0))) - -(defvar display-string-pattern - '(category TT_HANDLE - scope TT_SESSION - op "emacs-display-string" - callback tooltalk-display-string-handler)) - -(let ((p (make-tooltalk-pattern display-string-pattern))) - (register-tooltalk-pattern p)) -@end example - -@node Elisp Interface for Receiving Messages -@subsection Elisp Interface for Receiving Messages - -@defun make-tooltalk-pattern attributes -Create a ToolTalk pattern and initialize its attributes. -The value of attributes must be a list of alternating keyword/values, -where keywords are symbols that name valid pattern attributes -or lists of valid attributes. For example: - -@example - (make-tooltalk-pattern - '(category TT_OBSERVE - scope TT_SESSION - op ("operation1" "operation2") - args ("arg1" 12345 (TT_INOUT "arg3" "string")))) -@end example - -Attribute names are the same as those supported by -@code{add-tooltalk-pattern-attribute}, plus @code{'args}. - -Values must always be strings, integers, or symbols that represent -ToolTalk constants or lists of same. When a list of values is provided -all of the list elements are added to the attribute. In the example -above, messages whose @samp{op} attribute is @samp{"operation1"} or -@samp{"operation2"} would match the pattern. - -The value of @var{args} should be a list of pattern arguments where each -pattern argument has the following form: - -@quotation - @samp{(mode [value [type]])} or just @samp{value} -@end quotation - -Where @var{mode} is one of @code{TT_IN}, @code{TT_OUT}, or -@code{TT_INOUT} and @var{type} is a string. If @var{type} isn't -specified then @code{int} is used if @var{value} is a number; otherwise -@code{string} is used. If @var{type} is @code{string} then @var{value} -is converted to a string (if it isn't a string already) with -@code{prin1-to-string}. If only a value is specified then @var{mode} -defaults to @code{TT_IN}. If @var{mode} is @code{TT_OUT} then -@var{value} and @var{type} don't need to be specified. You can find out -more about the semantics and uses of ToolTalk pattern arguments in -chapter 3 of the @cite{ToolTalk Programmer's Guide}. -@refill -@end defun - -@defun register-tooltalk-pattern pat -XEmacs will begin receiving messages that match this pattern. -@end defun - -@defun unregister-tooltalk-pattern pat -XEmacs will stop receiving messages that match this pattern. -@end defun - -@defun add-tooltalk-pattern-attribute value pat indicator -Add one value to the indicated pattern attribute. The names of -attributes are the same as the ToolTalk accessors used to set them less -the @samp{tooltalk_pattern_} prefix and the @samp{_add} suffix. For -example, the name of the attribute for the -@samp{tt_pattern_disposition_add} attribute is @code{disposition}. The -@code{category} attribute is handled specially, since a pattern can only -be a member of one category (@code{TT_OBSERVE} or @code{TT_HANDLE}). -@refill - -Callbacks are handled slightly differently than in the C ToolTalk API. -The value of @var{callback} should be the name of a function of one -argument. It will be called each time the pattern matches an incoming -message. -@end defun - -@defun add-tooltalk-pattern-arg pat mode type value -Add one fully-specified argument to a ToolTalk pattern. @var{mode} must -be one of @code{TT_IN}, @code{TT_INOUT}, or @code{TT_OUT}. @var{type} -must be a string. @var{value} can be an integer, string or @code{nil}. -If @var{value} is an integer then an integer argument -(@samp{tt_pattern_iarg_add}) is added; otherwise a string argument is -added. At present there's no way to add a binary data argument. -@refill -@end defun - -@defun create-tooltalk-pattern -Create a new ToolTalk pattern and initialize its session attribute to -be the default session. -@end defun - -@defun destroy-tooltalk-pattern pat -Apply @samp{tt_pattern_destroy} to the pattern. This effectively -unregisters the pattern. -@end defun - -@defun describe-tooltalk-message msg &optional stream -Print the message's attributes and arguments to @var{stream}. This is -often useful for debugging. -@end defun diff --git a/man/lispref/variables.texi b/man/lispref/variables.texi deleted file mode 100644 index d5d5ab5..0000000 --- a/man/lispref/variables.texi +++ /dev/null @@ -1,1348 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/variables.info -@node Variables, Functions, Control Structures, Top -@chapter Variables -@cindex variable - - A @dfn{variable} is a name used in a program to stand for a value. -Nearly all programming languages have variables of some sort. In the -text of a Lisp program, variables are written using the syntax for -symbols. - - In Lisp, unlike most programming languages, programs are represented -primarily as Lisp objects and only secondarily as text. The Lisp -objects used for variables are symbols: the symbol name is the variable -name, and the variable's value is stored in the value cell of the -symbol. The use of a symbol as a variable is independent of its use as -a function name. @xref{Symbol Components}. - - The Lisp objects that constitute a Lisp program determine the textual -form of the program---it is simply the read syntax for those Lisp -objects. This is why, for example, a variable in a textual Lisp program -is written using the read syntax for the symbol that represents the -variable. - -@menu -* Global Variables:: Variable values that exist permanently, everywhere. -* Constant Variables:: Certain "variables" have values that never change. -* Local Variables:: Variable values that exist only temporarily. -* Void Variables:: Symbols that lack values. -* Defining Variables:: A definition says a symbol is used as a variable. -* Accessing Variables:: Examining values of variables whose names - are known only at run time. -* Setting Variables:: Storing new values in variables. -* Variable Scoping:: How Lisp chooses among local and global values. -* Buffer-Local Variables:: Variable values in effect only in one buffer. -* Variable Aliases:: Making one variable point to another. -@end menu - -@node Global Variables -@section Global Variables -@cindex global variable - - The simplest way to use a variable is @dfn{globally}. This means that -the variable has just one value at a time, and this value is in effect -(at least for the moment) throughout the Lisp system. The value remains -in effect until you specify a new one. When a new value replaces the -old one, no trace of the old value remains in the variable. - - You specify a value for a symbol with @code{setq}. For example, - -@example -(setq x '(a b)) -@end example - -@noindent -gives the variable @code{x} the value @code{(a b)}. Note that -@code{setq} does not evaluate its first argument, the name of the -variable, but it does evaluate the second argument, the new value. - - Once the variable has a value, you can refer to it by using the symbol -by itself as an expression. Thus, - -@example -@group -x @result{} (a b) -@end group -@end example - -@noindent -assuming the @code{setq} form shown above has already been executed. - - If you do another @code{setq}, the new value replaces the old one: - -@example -@group -x - @result{} (a b) -@end group -@group -(setq x 4) - @result{} 4 -@end group -@group -x - @result{} 4 -@end group -@end example - -@node Constant Variables -@section Variables That Never Change -@vindex nil -@vindex t -@kindex setting-constant - -In XEmacs Lisp, some symbols always evaluate to themselves: the two -special symbols @code{nil} and @code{t}, as well as @dfn{keyword -symbols}, that is, symbols whose name begins with the character -@samp{@code{:}}. These symbols cannot be rebound, nor can their value -cells be changed. An attempt to change the value of @code{nil} or -@code{t} signals a @code{setting-constant} error. - -@example -@group -nil @equiv{} 'nil - @result{} nil -@end group -@group -(setq nil 500) -@error{} Attempt to set constant symbol: nil -@end group -@end example - -@node Local Variables -@section Local Variables -@cindex binding local variables -@cindex local variables -@cindex local binding -@cindex global binding - - Global variables have values that last until explicitly superseded -with new values. Sometimes it is useful to create variable values that -exist temporarily---only while within a certain part of the program. -These values are called @dfn{local}, and the variables so used are -called @dfn{local variables}. - - For example, when a function is called, its argument variables receive -new local values that last until the function exits. The @code{let} -special form explicitly establishes new local values for specified -variables; these last until exit from the @code{let} form. - -@cindex shadowing of variables - Establishing a local value saves away the previous value (or lack of -one) of the variable. When the life span of the local value is over, -the previous value is restored. In the mean time, we say that the -previous value is @dfn{shadowed} and @dfn{not visible}. Both global and -local values may be shadowed (@pxref{Scope}). - - If you set a variable (such as with @code{setq}) while it is local, -this replaces the local value; it does not alter the global value, or -previous local values that are shadowed. To model this behavior, we -speak of a @dfn{local binding} of the variable as well as a local value. - - The local binding is a conceptual place that holds a local value. -Entry to a function, or a special form such as @code{let}, creates the -local binding; exit from the function or from the @code{let} removes the -local binding. As long as the local binding lasts, the variable's value -is stored within it. Use of @code{setq} or @code{set} while there is a -local binding stores a different value into the local binding; it does -not create a new binding. - - We also speak of the @dfn{global binding}, which is where -(conceptually) the global value is kept. - -@cindex current binding - A variable can have more than one local binding at a time (for -example, if there are nested @code{let} forms that bind it). In such a -case, the most recently created local binding that still exists is the -@dfn{current binding} of the variable. (This is called @dfn{dynamic -scoping}; see @ref{Variable Scoping}.) If there are no local bindings, -the variable's global binding is its current binding. We also call the -current binding the @dfn{most-local existing binding}, for emphasis. -Ordinary evaluation of a symbol always returns the value of its current -binding. - - The special forms @code{let} and @code{let*} exist to create -local bindings. - -@defspec let (bindings@dots{}) forms@dots{} -This special form binds variables according to @var{bindings} and then -evaluates all of the @var{forms} in textual order. The @code{let}-form -returns the value of the last form in @var{forms}. - -Each of the @var{bindings} is either @w{(i) a} symbol, in which case -that symbol is bound to @code{nil}; or @w{(ii) a} list of the form -@code{(@var{symbol} @var{value-form})}, in which case @var{symbol} is -bound to the result of evaluating @var{value-form}. If @var{value-form} -is omitted, @code{nil} is used. - -All of the @var{value-form}s in @var{bindings} are evaluated in the -order they appear and @emph{before} any of the symbols are bound. Here -is an example of this: @code{Z} is bound to the old value of @code{Y}, -which is 2, not the new value, 1. - -@example -@group -(setq Y 2) - @result{} 2 -@end group -@group -(let ((Y 1) - (Z Y)) - (list Y Z)) - @result{} (1 2) -@end group -@end example -@end defspec - -@defspec let* (bindings@dots{}) forms@dots{} -This special form is like @code{let}, but it binds each variable right -after computing its local value, before computing the local value for -the next variable. Therefore, an expression in @var{bindings} can -reasonably refer to the preceding symbols bound in this @code{let*} -form. Compare the following example with the example above for -@code{let}. - -@example -@group -(setq Y 2) - @result{} 2 -@end group -@group -(let* ((Y 1) - (Z Y)) ; @r{Use the just-established value of @code{Y}.} - (list Y Z)) - @result{} (1 1) -@end group -@end example -@end defspec - - Here is a complete list of the other facilities that create local -bindings: - -@itemize @bullet -@item -Function calls (@pxref{Functions}). - -@item -Macro calls (@pxref{Macros}). - -@item -@code{condition-case} (@pxref{Errors}). -@end itemize - - Variables can also have buffer-local bindings (@pxref{Buffer-Local -Variables}). These kinds of bindings work somewhat like ordinary local -bindings, but they are localized depending on ``where'' you are in -Emacs, rather than localized in time. - -@defvar max-specpdl-size -@cindex variable limit error -@cindex evaluation error -@cindex infinite recursion - This variable defines the limit on the total number of local variable -bindings and @code{unwind-protect} cleanups (@pxref{Nonlocal Exits}) -that are allowed before signaling an error (with data @code{"Variable -binding depth exceeds max-specpdl-size"}). - - This limit, with the associated error when it is exceeded, is one way -that Lisp avoids infinite recursion on an ill-defined function. - - The default value is 600. - - @code{max-lisp-eval-depth} provides another limit on depth of nesting. -@xref{Eval}. -@end defvar - -@node Void Variables -@section When a Variable is ``Void'' -@kindex void-variable -@cindex void variable - - If you have never given a symbol any value as a global variable, we -say that that symbol's global value is @dfn{void}. In other words, the -symbol's value cell does not have any Lisp object in it. If you try to -evaluate the symbol, you get a @code{void-variable} error rather than -a value. - - Note that a value of @code{nil} is not the same as void. The symbol -@code{nil} is a Lisp object and can be the value of a variable just as any -other object can be; but it is @emph{a value}. A void variable does not -have any value. - - After you have given a variable a value, you can make it void once more -using @code{makunbound}. - -@defun makunbound symbol -This function makes the current binding of @var{symbol} void. -Subsequent attempts to use this symbol's value as a variable will signal -the error @code{void-variable}, unless or until you set it again. - -@code{makunbound} returns @var{symbol}. - -@example -@group -(makunbound 'x) ; @r{Make the global value} - ; @r{of @code{x} void.} - @result{} x -@end group -@group -x -@error{} Symbol's value as variable is void: x -@end group -@end example - -If @var{symbol} is locally bound, @code{makunbound} affects the most -local existing binding. This is the only way a symbol can have a void -local binding, since all the constructs that create local bindings -create them with values. In this case, the voidness lasts at most as -long as the binding does; when the binding is removed due to exit from -the construct that made it, the previous or global binding is reexposed -as usual, and the variable is no longer void unless the newly reexposed -binding was void all along. - -@smallexample -@group -(setq x 1) ; @r{Put a value in the global binding.} - @result{} 1 -(let ((x 2)) ; @r{Locally bind it.} - (makunbound 'x) ; @r{Void the local binding.} - x) -@error{} Symbol's value as variable is void: x -@end group -@group -x ; @r{The global binding is unchanged.} - @result{} 1 - -(let ((x 2)) ; @r{Locally bind it.} - (let ((x 3)) ; @r{And again.} - (makunbound 'x) ; @r{Void the innermost-local binding.} - x)) ; @r{And refer: it's void.} -@error{} Symbol's value as variable is void: x -@end group - -@group -(let ((x 2)) - (let ((x 3)) - (makunbound 'x)) ; @r{Void inner binding, then remove it.} - x) ; @r{Now outer @code{let} binding is visible.} - @result{} 2 -@end group -@end smallexample -@end defun - - A variable that has been made void with @code{makunbound} is -indistinguishable from one that has never received a value and has -always been void. - - You can use the function @code{boundp} to test whether a variable is -currently void. - -@defun boundp variable -@code{boundp} returns @code{t} if @var{variable} (a symbol) is not void; -more precisely, if its current binding is not void. It returns -@code{nil} otherwise. - -@smallexample -@group -(boundp 'abracadabra) ; @r{Starts out void.} - @result{} nil -@end group -@group -(let ((abracadabra 5)) ; @r{Locally bind it.} - (boundp 'abracadabra)) - @result{} t -@end group -@group -(boundp 'abracadabra) ; @r{Still globally void.} - @result{} nil -@end group -@group -(setq abracadabra 5) ; @r{Make it globally nonvoid.} - @result{} 5 -@end group -@group -(boundp 'abracadabra) - @result{} t -@end group -@end smallexample -@end defun - -@node Defining Variables -@section Defining Global Variables -@cindex variable definition - - You may announce your intention to use a symbol as a global variable -with a @dfn{variable definition}: a special form, either @code{defconst} -or @code{defvar}. - - In XEmacs Lisp, definitions serve three purposes. First, they inform -people who read the code that certain symbols are @emph{intended} to be -used a certain way (as variables). Second, they inform the Lisp system -of these things, supplying a value and documentation. Third, they -provide information to utilities such as @code{etags} and -@code{make-docfile}, which create data bases of the functions and -variables in a program. - - The difference between @code{defconst} and @code{defvar} is primarily -a matter of intent, serving to inform human readers of whether programs -will change the variable. XEmacs Lisp does not restrict the ways in -which a variable can be used based on @code{defconst} or @code{defvar} -declarations. However, it does make a difference for initialization: -@code{defconst} unconditionally initializes the variable, while -@code{defvar} initializes it only if it is void. - - One would expect user option variables to be defined with -@code{defconst}, since programs do not change them. Unfortunately, this -has bad results if the definition is in a library that is not preloaded: -@code{defconst} would override any prior value when the library is -loaded. Users would like to be able to set user options in their init -files, and override the default values given in the definitions. For -this reason, user options must be defined with @code{defvar}. - -@defspec defvar symbol [value [doc-string]] -This special form defines @var{symbol} as a value and initializes it. -The definition informs a person reading your code that @var{symbol} is -used as a variable that programs are likely to set or change. It is -also used for all user option variables except in the preloaded parts of -XEmacs. Note that @var{symbol} is not evaluated; the symbol to be -defined must appear explicitly in the @code{defvar}. - -If @var{symbol} already has a value (i.e., it is not void), @var{value} -is not even evaluated, and @var{symbol}'s value remains unchanged. If -@var{symbol} is void and @var{value} is specified, @code{defvar} -evaluates it and sets @var{symbol} to the result. (If @var{value} is -omitted, the value of @var{symbol} is not changed in any case.) - -When you evaluate a top-level @code{defvar} form with @kbd{C-M-x} in -Emacs Lisp mode (@code{eval-defun}), a special feature of -@code{eval-defun} evaluates it as a @code{defconst}. The purpose of -this is to make sure the variable's value is reinitialized, when you ask -for it specifically. - -If @var{symbol} has a buffer-local binding in the current buffer, -@code{defvar} sets the default value, not the local value. -@xref{Buffer-Local Variables}. - -If the @var{doc-string} argument appears, it specifies the documentation -for the variable. (This opportunity to specify documentation is one of -the main benefits of defining the variable.) The documentation is -stored in the symbol's @code{variable-documentation} property. The -XEmacs help functions (@pxref{Documentation}) look for this property. - -If the first character of @var{doc-string} is @samp{*}, it means that -this variable is considered a user option. This lets users set the -variable conveniently using the commands @code{set-variable} and -@code{edit-options}. - -For example, this form defines @code{foo} but does not set its value: - -@example -@group -(defvar foo) - @result{} foo -@end group -@end example - -The following example sets the value of @code{bar} to @code{23}, and -gives it a documentation string: - -@example -@group -(defvar bar 23 - "The normal weight of a bar.") - @result{} bar -@end group -@end example - -The following form changes the documentation string for @code{bar}, -making it a user option, but does not change the value, since @code{bar} -already has a value. (The addition @code{(1+ 23)} is not even -performed.) - -@example -@group -(defvar bar (1+ 23) - "*The normal weight of a bar.") - @result{} bar -@end group -@group -bar - @result{} 23 -@end group -@end example - -Here is an equivalent expression for the @code{defvar} special form: - -@example -@group -(defvar @var{symbol} @var{value} @var{doc-string}) -@equiv{} -(progn - (if (not (boundp '@var{symbol})) - (setq @var{symbol} @var{value})) - (put '@var{symbol} 'variable-documentation '@var{doc-string}) - '@var{symbol}) -@end group -@end example - -The @code{defvar} form returns @var{symbol}, but it is normally used -at top level in a file where its value does not matter. -@end defspec - -@defspec defconst symbol [value [doc-string]] -This special form defines @var{symbol} as a value and initializes it. -It informs a person reading your code that @var{symbol} has a global -value, established here, that will not normally be changed or locally -bound by the execution of the program. The user, however, may be -welcome to change it. Note that @var{symbol} is not evaluated; the -symbol to be defined must appear explicitly in the @code{defconst}. - -@code{defconst} always evaluates @var{value} and sets the global value -of @var{symbol} to the result, provided @var{value} is given. If -@var{symbol} has a buffer-local binding in the current buffer, -@code{defconst} sets the default value, not the local value. - -@strong{Please note:} Don't use @code{defconst} for user option -variables in libraries that are not standardly preloaded. The user -should be able to specify a value for such a variable in the -@file{.emacs} file, so that it will be in effect if and when the library -is loaded later. - -Here, @code{pi} is a constant that presumably ought not to be changed -by anyone (attempts by the Indiana State Legislature notwithstanding). -As the second form illustrates, however, this is only advisory. - -@example -@group -(defconst pi 3.1415 "Pi to five places.") - @result{} pi -@end group -@group -(setq pi 3) - @result{} pi -@end group -@group -pi - @result{} 3 -@end group -@end example -@end defspec - -@defun user-variable-p variable -@cindex user option -This function returns @code{t} if @var{variable} is a user option---a -variable intended to be set by the user for customization---and -@code{nil} otherwise. (Variables other than user options exist for the -internal purposes of Lisp programs, and users need not know about them.) - -User option variables are distinguished from other variables by the -first character of the @code{variable-documentation} property. If the -property exists and is a string, and its first character is @samp{*}, -then the variable is a user option. -@end defun - - If a user option variable has a @code{variable-interactive} property, -the @code{set-variable} command uses that value to control reading the -new value for the variable. The property's value is used as if it were -the argument to @code{interactive}. - - @strong{Warning:} If the @code{defconst} and @code{defvar} special -forms are used while the variable has a local binding, they set the -local binding's value; the global binding is not changed. This is not -what we really want. To prevent it, use these special forms at top -level in a file, where normally no local binding is in effect, and make -sure to load the file before making a local binding for the variable. - -@node Accessing Variables -@section Accessing Variable Values - - The usual way to reference a variable is to write the symbol which -names it (@pxref{Symbol Forms}). This requires you to specify the -variable name when you write the program. Usually that is exactly what -you want to do. Occasionally you need to choose at run time which -variable to reference; then you can use @code{symbol-value}. - -@defun symbol-value symbol -This function returns the value of @var{symbol}. This is the value in -the innermost local binding of the symbol, or its global value if it -has no local bindings. - -@example -@group -(setq abracadabra 5) - @result{} 5 -@end group -@group -(setq foo 9) - @result{} 9 -@end group - -@group -;; @r{Here the symbol @code{abracadabra}} -;; @r{is the symbol whose value is examined.} -(let ((abracadabra 'foo)) - (symbol-value 'abracadabra)) - @result{} foo -@end group - -@group -;; @r{Here the value of @code{abracadabra},} -;; @r{which is @code{foo},} -;; @r{is the symbol whose value is examined.} -(let ((abracadabra 'foo)) - (symbol-value abracadabra)) - @result{} 9 -@end group - -@group -(symbol-value 'abracadabra) - @result{} 5 -@end group -@end example - -A @code{void-variable} error is signaled if @var{symbol} has neither a -local binding nor a global value. -@end defun - -@node Setting Variables -@section How to Alter a Variable Value - - The usual way to change the value of a variable is with the special -form @code{setq}. When you need to compute the choice of variable at -run time, use the function @code{set}. - -@defspec setq [symbol form]@dots{} -This special form is the most common method of changing a variable's -value. Each @var{symbol} is given a new value, which is the result of -evaluating the corresponding @var{form}. The most-local existing -binding of the symbol is changed. - -@code{setq} does not evaluate @var{symbol}; it sets the symbol that you -write. We say that this argument is @dfn{automatically quoted}. The -@samp{q} in @code{setq} stands for ``quoted.'' - -The value of the @code{setq} form is the value of the last @var{form}. - -@example -@group -(setq x (1+ 2)) - @result{} 3 -@end group -x ; @r{@code{x} now has a global value.} - @result{} 3 -@group -(let ((x 5)) - (setq x 6) ; @r{The local binding of @code{x} is set.} - x) - @result{} 6 -@end group -x ; @r{The global value is unchanged.} - @result{} 3 -@end example - -Note that the first @var{form} is evaluated, then the first -@var{symbol} is set, then the second @var{form} is evaluated, then the -second @var{symbol} is set, and so on: - -@example -@group -(setq x 10 ; @r{Notice that @code{x} is set before} - y (1+ x)) ; @r{the value of @code{y} is computed.} - @result{} 11 -@end group -@end example -@end defspec - -@defun set symbol value -This function sets @var{symbol}'s value to @var{value}, then returns -@var{value}. Since @code{set} is a function, the expression written for -@var{symbol} is evaluated to obtain the symbol to set. - -The most-local existing binding of the variable is the binding that is -set; shadowed bindings are not affected. - -@example -@group -(set one 1) -@error{} Symbol's value as variable is void: one -@end group -@group -(set 'one 1) - @result{} 1 -@end group -@group -(set 'two 'one) - @result{} one -@end group -@group -(set two 2) ; @r{@code{two} evaluates to symbol @code{one}.} - @result{} 2 -@end group -@group -one ; @r{So it is @code{one} that was set.} - @result{} 2 -(let ((one 1)) ; @r{This binding of @code{one} is set,} - (set 'one 3) ; @r{not the global value.} - one) - @result{} 3 -@end group -@group -one - @result{} 2 -@end group -@end example - -If @var{symbol} is not actually a symbol, a @code{wrong-type-argument} -error is signaled. - -@example -(set '(x y) 'z) -@error{} Wrong type argument: symbolp, (x y) -@end example - -Logically speaking, @code{set} is a more fundamental primitive than -@code{setq}. Any use of @code{setq} can be trivially rewritten to use -@code{set}; @code{setq} could even be defined as a macro, given the -availability of @code{set}. However, @code{set} itself is rarely used; -beginners hardly need to know about it. It is useful only for choosing -at run time which variable to set. For example, the command -@code{set-variable}, which reads a variable name from the user and then -sets the variable, needs to use @code{set}. - -@cindex CL note---@code{set} local -@quotation -@b{Common Lisp note:} In Common Lisp, @code{set} always changes the -symbol's special value, ignoring any lexical bindings. In XEmacs Lisp, -all variables and all bindings are (in effect) special, so @code{set} -always affects the most local existing binding. -@end quotation -@end defun - - One other function for setting a variable is designed to add -an element to a list if it is not already present in the list. - -@defun add-to-list symbol element -This function sets the variable @var{symbol} by consing @var{element} -onto the old value, if @var{element} is not already a member of that -value. It returns the resulting list, whether updated or not. The -value of @var{symbol} had better be a list already before the call. - -The argument @var{symbol} is not implicitly quoted; @code{add-to-list} -is an ordinary function, like @code{set} and unlike @code{setq}. Quote -the argument yourself if that is what you want. - -Here's a scenario showing how to use @code{add-to-list}: - -@example -(setq foo '(a b)) - @result{} (a b) - -(add-to-list 'foo 'c) ;; @r{Add @code{c}.} - @result{} (c a b) - -(add-to-list 'foo 'b) ;; @r{No effect.} - @result{} (c a b) - -foo ;; @r{@code{foo} was changed.} - @result{} (c a b) -@end example -@end defun - - An equivalent expression for @code{(add-to-list '@var{var} -@var{value})} is this: - -@example -(or (member @var{value} @var{var}) - (setq @var{var} (cons @var{value} @var{var}))) -@end example - -@node Variable Scoping -@section Scoping Rules for Variable Bindings - - A given symbol @code{foo} may have several local variable bindings, -established at different places in the Lisp program, as well as a global -binding. The most recently established binding takes precedence over -the others. - -@cindex scope -@cindex extent -@cindex dynamic scoping - Local bindings in XEmacs Lisp have @dfn{indefinite scope} and -@dfn{dynamic extent}. @dfn{Scope} refers to @emph{where} textually in -the source code the binding can be accessed. Indefinite scope means -that any part of the program can potentially access the variable -binding. @dfn{Extent} refers to @emph{when}, as the program is -executing, the binding exists. Dynamic extent means that the binding -lasts as long as the activation of the construct that established it. - - The combination of dynamic extent and indefinite scope is called -@dfn{dynamic scoping}. By contrast, most programming languages use -@dfn{lexical scoping}, in which references to a local variable must be -located textually within the function or block that binds the variable. - -@cindex CL note---special variables -@quotation -@b{Common Lisp note:} Variables declared ``special'' in Common Lisp -are dynamically scoped, like variables in XEmacs Lisp. -@end quotation - -@menu -* Scope:: Scope means where in the program a value is visible. - Comparison with other languages. -* Extent:: Extent means how long in time a value exists. -* Impl of Scope:: Two ways to implement dynamic scoping. -* Using Scoping:: How to use dynamic scoping carefully and avoid problems. -@end menu - -@node Scope -@subsection Scope - - XEmacs Lisp uses @dfn{indefinite scope} for local variable bindings. -This means that any function anywhere in the program text might access a -given binding of a variable. Consider the following function -definitions: - -@example -@group -(defun binder (x) ; @r{@code{x} is bound in @code{binder}.} - (foo 5)) ; @r{@code{foo} is some other function.} -@end group - -@group -(defun user () ; @r{@code{x} is used in @code{user}.} - (list x)) -@end group -@end example - - In a lexically scoped language, the binding of @code{x} in -@code{binder} would never be accessible in @code{user}, because -@code{user} is not textually contained within the function -@code{binder}. However, in dynamically scoped XEmacs Lisp, @code{user} -may or may not refer to the binding of @code{x} established in -@code{binder}, depending on circumstances: - -@itemize @bullet -@item -If we call @code{user} directly without calling @code{binder} at all, -then whatever binding of @code{x} is found, it cannot come from -@code{binder}. - -@item -If we define @code{foo} as follows and call @code{binder}, then the -binding made in @code{binder} will be seen in @code{user}: - -@example -@group -(defun foo (lose) - (user)) -@end group -@end example - -@item -If we define @code{foo} as follows and call @code{binder}, then the -binding made in @code{binder} @emph{will not} be seen in @code{user}: - -@example -(defun foo (x) - (user)) -@end example - -@noindent -Here, when @code{foo} is called by @code{binder}, it binds @code{x}. -(The binding in @code{foo} is said to @dfn{shadow} the one made in -@code{binder}.) Therefore, @code{user} will access the @code{x} bound -by @code{foo} instead of the one bound by @code{binder}. -@end itemize - -@node Extent -@subsection Extent - - @dfn{Extent} refers to the time during program execution that a -variable name is valid. In XEmacs Lisp, a variable is valid only while -the form that bound it is executing. This is called @dfn{dynamic -extent}. ``Local'' or ``automatic'' variables in most languages, -including C and Pascal, have dynamic extent. - - One alternative to dynamic extent is @dfn{indefinite extent}. This -means that a variable binding can live on past the exit from the form -that made the binding. Common Lisp and Scheme, for example, support -this, but XEmacs Lisp does not. - - To illustrate this, the function below, @code{make-add}, returns a -function that purports to add @var{n} to its own argument @var{m}. -This would work in Common Lisp, but it does not work as intended in -XEmacs Lisp, because after the call to @code{make-add} exits, the -variable @code{n} is no longer bound to the actual argument 2. - -@example -(defun make-add (n) - (function (lambda (m) (+ n m)))) ; @r{Return a function.} - @result{} make-add -(fset 'add2 (make-add 2)) ; @r{Define function @code{add2}} - ; @r{with @code{(make-add 2)}.} - @result{} (lambda (m) (+ n m)) -(add2 4) ; @r{Try to add 2 to 4.} -@error{} Symbol's value as variable is void: n -@end example - -@cindex closures not available - Some Lisp dialects have ``closures'', objects that are like functions -but record additional variable bindings. XEmacs Lisp does not have -closures. - -@node Impl of Scope -@subsection Implementation of Dynamic Scoping -@cindex deep binding - - A simple sample implementation (which is not how XEmacs Lisp actually -works) may help you understand dynamic binding. This technique is -called @dfn{deep binding} and was used in early Lisp systems. - - Suppose there is a stack of bindings: variable-value pairs. At entry -to a function or to a @code{let} form, we can push bindings on the stack -for the arguments or local variables created there. We can pop those -bindings from the stack at exit from the binding construct. - - We can find the value of a variable by searching the stack from top to -bottom for a binding for that variable; the value from that binding is -the value of the variable. To set the variable, we search for the -current binding, then store the new value into that binding. - - As you can see, a function's bindings remain in effect as long as it -continues execution, even during its calls to other functions. That is -why we say the extent of the binding is dynamic. And any other function -can refer to the bindings, if it uses the same variables while the -bindings are in effect. That is why we say the scope is indefinite. - -@cindex shallow binding - The actual implementation of variable scoping in XEmacs Lisp uses a -technique called @dfn{shallow binding}. Each variable has a standard -place in which its current value is always found---the value cell of the -symbol. - - In shallow binding, setting the variable works by storing a value in -the value cell. Creating a new binding works by pushing the old value -(belonging to a previous binding) on a stack, and storing the local value -in the value cell. Eliminating a binding works by popping the old value -off the stack, into the value cell. - - We use shallow binding because it has the same results as deep -binding, but runs faster, since there is never a need to search for a -binding. - -@node Using Scoping -@subsection Proper Use of Dynamic Scoping - - Binding a variable in one function and using it in another is a -powerful technique, but if used without restraint, it can make programs -hard to understand. There are two clean ways to use this technique: - -@itemize @bullet -@item -Use or bind the variable only in a few related functions, written close -together in one file. Such a variable is used for communication within -one program. - -You should write comments to inform other programmers that they can see -all uses of the variable before them, and to advise them not to add uses -elsewhere. - -@item -Give the variable a well-defined, documented meaning, and make all -appropriate functions refer to it (but not bind it or set it) wherever -that meaning is relevant. For example, the variable -@code{case-fold-search} is defined as ``non-@code{nil} means ignore case -when searching''; various search and replace functions refer to it -directly or through their subroutines, but do not bind or set it. - -Then you can bind the variable in other programs, knowing reliably what -the effect will be. -@end itemize - - In either case, you should define the variable with @code{defvar}. -This helps other people understand your program by telling them to look -for inter-function usage. It also avoids a warning from the byte -compiler. Choose the variable's name to avoid name conflicts---don't -use short names like @code{x}. - -@node Buffer-Local Variables -@section Buffer-Local Variables -@cindex variables, buffer-local -@cindex buffer-local variables - - Global and local variable bindings are found in most programming -languages in one form or another. XEmacs also supports another, unusual -kind of variable binding: @dfn{buffer-local} bindings, which apply only -to one buffer. XEmacs Lisp is meant for programming editing commands, -and having different values for a variable in different buffers is an -important customization method. - -@menu -* Intro to Buffer-Local:: Introduction and concepts. -* Creating Buffer-Local:: Creating and destroying buffer-local bindings. -* Default Value:: The default value is seen in buffers - that don't have their own local values. -@end menu - -@node Intro to Buffer-Local -@subsection Introduction to Buffer-Local Variables - - A buffer-local variable has a buffer-local binding associated with a -particular buffer. The binding is in effect when that buffer is -current; otherwise, it is not in effect. If you set the variable while -a buffer-local binding is in effect, the new value goes in that binding, -so the global binding is unchanged; this means that the change is -visible in that buffer alone. - - A variable may have buffer-local bindings in some buffers but not in -others. The global binding is shared by all the buffers that don't have -their own bindings. Thus, if you set the variable in a buffer that does -not have a buffer-local binding for it, the new value is visible in all -buffers except those with buffer-local bindings. (Here we are assuming -that there are no @code{let}-style local bindings to complicate the issue.) - - The most common use of buffer-local bindings is for major modes to change -variables that control the behavior of commands. For example, C mode and -Lisp mode both set the variable @code{paragraph-start} to specify that only -blank lines separate paragraphs. They do this by making the variable -buffer-local in the buffer that is being put into C mode or Lisp mode, and -then setting it to the new value for that mode. - - The usual way to make a buffer-local binding is with -@code{make-local-variable}, which is what major mode commands use. This -affects just the current buffer; all other buffers (including those yet to -be created) continue to share the global value. - -@cindex automatically buffer-local - A more powerful operation is to mark the variable as -@dfn{automatically buffer-local} by calling -@code{make-variable-buffer-local}. You can think of this as making the -variable local in all buffers, even those yet to be created. More -precisely, the effect is that setting the variable automatically makes -the variable local to the current buffer if it is not already so. All -buffers start out by sharing the global value of the variable as usual, -but any @code{setq} creates a buffer-local binding for the current -buffer. The new value is stored in the buffer-local binding, leaving -the (default) global binding untouched. The global value can no longer -be changed with @code{setq}; you need to use @code{setq-default} to do -that. - -@ignore -Section about not changing buffers during let bindings. Mly fixed -this for XEmacs. -@end ignore - Local variables in a file you edit are also represented by -buffer-local bindings for the buffer that holds the file within XEmacs. -@xref{Auto Major Mode}. - -@node Creating Buffer-Local -@subsection Creating and Deleting Buffer-Local Bindings - -@deffn Command make-local-variable variable -This function creates a buffer-local binding in the current buffer for -@var{variable} (a symbol). Other buffers are not affected. The value -returned is @var{variable}. - -@c Emacs 19 feature -The buffer-local value of @var{variable} starts out as the same value -@var{variable} previously had. If @var{variable} was void, it remains -void. - -@example -@group -;; @r{In buffer @samp{b1}:} -(setq foo 5) ; @r{Affects all buffers.} - @result{} 5 -@end group -@group -(make-local-variable 'foo) ; @r{Now it is local in @samp{b1}.} - @result{} foo -@end group -@group -foo ; @r{That did not change} - @result{} 5 ; @r{the value.} -@end group -@group -(setq foo 6) ; @r{Change the value} - @result{} 6 ; @r{in @samp{b1}.} -@end group -@group -foo - @result{} 6 -@end group - -@group -;; @r{In buffer @samp{b2}, the value hasn't changed.} -(save-excursion - (set-buffer "b2") - foo) - @result{} 5 -@end group -@end example - -Making a variable buffer-local within a @code{let}-binding for that -variable does not work. This is because @code{let} does not distinguish -between different kinds of bindings; it knows only which variable the -binding was made for. - -@strong{Please note:} do not use @code{make-local-variable} for a hook -variable. Instead, use @code{make-local-hook}. @xref{Hooks}. -@end deffn - -@deffn Command make-variable-buffer-local variable -This function marks @var{variable} (a symbol) automatically -buffer-local, so that any subsequent attempt to set it will make it -local to the current buffer at the time. - -The value returned is @var{variable}. -@end deffn - -@defun local-variable-p variable &optional buffer -This returns @code{t} if @var{variable} is buffer-local in buffer -@var{buffer} (which defaults to the current buffer); otherwise, -@code{nil}. -@end defun - -@defun buffer-local-variables &optional buffer -This function returns a list describing the buffer-local variables in -buffer @var{buffer}. It returns an association list (@pxref{Association -Lists}) in which each association contains one buffer-local variable and -its value. When a buffer-local variable is void in @var{buffer}, then -it appears directly in the resulting list. If @var{buffer} is omitted, -the current buffer is used. - -@example -@group -(make-local-variable 'foobar) -(makunbound 'foobar) -(make-local-variable 'bind-me) -(setq bind-me 69) -@end group -(setq lcl (buffer-local-variables)) - ;; @r{First, built-in variables local in all buffers:} -@result{} ((mark-active . nil) - (buffer-undo-list nil) - (mode-name . "Fundamental") - @dots{} -@group - ;; @r{Next, non-built-in local variables.} - ;; @r{This one is local and void:} - foobar - ;; @r{This one is local and nonvoid:} - (bind-me . 69)) -@end group -@end example - -Note that storing new values into the @sc{cdr}s of cons cells in this -list does @emph{not} change the local values of the variables. -@end defun - -@deffn Command kill-local-variable variable -This function deletes the buffer-local binding (if any) for -@var{variable} (a symbol) in the current buffer. As a result, the -global (default) binding of @var{variable} becomes visible in this -buffer. Usually this results in a change in the value of -@var{variable}, since the global value is usually different from the -buffer-local value just eliminated. - -If you kill the local binding of a variable that automatically becomes -local when set, this makes the global value visible in the current -buffer. However, if you set the variable again, that will once again -create a local binding for it. - -@code{kill-local-variable} returns @var{variable}. - -This function is a command because it is sometimes useful to kill one -buffer-local variable interactively, just as it is useful to create -buffer-local variables interactively. -@end deffn - -@defun kill-all-local-variables -This function eliminates all the buffer-local variable bindings of the -current buffer except for variables marked as ``permanent''. As a -result, the buffer will see the default values of most variables. - -This function also resets certain other information pertaining to the -buffer: it sets the local keymap to @code{nil}, the syntax table to the -value of @code{standard-syntax-table}, and the abbrev table to the value -of @code{fundamental-mode-abbrev-table}. - -Every major mode command begins by calling this function, which has the -effect of switching to Fundamental mode and erasing most of the effects -of the previous major mode. To ensure that this does its job, the -variables that major modes set should not be marked permanent. - -@code{kill-all-local-variables} returns @code{nil}. -@end defun - -@c Emacs 19 feature -@cindex permanent local variable -A local variable is @dfn{permanent} if the variable name (a symbol) has a -@code{permanent-local} property that is non-@code{nil}. Permanent -locals are appropriate for data pertaining to where the file came from -or how to save it, rather than with how to edit the contents. - -@node Default Value -@subsection The Default Value of a Buffer-Local Variable -@cindex default value - - The global value of a variable with buffer-local bindings is also -called the @dfn{default} value, because it is the value that is in -effect except when specifically overridden. - - The functions @code{default-value} and @code{setq-default} access and -change a variable's default value regardless of whether the current -buffer has a buffer-local binding. For example, you could use -@code{setq-default} to change the default setting of -@code{paragraph-start} for most buffers; and this would work even when -you are in a C or Lisp mode buffer that has a buffer-local value for -this variable. - -@c Emacs 19 feature - The special forms @code{defvar} and @code{defconst} also set the -default value (if they set the variable at all), rather than any local -value. - -@defun default-value symbol -This function returns @var{symbol}'s default value. This is the value -that is seen in buffers that do not have their own values for this -variable. If @var{symbol} is not buffer-local, this is equivalent to -@code{symbol-value} (@pxref{Accessing Variables}). -@end defun - -@c Emacs 19 feature -@defun default-boundp symbol -The function @code{default-boundp} tells you whether @var{symbol}'s -default value is nonvoid. If @code{(default-boundp 'foo)} returns -@code{nil}, then @code{(default-value 'foo)} would get an error. - -@code{default-boundp} is to @code{default-value} as @code{boundp} is to -@code{symbol-value}. -@end defun - -@defspec setq-default symbol value -This sets the default value of @var{symbol} to @var{value}. It does not -evaluate @var{symbol}, but does evaluate @var{value}. The value of the -@code{setq-default} form is @var{value}. - -If a @var{symbol} is not buffer-local for the current buffer, and is not -marked automatically buffer-local, @code{setq-default} has the same -effect as @code{setq}. If @var{symbol} is buffer-local for the current -buffer, then this changes the value that other buffers will see (as long -as they don't have a buffer-local value), but not the value that the -current buffer sees. - -@example -@group -;; @r{In buffer @samp{foo}:} -(make-local-variable 'local) - @result{} local -@end group -@group -(setq local 'value-in-foo) - @result{} value-in-foo -@end group -@group -(setq-default local 'new-default) - @result{} new-default -@end group -@group -local - @result{} value-in-foo -@end group -@group -(default-value 'local) - @result{} new-default -@end group - -@group -;; @r{In (the new) buffer @samp{bar}:} -local - @result{} new-default -@end group -@group -(default-value 'local) - @result{} new-default -@end group -@group -(setq local 'another-default) - @result{} another-default -@end group -@group -(default-value 'local) - @result{} another-default -@end group - -@group -;; @r{Back in buffer @samp{foo}:} -local - @result{} value-in-foo -(default-value 'local) - @result{} another-default -@end group -@end example -@end defspec - -@defun set-default symbol value -This function is like @code{setq-default}, except that @var{symbol} is -evaluated. - -@example -@group -(set-default (car '(a b c)) 23) - @result{} 23 -@end group -@group -(default-value 'a) - @result{} 23 -@end group -@end example -@end defun - -@node Variable Aliases -@section Variable Aliases -@cindex variables, indirect -@cindex indirect variables -@cindex variable aliases -@cindex aliases, for variables - -You can define a variable as an @dfn{alias} for another. Any time -you reference the former variable, the current value of the latter -is returned. Any time you change the value of the former variable, -the value of the latter is actually changed. This is useful in -cases where you want to rename a variable but still make old code -work (@pxref{Obsoleteness}). - -@defun defvaralias variable alias -This function defines @var{variable} as an alias for @var{alias}. -Thenceforth, any operations performed on @var{variable} will actually be -performed on @var{alias}. Both @var{variable} and @var{alias} should be -symbols. If @var{alias} is @code{nil}, remove any aliases for -@var{variable}. @var{alias} can itself be aliased, and the chain of -variable aliases will be followed appropriately. If @var{variable} -already has a value, this value will be shadowed until the alias is -removed, at which point it will be restored. Currently @var{variable} -cannot be a built-in variable, a variable that has a buffer-local value -in any buffer, or the symbols @code{nil} or @code{t}. -@end defun - -@defun variable-alias variable -If @var{variable} is aliased to another variable, this function returns -that variable. @var{variable} should be a symbol. If @var{variable} is -not aliased, this function returns @code{nil}. -@end defun - -@defun indirect-variable object -This function returns the variable at the end of @var{object}'s -variable-alias chain. If @var{object} is a symbol, follow all variable -aliases and return the final (non-aliased) symbol. If @var{object} is -not a symbol, just return it. Signal a -@code{cyclic-variable-indirection} error if there is a loop in the -variable chain of symbols. -@end defun - - diff --git a/man/lispref/windows.texi b/man/lispref/windows.texi deleted file mode 100644 index 45ca496..0000000 --- a/man/lispref/windows.texi +++ /dev/null @@ -1,1881 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/windows.info -@node Windows, Frames, Buffers, Top -@chapter Windows - - This chapter describes most of the functions and variables related to -Emacs windows. See @ref{Display}, for information on how text is -displayed in windows. - -@menu -* Basic Windows:: Basic information on using windows. -* Splitting Windows:: Splitting one window into two windows. -* Deleting Windows:: Deleting a window gives its space to other windows. -* Selecting Windows:: The selected window is the one that you edit in. -* Cyclic Window Ordering:: Moving around the existing windows. -* Buffers and Windows:: Each window displays the contents of a buffer. -* Displaying Buffers:: Higher-lever functions for displaying a buffer - and choosing a window for it. -* Choosing Window:: How to choose a window for displaying a buffer. -* Window Point:: Each window has its own location of point. -* Window Start:: The display-start position controls which text - is on-screen in the window. -* Vertical Scrolling:: Moving text up and down in the window. -* Horizontal Scrolling:: Moving text sideways on the window. -* Size of Window:: Accessing the size of a window. -* Position of Window:: Accessing the position of a window. -* Resizing Windows:: Changing the size of a window. -* Window Configurations:: Saving and restoring the state of the screen. -@end menu - -@node Basic Windows -@section Basic Concepts of Emacs Windows -@cindex window -@cindex selected window - - A @dfn{window} in XEmacs is the physical area of the screen in which a -buffer is displayed. The term is also used to refer to a Lisp object that -represents that screen area in XEmacs Lisp. It should be -clear from the context which is meant. - - XEmacs groups windows into frames. A frame represents an area of -screen available for XEmacs to use. Each frame always contains at least -one window, but you can subdivide it vertically or horizontally into -multiple nonoverlapping Emacs windows. - - In each frame, at any time, one and only one window is designated as -@dfn{selected within the frame}. The frame's cursor appears in that -window. At ant time, one frame is the selected frame; and the window -selected within that frame is @dfn{the selected window}. The selected -window's buffer is usually the current buffer (except when -@code{set-buffer} has been used). @xref{Current Buffer}. - - For practical purposes, a window exists only while it is displayed in -a frame. Once removed from the frame, the window is effectively deleted -and should not be used, @emph{even though there may still be references -to it} from other Lisp objects. Restoring a saved window configuration -is the only way for a window no longer on the screen to come back to -life. (@xref{Deleting Windows}.) - - Each window has the following attributes: - -@itemize @bullet -@item -containing frame - -@item -window height - -@item -window width - -@item -window edges with respect to the frame or screen - -@item -the buffer it displays - -@item -position within the buffer at the upper left of the window - -@item -amount of horizontal scrolling, in columns - -@item -point - -@item -the mark - -@item -how recently the window was selected -@end itemize - -@cindex multiple windows - Users create multiple windows so they can look at several buffers at -once. Lisp libraries use multiple windows for a variety of reasons, but -most often to display related information. In Rmail, for example, you -can move through a summary buffer in one window while the other window -shows messages one at a time as they are reached. - - The meaning of ``window'' in XEmacs is similar to what it means in the -context of general-purpose window systems such as X, but not identical. -The X Window System places X windows on the screen; XEmacs uses one or -more X windows as frames, and subdivides them into -Emacs windows. When you use XEmacs on a character-only terminal, XEmacs -treats the whole terminal screen as one frame. - -@cindex terminal frame -@cindex frame of terminal -@cindex tiled windows - Most window systems support arbitrarily located overlapping windows. -In contrast, Emacs windows are @dfn{tiled}; they never overlap, and -together they fill the whole screen or frame. Because of the way -in which XEmacs creates new windows and resizes them, you can't create -every conceivable tiling of windows on an Emacs frame. @xref{Splitting -Windows}, and @ref{Size of Window}. - - @xref{Display}, for information on how the contents of the -window's buffer are displayed in the window. - -@defun windowp object - This function returns @code{t} if @var{object} is a window. -@end defun - -@node Splitting Windows -@section Splitting Windows -@cindex splitting windows -@cindex window splitting - - The functions described here are the primitives used to split a window -into two windows. Two higher level functions sometimes split a window, -but not always: @code{pop-to-buffer} and @code{display-buffer} -(@pxref{Displaying Buffers}). - - The functions described here do not accept a buffer as an argument. -The two ``halves'' of the split window initially display the same buffer -previously visible in the window that was split. - -@defun one-window-p &optional no-mini all-frames -This function returns non-@code{nil} if there is only one window. The -argument @var{no-mini}, if non-@code{nil}, means don't count the -minibuffer even if it is active; otherwise, the minibuffer window is -included, if active, in the total number of windows which is compared -against one. - - The argument @var{all-frame} controls which set of windows are -counted. -@itemize @bullet -@item -If it is @code{nil} or omitted, then count only the selected frame, plus -the minibuffer it uses (which may be on another frame). -@item -If it is @code{t}, then windows on all frames that currently exist -(including invisible and iconified frames) are counted. -@item -If it is the symbol @code{visible}, then windows on all visible frames -are counted. -@item -If it is the number 0, then windows on all visible and iconified frames -are counted. -@item -If it is any other value, then precisely the windows in @var{window}'s -frame are counted, excluding the minibuffer in use if it lies in -some other frame. -@end itemize -@end defun - -@deffn Command split-window &optional window size horizontal -This function splits @var{window} into two windows. The original -window @var{window} remains the selected window, but occupies only -part of its former screen area. The rest is occupied by a newly created -window which is returned as the value of this function. - - If @var{horizontal} is non-@code{nil}, then @var{window} splits into -two side by side windows. The original window @var{window} keeps the -leftmost @var{size} columns, and gives the rest of the columns to the -new window. Otherwise, it splits into windows one above the other, and -@var{window} keeps the upper @var{size} lines and gives the rest of the -lines to the new window. The original window is therefore the -left-hand or upper of the two, and the new window is the right-hand or -lower. - - If @var{window} is omitted or @code{nil}, then the selected window is -split. If @var{size} is omitted or @code{nil}, then @var{window} is -divided evenly into two parts. (If there is an odd line, it is -allocated to the new window.) When @code{split-window} is called -interactively, all its arguments are @code{nil}. - - The following example starts with one window on a frame that is 50 -lines high by 80 columns wide; then the window is split. - -@smallexample -@group -(setq w (selected-window)) - @result{} # -(window-edges) ; @r{Edges in order:} - @result{} (0 0 80 50) ; @r{left--top--right--bottom} -@end group - -@group -;; @r{Returns window created} -(setq w2 (split-window w 15)) - @result{} # -@end group -@group -(window-edges w2) - @result{} (0 15 80 50) ; @r{Bottom window;} - ; @r{top is line 15} -@end group -@group -(window-edges w) - @result{} (0 0 80 15) ; @r{Top window} -@end group -@end smallexample - -The frame looks like this: - -@smallexample -@group - __________ - | | line 0 - | w | - |__________| - | | line 15 - | w2 | - |__________| - line 50 - column 0 column 80 -@end group -@end smallexample - -Next, the top window is split horizontally: - -@smallexample -@group -(setq w3 (split-window w 35 t)) - @result{} # -@end group -@group -(window-edges w3) - @result{} (35 0 80 15) ; @r{Left edge at column 35} -@end group -@group -(window-edges w) - @result{} (0 0 35 15) ; @r{Right edge at column 35} -@end group -@group -(window-edges w2) - @result{} (0 15 80 50) ; @r{Bottom window unchanged} -@end group -@end smallexample - -@need 3000 -Now, the screen looks like this: - -@smallexample -@group - column 35 - __________ - | | | line 0 - | w | w3 | - |___|______| - | | line 15 - | w2 | - |__________| - line 50 - column 0 column 80 -@end group -@end smallexample - -Normally, Emacs indicates the border between two side-by-side windows -with a scroll bar (@pxref{X Frame Properties,Scroll Bars}) or @samp{|} -characters. The display table can specify alternative border -characters; see @ref{Display Tables}. -@end deffn - -@deffn Command split-window-vertically &optional size -This function splits the selected window into two windows, one above -the other, leaving the selected window with @var{size} lines. - -This function is simply an interface to @code{split-windows}. -Here is the complete function definition for it: - -@smallexample -@group -(defun split-window-vertically (&optional arg) - "Split current window into two windows, one above the other." - (interactive "P") - (split-window nil (and arg (prefix-numeric-value arg)))) -@end group -@end smallexample -@end deffn - -@deffn Command split-window-horizontally &optional size -This function splits the selected window into two windows -side-by-side, leaving the selected window with @var{size} columns. - -This function is simply an interface to @code{split-windows}. Here is -the complete definition for @code{split-window-horizontally} (except for -part of the documentation string): - -@smallexample -@group -(defun split-window-horizontally (&optional arg) - "Split selected window into two windows, side by side..." - (interactive "P") - (split-window nil (and arg (prefix-numeric-value arg)) t)) -@end group -@end smallexample -@end deffn - -@defun one-window-p &optional no-mini all-frames -This function returns non-@code{nil} if there is only one window. The -argument @var{no-mini}, if non-@code{nil}, means don't count the -minibuffer even if it is active; otherwise, the minibuffer window is -included, if active, in the total number of windows, which is compared -against one. - -The argument @var{all-frames} specifies which frames to consider. Here -are the possible values and their meanings: - -@table @asis -@item @code{nil} -Count the windows in the selected frame, plus the minibuffer used -by that frame even if it lies in some other frame. - -@item @code{t} -Count all windows in all existing frames. - -@item @code{visible} -Count all windows in all visible frames. - -@item 0 -Count all windows in all visible or iconified frames. - -@item anything else -Count precisely the windows in the selected frame, and no others. -@end table -@end defun - -@node Deleting Windows -@section Deleting Windows -@cindex deleting windows - -A window remains visible on its frame unless you @dfn{delete} it by -calling certain functions that delete windows. A deleted window cannot -appear on the screen, but continues to exist as a Lisp object until -there are no references to it. There is no way to cancel the deletion -of a window aside from restoring a saved window configuration -(@pxref{Window Configurations}). Restoring a window configuration also -deletes any windows that aren't part of that configuration. - - When you delete a window, the space it took up is given to one -adjacent sibling. (In Emacs version 18, the space was divided evenly -among all the siblings.) - -@c Emacs 19 feature -@defun window-live-p window -This function returns @code{nil} if @var{window} is deleted, and -@code{t} otherwise. - -@strong{Warning:} Erroneous information or fatal errors may result from -using a deleted window as if it were live. -@end defun - -@deffn Command delete-window &optional window -This function removes @var{window} from the display. If @var{window} -is omitted, then the selected window is deleted. An error is signaled -if there is only one window when @code{delete-window} is called. - -This function returns @code{nil}. - -When @code{delete-window} is called interactively, @var{window} -defaults to the selected window. -@end deffn - -@deffn Command delete-other-windows &optional window -This function makes @var{window} the only window on its frame, by -deleting the other windows in that frame. If @var{window} is omitted or -@code{nil}, then the selected window is used by default. - -The result is @code{nil}. -@end deffn - -@deffn Command delete-windows-on buffer &optional frame -This function deletes all windows showing @var{buffer}. If there are -no windows showing @var{buffer}, it does nothing. - -@code{delete-windows-on} operates frame by frame. If a frame has -several windows showing different buffers, then those showing -@var{buffer} are removed, and the others expand to fill the space. If -all windows in some frame are showing @var{buffer} (including the case -where there is only one window), then the frame reverts to having a -single window showing another buffer chosen with @code{other-buffer}. -@xref{The Buffer List}. - -The argument @var{frame} controls which frames to operate on: - -@itemize @bullet -@item -If it is @code{nil}, operate on the selected frame. -@item -If it is @code{t}, operate on all frames. -@item -If it is @code{visible}, operate on all visible frames. -@item 0 -If it is 0, operate on all visible or iconified frames. -@item -If it is a frame, operate on that frame. -@end itemize - -This function always returns @code{nil}. -@end deffn - -@node Selecting Windows -@section Selecting Windows -@cindex selecting windows - - When a window is selected, the buffer in the window becomes the current -buffer, and the cursor will appear in it. - -@defun selected-window &optional device -This function returns the selected window. This is the window in -which the cursor appears and to which many commands apply. Each -separate device can have its own selected window, which is remembered -as focus changes from device to device. Optional argument @var{device} -specifies which device to return the selected window for, and defaults -to the selected device. -@end defun - -@defun select-window window &optional norecord -This function makes @var{window} the selected window. The cursor then -appears in @var{window} (on redisplay). The buffer being displayed in -@var{window} is immediately designated the current buffer. - -If optional argument @var{norecord} is non-@code{nil} then the global -and per-frame buffer orderings are not modified, as by the function -@code{record-buffer}. - -The return value is @var{window}. - -@example -@group -(setq w (next-window)) -(select-window w) - @result{} # -@end group -@end example -@end defun - -@defmac save-selected-window forms@dots{} -This macro records the selected window, executes @var{forms} -in sequence, then restores the earlier selected window. -It does not save or restore anything about the sizes, arrangement -or contents of windows; therefore, if the @var{forms} change them, -the changes are permanent. -@end defmac - -@cindex finding windows - The following functions choose one of the windows on the screen, -offering various criteria for the choice. - -@defun get-lru-window &optional frame -This function returns the window least recently ``used'' (that is, -selected). The selected window is always the most recently used window. - -The selected window can be the least recently used window if it is the -only window. A newly created window becomes the least recently used -window until it is selected. A minibuffer window is never a candidate. - -The argument @var{frame} controls which windows are considered. - -@itemize @bullet -@item -If it is @code{nil}, consider windows on the selected frame. -@item -If it is @code{t}, consider windows on all frames. -@item -If it is @code{visible}, consider windows on all visible frames. -@item -If it is 0, consider windows on all visible or iconified frames. -@item -If it is a frame, consider windows on that frame. -@end itemize -@end defun - -@defun get-largest-window &optional frame -This function returns the window with the largest area (height times -width). If there are no side-by-side windows, then this is the window -with the most lines. A minibuffer window is never a candidate. - -If there are two windows of the same size, then the function returns -the window that is first in the cyclic ordering of windows (see -following section), starting from the selected window. - -The argument @var{frame} controls which set of windows are -considered. See @code{get-lru-window}, above. -@end defun - -@node Cyclic Window Ordering -@section Cyclic Ordering of Windows -@cindex cyclic ordering of windows -@cindex ordering of windows, cyclic -@cindex window ordering, cyclic - - When you use the command @kbd{C-x o} (@code{other-window}) to select -the next window, it moves through all the windows on the screen in a -specific cyclic order. For any given configuration of windows, this -order never varies. It is called the @dfn{cyclic ordering of windows}. - - This ordering generally goes from top to bottom, and from left to -right. But it may go down first or go right first, depending on the -order in which the windows were split. - - If the first split was vertical (into windows one above each other), -and then the subwindows were split horizontally, then the ordering is -left to right in the top of the frame, and then left to right in the -next lower part of the frame, and so on. If the first split was -horizontal, the ordering is top to bottom in the left part, and so on. -In general, within each set of siblings at any level in the window tree, -the order is left to right, or top to bottom. - -@defun next-window &optional window minibuf all-frames -@cindex minibuffer window -This function returns the window following @var{window} in the cyclic -ordering of windows. This is the window that @kbd{C-x o} would select -if typed when @var{window} is selected. If @var{window} is the only -window visible, then this function returns @var{window}. If omitted, -@var{window} defaults to the selected window. - -The value of the argument @var{minibuf} determines whether the -minibuffer is included in the window order. Normally, when -@var{minibuf} is @code{nil}, the minibuffer is included if it is -currently active; this is the behavior of @kbd{C-x o}. (The minibuffer -window is active while the minibuffer is in use. @xref{Minibuffers}.) - -If @var{minibuf} is @code{t}, then the cyclic ordering includes the -minibuffer window even if it is not active. - -If @var{minibuf} is neither @code{t} nor @code{nil}, then the minibuffer -window is not included even if it is active. - -The argument @var{all-frames} specifies which frames to consider. Here -are the possible values and their meanings: - -@table @asis -@item @code{nil} -Consider all the windows in @var{window}'s frame, plus the minibuffer -used by that frame even if it lies in some other frame. - -@item @code{t} -Consider all windows in all existing frames. - -@item @code{visible} -Consider all windows in all visible frames. (To get useful results, you -must ensure @var{window} is in a visible frame.) - -@item 0 -Consider all windows in all visible or iconified frames. - -@item anything else -Consider precisely the windows in @var{window}'s frame, and no others. -@end table - -This example assumes there are two windows, both displaying the -buffer @samp{windows.texi}: - -@example -@group -(selected-window) - @result{} # -@end group -@group -(next-window (selected-window)) - @result{} # -@end group -@group -(next-window (next-window (selected-window))) - @result{} # -@end group -@end example -@end defun - -@defun previous-window &optional window minibuf all-frames -This function returns the window preceding @var{window} in the cyclic -ordering of windows. The other arguments specify which windows to -include in the cycle, as in @code{next-window}. -@end defun - -@deffn Command other-window count &optional frame -This function selects the @var{count}th following window in the cyclic -order. If count is negative, then it selects the @minus{}@var{count}th -preceding window. It returns @code{nil}. - -In an interactive call, @var{count} is the numeric prefix argument. - -The argument @var{frame} controls which set of windows are considered. -@itemize @bullet -@item -If it is @code{nil} or omitted, then windows on the selected frame are -considered. -@item -If it is a frame, then windows on that frame are considered. -@item -If it is @code{t}, then windows on all frames that currently exist -(including invisible and iconified frames) are considered. -@item -If it is the symbol @code{visible}, then windows on all visible frames -are considered. -@item -If it is the number 0, then windows on all visible and iconified frames -are considered. -@item -If it is any other value, then the behavior is undefined. -@end itemize -@end deffn - -@c Emacs 19 feature -@defun walk-windows proc &optional minibuf all-frames -This function cycles through all windows, calling @code{proc} -once for each window with the window as its sole argument. - -The optional arguments @var{minibuf} and @var{all-frames} specify the -set of windows to include in the scan. See @code{next-window}, above, -for details. -@end defun - -@node Buffers and Windows -@section Buffers and Windows -@cindex examining windows -@cindex windows, controlling precisely -@cindex buffers, controlled in windows - - This section describes low-level functions to examine windows or to -display buffers in windows in a precisely controlled fashion. -@iftex -See the following section for -@end iftex -@ifinfo -@xref{Displaying Buffers}, for -@end ifinfo -related functions that find a window to use and specify a buffer for it. -The functions described there are easier to use than these, but they -employ heuristics in choosing or creating a window; use these functions -when you need complete control. - -@defun set-window-buffer window buffer-or-name -This function makes @var{window} display @var{buffer-or-name} as its -contents. It returns @code{nil}. - -@example -@group -(set-window-buffer (selected-window) "foo") - @result{} nil -@end group -@end example -@end defun - -@defun window-buffer &optional window -This function returns the buffer that @var{window} is displaying. If -@var{window} is omitted, this function returns the buffer for the -selected window. - -@example -@group -(window-buffer) - @result{} # -@end group -@end example -@end defun - -@defun get-buffer-window buffer-or-name &optional frame -This function returns a window currently displaying -@var{buffer-or-name}, or @code{nil} if there is none. If there are -several such windows, then the function returns the first one in the -cyclic ordering of windows, starting from the selected window. -@xref{Cyclic Window Ordering}. - -The argument @var{all-frames} controls which windows to consider. - -@itemize @bullet -@item -If it is @code{nil}, consider windows on the selected frame. -@item -If it is @code{t}, consider windows on all frames. -@item -If it is @code{visible}, consider windows on all visible frames. -@item -If it is 0, consider windows on all visible or iconified frames. -@item -If it is a frame, consider windows on that frame. -@end itemize -@end defun - -@node Displaying Buffers -@section Displaying Buffers in Windows -@cindex switching to a buffer -@cindex displaying a buffer - - In this section we describe convenient functions that choose a window -automatically and use it to display a specified buffer. These functions -can also split an existing window in certain circumstances. We also -describe variables that parameterize the heuristics used for choosing a -window. -@iftex -See the preceding section for -@end iftex -@ifinfo -@xref{Buffers and Windows}, for -@end ifinfo -low-level functions that give you more precise control. - - Do not use the functions in this section in order to make a buffer -current so that a Lisp program can access or modify it; they are too -drastic for that purpose, since they change the display of buffers in -windows, which is gratuitous and will surprise the user. Instead, use -@code{set-buffer} (@pxref{Current Buffer}) and @code{save-excursion} -(@pxref{Excursions}), which designate buffers as current for programmed -access without affecting the display of buffers in windows. - -@deffn Command switch-to-buffer buffer-or-name &optional norecord -This function makes @var{buffer-or-name} the current buffer, and also -displays the buffer in the selected window. This means that a human can -see the buffer and subsequent keyboard commands will apply to it. -Contrast this with @code{set-buffer}, which makes @var{buffer-or-name} -the current buffer but does not display it in the selected window. -@xref{Current Buffer}. - -If @var{buffer-or-name} does not identify an existing buffer, then a new -buffer by that name is created. The major mode for the new buffer is -set according to the variable @code{default-major-mode}. @xref{Auto -Major Mode}. - -Normally the specified buffer is put at the front of the buffer list. -This affects the operation of @code{other-buffer}. However, if -@var{norecord} is non-@code{nil}, this is not done. @xref{The Buffer -List}. - -The @code{switch-to-buffer} function is often used interactively, as -the binding of @kbd{C-x b}. It is also used frequently in programs. It -always returns @code{nil}. -@end deffn - -@deffn Command switch-to-buffer-other-window buffer-or-name -This function makes @var{buffer-or-name} the current buffer and -displays it in a window not currently selected. It then selects that -window. The handling of the buffer is the same as in -@code{switch-to-buffer}. - -The currently selected window is absolutely never used to do the job. -If it is the only window, then it is split to make a distinct window for -this purpose. If the selected window is already displaying the buffer, -then it continues to do so, but another window is nonetheless found to -display it in as well. -@end deffn - -@defun pop-to-buffer buffer-or-name &optional other-window on-frame -This function makes @var{buffer-or-name} the current buffer and -switches to it in some window, preferably not the window previously -selected. The ``popped-to'' window becomes the selected window within -its frame. - -If the variable @code{pop-up-frames} is non-@code{nil}, -@code{pop-to-buffer} looks for a window in any visible frame already -displaying the buffer; if there is one, it returns that window and makes -it be selected within its frame. If there is none, it creates a new -frame and displays the buffer in it. - -If @code{pop-up-frames} is @code{nil}, then @code{pop-to-buffer} -operates entirely within the selected frame. (If the selected frame has -just a minibuffer, @code{pop-to-buffer} operates within the most -recently selected frame that was not just a minibuffer.) - -If the variable @code{pop-up-windows} is non-@code{nil}, windows may -be split to create a new window that is different from the original -window. For details, see @ref{Choosing Window}. - -If @var{other-window} is non-@code{nil}, @code{pop-to-buffer} finds or -creates another window even if @var{buffer-or-name} is already visible -in the selected window. Thus @var{buffer-or-name} could end up -displayed in two windows. On the other hand, if @var{buffer-or-name} is -already displayed in the selected window and @var{other-window} is -@code{nil}, then the selected window is considered sufficient display -for @var{buffer-or-name}, so that nothing needs to be done. - -All the variables that affect @code{display-buffer} affect -@code{pop-to-buffer} as well. @xref{Choosing Window}. - -If @var{buffer-or-name} is a string that does not name an existing -buffer, a buffer by that name is created. The major mode for the new -buffer is set according to the variable @code{default-major-mode}. -@xref{Auto Major Mode}. - - If @var{on-frame} is non-@code{nil}, it is the frame to pop to this -buffer on. - - An example use of this function is found at the end of @ref{Filter -Functions}. -@end defun - -@deffn Command replace-buffer-in-windows buffer -This function replaces @var{buffer} with some other buffer in all -windows displaying it. The other buffer used is chosen with -@code{other-buffer}. In the usual applications of this function, you -don't care which other buffer is used; you just want to make sure that -@var{buffer} is no longer displayed. - -This function returns @code{nil}. -@end deffn - -@node Choosing Window -@section Choosing a Window for Display - - This section describes the basic facility that chooses a window to -display a buffer in---@code{display-buffer}. All the higher-level -functions and commands use this subroutine. Here we describe how to use -@code{display-buffer} and how to customize it. - -@deffn Command display-buffer buffer-or-name &optional not-this-window -This command makes @var{buffer-or-name} appear in some window, like -@code{pop-to-buffer}, but it does not select that window and does not -make the buffer current. The identity of the selected window is -unaltered by this function. - -If @var{not-this-window} is non-@code{nil}, it means to display the -specified buffer in a window other than the selected one, even if it is -already on display in the selected window. This can cause the buffer to -appear in two windows at once. Otherwise, if @var{buffer-or-name} is -already being displayed in any window, that is good enough, so this -function does nothing. - -@code{display-buffer} returns the window chosen to display -@var{buffer-or-name}. - -Precisely how @code{display-buffer} finds or creates a window depends on -the variables described below. -@end deffn - -@c Emacs 19 feature -@cindex dedicated window -A window can be marked as ``dedicated'' to a particular buffer. -Then XEmacs will not automatically change which buffer appears in the -window, such as @code{display-buffer} might normally do. - -@defun window-dedicated-p window -This function returns @var{window}'s dedicated object, usually @code{t} -or @code{nil}. -@end defun - -@defun set-window-buffer-dedicated window buffer -This function makes @var{window} display @var{buffer} and be dedicated -to that buffer. Then XEmacs will not automatically change which buffer -appears in @var{window}. If @var{buffer} is @code{nil}, this function makes -@var{window} not be dedicated (but doesn't change which buffer appears -in it currently). -@end defun - -@defopt pop-up-windows -This variable controls whether @code{display-buffer} makes new windows. -If it is non-@code{nil} and there is only one window, then that window -is split. If it is @code{nil}, then @code{display-buffer} does not -split the single window, but uses it whole. -@end defopt - -@defopt split-height-threshold -This variable determines when @code{display-buffer} may split a window, -if there are multiple windows. @code{display-buffer} always splits the -largest window if it has at least this many lines. If the largest -window is not this tall, it is split only if it is the sole window and -@code{pop-up-windows} is non-@code{nil}. -@end defopt - -@c Emacs 19 feature -@defopt pop-up-frames -This variable controls whether @code{display-buffer} makes new frames. -If it is non-@code{nil}, @code{display-buffer} looks for an existing -window already displaying the desired buffer, on any visible frame. If -it finds one, it returns that window. Otherwise it makes a new frame. -The variables @code{pop-up-windows} and @code{split-height-threshold} do -not matter if @code{pop-up-frames} is non-@code{nil}. - -If @code{pop-up-frames} is @code{nil}, then @code{display-buffer} either -splits a window or reuses one. - -@xref{Frames}, for more information. -@end defopt - -@c Emacs 19 feature -@defvar pop-up-frame-function -This variable specifies how to make a new frame if @code{pop-up-frames} -is non-@code{nil}. - -Its value should be a function of no arguments. When -@code{display-buffer} makes a new frame, it does so by calling that -function, which should return a frame. The default value of the -variable is a function that creates a frame using properties from -@code{pop-up-frame-plist}. -@end defvar - -@defvar pop-up-frame-plist -This variable holds a plist specifying frame properties used when -@code{display-buffer} makes a new frame. @xref{Frame Properties}, for -more information about frame properties. -@end defvar - -@defvar special-display-buffer-names -A list of buffer names for buffers that should be displayed specially. -If the buffer's name is in this list, @code{display-buffer} handles the -buffer specially. - -By default, special display means to give the buffer a dedicated frame. - -If an element is a list, instead of a string, then the @sc{car} of the -list is the buffer name, and the rest of the list says how to create the -frame. There are two possibilities for the rest of the list. It can be -a plist, specifying frame properties, or it can contain a function and -arguments to give to it. (The function's first argument is always the -buffer to be displayed; the arguments from the list come after that.) -@end defvar - -@defvar special-display-regexps -A list of regular expressions that specify buffers that should be -displayed specially. If the buffer's name matches any of the regular -expressions in this list, @code{display-buffer} handles the buffer -specially. - -By default, special display means to give the buffer a dedicated frame. - -If an element is a list, instead of a string, then the @sc{car} of the -list is the regular expression, and the rest of the list says how to -create the frame. See above, under @code{special-display-buffer-names}. -@end defvar - -@defvar special-display-function -This variable holds the function to call to display a buffer specially. -It receives the buffer as an argument, and should return the window in -which it is displayed. - -The default value of this variable is -@code{special-display-popup-frame}. -@end defvar - -@defun special-display-popup-frame buffer -This function makes @var{buffer} visible in a frame of its own. If -@var{buffer} is already displayed in a window in some frame, it makes -the frame visible and raises it, to use that window. Otherwise, it -creates a frame that will be dedicated to @var{buffer}. - -This function uses an existing window displaying @var{buffer} whether or -not it is in a frame of its own; but if you set up the above variables -in your init file, before @var{buffer} was created, then presumably the -window was previously made by this function. -@end defun - -@defopt special-display-frame-plist -This variable holds frame properties for -@code{special-display-popup-frame} to use when it creates a frame. -@end defopt - -@defvar same-window-buffer-names -A list of buffer names for buffers that should be displayed in the -selected window. If the buffer's name is in this list, -@code{display-buffer} handles the buffer by switching to it in the -selected window. -@end defvar - -@defvar same-window-regexps -A list of regular expressions that specify buffers that should be -displayed in the selected window. If the buffer's name matches any of -the regular expressions in this list, @code{display-buffer} handles the -buffer by switching to it in the selected window. -@end defvar - -@c Emacs 19 feature -@defvar display-buffer-function -This variable is the most flexible way to customize the behavior of -@code{display-buffer}. If it is non-@code{nil}, it should be a function -that @code{display-buffer} calls to do the work. The function should -accept two arguments, the same two arguments that @code{display-buffer} -received. It should choose or create a window, display the specified -buffer, and then return the window. - -This hook takes precedence over all the other options and hooks -described above. -@end defvar - -@c Emacs 19 feature -@cindex dedicated window -A window can be marked as ``dedicated'' to its buffer. Then -@code{display-buffer} does not try to use that window. - -@defun window-dedicated-p window -This function returns @code{t} if @var{window} is marked as dedicated; -otherwise @code{nil}. -@end defun - -@defun set-window-dedicated-p window flag -This function marks @var{window} as dedicated if @var{flag} is -non-@code{nil}, and nondedicated otherwise. -@end defun - -@node Window Point -@section Windows and Point -@cindex window position -@cindex window point -@cindex position in window -@cindex point in window - - Each window has its own value of point, independent of the value of -point in other windows displaying the same buffer. This makes it useful -to have multiple windows showing one buffer. - -@itemize @bullet -@item -The window point is established when a window is first created; it is -initialized from the buffer's point, or from the window point of another -window opened on the buffer if such a window exists. - -@item -Selecting a window sets the value of point in its buffer to the window's -value of point. Conversely, deselecting a window sets the window's -value of point from that of the buffer. Thus, when you switch between -windows that display a given buffer, the point value for the selected -window is in effect in the buffer, while the point values for the other -windows are stored in those windows. - -@item -As long as the selected window displays the current buffer, the window's -point and the buffer's point always move together; they remain equal. - -@item -@xref{Positions}, for more details on buffer positions. -@end itemize - - As far as the user is concerned, point is where the cursor is, and -when the user switches to another buffer, the cursor jumps to the -position of point in that buffer. - -@defun window-point window -This function returns the current position of point in @var{window}. -For a nonselected window, this is the value point would have (in that -window's buffer) if that window were selected. - -When @var{window} is the selected window and its buffer is also the -current buffer, the value returned is the same as point in that buffer. - -Strictly speaking, it would be more correct to return the -``top-level'' value of point, outside of any @code{save-excursion} -forms. But that value is hard to find. -@end defun - -@defun set-window-point window position -This function positions point in @var{window} at position -@var{position} in @var{window}'s buffer. -@end defun - -@node Window Start -@section The Window Start Position - - Each window contains a marker used to keep track of a buffer position -that specifies where in the buffer display should start. This position -is called the @dfn{display-start} position of the window (or just the -@dfn{start}). The character after this position is the one that appears -at the upper left corner of the window. It is usually, but not -inevitably, at the beginning of a text line. - -@defun window-start &optional window -@cindex window top line -This function returns the display-start position of window -@var{window}. If @var{window} is @code{nil}, the selected window is -used. For example, - -@example -@group -(window-start) - @result{} 7058 -@end group -@end example - -When you create a window, or display a different buffer in it, the -display-start position is set to a display-start position recently used -for the same buffer, or 1 if the buffer doesn't have any. - -For a realistic example, see the description of @code{count-lines} in -@ref{Text Lines}. -@end defun - -@defun window-end &optional window -This function returns the position of the end of the display in window -@var{window}. If @var{window} is @code{nil}, the selected window is -used. - -Simply changing the buffer text or moving point does not update the -value that @code{window-end} returns. The value is updated only when -Emacs redisplays and redisplay actually finishes. - -If the last redisplay of @var{window} was preempted, and did not finish, -Emacs does not know the position of the end of display in that window. -In that case, this function returns a value that is not correct. In a -future version, @code{window-end} will return @code{nil} in that case. -@ignore -in that case, this function returns @code{nil}. You can compute where -the end of the window @emph{would} have been, if redisplay had finished, -like this: - -@example -(save-excursion - (goto-char (window-start window)) - (vertical-motion (1- (window-height window)) - window) - (point)) -@end example -@end ignore -@end defun - -@defun set-window-start window position &optional noforce -This function sets the display-start position of @var{window} to -@var{position} in @var{window}'s buffer. It returns @var{position}. - -The display routines insist that the position of point be visible when a -buffer is displayed. Normally, they change the display-start position -(that is, scroll the window) whenever necessary to make point visible. -However, if you specify the start position with this function using -@code{nil} for @var{noforce}, it means you want display to start at -@var{position} even if that would put the location of point off the -screen. If this does place point off screen, the display routines move -point to the left margin on the middle line in the window. - -For example, if point @w{is 1} and you set the start of the window @w{to -2}, then point would be ``above'' the top of the window. The display -routines will automatically move point if it is still 1 when redisplay -occurs. Here is an example: - -@example -@group -;; @r{Here is what @samp{foo} looks like before executing} -;; @r{the @code{set-window-start} expression.} -@end group - -@group ----------- Buffer: foo ---------- -@point{}This is the contents of buffer foo. -2 -3 -4 -5 -6 ----------- Buffer: foo ---------- -@end group - -@group -(set-window-start - (selected-window) - (1+ (window-start))) -@result{} 2 -@end group - -@group -;; @r{Here is what @samp{foo} looks like after executing} -;; @r{the @code{set-window-start} expression.} ----------- Buffer: foo ---------- -his is the contents of buffer foo. -2 -3 -@point{}4 -5 -6 ----------- Buffer: foo ---------- -@end group -@end example - -If @var{noforce} is non-@code{nil}, and @var{position} would place point -off screen at the next redisplay, then redisplay computes a new window-start -position that works well with point, and thus @var{position} is not used. -@end defun - -@defun pos-visible-in-window-p &optional position window -This function returns @code{t} if @var{position} is within the range -of text currently visible on the screen in @var{window}. It returns -@code{nil} if @var{position} is scrolled vertically out of view. The -argument @var{position} defaults to the current position of point; -@var{window}, to the selected window. Here is an example: - -@example -@group -(or (pos-visible-in-window-p - (point) (selected-window)) - (recenter 0)) -@end group -@end example - -The @code{pos-visible-in-window-p} function considers only vertical -scrolling. If @var{position} is out of view only because @var{window} -has been scrolled horizontally, @code{pos-visible-in-window-p} returns -@code{t}. @xref{Horizontal Scrolling}. -@end defun - -@node Vertical Scrolling -@section Vertical Scrolling -@cindex vertical scrolling -@cindex scrolling vertically - - Vertical scrolling means moving the text up or down in a window. It -works by changing the value of the window's display-start location. It -may also change the value of @code{window-point} to keep it on the -screen. - - In the commands @code{scroll-up} and @code{scroll-down}, the directions -``up'' and ``down'' refer to the motion of the text in the buffer at which -you are looking through the window. Imagine that the text is -written on a long roll of paper and that the scrolling commands move the -paper up and down. Thus, if you are looking at text in the middle of a -buffer and repeatedly call @code{scroll-down}, you will eventually see -the beginning of the buffer. - - Some people have urged that the opposite convention be used: they -imagine that the window moves over text that remains in place. Then -``down'' commands would take you to the end of the buffer. This view is -more consistent with the actual relationship between windows and the -text in the buffer, but it is less like what the user sees. The -position of a window on the terminal does not move, and short scrolling -commands clearly move the text up or down on the screen. We have chosen -names that fit the user's point of view. - - The scrolling functions (aside from @code{scroll-other-window}) have -unpredictable results if the current buffer is different from the buffer -that is displayed in the selected window. @xref{Current Buffer}. - -@deffn Command scroll-up &optional count -This function scrolls the text in the selected window upward -@var{count} lines. If @var{count} is negative, scrolling is actually -downward. - -If @var{count} is @code{nil} (or omitted), then the length of scroll -is @code{next-screen-context-lines} lines less than the usable height of -the window (not counting its modeline). - -@code{scroll-up} returns @code{nil}. -@end deffn - -@deffn Command scroll-down &optional count -This function scrolls the text in the selected window downward -@var{count} lines. If @var{count} is negative, scrolling is actually -upward. - -If @var{count} is omitted or @code{nil}, then the length of the scroll -is @code{next-screen-context-lines} lines less than the usable height of -the window (not counting its mode line). - -@code{scroll-down} returns @code{nil}. -@end deffn - -@deffn Command scroll-other-window &optional count -This function scrolls the text in another window upward @var{count} -lines. Negative values of @var{count}, or @code{nil}, are handled -as in @code{scroll-up}. - -You can specify a buffer to scroll with the variable -@code{other-window-scroll-buffer}. When the selected window is the -minibuffer, the next window is normally the one at the top left corner. -You can specify a different window to scroll with the variable -@code{minibuffer-scroll-window}. This variable has no effect when any -other window is selected. @xref{Minibuffer Misc}. - -When the minibuffer is active, it is the next window if the selected -window is the one at the bottom right corner. In this case, -@code{scroll-other-window} attempts to scroll the minibuffer. If the -minibuffer contains just one line, it has nowhere to scroll to, so the -line reappears after the echo area momentarily displays the message -``Beginning of buffer''. -@end deffn - -@c Emacs 19 feature -@defvar other-window-scroll-buffer -If this variable is non-@code{nil}, it tells @code{scroll-other-window} -which buffer to scroll. -@end defvar - -@defopt scroll-step -This variable controls how scrolling is done automatically when point -moves off the screen. If the value is zero, then redisplay scrolls the -text to center point vertically in the window. If the value is a -positive integer @var{n}, then redisplay brings point back on screen by -scrolling @var{n} lines in either direction, if possible; otherwise, it -centers point. The default value is zero. -@end defopt - -@defopt scroll-conservatively -This variable controls how many lines Emacs tries to scroll before -recentering. If you set it to a small number, then when you move point -a short distance off the screen, XEmacs will scroll the screen just far -enough to bring point back on screen, provided that does not exceed -@code{scroll-conservatively} lines. This variable overrides the -redisplay preemption. -@end defopt - -@defopt next-screen-context-lines -The value of this variable is the number of lines of continuity to -retain when scrolling by full screens. For example, @code{scroll-up} -with an argument of @code{nil} scrolls so that this many lines at the -bottom of the window appear instead at the top. The default value is -@code{2}. -@end defopt - -@deffn Command recenter &optional count -@cindex centering point -This function scrolls the selected window to put the text where point -is located at a specified vertical position within the window. - -If @var{count} is a nonnegative number, it puts the line containing -point @var{count} lines down from the top of the window. If @var{count} -is a negative number, then it counts upward from the bottom of the -window, so that @minus{}1 stands for the last usable line in the window. -If @var{count} is a non-@code{nil} list, then it stands for the line in -the middle of the window. - -If @var{count} is @code{nil}, @code{recenter} puts the line containing -point in the middle of the window, then clears and redisplays the entire -selected frame. - -When @code{recenter} is called interactively, @var{count} is the raw -prefix argument. Thus, typing @kbd{C-u} as the prefix sets the -@var{count} to a non-@code{nil} list, while typing @kbd{C-u 4} sets -@var{count} to 4, which positions the current line four lines from the -top. - -With an argument of zero, @code{recenter} positions the current line at -the top of the window. This action is so handy that some people make a -separate key binding to do this. For example, - -@example -@group -(defun line-to-top-of-window () - "Scroll current line to top of window. -Replaces three keystroke sequence C-u 0 C-l." - (interactive) - (recenter 0)) - -(global-set-key [kp-multiply] 'line-to-top-of-window) -@end group -@end example -@end deffn - -@node Horizontal Scrolling -@section Horizontal Scrolling -@cindex horizontal scrolling - - Because we read English first from top to bottom and second from left -to right, horizontal scrolling is not like vertical scrolling. Vertical -scrolling involves selection of a contiguous portion of text to display. -Horizontal scrolling causes part of each line to go off screen. The -amount of horizontal scrolling is therefore specified as a number of -columns rather than as a position in the buffer. It has nothing to do -with the display-start position returned by @code{window-start}. - - Usually, no horizontal scrolling is in effect; then the leftmost -column is at the left edge of the window. In this state, scrolling to -the right is meaningless, since there is no data to the left of the -screen to be revealed by it; so this is not allowed. Scrolling to the -left is allowed; it scrolls the first columns of text off the edge of -the window and can reveal additional columns on the right that were -truncated before. Once a window has a nonzero amount of leftward -horizontal scrolling, you can scroll it back to the right, but only so -far as to reduce the net horizontal scroll to zero. There is no limit -to how far left you can scroll, but eventually all the text will -disappear off the left edge. - -@deffn Command scroll-left count -This function scrolls the selected window @var{count} columns to the -left (or to the right if @var{count} is negative). The return value is -the total amount of leftward horizontal scrolling in effect after the -change---just like the value returned by @code{window-hscroll} (below). -@end deffn - -@deffn Command scroll-right count -This function scrolls the selected window @var{count} columns to the -right (or to the left if @var{count} is negative). The return value is -the total amount of leftward horizontal scrolling in effect after the -change---just like the value returned by @code{window-hscroll} (below). - -Once you scroll a window as far right as it can go, back to its normal -position where the total leftward scrolling is zero, attempts to scroll -any farther right have no effect. -@end deffn - -@defun window-hscroll &optional window -This function returns the total leftward horizontal scrolling of -@var{window}---the number of columns by which the text in @var{window} -is scrolled left past the left margin. - -The value is never negative. It is zero when no horizontal scrolling -has been done in @var{window} (which is usually the case). - -If @var{window} is @code{nil}, the selected window is used. - -@example -@group -(window-hscroll) - @result{} 0 -@end group -@group -(scroll-left 5) - @result{} 5 -@end group -@group -(window-hscroll) - @result{} 5 -@end group -@end example -@end defun - -@defun set-window-hscroll window columns -This function sets the number of columns from the left margin that -@var{window} is scrolled to the value of @var{columns}. The argument -@var{columns} should be zero or positive; if not, it is taken as zero. - -The value returned is @var{columns}. - -@example -@group -(set-window-hscroll (selected-window) 10) - @result{} 10 -@end group -@end example -@end defun - - Here is how you can determine whether a given position @var{position} -is off the screen due to horizontal scrolling: - -@example -@group -(defun hscroll-on-screen (window position) - (save-excursion - (goto-char position) - (and - (>= (- (current-column) (window-hscroll window)) 0) - (< (- (current-column) (window-hscroll window)) - (window-width window))))) -@end group -@end example -@node Size of Window -@section The Size of a Window -@cindex window size -@cindex size of window - -An Emacs window is rectangular, and its size information consists of -the height (in lines or pixels) and the width (in character positions -or pixels). The modeline is included in the height. The pixel -width and height values include scrollbars and margins, while the -line/character-position values do not. - -Note that the height in lines, and the width in characters, are -determined by dividing the corresponding pixel value by the height or -width of the default font in that window (if this is a variable-width -font, the average width is used). The resulting values may or may not -represent the actual number of lines in the window, or the actual number -of character positions in any particular line, esp. if there are pixmaps -or various different fonts in the window. - - The following functions return size information about a window: - -@defun window-height &optional window -This function returns the number of lines in @var{window}, including -its modeline but not including the horizontal scrollbar, if any (this -is different from @code{window-pixel-height}). If @var{window} is -@code{nil}, the function uses the selected window. - -@example -@group -(window-height) - @result{} 40 -@end group -@group -(split-window-vertically) - @result{} # -@end group -@group -(window-height) - @result{} 20 -@end group -@end example -@end defun - -@defun window-width &optional window -This function returns the number of columns in @var{window}, not -including any left margin, right margin, or vertical scrollbar (this is -different from @code{window-pixel-width}). If @var{window} is -@code{nil}, the function uses the selected window. - -@example -@group -(window-width) - @result{} 80 -@end group -@group -(window-height) - @result{} 40 -@end group -@group -(split-window-horizontally) - @result{} # -@end group -@group -(window-width) - @result{} 39 -@end group -@end example -@end defun - -Note that after splitting the window into two side-by-side windows, -the width of each window is less the half the width of the original -window because a vertical scrollbar appeared between the windows, -occupying two columns worth of space. Also, the height shrunk by -one because horizontal scrollbars appeared that weren't there -before. (Horizontal scrollbars appear only when lines are -truncated, not when they wrap. This is usually the case for -horizontally split windows but not for full-frame windows. You -can change this using the variables @code{truncate-lines} and -@code{truncate-partial-width-windows}.) - -@defun window-pixel-height &optional window -This function returns the height of @var{window} in pixels, including -its modeline and horizontal scrollbar, if any. If @var{window} is -@code{nil}, the function uses the selected window. - -@example -@group -(window-pixel-height) - @result{} 600 -@end group -@group -(split-window-vertically) - @result{} # -@end group -@group -(window-pixel-height) - @result{} 300 -@end group -@end example -@end defun - -@defun window-pixel-width &optional window - This function returns the width of @var{window} in pixels, including -any left margin, right margin, or vertical scrollbar that may be -displayed alongside it. If @var{window} is @code{nil}, the function -uses the selected window. - -@example -@group -(window-pixel-width) - @result{} 735 -@end group -@group -(window-pixel-height) - @result{} 600 -@end group -@group -(split-window-horizontally) - @result{} # -@end group -@group -(window-pixel-width) - @result{} 367 -@end group -@group -(window-pixel-height) - @result{} 600 -@end group -@end example -@end defun - -@defun window-text-area-pixel-height &optional window -This function returns the height in pixels of the text displaying -portion of @var{window}, which defaults to the selected window. Unlike -@code{window-pixel-height}, the space occupied by the modeline and -horizontal scrollbar, if any, is not counted. -@end defun - -@defun window-text-area-pixel-width &optional window -This function returns the width in pixels of the text displaying -portion of @var{window}, which defaults to the selected window. Unlike -@code{window-pixel-width}, the space occupied by the vertical scrollbar -and divider, if any, is not counted. -@end defun - -@defun window-displayed-text-pixel-height &optional window noclipped -This function returns the height in pixels of the text displayed in -@var{window}, which defaults to the selected window. Unlike -@code{window-text-area-pixel-height}, any blank space below the -end of the buffer is not included. If optional argument @var{noclipped} -is non-@code{nil}, any space occupied by clipped lines will not be -included. -@end defun - -@node Position of Window -@section The Position of a Window -@cindex window position -@cindex position of window - -XEmacs provides functions to determine the absolute location of windows -within a frame, and the relative location of a window in comparison to -other windows in the same frame. - -@defun window-pixel-edges &optional window - This function returns a list of the pixel edge coordinates of -@var{window}. If @var{window} is @code{nil}, the selected window is -used. - - The order of the list is @code{(@var{left} @var{top} @var{right} -@var{bottom})}, all elements relative to 0, 0 at the top left corner of -the frame. The element @var{right} of the value is one more than the -rightmost pixel used by @var{window} (including any left margin, right -margin, or vertical scrollbar displayed alongside it), and -@var{bottom} is one more than the bottommost pixel used by @var{window} -(including any modeline or horizontal scrollbar displayed above -or below it). The frame area does not include any frame menubars or -toolbars that may be displayed; thus, for example, if there is only -one window on the frame, the values for @var{left} and @var{top} will -always be 0. - - If @var{window} is at the upper left corner of its frame, @var{right} -and @var{bottom} are the same as the values returned by -@code{(window-pixel-width)} and @code{(window-pixel-height)} -respectively, and @var{top} and @var{bottom} are zero. -@end defun - - There is no longer a function @code{window-edges} because it does not -make sense in a world with variable-width and variable-height lines, -as are allowed in XEmacs. - -@defun window-highest-p window - This function returns non-@code{nil} if @var{window} is along the -top of its frame. -@end defun - -@defun window-lowest-p window - This function returns non-@code{nil} if @var{window} is along the -bottom of its frame. -@end defun - -@defun window-text-area-pixel-edges &optional window -This function allows one to determine the location of the -text-displaying portion of @var{window}, which defaults to the selected -window, with respect to the top left corner of the window. It returns -a list of integer pixel positions @code{(left top right bottom)}, all -relative to @code{(0,0)} at the top left corner of the window. -@end defun - -@node Resizing Windows -@section Changing the Size of a Window -@cindex window resizing -@cindex changing window size -@cindex window size, changing - - The window size functions fall into two classes: high-level commands -that change the size of windows and low-level functions that access -window size. XEmacs does not permit overlapping windows or gaps between -windows, so resizing one window affects other windows. - -@deffn Command enlarge-window size &optional horizontal window -This function makes the selected window @var{size} lines taller, -stealing lines from neighboring windows. It takes the lines from one -window at a time until that window is used up, then takes from another. -If a window from which lines are stolen shrinks below -@code{window-min-height} lines, that window disappears. - -If @var{horizontal} is non-@code{nil}, this function makes -@var{window} wider by @var{size} columns, stealing columns instead of -lines. If a window from which columns are stolen shrinks below -@code{window-min-width} columns, that window disappears. - -If the requested size would exceed that of the window's frame, then the -function makes the window occupy the entire height (or width) of the -frame. - -If @var{size} is negative, this function shrinks the window by -@minus{}@var{size} lines or columns. If that makes the window smaller -than the minimum size (@code{window-min-height} and -@code{window-min-width}), @code{enlarge-window} deletes the window. - -If @var{window} is non-@code{nil}, it specifies a window to change -instead of the selected window. - -@code{enlarge-window} returns @code{nil}. -@end deffn - -@deffn Command enlarge-window-horizontally columns -This function makes the selected window @var{columns} wider. -It could be defined as follows: - -@example -@group -(defun enlarge-window-horizontally (columns) - (enlarge-window columns t)) -@end group -@end example -@end deffn - -@deffn Command enlarge-window-pixels count &optional side window -This function makes the selected window @var{count} pixels larger. When -called from Lisp, optional second argument @var{side} non-@code{nil} -means to grow sideways @var{count} pixels, and optional third argument -@var{window} specifies the window to change instead of the selected -window. -@end deffn - -@deffn Command shrink-window size &optional horizontal window -This function is like @code{enlarge-window} but negates the argument -@var{size}, making the selected window smaller by giving lines (or -columns) to the other windows. If the window shrinks below -@code{window-min-height} or @code{window-min-width}, then it disappears. - -If @var{size} is negative, the window is enlarged by @minus{}@var{size} -lines or columns. - -If @var{window} is non-@code{nil}, it specifies a window to change -instead of the selected window. -@end deffn - -@deffn Command shrink-window-horizontally columns -This function makes the selected window @var{columns} narrower. -It could be defined as follows: - -@example -@group -(defun shrink-window-horizontally (columns) - (shrink-window columns t)) -@end group -@end example -@end deffn - -@deffn Command shrink-window-pixels count &optional side window -This function makes the selected window @var{count} pixels smaller. -When called from Lisp, optional second argument @var{side} -non-@code{nil} means to shrink sideways @var{count} pixels, and optional -third argument @var{window} specifies the window to change instead of -the selected window. -@end deffn - -@cindex minimum window size - The following two variables constrain the window-size-changing -functions to a minimum height and width. - -@defopt window-min-height -The value of this variable determines how short a window may become -before it is automatically deleted. Making a window smaller than -@code{window-min-height} automatically deletes it, and no window may be -created shorter than this. The absolute minimum height is two (allowing -one line for the mode line, and one line for the buffer display). -Actions that change window sizes reset this variable to two if it is -less than two. The default value is 4. -@end defopt - -@defopt window-min-width -The value of this variable determines how narrow a window may become -before it automatically deleted. Making a window smaller than -@code{window-min-width} automatically deletes it, and no window may be -created narrower than this. The absolute minimum width is one; any -value below that is ignored. The default value is 10. -@end defopt - -@c This is not yet implemented. Why is it "documented"? -@defvar window-size-change-functions -This variable holds a list of functions to be called if the size of any -window changes for any reason. The functions are called just once per -redisplay, and just once for each frame on which size changes have -occurred. - -Each function receives the frame as its sole argument. There is no -direct way to find out which windows changed size, or precisely how; -however, if your size-change function keeps track, after each change, of -the windows that interest you, you can figure out what has changed by -comparing the old size data with the new. - -Creating or deleting windows counts as a size change, and therefore -causes these functions to be called. Changing the frame size also -counts, because it changes the sizes of the existing windows. - -It is not a good idea to use @code{save-window-excursion} in these -functions, because that always counts as a size change, and it would -cause these functions to be called over and over. In most cases, -@code{save-selected-window} is what you need here. -@end defvar - -@node Window Configurations -@section Window Configurations -@cindex window configurations -@cindex saving window information - - A @dfn{window configuration} records the entire layout of a -frame---all windows, their sizes, which buffers they contain, what part -of each buffer is displayed, and the values of point and the mark. You -can bring back an entire previous layout by restoring a window -configuration previously saved. - - If you want to record all frames instead of just one, use a frame -configuration instead of a window configuration. @xref{Frame -Configurations}. - -@defun current-window-configuration -This function returns a new object representing XEmacs's current window -configuration, namely the number of windows, their sizes and current -buffers, which window is the selected window, and for each window the -displayed buffer, the display-start position, and the positions of point -and the mark. An exception is made for point in the current buffer, -whose value is not saved. -@end defun - -@defun set-window-configuration configuration -This function restores the configuration of XEmacs's windows and -buffers to the state specified by @var{configuration}. The argument -@var{configuration} must be a value that was previously returned by -@code{current-window-configuration}. - -This function always counts as a window size change and triggers -execution of the @code{window-size-change-functions}. (It doesn't know -how to tell whether the new configuration actually differs from the old -one.) - -Here is a way of using this function to get the same effect -as @code{save-window-excursion}: - -@example -@group -(let ((config (current-window-configuration))) - (unwind-protect - (progn (split-window-vertically nil) - @dots{}) - (set-window-configuration config))) -@end group -@end example -@end defun - -@defspec save-window-excursion forms@dots{} -This special form records the window configuration, executes @var{forms} -in sequence, then restores the earlier window configuration. The window -configuration includes the value of point and the portion of the buffer -that is visible. It also includes the choice of selected window. -However, it does not include the value of point in the current buffer; -use @code{save-excursion} if you wish to preserve that. - -Don't use this construct when @code{save-selected-window} is all you need. - -Exit from @code{save-window-excursion} always triggers execution of the -@code{window-size-change-functions}. (It doesn't know how to tell -whether the restored configuration actually differs from the one in -effect at the end of the @var{forms}.) - -The return value is the value of the final form in @var{forms}. -For example: - -@example -@group -(split-window) - @result{} # -@end group -@group -(setq w (selected-window)) - @result{} # -@end group -@group -(save-window-excursion - (delete-other-windows w) - (switch-to-buffer "foo") - 'do-something) - @result{} do-something - ;; @r{The frame is now split again.} -@end group -@end example -@end defspec - -@defun window-configuration-p object -This function returns @code{t} if @var{object} is a window configuration. -@end defun - - Primitives to look inside of window configurations would make sense, -but none are implemented. It is not clear they are useful enough to be -worth implementing. diff --git a/man/lispref/x-windows.texi b/man/lispref/x-windows.texi deleted file mode 100644 index c40ab14..0000000 --- a/man/lispref/x-windows.texi +++ /dev/null @@ -1,370 +0,0 @@ -@c -*-texinfo-*- -@c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. -@c See the file lispref.texi for copying conditions. -@setfilename ../../info/x-windows.texinfo -@node X-Windows, ToolTalk Support, System Interface, Top -@chapter Functions Specific to the X Window System -@cindex X -@cindex X-Windows - -@c This section is largely different from the one in FSF Emacs. - -XEmacs provides the concept of @dfn{devices}, which generalizes -connections to an X server, a TTY device, etc. Most information about -an X server that XEmacs is connected to can be determined through -general console and device functions. @xref{Consoles and Devices}. -However, there are some features of the X Window System that do not -generalize well, and they are covered specially here. - -@menu -* X Selections:: Transferring text to and from other X clients. -* X Server:: Information about the X server connected to - a particular device. -* X Miscellaneous:: Other X-specific functions and variables. -@end menu - -@node X Selections -@section X Selections -@cindex selection (for X windows) - -The X server records a set of @dfn{selections} which permit transfer of -data between application programs. The various selections are -distinguished by @dfn{selection types}, represented in XEmacs by -symbols. X clients including XEmacs can read or set the selection for -any given type. - -@defun x-own-selection data &optional type -This function sets a ``selection'' in the X server. It takes two -arguments: a value, @var{data}, and the selection type @var{type} to -assign it to. @var{data} may be a string, a cons of two markers, or an -extent. In the latter cases, the selection is considered to be the text -between the markers, or between the extent's endpoints. - -Each possible @var{type} has its own selection value, which changes -independently. The usual values of @var{type} are @code{PRIMARY} and -@code{SECONDARY}; these are symbols with upper-case names, in accord -with X Windows conventions. The default is @code{PRIMARY}. - -(In FSF Emacs, this function is called @code{x-set-selection} and -takes different arguments.) -@end defun - -@defun x-get-selection -This function accesses selections set up by XEmacs or by other X -clients. It returns the value of the current primary selection. -@end defun - -@defun x-disown-selection &optional secondary-p -Assuming we own the selection, this function disowns it. If -@var{secondary-p} is non-@code{nil}, the secondary selection instead of -the primary selection is discarded. -@end defun - -@cindex cut buffer -The X server also has a set of numbered @dfn{cut buffers} which can -store text or other data being moved between applications. Cut buffers -are considered obsolete, but XEmacs supports them for the sake of X -clients that still use them. - -@defun x-get-cutbuffer &optional n -This function returns the contents of cut buffer number @var{n}. (This -function is called @code{x-get-cut-buffer} in FSF Emacs.) -@end defun - -@defun x-store-cutbuffer string -This function stores @var{string} into the first cut buffer (cut buffer -0), moving the other values down through the series of cut buffers, -kill-ring-style. (This function is called @code{x-set-cut-buffer} in FSF -Emacs.) -@end defun - -@node X Server -@section X Server - -This section describes how to access and change the overall status of -the X server XEmacs is using. - -@menu -* Resources:: Getting resource values from the server. -* Server Data:: Getting info about the X server. -* Grabs:: Restricting access to the server by other apps. -@end menu - -@node Resources -@subsection Resources - -@defun default-x-device -This function return the default X device for resourcing. This is the -first-created X device that still exists. -@end defun - -@defun x-get-resource name class type &optional locale device noerror -This function retrieves a resource value from the X resource manager. - -@itemize @bullet -@item -The first arg is the name of the resource to retrieve, such as -@samp{"font"}. - -@item -The second arg is the class of the resource to retrieve, like -@samp{"Font"}. - -@item -The third arg should be one of the symbols @code{string}, -@code{integer}, @code{natnum}, or @code{boolean}, specifying the type of -object that the database is searched for. - -@item -The fourth arg is the locale to search for the resources on, and can -currently be a a buffer, a frame, a device, or the symbol @code{global}. -If omitted, it defaults to @code{global}. - -@item -The fifth arg is the device to search for the resources on. (The -resource database for a particular device is constructed by combining -non-device- specific resources such any command-line resources specified -and any app-defaults files found [or the fallback resources supplied by -XEmacs, if no app-defaults file is found] with device-specific resources -such as those supplied using @samp{xrdb}.) If omitted, it defaults to -the device of @var{locale}, if a device can be derived (i.e. if -@var{locale} is a frame or device), and otherwise defaults to the value -of @code{default-x-device}. - -@item -The sixth arg @var{noerror}, if non-@code{nil}, means do not signal an -error if a bogus resource specification was retrieved (e.g. if a -non-integer was given when an integer was requested). In this case, a -warning is issued instead. -@end itemize - -The resource names passed to this function are looked up relative to the -locale. - -If you want to search for a subresource, you just need to specify the -resource levels in @var{name} and @var{class}. For example, @var{name} -could be @samp{"modeline.attributeFont"}, and @var{class} -@samp{"Face.AttributeFont"}. - -Specifically, - -@enumerate -@item -If @var{locale} is a buffer, a call - -@example - @code{(x-get-resource "foreground" "Foreground" 'string @var{some-buffer})} -@end example - -is an interface to a C call something like - -@example - @code{XrmGetResource (db, "xemacs.buffer.@var{buffer-name}.foreground", - "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", - "String");} -@end example - -@item -If @var{locale} is a frame, a call - -@example - @code{(x-get-resource "foreground" "Foreground" 'string @var{some-frame})} -@end example - -is an interface to a C call something like -@example - - @code{XrmGetResource (db, "xemacs.frame.@var{frame-name}.foreground", - "Emacs.EmacsLocaleType.EmacsFrame.Foreground", - "String");} -@end example - -@item -If @var{locale} is a device, a call - -@example - @code{(x-get-resource "foreground" "Foreground" 'string @var{some-device})} -@end example - -is an interface to a C call something like - -@example - @code{XrmGetResource (db, "xemacs.device.@var{device-name}.foreground", - "Emacs.EmacsLocaleType.EmacsDevice.Foreground", - "String");} -@end example - -@item -If @var{locale} is the symbol @code{global}, a call - -@example - @code{(x-get-resource "foreground" "Foreground" 'string 'global)} -@end example - -is an interface to a C call something like - -@example - @code{XrmGetResource (db, "xemacs.foreground", - "Emacs.Foreground", - "String");} -@end example -@end enumerate - -Note that for @code{global}, no prefix is added other than that of the -application itself; thus, you can use this locale to retrieve arbitrary -application resources, if you really want to. - -The returned value of this function is @code{nil} if the queried -resource is not found. If @var{type} is @code{string}, a string is -returned, and if it is @code{integer}, an integer is returned. If -@var{type} is @code{boolean}, then the returned value is the list -@code{(t)} for true, @code{(nil)} for false, and is @code{nil} to mean -``unspecified''. -@end defun - -@defun x-put-resource resource-line &optional device -This function adds a resource to the resource database for @var{device}. -@var{resource-line} specifies the resource to add and should be a -standard resource specification. -@end defun - -@defvar x-emacs-application-class -This variable holds The X application class of the XEmacs process. This -controls, among other things, the name of the ``app-defaults'' file that -XEmacs will use. For changes to this variable to take effect, they must -be made before the connection to the X server is initialized, that is, -this variable may only be changed before XEmacs is dumped, or by setting -it in the file @file{lisp/term/x-win.el}. - -By default, this variable is nil at startup. When the connection -to the X server is first initialized, the X resource database will -be consulted and the value will be set according to whether any -resources are found for the application class ``XEmacs''. -@end defvar - -@node Server Data -@subsection Data about the X Server - - This section describes functions and a variable that you can use to -get information about the capabilities and origin of the X server -corresponding to a particular device. The device argument is generally -optional and defaults to the selected device. - -@defun x-server-version &optional device -This function returns the list of version numbers of the X server -@var{device} is on. The returned value is a list of three integers: the -major and minor version numbers of the X protocol in use, and the -vendor-specific release number. -@end defun - -@defun x-server-vendor &optional device -This function returns the vendor supporting the X server @var{device} is -on. -@end defun - -@defun x-display-visual-class &optional device -This function returns the visual class of the display @var{device} is -on. The value is one of the symbols @code{static-gray}, -@code{gray-scale}, @code{static-color}, @code{pseudo-color}, -@code{true-color}, and @code{direct-color}. (Note that this is different -from previous versions of XEmacs, which returned @code{StaticGray}, -@code{GrayScale}, etc.) -@end defun - -@node Grabs -@subsection Restricting Access to the Server by Other Apps - -@defun x-grab-keyboard &optional device -This function grabs the keyboard on the given device (defaulting to the -selected one). So long as the keyboard is grabbed, all keyboard events -will be delivered to XEmacs -- it is not possible for other X clients to -eavesdrop on them. Ungrab the keyboard with @code{x-ungrab-keyboard} -(use an @code{unwind-protect}). Returns @code{t} if the grab was -successful; @code{nil} otherwise. -@end defun - -@defun x-ungrab-keyboard &optional device -This function releases a keyboard grab made with @code{x-grab-keyboard}. -@end defun - -@defun x-grab-pointer &optional device cursor ignore-keyboard -This function grabs the pointer and restricts it to its current window. -If optional @var{device} argument is @code{nil}, the selected device -will be used. If optional @var{cursor} argument is non-@code{nil}, -change the pointer shape to that until @code{x-ungrab-pointer} is called -(it should be an object returned by the @code{make-cursor} function). -If the second optional argument @var{ignore-keyboard} is non-@code{nil}, -ignore all keyboard events during the grab. Returns @code{t} if the -grab is successful, @code{nil} otherwise. -@end defun - -@defun x-ungrab-pointer &optional device -This function releases a pointer grab made with @code{x-grab-pointer}. -If optional first arg @var{device} is @code{nil} the selected device is -used. If it is @code{t} the pointer will be released on all X devices. -@end defun - -@node X Miscellaneous -@section Miscellaneous X Functions and Variables - -@defvar x-bitmap-file-path -This variable holds a list of the directories in which X bitmap files -may be found. If @code{nil}, this is initialized from the -@samp{"*bitmapFilePath"} resource. This is used by the -@code{make-image-instance} function (however, note that if the -environment variable @samp{XBMLANGPATH} is set, it is consulted first). -@end defvar - -@defvar x-library-search-path -This variable holds the search path used by @code{read-color} to find -@file{rgb.txt}. -@end defvar - -@defun x-valid-keysym-name-p keysym -This function returns true if @var{keysym} names a keysym that the X -library knows about. Valid keysyms are listed in the files -@file{/usr/include/X11/keysymdef.h} and in -@file{/usr/lib/X11/XKeysymDB}, or whatever the equivalents are on your -system. -@end defun - -@defun x-window-id &optional frame -This function returns the ID of the X11 window. This gives us a chance -to manipulate the Emacs window from within a different program. Since -the ID is an unsigned long, we return it as a string. -@end defun - -@defvar x-allow-sendevents -If non-@code{nil}, synthetic events are allowed. @code{nil} means -they are ignored. Beware: allowing XEmacs to process SendEvents opens a -big security hole. -@end defvar - -@defun x-debug-mode arg &optional device -With a true arg, make the connection to the X server synchronous. With -false, make it asynchronous. Synchronous connections are much slower, -but are useful for debugging. (If you get X errors, make the connection -synchronous, and use a debugger to set a breakpoint on -@code{x_error_handler}. Your backtrace of the C stack will now be -useful. In asynchronous mode, the stack above @code{x_error_handler} -isn't helpful because of buffering.) If @var{device} is not specified, -the selected device is assumed. - -Calling this function is the same as calling the C function -@code{XSynchronize}, or starting the program with the @samp{-sync} -command line argument. -@end defun - -@defvar x-debug-events -If non-zero, debug information about events that XEmacs sees is -displayed. Information is displayed on stderr. Currently defined -values are: - -@itemize @bullet -@item -1 == non-verbose output -@item -2 == verbose output -@end itemize -@end defvar diff --git a/man/make-stds.texi b/man/make-stds.texi deleted file mode 100644 index b3b88da..0000000 --- a/man/make-stds.texi +++ /dev/null @@ -1,722 +0,0 @@ -@comment This file is included by both standards.texi and make.texinfo. -@comment It was broken out of standards.texi on 1/6/93 by roland. - -@node Makefile Conventions -@chapter Makefile Conventions -@comment standards.texi does not print an index, but make.texinfo does. -@cindex makefile, conventions for -@cindex conventions for makefiles -@cindex standards for makefiles - -This -@ifinfo -node -@end ifinfo -@iftex -@ifset CODESTD -section -@end ifset -@ifclear CODESTD -chapter -@end ifclear -@end iftex -describes conventions for writing the Makefiles for GNU programs. - -@menu -* Makefile Basics:: General Conventions for Makefiles -* Utilities in Makefiles:: Utilities in Makefiles -* Command Variables:: Variables for Specifying Commands -* Directory Variables:: Variables for Installation Directories -* Standard Targets:: Standard Targets for Users -@end menu - -@node Makefile Basics -@section General Conventions for Makefiles - -Every Makefile should contain this line: - -@example -SHELL = /bin/sh -@end example - -@noindent -to avoid trouble on systems where the @code{SHELL} variable might be -inherited from the environment. (This is never a problem with GNU -@code{make}.) - -Different @code{make} programs have incompatible suffix lists and -implicit rules, and this sometimes creates confusion or misbehavior. So -it is a good idea to set the suffix list explicitly using only the -suffixes you need in the particular Makefile, like this: - -@example -.SUFFIXES: -.SUFFIXES: .c .o -@end example - -@noindent -The first line clears out the suffix list, the second introduces all -suffixes which may be subject to implicit rules in this Makefile. - -Don't assume that @file{.} is in the path for command execution. When -you need to run programs that are a part of your package during the -make, please make sure that it uses @file{./} if the program is built as -part of the make or @file{$(srcdir)/} if the file is an unchanging part -of the source code. Without one of these prefixes, the current search -path is used. - -The distinction between @file{./} and @file{$(srcdir)/} is important -when using the @samp{--srcdir} option to @file{configure}. A rule of -the form: - -@smallexample -foo.1 : foo.man sedscript - sed -e sedscript foo.man > foo.1 -@end smallexample - -@noindent -will fail when the current directory is not the source directory, -because @file{foo.man} and @file{sedscript} are not in the current -directory. - -When using GNU @code{make}, relying on @samp{VPATH} to find the source -file will work in the case where there is a single dependency file, -since the @code{make} automatic variable @samp{$<} will represent the -source file wherever it is. (Many versions of @code{make} set @samp{$<} -only in implicit rules.) A Makefile target like - -@smallexample -foo.o : bar.c - $(CC) -I. -I$(srcdir) $(CFLAGS) -c bar.c -o foo.o -@end smallexample - -@noindent -should instead be written as - -@smallexample -foo.o : bar.c - $(CC) -I. -I$(srcdir) $(CFLAGS) -c $< -o $@@ -@end smallexample - -@noindent -in order to allow @samp{VPATH} to work correctly. When the target has -multiple dependencies, using an explicit @samp{$(srcdir)} is the easiest -way to make the rule work well. For example, the target above for -@file{foo.1} is best written as: - -@smallexample -foo.1 : foo.man sedscript - sed -e $(srcdir)/sedscript $(srcdir)/foo.man > $@@ -@end smallexample - -Try to make the build and installation targets, at least (and all their -subtargets) work correctly with a parallel @code{make}. - -@node Utilities in Makefiles -@section Utilities in Makefiles - -Write the Makefile commands (and any shell scripts, such as -@code{configure}) to run in @code{sh}, not in @code{csh}. Don't use any -special features of @code{ksh} or @code{bash}. - -The @code{configure} script and the Makefile rules for building and -installation should not use any utilities directly except these: - -@example -cat cmp cp echo egrep expr false grep -ln mkdir mv pwd rm rmdir sed test touch true -@end example - -Stick to the generally supported options for these programs. For -example, don't use @samp{mkdir -p}, convenient as it may be, because -most systems don't support it. - -It is a good idea to avoid creating symbolic links in makefiles, since a -few systems don't support them. - -The Makefile rules for building and installation can also use compilers -and related programs, but should do so via @code{make} variables so that the -user can substitute alternatives. Here are some of the programs we -mean: - -@example -ar bison cc flex install ld lex -make makeinfo ranlib texi2dvi yacc -@end example - -Use the following @code{make} variables: - -@example -$(AR) $(BISON) $(CC) $(FLEX) $(INSTALL) $(LD) $(LEX) -$(MAKE) $(MAKEINFO) $(RANLIB) $(TEXI2DVI) $(YACC) -@end example - -When you use @code{ranlib}, you should make sure nothing bad happens if -the system does not have @code{ranlib}. Arrange to ignore an error -from that command, and print a message before the command to tell the -user that failure of the @code{ranlib} command does not mean a problem. -(The Autoconf @samp{AC_PROG_RANLIB} macro can help with this.) - -If you use symbolic links, you should implement a fallback for systems -that don't have symbolic links. - -It is ok to use other utilities in Makefile portions (or scripts) -intended only for particular systems where you know those utilities -exist. - -@node Command Variables -@section Variables for Specifying Commands - -Makefiles should provide variables for overriding certain commands, options, -and so on. - -In particular, you should run most utility programs via variables. -Thus, if you use Bison, have a variable named @code{BISON} whose default -value is set with @samp{BISON = bison}, and refer to it with -@code{$(BISON)} whenever you need to use Bison. - -File management utilities such as @code{ln}, @code{rm}, @code{mv}, and -so on, need not be referred to through variables in this way, since users -don't need to replace them with other programs. - -Each program-name variable should come with an options variable that is -used to supply options to the program. Append @samp{FLAGS} to the -program-name variable name to get the options variable name---for -example, @code{BISONFLAGS}. (The name @code{CFLAGS} is an exception to -this rule, but we keep it because it is standard.) Use @code{CPPFLAGS} -in any compilation command that runs the preprocessor, and use -@code{LDFLAGS} in any compilation command that does linking as well as -in any direct use of @code{ld}. - -If there are C compiler options that @emph{must} be used for proper -compilation of certain files, do not include them in @code{CFLAGS}. -Users expect to be able to specify @code{CFLAGS} freely themselves. -Instead, arrange to pass the necessary options to the C compiler -independently of @code{CFLAGS}, by writing them explicitly in the -compilation commands or by defining an implicit rule, like this: - -@smallexample -CFLAGS = -g -ALL_CFLAGS = -I. $(CFLAGS) -.c.o: - $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $< -@end smallexample - -Do include the @samp{-g} option in @code{CFLAGS}, because that is not -@emph{required} for proper compilation. You can consider it a default -that is only recommended. If the package is set up so that it is -compiled with GCC by default, then you might as well include @samp{-O} -in the default value of @code{CFLAGS} as well. - -Put @code{CFLAGS} last in the compilation command, after other variables -containing compiler options, so the user can use @code{CFLAGS} to -override the others. - -Every Makefile should define the variable @code{INSTALL}, which is the -basic command for installing a file into the system. - -Every Makefile should also define the variables @code{INSTALL_PROGRAM} -and @code{INSTALL_DATA}. (The default for each of these should be -@code{$(INSTALL)}.) Then it should use those variables as the commands -for actual installation, for executables and nonexecutables -respectively. Use these variables as follows: - -@example -$(INSTALL_PROGRAM) foo $(bindir)/foo -$(INSTALL_DATA) libfoo.a $(libdir)/libfoo.a -@end example - -@noindent -Always use a file name, not a directory name, as the second argument of -the installation commands. Use a separate command for each file to be -installed. - -@node Directory Variables -@section Variables for Installation Directories - -Installation directories should always be named by variables, so it is -easy to install in a nonstandard place. The standard names for these -variables are described below. They are based on a standard filesystem -layout; variants of it are used in SVR4, 4.4BSD, Linux, Ultrix v4, and -other modern operating systems. - -These two variables set the root for the installation. All the other -installation directories should be subdirectories of one of these two, -and nothing should be directly installed into these two directories. - -@table @samp -@item prefix -A prefix used in constructing the default values of the variables listed -below. The default value of @code{prefix} should be @file{/usr/local}. -When building the complete GNU system, the prefix will be empty and -@file{/usr} will be a symbolic link to @file{/}. -(If you are using Autoconf, write it as @samp{@@prefix@@}.) - -@item exec_prefix -A prefix used in constructing the default values of some of the -variables listed below. The default value of @code{exec_prefix} should -be @code{$(prefix)}. -(If you are using Autoconf, write it as @samp{@@exec_prefix@@}.) - -Generally, @code{$(exec_prefix)} is used for directories that contain -machine-specific files (such as executables and subroutine libraries), -while @code{$(prefix)} is used directly for other directories. -@end table - -Executable programs are installed in one of the following directories. - -@table @samp -@item bindir -The directory for installing executable programs that users can run. -This should normally be @file{/usr/local/bin}, but write it as -@file{$(exec_prefix)/bin}. -(If you are using Autoconf, write it as @samp{@@bindir@@}.) - -@item sbindir -The directory for installing executable programs that can be run from -the shell, but are only generally useful to system administrators. This -should normally be @file{/usr/local/sbin}, but write it as -@file{$(exec_prefix)/sbin}. -(If you are using Autoconf, write it as @samp{@@sbindir@@}.) - -@item libexecdir -@comment This paragraph adjusted to avoid overfull hbox --roland 5jul94 -The directory for installing executable programs to be run by other -programs rather than by users. This directory should normally be -@file{/usr/local/libexec}, but write it as @file{$(exec_prefix)/libexec}. -(If you are using Autoconf, write it as @samp{@@libexecdir@@}.) -@end table - -Data files used by the program during its execution are divided into -categories in two ways. - -@itemize @bullet -@item -Some files are normally modified by programs; others are never normally -modified (though users may edit some of these). - -@item -Some files are architecture-independent and can be shared by all -machines at a site; some are architecture-dependent and can be shared -only by machines of the same kind and operating system; others may never -be shared between two machines. -@end itemize - -This makes for six different possibilities. However, we want to -discourage the use of architecture-dependent files, aside from object -files and libraries. It is much cleaner to make other data files -architecture-independent, and it is generally not hard. - -Therefore, here are the variables Makefiles should use to specify -directories: - -@table @samp -@item datadir -The directory for installing read-only architecture independent data -files. This should normally be @file{/usr/local/share}, but write it as -@file{$(prefix)/share}. -(If you are using Autoconf, write it as @samp{@@datadir@@}.) -As a special exception, see @file{$(infodir)} -and @file{$(includedir)} below. - -@item sysconfdir -The directory for installing read-only data files that pertain to a -single machine--that is to say, files for configuring a host. Mailer -and network configuration files, @file{/etc/passwd}, and so forth belong -here. All the files in this directory should be ordinary ASCII text -files. This directory should normally be @file{/usr/local/etc}, but -write it as @file{$(prefix)/etc}. -(If you are using Autoconf, write it as @samp{@@sysconfdir@@}.) - -@c rewritten to avoid overfull hbox --tower -Do not install executables -@c here -in this directory (they probably -belong in @file{$(libexecdir)} or @file{$(sbindir)}). Also do not -install files that are modified in the normal course of their use -(programs whose purpose is to change the configuration of the system -excluded). Those probably belong in @file{$(localstatedir)}. - -@item sharedstatedir -The directory for installing architecture-independent data files which -the programs modify while they run. This should normally be -@file{/usr/local/com}, but write it as @file{$(prefix)/com}. -(If you are using Autoconf, write it as @samp{@@sharedstatedir@@}.) - -@item localstatedir -The directory for installing data files which the programs modify while -they run, and that pertain to one specific machine. Users should never -need to modify files in this directory to configure the package's -operation; put such configuration information in separate files that go -in @file{$(datadir)} or @file{$(sysconfdir)}. @file{$(localstatedir)} -should normally be @file{/usr/local/var}, but write it as -@file{$(prefix)/var}. -(If you are using Autoconf, write it as @samp{@@localstatedir@@}.) - -@item libdir -The directory for object files and libraries of object code. Do not -install executables here, they probably ought to go in @file{$(libexecdir)} -instead. The value of @code{libdir} should normally be -@file{/usr/local/lib}, but write it as @file{$(exec_prefix)/lib}. -(If you are using Autoconf, write it as @samp{@@libdir@@}.) - -@item infodir -The directory for installing the Info files for this package. By -default, it should be @file{/usr/local/info}, but it should be written -as @file{$(prefix)/info}. -(If you are using Autoconf, write it as @samp{@@infodir@@}.) - -@item includedir -@c rewritten to avoid overfull hbox --roland -The directory for installing header files to be included by user -programs with the C @samp{#include} preprocessor directive. This -should normally be @file{/usr/local/include}, but write it as -@file{$(prefix)/include}. -(If you are using Autoconf, write it as @samp{@@includedir@@}.) - -Most compilers other than GCC do not look for header files in -@file{/usr/local/include}. So installing the header files this way is -only useful with GCC. Sometimes this is not a problem because some -libraries are only really intended to work with GCC. But some libraries -are intended to work with other compilers. They should install their -header files in two places, one specified by @code{includedir} and one -specified by @code{oldincludedir}. - -@item oldincludedir -The directory for installing @samp{#include} header files for use with -compilers other than GCC. This should normally be @file{/usr/include}. -(If you are using Autoconf, you can write it as @samp{@@oldincludedir@@}.) - -The Makefile commands should check whether the value of -@code{oldincludedir} is empty. If it is, they should not try to use -it; they should cancel the second installation of the header files. - -A package should not replace an existing header in this directory unless -the header came from the same package. Thus, if your Foo package -provides a header file @file{foo.h}, then it should install the header -file in the @code{oldincludedir} directory if either (1) there is no -@file{foo.h} there or (2) the @file{foo.h} that exists came from the Foo -package. - -To tell whether @file{foo.h} came from the Foo package, put a magic -string in the file---part of a comment---and @code{grep} for that string. -@end table - -Unix-style man pages are installed in one of the following: - -@table @samp -@item mandir -The top-level directory for installing the man pages (if any) for this -package. It will normally be @file{/usr/local/man}, but you should -write it as @file{$(prefix)/man}. -(If you are using Autoconf, write it as @samp{@@mandir@@}.) - -@item man1dir -The directory for installing section 1 man pages. Write it as -@file{$(mandir)/man1}. -@item man2dir -The directory for installing section 2 man pages. Write it as -@file{$(mandir)/man2} -@item @dots{} - -@strong{Don't make the primary documentation for any GNU software be a -man page. Write a manual in Texinfo instead. Man pages are just for -the sake of people running GNU software on Unix, which is a secondary -application only.} - -@item manext -The file name extension for the installed man page. This should contain -a period followed by the appropriate digit; it should normally be @samp{.1}. - -@item man1ext -The file name extension for installed section 1 man pages. -@item man2ext -The file name extension for installed section 2 man pages. -@item @dots{} -Use these names instead of @samp{manext} if the package needs to install man -pages in more than one section of the manual. -@end table - -And finally, you should set the following variable: - -@table @samp -@item srcdir -The directory for the sources being compiled. The value of this -variable is normally inserted by the @code{configure} shell script. -(If you are using Autconf, use @samp{srcdir = @@srcdir@@}.) -@end table - -For example: - -@smallexample -@c I have changed some of the comments here slightly to fix an overfull -@c hbox, so the make manual can format correctly. --roland -# Common prefix for installation directories. -# NOTE: This directory must exist when you start the install. -prefix = /usr/local -exec_prefix = $(prefix) -# Where to put the executable for the command `gcc'. -bindir = $(exec_prefix)/bin -# Where to put the directories used by the compiler. -libexecdir = $(exec_prefix)/libexec -# Where to put the Info files. -infodir = $(prefix)/info -@end smallexample - -If your program installs a large number of files into one of the -standard user-specified directories, it might be useful to group them -into a subdirectory particular to that program. If you do this, you -should write the @code{install} rule to create these subdirectories. - -Do not expect the user to include the subdirectory name in the value of -any of the variables listed above. The idea of having a uniform set of -variable names for installation directories is to enable the user to -specify the exact same values for several different GNU packages. In -order for this to be useful, all the packages must be designed so that -they will work sensibly when the user does so. - -@node Standard Targets -@section Standard Targets for Users - -All GNU programs should have the following targets in their Makefiles: - -@table @samp -@item all -Compile the entire program. This should be the default target. This -target need not rebuild any documentation files; Info files should -normally be included in the distribution, and DVI files should be made -only when explicitly asked for. - -By default, the Make rules should compile and link with @samp{-g}, so -that executable programs have debugging symbols. Users who don't mind -being helpless can strip the executables later if they wish. - -@item install -Compile the program and copy the executables, libraries, and so on to -the file names where they should reside for actual use. If there is a -simple test to verify that a program is properly installed, this target -should run that test. - -Do not strip executables when installing them. Devil-may-care users can -use the @code{install-strip} target to do that. - -If possible, write the @code{install} target rule so that it does not -modify anything in the directory where the program was built, provided -@samp{make all} has just been done. This is convenient for building the -program under one user name and installing it under another. - -The commands should create all the directories in which files are to be -installed, if they don't already exist. This includes the directories -specified as the values of the variables @code{prefix} and -@code{exec_prefix}, as well as all subdirectories that are needed. -One way to do this is by means of an @code{installdirs} target -as described below. - -Use @samp{-} before any command for installing a man page, so that -@code{make} will ignore any errors. This is in case there are systems -that don't have the Unix man page documentation system installed. - -The way to install Info files is to copy them into @file{$(infodir)} -with @code{$(INSTALL_DATA)} (@pxref{Command Variables}), and then run -the @code{install-info} program if it is present. @code{install-info} -is a program that edits the Info @file{dir} file to add or update the -menu entry for the given Info file; it is part of the Texinfo package. -Here is a sample rule to install an Info file: - -@comment This example has been carefully formatted for the Make manual. -@comment Please do not reformat it without talking to roland@gnu.ai.mit.edu. -@smallexample -$(infodir)/foo.info: foo.info -# There may be a newer info file in . than in srcdir. - -if test -f foo.info; then d=.; \ - else d=$(srcdir); fi; \ - $(INSTALL_DATA) $$d/foo.info $@@; \ -# Run install-info only if it exists. -# Use `if' instead of just prepending `-' to the -# line so we notice real errors from install-info. -# We use `$(SHELL) -c' because some shells do not -# fail gracefully when there is an unknown command. - if $(SHELL) -c 'install-info --version' \ - >/dev/null 2>&1; then \ - install-info --dir-file=$(infodir)/dir \ - $(infodir)/foo.info; \ - else true; fi -@end smallexample - -@item uninstall -Delete all the installed files that the @samp{install} target would -create (but not the noninstalled files such as @samp{make all} would -create). - -This rule should not modify the directories where compilation is done, -only the directories where files are installed. - -@item install-strip -Like @code{install}, but strip the executable files while installing -them. The definition of this target can be very simple: - -@smallexample -install-strip: - $(MAKE) INSTALL_PROGRAM='$(INSTALL_PROGRAM) -s' \ - install -@end smallexample - -Normally we do not recommend stripping an executable unless you are sure -the program has no bugs. However, it can be reasonable to install a -stripped executable for actual execution while saving the unstripped -executable elsewhere in case there is a bug. - -@comment The gratuitous blank line here is to make the table look better -@comment in the printed Make manual. Please leave it in. -@item clean - -Delete all files from the current directory that are normally created by -building the program. Don't delete the files that record the -configuration. Also preserve files that could be made by building, but -normally aren't because the distribution comes with them. - -Delete @file{.dvi} files here if they are not part of the distribution. - -@item distclean -Delete all files from the current directory that are created by -configuring or building the program. If you have unpacked the source -and built the program without creating any other files, @samp{make -distclean} should leave only the files that were in the distribution. - -@item mostlyclean -Like @samp{clean}, but may refrain from deleting a few files that people -normally don't want to recompile. For example, the @samp{mostlyclean} -target for GCC does not delete @file{libgcc.a}, because recompiling it -is rarely necessary and takes a lot of time. - -@item maintainer-clean -Delete almost everything from the current directory that can be -reconstructed with this Makefile. This typically includes everything -deleted by @code{distclean}, plus more: C source files produced by -Bison, tags tables, Info files, and so on. - -The reason we say ``almost everything'' is that running the command -@samp{make maintainer-clean} should not delete @file{configure} even if -@file{configure} can be remade using a rule in the Makefile. More generally, -@samp{make maintainer-clean} should not delete anything that needs to -exist in order to run @file{configure} and then begin to build the -program. This is the only exception; @code{maintainer-clean} should -delete everything else that can be rebuilt. - -The @samp{maintainer-clean} target is intended to be used by a maintainer of -the package, not by ordinary users. You may need special tools to -reconstruct some of the files that @samp{make maintainer-clean} deletes. -Since these files are normally included in the distribution, we don't -take care to make them easy to reconstruct. If you find you need to -unpack the full distribution again, don't blame us. - -To help make users aware of this, the commands for the special -@code{maintainer-clean} target should start with these two: - -@smallexample -@@echo 'This command is intended for maintainers to use; it' -@@echo 'deletes files that may need special tools to rebuild.' -@end smallexample - -@item TAGS -Update a tags table for this program. -@c ADR: how? - -@item info -Generate any Info files needed. The best way to write the rules is as -follows: - -@smallexample -info: foo.info - -foo.info: foo.texi chap1.texi chap2.texi - $(MAKEINFO) $(srcdir)/foo.texi -@end smallexample - -@noindent -You must define the variable @code{MAKEINFO} in the Makefile. It should -run the @code{makeinfo} program, which is part of the Texinfo -distribution. - -@item dvi -Generate DVI files for all Texinfo documentation. -For example: - -@smallexample -dvi: foo.dvi - -foo.dvi: foo.texi chap1.texi chap2.texi - $(TEXI2DVI) $(srcdir)/foo.texi -@end smallexample - -@noindent -You must define the variable @code{TEXI2DVI} in the Makefile. It should -run the program @code{texi2dvi}, which is part of the Texinfo -distribution.@footnote{@code{texi2dvi} uses @TeX{} to do the real work -of formatting. @TeX{} is not distributed with Texinfo.} Alternatively, -write just the dependencies, and allow GNU @code{make} to provide the command. - -@item dist -Create a distribution tar file for this program. The tar file should be -set up so that the file names in the tar file start with a subdirectory -name which is the name of the package it is a distribution for. This -name can include the version number. - -For example, the distribution tar file of GCC version 1.40 unpacks into -a subdirectory named @file{gcc-1.40}. - -The easiest way to do this is to create a subdirectory appropriately -named, use @code{ln} or @code{cp} to install the proper files in it, and -then @code{tar} that subdirectory. - -Compress the tar file with @code{gzip}. For example, the actual -distribution file for GCC version 1.40 is called @file{gcc-1.40.tar.gz}. - -The @code{dist} target should explicitly depend on all non-source files -that are in the distribution, to make sure they are up to date in the -distribution. -@ifset CODESTD -@xref{Releases, , Making Releases}. -@end ifset -@ifclear CODESTD -@xref{Releases, , Making Releases, standards, GNU Coding Standards}. -@end ifclear - -@item check -Perform self-tests (if any). The user must build the program before -running the tests, but need not install the program; you should write -the self-tests so that they work when the program is built but not -installed. -@end table - -The following targets are suggested as conventional names, for programs -in which they are useful. - -@table @code -@item installcheck -Perform installation tests (if any). The user must build and install -the program before running the tests. You should not assume that -@file{$(bindir)} is in the search path. - -@item installdirs -It's useful to add a target named @samp{installdirs} to create the -directories where files are installed, and their parent directories. -There is a script called @file{mkinstalldirs} which is convenient for -this; you can find it in the Texinfo package. -@c It's in /gd/gnu/lib/mkinstalldirs. -You can use a rule like this: - -@comment This has been carefully formatted to look decent in the Make manual. -@comment Please be sure not to make it extend any further to the right.--roland -@smallexample -# Make sure all installation directories (e.g. $(bindir)) -# actually exist by making them if necessary. -installdirs: mkinstalldirs - $(srcdir)/mkinstalldirs $(bindir) $(datadir) \ - $(libdir) $(infodir) \ - $(mandir) -@end smallexample - -This rule should not modify the directories where compilation is done. -It should do nothing but create installation directories. -@end table diff --git a/man/new-users-guide/custom1.texi b/man/new-users-guide/custom1.texi deleted file mode 100644 index a5da258..0000000 --- a/man/new-users-guide/custom1.texi +++ /dev/null @@ -1,330 +0,0 @@ -@comment node-name, next, previous, up -@node Customization Basics, Help, Edit, Top -@chapter Customize key bindings and menus -@cindex .emacs -@cindex customize -@findex eval-region - - When you start Emacs, it reads the file @file{~/.emacs} in your home -directory. You can use this file to initialize and customize Emacs to -your liking. This file should contain lisp-code. You can customize your -@file{.emacs} file to create new -menus, disable menus, change key bindings, enable a minor mode, etc. Any -kind of customization affects -only a particular Emacs job that you do them in. If you want to save -your customizations `permanently' i.e. for future use also, you have to -put it in your @samp{.emacs} file. After you make changes to your -@file{.emacs} file and save it, the changes will be effective only after -you start Emacs again i.e. for a new Emacs process. To try out some of -the examples in this section, highlight that region and evaluate the -region by giving the command @kbd{M-x eval-region}. You will be able to -see the results of your customizations in that Emacs session only -(@pxref{Lisp Eval,,,xemacs,XEmacs User's Manual}). - -@comment node-name, next, previous, up -@menu -* Customizing key Bindings:: Changing Key Bindings -* Customizing Menus:: Adding, Deleting, Enabling and Disabling Menus -@end menu - -@node Customizing key Bindings, Customizing Menus, Customization Basics, Customization Basics -@section Customize key bindings -@cindex key bindings -@cindex keystrokes - - Most of Emacs commands use key -sequences. @xref{Keystrokes,,,xemacs,XEmacs User's Manual}, for more -information about Keys and Commands. In Emacs, the keys themselves carry -no meaning unless they are bound to a function. For example, @kbd{C-n} -moves the cursor to the next line because its bound to the function -@b{next-line}. Similarly, @kbd{C-p} moves to the previous line because -its bound to the function @b{previous-line}. The functions themselves -define a particular behavior. You can customize the key @kbd{C-n} to -move to the previous line by binding it to @b{previous-line} and -@kbd{C-p} to move to the next line by binding it to @b{next-line}. To -bind keys to globally run commands you need to use the following syntax -in your @b{.emacs} file: - -@cindex binding keys -@example -@code{(global-set-key @var{keys} @var{cmd})} -@end example -@noindent - Here, @code{global-set-key} is a function which will bind the -@dfn{keys} to the specified @dfn{cmd}. For example, if you type the -following in your @b{.emacs} file: - -@example -(global-set-key "\C-p" 'next-line) -(global-set-key "\C-n" 'previous-line) -@end example - -@noindent -then @kbd{C-p} will move to the next line and @kbd{C-n} to the previous -line. - -You can also disable a key binding, by using @samp{nil} as the @var{cmd} -in the syntax stated above. Here, @samp{nil} stands for @samp{false} -which means disable a command or turn off a feature. If you want to -enable a command or turn on a particular feature use @samp{t} -which stands for @samp{true}. For example, if you do not wish @kbd{C-x -C-c} to @samp{Exit Emacs} you can type the following expression in your -@file{.emacs} file: - -@example -(global-set-key "\C-x\C-c" nil) -@end example - -@noindent -You might want to have this statement in your @file{.emacs} file because -its easy to hit this command by mistake and it could be annoying to exit -Emacs unintentionally. There is a @b{Exit Emacs} option in the @b{File -menu} which you might want to use instead. To make a particular key -undefined you can also use: - -@example -(global-unset-key "\C-x\C-c") -@end example - -@noindent -Now if you use the command @kbd{C-x C-c}, you will get an error saying -that the command is undefined. - - Some other customizations you could try are: -@itemize @bullet - -@item -@example -(global-set-key 'button3 'beginning-of-buffer) -@end example - -@noindent -Now when you press the third button of your mouse, the cursor will be -placed at the @code{beginning-of-buffer}. - -@item -@example -(global-set-key 'f1 'goto-line) -@end example - -@noindent -If you press the @key{F1} key, you will be prompted for a line -number. After you type the line number and hit @key{RET}, the cursor -will be placed on that line number. - -@item -@example -(global-set-key 'f2 'undo) -@end example - -Pressing @key{F2} will undo the last command. If you have a @key{undo} -key on your keyboard, try binding that key to the undo command. -@end itemize - - - Another syntax for customizing key bindings is: -@code{(define-key @var{keymap} @var{keys} @var{def})} -It defines @var{keys} to run @var{def} in the keymap @var{keymap}. - -@var{keymap} is a keymap object which records the bindings of keys to -the commands that they run. - -@var{keys} is the sequence of keystrokes to bind. - -@var{def} is anything that can be a key's definition: - -Look at the following two examples: - -@example -(define-key global-map "\C-xl" 'make-symbolic-link) -(define-key c-mode-map "\C-xl" 'make-symbolic-link) -@end example - -@findex make-symbolic-link -@noindent -Both the examples bind the key @kbd{C-xl} to run the function -@code{make-symbolic-link} (@pxref{Misc File Ops,,,xemacs,XEmacs User's -Manual}). However, the second example will bind the key only for C -mode. @xref{Major Modes,,,xemacs,XEmacs User's Manual}, for more -information on Major Modes in XEmacs. - - - -@comment node-name, next, previous, up -@node Customizing Menus, , Customizing key Bindings, Customization Basics -@section Customizing Menus -@cindex customize menus -@cindex delete menus -@cindex disable menus -@findex add-menu-item -@cindex add menus - -You can customize any of the XEmacs Pull-down-Menus. You can create your -own menu, delete an existing one, enable a menu or disable a menu. For -more information on the default menus available to you, @xref{Pull-down -Menus}. - - Some of the functions which are available to you for customization are: -@enumerate - -@item -add-menu-item: @var{(menu-name item-name function enabled-p -&optional before)} - -This function will add a menu item to a menu, creating the menu first if -necessary. If the named item already exists, the menu will remain -unchanged. For example, if you add the following example to your -@file{.emacs} file or evaluate it (@pxref{Customization Basics}), - -@example -(add-menu-item '("Edit") "Replace String" replace-string t "Clear") -@end example - -@noindent -a sub-menu @b{Replace String} will be created under @b{Edit} menu before the -sub-menu @b{Clear}. The @b{Edit} menu will now look like: - -@example -Undo C-x u -Cut cut -Copy copy -Paste paste -Replace String -Clear -Start Macro Recording C-x( -End Macro Recording C-x) -Execute Last Macro C-xe -@end example - -@noindent -@b{Replace String} will now execute the function -@code{replace-string}. Select this menu item. Emacs will prompt you for -a string name to be replaced. Type a -string and hit @key{RET}. Now type a new string to replace the old -string and hit @key{RET}. All occurrences of the old string will be -replaced by the new string. In this example, - -@samp{Edit} is the @var{menu-name} which identifies the menu into which -the new menu item should be inserted. - -@samp{Replace String} is the @var{item-name} which names the menu item -to be added. - -@samp{replace-string} is the @var{function} i.e. the command to be -invoked when the menu item "Replace String" is selected. - -@samp{t} is the @var{enabled-p} parameter which controls whether the -menu item is selectable or not. This parameter can be either @code{t} (selectable), @code{nil} (not selectable), or a -form to evaluate. This form is evaluated just before the menu is -displayed, and the menu item will be selectable if the form returns -non-@code{nil}. - -@samp{Clear} is the @var{&optional before} parameter which is the name -of the menu before which the new menu or sub-menu should be added. The -@var{&optional} string means that this parameter is optional. You do not -need to specify this parameter. If you do not specify this parameter in -the example above, the @b{Replace String} menu item will be added at the -end of the list of sub-menus in the @b{Edit} menu i.e. after @b{Execute -Last Macro}. - - If you wish to add a new menu to the menubar, try: - -@example -(add-menu-item nil "Bot" 'end-of-buffer t) -@end example - -@noindent -This will create a new menu @b{Bot} on the menu bar. Selecting this menu -will take you to the end of the buffer. Using @code{nil} for the -parameter @var{menu-name} will create a new menu. Your menu-bar -will now look like: - -@example -File Edit Options Buffers Bot Help -@end example - - The following example will illustrate how you can add sub-menus to the -submenus themselves: - -@example -(add-menu-item '("File" "Management") "Copy File" 'copy-file t) -(add-menu-item '("File" "Management") "Delete File" 'delete-file t) -(add-menu-item '("File" "Management") "Rename File" 'rename-file t) -@end example -@noindent - -This will create a sub-menu @b{Management} under the @b{File} -menu. When you select the submenu @b{Management}, it will contain three -submenus: @b{Copy File}, @b{Delete File} and @b{Rename File}. - -@findex delete-menu-item -@cindex deleting menu items -@item -delete-menu-item: @var{(menu-path)} -This function will remove the menu item defined by @var{menu-name} from -the menu hierarchy. Look at the following examples and the comments just -above them which specify what the examples do. - -@example -;; deletes the "Replace String" menu item created earlier -(delete-menu-item '("Edit" "Replace String")) - -;; deletes the "Bot" menu created earlier -(delete-menu-item '("Bot")) - -;; deletes the sub-menu "Copy File" created earlier -(delete-menu-item '("File" "File Management" "Copy File")) - -;; deletes the sub-menu "Delete File" created earlier -(delete-menu-item '("File" "Management" "Delete File")) - -;; deletes the sub-menu "Rename File" created earlier -(delete-menu-item '("File" "Management" "Rename File")) -@end example - - -@findex disable-menu-item -@cindex disabling menu items -@item -disable-menu-item: @var{(menu-name)} -Disables the specified menu item. The following example - -@example -(disable-menu-item '("File" "Management" "Copy File")) -@end example - -@noindent -will make the @b{Copy File} item unselectable. This menu-item would -still be there but it will appear faded which would mean that it cannot -be selected. - -@findex enable-menu-item -@cindex enabling menu items -@item -enable-menu-item: @var{(menu-name)} -Enables the specified previously disabled menu item. - -@example -(enable-menu-item '("File" "Management" "Copy File")) -@end example - -@noindent -This will enable the sub-menu @b{Copy File}, which was disabled by the -earlier command. - -@findex relabel-menu-items -@cindex relabelling menu items -@item -relabel-menu-item: @var{(menu-name new-name)} -Change the string of the menu item specified by @var{menu-name} to -@var{new-name}. - -@example -(relabel-menu-item '("File" "Open...") "Open File") -@end example - -This example will rename the @b{Open...} menu item from the @b{File} -menu to @b{Open File}. - -@end enumerate - diff --git a/man/new-users-guide/custom2.texi b/man/new-users-guide/custom2.texi deleted file mode 100644 index 76d83c0..0000000 --- a/man/new-users-guide/custom2.texi +++ /dev/null @@ -1,441 +0,0 @@ -@comment node-name, next, previous, up -@node Other Customizations, Select and Move, Files, Top -@chapter Other Customizations -@cindex customize -@cindex hook -@cindex font-lock-mode - -You can modify the behavior of Emacs in minor ways permanently by -putting your changes in your @file{.emacs} file. This file contains Lisp -function call expressions. Each of these expressions will consist of a -function name followed by arguments, all surrounded by parentheses. For -example, to turn on the auto-fill-mode (i.e. break lines automatically -when they become too long) , put the following line in your -@file{.emacs} file: - -@example -(add-hook 'text-mode-hook - '(lambda() (auto-fill-mode 1))) -@end example - -@noindent -Emacs has a function named "turn-on-auto-fill" which is defined as -"(lambda() (auto-fill-mode 1))". Therefore you can also write the above -as: - -@example -(add-hook 'text-mode-hook 'turn-on-auto-fill) -@end example - -@noindent -Emacs provides a number of hooks for the sake of customization. The hook -variables contain list of functions to be called with no arguments. To -turn on the auto-fill-mode, add the appropriate hook as shown in the -example above. - -Similarly, to enable the "font-lock mode" which displays your program in -different fonts and colors(@pxref{Modes}), put the following in your -@file{.emacs} file. The comments above the statement explain what the -statements do. - -@example -;;; enables the font-lock-mode in Lisp Mode -(add-hook 'lisp-mode-hook 'turn-on-font-lock) - -;;; enables the font-lock-mode in Texinfo Mode -(add-hook 'texinfo-mode-hook 'turn-on-font-lock) - -;;; enables the font-lock mode in C Mode -(add-hook 'c-mode-hook 'turn-on-font-lock) -@end example - -To turn on the font-lock mode in other Major Modes like emacs-lisp, just -put the name of the mode with "-hook" appended to it as the middle -parameter in the above examples. You can also select the color that the -functions, comments or other keywords should be displayed in : - -@example -;;; the function names will now be displayed in blue color -(set-face-foreground 'font-lock-function-name-face "blue") - -;;; the comments will be displayed in forest green - (set-face-foreground 'font-lock-comment-face "forest green") -@end example - -@noindent -For other customizations regarding the font-lock face, look at the file -@file{/usr/local/lib/xemacs-19.11/etc/sample.emacs}. - - - -@comment node-name, next, previous, up -@menu -* Setting Variables:: Customizing Emacs variables -* Init File:: Some examples of Lisp expressions in - .emacs file -@end menu - -@node Setting Variables, Init File, Other Customizations, Other Customizations -@section Other Customizations -@cindex setting variables -@findex describe-variable - -In XEmacs, @dfn{variables} are used for internal record-keeping and -customizations. There are some variables called "options" which you can -use for customizations. To examine a variable use: - -@example -;;; print the value and documentation of the variable, use either of the -;;; following commands -C-h v -M-x describe variable -@end example - -After you type any of the above commands, you will be prompted for a -variable name in the @dfn{echo area}. Type in the name of the variable, -for example, type @var{case-fold-search} @key{RET} -Your window will split into two and you will see the following message -in that window: - -@example -case-fold-search's value is t -This value is specific to the current buffer. - -Documentation: -*Non-nil if searches should ignore case. -Automatically becomes buffer-local when set in any fashion. - -@end example - -@noindent -Since this variable's value is 't' searches will ignore case. If you -want case-sensitive-search (i.e. if you are searching for "Foo" and you do -not want "foo" to be included in the search, you need to set this -variable to "nil". In order to do that, use: - -@findex set-variable -@example -M-x set-variable -@end example - -@noindent -Emacs will prompt you for the variable which you wish to set. Type in -"case-fold-search" and hit @key{RET}. You will see the following -message: - -@example -Set case-fold-search to value: -@end example - -@noindent -Type "nil" and hit @key{RET}. Now if you again use @kbd{M-x describe -variable} , you will see that the new value of case-fold-search will be -"nil" and your searches will be case-sensitive. This will be effective -only for that Emacs session. If you want to change the value of a -variable permanently put the following statement in your @file{.emacs} -file : - -@example -(setq case-fold-search nil) -@end example - -@noindent -This statement will make searches case-sensitive only in the current -buffer which is the @file{.emacs} file. This will not be very useful. To -make searches case-sensitive globally in all buffers, use: - -@example -(setq-default case-fold-search nil) -@end example - -If you want to change the value of any other variable, use : - -@example -(setq ) -@end example - -@noindent -"setq" will assign the "new value" to the "variable-name" . - - -If you want a list of the "options" i.e. the variables available for -customization type: - -@findex list-options -@findex edit-options -@example - -;;; displays a buffer listing names, values and documentation of options -M-x list-options - -;;; displays options and allows you to edit those list of options -M-x edit-options - -@end example - -@noindent -Try these options. If you are using edit-options to edit a variable, -just point at the variable you wish to edit and use one of the following -commands: - -@table @b -@item 1 -Set the value of the variable to t (non-nil). -@item 0 -Set the value of the variable to nil. -@item n -Move to the next variable. -@item p -Move to the previous variable. -@end table - - -There are some other options available to make the value of a variable -local to a buffer and then to switch to its global value. You can also -have a @dfn{local variables list} in a file which specifies the values -to use for certain Emacs variables when you edit that -file. @xref{Variables,,,xemacs,XEmacs User's Manual}, for information on -these options. - - -@comment node-name, next, previous, up -@node Init File, , Setting Variables, Other Customizations -@section Init File Examples -@cindex init file examples - - For customizing Emacs, you need to put Lisp expressions in your -@file{.emacs} file. The following are some useful Lisp expressions. If -you find any of them useful, just type them in your @file{.emacs} file: - -@itemize @bullet -@item -The following expression will make @key{TAB} in C mode insert a real tab -character if the cursor or point is in the middle of the line. Now -hitting the @key{TAB} key will indent a line only if the cursor is at -the left margin or in the line's indentation: - -@example -(setq c-tab-always-indent nil) -@end example - -@noindent -The value of the variable @var{c-tab-always-indent} is usually @samp{t} -for @samp{true}. When this variable is true, then hitting the @key{TAB} -key always indents the current line. - -@item -This expression will turn on the @var{auto-fill-mode} when you are in -text mode: - -@example -(setq text-mode-hook 'turn-on-auto-fill) -@end example - -This mode will automatically break lines when you type a space so that -the lines don't become too long. The length of the lines is controlled -by the variable @var{fill-column}. You can set this variable to a value -you wish. Look at the documentation for this variable to see its default -value. To change the value to 75 for example, use: - -@vindex fill-column -@example -(setq-default fill-column 75) -@end example - -@noindent -This will change the value of this variable globally. - -@item -@findex eval-expression -The following expression will enable the use of @var{eval-expression} -without confirmation: - -@example -(put 'eval-expression 'disabled nil) -@end example - -@noindent -Now when you use @var{eval-expression}, it will print the value of the -expression you specify in the @dfn{echo area} without confirming with -you. - -@item -This expression will remove the binding of @kbd{C-x C-c}, because its -easy to hit this key by mistake and you will exit Emacs -unintentionally. You can use the @b{Exit Emacs} option from the @b{File} -menu to exit Emacs. - -@example -(global-set-key "\C-x\C-c" nil) -@end example - -@noindent -Now if you type @kbd{C-x C-c}, you won't exit Emacs. - -@item -The following expression will make the @key{BACKSPACE} and the @key{DEL} -key work in the same manner: - -@example -(global-set-key 'backspace [delete]) -@end example - -@item -This expression will make searches case sensitive: - -@example -(setq-default case-fold-search nil) -@end example - -@noindent -If we use "setq" instead of "setq-default" then searches will be -case-sensitive only in the current buffer's local value. In this case the -buffer would be the @file{.emacs} file. Since this would not be too -helpful and we want to have case-sensitive searches in all buffers, we -have to use "setq-default". - -@item -This expression will enable the font-lock mode when you are using -texinfo mode: - -@example -(add-hook 'texinfo-mode-hook 'turn-on-font-lock) -@end example - -@noindent -@xref{Minor Modes}, for information on font-lock mode. - -@item -Rebinds the key @kbd{C-x l} to run the function -@code{make-symbolic-link}: - -@example -(global-set-key "\C-xl" 'make-symbolic-link) -@end example - -@noindent -We use the single quote before "make-symbolic-link" because its a -function name. You can also use the following expression which does the -same thing: - -@example -(define-key global-map "C-xl" 'make-symbolic-link) -@end example - -@item -The following expression will bind @kbd{C-x l} to run the function -@code{make-symbolic-link} in C mode only: - -@example -(define-key c-mode-map "C-xl" 'make-symbolic-link) -@end example - -@noindent -Instead of binding @kbd{C-xl} to run @code{make-symbolic-link}, you can -bind the @key{F1} key to run this function: - -@example -(define-key c-mode-map 'f1 'make-symbolic-link) -@end example - -@noindent -Here, you have to use lower case for naming function keys like @key{F1}. - -@item -You can bind the function @code{undo} i.e. @kbd{C-x u} to any key, for -example to @key{F2}: - -@example -(global-set-key 'f2 'undo) -@end example - -@item -The following statement will display the current time in the modeline of -the buffer: - -@vindex display-time -@cindex displaying time -@example -(display-time) -@end example - -@item -This displays the current line number on which the cursor is present in -the modeline: - -@example -(setq line-number-mode t) -@end example - -@item -If you don't want the text to be highlighted when you use commands for -marking regions so as to use the @dfn{kill} and @dfn{yank} commands -later, you can use the following expression in your @file{.emacs} file: - -@vindex zmacs-regions -@example -(setq zmacs-regions nil) -@end example - -@noindent -Now if you use a command like @kbd{C-x C-p} (@code{mark-page}), the text -will not be highlighted. - -@item -To control the number of buffers listed when you select the @b{Buffers} -menu, you need to set the variable @var{buffers-menu-max-size} to -whatever value you wish. For example, if you want 20 buffers to be listed -when you select @b{Buffers} use: - -@vindex buffers-menu-max-size -@example -(setq buffers-menu-max-size 20) -@end example - -@item -If you want the window title area to display the full directory/name of -the current buffer's file, and not just the name, use: - -@vindex frame-title-format -@example -(setq frame-title-format "%S: %f") -@end example - -@item -To get rid of the menu, use : - -@example -(set-menubar nil) -@end example - -@item -If you want an extensive menu-bar use the following expression in your -@file{.emacs} file. - -@example -(load "big-menubar") -@end example - -@noindent -If you want to write your own menus, you can look at some of the -examples in -@file{/usr/local/lib/xemacs-20.0/lisp/packages/big-menubar.el} file. - -@end itemize - - For more information on initializing your @file{.emacs} file, -@xref{Init File,,,xemacs,XEmacs User's Manual}. You should also look at -@file{/usr/local/lib/xemacs-20.0/etc/sample.emacs}, which is a sample -@file{.emacs} file. It contains some of the commonly desired -customizations in Emacs. - - - - - - - - - - - diff --git a/man/new-users-guide/edit.texi b/man/new-users-guide/edit.texi deleted file mode 100644 index 536d32f..0000000 --- a/man/new-users-guide/edit.texi +++ /dev/null @@ -1,301 +0,0 @@ -@comment node-name, next, previous, up -@node Edit, Customization Basics, Windows and Menus, Top -@chapter Basic Editing Commands - -@kindex C-h t -@findex help-with-tutorial - This chapter will introduce you to some basic editing commands. You -can also learn the basic editing commands by typing @kbd{Control-h t} -(@code{help-with-tutorial} OR by selecting @b{Emacs Tutorial} from the -@b{Help} menu on the menu bar. Most of the Emacs commands will use the -@key{CONTROL} key or the @key{META} key. The following abbreviations -will be used for the @key{CONTROL} and @key{META} key in this manual: - -@table @kbd -@item C- -This means that you should hold down the @key{CONTROL} key while typing -@kbd{}. For example, if the command is @kbd{C-g}, you should hold -the @key{CONTROL} key and type @key{g}. -@item M- -This means that you should hold down the @kbd{META} key while typing -@kbd{}. If there is no @kbd{META} key on your keyboard, use the -@kbd{ESC} key instead. For example, if the command is @kbd{M-x}, then -type @kbd{ESC}, release it and type @kbd{x}. -@end table - - The following abbreviations will be used for some other keys: - -@table @key -@item SPC -Space bar. -@item RET -Return key. -@item LFD -Linefeed key. -@item TAB -Tab. -@item ESC -Escape. -@item SFT -Shift. -@end table - -@comment node-name, next, previous, up -@menu -* Insert:: Insert text in Emacs by simply typing at - the cursor position. -* Cursor Position:: Moving Around the cursor in the buffer, -* Erase:: Different commands for erasing text -* Numeric Argument:: Giving Numeric Arguments to commands -* Undo:: Undoing Changes made by mistake -@end menu - -@node Insert, Cursor Position, Edit, Edit -@section Inserting Text - -@cindex insertion -@cindex overstrike - To insert printing characters into the text you are editing, just -type them. Emacs will automatically insert the characters that you type -into the buffer at the cursor. The cursor moves forward, but if you -prefer to have text characters replace (overwrite) existing text -characters, you can enable the @b{Overstrike} option from the -@b{Options} menu in the menu bar. - -@kindex DEL -@cindex deletion - To @dfn{delete} text you have just inserted, use @key{DEL}. -@key{DEL} deletes the character @var{before} the cursor (not the one -that the cursor is on top of or under; that is the character @var{after} -the cursor). The cursor and all characters after it move backwards. -Therefore, if you type a printing character and then type @key{DEL}, -they cancel out. - -@kindex RET -@cindex newline -@findex auto-fill-mode - To end a line and start typing a new one, type @key{RET}. This -inserts a newline character in the buffer. If point is in the middle of -a line, @key{RET} splits the line. Typing @key{DEL} when the cursor is -at the beginning of a line rubs out the newline before the line, thus -joining the line with the preceding line. - - Emacs automatically splits lines when they become too long, if you -turn on a special mode called @dfn{Auto Fill} mode. -@xref{Filling,,,xemacs,XEmacs User's Manual}, for information on using Auto Fill -mode. - - -@comment node-name, next, previous, up -@node Cursor Position, Erase, Insert, Edit -@section Moving Around -@cindex cursor control -@cindex cursor position - - The following commands will allow you to move the cursor around the -screen. The actual function names corresponding to these commands are -given in parenthesis. You can also invoke these commands by typing -@kbd{M-x }. You can do this for any command in XEmacs. - -@kindex C-a -@kindex C-e -@kindex C-fx -@kindex C-b -@kindex C-n -@kindex C-p -@kindex C-v -@kindex M-v -@kindex C-t -@kindex M-> -@kindex M-< -@findex beginning-of-line -@findex end-of-line -@findex forward-char -@findex backward-char -@findex next-line -@findex previous-line -@findex transpose-chars -@findex beginning-of-buffer -@findex end-of-buffer -@findex goto-char -@findex goto-line -@table @kbd -@item C-b -Move the cursor backward one character (@code{backward-char}). -@item C-f -Move the cursor forward one character (@code{forward-char}). -@item C-p -Move the cursor up one line vertically (@code{previous-line}). -@item C-n -Move the cursor down one line vertically (@code{next-line}). -@item C-a -Move the cursor to the beginning of the line (@code{beginning-of-line}). -@item C-e -Move the cursor to the end of the line (@code{end-of-line}). -@item M-f -@findex forward-word -Move the cursor forward one word (@code{forward-word}). -@item M-b -@findex backward-word -Move the cursor backword one word (@code{backward-word}). -@item M-< -Move the cursor to the top of the buffer (@code{beginning-of-buffer}). -@item M-> -Move the cursor to the end of the buffer (@code{end-of-buffer}). -@item M-x goto-char RET RET -To enable this command type @kbd{M-x goto-char}, and hit @key{RETURN} -key. In the @dfn{echo area} you will see: - -@example -Goto char: -@end example - -@noindent -You should then type in a number right after the colon -and hit the @kbd{RETURN} key again. After reading a number @var{n} this -command will move the cursor to character number @var{n}. -Position 1 is the beginning of the buffer. For example, if you type -@kbd{M-x goto-char RET 200 RET}, then the cursor will move to the 200th -character starting from the beginning of the buffer. - -@item M-x goto-line RET RET -@cindex goto-line -To enable this command type @kbd{M-x goto-line}, and hit the -@key{RETURN} key. After you see @kbd{Goto line:} in the @dfn{echo area}, -type in a number @var{n} and hit @key{RETURN} key again. This command will -position the cursor on the nth line starting from the beginning of the -buffer. -@item M-x what-line RET -This command will display the current line number in the echo area. - -@end table - - -@comment node-name, next, previous, up -@node Erase, Numeric Argument, Cursor Position, Edit -@section Erasing Text - -@cindex erasing -@cindex deleting -@kindex C-d -@kindex C-k -@kindex M-d -@kindex M-DEL -@kindex M-k -@kindex M-z -@findex delete-backward-char -@findex delete-char -@findex kill-line -@findex kill-word -@findex backward-kill-word -@findex kill-sentence -@findex zap-to-char - -@table @kbd -@item @key{DEL} -If you press @key{DEL} i.e. the @dfn{delete} key, it will delete the -character before the cursor (@code{delete-backward-char}). -@item C-d -This will delete the character after the cursor (@code{delete-char}). -@item C-k -Kill to the end of the line (@code{kill-line}). If you kill the line by -mistake you can @dfn{yank} or @samp{paste} it back by typing -@kbd{C-y}. @xref{Moving Text}, for more information on yanking. -@item M-d -Kill forward to the end of the next word (@code{kill-word}). -@item M-@key{DEL} -Kill back to the beginning of the previous word -(@code{backward-kill-word}). -@item M-k -Kill to the end of current sentence (@code{kill-sentence}). -@item M-z @var{char} -Kill up to next occurrence of @var{char} (@code{zap-to-char}). To use -this command type @kbd{M-z}. You will see the following statement in the -echo area : - -@example -Zap to char: -@end example - -Type any char and press the @key{RET} key. For example, if you type -@samp{p} then the entire text starting from the position of the cursor -until the first occurrence of @samp{p} is killed. -@end table - - -@comment node-name, next, previous, up -@node Numeric Argument, Undo, Erase, Edit -@section Giving Numeric Arguments -@cindex numeric argument -@cindex digit argument -@cindex negative argument -@kindex C-u -@kindex M-@t{-} - - Any Emacs command can be given a @dfn{numeric argument}. Some commands -interpret the argument as a repetition count. For example, if you want -to move forward ten characters, you could type @kbd{C-f} ten -times. However, a more efficient way to do this would be to give an -argument of ten to the key @kbd{C-f} (the command @code{forward-char}, move -forward one character). Negative arguments are also allowed. Often they tell -a command to move or act backwards. For example, if you want to move -down ten lines, type the following: -@example -C-u 10 C-n RET -@end example -@noindent -After you press @key{RET} key, the cursor will move ten lines -downward. You can also type: -@example -M-10 C-n RET -@end example -@noindent -Both @kbd{C-u} and @kbd{M-} allow you to give numeric arguments. If you -want to move ten lines backward, you can also give negative arguments, like: -@example -C-u -10 C-n RET -@end example -@noindent -OR you could also type: -@example -M--10 C-n RET -@end example -@noindent -You can obviously use @kbd{C-b} to move backward rather than giving -negative arguments to @kbd{C-n}. @xref{Numeric Arguments,,,xemacs,XEmacs -User's Manual}, for more information on numeric arguments. - -@comment node-name, next, previous, up -@node Undo, , Numeric Argument, Edit -@section Undoing Changes -@cindex undo -@cindex mistakes, correcting - - When you are editing a buffer, you might type something by -mistake. Emacs allows you to undo all changes you make to a buffer (but -not more than 8000 characters). Each buffer in Emacs keeps a record of -the changes made to it individually, so the undo command applies to the -current buffer. There are two undo commands: - -@table @kbd -@kindex C-x u -@item C-x u -Undo one batch of changes (usually, one command's worth). -(@code{undo}). -@item C-_ -The same as above, but this command might not be obvious to type on some -keyboards so it might be better to use the above command. -@end table - - @xref{Undoing Changes,,,xemacs,XEmacs User's Manual}, for more information on -undoing changes. - - - - - - - - - - diff --git a/man/new-users-guide/files.texi b/man/new-users-guide/files.texi deleted file mode 100644 index d7219b1..0000000 --- a/man/new-users-guide/files.texi +++ /dev/null @@ -1,254 +0,0 @@ -@comment node-name, next, previous, up -@node Files, Other Customizations, Modes, Top -@chapter Files -@cindex files - - The basic unit of stored data in Unix is the @dfn{file}. To edit a file, -you must tell Emacs to read the file into a buffer. This is called -@dfn{visiting} the file. You can now edit the buffer and to save the -changes you must write the buffer back to the file. - - In addition to visiting and saving files, Emacs can delete, copy, rename, -and append to files, and operate on file directories. - -@comment node-name, next, previous, up -@menu -* File Names:: How to type and edit file name arguments. -* Visiting:: Visiting a file prepares Emacs to edit the file. -* Saving Files:: How to save Emacs files. -@end menu - -@node File Names, Visiting, Files, Files -@section File Names -@cindex file names - - Most of the Emacs commands that operate on a file require you to -specify a file name. For example, you might specify the file name -initially when you enter Emacs : - -@example -xemacs myfile RET -@end example - -@noindent -After you hit @key{RET}, you will enter XEmacs with "myfile" read into -the current buffer. If you do not specify the filename when entering -Emacs, you can use the @b{Open...} option from the @b{File} menu. You -will be prompted for a filename in the echo area: - -@example -Find file: /usr/workspace/ -@end example - -@vindex default-directory -@noindent -Type in a file name which you want to open after the "/" and hit -@key{RET}. The specified file will be read into the current buffer. The -"/usr/workspace" might be the @dfn{default directory}. When Emacs -prompts you for a file, it uses the default-directory unless you specify -a directory. You can see what the default directory of the current -buffer is by using the @b{Describe Variable} option from the @b{Help} -menu. When Emacs prompts you for the variable name to describe, type -@var{default-directory}. If you wish to open a file in some other -directory, use @key{DEL} or the @key{BackSpace} key to go back and type -the path name of the new directory. - - You can create a new directory by typing @kbd{M-x -make-directory}. This command will prompt you for a directory name: - -@example -Create directory: /usr/workspace/ -@end example - -@findex make-directory -@findex remove-directory -@cindex creating-directories -@cindex removing-directories -@noindent -After you type a directory name and press @key{RET}, a new directory -with the specified name will be created. If you do not wish to create a -new directory, then simply press @kbd{C-g} to quit the -command. Similarly, you can also remove a directory by using the command -@kbd{remove-directory}. The command @kbd{M-x pwd} will print the current -buffer's default directory. For more information on file names, -@xref{File Names,,,xemacs,XEmacs User's Manual}. - - -@node Visiting, Saving Files, File Names, Files -@section Visiting Files -@cindex visiting files - - To edit a file in Emacs you need to @dfn{visit} it. @dfn{Visiting} a -file means copying its contents (or reading them) into the current -buffer. Emacs will create a new buffer for each file that you visit. The -buffer will be named after the file that you open. If you open a file -@file{/usr/workspace/myfile.texinfo}, the buffer will be called -"myfile.texinfo". If a buffer with this name already exists, a unique -name will be constructed by appending @samp{<2>}, @samp{<3>}, etc. If -this is the second buffer with the same name, a "<2>" will be appended, -"<3>" for a third buffer and so on. The name of the buffer which is -being displayed in the window will be shown both at the top and bottom -of the frame. Once you are in XEmacs, you can use the following -commands: - -@table @kbd -@item C-x C-f -@findex find-file -@kindex C-x C-f -This command will visit a file (@code{find-file}). It will prompt you -for a file name to visit. The @b{Open...} option from the @b{File} menu -does the same thing: - -@example -Find file: /usr/workspace/ -@end example - -@noindent -Type in a filename and press @key{RET}. You will see a new buffer on the -screen with its name in the mode-line. If the filename you specify -already exists in Emacs, the buffer containing that file will be -selected. You will get an error message if the filename does not -exist. If you still press @key{RET}, a new buffer with the given -filename will be displayed on the screen. - -@item C-x C-v -@kindex C-x C-v -@findex find-alternate-file -This command (@code{find-alternate-file}), will visit a different file -instead of the one visited last. It is similar to @kbd{C-c C-f} except -that it kills the current buffer (after offering to save it). - -@item C-x 5 C-f -@kindex C-x 5 C-f -@findex find-file-other-frame -This command will visit a file in another frame -(@code{find-file-other-frame}) without changing the current window or -frame. The @b{Open in New Frame...} from the @b{File} menu will do the -same thing. It will prompt you for a file name in the echo area. After -you type the file name and press @key{RET}, the specified file will be -read into a new buffer and displayed on a new frame. -@end table - -@node Saving Files, , Visiting, Files -@section Saving Files -@cindex saving files - - The changes that you make after visiting a file will not be saved -unless you save the buffer. When you save the buffer, Emacs writes the -current contents of the buffer into the visited file. Some commands to -save buffers are: - -@table @kbd -@item C-x C-s -@findex save-buffer -@kindex C-x C-s -This command will permanently save the current buffer in its visited -file (@code{save-buffer}). You will see the following message in the -echo area if you save a file called "myfile.texinfo" : - -@example -Wrote /usr/workspace/myfile.texinfo -@end example - -@noindent -Try using this command twice. You will get the above message the first -time you use this command, the second time you will get the following -message: - -@example -(No changes need to be saved) -@end example - -@noindent -This message indicates that you haven't made any changes since the last -time you saved the file. - -@item C-x s -@kindex C-x s -@findex save-some-buffers -This command will save all the buffers in their visited files -(@code{save-some-buffers}). It will prompt you for typing yes or no: - -@example -Save file /usr/workspace/myfile.texinfo? (y or n) -@end example - -@noindent -You will get the above message for all the buffers. Type "y" if you want -to save the buffer. - -@item C-x C-w -@findex write file -@kindex C-x C-w -This command will prompt you for a file name and save the current buffer -in that file. (@code{write-file}). You will see the following message in -the echo area: - -@example -Write file: /usr/workspace/ -@end example - -@noindent -After you type in a file name, press @key{RET}. The buffer will be saved -in a new file. You can make copies of a particular file using this -command. -@end table - - You can also undo all the changes made since the file was visited or -saved by reading the text from the file again (called -@dfn{reverting}). For more information on this option, -@xref{Reverting,,,xemacs,XEmacs User's Manual}. - -@vindex make-backup-files - When you save a file in Emacs, it destroys its old contents. However, -if you set the variable @var{make-backup-files} to non-@var{nil} -i.e. @samp{t}, Emacs will create a @dfn{backup} file. Select the -@b{Describe variable} option from the @b{Help} menu and look at the -documentation for this variable. Its default value should be -@samp{t}. However, if its not then use @kbd{M-x set-variable} to set it -to @samp{t} (@pxref{Setting Variables}). The backup file will contain -the contents from the last time you visited the file. Emacs also -provides options for creating numbered backups. For more information on -backups, @xref{Backup,,,xemacs,XEmacs User's Manual}. - -@cindex auto saving - Emacs also saves all the files from time to time so that in case of a -system crash you don't lose lot of your work. You will see the message -@samp{Auto-saving...} displayed in the echo area when the buffer is -being saved automatically. The auto saved files are named by putting the -character @samp{#} in front and back. For example a file called -"myfile.texinfo" would be named as @file{#myfile.texinfo#}. For -information on controlling auto-saving and recovering data from -auto-saving, @xref{Auto Save Files,,,xemacs,XEmacs User's Manual}. - -@cindex simultaneous editing - Emacs provides protection from simultaneous editing which occurs if -two users are visiting the same file and trying to save their -changes. It will put a lock on a file which is being visited and -modified. If any other user tries to modify that file, it will inform -the user about the lock and provide some -options. For more information on protection against simultaneous -editing, @xref{Interlocking,,,xemacs,XEmacs User's Manual}. - - - - - - - - - - - - - - - - - - - - - - - diff --git a/man/new-users-guide/help.texi b/man/new-users-guide/help.texi deleted file mode 100644 index 5225804..0000000 --- a/man/new-users-guide/help.texi +++ /dev/null @@ -1,187 +0,0 @@ -@comment node-name, next, previous, up -@node Help, Modes, Customization Basics, Top -@chapter Help -@cindex help - - -XEmacs provides a comprehensive Help facility. On the extreme right of -the menu-bar there is a @b{Help} menu. There are several help commands -provided by this menu. You can also use @kbd{C-h} for invoking the Help -facility. Type "?" for a list of keys you can type after typing -@kbd{C-h}. If you want more information on what your options are and -what kind of help you can get type "?" again. You will get a listing of -all the keys you can type and what they will do. Initially if you want -help, type @kbd{C-h} three times. - -@comment node-name, next, previous, up -@menu -* The Help Menu:: Items on the Help menu -@end menu - -@node The Help Menu, , Help, Help -@section Help menu -@cindex help - -When you click on the Help menu with any of the mouse buttons you will -get the following menu items: - -@table @b -@item Info -Selecting this item will take you to the Info page which is the online -documentation browsing system. You can simply click on the highlighted -items and "Info" will take you to the document providing information -about that topic. - -@item Describe Mode -After you select this item, you will get a documentation on the major -and minor modes which are enabled in the buffer you are working -with. @xref{Modes}, for information on Modes. - -@item Hyper Apropos... -After you select this item, you will see the following message in the -echo area: - -@example -List symbols matching regexp: -@end example - -@noindent -If you type "mode" and hit @key{RET}, you will get a list of all the -symbols (like functions and commands). You can now get documentation on -any of the given symbols by "clicking" on any of the symbols (i.e. drag -your mouse on the appropriate symbol and release the button). For -example, if you "click" on the 'auto-fill-mode' you will get the -following message in the window at the bottom: - -@example -auto-fill-mode - -Function, Command: - - Toggle auto-fill mode. - With arg, turn auto-fill mode on if and only if arg is positive. - In auto-fill mode, inserting a space at a column beyond `fill-column' - automatically breaks the line at a previous space. - -Variable: - - value = nil - - variable not documented -@end example - -@item Command Apropos... -Selecting this item will prompt you for a string just like when you -select @b{Hyper Apropos...}. After you give a string name, you will get -a listing of all the functions and commands containing that string name -with a very short description about what that command does. - -@item Full Apropos... -After you select this item, you will be prompted for a string name in -the echo area: - -@example -Apropos (regexp): -@end example - -@noindent -Now you can give any string name, for example "mode" and hit -@key{RET}. You will get a listing of all the variables and commands -containing that string i.e "mode" with a short description of its -function. - -@item List Keybindings -Select this item and you will get a listing of all the keys and the -commands that they execute. Depending on which Major mode your buffer is -in, you will get a listing of the special keybindings for that -particular buffer also. For example, if you are in "Texinfo" mode, part -of your list will contain: - -@example -C-c C-c n texinfo-insert-@@node -C-c C-c o texinfo-insert-@@noindent -C-c C-c s texinfo-insert-@@samp -C-c C-c t texinfo-insert-@@table -C-c C-c v texinfo-insert-@@var -C-c C-c x texinfo-insert-@@example -C-c C-c @{ texinfo-insert-braces -@end example -@noindent -These keybindings apply only to "Texinfo" mode. @xref{Modes}, for more -information on various modes. - -@item Describe Key... -After you select this item, you will be see the following message in the -echo area: - -@example -Describe Key: -@end example -After you type a command key sequence, full documentation of that -command will be displayed. For example if you type @kbd{C-g}, you will -see the following documentation for @kbd{C-g}: - -@kindex C-g -@example -keyboard-quit: -Signal a `quit' condition. -@end example -This means that @kbd{C-g} will quit whatever command you gave earlier. - -@kindex C-h d -@item Describe Function... -This menu item provides documentation for a function. After you select -this item, it will prompt you for a function name in the echo area: - -@example -Describe function (default ): -@end example -@noindent -If you hit @key{RET} without giving a function name, you will get -documentation for that default function name, otherwise if you type a -function name and hit @key{RET}, you will get documentation for the -given function. - -@kindex C-h k -@item Describe Variable... -You can get documentation on any variable by selecting this menu -item. It is similar to @b{Describe Function} and will prompt you for a -variable name. - -@item Unix Manual... -After you select this item you will be prompted for a Unix command for -which you wish to see the man page. You will see the following message -in the echo area: - -@example -Manual entry: (default ) -@end example -@noindent -Now you can type any command, for example type @samp{who} and press -@key{RET}. You will get the man page for the Unix command @samp{who} which -lists who is on the system. - -@item Emacs Tutorial -Select this item and you will get a tutorial on Emacs. It is good for new -users. - -@item Emacs News -Select this item and you will get a lot of historical and current news -on Emacs ! - -@end table - -For more information on the Help facility, @xref{Help,,,xemacs,XEmacs -User's Manual}. - - - - - - - - - - - - diff --git a/man/new-users-guide/modes.texi b/man/new-users-guide/modes.texi deleted file mode 100644 index 289e31d..0000000 --- a/man/new-users-guide/modes.texi +++ /dev/null @@ -1,250 +0,0 @@ -@comment node-name, next, previous, up -@node Modes, Files, Help, Top -@chapter Major and Minor Modes -@cindex modes - -XEmacs is @dfn{language sensitive}. It has several @dfn{major} and -@dfn{minor} modes. The major modes customize Emacs to edit text of a -particular sort. There are major modes for C, Lisp, Emacs Lisp, LaTeX, -English etc. Within each major mode, certain functions and keys are -redefined to "suit" that particular sort of text. The minor modes -provide certain features which can be turned off or on at any -time. Emacs can only be in one major mode at any time, but it can turn -on several minor modes at the same time. After you have selected any -major or minor mode, you can select @b{Describe Mode} from the @b{Help} -menu and you will get documentation about those modes. - -@comment node-name, next, previous, up -@menu -* Major Modes:: Choosing Major Modes -* Minor Modes:: Auto-Fill, Abbrev and other minor modes -@end menu - -@node Major Modes, Minor Modes, Modes, Modes -@section Major Modes -@cindex major modes - -Emacs has several major modes which customize Emacs to edit text of -various sorts. You can have only one major mode at any time. Within each -major mode, Emacs redefines certain functions (like cursor movement, -indentation and text killing) to suit the needs of the text being -edited. When you are editing a specific type of text you should switch -to the appropriate mode. If you are working with C code, you should -switch to C mode; if you are working with Lisp code, then switch to lisp -mode and if you are working with English text switch to Text mode. - - When you open a file to work on, Emacs usually selects the -appropriate mode. For example, if you open a file called @file{guide.c} -then Emacs will select the C mode because of the ".c" extension of the -file. To explicitly select a mode type the following command: - -@example -;;; selects lisp mode -M-x lisp-mode - -;;; selects C mode -M-x c-mode -@end example - -@noindent -To select any other mode, just add the major mode name before the -'-mode'. The current mode in which you are in will be displayed in -parenthesis in the mode-line at the bottom of the frame. All major -modes have some special keybindings and you can get a listing of those -keybindings by selecting @b{List Keybindings} from the @b{Help} menu on -the menu bar. - - Some of the available modes in XEmacs are : - -@table @b -@item fundamental-mode -@cindex fundamental-mode -When you start XEmacs, usually you start with the default "Fundamental" -mode. This mode has no special definitions or settings. - -@item nroff-mode -@cindex nroff-mode -Use this mode when you have to format a text with nroff before it can be -available in readable form. It redefines some indentation -commands. @xref{Nroff Mode,,,xemacs,XEmacs User's Manual}, for information -on this mode. - -@item tex-mode -@cindex tex-mode -Use this mode if you are using the LaTeX text-formatter. It provides -commands for insertion of quotes, braces and other characters. It also -allows you to format the buffer for printing. @xref{TeX -Mode,,,xemacs,XEmacs User's Manual}, for information on this mode. - -@item texinfo-mode -@cindex texinfo-mode -Texinfo is a documentation system that uses a single source file to -produce both printed output and on-line documentation. When you use this -mode, there will be some special keybindings for inserting some -characters and executing some commands. - -@ifinfo -This info file which you are reading right now is produced by 'Texinfo' -@end ifinfo -@iftex -This manual itself is produced by 'Texinfo' -@end iftex - -@item outline-mode -@cindex outline-mode -Use this mode for editing outlines. When you enable this mode, you can -make part of the text temporarily invisible so that you can see the -overall structure of the outline. @xref{Outline Mode,,,xemacs,XEmacs User's -Manual}, for information on this mode. - -@item c-mode -@cindex c-mode -Use this mode for C programs. It will redefine some indentation -commands. @xref{C Indent,,,xemacs,XEmacs User's Manual}. - -@item lisp-mode -@cindex lisp-mode -Use this mode for Lisp programs. Look at the XEmacs User's Manual for -more information. - -@item fortran-mode -@cindex fortran-mode -Use this mode for Fortran programs. This mode provides special commands -to move around and some other indentation commands. For more -information on this mode, @xref{Fortran,,,xemacs,XEmacs User's Manual}. - -@item edit-picture -@cindex edit-picture -This is the picture mode which you can use to create a picture out of -text characters. @xref{Picture,,,xemacs,XEmacs User's Manual}, for more -information. - -@item asm-mode -@cindex asm-mode -Use asm-mode for editing files of assembler code. Look at the file -@file{ /usr/local/lib/xemacs-19.11/lisp/modes/asm.el} for more -information. - -@end table - -There are some other modes and commands for working with other kinds of -text or programs. Emacs also provides commands for reading and sending -Mail. For more information on these features look at the XEmacs -Manual. Emacs also provides the functions of a desk calendar, with a -diary of past or planned events. For more information on the calendar -mode look at the manual for Calendar Mode and Diary. - -@comment node-name, next, previous, up -@node Minor Modes, , Major Modes, Modes -@section Minor Modes -@cindex minor modes - -The minor modes in Emacs provide some optional features which you can -turn on or off. Any number of minor modes can be active at the same time -with any major mode. You can enable a minor mode in one buffer and -disable it in other mode. To enable a minor mode, for example the -font-lock mode type the following command: - -@example -M-x font-lock-mode -@end example -@noindent -To enable the other minor modes, replace the "font-lock" with the -name of the minor mode. To disable the mode type the command again. A -positive argument will always turn the mode on. Whenever you type this -command, it will turn the mode on if it was off, OR it will turn it off -if it was on i.e. it toggles. Look at the mode-line at the bottom of the -frame. If it says FLock in parentheses, then it means that this -mode is on, otherwise it is off. - -The following are some of the minor modes available in XEmacs. To enable -any one of them type "M-x" in front of them. - -@table @b -@item font-lock-mode -@cindex font-lock-mode - -You can also choose this mode by selecting the @b{Syntax Highlighting} -menu item from the @b{Options} menu on the menu-bar at the -top. If you wish to have this mode enabled permanently, choose -@b{Save Options} from the @b{Options} menu. @xref{Options Menu}, for -more information on the Options menu. You can also add statements in -your @file{.emacs} file. For each major mode in which you wish to -enable this minor mode, you need a statement in your @file{.emacs} -file. The following example shows how to enable the font-lock mode when -the major mode is c-mode. - -@example -(add-hook 'c-mode-hook 'turn-on-font-lock) -@end example - -@noindent -@xref{Other Customizations}. - -When you enable this mode, the text will be displayed in -different colors and fonts depending on the type of the text. This makes -the text very easy to read and understand. For example, comments might -be displayed in red, variables in black, functions in blue and other -keywords in different colors and fonts. When you select @b{More} from -the @b{Syntax Highlighting} option, you get very detailed display of -colors and fonts; function names within comments themselves might appear -in a different font and color. - -@item auto-fill-mode -@findex auto-fill-mode -Enabling this mode will provide automatic word-wrapping. The @key{SPC} -key will break lines i.e. insert newlines as you type to prevent lines -from becoming too long. - -@item overwrite-mode -@cindex overwrite-mode -When you enable this mode, the text that you type will replace the -existing text rather than moving it to the right (the default case). You -can enable this mode by selecting @b{Overstrike} menu-item from the -@b{Options} menu from the menu-bar. - -@item abbrev-mode -@cindex abbrev-mode -After you enable this mode, you can define words which will expand into -some different text i.e. you can define abbreviations. For example, you -might define "expand" to "expand will eventually expand to this -text". After this definition you will be able to get "expand will -eventually expand to this text" simply by typing - -@example -expand @key{SPC} -@end example - -@noindent - @xref{Abbrevs,,,xemacs,XEmacs User's Manual}, for more information on this -mode and on defining abbreviations. - -@item auto-save-mode -@cindex auto-save-mode -After you enable this mode in a buffer, the contents of that buffer will -be saved periodically. This will reduce the amount you might lose in -case of a system crash. - -@item line-number-mode -@cindex line-number-mode -After you enable this mode, the line number at which your cursor is -present will be displayed continously in the mode line. - -@item blink-paren -@cindex blink-paren -To enable this command, just type -@example -M-x blink-paren -@end example - -@noindent -Do not add the "-mode" to it. You can also select the @b{Paren -Highlighting} option from the @b{Options} menu. After you enable this -command, put your cursor on one of the left parenthesis. The other -matching parenthesis will start blinking. @xref{Options Menu,} for more -information on the @b{Paren Highlighting} option. -@end table - -For information on some other modes, look at the XEmacs User's Manual -and the associated files. - diff --git a/man/new-users-guide/new-users-guide.texi b/man/new-users-guide/new-users-guide.texi deleted file mode 100644 index 13f88dd..0000000 --- a/man/new-users-guide/new-users-guide.texi +++ /dev/null @@ -1,284 +0,0 @@ -\input ../texinfo @c -*-texinfo-*- -@setfilename ../../info/new-users-guide.info -@comment node-name, next, previous, up - - -@ifinfo -This manual serves as an introduction to the XEmacs editor. - -Copyright (C) 1985, 1986, 1988 Richard M. Stallman. -Copyright @copyright{} 1991, 1992, 1993, 1994 Lucid, Inc. -Copyright @copyright{} 1993, 1994 Sun Microsystems, Inc. - -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 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 -@end ifinfo -@c -@setchapternewpage odd -@settitle Getting Started With XEmacs -@c -@titlepage -@sp 6 -@center @titlefont{Getting Started With XEmacs} -@sp 4 -@sp 1 -@sp 1 -@center July 1994 -@center (General Public License upgraded, January 1991) -@sp 5 -@center Richard Stallman -@sp 1 -@center and -@sp 1 -@center Rashmi Goyal -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1985, 1986, 1988 Richard M. Stallman. - -Copyright @copyright{} 1991, 1992, 1993, 1994 Lucid, Inc. - -Copyright @copyright{} 1993, 1994 Sun Microsystems, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. -@end titlepage -@page -@ifinfo -@node Top, Intro, (dir), (dir) - -The Emacs Editor -**************** - -Emacs is the extensible, customizable, self-documenting real-time -display editor. This Info file will help you get started on using -XEmacs. It corresponds to XEmacs version 19.13. - -@end ifinfo - -@iftex -@unnumbered Preface - - This guide is intended to help you get started on using the -Emacs editor. It will show you some examples of simple customizations. - - For detailed information on any topic, refer to the @b{XEmacs -User's Manual}. This document will also refer the reader to the -@b{XEmacs User's Manual} for more information on corresponding -topics. You can also use the on-line, learn-by-doing tutorial, which you -get by running Emacs and typing @kbd{C-h t} OR you can choose the -@b{Emacs Tutorial} from the @b{Help} menu on the menu bar (which is -located on the extreme right of the frame). With it, you learn Emacs by -using Emacs on a specially designed file which describes commands, tells -you when to try them, and then explains the results you see. - - The first few chapters will introduce you to some basic Emacs commands. -Later on, some examples of simple customizations will be shown. - - To find the documentation on a particular command, look in the index. -Keys (character commands) and command names have separate indexes. There -is also a glossary, with a cross reference for each term. - - This manual comes in two forms: the published form and the Info form. -The Info form is for on-line perusal with the INFO program; it is -distributed along with XEmacs. Both forms contain substantially the -same text and are generated from a common source file, which is also -distributed along with XEmacs. - -@end iftex - - -@c node - -@menu -* Intro:: Introduction to XEmacs editor - -Indices, nodes containing large menus -* Key Index:: An item for each standard Emacs key sequence. -* Command Index:: An item for each command and function name -* Variable Index:: An item for each variable in User-Guide -* Concept Index:: An item for the concepts introduced - -Entering, Exiting and Editing Emacs -* Entering:: Starting Emacs from the shell and Exiting -* Windows and Menus:: Description of Pull-down menus -* Edit:: Basic Editing commands - -Other Features of XEmacs -* Customization Basics:: Customize Emacs menus and keybindings -* Help:: Help menu and other help commands -* Modes:: Major and Minor modes in XEmacs -* Files:: Visiting, Saving and Listing Files -* Other Customizations:: Customizing Variables, Modes, etc -* Select and Move:: Selecting text and moving text -* Search and Replace:: Searching and Replacing text - - - - --- The Detailed Node Listing --- - -Entering and Exiting Emacs - -* Enter:: Entering Emacs from the shell -* Frame:: Basic information about the XEmacs Frame -* Exiting:: Exiting Emacs -* Mode Line:: Interpreting the mode line. -* Echo Area:: Bottom of the frame where you interact - with Emacs. - -XEmacs Windows and Menus - -* XEmacs Window:: Manipulating XEmacs Windows -* Pull-down Menus:: Description of XEmacs Pull-down Menus - -Pull-down menus - -* File menu:: Items on the File Menu -* Edit menu:: Items on the Edit Menu -* Options Menu:: Items on the Options Menu -* Buffers Menu:: Items on the Buffers Menu -* Help menu:: The Help Menu at the extreme right on - the frame - -Basic Editing Commands - -* Insert:: Insert text in Emacs by simply typing at - the cursor position. -* Cursor Position:: Moving Around the cursor in the buffer, -* Erase:: Different commands for erasing text -* Numeric Argument:: Giving Numeric Arguments to commands -* Undo:: Undoing Changes made by mistake - -Customize key bindings and menus - -* Customizing key Bindings:: Changing Key Bindings -* Customizing Menus:: Adding, Deleting, Enabling and Disabling Menus - -Help - -* The Help Menu:: Items on the Help Menu - -Major and Minor Modes - -* Major Modes:: Choosing Major Modes -* Minor Modes:: Auto-Fill, Abbrev and other minor modes - -Emacs Files - -* File Names:: How to type and edit file name arguments. -* Visiting:: Visiting a file prepares Emacs to edit the file. -* Saving Files:: How to save Emacs files. - -Other Customizations - -* Setting Variables:: Customizing Emacs variables -* Init File:: Some examples of Lisp expressions in - .emacs file - -Selecting and Moving Text - -* Selecting Text:: Select a region of text by setting the Mark -* Mouse:: Selecting Text with Mouse -* Region Operation:: Various ways to operate on a selected text -* Moving Text:: Moving Text -* Accumulating text:: Accumulating Text from several buffers - -No sub menu for the node search and replace -@end menu - -@node Intro,Key Index ,Top , Top -@unnumbered Introduction - - You are reading about XEmacs which is a self-documenting, customizable, extensible real-time display editor. - - XEmacs is a @dfn{display} editor because normally the text -being edited is visible on the screen and is updated automatically as you -type. @xref{Frame,Display,,xemacs,XEmacs User's Manual}. - - It is a @dfn{real-time} editor because the display is updated very -frequently, usually after each character or pair of characters you type. -This minimizes the amount of information you must keep in your head as -you edit. @xref{Basic,Real-time,Basic Editing,xemacs,XEmacs User's -Manual}. - - It is advanced because it provides facilities that go beyond -simple insertion and deletion: filling of text; automatic indentation of -programs; viewing two or more files at once; and dealing in terms of -characters, words, lines, sentences, paragraphs, and pages, as well as -expressions and comments in several different programming languages. It is -much easier to type one command meaning ``go to the end of the paragraph'' -than to find that spot with simple cursor keys. - - @dfn{Self-documenting} means that at any time you can type a special -character, @kbd{Control-h}, to find out what your options are. You can -also use @kbd{C-h} to find out what a command does, or to find all the -commands relevant to a topic. @xref{Help,,,xemacs,XEmacs User's Manual}. - - @dfn{Customizable} means you can change the definitions of Emacs -commands. For example, if you use a programming language in which -comments start with @samp{<**} and end with @samp{**>}, you can tell the -Emacs comment manipulation commands to use those strings -(@pxref{Comments,,,xemacs,XEmacs User's Manual}). Another sort of -customization is rearrangement of the command set. For example, you can -set up the four basic cursor motion commands (up, down, left and right) -on keys in a diamond pattern on the keyboard if you prefer. -@xref{Customization,,,xemacs,XEmacs User's Manual}. - - @dfn{Extensible} means you can go beyond simple customization and -write entirely new commands, programs in the Lisp language to be run by -Emacs's own Lisp interpreter. Emacs is an ``on-line extensible'' -system: it is divided into many functions that call each other. You can -redefine any function in the middle of an editing session and replace -any part of Emacs without making a separate copy of all of Emacs. Most -of the editing commands of Emacs are written in Lisp; the few -exceptions could have been written in Lisp but are written in C for -efficiency. Only a programmer can write an extension to Emacs, but anybody -can use it afterward. - -@include enter.texi -@include xmenu.texi -@include edit.texi -@include custom1.texi -@include help.texi -@include modes.texi -@include files.texi -@include custom2.texi -@include region.texi -@include search.texi - -@node Key Index, Command Index, Intro, Top -@unnumbered Key (Character) Index -@printindex ky - -@node Command Index, Variable Index, Key Index, Top -@unnumbered Command and Function Index -@printindex fn - -@node Variable Index, Concept Index, Command Index, Top -@unnumbered Variable Index -@printindex vr - -@node Concept Index, Entering, Variable Index, Top -@unnumbered Concept Index -@printindex cp - -@summarycontents -@contents -@bye - -@c Remember to delete these lines before creating the info file. -@iftex -@lucidbook -@bindingoffset = 0.5in -@parindent = 0pt -@end iftex - diff --git a/man/new-users-guide/region.texi b/man/new-users-guide/region.texi deleted file mode 100644 index 982931d..0000000 --- a/man/new-users-guide/region.texi +++ /dev/null @@ -1,258 +0,0 @@ -@comment node-name, next, previous, up -@node Select and Move, Search and Replace, Other Customizations, Top -@chapter Selecting and Moving Text -@cindex region -@cindex mark - - Many Emacs commands operate on an arbitrary contiguous -part of the current buffer. You can select some part of the buffer and -edit only that part of the buffer. This selected buffer is called a -@dfn{region}. You can select text in two ways: - -@itemize @bullet -@item -You use special keys to select text by defining a region between the -cursor and @dfn{the mark} (which you set). -@item -If you are running XEmacs under X, you can also select text -with the mouse. -@end itemize - -@comment node-name, next, previous, up -@menu -* Selecting Text:: Select a region of text by setting the Mark -* Mouse:: Selecting Text with Mouse -* Region Operation:: Various ways to operate on a selected text -* Moving Text:: Moving Text -* Accumulating text:: Accumulating Text from several buffers -@end menu - -@node Selecting Text, Mouse, Select and Move, Select and Move -@section Setting the Mark -@kindex C-SPC -@kindex C-x C-x -@kindex C-< -@kindex C-> -@findex set-mark-command -@findex mark-beginning-of-buffer -@findex mark-end-of-buffer -@findex exchange-point-and-mark - To define a region you need to set @dfn{the mark} at one end of it and -move the cursor to the other end. Once you set the mark, it remains -there until you set it again to some other place. Each buffer has its -own @dfn{mark ring} (a place where Emacs remembers 16 previous -locations of the mark). To set @dfn{the mark}, you can use the -following commands: - -@table @kbd -@item C-@key{SPC} -This command will set @dfn{the mark} at the position of your cursor -(@code{set-mark-command}). You can move your cursor around and @dfn{the -mark} will stay there. -@item C-x C-x -Interchange mark and point (@code{exchange-point-and-mark}). Since Emacs -will have only one cursor, after you move the cursor it will be unable -to show you where you set the @dfn{the mark}. In order to see @dfn{the -mark} you can type the command @kbd{C-x C-x} which will put your cursor -on the position of your mark and your mark on the position of your -cursor. Use the command again to reset the positions of your cursor and -mark. -@item C-< -This command will push the mark at the beginning of the buffer without -changing the position of your cursor. -@item C-> -This command will push the mark at the end of the buffer without -changing the position of your cursor. -@end table -@noindent -You can also give arguments to @kbd{C-<} or @kbd{C->}. @xref{The Mark -and the Region,,,xemacs,XEmacs User's Manual}, for more information. - -@comment node-name, next, previous, up -@node Mouse, Region Operation, Selecting Text, Select and Move -@section Selecting Text with Mouse -@cindex mouse selection -@cindex clipboard selection -@cindex primary selection -@cindex cursor shapes - If you are using XEmacs under X, you can use the mouse to select -text. The selected text will always be highlighted, so just by looking -at the text you know what you have selected so far. To select a word -just double-click with the left-mouse-button on the word. To select a -whole line triple-click anywhere on the line with the -left-mouse-button. You can also use the @b{Copy} item from the @b{Edit} -menu on the menu-bar to select text. This kind of selection is called -@b{Clipboard} selection, @xref{X Clipboard Selection,,,xemacs,XEmacs User's -Manual}, for more information. To select an arbitrary region, follow -these steps: - -@enumerate -@item -Move the mouse cursor over the character at the beginning of the region of -text you want to select. -@item -Press and hold the left mouse button. -@item -While holding the left mouse button down, drag the cursor to the -character at the end of the region of text you want to select. -@item -Release the left mouse button. -@end enumerate -The selected region of text is highlighted. - - @xref{Selecting Text with the Mouse,,,xemacs,XEmacs User's Manual}, for -more information regarding the Mouse and additional mouse operations. - -@comment node-name, next, previous, up -@node Region Operation, Moving Text, Mouse, Select and Move -@section Operating on the Region - Once you have selected a region you can do a lot of things to the text -in the region: -@kindex C-w -@kindex C-x C-u -@kindex C-x C-l -@kindex C-SPC -@kindex C-x TAB -@kindex C-M-\ -@findex print-region -@itemize @bullet -@item -Kill the text with @kbd{C-w}. For example if you want to kill a -paragraph, position the cursor to the beginning of the paragraph and -type @kbd{C-SPC}. Then go to the end of the paragraph and type -@kbd{C-w}. The entire paragraph will be deleted. You can also select the -text with a mouse and type @kbd{C-w} to kill the entire -region. @xref{Killing,,,xemacs,XEmacs User's Manual}, for more information. - -@item -Save the text in a buffer or a file (@pxref{Accumulating -Text,,,xemacs,XEmacs User's Manual}). -@item -You can convert the case of the text with @kbd{C-x C-l} or @kbd{C-x C-u} -If you type @kbd{C-x C-u} the selected text will become all -upper-case. If you type @kbd{C-x C-l} the selected text will become all -lower-case. -@item -Print hardcopy with @kbd{M-x -print-region}. @xref{Hardcopy,,,xemacs,XEmacs User's Manual}, for more -information. This command will print a hardcopy of only the selected -text. -@item -Indent it with @kbd{C-x @key{TAB}} or @kbd{C-M-\} -@xref{Indentation,,,xemacs,XEmacs User's Manual}, for more information. -@end itemize - - -@comment node-name, next, previous, up -@node Moving Text, Accumulating text, Region Operation, Select and Move -@section Moving Text -@cindex yanking -@cindex pasting -@findex yank -@cindex killing -@cindex kill ring -@cindex moving text -@kindex C-y - The most common way to move or copy text in Emacs is through -@dfn{killing} or @samp{cutting} it and then @dfn{yanking} or -@samp{pasting} it. You can also use the @b{Cut} or @b{Copy} option from -the @b{Edit} menu for killing and copying respectively. @xref{Edit menu} -for reviewing the commands for killing text. All the killed text -in Emacs is recorded in the @dfn{kill ring}. Since there is only one -kill ring in Emacs, you can kill text in one buffer and yank it in -another buffer. To @samp{paste} or -@samp{yank} the killed text you can use the following commands: -@table @kbd -@item C-y -This command will yank or paste the last killed text (@code{yank}). -@item M-w -Save region as last killed text without actually killing it -(@code{copy-region-as-kill}). You can use this command to copy a -selected region and then yank (or paste) it without actually removing it -from the buffer. -@item C-M-w -Append next kill to last batch of killed text -(@code{append-next-kill}). This command will append whatever you killed -last to what you kill now. Then later you will be able to yank the -entire appended text from the @dfn{kill ring}. -@end table - -@comment node-name, next, previous, up -@node Accumulating text, , Moving Text, Select and Move -@section Accumulating Text -@findex append-to-buffer -@findex prepend-to-buffer -@findex copy-to-buffer -@findex append-to-file -@cindex copying text -@cindex accumulating text -@cindex rectangle commands -@cindex registers -@cindex temporary storage - - The following commands can be used for accumulating text from -different buffers into one place or for copying one region of text into -many buffers: - -@table @kbd -@item M-x append-to-buffer -Append region to contents of specified buffer -(@code{append-to-buffer}). After you type in this command and press -@key{RET}, Emacs will prompt you for a buffer name. You will see a -message in the echo area: -@example -Append to buffer: (default ) -@end example -@noindent -After you type in a buffer name, a copy of the region will be inserted -at the location of the cursor into that buffer. If there is no buffer -with the name given by you, Emacs will create a new buffer with that -name. By default the cursor's position in the is at the end. -@item M-x prepend-to-buffer -Prepend region to contents of specified buffer. This command is similar -to the above command except that the cursor in the buffer (by default) -is at the beginning rather than at the end. -@item M-x copy-to-buffer -Copy region into specified buffer, deleting that buffer's old -contents. This command will also prompt you for a buffer name. -@item M-x insert-buffer -Insert contents of specified buffer into current buffer at point. This -command will prompt you for a buffername which you want to be copied -into the current buffer at the location of the cursor. -@item M-x append-to-file -This command will prompt you for a filename and append the region to -the end of the contents of the specified file. -@end table - -@noindent -@xref{Accumulating Text,,,xemacs,XEmacs User's Manual}, for more -information regarding this topic. - - You can also use @dfn{rectangle commands} for operating on rectangular -areas of text. @xref{Rectangles,,,xemacs,XEmacs User's Manual}, for more -information regarding rectangle commands. - - Emacs also provides @dfn{registers} which serve as temporary storage for -text or positions. Each register has a one character name and they can -store @dfn{regions}, a @dfn{rectangle}, or a @dfn{mark} i.e. a cursor -position. Whatever you store in register stays there until you store -something else in that register. To find out about commands which -manipulate registers @xref{Registers,,,xemacs,XEmacs User's Manual}. - - - - - - - - - - - - - - - - - - diff --git a/man/new-users-guide/search.texi b/man/new-users-guide/search.texi deleted file mode 100644 index cedc71e..0000000 --- a/man/new-users-guide/search.texi +++ /dev/null @@ -1,118 +0,0 @@ -@comment node-name, next, previous, up -@node Search and Replace, , Select and Move, Top -@chapter Searching and Replacing -@cindex searching -@cindex replace -@vindex case-fold-search - - Emacs provides commands for searching for occurrences of a particular -string. The search is incremental i.e. it begins even before you -complete typing the whole string. All searches in Emacs ignore the case -of the text they are searching, i.e. if you are searching for "String", -then "string" will also be one of the selections. If you want a case -sensitive search select the @b{Case Sensitive Search} from the -@b{Option} menu. You can also set the variable @var{case-fold-search} to -@var{nil} for making searches case-sensitive. For information on setting -variables, @xref{Setting Variables}. The two commands for searching for -strings in XEmacs are: - -@table @kbd -@item C-s -@findex isearch-forward -@kindex C-s -This command will prompt you for a string to search : - -@example -I-search: -@end example - -@noindent -If you type "myname" as the string to be searched, then Emacs will start -searching for "m", "my", "myn", etc as you go on typing the whole -string in the forward direction. The cursor will be on the matching -string which has been found so far. If you find the correct match just -hit @key{RET} or type @kbd{C-f} or @kbd{C-b} to set the cursor's -position. If you find a matching string "myname" but you were looking -for a different occurrence of it, use @kbd{C-s} again. If the search is -unable to find the string, it will give you an error message. - -@item C-r -@findex isearch-backward -@kindex C-r -This command will perform an incremental search in the backward -direction. It will prompt you for a string name: - -@example -I-search backward: -@end example - -@noindent -After you start typing the string name, it will search for the string in -the same fashion as it does for @kbd{C-s} except that it will search in -the backward direction. If it cannot find the string name, it will give -you an error message. -@end table - - If you make a mistake while typing the string names when you use the -above commands, you can use the @key{DEL} key to erase characters. Each -@key{DEL} will erase the last character. At any time if you want to quit -the search, just type @kbd{C-g}. - - To do a non-incremental search i.e. to start the search only after -you have typed the whole string you can use the following commands: - -@table @kbd -@item C-s RET @dfn{string} RET -This command will search for the specified string in the forward -direction and will give an error message if the string is not found. - -@item C-r RET @dfn{string} RET -This command will search for the specified string in the backward -direction. -@end table - - For information on how Emacs searches for words and regular -expressions, @xref{Search,,,xemacs,XEmacs User's Manual}. - - To replace all occurrences of a string in Emacs, you can use the -following command: -@findex replace-string -@example -M-x replace-string -@end example - -@noindent -After you type @kbd{M-x replace-string}, you will be prompted for a -string name to replace: - -@example -Replace string: -@end example - -@noindent -After you type in a string name, for example "FOO" and press @key{RET}, -you will see another prompt: - -@example -Replace string FOO with: -@end example - -@noindent -Now type the string which you want to replace "FOO" with and press -@key{RET}. After all the occurrences are replaced you will see the -message "Done" in the echo area. If you want only some occurrences of -the string to be replaced, use @kbd{M-x query-replace RET RET - RET}. For more information, @xref{Query -Replace,,,xemacs,XEmacs User's Manual}. - - XEmacs also provides a utility for checking spellings. Use @kbd{M-x -ispell-buffer} to check for spellings in the whole buffer. You can also -check the spelling of a word or a region. You can use menus to -check for spellings: - -@noindent -Evaluate the expression @code{(load "big-menubar")}. To evaluate this -expression you need to hit the @key{META} or the @key{ESC} key twice and -type in the expression in the echo area before hitting @key{RET}. You -will get an extensive menubar. Select the @b{Spell Check} menu item from -the @b{Utilities} menu for checking spellings. diff --git a/man/new-users-guide/xmenu.texi b/man/new-users-guide/xmenu.texi deleted file mode 100644 index d642ec0..0000000 --- a/man/new-users-guide/xmenu.texi +++ /dev/null @@ -1,472 +0,0 @@ -@comment node-name, next, previous, up -@node Windows and Menus, Edit, Entering, Top -@chapter XEmacs Windows and Menus -@cindex selected window -@cindex windows -@findex delete-window -@findex delete-other-windows -@findex scroll-other-window - - The first section of this chapter will show you how you can manipulate -XEmacs Windows and the other section will explain the Pull-down Menus of -an XEmacs window. - -@comment node-name, next, previous, up -@menu -* XEmacs Window:: Manipulating XEmacs Windows -* Pull-down Menus:: Description of XEmacs Pull-down Menus -@end menu - -@node XEmacs Window, Pull-down Menus, Windows and Menus, Windows and Menus -@section XEmacs Windows - When you use XEmacs under X, you can open multiple windows and each -window can display one buffer or multiple parts of one buffer. Each window -will have its own @dfn{mode line} and @dfn{echo area}. At any one time -there is only one @dfn{selected window} and the buffer it displays is -the @dfn{selected buffer}. There are some commands for manipulating -windows: - -@kindex C-x 0 -@kindex C-x 1 -@kindex C-x 2 -@kindex C-x 3 -@kindex C-x 4 -@kindex M-C-v -@table @kbd -@item M-C-v -@findex scroll-other-window -This command will scroll the window which is not @dfn{selected} -(@code{scroll-other-window}). - -@findex delete-window -@item C-x 0 -This command will get rid of the selected window (@code{delete-window}). -That is a zero. If there is more than one Emacs frame, deleting the -sole remaining window on that frame deletes the frame as well. If the -current frame is the only frame, it is not deleted. - -@findex delete-other-windows -@item C-x 1 -This command will get rid of all the windows except the selected one. -(@code{delete-other-windows}). For example, if you use the @b{Describe -variable} option from the @b{Help} menu, the window will split -vertically and the bottom window will contain documentation for that -variable. After you are done looking at that variable's documentation -you might want to come back to your original single window. Just type -@kbd{C-x 1} after your cursor is in the top window (the window which you -want to keep) and hit @key{RET}. - -@findex split-window-vertically -@item C-x 2 -This command will split the selected window into two windows, one above -the other (@code{split-window-vertically}). Both the windows will start -out by displaying the same buffer. The window in which you have your -cursor will be your @dfn{selected window}. - -@findex split-window-horizontally -@item C-x 3 -This will split the selected window into two windows positioned side by -side (@code{split-window-horizontally}). A line of vertical bars will -separate the window. -@end table -@noindent - -You can select a buffer in another window by using some other -commands. These commands all have a prefix key @kbd{C-x 4} -@table @kbd -@kindex C-x 4 b -@kindex C-x 4 f -@kindex C-x 4 d -@kindex C-x 4 m -@findex switch-to-buffer-other-window -@findex find-file-other-window -@findex dired-other-window -@findex mail-other-window -@item C-x 4 b @var{bufname} @key{RET} -This command will select a buffer @var{bufname} in another window. This -runs @code{switch-to-buffer-other-window}. It will prompt you for a -buffername. - -@item C-x 4 f @var{filename} @key{RET} -Visit file @var{filename} and select its buffer in another window. This -runs @code{find-file-other-window}. @xref{Visiting,,,xemacs,XEmacs User's -Manual}. It will prompt you for a filename. - -@item C-x 4 d @var{directory} @key{RET} -Select a Dired buffer for directory @var{directory} in another window. -This runs @code{dired-other-window}. @xref{Dired,,,xemacs,XEmacs User's -Manual}. - -@item C-x 4 m -Start composing a mail message in another window. This runs -@code{mail-other-window}, and its same-window version is @kbd{C-x m}. -@xref{Sending Mail,,,xemacs,XEmacs User's Manual}, for information on how -to @b{S}end @b{M}ail using XEmacs. @xref{Reading Mail With -Rmail,,,xemacs,XEmacs User's Manual}, for information on reading mail using -@b{Rmail}. -@end table - - - If you click the right button on the mouse on a mode line, you will -get a menu with following options: -@cindex windows -@cindex pull-down-menus -@cindex menus -@table @b -@item Delete Window -Choosing this menu will remove the window above this modeline from the frame. -@item Delete Other Windows -Delete all windows on the frame except for the one above this modeline. -@item Split Window -Split the window above the mode line in half, creating another window. -@item Split Window Horizontally -Split the window above the mode line in half horizontally, so that there -will be two windows side-by-side. -@item Balance Windows -Readjust the sizes of all windows on the frame until all windows have -roughly the same number of lines. -@end table - - -@comment node-name, next, previous, up -@node Pull-down Menus, , XEmacs Window, Windows and Menus -@section XEmacs Pull-down Menus - -When you run XEmacs under X, each Emacs frame has a menu-bar at the top -which provides commands for editing, help and other -options. All these options are also available via key commands, the -menus just provide convenient short-cuts. The key commands are displayed -right besides some of the options. The following is a brief -description of the four default menus on the menu bar: - -@menu -* File menu:: Items on the File menu -* Edit menu:: Items on the Edit menu -* Options Menu:: Items on the Options Menu -* Buffers Menu:: Items on the Buffers Menu -* Help menu:: The Help Menu at the extreme right on - the frame -@end menu - -@node File menu, Edit menu, Pull-down Menus, Pull-down Menus -@subsection The File Menu -@cindex File menu -@cindex Open in New Frame... menu item -@cindex Open ... menu item -@cindex Insert File... menu item -@cindex Save Buffer menu item -@cindex Save Buffer As ... menu item -@cindex Revert Buffer menu item -@cindex Kill Buffer menu item -@cindex Print Buffer menu item -@cindex New Frame menu item -@cindex Delete Frame menu item -@cindex Split Frame -@cindex Un-split (Keep This) -@cindex Un-split (Keep Others) -@cindex Exit Emacs menu item - -The @b{File} menu bar contains the following items. To choose a -particular option, press the left mouse button and drag it to the item -you wish to select. Then release the button. - -@table @b -@item Open... -This option will prompt you for a file name. You will get a message in -the echo area: - -@example -Find File: -@end example -@noindent -After Find File, there might be a directory path also. After you type -the file name and press @key{RET} the file will be loaded into a new -buffer. - -@item Open in New Frame... -It prompts you for a file name and loads that file in a new buffer in -a new frame. You can open many frames for the same Emacs session. You -can delete the frame by selecting @b{Delete Frame}. - -@item Insert File... -Prompts you for a filename and inserts the contents of this filename in -your current buffer. Position your cursor at the place you wish to -insert the file and select this option. You will get the following -message in the echo area: - -@example -Insert file: -@end example -@noindent -Insert the file name and press @key{RET}. - -@item Save -It saves the changes you have made to the buffer. If you have made -changes which are not saved yet, the option will appear dark, otherwise -it will be light and unselectable. If you do not wish to save the -changes, select @b{Revert Buffer}. - -@item Save As... -Prompts you for a filename and saves the current buffer in that file. It -loads the new file if the filename you specify is different from the one -you were working with. - -@item Print Buffer -Prints a hardcopy of the current or @dfn{selected} buffer. - -@item New Frame -Opens a new frame with @b{*scratch*} as the default buffer. It doesn't -prompt you for a filename. To open a file you need to go to that frame -and select @b{Open...} - -@item Split Frame -Splits the current window into two equal-sized windows with the same -buffer. To get back a single frame, select @b{Un-Split (Keep -This)}. @xref{XEmacs Window}, for more information about windows. - -@item Un-Split (Keep This) -If the frame contains multiple windows, it will remove all windows -except the selected one. - -@item Un-Split (Keep Others) -If the frame contains multiple windows, it will remove the selected -window and keep the other one. - -@item Revert Buffer -If you do not wish to save the changes you made to the file since you -opened it, select this option. It will restore the last saved version of -the file to the current buffer. - -@item Kill Buffer -It will kill the current buffer. If will prompt you if there are unsaved -changes. - -@item Exit Emacs -It will kill the Emacs @dfn{process} as opposed to simply killing the -@dfn{buffer}. Before it kills the process, it will prompt you as to -which unsaved buffers you wish to save by going through the list of the -buffers. - -@end table - -@comment node-name, next, previous, up -@menu -* Edit menu:: Items on the Edit Menu -* Options Menu:: Items on the Options Menu -* Buffers Menu:: Items on the Buffers Menu -* Help menu:: The Help Menu at the extreme right on - the frame -@end menu - -@node Edit menu, Options Menu, File menu, Pull-down Menus -@subsection The Edit Menu -@cindex Undo menu item -@cindex Cut menu item -@cindex Copy menu item -@cindex Paste menu item -@cindex Clear menu item -@cindex Start Macro Recording menu item -@cindex End Macro Recording menu item -@cindex Execute Last Macro menu item - -Most of the commands in this menu work on a block of text or a selected -region. The text will be highlighted as you select it. -@table @b -@item Undo -Undoes the previous command. If you type something by mistake you can -use this command. For example, if you select @b{Insert File...} from the -@b{File} menu and insert a wrong file by mistake, you can select this -item and it will remove the inserted file. It undoes a batch of text -which is worth an emacs command. - -@item Cut -Removes the selected text block from the current buffer, makes it the X -clipboard selection, and places it in the kill ring -(@pxref{Moving Text}). Before executing this command, you have to select -a region using Emacs region selection commands or with the -mouse. @xref{Selecting Text}. - -@item Copy -Makes a selected text block the X clipboard selection, and places it in -the kill ring. You can select text using one of the Emacs region -selection commands or by selecting a text region with the -mouse. @xref{Selecting Text}, for more information. - -@item Paste -Inserts the current value of the X clipboard selection in the current -buffer. Note that this is not necessarily the same as the Emacs -@code{yank} command, because the Emacs kill ring and the X clipboard -selection are not the same thing. You can paste in text you have placed -in the clipboard using @b{Copy} or @b{Cut}. You can also use @b{Paste} -to insert text that was pasted into the clipboard from other -applications. @xref{X Clipboard Selection,,,xemacs,XEmacs User's Manual}, -for information on using Clipboard Selection. - -@item Clear -Removes the selected text block from the current buffer but does not -place it in the kill ring or the X clipboard selection. You will not be -able to get this text back. - -@item Start Macro Recording -After selecting this, Emacs will remember every keystroke you type until -@b{End Macro Recording} is selected. - -@item End Macro Recording -Selecting this tells emacs to stop remembering your keystrokes. - -@item Execute Last Macro -Selecting this item will cause emacs to re-interpret all of the -keystrokes which were saved between selections of the @b{Start Macro -Recording} and @b{End Macro Recording} menu items. You can now execute -the most recent keyboard macro. @xref{Keyboard Macros,,,xemacs,XEmacs -User's Manual}, for further information. -@end table - -@comment node-name, next, previous, up -@node Options Menu, Buffers Menu, Edit menu, Pull-down Menus -@subsection The Options Menu -@cindex Options menu -@cindex Read Only menu item -@cindex Case Sensitive Search menu item -@cindex Overstrike menu item -@cindex Auto Delete Selection menu item -@cindex Teach Extended Commands menu item -@cindex Syntax Highlighting menu item -@cindex Paren Highlighting menu item -@cindex Font menu item -@cindex Size menu item -@cindex Weight menu item -@cindex Buffers Menu Length... menu item -@cindex Buffers Sub-Menus menu item -@cindex Save Options - -There are sub-menus for some of the menus which you will need to -select. If sub-menus exist for an item, they will be displayed -automatically when you drag the mouse on that item. The items in this -menu provide some fancy editing operations. - -@table @b -@item Read Only -Selecting this item will cause the buffer to visit the file in a -read-only mode. Changes to the file will not be allowed. - -@item Case Sensitive Search -Selecting this item will cause searches to be case-sensitive. If -its not selected then searches will ignore case. This option is -local to the buffer. For example, if this item is selected and you are -searching for @samp{Smile}, then an occurrence of @samp{smile} will not -be recognized because of the smaller case of @samp{s}. - -@item Overstrike -After selecting this item, when you type letters they will replace -existing text on a one-to-one basis, rather than pushing it to the -right. At the end of a line, such characters extend the line. Before -a tab, such characters insert until the tab is filled in. - -@item Auto Delete Selection -Selecting this item will cause automatic deletion of the selected -region. After you select a region and hit the @key{RET} key, the -selected text will be deleted. The typed text will replace the selection -if the selection is active (i.e. if its highlighted). If the option is -not selected then the typed text is just inserted at the cursor. - -@item Teach Extended Commands -After you select this item, any time you execute a command with -@kbd{M-x} which has a shorter keybinding, you will be shown the -alternate binding before the command executes. For example if you type -@kbd{M-x find-file-other-window} which performs the same function as the -@b{Open in Other Window...} in @b{File} menu you will see the following -message: - -@example -M-x find-file-other-window (bound to keys: C-x 4 f, C-x 4 C-f) -@end example - -@item Syntax Highlighting -You can customize your @code{.emacs} file to include the font-lock mode -so that when you select this item, the comments will be displayed in one -face, strings in another, reserved words in another, and so -on. @xref{Customization,,,xemacs,XEmacs User's Manual}, for more -information on customizing @code{.emacs} file. After selecting this -item, you will find your code a lot easier to read. When @b{Fonts} is -selected, different parts of the program will appear in different -Fonts. When @b{Colors} is selected, then the program will be displayed -in different colors. Selecting @b{None} causes the program to appear in -just one Font and Color. Selecting @b{Less} resets the Fonts and Colors -to a fast, minimal set of decorations. Selecting @b{More} resets the -Fonts and Colors to a larger set of decorations. For example, if -@b{Less} is selected (which is the default setting) then you might have -all comments in green color. It does not matter what the comments -contain. Whereas, if @b{More} is selected then a function name in the -comments themselves might appear in a different Color or Font. Even -though the comments themselves might appear in green color, a function -name @dfn{within} the comments might appear in red color. - -@item Paren Highlighting -After selecting @b{Blink} from this item, if you place the cursor -on a parenthesis, the matching parenthesis will blink. If you select -@b{Highlight} and place the cursor on a parenthesis, the whole -expression of the parenthesis under the cursor will be highlighted. -Selecting @b{None} will turn off the options (regarding @b{Paren -Highlighting}) which you had selected earlier.@refill - -@item Font -You can select any Font for your program by choosing from one of the -available Fonts. The whole buffer will be converted to the Font you select. - -@item Size -You can select any size for the text in your buffer (ranging from @b{2} to @b{24}) by selecting the appropriate option.@refill - -@item Weight -You can choose either @b{Bold} or @b{Medium} for the weight of the text -of your buffer. - -@item Buffers Menu Length... -Prompts you for the number of buffers to display. Then it will display -that number of most recently selected buffers. - -@item Buffers Sub-Menus -After selection of this item the Buffers menu will contain several -commands, as submenus of each buffer line. If this item is unselected, -then there are no submenus for each buffer line, the only command -available will be selecting that buffer. - -@item Save Options -Selecting this item will save the current settings of your Options -menu to your @code{.emacs} file so that the next time you start XEmacs, -you won't need to select the options again. -@end table - - -@comment node-name, next, previous, up -@node Buffers Menu, Help menu, Options Menu, Pull-down Menus -@subsection The Buffers Menu -@cindex Buffers menu -The @b{Buffers} menu provides a selection of up to ten buffers and the -item @b{List All Buffers}, which provides a Buffer List. If you select -@b{Buffers Sub-menus} from the @b{Options} menu, you will get some -sub-menus for each of the buffer listing. - - -@comment node-name, next, previous, up -@node Help menu, , Buffers Menu, Pull-down Menus -@subsection The Help Menu -@cindex Help menu - -The Help Menu gives you access to Emacs Info and provides a menu -equivalent for some of the choices you have when using @kbd{C-h}. -@xref{Help}, for more information. - -The @b{Describe variable} and @b{Describe function} will provide -documentation for the corresponding variable or function. The Help menu -also gives access to UNIX online manual pages via the @b{UNIX Manual...} -option. - - - - - - - - - diff --git a/man/standards.texi b/man/standards.texi deleted file mode 100644 index 222c11f..0000000 --- a/man/standards.texi +++ /dev/null @@ -1,2802 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@c %**start of header -@setfilename ../info/standards.info -@settitle GNU Coding Standards -@c UPDATE THIS DATE WHENEVER YOU MAKE CHANGES! -@set lastupdate 17 May 1996 -@c %**end of header - -@ifinfo -@format -START-INFO-DIR-ENTRY -* Standards: (standards). GNU coding standards. -END-INFO-DIR-ENTRY -@end format -@end ifinfo - -@c @setchapternewpage odd -@setchapternewpage off - -@c This is used by a cross ref in make-stds.texi -@set CODESTD 1 -@iftex -@set CHAPTER chapter -@end iftex -@ifinfo -@set CHAPTER node -@end ifinfo - -@ifinfo -GNU Coding Standards -Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. - -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 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 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 GNU Coding Standards -@author Richard Stallman -@author last updated @value{lastupdate} -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. - -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 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, Preface, (dir), (dir) -@top Version - -Last updated @value{lastupdate}. -@end ifinfo - -@menu -* Preface:: About the GNU Coding Standards -* Intellectual Property:: Keeping Free Software Free -* Design Advice:: General Program Design -* Program Behavior:: Program Behavior for All Programs -* Writing C:: Making The Best Use of C -* Documentation:: Documenting Programs -* Managing Releases:: The Release Process -@end menu - -@node Preface -@chapter About the GNU Coding Standards - -The GNU Coding Standards were written by Richard Stallman and other GNU -Project volunteers. Their purpose is to make the GNU system clean, -consistent, and easy to install. This document can also be read as a -guide to writing portable, robust and reliable programs. It focuses on -programs written in C, but many of the rules and principles are useful -even if you write in another programming language. The rules often -state reasons for writing in a certain way. - -Corrections or suggestions regarding this document should be sent to -@code{gnu@@prep.ai.mit.edu}. If you make a suggestion, please include a -suggested new wording for it; our time is limited. We prefer a context -diff to the @file{standards.texi} or @file{make-stds.texi} files, but if -you don't have those files, please mail your suggestion anyway. - -This release of the GNU Coding Standards was last updated -@value{lastupdate}. - -@node Intellectual Property -@chapter Keeping Free Software Free - -This @value{CHAPTER} discusses how you can make sure that GNU software -remains unencumbered. - -@menu -* Reading Non-Free Code:: Referring to Proprietary Programs -* Contributions:: Accepting Contributions -@end menu - -@node Reading Non-Free Code -@section Referring to Proprietary Programs - -Don't in any circumstances refer to Unix source code for or during -your work on GNU! (Or to any other proprietary programs.) - -If you have a vague recollection of the internals of a Unix program, -this does not absolutely mean you can't write an imitation of it, but -do try to organize the imitation internally along different lines, -because this is likely to make the details of the Unix version -irrelevant and dissimilar to your results. - -For example, Unix utilities were generally optimized to minimize -memory use; if you go for speed instead, your program will be very -different. You could keep the entire input file in core and scan it -there instead of using stdio. Use a smarter algorithm discovered more -recently than the Unix program. Eliminate use of temporary files. Do -it in one pass instead of two (we did this in the assembler). - -Or, on the contrary, emphasize simplicity instead of speed. For some -applications, the speed of today's computers makes simpler algorithms -adequate. - -Or go for generality. For example, Unix programs often have static -tables or fixed-size strings, which make for arbitrary limits; use -dynamic allocation instead. Make sure your program handles NULs and -other funny characters in the input files. Add a programming language -for extensibility and write part of the program in that language. - -Or turn some parts of the program into independently usable libraries. -Or use a simple garbage collector instead of tracking precisely when -to free memory, or use a new GNU facility such as obstacks. - - -@node Contributions -@section Accepting Contributions - -If someone else sends you a piece of code to add to the program you are -working on, we need legal papers to use it---the same sort of legal -papers we will need to get from you. @emph{Each} significant -contributor to a program must sign some sort of legal papers in order -for us to have clear title to the program. The main author alone is not -enough. - -So, before adding in any contributions from other people, tell us -so we can arrange to get the papers. Then wait until we tell you -that we have received the signed papers, before you actually use the -contribution. - -This applies both before you release the program and afterward. If -you receive diffs to fix a bug, and they make significant changes, we -need legal papers for it. - -You don't need papers for changes of a few lines here or there, since -they are not significant for copyright purposes. Also, you don't need -papers if all you get from the suggestion is some ideas, not actual code -which you use. For example, if you write a different solution to the -problem, you don't need to get papers. - -We know this is frustrating; it's frustrating for us as well. But if -you don't wait, you are going out on a limb---for example, what if the -contributor's employer won't sign a disclaimer? You might have to take -that code out again! - -The very worst thing is if you forget to tell us about the other -contributor. We could be very embarrassed in court some day as a -result. - -@node Design Advice -@chapter General Program Design - -This @value{CHAPTER} discusses some of the issues you should take into -account when designing your program. - -@menu -* Compatibility:: Compatibility with other implementations -* Using Extensions:: Using non-standard features -* ANSI C:: Using ANSI C features -* Source Language:: Using languages other than C -@end menu - -@node Compatibility -@section Compatibility with Other Implementations - -With occasional exceptions, utility programs and libraries for GNU -should be upward compatible with those in Berkeley Unix, and upward -compatible with @sc{ansi} C if @sc{ansi} C specifies their behavior, and -upward compatible with @sc{POSIX} if @sc{POSIX} specifies their -behavior. - -When these standards conflict, it is useful to offer compatibility -modes for each of them. - -@sc{ansi} C and @sc{POSIX} prohibit many kinds of extensions. Feel free -to make the extensions anyway, and include a @samp{--ansi}, -@samp{--posix}, or @samp{--compatible} option to turn them off. -However, if the extension has a significant chance of breaking any real -programs or scripts, then it is not really upward compatible. Try to -redesign its interface. - -Many GNU programs suppress extensions that conflict with POSIX if the -environment variable @code{POSIXLY_CORRECT} is defined (even if it is -defined with a null value). Please make your program recognize this -variable if appropriate. - -When a feature is used only by users (not by programs or command -files), and it is done poorly in Unix, feel free to replace it -completely with something totally different and better. (For example, -@code{vi} is replaced with Emacs.) But it is nice to offer a compatible -feature as well. (There is a free @code{vi} clone, so we offer it.) - -Additional useful features not in Berkeley Unix are welcome. -Additional programs with no counterpart in Unix may be useful, -but our first priority is usually to duplicate what Unix already -has. - -@node Using Extensions -@section Using Non-standard Features - -Many GNU facilities that already exist support a number of convenient -extensions over the comparable Unix facilities. Whether to use these -extensions in implementing your program is a difficult question. - -On the one hand, using the extensions can make a cleaner program. -On the other hand, people will not be able to build the program -unless the other GNU tools are available. This might cause the -program to work on fewer kinds of machines. - -With some extensions, it might be easy to provide both alternatives. -For example, you can define functions with a ``keyword'' @code{INLINE} -and define that as a macro to expand into either @code{inline} or -nothing, depending on the compiler. - -In general, perhaps it is best not to use the extensions if you can -straightforwardly do without them, but to use the extensions if they -are a big improvement. - -An exception to this rule are the large, established programs (such as -Emacs) which run on a great variety of systems. Such programs would -be broken by use of GNU extensions. - -Another exception is for programs that are used as part of -compilation: anything that must be compiled with other compilers in -order to bootstrap the GNU compilation facilities. If these require -the GNU compiler, then no one can compile them without having them -installed already. That would be no good. - -@node ANSI C -@section @sc{ansi} C and pre-@sc{ansi} C - -Do not ever use the ``trigraph'' feature of @sc{ansi} C. - -@sc{ansi} C is widespread enough now that it is ok to write new programs -that use @sc{ansi} C features (and therefore will not work in -non-@sc{ansi} compilers). And if a program is already written in -@sc{ansi} C, there's no need to convert it to support non-@sc{ansi} -compilers. - -However, it is easy to support non-@sc{ansi} compilers in most programs, -so you might still consider doing so when you write a program. Instead -of writing function definitions in @sc{ansi} prototype form, - -@example -int -foo (int x, int y) -@dots{} -@end example - -@noindent -write the definition in pre-@sc{ansi} style like this, - -@example -int -foo (x, y) - int x, y; -@dots{} -@end example - -@noindent -and use a separate declaration to specify the argument prototype: - -@example -int foo (int, int); -@end example - -You need such a declaration anyway, in a header file, to get the benefit -of @sc{ansi} C prototypes in all the files where the function is called. -And once you have it, you lose nothing by writing the function -definition in the pre-@sc{ansi} style. - -If you don't know non-@sc{ansi} C, there's no need to learn it; just -write in @sc{ansi} C. - -@node Source Language -@section Using Languages Other Than C - -Using a language other than C is like using a non-standard feature: it -will cause trouble for users. Even if GCC supports the other language, -users may find it inconvenient to have to install the compiler for that -other language in order to build your program. So please write in C. - -There are three exceptions for this rule: - -@itemize @bullet -@item -It is okay to use a special language if the same program contains an -interpreter for that language. - -For example, if your program links with GUILE, it is ok to write part of -the program in Scheme or another language supported by GUILE. - -@item -It is okay to use another language in a tool specifically intended for -use with that language. - -This is okay because the only people who want to build the tool will be -those who have installed the other language anyway. - -@item -If an application is not of extremely widespread interest, then perhaps -it's not important if the application is inconvenient to install. -@end itemize - -@node Program Behavior -@chapter Program Behavior for All Programs - -This @value{CHAPTER} describes how to write robust software. It also -describes general standards for error messages, the command line interface, -and how libraries should behave. - -@menu -* Semantics:: Writing robust programs -* Libraries:: Library behavior -* Errors:: Formatting error messages -* User Interfaces:: Standards for command line interfaces -* Memory Usage:: When and how to care about memory needs -@end menu - -@node Semantics -@section Writing Robust Programs - -Avoid arbitrary limits on the length or number of @emph{any} data -structure, including file names, lines, files, and symbols, by allocating -all data structures dynamically. In most Unix utilities, ``long lines -are silently truncated''. This is not acceptable in a GNU utility. - -Utilities reading files should not drop NUL characters, or any other -nonprinting characters @emph{including those with codes above 0177}. The -only sensible exceptions would be utilities specifically intended for -interface to certain types of printers that can't handle those characters. - -Check every system call for an error return, unless you know you wish to -ignore errors. Include the system error text (from @code{perror} or -equivalent) in @emph{every} error message resulting from a failing -system call, as well as the name of the file if any and the name of the -utility. Just ``cannot open foo.c'' or ``stat failed'' is not -sufficient. - -Check every call to @code{malloc} or @code{realloc} to see if it -returned zero. Check @code{realloc} even if you are making the block -smaller; in a system that rounds block sizes to a power of 2, -@code{realloc} may get a different block if you ask for less space. - -In Unix, @code{realloc} can destroy the storage block if it returns -zero. GNU @code{realloc} does not have this bug: if it fails, the -original block is unchanged. Feel free to assume the bug is fixed. If -you wish to run your program on Unix, and wish to avoid lossage in this -case, you can use the GNU @code{malloc}. - -You must expect @code{free} to alter the contents of the block that was -freed. Anything you want to fetch from the block, you must fetch before -calling @code{free}. - -If @code{malloc} fails in a noninteractive program, make that a fatal -error. In an interactive program (one that reads commands from the -user), it is better to abort the command and return to the command -reader loop. This allows the user to kill other processes to free up -virtual memory, and then try the command again. - -Use @code{getopt_long} to decode arguments, unless the argument syntax -makes this unreasonable. - -When static storage is to be written in during program execution, use -explicit C code to initialize it. Reserve C initialized declarations -for data that will not be changed. -@c ADR: why? - -Try to avoid low-level interfaces to obscure Unix data structures (such -as file directories, utmp, or the layout of kernel memory), since these -are less likely to work compatibly. If you need to find all the files -in a directory, use @code{readdir} or some other high-level interface. -These will be supported compatibly by GNU. - -By default, the GNU system will provide the signal handling functions of -@sc{BSD} and of @sc{POSIX}. So GNU software should be written to use -these. - -In error checks that detect ``impossible'' conditions, just abort. -There is usually no point in printing any message. These checks -indicate the existence of bugs. Whoever wants to fix the bugs will have -to read the source code and run a debugger. So explain the problem with -comments in the source. The relevant data will be in variables, which -are easy to examine with the debugger, so there is no point moving them -elsewhere. - -Do not use a count of errors as the exit status for a program. -@emph{That does not work}, because exit status values are limited to 8 -bits (0 through 255). A single run of the program might have 256 -errors; if you try to return 256 as the exit status, the parent process -will see 0 as the status, and it will appear that the program succeeded. - -If you make temporary files, check the @code{TMPDIR} environment -variable; if that variable is defined, use the specified directory -instead of @file{/tmp}. - -@node Libraries -@section Library Behavior - -Try to make library functions reentrant. If they need to do dynamic -storage allocation, at least try to avoid any nonreentrancy aside from -that of @code{malloc} itself. - -Here are certain name conventions for libraries, to avoid name -conflicts. - -Choose a name prefix for the library, more than two characters long. -All external function and variable names should start with this -prefix. In addition, there should only be one of these in any given -library member. This usually means putting each one in a separate -source file. - -An exception can be made when two external symbols are always used -together, so that no reasonable program could use one without the -other; then they can both go in the same file. - -External symbols that are not documented entry points for the user -should have names beginning with @samp{_}. They should also contain -the chosen name prefix for the library, to prevent collisions with -other libraries. These can go in the same files with user entry -points if you like. - -Static functions and variables can be used as you like and need not -fit any naming convention. - -@node Errors -@section Formatting Error Messages - -Error messages from compilers should look like this: - -@example -@var{source-file-name}:@var{lineno}: @var{message} -@end example - -Error messages from other noninteractive programs should look like this: - -@example -@var{program}:@var{source-file-name}:@var{lineno}: @var{message} -@end example - -@noindent -when there is an appropriate source file, or like this: - -@example -@var{program}: @var{message} -@end example - -@noindent -when there is no relevant source file. - -In an interactive program (one that is reading commands from a -terminal), it is better not to include the program name in an error -message. The place to indicate which program is running is in the -prompt or with the screen layout. (When the same program runs with -input from a source other than a terminal, it is not interactive and -would do best to print error messages using the noninteractive style.) - -The string @var{message} should not begin with a capital letter when -it follows a program name and/or file name. Also, it should not end -with a period. - -Error messages from interactive programs, and other messages such as -usage messages, should start with a capital letter. But they should not -end with a period. - -@node User Interfaces -@section Standards for Command Line Interfaces - -Please don't make the behavior of a utility depend on the name used -to invoke it. It is useful sometimes to make a link to a utility -with a different name, and that should not change what it does. - -Instead, use a run time option or a compilation switch or both -to select among the alternate behaviors. - -Likewise, please don't make the behavior of the program depend on the -type of output device it is used with. Device independence is an -important principle of the system's design; do not compromise it -merely to save someone from typing an option now and then. - -If you think one behavior is most useful when the output is to a -terminal, and another is most useful when the output is a file or a -pipe, then it is usually best to make the default behavior the one that -is useful with output to a terminal, and have an option for the other -behavior. - -Compatibility requires certain programs to depend on the type of output -device. It would be disastrous if @code{ls} or @code{sh} did not do so -in the way all users expect. In some of these cases, we supplement the -program with a preferred alternate version that does not depend on the -output device type. For example, we provide a @code{dir} program much -like @code{ls} except that its default output format is always -multi-column format. - -It is a good idea to follow the @sc{POSIX} guidelines for the -command-line options of a program. The easiest way to do this is to use -@code{getopt} to parse them. Note that the GNU version of @code{getopt} -will normally permit options anywhere among the arguments unless the -special argument @samp{--} is used. This is not what @sc{POSIX} -specifies; it is a GNU extension. - -Please define long-named options that are equivalent to the -single-letter Unix-style options. We hope to make GNU more user -friendly this way. This is easy to do with the GNU function -@code{getopt_long}. - -One of the advantages of long-named options is that they can be -consistent from program to program. For example, users should be able -to expect the ``verbose'' option of any GNU program which has one, to be -spelled precisely @samp{--verbose}. To achieve this uniformity, look at -the table of common long-option names when you choose the option names -for your program. The table appears below. - -If you use names not already in the table, please send -@samp{gnu@@prep.ai.mit.edu} a list of them, with their meanings, so we -can update the table. - -It is usually a good idea for file names given as ordinary arguments -to be input files only; any output files would be specified using -options (preferably @samp{-o}). Even if you allow an output file name -as an ordinary argument for compatibility, try to provide a suitable -option as well. This will lead to more consistency among GNU -utilities, so that there are fewer idiosyncracies for users to -remember. - -Programs should support an option @samp{--version} which prints the -program's version number on standard output and exits successfully, and -an option @samp{--help} which prints option usage information on -standard output and exits successfully. These options should inhibit -the normal function of the command; they should do nothing except print -the requested information. - -@c Please leave newlines between items in this table; it's much easier -@c to update when it isn't completely squashed together and unreadable. -@c When there is more than one short option for a long option name, put -@c a semicolon between the lists of the programs that use them, not a -@c period. --friedman - -Here is the table of long options used by GNU programs. - -@table @samp - -@item after-date -@samp{-N} in @code{tar}. - -@item all -@samp{-a} in @code{du}, @code{ls}, @code{nm}, @code{stty}, @code{uname}, -and @code{unexpand}. - -@item all-text -@samp{-a} in @code{diff}. - -@item almost-all -@samp{-A} in @code{ls}. - -@item append -@samp{-a} in @code{etags}, @code{tee}, @code{time}; -@samp{-r} in @code{tar}. - -@item archive -@samp{-a} in @code{cp}. - -@item archive-name -@samp{-n} in @code{shar}. - -@item arglength -@samp{-l} in @code{m4}. - -@item ascii -@samp{-a} in @code{diff}. - -@item assign -@samp{-v} in @code{gawk}. - -@item assume-new -@samp{-W} in Make. - -@item assume-old -@samp{-o} in Make. - -@item auto-check -@samp{-a} in @code{recode}. - -@item auto-pager -@samp{-a} in @code{wdiff}. - -@item auto-reference -@samp{-A} in @code{ptx}. - -@item avoid-wraps -@samp{-n} in @code{wdiff}. - -@item backward-search -@samp{-B} in @code{ctags}. - -@item basename -@samp{-f} in @code{shar}. - -@item batch -Used in GDB. - -@item baud -Used in GDB. - -@item before -@samp{-b} in @code{tac}. - -@item binary -@samp{-b} in @code{cpio} and @code{diff}. - -@item bits-per-code -@samp{-b} in @code{shar}. - -@item block-size -Used in @code{cpio} and @code{tar}. - -@item blocks -@samp{-b} in @code{head} and @code{tail}. - -@item break-file -@samp{-b} in @code{ptx}. - -@item brief -Used in various programs to make output shorter. - -@item bytes -@samp{-c} in @code{head}, @code{split}, and @code{tail}. - -@item c@t{++} -@samp{-C} in @code{etags}. - -@item catenate -@samp{-A} in @code{tar}. - -@item cd -Used in various programs to specify the directory to use. - -@item changes -@samp{-c} in @code{chgrp} and @code{chown}. - -@item classify -@samp{-F} in @code{ls}. - -@item colons -@samp{-c} in @code{recode}. - -@item command -@samp{-c} in @code{su}; -@samp{-x} in GDB. - -@item compare -@samp{-d} in @code{tar}. - -@item compat -Used in @code{gawk}. - -@item compress -@samp{-Z} in @code{tar} and @code{shar}. - -@item concatenate -@samp{-A} in @code{tar}. - -@item confirmation -@samp{-w} in @code{tar}. - -@item context -Used in @code{diff}. - -@item copyleft -@samp{-W copyleft} in @code{gawk}. - -@item copyright -@samp{-C} in @code{ptx}, @code{recode}, and @code{wdiff}; -@samp{-W copyright} in @code{gawk}. - -@item core -Used in GDB. - -@item count -@samp{-q} in @code{who}. - -@item count-links -@samp{-l} in @code{du}. - -@item create -Used in @code{tar} and @code{cpio}. - -@item cut-mark -@samp{-c} in @code{shar}. - -@item cxref -@samp{-x} in @code{ctags}. - -@item date -@samp{-d} in @code{touch}. - -@item debug -@samp{-d} in Make and @code{m4}; -@samp{-t} in Bison. - -@item define -@samp{-D} in @code{m4}. - -@item defines -@samp{-d} in Bison and @code{ctags}. - -@item delete -@samp{-D} in @code{tar}. - -@item dereference -@samp{-L} in @code{chgrp}, @code{chown}, @code{cpio}, @code{du}, -@code{ls}, and @code{tar}. - -@item dereference-args -@samp{-D} in @code{du}. - -@item diacritics -@samp{-d} in @code{recode}. - -@item dictionary-order -@samp{-d} in @code{look}. - -@item diff -@samp{-d} in @code{tar}. - -@item digits -@samp{-n} in @code{csplit}. - -@item directory -Specify the directory to use, in various programs. In @code{ls}, it -means to show directories themselves rather than their contents. In -@code{rm} and @code{ln}, it means to not treat links to directories -specially. - -@item discard-all -@samp{-x} in @code{strip}. - -@item discard-locals -@samp{-X} in @code{strip}. - -@item dry-run -@samp{-n} in Make. - -@item ed -@samp{-e} in @code{diff}. - -@item elide-empty-files -@samp{-z} in @code{csplit}. - -@item end-delete -@samp{-x} in @code{wdiff}. - -@item end-insert -@samp{-z} in @code{wdiff}. - -@item entire-new-file -@samp{-N} in @code{diff}. - -@item environment-overrides -@samp{-e} in Make. - -@item eof -@samp{-e} in @code{xargs}. - -@item epoch -Used in GDB. - -@item error-limit -Used in @code{makeinfo}. - -@item error-output -@samp{-o} in @code{m4}. - -@item escape -@samp{-b} in @code{ls}. - -@item exclude-from -@samp{-X} in @code{tar}. - -@item exec -Used in GDB. - -@item exit -@samp{-x} in @code{xargs}. - -@item exit-0 -@samp{-e} in @code{unshar}. - -@item expand-tabs -@samp{-t} in @code{diff}. - -@item expression -@samp{-e} in @code{sed}. - -@item extern-only -@samp{-g} in @code{nm}. - -@item extract -@samp{-i} in @code{cpio}; -@samp{-x} in @code{tar}. - -@item faces -@samp{-f} in @code{finger}. - -@item fast -@samp{-f} in @code{su}. - -@item fatal-warnings -@samp{-E} in @code{m4}. - -@item file -@samp{-f} in @code{info}, @code{gawk}, Make, @code{mt}, and @code{tar}; -@samp{-n} in @code{sed}; -@samp{-r} in @code{touch}. - -@item field-separator -@samp{-F} in @code{gawk}. - -@item file-prefix -@samp{-b} in Bison. - -@item file-type -@samp{-F} in @code{ls}. - -@item files-from -@samp{-T} in @code{tar}. - -@item fill-column -Used in @code{makeinfo}. - -@item flag-truncation -@samp{-F} in @code{ptx}. - -@item fixed-output-files -@samp{-y} in Bison. - -@item follow -@samp{-f} in @code{tail}. - -@item footnote-style -Used in @code{makeinfo}. - -@item force -@samp{-f} in @code{cp}, @code{ln}, @code{mv}, and @code{rm}. - -@item force-prefix -@samp{-F} in @code{shar}. - -@item format -Used in @code{ls}, @code{time}, and @code{ptx}. - -@item freeze-state -@samp{-F} in @code{m4}. - -@item fullname -Used in GDB. - -@item gap-size -@samp{-g} in @code{ptx}. - -@item get -@samp{-x} in @code{tar}. - -@item graphic -@samp{-i} in @code{ul}. - -@item graphics -@samp{-g} in @code{recode}. - -@item group -@samp{-g} in @code{install}. - -@item gzip -@samp{-z} in @code{tar} and @code{shar}. - -@item hashsize -@samp{-H} in @code{m4}. - -@item header -@samp{-h} in @code{objdump} and @code{recode} - -@item heading -@samp{-H} in @code{who}. - -@item help -Used to ask for brief usage information. - -@item here-delimiter -@samp{-d} in @code{shar}. - -@item hide-control-chars -@samp{-q} in @code{ls}. - -@item idle -@samp{-u} in @code{who}. - -@item ifdef -@samp{-D} in @code{diff}. - -@item ignore -@samp{-I} in @code{ls}; -@samp{-x} in @code{recode}. - -@item ignore-all-space -@samp{-w} in @code{diff}. - -@item ignore-backups -@samp{-B} in @code{ls}. - -@item ignore-blank-lines -@samp{-B} in @code{diff}. - -@item ignore-case -@samp{-f} in @code{look} and @code{ptx}; -@samp{-i} in @code{diff} and @code{wdiff}. - -@item ignore-errors -@samp{-i} in Make. - -@item ignore-file -@samp{-i} in @code{ptx}. - -@item ignore-indentation -@samp{-I} in @code{etags}. - -@item ignore-init-file -@samp{-f} in Oleo. - -@item ignore-interrupts -@samp{-i} in @code{tee}. - -@item ignore-matching-lines -@samp{-I} in @code{diff}. - -@item ignore-space-change -@samp{-b} in @code{diff}. - -@item ignore-zeros -@samp{-i} in @code{tar}. - -@item include -@samp{-i} in @code{etags}; -@samp{-I} in @code{m4}. - -@item include-dir -@samp{-I} in Make. - -@item incremental -@samp{-G} in @code{tar}. - -@item info -@samp{-i}, @samp{-l}, and @samp{-m} in Finger. - -@item initial -@samp{-i} in @code{expand}. - -@item initial-tab -@samp{-T} in @code{diff}. - -@item inode -@samp{-i} in @code{ls}. - -@item interactive -@samp{-i} in @code{cp}, @code{ln}, @code{mv}, @code{rm}; -@samp{-e} in @code{m4}; -@samp{-p} in @code{xargs}; -@samp{-w} in @code{tar}. - -@item intermix-type -@samp{-p} in @code{shar}. - -@item jobs -@samp{-j} in Make. - -@item just-print -@samp{-n} in Make. - -@item keep-going -@samp{-k} in Make. - -@item keep-files -@samp{-k} in @code{csplit}. - -@item kilobytes -@samp{-k} in @code{du} and @code{ls}. - -@item language -@samp{-l} in @code{etags}. - -@item less-mode -@samp{-l} in @code{wdiff}. - -@item level-for-gzip -@samp{-g} in @code{shar}. - -@item line-bytes -@samp{-C} in @code{split}. - -@item lines -Used in @code{split}, @code{head}, and @code{tail}. - -@item link -@samp{-l} in @code{cpio}. - -@item lint -@itemx lint-old -Used in @code{gawk}. - -@item list -@samp{-t} in @code{cpio}; -@samp{-l} in @code{recode}. - -@item list -@samp{-t} in @code{tar}. - -@item literal -@samp{-N} in @code{ls}. - -@item load-average -@samp{-l} in Make. - -@item login -Used in @code{su}. - -@item machine -No listing of which programs already use this; -someone should check to -see if any actually do and tell @code{gnu@@prep.ai.mit.edu}. - -@item macro-name -@samp{-M} in @code{ptx}. - -@item mail -@samp{-m} in @code{hello} and @code{uname}. - -@item make-directories -@samp{-d} in @code{cpio}. - -@item makefile -@samp{-f} in Make. - -@item mapped -Used in GDB. - -@item max-args -@samp{-n} in @code{xargs}. - -@item max-chars -@samp{-n} in @code{xargs}. - -@item max-lines -@samp{-l} in @code{xargs}. - -@item max-load -@samp{-l} in Make. - -@item max-procs -@samp{-P} in @code{xargs}. - -@item mesg -@samp{-T} in @code{who}. - -@item message -@samp{-T} in @code{who}. - -@item minimal -@samp{-d} in @code{diff}. - -@item mixed-uuencode -@samp{-M} in @code{shar}. - -@item mode -@samp{-m} in @code{install}, @code{mkdir}, and @code{mkfifo}. - -@item modification-time -@samp{-m} in @code{tar}. - -@item multi-volume -@samp{-M} in @code{tar}. - -@item name-prefix -@samp{-a} in Bison. - -@item nesting-limit -@samp{-L} in @code{m4}. - -@item net-headers -@samp{-a} in @code{shar}. - -@item new-file -@samp{-W} in Make. - -@item no-builtin-rules -@samp{-r} in Make. - -@item no-character-count -@samp{-w} in @code{shar}. - -@item no-check-existing -@samp{-x} in @code{shar}. - -@item no-common -@samp{-3} in @code{wdiff}. - -@item no-create -@samp{-c} in @code{touch}. - -@item no-defines -@samp{-D} in @code{etags}. - -@item no-deleted -@samp{-1} in @code{wdiff}. - -@item no-dereference -@samp{-d} in @code{cp}. - -@item no-inserted -@samp{-2} in @code{wdiff}. - -@item no-keep-going -@samp{-S} in Make. - -@item no-lines -@samp{-l} in Bison. - -@item no-piping -@samp{-P} in @code{shar}. - -@item no-prof -@samp{-e} in @code{gprof}. - -@item no-regex -@samp{-R} in @code{etags}. - -@item no-sort -@samp{-p} in @code{nm}. - -@item no-split -Used in @code{makeinfo}. - -@item no-static -@samp{-a} in @code{gprof}. - -@item no-time -@samp{-E} in @code{gprof}. - -@item no-timestamp -@samp{-m} in @code{shar}. - -@item no-validate -Used in @code{makeinfo}. - -@item no-warn -Used in various programs to inhibit warnings. - -@item node -@samp{-n} in @code{info}. - -@item nodename -@samp{-n} in @code{uname}. - -@item nonmatching -@samp{-f} in @code{cpio}. - -@item nstuff -@samp{-n} in @code{objdump}. - -@item null -@samp{-0} in @code{xargs}. - -@item number -@samp{-n} in @code{cat}. - -@item number-nonblank -@samp{-b} in @code{cat}. - -@item numeric-sort -@samp{-n} in @code{nm}. - -@item numeric-uid-gid -@samp{-n} in @code{cpio} and @code{ls}. - -@item nx -Used in GDB. - -@item old-archive -@samp{-o} in @code{tar}. - -@item old-file -@samp{-o} in Make. - -@item one-file-system -@samp{-l} in @code{tar}, @code{cp}, and @code{du}. - -@item only-file -@samp{-o} in @code{ptx}. - -@item only-prof -@samp{-f} in @code{gprof}. - -@item only-time -@samp{-F} in @code{gprof}. - -@item output -In various programs, specify the output file name. - -@item output-prefix -@samp{-o} in @code{shar}. - -@item override -@samp{-o} in @code{rm}. - -@item overwrite -@samp{-c} in @code{unshar}. - -@item owner -@samp{-o} in @code{install}. - -@item paginate -@samp{-l} in @code{diff}. - -@item paragraph-indent -Used in @code{makeinfo}. - -@item parents -@samp{-p} in @code{mkdir} and @code{rmdir}. - -@item pass-all -@samp{-p} in @code{ul}. - -@item pass-through -@samp{-p} in @code{cpio}. - -@item port -@samp{-P} in @code{finger}. - -@item portability -@samp{-c} in @code{cpio} and @code{tar}. - -@item posix -Used in @code{gawk}. - -@item prefix-builtins -@samp{-P} in @code{m4}. - -@item prefix -@samp{-f} in @code{csplit}. - -@item preserve -Used in @code{tar} and @code{cp}. - -@item preserve-environment -@samp{-p} in @code{su}. - -@item preserve-modification-time -@samp{-m} in @code{cpio}. - -@item preserve-order -@samp{-s} in @code{tar}. - -@item preserve-permissions -@samp{-p} in @code{tar}. - -@item print -@samp{-l} in @code{diff}. - -@item print-chars -@samp{-L} in @code{cmp}. - -@item print-data-base -@samp{-p} in Make. - -@item print-directory -@samp{-w} in Make. - -@item print-file-name -@samp{-o} in @code{nm}. - -@item print-symdefs -@samp{-s} in @code{nm}. - -@item printer -@samp{-p} in @code{wdiff}. - -@item prompt -@samp{-p} in @code{ed}. - -@item query-user -@samp{-X} in @code{shar}. - -@item question -@samp{-q} in Make. - -@item quiet -Used in many programs to inhibit the usual output. @strong{Please -note:} every program accepting @samp{--quiet} should accept -@samp{--silent} as a synonym. - -@item quiet-unshar -@samp{-Q} in @code{shar} - -@item quote-name -@samp{-Q} in @code{ls}. - -@item rcs -@samp{-n} in @code{diff}. - -@item re-interval -Used in @code{gawk}. - -@item read-full-blocks -@samp{-B} in @code{tar}. - -@item readnow -Used in GDB. - -@item recon -@samp{-n} in Make. - -@item record-number -@samp{-R} in @code{tar}. - -@item recursive -Used in @code{chgrp}, @code{chown}, @code{cp}, @code{ls}, @code{diff}, -and @code{rm}. - -@item reference-limit -Used in @code{makeinfo}. - -@item references -@samp{-r} in @code{ptx}. - -@item regex -@samp{-r} in @code{tac} and @code{etags}. - -@item release -@samp{-r} in @code{uname}. - -@item reload-state -@samp{-R} in @code{m4}. - -@item relocation -@samp{-r} in @code{objdump}. - -@item rename -@samp{-r} in @code{cpio}. - -@item replace -@samp{-i} in @code{xargs}. - -@item report-identical-files -@samp{-s} in @code{diff}. - -@item reset-access-time -@samp{-a} in @code{cpio}. - -@item reverse -@samp{-r} in @code{ls} and @code{nm}. - -@item reversed-ed -@samp{-f} in @code{diff}. - -@item right-side-defs -@samp{-R} in @code{ptx}. - -@item same-order -@samp{-s} in @code{tar}. - -@item same-permissions -@samp{-p} in @code{tar}. - -@item save -@samp{-g} in @code{stty}. - -@item se -Used in GDB. - -@item sentence-regexp -@samp{-S} in @code{ptx}. - -@item separate-dirs -@samp{-S} in @code{du}. - -@item separator -@samp{-s} in @code{tac}. - -@item sequence -Used by @code{recode} to chose files or pipes for sequencing passes. - -@item shell -@samp{-s} in @code{su}. - -@item show-all -@samp{-A} in @code{cat}. - -@item show-c-function -@samp{-p} in @code{diff}. - -@item show-ends -@samp{-E} in @code{cat}. - -@item show-function-line -@samp{-F} in @code{diff}. - -@item show-tabs -@samp{-T} in @code{cat}. - -@item silent -Used in many programs to inhibit the usual output. -@strong{Please note:} every program accepting -@samp{--silent} should accept @samp{--quiet} as a synonym. - -@item size -@samp{-s} in @code{ls}. - -@item sort -Used in @code{ls}. - -@item source -@samp{-W source} in @code{gawk}. - -@item sparse -@samp{-S} in @code{tar}. - -@item speed-large-files -@samp{-H} in @code{diff}. - -@item split-at -@samp{-E} in @code{unshar}. - -@item split-size-limit -@samp{-L} in @code{shar}. - -@item squeeze-blank -@samp{-s} in @code{cat}. - -@item start-delete -@samp{-w} in @code{wdiff}. - -@item start-insert -@samp{-y} in @code{wdiff}. - -@item starting-file -Used in @code{tar} and @code{diff} to specify which file within -a directory to start processing with. - -@item statistics -@samp{-s} in @code{wdiff}. - -@item stdin-file-list -@samp{-S} in @code{shar}. - -@item stop -@samp{-S} in Make. - -@item strict -@samp{-s} in @code{recode}. - -@item strip -@samp{-s} in @code{install}. - -@item strip-all -@samp{-s} in @code{strip}. - -@item strip-debug -@samp{-S} in @code{strip}. - -@item submitter -@samp{-s} in @code{shar}. - -@item suffix -@samp{-S} in @code{cp}, @code{ln}, @code{mv}. - -@item suffix-format -@samp{-b} in @code{csplit}. - -@item sum -@samp{-s} in @code{gprof}. - -@item summarize -@samp{-s} in @code{du}. - -@item symbolic -@samp{-s} in @code{ln}. - -@item symbols -Used in GDB and @code{objdump}. - -@item synclines -@samp{-s} in @code{m4}. - -@item sysname -@samp{-s} in @code{uname}. - -@item tabs -@samp{-t} in @code{expand} and @code{unexpand}. - -@item tabsize -@samp{-T} in @code{ls}. - -@item terminal -@samp{-T} in @code{tput} and @code{ul}. -@samp{-t} in @code{wdiff}. - -@item text -@samp{-a} in @code{diff}. - -@item text-files -@samp{-T} in @code{shar}. - -@item time -Used in @code{ls} and @code{touch}. - -@item to-stdout -@samp{-O} in @code{tar}. - -@item total -@samp{-c} in @code{du}. - -@item touch -@samp{-t} in Make, @code{ranlib}, and @code{recode}. - -@item trace -@samp{-t} in @code{m4}. - -@item traditional -@samp{-t} in @code{hello}; -@samp{-W traditional} in @code{gawk}; -@samp{-G} in @code{ed}, @code{m4}, and @code{ptx}. - -@item tty -Used in GDB. - -@item typedefs -@samp{-t} in @code{ctags}. - -@item typedefs-and-c++ -@samp{-T} in @code{ctags}. - -@item typeset-mode -@samp{-t} in @code{ptx}. - -@item uncompress -@samp{-z} in @code{tar}. - -@item unconditional -@samp{-u} in @code{cpio}. - -@item undefine -@samp{-U} in @code{m4}. - -@item undefined-only -@samp{-u} in @code{nm}. - -@item update -@samp{-u} in @code{cp}, @code{ctags}, @code{mv}, @code{tar}. - -@item usage -Used in @code{gawk}; same as @samp{--help}. - -@item uuencode -@samp{-B} in @code{shar}. - -@item vanilla-operation -@samp{-V} in @code{shar}. - -@item verbose -Print more information about progress. Many programs support this. - -@item verify -@samp{-W} in @code{tar}. - -@item version -Print the version number. - -@item version-control -@samp{-V} in @code{cp}, @code{ln}, @code{mv}. - -@item vgrind -@samp{-v} in @code{ctags}. - -@item volume -@samp{-V} in @code{tar}. - -@item what-if -@samp{-W} in Make. - -@item whole-size-limit -@samp{-l} in @code{shar}. - -@item width -@samp{-w} in @code{ls} and @code{ptx}. - -@item word-regexp -@samp{-W} in @code{ptx}. - -@item writable -@samp{-T} in @code{who}. - -@item zeros -@samp{-z} in @code{gprof}. -@end table - -@node Memory Usage -@section Memory Usage - -If it typically uses just a few meg of memory, don't bother making any -effort to reduce memory usage. For example, if it is impractical for -other reasons to operate on files more than a few meg long, it is -reasonable to read entire input files into core to operate on them. - -However, for programs such as @code{cat} or @code{tail}, that can -usefully operate on very large files, it is important to avoid using a -technique that would artificially limit the size of files it can handle. -If a program works by lines and could be applied to arbitrary -user-supplied input files, it should keep only a line in memory, because -this is not very hard and users will want to be able to operate on input -files that are bigger than will fit in core all at once. - -If your program creates complicated data structures, just make them in -core and give a fatal error if @code{malloc} returns zero. - -@node Writing C -@chapter Making The Best Use of C - -This @value{CHAPTER} provides advice on how best to use the C language -when writing GNU software. - -@menu -* Formatting:: Formatting Your Source Code -* Comments:: Commenting Your Work -* Syntactic Conventions:: Clean Use of C Constructs -* Names:: Naming Variables and Functions -* System Portability:: Portability between different operating systems -* CPU Portability:: Supporting the range of CPU types -* System Functions:: Portability and ``standard'' library functions -* Internationalization:: Techniques for internationalization -@end menu - -@node Formatting -@section Formatting Your Source Code - -It is important to put the open-brace that starts the body of a C -function in column zero, and avoid putting any other open-brace or -open-parenthesis or open-bracket in column zero. Several tools look -for open-braces in column zero to find the beginnings of C functions. -These tools will not work on code not formatted that way. - -It is also important for function definitions to start the name of the -function in column zero. This helps people to search for function -definitions, and may also help certain tools recognize them. Thus, -the proper format is this: - -@example -static char * -concat (s1, s2) /* Name starts in column zero here */ - char *s1, *s2; -@{ /* Open brace in column zero here */ - @dots{} -@} -@end example - -@noindent -or, if you want to use @sc{ansi} C, format the definition like this: - -@example -static char * -concat (char *s1, char *s2) -@{ - @dots{} -@} -@end example - -In @sc{ansi} C, if the arguments don't fit nicely on one line, -split it like this: - -@example -int -lots_of_args (int an_integer, long a_long, short a_short, - double a_double, float a_float) -@dots{} -@end example - -For the body of the function, we prefer code formatted like this: - -@example -if (x < foo (y, z)) - haha = bar[4] + 5; -else - @{ - while (z) - @{ - haha += foo (z, z); - z--; - @} - return ++x + bar (); - @} -@end example - -We find it easier to read a program when it has spaces before the -open-parentheses and after the commas. Especially after the commas. - -When you split an expression into multiple lines, split it -before an operator, not after one. Here is the right way: - -@example -if (foo_this_is_long && bar > win (x, y, z) - && remaining_condition) -@end example - -Try to avoid having two operators of different precedence at the same -level of indentation. For example, don't write this: - -@example -mode = (inmode[j] == VOIDmode - || GET_MODE_SIZE (outmode[j]) > GET_MODE_SIZE (inmode[j]) - ? outmode[j] : inmode[j]); -@end example - -Instead, use extra parentheses so that the indentation shows the nesting: - -@example -mode = ((inmode[j] == VOIDmode - || (GET_MODE_SIZE (outmode[j]) > GET_MODE_SIZE (inmode[j]))) - ? outmode[j] : inmode[j]); -@end example - -Insert extra parentheses so that Emacs will indent the code properly. -For example, the following indentation looks nice if you do it by hand, -but Emacs would mess it up: - -@example -v = rup->ru_utime.tv_sec*1000 + rup->ru_utime.tv_usec/1000 - + rup->ru_stime.tv_sec*1000 + rup->ru_stime.tv_usec/1000; -@end example - -But adding a set of parentheses solves the problem: - -@example -v = (rup->ru_utime.tv_sec*1000 + rup->ru_utime.tv_usec/1000 - + rup->ru_stime.tv_sec*1000 + rup->ru_stime.tv_usec/1000); -@end example - -Format do-while statements like this: - -@example -do - @{ - a = foo (a); - @} -while (a > 0); -@end example - -Please use formfeed characters (control-L) to divide the program into -pages at logical places (but not within a function). It does not matter -just how long the pages are, since they do not have to fit on a printed -page. The formfeeds should appear alone on lines by themselves. - - -@node Comments -@section Commenting Your Work - -Every program should start with a comment saying briefly what it is for. -Example: @samp{fmt - filter for simple filling of text}. - -Please put a comment on each function saying what the function does, -what sorts of arguments it gets, and what the possible values of -arguments mean and are used for. It is not necessary to duplicate in -words the meaning of the C argument declarations, if a C type is being -used in its customary fashion. If there is anything nonstandard about -its use (such as an argument of type @code{char *} which is really the -address of the second character of a string, not the first), or any -possible values that would not work the way one would expect (such as, -that strings containing newlines are not guaranteed to work), be sure -to say so. - -Also explain the significance of the return value, if there is one. - -Please put two spaces after the end of a sentence in your comments, so -that the Emacs sentence commands will work. Also, please write -complete sentences and capitalize the first word. If a lower-case -identifier comes at the beginning of a sentence, don't capitalize it! -Changing the spelling makes it a different identifier. If you don't -like starting a sentence with a lower case letter, write the sentence -differently (e.g., ``The identifier lower-case is @dots{}''). - -The comment on a function is much clearer if you use the argument -names to speak about the argument values. The variable name itself -should be lower case, but write it in upper case when you are speaking -about the value rather than the variable itself. Thus, ``the inode -number NODE_NUM'' rather than ``an inode''. - -There is usually no purpose in restating the name of the function in -the comment before it, because the reader can see that for himself. -There might be an exception when the comment is so long that the function -itself would be off the bottom of the screen. - -There should be a comment on each static variable as well, like this: - -@example -/* Nonzero means truncate lines in the display; - zero means continue them. */ -int truncate_lines; -@end example - -Every @samp{#endif} should have a comment, except in the case of short -conditionals (just a few lines) that are not nested. The comment should -state the condition of the conditional that is ending, @emph{including -its sense}. @samp{#else} should have a comment describing the condition -@emph{and sense} of the code that follows. For example: - -@example -@group -#ifdef foo - @dots{} -#else /* not foo */ - @dots{} -#endif /* not foo */ -@end group -@end example - -@noindent -but, by contrast, write the comments this way for a @samp{#ifndef}: - -@example -@group -#ifndef foo - @dots{} -#else /* foo */ - @dots{} -#endif /* foo */ -@end group -@end example - - -@node Syntactic Conventions -@section Clean Use of C Constructs - -Please explicitly declare all arguments to functions. -Don't omit them just because they are @code{int}s. - -Declarations of external functions and functions to appear later in the -source file should all go in one place near the beginning of the file -(somewhere before the first function definition in the file), or else -should go in a header file. Don't put @code{extern} declarations inside -functions. - -It used to be common practice to use the same local variables (with -names like @code{tem}) over and over for different values within one -function. Instead of doing this, it is better declare a separate local -variable for each distinct purpose, and give it a name which is -meaningful. This not only makes programs easier to understand, it also -facilitates optimization by good compilers. You can also move the -declaration of each local variable into the smallest scope that includes -all its uses. This makes the program even cleaner. - -Don't use local variables or parameters that shadow global identifiers. - -Don't declare multiple variables in one declaration that spans lines. -Start a new declaration on each line, instead. For example, instead -of this: - -@example -@group -int foo, - bar; -@end group -@end example - -@noindent -write either this: - -@example -int foo, bar; -@end example - -@noindent -or this: - -@example -int foo; -int bar; -@end example - -@noindent -(If they are global variables, each should have a comment preceding it -anyway.) - -When you have an @code{if}-@code{else} statement nested in another -@code{if} statement, always put braces around the @code{if}-@code{else}. -Thus, never write like this: - -@example -if (foo) - if (bar) - win (); - else - lose (); -@end example - -@noindent -always like this: - -@example -if (foo) - @{ - if (bar) - win (); - else - lose (); - @} -@end example - -If you have an @code{if} statement nested inside of an @code{else} -statement, either write @code{else if} on one line, like this, - -@example -if (foo) - @dots{} -else if (bar) - @dots{} -@end example - -@noindent -with its @code{then}-part indented like the preceding @code{then}-part, -or write the nested @code{if} within braces like this: - -@example -if (foo) - @dots{} -else - @{ - if (bar) - @dots{} - @} -@end example - -Don't declare both a structure tag and variables or typedefs in the -same declaration. Instead, declare the structure tag separately -and then use it to declare the variables or typedefs. - -Try to avoid assignments inside @code{if}-conditions. For example, -don't write this: - -@example -if ((foo = (char *) malloc (sizeof *foo)) == 0) - fatal ("virtual memory exhausted"); -@end example - -@noindent -instead, write this: - -@example -foo = (char *) malloc (sizeof *foo); -if (foo == 0) - fatal ("virtual memory exhausted"); -@end example - -Don't make the program ugly to placate @code{lint}. Please don't insert any -casts to @code{void}. Zero without a cast is perfectly fine as a null -pointer constant, except when calling a varargs function. - -@node Names -@section Naming Variables and Functions - -Please use underscores to separate words in a name, so that the Emacs -word commands can be useful within them. Stick to lower case; reserve -upper case for macros and @code{enum} constants, and for name-prefixes -that follow a uniform convention. - -For example, you should use names like @code{ignore_space_change_flag}; -don't use names like @code{iCantReadThis}. - -Variables that indicate whether command-line options have been -specified should be named after the meaning of the option, not after -the option-letter. A comment should state both the exact meaning of -the option and its letter. For example, - -@example -@group -/* Ignore changes in horizontal whitespace (-b). */ -int ignore_space_change_flag; -@end group -@end example - -When you want to define names with constant integer values, use -@code{enum} rather than @samp{#define}. GDB knows about enumeration -constants. - -Use file names of 14 characters or less, to avoid creating gratuitous -problems on older System V systems. You can use the program @code{doschk} to test for -this. @code{doschk} also tests for potential name conflicts if the -files were loaded onto an MS-DOS file system---something you may or may -not care about. - -@node System Portability -@section Portability between System Types - -In the Unix world, ``portability'' refers to porting to different Unix -versions. For a GNU program, this kind of portability is desirable, but -not paramount. - -The primary purpose of GNU software is to run on top of the GNU kernel, -compiled with the GNU C compiler, on various types of @sc{cpu}. The -amount and kinds of variation among GNU systems on different @sc{cpu}s -will be comparable to the variation among Linux-based GNU systems or -among BSD systems today. So the kinds of portability that are absolutely -necessary are quite limited. - -But many users do run GNU software on non-GNU Unix or Unix-like systems. -So supporting a variety of Unix-like systems is desirable, although not -paramount. - -The easiest way to achieve portability to most Unix-like systems is to -use Autoconf. It's unlikely that your program needs to know more -information about the host platform than Autoconf can provide, simply -because most of the programs that need such knowledge have already been -written. - -Avoid using the format of semi-internal data bases (e.g., directories) -when there is a higher-level alternative (@code{readdir}). - -As for systems that are not like Unix, such as MSDOS, Windows, the -Macintosh, VMS, and MVS, supporting them is usually so much work that it -is better if you don't. - -The planned GNU kernel is not finished yet, but you can tell which -facilities it will provide by looking at the GNU C Library Manual. The -GNU kernel is based on Mach, so the features of Mach will also be -available. However, if you use Mach features, you'll probably have -trouble debugging your program today. - -@node CPU Portability -@section Portability between @sc{cpu}s - -Even GNU systems will differ because of differences among @sc{cpu} -types---for example, difference in byte ordering and alignment -requirements. It is absolutely essential to handle these differences. -However, don't make any effort to cater to the possibility that an -@code{int} will be less than 32 bits. We don't support 16-bit machines -in GNU. - -Don't assume that the address of an @code{int} object is also the -address of its least-significant byte. This is false on big-endian -machines. Thus, don't make the following mistake: - -@example -int c; -@dots{} -while ((c = getchar()) != EOF) - write(file_descriptor, &c, 1); -@end example - -When calling functions, you need not worry about the difference between -pointers of various types, or between pointers and integers. On most -machines, there's no difference anyway. As for the few machines where -there is a difference, all of them support @sc{ansi} C, so you can use -prototypes (conditionalized to be active only in @sc{ansi} C) to make -the code work on those systems. - -In certain cases, it is ok to pass integer and pointer arguments -indiscriminately to the same function, and use no prototype on any -system. For example, many GNU programs have error-reporting functions -that pass their arguments along to @code{printf} and friends: - -@example -error (s, a1, a2, a3) - char *s; - int a1, a2, a3; -@{ - fprintf (stderr, "error: "); - fprintf (stderr, s, a1, a2, a3); -@} -@end example - -@noindent -In practice, this works on all machines, and it is much simpler than any -``correct'' alternative. Be sure @emph{not} to use a prototype -for such functions. - -However, avoid casting pointers to integers unless you really need to. -These assumptions really reduce portability, and in most programs they -are easy to avoid. In the cases where casting pointers to integers is -essential---such as, a Lisp interpreter which stores type information as -well as an address in one word---it is ok to do so, but you'll have to -make explicit provisions to handle different word sizes. - -@node System Functions -@section Calling System Functions - -C implementations differ substantially. @sc{ansi} C reduces but does not -eliminate the incompatibilities; meanwhile, many users wish to compile -GNU software with pre-@sc{ansi} compilers. This chapter gives -recommendations for how to use the more or less standard C library -functions to avoid unnecessary loss of portability. - -@itemize @bullet -@item -Don't use the value of @code{sprintf}. It returns the number of -characters written on some systems, but not on all systems. - -@item -Don't declare system functions explicitly. - -Almost any declaration for a system function is wrong on some system. -To minimize conflicts, leave it to the system header files to declare -system functions. If the headers don't declare a function, let it -remain undeclared. - -While it may seem unclean to use a function without declaring it, in -practice this works fine for most system library functions on the -systems where this really happens; thus, the disadvantage is only -theoretical. By contrast, actual declarations have frequently caused -actual conflicts. - -@item -If you must declare a system function, don't specify the argument types. -Use an old-style declaration, not an @sc{ansi} prototype. The more you -specify about the function, the more likely a conflict. - -@item -In particular, don't unconditionally declare @code{malloc} or -@code{realloc}. - -Most GNU programs use those functions just once, in functions -conventionally named @code{xmalloc} and @code{xrealloc}. These -functions call @code{malloc} and @code{realloc}, respectively, and -check the results. - -Because @code{xmalloc} and @code{xrealloc} are defined in your program, -you can declare them in other files without any risk of type conflict. - -On most systems, @code{int} is the same length as a pointer; thus, the -calls to @code{malloc} and @code{realloc} work fine. For the few -exceptional systems (mostly 64-bit machines), you can use -@strong{conditionalized} declarations of @code{malloc} and -@code{realloc}---or put these declarations in configuration files -specific to those systems. - -@item -The string functions require special treatment. Some Unix systems have -a header file @file{string.h}; others have @file{strings.h}. Neither -file name is portable. There are two things you can do: use Autoconf to -figure out which file to include, or don't include either file. - -@item -If you don't include either strings file, you can't get declarations for -the string functions from the header file in the usual way. - -That causes less of a problem than you might think. The newer @sc{ansi} -string functions should be avoided anyway because many systems still -don't support them. The string functions you can use are these: - -@example -strcpy strncpy strcat strncat -strlen strcmp strncmp -strchr strrchr -@end example - -The copy and concatenate functions work fine without a declaration as -long as you don't use their values. Using their values without a -declaration fails on systems where the width of a pointer differs from -the width of @code{int}, and perhaps in other cases. It is trivial to -avoid using their values, so do that. - -The compare functions and @code{strlen} work fine without a declaration -on most systems, possibly all the ones that GNU software runs on. -You may find it necessary to declare them @strong{conditionally} on a -few systems. - -The search functions must be declared to return @code{char *}. Luckily, -there is no variation in the data type they return. But there is -variation in their names. Some systems give these functions the names -@code{index} and @code{rindex}; other systems use the names -@code{strchr} and @code{strrchr}. Some systems support both pairs of -names, but neither pair works on all systems. - -You should pick a single pair of names and use it throughout your -program. (Nowadays, it is better to choose @code{strchr} and -@code{strrchr} for new programs, since those are the standard @sc{ansi} -names.) Declare both of those names as functions returning @code{char -*}. On systems which don't support those names, define them as macros -in terms of the other pair. For example, here is what to put at the -beginning of your file (or in a header) if you want to use the names -@code{strchr} and @code{strrchr} throughout: - -@example -#ifndef HAVE_STRCHR -#define strchr index -#endif -#ifndef HAVE_STRRCHR -#define strrchr rindex -#endif - -char *strchr (); -char *strrchr (); -@end example -@end itemize - -Here we assume that @code{HAVE_STRCHR} and @code{HAVE_STRRCHR} are -macros defined in systems where the corresponding functions exist. -One way to get them properly defined is to use Autoconf. - -@node Internationalization -@section Internationalization - -GNU has a library called GNU gettext that makes it easy to translate the -messages in a program into various languages. You should use this -library in every program. Use English for the messages as they appear -in the program, and let gettext provide the way to translate them into -other languages. - -Using GNU gettext involves putting a call to the @code{gettext} macro -around each string that might need translation---like this: - -@example -printf (gettext ("Processing file `%s'...")); -@end example - -@noindent -This permits GNU gettext to replace the string @code{"Processing file -`%s'..."} with a translated version. - -Once a program uses gettext, please make a point of writing calls to -@code{gettext} when you add new strings that call for translation. - -Using GNU gettext in a package involves specifying a @dfn{text domain -name} for the package. The text domain name is used to separate the -translations for this package from the translations for other packages. -Normally, the text domain name should be the same as the name of the -package---for example, @samp{fileutils} for the GNU file utilities. - -To enable gettext to work, avoid writing code that makes assumptions -about the structure of words. Don't construct words from parts. Here -is an example of what not to do: - -@example -prinf ("%d file%s processed", nfiles, - nfiles > 1 ? "s" : ""); -@end example - -@noindent -The problem with that example is that it assumes that plurals are made -by adding `s'. If you apply gettext to the format string, like this, - -@example -prinf (gettext ("%d file%s processed"), nfiles, - nfiles > 1 ? "s" : ""); -@end example - -@noindent -the message can use different words, but it will still be forced to use -`s' for the plural. Here is a better way: - -@example -prinf ((nfiles > 1 ? "%d files processed" - : "%d file processed"), - nfiles); -@end example - -@noindent -This way, you can apply gettext to each of the two strings -independently: - -@example -prinf ((nfiles > 1 ? gettext ("%d files processed") - : gettext ("%d file processed")), - nfiles); -@end example - -@noindent -This can handle any language, no matter how it forms the plural of the -word for ``file.'' - -@node Documentation -@chapter Documenting Programs - -@menu -* GNU Manuals:: Writing proper manuals. -* Manual Structure Details:: Specific structure conventions. -* NEWS File:: NEWS files supplement manuals. -* Change Logs:: Recording Changes -* Man Pages:: Man pages are secondary. -* Reading other Manuals:: How far you can go in learning - from other manuals. -@end menu - -@node GNU Manuals -@section GNU Manuals - -The preferred way to document part of the GNU system is to write a -manual in the Texinfo formatting language. See the Texinfo manual, -either the hardcopy, or the on-line version available through -@code{info} or the Emacs Info subsystem (@kbd{C-h i}). - -The manual should document all of the program's command-line options and -all of its commands. It should give examples of their use. But don't -organize the manual as a list of features. Instead, organize it -logically, by subtopics. Address the goals that a user will have in -mind, and explain how to accomplish them. - -In general, a GNU manual should serve both as tutorial and reference. -It should be set up for convenient access to each topic through Info, -and for reading straight through (appendixes aside). A GNU manual -should give a good introduction to a beginner reading through from the -start, and should also provide all the details that hackers want. - -That is not as hard as it first sounds. Arrange each chapter as a -logical breakdown of its topic, but order the sections, and write their -text, so that reading the chapter straight through makes sense. Do -likewise when structuring the book into chapters, and when structuring a -section into paragraphs. The watchword is, @emph{at each point, address -the most fundamental and important issue raised by the preceding text.} - -If necessary, add extra chapters at the beginning of the manual which -are purely tutorial and cover the basics of the subject. These provide -the framework for a beginner to understand the rest of the manual. The -Bison manual provides a good example of how to do this. - -Don't use Unix man pages as a model for how to write GNU documentation; -they are a bad example to follow. - -Please do not use the term ``pathname'' that is used in Unix -documentation; use ``file name'' (two words) instead. We use the term -``path'' only for search paths, which are lists of file names. - -@node Manual Structure Details -@section Manual Structure Details - -The title page of the manual should state the version of the program -to which the manual applies. The Top node of the manual should also -contain this information. If the manual is changing more frequently -than or independent of the program, also state a version number for -the manual in both of these places. - -The manual should have a node named @samp{@var{program} Invocation} or -@samp{Invoking @var{program}}, where @var{program} stands for the name -of the program being described, as you would type it in the shell to run -the program. This node (together with its subnodes, if any) should -describe the program's command line arguments and how to run it (the -sort of information people would look in a man page for). Start with an -@samp{@@example} containing a template for all the options and arguments -that the program uses. - -Alternatively, put a menu item in some menu whose item name fits one of -the above patterns. This identifies the node which that item points to -as the node for this purpose, regardless of the node's actual name. - -There will be automatic features for specifying a program name and -quickly reading just this part of its manual. - -If one manual describes several programs, it should have such a node for -each program described. - -@node NEWS File -@section The NEWS File - -In addition to its manual, the package should have a file named -@file{NEWS} which contains a list of user-visible changes worth -mentioning. In each new release, add items to the front of the file and -identify the version they pertain to. Don't discard old items; leave -them in the file after the newer items. This way, a user upgrading from -any previous version can see what is new. - -If the @file{NEWS} file gets very long, move some of the older items -into a file named @file{ONEWS} and put a note at the end referring the -user to that file. - -@node Change Logs -@section Change Logs - -Keep a change log to describe all the changes made to program source -files. The purpose of this is so that people investigating bugs in the -future will know about the changes that might have introduced the bug. -Often a new bug can be found by looking at what was recently changed. -More importantly, change logs can help eliminate conceptual -inconsistencies between different parts of a program; they can give you -a history of how the conflicting concepts arose. - -A change log file is normally called @file{ChangeLog} and covers an -entire directory. Each directory can have its own change log, or a -directory can use the change log of its parent directory--it's up to -you. - -Another alternative is to record change log information with a version -control system such as RCS or CVS. This can be converted automatically -to a @file{ChangeLog} file. - -The easiest way to add an entry to @file{ChangeLog} is with the Emacs -command @kbd{M-x add-change-log-entry}. An entry should have an -asterisk, the name of the changed file, and then in parentheses the name -of the changed functions, variables or whatever, followed by a colon. -Then describe the changes you made to that function or variable. - -Separate unrelated entries with blank lines. When two entries -represent parts of the same change, so that they work together, then -don't put blank lines between them. Then you can omit the file name -and the asterisk when successive entries are in the same file. - -Here are some examples: - -@example -* register.el (insert-register): Return nil. -(jump-to-register): Likewise. - -* sort.el (sort-subr): Return nil. - -* tex-mode.el (tex-bibtex-file, tex-file, tex-region): -Restart the tex shell if process is gone or stopped. -(tex-shell-running): New function. - -* expr.c (store_one_arg): Round size up for move_block_to_reg. -(expand_call): Round up when emitting USE insns. -* stmt.c (assign_parms): Round size up for move_block_from_reg. -@end example - -It's important to name the changed function or variable in full. Don't -abbreviate function or variable names, and don't combine them. -Subsequent maintainers will often -search for a function name to find all the change log entries that -pertain to it; if you abbreviate the name, they won't find it when they -search. For example, some people are tempted to abbreviate groups of -function names by writing @samp{* register.el -(@{insert,jump-to@}-register)}; this is not a good idea, since searching -for @code{jump-to-register} or @code{insert-register} would not find the -entry. - -There's no need to describe the full purpose of the changes or how they -work together. It is better to put such explanations in comments in the -code. That's why just ``New function'' is enough; there is a comment -with the function in the source to explain what it does. - -However, sometimes it is useful to write one line to describe the -overall purpose of a large batch of changes. - -You can think of the change log as a conceptual ``undo list'' which -explains how earlier versions were different from the current version. -People can see the current version; they don't need the change log -to tell them what is in it. What they want from a change log is a -clear explanation of how the earlier version differed. - -When you change the calling sequence of a function in a simple -fashion, and you change all the callers of the function, there is no -need to make individual entries for all the callers. Just write in -the entry for the function being called, ``All callers changed.'' - -When you change just comments or doc strings, it is enough to write an -entry for the file, without mentioning the functions. Write just, -``Doc fix.'' - -There's no need to make change log entries for documentation files. -This is because documentation is not susceptible to bugs that are hard -to fix. Documentation does not consist of parts that must interact in a -precisely engineered fashion. To correct an error, you need not know -the history of the erroneous passage; it is enough to compare the -passage with the way the program actually works. - -@node Man Pages -@section Man Pages - -In the GNU project, man pages are secondary. It is not necessary or -expected for every GNU program to have a man page, but some of them do. -It's your choice whether to include a man page in your program. - -When you make this decision, consider that supporting a man page -requires continual effort each time the program is changed. The time -you spend on the man page is time taken away from more useful work. - -For a simple program which changes little, updating the man page may be -a small job. Then there is little reason not to include a man page, if -you have one. - -For a large program that changes a great deal, updating a man page may -be a substantial burden. If a user offers to donate a man page, you may -find this gift costly to accept. It may be better to refuse the man -page unless the same person agrees to take full responsibility for -maintaining it---so that you can wash your hands of it entirely. If -this volunteer later ceases to do the job, then don't feel obliged to -pick it up yourself; it may be better to withdraw the man page from the -distribution until someone else agrees to update it. - -When a program changes only a little, you may feel that the -discrepancies are small enough that the man page remains useful without -updating. If so, put a prominent note near the beginning of the man -page explaining that you don't maintain it and that the Texinfo manual -is more authoritative. The note should say how to access the Texinfo -documentation. - -@node Reading other Manuals -@section Reading other Manuals - -There may be non-free books or documentation files that describe the -program you are documenting. - -It is ok to use these documents for reference, just as the author of a -new algebra textbook can read other books on algebra. A large portion -of any non-fiction book consists of facts, in this case facts about how -a certain program works, and these facts are necessarily the same for -everyone who writes about the subject. But be careful not to copy your -outline structure, wording, tables or examples from preexisting non-free -documentation. Copying from free documentation may be ok; please check -with the FSF about the individual case. - -@node Managing Releases -@chapter The Release Process - -Making a release is more than just bundling up your source files in a -tar file and putting it up for FTP. You should set up your software so -that it can be configured to run on a variety of systems. Your Makefile -should conform to the GNU standards described below, and your directory -layout should also conform to the standards discussed below. Doing so -makes it easy to include your package into the larger framework of -all GNU software. - -@menu -* Configuration:: How Configuration Should Work -* Makefile Conventions:: Makefile Conventions -* Releases:: Making Releases -@end menu - -@node Configuration -@section How Configuration Should Work - -Each GNU distribution should come with a shell script named -@code{configure}. This script is given arguments which describe the -kind of machine and system you want to compile the program for. - -The @code{configure} script must record the configuration options so -that they affect compilation. - -One way to do this is to make a link from a standard name such as -@file{config.h} to the proper configuration file for the chosen system. -If you use this technique, the distribution should @emph{not} contain a -file named @file{config.h}. This is so that people won't be able to -build the program without configuring it first. - -Another thing that @code{configure} can do is to edit the Makefile. If -you do this, the distribution should @emph{not} contain a file named -@file{Makefile}. Instead, it should include a file @file{Makefile.in} which -contains the input used for editing. Once again, this is so that people -won't be able to build the program without configuring it first. - -If @code{configure} does write the @file{Makefile}, then @file{Makefile} -should have a target named @file{Makefile} which causes @code{configure} -to be rerun, setting up the same configuration that was set up last -time. The files that @code{configure} reads should be listed as -dependencies of @file{Makefile}. - -All the files which are output from the @code{configure} script should -have comments at the beginning explaining that they were generated -automatically using @code{configure}. This is so that users won't think -of trying to edit them by hand. - -The @code{configure} script should write a file named @file{config.status} -which describes which configuration options were specified when the -program was last configured. This file should be a shell script which, -if run, will recreate the same configuration. - -The @code{configure} script should accept an option of the form -@samp{--srcdir=@var{dirname}} to specify the directory where sources are found -(if it is not the current directory). This makes it possible to build -the program in a separate directory, so that the actual source directory -is not modified. - -If the user does not specify @samp{--srcdir}, then @code{configure} should -check both @file{.} and @file{..} to see if it can find the sources. If -it finds the sources in one of these places, it should use them from -there. Otherwise, it should report that it cannot find the sources, and -should exit with nonzero status. - -Usually the easy way to support @samp{--srcdir} is by editing a -definition of @code{VPATH} into the Makefile. Some rules may need to -refer explicitly to the specified source directory. To make this -possible, @code{configure} can add to the Makefile a variable named -@code{srcdir} whose value is precisely the specified directory. - -The @code{configure} script should also take an argument which specifies the -type of system to build the program for. This argument should look like -this: - -@example -@var{cpu}-@var{company}-@var{system} -@end example - -For example, a Sun 3 might be @samp{m68k-sun-sunos4.1}. - -The @code{configure} script needs to be able to decode all plausible -alternatives for how to describe a machine. Thus, @samp{sun3-sunos4.1} -would be a valid alias. For many programs, @samp{vax-dec-ultrix} would -be an alias for @samp{vax-dec-bsd}, simply because the differences -between Ultrix and @sc{BSD} are rarely noticeable, but a few programs -might need to distinguish them. -@c Real 4.4BSD now runs on some Suns. - -There is a shell script called @file{config.sub} that you can use -as a subroutine to validate system types and canonicalize aliases. - -Other options are permitted to specify in more detail the software -or hardware present on the machine, and include or exclude optional -parts of the package: - -@table @samp -@item --enable-@var{feature}@r{[}=@var{parameter}@r{]} -Configure the package to build and install an optional user-level -facility called @var{feature}. This allows users to choose which -optional features to include. Giving an optional @var{parameter} of -@samp{no} should omit @var{feature}, if it is built by default. - -No @samp{--enable} option should @strong{ever} cause one feature to -replace another. No @samp{--enable} option should ever substitute one -useful behavior for another useful behavior. The only proper use for -@samp{--enable} is for questions of whether to build part of the program -or exclude it. - -@item --with-@var{package} -@c @r{[}=@var{parameter}@r{]} -The package @var{package} will be installed, so configure this package -to work with @var{package}. - -@c Giving an optional @var{parameter} of -@c @samp{no} should omit @var{package}, if it is used by default. - -Possible values of @var{package} include @samp{x}, @samp{x-toolkit}, -@samp{gnu-as} (or @samp{gas}), @samp{gnu-ld}, @samp{gnu-libc}, and -@samp{gdb}. - -Do not use a @samp{--with} option to specify the file name to use to -find certain files. That is outside the scope of what @samp{--with} -options are for. - -@item --nfp -The target machine has no floating point processor. - -@item --gas -The target machine assembler is GAS, the GNU assembler. -This is obsolete; users should use @samp{--with-gnu-as} instead. - -@item --x -The target machine has the X Window System installed. -This is obsolete; users should use @samp{--with-x} instead. -@end table - -All @code{configure} scripts should accept all of these ``detail'' -options, whether or not they make any difference to the particular -package at hand. In particular, they should accept any option that -starts with @samp{--with-} or @samp{--enable-}. This is so users will -be able to configure an entire GNU source tree at once with a single set -of options. - -You will note that the categories @samp{--with-} and @samp{--enable-} -are narrow: they @strong{do not} provide a place for any sort of option -you might think of. That is deliberate. We want to limit the possible -configuration options in GNU software. We do not want GNU programs to -have idiosyncratic configuration options. - -Packages that perform part of the compilation process may support cross-compilation. -In such a case, the host and target machines for the program may be -different. The @code{configure} script should normally treat the -specified type of system as both the host and the target, thus producing -a program which works for the same type of machine that it runs on. - -The way to build a cross-compiler, cross-assembler, or what have you, is -to specify the option @samp{--host=@var{hosttype}} when running -@code{configure}. This specifies the host system without changing the -type of target system. The syntax for @var{hosttype} is the same as -described above. - -Bootstrapping a cross-compiler requires compiling it on a machine other -than the host it will run on. Compilation packages accept a -configuration option @samp{--build=@var{hosttype}} for specifying the -configuration on which you will compile them, in case that is different -from the host. - -Programs for which cross-operation is not meaningful need not accept the -@samp{--host} option, because configuring an entire operating system for -cross-operation is not a meaningful thing. - -Some programs have ways of configuring themselves automatically. If -your program is set up to do this, your @code{configure} script can simply -ignore most of its arguments. - -@comment The makefile standards are in a separate file that is also -@comment included by make.texinfo. Done by roland@gnu.ai.mit.edu on 1/6/93. -@comment For this document, turn chapters into sections, etc. -@lowersections -@include make-stds.texi -@raisesections - -@node Releases -@section Making Releases - -Package the distribution of Foo version 69.96 in a gzipped tar file -named @file{foo-69.96.tar.gz}. It should unpack into a subdirectory -named @file{foo-69.96}. - -Building and installing the program should never modify any of the files -contained in the distribution. This means that all the files that form -part of the program in any way must be classified into @dfn{source -files} and @dfn{non-source files}. Source files are written by humans -and never changed automatically; non-source files are produced from -source files by programs under the control of the Makefile. - -Naturally, all the source files must be in the distribution. It is okay -to include non-source files in the distribution, provided they are -up-to-date and machine-independent, so that building the distribution -normally will never modify them. We commonly include non-source files -produced by Bison, @code{lex}, @TeX{}, and @code{makeinfo}; this helps avoid -unnecessary dependencies between our distributions, so that users can -install whichever packages they want to install. - -Non-source files that might actually be modified by building and -installing the program should @strong{never} be included in the -distribution. So if you do distribute non-source files, always make -sure they are up to date when you make a new distribution. - -Make sure that the directory into which the distribution unpacks (as -well as any subdirectories) are all world-writable (octal mode 777). -This is so that old versions of @code{tar} which preserve the -ownership and permissions of the files from the tar archive will be -able to extract all the files even if the user is unprivileged. - -Make sure that all the files in the distribution are world-readable. - -Make sure that no file name in the distribution is more than 14 -characters long. Likewise, no file created by building the program -should have a name longer than 14 characters. The reason for this is -that some systems adhere to a foolish interpretation of the POSIX -standard, and refuse to open a longer name, rather than truncating as -they did in the past. - -Don't include any symbolic links in the distribution itself. If the tar -file contains symbolic links, then people cannot even unpack it on -systems that don't support symbolic links. Also, don't use multiple -names for one file in different directories, because certain file -systems cannot handle this and that prevents unpacking the -distribution. - -Try to make sure that all the file names will be unique on MS-DOS. A -name on MS-DOS consists of up to 8 characters, optionally followed by a -period and up to three characters. MS-DOS will truncate extra -characters both before and after the period. Thus, -@file{foobarhacker.c} and @file{foobarhacker.o} are not ambiguous; they -are truncated to @file{foobarha.c} and @file{foobarha.o}, which are -distinct. - -Include in your distribution a copy of the @file{texinfo.tex} you used -to test print any @file{*.texinfo} or @file{*.texi} files. - -Likewise, if your program uses small GNU software packages like regex, -getopt, obstack, or termcap, include them in the distribution file. -Leaving them out would make the distribution file a little smaller at -the expense of possible inconvenience to a user who doesn't know what -other files to get. - -@contents - -@bye diff --git a/man/term.texi b/man/term.texi deleted file mode 100644 index 93a6730..0000000 --- a/man/term.texi +++ /dev/null @@ -1,395 +0,0 @@ -@\input texinfo @c -*-texinfo-*- -settitle Notes about emacs Term mode -@setfilename ../info/term.info - -@titlepage -@sp 6 -@center @titlefont(Notes about Emacs TERM Mode) -@end titlepage - -@ifinfo -@c @format -@c START-INFO-DIR-ENTRY -@c * term mode:: Emacs terminal emulator mode. -@c END-INFO-DIR-ENTRY -@c @end format - -@node Top, , (DIR) -@top Terminal emulator mode -@end ifinfo - -This is some notes about the term Emacs mode. - -@menu -* term mode:: -@end menu - -@node term mode -@chapter Term Mode - -@menu -* Overview:: -* Connecting to remote computers:: -* Paging:: -* Terminal escapes:: -@end menu - -The @code{term} package includes the major modes @code{term}, -@code{shell}, and @code{gud} (for running gbd or another debugger). -It is a replacement for the comint mode of Emacs 19, -as well as shell, gdb, terminal, and telnet modes. -The package works best with recent releases of Emacs 19, -but will also work reasonably well with Emacs 18 as well as Lucid Emacs 19. - -The file @code{nshell.el} is a wrapper to use unless term mode -is built into Emacs. If works around some of the missing -in older Emacs versions. -To use it, edit the paths in @code{nshell.el}, appropriately, -and then @code{M-x load-file nshell.el RET}. -This will also load in replacement shell and gud modes. - -@node Overview -@section Overview - -The @code{term} mode is used to control a program (an "inferior process"). -It sends most keyboard input characters to the program, -and displays output from the program in the buffer. -This is similar to the traditional comint mode, and -modes derived from it (such as shell and gdb modes). -You can do with the new term-based shell the same sort -of things you could do with the old shell mode, -using more or less the same interface. However, the -new mode is more flexible, and works somewhat differently. - -@menu -* Output from the inferior:: -* subbuffer:: The sub-buffer -* altsubbuffer:: The alternate sub-buffer -* Input to the inferior:: -@end menu - -@node Output from the inferior -@subsection Output from the inferior - -In typical usage, output from the inferior is -added to the end of the buffer. If needed, the window -will be scrolled, just like a regular terminal. -(Only one line at a time will be scrolled, just like -regular terminals, and in contrast to the old shell mode.) -Thus the buffer becomes a log of your interaction with the -inferior, just like the old shell mode. - -Like a real terminal, term maintains a "cursor position." -This is the @code{process-mark} of the inferior process. -If the process-mark is not at the end of the buffer, output from -the inferior will overwrite existing text in the buffer. -This is like a real terminal, but unlike the old shell mode -(which inserts the output, instead of overwriting). - -Some programs (such as Emacs itself) need to control the -appearance on the screen in detail. They do this by -sending special control codes. The exact control -codes needed from terminal to terminal, but nowadays -most terminals and terminal emulators (including xterm) -understand the so-called "ANSI escape sequences" (first -popularized by the Digital's VT100 family of terminal). -The term mode also understands these escape sequences, -and for each control code does the appropriate thing -to change the buffer so that the appearance of the window -will match what it would be on a real terminal. -(In contrast, the old shell mode doesn't handle -terminal control codes at all.) - -See <...> for the specific control codes. - -@node subbuffer -@subsection The sub-buffer - -A program that talks to terminal expects the terminal to have a fixed size. -If the program is talking a terminal emulator program such as @code{xterm}, -that size can be changed (if the xterm window is re-sized), but programs -still assume a logical terminal that has a fixed size independent -of the amount of output transmitted by the programs. - -To programs that use it, the Emacs terminal emulator acts as if it -too has a fixed size. The @dfn{sub-buffer} is the part of a @code{term}-mode -buffer that corresponds to a "normal" terminal. Most of the time -(unless you explicitly scroll the window displaying the buffer), -the sub-buffer is the part of the buffer that is displayed in a window. - -The sub-buffer is defined in terms of three buffer-local-variable: - -@defvar term-height -The height of the sub-buffer, in screen lines. -@end defvar - -@defvar term-width -The width of the sub-buffer, in screen columns. -@end defvar - -@defvar term-home-marker -The "home" position, that is the top left corner of the sub-buffer. -@end defvar - -The sub-buffer is assumed to be the end part of the buffer; -the @code{term-home-marker} should never be more than -@code{term-height} screen lines from the end of the buffer. - -@node altsubbuffer -@subsection The alternate sub-buffer - -When a "graphical" program finishes, it is nice to -restore the screen state to what it was before the program started. -Many people are used to this behavior from @code{xterm}, and -its also offered by the @code{term} emulator. - -@defun term-switch-to-alternate-sub-buffer set -If @var{set} is true, and we're not already using the alternate sub-buffer, -switch to it. What this means is that the @code{term-home-marker} -is saved (in the variable @code{term-saved-home-marker}), and the -@code{term-home-marker} is set to the end of the buffer. - -If @var{set} is false and we're using the alternate sub-buffer, -switch back to the saved sub-buffer. What this means is that the -(current, alternate) sub-buffer is deleted (using -@code{(delete-region term-home-marker (point-max))}), and then the -@code{term-home-marker} is restored (from @code{term-saved-home-marker}). -@end defun - -@node Input to the inferior -@subsection Input to the inferior - -Characters typed by the user are sent to the inferior. -How this is done depends on whether the @code{term} buffer -is in "character" mode or "line" mode. -(A @code{term} buffer can also be in "pager" mode. -This is discussed .) -Which of these is currently active is specified in the mode line. -The difference between them is the key-bindings available. - -In character mode, one character (by default @key{C-c}) is special, -and is a prefix for various commands. All other characters are -sent directly to the inferior process, with no interpretation by Emacs. -Character mode looks and feels like a real terminal, or a conventional -terminal emulator such as xterm. - -In line mode, key commands mostly have standard Emacs actions. -Regulars characters insert themselves into the buffer. -When return is typed, the entire current line of the buffer -(except possibly the prompt) is sent to the inferior process. -Line mode is basically the original shell mode from earlier Emacs versions. - -To switch from line mode to character mode type @kbd{C-c c}. -To switch from character mode to line mode type @kbd{C-c l}. - -In either mode, "echoing" of user input is handled by the inferior. -Therefor, in line mode after an input line at the end of the buffer -is sent to the inferior, it is deleted from the buffer. -This is so that the inferior can echo the input, if it wishes -(which it normally does). - -@node Connecting to remote computers -@section Connecting to remote computers - -If you want to login to a remove computer, you can do that just as -you would expect, using whatever commands you would normally use. - -(This is worth emphasizing, because earlier versions of @code{shell} -mode would not work properly if you tried to log in to some other -computer, because of the way echoing was handled. That is why -there was a separate @code{telnet} mode to partially compensate for -these problems. The @code{telnet} mode is no longer needed, and -is basically obsolete.) - -A program that asks you for a password will normally suppress -echoing of the password, so the password will not show up in the buffer. -This will happen just as if you were using a real terminal, if -the buffer is in char mode. If it is in line mode, the password -will be temporarily visible, but will be erased when you hit return. -(This happens automatically; there is no special password processing.) - -When you log in to a different machine, you need to specify the -type of terminal your using. If you are talking to a Bourne-compatible -shell, and your system understands the @code{TERMCAP} variable, -you can use the command @kbd{M-x shell-send-termcap}, which -sends a string specifying the terminal type and size. -(This command is also useful after the window has changed size.) - -If you need to specify the terminal type manually, you can try the -terminal types "ansi" or "vt100". - -You can of course run gdb on that remote computer. One useful -trick: If you invoke gdb with the @code{--fullname} option, -it will send special commands to Emacs that will cause Emacs to -pop up the source files you're debugging. This will work -whether or not gdb is running on a different computer than Emacs, -assuming can access the source files specified by gdb. - -@node Paging -@section Paging - -When the pager is enabled, Emacs will "pause" after each screenful -of output (since the last input sent to the inferior). -It will enter "pager" mode, which feels a lot like the "more" -program: Typing a space requests another screenful of output. -Other commands request more or less output, or scroll backwards -in the @code{term} buffer. In pager mode, type @kbd{h} or @kbd{?} -to display a help message listing all the available pager mode commands. - -In either character or line mode, type @kbd{C-c p} to enable paging, -and @kbd{C-c D} to disable it. - -@node Terminal escapes -@section Terminal Escape sequences - -A program that does "graphics" on a terminal controls the -terminal by sending strings called @dfn{terminal escape sequences} -that the terminal (or terminal emulator) interprets as special commands. -The @code{term} mode includes a terminal emulator that understands -standard ANSI escape sequences, originally popularized by VT100 terminals, -and now used by the @code{xterm} program and most modern terminal -emulator software. - -@menu -* Cursor motion:: Escape sequences to move the cursor -* Erasing:: Escape commands for erasing text -* Inserting and deleting:: Escape sequences to insert and delete text -* Scrolling:: Escape sequences to scroll part of the visible window -* Command hook:: -* Miscellaneous escapes:: -@end menu - -printing chars - -tab - -LF - -@node Cursor motion -@subsection Escape sequences to move the cursor - -@table @kbd -@item RETURN -Moves to the beginning of the current screen line. - -@item C-b -Moves backwards one column. (Tabs are broken up if needed.) -@comment Line wrap FIXME - -@item Esc [ R ; C H -Move to screen row R, screen column C, where (R=1) is the top row, -and (C=1) is the leftmost column. Defaults are R=1 and C=1. - -@item Esc [ N A -Move N (default 1) screen lines up. -@item Esc [ N B -Move N (default 1) screen lines down. -@item Esc [ N C -Move N (default 1) columns right. -@item Esc [ N D -Move N (default 1) columns left. -@end table - -@node Erasing -@subsection Escape commands for erasing text - -These commands "erase" part of the sub-buffer. -Erasing means replacing by white space; it is not the same as deleting. -The relative screen positions of things that are not erased remain -unchanged with each other, as does the relative cursor position. - -@table @kbd -@item E [ J -Erase from cursor to end of screen. -@item E [ 0 J -Same as E [ J. -@item E [ 1 J -Erase from home position to point. -@item E [ 2 J -Erase whole sub-buffer. -@item E [ K -Erase from point to end of screen line. -@item E [ 0 K -Same as E [ K. -@item E [ 1 K -Erase from beginning of screen line to point. -@item E [ 2 K -Erase whole screen line. -@end table - -@node Inserting and deleting -@subsection Escape sequences to insert and delete text - -@table @kbd -@item Esc [ N L -Insert N (default 1) blank lines. -@item Esc [ N M -Delete N (default 1) lines. -@item Esc [ N P -Delete N (default 1) characters. -@item Esc [ N @@ -Insert N (default 1) spaces. -@end table - -@node Scrolling -@subsection Escape sequences to scroll part of the visible window - -@table @kbd -@item Esc D -Scroll forward one screen line. - -@item Esc M -Scroll backwards one screen line. - -@item Esc [ T ; B r -Set the scrolling region to be from lines T down to line B inclusive, -where line 1 is the topmost line. -@end table - -@node Command hook -@subsection Command hook - -If @kbd{C-z} is seen, any text up to a following @key{LF} is scanned. -The text in between (not counting the initial C-z or the final LF) -is passed to the function that is the value of @code{term-command-hook}. - -The default value of the @code{term-command-hook} variable -is the function @code{term-command-hook}, which handles the following: - -@table @kbd -@item C-z C-z FILENAME:LINENUMBER:IGNORED LF -Set term-pending-frame to @code{(cons "FILENAME" LINENUMBER)}. -When the buffer is displayed in the current window, show -the FILENAME in the other window, and show an arrow at LINENUMBER. -Gdb emits these strings when invoked with the flag --fullname. -This is used by gdb mode; you can also invoke gdb with this flag -from shell mode. - -@item C-z / DIRNAME LF -Set the directory of the term buffer to DIRNAME - -@item C-z ! LEXPR LF -Read and evaluate LEXPR as a Lisp expression. -The result is ignored. -@end table - -@node Miscellaneous escapes -@subsection Miscellaneous escapes - -@table @kbd -@item C-g (Bell) -Calls @code{(beep t)}. - -@item Esc 7 -Save cursor. - -@item Esc 8 -Restore cursor. - -@item Esc [ 47 h -Switch to the alternate sub-buffer, -@item Esc [ 47 l -Switch back to the regular sub-buffer, -@end table - -@bye diff --git a/man/termcap.texi b/man/termcap.texi deleted file mode 100644 index 153d0f9..0000000 --- a/man/termcap.texi +++ /dev/null @@ -1,3412 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@setfilename ../info/termcap.info -@settitle The Termcap Library -@ifinfo -This file documents the termcap library of the GNU system. - -Copyright (C) 1988 Free Software Foundation, Inc. - -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 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 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 Foundation. -@end ifinfo - -@setchapternewpage odd -@titlepage -@sp 6 -@center @titlefont{Termcap} -@sp 1 -@center The Termcap Library and Data Base -@sp 4 -@center First Edition -@sp 1 -@center April 1988 -@sp 5 -@center Richard M. Stallman -@sp 1 -@center Free Software Foundation -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1988 Free Software Foundation, Inc. - -Published by the Free Software Foundation -(675 Mass Ave, Cambridge MA 02139). -Printed copies are available for $10 each. - -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 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 Foundation. -@end titlepage -@page - -@synindex vr fn - -@node Top, Introduction, (DIR), (DIR) - -@menu -* Introduction::What is termcap? Why this manual? -* Library:: The termcap library functions. -* Data Base:: What terminal descriptions in @file{/etc/termcap} look like. -* Capabilities::Definitions of the individual terminal capabilities: - how to write them in descriptions, and how to use - their values to do display updating. -* Summary:: Brief table of capability names and their meanings. -* Var Index:: Index of C functions and variables. -* Cap Index:: Index of termcap capabilities. -* Index:: Concept index. -@end menu - -@node Introduction, Library, Top, Top -@unnumbered Introduction - -@cindex termcap -@dfn{Termcap} is a library and data base that enables programs to use -display terminals in a terminal-independent manner. It originated in -Berkeley Unix. - -The termcap data base describes the capabilities of hundreds of different -display terminals in great detail. Some examples of the information -recorded for a terminal could include how many columns wide it is, what -string to send to move the cursor to an arbitrary position (including how -to encode the row and column numbers), how to scroll the screen up one or -several lines, and how much padding is needed for such a scrolling -operation. - -The termcap library is provided for easy access this data base in programs -that want to do terminal-independent character-based display output. - -This manual describes the GNU version of the termcap library, which has -some extensions over the Unix version. All the extensions are identified -as such, so this manual also tells you how to use the Unix termcap. - -The GNU version of the termcap library is available free as source code, -for use in free programs, and runs on Unix and VMS systems (at least). You -can find it in the GNU Emacs distribution in the files @file{termcap.c} and -@file{tparam.c}. - -This manual was written for the GNU project, whose goal is to develop a -complete free operating system upward-compatible with Unix for user -programs. The project is approximately two thirds complete. For more -information on the GNU project, including the GNU Emacs editor and the -mostly-portable optimizing C compiler, send one dollar to - -@display -Free Software Foundation -675 Mass Ave -Cambridge, MA 02139 -@end display - -@node Library, Data Base, Introduction, Top -@chapter The Termcap Library - -The termcap library is the application programmer's interface to the -termcap data base. It contains functions for the following purposes: - -@itemize @bullet -@item -Finding the description of the user's terminal type (@code{tgetent}). - -@item -Interrogating the description for information on various topics -(@code{tgetnum}, @code{tgetflag}, @code{tgetstr}). - -@item -Computing and performing padding (@code{tputs}). - -@item -Encoding numeric parameters such as cursor positions into the -terminal-specific form required for display commands (@code{tparam}, -@code{tgoto}). -@end itemize - -@menu -* Preparation:: Preparing to use the termcap library. -* Find:: Finding the description of the terminal being used. -* Interrogate:: Interrogating the description for particular capabilities. -* Initialize:: Initialization for output using termcap. -* Padding:: Outputting padding. -* Parameters:: Encoding parameters such as cursor positions. -@end menu - -@node Preparation, Find, Library, Library -@section Preparing to Use the Termcap Library - -To use the termcap library in a program, you need two kinds of preparation: - -@itemize @bullet -@item -The compiler needs declarations of the functions and variables in the -library. - -On GNU systems, it suffices to include the header file -@file{termcap.h} in each source file that uses these functions and -variables.@refill - -On Unix systems, there is often no such header file. Then you must -explictly declare the variables as external. You can do likewise for -the functions, or let them be implicitly declared and cast their -values from type @code{int} to the appropriate type. - -We illustrate the declarations of the individual termcap library -functions with ANSI C prototypes because they show how to pass the -arguments. If you are not using the GNU C compiler, you probably -cannot use function prototypes, so omit the argument types and names -from your declarations. - -@item -The linker needs to search the library. Usually either -@samp{-ltermcap} or @samp{-ltermlib} as an argument when linking will -do this.@refill -@end itemize - -@node Find, Interrogate, Preparation, Library -@section Finding a Terminal Description: @code{tgetent} - -@findex tgetent -An application program that is going to use termcap must first look up the -description of the terminal type in use. This is done by calling -@code{tgetent}, whose declaration in ANSI Standard C looks like: - -@example -int tgetent (char *@var{buffer}, char *@var{termtype}); -@end example - -@noindent -This function finds the description and remembers it internally so that -you can interrogate it about specific terminal capabilities -(@pxref{Interrogate}). - -The argument @var{termtype} is a string which is the name for the type of -terminal to look up. Usually you would obtain this from the environment -variable @code{TERM} using @code{getenv ("TERM")}. - -If you are using the GNU version of termcap, you can alternatively ask -@code{tgetent} to allocate enough space. Pass a null pointer for -@var{buffer}, and @code{tgetent} itself allocates the storage using -@code{malloc}. In this case the returned value on success is the address -of the storage, cast to @code{int}. But normally there is no need for you -to look at the address. Do not free the storage yourself.@refill - -With the Unix version of termcap, you must allocate space for the -description yourself and pass the address of the space as the argument -@var{buffer}. There is no way you can tell how much space is needed, so -the convention is to allocate a buffer 2048 characters long and assume that -is enough. (Formerly the convention was to allocate 1024 characters and -assume that was enough. But one day, for one kind of terminal, that was -not enough.) - -No matter how the space to store the description has been obtained, -termcap records its address internally for use when you later interrogate -the description with @code{tgetnum}, @code{tgetstr} or @code{tgetflag}. If -the buffer was allocated by termcap, it will be freed by termcap too if you -call @code{tgetent} again. If the buffer was provided by you, you must -make sure that its contents remain unchanged for as long as you still plan -to interrogate the description.@refill - -The return value of @code{tgetent} is @minus{}1 if there is some difficulty -accessing the data base of terminal types, 0 if the data base is accessible -but the specified type is not defined in it, and some other value -otherwise. - -Here is how you might use the function @code{tgetent}: - -@example -#ifdef unix -static char term_buffer[2048]; -#else -#define term_buffer 0 -#endif - -init_terminal_data () -@{ - char *termtype = getenv ("TERM"); - int success; - - if (termtype == 0) - fatal ("Specify a terminal type with `setenv TERM '.\n"); - - success = tgetent (term_buffer, termtype); - if (success < 0) - fatal ("Could not access the termcap data base.\n"); - if (success == 0) - fatal ("Terminal type `%s' is not defined.\n", termtype); -@} -@end example - -@noindent -Here we assume the function @code{fatal} prints an error message and exits. - -If the environment variable @code{TERMCAP} is defined, its value is used to -override the terminal type data base. The function @code{tgetent} checks -the value of @code{TERMCAP} automatically. If the value starts with -@samp{/} then it is taken as a file name to use as the data base file, -instead of @file{/etc/termcap} which is the standard data base. If the -value does not start with @samp{/} then it is itself used as the terminal -description, provided that the terminal type @var{termtype} is among the -types it claims to apply to. @xref{Data Base}, for information on the -format of a terminal description.@refill - -@node Interrogate, Initialize, Find, Library -@section Interrogating the Terminal Description - -Each piece of information recorded in a terminal description is called a -@dfn{capability}. Each defined terminal capability has a two-letter code -name and a specific meaning. For example, the number of columns is named -@samp{co}. @xref{Capabilities}, for definitions of all the standard -capability names. - -Once you have found the proper terminal description with @code{tgetent} -(@pxref{Find}), your application program must @dfn{interrogate} it for -various terminal capabilities. You must specify the two-letter code of -the capability whose value you seek. - -Capability values can be numeric, boolean (capability is either present or -absent) or strings. Any particular capability always has the same value -type; for example, @samp{co} always has a numeric value, while @samp{am} -(automatic wrap at margin) is always a flag, and @samp{cm} (cursor motion -command) always has a string value. The documentation of each capability -says which type of value it has.@refill - -There are three functions to use to get the value of a capability, -depending on the type of value the capability has. Here are their -declarations in ANSI C: - -@findex tgetnum -@findex tgetflag -@findex tgetstr -@example -int tgetnum (char *@var{name}); -int tgetflag (char *@var{name}); -char *tgetstr (char *@var{name}, char **@var{area}); -@end example - -@table @code -@item tgetnum -Use @code{tgetnum} to get a capability value that is numeric. The -argument @var{name} is the two-letter code name of the capability. If -the capability is present, @code{tgetnum} returns the numeric value -(which is nonnegative). If the capability is not mentioned in the -terminal description, @code{tgetnum} returns @minus{}1. - -@item tgetflag -Use @code{tgetflag} to get a boolean value. If the capability -@var{name} is present in the terminal description, @code{tgetflag} -returns 1; otherwise, it returns 0. - -@item tgetstr -Use @code{tgetstr} to get a string value. It returns a pointer to a -string which is the capability value, or a null pointer if the -capability is not present in the terminal description. - -There are two ways @code{tgetstr} can find space to store the string value: - -@itemize @bullet -@item -You can ask @code{tgetstr} to allocate the space. Pass a null -pointer for the argument @var{area}, and @code{tgetstr} will use -@code{malloc} to allocate storage big enough for the value. -Termcap will never free this storage or refer to it again; you -should free it when you are finished with it. - -This method is more robust, since there is no need to guess how -much space is needed. But it is supported only by the GNU -termcap library. - -@item -You can provide the space. Provide for the argument @var{area} the -address of a pointer variable of type @code{char *}. Before calling -@code{tgetstr}, initialize the variable to point at available space. -Then @code{tgetstr} will store the string value in that space and will -increment the pointer variable to point after the space that has been -used. You can use the same pointer variable for many calls to -@code{tgetstr}. - -There is no way to determine how much space is needed for a single -string, and no way for you to prevent or handle overflow of the area -you have provided. However, you can be sure that the total size of -all the string values you will obtain from the terminal description is -no greater than the size of the description (unless you get the same -capability twice). You can determine that size with @code{strlen} on -the buffer you provided to @code{tgetent}. See below for an example. - -Providing the space yourself is the only method supported by the Unix -version of termcap. -@end itemize -@end table - -Note that you do not have to specify a terminal type or terminal -description for the interrogation functions. They automatically use the -description found by the most recent call to @code{tgetent}. - -Here is an example of interrogating a terminal description for various -capabilities, with conditionals to select between the Unix and GNU methods -of providing buffer space. - -@example -char *tgetstr (); - -char *cl_string, *cm_string; -int height; -int width; -int auto_wrap; - -char PC; /* For tputs. */ -char *BC; /* For tgoto. */ -char *UP; - -interrogate_terminal () -@{ -#ifdef UNIX - /* Here we assume that an explicit term_buffer - was provided to tgetent. */ - char *buffer - = (char *) malloc (strlen (term_buffer)); -#define BUFFADDR &buffer -#else -#define BUFFADDR 0 -#endif - - char *temp; - - /* Extract information we will use. */ - cl_string = tgetstr ("cl", BUFFADDR); - cm_string = tgetstr ("cm", BUFFADDR); - auto_wrap = tgetflag ("am"); - height = tgetnum ("li"); - width = tgetnum ("co"); - - /* Extract information that termcap functions use. */ - temp = tgetstr ("pc", BUFFADDR); - PC = temp ? *temp : 0; - BC = tgetstr ("le", BUFFADDR); - UP = tgetstr ("up", BUFFADDR); -@} -@end example - -@noindent -@xref{Padding}, for information on the variable @code{PC}. @xref{Using -Parameters}, for information on @code{UP} and @code{BC}. - -@node Initialize, Padding, Interrogate, Library -@section Initialization for Use of Termcap -@cindex terminal flags (kernel) - -Before starting to output commands to a terminal using termcap, -an application program should do two things: - -@itemize @bullet -@item -Initialize various global variables which termcap library output -functions refer to. These include @code{PC} and @code{ospeed} for -padding (@pxref{Output Padding}) and @code{UP} and @code{BC} for -cursor motion (@pxref{tgoto}).@refill - -@item -Tell the kernel to turn off alteration and padding of horizontal-tab -characters sent to the terminal. -@end itemize - -To turn off output processing in Berkeley Unix you would use @code{ioctl} -with code @code{TIOCLSET} to set the bit named @code{LLITOUT}, and clear -the bits @code{ANYDELAY} using @code{TIOCSETN}. In POSIX or System V, you -must clear the bit named @code{OPOST}. Refer to the system documentation -for details.@refill - -If you do not set the terminal flags properly, some older terminals will -not work. This is because their commands may contain the characters that -normally signify newline, carriage return and horizontal tab---characters -which the kernel thinks it ought to modify before output. - -When you change the kernel's terminal flags, you must arrange to restore -them to their normal state when your program exits. This implies that the -program must catch fatal signals such as @code{SIGQUIT} and @code{SIGINT} -and restore the old terminal flags before actually terminating. - -Modern terminals' commands do not use these special characters, so if you -do not care about problems with old terminals, you can leave the kernel's -terminal flags unaltered. - -@node Padding, Parameters, Initialize, Library -@section Padding -@cindex padding - -@dfn{Padding} means outputting null characters following a terminal display -command that takes a long time to execute. The terminal description says -which commands require padding and how much; the function @code{tputs}, -described below, outputs a terminal command while extracting from it the -padding information, and then outputs the padding that is necessary. - -@menu -* Why Pad:: Explanation of padding. -* Describe Padding:: The data base says how much padding a terminal needs. -* Output Padding:: Using @code{tputs} to output the needed padding. -@end menu - -@node Why Pad, Describe Padding, Padding, Padding -@subsection Why Pad, and How - -Most types of terminal have commands that take longer to execute than they -do to send over a high-speed line. For example, clearing the screen may -take 20msec once the entire command is received. During that time, on a -9600 bps line, the terminal could receive about 20 additional output -characters while still busy clearing the screen. Every terminal has a -certain amount of buffering capacity to remember output characters that -cannot be processed yet, but too many slow commands in a row can cause the -buffer to fill up. Then any additional output that cannot be processed -immediately will be lost. - -To avoid this problem, we normally follow each display command with enough -useless charaters (usually null characters) to fill up the time that the -display command needs to execute. This does the job if the terminal throws -away null characters without using up space in the buffer (which most -terminals do). If enough padding is used, no output can ever be lost. The -right amount of padding avoids loss of output without slowing down -operation, since the time used to transmit padding is time that nothing -else could be done. - -The number of padding characters needed for an operation depends on the -line speed. In fact, it is proportional to the line speed. A 9600 baud -line transmits about one character per msec, so the clear screen command in -the example above would need about 20 characters of padding. At 1200 baud, -however, only about 3 characters of padding are needed to fill up 20msec. - -@node Describe Padding, Output Padding, Why Pad, Padding -@subsection Specifying Padding in a Terminal Description - -In the terminal description, the amount of padding required by each display -command is recorded as a sequence of digits at the front of the command. -These digits specify the padding time in msec. They can be followed -optionally by a decimal point and one more digit, which is a number of -tenths of msec. - -Sometimes the padding needed by a command depends on the cursor position. -For example, the time taken by an ``insert line'' command is usually -proportional to the number of lines that need to be moved down or cleared. -An asterisk (@samp{*}) following the padding time says that the time -should be multiplied by the number of screen lines affected by the command. - -@example -:al=1.3*\E[L: -@end example - -@noindent -is used to describe the ``insert line'' command for a certain terminal. -The padding required is 1.3 msec per line affected. The command itself is -@samp{@key{ESC} [ L}. - -The padding time specified in this way tells @code{tputs} how many pad -characters to output. @xref{Output Padding}. - -Two special capability values affect padding for all commands. These are -the @samp{pc} and @samp{pb}. The variable @samp{pc} specifies the -character to pad with, and @samp{pb} the speed below which no padding is -needed. The defaults for these variables, a null character and 0, -are correct for most terminals. @xref{Pad Specs}. - -@node Output Padding,, Describe Padding, Padding -@subsection Performing Padding with @code{tputs} -@cindex line speed - -@findex tputs -Use the termcap function @code{tputs} to output a string containing an -optional padding spec of the form described above (@pxref{Describe -Padding}). The function @code{tputs} strips off and decodes the padding -spec, outputs the rest of the string, and then outputs the appropriate -padding. Here is its declaration in ANSI C: - -@example -char PC; -short ospeed; - -int tputs (char *@var{string}, int @var{nlines}, int (*@var{outfun}) ()); -@end example - -Here @var{string} is the string (including padding spec) to be output; -@var{nlines} is the number of lines affected by the operation, which is -used to multiply the amount of padding if the padding spec ends with a -@samp{*}. Finally, @var{outfun} is a function (such as @code{fputchar}) -that is called to output each character. When actually called, -@var{outfun} should expect one argument, a character. - -@vindex ospeed -@vindex PC -The operation of @code{tputs} is controlled by two global variables, -@code{ospeed} and @code{PC}. The value of @code{ospeed} is supposed to be -the terminal output speed, encoded as in the @code{ioctl} system call which -gets the speed information. This is needed to compute the number of -padding characters. The value of @code{PC} is the character used for -padding. - -You are responsible for storing suitable values into these variables before -using @code{tputs}. The value stored into the @code{PC} variable should be -taken from the @samp{pc} capability in the terminal description (@pxref{Pad -Specs}). Store zero in @code{PC} if there is no @samp{pc} -capability.@refill - -The argument @var{nlines} requires some thought. Normally, it should be -the number of lines whose contents will be cleared or moved by the command. -For cursor motion commands, or commands that do editing within one line, -use the value 1. For most commands that affect multiple lines, such as -@samp{al} (insert a line) and @samp{cd} (clear from the cursor to the end -of the screen), @var{nlines} should be the screen height minus the current -vertical position (origin 0). For multiple insert and scroll commands such -as @samp{AL} (insert multiple lines), that same value for @var{nlines} is -correct; the number of lines being inserted is @i{not} correct.@refill - -If a ``scroll window'' feature is used to reduce the number of lines -affected by a command, the value of @var{nlines} should take this into -account. This is because the delay time required depends on how much work -the terminal has to do, and the scroll window feature reduces the work. -@xref{Scrolling}. - -Commands such as @samp{ic} and @samp{dc} (insert or delete characters) are -problematical because the padding needed by these commands is proportional -to the number of characters affected, which is the number of columns from -the cursor to the end of the line. It would be nice to have a way to -specify such a dependence, and there is no need for dependence on vertical -position in these commands, so it is an obvious idea to say that for these -commands @var{nlines} should really be the number of columns affected. -However, the definition of termcap clearly says that @var{nlines} is always -the number of lines affected, even in this case, where it is always 1. It -is not easy to change this rule now, because too many programs and terminal -descriptions have been written to follow it. - -Because @var{nlines} is always 1 for the @samp{ic} and @samp{dc} strings, -there is no reason for them to use @samp{*}, but some of them do. These -should be corrected by deleting the @samp{*}. If, some day, such entries -have disappeared, it may be possible to change to a more useful convention -for the @var{nlines} argument for these operations without breaking any -programs. - -@node Parameters,, Padding, Library -@section Filling In Parameters -@cindex parameters - -Some terminal control strings require numeric @dfn{parameters}. For -example, when you move the cursor, you need to say what horizontal and -vertical positions to move it to. The value of the terminal's @samp{cm} -capability, which says how to move the cursor, cannot simply be a string of -characters; it must say how to express the cursor position numbers and -where to put them within the command. - -The specifications of termcap include conventions as to which string-valued -capabilities require parameters, how many parameters, and what the -parameters mean; for example, it defines the @samp{cm} string to take -two parameters, the vertical and horizontal positions, with 0,0 being the -upper left corner. These conventions are described where the individual -commands are documented. - -Termcap also defines a language used within the capability definition for -specifying how and where to encode the parameters for output. This language -uses character sequences starting with @samp{%}. (This is the same idea as -@code{printf}, but the details are different.) The language for parameter -encoding is described in this section. - -A program that is doing display output calls the functions @code{tparam} or -@code{tgoto} to encode parameters according to the specifications. These -functions produce a string containing the actual commands to be output (as -well a padding spec which must be processed with @code{tputs}; -@pxref{Padding}). - -@menu -* Encode Parameters:: The language for encoding parameters. -* Using Parameters:: Outputting a string command with parameters. -@end menu - -@node Encode Parameters, Using Parameters, Parameters, Parameters -@subsection Describing the Encoding -@cindex % - -A terminal command string that requires parameters contains special -character sequences starting with @samp{%} to say how to encode the -parameters. These sequences control the actions of @code{tparam} and -@code{tgoto}. - -The parameters values passed to @code{tparam} or @code{tgoto} are -considered to form a vector. A pointer into this vector determines -the next parameter to be processed. Some of the @samp{%}-sequences -encode one parameter and advance the pointer to the next parameter. -Other @samp{%}-sequences alter the pointer or alter the parameter -values without generating output. - -For example, the @samp{cm} string for a standard ANSI terminal is written -as @samp{\E[%i%d;%dH}. (@samp{\E} stands for @key{ESC}.) @samp{cm} by -convention always requires two parameters, the vertical and horizontal goal -positions, so this string specifies the encoding of two parameters. Here -@samp{%i} increments the two values supplied, and each @samp{%d} encodes -one of the values in decimal. If the cursor position values 20,58 are -encoded with this string, the result is @samp{\E[21;59H}. - -First, here are the @samp{%}-sequences that generate output. Except for -@samp{%%}, each of them encodes one parameter and advances the pointer -to the following parameter. - -@table @samp -@item %% -Output a single @samp{%}. This is the only way to represent a literal -@samp{%} in a terminal command with parameters. @samp{%%} does not -use up a parameter. - -@item %d -As in @code{printf}, output the next parameter in decimal. - -@item %2 -Like @samp{%02d} in @code{printf}: output the next parameter in -decimal, and always use at least two digits. - -@item %3 -Like @samp{%03d} in @code{printf}: output the next parameter in -decimal, and always use at least three digits. Note that @samp{%4} -and so on are @emph{not} defined. - -@item %. -Output the next parameter as a single character whose ASCII code is -the parameter value. Like @samp{%c} in @code{printf}. - -@item %+@var{char} -Add the next parameter to the character @var{char}, and output the -resulting character. For example, @samp{%+ } represents 0 as a space, -1 as @samp{!}, etc. -@end table - -The following @samp{%}-sequences specify alteration of the parameters -(their values, or their order) rather than encoding a parameter for output. -They generate no output; they are used only for their side effects -on the parameters. Also, they do not advance the ``next parameter'' pointer -except as explicitly stated. Only @samp{%i}, @samp{%r} and @samp{%>} are -defined in standard Unix termcap. The others are GNU extensions.@refill - -@table @samp -@item %i -Increment the next two parameters. This is used for terminals that -expect cursor positions in origin 1. For example, @samp{%i%d,%d} would -output two parameters with @samp{1} for 0, @samp{2} for 1, etc. - -@item %r -Interchange the next two parameters. This is used for terminals whose -cursor positioning command expects the horizontal position first. - -@item %s -Skip the next parameter. Do not output anything. - -@item %b -Back up one parameter. The last parameter used will become once again -the next parameter to be output, and the next output command will use -it. Using @samp{%b} more than once, you can back up any number of -parameters, and you can refer to each parameter any number of times. - -@item %>@var{c1}@var{c2} -Conditionally increment the next parameter. Here @var{c1} and -@var{c2} are characters which stand for their ASCII codes as numbers. -If the next parameter is greater than the ASCII code of @var{c1}, the -ASCII code of @var{c2} is added to it.@refill - -@item %a @var{op} @var{type} @var{pos} -Perform arithmetic on the next parameter, do not use it up, and do not -output anything. Here @var{op} specifies the arithmetic operation, -while @var{type} and @var{pos} together specify the other operand. - -Spaces are used above to separate the operands for clarity; the spaces -don't appear in the data base, where this sequence is exactly five -characters long. - -The character @var{op} says what kind of arithmetic operation to -perform. It can be any of these characters: - -@table @samp -@item = -assign a value to the next parameter, ignoring its old value. -The new value comes from the other operand. - -@item + -add the other operand to the next parameter. - -@item - -subtract the other operand from the next parameter. - -@item * -multiply the next parameter by the other operand. - -@item / -divide the next parameter by the other operand. -@end table - -The ``other operand'' may be another parameter's value or a constant; -the character @var{type} says which. It can be: - -@table @samp -@item p -Use another parameter. The character @var{pos} says which -parameter to use. Subtract 64 from its ASCII code to get the -position of the desired parameter relative to this one. Thus, -the character @samp{A} as @var{pos} means the parameter after the -next one; the character @samp{?} means the parameter before the -next one. - -@item c -Use a constant value. The character @var{pos} specifies the -value of the constant. The 0200 bit is cleared out, so that 0200 -can be used to represent zero. -@end table -@end table - -The following @samp{%}-sequences are special purpose hacks to compensate -for the weird designs of obscure terminals. They modify the next parameter -or the next two parameters but do not generate output and do not use up any -parameters. @samp{%m} is a GNU extension; the others are defined in -standard Unix termcap. - -@table @samp -@item %n -Exclusive-or the next parameter with 0140, and likewise the parameter -after next. - -@item %m -Complement all the bits of the next parameter and the parameter after next. - -@item %B -Encode the next parameter in BCD. It alters the value of the -parameter by adding six times the quotient of the parameter by ten. -Here is a C statement that shows how the new value is computed: - -@example -@var{parm} = (@var{parm} / 10) * 16 + @var{parm} % 10; -@end example - -@item %D -Transform the next parameter as needed by Delta Data terminals. -This involves subtracting twice the remainder of the parameter by 16. - -@example -@var{parm} -= 2 * (@var{parm} % 16); -@end example -@end table - -@node Using Parameters,, Encode Parameters, Parameters -@subsection Sending Display Commands with Parameters - -The termcap library functions @code{tparam} and @code{tgoto} serve as the -analog of @code{printf} for terminal string parameters. The newer function -@code{tparam} is a GNU extension, more general but missing from Unix -termcap. The original parameter-encoding function is @code{tgoto}, which -is preferable for cursor motion. - -@menu -* tparam:: The general case, for GNU termcap only. -* tgoto:: The special case of cursor motion. -@end menu - -@node tparam, tgoto, Using Parameters, Using Parameters -@subsubsection @code{tparam} - -@findex tparam -The function @code{tparam} can encode display commands with any number of -parameters and allows you to specify the buffer space. It is the preferred -function for encoding parameters for all but the @samp{cm} capability. Its -ANSI C declaration is as follows: - -@example -char *tparam (char *@var{ctlstring}, char *@var{buffer}, int @var{size}, int @var{parm1},...) -@end example - -The arguments are a control string @var{ctlstring} (the value of a terminal -capability, presumably), an output buffer @var{buffer} and @var{size}, and -any number of integer parameters to be encoded. The effect of -@code{tparam} is to copy the control string into the buffer, encoding -parameters according to the @samp{%} sequences in the control string. - -You describe the output buffer by its address, @var{buffer}, and its size -in bytes, @var{size}. If the buffer is not big enough for the data to be -stored in it, @code{tparam} calls @code{malloc} to get a larger buffer. In -either case, @code{tparam} returns the address of the buffer it ultimately -uses. If the value equals @var{buffer}, your original buffer was used. -Otherwise, a new buffer was allocated, and you must free it after you are -done with printing the results. If you pass zero for @var{size} and -@var{buffer}, @code{tparam} always allocates the space with @code{malloc}. - -All capabilities that require parameters also have the ability to specify -padding, so you should use @code{tputs} to output the string produced by -@code{tparam}. @xref{Padding}. Here is an example. - -@example -@{ - char *buf; - char buffer[40]; - - buf = tparam (command, buffer, 40, parm); - tputs (buf, 1, fputchar); - if (buf != buffer) - free (buf); -@} -@end example - -If a parameter whose value is zero is encoded with @samp{%.}-style -encoding, the result is a null character, which will confuse @code{tputs}. -This would be a serious problem, but luckily @samp{%.} encoding is used -only by a few old models of terminal, and only for the @samp{cm} -capability. To solve the problem, use @code{tgoto} rather than -@code{tparam} to encode the @samp{cm} capability.@refill - -@node tgoto,, tparam, Using Parameters -@subsubsection @code{tgoto} - -@findex tgoto -The special case of cursor motion is handled by @code{tgoto}. There -are two reasons why you might choose to use @code{tgoto}: - -@itemize @bullet -@item -For Unix compatibility, because Unix termcap does not have @code{tparam}. - -@item -For the @samp{cm} capability, since @code{tgoto} has a special feature -to avoid problems with null characters, tabs and newlines on certain old -terminal types that use @samp{%.} encoding for that capability. -@end itemize - -Here is how @code{tgoto} might be declared in ANSI C: - -@example -char *tgoto (char *@var{cstring}, int @var{hpos}, int @var{vpos}) -@end example - -There are three arguments, the terminal description's @samp{cm} string and -the two cursor position numbers; @code{tgoto} computes the parametrized -string in an internal static buffer and returns the address of that buffer. -The next time you use @code{tgoto} the same buffer will be reused. - -@vindex UP -@vindex BC -Parameters encoded with @samp{%.} encoding can generate null characters, -tabs or newlines. These might cause trouble: the null character because -@code{tputs} would think that was the end of the string, the tab because -the kernel or other software might expand it into spaces, and the newline -becaue the kernel might add a carriage-return, or padding characters -normally used for a newline. To prevent such problems, @code{tgoto} is -careful to avoid these characters. Here is how this works: if the target -cursor position value is such as to cause a problem (that is to say, zero, -nine or ten), @code{tgoto} increments it by one, then compensates by -appending a string to move the cursor back or up one position. - -The compensation strings to use for moving back or up are found in global -variables named @code{BC} and @code{UP}. These are actual external C -variables with upper case names; they are declared @code{char *}. It is up -to you to store suitable values in them, normally obtained from the -@samp{le} and @samp{up} terminal capabilities in the terminal description -with @code{tgetstr}. Alternatively, if these two variables are both zero, -the feature of avoiding nulls, tabs and newlines is turned off. - -It is safe to use @code{tgoto} for commands other than @samp{cm} only if -you have stored zero in @code{BC} and @code{UP}. - -Note that @code{tgoto} reverses the order of its operands: the horizontal -position comes before the vertical position in the arguments to -@code{tgoto}, even though the vertical position comes before the horizontal -in the parameters of the @samp{cm} string. If you use @code{tgoto} with a -command such as @samp{AL} that takes one parameter, you must pass the -parameter to @code{tgoto} as the ``vertical position''.@refill - -@node Data Base, Capabilities, Library, Top -@chapter The Format of the Data Base - -The termcap data base of terminal descriptions is stored in the file -@file{/etc/termcap}. It contains terminal descriptions, blank lines, and -comments. - -A terminal description starts with one or more names for the terminal type. -The information in the description is a series of @dfn{capability names} -and values. The capability names have standard meanings -(@pxref{Capabilities}) and their values describe the terminal. - -@menu -* Format:: Overall format of a terminal description. -* Capability Format:: Format of capabilities within a description. -* Naming:: Naming conventions for terminal types. -* Inheriting:: Inheriting part of a description from - a related terminal type. -@end menu - -@node Format, Capability Format, Data Base, Data Base -@section Terminal Description Format -@cindex description format - -Aside from comments (lines starting with @samp{#}, which are ignored), each -nonblank line in the termcap data base is a terminal description. -A terminal description is nominally a single line, but it can be split -into multiple lines by inserting the two characters @samp{\ newline}. -This sequence is ignored wherever it appears in a description. - -The preferred way to split the description is between capabilities: insert -the four characters @samp{: \ newline tab} immediately before any colon. -This allows each sub-line to start with some indentation. This works -because, after the @samp{\ newline} are ignored, the result is @samp{: tab -:}; the first colon ends the preceding capability and the second colon -starts the next capability. If you split with @samp{\ newline} alone, you -may not add any indentation after them. - -Here is a real example of a terminal description: - -@example -dw|vt52|DEC vt52:\ - :cr=^M:do=^J:nl=^J:bl=^G:\ - :le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:\ - :nd=\EC:ta=^I:pt:sr=\EI:up=\EA:\ - :ku=\EA:kd=\EB:kr=\EC:kl=\ED:kb=^H: -@end example - -Each terminal description begins with several names for the terminal type. -The names are separated by @samp{|} characters, and a colon ends the last -name. The first name should be two characters long; it exists only for the -sake of very old Unix systems and is never used in modern systems. The -last name should be a fully verbose name such as ``DEC vt52'' or ``Ann -Arbor Ambassador with 48 lines''. The other names should include whatever -the user ought to be able to specify to get this terminal type, such as -@samp{vt52} or @samp{aaa-48}. @xref{Naming}, for information on how to -choose terminal type names. - -After the terminal type names come the terminal capabilities, separated by -colons and with a colon after the last one. Each capability has a -two-letter name, such as @samp{cm} for ``cursor motion string'' or @samp{li} -for ``number of display lines''. - -@node Capability Format, Naming, Format, Data Base -@section Writing the Capabilities - -There are three kinds of capabilities: flags, numbers, and strings. Each -kind has its own way of being written in the description. Each defined -capability has by convention a particular kind of value; for example, -@samp{li} always has a numeric value and @samp{cm} always a string value. - -A flag capability is thought of as having a boolean value: the value is -true if the capability is present, false if not. When the capability is -present, just write its name between two colons. - -A numeric capability has a value which is a nonnegative number. Write the -capability name, a @samp{#}, and the number, between two colons. For -example, @samp{@dots{}:li#48:@dots{}} is how you specify the @samp{li} -capability for 48 lines.@refill - -A string-valued capability has a value which is a sequence of characters. -Usually these are the characters used to perform some display operation. -Write the capability name, a @samp{=}, and the characters of the value, -between two colons. For example, @samp{@dots{}:cm=\E[%i%d;%dH:@dots{}} is -how the cursor motion command for a standard ANSI terminal would be -specified.@refill - -Special characters in the string value can be expressed using -@samp{\}-escape sequences as in C; in addition, @samp{\E} stands for -@key{ESC}. @samp{^} is also a kind of escape character; @samp{^} followed -by @var{char} stands for the control-equivalent of @var{char}. Thus, -@samp{^a} stands for the character control-a, just like @samp{\001}. -@samp{\} and @samp{^} themselves can be represented as @samp{\\} and -@samp{\^}.@refill - -To include a colon in the string, you must write @samp{\072}. You might -ask, ``Why can't @samp{\:} be used to represent a colon?'' The reason is -that the interrogation functions do not count slashes while looking for a -capability. Even if @samp{:ce=ab\:cd:} were interpreted as giving the -@samp{ce} capability the value @samp{ab:cd}, it would also appear to define -@samp{cd} as a flag. - -The string value will often contain digits at the front to specify padding -(@pxref{Padding}) and/or @samp{%}-sequences within to specify how to encode -parameters (@pxref{Parameters}). Although these things are not to be -output literally to the terminal, they are considered part of the value of -the capability. They are special only when the string value is processed -by @code{tputs}, @code{tparam} or @code{tgoto}. By contrast, @samp{\} and -@samp{^} are considered part of the syntax for specifying the characters -in the string. - -Let's look at the VT52 example again: - -@example -dw|vt52|DEC vt52:\ - :cr=^M:do=^J:nl=^J:bl=^G:\ - :le=^H:bs:cd=\EJ:ce=\EK:cl=\EH\EJ:cm=\EY%+ %+ :co#80:li#24:\ - :nd=\EC:ta=^I:pt:sr=\EI:up=\EA:\ - :ku=\EA:kd=\EB:kr=\EC:kl=\ED:kb=^H: -@end example - -Here we see the numeric-valued capabilities @samp{co} and @samp{li}, the -flags @samp{bs} and @samp{pt}, and many string-valued capabilities. Most -of the strings start with @key{ESC} represented as @samp{\E}. The rest -contain control characters represented using @samp{^}. The meanings of the -individual capabilities are defined elsewhere (@pxref{Capabilities}). - -@node Naming, Inheriting, Capability Format, Data Base -@section Terminal Type Name Conventions -@cindex names of terminal types - -There are conventions for choosing names of terminal types. For one thing, -all letters should be in lower case. The terminal type for a terminal in -its most usual or most fundamental mode of operation should not have a -hyphen in it. - -If the same terminal has other modes of operation which require -different terminal descriptions, these variant descriptions are given -names made by adding suffixes with hyphens. Such alternate descriptions -are used for two reasons: - -@itemize @bullet -@item -When the terminal has a switch that changes its behavior. Since the -computer cannot tell how the switch is set, the user must tell the -computer by choosing the appropriate terminal type name. - -@cindex wrapping -For example, the VT-100 has a setup flag that controls whether the -cursor wraps at the right margin. If this flag is set to ``wrap'', -you must use the terminal type @samp{vt100-am}. Otherwise you must -use @samp{vt100-nam}. Plain @samp{vt100} is defined as a synonym for -either @samp{vt100-am} or @samp{vt100-nam} depending on the -preferences of the local site.@refill - -The standard suffix @samp{-am} stands for ``automatic margins''. - -@item -To give the user a choice in how to use the terminal. This is done -when the terminal has a switch that the computer normally controls. - -@cindex screen size -For example, the Ann Arbor Ambassador can be configured with many -screen sizes ranging from 20 to 60 lines. Fewer lines make bigger -characters but more lines let you see more of what you are editing. -As a result, users have different preferences. Therefore, termcap -provides terminal types for many screen sizes. If you choose type -@samp{aaa-30}, the terminal will be configured to use 30 lines; if you -choose @samp{aaa-48}, 48 lines will be used, and so on. -@end itemize - -Here is a list of standard suffixes and their conventional meanings: - -@table @samp -@item -w -Short for ``wide''. This is a mode that gives the terminal more -columns than usual. This is normally a user option. - -@item -am -``Automatic margins''. This is an alternate description for use when -the terminal's margin-wrap switch is on; it contains the @samp{am} -flag. The implication is that normally the switch is off and the -usual description for the terminal says that the switch is off. - -@item -nam -``No automatic margins''. The opposite of @samp{-am}, this names an -alternative description which lacks the @samp{am} flag. This implies -that the terminal is normally operated with the margin-wrap switch -turned on, and the normal description of the terminal says so. - -@item -na -``No arrows''. This terminal description initializes the terminal to -keep its arrow keys in local mode. This is a user option. - -@item -rv -``Reverse video''. This terminal description causes text output for -normal video to appear as reverse, and text output for reverse video -to come out as normal. Often this description differs from the usual -one by interchanging the two strings which turn reverse video on and -off.@refill - -This is a user option; you can choose either the ``reverse video'' -variant terminal type or the normal terminal type, and termcap will -obey. - -@item -s -``Status''. Says to enable use of a status line which ordinary output -does not touch (@pxref{Status Line}). - -Some terminals have a special line that is used only as a status line. -For these terminals, there is no need for an @samp{-s} variant; the -status line commands should be defined by default. On other -terminals, enabling a status line means removing one screen line from -ordinary use and reducing the effective screen height. For these -terminals, the user can choose the @samp{-s} variant type to request -use of a status line. - -@item -@var{nlines} -Says to operate with @var{nlines} lines on the screen, for terminals -such as the Ambassador which provide this as an option. Normally this -is a user option; by choosing the terminal type, you control how many -lines termcap will use. - -@item -@var{npages}p -Says that the terminal has @var{npages} pages worth of screen memory, -for terminals where this is a hardware option. - -@item -unk -Says that description is not for direct use, but only for reference in -@samp{tc} capabilities. Such a description is a kind of subroutine, -because it describes the common characteristics of several variant -descriptions that would use other suffixes in place of @samp{-unk}. -@end table - -@node Inheriting,, Naming, Data Base -@section Inheriting from Related Descriptions - -@cindex inheritance -When two terminal descriptions are similar, their identical parts do not -need to be given twice. Instead, one of the two can be defined in terms of -the other, using the @samp{tc} capability. We say that one description -@dfn{refers to} the other, or @dfn{inherits from} the other. - -The @samp{tc} capability must be the last one in the terminal description, -and its value is a string which is the name of another terminal type which -is referred to. For example, - -@example -N9|aaa|ambassador|aaa-30|ann arbor ambassador/30 lines:\ - :ti=\E[2J\E[30;0;0;30p:\ - :te=\E[60;0;0;30p\E[30;1H\E[J:\ - :li#30:tc=aaa-unk: -@end example - -@noindent -defines the terminal type @samp{aaa-30} (also known as plain @samp{aaa}) in -terms of @samp{aaa-unk}, which defines everything about the Ambassador that -is independent of screen height. The types @samp{aaa-36}, @samp{aaa-48} -and so on for other screen heights are likewise defined to inherit from -@samp{aaa-unk}. - -The capabilities overridden by @samp{aaa-30} include @samp{li}, which says -how many lines there are, and @samp{ti} and @samp{te}, which configure the -terminal to use that many lines. - -The effective terminal description for type @samp{aaa} consists of the text -shown above followed by the text of the description of @samp{aaa-unk}. The -@samp{tc} capability is handled automatically by @code{tgetent}, which -finds the description thus referenced and combines the two descriptions -(@pxref{Find}). Therefore, only the implementor of the terminal -descriptions needs to think about using @samp{tc}. Users and application -programmers do not need to be concerned with it. - -Since the reference terminal description is used last, capabilities -specified in the referring description override any specifications of the -same capabilities in the reference description. - -The referring description can cancel out a capability without specifying -any new value for it by means of a special trick. Write the capability in -the referring description, with the character @samp{@@} after the capability -name, as follows: - -@example -NZ|aaa-30-nam|ann arbor ambassador/30 lines/no automatic-margins:\ - :am@@:tc=aaa-30: -@end example - -@node Capabilities, Summary, Data Base, Top -@chapter Definitions of the Terminal Capabilities - -This section is divided into many subsections, each for one aspect of -use of display terminals. For writing a display program, you usually need -only check the subsections for the operations you want to use. For writing -a terminal description, you must read each subsection and fill in the -capabilities described there. - -String capabilities that are display commands may require numeric -parameters (@pxref{Parameters}). Most such capabilities do not use -parameters. When a capability requires parameters, this is explicitly -stated at the beginning of its definition. In simple cases, the first or -second sentence of the definition mentions all the parameters, in the order -they should be given, using a name -@iftex -in italics -@end iftex -@ifinfo -in upper case -@end ifinfo -for each one. For example, the @samp{rp} capability is a command that -requires two parameters; its definition begins as follows: - -@quotation -String of commands to output a graphic character @var{c}, repeated @var{n} -times. -@end quotation - -In complex cases or when there are many parameters, they are described -explicitly. - -When a capability is described as obsolete, this means that programs should -not be written to look for it, but terminal descriptions should still be -written to provide it. - -When a capability is described as very obsolete, this means that it should -be omitted from terminal descriptions as well. - -@menu -* Basic:: Basic characteristics. -* Screen Size:: Screen size, and what happens when it changes. -* Cursor Motion:: Various ways to move the cursor. -* Scrolling:: Pushing text up and down on the screen. -* Wrapping:: What happens if you write a character in the last column. -* Windows:: Limiting the part of the window that output affects. -* Clearing:: Erasing one or many lines. -* Insdel Line:: Making new blank lines in mid-screen; deleting lines. -* Insdel Char:: Inserting and deleting characters within a line. -* Standout:: Highlighting some of the text. -* Underlining:: Underlining some of the text. -* Cursor Visibility:: Making the cursor more or less easy to spot. -* Bell:: Attracts user's attention; not localized on the screen. -* Keypad:: Recognizing when function keys or arrows are typed. -* Meta Key:: @key{META} acts like an extra shift key. -* Initialization:: Commands used to initialize or reset the terminal. -* Pad Specs:: Info for the kernel on how much padding is needed. -* Status Line:: A status line displays ``background'' information. -* Half-Line:: Moving by half-lines, for superscripts and subscripts. -* Printer:: Controlling auxiliary printers of display terminals. -@end menu - -@node Basic, Screen Size, Capabilities, Capabilities -@section Basic Characteristics - -This section documents the capabilities that describe the basic and -nature of the terminal, and also those that are relevant to the output -of graphic characters. - -@table @samp -@item os -@kindex os -@cindex overstrike -Flag whose presence means that the terminal can overstrike. This -means that outputting a graphic character does not erase whatever was -present in the same character position before. The terminals that can -overstrike include printing terminals, storage tubes (all obsolete -nowadays), and many bit-map displays. - -@item eo -@kindex eo -Flag whose presence means that outputting a space can erase an -overstrike. If this is not present and overstriking is supported, -output of a space has no effect except to move the cursor. - -@item gn -@kindex gn -@cindex generic terminal type -Flag whose presence means that this terminal type is a generic type -which does not really describe any particular terminal. Generic types -are intended for use as the default type assigned when the user -connects to the system, with the intention that the user should -specify what type he really has. One example of a generic type -is the type @samp{network}. - -Since the generic type cannot say how to do anything interesting with -the terminal, termcap-using programs will always find that the -terminal is too weak to be supported if the user has failed to specify -a real terminal type in place of the generic one. The @samp{gn} flag -directs these programs to use a different error message: ``You have -not specified your real terminal type'', rather than ``Your terminal -is not powerful enough to be used''. - -@item hc -@kindex hc -Flag whose presence means this is a hardcopy terminal. - -@item rp -@kindex rp -@cindex repeat output -String of commands to output a graphic character @var{c}, repeated @var{n} -times. The first parameter value is the ASCII code for the desired -character, and the second parameter is the number of times to repeat the -character. Often this command requires padding proportional to the -number of times the character is repeated. This effect can be had by -using parameter arithmetic with @samp{%}-sequences to compute the -amount of padding, then generating the result as a number at the front -of the string so that @code{tputs} will treat it as padding. - -@item hz -@kindex hz -Flag whose presence means that the ASCII character @samp{~} cannot be -output on this terminal because it is used for display commands. - -Programs handle this flag by checking all text to be output and -replacing each @samp{~} with some other character(s). If this is not -done, the screen will be thoroughly garbled. - -The old Hazeltine terminals that required such treatment are probably -very rare today, so you might as well not bother to support this flag. - -@item CC -@kindex CC -@cindex command character -String whose presence means the terminal has a settable command -character. The value of the string is the default command character -(which is usually @key{ESC}). - -All the strings of commands in the terminal description should be -written to use the default command character. If you are writing an -application program that changes the command character, use the -@samp{CC} capability to figure out how to translate all the display -commands to work with the new command character. - -Most programs have no reason to look at the @samp{CC} capability. - -@item xb -@kindex xb -@cindex Superbee -Flag whose presence identifies Superbee terminals which are unable to -transmit the characters @key{ESC} and @kbd{Control-C}. Programs which -support this flag are supposed to check the input for the code sequences -sent by the @key{F1} and @key{F2} keys, and pretend that @key{ESC} -or @kbd{Control-C} (respectively) had been read. But this flag is -obsolete, and not worth supporting. -@end table - -@node Screen Size, Cursor Motion, Basic, Capabilities -@section Screen Size -@cindex screen size - -A terminal description has two capabilities, @samp{co} and @samp{li}, -that describe the screen size in columns and lines. But there is more -to the question of screen size than this. - -On some operating systems the ``screen'' is really a window and the -effective width can vary. On some of these systems, @code{tgetnum} -uses the actual width of the window to decide what value to return for -the @samp{co} capability, overriding what is actually written in the -terminal description. On other systems, it is up to the application -program to check the actual window width using a system call. For -example, on BSD 4.3 systems, the system call @code{ioctl} with code -@code{TIOCGWINSZ} will tell you the current screen size. - -On all window systems, termcap is powerless to advise the application -program if the user resizes the window. Application programs must -deal with this possibility in a system-dependent fashion. On some -systems the C shell handles part of the problem by detecting changes -in window size and setting the @code{TERMCAP} environment variable -appropriately. This takes care of application programs that are -started subsequently. It does not help application programs already -running. - -On some systems, including BSD 4.3, all programs using a terminal get -a signal named @code{SIGWINCH} whenever the screen size changes. -Programs that use termcap should handle this signal by using -@code{ioctl TIOCGWINSZ} to learn the new screen size. - -@table @samp -@item co -@kindex co -@cindex screen size -Numeric value, the width of the screen in character positions. Even -hardcopy terminals normally have a @samp{co} capability. - -@item li -@kindex li -Numeric value, the height of the screen in lines. -@end table - -@node Cursor Motion, Wrapping, Screen Size, Capabilities -@section Cursor Motion -@cindex cursor motion - -Termcap assumes that the terminal has a @dfn{cursor}, a spot on the screen -where a visible mark is displayed, and that most display commands take -effect at the position of the cursor. It follows that moving the cursor -to a specified location is very important. - -There are many terminal capabilities for different cursor motion -operations. A terminal description should define as many as possible, but -most programs do not need to use most of them. One capability, @samp{cm}, -moves the cursor to an arbitrary place on the screen; this by itself is -sufficient for any application as long as there is no need to support -hardcopy terminals or certain old, weak displays that have only relative -motion commands. Use of other cursor motion capabilities is an -optimization, enabling the program to output fewer characters in some -common cases. - -If you plan to use the relative cursor motion commands in an application -program, you must know what the starting cursor position is. To do this, -you must keep track of the cursor position and update the records each -time anything is output to the terminal, including graphic characters. -In addition, it is necessary to know whether the terminal wraps after -writing in the rightmost column. @xref{Wrapping}. - -One other motion capability needs special mention: @samp{nw} moves the -cursor to the beginning of the following line, perhaps clearing all the -starting line after the cursor, or perhaps not clearing at all. This -capability is a least common denominator that is probably supported even by -terminals that cannot do most other things such as @samp{cm} or @samp{do}. -Even hardcopy terminals can support @samp{nw}. - -@table @asis -@item @samp{cm} -@kindex cm -String of commands to position the cursor at line @var{l}, column @var{c}. -Both parameters are origin-zero, and are defined relative to the -screen, not relative to display memory. - -All display terminals except a few very obsolete ones support @samp{cm}, -so it is acceptable for an application program to refuse to operate on -terminals lacking @samp{cm}. - -@item @samp{ho} -@kindex ho -@cindex home position -String of commands to move the cursor to the upper left corner of the -screen (this position is called the @dfn{home position}). In -terminals where the upper left corner of the screen is not the same as -the beginning of display memory, this command must go to the upper -left corner of the screen, not the beginning of display memory. - -Every display terminal supports this capability, and many application -programs refuse to operate if the @samp{ho} capability is missing. - -@item @samp{ll} -@kindex ll -String of commands to move the cursor to the lower left corner of the -screen. On some terminals, moving up from home position does this, -but programs should never assume that will work. Just output the -@samp{ll} string (if it is provided); if moving to home position and -then moving up is the best way to get there, the @samp{ll} command -will do that. - -@item @samp{cr} -@kindex cr -String of commands to move the cursor to the beginning of the line it -is on. If this capability is not specified, many programs assume -they can use the ASCII carriage return character for this. - -@item @samp{le} -@kindex le -String of commands to move the cursor left one column. Unless the -@samp{bw} flag capability is specified, the effect is undefined if the -cursor is at the left margin; do not use this command there. If -@samp{bw} is present, this command may be used at the left margin, and -it wraps the cursor to the last column of the preceding line. - -@item @samp{nd} -@kindex nd -String of commands to move the cursor right one column. The effect is -undefined if the cursor is at the right margin; do not use this -command there, not even if @samp{am} is present. - -@item @samp{up} -@kindex up -String of commands to move the cursor vertically up one line. The -effect of sending this string when on the top line is undefined; -programs should never use it that way. - -@item @samp{do} -@kindex do -String of commands to move the cursor vertically down one line. The -effect of sending this string when on the bottom line is undefined; -programs should never use it that way. - -The original idea was that this string would not contain a newline -character and therefore could be used without disabling the kernel's usual -habit of converting of newline into a carriage-return newline sequence. -But many terminal descriptions do use newline in the @samp{do} string, so -this is not possible; a program which sends the @samp{do} string must -disable output conversion in the kernel (@pxref{Initialize}). - -@item @samp{bw} -@kindex bw -Flag whose presence says that @samp{le} may be used in column zero -to move to the last column of the preceding line. If this flag -is not present, @samp{le} should not be used in column zero. - -@item @samp{nw} -@kindex nw -String of commands to move the cursor to start of next line, possibly -clearing rest of line (following the cursor) before moving. - -@item @samp{DO}, @samp{UP}, @samp{LE}, @samp{RI} -@kindex DO -@kindex LE -@kindex RI -@kindex UP -Strings of commands to move the cursor @var{n} lines down vertically, -up vertically, or @var{n} columns left or right. Do not attempt to -move past any edge of the screen with these commands; the effect of -trying that is undefined. Only a few terminal descriptions provide -these commands, and most programs do not use them. - -@item @samp{CM} -@kindex CM -String of commands to position the cursor at line @var{l}, column -@var{c}, relative to display memory. Both parameters are origin-zero. -This capability is present only in terminals where there is a -difference between screen-relative and memory-relative addressing, and -not even in all such terminals. - -@item @samp{ch} -@kindex ch -String of commands to position the cursor at column @var{c} in the -same line it is on. This is a special case of @samp{cm} in which the -vertical position is not changed. The @samp{ch} capability is -provided only when it is faster to output than @samp{cm} would be in -this special case. Programs should not assume most display terminals -have @samp{ch}. - -@item @samp{cv} -@kindex cv -String of commands to position the cursor at line @var{l} in the same -column. This is a special case of @samp{cm} in which the horizontal -position is not changed. The @samp{cv} capability is provided only -when it is faster to output than @samp{cm} would be in this special -case. Programs should not assume most display terminals have -@samp{cv}. - -@item @samp{sc} -@kindex sc -String of commands to make the terminal save the current cursor -position. Only the last saved position can be used. If this -capability is present, @samp{rc} should be provided also. Most -terminals have neither. - -@item @samp{rc} -@kindex rc -String of commands to make the terminal restore the last saved cursor -position. If this capability is present, @samp{sc} should be provided -also. Most terminals have neither. - -@item @samp{ff} -@kindex ff -String of commands to advance to the next page, for a hardcopy -terminal. - -@item @samp{ta} -@kindex ta -String of commands to move the cursor right to the next hardware tab -stop column. Missing if the terminal does not have any kind of -hardware tabs. Do not send this command if the kernel's terminal -modes say that the kernel is expanding tabs into spaces. - -@item @samp{bt} -@kindex bt -String of commands to move the cursor left to the previous hardware -tab stop column. Missing if the terminal has no such ability; many -terminals do not. Do not send this command if the kernel's terminal -modes say that the kernel is expanding tabs into spaces. -@end table - -The following obsolete capabilities should be included in terminal -descriptions when appropriate, but should not be looked at by new programs. - -@table @samp -@item nc -@kindex nc -Flag whose presence means the terminal does not support the ASCII -carriage return character as @samp{cr}. This flag is needed because -old programs assume, when the @samp{cr} capability is missing, that -ASCII carriage return can be used for the purpose. We use @samp{nc} -to tell the old programs that carriage return may not be used. - -New programs should not assume any default for @samp{cr}, so they need -not look at @samp{nc}. However, descriptions should contain @samp{nc} -whenever they do not contain @samp{cr}. - -@item xt -@kindex xt -Flag whose presence means that the ASCII tab character may not be used -for cursor motion. This flag exists because old programs assume, when -the @samp{ta} capability is missing, that ASCII tab can be used for -the purpose. We use @samp{xt} to tell the old programs not to use tab. - -New programs should not assume any default for @samp{ta}, so they need -not look at @samp{xt} in connection with cursor motion. Note that -@samp{xt} also has implications for standout mode (@pxref{Standout}). -It is obsolete in regard to cursor motion but not in regard to -standout. - -In fact, @samp{xt} means that the terminal is a Teleray 1061. - -@item bc -@kindex bc -Very obsolete alternative name for the @samp{le} capability. - -@item bs -@kindex bs -Flag whose presence means that the ASCII character backspace may be -used to move the cursor left. Obsolete; look at @samp{le} instead. - -@item nl -@kindex nl -Obsolete capability which is a string that can either be used to move -the cursor down or to scroll. The same string must scroll when used -on the bottom line and move the cursor when used on any other line. -New programs should use @samp{do} or @samp{sf}, and ignore @samp{nl}. - -If there is no @samp{nl} capability, some old programs assume they can -use the newline character for this purpose. These programs follow a -bad practice, but because they exist, it is still desirable to define -the @samp{nl} capability in a terminal description if the best way to -move down is @emph{not} a newline. -@end table - -@node Wrapping, Scrolling, Cursor Motion, Capabilities -@section Wrapping -@cindex wrapping - -@dfn{Wrapping} means moving the cursor from the right margin to the left -margin of the following line. Some terminals wrap automatically when a -graphic character is output in the last column, while others do not. Most -application programs that use termcap need to know whether the terminal -wraps. There are two special flag capabilities to describe what the -terminal does when a graphic character is output in the last column. - -@table @samp -@item am -@kindex am -Flag whose presence means that writing a character in the last column -causes the cursor to wrap to the beginning of the next line. - -If @samp{am} is not present, writing in the last column leaves the -cursor at the place where the character was written. - -Writing in the last column of the last line should be avoided on -terminals with @samp{am}, as it may or may not cause scrolling to -occur (@pxref{Scrolling}). Scrolling is surely not what you would -intend. - -If your program needs to check the @samp{am} flag, then it also needs -to check the @samp{xn} flag which indicates that wrapping happens in a -strange way. Many common terminals have the @samp{xn} flag. - -@item xn -@kindex xn -Flag whose presence means that the cursor wraps in a strange way. At -least two distinct kinds of strange behavior are known; the termcap -data base does not contain anything to distinguish the two. - -On Concept-100 terminals, output in the last column wraps the cursor -almost like an ordinary @samp{am} terminal. But if the next thing -output is a newline, it is ignored. - -DEC VT-100 terminals (when the wrap switch is on) do a different -strange thing: the cursor wraps only if the next thing output is -another graphic character. In fact, the wrap occurs when the -following graphic character is received by the terminal, before the -character is placed on the screen. - -On both of these terminals, after writing in the last column a -following graphic character will be displayed in the first column of -the following line. But the effect of relative cursor motion -characters such as newline or backspace at such a time depends on the -terminal. The effect of erase or scrolling commands also depends on -the terminal. You can't assume anything about what they will do on a -terminal that has @samp{xn}. So, to be safe, you should never do -these things at such a time on such a terminal. - -To be sure of reliable results on a terminal which has the @samp{xn} -flag, output a @samp{cm} absolute positioning command after writing in -the last column. Another safe thing to do is to output carriage-return -newline, which will leave the cursor at the beginning of the following -line. -@end table - -@node Scrolling, Windows, Wrapping, Capabilities -@section Scrolling -@cindex scrolling - -@dfn{Scrolling} means moving the contents of the screen up or down one or -more lines. Moving the contents up is @dfn{forward scrolling}; moving them -down is @dfn{reverse scrolling}. - -Scrolling happens after each line of output during ordinary output on most -display terminals. But in an application program that uses termcap for -random-access output, scrolling happens only when explicitly requested with -the commands in this section. - -Some terminals have a @dfn{scroll region} feature. This lets you limit -the effect of scrolling to a specified range of lines. Lines outside the -range are unaffected when scrolling happens. The scroll region feature -is available if either @samp{cs} or @samp{cS} is present. - -@table @samp -@item sf -@kindex sf -String of commands to scroll the screen one line up, assuming it is -output with the cursor at the beginning of the bottom line. - -@item sr -@kindex sr -String of commands to scroll the screen one line down, assuming it is -output with the cursor at the beginning of the top line. - -@item SF -@kindex SF -String of commands to scroll the screen @var{n} lines up, assuming it -is output with the cursor at the beginning of the bottom line. - -@item SR -@kindex SR -String of commands to scroll the screen @var{n} line down, assuming it -is output with the cursor at the beginning of the top line. - -@item cs -@kindex cs -String of commands to set the scroll region. This command takes two -parameters, @var{start} and @var{end}, which are the line numbers -(origin-zero) of the first line to include in the scroll region and of -the last line to include in it. When a scroll region is set, -scrolling is limited to the specified range of lines; lines outside -the range are not affected by scroll commands. - -Do not try to move the cursor outside the scroll region. The region -remains set until explicitly removed. To remove the scroll region, -use another @samp{cs} command specifying the full height of the -screen. - -The cursor position is undefined after the @samp{cs} command is set, -so position the cursor with @samp{cm} immediately afterward. - -@item cS -@kindex cS -String of commands to set the scroll region using parameters in -different form. The effect is the same as if @samp{cs} were used. -Four parameters are required: - -@enumerate -@item -Total number of lines on the screen. -@item -Number of lines above desired scroll region. -@item -Number of lines below (outside of) desired scroll region. -@item -Total number of lines on the screen, the same as the first parameter. -@end enumerate - -This capability is a GNU extension that was invented to allow the Ann -Arbor Ambassador's scroll-region command to be described; it could -also be done by putting non-Unix @samp{%}-sequences into a @samp{cs} -string, but that would have confused Unix programs that used the -@samp{cs} capability with the Unix termcap. Currently only GNU Emacs -uses the @samp{cS} capability. - -@item ns -@kindex ns -Flag which means that the terminal does not normally scroll for -ordinary sequential output. For modern terminals, this means that -outputting a newline in ordinary sequential output with the cursor on -the bottom line wraps to the top line. For some obsolete terminals, -other things may happen. - -The terminal may be able to scroll even if it does not normally do so. -If the @samp{sf} capability is provided, it can be used for scrolling -regardless of @samp{ns}. - -@item da -@kindex da -Flag whose presence means that lines scrolled up off the top of the -screen may come back if scrolling down is done subsequently. - -The @samp{da} and @samp{db} flags do not, strictly speaking, affect -how to scroll. But programs that scroll usually need to clear the -lines scrolled onto the screen, if these flags are present. - -@item db -@kindex db -Flag whose presence means that lines scrolled down off the bottom of -the screen may come back if scrolling up is done subsequently. - -@item lm -@kindex lm -Numeric value, the number of lines of display memory that the terminal -has. A value of zero means that the terminal has more display memory -than can fit on the screen, but no fixed number of lines. (The number -of lines may depend on the amount of text in each line.) -@end table - -Any terminal description that defines @samp{SF} should also define @samp{sf}; -likewise for @samp{SR} and @samp{sr}. However, many terminals can only -scroll by one line at a time, so it is common to find @samp{sf} and not -@samp{SF}, or @samp{sr} without @samp{SR}.@refill - -Therefore, all programs that use the scrolling facilities should be -prepared to work with @samp{sf} in the case that @samp{SF} is absent, and -likewise with @samp{sr}. On the other hand, an application program that -uses only @samp{sf} and not @samp{SF} is acceptable, though slow on some -terminals.@refill - -When outputting a scroll command with @code{tputs}, the @var{nlines} -argument should be the total number of lines in the portion of the screen -being scrolled. Very often these commands require padding proportional to -this number of lines. @xref{Padding}. - -@node Windows, Clearing, Scrolling, Capabilities -@section Windows -@cindex window - -A @dfn{window}, in termcap, is a rectangular portion of the screen to which -all display operations are restricted. Wrapping, clearing, scrolling, -insertion and deletion all operate as if the specified window were all the -screen there was. - -@table @samp -@item wi -@kindex wi -String of commands to set the terminal output screen window. -This string requires four parameters, all origin-zero: -@enumerate -@item -The first line to include in the window. -@item -The last line to include in the window. -@item -The first column to include in the window. -@item -The last column to include in the window. -@end enumerate -@end table - -Most terminals do not support windows. - -@node Clearing, Insdel Line, Windows, Capabilities -@section Clearing Parts of the Screen -@cindex erasing -@cindex clearing the screen - -There are several terminal capabilities for clearing parts of the screen -to blank. All display terminals support the @samp{cl} string, and most -display terminals support all of these capabilities. - -@table @samp -@item cl -@kindex cl -String of commands to clear the entire screen and position the cursor -at the upper left corner. - -@item cd -@kindex cd -String of commands to clear the line the cursor is on, and all the -lines below it, down to the bottom of the screen. This command string -should be used only with the cursor in column zero; their effect is -undefined if the cursor is elsewhere. - -@item ce -@kindex ce -String of commands to clear from the cursor to the end of the current -line. - -@item ec -@kindex ec -String of commands to clear @var{n} characters, starting with the -character that the cursor is on. This command string is expected to -leave the cursor position unchanged. The parameter @var{n} should never -be large enough to reach past the right margin; the effect of such a -large parameter would be undefined. -@end table - -Clear to end of line (@samp{ce}) is extremely important in programs that -maintain an updating display. Nearly all display terminals support this -operation, so it is acceptable for a an application program to refuse to -work if @samp{ce} is not present. However, if you do not want this -limitation, you can accomplish clearing to end of line by outputting spaces -until you reach the right margin. In order to do this, you must know the -current horizontal position. Also, this technique assumes that writing a -space will erase. But this happens to be true on all the display terminals -that fail to support @samp{ce}. - -@node Insdel Line, Insdel Char, Clearing, Capabilities -@section Insert/Delete Line - -@cindex insert line -@cindex delete line -@dfn{Inserting a line} means creating a blank line in the middle -of the screen, and pushing the existing lines of text apart. In fact, -the lines above the insertion point do not change, while the lines below -move down, and one is normally lost at the bottom of the screen. - -@dfn{Deleting a line} means causing the line to disappear from the screen, -closing up the gap by moving the lines below it upward. A new line -appears at the bottom of the screen. Usually this line is blank, but -on terminals with the @samp{db} flag it may be a line previously moved -off the screen bottom by scrolling or line insertion. - -Insertion and deletion of lines is useful in programs that maintain an -updating display some parts of which may get longer or shorter. They are -also useful in editors for scrolling parts of the screen, and for -redisplaying after lines of text are killed or inserted. - -Many terminals provide commands to insert or delete a single line at the -cursor position. Some provide the ability to insert or delete several -lines with one command, using the number of lines to insert or delete as a -parameter. Always move the cursor to column zero before using any of -these commands. - -@table @samp -@item al -@kindex al -String of commands to insert a blank line before the line the cursor -is on. The existing line, and all lines below it, are moved down. -The last line in the screen (or in the scroll region, if one is set) -disappears and in most circumstances is discarded. It may not be -discarded if the @samp{db} is present (@pxref{Scrolling}). - -The cursor must be at the left margin before this command is used. -This command does not move the cursor. - -@item dl -@kindex dl -String of commands to delete the line the cursor is on. The following -lines move up, and a blank line appears at the bottom of the screen -(or bottom of the scroll region). If the terminal has the @samp{db} -flag, a nonblank line previously pushed off the screen bottom may -reappear at the bottom. - -The cursor must be at the left margin before this command is used. -This command does not move the cursor. - -@item AL -@kindex AL -String of commands to insert @var{n} blank lines before the line that -the cursor is on. It is like @samp{al} repeated @var{n} times, except -that it is as fast as one @samp{al}. - -@item DL -@kindex DL -String of commands to delete @var{n} lines starting with the line that -the cursor is on. It is like @samp{dl} repeated @var{n} times, except -that it is as fast as one @samp{dl}. -@end table - -Any terminal description that defines @samp{AL} should also define -@samp{al}; likewise for @samp{DL} and @samp{dl}. However, many terminals -can only insert or delete one line at a time, so it is common to find -@samp{al} and not @samp{AL}, or @samp{dl} without @samp{DL}.@refill - -Therefore, all programs that use the insert and delete facilities should be -prepared to work with @samp{al} in the case that @samp{AL} is absent, and -likewise with @samp{dl}. On the other hand, it is acceptable to write -an application that uses only @samp{al} and @samp{dl} and does not look -for @samp{AL} or @samp{DL} at all.@refill - -If a terminal does not support line insertion and deletion directly, -but does support a scroll region, the effect of insertion and deletion -can be obtained with scrolling. However, it is up to the individual -user program to check for this possibility and use the scrolling -commands to get the desired result. It is fairly important to implement -this alternate strategy, since it is the only way to get the effect of -line insertion and deletion on the popular VT100 terminal. - -Insertion and deletion of lines is affected by the scroll region on -terminals that have a settable scroll region. This is useful when it is -desirable to move any few consecutive lines up or down by a few lines. -@xref{Scrolling}. - -The line pushed off the bottom of the screen is not lost if the terminal -has the @samp{db} flag capability; instead, it is pushed into display -memory that does not appear on the screen. This is the same thing that -happens when scrolling pushes a line off the bottom of the screen. -Either reverse scrolling or deletion of a line can bring the apparently -lost line back onto the bottom of the screen. If the terminal has the -scroll region feature as well as @samp{db}, the pushed-out line really -is lost if a scroll region is in effect. - -When outputting an insert or delete command with @code{tputs}, the -@var{nlines} argument should be the total number of lines from the cursor -to the bottom of the screen (or scroll region). Very often these commands -require padding proportional to this number of lines. @xref{Padding}. - -For @samp{AL} and @samp{DL} the @var{nlines} argument should @emph{not} -depend on the number of lines inserted or deleted; only the total number of -lines affected. This is because it is just as fast to insert two or -@var{n} lines with @samp{AL} as to insert one line with @samp{al}. - -@node Insdel Char, Standout, Insdel Line, Capabilities -@section Insert/Delete Character -@cindex insert character -@cindex delete character - -@dfn{Inserting a character} means creating a blank space in the middle of a -line, and pushing the rest of the line rightward. The character in the -rightmost column is lost. - -@dfn{Deleting a character} means causing the character to disappear from -the screen, closing up the gap by moving the rest of the line leftward. A -blank space appears in the rightmost column. - -Insertion and deletion of characters is useful in programs that maintain an -updating display some parts of which may get longer or shorter. It is also -useful in editors for redisplaying the results of editing within a line. - -Many terminals provide commands to insert or delete a single character at -the cursor position. Some provide the ability to insert or delete several -characters with one command, using the number of characters to insert or -delete as a parameter. - -@cindex insert mode -Many terminals provide an insert mode in which outputting a graphic -character has the added effect of inserting a position for that character. -A special command string is used to enter insert mode and another is used -to exit it. The reason for designing a terminal with an insert mode rather -than an insert command is that inserting character positions is usually -followed by writing characters into them. With insert mode, this is as -fast as simply writing the characters, except for the fixed overhead of -entering and leaving insert mode. However, when the line speed is great -enough, padding may be required for the graphic characters output in insert -mode. - -Some terminals require you to enter insert mode and then output a special -command for each position to be inserted. Or they may require special -commands to be output before or after each graphic character to be -inserted. - -@cindex delete mode -Deletion of characters is usually accomplished by a straightforward command -to delete one or several positions; but on some terminals, it is necessary -to enter a special delete mode before using the delete command, and leave -delete mode afterward. Sometimes delete mode and insert mode are the same -mode. - -Some terminals make a distinction between character positions in which a -space character has been output and positions which have been cleared. On -these terminals, the effect of insert or delete character runs to the first -cleared position rather than to the end of the line. In fact, the effect -may run to more than one line if there is no cleared position to stop the -shift on the first line. These terminals are identified by the @samp{in} -flag capability. - -On terminals with the @samp{in} flag, the technique of skipping over -characters that you know were cleared, and then outputting text later on in -the same line, causes later insert and delete character operations on that -line to do nonstandard things. A program that has any chance of doing this -must check for the @samp{in} flag and must be careful to write explicit -space characters into the intermediate columns when @samp{in} is present. - -A plethora of terminal capabilities are needed to describe all of this -complexity. Here is a list of them all. Following the list, we present -an algorithm for programs to use to take proper account of all of these -capabilities. - -@table @samp -@item im -@kindex im -String of commands to enter insert mode. - -If the terminal has no special insert mode, but it can insert -characters with a special command, @samp{im} should be defined with a -null value, because the @samp{vi} editor assumes that insertion of a -character is impossible if @samp{im} is not provided. - -New programs should not act like @samp{vi}. They should pay attention -to @samp{im} only if it is defined. - -@item ei -@kindex ei -String of commands to leave insert mode. This capability must be -present if @samp{im} is. - -On a few old terminals the same string is used to enter and exit -insert mode. This string turns insert mode on if it was off, and off -if it was on. You can tell these terminals because the @samp{ei} -string equals the @samp{im} string. If you want to support these -terminals, you must always remember accurately whether insert mode is -in effect. However, these terminals are obsolete, and it is -reasonable to refuse to support them. On all modern terminals, you -can safely output @samp{ei} at any time to ensure that insert mode is -turned off. - -@item ic -@kindex ic -String of commands to insert one character position at the cursor. -The cursor does not move. - -If outputting a graphic character while in insert mode is sufficient -to insert the character, then the @samp{ic} capability should be -defined with a null value. - -If your terminal offers a choice of ways to insert---either use insert -mode or use a special command---then define @samp{im} and do not define -@samp{ic}, since this gives the most efficient operation when several -characters are to be inserted. @emph{Do not} define both strings, for -that means that @emph{both} must be used each time insertion is done. - -@item ip -@kindex ip -String of commands to output following an inserted graphic character -in insert mode. Often it is used just for a padding spec, when padding -is needed after an inserted character (@pxref{Padding}). - -@item IC -@kindex IC -String of commands to insert @var{n} character positions at and after -the cursor. It has the same effect as repeating the @samp{ic} string -and a space, @var{n} times. - -If @samp{IC} is provided, application programs may use it without first -entering insert mode. - -@item mi -@kindex mi -Flag whose presence means it is safe to move the cursor while in insert -mode and assume the terminal remains in insert mode. - -@item in -@kindex in -Flag whose presence means that the terminal distinguishes between -character positions in which space characters have been output and -positions which have been cleared. -@end table - -An application program can assume that the terminal can do character -insertion if @emph{any one of} the capabilities @samp{IC}, @samp{im}, -@samp{ic} or @samp{ip} is provided. - -To insert @var{n} blank character positions, move the cursor to the place -to insert them and follow this algorithm: - -@enumerate -@item -If an @samp{IC} string is provided, output it with parameter @var{n} -and you are finished. Otherwise (or if you don't want to bother to -look for an @samp{IC} string) follow the remaining steps. - -@item -Output the @samp{im} string, if there is one, unless the terminal is -already in insert mode. - -@item -Repeat steps 4 through 6, @var{n} times. - -@item -Output the @samp{ic} string if any. - -@item -Output a space. - -@item -Output the @samp{ip} string if any. - -@item -Output the @samp{ei} string, eventually, to exit insert mode. There -is no need to do this right away. If the @samp{mi} flag is present, -you can move the cursor and the cursor will remain in insert mode; -then you can do more insertion elsewhere without reentering insert -mode. -@end enumerate - -To insert @var{n} graphic characters, position the cursor and follow this -algorithm: - -@enumerate -@item -If an @samp{IC} string is provided, output it with parameter @var{n}, -then output the graphic characters, and you are finished. Otherwise -(or if you don't want to bother to look for an @samp{IC} string) -follow the remaining steps. - -@item -Output the @samp{im} string, if there is one, unless the terminal is -already in insert mode. - -@item -For each character to be output, repeat steps 4 through 6. - -@item -Output the @samp{ic} string if any. - -@item -Output the next graphic character. - -@item -Output the @samp{ip} string if any. - -@item -Output the @samp{ei} string, eventually, to exit insert mode. There -is no need to do this right away. If the @samp{mi} flag is present, -you can move the cursor and the cursor will remain in insert mode; -then you can do more insertion elsewhere without reentering insert -mode. -@end enumerate - -Note that this is not the same as the original Unix termcap specifications -in one respect: it assumes that the @samp{IC} string can be used without -entering insert mode. This is true as far as I know, and it allows you be -able to avoid entering and leaving insert mode, and also to be able to -avoid the inserted-character padding after the characters that go into the -inserted positions. - -Deletion of characters is less complicated; deleting one column is done by -outputting the @samp{dc} string. However, there may be a delete mode that -must be entered with @samp{dm} in order to make @samp{dc} work. - -@table @samp -@item dc -@kindex dc -String of commands to delete one character position at the cursor. If -@samp{dc} is not present, the terminal cannot delete characters. - -@item DC -@kindex DC -String of commands to delete @var{n} characters starting at the cursor. -It has the same effect as repeating the @samp{dc} string @var{n} times. -Any terminal description that has @samp{DC} also has @samp{dc}. - -@item dm -@kindex dm -String of commands to enter delete mode. If not present, there is no -delete mode, and @samp{dc} can be used at any time (assuming there is -a @samp{dc}). - -@item ed -@kindex ed -String of commands to exit delete mode. This must be present if -@samp{dm} is. -@end table - -To delete @var{n} character positions, position the cursor and follow these -steps: - -@enumerate -@item -If the @samp{DC} string is present, output it with parameter @var{n} -and you are finished. Otherwise, follow the remaining steps. - -@item -Output the @samp{dm} string, unless you know the terminal is already -in delete mode. - -@item -Output the @samp{dc} string @var{n} times. - -@item -Output the @samp{ed} string eventually. If the flag capability -@samp{mi} is present, you can move the cursor and do more deletion -without leaving and reentering delete mode. -@end enumerate - -As with the @samp{IC} string, we have departed from the original termcap -specifications by assuming that @samp{DC} works without entering delete -mode even though @samp{dc} would not. - -If the @samp{dm} and @samp{im} capabilities are both present and have the -same value, it means that the terminal has one mode for both insertion and -deletion. It is useful for a program to know this, because then it can do -insertions after deletions, or vice versa, without leaving insert/delete -mode and reentering it. - -@node Standout, Underlining, Insdel Char, Capabilities -@section Standout and Appearance Modes -@cindex appearance modes -@cindex standout -@cindex magic cookie - -@dfn{Appearance modes} are modifications to the ways characters are -displayed. Typical appearance modes include reverse video, dim, bright, -blinking, underlined, invisible, and alternate character set. Each kind of -terminal supports various among these, or perhaps none. - -For each type of terminal, one appearance mode or combination of them that -looks good for highlighted text is chosen as the @dfn{standout mode}. The -capabilities @samp{so} and @samp{se} say how to enter and leave standout -mode. Programs that use appearance modes only to highlight some text -generally use the standout mode so that they can work on as many terminals -as possible. Use of specific appearance modes other than ``underlined'' -and ``alternate character set'' is rare. - -Terminals that implement appearance modes fall into two general classes as -to how they do it. - -In some terminals, the presence or absence of any appearance mode is -recorded separately for each character position. In these terminals, each -graphic character written is given the appearance modes current at the time -it is written, and keeps those modes until it is erased or overwritten. -There are special commands to turn the appearance modes on or off for -characters to be written in the future. - -In other terminals, the change of appearance modes is represented by a -marker that belongs to a certain screen position but affects all following -screen positions until the next marker. These markers are traditionally -called @dfn{magic cookies}. - -The same capabilities (@samp{so}, @samp{se}, @samp{mb} and so on) for -turning appearance modes on and off are used for both magic-cookie -terminals and per-character terminals. On magic cookie terminals, these -give the commands to write the magic cookies. On per-character terminals, -they change the current modes that affect future output and erasure. Some -simple applications can use these commands without knowing whether or not -they work by means of cookies. - -However, a program that maintains and updates a display needs to know -whether the terminal uses magic cookies, and exactly what their effect is. -This information comes from the @samp{sg} capability. - -The @samp{sg} capability is a numeric capability whose presence indicates -that the terminal uses magic cookies for appearance modes. Its value is -the number of character positions that a magic cookie occupies. Usually -the cookie occupies one or more character positions on the screen, and these -character positions are displayed as blank, but in some terminals the -cookie has zero width. - -The @samp{sg} capability describes both the magic cookie to turn standout -on and the cookie to turn it off. This makes the assumption that both -kinds of cookie have the same width on the screen. If that is not true, -the narrower cookie must be ``widened'' with spaces until it has the same -width as the other. - -On some magic cookie terminals, each line always starts with normal -display; in other words, the scope of a magic cookie never extends over -more than one line. But on other terminals, one magic cookie affects all -the lines below it unless explicitly canceled. Termcap does not define any -way to distinguish these two ways magic cookies can work. To be safe, it -is best to put a cookie at the beginning of each line. - -On some per-character terminals, standout mode or other appearance modes -may be canceled by moving the cursor. On others, moving the cursor has no -effect on the state of the appearance modes. The latter class of terminals -are given the flag capability @samp{ms} (``can move in standout''). All -programs that might have occasion to move the cursor while appearance modes -are turned on must check for this flag; if it is not present, they should -reset appearance modes to normal before doing cursor motion. - -A program that has turned on only standout mode should use @samp{se} to -reset the standout mode to normal. A program that has turned on only -alternate character set mode should use @samp{ae} to return it to normal. -If it is possible that any other appearance modes are turned on, use the -@samp{me} capability to return them to normal. - -Note that the commands to turn on one appearance mode, including @samp{so} -and @samp{mb} @dots{} @samp{mr}, if used while some other appearance modes -are turned on, may combine the two modes on some terminals but may turn off -the mode previously enabled on other terminals. This is because some -terminals do not have a command to set or clear one appearance mode without -changing the others. Programs should not attempt to use appearance modes -in combination except with @samp{sa}, and when switching from one single -mode to another should always turn off the previously enabled mode and then -turn on the new desired mode. - -On some old terminals, the @samp{so} and @samp{se} commands may be the same -command, which has the effect of turning standout on if it is off, or off -it is on. It is therefore risky for a program to output extra @samp{se} -commands for good measure. Fortunately, all these terminals are obsolete. - -Programs that update displays in which standout-text may be replaced with -non-standout text must check for the @samp{xs} flag. In a per-character -terminal, this flag says that the only way to remove standout once written is -to clear that portion of the line with the @samp{ce} string or something -even more powerful (@pxref{Clearing}); just writing new characters at those -screen positions will not change the modes in effect there. In a magic -cookie terminal, @samp{xs} says that the only way to remove a cookie is to -clear a portion of the line that includes the cookie; writing a different -cookie at the same position does not work. - -Such programs must also check for the @samp{xt} flag, which means that the -terminal is a Teleray 1061. On this terminal it is impossible to position -the cursor at the front of a magic cookie, so the only two ways to remove a -cookie are (1) to delete the line it is on or (2) to position the cursor at -least one character before it (possibly on a previous line) and output the -@samp{se} string, which on these terminals finds and removes the next -@samp{so} magic cookie on the screen. (It may also be possible to remove a -cookie which is not at the beginning of a line by clearing that line.) The -@samp{xt} capability also has implications for the use of tab characters, -but in that regard it is obsolete (@xref{Cursor Motion}). - -@table @samp -@item so -@kindex so -String of commands to enter standout mode. - -@item se -@kindex se -String of commands to leave standout mode. - -@item sg -@kindex sg -Numeric capability, the width on the screen of the magic cookie. This -capability is absent in terminals that record appearance modes -character by character. - -@item ms -@kindex ms -Flag whose presence means that it is safe to move the cursor while the -appearance modes are not in the normal state. If this flag is absent, -programs should always reset the appearance modes to normal before -moving the cursor. - -@item xs -@kindex xs -Flag whose presence means that the only way to reset appearance modes -already on the screen is to clear to end of line. On a per-character -terminal, you must clear the area where the modes are set. On a magic -cookie terminal, you must clear an area containing the cookie. -See the discussion above. - -@item xt -@kindex xt -Flag whose presence means that the cursor cannot be positioned right -in front of a magic cookie, and that @samp{se} is a command to delete -the next magic cookie following the cursor. See discussion above. - -@item mb -@kindex mb -String of commands to enter blinking mode. - -@item md -@kindex md -String of commands to enter double-bright mode. - -@item mh -@kindex mh -String of commands to enter half-bright mode. - -@item mk -@kindex mk -String of commands to enter invisible mode. - -@item mp -@kindex mp -String of commands to enter protected mode. - -@item mr -@kindex mr -String of commands to enter reverse-video mode. - -@item me -@kindex me -String of commands to turn off all appearance modes, including -standout mode and underline mode. On some terminals it also turns off -alternate character set mode; on others, it may not. This capability -must be present if any of @samp{mb} @dots{} @samp{mr} is present. - -@item as -@kindex as -String of commands to turn on alternate character set mode. This mode -assigns some or all graphic characters an alternate picture on the -screen. There is no standard as to what the alternate pictures look -like. - -@item ae -@kindex ae -String of commands to turn off alternate character set mode. - -@item sa -@kindex sa -String of commands to turn on an arbitrary combination of appearance -modes. It accepts 9 parameters, each of which controls a particular -kind of appearance mode. A parameter should be 1 to turn its appearance -mode on, or zero to turn that mode off. Most terminals do not support -the @samp{sa} capability, even among those that do have various -appearance modes. - -The nine parameters are, in order, @var{standout}, @var{underline}, -@var{reverse}, @var{blink}, @var{half-bright}, @var{double-bright}, -@var{blank}, @var{protect}, @var{alt char set}. -@end table - -@node Underlining, Cursor Visibility, Standout, Capabilities -@section Underlining -@cindex underlining - -Underlining on most terminals is a kind of appearance mode, much like -standout mode. Therefore, it may be implemented using magic cookies or as -a flag in the terminal whose current state affects each character that is -output. @xref{Standout}, for a full explanation. - -The @samp{ug} capability is a numeric capability whose presence indicates -that the terminal uses magic cookies for underlining. Its value is the -number of character positions that a magic cookie for underlining occupies; -it is used for underlining just as @samp{sg} is used for standout. Aside -from the simplest applications, it is impossible to use underlining -correctly without paying attention to the value of @samp{ug}. - -@table @samp -@item us -@kindex us -String of commands to turn on underline mode or to output a magic cookie -to start underlining. - -@item ue -@kindex ue -String of commands to turn off underline mode or to output a magic -cookie to stop underlining. - -@item ug -@kindex ug -Width of magic cookie that represents a change of underline mode; -or missing, if the terminal does not use a magic cookie for this. - -@item ms -@kindex ms -Flag whose presence means that it is safe to move the cursor while the -appearance modes are not in the normal state. Underlining is an -appearance mode. If this flag is absent, programs should always turn -off underlining before moving the cursor. -@end table - -There are two other, older ways of doing underlining: there can be a -command to underline a single character, or the output of @samp{_}, the -ASCII underscore character, as an overstrike could cause a character to be -underlined. New programs need not bother to handle these capabilities -unless the author cares strongly about the obscure terminals which support -them. However, terminal descriptions should provide these capabilities -when appropriate. - -@table @samp -@item uc -@kindex uc -String of commands to underline the character under the cursor, and -move the cursor right. - -@item ul -@kindex ul -Flag whose presence means that the terminal can underline by -overstriking an underscore character (@samp{_}); some terminals can do -this even though they do not support overstriking in general. An -implication of this flag is that when outputting new text to overwrite -old text, underscore characters must be treated specially lest they -underline the old text instead. -@end table - -@node Cursor Visibility, Bell, Underlining, Capabilities -@section Cursor Visibility -@cindex visibility - -Some terminals have the ability to make the cursor invisible, or to enhance -it. Enhancing the cursor is often done by programs that plan to use the -cursor to indicate to the user a position of interest that may be anywhere -on the screen---for example, the Emacs editor enhances the cursor on entry. -Such programs should always restore the cursor to normal on exit. - -@table @samp -@item vs -@kindex vs -String of commands to enhance the cursor. - -@item vi -@kindex vi -String of commands to make the cursor invisible. - -@item ve -@kindex ve -String of commands to return the cursor to normal. -@end table - -If you define either @samp{vs} or @samp{vi}, you must also define @samp{ve}. - -@node Bell, Keypad, Cursor Visibility, Capabilities -@section Bell -@cindex bell -@cindex visible bell - -Here we describe commands to make the terminal ask for the user to pay -attention to it. - -@table @samp -@item bl -@kindex bl -String of commands to cause the terminal to make an audible sound. If -this capability is absent, the terminal has no way to make a suitable -sound. - -@item vb -@kindex vb -String of commands to cause the screen to flash to attract attention -(``visible bell''). If this capability is absent, the terminal has no -way to do such a thing. -@end table - -@node Keypad, Meta Key, Bell, Capabilities -@section Keypad and Function Keys - -Many terminals have arrow and function keys that transmit specific -character sequences to the computer. Since the precise sequences used -depend on the terminal, termcap defines capabilities used to say what the -sequences are. Unlike most termcap string-valued capabilities, these are -not strings of commands to be sent to the terminal, rather strings that -are received from the terminal. - -Programs that expect to use keypad keys should check, initially, for a -@samp{ks} capability and send it, to make the keypad actually transmit. -Such programs should also send the @samp{ke} string when exiting. - -@table @asis -@item @samp{ks} -@kindex ka@dots{}ku -String of commands to make the function keys transmit. If this -capability is not provided, but the others in this section are, -programs may assume that the function keys always transmit. - -@item @samp{ke} -String of commands to make the function keys work locally. This -capability is provided only if @samp{ks} is. - -@item @samp{kl} -String of input characters sent by typing the left-arrow key. If this -capability is missing, you cannot expect the terminal to have a -left-arrow key that transmits anything to the computer. - -@item @samp{kr} -String of input characters sent by typing the right-arrow key. - -@item @samp{ku} -String of input characters sent by typing the up-arrow key. - -@item @samp{kd} -String of input characters sent by typing the down-arrow key. - -@item @samp{kh} -String of input characters sent by typing the ``home-position'' key. - -@item @samp{K1} @dots{} @samp{K5} -@kindex K1@dots{}K5 -Strings of input characters sent by the five other keys in a 3-by-3 -array that includes the arrow keys, if the keyboard has such a 3-by-3 -array. Note that one of these keys may be the ``home-position'' key, -in which case one of these capabilities will have the same value as -the @samp{kh} key. - -@item @samp{k0} -String of input characters sent by function key 10 (or 0, if the terminal -has one labeled 0). - -@item @samp{k1} @dots{} @samp{k9} -@kindex k1@dots{}k9 -Strings of input characters sent by function keys 1 through 9, -provided for those function keys that exist. - -@item @samp{kn} -Number: the number of numbered function keys, if there are more than -10. - -@item @samp{l0} @dots{} @samp{l9} -@kindex l0@dots{}l9 -Strings which are the labels appearing on the keyboard on the keys -described by the capabilities @samp{k0} @dots{} @samp{l9}. These -capabilities should be left undefined if the labels are @samp{f0} or -@samp{f10} and @samp{f1} @dots{} @samp{f9}.@refill - -@item @samp{kH} -@kindex kA@dots{}kT -String of input characters sent by the ``home down'' key, if there is -one. - -@item @samp{kb} -String of input characters sent by the ``backspace'' key, if there is -one. - -@item @samp{ka} -String of input characters sent by the ``clear all tabs'' key, if there -is one. - -@item @samp{kt} -String of input characters sent by the ``clear tab stop this column'' -key, if there is one. - -@item @samp{kC} -String of input characters sent by the ``clear screen'' key, if there is -one. - -@item @samp{kD} -String of input characters sent by the ``delete character'' key, if -there is one. - -@item @samp{kL} -String of input characters sent by the ``delete line'' key, if there is -one. - -@item @samp{kM} -String of input characters sent by the ``exit insert mode'' key, if -there is one. - -@item @samp{kE} -String of input characters sent by the ``clear to end of line'' key, if -there is one. - -@item @samp{kS} -String of input characters sent by the ``clear to end of screen'' key, -if there is one. - -@item @samp{kI} -String of input characters sent by the ``insert character'' or ``enter -insert mode'' key, if there is one. - -@item @samp{kA} -String of input characters sent by the ``insert line'' key, if there is -one. - -@item @samp{kN} -String of input characters sent by the ``next page'' key, if there is -one. - -@item @samp{kP} -String of input characters sent by the ``previous page'' key, if there is -one. - -@item @samp{kF} -String of input characters sent by the ``scroll forward'' key, if there -is one. - -@item @samp{kR} -String of input characters sent by the ``scroll reverse'' key, if there -is one. - -@item @samp{kT} -String of input characters sent by the ``set tab stop in this column'' -key, if there is one. - -@item @samp{ko} -String listing the other function keys the terminal has. This is a -very obsolete way of describing the same information found in the -@samp{kH} @dots{} @samp{kT} keys. The string contains a list of -two-character termcap capability names, separated by commas. The -meaning is that for each capability name listed, the terminal has a -key which sends the string which is the value of that capability. For -example, the value @samp{:ko=cl,ll,sf,sr:} says that the terminal has -four function keys which mean ``clear screen'', ``home down'', -``scroll forward'' and ``scroll reverse''.@refill -@end table - -@node Meta Key, Initialization, Keypad, Capabilities -@section Meta Key - -@cindex meta key -A Meta key is a key on the keyboard that modifies each character you type -by controlling the 0200 bit. This bit is on if and only if the Meta key is -held down when the character is typed. Characters typed using the Meta key -are called Meta characters. Emacs uses Meta characters as editing -commands. - -@table @samp -@item km -@kindex km -Flag whose presence means that the terminal has a Meta key. - -@item mm -@kindex mm -String of commands to enable the functioning of the Meta key. - -@item mo -@kindex mo -String of commands to disable the functioning of the Meta key. -@end table - -If the terminal has @samp{km} but does not have @samp{mm} and @samp{mo}, it -means that the Meta key always functions. If it has @samp{mm} and -@samp{mo}, it means that the Meta key can be turned on or off. Send the -@samp{mm} string to turn it on, and the @samp{mo} string to turn it off. -I do not know why one would ever not want it to be on. - -@node Initialization, Pad Specs, Meta Key, Capabilities -@section Initialization -@cindex reset -@cindex initialization -@cindex tab stops - -@table @samp -@item ti -@kindex ti -String of commands to put the terminal into whatever special modes are -needed or appropriate for programs that move the cursor -nonsequentially around the screen. Programs that use termcap to do -full-screen display should output this string when they start up. - -@item te -@kindex te -String of commands to undo what is done by the @samp{ti} string. -Programs that output the @samp{ti} string on entry should output this -string when they exit. - -@item is -@kindex is -String of commands to initialize the terminal for each login session. - -@item if -@kindex if -String which is the name of a file containing the string of commands -to initialize the terminal for each session of use. Normally @samp{is} -and @samp{if} are not both used. - -@item i1 -@itemx i3 -@kindex i1 -@kindex i3 -Two more strings of commands to initialize the terminal for each login -session. The @samp{i1} string (if defined) is output before @samp{is} -or @samp{if}, and the @samp{i3} string (if defined) is output after. - -The reason for having three separate initialization strings is to make -it easier to define a group of related terminal types with slightly -different initializations. Define two or three of the strings in the -basic type; then the other types can override one or two of the -strings. - -@item rs -@kindex rs -String of commands to reset the terminal from any strange mode it may -be in. Normally this includes the @samp{is} string (or other commands -with the same effects) and more. What would go in the @samp{rs} -string but not in the @samp{is} string are annoying or slow commands -to bring the terminal back from strange modes that nobody would -normally use. - -@item it -@kindex it -Numeric value, the initial spacing between hardware tab stop columns -when the terminal is powered up. Programs to initialize the terminal -can use this to decide whether there is a need to set the tab stops. -If the initial width is 8, well and good; if it is not 8, then the -tab stops should be set; if they cannot be set, the kernel is told -to convert tabs to spaces, and other programs will observe this and do -likewise. - -@item ct -@kindex ct -String of commands to clear all tab stops. - -@item st -@kindex st -String of commands to set tab stop at current cursor column on all -lines. -@end table - -@node Pad Specs, Status Line, Initialization, Capabilities -@section Padding Capabilities -@cindex padding - -There are two terminal capabilities that exist just to explain the proper -way to obey the padding specifications in all the command string -capabilities. One, @samp{pc}, must be obeyed by all termcap-using -programs. - -@table @samp -@item pb -@kindex pb -Numeric value, the lowest baud rate at which padding is actually -needed. Programs may check this and refrain from doing any padding at -lower speeds. - -@item pc -@kindex pc -String of commands for padding. The first character of this string is -to be used as the pad character, instead of using null characters for -padding. If @samp{pc} is not provided, use null characters. Every -program that uses termcap must look up this capability and use it to -set the variable @code{PC} that is used by @code{tputs}. -@xref{Padding}. -@end table - -Some termcap capabilities exist just to specify the amount of padding that -the kernel should give to cursor motion commands used in ordinary -sequential output. - -@table @samp -@item dC -@kindex dC -Numeric value, the number of msec of padding needed for the -carriage-return character. - -@item dN -@kindex dN -Numeric value, the number of msec of padding needed for the newline -(linefeed) character. - -@item dB -@kindex dB -Numeric value, the number of msec of padding needed for the backspace -character. - -@item dF -@kindex dF -Numeric value, the number of msec of padding needed for the formfeed -character. - -@item dT -@kindex dT -Numeric value, the number of msec of padding needed for the tab -character. -@end table - -In some systems, the kernel uses the above capabilities; in other systems, -the kernel uses the paddings specified in the string capabilities -@samp{cr}, @samp{sf}, @samp{le}, @samp{ff} and @samp{ta}. Descriptions of -terminals which require such padding should contain the @samp{dC} @dots{} -@samp{dT} capabilities and also specify the appropriate padding in the -corresponding string capabilities. Since no modern terminals require -padding for ordinary sequential output, you probably won't need to do -either of these things. - -@node Status Line, Half-Line, Pad Specs, Capabilities -@section Status Line - -@cindex status line -A @dfn{status line} is a line on the terminal that is not used for ordinary -display output but instead used for a special message. The intended use is -for a continuously updated description of what the user's program is doing, -and that is where the name ``status line'' comes from, but in fact it could -be used for anything. The distinguishing characteristic of a status line -is that ordinary output to the terminal does not affect it; it changes only -if the special status line commands of this section are used. - -@table @samp -@item hs -@kindex hs -Flag whose presence means that the terminal has a status line. If a -terminal description specifies that there is a status line, it must -provide the @samp{ts} and @samp{fs} capabilities. - -@item ts -@kindex ts -String of commands to move the terminal cursor into the status line. -Usually these commands must specifically record the old cursor -position for the sake of the @samp{fs} string. - -@item fs -@kindex fs -String of commands to move the cursor back from the status line to its -previous position (outside the status line). - -@item es -@kindex es -Flag whose presence means that other display commands work while -writing the status line. In other words, one can clear parts of it, -insert or delete characters, move the cursor within it using @samp{ch} -if there is a @samp{ch} capability, enter and leave standout mode, and -so on. - -@item ds -@kindex ds -String of commands to disable the display of the status line. This -may be absent, if there is no way to disable the status line display. - -@item ws -@kindex ws -Numeric value, the width of the status line. If this capability is -absent in a terminal that has a status line, it means the status line -is the same width as the other lines. - -Note that the value of @samp{ws} is sometimes as small as 8. -@end table - -@node Half-Line, Printer, Status Line, Capabilities -@section Half-Line Motion - -Some terminals have commands for moving the cursor vertically by half-lines, -useful for outputting subscripts and superscripts. Mostly it is hardcopy -terminals that have such features. - -@table @samp -@item hu -@kindex hu -String of commands to move the cursor up half a line. If the terminal -is a display, it is your responsibility to avoid moving up past the -top line; however, most likely the terminal that supports this is a -hardcopy terminal and there is nothing to be concerned about. - -@item hd -@kindex hd -String of commands to move the cursor down half a line. If the -terminal is a display, it is your responsibility to avoid moving down -past the bottom line, etc. -@end table - -@node Printer,, Half-Line, Capabilities -@section Controlling Printers Attached to Terminals -@cindex printer - -Some terminals have attached hardcopy printer ports. They may be able to -copy the screen contents to the printer; they may also be able to redirect -output to the printer. Termcap does not have anything to tell the program -whether the redirected output appears also on the screen; it does on some -terminals but not all. - -@table @samp -@item ps -@kindex ps -String of commands to cause the contents of the screen to be printed. -If it is absent, the screen contents cannot be printed. - -@item po -@kindex po -String of commands to redirect further output to the printer. - -@item pf -@kindex pf -String of commands to terminate redirection of output to the printer. -This capability must be present in the description if @samp{po} is. - -@item pO -@kindex pO -String of commands to redirect output to the printer for next @var{n} -characters of output, regardless of what they are. Redirection will -end automatically after @var{n} characters of further output. Until -then, nothing that is output can end redirection, not even the -@samp{pf} string if there is one. The number @var{n} should not be -more than 255. - -One use of this capability is to send non-text byte sequences (such as -bit-maps) to the printer. -@end table - -Most terminals with printers do not support all of @samp{ps}, @samp{po} and -@samp{pO}; any one or two of them may be supported. To make a program that -can send output to all kinds of printers, it is necessary to check for all -three of these capabilities, choose the most convenient of the ones that -are provided, and use it in its own appropriate fashion. - -@node Summary, Var Index, Capabilities, Top -@chapter Summary of Capability Names - -Here are all the terminal capability names in alphabetical order -with a brief description of each. For cross references to their definitions, -see the index of capability names (@pxref{Cap Index}). - -@table @samp -@item ae -String to turn off alternate character set mode. -@item al -String to insert a blank line before the cursor. -@item AL -String to insert @var{n} blank lines before the cursor. -@item am -Flag: output to last column wraps cursor to next line. -@item as -String to turn on alternate character set mode.like. -@item bc -Very obsolete alternative name for the @samp{le} capability. -@item bl -String to sound the bell. -@item bs -Obsolete flag: ASCII backspace may be used for leftward motion. -@item bt -String to move the cursor left to the previous hardware tab stop column. -@item bw -Flag: @samp{le} at left margin wraps to end of previous line. -@item CC -String to change terminal's command character. -@item cd -String to clear the line the cursor is on, and following lines. -@item ce -String to clear from the cursor to the end of the line. -@item ch -String to position the cursor at column @var{c} in the same line. -@item cl -String to clear the entire screen and put cursor at upper left corner. -@item cm -String to position the cursor at line @var{l}, column @var{c}. -@item CM -String to position the cursor at line @var{l}, column -@var{c}, relative to display memory. -@item co -Number: width of the screen. -@item cr -String to move cursor sideways to left margin. -@item cs -String to set the scroll region. -@item cS -Alternate form of string to set the scroll region. -@item ct -String to clear all tab stops. -@item cv -String to position the cursor at line @var{l} in the same column. -@item da -Flag: data scrolled off top of screen may be scrolled back. -@item db -Flag: data scrolled off bottom of screen may be scrolled back. -@item dB -Obsolete number: msec of padding needed for the backspace character. -@item dc -String to delete one character position at the cursor. -@item dC -Obsolete number: msec of padding needed for the carriage-return character. -@item DC -String to delete @var{n} characters starting at the cursor. -@item dF -Obsolete number: msec of padding needed for the formfeed character. -@item dl -String to delete the line the cursor is on. -@item DL -String to delete @var{n} lines starting with the cursor's line. -@item dm -String to enter delete mode. -@item dN -Obsolete number: msec of padding needed for the newline character. -@item do -String to move the cursor vertically down one line. -@item DO -String to move cursor vertically down @var{n} lines. -@item ds -String to disable the display of the status line. -@item dT -Obsolete number: msec of padding needed for the tab character. -@item ec -String of commands to clear @var{n} characters at cursor. -@item ed -String to exit delete mode. -@item ei -String to leave insert mode. -@item eo -Flag: output of a space can erase an overstrike. -@item es -Flag: other display commands work while writing the status line. -@item ff -String to advance to the next page, for a hardcopy terminal. -@item fs -String to move the cursor back from the status line to its -previous position (outside the status line). -@item gn -Flag: this terminal type is generic, not real. -@item hc -Flag: hardcopy terminal. -@item hd -String to move the cursor down half a line. -@item ho -String to position cursor at upper left corner. -@item hs -Flag: the terminal has a status line. -@item hu -String to move the cursor up half a line. -@item hz -Flag: terminal cannot accept @samp{~} as output. -@item i1 -String to initialize the terminal for each login session. -@item i3 -String to initialize the terminal for each login session. -@item ic -String to insert one character position at the cursor. -@item IC -String to insert @var{n} character positions at the cursor. -@item if -String naming a file of commands to initialize the terminal. -@item im -String to enter insert mode. -@item in -Flag: outputting a space is different from moving over empty positions. -@item ip -String to output following an inserted character in insert mode. -@item is -String to initialize the terminal for each login session. -@item it -Number: initial spacing between hardware tab stop columns. -@item k0 -String of input sent by function key 0 or 10. -@item k1 @dots{} k9 -Strings of input sent by function keys 1 through 9. -@item K1 @dots{} K5 -Strings sent by the five other keys in 3-by-3 array with arrows. -@item ka -String of input sent by the ``clear all tabs'' key. -@item kA -String of input sent by the ``insert line'' key. -@item kb -String of input sent by the ``backspace'' key. -@item kC -String of input sent by the ``clear screen'' key. -@item kd -String of input sent by typing the down-arrow key. -@item kD -String of input sent by the ``delete character'' key. -@item ke -String to make the function keys work locally. -@item kE -String of input sent by the ``clear to end of line'' key. -@item kF -String of input sent by the ``scroll forward'' key. -@item kh -String of input sent by typing the ``home-position'' key. -@item kH -String of input sent by the ``home down'' key. -@item kI -String of input sent by the ``insert character'' or ``enter -insert mode'' key. -@item kl -String of input sent by typing the left-arrow key. -@item kL -String of input sent by the ``delete line'' key. -@item km -Flag: the terminal has a Meta key. -@item kM -String of input sent by the ``exit insert mode'' key. -@item kn -Numeric value, the number of numbered function keys. -@item kN -String of input sent by the ``next page'' key. -@item ko -Very obsolete string listing the terminal's named function keys. -@item kP -String of input sent by the ``previous page'' key. -@item kr -String of input sent by typing the right-arrow key. -@item kR -String of input sent by the ``scroll reverse'' key. -@item ks -String to make the function keys transmit. -@item kS -String of input sent by the ``clear to end of screen'' key. -@item kt -String of input sent by the ``clear tab stop this column'' key. -@item kT -String of input sent by the ``set tab stop in this column'' key. -@item ku -String of input sent by typing the up-arrow key. -@item l0 -String on keyboard labelling function key 0 or 10. -@item l1 @dots{} l9 -Strings on keyboard labelling function keys 1 through 9. -@item le -String to move the cursor left one column. -@item LE -String to move cursor left @var{n} columns. -@item li -Number: height of the screen. -@item ll -String to position cursor at lower left corner. -@item lm -Number: lines of display memory. -@item mb -String to enter blinking mode. -@item md -String to enter double-bright mode. -@item me -String to turn off all appearance modes -@item mh -String to enter half-bright mode. -@item mi -Flag: cursor motion in insert mode is safe. -@item mk -String to enter invisible mode. -@item mm -String to enable the functioning of the Meta key. -@item mo -String to disable the functioning of the Meta key. -@item mp -String to enter protected mode. -@item mr -String to enter reverse-video mode. -@item ms -Flag: cursor motion in standout mode is safe. -@item nc -Obsolete flag: do not use ASCII carriage-return on this terminal. -@item nd -String to move the cursor right one column. -@item nl -Obsolete alternative name for the @samp{do} and @samp{sf} capabilities. -@item ns -Flag: the terminal does not normally scroll for sequential output. -@item nw -String to move to start of next line, possibly clearing rest of old line. -@item os -Flag: terminal can overstrike. -@item pb -Number: the lowest baud rate at which padding is actually needed. -@item pc -String containing character for padding. -@item pf -String to terminate redirection of output to the printer. -@item po -String to redirect further output to the printer. -@item pO -String to redirect @var{n} characters ofoutput to the printer. -@item ps -String to print the screen on the attached printer. -@item rc -String to move to last saved cursor position. -@item RI -String to move cursor right @var{n} columns. -@item rp -String to output character @var{c} repeated @var{n} times. -@item rs -String to reset the terminal from any strange modes. -@item sa -String to turn on an arbitrary combination of appearance modes. -@item sc -String to save the current cursor position. -@item se -String to leave standout mode. -@item sf -String to scroll the screen one line up. -@item SF -String to scroll the screen @var{n} lines up. -@item sg -Number: width of magic standout cookie. Absent if magic cookies are -not used. -@item so -String to enter standout mode. -@item sr -String to scroll the screen one line down. -@item SR -String to scroll the screen @var{n} line down. -@item st -String to set tab stop at current cursor column on all lines. -programs. -@item ta -String to move the cursor right to the next hardware tab stop column. -@item te -String to return terminal to settings for sequential output. -@item ti -String to initialize terminal for random cursor motion. -@item ts -String to move the terminal cursor into the status line. -@item uc -String to underline one character and move cursor right. -@item ue -String to turn off underline mode -@item ug -Number: width of underlining magic cookie. Absent if underlining -doesn't use magic cookies. -@item ul -Flag: underline by overstriking with an underscore. -@item up -String to move the cursor vertically up one line. -@item UP -String to move cursor vertically up @var{n} lines. -@item us -String to turn on underline mode -@item vb -String to make the screen flash. -@item ve -String to return the cursor to normal. -@item vi -String to make the cursor invisible. -@item vs -String to enhance the cursor. -@item wi -String to set the terminal output screen window. -@item ws -Number: the width of the status line. -@item xb -Flag: superbee terminal. -@item xn -Flag: cursor wraps in a strange way. -@item xs -Flag: clearing a line is the only way to clear the appearance modes of -positions in that line (or, only way to remove magic cookies on that -line). -@item xt -Flag: Teleray 1061; several strange characteristics. -@end table - -@node Var Index, Cap Index, Summary, Top -@unnumbered Variable and Function Index - -@printindex fn - -@node Cap Index, Index, Var Index, Top -@unnumbered Capability Index - -@printindex ky - -@node Index,, Cap Index, Top -@unnumbered Concept Index - -@printindex cp - -@contents -@bye diff --git a/man/texinfo.tex b/man/texinfo.tex deleted file mode 100644 index 3ce4715..0000000 --- a/man/texinfo.tex +++ /dev/null @@ -1,4977 +0,0 @@ -% texinfo.tex -- TeX macros to handle Texinfo files. -% $Id: texinfo.tex,v 2.227 1998/02/25 22:54:34 karl Exp $ -% -% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 94, 95, 96, 97, 98 -% Free Software Foundation, Inc. -% -% This texinfo.tex 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 texinfo.tex 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 this texinfo.tex file; see the file COPYING. If not, write -% to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -% Boston, MA 02111-1307, USA. -% -% In other words, you are welcome to use, share and improve this program. -% You are forbidden to forbid anyone else to use, share and improve -% what you give them. Help stamp out software-hoarding! -% -% Please try the latest version of texinfo.tex before submitting bug -% reports; you can get the latest version from: -% ftp://ftp.cs.umb.edu/pub/tex/texinfo.tex -% /home/gd/gnu/doc/texinfo.tex on the GNU machines. -% -% Send bug reports to bug-texinfo@gnu.org. -% Please include a precise test case in each bug report, -% including a complete document with which we can reproduce the problem. -% -% Texinfo macros (with @macro) are *not* supported by texinfo.tex. You -% have to run makeinfo -E to expand macros first; the texi2dvi script -% does this. - - -% Make it possible to create a .fmt file just by loading this file: -% if the underlying format is not loaded, start by loading it now. -% Added by gildea November 1993. -\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi - -% This automatically updates the version number based on RCS. -\def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} -\deftexinfoversion$Revision: 2.227 $ -\message{Loading texinfo package [Version \texinfoversion]:} - -% If in a .fmt file, print the version number -% and turn on active characters that we couldn't do earlier because -% they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}\message{} - \catcode`+=\active \catcode`\_=\active} - -% Save some parts of plain tex whose names we will redefine. - -\let\ptexb=\b -\let\ptexbullet=\bullet -\let\ptexc=\c -\let\ptexcomma=\, -\let\ptexdot=\. -\let\ptexdots=\dots -\let\ptexend=\end -\let\ptexequiv=\equiv -\let\ptexexclam=\! -\let\ptexi=\i -\let\ptexlbrace=\{ -\let\ptexrbrace=\} -\let\ptexstar=\* -\let\ptext=\t - -% Be sure we're in horizontal mode when doing a tie, since we make space -% equivalent to this in @example-like environments. Otherwise, a space -% at the beginning of a line will start with \penalty -- and -% since \penalty is valid in vertical mode, we'd end up putting the -% penalty on the vertical list instead of in the new paragraph. -{\catcode`@ = 11 - % Avoid using \@M directly, because that causes trouble - % if the definition is written into an index file. - \global\let\tiepenalty = \@M - \gdef\tie{\leavevmode\penalty\tiepenalty\ } -} - - -\message{Basics,} -\chardef\other=12 - -% If this character appears in an error message or help string, it -% starts a new line in the output. -\newlinechar = `^^J - -% Set up fixed words for English. -\ifx\putwordChapter\undefined{\gdef\putwordChapter{Chapter}}\fi% -\def\putwordInfo{Info}% -\ifx\putwordSee\undefined{\gdef\putwordSee{See}}\fi% -\ifx\putwordsee\undefined{\gdef\putwordsee{see}}\fi% -\ifx\putwordfile\undefined{\gdef\putwordfile{file}}\fi% -\ifx\putwordpage\undefined{\gdef\putwordpage{page}}\fi% -\ifx\putwordsection\undefined{\gdef\putwordsection{section}}\fi% -\ifx\putwordSection\undefined{\gdef\putwordSection{Section}}\fi% -\ifx\putwordTableofContents\undefined{\gdef\putwordTableofContents{Table of Contents}}\fi% -\ifx\putwordShortContents\undefined{\gdef\putwordShortContents{Short Contents}}\fi% -\ifx\putwordAppendix\undefined{\gdef\putwordAppendix{Appendix}}\fi% - -% Ignore a token. -% -\def\gobble#1{} - -\hyphenation{ap-pen-dix} -\hyphenation{mini-buf-fer mini-buf-fers} -\hyphenation{eshell} -\hyphenation{white-space} - -% Margin to add to right of even pages, to left of odd pages. -\newdimen \bindingoffset -\newdimen \normaloffset -\newdimen\pagewidth \newdimen\pageheight - -% Sometimes it is convenient to have everything in the transcript file -% and nothing on the terminal. We don't just call \tracingall here, -% since that produces some useless output on the terminal. -% -\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}% -\def\loggingall{\tracingcommands2 \tracingstats2 - \tracingpages1 \tracingoutput1 \tracinglostchars1 - \tracingmacros2 \tracingparagraphs1 \tracingrestores1 - \showboxbreadth\maxdimen\showboxdepth\maxdimen -}% - -% For @cropmarks command. -% Do @cropmarks to get crop marks. -% -\newif\ifcropmarks -\let\cropmarks = \cropmarkstrue -% -% Dimensions to add cropmarks at corners. -% Added by P. A. MacKay, 12 Nov. 1986 -% -\newdimen\cornerlong \newdimen\cornerthick -\newdimen\topandbottommargin -\newdimen\outerhsize \newdimen\outervsize -\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks -\outerhsize=7in -%\outervsize=9.5in -% Alternative @smallbook page size is 9.25in -\outervsize=9.25in -\topandbottommargin=.75in - -% Main output routine. -\chardef\PAGE = 255 -\output = {\onepageout{\pagecontents\PAGE}} - -\newbox\headlinebox -\newbox\footlinebox - -% \onepageout takes a vbox as an argument. Note that \pagecontents -% does insertions, but you have to call it yourself. -\def\onepageout#1{% - \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi - % - \ifodd\pageno \advance\hoffset by \bindingoffset - \else \advance\hoffset by -\bindingoffset\fi - % - % Do this outside of the \shipout so @code etc. will be expanded in - % the headline as they should be, not taken literally (outputting ''code). - \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}% - \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}% - % - {% - % Have to do this stuff outside the \shipout because we want it to - % take effect in \write's, yet the group defined by the \vbox ends - % before the \shipout runs. - % - \escapechar = `\\ % use backslash in output files. - \indexdummies % don't expand commands in the output. - \normalturnoffactive % \ in index entries must not stay \, e.g., if - % the page break happens to be in the middle of an example. - \shipout\vbox{% - \ifcropmarks \vbox to \outervsize\bgroup - \hsize = \outerhsize - \line{\ewtop\hfil\ewtop}% - \nointerlineskip - \line{% - \vbox{\moveleft\cornerthick\nstop}% - \hfill - \vbox{\moveright\cornerthick\nstop}% - }% - \vskip\topandbottommargin - \line\bgroup - \hfil % center the page within the outer (page) hsize. - \ifodd\pageno\hskip\bindingoffset\fi - \vbox\bgroup - \fi - % - \unvbox\headlinebox - \pagebody{#1}% - \ifdim\ht\footlinebox > 0pt - % Only leave this space if the footline is nonempty. - % (We lessened \vsize for it in \oddfootingxxx.) - % The \baselineskip=24pt in plain's \makefootline has no effect. - \vskip 2\baselineskip - \unvbox\footlinebox - \fi - % - \ifcropmarks - \egroup % end of \vbox\bgroup - \hfil\egroup % end of (centering) \line\bgroup - \vskip\topandbottommargin plus1fill minus1fill - \boxmaxdepth = \cornerthick - \line{% - \vbox{\moveleft\cornerthick\nsbot}% - \hfill - \vbox{\moveright\cornerthick\nsbot}% - }% - \nointerlineskip - \line{\ewbot\hfil\ewbot}% - \egroup % \vbox from first cropmarks clause - \fi - }% end of \shipout\vbox - }% end of group with \turnoffactive - \advancepageno - \ifnum\outputpenalty>-20000 \else\dosupereject\fi -} - -\newinsert\margin \dimen\margin=\maxdimen - -\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}} -{\catcode`\@ =11 -\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi -% marginal hacks, juha@viisa.uucp (Juha Takala) -\ifvoid\margin\else % marginal info is present - \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi -\dimen@=\dp#1 \unvbox#1 -\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi -\ifr@ggedbottom \kern-\dimen@ \vfil \fi} -} - -% Here are the rules for the cropmarks. Note that they are -% offset so that the space between them is truly \outerhsize or \outervsize -% (P. A. MacKay, 12 November, 1986) -% -\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong} -\def\nstop{\vbox - {\hrule height\cornerthick depth\cornerlong width\cornerthick}} -\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong} -\def\nsbot{\vbox - {\hrule height\cornerlong depth\cornerthick width\cornerthick}} - -% Parse an argument, then pass it to #1. The argument is the rest of -% the input line (except we remove a trailing comment). #1 should be a -% macro which expects an ordinary undelimited TeX argument. -% -\def\parsearg#1{% - \let\next = #1% - \begingroup - \obeylines - \futurelet\temp\parseargx -} - -% If the next token is an obeyed space (from an @example environment or -% the like), remove it and recurse. Otherwise, we're done. -\def\parseargx{% - % \obeyedspace is defined far below, after the definition of \sepspaces. - \ifx\obeyedspace\temp - \expandafter\parseargdiscardspace - \else - \expandafter\parseargline - \fi -} - -% Remove a single space (as the delimiter token to the macro call). -{\obeyspaces % - \gdef\parseargdiscardspace {\futurelet\temp\parseargx}} - -{\obeylines % - \gdef\parseargline#1^^M{% - \endgroup % End of the group started in \parsearg. - % - % First remove any @c comment, then any @comment. - % Result of each macro is put in \toks0. - \argremovec #1\c\relax % - \expandafter\argremovecomment \the\toks0 \comment\relax % - % - % Call the caller's macro, saved as \next in \parsearg. - \expandafter\next\expandafter{\the\toks0}% - }% -} - -% Since all \c{,omment} does is throw away the argument, we can let TeX -% do that for us. The \relax here is matched by the \relax in the call -% in \parseargline; it could be more or less anything, its purpose is -% just to delimit the argument to the \c. -\def\argremovec#1\c#2\relax{\toks0 = {#1}} -\def\argremovecomment#1\comment#2\relax{\toks0 = {#1}} - -% \argremovec{,omment} might leave us with trailing spaces, though; e.g., -% @end itemize @c foo -% will have two active spaces as part of the argument with the -% `itemize'. Here we remove all active spaces from #1, and assign the -% result to \toks0. -% -% This loses if there are any *other* active characters besides spaces -% in the argument -- _ ^ +, for example -- since they get expanded. -% Fortunately, Texinfo does not define any such commands. (If it ever -% does, the catcode of the characters in questionwill have to be changed -% here.) But this means we cannot call \removeactivespaces as part of -% \argremovec{,omment}, since @c uses \parsearg, and thus the argument -% that \parsearg gets might well have any character at all in it. -% -\def\removeactivespaces#1{% - \begingroup - \ignoreactivespaces - \edef\temp{#1}% - \global\toks0 = \expandafter{\temp}% - \endgroup -} - -% Change the active space to expand to nothing. -% -\begingroup - \obeyspaces - \gdef\ignoreactivespaces{\obeyspaces\let =\empty} -\endgroup - - -\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next} - -%% These are used to keep @begin/@end levels from running away -%% Call \inENV within environments (after a \begingroup) -\newif\ifENV \ENVfalse \def\inENV{\ifENV\relax\else\ENVtrue\fi} -\def\ENVcheck{% -\ifENV\errmessage{Still within an environment. Type Return to continue.} -\endgroup\fi} % This is not perfect, but it should reduce lossage - -% @begin foo is the same as @foo, for now. -\newhelp\EMsimple{Type to continue.} - -\outer\def\begin{\parsearg\beginxxx} - -\def\beginxxx #1{% -\expandafter\ifx\csname #1\endcsname\relax -{\errhelp=\EMsimple \errmessage{Undefined command @begin #1}}\else -\csname #1\endcsname\fi} - -% @end foo executes the definition of \Efoo. -% -\def\end{\parsearg\endxxx} -\def\endxxx #1{% - \removeactivespaces{#1}% - \edef\endthing{\the\toks0}% - % - \expandafter\ifx\csname E\endthing\endcsname\relax - \expandafter\ifx\csname \endthing\endcsname\relax - % There's no \foo, i.e., no ``environment'' foo. - \errhelp = \EMsimple - \errmessage{Undefined command `@end \endthing'}% - \else - \unmatchedenderror\endthing - \fi - \else - % Everything's ok; the right environment has been started. - \csname E\endthing\endcsname - \fi -} - -% There is an environment #1, but it hasn't been started. Give an error. -% -\def\unmatchedenderror#1{% - \errhelp = \EMsimple - \errmessage{This `@end #1' doesn't have a matching `@#1'}% -} - -% Define the control sequence \E#1 to give an unmatched @end error. -% -\def\defineunmatchedend#1{% - \expandafter\def\csname E#1\endcsname{\unmatchedenderror{#1}}% -} - - -% Single-spacing is done by various environments (specifically, in -% \nonfillstart and \quotations). -\newskip\singlespaceskip \singlespaceskip = 12.5pt -\def\singlespace{% - % Why was this kern here? It messes up equalizing space above and below - % environments. --karl, 6may93 - %{\advance \baselineskip by -\singlespaceskip - %\kern \baselineskip}% - \setleading \singlespaceskip -} - -%% Simple single-character @ commands - -% @@ prints an @ -% Kludge this until the fonts are right (grr). -\def\@{{\tt \char '100}} - -% This is turned off because it was never documented -% and you can use @w{...} around a quote to suppress ligatures. -%% Define @` and @' to be the same as ` and ' -%% but suppressing ligatures. -%\def\`{{`}} -%\def\'{{'}} - -% Used to generate quoted braces. -\def\mylbrace {{\tt \char '173}} -\def\myrbrace {{\tt \char '175}} -\let\{=\mylbrace -\let\}=\myrbrace -\begingroup - % Definitions to produce actual \{ & \} command in an index. - \catcode`\{ = 12 \catcode`\} = 12 - \catcode`\[ = 1 \catcode`\] = 2 - \catcode`\@ = 0 \catcode`\\ = 12 - @gdef@lbracecmd[\{]% - @gdef@rbracecmd[\}]% -@endgroup - -% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent -% Others are defined by plain TeX: @` @' @" @^ @~ @= @v @H. -\let\, = \c -\let\dotaccent = \. -\def\ringaccent#1{{\accent23 #1}} -\let\tieaccent = \t -\let\ubaraccent = \b -\let\udotaccent = \d - -% Other special characters: @questiondown @exclamdown -% Plain TeX defines: @AA @AE @O @OE @L (and lowercase versions) @ss. -\def\questiondown{?`} -\def\exclamdown{!`} - -% Dotless i and dotless j, used for accents. -\def\imacro{i} -\def\jmacro{j} -\def\dotless#1{% - \def\temp{#1}% - \ifx\temp\imacro \ptexi - \else\ifx\temp\jmacro \j - \else \errmessage{@dotless can be used only with i or j}% - \fi\fi -} - -% @: forces normal size whitespace following. -\def\:{\spacefactor=1000 } - -% @* forces a line break. -\def\*{\hfil\break\hbox{}\ignorespaces} - -% @. is an end-of-sentence period. -\def\.{.\spacefactor=3000 } - -% @! is an end-of-sentence bang. -\def\!{!\spacefactor=3000 } - -% @? is an end-of-sentence query. -\def\?{?\spacefactor=3000 } - -% @w prevents a word break. Without the \leavevmode, @w at the -% beginning of a paragraph, when TeX is still in vertical mode, would -% produce a whole line of output instead of starting the paragraph. -\def\w#1{\leavevmode\hbox{#1}} - -% @group ... @end group forces ... to be all on one page, by enclosing -% it in a TeX vbox. We use \vtop instead of \vbox to construct the box -% to keep its height that of a normal line. According to the rules for -% \topskip (p.114 of the TeXbook), the glue inserted is -% max (\topskip - \ht (first item), 0). If that height is large, -% therefore, no glue is inserted, and the space between the headline and -% the text is small, which looks bad. -% -\def\group{\begingroup - \ifnum\catcode13=\active \else - \errhelp = \groupinvalidhelp - \errmessage{@group invalid in context where filling is enabled}% - \fi - % - % The \vtop we start below produces a box with normal height and large - % depth; thus, TeX puts \baselineskip glue before it, and (when the - % next line of text is done) \lineskip glue after it. (See p.82 of - % the TeXbook.) Thus, space below is not quite equal to space - % above. But it's pretty close. - \def\Egroup{% - \egroup % End the \vtop. - \endgroup % End the \group. - }% - % - \vtop\bgroup - % We have to put a strut on the last line in case the @group is in - % the midst of an example, rather than completely enclosing it. - % Otherwise, the interline space between the last line of the group - % and the first line afterwards is too small. But we can't put the - % strut in \Egroup, since there it would be on a line by itself. - % Hence this just inserts a strut at the beginning of each line. - \everypar = {\strut}% - % - % Since we have a strut on every line, we don't need any of TeX's - % normal interline spacing. - \offinterlineskip - % - % OK, but now we have to do something about blank - % lines in the input in @example-like environments, which normally - % just turn into \lisppar, which will insert no space now that we've - % turned off the interline space. Simplest is to make them be an - % empty paragraph. - \ifx\par\lisppar - \edef\par{\leavevmode \par}% - % - % Reset ^^M's definition to new definition of \par. - \obeylines - \fi - % - % Do @comment since we are called inside an environment such as - % @example, where each end-of-line in the input causes an - % end-of-line in the output. We don't want the end-of-line after - % the `@group' to put extra space in the output. Since @group - % should appear on a line by itself (according to the Texinfo - % manual), we don't worry about eating any user text. - \comment -} -% -% TeX puts in an \escapechar (i.e., `@') at the beginning of the help -% message, so this ends up printing `@group can only ...'. -% -\newhelp\groupinvalidhelp{% -group can only be used in environments such as @example,^^J% -where each line of input produces a line of output.} - -% @need space-in-mils -% forces a page break if there is not space-in-mils remaining. - -\newdimen\mil \mil=0.001in - -\def\need{\parsearg\needx} - -% Old definition--didn't work. -%\def\needx #1{\par % -%% This method tries to make TeX break the page naturally -%% if the depth of the box does not fit. -%{\baselineskip=0pt% -%\vtop to #1\mil{\vfil}\kern -#1\mil\penalty 10000 -%\prevdepth=-1000pt -%}} - -\def\needx#1{% - % Go into vertical mode, so we don't make a big box in the middle of a - % paragraph. - \par - % - % Don't add any leading before our big empty box, but allow a page - % break, since the best break might be right here. - \allowbreak - \nointerlineskip - \vtop to #1\mil{\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. - \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak -} - -% @br forces paragraph break - -\let\br = \par - -% @dots{} output an ellipsis using the current font. -% We do .5em per period so that it has the same spacing in a typewriter -% font as three actual period characters. -% -\def\dots{\hbox to 1.5em{% - \hskip 0pt plus 0.25fil minus 0.25fil - .\hss.\hss.% - \hskip 0pt plus 0.5fil minus 0.5fil -}} - -% @enddots{} is an end-of-sentence ellipsis. -% -\def\enddots{% - \hbox to 2em{% - \hskip 0pt plus 0.25fil minus 0.25fil - .\hss.\hss.\hss.% - \hskip 0pt plus 0.5fil minus 0.5fil - }% - \spacefactor=3000 -} - - -% @page forces the start of a new page - -\def\page{\par\vfill\supereject} - -% @exdent text.... -% outputs text on separate line in roman font, starting at standard page margin - -% This records the amount of indent in the innermost environment. -% That's how much \exdent should take out. -\newskip\exdentamount - -% This defn is used inside fill environments such as @defun. -\def\exdent{\parsearg\exdentyyy} -\def\exdentyyy #1{{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}} - -% This defn is used inside nofill environments such as @example. -\def\nofillexdent{\parsearg\nofillexdentyyy} -\def\nofillexdentyyy #1{{\advance \leftskip by -\exdentamount -\leftline{\hskip\leftskip{\rm#1}}}} - -% @inmargin{TEXT} puts TEXT in the margin next to the current paragraph. - -\def\inmargin#1{% -\strut\vadjust{\nobreak\kern-\strutdepth - \vtop to \strutdepth{\baselineskip\strutdepth\vss - \llap{\rightskip=\inmarginspacing \vbox{\noindent #1}}\null}}} -\newskip\inmarginspacing \inmarginspacing=1cm -\def\strutdepth{\dp\strutbox} - -%\hbox{{\rm#1}}\hfil\break}} - -% @include file insert text of that file as input. -% Allow normal characters that we make active in the argument (a file name). -\def\include{\begingroup - \catcode`\\=12 - \catcode`~=12 - \catcode`^=12 - \catcode`_=12 - \catcode`|=12 - \catcode`<=12 - \catcode`>=12 - \catcode`+=12 - \parsearg\includezzz} -% Restore active chars for included file. -\def\includezzz#1{\endgroup\begingroup - % Read the included file in a group so nested @include's work. - \def\thisfile{#1}% - \input\thisfile -\endgroup} - -\def\thisfile{} - -% @center line outputs that line, centered - -\def\center{\parsearg\centerzzz} -\def\centerzzz #1{{\advance\hsize by -\leftskip -\advance\hsize by -\rightskip -\centerline{#1}}} - -% @sp n outputs n lines of vertical space - -\def\sp{\parsearg\spxxx} -\def\spxxx #1{\vskip #1\baselineskip} - -% @comment ...line which is ignored... -% @c is the same as @comment -% @ignore ... @end ignore is another way to write a comment - -\def\comment{\catcode 64=\other \catcode 123=\other \catcode 125=\other% -\parsearg \commentxxx} - -\def\commentxxx #1{\catcode 64=0 \catcode 123=1 \catcode 125=2 } - -\let\c=\comment - -% @paragraphindent is defined for the Info formatting commands only. -\let\paragraphindent=\comment - -% Prevent errors for section commands. -% Used in @ignore and in failing conditionals. -\def\ignoresections{% -\let\chapter=\relax -\let\unnumbered=\relax -\let\top=\relax -\let\unnumberedsec=\relax -\let\unnumberedsection=\relax -\let\unnumberedsubsec=\relax -\let\unnumberedsubsection=\relax -\let\unnumberedsubsubsec=\relax -\let\unnumberedsubsubsection=\relax -\let\section=\relax -\let\subsec=\relax -\let\subsubsec=\relax -\let\subsection=\relax -\let\subsubsection=\relax -\let\appendix=\relax -\let\appendixsec=\relax -\let\appendixsection=\relax -\let\appendixsubsec=\relax -\let\appendixsubsection=\relax -\let\appendixsubsubsec=\relax -\let\appendixsubsubsection=\relax -\let\contents=\relax -\let\smallbook=\relax -\let\titlepage=\relax -} - -% Used in nested conditionals, where we have to parse the Texinfo source -% and so want to turn off most commands, in case they are used -% incorrectly. -% -\def\ignoremorecommands{% - \let\defcodeindex = \relax - \let\defcv = \relax - \let\deffn = \relax - \let\deffnx = \relax - \let\defindex = \relax - \let\defivar = \relax - \let\defmac = \relax - \let\defmethod = \relax - \let\defop = \relax - \let\defopt = \relax - \let\defspec = \relax - \let\deftp = \relax - \let\deftypefn = \relax - \let\deftypefun = \relax - \let\deftypevar = \relax - \let\deftypevr = \relax - \let\defun = \relax - \let\defvar = \relax - \let\defvr = \relax - \let\ref = \relax - \let\xref = \relax - \let\printindex = \relax - \let\pxref = \relax - \let\settitle = \relax - \let\setchapternewpage = \relax - \let\setchapterstyle = \relax - \let\everyheading = \relax - \let\evenheading = \relax - \let\oddheading = \relax - \let\everyfooting = \relax - \let\evenfooting = \relax - \let\oddfooting = \relax - \let\headings = \relax - \let\include = \relax - \let\lowersections = \relax - \let\down = \relax - \let\raisesections = \relax - \let\up = \relax - \let\set = \relax - \let\clear = \relax - \let\item = \relax -} - -% Ignore @ignore ... @end ignore. -% -\def\ignore{\doignore{ignore}} - -% Ignore @ifinfo, @ifhtml, @ifnottex, @html, @menu, and @direntry text. -% -\def\ifinfo{\doignore{ifinfo}} -\def\ifhtml{\doignore{ifhtml}} -\def\ifnottex{\doignore{ifnottex}} -\def\html{\doignore{html}} -\def\menu{\doignore{menu}} -\def\direntry{\doignore{direntry}} - -% Also ignore @macro ... @end macro. The user must run texi2dvi, -% which runs makeinfo to do macro expansion. Ignore @unmacro, too. -\def\macro{\doignore{macro}} -\let\unmacro = \comment - - -% @dircategory CATEGORY -- specify a category of the dir file -% which this file should belong to. Ignore this in TeX. -\let\dircategory = \comment - -% Ignore text until a line `@end #1'. -% -\def\doignore#1{\begingroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define a command to swallow text until we reach `@end #1'. - \long\def\doignoretext##1\end #1{\enddoignore}% - % - % Make sure that spaces turn into tokens that match what \doignoretext wants. - \catcode32 = 10 - % - % Ignore braces, too, so mismatched braces don't cause trouble. - \catcode`\{ = 9 - \catcode`\} = 9 - % - % And now expand that command. - \doignoretext -} - -% What we do to finish off ignored text. -% -\def\enddoignore{\endgroup\ignorespaces}% - -\newif\ifwarnedobs\warnedobsfalse -\def\obstexwarn{% - \ifwarnedobs\relax\else - % We need to warn folks that they may have trouble with TeX 3.0. - % This uses \immediate\write16 rather than \message to get newlines. - \immediate\write16{} - \immediate\write16{***WARNING*** for users of Unix TeX 3.0!} - \immediate\write16{This manual trips a bug in TeX version 3.0 (tex hangs).} - \immediate\write16{If you are running another version of TeX, relax.} - \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.} - \immediate\write16{ Then upgrade your TeX installation if you can.} - \immediate\write16{ (See ftp://ftp.gnu.ai.mit.edu/pub/gnu/TeX.README.)} - \immediate\write16{If you are stuck with version 3.0, run the} - \immediate\write16{ script ``tex3patch'' from the Texinfo distribution} - \immediate\write16{ to use a workaround.} - \immediate\write16{} - \global\warnedobstrue - \fi -} - -% **In TeX 3.0, setting text in \nullfont hangs tex. For a -% workaround (which requires the file ``dummy.tfm'' to be installed), -% uncomment the following line: -%%%%%\font\nullfont=dummy\let\obstexwarn=\relax - -% Ignore text, except that we keep track of conditional commands for -% purposes of nesting, up to an `@end #1' command. -% -\def\nestedignore#1{% - \obstexwarn - % We must actually expand the ignored text to look for the @end - % command, so that nested ignore constructs work. Thus, we put the - % text into a \vbox and then do nothing with the result. To minimize - % the change of memory overflow, we follow the approach outlined on - % page 401 of the TeXbook: make the current font be a dummy font. - % - \setbox0 = \vbox\bgroup - % Don't complain about control sequences we have declared \outer. - \ignoresections - % - % Define `@end #1' to end the box, which will in turn undefine the - % @end command again. - \expandafter\def\csname E#1\endcsname{\egroup\ignorespaces}% - % - % We are going to be parsing Texinfo commands. Most cause no - % trouble when they are used incorrectly, but some commands do - % complicated argument parsing or otherwise get confused, so we - % undefine them. - % - % We can't do anything about stray @-signs, unfortunately; - % they'll produce `undefined control sequence' errors. - \ignoremorecommands - % - % Set the current font to be \nullfont, a TeX primitive, and define - % all the font commands to also use \nullfont. We don't use - % dummy.tfm, as suggested in the TeXbook, because not all sites - % might have that installed. Therefore, math mode will still - % produce output, but that should be an extremely small amount of - % stuff compared to the main input. - % - \nullfont - \let\tenrm = \nullfont \let\tenit = \nullfont \let\tensl = \nullfont - \let\tenbf = \nullfont \let\tentt = \nullfont \let\smallcaps = \nullfont - \let\tensf = \nullfont - % Similarly for index fonts (mostly for their use in - % smallexample) - \let\indrm = \nullfont \let\indit = \nullfont \let\indsl = \nullfont - \let\indbf = \nullfont \let\indtt = \nullfont \let\indsc = \nullfont - \let\indsf = \nullfont - % - % Don't complain when characters are missing from the fonts. - \tracinglostchars = 0 - % - % Don't bother to do space factor calculations. - \frenchspacing - % - % Don't report underfull hboxes. - \hbadness = 10000 - % - % Do minimal line-breaking. - \pretolerance = 10000 - % - % Do not execute instructions in @tex - \def\tex{\doignore{tex}}% -} - -% @set VAR sets the variable VAR to an empty value. -% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. -% -% Since we want to separate VAR from REST-OF-LINE (which might be -% empty), we can't just use \parsearg; we have to insert a space of our -% own to delimit the rest of the line, and then take it out again if we -% didn't need it. Make sure the catcode of space is correct to avoid -% losing inside @example, for instance. -% -\def\set{\begingroup\catcode` =10 - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \parsearg\setxxx} -\def\setxxx#1{\setyyy#1 \endsetyyy} -\def\setyyy#1 #2\endsetyyy{% - \def\temp{#2}% - \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty - \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. - \fi - \endgroup -} -% Can't use \xdef to pre-expand #2 and save some time, since \temp or -% \next or other control sequences that we've defined might get us into -% an infinite loop. Consider `@set foo @cite{bar}'. -\def\setzzz#1#2 \endsetzzz{\expandafter\gdef\csname SET#1\endcsname{#2}} - -% @clear VAR clears (i.e., unsets) the variable VAR. -% -\def\clear{\parsearg\clearxxx} -\def\clearxxx#1{\global\expandafter\let\csname SET#1\endcsname=\relax} - -% @value{foo} gets the text saved in variable foo. -% -\def\value{\begingroup - \catcode`\-=12 \catcode`\_=12 % Allow - and _ in VAR. - \valuexxx} -\def\valuexxx#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - {\{No value for ``#1''\}}% - \else - \csname SET#1\endcsname - \fi -\endgroup} - -% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined -% with @set. -% -\def\ifset{\parsearg\ifsetxxx} -\def\ifsetxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifsetfail - \else - \expandafter\ifsetsucceed - \fi -} -\def\ifsetsucceed{\conditionalsucceed{ifset}} -\def\ifsetfail{\nestedignore{ifset}} -\defineunmatchedend{ifset} - -% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been -% defined with @set, or has been undefined with @clear. -% -\def\ifclear{\parsearg\ifclearxxx} -\def\ifclearxxx #1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \expandafter\ifclearsucceed - \else - \expandafter\ifclearfail - \fi -} -\def\ifclearsucceed{\conditionalsucceed{ifclear}} -\def\ifclearfail{\nestedignore{ifclear}} -\defineunmatchedend{ifclear} - -% @iftex, @ifnothtml, @ifnotinfo always succeed; we read the text -% following, through the first @end iftex (etc.). Make `@end iftex' -% (etc.) valid only after an @iftex. -% -\def\iftex{\conditionalsucceed{iftex}} -\def\ifnothtml{\conditionalsucceed{ifnothtml}} -\def\ifnotinfo{\conditionalsucceed{ifnotinfo}} -\defineunmatchedend{iftex} -\defineunmatchedend{ifnothtml} -\defineunmatchedend{ifnotinfo} - -% We can't just want to start a group at @iftex (for example) and end it -% at @end iftex, since then @set commands inside the conditional have no -% effect (they'd get reverted at the end of the group). So we must -% define \Eiftex to redefine itself to be its previous value. (We can't -% just define it to fail again with an ``unmatched end'' error, since -% the @ifset might be nested.) -% -\def\conditionalsucceed#1{% - \edef\temp{% - % Remember the current value of \E#1. - \let\nece{prevE#1} = \nece{E#1}% - % - % At the `@end #1', redefine \E#1 to be its previous value. - \def\nece{E#1}{\let\nece{E#1} = \nece{prevE#1}}% - }% - \temp -} - -% We need to expand lots of \csname's, but we don't want to expand the -% control sequences after we've constructed them. -% -\def\nece#1{\expandafter\noexpand\csname#1\endcsname} - -% @asis just yields its argument. Used with @table, for example. -% -\def\asis#1{#1} - -% @math means output in math mode. -% We don't use $'s directly in the definition of \math because control -% sequences like \math are expanded when the toc file is written. Then, -% we read the toc file back, the $'s will be normal characters (as they -% should be, according to the definition of Texinfo). So we must use a -% control sequence to switch into and out of math mode. -% -% This isn't quite enough for @math to work properly in indices, but it -% seems unlikely it will ever be needed there. -% -\let\implicitmath = $ -\def\math#1{\implicitmath #1\implicitmath} - -% @bullet and @minus need the same treatment as @math, just above. -\def\bullet{\implicitmath\ptexbullet\implicitmath} -\def\minus{\implicitmath-\implicitmath} - -\def\node{\ENVcheck\parsearg\nodezzz} -\def\nodezzz#1{\nodexxx [#1,]} -\def\nodexxx[#1,#2]{\gdef\lastnode{#1}} -\let\nwnode=\node -\let\lastnode=\relax - -\def\donoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\setref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\unnumbnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\unnumbsetref{\lastnode}\fi -\global\let\lastnode=\relax} - -\def\appendixnoderef{\ifx\lastnode\relax\else -\expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi -\global\let\lastnode=\relax} - -% @refill is a no-op. -\let\refill=\relax - -% @setfilename is done at the beginning of every texinfo file. -% So open here the files we need to have open while reading the input. -% This makes it possible to make a .fmt file for texinfo. -\def\setfilename{% - \readauxfile - \opencontents - \openindices - \fixbackslash % Turn off hack to swallow `\input texinfo'. - \global\let\setfilename=\comment % Ignore extra @setfilename cmds. - % - % If texinfo.cnf is present on the system, read it. - % Useful for site-wide @afourpaper, etc. - % Just to be on the safe side, close the input stream before the \input. - \openin 1 texinfo.cnf - \ifeof1 \let\temp=\relax \else \def\temp{\input texinfo.cnf }\fi - \closein1 - \temp - % - \comment % Ignore the actual filename. -} - -% @bye. -\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} - -% \def\macro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\macroxxx} -% \def\macroxxx#1#2 \end macro{% -% \expandafter\gdef\macrotemp#1{#2}% -% \endgroup} - -%\def\linemacro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\linemacroxxx} -%\def\linemacroxxx#1#2 \end linemacro{% -%\let\parsearg=\relax -%\edef\macrotempx{\csname M\butfirst\expandafter\string\macrotemp\endcsname}% -%\expandafter\xdef\macrotemp{\parsearg\macrotempx}% -%\expandafter\gdef\macrotempx#1{#2}% -%\endgroup} - -%\def\butfirst#1{} - - -\message{fonts,} - -% Font-change commands. - -% Texinfo supports the sans serif font style, which plain TeX does not. -% So we set up a \sf analogous to plain's \rm, etc. -\newfam\sffam -\def\sf{\fam=\sffam \tensf} -\let\li = \sf % Sometimes we call it \li, not \sf. - -% We don't need math for this one. -\def\ttsl{\tenttsl} - -% Use Computer Modern fonts at \magstephalf (11pt). -\newcount\mainmagstep -\mainmagstep=\magstephalf - -% Set the font macro #1 to the font named #2, adding on the -% specified font prefix (normally `cm'). -% #3 is the font's design size, #4 is a scale factor -\def\setfont#1#2#3#4{\font#1=\fontprefix#2#3 scaled #4} - -% Use cm as the default font prefix. -% To specify the font prefix, you must define \fontprefix -% before you read in texinfo.tex. -\ifx\fontprefix\undefined -\def\fontprefix{cm} -\fi -% Support font families that don't use the same naming scheme as CM. -\def\rmshape{r} -\def\rmbshape{bx} %where the normal face is bold -\def\bfshape{b} -\def\bxshape{bx} -\def\ttshape{tt} -\def\ttbshape{tt} -\def\ttslshape{sltt} -\def\itshape{ti} -\def\itbshape{bxti} -\def\slshape{sl} -\def\slbshape{bxsl} -\def\sfshape{ss} -\def\sfbshape{ss} -\def\scshape{csc} -\def\scbshape{csc} - -\ifx\bigger\relax -\let\mainmagstep=\magstep1 -\setfont\textrm\rmshape{12}{1000} -\setfont\texttt\ttshape{12}{1000} -\else -\setfont\textrm\rmshape{10}{\mainmagstep} -\setfont\texttt\ttshape{10}{\mainmagstep} -\fi -% Instead of cmb10, you many want to use cmbx10. -% cmbx10 is a prettier font on its own, but cmb10 -% looks better when embedded in a line with cmr10. -\setfont\textbf\bfshape{10}{\mainmagstep} -\setfont\textit\itshape{10}{\mainmagstep} -\setfont\textsl\slshape{10}{\mainmagstep} -\setfont\textsf\sfshape{10}{\mainmagstep} -\setfont\textsc\scshape{10}{\mainmagstep} -\setfont\textttsl\ttslshape{10}{\mainmagstep} -\font\texti=cmmi10 scaled \mainmagstep -\font\textsy=cmsy10 scaled \mainmagstep - -% A few fonts for @defun, etc. -\setfont\defbf\bxshape{10}{\magstep1} %was 1314 -\setfont\deftt\ttshape{10}{\magstep1} -\def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf} - -% Fonts for indices and small examples (9pt). -% We actually use the slanted font rather than the italic, -% because texinfo normally uses the slanted fonts for that. -% Do not make many font distinctions in general in the index, since they -% aren't very useful. -\setfont\ninett\ttshape{9}{1000} -\setfont\indrm\rmshape{9}{1000} -\setfont\indit\slshape{9}{1000} -\let\indsl=\indit -\let\indtt=\ninett -\let\indttsl=\ninett -\let\indsf=\indrm -\let\indbf=\indrm -\setfont\indsc\scshape{10}{900} -\font\indi=cmmi9 -\font\indsy=cmsy9 - -% Fonts for title page: -\setfont\titlerm\rmbshape{12}{\magstep3} -\setfont\titleit\itbshape{10}{\magstep4} -\setfont\titlesl\slbshape{10}{\magstep4} -\setfont\titlett\ttbshape{12}{\magstep3} -\setfont\titlettsl\ttslshape{10}{\magstep4} -\setfont\titlesf\sfbshape{17}{\magstep1} -\let\titlebf=\titlerm -\setfont\titlesc\scbshape{10}{\magstep4} -\font\titlei=cmmi12 scaled \magstep3 -\font\titlesy=cmsy10 scaled \magstep4 -\def\authorrm{\secrm} - -% Chapter (and unnumbered) fonts (17.28pt). -\setfont\chaprm\rmbshape{12}{\magstep2} -\setfont\chapit\itbshape{10}{\magstep3} -\setfont\chapsl\slbshape{10}{\magstep3} -\setfont\chaptt\ttbshape{12}{\magstep2} -\setfont\chapttsl\ttslshape{10}{\magstep3} -\setfont\chapsf\sfbshape{17}{1000} -\let\chapbf=\chaprm -\setfont\chapsc\scbshape{10}{\magstep3} -\font\chapi=cmmi12 scaled \magstep2 -\font\chapsy=cmsy10 scaled \magstep3 - -% Section fonts (14.4pt). -\setfont\secrm\rmbshape{12}{\magstep1} -\setfont\secit\itbshape{10}{\magstep2} -\setfont\secsl\slbshape{10}{\magstep2} -\setfont\sectt\ttbshape{12}{\magstep1} -\setfont\secttsl\ttslshape{10}{\magstep2} -\setfont\secsf\sfbshape{12}{\magstep1} -\let\secbf\secrm -\setfont\secsc\scbshape{10}{\magstep2} -\font\seci=cmmi12 scaled \magstep1 -\font\secsy=cmsy10 scaled \magstep2 - -% \setfont\ssecrm\bxshape{10}{\magstep1} % This size an font looked bad. -% \setfont\ssecit\itshape{10}{\magstep1} % The letters were too crowded. -% \setfont\ssecsl\slshape{10}{\magstep1} -% \setfont\ssectt\ttshape{10}{\magstep1} -% \setfont\ssecsf\sfshape{10}{\magstep1} - -%\setfont\ssecrm\bfshape{10}{1315} % Note the use of cmb rather than cmbx. -%\setfont\ssecit\itshape{10}{1315} % Also, the size is a little larger than -%\setfont\ssecsl\slshape{10}{1315} % being scaled magstep1. -%\setfont\ssectt\ttshape{10}{1315} -%\setfont\ssecsf\sfshape{10}{1315} - -%\let\ssecbf=\ssecrm - -% Subsection fonts (13.15pt). -\setfont\ssecrm\rmbshape{12}{\magstephalf} -\setfont\ssecit\itbshape{10}{1315} -\setfont\ssecsl\slbshape{10}{1315} -\setfont\ssectt\ttbshape{12}{\magstephalf} -\setfont\ssecttsl\ttslshape{10}{1315} -\setfont\ssecsf\sfbshape{12}{\magstephalf} -\let\ssecbf\ssecrm -\setfont\ssecsc\scbshape{10}{\magstep1} -\font\sseci=cmmi12 scaled \magstephalf -\font\ssecsy=cmsy10 scaled 1315 -% The smallcaps and symbol fonts should actually be scaled \magstep1.5, -% but that is not a standard magnification. - -% In order for the font changes to affect most math symbols and letters, -% we have to define the \textfont of the standard families. Since -% texinfo doesn't allow for producing subscripts and superscripts, we -% don't bother to reset \scriptfont and \scriptscriptfont (which would -% also require loading a lot more fonts). -% -\def\resetmathfonts{% - \textfont0 = \tenrm \textfont1 = \teni \textfont2 = \tensy - \textfont\itfam = \tenit \textfont\slfam = \tensl \textfont\bffam = \tenbf - \textfont\ttfam = \tentt \textfont\sffam = \tensf -} - - -% The font-changing commands redefine the meanings of \tenSTYLE, instead -% of just \STYLE. We do this so that font changes will continue to work -% in math mode, where it is the current \fam that is relevant in most -% cases, not the current font. Plain TeX does \def\bf{\fam=\bffam -% \tenbf}, for example. By redefining \tenbf, we obviate the need to -% redefine \bf itself. -\def\textfonts{% - \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl - \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc - \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy \let\tenttsl=\textttsl - \resetmathfonts} -\def\titlefonts{% - \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl - \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc - \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy - \let\tenttsl=\titlettsl - \resetmathfonts \setleading{25pt}} -\def\titlefont#1{{\titlefonts\rm #1}} -\def\chapfonts{% - \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl - \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc - \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy \let\tenttsl=\chapttsl - \resetmathfonts \setleading{19pt}} -\def\secfonts{% - \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl - \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc - \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy \let\tenttsl=\secttsl - \resetmathfonts \setleading{16pt}} -\def\subsecfonts{% - \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl - \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc - \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl - \resetmathfonts \setleading{15pt}} -\let\subsubsecfonts = \subsecfonts % Maybe make sssec fonts scaled magstephalf? -\def\indexfonts{% - \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl - \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc - \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy \let\tenttsl=\indttsl - \resetmathfonts \setleading{12pt}} - -% Set up the default fonts, so we can use them for creating boxes. -% -\textfonts - -% Define these so they can be easily changed for other fonts. -\def\angleleft{$\langle$} -\def\angleright{$\rangle$} - -% Count depth in font-changes, for error checks -\newcount\fontdepth \fontdepth=0 - -% Fonts for short table of contents. -\setfont\shortcontrm\rmshape{12}{1000} -\setfont\shortcontbf\bxshape{12}{1000} -\setfont\shortcontsl\slshape{12}{1000} - -%% Add scribe-like font environments, plus @l for inline lisp (usually sans -%% serif) and @ii for TeX italic - -% \smartitalic{ARG} outputs arg in italics, followed by an italic correction -% unless the following character is such as not to need one. -\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else\/\fi\fi\fi} -\def\smartitalic#1{{\sl #1}\futurelet\next\smartitalicx} - -\let\i=\smartitalic -\let\var=\smartitalic -\let\dfn=\smartitalic -\let\emph=\smartitalic -\let\cite=\smartitalic - -\def\b#1{{\bf #1}} -\let\strong=\b - -% We can't just use \exhyphenpenalty, because that only has effect at -% the end of a paragraph. Restore normal hyphenation at the end of the -% group within which \nohyphenation is presumably called. -% -\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} -\def\restorehyphenation{\hyphenchar\font = `- } - -\def\t#1{% - {\tt \rawbackslash \frenchspacing #1}% - \null -} -\let\ttfont=\t -\def\samp#1{`\tclose{#1}'\null} -\setfont\smallrm\rmshape{8}{1000} -\font\smallsy=cmsy9 -\def\key#1{{\smallrm\textfont2=\smallsy \leavevmode\hbox{% - \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{% - \vbox{\hrule\kern-0.4pt - \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}% - \kern-0.4pt\hrule}% - \kern-.06em\raise0.4pt\hbox{\angleright}}}} -% The old definition, with no lozenge: -%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null} -\def\ctrl #1{{\tt \rawbackslash \hat}#1} - -\let\file=\samp - -% @code is a modification of @t, -% which makes spaces the same size as normal in the surrounding text. -\def\tclose#1{% - {% - % Change normal interword space to be same as for the current font. - \spaceskip = \fontdimen2\font - % - % Switch to typewriter. - \tt - % - % But `\ ' produces the large typewriter interword space. - \def\ {{\spaceskip = 0pt{} }}% - % - % Turn off hyphenation. - \nohyphenation - % - \rawbackslash - \frenchspacing - #1% - }% - \null -} - -% We *must* turn on hyphenation at `-' and `_' in \code. -% Otherwise, it is too hard to avoid overfull hboxes -% in the Emacs manual, the Library manual, etc. - -% Unfortunately, TeX uses one parameter (\hyphenchar) to control -% both hyphenation at - and hyphenation within words. -% We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate at a dash. -% -- rms. -{ -\catcode`\-=\active -\catcode`\_=\active -\catcode`\|=\active -\global\def\code{\begingroup \catcode`\-=\active \let-\codedash \catcode`\_=\active \let_\codeunder \codex} -% The following is used by \doprintindex to insure that long function names -% wrap around. It is necessary for - and _ to be active before the index is -% read from the file, as \entry parses the arguments long before \code is -% ever called. -- mycroft -% _ is always active; and it shouldn't be \let = to an _ that is a -% subscript character anyway. Then, @cindex @samp{_} (for example) -% fails. --karl -\global\def\indexbreaks{% - \catcode`\-=\active \let-\realdash -} -} - -\def\realdash{-} -\def\codedash{-\discretionary{}{}{}} -\def\codeunder{\ifusingtt{\normalunderscore\discretionary{}{}{}}{\_}} -\def\codex #1{\tclose{#1}\endgroup} - -%\let\exp=\tclose %Was temporary - -% @kbd is like @code, except that if the argument is just one @key command, -% then @kbd has no effect. - -% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), -% `example' (@kbd uses ttsl only inside of @example and friends), -% or `code' (@kbd uses normal tty font always). -\def\kbdinputstyle{\parsearg\kbdinputstylexxx} -\def\kbdinputstylexxx#1{% - \def\arg{#1}% - \ifx\arg\worddistinct - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% - \else\ifx\arg\wordexample - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% - \else\ifx\arg\wordcode - \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% - \fi\fi\fi -} -\def\worddistinct{distinct} -\def\wordexample{example} -\def\wordcode{code} - -% Default is kbdinputdistinct. (Too much of a hassle to call the macro, -% the catcodes are wrong for parsearg to work.) -\gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl} - -\def\xkey{\key} -\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% -\ifx\one\xkey\ifx\threex\three \key{#2}% -\else{\tclose{\kbdfont\look}}\fi -\else{\tclose{\kbdfont\look}}\fi} - -% @url. Quotes do not seem necessary, so use \code. -\let\url=\code - -% @uref (abbreviation for `urlref') takes an optional second argument -% specifying the text to display. First (mandatory) arg is the url. -% Perhaps eventually put in a hypertex \special here. -% -\def\uref#1{\urefxxx #1,,\finish} -\def\urefxxx#1,#2,#3\finish{% - \setbox0 = \hbox{\ignorespaces #2}% - \ifdim\wd0 > 0pt - \unhbox0\ (\code{#1})% - \else - \code{#1}% - \fi -} - -% rms does not like the angle brackets --karl, 17may97. -% So now @email is just like @uref. -%\def\email#1{\angleleft{\tt #1}\angleright} -\let\email=\uref - -% Check if we are currently using a typewriter font. Since all the -% Computer Modern typewriter fonts have zero interword stretch (and -% shrink), and it is reasonable to expect all typewriter fonts to have -% this property, we can check that font parameter. -% -\def\ifmonospace{\ifdim\fontdimen3\font=0pt } - -% Typeset a dimension, e.g., `in' or `pt'. The only reason for the -% argument is to make the input look right: @dmn{pt} instead of -% @dmn{}pt. -% -\def\dmn#1{\thinspace #1} - -\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par} - -% @l was never documented to mean ``switch to the Lisp font'', -% and it is not used as such in any manual I can find. We need it for -% Polish suppressed-l. --karl, 22sep96. -%\def\l#1{{\li #1}\null} - -\def\r#1{{\rm #1}} % roman font -% Use of \lowercase was suggested. -\def\sc#1{{\smallcaps#1}} % smallcaps font -\def\ii#1{{\it #1}} % italic font - -% @pounds{} is a sterling sign. -\def\pounds{{\it\$}} - - -\message{page headings,} - -\newskip\titlepagetopglue \titlepagetopglue = 1.5in -\newskip\titlepagebottomglue \titlepagebottomglue = 2pc - -% First the title page. Must do @settitle before @titlepage. -\newif\ifseenauthor -\newif\iffinishedtitlepage - -\def\shorttitlepage{\parsearg\shorttitlepagezzz} -\def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} - -\def\titlepage{\begingroup \parindent=0pt \textfonts - \let\subtitlerm=\tenrm -% I deinstalled the following change because \cmr12 is undefined. -% This change was not in the ChangeLog anyway. --rms. -% \let\subtitlerm=\cmr12 - \def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}% - % - \def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines}% - % - % Leave some space at the very top of the page. - \vglue\titlepagetopglue - % - % Now you can print the title using @title. - \def\title{\parsearg\titlezzz}% - \def\titlezzz##1{\leftline{\titlefonts\rm ##1} - % print a rule at the page bottom also. - \finishedtitlepagefalse - \vskip4pt \hrule height 4pt width \hsize \vskip4pt}% - % No rule at page bottom unless we print one at the top with @title. - \finishedtitlepagetrue - % - % Now you can put text using @subtitle. - \def\subtitle{\parsearg\subtitlezzz}% - \def\subtitlezzz##1{{\subtitlefont \rightline{##1}}}% - % - % @author should come last, but may come many times. - \def\author{\parsearg\authorzzz}% - \def\authorzzz##1{\ifseenauthor\else\vskip 0pt plus 1filll\seenauthortrue\fi - {\authorfont \leftline{##1}}}% - % - % Most title ``pages'' are actually two pages long, with space - % at the top of the second. We don't want the ragged left on the second. - \let\oldpage = \page - \def\page{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - \oldpage - \let\page = \oldpage - \hbox{}}% -% \def\page{\oldpage \hbox{}} -} - -\def\Etitlepage{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - % It is important to do the page break before ending the group, - % because the headline and footline are only empty inside the group. - % If we use the new definition of \page, we always get a blank page - % after the title page, which we certainly don't want. - \oldpage - \endgroup - \HEADINGSon -} - -\def\finishtitlepage{% - \vskip4pt \hrule height 2pt width \hsize - \vskip\titlepagebottomglue - \finishedtitlepagetrue -} - -%%% Set up page headings and footings. - -\let\thispage=\folio - -\newtoks \evenheadline % Token sequence for heading line of even pages -\newtoks \oddheadline % Token sequence for heading line of odd pages -\newtoks \evenfootline % Token sequence for footing line of even pages -\newtoks \oddfootline % Token sequence for footing line of odd pages - -% Now make Tex use those variables -\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline - \else \the\evenheadline \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} -\let\HEADINGShook=\relax - -% Commands to set those variables. -% For example, this is what @headings on does -% @evenheading @thistitle|@thispage|@thischapter -% @oddheading @thischapter|@thispage|@thistitle -% @evenfooting @thisfile|| -% @oddfooting ||@thisfile - -\def\evenheading{\parsearg\evenheadingxxx} -\def\oddheading{\parsearg\oddheadingxxx} -\def\everyheading{\parsearg\everyheadingxxx} - -\def\evenfooting{\parsearg\evenfootingxxx} -\def\oddfooting{\parsearg\oddfootingxxx} -\def\everyfooting{\parsearg\everyfootingxxx} - -{\catcode`\@=0 % - -\gdef\evenheadingxxx #1{\evenheadingyyy #1@|@|@|@|\finish} -\gdef\evenheadingyyy #1@|#2@|#3@|#4\finish{% -\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\oddheadingxxx #1{\oddheadingyyy #1@|@|@|@|\finish} -\gdef\oddheadingyyy #1@|#2@|#3@|#4\finish{% -\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\everyheadingxxx#1{\oddheadingxxx{#1}\evenheadingxxx{#1}}% - -\gdef\evenfootingxxx #1{\evenfootingyyy #1@|@|@|@|\finish} -\gdef\evenfootingyyy #1@|#2@|#3@|#4\finish{% -\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\gdef\oddfootingxxx #1{\oddfootingyyy #1@|@|@|@|\finish} -\gdef\oddfootingyyy #1@|#2@|#3@|#4\finish{% - \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}% - % - % Leave some space for the footline. Hopefully ok to assume - % @evenfooting will not be used by itself. - \global\advance\pageheight by -\baselineskip - \global\advance\vsize by -\baselineskip -} - -\gdef\everyfootingxxx#1{\oddfootingxxx{#1}\evenfootingxxx{#1}} -% -}% unbind the catcode of @. - -% @headings double turns headings on for double-sided printing. -% @headings single turns headings on for single-sided printing. -% @headings off turns them off. -% @headings on same as @headings double, retained for compatibility. -% @headings after turns on double-sided headings after this page. -% @headings doubleafter turns on double-sided headings after this page. -% @headings singleafter turns on single-sided headings after this page. -% By default, they are off at the start of a document, -% and turned `on' after @end titlepage. - -\def\headings #1 {\csname HEADINGS#1\endcsname} - -\def\HEADINGSoff{ -\global\evenheadline={\hfil} \global\evenfootline={\hfil} -\global\oddheadline={\hfil} \global\oddfootline={\hfil}} -\HEADINGSoff -% When we turn headings on, set the page number to 1. -% For double-sided printing, put current file name in lower left corner, -% chapter name on inside top of right hand pages, document -% title on inside top of left hand pages, and page numbers on outside top -% edge of all pages. -\def\HEADINGSdouble{ -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{ -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapter\hfil\folio}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} -\let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} - -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapter\hfil\folio}} -\global\oddheadline={\line{\thischapter\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} - -% Subroutines used in generating headings -% Produces Day Month Year style of output. -\def\today{\number\day\space -\ifcase\month\or -January\or February\or March\or April\or May\or June\or -July\or August\or September\or October\or November\or December\fi -\space\number\year} - -% Use this if you want the Month Day, Year style of output. -%\def\today{\ifcase\month\or -%January\or February\or March\or April\or May\or June\or -%July\or August\or September\or October\or November\or December\fi -%\space\number\day, \number\year} - -% @settitle line... specifies the title of the document, for headings -% It generates no output of its own - -\def\thistitle{No Title} -\def\settitle{\parsearg\settitlezzz} -\def\settitlezzz #1{\gdef\thistitle{#1}} - - -\message{tables,} - -% @tabs -- simple alignment - -% These don't work. For one thing, \+ is defined as outer. -% So these macros cannot even be defined. - -%\def\tabs{\parsearg\tabszzz} -%\def\tabszzz #1{\settabs\+#1\cr} -%\def\tabline{\parsearg\tablinezzz} -%\def\tablinezzz #1{\+#1\cr} -%\def\&{&} - -% Tables -- @table, @ftable, @vtable, @item(x), @kitem(x), @xitem(x). - -% default indentation of table text -\newdimen\tableindent \tableindent=.8in -% default indentation of @itemize and @enumerate text -\newdimen\itemindent \itemindent=.3in -% margin between end of table item and start of table text. -\newdimen\itemmargin \itemmargin=.1in - -% used internally for \itemindent minus \itemmargin -\newdimen\itemmax - -% Note @table, @vtable, and @vtable define @item, @itemx, etc., with -% these defs. -% They also define \itemindex -% to index the item name in whatever manner is desired (perhaps none). - -\newif\ifitemxneedsnegativevskip - -\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi} - -\def\internalBitem{\smallbreak \parsearg\itemzzz} -\def\internalBitemx{\itemxpar \parsearg\itemzzz} - -\def\internalBxitem "#1"{\def\xitemsubtopix{#1} \smallbreak \parsearg\xitemzzz} -\def\internalBxitemx "#1"{\def\xitemsubtopix{#1} \itemxpar \parsearg\xitemzzz} - -\def\internalBkitem{\smallbreak \parsearg\kitemzzz} -\def\internalBkitemx{\itemxpar \parsearg\kitemzzz} - -\def\kitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \lastfunction}}% - \itemzzz {#1}} - -\def\xitemzzz #1{\dosubind {kw}{\code{#1}}{for {\bf \xitemsubtopic}}% - \itemzzz {#1}} - -\def\itemzzz #1{\begingroup % - \advance\hsize by -\rightskip - \advance\hsize by -\tableindent - \setbox0=\hbox{\itemfont{#1}}% - \itemindex{#1}% - \nobreak % This prevents a break before @itemx. - % - % Be sure we are not still in the middle of a paragraph. - %{\parskip = 0in - %\par - %}% - % - % If the item text does not fit in the space we have, put it on a line - % by itself, and do not allow a page break either before or after that - % line. We do not start a paragraph here because then if the next - % command is, e.g., @kindex, the whatsit would get put into the - % horizontal list on a line by itself, resulting in extra blank space. - \ifdim \wd0>\itemmax - % - % Make this a paragraph so we get the \parskip glue and wrapping, - % but leave it ragged-right. - \begingroup - \advance\leftskip by-\tableindent - \advance\hsize by\tableindent - \advance\rightskip by0pt plus1fil - \leavevmode\unhbox0\par - \endgroup - % - % We're going to be starting a paragraph, but we don't want the - % \parskip glue -- logically it's part of the @item we just started. - \nobreak \vskip-\parskip - % - % Stop a page break at the \parskip glue coming up. Unfortunately - % we can't prevent a possible page break at the following - % \baselineskip glue. - \nobreak - \endgroup - \itemxneedsnegativevskipfalse - \else - % The item text fits into the space. Start a paragraph, so that the - % following text (if any) will end up on the same line. Since that - % text will be indented by \tableindent, we make the item text be in - % a zero-width box. - \noindent - \rlap{\hskip -\tableindent\box0}\ignorespaces% - \endgroup% - \itemxneedsnegativevskiptrue% - \fi -} - -\def\item{\errmessage{@item while not in a table}} -\def\itemx{\errmessage{@itemx while not in a table}} -\def\kitem{\errmessage{@kitem while not in a table}} -\def\kitemx{\errmessage{@kitemx while not in a table}} -\def\xitem{\errmessage{@xitem while not in a table}} -\def\xitemx{\errmessage{@xitemx while not in a table}} - -%% Contains a kludge to get @end[description] to work -\def\description{\tablez{\dontindex}{1}{}{}{}{}} - -\def\table{\begingroup\inENV\obeylines\obeyspaces\tablex} -{\obeylines\obeyspaces% -\gdef\tablex #1^^M{% -\tabley\dontindex#1 \endtabley}} - -\def\ftable{\begingroup\inENV\obeylines\obeyspaces\ftablex} -{\obeylines\obeyspaces% -\gdef\ftablex #1^^M{% -\tabley\fnitemindex#1 \endtabley -\def\Eftable{\endgraf\afterenvbreak\endgroup}% -\let\Etable=\relax}} - -\def\vtable{\begingroup\inENV\obeylines\obeyspaces\vtablex} -{\obeylines\obeyspaces% -\gdef\vtablex #1^^M{% -\tabley\vritemindex#1 \endtabley -\def\Evtable{\endgraf\afterenvbreak\endgroup}% -\let\Etable=\relax}} - -\def\dontindex #1{} -\def\fnitemindex #1{\doind {fn}{\code{#1}}}% -\def\vritemindex #1{\doind {vr}{\code{#1}}}% - -{\obeyspaces % -\gdef\tabley#1#2 #3 #4 #5 #6 #7\endtabley{\endgroup% -\tablez{#1}{#2}{#3}{#4}{#5}{#6}}} - -\def\tablez #1#2#3#4#5#6{% -\aboveenvbreak % -\begingroup % -\def\Edescription{\Etable}% Necessary kludge. -\let\itemindex=#1% -\ifnum 0#3>0 \advance \leftskip by #3\mil \fi % -\ifnum 0#4>0 \tableindent=#4\mil \fi % -\ifnum 0#5>0 \advance \rightskip by #5\mil \fi % -\def\itemfont{#2}% -\itemmax=\tableindent % -\advance \itemmax by -\itemmargin % -\advance \leftskip by \tableindent % -\exdentamount=\tableindent -\parindent = 0pt -\parskip = \smallskipamount -\ifdim \parskip=0pt \parskip=2pt \fi% -\def\Etable{\endgraf\afterenvbreak\endgroup}% -\let\item = \internalBitem % -\let\itemx = \internalBitemx % -\let\kitem = \internalBkitem % -\let\kitemx = \internalBkitemx % -\let\xitem = \internalBxitem % -\let\xitemx = \internalBxitemx % -} - -% This is the counter used by @enumerate, which is really @itemize - -\newcount \itemno - -\def\itemize{\parsearg\itemizezzz} - -\def\itemizezzz #1{% - \begingroup % ended by the @end itemsize - \itemizey {#1}{\Eitemize} -} - -\def\itemizey #1#2{% -\aboveenvbreak % -\itemmax=\itemindent % -\advance \itemmax by -\itemmargin % -\advance \leftskip by \itemindent % -\exdentamount=\itemindent -\parindent = 0pt % -\parskip = \smallskipamount % -\ifdim \parskip=0pt \parskip=2pt \fi% -\def#2{\endgraf\afterenvbreak\endgroup}% -\def\itemcontents{#1}% -\let\item=\itemizeitem} - -% Set sfcode to normal for the chars that usually have another value. -% These are `.?!:;,' -\def\frenchspacing{\sfcode46=1000 \sfcode63=1000 \sfcode33=1000 - \sfcode58=1000 \sfcode59=1000 \sfcode44=1000 } - -% \splitoff TOKENS\endmark defines \first to be the first token in -% TOKENS, and \rest to be the remainder. -% -\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}% - -% Allow an optional argument of an uppercase letter, lowercase letter, -% or number, to specify the first label in the enumerated list. No -% argument is the same as `1'. -% -\def\enumerate{\parsearg\enumeratezzz} -\def\enumeratezzz #1{\enumeratey #1 \endenumeratey} -\def\enumeratey #1 #2\endenumeratey{% - \begingroup % ended by the @end enumerate - % - % If we were given no argument, pretend we were given `1'. - \def\thearg{#1}% - \ifx\thearg\empty \def\thearg{1}\fi - % - % Detect if the argument is a single token. If so, it might be a - % letter. Otherwise, the only valid thing it can be is a number. - % (We will always have one token, because of the test we just made. - % This is a good thing, since \splitoff doesn't work given nothing at - % all -- the first parameter is undelimited.) - \expandafter\splitoff\thearg\endmark - \ifx\rest\empty - % Only one token in the argument. It could still be anything. - % A ``lowercase letter'' is one whose \lccode is nonzero. - % An ``uppercase letter'' is one whose \lccode is both nonzero, and - % not equal to itself. - % Otherwise, we assume it's a number. - % - % We need the \relax at the end of the \ifnum lines to stop TeX from - % continuing to look for a . - % - \ifnum\lccode\expandafter`\thearg=0\relax - \numericenumerate % a number (we hope) - \else - % It's a letter. - \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax - \lowercaseenumerate % lowercase letter - \else - \uppercaseenumerate % uppercase letter - \fi - \fi - \else - % Multiple tokens in the argument. We hope it's a number. - \numericenumerate - \fi -} - -% An @enumerate whose labels are integers. The starting integer is -% given in \thearg. -% -\def\numericenumerate{% - \itemno = \thearg - \startenumeration{\the\itemno}% -} - -% The starting (lowercase) letter is in \thearg. -\def\lowercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more lowercase letters in @enumerate; get a bigger - alphabet}% - \fi - \char\lccode\itemno - }% -} - -% The starting (uppercase) letter is in \thearg. -\def\uppercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more uppercase letters in @enumerate; get a bigger - alphabet} - \fi - \char\uccode\itemno - }% -} - -% Call itemizey, adding a period to the first argument and supplying the -% common last two arguments. Also subtract one from the initial value in -% \itemno, since @item increments \itemno. -% -\def\startenumeration#1{% - \advance\itemno by -1 - \itemizey{#1.}\Eenumerate\flushcr -} - -% @alphaenumerate and @capsenumerate are abbreviations for giving an arg -% to @enumerate. -% -\def\alphaenumerate{\enumerate{a}} -\def\capsenumerate{\enumerate{A}} -\def\Ealphaenumerate{\Eenumerate} -\def\Ecapsenumerate{\Eenumerate} - -% Definition of @item while inside @itemize. - -\def\itemizeitem{% -\advance\itemno by 1 -{\let\par=\endgraf \smallbreak}% -\ifhmode \errmessage{In hmode at itemizeitem}\fi -{\parskip=0in \hskip 0pt -\hbox to 0pt{\hss \itemcontents\hskip \itemmargin}% -\vadjust{\penalty 1200}}% -\flushcr} - -% @multitable macros -% Amy Hendrickson, 8/18/94, 3/6/96 -% -% @multitable ... @end multitable will make as many columns as desired. -% Contents of each column will wrap at width given in preamble. Width -% can be specified either with sample text given in a template line, -% or in percent of \hsize, the current width of text on page. - -% Table can continue over pages but will only break between lines. - -% To make preamble: -% -% Either define widths of columns in terms of percent of \hsize: -% @multitable @columnfractions .25 .3 .45 -% @item ... -% -% Numbers following @columnfractions are the percent of the total -% current hsize to be used for each column. You may use as many -% columns as desired. - - -% Or use a template: -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item ... -% using the widest term desired in each column. -% -% For those who want to use more than one line's worth of words in -% the preamble, break the line within one argument and it -% will parse correctly, i.e., -% -% @multitable {Column 1 template} {Column 2 template} {Column 3 -% template} -% Not: -% @multitable {Column 1 template} {Column 2 template} -% {Column 3 template} - -% Each new table line starts with @item, each subsequent new column -% starts with @tab. Empty columns may be produced by supplying @tab's -% with nothing between them for as many times as empty columns are needed, -% ie, @tab@tab@tab will produce two empty columns. - -% @item, @tab, @multitable or @end multitable do not need to be on their -% own lines, but it will not hurt if they are. - -% Sample multitable: - -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item first col stuff @tab second col stuff @tab third col -% @item -% first col stuff -% @tab -% second col stuff -% @tab -% third col -% @item first col stuff @tab second col stuff -% @tab Many paragraphs of text may be used in any column. -% -% They will wrap at the width determined by the template. -% @item@tab@tab This will be in third column. -% @end multitable - -% Default dimensions may be reset by user. -% @multitableparskip is vertical space between paragraphs in table. -% @multitableparindent is paragraph indent in table. -% @multitablecolmargin is horizontal space to be left between columns. -% @multitablelinespace is space to leave between table items, baseline -% to baseline. -% 0pt means it depends on current normal line spacing. -% -\newskip\multitableparskip -\newskip\multitableparindent -\newdimen\multitablecolspace -\newskip\multitablelinespace -\multitableparskip=0pt -\multitableparindent=6pt -\multitablecolspace=12pt -\multitablelinespace=0pt - -% Macros used to set up halign preamble: -% -\let\endsetuptable\relax -\def\xendsetuptable{\endsetuptable} -\let\columnfractions\relax -\def\xcolumnfractions{\columnfractions} -\newif\ifsetpercent - -% 2/1/96, to allow fractions to be given with more than one digit. -\def\pickupwholefraction#1 {\global\advance\colcount by1 % -\expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}% -\setuptable} - -\newcount\colcount -\def\setuptable#1{\def\firstarg{#1}% -\ifx\firstarg\xendsetuptable\let\go\relax% -\else - \ifx\firstarg\xcolumnfractions\global\setpercenttrue% - \else - \ifsetpercent - \let\go\pickupwholefraction % In this case arg of setuptable - % is the decimal point before the - % number given in percent of hsize. - % We don't need this so we don't use it. - \else - \global\advance\colcount by1 - \setbox0=\hbox{#1 }% Add a normal word space as a separator; - % typically that is always in the input, anyway. - \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% - \fi% - \fi% -\ifx\go\pickupwholefraction\else\let\go\setuptable\fi% -\fi\go} - -% multitable syntax -\def\tab{&\hskip1sp\relax} % 2/2/96 - % tiny skip here makes sure this column space is - % maintained, even if it is never used. - -% @multitable ... @end multitable definitions: - -\def\multitable{\parsearg\dotable} -\def\dotable#1{\bgroup - \vskip\parskip - \let\item\crcr - \tolerance=9500 - \hbadness=9500 - \setmultitablespacing - \parskip=\multitableparskip - \parindent=\multitableparindent - \overfullrule=0pt - \global\colcount=0 - \def\Emultitable{\global\setpercentfalse\cr\egroup\egroup}% - % - % To parse everything between @multitable and @item: - \setuptable#1 \endsetuptable - % - % \everycr will reset column counter, \colcount, at the end of - % each line. Every column entry will cause \colcount to advance by one. - % The table preamble - % looks at the current \colcount to find the correct column width. - \everycr{\noalign{% - % - % \filbreak%% keeps underfull box messages off when table breaks over pages. - % Maybe so, but it also creates really weird page breaks when the table - % breaks over pages. Wouldn't \vfil be better? Wait until the problem - % manifests itself, so it can be fixed for real --karl. - \global\colcount=0\relax}}% - % - % This preamble sets up a generic column definition, which will - % be used as many times as user calls for columns. - % \vtop will set a single line and will also let text wrap and - % continue for many paragraphs if desired. - \halign\bgroup&\global\advance\colcount by 1\relax - \multistrut\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname - % - % In order to keep entries from bumping into each other - % we will add a \leftskip of \multitablecolspace to all columns after - % the first one. - % - % If a template has been used, we will add \multitablecolspace - % to the width of each template entry. - % - % If the user has set preamble in terms of percent of \hsize we will - % use that dimension as the width of the column, and the \leftskip - % will keep entries from bumping into each other. Table will start at - % left margin and final column will justify at right margin. - % - % Make sure we don't inherit \rightskip from the outer environment. - \rightskip=0pt - \ifnum\colcount=1 - % The first column will be indented with the surrounding text. - \advance\hsize by\leftskip - \else - \ifsetpercent \else - % If user has not set preamble in terms of percent of \hsize - % we will advance \hsize by \multitablecolspace. - \advance\hsize by \multitablecolspace - \fi - % In either case we will make \leftskip=\multitablecolspace: - \leftskip=\multitablecolspace - \fi - % Ignoring space at the beginning and end avoids an occasional spurious - % blank line, when TeX decides to break the line at the space before the - % box from the multistrut, so the strut ends up on a line by itself. - % For example: - % @multitable @columnfractions .11 .89 - % @item @code{#} - % @tab Legal holiday which is valid in major parts of the whole country. - % Is automatically provided with highlighting sequences respectively marking - % characters. - \noindent\ignorespaces##\unskip\multistrut}\cr -} - -\def\setmultitablespacing{% test to see if user has set \multitablelinespace. -% If so, do nothing. If not, give it an appropriate dimension based on -% current baselineskip. -\ifdim\multitablelinespace=0pt -%% strut to put in table in case some entry doesn't have descenders, -%% to keep lines equally spaced -\let\multistrut = \strut -%% Test to see if parskip is larger than space between lines of -%% table. If not, do nothing. -%% If so, set to same dimension as multitablelinespace. -\else -\gdef\multistrut{\vrule height\multitablelinespace depth\dp0 -width0pt\relax} \fi -\ifdim\multitableparskip>\multitablelinespace -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller - %% than skip between lines in the table. -\fi% -\ifdim\multitableparskip=0pt -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller - %% than skip between lines in the table. -\fi} - - -\message{indexing,} -% Index generation facilities - -% Define \newwrite to be identical to plain tex's \newwrite -% except not \outer, so it can be used within \newindex. -{\catcode`\@=11 -\gdef\newwrite{\alloc@7\write\chardef\sixt@@n}} - -% \newindex {foo} defines an index named foo. -% It automatically defines \fooindex such that -% \fooindex ...rest of line... puts an entry in the index foo. -% It also defines \fooindfile to be the number of the output channel for -% the file that accumulates this index. The file's extension is foo. -% The name of an index should be no more than 2 characters long -% for the sake of vms. - -\def\newindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#1}} -} - -% @defindex foo == \newindex{foo} - -\def\defindex{\parsearg\newindex} - -% Define @defcodeindex, like @defindex except put all entries in @code. - -\def\newcodeindex #1{ -\expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#1}} -} - -\def\defcodeindex{\parsearg\newcodeindex} - -% @synindex foo bar makes index foo feed into index bar. -% Do this instead of @defindex foo if you don't want it as a separate index. -\def\synindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\doindex {#2}}% -} - -% @syncodeindex foo bar similar, but put all entries made for index foo -% inside @code. -\def\syncodeindex #1 #2 {% -\expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname -\expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex -\noexpand\docodeindex {#2}}% -} - -% Define \doindex, the driver for all \fooindex macros. -% Argument #1 is generated by the calling \fooindex macro, -% and it is "foo", the name of the index. - -% \doindex just uses \parsearg; it calls \doind for the actual work. -% This is because \doind is more useful to call from other macros. - -% There is also \dosubind {index}{topic}{subtopic} -% which makes an entry in a two-level index such as the operation index. - -\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer} -\def\singleindexer #1{\doind{\indexname}{#1}} - -% like the previous two, but they put @code around the argument. -\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer} -\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}} - -\def\indexdummies{% -% Take care of the plain tex accent commands. -\def\"{\realbackslash "}% -\def\`{\realbackslash `}% -\def\'{\realbackslash '}% -\def\^{\realbackslash ^}% -\def\~{\realbackslash ~}% -\def\={\realbackslash =}% -\def\b{\realbackslash b}% -\def\c{\realbackslash c}% -\def\d{\realbackslash d}% -\def\u{\realbackslash u}% -\def\v{\realbackslash v}% -\def\H{\realbackslash H}% -% Take care of the plain tex special European modified letters. -\def\oe{\realbackslash oe}% -\def\ae{\realbackslash ae}% -\def\aa{\realbackslash aa}% -\def\OE{\realbackslash OE}% -\def\AE{\realbackslash AE}% -\def\AA{\realbackslash AA}% -\def\o{\realbackslash o}% -\def\O{\realbackslash O}% -\def\l{\realbackslash l}% -\def\L{\realbackslash L}% -\def\ss{\realbackslash ss}% -% Take care of texinfo commands likely to appear in an index entry. -% (Must be a way to avoid doing expansion at all, and thus not have to -% laboriously list every single command here.) -\def\@{@}% will be @@ when we switch to @ as escape char. -%\let\{ = \lbracecmd -%\let\} = \rbracecmd -\def\_{{\realbackslash _}}% -\def\w{\realbackslash w }% -\def\bf{\realbackslash bf }% -%\def\rm{\realbackslash rm }% -\def\sl{\realbackslash sl }% -\def\sf{\realbackslash sf}% -\def\tt{\realbackslash tt}% -\def\gtr{\realbackslash gtr}% -\def\less{\realbackslash less}% -\def\hat{\realbackslash hat}% -%\def\char{\realbackslash char}% -\def\TeX{\realbackslash TeX}% -\def\dots{\realbackslash dots }% -\def\result{\realbackslash result}% -\def\equiv{\realbackslash equiv}% -\def\expansion{\realbackslash expansion}% -\def\print{\realbackslash print}% -\def\error{\realbackslash error}% -\def\point{\realbackslash point}% -\def\copyright{\realbackslash copyright}% -\def\tclose##1{\realbackslash tclose {##1}}% -\def\code##1{\realbackslash code {##1}}% -\def\dotless##1{\realbackslash dotless {##1}}% -\def\samp##1{\realbackslash samp {##1}}% -\def\,##1{\realbackslash ,{##1}}% -\def\t##1{\realbackslash t {##1}}% -\def\r##1{\realbackslash r {##1}}% -\def\i##1{\realbackslash i {##1}}% -\def\b##1{\realbackslash b {##1}}% -\def\sc##1{\realbackslash sc {##1}}% -\def\cite##1{\realbackslash cite {##1}}% -\def\key##1{\realbackslash key {##1}}% -\def\file##1{\realbackslash file {##1}}% -\def\var##1{\realbackslash var {##1}}% -\def\kbd##1{\realbackslash kbd {##1}}% -\def\dfn##1{\realbackslash dfn {##1}}% -\def\emph##1{\realbackslash emph {##1}}% -\def\value##1{\realbackslash value {##1}}% -\unsepspaces -} - -% If an index command is used in an @example environment, any spaces -% therein should become regular spaces in the raw index file, not the -% expansion of \tie (\\leavevmode \penalty \@M \ ). -{\obeyspaces - \gdef\unsepspaces{\obeyspaces\let =\space}} - -% \indexnofonts no-ops all font-change commands. -% This is used when outputting the strings to sort the index by. -\def\indexdummyfont#1{#1} -\def\indexdummytex{TeX} -\def\indexdummydots{...} - -\def\indexnofonts{% -% Just ignore accents. -\let\,=\indexdummyfont -\let\"=\indexdummyfont -\let\`=\indexdummyfont -\let\'=\indexdummyfont -\let\^=\indexdummyfont -\let\~=\indexdummyfont -\let\==\indexdummyfont -\let\b=\indexdummyfont -\let\c=\indexdummyfont -\let\d=\indexdummyfont -\let\u=\indexdummyfont -\let\v=\indexdummyfont -\let\H=\indexdummyfont -\let\dotless=\indexdummyfont -% Take care of the plain tex special European modified letters. -\def\oe{oe}% -\def\ae{ae}% -\def\aa{aa}% -\def\OE{OE}% -\def\AE{AE}% -\def\AA{AA}% -\def\o{o}% -\def\O{O}% -\def\l{l}% -\def\L{L}% -\def\ss{ss}% -\let\w=\indexdummyfont -\let\t=\indexdummyfont -\let\r=\indexdummyfont -\let\i=\indexdummyfont -\let\b=\indexdummyfont -\let\emph=\indexdummyfont -\let\strong=\indexdummyfont -\let\cite=\indexdummyfont -\let\sc=\indexdummyfont -%Don't no-op \tt, since it isn't a user-level command -% and is used in the definitions of the active chars like <, >, |... -%\let\tt=\indexdummyfont -\let\tclose=\indexdummyfont -\let\code=\indexdummyfont -\let\file=\indexdummyfont -\let\samp=\indexdummyfont -\let\kbd=\indexdummyfont -\let\key=\indexdummyfont -\let\var=\indexdummyfont -\let\TeX=\indexdummytex -\let\dots=\indexdummydots -\def\@{@}% -} - -% To define \realbackslash, we must make \ not be an escape. -% We must first make another character (@) an escape -% so we do not become unable to do a definition. - -{\catcode`\@=0 \catcode`\\=\other -@gdef@realbackslash{\}} - -\let\indexbackslash=0 %overridden during \printindex. - -\let\SETmarginindex=\relax %initialize! -% workhorse for all \fooindexes -% #1 is name of index, #2 is stuff to put there -\def\doind #1#2{% - % Put the index entry in the margin if desired. - \ifx\SETmarginindex\relax\else - \insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}% - \fi - {% - \count255=\lastpenalty - {% - \indexdummies % Must do this here, since \bf, etc expand at this stage - \escapechar=`\\ - {% - \let\folio=0% We will expand all macros now EXCEPT \folio. - \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now - % so it will be output as is; and it will print as backslash. - % - % First process the index-string with all font commands turned off - % to get the string to sort by. - {\indexnofonts \xdef\indexsorttmp{#2}}% - % - % Now produce the complete index entry, with both the sort key and the - % original text, including any font commands. - \toks0 = {#2}% - \edef\temp{% - \write\csname#1indfile\endcsname{% - \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}% - }% - \temp - }% - }% - \penalty\count255 - }% -} - -\def\dosubind #1#2#3{% -{\count10=\lastpenalty % -{\indexdummies % Must do this here, since \bf, etc expand at this stage -\escapechar=`\\% -{\let\folio=0% -\def\rawbackslashxx{\indexbackslash}% -% -% Now process the index-string once, with all font commands turned off, -% to get the string to sort the index by. -{\indexnofonts -\xdef\temp1{#2 #3}% -}% -% Now produce the complete index entry. We process the index-string again, -% this time with font commands expanded, to get what to print in the index. -\edef\temp{% -\write \csname#1indfile\endcsname{% -\realbackslash entry {\temp1}{\folio}{#2}{#3}}}% -\temp }% -}\penalty\count10}} - -% The index entry written in the file actually looks like -% \entry {sortstring}{page}{topic} -% or -% \entry {sortstring}{page}{topic}{subtopic} -% The texindex program reads in these files and writes files -% containing these kinds of lines: -% \initial {c} -% before the first topic whose initial is c -% \entry {topic}{pagelist} -% for a topic that is used without subtopics -% \primary {topic} -% for the beginning of a topic that is used with subtopics -% \secondary {subtopic}{pagelist} -% for each subtopic. - -% Define the user-accessible indexing commands -% @findex, @vindex, @kindex, @cindex. - -\def\findex {\fnindex} -\def\kindex {\kyindex} -\def\cindex {\cpindex} -\def\vindex {\vrindex} -\def\tindex {\tpindex} -\def\pindex {\pgindex} - -\def\cindexsub {\begingroup\obeylines\cindexsub} -{\obeylines % -\gdef\cindexsub "#1" #2^^M{\endgroup % -\dosubind{cp}{#2}{#1}}} - -% Define the macros used in formatting output of the sorted index material. - -% @printindex causes a particular index (the ??s file) to get printed. -% It does not print any chapter heading (usually an @unnumbered). -% -\def\printindex{\parsearg\doprintindex} -\def\doprintindex#1{\begingroup - \dobreak \chapheadingskip{10000}% - % - \indexfonts \rm - \tolerance = 9500 - \indexbreaks - % - % See if the index file exists and is nonempty. - % Change catcode of @ here so that if the index file contains - % \initial {@} - % as its first line, TeX doesn't complain about mismatched braces - % (because it thinks @} is a control sequence). - \catcode`\@ = 11 - \openin 1 \jobname.#1s - \ifeof 1 - % \enddoublecolumns gets confused if there is no text in the index, - % and it loses the chapter title and the aux file entries for the - % index. The easiest way to prevent this problem is to make sure - % there is some text. - (Index is nonexistent) - \else - % - % If the index file exists but is empty, then \openin leaves \ifeof - % false. We have to make TeX try to read something from the file, so - % it can discover if there is anything in it. - \read 1 to \temp - \ifeof 1 - (Index is empty) - \else - % Index files are almost Texinfo source, but we use \ as the escape - % character. It would be better to use @, but that's too big a change - % to make right now. - \def\indexbackslash{\rawbackslashxx}% - \catcode`\\ = 0 - \escapechar = `\\ - \begindoublecolumns - \input \jobname.#1s - \enddoublecolumns - \fi - \fi - \closein 1 -\endgroup} - -% These macros are used by the sorted index file itself. -% Change them to control the appearance of the index. - -% Same as \bigskipamount except no shrink. -% \balancecolumns gets confused if there is any shrink. -\newskip\initialskipamount \initialskipamount 12pt plus4pt - -\def\initial #1{% -{\let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt -\ifdim\lastskip<\initialskipamount -\removelastskip \penalty-200 \vskip \initialskipamount\fi -\line{\secbf#1\hfill}\kern 2pt\penalty10000}} - -% This typesets a paragraph consisting of #1, dot leaders, and then #2 -% flush to the right margin. It is used for index and table of contents -% entries. The paragraph is indented by \leftskip. -% -\def\entry #1#2{\begingroup - % - % Start a new paragraph if necessary, so our assignments below can't - % affect previous text. - \par - % - % Do not fill out the last line with white space. - \parfillskip = 0in - % - % No extra space above this paragraph. - \parskip = 0in - % - % Do not prefer a separate line ending with a hyphen to fewer lines. - \finalhyphendemerits = 0 - % - % \hangindent is only relevant when the entry text and page number - % don't both fit on one line. In that case, bob suggests starting the - % dots pretty far over on the line. Unfortunately, a large - % indentation looks wrong when the entry text itself is broken across - % lines. So we use a small indentation and put up with long leaders. - % - % \hangafter is reset to 1 (which is the value we want) at the start - % of each paragraph, so we need not do anything with that. - \hangindent=2em - % - % When the entry text needs to be broken, just fill out the first line - % with blank space. - \rightskip = 0pt plus1fil - % - % Start a ``paragraph'' for the index entry so the line breaking - % parameters we've set above will have an effect. - \noindent - % - % Insert the text of the index entry. TeX will do line-breaking on it. - #1% - % The following is kludged to not output a line of dots in the index if - % there are no page numbers. The next person who breaks this will be - % cursed by a Unix daemon. - \def\tempa{{\rm }}% - \def\tempb{#2}% - \edef\tempc{\tempa}% - \edef\tempd{\tempb}% - \ifx\tempc\tempd\ \else% - % - % If we must, put the page number on a line of its own, and fill out - % this line with blank space. (The \hfil is overwhelmed with the - % fill leaders glue in \indexdotfill if the page number does fit.) - \hfil\penalty50 - \null\nobreak\indexdotfill % Have leaders before the page number. - % - % The `\ ' here is removed by the implicit \unskip that TeX does as - % part of (the primitive) \par. Without it, a spurious underfull - % \hbox ensues. - \ #2% The page number ends the paragraph. - \fi% - \par -\endgroup} - -% Like \dotfill except takes at least 1 em. -\def\indexdotfill{\cleaders - \hbox{$\mathsurround=0pt \mkern1.5mu ${\it .}$ \mkern1.5mu$}\hskip 1em plus 1fill} - -\def\primary #1{\line{#1\hfil}} - -\newskip\secondaryindent \secondaryindent=0.5cm - -\def\secondary #1#2{ -{\parfillskip=0in \parskip=0in -\hangindent =1in \hangafter=1 -\noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\par -}} - -% Define two-column mode, which we use to typeset indexes. -% Adapted from the TeXbook, page 416, which is to say, -% the manmac.tex format used to print the TeXbook itself. -\catcode`\@=11 - -\newbox\partialpage -\newdimen\doublecolumnhsize - -\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns - % Grab any single-column material above us. - \output = {\global\setbox\partialpage = \vbox{% - % - % Here is a possibility not foreseen in manmac: if we accumulate a - % whole lot of material, we might end up calling this \output - % routine twice in a row (see the doublecol-lose test, which is - % essentially a couple of indexes with @setchapternewpage off). In - % that case, we must prevent the second \partialpage from - % simply overwriting the first, causing us to lose the page. - % This will preserve it until a real output routine can ship it - % out. Generally, \partialpage will be empty when this runs and - % this will be a no-op. - \unvbox\partialpage - % - % Unvbox the main output page. - \unvbox255 - \kern-\topskip \kern\baselineskip - }}% - \eject - % - % Use the double-column output routine for subsequent pages. - \output = {\doublecolumnout}% - % - % Change the page size parameters. We could do this once outside this - % routine, in each of @smallbook, @afourpaper, and the default 8.5x11 - % format, but then we repeat the same computation. Repeating a couple - % of assignments once per index is clearly meaningless for the - % execution time, so we may as well do it in one place. - % - % First we halve the line length, less a little for the gutter between - % the columns. We compute the gutter based on the line length, so it - % changes automatically with the paper format. The magic constant - % below is chosen so that the gutter has the same value (well, +-<1pt) - % as it did when we hard-coded it. - % - % We put the result in a separate register, \doublecolumhsize, so we - % can restore it in \pagesofar, after \hsize itself has (potentially) - % been clobbered. - % - \doublecolumnhsize = \hsize - \advance\doublecolumnhsize by -.04154\hsize - \divide\doublecolumnhsize by 2 - \hsize = \doublecolumnhsize - % - % Double the \vsize as well. (We don't need a separate register here, - % since nobody clobbers \vsize.) - \vsize = 2\vsize -} -\def\doublecolumnout{% - \splittopskip=\topskip \splitmaxdepth=\maxdepth - % Get the available space for the double columns -- the normal - % (undoubled) page height minus any material left over from the - % previous page. - \dimen@=\pageheight \advance\dimen@ by-\ht\partialpage - % box0 will be the left-hand column, box2 the right. - \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@ - \onepageout\pagesofar - \unvbox255 - \penalty\outputpenalty -} -\def\pagesofar{% - % Re-output the contents of the output page -- any previous material, - % followed by the two boxes we just split. - \unvbox\partialpage - \hsize = \doublecolumnhsize - \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}% -} -\def\enddoublecolumns{% - \output = {\balancecolumns}\eject % split what we have - \endgroup % started in \begindoublecolumns - % - % Back to normal single-column typesetting, but take account of the - % fact that we just accumulated some stuff on the output page. - \pagegoal = \vsize -} -\def\balancecolumns{% - % Called at the end of the double column material. - \setbox0 = \vbox{\unvbox255}% - \dimen@ = \ht0 - \advance\dimen@ by \topskip - \advance\dimen@ by-\baselineskip - \divide\dimen@ by 2 - \splittopskip = \topskip - % Loop until we get a decent breakpoint. - {\vbadness=10000 \loop - \global\setbox3=\copy0 - \global\setbox1=\vsplit3 to\dimen@ - \ifdim\ht3>\dimen@ \global\advance\dimen@ by1pt - \repeat}% - \setbox0=\vbox to\dimen@{\unvbox1}% - \setbox2=\vbox to\dimen@{\unvbox3}% - \pagesofar -} -\catcode`\@ = \other - - -\message{sectioning,} -% Define chapters, sections, etc. - -\newcount\chapno -\newcount\secno \secno=0 -\newcount\subsecno \subsecno=0 -\newcount\subsubsecno \subsubsecno=0 - -% This counter is funny since it counts through charcodes of letters A, B, ... -\newcount\appendixno \appendixno = `\@ -\def\appendixletter{\char\the\appendixno} - -\newwrite\contentsfile -% This is called from \setfilename. -\def\opencontents{\openout\contentsfile = \jobname.toc } - -% Each @chapter defines this as the name of the chapter. -% page headings and footings can use it. @section does likewise - -\def\thischapter{} \def\thissection{} -\def\seccheck#1{\ifnum \pageno<0 - \errmessage{@#1 not allowed after generating table of contents}% -\fi} - -\def\chapternofonts{% - \let\rawbackslash=\relax - \let\frenchspacing=\relax - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\TeX{\realbackslash TeX}% - \def\dots{\realbackslash dots}% - \def\result{\realbackslash result}% - \def\equiv{\realbackslash equiv}% - \def\expansion{\realbackslash expansion}% - \def\print{\realbackslash print}% - \def\error{\realbackslash error}% - \def\point{\realbackslash point}% - \def\copyright{\realbackslash copyright}% - \def\tt{\realbackslash tt}% - \def\bf{\realbackslash bf}% - \def\w{\realbackslash w}% - \def\less{\realbackslash less}% - \def\gtr{\realbackslash gtr}% - \def\hat{\realbackslash hat}% - \def\char{\realbackslash char}% - \def\tclose##1{\realbackslash tclose{##1}}% - \def\code##1{\realbackslash code{##1}}% - \def\samp##1{\realbackslash samp{##1}}% - \def\r##1{\realbackslash r{##1}}% - \def\b##1{\realbackslash b{##1}}% - \def\key##1{\realbackslash key{##1}}% - \def\file##1{\realbackslash file{##1}}% - \def\kbd##1{\realbackslash kbd{##1}}% - % These are redefined because @smartitalic wouldn't work inside xdef. - \def\i##1{\realbackslash i{##1}}% - \def\cite##1{\realbackslash cite{##1}}% - \def\var##1{\realbackslash var{##1}}% - \def\emph##1{\realbackslash emph{##1}}% - \def\dfn##1{\realbackslash dfn{##1}}% -} - -\newcount\absseclevel % used to calculate proper heading level -\newcount\secbase\secbase=0 % @raise/lowersections modify this count - -% @raisesections: treat @section as chapter, @subsection as section, etc. -\def\raisesections{\global\advance\secbase by -1} -\let\up=\raisesections % original BFox name - -% @lowersections: treat @chapter as section, @section as subsection, etc. -\def\lowersections{\global\advance\secbase by 1} -\let\down=\lowersections % original BFox name - -% Choose a numbered-heading macro -% #1 is heading level if unmodified by @raisesections or @lowersections -% #2 is text for heading -\def\numhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \chapterzzz{#2} -\or - \seczzz{#2} -\or - \numberedsubseczzz{#2} -\or - \numberedsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \chapterzzz{#2} - \else - \numberedsubsubseczzz{#2} - \fi -\fi -} - -% like \numhead, but chooses appendix heading levels -\def\apphead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \appendixzzz{#2} -\or - \appendixsectionzzz{#2} -\or - \appendixsubseczzz{#2} -\or - \appendixsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \appendixzzz{#2} - \else - \appendixsubsubseczzz{#2} - \fi -\fi -} - -% like \numhead, but chooses numberless heading levels -\def\unnmhead#1#2{\absseclevel=\secbase\advance\absseclevel by #1 -\ifcase\absseclevel - \unnumberedzzz{#2} -\or - \unnumberedseczzz{#2} -\or - \unnumberedsubseczzz{#2} -\or - \unnumberedsubsubseczzz{#2} -\else - \ifnum \absseclevel<0 - \unnumberedzzz{#2} - \else - \unnumberedsubsubseczzz{#2} - \fi -\fi -} - - -\def\thischaptername{No Chapter Title} -\outer\def\chapter{\parsearg\chapteryyy} -\def\chapteryyy #1{\numhead0{#1}} % normally numhead0 calls chapterzzz -\def\chapterzzz #1{\seccheck{chapter}% -\secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \chapno by 1 \message{\putwordChapter \the\chapno}% -\chapmacro {#1}{\the\chapno}% -\gdef\thissection{#1}% -\gdef\thischaptername{#1}% -% We don't substitute the actual chapter name into \thischapter -% because we don't want its macros evaluated now. -\xdef\thischapter{\putwordChapter{} \the\chapno: \noexpand\thischaptername}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}{\the\chapno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\global\let\section = \numberedsec -\global\let\subsection = \numberedsubsec -\global\let\subsubsection = \numberedsubsubsec -}} - -\outer\def\appendix{\parsearg\appendixyyy} -\def\appendixyyy #1{\apphead0{#1}} % normally apphead0 calls appendixzzz -\def\appendixzzz #1{\seccheck{appendix}% -\secno=0 \subsecno=0 \subsubsecno=0 -\global\advance \appendixno by 1 \message{Appendix \appendixletter}% -\chapmacro {#1}{\putwordAppendix{} \appendixletter}% -\gdef\thissection{#1}% -\gdef\thischaptername{#1}% -\xdef\thischapter{\putwordAppendix{} \appendixletter: \noexpand\thischaptername}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash chapentry{\the\toks0}% - {\putwordAppendix{} \appendixletter}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\global\let\section = \appendixsec -\global\let\subsection = \appendixsubsec -\global\let\subsubsection = \appendixsubsubsec -}} - -% @centerchap is like @unnumbered, but the heading is centered. -\outer\def\centerchap{\parsearg\centerchapyyy} -\def\centerchapyyy #1{{\let\unnumbchapmacro=\centerchapmacro \unnumberedyyy{#1}}} - -\outer\def\top{\parsearg\unnumberedyyy} -\outer\def\unnumbered{\parsearg\unnumberedyyy} -\def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz -\def\unnumberedzzz #1{\seccheck{unnumbered}% -\secno=0 \subsecno=0 \subsubsecno=0 -% -% This used to be simply \message{#1}, but TeX fully expands the -% argument to \message. Therefore, if #1 contained @-commands, TeX -% expanded them. For example, in `@unnumbered The @cite{Book}', TeX -% expanded @cite (which turns out to cause errors because \cite is meant -% to be executed, not expanded). -% -% Anyway, we don't want the fully-expanded definition of @cite to appear -% as a result of the \message, we just want `@cite' itself. We use -% \the to achieve this: TeX expands \the only once, -% simply yielding the contents of the . -\toks0 = {#1}\message{(\the\toks0)}% -% -\unnumbchapmacro {#1}% -\gdef\thischapter{#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbchapentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\global\let\section = \unnumberedsec -\global\let\subsection = \unnumberedsubsec -\global\let\subsubsection = \unnumberedsubsubsec -}} - -\outer\def\numberedsec{\parsearg\secyyy} -\def\secyyy #1{\numhead1{#1}} % normally calls seczzz -\def\seczzz #1{\seccheck{section}% -\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % -\gdef\thissection{#1}\secheading {#1}{\the\chapno}{\the\secno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\the\chapno}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsection{\parsearg\appendixsecyyy} -\outer\def\appendixsec{\parsearg\appendixsecyyy} -\def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz -\def\appendixsectionzzz #1{\seccheck{appendixsection}% -\subsecno=0 \subsubsecno=0 \global\advance \secno by 1 % -\gdef\thissection{#1}\secheading {#1}{\appendixletter}{\the\secno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash secentry % -{\the\toks0}{\appendixletter}{\the\secno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsec{\parsearg\unnumberedsecyyy} -\def\unnumberedsecyyy #1{\unnmhead1{#1}} % normally calls unnumberedseczzz -\def\unnumberedseczzz #1{\seccheck{unnumberedsec}% -\plainsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -\outer\def\numberedsubsec{\parsearg\numberedsubsecyyy} -\def\numberedsubsecyyy #1{\numhead2{#1}} % normally calls numberedsubseczzz -\def\numberedsubseczzz #1{\seccheck{subsection}% -\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % -\subsecheading {#1}{\the\chapno}{\the\secno}{\the\subsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\the\chapno}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsubsec{\parsearg\appendixsubsecyyy} -\def\appendixsubsecyyy #1{\apphead2{#1}} % normally calls appendixsubseczzz -\def\appendixsubseczzz #1{\seccheck{appendixsubsec}% -\gdef\thissection{#1}\subsubsecno=0 \global\advance \subsecno by 1 % -\subsecheading {#1}{\appendixletter}{\the\secno}{\the\subsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsecentry % -{\the\toks0}{\appendixletter}{\the\secno}{\the\subsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy} -\def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz -\def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}% -\plainsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -\outer\def\numberedsubsubsec{\parsearg\numberedsubsubsecyyy} -\def\numberedsubsubsecyyy #1{\numhead3{#1}} % normally numberedsubsubseczzz -\def\numberedsubsubseczzz #1{\seccheck{subsubsection}% -\gdef\thissection{#1}\global\advance \subsubsecno by 1 % -\subsubsecheading {#1} - {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0} - {\the\chapno}{\the\secno}{\the\subsecno}{\the\subsubsecno} - {\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\donoderef % -\penalty 10000 % -}} - -\outer\def\appendixsubsubsec{\parsearg\appendixsubsubsecyyy} -\def\appendixsubsubsecyyy #1{\apphead3{#1}} % normally appendixsubsubseczzz -\def\appendixsubsubseczzz #1{\seccheck{appendixsubsubsec}% -\gdef\thissection{#1}\global\advance \subsubsecno by 1 % -\subsubsecheading {#1} - {\appendixletter}{\the\secno}{\the\subsecno}{\the\subsubsecno}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash subsubsecentry{\the\toks0}% - {\appendixletter} - {\the\secno}{\the\subsecno}{\the\subsubsecno}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\appendixnoderef % -\penalty 10000 % -}} - -\outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy} -\def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz -\def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}% -\plainsubsubsecheading {#1}\gdef\thissection{#1}% -{\chapternofonts% -\toks0 = {#1}% -\edef\temp{{\realbackslash unnumbsubsubsecentry{\the\toks0}{\noexpand\folio}}}% -\escapechar=`\\% -\write \contentsfile \temp % -\unnumbnoderef % -\penalty 10000 % -}} - -% These are variants which are not "outer", so they can appear in @ifinfo. -% Actually, they should now be obsolete; ordinary section commands should work. -\def\infotop{\parsearg\unnumberedzzz} -\def\infounnumbered{\parsearg\unnumberedzzz} -\def\infounnumberedsec{\parsearg\unnumberedseczzz} -\def\infounnumberedsubsec{\parsearg\unnumberedsubseczzz} -\def\infounnumberedsubsubsec{\parsearg\unnumberedsubsubseczzz} - -\def\infoappendix{\parsearg\appendixzzz} -\def\infoappendixsec{\parsearg\appendixseczzz} -\def\infoappendixsubsec{\parsearg\appendixsubseczzz} -\def\infoappendixsubsubsec{\parsearg\appendixsubsubseczzz} - -\def\infochapter{\parsearg\chapterzzz} -\def\infosection{\parsearg\sectionzzz} -\def\infosubsection{\parsearg\subsectionzzz} -\def\infosubsubsection{\parsearg\subsubsectionzzz} - -% These macros control what the section commands do, according -% to what kind of chapter we are in (ordinary, appendix, or unnumbered). -% Define them by default for a numbered chapter. -\global\let\section = \numberedsec -\global\let\subsection = \numberedsubsec -\global\let\subsubsection = \numberedsubsubsec - -% Define @majorheading, @heading and @subheading - -% NOTE on use of \vbox for chapter headings, section headings, and -% such: -% 1) We use \vbox rather than the earlier \line to permit -% overlong headings to fold. -% 2) \hyphenpenalty is set to 10000 because hyphenation in a -% heading is obnoxious; this forbids it. -% 3) Likewise, headings look best if no \parindent is used, and -% if justification is not attempted. Hence \raggedright. - - -\def\majorheading{\parsearg\majorheadingzzz} -\def\majorheadingzzz #1{% -{\advance\chapheadingskip by 10pt \chapbreak }% -{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 200} - -\def\chapheading{\parsearg\chapheadingzzz} -\def\chapheadingzzz #1{\chapbreak % -{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 200} - -% @heading, @subheading, @subsubheading. -\def\heading{\parsearg\plainsecheading} -\def\subheading{\parsearg\plainsubsecheading} -\def\subsubheading{\parsearg\plainsubsubsecheading} - -% These macros generate a chapter, section, etc. heading only -% (including whitespace, linebreaking, etc. around it), -% given all the information in convenient, parsed form. - -%%% Args are the skip and penalty (usually negative) -\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi} - -\def\setchapterstyle #1 {\csname CHAPF#1\endcsname} - -%%% Define plain chapter starts, and page on/off switching for it -% Parameter controlling skip before chapter headings (if needed) - -\newskip\chapheadingskip - -\def\chapbreak{\dobreak \chapheadingskip {-4000}} -\def\chappager{\par\vfill\supereject} -\def\chapoddpage{\chappager \ifodd\pageno \else \hbox to 0pt{} \chappager\fi} - -\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname} - -\def\CHAPPAGoff{ -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chapbreak -\global\let\pagealignmacro=\chappager} - -\def\CHAPPAGon{ -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chappager -\global\let\pagealignmacro=\chappager -\global\def\HEADINGSon{\HEADINGSsingle}} - -\def\CHAPPAGodd{ -\global\let\contentsalignmacro = \chapoddpage -\global\let\pchapsepmacro=\chapoddpage -\global\let\pagealignmacro=\chapoddpage -\global\def\HEADINGSon{\HEADINGSdouble}} - -\CHAPPAGon - -\def\CHAPFplain{ -\global\let\chapmacro=\chfplain -\global\let\unnumbchapmacro=\unnchfplain -\global\let\centerchapmacro=\centerchfplain} - -% Plain chapter opening. -% #1 is the text, #2 the chapter number or empty if unnumbered. -\def\chfplain#1#2{% - \pchapsepmacro - {% - \chapfonts \rm - \def\chapnum{#2}% - \setbox0 = \hbox{#2\ifx\chapnum\empty\else\enspace\fi}% - \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright - \hangindent = \wd0 \centerparametersmaybe - \unhbox0 #1\par}% - }% - \nobreak\bigskip % no page break after a chapter title - \nobreak -} - -% Plain opening for unnumbered. -\def\unnchfplain#1{\chfplain{#1}{}} - -% @centerchap -- centered and unnumbered. -\let\centerparametersmaybe = \relax -\def\centerchfplain#1{{% - \def\centerparametersmaybe{% - \advance\rightskip by 3\rightskip - \leftskip = \rightskip - \parfillskip = 0pt - }% - \chfplain{#1}{}% -}} - -\CHAPFplain % The default - -\def\unnchfopen #1{% -\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 10000 % -} - -\def\chfopen #1#2{\chapoddpage {\chapfonts -\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}% -\par\penalty 5000 % -} - -\def\centerchfopen #1{% -\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt - \hfill {\rm #1}\hfill}}\bigskip \par\penalty 10000 % -} - -\def\CHAPFopen{ -\global\let\chapmacro=\chfopen -\global\let\unnumbchapmacro=\unnchfopen -\global\let\centerchapmacro=\centerchfopen} - - -% Section titles. -\newskip\secheadingskip -\def\secheadingbreak{\dobreak \secheadingskip {-1000}} -\def\secheading#1#2#3{\sectionheading{sec}{#2.#3}{#1}} -\def\plainsecheading#1{\sectionheading{sec}{}{#1}} - -% Subsection titles. -\newskip \subsecheadingskip -\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}} -\def\subsecheading#1#2#3#4{\sectionheading{subsec}{#2.#3.#4}{#1}} -\def\plainsubsecheading#1{\sectionheading{subsec}{}{#1}} - -% Subsubsection titles. -\let\subsubsecheadingskip = \subsecheadingskip -\let\subsubsecheadingbreak = \subsecheadingbreak -\def\subsubsecheading#1#2#3#4#5{\sectionheading{subsubsec}{#2.#3.#4.#5}{#1}} -\def\plainsubsubsecheading#1{\sectionheading{subsubsec}{}{#1}} - - -% Print any size section title. -% -% #1 is the section type (sec/subsec/subsubsec), #2 is the section -% number (maybe empty), #3 the text. -\def\sectionheading#1#2#3{% - {% - \expandafter\advance\csname #1headingskip\endcsname by \parskip - \csname #1headingbreak\endcsname - }% - {% - % Switch to the right set of fonts. - \csname #1fonts\endcsname \rm - % - % Only insert the separating space if we have a section number. - \def\secnum{#2}% - \setbox0 = \hbox{#2\ifx\secnum\empty\else\enspace\fi}% - % - \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright - \hangindent = \wd0 % zero if no section number - \unhbox0 #3}% - }% - \ifdim\parskip<10pt \nobreak\kern10pt\nobreak\kern-\parskip\fi \nobreak -} - - -\message{toc printing,} -% Finish up the main text and prepare to read what we've written -% to \contentsfile. - -\newskip\contentsrightmargin \contentsrightmargin=1in -\def\startcontents#1{% - % If @setchapternewpage on, and @headings double, the contents should - % start on an odd page, unlike chapters. Thus, we maintain - % \contentsalignmacro in parallel with \pagealignmacro. - % From: Torbjorn Granlund - \contentsalignmacro - \immediate\closeout \contentsfile - \ifnum \pageno>0 - \pageno = -1 % Request roman numbered pages. - \fi - % Don't need to put `Contents' or `Short Contents' in the headline. - % It is abundantly clear what they are. - \unnumbchapmacro{#1}\def\thischapter{}% - \begingroup % Set up to handle contents files properly. - \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11 - % We can't do this, because then an actual ^ in a section - % title fails, e.g., @chapter ^ -- exponentiation. --karl, 9jul97. - %\catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi - \raggedbottom % Worry more about breakpoints than the bottom. - \advance\hsize by -\contentsrightmargin % Don't use the full line length. -} - - -% Normal (long) toc. -\outer\def\contents{% - \startcontents{\putwordTableofContents}% - \input \jobname.toc - \endgroup - \vfill \eject -} - -% And just the chapters. -\outer\def\summarycontents{% - \startcontents{\putwordShortContents}% - % - \let\chapentry = \shortchapentry - \let\unnumbchapentry = \shortunnumberedentry - % We want a true roman here for the page numbers. - \secfonts - \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl - \rm - \hyphenpenalty = 10000 - \advance\baselineskip by 1pt % Open it up a little. - \def\secentry ##1##2##3##4{} - \def\unnumbsecentry ##1##2{} - \def\subsecentry ##1##2##3##4##5{} - \def\unnumbsubsecentry ##1##2{} - \def\subsubsecentry ##1##2##3##4##5##6{} - \def\unnumbsubsubsecentry ##1##2{} - \input \jobname.toc - \endgroup - \vfill \eject -} -\let\shortcontents = \summarycontents - -% These macros generate individual entries in the table of contents. -% The first argument is the chapter or section name. -% The last argument is the page number. -% The arguments in between are the chapter number, section number, ... - -% Chapter-level things, for both the long and short contents. -\def\chapentry#1#2#3{\dochapentry{#2\labelspace#1}{#3}} - -% See comments in \dochapentry re vbox and related settings -\def\shortchapentry#1#2#3{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno{#3}}% -} - -% Typeset the label for a chapter or appendix for the short contents. -% The arg is, e.g. `Appendix A' for an appendix, or `3' for a chapter. -% We could simplify the code here by writing out an \appendixentry -% command in the toc file for appendices, instead of using \chapentry -% for both, but it doesn't seem worth it. -\setbox0 = \hbox{\shortcontrm \putwordAppendix } -\newdimen\shortappendixwidth \shortappendixwidth = \wd0 - -\def\shortchaplabel#1{% - % We typeset #1 in a box of constant width, regardless of the text of - % #1, so the chapter titles will come out aligned. - \setbox0 = \hbox{#1}% - \dimen0 = \ifdim\wd0 > \shortappendixwidth \shortappendixwidth \else 0pt \fi - % - % This space should be plenty, since a single number is .5em, and the - % widest letter (M) is 1em, at least in the Computer Modern fonts. - % (This space doesn't include the extra space that gets added after - % the label; that gets put in by \shortchapentry above.) - \advance\dimen0 by 1.1em - \hbox to \dimen0{#1\hfil}% -} - -\def\unnumbchapentry#1#2{\dochapentry{#1}{#2}} -\def\shortunnumberedentry#1#2{\tocentry{#1}{\doshortpageno{#2}}} - -% Sections. -\def\secentry#1#2#3#4{\dosecentry{#2.#3\labelspace#1}{#4}} -\def\unnumbsecentry#1#2{\dosecentry{#1}{#2}} - -% Subsections. -\def\subsecentry#1#2#3#4#5{\dosubsecentry{#2.#3.#4\labelspace#1}{#5}} -\def\unnumbsubsecentry#1#2{\dosubsecentry{#1}{#2}} - -% And subsubsections. -\def\subsubsecentry#1#2#3#4#5#6{% - \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}{#6}} -\def\unnumbsubsubsecentry#1#2{\dosubsubsecentry{#1}{#2}} - -% This parameter controls the indentation of the various levels. -\newdimen\tocindent \tocindent = 3pc - -% Now for the actual typesetting. In all these, #1 is the text and #2 is the -% page number. -% -% If the toc has to be broken over pages, we want it to be at chapters -% if at all possible; hence the \penalty. -\def\dochapentry#1#2{% - \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip - \begingroup - \chapentryfonts - \tocentry{#1}{\dopageno{#2}}% - \endgroup - \nobreak\vskip .25\baselineskip plus.1\baselineskip -} - -\def\dosecentry#1#2{\begingroup - \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -\def\dosubsecentry#1#2{\begingroup - \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -\def\dosubsubsecentry#1#2{\begingroup - \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno{#2}}% -\endgroup} - -% Final typesetting of a toc entry; we use the same \entry macro as for -% the index entries, but we want to suppress hyphenation here. (We -% can't do that in the \entry macro, since index entries might consist -% of hyphenated-identifiers-that-do-not-fit-on-a-line-and-nothing-else.) -\def\tocentry#1#2{\begingroup - \vskip 0pt plus1pt % allow a little stretch for the sake of nice page breaks - % Do not use \turnoffactive in these arguments. Since the toc is - % typeset in cmr, so characters such as _ would come out wrong; we - % have to do the usual translation tricks. - \entry{#1}{#2}% -\endgroup} - -% Space between chapter (or whatever) number and the title. -\def\labelspace{\hskip1em \relax} - -\def\dopageno#1{{\rm #1}} -\def\doshortpageno#1{{\rm #1}} - -\def\chapentryfonts{\secfonts \rm} -\def\secentryfonts{\textfonts} -\let\subsecentryfonts = \textfonts -\let\subsubsecentryfonts = \textfonts - - -\message{environments,} - -% Since these characters are used in examples, it should be an even number of -% \tt widths. Each \tt character is 1en, so two makes it 1em. -% Furthermore, these definitions must come after we define our fonts. -\newbox\dblarrowbox \newbox\longdblarrowbox -\newbox\pushcharbox \newbox\bullbox -\newbox\equivbox \newbox\errorbox - -%{\tentt -%\global\setbox\dblarrowbox = \hbox to 1em{\hfil$\Rightarrow$\hfil} -%\global\setbox\longdblarrowbox = \hbox to 1em{\hfil$\mapsto$\hfil} -%\global\setbox\pushcharbox = \hbox to 1em{\hfil$\dashv$\hfil} -%\global\setbox\equivbox = \hbox to 1em{\hfil$\ptexequiv$\hfil} -% Adapted from the manmac format (p.420 of TeXbook) -%\global\setbox\bullbox = \hbox to 1em{\kern.15em\vrule height .75ex width .85ex -% depth .1ex\hfil} -%} - -% @point{}, @result{}, @expansion{}, @print{}, @equiv{}. -\def\point{$\star$} -\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}} -\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}} -\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}} -\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}} - -% Adapted from the TeXbook's \boxit. -{\tentt \global\dimen0 = 3em}% Width of the box. -\dimen2 = .55pt % Thickness of rules -% The text. (`r' is open on the right, `e' somewhat less so on the left.) -\setbox0 = \hbox{\kern-.75pt \tensf error\kern-1.5pt} - -\global\setbox\errorbox=\hbox to \dimen0{\hfil - \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right. - \advance\hsize by -2\dimen2 % Rules. - \vbox{ - \hrule height\dimen2 - \hbox{\vrule width\dimen2 \kern3pt % Space to left of text. - \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below. - \kern3pt\vrule width\dimen2}% Space to right. - \hrule height\dimen2} - \hfil} - -% The @error{} command. -\def\error{\leavevmode\lower.7ex\copy\errorbox} - -% @tex ... @end tex escapes into raw Tex temporarily. -% One exception: @ is still an escape character, so that @end tex works. -% But \@ or @@ will get a plain tex @ character. - -\def\tex{\begingroup - \catcode `\\=0 \catcode `\{=1 \catcode `\}=2 - \catcode `\$=3 \catcode `\&=4 \catcode `\#=6 - \catcode `\^=7 \catcode `\_=8 \catcode `\~=13 \let~=\tie - \catcode `\%=14 - \catcode 43=12 % plus - \catcode`\"=12 - \catcode`\==12 - \catcode`\|=12 - \catcode`\<=12 - \catcode`\>=12 - \escapechar=`\\ - % - \let\b=\ptexb - \let\bullet=\ptexbullet - \let\c=\ptexc - \let\,=\ptexcomma - \let\.=\ptexdot - \let\dots=\ptexdots - \let\equiv=\ptexequiv - \let\!=\ptexexclam - \let\i=\ptexi - \let\{=\ptexlbrace - \let\}=\ptexrbrace - \let\*=\ptexstar - \let\t=\ptext - % - \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}% - \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}% - \def\@{@}% -\let\Etex=\endgroup} - -% Define @lisp ... @endlisp. -% @lisp does a \begingroup so it can rebind things, -% including the definition of @endlisp (which normally is erroneous). - -% Amount to narrow the margins by for @lisp. -\newskip\lispnarrowing \lispnarrowing=0.4in - -% This is the definition that ^^M gets inside @lisp, @example, and other -% such environments. \null is better than a space, since it doesn't -% have any width. -\def\lisppar{\null\endgraf} - -% Make each space character in the input produce a normal interword -% space in the output. Don't allow a line break at this space, as this -% is used only in environments like @example, where each line of input -% should produce a line of output anyway. -% -{\obeyspaces % -\gdef\sepspaces{\obeyspaces\let =\tie}} - -% Define \obeyedspace to be our active space, whatever it is. This is -% for use in \parsearg. -{\sepspaces% -\global\let\obeyedspace= } - -% This space is always present above and below environments. -\newskip\envskipamount \envskipamount = 0pt - -% Make spacing and below environment symmetrical. We use \parskip here -% to help in doing that, since in @example-like environments \parskip -% is reset to zero; thus the \afterenvbreak inserts no space -- but the -% start of the next paragraph will insert \parskip -% -\def\aboveenvbreak{{\advance\envskipamount by \parskip -\endgraf \ifdim\lastskip<\envskipamount -\removelastskip \penalty-50 \vskip\envskipamount \fi}} - -\let\afterenvbreak = \aboveenvbreak - -% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins. -\let\nonarrowing=\relax - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% \cartouche: draw rectangle w/rounded corners around argument -\font\circle=lcircle10 -\newdimen\circthick -\newdimen\cartouter\newdimen\cartinner -\newskip\normbskip\newskip\normpskip\newskip\normlskip -\circthick=\fontdimen8\circle -% -\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth -\def\ctr{{\hskip 6pt\circle\char'010}} -\def\cbl{{\circle\char'012\hskip -6pt}} -\def\cbr{{\hskip 6pt\circle\char'011}} -\def\carttop{\hbox to \cartouter{\hskip\lskip - \ctl\leaders\hrule height\circthick\hfil\ctr - \hskip\rskip}} -\def\cartbot{\hbox to \cartouter{\hskip\lskip - \cbl\leaders\hrule height\circthick\hfil\cbr - \hskip\rskip}} -% -\newskip\lskip\newskip\rskip - -\long\def\cartouche{% -\begingroup - \lskip=\leftskip \rskip=\rightskip - \leftskip=0pt\rightskip=0pt %we want these *outside*. - \cartinner=\hsize \advance\cartinner by-\lskip - \advance\cartinner by-\rskip - \cartouter=\hsize - \advance\cartouter by 18pt % allow for 3pt kerns on either -% side, and for 6pt waste from -% each corner char - \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip - % Flag to tell @lisp, etc., not to narrow margin. - \let\nonarrowing=\comment - \vbox\bgroup - \baselineskip=0pt\parskip=0pt\lineskip=0pt - \carttop - \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \hsize=\cartinner - \kern3pt - \begingroup - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip -\def\Ecartouche{% - \endgroup - \kern3pt - \egroup - \kern3pt\vrule - \hskip\rskip - \egroup - \cartbot - \egroup -\endgroup -}} - - -% This macro is called at the beginning of all the @example variants, -% inside a group. -\def\nonfillstart{% - \aboveenvbreak - \inENV % This group ends at the end of the body - \hfuzz = 12pt % Don't be fussy - \sepspaces % Make spaces be word-separators rather than space tokens. - \singlespace - \let\par = \lisppar % don't ignore blank lines - \obeylines % each line of input is a line of output - \parskip = 0pt - \parindent = 0pt - \emergencystretch = 0pt % don't try to avoid overfull boxes - % @cartouche defines \nonarrowing to inhibit narrowing - % at next level down. - \ifx\nonarrowing\relax - \advance \leftskip by \lispnarrowing - \exdentamount=\lispnarrowing - \let\exdent=\nofillexdent - \let\nonarrowing=\relax - \fi -} - -% To ending an @example-like environment, we first end the paragraph -% (via \afterenvbreak's vertical glue), and then the group. That way we -% keep the zero \parskip that the environments set -- \parskip glue -% will be inserted at the beginning of the next paragraph in the -% document, after the environment. -% -\def\nonfillfinish{\afterenvbreak\endgroup}% - -\def\lisp{\begingroup - \nonfillstart - \let\Elisp = \nonfillfinish - \tt - % Make @kbd do something special, if requested. - \let\kbdfont\kbdexamplefont - \rawbackslash % have \ input char produce \ char from current font - \gobble -} - -% Define the \E... control sequence only if we are inside the -% environment, so the error checking in \end will work. -% -% We must call \lisp last in the definition, since it reads the -% return following the @example (or whatever) command. -% -\def\example{\begingroup \def\Eexample{\nonfillfinish\endgroup}\lisp} -\def\smallexample{\begingroup \def\Esmallexample{\nonfillfinish\endgroup}\lisp} -\def\smalllisp{\begingroup \def\Esmalllisp{\nonfillfinish\endgroup}\lisp} - -% @smallexample and @smalllisp. This is not used unless the @smallbook -% command is given. Originally contributed by Pavel@xerox. -% -\def\smalllispx{\begingroup - \nonfillstart - \let\Esmalllisp = \nonfillfinish - \let\Esmallexample = \nonfillfinish - % - % Smaller fonts for small examples. - \indexfonts \tt - \rawbackslash % make \ output the \ character from the current font (tt) - \gobble -} - -% This is @display; same as @lisp except use roman font. -% -\def\display{\begingroup - \nonfillstart - \let\Edisplay = \nonfillfinish - \gobble -} - -% This is @format; same as @display except don't narrow margins. -% -\def\format{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eformat = \nonfillfinish - \gobble -} - -% @flushleft (same as @format) and @flushright. -% -\def\flushleft{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eflushleft = \nonfillfinish - \gobble -} -\def\flushright{\begingroup - \let\nonarrowing = t - \nonfillstart - \let\Eflushright = \nonfillfinish - \advance\leftskip by 0pt plus 1fill - \gobble} - -% @quotation does normal linebreaking (hence we can't use \nonfillstart) -% and narrows the margins. -% -\def\quotation{% - \begingroup\inENV %This group ends at the end of the @quotation body - {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip - \singlespace - \parindent=0pt - % We have retained a nonzero parskip for the environment, since we're - % doing normal filling. So to avoid extra space below the environment... - \def\Equotation{\parskip = 0pt \nonfillfinish}% - % - % @cartouche defines \nonarrowing to inhibit narrowing at next level down. - \ifx\nonarrowing\relax - \advance\leftskip by \lispnarrowing - \advance\rightskip by \lispnarrowing - \exdentamount = \lispnarrowing - \let\nonarrowing = \relax - \fi -} - -\message{defuns,} -% Define formatter for defuns -% First, allow user to change definition object font (\df) internally -\def\setdeffont #1 {\csname DEF#1\endcsname} - -\newskip\defbodyindent \defbodyindent=.4in -\newskip\defargsindent \defargsindent=50pt -\newskip\deftypemargin \deftypemargin=12pt -\newskip\deflastargmargin \deflastargmargin=18pt - -\newcount\parencount -% define \functionparens, which makes ( and ) and & do special things. -% \functionparens affects the group it is contained in. -\def\activeparens{% -\catcode`\(=\active \catcode`\)=\active \catcode`\&=\active -\catcode`\[=\active \catcode`\]=\active} - -% Make control sequences which act like normal parenthesis chars. -\let\lparen = ( \let\rparen = ) - -{\activeparens % Now, smart parens don't turn on until &foo (see \amprm) - -% Be sure that we always have a definition for `(', etc. For example, -% if the fn name has parens in it, \boldbrax will not be in effect yet, -% so TeX would otherwise complain about undefined control sequence. -\global\let(=\lparen \global\let)=\rparen -\global\let[=\lbrack \global\let]=\rbrack - -\gdef\functionparens{\boldbrax\let&=\amprm\parencount=0 } -\gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} -% This is used to turn on special parens -% but make & act ordinary (given that it's active). -\gdef\boldbraxnoamp{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb\let&=\ampnr} - -% Definitions of (, ) and & used in args for functions. -% This is the definition of ( outside of all parentheses. -\gdef\oprm#1 {{\rm\char`\(}#1 \bf \let(=\opnested - \global\advance\parencount by 1 -} -% -% This is the definition of ( when already inside a level of parens. -\gdef\opnested{\char`\(\global\advance\parencount by 1 } -% -\gdef\clrm{% Print a paren in roman if it is taking us back to depth of 0. - % also in that case restore the outer-level definition of (. - \ifnum \parencount=1 {\rm \char `\)}\sl \let(=\oprm \else \char `\) \fi - \global\advance \parencount by -1 } -% If we encounter &foo, then turn on ()-hacking afterwards -\gdef\amprm#1 {{\rm\}\let(=\oprm \let)=\clrm\ } -% -\gdef\normalparens{\boldbrax\let&=\ampnr} -} % End of definition inside \activeparens -%% These parens (in \boldbrax) actually are a little bolder than the -%% contained text. This is especially needed for [ and ] -\def\opnr{{\sf\char`\(}\global\advance\parencount by 1 } -\def\clnr{{\sf\char`\)}\global\advance\parencount by -1 } -\def\ampnr{\&} -\def\lbrb{{\bf\char`\[}} -\def\rbrb{{\bf\char`\]}} - -% First, defname, which formats the header line itself. -% #1 should be the function name. -% #2 should be the type of definition, such as "Function". - -\def\defname #1#2{% -% Get the values of \leftskip and \rightskip as they were -% outside the @def... -\dimen2=\leftskip -\advance\dimen2 by -\defbodyindent -\dimen3=\rightskip -\advance\dimen3 by -\defbodyindent -\noindent % -\setbox0=\hbox{\hskip \deflastargmargin{\rm #2}\hskip \deftypemargin}% -\dimen0=\hsize \advance \dimen0 by -\wd0 % compute size for first line -\dimen1=\hsize \advance \dimen1 by -\defargsindent %size for continuations -\parshape 2 0in \dimen0 \defargsindent \dimen1 % -% Now output arg 2 ("Function" or some such) -% ending at \deftypemargin from the right margin, -% but stuck inside a box of width 0 so it does not interfere with linebreaking -{% Adjust \hsize to exclude the ambient margins, -% so that \rightline will obey them. -\advance \hsize by -\dimen2 \advance \hsize by -\dimen3 -\rlap{\rightline{{\rm #2}\hskip \deftypemargin}}}% -% Make all lines underfull and no complaints: -\tolerance=10000 \hbadness=10000 -\advance\leftskip by -\defbodyindent -\exdentamount=\defbodyindent -{\df #1}\enskip % Generate function name -} - -% Actually process the body of a definition -% #1 should be the terminating control sequence, such as \Edefun. -% #2 should be the "another name" control sequence, such as \defunx. -% #3 should be the control sequence that actually processes the header, -% such as \defunheader. - -\def\defparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2{\begingroup\obeylines\activeparens\spacesplit#3}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup % -\catcode 61=\active % 61 is `=' -\obeylines\activeparens\spacesplit#3} - -\def\defmethparsebody #1#2#3#4 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 {\begingroup\obeylines\activeparens\spacesplit{#3{##1}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\activeparens\spacesplit{#3{#4}}} - -\def\defopparsebody #1#2#3#4#5 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 ##2 {\def#4{##1}% -\begingroup\obeylines\activeparens\spacesplit{#3{##2}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\activeparens\spacesplit{#3{#5}}} - -% These parsing functions are similar to the preceding ones -% except that they do not make parens into active characters. -% These are used for "variables" since they have no arguments. - -\def\defvarparsebody #1#2#3{\begingroup\inENV% Environment for definitionbody -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2{\begingroup\obeylines\spacesplit#3}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup % -\catcode 61=\active % -\obeylines\spacesplit#3} - -% This is used for \def{tp,vr}parsebody. It could probably be used for -% some of the others, too, with some judicious conditionals. -% -\def\parsebodycommon#1#2#3{% - \begingroup\inENV % - \medbreak % - % Define the end token that this defining construct specifies - % so that it will exit this group. - \def#1{\endgraf\endgroup\medbreak}% - \def#2##1 {\begingroup\obeylines\spacesplit{#3{##1}}}% - \parindent=0in - \advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent - \exdentamount=\defbodyindent - \begingroup\obeylines -} - -\def\defvrparsebody#1#2#3#4 {% - \parsebodycommon{#1}{#2}{#3}% - \spacesplit{#3{#4}}% -} - -% This loses on `@deftp {Data Type} {struct termios}' -- it thinks the -% type is just `struct', because we lose the braces in `{struct -% termios}' when \spacesplit reads its undelimited argument. Sigh. -% \let\deftpparsebody=\defvrparsebody -% -% So, to get around this, we put \empty in with the type name. That -% way, TeX won't find exactly `{...}' as an undelimited argument, and -% won't strip off the braces. -% -\def\deftpparsebody #1#2#3#4 {% - \parsebodycommon{#1}{#2}{#3}% - \spacesplit{\parsetpheaderline{#3{#4}}}\empty -} - -% Fine, but then we have to eventually remove the \empty *and* the -% braces (if any). That's what this does. -% -\def\removeemptybraces\empty#1\relax{#1} - -% After \spacesplit has done its work, this is called -- #1 is the final -% thing to call, #2 the type name (which starts with \empty), and #3 -% (which might be empty) the arguments. -% -\def\parsetpheaderline#1#2#3{% - #1{\removeemptybraces#2\relax}{#3}% -}% - -\def\defopvarparsebody #1#2#3#4#5 {\begingroup\inENV % -\medbreak % -% Define the end token that this defining construct specifies -% so that it will exit this group. -\def#1{\endgraf\endgroup\medbreak}% -\def#2##1 ##2 {\def#4{##1}% -\begingroup\obeylines\spacesplit{#3{##2}}}% -\parindent=0in -\advance\leftskip by \defbodyindent \advance \rightskip by \defbodyindent -\exdentamount=\defbodyindent -\begingroup\obeylines\spacesplit{#3{#5}}} - -% Split up #2 at the first space token. -% call #1 with two arguments: -% the first is all of #2 before the space token, -% the second is all of #2 after that space token. -% If #2 contains no space token, all of it is passed as the first arg -% and the second is passed as empty. - -{\obeylines -\gdef\spacesplit#1#2^^M{\endgroup\spacesplitfoo{#1}#2 \relax\spacesplitfoo}% -\long\gdef\spacesplitfoo#1#2 #3#4\spacesplitfoo{% -\ifx\relax #3% -#1{#2}{}\else #1{#2}{#3#4}\fi}} - -% So much for the things common to all kinds of definitions. - -% Define @defun. - -% First, define the processing that is wanted for arguments of \defun -% Use this to expand the args and terminate the paragraph they make up - -\def\defunargs #1{\functionparens \sl -% Expand, preventing hyphenation at `-' chars. -% Note that groups don't affect changes in \hyphenchar. -\hyphenchar\tensl=0 -#1% -\hyphenchar\tensl=45 -\ifnum\parencount=0 \else \errmessage{Unbalanced parentheses in @def}\fi% -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% -} - -\def\deftypefunargs #1{% -% Expand, preventing hyphenation at `-' chars. -% Note that groups don't affect changes in \hyphenchar. -% Use \boldbraxnoamp, not \functionparens, so that & is not special. -\boldbraxnoamp -\tclose{#1}% avoid \code because of side effects on active chars -\interlinepenalty=10000 -\advance\rightskip by 0pt plus 1fil -\endgraf\penalty 10000\vskip -\parskip\penalty 10000% -} - -% Do complete processing of one @defun or @defunx line already parsed. - -% @deffn Command forward-char nchars - -\def\deffn{\defmethparsebody\Edeffn\deffnx\deffnheader} - -\def\deffnheader #1#2#3{\doind {fn}{\code{#2}}% -\begingroup\defname {#2}{#1}\defunargs{#3}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defun == @deffn Function - -\def\defun{\defparsebody\Edefun\defunx\defunheader} - -\def\defunheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Function}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @deftypefun int foobar (int @var{foo}, float @var{bar}) - -\def\deftypefun{\defparsebody\Edeftypefun\deftypefunx\deftypefunheader} - -% #1 is the data type. #2 is the name and args. -\def\deftypefunheader #1#2{\deftypefunheaderx{#1}#2 \relax} -% #1 is the data type, #2 the name, #3 the args. -\def\deftypefunheaderx #1#2 #3\relax{% -\doind {fn}{\code{#2}}% Make entry in function index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Function}% -\deftypefunargs {#3}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar}) - -\def\deftypefn{\defmethparsebody\Edeftypefn\deftypefnx\deftypefnheader} - -% \defheaderxcond#1\relax$$$ -% puts #1 in @code, followed by a space, but does nothing if #1 is null. -\def\defheaderxcond#1#2$$${\ifx#1\relax\else\code{#1#2} \fi} - -% #1 is the classification. #2 is the data type. #3 is the name and args. -\def\deftypefnheader #1#2#3{\deftypefnheaderx{#1}{#2}#3 \relax} -% #1 is the classification, #2 the data type, #3 the name, #4 the args. -\def\deftypefnheaderx #1#2#3 #4\relax{% -\doind {fn}{\code{#3}}% Make entry in function index -\begingroup -\normalparens % notably, turn off `&' magic, which prevents -% at least some C++ text from working -\defname {\defheaderxcond#2\relax$$$#3}{#1}% -\deftypefunargs {#4}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defmac == @deffn Macro - -\def\defmac{\defparsebody\Edefmac\defmacx\defmacheader} - -\def\defmacheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Macro}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% @defspec == @deffn Special Form - -\def\defspec{\defparsebody\Edefspec\defspecx\defspecheader} - -\def\defspecheader #1#2{\doind {fn}{\code{#1}}% Make entry in function index -\begingroup\defname {#1}{Special Form}% -\defunargs {#2}\endgroup % -\catcode 61=\other % Turn off change made in \defparsebody -} - -% This definition is run if you use @defunx -% anywhere other than immediately after a @defun or @defunx. - -\def\deffnx #1 {\errmessage{@deffnx in invalid context}} -\def\defunx #1 {\errmessage{@defunx in invalid context}} -\def\defmacx #1 {\errmessage{@defmacx in invalid context}} -\def\defspecx #1 {\errmessage{@defspecx in invalid context}} -\def\deftypefnx #1 {\errmessage{@deftypefnx in invalid context}} -\def\deftypemethodx #1 {\errmessage{@deftypemethodx in invalid context}} -\def\deftypeunx #1 {\errmessage{@deftypeunx in invalid context}} - -% @defmethod, and so on - -% @defop {Funny Method} foo-class frobnicate argument - -\def\defop #1 {\def\defoptype{#1}% -\defopparsebody\Edefop\defopx\defopheader\defoptype} - -\def\defopheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% Make entry in function index -\begingroup\defname {#2}{\defoptype{} on #1}% -\defunargs {#3}\endgroup % -} - -% @deftypemethod foo-class return-type foo-method args -% -\def\deftypemethod{% - \defmethparsebody\Edeftypemethod\deftypemethodx\deftypemethodheader} -% -% #1 is the class name, #2 the data type, #3 the method name, #4 the args. -\def\deftypemethodheader#1#2#3#4{% - \deftypefnheaderx{Method on #1}{#2}#3 #4\relax -} - -% @defmethod == @defop Method - -\def\defmethod{\defmethparsebody\Edefmethod\defmethodx\defmethodheader} - -\def\defmethodheader #1#2#3{% -\dosubind {fn}{\code{#2}}{on #1}% entry in function index -\begingroup\defname {#2}{Method on #1}% -\defunargs {#3}\endgroup % -} - -% @defcv {Class Option} foo-class foo-flag - -\def\defcv #1 {\def\defcvtype{#1}% -\defopvarparsebody\Edefcv\defcvx\defcvarheader\defcvtype} - -\def\defcvarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{\defcvtype{} of #1}% -\defvarargs {#3}\endgroup % -} - -% @defivar == @defcv {Instance Variable} - -\def\defivar{\defvrparsebody\Edefivar\defivarx\defivarheader} - -\def\defivarheader #1#2#3{% -\dosubind {vr}{\code{#2}}{of #1}% Make entry in var index -\begingroup\defname {#2}{Instance Variable of #1}% -\defvarargs {#3}\endgroup % -} - -% These definitions are run if you use @defmethodx, etc., -% anywhere other than immediately after a @defmethod, etc. - -\def\defopx #1 {\errmessage{@defopx in invalid context}} -\def\defmethodx #1 {\errmessage{@defmethodx in invalid context}} -\def\defcvx #1 {\errmessage{@defcvx in invalid context}} -\def\defivarx #1 {\errmessage{@defivarx in invalid context}} - -% Now @defvar - -% First, define the processing that is wanted for arguments of @defvar. -% This is actually simple: just print them in roman. -% This must expand the args and terminate the paragraph they make up -\def\defvarargs #1{\normalparens #1% -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000} - -% @defvr Counter foo-count - -\def\defvr{\defvrparsebody\Edefvr\defvrx\defvrheader} - -\def\defvrheader #1#2#3{\doind {vr}{\code{#2}}% -\begingroup\defname {#2}{#1}\defvarargs{#3}\endgroup} - -% @defvar == @defvr Variable - -\def\defvar{\defvarparsebody\Edefvar\defvarx\defvarheader} - -\def\defvarheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{Variable}% -\defvarargs {#2}\endgroup % -} - -% @defopt == @defvr {User Option} - -\def\defopt{\defvarparsebody\Edefopt\defoptx\defoptheader} - -\def\defoptheader #1#2{\doind {vr}{\code{#1}}% Make entry in var index -\begingroup\defname {#1}{User Option}% -\defvarargs {#2}\endgroup % -} - -% @deftypevar int foobar - -\def\deftypevar{\defvarparsebody\Edeftypevar\deftypevarx\deftypevarheader} - -% #1 is the data type. #2 is the name, perhaps followed by text that -% is actually part of the data type, which should not be put into the index. -\def\deftypevarheader #1#2{% -\dovarind#2 \relax% Make entry in variables index -\begingroup\defname {\defheaderxcond#1\relax$$$#2}{Variable}% -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 -\endgroup} -\def\dovarind#1 #2\relax{\doind{vr}{\code{#1}}} - -% @deftypevr {Global Flag} int enable - -\def\deftypevr{\defvrparsebody\Edeftypevr\deftypevrx\deftypevrheader} - -\def\deftypevrheader #1#2#3{\dovarind#3 \relax% -\begingroup\defname {\defheaderxcond#2\relax$$$#3}{#1} -\interlinepenalty=10000 -\endgraf\penalty 10000\vskip -\parskip\penalty 10000 -\endgroup} - -% This definition is run if you use @defvarx -% anywhere other than immediately after a @defvar or @defvarx. - -\def\defvrx #1 {\errmessage{@defvrx in invalid context}} -\def\defvarx #1 {\errmessage{@defvarx in invalid context}} -\def\defoptx #1 {\errmessage{@defoptx in invalid context}} -\def\deftypevarx #1 {\errmessage{@deftypevarx in invalid context}} -\def\deftypevrx #1 {\errmessage{@deftypevrx in invalid context}} - -% Now define @deftp -% Args are printed in bold, a slight difference from @defvar. - -\def\deftpargs #1{\bf \defvarargs{#1}} - -% @deftp Class window height width ... - -\def\deftp{\deftpparsebody\Edeftp\deftpx\deftpheader} - -\def\deftpheader #1#2#3{\doind {tp}{\code{#2}}% -\begingroup\defname {#2}{#1}\deftpargs{#3}\endgroup} - -% This definition is run if you use @deftpx, etc -% anywhere other than immediately after a @deftp, etc. - -\def\deftpx #1 {\errmessage{@deftpx in invalid context}} - - -\message{cross reference,} -% Define cross-reference macros -\newwrite \auxfile - -\newif\ifhavexrefs % True if xref values are known. -\newif\ifwarnedxrefs % True if we warned once that they aren't known. - -% @inforef is simple. -\def\inforef #1{\inforefzzz #1,,,,**} -\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, - node \samp{\ignorespaces#1{}}} - -% \setref{foo} defines a cross-reference point named foo. - -\def\setref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ysectionnumberandtype}} - -\def\unnumbsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Ynothing}} - -\def\appendixsetref#1{% -\dosetq{#1-title}{Ytitle}% -\dosetq{#1-pg}{Ypagenumber}% -\dosetq{#1-snt}{Yappendixletterandtype}} - -% \xref, \pxref, and \ref generate cross-references to specified points. -% For \xrefX, #1 is the node name, #2 the name of the Info -% cross-reference, #3 the printed node name, #4 the name of the Info -% file, #5 the name of the printed manual. All but the node name can be -% omitted. -% -\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]} -\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]} -\def\ref#1{\xrefX[#1,,,,,,,]} -\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup - \def\printedmanual{\ignorespaces #5}% - \def\printednodename{\ignorespaces #3}% - \setbox1=\hbox{\printedmanual}% - \setbox0=\hbox{\printednodename}% - \ifdim \wd0 = 0pt - % No printed node name was explicitly given. - \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax - % Use the node name inside the square brackets. - \def\printednodename{\ignorespaces #1}% - \else - % Use the actual chapter/section title appear inside - % the square brackets. Use the real section title if we have it. - \ifdim \wd1>0pt% - % It is in another manual, so we don't have it. - \def\printednodename{\ignorespaces #1}% - \else - \ifhavexrefs - % We know the real title if we have the xref values. - \def\printednodename{\refx{#1-title}{}}% - \else - % Otherwise just copy the Info node name. - \def\printednodename{\ignorespaces #1}% - \fi% - \fi - \fi - \fi - % - % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not - % insert empty discretionaries after hyphens, which means that it will - % not find a line break at a hyphen in a node names. Since some manuals - % are best written with fairly long node names, containing hyphens, this - % is a loss. Therefore, we give the text of the node name again, so it - % is as if TeX is seeing it for the first time. - \ifdim \wd1 > 0pt - \putwordsection{} ``\printednodename'' in \cite{\printedmanual}% - \else - % _ (for example) has to be the character _ for the purposes of the - % control sequence corresponding to the node, but it has to expand - % into the usual \leavevmode...\vrule stuff for purposes of - % printing. So we \turnoffactive for the \refx-snt, back on for the - % printing, back off for the \refx-pg. - {\turnoffactive \refx{#1-snt}{}}% - \space [\printednodename],\space - \turnoffactive \putwordpage\tie\refx{#1-pg}{}% - \fi -\endgroup} - -% \dosetq is the interface for calls from other macros - -% Use \turnoffactive so that punctuation chars such as underscore -% work in node names. -\def\dosetq #1#2{{\let\folio=0 \turnoffactive -\edef\next{\write\auxfile{\internalsetq {#1}{#2}}}% -\next}} - -% \internalsetq {foo}{page} expands into -% CHARACTERS 'xrdef {foo}{...expansion of \Ypage...} -% When the aux file is read, ' is the escape character - -\def\internalsetq #1#2{'xrdef {#1}{\csname #2\endcsname}} - -% Things to be expanded by \internalsetq - -\def\Ypagenumber{\folio} - -\def\Ytitle{\thissection} - -\def\Ynothing{} - -\def\Ysectionnumberandtype{% -\ifnum\secno=0 \putwordChapter\xreftie\the\chapno % -\else \ifnum \subsecno=0 \putwordSection\xreftie\the\chapno.\the\secno % -\else \ifnum \subsubsecno=0 % -\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno % -\else % -\putwordSection\xreftie\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno % -\fi \fi \fi } - -\def\Yappendixletterandtype{% -\ifnum\secno=0 \putwordAppendix\xreftie'char\the\appendixno{}% -\else \ifnum \subsecno=0 \putwordSection\xreftie'char\the\appendixno.\the\secno % -\else \ifnum \subsubsecno=0 % -\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno % -\else % -\putwordSection\xreftie'char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno % -\fi \fi \fi } - -\gdef\xreftie{'tie} - -% Use TeX 3.0's \inputlineno to get the line number, for better error -% messages, but if we're using an old version of TeX, don't do anything. -% -\ifx\inputlineno\thisisundefined - \let\linenumber = \empty % Non-3.0. -\else - \def\linenumber{\the\inputlineno:\space} -\fi - -% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME. -% If its value is nonempty, SUFFIX is output afterward. - -\def\refx#1#2{% - \expandafter\ifx\csname X#1\endcsname\relax - % If not defined, say something at least. - \angleleft un\-de\-fined\angleright - \ifhavexrefs - \message{\linenumber Undefined cross reference `#1'.}% - \else - \ifwarnedxrefs\else - \global\warnedxrefstrue - \message{Cross reference values unknown; you must run TeX again.}% - \fi - \fi - \else - % It's defined, so just use it. - \csname X#1\endcsname - \fi - #2% Output the suffix in any case. -} - -% This is the macro invoked by entries in the aux file. -% -\def\xrdef#1{\begingroup - % Reenable \ as an escape while reading the second argument. - \catcode`\\ = 0 - \afterassignment\endgroup - \expandafter\gdef\csname X#1\endcsname -} - -% Read the last existing aux file, if any. No error if none exists. -\def\readauxfile{\begingroup - \catcode`\^^@=\other - \catcode`\^^A=\other - \catcode`\^^B=\other - \catcode`\^^C=\other - \catcode`\^^D=\other - \catcode`\^^E=\other - \catcode`\^^F=\other - \catcode`\^^G=\other - \catcode`\^^H=\other - \catcode`\^^K=\other - \catcode`\^^L=\other - \catcode`\^^N=\other - \catcode`\^^P=\other - \catcode`\^^Q=\other - \catcode`\^^R=\other - \catcode`\^^S=\other - \catcode`\^^T=\other - \catcode`\^^U=\other - \catcode`\^^V=\other - \catcode`\^^W=\other - \catcode`\^^X=\other - \catcode`\^^Z=\other - \catcode`\^^[=\other - \catcode`\^^\=\other - \catcode`\^^]=\other - \catcode`\^^^=\other - \catcode`\^^_=\other - \catcode`\@=\other - \catcode`\^=\other - % It was suggested to define this as 7, which would allow ^^e4 etc. - % in xref tags, i.e., node names. But since ^^e4 notation isn't - % supported in the main text, it doesn't seem desirable. Furthermore, - % that is not enough: for node names that actually contain a ^ - % character, we would end up writing a line like this: 'xrdef {'hat - % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first - % argument, and \hat is not an expandable control sequence. It could - % all be worked out, but why? Either we support ^^ or we don't. - % - % The other change necessary for this was to define \auxhat: - % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter - % and then to call \auxhat in \setq. - % - \catcode`\~=\other - \catcode`\[=\other - \catcode`\]=\other - \catcode`\"=\other - \catcode`\_=\other - \catcode`\|=\other - \catcode`\<=\other - \catcode`\>=\other - \catcode`\$=\other - \catcode`\#=\other - \catcode`\&=\other - % `\+ does not work, so use 43. - \catcode43=\other - % Make the characters 128-255 be printing characters - {% - \count 1=128 - \def\loop{% - \catcode\count 1=\other - \advance\count 1 by 1 - \ifnum \count 1<256 \loop \fi - }% - }% - % The aux file uses ' as the escape (for now). - % Turn off \ as an escape so we do not lose on - % entries which were dumped with control sequences in their names. - % For example, 'xrdef {$\leq $-fun}{page ...} made by @defun ^^ - % Reference to such entries still does not work the way one would wish, - % but at least they do not bomb out when the aux file is read in. - \catcode`\{=1 - \catcode`\}=2 - \catcode`\%=\other - \catcode`\'=0 - \catcode`\\=\other - % - \openin 1 \jobname.aux - \ifeof 1 \else - \closein 1 - \input \jobname.aux - \global\havexrefstrue - \global\warnedobstrue - \fi - % Open the new aux file. TeX will close it automatically at exit. - \openout\auxfile=\jobname.aux -\endgroup} - - -% Footnotes. - -\newcount \footnoteno - -% The trailing space in the following definition for supereject is -% vital for proper filling; pages come out unaligned when you do a -% pagealignmacro call if that space before the closing brace is -% removed. (Generally, numeric constants should always be followed by a -% space to prevent strange expansion errors.) -\def\supereject{\par\penalty -20000\footnoteno =0 } - -% @footnotestyle is meaningful for info output only. -\let\footnotestyle=\comment - -\let\ptexfootnote=\footnote - -{\catcode `\@=11 -% -% Auto-number footnotes. Otherwise like plain. -\gdef\footnote{% - \global\advance\footnoteno by \@ne - \edef\thisfootno{$^{\the\footnoteno}$}% - % - % In case the footnote comes at the end of a sentence, preserve the - % extra spacing after we do the footnote number. - \let\@sf\empty - \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi - % - % Remove inadvertent blank space before typesetting the footnote number. - \unskip - \thisfootno\@sf - \footnotezzz -}% - -% Don't bother with the trickery in plain.tex to not require the -% footnote text as a parameter. Our footnotes don't need to be so general. -% -% Oh yes, they do; otherwise, @ifset and anything else that uses -% \parseargline fail inside footnotes because the tokens are fixed when -% the footnote is read. --karl, 16nov96. -% -\long\gdef\footnotezzz{\insert\footins\bgroup - % We want to typeset this text as a normal paragraph, even if the - % footnote reference occurs in (for example) a display environment. - % So reset some parameters. - \interlinepenalty\interfootnotelinepenalty - \splittopskip\ht\strutbox % top baseline for broken footnotes - \splitmaxdepth\dp\strutbox - \floatingpenalty\@MM - \leftskip\z@skip - \rightskip\z@skip - \spaceskip\z@skip - \xspaceskip\z@skip - \parindent\defaultparindent - % - % Hang the footnote text off the number. - \hang - \textindent{\thisfootno}% - % - % Don't crash into the line above the footnote text. Since this - % expands into a box, it must come within the paragraph, lest it - % provide a place where TeX can split the footnote. - \footstrut - \futurelet\next\fo@t -} -\def\fo@t{\ifcat\bgroup\noexpand\next \let\next\f@@t - \else\let\next\f@t\fi \next} -\def\f@@t{\bgroup\aftergroup\@foot\let\next} -\def\f@t#1{#1\@foot} -\def\@foot{\strut\egroup} - -}%end \catcode `\@=11 - -% Set the baselineskip to #1, and the lineskip and strut size -% correspondingly. There is no deep meaning behind these magic numbers -% used as factors; they just match (closely enough) what Knuth defined. -% -\def\lineskipfactor{.08333} -\def\strutheightpercent{.70833} -\def\strutdepthpercent {.29167} -% -\def\setleading#1{% - \normalbaselineskip = #1\relax - \normallineskip = \lineskipfactor\normalbaselineskip - \normalbaselines - \setbox\strutbox =\hbox{% - \vrule width0pt height\strutheightpercent\baselineskip - depth \strutdepthpercent \baselineskip - }% -} - -% @| inserts a changebar to the left of the current line. It should -% surround any changed text. This approach does *not* work if the -% change spans more than two lines of output. To handle that, we would -% have adopt a much more difficult approach (putting marks into the main -% vertical list for the beginning and end of each change). -% -\def\|{% - % \vadjust can only be used in horizontal mode. - \leavevmode - % - % Append this vertical mode material after the current line in the output. - \vadjust{% - % We want to insert a rule with the height and depth of the current - % leading; that is exactly what \strutbox is supposed to record. - \vskip-\baselineskip - % - % \vadjust-items are inserted at the left edge of the type. So - % the \llap here moves out into the left-hand margin. - \llap{% - % - % For a thicker or thinner bar, change the `1pt'. - \vrule height\baselineskip width1pt - % - % This is the space between the bar and the text. - \hskip 12pt - }% - }% -} - -% For a final copy, take out the rectangles -% that mark overfull boxes (in case you have decided -% that the text looks ok even though it passes the margin). -% -\def\finalout{\overfullrule=0pt} - -% @image. We use the macros from epsf.tex to support this. -% If epsf.tex is not installed and @image is used, we complain. -% -% Check for and read epsf.tex up front. If we read it only at @image -% time, we might be inside a group, and then its definitions would get -% undone and the next image would fail. -\openin 1 = epsf.tex -\ifeof 1 \else - \closein 1 - \def\epsfannounce{\toks0 = }% do not bother showing banner - \input epsf.tex -\fi -% -\newif\ifwarnednoepsf -\newhelp\noepsfhelp{epsf.tex must be installed for images to - work. It is also included in the Texinfo distribution, or you can get - it from ftp://ftp.tug.org/tex/epsf.tex.} -% -% Only complain once about lack of epsf.tex. -\def\image#1{% - \ifx\epsfbox\undefined - \ifwarnednoepsf \else - \errhelp = \noepsfhelp - \errmessage{epsf.tex not found, images will be ignored}% - \global\warnednoepsftrue - \fi - \else - \imagexxx #1,,,\finish - \fi -} -% -% Arguments to @image: -% #1 is (mandatory) image filename; we tack on .eps extension. -% #2 is (optional) width, #3 is (optional) height. -% #4 is just the usual extra ignored arg for parsing this stuff. -\def\imagexxx#1,#2,#3,#4\finish{% - % \epsfbox itself resets \epsf?size at each figure. - \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi - \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi - \epsfbox{#1.eps}% -} - -% End of control word definitions. - - -\message{and turning on texinfo input format.} - -\def\openindices{% - \newindex{cp}% - \newcodeindex{fn}% - \newcodeindex{vr}% - \newcodeindex{tp}% - \newcodeindex{ky}% - \newcodeindex{pg}% -} - -% Set some numeric style parameters, for 8.5 x 11 format. - -\hsize = 6in -\hoffset = .25in -\newdimen\defaultparindent \defaultparindent = 15pt -\parindent = \defaultparindent -\parskip 3pt plus 2pt minus 1pt -\setleading{13.2pt} -\advance\topskip by 1.2cm - -\chapheadingskip = 15pt plus 4pt minus 2pt -\secheadingskip = 12pt plus 3pt minus 2pt -\subsecheadingskip = 9pt plus 2pt minus 2pt - -% Prevent underfull vbox error messages. -\vbadness=10000 - -% Following George Bush, just get rid of widows and orphans. -\widowpenalty=10000 -\clubpenalty=10000 - -% Use TeX 3.0's \emergencystretch to help line breaking, but if we're -% using an old version of TeX, don't do anything. We want the amount of -% stretch added to depend on the line length, hence the dependence on -% \hsize. This makes it come to about 9pt for the 8.5x11 format. -% -\ifx\emergencystretch\thisisundefined - % Allow us to assign to \emergencystretch anyway. - \def\emergencystretch{\dimen0}% -\else - \emergencystretch = \hsize - \divide\emergencystretch by 45 -\fi - -% Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25) -\def\smallbook{ - \global\chapheadingskip = 15pt plus 4pt minus 2pt - \global\secheadingskip = 12pt plus 3pt minus 2pt - \global\subsecheadingskip = 9pt plus 2pt minus 2pt - % - \global\lispnarrowing = 0.3in - \setleading{12pt} - \advance\topskip by -1cm - \global\parskip 2pt plus 1pt - \global\hsize = 5in - \global\vsize=7.5in - \global\tolerance=700 - \global\hfuzz=1pt - \global\contentsrightmargin=0pt - \global\deftypemargin=0pt - \global\defbodyindent=.5cm - % - \global\pagewidth=\hsize - \global\pageheight=\vsize - % - \global\let\smalllisp=\smalllispx - \global\let\smallexample=\smalllispx - \global\def\Esmallexample{\Esmalllisp} -} - -% Use @afourpaper to print on European A4 paper. -\def\afourpaper{ -\global\tolerance=700 -\global\hfuzz=1pt -\setleading{12pt} -\global\parskip 15pt plus 1pt - -\global\vsize= 53\baselineskip -\advance\vsize by \topskip -%\global\hsize= 5.85in % A4 wide 10pt -\global\hsize= 6.5in -\global\outerhsize=\hsize -\global\advance\outerhsize by 0.5in -\global\outervsize=\vsize -\global\advance\outervsize by 0.6in - -\global\pagewidth=\hsize -\global\pageheight=\vsize -} - -\bindingoffset=0pt -\normaloffset=\hoffset -\pagewidth=\hsize -\pageheight=\vsize - -% Allow control of the text dimensions. Parameters in order: textheight; -% textwidth; voffset; hoffset; binding offset; topskip. -% All require a dimension; -% header is additional; added length extends the bottom of the page. - -\def\changepagesizes#1#2#3#4#5#6{ - \global\vsize= #1 - \global\topskip= #6 - \advance\vsize by \topskip - \global\voffset= #3 - \global\hsize= #2 - \global\outerhsize=\hsize - \global\advance\outerhsize by 0.5in - \global\outervsize=\vsize - \global\advance\outervsize by 0.6in - \global\pagewidth=\hsize - \global\pageheight=\vsize - \global\normaloffset= #4 - \global\bindingoffset= #5} - -% A specific text layout, 24x15cm overall, intended for A4 paper. Top margin -% 29mm, hence bottom margin 28mm, nominal side margin 3cm. -\def\afourlatex - {\global\tolerance=700 - \global\hfuzz=1pt - \setleading{12pt} - \global\parskip 15pt plus 1pt - \advance\baselineskip by 1.6pt - \changepagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm} - } - -% Use @afourwide to print on European A4 paper in wide format. -\def\afourwide{\afourpaper -\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}} - -% Define macros to output various characters with catcode for normal text. -\catcode`\"=\other -\catcode`\~=\other -\catcode`\^=\other -\catcode`\_=\other -\catcode`\|=\other -\catcode`\<=\other -\catcode`\>=\other -\catcode`\+=\other -\def\normaldoublequote{"} -\def\normaltilde{~} -\def\normalcaret{^} -\def\normalunderscore{_} -\def\normalverticalbar{|} -\def\normalless{<} -\def\normalgreater{>} -\def\normalplus{+} - -% This macro is used to make a character print one way in ttfont -% where it can probably just be output, and another way in other fonts, -% where something hairier probably needs to be done. -% -% #1 is what to print if we are indeed using \tt; #2 is what to print -% otherwise. Since all the Computer Modern typewriter fonts have zero -% interword stretch (and shrink), and it is reasonable to expect all -% typewriter fonts to have this, we can check that font parameter. -% -\def\ifusingtt#1#2{\ifdim \fontdimen3\the\font=0pt #1\else #2\fi} - -% Turn off all special characters except @ -% (and those which the user can use as if they were ordinary). -% Most of these we simply print from the \tt font, but for some, we can -% use math or other variants that look better in normal text. - -\catcode`\"=\active -\def\activedoublequote{{\tt \char '042}} -\let"=\activedoublequote -\catcode`\~=\active -\def~{{\tt \char '176}} -\chardef\hat=`\^ -\catcode`\^=\active -\def^{{\tt \hat}} - -\catcode`\_=\active -\def_{\ifusingtt\normalunderscore\_} -% Subroutine for the previous macro. -\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em height.1ex}} - -\catcode`\|=\active -\def|{{\tt \char '174}} -\chardef \less=`\< -\catcode`\<=\active -\def<{{\tt \less}} -\chardef \gtr=`\> -\catcode`\>=\active -\def>{{\tt \gtr}} -\catcode`\+=\active -\def+{{\tt \char 43}} -%\catcode 27=\active -%\def^^[{$\diamondsuit$} - -% Set up an active definition for =, but don't enable it most of the time. -{\catcode`\==\active -\global\def={{\tt \char 61}}} - -\catcode`+=\active -\catcode`\_=\active - -% If a .fmt file is being used, characters that might appear in a file -% name cannot be active until we have parsed the command line. -% So turn them off again, and have \everyjob (or @setfilename) turn them on. -% \otherifyactive is called near the end of this file. -\def\otherifyactive{\catcode`+=\other \catcode`\_=\other} - -\catcode`\@=0 - -% \rawbackslashxx output one backslash character in current font -\global\chardef\rawbackslashxx=`\\ -%{\catcode`\\=\other -%@gdef@rawbackslashxx{\}} - -% \rawbackslash redefines \ as input to do \rawbackslashxx. -{\catcode`\\=\active -@gdef@rawbackslash{@let\=@rawbackslashxx }} - -% \normalbackslash outputs one backslash in fixed width font. -\def\normalbackslash{{\tt\rawbackslashxx}} - -% Say @foo, not \foo, in error messages. -\escapechar=`\@ - -% \catcode 17=0 % Define control-q -\catcode`\\=\active - -% Used sometimes to turn off (effectively) the active characters -% even after parsing them. -@def@turnoffactive{@let"=@normaldoublequote -@let\=@realbackslash -@let~=@normaltilde -@let^=@normalcaret -@let_=@normalunderscore -@let|=@normalverticalbar -@let<=@normalless -@let>=@normalgreater -@let+=@normalplus} - -@def@normalturnoffactive{@let"=@normaldoublequote -@let\=@normalbackslash -@let~=@normaltilde -@let^=@normalcaret -@let_=@normalunderscore -@let|=@normalverticalbar -@let<=@normalless -@let>=@normalgreater -@let+=@normalplus} - -% Make _ and + \other characters, temporarily. -% This is canceled by @fixbackslash. -@otherifyactive - -% If a .fmt file is being used, we don't want the `\input texinfo' to show up. -% That is what \eatinput is for; after that, the `\' should revert to printing -% a backslash. -% -@gdef@eatinput input texinfo{@fixbackslash} -@global@let\ = @eatinput - -% On the other hand, perhaps the file did not have a `\input texinfo'. Then -% the first `\{ in the file would cause an error. This macro tries to fix -% that, assuming it is called before the first `\' could plausibly occur. -% Also back turn on active characters that might appear in the input -% file name, in case not using a pre-dumped format. -% -@gdef@fixbackslash{@ifx\@eatinput @let\ = @normalbackslash @fi - @catcode`+=@active @catcode`@_=@active} - -%% These look ok in all fonts, so just make them not special. The @rm below -%% makes sure that the current font starts out as the newly loaded cmr10 -@catcode`@$=@other @catcode`@%=@other @catcode`@&=@other @catcode`@#=@other - -@textfonts -@rm - -@c Local variables: -@c page-delimiter: "^\\\\message" -@c End: diff --git a/man/texinfo.texi b/man/texinfo.texi deleted file mode 100644 index db6ac4a..0000000 --- a/man/texinfo.texi +++ /dev/null @@ -1,17293 +0,0 @@ -\input texinfo.tex @c -*-texinfo-*- -@c $Id: texinfo.txi,v 1.50 1998/02/27 21:21:34 karl Exp $ -@c %**start of header - -@c All text is ignored before the setfilename. -@setfilename ../info/texinfo -@settitle Texinfo @value{edition} - -@c Edition number is now the same as the Texinfo distribution version number. -@set edition 3.12 -@set update-month February 1998 -@set update-date 27 @value{update-month} - -@c Define a new index for options. -@defcodeindex op -@c Put everything except function (command, in this case) names in one -@c index (arbitrarily chosen to be the concept index). -@syncodeindex op cp -@syncodeindex vr cp -@syncodeindex pg cp - -@footnotestyle separate -@paragraphindent 2 -@finalout -@comment %**end of header - -@c Before release, run C-u C-c C-u C-a (texinfo-all-menus-update with a -@c prefix arg). This updates the node pointers, which texinfmt.el needs. - -@dircategory Texinfo documentation system -@direntry -* Texinfo: (texinfo). The GNU documentation format. -* install-info: (texinfo)Invoking install-info. Updating info/dir entries. -* texi2dvi: (texinfo)Format with texi2dvi. Printing Texinfo documentation. -* texindex: (texinfo)Format with tex/texindex. Sorting Texinfo index files. -* makeinfo: (texinfo)makeinfo Preferred. Translate Texinfo source. -@end direntry - -@c Set smallbook if printing in smallbook format so the example of the -@c smallbook font is actually written using smallbook; in bigbook, a kludge -@c is used for TeX output. Do this through the -t option to texi2dvi, -@c so this same source can be used for other paper sizes as well. -@c smallbook -@c set smallbook -@c @@clear smallbook - -@c Currently undocumented command, 5 December 1993: -@c nwnode (Same as node, but no warnings; for `makeinfo'.) - -@ifinfo -This file documents Texinfo, a documentation system that can produce -both on-line information and a printed manual from a single source file. - -Copyright (C) 1988, 90, 91, 92, 93, 95, 96, 97, 98 -Free Software Foundation, Inc. - -This edition is for Texinfo version @value{edition}. - -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 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 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 - -@setchapternewpage odd - -@shorttitlepage Texinfo - -@titlepage -@c use the new format for titles -@title Texinfo -@subtitle The GNU Documentation Format -@subtitle for Texinfo version @value{edition} -@subtitle @value{update-month} - -@author Robert J.@: Chassell -@author Richard M.@: Stallman - -@c Include the Distribution inside the titlepage so -@c that headings are turned off. - -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1988, 90, 91, 92, 93, 95, 96, 97, 98 -Free Software Foundation, Inc. - -Published by the Free Software Foundation @* -59 Temple Place Suite 330 @* -Boston, MA 02111-1307 @* -USA @* -ISBN 1-882114-65-5 -@c ISBN 1-882114-63-9 is for edition 2.20 of 28 February 1995 -@c ISBN 1-882114-64-7 is for edition 2.24 of November 1996. - -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 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. -@sp 2 -Cover art by Etienne Suvasa. -@end titlepage - -@ifinfo -@node Top, Copying, (dir), (dir) -@top Texinfo - -Texinfo is a documentation system that uses a single source file to -produce both on-line information and printed output.@refill - -The first part of this master menu lists the major nodes in this Info -document, including the @@-command and concept indices. The rest of -the menu lists all the lower level nodes in the document.@refill - -This is Edition @value{edition} of the Texinfo documentation, -@w{@value{update-date}}. -@end ifinfo - -@c Here is a spare copy of the chapter menu entry descriptions, -@c in case they are accidently deleted -@ignore -Your rights. -Texinfo in brief. -How to use Texinfo mode. -What is at the beginning of a Texinfo file? -What is at the end of a Texinfo file? -How to create chapters, sections, subsections, - appendices, and other parts. -How to provide structure for a document. -How to write nodes. -How to write menus. -How to write cross references. -How to mark words and phrases as code, - keyboard input, meta-syntactic - variables, and the like. -How to write quotations, examples, etc. -How to write lists and tables. -How to create indices. -How to insert @@-signs, braces, etc. -How to indicate results of evaluation, - expansion of macros, errors, etc. -How to force and prevent line and page breaks. -How to describe functions and the like in a uniform manner. -How to write footnotes. -How to specify text for either @TeX{} or Info. -How to print hardcopy. -How to create an Info file. -How to install an Info file -A list of all the Texinfo @@-commands. -Hints on how to write a Texinfo document. -A sample Texinfo file to look at. -Tell readers they have the right to copy - and distribute. -How to incorporate other Texinfo files. -How to write page headings and footings. -How to find formatting mistakes. -All about paragraph refilling. -A description of @@-Command syntax. -Texinfo second edition features. -A menu containing commands and variables. -A menu covering many topics. -@end ignore - -@menu -* Copying:: Your rights. -* Overview:: Texinfo in brief. -* Texinfo Mode:: How to use Texinfo mode. -* Beginning a File:: What is at the beginning of a Texinfo file? -* Ending a File:: What is at the end of a Texinfo file? -* Structuring:: How to create chapters, sections, subsections, - appendices, and other parts. -* Nodes:: How to write nodes. -* Menus:: How to write menus. -* Cross References:: How to write cross references. -* Marking Text:: How to mark words and phrases as code, - keyboard input, meta-syntactic - variables, and the like. -* Quotations and Examples:: How to write quotations, examples, etc. -* Lists and Tables:: How to write lists and tables. -* Indices:: How to create indices. -* Insertions:: How to insert @@-signs, braces, etc. -* Breaks:: How to force and prevent line and page breaks. -* Definition Commands:: How to describe functions and the like - in a uniform manner. -* Footnotes:: How to write footnotes. -* Conditionals:: How to specify text for either @TeX{} or Info. -* Macros:: Defining new Texinfo commands. -* Format/Print Hardcopy:: How to convert a Texinfo file to a file - for printing and how to print that file. -* Create an Info File:: Convert a Texinfo file into an Info file. -* Install an Info File:: Make an Info file accessible to users. -* Command List:: All the Texinfo @@-commands. -* Tips:: Hints on how to write a Texinfo document. -* Sample Texinfo File:: A sample Texinfo file to look at. -* Sample Permissions:: Tell readers they have the right to copy - and distribute. -* Include Files:: How to incorporate other Texinfo files. -* Headings:: How to write page headings and footings. -* Catching Mistakes:: How to find formatting mistakes. -* Refilling Paragraphs:: All about paragraph refilling. -* Command Syntax:: A description of @@-Command syntax. -* Obtaining TeX:: How to Obtain @TeX{}. -* Command and Variable Index:: A menu containing commands and variables. -* Concept Index:: A menu covering many topics. - -@detailmenu - - --- The Detailed Node Listing --- - -Overview of Texinfo - -* Using Texinfo:: Create a conventional printed book - or an Info file. -* Info Files:: What is an Info file? -* Printed Books:: Characteristics of a printed book or manual. -* Formatting Commands:: @@-commands are used for formatting. -* Conventions:: General rules for writing a Texinfo file. -* Comments:: How to write comments and mark regions that - the formatting commands will ignore. -* Minimum:: What a Texinfo file must have. -* Six Parts:: Usually, a Texinfo file has six parts. -* Short Sample:: A short sample Texinfo file. -* Acknowledgements:: - -Using Texinfo Mode - -* Texinfo Mode Overview:: How Texinfo mode can help you. -* Emacs Editing:: Texinfo mode adds to GNU Emacs' general - purpose editing features. -* Inserting:: How to insert frequently used @@-commands. -* Showing the Structure:: How to show the structure of a file. -* Updating Nodes and Menus:: How to update or create new nodes and menus. -* Info Formatting:: How to format for Info. -* Printing:: How to format and print part or all of a file. -* Texinfo Mode Summary:: Summary of all the Texinfo mode commands. - -Updating Nodes and Menus - -* Updating Commands:: Five major updating commands. -* Updating Requirements:: How to structure a Texinfo file for - using the updating command. -* Other Updating Commands:: How to indent descriptions, insert - missing nodes lines, and update - nodes in sequence. - -Beginning a Texinfo File - -* Four Parts:: Four parts begin a Texinfo file. -* Sample Beginning:: Here is a sample beginning for a Texinfo file. -* Header:: The very beginning of a Texinfo file. -* Info Summary and Permissions:: Summary and copying permissions for Info. -* Titlepage & Copyright Page:: Creating the title and copyright pages. -* The Top Node:: Creating the `Top' node and master menu. -* Software Copying Permissions:: Ensure that you and others continue to - have the right to use and share software. - -The Texinfo File Header - -* First Line:: The first line of a Texinfo file. -* Start of Header:: Formatting a region requires this. -* setfilename:: Tell Info the name of the Info file. -* settitle:: Create a title for the printed work. -* setchapternewpage:: Start chapters on right-hand pages. -* paragraphindent:: An option to specify paragraph indentation. -* End of Header:: Formatting a region requires this. - -The Title and Copyright Pages - -* titlepage:: Create a title for the printed document. -* titlefont center sp:: The @code{@@titlefont}, @code{@@center}, - and @code{@@sp} commands. -* title subtitle author:: The @code{@@title}, @code{@@subtitle}, - and @code{@@author} commands. -* Copyright & Permissions:: How to write the copyright notice and - include copying permissions. -* end titlepage:: Turn on page headings after the title and - copyright pages. -* headings on off:: An option for turning headings on and off - and double or single sided printing. - -The `Top' Node and Master Menu - -* Title of Top Node:: Sketch what the file is about. -* Master Menu Parts:: A master menu has three or more parts. - -Ending a Texinfo File - -* Printing Indices & Menus:: How to print an index in hardcopy and - generate index menus in Info. -* Contents:: How to create a table of contents. -* File End:: How to mark the end of a file. - -Chapter Structuring - -* Tree Structuring:: A manual is like an upside down tree @dots{} -* Structuring Command Types:: How to divide a manual into parts. -* makeinfo top:: The @code{@@top} command, part of the `Top' node. -* chapter:: -* unnumbered & appendix:: -* majorheading & chapheading:: -* section:: -* unnumberedsec appendixsec heading:: -* subsection:: -* unnumberedsubsec appendixsubsec subheading:: -* subsubsection:: Commands for the lowest level sections. -* Raise/lower sections:: How to change commands' hierarchical level. - -Nodes - -* Two Paths:: Different commands to structure - Info output and printed output. -* Node Menu Illustration:: A diagram, and sample nodes and menus. -* node:: How to write a node, in detail. -* makeinfo Pointer Creation:: How to create node pointers with @code{makeinfo}. - -The @code{@@node} Command - -* Node Names:: How to choose node and pointer names. -* Writing a Node:: How to write an @code{@@node} line. -* Node Line Tips:: Keep names short. -* Node Line Requirements:: Keep names unique, without @@-commands. -* First Node:: How to write a `Top' node. -* makeinfo top command:: How to use the @code{@@top} command. -* Top Node Summary:: Write a brief description for readers. - -Menus - -* Menu Location:: Put a menu in a short node. -* Writing a Menu:: What is a menu? -* Menu Parts:: A menu entry has three parts. -* Less Cluttered Menu Entry:: Two part menu entry. -* Menu Example:: Two and three part menu entries. -* Other Info Files:: How to refer to a different Info file. - -Cross References - -* References:: What cross references are for. -* Cross Reference Commands:: A summary of the different commands. -* Cross Reference Parts:: A cross reference has several parts. -* xref:: Begin a reference with `See' @dots{} -* Top Node Naming:: How to refer to the beginning of another file. -* ref:: A reference for the last part of a sentence. -* pxref:: How to write a parenthetical cross reference. -* inforef:: How to refer to an Info-only file. -* uref:: How to refer to a uniform resource locator. - -@code{@@xref} - -* Reference Syntax:: What a reference looks like and requires. -* One Argument:: @code{@@xref} with one argument. -* Two Arguments:: @code{@@xref} with two arguments. -* Three Arguments:: @code{@@xref} with three arguments. -* Four and Five Arguments:: @code{@@xref} with four and five arguments. - -Marking Words and Phrases - -* Indicating:: How to indicate definitions, files, etc. -* Emphasis:: How to emphasize text. - -Indicating Definitions, Commands, etc. - -* Useful Highlighting:: Highlighting provides useful information. -* code:: How to indicate code. -* kbd:: How to show keyboard input. -* key:: How to specify keys. -* samp:: How to show a literal sequence of characters. -* var:: How to indicate a metasyntactic variable. -* file:: How to indicate the name of a file. -* dfn:: How to specify a definition. -* cite:: How to refer to a book that is not in Info. -* url:: How to indicate a world wide web reference. -* email:: How to indicate an electronic mail address. - -Emphasizing Text - -* emph & strong:: How to emphasize text in Texinfo. -* Smallcaps:: How to use the small caps font. -* Fonts:: Various font commands for printed output. -* Customized Highlighting:: How to define highlighting commands. - -Quotations and Examples - -* Block Enclosing Commands:: Use different constructs for - different purposes. -* quotation:: How to write a quotation. -* example:: How to write an example in a fixed-width font. -* noindent:: How to prevent paragraph indentation. -* Lisp Example:: How to illustrate Lisp code. -* smallexample & smalllisp:: Forms for the @code{@@smallbook} option. -* display:: How to write an example in the current font. -* format:: How to write an example that does not narrow - the margins. -* exdent:: How to undo the indentation of a line. -* flushleft & flushright:: How to push text flushleft or flushright. -* cartouche:: How to draw cartouches around examples. - -Lists and Tables - -* Introducing Lists:: Texinfo formats lists for you. -* itemize:: How to construct a simple list. -* enumerate:: How to construct a numbered list. -* Two-column Tables:: How to construct a two-column table. -* Multi-column Tables:: How to construct generalized tables. - -Making a Two-column Table - -* table:: How to construct a two-column table. -* ftable vtable:: Automatic indexing for two-column tables. -* itemx:: How to put more entries in the first column. - -Multi-column Tables - -* Multitable Column Widths:: Defining multitable column widths. -* Multitable Rows:: Defining multitable rows, with examples. - -Creating Indices - -* Index Entries:: Choose different words for index entries. -* Predefined Indices:: Use different indices for different kinds - of entry. -* Indexing Commands:: How to make an index entry. -* Combining Indices:: How to combine indices. -* New Indices:: How to define your own indices. - -Combining Indices - -* syncodeindex:: How to merge two indices, using @code{@@code} - font for the merged-from index. -* synindex:: How to merge two indices, using the - default font of the merged-to index. - -Special Insertions - -* Braces Atsigns:: How to insert braces, @samp{@@}. -* Inserting Space:: How to insert the right amount of space - within a sentence. -* Inserting Accents:: How to insert accents and special characters. -* Dots Bullets:: How to insert dots and bullets. -* TeX and copyright:: How to insert the @TeX{} logo - and the copyright symbol. -* pounds:: How to insert the pounds currency symbol. -* minus:: How to insert a minus sign. -* math:: How to format a mathematical expression. -* Glyphs:: How to indicate results of evaluation, - expansion of macros, errors, etc. -* Images:: How to include graphics. - -Inserting @@ and Braces - -* Inserting An Atsign:: How to insert @samp{@@}. -* Inserting Braces:: How to insert @samp{@{} and @samp{@}}. - -Inserting Space - -* Not Ending a Sentence:: Sometimes a . doesn't end a sentence. -* Ending a Sentence:: Sometimes it does. -* Multiple Spaces:: Inserting multiple spaces. -* dmn:: How to format a dimension. - -Inserting Ellipsis, Dots, and Bullets - -* dots:: How to insert dots @dots{} -* bullet:: How to insert a bullet. - -Inserting @TeX{} and the Copyright Symbol - -* tex:: How to insert the @TeX{} logo. -* copyright symbol:: How to use @code{@@copyright}@{@}. - -Glyphs for Examples - -* Glyphs Summary:: -* result:: How to show the result of expression. -* expansion:: How to indicate an expansion. -* Print Glyph:: How to indicate printed output. -* Error Glyph:: How to indicate an error message. -* Equivalence:: How to indicate equivalence. -* Point Glyph:: How to indicate the location of point. - -Glyphs Summary - -* result:: -* expansion:: -* Print Glyph:: -* Error Glyph:: -* Equivalence:: -* Point Glyph:: - -Making and Preventing Breaks - -* Break Commands:: Cause and prevent splits. -* Line Breaks:: How to force a single line to use two lines. -* - and hyphenation:: How to tell TeX about hyphenation points. -* w:: How to prevent unwanted line breaks. -* sp:: How to insert blank lines. -* page:: How to force the start of a new page. -* group:: How to prevent unwanted page breaks. -* need:: Another way to prevent unwanted page breaks. - -Definition Commands - -* Def Cmd Template:: How to structure a description using a - definition command. -* Optional Arguments:: How to handle optional and repeated arguments. -* deffnx:: How to group two or more `first' lines. -* Def Cmds in Detail:: All the definition commands. -* Def Cmd Conventions:: Conventions for writing definitions. -* Sample Function Definition:: - -The Definition Commands - -* Functions Commands:: Commands for functions and similar entities. -* Variables Commands:: Commands for variables and similar entities. -* Typed Functions:: Commands for functions in typed languages. -* Typed Variables:: Commands for variables in typed languages. -* Abstract Objects:: Commands for object-oriented programming. -* Data Types:: The definition command for data types. - -Footnotes - -* Footnote Commands:: How to write a footnote in Texinfo. -* Footnote Styles:: Controlling how footnotes appear in Info. - -Conditionally Visible Text - -* Conditional Commands:: Specifying text for HTML, Info, or @TeX{}. -* Conditional Not Commands:: Specifying text for not HTML, Info, or @TeX{}. -* Raw Formatter Commands:: Using raw @TeX{} or HTML commands. -* set clear value:: Designating which text to format (for - all output formats); and how to set a - flag to a string that you can insert. - -@code{@@set}, @code{@@clear}, and @code{@@value} - -* ifset ifclear:: Format a region if a flag is set. -* value:: Replace a flag with a string. -* value Example:: An easy way to update edition information. - -Macros: Defining New Texinfo Commands - -* Defining Macros:: Both defining and undefining new commands. -* Invoking Macros:: Using a macro, once you've defined it. - -Format and Print Hardcopy - -* Use TeX:: Use @TeX{} to format for hardcopy. -* Format with tex/texindex:: How to format in a shell. -* Format with texi2dvi:: A simpler way to use the shell. -* Print with lpr:: How to print. -* Within Emacs:: How to format and print from an Emacs shell. -* Texinfo Mode Printing:: How to format and print in Texinfo mode. -* Compile-Command:: How to print using Emacs's compile command. -* Requirements Summary:: @TeX{} formatting requirements summary. -* Preparing for TeX:: What you need to do to use @TeX{}. -* Overfull hboxes:: What are and what to do with overfull hboxes. -* smallbook:: How to print small format books and manuals. -* A4 Paper:: How to print on European A4 paper. -* Cropmarks and Magnification:: How to print marks to indicate the size - of pages and how to print scaled up output. - -Creating an Info File - -* makeinfo advantages:: @code{makeinfo} provides better error checking. -* Invoking makeinfo:: How to run @code{makeinfo} from a shell. -* makeinfo options:: Specify fill-column and other options. -* Pointer Validation:: How to check that pointers point somewhere. -* makeinfo in Emacs:: How to run @code{makeinfo} from Emacs. -* texinfo-format commands:: Two Info formatting commands written - in Emacs Lisp are an alternative - to @code{makeinfo}. -* Batch Formatting:: How to format for Info in Emacs Batch mode. -* Tag and Split Files:: How tagged and split files help Info - to run better. - -Installing an Info File - -* Directory file:: The top level menu for all Info files. -* New Info File:: Listing a new info file. -* Other Info Directories:: How to specify Info files that are - located in other directories. -* Installing Dir Entries:: How to specify what menu entry to add - to the Info directory. -* Invoking install-info:: @code{install-info} options. - -Sample Permissions - -* Inserting Permissions:: How to put permissions in your document. -* ifinfo Permissions:: Sample @samp{ifinfo} copying permissions. -* Titlepage Permissions:: Sample Titlepage copying permissions. - -Include Files - -* Using Include Files:: How to use the @code{@@include} command. -* texinfo-multiple-files-update:: How to create and update nodes and - menus when using included files. -* Include File Requirements:: What @code{texinfo-multiple-files-update} expects. -* Sample Include File:: A sample outer file with included files - within it; and a sample included file. -* Include Files Evolution:: How use of the @code{@@include} command - has changed over time. - -Page Headings - -* Headings Introduced:: Conventions for using page headings. -* Heading Format:: Standard page heading formats. -* Heading Choice:: How to specify the type of page heading. -* Custom Headings:: How to create your own headings and footings. - -Formatting Mistakes - -* makeinfo Preferred:: @code{makeinfo} finds errors. -* Debugging with Info:: How to catch errors with Info formatting. -* Debugging with TeX:: How to catch errors with @TeX{} formatting. -* Using texinfo-show-structure:: How to use @code{texinfo-show-structure}. -* Using occur:: How to list all lines containing a pattern. -* Running Info-Validate:: How to find badly referenced nodes. - -Finding Badly Referenced Nodes - -* Using Info-validate:: How to run @code{Info-validate}. -* Unsplit:: How to create an unsplit file. -* Tagifying:: How to tagify a file. -* Splitting:: How to split a file manually. - -How to Obtain @TeX{} - -* New Texinfo Mode Commands:: The updating commands are especially useful. -* New Commands:: Many newly described @@-commands. -@end detailmenu -@end menu - -@node Copying, Overview, Top, Top -@comment node-name, next, previous, up -@unnumbered Texinfo Copying Conditions -@cindex Copying conditions -@cindex Conditions for copying Texinfo - -The programs currently being distributed that relate to Texinfo include -portions of GNU Emacs, plus other separate programs (including -@code{makeinfo}, @code{info}, @code{texindex}, and @file{texinfo.tex}). -These programs are @dfn{free}; this means that everyone is free to use -them and free to redistribute them on a free basis. The Texinfo-related -programs are not in the public domain; they are copyrighted and there -are restrictions on their distribution, but these restrictions are -designed to permit everything that a good cooperating citizen would want -to do. What is not allowed is to try to prevent others from further -sharing any version of these programs that they might get from -you.@refill - - Specifically, we want to make sure that you have the right to give -away copies of the programs that relate to Texinfo, that you receive -source code or else can get it if you want it, that you can change these -programs or use pieces of them in new free programs, and that you know -you can do these things.@refill - - To make sure that everyone has such rights, we have to forbid you to -deprive anyone else of these rights. For example, if you distribute -copies of the Texinfo related programs, you must give the recipients all -the rights that you have. You must make sure that they, too, receive or -can get the source code. And you must tell them their rights.@refill - - Also, for our own protection, we must make certain that everyone finds -out that there is no warranty for the programs that relate to Texinfo. -If these programs are modified by someone else and passed on, we want -their recipients to know that what they have is not what we distributed, -so that any problems introduced by others will not reflect on our -reputation.@refill - - The precise conditions of the licenses for the programs currently -being distributed that relate to Texinfo are found in the General Public -Licenses that accompany them.@refill - -@node Overview, Texinfo Mode, Copying, Top -@comment node-name, next, previous, up -@chapter Overview of Texinfo -@cindex Overview of Texinfo -@cindex Texinfo overview - -@dfn{Texinfo}@footnote{Note that the first syllable of ``Texinfo'' is -pronounced like ``speck'', not ``hex''. This odd pronunciation is -derived from, but is not the same as, the pronunciation of @TeX{}. In -the word @TeX{}, the @samp{X} is actually the Greek letter ``chi'' -rather than the English letter ``ex''. Pronounce @TeX{} as if the -@samp{X} were the last sound in the name `Bach'; but pronounce Texinfo -as if the @samp{x} were a `k'. Spell ``Texinfo'' with a capital ``T'' -and write the other letters in lower case.} -is a documentation system that uses a single source file to produce both -on-line information and printed output. This means that instead of -writing two different documents, one for the on-line help or other on-line -information and the other for a typeset manual or other printed work, you -need write only one document. When the work is revised, you need revise -only one document. (You can read the on-line information, known as an -@dfn{Info file}, with an Info documentation-reading program.)@refill - -@menu -* Using Texinfo:: Create a conventional printed book - or an Info file. -* Info Files:: What is an Info file? -* Printed Books:: Characteristics of a printed book or manual. -* Formatting Commands:: @@-commands are used for formatting. -* Conventions:: General rules for writing a Texinfo file. -* Comments:: How to write comments and mark regions that - the formatting commands will ignore. -* Minimum:: What a Texinfo file must have. -* Six Parts:: Usually, a Texinfo file has six parts. -* Short Sample:: A short sample Texinfo file. -* Acknowledgements:: -@end menu - -@node Using Texinfo, Info Files, Overview, Overview -@ifinfo -@heading Using Texinfo -@end ifinfo - -Using Texinfo, you can create a printed document with the normal -features of a book, including chapters, sections, cross references, -and indices. From the same Texinfo source file, you can create a -menu-driven, on-line Info file with nodes, menus, cross references, -and indices. You can, if you wish, make the chapters and sections of -the printed document correspond to the nodes of the on-line -information; and you use the same cross references and indices for -both the Info file and the printed work. @cite{The GNU -Emacs Manual} is a good example of a Texinfo file, as is this manual.@refill - -To make a printed document, you process a Texinfo source file with the -@TeX{} typesetting program. This creates a DVI file that you can -typeset and print as a book or report. (Note that the Texinfo language -is completely different from @TeX{}'s usual language, plain @TeX{}.) If -you do not have @TeX{}, but do have @code{troff} or @code{nroff}, you -can use the @code{texi2roff} program instead.@refill - -To make an Info file, you process a Texinfo source file with the -@code{makeinfo} utility or Emacs's @code{texinfo-format-buffer} command; -this creates an Info file that you can install on-line.@refill - -@TeX{} and @code{texi2roff} work with many types of printers; similarly, -Info works with almost every type of computer terminal. This power -makes Texinfo a general purpose system, but brings with it a constraint, -which is that a Texinfo file may contain only the customary -``typewriter'' characters (letters, numbers, spaces, and punctuation -marks) but no special graphics.@refill - -A Texinfo file is a plain @sc{ascii} file containing text and -@dfn{@@-commands} (words preceded by an @samp{@@}) that tell the -typesetting and formatting programs what to do. You may edit a -Texinfo file with any text editor; but it is especially convenient to -use GNU Emacs since that editor has a special mode, called Texinfo -mode, that provides various Texinfo-related features. (@xref{Texinfo -Mode}.)@refill - -Before writing a Texinfo source file, you should become familiar with -the Info documentation reading program and learn about nodes, -menus, cross references, and the rest. (@inforef{Top, info, info}, -for more information.)@refill - -You can use Texinfo to create both on-line help and printed manuals; -moreover, Texinfo is freely redistributable. For these reasons, Texinfo -is the format in which documentation for GNU utilities and libraries is -written.@refill - -@node Info Files, Printed Books, Using Texinfo, Overview -@comment node-name, next, previous, up -@section Info files -@cindex Info files - -An Info file is a Texinfo file formatted so that the Info documentation -reading program can operate on it. (@code{makeinfo} -and @code{texinfo-format-buffer} are two commands that convert a Texinfo file -into an Info file.)@refill - -Info files are divided into pieces called @dfn{nodes}, each of which -contains the discussion of one topic. Each node has a name, and -contains both text for the user to read and pointers to other nodes, -which are identified by their names. The Info program displays one node -at a time, and provides commands with which the user can move to other -related nodes.@refill - -@ifinfo -@inforef{Top, info, info}, for more information about using Info.@refill -@end ifinfo - -Each node of an Info file may have any number of child nodes that -describe subtopics of the node's topic. The names of child -nodes are listed in a @dfn{menu} within the parent node; this -allows you to use certain Info commands to move to one of the child -nodes. Generally, an Info file is organized like a book. If a node -is at the logical level of a chapter, its child nodes are at the level -of sections; likewise, the child nodes of sections are at the level -of subsections.@refill - -All the children of any one parent are linked together in a -bidirectional chain of `Next' and `Previous' pointers. The `Next' -pointer provides a link to the next section, and the `Previous' pointer -provides a link to the previous section. This means that all the nodes -that are at the level of sections within a chapter are linked together. -Normally the order in this chain is the same as the order of the -children in the parent's menu. Each child node records the parent node -name as its `Up' pointer. The last child has no `Next' pointer, and the -first child has the parent both as its `Previous' and as its `Up' -pointer.@footnote{In some documents, the first child has no `Previous' -pointer. Occasionally, the last child has the node name of the next -following higher level node as its `Next' pointer.}@refill - -The book-like structuring of an Info file into nodes that correspond -to chapters, sections, and the like is a matter of convention, not a -requirement. The `Up', `Previous', and `Next' pointers of a node can -point to any other nodes, and a menu can contain any other nodes. -Thus, the node structure can be any directed graph. But it is usually -more comprehensible to follow a structure that corresponds to the -structure of chapters and sections in a printed book or report.@refill - -In addition to menus and to `Next', `Previous', and `Up' pointers, Info -provides pointers of another kind, called references, that can be -sprinkled throughout the text. This is usually the best way to -represent links that do not fit a hierarchical structure.@refill - -Usually, you will design a document so that its nodes match the -structure of chapters and sections in the printed output. But -occasionally there are times when this is not right for the material -being discussed. Therefore, Texinfo uses separate commands to specify -the node structure for the Info file and the section structure for the -printed output.@refill - -Generally, you enter an Info file through a node that by convention is -named `Top'. This node normally contains just a brief summary of the -file's purpose, and a large menu through which the rest of the file is -reached. From this node, you can either traverse the file -systematically by going from node to node, or you can go to a specific -node listed in the main menu, or you can search the index menus and then -go directly to the node that has the information you want. Alternatively, -with the standalone Info program, you can specify specific menu items on -the command line (@pxref{Top,,, info, Info}). - -If you want to read through an Info file in sequence, as if it were a -printed manual, you can hit @key{SPC} repeatedly, or you get the whole -file with the advanced Info command @kbd{g *}. (@inforef{Expert, -Advanced Info commands, info}.)@refill - -@c !!! dir file may be located in one of many places: -@c /usr/local/emacs/info mentioned in info.c DEFAULT_INFOPATH -@c /usr/local/lib/emacs/info mentioned in info.c DEFAULT_INFOPATH -@c /usr/gnu/info mentioned in info.c DEFAULT_INFOPATH -@c /usr/local/info -@c /usr/local/lib/info -The @file{dir} file in the @file{info} directory serves as the -departure point for the whole Info system. From it, you can reach the -`Top' nodes of each of the documents in a complete Info system.@refill - -@node Printed Books, Formatting Commands, Info Files, Overview -@comment node-name, next, previous, up -@section Printed Books -@cindex Printed book and manual characteristics -@cindex Manual characteristics, printed -@cindex Book characteristics, printed -@cindex Texinfo printed book characteristics -@cindex Characteristics, printed books or manuals - -@cindex Knuth, Donald -A Texinfo file can be formatted and typeset as a printed book or manual. -To do this, you need @TeX{}, a powerful, sophisticated typesetting -program written by Donald Knuth.@footnote{You can also use the -@code{texi2roff} program if you do not have @TeX{}; since Texinfo is -designed for use with @TeX{}, @code{texi2roff} is not described here. -@code{texi2roff} is not part of the standard GNU distribution.} - -A Texinfo-based book is similar to any other typeset, printed work: it -can have a title page, copyright page, table of contents, and preface, -as well as chapters, numbered or unnumbered sections and subsections, -page headers, cross references, footnotes, and indices.@refill - -You can use Texinfo to write a book without ever having the intention -of converting it into on-line information. You can use Texinfo for -writing a printed novel, and even to write a printed memo, although -this latter application is not recommended since electronic mail is so -much easier.@refill - -@TeX{} is a general purpose typesetting program. Texinfo provides a -file called @file{texinfo.tex} that contains information (definitions or -@dfn{macros}) that @TeX{} uses when it typesets a Texinfo file. -(@file{texinfo.tex} tells @TeX{} how to convert the Texinfo @@-commands -to @TeX{} commands, which @TeX{} can then process to create the typeset -document.) @file{texinfo.tex} contains the specifications for printing -a document.@refill - -Most often, documents are printed on 8.5 inch by 11 inch -pages (216@dmn{mm} by 280@dmn{mm}; this is the default size), but you -can also print for 7 inch by 9.25 inch pages (178@dmn{mm} by -235@dmn{mm}; the @code{@@smallbook} size) or on European A4 size paper -(@code{@@afourpaper}). (@xref{smallbook, , Printing ``Small'' Books}. -Also, see @ref{A4 Paper, ,Printing on A4 Paper}.)@refill - -By changing the parameters in @file{texinfo.tex}, you can change the -size of the printed document. In addition, you can change the style in -which the printed document is formatted; for example, you can change the -sizes and fonts used, the amount of indentation for each paragraph, the -degree to which words are hyphenated, and the like. By changing the -specifications, you can make a book look dignified, old and serious, or -light-hearted, young and cheery.@refill - -@TeX{} is freely distributable. It is written in a superset of Pascal -called WEB and can be compiled either in Pascal or (by using a -conversion program that comes with the @TeX{} distribution) in C. -(@xref{TeX Mode, ,@TeX{} Mode, xemacs, XEmacs User's Manual}, for information -about @TeX{}.)@refill - -@TeX{} is very powerful and has a great many features. Because a -Texinfo file must be able to present information both on a -character-only terminal in Info form and in a typeset book, the -formatting commands that Texinfo supports are necessarily -limited.@refill - -@xref{Obtaining TeX, , How to Obtain @TeX{}}. - - -@node Formatting Commands, Conventions, Printed Books, Overview -@comment node-name, next, previous, up -@section @@-commands -@cindex @@-commands -@cindex Formatting commands - -In a Texinfo file, the commands that tell @TeX{} how to typeset the -printed manual and tell @code{makeinfo} and -@code{texinfo-format-buffer} how to create an Info file are preceded -by @samp{@@}; they are called @dfn{@@-commands}. For example, -@code{@@node} is the command to indicate a node and @code{@@chapter} -is the command to indicate the start of a chapter.@refill - -@quotation -@strong{Please note:} All the @@-commands, with the exception of the -@code{@@TeX@{@}} command, must be written entirely in lower -case.@refill -@end quotation - -The Texinfo @@-commands are a strictly limited set of constructs. The -strict limits make it possible for Texinfo files to be understood both -by @TeX{} and by the code that converts them into Info files. You can -display Info files on any terminal that displays alphabetic and -numeric characters. Similarly, you can print the output generated by -@TeX{} on a wide variety of printers.@refill - -Depending on what they do or what arguments@footnote{The word -@dfn{argument} comes from the way it is used in mathematics and does -not refer to a disputation between two people; it refers to the -information presented to the command. According to the @cite{Oxford -English Dictionary}, the word derives from the Latin for @dfn{to make -clear, prove}; thus it came to mean `the evidence offered as proof', -which is to say, `the information offered', which led to its -mathematical meaning. In its other thread of derivation, the word -came to mean `to assert in a manner against which others may make -counter assertions', which led to the meaning of `argument' as a -disputation.} they take, you need to write @@-commands on lines of -their own or as part of sentences:@refill - -@itemize @bullet -@item -Write a command such as @code{@@noindent} at the beginning of a line as -the only text on the line. (@code{@@noindent} prevents the beginning of -the next line from being indented as the beginning of a -paragraph.)@refill - -@item -Write a command such as @code{@@chapter} at the beginning of a line -followed by the command's arguments, in this case the chapter title, on -the rest of the line. (@code{@@chapter} creates chapter titles.)@refill - -@item -Write a command such as @code{@@dots@{@}} wherever you wish but usually -within a sentence. (@code{@@dots@{@}} creates dots @dots{})@refill - -@item -Write a command such as @code{@@code@{@var{sample-code}@}} wherever you -wish (but usually within a sentence) with its argument, -@var{sample-code} in this example, between the braces. (@code{@@code} -marks text as being code.)@refill - -@item -Write a command such as @code{@@example} at the beginning of a line of -its own; write the body-text on following lines; and write the matching -@code{@@end} command, @code{@@end example} in this case, at the -beginning of a line of its own after the body-text. (@code{@@example} -@dots{} @code{@@end example} indents and typesets body-text as an -example.)@refill -@end itemize - -@noindent -@cindex Braces, when to use -As a general rule, a command requires braces if it mingles among other -text; but it does not need braces if it starts a line of its own. The -non-alphabetic commands, such as @code{@@:}, are exceptions to the rule; -they do not need braces.@refill - -As you gain experience with Texinfo, you will rapidly learn how to -write the different commands: the different ways to write commands -make it easier to write and read Texinfo files than if all commands -followed exactly the same syntax. (For details about @@-command -syntax, see @ref{Command Syntax, , @@-Command Syntax}.)@refill - -@node Conventions, Comments, Formatting Commands, Overview -@comment node-name, next, previous, up -@section General Syntactic Conventions -@cindex General syntactic conventions -@cindex Syntactic conventions -@cindex Conventions, syntactic - -All printable @sc{ascii} characters except @samp{@@}, @samp{@{} and -@samp{@}} can appear in a Texinfo file and stand for themselves. -@samp{@@} is the escape character which introduces commands. -@samp{@{} and @samp{@}} should be used only to surround arguments to -certain commands. To put one of these special characters into the -document, put an @samp{@@} character in front of it, like this: -@samp{@@@@}, @samp{@@@{}, and @samp{@@@}}.@refill - -@ifinfo -It is customary in @TeX{} to use doubled single-quote characters to -begin and end quotations: ` ` and ' ' (but without a space between the -two single-quote characters). This convention should be followed in -Texinfo files. @TeX{} converts doubled single-quote characters to -left- and right-hand doubled quotation marks and Info converts doubled -single-quote characters to @sc{ascii} double-quotes: ` ` and ' ' to " .@refill -@end ifinfo -@iftex -It is customary in @TeX{} to use doubled single-quote characters to -begin and end quotations: @w{@tt{ `` }} and @w{@tt{ '' }}. This -convention should be followed in Texinfo files. @TeX{} converts -doubled single-quote characters to left- and right-hand doubled -quotation marks, ``like this'', and Info converts doubled single-quote -characters to @sc{ascii} double-quotes: @w{@tt{ `` }} and -@w{@tt{ '' }} to @w{@tt{ " }}.@refill -@end iftex - -Use three hyphens in a row, @samp{---}, for a dash---like this. In -@TeX{}, a single or double hyphen produces a printed dash that is -shorter than the usual typeset dash. Info reduces three hyphens to two -for display on the screen. - -To prevent a paragraph from being indented in the printed manual, put -the command @code{@@noindent} on a line by itself before the -paragraph.@refill - -If you mark off a region of the Texinfo file with the @code{@@iftex} -and @w{@code{@@end iftex}} commands, that region will appear only in -the printed copy; in that region, you can use certain commands -borrowed from plain @TeX{} that you cannot use in Info. Likewise, if -you mark off a region with the @code{@@ifinfo} and @code{@@end ifinfo} -commands, that region will appear only in the Info file; in that -region, you can use Info commands that you cannot use in @TeX{}. -Similarly for @code{@@ifhtml @dots{} @@end ifhtml}, -@code{@@ifnothtml @dots{} @@end ifnothtml}, -@code{@@ifnotinfo @dots{} @@end ifnotinfo}, -@code{@@ifnottex @dots{} @@end ifnottex}, -@xref{Conditionals}. - -@cindex Tabs; don't use! -@quotation -@strong{Caution:} Do not use tabs in a Texinfo file! @TeX{} uses -variable-width fonts, which means that it cannot predefine a tab to work -in all circumstances. Consequently, @TeX{} treats tabs like single -spaces, and that is not what they look like. Furthermore, -@code{makeinfo} does nothing special with tabs, and thus a tab character -in your input file may appear differently in the output. - -@noindent -To avoid this problem, Texinfo mode causes GNU Emacs to insert multiple -spaces when you press the @key{TAB} key.@refill - -@noindent -Also, you can run @code{untabify} in Emacs to convert tabs in a region -to multiple spaces.@refill - -@noindent -Don't use tabs. -@end quotation - -@node Comments, Minimum, Conventions, Overview -@comment node-name, next, previous, up -@section Comments - -You can write comments in a Texinfo file that will not appear in -either the Info file or the printed manual by using the -@code{@@comment} command (which may be abbreviated to @code{@@c}). -Such comments are for the person who reads the Texinfo file. All the -text on a line that follows either @code{@@comment} or @code{@@c} is a -comment; the rest of the line does not appear in either the Info file -or the printed manual. (Often, you can write the @code{@@comment} or -@code{@@c} in the middle of a line, and only the text that follows after -the @code{@@comment} or @code{@@c} command does not appear; but some -commands, such as @code{@@settitle} and @code{@@setfilename}, work on a -whole line. You cannot use @code{@@comment} or @code{@@c} in a line -beginning with such a command.)@refill -@cindex Comments -@findex comment -@findex c @r{(comment)} - -You can write long stretches of text that will not appear in either -the Info file or the printed manual by using the @code{@@ignore} and -@code{@@end ignore} commands. Write each of these commands on a line -of its own, starting each command at the beginning of the line. Text -between these two commands does not appear in the processed output. -You can use @code{@@ignore} and @code{@@end ignore} for writing -comments. Often, @code{@@ignore} and @code{@@end ignore} is used -to enclose a part of the copying permissions that applies to the -Texinfo source file of a document, but not to the Info or printed -version of the document.@refill -@cindex Ignored text -@cindex Unprocessed text -@findex ignore -@c !!! Perhaps include this comment about ignore and ifset: -@ignore -Text enclosed by @code{@@ignore} or by failing @code{@@ifset} or -@code{@@ifclear} conditions is ignored in the sense that it will not -contribute to the formatted output. However, TeX and makeinfo must -still parse the ignored text, in order to understand when to -@emph{stop} ignoring text from the source file; that means that you -will still get error messages if you have invalid Texinfo markup -within ignored text. -@end ignore - -@node Minimum, Six Parts, Comments, Overview -@comment node-name, next, previous, up -@section What a Texinfo File Must Have -@cindex Minimal Texinfo file (requirements) -@cindex Must have in Texinfo file -@cindex Required in Texinfo file -@cindex Texinfo file minimum - -By convention, the names of Texinfo files end with one of the -extensions @file{.texinfo}, @file{.texi}, or @file{.tex}. The longer -extension is preferred since it describes more clearly to a human -reader the nature of the file. The shorter extensions are for -operating systems that cannot handle long file names.@refill - -In order to be made into a printed manual and an Info file, a Texinfo -file @strong{must} begin with lines like this:@refill - -@example -@group -\input texinfo -@@setfilename @var{info-file-name} -@@settitle @var{name-of-manual} -@end group -@end example - -@noindent -The contents of the file follow this beginning, and then you @strong{must} end -a Texinfo file with a line like this:@refill - -@example -@@bye -@end example - -@findex input @r{(@TeX{} command)} -@noindent -The @samp{\input texinfo} line tells @TeX{} to use the -@file{texinfo.tex} file, which tells @TeX{} how to translate the Texinfo -@@-commands into @TeX{} typesetting commands. (Note the use of the -backslash, @samp{\}; this is correct for @TeX{}.) The -@samp{@@setfilename} line provides a name for the Info file and tells -@TeX{} to open auxiliary files. The @samp{@@settitle} line specifies a -title for the page headers (or footers) of the printed manual.@refill - -The @code{@@bye} line at the end of the file on a line of its own tells -the formatters that the file is ended and to stop formatting.@refill - -Usually, you will not use quite such a spare format, but will include -mode setting and start-of-header and end-of-header lines at the -beginning of a Texinfo file, like this:@refill - -@example -@group -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename @var{info-file-name} -@@settitle @var{name-of-manual} -@@c %**end of header -@end group -@end example - -@noindent -In the first line, @samp{-*-texinfo-*-} causes Emacs to switch into -Texinfo mode when you edit the file. - -The @code{@@c} lines which surround the @samp{@@setfilename} and -@samp{@@settitle} lines are optional, but you need them in order to -run @TeX{} or Info on just part of the file. (@xref{Start of Header}, -for more information.)@refill - -Furthermore, you will usually provide a Texinfo file with a title -page, indices, and the like. But the minimum, which can be useful -for short documents, is just the three lines at the beginning and the -one line at the end.@refill - -@node Six Parts, Short Sample, Minimum, Overview -@comment node-name, next, previous, up -@section Six Parts of a Texinfo File - -Generally, a Texinfo file contains more than the minimal -beginning and end---it usually contains six parts:@refill - -@table @r -@item 1. Header -The @dfn{Header} names the file, tells @TeX{} which definitions' file to -use, and performs other ``housekeeping'' tasks.@refill - -@item 2. Summary Description and Copyright -The @dfn{Summary Description and Copyright} segment describes the document -and contains the copyright notice and copying permissions for the Info -file. The segment must be enclosed between @code{@@ifinfo} and -@code{@@end ifinfo} commands so that the formatters place it only in the Info -file.@refill - -@item 3. Title and Copyright -The @dfn{Title and Copyright} segment contains the title and copyright pages -and copying permissions for the printed manual. The segment must be -enclosed between @code{@@titlepage} and @code{@@end titlepage} commands. -The title and copyright page appear only in the printed @w{manual}.@refill - -@item 4. `Top' Node and Master Menu -The @dfn{Master Menu} contains a complete menu of all the nodes in the whole -Info file. It appears only in the Info file, in the `Top' node.@refill - -@item 5. Body -The @dfn{Body} of the document may be structured like a traditional book or -encyclopedia or it may be free form.@refill - -@item 6. End -The @dfn{End} contains commands for printing indices and generating -the table of contents, and the @code{@@bye} command on a line of its -own.@refill -@end table - -@node Short Sample, Acknowledgements, Six Parts, Overview -@comment node-name, next, previous, up -@section A Short Sample Texinfo File -@cindex Sample Texinfo file - -Here is a complete but very short Texinfo file, in six parts. The first -three parts of the file, from @samp{\input texinfo} through to -@samp{@@end titlepage}, look more intimidating than they are. Most of -the material is standard boilerplate; when you write a manual, simply -insert the names for your own manual in this segment. (@xref{Beginning a -File}.)@refill - -@noindent -In the following, the sample text is @emph{indented}; comments on it are -not. The complete file, without any comments, is shown in -@ref{Sample Texinfo File}. - -@subheading Part 1: Header - -@noindent -The header does not appear in either the Info file or the -printed output. It sets various parameters, including the -name of the Info file and the title used in the header. - -@example -@group -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename sample.info -@@settitle Sample Document -@@c %**end of header - -@@setchapternewpage odd -@end group -@end example - -@subheading Part 2: Summary Description and Copyright - -@noindent -The summary description and copyright segment does not -appear in the printed document. - -@example -@group -@@ifinfo -This is a short example of a complete Texinfo file. - -Copyright @@copyright@{@} 1990 Free Software Foundation, Inc. -@@end ifinfo -@end group -@end example - -@subheading Part 3: Titlepage and Copyright - -@noindent -The titlepage segment does not appear in the Info file. - -@example -@group -@@titlepage -@@sp 10 -@@comment The title is printed in a large font. -@@center @@titlefont@{Sample Title@} -@end group - -@group -@@c The following two commands start the copyright page. -@@page -@@vskip 0pt plus 1filll -Copyright @@copyright@{@} 1990 Free Software Foundation, Inc. -@@end titlepage -@end group -@end example - -@subheading Part 4: `Top' Node and Master Menu - -@noindent -The `Top' node contains the master menu for the Info file. -Since a printed manual uses a table of contents rather than -a menu, the master menu appears only in the Info file. - -@example -@group -@@node Top, First Chapter, , (dir) -@@comment node-name, next, previous, up -@end group -@end example - -@example -@group -@@menu -* First Chapter:: The first chapter is the - only chapter in this sample. -* Concept Index:: This index has two entries. -@@end menu -@end group -@end example - -@subheading Part 5: The Body of the Document - -@noindent -The body segment contains all the text of the document, but not the -indices or table of contents. This example illustrates a node and a -chapter containing an enumerated list.@refill - -@example -@group -@@node First Chapter, Concept Index, Top, Top -@@comment node-name, next, previous, up -@@chapter First Chapter -@@cindex Sample index entry -@end group - -@group -This is the contents of the first chapter. -@@cindex Another sample index entry -@end group - -@group -Here is a numbered list. - -@@enumerate -@@item -This is the first item. - -@@item -This is the second item. -@@end enumerate -@end group - -@group -The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@} -commands transform a Texinfo file such as this into -an Info file; and @@TeX@{@} typesets it for a printed -manual. -@end group -@end example - -@subheading Part 6: The End of the Document - -@noindent -The end segment contains commands both for generating an index in a node -and unnumbered chapter of its own and for generating the table of -contents; and it contains the @code{@@bye} command that marks the end of -the document.@refill - -@example -@group -@@node Concept Index, , First Chapter, Top -@@comment node-name, next, previous, up -@@unnumbered Concept Index -@end group - -@group -@@printindex cp - -@@contents -@@bye -@end group -@end example - -@subheading The Results - -Here is what the contents of the first chapter of the sample look like: - -@sp 1 -@need 700 -@quotation -This is the contents of the first chapter. - -Here is a numbered list. - -@enumerate -@item -This is the first item. - -@item -This is the second item. -@end enumerate - -The @code{makeinfo} and @code{texinfo-format-buffer} -commands transform a Texinfo file such as this into -an Info file; and @TeX{} typesets it for a printed -manual. -@end quotation - -@node Acknowledgements, , Short Sample, Overview -@comment node-name, next, previous, up -@section Acknowledgements - -@cindex Stallman, Richard M. -@cindex Chassell, Robert J. -@cindex Berry, Karl -Richard M.@: Stallman wrote Edition 1.0 of this manual. @w{Robert J.@: -Chassell} revised and extended it, starting with Edition 1.1. Karl -Berry made updates for the Texinfo 3.8 and subsequent releases, starting -with Edition 2.22. - -@cindex Pinard, Fran@,{c}ois -@cindex Zuhn, David D. -@cindex Weisshaus, Melissa -Our thanks go out to all who helped improve this work, particularly to -Fran@,{c}ois Pinard and @w{David D.@: Zuhn}, who tirelessly recorded and -reported mistakes and obscurities; our special thanks go to Melissa -Weisshaus for her frequent and often tedious reviews of nearly similar -editions. Our mistakes are our own. - -Please send suggestions and corrections to: - -@example -@group -@r{Internet address:} - bug-texinfo@@gnu.org -@end group -@end example - -@noindent -Please include the manual's edition number and update date in your messages. - -@node Texinfo Mode, Beginning a File, Overview, Top -@comment node-name, next, previous, up -@chapter Using Texinfo Mode -@cindex Texinfo mode -@cindex Mode, using Texinfo -@cindex GNU Emacs -@cindex Emacs - -You may edit a Texinfo file with any text editor you choose. A Texinfo -file is no different from any other @sc{ascii} file. However, GNU Emacs -comes with a special mode, called Texinfo -mode, that provides Emacs commands and tools to help ease your work.@refill - -This chapter describes features of GNU Emacs' Texinfo mode but not any -features of the Texinfo formatting language. If you are reading this -manual straight through from the beginning, you may want to skim through -this chapter briefly and come back to it after reading succeeding -chapters which describe the Texinfo formatting language in -detail.@refill - -@menu -* Texinfo Mode Overview:: How Texinfo mode can help you. -* Emacs Editing:: Texinfo mode adds to GNU Emacs' general - purpose editing features. -* Inserting:: How to insert frequently used @@-commands. -* Showing the Structure:: How to show the structure of a file. -* Updating Nodes and Menus:: How to update or create new nodes and menus. -* Info Formatting:: How to format for Info. -* Printing:: How to format and print part or all of a file. -* Texinfo Mode Summary:: Summary of all the Texinfo mode commands. -@end menu - -@node Texinfo Mode Overview, Emacs Editing, Texinfo Mode, Texinfo Mode -@ifinfo -@heading Texinfo Mode Overview -@end ifinfo - -Texinfo mode provides special features for working with Texinfo -files:@refill - -@itemize @bullet -@item -Insert frequently used @@-commands. @refill - -@item -Automatically create @code{@@node} lines. - -@item -Show the structure of a Texinfo source file.@refill - -@item -Automatically create or update the `Next', -`Previous', and `Up' pointers of a node. - -@item -Automatically create or update menus.@refill - -@item -Automatically create a master menu.@refill - -@item -Format a part or all of a file for Info.@refill - -@item -Typeset and print part or all of a file.@refill -@end itemize - -Perhaps the two most helpful features are those for inserting frequently -used @@-commands and for creating node pointers and menus.@refill - -@node Emacs Editing, Inserting, Texinfo Mode Overview, Texinfo Mode -@section The Usual GNU Emacs Editing Commands - -In most cases, the usual Text mode commands work the same in Texinfo -mode as they do in Text mode. Texinfo mode adds new editing commands -and tools to GNU Emacs' general purpose editing features. The major -difference concerns filling. In Texinfo mode, the paragraph -separation variable and syntax table are redefined so that Texinfo -commands that should be on lines of their own are not inadvertently -included in paragraphs. Thus, the @kbd{M-q} (@code{fill-paragraph}) -command will refill a paragraph but not mix an indexing command on a -line adjacent to it into the paragraph.@refill - -In addition, Texinfo mode sets the @code{page-delimiter} variable to -the value of @code{texinfo-chapter-level-regexp}; by default, this is -a regular expression matching the commands for chapters and their -equivalents, such as appendices. With this value for the page -delimiter, you can jump from chapter title to chapter title with the -@kbd{C-x ]} (@code{forward-page}) and @kbd{C-x [} -(@code{backward-page}) commands and narrow to a chapter with the -@kbd{C-x p} (@code{narrow-to-page}) command. (@xref{Pages, , , xemacs, -XEmacs User's Manual}, for details about the page commands.)@refill - -You may name a Texinfo file however you wish, but the convention is to -end a Texinfo file name with one of the three extensions -@file{.texinfo}, @file{.texi}, or @file{.tex}. A longer extension is -preferred, since it is explicit, but a shorter extension may be -necessary for operating systems that limit the length of file names. -GNU Emacs automatically enters Texinfo mode when you visit a file with -a @file{.texinfo} or @file{.texi} -extension. Also, Emacs switches to Texinfo mode -when you visit a -file that has @samp{-*-texinfo-*-} in its first line. If ever you are -in another mode and wish to switch to Texinfo mode, type @code{M-x -texinfo-mode}.@refill - -Like all other Emacs features, you can customize or enhance Texinfo -mode as you wish. In particular, the keybindings are very easy to -change. The keybindings described here are the default or standard -ones.@refill - -@node Inserting, Showing the Structure, Emacs Editing, Texinfo Mode -@comment node-name, next, previous, up -@section Inserting Frequently Used Commands -@cindex Inserting frequently used commands -@cindex Frequently used commands, inserting -@cindex Commands, inserting them - -Texinfo mode provides commands to insert various frequently used -@@-commands into the buffer. You can use these commands to save -keystrokes.@refill - -The insert commands are invoked by typing @kbd{C-c} twice and then the -first letter of the @@-command:@refill - -@table @kbd -@item C-c C-c c -@itemx M-x texinfo-insert-@@code -@findex texinfo-insert-@@code -Insert @code{@@code@{@}} and put the -cursor between the braces.@refill - -@item C-c C-c d -@itemx M-x texinfo-insert-@@dfn -@findex texinfo-insert-@@dfn -Insert @code{@@dfn@{@}} and put the -cursor between the braces.@refill - -@item C-c C-c e -@itemx M-x texinfo-insert-@@end -@findex texinfo-insert-@@end -Insert @code{@@end} and attempt to insert the correct following word, -such as @samp{example} or @samp{table}. (This command does not handle -nested lists correctly, but inserts the word appropriate to the -immediately preceding list.)@refill - -@item C-c C-c i -@itemx M-x texinfo-insert-@@item -@findex texinfo-insert-@@item -Insert @code{@@item} and put the -cursor at the beginning of the next line.@refill - -@item C-c C-c k -@itemx M-x texinfo-insert-@@kbd -@findex texinfo-insert-@@kbd -Insert @code{@@kbd@{@}} and put the -cursor between the braces.@refill - -@item C-c C-c n -@itemx M-x texinfo-insert-@@node -@findex texinfo-insert-@@node -Insert @code{@@node} and a comment line -listing the sequence for the `Next', -`Previous', and `Up' nodes. -Leave point after the @code{@@node}.@refill - -@item C-c C-c o -@itemx M-x texinfo-insert-@@noindent -@findex texinfo-insert-@@noindent -Insert @code{@@noindent} and put the -cursor at the beginning of the next line.@refill - -@item C-c C-c s -@itemx M-x texinfo-insert-@@samp -@findex texinfo-insert-@@samp -Insert @code{@@samp@{@}} and put the -cursor between the braces.@refill - -@item C-c C-c t -@itemx M-x texinfo-insert-@@table -@findex texinfo-insert-@@table -Insert @code{@@table} followed by a @key{SPC} -and leave the cursor after the @key{SPC}.@refill - -@item C-c C-c v -@itemx M-x texinfo-insert-@@var -@findex texinfo-insert-@@var -Insert @code{@@var@{@}} and put the -cursor between the braces.@refill - -@item C-c C-c x -@itemx M-x texinfo-insert-@@example -@findex texinfo-insert-@@example -Insert @code{@@example} and put the -cursor at the beginning of the next line.@refill - -@c M-@{ was the binding for texinfo-insert-braces; -@c in Emacs 19, backward-paragraph will take this binding. -@item C-c C-c @{ -@itemx M-x texinfo-insert-braces -@findex texinfo-insert-braces -Insert @code{@{@}} and put the cursor between the braces.@refill - -@item C-c C-c @} -@itemx C-c C-c ] -@itemx M-x up-list -@findex up-list -Move from between a pair of braces forward past the closing brace. -Typing @kbd{C-c C-c ]} is easier than typing @kbd{C-c C-c @}}, which -is, however, more mnemonic; hence the two keybindings. (Also, you can -move out from between braces by typing @kbd{C-f}.)@refill -@end table - -To put a command such as @w{@code{@@code@{@dots{}@}}} around an -@emph{existing} word, position the cursor in front of the word and type -@kbd{C-u 1 C-c C-c c}. This makes it easy to edit existing plain text. -The value of the prefix argument tells Emacs how many words following -point to include between braces---@samp{1} for one word, @samp{2} for -two words, and so on. Use a negative argument to enclose the previous -word or words. If you do not specify a prefix argument, Emacs inserts -the @@-command string and positions the cursor between the braces. This -feature works only for those @@-commands that operate on a word or words -within one line, such as @code{@@kbd} and @code{@@var}.@refill - -This set of insert commands was created after analyzing the frequency -with which different @@-commands are used in the @cite{GNU Emacs -Manual} and the @cite{GDB Manual}. If you wish to add your own insert -commands, you can bind a keyboard macro to a key, use abbreviations, -or extend the code in @file{texinfo.el}.@refill - -@findex texinfo-start-menu-description -@cindex Menu description, start -@cindex Description for menu, start -@kbd{C-c C-c C-d} (@code{texinfo-start-menu-description}) is an insert -command that works differently from the other insert commands. It -inserts a node's section or chapter title in the space for the -description in a menu entry line. (A menu entry has three parts, the -entry name, the node name, and the description. Only the node name is -required, but a description helps explain what the node is about. -@xref{Menu Parts, , The Parts of a Menu}.)@refill - -To use @code{texinfo-start-menu-description}, position point in a menu -entry line and type @kbd{C-c C-c C-d}. The command looks for and copies -the title that goes with the node name, and inserts the title as a -description; it positions point at beginning of the inserted text so you -can edit it. The function does not insert the title if the menu entry -line already contains a description.@refill - -This command is only an aid to writing descriptions; it does not do the -whole job. You must edit the inserted text since a title tends to use -the same words as a node name but a useful description uses different -words.@refill - -@node Showing the Structure, Updating Nodes and Menus, Inserting, Texinfo Mode -@comment node-name, next, previous, up -@section Showing the Section Structure of a File -@cindex Showing the section structure of a file -@cindex Section structure of a file, showing it -@cindex Structure of a file, showing it -@cindex Outline of file structure, showing it -@cindex Contents-like outline of file structure -@cindex File section structure, showing it -@cindex Texinfo file section structure, showing it - -You can show the section structure of a Texinfo file by using the -@kbd{C-c C-s} command (@code{texinfo-show-structure}). This command -shows the section structure of a Texinfo file by listing the lines -that begin with the @@-commands for @code{@@chapter}, -@code{@@section}, and the like. It constructs what amounts -to a table of contents. These lines are displayed in another buffer -called the @samp{*Occur*} buffer. In that buffer, you can position -the cursor over one of the lines and use the @kbd{C-c C-c} command -(@code{occur-mode-goto-occurrence}), to jump to the corresponding spot -in the Texinfo file.@refill - -@table @kbd -@item C-c C-s -@itemx M-x texinfo-show-structure -@findex texinfo-show-structure -Show the @code{@@chapter}, @code{@@section}, and such lines of a -Texinfo file.@refill - -@item C-c C-c -@itemx M-x occur-mode-goto-occurrence -@findex occur-mode-goto-occurrence -Go to the line in the Texinfo file corresponding to the line under the -cursor in the @file{*Occur*} buffer.@refill -@end table - -If you call @code{texinfo-show-structure} with a prefix argument by -typing @w{@kbd{C-u C-c C-s}}, it will list not only those lines with the -@@-commands for @code{@@chapter}, @code{@@section}, and the like, -but also the @code{@@node} lines. (This is how the -@code{texinfo-show-structure} command worked without an argument in -the first version of Texinfo. It was changed because @code{@@node} -lines clutter up the @samp{*Occur*} buffer and are usually not -needed.) You can use @code{texinfo-show-structure} with a prefix -argument to check whether the `Next', `Previous', and `Up' pointers of -an @code{@@node} line are correct.@refill - -Often, when you are working on a manual, you will be interested only -in the structure of the current chapter. In this case, you can mark -off the region of the buffer that you are interested in by using the -@kbd{C-x n n} (@code{narrow-to-region}) command and -@code{texinfo-show-structure} will work on only that region. To see -the whole buffer again, use @w{@kbd{C-x n w}} (@code{widen}). -(@xref{Narrowing, , , xemacs, XEmacs User's Manual}, for more -information about the narrowing commands.)@refill - -@vindex page-delimiter -@cindex Page delimiter in Texinfo mode -In addition to providing the @code{texinfo-show-structure} command, -Texinfo mode sets the value of the page delimiter variable to match -the chapter-level @@-commands. This enables you to use the @kbd{C-x -]} (@code{forward-page}) and @kbd{C-x [} (@code{backward-page}) -commands to move forward and backward by chapter, and to use the -@kbd{C-x p} (@code{narrow-to-page}) command to narrow to a chapter. -@xref{Pages, , , xemacs, XEmacs User's Manual}, for more information -about the page commands.@refill - -@node Updating Nodes and Menus, Info Formatting, Showing the Structure, Texinfo Mode -@comment node-name, next, previous, up -@section Updating Nodes and Menus -@cindex Updating nodes and menus -@cindex Create nodes, menus automatically -@cindex Insert nodes, menus automatically -@cindex Automatically insert nodes, menus - -Texinfo mode provides commands for automatically creating or updating -menus and node pointers. The commands are called ``update'' commands -because their most frequent use is for updating a Texinfo file after -you have worked on it; but you can use them to insert the `Next', -`Previous', and `Up' pointers into an @code{@@node} line that has none and to -create menus in a file that has none.@refill - -If you do not use the updating commands, you need to write menus and -node pointers by hand, which is a tedious task.@refill - -@menu -* Updating Commands:: Five major updating commands. -* Updating Requirements:: How to structure a Texinfo file for - using the updating command. -* Other Updating Commands:: How to indent descriptions, insert - missing nodes lines, and update - nodes in sequence. -@end menu - -@node Updating Commands, Updating Requirements, Updating Nodes and Menus, Updating Nodes and Menus -@ifinfo -@subheading The Updating Commands -@end ifinfo - -You can use the updating commands@refill - -@itemize @bullet -@item -to insert or update the `Next', `Previous', and `Up' pointers of a -node,@refill - -@item -to insert or update the menu for a section, and@refill - -@item -to create a master menu for a Texinfo source file.@refill -@end itemize - -You can also use the commands to update all the nodes and menus in a -region or in a whole Texinfo file.@refill - -The updating commands work only with conventional Texinfo files, which -are structured hierarchically like books. In such files, a structuring -command line must follow closely after each @code{@@node} line, except -for the `Top' @code{@@node} line. (A @dfn{structuring command line} is -a line beginning with @code{@@chapter}, @code{@@section}, or other -similar command.) - -You can write the structuring command line on the line that follows -immediately after an @code{@@node} line or else on the line that -follows after a single @code{@@comment} line or a single -@code{@@ifinfo} line. You cannot interpose more than one line between -the @code{@@node} line and the structuring command line; and you may -interpose only an @code{@@comment} line or an @code{@@ifinfo} line. - -Commands which work on a whole buffer require that the `Top' node be -followed by a node with an @code{@@chapter} or equivalent-level command. -Note that the menu updating commands will not create a main or master -menu for a Texinfo file that has only @code{@@chapter}-level nodes! The -menu updating commands only create menus @emph{within} nodes for lower level -nodes. To create a menu of chapters, you must provide a `Top' -node.@refill - -The menu updating commands remove menu entries that refer to other Info -files since they do not refer to nodes within the current buffer. This -is a deficiency. Rather than use menu entries, you can use cross -references to refer to other Info files. None of the updating commands -affect cross references.@refill - -Texinfo mode has five updating commands that are used most often: two -are for updating the node pointers or menu of a single node (or a -region); two are for updating every node pointer and menu in a file; -and one, the @code{texinfo-master-menu} command, is for creating a -master menu for a complete file, and optionally, for updating every -node and menu in the whole Texinfo file.@refill - -The @code{texinfo-master-menu} command is the primary command:@refill - -@table @kbd -@item C-c C-u m -@itemx M-x texinfo-master-menu -@findex texinfo-master-menu -Create or update a master menu that includes all the other menus -(incorporating the descriptions from pre-existing menus, if -any).@refill - -With an argument (prefix argument, @kbd{C-u,} if interactive), first create or -update all the nodes and all the regular menus in the buffer before -constructing the master menu. (@xref{The Top Node, , The Top Node and -Master Menu}, for more about a master menu.)@refill - -For @code{texinfo-master-menu} to work, the Texinfo file must have a -`Top' node and at least one subsequent node.@refill - -After extensively editing a Texinfo file, you can type the following: - -@example -C-u M-x texinfo-master-menu -@exdent or -C-u C-c C-u m -@end example - -@noindent -This updates all the nodes and menus completely and all at once.@refill -@end table - -The other major updating commands do smaller jobs and are designed for -the person who updates nodes and menus as he or she writes a Texinfo -file.@refill - -@need 1000 -The commands are:@refill - -@table @kbd -@item C-c C-u C-n -@itemx M-x texinfo-update-node -@findex texinfo-update-node -Insert the `Next', `Previous', and `Up' pointers for the node that point is -within (i.e., for the @code{@@node} line preceding point). If the -@code{@@node} line has pre-existing `Next', `Previous', or `Up' -pointers in it, the old pointers are removed and new ones inserted. -With an argument (prefix argument, @kbd{C-u}, if interactive), this command -updates all @code{@@node} lines in the region (which is the text -between point and mark).@refill - -@item C-c C-u C-m -@itemx M-x texinfo-make-menu -@findex texinfo-make-menu -Create or update the menu in the node that point is within. -With an argument (@kbd{C-u} as prefix argument, if -interactive), the command makes or updates menus for the -nodes which are either within or a part of the -region.@refill - -Whenever @code{texinfo-make-menu} updates an existing menu, 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.@refill - -@item C-c C-u C-e -@itemx M-x texinfo-every-node-update -@findex texinfo-every-node-update -Insert or update the `Next', `Previous', and `Up' pointers for every -node in the buffer.@refill - -@item C-c C-u C-a -@itemx M-x texinfo-all-menus-update -@findex texinfo-all-menus-update -Create or update all the menus in the buffer. With an argument -(@kbd{C-u} as prefix argument, if interactive), first insert -or update all the node -pointers before working on the menus.@refill - -If a master menu exists, the @code{texinfo-all-menus-update} command -updates it; but the command does not create a new master menu if none -already exists. (Use the @code{texinfo-master-menu} command for -that.)@refill - -When working on a document that does not merit a master menu, you can -type the following: - -@example -C-u C-c C-u C-a -@exdent or -C-u M-x texinfo-all-menus-update -@end example - -@noindent -This updates all the nodes and menus.@refill -@end table - -The @code{texinfo-column-for-description} variable specifies the -column to which menu descriptions are indented. By default, the value -is 32 although it is often useful to reduce it to as low as 24. You -can set the variable with the @kbd{M-x edit-options} command -(@pxref{Edit Options, , Editing Variable Values, xemacs, XEmacs User's -Manual}) or with the @kbd{M-x set-variable} command (@pxref{Examining, , -Examining and Setting Variables, xemacs, XEmacs User's Manual}).@refill - -Also, the @code{texinfo-indent-menu-description} command may be used to -indent existing menu descriptions to a specified column. Finally, if -you wish, you can use the @code{texinfo-insert-node-lines} command to -insert missing @code{@@node} lines into a file. (@xref{Other Updating -Commands}, for more information.)@refill - -@node Updating Requirements, Other Updating Commands, Updating Commands, Updating Nodes and Menus -@comment node-name, next, previous, up -@subsection Updating Requirements -@cindex Updating requirements -@cindex Requirements for updating commands - -To use the updating commands, you must organize the Texinfo file -hierarchically with chapters, sections, subsections, and the like. -When you construct the hierarchy of the manual, do not `jump down' -more than one level at a time: you can follow the `Top' node with a -chapter, but not with a section; you can follow a chapter with a -section, but not with a subsection. However, you may `jump up' any -number of levels at one time---for example, from a subsection to a -chapter.@refill - -Each @code{@@node} line, with the exception of the line for the `Top' -node, must be followed by a line with a structuring command such as -@code{@@chapter}, @code{@@section}, or -@code{@@unnumberedsubsec}.@refill - -Each @code{@@node} line/structuring-command line combination -must look either like this:@refill - -@example -@group -@@node Comments, Minimum, Conventions, Overview -@@comment node-name, next, previous, up -@@section Comments -@end group -@end example - -or like this (without the @code{@@comment} line): - -@example -@group -@@node Comments, Minimum, Conventions, Overview -@@section Comments -@end group -@end example - -@noindent -In this example, `Comments' is the name of both the node and the -section. The next node is called `Minimum' and the previous node is -called `Conventions'. The `Comments' section is within the `Overview' -node, which is specified by the `Up' pointer. (Instead of an -@code{@@comment} line, you can write an @code{@@ifinfo} line.)@refill - -If a file has a `Top' node, it must be called @samp{top} or @samp{Top} -and be the first node in the file.@refill - -The menu updating commands create a menu of sections within a chapter, -a menu of subsections within a section, and so on. This means that -you must have a `Top' node if you want a menu of chapters.@refill - -Incidentally, the @code{makeinfo} command will create an Info file for -a hierarchically organized Texinfo file that lacks `Next', `Previous' -and `Up' pointers. Thus, if you can be sure that your Texinfo file -will be formatted with @code{makeinfo}, you have no need for the -`update node' commands. (@xref{Create an Info File, , Creating an -Info File}, for more information about @code{makeinfo}.) However, -both @code{makeinfo} and the @code{texinfo-format-@dots{}} commands -require that you insert menus in the file.@refill - -@node Other Updating Commands, , Updating Requirements, Updating Nodes and Menus -@comment node-name, next, previous, up -@subsection Other Updating Commands - -In addition to the five major updating commands, Texinfo mode -possesses several less frequently used updating commands:@refill - -@table @kbd -@item M-x texinfo-insert-node-lines -@findex texinfo-insert-node-lines -Insert @code{@@node} lines before the @code{@@chapter}, -@code{@@section}, and other sectioning commands wherever they are -missing throughout a region in a Texinfo file.@refill - -With an argument (@kbd{C-u} as prefix argument, if interactive), the -@code{texinfo-insert-node-lines} command not only inserts -@code{@@node} lines but also inserts the chapter or section titles as -the names of the corresponding nodes. In addition, it inserts the -titles as node names in pre-existing @code{@@node} lines that lack -names. Since node names should be more concise than section or -chapter titles, you must manually edit node names so inserted.@refill - -For example, the following marks a whole buffer as a region and inserts -@code{@@node} lines and titles throughout:@refill - -@example -C-x h C-u M-x texinfo-insert-node-lines -@end example - -(Note that this command inserts titles as node names in @code{@@node} -lines; the @code{texinfo-start-menu-description} command -(@pxref{Inserting, Inserting Frequently Used Commands}) inserts titles -as descriptions in menu entries, a different action. However, in both -cases, you need to edit the inserted text.)@refill - -@item M-x texinfo-multiple-files-update -@findex texinfo-multiple-files-update @r{(in brief)} -Update nodes and menus in a document built from several separate files. -With @kbd{C-u} as a prefix argument, create and insert a master menu in -the outer file. With a numeric prefix argument, such as @kbd{C-u 2}, first -update all the menus and all the `Next', `Previous', and `Up' pointers -of all the included files before creating and inserting a master menu in -the outer file. The @code{texinfo-multiple-files-update} command is -described in the appendix on @code{@@include} files. -@ifinfo -@xref{texinfo-multiple-files-update}.@refill -@end ifinfo -@iftex -@xref{texinfo-multiple-files-update, , -@code{texinfo-multiple-files-update}}.@refill -@end iftex - -@item M-x texinfo-indent-menu-description -@findex texinfo-indent-menu-description -Indent every description in the menu following point to the specified -column. You can use this command to give yourself more space for -descriptions. With an argument (@kbd{C-u} as prefix argument, if -interactive), the @code{texinfo-indent-menu-description} command indents -every description in every menu in the region. However, this command -does not indent the second and subsequent lines of a multi-line -description.@refill - -@item M-x texinfo-sequential-node-update -@findex texinfo-sequential-node-update -Insert the names of the nodes immediately following and preceding the -current node as the `Next' or `Previous' pointers regardless of those -nodes' hierarchical level. This means that the `Next' node of a -subsection may well be the next chapter. Sequentially ordered nodes are -useful for novels and other documents that you read through -sequentially. (However, in Info, the @kbd{g *} command lets -you look through the file sequentially, so sequentially ordered nodes -are not strictly necessary.) With an argument (prefix argument, if -interactive), the @code{texinfo-sequential-node-update} command -sequentially updates all the nodes in the region.@refill -@end table - -@node Info Formatting, Printing, Updating Nodes and Menus, Texinfo Mode -@comment node-name, next, previous, up -@section Formatting for Info -@cindex Formatting for Info -@cindex Running an Info formatter -@cindex Info formatting - -Texinfo mode provides several commands for formatting part or all of a -Texinfo file for Info. Often, when you are writing a document, you -want to format only part of a file---that is, a region.@refill - -You can use either the @code{texinfo-format-region} or the -@code{makeinfo-region} command to format a region:@refill - -@table @kbd -@findex texinfo-format-region -@item C-c C-e C-r -@itemx M-x texinfo-format-region -@itemx C-c C-m C-r -@itemx M-x makeinfo-region -Format the current region for Info.@refill -@end table - -You can use either the @code{texinfo-format-buffer} or the -@code{makeinfo-buffer} command to format a whole buffer:@refill - -@table @kbd -@findex texinfo-format-buffer -@item C-c C-e C-b -@itemx M-x texinfo-format-buffer -@itemx C-c C-m C-b -@itemx M-x makeinfo-buffer -Format the current buffer for Info.@refill -@end table - -@need 1000 -For example, after writing a Texinfo file, you can type the following: - -@example -C-u C-c C-u m -@exdent or -C-u M-x texinfo-master-menu -@end example - -@noindent -This updates all the nodes and menus. Then type the following to create -an Info file: - -@example -C-c C-m C-b -@exdent or -M-x makeinfo-buffer -@end example - -For @TeX{} or the Info formatting commands to work, the file @emph{must} -include a line that has @code{@@setfilename} in its header.@refill - -@xref{Create an Info File}, for details about Info formatting.@refill - -@node Printing, Texinfo Mode Summary, Info Formatting, Texinfo Mode -@comment node-name, next, previous, up -@section Formatting and Printing -@cindex Formatting for printing -@cindex Printing a region or buffer -@cindex Region formatting and printing -@cindex Buffer formatting and printing -@cindex Part of file formatting and printing - -Typesetting and printing a Texinfo file is a multi-step process in which -you first create a file for printing (called a DVI file), and then -print the file. Optionally, you may also create indices. To do this, -you must run the @code{texindex} command after first running the -@code{tex} typesetting command; and then you must run the @code{tex} -command again. Or else run the @code{texi2dvi} command which -automatically creates indices as needed (@pxref{Format with texi2dvi}). - -Often, when you are writing a document, you want to typeset and print -only part of a file to see what it will look like. You can use the -@code{texinfo-tex-region} and related commands for this purpose. Use -the @code{texinfo-tex-buffer} command to format all of a -buffer.@refill - -@table @kbd -@item C-c C-t C-b -@itemx M-x texinfo-tex-buffer -@findex texinfo-tex-buffer -Run @code{texi2dvi} on the buffer. In addition to running @TeX{} on the -buffer, this command automatically creates or updates indices as -needed.@refill - -@item C-c C-t C-r -@itemx M-x texinfo-tex-region -@findex texinfo-tex-region -Run @TeX{} on the region.@refill - -@item C-c C-t C-i -@itemx M-x texinfo-texindex -Run @code{texindex} to sort the indices of a Texinfo file formatted with -@code{texinfo-tex-region}. The @code{texinfo-tex-region} command does -not run @code{texindex} automatically; it only runs the @code{tex} -typesetting command. You must run the @code{texinfo-tex-region} command -a second time after sorting the raw index files with the @code{texindex} -command. (Usually, you do not format an index when you format a region, -only when you format a buffer. Now that the @code{texi2dvi} command -exists, there is little or no need for this command.)@refill - -@item C-c C-t C-p -@itemx M-x texinfo-tex-print -@findex texinfo-tex-print -Print the file (or the part of the file) previously formatted with -@code{texinfo-tex-buffer} or @code{texinfo-tex-region}.@refill -@end table - -For @code{texinfo-tex-region} or @code{texinfo-tex-buffer} to work, the -file @emph{must} start with a @samp{\input texinfo} line and must -include an @code{@@settitle} line. The file must end with @code{@@bye} -on a line by itself. (When you use @code{texinfo-tex-region}, you must -surround the @code{@@settitle} line with start-of-header and -end-of-header lines.)@refill - -@xref{Format/Print Hardcopy}, for a description of the other @TeX{} related -commands, such as @code{tex-show-print-queue}.@refill - -@node Texinfo Mode Summary, , Printing, Texinfo Mode -@comment node-name, next, previous, up -@section Texinfo Mode Summary - -In Texinfo mode, each set of commands has default keybindings that -begin with the same keys. All the commands that are custom-created -for Texinfo mode begin with @kbd{C-c}. The keys are somewhat -mnemonic.@refill - -@subheading Insert Commands - -The insert commands are invoked by typing @kbd{C-c} twice and then the -first letter of the @@-command to be inserted. (It might make more -sense mnemonically to use @kbd{C-c C-i}, for `custom insert', but -@kbd{C-c C-c} is quick to type.)@refill - -@example -C-c C-c c @r{Insert} @samp{@@code}. -C-c C-c d @r{Insert} @samp{@@dfn}. -C-c C-c e @r{Insert} @samp{@@end}. -C-c C-c i @r{Insert} @samp{@@item}. -C-c C-c n @r{Insert} @samp{@@node}. -C-c C-c s @r{Insert} @samp{@@samp}. -C-c C-c v @r{Insert} @samp{@@var}. -C-c C-c @{ @r{Insert braces.} -C-c C-c ] -C-c C-c @} @r{Move out of enclosing braces.} - -@group -C-c C-c C-d @r{Insert a node's section title} - @r{in the space for the description} - @r{in a menu entry line.} -@end group -@end example - -@subheading Show Structure - -The @code{texinfo-show-structure} command is often used within a -narrowed region.@refill - -@example -C-c C-s @r{List all the headings.} -@end example - -@subheading The Master Update Command - -The @code{texinfo-master-menu} command creates a master menu; and can -be used to update every node and menu in a file as well.@refill - -@example -@group -C-c C-u m -M-x texinfo-master-menu - @r{Create or update a master menu.} -@end group - -@group -C-u C-c C-u m @r{With @kbd{C-u} as a prefix argument, first} - @r{create or update all nodes and regular} - @r{menus, and then create a master menu.} -@end group -@end example - -@subheading Update Pointers - -The update pointer commands are invoked by typing @kbd{C-c C-u} and -then either @kbd{C-n} for @code{texinfo-update-node} or @kbd{C-e} for -@code{texinfo-every-node-update}.@refill - -@example -C-c C-u C-n @r{Update a node.} -C-c C-u C-e @r{Update every node in the buffer.} -@end example - -@subheading Update Menus - -Invoke the update menu commands by typing @kbd{C-c C-u} -and then either @kbd{C-m} for @code{texinfo-make-menu} or -@kbd{C-a} for @code{texinfo-all-menus-update}. To update -both nodes and menus at the same time, precede @kbd{C-c C-u -C-a} with @kbd{C-u}.@refill - -@example -C-c C-u C-m @r{Make or update a menu.} - -@group -C-c C-u C-a @r{Make or update all} - @r{menus in a buffer.} -@end group - -@group -C-u C-c C-u C-a @r{With @kbd{C-u} as a prefix argument,} - @r{first create or update all nodes and} - @r{then create or update all menus.} -@end group -@end example - -@subheading Format for Info - -The Info formatting commands that are written in Emacs Lisp are -invoked by typing @kbd{C-c C-e} and then either @kbd{C-r} for a region -or @kbd{C-b} for the whole buffer.@refill - -The Info formatting commands that are written in C and based on the -@code{makeinfo} program are invoked by typing @kbd{C-c C-m} and then -either @kbd{C-r} for a region or @kbd{C-b} for the whole buffer.@refill - -@need 800 -@noindent -Use the @code{texinfo-format@dots{}} commands: - -@example -@group -C-c C-e C-r @r{Format the region.} -C-c C-e C-b @r{Format the buffer.} -@end group -@end example - -@need 750 -@noindent -Use @code{makeinfo}: - -@example -C-c C-m C-r @r{Format the region.} -C-c C-m C-b @r{Format the buffer.} -C-c C-m C-l @r{Recenter the @code{makeinfo} output buffer.} -C-c C-m C-k @r{Kill the @code{makeinfo} formatting job.} -@end example - -@subheading Typeset and Print - -The @TeX{} typesetting and printing commands are invoked by typing -@kbd{C-c C-t} and then another control command: @kbd{C-r} for -@code{texinfo-tex-region}, @kbd{C-b} for @code{texinfo-tex-buffer}, -and so on.@refill - -@example -C-c C-t C-r @r{Run @TeX{} on the region.} -C-c C-t C-b @r{Run} @code{texi2dvi} @r{on the buffer.} -C-c C-t C-i @r{Run} @code{texindex}. -C-c C-t C-p @r{Print the DVI file.} -C-c C-t C-q @r{Show the print queue.} -C-c C-t C-d @r{Delete a job from the print queue.} -C-c C-t C-k @r{Kill the current @TeX{} formatting job.} -C-c C-t C-x @r{Quit a currently stopped @TeX{} formatting job.} -C-c C-t C-l @r{Recenter the output buffer.} -@end example - -@subheading Other Updating Commands - -The `other updating commands' do not have standard keybindings because -they are rarely used. - -@example -@group -M-x texinfo-insert-node-lines - @r{Insert missing @code{@@node} lines in region.} - @r{With @kbd{C-u} as a prefix argument,} - @r{use section titles as node names.} -@end group - -@group -M-x texinfo-multiple-files-update - @r{Update a multi-file document.} - @r{With @kbd{C-u 2} as a prefix argument,} - @r{create or update all nodes and menus} - @r{in all included files first.} -@end group - -@group -M-x texinfo-indent-menu-description - @r{Indent descriptions.} -@end group - -@group -M-x texinfo-sequential-node-update - @r{Insert node pointers in strict sequence.} -@end group -@end example - -@node Beginning a File, Ending a File, Texinfo Mode, Top -@comment node-name, next, previous, up -@chapter Beginning a Texinfo File -@cindex Beginning a Texinfo file -@cindex Texinfo file beginning -@cindex File beginning - -Certain pieces of information must be provided at the beginning of a -Texinfo file, such as the name of the file and the title of the -document.@refill - -@menu -* Four Parts:: Four parts begin a Texinfo file. -* Sample Beginning:: Here is a sample beginning for a Texinfo file. -* Header:: The very beginning of a Texinfo file. -* Info Summary and Permissions:: Summary and copying permissions for Info. -* Titlepage & Copyright Page:: Creating the title and copyright pages. -* The Top Node:: Creating the `Top' node and master menu. -* Software Copying Permissions:: Ensure that you and others continue to - have the right to use and share software. -@end menu - -@node Four Parts, Sample Beginning, Beginning a File, Beginning a File -@ifinfo -@heading Four Parts Begin a File -@end ifinfo - -Generally, the beginning of a Texinfo file has four parts:@refill - -@enumerate -@item -The header, delimited by special comment lines, that includes the -commands for naming the Texinfo file and telling @TeX{} what -definitions file to use when processing the Texinfo file.@refill - -@item -A short statement of what the file is about, with a copyright notice -and copying permissions. This is enclosed in @code{@@ifinfo} and -@code{@@end ifinfo} commands so that the formatters place it only -in the Info file.@refill - -@item -A title page and copyright page, with a copyright notice and copying -permissions. This is enclosed between @code{@@titlepage} and -@code{@@end titlepage} commands. The title and copyright page appear -only in the printed @w{manual}.@refill - -@item -The `Top' node that contains a menu for the whole Info file. The -contents of this node appear only in the Info file.@refill -@end enumerate - -Also, optionally, you may include the copying conditions for a program -and a warranty disclaimer. The copying section will be followed by an -introduction or else by the first chapter of the manual.@refill - -Since the copyright notice and copying permissions for the Texinfo -document (in contrast to the copying permissions for a program) are in -parts that appear only in the Info file or only in the printed manual, -this information must be given twice.@refill - -@node Sample Beginning, Header, Four Parts, Beginning a File -@comment node-name, next, previous, up -@section Sample Texinfo File Beginning - -The following sample shows what is needed.@refill - -@example -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename @var{name-of-info-file} -@@settitle @var{name-of-manual} -@@setchapternewpage odd -@@c %**end of header - -@@ifinfo -This file documents @dots{} - -Copyright @var{year} @var{copyright-owner} - -@group -Permission is granted to @dots{} -@@end ifinfo -@end group - -@group -@@c This title page illustrates only one of the -@@c two methods of forming a title page. -@end group - -@group -@@titlepage -@@title @var{name-of-manual-when-printed} -@@subtitle @var{subtitle-if-any} -@@subtitle @var{second-subtitle} -@@author @var{author} -@end group - -@group -@@c The following two commands -@@c start the copyright page. -@@page -@@vskip 0pt plus 1filll -Copyright @@copyright@{@} @var{year} @var{copyright-owner} -@end group - -Published by @dots{} - -Permission is granted to @dots{} -@@end titlepage - -@@node Top, Overview, , (dir) - -@@ifinfo -This document describes @dots{} - -This document applies to version @dots{} -of the program named @dots{} -@@end ifinfo - -@group -@@menu -* Copying:: Your rights and freedoms. -* First Chapter:: Getting started @dots{} -* Second Chapter:: @dots{} - @dots{} - @dots{} -@@end menu -@end group - -@group -@@node First Chapter, Second Chapter, top, top -@@comment node-name, next, previous, up -@@chapter First Chapter -@@cindex Index entry for First Chapter -@end group -@end example - -@node Header, Info Summary and Permissions, Sample Beginning, Beginning a File -@comment node-name, next, previous, up -@section The Texinfo File Header -@cindex Header for Texinfo files -@cindex Texinfo file header - -Texinfo files start with at least three lines that provide Info and -@TeX{} with necessary information. These are the @code{\input -texinfo} line, the @code{@@settitle} line, and the -@code{@@setfilename} line. If you want to run @TeX{} on just a part -of the Texinfo File, you must write the @code{@@settitle} -and @code{@@setfilename} lines between start-of-header and end-of-header -lines.@refill - -Thus, the beginning of a Texinfo file looks like this: - -@example -@group -\input texinfo @@c -*-texinfo-*- -@@setfilename sample.info -@@settitle Sample Document -@end group -@end example - -@noindent -or else like this: - -@example -@group -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename sample.info -@@settitle Sample Document -@@c %**end of header -@end group -@end example - -@menu -* First Line:: The first line of a Texinfo file. -* Start of Header:: Formatting a region requires this. -* setfilename:: Tell Info the name of the Info file. -* settitle:: Create a title for the printed work. -* setchapternewpage:: Start chapters on right-hand pages. -* paragraphindent:: An option to specify paragraph indentation. -* End of Header:: Formatting a region requires this. -@end menu - -@node First Line, Start of Header, Header, Header -@comment node-name, next, previous, up -@subsection The First Line of a Texinfo File -@cindex First line of a Texinfo file -@cindex Beginning line of a Texinfo file -@cindex Header of a Texinfo file - -Every Texinfo file that is to be the top-level input to @TeX{} must begin -with a line that looks like this:@refill - -@example -\input texinfo @@c -*-texinfo-*- -@end example - -@noindent -This line serves two functions: - -@enumerate -@item -When the file is processed by @TeX{}, the @samp{\input texinfo} command -tells @TeX{} to load the macros needed for processing a Texinfo file. -These are in a file called @file{texinfo.tex}, which is usually located -in the @file{/usr/lib/tex/macros} directory. @TeX{} uses the backslash, -@samp{\}, to mark the beginning of a command, just as Texinfo uses -@samp{@@}. The @file{texinfo.tex} file causes the switch from @samp{\} -to @samp{@@}; before the switch occurs, @TeX{} requires @samp{\}, which -is why it appears at the beginning of the file.@refill - -@item -When the file is edited in GNU Emacs, the @samp{-*-texinfo-*-} mode -specification tells Emacs to use Texinfo mode.@refill -@end enumerate - -@node Start of Header, setfilename, First Line, Header -@comment node-name, next, previous, up -@subsection Start of Header -@cindex Start of header line - -Write a start-of-header line on the second line of a Texinfo file. -Follow the start-of-header line with @code{@@setfilename} and -@code{@@settitle} lines and, optionally, with other command lines, such -as @code{@@smallbook} or @code{@@footnotestyle}; and then by an -end-of-header line (@pxref{End of Header}).@refill - -With these lines, you can format part of a Texinfo file for Info or -typeset part for printing.@refill - -A start-of-header line looks like this:@refill - -@example -@@c %**start of header -@end example - -The odd string of characters, @samp{%**}, is to ensure that no other -comment is accidentally taken for a start-of-header line.@refill - -@node setfilename, settitle, Start of Header, Header -@comment node-name, next, previous, up -@subsection @code{@@setfilename} -@cindex Info file requires @code{@@setfilename} -@findex setfilename - -In order to serve as the primary input file for either @code{makeinfo} -or @TeX{}, a Texinfo file must contain a line that looks like this: - -@example -@@setfilename @var{info-file-name} -@end example - -Write the @code{@@setfilename} command at the beginning of a line and -follow it on the same line by the Info file name. Do not write anything -else on the line; anything on the line after the command is considered -part of the file name, including what would otherwise be a -comment. - -The @code{@@setfilename} line specifies the name of the Info file to be -generated. This name should be different from the name of the Texinfo -file. There are two conventions for choosing the name: you can either -remove the @samp{.texi} extension from the input file name, or replace -it with the @samp{.info} extension. - -Some operating systems cannot handle long file names. You can run into -a problem even when the file name you specify is itself short enough. -This occurs because the Info formatters split a long Info file into -short indirect subfiles, and name them by appending @samp{-1}, -@samp{-2}, @dots{}, @samp{-10}, @samp{-11}, and so on, to the original -file name. (@xref{Tag and Split Files, , Tag Files and Split Files}.) -The subfile name @file{texinfo.info-10}, for example, is too long for -some systems; so the Info file name for this document is @file{texinfo} -rather than @file{texinfo.info}. - -@cindex Ignored before @code{@@setfilename} -The Info formatting commands ignore everything written before the -@code{@@setfilename} line, which is why the very first line of -the file (the @code{\input} line) does not show up in the output. - -@pindex texinfo.cnf -The @code{@@setfilename} line produces no output when you typeset a -manual with @TeX{}, but it nevertheless is essential: it opens the -index, cross-reference, and other auxiliary files used by Texinfo, and -also reads @file{texinfo.cnf} if that file is present on your system -(@pxref{Preparing for TeX,, Preparing to Use @TeX{}}). - - -@node settitle, setchapternewpage, setfilename, Header -@comment node-name, next, previous, up -@subsection @code{@@settitle} -@findex settitle - -In order to be made into a printed manual, a Texinfo file must contain -a line that looks like this:@refill - -@example -@@settitle @var{title} -@end example - -Write the @code{@@settitle} command at the beginning of a line and -follow it on the same line by the title. This tells @TeX{} the title -to use in a header or footer. Do not write anything else on the line; -anything on the line after the command is considered part of the -title, including a comment.@refill - -Conventionally, when @TeX{} formats a Texinfo file for double-sided -output, the title is printed in the left-hand (even-numbered) page -headings and the current chapter title is printed in the right-hand -(odd-numbered) page headings. (@TeX{} learns the title of each chapter -from each @code{@@chapter} command.) Page footers are not -printed.@refill - -Even if you are printing in a single-sided style, @TeX{} looks for an -@code{@@settitle} command line, in case you include the manual title -in the heading. @refill - -The @code{@@settitle} command should precede everything that generates -actual output in @TeX{}.@refill - -Although the title in the @code{@@settitle} command is usually the -same as the title on the title page, it does not affect the title as -it appears on the title page. Thus, the two do not need not match -exactly; and the title in the @code{@@settitle} command can be a -shortened or expanded version of the title as it appears on the title -page. (@xref{titlepage, , @code{@@titlepage}}.)@refill - -@TeX{} prints page headings only for that text that comes after the -@code{@@end titlepage} command in the Texinfo file, or that comes -after an @code{@@headings} command that turns on headings. -(@xref{headings on off, , The @code{@@headings} Command}, for more -information.)@refill - -You may, if you wish, create your own, customized headings and -footings. @xref{Headings, , Page Headings}, for a detailed discussion -of this process.@refill - -@node setchapternewpage, paragraphindent, settitle, Header -@comment node-name, next, previous, up -@subsection @code{@@setchapternewpage} -@cindex Starting chapters -@cindex Pages, starting odd -@findex setchapternewpage - -In a book or a manual, text is usually printed on both sides of the -paper, chapters start on right-hand pages, and right-hand pages have -odd numbers. But in short reports, text often is printed only on one -side of the paper. Also in short reports, chapters sometimes do not -start on new pages, but are printed on the same page as the end of the -preceding chapter, after a small amount of vertical whitespace.@refill - -You can use the @code{@@setchapternewpage} command with various -arguments to specify how @TeX{} should start chapters and whether it -should typeset pages for printing on one or both sides of the paper -(single-sided or double-sided printing).@refill - -Write the @code{@@setchapternewpage} command at the beginning of a -line followed by its argument.@refill - -For example, you would write the following to cause each chapter to -start on a fresh odd-numbered page:@refill - -@example -@@setchapternewpage odd -@end example - -You can specify one of three alternatives with the -@code{@@setchapternewpage} command:@refill - -@table @asis -@ignore -@item No @code{@@setchapternewpage} command -If the Texinfo file does not contain an @code{@@setchapternewpage} -command before the @code{@@titlepage} command, @TeX{} automatically -begins chapters on new pages and prints headings in the standard -format for single-sided printing. This is the conventional format for -single-sided printing.@refill - -The result is exactly the same as when you write -@code{@@setchapternewpage on}.@refill -@end ignore -@item @code{@@setchapternewpage off} -Cause @TeX{} to typeset a new chapter on the same page as the last -chapter, after skipping some vertical whitespace. Also, cause @TeX{} to -format page headers for single-sided printing. (You can override the -headers format with the @code{@@headings double} command; see -@ref{headings on off, , The @code{@@headings} Command}.)@refill - -@item @code{@@setchapternewpage on} -Cause @TeX{} to start new chapters on new pages and to typeset page -headers for single-sided printing. This is the form most often -used for short reports.@refill - -This alternative is the default.@refill - -@item @code{@@setchapternewpage odd} -Cause @TeX{} to start new chapters on new, odd-numbered pages -(right-handed pages) and to typeset for double-sided printing. This is -the form most often used for books and manuals.@refill -@end table - -@noindent -Texinfo does not have an @code{@@setchapternewpage even} command.@refill - -@noindent -(You can countermand or modify an @code{@@setchapternewpage} command -with an @code{@@headings} command. @xref{headings on off, , The -@code{@@headings} Command}.)@refill - -At the beginning of a manual or book, pages are not numbered---for -example, the title and copyright pages of a book are not numbered. -By convention, table of contents pages are numbered with roman -numerals and not in sequence with the rest of the document.@refill - -Since an Info file does not have pages, the @code{@@setchapternewpage} -command has no effect on it.@refill - -Usually, you do not write an @code{@@setchapternewpage} command for -single-sided printing, but accept the default which is to typeset for -single-sided printing and to start new chapters on new pages. Usually, -you write an @code{@@setchapternewpage odd} command for double-sided -printing.@refill - -@node paragraphindent, End of Header, setchapternewpage, Header -@comment node-name, next, previous, up -@subsection Paragraph Indenting -@cindex Indenting paragraphs -@cindex Paragraph indentation -@findex paragraphindent - -The Info formatting commands may insert spaces at the beginning of the -first line of each paragraph, thereby indenting that paragraph. You -can use the @code{@@paragraphindent} command to specify the -indentation. Write an @code{@@paragraphindent} command at the -beginning of a line followed by either @samp{asis} or a number. The -template is:@refill - -@example -@@paragraphindent @var{indent} -@end example - -The Info formatting commands indent according to the value of -@var{indent}:@refill - -@itemize @bullet -@item -If the value of @var{indent} is @samp{asis}, the Info formatting -commands do not change the existing indentation.@refill - -@item -If the value of @var{indent} is zero, the Info formatting commands delete -existing indentation.@refill - -@item -If the value of @var{indent} is greater than zero, the Info formatting -commands indent the paragraph by that number of spaces.@refill -@end itemize - -The default value of @var{indent} is @samp{asis}.@refill - -Write the @code{@@paragraphindent} command before or shortly after the -end-of-header line at the beginning of a Texinfo file. (If you write -the command between the start-of-header and end-of-header lines, the -region formatting commands indent paragraphs as specified.)@refill - -A peculiarity of the @code{texinfo-format-buffer} and -@code{texinfo-format-region} commands is that they do not indent (nor -fill) paragraphs that contain @code{@@w} or @code{@@*} commands. -@xref{Refilling Paragraphs}, for a detailed description of what goes -on.@refill - -@node End of Header, , paragraphindent, Header -@comment node-name, next, previous, up -@subsection End of Header -@cindex End of header line - -Follow the header lines with an @w{end-of-header} line. -An end-of-header line looks like this:@refill - -@example -@@c %**end of header -@end example - -If you include the @code{@@setchapternewpage} command between the -start-of-header and end-of-header lines, @TeX{} will typeset a region as -that command specifies. Similarly, if you include an @code{@@smallbook} -command between the start-of-header and end-of-header lines, @TeX{} will -typeset a region in the ``small'' book format.@refill - -@ifinfo -The reason for the odd string of characters (@samp{%**}) is so that the -@code{texinfo-tex-region} command does not accidentally find -something that it should not when it is looking for the header.@refill - -The start-of-header line and the end-of-header line are Texinfo mode -variables that you can change.@refill -@end ifinfo - -@iftex -@xref{Start of Header}. -@end iftex - -@node Info Summary and Permissions, Titlepage & Copyright Page, Header, Beginning a File -@comment node-name, next, previous, up -@section Summary and Copying Permissions for Info - -The title page and the copyright page appear only in the printed copy of -the manual; therefore, the same information must be inserted in a -section that appears only in the Info file. This section usually -contains a brief description of the contents of the Info file, a -copyright notice, and copying permissions.@refill - -The copyright notice should read:@refill - -@example -Copyright @var{year} @var{copyright-owner} -@end example - -@noindent -and be put on a line by itself.@refill - -Standard text for the copyright permissions is contained in an appendix -to this manual; see @ref{ifinfo Permissions, , @samp{ifinfo} Copying -Permissions}, for the complete text.@refill - -The permissions text appears in an Info file @emph{before} the first -node. This mean that a reader does @emph{not} see this text when -reading the file using Info, except when using the advanced Info command -@kbd{g *}. - -@node Titlepage & Copyright Page, The Top Node, Info Summary and Permissions, Beginning a File -@comment node-name, next, previous, up -@section The Title and Copyright Pages - -A manual's name and author are usually printed on a title page. -Sometimes copyright information is printed on the title page as well; -more often, copyright information is printed on the back of the title -page. - -The title and copyright pages appear in the printed manual, but not in the -Info file. Because of this, it is possible to use several slightly -obscure @TeX{} typesetting commands that cannot be used in an Info file. -In addition, this part of the beginning of a Texinfo file contains the text -of the copying permissions that will appear in the printed manual.@refill - -@xref{Titlepage Permissions, , Titlepage Copying Permissions}, for the -standard text for the copyright permissions.@refill - -@menu -* titlepage:: Create a title for the printed document. -* titlefont center sp:: The @code{@@titlefont}, @code{@@center}, - and @code{@@sp} commands. -* title subtitle author:: The @code{@@title}, @code{@@subtitle}, - and @code{@@author} commands. -* Copyright & Permissions:: How to write the copyright notice and - include copying permissions. -* end titlepage:: Turn on page headings after the title and - copyright pages. -* headings on off:: An option for turning headings on and off - and double or single sided printing. -@end menu - -@node titlepage, titlefont center sp, Titlepage & Copyright Page, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection @code{@@titlepage} -@cindex Title page -@findex titlepage - -Start the material for the title page and following copyright page -with @code{@@titlepage} on a line by itself and end it with -@code{@@end titlepage} on a line by itself.@refill - -The @code{@@end titlepage} command starts a new page and turns on page -numbering. (@xref{Headings, , Page Headings}, for details about how to -generate page headings.) All the material that you want to -appear on unnumbered pages should be put between the -@code{@@titlepage} and @code{@@end titlepage} commands. By using the -@code{@@page} command you can force a page break within the region -delineated by the @code{@@titlepage} and @code{@@end titlepage} -commands and thereby create more than one unnumbered page. This is -how the copyright page is produced. (The @code{@@titlepage} command -might perhaps have been better named the -@code{@@titleandadditionalpages} command, but that would have been -rather long!)@refill - -@c !!! append refill to footnote when makeinfo can handle it. -When you write a manual about a computer program, you should write the -version of the program to which the manual applies on the title -page. If the manual changes more frequently than the program or is -independent of it, you should also include an edition -number@footnote{We have found that it is helpful to refer to versions -of manuals as `editions' and versions of programs as `versions'; -otherwise, we find we are liable to confuse each other in conversation -by referring to both the documentation and the software with the same -words.} for the manual. This helps readers keep track of which manual -is for which version of the program. (The `Top' node -should also contain this information; see @ref{makeinfo top, , -@code{@@top}}.)@refill - -Texinfo provides two main methods for creating a title page. One method -uses the @code{@@titlefont}, @code{@@sp}, and @code{@@center} commands -to generate a title page in which the words on the page are -centered.@refill - -The second method uses the @code{@@title}, @code{@@subtitle}, and -@code{@@author} commands to create a title page with black rules under -the title and author lines and the subtitle text set flush to the -right hand side of the page. With this method, you do not specify any -of the actual formatting of the title page. You specify the text -you want, and Texinfo does the formatting. You may use either -method.@refill - -@findex shorttitlepage -For extremely simple applications, Texinfo also provides a command -@code{@@shorttitlepage} which takes a single argument as the title. -The argument is typeset on a page by itself and followed by a blank -page. - - -@node titlefont center sp, title subtitle author, titlepage, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection @code{@@titlefont}, @code{@@center}, and @code{@@sp} -@findex titlefont -@findex center -@findex sp @r{(titlepage line spacing)} - -You can use the @code{@@titlefont}, @code{@@sp}, and @code{@@center} -commands to create a title page for a printed document. (This is the -first of the two methods for creating a title page in Texinfo.)@refill - -Use the @code{@@titlefont} command to select a large font suitable for -the title itself.@refill - -@need 700 -For example: - -@example -@@titlefont@{Texinfo@} -@end example - -Use the @code{@@center} command at the beginning of a line to center -the remaining text on that line. Thus,@refill - -@example -@@center @@titlefont@{Texinfo@} -@end example - -@noindent -centers the title, which in this example is ``Texinfo'' printed -in the title font.@refill - -Use the @code{@@sp} command to insert vertical space. For example:@refill - -@example -@@sp 2 -@end example - -@noindent -This inserts two blank lines on the printed page. (@xref{sp, , -@code{@@sp}}, for more information about the @code{@@sp} -command.)@refill - -A template for this method looks like this:@refill - -@example -@group -@@titlepage -@@sp 10 -@@center @@titlefont@{@var{name-of-manual-when-printed}@} -@@sp 2 -@@center @var{subtitle-if-any} -@@sp 2 -@@center @var{author} -@dots{} -@@end titlepage -@end group -@end example - -The spacing of the example fits an 8 1/2 by 11 inch manual.@refill - -@node title subtitle author, Copyright & Permissions, titlefont center sp, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection @code{@@title}, @code{@@subtitle}, and @code{@@author} -@findex title -@findex subtitle -@findex author - -You can use the @code{@@title}, @code{@@subtitle}, and @code{@@author} -commands to create a title page in which the vertical and horizontal -spacing is done for you automatically. This contrasts with the method -described in -the previous section, in which the @code{@@sp} command is needed to -adjust vertical spacing.@refill - -Write the @code{@@title}, @code{@@subtitle}, or @code{@@author} -commands at the beginning of a line followed by the title, subtitle, -or author.@refill - -The @code{@@title} command produces a line in which the title is set -flush to the left-hand side of the page in a larger than normal font. -The title is underlined with a black rule.@refill - -The @code{@@subtitle} command sets subtitles in a normal-sized font -flush to the right-hand side of the page.@refill - -The @code{@@author} command sets the names of the author or authors in -a middle-sized font flush to the left-hand side of the page on a line -near the bottom of the title page. The names are underlined with a -black rule that is thinner than the rule that underlines the title. -(The black rule only occurs if the @code{@@author} command line is -followed by an @code{@@page} command line.)@refill - -There are two ways to use the @code{@@author} command: you can write -the name or names on the remaining part of the line that starts with -an @code{@@author} command:@refill - -@example -@@author by Jane Smith and John Doe -@end example - -@noindent -or you can write the names one above each other by using two (or more) -@code{@@author} commands:@refill - -@example -@group -@@author Jane Smith -@@author John Doe -@end group -@end example - -@noindent -(Only the bottom name is underlined with a black rule.)@refill - -@need 950 -A template for this method looks like this:@refill - -@example -@group -@@titlepage -@@title @var{name-of-manual-when-printed} -@@subtitle @var{subtitle-if-any} -@@subtitle @var{second-subtitle} -@@author @var{author} -@@page -@dots{} -@@end titlepage -@end group -@end example - -@ifinfo -@noindent -Contrast this form with the form of a title page written using the -@code{@@sp}, @code{@@center}, and @code{@@titlefont} commands:@refill - -@example -@@titlepage -@@sp 10 -@@center @@titlefont@{Name of Manual When Printed@} -@@sp 2 -@@center Subtitle, If Any -@@sp 1 -@@center Second subtitle -@@sp 2 -@@center Author -@@page -@dots{} -@@end titlepage -@end example -@end ifinfo - -@node Copyright & Permissions, end titlepage, title subtitle author, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection Copyright Page and Permissions -@cindex Copyright page -@cindex Printed permissions -@cindex Permissions, printed - -By international treaty, the copyright notice for a book should be -either on the title page or on the back of the title page. The -copyright notice should include the year followed by the name of the -organization or person who owns the copyright.@refill - -When the copyright notice is on the back of the title page, that page -is customarily not numbered. Therefore, in Texinfo, the information -on the copyright page should be within @code{@@titlepage} and -@code{@@end titlepage} commands.@refill - -@findex vskip -@findex filll -@cindex Vertical whitespace (@samp{vskip}) -Use the @code{@@page} command to cause a page break. To push the -copyright notice and the other text on the copyright page towards the -bottom of the page, you can write a somewhat mysterious line after the -@code{@@page} command that reads like this:@refill - -@example -@@vskip 0pt plus 1filll -@end example - -@noindent -This is a @TeX{} command that is not supported by the Info formatting -commands. The @code{@@vskip} command inserts whitespace. The -@samp{0pt plus 1filll} means to put in zero points of mandatory whitespace, -and as much optional whitespace as needed to push the -following text to the bottom of the page. Note the use of three -@samp{l}s in the word @samp{filll}; this is the correct usage in -@TeX{}.@refill - -@findex copyright -In a printed manual, the @code{@@copyright@{@}} command generates a -@samp{c} inside a circle. (In Info, it generates @samp{(C)}.) The -copyright notice itself has the following legally defined sequence:@refill - -@example -Copyright @copyright{} @var{year} @var{copyright-owner} -@end example - -It is customary to put information on how to get a manual after the -copyright notice, followed by the copying permissions for the -manual.@refill - -Note that permissions must be given here as well as in the summary -segment within @code{@@ifinfo} and @code{@@end ifinfo} that -immediately follows the header since this text appears only in the -printed manual and the @samp{ifinfo} text appears only in the Info -file.@refill - -@xref{Sample Permissions}, for the standard text.@refill - -@node end titlepage, headings on off, Copyright & Permissions, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection Heading Generation -@findex end titlepage -@cindex Headings, page, begin to appear -@cindex Titlepage end starts headings -@cindex End titlepage starts headings - -An @code{@@end titlepage} command on a line by itself not only marks -the end of the title and copyright pages, but also causes @TeX{} to start -generating page headings and page numbers. - -To repeat what is said elsewhere, Texinfo has two standard page heading -formats, one for documents which are printed on one side of each sheet of paper -(single-sided printing), and the other for documents which are printed on both -sides of each sheet (double-sided printing). -(@xref{setchapternewpage, ,@code{@@setchapternewpage}}.) -You can specify these formats in different ways:@refill - -@itemize @bullet -@item -The conventional way is to write an @code{@@setchapternewpage} command -before the title page commands, and then have the @code{@@end -titlepage} command start generating page headings in the manner desired. -(@xref{setchapternewpage, , @code{@@setchapternewpage}}.)@refill - -@item -Alternatively, you can use the @code{@@headings} command to prevent page -headings from being generated or to start them for either single or -double-sided printing. (Write an @code{@@headings} command immediately -after the @code{@@end titlepage} command. @xref{headings on off, , The -@code{@@headings} Command}, for more information.)@refill - -@item -Or, you may specify your own page heading and footing format. -@xref{Headings, , Page Headings}, for detailed -information about page headings and footings.@refill -@end itemize - -Most documents are formatted with the standard single-sided or -double-sided format, using @code{@@setchapternewpage odd} for -double-sided printing and no @code{@@setchapternewpage} command for -single-sided printing.@refill - -@node headings on off, , end titlepage, Titlepage & Copyright Page -@comment node-name, next, previous, up -@subsection The @code{@@headings} Command -@findex headings - -The @code{@@headings} command is rarely used. It specifies what kind of -page headings and footings to print on each page. Usually, this is -controlled by the @code{@@setchapternewpage} command. You need the -@code{@@headings} command only if the @code{@@setchapternewpage} command -does not do what you want, or if you want to turn off pre-defined page -headings prior to defining your own. Write an @code{@@headings} command -immediately after the @code{@@end titlepage} command.@refill - -You can use @code{@@headings} as follows:@refill - -@table @code -@item @@headings off -Turn off printing of page headings.@refill - -@item @@headings single -Turn on page headings appropriate for single-sided printing. -@refill - -@item @@headings double -Turn on page headings appropriate for double-sided printing. The two -commands, @code{@@headings on} and @code{@@headings double}, are -synonymous.@refill - -@item @@headings singleafter -@itemx @@headings doubleafter -Turn on @code{single} or @code{double} headings, respectively, after the -current page is output. - -@item @@headings on -Turn on page headings: @code{single} if @samp{@@setchapternewpage -on}, @code{double} otherwise. -@end table - -For example, suppose you write @code{@@setchapternewpage off} before the -@code{@@titlepage} command to tell @TeX{} to start a new chapter on the -same page as the end of the last chapter. This command also causes -@TeX{} to typeset page headers for single-sided printing. To cause -@TeX{} to typeset for double sided printing, write @code{@@headings -double} after the @code{@@end titlepage} command. - -You can stop @TeX{} from generating any page headings at all by -writing @code{@@headings off} on a line of its own immediately after the -line containing the @code{@@end titlepage} command, like this:@refill - -@example -@@end titlepage -@@headings off -@end example - -@noindent -The @code{@@headings off} command overrides the @code{@@end titlepage} -command, which would otherwise cause @TeX{} to print page -headings.@refill - -You can also specify your own style of page heading and footing. -@xref{Headings, , Page Headings}, for more information.@refill - -@node The Top Node, Software Copying Permissions, Titlepage & Copyright Page, Beginning a File -@comment node-name, next, previous, up -@section The `Top' Node and Master Menu -@cindex @samp{@r{Top}} node -@cindex Master menu -@cindex Node, `Top' - -The `Top' node is the node from which you enter an Info file.@refill - -A `Top' node should contain a brief description of the Info file and an -extensive, master menu for the whole Info file. -This helps the reader understand what the Info file is -about. Also, you should write the version number of the program to -which the Info file applies; or, at least, the edition number.@refill - -The contents of the `Top' node should appear only in the Info file; none -of it should appear in printed output, so enclose it between -@code{@@ifinfo} and @code{@@end ifinfo} commands. (@TeX{} does not -print either an @code{@@node} line or a menu; they appear only in Info; -strictly speaking, you are not required to enclose these parts between -@code{@@ifinfo} and @code{@@end ifinfo}, but it is simplest to do so. -@xref{Conditionals, , Conditionally Visible Text}.)@refill - -@menu -* Title of Top Node:: Sketch what the file is about. -* Master Menu Parts:: A master menu has three or more parts. -@end menu - -@node Title of Top Node, Master Menu Parts, The Top Node, The Top Node -@ifinfo -@subheading `Top' Node Title -@end ifinfo - -Sometimes, you will want to place an @code{@@top} sectioning command -line containing the title of the document immediately after the -@code{@@node Top} line (@pxref{makeinfo top command, , The @code{@@top} -Sectioning Command}, for more information).@refill - -For example, the beginning of the Top node of this manual contains an -@code{@@top} sectioning command, a short description, and edition and -version information. It looks like this:@refill - -@example -@group -@dots{} -@@end titlepage - -@@ifinfo -@@node Top, Copying, , (dir) -@@top Texinfo - -Texinfo is a documentation system@dots{} -@end group - -@group -This is edition@dots{} -@dots{} -@@end ifinfo -@end group - -@group -@@menu -* Copying:: Texinfo is freely - redistributable. -* Overview:: What is Texinfo? -@dots{} -@end group -@@end menu -@end example - -In a `Top' node, the `Previous', and `Up' nodes usually refer to the top -level directory of the whole Info system, which is called @samp{(dir)}. -The `Next' node refers to the first node that follows the main or master -menu, which is usually the copying permissions, introduction, or first -chapter.@refill - -@node Master Menu Parts, , Title of Top Node, The Top Node -@subsection Parts of a Master Menu -@cindex Master menu parts -@cindex Parts of a master menu - -A @dfn{master menu} is a detailed main menu listing all the nodes in a -file. - -A master menu is enclosed in @code{@@menu} and @code{@@end menu} -commands and does not appear in the printed document.@refill - -Generally, a master menu is divided into parts.@refill - -@itemize @bullet -@item -The first part contains the major nodes in the Texinfo file: the nodes -for the chapters, chapter-like sections, and the appendices.@refill - -@item -The second part contains nodes for the indices.@refill - -@item -The third and subsequent parts contain a listing of the other, lower -level nodes, often ordered by chapter. This way, rather than go -through an intermediary menu, an inquirer can go directly to a -particular node when searching for specific information. These menu -items are not required; add them if you think they are a -convenience. If you do use them, put @code{@@detailmenu} before the -first one, and @code{@@end detailmenu} after the last; otherwise, -@code{makeinfo} will get confused. -@end itemize - -Each section in the menu can be introduced by a descriptive line. So -long as the line does not begin with an asterisk, it will not be -treated as a menu entry. (@xref{Writing a Menu}, for more -information.)@refill - -For example, the master menu for this manual looks like the following -(but has many more entries):@refill - -@example -@group -@@menu -* Copying:: Texinfo is freely - redistributable. -* Overview:: What is Texinfo? -* Texinfo Mode:: Special features in GNU Emacs. -@dots{} -@dots{} -@end group -@group -* Command and Variable Index:: - An entry for each @@-command. -* Concept Index:: An entry for each concept. -@end group - -@group -@@detailmenu - --- The Detailed Node Listing --- - -Overview of Texinfo - -* Info Files:: What is an Info file? -* Printed Manuals:: Characteristics of - a printed manual. -@dots{} -@dots{} -@end group - -@group -Using Texinfo Mode - -* Info on a Region:: Formatting part of a file - for Info. -@dots{} -@dots{} -@@end detailmenu -@@end menu -@end group -@end example - -@node Software Copying Permissions, , The Top Node, Beginning a File -@comment node-name, next, previous, up -@section Software Copying Permissions -@cindex Software copying permissions -@cindex Copying software -@cindex Distribution -@cindex License agreement - -If the Texinfo file has a section containing the ``General Public -License'' and the distribution information and a warranty disclaimer -for the software that is documented, this section usually follows the -`Top' node. The General Public License is very important to Project -GNU software. It ensures that you and others will continue to have a -right to use and share the software.@refill - -The copying and distribution information and the disclaimer are -followed by an introduction or else by the first chapter of the -manual.@refill - -@cindex Introduction, as part of file -Although an introduction is not a required part of a Texinfo file, it -is very helpful. Ideally, it should state clearly and concisely what -the file is about and who would be interested in reading it. In -general, an introduction would follow the licensing and distribution -information, although sometimes people put it earlier in the document. -Usually, an introduction is put in an @code{@@unnumbered} section. -(@xref{unnumbered & appendix, , The @code{@@unnumbered} and -@code{@@appendix} Commands}.)@refill - -@node Ending a File, Structuring, Beginning a File, Top -@comment node-name, next, previous, up -@chapter Ending a Texinfo File -@cindex Ending a Texinfo file -@cindex Texinfo file ending -@cindex File ending -@findex bye - -The end of a Texinfo file should include the commands that create -indices and generate detailed and summary tables of contents. -And it must include the @code{@@bye} command that marks the last line -processed by @TeX{}.@refill - -@need 700 -For example: - -@example -@@node Concept Index, , Variables Index, Top -@@c node-name, next, previous, up -@@unnumbered Concept Index - -@@printindex cp - -@@contents -@@bye -@end example - -@menu -* Printing Indices & Menus:: How to print an index in hardcopy and - generate index menus in Info. -* Contents:: How to create a table of contents. -* File End:: How to mark the end of a file. -@end menu - -@node Printing Indices & Menus, Contents, Ending a File, Ending a File -@comment node-name, next, previous, up -@section Index Menus and Printing an Index -@findex printindex -@cindex Printing an index -@cindex Indices, printing and menus -@cindex Generating menus with indices -@cindex Menus generated with indices - -To print an index means to include it as part of a manual or Info -file. This does not happen automatically just because you use -@code{@@cindex} or other index-entry generating commands in the -Texinfo file; those just cause the raw data for the index to be -accumulated. To generate an index, you must include the -@code{@@printindex} command at the place in the document where you -want the index to appear. Also, as part of the process of creating a -printed manual, you must run a program called @code{texindex} -(@pxref{Format/Print Hardcopy}) to sort the raw data to produce a sorted -index file. The sorted index file is what is actually used to -print the index.@refill - -Texinfo offers six different types of predefined index: the concept -index, the function index, the variables index, the keystroke index, the -program index, and the data type index (@pxref{Predefined Indices}). Each -index type has a two-letter name: @samp{cp}, @samp{fn}, @samp{vr}, -@samp{ky}, @samp{pg}, and @samp{tp}. You may merge indices, or put them -into separate sections (@pxref{Combining Indices}); or you may define -your own indices (@pxref{New Indices, , Defining New Indices}).@refill - -The @code{@@printindex} command takes a two-letter index name, reads -the corresponding sorted index file and formats it appropriately into -an index.@refill - -@ignore -The two-letter index names are: - -@table @samp -@item cp -concept index -@item fn -function index -@item vr -variable index -@item ky -key index -@item pg -program index -@item tp -data type index -@end table -@end ignore -The @code{@@printindex} command does not generate a chapter heading -for the index. Consequently, you should precede the -@code{@@printindex} command with a suitable section or chapter command -(usually @code{@@unnumbered}) to supply the chapter heading and put -the index into the table of contents. Precede the @code{@@unnumbered} -command with an @code{@@node} line.@refill - -@need 1200 -For example: - -@smallexample -@group -@@node Variable Index, Concept Index, Function Index, Top -@@comment node-name, next, previous, up -@@unnumbered Variable Index - -@@printindex vr -@end group - -@group -@@node Concept Index, , Variable Index, Top -@@comment node-name, next, previous, up -@@unnumbered Concept Index - -@@printindex cp -@end group - -@group -@@summarycontents -@@contents -@@bye -@end group -@end smallexample - -@noindent -(Readers often prefer that the concept index come last in a book, -since that makes it easiest to find.)@refill - -@ignore -@c TeX can do sorting, just not conveniently enough to handle sorting -@c Texinfo indexes. --karl, 5may97. -In @TeX{}, the @code{@@printindex} command needs a sorted index file -to work from. @TeX{} does not know how to do sorting; this is a -deficiency. @TeX{} writes output files of raw index data; use the -@code{texindex} program to convert these files to sorted index files. -(@xref{Format/Print Hardcopy}, for more information.)@refill -@end ignore - - -@node Contents, File End, Printing Indices & Menus, Ending a File -@comment node-name, next, previous, up -@section Generating a Table of Contents -@cindex Table of contents -@cindex Contents, Table of -@findex contents -@findex summarycontents -@findex shortcontents - -The @code{@@chapter}, @code{@@section}, and other structuring commands -supply the information to make up a table of contents, but they do not -cause an actual table to appear in the manual. To do this, you must -use the @code{@@contents} and @code{@@summarycontents} -commands:@refill - -@table @code -@item @@contents -Generate a table of contents in a printed manual, including all -chapters, sections, subsections, etc., as well as appendices and -unnumbered chapters. (Headings generated by the @code{@@heading} -series of commands do not appear in the table of contents.) The -@code{@@contents} command should be written on a line by -itself.@refill - -@item @@shortcontents -@itemx @@summarycontents -(@code{@@summarycontents} is a synonym for @code{@@shortcontents}; the -two commands are exactly the same.)@refill - -Generate a short or summary table of contents that lists only the -chapters (and appendices and unnumbered chapters). Omit sections, subsections -and subsubsections. Only a long manual needs a short table -of contents in addition to the full table of contents.@refill - -Write the @code{@@shortcontents} command on a line by itself right -@emph{before} the @code{@@contents} command.@refill -@end table - -The table of contents commands automatically generate a chapter-like -heading at the top of the first table of contents page. Write the table -of contents commands at the very end of a Texinfo file, just before the -@code{@@bye} command, following any index sections---anything in the -Texinfo file after the table of contents commands will be omitted from -the table of contents.@refill - -When you print a manual with a table of contents, the table of -contents are printed last and numbered with roman numerals. You need -to place those pages in their proper place, after the title page, -yourself. (This is the only collating you need to do for a printed -manual. The table of contents is printed last because it is generated -after the rest of the manual is typeset.)@refill - -@need 700 -Here is an example of where to write table of contents commands:@refill - -@example -@group -@var{indices}@dots{} -@@shortcontents -@@contents -@@bye -@end group -@end example - -Since an Info file uses menus instead of tables of contents, the Info -formatting commands ignore the @code{@@contents} and -@code{@@shortcontents} commands.@refill - -@node File End, , Contents, Ending a File -@comment node-name, next, previous, up -@section @code{@@bye} File Ending -@findex bye - -An @code{@@bye} command terminates @TeX{} or Info formatting. None of -the formatting commands see any of the file following @code{@@bye}. -The @code{@@bye} command should be on a line by itself.@refill - -If you wish, you may follow the @code{@@bye} line with notes. These notes -will not be formatted and will not appear in either Info or a printed -manual; it is as if text after @code{@@bye} were within @code{@@ignore} -@dots{} @code{@@end ignore}. Also, you may follow the @code{@@bye} line -with a local variables list. @xref{Compile-Command, , Using Local -Variables and the Compile Command}, for more information.@refill - -@node Structuring, Nodes, Ending a File, Top -@comment node-name, next, previous, up -@chapter Chapter Structuring -@cindex Chapter structuring -@cindex Structuring of chapters - -The @dfn{chapter structuring} commands divide a document into a hierarchy of -chapters, sections, subsections, and subsubsections. These commands -generate large headings; they also provide information for the table -of contents of a printed manual (@pxref{Contents, , Generating a Table -of Contents}).@refill - -The chapter structuring commands do not create an Info node structure, -so normally you should put an @code{@@node} command immediately before -each chapter structuring command (@pxref{Nodes}). The only time you -are likely to use the chapter structuring commands without using the -node structuring commands is if you are writing a document that -contains no cross references and will never be transformed into Info -format.@refill - -It is unlikely that you will ever write a Texinfo file that is -intended only as an Info file and not as a printable document. If you -do, you might still use chapter structuring commands to create a -heading at the top of each node---but you don't need to.@refill - -@menu -* Tree Structuring:: A manual is like an upside down tree @dots{} -* Structuring Command Types:: How to divide a manual into parts. -* makeinfo top:: The @code{@@top} command, part of the `Top' node. -* chapter:: -* unnumbered & appendix:: -* majorheading & chapheading:: -* section:: -* unnumberedsec appendixsec heading:: -* subsection:: -* unnumberedsubsec appendixsubsec subheading:: -* subsubsection:: Commands for the lowest level sections. -* Raise/lower sections:: How to change commands' hierarchical level. -@end menu - -@node Tree Structuring, Structuring Command Types, Structuring, Structuring -@comment node-name, next, previous, up -@section Tree Structure of Sections -@cindex Tree structuring - -A Texinfo file is usually structured like a book with chapters, -sections, subsections, and the like. This structure can be visualized -as a tree (or rather as an upside-down tree) with the root at the top -and the levels corresponding to chapters, sections, subsection, and -subsubsections.@refill - -Here is a diagram that shows a Texinfo file with three chapters, -each of which has two sections.@refill - -@example -@group - Top - | - ------------------------------------- - | | | - Chapter 1 Chapter 2 Chapter 3 - | | | - -------- -------- -------- - | | | | | | - Section Section Section Section Section Section - 1.1 1.2 2.1 2.2 3.1 3.2 - -@end group -@end example - -In a Texinfo file that has this structure, the beginning of Chapter 2 -looks like this:@refill - -@example -@group -@@node Chapter 2, Chapter 3, Chapter 1, top -@@chapter Chapter 2 -@end group -@end example - -The chapter structuring commands are described in the sections that -follow; the @code{@@node} and @code{@@menu} commands are described in -following chapters. (@xref{Nodes}, and see @ref{Menus}.)@refill - -@node Structuring Command Types, makeinfo top, Tree Structuring, Structuring -@comment node-name, next, previous, up -@section Types of Structuring Commands - -The chapter structuring commands fall into four groups or series, each -of which contains structuring commands corresponding to the -hierarchical levels of chapters, sections, subsections, and -subsubsections.@refill - -The four groups are the @code{@@chapter} series, the -@code{@@unnumbered} series, the @code{@@appendix} series, and the -@code{@@heading} series.@refill - -Each command produces titles that have a different appearance on the -printed page or Info file; only some of the commands produce -titles that are listed in the table of contents of a printed book or -manual.@refill - -@itemize @bullet -@item -The @code{@@chapter} and @code{@@appendix} series of commands produce -numbered or lettered entries both in the body of a printed work and in -its table of contents.@refill - -@item -The @code{@@unnumbered} series of commands produce unnumbered entries -both in the body of a printed work and in its table of contents. The -@code{@@top} command, which has a special use, is a member of this -series (@pxref{makeinfo top, , @code{@@top}}).@refill - -@item -The @code{@@heading} series of commands produce unnumbered headings -that do not appear in a table of contents. The heading commands never -start a new page.@refill - -@item -The @code{@@majorheading} command produces results similar to using -the @code{@@chapheading} command but generates a larger vertical -whitespace before the heading.@refill - -@item -When an @code{@@setchapternewpage} command says to do so, the -@code{@@chapter}, @code{@@unnumbered}, and @code{@@appendix} commands -start new pages in the printed manual; the @code{@@heading} commands -do not.@refill -@end itemize - -@need 1000 -Here are the four groups of chapter structuring commands:@refill - -@c Slightly different formatting for regular sized books and smallbooks. -@ifset smallbook -@sp 1 -@tex -{\let\rm=\indrm \let\tt=\indtt -\halign{\hskip\itemindent#\hfil& \hskip.5em#\hfil& \hskip.5em#\hfil& -\hskip.5em#\hfil\cr - -& & & \rm No new pages\cr -\rm Numbered& \rm Unnumbered& \rm Lettered and numbered& \rm Unnumbered\cr -\rm In contents& \rm In contents& \rm In contents& \rm Not in contents\cr - -& & & \cr - & \tt @@top& & \tt @@majorheading\cr -\tt @@chapter& \tt @@unnumbered& \tt @@appendix& \tt @@chapheading\cr -\tt @@section& \tt @@unnumberedsec& \tt @@appendixsec& \tt @@heading\cr -\tt @@subsection&\tt @@unnumberedsubsec&\tt @@appendixsubsec& -\tt @@subheading\cr -\tt @@subsubsection& \tt @@unnumberedsubsubsec& \tt @@appendixsubsubsec& -\tt @@subsubheading\cr}} -@end tex -@end ifset -@ifclear smallbook -@sp 1 -@tex -\vbox{ -\halign{\hskip\itemindent\hskip.5em#\hfil& \hskip.5em#\hfil& -\hskip.5em#\hfil& \hskip.5em #\hfil\cr - -& & & \cr -& & & \rm No new pages\cr -\rm Numbered& \rm Unnumbered& \rm Lettered and numbered& \rm Unnumbered\cr -\rm In contents& \rm In contents& \rm In contents& \rm Not in contents\cr - -& & & \cr - & \tt @@top& & \tt @@majorheading\cr -\tt @@chapter& \tt @@unnumbered& \tt @@appendix& \tt @@chapheading\cr -\tt @@section& \tt @@unnumberedsec& \tt @@appendixsec& \tt @@heading\cr -\tt @@subsection&\tt @@unnumberedsubsec&\tt @@appendixsubsec& -\tt @@subheading\cr -\tt @@subsubsection& \tt @@unnumberedsubsubsec& \tt @@appendixsubsubsec& -\tt @@subsubheading\cr}} -@end tex -@end ifclear -@ifinfo -@example -@group - @r{No new pages} -@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} -@r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - - @@top @@majorheading -@@chapter @@unnumbered @@appendix @@chapheading -@@section @@unnumberedsec @@appendixsec @@heading -@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading -@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading -@end group -@end example -@end ifinfo - -@c Cannot line up columns properly inside of an example because of roman -@c proportional fonts. -@ignore -@ifset smallbook -@iftex -@smallexample -@group - @r{No new pages} -@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} -@r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - - @@top @@majorheading -@@chapter @@unnumbered @@appendix @@chapheading -@@section @@unnumberedsec @@appendixsec @@heading -@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading -@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading -@end group -@end smallexample -@end iftex -@end ifset -@ifclear smallbook -@iftex -@smallexample -@group - @r{No new pages} -@r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} -@r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - - @@top @@majorheading -@@chapter @@unnumbered @@appendix @@chapheading -@@section @@unnumberedsec @@appendixsec @@heading -@@subsection @@unnumberedsubsec @@appendixsubsec @@subheading -@@subsubsection @@unnumberedsubsubsec @@appendixsubsubsec @@subsubheading -@end group -@end smallexample -@end iftex -@end ignore - -@node makeinfo top, chapter, Structuring Command Types, Structuring -@comment node-name, next, previous, up -@section @code{@@top} - -The @code{@@top} command is a special sectioning command that you use -only after an @samp{@@node Top} line at the beginning of a Texinfo file. -The @code{@@top} command tells the @code{makeinfo} formatter -which node is the `Top' -node. It has the same typesetting effect as @code{@@unnumbered} -(@pxref{unnumbered & appendix, , @code{@@unnumbered}, @code{@@appendix}}). -For detailed information, see -@ref{makeinfo top command, , The @code{@@top} Command}.@refill - -@node chapter, unnumbered & appendix, makeinfo top, Structuring -@comment node-name, next, previous, up -@section @code{@@chapter} -@findex chapter - -@code{@@chapter} identifies a chapter in the document. Write the -command at the beginning of a line and follow it on the same line by -the title of the chapter.@refill - -For example, this chapter in this manual is entitled ``Chapter -Structuring''; the @code{@@chapter} line looks like this:@refill - -@example -@@chapter Chapter Structuring -@end example - -In @TeX{}, the @code{@@chapter} command creates a chapter in the -document, specifying the chapter title. The chapter is numbered -automatically.@refill - -In Info, the @code{@@chapter} command causes the title to appear on a -line by itself, with a line of asterisks inserted underneath. Thus, -in Info, the above example produces the following output:@refill - -@example -Chapter Structuring -******************* -@end example - -@findex centerchap -Texinfo also provides a command @code{@@centerchap}, which is analogous -to @code{@@unnumbered}, but centers its argument in the printed output. -This kind of stylistic choice is not usually offered by Texinfo. -@c but the Hacker's Dictionary wanted it ... - - -@node unnumbered & appendix, majorheading & chapheading, chapter, Structuring -@comment node-name, next, previous, up -@section @code{@@unnumbered}, @code{@@appendix} -@findex unnumbered -@findex appendix - -Use the @code{@@unnumbered} command to create a chapter that appears -in a printed manual without chapter numbers of any kind. Use the -@code{@@appendix} command to create an appendix in a printed manual -that is labelled by letter instead of by number.@refill - -For Info file output, the @code{@@unnumbered} and @code{@@appendix} -commands are equivalent to @code{@@chapter}: the title is printed on a -line by itself with a line of asterisks underneath. (@xref{chapter, , -@code{@@chapter}}.)@refill - -To create an appendix or an unnumbered chapter, write an -@code{@@appendix} or @code{@@unnumbered} command at the beginning of a -line and follow it on the same line by the title, as you would if you -were creating a chapter.@refill - - -@node majorheading & chapheading, section, unnumbered & appendix, Structuring -@section @code{@@majorheading}, @code{@@chapheading} -@findex majorheading -@findex chapheading - -The @code{@@majorheading} and @code{@@chapheading} commands put -chapter-like headings in the body of a document.@refill - -However, neither command causes @TeX{} to produce a numbered heading -or an entry in the table of contents; and neither command causes -@TeX{} to start a new page in a printed manual.@refill - -In @TeX{}, an @code{@@majorheading} command generates a larger vertical -whitespace before the heading than an @code{@@chapheading} command but -is otherwise the same.@refill - -In Info, -the @code{@@majorheading} and -@code{@@chapheading} commands are equivalent to -@code{@@chapter}: the title is printed on a line by itself with a line -of asterisks underneath. (@xref{chapter, , @code{@@chapter}}.)@refill - -@node section, unnumberedsec appendixsec heading, majorheading & chapheading, Structuring -@comment node-name, next, previous, up -@section @code{@@section} -@findex section - -In a printed manual, an @code{@@section} command identifies a -numbered section within a chapter. The section title appears in the -table of contents. In Info, an @code{@@section} command provides a -title for a segment of text, underlined with @samp{=}.@refill - -This section is headed with an @code{@@section} command and looks like -this in the Texinfo file:@refill - -@example -@@section @@code@{@@@@section@} -@end example - -To create a section, write the @code{@@section} command at the -beginning of a line and follow it on the same line by the section -title.@refill - -Thus, - -@example -@@section This is a section -@end example - -@noindent -produces - -@example -@group -This is a section -================= -@end group -@end example - -@noindent -in Info. - -@node unnumberedsec appendixsec heading, subsection, section, Structuring -@comment node-name, next, previous, up -@section @code{@@unnumberedsec}, @code{@@appendixsec}, @code{@@heading} -@findex unnumberedsec -@findex appendixsec -@findex heading - -The @code{@@unnumberedsec}, @code{@@appendixsec}, and @code{@@heading} -commands are, respectively, the unnumbered, appendix-like, and -heading-like equivalents of the @code{@@section} command. -(@xref{section, , @code{@@section}}.)@refill - -@table @code -@item @@unnumberedsec -The @code{@@unnumberedsec} command may be used within an -unnumbered chapter or within a regular chapter or appendix to -provide an unnumbered section.@refill - -@item @@appendixsec -@itemx @@appendixsection -@code{@@appendixsection} is a longer spelling of the -@code{@@appendixsec} command; the two are synonymous.@refill -@findex appendixsection - -Conventionally, the @code{@@appendixsec} or @code{@@appendixsection} -command is used only within appendices.@refill - -@item @@heading -You may use the @code{@@heading} command anywhere you wish for a -section-style heading that will not appear in the table of contents.@refill -@end table - -@node subsection, unnumberedsubsec appendixsubsec subheading, unnumberedsec appendixsec heading, Structuring -@comment node-name, next, previous, up -@section The @code{@@subsection} Command -@findex subsection - -Subsections are to sections as sections are to chapters. -(@xref{section, , @code{@@section}}.) In Info, subsection titles are -underlined with @samp{-}. For example,@refill - -@example -@@subsection This is a subsection -@end example - -@noindent -produces - -@example -@group -This is a subsection --------------------- -@end group -@end example - -In a printed manual, subsections are listed in the table of contents -and are numbered three levels deep.@refill - -@node unnumberedsubsec appendixsubsec subheading, subsubsection, subsection, Structuring -@comment node-name, next, previous, up -@section The @code{@@subsection}-like Commands -@cindex Subsection-like commands -@findex unnumberedsubsec -@findex appendixsubsec -@findex subheading - -The @code{@@unnumberedsubsec}, @code{@@appendixsubsec}, and -@code{@@subheading} commands are, respectively, the unnumbered, -appendix-like, and heading-like equivalents of the @code{@@subsection} -command. (@xref{subsection, , @code{@@subsection}}.)@refill - -In Info, the @code{@@subsection}-like commands generate a title -underlined with hyphens. In a printed manual, an @code{@@subheading} -command produces a heading like that of a subsection except that it is -not numbered and does not appear in the table of contents. Similarly, -an @code{@@unnumberedsubsec} command produces an unnumbered heading like -that of a subsection and an @code{@@appendixsubsec} command produces a -subsection-like heading labelled with a letter and numbers; both of -these commands produce headings that appear in the table of -contents.@refill - -@node subsubsection, Raise/lower sections, unnumberedsubsec appendixsubsec subheading, Structuring -@comment node-name, next, previous, up -@section The `subsub' Commands -@cindex Subsub commands -@findex subsubsection -@findex unnumberedsubsubsec -@findex appendixsubsubsec -@findex subsubheading - -The fourth and lowest level sectioning commands in Texinfo are the -`subsub' commands. They are:@refill - -@table @code -@item @@subsubsection -Subsubsections are to subsections as subsections are to sections. -(@xref{subsection, , @code{@@subsection}}.) In a printed manual, -subsubsection titles appear in the table of contents and are numbered -four levels deep.@refill - -@item @@unnumberedsubsubsec -Unnumbered subsubsection titles appear in the table of contents of a -printed manual, but lack numbers. Otherwise, unnumbered -subsubsections are the same as subsubsections. In Info, unnumbered -subsubsections look exactly like ordinary subsubsections.@refill - -@item @@appendixsubsubsec -Conventionally, appendix commands are used only for appendices and are -lettered and numbered appropriately in a printed manual. They also -appear in the table of contents. In Info, appendix subsubsections look -exactly like ordinary subsubsections.@refill - -@item @@subsubheading -The @code{@@subsubheading} command may be used anywhere that you need -a small heading that will not appear in the table of contents. In -Info, subsubheadings look exactly like ordinary subsubsection -headings.@refill -@end table - -In Info, `subsub' titles are underlined with periods. -For example,@refill - -@example -@@subsubsection This is a subsubsection -@end example - -@noindent -produces - -@example -@group -This is a subsubsection -....................... -@end group -@end example - -@node Raise/lower sections, , subsubsection, Structuring -@comment node-name, next, previous, up -@section @code{@@raisesections} and @code{@@lowersections} -@findex raisesections -@findex lowersections -@cindex Raising and lowering sections -@cindex Sections, raising and lowering - -The @code{@@raisesections} and @code{@@lowersections} commands raise and -lower the hierarchical level of chapters, sections, subsections and the -like. The @code{@@raisesections} command changes sections to chapters, -subsections to sections, and so on. The @code{@@lowersections} command -changes chapters to sections, sections to subsections, and so on. - -@cindex Include files, and section levels -An @code{@@lowersections} command is useful if you wish to include text -that is written as an outer or standalone Texinfo file in another -Texinfo file as an inner, included file. If you write the command at -the beginning of the file, all your @code{@@chapter} commands are -formatted as if they were @code{@@section} commands, all your -@code{@@section} command are formatted as if they were -@code{@@subsection} commands, and so on. - -@need 1000 -@code{@@raisesections} raises a command one level in the chapter -structuring hierarchy:@refill - -@example -@group - @r{Change} @r{To} - -@@subsection @@section, -@@section @@chapter, -@@heading @@chapheading, - @r{etc.} -@end group -@end example - -@need 1000 -@code{@@lowersections} lowers a command one level in the chapter -structuring hierarchy:@refill - -@example -@group - @r{Change} @r{To} - -@@chapter @@section, -@@subsection @@subsubsection, -@@heading @@subheading, - @r{etc.} -@end group -@end example - -An @code{@@raisesections} or @code{@@lowersections} command changes only -those structuring commands that follow the command in the Texinfo file. -Write an @code{@@raisesections} or @code{@@lowersections} command on a -line of its own. - -An @code{@@lowersections} command cancels an @code{@@raisesections} -command, and vice versa. Typically, the commands are used like this: - -@example -@@lowersections -@@include somefile.texi -@@raisesections -@end example - -Without the @code{@@raisesections}, all the subsequent sections in your -document will be lowered. - -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. - -@node Nodes, Menus, Structuring, Top -@comment node-name, next, previous, up -@chapter Nodes - -@dfn{Nodes} are the primary segments of a Texinfo file. They do not -themselves impose a hierarchic or any other kind of structure on a file. -Nodes contain @dfn{node pointers} that name other nodes, and can contain -@dfn{menus} which are lists of nodes. In Info, the movement commands -can carry you to a pointed-to node or to a node listed in a menu. Node -pointers and menus provide structure for Info files just as chapters, -sections, subsections, and the like, provide structure for printed -books.@refill - -@menu -* Two Paths:: Different commands to structure - Info output and printed output. -* Node Menu Illustration:: A diagram, and sample nodes and menus. -* node:: How to write a node, in detail. -* makeinfo Pointer Creation:: How to create node pointers with @code{makeinfo}. -@end menu - -@node Two Paths, Node Menu Illustration, Nodes, Nodes -@ifinfo -@heading Two Paths -@end ifinfo - -The node and menu commands and the chapter structuring commands are -independent of each other: - -@itemize @bullet -@item -In Info, node and menu commands provide structure. The chapter -structuring commands generate headings with different kinds of -underlining---asterisks for chapters, hyphens for sections, and so on; -they do nothing else.@refill - -@item -In @TeX{}, the chapter structuring commands generate chapter and section -numbers and tables of contents. The node and menu commands provide -information for cross references; they do nothing else.@refill -@end itemize - -You can use node pointers and menus to structure an Info file any way -you want; and you can write a Texinfo file so that its Info output has a -different structure than its printed output. However, most Texinfo -files are written such that the structure for the Info output -corresponds to the structure for the printed output. It is not -convenient to do otherwise.@refill - -Generally, printed output is structured in a tree-like hierarchy in -which the chapters are the major limbs from which the sections branch -out. Similarly, node pointers and menus are organized to create a -matching structure in the Info output.@refill - -@node Node Menu Illustration, node, Two Paths, Nodes -@comment node-name, next, previous, up -@section Node and Menu Illustration - -Here is a copy of the diagram shown earlier that illustrates a Texinfo -file with three chapters, each of which contains two sections.@refill - -Note that the ``root'' is at the top of the diagram and the ``leaves'' -are at the bottom. This is how such a diagram is drawn conventionally; -it illustrates an upside-down tree. For this reason, the root node is -called the `Top' node, and `Up' node pointers carry you closer to the -root.@refill - -@example -@group - Top - | - ------------------------------------- - | | | - Chapter 1 Chapter 2 Chapter 3 - | | | - -------- -------- -------- - | | | | | | - Section Section Section Section Section Section - 1.1 1.2 2.1 2.2 3.1 3.2 - -@end group -@end example - -Write the beginning of the node for Chapter 2 like this:@refill - -@example -@group -@@node Chapter 2, Chapter 3, Chapter 1, top -@@comment node-name, next, previous, up -@end group -@end example - -@noindent -This @code{@@node} line says that the name of this node is ``Chapter 2'', the -name of the `Next' node is ``Chapter 3'', the name of the `Previous' -node is ``Chapter 1'', and the name of the `Up' node is ``Top''. - -@quotation -@strong{Please Note:} `Next' refers to the next node at the same -hierarchical level in the manual, not necessarily to the next node -within the Texinfo file. In the Texinfo file, the subsequent node may -be at a lower level---a section-level node may follow a chapter-level -node, and a subsection-level node may follow a section-level node. -`Next' and `Previous' refer to nodes at the @emph{same} hierarchical -level. (The `Top' node contains the exception to this rule. Since the -`Top' node is the only node at that level, `Next' refers to the first -following node, which is almost always a chapter or chapter-level -node.)@refill -@end quotation - -To go to Sections 2.1 and 2.2 using Info, you need a menu inside Chapter -2. (@xref{Menus}.) You would write the menu just -before the beginning of Section 2.1, like this:@refill - -@example -@group - @@menu - * Sect. 2.1:: Description of this section. - * Sect. 2.2:: - @@end menu -@end group -@end example - -Write the node for Sect. 2.1 like this:@refill - -@example -@group - @@node Sect. 2.1, Sect. 2.2, Chapter 2, Chapter 2 - @@comment node-name, next, previous, up -@end group -@end example - -In Info format, the `Next' and `Previous' pointers of a node usually -lead to other nodes at the same level---from chapter to chapter or from -section to section (sometimes, as shown, the `Previous' pointer points -up); an `Up' pointer usually leads to a node at the level above (closer -to the `Top' node); and a `Menu' leads to nodes at a level below (closer -to `leaves'). (A cross reference can point to a node at any level; -see @ref{Cross References}.)@refill - -Usually, an @code{@@node} command and a chapter structuring command are -used in sequence, along with indexing commands. (You may follow the -@code{@@node} line with a comment line that reminds you which pointer is -which.)@refill - -Here is the beginning of the chapter in this manual called ``Ending a -Texinfo File''. This shows an @code{@@node} line followed by a comment -line, an @code{@@chapter} line, and then by indexing lines.@refill - -@example -@group -@@node Ending a File, Structuring, Beginning a File, Top -@@comment node-name, next, previous, up -@@chapter Ending a Texinfo File -@@cindex Ending a Texinfo file -@@cindex Texinfo file ending -@@cindex File ending -@end group -@end example - -@node node, makeinfo Pointer Creation, Node Menu Illustration, Nodes -@comment node-name, next, previous, up -@section The @code{@@node} Command - -@cindex Node, defined -A @dfn{node} is a segment of text that begins at an @code{@@node} -command and continues until the next @code{@@node} command. The -definition of node is different from that for chapter or section. A -chapter may contain sections and a section may contain subsections; -but a node cannot contain subnodes; the text of a node continues only -until the next @code{@@node} command in the file. A node usually -contains only one chapter structuring command, the one that follows -the @code{@@node} line. On the other hand, in printed output nodes -are used only for cross references, so a chapter or section may -contain any number of nodes. Indeed, a chapter usually contains -several nodes, one for each section, subsection, and -subsubsection.@refill - -To create a node, write an @code{@@node} command at the beginning of a -line, and follow it with four arguments, separated by commas, on the -rest of the same line. These arguments are the name of the node, and -the names of the `Next', `Previous', and `Up' pointers, in that order. -You may insert spaces before each pointer if you wish; the spaces are -ignored. You must write the name of the node, and the names of the -`Next', `Previous', and `Up' pointers, all on the same line. Otherwise, -the formatters fail. (@inforef{Top, info, info}, for more information -about nodes in Info.)@refill - -Usually, you write one of the chapter-structuring command lines -immediately after an @code{@@node} line---for example, an -@code{@@section} or @code{@@subsection} line. (@xref{Structuring -Command Types, , Types of Structuring Commands}.)@refill - -@quotation -@strong{Please note:} The GNU Emacs Texinfo mode updating commands work -only with Texinfo files in which @code{@@node} lines are followed by chapter -structuring lines. @xref{Updating Requirements}.@refill -@end quotation - -@TeX{} uses @code{@@node} lines to identify the names to use for cross -references. For this reason, you must write @code{@@node} lines in a -Texinfo file that you intend to format for printing, even if you do not -intend to format it for Info. (Cross references, such as the one at the -end of this sentence, are made with @code{@@xref} and its related -commands; see @ref{Cross References}.)@refill - -@menu -* Node Names:: How to choose node and pointer names. -* Writing a Node:: How to write an @code{@@node} line. -* Node Line Tips:: Keep names short. -* Node Line Requirements:: Keep names unique, without @@-commands. -* First Node:: How to write a `Top' node. -* makeinfo top command:: How to use the @code{@@top} command. -* Top Node Summary:: Write a brief description for readers. -@end menu - -@node Node Names, Writing a Node, node, node -@ifinfo -@subheading Choosing Node and Pointer Names -@end ifinfo - -The name of a node identifies the node. The pointers enable -you to reach other nodes and consist of the names of those nodes.@refill - -Normally, a node's `Up' pointer contains the name of the node whose menu -mentions that node. The node's `Next' pointer contains the name of the -node that follows that node in that menu and its `Previous' pointer -contains the name of the node that precedes it in that menu. When a -node's `Previous' node is the same as its `Up' node, both node pointers -name the same node.@refill - -Usually, the first node of a Texinfo file is the `Top' node, and its -`Up' and `Previous' pointers point to the @file{dir} file, which -contains the main menu for all of Info.@refill - -The `Top' node itself contains the main or master menu for the manual. -Also, it is helpful to include a brief description of the manual in the -`Top' node. @xref{First Node}, for information on how to write the -first node of a Texinfo file.@refill - -@node Writing a Node, Node Line Tips, Node Names, node -@comment node-name, next, previous, up -@subsection How to Write an @code{@@node} Line -@cindex Writing an @code{@@node} line -@cindex @code{@@node} line writing -@cindex Node line writing - -The easiest way to write an @code{@@node} line is to write @code{@@node} -at the beginning of a line and then the name of the node, like -this:@refill - -@example -@@node @var{node-name} -@end example - -If you are using GNU Emacs, you can use the update node commands -provided by Texinfo mode to insert the names of the pointers; or you -can leave the pointers out of the Texinfo file and let @code{makeinfo} -insert node pointers into the Info file it creates. (@xref{Texinfo -Mode}, and @ref{makeinfo Pointer Creation}.)@refill - -Alternatively, you can insert the `Next', `Previous', and `Up' -pointers yourself. If you do this, you may find it helpful to use the -Texinfo mode keyboard command @kbd{C-c C-c n}. This command inserts -@samp{@@node} and a comment line listing the names of the pointers in -their proper order. The comment line helps you keep track of which -arguments are for which pointers. This comment line is especially useful -if you are not familiar with Texinfo.@refill - -The template for a node line with `Next', `Previous', and `Up' pointers -looks like this:@refill - -@example -@@node @var{node-name}, @var{next}, @var{previous}, @var{up} -@end example - -If you wish, you can ignore @code{@@node} lines altogether in your first -draft and then use the @code{texinfo-insert-node-lines} command to -create @code{@@node} lines for you. However, we do not -recommend this practice. It is better to name the node itself -at the same time that you -write a segment so you can easily make cross references. A large number -of cross references are an especially important feature of a good Info -file.@refill - -After you have inserted an @code{@@node} line, you should immediately -write an @@-command for the chapter or section and insert its name. -Next (and this is important!), put in several index entries. Usually, -you will find at least two and often as many as four or five ways of -referring to the node in the index. Use them all. This will make it -much easier for people to find the node.@refill - -@node Node Line Tips, Node Line Requirements, Writing a Node, node -@comment node-name, next, previous, up -@subsection @code{@@node} Line Tips - -Here are three suggestions: - -@itemize @bullet -@item -Try to pick node names that are informative but short.@refill - -In the Info file, the file name, node name, and pointer names are all -inserted on one line, which may run into the right edge of the window. -(This does not cause a problem with Info, but is ugly.)@refill - -@item -Try to pick node names that differ from each other near the beginnings -of their names. This way, it is easy to use automatic name completion in -Info.@refill - -@item -By convention, node names are capitalized just as they would be for -section or chapter titles---initial and significant words are -capitalized; others are not.@refill -@end itemize - -@node Node Line Requirements, First Node, Node Line Tips, node -@comment node-name, next, previous, up -@subsection @code{@@node} Line Requirements - -@cindex Node line requirements -Here are several requirements for @code{@@node} lines: - -@itemize @bullet -@cindex Unique nodename requirement -@cindex Nodename must be unique -@item -All the node names for a single Info file must be unique.@refill - -Duplicates confuse the Info movement commands. This means, for -example, that if you end every chapter with a summary, you must name -each summary node differently. You cannot just call each one -``Summary''. You may, however, duplicate the titles of chapters, sections, -and the like. Thus you can end each chapter in a book with a section -called ``Summary'', so long as the node names for those sections are all -different.@refill - -@item -A pointer name must be the name of a node.@refill - -The node to which a pointer points may come before or after the -node containing the pointer.@refill - -@cindex @@-command in nodename -@cindex Nodename, cannot contain -@item -You cannot use any of the Texinfo @@-commands in a node name; -@w{@@-commands} confuse Info.@refill - -@need 750 -Thus, the beginning of the section called @code{@@chapter} looks like -this:@refill - -@smallexample -@group -@@node chapter, unnumbered & appendix, makeinfo top, Structuring -@@comment node-name, next, previous, up -@@section @@code@{@@@@chapter@} -@@findex chapter -@end group -@end smallexample - -@cindex Comma in nodename -@cindex Apostrophe in nodename -@item -You cannot use commas or apostrophes within a node name; these -confuse @TeX{} or the Info formatters.@refill - -@need 700 -For example, the following is a section title: - -@smallexample -@@code@{@@@@unnumberedsec@}, @@code@{@@@@appendixsec@}, @@code@{@@@@heading@} -@end smallexample - -@noindent -The corresponding node name is: - -@smallexample -unnumberedsec appendixsec heading -@end smallexample - -@cindex Case in nodename -@item -Case is significant. -@end itemize - - -@node First Node, makeinfo top command, Node Line Requirements, node -@comment node-name, next, previous, up -@subsection The First Node -@cindex Top node is first -@cindex First node - -The first node of a Texinfo file is the @dfn{Top} node, except in an -included file (@pxref{Include Files}). The Top node contains the main -or master menu for the document, and a short summary of the document -(@pxref{Top Node Summary}). - -@cindex Up node of Top node -@cindex (dir) as Up node of Top node -The Top node (which must be named @samp{top} or @samp{Top}) should have -as its `Up' node the name of a node in another file, where there is a -menu that leads to this file. Specify the file name in parentheses. If -the file is to be installed directly in the Info directory file, use -@samp{(dir)} as the parent of the Top node; this is short for -@samp{(dir)top}, and specifies the Top node in the @file{dir} file, -which contains the main menu for the Info system as a whole. For -example, the @code{@@node Top} line of this manual looks like this: - -@example -@@node Top, Copying, , (dir) -@end example - -@noindent -(You can use the Texinfo updating commands or the @code{makeinfo} -utility to insert these pointers automatically.) - -@cindex Previous node of Top node -Do not define the `Previous' node of the Top node to be @samp{(dir)}, as -it causes confusing behavior for users: if you are in the Top node and -hits @key{DEL} to go backwards, you wind up in the middle of the -some other entry in the @file{dir} file, which has nothing to do with -what you were reading. - -@xref{Install an Info File}, for more information about installing -an Info file in the @file{info} directory. - - -@node makeinfo top command, Top Node Summary, First Node, node -@comment node-name, next, previous, up -@subsection The @code{@@top} Sectioning Command -@findex top @r{(@@-command)} - -A special sectioning command, @code{@@top}, has been created for use -with the @code{@@node Top} line. The @code{@@top} sectioning command tells -@code{makeinfo} that it marks the `Top' node in the file. It provides -the information that @code{makeinfo} needs to insert node -pointers automatically. Write the @code{@@top} command at the -beginning of the line immediately following the @code{@@node Top} -line. Write the title on the remaining part of the same line as the -@code{@@top} command.@refill - -In Info, the @code{@@top} sectioning command causes the title to appear on a -line by itself, with a line of asterisks inserted underneath.@refill - -In @TeX{} and @code{texinfo-format-buffer}, the @code{@@top} -sectioning command is merely a synonym for @code{@@unnumbered}. -Neither of these formatters require an @code{@@top} command, and do -nothing special with it. You can use @code{@@chapter} or -@code{@@unnumbered} after the @code{@@node Top} line when you use -these formatters. Also, you can use @code{@@chapter} or -@code{@@unnumbered} when you use the Texinfo updating commands to -create or update pointers and menus.@refill - - -@node Top Node Summary, , makeinfo top command, node -@subsection The `Top' Node Summary -@cindex @samp{@r{Top}} node summary - -You can help readers by writing a summary in the `Top' node, after the -@code{@@top} line, before the main or master menu. The summary should -briefly describe the document. In Info, this summary will appear just -before the master menu. In a printed manual, this summary will appear -on a page of its own.@refill - -If you do not want the summary to appear on a page of its own in a -printed manual, you can enclose the whole of the `Top' node, including -the @code{@@node Top} line and the @code{@@top} sectioning command line -or other sectioning command line between @code{@@ifinfo} and @code{@@end -ifinfo}. This prevents any of the text from appearing in the printed -output. (@pxref{Conditionals, , Conditionally Visible Text}). You can -repeat the brief description from the `Top' node within @code{@@iftex} -@dots{} @code{@@end iftex} at the beginning of the first chapter, for -those who read the printed manual. This saves paper and may look -neater.@refill - -You should write the version number of the program to which the manual -applies in the summary. This helps the reader keep track of which -manual is for which version of the program. If the manual changes more -frequently than the program or is independent of it, you should also -include an edition number for the manual. (The title page should also -contain this information: see @ref{titlepage, , -@code{@@titlepage}}.)@refill - -@node makeinfo Pointer Creation, , node, Nodes -@section Creating Pointers with @code{makeinfo} -@cindex Creating pointers with @code{makeinfo} -@cindex Pointer creation with @code{makeinfo} -@cindex Automatic pointer creation with @code{makeinfo} - -The @code{makeinfo} program has a feature for automatically creating -node pointers for a hierarchically organized file that lacks -them.@refill - -When you take advantage of this feature, you do not need to write the -`Next', `Previous', and `Up' pointers after the name of a node. -However, you must write a sectioning command, such as @code{@@chapter} -or @code{@@section}, on the line immediately following each truncated -@code{@@node} line. You cannot write a comment line after a node -line; the section line must follow it immediately.@refill - -In addition, you must follow the `Top' @code{@@node} line with a line beginning -with @code{@@top} to mark the `Top' node in the file. @xref{makeinfo -top, , @code{@@top}}. - -Finally, you must write the name of each node (except for the `Top' -node) in a menu that is one or more hierarchical levels above the -node's hierarchical level.@refill - -This node pointer insertion feature in @code{makeinfo} is an -alternative to the menu and pointer creation and update commands in -Texinfo mode. (@xref{Updating Nodes and Menus}.) It is especially -helpful to people who do not use GNU Emacs for writing Texinfo -documents.@refill - -@node Menus, Cross References, Nodes, Top -@comment node-name, next, previous, up -@chapter Menus -@cindex Menus -@findex menu - -@dfn{Menus} contain pointers to subordinate -nodes.@footnote{Menus can carry you to any node, regardless -of the hierarchical structure; even to nodes in a different -Info file. However, the GNU Emacs Texinfo mode updating -commands work only to create menus of subordinate nodes. -Conventionally, cross references are used to refer to other -nodes.} In Info, you use menus to go to such nodes. Menus -have no effect in printed manuals and do not appear in -them.@refill - -By convention, a menu is put at the end of a node since a reader who -uses the menu may not see text that follows it.@refill - -@ifinfo -A node that has a menu should @emph{not} contain much text. If you -have a lot of text and a menu, move most of the text into a new -subnode---all but a few lines.@refill -@end ifinfo -@iftex -@emph{A node that has a menu should not contain much text.} If you -have a lot of text and a menu, move most of the text into a new -subnode---all but a few lines. Otherwise, a reader with a terminal -that displays only a few lines may miss the menu and its associated -text. As a practical matter, you should locate a menu within 20 lines -of the beginning of the node.@refill -@end iftex - -@menu -* Menu Location:: Put a menu in a short node. -* Writing a Menu:: What is a menu? -* Menu Parts:: A menu entry has three parts. -* Less Cluttered Menu Entry:: Two part menu entry. -* Menu Example:: Two and three part menu entries. -* Other Info Files:: How to refer to a different Info file. -@end menu - -@node Menu Location, Writing a Menu, Menus, Menus -@ifinfo -@heading Menus Need Short Nodes -@end ifinfo -@cindex Menu location -@cindex Location of menus -@cindex Nodes for menus are short -@cindex Short nodes for menus - -@ifinfo -A reader can easily see a menu that is close to the beginning of the -node. The node should be short. As a practical matter, you should -locate a menu within 20 lines of the beginning of the node. -Otherwise, a reader with a terminal that displays only a few lines may -miss the menu and its associated text.@refill -@end ifinfo - -The short text before a menu may look awkward in a printed manual. To -avoid this, you can write a menu near the beginning of its node and -follow the menu by an @code{@@node} line, and then an @code{@@heading} -line located within @code{@@ifinfo} and @code{@@end ifinfo}. This way, -the menu, @code{@@node} line, and title appear only in the Info file, -not the printed document.@refill - -For example, the preceding two paragraphs follow an Info-only menu, -@code{@@node} line, and heading, and look like this:@refill - -@example -@group -@@menu -* Menu Location:: Put a menu in a short node. -* Writing a Menu:: What is a menu? -* Menu Parts:: A menu entry has three parts. -* Less Cluttered Menu Entry:: Two part menu entry. -* Menu Example:: Two and three part entries. -* Other Info Files:: How to refer to a different - Info file. -@@end menu - -@@node Menu Location, Writing a Menu, , Menus -@@ifinfo -@@heading Menus Need Short Nodes -@@end ifinfo -@end group -@end example - -The Texinfo file for this document contains more than a dozen -examples of this procedure. One is at the beginning of this chapter; -another is at the beginning of the ``Cross References'' chapter.@refill - -@node Writing a Menu, Menu Parts, Menu Location, Menus -@section Writing a Menu -@cindex Writing a menu -@cindex Menu writing - -A menu consists of an @code{@@menu} command on a line by -itself followed by menu entry lines or menu comment lines -and then by an @code{@@end menu} command on a line by -itself.@refill - -A menu looks like this:@refill - -@example -@group -@@menu -Larger Units of Text - -* Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing - several files at once. -@@end menu -@end group -@end example - -In a menu, every line that begins with an @w{@samp{* }} is a -@dfn{menu entry}. (Note the space after the asterisk.) A -line that does not start with an @w{@samp{* }} may also -appear in a menu. Such a line is not a menu entry but is a -menu comment line that appears in the Info file. In -the example above, the line @samp{Larger Units of Text} is a -menu comment line; the two lines starting with @w{@samp{* }} -are menu entries. - -@node Menu Parts, Less Cluttered Menu Entry, Writing a Menu, Menus -@section The Parts of a Menu -@cindex Parts of a menu -@cindex Menu parts -@cindex @code{@@menu} parts - -A menu entry has three parts, only the second of which is required: - -@enumerate -@item -The menu entry name (optional). - -@item -The name of the node (required). - -@item -A description of the item (optional). -@end enumerate - -The template for a menu entry looks like this:@refill - -@example -* @var{menu-entry-name}: @var{node-name}. @var{description} -@end example - -Follow the menu entry name with a single colon and follow the node name -with tab, comma, period, or newline.@refill - -In Info, a user selects a node with the @kbd{m} (@code{Info-menu}) -command. The menu entry name is what the user types after the @kbd{m} -command.@refill - -The third part of a menu entry is a descriptive phrase or sentence. -Menu entry names and node names are often short; the description -explains to the reader what the node is about. A useful description -complements the node name rather than repeats it. The description, -which is optional, can spread over two or more lines; if it does, some -authors prefer to indent the second line while others prefer to align it -with the first (and all others). It's up to you. - - -@node Less Cluttered Menu Entry, Menu Example, Menu Parts, Menus -@comment node-name, next, previous, up -@section Less Cluttered Menu Entry -@cindex Two part menu entry -@cindex Double-colon menu entries -@cindex Menu entries with two colons -@cindex Less cluttered menu entry -@cindex Uncluttered menu entry - -When the menu entry name and node name are the same, you can write -the name immediately after the asterisk and space at the beginning of -the line and follow the name with two colons.@refill - -@need 800 -For example, write - -@example -* Name:: @var{description} -@end example - -@need 800 -@noindent -instead of - -@example -* Name: Name. @var{description} -@end example - -You should use the node name for the menu entry name whenever possible, -since it reduces visual clutter in the menu.@refill - -@node Menu Example, Other Info Files, Less Cluttered Menu Entry, Menus -@comment node-name, next, previous, up -@section A Menu Example -@cindex Menu example -@cindex Example menu - -A menu looks like this in Texinfo:@refill - -@example -@group -@@menu -* menu entry name: Node name. A short description. -* Node name:: This form is preferred. -@@end menu -@end group -@end example - -@need 800 -@noindent -This produces: - -@example -@group -* menu: - -* menu entry name: Node name. A short description. -* Node name:: This form is preferred. -@end group -@end example - -@need 700 -Here is an example as you might see it in a Texinfo file:@refill - -@example -@group -@@menu -Larger Units of Text - -* Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing - several files at once. -@@end menu -@end group -@end example - -@need 800 -@noindent -This produces: - -@example -@group -* menu: -Larger Units of Text - -* Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing - several files at once. -@end group -@end example - -In this example, the menu has two entries. @samp{Files} is both a menu -entry name and the name of the node referred to by that name. -@samp{Multiples} is the menu entry name; it refers to the node named -@samp{Buffers}. The line @samp{Larger Units of Text} is a comment; it -appears in the menu, but is not an entry.@refill - -Since no file name is specified with either @samp{Files} or -@samp{Buffers}, they must be the names of nodes in the same Info file -(@pxref{Other Info Files, , Referring to Other Info Files}).@refill - -@node Other Info Files, , Menu Example, Menus -@comment node-name, next, previous, up -@section Referring to Other Info Files -@cindex Referring to other Info files -@cindex Nodes in other Info files -@cindex Other Info files' nodes -@cindex Going to other Info files' nodes -@cindex Info; other files' nodes - -You can create a menu entry that enables a reader in Info to go to a -node in another Info file by writing the file name in parentheses just -before the node name. In this case, you should use the three-part menu -entry format, which saves the reader from having to type the file -name.@refill - -@need 800 -The format looks like this:@refill - -@example -@group -@@menu -* @var{first-entry-name}:(@var{filename})@var{nodename}. @var{description} -* @var{second-entry-name}:(@var{filename})@var{second-node}. @var{description} -@@end menu -@end group -@end example - -For example, to refer directly to the @samp{Outlining} and -@samp{Rebinding} nodes in the @cite{Emacs Manual}, you would write a -menu like this:@refill - -@example -@group -@@menu -* Outlining: (emacs)Outline Mode. The major mode for - editing outlines. -* Rebinding: (emacs)Rebinding. How to redefine the - meaning of a key. -@@end menu -@end group -@end example - -If you do not list the node name, but only name the file, then Info -presumes that you are referring to the `Top' node.@refill - -The @file{dir} file that contains the main menu for Info has menu -entries that list only file names. These take you directly to the `Top' -nodes of each Info document. (@xref{Install an Info File}.)@refill - -@need 700 -For example: - -@example -@group -* Info: (info). Documentation browsing system. -* Emacs: (emacs). The extensible, self-documenting - text editor. -@end group -@end example - -@noindent -(The @file{dir} top level directory for the Info system is an Info file, -not a Texinfo file, but a menu entry looks the same in both types of -file.)@refill - -Note that the GNU Emacs Texinfo mode menu updating commands only work -with nodes within the current buffer, so you cannot use them to create -menus that refer to other files. You must write such menus by hand.@refill - -@node Cross References, Marking Text, Menus, Top -@comment node-name, next, previous, up -@chapter Cross References -@cindex Making cross references -@cindex Cross references -@cindex References - -@dfn{Cross references} are used to refer the reader to other parts of the -same or different Texinfo files. In Texinfo, nodes are the -places to which cross references can refer.@refill - -@menu -* References:: What cross references are for. -* Cross Reference Commands:: A summary of the different commands. -* Cross Reference Parts:: A cross reference has several parts. -* xref:: Begin a reference with `See' @dots{} -* Top Node Naming:: How to refer to the beginning of another file. -* ref:: A reference for the last part of a sentence. -* pxref:: How to write a parenthetical cross reference. -* inforef:: How to refer to an Info-only file. -* uref:: How to refer to a uniform resource locator. -@end menu - -@node References, Cross Reference Commands, Cross References, Cross References -@ifinfo -@heading What References Are For -@end ifinfo - -Often, but not always, a printed document should be designed so that -it can be read sequentially. People tire of flipping back and forth -to find information that should be presented to them as they need -it.@refill - -However, in any document, some information will be too detailed for -the current context, or incidental to it; use cross references to -provide access to such information. Also, an on-line help system or a -reference manual is not like a novel; few read such documents in -sequence from beginning to end. Instead, people look up what they -need. For this reason, such creations should contain many cross -references to help readers find other information that they may not -have read.@refill - -In a printed manual, a cross reference results in a page reference, -unless it is to another manual altogether, in which case the cross -reference names that manual.@refill - -In Info, a cross reference results in an entry that you can follow using -the Info @samp{f} command. (@inforef{Help-Adv, Some advanced Info -commands, info}.)@refill - -The various cross reference commands use nodes to define cross -reference locations. This is evident in Info, in which a cross -reference takes you to the specified node. @TeX{} also uses nodes to -define cross reference locations, but the action is less obvious. When -@TeX{} generates a DVI file, it records nodes' page numbers and -uses the page numbers in making references. Thus, if you are writing -a manual that will only be printed, and will not be used on-line, you -must nonetheless write @code{@@node} lines to name the places to which -you make cross references.@refill - -@need 800 -@node Cross Reference Commands, Cross Reference Parts, References, Cross References -@comment node-name, next, previous, up -@section Different Cross Reference Commands -@cindex Different cross reference commands - -There are four different cross reference commands:@refill - -@table @code -@item @@xref -Used to start a sentence in the printed manual saying @w{`See @dots{}'} -or an Info cross-reference saying @samp{*Note @var{name}: @var{node}.}. - -@item @@ref -Used within or, more often, at the end of a sentence; same as -@code{@@xref} for Info; produces just the reference in the printed -manual without a preceding `See'.@refill - -@item @@pxref -Used within parentheses to make a reference that suits both an Info -file and a printed book. Starts with a lower case `see' within the -printed manual. (@samp{p} is for `parenthesis'.)@refill - -@item @@inforef -Used to make a reference to an Info file for which there is no printed -manual.@refill -@end table - -@noindent -(The @code{@@cite} command is used to make references to books and -manuals for which there is no corresponding Info file and, therefore, -no node to which to point. @xref{cite, , @code{@@cite}}.)@refill - -@node Cross Reference Parts, xref, Cross Reference Commands, Cross References -@comment node-name, next, previous, up -@section Parts of a Cross Reference -@cindex Cross reference parts -@cindex Parts of a cross reference - -A cross reference command requires only one argument, which is the -name of the node to which it refers. But a cross reference command -may contain up to four additional arguments. By using these -arguments, you can provide a cross reference name for Info, a topic -description or section title for the printed output, the name of a -different Info file, and the name of a different printed -manual.@refill - -Here is a simple cross reference example:@refill - -@example -@@xref@{Node name@}. -@end example - -@noindent -which produces - -@example -*Note Node name::. -@end example - -@noindent -and - -@quotation -See Section @var{nnn} [Node name], page @var{ppp}. -@end quotation - -@need 700 -Here is an example of a full five-part cross reference:@refill - -@example -@group -@@xref@{Node name, Cross Reference Name, Particular Topic, -info-file-name, A Printed Manual@}, for details. -@end group -@end example - -@noindent -which produces - -@example -*Note Cross Reference Name: (info-file-name)Node name, -for details. -@end example - -@noindent -in Info and - -@quotation -See section ``Particular Topic'' in @i{A Printed Manual}, for details. -@end quotation - -@noindent -in a printed book. - -The five possible arguments for a cross reference are:@refill - -@enumerate -@item -The node name (required). This is the node to which the -cross reference takes you. In a printed document, the location of the -node provides the page reference only for references within the same -document.@refill - -@item -The cross reference name for the Info reference, if it is to be different -from the node name. If you include this argument, it becomes -the first part of the cross reference. It is usually omitted.@refill - -@item -A topic description or section name. Often, this is the title of the -section. This is used as the name of the reference in the printed -manual. If omitted, the node name is used.@refill - -@item -The name of the Info file in which the reference is located, if it is -different from the current file. You need not include any @samp{.info} -suffix on the file name, since Info readers try appending it -automatically. - -@item -The name of a printed manual from a different Texinfo file.@refill -@end enumerate - -The template for a full five argument cross reference looks like -this:@refill - -@example -@group -@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic}, -@var{info-file-name}, @var{printed-manual-title}@}. -@end group -@end example - -Cross references with one, two, three, four, and five arguments are -described separately following the description of @code{@@xref}.@refill - -Write a node name in a cross reference in exactly the same way as in -the @code{@@node} line, including the same capitalization; otherwise, the -formatters may not find the reference.@refill - -You can write cross reference commands within a paragraph, but note -how Info and @TeX{} format the output of each of the various commands: -write @code{@@xref} at the beginning of a sentence; write -@code{@@pxref} only within parentheses, and so on.@refill - -@node xref, Top Node Naming, Cross Reference Parts, Cross References -@comment node-name, next, previous, up -@section @code{@@xref} -@findex xref -@cindex Cross references using @code{@@xref} -@cindex References using @code{@@xref} - -The @code{@@xref} command generates a cross reference for the -beginning of a sentence. The Info formatting commands convert it into -an Info cross reference, which the Info @samp{f} command can use to -bring you directly to another node. The @TeX{} typesetting commands -convert it into a page reference, or a reference to another book or -manual.@refill - -@menu -* Reference Syntax:: What a reference looks like and requires. -* One Argument:: @code{@@xref} with one argument. -* Two Arguments:: @code{@@xref} with two arguments. -* Three Arguments:: @code{@@xref} with three arguments. -* Four and Five Arguments:: @code{@@xref} with four and five arguments. -@end menu - -@node Reference Syntax, One Argument, xref, xref -@ifinfo -@subheading What a Reference Looks Like and Requires -@end ifinfo - -Most often, an Info cross reference looks like this:@refill - -@example -*Note @var{node-name}::. -@end example - -@noindent -or like this - -@example -*Note @var{cross-reference-name}: @var{node-name}. -@end example - -@noindent -In @TeX{}, a cross reference looks like this: - -@example -See Section @var{section-number} [@var{node-name}], page @var{page}. -@end example - -@noindent -or like this - -@example -See Section @var{section-number} [@var{title-or-topic}], page @var{page}. -@end example - -The @code{@@xref} command does not generate a period or comma to end -the cross reference in either the Info file or the printed output. -You must write that period or comma yourself; otherwise, Info will not -recognize the end of the reference. (The @code{@@pxref} command works -differently. @xref{pxref, , @code{@@pxref}}.)@refill - -@quotation -@strong{Please note:} A period or comma @strong{must} follow the closing -brace of an @code{@@xref}. It is required to terminate the cross -reference. This period or comma will appear in the output, both in -the Info file and in the printed manual.@refill -@end quotation - -@code{@@xref} must refer to an Info node by name. Use @code{@@node} -to define the node (@pxref{Writing a Node}).@refill - -@code{@@xref} is followed by several arguments inside braces, separated by -commas. Whitespace before and after these commas is ignored.@refill - -A cross reference requires only the name of a node; but it may contain -up to four additional arguments. Each of these variations produces a -cross reference that looks somewhat different.@refill - -@quotation -@strong{Please note:} Commas separate arguments in a cross reference; -avoid including them in the title or other part lest the formatters -mistake them for separators.@refill -@end quotation - -@node One Argument, Two Arguments, Reference Syntax, xref -@subsection @code{@@xref} with One Argument - -The simplest form of @code{@@xref} takes one argument, the name of -another node in the same Info file. The Info formatters produce -output that the Info readers can use to jump to the reference; @TeX{} -produces output that specifies the page and section number for you.@refill - -@need 700 -@noindent -For example, - -@example -@@xref@{Tropical Storms@}. -@end example - -@noindent -produces - -@example -*Note Tropical Storms::. -@end example - -@noindent -and - -@quotation -See Section 3.1 [Tropical Storms], page 24. -@end quotation - -@noindent -(Note that in the preceding example the closing brace is followed by a -period.)@refill - -You can write a clause after the cross reference, like this:@refill - -@example -@@xref@{Tropical Storms@}, for more info. -@end example - -@noindent -which produces - -@example -*Note Tropical Storms::, for more info. -@end example - -@quotation -See Section 3.1 [Tropical Storms], page 24, for more info. -@end quotation - -@noindent -(Note that in the preceding example the closing brace is followed by a -comma, and then by the clause, which is followed by a period.)@refill - -@node Two Arguments, Three Arguments, One Argument, xref -@subsection @code{@@xref} with Two Arguments - -With two arguments, the second is used as the name of the Info cross -reference, while the first is still the name of the node to which the -cross reference points.@refill - -@need 750 -@noindent -The template is like this: - -@example -@@xref@{@var{node-name}, @var{cross-reference-name}@}. -@end example - -@need 700 -@noindent -For example, - -@example -@@xref@{Electrical Effects, Lightning@}. -@end example - -@noindent -produces: - -@example -*Note Lightning: Electrical Effects. -@end example - -@noindent -and - -@quotation -See Section 5.2 [Electrical Effects], page 57. -@end quotation - -@noindent -(Note that in the preceding example the closing brace is followed by a -period; and that the node name is printed, not the cross reference name.)@refill - -You can write a clause after the cross reference, like this:@refill - -@example -@@xref@{Electrical Effects, Lightning@}, for more info. -@end example - -@noindent -which produces -@example -*Note Lightning: Electrical Effects, for more info. -@end example - -@noindent -and - -@quotation -See Section 5.2 [Electrical Effects], page 57, for more info. -@end quotation - -@noindent -(Note that in the preceding example the closing brace is followed by a -comma, and then by the clause, which is followed by a period.)@refill - -@node Three Arguments, Four and Five Arguments, Two Arguments, xref -@subsection @code{@@xref} with Three Arguments - -A third argument replaces the node name in the @TeX{} output. The third -argument should be the name of the section in the printed output, or -else state the topic discussed by that section. Often, you will want to -use initial upper case letters so it will be easier to read when the -reference is printed. Use a third argument when the node name is -unsuitable because of syntax or meaning.@refill - -Remember to avoid placing a comma within the title or topic section of -a cross reference, or within any other section. The formatters divide -cross references into arguments according to the commas; a comma -within a title or other section will divide it into two arguments. In -a reference, you need to write a title such as ``Clouds, Mist, and -Fog'' without the commas.@refill - -Also, remember to write a comma or period after the closing brace of a -@code{@@xref} to terminate the cross reference. In the following -examples, a clause follows a terminating comma.@refill - - -@need 750 -@noindent -The template is like this: - -@example -@group -@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic}@}. -@end group -@end example - -@need 700 -@noindent -For example, - -@example -@group -@@xref@{Electrical Effects, Lightning, Thunder and Lightning@}, -for details. -@end group -@end example - -@noindent -produces - -@example -*Note Lightning: Electrical Effects, for details. -@end example - -@noindent -and - -@quotation -See Section 5.2 [Thunder and Lightning], page 57, for details. -@end quotation - -If a third argument is given and the second one is empty, then the -third argument serves both. (Note how two commas, side by side, mark -the empty second argument.)@refill - -@example -@group -@@xref@{Electrical Effects, , Thunder and Lightning@}, -for details. -@end group -@end example - -@noindent -produces - -@example -*Note Thunder and Lightning: Electrical Effects, for details. -@end example - -@noindent -and - -@quotation -See Section 5.2 [Thunder and Lightning], page 57, for details. -@end quotation - -As a practical matter, it is often best to write cross references with -just the first argument if the node name and the section title are the -same, and with the first and third arguments if the node name and title -are different.@refill - -Here are several examples from @cite{The GNU Awk User's Guide}:@refill - -@smallexample -@@xref@{Sample Program@}. -@@xref@{Glossary@}. -@@xref@{Case-sensitivity, ,Case-sensitivity in Matching@}. -@@xref@{Close Output, , Closing Output Files and Pipes@}, - for more information. -@@xref@{Regexp, , Regular Expressions as Patterns@}. -@end smallexample - -@node Four and Five Arguments, , Three Arguments, xref -@subsection @code{@@xref} with Four and Five Arguments - -In a cross reference, a fourth argument specifies the name of another -Info file, different from the file in which the reference appears, and -a fifth argument specifies its title as a printed manual.@refill - -Remember that a comma or period must follow the closing brace of an -@code{@@xref} command to terminate the cross reference. In the -following examples, a clause follows a terminating comma.@refill - -@need 800 -@noindent -The template is: - -@example -@group -@@xref@{@var{node-name}, @var{cross-reference-name}, @var{title-or-topic}, -@var{info-file-name}, @var{printed-manual-title}@}. -@end group -@end example - -@need 700 -@noindent -For example, - -@example -@@xref@{Electrical Effects, Lightning, Thunder and Lightning, -weather, An Introduction to Meteorology@}, for details. -@end example - -@noindent -produces - -@example -*Note Lightning: (weather)Electrical Effects, for details. -@end example - -@noindent -The name of the Info file is enclosed in parentheses and precedes -the name of the node. - -@noindent -In a printed manual, the reference looks like this:@refill - -@quotation -See section ``Thunder and Lightning'' in @i{An Introduction to -Meteorology}, for details. -@end quotation - -@noindent -The title of the printed manual is typeset in italics; and the -reference lacks a page number since @TeX{} cannot know to which page a -reference refers when that reference is to another manual.@refill - -Often, you will leave out the second argument when you use the long -version of @code{@@xref}. In this case, the third argument, the topic -description, will be used as the cross reference name in Info.@refill - -@noindent -The template looks like this: - -@example -@@xref@{@var{node-name}, , @var{title-or-topic}, @var{info-file-name}, -@var{printed-manual-title}@}, for details. -@end example - -@noindent -which produces - -@example -*Note @var{title-or-topic}: (@var{info-file-name})@var{node-name}, for details. -@end example - -@noindent -and - -@quotation -See section @var{title-or-topic} in @var{printed-manual-title}, for details. -@end quotation - -@need 700 -@noindent -For example, - -@example -@@xref@{Electrical Effects, , Thunder and Lightning, -weather, An Introduction to Meteorology@}, for details. -@end example - -@noindent -produces - -@example -@group -*Note Thunder and Lightning: (weather)Electrical Effects, -for details. -@end group -@end example - -@noindent -and - -@quotation -See section ``Thunder and Lightning'' in @i{An Introduction to -Meteorology}, for details. -@end quotation - -On rare occasions, you may want to refer to another Info file that -is within a single printed manual---when multiple Texinfo files are -incorporated into the same @TeX{} run but make separate Info files. -In this case, you need to specify only the fourth argument, and not -the fifth.@refill - -@node Top Node Naming, ref, xref, Cross References -@section Naming a `Top' Node -@cindex Naming a `Top' Node in references -@cindex @samp{@r{Top}} node naming for references - -In a cross reference, you must always name a node. This means that in -order to refer to a whole manual, you must identify the `Top' node by -writing it as the first argument to the @code{@@xref} command. (This -is different from the way you write a menu entry; see @ref{Other Info -Files, , Referring to Other Info Files}.) At the same time, to -provide a meaningful section topic or title in the printed cross -reference (instead of the word `Top'), you must write an appropriate -entry for the third argument to the @code{@@xref} command. -@refill - -@noindent -Thus, to make a cross reference to @cite{The GNU Make Manual}, -write:@refill - -@example -@@xref@{Top, , Overview, make, The GNU Make Manual@}. -@end example - -@noindent -which produces - -@example -*Note Overview: (make)Top. -@end example - -@noindent -and - -@quotation -See section ``Overview'' in @i{The GNU Make Manual}. -@end quotation - -@noindent -In this example, @samp{Top} is the name of the first node, and -@samp{Overview} is the name of the first section of the manual.@refill -@node ref, pxref, Top Node Naming, Cross References -@comment node-name, next, previous, up -@section @code{@@ref} -@cindex Cross references using @code{@@ref} -@cindex References using @code{@@ref} -@findex ref - -@code{@@ref} is nearly the same as @code{@@xref} except that it does -not generate a `See' in the printed output, just the reference itself. -This makes it useful as the last part of a sentence.@refill - -@need 700 -@noindent -For example, - -@example -For more information, see @@ref@{Hurricanes@}. -@end example - -@noindent -produces - -@example -For more information, see *Note Hurricanes. -@end example - -@noindent -and - -@quotation -For more information, see Section 8.2 [Hurricanes], page 123. -@end quotation - -The @code{@@ref} command sometimes leads writers to express themselves -in a manner that is suitable for a printed manual but looks awkward -in the Info format. Bear in mind that your audience will be using -both the printed and the Info format.@refill - -@need 800 -@noindent -For example, - -@example -@group -Sea surges are described in @@ref@{Hurricanes@}. -@end group -@end example - -@need 800 -@noindent -produces - -@quotation -Sea surges are described in Section 6.7 [Hurricanes], page 72. -@end quotation - -@need 800 -@noindent -in a printed document, and the following in Info: - -@example -Sea surges are described in *Note Hurricanes::. -@end example - -@quotation -@strong{Caution:} You @emph{must} write a period or comma immediately -after an @code{@@ref} command with two or more arguments. Otherwise, -Info will not find the end of the cross reference entry and its -attempt to follow the cross reference will fail. As a general rule, -you should write a period or comma after every @code{@@ref} command. -This looks best in both the printed and the Info output.@refill -@end quotation - -@node pxref, inforef, ref, Cross References -@comment node-name, next, previous, up -@section @code{@@pxref} -@cindex Cross references using @code{@@pxref} -@cindex References using @code{@@pxref} -@findex pxref - -The parenthetical reference command, @code{@@pxref}, is nearly the -same as @code{@@xref}, but you use it @emph{only} inside parentheses -and you do @emph{not} type a comma or period after the command's -closing brace. The command differs from @code{@@xref} in two -ways:@refill - -@enumerate -@item -@TeX{} typesets the reference for the printed manual with a lower case -`see' rather than an upper case `See'.@refill - -@item -The Info formatting commands automatically end the reference with a -closing colon or period.@refill -@end enumerate - -Because one type of formatting automatically inserts closing -punctuation and the other does not, you should use @code{@@pxref} -@emph{only} inside parentheses as part of another sentence. Also, you -yourself should not insert punctuation after the reference, as you do -with @code{@@xref}.@refill - -@code{@@pxref} is designed so that the output looks right and works -right between parentheses both in printed output and in an Info file. -In a printed manual, a closing comma or period should not follow a -cross reference within parentheses; such punctuation is wrong. But in -an Info file, suitable closing punctuation must follow the cross -reference so Info can recognize its end. @code{@@pxref} spares you -the need to use complicated methods to put a terminator into one form -of the output and not the other.@refill - -@noindent -With one argument, a parenthetical cross reference looks like -this:@refill - -@example -@dots{} storms cause flooding (@@pxref@{Hurricanes@}) @dots{} -@end example - -@need 800 -@noindent -which produces - -@example -@group -@dots{} storms cause flooding (*Note Hurricanes::) @dots{} -@end group -@end example - -@noindent -and - -@quotation -@dots{} storms cause flooding (see Section 6.7 [Hurricanes], page 72) @dots{} -@end quotation - -With two arguments, a parenthetical cross reference has this -template:@refill - -@example -@dots{} (@@pxref@{@var{node-name}, @var{cross-reference-name}@}) @dots{} -@end example - -@noindent -which produces - -@example -@dots{} (*Note @var{cross-reference-name}: @var{node-name}.) @dots{} -@end example - -@noindent -and - -@need 1500 -@quotation -@dots{} (see Section @var{nnn} [@var{node-name}], page @var{ppp}) @dots{} -@end quotation - -@code{@@pxref} can be used with up to five arguments just like -@code{@@xref} (@pxref{xref, , @code{@@xref}}).@refill - -@quotation -@strong{Please note:} Use @code{@@pxref} only as a parenthetical -reference. Do not try to use @code{@@pxref} as a clause in a sentence. -It will look bad in either the Info file, the printed output, or -both.@refill - -Also, parenthetical cross references look best at the ends of sentences. -Although you may write them in the middle of a sentence, that location -breaks up the flow of text.@refill -@end quotation - -@node inforef, uref, pxref, Cross References -@section @code{@@inforef} -@cindex Cross references using @code{@@inforef} -@cindex References using @code{@@inforef} -@findex inforef - -@code{@@inforef} is used for cross references to Info files for which -there are no printed manuals. Even in a printed manual, -@code{@@inforef} generates a reference directing the user to look in -an Info file.@refill - -The command takes either two or three arguments, in the following -order:@refill - -@enumerate -@item -The node name. - -@item -The cross reference name (optional). - -@item -The Info file name. -@end enumerate - -@noindent -Separate the arguments with commas, as with @code{@@xref}. Also, you -must terminate the reference with a comma or period after the -@samp{@}}, as you do with @code{@@xref}.@refill - -@noindent -The template is: - -@example -@@inforef@{@var{node-name}, @var{cross-reference-name}, @var{info-file-name}@}, -@end example - -@need 800 -@noindent -Thus, - -@example -@group -@@inforef@{Expert, Advanced Info commands, info@}, -for more information. -@end group -@end example - -@need 800 -@noindent -produces - -@example -@group -*Note Advanced Info commands: (info)Expert, -for more information. -@end group -@end example - -@need 800 -@noindent -and - -@quotation -See Info file @file{info}, node @samp{Expert}, for more information. -@end quotation - -@need 800 -@noindent -Similarly, - -@example -@group -@@inforef@{Expert, , info@}, for more information. -@end group -@end example - -@need 800 -@noindent -produces - -@example -*Note (info)Expert::, for more information. -@end example - -@need 800 -@noindent -and - -@quotation -See Info file @file{info}, node @samp{Expert}, for more information. -@end quotation - -The converse of @code{@@inforef} is @code{@@cite}, which is used to -refer to printed works for which no Info form exists. @xref{cite, , -@code{@@cite}}.@refill - - -@node uref, , inforef, Cross References -@section @code{@@uref@{@var{url}[, @var{displayed-text}]@}} -@findex uref -@cindex Uniform resource locator, referring to -@cindex URL, referring to - -@code{@@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). In HTML output, -@code{@@uref} produces a link you can follow. For example: - -@example -The official GNU ftp site is -@@uref@{ftp://ftp.gnu.ai.mit.edu/pub/gnu@} -@end example - -@noindent -produces (in text): -@display -The official GNU ftp site is -@uref{ftp://ftp.gnu.ai.mit.edu/pub/gnu} -@end display - -@noindent -whereas -@example -The official -@@uref@{ftp://ftp.gnu.ai.mit.edu/pub/gnu, - GNU ftp site@} holds programs and texts. -@end example - -@noindent -produces (in text): -@display -The official @uref{ftp://ftp.gnu.ai.mit.edu/pub/gnu, GNU ftp site} holds -programs and texts. -@end display - -@noindent -and (in HTML): -@example -The official GNU ftp -site holds programs and texts. -@end example - -To merely indicate a URL, use @code{@@url} (@pxref{url, @code{@@url}}). - - -@node Marking Text, Quotations and Examples, Cross References, Top -@comment node-name, next, previous, up -@chapter Marking Words and Phrases -@cindex Paragraph, marking text within -@cindex Marking words and phrases -@cindex Words and phrases, marking them -@cindex Marking text within a paragraph - -In Texinfo, you can mark words and phrases in a variety of ways. -The Texinfo formatters use this information to determine how to -highlight the text. -You can specify, for example, whether a word or phrase is a -defining occurrence, a metasyntactic variable, or a symbol used in a -program. Also, you can emphasize text.@refill - -@menu -* Indicating:: How to indicate definitions, files, etc. -* Emphasis:: How to emphasize text. -@end menu - -@node Indicating, Emphasis, Marking Text, Marking Text -@comment node-name, next, previous, up -@section Indicating Definitions, Commands, etc. -@cindex Highlighting text -@cindex Indicating commands, definitions, etc. - -Texinfo has commands for indicating just what kind of object a piece of -text refers to. For example, metasyntactic variables are marked by -@code{@@var}, and code by @code{@@code}. Since the pieces of text are -labelled by commands that tell what kind of object they are, it is easy -to change the way the Texinfo formatters prepare such text. (Texinfo is -an @emph{intentional} formatting language rather than a @emph{typesetting} -formatting language.)@refill - -For example, in a printed manual, -code is usually illustrated in a typewriter font; -@code{@@code} tells @TeX{} to typeset this text in this font. But it -would be easy to change the way @TeX{} highlights code to use another -font, and this change would not effect how keystroke examples are -highlighted. If straight typesetting commands were used in the body -of the file and you wanted to make a change, you would need to check -every single occurrence to make sure that you were changing code and -not something else that should not be changed.@refill - -@menu -* Useful Highlighting:: Highlighting provides useful information. -* code:: How to indicate code. -* kbd:: How to show keyboard input. -* key:: How to specify keys. -* samp:: How to show a literal sequence of characters. -* var:: How to indicate a metasyntactic variable. -* file:: How to indicate the name of a file. -* dfn:: How to specify a definition. -* cite:: How to refer to a book that is not in Info. -* url:: How to indicate a world wide web reference. -* email:: How to indicate an electronic mail address. -@end menu - -@node Useful Highlighting, code, Indicating, Indicating -@ifinfo -@subheading Highlighting Commands are Useful -@end ifinfo - -The highlighting commands can be used to generate useful information -from the file, such as lists of functions or file names. It is -possible, for example, to write a program in Emacs Lisp (or a keyboard -macro) to insert an index entry after every paragraph that contains -words or phrases marked by a specified command. You could do this to -construct an index of functions if you had not already made the -entries.@refill - -The commands serve a variety of purposes:@refill - -@table @code -@item @@code@{@var{sample-code}@} -Indicate text that is a literal example of a piece of a program.@refill - -@item @@kbd@{@var{keyboard-characters}@} -Indicate keyboard input.@refill - -@item @@key@{@var{key-name}@} -Indicate the conventional name for a key on a keyboard.@refill - -@item @@samp@{@var{text}@} -Indicate text that is a literal example of a sequence of characters.@refill - -@item @@var@{@var{metasyntactic-variable}@} -Indicate a metasyntactic variable.@refill - -@item @@url@{@var{uniform-resource-locator}@} -Indicate a uniform resource locator for the World Wide Web. - -@item @@file@{@var{file-name}@} -Indicate the name of a file.@refill - -@item @@email@{@var{email-address}[, @var{displayed-text}]@} -Indicate an electronic mail address. - -@item @@dfn@{@var{term}@} -Indicate the introductory or defining use of a term.@refill - -@item @@cite@{@var{reference}@} -Indicate the name of a book.@refill - -@ignore -@item @@ctrl@{@var{ctrl-char}@} -Use for an @sc{ascii} control character.@refill -@end ignore -@end table - -@node code, kbd, Useful Highlighting, Indicating -@comment node-name, next, previous, up -@subsection @code{@@code}@{@var{sample-code}@} -@findex code - -Use the @code{@@code} command to indicate text that is a piece of a -program and which consists of entire syntactic tokens. Enclose the -text in braces.@refill - -Thus, you should use @code{@@code} for an expression in a program, for -the name of a variable or function used in a program, or for a -keyword. Also, you should use @code{@@code} for the name of a -program, such as @code{diff}, that is a name used in the machine. (You -should write the name of a program in the ordinary text font if you -regard it as a new English word, such as `Emacs' or `Bison'.)@refill - -Use @code{@@code} for environment variables such as @code{TEXINPUTS}, -and other variables.@refill - -Use @code{@@code} for command names in command languages that -resemble programming languages, such as Texinfo or the shell. -For example, @code{@@code} and @code{@@samp} are produced by writing -@samp{@@code@{@@@@code@}} and @samp{@@code@{@@@@samp@}} in the Texinfo -source, respectively.@refill - -Note, however, that you should not use @code{@@code} for shell options -such as @samp{-c} when such options stand alone. (Use @code{@@samp}.) -Also, an entire shell command often looks better if written using -@code{@@samp} rather than @code{@@code}. In this case, the rule is to -choose the more pleasing format.@refill - -It is incorrect to alter the case of a word inside an @code{@@code} -command when it appears at the beginning of a sentence. Most computer -languages are case sensitive. In C, for example, @code{Printf} is -different from the identifier @code{printf}, and most likely is a -misspelling of it. Even in languages which are not case sensitive, it -is confusing to a human reader to see identifiers spelled in different -ways. Pick one spelling and always use that. If you do not want to -start a sentence with a command written all in lower case, you should -rearrange the sentence.@refill - -Do not use the @code{@@code} command for a string of characters shorter -than a syntactic token. If you are writing about @samp{TEXINPU}, which -is just a part of the name for the @code{TEXINPUTS} environment -variable, you should use @code{@@samp}.@refill - -In particular, you should not use the @code{@@code} command when writing -about the characters used in a token; do not, for example, use -@code{@@code} when you are explaining what letters or printable symbols -can be used in the names of functions. (Use @code{@@samp}.) Also, you -should not use @code{@@code} to mark text that is considered input to -programs unless the input is written in a language that is like a -programming language. For example, you should not use @code{@@code} for -the keystroke commands of GNU Emacs (use @code{@@kbd} instead) although -you may use @code{@@code} for the names of the Emacs Lisp functions that -the keystroke commands invoke.@refill - -In the printed manual, @code{@@code} causes @TeX{} to typeset the -argument in a typewriter face. In the Info file, it causes the Info -formatting commands to use single quotation marks around the text. - -@need 700 -For example, - -@example -Use @@code@{diff@} to compare two files. -@end example - -@noindent -produces this in the printed manual:@refill - -@quotation -Use @code{diff} to compare two files. -@end quotation -@iftex - -@noindent -and this in the Info file:@refill - -@example -Use `diff' to compare two files. -@end example -@end iftex - - -@node kbd, key, code, Indicating -@subsection @code{@@kbd}@{@var{keyboard-characters}@} -@findex kbd -@cindex keyboard input - -Use the @code{@@kbd} command for characters of input to be typed by -users. For example, to refer to the characters @kbd{M-a}, -write@refill - -@example -@@kbd@{M-a@} -@end example - -@noindent -and to refer to the characters @kbd{M-x shell}, write@refill - -@example -@@kbd@{M-x shell@} -@end example - -@cindex user input -@cindex slanted typewriter font, for @code{@@kbd} -The @code{@@kbd} command has the same effect as @code{@@code} in Info, -but by default produces a different font (slanted typewriter instead of -normal typewriter) in the printed manual, so users can distinguish the -characters they are supposed to type from those the computer outputs. - -@findex kbdinputstyle -Since the usage of @code{@@kbd} varies from manual to manual, you can -control the font switching with the @code{@@kbdinputstyle} command. -This command has no effect on Info output. Write this command at the -beginning of a line with a single word as an argument, one of the -following: -@vindex distinct@r{, arg to @@kbdinputstyle} -@vindex example@r{, arg to @@kbdinputstyle} -@vindex code@r{, arg to @@kbdinputstyle} -@table @samp -@item code -Always use the same font for @code{@@kbd} as @code{@@code}. -@item example -Use the distinguishing font for @code{@@kbd} only in @code{@@example} -and similar environments. -@item example -(the default) Always use the distinguishing font for @code{@@kbd}. -@end table - -You can embed another @@-command inside the braces of an @code{@@kbd} -command. Here, for example, is the way to describe a command that -would be described more verbosely as ``press an @samp{r} and then -press the @key{RET} key'':@refill - -@example -@@kbd@{r @@key@{RET@}@} -@end example - -@noindent -This produces: @kbd{r @key{RET}} - -You also use the @code{@@kbd} command if you are spelling out the letters -you type; for example:@refill - -@example -To give the @@code@{logout@} command, -type the characters @@kbd@{l o g o u t @@key@{RET@}@}. -@end example - -@noindent -This produces: - -@quotation -To give the @code{logout} command, -type the characters @kbd{l o g o u t @key{RET}}. -@end quotation - -(Also, this example shows that you can add spaces for clarity. If you -really want to mention a space character as one of the characters of -input, write @kbd{@@key@{SPC@}} for it.)@refill - - -@node key, samp, kbd, Indicating -@comment node-name, next, previous, up -@subsection @code{@@key}@{@var{key-name}@} -@findex key - -Use the @code{@@key} command for the conventional name for a key on a -keyboard, as in:@refill - -@example -@@key@{RET@} -@end example - -You can use the @code{@@key} command within the argument of an -@code{@@kbd} command when the sequence of characters to be typed -includes one or more keys that are described by name.@refill - -@need 700 -For example, to produce @kbd{C-x @key{ESC}} you would type:@refill - -@example -@@kbd@{C-x @@key@{ESC@}@} -@end example - -Here is a list of the recommended names for keys: -@cindex Recommended names for keys -@cindex Keys, recommended names -@cindex Names recommended for keys -@cindex Abbreviations for keys - -@quotation -@table @t -@item SPC -Space -@item RET -Return -@item LFD -Linefeed (however, since most keyboards nowadays do not have a Linefeed key, -it might be better to call this character @kbd{C-j}. -@item TAB -Tab -@item BS -Backspace -@item ESC -Escape -@item DEL -Delete -@item SHIFT -Shift -@item CTRL -Control -@item META -Meta -@end table -@end quotation - -@cindex META key -There are subtleties to handling words like `meta' or `ctrl' that are -names of modifier keys. When mentioning a character in which the -modifier key is used, such as @kbd{Meta-a}, use the @code{@@kbd} command -alone; do not use the @code{@@key} command; but when you are referring -to the modifier key in isolation, use the @code{@@key} command. For -example, write @samp{@@kbd@{Meta-a@}} to produce @kbd{Meta-a} and -@samp{@@key@{META@}} to produce @key{META}. - -@c I don't think this is a good explanation. -@c I think it will puzzle readers more than it clarifies matters. -- rms. -@c In other words, use @code{@@kbd} for what you do, and use @code{@@key} -@c for what you talk about: ``Press @code{@@kbd@{M-a@}} to move point to -@c the beginning of the sentence. The @code{@@key@{META@}} key is often in -@c the lower left of the keyboard.''@refill - -@node samp, var, key, Indicating -@comment node-name, next, previous, up -@subsection @code{@@samp}@{@var{text}@} -@findex samp - -Use the @code{@@samp} command to indicate text that is a literal example -or `sample' of a sequence of characters in a file, string, pattern, etc. -Enclose the text in braces. The argument appears within single -quotation marks in both the Info file and the printed manual; in -addition, it is printed in a fixed-width font.@refill - -@example -To match @@samp@{foo@} at the end of the line, -use the regexp @@samp@{foo$@}. -@end example - -@noindent -produces - -@quotation -To match @samp{foo} at the end of the line, use the regexp -@samp{foo$}.@refill -@end quotation - -Any time you are referring to single characters, you should use -@code{@@samp} unless @code{@@kbd} or @code{@@key} is more appropriate. -Use @code{@@samp} for the names of command-line options (except in an -@code{@@table}, where @code{@@code} seems to read more easily). Also, -you may use @code{@@samp} for entire statements in C and for entire -shell commands---in this case, @code{@@samp} often looks better than -@code{@@code}. Basically, @code{@@samp} is a catchall for whatever is -not covered by @code{@@code}, @code{@@kbd}, or @code{@@key}.@refill - -Only include punctuation marks within braces if they are part of the -string you are specifying. Write punctuation marks outside the braces -if those punctuation marks are part of the English text that surrounds -the string. In the following sentence, for example, the commas and -period are outside of the braces:@refill - -@example -@group -In English, the vowels are @@samp@{a@}, @@samp@{e@}, -@@samp@{i@}, @@samp@{o@}, @@samp@{u@}, and sometimes -@@samp@{y@}. -@end group -@end example - -@noindent -This produces: - -@quotation -In English, the vowels are @samp{a}, @samp{e}, -@samp{i}, @samp{o}, @samp{u}, and sometimes -@samp{y}. -@end quotation - -@node var, file, samp, Indicating -@comment node-name, next, previous, up -@subsection @code{@@var}@{@var{metasyntactic-variable}@} -@findex var - -Use the @code{@@var} command to indicate metasyntactic variables. A -@dfn{metasyntactic variable} is something that stands for another piece of -text. For example, you should use a metasyntactic variable in the -documentation of a function to describe the arguments that are passed -to that function.@refill - -Do not use @code{@@var} for the names of particular variables in -programming languages. These are specific names from a program, so -@code{@@code} is correct for them. For example, the Emacs Lisp variable -@code{texinfo-tex-command} is not a metasyntactic variable; it is -properly formatted using @code{@@code}.@refill - -The effect of @code{@@var} in the Info file is to change the case of -the argument to all upper case; in the printed manual, to italicize it. - -@need 700 -For example, - -@example -To delete file @@var@{filename@}, -type @@code@{rm @@var@{filename@}@}. -@end example - -@noindent -produces - -@quotation -To delete file @var{filename}, type @code{rm @var{filename}}. -@end quotation - -@noindent -(Note that @code{@@var} may appear inside @code{@@code}, -@code{@@samp}, @code{@@file}, etc.)@refill - -Write a metasyntactic variable all in lower case without spaces, and -use hyphens to make it more readable. Thus, the Texinfo source for -the illustration of how to begin a Texinfo manual looks like -this:@refill - -@example -@group -\input texinfo -@@@@setfilename @@var@{info-file-name@} -@@@@settitle @@var@{name-of-manual@} -@end group -@end example - -@noindent -This produces: - -@example -@group -\input texinfo -@@setfilename @var{info-file-name} -@@settitle @var{name-of-manual} -@end group -@end example - -In some documentation styles, metasyntactic variables are shown with -angle brackets, for example:@refill - -@example -@dots{}, type rm -@end example - -@noindent -However, that is not the style that Texinfo uses. (You can, of -course, modify the sources to @TeX{} and the Info formatting commands -to output the @code{<@dots{}>} format if you wish.)@refill - -@node file, dfn, var, Indicating -@comment node-name, next, previous, up -@subsection @code{@@file}@{@var{file-name}@} -@findex file - -Use the @code{@@file} command to indicate text that is the name of a -file, buffer, or directory, or is the name of a node in Info. You can -also use the command for file name suffixes. Do not use @code{@@file} -for symbols in a programming language; use @code{@@code}. - -Currently, @code{@@file} is equivalent to @code{@@samp} in its effects. -For example,@refill - -@example -The @@file@{.el@} files are in -the @@file@{/usr/local/emacs/lisp@} directory. -@end example - -@noindent -produces - -@quotation -The @file{.el} files are in -the @file{/usr/local/emacs/lisp} directory. -@end quotation - -@node dfn, cite, file, Indicating -@comment node-name, next, previous, up -@subsection @code{@@dfn}@{@var{term}@} -@findex dfn - -Use the @code{@@dfn} command to identify the introductory or defining -use of a technical term. Use the command only in passages whose -purpose is to introduce a term which will be used again or which the -reader ought to know. Mere passing mention of a term for the first -time does not deserve @code{@@dfn}. The command generates italics in -the printed manual, and double quotation marks in the Info file. For -example:@refill - -@example -Getting rid of a file is called @@dfn@{deleting@} it. -@end example - -@noindent -produces - -@quotation -Getting rid of a file is called @dfn{deleting} it. -@end quotation - -As a general rule, a sentence containing the defining occurrence of a -term should be a definition of the term. The sentence does not need -to say explicitly that it is a definition, but it should contain the -information of a definition---it should make the meaning clear. - -@node cite, url, dfn, Indicating -@comment node-name, next, previous, up -@subsection @code{@@cite}@{@var{reference}@} -@findex cite - -Use the @code{@@cite} command for the name of a book that lacks a -companion Info file. The command produces italics in the printed -manual, and quotation marks in the Info file.@refill - -(If a book is written in Texinfo, it is better to use a cross reference -command since a reader can easily follow such a reference in Info. -@xref{xref, , @code{@@xref}}.)@refill - -@ignore -@c node ctrl, , cite, Indicating -@comment node-name, next, previous, up -@c subsection @code{@@ctrl}@{@var{ctrl-char}@} -@findex ctrl - -The @code{@@ctrl} command is seldom used. It describes an @sc{ascii} -control character by inserting the actual character into the Info -file. - -Usually, in Texinfo, you talk what you type as keyboard entry by -describing it with @code{@@kbd}: thus, @samp{@@kbd@{C-a@}} for -@kbd{C-a}. Use @code{@@kbd} in this way when talking about a control -character that is typed on the keyboard by the user. When talking -about a control character appearing in a file or a string, do not use -@code{@@kbd} since the control character is not typed. Also, do not -use @samp{C-} but spell out @code{control-}, as in @samp{control-a}, -to make it easier for a reader to understand.@refill - -@code{@@ctrl} is an idea from the beginnings of Texinfo which may not -really fit in to the scheme of things. But there may be times when -you want to use the command. The pattern is -@code{@@ctrl@{@var{ch}@}}, where @var{ch} is an @sc{ascii} character -whose control-equivalent is wanted. For example, to specify -@samp{control-f}, you would enter@refill - -@example -@@ctrl@{f@} -@end example - -@noindent -produces - -@quotation -@ctrl{f} -@end quotation - -In the Info file, this generates the specified control character, output -literally into the file. This is done so a user can copy the specified -control character (along with whatever else he or she wants) into another -Emacs buffer and use it. Since the `control-h',`control-i', and -`control-j' characters are formatting characters, they should not be -indicated with @code{@@ctrl}.@refill - -In a printed manual, @code{@@ctrl} generates text to describe or -identify that control character: an uparrow followed by the character -@var{ch}.@refill -@end ignore - - -@node url, email, cite, Indicating -@subsection @code{@@url}@{@var{uniform-resource-locator}@} -@findex url -@cindex Uniform resource locator, indicating -@cindex URL, indicating - -Use the @code{@@url} to indicate a uniform resource locator on the World -Wide Web. This is analogous to @code{@@file}, @code{@@var}, etc., and -is purely for markup purposes. It does not produce a link you can -follow in HTML output (the @code{@@uref} command does, @pxref{uref,, -@code{@@uref}}). It is useful for example URL's which do not actually -exist. For example: - -@c Two lines because one is too long for smallbook format. -@example -For example, the url might be -@@url@{http://host.domain.org/path@}. -@end example - - -@node email, , url, Indicating -@subsection @code{@@email}@{@var{email-address}[, @var{displayed-text}]@} -@findex email - -Use the @code{@@email} command to indicate an electronic mail address. -It takes one mandatory argument, the address, and one optional argument, the -text to display (the default is the address itself). - -@cindex mailto link -In Info and @TeX{}, the address is shown in angle brackets, preceded by -the text to display if any. In HTML output, @code{@@email} produces a -@samp{mailto} link that usually brings up a mail composition window. -For example: - -@example -Send bug reports to @@email@{bug-texinfo@@@@gnu.org@}. -Send suggestions to the @@email@{bug-texinfo@@@@gnu.org, same place@}. -@end example -@noindent -produces -@example -Send bug reports to @email{bug-texinfo@@gnu.org}. -Send suggestions to the @email{bug-texinfo@@gnu.org, same place}. -@end example - - -@node Emphasis, , Indicating, Marking Text -@comment node-name, next, previous, up -@section Emphasizing Text -@cindex Emphasizing text - -Usually, Texinfo changes the font to mark words in the text according to -what category the words belong to; an example is the @code{@@code} command. -Most often, this is the best way to mark words. -However, sometimes you will want to emphasize text without indicating a -category. Texinfo has two commands to do this. Also, Texinfo has -several commands that specify the font in which @TeX{} will typeset -text. These commands have no affect on Info and only one of them, -the @code{@@r} command, has any regular use.@refill - -@menu -* emph & strong:: How to emphasize text in Texinfo. -* Smallcaps:: How to use the small caps font. -* Fonts:: Various font commands for printed output. -* Customized Highlighting:: How to define highlighting commands. -@end menu - -@node emph & strong, Smallcaps, Emphasis, Emphasis -@comment node-name, next, previous, up -@subsection @code{@@emph}@{@var{text}@} and @code{@@strong}@{@var{text}@} -@cindex Emphasizing text, font for -@findex emph -@findex strong - -The @code{@@emph} and @code{@@strong} commands are for emphasis; -@code{@@strong} is stronger. In printed output, @code{@@emph} -produces @emph{italics} and @code{@@strong} produces -@strong{bold}.@refill - -@need 800 -For example, - -@example -@group -@@quotation -@@strong@{Caution:@} @@samp@{rm * .[^.]*@} removes @@emph@{all@} -files in the directory. -@@end quotation -@end group -@end example - -@iftex -@noindent -produces the following in printed output: - -@quotation -@strong{Caution}: @code{rm * .[^.]*} removes @emph{all} -files in the directory. -@end quotation - -@noindent -and the following in Info: -@end iftex -@ifinfo -@noindent -produces: -@end ifinfo - -@example - *Caution*: `rm * .[^.]*' removes *all* - files in the directory. -@end example - -The @code{@@strong} command is seldom used except to mark what is, in -effect, a typographical element, such as the word `Caution' in the -preceding example. - -In the Info file, both @code{@@emph} and @code{@@strong} put asterisks -around the text.@refill - -@quotation -@strong{Caution:} Do not use @code{@@emph} or @code{@@strong} with the -word @samp{Note}; Info will mistake the combination for a cross -reference. Use a phrase such as @strong{Please note} or -@strong{Caution} instead.@refill -@end quotation - -@node Smallcaps, Fonts, emph & strong, Emphasis -@subsection @code{@@sc}@{@var{text}@}: The Small Caps Font -@cindex Small caps font -@findex sc @r{(small caps font)} - -@iftex -Use the @samp{@@sc} command to set text in the printed output in @sc{a -small caps font} and set text in the Info file in upper case letters.@refill -@end iftex -@ifinfo -Use the @samp{@@sc} command to set text in the printed output in a -small caps font and set text in the Info file in upper case letters.@refill -@end ifinfo - -Write the text between braces in lower case, like this:@refill - -@example -The @@sc@{acm@} and @@sc@{ieee@} are technical societies. -@end example - -@noindent -This produces: - -@display -The @sc{acm} and @sc{ieee} are technical societies. -@end display - -@TeX{} typesets the small caps font in a manner that prevents the -letters from `jumping out at you on the page'. This makes small caps -text easier to read than text in all upper case. The Info formatting -commands set all small caps text in upper case.@refill - -@ifinfo -If the text between the braces of an @code{@@sc} command is upper case, -@TeX{} typesets in full-size capitals. Use full-size capitals -sparingly.@refill -@end ifinfo -@iftex -If the text between the braces of an @code{@@sc} command is upper case, -@TeX{} typesets in @sc{FULL-SIZE CAPITALS}. Use full-size capitals -sparingly.@refill -@end iftex - -You may also use the small caps font for a jargon word such as -@sc{ato} (a @sc{nasa} word meaning `abort to orbit').@refill - -There are subtleties to using the small caps font with a jargon word -such as @sc{cdr}, a word used in Lisp programming. In this case, you -should use the small caps font when the word refers to the second and -subsequent elements of a list (the @sc{cdr} of the list), but you -should use @samp{@@code} when the word refers to the Lisp function of -the same spelling.@refill - -@node Fonts, Customized Highlighting, Smallcaps, Emphasis -@comment node-name, next, previous, up -@subsection Fonts for Printing, Not Info -@cindex Fonts for printing, not for Info -@findex i @r{(italic font)} -@findex b @r{(bold font)} -@findex t @r{(typewriter font)} -@findex r @r{(Roman font)} - -Texinfo provides four font commands that specify font changes in the -printed manual but have no effect in the Info file. @code{@@i} -requests @i{italic} font (in some versions of @TeX{}, a slanted font -is used), @code{@@b} requests @b{bold} face, @code{@@t} requests the -@t{fixed-width}, typewriter-style font used by @code{@@code}, and @code{@@r} requests a -@r{roman} font, which is the usual font in which text is printed. All -four commands apply to an argument that follows, surrounded by -braces.@refill - -Only the @code{@@r} command has much use: in example programs, you -can use the @code{@@r} command to convert code comments from the -fixed-width font to a roman font. This looks better in printed -output.@refill - -@need 700 -For example, - -@example -@group -@@lisp -(+ 2 2) ; @@r@{Add two plus two.@} -@@end lisp -@end group -@end example - -@noindent -produces - -@lisp -(+ 2 2) ; @r{Add two plus two.} -@end lisp - -If possible, you should avoid using the other three font commands. If -you need to use one, it probably indicates a gap in the Texinfo -language.@refill - -@node Customized Highlighting, , Fonts, Emphasis -@comment node-name, next, previous, up -@subsection Customized Highlighting -@cindex Highlighting, customized -@cindex Customized highlighting - -@c I think this whole section is obsolete with the advent of macros -@c --karl, 15sep96. -You can use regular @TeX{} commands inside of @code{@@iftex} @dots{} -@code{@@end iftex} to create your own customized highlighting commands -for Texinfo. The easiest way to do this is to equate your customized -commands with pre-existing commands, such as those for italics. Such -new commands work only with @TeX{}.@refill - -@findex definfoenclose -@cindex Enclosure command for Info -You can use the @code{@@definfoenclose} command inside of -@code{@@ifinfo} @dots{} @code{@@end ifinfo} to define commands for Info -with the same names as new commands for @TeX{}. -@code{@@definfoenclose} creates new commands for Info that mark text by -enclosing it in strings that precede and follow the text. -@footnote{Currently, @code{@@definfoenclose} works only with -@code{texinfo-format-buffer} and @code{texinfo-format-region}, not with -@code{makeinfo}.}@refill - -Here is how to create a new @@-command called @code{@@phoo} that causes -@TeX{} to typeset its argument in italics and causes Info to display the -argument between @samp{//} and @samp{\\}.@refill - -@need 1300 -For @TeX{}, write the following to equate the @code{@@phoo} command with -the existing @code{@@i} italics command:@refill - -@example -@group -@@iftex -@@global@@let@@phoo=@@i -@@end iftex -@end group -@end example - -@noindent -This defines @code{@@phoo} as a command that causes @TeX{} to typeset -the argument to @code{@@phoo} in italics. @code{@@global@@let} tells -@TeX{} to equate the next argument with the argument that follows the -equals sign. - -@need 1300 -For Info, write the following to tell the Info formatters to enclose the -argument between @samp{//} and @samp{\\}: - -@example -@group -@@ifinfo -@@definfoenclose phoo, //, \\ -@@end ifinfo -@end group -@end example - -@noindent -Write the @code{@@definfoenclose} command on a line and follow it with -three arguments separated by commas (commas are used as separators in an -@code{@@node} line in the same way).@refill - -@itemize @bullet -@item -The first argument to @code{@@definfoenclose} is the @@-command name -@strong{without} the @samp{@@}; - -@item -the second argument is the Info start delimiter string; and, - -@item -the third argument is the Info end delimiter string. -@end itemize - -@noindent -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.@refill - -After you have defined @code{@@phoo} both for @TeX{} and for Info, you -can then write @code{@@phoo@{bar@}} to see @samp{//bar\\} -in Info and see -@ifinfo -@samp{bar} in italics in printed output. -@end ifinfo -@iftex -@i{bar} in italics in printed output. -@end iftex - -Note that each definition applies to its own formatter: one for @TeX{}, -the other for Info. - -@need 1200 -Here is another example: - -@example -@group -@@ifinfo -@@definfoenclose headword, , : -@@end ifinfo -@@iftex -@@global@@let@@headword=@@b -@@end iftex -@end group -@end example - -@noindent -This defines @code{@@headword} as an Info formatting command that -inserts nothing before and a colon after the argument and as a @TeX{} -formatting command to typeset its argument in bold. - -@node Quotations and Examples, Lists and Tables, Marking Text, Top -@comment node-name, next, previous, up -@chapter Quotations and Examples - -Quotations and examples are blocks of text consisting of one or more -whole paragraphs that are set off from the bulk of the text and -treated differently. They are usually indented.@refill - -In Texinfo, you always begin a quotation or example by writing an -@@-command at the beginning of a line by itself, and end it by writing -an @code{@@end} command that is also at the beginning of a line by -itself. For instance, you begin an example by writing @code{@@example} -by itself at the beginning of a line and end the example by writing -@code{@@end example} on a line by itself, at the beginning of that -line.@refill -@findex end - -@menu -* Block Enclosing Commands:: Use different constructs for - different purposes. -* quotation:: How to write a quotation. -* example:: How to write an example in a fixed-width font. -* noindent:: How to prevent paragraph indentation. -* Lisp Example:: How to illustrate Lisp code. -* smallexample & smalllisp:: Forms for the @code{@@smallbook} option. -* display:: How to write an example in the current font. -* format:: How to write an example that does not narrow - the margins. -* exdent:: How to undo the indentation of a line. -* flushleft & flushright:: How to push text flushleft or flushright. -* cartouche:: How to draw cartouches around examples. -@end menu - -@node Block Enclosing Commands, quotation, Quotations and Examples, Quotations and Examples -@section The Block Enclosing Commands - -Here are commands for quotations and examples:@refill - -@table @code -@item @@quotation -Indicate text that is quoted. The text is filled, indented, and -printed in a roman font by default.@refill - -@item @@example -Illustrate code, commands, and the like. The text is printed -in a fixed-width font, and indented but not filled.@refill - -@item @@lisp -Illustrate Lisp code. The text is printed in a fixed-width font, -and indented but not filled.@refill - -@item @@smallexample -Illustrate code, commands, and the like. Similar to -@code{@@example}, except that in @TeX{} this command typesets text in -a smaller font for the smaller @code{@@smallbook} format than for the -8.5 by 11 inch format.@refill - -@item @@smalllisp -Illustrate Lisp code. Similar to @code{@@lisp}, except that -in @TeX{} this command typesets text in a smaller font for the smaller -@code{@@smallbook} format than for the 8.5 by 11 inch format.@refill - -@item @@display -Display illustrative text. The text is indented but not filled, and -no font is specified (so, by default, the font is roman).@refill - -@item @@format -Print illustrative text. The text is not indented and not filled -and no font is specified (so, by default, the font is roman).@refill -@end table - -The @code{@@exdent} command is used within the above constructs to -undo the indentation of a line. - -The @code{@@flushleft} and @code{@@flushright} commands are used to line -up the left or right margins of unfilled text.@refill - -The @code{@@noindent} command may be used after one of the above -constructs to prevent the following text from being indented as a new -paragraph.@refill - -You can use the @code{@@cartouche} command within one of the above -constructs to highlight the example or quotation by drawing a box with -rounded corners around it. (The @code{@@cartouche} command affects -only the printed manual; it has no effect in the Info file; see -@ref{cartouche, , Drawing Cartouches Around Examples}.)@refill - -@node quotation, example, Block Enclosing Commands, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@quotation} -@cindex Quotations -@findex quotation - -The text of a quotation is -processed normally except that:@refill - -@itemize @bullet -@item -the margins are closer to the center of the page, so the whole of the -quotation is indented;@refill - -@item -the first lines of paragraphs are indented no more than other -lines;@refill - -@item -in the printed output, interparagraph spacing is reduced.@refill -@end itemize - -@quotation -This is an example of text written between an @code{@@quotation} -command and an @code{@@end quotation} command. An @code{@@quotation} -command is most often used to indicate text that is excerpted from -another (real or hypothetical) printed work.@refill -@end quotation - -Write an @code{@@quotation} command as text on a line by itself. This -line will disappear from the output. Mark the end of the quotation -with a line beginning with and containing only @code{@@end quotation}. -The @code{@@end quotation} line will likewise disappear from the -output. Thus, the following,@refill - -@example -@@quotation -This is -a foo. -@@end quotation -@end example - -@noindent -produces - -@quotation -This is a foo. -@end quotation - -@node example, noindent, quotation, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@example} -@cindex Examples, formatting them -@cindex Formatting examples -@findex example - -The @code{@@example} command is used to indicate an example that is -not part of the running text, such as computer input or output.@refill - -@example -@group -This is an example of text written between an -@code{@@example} command -and an @code{@@end example} command. -The text is indented but not filled. -@end group - -@group -In the printed manual, the text is typeset in a -fixed-width font, and extra spaces and blank lines are -significant. In the Info file, an analogous result is -obtained by indenting each line with five spaces. -@end group -@end example - -Write an @code{@@example} command at the beginning of a line by itself. -This line will disappear from the output. Mark the end of the example -with an @code{@@end example} command, also written at the beginning of a -line by itself. The @code{@@end example} will disappear from the -output.@refill - -@need 700 -For example, - -@example -@@example -mv foo bar -@@end example -@end example - -@noindent -produces - -@example -mv foo bar -@end example - -Since the lines containing @code{@@example} and @code{@@end example} -will disappear, you should put a blank line before the -@code{@@example} and another blank line after the @code{@@end -example}. (Remember that blank lines between the beginning -@code{@@example} and the ending @code{@@end example} will appear in -the output.)@refill - -@quotation -@strong{Caution:} Do not use tabs in the lines of an example (or anywhere -else in Texinfo, for that matter)! @TeX{} treats tabs as single -spaces, and that is not what they look like. This is a problem with -@TeX{}. (If necessary, in Emacs, you can use @kbd{M-x untabify} to -convert tabs in a region to multiple spaces.)@refill -@end quotation - -Examples are often, logically speaking, ``in the middle'' of a -paragraph, and the text continues after an example should not be -indented. The @code{@@noindent} command prevents a piece of text from -being indented as if it were a new paragraph. -@ifinfo -(@xref{noindent}.) -@end ifinfo - -(The @code{@@code} command is used for examples of code that are -embedded within sentences, not set off from preceding and following -text. @xref{code, , @code{@@code}}.) - -@node noindent, Lisp Example, example, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@noindent} -@findex noindent - -An example or other inclusion can break a paragraph into segments. -Ordinarily, the formatters indent text that follows an example as a new -paragraph. However, you can prevent this by writing @code{@@noindent} -at the beginning of a line by itself preceding the continuation -text.@refill - -@need 1500 -For example: - -@example -@group -@@example -This is an example -@@end example - -@@noindent -This line is not indented. As you can see, the -beginning of the line is fully flush left with the line -that follows after it. (This whole example is between -@@code@{@@@@display@} and @@code@{@@@@end display@}.) -@end group -@end example - -@noindent -produces - -@display -@example -This is an example -@end example -@tex -% Remove extra vskip; this is a kludge to counter the effect of display -\vskip-3.5\baselineskip -@end tex - -@noindent -This line is not indented. As you can see, the -beginning of the line is fully flush left with the line -that follows after it. (This whole example is between -@code{@@display} and @code{@@end display}.) -@end display - -To adjust the number of blank lines properly in the Info file output, -remember that the line containing @code{@@noindent} does not generate a -blank line, and neither does the @code{@@end example} line.@refill - -In the Texinfo source file for this manual, each line that says -`produces' is preceded by a line containing @code{@@noindent}.@refill - -Do not put braces after an @code{@@noindent} command; they are not -necessary, since @code{@@noindent} is a command used outside of -paragraphs (@pxref{Command Syntax}).@refill - -@node Lisp Example, smallexample & smalllisp, noindent, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@lisp} -@cindex Lisp example -@findex lisp - -The @code{@@lisp} command is used for Lisp code. It is synonymous -with the @code{@@example} command. - -@lisp -This is an example of text written between an -@code{@@lisp} command and an @code{@@end lisp} command. -@end lisp - -Use @code{@@lisp} instead of @code{@@example} to preserve information -regarding the nature of the example. This is useful, for example, if -you write a function that evaluates only and all the Lisp code in a -Texinfo file. Then you can use the Texinfo file as a Lisp -library.@footnote{It would be straightforward to extend Texinfo to work -in a similar fashion for C, Fortran, or other languages.}@refill - -Mark the end of @code{@@lisp} with @code{@@end lisp} on a line by -itself.@refill - -@node smallexample & smalllisp, display, Lisp Example, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@smallexample} and @code{@@smalllisp} -@cindex Small book example -@cindex Example for a small book -@cindex Lisp example for a small book -@findex smallexample -@findex smalllisp - -In addition to the regular @code{@@example} and @code{@@lisp} commands, -Texinfo has two other ``example-style'' commands. These are the -@code{@@smallexample} and @code{@@smalllisp} commands. Both these -commands are designed for use with the @code{@@smallbook} command that -causes @TeX{} to produce a printed manual in a 7 by 9.25 inch format -rather than the regular 8.5 by 11 inch format.@refill - -In @TeX{}, the @code{@@smallexample} and @code{@@smalllisp} commands -typeset text in a smaller font for the smaller @code{@@smallbook} -format than for the 8.5 by 11 inch format. Consequently, many examples -containing long lines fit in a narrower, @code{@@smallbook} page -without needing to be shortened. Both commands typeset in the normal -font size when you format for the 8.5 by 11 inch size; indeed, -in this situation, the @code{@@smallexample} and @code{@@smalllisp} -commands are defined to be the @code{@@example} and @code{@@lisp} -commands.@refill - -In Info, the @code{@@smallexample} and @code{@@smalllisp} commands are -equivalent to the @code{@@example} and @code{@@lisp} commands, and work -exactly the same.@refill - -Mark the end of @code{@@smallexample} or @code{@@smalllisp} with -@code{@@end smallexample} or @code{@@end smalllisp}, -respectively.@refill - -@iftex -Here is an example written in the small font used by the -@code{@@smallexample} and @code{@@smalllisp} commands: - -@ifclear smallbook -@display -@tex -% Remove extra vskip; this is a kludge to counter the effect of display -\vskip-3\baselineskip -{\ninett -\dots{} 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.} -@end tex -@end display -@end ifclear -@end iftex -@ifset smallbook -@iftex -@smallexample -This is an example of text written between @code{@@smallexample} and -@code{@@end smallexample}. In Info and in an 8.5 by 11 inch manual, -this text appears in its normal size; but in a 7 by 9.25 inch manual, -this text appears in a smaller font. -@end smallexample -@end iftex -@end ifset -@ifinfo -@smallexample -This is an example of text written between @code{@@smallexample} and -@code{@@end smallexample}. In Info and in an 8.5 by 11 inch manual, -this text appears in its normal size; but in a 7 by 9.25 inch manual, -this text appears in a smaller font. -@end smallexample -@end ifinfo - -The @code{@@smallexample} and @code{@@smalllisp} commands make it -easier to prepare smaller format manuals without forcing you to edit -examples by hand to fit them onto narrower pages.@refill - -As a general rule, a printed document looks better if you write all the -examples in a chapter consistently in @code{@@example} or in -@code{@@smallexample}. Only occasionally should you mix the two -formats.@refill - -@xref{smallbook, , Printing ``Small'' Books}, for more information -about the @code{@@smallbook} command.@refill - -@node display, format, smallexample & smalllisp, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@display} -@cindex Display formatting -@findex display - -The @code{@@display} command begins a kind of example. It is like the -@code{@@example} command -except that, in -a printed manual, @code{@@display} does not select the fixed-width -font. In fact, it does not specify the font at all, so that the text -appears in the same font it would have appeared in without the -@code{@@display} command.@refill - -@display -This is an example of text written between an @code{@@display} command -and an @code{@@end display} command. The @code{@@display} command -indents the text, but does not fill it. -@end display - -@node format, exdent, display, Quotations and Examples -@comment node-name, next, previous, up -@section @code{@@format} -@findex format - -The @code{@@format} command is similar to @code{@@example} except -that, in the printed manual, @code{@@format} does not select the -fixed-width font and does not narrow the margins.@refill - -@format -This is an example of text written between an @code{@@format} command -and an @code{@@end format} command. As you can see -from this example, -the @code{@@format} command does not fill the text. -@end format - -@node exdent, flushleft & flushright, format, Quotations and Examples -@section @code{@@exdent}: Undoing a Line's Indentation -@cindex Indentation undoing -@findex exdent - -The @code{@@exdent} command removes any indentation a line might have. -The command is written at the beginning of a line and applies only to -the text that follows the command that is on the same line. Do not use -braces around the text. In a printed manual, the text on an -@code{@@exdent} line is printed in the roman font.@refill - -@code{@@exdent} is usually used within examples. Thus,@refill - -@example -@group -@@example -This line follows an @@@@example command. -@@exdent This line is exdented. -This line follows the exdented line. -The @@@@end example comes on the next line. -@@end group -@end group -@end example - -@noindent -produces - -@example -@group -This line follows an @@example command. -@exdent This line is exdented. -This line follows the exdented line. -The @@end example comes on the next line. -@end group -@end example - -In practice, the @code{@@exdent} command is rarely used. -Usually, you un-indent text by ending the example and -returning the page to its normal width.@refill - -@node flushleft & flushright, cartouche, exdent, Quotations and Examples -@section @code{@@flushleft} and @code{@@flushright} -@findex flushleft -@findex flushright - -The @code{@@flushleft} and @code{@@flushright} commands line up the -ends of lines on the left and right margins of a page, -but do not fill the text. The commands are written on lines of their -own, without braces. The @code{@@flushleft} and @code{@@flushright} -commands are ended by @code{@@end flushleft} and @code{@@end -flushright} commands on lines of their own.@refill - -@need 1500 -For example, - -@example -@group -@@flushleft -This text is -written flushleft. -@@end flushleft -@end group -@end example - -@noindent -produces - -@quotation -@flushleft -This text is -written flushleft. -@end flushleft -@end quotation - - -@code{@@flushright} produces the type of indentation often used in the -return address of letters. For example, - -@example -@group -@@flushright -Here is an example of text written -flushright. The @@code@{@@flushright@} command -right justifies every line but leaves the -left end ragged. -@@end flushright -@end group -@end example - -@noindent -produces - -@flushright -Here is an example of text written -flushright. The @code{@@flushright} command -right justifies every line but leaves the -left end ragged. -@end flushright - -@node cartouche, , flushleft & flushright, Quotations and Examples -@section Drawing Cartouches Around Examples -@findex cartouche -@cindex Box with rounded corners - -In a printed manual, the @code{@@cartouche} command draws a box with -rounded corners around its contents. You can use this command to -further highlight an example or quotation. For instance, you could -write a manual in which one type of example is surrounded by a cartouche -for emphasis.@refill - -The @code{@@cartouche} command affects only the printed manual; it has -no effect in the Info file.@refill - -@need 1500 -For example, - -@example -@group -@@example -@@cartouche -% pwd -/usr/local/share/emacs -@@end cartouche -@@end example -@end group -@end example - -@noindent -surrounds the two-line example with a box with rounded corners, in the -printed manual. - -@iftex -In a printed manual, the example looks like this:@refill - -@example -@group -@cartouche -% pwd -/usr/local/lib/emacs/info -@end cartouche -@end group -@end example -@end iftex - - -@node Lists and Tables, Indices, Quotations and Examples, Top -@chapter Lists and Tables -@cindex Making lists and tables -@cindex Lists and tables, making -@cindex Tables and lists, making - -Texinfo has several ways of making lists and tables. Lists can be -bulleted or numbered; two-column tables can highlight the items in -the first column; multi-column tables are also supported. - -@menu -* Introducing Lists:: Texinfo formats lists for you. -* itemize:: How to construct a simple list. -* enumerate:: How to construct a numbered list. -* Two-column Tables:: How to construct a two-column table. -* Multi-column Tables:: How to construct generalized tables. -@end menu - -@ifinfo -@node Introducing Lists, itemize, Lists and Tables, Lists and Tables -@heading Introducing Lists -@end ifinfo - -Texinfo automatically indents the text in lists or tables, and numbers -an enumerated list. This last feature is useful if you modify the -list, since you do not need to renumber it yourself.@refill - -Numbered lists and tables begin with the appropriate @@-command at the -beginning of a line, and end with the corresponding @code{@@end} -command on a line by itself. The table and itemized-list commands -also require that you write formatting information on the same line as -the beginning @@-command.@refill - -Begin an enumerated list, for example, with an @code{@@enumerate} -command and end the list with an @code{@@end enumerate} command. -Begin an itemized list with an @code{@@itemize} command, followed on -the same line by a formatting command such as @code{@@bullet}, and end -the list with an @code{@@end itemize} command.@refill -@findex end - -Precede each element of a list with an @code{@@item} or @code{@@itemx} -command.@refill - -@sp 1 -@noindent -Here is an itemized list of the different kinds of table and lists:@refill - -@itemize @bullet -@item -Itemized lists with and without bullets. - -@item -Enumerated lists, using numbers or letters. - -@item -Two-column tables with highlighting. -@end itemize - -@sp 1 -@noindent -Here is an enumerated list with the same items:@refill - -@enumerate -@item -Itemized lists with and without bullets. - -@item -Enumerated lists, using numbers or letters. - -@item -Two-column tables with highlighting. -@end enumerate - -@sp 1 -@noindent -And here is a two-column table with the same items and their -@w{@@-commands}:@refill - -@table @code -@item @@itemize -Itemized lists with and without bullets. - -@item @@enumerate -Enumerated lists, using numbers or letters. - -@item @@table -@itemx @@ftable -@itemx @@vtable -Two-column tables with indexing. -@end table - -@node itemize, enumerate, Introducing Lists, Lists and Tables -@comment node-name, next, previous, up -@section Making an Itemized List -@cindex Itemization -@findex itemize - -The @code{@@itemize} command produces sequences of indented -paragraphs, with a bullet or other mark inside the left margin -at the beginning of each paragraph for which such a mark is desired.@refill - -Begin an itemized list by writing @code{@@itemize} at the beginning of -a line. Follow the command, on the same line, with a character or a -Texinfo command that generates a mark. Usually, you will write -@code{@@bullet} after @code{@@itemize}, but you can use -@code{@@minus}, or any character or any special symbol that results in -a single character in the Info file. (When you write @code{@@bullet} -or @code{@@minus} after an @code{@@itemize} command, you may omit the -@samp{@{@}}.)@refill - -Write the text of the indented paragraphs themselves after the -@code{@@itemize}, up to another line that says @code{@@end -itemize}.@refill - -Before each paragraph for which a mark in the margin is desired, write -a line that says just @code{@@item}. Do not write any other text on this -line.@refill -@findex item - -Usually, you should put a blank line before an @code{@@item}. This -puts a blank line in the Info file. (@TeX{} inserts the proper -interline whitespace in either case.) Except when the entries are -very brief, these blank lines make the list look better.@refill - -Here is an example of the use of @code{@@itemize}, followed by the -output it produces. Note that @code{@@bullet} produces an @samp{*} in -Info and a round dot in @TeX{}.@refill - -@example -@group -@@itemize @@bullet -@@item -Some text for foo. - -@@item -Some text -for bar. -@@end itemize -@end group -@end example - -@noindent -This produces: - -@quotation -@itemize @bullet -@item -Some text for foo. - -@item -Some text -for bar. -@end itemize -@end quotation - -Itemized lists may be embedded within other itemized lists. Here is a -list marked with dashes embedded in a list marked with bullets:@refill - -@example -@group -@@itemize @@bullet -@@item -First item. - -@@itemize @@minus -@@item -Inner item. - -@@item -Second inner item. -@@end itemize - -@@item -Second outer item. -@@end itemize -@end group -@end example - -@noindent -This produces: - -@quotation -@itemize @bullet -@item -First item. - -@itemize @minus -@item -Inner item. - -@item -Second inner item. -@end itemize - -@item -Second outer item. -@end itemize -@end quotation - -@node enumerate, Two-column Tables, itemize, Lists and Tables -@comment node-name, next, previous, up -@section Making a Numbered or Lettered List -@cindex Enumeration -@findex enumerate - -@code{@@enumerate} is like @code{@@itemize} (@pxref{itemize,, -@code{@@itemize}}), except that the labels on the items are -successive integers or letters instead of bullets. - -Write the @code{@@enumerate} command at the beginning of a line. The -command does not require an argument, but accepts either a number or a -letter as an option. Without an argument, @code{@@enumerate} starts the -list with the number @samp{1}. With a numeric argument, such as -@samp{3}, the command starts the list with that number. With an upper -or lower case letter, such as @samp{a} or @samp{A}, the command starts -the list with that letter.@refill - -Write the text of the enumerated list in the same way you write an -itemized list: put @code{@@item} on a line of its own before the start -of each paragraph that you want enumerated. Do not write any other text -on the line beginning with @code{@@item}.@refill - -You should put a blank line between entries in the list. -This generally makes it easier to read the Info file.@refill - -@need 1500 -Here is an example of @code{@@enumerate} without an argument:@refill - -@example -@group -@@enumerate -@@item -Underlying causes. - -@@item -Proximate causes. -@@end enumerate -@end group -@end example - -@noindent -This produces: - -@enumerate -@item -Underlying causes. - -@item -Proximate causes. -@end enumerate -@sp 1 -Here is an example with an argument of @kbd{3}:@refill -@sp 1 -@example -@group -@@enumerate 3 -@@item -Predisposing causes. - -@@item -Precipitating causes. - -@@item -Perpetuating causes. -@@end enumerate -@end group -@end example - -@noindent -This produces: - -@enumerate 3 -@item -Predisposing causes. - -@item -Precipitating causes. - -@item -Perpetuating causes. -@end enumerate -@sp 1 -Here is a brief summary of the alternatives. The summary is constructed -using @code{@@enumerate} with an argument of @kbd{a}.@refill -@sp 1 -@enumerate a -@item -@code{@@enumerate} - -Without an argument, produce a numbered list, starting with the number -1.@refill - -@item -@code{@@enumerate @var{positive-integer}} - -With a (positive) numeric argument, start a numbered list with that -number. You can use this to continue a list that you interrupted with -other text.@refill - -@item -@code{@@enumerate @var{upper-case-letter}} - -With an upper case letter as argument, start a list -in which each item is marked -by a letter, beginning with that upper case letter.@refill - -@item -@code{@@enumerate @var{lower-case-letter}} - -With a lower case letter as argument, start a list -in which each item is marked by -a letter, beginning with that lower case letter.@refill -@end enumerate - -You can also nest enumerated lists, as in an outline.@refill - -@node Two-column Tables, Multi-column Tables, enumerate, Lists and Tables -@section Making a Two-column Table -@cindex Tables, making two-column -@findex table - -@code{@@table} is similar to @code{@@itemize} (@pxref{itemize,, -@code{@@itemize}}), but allows you to specify a name or heading line for -each item. The @code{@@table} command is used to produce two-column -tables, and is especially useful for glossaries, explanatory -exhibits, and command-line option summaries. - -@menu -* table:: How to construct a two-column table. -* ftable vtable:: Automatic indexing for two-column tables. -* itemx:: How to put more entries in the first column. -@end menu - -@ifinfo -@node table, ftable vtable, Two-column Tables, Two-column Tables -@subheading Using the @code{@@table} Command - -Use the @code{@@table} command to produce two-column tables.@refill -@end ifinfo - -Write the @code{@@table} command at the beginning of a line and follow -it on the same line with an argument that is a Texinfo ``indicating'' -command such as @code{@@code}, @code{@@samp}, @code{@@var}, or -@code{@@kbd} (@pxref{Indicating}). Although these commands are usually -followed by arguments in braces, in this case you use the command name -without an argument because @code{@@item} will supply the argument. -This command will be applied to the text that goes into the first column -of each item and determines how it will be highlighted. For example, -@code{@@code} will cause the text in the first column to be highlighted -with an @code{@@code} command. (We recommend @code{@@code} for -@code{@@table}'s of command-line options.) - -@findex asis -You may also choose to use the @code{@@asis} command as an argument to -@code{@@table}. @code{@@asis} is a command that does nothing; if you -use this command after @code{@@table}, @TeX{} and the Info formatting -commands output the first column entries without added highlighting -(``as is'').@refill - -(The @code{@@table} command may work with other commands besides those -listed here. However, you can only use commands that normally take -arguments in braces.)@refill - -Begin each table entry with an @code{@@item} command at the beginning -of a line. Write the first column text on the same line as the -@code{@@item} command. Write the second column text on the line -following the @code{@@item} line and on subsequent lines. (You do not -need to type anything for an empty second column entry.) You may -write as many lines of supporting text as you wish, even several -paragraphs. But only text on the same line as the @code{@@item} will -be placed in the first column.@refill -@findex item - -Normally, you should put a blank line before an @code{@@item} line. -This puts a blank like in the Info file. Except when the entries are -very brief, a blank line looks better.@refill - -@need 1500 -The following table, for example, highlights the text in the first -column with an @code{@@samp} command:@refill - -@example -@group -@@table @@samp -@@item foo -This is the text for -@@samp@{foo@}. - -@@item bar -Text for @@samp@{bar@}. -@@end table -@end group -@end example - -@noindent -This produces: - -@table @samp -@item foo -This is the text for -@samp{foo}. -@item bar -Text for @samp{bar}. -@end table - -If you want to list two or more named items with a single block of -text, use the @code{@@itemx} command. (@xref{itemx, , -@code{@@itemx}}.)@refill - -@node ftable vtable, itemx, table, Two-column Tables -@comment node-name, next, previous, up -@subsection @code{@@ftable} and @code{@@vtable} -@cindex Tables with indexes -@cindex Indexing table entries automatically -@findex ftable -@findex vtable - -The @code{@@ftable} and @code{@@vtable} commands are the same as the -@code{@@table} command except that @code{@@ftable} automatically enters -each of the items in the first column of the table into the index of -functions and @code{@@vtable} automatically enters each of the items in -the first column of the table into the index of variables. This -simplifies the task of creating indices. Only the items on the same -line as the @code{@@item} commands are indexed, and they are indexed in -exactly the form that they appear on that line. @xref{Indices, , -Creating Indices}, for more information about indices.@refill - -Begin a two-column table using @code{@@ftable} or @code{@@vtable} by -writing the @@-command at the beginning of a line, followed on the same -line by an argument that is a Texinfo command such as @code{@@code}, -exactly as you would for an @code{@@table} command; and end the table -with an @code{@@end ftable} or @code{@@end vtable} command on a line by -itself. - -See the example for @code{@@table} in the previous section. - -@node itemx, , ftable vtable, Two-column Tables -@comment node-name, next, previous, up -@subsection @code{@@itemx} -@cindex Two named items for @code{@@table} -@findex itemx - -Use the @code{@@itemx} command inside a table when you have two or more -first column entries for the same item, each of which should appear on a -line of its own. Use @code{@@itemx} for all but the first entry; -@code{@@itemx} should always follow an @code{@@item} command. The -@code{@@itemx} command works exactly like @code{@@item} except that it -does not generate extra vertical space above the first column text. - -@need 1000 -For example, - -@example -@group -@@table @@code -@@item upcase -@@itemx downcase -These two functions accept a character or a string as -argument, and return the corresponding upper case (lower -case) character or string. -@@end table -@end group -@end example - -@noindent -This produces: - -@table @code -@item upcase -@itemx downcase -These two functions accept a character or a string as -argument, and return the corresponding upper case (lower -case) character or string.@refill -@end table - -@noindent -(Note also that this example illustrates multi-line supporting text in -a two-column table.)@refill - - -@node Multi-column Tables, , Two-column Tables, Lists and Tables -@section Multi-column Tables -@cindex Tables, making multi-column -@findex multitable - -@code{@@multitable} allows you to construct tables with any number of -columns, with each column having any width you like. - -You define the column widths on the @code{@@multitable} line itself, and -write each row of the actual table following an @code{@@item} command, -with columns separated by an @code{@@tab} command. Finally, @code{@@end -multitable} completes the table. Details in the sections below. - -@menu -* Multitable Column Widths:: Defining multitable column widths. -* Multitable Rows:: Defining multitable rows, with examples. -@end menu - -@node Multitable Column Widths, Multitable Rows, Multi-column Tables, Multi-column Tables -@subsection Multitable Column Widths -@cindex Multitable column widths -@cindex Column widths, defining for multitables -@cindex Widths, defining multitable column - -You can define the column widths for a multitable in two ways: as -fractions of the line length; or with a prototype row. Mixing the two -methods is not supported. In either case, the widths are defined -entirely on the same line as the @code{@@multitable} command. - -@enumerate -@item -@findex columnfractions -@cindex Line length, column widths as fraction of -To specify column widths as fractions of the line length, write -@code{@@columnfractions} and the decimal numbers (presumably less than -1) after the @code{@@multitable} command, as in: - -@example -@@multitable @@columnfractions .33 .33 .33 -@end example - -@noindent -The fractions need not add up exactly to 1.0, as these do -not. This allows you to produce tables that do not need the full line -length. - -@item -@cindex Prototype row, column widths defined by -To specify a prototype row, write the longest entry for each column -enclosed in braces after the @code{@@multitable} command. For example: - -@example -@@multitable @{some text for column one@} @{for column two@} -@end example - -@noindent -The first column will then have the width of the typeset `some text for -column one', and the second column the width of `for column two'. - -The prototype entries need not appear in the table itself. - -Although we used simple text in this example, the prototype entries can -contain Texinfo commands; markup commands such as @code{@@code} are -particularly likely to be useful. - -@end enumerate - - -@node Multitable Rows, , Multitable Column Widths, Multi-column Tables -@subsection Multitable Rows -@cindex Multitable rows -@cindex Rows, of a multitable - -@findex item -@cindex tab -After the @code{@@multitable} command defining the column widths (see -the previous section), you begin each row in the body of a multitable -with @code{@@item}, and separate the column entries with @code{@@tab}. -Line breaks are not special within the table body, and you may break -input lines in your source file as necessary. - -Here is a complete example of a multi-column table (the text is from -@cite{The GNU Emacs Manual}, @pxref{Split Window,, Splitting Windows, -xemacs, XEmacs User's Manual}): - -@example -@@multitable @@columnfractions .15 .45 .4 -@@item Key @@tab Command @@tab Description -@@item C-x 2 -@@tab @@code@{split-window-vertically@} -@@tab Split the selected window into two windows, -with one above the other. -@@item C-x 3 -@@tab @@code@{split-window-horizontally@} -@@tab Split the selected window into two windows -positioned side by side. -@@item C-Mouse-2 -@@tab -@@tab In the mode line or scroll bar of a window, -split that window. -@@end multitable -@end example - -@noindent -produces: - -@multitable @columnfractions .15 .45 .4 -@item Key @tab Command @tab Description -@item C-x 2 -@tab @code{split-window-vertically} -@tab Split the selected window into two windows, -with one above the other. -@item C-x 3 -@tab @code{split-window-horizontally} -@tab Split the selected window into two windows -positioned side by side. -@item C-Mouse-2 -@tab -@tab In the mode line or scroll bar of a window, -split that window. -@end multitable - - -@node Indices, Insertions, Lists and Tables, Top -@comment node-name, next, previous, up -@chapter Creating Indices -@cindex Indices -@cindex Creating indices - -Using Texinfo, you can generate indices without having to sort and -collate entries manually. In an index, the entries are listed in -alphabetical order, together with information on how to find the -discussion of each entry. In a printed manual, this information -consists of page numbers. In an Info file, this information is a menu -entry leading to the first node referenced.@refill - -Texinfo provides several predefined kinds of index: an index -for functions, an index for variables, an index for concepts, and so -on. You can combine indices or use them for other than their -canonical purpose. If you wish, you can define your own indices.@refill - -@menu -* Index Entries:: Choose different words for index entries. -* Predefined Indices:: Use different indices for different kinds - of entry. -* Indexing Commands:: How to make an index entry. -* Combining Indices:: How to combine indices. -* New Indices:: How to define your own indices. -@end menu - -@node Index Entries, Predefined Indices, Indices, Indices -@comment node-name, next, previous, up -@section Making Index Entries -@cindex Index entries, making -@cindex Entries, making index - -When you are making index entries, it is good practice to think of the -different ways people may look for something. Different people -@emph{do not} think of the same words when they look something up. A -helpful index will have items indexed under all the different words -that people may use. For example, one reader may think it obvious that -the two-letter names for indices should be listed under ``Indices, -two-letter names'', since the word ``Index'' is the general concept. -But another reader may remember the specific concept of two-letter -names and search for the entry listed as ``Two letter names for -indices''. A good index will have both entries and will help both -readers.@refill - -Like typesetting, the construction of an index is a highly skilled, -professional art, the subtleties of which are not appreciated until you -need to do it yourself.@refill - -@xref{Printing Indices & Menus}, for information about printing an index -at the end of a book or creating an index menu in an Info file.@refill - -@node Predefined Indices, Indexing Commands, Index Entries, Indices -@comment node-name, next, previous, up -@section Predefined Indices - -Texinfo provides six predefined indices:@refill - -@itemize @bullet -@item -A @dfn{concept index} listing concepts that are discussed.@refill - -@item -A @dfn{function index} listing functions (such as entry points of -libraries).@refill - -@item -A @dfn{variables index} listing variables (such as global variables -of libraries).@refill - -@item -A @dfn{keystroke index} listing keyboard commands.@refill - -@item -A @dfn{program index} listing names of programs.@refill - -@item -A @dfn{data type index} listing data types (such as structures defined in -header files).@refill -@end itemize - -@noindent -Not every manual needs all of these, and most manuals use two or three -of them. This manual has two indices: a -concept index and an @@-command index (that is actually the function -index but is called a command index in the chapter heading). Two or -more indices can be combined into one using the @code{@@synindex} or -@code{@@syncodeindex} commands. @xref{Combining Indices}.@refill - -@node Indexing Commands, Combining Indices, Predefined Indices, Indices -@comment node-name, next, previous, up -@section Defining the Entries of an Index -@cindex Defining indexing entries -@cindex Index entries -@cindex Entries for an index -@cindex Specifying index entries -@cindex Creating index entries - -The data to make an index come from many individual indexing commands -scattered throughout the Texinfo source file. Each command says to add -one entry to a particular index; after formatting, the index will give -the current page number or node name as the reference.@refill - -An index entry consists of an indexing command at the beginning of a -line followed, on the rest of the line, by the entry.@refill - -For example, this section begins with the following five entries for -the concept index:@refill - -@example -@@cindex Defining indexing entries -@@cindex Index entries -@@cindex Entries for an index -@@cindex Specifying index entries -@@cindex Creating index entries -@end example - -Each predefined index has its own indexing command---@code{@@cindex} -for the concept index, @code{@@findex} for the function index, and so -on.@refill - -@cindex Writing index entries -@cindex Index entry writing -Concept index entries consist of text. The best way to write an index -is to choose entries that are terse yet clear. If you can do this, -the index often looks better if the entries are not capitalized, but -written just as they would appear in the middle of a sentence. -(Capitalize proper names and acronyms that always call for upper case -letters.) This is the case convention we use in most GNU manuals' -indices. - -If you don't see how to make an entry terse yet clear, make it longer -and clear---not terse and confusing. If many of the entries are several -words long, the index may look better if you use a different convention: -to capitalize the first word of each entry. But do not capitalize a -case-sensitive name such as a C or Lisp function name or a shell -command; that would be a spelling error. - -Whichever case convention you use, please use it consistently! - -@ignore -Concept index entries consist of English text. The usual convention -is to capitalize the first word of each such index entry, unless that -word is the name of a function, variable, or other such entity that -should not be capitalized. However, if your concept index entries are -consistently short (one or two words each) it may look better for each -regular entry to start with a lower case letter, aside from proper -names and acronyms that always call for upper case letters. Whichever -convention you adapt, please be consistent! -@end ignore - -Entries in indices other than the concept index are symbol names in -programming languages, or program names; these names are usually -case-sensitive, so use upper and lower case as required for them. - -By default, entries for a concept index are printed in a small roman -font and entries for the other indices are printed in a small -@code{@@code} font. You may change the way part of an entry is -printed with the usual Texinfo commands, such as @code{@@file} for -file names and @code{@@emph} for emphasis (@pxref{Marking -Text}).@refill -@cindex Index font types - -@cindex Predefined indexing commands -@cindex Indexing commands, predefined -The six indexing commands for predefined indices are: - -@table @code -@item @@cindex @var{concept} -@findex cindex -Make an entry in the concept index for @var{concept}.@refill - -@item @@findex @var{function} -@findex findex -Make an entry in the function index for @var{function}.@refill - -@item @@vindex @var{variable} -@findex vindex -Make an entry in the variable index for @var{variable}.@refill - -@item @@kindex @var{keystroke} -@findex kindex -Make an entry in the key index for @var{keystroke}.@refill - -@item @@pindex @var{program} -@findex pindex -Make an entry in the program index for @var{program}.@refill - -@item @@tindex @var{data type} -@findex tindex -Make an entry in the data type index for @var{data type}.@refill -@end table - -@quotation -@strong{Caution:} Do not use a colon in an index entry. In Info, a -colon separates the menu entry name from the node name. An extra -colon confuses Info. -@xref{Menu Parts, , The Parts of a Menu}, -for more information about the structure of a menu entry.@refill -@end quotation - -If you write several identical index entries in different places in a -Texinfo file, the index in the printed manual will list all the pages to -which those entries refer. However, the index in the Info file will -list @strong{only} the node that references the @strong{first} of those -index entries. Therefore, it is best to write indices in which each -entry refers to only one place in the Texinfo file. Fortunately, this -constraint is a feature rather than a loss since it means that the index -will be easy to use. Otherwise, you could create an index that lists -several pages for one entry and your reader would not know to which page -to turn. If you have two identical entries for one topic, change the -topics slightly, or qualify them to indicate the difference.@refill - -You are not actually required to use the predefined indices for their -canonical purposes. For example, suppose you wish to index some C -preprocessor macros. You could put them in the function index along -with actual functions, just by writing @code{@@findex} commands for -them; then, when you print the ``Function Index'' as an unnumbered -chapter, you could give it the title `Function and Macro Index' and -all will be consistent for the reader. Or you could put the macros in -with the data types by writing @code{@@tindex} commands for them, and -give that index a suitable title so the reader will understand. -(@xref{Printing Indices & Menus}.)@refill - -@node Combining Indices, New Indices, Indexing Commands, Indices -@comment node-name, next, previous, up -@section Combining Indices -@cindex Combining indices -@cindex Indices, combining them - -Sometimes you will want to combine two disparate indices such as functions -and concepts, perhaps because you have few enough of one of them that -a separate index for them would look silly.@refill - -You could put functions into the concept index by writing -@code{@@cindex} commands for them instead of @code{@@findex} commands, -and produce a consistent manual by printing the concept index with the -title `Function and Concept Index' and not printing the `Function -Index' at all; but this is not a robust procedure. It works only if -your document is never included as part of another -document that is designed to have a separate function index; if your -document were to be included with such a document, the functions from -your document and those from the other would not end up together. -Also, to make your function names appear in the right font in the -concept index, you would need to enclose every one of them between -the braces of @code{@@code}.@refill - -@menu -* syncodeindex:: How to merge two indices, using @code{@@code} - font for the merged-from index. -* synindex:: How to merge two indices, using the - default font of the merged-to index. -@end menu - -@node syncodeindex, synindex, Combining Indices, Combining Indices -@subsection @code{@@syncodeindex} -@findex syncodeindex - -When you want to combine functions and concepts into one index, you -should index the functions with @code{@@findex} and index the concepts -with @code{@@cindex}, and use the @code{@@syncodeindex} command to -redirect the function index entries into the concept index.@refill -@findex syncodeindex - -The @code{@@syncodeindex} command takes two arguments; they are the name -of the index to redirect, and the name of the index to redirect it to. -The template looks like this:@refill - -@example -@@syncodeindex @var{from} @var{to} -@end example - -@cindex Predefined names for indices -@cindex Two letter names for indices -@cindex Indices, two letter names -@cindex Names for indices -For this purpose, the indices are given two-letter names:@refill - -@table @samp -@item cp -concept index -@item fn -function index -@item vr -variable index -@item ky -key index -@item pg -program index -@item tp -data type index -@end table - -Write an @code{@@syncodeindex} command before or shortly after the -end-of-header line at the beginning of a Texinfo file. For example, -to merge a function index with a concept index, write the -following:@refill - -@example -@@syncodeindex fn cp -@end example - -@noindent -This will cause all entries designated for the function index to merge -in with the concept index instead.@refill - -To merge both a variables index and a function index into a concept -index, write the following:@refill - -@example -@group -@@syncodeindex vr cp -@@syncodeindex fn cp -@end group -@end example - -@cindex Fonts for indices -The @code{@@syncodeindex} command puts all the entries from the `from' -index (the redirected index) into the @code{@@code} font, overriding -whatever default font is used by the index to which the entries are -now directed. This way, if you direct function names from a function -index into a concept index, all the function names are printed in the -@code{@@code} font as you would expect.@refill - -@node synindex, , syncodeindex, Combining Indices -@subsection @code{@@synindex} -@findex synindex - -The @code{@@synindex} command is nearly the same as the -@code{@@syncodeindex} command, except that it does not put the -`from' index entries into the @code{@@code} font; rather it puts -them in the roman font. Thus, you use @code{@@synindex} when you -merge a concept index into a function index.@refill - -@xref{Printing Indices & Menus}, for information about printing an index -at the end of a book or creating an index menu in an Info file.@refill - -@node New Indices, , Combining Indices, Indices -@section Defining New Indices -@cindex Defining new indices -@cindex Indices, defining new -@cindex New index defining -@findex defindex -@findex defcodeindex - -In addition to the predefined indices, you may use the -@code{@@defindex} and @code{@@defcodeindex} commands to define new -indices. These commands create new indexing @@-commands with which -you mark index entries. The @code{@@defindex }command is used like -this:@refill - -@example -@@defindex @var{name} -@end example - -The name of an index should be a two letter word, such as @samp{au}. -For example:@refill - -@example -@@defindex au -@end example - -This defines a new index, called the @samp{au} index. At the same -time, it creates a new indexing command, @code{@@auindex}, that you -can use to make index entries. Use the new indexing command just as -you would use a predefined indexing command.@refill - -For example, here is a section heading followed by a concept index -entry and two @samp{au} index entries.@refill - -@example -@@section Cognitive Semantics -@@cindex kinesthetic image schemas -@@auindex Johnson, Mark -@@auindex Lakoff, George -@end example - -@noindent -(Evidently, @samp{au} serves here as an abbreviation for ``author''.) -Texinfo constructs the new indexing command by concatenating the name -of the index with @samp{index}; thus, defining an @samp{au} index -leads to the automatic creation of an @code{@@auindex} command.@refill - -Use the @code{@@printindex} command to print the index, as you do with -the predefined indices. For example:@refill - -@example -@group -@@node Author Index, Subject Index, , Top -@@unnumbered Author Index - -@@printindex au -@end group -@end example - -The @code{@@defcodeindex} is like the @code{@@defindex} command, except -that, in the printed output, it prints entries in an @code{@@code} font -instead of a roman font. Thus, it parallels the @code{@@findex} command -rather than the @code{@@cindex} command.@refill - -You should define new indices within or right after the end-of-header -line of a Texinfo file, before any @code{@@synindex} or -@code{@@syncodeindex} commands (@pxref{Header}).@refill - -@node Insertions, Breaks, Indices, Top -@comment node-name, next, previous, up -@chapter Special Insertions -@cindex Inserting special characters and symbols -@cindex Special insertions - -Texinfo provides several commands for inserting characters that have -special meaning in Texinfo, such as braces, and for other graphic -elements that do not correspond to simple characters you can type. - -@iftex -These are: - -@itemize @bullet -@item Braces, @samp{@@} and periods. -@item Whitespace within and around a sentence. -@item Accents. -@item Dots and bullets. -@item The @TeX{} logo and the copyright symbol. -@item Mathematical expressions. -@end itemize -@end iftex - -@menu -* Braces Atsigns:: How to insert braces, @samp{@@}. -* Inserting Space:: How to insert the right amount of space - within a sentence. -* Inserting Accents:: How to insert accents and special characters. -* Dots Bullets:: How to insert dots and bullets. -* TeX and copyright:: How to insert the @TeX{} logo - and the copyright symbol. -* pounds:: How to insert the pounds currency symbol. -* minus:: How to insert a minus sign. -* math:: How to format a mathematical expression. -* Glyphs:: How to indicate results of evaluation, - expansion of macros, errors, etc. -* Images:: How to include graphics. -@end menu - - -@node Braces Atsigns, Inserting Space, Insertions, Insertions -@section Inserting @@ and Braces -@cindex Inserting @@, braces -@cindex Braces, inserting -@cindex Special characters, commands to insert -@cindex Commands to insert special characters - -@samp{@@} and curly braces are special characters in Texinfo. To insert -these characters so they appear in text, you must put an @samp{@@} in -front of these characters to prevent Texinfo from misinterpreting -them. - -Do not put braces after any of these commands; they are not -necessary. - -@menu -* Inserting An Atsign:: How to insert @samp{@@}. -* Inserting Braces:: How to insert @samp{@{} and @samp{@}}. -@end menu - -@node Inserting An Atsign, Inserting Braces, Braces Atsigns, Braces Atsigns -@subsection Inserting @samp{@@} with @@@@ -@findex @@ @r{(single @samp{@@})} - -@code{@@@@} stands for a single @samp{@@} in either printed or Info -output. - -Do not put braces after an @code{@@@@} command. - -@node Inserting Braces, , Inserting An Atsign, Braces Atsigns -@subsection Inserting @samp{@{} and @samp{@}}with @@@{ and @@@} -@findex @{ @r{(single @samp{@{})} -@findex @} @r{(single @samp{@}})} - -@code{@@@{} stands for a single @samp{@{} in either printed or Info -output. - -@code{@@@}} stands for a single @samp{@}} in either printed or Info -output. - -Do not put braces after either an @code{@@@{} or an @code{@@@}} -command. - - -@node Inserting Space, Inserting Accents, Braces Atsigns, Insertions -@section Inserting Space - -@cindex Inserting space -@cindex Spacing, inserting -@cindex Whitespace, inserting -The following sections describe commands that control spacing of various -kinds within and after sentences. - -@menu -* Not Ending a Sentence:: Sometimes a . doesn't end a sentence. -* Ending a Sentence:: Sometimes it does. -* Multiple Spaces:: Inserting multiple spaces. -* dmn:: How to format a dimension. -@end menu - -@node Not Ending a Sentence, Ending a Sentence, Inserting Space, Inserting Space -@subsection Not Ending a Sentence - -@cindex Not ending a sentence -@cindex Sentence non-ending punctuation -@cindex Periods, inserting -Depending on whether a period or exclamation point or question mark is -inside or at the end of a sentence, less or more space is inserted after -a period in a typeset manual. Since it is not always possible for -Texinfo to determine when a period ends a sentence and when it is used -in an abbreviation, special commands are needed in some circumstances. -(Usually, Texinfo can guess how to handle periods, so you do not need to -use the special commands; you just enter a period as you would if you -were using a typewriter, which means you put two spaces after the -period, question mark, or exclamation mark that ends a sentence.) - -@findex : @r{(suppress widening)} -Use the @code{@@:}@: command after a period, question mark, -exclamation mark, or colon that should not be followed by extra space. -For example, use @code{@@:}@: after periods that end abbreviations -which are not at the ends of sentences. - -@need 700 -For example, - -@example -The s.o.p.@@: has three parts @dots{} -The s.o.p. has three parts @dots{} -@end example - -@noindent -@ifinfo -produces -@end ifinfo -@iftex -produces the following. If you look carefully at this printed output, -you will see a little more whitespace after @samp{s.o.p.} in the second -line.@refill -@end iftex - -@quotation -The s.o.p.@: has three parts @dots{}@* -The s.o.p. has three parts @dots{} -@end quotation - -@noindent -(Incidentally, @samp{s.o.p.} is an abbreviation for ``Standard Operating -Procedure''.) - -@code{@@:} has no effect on the Info output. Do not put braces after -@code{@@:}. - - -@node Ending a Sentence, Multiple Spaces, Not Ending a Sentence, Inserting Space -@subsection Ending a Sentence - -@cindex Ending a Sentence -@cindex Sentence ending punctuation - -@findex . @r{(end of sentence)} -@findex ! @r{(end of sentence)} -@findex ? @r{(end of sentence)} -Use @code{@@.}@: instead of a period, @code{@@!}@: instead of an -exclamation point, and @code{@@?}@: instead of a question mark at the end -of a sentence that ends with a single capital letter. Otherwise, @TeX{} -will think the letter is an abbreviation and will not insert the correct -end-of-sentence spacing. Here is an example: - -@example -Give it to M.I.B. and to M.E.W@@. Also, give it to R.J.C@@. -Give it to M.I.B. and to M.E.W. Also, give it to R.J.C. -@end example - -@noindent -@ifinfo -produces -@end ifinfo -@iftex -produces the following. If you look carefully at this printed output, -you will see a little more whitespace after the @samp{W} in the first -line. -@end iftex - -@quotation -Give it to M.I.B. and to M.E.W@. Also, give it to R.J.C@.@* -Give it to M.I.B. and to M.E.W. Also, give it to R.J.C. -@end quotation - -In the Info file output, @code{@@.}@: is equivalent to a simple -@samp{.}; likewise for @code{@@!}@: and @code{@@?}@:. - -The meanings of @code{@@:} and @code{@@.}@: in Texinfo are designed to -work well with the Emacs sentence motion commands (@pxref{Sentences,,, -xemacs, XEmacs User's Manual}). This made it necessary for them to be -incompatible with some other formatting systems that use @@-commands. - -Do not put braces after any of these commands. - - -@node Multiple Spaces, dmn, Ending a Sentence, Inserting Space -@subsection Multiple Spaces - -@cindex Multiple spaces -@cindex Whitespace, inserting -@findex (space) -@findex (tab) -@findex (newline) - -Ordinarily, @TeX{} collapses multiple whitespace characters (space, tab, -and newline) into a single space. Info output, on the other hand, -preserves whitespace as you type it, except for changing a newline into -a space; this is why it is important to put two spaces at the end of -sentences in Texinfo documents. - -Occasionally, you may want to actually insert several consecutive -spaces, either for purposes of example (what your program does with -multiple spaces as input), or merely for purposes of appearance in -headings or lists. Texinfo supports three commands: -@code{@@@kbd{SPACE}}, @code{@@@kbd{TAB}}, and @code{@@@kbd{NL}}, all of -which insert a single space into the output. (Here, -@code{@@@kbd{SPACE}} represents an @samp{@@} character followed by a -space, i.e., @samp{@@ }, and @kbd{TAB} and @kbd{NL} represent the tab -character and end-of-line, i.e., when @samp{@@} is the last character on -a line.) - -For example, -@example -Spacey@@ @@ @@ @@ -example. -@end example - -@noindent -produces - -@example -Spacey@ @ @ @ -example. -@end example - -Other possible uses of @code{@@@kbd{SPACE}} have been subsumed by -@code{@@multitable} (@pxref{Multi-column Tables}). - -Do not follow any of these commands with braces. - - -@node dmn, , Multiple Spaces, Inserting Space -@subsection @code{@@dmn}@{@var{dimension}@}: Format a Dimension -@cindex Thin space between number, dimension -@cindex Dimension formatting -@cindex Format a dimension -@findex dmn - -At times, you may want to write @samp{12@dmn{pt}} or -@samp{8.5@dmn{in}} with little or no space between the number and the -abbreviation for the dimension. You can use the @code{@@dmn} command -to do this. On seeing the command, @TeX{} inserts just enough space -for proper typesetting; the Info formatting commands insert no space -at all, since the Info file does not require it.@refill - -To use the @code{@@dmn} command, write the number and then follow it -immediately, with no intervening space, by @code{@@dmn}, and then by -the dimension within braces. For example, - -@example -A4 paper is 8.27@@dmn@{in@} wide. -@end example - -@noindent -produces - -@quotation -A4 paper is 8.27@dmn{in} wide. -@end quotation - -Not everyone uses this style. Some people prefer @w{@samp{8.27 in.@@:}} -or @w{@samp{8.27 inches}} to @samp{8.27@@dmn@{in@}} in the Texinfo file. -In these cases, however, the formatters may insert a line break between -the number and the dimension, so use @code{@@w} (@pxref{w}). Also, if -you write a period after an abbreviation within a sentence, you should -write @samp{@@:} after the period to prevent @TeX{} from inserting extra -whitespace, as shown here. @xref{Inserting Space}. - - -@node Inserting Accents, Dots Bullets, Inserting Space, Insertions -@section Inserting Accents - -@cindex Inserting accents -@cindex Accents, inserting -@cindex Floating accents, inserting - -Here is a table with the commands Texinfo provides for inserting -floating accents. The commands with non-alphabetic names do not take -braces around their argument (which is taken to be the next character). -(Exception: @code{@@,} @emph{does} take braces around its argument.) -This is so as to make the source as convenient to type and read as -possible, since accented characters are very common in some languages. - -@findex " -@cindex Umlaut accent -@findex ' -@cindex Acute accent -@findex = -@cindex Macron accent -@findex ^ -@cindex Circumflex accent -@findex ` -@cindex Grave accent -@findex ~ -@cindex Tilde accent -@findex , -@cindex Cedilla accent -@findex dotaccent -@cindex Dot accent -@findex H -@cindex Hungariam umlaut accent -@findex ringaccent -@cindex Ring accent -@findex tieaccent -@cindex Tie-after accent -@findex u -@cindex Breve accent -@findex ubaraccent -@cindex Underbar accent -@findex udotaccent -@cindex Underdot accent -@findex v -@cindex Check accent -@multitable {@@questiondown@{@}} {Output} {macron/overbar accent} -@item Command @tab Output @tab What -@item @t{@@"o} @tab @"o @tab umlaut accent -@item @t{@@'o} @tab @'o @tab acute accent -@item @t{@@,@{c@}} @tab @,{c} @tab cedilla accent -@item @t{@@=o} @tab @=o @tab macron/overbar accent -@item @t{@@^o} @tab @^o @tab circumflex accent -@item @t{@@`o} @tab @`o @tab grave accent -@item @t{@@~o} @tab @~o @tab tilde accent -@item @t{@@dotaccent@{o@}} @tab @dotaccent{o} @tab overdot accent -@item @t{@@H@{o@}} @tab @H{o} @tab long Hungarian umlaut -@item @t{@@ringaccent@{o@}} @tab @ringaccent{o} @tab ring accent -@item @t{@@tieaccent@{oo@}} @tab @tieaccent{oo} @tab tie-after accent -@item @t{@@u@{o@}} @tab @u{o} @tab breve accent -@item @t{@@ubaraccent@{o@}} @tab @ubaraccent{o} @tab underbar accent -@item @t{@@udotaccent@{o@}} @tab @udotaccent{o} @tab underdot accent -@item @t{@@v@{o@}} @tab @v{o} @tab hacek or check accent -@end multitable - -This table lists the Texinfo commands for inserting other characters -commonly used in languages other than English. - -@findex questiondown -@cindex @questiondown{} -@findex exclamdown -@cindex @exclamdown{} -@findex aa -@cindex @aa{} -@findex AA -@cindex @AA{} -@findex ae -@cindex @ae{} -@findex AE -@cindex @AE{} -@findex dotless -@cindex @dotless{i} -@cindex @dotless{j} -@cindex Dotless i, j -@findex l -@cindex @l{} -@findex L -@cindex @L{} -@findex o -@cindex @o{} -@findex O -@cindex @O{} -@findex oe -@cindex @oe{} -@findex OE -@cindex @OE{} -@findex ss -@cindex @ss{} -@cindex Es-zet -@cindex Sharp S -@cindex German S -@multitable {@@questiondown@{@}} {oe,OE} {es-zet or sharp S} -@item @t{@@exclamdown@{@}} @tab @exclamdown{} @tab upside-down ! -@item @t{@@questiondown@{@}} @tab @questiondown{} @tab upside-down ? -@item @t{@@aa@{@},@@AA@{@}} @tab @aa{},@AA{} @tab A,a with circle -@item @t{@@ae@{@},@@AE@{@}} @tab @ae{},@AE{} @tab ae,AE ligatures -@item @t{@@dotless@{i@}} @tab @dotless{i} @tab dotless i -@item @t{@@dotless@{j@}} @tab @dotless{j} @tab dotless j -@item @t{@@l@{@},@@L@{@}} @tab @l{},@L{} @tab suppressed-L,l -@item @t{@@o@{@},@@O@{@}} @tab @o{},@O{} @tab O,o with slash -@item @t{@@oe@{@},@@OE@{@}} @tab @oe{},@OE{} @tab OE,oe ligatures -@item @t{@@ss@{@}} @tab @ss{} @tab es-zet or sharp S -@end multitable - - -@node Dots Bullets, TeX and copyright, Inserting Accents, Insertions -@section Inserting Ellipsis, Dots, and Bullets -@cindex Dots, inserting -@cindex Bullets, inserting -@cindex Ellipsis, inserting -@cindex Inserting ellipsis -@cindex Inserting dots -@cindex Special typesetting commands -@cindex Typesetting commands for dots, etc. - -An @dfn{ellipsis} (a line of dots) is not typeset as a string of -periods, so a special command is used for ellipsis in Texinfo. The -@code{@@bullet} command is special, too. Each of these commands is -followed by a pair of braces, @samp{@{@}}, without any whitespace -between the name of the command and the braces. (You need to use braces -with these commands because you can use them next to other text; without -the braces, the formatters would be confused. @xref{Command Syntax, , -@@-Command Syntax}, for further information.)@refill - -@menu -* dots:: How to insert dots @dots{} -* bullet:: How to insert a bullet. -@end menu - - -@node dots, bullet, Dots Bullets, Dots Bullets -@subsection @code{@@dots}@{@} (@dots{}) -@findex dots -@cindex Inserting dots -@cindex Dots, inserting - -Use the @code{@@dots@{@}} command to generate an ellipsis, which is -three dots in a row, appropriately spaced, like this: `@dots{}'. Do -not simply write three periods in the input file; that would work for -the Info file output, but would produce the wrong amount of space -between the periods in the printed manual. - -Similarly, the @code{@@enddots@{@}} command generates an -end-of-sentence ellipsis (four dots) @enddots{} - -@iftex -Here is an ellipsis: @dots{} -Here are three periods in a row: ... - -In printed output, the three periods in a row are closer together than -the dots in the ellipsis. -@end iftex - - -@node bullet, , dots, Dots Bullets -@subsection @code{@@bullet}@{@} (@bullet{}) -@findex bullet - -Use the @code{@@bullet@{@}} command to generate a large round dot, or -the closest possible thing to one. In Info, an asterisk is used.@refill - -Here is a bullet: @bullet{} - -When you use @code{@@bullet} in @code{@@itemize}, you do not need to -type the braces, because @code{@@itemize} supplies them. -(@xref{itemize, , @code{@@itemize}}.)@refill - - -@node TeX and copyright, pounds, Dots Bullets, Insertions -@section Inserting @TeX{} and the Copyright Symbol - -The logo `@TeX{}' is typeset in a special fashion and it needs an -@@-command. The copyright symbol, `@copyright{}', is also special. -Each of these commands is followed by a pair of braces, @samp{@{@}}, -without any whitespace between the name of the command and the -braces.@refill - -@menu -* tex:: How to insert the @TeX{} logo. -* copyright symbol:: How to use @code{@@copyright}@{@}. -@end menu - - -@node tex, copyright symbol, TeX and copyright, TeX and copyright -@subsection @code{@@TeX}@{@} (@TeX{}) -@findex tex (command) - -Use the @code{@@TeX@{@}} command to generate `@TeX{}'. In a printed -manual, this is a special logo that is different from three ordinary -letters. In Info, it just looks like @samp{TeX}. The -@code{@@TeX@{@}} command is unique among Texinfo commands in that the -@kbd{T} and the @kbd{X} are in upper case.@refill - - -@node copyright symbol, , tex, TeX and copyright -@subsection @code{@@copyright}@{@} (@copyright{}) -@findex copyright - -Use the @code{@@copyright@{@}} command to generate `@copyright{}'. In -a printed manual, this is a @samp{c} inside a circle, and in Info, -this is @samp{(C)}.@refill - - -@node pounds, minus, TeX and copyright, Insertions -@section @code{@@pounds@{@}} (@pounds{}): Pounds Sterling -@findex pounds - -Use the @code{@@pounds@{@}} command to generate `@pounds{}'. In a -printed manual, this is the symbol for the currency pounds sterling. -In Info, it is a @samp{#}. Other currency symbols are unfortunately not -available. - - -@node minus, math, pounds, Insertions -@section @code{@@minus}@{@} (@minus{}): Inserting a Minus Sign -@findex minus - -Use the @code{@@minus@{@}} command to generate a minus sign. In a -fixed-width font, this is a single hyphen, but in a proportional font, -the symbol is the customary length for a minus sign---a little longer -than a hyphen, shorter than an em-dash: - -@display -@samp{@minus{}} is a minus sign generated with @samp{@@minus@{@}}, - -`-' is a hyphen generated with the character @samp{-}, - -`---' is an em-dash for text. -@end display - -@noindent -In the fixed-width font used by Info, @code{@@minus@{@}} is the same -as a hyphen. - -You should not use @code{@@minus@{@}} inside @code{@@code} or -@code{@@example} because the width distinction is not made in the -fixed-width font they use. - -When you use @code{@@minus} to specify the mark beginning each entry in -an itemized list, you do not need to type the braces -(@pxref{itemize, , @code{@@itemize}}.) - - -@node math, Glyphs, minus, Insertions -@section @code{@@math} - Inserting Mathematical Expressions -@findex math -@cindex Mathematical expressions - -You can write a short mathematical expression with the @code{@@math} -command. Write the mathematical expression between braces, like this: - -@example -@@math@{(a + b)(a + b) = a^2 + 2ab + b^2@} -@end example - -@iftex -@need 1000 -@noindent -This produces the following in @TeX{}: - -@display -@math{(a + b)(a + b) = a^2 + 2ab + b^2} -@end display - -@noindent -and the following in Info: -@end iftex -@ifinfo -@noindent -This produces the following in Info: -@end ifinfo - -@example -(a + b)(a + b) = a^2 + 2ab + b^2 -@end example - -Thus, the @code{@@math} command has no effect on the Info output. - -For complex mathematical expressions, you can also use @TeX{} directly -(@pxref{Raw Formatter Commands}). When you use @TeX{} directly, -remember to write the mathematical expression between one or two -@samp{$} (dollar-signs) as appropriate. - - -@node Glyphs, Images, math, Insertions -@section Glyphs for Examples -@cindex Glyphs - -In Texinfo, code is often illustrated in examples that are delimited -by @code{@@example} and @code{@@end example}, or by @code{@@lisp} and -@code{@@end lisp}. In such examples, you can indicate the results of -evaluation or an expansion using @samp{@result{}} or -@samp{@expansion{}}. Likewise, there are commands to insert glyphs -to indicate -printed output, error messages, equivalence of expressions, and the -location of point.@refill - -The glyph-insertion commands do not need to be used within an example, but -most often they are. Every glyph-insertion command is followed by a pair of -left- and right-hand braces.@refill - -@menu -* Glyphs Summary:: -* result:: How to show the result of expression. -* expansion:: How to indicate an expansion. -* Print Glyph:: How to indicate printed output. -* Error Glyph:: How to indicate an error message. -* Equivalence:: How to indicate equivalence. -* Point Glyph:: How to indicate the location of point. -@end menu - -@node Glyphs Summary, result, Glyphs, Glyphs -@ifinfo -@subheading Glyphs Summary - -Here are the different glyph commands:@refill -@end ifinfo - -@table @asis -@item @result{} -@code{@@result@{@}} points to the result of an expression.@refill - -@item @expansion{} -@code{@@expansion@{@}} shows the results of a macro expansion.@refill - -@item @print{} -@code{@@print@{@}} indicates printed output.@refill - -@item @error{} -@code{@@error@{@}} indicates that the following text is an error -message.@refill - -@item @equiv{} -@code{@@equiv@{@}} indicates the exact equivalence of two forms.@refill - -@item @point{} -@code{@@point@{@}} shows the location of point.@refill -@end table - - -@menu -* result:: -* expansion:: -* Print Glyph:: -* Error Glyph:: -* Equivalence:: -* Point Glyph:: -@end menu - -@node result, expansion, Glyphs Summary, Glyphs -@subsection @code{@@result@{@}} (@result{}): Indicating Evaluation -@cindex Result of an expression -@cindex Indicating evaluation -@cindex Evaluation glyph -@cindex Value of an expression, indicating - -Use the @code{@@result@{@}} command to indicate the result of -evaluating an expression.@refill - -@iftex -The @code{@@result@{@}} command is displayed as @samp{=>} in Info and -as @samp{@result{}} in the printed output. -@end iftex -@ifinfo -The @code{@@result@{@}} command is displayed as @samp{@result{}} in Info -and as a double stemmed arrow in the printed output.@refill -@end ifinfo - -Thus, the following, - -@lisp -(cdr '(1 2 3)) - @result{} (2 3) -@end lisp - -@noindent -may be read as ``@code{(cdr '(1 2 3))} evaluates to @code{(2 3)}''. - - -@node expansion, Print Glyph, result, Glyphs -@subsection @code{@@expansion@{@}} (@expansion{}): Indicating an Expansion -@cindex Expansion, indicating it - -When an expression is a macro call, it expands into a new expression. -You can indicate the result of the expansion with the -@code{@@expansion@{@}} command.@refill - -@iftex -The @code{@@expansion@{@}} command is displayed as @samp{==>} in Info and -as @samp{@expansion{}} in the printed output. -@end iftex -@ifinfo -The @code{@@expansion@{@}} command is displayed as @samp{@expansion{}} -in Info and as a long arrow with a flat base in the printed output.@refill -@end ifinfo - -@need 700 -For example, the following - -@example -@group -@@lisp -(third '(a b c)) - @@expansion@{@} (car (cdr (cdr '(a b c)))) - @@result@{@} c -@@end lisp -@end group -@end example - -@noindent -produces - -@lisp -@group -(third '(a b c)) - @expansion{} (car (cdr (cdr '(a b c)))) - @result{} c -@end group -@end lisp - -@noindent -which may be read as: - -@quotation -@code{(third '(a b c))} expands to @code{(car (cdr (cdr '(a b c))))}; -the result of evaluating the expression is @code{c}. -@end quotation - -@noindent -Often, as in this case, an example looks better if the -@code{@@expansion@{@}} and @code{@@result@{@}} commands are indented -five spaces.@refill - - -@node Print Glyph, Error Glyph, expansion, Glyphs -@subsection @code{@@print@{@}} (@print{}): Indicating Printed Output -@cindex Printed output, indicating it - -Sometimes an expression will print output during its execution. You -can indicate the printed output with the @code{@@print@{@}} command.@refill - -@iftex -The @code{@@print@{@}} command is displayed as @samp{-|} in Info and -as @samp{@print{}} in the printed output. -@end iftex -@ifinfo -The @code{@@print@{@}} command is displayed as @samp{@print{}} in Info -and similarly, as a horizontal dash butting against a vertical bar, in -the printed output.@refill -@end ifinfo - -In the following example, the printed text is indicated with -@samp{@print{}}, and the value of the expression follows on the -last line.@refill - -@lisp -@group -(progn (print 'foo) (print 'bar)) - @print{} foo - @print{} bar - @result{} bar -@end group -@end lisp - -@noindent -In a Texinfo source file, this example is written as follows: - -@lisp -@group -@@lisp -(progn (print 'foo) (print 'bar)) - @@print@{@} foo - @@print@{@} bar - @@result@{@} bar -@@end lisp -@end group -@end lisp - - -@node Error Glyph, Equivalence, Print Glyph, Glyphs -@subsection @code{@@error@{@}} (@error{}): Indicating an Error Message -@cindex Error message, indicating it - -A piece of code may cause an error when you evaluate it. You can -designate the error message with the @code{@@error@{@}} command.@refill - -@iftex -The @code{@@error@{@}} command is displayed as @samp{error-->} in Info -and as @samp{@error{}} in the printed output. -@end iftex -@ifinfo -The @code{@@error@{@}} command is displayed as @samp{@error{}} in Info -and as the word `error' in a box in the printed output.@refill -@end ifinfo - -@need 700 -Thus, - -@example -@@lisp -(+ 23 'x) -@@error@{@} Wrong type argument: integer-or-marker-p, x -@@end lisp -@end example - -@noindent -produces - -@lisp -(+ 23 'x) -@error{} Wrong type argument: integer-or-marker-p, x -@end lisp - -@noindent -This indicates that the following error message is printed -when you evaluate the expression: - -@lisp -Wrong type argument: integer-or-marker-p, x -@end lisp - -@samp{@error{}} itself is not part of the error message. - - -@node Equivalence, Point Glyph, Error Glyph, Glyphs -@subsection @code{@@equiv@{@}} (@equiv{}): Indicating Equivalence -@cindex Equivalence, indicating it - -Sometimes two expressions produce identical results. You can indicate the -exact equivalence of two forms with the @code{@@equiv@{@}} command.@refill - -@iftex -The @code{@@equiv@{@}} command is displayed as @samp{==} in Info and -as @samp{@equiv{}} in the printed output. -@end iftex -@ifinfo -The @code{@@equiv@{@}} command is displayed as @samp{@equiv{}} in Info -and as a three parallel horizontal lines in the printed output.@refill -@end ifinfo - -Thus, - -@example -@@lisp -(make-sparse-keymap) @@equiv@{@} (list 'keymap) -@@end lisp -@end example - -@noindent -produces - -@lisp -(make-sparse-keymap) @equiv{} (list 'keymap) -@end lisp - -@noindent -This indicates that evaluating @code{(make-sparse-keymap)} produces -identical results to evaluating @code{(list 'keymap)}. - - -@node Point Glyph, , Equivalence, Glyphs -@subsection @code{@@point@{@}} (@point{}): Indicating Point in a Buffer -@cindex Point, indicating it in a buffer - -Sometimes you need to show an example of text in an Emacs buffer. In -such examples, the convention is to include the entire contents of the -buffer in question between two lines of dashes containing the buffer -name.@refill - -You can use the @samp{@@point@{@}} command to show the location of point -in the text in the buffer. (The symbol for point, of course, is not -part of the text in the buffer; it indicates the place @emph{between} -two characters where point is located.)@refill - -@iftex -The @code{@@point@{@}} command is displayed as @samp{-!-} in Info and -as @samp{@point{}} in the printed output. -@end iftex -@ifinfo -The @code{@@point@{@}} command is displayed as @samp{@point{}} in Info -and as a small five pointed star in the printed output.@refill -@end ifinfo - -The following example shows the contents of buffer @file{foo} before -and after evaluating a Lisp command to insert the word @code{changed}.@refill - -@example -@group ----------- Buffer: foo ---------- -This is the @point{}contents of foo. ----------- Buffer: foo ---------- - -@end group -@end example - -@example -@group -(insert "changed ") - @result{} nil ----------- Buffer: foo ---------- -This is the changed @point{}contents of foo. ----------- Buffer: foo ---------- - -@end group -@end example - -In a Texinfo source file, the example is written like this:@refill - -@example -@@example ----------- Buffer: foo ---------- -This is the @@point@{@}contents of foo. ----------- Buffer: foo ---------- - -(insert "changed ") - @@result@{@} nil ----------- Buffer: foo ---------- -This is the changed @@point@{@}contents of foo. ----------- Buffer: foo ---------- -@@end example -@end example - - -@c this should be described with figures when we have them -@c perhaps in the quotation/example chapter. -@node Images, , Glyphs, Insertions -@section Inserting Images - -@cindex Images, inserting -@cindex Pictures, inserting -@findex image - -You can insert an image in an external file with the @code{@@image} -command: - -@example -@@image@{@var{filename}, @r{[}@var{width}@r{]}, @r{[}@var{height}@r{]}@} -@end example - -@cindex Formats for images -@cindex Image formats -The @var{filename} argument is mandatory, and must not have an -extension, because the different processors support different formats: -@TeX{} reads the file @file{@var{filename}.eps} (Encapsulated PostScript -format); @code{makeinfo} uses @file{@var{filename}.txt} verbatim for -Info output (more or less as if it was an @code{@@example}). HTML -output requires @file{@var{filename}.jpg}. - -@cindex Width of images -@cindex Height of images -@cindex Aspect ratio of images -@cindex Distorting images -The optional @var{width} and @var{height} arguments specify the size to -scale the image to (they are ignored for Info output). If they are both -specified, the image is presented in its natural size (given in the -file); if only one is specified, the other is scaled proportionately; -and if both are specified, both are respected, thus possibly distorting -the original image by changing its aspect ratio. - -@cindex Dimensions and image sizes -The @var{width} and @var{height} may be specified using any valid @TeX{} -dimension, namely: - -@table @asis -@item pt -@cindex Points (dimension) -point (72.27pt = 1in) -@item pc -@cindex Picas -pica (1pc = 12pt) -@item bp -@cindex Big points -big point (72bp = 1in) -@item in -@cindex Inches -inch -@item cm -@cindex Centimeters -centimeter (2.54cm = 1in) -@item mm -@cindex Millimeters -millimeter (10mm = 1cm) -@item dd -@cindex Did@^ot points -did@^ot point (1157dd = 1238pt) -@item cc -@cindex Ciceros -cicero (1cc = 12dd) -@item sp -@cindex Scaled points -scaled point (65536sp = 1pt) -@end table - -@pindex ridt.eps -For example, the following will scale a file @file{ridt.eps} to one -inch vertically, with the width scaled proportionately: - -@example -@@image@{ridt,,1in@} -@end example - -@pindex epsf.tex -For @code{@@image} to work with @TeX{}, the file @file{epsf.tex} must be -installed somewhere that @TeX{} can find it. This file is included in -the Texinfo distribution and is available from -@uref{ftp://ftp.tug.org/tex/epsf.tex}. - - -@node Breaks, Definition Commands, Insertions, Top -@chapter Making and Preventing Breaks -@cindex Making line and page breaks -@cindex Preventing line and page breaks - -Usually, a Texinfo file is processed both by @TeX{} and by one of the -Info formatting commands. Line, paragraph, or page breaks sometimes -occur in the `wrong' place in one or other form of output. You must -ensure that text looks right both in the printed manual and in the -Info file.@refill - -For example, in a printed manual, page breaks may occur awkwardly in -the middle of an example; to prevent this, you can hold text together -using a grouping command that keeps the text from being split across -two pages. Conversely, you may want to force a page break where none -would occur normally. Fortunately, problems like these do not often -arise. When they do, use the break, break prevention, or pagination -commands.@refill - -@menu -* Break Commands:: Cause and prevent splits. -* Line Breaks:: How to force a single line to use two lines. -* - and hyphenation:: How to tell TeX about hyphenation points. -* w:: How to prevent unwanted line breaks. -* sp:: How to insert blank lines. -* page:: How to force the start of a new page. -* group:: How to prevent unwanted page breaks. -* need:: Another way to prevent unwanted page breaks. -@end menu - -@ifinfo -@node Break Commands, Line Breaks, Breaks, Breaks -@heading The Break Commands -@end ifinfo -@iftex -@sp 1 -@end iftex - -The break commands create or allow line and paragraph breaks:@refill - -@table @code -@item @@* -Force a line break. - -@item @@sp @var{n} -Skip @var{n} blank lines.@refill - -@item @@- -Insert a discretionary hyphen. - -@item @@hyphenation@{@var{hy-phen-a-ted words}@} -Define hyphen points in @var{hy-phen-a-ted words}. -@end table - -The line-break-prevention command holds text together all on one -line:@refill - -@table @code -@item @@w@{@var{text}@} -Prevent @var{text} from being split and hyphenated across two lines.@refill -@end table -@iftex -@sp 1 -@end iftex - -The pagination commands apply only to printed output, since Info -files do not have pages.@refill - -@table @code -@item @@page -Start a new page in the printed manual.@refill - -@item @@group -Hold text together that must appear on one printed page.@refill - -@item @@need @var{mils} -Start a new printed page if not enough space on this one.@refill -@end table - -@node Line Breaks, - and hyphenation, Break Commands, Breaks -@comment node-name, next, previous, up -@section @code{@@*}: Generate Line Breaks -@findex * @r{(force line break)} -@cindex Line breaks -@cindex Breaks in a line - -The @code{@@*} command forces a line break in both the printed manual and -in Info.@refill - -@need 700 -For example, - -@example -This line @@* is broken @@*in two places. -@end example - -@noindent -produces - -@example -@group -This line - is broken -in two places. -@end group -@end example - -@noindent -(Note that the space after the first @code{@@*} command is faithfully -carried down to the next line.)@refill - -@need 800 -The @code{@@*} command is often used in a file's copyright page:@refill - -@example -@group -This is edition 2.0 of the Texinfo documentation,@@* -and is for @dots{} -@end group -@end example - -@noindent -In this case, the @code{@@*} command keeps @TeX{} from stretching the -line across the whole page in an ugly manner.@refill - -@quotation -@strong{Please note:} Do not write braces after an @code{@@*} command; -they are not needed.@refill - -Do not write an @code{@@refill} command at the end of a paragraph -containing an @code{@@*} command; it will cause the paragraph to be -refilled after the line break occurs, negating the effect of the line -break.@refill -@end quotation - -@node - and hyphenation, w, Line Breaks, Breaks -@section @code{@@-} and @code{@@hyphenation}: Helping @TeX{} hyphenate - -@findex - -@findex hyphenation -@cindex Hyphenation, helping @TeX{} do -@cindex Fine-tuning, and hyphenation - -Although @TeX{}'s hyphenation algorithm is generally pretty good, it -does miss useful hyphenation points from time to time. (Or, far more -rarely, insert an incorrect hyphenation.) So, for documents with an -unusual vocabulary or when fine-tuning for a printed edition, you may -wish to help @TeX{} out. Texinfo supports two commands for this: - -@table @code -@item @@- -Insert a discretionary hyphen, i.e., a place where @TeX{} can (but does -not have to) hyphenate. This is especially useful when you notice -an overfull hbox is due to @TeX{} missing a hyphenation (@pxref{Overfull -hboxes}). @TeX{} will not insert any hyphenation points in a word -containing @code{@@-}. - -@item @@hyphenation@{@var{hy-phen-a-ted words}@} -Tell @TeX{} how to hyphenate @var{hy-phen-a-ted words}. As shown, you -put a @samp{-} at each hyphenation point. For example: -@example -@@hyphenation@{man-u-script man-u-scripts@} -@end example -@noindent -@TeX{} only uses the specified hyphenation points when the -words match exactly, so give all necessary variants. -@end table - -Info output is not hyphenated, so these commands have no effect there. - -@node w, sp, - and hyphenation, Breaks -@comment node-name, next, previous, up -@section @code{@@w}@{@var{text}@}: Prevent Line Breaks -@findex w @r{(prevent line break)} -@cindex Line breaks, preventing -@cindex Hyphenation, preventing - -@code{@@w@{@var{text}@}} outputs @var{text} and prohibits line breaks -within @var{text}.@refill - -You can use the @code{@@w} command to prevent @TeX{} from automatically -hyphenating a long name or phrase that happens to fall near the end of a -line.@refill - -@example -You can copy GNU software from @@w@{@@samp@{ftp.gnu.ai.mit.edu@}@}. -@end example - -@noindent -produces - -@quotation -You can copy GNU software from @w{@samp{ftp.gnu.ai.mit.edu}}. -@end quotation - -@quotation -@strong{Caution:} Do not write an @code{@@refill} command at the end -of a paragraph containing an @code{@@w} command; it will cause the -paragraph to be refilled and may thereby negate the effect of the -@code{@@w} command.@refill -@end quotation - -@node sp, page, w, Breaks -@comment node-name, next, previous, up -@section @code{@@sp} @var{n}: Insert Blank Lines -@findex sp @r{(line spacing)} -@cindex Spaces (blank lines) -@cindex Blank lines -@cindex Line spacing - -A line beginning with and containing only @code{@@sp @var{n}} -generates @var{n} blank lines of space in both the printed manual and -the Info file. @code{@@sp} also forces a paragraph break. For -example,@refill - -@example -@@sp 2 -@end example - -@noindent -generates two blank lines. - -The @code{@@sp} command is most often used in the title page.@refill - -@ignore -@c node br, page, sp, Breaks -@comment node-name, next, previous, up -@c section @code{@@br}: Generate Paragraph Breaks -@findex br @r{(paragraph breaks)} -@cindex Paragraph breaks -@cindex Breaks in a paragraph - -The @code{@@br} command forces a paragraph break. It inserts a blank -line. You can use the command within or at the end of a line. If -used within a line, the @code{@@br@{@}} command must be followed by -left and right braces (as shown here) to mark the end of the -command.@refill - -@need 700 -For example, - -@example -@group -This line @@br@{@}contains and is ended by paragraph breaks@@br -and is followed by another line. -@end group -@end example - -@noindent -produces - -@example -@group -This line - -contains and is ended by paragraph breaks - -and is followed by another line. -@end group -@end example - -The @code{@@br} command is seldom used. -@end ignore - -@node page, group, sp, Breaks -@comment node-name, next, previous, up -@section @code{@@page}: Start a New Page -@cindex Page breaks -@findex page - -A line containing only @code{@@page} starts a new page in a printed -manual. The command has no effect on Info files since they are not -paginated. An @code{@@page} command is often used in the @code{@@titlepage} -section of a Texinfo file to start the copyright page.@refill - -@node group, need, page, Breaks -@comment node-name, next, previous, up -@section @code{@@group}: Prevent Page Breaks -@cindex Group (hold text together vertically) -@cindex Holding text together vertically -@cindex Vertically holding text together -@findex group - -The @code{@@group} command (on a line by itself) is used inside an -@code{@@example} or similar construct to begin an unsplittable vertical -group, which will appear entirely on one page in the printed output. -The group is terminated by a line containing only @code{@@end group}. -These two lines produce no output of their own, and in the Info file -output they have no effect at all.@refill - -@c Once said that these environments -@c turn off vertical spacing between ``paragraphs''. -@c Also, quotation used to work, but doesn't in texinfo-2.72 -Although @code{@@group} would make sense conceptually in a wide -variety of contexts, its current implementation works reliably only -within @code{@@example} and variants, and within @code{@@display}, -@code{@@format}, @code{@@flushleft} and @code{@@flushright}. -@xref{Quotations and Examples}. (What all these commands have in -common is that each line of input produces a line of output.) In -other contexts, @code{@@group} can cause anomalous vertical -spacing.@refill - -@need 750 -This formatting requirement means that you should write: - -@example -@group -@@example -@@group -@dots{} -@@end group -@@end example -@end group -@end example - -@noindent -with the @code{@@group} and @code{@@end group} commands inside the -@code{@@example} and @code{@@end example} commands. - -The @code{@@group} command is most often used to hold an example -together on one page. In this Texinfo manual, more than 100 examples -contain text that is enclosed between @code{@@group} and @code{@@end -group}. - -If you forget to end a group, you may get strange and unfathomable -error messages when you run @TeX{}. This is because @TeX{} keeps -trying to put the rest of the Texinfo file onto the one page and does -not start to generate error messages until it has processed -considerable text. It is a good rule of thumb to look for a missing -@code{@@end group} if you get incomprehensible error messages in -@TeX{}.@refill - -@node need, , group, Breaks -@comment node-name, next, previous, up -@section @code{@@need @var{mils}}: Prevent Page Breaks -@cindex Need space at page bottom -@findex need - -A line containing only @code{@@need @var{n}} starts -a new page in a printed manual if fewer than @var{n} mils (thousandths -of an inch) remain on the current page. Do not use -braces around the argument @var{n}. The @code{@@need} command has no -effect on Info files since they are not paginated.@refill - -@need 800 -This paragraph is preceded by an @code{@@need} command that tells -@TeX{} to start a new page if fewer than 800 mils (eight-tenths -inch) remain on the page. It looks like this:@refill - -@example -@group -@@need 800 -This paragraph is preceded by @dots{} -@end group -@end example - -The @code{@@need} command is useful for preventing orphans (single -lines at the bottoms of printed pages).@refill - -@node Definition Commands, Footnotes, Breaks, Top -@chapter Definition Commands -@cindex Definition commands - -The @code{@@deffn} command and the other @dfn{definition commands} -enable you to describe functions, variables, macros, commands, user -options, special forms and other such artifacts in a uniform -format.@refill - -In the Info file, a definition causes the entity -category---`Function', `Variable', or whatever---to appear at the -beginning of the first line of the definition, followed by the -entity's name and arguments. In the printed manual, the command -causes @TeX{} to print the entity's name and its arguments on the left -margin and print the category next to the right margin. In both -output formats, the body of the definition is indented. Also, the -name of the entity is entered into the appropriate index: -@code{@@deffn} enters the name into the index of functions, -@code{@@defvr} enters it into the index of variables, and so -on.@refill - -A manual need not and should not contain more than one definition for -a given name. An appendix containing a summary should use -@code{@@table} rather than the definition commands.@refill - -@menu -* Def Cmd Template:: How to structure a description using a - definition command. -* Optional Arguments:: How to handle optional and repeated arguments. -* deffnx:: How to group two or more `first' lines. -* Def Cmds in Detail:: All the definition commands. -* Def Cmd Conventions:: Conventions for writing definitions. -* Sample Function Definition:: -@end menu - -@node Def Cmd Template, Optional Arguments, Definition Commands, Definition Commands -@section The Template for a Definition -@cindex Definition template -@cindex Template for a definition - -The @code{@@deffn} command is used for definitions of entities that -resemble functions. To write a definition using the @code{@@deffn} -command, write the @code{@@deffn} command at the beginning of a line -and follow it on the same line by the category of the entity, the name -of the entity itself, and its arguments (if any). Then write the body -of the definition on succeeding lines. (You may embed examples in the -body.) Finally, end the definition with an @code{@@end deffn} command -written on a line of its own. (The other definition commands follow -the same format.)@refill - -The template for a definition looks like this: - -@example -@group -@@deffn @var{category} @var{name} @var{arguments}@dots{} -@var{body-of-definition} -@@end deffn -@end group -@end example - -@need 700 -@noindent -For example, - -@example -@group -@@deffn Command forward-word count -This command moves point forward @@var@{count@} words -(or backward if @@var@{count@} is negative). @dots{} -@@end deffn -@end group -@end example - -@noindent -produces - -@quotation -@deffn Command forward-word count -This function moves point forward @var{count} words -(or backward if @var{count} is negative). @dots{} -@end deffn -@end quotation - -Capitalize the category name like a title. If the name of the -category contains spaces, as in the phrase `Interactive Command', -write braces around it. For example:@refill - -@example -@group -@@deffn @{Interactive Command@} isearch-forward -@dots{} -@@end deffn -@end group -@end example - -@noindent -Otherwise, the second word will be mistaken for the name of the -entity.@refill - -Some of the definition commands are more general than others. The -@code{@@deffn} command, for example, is the general definition command -for functions and the like---for entities that may take arguments. When -you use this command, you specify the category to which the entity -belongs. The @code{@@deffn} command possesses three predefined, -specialized variations, @code{@@defun}, @code{@@defmac}, and -@code{@@defspec}, that specify the category for you: ``Function'', -``Macro'', and ``Special Form'' respectively. (In Lisp, a special form -is an entity much like a function.) The @code{@@defvr} command also is -accompanied by several predefined, specialized variations for describing -particular kinds of variables.@refill - -The template for a specialized definition, such as @code{@@defun}, is -similar to the template for a generalized definition, except that you -do not need to specify the category:@refill - -@example -@group -@@defun @var{name} @var{arguments}@dots{} -@var{body-of-definition} -@@end defun -@end group -@end example - -@noindent -Thus, - -@example -@group -@@defun buffer-end flag -This function returns @@code@{(point-min)@} if @@var@{flag@} -is less than 1, @@code@{(point-max)@} otherwise. -@dots{} -@@end defun -@end group -@end example - -@noindent -produces - -@quotation -@defun buffer-end flag -This function returns @code{(point-min)} if @var{flag} is less than 1, -@code{(point-max)} otherwise. @dots{} -@end defun -@end quotation - -@noindent -@xref{Sample Function Definition, Sample Function Definition, A Sample -Function Definition}, for a more detailed example of a function -definition, including the use of @code{@@example} inside the -definition.@refill - -The other specialized commands work like @code{@@defun}.@refill - -@node Optional Arguments, deffnx, Def Cmd Template, Definition Commands -@section Optional and Repeated Arguments -@cindex Optional and repeated arguments -@cindex Repeated and optional arguments -@cindex Arguments, repeated and optional -@cindex Syntax, optional & repeated arguments -@cindex Meta-syntactic chars for arguments - -Some entities take optional or repeated arguments, which may be -specified by a distinctive glyph that uses square brackets and -ellipses. For @w{example}, a special form often breaks its argument list -into separate arguments in more complicated ways than a -straightforward function.@refill - -@iftex -An argument enclosed within square brackets is optional. -Thus, the phrase -@samp{@code{@r{[}@var{optional-arg}@r{]}}} means that -@var{optional-arg} is optional. -An argument followed by an ellipsis is optional -and may be repeated more than once. -@c This is consistent with Emacs Lisp Reference manual -Thus, @samp{@var{repeated-args}@dots{}} stands for zero or more arguments. -Parentheses are used when several arguments are grouped -into additional levels of list structure in Lisp. -@end iftex -@c The following looks better in Info (no `r', `samp' and `code'): -@ifinfo -An argument enclosed within square brackets is optional. -Thus, [@var{optional-arg}] means that @var{optional-arg} is optional. -An argument followed by an ellipsis is optional -and may be repeated more than once. -@c This is consistent with Emacs Lisp Reference manual -Thus, @var{repeated-args}@dots{} stands for zero or more arguments. -Parentheses are used when several arguments are grouped -into additional levels of list structure in Lisp. -@end ifinfo - -Here is the @code{@@defspec} line of an example of an imaginary -special form:@refill - -@quotation -@defspec foobar (@var{var} [@var{from} @var{to} [@var{inc}]]) @var{body}@dots{} -@end defspec -@tex -\vskip \parskip -@end tex -@end quotation - -@noindent -In this example, the arguments @var{from} and @var{to} are optional, -but must both be present or both absent. If they are present, -@var{inc} may optionally be specified as well. These arguments are -grouped with the argument @var{var} into a list, to distinguish them -from @var{body}, which includes all remaining elements of the -form.@refill - -In a Texinfo source file, this @code{@@defspec} line is written like -this (except it would not be split over two lines, as it is in this -example).@refill - -@example -@group -@@defspec foobar (@@var@{var@} [@@var@{from@} @@var@{to@} - [@@var@{inc@}]]) @@var@{body@}@@dots@{@} -@end group -@end example - -@noindent -The function is listed in the Command and Variable Index under -@samp{foobar}.@refill - -@node deffnx, Def Cmds in Detail, Optional Arguments, Definition Commands -@section Two or More `First' Lines -@cindex Two `First' Lines for @code{@@deffn} -@cindex Grouping two definitions together -@cindex Definitions grouped together -@findex deffnx - -To create two or more `first' or header lines for a definition, follow -the first @code{@@deffn} line by a line beginning with @code{@@deffnx}. -The @code{@@deffnx} command works exactly like @code{@@deffn} -except that it does not generate extra vertical white space between it -and the preceding line.@refill - -@need 1000 -For example, - -@example -@group -@@deffn @{Interactive Command@} isearch-forward -@@deffnx @{Interactive Command@} isearch-backward -These two search commands are similar except @dots{} -@@end deffn -@end group -@end example - -@noindent -produces - -@deffn {Interactive Command} isearch-forward -@deffnx {Interactive Command} isearch-backward -These two search commands are similar except @dots{} -@end deffn - -Each of the other definition commands has an `x' form: @code{@@defunx}, -@code{@@defvrx}, @code{@@deftypefunx}, etc. - -The `x' forms work just like @code{@@itemx}; see @ref{itemx, , @code{@@itemx}}. - -@node Def Cmds in Detail, Def Cmd Conventions, deffnx, Definition Commands -@section The Definition Commands - -Texinfo provides more than a dozen definition commands, all of which -are described in this section.@refill - -The definition commands automatically enter the name of the entity in -the appropriate index: for example, @code{@@deffn}, @code{@@defun}, -and @code{@@defmac} enter function names in the index of functions; -@code{@@defvr} and @code{@@defvar} enter variable names in the index -of variables.@refill - -Although the examples that follow mostly illustrate Lisp, the commands -can be used for other programming languages.@refill - -@menu -* Functions Commands:: Commands for functions and similar entities. -* Variables Commands:: Commands for variables and similar entities. -* Typed Functions:: Commands for functions in typed languages. -* Typed Variables:: Commands for variables in typed languages. -* Abstract Objects:: Commands for object-oriented programming. -* Data Types:: The definition command for data types. -@end menu - -@node Functions Commands, Variables Commands, Def Cmds in Detail, Def Cmds in Detail -@subsection Functions and Similar Entities - -This section describes the commands for describing functions and similar -entities:@refill - -@table @code -@findex deffn -@item @@deffn @var{category} @var{name} @var{arguments}@dots{} -The @code{@@deffn} command is the general definition command for -functions, interactive commands, and similar entities that may take -arguments. You must choose a term to describe the category of entity -being defined; for example, ``Function'' could be used if the entity is -a function. The @code{@@deffn} command is written at the beginning of a -line and is followed on the same line by the category of entity being -described, the name of this particular entity, and its arguments, if -any. Terminate the definition with @code{@@end deffn} on a line of its -own.@refill - -@need 750 -For example, here is a definition: - -@example -@group -@@deffn Command forward-char nchars -Move point forward @@var@{nchars@} characters. -@@end deffn -@end group -@end example - -@noindent -This shows a rather terse definition for a ``command'' named -@code{forward-char} with one argument, @var{nchars}. - -@code{@@deffn} prints argument names such as @var{nchars} in italics or -upper case, as if @code{@@var} had been used, because we think of these -names as metasyntactic variables---they stand for the actual argument -values. Within the text of the description, write an argument name -explicitly with @code{@@var} to refer to the value of the argument. In -the example above, we used @samp{@@var@{nchars@}} in this way. - -The template for @code{@@deffn} is: - -@example -@group -@@deffn @var{category} @var{name} @var{arguments}@dots{} -@var{body-of-definition} -@@end deffn -@end group -@end example - -@findex defun -@item @@defun @var{name} @var{arguments}@dots{} -The @code{@@defun} command is the definition command for functions. -@code{@@defun} is equivalent to @samp{@@deffn Function -@dots{}}.@refill - -@need 800 -@noindent -For example, - -@example -@group -@@defun set symbol new-value -Change the value of the symbol @@var@{symbol@} -to @@var@{new-value@}. -@@end defun -@end group -@end example - -@noindent -shows a rather terse definition for a function @code{set} whose -arguments are @var{symbol} and @var{new-value}. The argument names on -the @code{@@defun} line automatically appear in italics or upper case as -if they were enclosed in @code{@@var}. Terminate the definition with -@code{@@end defun} on a line of its own.@refill - -The template is: - -@example -@group -@@defun @var{function-name} @var{arguments}@dots{} -@var{body-of-definition} -@@end defun -@end group -@end example - -@code{@@defun} creates an entry in the index of functions. - -@findex defmac -@item @@defmac @var{name} @var{arguments}@dots{} -The @code{@@defmac} command is the definition command for macros. -@code{@@defmac} is equivalent to @samp{@@deffn Macro @dots{}} and -works like @code{@@defun}.@refill - -@findex defspec -@item @@defspec @var{name} @var{arguments}@dots{} -The @code{@@defspec} command is the definition command for special -forms. (In Lisp, a special form is an entity much like a function, -@pxref{Special Forms,,, lispref, XEmacs Lisp Reference Manual}.) -@code{@@defspec} is equivalent to @samp{@@deffn @{Special Form@} -@dots{}} and works like @code{@@defun}.@refill -@end table - -@node Variables Commands, Typed Functions, Functions Commands, Def Cmds in Detail -@subsection Variables and Similar Entities - -Here are the commands for defining variables and similar -entities:@refill - -@table @code -@findex defvr -@item @@defvr @var{category} @var{name} -The @code{@@defvr} command is a general definition command for -something like a variable---an entity that records a value. You must -choose a term to describe the category of entity being defined; for -example, ``Variable'' could be used if the entity is a variable. -Write the @code{@@defvr} command at the beginning of a line and -followed it on the same line by the category of the entity and the -name of the entity.@refill - -Capitalize the category name like a title. If the name of the category -contains spaces, as in the name ``User Option'', enclose it in braces. -Otherwise, the second word will be mistaken for the name of the entity. -For example, - -@example -@group -@@defvr @{User Option@} fill-column -This buffer-local variable specifies -the maximum width of filled lines. -@dots{} -@@end defvr -@end group -@end example - -Terminate the definition with @code{@@end defvr} on a line of its -own.@refill - -The template is: - -@example -@group -@@defvr @var{category} @var{name} -@var{body-of-definition} -@@end defvr -@end group -@end example - -@code{@@defvr} creates an entry in the index of variables for @var{name}. - -@findex defvar -@item @@defvar @var{name} -The @code{@@defvar} command is the definition command for variables. -@code{@@defvar} is equivalent to @samp{@@defvr Variable -@dots{}}.@refill - -@need 750 -For example: - -@example -@group -@@defvar kill-ring -@dots{} -@@end defvar -@end group -@end example - -The template is: - -@example -@group -@@defvar @var{name} -@var{body-of-definition} -@@end defvar -@end group -@end example - -@code{@@defvar} creates an entry in the index of variables for -@var{name}.@refill - -@findex defopt -@item @@defopt @var{name} -@cindex User options, marking -The @code{@@defopt} command is the definition command for @dfn{user -options}, i.e., variables intended for users to change according to -taste; Emacs has many such (@pxref{Variables,,, xemacs, XEmacs User's -Manual}). @code{@@defopt} is equivalent to @samp{@@defvr @{User -Option@} @dots{}} and works like @code{@@defvar}.@refill -@end table - - -@node Typed Functions, Typed Variables, Variables Commands, Def Cmds in Detail -@subsection Functions in Typed Languages - -The @code{@@deftypefn} command and its variations are for describing -functions in languages in which you must declare types of variables and -functions, such as C and C++. - -@table @code -@findex deftypefn -@item @@deftypefn @var{category} @var{data-type} @var{name} @var{arguments}@dots{} -The @code{@@deftypefn} command is the general definition command for -functions and similar entities that may take arguments and that are -typed. The @code{@@deftypefn} command is written at the beginning of -a line and is followed on the same line by the category of entity -being described, the type of the returned value, the name of this -particular entity, and its arguments, if any.@refill - -@need 800 -@noindent -For example, - -@example -@group -@@deftypefn @{Library Function@} int foobar - (int @@var@{foo@}, float @@var@{bar@}) -@dots{} -@@end deftypefn -@end group -@end example - -@need 1000 -@noindent -(where the text before the ``@dots{}'', shown above as two lines, would -actually be a single line in a real Texinfo file) produces the following -in Info: - -@smallexample -@group --- Library Function: int foobar (int FOO, float BAR) -@dots{} -@end group -@end smallexample -@iftex - -In a printed manual, it produces: - -@quotation -@deftypefn {Library Function} int foobar (int @var{foo}, float @var{bar}) -@dots{} -@end deftypefn -@end quotation -@end iftex - -This means that @code{foobar} is a ``library function'' that returns an -@code{int}, and its arguments are @var{foo} (an @code{int}) and -@var{bar} (a @code{float}).@refill - -The argument names that you write in @code{@@deftypefn} are not subject -to an implicit @code{@@var}---since the actual names of the arguments in -@code{@@deftypefn} are typically scattered among data type names and -keywords, Texinfo cannot find them without help. Instead, you must write -@code{@@var} explicitly around the argument names. In the example -above, the argument names are @samp{foo} and @samp{bar}.@refill - -The template for @code{@@deftypefn} is:@refill - -@example -@group -@@deftypefn @var{category} @var{data-type} @var{name} @var{arguments} @dots{} -@var{body-of-description} -@@end deftypefn -@end group -@end example - -@noindent -Note that if the @var{category} or @var{data type} is more than one -word then it must be enclosed in braces to make it a single argument.@refill - -If you are describing a procedure in a language that has packages, -such as Ada, you might consider using @code{@@deftypefn} in a manner -somewhat contrary to the convention described in the preceding -paragraphs.@refill - -@need 800 -@noindent -For example: - -@example -@group -@@deftypefn stacks private push - (@@var@{s@}:in out stack; - @@var@{n@}:in integer) -@dots{} -@@end deftypefn -@end group -@end example - -@noindent -(The @code{@@deftypefn} arguments are shown split into three lines, but -would be a single line in a real Texinfo file.) - -In this instance, the procedure is classified as belonging to the -package @code{stacks} rather than classified as a `procedure' and its -data type is described as @code{private}. (The name of the procedure -is @code{push}, and its arguments are @var{s} and @var{n}.)@refill - -@code{@@deftypefn} creates an entry in the index of functions for -@var{name}.@refill - -@item @@deftypefun @var{data-type} @var{name} @var{arguments}@dots{} -@findex deftypefun -The @code{@@deftypefun} command is the specialized definition command -for functions in typed languages. The command is equivalent to -@samp{@@deftypefn Function @dots{}}.@refill - -@need 800 -@noindent -Thus, - -@smallexample -@group -@@deftypefun int foobar (int @@var@{foo@}, float @@var@{bar@}) -@dots{} -@@end deftypefun -@end group -@end smallexample - -@noindent -produces the following in Info: - -@example -@group --- Function: int foobar (int FOO, float BAR) -@dots{} -@end group -@end example -@iftex - -@need 800 -@noindent -and the following in a printed manual: - -@quotation -@deftypefun int foobar (int @var{foo}, float @var{bar}) -@dots{} -@end deftypefun -@end quotation -@end iftex - -@need 800 -The template is: - -@example -@group -@@deftypefun @var{type} @var{name} @var{arguments}@dots{} -@var{body-of-description} -@@end deftypefun -@end group -@end example - -@code{@@deftypefun} creates an entry in the index of functions for -@var{name}.@refill - -@end table - - -@node Typed Variables, Abstract Objects, Typed Functions, Def Cmds in Detail -@subsection Variables in Typed Languages - -Variables in typed languages are handled in a manner similar to -functions in typed languages. @xref{Typed Functions}. The general -definition command @code{@@deftypevr} corresponds to -@code{@@deftypefn} and the specialized definition command -@code{@@deftypevar} corresponds to @code{@@deftypefun}.@refill - -@table @code -@findex deftypevr -@item @@deftypevr @var{category} @var{data-type} @var{name} -The @code{@@deftypevr} command is the general definition command for -something like a variable in a typed language---an entity that records -a value. You must choose a term to describe the category of the -entity being defined; for example, ``Variable'' could be used if the -entity is a variable.@refill - -The @code{@@deftypevr} command is written at the beginning of a line -and is followed on the same line by the category of the entity -being described, the data type, and the name of this particular -entity.@refill - -@need 800 -@noindent -For example: - -@example -@group -@@deftypevr @{Global Flag@} int enable -@dots{} -@@end deftypevr -@end group -@end example - -@noindent -produces the following in Info: - -@example -@group --- Global Flag: int enable -@dots{} -@end group -@end example -@iftex - -@noindent -and the following in a printed manual: - -@quotation -@deftypevr {Global Flag} int enable -@dots{} -@end deftypevr -@end quotation -@end iftex - -@need 800 -The template is: - -@example -@@deftypevr @var{category} @var{data-type} @var{name} -@var{body-of-description} -@@end deftypevr -@end example - -@code{@@deftypevr} creates an entry in the index of variables for -@var{name}.@refill - -@findex deftypevar -@item @@deftypevar @var{data-type} @var{name} -The @code{@@deftypevar} command is the specialized definition command -for variables in typed languages. @code{@@deftypevar} is equivalent -to @samp{@@deftypevr Variable @dots{}}.@refill - -@need 800 -@noindent -For example: - -@example -@group -@@deftypevar int fubar -@dots{} -@@end deftypevar -@end group -@end example - -@noindent -produces the following in Info: - -@example -@group --- Variable: int fubar -@dots{} -@end group -@end example -@iftex - -@need 800 -@noindent -and the following in a printed manual: - -@quotation -@deftypevar int fubar -@dots{} -@end deftypevar -@end quotation -@end iftex - -@need 800 -@noindent -The template is: - -@example -@group -@@deftypevar @var{data-type} @var{name} -@var{body-of-description} -@@end deftypevar -@end group -@end example - -@code{@@deftypevar} creates an entry in the index of variables for -@var{name}.@refill -@end table - -@node Abstract Objects, Data Types, Typed Variables, Def Cmds in Detail -@subsection Object-Oriented Programming - -Here are the commands for formatting descriptions about abstract -objects, such as are used in object-oriented programming. A class is -a defined type of abstract object. An instance of a class is a -particular object that has the type of the class. An instance -variable is a variable that belongs to the class but for which each -instance has its own value.@refill - -In a definition, if the name of a class is truly a name defined in the -programming system for a class, then you should write an @code{@@code} -around it. Otherwise, it is printed in the usual text font.@refill - -@table @code -@findex defcv -@item @@defcv @var{category} @var{class} @var{name} -The @code{@@defcv} command is the general definition command for -variables associated with classes in object-oriented programming. The -@code{@@defcv} command is followed by three arguments: the category of -thing being defined, the class to which it belongs, and its -name. Thus,@refill - -@example -@group -@@defcv @{Class Option@} Window border-pattern -@dots{} -@@end defcv -@end group -@end example - -@noindent -illustrates how you would write the first line of a definition of the -@code{border-pattern} class option of the class @code{Window}.@refill - -The template is - -@example -@group -@@defcv @var{category} @var{class} @var{name} -@dots{} -@@end defcv -@end group -@end example - -@code{@@defcv} creates an entry in the index of variables. - -@findex defivar -@item @@defivar @var{class} @var{name} -The @code{@@defivar} command is the definition command for instance -variables in object-oriented programming. @code{@@defivar} is -equivalent to @samp{@@defcv @{Instance Variable@} @dots{}}@refill - -The template is: - -@example -@group -@@defivar @var{class} @var{instance-variable-name} -@var{body-of-definition} -@@end defivar -@end group -@end example - -@code{@@defivar} creates an entry in the index of variables. - -@findex defop -@item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{} -The @code{@@defop} command is the general definition command for -entities that may resemble methods in object-oriented programming. -These entities take arguments, as functions do, but are associated -with particular classes of objects.@refill - -For example, some systems have constructs called @dfn{wrappers} that -are associated with classes as methods are, but that act more like -macros than like functions. You could use @code{@@defop Wrapper} to -describe one of these.@refill - -Sometimes it is useful to distinguish methods and @dfn{operations}. -You can think of an operation as the specification for a method. -Thus, a window system might specify that all window classes have a -method named @code{expose}; we would say that this window system -defines an @code{expose} operation on windows in general. Typically, -the operation has a name and also specifies the pattern of arguments; -all methods that implement the operation must accept the same -arguments, since applications that use the operation do so without -knowing which method will implement it.@refill - -Often it makes more sense to document operations than methods. For -example, window application developers need to know about the -@code{expose} operation, but need not be concerned with whether a -given class of windows has its own method to implement this operation. -To describe this operation, you would write:@refill - -@example -@@defop Operation windows expose -@end example - -The @code{@@defop} command is written at the beginning of a line and -is followed on the same line by the overall name of the category of -operation, the name of the class of the operation, the name of the -operation, and its arguments, if any.@refill - -@need 800 -@noindent -The template is: - -@example -@group -@@defop @var{category} @var{class} @var{name} @var{arguments}@dots{} -@var{body-of-definition} -@@end defop -@end group -@end example - -@code{@@defop} creates an entry, such as `@code{expose} on -@code{windows}', in the index of functions.@refill - -@item @@defmethod @var{class} @var{name} @var{arguments}@dots{} -@findex defmethod -The @code{@@defmethod} command is the definition command for methods -in object-oriented programming. A method is a kind of function that -implements an operation for a particular class of objects and its -subclasses. In the Lisp Machine, methods actually were functions, but -they were usually defined with @code{defmethod}. - -@code{@@defmethod} is equivalent to @samp{@@defop Method @dots{}}. -The command is written at the beginning of a line and is followed by -the name of the class of the method, the name of the method, and its -arguments, if any.@refill - -@need 800 -@noindent -For example, - -@example -@group -@@defmethod @code{bar-class} bar-method argument -@dots{} -@@end defmethod -@end group -@end example - -@noindent -illustrates the definition for a method called @code{bar-method} of -the class @code{bar-class}. The method takes an argument.@refill - -The template is: - -@example -@group -@@defmethod @var{class} @var{method-name} @var{arguments}@dots{} -@var{body-of-definition} -@@end defmethod -@end group -@end example - -@code{@@defmethod} creates an entry, such as `@code{bar-method} on -@code{bar-class}', in the index of functions.@refill - -@item @@deftypemethod @var{class} @var{data-type} @var{name} @var{arguments}@dots{} -@findex defmethod -The @code{@@deftypemethod} command is the definition command for methods -in object-oriented typed languages, such as C++ and Java. It is similar -to the @code{@@defmethod} command with the addition of the -@var{data-type} parameter to specify the return type of the method. - -@end table - - -@node Data Types, , Abstract Objects, Def Cmds in Detail -@subsection Data Types - -Here is the command for data types:@refill - -@table @code -@findex deftp -@item @@deftp @var{category} @var{name} @var{attributes}@dots{} -The @code{@@deftp} command is the generic definition command for data -types. The command is written at the beginning of a line and is -followed on the same line by the category, by the name of the type -(which is a word like @code{int} or @code{float}), and then by names of -attributes of objects of that type. Thus, you could use this command -for describing @code{int} or @code{float}, in which case you could use -@code{data type} as the category. (A data type is a category of -certain objects for purposes of deciding which operations can be -performed on them.)@refill - -In Lisp, for example, @dfn{pair} names a particular data -type, and an object of that type has two slots called the -@sc{car} and the @sc{cdr}. Here is how you would write the first line -of a definition of @code{pair}.@refill - -@example -@group -@@deftp @{Data type@} pair car cdr -@dots{} -@@end deftp -@end group -@end example - -@need 950 -The template is: - -@example -@group -@@deftp @var{category} @var{name-of-type} @var{attributes}@dots{} -@var{body-of-definition} -@@end deftp -@end group -@end example - -@code{@@deftp} creates an entry in the index of data types. -@end table - -@node Def Cmd Conventions, Sample Function Definition, Def Cmds in Detail, Definition Commands -@section Conventions for Writing Definitions -@cindex Definition conventions -@cindex Conventions for writing definitions - -When you write a definition using @code{@@deffn}, @code{@@defun}, or -one of the other definition commands, please take care to use -arguments that indicate the meaning, as with the @var{count} argument -to the @code{forward-word} function. Also, if the name of an argument -contains the name of a type, such as @var{integer}, take care that the -argument actually is of that type.@refill - -@node Sample Function Definition, , Def Cmd Conventions, Definition Commands -@section A Sample Function Definition -@cindex Function definitions -@cindex Command definitions -@cindex Macro definitions -@cindex Sample function definition - -A function definition uses the @code{@@defun} and @code{@@end defun} -commands. The name of the function follows immediately after the -@code{@@defun} command and it is followed, on the same line, by the -parameter list.@refill - -Here is a definition from @ref{Calling Functions,,, lispref, XEmacs Lisp -Reference Manual}. - -@quotation -@defun apply function &rest arguments -@code{apply} calls @var{function} with @var{arguments}, just -like @code{funcall} but with one difference: the last of -@var{arguments} is a list of arguments to give to -@var{function}, rather than a single argument. We also say -that this list is @dfn{appended} to the other arguments. - -@code{apply} returns the result of calling @var{function}. -As with @code{funcall}, @var{function} must either be a Lisp -function or a primitive function; special forms and macros -do not make sense in @code{apply}. - -@example -(setq f 'list) - @result{} list -(apply f 'x 'y 'z) -@error{} Wrong type argument: listp, z -(apply '+ 1 2 '(3 4)) - @result{} 10 -(apply '+ '(1 2 3 4)) - @result{} 10 - -(apply 'append '((a b c) nil (x y z) nil)) - @result{} (a b c x y z) -@end example - -An interesting example of using @code{apply} is found in the description -of @code{mapcar}.@refill -@end defun -@end quotation - -@need 1200 -In the Texinfo source file, this example looks like this: - -@example -@group -@@defun apply function &rest arguments - -@@code@{apply@} calls @@var@{function@} with -@@var@{arguments@}, just like @@code@{funcall@} but with one -difference: the last of @@var@{arguments@} is a list of -arguments to give to @@var@{function@}, rather than a single -argument. We also say that this list is @@dfn@{appended@} -to the other arguments. -@end group - -@group -@@code@{apply@} returns the result of calling -@@var@{function@}. As with @@code@{funcall@}, -@@var@{function@} must either be a Lisp function or a -primitive function; special forms and macros do not make -sense in @@code@{apply@}. -@end group - -@group -@@example -(setq f 'list) - @@result@{@} list -(apply f 'x 'y 'z) -@@error@{@} Wrong type argument: listp, z -(apply '+ 1 2 '(3 4)) - @@result@{@} 10 -(apply '+ '(1 2 3 4)) - @@result@{@} 10 - -(apply 'append '((a b c) nil (x y z) nil)) - @@result@{@} (a b c x y z) -@@end example -@end group - -@group -An interesting example of using @@code@{apply@} is found -in the description of @@code@{mapcar@}.@@refill -@@end defun -@end group -@end example - -@noindent -In this manual, this function is listed in the Command and Variable -Index under @code{apply}.@refill - -Ordinary variables and user options are described using a format like -that for functions except that variables do not take arguments. - - -@node Footnotes, Conditionals, Definition Commands, Top -@chapter Footnotes -@cindex Footnotes -@findex footnote - -A @dfn{footnote} is for a reference that documents or elucidates the -primary text.@footnote{A footnote should complement or expand upon -the primary text, but a reader should not need to read a footnote to -understand the primary text. For a thorough discussion of footnotes, -see @cite{The Chicago Manual of Style}, which is published by the -University of Chicago Press.}@refill - -@menu -* Footnote Commands:: How to write a footnote in Texinfo. -* Footnote Styles:: Controlling how footnotes appear in Info. -@end menu - -@node Footnote Commands, Footnote Styles, Footnotes, Footnotes -@section Footnote Commands - -In Texinfo, footnotes are created with the @code{@@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. Footnotes may -be of any length (they will be broken across pages if necessary), but -are usually short. The template is: - -@example -ordinary text@@footnote@{@var{text of footnote}@} -@end example - -As shown here, the @code{@@footnote} command should come right after the -text being footnoted, with no intervening space; otherwise, the -formatters the footnote mark might end up starting up a line. - -For example, this clause is followed by a sample -footnote@footnote{Here is the sample footnote.}; in the Texinfo -source, it looks like this:@refill - -@example -@dots{}a sample footnote@@footnote@{Here is the sample -footnote.@}; in the Texinfo source@dots{} -@end example - -@strong{Warning:} Don't use footnotes in the argument of the -@code{@@item} command for a @code{@@table} table. This doesn't work, and -because of limitations of @TeX{}, there is no way to fix it. You must -put the footnote into the body text of the table. - -In a printed manual or book, the reference mark for a footnote is a -small, superscripted number; the text of the footnote appears at the -bottom of the page, below a horizontal line.@refill - -In Info, the reference mark for a footnote is a pair of parentheses -with the footnote number between them, like this: @samp{(1)}.@refill - - -@node Footnote Styles, , Footnote Commands, Footnotes -@section Footnote Styles - -Info has two footnote styles, which determine where the text of the -footnote is located:@refill - -@itemize @bullet -@cindex @samp{@r{End}} node footnote style -@item -In the `End' 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 -@samp{Footnotes} within it. Each footnote begins with an -@samp{(@var{n})} reference mark.@refill - -@need 700 -@noindent -Here is an example of a single footnote in the end of node style:@refill - -@example -@group - --------- Footnotes --------- - -(1) Here is a sample footnote. -@end group -@end example - -@cindex @samp{@r{Separate}} footnote style -@item -In the `Separate' node style, all the footnotes for a single -node are placed in an automatically constructed node of -their own. In this style, a ``footnote reference'' follows -each @samp{(@var{n})} reference mark in the body of the -node. The footnote reference is actually a cross reference -which you use to reach the footnote node.@refill - -The name of the node containing the footnotes is constructed -by appending @w{@samp{-Footnotes}} to the name of the node -that contains the footnotes. (Consequently, the footnotes' -node for the @file{Footnotes} node is -@w{@file{Footnotes-Footnotes}}!) The footnotes' node has an -`Up' node pointer that leads back to its parent node.@refill - -@noindent -Here is how the first footnote in this manual looks after being -formatted for Info in the separate node style:@refill - -@smallexample -@group -File: texinfo.info Node: Overview-Footnotes, Up: Overview - -(1) Note that the first syllable of "Texinfo" is -pronounced like "speck", not "hex". @dots{} -@end group -@end smallexample -@end itemize - -A Texinfo file may be formatted into an Info file with either footnote -style.@refill - -@findex footnotestyle -Use the @code{@@footnotestyle} command to specify an Info file's -footnote style. Write this command at the beginning of a line followed -by an argument, either @samp{end} for the end node style or -@samp{separate} for the separate node style. - -@need 700 -For example, - -@example -@@footnotestyle end -@end example -@noindent -or -@example -@@footnotestyle separate -@end example - -Write an @code{@@footnotestyle} command before or shortly after the -end-of-header line at the beginning of a Texinfo file. (If you -include the @code{@@footnotestyle} command between the start-of-header -and end-of-header lines, the region formatting commands will format -footnotes as specified.)@refill - -If you do not specify a footnote style, the formatting commands use -their default style. Currently, @code{texinfo-format-buffer} and -@code{texinfo-format-region} use the `separate' style and -@code{makeinfo} uses the `end' style.@refill - -@c !!! note: makeinfo's --footnote-style option overrides footnotestyle -@ignore -If you use @code{makeinfo} to create the Info file, the -@samp{--footnote-style} option determines which style is used, -@samp{end} for the end of node style or @samp{separate} for the -separate node style. Thus, to format the Texinfo manual in the -separate node style, you would use the following shell command:@refill - -@example -makeinfo --footnote-style=separate texinfo.texi -@end example - -@noindent -To format the Texinfo manual in the end of node style, you would -type:@refill - -@example -makeinfo --footnote-style=end texinfo.texi -@end example -@end ignore -@ignore -If you use @code{texinfo-format-buffer} or -@code{texinfo-format-region} to create the Info file, the value of the -@code{texinfo-footnote-style} variable controls the footnote style. -It can be either @samp{"separate"} for the separate node style or -@samp{"end"} for the end of node style. (You can change the value of -this variable with the @kbd{M-x edit-options} command (@pxref{Edit -Options, , Editing Variable Values, xemacs, XEmacs User's Manual}), or -with the @kbd{M-x set-variable} command (@pxref{Examining, , Examining -and Setting Variables, xemacs, XEmacs User's Manual}).@refill - -The @code{texinfo-footnote-style} variable also controls the style if -you use the @kbd{M-x makeinfo-region} or @kbd{M-x makeinfo-buffer} -command in Emacs.@refill -@end ignore -This chapter contains two footnotes.@refill - - -@node Conditionals, Macros, Footnotes, Top -@comment node-name, next, previous, up -@chapter Conditionally Visible Text -@cindex Conditionally visible text -@cindex Text, conditionally visible -@cindex Visibility of conditional text -@cindex If text conditionally visible - -Sometimes it is good to use different text for a printed manual and -its corresponding Info file. In this case, you can use the -@dfn{conditional commands} to specify which text is for the printed manual -and which is for the Info file.@refill - -@menu -* Conditional Commands:: Specifying text for HTML, Info, or @TeX{}. -* Conditional Not Commands:: Specifying text for not HTML, Info, or @TeX{}. -* Raw Formatter Commands:: Using raw @TeX{} or HTML commands. -* set clear value:: Designating which text to format (for - all output formats); and how to set a - flag to a string that you can insert. -@end menu - -@node Conditional Commands, Conditional Not Commands, Conditionals, Conditionals -@ifinfo -@heading Conditional Commands -@end ifinfo - -@findex ifinfo -@code{@@ifinfo} begins segments of text that should be ignored -by @TeX{} when it -typesets the printed manual. The segment of text appears only -in the Info file. -The @code{@@ifinfo} command should appear on a line by itself; end -the Info-only text with a line containing @code{@@end ifinfo} by -itself. At the beginning of a Texinfo file, the Info permissions are -contained within a region marked by @code{@@ifinfo} and @code{@@end -ifinfo}. (@xref{Info Summary and Permissions}.)@refill - -@findex iftex -@findex ifhtml -The @code{@@iftex} and @code{@@end iftex} commands are similar to the -@code{@@ifinfo} and @code{@@end ifinfo} commands, except that they -specify text that will appear in the printed manual but not in the Info -file. Likewise for @code{@@ifhtml} and @code{@@end ifhtml}, which -specify text to appear only in HTML output.@refill - -For example, - -@example -@@iftex -This text will appear only in the printed manual. -@@end iftex -@@ifinfo -However, this text will appear only in Info. -@@end ifinfo -@end example - -@noindent -The preceding example produces the following line: -@iftex -This text will appear only in the printed manual. -@end iftex -@ifinfo -However, this text will appear only in Info. -@end ifinfo - -@noindent -Note how you only see one of the two lines, depending on whether you -are reading the Info version or the printed version of this -manual.@refill - -The @code{@@titlepage} command is a special variant of @code{@@iftex} that -is used for making the title and copyright pages of the printed -manual. (@xref{titlepage, , @code{@@titlepage}}.) @refill - - -@node Conditional Not Commands, Raw Formatter Commands, Conditional Commands, Conditionals -@section Conditional Not Commands -@findex ifnothtml -@findex ifnotinfo -@findex ifnottex - -You can specify text to be included in any output format @emph{other} -than some given one with the @code{@@ifnot@dots{}} commands: -@example -@@ifnothtml @dots{} @@end ifnothtml -@@ifnotinfo @dots{} @@end ifnotinfo -@@ifnottex @dots{} @@end ifnottex -@end example -@noindent -(The @code{@@ifnot@dots{}} command and the @code{@@end} command must -actually appear on lines by themselves.) - -If the output file is not being made for the given format, the region is -included. Otherwise, it is ignored. - -The regions delimited by these commands are ordinary Texinfo source as -with @code{@@iftex}, not raw formatter source as with @code{@@tex}. - - -@node Raw Formatter Commands, set clear value, Conditional Not Commands, Conditionals -@section Raw Formatter Commands -@cindex @TeX{} commands, using ordinary -@cindex HTML commands, using ordinary -@cindex Raw formatter commands -@cindex Ordinary @TeX{} commands, using -@cindex Ordinary HTML commands, using -@cindex Commands using raw @TeX{} -@cindex Commands using raw HTML -@cindex plain @TeX{} - -Inside a region delineated by @code{@@iftex} and @code{@@end iftex}, you -can embed some raw @TeX{} commands. Info will ignore these commands -since they are only in that part of the file which is seen by @TeX{}. -You can write the @TeX{} commands as you would write them in a normal -@TeX{} file, except that you must replace the @samp{\} used by @TeX{} -with an @samp{@@}. For example, in the @code{@@titlepage} section of a -Texinfo file, you can use the @TeX{} command @code{@@vskip} to format -the copyright page. (The @code{@@titlepage} command causes Info to -ignore the region automatically, as it does with the @code{@@iftex} -command.) - -However, many features of plain @TeX{} will not work, as they are -overridden by Texinfo features. - -@findex tex -You can enter plain @TeX{} completely, and use @samp{\} in the @TeX{} -commands, by delineating a region with the @code{@@tex} and @code{@@end -tex} commands. (The @code{@@tex} command also causes Info to ignore the -region, like the @code{@@iftex} command.) The sole exception is that -@code{@@} chracter still introduces a command, so that @code{@@end tex} -can be recognized properly. - -@cindex Mathematical expressions -For example, here is a mathematical expression written in -plain @TeX{}: - -@example -@@tex -$$ \chi^2 = \sum_@{i=1@}^N - \left (y_i - (a + b x_i) - \over \sigma_i\right)^2 $$ -@@end tex -@end example - -@noindent -The output of this example will appear only in a printed manual. If -you are reading this in Info, you will not see the equation that appears -in the printed manual. -@iftex -In a printed manual, the above expression looks like -this: -@end iftex - -@tex -$$ \chi^2 = \sum_{i=1}^N - \left(y_i - (a + b x_i) - \over \sigma_i\right)^2 $$ -@end tex - -@findex ifhtml -@findex html -Analogously, you can use @code{@@ifhtml @dots{} @@end ifhtml} to delimit -a region to be included in HTML output only, and @code{@@html @dots{} -@@end ifhtml} for a region of raw HTML (again, except that @code{@@} is -still the escape character, so the @code{@@end} command can be -recognized.) - - -@node set clear value, , Raw Formatter Commands, Conditionals -@comment node-name, next, previous, up -@section @code{@@set}, @code{@@clear}, and @code{@@value} - -You can direct the Texinfo formatting commands to format or ignore parts -of a Texinfo file with the @code{@@set}, @code{@@clear}, @code{@@ifset}, -and @code{@@ifclear} commands.@refill - -In addition, you can use the @code{@@set @var{flag}} command to set the -value of @var{flag} to a string of characters; and use -@code{@@value@{@var{flag}@}} to insert that string. You can use -@code{@@set}, for example, to set a date and use @code{@@value} to -insert the date in several places in the Texinfo file.@refill - -@menu -* ifset ifclear:: Format a region if a flag is set. -* value:: Replace a flag with a string. -* value Example:: An easy way to update edition information. -@end menu - - -@node ifset ifclear, value, set clear value, set clear value -@subsection @code{@@ifset} and @code{@@ifclear} - -@findex ifset -When a @var{flag} is set, the Texinfo formatting commands format text -between subsequent pairs of @code{@@ifset @var{flag}} and @code{@@end -ifset} commands. When the @var{flag} is cleared, the Texinfo formatting -commands do @emph{not} format the text. - -Use the @code{@@set @var{flag}} command to turn on, or @dfn{set}, a -@var{flag}; a @dfn{flag} can be any single word. The format for the -command looks like this:@refill -@findex set - -@example -@@set @var{flag} -@end example - -Write the conditionally formatted text between @code{@@ifset @var{flag}} -and @code{@@end ifset} commands, like this:@refill - -@example -@group -@@ifset @var{flag} -@var{conditional-text} -@@end ifset -@end group -@end example - -For example, you can create one document that has two variants, such as -a manual for a `large' and `small' model:@refill - -@example -You can use this machine to dig up shrubs -without hurting them. - -@@set large - -@@ifset large -It can also dig up fully grown trees. -@@end ifset - -Remember to replant promptly @dots{} -@end example - -@noindent -In the example, the formatting commands will format the text between -@code{@@ifset large} and @code{@@end ifset} because the @code{large} -flag is set.@refill - -@findex clear -Use the @code{@@clear @var{flag}} command to turn off, or @dfn{clear}, -a flag. Clearing a flag is the opposite of setting a flag. The -command looks like this:@refill - -@example -@@clear @var{flag} -@end example - -@noindent -Write the command on a line of its own. - -When @var{flag} is cleared, the Texinfo formatting commands do -@emph{not} format the text between @code{@@ifset @var{flag}} and -@code{@@end ifset}; that text is ignored and does not appear in either -printed or Info output.@refill - -For example, if you clear the flag of the preceding example by writing -an @code{@@clear large} command after the @code{@@set large} command -(but before the conditional text), then the Texinfo formatting commands -ignore the text between the @code{@@ifset large} and @code{@@end ifset} -commands. In the formatted output, that text does not appear; in both -printed and Info output, you see only the lines that say, ``You can use -this machine to dig up shrubs without hurting them. Remember to replant -promptly @dots{}''. - -@findex ifclear -If a flag is cleared with an @code{@@clear @var{flag}} command, then -the formatting commands format text between subsequent pairs of -@code{@@ifclear} and @code{@@end ifclear} commands. But if the flag -is set with @code{@@set @var{flag}}, then the formatting commands do -@emph{not} format text between an @code{@@ifclear} and an @code{@@end -ifclear} command; rather, they ignore that text. An @code{@@ifclear} -command looks like this:@refill - -@example -@@ifclear @var{flag} -@end example - -@need 700 -In brief, the commands are:@refill - -@table @code -@item @@set @var{flag} -Tell the Texinfo formatting commands that @var{flag} is set.@refill - -@item @@clear @var{flag} -Tell the Texinfo formatting commands that @var{flag} is cleared.@refill - -@item @@ifset @var{flag} -If @var{flag} is set, tell the Texinfo formatting commands to format -the text up to the following @code{@@end ifset} command.@refill - -If @var{flag} is cleared, tell the Texinfo formatting commands to -ignore text up to the following @code{@@end ifset} command.@refill - -@item @@ifclear @var{flag} -If @var{flag} is set, tell the Texinfo formatting commands to ignore -the text up to the following @code{@@end ifclear} command.@refill - -If @var{flag} is cleared, tell the Texinfo formatting commands to -format the text up to the following @code{@@end ifclear} -command.@refill -@end table - -@node value, value Example, ifset ifclear, set clear value -@subsection @code{@@value} -@findex value - -You can use the @code{@@set} command to specify a value for a flag, -which is expanded by the @code{@@value} command. The value is a string -a characters. - -Write the @code{@@set} command like this: - -@example -@@set foo This is a string. -@end example - -@noindent -This sets the value of @code{foo} to ``This is a string.'' - -The Texinfo formatters replace an @code{@@value@{@var{flag}@}} command with -the string to which @var{flag} is set.@refill - -Thus, when @code{foo} is set as shown above, the Texinfo formatters convert - -@example -@group -@@value@{foo@} -@exdent @r{to} -This is a string. -@end group -@end example - -You can write an @code{@@value} command within a paragraph; but you -must write an @code{@@set} command on a line of its own. - -If you write the @code{@@set} command like this: - -@example -@@set foo -@end example - -@noindent -without specifying a string, the value of @code{foo} is an empty string. - -If you clear a previously set flag with an @code{@@clear @var{flag}} -command, a subsequent @code{@@value@{flag@}} command is invalid and the -string is replaced with an error message that says @samp{@{No value for -"@var{flag}"@}}. - -For example, if you set @code{foo} as follows:@refill - -@example -@@set how-much very, very, very -@end example - -@noindent -then the formatters transform - -@example -@group -It is a @@value@{how-much@} wet day. -@exdent @r{into} -It is a very, very, very wet day. -@end group -@end example - -If you write - -@example -@@clear how-much -@end example - -@noindent -then the formatters transform - -@example -@group -It is a @@value@{how-much@} wet day. -@exdent @r{into} -It is a @{No value for "how-much"@} wet day. -@end group -@end example - -@node value Example, , value, set clear value -@subsection @code{@@value} Example - -You can use the @code{@@value} command to limit the number of places you -need to change when you record an update to a manual. -Here is how it is done in @cite{The GNU Make Manual}: - -@need 1000 -@noindent -Set the flags: - -@example -@group -@@set EDITION 0.35 Beta -@@set VERSION 3.63 Beta -@@set UPDATED 14 August 1992 -@@set UPDATE-MONTH August 1992 -@end group -@end example - -@need 750 -@noindent -Write text for the first @code{@@ifinfo} section, for people reading the -Texinfo file: - -@example -@group -This is Edition @@value@{EDITION@}, -last updated @@value@{UPDATED@}, -of @@cite@{The GNU Make Manual@}, -for @@code@{make@}, Version @@value@{VERSION@}. -@end group -@end example - -@need 1000 -@noindent -Write text for the title page, for people reading the printed manual: -@c List only the month and the year since that looks less fussy on a -@c printed cover than a date that lists the day as well. - -@example -@group -@@title GNU Make -@@subtitle A Program for Directing Recompilation -@@subtitle Edition @@value@{EDITION@}, @dots{} -@@subtitle @@value@{UPDATE-MONTH@} -@end group -@end example - -@noindent -(On a printed cover, a date listing the month and the year looks less -fussy than a date listing the day as well as the month and year.) - -@need 750 -@noindent -Write text for the Top node, for people reading the Info file: - -@example -@group -This is Edition @@value@{EDITION@} -of the @@cite@{GNU Make Manual@}, -last updated @@value@{UPDATED@} -for @@code@{make@} Version @@value@{VERSION@}. -@end group -@end example - -@need 950 -After you format the manual, the text in the first @code{@@ifinfo} -section looks like this: - -@example -@group -This is Edition 0.35 Beta, last updated 14 August 1992, -of `The GNU Make Manual', for `make', Version 3.63 Beta. -@end group -@end example - -When you update the manual, change only the values of the flags; you do -not need to rewrite the three sections. - - -@node Macros, Format/Print Hardcopy, Conditionals, Top -@chapter Macros: Defining New Texinfo Commands -@cindex Macros -@cindex Defining new Texinfo commands -@cindex New Texinfo commands, defining -@cindex Texinfo commands, defining new -@cindex User-defined Texinfo commands - -A Texinfo @dfn{macro} allows you to define a new Texinfo command as any -sequence of text and/or existing commands (including other macros). The -macro can have any number of @dfn{parameters}---text you supply each -time you use the macro. (This has nothing to do with the -@code{@@defmac} command, which is for documenting macros in the subject -of the manual; @pxref{Def Cmd Template}.) - -@menu -* Defining Macros:: Both defining and undefining new commands. -* Invoking Macros:: Using a macro, once you've defined it. -@end menu - - -@node Defining Macros, Invoking Macros, Macros, Macros -@section Defining Macros -@cindex Defining macros -@cindex Macro definitions - -@findex macro -You use the Texinfo @code{@@macro} command to define a macro. For example: - -@example -@@macro @var{macro-name}@{@var{param1}, @var{param2}, @dots{}@} -@var{text} @dots{} \@var{param1}\ @dots{} -@@end macro -@end example - -The @dfn{parameters} @var{param1}, @var{param2}, @dots{} correspond to -arguments supplied when the macro is subsequently used in the document -(see the next section). - -If a macro needs no parameters, you can define it either with an empty -list (@samp{@@macro foo @{@}}) or with no braces at all (@samp{@@macro -foo}). - -@cindex Body of a macro -@cindex Mutually recursive macros -@cindex Recursion, mutual -The definition or @dfn{body} of the macro can contain any Texinfo -commands, including previously-defined macros. (It is not possible to -have mutually recursive Texinfo macros.) In the body, instances of a -parameter name surrounded by backslashes, as in @samp{\@var{param1}\} in -the example above, are replaced by the corresponding argument from the -macro invocation. - -@findex unmacro -@cindex Macros, undefining -@cindex Undefining macros -You can undefine a macro @var{foo} with @code{@@unmacro @var{foo}}. -It is not an error to undefine a macro that is already undefined. -For example: - -@example -@@unmacro foo -@end example - - -@node Invoking Macros, , Defining Macros, Macros -@section Invoking Macros -@cindex Invoking macros -@cindex Macro invocation - -After a macro is defined (see the previous section), you can use -(@dfn{invoke}) it in your document like this: - -@example -@@@var{macro-name} @{@var{arg1}, @var{arg2}, @dots{}@} -@end example - -@noindent -and the result will be just as if you typed the body of -@var{macro-name} at that spot. For example: - -@example -@@macro foo @{p, q@} -Together: \p\ & \q\. -@@end macro -@@foo@{a, b@} -@end example - -@noindent -produces: - -@display -Together: a & b. -@end display - -@cindex Backslash, and macros -Thus, the arguments and parameters are separated by commas and delimited -by braces; any whitespace after (but not before) a comma is ignored. To -insert a comma, brace, or backslash in an argument, prepend a backslash, -as in - -@example -@@@var{macro-name} @{\\\@{\@}\,@} -@end example - -@noindent -which will pass the (almost certainly error-producing) argument -@samp{\@{@},} to @var{macro-name}. - -If the macro is defined to take a single argument, and is invoked -without any braces, the entire rest of the line after the macro name is -supplied as the argument. For example: - -@example -@@macro bar @{p@} -Twice: \p\, \p\. -@@end macro -@@bar aah -@end example - -@noindent -produces: - -@display -Twice: aah, aah. -@end display - - -@node Format/Print Hardcopy, Create an Info File, Macros, Top -@comment node-name, next, previous, up -@chapter Format and Print Hardcopy -@cindex Format and print hardcopy -@cindex Hardcopy, printing it -@cindex Making a printed manual -@cindex Sorting indices -@cindex Indices, sorting -@cindex @TeX{} index sorting -@pindex texindex - -There are three major shell commands for making a printed manual from a -Texinfo file: one for converting the Texinfo file into a file that will be -printed, a second for sorting indices, and a third for printing the -formatted document. When you use the shell commands, you can either -work directly in the operating system shell or work within a shell -inside GNU Emacs.@refill - -If you are using GNU Emacs, you can use commands provided by Texinfo -mode instead of shell commands. In addition to the three commands to -format a file, sort the indices, and print the result, Texinfo mode -offers key bindings for commands to recenter the output buffer, show the -print queue, and delete a job from the print queue.@refill - -@menu -* Use TeX:: Use @TeX{} to format for hardcopy. -* Format with tex/texindex:: How to format in a shell. -* Format with texi2dvi:: A simpler way to use the shell. -* Print with lpr:: How to print. -* Within Emacs:: How to format and print from an Emacs shell. -* Texinfo Mode Printing:: How to format and print in Texinfo mode. -* Compile-Command:: How to print using Emacs's compile command. -* Requirements Summary:: @TeX{} formatting requirements summary. -* Preparing for TeX:: What you need to do to use @TeX{}. -* Overfull hboxes:: What are and what to do with overfull hboxes. -* smallbook:: How to print small format books and manuals. -* A4 Paper:: How to print on European A4 paper. -* Cropmarks and Magnification:: How to print marks to indicate the size - of pages and how to print scaled up output. -@end menu - -@node Use TeX, Format with tex/texindex, Format/Print Hardcopy, Format/Print Hardcopy -@ifinfo -@heading Use @TeX{} -@end ifinfo - -The typesetting program called @TeX{} is used for formatting a Texinfo -file. @TeX{} is a very powerful typesetting program and, if used right, -does an exceptionally good job. (@xref{Obtaining TeX, , How to Obtain -@TeX{}}, for information on how to obtain @TeX{}.) - -The @code{makeinfo}, @code{texinfo-format-region}, and -@code{texinfo-format-buffer} commands read the very same @@-commands -in the Texinfo file as does @TeX{}, but process them differently to -make an Info file; see @ref{Create an Info File}.@refill - -@node Format with tex/texindex, Format with texi2dvi, Use TeX, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Format using @code{tex} and @code{texindex} -@cindex Shell formatting with @code{tex} and @code{texindex} -@cindex Formatting with @code{tex} and @code{texindex} -@cindex DVI file - -Format the Texinfo file with the shell command @code{tex} followed by -the name of the Texinfo file. For example: - -@example -tex foo.texi -@end example - -@noindent -@TeX{} will produce a @dfn{DVI file} as well as several auxiliary -files containing information for indices, cross references, etc. The -DVI file (for @dfn{DeVice Independent} file) can be printed on virtually -any printe (see the following sections). - -@pindex texindex -The @code{tex} formatting command itself does not sort the indices; it -writes an output file of unsorted index data. (The @code{texi2dvi} -command automatically generates indices; see @ref{Format with texi2dvi,, -Format using @code{texi2dvi}}.) To generate a printed index after -running the @code{tex} command, you first need a sorted index to work -from. The @code{texindex} command sorts indices. (The source file -@file{texindex.c} comes as part of the standard Texinfo distribution, -among other places.)@refill - -@cindex Names of index files -The @code{tex} formatting command outputs unsorted index files under -names that obey a standard convention: the name of your main input file -with any @samp{.tex} (or similar, @pxref{tex invocation,,, web2c, -Web2c}) extension removed, followed by the two letter names of indices. -For example, the raw index output files for the input file -@file{foo.texinfo} would be @file{foo.cp}, @file{foo.vr}, @file{foo.fn}, -@file{foo.tp}, @file{foo.pg} and @file{foo.ky}. Those are exactly the -arguments to give to @code{texindex}.@refill - -@need 1000 -@cindex Wildcards -@cindex Globbing -Instead of specifying all the unsorted index file names explicitly, you -can use @samp{??} as shell wildcards and give the command in this -form:@refill - -@example -texindex foo.?? -@end example - -@noindent -This command will run @code{texindex} on all the unsorted index files, -including any that you have defined yourself using @code{@@defindex} -or @code{@@defcodeindex}. (You may execute @samp{texindex foo.??} -even if there are similarly named files with two letter extensions -that are not index files, such as @samp{foo.el}. The @code{texindex} -command reports but otherwise ignores such files.)@refill - -For each file specified, @code{texindex} generates a sorted index file -whose name is made by appending @samp{s} to the input file name. The -@code{@@printindex} command knows to look for a file of that name -(@pxref{Printing Indices & Menus}). @code{texindex} does not alter the -raw index output file.@refill - -After you have sorted the indices, you need to rerun the @code{tex} -formatting command on the Texinfo file. This regenerates the DVI file, -this time with up-to-date index entries. - -Finally, you may need to run @code{tex} one more time, to get the page -numbers in the cross-references correct. - -To summarize, this is a four step process: - -@enumerate -@item -Run @code{tex} on your Texinfo file. This generates a DVI file (with -undefined cross-references and no indices), and the raw index files -(with two letter extensions). - -@item -Run @code{texindex} on the raw index files. This creates the -corresponding sorted index files (with three letter extensions). - -@item -Run @code{tex} again on your Texinfo file. This regenerates the DVI -file, this time with indices and defined cross-references, but with page -numbers for the cross-references from last time, generally incorrect. - -@item -Run @code{tex} one last time. This time the correct page numbers are -written for the cross-references. -@end enumerate - -@pindex texi2dvi -Alternatively, it's a one-step process: run @code{texi2dvi}. - -You need not run @code{texindex} each time after you run @code{tex}. If -you do not, on the next run, the @code{tex} formatting command will use -whatever sorted index files happen to exist from the previous use of -@code{texindex}. This is usually ok while you are -debugging.@refill - - -@node Format with texi2dvi, Print with lpr, Format with tex/texindex, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Format using @code{texi2dvi} -@pindex texi2dvi @r{(shell script)} - -The @code{texi2dvi} command automatically runs both @code{tex} and -@code{texindex} as many times as necessary to produce a DVI file with -up-to-date, sorted indices. It simplifies the -@code{tex}---@code{texindex}---@code{tex} sequence described in the -previous section. - -The syntax for @code{texi2dvi} is like this (where @samp{prompt$} is your -shell prompt):@refill - -@example -prompt$ @kbd{texi2dvi @var{filename}@dots{}} -@end example - -For a list of options, run @samp{texi2dvi --help}. - - -@node Print with lpr, Within Emacs, Format with texi2dvi, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Shell Print Using @code{lpr -d} -@pindex lpr @r{(DVI print command)} - -The precise command to print a DVI file depends on your system -installation, but @samp{lpr -d} is common. The command may require the -DVI file name without any extension or with a @samp{.dvi} -extension. (If it is @samp{lpr}, you must include the @samp{.dvi}.) - -The following commands, for example, will (probably) suffice to sort the -indices, format, and print the @cite{Bison Manual}: - -@example -@group -tex bison.texinfo -texindex bison.?? -tex bison.texinfo -lpr -d bison.dvi -@end group -@end example - -@noindent -(Remember that the shell commands may be different at your site; but -these are commonly used versions.)@refill - -@need 1000 -Using the @code{texi2dvi} shell script, you simply need type:@refill - -@example -@group -texi2dvi bison.texinfo -lpr -d bison.dvi -@end group -@end example - -@node Within Emacs, Texinfo Mode Printing, Print with lpr, Format/Print Hardcopy -@comment node-name, next, previous, up -@section From an Emacs Shell -@cindex Print, format from Emacs shell -@cindex Format, print from Emacs shell -@cindex Shell, format, print from -@cindex Emacs shell, format, print from -@cindex GNU Emacs shell, format, print from - -You can give formatting and printing commands from a shell within GNU -Emacs. To create a shell within Emacs, type @kbd{M-x shell}. In this -shell, you can format and print the document. @xref{Format/Print -Hardcopy, , Format and Print Hardcopy}, for details.@refill - -You can switch to and from the shell buffer while @code{tex} is -running and do other editing. If you are formatting a long document -on a slow machine, this can be very convenient.@refill - -You can also use @code{texi2dvi} from an Emacs shell. For example, -here is how to use @code{texi2dvi} to format and print @cite{Using and -Porting GNU CC} from a shell within Emacs: - -@example -@group -texi2dvi gcc.texinfo -lpr -d gcc.dvi -@end group -@end example -@ifinfo - -@xref{Texinfo Mode Printing}, for more information about formatting -and printing in Texinfo mode.@refill -@end ifinfo - -@node Texinfo Mode Printing, Compile-Command, Within Emacs, Format/Print Hardcopy -@section Formatting and Printing in Texinfo Mode -@cindex Region printing in Texinfo mode -@cindex Format and print in Texinfo mode -@cindex Print and format in Texinfo mode - -Texinfo mode provides several predefined key commands for @TeX{} -formatting and printing. These include commands for sorting indices, -looking at the printer queue, killing the formatting job, and -recentering the display of the buffer in which the operations -occur.@refill - -@table @kbd -@item C-c C-t C-b -@itemx M-x texinfo-tex-buffer -Run @code{texi2dvi} on the current buffer.@refill - -@item C-c C-t C-r -@itemx M-x texinfo-tex-region -Run @TeX{} on the current region.@refill - -@item C-c C-t C-i -@itemx M-x texinfo-texindex -Sort the indices of a Texinfo file formatted with -@code{texinfo-tex-region}.@refill - -@item C-c C-t C-p -@itemx M-x texinfo-tex-print -Print a DVI file that was made with @code{texinfo-tex-region} or -@code{texinfo-tex-buffer}.@refill - -@item C-c C-t C-q -@itemx M-x tex-show-print-queue -Show the print queue.@refill - -@item C-c C-t C-d -@itemx M-x texinfo-delete-from-print-queue -Delete a job from the print queue; you will be prompted for the job -number shown by a preceding @kbd{C-c C-t C-q} command -(@code{texinfo-show-tex-print-queue}).@refill - -@item C-c C-t C-k -@itemx M-x tex-kill-job -Kill the currently running @TeX{} job started by -@code{texinfo-tex-region} or @code{texinfo-tex-buffer}, or any other -process running in the Texinfo shell buffer.@refill - -@item C-c C-t C-x -@itemx M-x texinfo-quit-job -Quit a @TeX{} formatting job that has stopped because of an error by -sending an @key{x} to it. When you do this, @TeX{} preserves a record -of what it did in a @file{.log} file.@refill - -@item C-c C-t C-l -@itemx M-x tex-recenter-output-buffer -Redisplay the shell buffer in which the @TeX{} printing and formatting -commands are run to show its most recent output.@refill -@end table - -@need 1000 -Thus, the usual sequence of commands for formatting a buffer is as -follows (with comments to the right):@refill - -@example -@group -C-c C-t C-b @r{Run @code{texi2dvi} on the buffer.} -C-c C-t C-p @r{Print the DVI file.} -C-c C-t C-q @r{Display the printer queue.} -@end group -@end example - -The Texinfo mode @TeX{} formatting commands start a subshell in Emacs -called the @file{*tex-shell*}. The @code{texinfo-tex-command}, -@code{texinfo-texindex-command}, and @code{tex-dvi-print-command} -commands are all run in this shell. - -You can watch the commands operate in the @samp{*tex-shell*} buffer, -and you can switch to and from and use the @samp{*tex-shell*} buffer -as you would any other shell buffer.@refill - -@need 1500 -The formatting and print commands depend on the values of several variables. -The default values are:@refill - -@example -@group - @r{Variable} @r{Default value} - -texinfo-texi2dvi-command "texi2dvi" -texinfo-tex-command "tex" -texinfo-texindex-command "texindex" -texinfo-delete-from-print-queue-command "lprm" -texinfo-tex-trailer "@@bye" -tex-start-of-header "%**start" -tex-end-of-header "%**end" -tex-dvi-print-command "lpr -d" -tex-show-queue-command "lpq" -@end group -@end example - -You can change the values of these variables with the @kbd{M-x -edit-options} command (@pxref{Edit Options, , Editing Variable Values, -xemacs, XEmacs User's Manual}), with the @kbd{M-x set-variable} command -(@pxref{Examining, , Examining and Setting Variables, xemacs, XEmacs -User's Manual}), or with your @file{.emacs} initialization file -(@pxref{Init File, , , xemacs, XEmacs User's Manual}).@refill - -@node Compile-Command, Requirements Summary, Texinfo Mode Printing, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Using the Local Variables List -@cindex Local variables -@cindex Compile command for formatting -@cindex Format with the compile command - -Yet another way to apply the @TeX{} formatting command to a Texinfo file -is to put that command in a @dfn{local variables list} at the end of the -Texinfo file. You can then specify the @code{tex} or @code{texi2dvi} -commands as a @code{compile-command} and have Emacs run it by typing -@kbd{M-x compile}. This creates a special shell called the -@file{*compilation*} buffer in which Emacs runs the compile command. -For example, at the end of the @file{gdb.texinfo} file, after the -@code{@@bye}, you could put the following:@refill - -@example -@group -Local Variables: -compile-command: "texi2dvi gdb.texinfo" -End: -@end group -@end example - -@noindent -This technique is most often used by programmers who also compile programs -this way; see @ref{Compilation, , , xemacs, XEmacs User's Manual}.@refill - - -@node Requirements Summary, Preparing for TeX, Compile-Command, Format/Print Hardcopy -@comment node-name, next, previous, up -@section @TeX{} Formatting Requirements Summary -@cindex Requirements for formatting -@cindex Minimal requirements for formatting -@cindex Formatting requirements - -Every Texinfo file that is to be input to @TeX{} must begin with a -@code{\input} command and must contain an @code{@@setfilename} command: - -@example -\input texinfo -@@setfilename @var{arg-not-used-by-@@TeX@{@}} -@end example - -@noindent -The first command instructs @TeX{} to load the macros it needs to -process a Texinfo file and the second command opens auxiliary files. - -Every Texinfo file must end with a line that terminates @TeX{}'s -processing and forces out unfinished pages: - -@example -@@bye -@end example - -Strictly speaking, these lines are all a Texinfo file needs to be -processed successfully by @TeX{}. - -Usually, however, the beginning includes an @code{@@settitle} command to -define the title of the printed manual, an @code{@@setchapternewpage} -command, a title page, a copyright page, and permissions. Besides an -@code{@@bye}, the end of a file usually includes indices and a table of -contents. (And of course most manuals contain a body of text as well.) - -@iftex -For more information, see -@ref{settitle, , @code{@@settitle}}, -@ref{setchapternewpage, , @code{@@setchapternewpage}}, -@ref{Headings, ,Page Headings}, -@ref{Titlepage & Copyright Page}, -@ref{Printing Indices & Menus}, and -@ref{Contents}. -@end iftex -@noindent -@ifinfo -For more information, see@* -@ref{settitle, , @code{@@settitle}},@* -@ref{setchapternewpage, , @code{@@setchapternewpage}},@* -@ref{Headings, ,Page Headings},@* -@ref{Titlepage & Copyright Page},@* -@ref{Printing Indices & Menus}, and@* -@ref{Contents}. -@end ifinfo - - -@node Preparing for TeX, Overfull hboxes, Requirements Summary, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Preparing to Use @TeX{} -@cindex Preparing to use @TeX{} -@cindex @TeX{} input initialization -@cindex @code{TEXINPUTS} environment variable -@vindex TEXINPUTS -@cindex @b{.profile} initialization file -@cindex @b{.cshrc} initialization file -@cindex Initialization file for @TeX{} input - -@TeX{} needs to know where to find the @file{texinfo.tex} file that you -have told it to input with the @samp{\input texinfo} command at the -beginning of the first line. The @file{texinfo.tex} file tells @TeX{} -how to handle @@-commands; it is included in all standard GNU -distributions. - -@pindex texinfo.tex@r{, installing} -Usually, the @file{texinfo.tex} file is put under the default directory -that contains @TeX{} macros -(@file{/usr/local/share/texmf/tex/texinfo/texinfo.tex} by default) when -GNU Emacs or other GNU software is installed. In this case, @TeX{} will -find the file and you do not need to do anything special. -Alternatively, you can put @file{texinfo.tex} in the current directory -when you run @TeX{}, and @TeX{} will find it there. - -@pindex epsf.tex@r{, installing} -Also, you should install @file{epsf.tex} in the same place as -@file{texinfo.tex}, if it is not already installed from another -distribution. This file is needed to support the @code{@@image} command -(@pxref{Images}). - -@pindex texinfo.cnf @r{installation} -@cindex Customizing of @TeX{} for Texinfo -@cindex Site-wide Texinfo configuration file -Optionally, you may create an additional @file{texinfo.cnf}, and install -it as well. This file is read by @TeX{} at the @code{@@setfilename} -command (@pxref{setfilename,, @code{@@setfilename}}). You can put any -commands you like there according to local site-wide conventions, and -they will be read by @TeX{} when processing any Texinfo document. For -example, if @file{texinfo.cnf} contains the a single line -@samp{@@afourpaper} (@pxref{A4 Paper}), then all Texinfo documents will -be processed with that page size in effect. If you have nothing to put -in @file{texinfo.cnf}, you do not need to create it. - -@vindex TEXINPUTS -If neither of the above locations for these system files suffice for -you, you can specify the directories explicitly. For -@file{texinfo.tex}, you can do this by writing the complete path for the -file after the @code{\input} command. Another way, that works for both -@file{texinfo.tex} and @file{texinfo.cnf} (and any other file @TeX{} -might read), is to set the @code{TEXINPUTS} environment variable in your -@file{.cshrc} or @file{.profile} file. - -Which you use of @file{.cshrc} or @file{.profile} depends on -whether you use a Bourne shell-compatible (@code{sh}, @code{bash}, -@code{ksh}, @dots{}) or C shell-compatible (@code{csh}, @code{tcsh}) -command interpreter. The latter read the @file{.cshrc} file for -initialization information, and the former read @file{.profile}. - -In a @file{.cshrc} file, you could use the following @code{csh} command -sequence: - -@example -setenv TEXINPUTS .:/home/me/mylib:/usr/lib/tex/macros -@end example - -@need 1000 -In a @file{.profile} file, you could use the following @code{sh} command -sequence: - -@example -@group -TEXINPUTS=.:/home/me/mylib:/usr/lib/tex/macros -export TEXINPUTS -@end group -@end example - -@noindent -This would cause @TeX{} to look for @file{\input} file first in the current -directory, indicated by the @samp{.}, then in a hypothetical user's -@file{me/mylib} directory, and finally in a system directory. - - -@node Overfull hboxes, smallbook, Preparing for TeX, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Overfull ``hboxes'' -@cindex Overfull @samp{hboxes} -@cindex @samp{hboxes}, overfull -@cindex Final output - -@TeX{} is sometimes unable to typeset a line without extending it into -the right margin. This can occur when @TeX{} comes upon what it -interprets as a long word that it cannot hyphenate, such as an -electronic mail network address or a very long title. When this -happens, @TeX{} prints an error message like this:@refill - -@example -Overfull \hbox (20.76302pt too wide) -@end example - -@noindent -(In @TeX{}, lines are in ``horizontal boxes'', hence the term, ``hbox''. -The backslash, @samp{\}, is the @TeX{} equivalent of @samp{@@}.)@refill - -@TeX{} also provides the line number in the Texinfo source file and -the text of the offending line, which is marked at all the places that -@TeX{} knows how to hyphenate words. -@xref{Debugging with TeX, , Catching Errors with @TeX{} Formatting}, -for more information about typesetting errors.@refill - -If the Texinfo file has an overfull hbox, you can rewrite the sentence -so the overfull hbox does not occur, or you can decide to leave it. A -small excursion into the right margin often does not matter and may not -even be noticeable.@refill - -@cindex Black rectangle in hardcopy -@cindex Rectangle, ugly, black in hardcopy -However, unless told otherwise, @TeX{} will print a large, ugly, black -rectangle beside the line that contains the overfull hbox. This is so -you will notice the location of the problem if you are correcting a -draft.@refill - -@need 1000 -@findex finalout -To prevent such a monstrosity from marring your final printout, write -the following in the beginning of the Texinfo file on a line of its own, -before the @code{@@titlepage} command:@refill - -@example -@@finalout -@end example - -@node smallbook, A4 Paper, Overfull hboxes, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Printing ``Small'' Books -@findex smallbook -@cindex Small book size -@cindex Book, printing small -@cindex Page sizes for books -@cindex Size of printed book - -By default, @TeX{} typesets pages for printing in an 8.5 by 11 inch -format. However, you can direct @TeX{} to typeset a document in a 7 by -9.25 inch format that is suitable for bound books by inserting the -following command on a line by itself at the beginning of the Texinfo -file, before the title page:@refill - -@example -@@smallbook -@end example - -@noindent -(Since regular sized books are often about 7 by 9.25 inches, this -command might better have been called the @code{@@regularbooksize} -command, but it came to be called the @code{@@smallbook} command by -comparison to the 8.5 by 11 inch format.)@refill - -If you write the @code{@@smallbook} command between the -start-of-header and end-of-header lines, the Texinfo mode @TeX{} -region formatting command, @code{texinfo-tex-region}, will format the -region in ``small'' book size (@pxref{Start of Header}).@refill - -The Free Software Foundation distributes printed copies of @cite{The GNU -Emacs Manual} and other manuals in the ``small'' book size. -@xref{smallexample & smalllisp, , @code{@@smallexample} and -@code{@@smalllisp}}, for information about commands that make it easier -to produce examples for a smaller manual.@refill - -Alternatively, to avoid embedding this physical paper size in your -document, use @code{texi2dvi} to format your document (@pxref{Format -with texi2dvi}), and supply @samp{-t @@smallbook} as an argument. Then -other people do not have to change the document source file to format it -differently. - - -@node A4 Paper, Cropmarks and Magnification, smallbook, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Printing on A4 Paper -@cindex A4 paper, printing on -@cindex Paper size, European A4 -@cindex European A4 paper -@findex afourpaper - -You can tell @TeX{} to typeset a document for printing on European size -A4 paper with the @code{@@afourpaper} command. Write the command on a -line by itself between @code{@@iftex} and @code{@@end iftex} lines near -the beginning of the Texinfo file, before the title page:@refill - -For example, this is how you would write the header for this manual:@refill - -@example -@group -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename texinfo -@@settitle Texinfo -@@syncodeindex vr fn -@@iftex -@@afourpaper -@@end iftex -@@c %**end of header -@end group -@end example - -Alternatively, to avoid embedding this physical paper size in your -document, use @code{texi2dvi} to format your document (@pxref{Format -with texi2dvi}), and supply @samp{-t @@afourpaper} as an argument. Then -other people do not have to change the document source file to format it -differently. - -@pindex texinfo.cnf -Another alternative: put the @code{@@afourpaper} command in the file -@file{texinfo.cnf} that @TeX{} will read. (No need for @code{@@iftex} -there.) This will automatically typeset all the Texinfo documents at -your site with that paper size in effect. - - -@node Cropmarks and Magnification, , A4 Paper, Format/Print Hardcopy -@comment node-name, next, previous, up -@section Cropmarks and Magnification - -@findex cropmarks -@cindex Cropmarks for printing -@cindex Printing cropmarks -You can attempt to direct @TeX{} to print cropmarks at the corners of -pages with the @code{@@cropmarks} command. Write the @code{@@cropmarks} -command on a line by itself between @code{@@iftex} and @code{@@end -iftex} lines near the beginning of the Texinfo file, before the title -page, like this:@refill - -@example -@group -@@iftex -@@cropmarks -@@end iftex -@end group -@end example - -This command is mainly for printers that typeset several pages on one -sheet of film; but you can attempt to use it to mark the corners of a -book set to 7 by 9.25 inches with the @code{@@smallbook} command. -(Printers will not produce cropmarks for regular sized output that is -printed on regular sized paper.) Since different printing machines work -in different ways, you should explore the use of this command with a -spirit of adventure. You may have to redefine the command in the -@file{texinfo.tex} definitions file.@refill - -@findex mag @r{(@TeX{} command)} -@cindex Magnified printing -@cindex Larger or smaller pages -You can attempt to direct @TeX{} to typeset pages larger or smaller than -usual with the @code{\mag} @TeX{} command. Everything that is typeset -is scaled proportionally larger or smaller. (@code{\mag} stands for -``magnification''.) This is @emph{not} a Texinfo @@-command, but is a -plain @TeX{} command that is prefixed with a backslash. You have to -write this command between @code{@@tex} and @code{@@end tex} -(@pxref{Raw Formatter Commands}). - -Follow the @code{\mag} command with an @samp{=} and then a number that -is 1000 times the magnification you desire. For example, to print pages -at 1.2 normal size, write the following near the beginning of the -Texinfo file, before the title page:@refill - -@example -@group -@@tex -\mag=1200 -@@end tex -@end group -@end example - -With some printing technologies, you can print normal-sized copies that -look better than usual by using a larger-than-normal master.@refill - -Depending on your system, @code{\mag} may not work or may work only at -certain magnifications. Be prepared to experiment.@refill - -@node Create an Info File, Install an Info File, Format/Print Hardcopy, Top -@comment node-name, next, previous, up -@chapter Creating an Info File -@cindex Creating an Info file -@cindex Info, creating an on-line file -@cindex Formatting a file for Info - -@code{makeinfo} is a utility that converts a Texinfo file into an Info -file; @code{texinfo-format-region} and @code{texinfo-format-buffer} are -GNU Emacs functions that do the same.@refill - -A Texinfo file must contain an @code{@@setfilename} line near its -beginning, otherwise the Info formatting commands will fail. - -For information on installing the Info file in the Info system, see -@ref{Install an Info File}.@refill - -@menu -* makeinfo advantages:: @code{makeinfo} provides better error checking. -* Invoking makeinfo:: How to run @code{makeinfo} from a shell. -* makeinfo options:: Specify fill-column and other options. -* Pointer Validation:: How to check that pointers point somewhere. -* makeinfo in Emacs:: How to run @code{makeinfo} from Emacs. -* texinfo-format commands:: Two Info formatting commands written - in Emacs Lisp are an alternative - to @code{makeinfo}. -* Batch Formatting:: How to format for Info in Emacs Batch mode. -* Tag and Split Files:: How tagged and split files help Info - to run better. -@end menu - -@node makeinfo advantages, Invoking makeinfo, Create an Info File, Create an Info File -@ifinfo -@heading @code{makeinfo} Preferred -@end ifinfo - -The @code{makeinfo} utility creates an Info file from a Texinfo source -file more quickly than either of the Emacs formatting commands and -provides better error messages. We recommend it. @code{makeinfo} is a -C program that is independent of Emacs. You do not need to run Emacs to -use @code{makeinfo}, which means you can use @code{makeinfo} on machines -that are too small to run Emacs. You can run @code{makeinfo} in -any one of three ways: from an operating system shell, from a shell -inside Emacs, or by typing a key command in Texinfo mode in Emacs. -@refill - -The @code{texinfo-format-region} and the @code{texinfo-format-buffer} -commands are useful if you cannot run @code{makeinfo}. Also, in some -circumstances, they format short regions or buffers more quickly than -@code{makeinfo}.@refill - -@node Invoking makeinfo, makeinfo options, makeinfo advantages, Create an Info File -@section Running @code{makeinfo} from a Shell - -To create an Info file from a Texinfo file, type @code{makeinfo} -followed by the name of the Texinfo file. Thus, to create the Info -file for Bison, type the following to the shell: -is the prompt):@refill - -@example -makeinfo bison.texinfo -@end example - -(You can run a shell inside Emacs by typing @kbd{M-x shell}.)@refill - -@ifinfo -Sometimes you will want to specify options. For example, if you wish -to discover which version of @code{makeinfo} you are using, -type:@refill - -@example -makeinfo --version -@end example - -@xref{makeinfo options}, for more information. -@end ifinfo - - -@node makeinfo options, Pointer Validation, Invoking makeinfo, Create an Info File -@comment node-name, next, previous, up -@section Options for @code{makeinfo} -@cindex @code{makeinfo} options -@cindex Options for @code{makeinfo} - -The @code{makeinfo} command takes a number of options. Most often, -options are used to set the value of the fill column and specify the -footnote style. Each command line option is a word preceded by -@samp{--} or a letter preceded by @samp{-}. You can use abbreviations -for the long option names as long as they are unique.@refill - -For example, you could use the following shell command to create an Info -file for @file{bison.texinfo} in which each line is filled to only 68 -columns:@refill - -@example -makeinfo --fill-column=68 bison.texinfo -@end example - -You can write two or more options in sequence, like this:@refill - -@example -makeinfo --no-split --fill-column=70 @dots{} -@end example - -@noindent -This would keep the Info file together as one possibly very long -file and would also set the fill column to 70.@refill - -The options are: - -@table @code - -@item -D @var{var} -@opindex -D @var{var} -Cause the variable @var{var} to be defined. This is equivalent to -@code{@@set @var{var}} in the Texinfo file (@pxref{set clear value}). - -@item --error-limit=@var{limit} -@opindex --error-limit=@var{limit} -Set the maximum number of errors that @code{makeinfo} will report -before exiting (on the assumption that continuing would be useless); -default 100. - -@need 150 -@item --fill-column=@var{width} -@opindex --fill-column=@var{width} -Specify the maximum number of columns in a line; this is the right-hand -edge of a line. Paragraphs that are filled will be filled to this -width. (Filling is the process of breaking up and connecting lines so -that lines are the same length as or shorter than the number specified -as the fill column. Lines are broken between words.) The default value -is 72. - -@item --footnote-style=@var{style} -@opindex --footnote-style=@var{style} -Set the footnote style to @var{style}, either @samp{end} for the end -node style (the default) or @samp{separate} for the separate node style. -The value set by this option overrides the value set in a Texinfo file -by an @code{@@footnotestyle} command (@pxref{Footnotes}). When the -footnote style is @samp{separate}, @code{makeinfo} makes a new node -containing the footnotes found in the current node. When the footnote -style is @samp{end}, @code{makeinfo} places the footnote references at -the end of the current node. - -@item --force -@opindex --force -Ordinarily, if the input file has errors, the output files are not -created. With this option, they are preserved. - -@item --help -@opindex --help -Print a usage message listing all available options, then exit successfully. - -@item -I @var{dir} -@opindex -I @var{dir} -Add @code{dir} to the directory search list for finding files that are -included using the @code{@@include} command. By default, -@code{makeinfo} searches only the current directory. - -@item --no-headers -@opindex --no-headers -Do not include menus or node lines in the output. This results in an -@sc{ascii} file that you cannot read in Info since it does not contain -the requisite nodes or menus. It is primarily useful to extract certain -pieces of a manual into separate files to be included in a distribution, -such as @file{INSTALL} files. - -@item --no-split -@opindex --no-split -Suppress the splitting stage of @code{makeinfo}. By default, large -output files (where the size is greater than 70k bytes) are split into -smaller subfiles, each one approximately 50k bytes. - -@item --no-pointer-validate -@itemx --no-validate -@opindex --no-pointer-validate -@opindex --no-validate -Suppress the pointer-validation phase of @code{makeinfo}. Normally, -after a Texinfo file is processed, some consistency checks are made to -ensure that cross references can be resolved, etc. -@xref{Pointer Validation}.@refill - -@item --no-warn -@opindex --no-warn -Suppress warning messages (but @emph{not} error messages). You might -want this if the file you are creating has examples of Texinfo cross -references within it, and the nodes that are referenced do not actually -exist. - -@item --no-number-footnotes -@opindex --no-number-footnotes -Suppress automatic footnote numbering. By default, @code{makeinfo} -numbers each footnote sequentially in a single node, resetting the -current footnote number to 1 at the start of each node. - -@item --output=@var{file} -@itemx -o @var{file} -@opindex --output=@var{file} -@opindex -o @var{file} -Specify that the output should be directed to @var{file} and not to the -file name specified in the @code{@@setfilename} command found in the -Texinfo source (@pxref{setfilename}). If @var{file} is @samp{-}, output -goes to standard output and @samp{--no-split} is implied. - -@item -P @var{dir} -@opindex -P @var{dir} -Prepend @code{dir} to the directory search list for @code{@@include}. -See @samp{-I} for more details. - -@item --paragraph-indent=@var{indent} -@opindex --paragraph-indent=@var{indent} -Set the paragraph indentation style to @var{indent}. The value set by -this option overrides the value set in a Texinfo file by an -@code{@@paragraphindent} command (@pxref{paragraphindent}). The value -of @var{indent} is interpreted as follows: - -@table @asis -@item @samp{asis} -Preserve any existing indentation at the starts of paragraphs. - -@item @samp{0} or @samp{none} -Delete any existing indentation. - -@item @var{num} -Indent each paragraph by that number of spaces. -@end table - -@item --reference-limit=@var{limit} -@opindex --reference-limit=@var{limit} -Set the value of the number of references to a node that -@code{makeinfo} will make without reporting a warning. If a node has more -than this number of references in it, @code{makeinfo} will make the -references but also report a warning. The default is 1000. - -@item -U @var{var} -Cause @var{var} to be undefined. This is equivalent to -@code{@@clear @var{var}} in the Texinfo file (@pxref{set clear value}). - -@item --verbose -@opindex --verbose -Cause @code{makeinfo} to display messages saying what it is doing. -Normally, @code{makeinfo} only outputs messages if there are errors or -warnings. - -@item --version -@opindex --version -Print the version number, then exit successfully. - -@end table - - -@node Pointer Validation, makeinfo in Emacs, makeinfo options, Create an Info File -@section Pointer Validation -@cindex Pointer validation with @code{makeinfo} -@cindex Validation of pointers - -If you do not suppress pointer-validation, @code{makeinfo} will check -the validity of the final Info file. Mostly, this means ensuring that -nodes you have referenced really exist. Here is a complete list of what -is checked:@refill - -@enumerate -@item -If a `Next', `Previous', or `Up' node reference is a reference to a -node in the current file and is not an external reference such as to -@file{(dir)}, then the referenced node must exist.@refill - -@item -In every node, if the `Previous' node is different from the `Up' node, -then the `Previous' node must also be pointed to by a `Next' node.@refill - -@item -Every node except the `Top' node must have an `Up' pointer.@refill - -@item -The node referenced by an `Up' pointer must contain a reference to the -current node in some manner other than through a `Next' reference. -This includes menu entries and cross references.@refill - -@item -If the `Next' reference of a node is not the same as the `Next' reference -of the `Up' reference, then the node referenced by the `Next' pointer -must have a `Previous' pointer that points back to the current node. -This rule allows the last node in a section to point to the first node -of the next chapter.@refill -@end enumerate - -@node makeinfo in Emacs, texinfo-format commands, Pointer Validation, Create an Info File -@section Running @code{makeinfo} inside Emacs -@cindex Running @code{makeinfo} in Emacs -@cindex @code{makeinfo} inside Emacs -@cindex Shell, running @code{makeinfo} in - -You can run @code{makeinfo} in GNU Emacs Texinfo mode by using either the -@code{makeinfo-region} or the @code{makeinfo-buffer} commands. In -Texinfo mode, the commands are bound to @kbd{C-c C-m C-r} and @kbd{C-c -C-m C-b} by default.@refill - -@table @kbd -@item C-c C-m C-r -@itemx M-x makeinfo-region -Format the current region for Info.@refill -@findex makeinfo-region - -@item C-c C-m C-b -@itemx M-x makeinfo-buffer -Format the current buffer for Info.@refill -@findex makeinfo-buffer -@end table - -When you invoke either @code{makeinfo-region} or -@code{makeinfo-buffer}, Emacs prompts for a file name, offering the -name of the visited file as the default. You can edit the default -file name in the minibuffer if you wish, before pressing @key{RET} to -start the @code{makeinfo} process.@refill - -The Emacs @code{makeinfo-region} and @code{makeinfo-buffer} commands -run the @code{makeinfo} program in a temporary shell buffer. If -@code{makeinfo} finds any errors, Emacs displays the error messages in -the temporary buffer.@refill - -@cindex Errors, parsing -@cindex Parsing errors -@findex next-error -You can parse the error messages by typing @kbd{C-x `} -(@code{next-error}). This causes Emacs to go to and position the -cursor on the line in the Texinfo source that @code{makeinfo} thinks -caused the error. @xref{Compilation, , Running @code{make} or -Compilers Generally, xemacs, XEmacs User's Manual}, for more -information about using the @code{next-error} command.@refill - -In addition, you can kill the shell in which the @code{makeinfo} -command is running or make the shell buffer display its most recent -output.@refill - -@table @kbd -@item C-c C-m C-k -@itemx M-x makeinfo-kill-job -@findex makeinfo-kill-job -Kill the current running @code{makeinfo} job created by -@code{makeinfo-region} or @code{makeinfo-buffer}.@refill - -@item C-c C-m C-l -@itemx M-x makeinfo-recenter-output-buffer -@findex makeinfo-recenter-output-buffer -Redisplay the @code{makeinfo} shell buffer to display its most recent -output.@refill -@end table - -@noindent -(Note that the parallel commands for killing and recentering a @TeX{} -job are @kbd{C-c C-t C-k} and @kbd{C-c C-t C-l}. @xref{Texinfo Mode -Printing}.)@refill - -You can specify options for @code{makeinfo} by setting the -@code{makeinfo-options} variable with either the @kbd{M-x -edit-options} or the @kbd{M-x set-variable} command, or by setting the -variable in your @file{.emacs} initialization file.@refill - -For example, you could write the following in your @file{.emacs} file:@refill - -@example -@group -(setq makeinfo-options - "--paragraph-indent=0 --no-split - --fill-column=70 --verbose") -@end group -@end example - -@c If you write these three cross references using xref, you see -@c three references to the same named manual, which looks strange. -@iftex -For more information, see @ref{makeinfo options, , Options for -@code{makeinfo}}, as well as ``Editing Variable Values,''``Examining and -Setting Variables,'' and ``Init File'' in the @cite{The GNU Emacs -Manual}. -@end iftex -@noindent -@ifinfo -For more information, see@* -@ref{Edit Options, , Editing Variable Values, xemacs, XEmacs User's Manual},@* -@ref{Examining, , Examining and Setting Variables, xemacs, XEmacs User's Manual},@* -@ref{Init File, , , xemacs, XEmacs User's Manual}, and@* -@ref{makeinfo options, , Options for @code{makeinfo}}. -@end ifinfo - -@node texinfo-format commands, Batch Formatting, makeinfo in Emacs, Create an Info File -@comment node-name, next, previous, up -@section The @code{texinfo-format@dots{}} Commands -@findex texinfo-format-region -@findex texinfo-format-buffer - -In GNU Emacs in Texinfo mode, you can format part or all of a Texinfo -file with the @code{texinfo-format-region} command. This formats the -current region and displays the formatted text in a temporary buffer -called @samp{*Info Region*}.@refill - -Similarly, you can format a buffer with the -@code{texinfo-format-buffer} command. This command creates a new -buffer and generates the Info file in it. Typing @kbd{C-x C-s} will -save the Info file under the name specified by the -@code{@@setfilename} line which must be near the beginning of the -Texinfo file.@refill - -@table @kbd -@item C-c C-e C-r -@itemx @code{texinfo-format-region} -Format the current region for Info. -@findex texinfo-format-region - -@item C-c C-e C-b -@itemx @code{texinfo-format-buffer} -Format the current buffer for Info. -@findex texinfo-format-buffer -@end table - -The @code{texinfo-format-region} and @code{texinfo-format-buffer} -commands provide you with some error checking, and other functions can -provide you with further help in finding formatting errors. These -procedures are described in an appendix; see @ref{Catching Mistakes}. -However, the @code{makeinfo} program is often faster and -provides better error checking (@pxref{makeinfo in Emacs}).@refill - -@node Batch Formatting, Tag and Split Files, texinfo-format commands, Create an Info File -@comment node-name, next, previous, up -@section Batch Formatting -@cindex Batch formatting for Info -@cindex Info batch formatting - -You can format Texinfo files for Info using @code{batch-texinfo-format} -and Emacs Batch mode. You can run Emacs in Batch mode from any shell, -including a shell inside of Emacs. (@xref{Command Switches, , Command -Line Switches and Arguments, xemacs, XEmacs User's Manual}.)@refill - -Here is a shell command to format all the files that end in -@file{.texinfo} in the current directory: - -@example -emacs -batch -funcall batch-texinfo-format *.texinfo -@end example - -@noindent -Emacs processes all the files listed on the command line, even if an -error occurs while attempting to format some of them.@refill - -Run @code{batch-texinfo-format} only with Emacs in Batch mode as shown; -it is not interactive. It kills the Batch mode Emacs on completion.@refill - -@code{batch-texinfo-format} is convenient if you lack @code{makeinfo} -and want to format several Texinfo files at once. When you use Batch -mode, you create a new Emacs process. This frees your current Emacs, so -you can continue working in it. (When you run -@code{texinfo-format-region} or @code{texinfo-format-buffer}, you cannot -use that Emacs for anything else until the command finishes.)@refill - -@node Tag and Split Files, , Batch Formatting, Create an Info File -@comment node-name, next, previous, up -@section Tag Files and Split Files -@cindex Making a tag table automatically -@cindex Tag table, making automatically - -If a Texinfo file has more than 30,000 bytes, -@code{texinfo-format-buffer} automatically creates a tag table -for its Info file; @code{makeinfo} always creates a tag table. With -a @dfn{tag table}, Info can jump to new nodes more quickly than it can -otherwise.@refill - -@cindex Indirect subfiles -In addition, if the Texinfo file contains more than about 70,000 -bytes, @code{texinfo-format-buffer} and @code{makeinfo} split the -large Info file into shorter @dfn{indirect} subfiles of about 50,000 -bytes each. Big files are split into smaller files so that Emacs does -not need to make a large buffer to hold the whole of a large Info -file; instead, Emacs allocates just enough memory for the small, split -off file that is needed at the time. This way, Emacs avoids wasting -memory when you run Info. (Before splitting was implemented, Info -files were always kept short and @dfn{include files} were designed as -a way to create a single, large printed manual out of the smaller Info -files. @xref{Include Files}, for more information. Include files are -still used for very large documents, such as @cite{The XEmacs Lisp -Reference Manual}, in which each chapter is a separate file.)@refill - -When a file is split, Info itself makes use of a shortened version of -the original file that contains just the tag table and references to -the files that were split off. The split off files are called -@dfn{indirect} files.@refill - -The split off files have names that are created by appending @w{@samp{-1}}, -@w{@samp{-2}}, @w{@samp{-3}} and so on to the file name specified by the -@code{@@setfilename} command. The shortened version of the original file -continues to have the name specified by @code{@@setfilename}.@refill - -At one stage in writing this document, for example, the Info file was saved -as @file{test-texinfo} and that file looked like this:@refill - -@example -@group -Info file: test-texinfo, -*-Text-*- -produced by texinfo-format-buffer -from file: new-texinfo-manual.texinfo - -^_ -Indirect: -test-texinfo-1: 102 -test-texinfo-2: 50422 -@end group -@group -test-texinfo-3: 101300 -^_^L -Tag table: -(Indirect) -Node: overview^?104 -Node: info file^?1271 -@end group -@group -Node: printed manual^?4853 -Node: conventions^?6855 -@dots{} -@end group -@end example - -@noindent -(But @file{test-texinfo} had far more nodes than are shown here.) Each of -the split off, indirect files, @file{test-texinfo-1}, -@file{test-texinfo-2}, and @file{test-texinfo-3}, is listed in this file -after the line that says @samp{Indirect:}. The tag table is listed after -the line that says @samp{Tag table:}. @refill - -In the list of indirect files, the number following the file name -records the cumulative number of bytes in the preceding indirect files, -not counting the file list itself, the tag table, or the permissions -text in each file. In the tag table, the number following the node name -records the location of the beginning of the node, in bytes from the -beginning.@refill - -If you are using @code{texinfo-format-buffer} to create Info files, -you may want to run the @code{Info-validate} command. (The -@code{makeinfo} command does such a good job on its own, you do not -need @code{Info-validate}.) However, you cannot run the @kbd{M-x -Info-validate} node-checking command on indirect files. For -information on how to prevent files from being split and how to -validate the structure of the nodes, see @ref{Using -Info-validate}.@refill - - -@node Install an Info File, Command List, Create an Info File, Top -@comment node-name, next, previous, up -@chapter Installing an Info File -@cindex Installing an Info file -@cindex Info file installation -@cindex @file{dir} directory for Info installation - -Info files are usually kept in the @file{info} directory. You can read -Info files using the standalone Info program or the Info reader built -into Emacs. (@inforef{Top, info, info}, for an introduction to Info.) - -@menu -* Directory file:: The top level menu for all Info files. -* New Info File:: Listing a new info file. -* Other Info Directories:: How to specify Info files that are - located in other directories. -* Installing Dir Entries:: How to specify what menu entry to add - to the Info directory. -* Invoking install-info:: @code{install-info} options. -@end menu - -@node Directory file, New Info File, Install an Info File, Install an Info File -@ifinfo -@heading The @file{dir} File -@end ifinfo - -For Info to work, the @file{info} directory must contain a file that -serves as a top level directory for the Info system. By convention, -this file is called @file{dir}. (You can find the location of this file -within Emacs by typing @kbd{C-h i} to enter Info and then typing -@kbd{C-x C-f} to see the pathname to the @file{info} directory.) - -The @file{dir} file is itself an Info file. It contains the top level -menu for all the Info files in the system. The menu looks like -this:@refill - -@example -@group -* Menu: - -* Info: (info). Documentation browsing system. -* Emacs: (emacs). The extensible, self-documenting - text editor. -* Texinfo: (texinfo). With one source file, make - either a printed manual using - TeX or an Info file. -@dots{} -@end group -@end example - -Each of these menu entries points to the `Top' node of the Info file -that is named in parentheses. (The menu entry does not need to -specify the `Top' node, since Info goes to the `Top' node if no node -name is mentioned. @xref{Other Info Files, , Nodes in Other Info -Files}.)@refill - -Thus, the @samp{Info} entry points to the `Top' node of the -@file{info} file and the @samp{Emacs} entry points to the `Top' node -of the @file{emacs} file.@refill - -In each of the Info files, the `Up' pointer of the `Top' node refers -back to the @code{dir} file. For example, the line for the `Top' -node of the Emacs manual looks like this in Info:@refill - -@example -File: emacs Node: Top, Up: (DIR), Next: Distrib -@end example - -@noindent -(Note that in this case, the @file{dir} file name is written in upper -case letters---it can be written in either upper or lower case. Info -has a feature that it will change the case of the file name to lower -case if it cannot find the name as written.)@refill -@c !!! Can any file name be written in upper or lower case, -@c or is dir a special case? -@c Yes, apparently so, at least with Gillespie's Info. --rjc 24mar92 - - -@node New Info File, Other Info Directories, Directory file, Install an Info File -@section Listing a New Info File -@cindex Adding a new info file -@cindex Listing a new info file -@cindex New info file, listing it in @file{dir} file -@cindex Info file, listing new one -@cindex @file{dir} file listing - -To add a new Info file to your system, you must write a menu entry to -add to the menu in the @file{dir} file in the @file{info} directory. -For example, if you were adding documentation for GDB, you would write -the following new entry:@refill - -@example -* GDB: (gdb). The source-level C debugger. -@end example - -@noindent -The first part of the menu entry is the menu entry name, followed by a -colon. The second part is the name of the Info file, in parentheses, -followed by a period. The third part is the description. - -The name of an Info file often has a @file{.info} extension. Thus, the -Info file for GDB might be called either @file{gdb} or @file{gdb.info}. -The Info reader programs automatically try the file name both with and -without @file{.info}; so it is better to avoid clutter and not to write -@samp{.info} explicitly in the menu entry. For example, the GDB menu -entry should use just @samp{gdb} for the file name, not @samp{gdb.info}. - - -@node Other Info Directories, Installing Dir Entries, New Info File, Install an Info File -@comment node-name, next, previous, up -@section Info Files in Other Directories -@cindex Installing Info in another directory -@cindex Info installed in another directory -@cindex Another Info directory - -If an Info file is not in the @file{info} directory, there are three -ways to specify its location:@refill - -@itemize @bullet -@item -Write the pathname in the @file{dir} file as the second part of the -menu.@refill - -@item -If you are using Emacs, list the name of the file in a second @file{dir} -file, in its directory; and then add the name of that directory to the -@code{Info-directory-list} variable in your personal or site -initialization file. - -This tells Emacs where to look for @file{dir} files. Emacs merges the -files named @file{dir} from each of the listed directories. (In Emacs -version 18, you can set the @code{Info-directory} variable to the name -of only one directory.)@refill - -@item -Specify the Info directory name in the @code{INFOPATH} environment -variable in your @file{.profile} or @file{.cshrc} initialization file. -(Only you and others who set this environment variable will be able to -find Info files whose location is specified this way.)@refill -@end itemize - -For example, to reach a test file in the @file{/home/bob/manuals} -directory, you could add an entry like this to the menu in the -@file{dir} file:@refill - -@example -* Test: (/home/bob/manuals/info-test). Bob's own test file. -@end example - -@noindent -In this case, the absolute file name of the @file{info-test} file is -written as the second part of the menu entry.@refill - -@vindex Info-directory-list -Alternatively, you could write the following in your @file{.emacs} -file:@refill - -@example -@group -(setq Info-directory-list - '("/home/bob/manuals" - "/usr/local/info")) -@end group -@end example - -@c reworded to avoid overfill hbox -This tells Emacs to merge the @file{dir} file from the -@file{/home/bob/manuals} directory with the @file{dir} file from the -@file{/usr/local/info} directory. Info will list the -@file{/home/bob/manuals/info-test} file as a menu entry in the -@file{/home/bob/manuals/dir} file.@refill - -@vindex INFOPATH -Finally, you can tell Info where to look by setting the @code{INFOPATH} -environment variable in your @file{.cshrc} or @file{.profile} file. If -you use a Bourne-compatible shell such as @code{sh} or @code{bash} for -your shell command interpreter, you set the @code{INFOPATH} environment -variable in the @file{.profile} initialization file; but if you use -@code{csh} or @code{tcsh}, you must set the variable in the -@file{.cshrc} initialization file. The two types of shells use -different syntax. - -@itemize @bullet -@item -In a @file{.cshrc} file, you could set the @code{INFOPATH} -variable as follows:@refill - -@smallexample -setenv INFOPATH .:~/manuals:/usr/local/emacs/info -@end smallexample - -@item -In a @file{.profile} file, you would achieve the same effect by -writing:@refill - -@smallexample -INFOPATH=.:$HOME/manuals:/usr/local/emacs/info -export INFOPATH -@end smallexample -@end itemize - -@noindent -The @samp{.} indicates the current directory as usual. Emacs uses the -@code{INFOPATH} environment variable to initialize the value of Emacs's -own @code{Info-directory-list} variable. - -@cindex colon @r{last in @code{INFOPATH}} -However you set @code{INFOPATH}, if its last character is a colon, this -is replaced by the default (compiled-in) path. This gives you a way to -augment the default path with new directories without having to list all -the standard places. For example (using @code{sh} syntax: - -@example -INFOPATH=/local/info: -export INFOPATH -@end example - -@noindent -will search @file{/local/info} first, then the standard directories. -Leading or doubled colons are not treated specially. - - -@node Installing Dir Entries, Invoking install-info, Other Info Directories, Install an Info File -@section Installing Info Directory Files - -When you install an Info file onto your system, you can use the program -@code{install-info} to update the Info directory file @file{dir}. -Normally the makefile for the package runs @code{install-info}, just -after copying the Info file into its proper installed location. - -@findex dircategory -@findex direntry -In order for the Info file to work with @code{install-info}, you should -use the commands @code{@@dircategory} and @code{@@direntry} in the -Texinfo source file. Use @code{@@direntry} to specify the menu entry to -add to the Info directory file, and use @code{@@dircategory} to specify -which part of the Info directory to put it in. Here is how these -commands are used in this manual: - -@smallexample -@@dircategory Texinfo documentation system -@@direntry -* Texinfo: (texinfo). The GNU documentation format. -* install-info: (texinfo)Invoking install-info. @dots{} -@dots{} -@@end direntry -@end smallexample - -Here's what this produces in the Info file: - -@smallexample -INFO-DIR-SECTION Texinfo documentation system -START-INFO-DIR-ENTRY -* Texinfo: (texinfo). The GNU documentation format. -* install-info: (texinfo)Invoking install-info. @dots{} -@dots{} -END-INFO-DIR-ENTRY -@end smallexample - -@noindent -The @code{install-info} program sees these lines in the Info file, and -that is how it knows what to do. - -Always use the @code{@@direntry} and @code{@@dircategory} commands near -the beginning of the Texinfo input, before the first @code{@@node} -command. If you use them later on in the input, @code{install-info} -will not notice them. - -If you use @code{@@dircategory} more than once in the Texinfo source, -each usage specifies one category; the new menu entry is added to the -Info directory file in each of the categories you specify. If you use -@code{@@direntry} more than once, each usage specifies one menu entry; -each of these menu entries is added to the directory in each of the -specified categories. - - -@node Invoking install-info, , Installing Dir Entries, Install an Info File -@section Invoking install-info - -@pindex install-info - -@code{install-info} inserts menu entries from an Info file into the -top-level @file{dir} file in the Info system (see the previous sections -for an explanation of how the @file{dir} file works). It's most often -run as part of software installation, or when constructing a dir file -for all manuals on a system. Synopsis: - -@example -install-info [@var{option}]@dots{} [@var{info-file} [@var{dir-file}]] -@end example - -If @var{info-file} or @var{dir-file} are not specified, the various -options (described below) that define them must be. There are no -compile-time defaults, and standard input is never used. -@code{install-info} can read only one info file and write only one dir -file per invocation. - -@cindex @file{dir}, created by @code{install-info} -If @var{dir-file} (however specified) does not exist, -@code{install-info} creates it if possible (with no entries). - -Options: - -@table @code -@item --delete -@opindex --delete -Delete the entries in @var{info-file} from @var{dir-file}. The file -name in the entry in @var{dir-file} must be @var{info-file} (except for -an optional @samp{.info} in either one). Don't insert any new entries. - -@item --dir-file=@var{name} -@opindex --dir-file=@var{name} -Specify file name of the Info directory file. This is equivalent to -using the @var{dir-file} argument. - -@item --entry=@var{text} -@opindex --entry=@var{text} -Insert @var{text} as an Info directory entry; @var{text} should have the -form of an Info menu item line plus zero or more extra lines starting -with whitespace. If you specify more than one entry, they are all -added. If you don't specify any entries, they are determined from -information in the Info file itself. - -@item --help -@opindex --help -Display a usage message listing basic usage and all available options, -then exit successfully. - -@item --info-file=@var{file} -@opindex --info-file=@var{file} -Specify Info file to install in the directory. -This is equivalent to using the @var{info-file} argument. - -@item --info-dir=@var{dir} -@opindex --info-dir=@var{dir} -Equivalent to @samp{--dir-file=@var{dir}/dir}. - -@item --item=@var{text} -@opindex --item=@var{text} -Same as @samp{--entry=@var{text}}. An Info directory entry is actually -a menu item. - -@item --quiet -@opindex --quiet -Suppress warnings. - -@item --remove -@opindex --remove -Same as @samp{--delete}. - -@item --section=@var{sec} -@opindex --section=@var{sec} -Put this file's entries in section @var{sec} of the directory. If you -specify more than one section, all the entries are added in each of the -sections. If you don't specify any sections, they are determined from -information in the Info file itself. - -@item --version -@opindex --version -@cindex version number, finding -Display version information and exit successfully. - -@end table - - -@node Command List, Tips, Install an Info File, Top -@appendix @@-Command List -@cindex Alphabetical @@-command list -@cindex List of @@-commands -@cindex @@-command list - -Here is an alphabetical list of the @@-commands in Texinfo. Square -brackets, @t{[}@w{ }@t{]}, indicate optional arguments; an ellipsis, -@samp{@dots{}}, indicates repeated text.@refill - -@sp 1 -@table @code -@item @@@var{whitespace} -An @code{@@} followed by a space, tab, or newline produces a normal, -stretchable, interword space. @xref{Multiple Spaces}. - -@item @@! -Generate an exclamation point that really does end a sentence (usually -after an end-of-sentence capital letter). @xref{Ending a Sentence}. - -@item @@" -@itemx @@' -Generate an umlaut or acute accent, respectively, over the next -character, as in @"o and @'o. @xref{Inserting Accents}. - -@item @@* -Force a line break. Do not end a paragraph that uses @code{@@*} with -an @code{@@refill} command. @xref{Line Breaks}.@refill - -@item @@,@{@var{c}@} -Generate a cedilla accent under @var{c}, as in @,{c}. @xref{Inserting -Accents}. - -@item @@- -Insert a discretionary hyphenation point. @xref{- and hyphenation}. - -@item @@. -Produce a period that really does end a sentence (usually after an -end-of-sentence capital letter). @xref{Ending a Sentence}. - -@item @@: -Indicate to @TeX{} that an immediately preceding period, question -mark, exclamation mark, or colon does not end a sentence. Prevent -@TeX{} from inserting extra whitespace as it does at the end of a -sentence. The command has no effect on the Info file output. -@xref{Not Ending a Sentence}.@refill - -@item @@= -Generate a macro (bar) accent over the next character, as in @=o. -@xref{Inserting Accents}. - -@item @@? -Generate a question mark that really does end a sentence (usually after -an end-of-sentence capital letter). @xref{Ending a Sentence}. - -@item @@@@ -Stands for an at sign, @samp{@@}. -@xref{Braces Atsigns, , Inserting @@ and braces}. - -@item @@^ -@itemx @@` -Generate a circumflex (hat) or grave accent, respectively, over the next -character, as in @^o. -@xref{Inserting Accents}. - -@item @@@{ -Stands for a left brace, @samp{@{}. -@xref{Braces Atsigns, , Inserting @@ and braces}. - -@item @@@} -Stands for a right-hand brace, @samp{@}}.@* -@xref{Braces Atsigns, , Inserting @@ and braces}. - -@item @@= -Generate a tilde accent over the next character, as in @~N. -@xref{Inserting Accents}. - -@item @@AA@{@} -@itemx @@aa@{@} -Generate the uppercase and lowercase Scandinavian A-ring letters, -respectively: @AA{}, @aa{}. @xref{Inserting Accents}. - -@item @@AE@{@} -@itemx @@ae@{@} -Generate the uppercase and lowercase AE ligatures, respectively: -@AE{}, @ae{}. @xref{Inserting Accents}. - -@item @@afourpaper -Change page dimensions for the A4 paper size. -Only allowed inside @code{@@iftex} @dots{} @code{@@end iftex}. -@xref{A4 Paper}. - -@item @@appendix @var{title} -Begin an appendix. The title appears in the table -of contents of a printed manual. In Info, the title is -underlined with asterisks. @xref{unnumbered & appendix, , The -@code{@@unnumbered} and @code{@@appendix} Commands}.@refill - -@item @@appendixsec @var{title} -@itemx @@appendixsection @var{title} -Begin an appendix section within an appendix. The section title appears -in the table of contents of a printed manual. In Info, the title is -underlined with equal signs. @code{@@appendixsection} is a longer -spelling of the @code{@@appendixsec} command. @xref{unnumberedsec -appendixsec heading, , Section Commands}.@refill - -@item @@appendixsubsec @var{title} -Begin an appendix subsection within an appendix. The title appears -in the table of contents of a printed manual. In Info, the title is -underlined with hyphens. @xref{unnumberedsubsec appendixsubsec -subheading, , Subsection Commands}.@refill - -@item @@appendixsubsubsec @var{title} -Begin an appendix subsubsection within an appendix subsection. The -title appears in the table of contents of a printed manual. In Info, -the title is underlined with periods. @xref{subsubsection,, The -`subsub' Commands}.@refill - -@item @@asis -Used following @code{@@table}, @code{@@ftable}, and @code{@@vtable} to -print the table's first column without highlighting (``as is''). -@xref{Two-column Tables, , Making a Two-column Table}.@refill - -@item @@author @var{author} -Typeset @var{author} flushleft and underline it. @xref{title -subtitle author, , The @code{@@title} and @code{@@author} -Commands}.@refill - -@item @@b@{@var{text}@} -Print @var{text} in @b{bold} font. No effect in Info. @xref{Fonts}.@refill - -@ignore -@item @@br -Force a paragraph break. If used within a line, follow @code{@@br} -with braces. @xref{br, , @code{@@br}}.@refill -@end ignore - -@item @@bullet@{@} -Generate a large round dot, or the closest possible -thing to one. @xref{bullet, , @code{@@bullet}}.@refill - -@item @@bye -Stop formatting a file. The formatters do not see the contents of a -file following an @code{@@bye} command. @xref{Ending a File}.@refill - -@item @@c @var{comment} -Begin a comment in Texinfo. The rest of the line does not appear in -either the Info file or the printed manual. A synonym for -@code{@@comment}. @xref{Comments, , Comments}.@refill - -@item @@cartouche -Highlight an example or quotation by drawing a box with rounded -corners around it. Pair with @code{@@end cartouche}. No effect in -Info. @xref{cartouche, , Drawing Cartouches Around Examples}.)@refill - -@item @@center @var{line-of-text} -Center the line of text following the command. -@xref{titlefont center sp, , @code{@@center}}.@refill - -@item @@centerchap @var{line-of-text} -Like @code{@@chapter}, but centers the chapter title. @xref{chapter,, -@code{@@chapter}}. - -@item @@chapheading @var{title} -Print a chapter-like heading in the text, but not in the table of -contents of a printed manual. In Info, the title is underlined with -asterisks. @xref{majorheading & chapheading, , @code{@@majorheading} -and @code{@@chapheading}}.@refill - -@item @@chapter @var{title} -Begin a chapter. The chapter title appears in the table of -contents of a printed manual. In Info, the title is underlined with -asterisks. @xref{chapter, , @code{@@chapter}}.@refill - -@item @@cindex @var{entry} -Add @var{entry} to the index of concepts. @xref{Index Entries, , -Defining the Entries of an Index}.@refill - -@item @@cite@{@var{reference}@} -Highlight the name of a book or other reference that lacks a -companion Info file. @xref{cite, , @code{@@cite}}.@refill - -@item @@clear @var{flag} -Unset @var{flag}, preventing the Texinfo formatting commands from -formatting text between subsequent pairs of @code{@@ifset @var{flag}} -and @code{@@end ifset} commands, and preventing -@code{@@value@{@var{flag}@}} from expanding to the value to which -@var{flag} is set. -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@item @@code@{@var{sample-code}@} -Highlight text that is an expression, a syntactically complete token -of a program, or a program name. @xref{code, , @code{@@code}}.@refill - -@item @@comment @var{comment} -Begin a comment in Texinfo. The rest of the line does not appear in -either the Info file or the printed manual. A synonym for @code{@@c}. -@xref{Comments, , Comments}.@refill - -@item @@contents -Print a complete table of contents. Has no effect in Info, which uses -menus instead. @xref{Contents, , Generating a Table of -Contents}.@refill - -@item @@copyright@{@} -Generate a copyright symbol. @xref{copyright symbol, , -@code{@@copyright}}.@refill - -@ignore -@item @@ctrl@{@var{ctrl-char}@} -Describe an @sc{ascii} control character. Insert actual control character -into Info file. @xref{ctrl, , @code{@@ctrl}}.@refill -@end ignore - -@item @@defcodeindex @var{index-name} -Define a new index and its indexing command. Print entries in an -@code{@@code} font. @xref{New Indices, , Defining New -Indices}.@refill - -@item @@defcv @var{category} @var{class} @var{name} -@itemx @@defcvx @var{category} @var{class} @var{name} -Format a description for a variable associated with a class in -object-oriented programming. Takes three arguments: the category of -thing being defined, the class to which it belongs, and its name. -@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}. - -@item @@deffn @var{category} @var{name} @var{arguments}@dots{} -@itemx @@deffnx @var{category} @var{name} @var{arguments}@dots{} -Format a description for a function, interactive command, or similar -entity that may take arguments. @code{@@deffn} takes as arguments the -category of entity being described, the name of this particular -entity, and its arguments, if any. @xref{Definition Commands}.@refill - -@item @@defindex @var{index-name} -Define a new index and its indexing command. Print entries in a roman -font. @xref{New Indices, , Defining New Indices}.@refill - -@c Unused so far as I can see and unsupported by makeinfo -- karl, 15sep96. -@item @@definfoenclose @var{new-command}, @var{before}, @var{after}, -Create new @@-command for Info that marks text by enclosing it in -strings that precede and follow the text. Write definition inside of -@code{@@ifinfo} @dots{} @code{@@end ifinfo}. @xref{Customized -Highlighting}.@refill - -@item @@defivar @var{class} @var{instance-variable-name} -@itemx @@defivarx @var{class} @var{instance-variable-name} -This command formats a description for an instance variable in -object-oriented programming. The command is equivalent to @samp{@@defcv -@{Instance Variable@} @dots{}}. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defmac @var{macro-name} @var{arguments}@dots{} -@itemx @@defmacx @var{macro-name} @var{arguments}@dots{} -Format a description for a macro. The command is equivalent to -@samp{@@deffn Macro @dots{}}. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defmethod @var{class} @var{method-name} @var{arguments}@dots{} -@itemx @@defmethodx @var{class} @var{method-name} @var{arguments}@dots{} -Format a description for a method in object-oriented programming. The -command is equivalent to @samp{@@defop Method @dots{}}. Takes as -arguments the name of the class of the method, the name of the -method, and its arguments, if any. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{} -@itemx @@defopx @var{category} @var{class} @var{name} @var{arguments}@dots{} -Format a description for an operation in object-oriented programming. -@code{@@defop} takes as arguments the overall name of the category of -operation, the name of the class of the operation, the name of the -operation, and its arguments, if any. @xref{Definition -Commands}, and @ref{deffnx,, Def Cmds in Detail}. - -@item @@defopt @var{option-name} -@itemx @@defoptx @var{option-name} -Format a description for a user option. The command is equivalent to -@samp{@@defvr @{User Option@} @dots{}}. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defspec @var{special-form-name} @var{arguments}@dots{} -@itemx @@defspecx @var{special-form-name} @var{arguments}@dots{} -Format a description for a special form. The command is equivalent to -@samp{@@deffn @{Special Form@} @dots{}}. @xref{Definition Commands}, -and @ref{deffnx,, Def Cmds in Detail}. - -@item @@deftp @var{category} @var{name-of-type} @var{attributes}@dots{} -@itemx @@deftpx @var{category} @var{name-of-type} @var{attributes}@dots{} -Format a description for a data type. @code{@@deftp} takes as arguments -the category, the name of the type (which is a word like @samp{int} or -@samp{float}), and then the names of attributes of objects of that type. -@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}. - -@item @@deftypefn @var{classification} @var{data-type} @var{name} @var{arguments}@dots{} -@itemx @@deftypefnx @var{classification} @var{data-type} @var{name} @var{arguments}@dots{} -Format a description for a function or similar entity that may take -arguments and that is typed. @code{@@deftypefn} takes as arguments the -classification of entity being described, the type, the name of the -entity, and its arguments, if any. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@deftypefun @var{data-type} @var{function-name} @var{arguments}@dots{} -@itemx @@deftypefunx @var{data-type} @var{function-name} @var{arguments}@dots{} -Format a description for a function in a typed language. -The command is equivalent to @samp{@@deftypefn Function @dots{}}. -@xref{Definition Commands}, -and @ref{deffnx,, Def Cmds in Detail}. - -@item @@deftypemethod @var{class} @var{data-type} @var{method-name} @var{arguments}@dots{} -@itemx @@deftypemethodx @var{class} @var{data-type} @var{method-name} @var{arguments}@dots{} -Format a description for a typed method in object-oriented programming. -Takes as arguments the name of the class of the method, the return type -of the method, the name of the method, and its arguments, if any. -@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}. - -@item @@deftypevr @var{classification} @var{data-type} @var{name} -@itemx @@deftypevrx @var{classification} @var{data-type} @var{name} -Format a description for something like a variable in a typed -language---an entity that records a value. Takes as arguments the -classification of entity being described, the type, and the name of the -entity. @xref{Definition Commands}, and @ref{deffnx,, Def Cmds in -Detail}. - -@item @@deftypevar @var{data-type} @var{variable-name} -@itemx @@deftypevarx @var{data-type} @var{variable-name} -Format a description for a variable in a typed language. The command is -equivalent to @samp{@@deftypevr Variable @dots{}}. @xref{Definition -Commands}, and @ref{deffnx,, Def Cmds in Detail}. - -@item @@defun @var{function-name} @var{arguments}@dots{} -@itemx @@defunx @var{function-name} @var{arguments}@dots{} -Format a description for functions. The command is equivalent to -@samp{@@deffn Function @dots{}}. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defvar @var{variable-name} -@itemx @@defvarx @var{variable-name} -Format a description for variables. The command is equivalent to -@samp{@@defvr Variable @dots{}}. @xref{Definition Commands}, and -@ref{deffnx,, Def Cmds in Detail}. - -@item @@defvr @var{category} @var{name} -@itemx @@defvrx @var{category} @var{name} -Format a description for any kind of variable. @code{@@defvr} takes -as arguments the category of the entity and the name of the entity. -@xref{Definition Commands}, -and @ref{deffnx,, Def Cmds in Detail}. - -@item @@detailmenu@{@} -Avoid @code{makeinfo} confusion stemming from the detailed node listing -in a master menu. @xref{Master Menu Parts}. - -@item @@dfn@{@var{term}@} -Highlight the introductory or defining use of a term. -@xref{dfn, , @code{@@dfn}}.@refill - -@item @@dircategory @var{dirpart} -Specify a part of the Info directory menu where this file's entry should -go. @xref{Installing Dir Entries}. - -@item @@direntry -Begin the Info directory menu entry for this file. -@xref{Installing Dir Entries}. - -@need 100 -@item @@display -Begin a kind of example. Indent text, do not fill, do not select a -new font. Pair with @code{@@end display}. @xref{display, , -@code{@@display}}.@refill - -@item @@dmn@{@var{dimension}@} -Format a unit of measure, as in 12@dmn{pt}. Causes @TeX{} to insert a -thin space before @var{dimension}. No effect in Info. -@xref{dmn, , @code{@@dmn}}.@refill - -@item @@dotaccent@{@var{c}@} -Generate a dot accent over the character @var{c}, as in @dotaccent{oo}. -@xref{Inserting Accents}. - -@item @@dots@{@} -Insert an ellipsis: @samp{@dots{}}. -@xref{dots, , @code{@@dots@{@}}}.@refill - -@item @@email@{@var{address}[, @var{displayed-text}]@} -Indicate an electronic mail address. -@xref{email, , @code{@@email}}.@refill - -@need 100 -@item @@emph@{@var{text}@} -Highlight @var{text}; text is displayed in @emph{italics} in printed -output, and surrounded by asterisks in Info. @xref{Emphasis, , -Emphasizing Text}. - -@item @@end @var{environment} -Ends @var{environment}, as in @samp{@@end example}. @xref{Formatting -Commands,,@@-commands}. - -@item @@enddots@{@} -Generate an end-of-sentence of ellipsis, like this @enddots{} -@xref{dots,,@code{@@dots@{@}}}. - -@need 100 -@item @@enumerate [@var{number-or-letter}] -Begin a numbered list, using @code{@@item} for each entry. -Optionally, start list with @var{number-or-letter}. Pair with -@code{@@end enumerate}. @xref{enumerate, , -@code{@@enumerate}}.@refill - -@need 100 -@item @@equiv@{@} -Indicate to the reader the exact equivalence of two forms with a -glyph: @samp{@equiv{}}. @xref{Equivalence}.@refill - -@item @@error@{@} -Indicate to the reader with a glyph that the following text is -an error message: @samp{@error{}}. @xref{Error Glyph}.@refill - -@item @@evenfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -@itemx @@evenheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page footings resp.@: headings for even-numbered (left-hand) -pages. Only allowed inside @code{@@iftex}. @xref{Custom Headings, , -How to Make Your Own Headings}.@refill - -@item @@everyfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -@itemx @@everyheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page footings resp.@: headings for every page. Not relevant to -Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill - -@item @@example -Begin an example. Indent text, do not fill, and select fixed-width font. -Pair with @code{@@end example}. @xref{example, , -@code{@@example}}.@refill - -@item @@exclamdown@{@} -Produce an upside-down exclamation point. @xref{Inserting Accents}. - -@item @@exdent @var{line-of-text} -Remove any indentation a line might have. @xref{exdent, , -Undoing the Indentation of a Line}.@refill - -@item @@expansion@{@} -Indicate the result of a macro expansion to the reader with a special -glyph: @samp{@expansion{}}. -@xref{expansion, , @expansion{} Indicating an Expansion}.@refill - -@item @@file@{@var{filename}@} -Highlight the name of a file, buffer, node, or directory. @xref{file, , -@code{@@file}}.@refill - -@item @@finalout -Prevent @TeX{} from printing large black warning rectangles beside -over-wide lines. @xref{Overfull hboxes}.@refill - -@need 100 -@item @@findex @var{entry} -Add @var{entry} to the index of functions. @xref{Index Entries, , -Defining the Entries of an Index}.@refill - -@need 200 -@item @@flushleft -@itemx @@flushright -Left justify every line but leave the right end ragged. -Leave font as is. Pair with @code{@@end flushleft}. -@code{@@flushright} analogous. -@xref{flushleft & flushright, , @code{@@flushleft} and -@code{@@flushright}}.@refill - -@need 200 -@item @@footnote@{@var{text-of-footnote}@} -Enter a footnote. Footnote text is printed at the bottom of the page -by @TeX{}; Info may format in either `End' node or `Separate' node style. -@xref{Footnotes}.@refill - -@item @@footnotestyle @var{style} -Specify an Info file's footnote style, either @samp{end} for the end -node style or @samp{separate} for the separate node style. -@xref{Footnotes}.@refill - -@item @@format -Begin a kind of example. Like @code{@@example} or @code{@@display}, -but do not narrow the margins and do not select the fixed-width font. -Pair with @code{@@end format}. @xref{example, , -@code{@@example}}.@refill - -@item @@ftable @var{formatting-command} -Begin a two-column table, using @code{@@item} for each entry. -Automatically enter each of the items in the first column into the -index of functions. Pair with @code{@@end ftable}. The same as -@code{@@table}, except for indexing. @xref{ftable vtable, , -@code{@@ftable} and @code{@@vtable}}.@refill - -@item @@group -Hold text together that must appear on one printed page. Pair with -@code{@@end group}. Not relevant to Info. @xref{group, , -@code{@@group}}.@refill - -@item @@H@{@var{c}@} -Generate the long Hungarian umlaut accent over @var{c}, as in @H{o}. - -@item @@heading @var{title} -Print an unnumbered section-like heading in the text, but not in the -table of contents of a printed manual. In Info, the title is -underlined with equal signs. @xref{unnumberedsec appendixsec heading, -, Section Commands}.@refill - -@item @@headings @var{on-off-single-double} -Turn page headings on or off, and/or specify single-sided or double-sided -page headings for printing. @xref{headings on off, , The -@code{@@headings} Command}. - -@item @@html -Enter HTML completely. Pair with @code{@@end html}. @xref{Raw -Formatter Commands}. - -@item @@hyphenation@{@var{hy-phen-a-ted words}@} -Explicitly define hyphenation points. @xref{- and hyphenation,, -@code{@@-} and @code{@@hyphenation}}. - -@item @@i@{@var{text}@} -Print @var{text} in @i{italic} font. No effect in Info. -@xref{Fonts}.@refill - -@item @@ifclear @var{flag} -If @var{flag} is cleared, the Texinfo formatting commands format text -between @code{@@ifclear @var{flag}} and the following @code{@@end -ifclear} command. -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@item @@ifhtml -@itemx @@ifinfo -Begin a stretch of text that will be ignored by @TeX{} when it typesets -the printed manual. The text appears only in the HTML resp.@: Info -file. Pair with @code{@@end ifhtml} resp.@: @code{@@end ifinfo}. -@xref{Conditionals}. - -@item @@ifnothtml -@itemx @@ifnotinfo -@itemx @@ifnottex -Begin a stretch of text that will be ignored in one output format but -not the others. The text appears only in the format not specified. -Pair with @code{@@end ifnothtml} resp.@: @code{@@end ifnotinfo} resp.@: -@code{@@end ifnotinfo}. @xref{Conditionals}. - -@item @@ifset @var{flag} -If @var{flag} is set, the Texinfo formatting commands format text -between @code{@@ifset @var{flag}} and the following @code{@@end ifset} -command. -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@item @@iftex -Begin a stretch of text that will not appear in the Info file, but -will be processed only by @TeX{}. Pair with @code{@@end iftex}. -@xref{Conditionals, , Conditionally Visible Text}.@refill - -@item @@ignore -Begin a stretch of text that will not appear in either the Info file -or the printed output. Pair with @code{@@end ignore}. -@xref{Comments, , Comments and Ignored Text}.@refill - -@item @@image@{@var{filename}, [@var{width}], [@var{height}]@} -Include graphics image in external @var{filename} scaled to the given -@var{width} and/or @var{height}. @xref{Images}. - -@item @@include @var{filename} -Incorporate the contents of the file @var{filename} into the Info file -or printed document. @xref{Include Files}.@refill - -@item @@inforef@{@var{node-name}, [@var{entry-name}], @var{info-file-name}@} -Make a cross reference to an Info file for which there is no printed -manual. @xref{inforef, , Cross references using -@code{@@inforef}}.@refill - -@item \input @var{macro-definitions-file} -Use the specified macro definitions file. This command is used only -in the first line of a Texinfo file to cause @TeX{} to make use of the -@file{texinfo} macro definitions file. The backslash in @code{\input} -is used instead of an @code{@@} because @TeX{} does not -recognize @code{@@} until after it has read the definitions file. -@xref{Header, , The Texinfo File Header}.@refill - -@item @@item -Indicate the beginning of a marked paragraph for @code{@@itemize} and -@code{@@enumerate}; indicate the beginning of the text of a first column -entry for @code{@@table}, @code{@@ftable}, and @code{@@vtable}. -@xref{Lists and Tables}.@refill - -@item @@itemize @var{mark-generating-character-or-command} -Produce a sequence of indented paragraphs, with a mark inside the left -margin at the beginning of each paragraph. Pair with @code{@@end -itemize}. @xref{itemize, , @code{@@itemize}}.@refill - -@item @@itemx -Like @code{@@item} but do not generate extra vertical space above the -item text. @xref{itemx, , @code{@@itemx}}.@refill - -@item @@kbd@{@var{keyboard-characters}@} -Indicate text that is characters of input to be typed by -users. @xref{kbd, , @code{@@kbd}}.@refill - -@item @@kbdinputstyle @var{style} -Specify when @code{@@kbd} should use a font distinct from @code{@@code}. -@xref{kbd, , @code{@@kbd}}.@refill - -@item @@key@{@var{key-name}@} -Indicate a name for a key on a keyboard. -@xref{key, , @code{@@key}}.@refill - -@item @@kindex @var{entry} -Add @var{entry} to the index of keys. -@xref{Index Entries, , Defining the Entries of an Index}.@refill - -@item @@L@{@} -@itemx @@l@{@} -Generate the uppercase and lowercase Polish suppressed-L letters, -respectively: @L{}, @l{}. - -@c Possibly this can be tossed now that we have macros. --karl, 16sep96. -@c Yes, let's toss it, it's pretty weird. --karl, 15jun97. -@c @item @@global@@let@var{new-command}=@var{existing-command} -@c Equate a new highlighting command with an existing one. Only for -@c @TeX{}. Write definition inside of @code{@@iftex} @dots{} @code{@@end -@c iftex}. @xref{Customized Highlighting}.@refill - -@item @@lisp -Begin an example of Lisp code. Indent text, do not fill, and select -fixed-width font. Pair with @code{@@end lisp}. @xref{Lisp Example, , -@code{@@lisp}}.@refill - -@item @@lowersections -Change subsequent chapters to sections, sections to subsections, and so -on. @xref{Raise/lower sections, , @code{@@raisesections} and -@code{@@lowersections}}.@refill - -@item @@macro @var{macro-name} @{@var{params}@} -Define a new Texinfo command @code{@@@var{macro-name}@{@var{params}@}}. -Only supported by @code{makeinfo} and @code{texi2dvi}. @xref{Defining -Macros}. - -@item @@majorheading @var{title} -Print a chapter-like heading in the text, but not in the table of -contents of a printed manual. Generate more vertical whitespace before -the heading than the @code{@@chapheading} command. In Info, the chapter -heading line is underlined with asterisks. @xref{majorheading & -chapheading, , @code{@@majorheading} and @code{@@chapheading}}.@refill - -@item @@math@{@var{mathematical-expression}@} -Format a mathematical expression. -@xref{math, , @code{@@math} - Inserting Mathematical Expressions}. - -@item @@menu -Mark the beginning of a menu of nodes in Info. No effect in a printed -manual. Pair with @code{@@end menu}. @xref{Menus}.@refill - -@item @@minus@{@} -Generate a minus sign, `@minus{}'. @xref{minus, , @code{@@minus}}.@refill - -@item @@multitable @var{column-width-spec} -Begin a multi-column table. Pair with @code{@@end multitable}. -@xref{Multitable Column Widths}. - -@item @@need @var{n} -Start a new page in a printed manual if fewer than @var{n} mils -(thousandths of an inch) remain on the current page. @xref{need, , -@code{@@need}}.@refill - -@item @@node @var{name, next, previous, up} -Define the beginning of a new node in Info, and serve as a locator for -references for @TeX{}. @xref{node, , @code{@@node}}.@refill - -@item @@noindent -Prevent text from being indented as if it were a new paragraph. -@xref{noindent, , @code{@@noindent}}.@refill - -@item @@O@{@} -@itemx @@o@{@} -Generate the uppercase and lowercase O-with-slash letters, respectively: -@O{}, @o{}. - -@item @@oddfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -@itemx @@oddheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page footings resp.@: headings for odd-numbered (right-hand) -pages. Only allowed inside @code{@@iftex}. @xref{Custom Headings, , -How to Make Your Own Headings}.@refill - -@item @@OE@{@} -@itemx @@oe@{@} -Generate the uppercase and lowercase OE ligatures, respectively: -@OE{}, @oe{}. @xref{Inserting Accents}. - -@item @@page -Start a new page in a printed manual. No effect in Info. -@xref{page, , @code{@@page}}.@refill - -@item @@paragraphindent @var{indent} -Indent paragraphs by @var{indent} number of spaces; delete indentation -if the value of @var{indent} is 0; and do not change indentation if -@var{indent} is @code{asis}. @xref{paragraphindent, , Paragraph -Indenting}.@refill - -@item @@pindex @var{entry} -Add @var{entry} to the index of programs. @xref{Index Entries, , Defining -the Entries of an Index}.@refill - -@item @@point@{@} -Indicate the position of point in a buffer to the reader with a -glyph: @samp{@point{}}. @xref{Point Glyph, , Indicating -Point in a Buffer}.@refill - -@item @@pounds@{@} -Generate the pounds sterling currency sign. -@xref{pounds,,@code{@@pounds@{@}}}. - -@item @@print@{@} -Indicate printed output to the reader with a glyph: -@samp{@print{}}. @xref{Print Glyph}.@refill - -@item @@printindex @var{index-name} -Print an alphabetized two-column index in a printed manual or generate -an alphabetized menu of index entries for Info. @xref{Printing -Indices & Menus}.@refill - -@item @@pxref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@} -Make a reference that starts with a lower case `see' in a printed -manual. Use within parentheses only. Do not follow command with a -punctuation mark---the Info formatting commands automatically insert -terminating punctuation as needed. Only the first argument is mandatory. -@xref{pxref, , @code{@@pxref}}.@refill - -@item @@questiondown@{@} -Generate an upside-down question mark. @xref{Inserting Accents}. - -@item @@quotation -Narrow the margins to indicate text that is quoted from another real -or imaginary work. Write command on a line of its own. Pair with -@code{@@end quotation}. @xref{quotation, , -@code{@@quotation}}.@refill - -@need 100 -@item @@r@{@var{text}@} -Print @var{text} in @r{roman} font. No effect in Info. -@xref{Fonts}.@refill - -@item @@raisesections -Change subsequent sections to chapters, subsections to sections, and so -on. @xref{Raise/lower sections, , @code{@@raisesections} and -@code{@@lowersections}}.@refill - -@need 300 -@item @@ref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@} -Make a reference. In a printed manual, the reference does not start -with a `See'. Follow command with a punctuation mark. Only the first -argument is mandatory. @xref{ref, , @code{@@ref}}.@refill - -@need 300 -@item @@refill -In Info, refill and indent the paragraph after all the other processing -has been done. No effect on @TeX{}, which always refills. This command -is no longer needed, since all formatters now automatically refill. -@xref{Refilling Paragraphs}.@refill - -@need 300 -@item @@result@{@} -Indicate the result of an expression to the reader with a special -glyph: @samp{@result{}}. @xref{result, , @code{@@result}}.@refill - -@item @@ringaccent@{@var{c}@} -Generate a ring accent over the next character, as in @ringaccent{o}. -@xref{Inserting Accents}. - -@item @@samp@{@var{text}@} -Highlight @var{text} that is a literal example of a sequence of -characters. Used for single characters, for statements, and often for -entire shell commands. @xref{samp, , @code{@@samp}}.@refill - -@item @@sc@{@var{text}@} -Set @var{text} in a printed output in @sc{the small caps font} and -set text in the Info file in uppercase letters. -@xref{Smallcaps}.@refill - -@item @@section @var{title} -Begin a section within a chapter. In a printed manual, the section -title is numbered and appears in the table of contents. In Info, the -title is underlined with equal signs. @xref{section, , -@code{@@section}}.@refill - -@item @@set @var{flag} [@var{string}] -Make @var{flag} active, causing the Texinfo formatting commands to -format text between subsequent pairs of @code{@@ifset @var{flag}} and -@code{@@end ifset} commands. Optionally, set value of @var{flag} to -@var{string}. -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@item @@setchapternewpage @var{on-off-odd} -Specify whether chapters start on new pages, and if so, whether on -odd-numbered (right-hand) new pages. @xref{setchapternewpage, , -@code{@@setchapternewpage}}.@refill - -@item @@setfilename @var{info-file-name} -Provide a name to be used by the Info file. This command is essential -for @TeX{} formatting as well, even though it produces no output. -@xref{setfilename, , @code{@@setfilename}}.@refill - -@item @@settitle @var{title} -Provide a title for page headers in a printed manual. -@xref{settitle, , @code{@@settitle}}.@refill - -@item @@shortcontents -Print a short table of contents. Not relevant to Info, which uses -menus rather than tables of contents. A synonym for -@code{@@summarycontents}. @xref{Contents, , Generating a Table of -Contents}.@refill - -@item @@shorttitlepage@{@var{title}@} -Generate a minimal title page. @xref{titlepage,,@code{@@titlepage}}. - -@need 400 -@item @@smallbook -Cause @TeX{} to produce a printed manual in a 7 by 9.25 inch format -rather than the regular 8.5 by 11 inch format. @xref{smallbook, , -Printing Small Books}. Also, see @ref{smallexample & smalllisp, , -@code{@@smallexample} and @code{@@smalllisp}}.@refill - -@need 400 -@item @@smallexample -Indent text to indicate an example. Do not fill, select fixed-width -font. In @code{@@smallbook} format, print text in a smaller font than -with @code{@@example}. Pair with @code{@@end smallexample}. -@xref{smallexample & smalllisp, , @code{@@smallexample} and -@code{@@smalllisp}}.@refill - -@need 400 -@item @@smalllisp -Begin an example of Lisp code. Indent text, do not fill, select -fixed-width font. In @code{@@smallbook} format, print text in a -smaller font. Pair with @code{@@end smalllisp}. @xref{smallexample & -smalllisp, , @code{@@smallexample} and @code{@@smalllisp}}.@refill - -@need 700 -@item @@sp @var{n} -Skip @var{n} blank lines. @xref{sp, , @code{@@sp}}.@refill - -@item @@ss@{@} -Generate the German sharp-S es-zet letter, @ss{}. @xref{Inserting Accents}. - -@need 700 -@item @@strong @var{text} -Emphasize @var{text} by typesetting it in a @strong{bold} font for the -printed manual and by surrounding it with asterisks for Info. -@xref{emph & strong, , Emphasizing Text}.@refill - -@item @@subheading @var{title} -Print an unnumbered subsection-like heading in the text, but not in -the table of contents of a printed manual. In Info, the title is -underlined with hyphens. @xref{unnumberedsubsec appendixsubsec -subheading, , @code{@@unnumberedsubsec} @code{@@appendixsubsec} -@code{@@subheading}}.@refill - -@item @@subsection @var{title} -Begin a subsection within a section. In a printed manual, the -subsection title is numbered and appears in the table of contents. In -Info, the title is underlined with hyphens. @xref{subsection, , -@code{@@subsection}}.@refill - -@item @@subsubheading @var{title} -Print an unnumbered subsubsection-like heading in the text, but not in -the table of contents of a printed manual. In Info, the title is -underlined with periods. @xref{subsubsection, , The `subsub' -Commands}.@refill - -@item @@subsubsection @var{title} -Begin a subsubsection within a subsection. In a printed manual, -the subsubsection title is numbered and appears in the table of -contents. In Info, the title is underlined with periods. -@xref{subsubsection, , The `subsub' Commands}.@refill - -@item @@subtitle @var{title} -In a printed manual, set a subtitle in a normal sized font flush to -the right-hand side of the page. Not relevant to Info, which does not -have title pages. @xref{title subtitle author, , @code{@@title} -@code{@@subtitle} and @code{@@author} Commands}.@refill - -@item @@summarycontents -Print a short table of contents. Not relevant to Info, which uses -menus rather than tables of contents. A synonym for -@code{@@shortcontents}. @xref{Contents, , Generating a Table of -Contents}.@refill - -@need 300 -@item @@syncodeindex @var{from-index} @var{into-index} -Merge the index named in the first argument into the index named in -the second argument, printing the entries from the first index in -@code{@@code} font. @xref{Combining Indices}.@refill - -@need 300 -@item @@synindex @var{from-index} @var{into-index} -Merge the index named in the first argument into the index named in -the second argument. Do not change the font of @var{from-index} -entries. @xref{Combining Indices}.@refill - -@need 100 -@item @@t@{@var{text}@} -Print @var{text} in a @t{fixed-width}, typewriter-like font. -No effect in Info. @xref{Fonts}.@refill - -@item @@tab -Separate columns in a multitable. @xref{Multitable Rows}. - -@need 400 -@item @@table @var{formatting-command} -Begin a two-column table, using @code{@@item} for each entry. Write -each first column entry on the same line as @code{@@item}. First -column entries are printed in the font resulting from -@var{formatting-command}. Pair with @code{@@end table}. -@xref{Two-column Tables, , Making a Two-column Table}. -Also see @ref{ftable vtable, , @code{@@ftable} and @code{@@vtable}}, -and @ref{itemx, , @code{@@itemx}}.@refill - -@item @@TeX@{@} -Insert the logo @TeX{}. @xref{TeX and copyright, , Inserting @TeX{} -and @copyright{}}.@refill - -@item @@tex -Enter @TeX{} completely. Pair with @code{@@end tex}. @xref{Raw -Formatter Commands}. - -@item @@thischapter -@itemx @@thischaptername -@itemx @@thisfile -@itemx @@thispage -@itemx @@thistitle -Only allowed in a heading or footing. Stands for the number and name of -the current chapter (in the format `Chapter 1: Title'), the chapter name -only, the filename, the current page number, and the title of the -document, respectively. @xref{Custom Headings, , How to Make Your Own -Headings}.@refill - -@item @@tieaccent@{@var{cc}@} -Generate a tie-after accent over the next two characters @var{cc}, as in -`@tieaccent{oo}'. @xref{Inserting Accents}. - -@item @@tindex @var{entry} -Add @var{entry} to the index of data types. @xref{Index Entries, , -Defining the Entries of an Index}.@refill - -@item @@title @var{title} -In a printed manual, set a title flush to the left-hand side of the -page in a larger than normal font and underline it with a black rule. -Not relevant to Info, which does not have title pages. @xref{title -subtitle author, , The @code{@@title} @code{@@subtitle} and -@code{@@author} Commands}.@refill - -@need 400 -@item @@titlefont@{@var{text}@} -In a printed manual, print @var{text} in a larger than normal font. -Not relevant to Info, which does not have title pages. -@xref{titlefont center sp, , The @code{@@titlefont} @code{@@center} -and @code{@@sp} Commands}.@refill - -@need 300 -@item @@titlepage -Indicate to Texinfo the beginning of the title page. Write command on -a line of its own. Pair with @code{@@end titlepage}. Nothing between -@code{@@titlepage} and @code{@@end titlepage} appears in Info. -@xref{titlepage, , @code{@@titlepage}}.@refill - -@need 150 -@item @@today@{@} -Insert the current date, in `1 Jan 1900' style. @xref{Custom -Headings, , How to Make Your Own Headings}.@refill - -@item @@top @var{title} -In a Texinfo file to be formatted with @code{makeinfo}, identify the -topmost @code{@@node} line in the file, which must be written on the line -immediately preceding the @code{@@top} command. Used for -@code{makeinfo}'s node pointer insertion feature. The title is -underlined with asterisks. Both the @code{@@node} line and the @code{@@top} -line normally should be enclosed by @code{@@ifinfo} and @code{@@end -ifinfo}. In @TeX{} and @code{texinfo-format-buffer}, the @code{@@top} -command is merely a synonym for @code{@@unnumbered}. @xref{makeinfo -Pointer Creation, , Creating Pointers with @code{makeinfo}}. - -@item @@u@{@var{c}@} -@itemx @@ubaraccent@{@var{c}@} -@itemx @@udotaccent@{@var{c}@} -Generate a breve, underbar, or underdot accent, respectively, over or -under the character @var{c}, as in @u{o}, @ubaraccent{o}, -@udotaccent{o}. @xref{Inserting Accents}. - -@item @@unnumbered @var{title} -In a printed manual, begin a chapter that appears without chapter -numbers of any kind. The title appears in the table of contents of a -printed manual. In Info, the title is underlined with asterisks. -@xref{unnumbered & appendix, , @code{@@unnumbered} and -@code{@@appendix}}.@refill - -@item @@unnumberedsec @var{title} -In a printed manual, begin a section that appears without section -numbers of any kind. The title appears in the table of contents of a -printed manual. In Info, the title is underlined with equal signs. -@xref{unnumberedsec appendixsec heading, , Section Commands}.@refill - -@item @@unnumberedsubsec @var{title} -In a printed manual, begin an unnumbered subsection within a -chapter. The title appears in the table of contents of a printed -manual. In Info, the title is underlined with hyphens. -@xref{unnumberedsubsec appendixsubsec subheading, , -@code{@@unnumberedsubsec} @code{@@appendixsubsec} -@code{@@subheading}}.@refill - -@item @@unnumberedsubsubsec @var{title} -In a printed manual, begin an unnumbered subsubsection within a -chapter. The title appears in the table of contents of a printed -manual. In Info, the title is underlined with periods. -@xref{subsubsection, , The `subsub' Commands}.@refill - -@item @@uref@{@var{url}[, @var{displayed-text}@} -Define a cross reference to an external uniform resource locator for the -World Wide Web. @xref{url, , @code{@@url}}.@refill - -@item @@url@{@var{url}@} -Indicate text that is a uniform resource locator for the World Wide -Web. @xref{url, , @code{@@url}}.@refill - -@item @@v@{@var{c}@} -Generate check accent over the character @var{c}, as in @v{o}. -@xref{Inserting Accents}. - -@item @@value@{@var{flag}@} -Replace @var{flag} with the value to which it is set by @code{@@set -@var{flag}}. -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@item @@var@{@var{metasyntactic-variable}@} -Highlight a metasyntactic variable, which is something that stands for -another piece of text. @xref{var, , Indicating Metasyntactic -Variables}.@refill - -@need 400 -@item @@vindex @var{entry} -Add @var{entry} to the index of variables. @xref{Index Entries, , -Defining the Entries of an Index}.@refill - -@need 400 -@item @@vskip @var{amount} -In a printed manual, insert whitespace so as to push text on the -remainder of the page towards the bottom of the page. Used in -formatting the copyright page with the argument @samp{0pt plus -1filll}. (Note spelling of @samp{filll}.) @code{@@vskip} may be used -only in contexts ignored for Info. @xref{Copyright & Permissions, , -The Copyright Page and Printed Permissions}.@refill - -@need 400 -@item @@vtable @var{formatting-command} -Begin a two-column table, using @code{@@item} for each entry. -Automatically enter each of the items in the first column into the -index of variables. Pair with @code{@@end vtable}. The same as -@code{@@table}, except for indexing. @xref{ftable vtable, , -@code{@@ftable} and @code{@@vtable}}.@refill - -@need 400 -@item @@w@{@var{text}@} -Prevent @var{text} from being split across two lines. Do not end a -paragraph that uses @code{@@w} with an @code{@@refill} command. -@xref{w, , @code{@@w}}.@refill - -@need 400 -@item @@xref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@} -Make a reference that starts with `See' in a printed manual. Follow -command with a punctuation mark. Only the first argument is -mandatory. @xref{xref, , @code{@@xref}}.@refill -@end table - - -@node Tips, Sample Texinfo File, Command List, Top -@appendix Tips and Hints - -Here are some tips for writing Texinfo documentation:@refill - -@cindex Tips -@cindex Usage tips -@cindex Hints -@itemize @bullet -@item -Write in the present tense, not in the past or the future. - -@item -Write actively! For example, write ``We recommend that @dots{}'' rather -than ``It is recommended that @dots{}''. - -@item -Use 70 or 72 as your fill column. Longer lines are hard to read. - -@item -Include a copyright notice and copying permissions. -@end itemize - -@subsubheading Index, Index, Index! - -Write many index entries, in different ways. -Readers like indices; they are helpful and convenient. - -Although it is easiest to write index entries as you write the body of -the text, some people prefer to write entries afterwards. In either -case, write an entry before the paragraph to which it applies. This -way, an index entry points to the first page of a paragraph that is -split across pages. - -Here are more hints we have found valuable: - -@itemize @bullet -@item -Write each index entry differently, so each entry refers to a different -place in the document. - -@item -Write index entries only where a topic is discussed significantly. For -example, it is not useful to index ``debugging information'' in a -chapter on reporting bugs. Someone who wants to know about debugging -information will certainly not find it in that chapter. - -@item -Consistently capitalize the first word of every concept index entry, -or else consistently use lower case. Terse entries often call for -lower case; longer entries for capitalization. Whichever case -convention you use, please use one or the other consistently! Mixing -the two styles looks bad. - -@item -Always capitalize or use upper case for those words in an index for -which this is proper, such as names of countries or acronyms. Always -use the appropriate case for case-sensitive names, such as those in C or -Lisp. - -@item -Write the indexing commands that refer to a whole section immediately -after the section command, and write the indexing commands that refer to -the paragraph before the paragraph. - -@need 1000 -In the example that follows, a blank line comes after the index -entry for ``Leaping'': - -@example -@group -@@section The Dog and the Fox -@@cindex Jumping, in general -@@cindex Leaping - -@@cindex Dog, lazy, jumped over -@@cindex Lazy dog jumped over -@@cindex Fox, jumps over dog -@@cindex Quick fox jumps over dog -The quick brown fox jumps over the lazy dog. -@end group -@end example - -@noindent -(Note that the example shows entries for the same concept that are -written in different ways---@samp{Lazy dog}, and @samp{Dog, lazy}---so -readers can look up the concept in different ways.) -@end itemize - -@subsubheading Blank Lines - -@itemize @bullet -@item -Insert a blank line between a sectioning command and the first following -sentence or paragraph, or between the indexing commands associated with -the sectioning command and the first following sentence or paragraph, as -shown in the tip on indexing. Otherwise, a formatter may fold title and -paragraph together. - -@item -Always insert a blank line before an @code{@@table} command and after an -@code{@@end table} command; but never insert a blank line after an -@code{@@table} command or before an @code{@@end table} command. - -@need 1000 -For example, - -@example -@group -Types of fox: - -@@table @@samp -@@item Quick -Jump over lazy dogs. -@end group - -@group -@@item Brown -Also jump over lazy dogs. -@@end table - -@end group -@group -@@noindent -On the other hand, @dots{} -@end group -@end example - -Insert blank lines before and after @code{@@itemize} @dots{} @code{@@end -itemize} and @code{@@enumerate} @dots{} @code{@@end enumerate} in the -same way. -@end itemize - -@subsubheading Complete Phrases - -Complete phrases are easier to read than @dots{} - -@itemize @bullet -@item -Write entries in an itemized list as complete sentences; or at least, as -complete phrases. Incomplete expressions @dots{} awkward @dots{} like -this. - -@item -Write the prefatory sentence or phrase for a multi-item list or table as -a complete expression. Do not write ``You can set:''; instead, write -``You can set these variables:''. The former expression sounds cut off. -@end itemize - -@subsubheading Editions, Dates and Versions - -Write the edition and version numbers and date in three places in every -manual: - -@enumerate -@item -In the first @code{@@ifinfo} section, for people reading the Texinfo file. - -@item -In the @code{@@titlepage} section, for people reading the printed manual. - -@item -In the `Top' node, for people reading the Info file. -@end enumerate - -@noindent -Also, it helps to write a note before the first @code{@@ifinfo} -section to explain what you are doing. - -@need 800 -@noindent -For example: - -@example -@group -@@c ===> NOTE! <== -@@c Specify the edition and version numbers and date -@@c in *three* places: -@@c 1. First ifinfo section 2. title page 3. top node -@@c To find the locations, search for !!set -@end group - -@group -@@ifinfo -@@c !!set edition, date, version -This is Edition 4.03, January 1992, -of the @@cite@{GDB Manual@} for GDB Version 4.3. -@dots{} -@end group -@end example - -@noindent ----or use @code{@@set} and @code{@@value} -(@pxref{value Example, , @code{@@value} Example}). - -@subsubheading Definition Commands - -Definition commands are @code{@@deffn}, @code{@@defun}, -@code{@@defmac}, and the like, and enable you to write descriptions in -a uniform format.@refill - -@itemize @bullet -@item -Write just one definition command for each entity you define with a -definition command. The automatic indexing feature creates an index -entry that leads the reader to the definition. - -@item -Use @code{@@table} @dots{} @code{@@end table} in an appendix that -contains a summary of functions, not @code{@@deffn} or other definition -commands. -@end itemize - -@subsubheading Capitalization - -@itemize @bullet -@item -Capitalize ``Texinfo''; it is a name. Do not write the @samp{x} or -@samp{i} in upper case. - -@item -Capitalize ``Info''; it is a name. - -@item -Write @TeX{} using the @code{@@TeX@{@}} command. Note the uppercase -@samp{T} and @samp{X}. This command causes the formatters to -typeset the name according to the wishes of Donald Knuth, who wrote -@TeX{}. -@end itemize - -@subsubheading Spaces - -Do not use spaces to format a Texinfo file, except inside of -@code{@@example} @dots{} @code{@@end example} and similar commands. - -@need 700 -For example, @TeX{} fills the following: - -@example -@group - @@kbd@{C-x v@} - @@kbd@{M-x vc-next-action@} - Perform the next logical operation - on the version-controlled file - corresponding to the current buffer. -@end group -@end example - -@need 950 -@noindent -so it looks like this: - -@iftex -@quotation - @kbd{C-x v} - @kbd{M-x vc-next-action} - Perform the next logical operation on the version-controlled file - corresponding to the current buffer. -@end quotation -@end iftex -@ifinfo -@quotation -`C-x v' `M-x vc-next-action' Perform the next logical operation on the -version-controlled file corresponding to the current buffer. -@end quotation -@end ifinfo - -@noindent -In this case, the text should be formatted with -@code{@@table}, @code{@@item}, and @code{@@itemx}, to create a table. - -@subsubheading @@code, @@samp, @@var, and @samp{---} - -@itemize @bullet -@item -Use @code{@@code} around Lisp symbols, including command names. -For example, - -@example -The main function is @@code@{vc-next-action@}, @dots{} -@end example - -@item -Avoid putting letters such as @samp{s} immediately after an -@samp{@@code}. Such letters look bad. - -@item -Use @code{@@var} around meta-variables. Do not write angle brackets -around them. - -@item -Use three hyphens in a row, @samp{---}, to indicate a long dash. @TeX{} -typesets these as a long dash and the Info formatters reduce three -hyphens to two. -@end itemize - -@subsubheading Periods Outside of Quotes - -Place periods and other punctuation marks @emph{outside} of quotations, -unless the punctuation is part of the quotation. This practice goes -against publishing conventions in the United States, but enables the -reader to distinguish between the contents of the quotation and the -whole passage. - -For example, you should write the following sentence with the period -outside the end quotation marks: - -@example -Evidently, @samp{au} is an abbreviation for ``author''. -@end example - -@noindent -since @samp{au} does @emph{not} serve as an abbreviation for -@samp{author.} (with a period following the word). - -@subsubheading Introducing New Terms - -@itemize @bullet -@item -Introduce new terms so that a reader who does not know them can -understand them from context; or write a definition for the term. - -For example, in the following, the terms ``check in'', ``register'' and -``delta'' are all appearing for the first time; the example sentence should be -rewritten so they are understandable. - -@quotation -The major function assists you in checking in a file to your -version control system and registering successive sets of changes to -it as deltas. -@end quotation - -@item -Use the @code{@@dfn} command around a word being introduced, to indicate -that the reader should not expect to know the meaning already, and -should expect to learn the meaning from this passage. -@end itemize - -@subsubheading @@pxref - -@c !!! maybe include this in the tips on pxref -@ignore -By the way, it is okay to use pxref with something else in front of -it within the parens, as long as the pxref is followed by the close -paren, and the material inside the parens is not part of a larger -sentence. Also, you can use xref inside parens as part of a complete -sentence so long as you terminate the cross reference with punctuation. -@end ignore -Absolutely never use @code{@@pxref} except in the special context for -which it is designed: inside parentheses, with the closing parenthesis -following immediately after the closing brace. One formatter -automatically inserts closing punctuation and the other does not. This -means that the output looks right both in printed output and in an Info -file, but only when the command is used inside parentheses. - -@subsubheading Invoking from a Shell - -You can invoke programs such as Emacs, GCC, and @code{gawk} from a -shell. The documentation for each program should contain a section that -describes this. Unfortunately, if the node names and titles for these -sections are all different, readers find it hard to search for the -section.@refill - -Name such sections with a phrase beginning with the word -@w{`Invoking @dots{}'}, as in `Invoking Emacs'; this way -users can find the section easily. - -@subsubheading ANSI C Syntax - -When you use @code{@@example} to describe a C function's calling -conventions, use the ANSI C syntax, like this:@refill - -@example -void dld_init (char *@@var@{path@}); -@end example - -@noindent -And in the subsequent discussion, refer to the argument values by -writing the same argument names, again highlighted with -@code{@@var}.@refill - -@need 800 -Avoid the obsolete style that looks like this:@refill - -@example -#include - -dld_init (path) -char *path; -@end example - -Also, it is best to avoid writing @code{#include} above the -declaration just to indicate that the function is declared in a -header file. The practice may give the misimpression that the -@code{#include} belongs near the declaration of the function. Either -state explicitly which header file holds the declaration or, better -yet, name the header file used for a group of functions at the -beginning of the section that describes the functions.@refill - -@subsubheading Bad Examples - -Here are several examples of bad writing to avoid: - -In this example, say, `` @dots{} you must @code{@@dfn}@{check -in@} the new version.'' That flows better. - -@quotation -When you are done editing the file, you must perform a -@code{@@dfn}@{check in@}. -@end quotation - -In the following example, say, ``@dots{} makes a unified interface such as VC -mode possible.'' - -@quotation -SCCS, RCS and other version-control systems all perform similar -functions in broadly similar ways (it is this resemblance which makes -a unified control mode like this possible). -@end quotation - -And in this example, you should specify what `it' refers to: - -@quotation -If you are working with other people, it assists in coordinating -everyone's changes so they do not step on each other. -@end quotation - -@subsubheading And Finally @dots{} - -@itemize @bullet -@item -Pronounce @TeX{} as if the @samp{X} were a Greek `chi', as the last -sound in the name `Bach'. But pronounce Texinfo as in `speck': -``teckinfo''. - -@item -Write notes for yourself at the very end of a Texinfo file after the -@code{@@bye}. None of the formatters process text after the -@code{@@bye}; it is as if the text were within @code{@@ignore} @dots{} -@code{@@end ignore}. -@end itemize - - -@node Sample Texinfo File, Sample Permissions, Tips, Top -@appendix A Sample Texinfo File -@cindex Sample Texinfo file, no comments - -Here is a complete, short sample Texinfo file, without any commentary. -You can see this file, with comments, in the first chapter. -@xref{Short Sample, , A Short Sample Texinfo File}. - -@sp 1 -@example -\input texinfo @@c -*-texinfo-*- -@@c %**start of header -@@setfilename sample.info -@@settitle Sample Document -@@c %**end of header - -@@setchapternewpage odd - -@@ifinfo -This is a short example of a complete Texinfo file. - -Copyright 1990 Free Software Foundation, Inc. -@@end ifinfo - -@@titlepage -@@sp 10 -@@comment The title is printed in a large font. -@@center @@titlefont@{Sample Title@} - -@@c The following two commands start the copyright page. -@@page -@@vskip 0pt plus 1filll -Copyright @@copyright@{@} 1990 Free Software Foundation, Inc. -@@end titlepage - -@@node Top, First Chapter, , (dir) -@@comment node-name, next, previous, up - -@@menu -* First Chapter:: The first chapter is the - only chapter in this sample. -* Concept Index:: This index has two entries. -@@end menu - -@@node First Chapter, Concept Index, Top, Top -@@comment node-name, next, previous, up -@@chapter First Chapter -@@cindex Sample index entry - -This is the contents of the first chapter. -@@cindex Another sample index entry - -Here is a numbered list. - -@@enumerate -@@item -This is the first item. - -@@item -This is the second item. -@@end enumerate - -The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@} -commands transform a Texinfo file such as this into -an Info file; and @@TeX@{@} typesets it for a printed -manual. - -@@node Concept Index, , First Chapter, Top -@@comment node-name, next, previous, up -@@unnumbered Concept Index - -@@printindex cp - -@@contents -@@bye -@end example - - -@node Sample Permissions, Include Files, Sample Texinfo File, Top -@appendix Sample Permissions -@cindex Permissions -@cindex Copying permissions - -Texinfo files should contain sections that tell the readers that they -have the right to copy and distribute the Texinfo file, the Info file, -and the printed manual.@refill - -Also, if you are writing a manual about software, you should explain -that the software is free and either include the GNU General Public -License (GPL) or provide a reference to it. @xref{Distrib, , -Distribution, xemacs, XEmacs User's Manual}, for an example of the text -that could be used in the software ``Distribution'', ``General Public -License'', and ``NO WARRANTY'' sections of a document. @xref{Copying, -, Texinfo Copying Conditions}, for an example of a brief explanation -of how the copying conditions provide you with rights. @refill - -@menu -* Inserting Permissions:: How to put permissions in your document. -* ifinfo Permissions:: Sample @samp{ifinfo} copying permissions. -* Titlepage Permissions:: Sample Titlepage copying permissions. -@end menu - -@node Inserting Permissions, ifinfo Permissions, Sample Permissions, Sample Permissions -@ifinfo -@appendixsec Inserting Permissions -@end ifinfo - -In a Texinfo file, the first @code{@@ifinfo} section usually begins -with a line that says what the file documents. This is what a person -reading the unprocessed Texinfo file or using the advanced Info -command @kbd{g *} sees first. @inforef{Expert, Advanced Info -commands, info}, for more information. (A reader using the regular -Info commands usually starts reading at the first node and skips -this first section, which is not in a node.)@refill - -In the @code{@@ifinfo} section, the summary sentence is followed by a -copyright notice and then by the copying permission notice. One of -the copying permission paragraphs is enclosed in @code{@@ignore} and -@code{@@end ignore} commands. This paragraph states that the Texinfo -file can be processed through @TeX{} and printed, provided the printed -manual carries the proper copying permission notice. This paragraph -is not made part of the Info file since it is not relevant to the Info -file; but it is a mandatory part of the Texinfo file since it permits -people to process the Texinfo file in @TeX{} and print the -results.@refill - -In the printed manual, the Free Software Foundation copying permission -notice follows the copyright notice and publishing information and is -located within the region delineated by the @code{@@titlepage} and -@code{@@end titlepage} commands. The copying permission notice is exactly -the same as the notice in the @code{@@ifinfo} section except that the -paragraph enclosed in @code{@@ignore} and @code{@@end ignore} commands is -not part of the notice.@refill - -To make it simple to insert a permission notice into each section of -the Texinfo file, sample permission notices for each section are -reproduced in full below.@refill - -Note that you may need to specify the correct name of a section -mentioned in the permission notice. For example, in @cite{The GDB -Manual}, the name of the section referring to the General Public -License is called the ``GDB General Public License'', but in the -sample shown below, that section is referred to generically as the -``GNU General Public License''. If the Texinfo file does not carry a -copy of the General Public License, leave out the reference to it, but -be sure to include the rest of the sentence.@refill - -@node ifinfo Permissions, Titlepage Permissions, Inserting Permissions, Sample Permissions -@comment node-name, next, previous, up -@appendixsec @samp{ifinfo} Copying Permissions -@cindex @samp{ifinfo} permissions - -In the @code{@@ifinfo} section of a Texinfo file, the standard Free -Software Foundation permission notice reads as follows:@refill - -@example -This file documents @dots{} - -Copyright 1998 Free Software Foundation, Inc. - -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 example - -@node Titlepage Permissions, , ifinfo Permissions, Sample Permissions -@comment node-name, next, previous, up -@appendixsec Titlepage Copying Permissions -@cindex Titlepage permissions - -In the @code{@@titlepage} section of a Texinfo file, the standard Free -Software Foundation copying permission notice follows the copyright -notice and publishing information. The standard phrasing is as -follows:@refill - -@example -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 example - - -@node Include Files, Headings, Sample Permissions, Top -@appendix Include Files -@cindex Include files - -When @TeX{} or an Info formatting command sees an @code{@@include} -command in a Texinfo file, it processes the contents of the file named -by the command and incorporates them into the DVI or Info file being -created. Index entries from the included file are incorporated into -the indices of the output file.@refill - -Include files let you keep a single large document as a collection of -conveniently small parts.@refill - -@menu -* Using Include Files:: How to use the @code{@@include} command. -* texinfo-multiple-files-update:: How to create and update nodes and - menus when using included files. -* Include File Requirements:: What @code{texinfo-multiple-files-update} expects. -* Sample Include File:: A sample outer file with included files - within it; and a sample included file. -* Include Files Evolution:: How use of the @code{@@include} command - has changed over time. -@end menu - -@node Using Include Files, texinfo-multiple-files-update, Include Files, Include Files -@appendixsec How to Use Include Files -@findex include - -To include another file within a Texinfo file, write the -@code{@@include} command at the beginning of a line and follow it on -the same line by the name of a file to be included. For -example:@refill - -@example -@@include buffers.texi -@end example - -An included file should simply be a segment of text that you expect to -be included as is into the overall or @dfn{outer} Texinfo file; it -should not contain the standard beginning and end parts of a Texinfo -file. In particular, you should not start an included file with a -line saying @samp{\input texinfo}; if you do, that phrase is inserted -into the output file as is. Likewise, you should not end an included -file with an @code{@@bye} command; nothing after @code{@@bye} is -formatted.@refill - -In the past, you were required to write an @code{@@setfilename} line at the -beginning of an included file, but no longer. Now, it does not matter -whether you write such a line. If an @code{@@setfilename} line exists -in an included file, it is ignored.@refill - -Conventionally, an included file begins with an @code{@@node} line that -is followed by an @code{@@chapter} line. Each included file is one -chapter. This makes it easy to use the regular node and menu creating -and updating commands to create the node pointers and menus within the -included file. However, the simple Emacs node and menu creating and -updating commands do not work with multiple Texinfo files. Thus you -cannot use these commands to fill in the `Next', `Previous', and `Up' -pointers of the @code{@@node} line that begins the included file. Also, -you cannot use the regular commands to create a master menu for the -whole file. Either you must insert the menus and the `Next', -`Previous', and `Up' pointers by hand, or you must use the GNU Emacs -Texinfo mode command, @code{texinfo-multiple-files-update}, that is -designed for @code{@@include} files.@refill - -@node texinfo-multiple-files-update, Include File Requirements, Using Include Files, Include Files -@appendixsec @code{texinfo-multiple-files-update} -@findex texinfo-multiple-files-update - -GNU Emacs Texinfo mode provides the @code{texinfo-multiple-files-update} -command. This command creates or updates `Next', `Previous', and `Up' -pointers of included files as well as those in the outer or overall -Texinfo file, and it creates or updates a main menu in the outer file. -Depending whether you call it with optional arguments, the command -updates only the pointers in the first @code{@@node} line of the -included files or all of them:@refill - -@table @kbd -@item M-x texinfo-multiple-files-update -Called without any arguments:@refill - -@itemize @minus -@item -Create or update the `Next', `Previous', and `Up' pointers of the -first @code{@@node} line in each file included in an outer or overall -Texinfo file.@refill - -@item -Create or update the `Top' level node pointers of the outer or -overall file.@refill - -@item -Create or update a main menu in the outer file.@refill -@end itemize - -@item C-u M-x texinfo-multiple-files-update -Called with @kbd{C-u} as a prefix argument: - -@itemize @minus{} -@item -Create or update pointers in the first @code{@@node} line in each -included file. - -@item -Create or update the `Top' level node pointers of the outer file. - -@item -Create and insert a master menu in the outer file. The master menu -is made from all the menus in all the included files.@refill -@end itemize - -@item C-u 8 M-x texinfo-multiple-files-update -Called with a numeric prefix argument, such as @kbd{C-u 8}: - -@itemize @minus -@item -Create or update @strong{all} the `Next', `Previous', and `Up' pointers -of all the included files.@refill - -@item -Create or update @strong{all} the menus of all the included -files.@refill - -@item -Create or update the `Top' level node pointers of the outer or -overall file.@refill - -@item -And then create a master menu in the outer file. This is similar to -invoking @code{texinfo-master-menu} with an argument when you are -working with just one file.@refill -@end itemize -@end table - -Note the use of the prefix argument in interactive use: with a regular -prefix argument, just @w{@kbd{C-u}}, the -@code{texinfo-multiple-files-update} command inserts a master menu; -with a numeric prefix argument, such as @kbd{C-u 8}, the command -updates @strong{every} pointer and menu in @strong{all} the files and then inserts a -master menu.@refill - -@node Include File Requirements, Sample Include File, texinfo-multiple-files-update, Include Files -@appendixsec Include File Requirements -@cindex Include file requirements -@cindex Requirements for include files - -If you plan to use the @code{texinfo-multiple-files-update} command, -the outer Texinfo file that lists included files within it should -contain nothing but the beginning and end parts of a Texinfo file, and -a number of @code{@@include} commands listing the included files. It -should not even include indices, which should be listed in an included -file of their own.@refill - -Moreover, each of the included files must contain exactly one highest -level node (conventionally, @code{@@chapter} or equivalent), -and this node must be the first node in the included file. -Furthermore, each of these highest level nodes in each included file -must be at the same hierarchical level in the file structure. -Usually, each is an @code{@@chapter}, an @code{@@appendix}, or an -@code{@@unnumbered} node. Thus, normally, each included file contains -one, and only one, chapter or equivalent-level node.@refill - -The outer file should contain only @emph{one} node, the `Top' node. It -should @emph{not} contain any nodes besides the single `Top' node. The -@code{texinfo-multiple-files-update} command will not process -them.@refill - -@node Sample Include File, Include Files Evolution, Include File Requirements, Include Files -@appendixsec Sample File with @code{@@include} -@cindex Sample @code{@@include} file -@cindex Include file sample -@cindex @code{@@include} file sample - -Here is an example of a complete outer Texinfo file with @code{@@include} files -within it before running @code{texinfo-multiple-files-update}, which -would insert a main or master menu:@refill - -@example -@group -\input texinfo @@c -*-texinfo-*- -@c %**start of header -@@setfilename include-example.info -@@settitle Include Example -@c %**end of header -@end group - -@group -@@setchapternewpage odd -@@titlepage -@@sp 12 -@@center @@titlefont@{Include Example@} -@@sp 2 -@@center by Whom Ever -@end group - -@group -@@page -@@vskip 0pt plus 1filll -Copyright @@copyright@{@} 1998 Free Software Foundation, Inc. -@@end titlepage -@end group - -@group -@@ifinfo -@@node Top, First, , (dir) -@@top Master Menu -@@end ifinfo -@end group - -@group -@@include foo.texinfo -@@include bar.texinfo -@@include concept-index.texinfo -@end group - -@group -@@summarycontents -@@contents - -@@bye -@end group -@end example - -An included file, such as @file{foo.texinfo}, might look like -this:@refill - -@example -@group -@@node First, Second, , Top -@@chapter First Chapter - -Contents of first chapter @dots{} -@end group -@end example - -The full contents of @file{concept-index.texinfo} might be as simple as this: - -@example -@group -@@node Concept Index, , Second, Top -@@unnumbered Concept Index - -@@printindex cp -@end group -@end example - -The outer Texinfo source file for @cite{The XEmacs Lisp Reference -Manual} is named @file{elisp.texi}. This outer file contains a master -menu with 417 entries and a list of 41 @code{@@include} -files.@refill - -@node Include Files Evolution, , Sample Include File, Include Files -@comment node-name, next, previous, up -@appendixsec Evolution of Include Files - -When Info was first created, it was customary to create many small -Info files on one subject. Each Info file was formatted from its own -Texinfo source file. This custom meant that Emacs did not need to -make a large buffer to hold the whole of a large Info file when -someone wanted information; instead, Emacs allocated just enough -memory for the small Info file that contained the particular -information sought. This way, Emacs could avoid wasting memory.@refill - -References from one file to another were made by referring to the file -name as well as the node name. (@xref{Other Info Files, , Referring to -Other Info Files}. Also, see @ref{Four and Five Arguments, , -@code{@@xref} with Four and Five Arguments}.)@refill - -Include files were designed primarily as a way to create a single, -large printed manual out of several smaller Info files. In a printed -manual, all the references were within the same document, so @TeX{} -could automatically determine the references' page numbers. The Info -formatting commands used include files only for creating joint -indices; each of the individual Texinfo files had to be formatted for -Info individually. (Each, therefore, required its own -@code{@@setfilename} line.)@refill - -However, because large Info files are now split automatically, it is -no longer necessary to keep them small.@refill - -Nowadays, multiple Texinfo files are used mostly for large documents, -such as @cite{The XEmacs Lisp Reference Manual}, and for projects -in which several different people write different sections of a -document simultaneously.@refill - -In addition, the Info formatting commands have been extended to work -with the @code{@@include} command so as to create a single large Info -file that is split into smaller files if necessary. This means that -you can write menus and cross references without naming the different -Texinfo files.@refill - - -@node Headings, Catching Mistakes, Include Files, Top -@appendix Page Headings -@cindex Headings -@cindex Footings -@cindex Page numbering -@cindex Page headings -@cindex Formatting headings and footings - -Most printed manuals contain headings along the top of every page -except the title and copyright pages. Some manuals also contain -footings. (Headings and footings have no meaning to Info, which is -not paginated.)@refill - -@menu -* Headings Introduced:: Conventions for using page headings. -* Heading Format:: Standard page heading formats. -* Heading Choice:: How to specify the type of page heading. -* Custom Headings:: How to create your own headings and footings. -@end menu - -@node Headings Introduced, Heading Format, Headings, Headings -@ifinfo -@heading Headings Introduced -@end ifinfo - -Texinfo provides standard page heading formats for manuals that are -printed on one side of each sheet of paper and for manuals that are -printed on both sides of the paper. Typically, you will use these -formats, but you can specify your own format if you wish.@refill - -In addition, you can specify whether chapters should begin on a new -page, or merely continue the same page as the previous chapter; and if -chapters begin on new pages, you can specify whether they must be -odd-numbered pages.@refill - -By convention, a book is printed on both sides of each sheet of paper. -When you open a book, the right-hand page is odd-numbered, and -chapters begin on right-hand pages---a preceding left-hand page is -left blank if necessary. Reports, however, are often printed on just -one side of paper, and chapters begin on a fresh page immediately -following the end of the preceding chapter. In short or informal -reports, chapters often do not begin on a new page at all, but are -separated from the preceding text by a small amount of whitespace.@refill - -The @code{@@setchapternewpage} command controls whether chapters begin -on new pages, and whether one of the standard heading formats is used. -In addition, Texinfo has several heading and footing commands that you -can use to generate your own heading and footing formats.@refill - -In Texinfo, headings and footings are single lines at the tops and -bottoms of pages; you cannot create multiline headings or footings. -Each header or footer line is divided into three parts: a left part, a -middle part, and a right part. Any part, or a whole line, may be left -blank. Text for the left part of a header or footer line is set -flushleft; text for the middle part is centered; and, text for the -right part is set flushright.@refill - -@node Heading Format, Heading Choice, Headings Introduced, Headings -@comment node-name, next, previous, up -@appendixsec Standard Heading Formats - -Texinfo provides two standard heading formats, one for manuals printed -on one side of each sheet of paper, and the other for manuals printed -on both sides of the paper. - -By default, nothing is specified for the footing of a Texinfo file, -so the footing remains blank.@refill - -The standard format for single-sided printing consists of a header -line in which the left-hand part contains the name of the chapter, the -central part is blank, and the right-hand part contains the page -number.@refill - -@need 950 -A single-sided page looks like this: - -@example -@group - _______________________ - | | - | chapter page number | - | | - | Start of text ... | - | ... | - | | - -@end group -@end example - -The standard format for two-sided printing depends on whether the page -number is even or odd. By convention, even-numbered pages are on the -left- and odd-numbered pages are on the right. (@TeX{} will adjust the -widths of the left- and right-hand margins. Usually, widths are -correct, but during double-sided printing, it is wise to check that -pages will bind properly---sometimes a printer will produce output in -which the even-numbered pages have a larger right-hand margin than the -odd-numbered pages.)@refill - -In the standard double-sided format, the left part of the left-hand -(even-numbered) page contains the page number, the central part is -blank, and the right part contains the title (specified by the -@code{@@settitle} command). The left part of the right-hand -(odd-numbered) page contains the name of the chapter, the central part -is blank, and the right part contains the page number.@refill - -@need 750 -Two pages, side by side as in an open book, look like this:@refill - -@example -@group - _______________________ _______________________ - | | | | - | page number title | | chapter page number | - | | | | - | Start of text ... | | More text ... | - | ... | | ... | - | | | | - -@end group -@end example - -@noindent -The chapter name is preceded by the word ``Chapter'', the chapter number -and a colon. This makes it easier to keep track of where you are in the -manual.@refill - -@node Heading Choice, Custom Headings, Heading Format, Headings -@comment node-name, next, previous, up -@appendixsec Specifying the Type of Heading - -@TeX{} does not begin to generate page headings for a standard Texinfo -file until it reaches the @code{@@end titlepage} command. Thus, the -title and copyright pages are not numbered. The @code{@@end -titlepage} command causes @TeX{} to begin to generate page headings -according to a standard format specified by the -@code{@@setchapternewpage} command that precedes the -@code{@@titlepage} section.@refill - -@need 1000 -There are four possibilities:@refill - -@table @asis -@item No @code{@@setchapternewpage} command -Cause @TeX{} to specify the single-sided heading format, with chapters -on new pages. This is the same as @code{@@setchapternewpage on}.@refill - -@item @code{@@setchapternewpage on} -Specify the single-sided heading format, with chapters on new pages.@refill - -@item @code{@@setchapternewpage off} -Cause @TeX{} to start a new chapter on the same page as the last page of -the preceding chapter, after skipping some vertical whitespace. Also -cause @TeX{} to typeset for single-sided printing. (You can override -the headers format with the @code{@@headings double} command; see -@ref{headings on off, , The @code{@@headings} Command}.)@refill - -@item @code{@@setchapternewpage odd} -Specify the double-sided heading format, with chapters on new pages.@refill -@end table - -@noindent -Texinfo lacks an @code{@@setchapternewpage even} command.@refill - -@node Custom Headings, , Heading Choice, Headings -@comment node-name, next, previous, up -@appendixsec How to Make Your Own Headings - -You can use the standard headings provided with Texinfo or specify -your own. By default, Texinfo has no footers, so if you specify them, -the available page size for the main text will be slightly reduced. - -@c Following paragraph is verbose to prevent overfull hboxes. -Texinfo provides six commands for specifying headings and -footings. The @code{@@everyheading} command and -@code{@@everyfooting} command generate page headers and footers -that are the same for both even- and odd-numbered pages. -The @code{@@evenheading} command and @code{@@evenfooting} -command generate headers and footers for even-numbered -(left-hand) pages; and the @code{@@oddheading} command and -@code{@@oddfooting} command generate headers and footers for -odd-numbered (right-hand) pages.@refill - -Write custom heading specifications in the Texinfo file immediately -after the @code{@@end titlepage} command. Enclose your specifications -between @code{@@iftex} and @code{@@end iftex} commands since the -@code{texinfo-format-buffer} command may not recognize them. Also, -you must cancel the predefined heading commands with the -@code{@@headings off} command before defining your own -specifications.@refill - -@need 1000 -Here is how to tell @TeX{} to place the chapter name at the left, the -page number in the center, and the date at the right of every header -for both even- and odd-numbered pages:@refill - -@example -@group -@@iftex -@@headings off -@@everyheading @@thischapter @@| @@thispage @@| @@today@{@} -@@end iftex -@end group -@end example - -@noindent -You need to divide the left part from the central part and the central -part from the right part by inserting @samp{@@|} between parts. -Otherwise, the specification command will not be able to tell where -the text for one part ends and the next part begins.@refill - -Each part can contain text or @@-commands. The text -is printed as if the part were within an ordinary paragraph in the -body of the page. The @@-commands replace -themselves with the page number, date, chapter name, or -whatever.@refill - -@need 950 -Here are the six heading and footing commands:@refill - -@findex everyheading -@findex everyfooting -@table @code -@item @@everyheading @var{left} @@| @var{center} @@| @var{right} -@itemx @@everyfooting @var{left} @@| @var{center} @@| @var{right} - -The `every' commands specify the format for both even- and odd-numbered -pages. These commands are for documents that are printed on one side -of each sheet of paper, or for documents in which you want symmetrical -headers or footers.@refill - -@findex evenheading -@findex evenfooting -@findex oddheading -@findex oddfooting -@item @@evenheading @var{left} @@| @var{center} @@| @var{right} -@itemx @@oddheading @var{left} @@| @var{center} @@| @var{right} - -@itemx @@evenfooting @var{left} @@| @var{center} @@| @var{right} -@itemx @@oddfooting @var{left} @@| @var{center} @@| @var{right} - -The `even' and `odd' commands specify the format for even-numbered -pages and odd-numbered pages. These commands are for books and -manuals that are printed on both sides of each sheet of paper. -@end table - -Use the @samp{@@this@dots{}} series of @@-commands to -provide the names of chapters -and sections and the page number. You can use the -@samp{@@this@dots{}} commands in the left, center, or right portions -of headers and footers, or anywhere else in a Texinfo file so long as -they are between @code{@@iftex} and @code{@@end iftex} commands.@refill - -@need 1000 -Here are the @samp{@@this@dots{}} commands:@refill - -@table @code -@findex thispage -@item @@thispage -Expands to the current page number.@refill -@c !!! Karl Berry says that `thissection' can fail on page breaks. -@ignore -@item @@thissection -Expands to the name of the current section.@refill -@end ignore - -@findex thischaptername -@item @@thischaptername -Expands to the name of the current chapter.@refill - -@findex thischapter -@item @@thischapter -Expands to the number and name of the current -chapter, in the format `Chapter 1: Title'.@refill - -@findex thistitle -@item @@thistitle -Expands to the name of the document, as specified by the -@code{@@settitle} command.@refill - -@findex thisfile -@item @@thisfile -For @code{@@include} files only: expands to the name of the current -@code{@@include} file. If the current Texinfo source file is not an -@code{@@include} file, this command has no effect. This command does -@emph{not} provide the name of the current Texinfo source file unless -it is an @code{@@include} file. (@xref{Include Files}, for more -information about @code{@@include} files.)@refill -@end table - -@noindent -You can also use the @code{@@today@{@}} command, which expands to the -current date, in `1 Jan 1900' format.@refill -@findex today - -Other @@-commands and text are printed in a header or footer just as -if they were in the body of a page. It is useful to incorporate text, -particularly when you are writing drafts:@refill - -@example -@group -@@iftex -@@headings off -@@everyheading @@emph@{Draft!@} @@| @@thispage @@| @@thischapter -@@everyfooting @@| @@| Version: 0.27: @@today@{@} -@@end iftex -@end group -@end example - -Beware of overlong titles: they may overlap another part of the -header or footer and blot it out.@refill - - -@node Catching Mistakes, Refilling Paragraphs, Headings, Top -@appendix Formatting Mistakes -@cindex Structure, catching mistakes in -@cindex Nodes, catching mistakes -@cindex Catching mistakes -@cindex Correcting mistakes -@cindex Mistakes, catching -@cindex Problems, catching -@cindex Debugging the Texinfo structure - -Besides mistakes in the content of your documentation, there -are two kinds of mistake you can make with Texinfo: you can make mistakes -with @@-commands, and you can make mistakes with the structure of the -nodes and chapters.@refill - -Emacs has two tools for catching the @@-command mistakes and two for -catching structuring mistakes.@refill - -For finding problems with @@-commands, you can run @TeX{} or a region -formatting command on the region that has a problem; indeed, you can -run these commands on each region as you write it.@refill - -For finding problems with the structure of nodes and chapters, you can use -@kbd{C-c C-s} (@code{texinfo-show-structure}) and the related @code{occur} -command and you can use the @kbd{M-x Info-validate} command.@refill - -@menu -* makeinfo Preferred:: @code{makeinfo} finds errors. -* Debugging with Info:: How to catch errors with Info formatting. -* Debugging with TeX:: How to catch errors with @TeX{} formatting. -* Using texinfo-show-structure:: How to use @code{texinfo-show-structure}. -* Using occur:: How to list all lines containing a pattern. -* Running Info-Validate:: How to find badly referenced nodes. -@end menu - -@node makeinfo Preferred, Debugging with Info, Catching Mistakes, Catching Mistakes -@ifinfo -@heading @code{makeinfo} Find Errors -@end ifinfo - -The @code{makeinfo} program does an excellent job of catching errors -and reporting them---far better than @code{texinfo-format-region} or -@code{texinfo-format-buffer}. In addition, the various functions for -automatically creating and updating node pointers and menus remove -many opportunities for human error.@refill - -If you can, use the updating commands to create and insert pointers -and menus. These prevent many errors. Then use @code{makeinfo} (or -its Texinfo mode manifestations, @code{makeinfo-region} and -@code{makeinfo-buffer}) to format your file and check for other -errors. This is the best way to work with Texinfo. But if you -cannot use @code{makeinfo}, or your problem is very puzzling, then you -may want to use the tools described in this appendix.@refill - -@node Debugging with Info, Debugging with TeX, makeinfo Preferred, Catching Mistakes -@comment node-name, next, previous, up -@appendixsec Catching Errors with Info Formatting -@cindex Catching errors with Info formatting -@cindex Debugging with Info formatting - -After you have written part of a Texinfo file, you can use the -@code{texinfo-format-region} or the @code{makeinfo-region} command to -see whether the region formats properly.@refill - -Most likely, however, you are reading this section because for some -reason you cannot use the @code{makeinfo-region} command; therefore, the -rest of this section presumes that you are using -@code{texinfo-format-region}.@refill - -If you have made a mistake with an @@-command, -@code{texinfo-format-region} will stop processing at or after the -error and display an error message. To see where in the buffer the -error occurred, switch to the @samp{*Info Region*} buffer; the cursor -will be in a position that is after the location of the error. Also, -the text will not be formatted after the place where the error -occurred (or more precisely, where it was detected).@refill - -For example, if you accidentally end a menu with the command @code{@@end -menus} with an `s' on the end, instead of with @code{@@end menu}, you -will see an error message that says:@refill - -@example -@@end menus is not handled by texinfo -@end example - -@noindent -The cursor will stop at the point in the buffer where the error -occurs, or not long after it. The buffer will look like this:@refill - -@example -@group ----------- Buffer: *Info Region* ---------- -* Menu: - -* Using texinfo-show-structure:: How to use - `texinfo-show-structure' - to catch mistakes. -* Running Info-Validate:: How to check for - unreferenced nodes. -@@end menus -@point{} ----------- Buffer: *Info Region* ---------- -@end group -@end example - -The @code{texinfo-format-region} command sometimes provides slightly -odd error messages. For example, the following cross reference fails to format:@refill - -@example -(@@xref@{Catching Mistakes, for more info.) -@end example - -@noindent -In this case, @code{texinfo-format-region} detects the missing closing -brace but displays a message that says @samp{Unbalanced parentheses} -rather than @samp{Unbalanced braces}. This is because the formatting -command looks for mismatches between braces as if they were -parentheses.@refill - -Sometimes @code{texinfo-format-region} fails to detect mistakes. For -example, in the following, the closing brace is swapped with the -closing parenthesis:@refill - -@example -(@@xref@{Catching Mistakes), for more info.@} -@end example - -@noindent -Formatting produces: -@example -(*Note for more info.: Catching Mistakes) -@end example - -The only way for you to detect this error is to realize that the -reference should have looked like this:@refill - -@example -(*Note Catching Mistakes::, for more info.) -@end example - -Incidentally, if you are reading this node in Info and type @kbd{f -@key{RET}} (@code{Info-follow-reference}), you will generate an error -message that says: - -@example -No such node: "Catching Mistakes) The only way @dots{} -@end example - -@noindent -This is because Info perceives the example of the error as the first -cross reference in this node and if you type a @key{RET} immediately -after typing the Info @kbd{f} command, Info will attempt to go to the -referenced node. If you type @kbd{f catch @key{TAB} @key{RET}}, Info -will complete the node name of the correctly written example and take -you to the `Catching Mistakes' node. (If you try this, you can return -from the `Catching Mistakes' node by typing @kbd{l} -(@code{Info-last}).) - -@c !!! section on using Elisp debugger ignored. -@ignore -Sometimes @code{texinfo-format-region} will stop long after the -original error; this is because it does not discover the problem until -then. In this case, you will need to backtrack.@refill - -@c menu -@c * Using the Emacs Lisp Debugger:: How to use the Emacs Lisp debugger. -@c end menu - -@c node Using the Emacs Lisp Debugger -@c appendixsubsec Using the Emacs Lisp Debugger -@c index Using the Emacs Lisp debugger -@c index Emacs Lisp debugger -@c index Debugger, using the Emacs Lisp - -If an error is especially elusive, you can turn on the Emacs Lisp -debugger and look at the backtrace; this tells you where in the -@code{texinfo-format-region} function the problem occurred. You can -turn on the debugger with the command:@refill - -@example -M-x set-variable @key{RET} debug-on-error @key{RET} t @key{RET} -@end example - -@noindent -and turn it off with - -@example -M-x set-variable @key{RET} debug-on-error @key{RET} nil @key{RET} -@end example - -Often, when you are using the debugger, it is easier to follow what is -going on if you use the Emacs Lisp files that are not byte-compiled. -The byte-compiled sources send octal numbers to the debugger that may -look mysterious. To use the uncompiled source files, load -@file{texinfmt.el} and @file{texinfo.el} with the @kbd{M-x load-file} -command.@refill - -The debugger will not catch an error if @code{texinfo-format-region} -does not detect one. In the example shown above, -@code{texinfo-format-region} did not find the error when the whole -list was formatted, but only when part of the list was formatted. -When @code{texinfo-format-region} did not find an error, the debugger -did not find one either. @refill - -However, when @code{texinfo-format-region} did report an error, it -invoked the debugger. This is the backtrace it produced:@refill - -@example ----------- Buffer: *Backtrace* ---------- -Signalling: (search-failed "[@},]") - re-search-forward("[@},]") - (while ...) - (let ...) - texinfo-format-parse-args() - (let ...) - texinfo-format-xref() - funcall(texinfo-format-xref) - (if ...) - (let ...) - (if ...) - (while ...) - texinfo-format-scan() - (save-excursion ...) - (let ...) - texinfo-format-region(103370 103631) -* call-interactively(texinfo-format-region) ----------- Buffer: *Backtrace* ---------- -@end example - -The backtrace is read from the bottom up. -@code{texinfo-format-region} was called interactively; and it, in -turn, called various functions, including @code{texinfo-format-scan}, -@code{texinfo-format-xref} and @code{texinfo-format-parse-args}. -Inside the function @code{texinfo-format-parse-args}, the function -@code{re-search-forward} was called; it was this function that could -not find the missing right-hand brace.@refill - -@xref{Lisp Debug, , Debugging Emacs Lisp, xemacs, XEmacs User's Manual}, -for more information.@refill -@end ignore - -@node Debugging with TeX, Using texinfo-show-structure, Debugging with Info, Catching Mistakes -@comment node-name, next, previous, up -@appendixsec Catching Errors with @TeX{} Formatting -@cindex Catching errors with @TeX{} formatting -@cindex Debugging with @TeX{} formatting - -You can also catch mistakes when you format a file with @TeX{}.@refill - -Usually, you will want to do this after you have run -@code{texinfo-format-buffer} (or, better, @code{makeinfo-buffer}) on -the same file, because @code{texinfo-format-buffer} sometimes displays -error messages that make more sense than @TeX{}. (@xref{Debugging -with Info}, for more information.)@refill - -For example, @TeX{} was run on a Texinfo file, part of which is shown -here:@refill - -@example ----------- Buffer: texinfo.texi ---------- -name of the Texinfo file as an extension. The -@@samp@{??@} are `wildcards' that cause the shell to -substitute all the raw index files. (@@xref@{sorting -indices, for more information about sorting -indices.)@@refill ----------- Buffer: texinfo.texi ---------- -@end example - -@noindent -(The cross reference lacks a closing brace.) -@TeX{} produced the following output, after which it stopped:@refill - -@example ----------- Buffer: *tex-shell* ---------- -Runaway argument? -@{sorting indices, for more information about sorting -indices.) @@refill @@ETC. -! Paragraph ended before @@xref was complete. - - @@par -l.27 - -? ----------- Buffer: *tex-shell* ---------- -@end example - -In this case, @TeX{} produced an accurate and -understandable error message: - -@example -Paragraph ended before @@xref was complete. -@end example - -@noindent -@samp{@@par} is an internal @TeX{} command of no relevance to Texinfo. -@samp{l.27} means that @TeX{} detected the problem on line 27 of the -Texinfo file. The @samp{?} is the prompt @TeX{} uses in this -circumstance.@refill - -Unfortunately, @TeX{} is not always so helpful, and sometimes you must -truly be a Sherlock Holmes to discover what went wrong.@refill - -In any case, if you run into a problem like this, you can do one of three -things.@refill - -@enumerate -@item -You can tell @TeX{} to continue running and ignore just this error by -typing @key{RET} at the @samp{?} prompt.@refill - -@item -You can tell @TeX{} to continue running and to ignore all errors as best -it can by typing @kbd{r @key{RET}} at the @samp{?} prompt.@refill - -This is often the best thing to do. However, beware: the one error -may produce a cascade of additional error messages as its consequences -are felt through the rest of the file. To stop @TeX{} when it is -producing such an avalanche of error messages, type @kbd{C-c} (or -@kbd{C-c C-c}, if you are running a shell inside Emacs). - -@item -You can tell @TeX{} to stop this run by typing @kbd{x @key{RET}} -at the @samp{?} prompt.@refill -@end enumerate - -Please note that if you are running @TeX{} inside Emacs, you need to -switch to the shell buffer and line at which @TeX{} offers the @samp{?} -prompt.@refill - -Sometimes @TeX{} will format a file without producing error messages even -though there is a problem. This usually occurs if a command is not ended -but @TeX{} is able to continue processing anyhow. For example, if you fail -to end an itemized list with the @code{@@end itemize} command, @TeX{} will -write a DVI file that you can print out. The only error message that -@TeX{} will give you is the somewhat mysterious comment that@refill - -@example -(@@end occurred inside a group at level 1) -@end example - -@noindent -However, if you print the DVI file, you will find that the text -of the file that follows the itemized list is entirely indented as if -it were part of the last item in the itemized list. The error message -is the way @TeX{} says that it expected to find an @code{@@end} -command somewhere in the file; but that it could not determine where -it was needed.@refill - -Another source of notoriously hard-to-find errors is a missing -@code{@@end group} command. If you ever are stumped by -incomprehensible errors, look for a missing @code{@@end group} command -first.@refill - -If the Texinfo file lacks header lines, -@TeX{} may stop in the -beginning of its run and display output that looks like the following. -The @samp{*} indicates that @TeX{} is waiting for input.@refill - -@example -This is TeX, Version 3.14159 (Web2c 7.0) -(test.texinfo [1]) -* -@end example - -@noindent -In this case, simply type @kbd{\end @key{RET}} after the asterisk. Then -write the header lines in the Texinfo file and run the @TeX{} command -again. (Note the use of the backslash, @samp{\}. @TeX{} uses @samp{\} -instead of @samp{@@}; and in this circumstance, you are working -directly with @TeX{}, not with Texinfo.)@refill - -@node Using texinfo-show-structure, Using occur, Debugging with TeX, Catching Mistakes -@comment node-name, next, previous, up -@appendixsec Using @code{texinfo-show-structure} -@cindex Showing the structure of a file -@findex texinfo-show-structure - -It is not always easy to keep track of the nodes, chapters, sections, and -subsections of a Texinfo file. This is especially true if you are revising -or adding to a Texinfo file that someone else has written.@refill - -In GNU Emacs, in Texinfo mode, the @code{texinfo-show-structure} -command lists all the lines that begin with the @@-commands that -specify the structure: @code{@@chapter}, @code{@@section}, -@code{@@appendix}, and so on. With an argument (@w{@kbd{C-u}} -as prefix argument, if interactive), -the command also shows the @code{@@node} lines. The -@code{texinfo-show-structure} command is bound to @kbd{C-c C-s} in -Texinfo mode, by default.@refill - -The lines are displayed in a buffer called the @samp{*Occur*} buffer, -indented by hierarchical level. For example, here is a part of what was -produced by running @code{texinfo-show-structure} on this manual:@refill - -@example -@group - Lines matching "^@@\\(chapter \\|sect\\|subs\\|subh\\| - unnum\\|major\\|chapheading \\|heading \\|appendix\\)" - in buffer texinfo.texi. - @dots{} - 4177:@@chapter Nodes - 4198: @@heading Two Paths - 4231: @@section Node and Menu Illustration - 4337: @@section The @@code@{@@@@node@} Command - 4393: @@subheading Choosing Node and Pointer Names - 4417: @@subsection How to Write an @@code@{@@@@node@} Line - 4469: @@subsection @@code@{@@@@node@} Line Tips - @dots{} -@end group -@end example - -This says that lines 4337, 4393, and 4417 of @file{texinfo.texi} begin -with the @code{@@section}, @code{@@subheading}, and @code{@@subsection} -commands respectively. If you move your cursor into the @samp{*Occur*} -window, you can position the cursor over one of the lines and use the -@kbd{C-c C-c} command (@code{occur-mode-goto-occurrence}), to jump to -the corresponding spot in the Texinfo file. @xref{Other Repeating -Search, , Using Occur, xemacs, XEmacs User's Manual}, for more -information about @code{occur-mode-goto-occurrence}.@refill - -The first line in the @samp{*Occur*} window describes the @dfn{regular -expression} specified by @var{texinfo-heading-pattern}. This regular -expression is the pattern that @code{texinfo-show-structure} looks for. -@xref{Regexps, , Using Regular Expressions, xemacs, XEmacs User's Manual}, -for more information.@refill - -When you invoke the @code{texinfo-show-structure} command, Emacs will -display the structure of the whole buffer. If you want to see the -structure of just a part of the buffer, of one chapter, for example, -use the @kbd{C-x n n} (@code{narrow-to-region}) command to mark the -region. (@xref{Narrowing, , , xemacs, XEmacs User's Manual}.) This is -how the example used above was generated. (To see the whole buffer -again, use @kbd{C-x n w} (@code{widen}).)@refill - -If you call @code{texinfo-show-structure} with a prefix argument by -typing @w{@kbd{C-u C-c C-s}}, it will list lines beginning with -@code{@@node} as well as the lines beginning with the @@-sign commands -for @code{@@chapter}, @code{@@section}, and the like.@refill - -You can remind yourself of the structure of a Texinfo file by looking at -the list in the @samp{*Occur*} window; and if you have mis-named a node -or left out a section, you can correct the mistake.@refill - -@node Using occur, Running Info-Validate, Using texinfo-show-structure, Catching Mistakes -@comment node-name, next, previous, up -@appendixsec Using @code{occur} -@cindex Occurrences, listing with @code{@@occur} -@findex occur - -Sometimes the @code{texinfo-show-structure} command produces too much -information. Perhaps you want to remind yourself of the overall structure -of a Texinfo file, and are overwhelmed by the detailed list produced by -@code{texinfo-show-structure}. In this case, you can use the @code{occur} -command directly. To do this, type@refill - -@example -@kbd{M-x occur} -@end example - -@noindent -and then, when prompted, type a @dfn{regexp}, a regular expression for -the pattern you want to match. (@xref{Regexps, , Regular Expressions, -xemacs, XEmacs User's Manual}.) The @code{occur} command works from the -current location of the cursor in the buffer to the end of the buffer. -If you want to run @code{occur} on the whole buffer, place the cursor at -the beginning of the buffer.@refill - -For example, to see all the lines that contain the word -@samp{@@chapter} in them, just type @samp{@@chapter}. This will -produce a list of the chapters. It will also list all the sentences -with @samp{@@chapter} in the middle of the line.@refill - -If you want to see only those lines that start with the word -@samp{@@chapter}, type @samp{^@@chapter} when prompted by -@code{occur}. If you want to see all the lines that end with a word -or phrase, end the last word with a @samp{$}; for example, -@samp{catching mistakes$}. This can be helpful when you want to see -all the nodes that are part of the same chapter or section and -therefore have the same `Up' pointer.@refill - -@xref{Other Repeating Search, , Using Occur, xemacs, XEmacs User's Manual}, -for more information.@refill - -@node Running Info-Validate, , Using occur, Catching Mistakes -@comment node-name, next, previous, up -@appendixsec Finding Badly Referenced Nodes -@findex Info-validate -@cindex Nodes, checking for badly referenced -@cindex Checking for badly referenced nodes -@cindex Looking for badly referenced nodes -@cindex Finding badly referenced nodes -@cindex Badly referenced nodes - -You can use the @code{Info-validate} command to check whether any of -the `Next', `Previous', `Up' or other node pointers fail to point to a -node. This command checks that every node pointer points to an -existing node. The @code{Info-validate} command works only on Info -files, not on Texinfo files.@refill - -The @code{makeinfo} program validates pointers automatically, so you -do not need to use the @code{Info-validate} command if you are using -@code{makeinfo}. You only may need to use @code{Info-validate} if you -are unable to run @code{makeinfo} and instead must create an Info file -using @code{texinfo-format-region} or @code{texinfo-format-buffer}, or -if you write an Info file from scratch.@refill - -@menu -* Using Info-validate:: How to run @code{Info-validate}. -* Unsplit:: How to create an unsplit file. -* Tagifying:: How to tagify a file. -* Splitting:: How to split a file manually. -@end menu - -@node Using Info-validate, Unsplit, Running Info-Validate, Running Info-Validate -@appendixsubsec Running @code{Info-validate} -@cindex Running @code{Info-validate} -@cindex Info validating a large file -@cindex Validating a large file - -To use @code{Info-validate}, visit the Info file you wish to check and -type:@refill - -@example -M-x Info-validate -@end example - -@noindent -(Note that the @code{Info-validate} command requires an upper case -`I'. You may also need to create a tag table before running -@code{Info-validate}. @xref{Tagifying}.)@refill - -If your file is valid, you will receive a message that says ``File appears -valid''. However, if you have a pointer that does not point to a node, -error messages will be displayed in a buffer called @samp{*problems in -info file*}.@refill - -For example, @code{Info-validate} was run on a test file that contained -only the first node of this manual. One of the messages said:@refill - -@example -In node "Overview", invalid Next: Texinfo Mode -@end example - -@noindent -This meant that the node called @samp{Overview} had a `Next' pointer that -did not point to anything (which was true in this case, since the test file -had only one node in it).@refill - -Now suppose we add a node named @samp{Texinfo Mode} to our test case -but we do not specify a `Previous' for this node. Then we will get -the following error message:@refill - -@example -In node "Texinfo Mode", should have Previous: Overview -@end example - -@noindent -This is because every `Next' pointer should be matched by a -`Previous' (in the node where the `Next' points) which points back.@refill - -@code{Info-validate} also checks that all menu entries and cross references -point to actual nodes.@refill - -Note that @code{Info-validate} requires a tag table and does not work -with files that have been split. (The @code{texinfo-format-buffer} -command automatically splits large files.) In order to use -@code{Info-validate} on a large file, you must run -@code{texinfo-format-buffer} with an argument so that it does not split -the Info file; and you must create a tag table for the unsplit -file.@refill - -@node Unsplit, Tagifying, Using Info-validate, Running Info-Validate -@comment node-name, next, previous, up -@appendixsubsec Creating an Unsplit File -@cindex Creating an unsplit file -@cindex Unsplit file creation - -You can run @code{Info-validate} only on a single Info file that has a -tag table. The command will not work on the indirect subfiles that -are generated when a master file is split. If you have a large file -(longer than 70,000 bytes or so), you need to run the -@code{texinfo-format-buffer} or @code{makeinfo-buffer} command in such -a way that it does not create indirect subfiles. You will also need -to create a tag table for the Info file. After you have done this, -you can run @code{Info-validate} and look for badly referenced -nodes.@refill - -The first step is to create an unsplit Info file. To prevent -@code{texinfo-format-buffer} from splitting a Texinfo file into -smaller Info files, give a prefix to the @kbd{M-x -texinfo-format-buffer} command:@refill - -@example -C-u M-x texinfo-format-buffer -@end example - -@noindent -or else - -@example -C-u C-c C-e C-b -@end example - -@noindent -When you do this, Texinfo will not split the file and will not create -a tag table for it. @refill -@cindex Making a tag table manually -@cindex Tag table, making manually - -@node Tagifying, Splitting, Unsplit, Running Info-Validate -@appendixsubsec Tagifying a File - -After creating an unsplit Info file, you must create a tag table for -it. Visit the Info file you wish to tagify and type:@refill - -@example -M-x Info-tagify -@end example - -@noindent -(Note the upper case @samp{I} in @code{Info-tagify}.) This creates an -Info file with a tag table that you can validate.@refill - -The third step is to validate the Info file:@refill - -@example -M-x Info-validate -@end example - -@noindent -(Note the upper case @samp{I} in @code{Info-validate}.) -In brief, the steps are:@refill - -@example -@group -C-u M-x texinfo-format-buffer -M-x Info-tagify -M-x Info-validate -@end group -@end example - -After you have validated the node structure, you can rerun -@code{texinfo-format-buffer} in the normal way so it will construct a -tag table and split the file automatically, or you can make the tag -table and split the file manually.@refill - -@node Splitting, , Tagifying, Running Info-Validate -@comment node-name, next, previous, up -@appendixsubsec Splitting a File Manually -@cindex Splitting an Info file manually -@cindex Info file, splitting manually - -You should split a large file or else let the -@code{texinfo-format-buffer} or @code{makeinfo-buffer} command do it -for you automatically. (Generally you will let one of the formatting -commands do this job for you. @xref{Create an Info File}.)@refill - -The split-off files are called the indirect subfiles.@refill - -Info files are split to save memory. With smaller files, Emacs does not -have make such a large buffer to hold the information.@refill - -If an Info file has more than 30 nodes, you should also make a tag -table for it. @xref{Using Info-validate}, for information -about creating a tag table. (Again, tag tables are usually created -automatically by the formatting command; you only need to create a tag -table yourself if you are doing the job manually. Most likely, you -will do this for a large, unsplit file on which you have run -@code{Info-validate}.)@refill - -@c Info-split is autoloaded in `loaddefs.el' in Emacs 18.51 -@ignore -Before running @code{Info-split}, you need to load the @code{info} library -into Emacs by giving the command @kbd{M-x load-library @key{RET} info -@key{RET}}. -@end ignore - -Visit the Info file you wish to tagify and split and type the two -commands:@refill - -@example -M-x Info-tagify -M-x Info-split -@end example - -@noindent -(Note that the @samp{I} in @samp{Info} is upper case.)@refill - -When you use the @code{Info-split} command, the buffer is modified into a -(small) Info file which lists the indirect subfiles. This file should be -saved in place of the original visited file. The indirect subfiles are -written in the same directory the original file is in, with names generated -by appending @samp{-} and a number to the original file name.@refill - -The primary file still functions as an Info file, but it contains just -the tag table and a directory of subfiles.@refill - - -@node Refilling Paragraphs, Command Syntax, Catching Mistakes, Top -@appendix Refilling Paragraphs -@cindex Refilling paragraphs -@cindex Filling paragraphs -@findex refill - -The @code{@@refill} command refills and, optionally, indents the first -line of a paragraph.@footnote{Perhaps the command should have been -called the @code{@@refillandindent} command, but @code{@@refill} is -shorter and the name was chosen before indenting was possible.} The -@code{@@refill} command is no longer important, but we describe it here -because you once needed it. You will see it in many old Texinfo -files.@refill - -Without refilling, paragraphs containing long @@-constructs may look -bad after formatting because the formatter removes @@-commands and -shortens some lines more than others. In the past, neither the -@code{texinfo-format-region} command nor the -@code{texinfo-format-buffer} command refilled paragraphs -automatically. The @code{@@refill} command had to be written at the -end of every paragraph to cause these formatters to fill them. (Both -@TeX{} and @code{makeinfo} have always refilled paragraphs -automatically.) Now, all the Info formatters automatically fill and -indent those paragraphs that need to be filled and indented.@refill - -The @code{@@refill} command causes @code{texinfo-format-region} and -@code{texinfo-format-buffer} to refill a paragraph in the Info file -@emph{after} all the other processing has been done. For this reason, -you can not use @code{@@refill} with a paragraph containing either -@code{@@*} or @code{@@w@{ @dots{} @}} since the refilling action will -override those two commands.@refill - -The @code{texinfo-format-region} and @code{texinfo-format-buffer} -commands now automatically append @code{@@refill} to the end of each -paragraph that should be filled. They do not append @code{@@refill} to -the ends of paragraphs that contain @code{@@*} or @w{@code{@@w@{ @dots{}@}}} -and therefore do not refill or indent them.@refill - - -@node Command Syntax, Obtaining TeX, Refilling Paragraphs, Top -@comment node-name, next, previous, up -@appendix @@-Command Syntax -@cindex @@-command syntax - -The character @samp{@@} is used to start special Texinfo commands. -(It has the same meaning that @samp{\} has in plain @TeX{}.) Texinfo -has four types of @@-command:@refill - -@table @asis -@item 1. Non-alphabetic commands. -These commands consist of an @@ followed by a punctuation mark or other -character that is not part of the alphabet. Non-alphabetic commands are -almost always part of the text within a paragraph, and never take any -argument. The two characters (@@ and the other one) are complete in -themselves; none is followed by braces. The non-alphabetic commands -are: @code{@@.}, @code{@@:}, @code{@@*}, @code{@@@kbd{SPACE}}, -@code{@@@kbd{TAB}}, @code{@@@kbd{NL}}, @code{@@@@}, @code{@@@{}, and -@code{@@@}}.@refill - -@item 2. Alphabetic commands that do not require arguments. -These commands start with @@ followed by a word followed by left- and -right-hand braces. These commands insert special symbols in the -document; they do not require arguments. For example, -@code{@@dots@{@}} @result{} @samp{@dots{}}, @code{@@equiv@{@}} -@result{} @samp{@equiv{}}, @code{@@TeX@{@}} @result{} `@TeX{}', -and @code{@@bullet@{@}} @result{} @samp{@bullet{}}.@refill - -@item 3. Alphabetic commands that require arguments within braces. -These commands start with @@ followed by a letter or a word, followed by an -argument within braces. For example, the command @code{@@dfn} indicates -the introductory or defining use of a term; it is used as follows: @samp{In -Texinfo, @@@@-commands are @@dfn@{mark-up@} commands.}@refill - -@item 4. Alphabetic commands that occupy an entire line. -These commands occupy an entire line. The line starts with @@, -followed by the name of the command (a word); for example, @code{@@center} -or @code{@@cindex}. If no argument is needed, the word is followed by -the end of the line. If there is an argument, it is separated from -the command name by a space. Braces are not used.@refill -@end table - -@cindex Braces and argument syntax -Thus, the alphabetic commands fall into classes that have -different argument syntaxes. You cannot tell to which class a command -belongs by the appearance of its name, but you can tell by the -command's meaning: if the command stands for a glyph, it is in -class 2 and does not require an argument; if it makes sense to use the -command together with other text as part of a paragraph, the command -is in class 3 and must be followed by an argument in braces; -otherwise, it is in class 4 and uses the rest of the line as its -argument.@refill - -The purpose of having a different syntax for commands of classes 3 and -4 is to make Texinfo files easier to read, and also to help the GNU -Emacs paragraph and filling commands work properly. There is only one -exception to this rule: the command @code{@@refill}, which is always -used at the end of a paragraph immediately following the final period -or other punctuation character. @code{@@refill} takes no argument and -does @emph{not} require braces. @code{@@refill} never confuses the -Emacs paragraph commands because it cannot appear at the beginning of -a line.@refill - - -@node Obtaining TeX, Command and Variable Index, Command Syntax, Top -@appendix How to Obtain @TeX{} -@cindex Obtaining @TeX{} -@cindex @TeX{}, how to obtain - -@c !!! Here is information about obtaining TeX. Update it whenever. -@c !!! Also consider updating TeX.README on ftp.gnu.org. -@c Updated by RJC on 1 March 1995, conversation with MacKay. -@c Updated by kb@cs.umb.edu on 29 July 1996. -@c Updated by kb@cs.umb.edu on 25 April 1997. -@c Updated by kb@cs.umb.edu on 27 February 1998. -@TeX{} is freely redistributable. You can obtain @TeX{} for Unix -systems via anonymous ftp or on physical media. The core material -consists of the Web2c @TeX{} distribution (@uref{http://tug.org/web2c}). - -Instructions for retrieval by anonymous ftp and information on other -available distributions: -@example -@uref{ftp://tug.org/tex/unixtex.ftp} -@uref{http://tug.org/unixtex.ftp} -@end example - -The Free Software Foundation provides a core distribution on its Source -Code CD-ROM suitable for printing Texinfo manuals; the University of -Washington maintains and supports a tape distribution; the @TeX{} Users -Group co-sponsors a complete CD-ROM @TeX{} distribution. - -@itemize @bullet - -@item -For the FSF Source Code CD-ROM, please contact: - -@iftex -@display -@group -Free Software Foundation, Inc. -59 Temple Place Suite 330 -Boston, MA @ @ 02111-1307 -USA -Telephone: @w{+1-617-542-5942} -Fax: (including Japan) @w{+1-617-542-2652} -Free Dial Fax (in Japan): -@w{ } @w{ } @w{ } 0031-13-2473 (KDD) -@w{ } @w{ } @w{ } 0066-3382-0158 (IDC) -Electronic mail: @code{gnu@@gnu.org} -@end group -@end display -@end iftex -@ifinfo -@display -@group -Free Software Foundation, Inc. -59 Temple Place Suite 330 -Boston, MA @w{ } 02111-1307 -USA - -Telephone: @w{+1-617-542-5942} -Fax: (including Japan) @w{+1-617-542-2652} -Free Dial Fax (in Japan): -@w{ } @w{ } @w{ } 0031-13-2473 (KDD) -@w{ } @w{ } @w{ } 0066-3382-0158 (IDC) -Electronic mail: @code{gnu@@gnu.org} -@end group -@end display -@end ifinfo - -@item -To order a complete distribution on CD-ROM, please see -@uref{http://tug.org/tex-live.html}. (This distribution is also -available by FTP; see the URL's above.) - -@item -To order a full distribution from the University of Washington on either -a 1/4@dmn{in} 4-track QIC-24 cartridge or a 4@dmn{mm} DAT cartridge, -send $210 to: - -@display -@group -Pierre A. MacKay -Denny Hall, Mail Stop DH-10 -University of Washington -Seattle, WA @w{ } 98195 -USA -Telephone: +1-206-543-2268 -Electronic mail: @code{mackay@@cs.washington.edu} -@end group -@end display - -@noindent -Please make checks payable to the University of Washington. -Checks must be in U.S.@: dollars, drawn on a U.S.@: bank. Overseas -sites: please add to the base cost, if desired, $20.00 for shipment via -air parcel post, or $30.00 for shipment via courier. - -@end itemize - -Many other @TeX{} distributions are available; see -@uref{http://tug.org/}. - - -@c These are no longer ``new'', and the explanations -@c are all given elsewhere anyway, I think. --karl, 25apr97. -@ignore (the entire appendix) -@c node New Features, Command and Variable Index, Obtaining TeX, Top -@c appendix Second Edition Features - -@tex -% Widen the space for the first column so three control-character -% strings fit in the first column. Switched back to default .8in -% value at end of chapter. -\global\tableindent=1.0in -@end tex - -The second edition of the Texinfo manual describes more than 20 new -Texinfo mode commands and more than 50 previously undocumented Texinfo -@@-commands. This edition is more than twice the length of the first -edition.@refill - -Here is a brief description of the new commands.@refill - -@menu -* New Texinfo Mode Commands:: The updating commands are especially useful. -* New Commands:: Many newly described @@-commands. -@end menu - -@c node New Texinfo Mode Commands, New Commands, Obtaining TeX, Obtaining TeX -@c appendixsec New Texinfo Mode Commands - -Texinfo mode provides commands and features especially designed for -working with Texinfo files. More than 20 new commands have been -added, including commands for automatically creating and updating -both nodes and menus. This is a tedious task when done by hand.@refill - -The keybindings are intended to be somewhat mnemonic.@refill - -@c subheading Update all nodes and menus - -The @code{texinfo-master-menu} command is the primary command: - -@table @kbd -@item C-c C-u m -@itemx M-x texinfo-master-menu -Create or update a master menu. -With @kbd{C-u} as a prefix argument, -first create or update all nodes -and regular menus. -@end table - -@c subheading Update Pointers - -@noindent -Create or update `Next', `Previous', and `Up' node pointers.@refill - -@noindent -@xref{Updating Nodes and Menus}. - -@table @kbd -@item C-c C-u C-n -@itemx M-x texinfo-update-node -Update a node. - -@item C-c C-u C-e -@itemx M-x texinfo-every-node-update -Update every node in the buffer. -@end table - -@c subheading Update Menus - -@noindent -Create or update menus.@refill - -@noindent -@xref{Updating Nodes and Menus}. - -@table @kbd -@item C-c C-u C-m -@itemx M-x texinfo-make-menu -Make or update a menu. - -@item C-c C-u C-a -@itemx M-x texinfo-all-menus-update -Make or update all the menus in a buffer. -With @kbd{C-u} as a prefix argument, -first update all the nodes. -@end table - -@c subheading Insert Title as Description - -@noindent -Insert a node's chapter or section title in the space for the -description in a menu entry line; position point so you can edit the -insert. (This command works somewhat differently than the other -insertion commands, which insert only a predefined string.)@refill - -@noindent -@xref{Inserting, Inserting Frequently Used Commands}. - -@table @kbd -@item C-c C-c C-d -Insert title. -@end table - -@c subheading Format for Info - -@noindent -Provide keybindings both for the Info formatting commands that are -written in Emacs Lisp and for @code{makeinfo} that is written in -C.@refill - -@noindent -@xref{Info Formatting}. - -@noindent -Use the Emacs lisp @code{texinfo-format@dots{}} commands: - -@table @kbd -@item C-c C-e C-r -Format the region. - -@item C-c C-e C-b -Format the buffer. -@end table - -@noindent -Use @code{makeinfo}: - -@table @kbd -@item C-c C-m C-r -Format the region. - -@item C-c C-m C-b -Format the buffer. - -@item C-c C-m C-l -Recenter the @code{makeinfo} output buffer. - -@item C-c C-m C-k -Kill the @code{makeinfo} formatting job. -@end table - -@c subheading Typeset and Print - -@noindent -Typeset and print Texinfo documents from within Emacs.@refill - -@ifinfo -@noindent -@xref{Printing}. -@end ifinfo -@iftex -@noindent -@xref{Printing, , Formatting and Printing}. -@end iftex - -@table @kbd -@item C-c C-t C-b -Run @code{texi2dvi} on the buffer. - -@item C-c C-t C-r -Run @TeX{} on the region. - -@item C-c C-t C-i -Run @code{texindex}. - -@item C-c C-t C-p -Print the DVI file. - -@item C-c C-t C-q -Show the print queue. - -@item C-c C-t C-d -Delete a job from the print queue. - -@item C-c C-t C-k -Kill the current @TeX{} formatting job. - -@item C-c C-t C-x -Quit a currently stopped @TeX{} formatting job. - -@item C-c C-t C-l -Recenter the output buffer. -@end table - -@c subheading Other Updating Commands - -@noindent -The ``other updating commands'' do not have standard keybindings because -they are used less frequently.@refill - -@noindent -@xref{Other Updating Commands}. - -@table @kbd -@item M-x texinfo-insert-node-lines -Insert missing @code{@@node} lines using -section titles as node names. - -@item M-x texinfo-multiple-files-update -Update a multi-file document. -With a numeric prefix, such as @kbd{C-u 8}, -update @strong{every} pointer and -menu in @strong{all} the files and -then insert a master menu. - -@item M-x texinfo-indent-menu-description -Indent descriptions in menus. - -@item M-x texinfo-sequential-node-update -Insert node pointers in strict sequence. -@end table - -@c node New Commands, , New Texinfo Mode Commands, Obtaining TeX -@c appendixsec New Texinfo @@-Commands - -The second edition of the Texinfo manual describes more than 50 -commands that were not described in the first edition. A third or so -of these commands existed in Texinfo but were not documented in the -manual; the others are new. Here is a listing, with brief -descriptions of them:@refill - -@c subheading Indexing - -@noindent -Create your own index, and merge indices.@refill - -@noindent -@xref{Indices}. - -@table @kbd -@item @@defindex @var{index-name} -Define a new index and its indexing command. -See also the @code{@@defcodeindex} command. - -@c written verbosely to avoid overfull hbox -@item @@synindex @var{from-index} @var{into-index} -Merge the @var{from-index} index into the @var{into-index} index. -See also the @code{@@syncodeindex} command. -@end table - -@c subheading Definitions - -@noindent -Describe functions, variables, macros, -commands, user options, special forms, and other such artifacts in a -uniform format.@refill - -@noindent -@xref{Definition Commands}. - -@table @kbd -@item @@deffn @var{category} @var{name} @var{arguments}@dots{} -Format a description for functions, interactive -commands, and similar entities. - -@item @@defvr, @@defop, @dots{} -15 other related commands. -@end table - -@c subheading Glyphs - -@noindent -Indicate the results of evaluation, expansion, -printed output, an error message, equivalence of expressions, and the -location of point.@refill - -@noindent -@xref{Glyphs}. - -@table @kbd -@item @@equiv@{@} -@itemx @equiv{} -Equivalence: - -@item @@error@{@} -@itemx @error{} -Error message - -@item @@expansion@{@} -@itemx @expansion{} -Macro expansion - -@item @@point@{@} -@itemx @point{} -Position of point - -@item @@print@{@} -@itemx @print{} -Printed output - -@item @@result@{@} -@itemx @result{} -Result of an expression -@end table - -@c subheading Page Headings - -@noindent -Customize page headings. - -@noindent -@xref{Headings}. - -@table @kbd -@item @@headings @var{on-off-single-double} -Headings on or off, single, or double-sided. - -@item @@evenfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -Footings for even-numbered (left-hand) pages. - -@item @@evenheading, @@everyheading, @@oddheading, @dots{} -Five other related commands. - -@item @@thischapter -Insert name of chapter and chapter number. - -@item @@thischaptername, @@thisfile, @@thistitle, @@thispage -Related commands. -@end table - -@c subheading Formatting - -@noindent -Format blocks of text. - -@noindent -@xref{Quotations and Examples}, and@* -@ref{Lists and Tables, , Making Lists and Tables}. - -@table @kbd -@item @@cartouche -Draw rounded box surrounding text (not in Info). - -@item @@enumerate @var{optional-arg} -Enumerate a list with letters or numbers. - -@item @@exdent @var{line-of-text} -Remove indentation. - -@item @@flushleft -Left justify. - -@item @@flushright -Right justify. - -@item @@format -Do not narrow nor change font. - -@item @@ftable @var{formatting-command} -@itemx @@vtable @var{formatting-command} -Two-column table with indexing. - -@item @@lisp -For an example of Lisp code. - -@item @@smallexample -@itemx @@smalllisp -Like @@table and @@lisp @r{but for} @@smallbook. -@end table - -@c subheading Conditionals - -@noindent -Conditionally format text. - -@noindent -@xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill - -@table @kbd -@item @@set @var{flag} [@var{string}] -Set a flag. Optionally, set value -of @var{flag} to @var{string}. - -@item @@clear @var{flag} -Clear a flag. - -@item @@value@{@var{flag}@} -Replace with value to which @var{flag} is set. - -@item @@ifset @var{flag} -Format, if @var{flag} is set. - -@item @@ifclear @var{flag} -Ignore, if @var{flag} is set. -@end table - -@c subheading @@heading series for Titles - -@noindent -Produce unnumbered headings that do not appear in a table of contents. - -@noindent -@xref{Structuring}. - -@table @kbd -@item @@heading @var{title} -Unnumbered section-like heading not listed -in the table of contents of a printed manual. - -@item @@chapheading, @@majorheading, @@c subheading, @@subsubheading -Related commands. -@end table - -@need 1000 -@c subheading Font commands - -@need 1000 -@noindent -@xref{Smallcaps}, and @* -@ref{Fonts}. - -@table @kbd -@item @@r@{@var{text}@} -Print in roman font. - -@item @@sc@{@var{text}@} -Print in @sc{small caps} font. -@end table - -@c subheading Miscellaneous - -@noindent -See @ref{title subtitle author, , @code{@@title} @code{@@subtitle} and @code{@@author} Commands},@* -see @ref{Customized Highlighting},@* -see @ref{Overfull hboxes},@* -see @ref{Footnotes},@* -see @ref{dmn, , Format a Dimension},@* -see @ref{Raise/lower sections, , @code{@@raisesections} and @code{@@lowersections}},@* -see @ref{math, , @code{@@math} - Inserting Mathematical Expressions}.@* -see @ref{minus, , Inserting a Minus Sign},@* -see @ref{paragraphindent, , Paragraph Indenting},@* -see @ref{Cross Reference Commands},@* -see @ref{title subtitle author, , @code{@@title} @code{@@subtitle} and @code{@@author}}, and@* -see @ref{Custom Headings, , How to Make Your Own Headings}. - -@table @kbd -@item @@author @var{author} -Typeset author's name. - -@c @item @@definfoenclose @var{new-command}, @var{before}, @var{after}, -@c Define a highlighting command for Info. (Info only.) - -@item @@finalout -Produce cleaner printed output. - -@item @@footnotestyle @var{end-or-separate} -Specify footnote style. - -@item @@dmn@{@var{dimension}@} -Format a dimension. - -@item @@global@@let@var{new-cmd}=@var{existing-cmd} -Define a highlighting command for @TeX{}. (@TeX{} only.) - -@item @@lowersections -Reduce hierarchical level of sectioning commands. - -@item @@math@{@var{mathematical-expression}@} -Format a mathematical expression. - -@item @@minus@{@} -Generate a minus sign. - -@item @@paragraphindent @var{asis-or-number} -Specify paragraph indentation. - -@item @@raisesections -Raise hierarchical level of sectioning commands. - -@item @@ref@{@var{node-name}, @r{[}@var{entry}@r{]}, @r{[}@var{topic-or-title}@r{]}, @r{[}@var{info-file}@r{]}, @r{[}@var{manual}@r{]}@} -Make a reference. In the printed manual, the -reference does not start with the word `see'. - -@item @@title @var{title} -Typeset @var{title} in the alternative -title page format. - -@item @@subtitle @var{subtitle} -Typeset @var{subtitle} in the alternative -title page format. - -@item @@today@{@} -Insert the current date. -@end table -@tex -% Switch width of first column of tables back to default value -\global\tableindent=.8in -@end tex -@end ignore - -@node Command and Variable Index, Concept Index, Obtaining TeX, Top -@comment node-name, next, previous, up -@unnumbered Command and Variable Index - -This is an alphabetical list of all the @@-commands, assorted Emacs Lisp -functions, and several variables. To make the list easier to use, the -commands are listed without their preceding @samp{@@}.@refill - -@printindex fn - - -@node Concept Index, , Command and Variable Index, Top -@unnumbered Concept Index - -@printindex cp - - -@summarycontents -@contents -@bye diff --git a/man/widget.texi b/man/widget.texi deleted file mode 100644 index 367ebd0..0000000 --- a/man/widget.texi +++ /dev/null @@ -1,1622 +0,0 @@ -\input texinfo.tex - -@c %**start of header -@setfilename ../info/widget -@settitle The Emacs Widget Library -@iftex -@afourpaper -@headings double -@end iftex -@c %**end of header - -@node Top, Introduction, (dir), (dir) -@comment node-name, next, previous, up -@top The Emacs Widget Library - -@menu -* Introduction:: -* User Interface:: -* Programming Example:: -* Setting Up the Buffer:: -* Basic Types:: -* Sexp Types:: -* Widget Properties:: -* Defining New Widgets:: -* Widget Browser:: -* Widget Minor Mode:: -* Utilities:: -* Widget Wishlist:: -@end menu - -@node Introduction, User Interface, Top, Top -@comment node-name, next, previous, up -@section Introduction - -Most graphical user interface toolkits, such as Motif and XView, provide -a number of standard user interface controls (sometimes known as -`widgets' or `gadgets'). Emacs doesn't really support anything like -this, except for an incredible powerful text ``widget''. On the other -hand, Emacs does provide the necessary primitives to implement many -other widgets within a text buffer. The @code{widget} package -simplifies this task. - -The basic widgets are: - -@table @code -@item link -Areas of text with an associated action. Intended for hypertext links -embedded in text. -@item push-button -Like link, but intended for stand-alone buttons. -@item editable-field -An editable text field. It can be either variable or fixed length. -@item menu-choice -Allows the user to choose one of multiple options from a menu, each -option is itself a widget. Only the selected option will be visible in -the buffer. -@item radio-button-choice -Allows the user to choose one of multiple options by activating radio -buttons. The options are implemented as widgets. All options will be -visible in the buffer. -@item item -A simple constant widget intended to be used in the @code{menu-choice} and -@code{radio-button-choice} widgets. -@item choice-item -An button item only intended for use in choices. When invoked, the user -will be asked to select another option from the choice widget. -@item toggle -A simple @samp{on}/@samp{off} switch. -@item checkbox -A checkbox (@samp{[ ]}/@samp{[X]}). -@item editable-list -Create an editable list. The user can insert or delete items in the -list. Each list item is itself a widget. -@end table - -Now of what possible use can support for widgets be in a text editor? -I'm glad you asked. The answer is that widgets are useful for -implementing forms. A @dfn{form} in emacs is a buffer where the user is -supposed to fill out a number of fields, each of which has a specific -meaning. The user is not supposed to change or delete any of the text -between the fields. Examples of forms in Emacs are the @file{forms} -package (of course), the customize buffers, the mail and news compose -modes, and the @sc{html} form support in the @file{w3} browser. - -The advantages for a programmer of using the @code{widget} package to -implement forms are: - -@enumerate -@item -More complex field than just editable text are supported. -@item -You can give the user immediate feedback if he enters invalid data in a -text field, and sometimes prevent entering invalid data. -@item -You can have fixed sized fields, thus allowing multiple field to be -lined up in columns. -@item -It is simple to query or set the value of a field. -@item -Editing happens in buffer, not in the mini-buffer. -@item -Packages using the library get a uniform look, making them easier for -the user to learn. -@item -As support for embedded graphics improve, the widget library will -extended to support it. This means that your code using the widget -library will also use the new graphic features by automatic. -@end enumerate - -In order to minimize the code that is loaded by users who does not -create any widgets, the code has been split in two files: - -@table @file -@item widget.el -This will declare the user variables, define the function -@code{widget-define}, and autoload the function @code{widget-create}. -@item wid-edit.el -Everything else is here, there is no reason to load it explicitly, as -it will be autoloaded when needed. -@end table - -@node User Interface, Programming Example, Introduction, Top -@comment node-name, next, previous, up -@section User Interface - -A form consist of read only text for documentation and some fields, -where each the fields contain two parts, as tag and a value. The tags -are used to identify the fields, so the documentation can refer to the -foo field, meaning the field tagged with @samp{Foo}. Here is an example -form: - -@example -Here is some documentation. - -Name: @i{My Name} @strong{Choose}: This option -Address: @i{Some Place -In some City -Some country.} - -See also @b{_other work_} for more information. - -Numbers: count to three below -@b{[INS]} @b{[DEL]} @i{One} -@b{[INS]} @b{[DEL]} @i{Eh, two?} -@b{[INS]} @b{[DEL]} @i{Five!} -@b{[INS]} - -Select multiple: - -@b{[X]} This -@b{[ ]} That -@b{[X]} Thus - -Select one: - -@b{(*)} One -@b{( )} Another One. -@b{( )} A Final One. - -@b{[Apply Form]} @b{[Reset Form]} -@end example - -The top level widgets in is example are tagged @samp{Name}, -@samp{Choose}, @samp{Address}, @samp{_other work_}, @samp{Numbers}, -@samp{Select multiple}, @samp{Select one}, @samp{[Apply Form]}, and -@samp{[Reset Form]}. There are basically two thing the user can do within -a form, namely editing the editable text fields and activating the -buttons. - -@subsection Editable Text Fields - -In the example, the value for the @samp{Name} is most likely displayed -in an editable text field, and so are values for each of the members of -the @samp{Numbers} list. All the normal Emacs editing operations are -available for editing these fields. The only restriction is that each -change you make must be contained within a single editable text field. -For example, capitalizing all text from the middle of one field to the -middle of another field is prohibited. - -Editing text fields are created by the @code{editable-field} widget. - -The editing text fields are highlighted with the -@code{widget-field-face} face, making them easy to find. - -@deffn Face widget-field-face -Face used for other editing fields. -@end deffn - -@subsection Buttons - -Some portions of the buffer have an associated @dfn{action}, which can -be @dfn{invoked} by a standard key or mouse command. These portions -are called @dfn{buttons}. The default commands for activating a button -are: - -@table @kbd -@item @key{RET} -@deffn Command widget-button-press @var{pos} &optional @var{event} -Invoke the button at @var{pos}, defaulting to point. -If point is not located on a button, invoke the binding in -@code{widget-global-map} (by default the global map). -@end deffn - -@item mouse-2 -@deffn Command widget-button-click @var{event} -Invoke the button at the location of the mouse pointer. If the mouse -pointer is located in an editable text field, invoke the binding in -@code{widget-global-map} (by default the global map). -@end deffn -@end table - -There are several different kind of buttons, all of which are present in -the example: - -@table @emph -@item The Option Field Tags. -When you invoke one of these buttons, you will be asked to choose -between a number of different options. This is how you edit an option -field. Option fields are created by the @code{menu-choice} widget. In -the example, @samp{@b{Choose}} is an option field tag. -@item The @samp{@b{[INS]}} and @samp{@b{[DEL]}} buttons. -Activating these will insert or delete elements from a editable list. -The list is created by the @code{editable-list} widget. -@item Embedded Buttons. -The @samp{@b{_other work_}} is an example of an embedded -button. Embedded buttons are not associated with a fields, but can serve -any purpose, such as implementing hypertext references. They are -usually created by the @code{link} widget. -@item The @samp{@b{[ ]}} and @samp{@b{[X]}} buttons. -Activating one of these will convert it to the other. This is useful -for implementing multiple-choice fields. You can create it wit -@item The @samp{@b{( )}} and @samp{@b{(*)}} buttons. -Only one radio button in a @code{radio-button-choice} widget can be -selected at any time. When you invoke one of the unselected radio -buttons, it will be selected and the previous selected radio button will -become unselected. -@item The @samp{@b{[Apply Form]}} @samp{@b{[Reset Form]}} buttons. -These are explicit buttons made with the @code{push-button} widget. The main -difference from the @code{link} widget is that the buttons are will be -displayed as GUI buttons when possible. -enough. -@end table - -To make them easier to locate, buttons are emphasized in the buffer. - -@deffn Face widget-button-face -Face used for buttons. -@end deffn - -@defopt widget-mouse-face -Face used for buttons when the mouse pointer is above it. -@end defopt - -@subsection Navigation - -You can use all the normal Emacs commands to move around in a form -buffer, plus you will have these additional commands: - -@table @kbd -@item @key{TAB} -@deffn Command widget-forward &optional count -Move point @var{count} buttons or editing fields forward. -@end deffn -@item @key{M-TAB} -@deffn Command widget-backward &optional count -Move point @var{count} buttons or editing fields backward. -@end deffn -@end table - -@node Programming Example, Setting Up the Buffer, User Interface, Top -@comment node-name, next, previous, up -@section Programming Example - -Here is the code to implement the user interface example (see @ref{User -Interface}). - -@lisp -(require 'widget) - -(eval-when-compile - (require 'wid-edit)) - -(defvar widget-example-repeat) - -(defun widget-example () - "Create the widgets from the Widget manual." - (interactive) - (kill-buffer (get-buffer-create "*Widget Example*")) - (switch-to-buffer (get-buffer-create "*Widget Example*")) - (kill-all-local-variables) - (make-local-variable 'widget-example-repeat) - (widget-insert "Here is some documentation.\n\nName: ") - (widget-create 'editable-field - :size 13 - "My Name") - (widget-create 'menu-choice - :tag "Choose" - :value "This" - :help-echo "Choose me, please!" - :notify (lambda (widget &rest ignore) - (message "%s is a good choice!" - (widget-value widget))) - '(item :tag "This option" :value "This") - '(choice-item "That option") - '(editable-field :menu-tag "No option" "Thus option")) - (widget-insert "Address: ") - (widget-create 'editable-field - "Some Place\nIn some City\nSome country.") - (widget-insert "\nSee also ") - (widget-create 'link - :notify (lambda (&rest ignore) - (widget-value-set widget-example-repeat - '("En" "To" "Tre")) - (widget-setup)) - "other work") - (widget-insert " for more information.\n\nNumbers: count to three below\n") - (setq widget-example-repeat - (widget-create 'editable-list - :entry-format "%i %d %v" - :notify (lambda (widget &rest ignore) - (let ((old (widget-get widget - ':example-length)) - (new (length (widget-value widget)))) - (unless (eq old new) - (widget-put widget ':example-length new) - (message "You can count to %d." new)))) - :value '("One" "Eh, two?" "Five!") - '(editable-field :value "three"))) - (widget-insert "\n\nSelect multiple:\n\n") - (widget-create 'checkbox t) - (widget-insert " This\n") - (widget-create 'checkbox nil) - (widget-insert " That\n") - (widget-create 'checkbox - :notify (lambda (&rest ignore) (message "Tickle")) - t) - (widget-insert " Thus\n\nSelect one:\n\n") - (widget-create 'radio-button-choice - :value "One" - :notify (lambda (widget &rest ignore) - (message "You selected %s" - (widget-value widget))) - '(item "One") '(item "Another One.") '(item "A Final One.")) - (widget-insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (if (= (length (widget-value widget-example-repeat)) - 3) - (message "Congratulation!") - (error "Three was the count!"))) - "Apply Form") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (widget-example)) - "Reset Form") - (widget-insert "\n") - (use-local-map widget-keymap) - (widget-setup)) -@end lisp - -@node Setting Up the Buffer, Basic Types, Programming Example, Top -@comment node-name, next, previous, up -@section Setting Up the Buffer - -Widgets are created with @code{widget-create}, which returns a -@dfn{widget} object. This object can be queried and manipulated by -other widget functions, until it is deleted with @code{widget-delete}. -After the widgets have been created, @code{widget-setup} must be called -to enable them. - -@defun widget-create type [ keyword argument ]@dots{} -Create and return a widget of type @var{type}. -The syntax for the @var{type} argument is described in @ref{Basic Types}. - -The keyword arguments can be used to overwrite the keyword arguments -that are part of @var{type}. -@end defun - -@defun widget-delete widget -Delete @var{widget} and remove it from the buffer. -@end defun - -@defun widget-setup -Setup a buffer to support widgets. - -This should be called after creating all the widgets and before allowing -the user to edit them. -@refill -@end defun - -If you want to insert text outside the widgets in the form, the -recommended way to do that is with @code{widget-insert}. - -@defun widget-insert -Insert the arguments, either strings or characters, at point. -The inserted text will be read only. -@end defun - -There is a standard widget keymap which you might find useful. - -@defvr Const widget-keymap -A keymap with the global keymap as its parent.@* -@key{TAB} and @kbd{C-@key{TAB}} are bound to @code{widget-forward} and -@code{widget-backward}, respectively. @kbd{@key{RET}} and @kbd{mouse-2} -are bound to @code{widget-button-press} and -@code{widget-button-}.@refill -@end defvr - -@defvar widget-global-map -Keymap used by @code{widget-button-press} and @code{widget-button-click} -when not on a button. By default this is @code{global-map}. -@end defvar - -@node Basic Types, Sexp Types, Setting Up the Buffer, Top -@comment node-name, next, previous, up -@section Basic Types - -The syntax of a type specification is given below: - -@example -NAME ::= (NAME [KEYWORD ARGUMENT]... ARGS) - | NAME -@end example - -Where, @var{name} is a widget name, @var{keyword} is the name of a -property, @var{argument} is the value of the property, and @var{args} -are interpreted in a widget specific way. - -There following keyword arguments that apply to all widgets: - -@table @code -@item :value -The initial value for widgets of this type. - -@item :format -This string will be inserted in the buffer when you create a widget. -The following @samp{%} escapes are available: - -@table @samp -@item %[ -@itemx %] -The text inside will be marked as a button. - -By default, the text will be shown in @code{widget-button-face}, and -surrounded by brackets. - -@defopt widget-button-prefix -String to prefix buttons. -@end defopt - -@defopt widget-button-suffix -String to suffix buttons. -@end defopt - -@item %@{ -@itemx %@} -The text inside will be displayed with the face specified by -@code{:sample-face}. - -@item %v -This will be replaces with the buffer representation of the widgets -value. What this is depends on the widget type. - -@item %d -Insert the string specified by @code{:doc} here. - -@item %h -Like @samp{%d}, with the following modifications: If the documentation -string is more than one line, it will add a button which will toggle -between showing only the first line, and showing the full text. -Furthermore, if there is no @code{:doc} property in the widget, it will -instead examine the @code{:documentation-property} property. If it is a -lambda expression, it will be called with the widget's value as an -argument, and the result will be used as the documentation text. - -@item %t -Insert the string specified by @code{:tag} here, or the @code{princ} -representation of the value if there is no tag. - -@item %% -Insert a literal @samp{%}. -@end table - -@item :button-face -Face used to highlight text inside %[ %] in the format. - -@item :button-prefix -@itemx :button-suffix - -Text around %[ %] in the format. - -These can be -@table @emph -@item nil -No text is inserted. - -@item a string -The string is inserted literally. - -@item a symbol -The value of the symbol is expanded according to this table. -@end table - -@item :doc -The string inserted by the @samp{%d} escape in the format -string. - -@item :tag -The string inserted by the @samp{%t} escape in the format -string. - -@item :tag-glyph -Name of image to use instead of the string specified by `:tag' on -Emacsen that supports it. - -@item :help-echo -Message displayed whenever you move to the widget with either -@code{widget-forward} or @code{widget-backward}. - -@item :indent -An integer indicating the absolute number of spaces to indent children -of this widget. - -@item :offset -An integer indicating how many extra spaces to add to the widget's -grandchildren compared to this widget. - -@item :extra-offset -An integer indicating how many extra spaces to add to the widget's -children compared to this widget. - -@item :notify -A function called each time the widget or a nested widget is changed. -The function is called with two or three arguments. The first argument -is the widget itself, the second argument is the widget that was -changed, and the third argument is the event leading to the change, if -any. - -@item :menu-tag -Tag used in the menu when the widget is used as an option in a -@code{menu-choice} widget. - -@item :menu-tag-get -Function used for finding the tag when the widget is used as an option -in a @code{menu-choice} widget. By default, the tag used will be either the -@code{:menu-tag} or @code{:tag} property if present, or the @code{princ} -representation of the @code{:value} property if not. - -@item :match -Should be a function called with two arguments, the widget and a value, -and returning non-nil if the widget can represent the specified value. - -@item :validate -A function which takes a widget as an argument, and return nil if the -widgets current value is valid for the widget. Otherwise, it should -return the widget containing the invalid data, and set that widgets -@code{:error} property to a string explaining the error. - -The following predefined function can be used: - -@defun widget-children-validate widget -All the @code{:children} of @var{widget} must be valid. -@end defun - -@item :tab-order -Specify the order in which widgets are traversed with -@code{widget-forward} or @code{widget-backward}. This is only partially -implemented. - -@enumerate a -@item -Widgets with tabbing order @code{-1} are ignored. - -@item -(Unimplemented) When on a widget with tabbing order @var{n}, go to the -next widget in the buffer with tabbing order @var{n+1} or @code{nil}, -whichever comes first. - -@item -When on a widget with no tabbing order specified, go to the next widget -in the buffer with a positive tabbing order, or @code{nil} -@end enumerate - -@item :parent -The parent of a nested widget (e.g. a @code{menu-choice} item or an -element of a @code{editable-list} widget). - -@item :sibling-args -This keyword is only used for members of a @code{radio-button-choice} or -@code{checklist}. The value should be a list of extra keyword -arguments, which will be used when creating the @code{radio-button} or -@code{checkbox} associated with this item. - -@end table - -@deffn {User Option} widget-glyph-directory -Directory where glyphs are found. -Widget will look here for a file with the same name as specified for the -image, with either a @samp{.xpm} (if supported) or @samp{.xbm} extension. -@end deffn - -@deffn{User Option} widget-glyph-enable -If non-nil, allow glyphs to appear on displays where they are supported. -@end deffn - - -@menu -* link:: -* url-link:: -* info-link:: -* push-button:: -* editable-field:: -* text:: -* menu-choice:: -* radio-button-choice:: -* item:: -* choice-item:: -* toggle:: -* checkbox:: -* checklist:: -* editable-list:: -* group:: -@end menu - -@node link, url-link, Basic Types, Basic Types -@comment node-name, next, previous, up -@subsection The @code{link} Widget - -Syntax: - -@example -TYPE ::= (link [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. - -By default the link will be shown in brackets. - -@defopt widget-link-prefix -String to prefix links. -@end defopt - -@defopt widget-link-suffix -String to suffix links. -@end defopt - -@node url-link, info-link, link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{url-link} Widget - -Syntax: - -@example -TYPE ::= (url-link [KEYWORD ARGUMENT]... URL) -@end example - -When this link is invoked, the @sc{www} browser specified by -@code{browse-url-browser-function} will be called with @var{url}. - -@node info-link, push-button, url-link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{info-link} Widget - -Syntax: - -@example -TYPE ::= (info-link [KEYWORD ARGUMENT]... ADDRESS) -@end example - -When this link is invoked, the built-in info browser is started on -@var{address}. - -@node push-button, editable-field, info-link, Basic Types -@comment node-name, next, previous, up -@subsection The @code{push-button} Widget - -Syntax: - -@example -TYPE ::= (push-button [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. - -By default the tag will be shown in brackets. - -@defopt widget-push-button-prefix -String to prefix push buttons. -@end defopt - -@defopt widget-push-button-suffix -String to suffix push buttons. -@end defopt - -@node editable-field, text, push-button, Basic Types -@comment node-name, next, previous, up -@subsection The @code{editable-field} Widget - -Syntax: - -@example -TYPE ::= (editable-field [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in -field. This widget will match all string values. - -The following extra properties are recognized. - -@table @code -@item :size -The width of the editable field.@* -By default the field will reach to the end of the line. - -@item :value-face -Face used for highlighting the editable field. Default is -@code{widget-field-face}. - -@item :secret -Character used to display the value. You can set this to e.g. @code{?*} -if the field contains a password or other secret information. By -default, the value is not secret. - -@item :valid-regexp -By default the @code{:validate} function will match the content of the -field with the value of this attribute. The default value is @code{""} -which matches everything. - -@item :keymap -Keymap used in the editable field. The default value is -@code{widget-field-keymap}, which allows you to use all the normal -editing commands, even if the buffers major mode suppress some of them. -Pressing return invokes the function specified by @code{:action}. -@end table - -@node text, menu-choice, editable-field, Basic Types -@comment node-name, next, previous, up -@subsection The @code{text} Widget - -This is just like @code{editable-field}, but intended for multiline text -fields. The default @code{:keymap} is @code{widget-text-keymap}, which -does not rebind the return key. - -@node menu-choice, radio-button-choice, text, Basic Types -@comment node-name, next, previous, up -@subsection The @code{menu-choice} Widget - -Syntax: - -@example -TYPE ::= (menu-choice [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. - -@table @code -@item :void -Widget type used as a fallback when the value does not match any of the -specified @var{type} arguments. - -@item :case-fold -Set this to nil if you don't want to ignore case when prompting for a -choice through the minibuffer. - -@item :children -A list whose car is the widget representing the currently chosen type in -the buffer. - -@item :choice -The current chosen type - -@item :args -The list of types. -@end table - -@node radio-button-choice, item, menu-choice, Basic Types -@comment node-name, next, previous, up -@subsection The @code{radio-button-choice} Widget - -Syntax: - -@example -TYPE ::= (radio-button-choice [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each possible choice. The widgets -value of will be the value of the chosen @var{type} argument. This -widget will match any value that matches at least one of the specified -@var{type} arguments. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -Replaced with the buffer representation of the @var{type} widget. -@item %b -Replace with the radio button. -@item %% -Insert a literal @samp{%}. -@end table - -@item button-args -A list of keywords to pass to the radio buttons. Useful for setting -e.g. the @samp{:help-echo} for each button. - -@item :buttons -The widgets representing the radio buttons. - -@item :children -The widgets representing each type. - -@item :choice -The current chosen type - -@item :args -The list of types. -@end table - -You can add extra radio button items to a @code{radio-button-choice} -widget after it has been created with the function -@code{widget-radio-add-item}. - -@defun widget-radio-add-item widget type -Add to @code{radio-button-choice} widget @var{widget} a new radio button item of type -@var{type}. -@end defun - -Please note that such items added after the @code{radio-button-choice} -widget has been created will @strong{not} be properly destructed when -you call @code{widget-delete}. - -@node item, choice-item, radio-button-choice, Basic Types -@comment node-name, next, previous, up -@subsection The @code{item} Widget - -Syntax: - -@example -ITEM ::= (item [KEYWORD ARGUMENT]... VALUE) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer. This widget will only match the specified value. - -@node choice-item, toggle, item, Basic Types -@comment node-name, next, previous, up -@subsection The @code{choice-item} Widget - -Syntax: - -@example -ITEM ::= (choice-item [KEYWORD ARGUMENT]... VALUE) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property. The value should be a string, which will be inserted in the -buffer as a button. Activating the button of a @code{choice-item} is -equivalent to activating the parent widget. This widget will only match -the specified value. - -@node toggle, checkbox, choice-item, Basic Types -@comment node-name, next, previous, up -@subsection The @code{toggle} Widget - -Syntax: - -@example -TYPE ::= (toggle [KEYWORD ARGUMENT]...) -@end example - -The widget has two possible states, `on' and `off', which corresponds to -a @code{t} or @code{nil} value. - -The following extra properties are recognized. - -@table @code -@item :on -String representing the `on' state. By default the string @samp{on}. -@item :off -String representing the `off' state. By default the string @samp{off}. -@item :on-glyph -Name of a glyph to be used instead of the `:on' text string, on emacsen -that supports it. -@item :off-glyph -Name of a glyph to be used instead of the `:off' text string, on emacsen -that supports it. -@end table - -@node checkbox, checklist, toggle, Basic Types -@comment node-name, next, previous, up -@subsection The @code{checkbox} Widget - -The widget has two possible states, `selected' and `unselected', which -corresponds to a @code{t} or @code{nil} value. - -Syntax: - -@example -TYPE ::= (checkbox [KEYWORD ARGUMENT]...) -@end example - -@node checklist, editable-list, checkbox, Basic Types -@comment node-name, next, previous, up -@subsection The @code{checklist} Widget - -Syntax: - -@example -TYPE ::= (checklist [KEYWORD ARGUMENT]... TYPE ... ) -@end example - -The @var{type} arguments represents each checklist item. The widgets -value of will be a list containing the value of each ticked @var{type} -argument. The checklist widget will match a list whose elements all -matches at least one of the specified @var{type} arguments. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -Replaced with the buffer representation of the @var{type} widget. -@item %b -Replace with the checkbox. -@item %% -Insert a literal @samp{%}. -@end table - -@item :greedy -Usually, a checklist will only match if the items are in the exact -sequence given in the specification. By setting @code{:greedy} to -non-nil, it will allow the items to come in any sequence. However, if -you extract the value they will be in the sequence given in the -checklist. I.e. the original sequence is forgotten. - -@item button-args -A list of keywords to pass to the checkboxes. Useful for setting -e.g. the @samp{:help-echo} for each checkbox. - -@item :buttons -The widgets representing the checkboxes. - -@item :children -The widgets representing each type. - -@item :args -The list of types. -@end table - -@node editable-list, group, checklist, Basic Types -@comment node-name, next, previous, up -@subsection The @code{editable-list} Widget - -Syntax: - -@example -TYPE ::= (editable-list [KEYWORD ARGUMENT]... TYPE) -@end example - -The value is a list, where each member represents one widget of type -@var{type}. - -The following extra properties are recognized. - -@table @code -@item :entry-format -This string will be inserted for each entry in the list. -The following @samp{%} escapes are available: -@table @samp -@item %v -This will be replaced with the buffer representation of the @var{type} -widget. -@item %i -Insert the @b{[INS]} button. -@item %d -Insert the @b{[DEL]} button. -@item %% -Insert a literal @samp{%}. -@end table - -@item :insert-button-args -A list of keyword arguments to pass to the insert buttons. - -@item :delete-button-args -A list of keyword arguments to pass to the delete buttons. - -@item :append-button-args -A list of keyword arguments to pass to the trailing insert button. - - -@item :buttons -The widgets representing the insert and delete buttons. - -@item :children -The widgets representing the elements of the list. - -@item :args -List whose car is the type of the list elements. - -@end table - -@node group, , editable-list, Basic Types -@comment node-name, next, previous, up -@subsection The @code{group} Widget - -This widget simply group other widget together. - -Syntax: - -@example -TYPE ::= (group [KEYWORD ARGUMENT]... TYPE...) -@end example - -The value is a list, with one member for each @var{type}. - -@node Sexp Types, Widget Properties, Basic Types, Top -@comment -@section Sexp Types - -A number of widgets for editing s-expressions (lisp types) are also -available. These basically fall in the following categories. - -@menu -* constants:: -* generic:: -* atoms:: -* composite:: -@end menu - -@node constants, generic, Sexp Types, Sexp Types -@comment node-name, next, previous, up -@subsection The Constant Widgets. - -The @code{const} widget can contain any lisp expression, but the user is -prohibited from editing edit it, which is mainly useful as a component -of one of the composite widgets. - -The syntax for the @code{const} widget is - -@example -TYPE ::= (const [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property and can be any s-expression. - -@deffn Widget const -This will display any valid s-expression in an immutable part of the -buffer. -@end deffn - -There are two variations of the @code{const} widget, namely -@code{variable-item} and @code{function-item}. These should contain a -symbol with a variable or function binding. The major difference from -the @code{const} widget is that they will allow the user to see the -variable or function documentation for the symbol. - -@deffn Widget variable-item -An immutable symbol that is bound as a variable. -@end deffn - -@deffn Widget function-item -An immutable symbol that is bound as a function. -@end deffn - -@node generic, atoms, constants, Sexp Types -@comment node-name, next, previous, up -@subsection Generic Sexp Widget. - -The @code{sexp} widget can contain any lisp expression, and allows the -user to edit it inline in the buffer. - -The syntax for the @code{sexp} widget is - -@example -TYPE ::= (sexp [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -@deffn Widget sexp -This will allow you to edit any valid s-expression in an editable buffer -field. - -The @code{sexp} widget takes the same keyword arguments as the -@code{editable-field} widget. -@end deffn - -@node atoms, composite, generic, Sexp Types -@comment node-name, next, previous, up -@subsection Atomic Sexp Widgets. - -The atoms are s-expressions that does not consist of other -s-expressions. A string is an atom, while a list is a composite type. -You can edit the value of an atom with the following widgets. - -The syntax for all the atoms are - -@example -TYPE ::= (NAME [KEYWORD ARGUMENT]... [ VALUE ]) -@end example - -The @var{value}, if present, is used to initialize the @code{:value} -property and must be an expression of the same type as the widget. -I.e. the string widget can only be initialized with a string. - -All the atom widgets take the same keyword arguments as the -@code{editable-field} widget. - -@deffn Widget string -Allows you to edit a string in an editable field. -@end deffn - -@deffn Widget regexp -Allows you to edit a regular expression in an editable field. -@end deffn - -@deffn Widget character -Allows you to enter a character in an editable field. -@end deffn - -@deffn Widget file -Allows you to edit a file name in an editable field. If you invoke -the tag button, you can edit the file name in the mini-buffer with -completion. - -Keywords: -@table @code -@item :must-match -If this is set to non-nil, only existing file names will be allowed in -the minibuffer. -@end table -@end deffn - -@deffn Widget directory -Allows you to edit a directory name in an editable field. -Similar to the @code{file} widget. -@end deffn - -@deffn Widget symbol -Allows you to edit a lisp symbol in an editable field. -@end deffn - -@deffn Widget function -Allows you to edit a lambda expression, or a function name with completion. -@end deffn - -@deffn Widget variable -Allows you to edit a variable name, with completion. -@end deffn - -@deffn Widget integer -Allows you to edit an integer in an editable field. -@end deffn - -@deffn Widget number -Allows you to edit a number in an editable field. -@end deffn - -@deffn Widget boolean -Allows you to edit a boolean. In lisp this means a variable which is -either nil meaning false, or non-nil meaning true. -@end deffn - - -@node composite, , atoms, Sexp Types -@comment node-name, next, previous, up -@subsection Composite Sexp Widgets. - -The syntax for the composite are - -@example -TYPE ::= (NAME [KEYWORD ARGUMENT]... COMPONENT...) -@end example - -Where each @var{component} must be a widget type. Each component widget -will be displayed in the buffer, and be editable to the user. - -@deffn Widget cons -The value of a @code{cons} widget is a cons-cell where the car is the -value of the first component and the cdr is the value of the second -component. There must be exactly two components. -@end deffn - -@deffn Widget list -The value of a @code{list} widget is a list containing the value of -each of its component. -@end deffn - -@deffn Widget vector -The value of a @code{vector} widget is a vector containing the value of -each of its component. -@end deffn - -The above suffice for specifying fixed size lists and vectors. To get -variable length lists and vectors, you can use a @code{choice}, -@code{set} or @code{repeat} widgets together with the @code{:inline} -keywords. If any component of a composite widget has the @code{:inline} -keyword set, its value must be a list which will then be spliced into -the composite. For example, to specify a list whose first element must -be a file name, and whose remaining arguments should either by the -symbol @code{t} or two files, you can use the following widget -specification: - -@example -(list file - (choice (const t) - (list :inline t - :value ("foo" "bar") - string string))) -@end example - -The value of a widget of this type will either have the form -@samp{(file t)} or @code{(file string string)}. - -This concept of inline is probably hard to understand. It was certainly -hard to implement so instead of confuse you more by trying to explain it -here, I'll just suggest you meditate over it for a while. - -@deffn Widget choice -Allows you to edit a sexp which may have one of fixed set of types. It -is currently implemented with the @code{choice-menu} basic widget, and -has a similar syntax. -@end deffn - -@deffn Widget set -Allows you to specify a type which must be a list whose elements all -belong to given set. The elements of the list is not significant. This -is implemented on top of the @code{checklist} basic widget, and has a -similar syntax. -@end deffn - -@deffn Widget repeat -Allows you to specify a variable length list whose members are all of -the same type. Implemented on top of the `editable-list' basic widget, -and has a similar syntax. -@end deffn - -@node Widget Properties, Defining New Widgets, Sexp Types, Top -@comment node-name, next, previous, up -@section Properties - -You can examine or set the value of a widget by using the widget object -that was returned by @code{widget-create}. - -@defun widget-value widget -Return the current value contained in @var{widget}. -It is an error to call this function on an uninitialized widget. -@end defun - -@defun widget-value-set widget value -Set the value contained in @var{widget} to @var{value}. -It is an error to call this function with an invalid @var{value}. -@end defun - -@strong{Important:} You @emph{must} call @code{widget-setup} after -modifying the value of a widget before the user is allowed to edit the -widget again. It is enough to call @code{widget-setup} once if you -modify multiple widgets. This is currently only necessary if the widget -contains an editing field, but may be necessary for other widgets in the -future. - -If your application needs to associate some information with the widget -objects, for example a reference to the item being edited, it can be -done with @code{widget-put} and @code{widget-get}. The property names -must begin with a @samp{:}. - -@defun widget-put widget property value -In @var{widget} set @var{property} to @var{value}. -@var{property} should be a symbol, while @var{value} can be anything. -@end defun - -@defun widget-get widget property -In @var{widget} return the value for @var{property}. -@var{property} should be a symbol, the value is what was last set by -@code{widget-put} for @var{property}. -@end defun - -@defun widget-member widget property -Non-nil if @var{widget} has a value (even nil) for property @var{property}. -@end defun - -Occasionally it can be useful to know which kind of widget you have, -i.e. the name of the widget type you gave when the widget was created. - -@defun widget-type widget -Return the name of @var{widget}, a symbol. -@end defun - -Widgets can be in two states: active, which means they are modifiable by -the user, or inactive, which means they cannot be modified by the user. -You can query or set the state with the following code: - -@lisp -;; Examine if @var{widget} is active or not. -(if (widget-apply @var{widget} :active) - (message "Widget is active.") - (message "Widget is inactive.") - -;; Make @var{widget} inactive. -(widget-apply @var{widget} :deactivate) - -;; Make @var{widget} active. -(widget-apply @var{widget} :activate) -@end lisp - -A widget is inactive if itself, or any of its ancestors (found by -following the @code{:parent} link) have been deactivated. To make sure -a widget is really active, you must therefore activate both itself, and -all its ancestors. - -@lisp -(while widget - (widget-apply widget :activate) - (setq widget (widget-get widget :parent))) -@end lisp - -You can check if a widget has been made inactive by examining the value -of @code{:inactive} keyword. If this is non-nil, the widget itself has -been deactivated. This is different from using the @code{:active} -keyword, in that the later tell you if the widget @strong{or} any of its -ancestors have been deactivated. Do not attempt to set the -@code{:inactive} keyword directly. Use the @code{:activate} -@code{:deactivated} keywords instead. - - -@node Defining New Widgets, Widget Browser, Widget Properties, Top -@comment node-name, next, previous, up -@section Defining New Widgets - -You can define specialized widgets with @code{define-widget}. It allows -you to create a shorthand for more complex widgets, including specifying -component widgets and default new default values for the keyword -arguments. - -@defun widget-define name class doc &rest args -Define a new widget type named @var{name} from @code{class}. - -@var{name} and class should both be symbols, @code{class} should be one -of the existing widget types. - -The third argument @var{DOC} is a documentation string for the widget. - -After the new widget has been defined, the following two calls will -create identical widgets: - -@itemize @bullet -@item -@lisp -(widget-create @var{name}) -@end lisp - -@item -@lisp -(apply widget-create @var{class} @var{args}) -@end lisp -@end itemize - -@end defun - -Using @code{widget-define} does just store the definition of the widget -type in the @code{widget-type} property of @var{name}, which is what -@code{widget-create} uses. - -If you just want to specify defaults for keywords with no complex -conversions, you can use @code{identity} as your conversion function. - -The following additional keyword arguments are useful when defining new -widgets: -@table @code -@item :convert-widget -Function to convert a widget type before creating a widget of that -type. It takes a widget type as an argument, and returns the converted -widget type. When a widget is created, this function is called for the -widget type and all the widgets parent types, most derived first. - -The following predefined functions can be used here: - -@defun widget-types-convert-widget widget -Convert @code{:args} as widget types in @var{widget}. -@end defun - -@defun widget-value-convert-widget widget -Initialize @code{:value} from @code{:args} in @var{widget}. -@end defun - -@item :value-to-internal -Function to convert the value to the internal format. The function -takes two arguments, a widget and an external value, and returns the -internal value. The function is called on the present @code{:value} -when the widget is created, and on any value set later with -@code{widget-value-set}. - -@item :value-to-external -Function to convert the value to the external format. The function -takes two arguments, a widget and an internal value, and returns the -internal value. The function is called on the present @code{:value} -when the widget is created, and on any value set later with -@code{widget-value-set}. - -@item :create -Function to create a widget from scratch. The function takes one -argument, a widget type, and create a widget of that type, insert it in -the buffer, and return a widget object. - -@item :delete -Function to delete a widget. The function takes one argument, a widget, -and should remove all traces of the widget from the buffer. - -@item :value-create -Function to expand the @samp{%v} escape in the format string. It will -be called with the widget as its argument. Should -insert a representation of the widgets value in the buffer. - -@item :value-delete -Should remove the representation of the widgets value from the buffer. -It will be called with the widget as its argument. It doesn't have to -remove the text, but it should release markers and delete nested widgets -if such has been used. - -The following predefined function can be used here: - -@defun widget-children-value-delete widget -Delete all @code{:children} and @code{:buttons} in @var{widget}. -@end defun - -@item :value-get -Function to extract the value of a widget, as it is displayed in the -buffer. - -The following predefined function can be used here: - -@defun widget-value-value-get widget -Return the @code{:value} property of @var{widget}. -@end defun - -@item :format-handler -Function to handle unknown @samp{%} escapes in the format string. It -will be called with the widget and the escape character as arguments. -You can set this to allow your widget to handle non-standard escapes. - -You should end up calling @code{widget-default-format-handler} to handle -unknown escape sequences, which will handle the @samp{%h} and any future -escape sequences, as well as give an error for unknown escapes. - -@item :action -Function to handle user initiated events. By default, @code{:notify} -the parent. - -The following predefined function can be used here: - -@defun widget-parent-action widget &optional event -Tell @code{:parent} of @var{widget} to handle the @code{:action}.@* -Optional @var{event} is the event that triggered the action. -@end defun - -@item :prompt-value -Function to prompt for a value in the minibuffer. The function should -take four arguments, @var{widget}, @var{prompt}, @var{value}, and -@var{unbound} and should return a value for widget entered by the user. -@var{prompt} is the prompt to use. @var{value} is the default value to -use, unless @var{unbound} is non-nil in which case there are no default -value. The function should read the value using the method most natural -for this widget, and does not have to check that it matches. -@end table - -If you want to define a new widget from scratch, use the @code{default} -widget as its base. - -@deffn Widget default -Widget used as a base for other widgets. - -It provides most of the functionality that is referred to as ``by -default'' in this text. -@end deffn - -@node Widget Browser, Widget Minor Mode, Defining New Widgets, Top -@comment node-name, next, previous, up -@section Widget Browser - -There is a separate package to browse widgets. This is intended to help -programmers who want to examine the content of a widget. The browser -shows the value of each keyword, but uses links for certain keywords -such as `:parent', which avoids printing cyclic structures. - -@deffn Command widget-browse WIDGET -Create a widget browser for WIDGET. -When called interactively, prompt for WIDGET. -@end deffn - -@deffn Command widget-browse-other-window WIDGET -Create a widget browser for WIDGET and show it in another window. -When called interactively, prompt for WIDGET. -@end deffn - -@deffn Command widget-browse-at POS -Create a widget browser for the widget at POS. -When called interactively, use the position of point. -@end deffn - -@node Widget Minor Mode, Utilities, Widget Browser, Top -@comment node-name, next, previous, up -@section Widget Minor Mode - -There is a minor mode for manipulating widgets in major modes that -doesn't provide any support for widgets themselves. This is mostly -intended to be useful for programmers doing experiments. - -@deffn Command widget-minor-mode -Toggle minor mode for traversing widgets. -With arg, turn widget mode on if and only if arg is positive. -@end deffn - -@defvar widget-minor-mode-keymap -Keymap used in @code{widget-minor-mode}. -@end defvar - -@node Utilities, Widget Wishlist, Widget Minor Mode, Top -@comment node-name, next, previous, up -@section Utilities. - -@defun widget-prompt-value widget prompt [ value unbound ] -Prompt for a value matching @var{widget}, using @var{prompt}.@* -The current value is assumed to be @var{value}, unless @var{unbound} is -non-nil.@refill -@end defun - -@defun widget-get-sibling widget -Get the item @var{widget} is assumed to toggle.@* -This is only meaningful for radio buttons or checkboxes in a list. -@end defun - -@node Widget Wishlist, , Utilities, Top -@comment node-name, next, previous, up -@section Wishlist - -@itemize @bullet -@item -It should be possible to add or remove items from a list with @kbd{C-k} -and @kbd{C-o} (suggested by @sc{rms}). - -@item -The @samp{[INS]} and @samp{[DEL]} buttons should be replaced by a single -dash (@samp{-}). The dash should be a button that, when invoked, ask -whether you want to add or delete an item (@sc{rms} wanted to git rid of -the ugly buttons, the dash is my idea). - -@item -The @code{menu-choice} tag should be prettier, something like the abbreviated -menus in Open Look. - -@item -Finish @code{:tab-order}. - -@item -Make indentation work with glyphs and proportional fonts. - -@item -Add commands to show overview of object and class hierarchies to the -browser. - -@item -Find a way to disable mouse highlight for inactive widgets. - -@item -Find a way to make glyphs look inactive. - -@item -Add @code{property-list} widget. - -@item -Add @code{association-list} widget. - -@item -Add @code{key-binding} widget. - -@item -Add @code{widget} widget for editing widget specifications. - -@item -Find clean way to implement variable length list. -See @code{TeX-printer-list} for an explanation. - -@item -@kbd{C-h} in @code{widget-prompt-value} should give type specific help. - -@item -A mailto widget. - -@item -@kbd{C-e e} in a fixed size field should go to the end of the text in -the field, not the end of the field itself. - -@item -Use and overlay instead of markers to delimit the widget. Create -accessors for the end points. - -@item -Clicking on documentation links should call @code{describe-function} or -@code{widget-browse-other-window} and friends directly, instead of going -through @code{apropos}. If more than one function is valid for the -symbol, it should pop up a menu. - -@end itemize - -@contents -@bye diff --git a/man/xemacs-faq.texi b/man/xemacs-faq.texi deleted file mode 100644 index 9ad5a5f..0000000 --- a/man/xemacs-faq.texi +++ /dev/null @@ -1,6225 +0,0 @@ -\input texinfo.tex @c -*-texinfo-*- -@c %**start of header -@setfilename ../info/xemacs-faq.info -@settitle Frequently asked questions about XEmacs -@setchapternewpage off -@c %**end of header -@finalout -@titlepage -@title XEmacs FAQ -@subtitle Frequently asked questions about XEmacs @* Last Modified: $Date: 1998/05/03 10:22:33 $ -@sp 1 -@author Tony Rossini -@author Ben Wing -@author Chuck Thompson -@author Steve Baur -@author Andreas Kaempf -@author Christian Nyb@o{} -@page -@end titlepage - -@node Top, Introduction, (dir), (dir) -@top XEmacs FAQ -@unnumbered Introduction - -This is the guide to the XEmacs Frequently Asked Questions list---a -compendium of questions and answers pertaining to one of the finest -programs ever written. It is much more than just a Text Editor. - -This FAQ is freely redistributable. I take no liability for the -correctness and safety of any procedures or advice given here. This -FAQ is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or -FITNESS FOR A PARTICULAR PURPOSE. - -If you have a Web browser, the official hypertext version is at -@iftex -@* -@end iftex -@uref{http://www.xemacs.org/faq/xemacs-faq.html}. - -This version is somewhat nicer than the unofficial hypertext versions -that are archived at Utrecht, Oxford, Smart Pages, and other FAQ -archives. - -@ifset CANONICAL -@html -This document is available in several different formats: -@itemize @bullet -@item -@uref{xemacs-faq.txt, As a single ASCII file}, produced by -@code{makeinfo --no-headers} -@item -@uref{xemacs-faq.dvi, As a .dvi file}, as used with -@uref{http://www.tug.org, TeX.} -@item -As a PostScript file @uref{xemacs-faq-a4.ps, in A4 format}, -as well as in @uref{xemacs-faq-letter.ps, letter format} -@item -In html format, @uref{xemacs-faq_1.html, split by chapter}, or in -@uref{xemacs-faq.html, one monolithic} document. -@item -The canonical version of the FAQ is the texinfo document -@uref{xemacs-faq.texi, man/xemacs-faq.texi}. -@item -If you do not have makeinfo installed, you may @uref{xemacs-faq.info, -download the faq} in info format, and install it in @file{/info/}. For example in -@file{/usr/local/lib/xemacs-20.4/info/}. - -@end itemize - -@end html - -@end ifset - -@c end ifset points to CANONICAL - -@menu -* Introduction:: Introduction, Policy, Credits. -* Installation:: Installation and Trouble Shooting. -* Customization:: Customization and Options. -* Subsystems:: Major Subsystems. -* Miscellaneous:: The Miscellaneous Stuff. -* Current Events:: What the Future Holds. - -@detailmenu - - --- The Detailed Node Listing --- - -Introduction, Policy, Credits - -* Q1.0.1:: What is XEmacs? -* Q1.0.2:: What is the current version of XEmacs? -* Q1.0.3:: Where can I find it? -* Q1.0.4:: Why Another Version of Emacs? -* Q1.0.5:: Why Haven't XEmacs and GNU Emacs Merged? -* Q1.0.6:: Where can I get help? -* Q1.0.7:: Where is the mailing list archived? -* Q1.0.8:: How do you pronounce XEmacs? -* Q1.0.9:: What does XEmacs look like? -* Q1.0.10:: Is there a port of XEmacs to Microsoft ('95 or NT)? -* Q1.0.11:: Is there a port of XEmacs to the Macintosh? -* Q1.0.12:: Is there a port of XEmacs to NextStep? -* Q1.0.13:: Is there a port of XEmacs to OS/2? -* Q1.0.14:: Where can I get a printed copy of the XEmacs users manual? - -Policies: -* Q1.1.1:: What is the FAQ editorial policy? -* Q1.1.2:: How do I become a Beta Tester? -* Q1.1.3:: How do I contribute to XEmacs itself? - -Credits: -* Q1.2.1:: Who wrote XEmacs? -* Q1.2.2:: Who contributed to this version of the FAQ? -* Q1.2.3:: Who contributed to the FAQ in the past? - -Internationalization: -* Q1.3.1:: What is the status of XEmacs v20? -* Q1.3.2:: What is the status of Asian-language support, aka @var{mule}? -* Q1.3.3:: How do I type non-ASCII characters? -* Q1.3.4:: Can XEmacs messages come out in a different language? -* Q1.3.5:: Please explain the various input methods in MULE/XEmacs 20.0 -* Q1.3.6:: How do I portably code for MULE/XEmacs 20.0? -* Q1.3.7:: How about Cyrillic Modes? - -Getting Started: -* Q1.4.1:: What is a @file{.emacs} and is there a sample one? -* Q1.4.2:: Can I use the same @file{.emacs} with the other Emacs? -* Q1.4.3:: Any good XEmacs tutorials around? -* Q1.4.4:: May I see an example of a useful XEmacs Lisp function? -* Q1.4.5:: And how do I bind it to a key? -* Q1.4.6:: What's the difference between a macro and a function? -* Q1.4.7:: Why options saved with 19.13 don't work with 19.14 or later? - -Installation and Trouble Shooting - -* Q2.0.1:: Running XEmacs without installing. -* Q2.0.2:: XEmacs is too big. -* Q2.0.3:: Compiling XEmacs with Netaudio. -* Q2.0.4:: Problems with Linux and ncurses. -* Q2.0.5:: Do I need X11 to run XEmacs? -* Q2.0.6:: I'm having strange crashes. What do I do? -* Q2.0.7:: Libraries in non-standard locations. -* Q2.0.8:: can't resolve symbol _h_errno -* Q2.0.9:: Where do I find external libraries? -* Q2.0.10:: After I run configure I find a coredump, is something wrong? -* Q2.0.11:: XEmacs can't resolve host names. -* Q2.0.12:: Why can't I strip XEmacs? -* Q2.0.13:: Can't link XEmacs on Solaris with Gcc. -* Q2.0.14:: Make on HP/UX 9 fails after linking temacs - -Trouble Shooting: -* Q2.1.1:: XEmacs just crashed on me! -* Q2.1.2:: Cryptic Minibuffer messages. -* Q2.1.3:: Translation Table Syntax messages at Startup. -* Q2.1.4:: Startup warnings about deducing proper fonts? -* Q2.1.5:: XEmacs cannot connect to my X Terminal. -* Q2.1.6:: XEmacs just locked up my Linux X server. -* Q2.1.7:: HP Alt key as Meta. -* Q2.1.8:: got (wrong-type-argument color-instance-p nil)! -* Q2.1.9:: XEmacs causes my OpenWindows 3.0 server to crash. -* Q2.1.10:: Warnings from incorrect key modifiers. -* Q2.1.11:: Can't instantiate image error... in toolbar -* Q2.1.12:: Regular Expression Problems on DEC OSF1. -* Q2.1.13:: HP/UX 10.10 and @code{create_process} failure -* Q2.1.14:: @kbd{C-g} doesn't work for me. Is it broken? -* Q2.1.15:: How to debug an XEmacs problem with a debugger. -* Q2.1.16:: XEmacs crashes in @code{strcat} on HP/UX 10. -* Q2.1.17:: @samp{Marker does not point anywhere}. -* Q2.1.18:: 19.14 hangs on HP/UX 10.10. -* Q2.1.19:: XEmacs does not follow the local timezone. -* Q2.1.20:: @samp{Symbol's function definition is void: hkey-help-show.} -* Q2.1.21:: Every so often the XEmacs frame freezes. -* Q2.1.22:: XEmacs seems to take a really long time to do some things. -* Q2.1.23:: Movemail on Linux does not work for XEmacs 19.15 and later. - -Customization and Options - -* Q3.0.1:: What version of Emacs am I running? -* Q3.0.2:: How do I evaluate Elisp expressions? -* Q3.0.3:: @code{(setq tab-width 6)} behaves oddly. -* Q3.0.4:: How can I add directories to the @code{load-path}? -* Q3.0.5:: How to check if a lisp function is defined? -* Q3.0.6:: Can I force the output of @code{(face-list)} to a buffer? -* Q3.0.7:: Font selections don't get saved after @code{Save Options}. -* Q3.0.8:: How do I make a single minibuffer frame? -* Q3.0.9:: What is @code{Customize}? - -X Window System & Resources: -* Q3.1.1:: Where is a list of X resources? -* Q3.1.2:: How can I detect a color display? -* Q3.1.3:: @code{(set-screen-width)} worked in 19.6, but not in 19.13? -* Q3.1.4:: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? -* Q3.1.5:: How can I get the icon to just say @samp{XEmacs}? -* Q3.1.6:: How can I have the window title area display the full path? -* Q3.1.7:: @samp{xemacs -name junk} doesn't work? -* Q3.1.8:: @samp{-iconic} doesn't work. - -Textual Fonts & Colors: -* Q3.2.1:: How can I set color options from @file{.emacs}? -* Q3.2.2:: How do I set the text, menu and modeline fonts? -* Q3.2.3:: How can I set the colors when highlighting a region? -* Q3.2.4:: How can I limit color map usage? -* Q3.2.5:: My tty supports color, but XEmacs doesn't use them. -* Q3.2.6:: Can I have pixmap backgrounds in XEmacs? - -The Modeline: -* Q3.3.1:: How can I make the modeline go away? -* Q3.3.2:: How do you have XEmacs display the line number in the modeline? -* Q3.3.3:: How do I get XEmacs to put the time of day on the modeline? -* Q3.3.4:: How do I turn off current chapter from AUC TeX modeline? -* Q3.3.5:: How can one change the modeline color based on the mode used? - -Multiple Device Support: -* Q3.4.1:: How do I open a frame on another screen of my multi-headed display? -* Q3.4.2:: Can I really connect to a running XEmacs after calling up over a modem? How? - -The Keyboard: -* Q3.5.1:: How can I bind complex functions (or macros) to keys? -* Q3.5.2:: How can I stop down-arrow from adding empty lines to the bottom of my buffers? -* Q3.5.3:: How do I bind C-. and C-; to scroll one line up and down? -* Q3.5.4:: Globally binding @kbd{Delete}? -* Q3.5.5:: Scrolling one line at a time. -* Q3.5.6:: How to map @kbd{Help} key alone on Sun type4 keyboard? -* Q3.5.7:: How can you type in special characters in XEmacs? -* Q3.5.8:: Why does @code{(global-set-key [delete-forward] 'delete-char)} complain? -* Q3.5.9:: How do I make the Delete key delete forward? -* Q3.5.10:: Can I turn on @dfn{sticky} modifier keys? -* Q3.5.11:: How do I map the arrow keys? - -The Cursor: -* Q3.6.1:: Is there a way to make the bar cursor thicker? -* Q3.6.2:: Is there a way to get back the old block cursor where the cursor covers the character in front of the point? -* Q3.6.3:: Can I make the cursor blink? - -The Mouse and Highlighting: -* Q3.7.1:: How can I turn off Mouse pasting? -* Q3.7.2:: How do I set control/meta/etc modifiers on mouse buttons? -* Q3.7.3:: Clicking the left button does not do anything in buffer list. -* Q3.7.4:: How can I get a list of buffers when I hit mouse button 3? -* Q3.7.5:: Why does cut-and-paste not work between XEmacs and a cmdtool? -* Q3.7.6:: How I can set XEmacs up so that it pastes where the text cursor is? -* Q3.7.7:: How do I select a rectangular region? -* Q3.7.8:: Why does @kbd{M-w} take so long? - -The Menubar and Toolbar: -* Q3.8.1:: How do I get rid of the menu (or menubar)? -* Q3.8.2:: Can I customize the basic menubar? -* Q3.8.3:: How do I control how many buffers are listed in the menu @code{Buffers} list? -* Q3.8.4:: Resources like @code{Emacs*menubar*font} are not working? -* Q3.8.5:: How can I bind a key to a function to toggle the toolbar? - -Scrollbars: -* Q3.9.1:: How can I disable the scrollbar? -* Q3.9.2:: How can one use resources to change scrollbar colors? -* Q3.9.3:: Moving the scrollbar can move the point; can I disable this? -* Q3.9.4:: How can I get automatic horizontal scrolling? - -Text Selections: -* Q3.10.1:: How can I turn off or change highlighted selections? -* Q3.10.2:: How do I get that typing on an active region removes it? -* Q3.10.3:: Can I turn off the highlight during isearch? -* Q3.10.4:: How do I turn off highlighting after @kbd{C-x C-p} (mark-page)? -* Q3.10.5:: The region disappears when I hit the end of buffer while scrolling. - -Major Subsystems - -* Q4.0.1:: How do I set up VM to retrieve remote mail using POP? -* Q4.0.2:: How do I get VM to filter mail for me? -* Q4.0.3:: How can I get VM to automatically check for new mail? -* Q4.0.4:: [This question intentionally left blank] -* Q4.0.5:: How do I get my outgoing mail archived? -* Q4.0.6:: I have various addresses at which I receive mail. How can I tell VM to ignore them when doing a "reply-all"? -* Q4.0.7:: Is there a mailing list or FAQ for VM? -* Q4.0.8:: Remote mail reading with VM. -* Q4.0.9:: rmail or VM gets an error incorporating new mail. -* Q4.0.10:: How do I make VM stay in a single frame? -* Q4.0.11:: How do I make VM or mh-e display graphical smilies? -* Q4.0.12:: Customization of VM not covered in the manual or here. - -Web browsing with W3: -* Q4.1.1:: What is W3? -* Q4.1.2:: How do I run W3 from behind a firewall? -* Q4.1.3:: Is it true that W3 supports style sheets and tables? - -Reading Netnews and Mail with Gnus: -* Q4.2.1:: GNUS, (ding) Gnus, Gnus 5, September Gnus, Red Gnus, Quassia Gnus, argh! -* Q4.2.2:: [This question intentionally left blank] -* Q4.2.3:: How do I make Gnus stay within a single frame? -* Q4.2.4:: How do I customize the From: line? - -Other Mail & News: -* Q4.3.1:: How can I read and/or compose MIME messages? -* Q4.3.2:: What is TM and where do I get it? -* Q4.3.3:: Why isn't this @code{movemail} program working? -* Q4.3.4:: Movemail is also distributed by Netscape? Can that cause problems? -* Q4.3.5:: Where do I find pstogif (required by tm)? - -Sparcworks, EOS, and WorkShop: -* Q4.4.1:: What is SPARCworks, EOS, and WorkShop - -Energize: -* Q4.5.1:: What is/was Energize? - -Infodock: -* Q4.6.1:: What is Infodock? - -Other Unbundled Packages: -* Q4.7.1:: What is AUC TeX? Where do you get it? -* Q4.7.2:: Are there any Emacs Lisp Spreadsheets? -* Q4.7.3:: Byte compiling AUC TeX on XEmacs 19.14 -* Q4.7.4:: Problems installing AUC TeX -* Q4.7.5:: Is there a reason for an Emacs package not to be included in XEmacs? -* Q4.7.6:: Is there a MatLab mode? - -The Miscellaneous Stuff - -* Q5.0.1:: How can I do source code highlighting using font-lock? -* Q5.0.2:: I do not like cc-mode. How do I use the old c-mode? -* Q5.0.3:: How do I get @samp{More} Syntax Highlighting on by default? -* Q5.0.4:: How can I enable auto-indent? -* Q5.0.5:: How can I get XEmacs to come up in text/auto-fill mode by default? -* Q5.0.6:: How do I start up a second shell buffer? -* Q5.0.7:: Telnet from shell filters too much. -* Q5.0.8:: Why does edt emulation not work? -* Q5.0.9:: How can I emulate VI and use it as my default mode? -* Q5.0.10:: [This question intentionally left blank] -* Q5.0.11:: Filladapt doesn't work in 19.15? -* Q5.0.12:: How do I disable gnuserv from opening a new frame? -* Q5.0.13:: How do I start gnuserv so that each subsequent XEmacs is a client? -* Q5.0.14:: Strange things are happening in Shell Mode. -* Q5.0.15:: Where do I get the latest CC Mode? -* Q5.0.16:: I find auto-show-mode disconcerting. How do I turn it off? -* Q5.0.17:: How can I get two instances of info? -* Q5.0.18:: I upgraded to XEmacs 19.14 and gnuserv stopped working -* Q5.0.19:: Is there something better than LaTeX mode? -* Q5.0.20:: Is there a way to start a new XEmacs if there's no gnuserv running, and otherwise use gnuclient? - -Emacs Lisp Programming Techniques: -* Q5.1.1:: The difference in key sequences between XEmacs and GNU Emacs? -* Q5.1.2:: Can I generate "fake" keyboard events? -* Q5.1.3:: Could you explain @code{read-kbd-macro} in more detail? -* Q5.1.4:: What is the performance hit of @code{let}? -* Q5.1.5:: What is the recommended use of @code{setq}? -* Q5.1.6:: What is the typical misuse of @code{setq} ? -* Q5.1.7:: I like the the @code{do} form of cl, does it slow things down? -* Q5.1.8:: I like recursion, does it slow things down? -* Q5.1.9:: How do I put a glyph as annotation in a buffer? -* Q5.1.10:: @code{map-extents} won't traverse all of my extents! -* Q5.1.11:: My elisp program is horribly slow. Is there an easy way to find out where it spends time? - -Sound: -* Q5.2.1:: How do I turn off the sound? -* Q5.2.2:: How do I get funky sounds instead of a boring beep? -* Q5.2.3:: What's NAS, how do I get it? -* Q5.2.4:: Sunsite sounds don't play. - -Miscellaneous: -* Q5.3.1:: How do you make XEmacs indent CL if-clauses correctly? -* Q5.3.2:: Fontifying hangs when editing a postscript file. -* Q5.3.3:: How can I print WYSIWYG a font-locked buffer? -* Q5.3.4:: Getting @kbd{M-x lpr} to work with postscript printer. -* Q5.3.5:: How do I specify the paths that XEmacs uses for finding files? -* Q5.3.6:: [This question intentionally left blank] -* Q5.3.7:: Can I have the end of the buffer delimited in some way? -* Q5.3.8:: How do I insert today's date into a buffer? -* Q5.3.9:: Are only certain syntactic character classes available for abbrevs? -* Q5.3.10:: How can I get those oh-so-neat X-Face lines? -* Q5.3.11:: How do I add new Info directories? -* Q5.3.12:: What do I need to change to make printing work? - -What the Future Holds - -* Q6.0.1:: What is new in 20.2? -* Q6.0.2:: What is new in 20.3? -* Q6.0.3:: What is new in 20.4? -* Q6.0.4:: Procedural changes in XEmacs development. -@end detailmenu -@end menu - -@node Introduction, Installation, Top, Top -@unnumbered 1 Introduction, Policy, Credits - -Learning XEmacs is a lifelong activity. Even people who have used Emacs -for years keep discovering new features. Therefore this document cannot -be complete. Instead it is aimed at the person who is either -considering XEmacs for their own use, or has just obtained it and is -wondering what to do next. It is also useful as a reference to -available resources. - -The previous maintainer of the FAQ was @email{rossini@@stat.sc.edu, -Anthony Rossini}, who started it, after getting tired of hearing JWZ -complain about repeatedly having to answer questions. -@email{ben@@666.com, Ben Wing} and @email{cthomp@@xemacs.org, Chuck -Thompson}, the principal authors of XEmacs, then took over and Ben did -a massive update reorganizing the whole thing. At which point Anthony -took back over, but then had to give it up again. Some of the other -contributors to this FAQ are listed later in this document. - -The previous version was converted to hypertext format, and edited by -@email{steve@@altair.xemacs.org, Steven L. Baur}. It was converted back to -texinfo by @email{hniksic@@srce.hr, Hrvoje Niksic}. - -The FAQ was then maintained by @email{andreas@@sccon.com, Andreas -Kaempf}, who passed it on to @email{faq@@xemacs.org, Christian -Nyb@o{}}, the current FAQ maintainer. - -If you notice any errors or items which should be added or amended to -this FAQ please send email to @email{faq@@xemacs.org, Christian -Nyb@o{}}. Include @samp{XEmacs FAQ} on the Subject: line. - -@menu -Introduction: -* Q1.0.1:: What is XEmacs? -* Q1.0.2:: What is the current version of XEmacs? -* Q1.0.3:: Where can I find it? -* Q1.0.4:: Why Another Version of Emacs? -* Q1.0.5:: Why Haven't XEmacs and GNU Emacs Merged? -* Q1.0.6:: Where can I get help? -* Q1.0.7:: Where is the mailing list archived? -* Q1.0.8:: How do you pronounce XEmacs? -* Q1.0.9:: What does XEmacs look like? -* Q1.0.10:: Is there a port of XEmacs to Microsoft ('95 or NT)? -* Q1.0.11:: Is there a port of XEmacs to the Macintosh? -* Q1.0.12:: Is there a port of XEmacs to NextStep? -* Q1.0.13:: Is there a port of XEmacs to OS/2? -* Q1.0.14:: Where can I get a printed copy of the XEmacs users manual? - -Policies: -* Q1.1.1:: What is the FAQ editorial policy? -* Q1.1.2:: How do I become a Beta Tester? -* Q1.1.3:: How do I contribute to XEmacs itself? - -Credits: -* Q1.2.1:: Who wrote XEmacs? -* Q1.2.2:: Who contributed to this version of the FAQ? -* Q1.2.3:: Who contributed to the FAQ in the past? - -Internationalization: -* Q1.3.1:: What is the status of XEmacs v20? -* Q1.3.2:: What is the status of Asian-language support, aka @var{mule}? -* Q1.3.3:: How do I type non-ASCII characters? -* Q1.3.4:: Can XEmacs messages come out in a different language? -* Q1.3.5:: Please explain the various input methods in MULE/XEmacs 20.0 -* Q1.3.6:: How do I portably code for MULE/XEmacs 20.0? -* Q1.3.7:: How about Cyrillic Modes? - -Getting Started: -* Q1.4.1:: What is a @file{.emacs} and is there a sample one? -* Q1.4.2:: Can I use the same @file{.emacs} with the other Emacs? -* Q1.4.3:: Any good XEmacs tutorials around? -* Q1.4.4:: May I see an example of a useful XEmacs Lisp function? -* Q1.4.5:: And how do I bind it to a key? -* Q1.4.6:: What's the difference between a macro and a function? -* Q1.4.7:: Why options saved with 19.13 don't work with 19.14 or later? -@end menu - -@node Q1.0.1, Q1.0.2, Introduction, Introduction -@unnumberedsec 1.0: Introduction -@unnumberedsubsec Q1.0.1: What is XEmacs? - - -An alternative to GNU Emacs, originally based on an early alpha version -of FSF's version 19, and has diverged quite a bit since then. XEmacs -was known as Lucid Emacs through version 19.10. Almost all features of -GNU Emacs are supported in XEmacs. The maintainers of XEmacs actively -track changes to GNU Emacs while also working to add new features. - -@node Q1.0.2, Q1.0.3, Q1.0.1, Introduction -@unnumberedsubsec Q1.0.2: What is the current version of XEmacs? - -XEmacs 20.4 is a minor upgrade from 20.3, containing many bugfixes. It -was released in February 1998. - -XEmacs 19.16 was the last release of v19, released in November, 1997, -which was also the last version without international language support. - -@node Q1.0.3, Q1.0.4, Q1.0.2, Introduction -@unnumberedsubsec Q1.0.3: Where can I find it? - -The canonical source and binaries is found via anonymous FTP at: - -@example -@uref{ftp://ftp.xemacs.org/pub/xemacs/} -@end example - -@node Q1.0.4, Q1.0.5, Q1.0.3, Introduction -@unnumberedsubsec Q1.0.4: Why Another Version of Emacs? - -For a detailed description of the differences between GNU Emacs and -XEmacs and a detailed history of XEmacs, check out the -@example -@uref{http://www.xemacs.org/NEWS.html, NEWS file} -@end example - -However, here is a list of some of the reasons why we think you might -consider using it: - -@itemize @bullet -@item -It looks nicer. - -@item -The XEmacs maintainers are generally more receptive to suggestions than -the GNU Emacs maintainers. - -@item -Many more bundled packages than GNU Emacs - -@item -Binaries are available for many common operating systems. - -@item -Face support on TTY's. - -@item -A built-in toolbar. - -@item -Better Motif compliance. - -@item -Some internationalization support (including full MULE support, if -compiled with it.) - -@item -Variable-width fonts. - -@item -Variable-height lines. - -@item -Marginal annotations. - -@item -ToolTalk support. - -@item -XEmacs can be used as an Xt widget, and can be embedded within another -application. - -@item -Horizontal and vertical scrollbars (using real toolkit scrollbars). - -@item -Better APIs (and performance) for attaching fonts, colors, and other -properties to text. - -@item -The ability to embed arbitrary graphics in a buffer. - -@item -Completely compatible (at the C level) with the Xt-based toolkits. - -@item -First production Web Browser supporting Style Sheets. -@end itemize - -@node Q1.0.5, Q1.0.6, Q1.0.4, Introduction -@unnumberedsubsec Q1.0.5: Why Haven't XEmacs and GNU Emacs Merged? - -There are currently irreconcilable differences in the views about -technical, programming, design and organizational matters between RMS -and the XEmacs development team which provide little hope for a merge to -take place in the short-term future. - -If you have a comment to add regarding the merge, it is a good idea to -avoid posting to the newsgroups, because of the very heated flamewars -that often result. Mail your questions to @email{xemacs-beta@@xemacs.org} and -@email{bug-gnu-emacs@@prep.ai.mit.edu}. - -@node Q1.0.6, Q1.0.7, Q1.0.5, Introduction -@unnumberedsubsec Q1.0.6: Where can I get help? - -Probably the easiest way, if everything is installed, is to use info, by -pressing @kbd{C-h i}, or selecting @code{Emacs Info} from the Help Menu. - -Also, @kbd{M-x apropos} will look for commands for you. - -Try reading this FAQ, examining the regular GNU Emacs FAQ (which can be -found with the Emacs 19 distribution) as well as at -@uref{http://www.eecs.nwu.edu/emacs/faq/} and reading the Usenet group -comp.emacs.xemacs. - -If that does not help, try posting your question to comp.emacs.xemacs. -Please @strong{do not} post XEmacs related questions to gnu.emacs.help. - -If you cannot post or read Usenet news, there is a corresponding mailing -list which is available. It can be subscribed to by sending a message -with a subject of @samp{subscribe} to @email{xemacs-request@@xemacs.org} -for subscription information and @email{xemacs@@xemacs.org} to send messages -to the list. - -To cancel a subscription, you @strong{must} use the xemacs-request -address. Send a message with a subject of @samp{unsubscribe} to be -removed. - -@node Q1.0.7, Q1.0.8, Q1.0.6, Introduction -@unnumberedsubsec Q1.0.7: Where is the mailing list archived? - -The mailing list was archived in the directory -@example -@uref{ftp://ftp.xemacs.org/pub/mlists/}. -@end example - -However, this archive is out of date. The current mailing list server -supports an @code{archive} feature, which may be utilized. - -@node Q1.0.8, Q1.0.9, Q1.0.7, Introduction -@unnumberedsubsec Q1.0.8: How do you pronounce XEmacs? - -I pronounce it @samp{Eks eemax}. - -@node Q1.0.9, Q1.0.10, Q1.0.8, Introduction -@unnumberedsubsec Q1.0.9: What does XEmacs look like? - -Screen snapshots are available in the WWW version of the FAQ. -@example -@uref{http://www.xemacs.org/faq/xemacs-faq.html} -@end example - -@node Q1.0.10, Q1.0.11, Q1.0.9, Introduction -@unnumberedsubsec Q1.0.10: Is there a port of XEmacs to Microsoft ('95 or NT)? - -Thanks to efforts of many people, coordinated by -@email{davidh@@wr.com.au, David Hobley} and @email{marcpa@@cam.org, Marc -Paquette}, beta versions of XEmacs now run on 32-bit Windows platforms -(NT and 95). The current betas require having an X server to run -XEmacs; however, a native NT/95 port is in alpha, thanks to -@email{jhar@@tardis.ed.ac.uk, Jonathan Harris}. - -Although some features are still unimplemented, XEmacs 21.0 will support -MS-Windows. - -The NT development is now coordinated by a mailing list at -@email{xemacs-nt@@xemacs.org}. - -If you are willing to contribute or want to follow the progress, mail to -@iftex -@* -@end iftex -@email{xemacs-nt-request@@xemacs.org} to subscribe. - -Furthermore, Altrasoft is seeking corporate and government sponsors to -help fund a fully native port of XEmacs to Windows 95 and NT using -full-time, senior-level staff working under a professionally managed -project structure. See @uref{http://www.altrasoft.com/, the Altrasoft -web site} for more details -or contact Altrasoft directly at 1-888-ALTSOFT. - - -The closest existing port is @dfn{Win-Emacs}, which is based on Lucid -Emacs 19.6. Available from @uref{http://www.pearlsoft.com/}. - -There's a port of GNU Emacs (not XEmacs) at -@example -@uref{http://www.cs.washington.edu/homes/voelker/ntemacs.html}. -@end example - -@node Q1.0.11, Q1.0.12, Q1.0.10, Introduction -@unnumberedsubsec Q1.0.11: Is there a port of XEmacs to the Macintosh? -@c changed - -There has been a port to the MachTen environment of XEmacs 19.13, but no -patches have been submitted to the maintainers to get this in the -mainstream distribution. - -For the MacOS, there is a port of -@uref{ftp://ftp.cs.cornell.edu/pub/parmet/, Emacs 18.59}. - -@node Q1.0.12, Q1.0.13, Q1.0.11, Introduction -@unnumberedsubsec Q1.0.12: Is there a port of XEmacs to NextStep? - -Carl Edman, apparently no longer at @email{cedman@@princeton.edu}, did -the port of GNU Emacs to NeXTstep and expressed interest in doing the -XEmacs port, but never went any farther. - -@node Q1.0.13, Q1.0.14, Q1.0.12, Introduction -@unnumberedsubsec Q1.0.13: Is there a port of XEmacs to OS/2? - -No, and there is no news of anyone working on it. - -@node Q1.0.14, Q1.1.1, Q1.0.13, Introduction -@unnumberedsubsec Q1.0.14: Where can I obtain a printed copy of the XEmacs users manual? - -Altrasoft Associates, a firm specializing in Emacs-related support and -development, will be maintaining the XEmacs user manual. The firm plans -to begin publishing printed copies of the manual soon. -@c This used to say `March 1997'! - -@example - Web: @uref{http://www.xemacs.com} - E-mail: @email{info@@xemacs.com} - Tel: +1 408 243 3300 -@end example - -@node Q1.1.1, Q1.1.2, Q1.0.14, Introduction -@unnumberedsec 1.1: Policies -@unnumberedsubsec Q1.1.1: What is the FAQ editorial policy? - -The FAQ is actively maintained and modified regularly. All links should -be up to date. - -Changes are displayed on a monthly basis. @dfn{Months}, for this -purpose are defined as the 5th of the month through the 5th of the -month. Preexisting questions that have been changed are marked as such. -Brand new questions are tagged. - -All submissions are welcome. E-mail submissions -to -@iftex -@* -@end iftex -@email{faq@@xemacs.org, Christian Nyb@o{}}. - -Please make sure that @samp{XEmacs FAQ} appears on the Subject: line. -If you think you have a better way of answering a question, or think a -question should be included, I'd like to hear about it. Questions and -answers included into the FAQ will be edited for spelling and grammar, -and will be attributed. Answers appearing without attribution are -either from versions of the FAQ dated before May 1996, or are from one -of the four people listed at the top of this document. Answers quoted -from Usenet news articles will always be attributed, regardless of the -author. - -@node Q1.1.2, Q1.1.3, Q1.1.1, Introduction -@unnumberedsubsec Q1.1.2: How do I become a Beta Tester? - -Send an email message to @email{xemacs-beta-request@@xemacs.org} with a -subject line of @samp{subscribe}. - -Be prepared to get your hands dirty, as beta testers are expected to -identify problems as best they can. - -@node Q1.1.3, Q1.2.1, Q1.1.2, Introduction -@unnumberedsubsec Q1.1.3: How do I contribute to XEmacs itself? - -Ben Wing @email{ben@@666.com} writes: - -@quotation -BTW if you have a wish list of things that you want added, you have to -speak up about it! More specifically, you can do the following if you -want a feature added (in increasing order of usefulness): - -@itemize @bullet -@item -Make a posting about a feature you want added. - -@item -Become a beta tester and make more postings about those same features. - -@item -Convince us that you're going to use the features in some cool and -useful way. - -@item -Come up with a clear and well-thought-out API concerning the features. - -@item -Write the code to implement a feature and send us a patch. -@end itemize - -(not that we're necessarily requiring you to write the code, but we can -always hope :) -@end quotation - -@node Q1.2.1, Q1.2.2, Q1.1.3, Introduction -@unnumberedsec 1.2: Credits -@unnumberedsubsec Q1.2.1: Who wrote XEmacs? - -XEmacs is the result of the time and effort of many people. The -developers responsible for the 19.16/20.x releases are: - -@itemize @bullet -@item @email{martin@@xemacs.org, Martin Buchholz} -@ifhtml -
Portrait of Martin Buchholz
-@end ifhtml - - -@item @email{steve@@altair.xemacs.org, Steve Baur} - -@ifhtml -
Portrait of Steve Baur
-@end ifhtml - - -@item @email{hniksic@@srce.hr, Hrvoje Niksic} - -@ifhtml -
Portrait of Hrvoje Niksic
-@end ifhtml - -@end itemize - -The developers responsible for the 19.14 release are: - -@itemize @bullet -@item @email{cthomp@@xemacs.org, Chuck Thompson} -@ifhtml -
Portrait of Chuck Thompson
-@end ifhtml - -Chuck was Mr. XEmacs from 19.11 through 19.14, and is responsible -for XEmacs becoming a widely distributed program over the Internet. - -@item @email{ben@@666.com, Ben Wing} -@ifhtml -
Portrait of Ben Wing
-@end ifhtml - -@end itemize - - -@itemize @bullet -@item @email{jwz@@netscape.com, Jamie Zawinski} -@ifhtml -
Portrait of Jamie Zawinski
-@end ifhtml - -Jamie Zawinski was Mr. Lucid Emacs from 19.0 through 19.10, the last -release actually named Lucid Emacs. Richard Mlynarik was crucial to -most of those releases. - -@item @email{mly@@adoc.xerox.com, Richard Mlynarik} -@end itemize - -Along with many other contributors, partially enumerated in the -@samp{About XEmacs} option in the Help menu. - -@node Q1.2.2, Q1.2.3, Q1.2.1, Introduction -@unnumberedsubsec Q1.2.2: Who contributed to this version of the FAQ? - -The following people contributed valuable suggestions to building this -version of the FAQ (listed in alphabetical order): - -@itemize @bullet -@item @email{steve@@xemacs.org, SL Baur} - -@item @email{hniksic@@srce.hr, Hrvoje Niksic} - -@item @email{Aki.Vehtari@@hut.fi, Aki Vehtari} - -@end itemize - -@node Q1.2.3, Q1.3.1, Q1.2.2, Introduction -@unnumberedsubsec Q1.2.3: Who contributed to the FAQ in the past? - -This is only a partial list, as many names were lost in a hard disk -crash some time ago. - -@itemize @bullet -@item @email{binge@@aloft.att.com, Curtis.N.Bingham} - -@item @email{rjc@@cogsci.ed.ac.uk, Richard Caley} - -@item @email{cognot@@ensg.u-nancy.fr, Richard Cognot} - -@item @email{wgd@@martigny.ai.mit.edu, William G. Dubuque} - -@item @email{eeide@@cs.utah.edu, Eric Eide} - -@item @email{cflatter@@nrao.edu, Chris Flatters} - -@item @email{ginsparg@@adra.com, Evelyn Ginsparg} - -@item @email{hall@@aplcenmp.apl.jhu.edu, Marty Hall} - -@item @email{dkindred@@cmu.edu, Darrell Kindred} - -@item @email{dmoore@@ucsd.edu, David Moore} - -@item @email{arup+@@cmu.edu, Arup Mukherjee} - -@item @email{nickel@@prz.tu-berlin.de, Juergen Nickelsen} - -@item @email{powell@@csl.ncsa.uiuc.edu, Kevin R. Powell} - -@item @email{dworkin@@ccs.neu.edu, Justin Sheehy} - -@item @email{stig@@hackvan.com, Stig} - -@item @email{Aki.Vehtari@@hut.fi, Aki Vehtari} -@end itemize - -@node Q1.3.1, Q1.3.2, Q1.2.3, Introduction -@unnumberedsec 1.3: Internationalization -@unnumberedsubsec Q1.3.1: What is the status of XEmacs v20? - -XEmacs v20 is the version of XEmacs that includes MULE (Asian-language) -support. XEmacs 20.0 was released in February 1997, followed by XEmacs -20.2 in May, XEmacs 20.3 in November and XEmacs 20.4 in February 1998. When compiled without MULE -support, 20.4 is approximately as stable as 19.16, and probably faster -(due to additional optimization work.) - -As of XEmacs 20.3, version 20 is @emph{the} supported version of -XEmacs. This means that 19.16 will optionally receive stability fixes -(if any), but that all the real development work will be done on the v20 -tree. - -The incompatible changes in XEmacs 20 include the additional byte-codes, -new primitive data types (@code{character}, @code{char-table}, and -@code{range-table}). This means that the character-integer equivalence -inherent to all the previous Emacs and XEmacs releases no longer -applies. - -However, to avoid breaking old code, many functions that should normally -accept characters work with integers, and vice versa. For more -information, see the Lisp reference manual. Here is a relevant excerpt, -for your convenience. - -@quotation - In XEmacs version 19, and in all versions of FSF GNU Emacs, a -@dfn{character} in XEmacs Lisp is nothing more than an integer. -This is yet another holdover from XEmacs Lisp's derivation from -vintage-1980 Lisps; modern versions of Lisp consider this equivalence -a bad idea, and have separate character types. In XEmacs version 20, -the modern convention is followed, and characters are their own -primitive types. (This change was necessary in order for @sc{MULE}, -i.e. Asian-language, support to be correctly implemented.) - - Even in XEmacs version 20, remnants of the equivalence between -characters and integers still exist; this is termed the @dfn{char-int -confoundance disease}. In particular, many functions such as @code{eq}, -@code{equal}, and @code{memq} have equivalent functions (@code{old-eq}, -@code{old-equal}, @code{old-memq}, etc.) that pretend like characters -are integers are the same. Byte code compiled under any version 19 -Emacs will have all such functions mapped to their @code{old-} equivalents -when the byte code is read into XEmacs 20. This is to preserve -compatibility -- Emacs 19 converts all constant characters to the equivalent -integer during byte-compilation, and thus there is no other way to preserve -byte-code compatibility even if the code has specifically been written -with the distinction between characters and integers in mind. - - Every character has an equivalent integer, called the @dfn{character -code}. For example, the character @kbd{A} is represented as the -@w{integer 65}, following the standard @sc{ASCII} representation of -characters. If XEmacs was not compiled with @sc{MULE} support, the -range of this integer will always be 0 to 255 -- eight bits, or one -byte. (Integers outside this range are accepted but silently truncated; -however, you should most decidedly @emph{not} rely on this, because it -will not work under XEmacs with @sc{MULE} support.) When @sc{MULE} -support is present, the range of character codes is much -larger. (Currently, 19 bits are used.) - - FSF GNU Emacs uses kludgy character codes above 255 to represent -keyboard input of @sc{ASCII} characters in combination with certain -modifiers. XEmacs does not use this (a more general mechanism is -used that does not distinguish between @sc{ASCII} keys and other -keys), so you will never find character codes above 255 in a -non-@sc{MULE} XEmacs. - - Individual characters are not often used in programs. It is far more -common to work with @emph{strings}, which are sequences composed of -characters. -@end quotation - -@node Q1.3.2, Q1.3.3, Q1.3.1, Introduction -@unnumberedsubsec Q1.3.2: What is the status of Asian-language support, aka MULE? - -The MULE support works OK but still needs a fair amount of work before -it's really solid. We could definitely use some help here, esp. people -who speak Japanese and will use XEmacs/MULE to work with Japanese and -have some experience with E-Lisp. - -As the fundings on Mule have stopped, the Mule part of XEmacs is currently -looking for a full-time maintainer. If you can provide help here, or -are willing to fund the work, please mail to @email{xemacs-beta@@xemacs.org}. - -@xref{Q1.1.2}. - -@node Q1.3.3, Q1.3.4, Q1.3.2, Introduction -@unnumberedsubsec Q1.3.3: How do I type non-ASCII characters? - -See question 3.5.7 (@xref{Q3.5.7}) in part 3 of this FAQ. - -@node Q1.3.4, Q1.3.5, Q1.3.3, Introduction -@unnumberedsubsec Q1.3.4: Can XEmacs messages come out in a different language? - -The message-catalog support has mostly been written but doesn't -currently work. The first release of XEmacs 20 will @emph{not} support -it. However, menubar localization @emph{does} work, even in 19.14. To -enable it, add to your @file{Emacs} file entries like this: - -@example -Emacs*XlwMenu.resourceLabels: True -Emacs*XlwMenu.file.labelString: Fichier -Emacs*XlwMenu.openInOtherWindow.labelString: In anderem Fenster offnen -@end example - -The name of the resource is derived from the non-localized entry by -removing punctuation and capitalizing as above. - -@node Q1.3.5, Q1.3.6, Q1.3.4, Introduction -@unnumberedsubsec Q1.3.5: Please explain the various input methods in MULE/XEmacs 20.0 - -@email{morioka@@jaist.ac.jp, MORIOKA Tomohiko} writes: - -@quotation -Original Mule supports the following input methods: Wnn4, Wnn6, Canna, SJ3 -and XIM. Interfaces for Wnn and SJ3 uses the @code{egg} user -interface. Interface for Canna does not use @samp{egg}. I don't know -about XIM. It is to support ATOK, of course, it may work for another -servers. - -Wnn supports Japanese, Chinese and Korean. It is made by OMRON and Kyôto -university. It is a powerful and complex system. Wnn4 is free and Wnn6 -is not free. - -Canna supports only Japanese. It is made by NEC. It is a simple and -powerful system. Canna uses only grammar (Wnn uses grammar and -probability between words), so I think Wnn is cleverer than Canna, -however Canna users made a good grammar and dictionary. So for standard -modern Japanese, Canna seems cleverer than Wnn4. In addition, the UNIX -version of Canna is free (now there is a Microsoft Windows version). - -SJ3 supports only Japanese. It is made by Sony. XIM supports was made -to use ATOK (a major input method in personal computer world). XIM is -the standard for accessing input methods bundled in Japanese versions of -Solaris. (XEmacs 20 will support XIM input). - -Egg consists of following parts: - -@enumerate -@item -Input character Translation System (ITS) layer. -It translates ASCII inputs to Kana/PinYin/Hangul characters. - -@item -Kana/PinYin/Hangul to Kanji transfer layer. -It is interface layer for network Kana-Kanji server (Wnn and Sj3). -@end enumerate - -These input methods are modal, namely there are mode, alphabet mode and -Kana-Kanji transfer mode. However there are mode-less input methods for -Egg and Canna. @samp{Boiled-egg} is a mode-less input method running on -Egg. For Canna, @samp{canna.el} has a tiny boiled-egg like command, -@code{(canna-boil)}, and there are some boiled-egg like utilities. In -addition, it was planned to make an abstraction for all transfer type -input methods. However authors of input methods are busy, so maybe this -plan is stopped. Perhaps after Mule merged GNU Emacs will be released, -it will be continued. -@end quotation - -@node Q1.3.6, Q1.3.7, Q1.3.5, Introduction -@unnumberedsubsec Q1.3.6: How do I portably code for MULE/XEmacs 20? - -@email{morioka@@jaist.ac.jp, MORIOKA Tomohiko} writes: - -@quotation -MULE and XEmacs are quite different. So the application -implementor must write separate code for these mule variants. - -MULE and the next version of Emacs are similar but the symbols are very -different---requiring separate code as well. - -Namely we must support 3 kinds of mule variants and 4 or 5 or 6 kinds of -emacs variants... (;_;) I'm shocked, so I wrote a wrapper package called -@code{emu} to provide a common interface. - -I have the following suggestions about dealing with mule variants: - -@itemize @bullet -@item -@code{(featurep 'mule)} @code{t} on all mule variants - -@item -@code{(boundp 'MULE)} is @code{t} on only MULE. Maybe the next version -of Emacs will not have this symbol. - -@item -MULE has a variable @code{mule-version}. Perhaps the next version of -Emacs will have this variable as well. -@end itemize - -Following is a sample to distinguish mule variants: - -@lisp -(if (featurep 'mule) - (cond ((boundp 'MULE) - ;; for original Mule - ) - ((string-match "XEmacs" emacs-version) - ;; for XEmacs with Mule - ) - (t - ;; for next version of Emacs - )) - ;; for old emacs variants - ) -@end lisp -@end quotation - -@node Q1.3.7, Q1.4.1, Q1.3.6, Introduction -@unnumberedsubsec Q1.3.7: How about Cyrillic Modes? - -@email{ilya@@math.ohio-state.edu, Ilya Zakharevich} writes: - -@quotation -There is a cyrillic mode in the file @file{mysetup.zip} in -@iftex -@* -@end iftex -@uref{ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs/}. This is a -modification to @email{ava@@math.jhu.ed, Valery Alexeev's} @file{russian.el} -which can be obtained from -@end quotation - -@uref{http://ftpsearch.ntnu.no/?query=russian.el.Z}. -@c dead link above - -@email{d.barsky@@ee.surrey.ac.uk, Dima Barsky} writes: - -@quotation -There is another cyrillic mode for both GNU Emacs and XEmacs by -@email{manin@@camelot.mssm.edu, Dmitrii -(Mitya) Manin} at -@iftex - -@end iftex -@uref{http://kulichki-lat.rambler.ru/centrolit/manin/cyr.el}. -@c Link above, was dead. -@c Changed to russian host instead -@end quotation - -@email{rebecca.ore@@op.net, Rebecca Ore} writes: - -@quotation -The fullest resource I found on Russian language use (in and out of -XEmacs) is @uref{http://sunsite.oit.unc.edu/sergei/Software/Software.html} -@end quotation - -@node Q1.4.1, Q1.4.2, Q1.3.7, Introduction -@unnumberedsec 1.4: Getting Started, Backing up & Recovery -@unnumberedsubsec Q1.4.1: What is a @file{.emacs} and is there a sample one? - -The @file{.emacs} file is used to customize XEmacs to your tastes. No -two are alike, nor are they expected to be alike, but that's the point. -The XEmacs distribution contains an excellent starter example in the etc -directory called @file{sample.emacs}. Copy this file from there to your -home directory and rename it @file{.emacs}. Then edit it to suit. - -Starting with 19.14, you may bring the @file{sample.emacs} into an -XEmacs buffer by selecting @samp{Help->Sample .emacs} from the menubar. -To determine the location of the @file{etc} directory type the command -@kbd{C-h v data-directory @key{RET}}. - -@node Q1.4.2, Q1.4.3, Q1.4.1, Introduction -@unnumberedsubsec Q1.4.2: Can I use the same @file{.emacs} with the other Emacs? - -Yes. The sample @file{.emacs} included in the XEmacs distribution will -show you how to handle different versions and flavors of Emacs. - -@node Q1.4.3, Q1.4.4, Q1.4.2, Introduction -@unnumberedsubsec Q1.4.3: Any good tutorials around? - -There's the XEmacs tutorial available from the Help Menu, or by typing -@kbd{C-h t}. To check whether it's available in a non-english language, -type @kbd{C-u C-h t TAB}, type the first letters of your preferred -language, then type @key{RET}. - -There's an Emacs Lisp tutorial at - -@example -@uref{ftp://prep.ai.mit.edu/pub/gnu/emacs-lisp-intro-1.04.tar.gz}. -@end example - -@email{erik@@petaxp.rug.ac.be, Erik Sundermann} has made a tutorial web -page at -@iftex -@* -@end iftex -@uref{http://petaxp.rug.ac.be/~erik/xemacs/}. - -@node Q1.4.4, Q1.4.5, Q1.4.3, Introduction -@unnumberedsubsec Q1.4.4: May I see an example of a useful XEmacs Lisp function? - -The following function does a little bit of everything useful. It does -something with the prefix argument, it examines the text around the -cursor, and it's interactive so it may be bound to a key. It inserts -copies of the current word the cursor is sitting on at the cursor. If -you give it a prefix argument: @kbd{C-u 3 M-x double-word} then it will -insert 3 copies. - -@lisp -(defun double-word (count) - "Insert a copy of the current word underneath the cursor" - (interactive "*p") - (let (here there string) - (save-excursion - (forward-word -1) - (setq here (point)) - (forward-word 1) - (setq there (point)) - (setq string (buffer-substring here there))) - (while (>= count 1) - (insert string) - (decf count)))) -@end lisp - -The best way to see what is going on here is to let XEmacs tell you. -Put the code into an XEmacs buffer, and do a @kbd{C-h f} with the cursor -sitting just to the right of the function you want explained. Eg. move -the cursor to the SPACE between @code{interactive} and @samp{"*p"} and -hit @kbd{C-h f} to see what the function @code{interactive} does. Doing -this will tell you that the @code{*} requires a writable buffer, and -@code{p} converts the prefix argument to a number, and -@code{interactive} allows you to execute the command with @kbd{M-x}. - -@node Q1.4.5, Q1.4.6, Q1.4.4, Introduction -@unnumberedsubsec Q1.4.5: And how do I bind it to a key? - -To bind to a key do: - -@lisp -(global-set-key "\C-cd" 'double-word) -@end lisp - -Or interactively, @kbd{M-x global-set-key} and follow the prompts. - -@node Q1.4.6, Q1.4.7, Q1.4.5, Introduction -@unnumberedsubsec Q1.4.6: What's the difference between a macro and a function? - -Quoting from the Lisp Reference (a.k.a @dfn{Lispref}) Manual: - -@dfn{Macros} enable you to define new control constructs and other -language features. A macro is defined much like a function, but instead -of telling how to compute a value, it tells how to compute another Lisp -expression which will in turn compute the value. We call this -expression the @dfn{expansion} of the macro. - -Macros can do this because they operate on the unevaluated expressions -for the arguments, not on the argument values as functions do. They can -therefore construct an expansion containing these argument expressions -or parts of them. - -Do not confuse the two terms with @dfn{keyboard macros}, which are -another matter, entirely. A keyboard macro is a key bound to several -other keys. Refer to manual for details. - -@node Q1.4.7, , Q1.4.6, Introduction -@unnumberedsubsec Q1.4.7: How come options saved with 19.13 don't work with 19.14 or later? - -There's a problem with options of the form: - -@lisp -(add-spec-list-to-specifier (face-property 'searchm-field 'font) - '((global (nil)))) -@end lisp - -saved by a 19.13 XEmacs that causes a 19.14 XEmacs grief. You must -delete these options. XEmacs 19.14 and later no longer write the -options directly to @file{.emacs} which should allow us to deal with -version incompatibilities better in the future. - -Options saved under XEmacs 19.13 are protected by code that specifically -requires a version 19 XEmacs. This won't be a problem unless you're -using XEmacs v20. You should consider changing the code to read: - -@lisp -(cond - ((and (string-match "XEmacs" emacs-version) - (boundp 'emacs-major-version) - (or (and (= emacs-major-version 19) - (>= emacs-minor-version 12)) - (>= emacs-major-version 20))) - ... - )) -@end lisp - -@node Installation, Customization, Introduction, Top -@unnumbered 2 Installation and Trouble Shooting - -This is part 2 of the XEmacs Frequently Asked Questions list. This -section is devoted to Installation, Maintenance and Trouble Shooting. - -@menu -Installation: -* Q2.0.1:: Running XEmacs without installing. -* Q2.0.2:: XEmacs is too big. -* Q2.0.3:: Compiling XEmacs with Netaudio. -* Q2.0.4:: Problems with Linux and ncurses. -* Q2.0.5:: Do I need X11 to run XEmacs? -* Q2.0.6:: I'm having strange crashes. What do I do? -* Q2.0.7:: Libraries in non-standard locations. -* Q2.0.8:: can't resolve symbol _h_errno -* Q2.0.9:: Where do I find external libraries? -* Q2.0.10:: After I run configure I find a coredump, is something wrong? -* Q2.0.11:: XEmacs can't resolve host names. -* Q2.0.12:: Why can't I strip XEmacs? -* Q2.0.13:: Can't link XEmacs on Solaris with Gcc. -* Q2.0.14:: Make on HP/UX 9 fails after linking temacs - -Trouble Shooting: -* Q2.1.1:: XEmacs just crashed on me! -* Q2.1.2:: Cryptic Minibuffer messages. -* Q2.1.3:: Translation Table Syntax messages at Startup. -* Q2.1.4:: Startup warnings about deducing proper fonts? -* Q2.1.5:: XEmacs cannot connect to my X Terminal. -* Q2.1.6:: XEmacs just locked up my Linux X server. -* Q2.1.7:: HP Alt key as Meta. -* Q2.1.8:: got (wrong-type-argument color-instance-p nil)! -* Q2.1.9:: XEmacs causes my OpenWindows 3.0 server to crash. -* Q2.1.10:: Warnings from incorrect key modifiers. -* Q2.1.11:: Can't instantiate image error... in toolbar -* Q2.1.12:: Regular Expression Problems on DEC OSF1. -* Q2.1.13:: HP/UX 10.10 and @code{create_process} failure -* Q2.1.14:: @kbd{C-g} doesn't work for me. Is it broken? -* Q2.1.15:: How to debug an XEmacs problem with a debugger. -* Q2.1.16:: XEmacs crashes in @code{strcat} on HP/UX 10. -* Q2.1.17:: @samp{Marker does not point anywhere}. -* Q2.1.18:: 19.14 hangs on HP/UX 10.10. -* Q2.1.19:: XEmacs does not follow the local timezone. -* Q2.1.20:: @samp{Symbol's function definition is void: hkey-help-show.} -* Q2.1.21:: Every so often the XEmacs frame freezes. -* Q2.1.22:: XEmacs seems to take a really long time to do some things. -* Q2.1.23:: Movemail on Linux does not work for XEmacs 19.15 and later. -@end menu - -@node Q2.0.1, Q2.0.2, Installation, Installation -@unnumberedsec 2.0: Installation -@unnumberedsubsec Q2.0.1: Running XEmacs without installing -The @file{INSTALL} file says that up to 108 MB of space is needed -temporarily during installation! How can I just try it out? - -XEmacs will run in place without requiring installation and copying of -the Lisp directories, and without having to specify a special build-time -flag. It's the copying of the Lisp directories that requires so much -space. XEmacs is largely written in Lisp. - -A good method is to make a shell alias for xemacs: - -@example -alias xemacs=/i/xemacs-20.2/src/xemacs -@end example - -(You will obviously use whatever directory you downloaded the source -tree to instead of @file{/i/xemacs-20.2}). - -This will let you run XEmacs without massive copying. - -@node Q2.0.2, Q2.0.3, Q2.0.1, Installation -@unnumberedsubsec Q2.0.2: XEmacs is too big - -Although this entry has been written for XEmacs 19.13, most of it still -stands true. - -@email{steve@@altair.xemacs.org, Steve Baur} writes: - -@quotation -The 45MB of space required by the installation directories can be -reduced dramatically if desired. Gzip all the .el files. Remove all -the packages you'll never want to use (or even ones you do like the two -obsolete mailcrypts and Gnus 4 in 19.13). Remove the TexInfo manuals. -Remove the Info (and use just hardcopy versions of the manual). Remove -most of the stuff in etc. Remove or gzip all the source code. Gzip or -remove the C source code. Configure it so that copies are not made of -the support lisp. I'm not advocating any of these things, just pointing -out ways to reduce the disk requirements if desired. - -Now examine the space used by directory: - -@format -0 /usr/local/bin/xemacs -2048 /usr/local/bin/xemacs-19.13 - -1546 /usr/local/lib/xemacs-19.13/i486-miranova-sco3.2v4.2 -1158 /usr/local/lib/xemacs-19.13/i486-unknown-linux1.2.13 -@end format - -You need to keep these. XEmacs isn't stripped by default in -installation, you should consider stripping. That will save you about -5MB right there. - -@format -207 /usr/local/lib/xemacs-19.13/etc/w3 -122 /usr/local/lib/xemacs-19.13/etc/sounds -18 /usr/local/lib/xemacs-19.13/etc/sparcworks -159 /usr/local/lib/xemacs-19.13/etc/vm -6 /usr/local/lib/xemacs-19.13/etc/e -21 /usr/local/lib/xemacs-19.13/etc/eos -172 /usr/local/lib/xemacs-19.13/etc/toolbar -61 /usr/local/lib/xemacs-19.13/etc/ns -43 /usr/local/lib/xemacs-19.13/etc/gnus -@end format - -These are support directories for various packages. In general they -match a directory under ./xemacs-19.13/lib/xemacs-19.13/lisp/. If you -do not require the package, you may delete or gzip the support too. - -@format -1959 /usr/local/lib/xemacs-19.13/etc -175 /usr/local/lib/xemacs-19.13/lisp/bytecomp -340 /usr/local/lib/xemacs-19.13/lisp/calendar -342 /usr/local/lib/xemacs-19.13/lisp/comint -517 /usr/local/lib/xemacs-19.13/lisp/dired -42 /usr/local/lib/xemacs-19.13/lisp/electric -212 /usr/local/lib/xemacs-19.13/lisp/emulators -238 /usr/local/lib/xemacs-19.13/lisp/energize -289 /usr/local/lib/xemacs-19.13/lisp/gnus -457 /usr/local/lib/xemacs-19.13/lisp/ilisp -1439 /usr/local/lib/xemacs-19.13/lisp/modes -2276 /usr/local/lib/xemacs-19.13/lisp/packages -1040 /usr/local/lib/xemacs-19.13/lisp/prim -176 /usr/local/lib/xemacs-19.13/lisp/pcl-cvs -154 /usr/local/lib/xemacs-19.13/lisp/rmail -3 /usr/local/lib/xemacs-19.13/lisp/epoch -45 /usr/local/lib/xemacs-19.13/lisp/term -860 /usr/local/lib/xemacs-19.13/lisp/utils -851 /usr/local/lib/xemacs-19.13/lisp/vm -13 /usr/local/lib/xemacs-19.13/lisp/vms -157 /usr/local/lib/xemacs-19.13/lisp/x11 -19 /usr/local/lib/xemacs-19.13/lisp/tooltalk -14 /usr/local/lib/xemacs-19.13/lisp/sunpro -291 /usr/local/lib/xemacs-19.13/lisp/games -198 /usr/local/lib/xemacs-19.13/lisp/edebug -619 /usr/local/lib/xemacs-19.13/lisp/w3 -229 /usr/local/lib/xemacs-19.13/lisp/eos -55 /usr/local/lib/xemacs-19.13/lisp/iso -59 /usr/local/lib/xemacs-19.13/lisp/mailcrypt -187 /usr/local/lib/xemacs-19.13/lisp/eterm -356 /usr/local/lib/xemacs-19.13/lisp/ediff -408 /usr/local/lib/xemacs-19.13/lisp/hyperbole/kotl -1262 /usr/local/lib/xemacs-19.13/lisp/hyperbole -247 /usr/local/lib/xemacs-19.13/lisp/hm--html-menus -161 /usr/local/lib/xemacs-19.13/lisp/mh-e -299 /usr/local/lib/xemacs-19.13/lisp/viper -53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-x -4 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/DocWindow.nib -3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/InfoPanel.nib -3 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj/TreeView.nib -11 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx/English.lproj -53 /usr/local/lib/xemacs-19.13/lisp/oobr/tree-nx -466 /usr/local/lib/xemacs-19.13/lisp/oobr -14142 /usr/local/lib/xemacs-19.13/lisp -@end format - -These are all Emacs Lisp source code and bytecompiled object code. You -may safely gzip everything named *.el here. You may remove any package -you don't use. @emph{Nothing bad will happen if you delete a package -that you do not use}. You must be sure you do not use it though, so be -conservative at first. - -Possible candidates for deletion include w3 (newer versions exist, or -you may just use Lynx or Netscape for web browsing), games, hyperbole, -mh-e, hm--html-menus (better packages exist), vm, viper, oobr, gnus (new -versions exist), etc. Ask yourself, @emph{Do I ever want to use this -package?} If the answer is no, then it is a candidate for removal. - -First, gzip all the .el files. Then go about package by package and -start gzipping the .elc files. Then run XEmacs and do whatever it is -you normally do. If nothing bad happens, then delete the directory. Be -conservative about deleting directories, and it would be handy to have a -backup tape around in case you get too zealous. - -@file{prim}, @file{modes}, @file{packages}, and @file{utils} are four -directories you definitely do @strong{not} want to delete, although -certain packages can be removed from them if you do not use them. - -@example -1972 /usr/local/lib/xemacs-19.13/info -@end example - -These are online texinfo sources. You may either gzip them or remove -them. In either case, @kbd{C-h i} (info mode) will no longer work. - -@example -20778 /usr/local/lib/xemacs-19.13 -@end example - -The 20MB achieved is less than half of what the full distribution takes up, -@strong{and} can be achieved without deleting a single file. -@end quotation - -@email{boffi@@hp735.stru.polimi.it, Giacomo Boffi} provides this procedure: - -@quotation -Substitute @file{/usr/local/lib/} with the path where the xemacs tree is -rooted, then use this script: - -@example -#!/bin/sh - -r=/usr/local/lib/xemacs-19.13/lisp - -cd $r ; rm -f cmpr ; touch cmpr - -du -s . - -for d in * ; do - if test -d $d ; then - cd $d - for f in *.el ; do -# compress (remove) only (ONLY) the sources that have a -# corresponding compiled file --- do not (DO NOT) -# touch other sources - if test -f $@{f@}c ; then gzip -v9 $f >> $r/cmpr ; fi - done - cd .. - fi -done - -du -s . -@end example - -A step beyond would be substituting @samp{rm -f} for @samp{gzip -v9}, -but you have to be desperate for removing the sources (remember that -emacs can access compressed files transparently). - -Also, a good megabyte could easily be trimmed from the $r/../etc -directory, e.g., the termcap files, some O+NEWS, others that I don't -remember as well. -@end quotation - -@quotation -XEmacs 21.0 will unbundle the lisp hierarchy and allow the installer -to choose exactly how much support code gets installed. -@end quotation - -@node Q2.0.3, Q2.0.4, Q2.0.2, Installation -@unnumberedsubsec Q2.0.3: Compiling XEmacs with Netaudio. - -What is the best way to compile XEmacs with the netaudio system, since I -have got the netaudio system compiled but installed at a weird place, I -am not root. Also in the READMEs it does not say anything about -compiling with the audioserver? - -You should only need to add some stuff to the configure command line. -To tell it to compile in netaudio support: @samp{--with-sound=both}, or -@samp{--with-sound=nas} if you don't want native sound support for some -reason.) To tell it where to find the netaudio includes and libraries: - -@example ---site-libraries=WHATEVER ---site-includes=WHATEVER -@end example - -Then (fingers crossed) it should compile and it will use netaudio if you -have a server running corresponding to the X server. The netaudio server -has to be there when XEmacs starts. If the netaudio server goes away and -another is run, XEmacs should cope (fingers crossed, error handling in -netaudio isn't perfect). - -BTW, netaudio has been renamed as it has a name clash with something -else, so if you see references to NAS or Network Audio System, it's the -same thing. It also might be found at -@uref{ftp://ftp.x.org/contrib/audio/nas/}. - -@node Q2.0.4, Q2.0.5, Q2.0.3, Installation -@unnumberedsubsec Q2.0.4: Problems with Linux and ncurses. - -On Linux 1.3.98 with termcap 2.0.8 and the ncurses that came with libc -5.2.18, XEmacs 20.0b20 is unable to open a tty device: - -@example -src/xemacs -nw -q -Initialization error: -@iftex -@* -@end iftex -Terminal type `xterm' undefined (or can't access database?) -@end example - -@email{ben@@666.com, Ben Wing} writes: - -@quotation -Your ncurses configuration is messed up. Your /usr/lib/terminfo is a -bad pointer, perhaps to a CD-ROM that is not inserted. -@end quotation - -@node Q2.0.5, Q2.0.6, Q2.0.4, Installation -@unnumberedsubsec Q2.0.5: Do I need X11 to run XEmacs? - -No. The name @dfn{XEmacs} is unfortunate in the sense that it is -@strong{not} an X Window System-only version of Emacs. Starting with -19.14 XEmacs has full color support on a color capable character -terminal. - -@node Q2.0.6, Q2.0.7, Q2.0.5, Installation -@unnumberedsubsec Q2.0.6: I'm having strange crashes. What do I do? - -There have been a variety of reports of crashes due to compilers with -buggy optimizers. Please see the @file{PROBLEMS} file that comes with -XEmacs to read what it says about your platform. - -@node Q2.0.7, Q2.0.8, Q2.0.6, Installation -@unnumberedsubsec Q2.0.7: Libraries in non-standard locations - -I have x-faces, jpeg, xpm etc. all in different places. I've tried -space-separated, comma-separated, several --site-libraries, all to no -avail. - -@example ---site-libraries='/path/one /path/two /path/etc' -@end example - -@node Q2.0.8, Q2.0.9, Q2.0.7, Installation -@unnumberedsubsec Q2.0.8: can't resolve symbol _h_errno - -You are using the Linux/ELF distribution of XEmacs 19.14, and your ELF -libraries are out of date. You have the following options: - -@enumerate -@item -Upgrade your libc to at least 5.2.16 (better is 5.2.18, 5.3.12, or -5.4.10). - -@item -Patch the XEmacs binary by replacing all occurrences of -@samp{_h_errno^@@} with -@iftex -@* -@end iftex -@samp{h_errno^@@^@@}. Any version of Emacs will -suffice. If you don't understand how to do this, don't do it. - -@item -Rebuild XEmacs yourself -- any working ELF version of libc should be -O.K. -@end enumerate - -@email{hniksic@@srce.hr, Hrvoje Niksic} writes: - -@quotation -Why not use a Perl one-liner for No. 2? - -@example -perl -pi -e 's/_h_errno\0/h_errno\0\0/g' \ -/usr/local/bin/xemacs-19.14 -@end example - -NB: You @emph{must} patch @file{/usr/local/bin/xemacs-19.14}, and not -@file{xemacs} because @file{xemacs} is a link to @file{xemacs-19.14}; -the Perl @samp{-i} option will cause unwanted side-effects if applied to -a symbolic link. -@end quotation - -@email{steve@@xemacs.org, SL Baur} writes: - -@quotation -If you build against a recent libc-5.4 (late enough to have caused -problems earlier in the beta cycle) and then run with an earlier version -of libc, you get a - -@example -$ xemacs -xemacs: can't resolve symbol '__malloc_hook' -zsh: 7942 segmentation fault (core dumped) xemacs -@end example - -(Example binary compiled against libc-5.4.23 and run with libc-5.4.16). - -The solution is to upgrade to at least libc-5.4.23. Sigh. Drat. -@end quotation - -@node Q2.0.9, Q2.0.10, Q2.0.8, Installation -@unnumberedsubsec Q2.0.9: Where do I find external libraries? - -All external libraries used by XEmacs can be found at the XEmacs FTP -site -@iftex -@* -@end iftex -@uref{ftp://ftp.xemacs.org/pub/xemacs/aux/}. - -@c Changed June Link above, was dead. -@c This list is a pain in the you-know-what to keep in synch with the -@c world. -The canonical locations (at the time of this writing) are as follows: - -@table @asis -@item JPEG -@uref{ftp://ftp.uu.net/graphics/jpeg/}. Version 6a is current. -@c Check from host with legal IP address -@item XPM -@uref{ftp://ftp.x.org/contrib/libraries/}. Version 3.4j is current. -Older versions of this package are known to cause XEmacs crashes. - -@item TIFF -@uref{ftp://ftp.sgi.com/graphics/tiff/}. v3.4 is current. The latest -beta is v3.4b035. There is a HOWTO here. - -@item PNG -@uref{ftp://ftp.uu.net/graphics/png/}. 0.89c is current. XEmacs -requires a fairly recent version to avoid using temporary files. -@c Check from host with legal IP address - -@uref{ftp://swrinde.nde.swri.edu/pub/png/src/} - -@item Compface -@uref{ftp://ftp.cs.indiana.edu/pub/faces/compface/}. This library has -been frozen for about 6 years, and is distributed without version -numbers. @emph{It should be compiled with the same options that X11 was -compiled with on your system}. The version of this library at -XEmacs.org includes the @file{xbm2xface.pl} script, written by -@email{stig@@hackvan.com}, which may be useful when generating your own xface. - -@item NAS -@uref{ftp://ftp.x.org/contrib/audio/nas/}. -Version 1.2p5 is current. There is a FAQ here. -@end table - -@node Q2.0.10, Q2.0.11, Q2.0.9, Installation -@unnumberedsubsec Q2.0.10: After I run configure I find a core dump, is something wrong? - -Not necessarily. If you have GNU sed 3.0 you should downgrade it to -2.05. From the @file{README} at prep.ai.mit.edu: - -@quotation -sed 3.0 has been withdrawn from distribution. It has major revisions, -which mostly seem to be improvements; but it turns out to have bugs too -which cause trouble in some common cases. - -Tom Lord won't be able to work fixing the bugs until May. So in the -mean time, we've decided to withdraw sed 3.0 from distribution and make -version 2.05 once again the recommended version. -@end quotation - -It has also been observed that the vfork test on Solaris will leave a -core dump. - -@node Q2.0.11, Q2.0.12, Q2.0.10, Installation -@unnumberedsubsec Q2.0.11: XEmacs doesn't resolve hostnames. - -This is the result of a long-standing problem with SunOS and the fact -that stock SunOS systems do not ship with DNS resolver code in libc. - -@email{ckd@@loiosh.kei.com, Christopher Davis} writes: - -@quotation -That's correct [The SunOS 4.1.3 precompiled binaries don't do name -lookup]. Since Sun figured that everyone used NIS to do name lookups -(that DNS thing was apparently only a passing fad, right?), the stock -SunOS 4.x systems don't have DNS-based name lookups in libc. - -This is also why Netscape ships two binaries for SunOS 4.1.x. - -The best solution is to compile it yourself; the configure script will -check to see if you've put DNS in the shared libc and will then proceed -to link against the DNS resolver library code. -@end quotation - -@node Q2.0.12, Q2.0.13, Q2.0.11, Installation -@unnumberedsubsec Q2.0.12: Why can't I strip XEmacs? - -@email{cognot@@fronsac.ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -Because of the way XEmacs (and every other Emacsen, AFAIK) is built. The -link gives you a bare-boned emacs (called temacs). temacs is then run, -preloading some of the lisp files. The result is then dumped into a new -executable, named xemacs, which will contain all of the preloaded lisp -functions and data. - -Now, during the dump itself, the executable (code+data+symbols) is -written on disk using a special unexec() function. This function is -obviously heavily system dependent. And on some systems, it leads to an -executable which, although valid, cannot be stripped without damage. If -memory serves, this is especially the case for AIX binaries. On other -architecture it might work OK. - -The Right Way to strip the emacs binary is to strip temacs prior to -dumping xemacs. This will always work, although you can do that only if -you install from sources (as temacs is @file{not} part of the binary -kits). -@end quotation - -@email{nat@@nataa.fr.eu.org, Nat Makarevitch} writes: - -@quotation -Here is the trick: - -@enumerate -@item -[ ./configure; make ] - -@item -rm src/xemacs - -@item -strip src/temacs - -@item -make - -@item -cp src/xemacs /usr/local/bin/xemacs - -@item -cp lib-src/DOC-19.16-XEmacs -@iftex -\ @* -@end iftex -/usr/local/lib/xemacs-19.16/i586-unknown-linuxaout -@end enumerate -@end quotation - -@node Q2.0.13, Q2.0.14, Q2.0.12, Installation -@unnumberedsubsec Q2.0.13: Problems linking with Gcc on Solaris - -There are known difficulties linking with Gnu ld on Solaris. A typical -error message might look like: - -@example -unexec(): dlopen(../dynodump/dynodump.so): ld.so.1: ./temacs: -fatal: relocation error: -symbol not found: main: referenced in ../dynodump/dynodump.so -@end example - -@email{martin@@xemacs.org, Martin Buchholz} writes: - -@quotation -You need to specify @samp{-fno-gnu-linker} as part of your flags to pass -to ld. Future releases of XEmacs will try to do this automatically. -@end quotation - -@node Q2.0.14, Q2.1.1, Q2.0.13, Installation -@unnumberedsubsec Q2.0.14: Make on HP/UX 9 fails after linking temacs - -Problem when building xemacs-19.16 on hpux 9: - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -make on hpux fails after linking temacs with a message: - -@example -"make: don't know how to make .y." -@end example - -Solution: This is a problem with HP make revision 70.X. Either use GNU -make, or install PHCO_6552, which will bring make to revision -72.24.1.17. -@end quotation - - -@node Q2.1.1, Q2.1.2, Q2.0.14, Installation -@unnumberedsec 2.1: Trouble Shooting -@unnumberedsubsec Q2.1.1: Help! XEmacs just crashed on me! - -First of all, don't panic. Whenever XEmacs crashes, it tries extremely -hard to auto-save all of your files before dying. (The main time that -this will not happen is if the machine physically lost power or if you -killed the XEmacs process using @code{kill -9}). The next time you try -to edit those files, you will be informed that a more recent auto-save -file exists. You can use @kbd{M-x recover-file} to retrieve the -auto-saved version of the file. - -Starting with 19.14, you may use the command @kbd{M-x recover-session} -after a crash to pick up where you left off. - -Now, XEmacs is not perfect, and there may occasionally be times, or -particular sequences of actions, that cause it to crash. If you can -come up with a reproducible way of doing this (or even if you have a -pretty good memory of exactly what you were doing at the time), the -maintainers would be very interested in knowing about it. Post a -message to comp.emacs.xemacs or send mail to @email{crashes@@xemacs.org}. -Please note that the @samp{crashes} address is exclusively for crash -reports. - -If at all possible, include a stack backtrace of the core dump that was -produced. This shows where exactly things went wrong, and makes it much -easier to diagnose problems. To do this, you need to locate the core -file (it's called @file{core}, and is usually sitting in the directory -that you started XEmacs from, or your home directory if that other -directory was not writable). Then, go to that directory and execute a -command like: - -@example -gdb `which xemacs` core -@end example - -and then issue the command @samp{where} to get the stack backtrace. You -might have to use @code{dbx} or some similar debugger in place of -@code{gdb}. If you don't have any such debugger available, complain to -your system administrator. - -It's possible that a core file didn't get produced, in which case you're -out of luck. Go complain to your system administrator and tell him not -to disable core files by default. Also @xref{Q2.1.15} for tips and -techniques for dealing with a debugger. - -When making a problem report make sure that: - -@enumerate -@item -Report @strong{all} of the information output by XEmacs during the -crash. - -@item -You mention what O/S & Hardware you are running XEmacs on. - -@item -What version of XEmacs you are running. - -@item -What build options you are using. - -@item -If the problem is related to graphics, we will also need to know what -version of the X Window System you are running, and what window manager -you are using. - -@item -If the problem happened on a tty, please include the terminal type. -@end enumerate - -@node Q2.1.2, Q2.1.3, Q2.1.1, Installation -@unnumberedsubsec Q2.1.2: Cryptic Minibuffer messages. - -When I try to use some particular option of some particular package, I -get a cryptic error in the minibuffer. - -If you can't figure out what's going on, select Options/General -Options/Debug on Error from the Menubar and then try and make the error -happen again. This will give you a backtrace that may be enlightening. -If not, try reading through this FAQ; if that fails, you could try -posting to comp.emacs.xemacs (making sure to include the backtrace) and -someone may be able to help. If you can identify which Emacs lisp -source file the error is coming from you can get a more detailed stack -backtrace by doing the following: - -@enumerate -@item -Visit the .el file in an XEmacs buffer. - -@item -Issue the command @kbd{M-x eval-current-buffer}. - -@item -Reproduce the error. -@end enumerate - -Depending on the version of XEmacs, you may either select Edit->Show -Messages (19.13 and earlier) or Help->Recent Keystrokes/Messages (19.14 -and later) from the menubar to see the most recent messages. This -command is bound to @kbd{C-h l} by default. - -@node Q2.1.3, Q2.1.4, Q2.1.2, Installation -@unnumberedsubsec Q2.1.3: Translation Table Syntax messages at Startup - -I get tons of translation table syntax error messages during startup. -How do I get rid of them? - -There are two causes of this problem. The first usually only strikes -people using the prebuilt binaries. The culprit in both cases is the -file @file{XKeysymDB}. - -@itemize @bullet -@item -The binary cannot find the @file{XKeysymDB} file. The location is -hardcoded at compile time so if the system the binary was built on puts -it a different place than your system does, you have problems. To fix, -set the environment variable @var{XKEYSYMDB} to the location of the -@file{XKeysymDB} file on your system or to the location of the one -included with XEmacs which should be at -@iftex -@* -@end iftex -@file{/lib/xemacs-19.16/etc/XKeysymDB}. - -@item -The binary is finding the XKeysymDB but it is out-of-date on your system -and does not contain the necessary lines. Either ask your system -administrator to replace it with the one which comes with XEmacs (which -is the stock R6 version and is backwards compatible) or set your -@var{XKEYSYMDB} variable to the location of XEmacs's described above. -@end itemize - -@node Q2.1.4, Q2.1.5, Q2.1.3, Installation -@unnumberedsubsec Q2.1.4: Startup warnings about deducing proper fonts? - -How can I avoid the startup warnings about deducing proper fonts? - -This is highly dependent on your installation, but try with the -following font as your base font for XEmacs and see what it does: - -@format --adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1 -@end format - -More precisely, do the following in your resource file: - -@format -Emacs.default.attributeFont: \ --adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1 -@end format - -If you just don't want to see the @samp{*Warnings*} buffer at startup -time, you can set this: - -@lisp -(setq display-warning-minimum-level 'error) -@end lisp - -The buffer still exists; it just isn't in your face. - -@node Q2.1.5, Q2.1.6, Q2.1.4, Installation -@unnumberedsubsec Q2.1.5: XEmacs cannot connect to my X Terminal! - -Help! I can not get XEmacs to display on my Envizex X-terminal! - -Try setting the @var{DISPLAY} variable using the numeric IP address of -the host you are running XEmacs from. - -@node Q2.1.6, Q2.1.7, Q2.1.5, Installation -@unnumberedsubsec Q2.1.6: XEmacs just locked up my Linux X server! - -There have been several reports of the X server locking up under Linux. -In all reported cases removing speedo and scaled fonts from the font -path corrected the problem. This can be done with the command -@code{xset}. - -It is possible that using a font server may also solve the problem. - -@node Q2.1.7, Q2.1.8, Q2.1.6, Installation -@unnumberedsubsec Q2.1.7: HP Alt key as Meta. - -How can I make XEmacs recognize the Alt key of my HP workstation as a -Meta key? - -Put the following line into a file and load it with xmodmap(1) before -starting XEmacs: - -@example -remove Mod1 = Mode_switch -@end example - -@node Q2.1.8, Q2.1.9, Q2.1.7, Installation -@unnumberedsubsec Q2.1.8: got (wrong-type-argument color-instance-p nil) - -@email{nataliek@@rd.scitec.com.au, Natalie Kershaw} writes: - -@quotation -I am trying to run xemacs 19.13 under X11R4. Whenever I move the mouse I -get the following error. Has anyone seen anything like this? This -doesn't occur on X11R5. - -@lisp -Signalling: -(error "got (wrong-type-argument color-instance-p nil) -and I don't know why!") -@end lisp -@end quotation - -@email{map01kd@@gold.ac.uk, dinos} writes: - -@quotation -I think this is due to undefined resources; You need to define color -backgrounds and foregrounds into your @file{.../app-defaults/Emacs} -like: - -@example -*Foreground: Black ;everything will be of black on grey95, -*Background: Grey95 ;unless otherwise specified. -*cursorColor: Red3 ;red3 cursor with grey95 border. -*pointerColor: Red3 ;red3 pointer with grey95 border. -@end example -@end quotation - -Natalie Kershaw adds: - -@quotation -What fixed the problem was adding some more colors to the X color -database (copying the X11R5 colors over), and also defining the -following resources: - -@example -xemacs*cursorColor: black -xemacs*pointerColor: black -@end example - -With the new colors installed the problem still occurs if the above -resources are not defined. - -If the new colors are not present then an additional error occurs on -XEmacs startup, which says @samp{Color Red3} not defined. -@end quotation - -@node Q2.1.9, Q2.1.10, Q2.1.8, Installation -@unnumberedsubsec Q2.1.9: XEmacs causes my OpenWindows 3.0 server to crash. - -The OpenWindows 3.0 server is incredibly buggy. Your best bet is to -replace it with one from the generic MIT X11 release. You might also -try disabling parts of your @file{.emacs}, like enabling background -pixmaps. - -@node Q2.1.10, Q2.1.11, Q2.1.9, Installation -@unnumberedsubsec Q2.1.10: Warnings from incorrect key modifiers. - -The following information comes from the @file{PROBLEMS} file that comes -with XEmacs. - -If you're having troubles with HP/UX it is because HP/UX defines the -modifiers wrong in X. Here is a shell script to fix the problem; be -sure that it is run after VUE configures the X server. - -@example -#! /bin/sh -xmodmap 2> /dev/null - << EOF -keysym Alt_L = Meta_L -keysym Alt_R = Meta_R -EOF - -xmodmap - << EOF -clear mod1 -keysym Mode_switch = NoSymbol -add mod1 = Meta_L -keysym Meta_R = Mode_switch -add mod2 = Mode_switch -EOF -@end example - -@node Q2.1.11, Q2.1.12, Q2.1.10, Installation -@unnumberedsubsec Q2.1.11: @samp{Can't instantiate image error...} in toolbar -@c New - -@email{expt@@alanine.ram.org, Dr. Ram Samudrala} writes: - -I just installed the XEmacs (20.4-2) RPMS that I downloaded from -@uref{http://www.xemacs.org/}. Everything works fine, except that when -I place my mouse over the toolbar, it beeps and gives me this message: - -@example - Can't instantiate image (probably cached): - [xbm :mask-file "/usr/include/X11/bitmaps/leftptrmsk :mask-data - (16 16 ... -@end example - -@email{kyle_jones@@wonderworks.com, Kyle Jones} writes: -@quotation -This is problem specific to some Chips and Technologies video -chips, when running XFree86. Putting - -@code{Option "sw_cursor"} - -in @file{XF86Config} gets rid of the problem. -@end quotation - -@node Q2.1.12, Q2.1.13, Q2.1.11, Installation -@unnumberedsubsec Q2.1.12: Problems with Regular Expressions on DEC OSF1. - -I have xemacs 19.13 running on an alpha running OSF1 V3.2 148 and ispell -would not run because it claimed the version number was incorrect -although it was indeed OK. I traced the problem to the regular -expression handler. - -@email{douglask@@dstc.edu.au, Douglas Kosovic} writes: - -@quotation -Actually it's a DEC cc optimization bug that screws up the regexp -handling in XEmacs. - -Rebuilding using the @samp{-migrate} switch for DEC cc (which uses a -different sort of optimization) works fine. -@end quotation - -See @file{xemacs-19_13-dunix-3_2c.patch} at the following URL on how to -build with the @samp{-migrate} flag: - -@example -@uref{http://www-digital.cern.ch/carney/emacs/emacs.html} -@c Link above, is -@c dead. And the directory `carney' is empty. - - - -@end example - -NOTE: There have been a variety of other problems reported that are -fixed in this fashion. - -@node Q2.1.13, Q2.1.14, Q2.1.12, Installation -@unnumberedsubsec Q2.1.13: HP/UX 10.10 and @code{create_process} failure. - -@email{Dave.Carrigan@@ipl.ca, Dave Carrigan} writes: - -@quotation -With XEmacs 19.13 and HP/UX 10.10, anything that relies on the -@code{create_process} function fails. This breaks a lot of things -(shell-mode, compile, ange-ftp, to name a few). -@end quotation - -@email{johnson@@dtc.hp.com, Phil Johnson} writes: - -@quotation -This is a problem specific to HP-UX 10.10. It only occurs when XEmacs -is compiled for shared libraries (the default), so you can work around -it by compiling a statically-linked binary (run configure with -@samp{--dynamic=no}). - -I'm not sure whether the problem is with a particular shared library or -if it's a kernel problem which crept into 10.10. -@end quotation - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -I had a few problems with 10.10. Apparently, some of them were solved by -forcing a static link of libc (manually). -@end quotation - -@node Q2.1.14, Q2.1.15, Q2.1.13, Installation -@unnumberedsubsec Q2.1.14: @kbd{C-g} doesn't work for me. Is it broken? - -@email{ben@@666.com, Ben Wing} writes: - -@quotation -@kbd{C-g} does work for most people in most circumstances. If it -doesn't, there are only two explanations: - -@enumerate -@item -The code is wrapped with a binding of @code{inhibit-quit} to -@code{t}. @kbd{Ctrl-Shift-G} should still work, I think. - -@item -SIGIO is broken on your system, but BROKEN_SIGIO isn't defined. -@end enumerate - -To test #2, try executing @code{(while t)} from the @samp{*scratch*} -buffer. If @kbd{C-g} doesn't interrupt, then you're seeing #2. -@end quotation - -@email{terra@@diku.dk, Morten Welinder} writes: - -@quotation -On some (but @emph{not} all) machines a hung XEmacs can be revived by -@code{kill -FPE }. This is a hack, of course, not a solution. -This technique works on a Sun4 running 4.1.3_U1. To see if it works for -you, start another XEmacs and test with that first. If you get a core -dump the method doesn't work and if you get @samp{Arithmetic error} then -it does. -@end quotation - -@node Q2.1.15, Q2.1.16, Q2.1.14, Installation -@unnumberedsubsec Q2.1.15: How to Debug an XEmacs problem with a debugger - -If XEmacs does crash on you, one of the most productive things you can -do to help get the bug fixed is to poke around a bit with the debugger. -Here are some hints: - -@itemize @bullet -@item -First of all, if the crash is at all reproducible, consider very -strongly recompiling your XEmacs with debugging symbols, with no -optimization, and with the configure options @samp{--debug=yes} and -@samp{--error-checking=all}. This will make your XEmacs run somewhat -slower but make it a lot more likely to catch the problem earlier -(closer to its source), and a lot easier to determine what's going on -with a debugger. - -@item -If you're able to run XEmacs under a debugger and reproduce the crash -(if it's inconvenient to do this because XEmacs is already running or is -running in batch mode as part of a bunch of scripts, consider attaching -to the existing process with your debugger; most debuggers let you do -this by substituting the process ID for the core file when you invoke -the debugger from the command line, or by using the @code{attach} -command or something similar), here are some things you can do: - -@item -If XEmacs is hitting an assertion failure, put a breakpoint on -@code{assert_failed()}. - -@item -If XEmacs is hitting some weird Lisp error that's causing it to crash -(e.g. during startup), put a breakpoint on @code{signal_1()}---this is -declared static in eval.c. - -@item -Internally, you will probably see lots of variables that hold objects of -type @code{Lisp_Object}. These are exactly what they appear to be, -i.e. references to Lisp objects. Printing them out with the debugger -probably won't be too useful---you'll likely just see a number. To -decode them, do this: - -@example -call debug_print (OBJECT) -@end example - -where @var{OBJECT} is whatever you want to decode (it can be a variable, -a function call, etc.). This will print out a readable representation -on the TTY from which the xemacs process was invoked. - -@item -If you want to get a Lisp backtrace showing the Lisp call -stack, do this: - -@example -call debug_backtrace () -@end example - -@item -Using @code{debug_print} and @code{debug_backtrace} has two -disadvantages - it can only be used with a running xemacs process, and -it cannot display the internal C structure of a Lisp Object. Even if -all you've got is a core dump, all is not lost. - -If you're using GDB, there are some macros in the file -@file{src/gdbinit} in the XEmacs source distribution that should make it -easier for you to decode Lisp objects. Copy this file to -@file{~/.gdbinit}, or @code{source} it from @file{~/.gdbinit}, and use -the macros defined therein. In particular, use the @code{pobj} macro to -print the internal C representation of a lisp object. This will work -with a core file or not-yet-run executable. The aliases @code{ldp} and -@code{lbt} are provided for conveniently calling @code{debug_print} and -@code{debug_backtrace}. - -If you are using Sun's @file{dbx} debugger, there is an equivalent file -@file{src/dbxrc} to copy to or source from @file{~/.dbxrc}. - -@item -If you're using a debugger to get a C stack backtrace and you're seeing -stack traces with some of the innermost frames mangled, it may be due to -dynamic linking. (This happens especially under Linux.) Consider -reconfiguring with @samp{--dynamic=no}. Also, sometimes (again under -Linux), stack backtraces of core dumps will have the frame where the -fatal signal occurred mangled; if you can obtain a stack trace while -running the XEmacs process under a debugger, the stack trace should be -clean. - -@email{1CMC3466@@ibm.mtsac.edu, Curtiss} suggests upgrading to ld.so version 1.8 -if dynamic linking and debugging is a problem on Linux. - -@item -If you're using a debugger to get a C stack backtrace and you're -getting a completely mangled and bogus stack trace, it's probably due to -one of the following: - -@enumerate a -@item -Your executable has been stripped. Bad news. Tell your sysadmin not to -do this---it doesn't accomplish anything except to save a bit of disk -space, and makes debugging much much harder. - -@item -Your stack is getting trashed. Debugging this is hard; you have to do a -binary-search type of narrowing down where the crash occurs, until you -figure out exactly which line is causing the problem. Of course, this -only works if the bug is highly reproducible. - -@item -If your stack trace has exactly one frame in it, with address 0x0, this -could simply mean that XEmacs attempted to execute code at that address, -e.g. through jumping to a null function pointer. Unfortunately, under -those circumstances, GDB under Linux doesn't know how to get a stack -trace. (Yes, this is the third Linux-related problem I've mentioned. I -have no idea why GDB under Linux is so bogus. Complain to the GDB -authors, or to comp.os.linux.development.system). Again, you'll have to -use the narrowing-down process described above. - -@item -If you compiled 19.14 with @samp{--debug} (or by default in later -versions), you will get a Lisp backtrace output when XEmacs crashes, so -you'll have something useful. - -@end enumerate - -@item -If you compile with the newer gcc variants gcc-2.8 or egcs, you will -also need gdb 4.17. Earlier releases of gdb can't handle the debug -information generated by the newer compilers. - -@item -The above information on using @file{src/gdbinit} works for XEmacs-21.0 -and above. For older versions of XEmacs, there are different -@file{gdbinit} files provided in the @file{src} directory. Use the one -corresponding to the configure options used when building XEmacs. - -@end itemize - -@node Q2.1.16, Q2.1.17, Q2.1.15, Installation -@unnumberedsubsec Q2.1.16: XEmacs crashes in @code{strcat} on HP/UX 10 - ->From the problems database (through -@uref{http://support.mayfield.hp.com/}): - -@example -Problem Report: 5003302299 -Status: Open - -System/Model: 9000/700 -Product Name: HPUX S800 10.0X -Product Vers: 9245XB.10.00 - -Description: strcat(3C) may read beyond -end of source string, can cause SIGSEGV - - -*** PROBLEM TEXT *** -strcat(3C) may read beyond the source string onto an unmapped page, -causing a segmentation violation. -@end example - -@node Q2.1.17, Q2.1.18, Q2.1.16, Installation -@unnumberedsubsec Q2.1.17: @samp{Marker does not point anywhere} - -As with other errors, set @code{debug-on-error} to @code{t} to get the -backtrace when the error occurs. Specifically, two problems have been -reported (and fixed). - -@enumerate -@item -A problem with line-number-mode in XEmacs 19.14 affected a large number -of other packages. If you see this error message, turn off -line-number-mode. - -@item -A problem with some early versions of Gnus 5.4 caused this error. -Upgrade your Gnus. -@end enumerate - -@node Q2.1.18, Q2.1.19, Q2.1.17, Installation -@unnumberedsubsec Q2.1.18: 19.14 hangs on HP/UX 10.10. - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} writes: - -@quotation -For the record, compiling on hpux 10.10 leads to a hang in Gnus when -compiled with optimization on. - -I've just discovered that my hpux 10.01 binary was working less well -than expected. In fact, on a 10.10 system, @code{(while t)} was not -interrupted by @kbd{C-g}. I defined @code{BROKEN_SIGIO} and recompiled on -10.10, and... the hang is now gone. - -As far as configure goes, this will be a bit tricky: @code{BROKEN_SIGIO} -is needed on 10.10, but @strong{not} on 10.01: if I run my 10.01 binary -on a 10.01 machine, without @code{BROKEN_SIGIO} being defined, @kbd{C-g} -works as expected. -@end quotation - -@email{cognot@@ensg.u-nancy.fr, Richard Cognot} adds: - -@quotation -Apparently somebody has found the reason why there is this -@iftex -@* -@end iftex -@samp{poll: -interrupted...} message for each event. For some reason, libcurses -reimplements a @code{select()} system call, in a highly broken fashion. -The fix is to add a -lc to the link line @emph{before} the --lxcurses. XEmacs will then use the right version of @code{select()}. -@end quotation - - -@email{af@@biomath.jussieu.fr, Alain Fauconnet} writes: - -@quotation -The @emph{real} solution is to @emph{not} link -lcurses in! I just -changed -lcurses to -ltermcap in the Makefile and it fixed: - -@enumerate -@item -The @samp{poll: interrupted system call} message. - -@item -A more serious problem I had discovered in the meantime, that is the -fact that subprocess handling was seriously broken: subprocesses -e.g. started by AUC TeX for TeX compilation of a buffer would -@emph{hang}. Actually they would wait forever for emacs to read the -socket which connects stdout... -@end enumerate -@end quotation - -@node Q2.1.19, Q2.1.20, Q2.1.18, Installation -@unnumberedsubsec Q2.1.19: XEmacs does not follow the local timezone. - -When using one of the prebuilt binaries many users have observed that -XEmacs uses the timezone under which it was built, but not the timezone -under which it is running. The solution is to add: - -@lisp -(set-time-zone-rule "MET") -@end lisp - -to your @file{.emacs} or the @file{site-start.el} file if you can. -Replace @code{MET} with your local timezone. - -@node Q2.1.20, Q2.1.21, Q2.1.19, Installation -@unnumberedsubsec Q2.1.20: @samp{Symbol's function definition is void: hkey-help-show.} - -This is a problem with a partially loaded hyperbole. Try adding: - -@lisp -(require 'hmouse-drv) -@end lisp - -where you load hyperbole and the problem should go away. - -@node Q2.1.21, Q2.1.22, Q2.1.20, Installation -@unnumberedsubsec Q2.1.21: Every so often the XEmacs frame freezes - -This problem has been fixed in 19.15, and was due to a not easily -reproducible race condition. - -@node Q2.1.22, Q2.1.23, Q2.1.21, Installation -@unnumberedsubsec Q2.1.22: XEmacs seems to take a really long time to do some things - -@email{dmoore@@ucsd.edu, David Moore} writes: - -@quotation -Two things you can do: - -1) C level: - -When you see it going mad like this, you might want to use gdb from an -'xterm' to attach to the running process and get a stack trace. To do -this just run: - -@example -gdb /path/to/xemacs/xemacs #### -@end example - -Where @code{####} is the process id of your xemacs, instead of -specifying the core. When gdb attaches, the xemacs will stop [1] and -you can type `where' in gdb to get a stack trace as usual. To get -things moving again, you can just type `quit' in gdb. It'll tell you -the program is running and ask if you want to quit anyways. Say 'y' and -it'll quit and have your emacs continue from where it was at. - -2) Lisp level: - -Turn on debug-on-quit early on. When you think things are going slow -hit C-g and it may pop you in the debugger so you can see what routine -is running. Press `c' to get going again. - -debug-on-quit doesn't work if something's turned on inhibit-quit or in -some other strange cases. -@end quotation - -@node Q2.1.23, , Q2.1.22, Installation -@unnumberedsubsec Q2.1.23: Movemail on Linux does not work for XEmacs 19.15 and later. - -Movemail used to work fine in 19.14 but has stopped working in 19.15 -and 20.x. I am using Linux. - -@email{steve@@xemacs.org, SL Baur} writes: - -@quotation -Movemail on Linux used to default to using flock file locking. With -19.15 and later versions it now defaults to using @code{.lock} file -locking. If this is not appropriate for your system, edit src/s/linux.h -and uncomment the line that reads: - -@example -#define MAIL_USE_FLOCK -@end example -@end quotation - -@node Customization, Subsystems, Installation, Top -@unnumbered 3 Customization and Options - -This is part 3 of the XEmacs Frequently Asked Questions list. This -section is devoted to Customization and screen settings. - -@menu -Customization---Emacs Lisp and @file{.emacs}: -* Q3.0.1:: What version of Emacs am I running? -* Q3.0.2:: How do I evaluate Elisp expressions? -* Q3.0.3:: @code{(setq tab-width 6)} behaves oddly. -* Q3.0.4:: How can I add directories to the @code{load-path}? -* Q3.0.5:: How to check if a lisp function is defined? -* Q3.0.6:: Can I force the output of @code{(face-list)} to a buffer? -* Q3.0.7:: Font selections don't get saved after @code{Save Options}. -* Q3.0.8:: How do I make a single minibuffer frame? -* Q3.0.9:: What is @code{Customize}? - -X Window System & Resources: -* Q3.1.1:: Where is a list of X resources? -* Q3.1.2:: How can I detect a color display? -* Q3.1.3:: @code{(set-screen-width)} worked in 19.6, but not in 19.13? -* Q3.1.4:: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? -* Q3.1.5:: How can I get the icon to just say @samp{XEmacs}? -* Q3.1.6:: How can I have the window title area display the full path? -* Q3.1.7:: @samp{xemacs -name junk} doesn't work? -* Q3.1.8:: @samp{-iconic} doesn't work. - -Textual Fonts & Colors: -* Q3.2.1:: How can I set color options from @file{.emacs}? -* Q3.2.2:: How do I set the text, menu and modeline fonts? -* Q3.2.3:: How can I set the colors when highlighting a region? -* Q3.2.4:: How can I limit color map usage? -* Q3.2.5:: My tty supports color, but XEmacs doesn't use them. -* Q3.2.6:: Can I have pixmap backgrounds in XEmacs? - -The Modeline: -* Q3.3.1:: How can I make the modeline go away? -* Q3.3.2:: How do you have XEmacs display the line number in the modeline? -* Q3.3.3:: How do I get XEmacs to put the time of day on the modeline? -* Q3.3.4:: How do I turn off current chapter from AUC TeX modeline? -* Q3.3.5:: How can one change the modeline color based on the mode used? - -3.4 Multiple Device Support: -* Q3.4.1:: How do I open a frame on another screen of my multi-headed display? -* Q3.4.2:: Can I really connect to a running XEmacs after calling up over a modem? How? - -3.5 The Keyboard: -* Q3.5.1:: How can I bind complex functions (or macros) to keys? -* Q3.5.2:: How can I stop down-arrow from adding empty lines to the bottom of my buffers? -* Q3.5.3:: How do I bind C-. and C-; to scroll one line up and down? -* Q3.5.4:: Globally binding @kbd{Delete}? -* Q3.5.5:: Scrolling one line at a time. -* Q3.5.6:: How to map @kbd{Help} key alone on Sun type4 keyboard? -* Q3.5.7:: How can you type in special characters in XEmacs? -* Q3.5.8:: Why does @code{(global-set-key [delete-forward] 'delete-char)} complain? -* Q3.5.9:: How do I make the Delete key delete forward? -* Q3.5.10:: Can I turn on @dfn{sticky} modifier keys? -* Q3.5.11:: How do I map the arrow keys? - -The Cursor: -* Q3.6.1:: Is there a way to make the bar cursor thicker? -* Q3.6.2:: Is there a way to get back the old block cursor where the cursor covers the character in front of the point? -* Q3.6.3:: Can I make the cursor blink? - -The Mouse and Highlighting: -* Q3.7.1:: How can I turn off Mouse pasting? -* Q3.7.2:: How do I set control/meta/etc modifiers on mouse buttons? -* Q3.7.3:: Clicking the left button does not do anything in buffer list. -* Q3.7.4:: How can I get a list of buffers when I hit mouse button 3? -* Q3.7.5:: Why does cut-and-paste not work between XEmacs and a cmdtool? -* Q3.7.6:: How I can set XEmacs up so that it pastes where the text cursor is? -* Q3.7.7:: How do I select a rectangular region? -* Q3.7.8:: Why does @kbd{M-w} take so long? - -The Menubar and Toolbar: -* Q3.8.1:: How do I get rid of the menu (or menubar)? -* Q3.8.2:: Can I customize the basic menubar? -* Q3.8.3:: How do I control how many buffers are listed in the menu @code{Buffers} list? -* Q3.8.4:: Resources like @code{Emacs*menubar*font} are not working? -* Q3.8.5:: How can I bind a key to a function to toggle the toolbar? - -Scrollbars: -* Q3.9.1:: How can I disable the scrollbar? -* Q3.9.2:: How can one use resources to change scrollbar colors? -* Q3.9.3:: Moving the scrollbar can move the point; can I disable this? -* Q3.9.4:: How can I get automatic horizontal scrolling? - -Text Selections: -* Q3.10.1:: How can I turn off or change highlighted selections? -* Q3.10.2:: How do I get that typing on an active region removes it? -* Q3.10.3:: Can I turn off the highlight during isearch? -* Q3.10.4:: How do I turn off highlighting after @kbd{C-x C-p} (mark-page)? -* Q3.10.5:: The region disappears when I hit the end of buffer while scrolling. -@end menu - -@node Q3.0.1, Q3.0.2, Customization, Customization -@unnumberedsec 3.0: Customization -- Emacs Lisp and .emacs -@unnumberedsubsec Q3.0.1: What version of Emacs am I running? - -How can @file{.emacs} determine which of the family of Emacsen I am -using? - -To determine if you are currently running GNU Emacs 18, GNU Emacs 19, -XEmacs 19, XEmacs 20, or Epoch, and use appropriate code, check out the -example given in @file{etc/sample.emacs}. There are other nifty things -in there as well! - -For all new code, all you really need to do is: - -@lisp -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) -@end lisp - -@node Q3.0.2, Q3.0.3, Q3.0.1, Customization -@unnumberedsubsec Q3.0.2: How can I evaluate Emacs-Lisp expressions? - -I know I can evaluate Elisp expressions from @code{*scratch*} buffer -with @kbd{C-j} after the expression. How do I do it from another -buffer? - -Press @kbd{M-:} (the default binding of @code{eval-expression}), and -enter the expression to the minibuffer. In XEmacs prior to 19.15 -@code{eval-expression} used to be a disabled command by default. If -this is the case, upgrade your XEmacs. - -@node Q3.0.3, Q3.0.4, Q3.0.2, Customization -@unnumberedsubsec Q3.0.3: @code{(setq tab-width 6)} behaves oddly. - -If you put @code{(setq tab-width 6)} in your @file{.emacs} file it does -not work! Is there a reason for this? If you do it at the EVAL prompt -it works fine!! How strange. - -Use @code{setq-default} instead, since @code{tab-width} is -all-buffer-local. - -@node Q3.0.4, Q3.0.5, Q3.0.3, Customization -@unnumberedsubsec Q3.0.4: How can I add directories to the @code{load-path}? - -Here are two ways to do that, one that puts your directories at the -front of the load-path, the other at the end: - -@lisp -;;; Add things at the beginning of the load-path, do not add -;;; duplicate directories: -(pushnew "bar" load-path :test 'equal) - -(pushnew "foo" load-path :test 'equal) - -;;; Add things at the end, unconditionally -(setq load-path (nconc load-path '("foo" "bar"))) -@end lisp - -@email{keithh@@nortel.ca, keith (k.p.) hanlan} writes: - -@quotation -To add directories using Unix shell metacharacters use -@file{expand-file-name} like this: - -@lisp -(push (expand-file-name "~keithh/.emacsdir") load-path) -@end lisp -@end quotation - -@node Q3.0.5, Q3.0.6, Q3.0.4, Customization -@unnumberedsubsec Q3.0.5: How to check if a lisp function is defined? - -Use the following elisp: - -@lisp -(fboundp 'foo) -@end lisp - -It's almost always a mistake to test @code{emacs-version} or any similar -variables. - -Instead, use feature-tests, such as @code{featurep}, @code{boundp}, -@code{fboundp}, or even simple behavioral tests, eg.: - -@lisp -(defvar foo-old-losing-code-p - (condition-case nil (progn (losing-code t) nil) - (wrong-number-of-arguments t))) -@end lisp - -There is an incredible amount of broken code out there which could work -much better more often in more places if it did the above instead of -trying to divine its environment from the value of one variable. - -@node Q3.0.6, Q3.0.7, Q3.0.5, Customization -@unnumberedsubsec Q3.0.6: Can I force the output of @code{(face-list)} to a buffer? - -It would be good having it in a buffer, as the output of -@code{(face-list)} is too wide to fit to a minibuffer. - -Evaluate the expression in the @samp{*scratch*} buffer with point after -the rightmost paren and typing @kbd{C-j}. - -If the minibuffer smallness is the only problem you encounter, you can -simply press @kbd{C-h l} to get the former minibuffer contents in a -buffer. - -@node Q3.0.7, Q3.0.8, Q3.0.6, Customization -@unnumberedsubsec Q3.0.7: Font selections in don't get saved after @code{Save Options}. - -For XEmacs 19.14 and previous: - -@email{mannj@@ll.mit.edu, John Mann} writes: - -@quotation -You have to go to Options->Menubar Appearance and unselect -@samp{Frame-Local Font Menu}. If this option is selected, font changes -are only applied to the @emph{current} frame and do @emph{not} get saved -when you save options. -@end quotation - -For XEmacs 19.15 and later: - -Implement the above as well as set the following in your @file{.emacs} - -@lisp -(setq options-save-faces t) -@end lisp - -@node Q3.0.8, Q3.0.9, Q3.0.7, Customization -@unnumberedsubsec Q3.0.8: How do I get a single minibuffer frame? - -@email{acs@@acm.org, Vin Shelton} writes: - -@lisp -(setq initial-frame-plist '(minibuffer nil)) -(setq default-frame-plist '(minibuffer nil)) -(setq default-minibuffer-frame - (make-frame - '(minibuffer only - width 86 - height 1 - menubar-visible-p nil - default-toolbar-visible-p nil - name "minibuffer" - top -2 - left -2 - has-modeline-p nil))) -(frame-notice-user-settings) -@end lisp - -@strong{Please note:} The single minibuffer frame may not be to everyone's -taste, and there any number of other XEmacs options settings that may -make it difficult or inconvenient to use. - -@node Q3.0.9, Q3.1.1, Q3.0.8, Customization -@unnumberedsubsec Q3.0.9: What is @code{Customize}? - -Starting with XEmacs 20.2 there is new system 'Customize' for customizing -XEmacs options. - -You can access @code{Customize} from the @code{Options} menu -or invoking one of customize commands by typing eg. -@kbd{M-x customize}, @kbd{M-x customize-face}, -@kbd{M-x customize-variable} or @kbd{M-x customize-apropos}. - -Starting with XEmacs 20.3 there is also new `browser' mode for Customize. -Try it out with @kbd{M-x customize-browse} - -@node Q3.1.1, Q3.1.2, Q3.0.9, Customization -@unnumberedsec 3.1: X Window System & Resources -@unnumberedsubsec Q3.1.1: Where is a list of X resources? - -Search through the @file{NEWS} file for @samp{X Resources}. A fairly -comprehensive list is given after it. - -In addition, an @file{app-defaults} file is supplied, -@file{etc/Emacs.ad} listing the defaults. The file -@file{etc/sample.Xdefaults} gives a set of defaults that you might -consider. It is essentially the same as @file{etc/Emacs.ad} but some -entries are slightly altered. Be careful about installing the contents -of this file into your @file{.Xdefaults} or @file{.Xresources} file if -you use GNU Emacs under X11 as well. - -@node Q3.1.2, Q3.1.3, Q3.1.1, Customization -@unnumberedsubsec Q3.1.2: How can I detect a color display? - -You can test the return value of the function @code{(device-class)}, as -in: - -@lisp -(when (eq (device-class) 'color) - (set-face-foreground 'font-lock-comment-face "Grey") - (set-face-foreground 'font-lock-string-face "Red") - .... - ) -@end lisp - -@node Q3.1.3, Q3.1.4, Q3.1.2, Customization -@unnumberedsubsec Q3.1.3: @code{(set-screen-width)} worked in 19.6, but not in 19.13? - -In Lucid Emacs 19.6 I did @code{(set-screen-width @var{characters})} and -@code{(set-screen-height @var{lines})} in my @file{.emacs} instead of -specifying @code{Emacs*EmacsScreen.geometry} in my -@iftex -@* -@end iftex -@file{.Xdefaults} but -this does not work in XEmacs 19.13. - -These two functions now take frame arguments: - -@lisp -(set-frame-width (selected-frame) @var{characters}) -(set-frame-height (selected-frame) @var{lines}) -@end lisp - -@node Q3.1.4, Q3.1.5, Q3.1.3, Customization -@unnumberedsubsec Q3.1.4: Specifying @code{Emacs*EmacsScreen.geometry} in @file{.emacs} does not work in 19.15? - -In XEmacs 19.11 I specified @code{Emacs*EmacsScreen.geometry} in -my @file{.emacs} but this does not work in XEmacs 19.15. - -We have switched from using the term @dfn{screen} to using the term -@dfn{frame}. - -The correct entry for your @file{.Xdefaults} is now: - -@example -Emacs*EmacsFrame.geometry -@end example - -@node Q3.1.5, Q3.1.6, Q3.1.4, Customization -@unnumberedsubsec Q3.1.5: How can I get the icon to just say @samp{XEmacs}? - -I'd like the icon to just say @samp{XEmacs}, and not include the name of -the current file in it. - -Add the following line to your @file{.emacs}: - -@lisp -(setq frame-icon-title-format "XEmacs") -@end lisp - -@node Q3.1.6, Q3.1.7, Q3.1.5, Customization -@unnumberedsubsec Q3.1.6: How can I have the window title area display the full path? - -I'd like to have the window title area display the full directory/name -of the current buffer file and not just the name. - -Add the following line to your @file{.emacs}: - -@lisp -(setq frame-title-format "%S: %f") -@end lisp - -A more sophisticated title might be: - -@lisp -(setq frame-title-format - '("%S: " (buffer-file-name "%f" - (dired-directory dired-directory "%b")))) -@end lisp - -That is, use the file name, or the dired-directory, or the buffer name. - -@node Q3.1.7, Q3.1.8, Q3.1.6, Customization -@unnumberedsubsec Q3.1.7: @samp{xemacs -name junk} doesn't work? - -When I run @samp{xterm -name junk}, I get an xterm whose class name -according to xprop, is @samp{junk}. This is the way it's supposed to -work, I think. When I run @samp{xemacs -name junk} the class name is -not set to @samp{junk}. It's still @samp{emacs}. What does -@samp{xemacs -name} really do? The reason I ask is that my window -manager (fvwm) will make a window sticky and I use XEmacs to read my -mail. I want that XEmacs window to be sticky, without having to use the -window manager's function to set the window sticky. What gives? - -@samp{xemacs -name} sets the application name for the program (that is, -the thing which normally comes from @samp{argv[0]}). Using @samp{-name} -is the same as making a copy of the executable with that new name. The -@code{WM_CLASS} property on each frame is set to the frame-name, and the -application-class. So, if you did @samp{xemacs -name FOO} and then -created a frame named @var{BAR}, you'd get an X window with WM_CLASS = -@code{( "BAR", "Emacs")}. However, the resource hierarchy for this -widget would be: - -@example -Name: FOO .shell .container .BAR -Class: Emacs .TopLevelEmacsShell.EmacsManager.EmacsFrame -@end example - -instead of the default - -@example -Name: xemacs.shell .container .emacs -Class: Emacs .TopLevelEmacsShell.EmacsManager.EmacsFrame -@end example - - -It is arguable that the first element of WM_CLASS should be set to the -application-name instead of the frame-name, but I think that's less -flexible, since it does not give you the ability to have multiple frames -with different WM_CLASS properties. Another possibility would be for -the default frame name to come from the application name instead of -simply being @samp{emacs}. However, at this point, making that change -would be troublesome: it would mean that many users would have to make -yet another change to their resource files (since the default frame name -would suddenly change from @samp{emacs} to @samp{xemacs}, or whatever -the executable happened to be named), so we'd rather avoid it. - -To make a frame with a particular name use: - -@lisp -(make-frame '((name . "the-name"))) -@end lisp - -@node Q3.1.8, Q3.2.1, Q3.1.7, Customization -@unnumberedsubsec Q3.1.8: @samp{-iconic} doesn't work. - -When I start up XEmacs using @samp{-iconic} it doesn't work right. -Using @samp{-unmapped} on the command line, and setting the -@code{initiallyUnmapped} X Resource don't seem to help much either... - -@email{ben@@666.com, Ben Wing} writes: - -@quotation -Ugh, this stuff is such an incredible mess that I've about given up -getting it to work. The principal problem is numerous window-manager -bugs... -@end quotation - -@node Q3.2.1, Q3.2.2, Q3.1.8, Customization -@unnumberedsec 3.2: Textual Fonts & Colors -@unnumberedsubsec Q3.2.1: How can I set color options from @file{.emacs}? - -How can I set the most commonly used color options from my @file{.emacs} -instead of from my @file{.Xdefaults}? - -Like this: - -@lisp -(set-face-background 'default "bisque") ; frame background -(set-face-foreground 'default "black") ; normal text -(set-face-background 'zmacs-region "red") ; When selecting w/ - ; mouse -(set-face-foreground 'zmacs-region "yellow") -(set-face-font 'default "*courier-bold-r*120-100-100*") -(set-face-background 'highlight "blue") ; Ie when selecting - ; buffers -(set-face-foreground 'highlight "yellow") -(set-face-background 'modeline "blue") ; Line at bottom - ; of buffer -(set-face-foreground 'modeline "white") -(set-face-font 'modeline "*bold-r-normal*140-100-100*") -(set-face-background 'isearch "yellow") ; When highlighting - ; while searching -(set-face-foreground 'isearch "red") -(setq x-pointer-foreground-color "black") ; Adds to bg color, - ; so keep black -(setq x-pointer-background-color "blue") ; This is color - ; you really - ; want ptr/crsr -@end lisp - -@node Q3.2.2, Q3.2.3, Q3.2.1, Customization -@unnumberedsubsec Q3.2.2: How do I set the text, menu and modeline fonts? - -Note that you should use @samp{Emacs.} and not @samp{Emacs*} when -setting face values. - -In @file{.Xdefaults}: - -@example -Emacs.default.attributeFont: -*-*-medium-r-*-*-*-120-*-*-m-*-*-* -Emacs*menubar*font: fixed -Emacs.modeline.attributeFont: fixed -@end example - -This is confusing because modeline is a face, and can be found listed -with all faces in the current mode by using @kbd{M-x set-face-font -(enter) ?}. It uses the face specification of @code{attributeFont}, -while menubar is a normal X thing that uses the specification -@code{font}. With Motif it may be necessary to use @code{fontList} -instead of @code{font}. - -@node Q3.2.3, Q3.2.4, Q3.2.2, Customization -@unnumberedsubsec Q3.2.3: How can I set the colors when highlighting a region? - -How can I set the background/foreground colors when highlighting a -region? - -You can change the face @code{zmacs-region} either in your -@file{.Xdefaults}: - -@example -Emacs.zmacs-region.attributeForeground: firebrick -Emacs.zmacs-region.attributeBackground: lightseagreen -@end example - -or in your @file{.emacs}: - -@lisp -(set-face-background 'zmacs-region "red") -(set-face-foreground 'zmacs-region "yellow") -@end lisp - -@node Q3.2.4, Q3.2.5, Q3.2.3, Customization -@unnumberedsubsec Q3.2.4: How can I limit color map usage? - -I'm using Netscape (or another color grabber like XEmacs); -is there anyway to limit the number of available colors in the color map? - -XEmacs 19.13 didn't have such a mechanism (unlike netscape, or other -color-hogs). One solution is to start XEmacs prior to netscape, since -this will prevent Netscape from grabbing all colors (but Netscape will -complain). You can use the flags for Netscape, like -mono, -ncols <#> -or -install (for mono, limiting to <#> colors, or for using a private -color map). Since Netscape will take the entire colormap and never -release it, the only reasonable way to run it is with @samp{-install}. - -If you have the money, another solution would be to use a truecolor or -direct color video. - -Starting with XEmacs 19.14, XEmacs uses the closest available color if -the colormap is full, so it's O.K. now to start Netscape first. - -@node Q3.2.5, Q3.2.6, Q3.2.4, Customization -@unnumberedsubsec Q3.2.5: My tty supports color, but XEmacs doesn't use them. - -XEmacs tries to automatically determine whether your tty supports color, -but sometimes guesses wrong. In that case, you can make XEmacs Do The -Right Thing using this Lisp code: - -@lisp -(if (eq 'tty (device-type)) - (set-device-class nil 'color)) -@end lisp - -@node Q3.2.6, Q3.3.1, Q3.2.5, Customization -@unnumberedsubsec Q3.2.6: Can I have pixmap backgrounds in XEmacs? -@c New -@email{jvillaci@@wahnsinnig.extreme.indiana.edu, Juan Villacis} writes: - -@quotation -There are several ways to do it. For example, you could specify a -default pixmap image to use in your @file{~/.Xresources}, e.g., - - -@example - Emacs*EmacsFrame.default.attributeBackgroundPixmap: /path/to/image.xpm -@end example - - -and then reload ~/.Xresources and restart XEmacs. Alternatively, -since each face can have its own pixmap background, a better way -would be to set a face's pixmap within your XEmacs init file, e.g., - -@lisp - (set-face-background-pixmap 'default "/path/to/image.xpm") - (set-face-background-pixmap 'bold "/path/to/another_image.xpm") -@end lisp - -and so on. You can also do this interactively via @kbd{M-x edit-faces}. - -@end quotation - -@unnumberedsec 3.3: The Modeline -@node Q3.3.1, Q3.3.2, Q3.2.6, Customization -@unnumberedsubsec Q3.3.1: How can I make the modeline go away? - -@lisp -(set-specifier has-modeline-p nil) -@end lisp - -Starting with XEmacs 19.14 the modeline responds to mouse clicks, so if -you haven't liked or used the modeline in the past, you might want to -try the new version out. - -@node Q3.3.2, Q3.3.3, Q3.3.1, Customization -@unnumberedsubsec Q3.3.2: How do you have XEmacs display the line number in the modeline? - -Add the following line to your @file{.emacs} file to display the -line number: - -@lisp -(line-number-mode 1) -@end lisp - -Use the following to display the column number: - -@lisp -(column-number-mode 1) -@end lisp - -Or select from the @code{Options} menu -@iftex -@* -@end iftex -@code{Customize->Emacs->Editing->Basics->Line Number Mode} -and/or -@iftex -@* -@end iftex -@code{Customize->Emacs->Editing->Basics->Column Number Mode} - -Or type @kbd{M-x customize @key{RET} editing-basics @key{RET}}. - -@node Q3.3.3, Q3.3.4, Q3.3.2, Customization -@unnumberedsubsec Q3.3.3: How do I get XEmacs to put the time of day on the modeline? - -Add the following line to your @file{.emacs} file to display the -time: - -@lisp -(display-time) -@end lisp - -See @code{Customize} from the @code{Options} menu for customization. - -@node Q3.3.4, Q3.3.5, Q3.3.3, Customization -@unnumberedsubsec Q3.3.4: How do I turn off current chapter from AUC TeX modeline? - -With AUC TeX, fast typing is hard because the current chapter, section -etc. are given in the modeline. How can I turn this off? - -It's not AUC TeX, it comes from @code{func-menu} in @file{func-menu.el}. -Add this code to your @file{.emacs} to turn it off: - -@lisp -(setq fume-display-in-modeline-p nil) -@end lisp - -Or just add a hook to @code{TeX-mode-hook} to turn it off only for TeX -mode: - -@lisp -(add-hook 'TeX-mode-hook - '(lambda () (setq fume-display-in-modeline-p nil))) -@end lisp - -@email{dhughes@@origin-at.co.uk, David Hughes} writes: - -@quotation -If you have 19.14 or later, try this instead; you'll still get the -function name displayed in the modeline, but it won't attempt to keep -track when you modify the file. To refresh when it gets out of synch, -you simply need click on the @samp{Rescan Buffer} option in the -function-menu. - -@lisp -(setq-default fume-auto-rescan-buffer-p nil) -@end lisp -@end quotation - -@node Q3.3.5, Q3.4.1, Q3.3.4, Customization -@unnumberedsubsec Q3.3.5: How can one change the modeline color based on the mode used? - -You can use something like the following: - -@lisp -(add-hook 'lisp-mode-hook - (lambda () - (set-face-background 'modeline "red" (current-buffer)))) -@end lisp - -Then, when editing a Lisp file (i.e. when in Lisp mode), the modeline -colors change from the default set in your @file{.emacs}. The change -will only be made in the buffer you just entered (which contains the -Lisp file you are editing) and will not affect the modeline colors -anywhere else. - -Notes: - -@itemize @bullet - -@item -The hook is the mode name plus @code{-hook}. eg. c-mode-hook, -c++-mode-hook, emacs-lisp-mode-hook (used for your @file{.emacs} or a -@file{xx.el} file), lisp-interaction-mode-hook (the @samp{*scratch*} -buffer), text-mode-hook, etc. - -@item -Be sure to use @code{add-hook}, not @code{(setq c-mode-hook xxxx)}, -otherwise you will erase anything that anybody has already put on the -hook. - -@item -You can also do @code{(set-face-font 'modeline @var{font})}, -eg. @code{(set-face-font 'modeline "*bold-r-normal*140-100-100*" -(current-buffer))} if you wish the modeline font to vary based on the -current mode. -@end itemize - -This works in 19.15 as well, but there are additional modeline faces, -@code{modeline-buffer-id}, @code{modeline-mousable}, and -@code{modeline-mousable-minor-mode}, which you may want to customize. - -@node Q3.4.1, Q3.4.2, Q3.3.5, Customization -@unnumberedsec 3.4: Multiple Device Support -@unnumberedsubsec Q3.4.1: How do I open a frame on another screen of my multi-headed display? - -The support for this was revamped for 19.14. Use the command -@kbd{M-x make-frame-on-display}. This command is also on the File menu -in the menubar. - -XEmacs 19.14 and later also have the command @code{make-frame-on-tty} -which will establish a connection to any tty-like device. Opening the -TTY devices should be left to @code{gnuclient}, though. - -@node Q3.4.2, Q3.5.1, Q3.4.1, Customization -@unnumberedsubsec Q3.4.2: Can I really connect to a running XEmacs after calling up over a modem? How? - -If you're not running at least XEmacs 19.14, you can't. Otherwise check -out the @code{gnuattach} program supplied with XEmacs. Starting with -XEmacs 20.3, @code{gnuattach} and @code{gnudoit} functionality is -provided by @code{gnuclient}. - -Also @xref{Q5.0.12}. - -@node Q3.5.1, Q3.5.2, Q3.4.2, Customization -@unnumberedsec 3.5: The Keyboard -@unnumberedsubsec Q3.5.1: How can I bind complex functions (or macros) to keys? - -As an example, say you want the @kbd{paste} key on a Sun keyboard to -insert the current Primary X selection at point. You can accomplish this -with: - -@lisp -(define-key global-map [f18] 'x-insert-selection) -@end lisp - -However, this only works if there is a current X selection (the -selection will be highlighted). The functionality I like is for the -@kbd{paste} key to insert the current X selection if there is one, -otherwise insert the contents of the clipboard. To do this you need to -pass arguments to @code{x-insert-selection}. This is done by wrapping -the call in a 'lambda form: - -@lisp -(global-set-key [f18] - (lambda () (interactive) (x-insert-selection t nil))) -@end lisp - -This binds the f18 key to a @dfn{generic} functional object. The -interactive spec is required because only interactive functions can be -bound to keys. - -For the FAQ example you could use: - -@lisp -(global-set-key [(control ?.)] - (lambda () (interactive) (scroll-up 1))) -(global-set-key [(control ? ;)] - (lambda () (interactive) (scroll-up -1))) -@end lisp - -This is fine if you only need a few functions within the lambda body. -If you're doing more it's cleaner to define a separate function as in -question 3.5.3 (@xref{Q3.5.3}). - -@node Q3.5.2, Q3.5.3, Q3.5.1, Customization -@unnumberedsubsec Q3.5.2: How can I stop down-arrow from adding empty lines to the bottom of my buffers? - -Add the following line to your @file{.emacs} file: - -@lisp -(setq next-line-add-newlines nil) -@end lisp - -This has been the default setting in XEmacs for some time. - -@node Q3.5.3, Q3.5.4, Q3.5.2, Customization -@unnumberedsubsec Q3.5.3: How do I bind C-. and C-; to scroll one line up and down? - -Add the following (Thanks to @email{mly@@adoc.xerox.com, Richard Mlynarik} and -@email{wayne@@zen.cac.stratus.com, Wayne Newberry}) to @file{.emacs}: - -@lisp -(defun scroll-up-one-line () - (interactive) - (scroll-up 1)) - -(defun scroll-down-one-line () - (interactive) - (scroll-down 1)) - -(global-set-key [(control ?.)] 'scroll-up-one-line) ; C-. -(global-set-key [(control ? ;)] 'scroll-down-one-line) ; C-; -@end lisp - -The key point is that you can only bind simple functions to keys; you -can not bind a key to a function that you're also passing arguments to. -(@xref{Q3.5.1} for a better answer). - -@node Q3.5.4, Q3.5.5, Q3.5.3, Customization -@unnumberedsubsec Q3.5.4: Globally binding @kbd{Delete}? - -I cannot manage to globally bind my @kbd{Delete} key to something other -than the default. How does one do this? - -@lisp -(defun foo () - (interactive) - (message "You hit DELETE")) - -(global-set-key 'delete 'foo) -@end lisp - -However, some modes explicitly bind @kbd{Delete}, so you would need to -add a hook that does @code{local-set-key} for them. If what you want to -do is make the Backspace and Delete keys work more PC/Motif-like, then -take a look at the @file{delbs.el} package. - -New in XEmacs 19.14 is a variable called @code{key-translation-map} -which makes it easier to bind @kbd{Delete}. @file{delbs.el} is a -good example of how to do this correctly. - -Also @xref{Q3.5.10}. - -@node Q3.5.5, Q3.5.6, Q3.5.4, Customization -@unnumberedsubsec Q3.5.5: Scrolling one line at a time. - -Can the cursor keys scroll the screen a line at a time, rather than the -default half page jump? I tend it to find it disorienting. - -Try this: - -@lisp -(defun scroll-one-line-up (&optional arg) - "Scroll the selected window up (forward in the text) one line (or N lines)." - (interactive "p") - (scroll-up (or arg 1))) - -(defun scroll-one-line-down (&optional arg) - "Scroll the selected window down (backward in the text) one line (or N)." - (interactive "p") - (scroll-down (or arg 1))) - -(global-set-key [up] 'scroll-one-line-up) -(global-set-key [down] 'scroll-one-line-down) -@end lisp - -The following will also work but will affect more than just the cursor -keys (i.e. @kbd{C-n} and @kbd{C-p}): - -@lisp -(setq scroll-step 1) -@end lisp - -Starting with XEmacs-20.3 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Windows->Scroll Step...} or type -@kbd{M-x customize @key{RET} windows @key{RET}}. - -@node Q3.5.6, Q3.5.7, Q3.5.5, Customization -@unnumberedsubsec Q3.5.6: How to map @kbd{Help} key alone on Sun type4 keyboard? - -The following works in GNU Emacs 19: - -@lisp -(global-set-key [help] 'help-command);; Help -@end lisp - -The following works in XEmacs 19.15 with the addition of shift: - -@lisp -(global-set-key [(shift help)] 'help-command);; Help -@end lisp - -But it doesn't work alone. This is in the file @file{PROBLEMS} which -should have come with your XEmacs installation: @emph{Emacs ignores the -@kbd{help} key when running OLWM}. - -OLWM grabs the @kbd{help} key, and retransmits it to the appropriate -client using -@iftex -@* -@end iftex -@code{XSendEvent}. Allowing Emacs to react to synthetic -events is a security hole, so this is turned off by default. You can -enable it by setting the variable @code{x-allow-sendevents} to t. You -can also cause fix this by telling OLWM to not grab the help key, with -the null binding @code{OpenWindows.KeyboardCommand.Help:}. - -@node Q3.5.7, Q3.5.8, Q3.5.6, Customization -@unnumberedsubsec Q3.5.7: How can you type in special characters in XEmacs? -@c Changed -One way is to use the package @code{x-compose}. Then you can use -sequences like @kbd{Compose " a} to get ä, etc. - -Another way is to use the @code{iso-insert} package, provided in XEmacs -19.15 and later. Then you can use sequences like @kbd{C-x 8 " a} to get -ä, etc. - -@email{glynn@@sensei.co.uk, Glynn Clements} writes: - -@quotation -It depends upon your X server. - -Generally, the simplest way is to define a key as Multi_key with -xmodmap, e.g. -@c hey, show some respect, willya -- there's xkeycaps, isn't there? -- -@c chr ;) -@example - xmodmap -e 'keycode 0xff20 = Multi_key' -@end example - -You will need to pick an appropriate keycode. Use xev to find out the -keycodes for each key. - -[NB: On a `Windows' keyboard, recent versions of XFree86 automatically -define the right `Windows' key as Multi_key'.] - -Once you have Multi_key defined, you can use e.g. -@example - Multi a ' => á - Multi e " => ë - Multi c , => ç -@end example - -etc. - -Also, recent versions of XFree86 define various AltGr- -combinations as dead keys, i.e. -@example - AltGr [ => dead_diaeresis - AltGr ] => dead_tilde - AltGr ; => dead_acute -@end example -etc. - -Running @samp{xmodmap -pk} will list all of the defined keysyms. -@end quotation - -@node Q3.5.8, Q3.5.9, Q3.5.7, Customization -@unnumberedsubsec Q3.5.8: Why does @code{(global-set-key [delete-forward] 'delete-char)} complain? - -Why does @code{(define-key global-map [ delete-forward ] 'delete-char)} -complain of not being able to bind an unknown key? - -Try this instead: - -@lisp -(define-key global-map [delete_forward] 'delete-char) -@end lisp - -and it will work. - -What you are seeing above is a bug due to code that is trying to check -for GNU Emacs syntax like: - -(define-key global-map [C-M-a] 'delete-char) - -which otherwise would cause no errors but would not result in the -expected behavior. - -This bug has been fixed in 19.14. - -@node Q3.5.9, Q3.5.10, Q3.5.8, Customization -@unnumberedsubsec Q3.5.9: How do I make the Delete key delete forward? - -With XEmacs-20.2 use the @code{delbs} package: - -@lisp -(require 'delbs) -@end lisp - -This will give you the functions @code{delbs-enable-delete-forward} to -set things up, and @code{delbs-disable-delete-forward} to revert to -``normal'' behavior. Note that @code{delbackspace} package is obsolete. - -Starting with XEmacs-20.3 better solution is to set variable -@code{delete-key-deletes-forward} to t. You can also change this with -Customize. Select from the @code{Options} menu -@code{Customize->Emacs->Editing->Basics->Delete Key Deletes Forward} or -type @kbd{M-x customize @key{RET} editing-basics @key{RET}}. - -Also @xref{Q3.5.4}. - -@node Q3.5.10, Q3.5.11, Q3.5.9, Customization -@unnumberedsubsec Q3.5.10: Can I turn on @dfn{sticky} modifier keys? - -Yes, with @code{(setq modifier-keys-are-sticky t)}. This will give the -effect of being able to press and release Shift and have the next -character typed come out in upper case. This will affect all the other -modifier keys like Control and Meta as well. - -@email{ben@@666.com, Ben Wing} writes: - -@quotation -One thing about the sticky modifiers is that if you move the mouse out -of the frame and back in, it cancels all currently ``stuck'' modifiers. -@end quotation - -@node Q3.5.11, Q3.6.1, Q3.5.10, Customization -@unnumberedsubsec Q3.5.11: How do I map the arrow keys? -@c New -Say you want to map @kbd{C-@key{right}} to forward-word: - -@email{sds@@usa.net, Sam Steingold} writes: - -@quotation -@lisp -; both XEmacs and Emacs -(define-key global-map [(control right)] 'forward-word) -@end lisp -or -@lisp -; Emacs only -(define-key global-map [C-right] 'forward-word) -@end lisp -or -@lisp -; ver > 20, both -(define-key global-map (kbd "C-") 'forward-word) -@end lisp -@end quotation - - - -@node Q3.6.1, Q3.6.2, Q3.5.11, Customization -@unnumberedsec 3.6: The Cursor -@unnumberedsubsec Q3.6.1: Is there a way to make the bar cursor thicker? - -I'd like to have the bar cursor a little thicker, as I tend to "lose" it -often. - -For a 1 pixel bar cursor, use: - -@lisp -(setq bar-cursor t) -@end lisp - -For a 2 pixel bar cursor, use: - -@lisp -(setq bar-cursor 'anything-else) -@end lisp - -Starting with XEmacs-20.3 you can also change these with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Display->Bar Cursor...} or type -@kbd{M-x customize @key{RET} display @key{RET}}. - -You can use a color to make it stand out better: - -@example -Emacs*cursorColor: Red -@end example - -@node Q3.6.2, Q3.6.3, Q3.6.1, Customization -@unnumberedsubsec Q3.6.2: Is there a way to get back the block cursor? - -@lisp -(setq bar-cursor nil) -@end lisp - -Starting with XEmacs-20.3 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Display->Bar Cursor...} or type -@kbd{M-x customize @key{RET} display @key{RET}}. - -@node Q3.6.3, Q3.7.1, Q3.6.2, Customization -@unnumberedsubsec Q3.6.3: Can I make the cursor blink? - -If you are running a version of XEmacs older than 19.14, no. Otherwise -you can do the following: - -@lisp -(blink-cursor-mode) -@end lisp - -This function toggles between a steady cursor and a blinking cursor. -You may also set this mode from the menu bar by selecting @samp{Options -=> Frame Appearance => Blinking Cursor}. Remember to save options. - -@node Q3.7.1, Q3.7.2, Q3.6.3, Customization -@unnumberedsec 3.7: The Mouse and Highlighting -@unnumberedsubsec Q3.7.1: How can I turn off Mouse pasting? - -I keep hitting the middle mouse button by accident and getting stuff -pasted into my buffer so how can I turn this off? - -Here is an alternative binding, whereby the middle mouse button selects -(but does not cut) the expression under the mouse. Clicking middle on a -left or right paren will select to the matching one. Note that you can -use @code{define-key} or @code{global-set-key}. - -@lisp -(defun mouse-set-point-and-select (event) - "Sets the point at the mouse location, then marks following form" - (interactive "@@e") - (mouse-set-point event) - (mark-sexp 1)) -(define-key global-map [button2] 'mouse-set-point-and-select) -@end lisp - -@node Q3.7.2, Q3.7.3, Q3.7.1, Customization -@unnumberedsubsec Q3.7.2: How do I set control/meta/etc modifiers on mouse buttons? - -Use, for instance, @code{[(meta button1)]}. For example, here is a common -setting for Common Lisp programmers who use the bundled @code{ilisp} -package, whereby meta-button1 on a function name will find the file where -the function name was defined, and put you at that location in the source -file. - -[Inside a function that gets called by the lisp-mode-hook and -ilisp-mode-hook] - -@lisp -(local-set-key [(meta button1)] 'edit-definitions-lisp) -@end lisp - -@node Q3.7.3, Q3.7.4, Q3.7.2, Customization -@unnumberedsubsec Q3.7.3: Clicking the left button does not do anything in buffer list. - -I do @kbd{C-x C-b} to get a list of buffers and the entries get -highlighted when I move the mouse over them but clicking the left mouse -does not do anything. - -Use the middle mouse button. - -@node Q3.7.4, Q3.7.5, Q3.7.3, Customization -@unnumberedsubsec Q3.7.4: How can I get a list of buffers when I hit mouse button 3? - -The following code will replace the default popup on button3: - -@lisp -(global-set-key [button3] 'popup-buffer-menu) -@end lisp - -@node Q3.7.5, Q3.7.6, Q3.7.4, Customization -@unnumberedsubsec Q3.7.5: Why does cut-and-paste not work between XEmacs and a cmdtool? - -We don't know. It's a bug. There does seem to be a work-around, -however. Try running xclipboard first. It appears to fix the problem -even if you exit it. (This should be mostly fixed in 19.13, but we -haven't yet verified that). - -@node Q3.7.6, Q3.7.7, Q3.7.5, Customization -@unnumberedsubsec Q3.7.6: How I can set XEmacs up so that it pastes where the text cursor is? - -By default XEmacs pastes X selections where the mouse pointer is. How -do I disable this? - -Examine the function @code{mouse-yank}, by typing @kbd{C-h f mouse-yank -@key{RET}}. - -To get XEmacs to paste at the text cursor, add this your @file{.emacs}: - -@lisp -(setq mouse-yank-at-point t) -@end lisp - -Starting with XEmacs-20.2 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Editing->Mouse->Yank At Point...} or type -@kbd{M-x customize @key{RET} mouse @key{RET}}. - -@node Q3.7.7, Q3.7.8, Q3.7.6, Customization -@unnumberedsubsec Q3.7.7: How do I select a rectangular region? - -Just select the region normally, then use the rectangle commands (e.g. -@code{kill-rectangle} on it. The region does not highlight as a -rectangle, but the commands work just fine. - -To actually sweep out rectangular regions with the mouse you can use -@code{mouse-track-do-rectangle} which is assigned to @kbd{M-button1}. -Then use rectangle commands. - -You can also do the following to change default behavior to sweep out -rectangular regions: - -@lisp -(setq mouse-track-rectangle-p t) -@end lisp - -Starting with XEmacs-20.2 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Editing->Mouse->Track Rectangle...} or type -@kbd{M-x customize @key{RET} mouse @key{RET}}. - - -@example - mouse-track-do-rectangle: (event) - -- an interactive compiled Lisp function. - Like `mouse-track' but selects rectangles instead of regions. -@end example - -@node Q3.7.8, Q3.8.1, Q3.7.7, Customization -@unnumberedsubsec Q3.7.8: Why does @kbd{M-w} take so long? - -It actually doesn't. It leaves the region visible for a second so that -you can see what area is being yanked. If you start working, though, it -will immediately complete its operation. In other words, it will only -delay for a second if you let it. - -@node Q3.8.1, Q3.8.2, Q3.7.8, Customization -@unnumberedsec 3.8: The Menubar and Toolbar -@unnumberedsubsec Q3.8.1: How do I get rid of the menu (or menubar)? - -If you are running XEmacs 19.13 and earlier, add this command to your -@file{.emacs}. - -@lisp -(set-menubar nil) -@end lisp - -Starting with XEmacs 19.14 the preferred method is: - -@lisp -(set-specifier menubar-visible-p nil) -@end lisp - -@node Q3.8.2, Q3.8.3, Q3.8.1, Customization -@unnumberedsubsec Q3.8.2: Can I customize the basic menubar? - -For an extensive menubar, add this line to your @file{.emacs}: - -@lisp -(load "big-menubar") -@end lisp - -If you'd like to write your own, this file provides as good a set of -examples as any to start from. The file is located in -@file{lisp/packages/big-menubar.el} in the XEmacs installation -directory. - -@node Q3.8.3, Q3.8.4, Q3.8.2, Customization -@unnumberedsubsec Q3.8.3: How do I control how many buffers are listed in the menu @code{Buffers List}? - -Add the following to your @file{.emacs} (suit to fit): - -@lisp -(setq buffers-menu-max-size 20) -@end lisp - -For no limit, use an argument of @samp{nil}. - -Starting with XEmacs-20.3 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Menu->Buffers Menu->Max Size...} or -type @kbd{M-x customize @key{RET} buffers-menu @key{RET}}. - -@node Q3.8.4, Q3.8.5, Q3.8.3, Customization -@unnumberedsubsec Q3.8.4: Resources like @code{Emacs*menubar*font} are not working? - -I am trying to use a resource like @code{Emacs*menubar*font} to set the -font of the menubar but it's not working. - -If you are using the real Motif menubar, this resource is not -recognized; you have to say: - -@example -Emacs*menubar*fontList: FONT -@end example - -If you are using the Lucid menubar, the former resource will be -recognized only if the latter resource is unset. This means that the -resource - -@example -*fontList: FONT -@end example - -will override - -@example -Emacs*menubar*font: FONT -@end example - -even though the latter is more specific. - -@node Q3.8.5, Q3.9.1, Q3.8.4, Customization -@unnumberedsubsec Q3.8.5: How can I bind a key to a function to toggle the toolbar? - -Try something like: - -@lisp -(defun my-toggle-toolbar () - (interactive) - (set-specifier default-toolbar-visible-p - (not (specifier-instance default-toolbar-visible-p)))) -(global-set-key "\C-xT" 'my-toggle-toolbar) -@end lisp - -There are redisplay bugs in 19.14 that may make the preceding result in -a messed-up display, especially for frames with multiple windows. You -may need to resize the frame before XEmacs completely realizes the -toolbar is really gone. - -Thanks to @email{martin@@xemacs.org, Martin Buchholz} for the correct -code. - -@node Q3.9.1, Q3.9.2, Q3.8.5, Customization -@unnumberedsec 3.9: Scrollbars -@unnumberedsubsec Q3.9.1: How can I disable the scrollbar? - -To disable them for all frames, add the following line to -your @file{.Xdefaults}: - -@example -Emacs.scrollBarWidth: 0 -@end example - -Or select from the @code{Options} menu @code{Frame Appearance->Scrollbars}. -Remember to save options. - -To turn the scrollbar off on a per-frame basis, use the following -function: - -@lisp -(set-specifier scrollbar-width 0 (selected-frame)) -@end lisp - -You can actually turn the scrollbars on at any level you want by -substituting for (selected-frame) in the above command. For example, to -turn the scrollbars off only in a single buffer: - -@lisp -(set-specifier scrollbar-width 0 (current-buffer)) -@end lisp - -In XEmacs versions prior to 19.14, you had to use the hairier construct: - -@lisp -(set-specifier scrollbar-width (cons (selected-frame) 0)) -@end lisp - -@node Q3.9.2, Q3.9.3, Q3.9.1, Customization -@unnumberedsubsec Q3.9.2: How can one use resources to change scrollbar colors? - -Here's a recap of how to use resources to change your scrollbar colors: - -@example -! Motif scrollbars - -Emacs*XmScrollBar.Background: skyblue -Emacs*XmScrollBar.troughColor: lightgray - -! Athena scrollbars - -Emacs*Scrollbar.Foreground: skyblue -Emacs*Scrollbar.Background: lightgray -@end example - -Note the capitalization of @code{Scrollbar} for the Athena widget. - -@node Q3.9.3, Q3.9.4, Q3.9.2, Customization -@unnumberedsubsec Q3.9.3: Moving the scrollbar can move the point; can I disable this? - -When I move the scrollbar in an XEmacs window, it moves the point as -well, which should not be the default behavior. Is this a bug or a -feature? Can I disable it? - -The current behavior is a feature, not a bug. Point remains at the same -buffer position as long as that position does not scroll off the screen. -In that event, point will end up in either the upper-left or lower-left -hand corner. - -This cannot be changed. - -@node Q3.9.4, Q3.10.1, Q3.9.3, Customization -@unnumberedsubsec Q3.9.4: How can I get automatic horizontal scrolling? - -By the same token, how can I turn it off in specific modes? - -To do this, add to your @file{.emacs} file: - -@lisp -(require 'auto-show) -@end lisp - -Then do @code{(setq truncate-lines t)} in the mode-hooks for any modes -in which you want lines truncated. - -More precisely: If @code{truncate-lines} is nil, horizontal scrollbars -will never appear. Otherwise, they will appear only if the value of -@code{scrollbar-height} for that buffer/window/etc. is non-zero. If you -do - -@lisp -(set-specifier scrollbar-height 0) -@end lisp - -then horizontal scrollbars will not appear in truncated buffers unless -the package specifically asked for them. - -Automatic horizontal scrolling is now standard, starting with 19.14. - -@node Q3.10.1, Q3.10.2, Q3.9.4, Customization -@unnumberedsec 3.10: Text Selections -@unnumberedsubsec Q3.10.1: How can I turn off or change highlighted selections? - -The @code{zmacs} mode allows for what some might call gratuitous -highlighting for selected regions (either by setting mark or by using -the mouse). This is the default behavior. To turn off, add the -following line to your @file{.emacs} file: - -@lisp -(setq zmacs-regions nil) -@end lisp - -Starting with XEmacs-20.2 you can also change this with Customize. Select -from the @code{Options} menu @code{Customize->Emacs->Editing->Basics->Zmacs -Regions} or type @kbd{M-x customize @key{RET} editing-basics @key{RET}}. - -To change the face for selection, look at @code{Options->Customize} on -the menubar. - -@node Q3.10.2, Q3.10.3, Q3.10.1, Customization -@unnumberedsubsec Q3.10.2: How do I get that typing on an active region removes it? - -I want to change things so that if I select some text and start typing, -the typed text replaces the selected text, similar to Motif. - -You want to use something called @dfn{pending delete}. Pending delete -is what happens when you select a region (with the mouse or keyboard) -and you press a key to replace the selected region by the key you typed. -Usually backspace kills the selected region. - -To get this behavior, add the following line to your @file{.emacs}: - -@lisp -(turn-on-pending-delete) -@end lisp - -Note that this will work with both Backspace and Delete. - -@node Q3.10.3, Q3.10.4, Q3.10.2, Customization -@unnumberedsubsec Q3.10.3: Can I turn off the highlight during isearch? - -I do not like my text highlighted while I am doing isearch as I am not -able to see what's underneath. How do I turn it off? - -Put the following in your @file{.emacs}: - -@lisp -(setq isearch-highlight nil) -@end lisp - -Starting with XEmacs-20.2 you can also change this with Customize. Type -@kbd{M-x customize-variable @key{RET} isearch-highlight @key{RET}}. - -Note also that isearch-highlight affects query-replace and ispell. -Instead of disabling isearch-highlight you may find that a better -solution consists of customizing the @code{isearch} face. - -@node Q3.10.4, Q3.10.5, Q3.10.3, Customization -@unnumberedsubsec Q3.10.4: How do I turn off highlighting after @kbd{C-x C-p} (mark-page)? - -Put this in your @code{.emacs}: - -@lisp -(setq zmacs-regions nil) -@end lisp - -@strong{Warning: This command turns off all region highlighting.} - -Also @xref{Q3.10.1}. - -@node Q3.10.5, , Q3.10.4, Customization -@unnumberedsubsec Q3.10.5: The region disappears when I hit the end of buffer while scrolling. - -This has been fixed by default starting with XEmacs-20.3. - -With older versions you can turn this feature (if it indeed is a feature) -off like this: - -@lisp -(defadvice scroll-up (around scroll-up freeze) - (interactive "_P") - (let ((zmacs-region-stays t)) - (if (interactive-p) - (condition-case nil - ad-do-it - (end-of-buffer (goto-char (point-max)))) - ad-do-it))) - -(defadvice scroll-down (around scroll-down freeze) - (interactive "_P") - (let ((zmacs-region-stays t)) - (if (interactive-p) - (condition-case nil - ad-do-it - (beginning-of-buffer (goto-char (point-min)))) - ad-do-it))) -@end lisp - -Thanks to @email{raman@@adobe.com, T. V. Raman} for assistance in deriving this -answer. - -@node Subsystems, Miscellaneous, Customization, Top -@unnumbered 4 Major Subsystems - -This is part 4 of the XEmacs Frequently Asked Questions list. This -section is devoted to major XEmacs subsystems. - -@menu -Reading Mail with VM: -* Q4.0.1:: How do I set up VM to retrieve remote mail using POP? -* Q4.0.2:: How do I get VM to filter mail for me? -* Q4.0.3:: How can I get VM to automatically check for new mail? -* Q4.0.4:: [This question intentionally left blank] -* Q4.0.5:: How do I get my outgoing mail archived? -* Q4.0.6:: I have various addresses at which I receive mail. How can I tell VM to ignore them when doing a "reply-all"? -* Q4.0.7:: Is there a mailing list or FAQ for VM? -* Q4.0.8:: Remote mail reading with VM. -* Q4.0.9:: rmail or VM gets an error incorporating new mail. -* Q4.0.10:: How do I make VM stay in a single frame? -* Q4.0.11:: How do I make VM or mh-e display graphical smilies? -* Q4.0.12:: Customization of VM not covered in the manual or here. - -Web browsing with W3: -* Q4.1.1:: What is W3? -* Q4.1.2:: How do I run W3 from behind a firewall? -* Q4.1.3:: Is it true that W3 supports style sheets and tables? - -Reading Netnews and Mail with Gnus: -* Q4.2.1:: GNUS, (ding) Gnus, Gnus 5, September Gnus, Red Gnus,argh! -* Q4.2.2:: [This question intentionally left blank] -* Q4.2.3:: How do I make Gnus stay within a single frame? -* Q4.2.4:: How do I customize the From: line? - -Other Mail & News: -* Q4.3.1:: How can I read and/or compose MIME messages? -* Q4.3.2:: What is TM and where do I get it? -* Q4.3.3:: Why isn't this @code{movemail} program working? -* Q4.3.4:: Movemail is also distributed by Netscape? Can that cause problems? -* Q4.3.5:: Where do I find pstogif (required by tm)? - -Sparcworks, EOS, and WorkShop: -* Q4.4.1:: What is SPARCworks, EOS, and WorkShop - -Energize: -* Q4.5.1:: What is/was Energize? - -Infodock: -* Q4.6.1:: What is Infodock? - -Other Unbundled Packages: -* Q4.7.1:: What is AUC TeX? Where do you get it? -* Q4.7.2:: Are there any Emacs Lisp Spreadsheets? -* Q4.7.3:: Byte compiling AUC TeX on XEmacs 19.14 -* Q4.7.4:: Problems installing AUC TeX -* Q4.7.5:: Is there a reason for an Emacs package not to be included in XEmacs? -* Q4.7.6:: Is there a MatLab mode? -@end menu - -@node Q4.0.1, Q4.0.2, Subsystems, Subsystems -@unnumberedsec 4.0: Reading Mail with VM -@unnumberedsubsec Q4.0.1: How do I set up VM to retrieve mail from a remote site using POP? - -Use @code{vm-spool-files}, like this for example: - -@lisp -(setq vm-spool-files '("/var/spool/mail/wing" - "netcom23.netcom.com:110:pass:wing:MYPASS")) -@end lisp - -Of course substitute your actual password for MYPASS. - -@node Q4.0.2, Q4.0.3, Q4.0.1, Subsystems -@unnumberedsubsec Q4.0.2: How do I get VM to filter mail for me? - -One possibility is to use procmail to split your mail before it gets to -VM. I prefer this personally, since there are many strange and -wonderful things one can do with procmail. Procmail may be found at -@uref{ftp://ftp.informatik.rwth-aachen.de/pub/packages/procmail/}. - -Also see the Mail Filtering FAQ at: -@iftex -@* -@end iftex -@uref{ftp://rtfm.mit.edu/pub/usenet/news.answers/mail/filtering-faq}. -@c Link above, -@c -@c was dead. - -@node Q4.0.3, Q4.0.4, Q4.0.2, Subsystems -@unnumberedsubsec Q4.0.3: How can I get VM to automatically check for new mail? - -@email{turner@@lanl.gov, John Turner} writes: - -@quotation -Use the following: - -@lisp -(setq vm-auto-get-new-mail 60) -@end lisp -@end quotation - -@node Q4.0.4, Q4.0.5, Q4.0.3, Subsystems -@unnumberedsubsec Q4.0.4: [This question intentionally left blank] - -Obsolete question, left blank to avoid renumbering. - -@node Q4.0.5, Q4.0.6, Q4.0.4, Subsystems -@unnumberedsubsec Q4.0.5: How do I get my outgoing mail archived? - -@lisp -(setq mail-archive-file-name "~/outbox") -@end lisp - -@node Q4.0.6, Q4.0.7, Q4.0.5, Subsystems -@unnumberedsubsec Q4.0.6: I have various addresses at which I receive mail. How can I tell VM to ignore them when doing a "reply-all"? - -Set @code{vm-reply-ignored-addresses} to a list, like - -@lisp -(setq vm-reply-ignored-addresses - '("wing@@nuspl@@nvwls.cc.purdue.edu,netcom[0-9]*.netcom.com" - "wing@@netcom.com" "wing@@666.com")) -@end lisp - -Note that each string is a regular expression. - -@node Q4.0.7, Q4.0.8, Q4.0.6, Subsystems -@unnumberedsubsec Q4.0.7: Is there a mailing list or FAQ for VM? - -A FAQ for VM exists at @uref{http://www.cyberpass.net/~gorkab/vmfaq.htm}. - -VM has its own newsgroups gnu.emacs.vm.info and gnu.emacs.vm.bug. - -@node Q4.0.8, Q4.0.9, Q4.0.7, Subsystems -@unnumberedsubsec Q4.0.8: Remote mail reading with VM. - -My mailbox lives at the office on a big honkin server. My regular INBOX -lives on my honkin desktop machine. I now can PPP to the office from -home which is far from honking... I'd like to be able to read mail at -home without storing it here and I'd like to use xemacs and VM at -home... Is there a recommended setup? - -@email{nuspl@@nvwls.cc.purdue.edu, Joseph J. Nuspl Jr.} writes: - -@quotation -There are several ways to do this. - -@enumerate -@item -Set your display to your home machine and run dxpc or one of the other X -compressors. - -@item -NFS mount your desktop machine on your home machine and modify your pop -command on your home machine to rsh to your desktop machine and actually -do the pop get's. - -@item -Run a POP server on your desktop machine as well and do a sort of two -tiered POP get. -@end enumerate -@end quotation - - @email{wmperry@@monolith.spry.com, William Perry} adds: - -@quotation -Or you could run a pop script periodically on your desktop machine, and -just use ange-ftp or NFS to get to your mailbox. I used to do this all -the time back at IU. -@end quotation - -@node Q4.0.9, Q4.0.10, Q4.0.8, Subsystems -@unnumberedsubsec Q4.0.9: rmail or VM gets an error incorporating new mail. - -Quoting the XEmacs PROBLEMS file: - -@quotation -rmail and VM get new mail from @file{/usr/spool/mail/$USER} using a -program called @code{movemail}. This program interlocks with -@code{/bin/mail} using the protocol defined by @code{/bin/mail}. - -There are two different protocols in general use. One of them uses the -@code{flock} system call. The other involves creating a lock file; -@code{movemail} must be able to write in @file{/usr/spool/mail} in order -to do this. You control which one is used by defining, or not defining, -the macro @code{MAIL_USE_FLOCK} in @file{config.h} or the m- or s- file -it includes. - -@strong{IF YOU DON'T USE THE FORM OF INTERLOCKING THAT IS NORMAL ON YOUR -SYSTEM, YOU CAN LOSE MAIL!} - -If your system uses the lock file protocol, and fascist restrictions -prevent ordinary users from writing the lock files in -@file{/usr/spool/mail}, you may need to make @code{movemail} setgid to a -suitable group such as @samp{mail}. You can use these commands (as -root): - -@example -chgrp mail movemail -chmod 2755 movemail -@end example - -If your system uses the lock file protocol, and fascist restrictions -prevent ordinary users from writing the lock files in -@file{/usr/spool/mail}, you may need to make @code{movemail} setgid to a -suitable group such as @code{mail}. To do this, use the following -commands (as root) after doing the make install. - -@example -chgrp mail movemail -chmod 2755 movemail -@end example - -Installation normally copies movemail from the build directory to an -installation directory which is usually under @file{/usr/local/lib}. -The installed copy of @code{movemail} is usually in the directory -@file{/usr/local/lib/emacs/VERSION/TARGET}. You must change the group -and mode of the installed copy; changing the group and mode of the build -directory copy is ineffective. -@end quotation - -@node Q4.0.10, Q4.0.11, Q4.0.9, Subsystems -@unnumberedsubsec Q4.0.10: How do I make VM stay in a single frame? - -John.@email{Cooper@@Eng.Sun.COM, John S Cooper} writes: - -@quotation -@lisp - ; Don't use multiple frames -(setq vm-frame-per-composition nil) -(setq vm-frame-per-folder nil) -(setq vm-frame-per-edit nil) -(setq vm-frame-per-summary nil) -@end lisp -@end quotation - -@node Q4.0.11, Q4.0.12, Q4.0.10, Subsystems -@unnumberedsubsec Q4.0.11: How do I make VM or mh-e display graphical smilies? -@c Changed June -For mh-e use the following: - -@lisp -(add-hook 'mh-show-mode-hook '(lambda () - (smiley-region (point-min) - (point-max)))) -@end lisp - -@email{bill@@carpenter.ORG, WJCarpenter} writes: -For VM use the following: -@lisp - (autoload 'smiley-region "smiley" nil t) - (add-hook 'vm-select-message-hook - '(lambda () - (smiley-region (point-min) - (point-max)))) -@end lisp - -For tm use the following: -@lisp -(autoload 'smiley-buffer "smiley" nil t) -(add-hook 'mime-viewer/plain-text-preview-hook 'smiley-buffer) -@end lisp - -@node Q4.0.12, Q4.1.1, Q4.0.11, Subsystems -@unnumberedsubsec Q4.0.12: Customization of VM not covered in the manual, or here. - -@email{boffi@@hp735.stru.polimi.it, giacomo boffi} writes: - -@quotation -The meta-answer is to look into the file @file{vm-vars.el}, in the vm -directory of the lisp library. - -@file{vm-vars.el} contains, initializes and carefully describes, with -examples of usage, the plethora of user options that @emph{fully} -control VM's behavior. - -Enter vm-vars, @code{forward-search} for toolbar, find the variables -that control the toolbar placement, appearance, existence, copy to your -@file{.emacs} or @file{.vm} and modify according to the detailed -instructions. - -The above also applies to all the various features of VM: search for -some keywords, maybe the first you conjure isn't appropriate, find the -appropriate variables, copy and experiment. -@end quotation - -@node Q4.1.1, Q4.1.2, Q4.0.12, Subsystems -@unnumberedsec 4.1: Web browsing with W3 -@unnumberedsubsec Q4.1.1: What is W3? - -W3 is an advanced graphical browser written in Emacs lisp that runs on -XEmacs. It has full support for cascaded style sheets, and more... - -It has a home web page at -@uref{http://www.cs.indiana.edu/elisp/w3/docs.html}. - -@node Q4.1.2, Q4.1.3, Q4.1.1, Subsystems -@unnumberedsubsec Q4.1.2: How do I run W3 from behind a firewall? - -There is a long, well-written, detailed section in the W3 manual that -describes how to do this. Look in the section entitled "Firewalls". - -@node Q4.1.3, Q4.2.1, Q4.1.2, Subsystems -@unnumberedsubsec Q4.1.3: Is it true that W3 supports style sheets and tables? - -Yes, and much more. W3, as distributed with the latest XEmacs is a -full-featured web browser. - -@node Q4.2.1, Q4.2.2, Q4.1.3, Subsystems -@unnumberedsec 4.2: Reading Netnews and Mail with Gnus -@unnumberedsubsec Q4.2.1: GNUS, (ding) Gnus, Gnus 5, September Gnus, Red Gnus, Quassia Gnus, argh! - -The Gnus numbering issues are not meant for mere mortals to know them. -If you feel you @emph{must} enter the muddy waters of Gnus, visit the -excellent FAQ, maintained by Justin Sheehy, at: - -@example -@uref{http://www.ccs.neu.edu/software/contrib/gnus/} -@end example - -See also Gnus home page -@example -@uref{http://www.gnus.org/} -@end example - -@node Q4.2.2, Q4.2.3, Q4.2.1, Subsystems -@unnumberedsubsec Q4.2.2: This question intentionally left blank. - -Obsolete question, left blank to avoid renumbering. - -@node Q4.2.3, Q4.2.4, Q4.2.2, Subsystems -@unnumberedsubsec Q4.2.3: How do I make Gnus stay within a single frame? - -The toolbar code to start Gnus opens the new frame---and it's a feature -rather than a bug. If you don't like it, but would still like to click -on the seemly icon, use the following code: - -@lisp -(defun toolbar-news () - (gnus)) -@end lisp - -It will redefine the callback function of the icon to just call -@code{gnus}, without all the fancy frame stuff. - -@node Q4.2.4, Q4.3.1, Q4.2.3, Subsystems -@unnumberedsubsec Q4.2.4: How do I customize the From: line? - -How do I change the @code{From:} line? I have set gnus-user-from-line -to -@example -Gail Gurman -@end example -@noindent , but XEmacs Gnus doesn't use -it. Instead it uses -@example -Gail Mara Gurman @email{gailg@@deall} -@end example -@noindent and then complains -that it's incorrect. Also, as you perhaps can see, my Message-ID is -screwy. How can I change that? - -@email{larsi@@ifi.uio.no, Lars Magne Ingebrigtsen} writes: - -@quotation -Set @code{user-mail-address} to @samp{gail.gurman@@sybase.com} or -@code{mail-host-address} to @samp{sybase.com}. -@end quotation - -@node Q4.3.1, Q4.3.2, Q4.2.4, Subsystems -@unnumberedsec 4.3: Other Mail & News -@unnumberedsubsec Q4.3.1: How can I read and/or compose MIME messages? -@c Changed June - -VM supports MIME natively. - -You probably want to use the Tools for MIME (tm). @xref{Q4.3.2} for -details. - -@email{trey@@cs.berkeley.edu, Trey Jackson} has an Emacs & MIME web page at -@iftex -@* -@end iftex -@uref{http://bmrc.berkeley.edu/~trey/emacs/mime.html}. - - -Another possibility is RMIME. You may find RMIME at -@iftex -@* -@end iftex -@uref{http://www.cinti.net/~rmoody/rmime/index.html}. - - -@node Q4.3.2, Q4.3.3, Q4.3.1, Subsystems -@unnumberedsubsec Q4.3.2: What is TM and where do I get it? - -TM stands for @dfn{Tools for MIME} and not Tiny MIME. TM integrates -with all major XEmacs packages like Gnus (all flavors), VM, MH-E, and -mailcrypt. It provides totally transparent and trouble-free MIME -support. When appropriate a message will be decoded in place in an -XEmacs buffer. - -TM now comes as a package with XEmacs 19.16 and XEmacs 20.2. - -TM was written by @email{morioka@@jaist.ac.jp, MORIOKA Tomohiko} and -@email{shuhei-k@@jaist.ac.jp, KOBAYASHI -Shuhei}. - -It is based on the work of @email{umerin@@mse.kyutech.ac.jp, UMEDA -Masanobu}, the original writer of GNUS. - -The following information is from the @file{README}: - -@dfn{tm} is a MIME package for GNU Emacs. -tm has following functions: - -@itemize @bullet -@item MIME style multilingual header. -@item MIME message viewer (mime/viewer-mode). -@item MIME message composer (mime/editor-mode). -@item MIME extenders for mh-e, GNUS, RMAIL and VM. -@end itemize - -tm is available from following anonymous ftp sites: -@itemize @bullet -@item @uref{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/mime/} (Japan). -@item @uref{ftp://ftp.nis.co.jp/pub/gnu/emacs-lisp/tm/} (Japan). -@c The host above is unknown. - -@item @uref{ftp://ftp.nisiq.net/pub/gnu/emacs-lisp/tm/} (US). -@item @uref{ftp://ftp.miranova.com/pub/gnus/jaist.ac.jp/} (US). -@item @uref{ftp://ftp.unicamp.br/pub/mail/mime/tm/} (Brasil). -@item @uref{ftp://ftp.th-darmstadt.de/pub/editors/GNU-Emacs/lisp/mime/} (Germany). -@item @uref{ftp://ftp.tnt.uni-hannover.de/pub/editors/xemacs/contrib/} (Germany). -@end itemize - -Don't let the installation procedure & instructions stop you from trying -this package out---it's much simpler than it looks, and once installed, -trivial to use. - -@node Q4.3.3, Q4.3.4, Q4.3.2, Subsystems -@unnumberedsubsec Q4.3.3: Why isn't this @code{movemail} program working? - -Ben Wing @email{ben@@666.com} writes: - -@quotation -It wasn't chown'ed/chmod'd correctly. -@end quotation - -@node Q4.3.4, Q4.3.5, Q4.3.3, Subsystems -@unnumberedsubsec Q4.3.4: Movemail is also distributed by Netscape? Can that cause problems? - -@email{steve@@altair.xemacs.org, Steve Baur} writes: - -@quotation -Yes. Always use the movemail installed with your XEmacs. Failure to do -so can result in lost mail. -@end quotation - -Please refer to @email{jwz@@netscape.com, Jamie Zawinski's} notes at -@iftex -@* -@end iftex -@uref{http://home.netscape.com/eng/mozilla/2.0/relnotes/demo/movemail.html}. -In particular, this document will show you how to make Netscape use the -version of movemail configured for your system by the person who built -XEmacs. - -@node Q4.3.5, Q4.4.1, Q4.3.4, Subsystems -@unnumberedsubsec Q4.3.5: Where do I find pstogif (required by tm)? - -pstogif is part of the latex2html package. - -@email{vroonhof@@math.ethz.ch, Jan Vroonhof} writes: - -latex2html is best found at the CTAN hosts and their mirrors -in -@iftex -@* -@end iftex -@file{tex-archive/support/latex2html}. - -CTAN hosts are: - -@itemize @bullet -@item @uref{ftp://ftp.tex.ac.uk/tex-archive/support/latex2html/}. -@item @uref{ftp://ftp.dante.de/tex-archive/support/latex2html/}. -@end itemize - -There is a good mirror at ftp.cdrom.com; -@iftex -@* -@end iftex -@uref{ftp://ftp.cdrom.com/pub/tex/ctan/support/latex2html/}. - -@node Q4.4.1, Q4.5.1, Q4.3.5, Subsystems -@unnumberedsec 4.4: Sparcworks, EOS, and WorkShop -@unnumberedsubsec Q4.4.1: What is SPARCworks, EOS, and WorkShop? - -@email{turner@@lanl.gov, John Turner} writes: - -@quotation -SPARCworks is SunSoft's development environment, comprising compilers -(C, C++, FORTRAN 77, Fortran 90, Ada, and Pascal), a debugger, and other -tools such as TeamWare (for configuration management), MakeTool, etc. -@end quotation - -See @uref{http://www.sun.com/software/Developer-products/} -for more info. - -EOS stands for "Era on SPARCworks", but I don't know what Era stands -for. - -EOS is the integration of XEmacs with the SPARCworks debugger. It -allows one to use an XEmacs frame to view code (complete with -fontification, etc.), set breakpoints, print variables, etc., while -using the SPARCworks debugger. It works very well and I use it all the -time. - -@email{cthomp@@xemacs.org, Chuck Thompson} writes: - -@quotation -Era stood for "Emacs Rewritten Again". It was what we were calling the -modified version of Lucid Emacs for Sun when I was dragged, er, allowed -to work on this wonderful editor. -@end quotation - -@email{martin@@xemacs.org, Martin Buchholz} writes: - -@quotation -EOS is being replaced with a new graphical development environment -called Sun WorkShop, which is currently (07/96) in Alpha Test. For more -details, check out -@iftex -@* -@end iftex -@uref{http://www.sun.com/software/Products/Developer-products/programs.html}. -@end quotation - -@node Q4.5.1, Q4.6.1, Q4.4.1, Subsystems -@unnumberedsec 4.5: Energize -@unnumberedsubsec Q4.5.1: What is/was Energize? - -@email{gray@@meteor.harlequin.com, David N Gray} writes: -@quotation -The files in @file{lisp/energize} are to enable Emacs to interface with -the "Energize Programming System", a C and C++ development environment, -which was a product of Lucid, Inc. Tragically, Lucid went out of -business in 1994, so although Energize is still a great system, if you -don't already have it, there isn't any way to get it now. (Unless you -happen to be in Japan; INS Engineering may still be selling it there. -Tartan bought the rights to sell it in the rest of the world, but never -did so.) -@end quotation - -@node Q4.6.1, Q4.7.1, Q4.5.1, Subsystems -@unnumberedsec 4.6: Infodock -@unnumberedsubsec Q4.6.1: What is Infodock? - -InfoDock is an integrated productivity toolset, mainly aimed at -technical people. It is developed and supported by InfoDock -Associates, a firm that offers custom support and development -for InfoDock, XEmacs and GNU Emacs. ( @uref{http://www.infodock.com}, -@email{info@@infodock.com}, +1 408 243 3300). - -InfoDock is built atop the XEmacs variant of GNU Emacs and so has all of -the power of Emacs, but with an easier to use and more comprehensive -menu-based user interface. The bottom portion of this text describes -how it differs from XEmacs and GNU Emacs from the Free Software -Foundation. - -InfoDock is aimed at people who want a free, turn-key productivity -environment. Although InfoDock is customizable, it is not intended for -people who like basic versions of Emacs which need to be customized -extensively for local use; standard Emacs distributions are better for -such uses. InfoDock is for those people who want a complete, -pre-customized environment in one package, which they need not touch -more than once or twice a year to update to new revisions. - -InfoDock is pre-built for SPARC SunOS/Solaris systems, PA-RISC HP-UX, -and Intel Linux systems. It is intended for use on a color display, -although most features will work on monochrome monitors. Simply unpack -InfoDock according to the instructions in the ID-INSTALL file and you -are ready to run. - -The InfoDock Manual is concise, yet sufficient as a user guide for users -who have never used an Emacs-type editor before. For users who are -already familiar with Emacs, it supplements the information in the GNU -Emacs Manual. - -InfoDock menus are much more extensive and more mature than standard -Emacs menus. Each menu offers a @samp{Manual} item which displays -documentation associated with the menu's functions. - -@noindent -Four types of menubars are provided: -@enumerate -@item -An extensive menubar providing access to global InfoDock commands. -@item -Mode-specific menubars tailored to the current major mode. -@item -A simple menubar for basic editing to help novices get started with InfoDock. -@item -The standard XEmacs menubar. -@end enumerate - -Most modes also include mode-specific popup menus. Additionally, region and -rectangle popup menus are included. - -@samp{Hyperbole}, the everyday information manager, is a core part of -InfoDock. This provides context-sensitive mouse keys, a rolodex-type -contact manager, programmable hypertext buttons, and an autonumbered -outliner with embedded hyperlink anchors. - -The @samp{OO-Browser}, a multi-language object-oriented code browser, is a -standard part of InfoDock. - -InfoDock saves a more extensive set of user options than other Emacs -versions. - -InfoDock inserts a useful file header in many file types, showing the -author, summary, and last modification time of each file. A summary -program can then be used to summarize all of the files in a directory, -for easy MANIFEST file creation. - -Your working set of buffers is automatically saved and restored (if you -answer yes to a prompt) between InfoDock sessions. - -Refined color choices for code highlighting are provided for both dark and -light background display frames. - -The @kbd{C-z} key prefix performs frame-based commands which parallel the -@kbd{C-x} key prefix for window-based commands. - -The Smart Menu system is included for producing command menus on dumb -terminals. - -Lisp libraries are better categorized according to function. - -Extensions and improvements to many areas of Emacs are included, such as: -paragraph filling, mail reading with Rmail, shell handling, outlining, code -highlighting and browsing, and man page browsing. - -InfoDock questions, answers and discussion should go to the mail list -@iftex -@* -@end iftex -@email{infodock@@infodock.com}. Use -@email{infodock-request@@infodock.com} to be added or removed from the -list. Always include your InfoDock version number when sending help -requests. - -InfoDock is available across the Internet via anonymous FTP. To get -it, first move to a directory into which you want the InfoDock archive -files placed. We will call this . - -@example - cd -@end example - -Ftp to ftp.xemacs.org (Internet Host ID = 128.174.252.16): - -@example - prompt> ftp ftp.xemacs.org -@end example - -Login as @samp{anonymous} with your own @@ as a password. - -@example - Name (ftp.xemacs.org): anonymous - 331 Guest login ok, send your complete e-mail address as password. - Password: -@@ - 230 Guest login ok, access restrictions apply. -@end example - -Move to the location of the InfoDock archives: - -@example - ftp> cd pub/infodock -@end example - -Set your transfer mode to binary: - -@example - ftp> bin - 200 Type set to I. -@end example - -Turn off prompting: - -@example - ftp> prompt - Interactive mode off. -@end example - -Retrieve the InfoDock archives that you want, either by using a -@samp{get } for each file you want or by using the following to -get a complete distribution, including all binaries: - -@example - ftp> mget ID-INSTALL - ftp> mget id-* -@end example - -Close the FTP connection: - -@example - ftp> quit - 221 Goodbye. -@end example - -Read the @file{ID-INSTALL} file which you just retrieved for -step-by-step installation instructions. - -@node Q4.7.1, Q4.7.2, Q4.6.1, Subsystems -@unnumberedsec 4.7: Other Unbundled Packages -@unnumberedsubsec Q4.7.1: What is AUC TeX? Where do you get it? - -AUC TeX is a package written by @email{abraham@@dina.kvl.dk, Per Abrahamsen}. -Starting with XEmacs 19.16, AUC TeX is bundled with XEmacs. The -following information is from the @file{README} and website. - -AUC TeX is an extensible package that supports writing and formatting -TeX files for most variants of GNU Emacs. Many different macro packages -are supported, including AMS TeX, LaTeX, and TeXinfo. - -The most recent version is always available by ftp at -@iftex -@* -@end iftex -@uref{ftp://sunsite.auc.dk/packages/auctex/auctex.tar.gz}. - -In case you don't have access to anonymous ftp, you can get it by an -email request to @email{ftpmail@@decwrl.dec.com}. - -WWW users may want to check out the AUC TeX page at -@iftex -@* -@end iftex -@uref{http://sunsite.auc.dk/auctex/}. - -@node Q4.7.2, Q4.7.3, Q4.7.1, Subsystems -@unnumberedsubsec Q4.7.2: Are there any Emacs Lisp Spreadsheets? - -Yes. Check out @dfn{dismal} (which stands for Dis' Mode Ain't Lotus) at -@iftex -@* -@end iftex -@uref{ftp://cs.nyu.edu/pub/local/fox/dismal/}. - -@node Q4.7.3, Q4.7.4, Q4.7.2, Subsystems -@unnumberedsubsec Q4.7.3: Byte compiling AUC TeX on XEmacs 19.14. - -@email{bruncott@@dormeur.inria.fr, Georges Brun-Cottan} writes: - -@quotation -When byte compiling auctex-9.4g, you must use the command: - -@example -xemacs -batch -l lpath.el -@end example -@end quotation - -@node Q4.7.4, Q4.7.5, Q4.7.3, Subsystems -@unnumberedsubsec Q4.7.4: Problems installing AUC TeX. - -@email{vroonhof@@math.ethz.ch, Jan Vroonhof} writes: - -@quotation -AUC TeX works fine on both stock Emacs and XEmacs has been doing so for -a very very long time. This is mostly due to the work of -@email{abraham@@dina.kvl.dk, Per Abrahamsen} (clap clap) in particular his @file{easymenu} -package. Which leads to what is probably the problem... -@end quotation - -Most problems with AUC TeX are one of two things: - -@itemize @bullet -@item -The TeX-lisp-directory in @file{tex-site.el} and the makefile don't -match. - -Fix: make sure you configure AUC TeX properly @strong{before} installing. - -@item -You have an old version of easymenu.el in your path. - -Fix: use @code{locate-library} and remove old versions to make sure it -@strong{only} finds the one that came with XEmacs. -@end itemize - - -@node Q4.7.5, Q4.7.6, Q4.7.4, Subsystems -@unnumberedsubsec Q4.7.5: Is there a reason for an Emacs package not to be included in XEmacs? - -The reason for an Emacs package not to be included in XEmacs is -usually one or more of the following: - -@enumerate -@item -The package has not been ported to XEmacs. This will typically happen -when it uses GNU-Emacs-specific features, which make it fail under -XEmacs. - -Porting a package to XEmacs can range from a trivial amount of change to -a partial or full rewrite. Fortunately, the authors of modern packages -usually choose to support both Emacsen themselves. - -@item -The package has been decided not to be appropriate for XEmacs. It may -have an equivalent or better replacement within XEmacs, in which case -the developers may choose not to burden themselves with supporting an -additional package. - -Each package bundled with XEmacs means more work for the maintainers, -whether they want it or not. If you are ready to take over the -maintenance responsibilities for the package you port, be sure to say -so -- we will more likely include it. - -@item -The package simply hasn't been noted by the XEmacs development. If -that's the case, the messages like yours are very useful for attracting -our attention. - -@item -The package was noted by the developers, but they simply haven't yet -gotten around to including/porting it. Wait for the next release or, -even better, offer your help. It will be gladly accepted and -appreciated. -@end enumerate - -@node Q4.7.6, , Q4.7.5, Subsystems -@unnumberedsubsec Q4.7.5: Is there a MatLab mode? -@c New -Is there any way I can get syntax highlighting for MatLab .m files? -Can I "teach" emacs what words are MatLab commands, comments, etc. ? - -@email{elsner@@mathematik.tu-chemnitz.de, Ulrich Elsner} writes: -@quotation -One way to do this (and much more) is by using the -@iftex -@* -@end iftex -@uref{ftp://ftp.mathworks.com/pub/contrib/v5/tools/matlab.el, matlab mode}. - -Instructions on how to install this mode are included in this file. -@end quotation - - -@node Miscellaneous, Current Events, Subsystems, Top -@unnumbered 5 The Miscellaneous Stuff - -This is part 5 of the XEmacs Frequently Asked Questions list. This -section is devoted to anything that doesn't fit neatly into the other -sections. - -@menu -Major & Minor Modes: -* Q5.0.1:: How can I do source code highlighting using font-lock? -* Q5.0.2:: I do not like cc-mode. How do I use the old c-mode? -* Q5.0.3:: How do I get @samp{More} Syntax Highlighting on by default? -* Q5.0.4:: How can I enable auto-indent? -* Q5.0.5:: How can I get XEmacs to come up in text/auto-fill mode by default? -* Q5.0.6:: How do I start up a second shell buffer? -* Q5.0.7:: Telnet from shell filters too much. -* Q5.0.8:: Why does edt emulation not work? -* Q5.0.9:: How can I emulate VI and use it as my default mode? -* Q5.0.10:: [This question intentionally left blank] -* Q5.0.11:: Filladapt doesn't work in 19.15? -* Q5.0.12:: How do I disable gnuserv from opening a new frame? -* Q5.0.13:: How do I start gnuserv so that each subsequent XEmacs is a client? -* Q5.0.14:: Strange things are happening in Shell Mode. -* Q5.0.15:: Where do I get the latest CC Mode? -* Q5.0.16:: I find auto-show-mode disconcerting. How do I turn it off? -* Q5.0.17:: How can I get two instances of info? -* Q5.0.18:: I upgraded to XEmacs 19.14 and gnuserv stopped working -* Q5.0.19:: Is there something better than LaTeX mode? -* Q5.0.20:: Is there a way to start a new XEmacs if there's no gnuserv running, and otherwise use gnuclient? - -Emacs Lisp Programming Techniques: -* Q5.1.1:: The difference in key sequences between XEmacs and GNU Emacs? -* Q5.1.2:: Can I generate "fake" keyboard events? -* Q5.1.3:: Could you explain @code{read-kbd-macro} in more detail? -* Q5.1.4:: What is the performance hit of @code{let}? -* Q5.1.5:: What is the recommended use of @code{setq}? -* Q5.1.6:: What is the typical misuse of @code{setq}? -* Q5.1.7:: I like the the @code{do} form of cl, does it slow things down? -* Q5.1.8:: I like recursion, does it slow things down? -* Q5.1.9:: How do I put a glyph as annotation in a buffer? -* Q5.1.10:: @code{map-extents} won't traverse all of my extents! -* Q5.1.11:: My elisp program is horribly slow. Is there an easy way to find out where it spends time? - -Sound: -* Q5.2.1:: How do I turn off the sound? -* Q5.2.2:: How do I get funky sounds instead of a boring beep? -* Q5.2.3:: What's NAS, how do I get it? -* Q5.2.4:: Sunsite sounds don't play. - -Miscellaneous: -* Q5.3.1:: How do you make XEmacs indent CL if-clauses correctly? -* Q5.3.2:: Fontifying hangs when editing a postscript file. -* Q5.3.3:: How can I print WYSIWYG a font-locked buffer? -* Q5.3.4:: Getting @kbd{M-x lpr} to work with postscript printer. -* Q5.3.5:: How do I specify the paths that XEmacs uses for finding files? -* Q5.3.6:: [This question intentionally left blank] -* Q5.3.7:: Can I have the end of the buffer delimited in some way? -* Q5.3.8:: How do I insert today's date into a buffer? -* Q5.3.9:: Are only certain syntactic character classes available for abbrevs? -* Q5.3.10:: How can I get those oh-so-neat X-Face lines? -* Q5.3.11:: How do I add new Info directories? -* Q5.3.12:: What do I need to change to make printing work? -@end menu - -@node Q5.0.1, Q5.0.2, Miscellaneous, Miscellaneous -@unnumberedsec 5.0: Major & Minor Modes -@unnumberedsubsec Q5.0.1: How can I do source code highlighting using font-lock? - -For most modes, font-lock is already set up and just needs to be turned -on. This can be done by @kbd{M-x font-lock-mode}, or by having XEmacs -automatically start it by adding lines like: - -@lisp -(add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) -(add-hook 'dired-mode-hook 'turn-on-font-lock) -@end lisp - -to your @file{.emacs}. See the file @file{etc/sample.emacs} for more -examples. - -See also @code{Syntax Highlighting} from the @code{Options} menu. -Remember to save options. - -@node Q5.0.2, Q5.0.3, Q5.0.1, Miscellaneous -@unnumberedsubsec Q5.0.2: I do not like cc-mode. How do I use the old c-mode? - -Well, first off, consider if you really want to do this. cc-mode is -much more powerful than the old c-mode. If you're having trouble -getting your old offsets to work, try using @code{c-set-offset} instead. -You might also consider using the package @code{cc-compat}. - -But, if you still insist, add the following lines to your @file{.emacs}: - -@lisp -(fmakunbound 'c-mode) -(makunbound 'c-mode-map) -(fmakunbound 'c++-mode) -(makunbound 'c++-mode-map) -(makunbound 'c-style-alist) -(load-library "old-c-mode") -(load-library "old-c++-mode") -@end lisp - -This must be done before any other reference is made to either c-mode or -c++-mode. - -@node Q5.0.3, Q5.0.4, Q5.0.2, Miscellaneous -@unnumberedsubsec Q5.0.3: How do I get @samp{More} Syntax Highlighting on by default? - -Use the following code in your @file{.emacs}: - -@lisp -(setq-default font-lock-maximum-decoration t) -@end lisp - -In versions of XEmacs prior to 19.14, you had to use a kludgy solution -like this: - -@lisp -(setq c-font-lock-keywords c-font-lock-keywords-2 - c++-font-lock-keywords c++-font-lock-keywords-2 - lisp-font-lock-keywords lisp-font-lock-keywords-2) -@end lisp - -It will work for C, C++ and Lisp. - -See also @code{Syntax Highlighting} from the @code{Options} menu. -Remember to save options. - -@node Q5.0.4, Q5.0.5, Q5.0.3, Miscellaneous -@unnumberedsubsec Q5.0.4: How can I enable auto-indent? - -Put the following line in your @file{.emacs}: - -@lisp -(setq indent-line-function 'indent-relative-maybe) -@end lisp - -If you want to get fancy, try the @code{filladapt} package available -standard with XEmacs. Put this into your @file{.emacs}: - -@lisp -(require 'filladapt) -(add-hook 'text-mode-hook 'turn-on-filladapt-mode) -;;; and others ... -@end lisp - -You can customize filling and adaptive filling with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->->Editing->Fill->Fill...} -or type @kbd{M-x customize @key{RET} fill @key{RET}}. - -Note that well-behaving text-lookalike modes will run -@code{text-mode-hook} by default (e.g. that's what Message does). For -the nasty ones, you'll have to provide the @code{add-hook}s yourself. - -Please note that the @code{fa-extras} package is no longer useful. - -@node Q5.0.5, Q5.0.6, Q5.0.4, Miscellaneous -@unnumberedsubsec Q5.0.5: How can I get XEmacs to come up in text/auto-fill mode by default? - -Try the following lisp in your @file{.emacs}: - -@lisp -(setq default-major-mode 'text-mode) -(setq text-mode-hook 'turn-on-auto-fill) -@end lisp - -@strong{WARNING}: note that changing the value of -@code{default-major-mode} from @code{fundamental-mode} can break a large -amount of built-in code that expects newly created buffers to be in -@code{fundamental-mode}. (Changing from @code{fundamental-mode} to -@code{text-mode} might not wreak too much havoc, but changing to -something more exotic like a lisp-mode would break many Emacs packages). - -Note that Emacs by default starts up in buffer @code{*scratch*} in -@code{initial-major-mode}, which defaults to -@code{lisp-interaction-mode}. Thus adding the following form to your -Emacs init file will cause the initial @code{*scratch*} buffer to be put -into auto-fill'ed @code{text-mode}: - -@lisp -(setq initial-major-mode - (lambda () - (text-mode) - (turn-on-auto-fill))) -@end lisp - -Note that after your init file is loaded, if -@code{inhibit-startup-message} is @code{nil} (the default) and the -startup buffer is @code{*scratch*} then the startup message will be -inserted into @code{*scratch*}; it will be removed after a timeout by -erasing the entire @code{*scratch*} buffer. Keep in mind this default -usage of @code{*scratch*} if you desire any prior manipulation of -@code{*scratch*} from within your Emacs init file. In particular, -anything you insert into @code{*scratch*} from your init file will be -later erased. Also, if you change the mode of the @code{*scratch*} -buffer, be sure that this will not interfere with possible later -insertion of the startup message (e.g. if you put @code{*scratch*} into -a nonstandard mode that has automatic font lock rules, then the startup -message might get fontified in a strange foreign manner, e.g. as code in -some programming language). - -@node Q5.0.6, Q5.0.7, Q5.0.5, Miscellaneous -@unnumberedsubsec Q5.0.6: How do I start up a second shell buffer? - -In the @code{*shell*} buffer: - -@lisp -M-x rename-buffer @key{RET} *shell-1* @key{RET} -M-x shell RET -@end lisp - -This will then start a second shell. The key is that no buffer named -@samp{*shell*} can exist. It might be preferable to use @kbd{M-x -rename-uniquely} to rename the @code{*shell*} buffer instead of @kbd{M-x -rename-buffer}. - -@node Q5.0.7, Q5.0.8, Q5.0.6, Miscellaneous -@unnumberedsubsec Q5.0.7: Telnet from shell filters too much - -I'm using the Emacs @kbd{M-x shell} function, and I would like to invoke -and use a telnet session within it. Everything works fine except that -now all @samp{^M}'s are filtered out by Emacs. Fixes? - -Use @kbd{M-x rsh} or @kbd{M-x telnet} to open remote sessions rather -than doing rsh or telnet within the local shell buffer. Starting with -XEmacs-20.3 you can also use @kbd{M-x ssh} to open secure remote session -if you have @code{ssh} installed. - -@node Q5.0.8, Q5.0.9, Q5.0.7, Miscellaneous -@unnumberedsubsec Q5.0.8: Why does edt emulation not work? - -We don't know, but you can use tpu-edt emulation instead, which works -fine and is a little fancier than the standard edt emulation. To do -this, add the following line to your @file{.emacs}: - -@lisp -(tpu-edt) -@end lisp - -If you don't want it to replace @kbd{C-h} with an edt-style help menu -add this as well: - -@lisp -(global-set-key [(control h)] 'help-for-help) -@end lisp - -@node Q5.0.9, Q5.0.10, Q5.0.8, Miscellaneous -@unnumberedsubsec Q5.0.9: How can I emulate VI and use it as my default mode? - -Our recommended VI emulator is viper. To make viper-mode the default, -add this to your @file{.emacs}: - -@lisp -(viper-mode) -@end lisp - -@email{kifer@@CS.SunySB.EDU, Michael Kifer} writes: - -@quotation -This should be added as close to the top of @file{.emacs} as you can get -it, otherwise some minor modes may not get viper-ized. -@end quotation - -@node Q5.0.10, Q5.0.11, Q5.0.9, Miscellaneous -@unnumberedsubsec Q5.0.10: [This question intentionally left blank] - -Obsolete question, left blank to avoid renumbering - -@node Q5.0.11, Q5.0.12, Q5.0.10, Miscellaneous -@unnumberedsubsec Q5.0.11: Filladapt doesn't work in 19.15 - -Filladapt 2.x is included in 19.15. In it filladapt is now a minor -mode and minor modes are traditionally off by default. The following -added to your @file{.emacs} will turn it on for all buffers: - -@lisp -(setq-default filladapt-mode t) -@end lisp - -Use @code{turn-on-filladapt-mode} to turn Filladapt on in particular -major modes, like this: - -@lisp -(add-hook 'text-mode-hook 'turn-on-filladapt-mode) -@end lisp - -@node Q5.0.12, Q5.0.13, Q5.0.11, Miscellaneous -@unnumberedsubsec Q5.0.12: How do I disable gnuserv from opening a new frame? - -If you set the @code{gnuserv-frame} variable to the frame that should be -used to display buffers that are pulled up, a new frame will not be -created. For example, you could put - -@lisp -(setq gnuserv-frame (selected-frame)) -@end lisp - -early on in your @file{.emacs}, to ensure that the first frame created -is the one used for your gnuserv buffers. - -Starting in 19.15, there is an option to set the gnuserv target to -the current frame. See -@code{Options->"Other Window" Location->Make current frame gnuserv target} - -Starting with XEmacs-20.3 you can also change this with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Gnuserv->Gnuserv Frame...} or type -@kbd{M-x customize @key{RET} gnuserv @key{RET}}. - - -@node Q5.0.13, Q5.0.14, Q5.0.12, Miscellaneous -@unnumberedsubsec Q5.0.13: How do I start gnuserv so that each subsequent XEmacs is a client? - -Put the following in your @file{.emacs} file to start the server: - -@lisp -(gnuserv-start) -@end lisp - -Start your first XEmacs as usual. After that, you can do: - -@example -gnuclient randomfilename -@end example - -from the command line to get your existing XEmacs process to open a new -frame and visit randomfilename in that window. When you're done editing -randomfilename, hit @kbd{C-x #} to kill the buffer and get rid of the -frame. - -See also man page of gnuclient. - -@node Q5.0.14, Q5.0.15, Q5.0.13, Miscellaneous -@unnumberedsubsec Q5.0.14: Strange things are happening in Shell Mode. - -Sometimes (i.e. it's not repeatable, and I can't work out why it -happens) when I'm typing into shell mode, I hit return and only a -portion of the command is given to the shell, and a blank prompt is -returned. If I hit return again, the rest of the previous command is -given to the shell. - -@email{martin@@xemacs.org, Martin Buchholz} writes: - -@quotation -There is a known problem with interaction between @code{csh} and the -@code{filec} option and XEmacs. You should add the following to your -@file{.cshrc}: - -@example -if ( "$TERM" == emacs || "$TERM" == unknown ) unset filec -@end example -@end quotation - -@node Q5.0.15, Q5.0.16, Q5.0.14, Miscellaneous -@unnumberedsubsec Q5.0.15: Where do I get the latest CC Mode? - -@email{bwarsaw@@cnri.reston.va.us, Barry A. Warsaw} writes: - -@quotation -This can be had from @uref{http://www.python.org/ftp/emacs/}. -@end quotation - -@node Q5.0.16, Q5.0.17, Q5.0.15, Miscellaneous -@unnumberedsubsec Q5.0.16: I find auto-show-mode disconcerting. How do I turn it off? - -@code{auto-show-mode} controls whether or not a horizontal scrollbar -magically appears when a line is too long to be displayed. This is -enabled by default. To turn it off, put the following in your -@file{.emacs}: - -@lisp -(setq auto-show-mode nil) -(setq-default auto-show-mode nil) -@end lisp - -@node Q5.0.17, Q5.0.18, Q5.0.16, Miscellaneous -@unnumberedsubsec Q5.0.17: How can I get two instances of info? - -You can't. The @code{info} package does not provide for multiple info buffers. - -@node Q5.0.18, Q5.0.19, Q5.0.17, Miscellaneous -@unnumberedsubsec Q5.0.18: I upgraded to XEmacs 19.14 and gnuserv stopped working. - -@email{daku@@nortel.ca, Mark Daku} writes: - -@quotation -It turns out I was using an older version of gnuserv. The installation -didn't put the binary into the public bin directory. It put it in -@iftex -@* -@end iftex -@file{lib/xemacs-19.14/hppa1.1-hp-hpux9.05/gnuserv}. Shouldn't it have -been put in @file{bin/hppa1.1-hp-hpux9.0}? -@end quotation - -@node Q5.0.19, Q5.0.20, Q5.0.18, Miscellaneous -@unnumberedsubsec Q5.0.19: Is there something better than LaTeX mode? - -@email{dak@@fsnif.neuroinformatik.ruhr-uni-bochum.de, David Kastrup} writes: - -@quotation -The standard TeX modes leave much to be desired, and are somewhat -leniently maintained. Serious TeX users use AUC TeX (@xref{Q4.7.1}). -@end quotation - -@node Q5.0.20, Q5.1.1, Q5.0.19, Miscellaneous -@unnumberedsubsec Q5.0.20: Is there a way to start a new XEmacs if there's no gnuserv running, and otherwise use gnuclient? - -@email{vroonhof@@math.ethz.ch, Jan Vroonhof} writes: -@quotation -Here is one of the solutions, we have this in a script called -@file{etc/editclient.sh}. -@example - #!/bin/sh - if gnuclient -batch -eval t >/dev/null 2>&1 - then - exec gnuclient $@{1+"$@@"@} - else - xemacs -unmapped -f gnuserv-start & - until gnuclient -batch -eval t >/dev/null 2>&1 - do - sleep 1 - done - exec gnuclient $@{1+"$@@"@} - fi -@end example - -Note that there is a known problem when running XEmacs and 'gnuclient --nw' on the same TTY. -@end quotation - -@node Q5.1.1, Q5.1.2, Q5.0.20, Miscellaneous -@unnumberedsec 5.1: Emacs Lisp Programming Techniques -@unnumberedsubsec Q5.1.1: What is the difference in key sequences between XEmacs and GNU Emacs? - -@email{clerik@@naggum.no, Erik Naggum} writes; - -@quotation -Emacs has a legacy of keyboards that produced characters with modifier -bits, and therefore map a variety of input systems into this scheme even -today. XEmacs is instead optimized for X events. This causes an -incompatibility in the way key sequences are specified, but both Emacs -and XEmacs will accept a key sequence as a vector of lists of modifiers -that ends with a key, e.g., to bind @kbd{M-C-a}, you would say -@code{[(meta control a)]} in both Emacsen. XEmacs has an abbreviated -form for a single key, just (meta control a). Emacs has an abbreviated -form for the Control and the Meta modifiers to string-characters (the -ASCII characters), as in @samp{\M-\C-a}. XEmacs users need to be aware -that the abbreviated form works only for one-character key sequences, -while Emacs users need to be aware that the string-character is rather -limited. Specifically, the string-character can accommodate only 256 -different values, 128 of which have the Meta modifier and 128 of which -have not. In each of these blocks, only 32 characters have the Control -modifier. Whereas @code{[(meta control A)]} differs from @code{[(meta -control a)]} because the case differs, @samp{\M-\C-a} and @samp{\M-\C-A} -do not. Programmers are advised to use the full common form, both -because it is more readable and less error-prone, and because it is -supported by both Emacsen. -@end quotation - -Another (even safer) way to be sure of the key-sequences is to use the -@code{read-kbd-macro} function, which takes a string like @samp{C-c -}, and converts it to the internal key representation of the Emacs -you use. The function is available both on XEmacs and GNU Emacs. - -@node Q5.1.2, Q5.1.3, Q5.1.1, Miscellaneous -@unnumberedsubsec Q5.1.2: Can I generate "fake" keyboard events? - -I wonder if there is an interactive function that can generate -@dfn{fake} keyboard events. This way, I could simply map them inside -XEmacs. - -This seems to work: - -@lisp -(defun cg--generate-char-event (ch) - "Generate an event, as if ch has been typed" - (dispatch-event (character-to-event ch))) - -;; Backspace and Delete stuff -(global-set-key [backspace] - (lambda () (interactive) (cg--generate-char-event 127))) -(global-set-key [unknown_keysym_0x4] - (lambda () (interactive) (cg--generate-char-event 4))) -@end lisp - -@node Q5.1.3, Q5.1.4, Q5.1.2, Miscellaneous -@unnumberedsubsec Q5.1.3: Could you explain @code{read-kbd-macro} in more detail? - -The @code{read-kbd-macro} function returns the internal Emacs -representation of a human-readable string (which is its argument). -Thus: - -@lisp -(read-kbd-macro "C-c C-a") -@result{} [(control ?c) (control ?a)] - -(read-kbd-macro "C-c C-. ") -@result{} [(control ?c) (control ?.) up] -@end lisp - -In GNU Emacs the same forms will be evaluated to what GNU Emacs -understands internally---the sequences @code{"\C-x\C-c"} and @code{[3 -67108910 up]}, respectively. - -The exact @dfn{human-readable} syntax is defined in the docstring of -@code{edmacro-mode}. I'll repeat it here, for completeness. - -@quotation -Format of keyboard macros during editing: - -Text is divided into @dfn{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 -@kbd{foo @key{SPC} bar @key{RET}}. - -@itemize @bullet -@item -The special words @kbd{RET}, @kbd{SPC}, @kbd{TAB}, @kbd{DEL}, @kbd{LFD}, -@kbd{ESC}, and @kbd{NUL} represent special control characters. The -words must be written in uppercase. - -@item -A word in angle brackets, e.g., @code{}, @code{}, or -@code{}, represents a function key. (Note that in the standard -configuration, the function key @code{} and the control key -@key{RET} are synonymous.) You can use angle brackets on the words -@key{RET}, @key{SPC}, etc., but they are not required there. - -@item -Keys can be written by their @sc{ascii} code, using a backslash followed -by up to six octal digits. This is the only way to represent keys with -codes above \377. - -@item -One or more prefixes @kbd{M-} (meta), @kbd{C-} (control), @kbd{S-} -(shift), @kbd{A-} (alt), @kbd{H-} (hyper), and @kbd{s-} (super) may -precede a character or key notation. For function keys, the prefixes -may go inside or outside of the brackets: @code{C-} @equiv{} -@code{}. The prefixes may be written in any order: @kbd{M-C-x} -@equiv{} @kbd{C-M-x}. - -Prefixes are not allowed on multi-key words, e.g., @kbd{C-abc}, except -that the Meta prefix is allowed on a sequence of digits and optional -minus sign: @kbd{M--123} @equiv{} @kbd{M-- M-1 M-2 M-3}. - -@item -The @code{^} notation for control characters also works: @kbd{^M} -@equiv{} @kbd{C-m}. - -@item -Double angle brackets enclose command names: @code{<>} is -shorthand for @kbd{M-x next-line @key{RET}}. - -@item -Finally, @code{REM} or @code{;;} causes the rest of the line to be -ignored as a comment. -@end itemize - -Any word may be prefixed by a multiplier in the form of a decimal number -and @code{*}: @code{3*} @equiv{} @code{ }, -and @code{10*foo} @equiv{} -@iftex -@* -@end iftex -@code{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: @code{; ; ;} is a keyboard macro with three semicolons, -but @code{;;;} is a comment. Likewise, @code{\ 1 2 3} is four keys but -@code{\123} is a single key written in octal, and @code{< right >} is -seven keys but @code{} is a single function key. When in doubt, -use whitespace. -@end quotation - -@node Q5.1.4, Q5.1.5, Q5.1.3, Miscellaneous -@unnumberedsubsec Q5.1.4: What is the performance hit of @code{let}? - -In most cases, not noticeable. Besides, there's no avoiding -@code{let}---you have to bind your local variables, after all. Some -pose a question whether to nest @code{let}s, or use one @code{let} per -function. I think because of clarity and maintenance (and possible -future implementation), @code{let}-s should be used (nested) in a way to -provide the clearest code. - -@node Q5.1.5, Q5.1.6, Q5.1.4, Miscellaneous -@unnumberedsubsec Q5.1.5: What is the recommended use of @code{setq}? - -@itemize @bullet -@item Global variables - -You will typically @code{defvar} your global variable to a default -value, and use @code{setq} to set it later. - -It is never a good practice to @code{setq} user variables (like -@code{case-fold-search}, etc.), as it ignores the user's choice -unconditionally. Note that @code{defvar} doesn't change the value of a -variable if it was bound previously. If you wish to change a -user-variable temporarily, use @code{let}: - -@lisp -(let ((case-fold-search nil)) - ... ; code with searches that must be case-sensitive - ...) -@end lisp - -You will notice the user-variables by their docstrings beginning with an -asterisk (a convention). - -@item Local variables - -Bind them with @code{let}, which will unbind them (or restore their -previous value, if they were bound) after exiting from the @code{let} -form. Change the value of local variables with @code{setq} or whatever -you like (e.g. @code{incf}, @code{setf} and such). The @code{let} form -can even return one of its local variables. - -Typical usage: - -@lisp -;; iterate through the elements of the list returned by -;; `hairy-function-that-returns-list' -(let ((l (hairy-function-that-returns-list))) - (while l - ... do something with (car l) ... - (setq l (cdr l)))) -@end lisp - -Another typical usage includes building a value simply to work with it. - -@lisp -;; Build the mode keymap out of the key-translation-alist -(let ((inbox (file-truename (expand-file-name box))) - (i 0)) - ... code dealing with inbox ... - inbox) -@end lisp - -This piece of code uses the local variable @code{inbox}, which becomes -unbound (or regains old value) after exiting the form. The form also -returns the value of @code{inbox}, which can be reused, for instance: - -@lisp -(setq foo-processed-inbox - (let .....)) -@end lisp -@end itemize - -@node Q5.1.6, Q5.1.7, Q5.1.5, Miscellaneous -@unnumberedsubsec Q5.1.6: What is the typical misuse of @code{setq} ? - -A typical misuse is probably @code{setq}ing a variable that was meant to -be local. Such a variable will remain bound forever, never to be -garbage-collected. For example, the code doing: - -@lisp -(defun my-function (whatever) - (setq a nil) - ... build a large list ... - ... and exit ...) -@end lisp - -does a bad thing, as @code{a} will keep consuming memory, never to be -unbound. The correct thing is to do it like this: - -@lisp -(defun my-function (whatever) - (let (a) ; default initialization is to nil - ... build a large list ... - ... and exit, unbinding `a' in the process ...) -@end lisp - -Not only is this prettier syntactically, but it makes it possible for -Emacs to garbage-collect the objects which @code{a} used to reference. - -Note that even global variables should not be @code{setq}ed without -@code{defvar}ing them first, because the byte-compiler issues warnings. -The reason for the warning is the following: - -@lisp -(defun flurgoze nil) ; ok, global internal variable -... - -(setq flurghoze t) ; ops! a typo, but semantically correct. - ; however, the byte-compiler warns. - -While compiling toplevel forms: -** assignment to free variable flurghoze -@end lisp - -@node Q5.1.7, Q5.1.8, Q5.1.6, Miscellaneous -@unnumberedsubsec Q5.1.7: I like the the @code{do} form of cl, does it slow things down? - -It shouldn't. Here is what Dave Gillespie has to say about cl.el -performance: - -@quotation -Many of the advanced features of this package, such as @code{defun*}, -@code{loop}, and @code{setf}, are implemented as Lisp macros. In -byte-compiled code, these complex notations will be expanded into -equivalent Lisp code which is simple and efficient. For example, the -forms - -@lisp -(incf i n) -(push x (car p)) -@end lisp - -are expanded at compile-time to the Lisp forms - -@lisp -(setq i (+ i n)) -(setcar p (cons x (car p))) -@end lisp - -which are the most efficient ways of doing these respective operations -in Lisp. Thus, there is no performance penalty for using the more -readable @code{incf} and @code{push} forms in your compiled code. - -@emph{Interpreted} code, on the other hand, must expand these macros -every time they are executed. For this reason it is strongly -recommended that code making heavy use of macros be compiled. (The -features labelled @dfn{Special Form} instead of @dfn{Function} in this -manual are macros.) A loop using @code{incf} a hundred times will -execute considerably faster if compiled, and will also garbage-collect -less because the macro expansion will not have to be generated, used, -and thrown away a hundred times. - -You can find out how a macro expands by using the @code{cl-prettyexpand} -function. -@end quotation - -@node Q5.1.8, Q5.1.9, Q5.1.7, Miscellaneous -@unnumberedsubsec Q5.1.8: I like recursion, does it slow things down? - -Yes. Emacs byte-compiler cannot do much to optimize recursion. But -think well whether this is a real concern in Emacs. Much of the Emacs -slowness comes from internal mechanisms such as redisplay, or from the -fact that it is an interpreter. - -Please try not to make your code much uglier to gain a very small speed -gain. It's not usually worth it. - -@node Q5.1.9, Q5.1.10, Q5.1.8, Miscellaneous -@unnumberedsubsec Q5.1.9: How do I put a glyph as annotation in a buffer? - -Here is a solution that will insert the glyph annotation at the -beginning of buffer: - -@lisp -(make-annotation (make-glyph '([FORMAT :file FILE] - [string :data "fallback-text"])) - (point-min) - 'text - (current-buffer)) -@end lisp - -Replace @samp{FORMAT} with an unquoted symbol representing the format of -the image (e.g. @code{xpm}, @code{xbm}, @code{gif}, @code{jpeg}, etc.) -Instead of @samp{FILE}, use the image file name -(e.g. -@iftex -@* -@end iftex -@file{/usr/local/lib/xemacs-20.2/etc/recycle.xpm}). - -You can turn this to a function (that optionally prompts you for a file -name), and inserts the glyph at @code{(point)} instead of -@code{(point-min)}. - -@node Q5.1.10, Q5.1.11, Q5.1.9, Miscellaneous -@unnumberedsubsec Q5.1.10: @code{map-extents} won't traverse all of my extents! - -I tried to use @code{map-extents} to do an operation on all the extents -in a region. However, it seems to quit after processing a random number -of extents. Is it buggy? - -No. The documentation of @code{map-extents} states that it will iterate -across the extents as long as @var{function} returns @code{nil}. -Unexperienced programmers often forget to return @code{nil} explicitly, -which results in buggy code. For instance, the following code is -supposed to delete all the extents in a buffer, and issue as many -@samp{fubar!} messages. - -@lisp -(map-extents (lambda (ext ignore) - (delete-extent ext) - (message "fubar!"))) -@end lisp - -Instead, it will delete only the first extent, and stop right there -- -because @code{message} will return a non-nil value. The correct code -is: - -@lisp -(map-extents (lambda (ext ignore) - (delete-extent ext) - (message "fubar!") - nil)) -@end lisp - -@node Q5.1.11, Q5.2.1, Q5.1.10, Miscellaneous -@unnumberedsubsec Q5.1.11: My elisp program is horribly slow. Is there -an easy way to find out where it spends time? -@c New - -z@email{hniksic@@srce.hr, Hrvoje Niksic} writes: -@quotation -Under XEmacs 20.4 and later you can use @kbd{M-x profile-key-sequence}, press a key -(say @key{RET} in the Gnus Group buffer), and get the results using -@kbd{M-x profile-results}. It should give you an idea of where the time -is being spent. -@end quotation - -@node Q5.2.1, Q5.2.2, Q5.1.11, Miscellaneous -@unnumberedsubsec Q5.2.1: How do I turn off the sound? - -Add the following line to your @file{.emacs}: - -@lisp -(setq bell-volume 0) -(setq sound-alist nil) -@end lisp - -That will make your XEmacs totally silent -- even the default ding sound -(TTY beep on TTY-s) will be gone. - -Starting with XEmacs-20.2 you can also change these with Customize. -Select from the @code{Options} menu -@code{Customize->Emacs->Environment->Sound->Sound...} or type -@kbd{M-x customize @key{RET} sound @key{RET}}. - - -@node Q5.2.2, Q5.2.3, Q5.2.1, Miscellaneous -@unnumberedsubsec Q5.2.2: How do I get funky sounds instead of a boring beep? - -Make sure your XEmacs was compiled with sound support, and then put this -in your @file{.emacs}: - -@lisp -(load-default-sounds) -@end lisp - -The sound support in XEmacs 19.14 was greatly improved over previous -versions. - -@node Q5.2.3, Q5.2.4, Q5.2.2, Miscellaneous -@unnumberedsubsec Q5.2.3: What's NAS, how do I get it? - -@xref{Q2.0.3} for an explanation of the @dfn{Network Audio System}. - -@node Q5.2.4, Q5.3.1, Q5.2.3, Miscellaneous -@unnumberedsubsec Q5.2.4: Sunsite sounds don't play. - -I'm having some trouble with sounds I've downloaded from sunsite. They -play when I run them through @code{showaudio} or cat them directly to -@file{/dev/audio}, but XEmacs refuses to play them. - -@email{gutschk@@uni-muenster.de, Markus Gutschke} writes: - -@quotation -[Many of] These files have an (erroneous) 24byte header that tells about -the format that they have been recorded in. If you cat them to -@file{/dev/audio}, the header will be ignored and the default behavior -for /dev/audio will be used. This happens to be 8kHz uLaw. It is -probably possible to fix the header by piping through @code{sox} and -passing explicit parameters for specifying the sampling format; you then -need to perform a 'null' conversion from SunAudio to SunAudio. -@end quotation - -@node Q5.3.1, Q5.3.2, Q5.2.4, Miscellaneous -@unnumberedsec 5.3: Miscellaneous -@unnumberedsubsec Q5.3.1: How do you make XEmacs indent CL if-clauses correctly? - -I'd like XEmacs to indent all the clauses of a Common Lisp @code{if} the -same amount instead of indenting the 3rd clause differently from the -first two. - -One way is to add, to @file{.emacs}: - -@lisp -(put 'if 'lisp-indent-function nil) -@end lisp - -However, note that the package @code{cl-indent} that comes with -XEmacs sets up this kind of indentation by default. @code{cl-indent} -also knows about many other CL-specific forms. To use @code{cl-indent}, -one can do this: - -@lisp -(load "cl-indent") -(setq lisp-indent-function (function common-lisp-indent-function)) -@end lisp - -One can also customize @file{cl-indent.el} so it mimics the default -@code{if} indentation @code{then} indented more than the @code{else}. -Here's how: - -@lisp -(put 'if 'common-lisp-indent-function '(nil nil &body)) -@end lisp - -Also, a new version (1.2) of @file{cl-indent.el} was posted to -comp.emacs.xemacs on 12/9/94. This version includes more documentation -than previous versions. This may prove useful if you need to customize -any indent-functions. - -@node Q5.3.2, Q5.3.3, Q5.3.1, Miscellaneous -@unnumberedsubsec Q5.3.2: Fontifying hang when editing a postscript file. - -When I try to edit a postscript file it gets stuck saying: -@samp{fontifying 'filename' (regexps....)} and it just sits there. If I -press @kbd{C-c} in the window where XEmacs was started, it suddenly -becomes alive again. - -This was caused by a bug in the Postscript font-lock regular -expressions. It was fixed in 19.13. For earlier versions of XEmacs, -have a look at your @file{.emacs} file. You will probably have a line -like: - -@lisp -(add-hook 'postscript-mode-hook 'turn-on-font-lock) -@end lisp - -Take it out, restart XEmacs, and it won't try to fontify your postscript -files anymore. - -@node Q5.3.3, Q5.3.4, Q5.3.2, Miscellaneous -@unnumberedsubsec Q5.3.3: How can I print WYSIWYG a font-locked buffer? - -Font-lock looks nice. How can I print (WYSIWYG) the highlighted -document? - -The package @code{ps-print}, which is now included with XEmacs, provides -the ability to do this. The source code contains complete instructions -on its use, in @file{/lisp/packages/ps-print.el}. - -@node Q5.3.4, Q5.3.5, Q5.3.3, Miscellaneous -@unnumberedsubsec Q5.3.4: Getting @kbd{M-x lpr} to work with postscript printer. - -My printer is a Postscript printer and @code{lpr} only works for -Postscript files, so how do I get @kbd{M-x lpr-region} and @kbd{M-x -lpr-buffer} to work? - -Put something like this in your @file{.emacs}: - -@lisp -(setq lpr-command "a2ps") -(setq lpr-switches '("-p" "-1")) -@end lisp - -If you don't use a2ps to convert ASCII to postscript (why not, it's -free?), replace with the command you do use. Note also that some -versions of a2ps require a @samp{-Pprinter} to ensure spooling. - -@node Q5.3.5, Q5.3.6, Q5.3.4, Miscellaneous -@unnumberedsubsec Q5.3.5: How do I specify the paths that XEmacs uses for finding files? - -You can specify what paths to use by using a number of different flags -when running configure. See the section MAKE VARIABLES in the top-level -file INSTALL in the XEmacs distribution for a listing of those flags. - -Most of the time, however, the simplest fix is: @strong{do not} specify -paths as you might for GNU Emacs. XEmacs can generally determine the -necessary paths dynamically at run time. The only path that generally -needs to be specified is the root directory to install into. That can -be specified by passing the @code{--prefix} flag to configure. For a -description of the XEmacs install tree, please consult the @file{NEWS} -file. - -@node Q5.3.6, Q5.3.7, Q5.3.5, Miscellaneous -@unnumberedsubsec Q5.3.6: [This question intentionally left blank] - -Obsolete question, left blank to avoid renumbering. - -@node Q5.3.7, Q5.3.8, Q5.3.6, Miscellaneous -@unnumberedsubsec Q5.3.7: Can I have the end of the buffer delimited in some way? - -Say, with: @samp{[END]}? - -Try this: - -@lisp -(let ((ext (make-extent (point-min) (point-max)))) - (set-extent-property ext 'start-closed t) - (set-extent-property ext 'end-closed t) - (set-extent-property ext 'detachable nil) - (set-extent-end-glyph ext (make-glyph [string :data "[END]"]))) -@end lisp - -Since this is XEmacs, you can specify an icon to be shown on -window-system devices. To do so, change the @code{make-glyph} call to -something like this: - -@lisp -(make-glyph '([xpm :file "~/something.xpm"] - [string :data "[END]"])) -@end lisp - -You can inline the @sc{xpm} definition yourself by specifying -@code{:data} instead of @code{:file}. Here is such a full-featured -version that works on both X and TTY devices: - -@lisp -(let ((ext (make-extent (point-min) (point-max)))) - (set-extent-property ext 'start-closed t) - (set-extent-property ext 'end-closed t) - (set-extent-property ext 'detachable nil) - (set-extent-end-glyph ext (make-glyph '([xpm :data "\ -/* XPM */ -static char* eye = @{ -\"20 11 7 2\", -\"__ c None\" -\"_` c #7f7f7f\", -\"_a c #fefefe\", -\"_b c #7f0000\", -\"_c c #fefe00\", -\"_d c #fe0000\", -\"_e c #bfbfbf\", -\"___________`_`_`___b_b_b_b_________`____\", -\"_________`_`_`___b_c_c_c_b_b____________\", -\"_____`_`_`_e___b_b_c_c_c___b___b_______`\", -\"___`_`_e_a___b_b_d___b___b___b___b______\", -\"_`_`_e_a_e___b_b_d_b___b___b___b___b____\", -\"_`_`_a_e_a___b_b_d___b___b___b___b___b__\", -\"_`_`_e_a_e___b_b_d_b___b___b___b___b_b__\", -\"___`_`_e_a___b_b_b_d_c___b___b___d_b____\", -\"_____`_`_e_e___b_b_b_d_c___b_b_d_b______\", -\"_`_____`_`_`_`___b_b_b_d_d_d_d_b________\", -\"___`_____`_`_`_`___b_b_b_b_b_b__________\", -@} ;"] - [string :data "[END]"])))) -@end lisp - -Note that you might want to make this a function, and put it to a hook. -We leave that as an exercise for the reader. - -@node Q5.3.8, Q5.3.9, Q5.3.7, Miscellaneous -@unnumberedsubsec Q5.3.8: How do I insert today's date into a buffer? - -Like this: - -@lisp -(insert (current-time-string)) -@end lisp - -@node Q5.3.9, Q5.3.10, Q5.3.8, Miscellaneous -@unnumberedsubsec Q5.3.9: Are only certain syntactic character classes available for abbrevs? - -@email{gutschk@@uni-muenster.de, Markus Gutschke} writes: - -@quotation -Yes, abbrevs only expands word-syntax strings. While XEmacs does not -prevent you from defining (e.g. with @kbd{C-x a g} or @kbd{C-x a l}) -abbrevs that contain special characters, it will refuse to expand -them. So you need to ensure, that the abbreviation contains letters and -digits only. This means that @samp{xd}, @samp{d5}, and @samp{5d} are -valid abbrevs, but @samp{&d}, and @samp{x d} are not. - -If this sounds confusing to you, (re-)read the online documentation for -abbrevs (@kbd{C-h i m XEmacs @key{RET} m Abbrevs @key{RET}}), and then come back and -read this question/answer again. -@end quotation - -Starting with XEmacs 20.3 this restriction has been lifted. - -@node Q5.3.10, Q5.3.11, Q5.3.9, Miscellaneous -@unnumberedsubsec Q5.3.10: How can I get those oh-so-neat X-Face lines? - -Firstly there is an ftp site which describes X-faces and has the -associated tools mentioned below, at -@uref{ftp://ftp.cs.indiana.edu:/pub/faces/}. - -Then the steps are - -@enumerate -@item -Create 48x48x1 bitmap with your favorite tool - -@item -Convert to "icon" format using one of xbm2ikon, pbmtoicon, etc., -and then compile the face. - -@item -@example -cat file.xbm | xbm2ikon |compface > file.face -@end example - -@item -Then be sure to quote things that are necessary for emacs strings: - -@example -cat ./file.face | sed 's/\\/\\\\/g' -@iftex -\ @* -@end iftex -| sed 's/\"/\\\"/g' > ./file.face.quoted -@end example - -@item -Then set up emacs to include the file as a mail header - there were a -couple of suggestions here---either something like: - -@lisp -(setq mail-default-headers - "X-Face: @email{Ugly looking text string here}") -@end lisp - -Or, alternatively, as: - -@lisp -(defun mail-insert-x-face () - (save-excursion - (goto-char (point-min)) - (search-forward mail-header-separator) - (beginning-of-line) - (insert "X-Face:") - (insert-file-contents "~/.face"))) - -(add-hook 'mail-setup-hook 'mail-insert-x-face) -@end lisp -@end enumerate - -However, 2 things might be wrong: - -Some versions of pbmtoicon produces some header lines that is not -expected by the version of compface that I grabbed. So I found I had to -include a @code{tail +3} in the pipeline like this: - -@example -cat file.xbm | xbm2ikon | tail +3 |compface > file.face -@end example - -Some people have also found that if one uses the @code{(insert-file)} -method, one should NOT quote the face string using the sed script . - -It might also be helpful to use @email{stig@@hackvan.com, Stig's} script -(included in the compface distribution at XEmacs.org) to do the -conversion. For convenience xbm2xface is available for anonymous FTP at -@uref{ftp://ftp.miranova.com/pub/xemacs/xbm2xface.pl}. - -Contributors for this item: - -Paul Emsley, -Ricardo Marek, -Amir J. Katz, -Glen McCort, -Heinz Uphoff, -Peter Arius, -Paul Harrison, and -Vegard Vesterheim - -@node Q5.3.11, Q5.3.12, Q5.3.10, Miscellaneous -@unnumberedsubsec Q5.3.11: How do I add new Info directories? - -You use something like: - -@lisp -(setq Info-directory-list (cons - (expand-file-name "~/info") - Info-default-directory-list)) -@end lisp - -@email{davidm@@prism.kla.com, David Masterson} writes: - -@quotation -Emacs Info and XEmacs Info do many things differently. If you're trying to -support a number of versions of Emacs, here are some notes to remember: - -@enumerate -@item -Emacs Info scans @code{Info-directory-list} from right-to-left while -XEmacs Info reads it from left-to-right, so append to the @emph{correct} -end of the list. - -@item -Use @code{Info-default-directory-list} to initialize -@code{Info-directory-list} @emph{if} it is available at startup, but not -all Emacsen define it. - -@item -Emacs Info looks for a standard @file{dir} file in each of the -directories scanned from #1 and magically concatenates them together. - -@item -XEmacs Info looks for a @file{localdir} file (which consists of just the -menu entries from a @file{dir} file) in each of the directories scanned -from #1 (except the first), does a simple concatenation of them, and -magically attaches the resulting list to the end of the menu in the -@file{dir} file in the first directory. -@end enumerate - -Another alternative is to convert the documentation to HTML with -texi2html and read it from a web browser like Lynx or W3. -@end quotation - -@node Q5.3.12, , Q5.3.11, Miscellaneous -@unnumberedsubsec Q5.3.12: What do I need to change to make printing work? - -For regular printing there are two variables that can be customized. - -@table @code -@item lpr-command -This should be set to a command that takes standard input and sends -it to a printer. Something like: - -@lisp -(setq lpr-command "lp") -@end lisp - -@item lpr-switches -This should be set to a list that contains whatever the print command -requires to do its job. Something like: - -@lisp -(setq lpr-switches '("-depson")) -@end lisp -@end table - -For postscript printing there are three analogous variables to -customize. - -@table @code -@item ps-lpr-command -This should be set to a command that takes postscript on standard input -and directs it to a postscript printer. - -@item ps-lpr-switches -This should be set to a list of switches required for -@code{ps-lpr-command} to do its job. - -@item ps-print-color-p -This boolean variable should be set @code{t} if printing will be done in -color, otherwise it should be set to @code{nil}. -@end table - -NOTE: It is an undocumented limitation in XEmacs that postscript -printing (the @code{Pretty Print Buffer} menu item) @strong{requires} a -window system environment. It cannot be used outside of X11. - -@node Current Events, , Miscellaneous, Top -@unnumbered 6 What the Future Holds - -This is part 6 of the XEmacs Frequently Asked Questions list. This -section will change monthly, and contains any interesting items that have -transpired over the previous month. If you are reading this from the -XEmacs distribution, please see the version on the Web or archived at the -various FAQ FTP sites, as this file is surely out of date. - -@menu -* Q6.0.1:: What is new in 20.2? -* Q6.0.2:: What is new in 20.3? -* Q6.0.3:: What is new in 20.4? -* Q6.0.4:: Procedural changes in XEmacs development. -@end menu - -@node Q6.0.1, Q6.0.2, Current Events, Current Events -@unnumberedsec 6.0: Changes -@unnumberedsubsec Q6.0.1: What is new in 20.2? - -The biggest changes in 20.2 include integration of EFS (the next -generation of ange-ftp) and AUC Tex (the Emacs subsystem that includes a -major mode for editing Tex and LaTeX, and a lot of other stuff). Many -bugs from 20.0 have been fixed for this release. 20.2 also contains a -new system for customizing XEmacs options, invoked via @kbd{M-x -customize}. - -XEmacs 20.2 is the development release (20.0 was beta), and is no longer -considered unstable. - -@node Q6.0.2, Q6.0.3, Q6.0.1, Current Events -@unnumberedsubsec Q6.0.2: What is new in 20.3? - -XEmacs 20.3 was released in November 1997. It contains many bugfixes, -and a number of new features, including Autoconf 2 based configuration, -additional support for Mule (Multi-language extensions to Emacs), many -more customizations, multiple frames on TTY-s, support for multiple info -directories, an enhanced gnuclient, improvements to regexp matching, -increased MIME support, and many, many synches with GNU Emacs 20. - -The XEmacs/Mule support has been only seriously tested in a Japanese -locale, and no doubt many problems still remain. The support for -ISO-Latin-1 and Japanese is fairly strong. MULE support comes at a -price -- about a 30% slowdown from 19.16. We're making progress on -improving performance and XEmacs 20.3 compiled without Mule (which is -the default) is definitely faster than XEmacs 19.16. - -XEmacs 20.3 is the first non-beta v20 release, and will be the -basis for all further development. - -@node Q6.0.3, Q6.0.4, Q6.0.2, Current Events -@unnumberedsubsec Q6.0.3: What's new in XEmacs 20.4? - -XEmacs 20.4 is a bugfix release with no user-visible changes. -@c Filled in from NEWS file of 20.5-b33 - - -@node Q6.0.4, , Q6.0.3, Current Events -@unnumberedsubsec Q6.0.4: Procedural changes in XEmacs development. - -@enumerate -@item -Discussion about the development of XEmacs occurs on the xemacs-beta -mailing list. Subscriptions to this list will now be fully automated -instead of being handled by hand. Send a mail message to -@email{xemacs-beta-request@@xemacs.org} with @samp{subscribe} as the -BODY of the message to join the list. Please note this is a developers -mailing list for people who have an active interest in the development -process. - -The discussion of NT XEmacs development is taking place on a separate -mailing list. Send mail to -@iftex -@* -@end iftex -@email{xemacs-nt-request@@xemacs.org} to -subscribe. - -@item -Due to the long development cycle in between releases, it has been -decided that intermediate versions will be made available in source only -form for the truly interested. - -XEmacs 19.16 was the last 19 release, basically consisting of 19.15 plus -the collected bugfixes. - -@item -As of December 1996, @email{steve@@altair.xemacs.org, Steve Baur} has become -the lead maintainer of XEmacs. -@end enumerate - -@bye diff --git a/man/xemacs/abbrevs.texi b/man/xemacs/abbrevs.texi deleted file mode 100644 index e1afef7..0000000 --- a/man/xemacs/abbrevs.texi +++ /dev/null @@ -1,306 +0,0 @@ - -@node Abbrevs, Picture, Packages, Top -@chapter Abbrevs -@cindex abbrevs -@cindex expansion (of abbrevs) - - An @dfn{abbrev} is a word which @dfn{expands} into some -different text. Abbrevs are defined by the user to expand in specific -ways. For example, you might define @samp{foo} as an abbrev expanding to -@samp{find outer otter}. With this abbrev defined, you would be able to -get @samp{find outer otter } into the buffer by typing @kbd{f o o @key{SPC}}. - -@findex abbrev-mode -@vindex abbrev-mode - Abbrevs expand only when Abbrev mode (a minor mode) is enabled. -Disabling Abbrev mode does not cause abbrev definitions to be discarded, -but they do not expand until Abbrev mode is enabled again. The command -@kbd{M-x abbrev-mode} toggles Abbrev mode; with a numeric argument, it -turns Abbrev mode on if the argument is positive, off otherwise. -@xref{Minor Modes}. @code{abbrev-mode} is also a variable; Abbrev mode is -on when the variable is non-@code{nil}. The variable @code{abbrev-mode} -automatically becomes local to the current buffer when it is set. - - Abbrev definitions can be @dfn{mode-specific}---active only in one major -mode. Abbrevs can also have @dfn{global} definitions that are active in -all major modes. The same abbrev can have a global definition and various -mode-specific definitions for different major modes. A mode-specific -definition for the current major mode overrides a global definition. - - You can define Abbrevs interactively during an editing session. You -can also save lists of abbrev definitions in files and reload them in later -sessions. Some users keep extensive lists of abbrevs that they load in -every session. - - A second kind of abbreviation facility is called the @dfn{dynamic -expansion}. Dynamic abbrev expansion happens only when you give an -explicit command and the result of the expansion depends only on the -current contents of the buffer. @xref{Dynamic Abbrevs}. - -@menu -* Defining Abbrevs:: Defining an abbrev, so it will expand when typed. -* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion. -* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs. -* Saving Abbrevs:: Saving the entire list of abbrevs for another session. -* Dynamic Abbrevs:: Abbreviations for words already in the buffer. -@end menu - -@node Defining Abbrevs, Expanding Abbrevs, Abbrevs, Abbrevs -@section Defining Abbrevs - -@table @kbd -@item C-x a g -Define an abbrev to expand into some text before point -(@code{add-global-abbrev}). -@item C-x a l -Similar, but define an abbrev available only in the current major mode -(@code{add-mode-abbrev}). -@item C-x a i g -Define a word in the buffer as an abbrev (@code{inverse-add-global-abbrev}). -@item C-x a i l -Define a word in the buffer as a mode-specific abbrev -(@code{inverse-add-mode-abbrev}). -@item M-x kill-all-abbrevs -After this command, no abbrev definitions remain in effect. -@end table - -@kindex C-x a g -@findex add-global-abbrev - The usual way to define an abbrev is to enter the text you want the -abbrev to expand to, position point after it, and type @kbd{C-x a g} -(@code{add-global-abbrev}). This reads the abbrev itself using the -minibuffer, and then defines it as an abbrev for one or more words -before point. Use a numeric argument to say how many words before point -should be taken as the expansion. For example, to define the abbrev -@samp{foo} as in the example above, insert the text @samp{find outer -otter}, then type @*@kbd{C-u 3 C-x a g f o o @key{RET}}. - - An argument of zero to @kbd{C-x a g} means to use the contents of the -region as the expansion of the abbrev being defined. - -@kindex C-x a l -@findex add-mode-abbrev - The command @kbd{C-x a l} (@code{add-mode-abbrev}) is similar, but -defines a mode-specific abbrev. Mode-specific abbrevs are active only in a -particular major mode. @kbd{C-x a l} defines an abbrev for the major mode -in effect at the time @kbd{C-x a l} is typed. The arguments work the -same way they do for @kbd{C-x a g}. - -@kindex C-x a i g -@findex inverse-add-global-abbrev -@kindex C-x a i l -@findex inverse-add-mode-abbrev - If the text of an abbrev you want is already in the buffer instead of -the expansion, use command @kbd{C-x a i g} (@code{inverse-add-global-abbrev}) -instead of @kbd{C-x a g}, or use @kbd{C-x a i l} -(@code{inverse-add-mode-abbrev}) instead of @kbd{C-x a l}. These commands -are called ``inverse'' because they invert the meaning of the argument -found in the buffer and the argument read using the minibuffer.@refill - - To change the definition of an abbrev, just add the new definition. You -will be asked to confirm if the abbrev has a prior definition. To remove -an abbrev definition, give a negative argument to @kbd{C-x a g} or @kbd{C-x -a l}. You must choose the command to specify whether to kill a global -definition or a mode-specific definition for the current mode, since those -two definitions are independent for one abbrev. - -@findex kill-all-abbrevs - @kbd{M-x kill-all-abbrevs} removes all existing abbrev definitions. - -@node Expanding Abbrevs, Editing Abbrevs, Defining Abbrevs, Abbrevs -@section Controlling Abbrev Expansion - - An abbrev expands whenever it is in a buffer just before point and you -type a self-inserting punctuation character (@key{SPC}, comma, -etc.@:). Most often an abbrev is used by inserting the abbrev followed -by punctuation. - -@vindex abbrev-all-caps - Abbrev expansion preserves case; thus, @samp{foo} expands into @samp{find -outer otter}, @samp{Foo} into @samp{Find outer otter}, and @samp{FOO} into -@samp{FIND OUTER OTTER} or @samp{Find Outer Otter} according to the -variable @code{abbrev-all-caps} (a non-@code{nil} value chooses the first -of the two expansions).@refill - - Two commands are available to control abbrev expansion: - -@table @kbd -@item M-' -Separate a prefix from a following abbrev to be expanded -(@code{abbrev-prefix-mark}). -@item C-x a e -@findex expand-abbrev -Expand the abbrev before point (@code{expand-abbrev}). -This is effective even when Abbrev mode is not enabled. -@item M-x unexpand-abbrev -Undo last abbrev expansion. -@item M-x expand-region-abbrevs -Expand some or all abbrevs found in the region. -@end table - -@kindex M-' -@findex abbrev-prefix-mark - You may wish to expand an abbrev with a prefix attached. For example, -if @samp{cnst} expands into @samp{construction}, you may want to use it -to enter @samp{reconstruction}. It does not work to type @kbd{recnst}, -because that is not necessarily a defined abbrev. Instead, you can use -the command @kbd{M-'} (@code{abbrev-prefix-mark}) between the prefix -@samp{re} and the abbrev @samp{cnst}. First, insert @samp{re}. Then -type @kbd{M-'}; this inserts a minus sign in the buffer to indicate that -it has done its work. Then insert the abbrev @samp{cnst}. The buffer -now contains @samp{re-cnst}. Now insert a punctuation character to -expand the abbrev @samp{cnst} into @samp{construction}. The minus sign -is deleted at this point by @kbd{M-'}. The resulting text is the -desired @samp{reconstruction}.@refill - - If you actually want the text of the abbrev in the buffer, rather than -its expansion, insert the following punctuation with @kbd{C-q}. Thus, -@kbd{foo C-q -} leaves @samp{foo-} in the buffer. - -@findex unexpand-abbrev - If you expand an abbrev by mistake, you can undo the expansion (replace -the expansion by the original abbrev text) with @kbd{M-x unexpand-abbrev}. -You can also use @kbd{C-_} (@code{undo}) to undo the expansion; but that -will first undo the insertion of the punctuation character. - -@findex expand-region-abbrevs - @kbd{M-x expand-region-abbrevs} searches through the region for defined -abbrevs, and offers to replace each one it finds with its expansion. -This command is useful if you have typed text using abbrevs but forgot -to turn on Abbrev mode first. It may also be useful together with a -special set of abbrev definitions for making several global replacements at -once. The command is effective even if Abbrev mode is not enabled. - -@node Editing Abbrevs, Saving Abbrevs, Expanding Abbrevs, Abbrevs -@section Examining and Editing Abbrevs - -@table @kbd -@item M-x list-abbrevs -Print a list of all abbrev definitions. -@item M-x edit-abbrevs -Edit a list of abbrevs; you can add, alter, or remove definitions. -@end table - -@findex list-abbrevs - The output from @kbd{M-x list-abbrevs} looks like this: - -@example -(lisp-mode-abbrev-table) -"dk" 0 "define-key" -(global-abbrev-table) -"dfn" 0 "definition" -@end example - -@noindent -(Some blank lines of no semantic significance, and some other abbrev -tables, have been omitted.) - - A line containing a name in parentheses is the header for abbrevs in a -particular abbrev table; @code{global-abbrev-table} contains all the global -abbrevs, and the other abbrev tables that are named after major modes -contain the mode-specific abbrevs. - - Within each abbrev table, each non-blank line defines one abbrev. The -word at the beginning is the abbrev. The number that appears is the number -of times the abbrev has been expanded. Emacs keeps track of this to help -you see which abbrevs you actually use, in case you want to eliminate -those that you don't use often. The string at the end of the line is the -expansion. - -@findex edit-abbrevs -@kindex C-c C-c (Edit Abbrevs) -@findex edit-abbrevs-redefine - @kbd{M-x edit-abbrevs} allows you to add, change or kill abbrev -definitions by editing a list of them in an Emacs buffer. The list has -the format described above. The buffer of abbrevs is called -@samp{*Abbrevs*}, and is in Edit-Abbrevs mode. This mode redefines the -key @kbd{C-c C-c} to install the abbrev definitions as specified in the -buffer. The @code{edit-abbrevs-redefine} command does this. -Any abbrevs not described in the buffer are eliminated when this is -done. - - @code{edit-abbrevs} is actually the same as @code{list-abbrevs}, except -that it selects the buffer @samp{*Abbrevs*} whereas @code{list-abbrevs} -merely displays it in another window. - -@node Saving Abbrevs, Dynamic Abbrevs, Editing Abbrevs, Abbrevs -@section Saving Abbrevs - - These commands allow you to keep abbrev definitions between editing -sessions. - -@table @kbd -@item M-x write-abbrev-file -Write a file describing all defined abbrevs. -@item M-x read-abbrev-file -Read such an abbrev file and define abbrevs as specified there. -@item M-x quietly-read-abbrev-file -Similar, but do not display a message about what is going on. -@item M-x define-abbrevs -Define abbrevs from buffer. -@item M-x insert-abbrevs -Insert all abbrevs and their expansions into the buffer. -@end table - -@findex write-abbrev-file - Use @kbd{M-x write-abbrev-file} to save abbrev definitions for use in -a later session. The command reads a file name using the minibuffer and -writes a description of all current abbrev definitions into the -specified file. The text stored in the file looks like the output of -@kbd{M-x list-abbrevs}. - - -@findex read-abbrev-file -@findex quietly-read-abbrev-file -@vindex abbrev-file-name - @kbd{M-x read-abbrev-file} prompts for a file name using the -minibuffer and reads the specified file, defining abbrevs according to -its contents. @kbd{M-x quietly-read-abbrev-file} is the same but does -not display a message in the echo area; it is actually useful primarily -in the @file{.emacs} file. If you give an empty argument to either of -these functions, the file name Emacs uses is the value of the variable -@code{abbrev-file-name}, which is by default @code{"~/.abbrev_defs"}. - -@vindex save-abbrevs - Emacs offers to save abbrevs automatically if you have changed any of -them, whenever it offers to save all files (for @kbd{C-x s} or @kbd{C-x -C-c}). Set the variable @code{save-abbrevs} to @code{nil} to inhibit -this feature. - -@findex insert-abbrevs -@findex define-abbrevs - The commands @kbd{M-x insert-abbrevs} and @kbd{M-x define-abbrevs} are -similar to the previous commands but work on text in an Emacs buffer. -@kbd{M-x insert-abbrevs} inserts text into the current buffer before point, -describing all current abbrev definitions; @kbd{M-x define-abbrevs} parses -the entire current buffer and defines abbrevs accordingly.@refill - -@node Dynamic Abbrevs,, Saving Abbrevs, Abbrevs -@section Dynamic Abbrev Expansion - - The abbrev facility described above operates automatically as you insert -text, but all abbrevs must be defined explicitly. By contrast, -@dfn{dynamic abbrevs} allow the meanings of abbrevs to be determined -automatically from the contents of the buffer, but dynamic abbrev expansion -happens only when you request it explicitly. - -@kindex M-/ -@findex dabbrev-expand -@table @kbd -@item M-/ -Expand the word in the buffer before point as a @dfn{dynamic abbrev}, -by searching in the buffer for words starting with that abbreviation -(@code{dabbrev-expand}). -@end table - - For example, if the buffer contains @samp{does this follow } and you type -@kbd{f o M-/}, the effect is to insert @samp{follow} because that is the -last word in the buffer that starts with @samp{fo}. A numeric argument to -@kbd{M-/} says to take the second, third, etc.@: distinct expansion found -looking backward from point. Repeating @kbd{M-/} searches for an -alternative expansion by looking farther back. After the entire buffer -before point has been considered, the buffer after point is searched. - - Dynamic abbrev expansion is completely independent of Abbrev mode; the -expansion of a word with @kbd{M-/} is completely independent of whether it -has a definition as an ordinary abbrev. diff --git a/man/xemacs/basic.texi b/man/xemacs/basic.texi deleted file mode 100644 index 32cfc00..0000000 --- a/man/xemacs/basic.texi +++ /dev/null @@ -1,550 +0,0 @@ - -@node Basic, Undo, Startup Paths, Top -@chapter Basic Editing Commands - -@kindex C-h t -@findex help-with-tutorial - We now give the basics of how to enter text, make corrections, and -save the text in a file. If this material is new to you, you might -learn it more easily by running the Emacs learn-by-doing tutorial. To -do this, type @kbd{Control-h t} (@code{help-with-tutorial}). - -@section Inserting Text - -@cindex insertion -@cindex point -@cindex cursor -@cindex graphic characters - To insert printing characters into the text you are editing, just type -them. This inserts the characters into the buffer at the cursor (that -is, at @dfn{point}; @pxref{Point}). The cursor moves forward. Any -characters after the cursor move forward too. If the text in the buffer -is @samp{FOOBAR}, with the cursor before the @samp{B}, and you type -@kbd{XX}, the result is @samp{FOOXXBAR}, with the cursor still before the -@samp{B}. - -@kindex DEL -@cindex deletion - To @dfn{delete} text you have just inserted, use @key{DEL}. -@key{DEL} deletes the character @var{before} the cursor (not the one -that the cursor is on top of or under; that is the character @var{after} -the cursor). The cursor and all characters after it move backwards. -Therefore, if you type a printing character and then type @key{DEL}, -they cancel out. - -@kindex RET -@cindex newline - To end a line and start typing a new one, type @key{RET}. This -inserts a newline character in the buffer. If point is in the middle of -a line, @key{RET} splits the line. Typing @key{DEL} when the cursor is -at the beginning of a line rubs out the newline before the line, thus -joining the line with the preceding line. - - Emacs automatically splits lines when they become too long, if you -turn on a special mode called @dfn{Auto Fill} mode. @xref{Filling}, for -information on using Auto Fill mode. - -@findex delete-backward-char -@findex newline -@findex self-insert - Customization information: @key{DEL}, in most modes, runs the command -@code{delete-backward-char}; @key{RET} runs the command @code{newline}, -and self-inserting printing characters run the command -@code{self-insert}, which inserts whatever character was typed to invoke -it. Some major modes rebind @key{DEL} to other commands. - -@cindex quoting -@kindex C-q -@findex quoted-insert - Direct insertion works for printing characters and @key{SPC}, but -other characters act as editing commands and do not insert themselves. -If you need to insert a control character or a character whose code is -above 200 octal, you must @dfn{quote} it by typing the character -@kbd{control-q} (@code{quoted-insert}) first. There are two ways to use -@kbd{C-q}:@refill - -@itemize @bullet -@item -@kbd{Control-q} followed by any non-graphic character (even @kbd{C-g}) -inserts that character. -@item -@kbd{Control-q} followed by three octal digits inserts the character -with the specified character code. -@end itemize - -@noindent -A numeric argument to @kbd{C-q} specifies how many copies of the quoted -character should be inserted (@pxref{Arguments}). - - If you prefer to have text characters replace (overwrite) existing -text instead of moving it to the right, you can enable Overwrite mode, a -minor mode. @xref{Minor Modes}. - -@section Changing the Location of Point - - To do more than insert characters, you have to know how to move point -(@pxref{Point}). Here are a few of the available commands. - - NOTE: Many of the following commands have two versions, one that uses -the function keys (e.g. @key{LEFT} or @key{END}) and one that doesn't. -The former versions may only be available on X terminals (i.e. not on -TTY's), but the latter are available on all terminals. - -@kindex C-a -@kindex C-e -@kindex C-f -@kindex C-b -@kindex C-n -@kindex C-p -@kindex C-l -@kindex C-t -@kindex C-v -@kindex M-v -@kindex M-> -@kindex M-< -@kindex M-r -@kindex LEFT -@kindex RIGHT -@kindex UP -@kindex DOWN -@kindex HOME -@kindex END -@kindex PGUP -@kindex PGDN -@kindex C-LEFT -@kindex C-RIGHT -@kindex C-HOME -@kindex C-END -@findex beginning-of-line -@findex end-of-line -@findex forward-char -@findex backward-char -@findex next-line -@findex previous-line -@findex recenter -@findex transpose-chars -@findex beginning-of-buffer -@findex end-of-buffer -@findex goto-char -@findex goto-line -@findex move-to-window-line -@table @kbd -@item C-a -@itemx HOME -Move to the beginning of the line (@code{beginning-of-line}). -@item C-e -@itemx END -Move to the end of the line (@code{end-of-line}). -@item C-f -@itemx RIGHT -Move forward one character (@code{forward-char}). -@item C-b -@itemx LEFT -Move backward one character (@code{backward-char}). -@item M-f -@itemx C-RIGHT -Move forward one word (@code{forward-word}). -@item M-b -@itemx C-LEFT -Move backward one word (@code{backward-word}). -@item C-n -@itemx DOWN -Move down one line, vertically (@code{next-line}). This command attempts to keep the horizontal position unchanged, so if you start in the middle of one line, you end in the middle of the next. When on the last line of text, @kbd{C-n} creates a new line and moves onto it. -@item C-p -@itemx UP -Move up one line, vertically (@code{previous-line}). -@item C-v -@itemx PGDN -Move down one page, vertically (@code{scroll-up}). -@item M-v -@itemx PGUP -Move up one page, vertically (@code{scroll-down}). -@item C-l -Clear the frame and reprint everything (@code{recenter}). Text moves -on the frame to bring point to the center of the window. -@item M-r -Move point to left margin on the line halfway down the frame or -window (@code{move-to-window-line}). Text does not move on the -frame. A numeric argument says how many screen lines down from the -top of the window (zero for the top). A negative argument counts from -the bottom (@minus{}1 for the bottom). -@item C-t -Transpose two characters, the ones before and after the cursor -@*(@code{transpose-chars}). -@item M-< -@itemx C-HOME -Move to the top of the buffer (@code{beginning-of-buffer}). With -numeric argument @var{n}, move to @var{n}/10 of the way from the top. -@xref{Arguments}, for more information on numeric arguments.@refill -@item M-> -@itemx C-END -Move to the end of the buffer (@code{end-of-buffer}). -@item M-x goto-char -Read a number @var{n} and move the cursor to character number @var{n}. -Position 1 is the beginning of the buffer. -@item M-g -Read a number @var{n} and move cursor to line number @var{n} -(@code{goto-line}). Line 1 is the beginning of the buffer. -@item C-x C-n -@findex set-goal-column -Use the current column of point as the @dfn{semi-permanent goal column} for -@kbd{C-n} and @kbd{C-p} (@code{set-goal-column}). Henceforth, those -commands always move to this column in each line moved into, or as -close as possible given the contents of the line. This goal column remains -in effect until canceled. -@item C-u C-x C-n -Cancel the goal column. Henceforth, @kbd{C-n} and @kbd{C-p} once -again try to avoid changing the horizontal position, as usual. -@end table - -@vindex track-eol - If you set the variable @code{track-eol} to a non-@code{nil} value, -@kbd{C-n} and @kbd{C-p} move to the end of the line when at the end of -the starting line. By default, @code{track-eol} is @code{nil}. - -@section Erasing Text - -@table @kbd -@item @key{DEL} -Delete the character before the cursor (@code{delete-backward-char}). -@item C-d -Delete the character after the cursor (@code{delete-char}). -@item C-k -Kill to the end of the line (@code{kill-line}). -@item M-d -Kill forward to the end of the next word (@code{kill-word}). -@item M-@key{DEL} -Kill back to the beginning of the previous word -(@code{backward-kill-word}). -@end table - - In contrast to the @key{DEL} key, which deletes the character before -the cursor, @kbd{Control-d} deletes the character after the cursor, -causing the rest of the text on the line to shift left. If -@kbd{Control-d} is typed at the end of a line, that line and the next -line are joined. - - To erase a larger amount of text, use @kbd{Control-k}, which kills a -line at a time. If you use @kbd{C-k} at the beginning or in the middle -of a line, it kills all the text up to the end of the line. If you use -@kbd{C-k} at the end of a line, it joins that line and the next -line. - - @xref{Killing}, for more flexible ways of killing text. - -@section Files - -@cindex files - The commands above are sufficient for creating and altering text in an -Emacs buffer. More advanced Emacs commands just make things easier. But -to keep any text permanently you must put it in a @dfn{file}. Files are -named units of text which are stored by the operating system and which -you can retrieve by name. To look at or use the contents of a file in -any way, including editing the file with Emacs, you must specify the -file name. - - Consider a file named @file{/usr/rms/foo.c}. To begin editing -this file from Emacs, type: - -@example -C-x C-f /usr/rms/foo.c @key{RET} -@end example - -@noindent -The file name is given as an @dfn{argument} to the command @kbd{C-x -C-f} (@code{find-file}). The command uses the @dfn{minibuffer} to -read the argument. You have to type @key{RET} to terminate the argument -(@pxref{Minibuffer}).@refill - - You can also use the @b{Open...} menu item from the @b{File} menu, then -type the name of the file to the prompt. - - Emacs obeys the command by @dfn{visiting} the file: it creates a -buffer, copies the contents of the file into the buffer, and then -displays the buffer for you to edit. You can make changes in the -buffer, and then @dfn{save} the file by typing @kbd{C-x C-s} -(@code{save-buffer}) or choosing @b{Save Buffer} from the @b{File} menu. -This makes the changes permanent by copying the altered contents of the -buffer back into the file @file{/usr/rms/foo.c}. Until then, the -changes are only inside your Emacs buffer, and the file @file{foo.c} is -not changed.@refill - - To create a file, visit the file with @kbd{C-x C-f} as if it already -existed or choose @b{Open...} from the @b{File} menu and provide the -name for the new file in the minibuffer. Emacs will create an empty -buffer in which you can insert the text you want to put in the file. -When you save the buffer with @kbd{C-x C-s}, or by choosing @b{Save -Buffer} from the @b{File} menu, the file is created. - - To learn more about using files, @pxref{Files}. - -@section Help - - If you forget what a key does, you can use the Help character -(@kbd{C-h}) to find out: Type @kbd{C-h k} followed by the key you want -to know about. For example, @kbd{C-h k C-n} tells you what @kbd{C-n} -does. @kbd{C-h} is a prefix key; @kbd{C-h k} is just one of its -subcommands (the command @code{describe-key}). The other subcommands of -@kbd{C-h} provide different kinds of help. Type @kbd{C-h} three times -to get a description of all the help facilities. @xref{Help}.@refill - -@menu -* Blank Lines:: Commands to make or delete blank lines. -* Continuation Lines:: Lines too wide for the frame. -* Position Info:: What page, line, row, or column is point on? -* Arguments:: Numeric arguments for repeating a command. -@end menu - -@node Blank Lines, Continuation Lines, Basic, Basic -@section Blank Lines - - Here are special commands and techniques for entering and removing -blank lines. - -@c widecommands -@table @kbd -@item C-o -Insert one or more blank lines after the cursor (@code{open-line}). -@item C-x C-o -Delete all but one of many consecutive blank lines -(@code{delete-blank-lines}). -@end table - -@kindex C-o -@kindex C-x C-o -@cindex blank lines -@findex open-line -@findex delete-blank-lines - When you want to insert a new line of text before an existing line, -you just type the new line of text, followed by @key{RET}. If you -prefer to create a blank line first and then insert the desired text, -use the key @kbd{C-o} (@code{open-line}), which inserts a newline after -point but leaves point in front of the newline. Then type -the text into the new line. @kbd{C-o F O O} has the same effect as -@kbd{F O O @key{RET}}, except for the final location of point. - - To create several blank lines, type @kbd{C-o} several times, or -give @kbd{C-o} an argument indicating how many blank lines to create. -@xref{Arguments}, for more information. - - If you have many blank lines in a row and want to get rid of them, use -@kbd{C-x C-o} (@code{delete-blank-lines}). If point is on a blank -line which is adjacent to at least one other blank line, @kbd{C-x C-o} -deletes all but one of the blank lines. -If point is on a blank line with no other adjacent blank line, the -sole blank line is deleted. If point is on a non-blank -line, @kbd{C-x C-o} deletes any blank lines following that non-blank -line. - -@node Continuation Lines, Position Info, Blank Lines, Basic -@section Continuation Lines - -@cindex continuation line - If you add too many characters to one line without breaking with a -@key{RET}, the line grows to occupy two (or more) screen lines, with a -curved arrow at the extreme right margin of all but the last line. The -curved arrow indicates that the following screen line is not really a -distinct line in the text, but just the @dfn{continuation} of a line too -long to fit the frame. You can use Auto Fill mode (@pxref{Filling}) -to have Emacs insert newlines automatically when a line gets too long. - - -@vindex truncate-lines -@cindex truncation - Instead of continuation, long lines can be displayed by @dfn{truncation}. -This means that all the characters that do not fit in the width of the -frame or window do not appear at all. They remain in the buffer, -temporarily invisible. Three diagonal dots in the last column (instead of -the curved arrow inform you that truncation is in effect. - - To turn off continuation for a particular buffer, set the -variable @code{truncate-lines} to non-@code{nil} in that buffer. -Truncation instead of continuation also happens whenever horizontal -scrolling is in use, and optionally whenever side-by-side windows are in -use (@pxref{Windows}). Altering the value of @code{truncate-lines} makes -it local to the current buffer; until that time, the default value is in -effect. The default is initially @code{nil}. @xref{Locals}.@refill - -@node Position Info, Arguments, Continuation Lines, Basic -@section Cursor Position Information - - If you are accustomed to other display editors, you may be surprised -that Emacs does not always display the page number or line number of -point in the mode line. In Emacs, this information is only rarely -needed, and a number of commands are available to compute and print it. -Since text is stored in a way that makes it difficult to compute the -information, it is not displayed all the time. - -@table @kbd -@item M-x what-page -Print page number of point, and line number within page. -@item M-x what-line -Print line number of point in the buffer. -@item M-= -Print number of lines and characters in the current region -(@code{count-lines-region}). -@item C-x = -Print character code of character after point, character position of -point, and column of point (@code{what-cursor-position}). -@end table - -@findex what-page -@findex what-line -@cindex line number -@cindex page number -@kindex M-= -@findex count-lines-region - - There are several commands for printing line numbers: -@itemize @bullet -@item -@kbd{M-x what-line} counts lines from the beginning of the file and -prints the line number point is on. The first line of the file is line -number 1. You can use these numbers as arguments to @kbd{M-x -goto-line}. -@item -@kbd{M-x what-page} counts pages from the beginning of the file, and -counts lines within the page, printing both of them. @xref{Pages}, for -the command @kbd{C-x l}, which counts the lines in the current page. -@item -@kbd{M-=} (@code{count-lines-region}) prints the number of lines in -the region (@pxref{Mark}). -@end itemize - -@kindex C-x = -@findex what-cursor-position - The command @kbd{C-x =} (@code{what-cursor-position}) provides -information about point and about the column the cursor is in. -It prints a line in the echo area that looks like this: - -@example -Char: x (0170) point=65986 of 563027(12%) column 44 -@end example - -@noindent -(In fact, this is the output produced when point is before @samp{column 44} -in the example.) - - The two values after @samp{Char:} describe the character following point, -first by showing it and second by giving its octal character code. - - @samp{point=} is followed by the position of point expressed as a character -count. The front of the buffer counts as position 1, one character later -as 2, and so on. The next, larger number is the total number of characters -in the buffer. Afterward in parentheses comes the position expressed as a -percentage of the total size. - - @samp{column} is followed by the horizontal position of point, in columns -from the left edge of the window. - - If the buffer has been narrowed, making some of the text at the -beginning and the end temporarily invisible, @kbd{C-x =} prints -additional text describing the current visible range. For example, it -might say: - -@smallexample -Char: x (0170) point=65986 of 563025(12%) <65102 - 68533> column 44 -@end smallexample - -@noindent -where the two extra numbers give the smallest and largest character position -that point is allowed to assume. The characters between those two positions -are the visible ones. @xref{Narrowing}. - - If point is at the end of the buffer (or the end of the visible part), -@kbd{C-x =} omits any description of the character after point. -The output looks like - -@smallexample -point=563026 of 563025(100%) column 0 -@end smallexample - -@node Arguments,, Position Info, Basic -@section Numeric Arguments -@cindex numeric arguments - - Any Emacs command can be given a @dfn{numeric argument}. Some commands -interpret the argument as a repetition count. For example, giving an -argument of ten to the key @kbd{C-f} (the command @code{forward-char}, move -forward one character) moves forward ten characters. With these commands, -no argument is equivalent to an argument of one. Negative arguments are -allowed. Often they tell a command to move or act backwards. - -@kindex M-1 -@kindex M-@t{-} -@findex digit-argument -@findex negative-argument - If your keyboard has a @key{META} key (labelled with a diamond on -Sun-type keyboards and labelled @samp{Alt} on some other keyboards), the -easiest way to specify a numeric argument is to type digits and/or a -minus sign while holding down the @key{META} key. For example, -@example -M-5 C-n -@end example -@noindent -moves down five lines. The characters @kbd{Meta-1}, @kbd{Meta-2}, and -so on, as well as @kbd{Meta--}, do this because they are keys bound to -commands (@code{digit-argument} and @code{negative-argument}) that are -defined to contribute to an argument for the next command. - -@kindex C-u -@findex universal-argument - Another way of specifying an argument is to use the @kbd{C-u} -(@code{universal-argument}) command followed by the digits of the argument. -With @kbd{C-u}, you can type the argument digits without holding -down shift keys. To type a negative argument, start with a minus sign. -Just a minus sign normally means @minus{}1. @kbd{C-u} works on all terminals. - - @kbd{C-u} followed by a character which is neither a digit nor a minus -sign has the special meaning of ``multiply by four''. It multiplies the -argument for the next command by four. @kbd{C-u} twice multiplies it by -sixteen. Thus, @kbd{C-u C-u C-f} moves forward sixteen characters. This -is a good way to move forward ``fast'', since it moves about 1/5 of a line -in the usual size frame. Other useful combinations are @kbd{C-u C-n}, -@kbd{C-u C-u C-n} (move down a good fraction of a frame), @kbd{C-u C-u -C-o} (make ``a lot'' of blank lines), and @kbd{C-u C-k} (kill four -lines).@refill - - Some commands care only about whether there is an argument and not about -its value. For example, the command @kbd{M-q} (@code{fill-paragraph}) with -no argument fills text; with an argument, it justifies the text as well. -(@xref{Filling}, for more information on @kbd{M-q}.) Just @kbd{C-u} is a -handy way of providing an argument for such commands. - - Some commands use the value of the argument as a repeat count, but do -something peculiar when there is no argument. For example, the command -@kbd{C-k} (@code{kill-line}) with argument @var{n} kills @var{n} lines, -including their terminating newlines. But @kbd{C-k} with no argument is -special: it kills the text up to the next newline, or, if point is right at -the end of the line, it kills the newline itself. Thus, two @kbd{C-k} -commands with no arguments can kill a non-blank line, just like @kbd{C-k} -with an argument of one. (@xref{Killing}, for more information on -@kbd{C-k}.)@refill - - A few commands treat a plain @kbd{C-u} differently from an ordinary -argument. A few others may treat an argument of just a minus sign -differently from an argument of @minus{}1. These unusual cases will be -described when they come up; they are always to make the individual -command more convenient to use. - -@c section Autoarg Mode -@ignore -@cindex autoarg mode - Users of ASCII keyboards may prefer to use Autoarg mode. Autoarg mode -means that you don't need to type @kbd{C-u} to specify a numeric argument. -Instead, you type just the digits. Digits followed by an ordinary -inserting character are themselves inserted, but digits followed by an -Escape or Control character serve as an argument to it and are not -inserted. A minus sign can also be part of an argument, but only at the -beginning. If you type a minus sign following some digits, both the digits -and the minus sign are inserted. - - To use Autoarg mode, set the variable Autoarg Mode nonzero. -@xref{Variables}. - - Autoargument digits echo at the bottom of the frame; the first -nondigit causes them to be inserted or uses them as an argument. To -insert some digits and nothing else, you must follow them with a Space -and then rub it out. @kbd{C-g} cancels the digits, while Delete inserts -them all and then rubs out the last. -@end ignore diff --git a/man/xemacs/buffers.texi b/man/xemacs/buffers.texi deleted file mode 100644 index c6dcc9a..0000000 --- a/man/xemacs/buffers.texi +++ /dev/null @@ -1,311 +0,0 @@ - -@node Buffers, Windows, Files, Top -@chapter Using Multiple Buffers - -@cindex buffers - Text you are editing in Emacs resides in an object called a -@dfn{buffer}. Each time you visit a file, Emacs creates a buffer to -hold the file's text. Each time you invoke Dired, Emacs creates a buffer -to hold the directory listing. If you send a message with @kbd{C-x m}, -a buffer named @samp{*mail*} is used to hold the text of the message. -When you ask for a command's documentation, it appears in a buffer -called @samp{*Help*}. - -@cindex selected buffer -@cindex current buffer - At any time, one and only one buffer is @dfn{selected}. It is also -called the @dfn{current buffer}. Saying a command operates on ``the -buffer'' really means that the command operates on the selected -buffer, as most commands do. - - When Emacs creates multiple windows, each window has a chosen buffer which -is displayed there, but at any time only one of the windows is selected and -its chosen buffer is the selected buffer. Each window's mode line displays -the name of the buffer the window is displaying (@pxref{Windows}). - - Each buffer has a name which can be of any length but is -case-sensitive. You can select a buffer using its name. Most -buffers are created when you visit files; their names are derived from -the files' names. You can also create an empty buffer with any name you -want. A newly started Emacs has a buffer named @samp{*scratch*} which -you can use for evaluating Lisp expressions in Emacs. - - Each buffer records what file it is visiting, whether it is -modified, and what major mode and minor modes are in effect in it -(@pxref{Major Modes}). Any Emacs variable can be made @dfn{local to} a -particular buffer, meaning its value in that buffer can be different from -the value in other buffers. @xref{Locals}. - -@menu -* Select Buffer:: Creating a new buffer or reselecting an old one. -* List Buffers:: Getting a list of buffers that exist. -* Misc Buffer:: Renaming; changing read-onliness; copying text. -* Kill Buffer:: Killing buffers you no longer need. -* Several Buffers:: How to go through the list of all buffers - and operate variously on several of them. -@end menu - -@node Select Buffer, List Buffers, Buffers, Buffers -@section Creating and Selecting Buffers -@cindex changing buffers -@cindex switching buffers - -@table @kbd -@item C-x b @var{buffer} @key{RET} -Select or create a buffer named @var{buffer} (@code{switch-to-buffer}). -@item C-x 4 b @var{buffer} @key{RET} -Similar, but select a buffer named @var{buffer} in another window -(@code{switch-to-buffer-other-window}). -@item M-x switch-to-other-buffer @var{n} -Switch to the previous buffer. -@end table - -@kindex C-x 4 b -@kindex C-x 5 b -@findex switch-to-buffer-other-window -@kindex C-x b -@findex switch-to-buffer -@findex switch-to-buffer-other-frame - To select a buffer named @var{bufname}, type @kbd{C-x b @var{bufname} -@key{RET}}. This is the command @code{switch-to-buffer} with argument -@var{bufname}. You can use completion on an abbreviation for the buffer -name you want (@pxref{Completion}). An empty argument to @kbd{C-x b} -specifies the most recently selected buffer that is not displayed in any -window.@refill - - Most buffers are created when you visit files, or use Emacs commands -that display text. You can also create a buffer explicitly by typing -@kbd{C-x b @var{bufname} @key{RET}}, which creates a new, empty buffer -that is not visiting any file, and selects it for editing. The new -buffer's major mode is determined by the value of -@code{default-major-mode} (@pxref{Major Modes}). Buffers not visiting -files are usually used for making notes to yourself. If you try to save -one, you are asked for the file name to use. - - The function @code{switch-to-buffer-other-frame} is similar to -@code{switch-to-buffer} except that it creates a new frame in which to -display the selected buffer. - -@findex switch-to-other-buffer -Use @kbd{M-x switch-to-other-buffer} to visit the previous buffer. If -you supply a positive integer @var{n}, the @var{n}th most recent buffer -is displayed. If you supply an argument of 0, the current buffer is -moved to the bottom of the buffer stack. - - Note that you can also use @kbd{C-x C-f} and any other command for -visiting a file to switch buffers. @xref{Visiting}. - -@node List Buffers, Misc Buffer, Select Buffer, Buffers -@section Listing Existing Buffers - -@table @kbd -@item C-x C-b -List the existing buffers (@code{list-buffers}). -@end table - -@kindex C-x C-b -@findex list-buffers - To print a list of all existing buffers, type @kbd{C-x C-b}. Each -line in the list shows one buffer's name, major mode, and visited file. -A @samp{*} at the beginning of a line indicates the buffer has been -``modified''. If several buffers are modified, it may be time to save -some with @kbd{C-x s} (@pxref{Saving}). A @samp{%} indicates a read-only -buffer. A @samp{.} marks the selected buffer. Here is an example of a -buffer list:@refill - -@smallexample - MR Buffer Size Mode File - -- ------ ---- ---- ---- -.* emacs.tex 383402 Texinfo /u2/emacs/man/emacs.tex - *Help* 1287 Fundamental - files.el 23076 Emacs-Lisp /u2/emacs/lisp/files.el - % RMAIL 64042 RMAIL /u/rms/RMAIL - *% man 747 Dired /u2/emacs/man/ - net.emacs 343885 Fundamental /u/rms/net.emacs - fileio.c 27691 C /u2/emacs/src/fileio.c - NEWS 67340 Text /u2/emacs/etc/NEWS - *scratch* 0 Lisp Interaction -@end smallexample - -@noindent -Note that the buffer @samp{*Help*} was made by a help request; it is not -visiting any file. The buffer @code{man} was made by Dired on the -directory @file{/u2/emacs/man/}. - -As you move the mouse over the @samp{*Buffer List*} buffer, the lines -are highlighted. This visual cue indicates that clicking the right -mouse button (@code{button3}) will pop up a menu of commands on the -buffer represented by this line. This menu duplicates most of those -commands which are bound to keys in the @samp{*Buffer List*} buffer. - -@node Misc Buffer, Kill Buffer, List Buffers, Buffers -@section Miscellaneous Buffer Operations - -@table @kbd -@item C-x C-q -Toggle read-only status of buffer (@code{toggle-read-only}). -@item M-x rename-buffer -Change the name of the current buffer. -@item M-x view-buffer -Scroll through a buffer. -@end table - -@cindex read-only buffer -@kindex C-x C-q -@findex toggle-read-only -@vindex buffer-read-only - A buffer can be @dfn{read-only}, which means that commands to change -its text are not allowed. Normally, read-only buffers are created by -subsystems such as Dired and Rmail that have special commands to operate -on the text. Emacs also creates a read-only buffer if you -visit a file that is protected. To make changes in a read-only buffer, -use the command @kbd{C-x C-q} (@code{toggle-read-only}). It makes a -read-only buffer writable, and makes a writable buffer read-only. This -works by setting the variable @code{buffer-read-only}, which has a local -value in each buffer and makes a buffer read-only if its value is -non-@code{nil}. - -@findex rename-buffer - @kbd{M-x rename-buffer} changes the name of the current buffer, -prompting for the new name in the minibuffer. There is no default. If you -specify a name that is used by a different buffer, an error is signalled and -renaming is not done. - -@findex view-buffer - @kbd{M-x view-buffer} is similar to @kbd{M-x view-file} (@pxref{Misc -File Ops}), but it examines an already existing Emacs buffer. View mode -provides convenient commands for scrolling through the buffer but not -for changing it. When you exit View mode, the resulting value of point -remains in effect. - -To copy text from one buffer to another, use the commands @kbd{M-x -append-to-buffer} and @kbd{M-x insert-buffer}. @xref{Accumulating -Text}.@refill - -@node Kill Buffer, Several Buffers, Misc Buffer, Buffers -@section Killing Buffers - - After using Emacs for a while, you may accumulate a large number of -buffers and may want to eliminate the ones you no -longer need. There are several commands for doing this. - -@c WideCommands -@table @kbd -@item C-x k -Kill a buffer, specified by name (@code{kill-buffer}). -@item M-x kill-some-buffers -Offer to kill each buffer, one by one. -@end table - -@findex kill-buffer -@findex kill-some-buffers -@kindex C-x k - - @kbd{C-x k} (@code{kill-buffer}) kills one buffer, whose name you -specify in the minibuffer. If you type just @key{RET} in the -minibuffer, the default, killing the current buffer, is used. If the -current buffer is killed, the buffer that has been selected recently but -does not appear in any window now is selected. If the buffer being -killed contains unsaved changes, you are asked to confirm with @kbd{yes} -before the buffer is killed. - - The command @kbd{M-x kill-some-buffers} asks about each buffer, one by -one. An answer of @kbd{y} means to kill the buffer. Killing the current -buffer or a buffer containing unsaved changes selects a new buffer or asks -for confirmation just like @code{kill-buffer}. - -@node Several Buffers,, Kill Buffer, Buffers -@section Operating on Several Buffers -@cindex buffer menu - - The @dfn{buffer-menu} facility is like a ``Dired for buffers''; it allows -you to request operations on various Emacs buffers by editing a -buffer containing a list of them. You can save buffers, kill them -(here called @dfn{deleting} them, for consistency with Dired), or display -them. - -@table @kbd -@item M-x buffer-menu -Begin editing a buffer listing all Emacs buffers. -@end table - -@findex buffer-menu - The command @code{buffer-menu} writes a list of all Emacs buffers into -the buffer @samp{*Buffer List*}, and selects that buffer in Buffer Menu -mode. The buffer is read-only. You can only change it using the special -commands described in this section. Most of the commands are graphic -characters. You can use Emacs cursor motion commands in the -@samp{*Buffer List*} buffer. If the cursor is on a line describing a -buffer, the following special commands apply to that buffer: - -@table @kbd -@item d -Request to delete (kill) the buffer, then move down. A @samp{D} before -the buffer name on a line indicates a deletion request. Requested -deletions actually take place when you use the @kbd{x} command. -@item k -Synonym for @kbd{d}. -@item C-d -Like @kbd{d} but move up afterwards instead of down. -@item s -Request to save the buffer. An @samp{S} befor the buffer name on a line -indicates the request. Requested saves actually take place when you use -the @kbd{x} command. You can request both saving and deletion for the -same buffer. -@item ~ -Mark buffer ``unmodified''. The command @kbd{~} does this -immediately when typed. -@item x -Perform previously requested deletions and saves. -@item u -Remove any request made for the current line, and move down. -@item @key{DEL} -Move to previous line and remove any request made for that line. -@end table - - All commands that add or remove flags to request later operations -also move down a line. They accept a numeric argument as a repeat count, -unless otherwise specified. - - There are also special commands to use the buffer list to select another -buffer, and to specify one or more other buffers for display in additional -windows. - -@table @kbd -@item 1 -Select the buffer in a full-frame window. This command takes effect -immediately. -@item 2 -Immediately set up two windows, with this buffer in one and the -buffer selected before @samp{*Buffer List*} in the other. -@item f -Immediately select the buffer in place of the @samp{*Buffer List*} buffer. -@item o -Immediately select the buffer in another window as if by @kbd{C-x 4 b}, -leaving @samp{*Buffer List*} visible. -@item q -Immediately select this buffer, and display any buffers previously -flagged with the @kbd{m} command in other windows. If there are no -buffers flagged with @kbd{m}, this command is equivalent to @kbd{1}. -@item m -Flag this buffer to be displayed in another window if the @kbd{q} -command is used. The request shows as a @samp{>} at the beginning of -the line. The same buffer may not have both a delete request and a -display request. -@end table - - Going back between a @code{buffer-menu} buffer and other Emacs buffers is -easy. You can, for example, switch from the @samp{*Buffer List*} -buffer to another Emacs buffer, and edit there. You can then reselect the -@code{buffer-menu} buffer and perform operations already -requested, or you can kill that buffer or pay no further attention to it. - All that @code{buffer-menu} does directly is create and select a -suitable buffer, and turn on Buffer Menu mode. All the other -capabilities of the buffer menu are implemented by special commands -provided in Buffer Menu mode. - - The only difference between @code{buffer-menu} and @code{list-buffers} is -that @code{buffer-menu} selects the @samp{*Buffer List*} buffer and -@code{list-buffers} does not. If you run @code{list-buffers} (that is, -type @kbd{C-x C-b}) and select the buffer list manually, you can use all -the commands described here. diff --git a/man/xemacs/building.texi b/man/xemacs/building.texi deleted file mode 100644 index 1197097..0000000 --- a/man/xemacs/building.texi +++ /dev/null @@ -1,613 +0,0 @@ - -@node Running, Packages, Programs, Top -@chapter Compiling and Testing Programs - - The previous chapter discusses the Emacs commands that are useful for -making changes in programs. This chapter deals with commands that assist -in the larger process of developing and maintaining programs. - -@menu -* Compilation:: Compiling programs in languages other than Lisp - (C, Pascal, etc.) -* Modes: Lisp Modes. Various modes for editing Lisp programs, with - different facilities for running the Lisp programs. -* Libraries: Lisp Libraries. Creating Lisp programs to run in Emacs. -* Eval: Lisp Eval. Executing a single Lisp expression in Emacs. -* Debug: Lisp Debug. Debugging Lisp programs running in Emacs. -* Interaction: Lisp Interaction. Executing Lisp in an Emacs buffer. -* External Lisp:: Communicating through Emacs with a separate Lisp. -@end menu - -@node Compilation, Lisp Modes, Running, Running -@section Running ``make'', or Compilers Generally -@cindex inferior process -@cindex make -@cindex compilation errors -@cindex error log - - Emacs can run compilers for non-interactive languages like C and -Fortran as inferior processes, feeding the error log into an Emacs buffer. -It can also parse the error messages and visit the files in which errors -are found, moving point to the line where the error occurred. - -@table @kbd -@item M-x compile -Run a compiler asynchronously under Emacs, with error messages to -@samp{*compilation*} buffer. -@item M-x grep -Run @code{grep} asynchronously under Emacs, with matching lines -listed in the buffer named @samp{*compilation*}. -@item M-x kill-compilation -Kill the process made by the @code{M-x compile} command. -@item M-x kill-grep -Kill the running compilation or @code{grep} subprocess. -@item C-x ` -Visit the next compiler error message or @code{grep} match. -@end table - -@findex compile - To run @code{make} or another compiler, type @kbd{M-x compile}. This -command reads a shell command line using the minibuffer, then executes -the specified command line in an inferior shell with output going to the -buffer named @samp{*compilation*}. By default, the current buffer's -default directory is used as the working directory for the execution of -the command; therefore, the makefile comes from this directory. - -@vindex compile-command - When the shell command line is read, the minibuffer appears containing a -default command line (the command you used the last time you typed -@kbd{M-x compile}). If you type just @key{RET}, the same command line is used -again. The first @kbd{M-x compile} provides @code{make -k} as the default. -The default is taken from the variable @code{compile-command}; if the -appropriate compilation command for a file is something other than -@code{make -k}, it can be useful to have the file specify a local value for -@code{compile-command} (@pxref{File Variables}). - -@cindex compiling files - When you start a compilation, the buffer @samp{*compilation*} is -displayed in another window but not selected. Its mode line displays -the word @samp{run} or @samp{exit} in the parentheses to tell you whether -compilation is finished. You do not have to keep this buffer visible; -compilation continues in any case. - -@findex kill-compilation - To kill the compilation process, type @kbd{M-x-kill-compilation}. The mode -line of the @samp{*compilation*} buffer changes to say @samp{signal} -instead of @samp{run}. Starting a new compilation also kills any -running compilation, as only one can occur at any time. Starting a new -compilation prompts for confirmation before actually killing a -compilation that is running.@refill - -@kindex C-x ` -@findex next-error - To parse the compiler error messages, type @kbd{C-x `} -(@code{next-error}). The character following @kbd{C-x} is the grave -accent, not the single quote. The command displays the buffer -@samp{*compilation*} in one window and the buffer in which the next -error occurred in another window. Point in that buffer is moved to the -line where the error was found. The corresponding error message is -scrolled to the top of the window in which @samp{*compilation*} is -displayed. - - The first time you use @kbd{C-x `} after the start of a compilation, it -parses all the error messages, visits all the files that have error -messages, and creates markers pointing at the lines the error messages -refer to. It then moves to the first error message location. Subsequent -uses of @kbd{C-x `} advance down the data set up by the first use. When -the preparsed error messages are exhausted, the next @kbd{C-x `} checks for -any more error messages that have come in; this is useful if you start -editing compiler errors while compilation is still going on. If no -additional error messages have come in, @kbd{C-x `} reports an error. - - @kbd{C-u C-x `} discards the preparsed error message data and parses the -@samp{*compilation*} buffer again, then displays the first error. -This way, you can process the same set of errors again. - - Instead of running a compiler, you can run @code{grep} and see the -lines on which matches were found. To do this, type @kbd{M-x grep} with -an argument line that contains the same arguments you would give to -@code{grep}: a @code{grep}-style regexp (usually in single quotes to -quote the shell's special characters) followed by filenames, which may -use wildcard characters. The output from @code{grep} goes in the -@samp{*compilation*} buffer. You can use @kbd{C-x `} to find the lines that -match as if they were compilation errors. - - Note: a shell is used to run the compile command, but the shell is not -run in interactive mode. In particular, this means that the shell starts -up with no prompt. If you find your usual shell prompt making an -unsightly appearance in the @samp{*compilation*} buffer, it means you -have made a mistake in your shell's initialization file (@file{.cshrc} -or @file{.shrc} or @dots{}) by setting the prompt unconditionally. The -shell initialization file should set the prompt only if there already is -a prompt. Here's how to do it in @code{csh}: - -@example -if ($?prompt) set prompt = ... -@end example - -@node Lisp Modes, Lisp Libraries, Compilation, Running -@section Major Modes for Lisp - - Emacs has four different major modes for Lisp. They are the same in -terms of editing commands, but differ in the commands for executing Lisp -expressions. - -@table @asis -@item Emacs-Lisp mode -The mode for editing source files of programs to run in Emacs Lisp. -This mode defines @kbd{C-M-x} to evaluate the current defun. -@xref{Lisp Libraries}. -@item Lisp Interaction mode -The mode for an interactive session with Emacs Lisp. It defines -@key{LFD} to evaluate the sexp before point and insert its value in the -buffer. @xref{Lisp Interaction}. -@item Lisp mode -The mode for editing source files of programs that run in other dialects -of Lisp than Emacs Lisp. This mode defines @kbd{C-M-x} to send the -current defun to an inferior Lisp process. @xref{External Lisp}. -@item Inferior Lisp mode -The mode for an interactive session with an inferior Lisp process. -This mode combines the special features of Lisp mode and Shell mode -(@pxref{Shell Mode}). -@item Scheme mode -Like Lisp mode but for Scheme programs. -@item Inferior Scheme mode -The mode for an interactive session with an inferior Scheme process. -@end table - -@node Lisp Libraries, Lisp Eval, Lisp Modes, Running -@section Libraries of Lisp Code for Emacs -@cindex libraries -@cindex loading Lisp code - - Lisp code for Emacs editing commands is stored in files whose names -conventionally end in @file{.el}. This ending tells Emacs to edit them in -Emacs-Lisp mode (@pxref{Lisp Modes}). - -@menu -* Loading:: Loading libraries of Lisp code into Emacs for use. -* Compiling Libraries:: Compiling a library makes it load and run faster. -* Mocklisp:: Converting Mocklisp to Lisp so XEmacs can run it. -@end menu - -@node Loading, Compiling Libraries, Lisp Libraries, Lisp Libraries -@subsection Loading Libraries - -@table @kbd -@item M-x load-file @var{file} -Load the file @var{file} of Lisp code. -@item M-x load-library @var{library} -Load the library named @var{library}. -@item M-x locate-library @var{library} &optional @var{nosuffix} -Show the full path name of Emacs library @var{library}. -@end table - -@findex load-file - To execute a file of Emacs Lisp, use @kbd{M-x load-file}. This -command reads the file name you provide in the minibuffer, then executes -the contents of that file as Lisp code. It is not necessary to visit -the file first; in fact, this command reads the file as found on -disk, not the text in an Emacs buffer. - -@findex load -@findex load-library - Once a file of Lisp code is installed in the Emacs Lisp library -directories, users can load it using @kbd{M-x load-library}. Programs can -load it by calling @code{load-library}, or with @code{load}, a more primitive -function that is similar but accepts some additional arguments. - - @kbd{M-x load-library} differs from @kbd{M-x load-file} in that it -searches a sequence of directories and tries three file names in each -directory. The three names are: first, the specified name with @file{.elc} -appended; second, the name with @file{.el} appended; third, the specified -name alone. A @file{.elc} file would be the result of compiling the Lisp -file into byte code; if possible, it is loaded in preference to the Lisp -file itself because the compiled file loads and runs faster. - -@cindex loading libraries - Because the argument to @code{load-library} is usually not in itself -a valid file name, file name completion is not available. In fact, when -using this command, you usually do not know exactly what file name -will be used. - -@vindex load-path - The sequence of directories searched by @kbd{M-x load-library} is -specified by the variable @code{load-path}, a list of strings that are -directory names. The elements of this list may not begin with "@samp{~}", -so you must call @code{expand-file-name} on them before adding them to -the list. The default value of the list contains the directory where -the Lisp code for Emacs itself is stored. If you have libraries of your -own, put them in a single directory and add that directory to -@code{load-path}. @code{nil} in this list stands for the current -default directory, but it is probably not a good idea to put @code{nil} -in the list. If you start wishing that @code{nil} were in the list, you -should probably use @kbd{M-x load-file} for this case. - -The variable is initialized by the @b{EMACSLOADPATH} environment -variable. If no value is specified, the variable takes the default value -specified in the file @file{paths.h} when Emacs was built. If a path -isn't specified in @file{paths.h}, a default value is obtained from the -file system, near the directory in which the Emacs executable resides. - -@findex locate-library - Like @kbd{M-x load-library}, @kbd{M-x locate-library} searches the -directories in @code{load-path} to find the file that @kbd{M-x load-library} -would load. If the optional second argument @var{nosuffix} is -non-@code{nil}, the suffixes @file{.elc} or @file{.el} are not added to -the specified name @var{library} (like calling @code{load} instead of -@code{load-library}). - -@cindex autoload - You often do not have to give any command to load a library, because the -commands defined in the library are set up to @dfn{autoload} that library. -Running any of those commands causes @code{load} to be called to load the -library; this replaces the autoload definitions with the real ones from the -library. - - If autoloading a file does not finish, either because of an error or -because of a @kbd{C-g} quit, all function definitions made by the file -are undone automatically. So are any calls to @code{provide}. As a -consequence, the entire file is loaded a second time if you use one of -the autoloadable commands again. This prevents problems when the -command is no longer autoloading but is working incorrectly because the file -was only partially loaded. Function definitions are undone only for -autoloading; explicit calls to @code{load} do not undo anything if -loading is not completed. - -@vindex after-load-alist -The variable @code{after-load-alist} takes an alist of expressions to be -evaluated when particular files are loaded. Each element has the form -@code{(@var{filename} forms...)}. When @code{load} is run and the filename -argument is @var{filename}, the forms in the corresponding element are -executed at the end of loading. - -@var{filename} must match exactly. Normally @var{filename} is the -name of a library, with no directory specified, since that is how load -is normally called. An error in @code{forms} does not undo the load, but -it does prevent execution of the rest of the @code{forms}. - -@node Compiling Libraries, Mocklisp, Loading, Lisp Libraries -@subsection Compiling Libraries - -@cindex byte code - Emacs Lisp code can be compiled into byte-code which loads faster, -takes up less space when loaded, and executes faster. - -@table @kbd -@item M-x batch-byte-compile -Run byte-compile-file on the files remaining on the command line. -@item M-x byte-compile-buffer &optional @var{buffer} -Byte-compile and evaluate contents of @var{buffer} (default is current -buffer). -@item M-x byte-compile-file -Compile a file of Lisp code named @var{filename} into a file of byte code. -@item M-x byte-compile-and-load-file @var{filename} -Compile a file of Lisp code named @var{filename} into a file of byte -code and load it. -@item M-x byte-recompile-directory @var{directory} -Recompile every @file{.el} file in @var{directory} that needs recompilation. -@item M-x disassemble -Print disassembled code for @var{object} on (optional) @var{stream}. -@findex make-obsolete -@item M-x make-obsolete @var{function new} -Make the byte-compiler warn that @var{function} is obsolete and @var{new} -should be used instead. -@end table - -@findex byte-compile-file -@findex byte-compile-and-load-file -@findex byte-compile-buffer - @kbd{byte-compile-file} creates a byte-code compiled file from an -Emacs-Lisp source file. The default argument for this function is the -file visited in the current buffer. The function reads the specified -file, compiles it into byte code, and writes an output file whose name -is made by appending @file{c} to the input file name. Thus, the file -@file{rmail.el} would be compiled into @file{rmail.elc}. To compile a -file of Lisp code named @var{filename} into a file of byte code and -then load it, use @code{byte-compile-and-load-file}. To compile and -evaluate Lisp code in a given buffer, use @code{byte-compile-buffer}. - -@findex byte-recompile-directory - To recompile all changed Lisp files in a directory, use @kbd{M-x -byte-recompile-directory}. Specify just the directory name as an argument. -Each @file{.el} file that has been byte-compiled before is byte-compiled -again if it has changed since the previous compilation. A numeric argument -to this command tells it to offer to compile each @file{.el} file that has -not been compiled yet. You must answer @kbd{y} or @kbd{n} to each -offer. - -@findex batch-byte-compile - You can use the function @code{batch-byte-compile} to invoke Emacs -non-interactively from the shell to do byte compilation. When you use -this function, the files to be compiled are specified with command-line -arguments. Use a shell command of the form: - -@example -emacs -batch -f batch-byte-compile @var{files}... -@end example - - Directory names may also be given as arguments; in that case, -@code{byte-recompile-directory} is invoked on each such directory. -@code{batch-byte-compile} uses all remaining command-line arguments as -file or directory names, then kills the Emacs process. - -@findex disassemble - @kbd{M-x disassemble} explains the result of byte compilation. Its -argument is a function name. It displays the byte-compiled code in a help -window in symbolic form, one instruction per line. If the instruction -refers to a variable or constant, that is shown, too. - -@node Mocklisp,,Compiling Libraries,Lisp Libraries -@subsection Converting Mocklisp to Lisp - -@cindex mocklisp -@findex convert-mocklisp-buffer - XEmacs can run Mocklisp files by converting them to Emacs Lisp first. -To convert a Mocklisp file, visit it and then type @kbd{M-x -convert-mocklisp-buffer}. Then save the resulting buffer of Lisp file in a -file whose name ends in @file{.el} and use the new file as a Lisp library. - - You cannot currently byte-compile converted Mocklisp code. -The reason is that converted Mocklisp code uses some special Lisp features -to deal with Mocklisp's incompatible ideas of how arguments are evaluated -and which values signify ``true'' or ``false''. - -@node Lisp Eval, Lisp Debug, Lisp Libraries, Running -@section Evaluating Emacs-Lisp Expressions -@cindex Emacs-Lisp mode - -@findex emacs-lisp-mode - Lisp programs intended to be run in Emacs should be edited in -Emacs-Lisp mode; this will happen automatically for file names ending in -@file{.el}. By contrast, Lisp mode itself should be used for editing -Lisp programs intended for other Lisp systems. Emacs-Lisp mode can be -selected with the command @kbd{M-x emacs-lisp-mode}. - - For testing of Lisp programs to run in Emacs, it is useful to be able -to evaluate part of the program as it is found in the Emacs buffer. For -example, if you change the text of a Lisp function definition and then -evaluate the definition, Emacs installs the change for future calls to the -function. Evaluation of Lisp expressions is also useful in any kind of -editing task for invoking non-interactive functions (functions that are -not commands). - -@table @kbd -@item M-@key{ESC} -Read a Lisp expression in the minibuffer, evaluate it, and print the -value in the minibuffer (@code{eval-expression}). -@item C-x C-e -Evaluate the Lisp expression before point, and print the value in the -minibuffer (@code{eval-last-sexp}). -@item C-M-x -Evaluate the defun containing point or after point, and print the value in -the minibuffer (@code{eval-defun}). -@item M-x eval-region -Evaluate all the Lisp expressions in the region. -@item M-x eval-current-buffer -Evaluate all the Lisp expressions in the buffer. -@end table - -@kindex M-ESC -@findex eval-expression - @kbd{M-@key{ESC}} (@code{eval-expression}) is the most basic command -for evaluating a Lisp expression interactively. It reads the expression -using the minibuffer, so you can execute any expression on a buffer -regardless of what the buffer contains. When evaluation is complete, -the current buffer is once again the buffer that was current when -@kbd{M-@key{ESC}} was typed. - - @kbd{M-@key{ESC}} can easily confuse users, especially on keyboards -with autorepeat, where it can result from holding down the @key{ESC} key -for too long. Therefore, @code{eval-expression} is normally a disabled -command. Attempting to use this command asks for confirmation and gives -you the option of enabling it; once you enable the command, you are no -longer required to confirm. @xref{Disabling}.@refill - -@kindex C-M-x -@findex eval-defun - In Emacs-Lisp mode, the key @kbd{C-M-x} is bound to the function -@code{eval-defun}, which parses the defun containing point or following point -as a Lisp expression and evaluates it. The value is printed in the echo -area. This command is convenient for installing in the Lisp environment -changes that you have just made in the text of a function definition. - -@kindex C-x C-e -@findex eval-last-sexp - The command @kbd{C-x C-e} (@code{eval-last-sexp}) performs a similar job -but is available in all major modes, not just Emacs-Lisp mode. It finds -the sexp before point, reads it as a Lisp expression, evaluates it, and -prints the value in the echo area. It is sometimes useful to type in an -expression and then, with point still after it, type @kbd{C-x C-e}. - - If @kbd{C-M-x} or @kbd{C-x C-e} are given a numeric argument, they -print the value by inserting it into the current buffer at point, rather -than in the echo area. The argument value does not matter. - -@findex eval-region -@findex eval-current-buffer - The most general command for evaluating Lisp expressions from a buffer -is @code{eval-region}. @kbd{M-x eval-region} parses the text of the -region as one or more Lisp expressions, evaluating them one by one. -@kbd{M-x eval-current-buffer} is similar, but it evaluates the entire -buffer. This is a reasonable way to install the contents of a file of -Lisp code that you are just ready to test. After finding and fixing a -bug, use @kbd{C-M-x} on each function that you change, to keep the Lisp -world in step with the source file. - -@node Lisp Debug, Lisp Interaction, Lisp Eval, Running -@section The Emacs-Lisp Debugger -@cindex debugger - -@vindex debug-on-error -@vindex debug-on-quit - XEmacs contains a debugger for Lisp programs executing inside it. -This debugger is normally not used; many commands frequently get Lisp -errors when invoked in inappropriate contexts (such as @kbd{C-f} at the -end of the buffer) and it would be unpleasant to enter a special -debugging mode in this case. When you want to make Lisp errors invoke -the debugger, you must set the variable @code{debug-on-error} to -non-@code{nil}. Quitting with @kbd{C-g} is not considered an error, and -@code{debug-on-error} has no effect on the handling of @kbd{C-g}. -However, if you set @code{debug-on-quit} to be non-@code{nil}, @kbd{C-g} will -invoke the debugger. This can be useful for debugging an infinite loop; -type @kbd{C-g} once the loop has had time to reach its steady state. -@code{debug-on-quit} has no effect on errors.@refill - -@findex debug-on-entry -@findex cancel-debug-on-entry -@findex debug - You can make Emacs enter the debugger when a specified function -is called or at a particular place in Lisp code. Use @kbd{M-x -debug-on-entry} with argument @var{fun-name} to have Emacs enter the -debugger as soon as @var{fun-name} is called. Use -@kbd{M-x cancel-debug-on-entry} to make the function stop entering the -debugger when called. (Redefining the function also does this.) To enter -the debugger from some other place in Lisp code, you must insert the -expression @code{(debug)} there and install the changed code with -@kbd{C-M-x}. @xref{Lisp Eval}.@refill - - When the debugger is entered, it displays the previously selected buffer -in one window and a buffer named @samp{*Backtrace*} in another window. The -backtrace buffer contains one line for each level of Lisp function -execution currently going on. At the beginning of the buffer is a message -describing the reason that the debugger was invoked, for example, an -error message if it was invoked due to an error. - - The backtrace buffer is read-only and is in Backtrace mode, a special -major mode in which letters are defined as debugger commands. The -usual Emacs editing commands are available; you can switch windows to -examine the buffer that was being edited at the time of the error, and -you can switch buffers, visit files, and perform any other editing -operations. However, the debugger is a recursive editing level -(@pxref{Recursive Edit}); it is a good idea to return to the backtrace -buffer and explictly exit the debugger when you don't want to use it any -more. Exiting the debugger kills the backtrace buffer. - -@cindex current stack frame - The contents of the backtrace buffer show you the functions that are -executing and the arguments that were given to them. It also allows you -to specify a stack frame by moving point to the line describing that -frame. The frame whose line point is on is considered the @dfn{current -frame}. Some of the debugger commands operate on the current frame. -Debugger commands are mainly used for stepping through code one -expression at a time. Here is a list of them: - -@table @kbd -@item c -Exit the debugger and continue execution. In most cases, execution of -the program continues as if the debugger had never been entered (aside -from the effect of any variables or data structures you may have changed -while inside the debugger). This includes entry to the debugger due to -function entry or exit, explicit invocation, and quitting or certain -errors. Most errors cannot be continued; trying to continue an error usually -causes the same error to occur again. -@item d -Continue execution, but enter the debugger the next time a Lisp -function is called. This allows you to step through the -subexpressions of an expression, and see what the subexpressions do and -what values they compute. - -When you enter the debugger this way, Emacs flags the stack frame for the -function call from which you entered. The same function is then called -when you exit the frame. To cancel this flag, use @kbd{u}. -@item b -Set up to enter the debugger when the current frame is exited. Frames -that invoke the debugger on exit are flagged with stars. -@item u -Don't enter the debugger when the current frame is exited. This -cancels a @kbd{b} command on a frame. -@item e -Read a Lisp expression in the minibuffer, evaluate it, and print the -value in the echo area. This is equivalent to the command @kbd{M-@key{ESC}}, -except that @kbd{e} is not normally disabled like @kbd{M-@key{ESC}}. -@item q -Terminate the program being debugged; return to top-level Emacs -command execution. - -If the debugger was entered due to a @kbd{C-g} but you really want -to quit, not to debug, use the @kbd{q} command. -@item r -Return a value from the debugger. The value is computed by reading an -expression with the minibuffer and evaluating it. - -The value returned by the debugger makes a difference when the debugger -was invoked due to exit from a Lisp call frame (as requested with @kbd{b}); -then the value specified in the @kbd{r} command is used as the value of -that frame. - -The debugger's return value also matters with many errors. For example, -@code{wrong-type-argument} errors will use the debugger's return value -instead of the invalid argument; @code{no-catch} errors will use the -debugger value as a throw tag instead of the tag that was not found. -If an error was signaled by calling the Lisp function @code{signal}, -the debugger's return value is returned as the value of @code{signal}. -@end table - -@node Lisp Interaction, External Lisp, Lisp Debug, Running -@section Lisp Interaction Buffers - - The buffer @samp{*scratch*}, which is selected when Emacs starts up, is -provided for evaluating Lisp expressions interactively inside Emacs. Both -the expressions you evaluate and their output goes in the buffer. - - The @samp{*scratch*} buffer's major mode is Lisp Interaction mode, which -is the same as Emacs-Lisp mode except for one command, @key{LFD}. In -Emacs-Lisp mode, @key{LFD} is an indentation command. In Lisp -Interaction mode, @key{LFD} is bound to @code{eval-print-last-sexp}. This -function reads the Lisp expression before point, evaluates it, and inserts -the value in printed representation before point. - - The way to use the @samp{*scratch*} buffer is to insert Lisp -expressions at the end, ending each one with @key{LFD} so that it will -be evaluated. The result is a complete typescript of the expressions -you have evaluated and their values. - -@findex lisp-interaction-mode - The rationale for this feature is that Emacs must have a buffer when it -starts up, but that buffer is not useful for editing files since a new -buffer is made for every file that you visit. The Lisp interpreter -typescript is the most useful thing I can think of for the initial buffer -to do. @kbd{M-x lisp-interaction-mode} will put any buffer in Lisp -Interaction mode. - -@node External Lisp,, Lisp Interaction, Running -@section Running an External Lisp - - Emacs has facilities for running programs in other Lisp systems. You can -run a Lisp process as an inferior of Emacs, and pass expressions to it to -be evaluated. You can also pass changed function definitions directly from -the Emacs buffers in which you edit the Lisp programs to the inferior Lisp -process. - -@findex run-lisp - To run an inferior Lisp process, type @kbd{M-x run-lisp}. This runs the -program named @code{lisp}, the same program you would run by typing -@code{lisp} as a shell command, with both input and output going through an -Emacs buffer named @samp{*lisp*}. In other words, any ``terminal output'' -from Lisp will go into the buffer, advancing point, and any ``terminal -input'' for Lisp comes from text in the buffer. To give input to Lisp, go -to the end of the buffer and type the input, terminated by @key{RET}. The -@samp{*lisp*} buffer is in Inferior Lisp mode, which has all the -special characteristics of Lisp mode and Shell mode (@pxref{Shell Mode}). - -@findex lisp-mode - Use Lisp mode to run the source files of programs in external Lisps. -You can select this mode with @kbd{M-x lisp-mode}. It is used automatically -for files whose names end in @file{.l} or @file{.lisp}, as most Lisp -systems usually expect. - -@kindex C-M-x -@findex lisp-send-defun - When you edit a function in a Lisp program you are running, the easiest -way to send the changed definition to the inferior Lisp process is the key -@kbd{C-M-x}. In Lisp mode, this key runs the function @code{lisp-send-defun}, -which finds the defun around or following point and sends it as input to -the Lisp process. (Emacs can send input to any inferior process regardless -of what buffer is current.) - - Contrast the meanings of @kbd{C-M-x} in Lisp mode (for editing programs -to be run in another Lisp system) and Emacs-Lisp mode (for editing Lisp -programs to be run in Emacs): in both modes it has the effect of installing -the function definition that point is in, but the way of doing so is -different according to where the relevant Lisp environment is found. -@xref{Lisp Modes}. diff --git a/man/xemacs/calendar.texi b/man/xemacs/calendar.texi deleted file mode 100644 index d935a1d..0000000 --- a/man/xemacs/calendar.texi +++ /dev/null @@ -1,2304 +0,0 @@ -@node Calendar/Diary, Sorting, Reading Mail, Top -@section Calendar Mode and the Diary -@cindex calendar -@findex calendar - - Emacs provides the functions of a desk calendar, with a diary of -planned or past events. To enter the calendar, type @kbd{M-x calendar}; -this displays a three-month calendar centered on the current month, with -point on the current date. With a numeric argument, as in @kbd{C-u M-x -calendar}, it prompts you for the month and year to be the center of the -three-month calendar. The calendar uses its own buffer, whose major -mode is Calendar mode. - - @kbd{Button2} in the calendar brings up a menu of operations on a -particular date; @kbd{Buttons3} brings up a menu of commonly used -calendar features that are independent of any particular date. To exit -the calendar, type @kbd{q}. @xref{Calendar, Customizing the Calendar -and Diary,, elisp, The Emacs Lisp Reference Manual}, for customization -information about the calendar and diary. - -@menu -* Calendar Motion:: Moving through the calendar; selecting a date. -* Scroll Calendar:: Bringing earlier or later months onto the screen. -* Mark and Region:: Remembering dates, the mark ring. -* General Calendar:: Exiting or recomputing the calendar. -* LaTeX Calendar:: Print a calendar using LaTeX. -* Holidays:: Displaying dates of holidays. -* Sunrise/Sunset:: Displaying local times of sunrise and sunset. -* Lunar Phases:: Displaying phases of the moon. -* Other Calendars:: Converting dates to other calendar systems. -* Diary:: Displaying events from your diary. -* Calendar Customization:: Altering the behavior of the features above. -@end menu - -@node Calendar Motion, Scroll Calendar, Calendar/Diary, Calendar/Diary -@subsection Movement in the Calendar - -@cindex moving inside the calendar - Calendar mode lets you move through the calendar in logical units of -time such as days, weeks, months, and years. If you move outside the -three months originally displayed, the calendar display ``scrolls'' -automatically through time to make the selected date visible. Moving to -a date lets you view its holidays or diary entries, or convert it to other -calendars; moving longer time periods is also useful simply to scroll the -calendar. - -@menu -* Calendar Unit Motion:: Moving by days, weeks, months, and years. -* Move to Beginning or End:: Moving to start/end of weeks, months, and years. -* Specified Dates:: Moving to the current date or another - specific date. -@end menu - -@node Calendar Unit Motion, Move to Beginning or End, Calendar Motion, Calendar Motion -@subsubsection Motion by Integral Days, Weeks, Months, Years - - The commands for movement in the calendar buffer parallel the -commands for movement in text. You can move forward and backward by -days, weeks, months, and years. - -@table @kbd -@item C-f -Move point one day forward (@code{calendar-forward-day}). -@item C-b -Move point one day backward (@code{calendar-backward-day}). -@item C-n -Move point one week forward (@code{calendar-forward-week}). -@item C-p -Move point one week backward (@code{calendar-backward-week}). -@item M-@} -Move point one month forward (@code{calendar-forward-month}). -@item M-@{ -Move point one month backward (@code{calendar-backward-month}). -@item C-x ] -Move point one year forward (@code{calendar-forward-year}). -@item C-x [ -Move point one year backward (@code{calendar-backward-year}). -@end table - -@kindex C-f @r{(Calendar mode)} -@findex calendar-forward-day -@kindex C-b @r{(Calendar mode)} -@findex calendar-backward-day -@kindex C-n @r{(Calendar mode)} -@findex calendar-forward-week -@kindex C-p @r{(Calendar mode)} -@findex calendar-backward-week - The day and week commands are natural analogues of the usual Emacs -commands for moving by characters and by lines. Just as @kbd{C-n} -usually moves to the same column in the following line, in Calendar -mode it moves to the same day in the following week. And @kbd{C-p} -moves to the same day in the previous week. - - The arrow keys are equivalent to @kbd{C-f}, @kbd{C-b}, @kbd{C-n} and -@kbd{C-p}, just as they normally are in other modes. - -@kindex M-@} @r{(Calendar mode)} -@findex calendar-forward-month -@kindex M-@{ @r{(Calendar mode)} -@findex calendar-backward-month -@kindex C-x ] @r{(Calendar mode)} -@findex calendar-forward-year -@kindex C-x [ @r{(Calendar mode)} -@findex calendar-forward-year - The commands for motion by months and years work like those for -weeks, but move a larger distance. The month commands @kbd{M-@}} and -@kbd{M-@{} move forward or backward by an entire month's time. The -year commands @kbd{C-x ]} and @w{@kbd{C-x [}} move forward or backward a -whole year. - - The easiest way to remember these commands is to consider months and -years analogous to paragraphs and pages of text, respectively. But the -commands themselves are not quite analogous. The ordinary Emacs paragraph -commands move to the beginning or end of a paragraph, whereas these month -and year commands move by an entire month or an entire year, which usually -involves skipping across the end of a month or year. - - All these commands accept a numeric argument as a repeat count. -For convenience, the digit keys and the minus sign specify numeric -arguments in Calendar mode even without the Meta modifier. For example, -@kbd{100 C-f} moves point 100 days forward from its present location. - -@node Move to Beginning or End, Specified Dates, Calendar Unit Motion, Calendar Motion -@subsubsection Beginning or End of Week, Month or Year - - A week (or month, or year) is not just a quantity of days; we think of -weeks (months, years) as starting on particular dates. So Calendar mode -provides commands to move to the beginning or end of a week, month or -year: - -@table @kbd -@kindex C-a @r{(Calendar mode)} -@findex calendar-beginning-of-week -@item C-a -Move point to start of week (@code{calendar-beginning-of-week}). -@kindex C-e @r{(Calendar mode)} -@findex calendar-end-of-week -@item C-e -Move point to end of week (@code{calendar-end-of-week}). -@kindex M-a @r{(Calendar mode)} -@findex calendar-beginning-of-month -@item M-a -Move point to start of month (@code{calendar-beginning-of-month}). -@kindex M-e @r{(Calendar mode)} -@findex calendar-end-of-month -@item M-e -Move point to end of month (@code{calendar-end-of-month}). -@kindex M-< @r{(Calendar mode)} -@findex calendar-beginning-of-year -@item M-< -Move point to start of year (@code{calendar-beginning-of-year}). -@kindex M-> @r{(Calendar mode)} -@findex calendar-end-of-year -@item M-> -Move point to end of year (@code{calendar-end-of-year}). -@end table - - These commands also take numeric arguments as repeat counts, with the -repeat count indicating how many weeks, months, or years to move -backward or forward. - -@vindex calendar-week-start-day -@cindex weeks, which day they start on -@cindex calendar, first day of week - By default, weeks begin on Sunday. To make them begin on Monday -instead, set the variable @code{calendar-week-start-day} to 1. - -@node Specified Dates,,Move to Beginning or End, Calendar Motion -@subsubsection Particular Dates - - Calendar mode provides commands for moving to a particular date -specified in various ways. - -@table @kbd -@item g d -Move point to specified date (@code{calendar-goto-date}). -@item o -Center calendar around specified month (@code{calendar-other-month}). -@item . -Move point to today's date (@code{calendar-goto-today}). -@end table - -@kindex g d @r{(Calendar mode)} -@findex calendar-goto-date - @kbd{g d} (@code{calendar-goto-date}) prompts for a year, a month, and a day -of the month, and then moves to that date. Because the calendar includes all -dates from the beginning of the current era, you must type the year in its -entirety; that is, type @samp{1990}, not @samp{90}. - -@kindex o @r{(Calendar mode)} -@findex calendar-other-month - @kbd{o} (@code{calendar-other-month}) prompts for a month and year, -then centers the three-month calendar around that month. - -@kindex . @r{(Calendar mode)} -@findex calendar-goto-today - You can return to today's date with @kbd{.}@: -(@code{calendar-goto-today}). - -@node Scroll Calendar, Mark and Region, Calendar Motion, Calendar/Diary -@subsection Scrolling the Calendar through Time - -@cindex scrolling in the calendar - The calendar display scrolls automatically through time when you move out -of the visible portion. You can also scroll it manually. Imagine that the -calendar window contains a long strip of paper with the months on it. -Scrolling it means moving the strip so that new months become visible in -the window. - -@table @kbd -@item C-x < -Scroll calendar one month forward (@code{scroll-calendar-left}). -@item C-x > -Scroll calendar one month backward (@code{scroll-calendar-right}). -@item C-v -@itemx @key{NEXT} -Scroll calendar three months forward -(@code{scroll-calendar-left-three-months}). -@item M-v -@itemx @key{PRIOR} -Scroll calendar three months backward -(@code{scroll-calendar-right-three-months}). -@end table - -@kindex C-x < @r{(Calendar mode)} -@findex scroll-calendar-left -@kindex C-x > @r{(Calendar mode)} -@findex scroll-calendar-right - The most basic calendar scroll commands scroll by one month at a -time. This means that there are two months of overlap between the -display before the command and the display after. @kbd{C-x <} scrolls -the calendar contents one month to the left; that is, it moves the -display forward in time. @kbd{C-x >} scrolls the contents to the -right, which moves backwards in time. - -@kindex C-v @r{(Calendar mode)} -@findex scroll-calendar-left-three-months -@kindex M-v @r{(Calendar mode)} -@findex scroll-calendar-right-three-months - The commands @kbd{C-v} and @kbd{M-v} scroll the calendar by an entire -``screenful''---three months---in analogy with the usual meaning of -these commands. @kbd{C-v} makes later dates visible and @kbd{M-v} makes -earlier dates visible. These commands take a numeric argument as a -repeat count; in particular, since @kbd{C-u} multiplies the next command -by four, typing @kbd{C-u C-v} scrolls the calendar forward by a year and -typing @kbd{C-u M-v} scrolls the calendar backward by a year. - - The function keys @key{NEXT} and @key{PRIOR} are equivalent to -@kbd{C-v} and @kbd{M-v}, just as they are in other modes. - - -@node Mark and Region, General Calendar, Scroll Calendar, Calendar/Diary -@subsection The Mark and the Region - - The concept of the mark applies to the calendar just as to any other -buffer, but it marks a @emph{date}, not a @emph{position} in the buffer. -The region consists of the days between the mark and point (including -the starting and stopping dates). - -@table @kbd -@item C-SPC -Set the mark to today's date (@code{calendar-set-mark}). -@item C-@@ -The same. -@item C-x C-x -Interchange mark and point (@code{calendar-exchange-point-and-mark}). -@item M-= -Display the number of days in the current region -(@code{calendar-count-days-region}). -@end table - -@kindex C-@@ @r{(Calendar mode)} -@kindex C-SPC @r{(Calendar mode)} -@findex calendar-set-mark -@kindex C-x C-x @r{(Calendar mode)} -@findex calendar-exchange-point-and-mark - You set the mark in the calendar, as in any other buffer, by using @kbd{C-@@} -or @kbd{C-SPC} (@code{calendar-set-mark}). You return to the marked date -with the command @kbd{C-x C-x} (@code{calendar-exchange-point-and-mark}) -which puts the mark where point was and point where mark was. The calendar -is scrolled as necessary, if the marked date was not visible on the -screen. This does not change the extent of the region. - -@kindex M-= @r{(Calendar mode)} -@findex calendar-count-days-region - To determine the number of days in the region, type @kbd{M-=} -(@code{calendar-count-days-region}). The numbers of days printed is -@emph{inclusive}; that is, it includes the days specified by mark and -point. - -@cindex mark ring - The main use of the mark in the calendar is to remember dates that you may -want to go back to. To make this feature more useful, the mark ring -(@pxref{Mark Ring}) operates exactly as in other buffers: Emacs remembers -16 previous locations of the mark. To return to a marked date, type @kbd{C-u -C-SPC} (or @kbd{C-u C-@@}); this is the command @code{calendar-set-mark} given -a numeric argument. It moves point to where the mark was, restores the mark -from the ring of former marks, and stores the previous point at the end of -the mark ring. So, repeated use of this command moves point through all -the old marks on the ring, one by one. - -@node General Calendar, LaTeX Calendar, Mark and Region, Calendar/Diary -@subsection Miscellaneous Calendar Commands - -@table @kbd -@item p d -Display day-in-year (@code{calendar-print-day-of-year}). -@item ? -Briefly describe calendar commands (@code{describe-calendar-mode}). -@item C-c C-l -Regenerate the calendar window (@code{redraw-calendar}). -@item SPC -Scroll the next window (@code{scroll-other-window}). -@item q -Exit from calendar (@code{exit-calendar}). -@end table - -@kindex p d @r{(Calendar mode)} -@cindex day of year -@findex calendar-print-day-of-year - If you want to know how many days have elapsed since the start of -the year, or the number of days remaining in the year, type the @kbd{p d} -command (@code{calendar-print-day-of-year}). This displays both -of those numbers in the echo area. - -@kindex ? @r{(Calendar mode)} -@findex describe-calendar-mode - To display a brief description of the calendar commands, type @kbd{?} -(@code{describe-calendar-mode}). For a fuller description, type @kbd{C-h m}. - -@kindex SPC @r{(Calendar mode)} -@findex scroll-other-window - You can use @kbd{SPC} (@code{scroll-other-window}) to scroll the other -window. This is handy when you display a list of holidays or diary entries -in another window. - -@kindex C-c C-l @r{(Calendar mode)} -@findex redraw-calendar - If the calendar window text gets corrupted, type @kbd{C-c C-l} -(@code{redraw-calendar}) to redraw it. (This can only happen if you use -non-Calendar-mode editing commands.) - -@kindex SPC @r{(Calendar mode)} - In Calendar mode, you can use @kbd{SPC} (@code{scroll-other-window}) -to scroll the other window. This is handy when you display a list of -holidays or diary entries in another window. - -@kindex q @r{(Calendar mode)} -@findex exit-calendar - To exit from the calendar, type @kbd{q} (@code{exit-calendar}). This -buries all buffers related to the calendar, selecting other buffers. -(If a frame contains a dedicated calendar window, exiting from the -calendar iconifies that frame.) - -@node LaTeX Calendar, Holidays, General Calendar, Calendar/Diary -@section LaTeX Calendar -@cindex calendar and La@TeX{} - - The Calendar La@TeX{} commands produce a buffer of La@TeX{} code that -prints as a calendar. Depending on the command you use, the printed -calendar covers the day, week, month or year that point is in. - -@kindex t @r{(Calendar mode)} -@table @kbd -@item t m -Generate a one-month calendar (@code{cal-tex-cursor-month}). -@item t M -Generate a sideways-printing one-month calendar -(@code{cal-tex-cursor-month-landscape}). -@item t d -Generate a one-day calendar -(@code{cal-tex-cursor-day}). -@item t w 1 -Generate a one-page calendar for one week -(@code{cal-tex-cursor-week}). -@item t w 2 -Generate a two-page calendar for one week -(@code{cal-tex-cursor-week2}). -@item t w 3 -Generate an ISO-style calendar for one week -(@code{cal-tex-cursor-week-iso}). -@item t w 4 -Generate a calendar for one Monday-starting week -(@code{cal-tex-cursor-week-monday}). -@item t f w -Generate a Filofax-style two-weeks-at-a-glance calendar -(@code{cal-tex-cursor-filofax-2week}). -@item t f W -Generate a Filofax-style one-week-at-a-glance calendar -(@code{cal-tex-cursor-filofax-week}). -@item t y -Generate a calendar for one year -(@code{cal-tex-cursor-year}). -@item t Y -Generate a sideways-printing calendar for one year -(@code{cal-tex-cursor-year-landscape}). -@item t f y -Generate a Filofax-style calendar for one year -(@code{cal-tex-cursor-filofax-year}). -@end table - - Some of these commands print the calendar sideways (in ``landscape -mode''), so it can be wider than it is long. Some of them use Filofax -paper size (3.75in x 6.75in). All of these commands accept a prefix -argument which specifies how many days, weeks, months or years to print -(starting always with the selected one). - - If the variable @code{cal-tex-holidays} is non-@code{nil} (the -default), then the printed calendars show the holidays in -@code{calendar-holidays}. If the variable @code{cal-tex-diary} is -non-@code{nil} (the default is @code{nil}), diary entries are included -also (in weekly and monthly calendars only). - -@node Holidays, Sunrise/Sunset, LaTeX Calendar, Calendar/Diary -@subsection Holidays -@cindex holidays - - The Emacs calendar knows about all major and many minor holidays, -and can display them. - -@table @kbd -@item h -Display holidays for the selected date -(@code{calendar-cursor-holidays}). -@item Button2 Holidays -Display any holidays for the date you click on. -@item x -Mark holidays in the calendar window (@code{mark-calendar-holidays}). -@item u -Unmark calendar window (@code{calendar-unmark}). -@item a -List all holidays for the displayed three months in another window -(@code{list-calendar-holidays}). -@item M-x holidays -List all holidays for three months around today's date in another -window. -@item M-x list-holidays -List holidays in another window for a specified range of years. -@end table - -@kindex h @r{(Calendar mode)} -@findex calendar-cursor-holidays - To see if any holidays fall on a given date, position point on that -date in the calendar window and use the @kbd{h} command. Alternatively, -click on that date with @kbd{Button2} and then choose @kbd{Holidays} -from the menu that appears. Either way, this displays the holidays for -that date, in the echo area if they fit there, otherwise in a separate -window. - -@kindex x @r{(Calendar mode)} -@findex mark-calendar-holidays -@kindex u @r{(Calendar mode)} -@findex calendar-unmark - To view the distribution of holidays for all the dates shown in the -calendar, use the @kbd{x} command. This displays the dates that are -holidays in a different face (or places a @samp{*} after these dates, if -display with multiple faces is not available). The command applies both -to the currently visible months and to other months that subsequently -become visible by scrolling. To turn marking off and erase the current -marks, type @kbd{u}, which also erases any diary marks (@pxref{Diary}). - -@kindex a @r{(Calendar mode)} -@findex list-calendar-holidays - To get even more detailed information, use the @kbd{a} command, which -displays a separate buffer containing a list of all holidays in the -current three-month range. You can use @key{SPC} in the calendar window -to scroll that list. - -@findex holidays - The command @kbd{M-x holidays} displays the list of holidays for the -current month and the preceding and succeeding months; this works even -if you don't have a calendar window. If you want the list of holidays -centered around a different month, use @kbd{C-u M-x holidays}, which -prompts for the month and year. - - The holidays known to Emacs include United States holidays and the -major Christian, Jewish, and Islamic holidays; also the solstices and -equinoxes. - -@findex list-holidays - The command @kbd{M-x list-holidays} displays the list of holidays for -a range of years. This function asks you for the starting and stopping -years, and allows you to choose all the holidays or one of several -categories of holidays. You can use this command even if you don't have -a calendar window. - - The dates used by Emacs for holidays are based on @emph{current -practice}, not historical fact. Historically, for instance, the start -of daylight savings time and even its existence have varied from year to -year, but present United States law mandates that daylight savings time -begins on the first Sunday in April. When the daylight savings rules -are set up for the United States, Emacs always uses the present -definition, even though it is wrong for some prior years. - -@node Sunrise/Sunset, Lunar Phases, Holidays, Calendar/Diary -@subsection Times of Sunrise and Sunset -@cindex sunrise and sunset - - Special calendar commands can tell you, to within a minute or two, the -times of sunrise and sunset for any date. - -@table @kbd -@item S -Display times of sunrise and sunset for the selected date -(@code{calendar-sunrise-sunset}). -@item Button2 Sunrise/Sunset -Display times of sunrise and sunset for the date you click on. -@item M-x sunrise-sunset -Display times of sunrise and sunset for today's date. -@item C-u M-x sunrise-sunset -Display times of sunrise and sunset for a specified date. -@end table - -@kindex S @r{(Calendar mode)} -@findex calendar-sunrise-sunset -@findex sunrise-sunset - Within the calendar, to display the @emph{local times} of sunrise and -sunset in the echo area, move point to the date you want, and type -@kbd{S}. Alternatively, click @kbd{Button2} on the date, then choose -@kbd{Sunrise/Sunset} from the menu that appears. The command @kbd{M-x -sunrise-sunset} is available outside the calendar to display this -information for today's date or a specified date. To specify a date -other than today, use @kbd{C-u M-x sunrise-sunset}, which prompts for -the year, month, and day. - - You can display the times of sunrise and sunset for any location and -any date with @kbd{C-u C-u M-x sunrise-sunset}. This asks you for a -longitude, latitude, number of minutes difference from Coordinated -Universal Time, and date, and then tells you the times of sunrise and -sunset for that location on that date. - - Because the times of sunrise and sunset depend on the location on -earth, you need to tell Emacs your latitude, longitude, and location -name before using these commands. Here is an example of what to set: - -@vindex calendar-location-name -@vindex calendar-longitude -@vindex calendar-latitude -@example -(setq calendar-latitude 40.1) -(setq calendar-longitude -88.2) -(setq calendar-location-name "Urbana, IL") -@end example - -@noindent -Use one decimal place in the values of @code{calendar-latitude} and -@code{calendar-longitude}. - - Your time zone also affects the local time of sunrise and sunset. -Emacs usually gets time zone information from the operating system, but -if these values are not what you want (or if the operating system does -not supply them), you must set them yourself. Here is an example: - -@vindex calendar-time-zone -@vindex calendar-standard-time-zone-name -@vindex calendar-daylight-time-zone-name -@example -(setq calendar-time-zone -360) -(setq calendar-standard-time-zone-name "CST") -(setq calendar-daylight-time-zone-name "CDT") -@end example - -@noindent -The value of @code{calendar-time-zone} is the number of minutes -difference between your local standard time and Coordinated Universal -Time (Greenwich time). The values of -@code{calendar-standard-time-zone-name} and -@code{calendar-daylight-time-zone-name} are the abbreviations used in -your time zone. Emacs displays the times of sunrise and sunset -@emph{corrected for daylight savings time}. @xref{Daylight Savings}, -for how daylight savings time is determined. - - As a user, you might find it convenient to set the calendar location -variables for your usual physical location in your @file{.emacs} file. -And when you install Emacs on a machine, you can create a -@file{default.el} file which sets them properly for the typical location -of most users of that machine. @xref{Init File}. - -@node Lunar Phases, Other Calendars, Sunrise/Sunset, Calendar/Diary -@subsection Phases of the Moon -@cindex phases of the moon -@cindex moon, phases of - - These calendar commands display the dates and times of the phases of -the moon (new moon, first quarter, full moon, last quarter). This -feature is useful for debugging problems that ``depend on the phase of -the moon.'' - -@table @kbd -@item M -Display the dates and times for all the quarters of the moon for the -three-month period shown (@code{calendar-phases-of-moon}). -@item M-x phases-of-moon -Display dates and times of the quarters of the moon for three months around -today's date. -@end table - -@kindex M @r{(Calendar mode)} -@findex calendar-phases-of-moon - Within the calendar, use the @kbd{M} command to display a separate -buffer of the phases of the moon for the current three-month range. The -dates and times listed are accurate to within a few minutes. - -@findex phases-of-moon - Outside the calendar, use the command @kbd{M-x phases-of-moon} to -display the list of the phases of the moon for the current month and the -preceding and succeeding months. For information about a different -month, use @kbd{C-u M-x phases-of-moon}, which prompts for the month and -year. - - The dates and times given for the phases of the moon are given in -local time (corrected for daylight savings, when appropriate); but if -the variable @code{calendar-time-zone} is void, Coordinated Universal -Time (the Greenwich time zone) is used. @xref{Daylight Savings}. - -@node Other Calendars, Calendar Systems, Lunar Phases, Calendar/Diary -@subsection Conversion To and From Other Calendars - -@cindex Gregorian calendar - The Emacs calendar displayed is @emph{always} the Gregorian calendar, -sometimes called the ``new style'' calendar, which is used in most of -the world today. However, this calendar did not exist before the -sixteenth century and was not widely used before the eighteenth century; -it did not fully displace the Julian calendar and gain universal -acceptance until the early twentieth century. The Emacs calendar can -display any month since January, year 1 of the current era, but the -calendar displayed is the Gregorian, even for a date at which the -Gregorian calendar did not exist. - - While Emacs cannot display other calendars, it can convert dates to -and from several other calendars. - -@menu -* Calendar Systems:: The calendars Emacs understands - (aside from Gregorian). -* To Other Calendar:: Converting the selected date to various calendars. -* From Other Calendar:: Moving to a date specified in another calendar. -* Mayan Calendar:: Moving to a date specified in a Mayan calendar. -@end menu - - If you are interested in these calendars, you can convert dates one at a -time. Put point on the desired date of the Gregorian calendar and press the -appropriate keys. The @kbd{p} is a mnemonic for ``print'' since Emacs -``prints' the equivalent date in the echo area. -@node Calendar Systems, To Other Calendar, Other Calendars, Other Calendars -@section Supported Calendar Systems - -@cindex ISO commercial calendar - The ISO commercial calendar is used largely in Europe. - -@cindex Julian calendar - The Julian calendar, named after Julius Caesar, was the one used in Europe -throughout medieval times, and in many countries up until the nineteenth -century. - -@cindex Julian day numbers -@cindex astronomical day numbers - Astronomers use a simple counting of days elapsed since noon, Monday, -January 1, 4713 B.C. on the Julian calendar. The number of days elapsed -is called the @emph{Julian day number} or the @emph{Astronomical day number}. - -@cindex Hebrew calendar - The Hebrew calendar is used by tradition in the Jewish religion. The -Emacs calendar program uses the Hebrew calendar to determine the dates -of Jewish holidays. Hebrew calendar dates begin and end at sunset. - -@cindex Islamic calendar - The Islamic calendar is used in many predominantly Islamic countries. -Emacs uses it to determine the dates of Islamic holidays. There is no -universal agreement in the Islamic world about the calendar; Emacs uses -a widely accepted version, but the precise dates of Islamic holidays -often depend on proclamation by religious authorities, not on -calculations. As a consequence, the actual dates of observance can vary -slightly from the dates computed by Emacs. Islamic calendar dates begin -and end at sunset. - -@cindex French Revolutionary calendar - The French Revolutionary calendar was created by the Jacobins after the 1789 -revolution, to represent a more secular and nature-based view of the annual -cycle, and to install a 10-day week in a rationalization measure similar to -the metric system. The French government officially abandoned this -calendar at the end of 1805. - -@cindex Mayan calendar - The Maya of Central America used three separate, overlapping calendar -systems, the @emph{long count}, the @emph{tzolkin}, and the @emph{haab}. -Emacs knows about all three of these calendars. Experts dispute the -exact correlation between the Mayan calendar and our calendar; Emacs uses the -Goodman-Martinez-Thompson correlation in its calculations. - -@cindex Coptic calendar -@cindex Ethiopic calendar - The Copts use a calendar based on the ancient Egyptian solar calendar. -Their calendar consists of twelve 30-day months followed by an extra -five-day period. Once every fourth year they add a leap day to this -extra period to make it six days. The Ethiopic calendar is identical in -structure, but has different year numbers and month names. - -@cindex Persian calendar - The Persians use a solar calendar based on a design of Omar Khayyam. -Their calendar consists of twelve months of which the first six have 31 -days, the next five have 30 days, and the last has 29 in ordinary years -and 30 in leap years. Leap years occur in a complicated pattern every -four or five years. - -@cindex Chinese calendar - The Chinese calendar is a complicated system of lunar months arranged -into solar years. The years go in cycles of sixty, each year containing -either twelve months in an ordinary year or thirteen months in a leap -year; each month has either 29 or 30 days. Years, ordinary months, and -days are named by combining one of ten ``celestial stems'' with one of -twelve ``terrestrial branches'' for a total of sixty names that are -repeated in a cycle of sixty. - -@node To Other Calendar, From Other Calendar, Calendar Systems, Other Calendars -@section Converting To Other Calendars - - The following commands describe the selected date (the date at point) -in various other calendar systems: - -@table @kbd -@item Button2 Other Calendars -Display the date that you click on, expressed in various other calendars. -@kindex p @r{(Calendar mode)} -@findex calendar-print-iso-date -@item p c -Display ISO commercial calendar equivalent for selected day -(@code{calendar-print-iso-date}). -@findex calendar-print-julian-date -@item p j -Display Julian date for selected day (@code{calendar-print-julian-date}). -@findex calendar-print-astro-day-number -@item p a -Display astronomical (Julian) day number for selected day -(@code{calendar-print-astro-day-number}). -@findex calendar-print-hebrew-date -@item p h -Display Hebrew date for selected day (@code{calendar-print-hebrew-date}). -@findex calendar-print-islamic-date -@item p i -Display Islamic date for selected day (@code{calendar-print-islamic-date}). -@findex calendar-print-french-date -@item p f -Display French Revolutionary date for selected day -(@code{calendar-print-french-date}). -@findex calendar-print-chinese-date -@item p C -Display Chinese date for selected day -(@code{calendar-print-chinese-date}). -@findex calendar-print-coptic-date -@item p k -Display Coptic date for selected day -(@code{calendar-print-coptic-date}). -@findex calendar-print-ethiopic-date -@item p e -Display Ethiopic date for selected day -(@code{calendar-print-ethiopic-date}). -@findex calendar-print-persian-date -@item p p -Display Persian date for selected day -(@code{calendar-print-persian-date}). -@findex calendar-print-mayan-date -@item p m -Display Mayan date for selected day (@code{calendar-print-mayan-date}). -@end table - - If you are using X, the easiest way to translate a date into other -calendars is to click on it with @kbd{Button2}, then choose @kbd{Other -Calendars} from the menu that appears. This displays the equivalent -forms of the date in all the calendars Emacs understands, in the form of -a menu. (Choosing an alternative from this menu doesn't actually do -anything---the menu is used only for display.) - - Put point on the desired date of the Gregorian calendar, then type the -appropriate keys. The @kbd{p} is a mnemonic for ``print'' since Emacs -``prints'' the equivalent date in the echo area. - -@node From Other Calendar, Mayan Calendar, To Other Calendar, Other Calendars -@section Converting From Other Calendars - - You can use the other supported calendars to specify a date to move -to. This section describes the commands for doing this using calendars -other than Mayan; for the Mayan calendar, see the following section. - -@kindex g @var{char} @r{(Calendar mode)} -@findex calendar-goto-iso-date -@findex calendar-goto-julian-date -@findex calendar-goto-astro-day-number -@findex calendar-goto-hebrew-date -@findex calendar-goto-islamic-date -@findex calendar-goto-french-date -@findex calendar-goto-chinese-date -@findex calendar-goto-persian-date -@findex calendar-goto-coptic-date -@findex calendar-goto-ethiopic-date -@table @kbd -@item g c -Move to a date specified in the ISO commercial calendar -(@code{calendar-goto-iso-date}). -@item g j -Move to a date specified in the Julian calendar -(@code{calendar-goto-julian-date}). -@item g a -Move to a date specified in astronomical (Julian) day number -(@code{calendar-goto-astro-day-number}). -@item g h -Move to a date specified in the Hebrew calendar -(@code{calendar-goto-hebrew-date}). -@item g i -Move to a date specified in the Islamic calendar -(@code{calendar-goto-islamic-date}). -@item g f -Move to a date specified in the French Revolutionary calendar -(@code{calendar-goto-french-date}). -@item g C -Move to a date specified in the Chinese calendar -(@code{calendar-goto-chinese-date}). -@item g p -Move to a date specified in the Persian calendar -(@code{calendar-goto-persian-date}). -@item g k -Move to a date specified in the Coptic calendar -(@code{calendar-goto-coptic-date}). -@item g e -Move to a date specified in the Ethiopic calendar -(@code{calendar-goto-ethiopic-date}). -@end table - - These commands ask you for a date on the other calendar, move point to -the Gregorian calendar date equivalent to that date, and display the -other calendar's date in the echo area. Emacs uses strict completion -(@pxref{Completion}) whenever it asks you to type a month name, so you -don't have to worry about the spelling of Hebrew, Islamic, or French names. - -@findex list-yahrzeit-dates -@cindex yahrzeits - One common question concerning the Hebrew calendar is the computation -of the anniversary of a date of death, called a ``yahrzeit.'' The Emacs -calendar includes a facility for such calculations. If you are in the -calendar, the command @kbd{M-x list-yahrzeit-dates} asks you for a -range of years and then displays a list of the yahrzeit dates for those -years for the date given by point. If you are not in the calendar, -this command first asks you for the date of death and the range of -years, and then displays the list of yahrzeit dates. - -@node Mayan Calendar, Diary ,From Other Calendar ,Other Calendars -@subsection Converting from the Mayan Calendar - - Here are the commands to select dates based on the Mayan calendar: - -@table @kbd -@item g m l -Move to a date specified by the long count calendar -(@code{calendar-goto-mayan-long-count-date}). -@item g m n t -Move to the next occurrence of a place in the -tzolkin calendar (@code{calendar-next-tzolkin-date}). -@item g m p t -Move to the previous occurrence of a place in the -tzolkin calendar (@code{calendar-previous-tzolkin-date}). -@item g m n h -Move to the next occurrence of a place in the -haab calendar (@code{calendar-next-haab-date}). -@item g m p h -Move to the previous occurrence of a place in the -haab calendar (@code{calendar-previous-haab-date}). -@item g m n c -Move to the next occurrence of a place in the -calendar round (@code{calendar-next-calendar-round-date}). -@item g m p c -Move to the previous occurrence of a place in the -calendar round (@code{calendar-previous-calendar-round-date}). -@end table - -@cindex Mayan long count - To understand these commands, you need to understand the Mayan calendars. -The @dfn{long count} is a counting of days with these units: - -@display -1 kin = 1 day@ @ @ 1 uinal = 20 kin@ @ @ 1 tun = 18 uinal -1 katun = 20 tun@ @ @ 1 baktun = 20 katun -@end display - -@kindex g m l @r{(Calendar mode)} -@findex calendar-goto-mayan-long-count-date -@noindent -Thus, the long count date 12.16.11.16.6 means 12 baktun, 16 katun, 11 -tun, 16 uinal, and 6 kin. The Emacs calendar can handle Mayan long -count dates as early as 7.17.18.13.1, but no earlier. When you use the -@kbd{g m l} command, type the Mayan long count date with the baktun, -katun, tun, uinal, and kin separated by periods. - -@findex calendar-previous-tzolkin-date -@findex calendar-next-tzolkin-date -@cindex Mayan tzolkin calendar - The Mayan tzolkin calendar is a cycle of 260 days formed by a pair of -independent cycles of 13 and 20 days. Since this cycle repeats -endlessly, Emacs provides commands to move backward and forward to the -previous or next point in the cycle. Type @kbd{g m p t} to go to the -previous tzolkin date; Emacs asks you for a tzolkin date and moves point -to the previous occurrence of that date. Similarly, type @kbd{g m n t} -to go to the next occurrence of a tzolkin date. - -@findex calendar-previous-haab-date -@findex calendar-next-haab-date -@cindex Mayan haab calendar - The Mayan haab calendar is a cycle of 365 days arranged as 18 months -of 20 days each, followed a 5-day monthless period. Like the tzolkin -cycle, this cycle repeats endlessly, and there are commands to move -backward and forward to the previous or next point in the cycle. Type -@kbd{g m p h} to go to the previous haab date; Emacs asks you for a haab -date and moves point to the previous occurrence of that date. -Similarly, type @kbd{g m n h} to go to the next occurrence of a haab -date. - -@c This is omitted because it is too long for smallbook format. -@c @findex calendar-previous-calendar-round-date -@findex calendar-next-calendar-round-date -@cindex Mayan calendar round - The Maya also used the combination of the tzolkin date and the haab -date. This combination is a cycle of about 52 years called a -@emph{calendar round}. If you type @kbd{g m p c}, Emacs asks you for -both a haab and a tzolkin date and then moves point to the previous -occurrence of that combination. Use @kbd{g m n c} to move point to the -next occurrence of a combination. These commands signal an error if the -haab/tzolkin date combination you have typed is impossible. - - Emacs uses strict completion (@pxref{Completion}) whenever it -asks you to type a Mayan name, so you don't have to worry about -spelling. - -@node Diary, Calendar Customization, Mayan Calendar, Calendar/Diary -@subsection The Diary -@cindex diary - - The Emacs diary keeps track of appointments or other events on a daily -basis, in conjunction with the calendar. To use the diary feature, you -must first create a @dfn{diary file} containing a list of events and -their dates. Then Emacs can automatically pick out and display the -events for today, for the immediate future, or for any specified -date. - - By default, Emacs uses @file{~/diary} as the diary file. This is the -same file that the @code{calendar} utility uses. A sample -@file{~/diary} file is: - -@example -12/22/1988 Twentieth wedding anniversary!! -&1/1. Happy New Year! -10/22 Ruth's birthday. -* 21, *: Payday -Tuesday--weekly meeting with grad students at 10am - Supowit, Shen, Bitner, and Kapoor to attend. -1/13/89 Friday the thirteenth!! -&thu 4pm squash game with Lloyd. -mar 16 Dad's birthday -April 15, 1989 Income tax due. -&* 15 time cards due. -@end example - -@noindent -This example uses extra spaces to align the event descriptions of most -of the entries. Such formatting is purely a matter of taste. - - Although you probably will start by creating a diary manually, Emacs -provides a number of commands to let you view, add, and change diary -entries. You can also share diary entries with other users -(@pxref{Included Diary Files}). - -@menu -* Diary Commands:: Viewing diary entries and associated calendar dates. -* Format of Diary File:: Entering events in your diary. -* Date Formats:: Various ways you can specify dates. -* Adding to Diary:: Commands to create diary entries. -* Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc. -@end menu - -@node Diary Commands, Format of Diary File, Diary, Diary -@subsection Commands Displaying Diary Entries - - Once you have created a @file{~/diary} file, you can use the calendar -to view it. You can also view today's events outside of Calendar mode. - -@table @kbd -@item d -Display all diary entries for the selected date -(@code{view-diary-entries}). -@item Button2 Diary -Display all diary entries for the date you click on. -@item s -Display the entire diary file (@code{show-all-diary-entries}). -@item m -Mark all visible dates that have diary entries -(@code{mark-diary-entries}). -@item u -Unmark the calendar window (@code{calendar-unmark}). -@item M-x print-diary-entries -Print hard copy of the diary display as it appears. -@item M-x diary -Display all diary entries for today's date. -@item M-x diary-mail-entries -Mail yourself email reminders about upcoming diary entries. -@end table - -@kindex d @r{(Calendar mode)} -@findex view-diary-entries - Displaying the diary entries with @kbd{d} shows in a separate window -the diary entries for the selected date in the calendar. The mode line -of the new window shows the date of the diary entries and any holidays -that fall on that date. If you specify a numeric argument with @kbd{d}, -it shows all the diary entries for that many successive days. Thus, -@kbd{2 d} displays all the entries for the selected date and for the -following day. - - Another way to display the diary entries for a date is to click -@kbd{Button2} on the date, and then choose @kbd{Diary} from the menu -that appears. - -@kindex m @r{(Calendar mode)} -@findex mark-diary-entries -@kindex u @r{(Calendar mode)} -@findex calendar-unmark - To get a broader view of which days are mentioned in the diary, use -the @kbd{m} command. This displays the dates that have diary entries -in a different face (or places a @samp{+} after these dates, if -display with multiple faces is not available). The command applies both -to the currently visible months and to other months that subsequently -become visible by scrolling. To turn marking off and erase the current -marks, type @kbd{u}, which also turns off holiday marks -(@pxref{Holidays}). - -@kindex s @r{(Calendar mode)} -@findex show-all-diary-entries - To see the full diary file, rather than just some of the entries, use -the @kbd{s} command. - - Display of selected diary entries uses the selective display feature -to hide entries that don't apply. - -@findex print-diary-entries - The diary buffer as you see it is an illusion, so simply printing the -buffer does not print what you see on your screen. There is a special -command to print hard copy of the diary buffer @emph{as it appears}; -this command is @kbd{M-x print-diary-entries}. It sends the data -directly to the printer. You can customize it like @code{lpr-region} -(@pxref{Hardcopy}). - -@findex diary - The command @kbd{M-x diary} displays the diary entries for the current -date, independently of the calendar display, and optionally for the next -few days as well; the variable @code{number-of-diary-entries} specifies -how many days to include (@pxref{Customization}). - - If you put @code{(diary)} in your @file{.emacs} file, this -automatically displays a window with the day's diary entries, when you -enter Emacs. The mode line of the displayed window shows the date and -any holidays that fall on that date. - -@findex diary-mail-entries -@vindex diary-mail-days - Many users like to receive notice of events in their diary as email. -To send such mail to yourself, use the command @kbd{M-x -diary-mail-entries}. A prefix argument specifies how many days -(starting with today) to check; otherwise, the variable -@code{diary-mail-days} says how many days. - -@node Format of Diary File, Date Formats, Diary Commands, Diary -@subsection The Diary File -@cindex diary file - -@vindex diary-file - Your @dfn{diary file} is a file that records events associated with -particular dates. The name of the diary file is specified by the -variable @code{diary-file}; @file{~/diary} is the default. The -@code{calendar} utility program supports a subset of the format allowed -by the Emacs diary facilities, so you can use that utility to view the -diary file, with reasonable results aside from the entries it cannot -understand. - - Each entry in the diary file describes one event and consists of one -or more lines. An entry always begins with a date specification at the -left margin. The rest of the entry is simply text to describe the -event. If the entry has more than one line, then the lines after the -first must begin with whitespace to indicate they continue a previous -entry. Lines that do not begin with valid dates and do not continue a -preceding entry are ignored. - - You can inhibit the marking of certain diary entries in the calendar -window; to do this, insert an ampersand (@samp{&}) at the beginning of -the entry, before the date. This has no effect on display of the entry -in the diary window; it affects only marks on dates in the calendar -window. Nonmarking entries are especially useful for generic entries -that would otherwise mark many different dates. - - If the first line of a diary entry consists only of the date or day -name with no following blanks or punctuation, then the diary window -display doesn't include that line; only the continuation lines appear. -For example, this entry: - -@example -02/11/1989 - Bill B. visits Princeton today - 2pm Cognitive Studies Committee meeting - 2:30-5:30 Liz at Lawrenceville - 4:00pm Dentist appt - 7:30pm Dinner at George's - 8:00-10:00pm concert -@end example - -@noindent -appears in the diary window without the date line at the beginning. -This style of entry looks neater when you display just a single day's -entries, but can cause confusion if you ask for more than one day's -entries. - - You can edit the diary entries as they appear in the window, but it is -important to remember that the buffer displayed contains the @emph{entire} -diary file, with portions of it concealed from view. This means, for -instance, that the @kbd{C-f} (@code{forward-char}) command can put point -at what appears to be the end of the line, but what is in reality the -middle of some concealed line. - - @emph{Be careful when editing the diary entries!} Inserting -additional lines or adding/deleting characters in the middle of a -visible line cannot cause problems, but editing at the end of a line may -not do what you expect. Deleting a line may delete other invisible -entries that follow it. Before editing the diary, it is best to display -the entire file with @kbd{s} (@code{show-all-diary-entries}). - -@node Date Formats,Adding to Diary ,Format of Diary File, Diary -@subsection Date Formats - - Here are some sample diary entries, illustrating different ways of -formatting a date. The examples all show dates in American order -(month, day, year), but Calendar mode supports European order (day, -month, year) as an option. - -@example -4/20/93 Switch-over to new tabulation system -apr. 25 Start tabulating annual results -4/30 Results for April are due -*/25 Monthly cycle finishes -Friday Don't leave without backing up files -@end example - - The first entry appears only once, on April 20, 1993. The second and -third appear every year on the specified dates, and the fourth uses a -wildcard (asterisk) for the month, so it appears on the 25th of every -month. The final entry appears every week on Friday. - - You can use just numbers to express a date, as in -@samp{@var{month}/@var{day}} or @samp{@var{month}/@var{day}/@var{year}}. -This must be followed by a nondigit. In the date itself, @var{month} -and @var{day} are numbers of one or two digits. The optional @var{year} -is also a number, and may be abbreviated to the last two digits; that -is, you can use @samp{11/12/1989} or @samp{11/12/89}. - - Dates can also have the form @samp{@var{monthname} @var{day}} or -@samp{@var{monthname} @var{day}, @var{year}}, where the month's name can -be spelled in full or abbreviated to three characters (with or without a -period). Case is not significant. - - A date may be @dfn{generic}; that is, partially unspecified. Then the -entry applies to all dates that match the specification. If the date -does not contain a year, it is generic and applies to any year. -Alternatively, @var{month}, @var{day}, or @var{year} can be a @samp{*}; -this matches any month, day, or year, respectively. Thus, a diary entry -@samp{3/*/*} matches any day in March of any year; so does @samp{march -*}. - -@vindex european-calendar-style -@findex european-calendar -@findex american-calendar - If you prefer the European style of writing dates---in which the day -comes before the month---type @kbd{M-x european-calendar} while in the -calendar, or set the variable @code{european-calendar-style} to @code{t} -@emph{before} using any calendar or diary command. This mode interprets -all dates in the diary in the European manner, and also uses European -style for displaying diary dates. (Note that there is no comma after -the @var{monthname} in the European style.) To go back to the (default) -American style of writing dates, type @kbd{M-x american-calendar}. - - You can use the name of a day of the week as a generic date which -applies to any date falling on that day of the week. You can abbreviate -the day of the week to three letters (with or without a period) or spell -it in full; case is not significant. - -@node Adding to Diary, Special Diary Entries, Date Formats, Diary -@subsection Commands to Add to the Diary - - While in the calendar, there are several commands to create diary -entries: - -@table @kbd -@item i d -Add a diary entry for the selected date (@code{insert-diary-entry}). -@item i w -Add a diary entry for the selected day of the week (@code{insert-weekly-diary-entry}). -@item i m -Add a diary entry for the selected day of the month (@code{insert-monthly-diary-entry}). -@item i y -Add a diary entry for the selected day of the year (@code{insert-yearly-diary-entry}). -@end table - -@kindex i d @r{(Calendar mode)} -@findex insert-diary-entry - You can make a diary entry for a specific date by selecting that date -in the calendar window and typing the @kbd{i d} command. This command -displays the end of your diary file in another window and inserts the -date; you can then type the rest of the diary entry. - -@kindex i w @r{(Calendar mode)} -@findex insert-weekly-diary-entry -@kindex i m @r{(Calendar mode)} -@findex insert-monthly-diary-entry -@kindex i y @r{(Calendar mode)} -@findex insert-yearly-diary-entry - If you want to make a diary entry that applies to a specific day of -the week, select that day of the week (any occurrence will do) and type -@kbd{i w}. This inserts the day-of-week as a generic date; you can then -type the rest of the diary entry. You can make a monthly diary entry in -the same fashion. Select the day of the month, use the @kbd{i m} -command, and type rest of the entry. Similarly, you can insert a yearly -diary entry with the @kbd{i y} command. - - All of the above commands make marking diary entries by default. To -make a nonmarking diary entry, give a numeric argument to the command. -For example, @kbd{C-u i w} makes a nonmarking weekly diary entry. - - When you modify the diary file, be sure to save the file before -exiting Emacs. - -@node Special Diary Entries,, Adding to Diary, Diary -@subsection Special Diary Entries - - In addition to entries based on calendar dates, the diary file can -contain @dfn{sexp entries} for regular events such as anniversaries. -These entries are based on Lisp expressions (sexps) that Emacs evaluates -as it scans the diary file. Instead of a date, a sexp entry contains -@samp{%%} followed by a Lisp expression which must begin and end with -parentheses. The Lisp expression determines which dates the entry -applies to. - - Calendar mode provides commands to insert certain commonly used -sexp entries: - -@table @kbd -@item i a -Add an anniversary diary entry for the selected date -(@code{insert-anniversary-diary-entry}). -@item i b -Add a block diary entry for the current region -(@code{insert-block-diary-entry}). -@item i c -Add a cyclic diary entry starting at the date -(@code{insert-cyclic-diary-entry}). -@end table - -@kindex i a @r{(Calendar mode)} -@findex insert-anniversary-diary-entry - If you want to make a diary entry that applies to the anniversary of a -specific date, move point to that date and use the @kbd{i a} command. -This displays the end of your diary file in another window and inserts -the anniversary description; you can then type the rest of the diary -entry. The entry looks like this: - -@findex diary-anniversary - The effect of @kbd{i a} is to add a @code{diary-anniversary} sexp to your -diary file. You can also add one manually, for instance: - -@example -%%(diary-anniversary 10 31 1948) Arthur's birthday -@end example - -@noindent -This entry applies to October 31 in any year after 1948; @samp{10 31 -1948} specifies the date. (If you are using the European calendar -style, the month and day are interchanged.) The reason this expression -requires a beginning year is that advanced diary functions can use it to -calculate the number of elapsed years. - - A @dfn{block} diary entry applies to a specified range of consecutive -dates. Here is a block diary entry that applies to all dates from June -24, 1990 through July 10, 1990: - -@findex diary-block -@example -%%(diary-block 6 24 1990 7 10 1990) Vacation -@end example - -@noindent -The @samp{6 24 1990} indicates the starting date and the @samp{7 10 1990} -indicates the stopping date. (Again, if you are using the European calendar -style, the month and day are interchanged.) - -@kindex i b @r{(Calendar mode)} -@findex insert-block-diary-entry - To insert a block entry, place point and the mark on the two -dates that begin and end the range, and type @kbd{i b}. This command -displays the end of your diary file in another window and inserts the -block description; you can then type the diary entry. - -@kindex i c @r{(Calendar mode)} -@findex insert-cyclic-diary-entry - @dfn{Cyclic} diary entries repeat after a fixed interval of days. To -create one, select the starting date and use the @kbd{i c} command. The -command prompts for the length of interval, then inserts the entry, -which looks like this: - -@findex diary-cyclic -@example -%%(diary-cyclic 50 3 1 1990) Renew medication -@end example - -@noindent -This entry applies to March 1, 1990 and every 50th day following; -@samp{3 1 1990} specifies the starting date. (If you are using the -European calendar style, the month and day are interchanged.) - - All three of these commands make marking diary entries. To insert a -nonmarking entry, give a numeric argument to the command. For example, -@kbd{C-u i a} makes a nonmarking anniversary diary entry. - - Marking sexp diary entries in the calendar is @emph{extremely} -time-consuming, since every date visible in the calendar window must be -individually checked. So it's a good idea to make sexp diary entries -nonmarking (with @samp{&}) when possible. - - Another sophisticated kind of sexp entry, a @dfn{floating} diary entry, -specifies a regularly occurring event by offsets specified in days, -weeks, and months. It is comparable to a crontab entry interpreted by -the @code{cron} utility. Here is a nonmarking, floating diary entry -that applies to the last Thursday in November: - -@findex diary-float -@example -&%%(diary-float 11 4 -1) American Thanksgiving -@end example - -@noindent -The 11 specifies November (the eleventh month), the 4 specifies Thursday -(the fourth day of the week, where Sunday is numbered zero), and the -@minus{}1 specifies ``last'' (1 would mean ``first'', 2 would mean -``second'', @minus{}2 would mean ``second-to-last'', and so on). The -month can be a single month or a list of months. Thus you could change -the 11 above to @samp{'(1 2 3)} and have the entry apply to the last -Thursday of January, February, and March. If the month is @code{t}, the -entry applies to all months of the year.@refill - - The sexp feature of the diary allows you to specify diary entries -based on any Emacs Lisp expression. You can use the library of built-in -functions or you can write your own functions. The built-in functions -include the ones shown in this section, plus a few others (@pxref{Sexp -Diary Entries}). - - The generality of sexps lets you specify any diary entry that you can -describe algorithmically. Suppose you get paid on the 21st of the month -if it is a weekday, and to the Friday before if the 21st is on a -weekend. The diary entry - -@example -&%%(let ((dayname (calendar-day-of-week date)) - (day (car (cdr date)))) - (or (and (= day 21) (memq dayname '(1 2 3 4 5))) - (and (memq day '(19 20)) (= dayname 5))) - ) Pay check deposited -@end example - -@noindent -to just those dates. This example illustrates how the sexp can depend -on the variable @code{date}; this variable is a list (@var{month} -@var{day} @var{year}) that gives the Gregorian date for which the diary -entries are being found. If the value of the sexp is @code{t}, the -entry applies to that date. If the sexp evaluates to @code{nil}, the -entry does @emph{not} apply to that date. - - -@node Calendar Customization,,Diary, Calendar/Diary -@subsection Customizing the Calendar and Diary - - There are many customizations that you can use to make the calendar and -diary suit your personal tastes. - -@menu -* Calendar Customizing:: Defaults you can set. -* Holiday Customizing:: Defining your own holidays. -* Date Display Format:: Changing the format. -* Time Display Format:: Changing the format. -* Daylight Savings:: Changing the default. -* Diary Customizing:: Defaults you can set. -* Hebrew/Islamic Entries:: How to obtain them. -* Fancy Diary Display:: Enhancing the diary display, sorting entries. -* Included Diary Files:: Sharing a common diary file. -* Sexp Diary Entries:: Fancy things you can do. -* Appt Customizing:: Customizing appointment reminders. -@end menu - -@node Calendar Customizing -@subsubsection Customizing the Calendar -@vindex view-diary-entries-initially - - If you set the variable @code{view-diary-entries-initially} to -@code{t}, calling up the calendar automatically displays the diary -entries for the current date as well. The diary dates appear only if -the current date is visible. If you add both of the following lines to -your @file{.emacs} file:@refill - -@example -(setq view-diary-entries-initially t) -(calendar) -@end example - -@noindent -this displays both the calendar and diary windows whenever you start Emacs. - -@vindex view-calendar-holidays-initially - Similarly, if you set the variable -@code{view-calendar-holidays-initially} to @code{t}, entering the -calendar automatically displays a list of holidays for the current -three-month period. The holiday list appears in a separate -window. - -@vindex mark-diary-entries-in-calendar - You can set the variable @code{mark-diary-entries-in-calendar} to -@code{t} in order to mark any dates with diary entries. This takes -effect whenever the calendar window contents are recomputed. There are -two ways of marking these dates: by changing the face (@pxref{Faces}), -if the display supports that, or by placing a plus sign (@samp{+}) -beside the date otherwise. - -@vindex mark-holidays-in-calendar - Similarly, setting the variable @code{mark-holidays-in-calendar} to -@code{t} marks holiday dates, either with a change of face or with an -asterisk (@samp{*}). - -@vindex calendar-holiday-marker -@vindex diary-entry-marker - The variable @code{calendar-holiday-marker} specifies how to mark a -date as being a holiday. Its value may be a character to insert next to -the date, or a face name to use for displaying the date. Likewise, the -variable @code{diary-entry-marker} specifies how to mark a date that has -diary entries. The calendar creates faces named @code{holiday-face} and -@code{diary-face} for these purposes; those symbols are the default -values of these variables, when Emacs supports multiple faces on your -terminal. - -@vindex calendar-load-hook - The variable @code{calendar-load-hook} is a normal hook run when the -calendar package is first loaded (before actually starting to display -the calendar). - -@vindex initial-calendar-window-hook - Starting the calendar runs the normal hook -@code{initial-calendar-window-hook}. Recomputation of the calendar -display does not run this hook. But if you leave the calendar with the -@kbd{q} command and reenter it, the hook runs again.@refill - -@vindex today-visible-calendar-hook - The variable @code{today-visible-calendar-hook} is a normal hook run -after the calendar buffer has been prepared with the calendar when the -current date is visible in the window. One use of this hook is to -replace today's date with asterisks; to do that, use the hook function -@code{calendar-star-date}. - -@findex calendar-star-date -@example -(add-hook 'today-visible-calendar-hook 'calendar-star-date) -@end example - -@noindent -Another standard hook function marks the current date, either by -changing its face or by adding an asterisk. Here's how to use it: - -@findex calendar-mark-today -@example -(add-hook 'today-visible-calendar-hook 'calendar-mark-today) -@end example - -@noindent -@vindex calendar-today-marker -The variable @code{calendar-today-marker} specifies how to mark today's -date. Its value should be a character to insert next to the date or a -face name to use for displaying the date. A face named -@code{calendar-today-face} is provided for this purpose; that symbol is -the default for this variable when Emacs supports multiple faces on your -terminal. - -@vindex today-invisible-calendar-hook -@noindent - A similar normal hook, @code{today-invisible-calendar-hook} is run if -the current date is @emph{not} visible in the window. - -@node Holiday Customizing -@subsubsection Customizing the Holidays - -@vindex calendar-holidays -@vindex christian-holidays -@vindex hebrew-holidays -@vindex islamic-holidays - Emacs knows about holidays defined by entries on one of several lists. -You can customize these lists of holidays to your own needs, adding or -deleting holidays. The lists of holidays that Emacs uses are for -general holidays (@code{general-holidays}), local holidays -(@code{local-holidays}), Christian holidays (@code{christian-holidays}), -Hebrew (Jewish) holidays (@code{hebrew-holidays}), Islamic (Moslem) -holidays (@code{islamic-holidays}), and other holidays -(@code{other-holidays}). - -@vindex general-holidays - The general holidays are, by default, holidays common throughout the -United States. To eliminate these holidays, set @code{general-holidays} -to @code{nil}. - -@vindex local-holidays - There are no default local holidays (but sites may supply some). You -can set the variable @code{local-holidays} to any list of holidays, as -described below. - -@vindex all-christian-calendar-holidays -@vindex all-hebrew-calendar-holidays -@vindex all-islamic-calendar-holidays - By default, Emacs does not include all the holidays of the religions -that it knows, only those commonly found in secular calendars. For a -more extensive collection of religious holidays, you can set any (or -all) of the variables @code{all-christian-calendar-holidays}, -@code{all-hebrew-calendar-holidays}, or -@code{all-islamic-calendar-holidays} to @code{t}. If you want to -eliminate the religious holidays, set any or all of the corresponding -variables @code{christian-holidays}, @code{hebrew-holidays}, and -@code{islamic-holidays} to @code{nil}.@refill - -@vindex other-holidays - You can set the variable @code{other-holidays} to any list of -holidays. This list, normally empty, is intended for individual use. - -@cindex holiday forms - Each of the lists (@code{general-holidays}, @code{local-holidays}, -@code{christian-holidays}, @code{hebrew-holidays}, -@code{islamic-holidays}, and @code{other-holidays}) is a list of -@dfn{holiday forms}, each holiday form describing a holiday (or -sometimes a list of holidays). - - Here is a table of the possible kinds of holiday form. Day numbers -and month numbers count starting from 1, but ``dayname'' numbers -count Sunday as 0. The element @var{string} is always the -name of the holiday, as a string. - -@table @code -@item (holiday-fixed @var{month} @var{day} @var{string}) -A fixed date on the Gregorian calendar. @var{month} and @var{day} are -numbers, @var{string} is the name of the holiday. - -@item (holiday-float @var{month} @var{dayname} @var{k} @var{string}) -The @var{k}th @var{dayname} in @var{month} on the Gregorian calendar -(@var{dayname}=0 for Sunday, and so on); negative @var{k} means count back -from the end of the month. @var{string} is the name of the holiday. - -@item (holiday-hebrew @var{month} @var{day} @var{string}) -A fixed date on the Hebrew calendar. @var{month} and @var{day} are -numbers, @var{string} is the name of the holiday. - -@item (holiday-islamic @var{month} @var{day} @var{string}) -A fixed date on the Islamic calendar. @var{month} and @var{day} are -numbers, @var{string} is the name of the holiday. - -@item (holiday-julian @var{month} @var{day} @var{string}) -A fixed date on the Julian calendar. @var{month} and @var{day} are -numbers, @var{string} is the name of the holiday. - -@item (holiday-sexp @var{sexp} @var{string}) -A date calculated by the Lisp expression @var{sexp}. The expression -should use the variable @code{year} to compute and return the date of a -holiday, or @code{nil} if the holiday doesn't happen this year. The -value of @var{sexp} must represent the date as a list of the form -@code{(@var{month} @var{day} @var{year})}. @var{string} is the name of -the holiday. - -@item (if @var{condition} @var{holiday-form} &optional @var{holiday-form}) -A holiday that happens only if @var{condition} is true. - -@item (@var{function} @r{[}@var{args}@r{]}) -A list of dates calculated by the function @var{function}, called with -arguments @var{args}. -@end table - - For example, suppose you want to add Bastille Day, celebrated in -France on July 14. You can do this by adding the following line -to your @file{.emacs} file: - -@smallexample -(setq other-holidays '((holiday-fixed 7 14 "Bastille Day"))) -@end smallexample - -@noindent -The holiday form @code{(holiday-fixed 7 14 "Bastille Day")} specifies the -fourteenth day of the seventh month (July). - - Many holidays occur on a specific day of the week, at a specific time -of month. Here is a holiday form describing Hurricane Supplication Day, -celebrated in the Virgin Islands on the fourth Monday in August: - -@smallexample -(holiday-float 8 1 4 "Hurricane Supplication Day") -@end smallexample - -@noindent -Here the 8 specifies August, the 1 specifies Monday (Sunday is 0, -Tuesday is 2, and so on), and the 4 specifies the fourth occurrence in -the month (1 specifies the first occurrence, 2 the second occurrence, -@minus{}1 the last occurrence, @minus{}2 the second-to-last occurrence, and -so on). - - You can specify holidays that occur on fixed days of the Hebrew, -Islamic, and Julian calendars too. For example, - -@smallexample -(setq other-holidays - '((holiday-hebrew 10 2 "Last day of Hanukkah") - (holiday-islamic 3 12 "Mohammed's Birthday") - (holiday-julian 4 2 "Jefferson's Birthday"))) -@end smallexample - -@noindent -adds the last day of Hanukkah (since the Hebrew months are numbered with -1 starting from Nisan), the Islamic feast celebrating Mohammed's -birthday (since the Islamic months are numbered from 1 starting with -Muharram), and Thomas Jefferson's birthday, which is 2 April 1743 on the -Julian calendar. - - To include a holiday conditionally, use either Emacs Lisp's @code{if} or the -@code{holiday-sexp} form. For example, American presidential elections -occur on the first Tuesday after the first Monday in November of years -divisible by 4: - -@smallexample -(holiday-sexp (if (= 0 (% year 4)) - (calendar-gregorian-from-absolute - (1+ (calendar-dayname-on-or-before - 1 (+ 6 (calendar-absolute-from-gregorian - (list 11 1 year)))))) - "US Presidential Election")) -@end smallexample - -@noindent -or - -@smallexample -(if (= 0 (% displayed-year 4)) - (fixed 11 - (extract-calendar-day - (calendar-gregorian-from-absolute - (1+ (calendar-dayname-on-or-before - 1 (+ 6 (calendar-absolute-from-gregorian - (list 11 1 displayed-year))))))) - "US Presidential Election")) -@end smallexample - - Some holidays just don't fit into any of these forms because special -calculations are involved in their determination. In such cases you -must write a Lisp function to do the calculation. To include eclipses, -for example, add @code{(eclipses)} to @code{other-holidays} -and write an Emacs Lisp function @code{eclipses} that returns a -(possibly empty) list of the relevant Gregorian dates among the range -visible in the calendar window, with descriptive strings, like this: - -@smallexample -(((6 27 1991) "Lunar Eclipse") ((7 11 1991) "Solar Eclipse") ... ) -@end smallexample - -@node Date Display Format -@subsubsection Date Display Format -@vindex calendar-date-display-form - - You can customize the manner of displaying dates in the diary, in mode -lines, and in messages by setting @code{calendar-date-display-form}. -This variable holds a list of expressions that can involve the variables -@code{month}, @code{day}, and @code{year}, which are all numbers in -string form, and @code{monthname} and @code{dayname}, which are both -alphabetic strings. In the American style, the default value of this -list is as follows: - -@smallexample -((if dayname (concat dayname ", ")) monthname " " day ", " year) -@end smallexample - -@noindent -while in the European style this value is the default: - -@smallexample -((if dayname (concat dayname ", ")) day " " monthname " " year) -@end smallexample - -+@noindent -The ISO standard date representation is this: - -@smallexample -(year "-" month "-" day) -@end smallexample - -@noindent -This specifies a typical American format: - -@smallexample -(month "/" day "/" (substring year -2)) -@end smallexample - -@node Time Display Format -@subsubsection Time Display Format -@vindex calendar-time-display-form - - The calendar and diary by default display times of day in the -conventional American style with the hours from 1 through 12, minutes, -and either @samp{am} or @samp{pm}. If you prefer the European style, -also known in the US as military, in which the hours go from 00 to 23, -you can alter the variable @code{calendar-time-display-form}. This -variable is a list of expressions that can involve the variables -@code{12-hours}, @code{24-hours}, and @code{minutes}, which are all -numbers in string form, and @code{am-pm} and @code{time-zone}, which are -both alphabetic strings. The default value of -@code{calendar-time-display-form} is as follows: - -@smallexample -(12-hours ":" minutes am-pm - (if time-zone " (") time-zone (if time-zone ")")) -@end smallexample - -@noindent -Here is a value that provides European style times: - -@smallexample -(24-hours ":" minutes - (if time-zone " (") time-zone (if time-zone ")")) -@end smallexample - -@noindent -gives military-style times like @samp{21:07 (UT)} if time zone names are -defined, and times like @samp{21:07} if they are not. - -@node Daylight Savings -@subsubsection Daylight Savings Time -@cindex daylight savings time - - Emacs understands the difference between standard time and daylight -savings time---the times given for sunrise, sunset, solstices, -equinoxes, and the phases of the moon take that into account. The rules -for daylight savings time vary from place to place and have also varied -historically from year to year. To do the job properly, Emacs needs to -know which rules to use. - - Some operating systems keep track of the rules that apply to the place -where you are; on these systems, Emacs gets the information it needs -from the system automatically. If some or all of this information is -missing, Emacs fills in the gaps with the rules currently used in -Cambridge, Massachusetts. If the resulting rules are not what you want, -you can tell Emacs the rules to use by setting certain variables. - -@vindex calendar-daylight-savings-starts -@vindex calendar-daylight-savings-ends - If the default choice of rules is not appropriate for your location, -you can tell Emacs the rules to use by setting the variables -@code{calendar-daylight-savings-starts} and -@code{calendar-daylight-savings-ends}. Their values should be Lisp -expressions that refer to the variable @code{year}, and evaluate to the -Gregorian date on which daylight savings time starts or (respectively) -ends, in the form of a list @code{(@var{month} @var{day} @var{year})}. -The values should be @code{nil} if your area does not use daylight -savings time. - - Emacs uses these expressions to determine the starting date of -daylight savings time for the holiday list and for correcting times of -day in the solar and lunar calculations. - - The values for Cambridge, Massachusetts are as follows: - -@example -@group -(calendar-nth-named-day 1 0 4 year) -(calendar-nth-named-day -1 0 10 year) -@end group -@end example - -@noindent -That is, the first 0th day (Sunday) of the fourth month (April) in -the year specified by @code{year}, and the last Sunday of the tenth month -(October) of that year. If daylight savings time were -changed to start on October 1, you would set -@code{calendar-daylight-savings-starts} to this: - -@example -(list 10 1 year) -@end example - - For a more complex example, suppose daylight savings time begins on -the first of Nisan on the Hebrew calendar. You should set -@code{calendar-daylight-savings-starts} to this value: - -@example -(calendar-gregorian-from-absolute - (calendar-absolute-from-hebrew - (list 1 1 (+ year 3760)))) -@end example - -@noindent -because Nisan is the first month in the Hebrew calendar and the Hebrew -year differs from the Gregorian year by 3760 at Nisan. - - If there is no daylight savings time at your location, or if you want -all times in standard time, set @code{calendar-daylight-savings-starts} -and @code{calendar-daylight-savings-ends} to @code{nil}. - -@vindex calendar-daylight-time-offset - The variable @code{calendar-daylight-time-offset} specifies the -difference between daylight savings time and standard time, measured in -minutes. The value for Cambridge, Massachusetts is 60. - -@c @vindex calendar-daylight-savings-starts-time too long! -@vindex calendar-daylight-savings-ends-time - The two variables @code{calendar-daylight-savings-starts-time} and -@code{calendar-daylight-savings-ends-time} specify the number of minutes -after midnight local time when the transition to and from daylight -savings time should occur. For Cambridge, Massachusetts both variables' -values are 120. - -@node Diary Customizing -@subsubsection Customizing the Diary - -@vindex holidays-in-diary-buffer - Ordinarily, the mode line of the diary buffer window indicates any -holidays that fall on the date of the diary entries. The process of -checking for holidays can take several seconds, so including holiday -information delays the display of the diary buffer noticeably. If you'd -prefer to have a faster display of the diary buffer but without the -holiday information, set the variable @code{holidays-in-diary-buffer} to -@code{nil}.@refill - -@vindex number-of-diary-entries - The variable @code{number-of-diary-entries} controls the number of -days of diary entries to be displayed at one time. It affects the -initial display when @code{view-diary-entries-initially} is @code{t}, as -well as the command @kbd{M-x diary}. For example, the default value is -1, which says to display only the current day's diary entries. If the -value is 2, both the current day's and the next day's entries are -displayed. The value can also be a vector of seven elements: for -example, if the value is @code{[0 2 2 2 2 4 1]} then no diary entries -appear on Sunday, the current date's and the next day's diary entries -appear Monday through Thursday, Friday through Monday's entries appear -on Friday, while on Saturday only that day's entries appear. - -@vindex print-diary-entries-hook -@findex print-diary-entries - The variable @code{print-diary-entries-hook} is a normal hook run -after preparation of a temporary buffer containing just the diary -entries currently visible in the diary buffer. (The other, irrelevant -diary entries are really absent from the temporary buffer; in the diary -buffer, they are merely hidden.) The default value of this hook does -the printing with the command @code{lpr-buffer}. If you want to use a -different command to do the printing, just change the value of this -hook. Other uses might include, for example, rearranging the lines into -order by day and time. - -@vindex diary-date-forms - You can customize the form of dates in your diary file, if neither the -standard American nor European styles suits your needs, by setting the -variable @code{diary-date-forms}. This variable is a list of patterns -for recognizing a date. Each date pattern is a list whose elements may -be regular expressions (@pxref{Regexps}) or the symbols -@code{month}, @code{day}, @code{year}, @code{monthname}, and -@code{dayname}. All these elements serve as patterns that match certain -kinds of text in the diary file. In order for the date pattern, as a -whole, to match, all of its elements must match consecutively. - - A regular expression in a date pattern matches in its usual fashion, -using the standard syntax table altered so that @samp{*} is a word -constituent. - - The symbols @code{month}, @code{day}, @code{year}, @code{monthname}, -and @code{dayname} match the month number, day number, year number, -month name, and day name of the date being considered. The symbols that -match numbers allow leading zeros; those that match names allow -three-letter abbreviations and capitalization. All the symbols can -match @samp{*}; since @samp{*} in a diary entry means ``any day'', ``any -month'', and so on, it should match regardless of the date being -considered. - - The default value of @code{diary-date-forms} in the American style is -this: - -@example -((month "/" day "[^/0-9]") - (month "/" day "/" year "[^0-9]") - (monthname " *" day "[^,0-9]") - (monthname " *" day ", *" year "[^0-9]") - (dayname "\\W")) -@end example - -@noindent -Emacs matches of the diary entries with the date forms is done with the -standard syntax table from Fundamental mode -(@pxref{Syntax Tables,,,lispref,XEmacs Lisp Reference Manual}), -but with the @samp{*} changed so that it is a word constituent.@refill - - The date patterns in the list must be @emph{mutually exclusive} and -must not match any portion of the diary entry itself, just the date and -one character of whitespace. If, to be mutually exclusive, the pattern -must match a portion of the diary entry text---beyond the whitespace -that ends the date---then the first element of the date pattern -@emph{must} be @code{backup}. This causes the date recognizer to back -up to the beginning of the current word of the diary entry, after -finishing the match. Even if you use @code{backup}, the date pattern -must absolutely not match more than a portion of the first word of the -diary entry. The default value of @code{diary-date-forms} in the -European style is this list: - -@example -((day "/" month "[^/0-9]") - (day "/" month "/" year "[^0-9]") - (backup day " *" monthname "\\W+\\<[^*0-9]") - (day " *" monthname " *" year "[^0-9]") - (dayname "\\W")) -@end example - -@noindent -Notice the use of @code{backup} in the third pattern, because it needs -to match part of a word beyond the date itself to distinguish it from -the fourth pattern. - -@node Hebrew/Islamic Entries -@subsubsection Hebrew- and Islamic-Date Diary Entries - - Your diary file can have entries based on Hebrew or Islamic dates, as -well as entries based on the world-standard Gregorian calendar. -However, because recognition of such entries is time-consuming and most -people don't use them, you must explicitly enable their use. If you -want the diary to recognize Hebrew-date diary entries, for example, -you must do this: - -@vindex nongregorian-diary-listing-hook -@vindex nongregorian-diary-marking-hook -@findex list-hebrew-diary-entries -@findex mark-hebrew-diary-entries -@smallexample -(add-hook 'nongregorian-diary-listing-hook 'list-hebrew-diary-entries) -(add-hook 'nongregorian-diary-marking-hook 'mark-hebrew-diary-entries) -@end smallexample - -@noindent -If you want Islamic-date entries, do this: - -@findex list-islamic-diary-entries -@findex mark-islamic-diary-entries -@smallexample -(add-hook 'nongregorian-diary-listing-hook 'list-islamic-diary-entries) -(add-hook 'nongregorian-diary-marking-hook 'mark-islamic-diary-entries) -@end smallexample - - Hebrew- and Islamic-date diary entries have the same formats as -Gregorian-date diary entries, except that @samp{H} precedes a Hebrew -date and @samp{I} precedes an Islamic date. Moreover, because the -Hebrew and Islamic month names are not uniquely specified by the first -three letters, you may not abbreviate them. For example, a diary entry -for the Hebrew date Heshvan 25 could look like this: - -@smallexample -HHeshvan 25 Happy Hebrew birthday! -@end smallexample - -@noindent -and would appear in the diary for any date that corresponds to Heshvan 25 -on the Hebrew calendar. And here is Islamic-date diary entry that matches -Dhu al-Qada 25: - -@smallexample -IDhu al-Qada 25 Happy Islamic birthday! -@end smallexample - -@noindent -and would appear in the diary for any date that corresponds to Dhu al-Qada 25 -on the Islamic calendar. - - As with Gregorian-date diary entries, Hebrew- and Islamic-date entries -are nonmarking if they are preceded with an ampersand (@samp{&}). - - Here is a table of commands used in the calendar to create diary entries -that match the selected date and other dates that are similar in the Hebrew -or Islamic calendar: - -@table @kbd -@item i h d -Add a diary entry for the Hebrew date corresponding to the selected date -(@code{insert-hebrew-diary-entry}). -@item i h m -Add a diary entry for the day of the Hebrew month corresponding to the -selected date (@code{insert-monthly-hebrew-diary-entry}). This diary -entry matches any date that has the same Hebrew day-within-month as the -selected date. -@item i h y -Add a diary entry for the day of the Hebrew year corresponding to the -selected date (@code{insert-yearly-hebrew-diary-entry}). This diary -entry matches any date which has the same Hebrew month and day-within-month -as the selected date. -@item i i d -Add a diary entry for the Islamic date corresponding to the selected date -(@code{insert-islamic-diary-entry}). -@item i i m -Add a diary entry for the day of the Islamic month corresponding to the -selected date (@code{insert-monthly-islamic-diary-entry}). -@item i i y -Add a diary entry for the day of the Islamic year corresponding to the -selected date (@code{insert-yearly-islamic-diary-entry}). -@end table - -@findex insert-hebrew-diary-entry -@findex insert-monthly-hebrew-diary-entry -@findex insert-yearly-hebrew-diary-entry -@findex insert-islamic-diary-entry -@findex insert-monthly-islamic-diary-entry -@findex insert-yearly-islamic-diary-entry - These commands work much like the corresponding commands for ordinary -diary entries: they apply to the date that point is on in the calendar -window, and what they do is insert just the date portion of a diary entry -at the end of your diary file. You must then insert the rest of the -diary entry. - -@node Fancy Diary Display -@subsubsection Fancy Diary Display -@vindex diary-display-hook -@findex simple-diary-display - - Diary display works by preparing the diary buffer and then running the -hook @code{diary-display-hook}. The default value of this hook -(@code{simple-diary-display}) hides the irrelevant diary entries and -then displays the buffer. However, if you specify the hook as follows, - -@cindex diary buffer -@findex fancy-diary-display -@example -(add-hook 'diary-display-hook 'fancy-diary-display) -@end example - -@noindent -this enables fancy diary display. It displays diary entries and -holidays by copying them into a special buffer that exists only for the -sake of display. Copying to a separate buffer provides an opportunity -to change the displayed text to make it prettier---for example, to sort -the entries by the dates they apply to. - - As with simple diary display, you can print a hard copy of the buffer -with @code{print-diary-entries}. To print a hard copy of a day-by-day -diary for a week by positioning point on Sunday of that week, type -@kbd{7 d} and then do @kbd{M-x print-diary-entries}. As usual, the -inclusion of the holidays slows down the display slightly; you can speed -things up by setting the variable @code{holidays-in-diary-buffer} to -@code{nil}. - -@vindex diary-list-include-blanks - Ordinarily, the fancy diary buffer does not show days for which there are -no diary entries, even if that day is a holiday. If you want such days to be -shown in the fancy diary buffer, set the variable -@code{diary-list-include-blanks} to @code{t}.@refill - -@cindex sorting diary entries - If you use the fancy diary display, you can use the normal hook -@code{list-diary-entries-hook} to sort each day's diary entries by their -time of day. Add this line to your @file{.emacs} file: - -@findex sort-diary-entries -@example -(add-hook 'list-diary-entries-hook 'sort-diary-entries t) -@end example - -@noindent -For each day, this sorts diary entries that begin with a recognizable -time of day according to their times. Diary entries without times come -first within each day. - -@node Included Diary Files -@subsubsection Included Diary Files - - Fancy diary display also has the ability to process included diary -files. This permits a group of people to share a diary file for events -that apply to all of them. Lines in the diary file of this form: - -@smallexample -#include "@var{filename}" -@end smallexample - -@noindent -includes the diary entries from the file @var{filename} in the fancy -diary buffer. The include mechanism is recursive, so that included files -can include other files, and so on; you must be careful not to have a -cycle of inclusions, of course. Here is how to enable the include -facility: - -@vindex list-diary-entries-hook -@vindex mark-diary-entries-hook -@findex include-other-diary-files -@findex mark-included-diary-files -@smallexample -(add-hook 'list-diary-entries-hook 'include-other-diary-files) -(add-hook 'mark-diary-entries-hook 'mark-included-diary-files) -@end smallexample - -The include mechanism works only with the fancy diary display, because -ordinary diary display shows the entries directly from your diary file. - -@node Sexp Diary Entries -@subsubsection Sexp Entries and the Fancy Diary Display -@cindex sexp diary entries - - Sexp diary entries allow you to do more than just have complicated -conditions under which a diary entry applies. If you use the fancy -diary display, sexp entries can generate the text of the entry depending -on the date itself. For example, an anniversary diary entry can insert -the number of years since the anniversary date into the text of the -diary entry. Thus the @samp{%d} in this dairy entry: - -@findex diary-anniversary -@smallexample -%%(diary-anniversary 10 31 1948) Arthur's birthday (%d years old) -@end smallexample - -@noindent -gets replaced by the age, so on October 31, 1990 the entry appears in -the fancy diary buffer like this: - -@smallexample -Arthur's birthday (42 years old) -@end smallexample - -@noindent -If the diary file instead contains this entry: - -@smallexample -%%(diary-anniversary 10 31 1948) Arthur's %d%s birthday -@end smallexample - -@noindent -the entry in the fancy diary buffer for October 31, 1990 appears like this: - -@smallexample -Arthur's 42nd birthday -@end smallexample - - Similarly, cyclic diary entries can interpolate the number of repetitions -that have occurred: - -@findex diary-cyclic -@smallexample -%%(diary-cyclic 50 1 1 1990) Renew medication (%d%s time) -@end smallexample - -@noindent -looks like this: - -@smallexample -Renew medication (5th time) -@end smallexample - -@noindent -in the fancy diary display on September 8, 1990. - - The generality of sexp diary entries lets you specify any diary entry -that you can describe algorithmically. A sexp diary entry contains an -expression that computes whether the entry applies to any given date. -If its value is non-@code{nil}, the entry applies to that date; -otherwise, it does not. The expression can use the variable @code{date} -to find the date being considered; its value is a list (@var{month} -@var{day} @var{year}) that refers to the Gregorian calendar. - - Suppose you get paid on the 21st of the month if it is a weekday, and -on the Friday before if the 21st is on a weekend. Here is how to write -a sexp diary entry that matches those dates: - -@smallexample -&%%(let ((dayname (calendar-day-of-week date)) - (day (car (cdr date)))) - (or (and (= day 21) (memq dayname '(1 2 3 4 5))) - (and (memq day '(19 20)) (= dayname 5))) - ) Pay check deposited -@end smallexample - -@noindent -applies to just those dates. This example illustrates how the sexp can -depend on the variable @code{date}; this variable is a list (@var{month} -@var{day} @var{year}) that gives the Gregorian date for which the diary -entries are being found. If the value of the expression is @code{t}, -the entry applies to that date. If the expression evaluates to -@code{nil}, the entry does @emph{not} apply to that date. - - The following sexp diary entries take advantage of the ability (in the fancy -diary display) to concoct diary entries whose text varies based on the date: - -@findex diary-sunrise-sunset -@findex diary-phases-of-moon -@findex diary-day-of-year -@findex diary-iso-date -@findex diary-julian-date -@findex diary-astro-day-number -@findex diary-hebrew-date -@findex diary-islamic-date -@findex diary-french-date -@findex diary-mayan-date -@table @code -@item %%(diary-sunrise-sunset) -Make a diary entry for the local times of today's sunrise and sunset. -@item %%(diary-phases-of-moon) -Make a diary entry for the phases (quarters) of the moon. -@item %%(diary-day-of-year) -Make a diary entry with today's day number in the current year and the number -of days remaining in the current year. -@item %%(diary-iso-date) -Make a diary entry with today's equivalent ISO commercial date. -@item %%(diary-julian-date) -Make a diary entry with today's equivalent date on the Julian calendar. -@item %%(diary-astro-day-number) -Make a diary entry with today's equivalent astronomical (Julian) day number. -@item %%(diary-hebrew-date) -Make a diary entry with today's equivalent date on the Hebrew calendar. -@item %%(diary-islamic-date) -Make a diary entry with today's equivalent date on the Islamic calendar. -@item %%(diary-french-date) -Make a diary entry with today's equivalent date on the French Revolutionary -calendar. -@item %%(diary-mayan-date) -Make a diary entry with today's equivalent date on the Mayan calendar. -@end table - -@noindent -Thus including the diary entry - -@smallexample -&%%(diary-hebrew-date) -@end smallexample - -@noindent -causes every day's diary display to contain the equivalent date on the -Hebrew calendar, if you are using the fancy diary display. (With simple -diary display, the line @samp{&%%(diary-hebrew-date)} appears in the -diary for any date, but does nothing particularly useful.) - - These functions can be used to construct sexp diary entries based on -the Hebrew calendar in certain standard ways: - -@cindex rosh hodesh -@findex diary-rosh-hodesh -@cindex parasha, weekly -@findex diary-parasha -@cindex candle lighting times -@findex diary-sabbath-candles -@cindex omer count -@findex diary-omer -@cindex yahrzeits -@findex diary-yahrzeit -@table @code -@item %%(diary-rosh-hodesh) -Make a diary entry that tells the occurrence and ritual announcement of each -new Hebrew month. -@item %%(diary-parasha) -Make a Saturday diary entry that tells the weekly synagogue scripture reading. -@item %%(diary-sabbath-candles) -Make a Friday diary entry that tells the @emph{local time} of Sabbath -candle lighting. -@item %%(diary-omer) -Make a diary entry that gives the omer count, when appropriate. -@item %%(diary-yahrzeit @var{month} @var{day} @var{year}) @var{name} -Make a diary entry marking the anniversary of a date of death. The date -is the @emph{Gregorian} (civil) date of death. The diary entry appears -on the proper Hebrew calendar anniversary and on the day before. (In -the European style, the order of the parameters is changed to @var{day}, -@var{month}, @var{year}.) -@end table - -@node Appt Customizing -@subsubsection Customizing Appointment Reminders - - You can specify exactly how Emacs reminds you of an appointment, and -how far in advance it begins doing so, by setting these variables: - -@vindex appt-message-warning-time -@vindex appt-audible -@vindex appt-visible -@vindex appt-display-mode-line -@vindex appt-msg-window -@vindex appt-display-duration -@table @code -@item appt-message-warning-time -The time in minutes before an appointment that the reminder begins. The -default is 10 minutes. -@item appt-audible -If this is @code{t} (the default), Emacs rings the terminal bell for -appointment reminders. -@item appt-visible -If this is @code{t} (the default), Emacs displays the appointment -message in echo area. -@item appt-display-mode-line -If this is @code{t} (the default), Emacs displays the number of minutes -to the appointment on the mode line. -@item appt-msg-window -If this is @code{t} (the default), Emacs displays the appointment -message in another window. -@item appt-display-duration -The number of seconds an appointment message is displayed. The default -is 5 seconds. -@end table diff --git a/man/xemacs/cmdargs.texi b/man/xemacs/cmdargs.texi deleted file mode 100644 index a41ee2b..0000000 --- a/man/xemacs/cmdargs.texi +++ /dev/null @@ -1,278 +0,0 @@ - -@node Command Switches, Startup Paths, Exiting, Top -@section Command Line Switches and Arguments -@cindex command line arguments -@cindex arguments (from shell) - - XEmacs supports command line arguments you can use to request -various actions when invoking Emacs. The commands are for compatibility -with other editors and for sophisticated activities. If you are using -XEmacs under the X window system, you can also use a number of -standard Xt command line arguments. Command line arguments are not usually -needed for editing with Emacs; new users can skip this section. - -Many editors are designed to be started afresh each time you want to -edit. You start the editor to edit one file; then exit the editor. The -next time you want to edit either another file or the same one, you -start the editor again. Under these circumstances, it makes sense to use a -command line argument to say which file to edit. - - The recommended way to use XEmacs is to start it only once, just -after you log in, and do all your editing in the same Emacs process. -Each time you want to edit a file, you visit it using the existing -Emacs. Emacs creates a new buffer for each file, and (unless you kill -some of the buffers) Emacs eventually has many files in it ready for -editing. Usually you do not kill the Emacs process until you are about -to log out. Since you usually read files by typing commands to Emacs, -command line arguments for specifying a file when Emacs is started are seldom -needed. - - Emacs accepts command-line arguments that specify files to visit, -functions to call, and other activities and operating modes. If you are -running XEmacs under the X window system, a number of standard -Xt command line arguments are available as well. - -The following subsections list: -@itemize @bullet -@item -Command line arguments that you can always use -@item -Command line arguments that have to appear at the beginning of the -argument list -@item -Command line arguments that are only relevant if you are running XEmacs -under X -@end itemize - -@subsection Command Line Arguments for Any Position - Command line arguments are processed in the order they appear on the -command line; however, certain arguments (the ones in the -second table) must be at the front of the list if they are used. - - Here are the arguments allowed: - -@table @samp -@item @var{file} -Visit @var{file} using @code{find-file}. @xref{Visiting}. - -@item +@var{linenum} @var{file} -Visit @var{file} using @code{find-file}, then go to line number -@var{linenum} in it. - -@item -load @var{file} -@itemx -l @var{file} -Load a file @var{file} of Lisp code with the function @code{load}. -@xref{Lisp Libraries}. - -@item -funcall @var{function} -@itemx -f @var{function} -Call Lisp function @var{function} with no arguments. - -@item -eval @var{function} -Interpret the next argument as a Lisp expression, and evaluate it. -You must be very careful of the shell quoting here. - -@item -insert @var{file} -@itemx -i @var{file} -Insert the contents of @var{file} into the current buffer. This is like -what @kbd{M-x insert-buffer} does; @xref{Misc File Ops}. - -@item -kill -Exit from Emacs without asking for confirmation. - -@item -version -@itemx -V -Prints version information. This implies @samp{-batch}. - -@example -% xemacs -version -XEmacs 19.13 of Mon Aug 21 1995 on willow (usg-unix-v) [formerly Lucid Emacs] -@end example - -@item -help -Prints a summary of command-line options and then exits. -@end table - -@subsection Command Line Arguments (Beginning of Line Only) - The following arguments are recognized only at the beginning of the -command line. If more than one of them appears, they must appear in the -order in which they appear in this table. - -@table @samp -@item -t @var{file} -Use @var{file} instead of the terminal for input and output. This -implies the @samp{-nw} option, documented below. - -@cindex batch mode -@item -batch -Run Emacs in @dfn{batch mode}, which means that the text being edited is -not displayed and the standard Unix interrupt characters such as -@kbd{C-z} and @kbd{C-c} continue to have their normal effect. Emacs in -batch mode outputs to @code{stderr} only what would normally be printed -in the echo area under program control. - -Batch mode is used for running programs written in Emacs Lisp from shell -scripts, makefiles, and so on. Normally the @samp{-l} switch or -@samp{-f} switch will be used as well, to invoke a Lisp program to do -the batch processing. - -@samp{-batch} implies @samp{-q} (do not load an init file). It also -causes Emacs to kill itself after all command switches have been -processed. In addition, auto-saving is not done except in buffers for -which it has been explicitly requested. - -@item -nw -Start up XEmacs in TTY mode (using the TTY XEmacs was started from), -rather than trying to connect to an X display. Note that this happens -automatically if the @samp{DISPLAY} environment variable is not set. - -@item -debug-init -Enter the debugger if an error in the init file occurs. - -@item -debug-paths -Displays information on how XEmacs constructs the various paths into its -hierarchy on startup. (See also @pxref{Startup Paths}.) - -@item -unmapped -Do not map the initial frame. This is useful if you want to start up -XEmacs as a server (e.g. for gnuserv screens or external client widgets). - -@item -no-init-file -@itemx -q -Do not load your Emacs init file @file{~/.emacs}. - -@item -no-site-file -Do not load the site-specific init file @file{lisp/site-start.el}. - -@item -no-autoloads -Do not load global symbol files (@file{auto-autoloads}) at startup. -This implies @samp{-vanilla}. - -@item -no-early-packages -Do not process early packages. (For more information on startup issues -concerning the package system, @xref{Startup Paths}.) - -@item -vanilla -This is equivalent to @samp{-q -no-site-file -no-early-packages}. - -@item -user @var{user} -@itemx -u @var{user} -Load @var{user}'s Emacs init file @file{~@var{user}/.emacs} instead of -your own. - - -@end table - -@vindex command-line-args - Note that the init file can get access to the command line argument -values as the elements of a list in the variable -@code{command-line-args}. (The arguments in the second table above will -already have been processed and will not be in the list.) The init file -can override the normal processing of the other arguments by setting -this variable. - - One way to use command switches is to visit many files automatically: - -@example -xemacs *.c -@end example - -@noindent -passes each @code{.c} file as a separate argument to Emacs, so that -Emacs visits each file (@pxref{Visiting}). - - Here is an advanced example that assumes you have a Lisp program file -called @file{hack-c-program.el} which, when loaded, performs some useful -operation on the current buffer, expected to be a C program. - -@example -xemacs -batch foo.c -l hack-c-program -f save-buffer -kill > log -@end example - -@noindent -Here Emacs is told to visit @file{foo.c}, load @file{hack-c-program.el} -(which makes changes in the visited file), save @file{foo.c} (note that -@code{save-buffer} is the function that @kbd{C-x C-s} is bound to), and -then exit to the shell from which the command was executed. @samp{-batch} -guarantees there will be no problem redirecting output to @file{log}, -because Emacs will not assume that it has a display terminal to work -with. - -@subsection Command Line Arguments (for XEmacs Under X) -@vindex frame-title-format -@vindex frame-icon-title-format -If you are running XEmacs under X, a number of options are -available to control color, border, and window title and icon name: - -@table @samp -@item -title @var{title} -@itemx -wn @var{title} -@itemx -T @var{title} -Use @var{title} as the window title. This sets the -@code{frame-title-format} variable, which controls the title of the X -window corresponding to the selected frame. This is the same format as -@code{mode-line-format}. - -@item -iconname @var{title} -@itemx -in @var{title} -Use @var{title} as the icon name. This sets the -@code{frame-icon-title-format} variable, which controls the title of -the icon corresponding to the selected frame. - -@item -mc @var{color} -Use @var{color} as the mouse color. - -@item -cr @var{color} -Use @var{color} as the text-cursor foreground color. -@end table - -In addition, XEmacs allows you to use a number of standard Xt -command line arguments. - -@table @samp - -@item -background @var{color} -@itemx -bg @var{color} -Use @var{color} as the background color. - -@item -bordercolor @var{color} -@itemx -bd @var{color} -Use @var{color} as the border color. - -@item -borderwidth @var{width} -@itemx -bw @var{width} -Use @var{width} as the border width. - -@item -display @var{display} -@itemx -d @var{display} -When running under the X window system, create the window containing the -Emacs frame on the display named @var{display}. - -@item -foreground @var{color} -@itemx -fg @var{color} -Use @var{color} as the foreground color. - -@item -font @var{name} -@itemx -fn @var{name} -Use @var{name} as the default font. - -@item -geometry @var{spec} -@itemx -geom @var{spec} -@itemx -g @var{spec} -Use the geometry (window size and/or position) specified by @var{spec}. - -@item -iconic -Start up iconified. - -@item -rv -Bring up Emacs in reverse video. - -@item -name @var{name} -Use the resource manager resources specified by @var{name}. -The default is to use the name of the program (@code{argv[0]}) as -the resource manager name. - -@item -xrm -Read something into the resource database for this invocation of Emacs only. - -@end table diff --git a/man/xemacs/custom.texi b/man/xemacs/custom.texi deleted file mode 100644 index f5c20ce..0000000 --- a/man/xemacs/custom.texi +++ /dev/null @@ -1,2506 +0,0 @@ - -@node Customization, Quitting, Emulation, Top -@chapter Customization -@cindex customization - - This chapter talks about various topics relevant to adapting the -behavior of Emacs in minor ways. - - All kinds of customization affect only the particular Emacs job that you -do them in. They are completely lost when you kill the Emacs job, and have -no effect on other Emacs jobs you may run at the same time or later. The -only way an Emacs job can affect anything outside of it is by writing a -file; in particular, the only way to make a customization `permanent' is to -put something in your @file{.emacs} file or other appropriate file to do the -customization in each session. @xref{Init File}. - -@menu -* Minor Modes:: Each minor mode is one feature you can turn on - independently of any others. -* Variables:: Many Emacs commands examine Emacs variables - to decide what to do; by setting variables, - you can control their functioning. -* Keyboard Macros:: A keyboard macro records a sequence of keystrokes - to be replayed with a single command. -* Key Bindings:: The keymaps say what command each key runs. - By changing them, you can "redefine keys". -* Syntax:: The syntax table controls how words and expressions - are parsed. -* Init File:: How to write common customizations in the @file{.emacs} - file. -* Audible Bell:: Changing how Emacs sounds the bell. -* Faces:: Changing the fonts and colors of a region of text. -* X Resources:: X resources controlling various aspects of the - behavior of XEmacs. -@end menu - -@node Minor Modes -@section Minor Modes -@cindex minor modes - -@cindex mode line - Minor modes are options which you can use or not. For example, Auto -Fill mode is a minor mode in which @key{SPC} breaks lines between words -as you type. All the minor modes are independent of each other and of -the selected major mode. Most minor modes inform you in the mode line -when they are on; for example, @samp{Fill} in the mode line means that -Auto Fill mode is on. - - Append @code{-mode} to the name of a minor mode to get the name of a -command function that turns the mode on or off. Thus, the command to -enable or disable Auto Fill mode is called @kbd{M-x auto-fill-mode}. These -commands are usually invoked with @kbd{M-x}, but you can bind keys to them -if you wish. With no argument, the function turns the mode on if it was -off and off if it was on. This is known as @dfn{toggling}. A positive -argument always turns the mode on, and an explicit zero argument or a -negative argument always turns it off. - -@cindex Auto Fill mode -@findex auto-fill-mode - Auto Fill mode allows you to enter filled text without breaking lines -explicitly. Emacs inserts newlines as necessary to prevent lines from -becoming too long. @xref{Filling}. - -@cindex Overwrite mode -@findex overwrite-mode - Overwrite mode causes ordinary printing characters to replace existing -text instead of moving it to the right. For example, if point is in -front of the @samp{B} in @samp{FOOBAR}, and you type a @kbd{G} in Overwrite -mode, it changes to @samp{FOOGAR}, instead of @samp{FOOGBAR}.@refill - -@cindex Abbrev mode -@findex abbrev-mode - Abbrev mode allows you to define abbreviations that automatically expand -as you type them. For example, @samp{amd} might expand to @samp{abbrev -mode}. @xref{Abbrevs}, for full information. - -@node Variables -@section Variables -@cindex variable -@cindex option - - A @dfn{variable} is a Lisp symbol which has a value. Variable names -can contain any characters, but by convention they are words separated -by hyphens. A variable can also have a documentation string, which -describes what kind of value it should have and how the value will be -used. - - Lisp allows any variable to have any kind of value, but most variables -that Emacs uses require a value of a certain type. Often the value has -to be a string or a number. Sometimes we say that a certain feature is -turned on if a variable is ``non-@code{nil},'' meaning that if the -variable's value is @code{nil}, the feature is off, but the feature is -on for @i{any} other value. The conventional value to turn on the -feature---since you have to pick one particular value when you set the -variable---is @code{t}. - - Emacs uses many Lisp variables for internal recordkeeping, as any Lisp -program must, but the most interesting variables for you are the ones that -exist for the sake of customization. Emacs does not (usually) change the -values of these variables; instead, you set the values, and thereby alter -and control the behavior of certain Emacs commands. These variables are -called @dfn{options}. Most options are documented in this manual and -appear in the Variable Index (@pxref{Variable Index}). - - One example of a variable which is an option is @code{fill-column}, which -specifies the position of the right margin (as a number of characters from -the left margin) to be used by the fill commands (@pxref{Filling}). - -@menu -* Examining:: Examining or setting one variable's value. -* Easy Customization:: Convenient and easy customization of variables. -* Edit Options:: Examining or editing list of all variables' values. -* Locals:: Per-buffer values of variables. -* File Variables:: How files can specify variable values. -@end menu - -@node Examining -@subsection Examining and Setting Variables -@cindex setting variables - -@table @kbd -@item C-h v -@itemx M-x describe-variable -Print the value and documentation of a variable. -@findex set-variable -@item M-x set-variable -Change the value of a variable. -@end table - -@kindex C-h v -@findex describe-variable - To examine the value of a single variable, use @kbd{C-h v} -(@code{describe-variable}), which reads a variable name using the -minibuffer, with completion. It prints both the value and the -documentation of the variable. - -@example -C-h v fill-column @key{RET} -@end example - -@noindent -prints something like: - -@smallexample -fill-column's value is 75 - -Documentation: -*Column beyond which automatic line-wrapping should happen. -Automatically becomes local when set in any fashion. -@end smallexample - -@cindex option -@noindent -The star at the beginning of the documentation indicates that this variable -is an option. @kbd{C-h v} is not restricted to options; it allows any -variable name. - -@findex set-variable - If you know which option you want to set, you can use @kbd{M-x -set-variable} to set it. This prompts for the variable name in the -minibuffer (with completion), and then prompts for a Lisp expression for the -new value using the minibuffer a second time. For example, - -@example -M-x set-variable @key{RET} fill-column @key{RET} 75 @key{RET} -@end example - -@noindent -sets @code{fill-column} to 75, as if you had executed the Lisp expression -@code{(setq fill-column 75)}. - - Setting variables in this way, like all means of customizing Emacs -except where explicitly stated, affects only the current Emacs session. - -@node Easy Customization -@subsection Easy Customization Interface - -@findex customize -@cindex customization buffer - A convenient way to find the user option variables that you want to -change, and then change them, is with @kbd{M-x customize}. This command -creates a @dfn{customization buffer} with which you can browse through -the Emacs user options in a logically organized structure, then edit and -set their values. You can also use the customization buffer to save -settings permanently. (Not all Emacs user options are included in this -structure as of yet, but we are adding the rest.) - -@menu -* Groups: Customization Groups. - How options are classified in a structure. -* Changing an Option:: How to edit a value and set an option. -* Face Customization:: How to edit the attributes of a face. -* Specific Customization:: Making a customization buffer for specific - options, faces, or groups. -@end menu - -@node Customization Groups -@subsubsection Customization Groups -@cindex customization groups - - For customization purposes, user options are organized into -@dfn{groups} to help you find them. Groups are collected into bigger -groups, all the way up to a master group called @code{Emacs}. - - @kbd{M-x customize} creates a customization buffer that shows the -top-level @code{Emacs} group and the second-level groups immediately -under it. It looks like this, in part: - -@smallexample -/- Emacs group: ---------------------------------------------------\ - [State]: visible group members are all at standard settings. - Customization of the One True Editor. - See also [Manual]. - - [Open] Editing group -Basic text editing facilities. - - [Open] External group -Interfacing to external utilities. - -@var{more second-level groups} - -\- Emacs group end ------------------------------------------------/ - -@end smallexample - -@noindent -This says that the buffer displays the contents of the @code{Emacs} -group. The other groups are listed because they are its contents. But -they are listed differently, without indentation and dashes, because -@emph{their} contents are not included. Each group has a single-line -documentation string; the @code{Emacs} group also has a @samp{[State]} -line. - -@cindex editable fields (customization buffer) -@cindex active fields (customization buffer) - Most of the text in the customization buffer is read-only, but it -typically includes some @dfn{editable fields} that you can edit. There -are also @dfn{active fields}; this means a field that does something -when you @dfn{invoke} it. To invoke an active field, either click on it -with @kbd{Mouse-1}, or move point to it and type @key{RET}. - - For example, the phrase @samp{[Open]} that appears in a second-level -group is an active field. Invoking the @samp{[Open]} field for a group -opens up a new customization buffer, which shows that group and its -contents. This field is a kind of hypertext link to another group. - - The @code{Emacs} group does not include any user options itself, but -other groups do. By examining various groups, you will eventually find -the options and faces that belong to the feature you are interested in -customizing. Then you can use the customization buffer to set them. - -@findex customize-browse - You can view the structure of customization groups on a larger scale -with @kbd{M-x customize-browse}. This command creates a special kind of -customization buffer which shows only the names of the groups (and -options and faces), and their structure. - - In this buffer, you can show the contents of a group by invoking -@samp{[+]}. When the group contents are visible, this button changes to -@samp{[-]}; invoking that hides the group contents. - - Each group, option or face name in this buffer has an active field -which says @samp{[Group]}, @samp{[Option]} or @samp{[Face]}. Invoking -that active field creates an ordinary customization buffer showing just -that group and its contents, just that option, or just that face. -This is the way to set values in it. - -@node Changing an Option -@subsubsection Changing an Option - - Here is an example of what a user option looks like in the -customization buffer: - -@smallexample -Kill Ring Max: [Hide] 30 - [State]: this option is unchanged from its standard setting. -Maximum length of kill ring before oldest elements are thrown away. -@end smallexample - - The text following @samp{[Hide]}, @samp{30} in this case, indicates -the current value of the option. If you see @samp{[Show]} instead of -@samp{[Hide]}, it means that the value is hidden; the customization -buffer initially hides values that take up several lines. Invoke -@samp{[Show]} to show the value. - - The line after the option name indicates the @dfn{customization state} -of the option: in the example above, it says you have not changed the -option yet. The word @samp{[State]} at the beginning of this line is -active; you can get a menu of various operations by invoking it with -@kbd{Mouse-1} or @key{RET}. These operations are essential for -customizing the variable. - - The line after the @samp{[State]} line displays the beginning of the -option's documentation string. If there are more lines of -documentation, this line ends with @samp{[More]}; invoke this to show -the full documentation string. - - To enter a new value for @samp{Kill Ring Max}, move point to the value -and edit it textually. For example, you can type @kbd{M-d}, then insert -another number. - - When you begin to alter the text, you will see the @samp{[State]} line -change to say that you have edited the value: - -@smallexample -[State]: you have edited the value as text, but not set the option. -@end smallexample - -@cindex setting option value - Editing the value does not actually set the option variable. To do -that, you must @dfn{set} the option. To do this, invoke the word -@samp{[State]} and choose @samp{Set for Current Session}. - - The state of the option changes visibly when you set it: - -@smallexample -[State]: you have set this option, but not saved it for future sessions. -@end smallexample - - You don't have to worry about specifying a value that is not valid; -setting the option checks for validity and will not really install an -unacceptable value. - -@kindex M-TAB @r{(customization buffer)} -@findex widget-complete - While editing a value or field that is a file name, directory name, -command name, or anything else for which completion is defined, you can -type @kbd{M-@key{TAB}} (@code{widget-complete}) to do completion. - - Some options have a small fixed set of possible legitimate values. -These options don't let you edit the value textually. Instead, an -active field @samp{[Value Menu]} appears before the value; invoke this -field to edit the value. For a boolean ``on or off'' value, the active -field says @samp{[Toggle]}, and it changes to the other value. -@samp{[Value Menu]} and @samp{[Toggle]} edit the buffer; the changes -take effect when you use the @samp{Set for Current Session} operation. - - Some options have values with complex structure. For example, the -value of @code{load-path} is a list of directories. Here is how it -appears in the customization buffer: - -@smallexample -Load Path: -[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/site-lisp -[INS] [DEL] [Current dir?]: /usr/local/share/emacs/site-lisp -[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/leim -[INS] [DEL] [Current dir?]: /usr/local/share/emacs/19.34.94/lisp -[INS] [DEL] [Current dir?]: /build/emacs/e19/lisp -[INS] [DEL] [Current dir?]: /build/emacs/e19/lisp/gnus -[INS] - [State]: this item has been changed outside the customization buffer. -List of directories to search for files to load.... -@end smallexample - -@noindent -Each directory in the list appears on a separate line, and each line has -several editable or active fields. - - You can edit any of the directory names. To delete a directory from -the list, invoke @samp{[DEL]} on that line. To insert a new directory in -the list, invoke @samp{[INS]} at the point where you want to insert it. - - You can also invoke @samp{[Current dir?]} to switch between including -a specific named directory in the path, and including @code{nil} in the -path. (@code{nil} in a search path means ``try the current -directory.'') - -@kindex TAB @r{(customization buffer)} -@kindex S-TAB @r{(customization buffer)} -@findex widget-forward -@findex widget-backward - Two special commands, @key{TAB} and @kbd{S-@key{TAB}}, are useful for -moving through the customization buffer. @key{TAB} -(@code{widget-forward}) moves forward to the next active or editable -field; @kbd{S-@key{TAB}} (@code{widget-backward}) moves backward to the -previous active or editable field. - - Typing @key{RET} on an editable field also moves forward, just like -@key{TAB}. The reason for this is that people have a tendency to type -@key{RET} when they are finished editing a field. If you have occasion -to insert a newline in an editable field, use @kbd{C-o} or @kbd{C-q -C-j}, - -@cindex saving option value - Setting the option changes its value in the current Emacs session; -@dfn{saving} the value changes it for future sessions as well. This -works by writing code into your @file{~/.emacs} file so as to set the -option variable again each time you start Emacs. To save the option, -invoke @samp{[State]} and select the @samp{Save for Future Sessions} -operation. - - You can also restore the option to its standard value by invoking -@samp{[State]} and selecting the @samp{Reset} operation. There are -actually three reset operations: - -@table @samp -@item Reset to Current -If you have made some modifications and not yet set the option, -this restores the text in the customization buffer to match -the actual value. - -@item Reset to Saved -This restores the value of the option to the last saved value, -and updates the text accordingly. - -@item Reset to Standard Settings -This sets the option to its standard value, and updates the text -accordingly. This also eliminates any saved value for the option, -so that you will get the standard value in future Emacs sessions. -@end table - - The state of a group indicates whether anything in that group has been -edited, set or saved. You can select @samp{Set for Current Session}, -@samp{Save for Future Sessions} and the various kinds of @samp{Reset} -operation for the group; these operations on the group apply to all -options in the group and its subgroups. - - Near the top of the customization buffer there are two lines -containing several active fields: - -@smallexample - [Set] [Save] [Reset] [Done] -@end smallexample - -@noindent -Invoking @samp{[Done]} buries this customization buffer. Each of the -other fields performs an operation---set, save or reset---on each of the -items in the buffer that could meaningfully be set, saved or reset. - -@node Face Customization -@subsubsection Customizing Faces -@cindex customizing faces -@cindex bold font -@cindex italic font -@cindex fonts and faces - - In addition to user options, some customization groups also include -faces. When you show the contents of a group, both the user options and -the faces in the group appear in the customization buffer. Here is an -example of how a face looks: - -@smallexample -Custom Changed Face: (sample) - [State]: this face is unchanged from its standard setting. -Face used when the customize item has been changed. -Parent groups: [Custom Magic Faces] -Attributes: [ ] Bold: [Toggle] off (nil) - [ ] Italic: [Toggle] off (nil) - [ ] Underline: [Toggle] off (nil) - [ ] Foreground: white (sample) - [ ] Background: blue (sample) - [ ] Inverse: [Toggle] off (nil) - [ ] Stipple: - [ ] Font Family: - [ ] Size: - [ ] Strikethru: off -@end smallexample - - Each face attribute has its own line. The @samp{[@var{x}]} field -before the attribute name indicates whether the attribute is -@dfn{enabled}; @samp{X} means that it is. You can enable or disable the -attribute by invoking that field. When the attribute is enabled, you -can change the attribute value in the usual ways. - -@c Is this true for XEmacs? -@c On a black-and-white display, the colors you can use for the -@c background are @samp{black}, @samp{white}, @samp{gray}, @samp{gray1}, -@c and @samp{gray3}. Emacs supports these shades of gray by using -@c background stipple patterns instead of a color. -@c - Setting, saving and resetting a face work like the same operations for -options (@pxref{Changing an Option}). - - A face can specify different appearances for different types of -display. For example, a face can make text red on a color display, but -use a bold font on a monochrome display. To specify multiple -appearances for a face, select @samp{Show Display Types} in the menu you -get from invoking @samp{[State]}. - -@c It would be cool to implement this -@c @findex modify-face -@c Another more basic way to set the attributes of a specific face is -@c with @kbd{M-x modify-face}. This command reads the name of a face, then -@c reads the attributes one by one. For the color and stipple attributes, -@c the attribute's current value is the default---type just @key{RET} if -@c you don't want to change that attribute. Type @samp{none} if you want -@c to clear out the attribute. - -@node Specific Customization -@subsubsection Customizing Specific Items - - Instead of finding the options you want to change by moving down -through the structure of groups, you can specify the particular option, -face or group that you want to customize. - -@table @kbd -@item M-x customize-option @key{RET} @var{option} @key{RET} -Set up a customization buffer with just one option, @var{option}. -@item M-x customize-face @key{RET} @var{face} @key{RET} -Set up a customization buffer with just one face, @var{face}. -@item M-x customize-group @key{RET} @var{group} @key{RET} -Set up a customization buffer with just one group, @var{group}. -@item M-x customize-apropos @key{RET} @var{regexp} @key{RET} -Set up a customization buffer with all the options, faces and groups -that match @var{regexp}. -@item M-x customize-saved -Set up a customization buffer containing all options and faces that you -have saved with customization buffers. -@item M-x customize-customized -Set up a customization buffer containing all options and faces that you -have customized but not saved. -@end table - -@findex customize-option - If you want to alter a particular user option variable with the -customization buffer, and you know its name, you can use the command -@kbd{M-x customize-option} and specify the option name. This sets up -the customization buffer with just one option---the one that you asked -for. Editing, setting and saving the value work as described above, but -only for the specified option. - -@findex customize-face - Likewise, you can modify a specific face, chosen by name, using -@kbd{M-x customize-face}. - -@findex customize-group - You can also set up the customization buffer with a specific group, -using @kbd{M-x customize-group}. The immediate contents of the chosen -group, including option variables, faces, and other groups, all appear -as well. However, these subgroups' own contents start out hidden. You -can show their contents in the usual way, by invoking @samp{[Show]}. - -@findex customize-apropos - To control more precisely what to customize, you can use @kbd{M-x -customize-apropos}. You specify a regular expression as argument; then -all options, faces and groups whose names match this regular expression -are set up in the customization buffer. If you specify an empty regular -expression, this includes @emph{all} groups, options and faces in the -customization buffer (but that takes a long time). - -@findex customize-saved -@findex customize-customized - If you change option values and then decide the change was a mistake, -you can use two special commands to revisit your previous changes. Use -@kbd{customize-saved} to look at the options and faces that you have -saved. Use @kbd{M-x customize-customized} to look at the options and -faces that you have set but not saved. - -@node Edit Options -@subsection Editing Variable Values - -@table @kbd -@item M-x list-options -Display a buffer listing names, values, and documentation of all options. -@item M-x edit-options -Change option values by editing a list of options. -@end table - -@findex list-options - @kbd{M-x list-options} displays a list of all Emacs option variables in -an Emacs buffer named @samp{*List Options*}. Each option is shown with its -documentation and its current value. Here is what a portion of it might -look like: - -@smallexample -;; exec-path: -("." "/usr/local/bin" "/usr/ucb" "/bin" "/usr/bin" "/u2/emacs/etc") -*List of directories to search programs to run in subprocesses. -Each element is a string (directory name) -or nil (try the default directory). -;; -;; fill-column: -75 -*Column beyond which automatic line-wrapping should happen. -Automatically becomes local when set in any fashion. -;; -@end smallexample - -@findex edit-options - @kbd{M-x edit-options} goes one step further and immediately selects the -@samp{*List Options*} buffer; this buffer uses the major mode Options mode, -which provides commands that allow you to point at an option and change its -value: - -@table @kbd -@item s -Set the variable point is in or near to a new value read using the -minibuffer. -@item x -Toggle the variable point is in or near: if the value was @code{nil}, -it becomes @code{t}; otherwise it becomes @code{nil}. -@item 1 -Set the variable point is in or near to @code{t}. -@item 0 -Set the variable point is in or near to @code{nil}. -@item n -@itemx p -Move to the next or previous variable. -@end table - -@node Locals -@subsection Local Variables - -@table @kbd -@item M-x make-local-variable -Make a variable have a local value in the current buffer. -@item M-x kill-local-variable -Make a variable use its global value in the current buffer. -@item M-x make-variable-buffer-local -Mark a variable so that setting it will make it local to the -buffer that is current at that time. -@end table - -@cindex local variables - You can make any variable @dfn{local} to a specific Emacs buffer. -This means that the variable's value in that buffer is independent of -its value in other buffers. A few variables are always local in every -buffer. All other Emacs variables have a @dfn{global} value which is in -effect in all buffers that have not made the variable local. - - Major modes always make the variables they set local to the buffer. -This is why changing major modes in one buffer has no effect on other -buffers. - -@findex make-local-variable - @kbd{M-x make-local-variable} reads the name of a variable and makes it -local to the current buffer. Further changes in this buffer will not -affect others, and changes in the global value will not affect this -buffer. - -@findex make-variable-buffer-local -@cindex per-buffer variables - @kbd{M-x make-variable-buffer-local} reads the name of a variable and -changes the future behavior of the variable so that it automatically -becomes local when it is set. More precisely, once you have marked a -variable in this way, the usual ways of setting the -variable will automatically invoke @code{make-local-variable} first. We -call such variables @dfn{per-buffer} variables. - - Some important variables have been marked per-buffer already. They -include @code{abbrev-mode}, @code{auto-fill-function}, -@code{case-fold-search}, @code{comment-column}, @code{ctl-arrow}, -@code{fill-column}, @code{fill-prefix}, @code{indent-tabs-mode}, -@code{left-margin}, @*@code{mode-line-format}, @code{overwrite-mode}, -@code{selective-display-ellipses}, @*@code{selective-display}, -@code{tab-width}, and @code{truncate-lines}. Some other variables are -always local in every buffer, but they are used for internal -purposes.@refill - -Note: the variable @code{auto-fill-function} was formerly named -@code{auto-fill-hook}. - -@findex kill-local-variable - If you want a variable to cease to be local to the current buffer, -call @kbd{M-x kill-local-variable} and provide the name of a variable to -the prompt. The global value of the variable -is again in effect in this buffer. Setting the major mode kills all -the local variables of the buffer. - -@findex setq-default - To set the global value of a variable, regardless of whether the -variable has a local value in the current buffer, you can use the -Lisp function @code{setq-default}. It works like @code{setq}. -If there is a local value in the current buffer, the local value is -not affected by @code{setq-default}; thus, the new global value may -not be visible until you switch to another buffer, as in the case of: - -@example -(setq-default fill-column 75) -@end example - -@noindent -@code{setq-default} is the only way to set the global value of a variable -that has been marked with @code{make-variable-buffer-local}. - -@findex default-value - Programs can look at a variable's default value with @code{default-value}. -This function takes a symbol as an argument and returns its default value. -The argument is evaluated; usually you must quote it explicitly, as in -the case of: - -@example -(default-value 'fill-column) -@end example - -@node File Variables -@subsection Local Variables in Files -@cindex local variables in files - - A file can contain a @dfn{local variables list}, which specifies the -values to use for certain Emacs variables when that file is edited. -Visiting the file checks for a local variables list and makes each variable -in the list local to the buffer in which the file is visited, with the -value specified in the file. - - A local variables list goes near the end of the file, in the last page. -(It is often best to put it on a page by itself.) The local variables list -starts with a line containing the string @samp{Local Variables:}, and ends -with a line containing the string @samp{End:}. In between come the -variable names and values, one set per line, as @samp{@var{variable}:@: -@var{value}}. The @var{value}s are not evaluated; they are used literally. - - The line which starts the local variables list does not have to say -just @samp{Local Variables:}. If there is other text before @samp{Local -Variables:}, that text is called the @dfn{prefix}, and if there is other -text after, that is called the @dfn{suffix}. If a prefix or suffix are -present, each entry in the local variables list should have the prefix -before it and the suffix after it. This includes the @samp{End:} line. -The prefix and suffix are included to disguise the local variables list -as a comment so the compiler or text formatter will ignore it. -If you do not need to disguise the local variables list as a comment in -this way, there is no need to include a prefix or a suffix.@refill - - Two ``variable'' names are special in a local variables list: a value -for the variable @code{mode} sets the major mode, and a value for the -variable @code{eval} is simply evaluated as an expression and the value -is ignored. These are not real variables; setting them in any other -context does not have the same effect. If @code{mode} is used in a -local variables list, it should be the first entry in the list. - -Here is an example of a local variables list: -@example -;;; Local Variables: *** -;;; mode:lisp *** -;;; comment-column:0 *** -;;; comment-start: ";;; " *** -;;; comment-end:"***" *** -;;; End: *** -@end example - - Note that the prefix is @samp{;;; } and the suffix is @samp{ ***}. -Note also that comments in the file begin with and end with the same -strings. Presumably the file contains code in a language which is -enough like Lisp for Lisp mode to be useful but in which comments -start and end differently. The prefix and suffix are used in the local -variables list to make the list look like several lines of comments when -the compiler or interpreter for that language reads the file. - - The start of the local variables list must be no more than 3000 -characters from the end of the file, and must be in the last page if the -file is divided into pages. Otherwise, Emacs will not notice it is -there. The purpose is twofold: a stray @samp{Local Variables:}@: not in -the last page does not confuse Emacs, and Emacs never needs to search a -long file that contains no page markers and has no local variables list. - - You may be tempted to turn on Auto Fill mode with a local variable -list. That is inappropriate. Whether you use Auto Fill mode or not is -a matter of personal taste, not a matter of the contents of particular -files. If you want to use Auto Fill, set up major mode hooks with your -@file{.emacs} file to turn it on (when appropriate) for you alone -(@pxref{Init File}). Don't try to use a local variable list that would -impose your taste on everyone working with the file. - -XEmacs allows you to specify local variables in the first line -of a file, in addition to specifying them in the @code{Local Variables} -section at the end of a file. - -If the first line of a file contains two occurrences of @code{`-*-'}, -XEmacs uses the information between them to determine what the major -mode and variable settings should be. For example, these are all legal: - -@example - ;;; -*- mode: emacs-lisp -*- - ;;; -*- mode: postscript; version-control: never -*- - ;;; -*- tags-file-name: "/foo/bar/TAGS" -*- -@end example - -For historical reasons, the syntax @code{`-*- modename -*-'} is allowed -as well; for example, you can use: - -@example - ;;; -*- emacs-lisp -*- -@end example - -@vindex enable-local-variables -The variable @code{enable-local-variables} controls the use of local -variables lists in files you visit. The value can be @code{t}, -@code{nil}, or something else. A value of @code{t} means local variables -lists are obeyed; @code{nil} means they are ignored; anything else means -query. - -The command @code{M-x normal-mode} always obeys local variables lists -and ignores this variable. - -@node Keyboard Macros -@section Keyboard Macros - -@cindex keyboard macros - A @dfn{keyboard macro} is a command defined by the user to abbreviate a -sequence of keys. For example, if you discover that you are about to type -@kbd{C-n C-d} forty times, you can speed your work by defining a keyboard -macro to invoke @kbd{C-n C-d} and calling it with a repeat count of forty. - -@c widecommands -@table @kbd -@item C-x ( -Start defining a keyboard macro (@code{start-kbd-macro}). -@item C-x ) -End the definition of a keyboard macro (@code{end-kbd-macro}). -@item C-x e -Execute the most recent keyboard macro (@code{call-last-kbd-macro}). -@item C-u C-x ( -Re-execute last keyboard macro, then add more keys to its definition. -@item C-x q -When this point is reached during macro execution, ask for confirmation -(@code{kbd-macro-query}). -@item M-x name-last-kbd-macro -Give a command name (for the duration of the session) to the most -recently defined keyboard macro. -@item M-x insert-kbd-macro -Insert in the buffer a keyboard macro's definition, as Lisp code. -@end table - - Keyboard macros differ from other Emacs commands in that they are -written in the Emacs command language rather than in Lisp. This makes it -easier for the novice to write them and makes them more convenient as -temporary hacks. However, the Emacs command language is not powerful -enough as a programming language to be useful for writing anything -general or complex. For such things, Lisp must be used. - - You define a keyboard macro by executing the commands which are its -definition. Put differently, as you are defining a keyboard macro, the -definition is being executed for the first time. This way, you see -what the effects of your commands are, and don't have to figure -them out in your head. When you are finished, the keyboard macro is -defined and also has been executed once. You can then execute the same -set of commands again by invoking the macro. - -@menu -* Basic Kbd Macro:: Defining and running keyboard macros. -* Save Kbd Macro:: Giving keyboard macros names; saving them in files. -* Kbd Macro Query:: Keyboard macros that do different things each use. -@end menu - -@node Basic Kbd Macro -@subsection Basic Use - -@kindex C-x ( -@kindex C-x ) -@kindex C-x e -@findex start-kbd-macro -@findex end-kbd-macro -@findex call-last-kbd-macro - To start defining a keyboard macro, type @kbd{C-x (} -(@code{start-kbd-macro}). From then on, anything you type continues to be -executed, but also becomes part of the definition of the macro. @samp{Def} -appears in the mode line to remind you of what is going on. When you are -finished, the @kbd{C-x )} command (@code{end-kbd-macro}) terminates the -definition, without becoming part of it. - - For example, - -@example -C-x ( M-f foo C-x ) -@end example - -@noindent -defines a macro to move forward a word and then insert @samp{foo}. - -You can give @kbd{C-x )} a repeat count as an argument, in which case it -repeats the macro that many times right after defining it, but defining -the macro counts as the first repetition (since it is executed as you -define it). If you give @kbd{C-x )} an argument of 4, it executes the -macro immediately 3 additional times. An argument of zero to @kbd{C-x -e} or @kbd{C-x )} means repeat the macro indefinitely (until it gets an -error or you type @kbd{C-g}). - - Once you have defined a macro, you can invoke it again with the -@kbd{C-x e} command (@code{call-last-kbd-macro}). You can give the -command a repeat count numeric argument to execute the macro many times. - - To repeat an operation at regularly spaced places in the -text, define a macro and include as part of the macro the commands to move -to the next place you want to use it. For example, if you want to change -each line, you should position point at the start of a line, and define a -macro to change that line and leave point at the start of the next line. -Repeating the macro will then operate on successive lines. - - After you have terminated the definition of a keyboard macro, you can add -to the end of its definition by typing @kbd{C-u C-x (}. This is equivalent -to plain @kbd{C-x (} followed by retyping the whole definition so far. As -a consequence it re-executes the macro as previously defined. - -@node Save Kbd Macro -@subsection Naming and Saving Keyboard Macros - -@findex name-last-kbd-macro - To save a keyboard macro for longer than until you define the -next one, you must give it a name using @kbd{M-x name-last-kbd-macro}. -This reads a name as an argument using the minibuffer and defines that name -to execute the macro. The macro name is a Lisp symbol, and defining it in -this way makes it a valid command name for calling with @kbd{M-x} or for -binding a key to with @code{global-set-key} (@pxref{Keymaps}). If you -specify a name that has a prior definition other than another keyboard -macro, Emacs prints an error message and nothing is changed. - -@findex insert-kbd-macro - Once a macro has a command name, you can save its definition in a file. -You can then use it in another editing session. First visit the file -you want to save the definition in. Then use the command: - -@example -M-x insert-kbd-macro @key{RET} @var{macroname} @key{RET} -@end example - -@noindent -This inserts some Lisp code that, when executed later, will define the same -macro with the same definition it has now. You need not understand Lisp -code to do this, because @code{insert-kbd-macro} writes the Lisp code for you. -Then save the file. You can load the file with @code{load-file} -(@pxref{Lisp Libraries}). If the file you save in is your initialization file -@file{~/.emacs} (@pxref{Init File}), then the macro will be defined each -time you run Emacs. - - If you give @code{insert-kbd-macro} a prefix argument, it creates -additional Lisp code to record the keys (if any) that you have bound to the -keyboard macro, so that the macro is reassigned the same keys when you -load the file. - -@node Kbd Macro Query -@subsection Executing Macros With Variations - -@kindex C-x q -@findex kbd-macro-query - You can use @kbd{C-x q} (@code{kbd-macro-query}), to get an effect similar -to that of @code{query-replace}. The macro asks you each time -whether to make a change. When you are defining the macro, type @kbd{C-x -q} at the point where you want the query to occur. During macro -definition, the @kbd{C-x q} does nothing, but when you invoke the macro, -@kbd{C-x q} reads a character from the terminal to decide whether to -continue. - - The special answers to a @kbd{C-x q} query are @key{SPC}, @key{DEL}, -@kbd{C-d}, @kbd{C-l}, and @kbd{C-r}. Any other character terminates -execution of the keyboard macro and is then read as a command. -@key{SPC} means to continue. @key{DEL} means to skip the remainder of -this repetition of the macro, starting again from the beginning in the -next repetition. @kbd{C-d} means to skip the remainder of this -repetition and cancel further repetition. @kbd{C-l} redraws the frame -and asks you again for a character to specify what to do. @kbd{C-r} enters -a recursive editing level, in which you can perform editing that is not -part of the macro. When you exit the recursive edit using @kbd{C-M-c}, -you are asked again how to continue with the keyboard macro. If you -type a @key{SPC} at this time, the rest of the macro definition is -executed. It is up to you to leave point and the text in a state such -that the rest of the macro will do what you want.@refill - - @kbd{C-u C-x q}, which is @kbd{C-x q} with a numeric argument, performs a -different function. It enters a recursive edit reading input from the -keyboard, both when you type it during the definition of the macro and -when it is executed from the macro. During definition, the editing you do -inside the recursive edit does not become part of the macro. During macro -execution, the recursive edit gives you a chance to do some particularized -editing. @xref{Recursive Edit}. - -@node Key Bindings -@section Customizing Key Bindings - - This section deals with the @dfn{keymaps} that define the bindings -between keys and functions, and shows how you can customize these bindings. -@cindex command -@cindex function -@cindex command name - - A command is a Lisp function whose definition provides for interactive -use. Like every Lisp function, a command has a function name, which is -a Lisp symbol whose name usually consists of lower case letters and -hyphens. - -@menu -* Keymaps:: Definition of the keymap data structure. - Names of Emacs's standard keymaps. -* Rebinding:: How to redefine one key's meaning conveniently. -* Disabling:: Disabling a command means confirmation is required - before it can be executed. This is done to protect - beginners from surprises. -@end menu - -@node Keymaps -@subsection Keymaps -@cindex keymap - -@cindex global keymap -@vindex global-map - The bindings between characters and command functions are recorded in -data structures called @dfn{keymaps}. Emacs has many of these. One, the -@dfn{global} keymap, defines the meanings of the single-character keys that -are defined regardless of major mode. It is the value of the variable -@code{global-map}. - -@cindex local keymap -@vindex c-mode-map -@vindex lisp-mode-map - Each major mode has another keymap, its @dfn{local keymap}, which -contains overriding definitions for the single-character keys that are -redefined in that mode. Each buffer records which local keymap is -installed for it at any time, and the current buffer's local keymap is -the only one that directly affects command execution. The local keymaps -for Lisp mode, C mode, and many other major modes always exist even when -not in use. They are the values of the variables @code{lisp-mode-map}, -@code{c-mode-map}, and so on. For less frequently used major modes, the -local keymap is sometimes constructed only when the mode is used for the -first time in a session, to save space. - -@cindex minibuffer -@vindex minibuffer-local-map -@vindex minibuffer-local-ns-map -@vindex minibuffer-local-completion-map -@vindex minibuffer-local-must-match-map -@vindex repeat-complex-command-map -@vindex isearch-mode-map - There are local keymaps for the minibuffer, too; they contain various -completion and exit commands. - -@itemize @bullet -@item -@code{minibuffer-local-map} is used for ordinary input (no completion). -@item -@code{minibuffer-local-ns-map} is similar, except that @key{SPC} exits -just like @key{RET}. This is used mainly for Mocklisp compatibility. -@item -@code{minibuffer-local-completion-map} is for permissive completion. -@item -@code{minibuffer-local-must-match-map} is for strict completion and -for cautious completion. -@item -@code{repeat-complex-command-map} is for use in @kbd{C-x @key{ESC}}. -@item -@code{isearch-mode-map} contains the bindings of the special keys which -are bound in the pseudo-mode entered with @kbd{C-s} and @kbd{C-r}. -@end itemize - -@vindex ctl-x-map -@vindex help-map -@vindex esc-map - Finally, each prefix key has a keymap which defines the key sequences -that start with it. For example, @code{ctl-x-map} is the keymap used for -characters following a @kbd{C-x}. - -@itemize @bullet -@item -@code{ctl-x-map} is the variable name for the map used for characters that -follow @kbd{C-x}. -@item -@code{help-map} is used for characters that follow @kbd{C-h}. -@item -@code{esc-map} is for characters that follow @key{ESC}. All Meta -characters are actually defined by this map. -@item -@code{ctl-x-4-map} is for characters that follow @kbd{C-x 4}. -@item -@code{mode-specific-map} is for characters that follow @kbd{C-c}. -@end itemize - - The definition of a prefix key is the keymap to use for looking up -the following character. Sometimes the definition is actually a Lisp -symbol whose function definition is the following character keymap. The -effect is the same, but it provides a command name for the prefix key that -you can use as a description of what the prefix key is for. Thus the -binding of @kbd{C-x} is the symbol @code{Ctl-X-Prefix}, whose function -definition is the keymap for @kbd{C-x} commands, the value of -@code{ctl-x-map}.@refill - - Prefix key definitions can appear in either the global -map or a local map. The definitions of @kbd{C-c}, @kbd{C-x}, @kbd{C-h}, -and @key{ESC} as prefix keys appear in the global map, so these prefix -keys are always available. Major modes can locally redefine a key as a -prefix by putting a prefix key definition for it in the local -map.@refill - - A mode can also put a prefix definition of a global prefix character such -as @kbd{C-x} into its local map. This is how major modes override the -definitions of certain keys that start with @kbd{C-x}. This case is -special, because the local definition does not entirely replace the global -one. When both the global and local definitions of a key are other -keymaps, the next character is looked up in both keymaps, with the local -definition overriding the global one. The character after the -@kbd{C-x} is looked up in both the major mode's own keymap for redefined -@kbd{C-x} commands and in @code{ctl-x-map}. If the major mode's own keymap -for @kbd{C-x} commands contains @code{nil}, the definition from the global -keymap for @kbd{C-x} commands is used.@refill - -@node Rebinding -@subsection Changing Key Bindings -@cindex key rebinding, this session -@cindex rebinding keys, this session - - You can redefine an Emacs key by changing its entry in a keymap. -You can change the global keymap, in which case the change is effective in -all major modes except those that have their own overriding local -definitions for the same key. Or you can change the current buffer's -local map, which affects all buffers using the same major mode. - -@menu -* Interactive Rebinding:: Changing Key Bindings Interactively -* Programmatic Rebinding:: Changing Key Bindings Programmatically -* Key Bindings Using Strings::Using Strings for Changing Key Bindings -@end menu - -@node Interactive Rebinding -@subsubsection Changing Key Bindings Interactively -@findex global-set-key -@findex local-set-key -@findex local-unset-key - -@table @kbd -@item M-x global-set-key @key{RET} @var{key} @var{cmd} @key{RET} -Defines @var{key} globally to run @var{cmd}. -@item M-x local-set-key @key{RET} @var{keys} @var{cmd} @key{RET} -Defines @var{key} locally (in the major mode now in effect) to run -@var{cmd}. -@item M-x local-unset-key @key{RET} @var{keys} @key{RET} -Removes the local binding of @var{key}. -@end table - -@var{cmd} is a symbol naming an interactively-callable function. - -When called interactively, @var{key} is the next complete key sequence -that you type. When called as a function, @var{key} is a string, a -vector of events, or a vector of key-description lists as described in -the @code{define-key} function description. The binding goes in -the current buffer's local map, which is shared with other buffers in -the same major mode. - -The following example: - -@example -M-x global-set-key @key{RET} C-f next-line @key{RET} -@end example - -@noindent -redefines @kbd{C-f} to move down a line. The fact that @var{cmd} is -read second makes it serve as a kind of confirmation for @var{key}. - - These functions offer no way to specify a particular prefix keymap as -the one to redefine in, but that is not necessary, as you can include -prefixes in @var{key}. @var{key} is read by reading characters one by -one until they amount to a complete key (that is, not a prefix key). -Thus, if you type @kbd{C-f} for @var{key}, Emacs enters -the minibuffer immediately to read @var{cmd}. But if you type -@kbd{C-x}, another character is read; if that character is @kbd{4}, -another character is read, and so on. For example,@refill - -@example -M-x global-set-key @key{RET} C-x 4 $ spell-other-window @key{RET} -@end example - -@noindent -redefines @kbd{C-x 4 $} to run the (fictitious) command -@code{spell-other-window}. - -@findex define-key -@findex substitute-key-definition - The most general way to modify a keymap is the function -@code{define-key}, used in Lisp code (such as your @file{.emacs} file). -@code{define-key} takes three arguments: the keymap, the key to modify -in it, and the new definition. @xref{Init File}, for an example. -@code{substitute-key-definition} is used similarly; it takes three -arguments, an old definition, a new definition, and a keymap, and -redefines in that keymap all keys that were previously defined with the -old definition to have the new definition instead. - -@node Programmatic Rebinding -@subsubsection Changing Key Bindings Programmatically - - You can use the functions @code{global-set-key} and @code{define-key} -to rebind keys under program control. - -@findex define-key -@findex global-set-key - -@table @kbd -@item @code{(global-set-key @var{keys} @var{cmd})} -Defines @var{keys} globally to run @var{cmd}. -@item @code{(define-key @var{keymap} @var{keys} @var{def})} -Defines @var{keys} to run @var{def} in the keymap @var{keymap}. -@end table - -@var{keymap} is a keymap object. - -@var{keys} is the sequence of keystrokes to bind. - -@var{def} is anything that can be a key's definition: - -@itemize @bullet -@item -@code{nil}, meaning key is undefined in this keymap -@item -A command, that is, a Lisp function suitable for interactive calling -@item -A string or key sequence vector, which is treated as a keyboard macro -@item -A keymap to define a prefix key -@item -A symbol so that when the key is looked up, the symbol stands for its -function definition, which should at that time be one of the above, -or another symbol whose function definition is used, and so on -@item -A cons, @code{(string . defn)}, meaning that @var{defn} is the definition -(@var{defn} should be a valid definition in its own right) -@item -A cons, @code{(keymap . char)}, meaning use the definition of -@var{char} in map @var{keymap} -@end itemize - -For backward compatibility, XEmacs allows you to specify key -sequences as strings. However, the preferred method is to use the -representations of key sequences as vectors of keystrokes. -@xref{Keystrokes}, for more information about the rules for constructing -key sequences. - -Emacs allows you to abbreviate representations for key sequences in -most places where there is no ambiguity. -Here are some rules for abbreviation: - -@itemize @bullet -@item -The keysym by itself is equivalent to a list of just that keysym, i.e., -@code{f1} is equivalent to @code{(f1)}. -@item -A keystroke by itself is equivalent to a vector containing just that -keystroke, i.e., @code{(control a)} is equivalent to @code{[(control a)]}. -@item -You can use ASCII codes for keysyms that have them. i.e., -@code{65} is equivalent to @code{A}. (This is not so much an -abbreviation as an alternate representation.) -@end itemize - -Here are some examples of programmatically binding keys: - -@example - -;;; Bind @code{my-command} to @key{f1} -(global-set-key 'f1 'my-command) - -;;; Bind @code{my-command} to @kbd{Shift-f1} -(global-set-key '(shift f1) 'my-command) - -;;; Bind @code{my-command} to @kbd{C-c Shift-f1} -(global-set-key '[(control c) (shift f1)] 'my-command) - -;;; Bind @code{my-command} to the middle mouse button. -(global-set-key 'button2 'my-command) - -;;; Bind @code{my-command} to @kbd{@key{META} @key{CTL} @key{Right Mouse Button}} -;;; in the keymap that is in force when you are running @code{dired}. -(define-key dired-mode-map '(meta control button3) 'my-command) - -@end example - -@comment ;; note that these next four lines are not synonymous: -@comment ;; -@comment (global-set-key '(meta control delete) 'my-command) -@comment (global-set-key '(meta control backspace) 'my-command) -@comment (global-set-key '(meta control h) 'my-command) -@comment (global-set-key '(meta control H) 'my-command) -@comment -@comment ;; note that this binds two key sequences: ``control-j'' and ``linefeed''. -@comment ;; -@comment (global-set-key "\^J" 'my-command) - -@node Key Bindings Using Strings -@subsubsection Using Strings for Changing Key Bindings - - For backward compatibility, you can still use strings to represent -key sequences. Thus you can use commands like the following: - -@example -;;; Bind @code{end-of-line} to @kbd{C-f} -(global-set-key "\C-f" 'end-of-line) -@end example - -Note, however, that in some cases you may be binding more than one -key sequence by using a single command. This situation can -arise because in ASCII, @kbd{C-i} and @key{TAB} have -the same representation. Therefore, when Emacs sees: - -@example -(global-set-key "\C-i" 'end-of-line) -@end example - -it is unclear whether the user intended to bind @kbd{C-i} or @key{TAB}. -The solution XEmacs adopts is to bind both of these key -sequences. - -@cindex redefining keys -After binding a command to two key sequences with a form like: - -@example - (define-key global-map "\^X\^I" 'command-1) -@end example - -it is possible to redefine only one of those sequences like so: - -@example - (define-key global-map [(control x) (control i)] 'command-2) - (define-key global-map [(control x) tab] 'command-3) -@end example - -This applies only when running under a window system. If you are -talking to Emacs through an ASCII-only channel, you do not get any of -these features. - -Here is a table of pairs of key sequences that behave in a -similar fashion: - -@example - control h backspace - control l clear - control i tab - control m return - control j linefeed - control [ escape - control @@ control space -@end example - -@node Disabling -@subsection Disabling Commands -@cindex disabled command - - Disabling a command marks it as requiring confirmation before it -can be executed. The purpose of disabling a command is to prevent -beginning users from executing it by accident and being confused. - - The direct mechanism for disabling a command is to have a non-@code{nil} -@code{disabled} property on the Lisp symbol for the command. These -properties are normally set by the user's @file{.emacs} file with -Lisp expressions such as: - -@example -(put 'delete-region 'disabled t) -@end example - - If the value of the @code{disabled} property is a string, that string -is included in the message printed when the command is used: - -@example -(put 'delete-region 'disabled - "Text deleted this way cannot be yanked back!\n") -@end example - -@findex disable-command -@findex enable-command - You can disable a command either by editing the @file{.emacs} file -directly or with the command @kbd{M-x disable-command}, which edits the -@file{.emacs} file for you. @xref{Init File}. - - When you attempt to invoke a disabled command interactively in Emacs, -a window is displayed containing the command's name, its -documentation, and some instructions on what to do next; then -Emacs asks for input saying whether to execute the command as requested, -enable it and execute, or cancel it. If you decide to enable the -command, you are asked whether to do this permanently or just for the -current session. Enabling permanently works by automatically editing -your @file{.emacs} file. You can use @kbd{M-x enable-command} at any -time to enable any command permanently. - - Whether a command is disabled is independent of what key is used to -invoke it; it also applies if the command is invoked using @kbd{M-x}. -Disabling a command has no effect on calling it as a function from Lisp -programs. - -@node Syntax -@section The Syntax Table -@cindex syntax table - - All the Emacs commands which parse words or balance parentheses are -controlled by the @dfn{syntax table}. The syntax table specifies which -characters are opening delimiters, which are parts of words, which are -string quotes, and so on. Actually, each major mode has its own syntax -table (though sometimes related major modes use the same one) which it -installs in each buffer that uses that major mode. The syntax table -installed in the current buffer is the one that all commands use, so we -call it ``the'' syntax table. A syntax table is a Lisp object, a vector of -length 256 whose elements are numbers. - -@menu -* Entry: Syntax Entry. What the syntax table records for each character. -* Change: Syntax Change. How to change the information. -@end menu - -@node Syntax Entry -@subsection Information About Each Character - - The syntax table entry for a character is a number that encodes six -pieces of information: - -@itemize @bullet -@item -The syntactic class of the character, represented as a small integer -@item -The matching delimiter, for delimiter characters only -(the matching delimiter of @samp{(} is @samp{)}, and vice versa) -@item -A flag saying whether the character is the first character of a -two-character comment starting sequence -@item -A flag saying whether the character is the second character of a -two-character comment starting sequence -@item -A flag saying whether the character is the first character of a -two-character comment ending sequence -@item -A flag saying whether the character is the second character of a -two-character comment ending sequence -@end itemize - - The syntactic classes are stored internally as small integers, but are -usually described to or by the user with characters. For example, @samp{(} -is used to specify the syntactic class of opening delimiters. Here is a -table of syntactic classes, with the characters that specify them. - -@table @samp -@item @w{ } -The class of whitespace characters. -@item w -The class of word-constituent characters. -@item _ -The class of characters that are part of symbol names but not words. -This class is represented by @samp{_} because the character @samp{_} -has this class in both C and Lisp. -@item . -The class of punctuation characters that do not fit into any other -special class. -@item ( -The class of opening delimiters. -@item ) -The class of closing delimiters. -@item ' -The class of expression-adhering characters. These characters are -part of a symbol if found within or adjacent to one, and are part -of a following expression if immediately preceding one, but are like -whitespace if surrounded by whitespace. -@item " -The class of string-quote characters. They match each other in pairs, -and the characters within the pair all lose their syntactic -significance except for the @samp{\} and @samp{/} classes of escape -characters, which can be used to include a string-quote inside the -string. -@item $ -The class of self-matching delimiters. This is intended for @TeX{}'s -@samp{$}, which is used both to enter and leave math mode. Thus, -a pair of matching @samp{$} characters surround each piece of math mode -@TeX{} input. A pair of adjacent @samp{$} characters act like a single -one for purposes of matching. - -@item / -The class of escape characters that always just deny the following -character its special syntactic significance. The character after one -of these escapes is always treated as alphabetic. -@item \ -The class of C-style escape characters. In practice, these are -treated just like @samp{/}-class characters, because the extra -possibilities for C escapes (such as being followed by digits) have no -effect on where the containing expression ends. -@item < -The class of comment-starting characters. Only single-character -comment starters (such as @samp{;} in Lisp mode) are represented this -way. -@item > -The class of comment-ending characters. Newline has this syntax in -Lisp mode. -@end table - -@vindex parse-sexp-ignore-comments - The characters flagged as part of two-character comment delimiters can -have other syntactic functions most of the time. For example, @samp{/} and -@samp{*} in C code, when found separately, have nothing to do with -comments. The comment-delimiter significance overrides when the pair of -characters occur together in the proper order. Only the list and sexp -commands use the syntax table to find comments; the commands specifically -for comments have other variables that tell them where to find comments. -Moreover, the list and sexp commands notice comments only if -@code{parse-sexp-ignore-comments} is non-@code{nil}. This variable is set -to @code{nil} in modes where comment-terminator sequences are liable to -appear where there is no comment, for example, in Lisp mode where the -comment terminator is a newline but not every newline ends a comment. - -@node Syntax Change -@subsection Altering Syntax Information - - It is possible to alter a character's syntax table entry by storing a new -number in the appropriate element of the syntax table, but it would be hard -to determine what number to use. Emacs therefore provides a command that -allows you to specify the syntactic properties of a character in a -convenient way. - -@findex modify-syntax-entry - @kbd{M-x modify-syntax-entry} is the command to change a character's -syntax. It can be used interactively and is also used by major -modes to initialize their own syntax tables. Its first argument is the -character to change. The second argument is a string that specifies the -new syntax. When called from Lisp code, there is a third, optional -argument, which specifies the syntax table in which to make the change. If -not supplied, or if this command is called interactively, the third -argument defaults to the current buffer's syntax table. - -@enumerate -@item -The first character in the string specifies the syntactic class. It -is one of the characters in the previous table (@pxref{Syntax Entry}). - -@item -The second character is the matching delimiter. For a character that -is not an opening or closing delimiter, this should be a space, and may -be omitted if no following characters are needed. - -@item -The remaining characters are flags. The flag characters allowed are: - -@table @samp -@item 1 -Flag this character as the first of a two-character comment starting sequence. -@item 2 -Flag this character as the second of a two-character comment starting sequence. -@item 3 -Flag this character as the first of a two-character comment ending sequence. -@item 4 -Flag this character as the second of a two-character comment ending sequence. -@end table -@end enumerate - -@kindex C-h s -@findex describe-syntax - Use @kbd{C-h s} (@code{describe-syntax}) to display a description of -the contents of the current syntax table. The description of each -character includes both the string you have to pass to -@code{modify-syntax-entry} to set up that character's current syntax, -and some English to explain that string if necessary. - -@node Init File -@section The Init File, .emacs -@cindex init file -@cindex Emacs initialization file -@cindex key rebinding, permanent -@cindex rebinding keys, permanently - - When you start Emacs, it normally loads the file @file{.emacs} in your -home directory. This file, if it exists, should contain Lisp code. It -is called your initialization file or @dfn{init file}. Use the command -line switches @samp{-q} and @samp{-u} to tell Emacs whether to load an -init file (@pxref{Entering Emacs}). - -@vindex init-file-user -When the @file{.emacs} file is read, the variable @code{init-file-user} -says which user's init file it is. The value may be the null string or a -string containing a user's name. If the value is a null string, it means -that the init file was taken from the user that originally logged in. - -In all cases, @code{(concat "~" init-file-user "/")} evaluates to the -directory name of the directory where the @file{.emacs} file was looked -for. - - At some sites there is a @dfn{default init file}, which is the -library named @file{default.el}, found via the standard search path for -libraries. The Emacs distribution contains no such library; your site -may create one for local customizations. If this library exists, it is -loaded whenever you start Emacs. But your init file, if any, is loaded -first; if it sets @code{inhibit-default-init} non-@code{nil}, then -@file{default} is not loaded. - - If you have a large amount of code in your @file{.emacs} file, you -should move it into another file named @file{@var{something}.el}, -byte-compile it (@pxref{Lisp Libraries}), and load that file from your -@file{.emacs} file using @code{load}. - -@menu -* Init Syntax:: Syntax of constants in Emacs Lisp. -* Init Examples:: How to do some things with an init file. -* Terminal Init:: Each terminal type can have an init file. -@end menu - -@node Init Syntax -@subsection Init File Syntax - - The @file{.emacs} file contains one or more Lisp function call -expressions. Each consists of a function name followed by -arguments, all surrounded by parentheses. For example, @code{(setq -fill-column 60)} represents a call to the function @code{setq} which is -used to set the variable @code{fill-column} (@pxref{Filling}) to 60. - - The second argument to @code{setq} is an expression for the new value -of the variable. This can be a constant, a variable, or a function call -expression. In @file{.emacs}, constants are used most of the time. -They can be: - -@table @asis -@item Numbers -Integers are written in decimal, with an optional initial minus sign. - -If a sequence of digits is followed by a period and another sequence -of digits, it is interpreted as a floating point number. - -The number prefixes @samp{#b}, @samp{#o}, and @samp{#x} are supported to -represent numbers in binary, octal, and hexadecimal notation (or radix). - -@item Strings -Lisp string syntax is the same as C string syntax with a few extra -features. Use a double-quote character to begin and end a string constant. - -Newlines and special characters may be present literally in strings. They -can also be represented as backslash sequences: @samp{\n} for newline, -@samp{\b} for backspace, @samp{\r} for return, @samp{\t} for tab, -@samp{\f} for formfeed (control-l), @samp{\e} for escape, @samp{\\} for a -backslash, @samp{\"} for a double-quote, or @samp{\@var{ooo}} for the -character whose octal code is @var{ooo}. Backslash and double-quote are -the only characters for which backslash sequences are mandatory. - -You can use @samp{\C-} as a prefix for a control character, as in -@samp{\C-s} for ASCII Control-S, and @samp{\M-} as a prefix for -a Meta character, as in @samp{\M-a} for Meta-A or @samp{\M-\C-a} for -Control-Meta-A.@refill - -@item Characters -Lisp character constant syntax consists of a @samp{?} followed by -either a character or an escape sequence starting with @samp{\}. -Examples: @code{?x}, @code{?\n}, @code{?\"}, @code{?\)}. Note that -strings and characters are not interchangeable in Lisp; some contexts -require one and some contexts require the other. - -@item True -@code{t} stands for `true'. - -@item False -@code{nil} stands for `false'. - -@item Other Lisp objects -Write a single-quote (') followed by the Lisp object you want. -@end table - -@node Init Examples -@subsection Init File Examples - - Here are some examples of doing certain commonly desired things with -Lisp expressions: - -@itemize @bullet -@item -Make @key{TAB} in C mode just insert a tab if point is in the middle of a -line. - -@example -(setq c-tab-always-indent nil) -@end example - -Here we have a variable whose value is normally @code{t} for `true' -and the alternative is @code{nil} for `false'. - -@item -Make searches case sensitive by default (in all buffers that do not -override this). - -@example -(setq-default case-fold-search nil) -@end example - -This sets the default value, which is effective in all buffers that do -not have local values for the variable. Setting @code{case-fold-search} -with @code{setq} affects only the current buffer's local value, which -is probably not what you want to do in an init file. - -@item -Make Text mode the default mode for new buffers. - -@example -(setq default-major-mode 'text-mode) -@end example - -Note that @code{text-mode} is used because it is the command for entering -the mode we want. A single-quote is written before it to make a symbol -constant; otherwise, @code{text-mode} would be treated as a variable name. - -@item -Turn on Auto Fill mode automatically in Text mode and related modes. - -@example -(setq text-mode-hook - '(lambda () (auto-fill-mode 1))) -@end example - -Here we have a variable whose value should be a Lisp function. The -function we supply is a list starting with @code{lambda}, and a single -quote is written in front of it to make it (for the purpose of this -@code{setq}) a list constant rather than an expression. Lisp functions -are not explained here; for mode hooks it is enough to know that -@code{(auto-fill-mode 1)} is an expression that will be executed when -Text mode is entered. You could replace it with any other expression -that you like, or with several expressions in a row. - -@example -(setq text-mode-hook 'turn-on-auto-fill) -@end example - -This is another way to accomplish the same result. -@code{turn-on-auto-fill} is a symbol whose function definition is -@code{(lambda () (auto-fill-mode 1))}. - -@item -Load the installed Lisp library named @file{foo} (actually a file -@file{foo.elc} or @file{foo.el} in a standard Emacs directory). - -@example -(load "foo") -@end example - -When the argument to @code{load} is a relative pathname, not starting -with @samp{/} or @samp{~}, @code{load} searches the directories in -@code{load-path} (@pxref{Loading}). - -@item -Load the compiled Lisp file @file{foo.elc} from your home directory. - -@example -(load "~/foo.elc") -@end example - -Here an absolute file name is used, so no searching is done. - -@item -Rebind the key @kbd{C-x l} to run the function @code{make-symbolic-link}. - -@example -(global-set-key "\C-xl" 'make-symbolic-link) -@end example - -or - -@example -(define-key global-map "\C-xl" 'make-symbolic-link) -@end example - -Note once again the single-quote used to refer to the symbol -@code{make-symbolic-link} instead of its value as a variable. - -@item -Do the same thing for C mode only. - -@example -(define-key c-mode-map "\C-xl" 'make-symbolic-link) -@end example - -@item -Bind the function key @key{F1} to a command in C mode. -Note that the names of function keys must be lower case. - -@example -(define-key c-mode-map 'f1 'make-symbolic-link) -@end example - -@item -Bind the shifted version of @key{F1} to a command. - -@example -(define-key c-mode-map '(shift f1) 'make-symbolic-link) -@end example - -@item -Redefine all keys which now run @code{next-line} in Fundamental mode -to run @code{forward-line} instead. - -@example -(substitute-key-definition 'next-line 'forward-line - global-map) -@end example - -@item -Make @kbd{C-x C-v} undefined. - -@example -(global-unset-key "\C-x\C-v") -@end example - -One reason to undefine a key is so that you can make it a prefix. -Simply defining @kbd{C-x C-v @var{anything}} would make @kbd{C-x C-v} -a prefix, but @kbd{C-x C-v} must be freed of any non-prefix definition -first. - -@item -Make @samp{$} have the syntax of punctuation in Text mode. -Note the use of a character constant for @samp{$}. - -@example -(modify-syntax-entry ?\$ "." text-mode-syntax-table) -@end example - -@item -Enable the use of the command @code{eval-expression} without confirmation. - -@example -(put 'eval-expression 'disabled nil) -@end example -@end itemize - -@node Terminal Init -@subsection Terminal-Specific Initialization - - Each terminal type can have a Lisp library to be loaded into Emacs when -it is run on that type of terminal. For a terminal type named -@var{termtype}, the library is called @file{term/@var{termtype}} and it is -found by searching the directories @code{load-path} as usual and trying the -suffixes @samp{.elc} and @samp{.el}. Normally it appears in the -subdirectory @file{term} of the directory where most Emacs libraries are -kept.@refill - - The usual purpose of the terminal-specific library is to define the -escape sequences used by the terminal's function keys using the library -@file{keypad.el}. See the file -@file{term/vt100.el} for an example of how this is done.@refill - - When the terminal type contains a hyphen, only the part of the name -before the first hyphen is significant in choosing the library name. -Thus, terminal types @samp{aaa-48} and @samp{aaa-30-rv} both use -the library @file{term/aaa}. The code in the library can use -@code{(getenv "TERM")} to find the full terminal type name.@refill - -@vindex term-file-prefix - The library's name is constructed by concatenating the value of the -variable @code{term-file-prefix} and the terminal type. Your @file{.emacs} -file can prevent the loading of the terminal-specific library by setting -@code{term-file-prefix} to @code{nil}. - -@vindex term-setup-hook - The value of the variable @code{term-setup-hook}, if not @code{nil}, is -called as a function of no arguments at the end of Emacs initialization, -after both your @file{.emacs} file and any terminal-specific library have -been read. You can set the value in the @file{.emacs} file to override -part of any of the terminal-specific libraries and to define -initializations for terminals that do not have a library.@refill - -@node Audible Bell -@section Changing the Bell Sound -@cindex audible bell, changing -@cindex bell, changing -@vindex sound-alist -@findex load-default-sounds -@findex play-sound - -You can now change how the audible bell sounds using the variable -@code{sound-alist}. - -@code{sound-alist}'s value is an list associating symbols with, among -other things, strings of audio-data. When @code{ding} is called with -one of the symbols, the associated sound data is played instead of the -standard beep. This only works if you are logged in on the console of a -machine with audio hardware. To listen to a sound of the provided type, -call the function @code{play-sound} with the argument @var{sound}. You -can also set the volume of the sound with the optional argument -@var{volume}.@refill -@cindex ding - -Each element of @code{sound-alist} is a list describing a sound. -The first element of the list is the name of the sound being defined. -Subsequent elements of the list are alternating keyword/value pairs: - -@table @code -@item sound -A string of raw sound data, or the name of another sound to play. -The symbol @code{t} here means use the default X beep. - -@item volume -An integer from 0-100, defaulting to @code{bell-volume}. - -@item pitch -If using the default X beep, the pitch (Hz) to generate. - -@item duration -If using the default X beep, the duration (milliseconds). -@end table - -For compatibility, elements of `sound-alist' may also be of the form: - -@example -( @var{sound-name} . @var{} ) -( @var{sound-name} @var{} @var{} ) -@end example - -You should probably add things to this list by calling the function -@code{load-sound-file}. - -Note that you can only play audio data if running on the console screen -of a machine with audio hardware which emacs understands, which at this -time means a Sun SparcStation, SGI, or HP9000s700. - -Also note that the pitch, duration, and volume options are available -everywhere, but most X servers ignore the `pitch' option. - -@vindex bell-volume -The variable @code{bell-volume} should be an integer from 0 to 100, -with 100 being loudest, which controls how loud the sounds emacs makes -should be. Elements of the @code{sound-alist} may override this value. -This variable applies to the standard X bell sound as well as sound files. - -If the symbol @code{t} is in place of a sound-string, Emacs uses the -default X beep. This allows you to define beep-types of -different volumes even when not running on the console. - -@findex load-sound-file -You can add things to this list by calling the function -@code{load-sound-file}, which reads in an audio-file and adds its data to -the sound-alist. You can specify the sound with the @var{sound-name} -argument and the file into which the sounds are loaded with the -@var{filename} argument. The optional @var{volume} argument sets the -volume. - -@code{load-sound-file (@var{filename sound-name} &optional @var{volume})} - -To load and install some sound files as beep-types, use the function -@code{load-default-sounds} (note that this only works if you are on -display 0 of a machine with audio hardware). - -The following beep-types are used by Emacs itself. Other Lisp -packages may use other beep types, but these are the ones that the C -kernel of Emacs uses. - -@table @code -@item auto-save-error -An auto-save does not succeed - -@item command-error -The Emacs command loop catches an error - -@item undefined-key -You type a key that is undefined - -@item undefined-click -You use an undefined mouse-click combination - -@item no-completion -Completion was not possible - -@item y-or-n-p -You type something other than the required @code{y} or @code{n} - -@item yes-or-no-p -You type something other than @code{yes} or @code{no} -@end table - -@comment node-name, next, previous, up -@node Faces -@section Faces - -XEmacs has objects called extents and faces. An @dfn{extent} -is a region of text and a @dfn{face} is a collection of textual -attributes, such as fonts and colors. Every extent is displayed in some -face; therefore, changing the properties of a face immediately updates the -display of all associated extents. Faces can be frame-local: you can -have a region of text that displays with completely different -attributes when its buffer is viewed from a different X window. - -The display attributes of faces may be specified either in Lisp or through -the X resource manager. - -@subsection Customizing Faces - -You can change the face of an extent with the functions in -this section. All the functions prompt for a @var{face} as an -argument; use completion for a list of possible values. - -@table @kbd -@item M-x invert-face -Swap the foreground and background colors of the given @var{face}. -@item M-x make-face-bold -Make the font of the given @var{face} bold. When called from a -program, returns @code{nil} if this is not possible. -@item M-x make-face-bold-italic -Make the font of the given @var{face} bold italic. -When called from a program, returns @code{nil} if not possible. -@item M-x make-face-italic -Make the font of the given @var{face} italic. -When called from a program, returns @code{nil} if not possible. -@item M-x make-face-unbold -Make the font of the given @var{face} non-bold. -When called from a program, returns @code{nil} if not possible. -@item M-x make-face-unitalic -Make the font of the given @var{face} non-italic. -When called from a program, returns @code{nil} if not possible. -@item M-x make-face-larger -Make the font of the given @var{face} a little larger. -When called from a program, returns @code{nil} if not possible. -@item M-x make-face-smaller -Make the font of the given @var{face} a little smaller. -When called from a program, returns @code{nil} if not possible. -@item M-x set-face-background -Change the background color of the given @var{face}. -@item M-x set-face-background-pixmap -Change the background pixmap of the given @var{face}. -@item M-x set-face-font -Change the font of the given @var{face}. -@item M-x set-face-foreground -Change the foreground color of the given @var{face}. -@item M-x set-face-underline-p -Change whether the given @var{face} is underlined. -@end table - -@findex make-face-bold -@findex make-face-bold-italic -@findex make-face-italic -@findex make-face-unbold -@findex make-face-unitalic -@findex make-face-larger -@findex make-face-smaller - -@findex invert-face -You can exchange the foreground and background color of the selected -@var{face} with the function @code{invert-face}. If the face does not -specify both foreground and background, then its foreground and -background are set to the background and foreground of the default face. -When calling this from a program, you can supply the optional argument -@var{frame} to specify which frame is affected; otherwise, all frames -are affected. - -@findex set-face-background -You can set the background color of the specified @var{face} with the -function @code{set-face-background}. The argument @code{color} should -be a string, the name of a color. When called from a program, if the -optional @var{frame} argument is provided, the face is changed only -in that frame; otherwise, it is changed in all frames. - -@findex set-face-background-pixmap -You can set the background pixmap of the specified @var{face} with the -function @code{set-face-background-pixmap}. The pixmap argument -@var{name} should be a string, the name of a file of pixmap data. The -directories listed in the @code{x-bitmap-file-path} variable are -searched. The bitmap may also be a list of the form @code{(@var{width -height data})}, where @var{width} and @var{height} are the size in -pixels, and @var{data} is a string containing the raw bits of the -bitmap. If the optional @var{frame} argument is provided, the face is -changed only in that frame; otherwise, it is changed in all frames. - -The variable @code{x-bitmap-file-path} takes as a value a list of the -directories in which X bitmap files may be found. If the value is -@code{nil}, the list is initialized from the @code{*bitmapFilePath} -resource. - -If the environment variable @b{XBMLANGPATH} is set, then it is consulted -before the @code{x-bitmap-file-path} variable. - -@findex set-face-font -You can set the font of the specified @var{face} with the function -@code{set-face-font}. The @var{font} argument should be a string, the -name of a font. When called from a program, if the -optional @var{frame} argument is provided, the face is changed only -in that frame; otherwise, it is changed in all frames. - -@findex set-face-foreground -You can set the foreground color of the specified @var{face} with the -function @code{set-face-foreground}. The argument @var{color} should be -a string, the name of a color. If the optional @var{frame} argument is -provided, the face is changed only in that frame; otherwise, it is -changed in all frames. - -@findex set-face-underline-p -You can set underline the specified @var{face} with the function -@code{set-face-underline-p}. The argument @var{underline-p} can be used -to make underlining an attribute of the face or not. If the optional -@var{frame} argument is provided, the face is changed only in that -frame; otherwise, it is changed in all frames. - -@node X Resources -@section X Resources -@cindex X resources -@findex x-create-frame - -Historically, XEmacs has used the X resource application class @samp{Emacs} -for its resources. Unfortunately, GNU Emacs uses the same application -class, and resources are not compatible between the two Emacsen. This -sharing of the application class often leads to trouble if you want to -run both variants. - -Starting with XEmacs 21, XEmacs uses the class @samp{XEmacs} if it finds -any XEmacs resources in the resource database when the X connection is -initialized. Otherwise, it will use the class @samp{Emacs} for -backwards compatability. The variable @var{x-emacs-application-class} -may be consulted to determine the application class being used. - -The examples in this section assume the application class is @samp{Emacs}. - -The Emacs resources are generally set per-frame. Each Emacs frame can have -its own name or the same name as another, depending on the name passed to the -@code{make-frame} function. - -You can specify resources for all frames with the syntax: - -@example -Emacs*parameter: value -@end example -@noindent - -or - -@example -Emacs*EmacsFrame.parameter:value -@end example -@noindent - -You can specify resources for a particular frame with the syntax: - -@example -Emacs*FRAME-NAME.parameter: value -@end example -@noindent - -@menu -* Geometry Resources:: Controlling the size and position of frames. -* Iconic Resources:: Controlling whether frames come up iconic. -* Resource List:: List of resources settable on a frame or device. -* Face Resources:: Controlling faces using resources. -* Widgets:: The widget hierarchy for XEmacs. -* Menubar Resources:: Specifying resources for the menubar. -@end menu - -@node Geometry Resources -@subsection Geometry Resources - -To make the default size of all Emacs frames be 80 columns by 55 lines, -do this: - -@example -Emacs*EmacsFrame.geometry: 80x55 -@end example -@noindent - -To set the geometry of a particular frame named @samp{fred}, do this: - -@example -Emacs*fred.geometry: 80x55 -@end example -@noindent - -Important! Do not use the following syntax: - -@example -Emacs*geometry: 80x55 -@end example -@noindent - -You should never use @code{*geometry} with any X application. It does -not say "make the geometry of Emacs be 80 columns by 55 lines." It -really says, "make Emacs and all subwindows thereof be 80x55 in whatever -units they care to measure in." In particular, that is both telling the -Emacs text pane to be 80x55 in characters, and telling the menubar pane -to be 80x55 pixels, which is surely not what you want. - -As a special case, this geometry specification also works (and sets the -default size of all Emacs frames to 80 columns by 55 lines): - -@example -Emacs.geometry: 80x55 -@end example -@noindent - -since that is the syntax used with most other applications (since most -other applications have only one top-level window, unlike Emacs). In -general, however, the top-level shell (the unmapped ApplicationShell -widget named @samp{Emacs} that is the parent of the shell widgets that -actually manage the individual frames) does not have any interesting -resources on it, and you should set the resources on the frames instead. - -The @code{-geometry} command-line argument sets only the geometry of the -initial frame created by Emacs. - -A more complete explanation of geometry-handling is - -@itemize @bullet -@item -The @code{-geometry} command-line option sets the @code{Emacs.geometry} -resource, that is, the geometry of the ApplicationShell. - -@item -For the first frame created, the size of the frame is taken from the -ApplicationShell if it is specified, otherwise from the geometry of the -frame. - -@item -For subsequent frames, the order is reversed: First the frame, and then -the ApplicationShell. - -@item -For the first frame created, the position of the frame is taken from the -ApplicationShell (@code{Emacs.geometry}) if it is specified, otherwise -from the geometry of the frame. - -@item -For subsequent frames, the position is taken only from the frame, and -never from the ApplicationShell. -@end itemize - -This is rather complicated, but it does seem to provide the most -intuitive behavior with respect to the default sizes and positions of -frames created in various ways. - -@node Iconic Resources -@subsection Iconic Resources - -Analogous to @code{-geometry}, the @code{-iconic} command-line option -sets the iconic flag of the ApplicationShell (@code{Emacs.iconic}) and -always applies to the first frame created regardless of its name. -However, it is possible to set the iconic flag on particular frames (by -name) by using the @code{Emacs*FRAME-NAME.iconic} resource. - -@node Resource List -@subsection Resource List - -Emacs frames accept the following resources: - -@table @asis -@item @code{geometry} (class @code{Geometry}): string -Initial geometry for the frame. @xref{Geometry Resources} for a -complete discussion of how this works. - -@item @code{iconic} (class @code{Iconic}): boolean -Whether this frame should appear in the iconified state. - -@item @code{internalBorderWidth} (class @code{InternalBorderWidth}): int -How many blank pixels to leave between the text and the edge of the -window. - -@item @code{interline} (class @code{Interline}): int -How many pixels to leave between each line (may not be implemented). - -@item @code{menubar} (class @code{Menubar}): boolean -Whether newly-created frames should initially have a menubar. Set to -true by default. - -@item @code{initiallyUnmapped} (class @code{InitiallyUnmapped}): boolean -Whether XEmacs should leave the initial frame unmapped when it starts -up. This is useful if you are starting XEmacs as a server (e.g. in -conjunction with gnuserv or the external client widget). You can also -control this with the @code{-unmapped} command-line option. - -@item @code{barCursor} (class @code{BarColor}): boolean -Whether the cursor should be displayed as a bar, or the traditional box. - -@item @code{cursorColor} (class @code{CursorColor}): color-name -The color of the text cursor. - -@item @code{scrollBarWidth} (class @code{ScrollBarWidth}): integer -How wide the vertical scrollbars should be, in pixels; 0 means no -vertical scrollbars. You can also use a resource specification of the -form @code{*scrollbar.width}, or the usual toolkit scrollbar resources: -@code{*XmScrollBar.width} (Motif), @code{*XlwScrollBar.width} (Lucid), -or @code{*Scrollbar.thickness} (Athena). We don't recommend that you -use the toolkit resources, though, because they're dependent on how -exactly your particular build of XEmacs was configured. - -@item @code{scrollBarHeight} (class @code{ScrollBarHeight}): integer -How high the horizontal scrollbars should be, in pixels; 0 means no -horizontal scrollbars. You can also use a resource specification of the -form @code{*scrollbar.height}, or the usual toolkit scrollbar resources: -@code{*XmScrollBar.height} (Motif), @code{*XlwScrollBar.height} (Lucid), -or @code{*Scrollbar.thickness} (Athena). We don't recommend that you use -the toolkit resources, though, because they're dependent on how exactly -your particular build of XEmacs was configured. - -@item @code{scrollBarPlacement} (class @code{ScrollBarPlacement}): string -Where the horizontal and vertical scrollbars should be positioned. This -should be one of the four strings @samp{BOTTOM_LEFT}, -@samp{BOTTOM_RIGHT}, @samp{TOP_LEFT}, and @samp{TOP_RIGHT}. Default is -@samp{BOTTOM_RIGHT} for the Motif and Lucid scrollbars and -@samp{BOTTOM_LEFT} for the Athena scrollbars. - -@item @code{topToolBarHeight} (class @code{TopToolBarHeight}): integer -@itemx @code{bottomToolBarHeight} (class @code{BottomToolBarHeight}): integer -@itemx @code{leftToolBarWidth} (class @code{LeftToolBarWidth}): integer -@itemx @code{rightToolBarWidth} (class @code{RightToolBarWidth}): integer -Height and width of the four possible toolbars. - -@item @code{topToolBarShadowColor} (class @code{TopToolBarShadowColor}): color-name -@itemx @code{bottomToolBarShadowColor} (class @code{BottomToolBarShadowColor}): color-name -Color of the top and bottom shadows for the toolbars. NOTE: These resources -do @emph{not} have anything to do with the top and bottom toolbars (i.e. the -toolbars at the top and bottom of the frame)! Rather, they affect the top -and bottom shadows around the edges of all four kinds of toolbars. - -@item @code{topToolBarShadowPixmap} (class @code{TopToolBarShadowPixmap}): pixmap-name -@itemx @code{bottomToolBarShadowPixmap} (class @code{BottomToolBarShadowPixmap}): pixmap-name -Pixmap of the top and bottom shadows for the toolbars. If set, these -resources override the corresponding color resources. NOTE: These -resources do @emph{not} have anything to do with the top and bottom -toolbars (i.e. the toolbars at the top and bottom of the frame)! -Rather, they affect the top and bottom shadows around the edges of all -four kinds of toolbars. - -@item @code{toolBarShadowThickness} (class @code{ToolBarShadowThickness}): integer -Thickness of the shadows around the toolbars, in pixels. - -@item @code{visualBell} (class @code{VisualBell}): boolean -Whether XEmacs should flash the screen rather than making an audible beep. - -@item @code{bellVolume} (class @code{BellVolume}): integer -Volume of the audible beep. - -@item @code{useBackingStore} (class @code{UseBackingStore}): boolean -Whether XEmacs should set the backing-store attribute of the X windows -it creates. This increases the memory usage of the X server but decreases -the amount of X traffic necessary to update the screen, and is useful -when the connection to the X server goes over a low-bandwidth line -such as a modem connection. -@end table - -Emacs devices accept the following resources: - -@table @asis -@item @code{textPointer} (class @code{Cursor}): cursor-name -The cursor to use when the mouse is over text. This resource is used to -initialize the variable @code{x-pointer-shape}. - -@item @code{selectionPointer} (class @code{Cursor}): cursor-name -The cursor to use when the mouse is over a selectable text region (an -extent with the @samp{highlight} property; for example, an Info -cross-reference). This resource is used to initialize the variable -@code{x-selection-pointer-shape}. - -@item @code{spacePointer} (class @code{Cursor}): cursor-name -The cursor to use when the mouse is over a blank space in a buffer (that -is, after the end of a line or after the end-of-file). This resource is -used to initialize the variable @code{x-nontext-pointer-shape}. - -@item @code{modeLinePointer} (class @code{Cursor}): cursor-name -The cursor to use when the mouse is over a modeline. This resource is -used to initialize the variable @code{x-mode-pointer-shape}. - -@item @code{gcPointer} (class @code{Cursor}): cursor-name -The cursor to display when a garbage-collection is in progress. This -resource is used to initialize the variable @code{x-gc-pointer-shape}. - -@item @code{scrollbarPointer} (class @code{Cursor}): cursor-name -The cursor to use when the mouse is over the scrollbar. This resource -is used to initialize the variable @code{x-scrollbar-pointer-shape}. - -@item @code{pointerColor} (class @code{Foreground}): color-name -@itemx @code{pointerBackground} (class @code{Background}): color-name -The foreground and background colors of the mouse cursor. These -resources are used to initialize the variables -@code{x-pointer-foreground-color} and @code{x-pointer-background-color}. -@end table - -@node Face Resources -@subsection Face Resources - -The attributes of faces are also per-frame. They can be specified as: - -@example -Emacs.FACE_NAME.parameter: value -@end example -@noindent - -or - -@example -Emacs*FRAME_NAME.FACE_NAME.parameter: value -@end example -@noindent - -Faces accept the following resources: - -@table @asis -@item @code{attributeFont} (class @code{AttributeFont}): font-name -The font of this face. - -@item @code{attributeForeground} (class @code{AttributeForeground}): color-name -@itemx @code{attributeBackground} (class @code{AttributeBackground}): color-name -The foreground and background colors of this face. - -@item @code{attributeBackgroundPixmap} (class @code{AttributeBackgroundPixmap}): file-name -The name of an @sc{XBM} file (or @sc{XPM} file, if your version of Emacs -supports @sc{XPM}), to use as a background stipple. - -@item @code{attributeUnderline} (class @code{AttributeUnderline}): boolean -Whether text in this face should be underlined. -@end table - -All text is displayed in some face, defaulting to the face named -@code{default}. To set the font of normal text, use -@code{Emacs*default.attributeFont}. To set it in the frame named -@code{fred}, use @code{Emacs*fred.default.attributeFont}. - -These are the names of the predefined faces: - -@table @code -@item default -Everything inherits from this. - -@item bold -If this is not specified in the resource database, Emacs tries to find a -bold version of the font of the default face. - -@item italic -If this is not specified in the resource database, Emacs tries to find -an italic version of the font of the default face. - -@item bold-italic -If this is not specified in the resource database, Emacs tries to find a -bold-italic version of the font of the default face. - -@item modeline -This is the face that the modeline is displayed in. If not specified in -the resource database, it is determined from the default face by -reversing the foreground and background colors. - -@item highlight -This is the face that highlighted extents (for example, Info -cross-references and possible completions, when the mouse passes over -them) are displayed in. - -@item left-margin -@itemx right-margin -These are the faces that the left and right annotation margins are -displayed in. - -@item zmacs-region -This is the face that mouse selections are displayed in. - -@item isearch -This is the face that the matched text being searched for is displayed -in. - -@item info-node -This is the face of info menu items. If unspecified, it is copied from -@code{bold-italic}. - -@item info-xref -This is the face of info cross-references. If unspecified, it is copied -from @code{bold}. (Note that, when the mouse passes over a -cross-reference, the cross-reference's face is determined from a -combination of the @code{info-xref} and @code{highlight} faces.) -@end table - -Other packages might define their own faces; to see a list of all faces, -use any of the interactive face-manipulation commands such as -@code{set-face-font} and type @samp{?} when you are prompted for the -name of a face. - -If the @code{bold}, @code{italic}, and @code{bold-italic} faces are not -specified in the resource database, then XEmacs attempts to derive them -from the font of the default face. It can only succeed at this if you -have specified the default font using the XLFD (X Logical Font -Description) format, which looks like - -@example -*-courier-medium-r-*-*-*-120-*-*-*-*-*-* -@end example -@noindent - -If you use any of the other, less strict font name formats, some of which -look like - -@example -lucidasanstypewriter-12 -fixed -9x13 -@end example - -then XEmacs won't be able to guess the names of the bold and italic -versions. All X fonts can be referred to via XLFD-style names, so you -should use those forms. See the man pages for @samp{X(1)}, -@samp{xlsfonts(1)}, and @samp{xfontsel(1)}. - -@node Widgets -@subsection Widgets - -There are several structural widgets between the terminal EmacsFrame -widget and the top level ApplicationShell; the exact names and types of -these widgets change from release to release (for example, they changed -between 19.8 and 19.9, 19.9 and 19.10, and 19.10 and 19.12) and are -subject to further change in the future, so you should avoid mentioning -them in your resource database. The above-mentioned syntaxes should be -forward- compatible. As of 19.13, the exact widget hierarchy is as -follows: - -@example -INVOCATION-NAME "shell" "container" FRAME-NAME -x-emacs-application-class "EmacsShell" "EmacsManager" "EmacsFrame" -@end example - -where INVOCATION-NAME is the terminal component of the name of the -XEmacs executable (usually @samp{xemacs}), and -@samp{x-emacs-application-class} is generally @samp{Emacs}. - -@node Menubar Resources -@subsection Menubar Resources - -As the menubar is implemented as a widget which is not a part of XEmacs -proper, it does not use the fac" mechanism for specifying fonts and -colors: It uses whatever resources are appropriate to the type of widget -which is used to implement it. - -If Emacs was compiled to use only the Motif-lookalike menu widgets, then one -way to specify the font of the menubar would be - -@example -Emacs*menubar*font: *-courier-medium-r-*-*-*-120-*-*-*-*-*-* -@end example - -If the Motif library is being used, then one would have to use - -@example -Emacs*menubar*fontList: *-courier-medium-r-*-*-*-120-*-*-*-*-*-* -@end example - -because the Motif library uses the @code{fontList} resource name instead -of @code{font}, which has subtly different semantics. - -The same is true of the scrollbars: They accept whichever resources are -appropriate for the toolkit in use. diff --git a/man/xemacs/entering.texi b/man/xemacs/entering.texi deleted file mode 100644 index 2c9b33c..0000000 --- a/man/xemacs/entering.texi +++ /dev/null @@ -1,100 +0,0 @@ - -@node Entering Emacs, Exiting, Pull-down Menus, Top -@chapter Entering and Exiting Emacs -@cindex entering Emacs -@cindex entering XEmacs - - The usual way to invoke Emacs is to type @kbd{emacs @key{RET}} at the -shell (for XEmacs, type @kbd{xemacs @key{RET}}). Emacs clears the -screen and then displays an initial advisory message and copyright -notice. You can begin typing Emacs commands immediately afterward. - - Some operating systems insist on discarding all type-ahead when Emacs -starts up; they give Emacs no way to prevent this. Therefore, it is -wise to wait until Emacs clears the screen before typing the first -editing command. - -@vindex initial-major-mode - Before Emacs reads the first command, you have not had a chance to -give a command to specify a file to edit. Since Emacs must always have a -current buffer for editing, it presents a buffer, by default, a buffer named -@samp{*scratch*}. The buffer is in Lisp Interaction -mode; you can use it to type Lisp expressions and evaluate them, or you -can ignore that capability and simply doodle. You can specify a -different major mode for this buffer by setting the variable -@code{initial-major-mode} in your init file. @xref{Init File}. - - It is possible to give Emacs arguments in the shell command line to -specify files to visit, Lisp files to load, and functions to call. - -@node Exiting, Command Switches, Entering Emacs, Top -@section Exiting Emacs -@cindex exiting -@cindex killing Emacs -@cindex suspending -@cindex shrinking XEmacs frame - - There are two commands for exiting Emacs because there are two kinds -of exiting: @dfn{suspending} Emacs and @dfn{killing} Emacs. -@dfn{Suspending} means stopping Emacs temporarily and returning control -to its superior (usually the shell), allowing you to resume editing -later in the same Emacs job, with the same files, same kill ring, same -undo history, and so on. This is the usual way to exit. @dfn{Killing} -Emacs means destroying the Emacs job. You can run Emacs again later, -but you will get a fresh Emacs; there is no way to resume the same -editing session after it has been killed. - -@table @kbd -@item C-z -Suspend Emacs (@code{suspend-emacs}). If used under the X window system, -shrink the X window containing the Emacs frame to an icon (see below). -@item C-x C-c -Kill Emacs (@code{save-buffers-kill-emacs}). -@end table - -If you use XEmacs under the X window system, @kbd{C-z} shrinks -the X window containing the Emacs frame to an icon. The Emacs process -is stopped temporarily, and control is returned to the window manager. -If more than one frame is associated with the Emacs process, only the -frame from which you used @kbd{C-z} is retained. The X windows -containing the other Emacs frames are closed. - -To activate the "suspended" Emacs, use the appropriate window manager -mouse gestures. Usually left-clicking on the icon reactivates and -reopens the X window containing the Emacs frame, but the window manager -you use determines what exactly happens. To actually kill the Emacs -process, use @kbd{C-x C-c} or the @b{Exit Emacs} item on the @b{File} -menu. - -@kindex C-z -@findex suspend-emacs - On systems that do not permit programs to be suspended, @kbd{C-z} runs -an inferior shell that communicates directly with the terminal, and -Emacs waits until you exit the subshell. On these systems, the only way -to return to the shell from which Emacs was started (to log out, for -example) is to kill Emacs. @kbd{C-d} or @code{exit} are typical -commands to exit a subshell. - -@kindex C-x C-c -@findex save-buffers-kill-emacs - To kill Emacs, type @kbd{C-x C-c} (@code{save-buffers-kill-emacs}). A -two-character key is used for this to make it harder to type. In -XEmacs, selecting the @b{Exit Emacs} option of the @b{File} menu is an -alternate way of issuing the command. - -Unless a numeric argument is used, this command first offers to save any -modified buffers. If you do not save all buffers, you are asked for -reconfirmation with @kbd{yes} before killing Emacs, since any changes -not saved will be lost. If any subprocesses are still running, @kbd{C-x -C-c} asks you to confirm killing them, since killing Emacs kills the -subprocesses simultaneously. - - In most programs running on Unix, certain characters may instantly -suspend or kill the program. (In Berkeley Unix these characters are -normally @kbd{C-z} and @kbd{C-c}.) @i{This Unix feature is turned off -while you are in Emacs.} The meanings of @kbd{C-z} and @kbd{C-x C-c} as -keys in Emacs were inspired by the standard Berkeley Unix meanings of -@kbd{C-z} and @kbd{C-c}, but that is their only relationship with Unix. -You could customize these keys to do anything (@pxref{Keymaps}). - -@c ??? What about system V here? diff --git a/man/xemacs/files.texi b/man/xemacs/files.texi deleted file mode 100644 index 7ca98a7..0000000 --- a/man/xemacs/files.texi +++ /dev/null @@ -1,1757 +0,0 @@ - -@node Files, Buffers, Fixit, Top -@chapter File Handling -@cindex files - - The basic unit of stored data in Unix is the @dfn{file}. To edit a file, -you must tell Emacs to examine the file and prepare a buffer containing a -copy of the file's text. This is called @dfn{visiting} the file. Editing -commands apply directly to text in the buffer; that is, to the copy inside -Emacs. Your changes appear in the file itself only when you @dfn{save} the -buffer back into the file. - - In addition to visiting and saving files, Emacs can delete, copy, rename, -and append to files, and operate on file directories. - -@menu -* File Names:: How to type and edit file name arguments. -* Visiting:: Visiting a file prepares Emacs to edit the file. -* Saving:: Saving makes your changes permanent. -* Reverting:: Reverting cancels all the changes not saved. -* Auto Save:: Auto Save periodically protects against loss of data. -* Version Control:: Version control systems (RCS and SCCS). -* ListDir:: Listing the contents of a file directory. -* Comparing Files:: Finding where two files differ. -* Dired:: ``Editing'' a directory to delete, rename, etc. - the files in it. -* Misc File Ops:: Other things you can do on files. -@end menu - -@node File Names, Visiting, Files, Files -@section File Names -@cindex file names - - Most Emacs commands that operate on a file require you to specify the -file name. (Saving and reverting are exceptions; the buffer knows which -file name to use for them.) File names are specified in the minibuffer -(@pxref{Minibuffer}). @dfn{Completion} is available, to make it easier to -specify long file names. @xref{Completion}. - - There is always a @dfn{default file name} which is used if you -enter an empty argument by typing just @key{RET}. Normally the default -file name is the name of the file visited in the current buffer; this -makes it easy to operate on that file with any of the Emacs file -commands. - -@vindex default-directory - Each buffer has a default directory, normally the same as the -directory of the file visited in that buffer. When Emacs reads a file -name, the default directory is used if you do not specify a directory. -If you specify a directory in a relative fashion, with a name that does -not start with a slash, it is interpreted with respect to the default -directory. The default directory of the current buffer is kept in the -variable @code{default-directory}, which has a separate value in every -buffer. The value of the variable should end with a slash. - - For example, if the default file name is @file{/u/rms/gnu/gnu.tasks} then -the default directory is @file{/u/rms/gnu/}. If you type just @samp{foo}, -which does not specify a directory, it is short for @file{/u/rms/gnu/foo}. -@samp{../.login} would stand for @file{/u/rms/.login}. @samp{new/foo} -would stand for the filename @file{/u/rms/gnu/new/foo}. - -@vindex default-directory-alist -The variable @code{default-directory-alist} takes an alist of major -modes and their opinions on @code{default-directory} as a Lisp -expression to evaluate. A resulting value of @code{nil} is ignored in -favor of @code{default-directory}. - -@findex make-directory -@findex remove-directory -@cindex creating directories -@cindex removing directories -You can create a new directory with the function @code{make-directory}, -which takes as an argument a file name string. The current directory is -displayed in the minibuffer when the function is called; you can delete -the old directory name and supply a new directory name. For example, if -the current directory is @file{/u/rms/gnu}, you can delete @file{gnu} -and type @file{oryx} and @key{RET} to create @file{/u/rms/oryx}. -Removing a directory is similar to creating one. To remove a directory, -use @code{remove-directory}; it takes one argument, a file name string. - - The command @kbd{M-x pwd} prints the current buffer's default directory, -and the command @kbd{M-x cd} sets it (to a value read using the -minibuffer). A buffer's default directory changes only when the @code{cd} -command is used. A file-visiting buffer's default directory is initialized -to the directory of the file that is visited there. If a buffer is created -with @kbd{C-x b}, its default directory is copied from that of the -buffer that was current at the time. - -@vindex insert-default-directory - The default directory name actually appears in the minibuffer when the -minibuffer becomes active to read a file name. This serves two -purposes: it shows you what the default is, so that you can type a -relative file name and know with certainty what it will mean, and it -allows you to edit the default to specify a different directory. To -inhibit the insertion of the default directory, set the variable -@code{insert-default-directory} to @code{nil}. - - Note that it is legitimate to type an absolute file name after you -enter the minibuffer, ignoring the presence of the default directory -name. The final minibuffer contents may look invalid, but that is not -so. @xref{Minibuffer File}. - - @samp{$} in a file name is used to substitute environment variables. For -example, if you have used the shell command @samp{setenv FOO rms/hacks} to -set up an environment variable named @samp{FOO}, then you can use -@file{/u/$FOO/test.c} or @file{/u/$@{FOO@}/test.c} as an abbreviation for -@file{/u/rms/hacks/test.c}. The environment variable name consists of all -the alphanumeric characters after the @samp{$}; alternatively, it may be -enclosed in braces after the @samp{$}. Note that the @samp{setenv} command -affects Emacs only if done before Emacs is started. - - To access a file with @samp{$} in its name, type @samp{$$}. This pair -is converted to a single @samp{$} at the same time variable substitution -is performed for single @samp{$}. The Lisp function that performs the -substitution is called @code{substitute-in-file-name}. The substitution -is performed only on filenames read as such using the minibuffer. - -@node Visiting, Saving, File Names, Files -@section Visiting Files -@cindex visiting files - -@c WideCommands -@table @kbd -@item C-x C-f -Visit a file (@code{find-file}). -@item C-x C-v -Visit a different file instead of the one visited last -(@code{find-alternate-file}). -@item C-x 4 C-f -Visit a file, in another window (@code{find-file-other-window}). Don't -change this window. -@item C-x 5 C-f -Visit a file, in another frame (@code{find-file-other-frame}). Don't -change this window or frame. -@end table - -@cindex files -@cindex visiting -@cindex saving - @dfn{Visiting} a file means copying its contents into an Emacs buffer -so you can edit it. Emacs creates a new buffer for each file you -visit. We say that the buffer is visiting the file that it was created -to hold. Emacs constructs the buffer name from the file name by -throwing away the directory and keeping just the file name. For example, -a file named @file{/usr/rms/emacs.tex} is displayed in a buffer named -@samp{emacs.tex}. If a buffer with that name exists, a unique -name is constructed by appending @samp{<2>}, @samp{<3>},and so on, using -the lowest number that makes a name that is not already in use. - - Each window's mode line shows the name of the buffer that is being displayed -in that window, so you can always tell what buffer you are editing. - - The changes you make with Emacs are made in the Emacs buffer. They do -not take effect in the file that you visit, or any other permanent -place, until you @dfn{save} the buffer. Saving the buffer means that -Emacs writes the current contents of the buffer into its visited file. -@xref{Saving}. - -@cindex modified (buffer) - If a buffer contains changes that have not been saved, the buffer is said -to be @dfn{modified}. This is important because it implies that some -changes will be lost if the buffer is not saved. The mode line displays -two stars near the left margin if the buffer is modified. - -@kindex C-x 5 C-f -@findex find-file -@findex find-file-other-frame - To visit a file, use the command @kbd{C-x C-f} (@code{find-file}). Follow -the command with the name of the file you wish to visit, terminated by a -@key{RET}. If you are using XEmacs under X, you can also use the -@b{Open...} command from the @b{File} menu bar item. - - The file name is read using the minibuffer (@pxref{Minibuffer}), with -defaulting and completion in the standard manner (@pxref{File Names}). -While in the minibuffer, you can abort @kbd{C-x C-f} by typing @kbd{C-g}. - - @kbd{C-x C-f} has completed successfully when text appears on the -screen and a new buffer name appears in the mode line. If the specified -file does not exist and could not be created or cannot be read, an error -results. The error message is printed in the echo area, and includes -the name of the file that Emacs was trying to visit. - - If you visit a file that is already in Emacs, @kbd{C-x C-f} does not make -another copy. It selects the existing buffer containing that file. -However, before doing so, it checks that the file itself has not changed -since you visited or saved it last. If the file has changed, Emacs -prints a warning message. @xref{Interlocking,,Simultaneous Editing}. - -@findex find-this-file -You can switch to a specific file called out in the current buffer by -calling the function @code{find-this-file}. By providing a prefix -argument, this function calls @code{filename-at-point} and switches to a -buffer visiting the file @var{filename}. It creates one if none already -exists. You can use this function to edit the file mentioned in the -buffer you are working in or to test if the file exists. You can do that -by using the minibuffer completion after snatching the all or part of -the filename. - -@vindex find-file-use-truenames -@vindex buffer-file-name -If the variable @code{find-file-use-truenames}'s value is -non-@code{nil}, a buffer's visited filename will always be traced back -to the real file. The filename will never be a symbolic link, and there -will never be a symbolic link anywhere in its directory path. In other -words, the @code{buffer-file-name} and @code{buffer-file-truename} will -be equal. - -@vindex find-file-compare-truenames -@vindex buffer-file-truename -If the variable @code{find-file-compare-truenames} value is -non-@code{nil}, the @code{find-file} command will check the -@code{buffer-file-truename} of all visited files when deciding whether a -given file is already in a buffer, instead of just -@code{buffer-file-name}. If you attempt to visit another file which is -a hard-link or symbolic-link to a file that is already in a buffer, the -existing buffer will be found instead of a newly created one. - -@cindex creating files - If you want to create a file, just visit it. Emacs prints -@samp{(New File)} in the echo area, but in other respects behaves as if you -had visited an existing empty file. If you make any changes and save them, -the file is created. - -@kindex C-x C-v -@findex find-alternate-file - If you visit a nonexistent file unintentionally (because you typed the -wrong file name), use the @kbd{C-x C-v} (@code{find-alternate-file}) -command to visit the file you wanted. @kbd{C-x C-v} is similar to @kbd{C-x -C-f}, but it kills the current buffer (after first offering to save it if -it is modified). @kbd{C-x C-v} is allowed even if the current buffer -is not visiting a file. - -@vindex find-file-run-dired - If the file you specify is actually a directory, Dired is called on -that directory (@pxref{Dired}). To inhibit this, set the variable -@code{find-file-run-dired} to @code{nil}; then it is an error to try to -visit a directory. - -@kindex C-x 4 f -@findex find-file-other-window - @kbd{C-x 4 f} (@code{find-file-other-window}) is like @kbd{C-x C-f} -except that the buffer containing the specified file is selected in another -window. The window that was selected before @kbd{C-x 4 f} continues to -show the same buffer it was already showing. If you use this command when -only one window is being displayed, that window is split in two, with one -window showing the same buffer as before, and the other one showing the -newly requested file. @xref{Windows}. - -@kindex C-x 5 C-f -@findex find-file-other-frame -@kbd{C-x 5 C-f} (@code{find-file-other-frame}) is like @kbd{C-x C-f} -except that it creates a new frame in which the file is displayed. - -@findex find-this-file-other-window - Use the function @code{find-this-file-other-window} to edit a file -mentioned in the buffer you are editing or to test if that file exists. -To do this, use the minibuffer completion after snatching the part or -all of the filename. By providing a prefix argument, the function calls -@code{filename-at-point} and switches you to a buffer visiting the file -@var{filename} in another window. The function creates a buffer if none -already exists. This function is similar to @code{find-file-other-window}. - -@vindex find-file-hooks -@vindex find-file-not-found-hooks - There are two hook variables that allow extensions to modify the -operation of visiting files. Visiting a file that does not exist runs the -functions in the list @code{find-file-not-found-hooks}; the value of this -variable is expected to be a list of functions which are -called one by one until one of them returns non-@code{nil}. Any visiting -of a file, whether extant or not, expects @code{find-file-hooks} to -contain list of functions and calls them all, one by one. In both cases -the functions receive no arguments. Visiting a nonexistent file -runs the @code{find-file-not-found-hooks} first. - -@node Saving, Reverting, Visiting, Files -@section Saving Files - - @dfn{Saving} a buffer in Emacs means writing its contents back into the file -that was visited in the buffer. - -@table @kbd -@item C-x C-s -Save the current buffer in its visited file (@code{save-buffer}). -@item C-x s -Save any or all buffers in their visited files (@code{save-some-buffers}). -@item M-~ -Forget that the current buffer has been changed (@code{not-modified}). -@item C-x C-w -Save the current buffer in a specified file, and record that file as -the one visited in the buffer (@code{write-file}). -@item M-x set-visited-file-name -Change file the name under which the current buffer will be saved. -@end table - -@kindex C-x C-s -@findex save-buffer - To save a file and make your changes permanent, type -@kbd{C-x C-s} (@code{save-buffer}). After saving is finished, @kbd{C-x C-s} -prints a message such as: - -@example -Wrote /u/rms/gnu/gnu.tasks -@end example - -@noindent -If the selected buffer is not modified (no changes have been made in it -since the buffer was created or last saved), Emacs does not save it -because it would have no effect. Instead, @kbd{C-x C-s} prints a message -in the echo area saying: - -@example -(No changes need to be saved) -@end example - -@kindex C-x s -@findex save-some-buffers - The command @kbd{C-x s} (@code{save-some-buffers}) can save any or all -modified buffers. First it asks, for each modified buffer, whether to -save it. The questions should be answered with @kbd{y} or @kbd{n}. -@kbd{C-x C-c}, the key that kills Emacs, invokes -@code{save-some-buffers} and therefore asks the same questions. - -@kindex M-~ -@findex not-modified - If you have changed a buffer and do not want the changes to be saved, -you should take some action to prevent it. Otherwise, you are liable to -save it by mistake each time you use @code{save-some-buffers} or a -related command. One thing you can do is type @kbd{M-~} -(@code{not-modified}), which removes the indication that the buffer -is modified. If you do this, none of the save commands will believe -that the buffer needs to be saved. (@samp{~} is often used as a -mathematical symbol for `not'; thus @kbd{Meta-~} is `not', metafied.) -You could also use @code{set-visited-file-name} (see below) to mark the -buffer as visiting a different file name, not in use for -anything important. - -You can also undo all the changes made since the file was visited or -saved, by reading the text from the file again. This is called -@dfn{reverting}. @xref{Reverting}. Alternatively, you can undo all the -changes by repeating the undo command @kbd{C-x u}; but this only works -if you have not made more changes than the undo mechanism can remember. - -@findex set-visited-file-name - @kbd{M-x set-visited-file-name} alters the name of the file that the -current buffer is visiting. It prompts you for the new file name in the -minibuffer. You can also use @code{set-visited-file-name} on a buffer -that is not visiting a file. The buffer's name is changed to correspond -to the file it is now visiting unless the new name is already used by a -different buffer; in that case, the buffer name is not changed. -@code{set-visited-file-name} does not save the buffer in the newly -visited file; it just alters the records inside Emacs so that it will -save the buffer in that file. It also marks the buffer as ``modified'' -so that @kbd{C-x C-s} @i{will} save. - -@kindex C-x C-w -@findex write-file - If you wish to mark a buffer as visiting a different file and save it -right away, use @kbd{C-x C-w} (@code{write-file}). It is precisely -equivalent to @code{set-visited-file-name} followed by @kbd{C-x C-s}. -@kbd{C-x C-s} used on a buffer that is not visiting a file has the -same effect as @kbd{C-x C-w}; that is, it reads a file name, marks the -buffer as visiting that file, and saves it there. The default file name in -a buffer that is not visiting a file is made by combining the buffer name -with the buffer's default directory. - - If Emacs is about to save a file and sees that the date of the latest -version on disk does not match what Emacs last read or wrote, Emacs -notifies you of this fact, because it probably indicates a problem caused -by simultaneous editing and requires your immediate attention. -@xref{Interlocking,, Simultaneous Editing}. - -@vindex require-final-newline - If the variable @code{require-final-newline} is non-@code{nil}, Emacs -puts a newline at the end of any file that doesn't already end in one, -every time a file is saved or written. - -@vindex write-file-hooks -@vindex after-save-hook - Use the hook variable @code{write-file-hooks} to implement other ways -to write files, and specify things to be done before files are written. The -value of this variable should be a list of Lisp functions. When a file -is to be written, the functions in the list are called, one by one, with -no arguments. If one of them returns a non-@code{nil} value, Emacs -takes this to mean that the file has been written in some suitable -fashion; the rest of the functions are not called, and normal writing is -not done. Use the hook variable @code{after-save-hook} to list -all the functions to be called after writing out a buffer to a file. - -@menu -* Backup:: How Emacs saves the old version of your file. -* Interlocking:: How Emacs protects against simultaneous editing - of one file by two users. -@end menu - -@node Backup, Interlocking, Saving, Saving -@subsection Backup Files -@cindex backup file -@vindex make-backup-files - - Because Unix does not provide version numbers in file names, rewriting a -file in Unix automatically destroys all record of what the file used to -contain. Thus, saving a file from Emacs throws away the old contents of -the file---or it would, except that Emacs carefully copies the old contents -to another file, called the @dfn{backup} file, before actually saving. -(Make sure that the variable @code{make-backup-files} is non-@code{nil}. -Backup files are not written if this variable is @code{nil}). - - At your option, Emacs can keep either a single backup file or a series of -numbered backup files for each file you edit. - - Emacs makes a backup for a file only the first time a file is saved -from one buffer. No matter how many times you save a file, its backup file -continues to contain the contents from before the file was visited. -Normally this means that the backup file contains the contents from before -the current editing session; however, if you kill the buffer and then visit -the file again, a new backup file is made by the next save. - -@menu -* Names: Backup Names. How backup files are named; - Choosing single or numbered backup files. -* Deletion: Backup Deletion. Emacs deletes excess numbered backups. -* Copying: Backup Copying. Backups can be made by copying or renaming. -@end menu - -@node Backup Names, Backup Deletion, Backup, Backup -@subsubsection Single or Numbered Backups - - If you choose to have a single backup file (the default), -the backup file's name is constructed by appending @samp{~} to the -file name being edited; thus, the backup file for @file{eval.c} is -@file{eval.c~}. - - If you choose to have a series of numbered backup files, backup file -names are made by appending @samp{.~}, the number, and another @samp{~} to -the original file name. Thus, the backup files of @file{eval.c} would be -called @file{eval.c.~1~}, @file{eval.c.~2~}, and so on, through names -like @file{eval.c.~259~} and beyond. - - If protection stops you from writing backup files under the usual names, -the backup file is written as @file{%backup%~} in your home directory. -Only one such file can exist, so only the most recently made backup is -available. - -@vindex version-control - The choice of single backup or numbered backups is controlled by the -variable @code{version-control}. Its possible values are: - -@table @code -@item t -Make numbered backups. -@item nil -Make numbered backups for files that have numbered backups already. -Otherwise, make single backups. -@item never -Never make numbered backups; always make single backups. -@end table - -@noindent -@code{version-control} may be set locally in an individual buffer to -control the making of backups for that buffer's file. For example, -Rmail mode locally sets @code{version-control} to @code{never} to make sure -that there is only one backup for an Rmail file. @xref{Locals}. - -@node Backup Deletion, Backup Copying, Backup Names, Backup -@subsubsection Automatic Deletion of Backups - -@vindex kept-old-versions -@vindex kept-new-versions - To prevent unlimited consumption of disk space, Emacs can delete numbered -backup versions automatically. Generally Emacs keeps the first few backups -and the latest few backups, deleting any in between. This happens every -time a new backup is made. The two variables that control the deletion are -@code{kept-old-versions} and @code{kept-new-versions}. Their values are, respectively -the number of oldest (lowest-numbered) backups to keep and the number of -newest (highest-numbered) ones to keep, each time a new backup is made. -The values are used just after a new backup version is made; -that newly made backup is included in the count in @code{kept-new-versions}. -By default, both variables are 2. - -@vindex trim-versions-without-asking - If @code{trim-versions-without-asking} is non-@code{nil}, excess -middle versions are deleted without notification. If it is @code{nil}, the -default, you are asked whether the excess middle versions should -really be deleted. - - You can also use Dired's @kbd{.} (Period) command to delete old versions. -@xref{Dired}. - -@node Backup Copying, , Backup Deletion, Backup -@subsubsection Copying vs.@: Renaming - - You can make backup files by copying the old file or by renaming it. -This makes a difference when the old file has multiple names. If you -rename the old file into the backup file, the alternate names -become names for the backup file. If you copy the old file instead, -the alternate names remain names for the file that you are editing, -and the contents accessed by those names will be the new contents. - - How you make a backup file may also affect the file's owner -and group. If you use copying, they do not change. If renaming is used, -you become the file's owner, and the file's group becomes the default -(different operating systems have different defaults for the group). - - Having the owner change is usually a good idea, because then the owner -is always the person who last edited the file. Occasionally there is a -file whose owner should not change. Since most files should change -owners, it is a good idea to use local variable lists to set -@code{backup-by-copying-when-mismatch} for the special cases where the -owner should not change (@pxref{File Variables}). - -@vindex backup-by-copying -@vindex backup-by-copying-when-linked -@vindex backup-by-copying-when-mismatch - Three variables control the choice of renaming or copying. -Normally, renaming is done. If the variable @code{backup-by-copying} is -non-@code{nil}, copying is used. Otherwise, if the variable -@code{backup-by-copying-when-linked} is non-@code{nil}, copying is -done for files that have multiple names, but renaming may still be done when -the file being edited has only one name. If the variable -@code{backup-by-copying-when-mismatch} is non-@code{nil}, copying is -done if renaming would cause the file's owner or group to change. @refill - -@node Interlocking, , Backup, Saving -@subsection Protection Against Simultaneous Editing - -@cindex file dates -@cindex simultaneous editing - Simultaneous editing occurs when two users visit the same file, both -make changes, and both save their changes. If no one was informed that -this was happening, and you saved first, you would later find that your -changes were lost. On some systems, Emacs notices immediately when the -second user starts to change a file already being edited, and issues a -warning. When this is not possible, or if the second user has started -to change the file despite the warning, Emacs checks when the file is -saved, and issues a second warning when a user is about to overwrite a -file containing another user's changes. If you are the user editing the -file, you can take corrective action at this point and prevent actual -loss of work. - -@findex ask-user-about-lock - When you make the first modification in an Emacs buffer that is visiting -a file, Emacs records that you have locked the file. (It does this by -writing another file in a directory reserved for this purpose.) The lock -is removed when you save the changes. The idea is that the file is locked -whenever the buffer is modified. If you begin to modify the buffer while -the visited file is locked by someone else, this constitutes a collision, -and Emacs asks you what to do. It does this by calling the Lisp function -@code{ask-user-about-lock}, which you can redefine to customize what it -does. The standard definition of this function asks you a -question and accepts three possible answers: - -@table @kbd -@item s -Steal the lock. Whoever was already changing the file loses the lock, -and you get the lock. -@item p -Proceed. Go ahead and edit the file despite its being locked by someone else. -@item q -Quit. This causes an error (@code{file-locked}) and the modification you -were trying to make in the buffer does not actually take place. -@end table - - Note that locking works on the basis of a file name; if a file has -multiple names, Emacs does not realize that the two names are the same file -and cannot prevent two users from editing it simultaneously under different -names. However, basing locking on names means that Emacs can interlock the -editing of new files that do not really exist until they are saved. - - Some systems are not configured to allow Emacs to make locks. On -these systems, Emacs cannot detect trouble in advance, but it can still -detect it in time to prevent you from overwriting someone else's changes. - - Every time Emacs saves a buffer, it first checks the last-modification -date of the existing file on disk to see that it has not changed since the -file was last visited or saved. If the date does not match, it implies -that changes were made in the file in some other way, and these changes are -about to be lost if Emacs actually does save. To prevent this, Emacs -prints a warning message and asks for confirmation before saving. -Occasionally you will know why the file was changed and know that it does -not matter; then you can answer @kbd{yes} and proceed. Otherwise, you should -cancel the save with @kbd{C-g} and investigate the situation. - - The first thing you should do when notified that simultaneous editing -has already taken place is to list the directory with @kbd{C-u C-x C-d} -(@pxref{ListDir,,Directory Listing}). This will show the file's current -author. You should attempt to contact that person and ask him not to -continue editing. Often the next step is to save the contents of your -Emacs buffer under a different name, and use @code{diff} to compare the -two files.@refill - - Simultaneous editing checks are also made when you visit a file that -is already visited with @kbd{C-x C-f} and when you start to modify a -file. This is not strictly necessary, but it is useful to find out -about such a problem as early as possible, when corrective action takes -less work. - -@findex set-default-file-modes -@cindex file protection -Another way to protect your file is to set the read, write, and -executable permissions for the file. Use the function -@code{set-default-file-modes} to set the UNIX @code{umask} value to the -@var{nmask} argument. The @code{umask} value is the default protection -mode for new files. - -@node Reverting, Auto Save, Saving, Files -@section Reverting a Buffer -@findex revert-buffer -@cindex drastic changes - - If you have made extensive changes to a file and then change your mind -about them, you can get rid of all changes by reading in the previous -version of the file. To do this, use @kbd{M-x revert-buffer}, which -operates on the current buffer. Since reverting a buffer can result in -very extensive changes, you must confirm it with @kbd{yes}. - - If the current buffer has been auto-saved more recently than it has been -saved explicitly, @code{revert-buffer} offers to read the auto save file -instead of the visited file (@pxref{Auto Save}). Emacs asks you about -the auto-save file before the request for confirmation of the -@kbd{revert-buffer} operation, and demands @kbd{y} or @kbd{n} -as an answer. If you have started to type @kbd{yes} for confirmation -without realizing that the auto-save question was going to be asked, the -@kbd{y} will answer that question, but the @kbd{es} will not be valid -confirmation. This gives you a chance to cancel the operation with -@kbd{C-g} and try again with the answers you really intend. - - @code{revert-buffer} keeps point at the same distance (measured in -characters) from the beginning of the file. If the file was edited only -slightly, you will be at approximately the same piece of text after -reverting as before. If you have made more extensive changes, the value of -point in the old file may bring you to a totally different piece of text -than your last editing point. - -A buffer reverted from its visited file is marked ``not modified'' until -you make a change. - - Some kinds of buffers whose contents reflect data bases other than files, -such as Dired buffers, can also be reverted. For them, reverting means -recalculating their contents from the appropriate data. Buffers -created randomly with @kbd{C-x b} cannot be reverted; @code{revert-buffer} -reports an error when asked to do so. - -@node Auto Save, Version Control, Reverting, Files -@section Auto-Saving: Protection Against Disasters -@cindex Auto-Save mode -@cindex crashes - - Emacs saves all the visited files from time to time (based on counting -your keystrokes) without being asked. This is called @dfn{auto-saving}. -It prevents you from losing more than a limited amount of work if the -system crashes. - - When Emacs determines it is time for auto-saving, each buffer is -considered and is auto-saved if auto-saving is turned on for it and it has -changed since the last time it was auto-saved. If any auto-saving is -done, the message @samp{Auto-saving...} is displayed in the echo area until -auto-saving is finished. Errors occurring during auto-saving are caught -so that they do not interfere with the execution of commands you have been -typing. - -@menu -* Files: Auto Save Files. -* Control: Auto Save Control. -* Recover:: Recovering text from auto-save files. -@end menu - -@node Auto Save Files, Auto Save Control, Auto Save, Auto Save -@subsection Auto-Save Files - - Auto-saving does not normally write to the files you visited, because -it can be undesirable to save a program that is in an inconsistent -state when you have made only half of a planned change. Instead, auto-saving -is done in a different file called the @dfn{auto-save file}, and the -visited file is changed only when you save explicitly, for example, -with @kbd{C-x C-s}. - - Normally, the name of the auto-save file is generated by appending -@samp{#} to the front and back of the visited file name. Thus, a buffer -visiting file @file{foo.c} would be auto-saved in a file @file{#foo.c#}. -Most buffers that are not visiting files are auto-saved only if you -request it explicitly; when they are auto-saved, the auto-save file name -is generated by appending @samp{#%} to the front and @samp{#} to the -back of buffer name. For example, the @samp{*mail*} buffer in which you -compose messages to be sent is auto-saved in a file named -@file{#%*mail*#}. Names of auto-save files are generated this way -unless you customize the functions @code{make-auto-save-file-name} and -@code{auto-save-file-name-p} to do something different. The file name -to be used for auto-saving a buffer is calculated at the time auto-saving is -turned on in that buffer. - -@vindex auto-save-visited-file-name - If you want auto-saving to be done in the visited file, set the variable -@code{auto-save-visited-file-name} to be non-@code{nil}. In this mode, -there is really no difference between auto-saving and explicit saving. - -@vindex delete-auto-save-files - Emacs deletes a buffer's auto-save file when you explicitly save the -buffer. To inhibit the deletion, set the variable -@code{delete-auto-save-files} to @code{nil}. Changing the visited file -name with @kbd{C-x C-w} or @code{set-visited-file-name} renames any -auto-save file to correspond to the new visited name. - -@node Auto Save Control, Recover, Auto Save Files, Auto Save -@subsection Controlling Auto-Saving - -@vindex auto-save-default -@findex auto-save-mode - Each time you visit a file, auto-saving is turned on for that file's -buffer if the variable @code{auto-save-default} is non-@code{nil} (but -not in batch mode; @pxref{Entering Emacs}). The default for this -variable is @code{t}, so Emacs auto-saves buffers that visit files by -default. You can use the command @kbd{M-x auto-save-mode} to turn -auto-saving for a buffer on or off. Like other minor mode commands, -@kbd{M-x auto-save-mode} turns auto-saving on with a positive argument, -off with a zero or negative argument; with no argument, it toggles. - -@vindex auto-save-interval -@findex do-auto-save - Emacs performs auto-saving periodically based on counting how many -characters you have typed since the last time auto-saving happened. The -variable @code{auto-save-interval} specifies the number of characters -between auto-saves. By default, it is 300. Emacs also auto-saves -whenever you call the function @code{do-auto-save}. - - Emacs also does auto-saving whenever it gets a fatal error. This -includes killing the Emacs job with a shell command such as @code{kill --emacs}, or disconnecting a phone line or network connection. - -@vindex auto-save-timeout -You can set the number of seconds of idle time before an auto-save is -done. Setting the value of the variable @code{auto-save-timeout} to zero or -@code{nil} will disable auto-saving due to idleness. - -The actual amount of idle time between auto-saves is logarithmically -related to the size of the current buffer. This variable is the number -of seconds after which an auto-save will happen when the current buffer -is 50k or less; the timeout will be 2 1/4 times this in a 200k buffer, 3 -3/4 times this in a 1000k buffer, and 4 1/2 times this in a 2000k -buffer. - -For this variable to have any effect, you must do @code{(require 'timer)}. - -@node Recover, , Auto Save Control, Auto Save -@subsection Recovering Data from Auto-Saves - -@findex recover-file - If you want to use the contents of an auto-save file to recover from a -loss of data, use the command @kbd{M-x recover-file @key{RET} @var{file} -@key{RET}}. Emacs visits @var{file} and then (after your confirmation) -restores the contents from the auto-save file @file{#@var{file}#}. You -can then save the file with @kbd{C-x C-s} to put the recovered text into -@var{file} itself. For example, to recover file @file{foo.c} from its -auto-save file @file{#foo.c#}, do:@refill - -@example -M-x recover-file @key{RET} foo.c @key{RET} -C-x C-s -@end example - - Before asking for confirmation, @kbd{M-x recover-file} displays a -directory listing describing the specified file and the auto-save file, -so you can compare their sizes and dates. If the auto-save file -is older, @kbd{M-x recover-file} does not offer to read it. - - Auto-saving is disabled by @kbd{M-x recover-file} because using -this command implies that the auto-save file contains valuable data -from a past session. If you save the data in the visited file and -then go on to make new changes, turn auto-saving back on -with @kbd{M-x auto-save-mode}. - -@node Version Control, ListDir, Auto Save, Files -@section Version Control -@cindex version control - - @dfn{Version control systems} are packages that can record multiple -versions of a source file, usually storing the unchanged parts of the -file just once. Version control systems also record history information -such as the creation time of each version, who created it, and a -description of what was changed in that version. - - The GNU project recommends the version control system known as RCS, -which is free software and available from the Free Software Foundation. -Emacs supports use of either RCS or SCCS (a proprietary, but widely -used, version control system that is not quite as powerful as RCS) -through a facility called VC. The same Emacs commands work with either -RCS or SCCS, so you hardly have to know which one of them you are -using. - -@menu -* Concepts of VC:: Basic version control information; - checking files in and out. -* Editing with VC:: Commands for editing a file maintained - with version control. -* Variables for Check-in/out:: Variables that affect the commands used - to check files in or out. -* Log Entries:: Logging your changes. -* Change Logs and VC:: Generating a change log file from log - entries. -* Old Versions:: Examining and comparing old versions. -* VC Status:: Commands to view the VC status of files and - look at log entries. -* Renaming and VC:: A command to rename both the source and - master file correctly. -* Snapshots:: How to make and use snapshots, a set of - file versions that can be treated as a unit. -* Version Headers:: Inserting version control headers into - working files. -@end menu - -@node Concepts of VC, Editing with VC, Version Control, Version Control -@subsection Concepts of Version Control - -@cindex RCS -@cindex SCCS -@cindex master file -@cindex registered file -@cindex work file - When a file is under version control, we also say that it is -@dfn{registered} in the version control system. Each registered file -has a corresponding @dfn{master file} which represents the file's -present state plus its change history, so that you can reconstruct from -it either the current version or any specified earlier version. Usually -the master file also records a @dfn{log entry} for each version describing -what was changed in that version. - - The file that is maintained under version control is sometimes called -the @dfn{work file} corresponding to its master file. - -@cindex checking out files -@cindex checking in files -@cindex locking and version control - To examine a file, you @dfn{check it out}. This extracts a version -of the source file (typically, the most recent) from the master file. -If you want to edit the file, you must check it out @dfn{locked}. Only -one user can do this at a time for any given source file. (This kind -of locking is completely unrelated to the locking that Emacs uses to -detect simultaneous editing of a file.) - - When you are done with your editing, you must @dfn{check in} the new -version. This records the new version in the master file, and unlocks -the source file so that other people can lock it and thus modify it. - - Checkin and checkout are the basic operations of version control. You -can do both of them with a single Emacs command: @w{@kbd{C-x C-q}} -(@code{vc-toggle-read-only}). - - A @dfn{snapshot} is a coherent collection of versions of the various -files that make up a program. @xref{Snapshots}. - -@node Editing with VC, Variables for Check-in/out, Concepts of VC, Version Control -@subsection Editing with Version Control - - When you visit a file that is maintained using version control, the -mode line displays @samp{RCS} or @samp{SCCS} to inform you that version -control is in use, and also (in case you care) which low-level system -the file is actually stored in. Normally, such a source file is -read-only, and the mode line indicates this with @samp{%%}. With RCS, -the mode line also indicates the number of the head version, which is -normally also the version you are looking at. - - These are the commands for editing a file maintained with -version control: - -@table @kbd -@item C-x C-q -Check the visited file in or out. - -@item C-x v u -Revert the buffer and the file to the last checked in version. - -@item C-x v c -Remove the last-entered change from the master for the visited file. -This undoes your last check-in. - -@item C-x v i -Register the visited file in version control. -@end table - -@noindent -(@kbd{C-x v} is the prefix key for version control commands; all of these -commands except for @kbd{C-x C-q} start with @kbd{C-x v}.) - -@kindex C-x C-q @r{(version control)} - When you want to modify a file maintained with version control, type -@kbd{C-x C-q} (@code{vc-toggle-read-only}). This @dfn{checks out} the -file, and tells RCS or SCCS to lock the file. This means making the -file writable for you (but not for anyone else). - -@cindex log entry - When you are finished editing the file, type @kbd{C-x C-q} again. -When used on a file that is checked out, this command checks the file -in. But check-in does not start immediately; first, you must enter the -@dfn{log entry}---a description of the changes in the new version. -@kbd{C-x C-q} pops up a buffer for you to enter this in. When you are -finished typing in the log entry, type @kbd{C-c C-c} to terminate it; this is -when actual check-in takes place. - - Once you have checked in your changes, the file is unlocked, so that -other users can lock it and modify it. - -@vindex vc-make-backup-files - Emacs does not save backup files for source files that are maintained -with version control. If you want to make backup files despite version -control, set the variable @code{vc-make-backup-files} to a -non-@code{nil} value. - -@vindex vc-keep-workfiles - Normally the work file exists all the time, whether it is locked or -not. If you set @code{vc-keep-workfiles} to @code{nil}, then checking -in a new version with @kbd{C-x C-q} deletes the work file; but any -attempt to visit the file with Emacs creates it again. - - It is not impossible to lock a file that someone else has locked. If -you try to check out a file that is locked, @kbd{C-x C-q} asks you -whether you want to ``steal the lock.'' If you say yes, the file -becomes locked by you, but a message is sent to the person who had -formerly locked the file, to inform him of what has happened. The mode -line indicates that a file is locked by someone else by displaying the -login name of that person, before the version number. - -@kindex C-x v u -@findex vc-revert-buffer - If you want to discard your current set of changes and revert to the -last version checked in, use @kbd{C-x v u} (@code{vc-revert-buffer}). -This cancels your last check-out, leaving the file unlocked. If you want -to make a different set of changes, you must first check the file out -again. @kbd{C-x v u} requires confirmation, unless it sees that -you haven't made any changes since the last checked-in version. - - @kbd{C-x v u} is also the command to use if you lock a file and then -don't actually change it. - -@kindex C-x v c -@findex vc-cancel-version - You can cancel a change after checking it in, with @kbd{C-x v c} -(@code{vc-cancel-version}). This command discards all record of the -most recent checked in version, so be careful about using it. It -requires confirmation with @kbd{yes}. By default, @kbd{C-x v c} reverts -your workfile and buffer to the previous version (the one that precedes -the version that is deleted), but you can prevent the reversion by -giving the command a prefix argument. Then the buffer does not change. - - This command with a prefix argument is useful when you have checked in -a change and then discover a trivial error in it; you can cancel the -erroneous check-in, fix the error, and repeat the check-in. - - Be careful when invoking @kbd{C-x v c}, as it is easy to throw away a -lot of work with it. To help you be careful, this command always -requires confirmation with @samp{yes}. - -@kindex C-x v i -@findex vc-register -@vindex vc-default-back-end - You can register the visited file for version control using -@w{@kbd{C-x v i}} (@code{vc-register}). If the variable -@code{vc-default-back-end} is non-@code{nil}, it specifies which -version control system to use; otherwise, this uses RCS if it is -installed on your system and SCCS if not. After @kbd{C-x v i}, -the file is unlocked and read-only. Type @kbd{C-x C-q} if you wish to -edit it. - - By default, the initial version number is 1.1. If you want to use a -different number, give @kbd{C-x v i} a prefix argument; then it reads -the initial version number using the minibuffer. - -@vindex vc-initial-comment - If @code{vc-initial-comment} is non-@code{nil}, @kbd{C-x v i} reads -an initial comment (much like a log entry) to describe the purpose of -this source file. - -@kindex C-u C-x v v -@findex vc-next-action - To specify the version number for a subsequent checkin, use the -command @kbd{C-u C-x v v}. @kbd{C-x v v} (@code{vc-next-action}) is the -command that @kbd{C-x C-q} uses to do the ``real work'' when the visited -file uses version control. When used for checkin, and given a prefix -argument, it reads the version number with the minibuffer. - -@node Variables for Check-in/out, Log Entries, Editing with VC, Version Control -@subsection Variables Affecting Check-in and Check-out -@c There is no need to tell users about vc-master-templates. - -@vindex vc-suppress-confirm - If @code{vc-suppress-confirm} is non-@code{nil}, then @kbd{C-x C-q} -and @kbd{C-x v i} can save the current buffer without asking, and -@kbd{C-x v u} also operates without asking for confirmation. -(This variable does not affect @kbd{C-x v c}; that is so drastic -that it should always ask for confirmation.) - -@vindex vc-command-messages - VC mode does much of its work by running the shell commands for RCS -and SCCS. If @code{vc-command-messages} is non-@code{nil}, VC displays -messages to indicate which shell commands it runs, and additional -messages when the commands finish. - - Normally, VC assumes that it can deduce the locked/unlocked state of -files by looking at the file permissions of the work file; this is -fast. However, if the @file{RCS} or @file{SCCS} subdirectory is -actually a symbolic link, then VC does not trust the file permissions to -reflect this status. - -@vindex vc-mistrust-permissions -You can specify the criterion for whether to trust the file permissions -by setting the variable @code{vc-mistrust-permissions}. Its value may -be @code{t} (always mistrust the file permissions and check the master -file), @code{nil} (always trust the file permissions), or a function of -one argument which makes the decision. The argument is the directory -name of the @file{RCS} or @file{SCCS} subdirectory. A non-@code{nil} -value from the function says to mistrust the file permissions. - - If you find that the file permissions of work files are changed -erroneously, set @code{vc-mistrust-permissions} to @code{t}. Then VC -always checks the master file to determine the file's status. - -@vindex vc-path - You can specify additional directories to search for version control -programs by setting the variable @code{vc-path}. These directories -are searched before the usual search path. The proper result usually -happens automatically. - -@node Log Entries, Change Logs and VC, Variables for Check-in/out, Version Control -@subsection Log Entries - - When you're editing an initial comment or log entry for inclusion in a -master file, finish your entry by typing @kbd{C-c C-c}. - -@table @kbd -@item C-c C-c -Finish the comment edit normally (@code{vc-finish-logentry}). -This finishes check-in. -@end table - - To abort check-in, just don't type @kbd{C-c C-c} in that buffer. You -can switch buffers and do other editing. As long as you don't try to -check in another file, the entry you were editing remains in its -buffer, and you can go back to that buffer at any time to complete the -check-in. - - If you change several source files for the same reason, it is often -convenient to specify the same log entry for many of the files. To do -this, use the history of previous log entries. The commands @kbd{M-n}, -@kbd{M-p}, @kbd{M-s} and @kbd{M-r} for doing this work just like the -minibuffer history commands (except that these versions are used outside -the minibuffer). - -@vindex vc-log-mode-hook - Each time you check in a file, the log entry buffer is put into VC Log -mode, which involves running two hooks: @code{text-mode-hook} and -@code{vc-log-mode-hook}. - -@node Change Logs and VC, Old Versions, Log Entries, Version Control -@subsection Change Logs and VC - - If you use RCS for a program and also maintain a change log file for -it (@pxref{Change Log}), you can generate change log entries -automatically from the version control log entries: - -@table @kbd -@item C-x v a -@kindex C-x v a -@findex vc-update-change-log -Visit the current directory's change log file and create new entries for -versions checked in since the most recent entry in the change log file -(@code{vc-update-change-log}). - -This command works with RCS only; it does not work with SCCS. -@end table - - For example, suppose the first line of @file{ChangeLog} is dated 10 -April 1992, and that the only check-in since then was by Nathaniel -Bowditch to @file{rcs2log} on 8 May 1992 with log text @samp{Ignore log -messages that start with `#'.}. Then @kbd{C-x v a} visits -@file{ChangeLog} and inserts text like this: - -@smallexample -@group -Fri May 8 21:45:00 1992 Nathaniel Bowditch (nat@@apn.org) - - * rcs2log: Ignore log messages that start with `#'. -@end group -@end smallexample - -@noindent -You can then edit the new change log entry further as you wish. - - Normally, the log entry for file @file{foo} is displayed as @samp{* -foo: @var{text of log entry}}. The @samp{:} after @file{foo} is omitted -if the text of the log entry starts with @w{@samp{(@var{functionname}): -}}. For example, if the log entry for @file{vc.el} is -@samp{(vc-do-command): Check call-process status.}, then the text in -@file{ChangeLog} looks like this: - -@smallexample -@group -Wed May 6 10:53:00 1992 Nathaniel Bowditch (nat@@apn.org) - - * vc.el (vc-do-command): Check call-process status. -@end group -@end smallexample - - When @kbd{C-x v a} adds several change log entries at once, it groups -related log entries together if they all are checked in by the same -author at nearly the same time. If the log entries for several such -files all have the same text, it coalesces them into a single entry. -For example, suppose the most recent checkins have the following log -entries: - -@example -@exdent For @file{vc.texinfo}: -Fix expansion typos. -@exdent For @file{vc.el}: -Don't call expand-file-name. -@exdent For @file{vc-hooks.el}: -Don't call expand-file-name. -@end example - - They appear like this in @file{ChangeLog}: - -@smallexample -@group -Wed Apr 1 08:57:59 1992 Nathaniel Bowditch (nat@@apn.org) - - * vc.texinfo: Fix expansion typos. - - * vc.el, vc-hooks.el: Don't call expand-file-name. -@end group -@end smallexample - - Normally, @kbd{C-x v a} separates log entries by a blank line, but you -can mark several related log entries to be clumped together (without an -intervening blank line) by starting the text of each related log entry -with a label of the form @w{@samp{@{@var{clumpname}@} }}. The label -itself is not copied to @file{ChangeLog}. For example, suppose the log -entries are: - -@example -@exdent For @file{vc.texinfo}: -@{expand@} Fix expansion typos. -@exdent For @file{vc.el}: -@{expand@} Don't call expand-file-name. -@exdent For @file{vc-hooks.el}: -@{expand@} Don't call expand-file-name. -@end example - -@noindent -Then the text in @file{ChangeLog} looks like this: - -@smallexample -@group -Wed Apr 1 08:57:59 1992 Nathaniel Bowditch (nat@@apn.org) - - * vc.texinfo: Fix expansion typos. - * vc.el, vc-hooks.el: Don't call expand-file-name. -@end group -@end smallexample - - A log entry whose text begins with @samp{#} is not copied to -@file{ChangeLog}. For example, if you merely fix some misspellings in -comments, you can log the change with an entry beginning with @samp{#} -to avoid putting such trivia into @file{ChangeLog}. - -@node Old Versions, VC Status, Change Logs and VC, Version Control -@subsection Examining And Comparing Old Versions - -@table @kbd -@item C-x v ~ @var{version} @key{RET} -Examine version @var{version} of the visited file, in a buffer of its -own (@code{vc-version-other-window}). - -@item C-x v = -Compare the current buffer contents with the latest checked-in version -of the file. - -@item C-u C-x v = @var{file} @key{RET} @var{oldvers} @key{RET} @var{newvers} @key{RET} -Compare the specified two versions of @var{file}. -@end table - -@findex vc-version-other-window -@kindex C-x v ~ - You can examine any version of a file by first visiting it, and then -using @kbd{C-x v ~ @var{version} @key{RET}} -(@code{vc-version-other-window}). This puts the text of version -@var{version} in a file named @file{@var{filename}.~@var{version}~}, -then visits it in a separate window. - -@findex vc-diff -@kindex C-x v = - To compare two versions of a file, use the command @kbd{C-x v =} -(@code{vc-diff}). - - Plain @kbd{C-x v =} compares the current buffer contents (saving them -in the file if necessary) with the last checked-in version of the file. -With a prefix argument, @kbd{C-x v =} reads a file name and two version -numbers, then compares those versions of the specified file. - - If you supply a directory name instead of the name of a work file, -this command compares the two specified versions of all registered files -in that directory and its subdirectories. You can also specify a -snapshot name (@pxref{Snapshots}) instead of one or both version -numbers. - - You can specify a checked-in version by its number; you can specify -the most recent checked-in version with an empty version number. - - This command works by running the @code{vcdiff} utility, getting the -options from the variable @code{diff-switches}. It displays the output -in a special buffer in another window. Unlike the @kbd{M-x diff} -command, @kbd{C-x v =} does not try to find the changes in the old and -new versions. This is because one or both versions normally do not -exist as files. They exist only in the records of the master file. -@xref{Comparing Files}, for more information about @kbd{M-x diff}. - -@node VC Status, Renaming and VC, Old Versions, Version Control -@subsection VC Status Commands - -@kindex C-x v l -@findex vc-print-log - To view the detailed version control status and history of a file, -type @kbd{C-x v l} (@code{vc-print-log}). It displays the history of -changes to the current file, including the text of the log entries. The -output appears in a separate window. - -@kindex C-x v d -@findex vc-directory - When you are working on a large program, it's often useful to find all -the files that are currently locked, or all the files maintained in -version control at all. You can use @kbd{C-x v d} (@code{vc-directory}) -to show all the locked files in or beneath the current directory. This -includes all files that are locked by any user. @kbd{C-u C-x v d} lists -all files in or beneath the current directory that are maintained with -version control. - - The list of files is displayed as a buffer that uses an augmented -Dired mode. The names of the users locking various files are shown (in -parentheses) in place of the owner and group. All the normal Dired -commands work in this buffer. Most interactive VC commands work also, -and apply to the file name on the current line. - - The @kbd{C-x v v} command (@code{vc-next-action}), when used in the -augmented Dired buffer, operates on all the marked files (or the file on -the current line). If it operates on more than one file, it handles -each file according to its current state; thus, it may check out one -file and check in another (because it is already checked out). If it -has to check in any files, it reads a single log entry, then uses that -text for all the files being checked in. This can be convenient for -registering or checking in several files at once, as part of the same -change. - -@node Renaming and VC, Snapshots, VC Status, Version Control -@subsection Renaming VC Work Files and Master Files - -@findex vc-rename-file - When you rename a registered file, you must also rename its master -file correspondingly to get proper results. Use @code{vc-rename-file} -to rename the source file as you specify, and rename its master file -accordingly. It also updates any snapshots (@pxref{Snapshots}) that -mention the file, so that they use the new name; despite this, the -snapshot thus modified may not completely work (@pxref{Snapshot -Caveats}). - - You cannot use @code{vc-rename-file} on a file that is locked by -someone else. - -@node Snapshots, Version Headers, Renaming and VC, Version Control -@subsection Snapshots -@cindex snapshots and version control - - A @dfn{snapshot} is a named set of file versions (one for each -registered file) that you can treat as a unit. One important kind of -snapshot is a @dfn{release}, a (theoretically) stable version of the -system that is ready for distribution to users. - -@menu -* Making Snapshots:: The snapshot facilities. -* Snapshot Caveats:: Things to be careful of when using snapshots. -@end menu - -@node Making Snapshots, Snapshot Caveats, Snapshots, Snapshots -@subsubsection Making and Using Snapshots - - There are two basic commands for snapshots; one makes a -snapshot with a given name, the other retrieves a named snapshot. - -@table @code -@kindex C-x v s -@findex vc-create-snapshot -@item C-x v s @var{name} @key{RET} -Define the last saved versions of every registered file in or under the -current directory as a snapshot named @var{name} -(@code{vc-create-snapshot}). - -@kindex C-x v r -@findex vc-retrieve-snapshot -@item C-x v r @var{name} @key{RET} -Check out all registered files at or below the current directory level -using whatever versions correspond to the snapshot @var{name} -(@code{vc-retrieve-snapshot}). - -This command reports an error if any files are locked at or below the -current directory, without changing anything; this is to avoid -overwriting work in progress. -@end table - - A snapshot uses a very small amount of resources---just enough to record -the list of file names and which version belongs to the snapshot. Thus, -you need not hesitate to create snapshots whenever they are useful. - - You can give a snapshot name as an argument to @kbd{C-x v =} or -@kbd{C-x v ~} (@pxref{Old Versions}). Thus, you can use it to compare a -snapshot against the current files, or two snapshots against each other, -or a snapshot against a named version. - -@node Snapshot Caveats, , Making Snapshots, Snapshots -@subsubsection Snapshot Caveats - -@cindex named configurations (RCS) - VC's snapshot facilities are modeled on RCS's named-configuration -support. They use RCS's native facilities for this, so under VC -snapshots made using RCS are visible even when you bypass VC. - -@c worded verbosely to avoid overfull hbox. - For SCCS, VC implements snapshots itself. The files it uses contain -name/file/version-number triples. These snapshots are visible only -through VC. - - A snapshot is a set of checked-in versions. So make sure that all the -files are checked in and not locked when you make a snapshot. - - File renaming and deletion can create some difficulties with snapshots. -This is not a VC-specific problem, but a general design issue in version -control systems that no one has solved very well yet. - - If you rename a registered file, you need to rename its master along -with it (the command @code{vc-rename-file} does this automatically). If -you are using SCCS, you must also update the records of the snapshot, to -mention the file by its new name (@code{vc-rename-file} does this, -too). An old snapshot that refers to a master file that no longer -exists under the recorded name is invalid; VC can no longer retrieve -it. It would be beyond the scope of this manual to explain enough about -RCS and SCCS to explain how to update the snapshots by hand. - - Using @code{vc-rename-file} makes the snapshot remain valid for -retrieval, but it does not solve all problems. For example, some of the -files in the program probably refer to others by name. At the very -least, the makefile probably mentions the file that you renamed. If you -retrieve an old snapshot, the renamed file is retrieved under its new -name, which is not the name that the makefile expects. So the program -won't really work as retrieved. - -@node Version Headers, , Snapshots, Version Control -@subsection Inserting Version Control Headers - - Sometimes it is convenient to put version identification strings -directly into working files. Certain special strings called -@dfn{version headers} are replaced in each successive version by the -number of that version. - -@kindex C-x v h -@findex vc-insert-headers - You can use the @kbd{C-x v h} command (@code{vc-insert-headers}) to -insert a suitable header string. - -@table @kbd -@item C-x v h -Insert headers in a file for use with your version-control system. -@end table - -@vindex vc-header-alist - The default header string is @samp{\$Id\$} for RCS and @samp{\%W\%} -for SCCS. (The actual strings inserted do not have the backslashes -in them. They were placed in the Info source file so that the -strings don't get interpreted as version-control headers when the -Info source files are maintained under version control.) You can -specify other headers to insert by setting the variable -@code{vc-header-alist}. Its value is a list of elements of the form -@code{(@var{program} . @var{string})} where @var{program} is @code{RCS} -or @code{SCCS} and @var{string} is the string to use. - - Instead of a single string, you can specify a list of strings; then -each string in the list is inserted as a separate header on a line of -its own. - - It is often necessary to use ``superfluous'' backslashes when writing -the strings that you put in this variable. This is to prevent the -string in the constant from being interpreted as a header itself if the -Emacs Lisp file containing it is maintained with version control. - -@vindex vc-comment-alist - Each header is inserted surrounded by tabs, inside comment delimiters, -on a new line at the start of the buffer. Normally the ordinary comment -start and comment end strings of the current mode are used, but for -certain modes, there are special comment delimiters for this purpose; -the variable @code{vc-comment-alist} specifies them. Each element of -this list has the form @code{(@var{mode} @var{starter} @var{ender})}. - -@vindex vc-static-header-alist - The variable @code{vc-static-header-alist} specifies further strings -to add based on the name of the buffer. Its value should be a list of -elements of the form @code{(@var{regexp} . @var{format})}. Whenever -@var{regexp} matches the buffer name, @var{format} is inserted as part -of the header. A header line is inserted for each element that matches -the buffer name, and for each string specified by -@code{vc-header-alist}. The header line is made by processing the -string from @code{vc-header-alist} with the format taken from the -element. The default value for @code{vc-static-header-alist} is: - -@example -@group -(("\\.c$" . - "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n\ -#endif /* lint */\n")) -@end group -@end example - -@noindent -which specifies insertion of a string of this form: - -@example -@group - -#ifndef lint -static char vcid[] = "@var{string}"; -#endif /* lint */ -@end group -@end example - -@node ListDir, Comparing Files, Version Control, Files -@section Listing a File Directory - -@cindex file directory -@cindex directory listing - Files are organized by Unix into @dfn{directories}. A @dfn{directory -listing} is a list of all the files in a directory. Emacs provides -directory listings in brief format (file names only) and verbose format -(sizes, dates, and authors included). - -@table @kbd -@item C-x C-d @var{dir-or-pattern} -Print a brief directory listing (@code{list-directory}). -@item C-u C-x C-d @var{dir-or-pattern} -Print a verbose directory listing. -@end table - -@findex list-directory -@kindex C-x C-d - To print a directory listing, use @kbd{C-x C-d} -(@code{list-directory}). This command prompts in the minibuffer for a -file name which is either a directory to be listed or pattern -containing wildcards for the files to be listed. For example, - -@example -C-x C-d /u2/emacs/etc @key{RET} -@end example - -@noindent -lists all the files in directory @file{/u2/emacs/etc}. An example of -specifying a file name pattern is: - -@example -C-x C-d /u2/emacs/src/*.c @key{RET} -@end example - - Normally, @kbd{C-x C-d} prints a brief directory listing containing just -file names. A numeric argument (regardless of value) tells it to print a -verbose listing (like @code{ls -l}). - -@vindex list-directory-brief-switches -@vindex list-directory-verbose-switches - Emacs obtains the text of a directory listing by running @code{ls} in -an inferior process. Two Emacs variables control the switches passed to -@code{ls}: @code{list-directory-brief-switches} is a string giving the -switches to use in brief listings (@code{"-CF"} by default). -@code{list-directory-verbose-switches} is a string giving the switches -to use in a verbose listing (@code{"-l"} by default). - -The variable @code{directory-abbrev-alist} is an alist of abbreviations -for file directories. The list consists of elements of the form -@code{(FROM . TO)}, each meaning to replace @code{FROM} with @code{TO} -when it appears in a directory name. This replacement is done when -setting up the default directory of a newly visited file. Every @code{FROM} -string should start with `@samp{^}'. - -Use this feature when you have directories which you normally refer to -via absolute symbolic links. Make @code{TO} the name of the link, and -@code{FROM} the name it is linked to. - -@node Comparing Files, Dired, ListDir, Files -@section Comparing Files -@cindex comparing files - -@findex diff -@vindex diff-switches - The command @kbd{M-x diff} compares two files, displaying the -differences in an Emacs buffer named @samp{*Diff*}. It works by running -the @code{diff} program, using options taken from the variable -@code{diff-switches}, whose value should be a string. - - The buffer @samp{*Diff*} has Compilation mode as its major mode, so -you can use @kbd{C-x `} to visit successive changed locations in the two -source files. You can also move to a particular hunk of changes and -type @kbd{C-c C-c} to find the corresponding source location. You can -also use the other special commands of Compilation mode: @key{SPC} and -@key{DEL} for scrolling, and @kbd{M-p} and @kbd{M-n} for cursor motion. -@xref{Compilation}. - -@findex diff-backup - The command @kbd{M-x diff-backup} compares a specified file with its most -recent backup. If you specify the name of a backup file, -@code{diff-backup} compares it with the source file that it is a backup -of. - -@findex compare-windows -@cindex comparing files - The command @kbd{M-x compare-windows} compares the text in the current -window with that in the next window. Comparison starts at point in each -window. Point moves forward in each window, a character at a time in each -window, until the next characters in the two windows are different. Then -the command is finished. For more information about windows in Emacs, -@ref{Windows}. - -@vindex compare-ignore-case - With a numeric argument, @code{compare-windows} ignores changes in -whitespace. If the variable @code{compare-ignore-case} is -non-@code{nil}, it ignores differences in case as well. - -@node Dired, Misc File Ops, Comparing Files, Files -@section Dired, the Directory Editor -@cindex Dired -@cindex deletion (of files) - - Dired makes it easy to delete or visit many of the files in a single -directory at once. It creates an Emacs buffer containing a listing of the -directory. You can use the normal Emacs commands to move around in this -buffer and special Dired commands to operate on the files. - -@menu -* Enter: Dired Enter. How to invoke Dired. -* Edit: Dired Edit. Editing the Dired buffer. -* Deletion: Dired Deletion. Deleting files with Dired. -* Immed: Dired Immed. Other file operations through Dired. -@end menu - -@node Dired Enter, Dired Edit, Dired, Dired -@subsection Entering Dired - -@findex dired -@kindex C-x d -@vindex dired-listing-switches - To invoke dired, type @kbd{C-x d} or @kbd{M-x dired}. The command reads a -directory name or wildcard file name pattern as a minibuffer argument just -like the @code{list-directory} command, @kbd{C-x C-d}. Where @code{dired} -differs from @code{list-directory} is in naming the buffer after the -directory name or the wildcard pattern used for the listing, and putting -the buffer into Dired mode so that the special commands of Dired are -available in it. The variable @code{dired-listing-switches} is a string -used as an argument to @code{ls} in making the directory; this string -@i{must} contain @samp{-l}. - -@findex dired-other-window -@kindex C-x 4 d - To display the Dired buffer in another window rather than in the selected -window, use @kbd{C-x 4 d} (@code{dired-other-window)} instead of @kbd{C-x d}. - -@node Dired Edit, Dired Deletion, Dired Enter, Dired -@subsection Editing in Dired - - Once the Dired buffer exists, you can switch freely between it and other -Emacs buffers. Whenever the Dired buffer is selected, certain special -commands are provided that operate on files that are listed. The Dired -buffer is ``read-only'', and inserting text in it is not useful, so -ordinary printing characters such as @kbd{d} and @kbd{x} are used for Dired -commands. Most Dired commands operate on the file described by the line -that point is on. Some commands perform operations immediately; others -``flag'' a file to be operated on later. - - Most Dired commands that operate on the current line's file also treat a -numeric argument as a repeat count, meaning to act on the files of the -next few lines. A negative argument means to operate on the files of the -preceding lines, and leave point on the first of those lines. - - All the usual Emacs cursor motion commands are available in Dired -buffers. Some special purpose commands are also provided. The keys -@kbd{C-n} and @kbd{C-p} are redefined so that they try to position -the cursor at the beginning of the filename on the line, rather than -at the beginning of the line. - - For extra convenience, @key{SPC} and @kbd{n} in Dired are equivalent to -@kbd{C-n}. @kbd{p} is equivalent to @kbd{C-p}. Moving by lines is done so -often in Dired that it deserves to be easy to type. @key{DEL} (move up and -unflag) is often useful simply for moving up.@refill - - The @kbd{g} command in Dired runs @code{revert-buffer} to reinitialize -the buffer from the actual disk directory and show any changes made in the -directory by programs other than Dired. All deletion flags in the Dired -buffer are lost when this is done. - -@node Dired Deletion, Dired Immed, Dired Edit, Dired -@subsection Deleting Files With Dired - - The primary use of Dired is to flag files for deletion and then delete -them. - -@table @kbd -@item d -Flag this file for deletion. -@item u -Remove deletion-flag on this line. -@item @key{DEL} -Remove deletion-flag on previous line, moving point to that line. -@item x -Delete the files that are flagged for deletion. -@item # -Flag all auto-save files (files whose names start and end with @samp{#}) -for deletion (@pxref{Auto Save}). -@item ~ -Flag all backup files (files whose names end with @samp{~}) for deletion -(@pxref{Backup}). -@item .@: @r{(Period)} -Flag excess numeric backup files for deletion. The oldest and newest -few backup files of any one file are exempt; the middle ones are flagged. -@end table - - You can flag a file for deletion by moving to the line describing the -file and typing @kbd{d} or @kbd{C-d}. The deletion flag is visible as a -@samp{D} at the beginning of the line. Point is moved to the beginning of -the next line, so that repeated @kbd{d} commands flag successive files. - - The files are flagged for deletion rather than deleted immediately to -avoid the danger of deleting a file accidentally. Until you direct Dired -to delete the flagged files, you can remove deletion flags using the -commands @kbd{u} and @key{DEL}. @kbd{u} works just like @kbd{d}, but -removes flags rather than making flags. @key{DEL} moves upward, removing -flags; it is like @kbd{u} with numeric argument automatically negated. - - To delete the flagged files, type @kbd{x}. This command first displays a -list of all the file names flagged for deletion, and requests confirmation -with @kbd{yes}. Once you confirm, all the flagged files are deleted, and their -lines are deleted from the text of the Dired buffer. The shortened Dired -buffer remains selected. If you answer @kbd{no} or quit with @kbd{C-g}, you -return immediately to Dired, with the deletion flags still present and no -files actually deleted. - - The @kbd{#}, @kbd{~}, and @kbd{.} commands flag many files for -deletion, based on their names. These commands are useful precisely -because they do not actually delete any files; you can remove the -deletion flags from any flagged files that you really wish to keep.@refill - - @kbd{#} flags for deletion all files that appear to have been made by -auto-saving (that is, files whose names begin and end with @samp{#}). -@kbd{~} flags for deletion all files that appear to have been made as -backups for files that were edited (that is, files whose names end with -@samp{~}). - -@vindex dired-kept-versions - @kbd{.} (Period) flags just some of the backup files for deletion: only -numeric backups that are not among the oldest few nor the newest few -backups of any one file. Normally @code{dired-kept-versions} (not -@code{kept-new-versions}; that applies only when saving) specifies the -number of newest versions of each file to keep, and -@code{kept-old-versions} specifies the number of oldest versions to keep. -Period with a positive numeric argument, as in @kbd{C-u 3 .}, specifies the -number of newest versions to keep, overriding @code{dired-kept-versions}. -A negative numeric argument overrides @code{kept-old-versions}, using minus -the value of the argument to specify the number of oldest versions of each -file to keep.@refill - -@node Dired Immed, , Dired Deletion, Dired -@subsection Immediate File Operations in Dired - - Some file operations in Dired take place immediately when they are -requested. - -@table @kbd -@item C -Copies the file described on the current line. You must supply a file name -to copy to, using the minibuffer. -@item f -Visits the file described on the current line. It is just like typing -@kbd{C-x C-f} and supplying that file name. If the file on this line is a -subdirectory, @kbd{f} actually causes Dired to be invoked on that -subdirectory. @xref{Visiting}. -@item o -Like @kbd{f}, but uses another window to display the file's buffer. The -Dired buffer remains visible in the first window. This is like using -@kbd{C-x 4 C-f} to visit the file. @xref{Windows}. -@item R -Renames the file described on the current line. You must supply a file -name to rename to, using the minibuffer. -@item v -Views the file described on this line using @kbd{M-x view-file}. Viewing a -file is like visiting it, but is slanted toward moving around in the file -conveniently and does not allow changing the file. @xref{Misc File -Ops,View File}. Viewing a file that is a directory runs Dired on that -directory.@refill -@end table - -@node Misc File Ops, , Dired, Files -@section Miscellaneous File Operations - - Emacs has commands for performing many other operations on files. -All operate on one file; they do not accept wildcard file names. - -@findex add-name-to-file - You can use the command @kbd{M-x add-name-to-file} to add a name to an -existing file without removing the old name. The new name must belong -on the file system that the file is on. - -@findex append-to-file - @kbd{M-x append-to-file} adds the text of the region to the end of the -specified file. - -@findex copy-file -@cindex copying files - @kbd{M-x copy-file} reads the file @var{old} and writes a new file -named @var{new} with the same contents. Confirmation is required if a -file named @var{new} already exists, because copying overwrites the old -contents of the file @var{new}. - -@findex delete-file -@cindex deletion (of files) - @kbd{M-x delete-file} deletes a specified file, like the @code{rm} -command in the shell. If you are deleting many files in one directory, it -may be more convenient to use Dired (@pxref{Dired}). - -@findex insert-file - @kbd{M-x insert-file} inserts a copy of the contents of a specified -file into the current buffer at point, leaving point unchanged before the -contents and the mark after them. @xref{Mark}. - -@findex make-symbolic-link - @kbd{M-x make-symbolic-link} reads two file names @var{old} and -@var{linkname}, and then creates a symbolic link named @var{linkname} -and pointing at @var{old}. Future attempts to open file -@var{linkname} will then refer to the file named @var{old} at the time -the opening is done, or will result in an error if the name @var{old} is -not in use at that time. Confirmation is required if you create the -link while @var{linkname} is in use. Note that not all systems support -symbolic links. - -@findex rename-file - @kbd{M-x rename-file} reads two file names @var{old} and @var{new} using -the minibuffer, then renames file @var{old} as @var{new}. If a file named -@var{new} already exists, you must confirm with @kbd{yes} or renaming is not -done; this is because renaming causes the previous meaning of the -name @var{new} to be lost. If @var{old} and @var{new} are on different -file systems, the file @var{old} is copied and deleted. - -@findex view-file -@cindex viewing - @kbd{M-x view-file} allows you to scan or read a file by sequential -screenfuls. It reads a file name argument using the minibuffer. After -reading the file into an Emacs buffer, @code{view-file} reads and displays -one windowful. You can then type @key{SPC} to scroll forward one window, -or @key{DEL} to scroll backward. Various other commands are provided for -moving around in the file, but none for changing it; type @kbd{C-h} while -viewing a file for a list of them. Most commands are the default Emacs -cursor motion commands. To exit from viewing, type @kbd{C-c}. diff --git a/man/xemacs/frame.texi b/man/xemacs/frame.texi deleted file mode 100644 index 52be4b8..0000000 --- a/man/xemacs/frame.texi +++ /dev/null @@ -1,345 +0,0 @@ -@node Frame, Keystrokes, Concept Index, Top -@comment node-name, next, previous, up -@chapter The XEmacs Frame -@cindex frame -@cindex window -@cindex buffer - -@table @asis -@item Frame -In many environments, such as a tty terminal, an XEmacs frame -literally takes up the whole screen. If you are -running XEmacs in a multi-window system like the X Window System, the -XEmacs frame takes up one X window. @xref{XEmacs under X}, for more -information.@refill - -@item Window -No matter what environment you are running in, XEmacs allows you to look -at several buffers at the same time by having several windows be part of -the frame. Often, the whole frame is taken up by just one window, but -you can split the frame into two or more subwindows. If you are -running XEmacs under the X window system, that means you can have several -@dfn{XEmacs windows} inside the X window that contains the XEmacs frame. -You can even have multiple frames in different X windows, each with -their own set of subwindows. -@refill -@end table - -Each XEmacs frame displays a variety of information: -@itemize @bullet -@item -The biggest area usually displays the text you are editing. It may -consist of one window or of two or more windows if you need to look at two -buffers a the same time. -@item -Below each text window's last line is a @dfn{mode line} (@pxref{Mode -Line}), which describes what is going on in that window. The mode line -is in inverse video if the terminal supports that. If there are several -XEmacs windows in one frame, each window has its own mode line. -@item -At the bottom of each XEmacs frame is the @dfn{echo area} or @dfn{minibuffer -window}(@pxref{Echo Area}). It is used by XEmacs to exchange information -with the user. There is only one echo area per XEmacs frame. -@item -If you are running XEmacs under the X Window System, a -menu bar at the top of the frame makes shortcuts to several of the -commands available (@pxref{Pull-down Menus}). -@end itemize - - You can subdivide the XEmacs frame into multiple text windows, and use -each window for a different file (@pxref{Windows}). Multiple XEmacs -windows are tiled vertically on the XEmacs frame. The upper XEmacs window -is separated from the lower window by its mode line. - - When there are multiple, tiled XEmacs windows on a single XEmacs frame, -the XEmacs window receiving input from the keyboard has the @dfn{keyboard -focus} and is called the @dfn{selected window}. The selected window -contains the cursor, which indicates the insertion point. If you are -working in an environment that permits multiple XEmacs frames, and you -move the focus from one XEmacs frame into another, the -selected window is the one that was last selected in that frame. - - The same text can be displayed simultaneously in several XEmacs -windows, which can be in different XEmacs frames. If you alter the text -in an XEmacs buffer by editing it in one XEmacs window, the changes are -visible in all XEmacs windows containing that buffer. - - -@menu -* Point:: The place in the text where editing commands operate. -* Echo Area:: Short messages appear at the bottom of the frame. -* Mode Line:: Interpreting the mode line. -* XEmacs under X:: Some information on using XEmacs under the X - Window System. -@end menu - -@node Point, Echo Area, Frame, Frame -@comment node-name, next, previous, up -@section Point -@cindex point -@cindex cursor - - When XEmacs is running, the cursor shows the location at which editing -commands will take effect. This location is called @dfn{point}. You -can use keystrokes or the mouse cursor to move point through the text -and edit the text at different places. - - While the cursor appears to point @var{at} a character, you should -think of point as @var{between} two characters: it points @var{before} -the character on which the cursor appears. The exception is at the -end of the line, where the cursor appears after the last character of -the line. Where the display is capable, the cursor at the end of the -line will appear differently from a cursor over whitespace at the end -of the line. (In an X Windows frame, the end-of-line cursor is half -the width of a within-line cursor.) Sometimes people speak of ``the -cursor'' when they mean ``point,'' or speak of commands that move -point as ``cursor motion'' commands. - - Each XEmacs frame has only one cursor. When output is in progress, the cursor -must appear where the typing is being done. This does not mean that -point is moving. It is only that XEmacs has no way to show you the -location of point except when the terminal is idle. - - If you are editing several files in XEmacs, each file has its own point -location. A file that is not being displayed remembers where point is. -Point becomes visible at the correct location when you look at the file again. - - When there are multiple text windows, each window has its own point -location. The cursor shows the location of point in the selected -window. The visible cursor also shows you which window is selected. If -the same buffer appears in more than one window, point can be moved in -each window independently. - - The term `point' comes from the character @samp{.}, which was the -command in TECO (the language in which the original Emacs was written) -for accessing the value now called `point'. - -@node Echo Area, Mode Line, Point, Frame -@section The Echo Area -@cindex echo area - - The line at the bottom of the frame (below the mode line) is the -@dfn{echo area}. XEmacs uses this area to communicate with the user: - -@itemize @bullet -@item - @dfn{Echoing} means printing out the characters that the user types. XEmacs -never echoes single-character commands. Multi-character commands are -echoed only if you pause while typing them: As soon as you pause for more -than one second in the middle of a command, all the characters of the command -so far are echoed. This is intended to @dfn{prompt} you for the rest of -the command. Once echoing has started, the rest of the command is echoed -immediately as you type it. This behavior is designed to give confident -users fast response, while giving hesitant users maximum feedback. You -can change this behavior by setting a variable (@pxref{Display Vars}). -@item - If you issue a command that cannot be executed, XEmacs may print an -@dfn{error message} in the echo area. Error messages are accompanied by -a beep or by flashing the frame. Any input you have typed ahead is -thrown away when an error happens. -@item - Some commands print informative messages in the echo area. These -messages look similar to error messages, but are not announced with a -beep and do not throw away input. Sometimes a message tells you what the -command has done, when this is not obvious from looking at the text being -edited. Sometimes the sole purpose of a command is to print a message -giving you specific information. For example, the command @kbd{C-x =} is -used to print a message describing the character position of point in the -text and its current column in the window. Commands that take a long time -often display messages ending in @samp{...} while they are working, and -add @samp{done} at the end when they are finished. -@item - The echo area is also used to display the @dfn{minibuffer}, a window -that is used for reading arguments to commands, such as the name of a -file to be edited. When the minibuffer is in use, the echo area displays -with a prompt string that usually ends with a colon. The cursor -appears after the prompt. You can always get out of the minibuffer by -typing @kbd{C-g}. @xref{Minibuffer}. -@end itemize - -@node Mode Line, XEmacs under X, Echo Area, Frame -@comment node-name, next, previous, up -@section The Mode Line -@cindex mode line -@cindex top level - - Each text window's last line is a @dfn{mode line} which describes what is -going on in that window. When there is only one text window, the mode line -appears right above the echo area. The mode line is in inverse video if -the terminal supports that, starts and ends with dashes, and contains text -like @samp{XEmacs:@: @var{something}}. - - If a mode line has something else in place of @samp{XEmacs:@: -@var{something}}, the window above it is in a special subsystem -such as Dired. The mode line then indicates the status of the -subsystem. - - Normally, the mode line has the following appearance: - -@example ---@var{ch}-XEmacs: @var{buf} (@var{major} @var{minor})----@var{pos}------ -@end example - -@noindent -This gives information about the buffer being displayed in the window: the -buffer's name, what major and minor modes are in use, whether the buffer's -text has been changed, and how far down the buffer you are currently -looking. - - @var{ch} contains two stars (@samp{**}) if the text in the buffer has been -edited (the buffer is ``modified''), or two dashes (@samp{--}) if the -buffer has not been edited. Exception: for a read-only buffer, it is -@samp{%%}. - - @var{buf} is the name of the window's chosen @dfn{buffer}. The chosen -buffer in the selected window (the window that the cursor is in) is also -XEmacs's selected buffer, the buffer in which editing takes place. When -we speak of what some command does to ``the buffer'', we mean the -currently selected buffer. @xref{Buffers}. - - @var{pos} tells you whether there is additional text above the top of -the screen or below the bottom. If your file is small and it is -completely visible on the screen, @var{pos} is @samp{All}. Otherwise, -@var{pos} is @samp{Top} if you are looking at the beginning of the file, -@samp{Bot} if you are looking at the end of the file, or -@samp{@var{nn}%}, where @var{nn} is the percentage of the file above the -top of the screen.@refill - - @var{major} is the name of the @dfn{major mode} in effect in the buffer. At -any time, each buffer is in one and only one major mode. -The available major modes include Fundamental mode (the least specialized), -Text mode, Lisp mode, and C mode. @xref{Major Modes}, for details -on how the modes differ and how you select one.@refill - - @var{minor} is a list of some of the @dfn{minor modes} that are turned on -in the window's chosen buffer. For example, @samp{Fill} means that Auto -Fill mode is on. @code{Abbrev} means that Word Abbrev mode is on. -@code{Ovwrt} means that Overwrite mode is on. @xref{Minor Modes}, for more -information. @samp{Narrow} means that the buffer being displayed has -editing restricted to only a portion of its text. This is not really a -minor mode, but is like one. @xref{Narrowing}. @code{Def} means that a -keyboard macro is being defined. @xref{Keyboard Macros}. - - Some buffers display additional information after the minor modes. For -example, Rmail buffers display the current message number and the total -number of messages. Compilation buffers and Shell mode display the status -of the subprocess. - - If XEmacs is currently inside a recursive editing level, square -brackets (@samp{[@dots{}]}) appear around the parentheses that surround -the modes. If XEmacs is in one recursive editing level within another, -double square brackets appear, and so on. Since information on -recursive editing applies to XEmacs in general and not to any one buffer, -the square brackets appear in every mode line on the screen or not in -any of them. @xref{Recursive Edit}.@refill - -@findex display-time - XEmacs can optionally display the time and system load in all mode lines. -To enable this feature, type @kbd{M-x display-time}. The information added -to the mode line usually appears after the file name, before the mode names -and their parentheses. It looks like this: - -@example -@var{hh}:@var{mm}pm @var{l.ll} [@var{d}] -@end example - -@noindent -(Some fields may be missing if your operating system cannot support them.) -@var{hh} and @var{mm} are the hour and minute, followed always by @samp{am} -or @samp{pm}. @var{l.ll} is the average number of running processes in the -whole system recently. @var{d} is an approximate index of the ratio of -disk activity to CPU activity for all users. - -The word @samp{Mail} appears after the load level if there is mail for -you that you have not read yet. - -@vindex mode-line-inverse-video - Customization note: the variable @code{mode-line-inverse-video} -controls whether the mode line is displayed in inverse video (assuming -the terminal supports it); @code{nil} means no inverse video. The -default is @code{t}. For X frames, simply set the foreground and -background colors appropriately. - -@node XEmacs under X, , Mode Line, Frame -@section Using XEmacs Under the X Window System -@comment node-name, next, previous, up - -XEmacs can be used with the X Window System and a window manager like -MWM or TWM. In that case, the X window manager opens, closes, and -resizes XEmacs frames. You use the window manager's mouse gestures to -perform the operations. Consult your window manager guide or reference -manual for information on manipulating X windows. - -When you are working under X, each X window (that is, each XEmacs frame) -has a menu bar for mouse-controlled operations (@pxref{Pull-down Menus}). - -@cindex multi-frame XEmacs -@findex make-frame -XEmacs under X is also a multi-frame XEmacs. You can use the @b{New -Frame} menu item from the @b{File} menu to create a new XEmacs frame in a -new X window from the same process. The different frames will share the -same buffer list, but you can look at different buffers in the different -frames. - -@findex find-file-other-frame -The function @code{find-file-other-frame} is just like @code{find-file}, -but creates a new frame to display the buffer in first. This is -normally bound to @kbd{C-x 5 C-f}, and is what the @b{Open File, New -Frame} menu item does. - -@findex switch-to-buffer-other-frame -The function @code{switch-to-buffer-other-frame} is just like -@code{switch-to-buffer}, but creates a new frame to display the buffer -in first. This is normally bound to @kbd{C-x 5 b}. - -@vindex default-frame-alist -You can specify a different default frame size other than the one provided. -Use the variable @code{default-frame-alist}, which is an alist of default -values for frame creation other than the first one. These may be set in -your init file, like this: - -@example - (setq default-frame-alist '((width . 80) (height . 55))) -@end example - -@vindex x-frame-defaults -For values specific to the first XEmacs frame, you must use X resources. -The variable @code{x-frame-defaults} takes an alist of default frame -creation parameters for X window frames. These override what is -specified in @file{~/.Xdefaults} but are overridden by the arguments to -the particular call to @code{x-create-frame}. - -@vindex create-frame-hook -When you create a new frame, the variable @code{create-frame-hook} -is called with one argument, the frame just created. - -If you want to close one or more of the X windows you created using -@b{New Frame}, use the @b{Delete Frame} menu item from the @b{File} menu. - -@vindex frame-title-format -@vindex frame-icon-title-format -If you are working with multiple frames, some special information -applies: -@itemize @bullet -@item -Two variables, @code{frame-title-format} and -@code{frame-icon-title-format} determine the title of the frame and -the title of the icon that results if you shrink the frame. - -@vindex auto-lower-frame -@vindex auto-raise-frame -@item -The variables @code{auto-lower-frame} and @code{auto-raise-frame} -position a frame. If true, @code{auto-lower-frame} lowers a frame to -the bottom when it is no longer selected. If true, -@code{auto-raise-frame} raises a frame to the top when it is -selected. Under X, most ICCCM-compliant window managers will have -options to do this for you, but these variables are provided in case you -are using a broken window manager. - -@item -There is a new frame/modeline format directive, %S, which expands to -the name of the current frame (a frame's name is distinct from its -title; the name is used for resource lookup, among other things, and the -title is simply what appears above the window.) -@end itemize diff --git a/man/xemacs/glossary.texi b/man/xemacs/glossary.texi deleted file mode 100644 index a8c21aa..0000000 --- a/man/xemacs/glossary.texi +++ /dev/null @@ -1,765 +0,0 @@ - -@node Glossary, Manifesto, Intro, Top -@unnumbered Glossary - -@table @asis -@item Abbrev -An abbrev is a text string which expands into a different text string -when present in the buffer. For example, you might define a short -word as an abbrev for a long phrase that you want to insert -frequently. @xref{Abbrevs}. - -@item Aborting -Aborting means getting out of a recursive edit (q.v.@:). You can use -the commands @kbd{C-]} and @kbd{M-x top-level} for this. -@xref{Quitting}. - -@item Auto Fill mode -Auto Fill mode is a minor mode in which text you insert is -automatically broken into lines of fixed width. @xref{Filling}. - -@item Auto Saving -Auto saving means that Emacs automatically stores the contents of an -Emacs buffer in a specially-named file so the information will not be -lost if the buffer is lost due to a system error or user error. -@xref{Auto Save}. - -@item Backup File -A backup file records the contents that a file had before the current -editing session. Emacs creates backup files automatically to help you -track down or cancel changes you later regret. @xref{Backup}. - -@item Balance Parentheses -Emacs can balance parentheses manually or automatically. Manual -balancing is done by the commands to move over balanced expressions -(@pxref{Lists}). Automatic balancing is done by blinking the -parenthesis that matches one just inserted (@pxref{Matching,,Matching -Parens}). - -@item Bind -To bind a key is to change its binding (q.v.@:). @xref{Rebinding}. - -@item Binding -A key gets its meaning in Emacs by having a binding which is a -command (q.v.@:), a Lisp function that is run when the key is typed. -@xref{Commands,Binding}. Customization often involves rebinding a -character to a different command function. The bindings of all keys -are recorded in the keymaps (q.v.@:). @xref{Keymaps}. - -@item Blank Lines -Blank lines are lines that contain only whitespace. Emacs has several -commands for operating on the blank lines in a buffer. - -@item Buffer -The buffer is the basic editing unit; one buffer corresponds to one -piece of text being edited. You can have several buffers, but at any -time you are editing only one, the `selected' buffer, though several -buffers can be visible when you are using multiple windows. @xref{Buffers}. - -@item Buffer Selection History -Emacs keeps a buffer selection history which records how recently each -Emacs buffer was selected. Emacs uses this list when choosing a buffer to -select. @xref{Buffers}. - -@item C- -@samp{C} in the name of a character is an abbreviation for Control. -@xref{Keystrokes,C-}. - -@item C-M- -@samp{C-M-} in the name of a character is an abbreviation for -Control-Meta. @xref{Keystrokes,C-M-}. - -@item Case Conversion -Case conversion means changing text from upper case to lower case or -vice versa. @xref{Case}, for the commands for case conversion. - -@item Characters -Characters form the contents of an Emacs buffer; also, Emacs commands -are invoked by keys (q.v.@:), which are sequences of one or more -characters. @xref{Keystrokes}. - -@item Command -A command is a Lisp function specially defined to be able to serve as a -key binding in Emacs. When you type a key (q.v.@:), Emacs looks up its -binding (q.v.@:) in the relevant keymaps (q.v.@:) to find the command to -run. @xref{Commands}. - -@item Command Name -A command name is the name of a Lisp symbol which is a command -(@pxref{Commands}). You can invoke any command by its name using -@kbd{M-x} (@pxref{M-x}). - -@item Comments -A comment is text in a program which is intended only for the people -reading the program, and is marked specially so that it will be -ignored when the program is loaded or compiled. Emacs offers special -commands for creating, aligning, and killing comments. -@xref{Comments}. - -@item Compilation -Compilation is the process of creating an executable program from -source code. Emacs has commands for compiling files of Emacs Lisp -code (@pxref{Lisp Libraries}) and programs in C and other languages -(@pxref{Compilation}). - -@item Complete Key -A complete key is a character or sequence of characters which, when typed -by the user, fully specifies one action to be performed by Emacs. For -example, @kbd{X} and @kbd{Control-f} and @kbd{Control-x m} are keys. Keys -derive their meanings from being bound (q.v.@:) to commands (q.v.@:). -Thus, @kbd{X} is conventionally bound to a command to insert @samp{X} in -the buffer; @kbd{C-x m} is conventionally bound to a command to begin -composing a mail message. @xref{Keystrokes}. - -@item Completion -When Emacs automatically fills an abbreviation for a name into the -entire name, that process is called completion. Completion is done for -minibuffer (q.v.@:) arguments when the set of possible valid inputs is -known; for example, on command names, buffer names, and file names. -Completion occurs when you type @key{TAB}, @key{SPC}, or @key{RET}. -@xref{Completion}.@refill - -@item Continuation Line -When a line of text is longer than the width of the frame, it -takes up more than one screen line when displayed. We say that the -text line is continued, and all screen lines used for it after the -first are called continuation lines. @xref{Basic,Continuation,Basic -Editing}. - -@item Control-Character -ASCII characters with octal codes 0 through 037, and also code 0177, -do not have graphic images assigned to them. These are the control -characters. Any control character can be typed by holding down the -@key{CTRL} key and typing some other character; some have special keys -on the keyboard. @key{RET}, @key{TAB}, @key{ESC}, @key{LFD}, and -@key{DEL} are all control characters. @xref{Keystrokes}.@refill - -@item Copyleft -A copyleft is a notice giving the public legal permission to redistribute -a program or other work of art. Copylefts are used by leftists to enrich -the public just as copyrights are used by rightists to gain power over -the public. - -@item Current Buffer -The current buffer in Emacs is the Emacs buffer on which most editing -commands operate. You can select any Emacs buffer as the current one. -@xref{Buffers}. - -@item Current Line -The line point is on (@pxref{Point}). - -@item Current Paragraph -The paragraph that point is in. If point is between paragraphs, the -current paragraph is the one that follows point. @xref{Paragraphs}. - -@item Current Defun -The defun (q.v.@:) that point is in. If point is between defuns, the -current defun is the one that follows point. @xref{Defuns}. - -@item Cursor -The cursor is the rectangle on the screen which indicates the position -called point (q.v.@:) at which insertion and deletion takes place. -The cursor is on or under the character that follows point. Often -people speak of `the cursor' when, strictly speaking, they mean -`point'. @xref{Basic,Cursor,Basic Editing}. - -@item Customization -Customization is making minor changes in the way Emacs works. It is -often done by setting variables (@pxref{Variables}) or by rebinding -keys (@pxref{Keymaps}). - -@item Default Argument -The default for an argument is the value that is used if you do not -specify one. When Emacs prompts you in the minibuffer for an argument, -the default argument is used if you just type @key{RET}. -@xref{Minibuffer}. - -@item Default Directory -When you specify a file name that does not start with @samp{/} or @samp{~}, -it is interpreted relative to the current buffer's default directory. -@xref{Minibuffer File,Default Directory}. - -@item Defun -A defun is a list at the top level of parenthesis or bracket structure -in a program. It is so named because most such lists in Lisp programs -are calls to the Lisp function @code{defun}. @xref{Defuns}. - -@item @key{DEL} -The @key{DEL} character runs the command that deletes one character of -text. @xref{Basic,DEL,Basic Editing}. - -@item Deletion -Deleting text means erasing it without saving it. Emacs deletes text -only when it is expected not to be worth saving (all whitespace, or -only one character). The alternative is killing (q.v.@:). -@xref{Killing,Deletion}. - -@item Deletion of Files -Deleting a file means removing it from the file system. -@xref{Misc File Ops}. - -@item Deletion of Messages -Deleting a message means flagging it to be eliminated from your mail -file. Until the mail file is expunged, you can undo this by undeleting -the message. - -@item Deletion of Frames -When working under the multi-frame X-based version of XEmacs, -you can delete individual frames using the @b{Close} menu item from the -@b{File} menu. - -@item Deletion of Windows -When you delete a subwindow of an Emacs frame, you eliminate it from -the frame. Other windows expand to use up the space. The deleted -window can never come back, but no actual text is lost. @xref{Windows}. - -@item Directory -Files in the Unix file system are grouped into file directories. -@xref{ListDir,,Directories}. - -@item Dired -Dired is the Emacs facility that displays the contents of a file -directory and allows you to ``edit the directory'', performing -operations on the files in the directory. @xref{Dired}. - -@item Disabled Command -A disabled command is one that you may not run without special -confirmation. Commands are usually disabled because they are -confusing for beginning users. @xref{Disabling}. - -@item Dribble File -A file into which Emacs writes all the characters that the user types -on the keyboard. Dribble files are used to make a record for -debugging Emacs bugs. Emacs does not make a dribble file unless you -tell it to. @xref{Bugs}. - -@item Echo Area -The area at the bottom of the Emacs frame which is used for echoing the -arguments to commands, for asking questions, and for printing brief -messages (including error messages). @xref{Echo Area}. - -@item Echoing -Echoing refers to acknowledging the receipt of commands by displaying them -(in the echo area). Emacs never echoes single-character keys; longer -keys echo only if you pause while typing them. - -@item Error -An error occurs when an Emacs command cannot execute in the current -circumstances. When an error occurs, execution of the command stops -(unless the command has been programmed to do otherwise) and Emacs -reports the error by printing an error message (q.v.). Type-ahead -is discarded. Then Emacs is ready to read another editing command. - -@item Error Messages -Error messages are single lines of output printed by Emacs when the -user asks for something impossible to do (such as killing text -forward when point is at the end of the buffer). They appear in the -echo area, accompanied by a beep. - -@item @key{ESC} -@key{ESC} is a character used as a prefix for typing Meta characters on -keyboards lacking a @key{META} key. Unlike the @key{META} key (which, -like the @key{SHIFT} key, is held down while another character is -typed), the @key{ESC} key is pressed and released, and applies to the -next character typed. - -@item Fill Prefix -The fill prefix is a string that Emacs enters at the beginning -of each line when it performs filling. It is not regarded as part of the -text to be filled. @xref{Filling}. - -@item Filling -Filling text means moving text from line to line so that all the lines -are approximately the same length. @xref{Filling}. - -@item Frame -When running Emacs on a TTY terminal, ``frame'' means the terminal's -screen. When running Emacs under X, you can have multiple frames, -each corresponding to a top-level X window and each looking like -the screen on a TTY. Each frame contains one or more non-overlapping -Emacs windows (possibly with associated scrollbars, under X), an -echo area, and (under X) possibly a menubar. - -@item Global -Global means `independent of the current environment; in effect -@*throughout Emacs'. It is the opposite of local (q.v.@:). -Examples of the use of `global' appear below. - -@item Global Abbrev -A global definition of an abbrev (q.v.@:) is effective in all major -modes that do not have local (q.v.@:) definitions for the same abbrev. -@xref{Abbrevs}. - -@item Global Keymap -The global keymap (q.v.@:) contains key bindings that are in effect -unless local key bindings in a major mode's local -keymap (q.v.@:) override them.@xref{Keymaps}. - -@item Global Substitution -Global substitution means replacing each occurrence of one string by -another string through a large amount of text. @xref{Replace}. - -@item Global Variable -The global value of a variable (q.v.@:) takes effect in all buffers -that do not have their own local (q.v.@:) values for the variable. -@xref{Variables}. - -@item Graphic Character -Graphic characters are those assigned pictorial images rather than -just names. All the non-Meta (q.v.@:) characters except for the -Control (q.v.@:) character are graphic characters. These include -letters, digits, punctuation, and spaces; they do not include -@key{RET} or @key{ESC}. In Emacs, typing a graphic character inserts -that character (in ordinary editing modes). @xref{Basic,,Basic Editing}. - -@item Grinding -Grinding means adjusting the indentation in a program to fit the -nesting structure. @xref{Indentation,Grinding}. - -@item Hardcopy -Hardcopy means printed output. Emacs has commands for making printed -listings of text in Emacs buffers. @xref{Hardcopy}. - -@item @key{HELP} -You can type @key{HELP} at any time to ask what options you have, or -to ask what any command does. @key{HELP} is really @kbd{Control-h}. -@xref{Help}. - -@item Inbox -An inbox is a file in which mail is delivered by the operating system. -Some mail handlers transfers mail from inboxes to mail files (q.v.) in -which the mail is then stored permanently or until explicitly deleted. - -@item Indentation -Indentation means blank space at the beginning of a line. Most -programming languages have conventions for using indentation to -illuminate the structure of the program, and Emacs has special -features to help you set up the correct indentation. -@xref{Indentation}. - -@item Insertion -Insertion means copying text into the buffer, either from the keyboard -or from some other place in Emacs. - -@item Justification -Justification means adding extra spaces to lines of text to make them -come exactly to a specified width. @xref{Filling,Justification}. - -@item Keyboard Macros -Keyboard macros are a way of defining new Emacs commands from -sequences of existing ones, with no need to write a Lisp program. -@xref{Keyboard Macros}. - -@item Key -A key is a sequence of characters that, when input to Emacs, specify -or begin to specify a single action for Emacs to perform. That is, -the sequence is considered a single unit. If the key is enough to -specify one action, it is a complete key (q.v.); if it is less than -enough, it is a prefix key (q.v.). @xref{Keystrokes}. - -@item Keymap -The keymap is the data structure that records the bindings (q.v.@:) of -keys to the commands that they run. For example, the keymap binds the -character @kbd{C-n} to the command function @code{next-line}. -@xref{Keymaps}. - -@item Kill Ring -The kill ring is the place where all text you have killed recently is saved. -You can re-insert any of the killed text still in the ring; this is -called yanking (q.v.@:). @xref{Yanking}. - -@item Killing -Killing means erasing text and saving it on the kill ring so it can be -yanked (q.v.@:) later. Some other systems call this ``cutting.'' -Most Emacs commands to erase text do killing, as opposed to deletion -(q.v.@:). @xref{Killing}. - -@item Killing Jobs -Killing a job (such as, an invocation of Emacs) means making it cease -to exist. Any data within it, if not saved in a file, is lost. -@xref{Exiting}. - -@item List -A list is, approximately, a text string beginning with an open -parenthesis and ending with the matching close parenthesis. In C mode -and other non-Lisp modes, groupings surrounded by other kinds of matched -delimiters appropriate to the language, such as braces, are also -considered lists. Emacs has special commands for many operations on -lists. @xref{Lists}. - -@item Local -Local means `in effect only in a particular context'; the relevant -kind of context is a particular function execution, a particular -buffer, or a particular major mode. Local is the opposite of `global' -(q.v.@:). Specific uses of `local' in Emacs terminology appear below. - -@item Local Abbrev -A local abbrev definition is effective only if a particular major mode -is selected. In that major mode, it overrides any global definition -for the same abbrev. @xref{Abbrevs}. - -@item Local Keymap -A local keymap is used in a particular major mode; the key bindings -(q.v.@:) in the current local keymap override global bindings of the -same keys. @xref{Keymaps}. - -@item Local Variable -A local value of a variable (q.v.@:) applies to only one buffer. -@xref{Locals}. - -@item M- -@kbd{M-} in the name of a character is an abbreviation for @key{META}, -one of the modifier keys that can accompany any character. -@xref{Keystrokes}. - -@item M-C- -@samp{M-C-} in the name of a character is an abbreviation for -Control-Meta; it means the same thing as @samp{C-M-}. If your -terminal lacks a real @key{META} key, you type a Control-Meta character by -typing @key{ESC} and then typing the corresponding Control character. -@xref{Keystrokes,C-M-}. - -@item M-x -@kbd{M-x} is the key which is used to call an Emacs command by name. -You use it to call commands that are not bound to keys. -@xref{M-x}. - -@item Mail -Mail means messages sent from one user to another through the computer -system, to be read at the recipient's convenience. Emacs has commands for -composing and sending mail, and for reading and editing the mail you have -received. @xref{Sending Mail}. - -@item Major Mode -The major modes are a mutually exclusive set of options each of which -configures Emacs for editing a certain sort of text. Ideally, each -programming language has its own major mode. @xref{Major Modes}. - -@item Mark -The mark points to a position in the text. It specifies one end of the -region (q.v.@:), point being the other end. Many commands operate on -the whole region, that is, all the text from point to the mark. -@xref{Mark}. - -@item Mark Ring -The mark ring is used to hold several recent previous locations of the -mark, just in case you want to move back to them. @xref{Mark Ring}. - -@item Message -See `mail'. - -@item Meta -Meta is the name of a modifier bit which a command character may have. -It is present in a character if the character is typed with the -@key{META} key held down. Such characters are given names that start -with @kbd{Meta-}. For example, @kbd{Meta-<} is typed by holding down -@key{META} and at the same time typing @kbd{<} (which itself is done, -on most terminals, by holding down @key{SHIFT} and typing @kbd{,}). -@xref{Keystrokes,Meta}. - -@item Meta Character -A Meta character is one whose character code includes the Meta bit. - -@item Minibuffer -The minibuffer is the window that Emacs displays inside the -echo area (q.v.@:) when it prompts you for arguments to commands. -@xref{Minibuffer}. - -@item Minor Mode -A minor mode is an optional feature of Emacs which can be switched on -or off independent of the major mode. Each minor mode has a -command to turn it on or off. @xref{Minor Modes}. - -@item Mode Line -The mode line is the line at the bottom of each text window (q.v.@:), -which gives status information on the buffer displayed in that window. -@xref{Mode Line}. - -@item Modified Buffer -A buffer (q.v.@:) is modified if its text has been changed since the -last time the buffer was saved (or since it was created, if it -has never been saved). @xref{Saving}. - -@item Moving Text -Moving text means erasing it from one place and inserting it in -another. This is done by killing (q.v.@:) and then yanking (q.v.@:). -@xref{Killing}. - -@item Named Mark -A named mark is a register (q.v.@:) in its role of recording a -location in text so that you can move point to that location. -@xref{Registers}. - -@item Narrowing -Narrowing means creating a restriction (q.v.@:) that limits editing in -the current buffer to only a part of the text in the buffer. Text -outside that part is inaccessible to the user until the boundaries are -widened again, but it is still there, and saving the file saves the -invisible text. @xref{Narrowing}. - -@item Newline -@key{LFD} characters in the buffer terminate lines of text and are -called newlines. @xref{Keystrokes,Newline}. - -@item Numeric Argument -A numeric argument is a number, specified before a command, to change -the effect of the command. Often the numeric argument serves as a -repeat count. @xref{Arguments}. - -@item Option -An option is a variable (q.v.@:) that allows you to customize -Emacs by giving it a new value. @xref{Variables}. - -@item Overwrite Mode -Overwrite mode is a minor mode. When it is enabled, ordinary text -characters replace the existing text after point rather than pushing -it to the right. @xref{Minor Modes}. - -@item Page -A page is a unit of text, delimited by formfeed characters (ASCII -Control-L, code 014) coming at the beginning of a line. Some Emacs -commands are provided for moving over and operating on pages. -@xref{Pages}. - -@item Paragraphs -Paragraphs are the medium-size unit of English text. There are -special Emacs commands for moving over and operating on paragraphs. -@xref{Paragraphs}. - -@item Parsing -We say that Emacs parses words or expressions in the text being -edited. Really, all it knows how to do is find the other end of a -word or expression. @xref{Syntax}. - -@item Point -Point is the place in the buffer at which insertion and deletion -occur. Point is considered to be between two characters, not at one -character. The terminal's cursor (q.v.@:) indicates the location of -point. @xref{Basic,Point}. - -@item Prefix Key -A prefix key is a key (q.v.@:) whose sole function is to introduce a -set of multi-character keys. @kbd{Control-x} is an example of a prefix -key; any two-character sequence starting with @kbd{C-x} is also -a legitimate key. @xref{Keystrokes}. - -@item Prompt -A prompt is text printed to ask the user for input. Printing a prompt -is called prompting. Emacs prompts always appear in the echo area -(q.v.@:). One kind of prompting happens when the minibuffer is used -to read an argument (@pxref{Minibuffer}); the echoing which happens -when you pause in the middle of typing a multi-character key is also a -kind of prompting (@pxref{Echo Area}). - -@item Quitting -Quitting means cancelling a partially typed command or a running -command, using @kbd{C-g}. @xref{Quitting}. - -@item Quoting -Quoting means depriving a character of its usual special significance. -In Emacs this is usually done with @kbd{Control-q}. What constitutes special -significance depends on the context and on convention. For example, -an ``ordinary'' character as an Emacs command inserts itself; so in -this context, a special character is any character that does not -normally insert itself (such as @key{DEL}, for example), and quoting -it makes it insert itself as if it were not special. Not all contexts -allow quoting. @xref{Basic,Quoting,Basic Editing}. - -@item Read-only Buffer -A read-only buffer is one whose text you are not allowed to change. -Normally Emacs makes buffers read-only when they contain text which -has a special significance to Emacs, such asDired buffers. -Visiting a file that is write-protected also makes a read-only buffer. -@xref{Buffers}. - -@item Recursive Editing Level -A recursive editing level is a state in which part of the execution of -a command involves asking the user to edit some text. This text may -or may not be the same as the text to which the command was applied. -The mode line indicates recursive editing levels with square brackets -(@samp{[} and @samp{]}). @xref{Recursive Edit}. - -@item Redisplay -Redisplay is the process of correcting the image on the screen to -correspond to changes that have been made in the text being edited. -@xref{Frame,Redisplay}. - -@item Regexp -See `regular expression'. - -@item Region -The region is the text between point (q.v.@:) and the mark (q.v.@:). -Many commands operate on the text of the region. @xref{Mark,Region}. - -@item Registers -Registers are named slots in which text or buffer positions or -rectangles can be saved for later use. @xref{Registers}. - -@item Regular Expression -A regular expression is a pattern that can match various text strings; -for example, @samp{l[0-9]+} matches @samp{l} followed by one or more -digits. @xref{Regexps}. - -@item Replacement -See `global substitution'. - -@item Restriction -A buffer's restriction is the amount of text, at the beginning or the -end of the buffer, that is temporarily invisible and inaccessible. -Giving a buffer a nonzero amount of restriction is called narrowing -(q.v.). @xref{Narrowing}. - -@item @key{RET} -@key{RET} is the character than runs the command to insert a -newline into the text. It is also used to terminate most arguments -read in the minibuffer (q.v.@:). @xref{Keystrokes,Return}. - -@item Saving -Saving a buffer means copying its text into the file that was visited -(q.v.@:) in that buffer. To actually change a file you have edited in -Emacs, you have to save it. @xref{Saving}. - -@item Scrolling -Scrolling means shifting the text in the Emacs window to make a -different part ot the buffer visible. @xref{Display,Scrolling}. - -@item Searching -Searching means moving point to the next occurrence of a specified -string. @xref{Search}. - -@item Selecting -Selecting a buffer means making it the current (q.v.@:) buffer. -@xref{Buffers,Selecting}. - -@item Self-documentation -Self-documentation is the feature of Emacs which can tell you what any -command does, or can give you a list of all commands related to a topic -you specify. You ask for self-documentation with the help character, -@kbd{C-h}. @xref{Help}. - -@item Sentences -Emacs has commands for moving by or killing by sentences. -@xref{Sentences}. - -@item Sexp -An sexp (short for `s-expression,' itself short for `symbolic -expression') is the basic syntactic unit of Lisp -in its textual form: either a list, or Lisp atom. Many Emacs commands -operate on sexps. The term `sexp' is generalized to languages other -than Lisp to mean a syntactically recognizable expression. -@xref{Lists,Sexps}. - -@item Simultaneous Editing -Simultaneous editing means two users modifying the same file at once. -If simultaneous editing is not detected, you may lose your -work. Emacs detects all cases of simultaneous editing and warns the -user to investigate them. @xref{Interlocking,,Simultaneous Editing}. - -@item String -A string is a kind of Lisp data object which contains a sequence of -characters. Many Emacs variables are intended to have strings as -values. The Lisp syntax for a string consists of the characters in -the string with a @samp{"} before and another @samp{"} after. Write a -@samp{"} that is part of the string as @samp{\"} and a -@samp{\} that is part of the string as @samp{\\}. You can include all -other characters, including newline, just by writing -them inside the string. You can also include escape sequences as in C, such as -@samp{\n} for newline or @samp{\241} using an octal character code. - -@item String Substitution -See `global substitution'. - -@item Syntax Table -The syntax table tells Emacs which characters are part of a word, -which characters balance each other like parentheses, etc. -@xref{Syntax}. - -@item Tag Table -A tag table is a file that serves as an index to the function -definitions in one or more other files. @xref{Tags}. - -@item Termscript File -A termscript file contains a record of all characters Emacs sent to -the terminal. It is used for tracking down bugs in Emacs redisplay. -Emacs does not make a termscript file unless explicitly instructed to do -so. -@xref{Bugs}. - -@item Text -Text has two meanings (@pxref{Text}): - -@itemize @bullet -@item -Data consisting of a sequence of characters, as opposed to binary -numbers, images, graphics commands, executable programs, and the like. -The contents of an Emacs buffer are always text in this sense. -@item -Data consisting of written human language, as opposed to programs, -or something that follows the stylistic conventions of human language. -@end itemize - -@item Top Level -Top level is the normal state of Emacs, in which you are editing the -text of the file you have visited. You are at top level whenever you -are not in a recursive editing level (q.v.@:) or the minibuffer -(q.v.@:), and not in the middle of a command. You can get back to top -level by aborting (q.v.@:) and quitting (q.v.@:). @xref{Quitting}. - -@item Transposition -Transposing two units of text means putting each one into the place -formerly occupied by the other. There are Emacs commands to transpose -two adjacent characters, words, sexps (q.v.@:), or lines -(@pxref{Transpose}). - -@item Truncation -Truncating text lines in the display means leaving out any text on a -line that does not fit within the right margin of the window -displaying it. See also `continuation line'. -@xref{Basic,Truncation,Basic Editing}. - -@item Undoing -Undoing means making your previous editing go in reverse, bringing -back the text that existed earlier in the editing session. -@xref{Undo}. - -@item Variable -A variable is Lisp object that can store an arbitrary value. Emacs uses -some variables for internal purposes, and has others (known as `options' -(q.v.@:)) you can set to control the behavior of Emacs. The variables -used in Emacs that you are likely to be interested in are listed in the -Variables Index of this manual. @xref{Variables}, for information on -variables. - -@item Visiting -Visiting a file means loading its contents into a buffer (q.v.@:) -where they can be edited. @xref{Visiting}. - -@item Whitespace -Whitespace is any run of consecutive formatting characters (spaces, -tabs, newlines, and backspaces). - -@item Widening -Widening is removing any restriction (q.v.@:) on the current buffer; -it is the opposite of narrowing (q.v.@:). @xref{Narrowing}. - -@item Window -Emacs divides the frame into one or more windows, each of which can -display the contents of one buffer (q.v.@:) at any time. -@xref{Frame}, for basic information on how Emacs uses the frame. -@xref{Windows}, for commands to control the use of windows. Note that if -you are running Emacs under X, terminology can be confusing: Each Emacs -frame occupies a separate X window and can, in turn, be divided into -different subwindows. - -@item Word Abbrev -Synonymous with `abbrev'. - -@item Word Search -Word search is searching for a sequence of words, considering the -punctuation between them as insignificant. @xref{Word Search}. - -@item Yanking -Yanking means reinserting text previously killed. It can be used to -undo a mistaken kill, or for copying or moving text. Some other -systems call this ``pasting''. @xref{Yanking}. -@end table diff --git a/man/xemacs/gnu.texi b/man/xemacs/gnu.texi deleted file mode 100644 index 5762718..0000000 --- a/man/xemacs/gnu.texi +++ /dev/null @@ -1,478 +0,0 @@ - -@node Manifesto, Key Index, Glossary, Top -@unnumbered The GNU Manifesto - -@unnumberedsec What's GNU? GNU's Not Unix! - -GNU, which stands for GNU's Not Unix, is the name for the complete -Unix-compatible software system which I am writing so that I can give it -away free to everyone who can use it. Several other volunteers are helping -me. Contributions of time, money, programs, and equipment are greatly -needed. - -So far we have an Emacs text editor with Lisp for writing editor commands, -a source level debugger, a yacc-compatible parser generator, a linker, and -around 35 utilities. A shell (command interpreter) is nearly completed. A -new portable optimizing C compiler has compiled itself and may be released -this year. An initial kernel exists, but many more features are needed to -emulate Unix. When the kernel and compiler are finished, it will be -possible to distribute a GNU system suitable for program development. We -will use @TeX{} as our text formatter, but an nroff is being worked on. We -will use the free, portable X window system as well. After this we will -add a portable Common Lisp, an Empire game, a spreadsheet, and hundreds of -other things, plus online documentation. We hope to supply, eventually, -everything useful that normally comes with a Unix system, and more. - -GNU will be able to run Unix programs, but will not be identical to Unix. -We will make all improvements that are convenient, based on our experience -with other operating systems. In particular, we plan to have longer -filenames, file version numbers, a crashproof file system, filename -completion perhaps, terminal-independent display support, and perhaps -eventually a Lisp-based window system through which several Lisp programs -and ordinary Unix programs can share a screen. Both C and Lisp will be -available as system programming languages. We will try to support UUCP, -MIT Chaosnet, and Internet protocols for communication. - -GNU is aimed initially at machines in the 68000/16000 class with virtual -memory, because they are the easiest machines to make it run on. The extra -effort to make it run on smaller machines will be left to someone who wants -to use it on them. - -To avoid horrible confusion, please pronounce the `G' in the word `GNU' -when it is the name of this project. - -@page -@unnumberedsec Why I Must Write GNU - -I consider that the golden rule requires that if I like a program I must -share it with other people who like it. Software sellers want to divide -the users and conquer them, making each user agree not to share with -others. I refuse to break solidarity with other users in this way. I -cannot in good conscience sign a nondisclosure agreement or a software -license agreement. For years I worked within the Artificial Intelligence -Lab to resist such tendencies and other inhospitalities, but eventually -they had gone too far: I could not remain in an institution where such -things are done for me against my will. - -So that I can continue to use computers without dishonor, I have decided to -put together a sufficient body of free software so that I will be able to -get along without any software that is not free. I have resigned from the -AI lab to deny MIT any legal excuse to prevent me from giving GNU away. - -@unnumberedsec Why GNU Will Be Compatible With Unix - -Unix is not my ideal system, but it is not too bad. The essential features -of Unix seem to be good ones, and I think I can fill in what Unix lacks -without spoiling them. And a system compatible with Unix would be -convenient for many other people to adopt. - -@unnumberedsec How GNU Will Be Available - -GNU is not in the public domain. Everyone will be permitted to modify and -redistribute GNU, but no distributor will be allowed to restrict its -further redistribution. That is to say, proprietary modifications will not -be allowed. I want to make sure that all versions of GNU remain free. - -@unnumberedsec Why Many Other Programmers Want to Help - -I have found many other programmers who are excited about GNU and want to -help. - -Many programmers are unhappy about the commercialization of system -software. It may enable them to make more money, but it requires them to -feel in conflict with other programmers in general rather than feel as -comrades. The fundamental act of friendship among programmers is the -sharing of programs; marketing arrangements now typically used essentially -forbid programmers to treat others as friends. The purchaser of software -must choose between friendship and obeying the law. Naturally, many decide -that friendship is more important. But those who believe in law often do -not feel at ease with either choice. They become cynical and think that -programming is just a way of making money. - -By working on and using GNU rather than proprietary programs, we can be -hospitable to everyone and obey the law. In addition, GNU serves as an -example to inspire and a banner to rally others to join us in sharing. -This can give us a feeling of harmony which is impossible if we use -software that is not free. For about half the programmers I talk to, this -is an important happiness that money cannot replace. - -@unnumberedsec How You Can Contribute - -I am asking computer manufacturers for donations of machines and money. -I'm asking individuals for donations of programs and work. - -One consequence you can expect if you donate machines is that GNU will run -on them at an early date. The machines should be complete, ready-to-use -systems, approved for use in a residential area, and not in need of -sophisticated cooling or power. - -I have found very many programmers eager to contribute part-time work for -GNU. For most projects, such part-time distributed work would be very hard -to coordinate; the independently-written parts would not work together. -But for the particular task of replacing Unix, this problem is absent. A -complete Unix system contains hundreds of utility programs, each of which -is documented separately. Most interface specifications are fixed by Unix -compatibility. If each contributor can write a compatible replacement for -a single Unix utility, and make it work properly in place of the original -on a Unix system, then these utilities will work right when put together. -Even allowing for Murphy to create a few unexpected problems, assembling -these components will be a feasible task. (The kernel will require closer -communication and will be worked on by a small, tight group.) - -If I get donations of money, I may be able to hire a few people full or -part time. The salary won't be high by programmers' standards, but I'm -looking for people for whom building community spirit is as important as -making money. I view this as a way of enabling dedicated people to devote -their full energies to working on GNU by sparing them the need to make a -living in another way. - -@unnumberedsec Why All Computer Users Will Benefit - -Once GNU is written, everyone will be able to obtain good system software -free, just like air. - -This means much more than just saving everyone the price of a Unix license. -It means that much wasteful duplication of system programming effort will -be avoided. This effort can go instead into advancing the state of the -art. - -Complete system sources will be available to everyone. As a result, a user -who needs changes in the system will always be free to make them himself, -or hire any available programmer or company to make them for him. Users -will no longer be at the mercy of one programmer or company which owns the -sources and is in sole position to make changes. - -Schools will be able to provide a much more educational environment by -encouraging all students to study and improve the system code. Harvard's -computer lab used to have the policy that no program could be installed on -the system if its sources were not on public display, and upheld it by -actually refusing to install certain programs. I was very much inspired by -this. - -Finally, the overhead of considering who owns the system software and what -one is or is not entitled to do with it will be lifted. - -Arrangements to make people pay for using a program, including licensing of -copies, always incur a tremendous cost to society through the cumbersome -mechanisms necessary to figure out how much (that is, which programs) a -person must pay for. And only a police state can force everyone to obey -them. Consider a space station where air must be manufactured at great -cost: charging each breather per liter of air may be fair, but wearing the -metered gas mask all day and all night is intolerable even if everyone can -afford to pay the air bill. And the TV cameras everywhere to see if you -ever take the mask off are outrageous. It's better to support the air -plant with a head tax and chuck the masks. - -Copying all or parts of a program is as natural to a programmer as -breathing, and as productive. It ought to be as free. - -@unnumberedsec Some Easily Rebutted Objections to GNU's Goals - -@quotation -``Nobody will use it if it is free, because that means they can't rely -on any support.'' - -``You have to charge for the program to pay for providing the -support.'' -@end quotation - -If people would rather pay for GNU plus service than get GNU free without -service, a company to provide just service to people who have obtained GNU -free ought to be profitable. - -We must distinguish between support in the form of real programming work -and mere handholding. The former is something one cannot rely on from a -software vendor. If your problem is not shared by enough people, the -vendor will tell you to get lost. - -If your business needs to be able to rely on support, the only way is to -have all the necessary sources and tools. Then you can hire any available -person to fix your problem; you are not at the mercy of any individual. -With Unix, the price of sources puts this out of consideration for most -businesses. With GNU this will be easy. It is still possible for there to -be no available competent person, but this problem cannot be blamed on -distibution arrangements. GNU does not eliminate all the world's problems, -only some of them. - -Meanwhile, the users who know nothing about computers need handholding: -doing things for them which they could easily do themselves but don't know -how. - -Such services could be provided by companies that sell just hand-holding -and repair service. If it is true that users would rather spend money and -get a product with service, they will also be willing to buy the service -having got the product free. The service companies will compete in quality -and price; users will not be tied to any particular one. Meanwhile, those -of us who don't need the service should be able to use the program without -paying for the service. - -@quotation -``You cannot reach many people without advertising, -and you must charge for the program to support that.'' - -``It's no use advertising a program people can get free.'' -@end quotation - -There are various forms of free or very cheap publicity that can be used to -inform numbers of computer users about something like GNU. But it may be -true that one can reach more microcomputer users with advertising. If this -is really so, a business which advertises the service of copying and -mailing GNU for a fee ought to be successful enough to pay for its -advertising and more. This way, only the users who benefit from the -advertising pay for it. - -On the other hand, if many people get GNU from their friends, and such -companies don't succeed, this will show that advertising was not really -necessary to spread GNU. Why is it that free market advocates don't want -to let the free market decide this? -@page -@quotation -``My company needs a proprietary operating system -to get a competitive edge.'' -@end quotation - -GNU will remove operating system software from the realm of competition. -You will not be able to get an edge in this area, but neither will your -competitors be able to get an edge over you. You and they will compete in -other areas, while benefitting mutually in this one. If your business is -selling an operating system, you will not like GNU, but that's tough on -you. If your business is something else, GNU can save you from being -pushed into the expensive business of selling operating systems. - -I would like to see GNU development supported by gifts from many -manufacturers and users, reducing the cost to each. - -@quotation -``Don't programmers deserve a reward for their creativity?'' -@end quotation - -If anything deserves a reward, it is social contribution. Creativity can -be a social contribution, but only in so far as society is free to use the -results. If programmers deserve to be rewarded for creating innovative -programs, by the same token they deserve to be punished if they restrict -the use of these programs. - -@quotation -``Shouldn't a programmer be able to ask for a reward for his creativity?'' -@end quotation - -There is nothing wrong with wanting pay for work, or seeking to maximize -one's income, as long as one does not use means that are destructive. But -the means customary in the field of software today are based on -destruction. - -Extracting money from users of a program by restricting their use of it is -destructive because the restrictions reduce the amount and the ways that -the program can be used. This reduces the amount of wealth that humanity -derives from the program. When there is a deliberate choice to restrict, -the harmful consequences are deliberate destruction. - -The reason a good citizen does not use such destructive means to become -wealthier is that, if everyone did so, we would all become poorer from the -mutual destructiveness. This is Kantian ethics; or, the Golden Rule. -Since I do not like the consequences that result if everyone hoards -information, I am required to consider it wrong for one to do so. -Specifically, the desire to be rewarded for one's creativity does not -justify depriving the world in general of all or part of that creativity. - -@quotation -``Won't programmers starve?'' -@end quotation - -I could answer that nobody is forced to be a programmer. Most of us cannot -manage to get any money for standing on the street and making faces. But -we are not, as a result, condemned to spend our lives standing on the -street making faces, and starving. We do something else. - -But that is the wrong answer because it accepts the questioner's implicit -assumption: that without ownership of software, programmers cannot possibly -be paid a cent. Supposedly it is all or nothing. - -The real reason programmers will not starve is that it will still be -possible for them to get paid for programming; just not paid as much as -now. - -Restricting copying is not the only basis for business in software. It is -the most common basis because it brings in the most money. If it were -prohibited, or rejected by the customer, software business would move to -other bases of organization which are now used less often. There are -always numerous ways to organize any kind of business. - -Probably programming will not be as lucrative on the new basis as it is -now. But that is not an argument against the change. It is not considered -an injustice that sales clerks make the salaries that they now do. If -programmers made the same, that would not be an injustice either. (In -practice they would still make considerably more than that.) - -@quotation -``Don't people have a right to control how their creativity is used?'' -@end quotation - -``Control over the use of one's ideas'' really constitutes control over -other people's lives; and it is usually used to make their lives more -difficult. - -People who have studied the issue of intellectual property rights carefully -(such as lawyers) say that there is no intrinsic right to intellectual -property. The kinds of supposed intellectual property rights that the -government recognizes were created by specific acts of legislation for -specific purposes. - -For example, the patent system was established to encourage inventors to -disclose the details of their inventions. Its purpose was to help society -rather than to help inventors. At the time, the life span of 17 years for -a patent was short compared with the rate of advance of the state of the -art. Since patents are an issue only among manufacturers, for whom the -cost and effort of a license agreement are small compared with setting up -production, the patents often do not do much harm. They do not obstruct -most individuals who use patented products. - -The idea of copyright did not exist in ancient times, when authors -frequently copied other authors at length in works of non-fiction. This -practice was useful, and is the only way many authors' works have survived -even in part. The copyright system was created expressly for the purpose -of encouraging authorship. In the domain for which it was -invented---books, which could be copied economically only on a printing -press---it did little harm, and did not obstruct most of the individuals -who read the books. - -All intellectual property rights are just licenses granted by society -because it was thought, rightly or wrongly, that society as a whole would -benefit by granting them. But in any particular situation, we have to ask: -are we really better off granting such license? What kind of act are we -licensing a person to do? - -The case of programs today is very different from that of books a hundred -years ago. The fact that the easiest way to copy a program is from one -neighbor to another, the fact that a program has both source code and -object code which are distinct, and the fact that a program is used rather -than read and enjoyed, combine to create a situation in which a person who -enforces a copyright is harming society as a whole both materially and -spiritually; in which a person should not do so regardless of whether the -law enables him to. - -@quotation -``Competition makes things get done better.'' -@end quotation - -The paradigm of competition is a race: by rewarding the winner, we -encourage everyone to run faster. When capitalism really works this way, -it does a good job; but its defenders are wrong in assuming it always works -this way. If the runners forget why the reward is offered and become -intent on winning, no matter how, they may find other strategies---such as, -attacking other runners. If the runners get into a fist fight, they will -all finish late. - -Proprietary and secret software is the moral equivalent of runners in a -fist fight. Sad to say, the only referee we've got does not seem to -object to fights; he just regulates them (``For every ten yards you run, -you can fire one shot''). He really ought to break them up, and penalize -runners for even trying to fight. - -@quotation -``Won't everyone stop programming without a monetary incentive?'' -@end quotation - -Actually, many people will program with absolutely no monetary incentive. -Programming has an irresistible fascination for some people, usually the -people who are best at it. There is no shortage of professional musicians -who keep at it even though they have no hope of making a living that way. - -But really this question, though commonly asked, is not appropriate to the -situation. Pay for programmers will not disappear, only become less. So -the right question is, will anyone program with a reduced monetary -incentive? My experience shows that they will. - -For more than ten years, many of the world's best programmers worked at the -Artificial Intelligence Lab for far less money than they could have had -anywhere else. They got many kinds of non-monetary rewards: fame and -appreciation, for example. And creativity is also fun, a reward in itself. -@page -Then most of them left when offered a chance to do the same interesting -work for a lot of money. - -What the facts show is that people will program for reasons other than -riches; but if given a chance to make a lot of money as well, they will -come to expect and demand it. Low-paying organizations do poorly in -competition with high-paying ones, but they do not have to do badly if the -high-paying ones are banned. - -@quotation -``We need the programmers desperately. If they demand that we -stop helping our neighbors, we have to obey.'' -@end quotation - -You're never so desperate that you have to obey this sort of demand. -Remember: millions for defense, but not a cent for tribute! - -@quotation -``Programmers need to make a living somehow.'' -@end quotation - -In the short run, this is true. However, there are plenty of ways that -programmers could make a living without selling the right to use a program. -This way is customary now because it brings programmers and businessmen the -most money, not because it is the only way to make a living. It is easy to -find other ways if you want to find them. Here are a number of examples. - -A manufacturer introducing a new computer will pay for the porting of -operating systems onto the new hardware. - -The sale of teaching, hand-holding, and maintenance services could also -employ programmers. - -People with new ideas could distribute programs as freeware and ask for -donations from satisfied users or sell hand-holding services. I have -met people who are already working this way successfully. - -Users with related needs can form users' groups and pay dues. A group -would contract with programming companies to write programs that the -group's members would like to use. - -All sorts of development can be funded with a Software Tax: - -@quotation -Suppose everyone who buys a computer has to pay a certain percent of -the price as a software tax. The government gives this to -an agency like the NSF to spend on software development. - -But if the computer buyer makes a donation to software development -himself, he can take a credit against the tax. He can donate to -the project of his own choosing---often, chosen because he hopes to -use the results when -@page -it is done. He can take a credit for any amount -of donation up to the total tax he had to pay. - -The total tax rate could be decided by a vote of the payers of -the tax, weighted according to the amount they will be taxed on. - -The consequences: - -@itemize @bullet -@item -The computer-using community supports software development. -@item -This community decides what level of support is needed. -@item -Users who care which projects their share is spent on -can choose this for themselves. -@end itemize -@end quotation - -In the long run, making programs free is a step toward the post-scarcity -world, where nobody will have to work very hard just to make a living. -People will be free to devote themselves to activities that are fun, such -as programming, after spending the necessary ten hours a week on required -tasks such as legislation, family counseling, robot repair, and asteroid -prospecting. There will be no need to be able to make a living from -programming. - -We have already greatly reduced the amount of work that the whole society -must do for its actual productivity, but only a little of this has -translated itself into leisure for workers because much nonproductive -activity is required to accompany productive activity. The main causes of -this are bureaucracy and isometric struggles against competition. Free -software will greatly reduce these drains in the area of software -production. We must do this, in order for technical gains in productivity -to translate into less work for us. diff --git a/man/xemacs/help.texi b/man/xemacs/help.texi deleted file mode 100644 index 2b517fc..0000000 --- a/man/xemacs/help.texi +++ /dev/null @@ -1,265 +0,0 @@ - -@node Help, Mark, M-x, Top -@chapter Help -@cindex help -@cindex self-documentation - - Emacs provides extensive help features which revolve around a single -character, @kbd{C-h}. @kbd{C-h} is a prefix key that is used only for -documentation-printing commands. The characters you can type after -@kbd{C-h} are called @dfn{help options}. One help option is @kbd{C-h}; -you use it to ask for help about using @kbd{C-h}. - - @kbd{C-h C-h} prints a list of the possible help options, and then asks -you to type the desired option. It prompts with the string: - -@smallexample -A, B, C, F, I, K, L, M, N, S, T, V, W, C-c, C-d, C-n, C-w or C-h for more help: -@end smallexample - -@noindent -You should type one of those characters. - - Typing a third @kbd{C-h} displays a description of what the options mean; -Emacs still waits for you to type an option. To cancel, type @kbd{C-g}. - - Here is a summary of the defined help commands. - -@table @kbd -@item C-h a @var{string} @key{RET} -Display a list of commands whose names contain @var{string} -(@code{command-@*apropos}).@refill -@item C-h b -Display a table of all key bindings currently in effect, with local bindings of -the current major mode first, followed by all global bindings -(@code{describe-bindings}). -@item C-h c @var{key} -Print the name of the command that @var{key} runs (@code{describe-key-@*briefly}). -@kbd{c} is for `character'. For more extensive information on @var{key}, -use @kbd{C-h k}. -@item C-h f @var{function} @key{RET} -Display documentation on the Lisp function named @var{function} -(@code{describe-function}). Note that commands are Lisp functions, so -a command name may be used. -@item C-h i -Run Info, the program for browsing documentation files (@code{info}). -The complete Emacs manual is available online in Info. -@item C-h k @var{key} -Display name and documentation of the command @var{key} runs (@code{describe-key}). -@item C-h l -Display a description of the last 100 characters you typed -(@code{view-lossage}). -@item C-h m -Display documentation of the current major mode (@code{describe-mode}). -@item C-h n -Display documentation of Emacs changes, most recent first -(@code{view-emacs-news}). -@item C-h p -Display a table of all mouse bindings currently in effect now, with -local bindings of the current major mode first, followed by all global bindings -(@code{describe-pointer}). -@item C-h s -Display current contents of the syntax table, plus an explanation of -what they mean (@code{describe-syntax}). -@item C-h t -Display the Emacs tutorial (@code{help-with-tutorial}). -@item C-h v @var{var} @key{RET} -Display the documentation of the Lisp variable @var{var} -(@code{describe-@*variable}). -@item C-h w @var{command} @key{RET} -Print which keys run the command named @var{command} (@code{where-is}). -@item M-x apropos @var{regexp} -Show all symbols whose names contain matches for @var{regexp}. -@end table - -@section Documentation for a Key - -@kindex C-h c -@findex describe-key-briefly - The most basic @kbd{C-h} options are @kbd{C-h c} -(@code{describe-key-briefly}) and @kbd{C-h k}@*(@code{describe-key}). -@kbd{C-h c @var{key}} prints the name of the command that @var{key} is -bound to in the echo area. For example, @kbd{C-h c C-f} prints -@samp{forward-char}. Since command names are chosen to describe what -the command does, using this option is a good way to get a somewhat cryptic -description of what @var{key} does.@refill - -@kindex C-h k -@findex describe-key - @kbd{C-h k @var{key}} is similar to @kbd{C-h c} but gives more -information. It displays the documentation string of the function -@var{key} is bound to as well as its name. @var{key} is a string or -vector of events. When called interactively, @var{key} may also be a menu -selection. This information does not usually fit into the echo area, so a -window is used for the display. - -@section Help by Command or Variable Name - -@kindex C-h f -@findex describe-function -@vindex describe-function-show-arglist - @kbd{C-h f} (@code{describe-function}) reads the name of a Lisp -function using the minibuffer, then displays that function's -documentation string in a window. Since commands are Lisp functions, -you can use the argument @var{function} to get the documentation of a -command that you know by name. For example, - -@example -C-h f auto-fill-mode @key{RET} -@end example - -@noindent -displays the documentation for @code{auto-fill-mode}. Using @kbd{C-h f} -is the only way to see the documentation of a command that is not bound -to any key, that is, a command you would normally call using @kbd{M-x}. -If the variable @code{describe-function-show-arglist} is @code{t}, -@code{describe-function} shows its arglist if the @var{function} is not -an autoload function. - - @kbd{C-h f} is also useful for Lisp functions you are planning to -use in a Lisp program. For example, if you have just written the code -@code{(make-vector len)} and want to make sure you are using -@code{make-vector} properly, type @kbd{C-h f make-vector @key{RET}}. Because -@kbd{C-h f} allows all function names, not just command names, you may find -that some of your favorite abbreviations that work in @kbd{M-x} don't work -in @kbd{C-h f}. An abbreviation may be unique among command names, yet fail -to be unique when other function names are allowed. - - -If you type @key{RET}, leaving the minibuffer empty, @kbd{C-h f} by -default describes the function called by the innermost Lisp expression -in the buffer around point, @i{provided} that that is a valid, defined Lisp -function name. For example, if point is located following the text -@samp{(make-vector (car x)}, the innermost list containing point is the -one starting with @samp{(make-vector}, so the default is to describe -the function @code{make-vector}. - - @kbd{C-h f} is often useful just to verify that you have the right -spelling for the function name. If @kbd{C-h f} mentions a default in the -prompt, you have typed the name of a defined Lisp function. If that is -what you wanted to know, just type @kbd{C-g} to cancel the @kbd{C-h f} -command and continue editing. - -@kindex C-h w -@findex where-is - @kbd{C-h w @var{command} @key{RET}} (@code{where-s}) tells you what -keys are bound to @var{command}. It prints a list of the keys in the -echo area. Alternatively, it informs you that a command is not bound to -any keys, which implies that you must use @kbd{M-x} to call the -command.@refill - -@kindex C-h v -@findex describe-variable - @kbd{C-h v} (@code{describe-variable}) is like @kbd{C-h f} but -describes Lisp variables instead of Lisp functions. Its default is the -Lisp symbol around or before point, if that is the name of a known Lisp -variable. @xref{Variables}.@refill - -@section Apropos - -@kindex C-h a -@findex command-apropos -@cindex apropos - -@table @kbd -@item C-h a -Show only symbols that are names of commands -(@code{command-apropos}).@refill - -@item M-x apropos @var{regexp} -Show all symbols whose names comtain matches for @var{regexp}. -@end table - - It is possible to ask a question like, ``What are the commands for -working with files?'' To do this, type @kbd{C-h a file @key{RET}}, -which displays a list of all command names that contain @samp{file}, -such as @code{copy-file}, @code{find-file}, and so on. With each -command name a brief description of its use and information on the keys -you can use to invoke it is displayed. For example, you would be -informed that you can invoke @code{find-file} by typing @kbd{C-x C-f}. -The @kbd{a} in @kbd{C-h a} stands for `Apropos'; @kbd{C-h a} runs the -Lisp function @code{command-apropos}.@refill - - Because @kbd{C-h a} looks only for functions whose names contain the -string you specify, you must use ingenuity in choosing the string. If -you are looking for commands for killing backwards and @kbd{C-h a -kill-backwards @key{RET}} doesn't reveal any commands, don't give up. -Try just @kbd{kill}, or just @kbd{backwards}, or just @kbd{back}. Be -persistent. Pretend you are playing Adventure. Also note that you can -use a regular expression as the argument (@pxref{Regexps}). - - Here is a set of arguments to give to @kbd{C-h a} that covers many -classes of Emacs commands, since there are strong conventions for naming -standard Emacs commands. By giving you a feeling for the naming -conventions, this set of arguments can also help you develop a -technique for picking @code{apropos} strings. - -@quotation -char, line, word, sentence, paragraph, region, page, sexp, list, defun, -buffer, frame, window, file, dir, register, mode, -beginning, end, forward, backward, next, previous, up, down, search, goto, -kill, delete, mark, insert, yank, fill, indent, case, -change, set, what, list, find, view, describe. -@end quotation - -@findex apropos - To list all Lisp symbols that contain a match for a regexp, not just -the ones that are defined as commands, use the command @kbd{M-x apropos} -instead of @kbd{C-h a}. - -@section Other Help Commands - -@kindex C-h i -@findex info - @kbd{C-h i} (@code{info}) runs the Info program, which is used for -browsing through structured documentation files. The entire Emacs manual -is available within Info. Eventually all the documentation of the GNU -system will be available. Type @kbd{h} after entering Info to run -a tutorial on using Info. - -@kindex C-h l -@findex view-lossage - If something surprising happens, and you are not sure what commands you -typed, use @kbd{C-h l} (@code{view-lossage}). @kbd{C-h l} prints the last -100 command characters you typed. If you see commands you don't -know, use @kbd{C-h c} to find out what they do. - -@kindex C-h m -@findex describe-mode - Emacs has several major modes. Each mode redefines a few keys and -makes a few other changes in how editing works. @kbd{C-h m} -(@code{describe-mode}) prints documentation on the current major mode, -which normally describes all the commands that are changed in this mode. - -@kindex C-h b -@findex describe-bindings - @kbd{C-h b} (@code{describe-bindings}) and @kbd{C-h s} -(@code{describe-syntax}) present information about the current Emacs -mode that is not covered by @kbd{C-h m}. @kbd{C-h b} displays a list of -all key bindings currently in effect, with the local bindings of the current -major mode first, followed by the global bindings (@pxref{Key -Bindings}). @kbd{C-h s} displays the contents of the syntax table with -explanations of each character's syntax (@pxref{Syntax}).@refill - -@kindex C-h n -@findex view-emacs-news -@kindex C-h t -@findex help-with-tutorial -@kindex C-h C-c -@findex describe-copying -@kindex C-h C-d -@findex describe-distribution -@kindex C-h C-w -@findex describe-no-warranty - The other @kbd{C-h} options display various files of useful -information. @kbd{C-h C-w} (@code{describe-no-warranty}) displays -details on the complete absence of warranty for XEmacs. @kbd{C-h n} -(@code{view-emacs-news}) displays the file @file{emacs/etc/NEWS}, which -contains documentation on Emacs changes arranged chronologically. -@kbd{C-h t} (@code{help-with-tutorial}) displays the learn-by-doing -Emacs tutorial. @kbd{C-h C-c} (@code{describe-copying}) displays the file -@file{emacs/etc/COPYING}, which tells you the conditions you must obey -in distributing copies of Emacs. @kbd{C-h C-d} -(@code{describe-distribution}) displays another file named -@file{emacs/etc/DISTRIB}, which tells you how you can order a copy of -the latest version of Emacs.@refill diff --git a/man/xemacs/keystrokes.texi b/man/xemacs/keystrokes.texi deleted file mode 100644 index 6be81fc..0000000 --- a/man/xemacs/keystrokes.texi +++ /dev/null @@ -1,516 +0,0 @@ - -@node Keystrokes, Pull-down Menus, Frame, Top -@chapter Keystrokes, Key Sequences, and Key Bindings - -@iftex - This chapter discusses the character set Emacs uses for input commands -and inside files. You have already learned that the more frequently -used Emacs commands are bound to keys. For example, @kbd{Control-f} is -bound to @code{forward-char}. The following issues are covered: - -@itemize @bullet -@item -How keystrokes can be represented -@item -How you can create key sequences from keystrokes -@item -How you can add to the available modifier keys by customizing your -keyboard: for example, you could have the -@key{Capslock} key be understood as the @key{Super} key by Emacs. A -@key{Super} key is used like @key{Control} or @key{Meta} in that you hold -it while typing another key. -@end itemize - - You will also learn how to customize existing key bindings and -create new ones. -@end iftex - -@menu -* Intro to Keystrokes:: Keystrokes as building blocks of key sequences. -* Representing Keystrokes:: Using lists of modifiers and keysyms to - represent keystrokes. -* Key Sequences:: Combine key strokes into key sequences you can - bind to commands. -* String Key Sequences:: Available for upward compatibility. -* Meta Key:: Using @key{ESC} to represent @key{Meta} -* Super and Hyper Keys:: Adding modifier keys on certain keyboards. -* Character Representation:: How characters appear in Emacs buffers. -* Commands:: How commands are bound to key sequences. -@end menu - -@node Intro to Keystrokes, Representing Keystrokes, Keystrokes, Keystrokes -@section Keystrokes as Building Blocks of Key Sequences -@cindex character set -@cindex ASCII -@cindex keystroke - - Earlier versions of Emacs used only the ASCII character set, -which defines 128 different character codes. Some of these codes are -assigned graphic symbols like @samp{a} and @samp{=}; the rest are -control characters, such as @kbd{Control-a} (also called @kbd{C-a}). -@kbd{C-a} means you hold down the @key{CTRL} key and then press -@kbd{a}.@refill - - Keybindings in XEmacs are not restricted to the set of -keystrokes that can be represented in ASCII. XEmacs can tell the -difference between, for example, @kbd{Control-h}, @kbd{Control-Shift-h}, -and @kbd{Backspace}. - -@cindex modifier key -@cindex keysym -@kindex meta key -@kindex control key -@kindex hyper key -@kindex super key -@kindex shift key -@kindex button1 -@kindex button2 -@kindex button3 -@kindex button1up -@kindex button2up -@kindex button3up - - A keystroke is like a piano chord: you get it by simultaneously -striking several keys. To be more precise, a keystroke consists -of a possibly empty set of modifiers followed by a single -@dfn{keysym}. The set of modifiers is small; it consists of -@kbd{Control}, @kbd{Meta}, @kbd{Super}, @kbd{Hyper}, and @kbd{Shift}. - - The rest of the keys on your keyboard, along with the mouse buttons, -make up the set of keysyms. A keysym is usually what is printed on the -keys on your keyboard. Here is a table of some of the symbolic names -for keysyms: -@table @kbd -@item a,b,c... -alphabetic keys -@item f1,f2... -function keys -@item button1 -left mouse button -@item button2 -middle mouse button -@item button3 -right mouse button -@item button1up -upstroke on the left mouse button -@item button2up -upstroke on the middle mouse button -@item button3up -upstroke on the right mouse button -@item return -Return key -@end table - -@vindex keyboard-translate-table -Use the variable @code{keyboard-translate-table} only if you are on a -dumb tty, as it cannot handle input that cannot be represented as ASCII. -The value of this variable is a string used as a translate table for -keyboard input or @code{nil}. Each character is looked up in this -string and the contents used instead. If the string is of length -@code{n}, character codes @code{N} and up are untranslated. If you are -running Emacs under X, you should do the translations with the -@code{xmodmap} program instead. - - -@node Representing Keystrokes, Key Sequences, Intro to Keystrokes, Keystrokes -@comment node-name, next, previous, up -@subsection Representing Keystrokes -@kindex hyper key -@kindex super key -@findex read-key-sequence - - XEmacs represents keystrokes as lists. Each list consists of -an arbitrary combination of modifiers followed by a single keysym at the -end of the list. If the keysym corresponds to an ASCII character, you -can use its character code. (A keystroke may also be represented by an -event object, as returned by the @code{read-key-sequence} function; -non-programmers need not worry about this.) - -The following table gives some examples of how to list representations -for keystrokes. Each list consists of sets of modifiers followed by -keysyms: - -@table @kbd -@item (control a) -Pressing @key{CTRL} and @kbd{a} simultaneously. -@item (control ?a) -Another way of writing the keystroke @kbd{C-a}. -@item (control 65) -Yet another way of writing the keystroke @kbd{C-a}. -@item (break) -Pressing the @key{BREAK} key. -@item (control meta button2up) -Release the middle mouse button, while pressing @key{CTRL} and -@key{META}. -@end table -@cindex shift modifer - Note: As you define keystrokes, you can use the @kbd{shift} key only -as a modifier with characters that do not have a second keysym on the -same key, such as @kbd{backspace} and @kbd{tab}. It is an error to -define a keystroke using the @key{shift} modifier with keysyms such as -@kbd{a} and @kbd{=}. The correct forms are @kbd{A} and @kbd{+}. - -@node Key Sequences, String Key Sequences, Representing Keystrokes, Keystrokes -@subsection Representing Key Sequences - - A @dfn{complete key sequence} is a sequence of keystrokes that Emacs -understands as a unit. Key sequences are significant because you can -bind them to commands. Note that not all sequences of keystrokes are -possible key sequences. In particular, the initial keystrokes in a key -sequence must make up a @dfn{prefix key sequence}. - - Emacs represents a key sequence as a vector of keystrokes. Thus, the -schematic representation of a complete key sequence is as follows: - -@example - [(modifier .. modifer keysym) ... (modifier .. modifier keysym)] -@end example - - Here are some examples of complete key sequences: - -@table @kbd -@item [(control c) (control a)] -Typing @kbd{C-c} followed by @kbd{C-a} -@item [(control c) (control 65)] -Typing @kbd{C-c} followed by @kbd{C-a}. (Using the ASCII code -for the character `a')@refill -@item [(control c) (break)] -Typing @kbd{C-c} followed by the @kbd{break} character.@refill -@end table - -@kindex C-c -@kindex C-x -@kindex C-h -@kindex ESC -@cindex prefix key sequence - - A @dfn{prefix key sequence} is the beginning of a series of longer -sequences that are valid key sequences; adding any single keystroke to -the end of a prefix results in a valid key sequence. For example, -@kbd{control-x} is standardly defined as a prefix. Thus there is a -two-character key sequence starting with @kbd{C-x} for each valid -keystroke, giving numerous possibilities. Here are some samples: - -@itemize @bullet -@item -@kbd{[(control x) (c)]} -@item -@kbd{[(control x) (control c)]} -@end itemize - - Adding one character to a prefix key does not have to form a complete -key. It could make another, longer prefix. For example, @kbd{[(control -x) (\4)]} is itself a prefix that leads to any number of different -three-character keys, including @kbd{[(control x) (\4) (f)]}, -@kbd{[(control x) (\4) (b)]} and so on. It would be possible to define -one of those three-character sequences as a prefix, creating a series of -four-character keys, but we did not define any of them this way.@refill - - By contrast, the two-character sequence @kbd{[(control f) (control -k)]} is not a key, because the @kbd{(control f)} is a complete key -sequence in itself. You cannot give @kbd{[(control f (control k)]} an -independent meaning as a command while @kbd{(control f)} is a complete -sequence, because Emacs would understand @key{C-f C-k} as two -commands.@refill - - The predefined prefix key sequences in Emacs are @kbd{(control c)}, -@kbd{(control x)}, @kbd{(control h)}, @kbd{[(control x) (\4)]}, and -@kbd{escape}. You can customize Emacs and could make new prefix keys or -eliminate the default key sequences. @xref{Key Bindings}. For example, -if you redefine @kbd{(control f)} as a prefix, @kbd{[(control f) -(control k)]} automatically becomes a valid key sequence (complete, -unless you define it as a prefix as well). Conversely, if you remove -the prefix definition of @kbd{[(control x) (\4)]}, @kbd{[(control x) -(\4) (f)]} (or @kbd{[(control x) (\4) @var{anything}]}) is no longer a -valid key sequence. - -Note that the above paragraphs uses \4 instead of simply 4, because \4 -is the symbol whose name is "4", and plain 4 is the integer 4, which -would have been interpreted as the ASCII value. Another way of -representing the symbol whose name is "4" is to write ?4, which would be -interpreted as the number 52, which is the ASCII code for the character -"4". We could therefore actually have written 52 directly, but that is -far less clear. - -@node String Key Sequences, Meta Key, Key Sequences, Keystrokes -@comment node-name, next, previous, up -@subsection String Key Sequences -For backward compatibility, you may also represent a key sequence using -strings. For example, we have the following equivalent representations: - -@table @kbd -@item "\C-c\C-c" -@code{[(control c) (control c)]} -@item "\e\C-c" -@code{[(meta control c)]} -@end table - -@kindex LFD -@kindex TAB - -@node Meta Key, Super and Hyper Keys, String Key Sequences, Keystrokes -@comment node-name, next, previous, up -@subsection Assignment of the @key{META} Key - -@kindex META -@kindex ESC - Not all terminals have the complete set of modifiers. -Terminals that have a @key{Meta} key allow you to type Meta characters -by just holding that key down. To type @kbd{Meta-a}, hold down -@key{META} and press @kbd{a}. On those terminals, the @key{META} key -works like the @key{SHIFT} key. Such a key is not always labeled -@key{META}, however, as this function is often a special option for a -key with some other primary purpose.@refill - - If there is no @key{META} key, you can still type Meta characters -using two-character sequences starting with @key{ESC}. To enter -@kbd{M-a}, you could type @kbd{@key{ESC} a}. To enter @kbd{C-M-a}, you -would type @kbd{ESC C-a}. @key{ESC} is allowed on terminals with -Meta keys, too, in case you have formed a habit of using it.@refill - -If you are running under X and do not have a @key{META} key, it -is possible to reconfigure some other key to be a @key{META} -key. @xref{Super and Hyper Keys}. @refill - -@vindex meta-flag - Emacs believes the terminal has a @key{META} key if the variable -@code{meta-flag} is non-@code{nil}. Normally this is set automatically -according to the termcap entry for your terminal type. However, sometimes -the termcap entry is wrong, and then it is useful to set this variable -yourself. @xref{Variables}, for how to do this. - -Note: If you are running under the X window system, the setting of -the @code{meta-flag} variable is irrelevant. - -@node Super and Hyper Keys, Character Representation, Meta Key, Keystrokes -@comment node-name, next, previous, up -@subsection Assignment of the @key{SUPER} and @key{HYPER} Keys -@kindex hyper key -@kindex super key - - Most keyboards do not, by default, have @key{SUPER} or @key{HYPER} -modifier keys. Under X, you can simulate the @key{SUPER} or -@key{HYPER} key if you want to bind keys to sequences using @kbd{super} -and @kbd{hyper}. You can use the @code{xmodmap} program to do this. - - For example, to turn your @key{CAPS-LOCK} key into a @key{SUPER} key, -do the following: - - Create a file called @code{~/.xmodmap}. In this file, place the lines - -@example - remove Lock = Caps_Lock - keysym Caps_Lock = Super_L - add Mod2 = Super_L -@end example - -The first line says that the key that is currently called @code{Caps_Lock} -should no longer behave as a ``lock'' key. The second line says that -this should now be called @code{Super_L} instead. The third line says that -the key called @code{Super_L} should be a modifier key, which produces the -@code{Mod2} modifier. - -To create a @key{META} or @key{HYPER} key instead of a @key{SUPER} key, -replace the word @code{Super} above with @code{Meta} or @code{Hyper}. - -Just after you start up X, execute the command @code{xmodmap /.xmodmap}. -You can add this command to the appropriate initialization file to have -the command executed automatically.@refill - -If you have problems, see the documentation for the @code{xmodmap} -program. The X keyboard model is quite complicated, and explaining -it is beyond the scope of this manual. However, we reprint the -following description from the X Protocol document for your convenience: - -@cindex keysyms -@cindex keycode - - A list of keysyms is associated with each keycode. If that list -(ignoring trailing @code{NoSymbol} entries) is a single keysym @samp{K}, -then the list is treated as if it were the list -@code{``K NoSymbol K NoSymbol''}. If the list (ignoring trailing -@code{NoSymbol} entries) is a pair of keysyms @samp{K1 K2}, then the -list is treated as if it were the list @code{``K1 K2 K1 K2''}. If the -list (ignoring trailing @code{NoSymbol} entries) is a triple of keysyms -@samp{K1 K2 K3}, then the list is treated as if it were the list -@code{``K1 K2 K3 NoSymbol''}. - - The first four elements of the list are split into two groups of -keysyms. Group 1 contains the first and second keysyms; Group 2 contains -third and fourth keysyms. Within each group, if the second element of -the group is NoSymbol, then the group should be treated as if the second -element were the same as the first element, except when the first -element is an alphabetic keysym @samp{K} for which both lowercase and -uppercase forms are defined. In that case, the group should be treated -as if the first element were the lowercase form of @samp{K} and the second -element were the uppercase form of @samp{K}. - - The standard rules for obtaining a keysym from a KeyPress event make use of -only the Group 1 and Group 2 keysyms; no interpretation of other keysyms in -the list is given here. (That is, the last four keysyms are unused.) - - Which group to use is determined by modifier state. Switching between -groups is controlled by the keysym named @code{Mode_switch}. Attach that -keysym to some keycode and attach that keycode to any one of the -modifiers Mod1 through Mod5. This modifier is called the @dfn{group -modifier}. For any keycode, Group 1 is used when the group modifier is -off, and Group 2 is used when the group modifier is on. - - Within a group, which keysym to use is also determined by modifier -state. The first keysym is used when the @code{Shift} and @code{Lock} -modifiers are off. The second keysym is used when the @code{Shift} -modifier is on, or when the @code{Lock} modifier is on and the second -keysym is uppercase alphabetic, or when the @code{Lock} modifier is on -and is interpreted as @code{ShiftLock}. Otherwise, when the @code{Lock} -modifier is on and is interpreted as @code{CapsLock}, the state of the -@code{Shift} modifier is applied first to select a keysym, -but if that keysym is lower-case alphabetic, then the corresponding -upper-case keysym is used instead. - - In addition to the above information on keysyms, we also provide the -following description of modifier mapping from the InterClient -Communications Conventions Manual: - -@cindex modifier mapping - - X11 supports 8 modifier bits, of which 3 are pre-assigned to -@code{Shift}, @code{Lock}, and @code{Control}. Each modifier bit is -controlled by the state of a set of keys, and these sets are specified -in a table accessed by @code{GetModifierMapping()} and -@code{SetModifierMapping()}. - - A client needing to use one of the pre-assigned modifiers should assume -that the modifier table has been set up correctly to control these -modifiers. The @code{Lock} modifier should be interpreted as @code{Caps -Lock} or @code{Shift Lock} according to whether the keycodes in its -controlling set include @code{XK_Caps_Lock} or @code{XK_Shift_Lock}. - - Clients should determine the meaning of a modifier bit from the keysyms -being used to control it. - -A client needing to use an extra modifier, for example @code{Meta}, should: - -@enumerate -@item -Scan the existing modifier mappings. - -@enumerate -@item -If it finds a modifier that contains a keycode whose set of keysyms -includes @code{XK_Meta_L} or @code{XK_Meta_R}, it should use that -modifier bit. - -@item -If there is no existing modifier controlled by @code{XK_Meta_L} or -@code{XK_Meta_R}, it should select an unused modifier bit (one with -an empty controlling set) and: -@end enumerate - -@item -If there is a keycode with @code{XL_Meta_L} in its set of keysyms, -add that keycode to the set for the chosen modifier, and then: - -@enumerate -@item -If there is a keycode with @code{XL_Meta_R} in its set of keysyms, -add that keycode to the set for the chosen modifier, and then: - -@item -If the controlling set is still empty, interact with the user to -select one or more keys to be @code{Meta}. -@end enumerate - - -@item -If there are no unused modifier bits, ask the user to take corrective action. -@end enumerate - - This means that the @code{Mod1} modifier does not necessarily mean -@code{Meta}, although some applications (such as twm and emacs 18) -assume that. Any of the five unassigned modifier bits could mean -@code{Meta}; what matters is that a modifier bit is generated by a -keycode which is bound to the keysym @code{Meta_L} or @code{Meta_R}. - - Therefore, if you want to make a @key{META} key, the right way -is to make the keycode in question generate both a @code{Meta} keysym -and some previously-unassigned modifier bit. - -@node Character Representation, Commands, Super and Hyper Keys, Keystrokes -@comment node-name, next, previous, up -@section Representation of Characters - -This section briefly discusses how characters are represented in Emacs -buffers. @xref{Key Sequences} for information on representing key -sequences to create key bindings. - - ASCII graphic characters in Emacs buffers are displayed with their -graphics. @key{LFD} is the same as a newline character; it is displayed -by starting a new line. @key{TAB} is displayed by moving to the next -tab stop column (usually every 8 spaces). Other control characters are -displayed as a caret (@samp{^}) followed by the non-control version of -the character; thus, @kbd{C-a} is displayed as @samp{^A}. Non-ASCII -characters 128 and up are displayed with octal escape sequences; thus, -character code 243 (octal), also called @kbd{M-#} when used as an input -character, is displayed as @samp{\243}. - -The variable @code{ctl-arrow} may be used to alter this behavior. -@xref{Display Vars}. - -@node Commands, , Character Representation, Keystrokes -@section Keys and Commands - -@cindex binding -@cindex customization -@cindex keymap -@cindex function -@cindex command - This manual is full of passages that tell you what particular keys do. -But Emacs does not assign meanings to keys directly. Instead, Emacs -assigns meanings to @dfn{functions}, and then gives keys their meanings -by @dfn{binding} them to functions. - - A function is a Lisp object that can be executed as a program. Usually -it is a Lisp symbol that has been given a function definition; every -symbol has a name, usually made of a few English words separated by -dashes, such as @code{next-line} or @code{forward-word}. It also has a -@dfn{definition}, which is a Lisp program. Only some functions can be the -bindings of keys; these are functions whose definitions use -@code{interactive} to specify how to call them interactively. Such -functions are called @dfn{commands}, and their names are @dfn{command -names}. More information on this subject will appear in the @i{XEmacs -Lisp Reference Manual}. - - The bindings between keys and functions are recorded in various tables -called @dfn{keymaps}. @xref{Key Bindings} for more information on key -sequences you can bind commands to. @xref{Keymaps} for information on -creating keymaps. - - When we say ``@kbd{C-n} moves down vertically one line'' we are -glossing over a distinction that is irrelevant in ordinary use but is -vital in understanding how to customize Emacs. The function -@code{next-line} is programmed to move down vertically. @kbd{C-n} -has this effect @i{because} it is bound to that function. If you rebind -@kbd{C-n} to the function @code{forward-word} then @kbd{C-n} will move -forward by words instead. Rebinding keys is a common method of -customization.@refill - - The rest of this manual usually ignores this subtlety to keep -things simple. To give the customizer the information needed, we often -state the name of the command that really does the work in parentheses -after mentioning the key that runs it. For example, we will say that -``The command @kbd{C-n} (@code{next-line}) moves point vertically -down,'' meaning that @code{next-line} is a command that moves vertically -down and @kbd{C-n} is a key that is standardly bound to it. - -@cindex variables - While we are on the subject of information for customization only, -it's a good time to tell you about @dfn{variables}. Often the -description of a command will say, ``To change this, set the variable -@code{mumble-foo}.'' A variable is a name used to remember a value. -Most of the variables documented in this manual exist just to facilitate -customization: some command or other part of Emacs uses the variable -and behaves differently depending on its setting. Until you are interested in -customizing, you can ignore the information about variables. When you -are ready to be interested, read the basic information on variables, and -then the information on individual variables will make sense. -@xref{Variables}. diff --git a/man/xemacs/major.texi b/man/xemacs/major.texi deleted file mode 100644 index d214045..0000000 --- a/man/xemacs/major.texi +++ /dev/null @@ -1,113 +0,0 @@ - -@node Major Modes, Indentation, Mule, Top -@chapter Major Modes -@cindex major modes -@kindex TAB -@kindex DEL -@kindex LFD - - Emacs has many different @dfn{major modes}, each of which customizes -Emacs for editing text of a particular sort. The major modes are mutually -exclusive; at any time, each buffer has one major mode. The mode line -normally contains the name of the current major mode in parentheses. -@xref{Mode Line}. - - The least specialized major mode is called @dfn{Fundamental mode}. This -mode has no mode-specific redefinitions or variable settings. Each -Emacs command behaves in its most general manner, and each option is in its -default state. For editing any specific type of text, such as Lisp code or -English text, you should switch to the appropriate major mode, such as Lisp -mode or Text mode. - - Selecting a major mode changes the meanings of a few keys to become -more specifically adapted to the language being edited. @key{TAB}, -@key{DEL}, and @key{LFD} are changed frequently. In addition, commands -which handle comments use the mode to determine how to delimit comments. -Many major modes redefine the syntactical properties of characters -appearing in the buffer. @xref{Syntax}. - - The major modes fall into three major groups. Lisp mode (which has -several variants), C mode, and Muddle mode are for specific programming -languages. Text mode, Nroff mode, @TeX{} mode, and Outline mode are for -editing English text. The remaining major modes are not intended for use -on users' files; they are used in buffers created by Emacs for specific -purposes and include Dired mode for buffers made by Dired (@pxref{Dired}), -Mail mode for buffers made by @kbd{C-x m} (@pxref{Sending Mail}), and Shell -mode for buffers used for communicating with an inferior shell process -(@pxref{Interactive Shell}). - - Most programming language major modes specify that only blank lines -separate paragraphs. This is so that the paragraph commands remain useful. -@xref{Paragraphs}. They also cause Auto Fill mode to use the definition of -@key{TAB} to indent the new lines it creates. This is because most lines -in a program are usually indented. @xref{Indentation}. - -@menu -* Choosing Modes:: How major modes are specified or chosen. -@end menu - -@node Choosing Modes,,Major Modes,Major Modes -@section Choosing Major Modes - - You can select a major mode explicitly for the current buffer, but -most of the time Emacs determines which mode to use based on the file -name or some text in the file. - - Use a @kbd{M-x} command to explicitly select a new major mode. Add -@code{-mode} to the name of a major mode to get the name of a command to -select that mode. For example, to enter Lisp mode, execute @kbd{M-x -lisp-mode}. - -@vindex auto-mode-alist - When you visit a file, Emacs usually chooses the right major mode -based on the file's name. For example, files whose names end in -@code{.c} are edited in C mode. The variable @code{auto-mode-alist} -controls the correspondence between file names and major mode. Its value -is a list in which each element has the form: - -@example -(@var{regexp} . @var{mode-function}) -@end example - -@noindent -For example, one element normally found in the list has the form -@code{(@t{"\\.c$"} . c-mode)}. It is responsible for selecting C mode -for files whose names end in @file{.c}. (Note that @samp{\\} is needed in -Lisp syntax to include a @samp{\} in the string, which is needed to -suppress the special meaning of @samp{.} in regexps.) The only practical -way to change this variable is with Lisp code. - - You can specify which major mode should be used for editing a certain -file by a special sort of text in the first non-blank line of the file. -The mode name should appear in this line both preceded and followed by -@samp{-*-}. Other text may appear on the line as well. For example, - -@example -;-*-Lisp-*- -@end example - -@noindent -tells Emacs to use Lisp mode. Note how the semicolon is used to make Lisp -treat this line as a comment. Such an explicit specification overrides any -default mode based on the file name. - - Another format of mode specification is: - -@example --*-Mode: @var{modename};-*- -@end example - -@noindent -which allows other things besides the major mode name to be specified. -However, Emacs does not look for anything except the mode name. - -The major mode can also be specified in a local variables list. -@xref{File Variables}. - -@vindex default-major-mode - When you visit a file that does not specify a major mode to use, or -when you create a new buffer with @kbd{C-x b}, Emacs uses the major mode -specified by the variable @code{default-major-mode}. Normally this -value is the symbol @code{fundamental-mode}, which specifies Fundamental -mode. If @code{default-major-mode} is @code{nil}, the major mode is -taken from the previously selected buffer. diff --git a/man/xemacs/mark.texi b/man/xemacs/mark.texi deleted file mode 100644 index 0d18a13..0000000 --- a/man/xemacs/mark.texi +++ /dev/null @@ -1,240 +0,0 @@ - -@node Mark, Mouse Selection, Help, Top -@chapter Selecting Text -@cindex mark -@cindex region - - Many Emacs commands operate on an arbitrary contiguous -part of the current buffer. You can select text in two ways: - -@itemize @bullet -@item -You use special keys to select text by defining a region between point -and the mark. -@item -If you are running XEmacs under X, you can also select text -with the mouse. -@end itemize - -@section The Mark and the Region - To specify the text for a command to operate on, set @dfn{the -mark} at one end of it, and move point to the other end. The text -between point and the mark is called @dfn{the region}. You can move -point or the mark to adjust the boundaries of the region. It doesn't -matter which one is set first chronologically, or which one comes -earlier in the text. - - Once the mark has been set, it remains until it is set again at -another place. The mark remains fixed with respect to the preceding -character if text is inserted or deleted in a buffer. Each Emacs -buffer has its own mark; when you return to a buffer that had been -selected previously, it has the same mark it had before. - - Many commands that insert text, such as @kbd{C-y} (@code{yank}) and -@kbd{M-x insert-buffer}, position the mark at one end of the inserted -text---the opposite end from where point is positioned, so that the region -contains the text just inserted. - - Aside from delimiting the region, the mark is useful for marking -a spot that you may want to go back to. To make this feature more useful, -Emacs remembers 16 previous locations of the mark in the @code{mark ring}. - -@menu -* Setting Mark:: Commands to set the mark. -* Using Region:: Summary of ways to operate on contents of the region. -* Marking Objects:: Commands to put region around textual units. -* Mark Ring:: Previous mark positions saved so you can go back there. -@end menu - -@node Setting Mark, Using Region, Mark, Mark -@subsection Setting the Mark - - Here are some commands for setting the mark: - -@c WideCommands -@table @kbd -@item C-@key{SPC} -Set the mark where point is (@code{set-mark-command}). -@item C-@@ -The same. -@item C-x C-x -Interchange mark and point (@code{exchange-point-and-mark}). -@item C-< -Pushes a mark at the beginning of the buffer. -@item C-> -Pushes a mark at the end of the buffer. -@end table - - For example, to convert part of the buffer to all -upper-case, you can use the @kbd{C-x C-u} (@code{upcase-region}) -command, which operates on the text in the region. First go to the -beginning of the text you want to capitalize and type @kbd{C-@key{SPC}} to -put the mark there, then move to the end, and then type @kbd{C-x C-u} to -capitalize the selected region. You can also set the mark at the end of the -text, move to the beginning, and then type @kbd{C-x C-u}. Most commands -that operate on the text in the region have the word @code{region} in -their names. - -@kindex C-SPC -@findex set-mark-command - The most common way to set the mark is with the @kbd{C-@key{SPC}} -command (@code{set-mark-command}). This command sets the mark where -point is. You can then move point away, leaving the mark behind. It is -actually incorrect to speak of the character @kbd{C-@key{SPC}}; there is -no such character. When you type @key{SPC} while holding down -@key{CTRL}, you get the character @kbd{C-@@} on most terminals. This -character is actually bound to @code{set-mark-command}. But unless you are -unlucky enough to have a terminal where typing @kbd{C-@key{SPC}} does -not produce @kbd{C-@@}, you should think of this character as -@kbd{C-@key{SPC}}. - -@kindex C-x C-x -@findex exchange-point-and-mark - Since terminals have only one cursor, Emacs cannot show you where the -mark is located. Most people use the mark soon after they set it, before -they forget where it is. But you can see where the mark is with the -command @kbd{C-x C-x} (@code{exchange-point-and-mark}) which puts the -mark where point was and point where the mark was. The extent of the -region is unchanged, but the cursor and point are now at the previous -location of the mark. - -@kindex C-< -@kindex C-> -@findex mark-beginning-of-buffer -@findex mark-end-of-buffer - Another way to set the mark is to push the mark to the beginning of a -buffer while leaving point at its original location. If you supply an -argument to @kbd{C-<} (@code{mark-beginning-of-buffer}), the mark is pushed -@var{n}/10 of the way from the true beginning of the buffer. You can -also set the mark at the end of a buffer with @kbd{C->} -(@code{mark-end-of-buffer}). It pushes the mark to the end of the buffer, -leaving point alone. Supplying an argument to the command pushes the mark -@var{n}/10 of the way from the true end of the buffer. - -If you are using XEmacs under the X window system, you can set -the variable @code{zmacs-regions} to @code{t}. This makes the current -region (defined by point and mark) highlight and makes it available as -the X clipboard selection, which means you can use the menu bar items on -it. @xref{Active Regions} for more information. - - @kbd{C-x C-x} is also useful when you are satisfied with the location of -point but want to move the mark; do @kbd{C-x C-x} to put point there and -then you can move it. A second use of @kbd{C-x C-x}, if necessary, puts -the mark at the new location with point back at its original location. - -@node Using Region, Marking Objects, Setting Mark, Mark -@subsection Operating on the Region - - Once you have created an active region, you can do many things to -the text in it: -@itemize @bullet -@item -Kill it with @kbd{C-w} (@pxref{Killing}). -@item -Save it in a register with @kbd{C-x r s} (@pxref{Registers}). -@item -Save it in a buffer or a file (@pxref{Accumulating Text}). -@item -Convert case with @kbd{C-x C-l} or @kbd{C-x C-u} @*(@pxref{Case}). -@item -Evaluate it as Lisp code with @kbd{M-x eval-region} (@pxref{Lisp Eval}). -@item -Fill it as text with @kbd{M-q} (@pxref{Filling}). -@item -Print hardcopy with @kbd{M-x print-region} (@pxref{Hardcopy}). -@item -Indent it with @kbd{C-x @key{TAB}} or @kbd{C-M-\} (@pxref{Indentation}). -@end itemize - -@node Marking Objects, Mark Ring, Using Region, Mark -@subsection Commands to Mark Textual Objects - - There are commands for placing point and the mark around a textual -object such as a word, list, paragraph or page. - -@table @kbd -@item M-@@ -Set mark after end of next word (@code{mark-word}). This command and -the following one do not move point. -@item C-M-@@ -Set mark after end of next Lisp expression (@code{mark-sexp}). -@item M-h -Put region around current paragraph (@code{mark-paragraph}). -@item C-M-h -Put region around current Lisp defun (@code{mark-defun}). -@item C-x h -Put region around entire buffer (@code{mark-whole-buffer}). -@item C-x C-p -Put region around current page (@code{mark-page}). -@end table - -@kindex M-@@ -@kindex C-M-@@ -@findex mark-word -@findex mark-sexp -@kbd{M-@@} (@code{mark-word}) puts the mark at the end of the next word, -while @kbd{C-M-@@} (@code{mark-sexp}) puts it at the end of the next Lisp -expression. These characters sometimes save you some typing. - -@kindex M-h -@kindex C-M-h -@kindex C-x C-p -@kindex C-x h -@findex mark-paragraph -@findex mark-defun -@findex mark-page -@findex mark-whole-buffer - A number of commands are available that set both point and mark and -thus delimit an object in the buffer. @kbd{M-h} (@code{mark-paragraph}) -moves point to the beginning of the paragraph that surrounds or follows -point, and puts the mark at the end of that paragraph -(@pxref{Paragraphs}). You can then indent, case-convert, or kill the -whole paragraph. In the same fashion, @kbd{C-M-h} (@code{mark-defun}) -puts point before and the mark after the current or following defun -(@pxref{Defuns}). @kbd{C-x C-p} (@code{mark-page}) puts point before -the current page (or the next or previous, depending on the argument), -and mark at the end (@pxref{Pages}). The mark goes after the -terminating page delimiter (to include it), while point goes after the -preceding page delimiter (to exclude it). Finally, @kbd{C-x h} -(@code{mark-whole-buffer}) sets up the entire buffer as the region by -putting point at the beginning and the mark at the end. - -@node Mark Ring,, Marking Objects, Mark -@subsection The Mark Ring - -@kindex C-u C-SPC -@cindex mark ring -@kindex C-u C-@@ - Aside from delimiting the region, the mark is also useful for marking -a spot that you may want to go back to. To make this feature more -useful, Emacs remembers 16 previous locations of the mark in the -@dfn{mark ring}. Most commands that set the mark push the old mark onto -this ring. To return to a marked location, use @kbd{C-u C-@key{SPC}} -(or @kbd{C-u C-@@}); this is the command @code{set-mark-command} given a -numeric argument. The command moves point to where the mark was, and -restores the mark from the ring of former marks. Repeated use of this -command moves point to all the old marks on the ring, one by one. -The marks you have seen go to the end of the ring, so no marks are lost. - - Each buffer has its own mark ring. All editing commands use the current -buffer's mark ring. In particular, @kbd{C-u C-@key{SPC}} always stays in -the same buffer. - - Many commands that can move long distances, such as @kbd{M-<} -(@code{beginning-of-buffer}), start by setting the mark and saving the -old mark on the mark ring. This makes it easier for you to move back -later. Searches set the mark, unless they do not actually move point. -When a command sets the mark, @samp{Mark Set} is printed in the -echo area. - -@vindex mark-ring-max - The variable @code{mark-ring-max} is the maximum number of entries to -keep in the mark ring. If that many entries exist and another entry is -added, the last entry in the list is discarded. Repeating @kbd{C-u -C-@key{SPC}} circulates through the entries that are currently in the -ring. - -@vindex mark-ring - The variable @code{mark-ring} holds the mark ring itself, as a list of -marker objects in the order most recent first. This variable is local -in every buffer. diff --git a/man/xemacs/menus.texi b/man/xemacs/menus.texi deleted file mode 100644 index 7c47974..0000000 --- a/man/xemacs/menus.texi +++ /dev/null @@ -1,549 +0,0 @@ - -@node Pull-down Menus, Entering Emacs, Keystrokes, Top -@comment node-name, next, previous, up -@section XEmacs Pull-down Menus - -If you are running XEmacs under X, a menu bar on top of the -Emacs frame provides access to pull-down menus of file, edit, and -help-related commands. The menus provide convenient shortcuts and an -easy interface for novice users. They do not provide additions to the -functionality available via key commands; you can still invoke commands -from the keyboard as in previous versions of Emacs. - -@table @b -@item File -Perform file and buffer-related operations, such as opening and closing -files, saving and printing buffers, as well as exiting Emacs. -@cindex File menu - -@item Edit -Perform standard editing operations, such as -cutting, copying, pasting, and killing selected text. -@cindex Edit menu - -@item Apps -Access to sub-applications implemented within XEmacs, such as the mail -reader, the World Wide Web browser, the spell-checker, and the calendar -program. -@cindex Apps menu - -@item Options -Control various options regarding the way XEmacs works, such as controlling -which elements of the frame are visible, selecting the fonts to be used for -text, specifying whether searches are case-sensitive, etc. -@cindex Options menu - -@item Buffers -Present a menu of buffers for selection as well as the option to display -a buffer list. -@cindex Buffers menu - -@item Tools -Perform various actions designed to automate software development and -similar technical work, such as searching through many files, compiling -a program, and comparing or merging two or three files. -@cindex Tools menu - -@item Help -Access to Emacs Info. -@cindex Help menu -@end table -@cindex Pull-down Menus -@cindex menus - -There are two ways of selecting an item from a pull-down menu: - -@itemize @bullet -@item -Select an item in the menu bar by moving the cursor over it and click the -left mouse-button. Then move the cursor over the menu item you want to choose -and click left again. -@item -Select an item in the menu bar by moving the cursor over it and click and -hold the left mouse-button. With the mouse-button depressed, move the -cursor over the menu item you want, then release it to make your selection. -@end itemize - -If a command in the pull-down menu is not applicable in a given -situation, the command is disabled and its name appears faded. You -cannot invoke items that are faded. For example, many commands on the -@b{Edit} menu appear faded until you select text on which they are to -operate; after you select a block of text, edit commands are enabled. -@xref{Mouse Selection} for information on using the mouse to select -text. @xref{Using X Selections} for related information. - -There are also @kbd{M-x} equivalents for each menu item. To find the -equivalent for any left-button menu item, do the following: - -@enumerate -@item -Type @kbd{C-h k} to get the @code{Describe Key} prompt. -@item -Select the menu item and click. -@end enumerate - -Emacs displays the function associated with the menu item in a separate -window, usually together with some documentation. - -@menu -* File Menu:: Items on the File menu. -* Edit Menu:: Items on the Edit menu. -* Apps Menu:: Items on the Apps menu. -* Options Menu:: Items on the Options menu. -* Buffers Menu:: Information about the Buffers menu. -* Tools Menu:: Items on the Tools menu. -* Help Menu:: Items on the Help menu. -* Menu Customization:: Adding and removing menu items and related - operations. -@end menu - -@node File Menu -@subsection The File Menu - -@cindex File menu - -The @b{File} menu bar item contains the items @b{New Frame}, @b{Open -File...}, @b{Save Buffer}, @b{Save Buffer As...}, @b{Revert Buffer}, -@b{Print Buffer}, @b{Delete Frame}, @b{Kill Buffer} and @b{Exit Emacs} -on the pull-down menu. If you select a menu item, Emacs executes the -equivalent command. - -@cindex Open File, New Frame... menu item -@cindex Open File... menu item -@cindex Insert File... menu item -@cindex Save Buffer menu item -@cindex Save Buffer As ... menu item -@cindex Revert Buffer menu item -@cindex Kill Buffer menu item -@cindex Print Buffer menu item -@cindex New Frame menu item -@cindex Delete Frame menu item -@cindex Split Frame -@cindex Un-split (Keep This) -@cindex Un-split (Keep Others) -@cindex Exit Emacs menu item - -@table @b -@item Open File, New Frame... -Prompts you for a filename and loads that file into a new buffer in a -new Emacs frame, that is, a new X window running under the same Emacs -process. You can remove the frame using the @b{Delete Frame} menu -item. When you remove the last frame, you exit Emacs and are prompted -for confirmation. @refill - -@item Open File... -Prompts you for a filename and loads that file into a new buffer. -@b{Open File...} is equivalent to the Emacs command @code{find-file} (@kbd{C-x -C-f}).@refill - -@item Insert File... -Prompts you for a filename and inserts the contents of that file into -the current buffer. The file associated with the current buffer is -not changed by this command. This is equivalent to the Emacs command -@code{insert-file} (@kbd{C-x i}).@refill - -@item Save Buffer -Writes and saves the current Emacs buffer as the latest -version of the current visited file. @b{Save Buffer} is equivalent to the -Emacs command @code{save-buffer} (@kbd{C-x C-s}).@refill - -@item Save Buffer As... -Writes and saves the current Emacs buffer to the filename you specify. -@b{Save Buffer As...} is equivalent to the Emacs command -@code{write-file} (@kbd{C-x C-w}).@refill - -@item Revert Buffer -Restores the last saved version of the file to the current buffer. When -you edit a buffer containing a text file, you must save the buffer -before your changes become effective. Use @b{Revert Buffer} if you do -not want to keep the changes you have made in the buffer. @b{Revert -Buffer} is equivalent to the Emacs command @code{revert-file} (@kbd{M-x -revert-buffer}).@refill - -@item Kill Buffer -Kills the current buffer, prompting you first if there are unsaved -changes. This is roughly equivalent to the Emacs command -@code{kill-buffer} (@kbd{C-x k}), except that @code{kill-buffer} -prompts for the name of a buffer to kill. @refill - -@item Print Buffer -Prints a hardcopy of the current buffer. Equivalent -to the Emacs command @code{print-buffer} (@kbd{M-x print-buffer}).@refill - -@item New Frame -Creates a new Emacs frame displaying the @code{*scratch*} buffer. This -is like the @b{Open File, New Frame...} menu item, except that it does -not prompt for or load a file.@refill - -@item Delete Frame -Allows you to close all but one of the frames created by @b{New Frame}. -If you created several Emacs frames belonging to the same Emacs -process, you can close all but one of them. When you attempt to close the -last frame, Emacs informs you that you are attempting to delete the -last frame. You have to choose @b{Exit Emacs} for that.@refill - -@item Split Frame -Divides the current window on the current frame into two equal-sized -windows, both displaying the same buffer. Equivalent to the Emacs -command @code{split-window-vertically} (@kbd{C-x 2}).@refill - -@item Un-split (Keep This) -If the frame is divided into multiple windows, this removes all windows -other than the selected one. Equivalent to the Emacs command -@code{delete-other-windows} (@kbd{C-x 1}).@refill - -@item Un-split (Keep Others) -If the frame is divided into multiple windows, this removes the -selected window from the frame, giving the space back to one of the -other windows. Equivalent to the Emacs command @code{delete-window} -(@kbd{C-x 0}).@refill - -@item Exit Emacs -Shuts down (kills) the Emacs process. Equivalent to the Emacs command -@code{save-buffers-kill-emacs} (@kbd{C-x C-c}). Before killing the -Emacs process, the system asks which unsaved buffers to save by going through -the list of all buffers in that Emacs process.@refill -@end table - -@node Edit Menu -@subsection The Edit Menu -@cindex Edit menu - -The @b{Edit} pull-down menu contains the @b{Undo}, @b{Cut}, @b{Copy}, -@b{Paste}, and @b{Clear} menu items. When you select a menu item, Emacs -executes the equivalent command. Most commands on the @b{Edit} menu -work on a block of text, the X selection. They appear faded until you -select a block of text (activate a region) with the mouse. @xref{Using -X Selections}, @pxref{Killing}, and @pxref{Yanking} for more -information.@refill - -@c **** zmacs-regions is on by default these days - jwz -@c -@c Note: By default, you can use the @b{Edit} menu items on the region between -@c point an the mark as well as regions selected with the mouse. To change -@c this behavior, set the variable @code{zmacs-regions} to -@c @code{t}. @xref{Active Regions} for more information. - -@cindex Undo menu item -@cindex Cut menu item -@cindex Copy menu item -@cindex Paste menu item -@cindex Clear menu item -@cindex Start Macro Recording menu item -@cindex End Macro Recording menu item -@cindex Execute Last Macro menu item -@table @b -@item Undo -Undoes the previous command. @b{Undo} is equivalent to -the Emacs command @code{undo} (@kbd{C-x u}).@refill - -@item Cut -Removes the selected text block from the current buffer, makes it the X -clipboard selection, and places it in the kill ring. Before executing -this command, you have to select a region using Emacs region selection -commands or with the mouse.@refill - -@item Copy -Makes a selected text block the X clipboard selection, and places it in -the kill ring. You can select text using one of the Emacs region -selection commands or by selecting a text region with the mouse.@refill - -@item Paste -Inserts the current value of the X clipboard selection in the current -buffer. Note that this is not necessarily the same as the Emacs -@code{yank} command, because the Emacs kill ring and the X clipboard -selection are not the same thing. You can paste in text you -have placed in the clipboard using @b{Copy} or @b{Cut}. You can also -use @b{Paste} to insert text that was pasted into the clipboard from other -applications. - -@item Clear -Removes the selected text block from the current buffer but does not -place it in the kill ring or the X clipboard selection. - -@item Start Macro Recording -After selecting this, Emacs will remember every keystroke you type until -@b{End Macro Recording} is selected. This is the same as the Emacs -command @code{start-kbd-macro} (@kbd{C-x (}). - -@item End Macro Recording -Selecting this tells emacs to stop remembering your keystrokes. This is -the same as the Emacs command @code{end-kbd-macro} (@kbd{C-x )}). - -@item Execute Last Macro -Selecting this item will cause emacs to re-interpret all of the -keystrokes which were saved between selections of the @b{Start Macro -Recording} and @b{End Macro Recording} menu items. This is the same -as the Emacs command @code{call-last-kbd-macro} (@kbd{C-x e}). -@end table - -@node Apps Menu -@subsection The Apps Menu -@cindex Apps menu - -The @b{Apps} pull-down menu contains the @b{Read Mail (VM)...}, @b{Read -Mail (MH)...}, @b{Send Mail...}, @b{Usenet News}, @b{Browse the Web}, -@b{Gopher}, @b{Spell-Check Buffer} and @b{Emulate VI} menu items, -and the @b{Calendar} and @b{Games} sub-menus. When you select a menu -item, Emacs executes the equivalent command. For some of the menu -items, there are sub-menus which you will need to select. - -@node Options Menu -@subsection The Options Menu -@cindex Options menu - -The @b{Options} pull-down menu contains the @b{Read Only}, @b{Case -Sensitive Search}, @b{Overstrike}, @b{Auto Delete Selection}, -@b{Teach Extended Commands}, @b{Syntax Highlighting}, @b{Paren -Highlighting}, @b{Font}, @b{Size}, @b{Weight}, @b{Buffers Menu -Length...}, @b{Buffers Sub-Menus} and @b{Save Options} menu items. -When you select a menu item, Emacs executes the equivalent command. -For some of the menu items, there are sub-menus which you will need -to select. - -@cindex Read Only menu item -@cindex Case Sensitive Search menu item -@cindex Overstrike menu item -@cindex Auto Delete Selection menu item -@cindex Teach Extended Commands menu item -@cindex Syntax Highlighting menu item -@cindex Paren Highlighting menu item -@cindex Font menu item -@cindex Size menu item -@cindex Weight menu item -@cindex Buffers Menu Length... menu item -@cindex Buffers Sub-Menus menu item -@cindex Save Options -@table @b -@item Read Only -Selecting this item will cause the buffer to visit the file in a -read-only mode. Changes to the file will not be allowed. This is -equivalent to the Emacs command @code{toggle-read-only} -(@kbd{C-x C-q}). - -@item Case Sensitive Search -Selecting this item will cause searches to be case-sensitive. If -its not selected then searches will ignore case. This option is -local to the buffer. - -@item Overstrike -After selecting this item, when you type letters they will replace -existing text on a one-to-one basis, rather than pushing it to the -right. At the end of a line, such characters extend the line. Before -a tab, such characters insert until the tab is filled in. This is the -same as Emacs command @code{quoted-insert} (@kbd{C-q}). - -@item Auto Delete Selection -Selecting this item will cause automatic deletion of the selected -region. The typed text will replace the selection if the selection -is active (i.e. if its highlighted). If the option is not selected -then the typed text is just inserted at the point. - -@item Teach Extended Commands -After you select this item, any time you execute a command with -@kbd{M-x}which has a shorter keybinding, you will be shown the -alternate binding before the command executes. - -@item Syntax Highlighting -You can customize your @code{.emacs} file to include the font-lock -mode so that when you select this item, the comments will be -displayed in one face, strings in another, reserved words in another, -and so on. When @b{Fonts} is selected, different parts of the program -will appear in different Fonts. When @b{Colors} is selected, then the -program will be displayed in different colors. Selecting @b{None} -causes the program to appear in just one Font and Color. Selecting -@b{Less} resets the Fonts and Colors to a fast, minimal set of -decorations. Selecting @b{More} resets the Fonts and Colors to a larger -set of decorations. For example, if @b{Less} is selected (which is the -default setting) then you might have all comments in green color. -Whereas, if @b{More} is selected then a function name in the comments -themselves might appear in a different Color or Font.@refill - -@item Paren Highlighting -After selecting @b{Blink} from this item, if you place the cursor -on a parenthesis, the matching parenthesis will blink. If you select -@b{Highlight} and place the cursor on a parenthesis, the whole -expression of the parenthesis under the cursor will be highlighted. -Selecting @b{None} will turn off the options (regarding @b{Paren -Highlighting}) which you had selected earlier.@refill - -@item Font -You can select any Font for your program by choosing from one of the -available Fonts. - -@item Size -You can select any size ranging from @b{2} to @b{24} by selecting the -appropriate option.@refill - -@item Weight -You can choose either @b{Bold} or @b{Medium} for the weight.@refill - -@item Buffers Menu Length... -Prompts you for the number of buffers to display. Then it will display -that number of most recently selected buffers. - -@item Buffers Sub-Menus -After selection of this item the Buffers menu will contain several -commands, as submenus of each buffer line. If this item is unselected, -then there are no submenus for each buffer line, the only command -available will be selecting that buffer. - -@item Save Options -Selecting this item will save the current settings of your Options -menu to your @code{.emacs} file. -@end table - -@node Buffers Menu -@subsection The Buffers Menu -@cindex Buffers menu -The @b{Buffers} menu provides a selection of up to ten buffers and the -item @b{List All Buffers}, which provides a Buffer List. @xref{List -Buffers} for more information. - -@node Tools Menu -@subsection The Tools Menu -@cindex Tools menu - -The @b{Tools} pull-down menu contains the @b{Grep...}, @b{Compile...}, -@b{Shell Command...}, @b{Shell Command on Region...}, @b{Debug(GDB)...} -and @b{Debug(DBX)...} menu items, and the @b{Compare}, @b{Merge}, -@b{Apply Patch} and @b{Tags} sub-menus. When you select a menu item, -Emacs executes the equivalent command. For some of the menu items, -there are sub-menus which you will need to select. - -@node Help Menu -@subsection The Help Menu -@cindex Help menu - -The Help Menu gives you access to Emacs Info and provides a menu -equivalent for each of the choices you have when using @kbd{C-h}. -@xref{Help} for more information. - -The Help menu also gives access to UNIX online manual pages via the -@b{UNIX Manual Page} option. - -@node Menu Customization -@subsection Customizing XEmacs Menus - -You can customize any of the pull-down menus by adding or removing menu -items and disabling or enabling existing menu items. - -The following functions are available: -@table @kbd -@item add-menu: @var{(menu-path menu-name menu-items &optional before)} -Add a menu to the menu bar or one of its submenus. -@item add-menu-item: @var{(menu-path item-name function enabled-p -&optional before)} -Add a menu item to a menu, creating the menu first if necessary. -@item delete-menu-item: @var{(path)} -Remove the menu item defined by @var{path} from the menu hierarchy. -@item disable-menu-item: @var{(path)} -Disable the specified menu item. -@item enable-menu-item: @var{(path)} -Enable the specified previously disabled menu item. -@item relabel-menu-item: @var{(path new-name)} -Change the string of the menu item specified by @var{path} to -@var{new-name}. - -@end table - -@findex add-menu -@cindex adding menus -Use the function @code{add-menu} to add a new menu or submenu. -If a menu or submenu of the given name exists already, it is changed. - -@var{menu-path} identifies the menu under which the new menu should be -inserted. It is a list of strings; for example, @code{("File")} names -the top-level @b{File} menu. @code{("File" "Foo")} names a hypothetical -submenu of @b{File}. If @var{menu-path} is @code{nil}, the menu is -added to the menu bar itself. - -@var{menu-name} is the string naming the menu to be added. - -@var{menu-items} is a list of menu item descriptions. Each menu item -should be a vector of three elements: - -@itemize @bullet -@item -A string, which is the name of the menu item -@item -A symbol naming a command, or a form to evaluate -@item -@code{t} or @code{nil} to indicate whether the item is selectable -@end itemize - -The optional argument @var{before} is the name of the menu before which -the new menu or submenu should be added. If the menu is already -present, it is not moved. - -@findex add-menu-item -@cindex adding menu items -The function @code{add-menu-item} adds a menu item to the specified -menu, creating the menu first if necessary. If the named item already -exists, the menu remains unchanged. - -@var{menu-path} identifies the menu into which the new menu item should -be inserted. It is a list of strings; for example, @code{("File")} -names the top-level @b{File} menu. @code{("File" "Foo")} names a -hypothetical submenu of @b{File}. - -@var{item-name} is the string naming the menu item to add. - -@var{function} is the command to invoke when this menu item is selected. -If it is a symbol, it is invoked with @code{call-interactively}, in the -same way that functions bound to keys are invoked. If it is a list, the -list is simply evaluated. - -@var{enabled-p} controls whether the item is selectable or not. -It should be @code{t}, @code{nil}, or a form to evaluate to decide. -This form will be evaluated just before the menu is displayed, and -the menu item will be selectable if that form returns non-@code{nil}. - -For example, to make the @code{rename-file} command available from the -@b{File} menu, use the following code: - -@example -(add-menu-item '("File") "Rename File" 'rename-file t) -@end example - -To add a submenu of file management commands using a @b{File Management} -item, use the following code: - -@example -(add-menu-item '("File" "File Management") "Copy File" 'copy-file t) -(add-menu-item '("File" "File Management") "Delete File" 'delete-file t) -(add-menu-item '("File" "File Management") "Rename File" 'rename-file t) -@end example - -The optional @var{before} argument is the name of a menu item before -which the new item should be added. If the item is already present, it -is not moved. - -@findex delete-menu-item -@cindex deleting menu items -To remove a specified menu item from the menu hierarchy, use -@code{delete-menu-item}. - -@var{path} is a list of strings that identify the position of the menu -item in the menu hierarchy. @code{("File" "Save")} means the menu item -called @b{Save} under the top level @b{File} menu. @code{("Menu" "Foo" -"Item")} means the menu item called @b{Item} under the @b{Foo} submenu -of @b{Menu}. - -@findex disable-menu-item -@findex enable-menu-item -@cindex enabling menu items -@cindex disabling menu items - -To disable a menu item, use @code{disable-menu-item}. The disabled -menu item is grayed and can no longer be selected. To make the -item selectable again, use @code{enable-menu-item}. -@code{disable-menu-item} and @code{enable-menu-item} both have the -argument @var{path}. - -@findex relabel-menu-item -@cindex changing menu items -To change the string of the specified menu item, use -@code{relabel-menu-item}. This function also takes the argument @var{path}. - -@var{new-name} is the string to which the menu item will be changed. diff --git a/man/xemacs/mini.texi b/man/xemacs/mini.texi deleted file mode 100644 index c46ce59..0000000 --- a/man/xemacs/mini.texi +++ /dev/null @@ -1,383 +0,0 @@ - -@node Minibuffer, M-x, Undo, Top -@chapter The Minibuffer -@cindex minibuffer - - Emacs commands use the @dfn{minibuffer} to read arguments more -complicated than a single number. Minibuffer arguments can be file -names, buffer names, Lisp function names, Emacs command names, Lisp -expressions, and many other things, depending on the command reading the -argument. To edit the argument in the minibuffer, you can use Emacs -editing commands. - - -@cindex prompt - When the minibuffer is in use, it appears in the echo area, and the -cursor moves there. The beginning of the minibuffer line displays a -@dfn{prompt} indicating what kind of input you should supply and how it -will be used. The prompt is often derived from the name of the command -the argument is for. The prompt normally ends with a colon. - -@cindex default argument - Sometimes a @dfn{default argument} appears in parentheses after the -colon; it, too, is part of the prompt. The default is used as the -argument value if you enter an empty argument (e.g., by just typing @key{RET}). -For example, commands that read buffer names always show a default, which -is the name of the buffer that will be used if you type just @key{RET}. - -@kindex C-g - The simplest way to give a minibuffer argument is to type the text you -want, terminated by @key{RET} to exit the minibuffer. To get out -of the minibuffer and cancel the command that it was for, type -@kbd{C-g}. - - Since the minibuffer uses the screen space of the echo area, it can -conflict with other ways Emacs customarily uses the echo area. Here is how -Emacs handles such conflicts: - -@itemize @bullet -@item -If a command gets an error while you are in the minibuffer, this does -not cancel the minibuffer. However, the echo area is needed for the -error message and therefore the minibuffer itself is hidden for a -while. It comes back after a few seconds, or as soon as you type -anything. - -@item -If you use a command in the minibuffer whose purpose is to print a -message in the echo area (for example @kbd{C-x =}) the message is -displayed normally, and the minibuffer is hidden for a while. It comes back -after a few seconds, or as soon as you type anything. - -@item -Echoing of keystrokes does not take place while the minibuffer is in -use. -@end itemize - -@menu -* File: Minibuffer File. Entering file names with the minibuffer. -* Edit: Minibuffer Edit. How to edit in the minibuffer. -* Completion:: An abbreviation facility for minibuffer input. -* Repetition:: Re-executing commands that used the minibuffer. -@end menu - -@node Minibuffer File, Minibuffer Edit, Minibuffer, Minibuffer -@section Minibuffers for File Names - - Sometimes the minibuffer starts out with text in it. For example, when -you are supposed to give a file name, the minibuffer starts out containing -the @dfn{default directory}, which ends with a slash. This informs -you in which directory the file will be looked for if you do not specify -a different one. For example, the minibuffer might start out with: - -@example -Find File: /u2/emacs/src/ -@end example - -@noindent -where @samp{Find File:@: } is the prompt. Typing @kbd{buffer.c} specifies -the file -@*@file{/u2/emacs/src/buffer.c}. To find files in nearby -directories, use @samp{..}; thus, if you type @kbd{../lisp/simple.el}, the -file that you visit will be the one named -@*@file{/u2/emacs/lisp/simple.el}. -Alternatively, you can use @kbd{M-@key{DEL}} to kill directory names you -don't want (@pxref{Words}).@refill - - You can also type an absolute file name, one starting with a slash or a -tilde, ignoring the default directory. For example, to find the file -@file{/etc/termcap}, just type the name, giving: - -@example -Find File: /u2/emacs/src//etc/termcap -@end example - -@noindent -Two slashes in a row are not normally meaningful in Unix file names, but -they are allowed in XEmacs. They mean, ``ignore everything before the -second slash in the pair.'' Thus, @samp{/u2/emacs/src/} is ignored, and -you get the file @file{/etc/termcap}. - -@vindex insert-default-directory -If you set @code{insert-default-directory} to @code{nil}, the default -directory is not inserted in the minibuffer. This way, the minibuffer -starts out empty. But the name you type, if relative, is still -interpreted with respect to the same default directory. - -@node Minibuffer Edit, Completion, Minibuffer File, Minibuffer -@section Editing in the Minibuffer - - The minibuffer is an Emacs buffer (albeit a peculiar one), and the usual -Emacs commands are available for editing the text of an argument you are -entering. - - Since @key{RET} in the minibuffer is defined to exit the minibuffer, -you must use @kbd{C-o} or @kbd{C-q @key{LFD}} to insert a newline into -the minibuffer. (Recall that a newline is really the @key{LFD} -character.) - - The minibuffer has its own window, which always has space on the screen -but acts as if it were not there when the minibuffer is not in use. The -minibuffer window is just like the others; you can switch to another -window with @kbd{C-x o}, edit text in other windows, and perhaps even -visit more files before returning to the minibuffer to submit the -argument. You can kill text in another window, return to the minibuffer -window, and then yank the text to use it in the argument. @xref{Windows}. - - There are, however, some restrictions on the use of the minibuffer window. -You cannot switch buffers in it---the minibuffer and its window are -permanently attached. You also cannot split or kill the minibuffer -window, but you can make it taller with @kbd{C-x ^}. - -@kindex C-M-v - If you are in the minibuffer and issue a command that displays help -text in another window, that window will be scrolled if you type -@kbd{M-C-v} while in the minibuffer until you exit the minibuffer. This -feature is helpful if a completing minibuffer gives you a long list of -possible completions. - -If the variable @code{minibuffer-confirm-incomplete} is @code{t}, you -are asked for confirmation if there is no known completion for the text -you typed. For example, if you attempted to visit a non-existent file, -the minibuffer might read: -@example - Find File:chocolate_bar.c [no completions, confirm] -@end example -If you press @kbd{Return} again, that confirms the filename. Otherwise, -you can continue editing it. - - Emacs supports recursive use of the minibuffer. However, it is -easy to do this by accident (because of autorepeating keyboards, for -example) and get confused. Therefore, most Emacs commands that use the -minibuffer refuse to operate if the minibuffer window is selected. If the -minibuffer is active but you have switched to a different window, recursive -use of the minibuffer is allowed---if you know enough to try to do this, -you probably will not get confused. - -@vindex enable-recursive-minibuffers - If you set the variable @code{enable-recursive-minibuffers} to be -non-@code{nil}, recursive use of the minibuffer is always allowed. - -@node Completion, Repetition, Minibuffer Edit, Minibuffer -@section Completion -@cindex completion - - When appropriate, the minibuffer provides a @dfn{completion} facility. -You type the beginning of an argument and one of the completion keys, -and Emacs visibly fills in the rest, depending on what you have already -typed. - - When completion is available, certain keys---@key{TAB}, @key{RET}, and -@key{SPC}---are redefined to complete an abbreviation present in the -minibuffer into a longer string that it stands for, by matching it -against a set of @dfn{completion alternatives} provided by the command -reading the argument. @kbd{?} is defined to display a list of possible -completions of what you have inserted. - - For example, when the minibuffer is being used by @kbd{Meta-x} to read -the name of a command, it is given a list of all available Emacs command -names to complete against. The completion keys match the text in the -minibuffer against all the command names, find any additional characters of -the name that are implied by the ones already present in the minibuffer, -and add those characters to the ones you have given. - - Case is normally significant in completion because it is significant in -most of the names that you can complete (buffer names, file names, and -command names). Thus, @samp{fo} will not complete to @samp{Foo}. When you -are completing a name in which case does not matter, case may be ignored -for completion's sake if specified by program. - -When a completion list is displayed, the completions will highlight as -you move the mouse over them. Clicking the middle mouse button on any -highlighted completion will ``select'' it just as if you had typed it in -and hit @key{RET}. - -@subsection A Completion Example - -@kindex TAB -@findex minibuffer-complete - Consider the following example. If you type @kbd{Meta-x au @key{TAB}}, -@key{TAB} looks for alternatives (in this case, command names) that -start with @samp{au}. There are only two commands: @code{auto-fill-mode} and -@code{auto-save-mode}. They are the same as far as @code{auto-}, so the -@samp{au} in the minibuffer changes to @samp{auto-}.@refill - - If you type @key{TAB} again immediately, there are multiple possibilities -for the very next character---it could be @samp{s} or @samp{f}---so no more -characters are added; but a list of all possible completions is displayed -in another window. - - If you go on to type @kbd{f @key{TAB}}, this @key{TAB} sees -@samp{auto-f}. The only command name starting this way is -@code{auto-fill-mode}, so completion inserts the rest of that command. You -now have @samp{auto-fill-mode} in the minibuffer after typing just @kbd{au -@key{TAB} f @key{TAB}}. Note that @key{TAB} has this effect because in the -minibuffer it is bound to the function @code{minibuffer-complete} when -completion is supposed to be done.@refill - -@subsection Completion Commands - - Here is a list of all the completion commands defined in the minibuffer -when completion is available. - -@table @kbd -@item @key{TAB} -Complete the text in the minibuffer as much as possible @* -(@code{minibuffer-complete}). -@item @key{SPC} -Complete the text in the minibuffer but don't add or fill out more -than one word (@code{minibuffer-complete-word}). -@item @key{RET} -Submit the text in the minibuffer as the argument, possibly completing -first as described below (@code{minibuffer-complete-and-exit}). -@item ? -Print a list of all possible completions of the text in the minibuffer -(@code{minibuffer-list-completions}). -@item @key{button2} -Select the highlighted text under the mouse as a minibuffer response. -When the minibuffer is being used to prompt the user for a completion, -any valid completions which are visible on the screen will be highlighted -when the mouse moves over them. Clicking @key{button2} will select the -highlighted completion and exit the minibuffer. -(@code{minibuf-select-highlighted-completion}). -@end table - -@kindex SPC -@findex minibuffer-complete-word -@key{SPC} completes in a way that is similar to @key{TAB}, but it never -goes beyond the next hyphen or space. If you have @samp{auto-f} in the -minibuffer and type @key{SPC}, it finds that the completion is - @samp{auto-fill-mode}, but it stops completing after @samp{fill-}. -The result is @samp{auto-fill-}. Another @key{SPC} at this point -completes all the way to @samp{auto-fill-mode}. @key{SPC} in the -minibuffer runs the function @code{minibuffer-complete-word} when -completion is available.@refill - - There are three different ways that @key{RET} can work in completing -minibuffers, depending on how the argument will be used. - -@itemize @bullet -@item -@dfn{Strict} completion is used when it is meaningless to give any -argument except one of the known alternatives. For example, when -@kbd{C-x k} reads the name of a buffer to kill, it is meaningless to -give anything but the name of an existing buffer. In strict -completion, @key{RET} refuses to exit if the text in the minibuffer -does not complete to an exact match. - -@item -@dfn{Cautious} completion is similar to strict completion, except that -@key{RET} exits only if the text was an exact match already, not -needing completion. If the text is not an exact match, @key{RET} does -not exit, but it does complete the text. If it completes to an exact -match, a second @key{RET} will exit. - -Cautious completion is used for reading file names for files that must -already exist. - -@item -@dfn{Permissive} completion is used when any string is -meaningful, and the list of completion alternatives is just a guide. -For example, when @kbd{C-x C-f} reads the name of a file to visit, any -file name is allowed, in case you want to create a file. In -permissive completion, @key{RET} takes the text in the minibuffer -exactly as given, without completing it. -@end itemize - - The completion commands display a list of all possible completions in a -window whenever there is more than one possibility for the very next -character. Typing @kbd{?} explicitly requests such a list. The -list of completions counts as help text, so @kbd{C-M-v} typed in the -minibuffer scrolls the list. - -@vindex completion-ignored-extensions - When completion is done on file names, certain file names are usually -ignored. The variable @code{completion-ignored-extensions} contains a list -of strings; a file whose name ends in any of those strings is ignored as a -possible completion. The standard value of this variable has several -elements including @code{".o"}, @code{".elc"}, @code{".dvi"} and @code{"~"}. -The effect is that, for example, @samp{foo} completes to @samp{foo.c} -even though @samp{foo.o} exists as well. If the only possible completions -are files that end in ``ignored'' strings, they are not ignored.@refill - -@vindex completion-auto-help - If a completion command finds the next character is undetermined, it -automatically displays a list of all possible completions. If the variable -@code{completion-auto-help} is set to @code{nil}, this does not happen, -and you must type @kbd{?} to display the possible completions. - -@vindex minibuffer-confirm-incomplete -If the variable @code{minibuffer-confirm-incomplete} is set to @code{t}, -then in contexts where @code{completing-read} allows answers that are -not valid completions, an extra @key{RET} must be typed to confirm the -response. This is helpful for catching typos. - -@node Repetition,, Completion, Minibuffer -@section Repeating Minibuffer Commands -@cindex command history -@cindex history of commands - - Every command that uses the minibuffer at least once is recorded on a -special history list, together with the values of the minibuffer arguments, -so that you can repeat the command easily. In particular, every -use of @kbd{Meta-x} is recorded, since @kbd{M-x} uses the minibuffer to -read the command name. - -@findex list-command-history -@c widecommands -@table @kbd -@item C-x @key{ESC} -Re-execute a recent minibuffer command @*(@code{repeat-complex-command}). -@item M-p -Within @kbd{C-x @key{ESC}}, move to previous recorded command -(@code{previous-history-element}). -@item M-n -Within @kbd{C-x @key{ESC}}, move to the next (more recent) recorded -command (@code{next-history-element}).@refill -@item M-x list-command-history -Display the entire command history, showing all the commands -@kbd{C-x @key{ESC}} can repeat, most recent first.@refill -@end table - -@kindex C-x ESC -@findex repeat-complex-command - @kbd{C-x @key{ESC}} is used to re-execute a recent command that used -the minibuffer. With no argument, it repeats the last command. A numeric -argument specifies which command to repeat; 1 means the last one, and -larger numbers specify earlier commands. - - @kbd{C-x @key{ESC}} works by turning the previous command into a Lisp -expression and then entering a minibuffer initialized with the text for -that expression. If you type just @key{RET}, the command is repeated as -before. You can also change the command by editing the Lisp expression. -The expression you finally submit will be executed. The repeated -command is added to the front of the command history unless it is -identical to the most recently executed command already there. - - Even if you don't understand Lisp syntax, it will probably be obvious -which command is displayed for repetition. If you do not change the text, -you can be sure the command will repeat exactly as before. - -@kindex M-n -@kindex M-p -@findex next-complex-command -@findex previous-complex-command - If you are in the minibuffer for @kbd{C-x @key{ESC}} and the command shown -to you is not the one you want to repeat, you can move around the list of -previous commands using @kbd{M-n} and @kbd{M-p}. @kbd{M-p} replaces the -contents of the minibuffer with the next earlier recorded command, and -@kbd{M-n} replaces it with the next later command. After finding the -desired previous command, you can edit its expression and then -resubmit it by typing @key{RET}. Any editing you have done on the -command to be repeated is lost if you use @kbd{M-n} or @kbd{M-p}. - -@kbd{M-n} and @kbd{M-p} are specially defined within @kbd{C-x @key{ESC}} -to run the commands @code{previous-history-element} and -@code{next-history-element}. - -@vindex command-history - The list of previous commands using the minibuffer is stored as a Lisp -list in the variable @code{command-history}. Each element of the list -is a Lisp expression which describes one command and its arguments. -Lisp programs can reexecute a command by feeding the corresponding -@code{command-history} element to @code{eval}. diff --git a/man/xemacs/misc.texi b/man/xemacs/misc.texi deleted file mode 100644 index bbb8c64..0000000 --- a/man/xemacs/misc.texi +++ /dev/null @@ -1,784 +0,0 @@ - -@iftex -@chapter Miscellaneous Commands - - This chapter contains several brief topics that do not fit anywhere else. - -@end iftex - -@node Sorting, Shell, Calendar/Diary, Top -@section Sorting Text -@cindex sorting - - XEmacs provides several commands for sorting text in a buffer. All -operate on the contents of the region (the text between point and the -mark). They divide the text of the region into many @dfn{sort records}, -identify a @dfn{sort key} for each record, and then reorder the records -using the order determined by the sort keys. The records are ordered so -that their keys are in alphabetical order, or, for numerical sorting, in -numerical order. In alphabetical sorting, all upper-case letters `A' -through `Z' come before lower-case `a', in accordance with the ASCII -character sequence. - - The sort commands differ in how they divide the text into sort -records and in which part of each record they use as the sort key. Most of -the commands make each line a separate sort record, but some commands use -paragraphs or pages as sort records. Most of the sort commands use each -entire sort record as its own sort key, but some use only a portion of the -record as the sort key. - -@findex sort-lines -@findex sort-paragraphs -@findex sort-pages -@findex sort-fields -@findex sort-numeric-fields -@table @kbd -@item M-x sort-lines -Divide the region into lines and sort by comparing the entire -text of a line. A prefix argument means sort in descending order. - -@item M-x sort-paragraphs -Divide the region into paragraphs and sort by comparing the entire -text of a paragraph (except for leading blank lines). A prefix -argument means sort in descending order. - -@item M-x sort-pages -Divide the region into pages and sort by comparing the entire -text of a page (except for leading blank lines). A prefix -argument means sort in descending order. - -@item M-x sort-fields -Divide the region into lines and sort by comparing the contents of -one field in each line. Fields are defined as separated by -whitespace, so the first run of consecutive non-whitespace characters -in a line constitutes field 1, the second such run constitutes field -2, etc. - -You specify which field to sort by with a numeric argument: 1 to sort -by field 1, etc. A negative argument means sort in descending -order. Thus, minus 2 means sort by field 2 in reverse-alphabetical -order. - -@item M-x sort-numeric-fields -Like @kbd{M-x sort-fields}, except the specified field is converted -to a number for each line and the numbers are compared. @samp{10} -comes before @samp{2} when considered as text, but after it when -considered as a number. - -@item M-x sort-columns -Like @kbd{M-x sort-fields}, except that the text within each line -used for comparison comes from a fixed range of columns. An explanation -is given below. -@end table - -For example, if the buffer contains: - -@smallexample -On systems where clash detection (locking of files being edited) is -implemented, XEmacs also checks the first time you modify a buffer -whether the file has changed on disk since it was last visited or -saved. If it has, you are asked to confirm that you want to change -the buffer. -@end smallexample - -@noindent -then if you apply @kbd{M-x sort-lines} to the entire buffer you get: - -@smallexample -On systems where clash detection (locking of files being edited) is -implemented, XEmacs also checks the first time you modify a buffer -saved. If it has, you are asked to confirm that you want to change -the buffer. -whether the file has changed on disk since it was last visited or -@end smallexample - -@noindent -where the upper case `O' comes before all lower case letters. If you apply -instead @kbd{C-u 2 M-x sort-fields} you get: - -@smallexample -saved. If it has, you are asked to confirm that you want to change -implemented, XEmacs also checks the first time you modify a buffer -the buffer. -On systems where clash detection (locking of files being edited) is -whether the file has changed on disk since it was last visited or -@end smallexample - -@noindent -where the sort keys were @samp{If}, @samp{XEmacs}, @samp{buffer}, -@samp{systems}, and @samp{the}.@refill - -@findex sort-columns - @kbd{M-x sort-columns} requires more explanation. You specify the -columns by putting point at one of the columns and the mark at the other -column. Because this means you cannot put point or the mark at the -beginning of the first line to sort, this command uses an unusual -definition of `region': all of the line point is in is considered part of -the region, and so is all of the line the mark is in. - - For example, to sort a table by information found in columns 10 to 15, -you could put the mark on column 10 in the first line of the table, and -point on column 15 in the last line of the table, and then use this command. -Or you could put the mark on column 15 in the first line and point on -column 10 in the last line. - - This can be thought of as sorting the rectangle specified by point and -the mark, except that the text on each line to the left or right of the -rectangle moves along with the text inside the rectangle. -@xref{Rectangles}. - -@node Shell, Narrowing, Sorting, Top -@section Running Shell Commands from XEmacs -@cindex subshell -@cindex shell commands - - XEmacs has commands for passing single command lines to inferior shell -processes; it can also run a shell interactively with input and output to -an XEmacs buffer @samp{*shell*}. - -@table @kbd -@item M-! -Run a specified shell command line and display the output -(@code{shell-command}). -@item M-| -Run a specified shell command line with region contents as input; -optionally replace the region with the output -(@code{shell-command-on-region}). -@item M-x shell -Run a subshell with input and output through an XEmacs buffer. -You can then give commands interactively. -@item M-x term -Run a subshell with input and output through an XEmacs buffer. -You can then give commands interactively. -Full terminal emulation is available. -@end table - -@menu -* Single Shell:: How to run one shell command and return. -* Interactive Shell:: Permanent shell taking input via XEmacs. -* Shell Mode:: Special XEmacs commands used with permanent shell. -* Terminal emulator:: An XEmacs window as a terminal emulator. -* Term Mode:: Special XEmacs commands used in Term mode. -* Paging in Term:: Paging in the terminal emulator. -@end menu - -@node Single Shell, Interactive Shell, Shell, Shell -@subsection Single Shell Commands - -@kindex M-! -@findex shell-command - @kbd{M-!} (@code{shell-command}) reads a line of text using the -minibuffer and creates an inferior shell to execute the line as a command. -Standard input from the command comes from the null device. If the shell -command produces any output, the output goes to an XEmacs buffer named -@samp{*Shell Command Output*}, which is displayed in another window but not -selected. A numeric argument, as in @kbd{M-1 M-!}, directs this command to -insert any output into the current buffer. In that case, point is left -before the output and the mark is set after the output. - -@kindex M-| -@findex shell-command-on-region - @kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!} but passes -the contents of the region as input to the shell command, instead of no -input. If a numeric argument is used to direct output to the current -buffer, then the old region is deleted first and the output replaces it as -the contents of the region.@refill - -@vindex shell-file-name -@cindex environment - Both @kbd{M-!} and @kbd{M-|} use @code{shell-file-name} to specify the -shell to use. This variable is initialized based on your @code{SHELL} -environment variable when you start XEmacs. If the file name does not -specify a directory, the directories in the list @code{exec-path} are -searched; this list is initialized based on the @code{PATH} environment -variable when you start XEmacs. You can override either or both of these -default initializations in your @file{.emacs} file.@refill - - When you use @kbd{M-!} and @kbd{M-|}, XEmacs has to wait until the -shell command completes. You can quit with @kbd{C-g}; that terminates -the shell command. - -@node Interactive Shell, Shell Mode, Single Shell, Shell -@subsection Interactive Inferior Shell - -@findex shell - To run a subshell interactively with its typescript in an XEmacs -buffer, use @kbd{M-x shell}. This creates (or reuses) a buffer named -@samp{*shell*} and runs a subshell with input coming from and output going -to that buffer. That is to say, any ``terminal output'' from the subshell -will go into the buffer, advancing point, and any ``terminal input'' for -the subshell comes from text in the buffer. To give input to the subshell, -go to the end of the buffer and type the input, terminated by @key{RET}. - - XEmacs does not wait for the subshell to do anything. You can switch -windows or buffers and edit them while the shell is waiting, or while it is -running a command. Output from the subshell waits until XEmacs has time to -process it; this happens whenever XEmacs is waiting for keyboard input or -for time to elapse. - - To get multiple subshells, change the name of buffer -@samp{*shell*} to something different by using @kbd{M-x rename-buffer}. The -next use of @kbd{M-x shell} creates a new buffer @samp{*shell*} with -its own subshell. By renaming this buffer as well you can create a third -one, and so on. All the subshells run independently and in parallel. - -@vindex explicit-shell-file-name - The file name used to load the subshell is the value of the variable -@code{explicit-shell-file-name}, if that is non-@code{nil}. Otherwise, the -environment variable @code{ESHELL} is used, or the environment variable -@code{SHELL} if there is no @code{ESHELL}. If the file name specified -is relative, the directories in the list @code{exec-path} are searched -(@pxref{Single Shell,Single Shell Commands}).@refill - - As soon as the subshell is started, it is sent as input the contents of -the file @file{~/.emacs_@var{shellname}}, if that file exists, where -@var{shellname} is the name of the file that the shell was loaded from. -For example, if you use @code{csh}, the file sent to it is -@file{~/.emacs_csh}.@refill - -@vindex shell-pushd-regexp -@vindex shell-popd-regexp -@vindex shell-cd-regexp - @code{cd}, @code{pushd}, and @code{popd} commands given to the inferior -shell are watched by XEmacs so it can keep the @samp{*shell*} buffer's -default directory the same as the shell's working directory. These -commands are recognized syntactically by examining lines of input that are -sent. If you use aliases for these commands, you can tell XEmacs to -recognize them also. For example, if the value of the variable -@code{shell-pushd-regexp} matches the beginning of a shell command line, -that line is regarded as a @code{pushd} command. Change this variable when -you add aliases for @samp{pushd}. Likewise, @code{shell-popd-regexp} and -@code{shell-cd-regexp} are used to recognize commands with the meaning of -@samp{popd} and @samp{cd}.@refill - -@kbd{M-x shell-resync-dirs} queries the shell and resynchronizes XEmacs' -idea of what the current directory stack is. @kbd{M-x -shell-dirtrack-toggle} turns directory tracking on and off. - -@vindex input-ring-size -XEmacs keeps a history of the most recent commands you have typed in the -@samp{*shell*} buffer. If you are at the beginning of a shell command -line and type @key{M-p}, the previous shell input is inserted into the -buffer before point. Immediately typing @key{M-p} again deletes that -input and inserts the one before it. By repeating @key{M-p} you can -move backward through your commands until you find one you want to -repeat. You may then edit the command before typing @key{RET} if you -wish. @key{M-n} moves forward through the command history, in case you -moved backward past the one you wanted while using @key{M-p}. If you -type the first few characters of a previous command and then type -@key{M-p}, the most recent shell input starting with those characters is -inserted. This can be very convenient when you are repeating a sequence -of shell commands. The variable @code{input-ring-size} controls how -many commands are saved in your input history. The default is 30. - - -@node Shell Mode, Terminal emulator, Interactive Shell, Shell -@subsection Shell Mode - -@cindex Shell mode - The shell buffer uses Shell mode, which defines several special keys -attached to the @kbd{C-c} prefix. They are chosen to resemble the usual -editing and job control characters present in shells that are not under -XEmacs, except that you must type @kbd{C-c} first. Here is a list -of the special key bindings of Shell mode: - -@kindex RET (Shell mode) -@kindex C-c C-d (Shell mode) -@kindex C-d (Shell mode) -@kindex C-c C-u (Shell mode) -@kindex C-c C-w (Shell mode) -@kindex C-c C-c (Shell mode) -@kindex C-c C-z (Shell mode) -@kindex C-c C-\ (Shell mode) -@kindex C-c C-o (Shell mode) -@kindex C-c C-r (Shell mode) -@kindex C-c C-y (Shell mode) -@kindex M-p (Shell mode) -@kindex M-n (Shell mode) -@kindex TAB (Shell mode) -@findex send-shell-input -@findex shell-send-eof -@findex comint-delchar-or-maybe-eof -@findex interrupt-shell-subjob -@findex stop-shell-subjob -@findex quit-shell-subjob -@findex kill-output-from-shell -@findex show-output-from-shell -@findex copy-last-shell-input -@findex comint-previous-input -@findex comint-next-input -@findex comint-dynamic-complete -@vindex shell-prompt-pattern -@table @kbd -@item @key{RET} -At end of buffer send line as input; otherwise, copy current line to end of -buffer and send it (@code{send-shell-input}). When a line is copied, any -text at the beginning of the line that matches the variable -@code{shell-prompt-pattern} is left out; this variable's value should be a -regexp string that matches the prompts that you use in your subshell. -@item C-c C-d -Send end-of-file as input, probably causing the shell or its current -subjob to finish (@code{shell-send-eof}). -@item C-d -If point is not at the end of the buffer, delete the next character just -like most other modes. If point is at the end of the buffer, send -end-of-file as input, instead of generating an error as in other modes -(@code{comint-delchar-or-maybe-eof}). -@item C-c C-u -Kill all text that has yet to be sent as input (@code{kill-shell-input}). -@item C-c C-w -Kill a word before point (@code{backward-kill-word}). -@item C-c C-c -Interrupt the shell or its current subjob if any -(@code{interrupt-shell-subjob}). -@item C-c C-z -Stop the shell or its current subjob if any (@code{stop-shell-subjob}). -@item C-c C-\ -Send quit signal to the shell or its current subjob if any -(@code{quit-shell-subjob}). -@item C-c C-o -Delete last batch of output from shell (@code{kill-output-from-shell}). -@item C-c C-r -Scroll top of last batch of output to top of window -(@code{show-output-from-shell}). -@item C-c C-y -Copy the previous bunch of shell input and insert it into the -buffer before point (@code{copy-last-shell-input}). No final newline -is inserted, and the input copied is not resubmitted until you type -@key{RET}. -@item M-p -Move backward through the input history. Search for a matching command -if you have typed the beginning of a command (@code{comint-previous-input}). -@item M-n -Move forward through the input history. Useful when you are -using @key{M-p} quickly and go past the desired command -(@code{comint-next-input}). -@item @key{TAB} -Complete the file name preceding point (@code{comint-dynamic-complete}). -@end table - -@node Terminal emulator, Term Mode, Shell Mode, Shell -@subsection Interactive Inferior Shell with Terminal Emulator -@findex term - - To run a subshell in a terminal emulator, putting its typescript in an XEmacs -buffer, use @kbd{M-x term}. This creates (or reuses) a buffer named -@samp{*term*} and runs a subshell with input coming from your keyboard and -output going to that buffer. - -All the normal keys that you type are sent without any interpretation -by XEmacs directly to the subshell, as ``terminal input.'' -Any ``echo'' of your input is the responsibility of the subshell. -(The exception is the terminal escape character, -which by default is @kbd{C-c}. @pxref{Term Mode}.) -Any ``terminal output'' from the subshell goes into the buffer, -advancing point. - - Some programs (such as XEmacs itself) need to control the -appearance on the terminal screen in detail. They do this by -sending special control codes. The exact control -codes needed vary from terminal to terminal, but nowadays -most terminals and terminal emulators (including xterm) -understand the so-called "ANSI escape sequences" (first -popularized by the Digital's VT100 family of terminal). -The term mode also understands these escape sequences, -and for each control code does the appropriate thing -to change the buffer so that the appearance of the window -will match what it would be on a real terminal. -Thus you can actually run XEmacs inside an XEmacs Term window! - - XEmacs does not wait for the subshell to do anything. You can switch -windows or buffers and edit them while the shell is waiting, or while -it is running a command. Output from the subshell waits until XEmacs -has time to process it; this happens whenever XEmacs is waiting for -keyboard input or for time to elapse. - - To make multiple terminal emulators, rename the buffer @samp{*term*} -to something different using @kbd{M-x rename-uniquely}, -just as with Shell mode. - - The file name used to load the subshell is determined -the same way as for Shell mode. - -Unlike Shell mode, Term mode does not track the current directory -by examining your input. Instead, if you use a programmable -shell, you can have it tell Term what the current directory is. -This is done automatically by bash for version 1.15 and later. - -@node Term Mode, Paging in Term, Terminal emulator, Shell -@subsection Term Mode -@cindex Term mode -@cindex mode, Term - - Term uses Term mode, which has two input modes: -In line mode, Term basically acts like Shell mode. @xref{Shell Mode}. -In Char mode, each character is sent directly to the inferior subshell, -except for the Term escape character, normally @kbd{C-c}. - -To switch between line and char mode, use these commands: -@table @kbd -@kindex C-c C-k @r{(Term mode)} -findex term-char-mode -@item C-c C-k -Switch to line mode. Do nothing if already in line mode. - -@kindex C-c C-j @r{(Term mode)} -@findex term-line-mode -@item C-c C-j -Switch to char mode. Do nothing if already in char mode. -@end table - -The following commands are only available in Char mode: -@table @kbd -@item C-c C-c -Send a literal @key{C-c} to the sub-shell. - -@item C-c C-x -A prefix command to conveniently access the global @key{C-x} commands. -For example, @kbd{C-c C-x o} invokes the global binding of -@kbd{C-x o}, which is normally @samp{other-window}. -@end table - -@node Paging in Term,, Term Mode, Shell -@subsection Paging in the terminal emulator - -Term mode has a pager feature. When the pager is enabled, -term mode will pause at the end of each screenful. - -@table @kbd -@kindex C-c C-q @r{(Term mode)} -@findex term-pager-toggle -@item C-c C-q -Toggles the pager feature: Disables the pager if it is enabled, -and vice versa. This works in both line and char modes. -If the pager enabled, the mode-line contains the word @samp{page}. -@end table - -If the pager is enabled, and Term receives more than a screenful -of output since your last input, Term will enter More break mode. -This is indicated by @samp{**MORE**} in the mode-line. -Type a @kbd{Space} to display the next screenful of output. -Type @kbd{?} to see your other options. The interface is similar -to the Unix @samp{more} program. - -@node Narrowing, Hardcopy, Shell, Top -@section Narrowing -@cindex widening -@cindex restriction -@cindex narrowing - - @dfn{Narrowing} means focusing in on some portion of the buffer, making -the rest temporarily invisible and inaccessible. Cancelling the narrowing -and making the entire buffer once again visible is called @dfn{widening}. -The amount of narrowing in effect in a buffer at any time is called the -buffer's @dfn{restriction}. - -@c WideCommands -@table @kbd -@item C-x n n -Narrow down to between point and mark (@code{narrow-to-region}). -@item C-x n w -Widen to make the entire buffer visible again (@code{widen}). -@end table - - Narrowing sometimes makes it easier to concentrate on a single -subroutine or paragraph by eliminating clutter. It can also be used to -restrict the range of operation of a replace command or repeating -keyboard macro. The word @samp{Narrow} appears in the mode line -whenever narrowing is in effect. When you have narrowed to a part of the -buffer, that part appears to be all there is. You can't see the rest, -can't move into it (motion commands won't go outside the visible part), -and can't change it in any way. However, the invisible text is not -gone; if you save the file, it will be saved. - -@kindex C-x n n -@findex narrow-to-region - The primary narrowing command is @kbd{C-x n n} (@code{narrow-to-region}). -It sets the current buffer's restrictions so that the text in the current -region remains visible but all text before the region or after the region -is invisible. Point and mark do not change. - - Because narrowing can easily confuse users who do not understand it, -@code{narrow-to-region} is normally a disabled command. Attempting to use -this command asks for confirmation and gives you the option of enabling it; -once you enable the command, confirmation will no longer be required. @xref{Disabling}. - -@kindex C-x n w -@findex widen - To undo narrowing, use @kbd{C-x n w} (@code{widen}). This makes all -text in the buffer accessible again. - - Use the @kbd{C-x =} command to get information on what part of the -buffer you narrowed down. @xref{Position Info}. - -@node Hardcopy, Recursive Edit, Narrowing, Top -@section Hardcopy Output -@cindex hardcopy - - The XEmacs commands for making hardcopy derive their names from the -Unix commands @samp{print} and @samp{lpr}. - -@table @kbd -@item M-x print-buffer -Print hardcopy of current buffer using Unix command @samp{print} -@*(@samp{lpr -p}). This command adds page headings containing the file name -and page number. -@item M-x lpr-buffer -Print hardcopy of current buffer using Unix command @samp{lpr}. -This command does not add page headings. -@item M-x print-region -Like @code{print-buffer}, but prints only the current region. -@item M-x lpr-region -Like @code{lpr-buffer}, but prints only the current region. -@end table - -@findex print-buffer -@findex print-region -@findex lpr-buffer -@findex lpr-region -@vindex lpr-switches - All the hardcopy commands pass extra switches to the @code{lpr} program -based on the value of the variable @code{lpr-switches}. Its value should -be a list of strings, each string a switch starting with @samp{-}. For -example, the value could be @code{("-Pfoo")} to print on printer -@samp{foo}. - -@node Recursive Edit, Dissociated Press, Hardcopy, Top -@section Recursive Editing Levels -@cindex recursive editing level -@cindex editing level, recursive - - A @dfn{recursive edit} is a situation in which you are using XEmacs -commands to perform arbitrary editing while in the middle of another -XEmacs command. For example, when you type @kbd{C-r} inside a -@code{query-replace}, you enter a recursive edit in which you can change -the current buffer. When you exit from the recursive edit, you go back to -the @code{query-replace}. - -@kindex C-M-c -@findex exit-recursive-edit -@cindex exiting - @dfn{Exiting} a recursive edit means returning to the unfinished -command, which continues execution. For example, exiting the recursive -edit requested by @kbd{C-r} in @code{query-replace} causes query replacing -to resume. Exiting is done with @kbd{C-M-c} (@code{exit-recursive-edit}). - -@kindex C-] -@findex abort-recursive-edit - You can also @dfn{abort} a recursive edit. This is like exiting, but -also quits the unfinished command immediately. Use the command @kbd{C-]} -(@code{abort-recursive-edit}) for this. @xref{Quitting}. - - The mode line shows you when you are in a recursive edit by displaying -square brackets around the parentheses that always surround the major -and minor mode names. Every window's mode line shows the square -brackets, since XEmacs as a whole, rather than any particular buffer, is -in a recursive edit. - -@findex top-level - It is possible to be in recursive edits within recursive edits. For -example, after typing @kbd{C-r} in a @code{query-replace}, you might -type a command that entered the debugger. In such a case, two or -more sets of square brackets appear in the mode line(s). Exiting the -inner recursive edit (here with the debugger @kbd{c} command) -resumes the query-replace command where it called the debugger. After -the end of the query-replace command, you would be able to exit the -first recursive edit. Aborting exits only one level of recursive edit; -it returns to the command level of the previous recursive edit. You can -then abort that one as well. - - The command @kbd{M-x top-level} aborts all levels of -recursive edits, returning immediately to the top level command reader. - - The text you edit inside the recursive edit need not be the same text -that you were editing at top level. If the command that invokes the -recursive edit selects a different buffer first, that is the buffer you -will edit recursively. You can switch buffers within the recursive edit -in the normal manner (as long as the buffer-switching keys have not been -rebound). While you could theoretically do the rest of your editing -inside the recursive edit, including visiting files, this could have -surprising effects (such as stack overflow) from time to time. It is -best if you always exit or abort a recursive edit when you no longer -need it. - - In general, XEmacs tries to avoid using recursive edits. It is -usually preferable to allow users to switch among the possible editing -modes in any order they like. With recursive edits, the only way to get -to another state is to go ``back'' to the state that the recursive edit -was invoked from. - -@node Dissociated Press, CONX, Recursive Edit, Top -@section Dissociated Press - -@findex dissociated-press - @kbd{M-x dissociated-press} is a command for scrambling a file of text -either word by word or character by character. Starting from a buffer of -straight English, it produces extremely amusing output. The input comes -from the current XEmacs buffer. Dissociated Press writes its output in a -buffer named @samp{*Dissociation*}, and redisplays that buffer after every -couple of lines (approximately) to facilitate reading it. - - @code{dissociated-press} asks every so often whether to continue -operating. Answer @kbd{n} to stop it. You can also stop at any time by -typing @kbd{C-g}. The dissociation output remains in the @samp{*Dissociation*} -buffer for you to copy elsewhere if you wish. - -@cindex presidentagon - Dissociated Press operates by jumping at random from one point in the -buffer to another. In order to produce plausible output rather than -gibberish, it insists on a certain amount of overlap between the end of one -run of consecutive words or characters and the start of the next. That is, -if it has just printed out `president' and then decides to jump to a -different point in the file, it might spot the `ent' in `pentagon' and -continue from there, producing `presidentagon'. Long sample texts produce -the best results. - -@cindex againformation - A positive argument to @kbd{M-x dissociated-press} tells it to operate -character by character, and specifies the number of overlap characters. A -negative argument tells it to operate word by word and specifies the number -of overlap words. In this mode, whole words are treated as the elements to -be permuted, rather than characters. No argument is equivalent to an -argument of two. For your againformation, the output goes only into the -buffer @samp{*Dissociation*}. The buffer you start with is not changed. - -@cindex Markov chain -@cindex ignoriginal -@cindex techniquitous - Dissociated Press produces nearly the same results as a Markov chain -based on a frequency table constructed from the sample text. It is, -however, an independent, ignoriginal invention. Dissociated Press -techniquitously copies several consecutive characters from the sample -between random choices, whereas a Markov chain would choose randomly for -each word or character. This makes for more plausible sounding results -and runs faster. - -@cindex outragedy -@cindex buggestion -@cindex properbose - It is a mustatement that too much use of Dissociated Press can be a -developediment to your real work. Sometimes to the point of outragedy. -And keep dissociwords out of your documentation, if you want it to be well -userenced and properbose. Have fun. Your buggestions are welcome. - -@node CONX, Amusements, Dissociated Press, Top -@section CONX -@cindex random sentences - -Besides producing a file of scrambled text with Dissociated Press, you -can generate random sentences by using CONX. - -@table @kbd -@item M-x conx -Generate random sentences in the @code{*conx*} buffer. -@item M-x conx-buffer -Absorb the text in the current buffer into the @code{conx} database. -@item M-x conx-init -Forget the current word-frequency tree. -@item M-x conx-load -Load a @code{conx} database that has been previously saved with -@code{M-x conx-save}. -@item M-x conx-region -Absorb the text in the current buffer into the @code{conx} database. -@item M-x conx-save -Save the current @code{conx} database to a file for future retrieval. -@end table - -@findex conx -@findex conx-buffer -@findex conx-load -@findex conx-region -@findex conx-init -@findex conx-save - -Copy text from a buffer using @kbd{M-x conx-buffer} or @kbd{M-x conx-region} -and then type @kbd{M-x conx}. Output is continuously generated until you -type @key{^G}. You can save the @code{conx} database to a file with -@kbd{M-x conx-save}, which you can retrieve with @code{M-x conx-load}. -To clear the database, use @code{M-x conx-init}. - -@node Amusements, Emulation, CONX, Top -@section Other Amusements -@cindex boredom -@findex hanoi -@findex yow - - If you are a little bit bored, you can try @kbd{M-x hanoi}. If you are -considerably bored, give it a numeric argument. If you are very, very -bored, try an argument of 9. Sit back and watch. - - When you are frustrated, try the famous Eliza program. Just do -@kbd{M-x doctor}. End each input by typing @kbd{RET} twice. - - When you are feeling strange, type @kbd{M-x yow}. - -@node Emulation, Customization, Amusements, Top -@comment node-name, next, previous, up -@section Emulation -@cindex other editors -@cindex vi -@cindex EDT - - XEmacs can be programmed to emulate (more or less) most other -editors. Standard facilities can emulate these: - -@table @asis -@item Viper (a vi emulator) -@cindex Viper -In XEmacs, Viper is the preferred emulation of vi within XEmacs. -Viper is designed to allow you to take advantage of the best -features of XEmacs while still doing your basic editing in a -familiar, vi-like fashion. Viper provides various different -levels of vi emulation, from a quite complete emulation that -allows almost no access to native XEmacs commands, to an -``expert'' mode that combines the most useful vi commands with -the most useful XEmacs commands. - -To start Viper, put the command - -@example -(viper-mode) -@end example - -in your @file{.emacs} file. - -Viper comes with a separate manual that is provided standard -with the XEmacs distribution. - -@ignore -@item evi (alternative vi emulator) -@cindex evi -evi is an alternative vi emulator that also provides a nearly complete -emulation of vi. - -evi comes with a separate manual that is provided standard -with the XEmacs distribution. - -Warning: loading more than one vi emulator at once may cause name -conflicts; no one has checked. -@end ignore - -@item EDT (DEC VMS editor) -@findex edt-emulation-on -@findex edt-emulation-off -Turn on EDT emulation with @kbd{M-x edt-emulation-on}. @kbd{M-x -@*edt-emulation-off} restores normal Emacs command bindings. - -Most of the EDT emulation commands are keypad keys, and most standard -Emacs key bindings are still available. The EDT emulation rebindings -are done in the global keymap, so there is no problem switching -buffers or major modes while in EDT emulation. - -@item Gosling Emacs -@findex set-gosmacs-bindings -@findex set-gnu-bindings -Turn on emulation of Gosling Emacs (aka Unipress Emacs) with @kbd{M-x -set-gosmacs-bindings}. This redefines many keys, mostly on the -@kbd{C-x} and @kbd{ESC} prefixes, to work as they do in Gosmacs. -@kbd{M-x set-gnu-bindings} returns to normal XEmacs by rebinding -the same keys to the definitions they had at the time @kbd{M-x -set-gosmacs-bindings} was done. - -It is also possible to run Mocklisp code written for Gosling Emacs. -@xref{Mocklisp}. -@end table diff --git a/man/xemacs/mule.texi b/man/xemacs/mule.texi deleted file mode 100644 index 66cb453..0000000 --- a/man/xemacs/mule.texi +++ /dev/null @@ -1,540 +0,0 @@ -@c This is part of the Emacs manual. -@c Copyright (C) 1997 Free Software Foundation, Inc. -@c See file emacs.texi for copying conditions. -@node Mule, Major Modes, Windows, Top -@chapter World Scripts Support -@cindex MULE -@cindex international scripts -@cindex multibyte characters -@cindex encoding of characters - -@cindex Chinese -@cindex Greek -@cindex IPA -@cindex Japanese -@cindex Korean -@cindex Russian - If you compile XEmacs with mule option, it supports a wide variety of -world scripts, including Latin script, as well as Arabic script, -Simplified Chinese script (for mainland of China), Traditional Chinese -script (for Taiwan and Hong-Kong), Greek script, Hebrew script, IPA -symbols, Japanese scripts (Hiragana, Katakana and Kanji), Korean scripts -(Hangul and Hanja) and Cyrillic script (for Beylorussian, Bulgarian, -Russian, Serbian and Ukrainian). These features have been merged from -the modified version of Emacs known as MULE (for ``MULti-lingual -Enhancement to GNU Emacs''). - -@menu -* Mule Intro:: Basic concepts of Mule. -* Language Environments:: Setting things up for the language you use. -* Input Methods:: Entering text characters not on your keyboard. -* Select Input Method:: Specifying your choice of input methods. -* Coding Systems:: Character set conversion when you read and - write files, and so on. -* Recognize Coding:: How XEmacs figures out which conversion to use. -* Specify Coding:: Various ways to choose which conversion to use. -@end menu - -@node Mule Intro, Language Environments, Mule, Mule -@section Introduction to world scripts - - The users of these scripts have established many more-or-less standard -coding systems for storing files. -@c XEmacs internally uses a single multibyte character encoding, so that it -@c can intermix characters from all these scripts in a single buffer or -@c string. This encoding represents each non-ASCII character as a sequence -@c of bytes in the range 0200 through 0377. -XEmacs translates between the internal character encoding and various -other coding systems when reading and writing files, when exchanging -data with subprocesses, and (in some cases) in the @kbd{C-q} command -(see below). - -@kindex C-h h -@findex view-hello-file - The command @kbd{C-h h} (@code{view-hello-file}) displays the file -@file{etc/HELLO}, which shows how to say ``hello'' in many languages. -This illustrates various scripts. - - Keyboards, even in the countries where these character sets are used, -generally don't have keys for all the characters in them. So XEmacs -supports various @dfn{input methods}, typically one for each script or -language, to make it convenient to type them. - -@kindex C-x RET - The prefix key @kbd{C-x @key{RET}} is used for commands that pertain -to world scripts, coding systems, and input methods. - - -@node Language Environments, Input Methods, Mule Intro, Mule -@section Language Environments -@cindex language environments - - All supported character sets are supported in XEmacs buffers if it is -compile with mule; there is no need to select a particular language in -order to display its characters in an XEmacs buffer. However, it is -important to select a @dfn{language environment} in order to set various -defaults. The language environment really represents a choice of -preferred script (more or less) rather that a choice of language. - - The language environment controls which coding systems to recognize -when reading text (@pxref{Recognize Coding}). This applies to files, -incoming mail, netnews, and any other text you read into XEmacs. It may -also specify the default coding system to use when you create a file. -Each language environment also specifies a default input method. - -@findex set-language-environment - The command to select a language environment is @kbd{M-x -set-language-environment}. It makes no difference which buffer is -current when you use this command, because the effects apply globally to -the XEmacs session. The supported language environments include: - -@quotation -Chinese-BIG5, Chinese-CNS, Chinese-GB, Cyrillic-ISO, English, Ethiopic, -Greek, Japanese, Korean, Latin-1, Latin-2, Latin-3, Latin-4, Latin-5. -@end quotation - - Some operating systems let you specify the language you are using by -setting locale environment variables. XEmacs handles one common special -case of this: if your locale name for character types contains the -string @samp{8859-@var{n}}, XEmacs automatically selects the -corresponding language environment. - -@kindex C-h L -@findex describe-language-environment - To display information about the effects of a certain language -environment @var{lang-env}, use the command @kbd{C-h L @var{lang-env} -@key{RET}} (@code{describe-language-environment}). This tells you which -languages this language environment is useful for, and lists the -character sets, coding systems, and input methods that go with it. It -also shows some sample text to illustrate scripts used in this language -environment. By default, this command describes the chosen language -environment. - -@node Input Methods, Select Input Method, Language Environments, Mule -@section Input Methods - -@cindex input methods - An @dfn{input method} is a kind of character conversion designed -specifically for interactive input. In XEmacs, typically each language -has its own input method; sometimes several languages which use the same -characters can share one input method. A few languages support several -input methods. - - The simplest kind of input method works by mapping ASCII letters into -another alphabet. This is how the Greek and Russian input methods work. - - A more powerful technique is composition: converting sequences of -characters into one letter. Many European input methods use composition -to produce a single non-ASCII letter from a sequence that consists of a -letter followed by accent characters. For example, some methods convert -the sequence @kbd{'a} into a single accented letter. - - The input methods for syllabic scripts typically use mapping followed -by composition. The input methods for Thai and Korean work this way. -First, letters are mapped into symbols for particular sounds or tone -marks; then, sequences of these which make up a whole syllable are -mapped into one syllable sign. - - Chinese and Japanese require more complex methods. In Chinese input -methods, first you enter the phonetic spelling of a Chinese word (in -input method @code{chinese-py}, among others), or a sequence of portions -of the character (input methods @code{chinese-4corner} and -@code{chinese-sw}, and others). Since one phonetic spelling typically -corresponds to many different Chinese characters, you must select one of -the alternatives using special XEmacs commands. Keys such as @kbd{C-f}, -@kbd{C-b}, @kbd{C-n}, @kbd{C-p}, and digits have special definitions in -this situation, used for selecting among the alternatives. @key{TAB} -displays a buffer showing all the possibilities. - - In Japanese input methods, first you input a whole word using -phonetic spelling; then, after the word is in the buffer, XEmacs -converts it into one or more characters using a large dictionary. One -phonetic spelling corresponds to many differently written Japanese -words, so you must select one of them; use @kbd{C-n} and @kbd{C-p} to -cycle through the alternatives. - - Sometimes it is useful to cut off input method processing so that the -characters you have just entered will not combine with subsequent -characters. For example, in input method @code{latin-1-postfix}, the -sequence @kbd{e '} combines to form an @samp{e} with an accent. What if -you want to enter them as separate characters? - - One way is to type the accent twice; that is a special feature for -entering the separate letter and accent. For example, @kbd{e ' '} gives -you the two characters @samp{e'}. Another way is to type another letter -after the @kbd{e}---something that won't combine with that---and -immediately delete it. For example, you could type @kbd{e e @key{DEL} -'} to get separate @samp{e} and @samp{'}. - - Another method, more general but not quite as easy to type, is to use -@kbd{C-\ C-\} between two characters to stop them from combining. This -is the command @kbd{C-\} (@code{toggle-input-method}) used twice. -@ifinfo -@xref{Select Input Method}. -@end ifinfo - - @kbd{C-\ C-\} is especially useful inside an incremental search, -because stops waiting for more characters to combine, and starts -searching for what you have already entered. - -@vindex input-method-verbose-flag -@vindex input-method-highlight-flag - The variables @code{input-method-highlight-flag} and -@code{input-method-verbose-flag} control how input methods explain what -is happening. If @code{input-method-highlight-flag} is non-@code{nil}, -the partial sequence is highlighted in the buffer. If -@code{input-method-verbose-flag} is non-@code{nil}, the list of possible -characters to type next is displayed in the echo area (but not when you -are in the minibuffer). - -@node Select Input Method, Coding Systems, Input Methods, Mule -@section Selecting an Input Method - -@table @kbd -@item C-\ -Enable or disable use of the selected input method. - -@item C-x @key{RET} C-\ @var{method} @key{RET} -Select a new input method for the current buffer. - -@item C-h I @var{method} @key{RET} -@itemx C-h C-\ @var{method} @key{RET} -@findex describe-input-method -@kindex C-h I -@kindex C-h C-\ -Describe the input method @var{method} (@code{describe-input-method}). -By default, it describes the current input method (if any). - -@item M-x list-input-methods -Display a list of all the supported input methods. -@end table - -@findex select-input-method -@vindex current-input-method -@kindex C-x RET C-\ - To choose an input method for the current buffer, use @kbd{C-x -@key{RET} C-\} (@code{select-input-method}). This command reads the -input method name with the minibuffer; the name normally starts with the -language environment that it is meant to be used with. The variable -@code{current-input-method} records which input method is selected. - -@findex toggle-input-method -@kindex C-\ - Input methods use various sequences of ASCII characters to stand for -non-ASCII characters. Sometimes it is useful to turn off the input -method temporarily. To do this, type @kbd{C-\} -(@code{toggle-input-method}). To reenable the input method, type -@kbd{C-\} again. - - If you type @kbd{C-\} and you have not yet selected an input method, -it prompts for you to specify one. This has the same effect as using -@kbd{C-x @key{RET} C-\} to specify an input method. - -@vindex default-input-method - Selecting a language environment specifies a default input method for -use in various buffers. When you have a default input method, you can -select it in the current buffer by typing @kbd{C-\}. The variable -@code{default-input-method} specifies the default input method -(@code{nil} means there is none). - -@findex quail-set-keyboard-layout - Some input methods for alphabetic scripts work by (in effect) -remapping the keyboard to emulate various keyboard layouts commonly used -for those scripts. How to do this remapping properly depends on your -actual keyboard layout. To specify which layout your keyboard has, use -the command @kbd{M-x quail-set-keyboard-layout}. - -@findex list-input-methods - To display a list of all the supported input methods, type @kbd{M-x -list-input-methods}. The list gives information about each input -method, including the string that stands for it in the mode line. - -@node Coding Systems, Recognize Coding, Select Input Method, Mule -@section Coding Systems -@cindex coding systems - - Users of various languages have established many more-or-less standard -coding systems for representing them. XEmacs does not use these coding -systems internally; instead, it converts from various coding systems to -its own system when reading data, and converts the internal coding -system to other coding systems when writing data. Conversion is -possible in reading or writing files, in sending or receiving from the -terminal, and in exchanging data with subprocesses. - - XEmacs assigns a name to each coding system. Most coding systems are -used for one language, and the name of the coding system starts with the -language name. Some coding systems are used for several languages; -their names usually start with @samp{iso}. There are also special -coding systems @code{binary} and @code{no-conversion} which do not -convert printing characters at all. - - In addition to converting various representations of non-ASCII -characters, a coding system can perform end-of-line conversion. XEmacs -handles three different conventions for how to separate lines in a file: -newline, carriage-return linefeed, and just carriage-return. - -@table @kbd -@item C-h C @var{coding} @key{RET} -Describe coding system @var{coding}. - -@item C-h C @key{RET} -Describe the coding systems currently in use. - -@item M-x list-coding-systems -Display a list of all the supported coding systems. -@end table - -@kindex C-h C -@findex describe-coding-system - The command @kbd{C-h C} (@code{describe-coding-system}) displays -information about particular coding systems. You can specify a coding -system name as argument; alternatively, with an empty argument, it -describes the coding systems currently selected for various purposes, -both in the current buffer and as the defaults, and the priority list -for recognizing coding systems (@pxref{Recognize Coding}). - -@findex list-coding-systems - To display a list of all the supported coding systems, type @kbd{M-x -list-coding-systems}. The list gives information about each coding -system, including the letter that stands for it in the mode line -(@pxref{Mode Line}). - - Each of the coding systems that appear in this list---except for -@code{binary}, which means no conversion of any kind---specifies how and -whether to convert printing characters, but leaves the choice of -end-of-line conversion to be decided based on the contents of each file. -For example, if the file appears to use carriage-return linefeed between -lines, that end-of-line conversion will be used. - - Each of the listed coding systems has three variants which specify -exactly what to do for end-of-line conversion: - -@table @code -@item @dots{}-unix -Don't do any end-of-line conversion; assume the file uses -newline to separate lines. (This is the convention normally used -on Unix and GNU systems.) - -@item @dots{}-dos -Assume the file uses carriage-return linefeed to separate lines, -and do the appropriate conversion. (This is the convention normally used -on Microsoft systems.) - -@item @dots{}-mac -Assume the file uses carriage-return to separate lines, and do the -appropriate conversion. (This is the convention normally used on the -Macintosh system.) -@end table - - These variant coding systems are omitted from the -@code{list-coding-systems} display for brevity, since they are entirely -predictable. For example, the coding system @code{iso-8859-1} has -variants @code{iso-8859-1-unix}, @code{iso-8859-1-dos} and -@code{iso-8859-1-mac}. - - In contrast, the coding system @code{binary} specifies no character -code conversion at all---none for non-Latin-1 byte values and none for -end of line. This is useful for reading or writing binary files, tar -files, and other files that must be examined verbatim. - - The easiest way to edit a file with no conversion of any kind is with -the @kbd{M-x find-file-literally} command. This uses @code{binary}, and -also suppresses other XEmacs features that might convert the file -contents before you see them. @xref{Visiting}. - - The coding system @code{no-conversion} means that the file contains -non-Latin-1 characters stored with the internal XEmacs encoding. It -handles end-of-line conversion based on the data encountered, and has -the usual three variants to specify the kind of end-of-line conversion. - - -@node Recognize Coding, Specify Coding, Coding Systems, Mule -@section Recognizing Coding Systems - - Most of the time, XEmacs can recognize which coding system to use for -any given file--once you have specified your preferences. - - Some coding systems can be recognized or distinguished by which byte -sequences appear in the data. However, there are coding systems that -cannot be distinguished, not even potentially. For example, there is no -way to distinguish between Latin-1 and Latin-2; they use the same byte -values with different meanings. - - XEmacs handles this situation by means of a priority list of coding -systems. Whenever XEmacs reads a file, if you do not specify the coding -system to use, XEmacs checks the data against each coding system, -starting with the first in priority and working down the list, until it -finds a coding system that fits the data. Then it converts the file -contents assuming that they are represented in this coding system. - - The priority list of coding systems depends on the selected language -environment (@pxref{Language Environments}). For example, if you use -French, you probably want XEmacs to prefer Latin-1 to Latin-2; if you -use Czech, you probably want Latin-2 to be preferred. This is one of -the reasons to specify a language environment. - -@findex prefer-coding-system - However, you can alter the priority list in detail with the command -@kbd{M-x prefer-coding-system}. This command reads the name of a coding -system from the minibuffer, and adds it to the front of the priority -list, so that it is preferred to all others. If you use this command -several times, each use adds one element to the front of the priority -list. - -@vindex file-coding-system-alist - Sometimes a file name indicates which coding system to use for the -file. The variable @code{file-coding-system-alist} specifies this -correspondence. There is a special function -@code{modify-coding-system-alist} for adding elements to this list. For -example, to read and write all @samp{.txt} using the coding system -@code{china-iso-8bit}, you can execute this Lisp expression: - -@smallexample -(modify-coding-system-alist 'file "\\.txt\\'" 'china-iso-8bit) -@end smallexample - -@noindent -The first argument should be @code{file}, the second argument should be -a regular expression that determines which files this applies to, and -the third argument says which coding system to use for these files. - -@vindex coding - You can specify the coding system for a particular file using the -@samp{-*-@dots{}-*-} construct at the beginning of a file, or a local -variables list at the end (@pxref{File Variables}). You do this by -defining a value for the ``variable'' named @code{coding}. XEmacs does -not really have a variable @code{coding}; instead of setting a variable, -it uses the specified coding system for the file. For example, -@samp{-*-mode: C; coding: iso-8859-1;-*-} specifies use of the -iso-8859-1 coding system, as well as C mode. - -@vindex buffer-file-coding-system - Once XEmacs has chosen a coding system for a buffer, it stores that -coding system in @code{buffer-file-coding-system} and uses that coding -system, by default, for operations that write from this buffer into a -file. This includes the commands @code{save-buffer} and -@code{write-region}. If you want to write files from this buffer using -a different coding system, you can specify a different coding system for -the buffer using @code{set-buffer-file-coding-system} (@pxref{Specify -Coding}). - - -@node Specify Coding, , Recognize Coding, Mule -@section Specifying a Coding System - - In cases where XEmacs does not automatically choose the right coding -system, you can use these commands to specify one: - -@table @kbd -@item C-x @key{RET} f @var{coding} @key{RET} -Use coding system @var{coding} for the visited file -in the current buffer. - -@item C-x @key{RET} c @var{coding} @key{RET} -Specify coding system @var{coding} for the immediately following -command. - -@item C-x @key{RET} k @var{coding} @key{RET} -Use coding system @var{coding} for keyboard input. - -@item C-x @key{RET} t @var{coding} @key{RET} -Use coding system @var{coding} for terminal output. - -@item C-x @key{RET} p @var{coding} @key{RET} -Use coding system @var{coding} for subprocess input and output -in the current buffer. -@end table - -@kindex C-x RET f -@findex set-buffer-file-coding-system - The command @kbd{C-x RET f} (@code{set-buffer-file-coding-system}) -specifies the file coding system for the current buffer---in other -words, which coding system to use when saving or rereading the visited -file. You specify which coding system using the minibuffer. Since this -command applies to a file you have already visited, it affects only the -way the file is saved. - -@kindex C-x RET c -@findex universal-coding-system-argument - Another way to specify the coding system for a file is when you visit -the file. First use the command @kbd{C-x @key{RET} c} -(@code{universal-coding-system-argument}); this command uses the -minibuffer to read a coding system name. After you exit the minibuffer, -the specified coding system is used for @emph{the immediately following -command}. - - So if the immediately following command is @kbd{C-x C-f}, for example, -it reads the file using that coding system (and records the coding -system for when the file is saved). Or if the immediately following -command is @kbd{C-x C-w}, it writes the file using that coding system. -Other file commands affected by a specified coding system include -@kbd{C-x C-i} and @kbd{C-x C-v}, as well as the other-window variants of -@kbd{C-x C-f}. - - In addition, if you run some file input commands with the precedent -@kbd{C-u}, you can specify coding system to read from minibuffer. So if -the immediately following command is @kbd{C-x C-f}, for example, it -reads the file using that coding system (and records the coding system -for when the file is saved). Other file commands affected by a -specified coding system include @kbd{C-x C-i} and @kbd{C-x C-v}, as well -as the other-window variants of @kbd{C-x C-f}. - -@vindex default-buffer-file-coding-system - The variable @code{default-buffer-file-coding-system} specifies the -choice of coding system to use when you create a new file. It applies -when you find a new file, and when you create a buffer and then save it -in a file. Selecting a language environment typically sets this -variable to a good choice of default coding system for that language -environment. - -@kindex C-x RET t -@findex set-terminal-coding-system - The command @kbd{C-x @key{RET} t} (@code{set-terminal-coding-system}) -specifies the coding system for terminal output. If you specify a -character code for terminal output, all characters output to the -terminal are translated into that coding system. - - This feature is useful for certain character-only terminals built to -support specific languages or character sets---for example, European -terminals that support one of the ISO Latin character sets. - - By default, output to the terminal is not translated at all. - -@kindex C-x RET k -@findex set-keyboard-coding-system - The command @kbd{C-x @key{RET} k} (@code{set-keyboard-coding-system}) -specifies the coding system for keyboard input. Character-code -translation of keyboard input is useful for terminals with keys that -send non-ASCII graphic characters---for example, some terminals designed -for ISO Latin-1 or subsets of it. - - By default, keyboard input is not translated at all. - - There is a similarity between using a coding system translation for -keyboard input, and using an input method: both define sequences of -keyboard input that translate into single characters. However, input -methods are designed to be convenient for interactive use by humans, and -the sequences that are translated are typically sequences of ASCII -printing characters. Coding systems typically translate sequences of -non-graphic characters. - -@kindex C-x RET p -@findex set-buffer-process-coding-system - The command @kbd{C-x @key{RET} p} (@code{set-buffer-process-coding-system}) -specifies the coding system for input and output to a subprocess. This -command applies to the current buffer; normally, each subprocess has its -own buffer, and thus you can use this command to specify translation to -and from a particular subprocess by giving the command in the -corresponding buffer. - - By default, process input and output are not translated at all. - -@vindex file-name-coding-system - The variable @code{file-name-coding-system} specifies a coding system -to use for encoding file names. If you set the variable to a coding -system name (as a Lisp symbol or a string), XEmacs encodes file names -using that coding system for all file operations. This makes it -possible to use non-Latin-1 characters in file names---or, at least, -those non-Latin-1 characters which the specified coding system can -encode. By default, this variable is @code{nil}, which implies that you -cannot use non-Latin-1 characters in file names. diff --git a/man/xemacs/new.texi b/man/xemacs/new.texi deleted file mode 100644 index 1557dd5..0000000 --- a/man/xemacs/new.texi +++ /dev/null @@ -1,367 +0,0 @@ - -@iftex -@unnumbered XEmacs Features - -This section describes the difference between Emacs Version 18 and -XEmacs. - -@unnumberedsec General Changes - -@itemize @bullet -@ignore -@item -XEmacs has a new vi emulation mode called evi mode. To -start evi mode in Emacs, type the command @kbd{M-x evi}. If you want -Emacs to automatically put you in evi-mode all the time, include this -line in your @file{.emacs} file: -@example -(setq term-setup-hook 'evi) -@end example -@xref{evi Mode} for a brief discussion. -@end ignore - -@item -XEmacs has a new vi emulation mode called ``viper'' mode. To start -viper mode in XEmacs, type the command @kbd{M-x viper-mode}. If you -want XEmacs to automatically put you in viper-mode all the time, include -this line in your @file{.emacs} file: -@example -(viper-mode) -@end example - -@item -Earlier versions of Emacs only allowed keybindings to ASCII character -sequences. XEmacs has greatly expanded this by allowing you to -use a vector of key sequences which are in turn composed of a modifier -and a keysym. @xref{Keystrokes} for more information. - -@item -The keymap data structure has been reimplemented to allow the use of a -character set larger than ASCII. Keymaps are no longer alists and/or -vectors; they are a new primary data type. Consequently, code which -manipulated keymaps with list or array manipulation functions will no -longer work. It must use the functions @code{define-key} or -@code{map-keymap} and @code{set-keymap-parent} (the new keymap -functions). @xref{Key Bindings} for more information. - -@item -Input and display of all ISO-8859-1 characters is supported. - -@item -Multiple fonts, including variable-width fonts, and fonts of differing -heights, are supported. - -@item -There is a new @file{tags} package and a new UNIX manual browsing -package. They are similar to earlier versions; for more information look -at the source code. - -@item -There is a new implementation of Dired, with many new features. The -online info for Dired, @i{not} the Dired node of Emacs info, provides -more detail. - -@item -GNUS (a network news reader), VM (an alternative mail reader), ILISP (a -package for interacting with inferior Lisp processes), ANGE-FTP (a package -for making FTP-accessible files appear just like files on the local disk, -even to Dired), Calendar (an Emacs-based calendar and appointment- -management tool), and W3 (an interface to the World Wide Web) are a part -of the XEmacs Lisp library. See the related documentation in the -online info browser. - -@item -Emacs now supports floating-point numbers. - -@item -When you send mail, mail aliases are now expanded in the buffer. In -earlier versions, they were expanded after the mail-sending command was -executed. - -@item -The initial value of @code{load-path} is computed when Emacs starts up, -instead of being hardcoded in when Emacs is compiled. As a result, you -can now move the Emacs executable and Lisp library to a -different location in the file system without having to recompile. - -@item -Any existing subdirectories of the Emacs Lisp directory are now added to the -@code{load-path} by default. - -@item -On some machines, you can change the audible bell using the -@code{sound-alist} variable. @xref{Audible Bell} for more information. - -@item -You can use multiple X windows to display multiple Emacs frames. - -@item -You can use the X selection mechanism to copy material from other -applications and into other applications. You can also use all Emacs -region commands on a region selected with the mouse. @xref{Mouse -Selection} for more information. - -@item -By default, the variable @code{zmacs-regions} is set to highlight the region -between point and the mark. This unifies X selection and Emacs selection -behavior. - -@item -XEmacs has a menu bar for mouse-controlled operations in addition to -keystrokes. @xref{Pull-down Menus}. - -@item -You can look in the file @file{/usr/local/lib/xemacs-19.11/etc/Emacs.ad} for -a list of Emacs X resources. You can set these resources in your X -environment to set your preferences for color, fonts, location, and the size -of XEmacs frames. Refer to your X documentation for more information -about resources. - -@unnumberedsec New Commands and Variables - -There are many new functions in XEmacs, and many existing functions -whose semantics have been expanded. Most of these are only of interest -to the Emacs-Lisp programmer; see the NEWS file @kbd{C-h n} for a complete -list. What follows is a partial list of the new interactive commands: - -@findex byte-compile-and-load-file -@findex byte-compile-buffer -@item -@code{byte-compile-and-load-file} and @code{byte-compile-buffer} -byte-compile the contents of a file or buffer. - -@findex conx -The new @code{conx} function lets you generate random sentences for your -amusement. - -@findex compile-defun -@item -@code{compile-defun} compiles and evaluates the current top-level -form. - -@findex find-this-file -@findex find-this-file-other-window -@item -@code{find-this-file} and @code{find-this-file-other-window} can be used -interactively with a prefix argument to switch to the filename at point -in the buffer. @code{find-this-file-other-window} displays the file in -another window. - -@findex invert-face -@findex make-face-bold -@findex make-face-bold-italic -@findex make-face-italic -@findex make-face-unbold -@findex make-face-unitalic -@findex set-face-background -@findex set-face-background-pixmap -@findex set-face-font -@findex set-face-foreground -@findex set-face-underline-p -@item -Several new functions have been added that allow you to customize the -color and font attributes of a region of text: @code{invert-face}, -@code{make-face-bold}, @code{make-face-bold-italic}, -@code{make-face-italic}, @code{make-face-unbold}, -@code{make-face-unitalic}, @code{set-face-background}, -@code{set-face-background-pixmap}, @code{set-face-font}, -@code{set-face-foreground}, and @code{set-face-underline-p}. - -@findex load-default-sounds -@findex load-sound-file -@findex play-sound -@item -@code{load-default-sounds} and @code{load-sound-file} allow you to -customize the audible bell sound. @code{load-default-sounds} loads and -installs sound files. @code{load-sound-file} reads in audio files and -adds them to the sound alist. @code{play-sound} plays the specified -sound type. - -@findex locate-library -@item -@code{locate-library} finds the file that the function -@code{load-library} loads, and it displays the file's full pathname. - -@findex make-directory -@findex remove-directory -@item -@code{make-directory} creates a directory, while @code{remove-directory} -removes a directory. - -@findex mark-beginning-of-buffer -@findex mark-end-of-buffer -@item -@code{mark-beginning-of-buffer} and @code{mark-end-of-buffer} push the -mark to the beginning or end of a buffer, respectively. - -@findex mouse-del-char -@findex mouse-delete-window -@findex mouse-keep-one-window -@findex mouse-kill-line -@findex mouse-line-length -@findex mouse-scroll -@findex mouse-select -@findex mouse-select-and-split -@findex mouse-set-mark -@findex mouse-set-point -@findex mouse-track -@findex mouse-track-adjust -@findex mouse-track-and-copy-to-cutbuffer -@findex mouse-track-delete-and-insert -@findex mouse-track-insert -@findex mouse-window-to-region -Several functions have been added that allow you to perform various -editing, region, and window operations using the mouse: -@code{mouse-del-char}, @code{mouse-delete-window}, -@code{mouse-keep-one-window}, @code{mouse-kill-line}, -@code{mouse-line-length}, @code{mouse-scroll}, @code{mouse-select}, -@code{mouse-select-and-split}, @code{mouse-set-mark}, -@code{mouse-set-point}, @code{mouse-track}, @code{mouse-track-adjust}, -@code{mouse-track-and-copy-to-cutbuffer}, -@code{mouse-track-delete-and-insert}, @code{mouse-track-insert}, and -@code{mouse-window-to-region}. - -@findex compare-windows -@item -@code{compare-windows} takes an argument @var{ignore-whitespace}. -The argument means ignore changes in whitespace. - -@end itemize - -You can conditionalize your @file{.emacs} file as follows so that XEmacs -commands are invoked only when you are in XEmacs: - -@cindex version number -@example -(cond ((string-match "Lucid" emacs-version) - ;; - ;; Code for any version of Lucid Emacs or XEmacs goes here - ;; - )) - -(cond ((and (string-match "XEmacs" emacs-version) - (or (> emacs-major-version 19) - (>= emacs-minor-version 12))) - ;; - ;; Code which requires XEmacs version 19.12 or newer goes here - ;; - )) - -(cond ((>= emacs-major-version 19) - ;; - ;; Code for any vintage-19 emacs goes here - ;; - )) - -(cond ((and (not (string-match "Lucid" emacs-version)) - (= emacs-major-version 19)) - ;; - ;; Code specific to FSF Emacs 19 (not XEmacs) goes here - ;; - )) - -(cond ((< emacs-major-version 19) - ;; - ;; Code specific to emacs 18 goes here - ;; - )) -@end example - -Of particular interest for use in @file{.emacs} files are: - -@itemize @bullet -@findex add-menu -@findex add-menu-item -@findex delete-menu-item -@findex disable-menu-item -@findex enable-menu-item -@findex relabel-menu-item -@item -@code{add-menu} lets you add a new menu to the menubar or a submenu to a -pull-down menu. @code{add-menu-item}, @code{disable-menu-item}, -@code{delete-menu-item}, @code{enable-menu-item}, and -@code{relabel-menu-item} allow you to customize the XEmacs -pull-down menus. - -@findex make-frame -@item -@code{make-frame} creates a new Emacs frame (X window). - -@end itemize - -These new variables are only present in XEmacs: - -@itemize @bullet - -@vindex minibuffer-confirm-incomplete -@item -@code{minibuffer-confirm-incomplete} prompts for confirmation in -contexts where @code{completing-read} allows answers that are not valid -completions. - -@vindex x-mode-pointer-shape -@vindex x-nontext-pointer-shape -@vindex x-pointer-background-color -@vindex x-pointer-foreground-color -@vindex x-pointer-shape -@item -Several variables have been added that allow you to customize the color -and shape of the mouse pointer: @code{x-pointer-background-color}, -@code{x-pointer-foreground-color}, @code{x-mode-pointer-shape}, -@code{x-pointer-shape}, and @* @code{x-nontext-pointer-shape}. - -@vindex zmacs-regions -@item -@code{zmacs-regions} determines whether LISPM-style active regions -should be used. -@end itemize - -@unnumberedsec Changes in Key Bindings - -XEmacs has the following new default function keybindings: - -@table @kbd -@item @key{HELP} -Same as @kbd{C-h}. - -@item @key{UNDO} -Same as @kbd{M-x undo}. - -@item @key{CUT} -Same as the Cut menu item; that is, it copies the selected text to -the X Clipboard selection. - -@item @key{COPY} -Same as the Copy menu item. - -@item @key{PASTE} -Same as the Paste menu item. - -@item @key{PGUP} -Same as @kbd{M-v}. - -@item @key{PGDN} -Same as @kbd{C-v}. - -@item @key{HOME} -Same as @kbd{M-<}. - -@item @key{END} -Same as @kbd{M->}. - -@item @key{LEFT-ARROW} -Same as the function @code{backward-char}. - -@item @key{RIGHT-ARROW} -Same as the function @code{forward-char}. - -@item @key{UP-ARROW} -Same as the function @code{previous-line}. - -@item @key{DOWN-ARROW} -Same as the function @code{next-line}. - -@end table - - -@end iftex diff --git a/man/xemacs/packages.texi b/man/xemacs/packages.texi deleted file mode 100644 index 91ac7fb..0000000 --- a/man/xemacs/packages.texi +++ /dev/null @@ -1,379 +0,0 @@ -@node Packages, Abbrevs, Running, Top -@comment node-name, next, previous, up - -@section Packages -@cindex packages - -The XEmacs 21 distribution comes only with a very basic set of -built-in modes and packages. Most of the packages that were part of -the distribution of earlier versions of XEmacs are now separately -available. The installer as well as the user can choose which -packages to install; the actual installation process is easy. -This gives an installer the ability to tailor an XEmacs installation for -local needs with safe removal of unnecessary code. - -@menu -* Package Terminology:: Understanding different kinds of packages. -* Using Packages:: How to install and use packages. -* Building Packages:: Building packages from sources. -@end menu - -@node Package Terminology, Using Packages, , Packages -@comment node-name, next, previous, up - -@subsection Package Flavors - -There are two main flavors of packages. - -@itemize @bullet -@item Regular Packages -@cindex regular packages -A regular package is one in which multiple files are involved and one -may not in general safely remove any of them. - -@item Single-File Packages -@cindex single-file packages -A single-file package is an aggregate collection of thematically -related but otherwise independent lisp files. These files are bundled -together for download convenience and individual files may be deleted at -will without any loss of functionality. -@end itemize - -@subsection Package Distributions - -XEmacs Lisp packages are distributed in two ways, depending on the -intended use. Binary Packages are for installers and end-users and may -be installed directly into an XEmacs package directory. Source Packages -are for developers and include all files necessary for rebuilding -bytecompiled lisp and creating tarballs for distribution. - -@subsection Binary Packages -@cindex binary packages -Binary packages may be installed directly into an XEmacs package -hierarchy. - -@subsection Source Packages -@cindex source packages -Source packages contain all of the Package author's (where appropriate -in regular packages) source code plus all of the files necessary to -build distribution tarballs (Unix Tar format files, gzipped for space -savings). - -@node Using Packages, Building Packages, Package Terminology, Packages -@comment node-name, next, previous, up - -@subsection Getting Started - -When you first download XEmacs 21, you will usually first grab the -@dfn{core distribution}, -@cindex core distribution -a file called -@file{xemacs-21.0.tar.gz}. (Replace the @t{21.0} by the current version -number.) The core distribution contains the sources of XEmacs and a -minimal set of Emacs Lisp files, which are in the subdirectory named -@file{lisp}. This subdirectory used to contain all Emacs Lisp files -distributed with XEmacs. Now, to conserve disk space, most -non-essential packages were made optional. - -@subsection Choosing the Packages You Need - -The available packages can currently be found in the same ftp directory -where you grabbed the core distribution from, and are located in the -subdirectory @file{packages/binary-packages}. Package file names follow -the naming convention @file{--pkg.tar.gz}. - -If you have EFS @ref{(EFS)}, packages can be installed over the network. -Alternatively, if you have copies of the packages locally, you can -install packages from a local disk or CDROM. - -The file @file{etc/PACKAGES} in the core distribution contains a list of -the packages available at the time of the XEmacs release. Packages are -also listed on the @code{Options} menu under: - -@example - Options->Customize->Emacs->Packages -@end example - -However, don't select any of these menu picks unless you actually want -to install the given package (and have properly configured your system -to do so). - -You can also get a list of available packages, and whether or not they -are installed, using the visual package browser and installer. You can -access it via the menus: - -@example - Options->Manage Packages->List & Install -@end example - -Or, you can get to it via the keyboard: - -@example -M-x pui-list-packages -@end example - -Hint to system administrators of multi-user systems: it might be a good -idea to install all packages and not interfere with the wishes of your -users. - -@subsection XEmacs and Installing Packages - -Normally, packages are installed over the network, using EFS -@ref{(EFS)}. However, you may not have network access, or you may -already have some or all of the packages on a local disk, such as a -CDROM. If you want to install from a local disk, you must first tell -XEmacs where to find the package binaries. This is done by adding a line -like the following to your @file{.emacs} file: - -@example -(setq package-get-remote (cons (list nil "/my/path/to/package/binaries") - package-get-remote)) -@end example - -Here, you'd change @file{/my/path/to/package/binaries} to be the path -to your local package binaries. Next, restart XEmacs, and you're ready -to go (advanced users can just re-evaluate the sexp). - -If you are installing from a temporary, one-time directory, you can also -add these directory names to @code{package-get-remote} using: - -@example - M-x pui-add-install-directory -@end example - -Note, however, that any directories added using this function are not -saved; this information will be lost when you quit XEmacs. - -If you're going to install over the network, you only have to insure -that EFS @ref{(EFS)} works, and that it can get outside a firewall, if -you happen to be behind one. You shouldn't have to do anything else; -XEmacs already knows where to go. However you can add your own mirrors -to this list. See @code{package-get-remote}. - -The easiest way to install a package is to use the visual package -browser and installer, using the menu pick: - -@example - Options->Manage Packages->List & Install -@end example -or -@example - Options->Manage Packages->Using Custom->Select-> ... -@end example - -You can also access it using the keyboard: - -@example -M-x pui-list-packages -@end example - -The visual package browser will then display a list of all packages. -Help information will be displayed at the very bottom of the buffer; you -may have to scroll down to see it. You can also press @kbd{?} to get -the same help. From this buffer, you can tell the package status by the -character in the first column: - -@table @kbd -@item - -The package has not been installed. -@item * -The package has been installed, but a newer version is available. The -current version is out-of-date. -@item + -The package has been marked for installation/update. -@end table - -If there is no character in the first column, the package has been -installed and is up-to-date. - -From here, you can select or unselect packages for installation using -the @key{RET} key, the @kbd{Mouse-2} button or selecting "Select" from -the (Popup) Menu. -Once you've finished selecting the packages, you can -press the @kbd{x} key (or use the menu) to actually install the -packages. Note that you will have to restart XEmacs for XEmacs to -recognize any new packages. - -Key summary: - -@table @kbd -@item ? -Display simple help. -@item @key{RET} -@itemx @key{Mouse-2} -Toggle between selecting and unselecting a package for installation. -@item x -Install selected packages. -@item @key{SPC} -View, in the minibuffer, additional information about the package, such -as the package date (not the build date) and the package author. Moving -the mouse over a package name will also do the same thing. -@item v -Toggle between verbose and non-verbose package display. -@item g -Refresh the package display. -@item q -Kill the package buffer. -@end table - -Moving the mouse over a package will also cause additional information -about the package to be displayed in the minibuffer. - -@subsection Other package installation interfaces - -For an alternative package interface, you can select packages from the -customize menus, under: - -@example - Options->Customize->Emacs->Packages-> ... -@end example -or -@example - Options->Manage Packages->Using Custom->Select-> ... -@end example - -Set their state to on, and then do: - -@example - Options->Manage Packages->Using Custom->Update Packages -@end example - -This will automatically retrieve the packages you have selected from the -XEmacs ftp site or your local disk, and install them into -XEmacs. Additionally it will update any packages you already have -installed to the newest version. Note that if a package is newly -installed you will have to restart XEmacs for the change to take effect. - -You can also install packages using a semi-manual interface: - -@example -M-x package-get-all -@end example - -Enter the name of the package (e.g., @code{prog-modes}), and XEmacs -will search for the latest version (as listed in the lisp file -@file{lisp/package-get-base.el}), and install it and any packages that -it depends upon. - -@subsection Manual Binary Package Installation - -Pre-compiled, binary packages can be installed in either a system -package directory (this is determined when XEmacs is compiled), or in a -subdirectory of your @file{$HOME} directory: - -@example -~/.xemacs/packages -@end example - -XEmacs does not have to be running to install binary packages, although -XEmacs will not know about any newly-installed packages until you -restart XEmacs. Note, however, that installing a newer version of a -package while XEmacs is running could cause strange errors in XEmacs; -it's best to exit XEmacs before upgrading an existing package. - -To install binary packages manually: - -@enumerate -@item -Download the package(s) that you want to install. Each binary package -will typically be a gzip'd tarball. - -@item -Decide where to install the packages: in the system package directory, -or in @file{~/.xemacs/packages}. If you want to install the -packages in the system package directory, make sure you can write into -that directory. If you want to install in your @file{$HOME} directory, -create the directory, @file{~/.xemacs/packages}. - -@item -Next, @code{cd} to the directory under which you want to install the -package(s). - -@item -From this directory, uncompress and extract each of the gzip'd tarballs -that you downloaded in step 1. Unix and Cygnus cygwin users will -typically do this using the commands: - -@example - gunzip < package.tar.gz | tar xvf - -@end example - -Above, replace @file{package.tar.gz} with the filename of the -package that you downloaded in step 1. - -Of course, if you use GNU @code{tar}, you could also use: - -@example - tar xvzf package.tar.gz -@end example - -@comment What about native MS Windows users??? - -@item -That's it. Quit and restart XEmacs to get it to recognize any new or -changed packages. - -@end enumerate - -@node Building Packages, , Using Packages, Packages -@comment node-name, next, previous, up - -Source packages are available from the @file{packages/source-packages} -subdirectory of your favorite XEmacs distribution site. Alternatively, -they are available via CVS from @file{cvs.xemacs.org}. Look at -@file{http://cvs.xemacs.org} for instructions. - -@subsection Prerequisites for Building Source Packages - -You must have GNU @code{cp}, GNU @code{install} (or a BSD compatible -@code{install} program) GNU @code{make} (3.75 or later preferred), -@code{makeinfo} (1.68 from @code{texinfo-3.11} or later required), GNU -@code{tar} and XEmacs 21.0. The source packages will untar into a -correct directory structure. At the top level you must have -@file{XEmacs.rules} and @file{package-compile.el}. These files are -available from the XEmacs FTP site from the same place you obtained your -source package distributions. - -@subsection What You Can Do With Source Packages - -NB: A global build operation doesn't exist yet as of 13 January 1998. - -Source packages are most useful for creating XEmacs package tarballs -for installation into your own XEmacs installations or for -distributing to others. - -Supported operations from @file{make} are: - -@table @code -@item clean -Remove all built files except @file{auto-autoloads.el} and @file{custom-load.el}. - -@item distclean -Remove XEmacs backups as well as the files deleted by @code{make clean}. - -@item all -Bytecompile all files, build and bytecompile byproduct files like -@file{auto-autoloads.el} and @file{custom-load.el}. Create info version -of TeXinfo documentation if present. - -@item srckit -Usually aliased to @code{make srckit-std}. This does a @code{make -distclean} and creates a package source tarball in the staging -directory. This is generally only of use for package maintainers. - -@item binkit -May be aliased to @code{binkit-sourceonly}, @code{binkit-sourceinfo}, -@code{binkit-sourcedata}, or -@code{binkit-sourcedatainfo}. @code{sourceonly} indicates there is -nothing to install in a data directory or info directory. -@code{sourceinfo} indicates that source and info files are to be -installed. @code{sourcedata} indicates that source and etc (data) files -are to be installed. @code{sourcedatainfo} indicates source, etc -(data), and info files are to be installed. A few packages have needs -beyond the basic templates so this is not yet complete. - -@item dist -Runs the rules @code{srckit} followed by @code{binkit}. This is -primarily of use by XEmacs maintainers producing files for distribution. - -@end table diff --git a/man/xemacs/programs.texi b/man/xemacs/programs.texi deleted file mode 100644 index ff2b41e..0000000 --- a/man/xemacs/programs.texi +++ /dev/null @@ -1,1940 +0,0 @@ - -@node Programs, Running, Text, Top -@chapter Editing Programs -@cindex Lisp -@cindex C - - Emacs has many commands designed to understand the syntax of programming -languages such as Lisp and C. These commands can: - -@itemize @bullet -@item -Move over or kill balanced expressions or @dfn{sexps} (@pxref{Lists}). -@item -Move over or mark top-level balanced expressions (@dfn{defuns}, in Lisp; -functions, in C). -@item -Show how parentheses balance (@pxref{Matching}). -@item -Insert, kill, or align comments (@pxref{Comments}). -@item -Follow the usual indentation conventions of the language -(@pxref{Grinding}). -@end itemize - - The commands available for words, sentences, and paragraphs are useful in -editing code even though their canonical application is for editing human -language text. Most symbols contain words (@pxref{Words}); sentences can -be found in strings and comments (@pxref{Sentences}). Paragraphs per se -are not present in code, but the paragraph commands are useful anyway, -because Lisp mode and C mode define paragraphs to begin and end at blank -lines (@pxref{Paragraphs}). Judicious use of blank lines to make the -program clearer also provides interesting chunks of text for the -paragraph commands to work on. - - The selective display feature is useful for looking at the overall -structure of a function (@pxref{Selective Display}). This feature causes -only the lines that are indented less than a specified amount to appear -on the screen. - -@menu -* Program Modes:: Major modes for editing programs. -* Lists:: Expressions with balanced parentheses. - There are editing commands to operate on them. -* Defuns:: Each program is made up of separate functions. - There are editing commands to operate on them. -* Grinding:: Adjusting indentation to show the nesting. -* Matching:: Insertion of a close-delimiter flashes matching open. -* Comments:: Inserting, illing and aligning comments. -* Balanced Editing:: Inserting two matching parentheses at once, etc. -* Lisp Completion:: Completion on symbol names in Lisp code. -* Documentation:: Getting documentation of functions you plan to call. -* Change Log:: Maintaining a change history for your program. -* Tags:: Go direct to any function in your program in one - command. Tags remembers which file it is in. -* Fortran:: Fortran mode and its special features. -* Asm Mode:: Asm mode and its special features. -@end menu - -@node Program Modes, Lists, Programs, Programs -@section Major Modes for Programming Languages - -@cindex Lisp mode -@cindex C mode -@cindex Scheme mode - Emacs has several major modes for the programming languages Lisp, Scheme (a -variant of Lisp), C, Fortran, and Muddle. Ideally, a major mode should be -implemented for each programming language you might want to edit with -Emacs; but often the mode for one language can serve for other -syntactically similar languages. The language modes that exist are those -that someone decided to take the trouble to write. - - There are several variants of Lisp mode, which differ in the way they -interface to Lisp execution. @xref{Lisp Modes}. - - Each of the programming language modes defines the @key{TAB} key to run -an indentation function that knows the indentation conventions of that -language and updates the current line's indentation accordingly. For -example, in C mode @key{TAB} is bound to @code{c-indent-line}. @key{LFD} -is normally defined to do @key{RET} followed by @key{TAB}; thus it, too, -indents in a mode-specific fashion. - -@kindex DEL -@findex backward-delete-char-untabify - In most programming languages, indentation is likely to vary from line to -line. So the major modes for those languages rebind @key{DEL} to treat a -tab as if it were the equivalent number of spaces (using the command -@code{backward-delete-char-untabify}). This makes it possible to rub out -indentation one column at a time without worrying whether it is made up of -spaces or tabs. In these modes, use @kbd{C-b C-d} to delete a tab -character before point. - - Programming language modes define paragraphs to be separated only by -blank lines, so that the paragraph commands remain useful. Auto Fill mode, -if enabled in a programming language major mode, indents the new lines -which it creates. - -@cindex mode hook -@vindex c-mode-hook -@vindex lisp-mode-hook -@vindex emacs-lisp-mode-hook -@vindex lisp-interaction-mode-hook -@vindex scheme-mode-hook -@vindex muddle-mode-hook - Turning on a major mode calls a user-supplied function called the -@dfn{mode hook}, which is the value of a Lisp variable. For example, -turning on C mode calls the value of the variable @code{c-mode-hook} if -that value exists and is non-@code{nil}. Mode hook variables for other -programming language modes include @code{lisp-mode-hook}, -@code{emacs-lisp-mode-hook}, @code{lisp-interaction-mode-hook}, -@code{scheme-mode-hook}, and @code{muddle-mode-hook}. The mode hook -function receives no arguments.@refill - -@node Lists, Defuns, Program Modes, Programs -@section Lists and Sexps - -@cindex Control-Meta - By convention, Emacs keys for dealing with balanced expressions are -usually @kbd{Control-Meta-} characters. They tend to be analogous in -function to their @kbd{Control-} and @kbd{Meta-} equivalents. These commands -are usually thought of as pertaining to expressions in programming -languages, but can be useful with any language in which some sort of -parentheses exist (including English). - -@cindex list -@cindex sexp -@cindex expression - The commands fall into two classes. Some commands deal only with -@dfn{lists} (parenthetical groupings). They see nothing except -parentheses, brackets, braces (depending on what must balance in the -language you are working with), and escape characters that might be used -to quote those. - - The other commands deal with expressions or @dfn{sexps}. The word `sexp' -is derived from @dfn{s-expression}, the term for a symbolic expression in -Lisp. In Emacs, the notion of `sexp' is not limited to Lisp. It -refers to an expression in the language your program is written in. -Each programming language has its own major mode, which customizes the -syntax tables so that expressions in that language count as sexps. - - Sexps typically include symbols, numbers, and string constants, as well -as anything contained in parentheses, brackets, or braces. - - In languages that use prefix and infix operators, such as C, it is not -possible for all expressions to be sexps. For example, C mode does not -recognize @samp{foo + bar} as an sexp, even though it @i{is} a C expression; -it recognizes @samp{foo} as one sexp and @samp{bar} as another, with the -@samp{+} as punctuation between them. This is a fundamental ambiguity: -both @samp{foo + bar} and @samp{foo} are legitimate choices for the sexp to -move over if point is at the @samp{f}. Note that @samp{(foo + bar)} is a -sexp in C mode. - - Some languages have obscure forms of syntax for expressions that nobody -has bothered to make Emacs understand properly. - -@c doublewidecommands -@table @kbd -@item C-M-f -Move forward over an sexp (@code{forward-sexp}). -@item C-M-b -Move backward over an sexp (@code{backward-sexp}). -@item C-M-k -Kill sexp forward (@code{kill-sexp}). -@item C-M-u -Move up and backward in list structure (@code{backward-up-list}). -@item C-M-d -Move down and forward in list structure (@code{down-list}). -@item C-M-n -Move forward over a list (@code{forward-list}). -@item C-M-p -Move backward over a list (@code{backward-list}). -@item C-M-t -Transpose expressions (@code{transpose-sexps}). -@item C-M-@@ -Put mark after following expression (@code{mark-sexp}). -@end table - -@kindex C-M-f -@kindex C-M-b -@findex forward-sexp -@findex backward-sexp - To move forward over an sexp, use @kbd{C-M-f} (@code{forward-sexp}). If -the first significant character after point is an opening delimiter -(@samp{(} in Lisp; @samp{(}, @samp{[}, or @samp{@{} in C), @kbd{C-M-f} -moves past the matching closing delimiter. If the character begins a -symbol, string, or number, @kbd{C-M-f} moves over that. If the character -after point is a closing delimiter, @kbd{C-M-f} just moves past it. (This -last is not really moving across an sexp; it is an exception which is -included in the definition of @kbd{C-M-f} because it is as useful a -behavior as anyone can think of for that situation.)@refill - - The command @kbd{C-M-b} (@code{backward-sexp}) moves backward over a -sexp. The detailed rules are like those above for @kbd{C-M-f}, but with -directions reversed. If there are any prefix characters (single quote, -back quote, and comma, in Lisp) preceding the sexp, @kbd{C-M-b} moves back -over them as well. - - @kbd{C-M-f} or @kbd{C-M-b} with an argument repeats that operation the -specified number of times; with a negative argument, it moves in the -opposite direction. - -In languages such as C where the comment-terminator can be recognized, -the sexp commands move across comments as if they were whitespace. In -Lisp and other languages where comments run until the end of a line, it -is very difficult to ignore comments when parsing backwards; therefore, -in such languages the sexp commands treat the text of comments as if it -were code. - -@kindex C-M-k -@findex kill-sexp - Killing an sexp at a time can be done with @kbd{C-M-k} (@code{kill-sexp}). -@kbd{C-M-k} kills the characters that @kbd{C-M-f} would move over. - -@kindex C-M-n -@kindex C-M-p -@findex forward-list -@findex backward-list - The @dfn{list commands}, @kbd{C-M-n} (@code{forward-list}) and -@kbd{C-M-p} (@code{backward-list}), move over lists like the sexp -commands but skip over any number of other kinds of sexps (symbols, -strings, etc). In some situations, these commands are useful because -they usually ignore comments, since the comments usually do not contain -any lists.@refill - -@kindex C-M-u -@kindex C-M-d -@findex backward-up-list -@findex down-list - @kbd{C-M-n} and @kbd{C-M-p} stay at the same level in parentheses, when -that is possible. To move @i{up} one (or @var{n}) levels, use @kbd{C-M-u} -(@code{backward-up-list}). -@kbd{C-M-u} moves backward up past one unmatched opening delimiter. A -positive argument serves as a repeat count; a negative argument reverses -direction of motion and also requests repetition, so it moves forward and -up one or more levels.@refill - - To move @i{down} in list structure, use @kbd{C-M-d} -(@code{down-list}). In Lisp mode, where @samp{(} is the only opening -delimiter, this is nearly the same as searching for a @samp{(}. An -argument specifies the number of levels of parentheses to go down. - -@cindex transposition -@kindex C-M-t -@findex transpose-sexps -@kbd{C-M-t} (@code{transpose-sexps}) drags the previous sexp across -the next one. An argument serves as a repeat count, and a negative -argument drags backwards (thus canceling out the effect of @kbd{C-M-t} with -a positive argument). An argument of zero, rather than doing nothing, -transposes the sexps ending after point and the mark. - -@kindex C-M-@@ -@findex mark-sexp - To make the region be the next sexp in the buffer, use @kbd{C-M-@@} -(@code{mark-sexp}) which sets the mark at the same place that -@kbd{C-M-f} would move to. @kbd{C-M-@@} takes arguments like -@kbd{C-M-f}. In particular, a negative argument is useful for putting -the mark at the beginning of the previous sexp. - - The list and sexp commands' understanding of syntax is completely -controlled by the syntax table. Any character can, for example, be -declared to be an opening delimiter and act like an open parenthesis. -@xref{Syntax}. - -@node Defuns, Grinding, Lists, Programs -@section Defuns -@cindex defuns - - In Emacs, a parenthetical grouping at the top level in the buffer is -called a @dfn{defun}. The name derives from the fact that most -top-level lists in Lisp are instances of the special form -@code{defun}, but Emacs calls any top-level parenthetical -grouping counts a defun regardless of its contents or -the programming language. For example, in C, the body of a -function definition is a defun. - -@c doublewidecommands -@table @kbd -@item C-M-a -Move to beginning of current or preceding defun -(@code{beginning-of-defun}). -@item C-M-e -Move to end of current or following defun (@code{end-of-defun}). -@item C-M-h -Put region around whole current or following defun (@code{mark-defun}). -@end table - -@kindex C-M-a -@kindex C-M-e -@kindex C-M-h -@findex beginning-of-defun -@findex end-of-defun -@findex mark-defun - The commands to move to the beginning and end of the current defun are -@kbd{C-M-a} (@code{beginning-of-defun}) and @kbd{C-M-e} (@code{end-of-defun}). - - To operate on the current defun, use @kbd{C-M-h} (@code{mark-defun}) -which puts point at the beginning and the mark at the end of the current -or next defun. This is the easiest way to prepare for moving the defun -to a different place. In C mode, @kbd{C-M-h} runs the function -@code{mark-c-function}, which is almost the same as @code{mark-defun}, -but which backs up over the argument declarations, function name, and -returned data type so that the entire C function is inside the region. - -@findex compile-defun -To compile and evaluate the current defun, use @kbd{M-x compile-defun}. -This function prints the results in the minibuffer. If you include an -argument, it inserts the value in the current buffer after the defun. - - Emacs assumes that any open-parenthesis found in the leftmost column is -the start of a defun. Therefore, @i{never put an open-parenthesis at the -left margin in a Lisp file unless it is the start of a top level list. -Never put an open-brace or other opening delimiter at the beginning of a -line of C code unless it starts the body of a function.} The most likely -problem case is when you want an opening delimiter at the start of a line -inside a string. To avoid trouble, put an escape character (@samp{\} in C -and Emacs Lisp, @samp{/} in some other Lisp dialects) before the opening -delimiter. It will not affect the contents of the string. - - The original Emacs found defuns by moving upward a -level of parentheses until there were no more levels to go up. This -required scanning back to the beginning of the buffer for every -function. To speed this up, Emacs was changed to assume -that any @samp{(} (or other character assigned the syntactic class of -opening-delimiter) at the left margin is the start of a defun. This -heuristic is nearly always right; however, it mandates the convention -described above. - -@node Grinding, Matching, Defuns, Programs -@section Indentation for Programs -@cindex indentation -@cindex grinding - - The best way to keep a program properly indented (``ground'') is to -use Emacs to re-indent it as you change the program. Emacs has commands -to indent properly either a single line, a specified number of lines, or -all of the lines inside a single parenthetical grouping. - -@menu -* Basic Indent:: -* Multi-line Indent:: Commands to reindent many lines at once. -* Lisp Indent:: Specifying how each Lisp function should be indented. -* C Indent:: Choosing an indentation style for C code. -@end menu - -@node Basic Indent, Multi-line Indent, Grinding, Grinding -@subsection Basic Program Indentation Commands - -@c WideCommands -@table @kbd -@item @key{TAB} -Adjust indentation of current line. -@item @key{LFD} -Equivalent to @key{RET} followed by @key{TAB} (@code{newline-and-indent}). -@end table - -@kindex TAB -@findex c-indent-line -@findex lisp-indent-line - The basic indentation command is @key{TAB}, which gives the current -line the correct indentation as determined from the previous lines. The -function that @key{TAB} runs depends on the major mode; it is -@code{lisp-indent-line} in Lisp mode, @code{c-indent-line} in C mode, -etc. These functions understand different syntaxes for different -languages, but they all do about the same thing. @key{TAB} in any -programming language major mode inserts or deletes whitespace at the -beginning of the current line, independent of where point is in the -line. If point is inside the whitespace at the beginning of the line, -@key{TAB} leaves it at the end of that whitespace; otherwise, @key{TAB} -leaves point fixed with respect to the characters around it. - - Use @kbd{C-q @key{TAB}} to insert a tab at point. - -@kindex LFD -@findex newline-and-indent - When entering a large amount of new code, use @key{LFD} -(@code{newline-and-indent}), which is equivalent to a @key{RET} followed -by a @key{TAB}. @key{LFD} creates a blank line, then gives it the -appropriate indentation. - - @key{TAB} indents the second and following lines of the body of a -parenthetical grouping each under the preceding one; therefore, if you -alter one line's indentation to be nonstandard, the lines below tend -to follow it. This is the right behavior in cases where the standard -result of @key{TAB} does not look good. - - Remember that Emacs assumes that an open-parenthesis, open-brace, or -other opening delimiter at the left margin (including the indentation -routines) is the start of a function. You should therefore never have -an opening delimiter in column zero that is not the beginning of a -function, not even inside a string. This restriction is vital for -making the indentation commands fast. @xref{Defuns}, for more -information on this behavior. - -@node Multi-line Indent, Lisp Indent, Basic Indent, Grinding -@subsection Indenting Several Lines - - Several commands are available to re-indent several lines of code -which have been altered or moved to a different level in a list -structure. - - -@table @kbd -@item C-M-q -Re-indent all the lines within one list (@code{indent-sexp}). -@item C-u @key{TAB} -Shift an entire list rigidly sideways so that its first line -is properly indented. -@item C-M-\ -Re-indent all lines in the region (@code{indent-region}). -@end table - -@kindex C-M-q -@findex indent-sexp -@findex indent-c-exp - To re-indent the contents of a single list, position point before the -beginning of it and type @kbd{C-M-q}. This key is bound to -@code{indent-sexp} in Lisp mode, @code{indent-c-exp} in C mode, and -bound to other suitable functions in other modes. The indentation of -the line the sexp starts on is not changed; therefore, only the relative -indentation within the list, and not its position, is changed. To -correct the position as well, type a @key{TAB} before @kbd{C-M-q}. - -@kindex C-u TAB - If the relative indentation within a list is correct but the -indentation of its beginning is not, go to the line on which the list -begins and type @kbd{C-u @key{TAB}}. When you give @key{TAB} a numeric -argument, it moves all the lines in the group, starting on the current -line, sideways the same amount that the current line moves. The command -does not move lines that start inside strings, or C -preprocessor lines when in C mode. - -@kindex C-M-\ -@findex indent-region - Another way to specify a range to be re-indented is with point and -mark. The command @kbd{C-M-\} (@code{indent-region}) applies @key{TAB} -to every line whose first character is between point and mark. - -@node Lisp Indent, C Indent, Multi-line Indent, Grinding -@subsection Customizing Lisp Indentation -@cindex customization - - The indentation pattern for a Lisp expression can depend on the function -called by the expression. For each Lisp function, you can choose among -several predefined patterns of indentation, or define an arbitrary one with -a Lisp program. - - The standard pattern of indentation is as follows: the second line of the -expression is indented under the first argument, if that is on the same -line as the beginning of the expression; otherwise, the second line is -indented underneath the function name. Each following line is indented -under the previous line whose nesting depth is the same. - -@vindex lisp-indent-offset - If the variable @code{lisp-indent-offset} is non-@code{nil}, it overrides -the usual indentation pattern for the second line of an expression, so that -such lines are always indented @code{lisp-indent-offset} more columns than -the containing list. - -@vindex lisp-body-indention - Certain functions override the standard pattern. Functions -whose names start with @code{def} always indent the second line by -@code{lisp-body-indention} extra columns beyond the open-parenthesis -starting the expression. - - Individual functions can override the standard pattern in various -ways, according to the @code{lisp-indent-function} property of the -function name. (Note: @code{lisp-indent-function} was formerly called -@code{lisp-indent-hook}). There are four possibilities for this -property: - -@table @asis -@item @code{nil} -This is the same as no property; the standard indentation pattern is used. -@item @code{defun} -The pattern used for function names that start with @code{def} is used for -this function also. -@item a number, @var{number} -The first @var{number} arguments of the function are -@dfn{distinguished} arguments; the rest are considered the @dfn{body} -of the expression. A line in the expression is indented according to -whether the first argument on it is distinguished or not. If the -argument is part of the body, the line is indented @code{lisp-body-indent} -more columns than the open-parenthesis starting the containing -expression. If the argument is distinguished and is either the first -or second argument, it is indented @i{twice} that many extra columns. -If the argument is distinguished and not the first or second argument, -the standard pattern is followed for that line. -@item a symbol, @var{symbol} -@var{symbol} should be a function name; that function is called to -calculate the indentation of a line within this expression. The -function receives two arguments: -@table @asis -@item @var{state} -The value returned by @code{parse-partial-sexp} (a Lisp primitive for -indentation and nesting computation) when it parses up to the -beginning of this line. -@item @var{pos} -The position at which the line being indented begins. -@end table -@noindent -It should return either a number, which is the number of columns of -indentation for that line, or a list whose first element is such a -number. The difference between returning a number and returning a list -is that a number says that all following lines at the same nesting level -should be indented just like this one; a list says that following lines -might call for different indentations. This makes a difference when the -indentation is computed by @kbd{C-M-q}; if the value is a number, -@kbd{C-M-q} need not recalculate indentation for the following lines -until the end of the list. -@end table - -@node C Indent,, Lisp Indent, Grinding -@subsection Customizing C Indentation - - Two variables control which commands perform C indentation and when. - -@vindex c-auto-newline - If @code{c-auto-newline} is non-@code{nil}, newlines are inserted both -before and after braces that you insert and after colons and semicolons. -Correct C indentation is done on all the lines that are made this way. - -@vindex c-tab-always-indent - If @code{c-tab-always-indent} is non-@code{nil}, the @key{TAB} command -in C mode does indentation only if point is at the left margin or within -the line's indentation. If there is non-whitespace to the left of point, -@key{TAB} just inserts a tab character in the buffer. Normally, -this variable is @code{nil}, and @key{TAB} always reindents the current line. - - C does not have anything analogous to particular function names for which -special forms of indentation are desirable. However, it has a different -need for customization facilities: many different styles of C indentation -are in common use. - - There are six variables you can set to control the style that Emacs C -mode will use. - -@table @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 @code{if} or body of a @code{while}. -@item c-brace-offset -Extra indentation for lines that start 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 a line that is a label, case, or default. -@end table - -@vindex c-indent-level - The variable @code{c-indent-level} controls the indentation for C -statements with respect to the surrounding block. In the example: - -@example - @{ - foo (); -@end example - -@noindent -the difference in indentation between the lines is @code{c-indent-level}. -Its standard value is 2. - -If the open-brace beginning the compound statement is not at the beginning -of its line, the @code{c-indent-level} is added to the indentation of the -line, not the column of the open-brace. For example, - -@example -if (losing) @{ - do_this (); -@end example - -@noindent -One popular indentation style is that which results from setting -@code{c-indent-level} to 8 and putting open-braces at the end of a line -in this way. Another popular style prefers to put the open-brace on a -separate line. - -@vindex c-brace-imaginary-offset - In fact, the value of the variable @code{c-brace-imaginary-offset} is -also added to the indentation of such a statement. Normally this variable -is zero. Think of this variable as the imaginary position of the open -brace, relative to the first non-blank character on the line. By setting -the variable to 4 and @code{c-indent-level} to 0, you can get this style: - -@example -if (x == y) @{ - do_it (); - @} -@end example - - When @code{c-indent-level} is zero, the statements inside most braces -line up exactly under the open brace. An exception are braces in column -zero, like those surrounding a function's body. The statements inside -those braces are not placed at column zero. Instead, -@code{c-brace-offset} and @code{c-continued-statement-offset} (see -below) are added to produce a typical offset between brace levels, and -the statements are indented that far. - -@vindex c-continued-statement-offset - @code{c-continued-statement-offset} controls the extra indentation for -a line that starts within a statement (but not within parentheses or -brackets). These lines are usually statements inside other statements, -like the then-clauses of @code{if} statements and the bodies of -@code{while} statements. The @code{c-continued-statement-offset} -parameter determines the difference in indentation between the two lines in: - -@example -if (x == y) - do_it (); -@end example - -@noindent -The default value for @code{c-continued-statement-offset} is 2. Some -popular indentation styles correspond to a value of zero for -@code{c-continued-statement-offset}. - -@vindex c-brace-offset - @code{c-brace-offset} is the extra indentation given to a line that -starts with an open-brace. Its standard value is zero; -compare: - -@example -if (x == y) - @{ -@end example - -@noindent -with: - -@example -if (x == y) - do_it (); -@end example - -@noindent -If you set @code{c-brace-offset} to 4, the first example becomes: - -@example -if (x == y) - @{ -@end example - -@vindex c-argdecl-indent - @code{c-argdecl-indent} controls the indentation of declarations of the -arguments of a C function. It is absolute: argument declarations receive -exactly @code{c-argdecl-indent} spaces. The standard value is 5 and -results in code like this: - -@example -char * -index (string, char) - char *string; - int char; -@end example - -@vindex c-label-offset - @code{c-label-offset} is the extra indentation given to a line that -contains a label, a case statement, or a @code{default:} statement. Its -standard value is @minus{}2 and results in code like this: - -@example -switch (c) - @{ - case 'x': -@end example - -@noindent -If @code{c-label-offset} were zero, the same code would be indented as: - -@example -switch (c) - @{ - case 'x': -@end example - -@noindent -This example assumes that the other variables above also have their -default values. - -Using the indentation style produced by the default settings of the -variables just discussed and putting open braces on separate lines -produces clear and readable files. For an example, look at any of the C -source files of XEmacs. - -@node Matching, Comments, Grinding, Programs -@section Automatic Display of Matching Parentheses -@cindex matching parentheses -@cindex parentheses - - The Emacs parenthesis-matching feature shows you automatically how -parentheses match in the text. Whenever a self-inserting character that -is a closing delimiter is typed, the cursor moves momentarily to the -location of the matching opening delimiter, provided that is visible on -the screen. If it is not on the screen, some text starting with that -opening delimiter is displayed in the echo area. Either way, you see -the grouping you are closing off. - - In Lisp, automatic matching applies only to parentheses. In C, it -also applies to braces and brackets. Emacs knows which characters to regard -as matching delimiters based on the syntax table set by the major -mode. @xref{Syntax}. - - If the opening delimiter and closing delimiter are mismatched---as -in @samp{[x)}---the echo area displays a warning message. The -correct matches are specified in the syntax table. - -@vindex blink-matching-paren -@vindex blink-matching-paren-distance - Two variables control parenthesis matching displays. -@code{blink-matching-paren} turns the feature on or off. The default is -@code{t} (match display is on); @code{nil} turns it off. -@code{blink-matching-paren-distance} specifies how many characters back -Emacs searches to find a matching opening delimiter. If the match is -not found in the specified region, scanning stops, and nothing is -displayed. This prevents wasting lots of time scanning when there is no -match. The default is 4000. - -@node Comments, Balanced Editing, Matching, Programs -@section Manipulating Comments -@cindex comments -@kindex M-; -@cindex indentation -@findex indent-for-comment - - The comment commands insert, kill and align comments. - -@c WideCommands -@table @kbd -@item M-; -Insert or align comment (@code{indent-for-comment}). -@item C-x ; -Set comment column (@code{set-comment-column}). -@item C-u - C-x ; -Kill comment on current line (@code{kill-comment}). -@item M-@key{LFD} -Like @key{RET} followed by inserting and aligning a comment -(@code{indent-new-comment-line}). -@end table - - The command that creates a comment is @kbd{Meta-;} -(@code{indent-for-comment}). If there is no comment already on the -line, a new comment is created and aligned at a specific column called -the @dfn{comment column}. Emacs creates the comment by inserting the -string at the value of @code{comment-start}; see below. Point is left -after that string. If the text of the line extends past the comment -column, indentation is done to a suitable boundary (usually, at least -one space is inserted). If the major mode has specified a string to -terminate comments, that string is inserted after point, to keep the -syntax valid. - - You can also use @kbd{Meta-;} to align an existing comment. If a line -already contains the string that starts comments, @kbd{M-;} just moves -point after it and re-indents it to the conventional place. Exception: -comments starting in column 0 are not moved. - - Some major modes have special rules for indenting certain kinds of -comments in certain contexts. For example, in Lisp code, comments which -start with two semicolons are indented as if they were lines of code, -instead of at the comment column. Comments which start with three -semicolons are supposed to start at the left margin. Emacs understands -these conventions by indenting a double-semicolon comment using @key{TAB} -and by not changing the indentation of a triple-semicolon comment at all. - -@example -;; This function is just an example. -;;; Here either two or three semicolons are appropriate. -(defun foo (x) -;;; And now, the first part of the function: - ;; The following line adds one. - (1+ x)) ; This line adds one. -@end example - - In C code, a comment preceded on its line by nothing but whitespace -is indented like a line of code. - - Even when an existing comment is properly aligned, @kbd{M-;} is still -useful for moving directly to the start of the comment. - -@kindex C-u - C-x ; -@findex kill-comment - @kbd{C-u - C-x ;} (@code{kill-comment}) kills the comment on the -current line, if there is one. The indentation before the start of the -comment is killed as well. If there does not appear to be a comment in -the line, nothing happens. To reinsert the comment on another line, -move to the end of that line, type first @kbd{C-y}, and then @kbd{M-;} -to realign the comment. Note that @kbd{C-u - C-x ;} is not a distinct -key; it is @kbd{C-x ;} (@code{set-comment-column}) with a negative -argument. That command is programmed to call @code{kill-comment} when -called with a negative argument. However, @code{kill-comment} is a -valid command which you could bind directly to a key if you wanted to. - -@subsection Multiple Lines of Comments - -@kindex M-LFD -@cindex blank lines -@cindex Auto Fill mode -@findex indent-new-comment-line - If you are typing a comment and want to continue it on another line, -use the command @kbd{Meta-@key{LFD}} (@code{indent-new-comment-line}), -which terminates the comment you are typing, creates a new blank line -afterward, and begins a new comment indented under the old one. If -Auto Fill mode is on and you go past the fill column while typing, the -comment is continued in just this fashion. If point is -not at the end of the line when you type @kbd{M-@key{LFD}}, the text on -the rest of the line becomes part of the new comment line. - -@subsection Options Controlling Comments - -@vindex comment-column -@kindex C-x ; -@findex set-comment-column - The comment column is stored in the variable @code{comment-column}. You -can explicitly set it to a number. Alternatively, the command @kbd{C-x ;} -(@code{set-comment-column}) sets the comment column to the column point is -at. @kbd{C-u C-x ;} sets the comment column to match the last comment -before point in the buffer, and then calls @kbd{Meta-;} to align the -current line's comment under the previous one. Note that @kbd{C-u - C-x ;} -runs the function @code{kill-comment} as described above. - - @code{comment-column} is a per-buffer variable; altering the variable -affects only the current buffer. You can also change the default value. -@xref{Locals}. Many major modes initialize this variable -for the current buffer. - -@vindex comment-start-skip - The comment commands recognize comments based on the regular expression -that is the value of the variable @code{comment-start-skip}. This regexp -should not match the null string. It may match more than the comment -starting delimiter in the strictest sense of the word; for example, in C -mode the value of the variable is @code{@t{"/\\*+ *"}}, which matches extra -stars and spaces after the @samp{/*} itself. (Note that @samp{\\} is -needed in Lisp syntax to include a @samp{\} in the string, which is needed -to deny the first star its special meaning in regexp syntax. @xref{Regexps}.) - -@vindex comment-start -@vindex comment-end - When a comment command makes a new comment, it inserts the value of -@code{comment-start} to begin it. The value of @code{comment-end} is -inserted after point and will follow the text you will insert -into the comment. In C mode, @code{comment-start} has the value -@w{@code{"/* "}} and @code{comment-end} has the value @w{@code{" */"}}. - -@vindex comment-multi-line - @code{comment-multi-line} controls how @kbd{M-@key{LFD}} -(@code{indent-new-comment-line}) behaves when used inside a comment. If -@code{comment-multi-line} is @code{nil}, as it normally is, then -@kbd{M-@key{LFD}} terminates the comment on the starting line and starts -a new comment on the new following line. If @code{comment-multi-line} -is not @code{nil}, then @kbd{M-@key{LFD}} sets up the new following line -as part of the same comment that was found on the starting line. This -is done by not inserting a terminator on the old line and not inserting -a starter on the new line. In languages where multi-line comments are legal, -the value you choose for this variable is a matter of taste. - -@vindex comment-indent-hook - The variable @code{comment-indent-hook} should contain a function that -is called to compute the indentation for a newly inserted comment or for -aligning an existing comment. Major modes set this variable differently. -The function is called with no arguments, but with point at the -beginning of the comment, or at the end of a line if a new comment is to -be inserted. The function should return the column in which the comment -ought to start. For example, in Lisp mode, the indent hook function -bases its decision on the number of semicolons that begin an existing -comment and on the code in the preceding lines. - -@node Balanced Editing, Lisp Completion, Comments, Programs -@section Editing Without Unbalanced Parentheses - -@table @kbd -@item M-( -Put parentheses around next sexp(s) (@code{insert-parentheses}). -@item M-) -Move past next close parenthesis and re-indent -(@code{move-over-close-and-reindent}). -@end table - -@kindex M-( -@kindex M-) -@findex insert-parentheses -@findex move-over-close-and-reindent - The commands @kbd{M-(} (@code{insert-parentheses}) and @kbd{M-)} -(@code{move-over-close-@*and-reindent}) are designed to facilitate a style of -editing which keeps parentheses balanced at all times. @kbd{M-(} inserts a -pair of parentheses, either together as in @samp{()}, or, if given an -argument, around the next several sexps, and leaves point after the open -parenthesis. Instead of typing @kbd{( F O O )}, you can type @kbd{M-( F O -O}, which has the same effect except for leaving the cursor before the -close parenthesis. You can then type @kbd{M-)}, which moves past the -close parenthesis, deletes any indentation preceding it (in this example -there is none), and indents with @key{LFD} after it. - -@node Lisp Completion, Documentation, Balanced Editing, Programs -@section Completion for Lisp Symbols -@cindex completion (symbol names) - - Completion usually happens in the minibuffer. An exception is -completion for Lisp symbol names, which is available in all buffers. - -@kindex M-TAB -@findex lisp-complete-symbol - The command @kbd{M-@key{TAB}} (@code{lisp-complete-symbol}) takes the -partial Lisp symbol before point to be an abbreviation, and compares it -against all non-trivial Lisp symbols currently known to Emacs. Any -additional characters that they all have in common are inserted at point. -Non-trivial symbols are those that have function definitions, values, or -properties. - - If there is an open-parenthesis immediately before the beginning of -the partial symbol, only symbols with function definitions are considered -as completions. - - If the partial name in the buffer has more than one possible completion -and they have no additional characters in common, a list of all possible -completions is displayed in another window. - -@node Documentation, Change Log, Lisp Completion, Programs -@section Documentation Commands - -@kindex C-h f -@findex describe-function -@kindex C-h v -@findex describe-variable - As you edit Lisp code to be run in Emacs, you can use the commands -@kbd{C-h f} (@code{describe-function}) and @kbd{C-h v} -(@code{describe-variable}) to print documentation of functions and -variables you want to call. These commands use the minibuffer to -read the name of a function or variable to document, and display the -documentation in a window. - - For extra convenience, these commands provide default arguments based on -the code in the neighborhood of point. @kbd{C-h f} sets the default to the -function called in the innermost list containing point. @kbd{C-h v} uses -the symbol name around or adjacent to point as its default. - -@findex manual-entry - The @kbd{M-x manual-entry} command gives you access to documentation -on Unix commands, system calls, and libraries. The command reads a -topic as an argument, and displays the Unix manual page for that topic. -@code{manual-entry} always searches all 8 sections of the -manual and concatenates all the entries it finds. For example, -the topic @samp{termcap} finds the description of the termcap library -from section 3, followed by the description of the termcap data base -from section 5. - -@node Change Log, Tags, Documentation, Programs -@section Change Logs - -@cindex change log -@findex add-change-log-entry - The Emacs command @kbd{M-x add-change-log-entry} helps you keep a record -of when and why you have changed a program. It assumes that you have a -file in which you write a chronological sequence of entries describing -individual changes. The default is to store the change entries in a file -called @file{ChangeLog} in the same directory as the file you are editing. -The same @file{ChangeLog} file therefore records changes for all the files -in a directory. - - A change log entry starts with a header line that contains your name -and the current date. Except for these header lines, every line in the -change log starts with a tab. One entry can describe several changes; -each change starts with a line starting with a tab and a star. @kbd{M-x -add-change-log-entry} visits the change log file and creates a new entry -unless the most recent entry is for today's date and your name. In -either case, it adds a new line to start the description of another -change just after the header line of the entry. When @kbd{M-x -add-change-log-entry} is finished, all is prepared for you to edit in -the description of what you changed and how. You must then save the -change log file yourself. - - The change log file is always visited in Indented Text mode, which means -that @key{LFD} and auto-filling indent each new line like the previous -line. This is convenient for entering the contents of an entry, which must -be indented. @xref{Text Mode}. - - Here is an example of the formatting conventions used in the change log -for Emacs: - -@smallexample -Wed Jun 26 19:29:32 1985 Richard M. Stallman (rms at mit-prep) - - * xdisp.c (try_window_id): - If C-k is done at end of next-to-last line, - this fn updates window_end_vpos and cannot leave - window_end_pos nonnegative (it is zero, in fact). - If display is preempted before lines are output, - this is inconsistent. Fix by setting - blank_end_of_window to nonzero. - -Tue Jun 25 05:25:33 1985 Richard M. Stallman (rms at mit-prep) - - * cmds.c (Fnewline): - Call the auto fill hook if appropriate. - - * xdisp.c (try_window_id): - If point is found by compute_motion after xp, record that - permanently. If display_text_line sets point position wrong - (case where line is killed, point is at eob and that line is - not displayed), set it again in final compute_motion. -@end smallexample - -@node Tags, Fortran, Change Log, Programs -@section Tags Tables -@cindex tags table - - A @dfn{tags table} is a description of how a multi-file program is -broken up into files. It lists the names of the component files and the -names and positions of the functions (or other named subunits) in each -file. Grouping the related files makes it possible to search or replace -through all the files with one command. Recording the function names -and positions makes possible the @kbd{M-.} command which finds the -definition of a function by looking up which of the files it is in. - - Tags tables are stored in files called @dfn{tags table files}. The -conventional name for a tags table file is @file{TAGS}. - - Each entry in the tags table records the name of one tag, the name of the -file that the tag is defined in (implicitly), and the position in that file -of the tag's definition. - - Just what names from the described files are recorded in the tags table -depends on the programming language of the described file. They -normally include all functions and subroutines, and may also include -global variables, data types, and anything else convenient. Each name -recorded is called a @dfn{tag}. - -@menu -* Tag Syntax:: Tag syntax for various types of code and text files. -* Create Tags Table:: Creating a tags table with @code{etags}. -* Select Tags Table:: How to visit a tags table. -* Find Tag:: Commands to find the definition of a specific tag. -* Tags Search:: Using a tags table for searching and replacing. -* List Tags:: Listing and finding tags defined in a file. -@end menu - -@node Tag Syntax -@subsection Source File Tag Syntax - - Here is how tag syntax is defined for the most popular languages: - -@itemize @bullet -@item -In C code, any C function or typedef is a tag, and so are definitions of -@code{struct}, @code{union} and @code{enum}. @code{#define} macro -definitions and @code{enum} constants are also tags, unless you specify -@samp{--no-defines} when making the tags table. Similarly, global -variables are tags, unless you specify @samp{--no-globals}. Use of -@samp{--no-globals} and @samp{--no-defines} can make the tags table file -much smaller. - -@item -In C++ code, in addition to all the tag constructs of C code, member -functions are also recognized, and optionally member variables if you -use the @samp{--members} option. Tags for variables and functions in -classes are named @samp{@var{class}::@var{variable}} and -@samp{@var{class}::@var{function}}. - -@item -In Java code, tags include all the constructs recognized in C++, plus -the @code{extends} and @code{implements} constructs. Tags for variables -and functions in classes are named @samp{@var{class}.@var{variable}} and -@samp{@var{class}.@var{function}}. - -@item -In La@TeX{} text, the argument of any of the commands @code{\chapter}, -@code{\section}, @code{\subsection}, @code{\subsubsection}, -@code{\eqno}, @code{\label}, @code{\ref}, @code{\cite}, @code{\bibitem}, -@code{\part}, @code{\appendix}, @code{\entry}, or @code{\index}, is a -tag.@refill - -Other commands can make tags as well, if you specify them in the -environment variable @code{TEXTAGS} before invoking @code{etags}. The -value of this environment variable should be a colon-separated list of -commands names. For example, - -@example -TEXTAGS="def:newcommand:newenvironment" -export TEXTAGS -@end example - -@noindent -specifies (using Bourne shell syntax) that the commands @samp{\def}, -@samp{\newcommand} and @samp{\newenvironment} also define tags. - -@item -In Lisp code, any function defined with @code{defun}, any variable -defined with @code{defvar} or @code{defconst}, and in general the first -argument of any expression that starts with @samp{(def} in column zero, is -a tag. - -@item -In Scheme code, tags include anything defined with @code{def} or with a -construct whose name starts with @samp{def}. They also include variables -set with @code{set!} at top level in the file. -@end itemize - - Several other languages are also supported: - -@itemize @bullet -@item -In assembler code, labels appearing at the beginning of a line, -followed by a colon, are tags. - -@item -In Bison or Yacc input files, each rule defines as a tag the nonterminal -it constructs. The portions of the file that contain C code are parsed -as C code. - -@item -In Cobol code, paragraphs names are the tags, i.e. any word starting in -column 8 and followed by a full stop. - -@item -In Erlang code, the tags are the functions, records, and macros defined -in the file. - -@item -In Fortran code, functions and subroutines are tags. - -@item -In Objective C code, tags include Objective C definitions for classes, -class categories, methods and protocols. - -@item -In Pascal code, the tags are the functions and procedures defined in -the file. - -@item -In Perl code, the tags are the procedures defined by the @code{sub} -keyword. - -@item -In Postscript code, the tags are the functions. - -@item -In Prolog code, a tag name appears at the left margin. -@end itemize - - You can also generate tags based on regexp matching (@pxref{Create -Tags Table}) to handle other formats and languages. - -@node Create Tags Table -@subsection Creating Tags Tables -@cindex @code{etags} program - - The @code{etags} program is used to create a tags table file. It knows -the syntax of several languages, as described in -@iftex -the previous section. -@end iftex -@ifinfo -@ref{Tag Syntax}. -@end ifinfo -Here is how to run @code{etags}: - -@example -etags @var{inputfiles}@dots{} -@end example - -@noindent -The @code{etags} program reads the specified files, and writes a tags table -named @file{TAGS} in the current working directory. @code{etags} -recognizes the language used in an input file based on its file name and -contents. You can specify the language with the -@samp{--language=@var{name}} option, described below. - - If the tags table data become outdated due to changes in the files -described in the table, the way to update the tags table is the same way it -was made in the first place. It is not necessary to do this often. - - If the tags table fails to record a tag, or records it for the wrong -file, then Emacs cannot possibly find its definition. However, if the -position recorded in the tags table becomes a little bit wrong (due to -some editing in the file that the tag definition is in), the only -consequence is a slight delay in finding the tag. Even if the stored -position is very wrong, Emacs will still find the tag, but it must -search the entire file for it. - - So you should update a tags table when you define new tags that you want -to have listed, or when you move tag definitions from one file to another, -or when changes become substantial. Normally there is no need to update -the tags table after each edit, or even every day. - - One tags table can effectively include another. Specify the included -tags file name with the @samp{--include=@var{file}} option when creating -the file that is to include it. The latter file then acts as if it -contained all the files specified in the included file, as well as the -files it directly contains. - - If you specify the source files with relative file names when you run -@code{etags}, the tags file will contain file names relative to the -directory where the tags file was initially written. This way, you can -move an entire directory tree containing both the tags file and the -source files, and the tags file will still refer correctly to the source -files. - - If you specify absolute file names as arguments to @code{etags}, then -the tags file will contain absolute file names. This way, the tags file -will still refer to the same files even if you move it, as long as the -source files remain in the same place. Absolute file names start with -@samp{/}, or with @samp{@var{device}:/} on MS-DOS and Windows. - - When you want to make a tags table from a great number of files, you -may have problems listing them on the command line, because some systems -have a limit on its length. The simplest way to circumvent this limit -is to tell @code{etags} to read the file names from its standard input, -by typing a dash in place of the file names, like this: - -@example -find . -name "*.[chCH]" -print | etags - -@end example - - Use the option @samp{--language=@var{name}} to specify the language -explicitly. You can intermix these options with file names; each one -applies to the file names that follow it. Specify -@samp{--language=auto} to tell @code{etags} to resume guessing the -language from the file names and file contents. Specify -@samp{--language=none} to turn off language-specific processing -entirely; then @code{etags} recognizes tags by regexp matching alone. -@samp{etags --help} prints the list of the languages @code{etags} knows, -and the file name rules for guessing the language. - - The @samp{--regex} option provides a general way of recognizing tags -based on regexp matching. You can freely intermix it with file names. -Each @samp{--regex} option adds to the preceding ones, and applies only -to the following files. The syntax is: - -@example ---regex=/@var{tagregexp}[/@var{nameregexp}]/ -@end example - -@noindent -where @var{tagregexp} is used to match the lines to tag. It is always -anchored, that is, it behaves as if preceded by @samp{^}. If you want -to account for indentation, just match any initial number of blanks by -beginning your regular expression with @samp{[ \t]*}. In the regular -expressions, @samp{\} quotes the next character, and @samp{\t} stands -for the tab character. Note that @code{etags} does not handle the other -C escape sequences for special characters. - -@cindex interval operator (in regexps) - The syntax of regular expressions in @code{etags} is the same as in -Emacs, augmented with the @dfn{interval operator}, which works as in -@code{grep} and @code{ed}. The syntax of an interval operator is -@samp{\@{@var{m},@var{n}\@}}, and its meaning is to match the preceding -expression at least @var{m} times and up to @var{n} times. - - You should not match more characters with @var{tagregexp} than that -needed to recognize what you want to tag. If the match is such that -more characters than needed are unavoidably matched by @var{tagregexp}, -you may find useful to add a @var{nameregexp}, in order to narrow the tag -scope. You can find some examples below. - - The @samp{-R} option deletes all the regexps defined with -@samp{--regex} options. It applies to the file names following it, as -you can see from the following example: - -@example -etags --regex=/@var{reg1}/ voo.doo --regex=/@var{reg2}/ \ - bar.ber -R --lang=lisp los.er -@end example - -@noindent -Here @code{etags} chooses the parsing language for @file{voo.doo} and -@file{bar.ber} according to their contents. @code{etags} also uses -@var{reg1} to recognize additional tags in @file{voo.doo}, and both -@var{reg1} and @var{reg2} to recognize additional tags in -@file{bar.ber}. @code{etags} uses the Lisp tags rules, and no regexp -matching, to recognize tags in @file{los.er}. - - Here are some more examples. The regexps are quoted to protect them -from shell interpretation. - -@noindent -Tag the @code{DEFVAR} macros in the emacs source files: - -@example ---regex='/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/' -@end example - -@noindent -Tag VHDL files (this example is a single long line, broken here for -formatting reasons): - -@example ---language=none ---regex='/[ \t]*\(ARCHITECTURE\|CONFIGURATION\) +[^ ]* +OF/' ---regex='/[ \t]*\(ATTRIBUTE\|ENTITY\|FUNCTION\|PACKAGE\ -\( BODY\)?\|PROCEDURE\|PROCESS\|TYPE\)[ \t]+\([^ \t(]+\)/\3/' -@end example - -@noindent -Tag TCL files (this last example shows the usage of a @var{nameregexp}): - -@example ---lang=none --regex='/proc[ \t]+\([^ \t]+\)/\1/' -@end example - - For a list of the other available @code{etags} options, execute -@code{etags --help}. - -@node Select Tags Table, Find Tag, Create Tags Table, Tags -@subsection Selecting a Tags Table - -@vindex tag-table-alist - At any time Emacs has one @dfn{selected} tags table, and all the commands -for working with tags tables use the selected one. To select a tags table, -use the variable @code{tag-table-alist}. - -The value of @code{tag-table-alist} is a list that determines which -@code{TAGS} files should be active for a given buffer. This is not -really an association list, in that all elements are checked. The car -of each element of this list is a pattern against which the buffers file -name is compared; if it matches, then the cdr of the list should be the -name of the tags table to use. If more than one element of this list -matches the buffers file name, all of the associated tags tables are -used. Earlier ones are searched first. - -If the car of elements of this list are strings, they are treated -as regular-expressions against which the file is compared (like the -@code{auto-mode-alist}). If they are not strings, they are evaluated. -If they evaluate to non-@code{nil}, the current buffer is considered to -match. - -If the cdr of the elements of this list are strings, they are -assumed to name a tags file. If they name a directory, the string -@file{tags} is appended to them to get the file name. If they are not -strings, they are evaluated and must return an appropriate string. - -For example: - -@example - (setq tag-table-alist - '(("/usr/src/public/perl/" . "/usr/src/public/perl/perl-3.0/") - ("\\.el$" . "/usr/local/emacs/src/") - ("/jbw/gnu/" . "/usr15/degree/stud/jbw/gnu/") - ("" . "/usr/local/emacs/src/") - )) -@end example - -The example defines the tags table alist in the following way: - -@itemize @bullet -@item -Anything in the directory @file{/usr/src/public/perl/} -should use the @file{TAGS} file @file{/usr/src/public/perl/perl-3.0/TAGS}. -@item -Files ending in @file{.el} should use the @file{TAGS} file -@file{/usr/local/emacs/src/TAGS}. -@item -Anything in or below the directory @file{/jbw/gnu/} should use the -@file{TAGS} file @file{/usr15/degree/stud/jbw/gnu/TAGS}. -@end itemize - -If you had a file called @file{/usr/jbw/foo.el}, it would use both -@file{TAGS} files, @* @file{/usr/local/emacs/src/TAGS} and -@file{/usr15/degree/stud/jbw/gnu/TAGS} (in that order), because it -matches both patterns. - -If the buffer-local variable @code{buffer-tag-table} is set, it names a -tags table that is searched before all others when @code{find-tag} is -executed from this buffer. - -If there is a file called @file{TAGS} in the same directory as the file -in question, then that tags file will always be used as well (after the -@code{buffer-tag-table} but before the tables specified by this list). - -If the variable @code{tags-file-name} is set, the @file{TAGS} file it names -will apply to all buffers (for backwards compatibility.) It is searched -first. - -@vindex tags-always-build-completion-table -If the value of the variable @code{tags-always-build-completion-table} -is @code{t}, the tags file will always be added to the completion table -without asking first, regardless of the size of the tags file. - -@vindex tags-file-name -@findex visit-tags-table -The function @kbd{M-x visit-tags-table}, is largely made obsolete by -the variable @code{tag-table-alist}, tells tags commands to use the tags -table file @var{file} first. The @var{file} should be the name of a -file created with the @code{etags} program. A directory name is also -acceptable; it means the file @file{TAGS} in that directory. The -function only stores the file name you provide in the variable -@code{tags-file-name}. Emacs does not actually read in the tags table -contents until you try to use them. You can set the variable explicitly -instead of using @code{visit-tags-table}. The value of the variable -@code{tags-file-name} is the name of the tags table used by all buffers. -This is for backward compatibility, and is largely supplanted by the -variable @code{tag-table-alist}. - -@node Find Tag, Tags Search, Select Tags Table, Tags -@subsection Finding a Tag - - The most important thing that a tags table enables you to do is to find -the definition of a specific tag. - -@table @kbd -@item M-.@: @var{tag &optional other-window} -Find first definition of @var{tag} (@code{find-tag}). -@item C-u M-. -Find next alternate definition of last tag specified. -@item C-x 4 . @var{tag} -Find first definition of @var{tag}, but display it in another window -(@code{find-tag-other-window}). -@end table - -@kindex M-. -@findex find-tag - @kbd{M-.}@: (@code{find-tag}) is the command to find the definition of -a specified tag. It searches through the tags table for that tag, as a -string, then uses the tags table information to determine the file in -which the definition is used and the approximate character position of -the definition in the file. Then @code{find-tag} visits the file, -moves point to the approximate character position, and starts searching -ever-increasing distances away for the text that should appear at -the beginning of the definition. - - If an empty argument is given (by typing @key{RET}), the sexp in the -buffer before or around point is used as the name of the tag to find. -@xref{Lists}, for information on sexps. - - The argument to @code{find-tag} need not be the whole tag name; it can -be a substring of a tag name. However, there can be many tag names -containing the substring you specify. Since @code{find-tag} works by -searching the text of the tags table, it finds the first tag in the table -that the specified substring appears in. To find other tags that match -the substring, give @code{find-tag} a numeric argument, as in @kbd{C-u -M-.}. This does not read a tag name, but continues searching the tag -table's text for another tag containing the same substring last used. -If your keyboard has a real @key{META} key, @kbd{M-0 M-.}@: is an easier -alternative to @kbd{C-u M-.}. - -If the optional second argument @var{other-window} is non-@code{nil}, it uses -another window to display the tag. -Multiple active tags tables and completion are supported. - -Variables of note include the following: - -@vindex tag-table-alist -@vindex tags-file-name -@vindex tags-build-completion-table -@vindex buffer-tag-table -@vindex make-tags-files-invisible -@vindex tag-mark-stack-max - -@table @kbd -@item tag-table-alist -Controls which tables apply to which buffers. -@item tags-file-name -Stores a default tags table. -@item tags-build-completion-table -Controls completion behavior. -@item buffer-tag-table -Specifies a buffer-local table. -@item make-tags-files-invisible -Sets whether tags tables should be very hidden. -@item tag-mark-stack-max -Specifies how many tags-based hops to remember. -@end table - -@kindex C-x 4 . -@findex find-tag-other-window - Like most commands that can switch buffers, @code{find-tag} has another -similar command that displays the new buffer in another window. @kbd{C-x 4 -.}@: invokes the function @code{find-tag-other-window}. (This key sequence -ends with a period.) - - Emacs comes with a tags table file @file{TAGS} (in the directory -containing Lisp libraries) that includes all the Lisp libraries and all -the C sources of Emacs. By specifying this file with @code{visit-tags-table} -and then using @kbd{M-.}@: you can quickly look at the source of any Emacs -function. - -@node Tags Search, List Tags, Find Tag, Tags -@subsection Searching and Replacing with Tags Tables - - The commands in this section visit and search all the files listed in the -selected tags table, one by one. For these commands, the tags table serves -only to specify a sequence of files to search. A related command is -@kbd{M-x grep} (@pxref{Compilation}). - -@table @kbd -@item M-x tags-search @key{RET} @var{regexp} @key{RET} -Search for @var{regexp} through the files in the selected tags -table. -@item M-x tags-query-replace @key{RET} @var{regexp} @key{RET} @var{replacement} @key{RET} -Perform a @code{query-replace-regexp} on each file in the selected tags table. -@item M-, -Restart one of the commands above, from the current location of point -(@code{tags-loop-continue}). -@end table - -@findex tags-search - @kbd{M-x tags-search} reads a regexp using the minibuffer, then -searches for matches in all the files in the selected tags table, one -file at a time. It displays the name of the file being searched so you -can follow its progress. As soon as it finds an occurrence, -@code{tags-search} returns. - -@kindex M-, -@findex tags-loop-continue - Having found one match, you probably want to find all the rest. To find -one more match, type @kbd{M-,} (@code{tags-loop-continue}) to resume the -@code{tags-search}. This searches the rest of the current buffer, followed -by the remaining files of the tags table.@refill - -@findex tags-query-replace - @kbd{M-x tags-query-replace} performs a single -@code{query-replace-regexp} through all the files in the tags table. It -reads a regexp to search for and a string to replace with, just like -ordinary @kbd{M-x query-replace-regexp}. It searches much like @kbd{M-x -tags-search}, but repeatedly, processing matches according to your -input. @xref{Replace}, for more information on query replace. - - It is possible to get through all the files in the tags table with a -single invocation of @kbd{M-x tags-query-replace}. But often it is -useful to exit temporarily, which you can do with any input event that -has no special query replace meaning. You can resume the query replace -subsequently by typing @kbd{M-,}; this command resumes the last tags -search or replace command that you did. - - The commands in this section carry out much broader searches than the -@code{find-tag} family. The @code{find-tag} commands search only for -definitions of tags that match your substring or regexp. The commands -@code{tags-search} and @code{tags-query-replace} find every occurrence -of the regexp, as ordinary search commands and replace commands do in -the current buffer. - - These commands create buffers only temporarily for the files that they -have to search (those which are not already visited in Emacs buffers). -Buffers in which no match is found are quickly killed; the others -continue to exist. - - It may have struck you that @code{tags-search} is a lot like -@code{grep}. You can also run @code{grep} itself as an inferior of -Emacs and have Emacs show you the matching lines one by one. This works -much like running a compilation; finding the source locations of the -@code{grep} matches works like finding the compilation errors. -@xref{Compilation}. - - If you wish to process all the files in a selected tags table, but -@kbd{M-x tags-search} and @kbd{M-x tags-query-replace} are not giving -you the desired result, you can use @kbd{M-x next-file}. - -@table @kbd -@item C-u M-x next-file -With a numeric argument, regardless of its value, visit the first -file in the tags table and prepare to advance sequentially by files. -@item M-x next-file -Visit the next file in the selected tags table. -@end table - -@node List Tags,, Tags Search, Tags -@subsection Tags Table Inquiries - -@table @kbd -@item M-x list-tags -Display a list of the tags defined in a specific program file. -@item M-x tags-apropos -Display a list of all tags matching a specified regexp. -@end table - -@findex list-tags - @kbd{M-x list-tags} reads the name of one of the files described by the -selected tags table, and displays a list of all the tags defined in that -file. The ``file name'' argument is really just a string to compare -against the names recorded in the tags table; it is read as a string rather -than a file name. Therefore, completion and defaulting are not -available, and you must enter the string the same way it appears in the tag -table. Do not include a directory as part of the file name unless the file -name recorded in the tags table contains that directory. - -@findex tags-apropos - @kbd{M-x tags-apropos} is like @code{apropos} for tags. It reads a regexp, -then finds all the tags in the selected tags table whose entries match that -regexp, and displays the tag names found. - -@node Fortran, Asm Mode, Tags, Programs -@section Fortran Mode -@cindex Fortran mode - - Fortran mode provides special motion commands for Fortran statements and -subprograms, and indentation commands that understand Fortran conventions -of nesting, line numbers, and continuation statements. - - Special commands for comments are provided because Fortran comments are -unlike those of other languages. - - Built-in abbrevs optionally save typing when you insert Fortran keywords. - -@findex fortran-mode - Use @kbd{M-x fortran-mode} to switch to this major mode. Doing so calls -the value of @code{fortran-mode-hook} as a function of no arguments if -that variable has a non-@code{nil} value. - -@menu -* Motion: Fortran Motion. Moving point by statements or subprograms. -* Indent: Fortran Indent. Indentation commands for Fortran. -* Comments: Fortran Comments. Inserting and aligning comments. -* Columns: Fortran Columns. Measuring columns for valid Fortran. -* Abbrev: Fortran Abbrev. Built-in abbrevs for Fortran keywords. -@end menu - - Fortran mode was contributed by Michael Prange. - -@node Fortran Motion, Fortran Indent, Fortran, Fortran -@subsection Motion Commands - - Fortran mode provides special commands to move by subprograms (functions -and subroutines) and by statements. There is also a command to put the -region around one subprogram, which is convenient for killing it or moving it. - -@kindex C-M-a (Fortran mode) -@kindex C-M-e (Fortran mode) -@kindex C-M-h (Fortran mode) -@kindex C-c C-p (Fortran mode) -@kindex C-c C-n (Fortran mode) -@findex beginning-of-fortran-subprogram -@findex end-of-fortran-subprogram -@findex mark-fortran-subprogram -@findex fortran-previous-statement -@findex fortran-next-statement - -@table @kbd -@item C-M-a -Move to beginning of subprogram@* -(@code{beginning-of-fortran-subprogram}). -@item C-M-e -Move to end of subprogram (@code{end-of-fortran-subprogram}). -@item C-M-h -Put point at beginning of subprogram and mark at end -(@code{mark-fortran-subprogram}). -@item C-c C-n -Move to beginning of current or next statement -(@code{fortran-next-@*statement}). -@item C-c C-p -Move to beginning of current or previous statement -(@code{fortran-@*previous-statement}). -@end table - -@node Fortran Indent, Fortran Comments, Fortran Motion, Fortran -@subsection Fortran Indentation - - Special commands and features are available for indenting Fortran -code. They make sure various syntactic entities (line numbers, comment line -indicators, and continuation line flags) appear in the columns that are -required for standard Fortran. - -@menu -* Commands: ForIndent Commands. Commands for indenting Fortran. -* Numbers: ForIndent Num. How line numbers auto-indent. -* Conv: ForIndent Conv. Conventions you must obey to avoid trouble. -* Vars: ForIndent Vars. Variables controlling Fortran indent style. -@end menu - -@node ForIndent Commands, ForIndent Num, Fortran Indent, Fortran Indent -@subsubsection Fortran Indentation Commands - -@table @kbd -@item @key{TAB} -Indent the current line (@code{fortran-indent-line}). -@item M-@key{LFD} -Break the current line and set up a continuation line. -@item C-M-q -Indent all the lines of the subprogram point is in -(@code{fortran-indent-subprogram}). -@end table - -@findex fortran-indent-line - @key{TAB} is redefined by Fortran mode to reindent the current line for -Fortran (@code{fortran-indent-line}). Line numbers and continuation -markers are indented to their required columns, and the body of the -statement is independently indented, based on its nesting in the program. - -@kindex C-M-q (Fortran mode) -@findex fortran-indent-subprogram - The key @kbd{C-M-q} is redefined as @code{fortran-indent-subprogram}, a -command that reindents all the lines of the Fortran subprogram (function or -subroutine) containing point. - -@kindex M-LFD (Fortran mode) -@findex fortran-split-line - The key @kbd{M-@key{LFD}} is redefined as @code{fortran-split-line}, a -command to split a line in the appropriate fashion for Fortran. In a -non-comment line, the second half becomes a continuation line and is -indented accordingly. In a comment line, both halves become separate -comment lines. - -@node ForIndent Num, ForIndent Conv, ForIndent Commands, Fortran Indent -@subsubsection Line Numbers and Continuation - - If a number is the first non-whitespace in the line, it is assumed to be -a line number and is moved to columns 0 through 4. (Columns are always -counted from 0 in XEmacs.) If the text on the line starts with the -conventional Fortran continuation marker @samp{$}, it is moved to column 5. -If the text begins with any non whitespace character in column 5, it is -assumed to be an unconventional continuation marker and remains in column -5. - -@vindex fortran-line-number-indent - Line numbers of four digits or less are normally indented one space. -This amount is controlled by the variable @code{fortran-line-number-indent}, -which is the maximum indentation a line number can have. Line numbers -are indented to right-justify them to end in column 4 unless that would -require more than the maximum indentation. The default value of the -variable is 1. - -@vindex fortran-electric-line-number - Simply inserting a line number is enough to indent it according to these -rules. As each digit is inserted, the indentation is recomputed. To turn -off this feature, set the variable @code{fortran-electric-line-number} to -@code{nil}. Then inserting line numbers is like inserting anything else. - -@node ForIndent Conv, ForIndent Vars, ForIndent Num, Fortran Indent -@subsubsection Syntactic Conventions - - Fortran mode assumes that you follow certain conventions that simplify -the task of understanding a Fortran program well enough to indent it -properly: - -@vindex fortran-continuation-char -@itemize @bullet -@item -Two nested @samp{do} loops never share a @samp{continue} statement. - -@item -The same character appears in column 5 of all continuation lines. It -is the value of the variable @code{fortran-continuation-char}. -By default, this character is @samp{$}. -@end itemize - -@noindent -If you fail to follow these conventions, the indentation commands may -indent some lines unaesthetically. However, a correct Fortran program will -retain its meaning when reindented even if the conventions are not -followed. - -@node ForIndent Vars,, ForIndent Conv, Fortran Indent -@subsubsection Variables for Fortran Indentation - -@vindex fortran-do-indent -@vindex fortran-if-indent -@vindex fortran-continuation-indent -@vindex fortran-check-all-num-for-matching-do -@vindex fortran-minimum-statement-indent - Several additional variables control how Fortran indentation works. - -@table @code -@item fortran-do-indent -Extra indentation within each level of @samp{do} statement (the default is 3). - -@item fortran-if-indent -Extra indentation within each level of @samp{if} statement (the default is 3). - -@item fortran-continuation-indent -Extra indentation for bodies of continuation lines (the default is 5). - -@item fortran-check-all-num-for-matching-do -If this is @code{nil}, indentation assumes that each @samp{do} -statement ends on a @samp{continue} statement. Therefore, when -computing indentation for a statement other than @samp{continue}, it -can save time by not checking for a @samp{do} statement ending there. -If this is non-@code{nil}, indenting any numbered statement must check -for a @samp{do} that ends there. The default is @code{nil}. - -@item fortran-minimum-statement-indent -Minimum indentation for Fortran statements. For standard Fortran, -this is 6. Statement bodies are always indented at least this much. -@end table - -@node Fortran Comments, Fortran Columns, Fortran Indent, Fortran -@subsection Comments - - The usual Emacs comment commands assume that a comment can follow a line -of code. In Fortran, the standard comment syntax requires an entire line -to be just a comment. Therefore, Fortran mode replaces the standard Emacs -comment commands and defines some new variables. - - Fortran mode can also handle a non-standard comment syntax where comments -start with @samp{!} and can follow other text. Because only some Fortran -compilers accept this syntax, Fortran mode will not insert such comments -unless you have specified to do so in advance by setting the variable -@code{comment-start} to @samp{"!"} (@pxref{Variables}). - -@table @kbd -@item M-; -Align comment or insert new comment (@code{fortran-comment-indent}). - -@item C-x ; -Applies to nonstandard @samp{!} comments only. - -@item C-c ; -Turn all lines of the region into comments, or (with arg) -turn them back into real code (@code{fortran-comment-region}). -@end table - - @kbd{M-;} in Fortran mode is redefined as the command -@code{fortran-comment-indent}. Like the usual @kbd{M-;} command, -it recognizes an existing comment and aligns its text appropriately. -If there is no existing comment, a comment is inserted and aligned. - -Inserting and aligning comments is not the same in Fortran mode as in -other modes. When a new comment must be inserted, a full-line comment is -inserted if the current line is blank. On a non-blank line, a -non-standard @samp{!} comment is inserted if you previously specified -you wanted to use them. Otherwise a full-line comment is inserted on a -new line before the current line. - - Non-standard @samp{!} comments are aligned like comments in other -languages, but full-line comments are aligned differently. In a -standard full-line comment, the comment delimiter itself must always -appear in column zero. What can be aligned is the text within the -comment. You can choose from three styles of alignment by setting the -variable @code{fortran-comment-indent-style} to one of these values: - -@vindex fortran-comment-indent-style -@vindex fortran-comment-line-column -@table @code -@item fixed -The text is aligned at a fixed column, which is the value of -@code{fortran-comment-line-column}. This is the default. -@item relative -The text is aligned as if it were a line of code, but with an -additional @code{fortran-comment-line-column} columns of indentation. -@item nil -Text in full-line columns is not moved automatically. -@end table - -@vindex fortran-comment-indent-char - You can also specify the character to be used to indent within -full-line comments by setting the variable @code{fortran-comment-indent-char} -to the character you want to use. - -@vindex comment-line-start -@vindex comment-line-start-skip - Fortran mode introduces two variables @code{comment-line-start} and -@code{comment-line-start-skip}, which do for full-line comments what -@code{comment-start} and @code{comment-start-skip} do for -ordinary text-following comments. Normally these are set properly by -Fortran mode, so you do not need to change them. - - The normal Emacs comment command @kbd{C-x ;} has not been redefined. -It can therefore be used if you use @samp{!} comments, but is useless in -Fortran mode otherwise. - -@kindex C-c ; (Fortran mode) -@findex fortran-comment-region -@vindex fortran-comment-region - The command @kbd{C-c ;} (@code{fortran-comment-region}) turns all the -lines of the region into comments by inserting the string @samp{C$$$} at -the front of each one. With a numeric arg, the region is turned back into -live code by deleting @samp{C$$$} from the front of each line. You can -control the string used for the comments by setting the variable -@code{fortran-comment-region}. Note that here we have an example of a -command and a variable with the same name; the two uses of the name never -conflict because in Lisp and in Emacs it is always clear from the context -which one is referred to. - -@node Fortran Columns, Fortran Abbrev, Fortran Comments, Fortran -@subsection Columns - -@table @kbd -@item C-c C-r -Displays a ``column ruler'' momentarily above the current line -(@code{fortran-column-ruler}). -@item C-c C-w -Splits the current window horizontally so that it is 72 columns wide. -This may help you avoid going over that limit (@code{fortran-window-create}). -@end table - -@kindex C-c C-r (Fortran mode) -@findex fortran-column-ruler - The command @kbd{C-c C-r} (@code{fortran-column-ruler}) shows a column -ruler above the current line. The comment ruler consists of two lines -of text that show you the locations of columns with special significance -in Fortran programs. Square brackets show the limits of the columns for -line numbers, and curly brackets show the limits of the columns for the -statement body. Column numbers appear above them. - - Note that the column numbers count from zero, as always in XEmacs. As -a result, the numbers may not be those you are familiar with; but the -actual positions in the line are standard Fortran. - - The text used to display the column ruler is the value of the variable -@code{fortran-comment-ruler}. By changing this variable, you can change -the display. - -@kindex C-c C-w (Fortran mode) -@findex fortran-window-create - For even more help, use @kbd{C-c C-w} (@code{fortran-window-create}), a -command which splits the current window horizontally, resulting in a window 72 -columns wide. When you edit in this window, you can immediately see -when a line gets too wide to be correct Fortran. - -@node Fortran Abbrev,, Fortran Columns, Fortran -@subsection Fortran Keyword Abbrevs - - Fortran mode provides many built-in abbrevs for common keywords and -declarations. These are the same sort of abbrevs that you can define -yourself. To use them, you must turn on Abbrev mode. @pxref{Abbrevs}. - - The built-in abbrevs are unusual in one way: they all start with a -semicolon. You cannot normally use semicolon in an abbrev, but Fortran -mode makes this possible by changing the syntax of semicolon to ``word -constituent''. - - For example, one built-in Fortran abbrev is @samp{;c} for -@samp{continue}. If you insert @samp{;c} and then insert a punctuation -character such as a space or a newline, the @samp{;c} changes -automatically to @samp{continue}, provided Abbrev mode is enabled.@refill - - Type @samp{;?} or @samp{;C-h} to display a list of all built-in -Fortran abbrevs and what they stand for. - -@node Asm Mode,, Fortran, Programs -@section Asm Mode - -@cindex Asm mode -Asm mode is a major mode for editing files of assembler code. It -defines these commands: - -@table @kbd -@item @key{TAB} -@code{tab-to-tab-stop}. -@item @key{LFD} -Insert a newline and then indent using @code{tab-to-tab-stop}. -@item : -Insert a colon and then remove the indentation from before the label -preceding colon. Then do @code{tab-to-tab-stop}. -@item ; -Insert or align a comment. -@end table - - The variable @code{asm-comment-char} specifies which character -starts comments in assembler syntax. diff --git a/man/xemacs/reading.texi b/man/xemacs/reading.texi deleted file mode 100644 index 57e965c..0000000 --- a/man/xemacs/reading.texi +++ /dev/null @@ -1,32 +0,0 @@ - -@node Reading Mail, Calendar/Diary, Sending Mail, Top -@chapter Reading Mail -@cindex mail -@cindex message - -XEmacs provides three separate mail-reading packages. Each one comes with -its own manual, which is included standard with the XEmacs distribution. - -The recommended mail-reading package for new users is VM. VM works -with standard Unix-mail-format folders and was designed as a replacement -for the older Rmail. - -XEmacs also provides a sophisticated and comfortable front-end to the -MH mail-processing system, called @samp{mh-e}. Unlike in other -mail programs, folders in MH are stored as file-system directories, -with each message occupying one (numbered) file. This facilitates -working with mail using shell commands, and many other features of -MH are also designed to integrate well with the shell and with -shell scripts. Keep in mind, however, that in order to use mh-e -you must have the MH mail-processing system installed on your -computer. - -Finally, XEmacs provides the Rmail package. Rmail is (currently) the -only mail reading package distributed with FSF GNU Emacs, and is -powerful in its own right. However, it stores mail folders in a special -format called @samp{Babyl}, that is incompatible with all other -frequently-used mail programs. A utility program is provided for -converting Babyl folders to standard Unix-mail format; however, unless -you already have mail in Babyl-format folders, you should consider -using VM or mh-e instead. (If at times you have to use FSF Emacs, it -is not hard to obtain and install VM for that editor.) diff --git a/man/xemacs/regs.texi b/man/xemacs/regs.texi deleted file mode 100644 index 9435e1e..0000000 --- a/man/xemacs/regs.texi +++ /dev/null @@ -1,110 +0,0 @@ - -@node Registers, Display, Rectangles, Top -@chapter Registers -@cindex registers - - Emacs @dfn{registers} are places in which you can save text or -positions for later use. Text saved in a register can be copied into -the buffer once or many times; a position saved in a register is used by -moving point to that position. Rectangles can also be copied into and -out of registers (@pxref{Rectangles}). - - Each register has a name, which is a single character. A register can -store either a piece of text, a position, or a rectangle, but only one -thing at any given time. Whatever you store in a register remains -there until you store something else in that register. - -@menu -* RegPos:: Saving positions in registers. -* RegText:: Saving text in registers. -* RegRect:: Saving rectangles in registers. -@end menu - -@table @kbd -@item M-x view-register @key{RET} @var{r} -Display a description of what register @var{r} contains. -@end table - -@findex view-register - @kbd{M-x view-register} reads a register name as an argument and then -displays the contents of the specified register. - -@node RegPos, RegText, Registers, Registers -@section Saving Positions in Registers - - Saving a position records a spot in a buffer so you can move -back there later. Moving to a saved position re-selects the buffer -and moves point to the spot. - -@table @kbd -@item C-x r SPC @var{r} -Save the location of point in register @var{r} (@code{point-to-register}). -@item C-x r j @var{r} -Jump to the location saved in register @var{r} (@code{register-to-point}). -@end table - -@kindex C-x r SPC -@findex point-to-register - To save the current location of point in a register, choose a name -@var{r} and type @kbd{C-x r SPC @var{r}}. The register @var{r} retains -the location thus saved until you store something else in that -register.@refill - -@kindex C-x r j -@findex register-to-point - The command @kbd{C-x r j @var{r}} moves point to the location recorded -in register @var{r}. The register is not affected; it continues to -record the same location. You can jump to the same position using the -same register as often as you want. - -@node RegText, RegRect, RegPos, Registers -@section Saving Text in Registers - - When you want to insert a copy of the same piece of text many times, it -can be impractical to use the kill ring, since each subsequent kill moves -the piece of text further down on the ring. It becomes hard to keep -track of the argument needed to retrieve the same text with @kbd{C-y}. An -alternative is to store the text in a register with @kbd{C-x r s} -(@code{copy-to-register}) and then retrieve it with @kbd{C-x r g} -(@code{insert-register}). - -@table @kbd -@item C-x r s @var{r} -Copy region into register @var{r} (@code{copy-to-register}). -@item C-x r g @var{r} -Insert text contents of register @var{r} (@code{insert-register}). -@end table - -@kindex C-x r s -@kindex C-x r g -@findex copy-to-register -@findex insert-register - @kbd{C-x r s @var{r}} stores a copy of the text of the region into the -register named @var{r}. Given a numeric argument, @kbd{C-x r s} deletes the -text from the buffer as well. - - @kbd{C-x r g @var{r}} inserts the text from register @var{r} in the buffer. -By default it leaves point before the text and places the mark after it. -With a numeric argument, it puts point after the text and the mark -before it. - -@node RegRect,, RegText, Registers -@section Saving Rectangles in Registers -@cindex rectangle -@findex copy-region-to-rectangle - - A register can contain a rectangle instead of lines of text. The rectangle -is represented as a list of strings. @xref{Rectangles}, for basic -information on rectangles and how to specify rectangles in a buffer. - -@table @kbd -@item C-x r r @var{r} -Copy the region-rectangle into register @var{r}(@code{copy-rectangle-to-register}). -With a numeric argument, delete it as well. -@item C-x r g @var{r} -Insert the rectangle stored in register @var{r} (if it contains a -rectangle) (@code{insert-register}). -@end table - - The @kbd{C-x r g} command inserts linear text if the register contains -that, or inserts a rectangle if the register contains one. diff --git a/man/xemacs/search.texi b/man/xemacs/search.texi deleted file mode 100644 index 62a9d09..0000000 --- a/man/xemacs/search.texi +++ /dev/null @@ -1,883 +0,0 @@ - -@node Search, Fixit, Display, Top -@chapter Searching and Replacement -@cindex searching - - Like other editors, Emacs has commands for searching for occurrences of -a string. The principal search command is unusual in that it is -@dfn{incremental}: it begins to search before you have finished typing the -search string. There are also non-incremental search commands more like -those of other editors. - - Besides the usual @code{replace-string} command that finds all -occurrences of one string and replaces them with another, Emacs has a fancy -replacement command called @code{query-replace} which asks interactively -which occurrences to replace. - -@menu -* Incremental Search:: Search happens as you type the string. -* Non-Incremental Search:: Specify entire string and then search. -* Word Search:: Search for sequence of words. -* Regexp Search:: Search for match for a regexp. -* Regexps:: Syntax of regular expressions. -* Search Case:: To ignore case while searching, or not. -* Replace:: Search, and replace some or all matches. -* Other Repeating Search:: Operating on all matches for some regexp. -@end menu - -@node Incremental Search, Non-Incremental Search, Search, Search -@section Incremental Search - - An incremental search begins searching as soon as you type the first -character of the search string. As you type in the search string, Emacs -shows you where the string (as you have typed it so far) is found. -When you have typed enough characters to identify the place you want, you -can stop. Depending on what you do next, you may or may not need to -terminate the search explicitly with a @key{RET}. - -@c WideCommands -@table @kbd -@item C-s -Incremental search forward (@code{isearch-forward}). -@item C-r -Incremental search backward (@code{isearch-backward}). -@end table - -@kindex C-s -@kindex C-r -@findex isearch-forward -@findex isearch-backward - @kbd{C-s} starts an incremental search. @kbd{C-s} reads characters from -the keyboard and positions the cursor at the first occurrence of the -characters that you have typed. If you type @kbd{C-s} and then @kbd{F}, -the cursor moves right after the first @samp{F}. Type an @kbd{O}, and see -the cursor move to after the first @samp{FO}. After another @kbd{O}, the -cursor is after the first @samp{FOO} after the place where you started the -search. Meanwhile, the search string @samp{FOO} has been echoed in the -echo area.@refill - - The echo area display ends with three dots when actual searching is going -on. When search is waiting for more input, the three dots are removed. -(On slow terminals, the three dots are not displayed.) - - If you make a mistake in typing the search string, you can erase -characters with @key{DEL}. Each @key{DEL} cancels the last character of the -search string. This does not happen until Emacs is ready to read another -input character; first it must either find, or fail to find, the character -you want to erase. If you do not want to wait for this to happen, use -@kbd{C-g} as described below.@refill - - When you are satisfied with the place you have reached, you can type -@key{RET} (or @key{C-m}), which stops searching, leaving the cursor where -the search brought it. Any command not specially meaningful in searches also -stops the search and is then executed. Thus, typing @kbd{C-a} exits the -search and then moves to the beginning of the line. @key{RET} is necessary -only if the next command you want to type is a printing character, -@key{DEL}, @key{ESC}, or another control character that is special -within searches (@kbd{C-q}, @kbd{C-w}, @kbd{C-r}, @kbd{C-s}, or @kbd{C-y}). - - Sometimes you search for @samp{FOO} and find it, but were actually -looking for a different occurance of it. To move to the next occurrence -of the search string, type another @kbd{C-s}. Do this as often as -necessary. If you overshoot, you can cancel some @kbd{C-s} -characters with @key{DEL}. - - After you exit a search, you can search for the same string again by -typing just @kbd{C-s C-s}: the first @kbd{C-s} is the key that invokes -incremental search, and the second @kbd{C-s} means ``search again''. - - If the specified string is not found at all, the echo area displays -the text @samp{Failing I-Search}. The cursor is after the place where -Emacs found as much of your string as it could. Thus, if you search for -@samp{FOOT}, and there is no @samp{FOOT}, the cursor may be after the -@samp{FOO} in @samp{FOOL}. At this point there are several things you -can do. If you mistyped the search string, correct it. If you like the -place you have found, you can type @key{RET} or some other Emacs command -to ``accept what the search offered''. Or you can type @kbd{C-g}, which -removes from the search string the characters that could not be found -(the @samp{T} in @samp{FOOT}), leaving those that were found (the -@samp{FOO} in @samp{FOOT}). A second @kbd{C-g} at that point cancels -the search entirely, returning point to where it was when the search -started. - - If a search is failing and you ask to repeat it by typing another -@kbd{C-s}, it starts again from the beginning of the buffer. Repeating -a failing backward search with @kbd{C-r} starts again from the end. This -is called @dfn{wrapping around}. @samp{Wrapped} appears in the search -prompt once this has happened. - -@cindex quitting (in search) - The @kbd{C-g} ``quit'' character does special things during searches; -just what it does depends on the status of the search. If the search has -found what you specified and is waiting for input, @kbd{C-g} cancels the -entire search. The cursor moves back to where you started the search. If -@kbd{C-g} is typed when there are characters in the search string that have -not been found---because Emacs is still searching for them, or because it -has failed to find them---then the search string characters which have not -been found are discarded from the search string. The -search is now successful and waiting for more input, so a second @kbd{C-g} -cancels the entire search. - - To search for a control character such as @kbd{C-s} or @key{DEL} or -@key{ESC}, you must quote it by typing @kbd{C-q} first. This function -of @kbd{C-q} is analogous to its meaning as an Emacs command: it causes -the following character to be treated the way a graphic character would -normally be treated in the same context. - - To search backwards, you can use @kbd{C-r} instead of @kbd{C-s} to -start the search; @kbd{C-r} is the key that runs the command -(@code{isearch-backward}) to search backward. You can also use -@kbd{C-r} to change from searching forward to searching backwards. Do -this if a search fails because the place you started was too far down in the -file. Repeated @kbd{C-r} keeps looking for more occurrences backwards. -@kbd{C-s} starts going forward again. You can cancel @kbd{C-r} in a -search with @key{DEL}. - - The characters @kbd{C-y} and @kbd{C-w} can be used in incremental search -to grab text from the buffer into the search string. This makes it -convenient to search for another occurrence of text at point. @kbd{C-w} -copies the word after point as part of the search string, advancing -point over that word. Another @kbd{C-s} to repeat the search will then -search for a string including that word. @kbd{C-y} is similar to @kbd{C-w} -but copies the rest of the current line into the search string. - - The characters @kbd{M-p} and @kbd{M-n} can be used in an incremental -search to recall things which you have searched for in the past. A -list of the last 16 things you have searched for is retained, and -@kbd{M-p} and @kbd{M-n} let you cycle through that ring. - -The character @kbd{M-@key{TAB}} does completion on the elements in -the search history ring. For example, if you know that you have -recently searched for the string @code{POTATOE}, you could type -@kbd{C-s P O M-@key{TAB}}. If you had searched for other strings -beginning with @code{PO} then you would be shown a list of them, and -would need to type more to select one. - - You can change any of the special characters in incremental search via -the normal keybinding mechanism: simply add a binding to the -@code{isearch-mode-map}. For example, to make the character -@kbd{C-b} mean ``search backwards'' while in isearch-mode, do this: - -@example -(define-key isearch-mode-map "\C-b" 'isearch-repeat-backward) -@end example - -These are the default bindings of isearch-mode: - -@findex isearch-delete-char -@findex isearch-exit -@findex isearch-quote-char -@findex isearch-repeat-forward -@findex isearch-repeat-backward -@findex isearch-yank-line -@findex isearch-yank-word -@findex isearch-abort -@findex isearch-ring-retreat -@findex isearch-ring-advance -@findex isearch-complete - -@kindex DEL (isearch-mode) -@kindex RET (isearch-mode) -@kindex C-q (isearch-mode) -@kindex C-s (isearch-mode) -@kindex C-r (isearch-mode) -@kindex C-y (isearch-mode) -@kindex C-w (isearch-mode) -@kindex C-g (isearch-mode) -@kindex M-p (isearch-mode) -@kindex M-n (isearch-mode) -@kindex M-TAB (isearch-mode) - -@table @kbd -@item DEL -Delete a character from the incremental search string (@code{isearch-delete-char}). -@item RET -Exit incremental search (@code{isearch-exit}). -@item C-q -Quote special characters for incremental search (@code{isearch-quote-char}). -@item C-s -Repeat incremental search forward (@code{isearch-repeat-forward}). -@item C-r -Repeat incremental search backward (@code{isearch-repeat-backward}). -@item C-y -Pull rest of line from buffer into search string (@code{isearch-yank-line}). -@item C-w -Pull next word from buffer into search string (@code{isearch-yank-word}). -@item C-g -Cancels input back to what has been found successfully, or aborts the -isearch (@code{isearch-abort}). -@item M-p -Recall the previous element in the isearch history ring -(@code{isearch-ring-retreat}). -@item M-n -Recall the next element in the isearch history ring -(@code{isearch-ring-advance}). -@item M-@key{TAB} -Do completion on the elements in the isearch history ring -(@code{isearch-complete}). - -@end table - -Any other character which is normally inserted into a buffer when typed -is automatically added to the search string in isearch-mode. - -@subsection Slow Terminal Incremental Search - - Incremental search on a slow terminal uses a modified style of display -that is designed to take less time. Instead of redisplaying the buffer at -each place the search gets to, it creates a new single-line window and uses -that to display the line the search has found. The single-line window -appears as soon as point gets outside of the text that is already -on the screen. - - When the search is terminated, the single-line window is removed. Only -at this time the window in which the search was done is redisplayed to show -its new value of point. - - The three dots at the end of the search string, normally used to indicate -that searching is going on, are not displayed in slow style display. - -@vindex search-slow-speed - The slow terminal style of display is used when the terminal baud rate is -less than or equal to the value of the variable @code{search-slow-speed}, -initially 1200. - -@vindex search-slow-window-lines - The number of lines to use in slow terminal search display is controlled -by the variable @code{search-slow-window-lines}. Its normal value is 1. - -@node Non-Incremental Search, Word Search, Incremental Search, Search -@section Non-Incremental Search -@cindex non-incremental search - - Emacs also has conventional non-incremental search commands, which require -you type the entire search string before searching begins. - -@table @kbd -@item C-s @key{RET} @var{string} @key{RET} -Search for @var{string}. -@item C-r @key{RET} @var{string} @key{RET} -Search backward for @var{string}. -@end table - - To do a non-incremental search, first type @kbd{C-s @key{RET}} -(or @kbd{C-s C-m}). This enters the minibuffer to read the search string. -Terminate the string with @key{RET} to start the search. If the string -is not found, the search command gets an error. - - By default, @kbd{C-s} invokes incremental search, but if you give it an -empty argument, which would otherwise be useless, it invokes non-incremental -search. Therefore, @kbd{C-s @key{RET}} invokes non-incremental search. -@kbd{C-r @key{RET}} also works this way. - -@findex search-forward -@findex search-backward - Forward and backward non-incremental searches are implemented by the -commands @code{search-forward} and @code{search-backward}. You can bind -these commands to keys. The reason that incremental -search is programmed to invoke them as well is that @kbd{C-s @key{RET}} -is the traditional sequence of characters used in Emacs to invoke -non-incremental search. - - Non-incremental searches performed using @kbd{C-s @key{RET}} do -not call @code{search-forward} right away. They first check -if the next character is @kbd{C-w}, which requests a word search. -@ifinfo -@xref{Word Search}. -@end ifinfo - -@node Word Search, Regexp Search, Non-Incremental Search, Search -@section Word Search -@cindex word search - - Word search looks for a sequence of words without regard to how the -words are separated. More precisely, you type a string of many words, -using single spaces to separate them, and the string is found even if -there are multiple spaces, newlines or other punctuation between the words. - - Word search is useful in editing documents formatted by text formatters. -If you edit while looking at the printed, formatted version, you can't tell -where the line breaks are in the source file. Word search, allows you -to search without having to know the line breaks. - -@table @kbd -@item C-s @key{RET} C-w @var{words} @key{RET} -Search for @var{words}, ignoring differences in punctuation. -@item C-r @key{RET} C-w @var{words} @key{RET} -Search backward for @var{words}, ignoring differences in punctuation. -@end table - - Word search is a special case of non-incremental search. It is invoked -with @kbd{C-s @key{RET} C-w} followed by the search string, which -must always be terminated with another @key{RET}. Being non-incremental, this -search does not start until the argument is terminated. It works by -constructing a regular expression and searching for that. @xref{Regexp -Search}. - - You can do a backward word search with @kbd{C-r @key{RET} C-w}. - -@findex word-search-forward -@findex word-search-backward - Forward and backward word searches are implemented by the commands -@code{word-search-forward} and @code{word-search-backward}. You can -bind these commands to keys. The reason that incremental -search is programmed to invoke them as well is that @kbd{C-s @key{RET} C-w} -is the traditional Emacs sequence of keys for word search. - -@node Regexp Search, Regexps, Word Search, Search -@section Regular Expression Search -@cindex regular expression -@cindex regexp - - A @dfn{regular expression} (@dfn{regexp}, for short) is a pattern that -denotes a set of strings, possibly an infinite set. Searching for matches -for a regexp is a powerful operation that editors on Unix systems have -traditionally offered. In XEmacs, you can search for the next match for -a regexp either incrementally or not. - -@kindex M-C-s -@findex isearch-forward-regexp -@findex isearch-backward-regexp - Incremental search for a regexp is done by typing @kbd{M-C-s} -(@code{isearch-forward-regexp}). This command reads a search string -incrementally just like @kbd{C-s}, but it treats the search string as a -regexp rather than looking for an exact match against the text in the -buffer. Each time you add text to the search string, you make the regexp -longer, and the new regexp is searched for. A reverse regexp search command -@code{isearch-backward-regexp} also exists, but no key runs it. - - All of the control characters that do special things within an ordinary -incremental search have the same functionality in incremental regexp search. -Typing @kbd{C-s} or @kbd{C-r} immediately after starting a search -retrieves the last incremental search regexp used: -incremental regexp and non-regexp searches have independent defaults. - -@findex re-search-forward -@findex re-search-backward - Non-incremental search for a regexp is done by the functions -@code{re-search-forward} and @code{re-search-backward}. You can invoke -them with @kbd{M-x} or bind them to keys. You can also call -@code{re-search-forward} by way of incremental regexp search with -@kbd{M-C-s @key{RET}}. - -@node Regexps, Search Case, Regexp Search, Search -@section Syntax of Regular Expressions - -Regular expressions have a syntax in which a few characters are special -constructs and the rest are @dfn{ordinary}. An ordinary character is a -simple regular expression which matches that character and nothing else. -The special characters are @samp{$}, @samp{^}, @samp{.}, @samp{*}, -@samp{+}, @samp{?}, @samp{[}, @samp{]} and @samp{\}; no new special -characters will be defined. Any other character appearing in a regular -expression is ordinary, unless a @samp{\} precedes it.@refill - -For example, @samp{f} is not a special character, so it is ordinary, and -therefore @samp{f} is a regular expression that matches the string @samp{f} -and no other string. (It does @i{not} match the string @samp{ff}.) Likewise, -@samp{o} is a regular expression that matches only @samp{o}.@refill - -Any two regular expressions @var{a} and @var{b} can be concatenated. The -result is a regular expression which matches a string if @var{a} matches -some amount of the beginning of that string and @var{b} matches the rest of -the string.@refill - -As a simple example, you can concatenate the regular expressions @samp{f} -and @samp{o} to get the regular expression @samp{fo}, which matches only -the string @samp{fo}. To do something nontrivial, you -need to use one of the following special characters: - -@table @kbd -@item .@: @r{(Period)} -is a special character that matches any single character except a newline. -Using concatenation, you can make regular expressions like @samp{a.b}, which -matches any three-character string which begins with @samp{a} and ends with -@samp{b}.@refill - -@item * -is not a construct by itself; it is a suffix, which means the -preceding regular expression is to be repeated as many times as -possible. In @samp{fo*}, the @samp{*} applies to the @samp{o}, so -@samp{fo*} matches one @samp{f} followed by any number of @samp{o}s. -The case of zero @samp{o}s is allowed: @samp{fo*} does match -@samp{f}.@refill - -@samp{*} always applies to the @i{smallest} possible preceding -expression. Thus, @samp{fo*} has a repeating @samp{o}, not a -repeating @samp{fo}.@refill - -The matcher processes a @samp{*} construct by immediately matching -as many repetitions as it can find. Then it continues with the rest -of the pattern. If that fails, backtracking occurs, discarding some -of the matches of the @samp{*}-modified construct in case that makes -it possible to match the rest of the pattern. For example, matching -@samp{ca*ar} against the string @samp{caaar}, the @samp{a*} first -tries to match all three @samp{a}s; but the rest of the pattern is -@samp{ar} and there is only @samp{r} left to match, so this try fails. -The next alternative is for @samp{a*} to match only two @samp{a}s. -With this choice, the rest of the regexp matches successfully.@refill - -@item + -is a suffix character similar to @samp{*} except that it requires that -the preceding expression be matched at least once. For example, -@samp{ca+r} will match the strings @samp{car} and @samp{caaaar} -but not the string @samp{cr}, whereas @samp{ca*r} would match all -three strings.@refill - -@item ? -is a suffix character similar to @samp{*} except that it can match the -preceding expression either once or not at all. For example, -@samp{ca?r} will match @samp{car} or @samp{cr}; nothing else. - -@item [ @dots{} ] -@samp{[} begins a @dfn{character set}, which is terminated by a -@samp{]}. In the simplest case, the characters between the two form -the set. Thus, @samp{[ad]} matches either one @samp{a} or one -@samp{d}, and @samp{[ad]*} matches any string composed of just -@samp{a}s and @samp{d}s (including the empty string), from which it -follows that @samp{c[ad]*r} matches @samp{cr}, @samp{car}, @samp{cdr}, -@samp{caddaar}, etc.@refill - -You can include character ranges in a character set by writing two -characters with a @samp{-} between them. Thus, @samp{[a-z]} matches any -lower-case letter. Ranges may be intermixed freely with individual -characters, as in @samp{[a-z$%.]}, which matches any lower-case letter -or @samp{$}, @samp{%}, or period. -@refill - -Note that inside a character set the usual special characters are not -special any more. A completely different set of special characters -exists inside character sets: @samp{]}, @samp{-}, and @samp{^}.@refill - -To include a @samp{]} in a character set, you must make it the first -character. For example, @samp{[]a]} matches @samp{]} or @samp{a}. To -include a @samp{-}, write @samp{---}, which is a range containing only -@samp{-}. To include @samp{^}, make it other than the first character -in the set.@refill - -@item [^ @dots{} ] -@samp{[^} begins a @dfn{complement character set}, which matches any -character except the ones specified. Thus, @samp{[^a-z0-9A-Z]} -matches all characters @i{except} letters and digits.@refill - -@samp{^} is not special in a character set unless it is the first -character. The character following the @samp{^} is treated as if it -were first (@samp{-} and @samp{]} are not special there). - -Note that a complement character set can match a newline, unless -newline is mentioned as one of the characters not to match. - -@item ^ -is a special character that matches the empty string, but only if at -the beginning of a line in the text being matched. Otherwise, it fails -to match anything. Thus, @samp{^foo} matches a @samp{foo} that occurs -at the beginning of a line. - -@item $ -is similar to @samp{^} but matches only at the end of a line. Thus, -@samp{xx*$} matches a string of one @samp{x} or more at the end of a line. - -@item \ -does two things: it quotes the special characters (including -@samp{\}), and it introduces additional special constructs. - -Because @samp{\} quotes special characters, @samp{\$} is a regular -expression that matches only @samp{$}, and @samp{\[} is a regular -expression that matches only @samp{[}, and so on.@refill -@end table - -Note: for historical compatibility, special characters are treated as -ordinary ones if they are in contexts where their special meanings make no -sense. For example, @samp{*foo} treats @samp{*} as ordinary since there is -no preceding expression on which the @samp{*} can act. It is poor practice -to depend on this behavior; better to quote the special character anyway, -regardless of where is appears.@refill - -Usually, @samp{\} followed by any character matches only -that character. However, there are several exceptions: characters -which, when preceded by @samp{\}, are special constructs. Such -characters are always ordinary when encountered on their own. Here -is a table of @samp{\} constructs. - -@table @kbd -@item \| -specifies an alternative. -Two regular expressions @var{a} and @var{b} with @samp{\|} in -between form an expression that matches anything @var{a} or -@var{b} matches.@refill - -Thus, @samp{foo\|bar} matches either @samp{foo} or @samp{bar} -but no other string.@refill - -@samp{\|} applies to the largest possible surrounding expressions. Only a -surrounding @samp{\( @dots{} \)} grouping can limit the grouping power of -@samp{\|}.@refill - -Full backtracking capability exists to handle multiple uses of @samp{\|}. - -@item \( @dots{} \) -is a grouping construct that serves three purposes: - -@enumerate -@item -To enclose a set of @samp{\|} alternatives for other operations. -Thus, @samp{\(foo\|bar\)x} matches either @samp{foox} or @samp{barx}. - -@item -To enclose a complicated expression for the postfix @samp{*} to operate on. -Thus, @samp{ba\(na\)*} matches @samp{bananana}, etc., with any (zero or -more) number of @samp{na} strings.@refill - -@item -To mark a matched substring for future reference. - -@end enumerate - -This last application is not a consequence of the idea of a -parenthetical grouping; it is a separate feature which happens to be -assigned as a second meaning to the same @samp{\( @dots{} \)} construct -because in practice there is no conflict between the two meanings. -Here is an explanation: - -@item \@var{digit} -after the end of a @samp{\( @dots{} \)} construct, the matcher remembers the -beginning and end of the text matched by that construct. Then, later on -in the regular expression, you can use @samp{\} followed by @var{digit} -to mean ``match the same text matched the @var{digit}'th time by the -@samp{\( @dots{} \)} construct.''@refill - -The strings matching the first nine @samp{\( @dots{} \)} constructs appearing -in a regular expression are assigned numbers 1 through 9 in order that the -open-parentheses appear in the regular expression. @samp{\1} through -@samp{\9} may be used to refer to the text matched by the corresponding -@samp{\( @dots{} \)} construct. - -For example, @samp{\(.*\)\1} matches any newline-free string that is -composed of two identical halves. The @samp{\(.*\)} matches the first -half, which may be anything, but the @samp{\1} that follows must match -the same exact text. - -@item \` -matches the empty string, provided it is at the beginning -of the buffer. - -@item \' -matches the empty string, provided it is at the end of -the buffer. - -@item \b -matches the empty string, provided it is at the beginning or -end of a word. Thus, @samp{\bfoo\b} matches any occurrence of -@samp{foo} as a separate word. @samp{\bballs?\b} matches -@samp{ball} or @samp{balls} as a separate word.@refill - -@item \B -matches the empty string, provided it is @i{not} at the beginning or -end of a word. - -@item \< -matches the empty string, provided it is at the beginning of a word. - -@item \> -matches the empty string, provided it is at the end of a word. - -@item \w -matches any word-constituent character. The editor syntax table -determines which characters these are. - -@item \W -matches any character that is not a word-constituent. - -@item \s@var{code} -matches any character whose syntax is @var{code}. @var{code} is a -character which represents a syntax code: thus, @samp{w} for word -constituent, @samp{-} for whitespace, @samp{(} for open-parenthesis, -etc. @xref{Syntax}.@refill - -@item \S@var{code} -matches any character whose syntax is not @var{code}. -@end table - - Here is a complicated regexp used by Emacs to recognize the end of a -sentence together with any whitespace that follows. It is given in Lisp -syntax to enable you to distinguish the spaces from the tab characters. In -Lisp syntax, the string constant begins and ends with a double-quote. -@samp{\"} stands for a double-quote as part of the regexp, @samp{\\} for a -backslash as part of the regexp, @samp{\t} for a tab and @samp{\n} for a -newline. - -@example -"[.?!][]\"')]*\\($\\|\t\\| \\)[ \t\n]*" -@end example - -@noindent -This regexp contains four parts: a character set matching -period, @samp{?} or @samp{!}; a character set matching close-brackets, -quotes or parentheses, repeated any number of times; an alternative in -backslash-parentheses that matches end-of-line, a tab or two spaces; and -a character set matching whitespace characters, repeated any number of -times. - -@node Search Case, Replace, Regexps, Search -@section Searching and Case - -@vindex case-fold-search - All searches in Emacs normally ignore the case of the text they -are searching through; if you specify searching for @samp{FOO}, -@samp{Foo} and @samp{foo} are also considered a match. Regexps, and in -particular character sets, are included: @samp{[aB]} matches @samp{a} -or @samp{A} or @samp{b} or @samp{B}.@refill - - If you want a case-sensitive search, set the variable -@code{case-fold-search} to @code{nil}. Then all letters must match -exactly, including case. @code{case-fold-search} is a per-buffer -variable; altering it affects only the current buffer, but -there is a default value which you can change as well. @xref{Locals}. -You can also use @b{Case Sensitive Search} from the @b{Options} menu -on your screen. - -@node Replace, Other Repeating Search, Search Case, Search -@section Replacement Commands -@cindex replacement -@cindex string substitution -@cindex global substitution - - Global search-and-replace operations are not needed as often in Emacs as -they are in other editors, but they are available. In addition to the -simple @code{replace-string} command which is like that found in most -editors, there is a @code{query-replace} command which asks you, for each -occurrence of a pattern, whether to replace it. - - The replace commands all replace one string (or regexp) with one -replacement string. It is possible to perform several replacements in -parallel using the command @code{expand-region-abbrevs}. @xref{Expanding -Abbrevs}. - -@menu -* Unconditional Replace:: Replacing all matches for a string. -* Regexp Replace:: Replacing all matches for a regexp. -* Replacement and Case:: How replacements preserve case of letters. -* Query Replace:: How to use querying. -@end menu - -@node Unconditional Replace, Regexp Replace, Replace, Replace -@subsection Unconditional Replacement -@findex replace-string -@findex replace-regexp - -@table @kbd -@item M-x replace-string @key{RET} @var{string} @key{RET} @var{newstring} @key{RET} -Replace every occurrence of @var{string} with @var{newstring}. -@item M-x replace-regexp @key{RET} @var{regexp} @key{RET} @var{newstring} @key{RET} -Replace every match for @var{regexp} with @var{newstring}. -@end table - - To replace every instance of @samp{foo} after point with @samp{bar}, -use the command @kbd{M-x replace-string} with the two arguments -@samp{foo} and @samp{bar}. Replacement occurs only after point: if you -want to cover the whole buffer you must go to the beginning first. By -default, all occurrences up to the end of the buffer are replaced. To -limit replacement to part of the buffer, narrow to that part of the -buffer before doing the replacement (@pxref{Narrowing}). - - When @code{replace-string} exits, point is left at the last occurrence -replaced. The value of point when the @code{replace-string} command was -issued is remembered on the mark ring; @kbd{C-u C-@key{SPC}} moves back -there. - - A numeric argument restricts replacement to matches that are surrounded -by word boundaries. - -@node Regexp Replace, Replacement and Case, Unconditional Replace, Replace -@subsection Regexp Replacement - - @code{replace-string} replaces exact matches for a single string. The -similar command @code{replace-regexp} replaces any match for a specified -pattern. - - In @code{replace-regexp}, the @var{newstring} need not be constant. It -can refer to all or part of what is matched by the @var{regexp}. @samp{\&} -in @var{newstring} stands for the entire text being replaced. -@samp{\@var{d}} in @var{newstring}, where @var{d} is a digit, stands for -whatever matched the @var{d}'th parenthesized grouping in @var{regexp}. -For example,@refill - -@example -M-x replace-regexp @key{RET} c[ad]+r @key{RET} \&-safe @key{RET} -@end example - -@noindent -would replace (for example) @samp{cadr} with @samp{cadr-safe} and @samp{cddr} -with @samp{cddr-safe}. - -@example -M-x replace-regexp @key{RET} \(c[ad]+r\)-safe @key{RET} \1 @key{RET} -@end example - -@noindent -would perform exactly the opposite replacements. To include a @samp{\} -in the text to replace with, you must give @samp{\\}. - -@node Replacement and Case, Query Replace, Regexp Replace, Replace -@subsection Replace Commands and Case - -@vindex case-replace -@vindex case-fold-search - If the arguments to a replace command are in lower case, the command -preserves case when it makes a replacement. Thus, the following command: - -@example -M-x replace-string @key{RET} foo @key{RET} bar @key{RET} -@end example - -@noindent -replaces a lower-case @samp{foo} with a lower case @samp{bar}, @samp{FOO} -with @samp{BAR}, and @samp{Foo} with @samp{Bar}. If upper-case letters are -used in the second argument, they remain upper-case every time that -argument is inserted. If upper-case letters are used in the first -argument, the second argument is always substituted exactly as given, with -no case conversion. Likewise, if the variable @code{case-replace} is set -to @code{nil}, replacement is done without case conversion. If -@code{case-fold-search} is set to @code{nil}, case is significant in -matching occurrences of @samp{foo} to replace; also, case conversion of the -replacement string is not done. - -@node Query Replace,, Replacement and Case, Replace -@subsection Query Replace -@cindex query replace - -@table @kbd -@item M-% @var{string} @key{RET} @var{newstring} @key{RET} -@itemx M-x query-replace @key{RET} @var{string} @key{RET} @var{newstring} @key{RET} -Replace some occurrences of @var{string} with @var{newstring}. -@item M-x query-replace-regexp @key{RET} @var{regexp} @key{RET} @var{newstring} @key{RET} -Replace some matches for @var{regexp} with @var{newstring}. -@end table - -@kindex M-% -@findex query-replace - If you want to change only some of the occurrences of @samp{foo} to -@samp{bar}, not all of them, you can use @code{query-replace} instead of -@kbd{M-%}. This command finds occurrences of @samp{foo} one by one, -displays each occurrence, and asks you whether to replace it. A numeric -argument to @code{query-replace} tells it to consider only occurrences -that are bounded by word-delimiter characters.@refill - -@findex query-replace-regexp - Aside from querying, @code{query-replace} works just like -@code{replace-string}, and @code{query-replace-regexp} works -just like @code{replace-regexp}.@refill - - The things you can type when you are shown an occurrence of @var{string} -or a match for @var{regexp} are: - -@kindex SPC (query-replace) -@kindex DEL (query-replace) -@kindex , (query-replace) -@kindex ESC (query-replace) -@kindex . (query-replace) -@kindex ! (query-replace) -@kindex ^ (query-replace) -@kindex C-r (query-replace) -@kindex C-w (query-replace) -@kindex C-l (query-replace) - -@c WideCommands -@table @kbd -@item @key{SPC} -to replace the occurrence with @var{newstring}. This preserves case, just -like @code{replace-string}, provided @code{case-replace} is non-@code{nil}, -as it normally is.@refill - -@item @key{DEL} -to skip to the next occurrence without replacing this one. - -@item , @r{(Comma)} -to replace this occurrence and display the result. You are then -prompted for another input character. However, since the replacement has -already been made, @key{DEL} and @key{SPC} are equivalent. At this -point, you can type @kbd{C-r} (see below) to alter the replaced text. To -undo the replacement, you can type @kbd{C-x u}. -This exits the @code{query-replace}. If you want to do further -replacement you must use @kbd{C-x ESC} to restart (@pxref{Repetition}). - -@item @key{ESC} -to exit without doing any more replacements. - -@item .@: @r{(Period)} -to replace this occurrence and then exit. - -@item ! -to replace all remaining occurrences without asking again. - -@item ^ -to go back to the location of the previous occurrence (or what used to -be an occurrence), in case you changed it by mistake. This works by -popping the mark ring. Only one @kbd{^} in a row is allowed, because -only one previous replacement location is kept during @code{query-replace}. - -@item C-r -to enter a recursive editing level, in case the occurrence needs to be -edited rather than just replaced with @var{newstring}. When you are -done, exit the recursive editing level with @kbd{C-M-c} and the next -occurrence will be displayed. @xref{Recursive Edit}. - -@item C-w -to delete the occurrence, and then enter a recursive editing level as -in @kbd{C-r}. Use the recursive edit to insert text to replace the -deleted occurrence of @var{string}. When done, exit the recursive -editing level with @kbd{C-M-c} and the next occurrence will be -displayed. - -@item C-l -to redisplay the screen and then give another answer. - -@item C-h -to display a message summarizing these options, then give another -answer. -@end table - - If you type any other character, Emacs exits the @code{query-replace}, and -executes the character as a command. To restart the @code{query-replace}, -use @kbd{C-x @key{ESC}}, which repeats the @code{query-replace} because it -used the minibuffer to read its arguments. @xref{Repetition, C-x ESC}. - -@node Other Repeating Search,, Replace, Search -@section Other Search-and-Loop Commands - - Here are some other commands that find matches for a regular expression. -They all operate from point to the end of the buffer. - -@findex list-matching-lines -@findex occur -@findex count-matches -@findex delete-non-matching-lines -@findex delete-matching-lines -@c grosscommands -@table @kbd -@item M-x occur -Print each line that follows point and contains a match for the -specified regexp. A numeric argument specifies the number of context -lines to print before and after each matching line; the default is -none. - -@kindex C-c C-c (Occur mode) -The buffer @samp{*Occur*} containing the output serves as a menu for -finding occurrences in their original context. Find an occurrence -as listed in @samp{*Occur*}, position point there, and type @kbd{C-c -C-c}; this switches to the buffer that was searched and moves point to -the original of the same occurrence. - -@item M-x list-matching-lines -Synonym for @kbd{M-x occur}. - -@item M-x count-matches -Print the number of matches following point for the specified regexp. - -@item M-x delete-non-matching-lines -Delete each line that follows point and does not contain a match for -the specified regexp. - -@item M-x delete-matching-lines -Delete each line that follows point and contains a match for the -specified regexp. -@end table diff --git a/man/xemacs/sending.texi b/man/xemacs/sending.texi deleted file mode 100644 index dda833f..0000000 --- a/man/xemacs/sending.texi +++ /dev/null @@ -1,350 +0,0 @@ - -@node Sending Mail, Reading Mail, Picture, Top -@chapter Sending Mail -@cindex mail -@cindex message - - To send a message in Emacs, start by typing the command (@kbd{C-x m}) -to select and initialize the @samp{*mail*} buffer. You can then edit the text -and headers of the message in the mail buffer, and type the command -(@kbd{C-c C-c}) to send the message. - -@table @kbd -@item C-x m -Begin composing a message to send (@code{mail}). -@item C-x 4 m -Likewise, but display the message in another window -(@code{mail-other-window}). -@item C-c C-c -In Mail mode, send the message and switch to another buffer -(@code{mail-send-and-exit}). -@end table - -@kindex C-x m -@findex mail -@kindex C-x 4 m -@findex mail-other-window - The command @kbd{C-x m} (@code{mail}) selects a buffer named -@samp{*mail*} and initializes it with the skeleton of an outgoing message. -@kbd{C-x 4 m} (@code{mail-other-window}) selects the @samp{*mail*} buffer -in a different window, leaving the previous current buffer visible.@refill - - Because the buffer for mail composition is an ordinary Emacs buffer, you can -switch to other buffers while in the middle of composing mail, and switch -back later (or never). If you use the @kbd{C-x m} command again when you -have been composing another message but have not sent it, a new mail -buffer will be created; in this way, you can compose multiple messages -at once. You can switch back to and complete an unsent message by using -the normal buffer selection mechanisms. - -@kbd{C-u C-x m} is another way to switch back to a message in progress: -it will search for an existing, unsent mail message buffer and select it. - -@menu -* Format: Mail Format. Format of the mail being composed. -* Headers: Mail Headers. Details of allowed mail header fields. -* Mode: Mail Mode. Special commands for editing mail being composed. -@end menu - -@node Mail Format, Mail Headers, Sending Mail, Sending Mail -@section The Format of the Mail Buffer - - In addition to the @dfn{text} or contents, a message has @dfn{header -fields}, which say who sent it, when, to whom, why, and so on. Some header -fields, such as the date and sender, are created automatically after the -message is sent. Others, such as the recipient names, must be specified by -you in order to send the message properly. - - Mail mode provides a few commands to help you edit some header fields, -and some are preinitialized in the buffer automatically at times. You can -insert or edit any header fields using ordinary editing commands. - - The line in the buffer that says: - -@example ---text follows this line-- -@end example - -@vindex mail-header-separator -@noindent -is a special delimiter that separates the headers you have specified from -the text. Whatever follows this line is the text of the message; the -headers precede it. The delimiter line itself does not appear in the -message actually sent. The text used for the delimiter line is controlled -by the variable @code{mail-header-separator}. - -Here is an example of what the headers and text in the @samp{*mail*} buffer -might look like. - -@example -To: rms@@mc -CC: mly@@mc, rg@@oz -Subject: The XEmacs User's Manual ---Text follows this line-- -Please ignore this message. -@end example - -@node Mail Headers, Mail Mode, Mail Format, Sending Mail -@section Mail Header Fields -@cindex headers (of mail message) - - There are several header fields you can use in the @samp{*mail*} buffer. -Each header field starts with a field name at the beginning of a line, -terminated by a colon. It does not matter whether you use upper or lower -case in the field name. After the colon and optional whitespace comes the -contents of the field. - -@table @samp -@item To -This field contains the mailing addresses of the message. - -@item Subject -The contents of the @samp{Subject} field should be a piece of text that -says what the message is about. Subject fields are useful because most -mail-reading programs can provide a summary of messages, listing the -subject of each message but not its text. - -@item CC -This field contains additional mailing addresses to send the message -to, but whose readers should not regard the message as addressed to -them. - -@item BCC -This field contains additional mailing addresses to send the message -to, but which should not appear in the header of the message actually -sent. - -@item FCC -This field contains the name of one file (in Unix mail file format) to -which a copy of the message should be appended when the message is -sent. - -@item From -Use the @samp{From} field to say who you are, when the account you are -using to send the mail is not your own. The contents of the -@samp{From} field should be a valid mailing address, since replies -will normally go there. - -@item Reply-To -Use the @samp{Reply-To} field to direct replies to a different -address, not your own. @samp{From} and -@samp{Reply-To} have the same effect on where replies go, but they convey a -different meaning to the person who reads the message. - -@item In-Reply-To -This field contains a piece of text describing a message you are -replying to. Some mail systems can use the information to correlate -related pieces of mail. This field is normally filled in by your mail -handling package when you are replying to a message and you never need -to think about it. -@end table - -@noindent -The @samp{To}, @samp{CC}, @samp{BCC} and @samp{FCC} fields can appear -any number of times, to specify many places to send the message. - -@noindent -The @samp{To}, @samp{CC}, and @samp{BCC}, fields can have continuation -lines. All the lines starting with whitespace, following the line on -which the field starts, are considered part of the field. For -example,@refill - -@example -To: foo@@here, this@@there, - me@@gnu.cambridge.mass.usa.earth.spiral3281 -@end example - -@noindent -@vindex mail-abbrev-mailrc-file -If you have a @file{~/.mailrc} file, Emacs scans it for mail aliases the -first time you try to send mail in an Emacs session. Emacs expands -aliases found in the @samp{To}, @samp{CC}, and @samp{BCC} fields where -appropriate. You can set the variable @code{mail-abbrev-mailrc-file} to -the name of the file with mail aliases. If @code{nil}, @file{~/.mailrc} -is used. - -@cindex .mailrc file -Your @file{.mailrc} file ensures that word-abbrevs are defined for each -of your mail aliases when point is in a @samp{To}, @samp{CC}, -@samp{BCC}, or @samp{From} field. The aliases are defined in your -@file{.mailrc} file or in a file specified by the @b{MAILRC} -environment variable if it exists. Your mail aliases expand any time -you type a word-delimiter at the end of an abbreviation. - -In this version of Emacs, what you see is what you get: in contrast to -some other versions, no abbreviations are expanded after you have sent the -mail. This means you don't suffer the annoyance of having the system do -things behind your back --- if the system rewrites an address you typed, -you know it immediately, instead of after the mail has been sent and -it's too late to do anything about it. For example, you will never -again be in trouble because you forgot to delete an old alias from your -@file{.mailrc} and a new local user is given a userid which conflicts -with one of your aliases. - -@vindex mail-abbrev-mode-regexp -Your mail alias abbrevs are in effect only when point is in an -appropriate header field. The mail aliases will not expand in the body -of the message, or in other header fields. The default mode-specific -abbrev table @code{mail-mode-abbrev-table} is used instead if defined. -That means if you have been using 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 @code{mail-abbrev-mode-regexp}. - -If auto-fill mode is on, abbrevs wrap at commas instead of at word -boundaries, and header continuation lines will be properly indented. - -@findex mail-interactive-insert-alias -You can also insert a mail alias with @code{mail-interactive-insert-alias}. -This function, which is bound to @kbd{C-c C-a}, prompts you for an alias -(with completion) and inserts its expansion at point. - -In this version of Emacs, it is possible to have lines like the -following in your @file{.mailrc} file: - -@example - alias someone "John Doe " -@end example - -That is, if you want an address to have embedded spaces, simply surround -it with double-quotes. The quotes are necessary because the format of -the @file{.mailrc} file uses spaces as address delimiters. - -Aliases in the @file{.mailrc} file may be nested. For example, assume -you define aliases like: -@example - alias group1 fred ethel - alias group2 larry curly moe - alias everybody group1 group2 -@end example - -When you now type @samp{everybody} on the @samp{To} line, it will expand to: -@example - fred, ethyl, larry, curly, moe -@end example - -Aliases may contain forward references; the alias of @samp{everybody} in the -example above can precede the aliases of @samp{group1} and @samp{group2}. - -In this version of Emacs, you can use the @code{source} @file{.mailrc} command -for reading aliases from some other file as well. - -Aliases may contain hyphens, as in @code{"alias foo-bar foo@@bar"}, even -though word-abbrevs normally cannot contain hyphens. - -To read in the contents of another @file{.mailrc}-type file from Emacs, use the -command @code{M-x merge-mail-aliases}. The @code{rebuild-mail-aliases} -command is similar, but deletes existing aliases first. - -@vindex mail-alias-seperator-string -If you want multiple addresses separated by a string other than @samp{,} -(a comma), then set the variable @code{mail-alias-seperator-string} to -it. This has to be a comma bracketed by whitespace if you want any kind - of reasonable behavior. - -@vindex mail-archive-file-name - If the variable @code{mail-archive-file-name} is non-@code{nil}, it -should be a string naming a file. Each time you start to edit a message -to send, an @samp{FCC} field is entered for that file. Unless you -remove the @samp{FCC} field, every message is written into that -file when it is sent. - -@node Mail Mode,, Mail Headers, Sending Mail -@section Mail Mode - - The major mode used in the @samp{*mail*} buffer is Mail mode. Mail -mode is similar to Text mode, but several commands are provided on -the @kbd{C-c} prefix. These commands all deal specifically with -editing or sending the message. - -@table @kbd -@item C-c C-s -Send the message, and leave the @samp{*mail*} buffer selected -(@code{mail-send}). -@item C-c C-c -Send the message, and select some other buffer (@code{mail-send-and-exit}). -@item C-c C-f C-t -Move to the @samp{To} header field, creating one if there is none -(@code{mail-to}). -@item C-c C-f C-s -Move to the @samp{Subject} header field, creating one if there is -none (@code{mail-subject}). -@item C-c C-f C-c -Move to the @samp{CC} header field, creating one if there is none -(@code{mail-cc}). -@item C-c C-w -Insert the file @file{~/.signature} at the end of the message text -(@code{mail-signature}). -@item C-c C-y -Yank the selected message (@code{mail-yank-original}). -@item C-c C-q -Fill all paragraphs of yanked old messages, each individually -(@code{mail-fill-yanked-message}). -@item @key{button3} -Pops up a menu of useful mail-mode commands. -@end table - -@kindex C-c C-s (Mail mode) -@kindex C-c C-c (Mail mode) -@findex mail-send -@findex mail-send-and-exit - There are two ways to send a message. @kbd{C-c C-c} -(@code{mail-send-and-exit}) is the usual way to send the message. It -sends the message and then deletes the window (if there is another -window) or switches to another buffer. It puts the @samp{*mail*} buffer -at the lowest priority for automatic reselection, since you are finished -with using it. @kbd{C-c C-s} (@code{mail-send}) sends the -message and marks the @samp{*mail*} buffer unmodified, but leaves that -buffer selected so that you can modify the message (perhaps with new -recipients) and send it again. - -@kindex C-c C-f C-t (Mail mode) -@findex mail-to -@kindex C-c C-f C-s (Mail mode) -@findex mail-subject -@kindex C-c C-f C-c (Mail mode) -@findex mail-cc - Mail mode provides some other special commands that are useful for -editing the headers and text of the message before you send it. There are -three commands defined to move point to particular header fields, all based -on the prefix @kbd{C-c C-f} (@samp{C-f} is for ``field''). They are -@kbd{C-c C-f C-t} (@code{mail-to}) to move to the @samp{To} field, @kbd{C-c -C-f C-s} (@code{mail-subject}) for the @samp{Subject} field, and @kbd{C-c -C-f C-c} (@code{mail-cc}) for the @samp{CC} field. These fields have -special motion commands because they are edited most frequently. - - -@kindex C-c C-w (Mail mode) -@findex mail-signature - @kbd{C-c C-w} (@code{mail-signature}) adds a standard piece of text at -the end of the message to say more about who you are. The text comes -from the file @file{.signature} in your home directory. - -@kindex C-c C-y (Mail mode) -@findex mail-yank-original - When you use an Rmail command to send mail from the Rmail mail reader, -you can use @kbd{C-c C-y} @code{mail-yank-original} inside the -@samp{*mail*} buffer to insert the -text of the message you are replying to. Normally Rmail indents each line -of that message four spaces and eliminates most header fields. A -numeric argument specifies the number of spaces to indent. An argument -of just @kbd{C-u} says not to indent at all and not to eliminate -anything. @kbd{C-c C-y} always uses the current message from the -@samp{RMAIL} buffer, so you can insert several old messages by selecting -one in @samp{RMAIL}, switching to @samp{*mail*} and yanking it, then -switching back to @samp{RMAIL} to select another.@refill - -@kindex C-c C-q (Mail mode) -@findex mail-fill-yanked-message - After using @kbd{C-c C-y}, you can use the command @kbd{C-c C-q} -(@code{mail-fill-yanked-message}) to fill the paragraphs of the yanked -old message or messages. One use of @kbd{C-c C-q} fills all such -paragraphs, each one separately. - - Clicking the right mouse button in a mail buffer pops up a menu of -the above commands, for easy access. - -@vindex mail-mode-hook - Turning on Mail mode (which @kbd{C-x m} does automatically) calls the -value of @code{text-mode-hook}, if it is not void or @code{nil}, and -then calls the value of @code{mail-mode-hook} if that is not void or -@code{nil}. diff --git a/man/xemacs/startup.texi b/man/xemacs/startup.texi deleted file mode 100644 index 54ab1b3..0000000 --- a/man/xemacs/startup.texi +++ /dev/null @@ -1,204 +0,0 @@ -@node Startup Paths, Basic, Command Switches, Top -@comment node-name, next, previous, up -@section How XEmacs finds Directories and Files - -@cindex startup paths -@cindex directories - -XEmacs deals with a multitude of files during operation. These files -are spread over many directories, and XEmacs determines the location of -most of these directories at startup and organizes them into various -paths. (A @dfn{path}, -@cindex path -for the purposes of this section, is simply a list of directories which -XEmacs searches successively in order to locate a file.) - -@subsection XEmacs Directory Hierarchies -@cindex hierarchies -@cindex directory hierarchies - -Many of the files XEmacs looks for are located within the XEmacs -installation itself. However, there are several views of what actually -constitutes the "XEmacs installation": XEmacs may be run from the -compilation directory, it may be installed into arbitrary directories, -spread over several directories unrelated to each other. Moreover, it -may subsequently be moved to a different place. (This last case is not -as uncommon as it sounds. Binary kits work this way.) Consequently, -XEmacs has quite complex procedures in place to find directories, no -matter where they may be hidden. - -XEmacs will always respect directory options passed to @code{configure}. -However, if it cannot locate a directory at the configured place, it -will initiate a search for the directory in any of a number of -@dfn{hierarchies} rooted under a directory which XEmacs assumes contain -parts of the XEmacs installation; it may locate several such hierarchies -and search across them. (Typically, there are just one or two -hierarchies: the hierarchy where XEmacs was or will be installed, and -the one where it is being built.) Such a directory containing a -hierarchy is called a @dfn{root}. -@cindex root of a hierarchy -Whenever this section refers to a directory using the shorthand -@code{}, it means that XEmacs searches for it under all -hierarchies under all hierarchies XEmacs was able to scrounge up. In a -running XEmacs, the hierarchy roots are stored in the variable -@code{emacs-roots}. -@vindex emacs-roots - -@subsection Package Hierarchies -@cindex package hierarchies - -Many relevant directories and files XEmacs uses are actually not part of -the core installation. They are part of any of the many packages -usually installed on top of an XEmacs installation. (@xref{Packages}.) -Hence, they play a prominent role in the various paths XEmacs sets up. - -XEmacs locates packages in any of a number of package hierarchies. -Package hierarchies fall into three groups: @dfn{early}, @dfn{late}, -and @dfn{last}, -@cindex early package hierarchies -@cindex late package hierarchies -@cindex last package hierarchies -according to the relative location at which they show -up in the various XEmacs paths. Early package hierarchies are at the -very front, late ones somewhere in the middle, and last hierarchies are -(you guessed it) last. - -By default, XEmacs expects an early package hierarchy in the a -subdirectory @file{.xemacs} of the user's home directory. - -Moreover, XEmacs expects late hierarchies in the subdirectories -@file{site-packages}, @file{mule-packages}, and @file{xemacs-packages} -(in that order) of the @file{/lib/xemacs} subdirectory of one of -the installation hierarchies. (If you run in-place, these are direct -subdirectories of the build directory.) Furthermore, XEmacs will also -search these subdirectories in the @file{/lib/xemacs-} -subdirectory and prefer directories found there. - -By default, XEmacs does not have a pre-configured last package -hierarchy. Last hierarchies are primarily for using package hierarchies -of outdated versions of XEmacs as a fallback option. For example, it is -possible to run XEmacs 21.0 with the 20.4 package hierarchy as a last -hierarchy. - -It is possible to specify at configure-time the location of the various -package hierarchies with the @code{--package-path} option to configure. -@cindex package path -The early, late, and last components of the package path are separated -by double instead of single colons. If three components are present, -they are locate the early, late, and last package hierarchies -respectively. If two components are present, they locate the early and -late hierarchies. If only one component is present, it locates the late -hierarchy. At run time, the package path may also be specified via the -@code{PACKAGEPATH} environment variable. - -An XEmacs package is laid out just like a normal installed XEmacs lisp -directory. It may have @file{lisp}, @file{etc}, @file{info}, and -@file{lib-src} subdirectories. XEmacs adds these at appropriate places -within the various system-wide paths. - -There may be any number of package hierarchy directories. - -@subsection Directories and Paths -@cindex paths - -Here is a list of the various directories and paths XEmacs tries to -locate during startup. XEmacs distinguishes between directories and -paths specific to @dfn{version}, @dfn{site}, and @dfn{architecture} -when looking for them. - -@table @code -@item version-specific -@cindex version-specific directories -directories are specific to the version of XEmacs they belong to and -typically reside under @file{/lib/xemacs-}. -@item site-specific -@cindex site-specific directories -directories are independent of the version of XEmacs they belong to and -typically reside under @file{/lib/xemacs} -@item architecture-specific -@cindex architecture-specific directories -directories are specific both to the version of XEmacs and the -architecture it runs on and typically reside under -@file{/lib/xemacs-/}. -@end table - -During installation, all of these directories may also reside directly -under @file{}, because that is where they are in the XEmacs tarball. - -If XEmacs runs with the @code{-debug-paths} option (@xref{Command -Switches}), it will print the values of these variables, hopefully -aiding in debugging any problems which come up. - -@table @code - -@item lisp-directory -@vindex lisp-directory -Contains the version-specific location of the Lisp files that come with -the core distribution of XEmacs. XEmacs will search it recursively to a -depth of 1 when setting up @code{load-path}. - -@item load-path -@vindex load-path -Is where XEmacs searches for XEmacs Lisp files with commands like -@code{load-library}. -@findex load-library -It contains the package lisp directories (see further down) and the -version-specific core Lisp directories. If the environment variable -@code{EMACSLOADPATH} is set at startup, its directories are prepended to -@code{load-path}. -@vindex EMACSLOADPATH - -@item Info-directory-list -@vindex Info-directory-list -Contains the location of info files. (See @ref{(info)}.) It contains -the package info directories and the version-specific core -documentation. Moreover, XEmacs will add @file{/usr/info}, -@file{/usr/local/info} as well as the directories of the environment -variable @code{INFOPATH} -@vindex INFOPATH -to @code{Info-directory-list}. - -@item lock-directory -@itemx superlock-file -@vindex lock-directory -@vindex superlock-file -Are the site-specific locations of the lock directory and the superlock -file, respectively. The @code{lock-directory} variable may also be -initialized from the @code{EMACSLOCKDIR} -@vindex EMACSLOCKDIR -environment variable. - -@item exec-directory -@vindex exec-directory -Is the directory of architecture-dependent files that come with XEmacs, -especially executable programs intended for XEmacs to invoke. - -@item exec-path -@vindex exec-path -Is the path for executables which XEmacs may want to start. It contains -the package executable paths as well as @code{exec-directory}, and the -directories of the environment variables @code{PATH} -@vindex PATH -and @code{EMACSPATH}. -@vindex EMACSPATH - -@item doc-directory -@vindex doc-directory -Is the directory containing the architecture-specific @file{DOC} file -that contains documentation for XEmacs' commands. - -@item data-directory -@vindex data-directory -Is the version-specific directory that contains core data files XEmacs uses. -It may be initialized from the @code{EMACSDATA} -@vindex EMACSDATA -environment variable. - -@item data-directory-list -@vindex data-directory-list -Is the path where XEmacs looks for data files. It contains package data -directories as well as @code{data-directory}. - -@end table - - diff --git a/man/xemacs/text.texi b/man/xemacs/text.texi deleted file mode 100644 index 5154fdb..0000000 --- a/man/xemacs/text.texi +++ /dev/null @@ -1,1126 +0,0 @@ - -@node Text, Programs, Indentation, Top -@chapter Commands for Human Languages -@cindex text - - The term @dfn{text} has two widespread meanings in our area of the -computer field. One is data that is a sequence of characters. In this -sense of the word any file that you edit with Emacs is text. The other -meaning is more restrictive: a sequence of characters in a human -language for humans to read (possibly after processing by a text -formatter), as opposed to a program or commands for a program. - - Human languages have syntactic and stylistic conventions that editor -commands should support or use to advantage: conventions involving -words, sentences, paragraphs, and capital letters. This chapter describes -Emacs commands for all these things. There are also commands for -@dfn{filling}, or rearranging paragraphs into lines of approximately equal -length. The commands for moving over and killing words, sentences, -and paragraphs, while intended primarily for editing text, are also often -useful for editing programs. - - Emacs has several major modes for editing human language text. -If a file contains plain text, use Text mode, which customizes -Emacs in small ways for the syntactic conventions of text. For text which -contains embedded commands for text formatters, Emacs has other major modes, -each for a particular text formatter. Thus, for input to @TeX{}, you can -use @TeX{} mode; for input to nroff, Nroff mode. - -@menu -* Text Mode:: The major modes for editing text files. -* Nroff Mode:: The major mode for editing input to the formatter nroff. -* TeX Mode:: The major modes for editing input to the formatter TeX. -* Outline Mode:: The major mode for editing outlines. -* Words:: Moving over and killing words. -* Sentences:: Moving over and killing sentences. -* Paragraphs:: Moving over paragraphs. -* Pages:: Moving over pages. -* Filling:: Filling or justifying text -* Case:: Changing the case of text -@end menu - -@node Text Mode, Words, Text, Text -@section Text Mode - -@findex tab-to-tab-stop -@findex edit-tab-stops -@cindex Text mode -@kindex TAB -@findex text-mode - You should use Text mode---rather than Fundamental or Lisp mode---to -edit files of text in a human language. Invoke @kbd{M-x text-mode} to -enter Text mode. In Text mode, @key{TAB} runs the function -@code{tab-to-tab-stop}, which allows you to use arbitrary tab stops set -with @kbd{M-x edit-tab-stops} (@pxref{Tab Stops}). Features concerned -with comments in programs are turned off unless they are explicitly invoked. -The syntax table is changed so that periods are not considered part of a -word, while apostrophes, backspaces and underlines are. - -@findex indented-text-mode - A similar variant mode is Indented Text mode, intended for editing -text in which most lines are indented. This mode defines @key{TAB} to -run @code{indent-relative} (@pxref{Indentation}), and makes Auto Fill -indent the lines it creates. As a result, a line made by Auto Filling, -or by @key{LFD}, is normally indented just like the previous line. Use -@kbd{M-x indented-text-mode} to select this mode. - -@vindex text-mode-hook - Entering Text mode or Indented Text mode calls the value of the -variable @code{text-mode-hook} with no arguments, if that value exists -and is not @code{nil}. This value is also called when modes related to -Text mode are entered; this includes Nroff mode, @TeX{} mode, Outline -mode, and Mail mode. Your hook can look at the value of -@code{major-mode} to see which of these modes is actually being entered. - - Two modes similar to Text mode are of use for editing text that is to -be passed through a text formatter before achieving its final readable form. - -@menu -* Nroff Mode:: The major mode for editing input to the formatter nroff. -* TeX Mode:: The major modes for editing input to the formatter TeX. - - - Another similar mode is used for editing outlines. It allows you -to view the text at various levels of detail. You can view either -the outline headings alone or both headings and text; you can also -hide some of the headings at lower levels from view to make the high -level structure more visible. - - -* Outline Mode:: The major mode for editing outlines. -@end menu - -@node Nroff Mode, TeX Mode, Text Mode, Text Mode -@subsection Nroff Mode - -@cindex nroff -@findex nroff-mode - Nroff mode is a mode like Text mode but modified to handle nroff -commands present in the text. Invoke @kbd{M-x nroff-mode} to enter this -mode. Nroff mode differs from Text mode in only a few ways. All nroff -command lines are considered paragraph separators, so that filling never -garbles the nroff commands. Pages are separated by @samp{.bp} commands. -Comments start with backslash-doublequote. There are also three special -commands that are not available in Text mode: - -@findex forward-text-line -@findex backward-text-line -@findex count-text-lines -@kindex M-n -@kindex M-p -@kindex M-? -@table @kbd -@item M-n -Move to the beginning of the next line that isn't an nroff command -(@code{forward-text-line}). An argument is a repeat count. -@item M-p -Like @kbd{M-n} but move up (@code{backward-text-line}). -@item M-? -Prints in the echo area the number of text lines (lines that are not -nroff commands) in the region (@code{count-text-lines}). -@end table - -@findex electric-nroff-mode - The other feature of Nroff mode is Electric Nroff newline mode. -This is a minor mode that you can turn on or off with -@kbd{M-x electric-nroff-mode} (@pxref{Minor Modes}). When the mode is -on and you use @key{RET} to end a line containing an nroff command -that opens a kind of grouping, Emacs automatically inserts the matching -nroff command to close that grouping on the following line. For -example, if you are at the beginning of a line and type @kbd{.@:(b -@key{RET}}, the matching command @samp{.)b} will be inserted on a new -line following point. - -@vindex nroff-mode-hook - Entering Nroff mode calls the value of the variable -@code{text-mode-hook} with no arguments, if that value exists and is not -@code{nil}; then it does the same with the variable -@code{nroff-mode-hook}. - -@node TeX Mode, Outline Mode, Nroff Mode, Text Mode -@subsection @TeX{} Mode -@cindex TeX -@cindex LaTeX -@findex TeX-mode -@findex tex-mode -@findex plain-tex-mode -@findex LaTeX-mode -@findex plain-TeX-mode -@findex latex-mode - - @TeX{} is a powerful text formatter written by Donald Knuth; like GNU -Emacs, it is free. La@TeX{} is a simplified input format for @TeX{}, -implemented by @TeX{} macros. It is part of @TeX{}.@refill - - Emacs has a special @TeX{} mode for editing @TeX{} input files. -It provides facilities for checking the balance of delimiters and for -invoking @TeX{} on all or part of the file. - - @TeX{} mode has two variants, Plain @TeX{} mode and La@TeX{} mode, -which are two distinct major modes that differ only slightly. These -modes are designed for editing the two different input formats. The -command @kbd{M-x tex-mode} looks at the contents of a buffer to -determine whether it appears to be La@TeX{} input or not; it then -selects the appropriate mode. If it can't tell which is right (e.g., -the buffer is empty), the variable @code{tex-default-mode} controls -which mode is used. - - The commands @kbd{M-x plain-tex-mode} and @kbd{M-x latex-mode} -explicitly select one of the variants of @TeX{} mode. Use these -commands when @kbd{M-x tex-mode} does not guess right.@refill - -@menu -* Editing: TeX Editing. Special commands for editing in TeX mode. -* Printing: TeX Print. Commands for printing part of a file with TeX. -@end menu - - @TeX{} for Unix systems can be obtained from the University of Washington -for a distribution fee. - - To order a full distribution, send $140.00 for a 1/2 inch -9-track tape, $165.00 for two 4-track 1/4 inch cartridge tapes -(foreign sites $150.00, for 1/2 inch, $175.00 for 1/4 inch, to cover -the extra postage) payable to the University of Washington to: - -@display -The Director -Northwest Computer Support Group, DW-10 -University of Washington -Seattle, Washington 98195 -@end display - -@noindent -Purchase orders are acceptable, but there is an extra charge of -$10.00 to pay for processing charges. (The total cost comes to $150 -for domestic sites, $175 for foreign sites). - - The normal distribution is a tar tape, blocked 20, 1600 bpi, on an -industry standard 2400 foot half-inch reel. The physical format for -the 1/4 inch streamer cartridges uses QIC-11, 8000 bpi, 4-track -serpentine recording for the SUN. Also, SystemV tapes can be written -in cpio format, blocked 5120 bytes, ASCII headers. - -@node TeX Editing,TeX Print,TeX Mode,TeX Mode -@subsubsection @TeX{} Editing Commands - - Here are the special commands provided in @TeX{} mode for editing the -text of the file. - -@table @kbd -@item " -Insert, according to context, either @samp{``} or @samp{"} or -@samp{''} (@code{TeX-insert-quote}). -@item @key{LFD} -Insert a paragraph break (two newlines) and check the previous -paragraph for unbalanced braces or dollar signs -(@code{tex-terminate-@*paragraph}). -@item M-x validate-tex-buffer -Check each paragraph in the buffer for unbalanced braces or dollar signs. -@item C-c @{ -Insert @samp{@{@}} and position point between them (@code{tex-insert-braces}). -@item C-c @} -Move forward past the next unmatched close brace (@code{up-list}). -@item C-c C-e -Close a block for La@TeX{} (@code{tex-close-latex-block}). -@end table - -@findex tex-insert-quote -@kindex " (TeX mode) - In @TeX{}, the character @samp{"} is not normally used; you use @samp{``} -to start a quotation and @samp{''} to end one. @TeX{} mode defines the key -@kbd{"} to insert @samp{``} after whitespace or an open brace, @samp{"} -after a backslash, or @samp{''} otherwise. This is done by the command -@code{tex-insert-quote}. If you need the character @samp{"} itself in -unusual contexts, use @kbd{C-q} to insert it. Also, @kbd{"} with a -numeric argument always inserts that number of @samp{"} characters. - - In @TeX{} mode, @samp{$} has a special syntax code which attempts to -understand the way @TeX{} math mode delimiters match. When you insert a -@samp{$} that is meant to exit math mode, the position of the matching -@samp{$} that entered math mode is displayed for a second. This is the -same feature that displays the open brace that matches a close brace that -is inserted. However, there is no way to tell whether a @samp{$} enters -math mode or leaves it; so when you insert a @samp{$} that enters math -mode, the previous @samp{$} position is shown as if it were a match, even -though they are actually unrelated. - -@findex tex-insert-braces -@kindex C-c @{ (TeX mode) -@findex up-list -@kindex C-c @} (TeX mode) - If you prefer to keep braces balanced at all times, you can use @kbd{C-c @{} -(@code{tex-insert-braces}) to insert a pair of braces. It leaves point -between the two braces so you can insert the text that belongs inside. -Afterward, use the command @kbd{C-c @}} (@code{up-list}) to move forward -past the close brace. - -@findex validate-tex-buffer -@findex tex-terminate-paragraph -@kindex LFD (TeX mode) - There are two commands for checking the matching of braces. @key{LFD} -(@code{tex-terminate-paragraph}) checks the paragraph before point, and -inserts two newlines to start a new paragraph. It prints a message in the -echo area if any mismatch is found. @kbd{M-x validate-tex-buffer} checks -the entire buffer, paragraph by paragraph. When it finds a paragraph that -contains a mismatch, it displays point at the beginning of the paragraph -for a few seconds and pushes a mark at that spot. Scanning continues -until the whole buffer has been checked or until you type another key. -The positions of the last several paragraphs with mismatches can be -found in the mark ring (@pxref{Mark Ring}). - - Note that square brackets and parentheses, not just braces, are -matched in @TeX{} mode. This is wrong if you want to check @TeX{} syntax. -However, parentheses and square brackets are likely to be used in text as -matching delimiters and it is useful for the various motion commands and -automatic match display to work with them. - -@findex tex-close-latex-block -@kindex C-c C-f (LaTeX mode) - In La@TeX{} input, @samp{\begin} and @samp{\end} commands must balance. -After you insert a @samp{\begin}, use @kbd{C-c C-f} -(@code{tex-close-latex-block}) to insert automatically a matching -@samp{\end} (on a new line following the @samp{\begin}). A blank line is -inserted between the two, and point is left there.@refill - -@node TeX Print,,TeX Editing,TeX Mode -@subsubsection @TeX{} Printing Commands - - You can invoke @TeX{} as an inferior of Emacs on either the entire -contents of the buffer or just a region at a time. Running @TeX{} in -this way on just one chapter is a good way to see what your changes -look like without taking the time to format the entire file. - -@table @kbd -@item C-c C-r -Invoke @TeX{} on the current region, plus the buffer's header -(@code{tex-region}). -@item C-c C-b -Invoke @TeX{} on the entire current buffer (@code{tex-buffer}). -@item C-c C-l -Recenter the window showing output from the inferior @TeX{} so that -the last line can be seen (@code{tex-recenter-output-buffer}). -@item C-c C-k -Kill the inferior @TeX{} (@code{tex-kill-job}). -@item C-c C-p -Print the output from the last @kbd{C-c C-r} or @kbd{C-c C-b} command -(@code{tex-print}). -@item C-c C-q -Show the printer queue (@code{tex-show-print-queue}). -@end table - -@findex tex-buffer -@kindex C-c C-b (TeX mode) -@findex tex-print -@kindex C-c C-p (TeX mode) -@findex tex-show-print-queue -@kindex C-c C-q (TeX mode) - You can pass the current buffer through an inferior @TeX{} using -@kbd{C-c C-b} (@code{tex-buffer}). The formatted output appears in a file -in @file{/tmp}; to print it, type @kbd{C-c C-p} (@code{tex-print}). -Afterward use @kbd{C-c C-q} (@code{tex-show-print-queue}) to view the -progress of your output towards being printed. - -@findex tex-kill-job -@kindex C-c C-k (TeX mode) -@findex tex-recenter-output-buffer -@kindex C-c C-l (TeX mode) - The console output from @TeX{}, including any error messages, appears in a -buffer called @samp{*TeX-shell*}. If @TeX{} gets an error, you can switch -to this buffer and feed it input (this works as in Shell mode; -@pxref{Interactive Shell}). Without switching to this buffer, you can scroll -it so that its last line is visible by typing @kbd{C-c C-l}. - - Type @kbd{C-c C-k} (@code{tex-kill-job}) to kill the @TeX{} process if -you see that its output is no longer useful. Using @kbd{C-c C-b} or -@kbd{C-c C-r} also kills any @TeX{} process still running.@refill - -@findex tex-region -@kindex C-c C-r (TeX mode) - You can pass an arbitrary region through an inferior @TeX{} by typing -@kbd{C-c C-r} (@code{tex-region}). This is tricky, however, because -most files of @TeX{} input contain commands at the beginning to set -parameters and define macros. Without them, no later part of the file -will format correctly. To solve this problem, @kbd{C-c C-r} allows you -to designate a part of the file as containing essential commands; it is -included before the specified region as part of the input to @TeX{}. -The designated part of the file is called the @dfn{header}. - -@cindex header (TeX mode) - To indicate the bounds of the header in Plain @TeX{} mode, insert two -special strings in the file: @samp{%**start of header} before the -header, and @samp{%**end of header} after it. Each string must appear -entirely on one line, but there may be other text on the line before or -after. The lines containing the two strings are included in the header. -If @samp{%**start of header} does not appear within the first 100 lines of -the buffer, @kbd{C-c C-r} assumes there is no header. - - In La@TeX{} mode, the header begins with @samp{\documentstyle} and ends -with @*@samp{\begin@{document@}}. These are commands that La@TeX{} requires -you to use, so you don't need to do anything special to identify the -header. - -@vindex TeX-mode-hook -@vindex LaTeX-mode-hook -@vindex plain-TeX-mode-hook - When you enter either kind of @TeX{} mode, Emacs calls with no -arguments the value of the variable @code{text-mode-hook}, if that value -exists and is not @code{nil}. Emacs then calls the variable -@code{TeX-mode-hook} and either @code{plain-TeX-mode-hook} or -@code{LaTeX-mode-hook} under the same conditions. - -@node Outline Mode,, TeX Mode, Text Mode -@subsection Outline Mode -@cindex outlines -@cindex selective display -@cindex invisible lines - - Outline mode is a major mode similar to Text mode but intended for editing -outlines. It allows you to make parts of the text temporarily invisible -so that you can see just the overall structure of the outline. Type -@kbd{M-x outline-mode} to turn on Outline mode in the current buffer. - -@vindex outline-mode-hook - When you enter Outline mode, Emacs calls with no arguments the value -of the variable @code{text-mode-hook}, if that value exists and is not -@code{nil}; then it does the same with the variable -@code{outline-mode-hook}. - - When a line is invisible in outline mode, it does not appear on the -screen. The screen appears exactly as if the invisible line -were deleted, except that an ellipsis (three periods in a row) appears -at the end of the previous visible line (only one ellipsis no matter -how many invisible lines follow). - - All editing commands treat the text of the invisible line as part of the -previous visible line. For example, @kbd{C-n} moves onto the next visible -line. Killing an entire visible line, including its terminating newline, -really kills all the following invisible lines as well; yanking -everything back yanks the invisible lines and they remain invisible. - -@menu -* Format: Outline Format. What the text of an outline looks like. -* Motion: Outline Motion. Special commands for moving through outlines. -* Visibility: Outline Visibility. Commands to control what is visible. -@end menu - -@node Outline Format,Outline Motion,Outline Mode, Outline Mode -@subsubsection Format of Outlines - -@cindex heading lines (Outline mode) -@cindex body lines (Outline mode) - Outline mode assumes that the lines in the buffer are of two types: -@dfn{heading lines} and @dfn{body lines}. A heading line represents a -topic in the outline. Heading lines start with one or more stars; the -number of stars determines the depth of the heading in the outline -structure. Thus, a heading line with one star is a major topic; all the -heading lines with two stars between it and the next one-star heading -are its subtopics; and so on. Any line that is not a heading line is a -body line. Body lines belong to the preceding heading line. Here is an -example: - -@example -* Food - -This is the body, -which says something about the topic of food. - -** Delicious Food - -This is the body of the second-level header. - -** Distasteful Food - -This could have -a body too, with -several lines. - -*** Dormitory Food - -* Shelter - -A second first-level topic with its header line. -@end example - - A heading line together with all following body lines is called -collectively an @dfn{entry}. A heading line together with all following -deeper heading lines and their body lines is called a @dfn{subtree}. - -@vindex outline-regexp - You can customize the criterion for distinguishing heading lines by -setting the variable @code{outline-regexp}. Any line whose beginning -has a match for this regexp is considered a heading line. Matches that -start within a line (not at the beginning) do not count. The length of -the matching text determines the level of the heading; longer matches -make a more deeply nested level. Thus, for example, if a text formatter -has commands @samp{@@chapter}, @samp{@@section} and @samp{@@subsection} -to divide the document into chapters and sections, you can make those -lines count as heading lines by setting @code{outline-regexp} to -@samp{"@@chap\\|@@\\(sub\\)*section"}. Note the trick: the two words -@samp{chapter} and @samp{section} are the same length, but by defining -the regexp to match only @samp{chap} we ensure that the length of the -text matched on a chapter heading is shorter, so that Outline mode will -know that sections are contained in chapters. This works as long as no -other command starts with @samp{@@chap}. - - Outline mode makes a line invisible by changing the newline before it -into an ASCII Control-M (code 015). Most editing commands that work on -lines treat an invisible line as part of the previous line because, -strictly speaking, it @i{is} part of that line, since there is no longer a -newline in between. When you save the file in Outline mode, Control-M -characters are saved as newlines, so the invisible lines become ordinary -lines in the file. Saving does not change the visibility status of a -line inside Emacs. - -@node Outline Motion,Outline Visibility,Outline Format,Outline Mode -@subsubsection Outline Motion Commands - - Some special commands in Outline mode move backward and forward to -heading lines. - -@table @kbd -@item C-c C-n -Move point to the next visible heading line -(@code{outline-next-visible-heading}). -@item C-c C-p -Move point to the previous visible heading line @* -(@code{outline-previous-visible-heading}). -@item C-c C-f -Move point to the next visible heading line at the same level -as the one point is on (@code{outline-forward-same-level}). -@item C-c C-b -Move point to the previous visible heading line at the same level -(@code{outline-backward-same-level}). -@item C-c C-u -Move point up to a lower-level (more inclusive) visible heading line -(@code{outline-up-heading}). -@end table - -@findex outline-next-visible-heading -@findex outline-previous-visible-heading -@kindex C-c C-n (Outline mode) -@kindex C-c C-p (Outline mode) - @kbd{C-c C-n} (@code{next-visible-heading}) moves down to the next -heading line. @kbd{C-c C-p} (@code{previous-visible-heading}) moves -similarly backward. Both accept numeric arguments as repeat counts. The -names emphasize that invisible headings are skipped, but this is not really -a special feature. All editing commands that look for lines ignore the -invisible lines automatically.@refill - -@findex outline-up-heading -@findex outline-forward-same-level -@findex outline-backward-same-level -@kindex C-c C-f (Outline mode) -@kindex C-c C-b (Outline mode) -@kindex C-c C-u (Outline mode) - More advanced motion commands understand the levels of headings. -The commands @kbd{C-c C-f} (@code{outline-forward-same-level}) and -@kbd{C-c C-b} (@code{outline-backward-same-level}) move from one -heading line to another visible heading at the same depth in -the outline. @kbd{C-c C-u} (@code{outline-up-heading}) moves -backward to another heading that is less deeply nested. - -@node Outline Visibility,,Outline Motion,Outline Mode -@subsubsection Outline Visibility Commands - - The other special commands of outline mode are used to make lines visible -or invisible. Their names all start with @code{hide} or @code{show}. -Most of them exist as pairs of opposites. They are not undoable; instead, -you can undo right past them. Making lines visible or invisible is simply -not recorded by the undo mechanism. - -@table @kbd -@item M-x hide-body -Make all body lines in the buffer invisible. -@item M-x show-all -Make all lines in the buffer visible. -@item C-c C-d -Make everything under this heading invisible, not including this -heading itself (@code{hide-subtree}). -@item C-c C-s -Make everything under this heading visible, including body, -subheadings, and their bodies (@code{show-subtree}). -@item M-x hide-leaves -Make the body of this heading line, and of all its subheadings, -invisible. -@item M-x show-branches -Make all subheadings of this heading line, at all levels, visible. -@item C-c C-i -Make immediate subheadings (one level down) of this heading line -visible (@code{show-children}). -@item M-x hide-entry -Make this heading line's body invisible. -@item M-x show-entry -Make this heading line's body visible. -@end table - -@findex hide-entry -@findex show-entry - Two commands that are exact opposites are @kbd{M-x hide-entry} and -@kbd{M-x show-entry}. They are used with point on a heading line, and -apply only to the body lines of that heading. The subtopics and their -bodies are not affected. - -@findex hide-subtree -@findex show-subtree -@kindex C-c C-s (Outline mode) -@kindex C-c C-h (Outline mode) -@cindex subtree (Outline mode) - Two more powerful opposites are @kbd{C-c C-h} (@code{hide-subtree}) and -@kbd{C-c C-s} (@code{show-subtree}). Both should be used when point is -on a heading line, and both apply to all the lines of that heading's -@dfn{subtree}: its body, all its subheadings, both direct and indirect, and -all of their bodies. In other words, the subtree contains everything -following this heading line, up to and not including the next heading of -the same or higher rank.@refill - -@findex hide-leaves -@findex show-branches - Intermediate between a visible subtree and an invisible one is having -all the subheadings visible but none of the body. There are two commands -for doing this, one that hides the bodies and one that -makes the subheadings visible. They are @kbd{M-x hide-leaves} and -@kbd{M-x show-branches}. - -@kindex C-c C-i (Outline mode) -@findex show-children - A little weaker than @code{show-branches} is @kbd{C-c C-i} -(@code{show-children}). It makes just the direct subheadings -visible---those one level down. Deeper subheadings remain -invisible.@refill - -@findex hide-body -@findex show-all - Two commands have a blanket effect on the whole file. @kbd{M-x -hide-body} makes all body lines invisible, so that you see just the -outline structure. @kbd{M-x show-all} makes all lines visible. You can -think of these commands as a pair of opposites even though @kbd{M-x -show-all} applies to more than just body lines. - -@vindex selective-display-ellipses -You can turn off the use of ellipses at the ends of visible lines by -setting @code{selective-display-ellipses} to @code{nil}. The result is -no visible indication of the presence of invisible lines. - -@node Words, Sentences, Text Mode, Text -@section Words -@cindex words -@cindex Meta - - Emacs has commands for moving over or operating on words. By convention, -the keys for them are all @kbd{Meta-} characters. - -@c widecommands -@table @kbd -@item M-f -Move forward over a word (@code{forward-word}). -@item M-b -Move backward over a word (@code{backward-word}). -@item M-d -Kill up to the end of a word (@code{kill-word}). -@item M-@key{DEL} -Kill back to the beginning of a word (@code{backward-kill-word}). -@item M-@@ -Mark the end of the next word (@code{mark-word}). -@item M-t -Transpose two words; drag a word forward -or backward across other words (@code{transpose-words}). -@end table - - Notice how these keys form a series that parallels the -character-based @kbd{C-f}, @kbd{C-b}, @kbd{C-d}, @kbd{C-t} and -@key{DEL}. @kbd{M-@@} is related to @kbd{C-@@}, which is an alias for -@kbd{C-@key{SPC}}.@refill - -@kindex M-f -@kindex M-b -@findex forward-word -@findex backward-word - The commands @kbd{Meta-f} (@code{forward-word}) and @kbd{Meta-b} -(@code{backward-word}) move forward and backward over words. They are -analogous to @kbd{Control-f} and @kbd{Control-b}, which move over single -characters. Like their @kbd{Control-} analogues, @kbd{Meta-f} and -@kbd{Meta-b} move several words if given an argument. @kbd{Meta-f} with a -negative argument moves backward, and @kbd{Meta-b} with a negative argument -moves forward. Forward motion stops after the last letter of the -word, while backward motion stops before the first letter.@refill - -@kindex M-d -@findex kill-word - @kbd{Meta-d} (@code{kill-word}) kills the word after point. To be -precise, it kills everything from point to the place @kbd{Meta-f} would -move to. Thus, if point is in the middle of a word, @kbd{Meta-d} kills -just the part after point. If some punctuation comes between point and the -next word, it is killed along with the word. (To kill only the -next word but not the punctuation before it, simply type @kbd{Meta-f} to get -to the end and kill the word backwards with @kbd{Meta-@key{DEL}}.) -@kbd{Meta-d} takes arguments just like @kbd{Meta-f}. - -@findex backward-kill-word -@kindex M-DEL - @kbd{Meta-@key{DEL}} (@code{backward-kill-word}) kills the word before -point. It kills everything from point back to where @kbd{Meta-b} would -move to. If point is after the space in @w{@samp{FOO, BAR}}, then -@w{@samp{FOO, }} is killed. To kill just @samp{FOO}, type -@kbd{Meta-b Meta-d} instead of @kbd{Meta-@key{DEL}}. - -@cindex transposition -@kindex M-t -@findex transpose-words - @kbd{Meta-t} (@code{transpose-words}) exchanges the word before or -containing point with the following word. The delimiter characters -between the words do not move. For example, transposing @w{@samp{FOO, -BAR}} results in @w{@samp{BAR, FOO}} rather than @samp{@w{BAR FOO,}}. -@xref{Transpose}, for more on transposition and on arguments to -transposition commands. - -@kindex M-@@ -@findex mark-word - To operate on the next @var{n} words with an operation which applies -between point and mark, you can either set the mark at point and then move -over the words, or you can use the command @kbd{Meta-@@} (@code{mark-word}) -which does not move point but sets the mark where @kbd{Meta-f} would move -to. It can be given arguments just like @kbd{Meta-f}. - -@cindex syntax table - The word commands' understanding of syntax is completely controlled by -the syntax table. For example, any character can be declared to be a word -delimiter. @xref{Syntax}. - -@node Sentences, Paragraphs, Words, Text -@section Sentences -@cindex sentences - - The Emacs commands for manipulating sentences and paragraphs are mostly -on @kbd{Meta-} keys, and therefore are like the word-handling commands. - -@table @kbd -@item M-a -Move back to the beginning of the sentence (@code{backward-sentence}). -@item M-e -Move forward to the end of the sentence (@code{forward-sentence}). -@item M-k -Kill forward to the end of the sentence (@code{kill-sentence}). -@item C-x @key{DEL} -Kill back to the beginning of the sentence @*(@code{backward-kill-sentence}). -@end table - -@kindex M-a -@kindex M-e -@findex backward-sentence -@findex forward-sentence - The commands @kbd{Meta-a} and @kbd{Meta-e} (@code{backward-sentence} -and @code{forward-sentence}) move to the beginning and end of the -current sentence, respectively. They resemble @kbd{Control-a} and -@kbd{Control-e}, which move to the beginning and end of a line. Unlike -their counterparts, @kbd{Meta-a} and @kbd{Meta-e} move over successive -sentences if repeated or given numeric arguments. Emacs assumes -the typist's convention is followed, and thus considers a sentence to -end wherever there is a @samp{.}, @samp{?}, or @samp{!} followed by the -end of a line or two spaces, with any number of @samp{)}, @samp{]}, -@samp{'}, or @samp{"} characters allowed in between. A sentence also -begins or ends wherever a paragraph begins or ends.@refill - - Neither @kbd{M-a} nor @kbd{M-e} moves past the newline or spaces beyond -the sentence edge at which it is stopping. - -@kindex M-k -@kindex C-x DEL -@findex kill-sentence -@findex backward-kill-sentence - @kbd{M-a} and @kbd{M-e} have a corresponding kill command, just like -@kbd{C-a} and @kbd{C-e} have @kbd{C-k}. The command is @kbd{M-k} -(@code{kill-sentence}) which kills from point to the end of the -sentence. With minus one as an argument it kills back to the beginning -of the sentence. Larger arguments serve as repeat counts.@refill - - There is a special command, @kbd{C-x @key{DEL}} -(@code{backward-kill-sentence}), for killing back to the beginning of a -sentence, which is useful when you change your mind in the middle of -composing text.@refill - -@vindex sentence-end - The variable @code{sentence-end} controls recognition of the end of a -sentence. It is a regexp that matches the last few characters of a -sentence, together with the whitespace following the sentence. Its -normal value is: - -@example -"[.?!][]\"')]*\\($\\|\t\\| \\)[ \t\n]*" -@end example - -@noindent -This example is explained in the section on regexps. @xref{Regexps}. - -@node Paragraphs, Pages, Sentences, Text -@section Paragraphs -@cindex paragraphs -@kindex M-[ -@kindex M-] -@findex backward-paragraph -@findex forward-paragraph - - The Emacs commands for manipulating paragraphs are also @kbd{Meta-} -keys. - -@table @kbd -@item M-[ -Move back to previous paragraph beginning @*(@code{backward-paragraph}). -@item M-] -Move forward to next paragraph end (@code{forward-paragraph}). -@item M-h -Put point and mark around this or next paragraph (@code{mark-paragraph}). -@end table - - @kbd{Meta-[} moves to the beginning of the current or previous paragraph, -while @kbd{Meta-]} moves to the end of the current or next paragraph. -Blank lines and text formatter command lines separate paragraphs and are -not part of any paragraph. An indented line starts a new paragraph. - - In major modes for programs (as opposed to Text mode), paragraphs begin -and end only at blank lines. As a result, the paragraph commands continue to -be useful even though there are no paragraphs per se. - - When there is a fill prefix, paragraphs are delimited by all lines -which don't start with the fill prefix. @xref{Filling}. - -@kindex M-h -@findex mark-paragraph - To operate on a paragraph, you can use the command -@kbd{Meta-h} (@code{mark-paragraph}) to set the region around it. This -command puts point at the beginning and mark at the end of the paragraph -point was in. If point is between paragraphs (in a run of blank lines or -at a boundary), the paragraph following point is surrounded by point and -mark. If there are blank lines preceding the first line of the paragraph, -one of the blank lines is included in the region. Thus, for example, -@kbd{M-h C-w} kills the paragraph around or after point. - -@vindex paragraph-start -@vindex paragraph-separate - The precise definition of a paragraph boundary is controlled by the -variables @code{paragraph-separate} and @code{paragraph-start}. The value -of @code{paragraph-start} is a regexp that matches any line that -either starts or separates paragraphs. The value of -@code{paragraph-separate} is another regexp that matches only lines -that separate paragraphs without being part of any paragraph. Lines that -start a new paragraph and are contained in it must match both regexps. For -example, normally @code{paragraph-start} is @code{"^[ @t{\}t@t{\}n@t{\}f]"} -and @code{paragraph-separate} is @code{"^[ @t{\}t@t{\}f]*$"}.@refill - - Normally it is desirable for page boundaries to separate paragraphs. -The default values of these variables recognize the usual separator for -pages. - -@node Pages, Filling, Paragraphs, Text -@section Pages - -@cindex pages -@cindex formfeed - Files are often thought of as divided into @dfn{pages} by the -@dfn{formfeed} character (ASCII Control-L, octal code 014). For -example, if a file is printed on a line printer, each ``page'' of the -file starts on a new page of paper. Emacs treats a page-separator -character just like any other character. It can be inserted with -@kbd{C-q C-l} or deleted with @key{DEL}. You are free to -paginate your file or not. However, since pages are often meaningful -divisions of the file, commands are provided to move over them and -operate on them. - -@c WideCommands -@table @kbd -@item C-x [ -Move point to previous page boundary (@code{backward-page}). -@item C-x ] -Move point to next page boundary (@code{forward-page}). -@item C-x C-p -Put point and mark around this page (or another page) (@code{mark-page}). -@item C-x l -Count the lines in this page (@code{count-lines-page}). -@end table - -@kindex C-x [ -@kindex C-x ] -@findex forward-page -@findex backward-page - The @kbd{C-x [} (@code{backward-page}) command moves point to -immediately after the previous page delimiter. If point is already -right after a page delimiter, the command skips that one and stops at -the previous one. A numeric argument serves as a repeat count. The -@kbd{C-x ]} (@code{forward-page}) command moves forward past the next -page delimiter. - -@kindex C-x C-p -@findex mark-page - The @kbd{C-x C-p} command (@code{mark-page}) puts point at the beginning -of the current page and the mark at the end. The page delimiter at the end -is included (the mark follows it). The page delimiter at the front is -excluded (point follows it). You can follow this command by @kbd{C-w} to -kill a page you want to move elsewhere. If you insert the page after a page -delimiter, at a place where @kbd{C-x ]} or @kbd{C-x [} would take you, -the page will be properly delimited before and after once again. - - A numeric argument to @kbd{C-x C-p} is used to specify which page to go -to, relative to the current one. Zero means the current page. One means -the next page, and @minus{}1 means the previous one. - -@kindex C-x l -@findex count-lines-page - The @kbd{C-x l} command (@code{count-lines-page}) can help you decide -where to break a page in two. It prints the total number of lines in -the current page in the echo area, then divides the lines into those -preceding the current line and those following it, for example - -@example -Page has 96 (72+25) lines -@end example - -@noindent - Notice that the sum is off by one; this is correct if point is not at the -beginning of a line. - -@vindex page-delimiter - The variable @code{page-delimiter} should have as its value a regexp that -matches the beginning of a line that separates pages. This defines -where pages begin. The normal value of this variable is @code{"^@t{\}f"}, -which matches a formfeed character at the beginning of a line. - -@node Filling, Case, Pages, Text -@section Filling Text -@cindex filling - - If you use Auto Fill mode, Emacs @dfn{fills} text (breaks it up into -lines that fit in a specified width) as you insert it. When you alter -existing text it is often no longer be properly filled afterwards and -you can use explicit commands for filling. - -@menu -* Auto Fill:: Auto Fill mode breaks long lines automatically. -* Fill Commands:: Commands to refill paragraphs and center lines. -* Fill Prefix:: Filling when every line is indented or in a comment, etc. -@end menu - -@node Auto Fill, Fill Commands, Filling, Filling -@subsection Auto Fill Mode - -@cindex Auto Fill mode - - @dfn{Auto Fill} mode is a minor mode in which lines are broken -automatically when they become too wide. Breaking happens only when -you type a @key{SPC} or @key{RET}. - -@table @kbd -@item M-x auto-fill-mode -Enable or disable Auto Fill mode. -@item @key{SPC} -@itemx @key{RET} -In Auto Fill mode, break lines when appropriate. -@end table - -@findex auto-fill-mode - @kbd{M-x auto-fill-mode} turns Auto Fill mode on if it was off, or off -if it was on. With a positive numeric argument the command always turns -Auto Fill mode on, and with a negative argument it always turns it off. -The presence of the word @samp{Fill} in the mode line, inside the -parentheses, indicates that Auto Fill mode is in effect. Auto Fill mode -is a minor mode; you can turn it on or off for each buffer individually. -@xref{Minor Modes}. - - In Auto Fill mode, lines are broken automatically at spaces when they get -longer than desired. Line breaking and rearrangement takes place -only when you type @key{SPC} or @key{RET}. To insert a space -or newline without permitting line-breaking, type @kbd{C-q @key{SPC}} or -@kbd{C-q @key{LFD}} (recall that a newline is really a linefeed). -@kbd{C-o} inserts a newline without line breaking. - - Auto Fill mode works well with Lisp mode: when it makes a new line in -Lisp mode, it indents that line with @key{TAB}. If a line ending in a -Lisp comment gets too long, the text of the comment is split into two -comment lines. Optionally, new comment delimiters are inserted at the -end of the first line and the beginning of the second, so that each line -is a separate comment. The variable @code{comment-multi-line} controls -the choice (@pxref{Comments}). - - Auto Fill mode does not refill entire paragraphs. It can break lines but -cannot merge lines. Editing in the middle of a paragraph can result in -a paragraph that is not correctly filled. The easiest way to make the -paragraph properly filled again is using an explicit fill commands. - - Many users like Auto Fill mode and want to use it in all text files. -The section on init files explains how you can arrange this -permanently for yourself. @xref{Init File}. - -@node Fill Commands, Fill Prefix, Auto Fill, Filling -@subsection Explicit Fill Commands - -@table @kbd -@item M-q -Fill current paragraph (@code{fill-paragraph}). -@item M-g -Fill each paragraph in the region (@code{fill-region}). -@item C-x f -Set the fill column (@code{set-fill-column}). -@item M-x fill-region-as-paragraph -Fill the region, considering it as one paragraph. -@item M-s -Center a line. -@end table - -@kindex M-q -@findex fill-paragraph - To refill a paragraph, use the command @kbd{Meta-q} -(@code{fill-paragraph}). It causes the paragraph containing point, or -the one after point if point is between paragraphs, to be refilled. All -line breaks are removed, and new ones are inserted where necessary. -@kbd{M-q} can be undone with @kbd{C-_}. @xref{Undo}.@refill - -@kindex M-g -@findex fill-region - To refill many paragraphs, use @kbd{M-g} (@code{fill-region}), which -divides the region into paragraphs and fills each of them. - -@findex fill-region-as-paragraph - @kbd{Meta-q} and @kbd{Meta-g} use the same criteria as @kbd{Meta-h} for -finding paragraph boundaries (@pxref{Paragraphs}). For more control, you -can use @kbd{M-x fill-region-as-paragraph}, which refills everything -between point and mark. This command recognizes only blank lines as -paragraph separators.@refill - -@cindex justification - A numeric argument to @kbd{M-g} or @kbd{M-q} causes it to -@dfn{justify} the text as well as filling it. Extra spaces are inserted -to make the right margin line up exactly at the fill column. To remove -the extra spaces, use @kbd{M-q} or @kbd{M-g} with no argument.@refill - -@vindex auto-fill-inhibit-regexp -The variable @code{auto-fill-inhibit-regexp} takes as a value a regexp to -match lines that should not be auto-filled. - -@kindex M-s -@cindex centering -@findex center-line - The command @kbd{Meta-s} (@code{center-line}) centers the current line -within the current fill column. With an argument, it centers several lines -individually and moves past them. - -@vindex fill-column - The maximum line width for filling is in the variable -@code{fill-column}. Altering the value of @code{fill-column} makes it -local to the current buffer; until then, the default value---initially -70---is in effect. @xref{Locals}. - -@kindex C-x f -@findex set-fill-column - The easiest way to set @code{fill-column} is to use the command @kbd{C-x -f} (@code{set-fill-column}). With no argument, it sets @code{fill-column} -to the current horizontal position of point. With a numeric argument, it -uses that number as the new fill column. - -@node Fill Prefix,, Fill Commands, Filling -@subsection The Fill Prefix - -@cindex fill prefix - To fill a paragraph in which each line starts with a special marker -(which might be a few spaces, giving an indented paragraph), use the -@dfn{fill prefix} feature. The fill prefix is a string which is not -included in filling. Emacs expects every line to start with a fill -prefix. - -@table @kbd -@item C-x . -Set the fill prefix (@code{set-fill-prefix}). -@item M-q -Fill a paragraph using current fill prefix (@code{fill-paragraph}). -@item M-x fill-individual-paragraphs -Fill the region, considering each change of indentation as starting a -new paragraph. -@end table - -@kindex C-x . -@findex set-fill-prefix - To specify a fill prefix, move to a line that starts with the desired -prefix, put point at the end of the prefix, and give the command -@w{@kbd{C-x .}}@: (@code{set-fill-prefix}). That's a period after the -@kbd{C-x}. To turn off the fill prefix, specify an empty prefix: type -@w{@kbd{C-x .}}@: with point at the beginning of a line.@refill - - When a fill prefix is in effect, the fill commands remove the fill -prefix from each line before filling and insert it on each line after -filling. Auto Fill mode also inserts the fill prefix inserted on new -lines it creates. Lines that do not start with the fill prefix are -considered to start paragraphs, both in @kbd{M-q} and the paragraph -commands; this is just right if you are using paragraphs with hanging -indentation (every line indented except the first one). Lines which are -blank or indented once the prefix is removed also separate or start -paragraphs; this is what you want if you are writing multi-paragraph -comments with a comment delimiter on each line. - -@vindex fill-prefix - The fill prefix is stored in the variable @code{fill-prefix}. Its value -is a string, or @code{nil} when there is no fill prefix. This is a -per-buffer variable; altering the variable affects only the current buffer, -but there is a default value which you can change as well. @xref{Locals}. - -@findex fill-individual-paragraphs - Another way to use fill prefixes is through @kbd{M-x -fill-individual-paragraphs}. This function divides the region into groups -of consecutive lines with the same amount and kind of indentation and fills -each group as a paragraph, using its indentation as a fill prefix. - -@node Case,, Filling, Text -@section Case Conversion Commands -@cindex case conversion - - Emacs has commands for converting either a single word or any arbitrary -range of text to upper case or to lower case. - -@c WideCommands -@table @kbd -@item M-l -Convert following word to lower case (@code{downcase-word}). -@item M-u -Convert following word to upper case (@code{upcase-word}). -@item M-c -Capitalize the following word (@code{capitalize-word}). -@item C-x C-l -Convert region to lower case (@code{downcase-region}). -@item C-x C-u -Convert region to upper case (@code{upcase-region}). -@end table - -@kindex M-l -@kindex M-u -@kindex M-c -@cindex words -@findex downcase-word -@findex upcase-word -@findex capitalize-word - The word conversion commands are used most frequently. @kbd{Meta-l} -(@code{downcase-word}) converts the word after point to lower case, -moving past it. Thus, repeating @kbd{Meta-l} converts successive words. -@kbd{Meta-u} (@code{upcase-word}) converts to all capitals instead, -while @kbd{Meta-c} (@code{capitalize-word}) puts the first letter of the -word into upper case and the rest into lower case. The word conversion -commands convert several words at once if given an argument. They are -especially convenient for converting a large amount of text from all -upper case to mixed case: you can move through the text using -@kbd{M-l}, @kbd{M-u}, or @kbd{M-c} on each word as appropriate, -occasionally using @kbd{M-f} instead to skip a word. - - When given a negative argument, the word case conversion commands apply -to the appropriate number of words before point, but do not move point. -This is convenient when you have just typed a word in the wrong case: you -can give the case conversion command and continue typing. - - If a word case conversion command is given in the middle of a word, it -applies only to the part of the word which follows point. This is just -like what @kbd{Meta-d} (@code{kill-word}) does. With a negative argument, -case conversion applies only to the part of the word before point. - -@kindex C-x C-l -@kindex C-x C-u -@cindex region -@findex downcase-region -@findex upcase-region - The other case conversion commands are @kbd{C-x C-u} -(@code{upcase-region}) and @kbd{C-x C-l} (@code{downcase-region}), which -convert everything between point and mark to the specified case. Point and -mark do not move.@refill diff --git a/man/xemacs/trouble.texi b/man/xemacs/trouble.texi deleted file mode 100644 index 8f4a532..0000000 --- a/man/xemacs/trouble.texi +++ /dev/null @@ -1,406 +0,0 @@ - -@iftex -@chapter Correcting Mistakes (Yours or Emacs's) - - If you type an Emacs command you did not intend, the results are often -mysterious. This chapter discusses how you can undo your mistake or -recover from a mysterious situation. Emacs bugs and system crashes are -also considered. -@end iftex - -@node Quitting, Lossage, Customization, Top -@section Quitting and Aborting -@cindex quitting - -@table @kbd -@item C-g -Quit. Cancel running or partially typed command. -@item C-] -Abort innermost recursive editing level and cancel the command which -invoked it (@code{abort-recursive-edit}). -@item M-x top-level -Abort all recursive editing levels that are currently executing. -@item C-x u -Cancel an already-executed command, usually (@code{undo}). -@end table - - There are two ways of cancelling commands which are not finished -executing: @dfn{quitting} with @kbd{C-g}, and @dfn{aborting} with @kbd{C-]} -or @kbd{M-x top-level}. Quitting is cancelling a partially typed command -or one which is already running. Aborting is getting out of a recursive -editing level and cancelling the command that invoked the recursive edit. - -@cindex quitting -@kindex C-g - Quitting with @kbd{C-g} is used for getting rid of a partially typed -command or a numeric argument that you don't want. It also stops a -running command in the middle in a relatively safe way, so you can use -it if you accidentally start executing a command that takes a long -time. In particular, it is safe to quit out of killing; either your -text will @var{all} still be there, or it will @var{all} be in the kill -ring (or maybe both). Quitting an incremental search does special -things documented under searching; in general, it may take two -successive @kbd{C-g} characters to get out of a search. @kbd{C-g} works -by setting the variable @code{quit-flag} to @code{t} the instant -@kbd{C-g} is typed; Emacs Lisp checks this variable frequently and quits -if it is non-@code{nil}. @kbd{C-g} is only actually executed as a -command if it is typed while Emacs is waiting for input. - -If you quit twice in a row before the first @kbd{C-g} is recognized, you -activate the ``emergency escape'' feature and return to the shell. -@xref{Emergency Escape}. - -@cindex recursive editing level -@cindex editing level, recursive -@cindex aborting -@findex abort-recursive-edit -@kindex C-] - You can use @kbd{C-]} (@code{abort-recursive-edit}) to get out -of a recursive editing level and cancel the command which invoked it. -Quitting with @kbd{C-g} does not do this, and could not do this because it -is used to cancel a partially typed command @i{within} the recursive -editing level. Both operations are useful. For example, if you are in the -Emacs debugger (@pxref{Lisp Debug}) and have typed @kbd{C-u 8} to enter a -numeric argument, you can cancel that argument with @kbd{C-g} and remain in -the debugger. - -@findex top-level - The command @kbd{M-x top-level} is equivalent to ``enough'' @kbd{C-]} -commands to get you out of all the levels of recursive edits that you are -in. @kbd{C-]} only gets you out one level at a time, but @kbd{M-x top-level} -goes out all levels at once. Both @kbd{C-]} and @kbd{M-x top-level} are -like all other commands and unlike @kbd{C-g} in that they are effective -only when Emacs is ready for a command. @kbd{C-]} is an ordinary key and -has its meaning only because of its binding in the keymap. -@xref{Recursive Edit}. - - @kbd{C-x u} (@code{undo}) is not strictly speaking a way of cancelling a -command, but you can think of it as cancelling a command already finished -executing. @xref{Undo}. - -@node Lossage, Bugs, Quitting, Top -@section Dealing With Emacs Trouble - - This section describes various conditions in which Emacs fails to work, -and how to recognize them and correct them. - -@menu -* Stuck Recursive:: `[...]' in mode line around the parentheses. -* Screen Garbled:: Garbage on the screen. -* Text Garbled:: Garbage in the text. -* Unasked-for Search:: Spontaneous entry to incremental search. -* Emergency Escape:: Emergency escape--- - What to do if Emacs stops responding. -* Total Frustration:: When you are at your wits' end. -@end menu - -@node Stuck Recursive, Screen Garbled, Lossage, Lossage -@subsection Recursive Editing Levels - - Recursive editing levels are important and useful features of Emacs, but -they can seem like malfunctions to the user who does not understand them. - - If the mode line has square brackets @samp{[@dots{}]} around the parentheses -that contain the names of the major and minor modes, you have entered a -recursive editing level. If you did not do this on purpose, or if you -don't understand what that means, you should just get out of the recursive -editing level. To do so, type @kbd{M-x top-level}. This is called getting -back to top level. @xref{Recursive Edit}. - -@node Screen Garbled, Text Garbled, Stuck Recursive, Lossage -@subsection Garbage on the Screen - - If the data on the screen looks wrong, the first thing to do is see -whether the text is actually wrong. Type @kbd{C-l}, to redisplay the -entire screen. If the text appears correct after this, the problem was -entirely in the previous screen update. - - Display updating problems often result from an incorrect termcap entry -for the terminal you are using. The file @file{etc/TERMS} in the Emacs -distribution gives the fixes for known problems of this sort. -@file{INSTALL} contains general advice for these problems in one of its -sections. Very likely there is simply insufficient padding for certain -display operations. To investigate the possibility that you have this -sort of problem, try Emacs on another terminal made by a different -manufacturer. If problems happen frequently on one kind of terminal but -not another kind, the real problem is likely to be a bad termcap entry, -though it could also be due to a bug in Emacs that appears for terminals -that have or lack specific features. - -@node Text Garbled, Unasked-for Search, Screen Garbled, Lossage -@subsection Garbage in the Text - - If @kbd{C-l} shows that the text is wrong, try undoing the changes to it -using @kbd{C-x u} until it gets back to a state you consider correct. Also -try @kbd{C-h l} to find out what command you typed to produce the observed -results. - - If a large portion of text appears to be missing at the beginning or -end of the buffer, check for the word @samp{Narrow} in the mode line. -If it appears, the text is still present, but marked off-limits. -To make it visible again, type @kbd{C-x n w}. @xref{Narrowing}. - -@node Unasked-for Search, Emergency Escape, Text Garbled, Lossage -@subsection Spontaneous Entry to Incremental Search - - If Emacs spontaneously displays @samp{I-search:} at the bottom of the -screen, it means that the terminal is sending @kbd{C-s} and @kbd{C-q} -according to the poorly designed xon/xoff ``flow control'' protocol. You -should try to prevent this by putting the terminal in a mode where it will -not use flow control, or by giving it enough padding that it will never send a -@kbd{C-s}. If that cannot be done, you must tell Emacs to expect flow -control to be used, until you can get a properly designed terminal. - - Information on how to do these things can be found in the file -@file{INSTALL} in the Emacs distribution. - -@node Emergency Escape, Total Frustration, Unasked-for Search, Lossage -@subsection Emergency Escape - - Because at times there have been bugs causing Emacs to loop without -checking @code{quit-flag}, a special feature causes Emacs to be suspended -immediately if you type a second @kbd{C-g} while the flag is already set, -so you can always get out of XEmacs. Normally Emacs recognizes and -clears @code{quit-flag} (and quits!) quickly enough to prevent this from -happening. - - When you resume Emacs after a suspension caused by multiple @kbd{C-g}, it -asks two questions before going back to what it had been doing: - -@example -Auto-save? (y or n) -Abort (and dump core)? (y or n) -@end example - -@noindent -Answer each one with @kbd{y} or @kbd{n} followed by @key{RET}. - - Saying @kbd{y} to @samp{Auto-save?} causes immediate auto-saving of all -modified buffers in which auto-saving is enabled. - - Saying @kbd{y} to @samp{Abort (and dump core)?} causes an illegal -instruction to be executed, dumping core. This is to enable a wizard to -figure out why Emacs was failing to quit in the first place. Execution -does not continue after a core dump. If you answer @kbd{n}, execution -does continue. With luck, Emacs will ultimately check -@code{quit-flag} and quit normally. If not, and you type another -@kbd{C-g}, it is suspended again. - - If Emacs is not really hung, but is just being slow, you may invoke -the double @kbd{C-g} feature without really meaning to. In that case, -simply resume and answer @kbd{n} to both questions, and you will arrive -at your former state. Presumably the quit you requested will happen -soon. - - The double-@kbd{C-g} feature may be turned off when Emacs is running under -a window system, since the window system always enables you to kill Emacs -or to create another window and run another program. - -@node Total Frustration,, Emergency Escape, Lossage -@subsection Help for Total Frustration -@cindex Eliza -@cindex doctor - - If using Emacs (or something else) becomes terribly frustrating and none -of the techniques described above solve the problem, Emacs can still help -you. - - First, if the Emacs you are using is not responding to commands, type -@kbd{C-g C-g} to get out of it and then start a new one. - -@findex doctor - Second, type @kbd{M-x doctor @key{RET}}. - - The doctor will make you feel better. Each time you say something to -the doctor, you must end it by typing @key{RET} @key{RET}. This lets the -doctor know you are finished. - -@node Bugs,, Lossage, Top -@section Reporting Bugs - -@cindex bugs - Sometimes you will encounter a bug in Emacs. Although we cannot promise -we can or will fix the bug, and we might not even agree that it is a bug, -we want to hear about bugs you encounter in case we do want to fix them. - - To make it possible for us to fix a bug, you must report it. In order -to do so effectively, you must know when and how to do it. - -@subsection When Is There a Bug - - If Emacs executes an illegal instruction, or dies with an operating -system error message that indicates a problem in the program (as opposed to -something like ``disk full''), then it is certainly a bug. - - If Emacs updates the display in a way that does not correspond to what is -in the buffer, then it is certainly a bug. If a command seems to do the -wrong thing but the problem corrects itself if you type @kbd{C-l}, it is a -case of incorrect display updating. - - Taking forever to complete a command can be a bug, but you must make -certain that it was really Emacs's fault. Some commands simply take a long -time. Type @kbd{C-g} and then @kbd{C-h l} to see whether the input Emacs -received was what you intended to type; if the input was such that you -@var{know} it should have been processed quickly, report a bug. If you -don't know whether the command should take a long time, find out by looking -in the manual or by asking for assistance. - - If a command you are familiar with causes an Emacs error message in a -case where its usual definition ought to be reasonable, it is probably a -bug. - - If a command does the wrong thing, that is a bug. But be sure you know -for certain what it ought to have done. If you aren't familiar with the -command, or don't know for certain how the command is supposed to work, -then it might actually be working right. Rather than jumping to -conclusions, show the problem to someone who knows for certain. - - Finally, a command's intended definition may not be best for editing -with. This is a very important sort of problem, but it is also a matter of -judgment. Also, it is easy to come to such a conclusion out of ignorance -of some of the existing features. It is probably best not to complain -about such a problem until you have checked the documentation in the usual -ways, feel confident that you understand it, and know for certain that what -you want is not available. If you are not sure what the command is -supposed to do after a careful reading of the manual, check the index and -glossary for any terms that may be unclear. If you still do not -understand, this indicates a bug in the manual. The manual's job is to -make everything clear. It is just as important to report documentation -bugs as program bugs. - - If the online documentation string of a function or variable disagrees -with the manual, one of them must be wrong, so report the bug. - -@subsection How to Report a Bug - -@findex emacs-version - When you decide that there is a bug, it is important to report it and to -report it in a way which is useful. What is most useful is an exact -description of what commands you type, starting with the shell command to -run Emacs, until the problem happens. Always include the version number -of Emacs that you are using; type @kbd{M-x emacs-version} to print this. - - The most important principle in reporting a bug is to report @var{facts}, -not hypotheses or categorizations. It is always easier to report the facts, -but people seem to prefer to strain to posit explanations and report -them instead. If the explanations are based on guesses about how Emacs is -implemented, they will be useless; we will have to try to figure out what -the facts must have been to lead to such speculations. Sometimes this is -impossible. But in any case, it is unnecessary work for us. - - For example, suppose that you type @kbd{C-x C-f /glorp/baz.ugh -@key{RET}}, visiting a file which (you know) happens to be rather large, -and Emacs prints out @samp{I feel pretty today}. The best way to report -the bug is with a sentence like the preceding one, because it gives all the -facts and nothing but the facts. - - Do not assume that the problem is due to the size of the file and say, -``When I visit a large file, Emacs prints out @samp{I feel pretty today}.'' -This is what we mean by ``guessing explanations''. The problem is just as -likely to be due to the fact that there is a @samp{z} in the file name. If -this is so, then when we got your report, we would try out the problem with -some ``large file'', probably with no @samp{z} in its name, and not find -anything wrong. There is no way in the world that we could guess that we -should try visiting a file with a @samp{z} in its name. - - Alternatively, the problem might be due to the fact that the file starts -with exactly 25 spaces. For this reason, you should make sure that you -inform us of the exact contents of any file that is needed to reproduce the -bug. What if the problem only occurs when you have typed the @kbd{C-x a l} -command previously? This is why we ask you to give the exact sequence of -characters you typed since starting to use Emacs. - - You should not even say ``visit a file'' instead of @kbd{C-x C-f} unless -you @i{know} that it makes no difference which visiting command is used. -Similarly, rather than saying ``if I have three characters on the line,'' -say ``after I type @kbd{@key{RET} A B C @key{RET} C-p},'' if that is -the way you entered the text.@refill - - If you are not in Fundamental mode when the problem occurs, you should -say what mode you are in. - - If the manifestation of the bug is an Emacs error message, it is -important to report not just the text of the error message but a backtrace -showing how the Lisp program in Emacs arrived at the error. To make the -backtrace, you must execute the Lisp expression -@code{(setq @w{debug-on-error t})} before the error happens (that is to -say, you must execute that expression and then make the bug happen). This -causes the Lisp debugger to run (@pxref{Lisp Debug}). The debugger's -backtrace can be copied as text into the bug report. This use of the -debugger is possible only if you know how to make the bug happen again. Do -note the error message the first time the bug happens, so if you can't make -it happen again, you can report at least that. - - Check whether any programs you have loaded into the Lisp world, including -your @file{.emacs} file, set any variables that may affect the functioning -of Emacs. Also, see whether the problem happens in a freshly started Emacs -without loading your @file{.emacs} file (start Emacs with the @code{-q} switch -to prevent loading the init file). If the problem does @var{not} occur -then, it is essential that we know the contents of any programs that you -must load into the Lisp world in order to cause the problem to occur. - - If the problem does depend on an init file or other Lisp programs that -are not part of the standard Emacs system, then you should make sure it is -not a bug in those programs by complaining to their maintainers first. -After they verify that they are using Emacs in a way that is supposed to -work, they should report the bug. - - If you can tell us a way to cause the problem without visiting any files, -please do so. This makes it much easier to debug. If you do need files, -make sure you arrange for us to see their exact contents. For example, it -can often matter whether there are spaces at the ends of lines, or a -newline after the last line in the buffer (nothing ought to care whether -the last line is terminated, but tell that to the bugs). - -@findex open-dribble-file -@cindex dribble file - The easy way to record the input to Emacs precisely is to write a -dribble file; execute the Lisp expression: - -@example -(open-dribble-file "~/dribble") -@end example - -@noindent -using @kbd{Meta-@key{ESC}} or from the @samp{*scratch*} buffer just after starting -Emacs. From then on, all Emacs input will be written in the specified -dribble file until the Emacs process is killed. - -@findex open-termscript -@cindex termscript file - For possible display bugs, it is important to report the terminal type -(the value of environment variable @code{TERM}), the complete termcap entry -for the terminal from @file{/etc/termcap} (since that file is not identical -on all machines), and the output that Emacs actually sent to the terminal. -The way to collect this output is to execute the Lisp expression: - -@example -(open-termscript "~/termscript") -@end example - -@noindent -using @kbd{Meta-@key{ESC}} or from the @samp{*scratch*} buffer just -after starting Emacs. From then on, all output from Emacs to the terminal -will be written in the specified termscript file as well, until the Emacs -process is killed. If the problem happens when Emacs starts up, put this -expression into your @file{.emacs} file so that the termscript file will -be open when Emacs displays the screen for the first time. Be warned: -it is often difficult, and sometimes impossible, to fix a terminal-dependent -bug without access to a terminal of the type that stimulates the bug.@refill - -The newsgroup @samp{comp.emacs.xemacs} may be used for bug reports, -other discussions and requests for assistance. - -If you don't have access to this newgroup, you can subscribe to the -mailing list version: the newsgroup is bidirectionally gatewayed into -the mailing list @samp{xemacs@@xemacs.org}. - -To be added or removed from this mailing list, send mail to -@samp{xemacs-request@@xemacs.org}. Do not send requests for addition -to the mailing list itself. - -The mailing lists and newsgroups are archived on our anonymous FTP server, -@samp{ftp.xemacs.org}, and at various other archive sites around the net. You -should also check the @samp{FAQ} in @samp{/pub/xemacs} on our anonymous -FTP server. It provides some introductory information and help for initial -configuration problems. diff --git a/man/xemacs/windows.texi b/man/xemacs/windows.texi deleted file mode 100644 index 17e903e..0000000 --- a/man/xemacs/windows.texi +++ /dev/null @@ -1,287 +0,0 @@ - -@node Windows, Mule, Buffers, Top -@chapter Multiple Windows -@cindex windows - - Emacs can split the frame into two or many windows, which can display -parts of different buffers or different parts of one buffer. If you are -running XEmacs under X, that means you can have the X window that contains -the Emacs frame have multiple subwindows. - -@menu -* Basic Window:: Introduction to Emacs windows. -* Split Window:: New windows are made by splitting existing windows. -* Other Window:: Moving to another window or doing something to it. -* Pop Up Window:: Finding a file or buffer in another window. -* Change Window:: Deleting windows and changing their sizes. -@end menu - -@node Basic Window, Split Window, Windows, Windows -@section Concepts of Emacs Windows - - When Emacs displays multiple windows, each window has one Emacs -buffer designated for display. The same buffer may appear in more -than one window; if it does, any changes in its text are displayed in all -the windows that display it. Windows showing the same buffer can -show different parts of it, because each window has its own value of point. - -@cindex selected window - At any time, one window is the @dfn{selected window}; the buffer - displayed by that window is the current buffer. The cursor -shows the location of point in that window. Each other window has a -location of point as well, but since the terminal has only one cursor, it -cannot show the location of point in the other windows. - - Commands to move point affect the value of point for the selected Emacs -window only. They do not change the value of point in any other Emacs -window, including those showing the same buffer. The same is true for commands -such as @kbd{C-x b} to change the selected buffer in the selected window; -they do not affect other windows at all. However, there are other commands -such as @kbd{C-x 4 b} that select a different window and switch buffers in -it. Also, all commands that display information in a window, including -(for example) @kbd{C-h f} (@code{describe-function}) and @kbd{C-x C-b} -(@code{list-buffers}), work by switching buffers in a non-selected window -without affecting the selected window. - - Each window has its own mode line, which displays the buffer name, -modification status, and major and minor modes of the buffer that is -displayed in the window. @xref{Mode Line}, for details on the mode -line. - -@node Split Window, Other Window, Basic Window, Windows -@section Splitting Windows - -@table @kbd -@item C-x 2 -Split the selected window into two windows, one above the other -(@code{split-window-vertically}). -@item C-x 3 -Split the selected window into two windows positioned side by side -(@code{split-window-horizontally}). -@item C-x 6 -Save the current window configuration in register @var{reg} (a letter). -@item C-x 7 -Restore (make current) the window configuration in register -@var{reg} (a letter). Use with a register previously set with @kbd{C-x 6}. -@end table - -@kindex C-x 2 -@findex split-window-vertically - The command @kbd{C-x 2} (@code{split-window-vertically}) breaks the -selected window into two windows, one above the other. Both windows -start out displaying the same buffer, with the same value of point. By -default each of the two windows gets half the height of the window that -was split. A numeric argument specifies how many lines to give to the -top window. - -@kindex C-x 3 -@findex split-window-horizontally - @kbd{C-x 3} (@code{split-window-horizontally}) breaks the selected -window into two side-by-side windows. A numeric argument specifies how -many columns to give the one on the left. A line of vertical bars -separates the two windows. Windows that are not the full width of the -frame have truncated mode lines which do not always appear in inverse -video, because Emacs display routines cannot display a region of inverse -video that is only part of a line on the screen. - -@vindex truncate-partial-width-windows - When a window is less than the full width, many text lines are too -long to fit. Continuing all those lines might be confusing. Set the -variable @code{truncate-partial-width-windows} to non-@code{nil} to -force truncation in all windows less than the full width of the frame, -independent of the buffer and its value for @code{truncate-lines}. -@xref{Continuation Lines}.@refill - - Horizontal scrolling is often used in side-by-side windows. -@xref{Display}. - -@findex jump-to-register -@findex window-configuration-to-register -You can resize a window and store that configuration in a register by -supplying a @var{register} argument to @code{window-configuration-to-register} -(@kbd{C-x 6}). To return to the window configuration established with -@code{window-configuration-to-register}, use @code{jump-to-register} -(@kbd{C-x j}). - -@node Other Window, Pop Up Window, Split Window, Windows -@section Using Other Windows - -@table @kbd -@item C-x o -Select another window (@code{other-window}). That is the letter `o', not zero. -@item M-C-v -Scroll the next window (@code{scroll-other-window}). -@item M-x compare-windows -Find the next place where the text in the selected window does not match -the text in the next window. -@item M-x other-window-any-frame @var{n} -Select the @var{n}th different window on any frame. -@end table - -@kindex C-x o -@findex other-window - To select a different window, use @kbd{C-x o} (@code{other-window}). -That is an `o', for `other', not a zero. When there are more than -two windows, the command moves through all the windows in a cyclic -order, generally top to bottom and left to right. From the rightmost -and bottommost window, it goes back to the one at the upper left corner. -A numeric argument, @var{n}, moves several steps in the cyclic order of -windows. A negative numeric argument moves around the cycle in the -opposite order. If the optional second argument @var{all-frames} is -non-@code{nil}, the function cycles through all frames. When the -minibuffer is active, the minibuffer is the last window in the cycle; -you can switch from the minibuffer window to one of the other windows, -and later switch back and finish supplying the minibuffer argument that -is requested. @xref{Minibuffer Edit}. - -@findex other-window-any-frame - The command @kbd{M-x other-window-any-frame} also selects the window -@var{n} steps away in the cyclic order. However, unlike @code{other-window}, -this command selects a window on the next or previous frame instead of -wrapping around to the top or bottom of the current frame, when there -are no more windows. - -@kindex C-M-v -@findex scroll-other-window - The usual scrolling commands (@pxref{Display}) apply to the selected -window only. @kbd{M-C-v} (@code{scroll-other-window}) scrolls the -window that @kbd{C-x o} would select. Like @kbd{C-v}, it takes positive -and negative arguments. - -@findex compare-windows - The command @kbd{M-x compare-windows} compares the text in the current -window with the text in the next window. Comparison starts at point in each -window. Point moves forward in each window, a character at a time, -until the next set of characters in the two windows are different. Then the -command is finished. - -A prefix argument @var{ignore-whitespace} means ignore changes in -whitespace. The variable @code{compare-windows-whitespace} controls how -whitespace is skipped. - -If @code{compare-ignore-case} is non-@code{nil}, changes in case are -also ignored. - -@node Pop Up Window, Change Window, Other Window, Windows -@section Displaying in Another Window - -@kindex C-x 4 - @kbd{C-x 4} is a prefix key for commands that select another window -(splitting the window if there is only one) and select a buffer in that -window. Different @kbd{C-x 4} commands have different ways of finding the -buffer to select. - -@findex switch-to-buffer-other-window -@findex find-file-other-window -@findex find-tag-other-window -@findex dired-other-window -@findex mail-other-window -@table @kbd -@item C-x 4 b @var{bufname} @key{RET} -Select buffer @var{bufname} in another window. This runs -@code{switch-to-buffer-other-window}. -@item C-x 4 f @var{filename} @key{RET} -Visit file @var{filename} and select its buffer in another window. This -runs @code{find-file-other-window}. @xref{Visiting}. -@item C-x 4 d @var{directory} @key{RET} -Select a Dired buffer for directory @var{directory} in another window. -This runs @code{dired-other-window}. @xref{Dired}. -@item C-x 4 m -Start composing a mail message in another window. This runs -@code{mail-other-window}, and its same-window version is @kbd{C-x m} -(@pxref{Sending Mail}). -@item C-x 4 . -Find a tag in the current tag table in another window. This runs -@code{find-tag-other-window}, the multiple-window variant of @kbd{M-.} -(@pxref{Tags}). -@end table - -@vindex display-buffer-function -If the variable @code{display-buffer-function} is non-@code{nil}, its value is -the function to call to handle @code{display-buffer}. It receives two -arguments, the buffer and a flag that if non-@code{nil} means that the -currently selected window is not acceptable. Commands such as -@code{switch-to-buffer-other-window} and @code{find-file-other-window} -work using this function. - -@node Change Window,, Pop Up Window, Windows -@section Deleting and Rearranging Windows - -@table @kbd -@item C-x 0 -Get rid of the selected window (@code{delete-window}). That is a zero. -If there is more than one Emacs frame, deleting the sole remaining -window on that frame deletes the frame as well. If the current frame -is the only frame, it is not deleted. -@item C-x 1 -Get rid of all windows except the selected one -(@code{delete-other-windows}). -@item C-x ^ -Make the selected window taller, at the expense of the other(s) -@*(@code{enlarge-window}). -@item C-x @} -Make the selected window wider (@code{enlarge-window-horizontally}). -@end table - -@kindex C-x 0 -@findex delete-window - To delete a window, type @kbd{C-x 0} (@code{delete-window}). (That is a -zero.) The space occupied by the deleted window is distributed among the -other active windows (but not the minibuffer window, even if that is active -at the time). Once a window is deleted, its attributes are forgotten; -there is no automatic way to make another window of the same shape or -showing the same buffer. The buffer continues to exist, and you can -select it in any window with @kbd{C-x b}. - -@kindex C-x 1 -@findex delete-other-windows - @kbd{C-x 1} (@code{delete-other-windows}) is more powerful than @kbd{C-x 0}; -it deletes all the windows except the selected one (and the minibuffer). -The selected window expands to use the whole frame except for the echo -area. - -@kindex C-x ^ -@findex enlarge-window -@kindex C-x @} -@findex enlarge-window-horizontally -@vindex window-min-height -@vindex window-min-width - To readjust the division of space among existing windows, use @kbd{C-x -^} (@code{enlarge-window}). It makes the currently selected window -longer by one line or as many lines as a numeric argument specifies. -With a negative argument, it makes the selected window smaller. -@kbd{C-x @}} (@code{enlarge-window-horizontally}) makes the selected -window wider by the specified number of columns. The extra screen space -given to a window comes from one of its neighbors, if that is possible; -otherwise, all the competing windows are shrunk in the same proportion. -If this makes some windows too small, those windows are deleted and their -space is divided up. Minimum window size is specified by the variables -@code{window-min-height} and @code{window-min-width}. - -You can also resize windows within a frame by clicking the left mouse -button on a modeline, and dragging. - -Clicking the right button on a mode line pops up a menu of common window -manager operations. This menu contains the following options: - -@cindex Windows menu -@cindex Pull-down Menus -@cindex menus -@table @b -@item Delete Window -Remove the window above this modeline from the frame. - -@item Delete Other Windows -Delete all windows on the frame except for the one above this modeline. - -@item Split Window -Split the window above the mode line in half, creating another window. - -@item Split Window Horizontally -Split the window above the mode line in half horizontally, so that there -will be two windows side-by-side. - -@item Balance Windows -Readjust the sizes of all windows on the frame until all windows have -roughly the same number of lines. -@end table diff --git a/man/xemacs/xemacs.texi b/man/xemacs/xemacs.texi deleted file mode 100644 index 82ccfb2..0000000 --- a/man/xemacs/xemacs.texi +++ /dev/null @@ -1,1121 +0,0 @@ - -\input ../texinfo @c -*-texinfo-*- -@setfilename ../../info/xemacs.info -@comment node-name, next, previous, up - - -@ifinfo -This file documents the XEmacs editor. - -Copyright (C) 1985, 1986, 1988 Richard M. Stallman. -Copyright @copyright{} 1991, 1992, 1993, 1994 Lucid, Inc. -Copyright @copyright{} 1993, 1994 Sun Microsystems, Inc. -Copyright @copyright{} 1995 Amdahl Corporation. - -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 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 ``The GNU Manifesto'', ``Distribution'' 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 the sections entitled ``The GNU Manifesto'', -``Distribution'' and ``GNU General Public License'' may be included in a -translation approved by the author instead of in the original English. -@end ifinfo -@c -@setchapternewpage odd -@settitle XEmacs User's Manual -@c -@titlepage -@sp 6 -@center @titlefont{XEmacs User's Manual} -@sp 4 -@sp 1 -@sp 1 -@center July 1994 -@center (General Public License upgraded, January 1991) -@sp 5 -@center Richard Stallman -@sp 1 -@center Lucid, Inc. -@sp 1 -@center and -@sp 1 -@center Ben Wing -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1985, 1986, 1988 Richard M. Stallman. - -Copyright @copyright{} 1991, 1992, 1993, 1994 Lucid, Inc. - -Copyright @copyright{} 1993, 1994 Sun Microsystems, Inc. - -Copyright @copyright{} 1995 Amdahl Corporation. - -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 ``The GNU Manifesto'', ``Distribution'' 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 the sections entitled ``The GNU Manifesto'', -``Distribution'' and ``GNU General Public License'' may be included in a -translation approved by the author instead of in the original English. -@end titlepage -@page -@ifinfo -@node Top, License,, (dir) - -The XEmacs Editor -***************** - -XEmacs is the extensible, customizable, self-documenting real-time -display editor. This Info file describes how to edit with Emacs -and some of how to customize it, but not how to extend it. It -corresponds to XEmacs version 21.0. - -This manual is intended as a detailed reference to XEmacs. If -you are looking for an introductory manual, see the New User's -Guide. - -@end ifinfo -@menu -* License:: The GNU General Public License gives you permission - to redistribute XEmacs on certain terms; and also - explains that there is no warranty. -* Distrib:: How to get XEmacs. -* Intro:: An introduction to XEmacs concepts. -* Glossary:: The glossary. -* Manifesto:: What's GNU? Gnu's Not Unix! - -Indices, nodes containing large menus -* Key Index:: An item for each standard XEmacs key sequence. -* Command Index:: An item for each command name. -* Variable Index:: An item for each documented variable. -* Concept Index:: An item for each concept. - -Important General Concepts -* Frame:: How to interpret what you see on the screen. -* Keystrokes:: Keyboard gestures XEmacs recognizes. -* Pull-down Menus:: - The XEmacs Pull-down Menus available under X. -* Entering Emacs:: - Starting Emacs from the shell. -* Exiting:: Stopping or killing XEmacs. -* Command Switches:: - Hairy startup options. -* Startup Paths:: - How XEmacs finds Directories and Files - -Fundamental Editing Commands -* Basic:: The most basic editing commands. -* Undo:: Undoing recently made changes in the text. -* Minibuffer:: Entering arguments that are prompted for. -* M-x:: Invoking commands by their names. -* Help:: Commands for asking XEmacs about its commands. - -Important Text-Changing Commands -* Mark:: The mark: how to delimit a ``region'' of text. -* Mouse Selection:: - Selecting text with the mouse. -* Additional Mouse Operations:: - Other operations available from the mouse. -* Killing:: Killing text. -* Yanking:: Recovering killed text. Moving text. -* Using X Selections:: - Using primary selection, cut buffers, and highlighted regions. -* Accumulating Text:: - Other ways of copying text. -* Rectangles:: Operating on the text inside a rectangle on the screen. -* Registers:: Saving a text string or a location in the buffer. -* Display:: Controlling what text is displayed. -* Search:: Finding or replacing occurrences of a string. -* Fixit:: Commands especially useful for fixing typos. - -Larger Units of Text -* Files:: All about handling files. -* Buffers:: Multiple buffers; editing several files at once. -* Windows:: Viewing two pieces of text at once. -* Mule:: Using world scripts. - -Advanced Features -* Major Modes:: Text mode vs. Lisp mode vs. C mode ... -* Indentation:: Editing the white space at the beginnings of lines. -* Text:: Commands and modes for editing English. -* Programs:: Commands and modes for editing programs. -* Running:: Compiling, running and debugging programs. -* Packages:: How to add new packages to XEmacs. -* Abbrevs:: How to define text abbreviations to reduce - the number of characters you must type. -* Picture:: Editing pictures made up of characters - using the quarter-plane screen model. -* Sending Mail:: Sending mail in XEmacs. -* Reading Mail:: Reading mail in XEmacs. -* Calendar/Diary:: A Calendar and diary facility in XEmacs. -* Sorting:: Sorting lines, paragraphs or pages within XEmacs. -* Shell:: Executing shell commands from XEmacs. -* Narrowing:: Restricting display and editing to a portion - of the buffer. -* Hardcopy:: Printing buffers or regions. -* Recursive Edit:: - A command can allow you to do editing - "within the command". This is called a - `recursive editing level'. -* Dissociated Press:: Dissociating text for fun. -* CONX:: A different kind of dissociation. -* Amusements:: Various games and hacks. -* Emulation:: Emulating some other editors with XEmacs. -* Customization:: Modifying the behavior of XEmacs. - -Recovery from Problems. -* Quitting:: Quitting and aborting. -* Lossage:: What to do if XEmacs is hung or malfunctioning. -* Bugs:: How and when to report a bug. - -Here are some other nodes which are really inferiors of the ones -already listed, mentioned here so you can get to them in one step: - - --- The Detailed Node Listing --- - -The Organization of the Frame - -* Point:: The place in the text where editing commands operate. -* Echo Area:: Short messages appear at the bottom of the frame. -* Mode Line:: Interpreting the mode line. -* XEmacs under X:: Some information on using XEmacs under the X - Window System. - -Keystrokes - -* Intro to Keystrokes:: Keystrokes as building blocks of key sequences. -* Representing Keystrokes:: Using lists of modifiers and keysyms to - represent keystrokes. -* Key Sequences:: Combine key strokes into key sequences you can - bind to commands. -* String Key Sequences:: Available for upward compatibility. -* Meta Key:: Using @key{ESC} to represent @key{Meta} -* Super and Hyper Keys:: Adding modifier keys on certain keyboards. -* Character Representation:: How characters appear in XEmacs buffers. -* Commands:: How commands are bound to key sequences. - -Pull-down Menus - -* File Menu:: Items on the File menu. -* Edit Menu:: Items on the Edit menu. -* Apps Menu:: Items on the Apps menu. -* Options Menu:: Items on the Options menu. -* Buffers Menu:: Information about the Buffers menu. -* Tools Menu:: Items on the Tools menu. -* Help Menu:: Items on the Help menu. -* Menu Customization:: Adding and removing menu items and related - operations. - -Basic Editing Commands - -* Blank Lines:: Commands to make or delete blank lines. -* Continuation Lines:: Lines too wide for the frame. -* Position Info:: What page, line, row, or column is point on? -* Arguments:: Numeric arguments for repeating a command. - -The Minibuffer - -* File: Minibuffer File. Entering file names with the minibuffer. -* Edit: Minibuffer Edit. How to edit in the minibuffer. -* Completion:: An abbreviation facility for minibuffer input. -* Repetition:: Re-executing commands that used the minibuffer. - -The Mark and the Region - -* Setting Mark:: Commands to set the mark. -* Using Region:: Summary of ways to operate on contents of the region. -* Marking Objects:: Commands to put region around textual units. -* Mark Ring:: Previous mark positions saved so you can go back there. - -Yanking - -* Kill Ring:: Where killed text is stored. Basic yanking. -* Appending Kills:: Several kills in a row all yank together. -* Earlier Kills:: Yanking something killed some time ago. - -Using X Selections - -* X Clipboard Selection:: Pasting to the X clipboard. -* X Selection Commands:: Other operations on the selection. -* X Cut Buffers:: X cut buffers are available for compatibility. -* Active Regions:: Using zmacs-style highlighting of the - selected region. - -Registers - -* RegPos:: Saving positions in registers. -* RegText:: Saving text in registers. -* RegRect:: Saving rectangles in registers. - -Controlling the Display - -* Scrolling:: Moving text up and down in a window. -* Horizontal Scrolling:: Moving text left and right in a window. -* Selective Display:: Hiding lines with lots of indentation. -* Display Vars:: Information on variables for customizing display. - -Searching and Replacement - -* Incremental Search:: Search happens as you type the string. -* Non-Incremental Search:: Specify entire string and then search. -* Word Search:: Search for sequence of words. -* Regexp Search:: Search for match for a regexp. -* Regexps:: Syntax of regular expressions. -* Search Case:: To ignore case while searching, or not. -* Replace:: Search, and replace some or all matches. -* Other Repeating Search:: Operating on all matches for some regexp. - -Replacement Commands - -* Unconditional Replace:: Replacing all matches for a string. -* Regexp Replace:: Replacing all matches for a regexp. -* Replacement and Case:: How replacements preserve case of letters. -* Query Replace:: How to use querying. - -Commands for Fixing Typos - -* Kill Errors:: Commands to kill a batch of recently entered text. -* Transpose:: Exchanging two characters, words, lines, lists... -* Fixing Case:: Correcting case of last word entered. -* Spelling:: Apply spelling checker to a word, or a whole file. - -File Handling - -* File Names:: How to type and edit file name arguments. -* Visiting:: Visiting a file prepares XEmacs to edit the file. -* Saving:: Saving makes your changes permanent. -* Reverting:: Reverting cancels all the changes not saved. -* Auto Save:: Auto Save periodically protects against loss of data. -* Version Control:: Version control systems (RCS and SCCS). -* ListDir:: Listing the contents of a file directory. -* Comparing Files:: Finding where two files differ. -* Dired:: ``Editing'' a directory to delete, rename, etc. - the files in it. -* Misc File Ops:: Other things you can do on files. - -Saving Files - -* Backup:: How XEmacs saves the old version of your file. -* Interlocking:: How XEmacs protects against simultaneous editing - of one file by two users. - -Backup Files - -* Names: Backup Names. How backup files are named; - Choosing single or numbered backup files. -* Deletion: Backup Deletion. XEmacs deletes excess numbered backups. -* Copying: Backup Copying. Backups can be made by copying or renaming. - -Auto-Saving: Protection Against Disasters - -* Files: Auto Save Files. -* Control: Auto Save Control. -* Recover:: Recovering text from auto-save files. - -Version Control - -* Concepts of VC:: Basic version control information; - checking files in and out. -* Editing with VC:: Commands for editing a file maintained - with version control. -* Variables for Check-in/out:: Variables that affect the commands used - to check files in or out. -* Log Entries:: Logging your changes. -* Change Logs and VC:: Generating a change log file from log - entries. -* Old Versions:: Examining and comparing old versions. -* VC Status:: Commands to view the VC status of files and - look at log entries. -* Renaming and VC:: A command to rename both the source and - master file correctly. -* Snapshots:: How to make and use snapshots, a set of - file versions that can be treated as a unit. -* Version Headers:: Inserting version control headers into - working files. - -Snapshots - -* Making Snapshots:: The snapshot facilities. -* Snapshot Caveats:: Things to be careful of when using snapshots. - -Dired, the Directory Editor - -* Enter: Dired Enter. How to invoke Dired. -* Edit: Dired Edit. Editing the Dired buffer. -* Deletion: Dired Deletion. Deleting files with Dired. -* Immed: Dired Immed. Other file operations through Dired. - -Using Multiple Buffers - -* Select Buffer:: Creating a new buffer or reselecting an old one. -* List Buffers:: Getting a list of buffers that exist. -* Misc Buffer:: Renaming; changing read-onliness; copying text. -* Kill Buffer:: Killing buffers you no longer need. -* Several Buffers:: How to go through the list of all buffers - and operate variously on several of them. - -Multiple Windows - -* Basic Window:: Introduction to XEmacs windows. -* Split Window:: New windows are made by splitting existing windows. -* Other Window:: Moving to another window or doing something to it. -* Pop Up Window:: Finding a file or buffer in another window. -* Change Window:: Deleting windows and changing their sizes. - -Major Modes - -* Choosing Modes:: How major modes are specified or chosen. - -Indentation - -* Indentation Commands:: Various commands and techniques for indentation. -* Tab Stops:: You can set arbitrary "tab stops" and then - indent to the next tab stop when you want to. -* Just Spaces:: You can request indentation using just spaces. - -Commands for Human Languages - -* Text Mode:: The major modes for editing text files. -* Nroff Mode:: The major mode for editing input to the formatter nroff. -* TeX Mode:: The major modes for editing input to the formatter TeX. -* Outline Mode:: The major mode for editing outlines. -* Words:: Moving over and killing words. -* Sentences:: Moving over and killing sentences. -* Paragraphs:: Moving over paragraphs. -* Pages:: Moving over pages. -* Filling:: Filling or justifying text -* Case:: Changing the case of text - -@TeX{} Mode - -* Editing: TeX Editing. Special commands for editing in TeX mode. -* Printing: TeX Print. Commands for printing part of a file with TeX. - -Outline Mode - -* Format: Outline Format. What the text of an outline looks like. -* Motion: Outline Motion. Special commands for moving through outlines. -* Visibility: Outline Visibility. Commands to control what is visible. - -Filling Text - -* Auto Fill:: Auto Fill mode breaks long lines automatically. -* Fill Commands:: Commands to refill paragraphs and center lines. -* Fill Prefix:: Filling when every line is indented or in a comment, etc. - -Editing Programs - -* Program Modes:: Major modes for editing programs. -* Lists:: Expressions with balanced parentheses. - There are editing commands to operate on them. -* Defuns:: Each program is made up of separate functions. - There are editing commands to operate on them. -* Grinding:: Adjusting indentation to show the nesting. -* Matching:: Insertion of a close-delimiter flashes matching open. -* Comments:: Inserting, filling and aligning comments. -* Balanced Editing:: Inserting two matching parentheses at once, etc. -* Lisp Completion:: Completion on symbol names in Lisp code. -* Documentation:: Getting documentation of functions you plan to call. -* Change Log:: Maintaining a change history for your program. -* Tags:: Go directly to any function in your program in one - command. Tags remembers which file it is in. -* Fortran:: Fortran mode and its special features. -* Asm Mode:: Asm mode and its special features. - -Indentation for Programs - -* Basic Indent:: -* Multi-line Indent:: Commands to reindent many lines at once. -* Lisp Indent:: Specifying how each Lisp function should be indented. -* C Indent:: Choosing an indentation style for C code. - -Tags Tables - -* Tag Syntax:: Tag syntax for various types of code and text files. -* Create Tags Table:: Creating a tags table with @code{etags}. -* Select Tags Table:: How to visit a tags table. -* Find Tag:: Commands to find the definition of a specific tag. -* Tags Search:: Using a tags table for searching and replacing. -* List Tags:: Listing and finding tags defined in a file. - -Fortran Mode - -* Motion: Fortran Motion. Moving point by statements or subprograms. -* Indent: Fortran Indent. Indentation commands for Fortran. -* Comments: Fortran Comments. Inserting and aligning comments. -* Columns: Fortran Columns. Measuring columns for valid Fortran. -* Abbrev: Fortran Abbrev. Built-in abbrevs for Fortran keywords. - -Fortran Indentation - -* Commands: ForIndent Commands. Commands for indenting Fortran. -* Numbers: ForIndent Num. How line numbers auto-indent. -* Conv: ForIndent Conv. Conventions you must obey to avoid trouble. -* Vars: ForIndent Vars. Variables controlling Fortran indent style. - -Compiling and Testing Programs - -* Compilation:: Compiling programs in languages other than Lisp - (C, Pascal, etc.) -* Modes: Lisp Modes. Various modes for editing Lisp programs, with - different facilities for running the Lisp programs. -* Libraries: Lisp Libraries. Creating Lisp programs to run in XEmacs. -* Eval: Lisp Eval. Executing a single Lisp expression in XEmacs. -* Debug: Lisp Debug. Debugging Lisp programs running in XEmacs. -* Interaction: Lisp Interaction. Executing Lisp in an XEmacs buffer. -* External Lisp:: Communicating through XEmacs with a separate Lisp. - -Lisp Libraries - -* Loading:: Loading libraries of Lisp code into XEmacs for use. -* Compiling Libraries:: Compiling a library makes it load and run faster. -* Mocklisp:: Converting Mocklisp to Lisp so XEmacs can run it. - -Packages - -* Packages:: Introduction to XEmacs Packages. -* Package Terminology:: Understanding different kinds of packages. -* Using Packages:: How to install and use packages. -* Building Packages:: Building packages from sources. - -Abbrevs - -* Defining Abbrevs:: Defining an abbrev, so it will expand when typed. -* Expanding Abbrevs:: Controlling expansion: prefixes, canceling expansion. -* Editing Abbrevs:: Viewing or editing the entire list of defined abbrevs. -* Saving Abbrevs:: Saving the entire list of abbrevs for another session. -* Dynamic Abbrevs:: Abbreviations for words already in the buffer. - -Editing Pictures - -* Basic Picture:: Basic concepts and simple commands of Picture Mode. -* Insert in Picture:: Controlling direction of cursor motion - after "self-inserting" characters. -* Tabs in Picture:: Various features for tab stops and indentation. -* Rectangles in Picture:: Clearing and superimposing rectangles. - -Sending Mail - -* Format: Mail Format. Format of the mail being composed. -* Headers: Mail Headers. Details of allowed mail header fields. -* Mode: Mail Mode. Special commands for editing mail being composed. - -Running Shell Commands from XEmacs - -* Single Shell:: How to run one shell command and return. -* Interactive Shell:: Permanent shell taking input via XEmacs. -* Shell Mode:: Special XEmacs commands used with permanent shell. - -Customization - -* Minor Modes:: Each minor mode is one feature you can turn on - independently of any others. -* Variables:: Many XEmacs commands examine XEmacs variables - to decide what to do; by setting variables, - you can control their functioning. -* Keyboard Macros:: A keyboard macro records a sequence of keystrokes - to be replayed with a single command. -* Key Bindings:: The keymaps say what command each key runs. - By changing them, you can "redefine keys". -* Syntax:: The syntax table controls how words and expressions - are parsed. -* Init File:: How to write common customizations in the @file{.emacs} - file. -* Audible Bell:: Changing how XEmacs sounds the bell. -* Faces:: Changing the fonts and colors of a region of text. -* X Resources:: X resources controlling various aspects of the - behavior of XEmacs. - -Variables - -* Examining:: Examining or setting one variable's value. -* Easy Customization:: Convenient and easy customization of variables. -* Edit Options:: Examining or editing list of all variables' values. -* Locals:: Per-buffer values of variables. -* File Variables:: How files can specify variable values. - -Keyboard Macros - -* Basic Kbd Macro:: Defining and running keyboard macros. -* Save Kbd Macro:: Giving keyboard macros names; saving them in files. -* Kbd Macro Query:: Keyboard macros that do different things each use. - -Customizing Key Bindings - -* Keymaps:: Definition of the keymap data structure. - Names of XEmacs's standard keymaps. -* Rebinding:: How to redefine one key's meaning conveniently. -* Disabling:: Disabling a command means confirmation is required - before it can be executed. This is done to protect - beginners from surprises. - -The Syntax Table - -* Entry: Syntax Entry. What the syntax table records for each character. -* Change: Syntax Change. How to change the information. - -The Init File, @file{~/.emacs} - -* Init Syntax:: Syntax of constants in Emacs Lisp. -* Init Examples:: How to do some things with an init file. -* Terminal Init:: Each terminal type can have an init file. - -Dealing with XEmacs Trouble - -* Stuck Recursive:: `[...]' in mode line around the parentheses. -* Screen Garbled:: Garbage on the screen. -* Text Garbled:: Garbage in the text. -* Unasked-for Search:: Spontaneous entry to incremental search. -* Emergency Escape:: Emergency escape--- - What to do if XEmacs stops responding. -* Total Frustration:: When you are at your wits' end. - -@end menu - -@iftex -@unnumbered Preface - - This manual documents the use and simple customization of the XEmacs -editor. The reader is not expected to be a programmer to use this -editor, and simple customizations do not require programming skills either. -Users who are not interested in customizing XEmacs can ignore the scattered -customization hints. - - This document is primarily a reference manual, but it can also be used as a -primer. However, if you are new to XEmacs, consider using the on-line, -learn-by-doing tutorial, which you get by running XEmacs and typing -@kbd{C-h t}. With it, you learn XEmacs by using XEmacs on a specially -designed file which describes commands, tells you when to try them, -and then explains the results you see. Using the tutorial gives a more vivid -introduction than the printed manual. Also consider reading the XEmacs -New User's Guide, which is intended specifically as an introductory -manual rather than as a reference guide. - - On first reading, just skim chapters one and two, which describe the -notational conventions of the manual and the general appearance of the -XEmacs display frame. Note which questions are answered in these chapters, -so you can refer back later. After reading chapter four you should -practice the commands there. The next few chapters describe fundamental -techniques and concepts that are used constantly. You need to understand -them thoroughly, experimenting with them if necessary. - - To find the documentation on a particular command, look in the index. -Keys (character commands) and command names have separate indexes. There -is also a glossary, with a cross reference for each term. - -@ignore - If you know vaguely what the command -does, look in the command summary. The command summary contains a line or -two about each command, and a cross reference to the section of the -manual that describes the command in more detail; related commands -are grouped together. -@end ignore - - This manual comes in two forms: the published form and the Info form. -The Info form is for on-line perusal with the INFO program; it is -distributed along with XEmacs. Both forms contain substantially the -same text and are generated from a common source file, which is also -distributed along with XEmacs. - - XEmacs is a member of the Emacs editor family. There are many Emacs -editors, all sharing common principles of organization. For information on -the underlying philosophy of Emacs and the lessons learned from its -development, write for a copy of AI memo 519a, ``Emacs, the Extensible, -Customizable Self-Documenting Display Editor'', to Publications Department, -Artificial Intelligence Lab, 545 Tech Square, Cambridge, MA 02139, USA. At -last report they charge $2.25 per copy. Another useful publication is LCS -TM-165, ``A Cookbook for an Emacs'', by Craig Finseth, available from -Publications Department, Laboratory for Computer Science, 545 Tech Square, -Cambridge, MA 02139, USA. The price today is $3. - -This manual is for XEmacs installed on UNIX systems. XEmacs also -exists on Microsoft Windows and Windows NT as Win-Emacs (which is -actually based on Lucid Emacs 19.6, an older incarnation of XEmacs). -@end iftex - -@comment node-name, next, previous, up -@node License, Distrib, Top, Top -@unnumbered GNU GENERAL PUBLIC LICENSE -@center Version 1, February 1989 -@cindex license to copy XEmacs -@cindex General Public License - -@display -Copyright @copyright{} 1989 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 license agreements of most software companies try to keep users -at the mercy of those companies. By contrast, our 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. The -General Public License applies to the Free Software Foundation's -software and to any other program whose authors commit to using it. -You can use it for your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Specifically, the General Public License is designed to make -sure that you have the freedom to give away or sell copies of free -software, 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 a 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 tell them 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. - - The precise terms and conditions for copying, distribution and -modification follow. - -@iftex -@unnumberedsec TERMS AND CONDITIONS -@end iftex -@ifinfo -@center TERMS AND CONDITIONS -@end ifinfo - -@enumerate -@item -This License Agreement 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 work containing the -Program or a portion of it, either verbatim or with modifications. Each -licensee is addressed as ``you''. - -@item -@cindex Distribution -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 -General Public License and to the absence of any warranty; and give any -other recipients of the Program a copy of this General Public License -along with the Program. You may charge a fee for the physical act of -transferring a copy. - -@item -You may modify your copy or copies of the Program or any portion of -it, and copy and distribute such modifications under the terms of Paragraph -1 above, provided that you also do the following: - -@itemize @bullet -@item -cause the modified files to carry prominent notices stating that -you changed the files and the date of any change; and - -@item -cause the whole of any work that you distribute or publish, that -in whole or in part contains the Program or any part thereof, either -with or without modifications, to be licensed at no charge to all -third parties under the terms of this General Public License (except -that you may choose to grant warranty protection to some or all -third parties, at your option). - -@item -If the modified program normally reads commands interactively when -run, you must cause it, when started running for such interactive use -in the simplest and most usual 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 General -Public License. - -@item -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. -@end itemize - -Mere aggregation of another independent work with the Program (or its -derivative) on a volume of a storage or distribution medium does not bring -the other work under the scope of these terms. - -@item -You may copy and distribute the Program (or a portion or derivative of -it, under Paragraph 2) in object code or executable form under the terms of -Paragraphs 1 and 2 above provided that you also do one of the following: - -@itemize @bullet -@item -accompany it with the complete corresponding machine-readable -source code, which must be distributed under the terms of -Paragraphs 1 and 2 above; or, - -@item -accompany it with a written offer, valid for at least three -years, to give any third party free (except for a nominal charge -for the cost of distribution) a complete machine-readable copy of the -corresponding source code, to be distributed under the terms of -Paragraphs 1 and 2 above; or, - -@item -accompany it with the information you received as to where the -corresponding source code may be obtained. (This alternative is -allowed only for noncommercial distribution and only if you -received the program in object code or executable form alone.) -@end itemize - -Source code for a work means the preferred form of the work for making -modifications to it. For an executable file, complete source code means -all the source code for all modules it contains; but, as a special -exception, it need not include source code for modules which are standard -libraries that accompany the operating system on which the executable -file runs, or for standard header files or definitions files that -accompany that operating system. - -@item -You may not copy, modify, sublicense, distribute or transfer the -Program except as expressly provided under this General Public License. -Any attempt otherwise to copy, modify, sublicense, distribute or transfer -the Program is void, and will automatically terminate your rights to use -the Program under this License. However, parties who have received -copies, or rights to use copies, from you under this General Public -License will not have their licenses terminated so long as such parties -remain in full compliance. - -@item -By copying, distributing or modifying 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. - -@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. - -@page -@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 the 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 -the 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 Appendix: How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to humanity, 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 a brief 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 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. -@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 `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. - -@page -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 a sample; alter the names: - -@example -Yoyodyne, Inc., hereby disclaims all copyright interest in the -program `Gnomovision' (a program to direct compilers to make passes -at assemblers) written by James Hacker. - -@var{signature of Ty Coon}, 1 April 1989 -Ty Coon, President of Vice -@end example - -That's all there is to it! - -@comment node-name, next, previous, up -@node Distrib, Intro, License, Top -@unnumbered Distribution - -XEmacs is @dfn{free}; this means that everyone is free to use it and -free to redistribute it on a free basis. XEmacs is not in the public -domain; it is copyrighted and there are restrictions on its -distribution, but these restrictions are designed to permit everything -that a good cooperating citizen would want to do. What is not allowed -is to try to prevent others from further sharing any version of XEmacs -that they might get from you. The precise conditions are found in -the GNU General Public License that comes with XEmacs and also appears -following this section. - -The easiest way to get a copy of XEmacs is from someone else who has it. -You need not ask for permission to do so, or tell any one else; just copy -it. - -If you have access to the Internet, you can get the latest version of -XEmacs from the anonymous FTP server @file{ftp.xemacs.org} in the directory -@file{/pub/xemacs}. It can also be found at numerous other archive -sites around the world; check the file @file{etc/DISTRIB} in an XEmacs -distribution for the latest known list. - - -@unnumberedsec Getting Other Versions of Emacs - -The Free Software Foundation's version of Emacs (called @dfn{FSF Emacs} -in this manual and often referred to as @dfn{GNU Emacs}) is available -by anonymous FTP from @file{prep.ai.mit.edu}. - -Win-Emacs, an older version of XEmacs that runs on Microsoft Windows -and Windows NT, is available by anonymous FTP from @file{ftp.netcom.com} -in the directory @file{/pub/pe/pearl}, or from @file{ftp.cica.indiana.edu} -as the files @file{wemdemo*.zip} in the directory @file{/pub/pc/win3/demo}. - -@node Intro, Glossary, Distrib, Top -@unnumbered Introduction - - You are reading about XEmacs, an incarnation of the advanced, -self-documenting, customizable, extensible real-time display editor -Emacs. XEmacs provides many powerful display and user-interface -capabilities not found in other Emacsen and is mostly upwardly -compatible with GNU Emacs from the Free Software Foundation -(referred to as @dfn{FSF Emacs} in this manual). XEmacs also -comes standard with a great number of useful packages. - - We say that XEmacs is a @dfn{display} editor because normally the text -being edited is visible on the screen and is updated automatically as you -type. @xref{Frame,Display}. - - We call XEmacs a @dfn{real-time} editor because the display is updated very -frequently, usually after each character or pair of characters you -type. This minimizes the amount of information you must keep in your -head as you edit. @xref{Basic,Real-time,Basic Editing}. - - We call XEmacs advanced because it provides facilities that go beyond -simple insertion and deletion: filling of text; automatic indentation of -programs; viewing two or more files at once; and dealing in terms of -characters, words, lines, sentences, paragraphs, and pages, as well as -expressions and comments in several different programming languages. It is -much easier to type one command meaning ``go to the end of the paragraph'' -than to find that spot with simple cursor keys. - - @dfn{Self-documenting} means that at any time you can type a special -character, @kbd{Control-h}, to find out what your options are. You can -also use @kbd{C-h} to find out what a command does, or to find all the -commands relevant to a topic. @xref{Help}. - - @dfn{Customizable} means you can change the definitions of XEmacs -commands. For example, if you use a programming language in -which comments start with @samp{<**} and end with @samp{**>}, you can tell -the XEmacs comment manipulation commands to use those strings -(@pxref{Comments}). Another sort of customization is rearrangement of the -command set. For example, you can set up the four basic cursor motion -commands (up, down, left and right) on keys in a diamond pattern on the -keyboard if you prefer. @xref{Customization}. - - @dfn{Extensible} means you can go beyond simple customization and -write entirely new commands, programs in the Lisp language to be run by -XEmacs's own Lisp interpreter. XEmacs is an ``on-line extensible'' -system: it is divided into many functions that call each other. You can -redefine any function in the middle of an editing session and replace -any part of XEmacs without making a separate copy of all of XEmacs. Most -of the editing commands of XEmacs are written in Lisp; the few -exceptions could have been written in Lisp but are written in C for -efficiency. Only a programmer can write an extension to XEmacs, but anybody -can use it afterward. - -@include frame.texi -@include keystrokes.texi -@include menus.texi -@include entering.texi -@include cmdargs.texi -@include startup.texi -@include basic.texi -@include undo.texi -@include mini.texi -@include m-x.texi -@include help.texi -@include mark.texi -@include mouse.texi -@include killing.texi -@include regs.texi -@include display.texi -@include search.texi -@include fixit.texi -@include files.texi -@include buffers.texi -@include windows.texi -@include mule.texi -@include major.texi -@include indent.texi -@include text.texi -@include programs.texi -@include building.texi -@include packages.texi -@include abbrevs.texi -@include picture.texi -@include sending.texi -@include reading.texi -@include calendar.texi -@include misc.texi -@include custom.texi -@include trouble.texi - -@include new.texi -@include glossary.texi -@include gnu.texi - -@node Key Index, Command Index, Manifesto, Top -@unnumbered Key (Character) Index -@printindex ky - -@node Command Index, Variable Index, Key Index, Top -@unnumbered Command and Function Index -@printindex fn - -@node Variable Index, Concept Index, Command Index, Top -@unnumbered Variable Index -@printindex vr - -@node Concept Index, Frame, Variable Index, Top -@unnumbered Concept Index -@printindex cp - -@summarycontents -@contents -@bye - - -@c Remember to delete these lines before creating the info file. -@iftex -@lucidbook -@bindingoffset = 0.5in -@parindent = 0pt -@end iftex diff --git a/modules/base64/Makefile b/modules/base64/Makefile deleted file mode 100644 index 43a70e3..0000000 --- a/modules/base64/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# Sample makefile for a simple Emacs module. -# This is slightly more complicated than would normally be the case, -# as this makefile has been tailored to work in the Emacs source tree. -# For samples of how to compile modules outside of the source tree -# (as would be the case if a user had downloaded a module and wanted -# to compile it for use within Emacs), see the samples in the sub-directory -# 'installed'. -# - -CC=../../lib-src/ellcc -CFLAGS=-I. -I../../src -LD=$(CC) --mode=link -MKINIT=$(CC) --mode=init - -SRCS=base64.c -OBJS=$(SRCS:.c=.o) - -.c.o: - $(CC) $(CFLAGS) -c $< - -MODNAME=base64 -MODVER=1.0.0 -MODTITLE="Encode objects in Base 64" - -all: $(MODNAME).ell - -clean: - rm -f $(MODNAME).ell $(OBJS) base64_i.o base64_i.c - -$(MODNAME).ell: $(OBJS) base64_i.o - $(LD) --mod-output=$@ $(OBJS) base64_i.o - -base64_i.o: base64_i.c -base64_i.c: $(SRCS) - ELLMAKEDOC=../../lib-src/make-docfile $(MKINIT) --mod-output=$@ \ - --mod-name=$(MODNAME) --mod-version=$(MODVER) \ - --mod-title=$(MODTITLE) $(SRCS) - diff --git a/modules/base64/base64.c b/modules/base64/base64.c deleted file mode 100644 index 48459a7..0000000 --- a/modules/base64/base64.c +++ /dev/null @@ -1,421 +0,0 @@ -/* base64 interface for XEmacs. - Copyright (C) 1998, 1999 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. */ - -/* Author: William Perry */ - -#include - -unsigned char alphabet[64] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; - -DEFUN ("base64-encode", Fbase64_encode, 1, 5, 0, /* -Return the base64 encoding 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. The optional CODING argument specifies the coding -system the text is to be represented in while computing the digest. This only -has meaning with MULE, and defaults to the current format of the data. -If ERROR-ME-NOT is nil, report an error if the coding system can't be -determined. Else assume binary coding if all else fails. -*/ - (object, start, end, coding, error_me_not)) -{ - int cols,bits,char_count; - Lisp_Object instream, outstream,deststream; - Lstream *istr, *ostr, *dstr; - static Extbyte_dynarr *conversion_out_dynarr; - static Extbyte_dynarr *out_dynarr; - char tempbuf[1024]; /* some random amount */ - struct gcpro gcpro1, gcpro2; -#ifdef FILE_CODING - Lisp_Object conv_out_stream, coding_system; - Lstream *costr; - struct gcpro gcpro3; -#endif - - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - if (!out_dynarr) - out_dynarr = Dynarr_new(Extbyte); - else - Dynarr_reset (out_dynarr); - - char_count = bits = cols = 0; - - /* set up the in stream */ - if (BUFFERP (object)) - { - struct buffer *b = decode_buffer (object, 1); - Bufpos begv, endv; - /* Figure out where we need to get info from */ - get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); - - instream = make_lisp_buffer_input_stream (b, begv, endv, 0); - } - else - { - Bytecount bstart, bend; - CHECK_STRING (object); - get_string_range_byte (object, start, end, &bstart, &bend, - GB_HISTORICAL_STRING_BEHAVIOR); - instream = make_lisp_string_input_stream (object, bstart, bend); - } - istr = XLSTREAM (instream); - -#ifdef FILE_CODING - /* Find out what format the buffer will be saved in, so we can make - the digest based on what it will look like on disk */ - if (NILP(coding)) - { - if (BUFFERP(object)) - { - /* Use the file coding for this buffer by default */ - coding_system = XBUFFER(object)->buffer_file_coding_system; - } - else - { - /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ - enum eol_type eol = EOL_AUTODETECT; - coding_system = Fget_coding_system(Qundecided); - determine_real_coding_system(istr, &coding_system, &eol); - } - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - else - { - coding_system = Ffind_coding_system (coding_system); - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - } - } - else - { - coding_system = Ffind_coding_system (coding); - if (NILP(coding_system)) - { - if (NILP(error_me_not)) - signal_simple_error("No such coding system", coding); - else - coding_system = Fget_coding_system(Qbinary); /* default to binary */ - } - } -#endif - - /* setup the out stream */ - outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr); - ostr = XLSTREAM (outstream); - deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr); - dstr = XLSTREAM (deststream); -#ifdef FILE_CODING - /* setup the conversion stream */ - conv_out_stream = make_encoding_output_stream (ostr, coding_system); - costr = XLSTREAM (conv_out_stream); - GCPRO3 (instream, outstream, conv_out_stream); -#else - GCPRO2 (instream, outstream); -#endif - - /* Get the data while doing the conversion */ - while (1) { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - int l; - if (!size_in_bytes) - break; - /* It does seem the flushes are necessary... */ -#ifdef FILE_CODING - Lstream_write (costr, tempbuf, size_in_bytes); - Lstream_flush (costr); -#else - Lstream_write (ostr, tempbuf, size_in_bytes); -#endif - Lstream_flush (ostr); - - /* Update the base64 output buffer */ - for (l = 0; l < size_in_bytes; l++) { - bits += Dynarr_at(conversion_out_dynarr,l); - char_count++; - if (char_count == 3) { - static char obuf[4]; - obuf[0] = alphabet[(bits >> 18)]; - obuf[1] = alphabet[(bits >> 12) & 0x3f]; - obuf[2] = alphabet[(bits >> 6) & 0x3f]; - obuf[3] = alphabet[bits & 0x3f]; - - Lstream_write(dstr,obuf,sizeof(obuf)); - cols += 4; - if (cols == 72) { - Lstream_write(dstr,"\n",sizeof(unsigned char)); - cols = 0; - } - bits = char_count = 0; - } else { - bits <<= 8; - } - } - /* reset the dynarr */ - Lstream_rewind(ostr); - } - Lstream_close (istr); -#ifdef FILE_CODING - Lstream_close (costr); -#endif - Lstream_close (ostr); - - if (char_count != 0) { - bits <<= 16 - (8 * char_count); - Lstream_write(dstr,&alphabet[bits >> 18],sizeof(unsigned char)); - Lstream_write(dstr,&alphabet[(bits >> 12) & 0x3f],sizeof(unsigned char)); - if (char_count == 1) { - Lstream_write(dstr,"==",2 * sizeof(unsigned char)); - } else { - Lstream_write(dstr,&alphabet[(bits >> 6) & 0x3f],sizeof(unsigned char)); - Lstream_write(dstr,"=",sizeof(unsigned char)); - } - } -#if 0 - if (cols > 0) { - Lstream_write(dstr,"\n",sizeof(unsigned char)); - } -#endif - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); -#ifdef FILE_CODING - Lstream_delete (costr); -#endif - Lstream_flush(dstr); - Lstream_delete(dstr); - - return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr))); -} - -DEFUN ("base64-decode", Fbase64_decode, 1, 5, 0, /* -Undo the base64 encoding 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. The optional CODING argument specifies the coding -system the text is to be represented in while computing the digest. This only -has meaning with MULE, and defaults to the current format of the data. -If ERROR-ME-NOT is nil, report an error if the coding system can't be -determined. Else assume binary coding if all else fails. -*/ - (object, start, end, coding, error_me_not)) -{ - static char inalphabet[256], decoder[256]; - int i,cols,bits,char_count,hit_eof; - Lisp_Object instream, outstream,deststream; - Lstream *istr, *ostr, *dstr; - static Extbyte_dynarr *conversion_out_dynarr; - static Extbyte_dynarr *out_dynarr; - char tempbuf[1024]; /* some random amount */ - struct gcpro gcpro1, gcpro2; -#ifdef FILE_CODING - Lisp_Object conv_out_stream, coding_system; - Lstream *costr; - struct gcpro gcpro3; -#endif - - for (i = (sizeof alphabet) - 1; i >= 0 ; i--) { - inalphabet[alphabet[i]] = 1; - decoder[alphabet[i]] = i; - } - - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - if (!out_dynarr) - out_dynarr = Dynarr_new(Extbyte); - else - Dynarr_reset (out_dynarr); - - char_count = bits = cols = hit_eof = 0; - - /* set up the in stream */ - if (BUFFERP (object)) - { - struct buffer *b = decode_buffer (object, 1); - Bufpos begv, endv; - /* Figure out where we need to get info from */ - get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL); - - instream = make_lisp_buffer_input_stream (b, begv, endv, 0); - } - else - { - Bytecount bstart, bend; - CHECK_STRING (object); - get_string_range_byte (object, start, end, &bstart, &bend, - GB_HISTORICAL_STRING_BEHAVIOR); - instream = make_lisp_string_input_stream (object, bstart, bend); - } - istr = XLSTREAM (instream); - -#ifdef FILE_CODING - /* Find out what format the buffer will be saved in, so we can make - the digest based on what it will look like on disk */ - if (NILP(coding)) - { - if (BUFFERP(object)) - { - /* Use the file coding for this buffer by default */ - coding_system = XBUFFER(object)->buffer_file_coding_system; - } - else - { - /* attempt to autodetect the coding of the string. Note: this VERY hit-and-miss */ - enum eol_type eol = EOL_AUTODETECT; - coding_system = Fget_coding_system(Qundecided); - determine_real_coding_system(istr, &coding_system, &eol); - } - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - else - { - coding_system = Ffind_coding_system (coding_system); - if (NILP(coding_system)) - coding_system = Fget_coding_system(Qbinary); - } - } - else - { - coding_system = Ffind_coding_system (coding); - if (NILP(coding_system)) - { - if (NILP(error_me_not)) - signal_simple_error("No such coding system", coding); - else - coding_system = Fget_coding_system(Qbinary); /* default to binary */ - } - } -#endif - - /* setup the out stream */ - outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr); - ostr = XLSTREAM (outstream); - deststream = make_dynarr_output_stream((unsigned_char_dynarr *)out_dynarr); - dstr = XLSTREAM (deststream); -#ifdef FILE_CODING - /* setup the conversion stream */ - conv_out_stream = make_encoding_output_stream (ostr, coding_system); - costr = XLSTREAM (conv_out_stream); - GCPRO3 (instream, outstream, conv_out_stream); -#else - GCPRO2 (instream, outstream); -#endif - - /* Get the data while doing the conversion */ - while (1) { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - int l; - if (!size_in_bytes) { - hit_eof = 1; - break; - } - /* It does seem the flushes are necessary... */ -#ifdef FILE_CODING - Lstream_write (costr, tempbuf, size_in_bytes); - Lstream_flush (costr); -#else - Lstream_write (ostr, tempbuf, size_in_bytes); -#endif - Lstream_flush (ostr); - - /* Update the base64 output buffer */ - for (l = 0; l < size_in_bytes; l++) { - if (Dynarr_at(conversion_out_dynarr,l) == '=') - goto decoder_out; - bits += decoder[Dynarr_at(conversion_out_dynarr,l)]; - fprintf(stderr,"%d\n",bits); - char_count++; - if (char_count == 4) { - static unsigned char obuf[3]; - obuf[0] = (bits >> 16); - obuf[1] = (bits >> 8) & 0xff; - obuf[2] = (bits & 0xff); - - Lstream_write(dstr,obuf,sizeof(obuf)); - bits = char_count = 0; - } else { - bits <<= 6; - } - } - /* reset the dynarr */ - Lstream_rewind(ostr); - } - decoder_out: - Lstream_close (istr); -#ifdef FILE_CODING - Lstream_close (costr); -#endif - Lstream_close (ostr); - - if (hit_eof) { - if (char_count) { - error_with_frob(object,"base64-decode failed: at least %d bits truncated",((4 - char_count) * 6)); - } - } - switch(char_count) { - case 1: - error_with_frob(object, "base64 encoding incomplete: at least 2 bits missing"); - break; - case 2: - char_count = bits >> 10; - Lstream_write(dstr,&char_count,sizeof(char_count)); - break; - case 3: - { - unsigned char buf[2]; - buf[0] = (bits >> 16); - buf[1] = (bits >> 8) & 0xff; - Lstream_write(dstr,buf,sizeof(buf)); - break; - } - } - - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); -#ifdef FILE_CODING - Lstream_delete (costr); -#endif - Lstream_flush(dstr); - Lstream_delete(dstr); - - return(make_string(Dynarr_atp(out_dynarr,0),Dynarr_length(out_dynarr))); -} - -void -syms_of_base64 (void) -{ - DEFSUBR(Fbase64_encode); - DEFSUBR(Fbase64_decode); -} - -void -vars_of_base64 (void) -{ - Fprovide (intern ("base64")); -} diff --git a/modules/ldap/Makefile b/modules/ldap/Makefile deleted file mode 100644 index e0f1976..0000000 --- a/modules/ldap/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# Sample makefile for a simple Emacs module. -# This is slightly more complicated than would normally be the case, -# as this makefile has been tailored to work in the Emacs source tree. -# For samples of how to compile modules outside of the source tree -# (as would be the case if a user had downloaded a module and wanted -# to compile it for use within Emacs), see the samples in the sub-directory -# 'installed'. -# - -CC=../../lib-src/ellcc -CFLAGS=-I. -I../../src -LD=$(CC) --mode=link -MKINIT=$(CC) --mode=init - -SRCS=eldap.c -OBJS=$(SRCS:.c=.o) - -.c.o: - $(CC) $(CFLAGS) -c $< - -MODNAME=ldap -MODVER=1.0.0 -MODTITLE="LDAP Client Interface for XEmacs" - -all: $(MODNAME).ell - -clean: - rm -f $(MODNAME).ell $(OBJS) eldap_i.o eldap_i.c - -$(MODNAME).ell: $(OBJS) eldap_i.o - $(LD) --mod-output=$@ $(OBJS) eldap_i.o - -eldap_i.o: eldap_i.c -eldap_i.c: $(SRCS) - ELLMAKEDOC=../../lib-src/make-docfile $(MKINIT) --mod-output=$@ \ - --mod-name=$(MODNAME) --mod-version=$(MODVER) \ - --mod-title=$(MODTITLE) $(SRCS) - diff --git a/modules/sample/Makefile b/modules/sample/Makefile deleted file mode 100644 index 09390d1..0000000 --- a/modules/sample/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# Sample makefile for a simple Emacs module. -# This is slightly more complicated than would normally be the case, -# as this makefile has been tailored to work in the Emacs source tree. -# For samples of how to compile modules outside of the source tree -# (as would be the case if a user had downloaded a module and wanted -# to compile it for use within Emacs), see the samples in the sub-directory -# 'installed'. -# - -CC=../../lib-src/ellcc -CFLAGS=-I. -I../../src -LD=$(CC) --mode=link -MKINIT=$(CC) --mode=init - -SRCS=sample.c -OBJS=$(SRCS:.c=.o) - -.c.o: - $(CC) $(CFLAGS) -c $< - -MODNAME=sample -MODVER=1.0.0 -MODTITLE="Sample loadable module" - -all: $(MODNAME).ell - -clean: - rm -f $(MODNAME).ell $(OBJS) sample_i.o sample_i.c - -$(MODNAME).ell: $(OBJS) sample_i.o - $(LD) --mod-output=$@ $(OBJS) sample_i.o - -sample_i.o: sample_i.c -sample_i.c: $(SRCS) - ELLMAKEDOC=../../lib-src/make-docfile $(MKINIT) --mod-output=$@ \ - --mod-name=$(MODNAME) --mod-version=$(MODVER) \ - --mod-title=$(MODTITLE) $(SRCS) - diff --git a/modules/sample/sample.c b/modules/sample/sample.c deleted file mode 100644 index 1f519fc..0000000 --- a/modules/sample/sample.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * Very simple sample module. Illustrates most of the salient features - * of Emacs dynamic modules. - * (C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. - */ - -#include - -/* - * This sample introduces three new Lisp objects to the Lisp reader. - * The first, a simple boolean value, and the second a string. The - * Third is a sample function that simply prints a message. - */ -int sample_bool; -Lisp_Object Vsample_string; - -DEFUN ("sample-function", Fsample_function, 0, 0, "", /* -This is a sample function loaded dynamically. - -You will notice in the source code for this module that the -declaration is identical to internal Emacs functions. This -makes it possible to use the exact same code in a dumped -version of Emacs. -*/ - ()) -{ - message ("Eureka! It worked"); - return Qt; -} - -/* - * Each dynamically loaded Emacs module is given a name at compile - * time. This is a short name, and must be a valid part of a C - * identifier. This name is used to contruct the name of several - * functions which must appear in the module source code. - * The first such function, modules_of_XXXX, should load in any dependant - * modules. This function is optional, and the module will still load if - * it is not present in the module. - * - * The second function, which is NOT optional, is syms_of_XXXX, in which - * all functions that the module will be provided are declared. This - * function will contain calls to DEFSUBR(). - * - * The third function, which is also NOT optional, is vars_of_XXXX, in - * which you declare all variables that the module provides. This - * function will contain calls to DEFVAR_LISP(), DEFVAR_BOOL() etc. - * - * When declaring functions and variables in the syms_of_XXXX and - * vars_of_XXXX functions, you use the exact same syntax that you - * would as if this module were being compiled into the pure Emacs. - * - * All three of these functions are declared as void functions, - * taking no parameters. Since this sample module is called 'sample', - * the functions will be named 'modules_of_sample', 'syms_of_sample' - * and 'vars_of_sample'. - */ - -void -modules_of_sample() -{ - /* - * This function isn't actually required as we will not be loading - * in any dependant modules, but if we were, we would do something like: - * emodules_load ("dependant.ell", "sample2", "1.0.0"); - */ -} - -void -syms_of_sample() -{ - DEFSUBR(Fsample_function); -} - -void -vars_of_sample() -{ - DEFVAR_LISP ("sample-string", &Vsample_string /* -This is a sample string, declared in a dynamic module. - -The syntax and conventions used for all normal Emacs variables -apply equally to modules, using an identical syntax. -*/ ); - - DEFVAR_BOOL ("sample-boolean", &sample_bool /* -*Sample boolean value, in a dynamic module. - -This is a user-settable variable, as indicated by the * -as the first character of the description. Declared in -a module exactly as it would be internally in Emacs. -*/ ); -} - diff --git a/modules/zlib/Makefile b/modules/zlib/Makefile deleted file mode 100644 index cb7aecd..0000000 --- a/modules/zlib/Makefile +++ /dev/null @@ -1,39 +0,0 @@ -# -# Sample makefile for a simple Emacs module. -# This is slightly more complicated than would normally be the case, -# as this makefile has been tailored to work in the Emacs source tree. -# For samples of how to compile modules outside of the source tree -# (as would be the case if a user had downloaded a module and wanted -# to compile it for use within Emacs), see the samples in the sub-directory -# 'installed'. -# - -CC=../../lib-src/ellcc -CFLAGS=-I. -I../../src -LD=$(CC) --mode=link -MKINIT=$(CC) --mode=init - -SRCS=zlib.c -OBJS=$(SRCS:.c=.o) - -.c.o: - $(CC) $(CFLAGS) -c $< - -MODNAME=zlib -MODVER=1.0.4 -MODTITLE="ZLIB compression library interface" - -all: $(MODNAME).ell - -clean: - rm -f $(MODNAME).ell $(OBJS) zlib_i.o zlib_i.c - -$(MODNAME).ell: $(OBJS) zlib_i.o - $(LD) --mod-output=$@ $(OBJS) zlib_i.o - -zlib_i.o: zlib_i.c -zlib_i.c: $(SRCS) - ELLMAKEDOC=../../lib-src/make-docfile $(MKINIT) --mod-output=$@ \ - --mod-name=$(MODNAME) --mod-version=$(MODVER) \ - --mod-title=$(MODTITLE) $(SRCS) - diff --git a/nt/ChangeLog b/nt/ChangeLog deleted file mode 100644 index 25bc2e2..0000000 --- a/nt/ChangeLog +++ /dev/null @@ -1,620 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-01-14 Adrian Aichner - - * xemacs.mak (MODULES): Adding variable. - (update-elc): Setting EMACSBOOTSTRAPMODULEPATH. - -1998-12-17 Charles G. Waldman - - * minitar.c: New file - * minitar.mak: New file - -1998-12-29 Jonathan Harris - - * xemacs.mak: - Changed x86 EMACS_CONFIGURATION to i586-pc-win32 since we - build optimised for Pentium. - Created CFLAGS variable, used in building all objects and in - constructing config.values. - Added glyphs-widget.c and gui-msw.c to list of sources. - Added PACKAGE_PATH to EMACSBOOTSTRAPLOADPATH for mule builds. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-13 Jonathan Harris - - * xemacs.mak: - Replaced PACKAGEPATH variable with PACKAGE_PREFIX. - configure-package-path is initialised to contain - subdirectories of PACKAGE_PREFIX. The install target makes - a skeleton package tree under PACKAGE_PREFIX. - - * README, PROBLEMS: - Documented the package path changes. - Corrected the advice on a suitable minimal set of packages. - -1998-12-17 Andy Piper - - * xemacs.mak ($(LIB_SRC)/movemail.exe): adapt make rule to build - with pop support. - - * xemacs.mak: add gui-msw.c and glyphs-widget.c object lists. - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-12-11 Adrian Aichner - - * xemacs.mak (DOC_SRC2): CLASH_DETECTION is not supported under - native Windows NT. Therefore src\filelock.c is not to be - compiled. - (TEMACS_OBJS): Consequently, don't link in $(OUTDIR)\filelock.obj. - -1998-12-10 Jonathan Harris - - * xemacs.mak ($(OUTDIR)\alloc.obj): add a dependency on - puresize-adjust.h to avoid infinite recursion. - -1998-12-09 Andy Piper - - * config.h: remove clash detection stuff. - -1998-12-07 Martin Buchholz - - * xemacs.mak (TEMACS_OBJS): - (DOC_SRC4): - - Remove pure.c, pure.obj - -1998-11-04 Adrian Aichner - - * xemacs.mak: Creating minimal versions of Installation, - Installation.el, and config.values to make - (describe-installation) and (config-value ...) work in Windows NT - native builds. Incorporating rule for movemail.exe courtesy of - Andy Piper. - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-10-29 Andy Piper - - * xemacs.mak ($(LIB_SRC)/movemail.exe): add etags dependencies to - pull in getopt and friends. - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-09-19 Adrian Aichner - - * tiff.mak: New file provided by Charles Wilson - - - * README: Update provided by Charles Wilson - . Documenting use of the newly - introduced tiff.mak. Renumbering subsequent build instruction - items. - -1998-09-20 Jonathan Harris - - * PROBLEMS: New file. - - * xemacs.mak: Install the PROBLEMS file in the root directory of - the XEmacs installation. - -1998-08-31 Jonathan Harris - - * xemacs.mak: Detect failure to supply PNG_DIR or XLIB_DIR - when building with PNG support. - -1998-08-31 Jonathan Harris - - * README: Document the PNG, ZLIB, JPEG, TIFF and GIF build - options. - -1998-08-12 Jeff Sparkes - - * xemacs.mak: Link in GIF, fix HAVE_JPEG default. - -1998-08-09 Jonathan Harris - - * xemacs.mak (install): Win95 fixes: - DOS mkdir doesn't create intermediate directories. xcopy does - so use it to create the install and lock directories. - Removed trailing backslashes from copy commands since DOS - copy doesn't like them. - -1998-08-05 Charles G. Waldman - - * xemacs.mak: change "copy" to "xcopy" in install target - -1998-08-04 Jeff Sparkes - - * xemacs.mak: Link in PNG, TIFF and JPEG in native build. - -1998-08-04 Jonathan Harris - - * README: XEmacs has been successfully built with MSVC 4.0. - Mention the vcvars32.bat file installed with the MSVC tools. - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-13 Jonathan Harris - - * xemacs.mak: - Add path to xemacs.res dependency. - -1998-07-12 SL Baur - - * XEmacs 21.0-pre5 is released. - -1998-07-09 SL Baur - - * XEmacs 21.0-pre4 is released. - -1998-07-04 Jonathan Harris - - * README: Documented the changed PACKAGEPATH option and the new - INSTALL_DIR option, install target and runemacs executable. - Added more debugging documentation. - - * config.h: Don't undef EMACS_CONFIGURATION because it's now - set in the makefile. - - * xemacs.mak: Added an INSTALL_DIR option and install target. - Renamed the default package location option to PACKAGEPATH - and made it cope with paths with spaces in them. - Made non-debug build the default; DEBUG_XEMACS defaults to 0. - System configuration (EMACS_CONFIGURATION) now correctly - determined at build-time by this makefile. - Compiles the runemacs executable as part of the all target. - -1998-06-29 SL Baur - - * config.h: - * xemacs.mak: NT native sound fixes - From Fabrice POPINEAU via Adrian Aichner - -1998-06-21 Martin Buchholz - - * xemacs.mak: It's XEmacs, not Xemacs! - -1998-06-19 Jonathan Harris - - * file.ico, lisp.ico: - New icons to represent a generic file and a lisp file. - - * xemacs.rc: Build file.ico and lisp.ico into the executable. - -1998-06-15 Peter Windle - - * xemacs.mak: Made XPM and X11 checks cope with case-sensitive - NFS. Also apply Sean MacLennan's change allowing - emacs_beta_version to be undefined. - -1998-06-19 SL Baur - - * xemacs.mak (distclean): Reorder when puresize-adjust.h gets - deleted. - From Adrian Aichner - -1998-06-08 Kirill M. Katsnelson - - * config.h: Undefined DONT_ENCAPSULATE. - Defined ENCAPSULATE_* for fopem, open, rename and mkdir. - Removed MS-DOS code remains. - -1998-06-03 Rick Rankin - - * Makefile.cygwin: created to compile runemacs.c. This should - probably have a Makefile.in, but... - - * runemacs.c: modified to check to see if xemacs is a symbolic - link when compiled under Cygwin. - -1998-05-31 Kirill M. Katsnelson - - * xemacs.mak: Added lib-src/wakeup.exe - -1998-05-30 Kirill M. Katsnelson - - * xemacs.mak: Added rules for hexl.exe, movemail.exe, mmencode.exe - sorted-doc.exe, etags.exe - -1998-05-30 Kirill M. Katsnelson - - * xemacs.mak: Support building InfoDock, with INFODOCK=1 macro - in the command line. - -1998-05-26 Kirill M. Katsnelson - - * inc/sys/dir.h: Removed #ifndef WINDOWSNT around the code which - should be compiled in (sic!). - Removed 'extern' before function prototypes. - -1998-05-20 Kirill M. Katsnelson - - * xemacs.mak: Unified -nologo compiler switch handling and lib-src - programs build (only make-docfile currently, adding other tools - soon). - -1998-05-23 Kirill M. Katsnelson - - * xemacs.mak: Added HAVE_DIALOGS macro, and dialog-*.* files to - docfile creation and compilation. - Defaulted HAVE_MSW to 1. - Changed lib-src references to be relative to $(XEMACS)/, not ../ - -1998-05-16 Kirill M. Katsnelson - - * xemacs.mak: Removed inline.{c,obj}. It did buy nothing. - -1998-05-15 Kirill M. Katsnelson - - * xemacs.mak: Comment out dialog.{c,obj} from build. - -1998-05-11 Jonathan Harris - - * nt/config.h: - Unconditionally define new HAVE_DRAGNDROP. - -1998-05-10 Kirill M. Katsnelson - - * xemacs.mak: Added dragdrop.{c,obj} - -1998-05-08 Kirill M. Katsnelson - - * config.h (enum_field): Redefine to be unsigned int. - -1998-05-07 Kirill M. Katsnelson - - * xemacs.mak: Really honor minimal tagbits, indexed lrecord and - union type. - -1998-05-03 Kirill M. Katsnelson - - * inc/sys/socket.h: Removed encapsulating definitions for Winsock - functions. - -1998-05-04 Kirill M. Katsnelson - - * xemacs.mak: Defined PATH_PROGNAME and PATH_VERSION C macros. - Make _DEBUG defined only when DEBUG_XEMACS. - -1998-04-26 Kirill M. Katsnelson - - * xemacs.mak: Added glyphs-eimage.{c,obj} - -1998-04-20 Kirill M. Katsnelson - - * xemacs.mak: Support "Don't panic, I will restart make" exit code. - Extra checks for externally specified X{PM,11}_DIR. - Proper quoting to allow spaces in these paths. - Conduct all config checks at once. - New option VERBOSECC. When non-zero, C compiler echoes its - commands. When zero, only name of the file being compiled is - echoed. Default is 0 (do not echo). - -1998-04-17 Jonathan Harris - - * README: Documented new msvc build procedure, including XPM - support. - - * xemacs.mak: Added XPM and TOOLBARS support for native msvc - build. - - * xpm.mak: New file - Makefile for building xpm library under msvc. Hopefully this - will be part of future xpm distributions. - -1998-04-10 Kirill M. Katsnelson - - * config.h: Do not USE_ASSERTION when DEBUG_XEMACS is not - defined. - - * xemacs.mak: Added new file process-nt.c - -1998-04-07 Kirill M. Katsnelson - - * xemacs.mak: Added build options which can be defined in nmake - command line (defaults are parentheses): - HAVE_MSW=0/1 (0) Build with native GUI - HAVE_X=0/1 (0) Build with X-Windows - ** At least one must be defined - X11_DIR=path () Path to the root dir of X11R6 installation - ** Must be defined when HAVE_X=1 - HAVE_MULE=0/1 (0) Compile in MULE - HAVE_MSW_C_DIRED=0/1(1) Compile in fast dired - PATH_PACKAGEPATH=path Package search path - ("~/.xemacs") - DEBUG_XEMACS=0/1 (1) Compile with symbols, assertions and - extra debugging checks - USE_UNION_TYPE=0/1 (0) - USE_MINIMAL_TAGBITS=0/1 (0) - USE_INDEXED_LRECORD_IMPLEMENTATION=0/1 (0) - GUNG_HO=0/1 (none) When specified, overrides the above two. - : Added output of a configuration report - : Added copyright notice. - : Deleted remains of ImageMagick. - (distclean): Do not use mskedepend - (install): echo "Not yet implmented". - -1998-04-05 Kirill M. Katsnelson - - * config.h (enum_field): Borrow new definition from config.h.in - -1998-04-01 Kirill M. Katsnelson - - * config.h: Patial sync-up with config.h.in - -1998-03-25 jhar@tardis.ed.ac.uk - - * xemacs.mak: Adds glyphs-msw.c and imgproc.c and reflects - alterations to package_path in nt/xemacs.mak. - -1998-03-24 Kirill M. Katsnelson - - * xemacs.mak (dump-xemacs): Replaced use of `touch' with `echo'. - -1998-03-20 Kirill M. Katsnelson - - * xemacs.mak: Removed all references to deleted dgif_lib.{c,obj}, - gif_err.{c,obj} and gifalloc.{c,obj}. New image support is not - compiled in yet. - -1998-03-19 Kirill M. Katsnelson - - * xemacs.mak: HAVE_FILE_CODING removed: it is no longer an option, - since file I/O depends on it, and defined unconditioanlly in - src/s/windowsnt.h. - Added -nologo switch to different tools here and there. - Suppressed some irrelevant make output. - -1998-02-28 Kirill M. Katsnelson - - * xemacs.mak: Defined HAVE_FILE_CODING variable, an equivalent of - --with-file-coding configure option. Default is yes. - -1998-03-13 Kirill M. Katsnelson - - * xemacs.mak (update-elc): Copy Installation.el to $(LISP) - - * Installation.el: New file, copied by xemacs.mak during build. - -Fri Feb 20 21:22:34 1998 Darryl Okahata - - * xemacs.mak: Added entry for src/dired-msw.c. Use of the - dired-in-C enhancements is optional, and is determined by - HAVE_MSW_C_DIRED. See comments in xemacs.mak. - -1998-02-18 Kirill M. Katsnelson - - * xemacs.mak: Fixed lost docstrings - -1998-01-28 Jonathon Harris - - * xemacs.mak: Updated accordingly. - Creates the MSVC browse info immediately after the link. - -1997-12-29 Kirill M. Katsnelson - - * config.h: Suppressed MSVC warning 'relational' : signed/unsigned - mismatch - - * config.h: INLINE defined to __inline for MSVC compilers >= 2.x - -1997-12-26 Kirill M. Katsnelson - - * xemacs.mak: added menubar-msw.c, menubar.c - - * xemacs.mak: scrollabrs and menubars are rearranged properly - under different ifdef'd secions, so for example menubar.obj goes - to always compiled section, and menubar-msw.obj is built only when - HAVE_MSW. - - * xemacs.mak: Compiler warning flag definition moved to a macro - CPP_WARN_FLAGS. Redefined from -w to -W3 (Doh!). - -1997-12-11 David Hobley - - * Added support for auto generation of puresize-adjust.h - in xemacs.mak. Also created new file puresize-adjust.h to copy - into src on initial build. - -Mon December 08 1997 kkm@kis.ru - - * xemacs.mak: added profile.c, removed event-unixod.c - * xemacs.mak: removed dangerous defines _IX_86, _X86_, - _MSC_VER - * config.h: removed #define HAVE_UNIXOID_EVENT_LOOP - -Thu December 04 1997 jhar@tardis.ed.ac.uk - - * xemacs.mak: Define DEBUG_XEMACS when compiling with debug. - -Tue November 29 12:29:33 1997 davidh - - * xemacs.mak and config.h updated to provide ability to - specify DEBUG mode from the xemacs.mak file. - -Mon December 01 1997 jhar - - * msw-init.el: Provide default bindings for cut, paste, copy and undo - - * event-msw.c, event-msw.h, frame-msw.c, msw-proc.c: - - Implemeted simple emacs_mswindows_event_pending_p(). - - Fixed deleting frames. - - Rewrote timeout code, eliminating "!NILP(rest)" bug. - - Special processing for 'Ctrl-@' keystroke. - - Support for some new keysyms. - -Mon December 01 1997 jhar - - * xemacs.mak: - - Add PACKAGE_PATH and EMACS_BETA_VERSION defines. - - Automatically copy changed include files from \nt to \src. - - Corrected some DOC_SRC* lists. - -Tue November 18 21:45:06 1997 davidh - - * xemacs.mak updated to remove dependency on startup.elc - HAVE_IMAGEMAGICK added for X build. - -Thu September 25 23:06:44 1997 davidh - - * xemacs.mak updated to make the build as simple as typing - nmake -f xemacs.mak. Also support for native gui included - which should mean the w32 directory is no longer required. - - * config.h synced with config.h.in from 20.3-b2 - - * synced in changes to support native gui. - -Thu September 25 23:06:44 1997 davidh - - * August Hill provided a patch to xemacs.mak to greatly simplify - the build - the DOC file gets created correctly. - -Tue September 22 23:06:44 1997 davidh - - * August Hill provided some more patches - to expand ~ correctly - and to correctly deal with drive letters in the path. - - * emacs.c patched to call init_ntproc() - - -Tue July 15 19:32:21 1997 davidh - - * August Hill provided some more patches to make things better - - there is a workaround for dired to make the ^M's disappear - - a patch to fix shell-command - -Tue July 08 22:01:36 1997 davidh - - * #ifdef'd call to vfork and replaced with spawn as per GNU Emacs; - as a result, removed /force - XEmacs now links normally. - -Thu June 31 21:16:21 1997 davidh - - * nt/TODO created. - - * nt/X11.patch created to help with the X build. - - * August Hill provided: - a patch to fix the _WRETCODE undefined symbol, - a patch to fix a problem with dired - - and generally helped clarify the build instructions. - - * Synced with 20.3b10 (Athens). - - * Made DIRECTORY_SEP be '\\'. Until I can change all code to - use the macro, I decided this would be easiest. - - * Modified src/fileio.c to only open files in O_BINARY. This - causes files to be opened and written without automatically - writing ^M 's to the end of each line. MULE ought to sort this - in theory, but I am less than convinced. - - * Updated the nt/README to provide a little more help. - -Thu May 29 23:11:21 1997 davidh - - * Synced with 20.3b2. - - * Removed nt/README.src, nt/src.m.windowsnt.h nt/src.s.windowsnt.h. - - * Updated README from marcpa. - - * Added example Win32.cf and site.def files for X. - - * Added sed.exe into nt/. - - * Modified nt/xemacs.mak to pass correct flags to lwlib compile. - - * Added extra .elc files to ensure make-docfile gets all symbols. - - * Modified balloon_help.c to compile (#if'd max definition) - - * Modified src/event-Xt.c so as not to add signal_event_pipe to - be selected on - this is a hack until I can work out a better - way. Thanks to Ben Wing for help on this. - -Thu Mar 27 20:56:21 1997 marcpa (marcpa at MARCPA) - - * Synced with 20.1b9. - -Sun Mar 16 00:32:15 1997 marcpa (marcpa at MARCPA) - - * lisp/eterm/README.term is truncated: is it just me (because - I'm on NT) or everyone else sees this ? - Answer: it is because it contains a ^Z embedded in it, therefore - it needs to be inserted in binary mode in CVS. - -Thu Mar 13 00:19:25 1997 marcpa (marcpa at MARCPA) - - * At end of compilation, there are some unresolved symbols: - -link.exe @C:\TEMP\nma00115. -sysdep.obj : error LNK2001: unresolved external symbol _vfork -../src/temacs.exe : warning LNK4088: image being generated due to /FORCE -option; image may not run - - -Wed Mar 12 23:18:53 1997 marcpa (marcpa at MARCPA) - - * Need to copy the nt/inc directory David originally submitted or - NT code won't compile. - - * Need to copy nt/{config.h,paths.h,ad2c.sed,xemacs.mak} in src. - - * Had to modify XEmacs sources here and there : see the diffs - between NT_FIRST_COMPILE and V20_1_beta9. - - * Needed to patch X11R6.3 sources: (include/x11/Xmd.h:155) BOOL is - already defined by Windows and is a long, while X wants it to be - an unsigned char. - ---- Xmd.h~ Thu Jun 08 23:20:40 1995 -+++ Xmd.h Sun Mar 16 13:09:10 1997 -@@ -150,8 +150,9 @@ - typedef CARD16 BITS16; - typedef CARD8 BYTE; - -+#ifndef WIN32 - typedef CARD8 BOOL; -- -+#endif - - * cpp.exe not used: cl.exe from VC++4.2 seems to handle everything - properly. - diff --git a/nt/Emacs.ad.h b/nt/Emacs.ad.h deleted file mode 100644 index f45fdd9..0000000 --- a/nt/Emacs.ad.h +++ /dev/null @@ -1,83 +0,0 @@ -(String) "Emacs.modeline*attributeForeground: Black", -(String) "Emacs.modeline*attributeBackground: Gray75", -(String) "Emacs.text-cursor*attributeBackground: Red3", -(String) "*menubar*Foreground: Gray30", -(String) "*menubar*Background: Gray75", -(String) "*menubar*buttonForeground: Blue", -(String) "*XlwMenu*selectColor: ForestGreen", -(String) "*XmToggleButton*selectColor: ForestGreen", -(String) "*popup*Foreground: Black", -(String) "*popup*Background: Gray75", -(String) "*dialog*Foreground: Black", -(String) "*dialog*Background: #A5C0C1", -(String) "*dialog*XmTextField*Background: WhiteSmoke", -(String) "*dialog*XmText*Background: WhiteSmoke", -(String) "*dialog*XmList*Background: WhiteSmoke", -(String) "*dialog*Command*Background: WhiteSmoke", -(String) "*XlwScrollBar*Foreground: Gray30", -(String) "*XlwScrollBar*Background: Gray75", -(String) "*XmScrollBar*Foreground: Gray30", -(String) "*XmScrollBar*Background: Gray75", -(String) "*topToolBarShadowColor: Gray90", -(String) "*bottomToolBarShadowColor: Gray40", -(String) "*backgroundToolBarColor: Gray75", -(String) "*toolBarShadowThickness: 2", -(String) "*menubar*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*popup*Font: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*XmDialogShell*FontList: -*-helvetica-bold-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*XmTextField*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*XmText*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*XmList*FontList: -*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", -(String) "*Dialog*Font: -*-helvetica-bold-r-*-*-*-140-*-*-*-*-iso8859-*", -(String) "*dialog*button1.accelerators:#override\ -Return: ArmAndActivate()\\n\ -KP_Enter: ArmAndActivate()\\n\ -Ctrlm: ArmAndActivate()\\n", -(String) "*XmTextField*translations: #override\\n\ - !osfBackSpace: delete-previous-character()\\n\ - !osfDelete: delete-previous-character()\\n\ - !Ctrlh: delete-previous-character()\\n\ - !Ctrld: delete-next-character()\\n\ - !MetaosfDelete: delete-previous-word()\\n\ - !MetaosfBackSpace: delete-previous-word()\\n\ - !Metad: delete-next-word()\\n\ - !Ctrlk: delete-to-end-of-line()\\n\ - !Ctrlg: process-cancel()\\n\ - !Ctrlb: backward-character()\\n\ - !osfLeft: backward-character()\\n\ - !Ctrlf: forward-character()\\n\ - !osfRight: forward-character()\\n\ - !Metab: backward-word()\\n\ - !MetaosfLeft: backward-word()\\n\ - !Metaf: forward-word()\\n\ - !MetaosfRight: forward-word()\\n\ - !Ctrle: end-of-line()\\n\ - !Ctrla: beginning-of-line()\\n\ - !Ctrlw: cut-clipboard()\\n\ - !Metaw: copy-clipboard()\\n\ - : copy-primary()\\n", -(String) "*dialog*XmPushButton*translations:#override\\n\ - : Arm()\\n\ - ,: Activate()\ - Disarm()\\n\ - (2+): MultiArm()\\n\ - (2+): MultiActivate()\\n\ - : Activate()\ - Disarm()\\n\ - osfSelect: ArmAndActivate()\\n\ - osfActivate: ArmAndActivate()\\n\ - osfHelp: Help()\\n\ - ~Shift ~Meta ~Alt Return: ArmAndActivate()\\n\ - : Enter()\\n\ - : Leave()\\n", -(String) "*ximStyles: XIMPreeditPosition|XIMStatusArea\ - XIMPreeditPosition|XIMStatusNothing\ - XIMPreeditPosition|XIMStatusNone\ - XIMPreeditNothing|XIMStatusArea\ - XIMPreeditNothing|XIMStatusNothing\ - XIMPreeditNothing|XIMStatusNone\ - XIMPreeditNone|XIMStatusArea\ - XIMPreeditNone|XIMStatusNothing\ - XIMPreeditNone|XIMStatusNone", -(String) "*EmacsFrame.ximForeground: black", -(String) "*EmacsFrame.ximBackground: white", diff --git a/nt/PROBLEMS b/nt/PROBLEMS deleted file mode 100644 index 0be8bff..0000000 --- a/nt/PROBLEMS +++ /dev/null @@ -1,177 +0,0 @@ - -*- mode:outline -*- - -This file describes various problems that have been encountered in -running XEmacs on Windows 95, 98 and NT. It has been updated for -XEmacs 21.0. - -This is the first release of XEmacs on Windows. In testing it has -proved to be extremely stable in general use (but see the gnus and -subprocess problems below), but not all features or packages work -correctly yet. - -Use `C-c C-f' to move to the next equal level of outline, and -`C-c C-b' to move to previous equal level. `C-h m' will give more -info about the Outline mode. - -Also, Try finding the things you need using one of the search commands -XEmacs provides (e.g. `C-s'). - -General advice: - Remember your .emacs file! ~\.emacs is your Emacs init file. If - you observe strange problems, invoke XEmacs with the `-q' option - and see if you can repeat the problem. - - -* Problems with running XEmacs -============================== -** Conflicts with FSF NTEmacs - -Depending on how it is installed, FSF NTEmacs may setup various EMACS* -variables in your environment. The presence of these variables may -cause XEmacs to fail at startup, cause you to see corrupted -doc-strings, or cause other random problems. - -You should remove these variables from your environment. These -variables are not required to run FSF NTEmacs if you start it by -running emacs.bat. - -** XEmacs can't find my .emacs file - -XEmacs looks for your .emacs in your "home" directory. XEmacs decides -that your "home" directory is, in order of preference: - -- The value of the HOME environment variable, if the variable exists. -- The value of the HOMEDRIVE and HOMEPATH environment variables, if - these variables both exist. -- The directory that XEmacs was started from. - -** XEmacs can't find any packages - -XEmacs looks for your packages in subdirectories of a directory which -is set at compile-time, and defaults to C:\Program Files\XEmacs. The -variable configure-package-path holds the actual path that was -compiled into your copy of XEmacs. - -The compile-time default location can be overridden by the -EMACSPACKAGEPATH environment variable or by the -SOFTWARE\GNU\XEmacs\EMACSPACKAGEPATH registry entry. You should check -that these variables, if they exist, point to the actual location of -your package tree. - -** XEmacs sometimes crashes when using gnus - -This is a known bug in this release of XEmacs on Windows. - -If you want to use gnus anyway, you should minimize any possible data -loss by saving any modified buffers before you start and ensuring that -you haven't set gnus-use-dribble-file to nil or disabled the normal -XEmacs auto-save mechanism. - -** XEmacs doesn't die when shutting down Windows 95 or 98 - -When shutting down Windows 95 or 98 you may see a dialog that says - "xemacs / You must quit this program before you quit Windows". -It is safe to - "Click OK to quit the program and Windows", -but you won't be offered a chance to save any modified XEmacs buffers. - -* Look and feel -=============== -** Key bindings - -The C-z, C-x, C-c, and C-v keystrokes have traditional uses in both -emacs and Windows programs. XEmacs binds these keys to their -traditional emacs uses, and provides Windows 3.x style bindings for -the Cut, Copy and Paste functions. - - Function XEmacs binding - -------- -------------- - Undo C-_ - Cut C-Insert - Copy C-Insert - Paste Sh-Del - -You can rebind keys to make XEmacs more Windows-compatible; for -example, to bind C-z to undo: - - (global-set-key [(control z)] 'undo) - -Rebindind C-x and C-c is trickier because by default these are prefix -keys in XEmacs. See the "Key Bindings" node in the XEmacs manual. - -** Behaviour of selected regions - -Selected regions behave differently in XEmacs from typical Windows -programs. The pc-select package provides various functions to enable -the standard Windows behaviour for selected regions (eg mark via -shift-arrow, self-inserting deletes region, etc). - -** Limitations on the use of the AltGr key. - -In some locale and OS combinations you can't generate M-AltGr-key or -C-M-AltGr-key sequences at all. - -To generate C-AltGr-key or C-M-AltGr-key sequences you must use the -right-hand Control key and you must press it *after* AltGr. - -These limitations arise from fundamental problems in the way that the -win32 API reports AltGr key events. There isn't anything that XEmacs -can do to work round these problems that it isn't already doing. - -You may want to create alternative bindings if any of the standard -XEmacs bindings require you to use some combination of Control or Meta -and AltGr. - - -* Features not fully supported in this release -============================================== -** Limited support for subprocesses - -Attempting to use call-process to run a 16bit program gives a -"Spawning child process: Exec format error". For example shell-command -fails under Windows 95 and 98 if you use command.com or any other -16bit program as your shell. - -XEmacs may incorrectly quote your call-process command if it contains -double quotes, backslashes or spaces. - -start-process and functions that rely on it are supported under Windows 95, -98 and NT. However, starting a 16bit program that requires keyboard input -may cause XEmacs to hang or crash under Windows 95 and 98, and will leave -the orphaned 16bit program consuming all available CPU time. - -Sending signals to subprocesses started by call-process or by -start-process fails with a "Cannot send signal to process" error under -Windows 95 and 98. As a side effect of this, quitting XEmacs while it -is still running subprocesses causes it to crash under Windows 95 and -98. - -** Changing fonts from the Options menu - -The "Font" and "Size" entries on the Options menu don't work yet. This -will be fixed in a future release. In the meantime, you can either -change face fonts with customize or manually; for example: - - (set-face-font 'default "Lucida Console:Regular:10::Western") - (set-face-font 'modeline "MS Sans Serif:Regular:10::Western") - -Font weight and style and character set must be supplied in English as -above. Common weights and styles are "Regular", "Regular Italic", -"Bold" and "Bold Italic". Common character sets are "Western", -"Central European" and "OEM/DOS". - -Windows 95 only comes with one fixed-width font that is suitable for -use by XEmacs, namely "Courier New". - -** No MULE support - -This release of XEmacs on Windows does not contain MULE support. MULE -support has not been a priority for the XEmacs on Windows developers. - -** Printing - -This release of XEmacs on Windows does not support printing natively. - -You can use the lpr-command and lpr-switches variables to specify an -external print program. - diff --git a/nt/README b/nt/README deleted file mode 100644 index 42c2293..0000000 --- a/nt/README +++ /dev/null @@ -1,156 +0,0 @@ - Building and Installing XEmacs on Windows NT - - David Hobley - Marc Paquette - Jonathan Harris - -The port was made much easier by the groundbreaking work of Geoff Voelker -and others who worked on the GNU Emacs port to NT. Their version is available -from http://www.cs.washington.edu/homes/voelker/ntemacs.html - -To get it working you will need: - -1. You will need Visual C++ V4.0 or later to compile everything. Personally we - have tested V4.0, V4.2 and V5.0. - Note that Visual C++ assumes a couple of environment variables INCLUDE and - LIB to be set which specify the location of the includes and libraries. - Your PATH environment variable also needs to include the DevStudio vc\bin - and sharedide\bin directories. - Visual C++ V5.0 installs a batch file called vcvars32.bat in - c:\Program Files\DevStudio\VC\bin\ (or wherever you installed it) that you - can run before building to set up all of these environment variables. - -2. Grab the latest XEmacs source from ftp.xemacs.org if necessary. All Win32 - support is in the nt\ subdirectory. You'll also need the xemacs-base - package from the binary-packages subdirectory and you'll probably also - want at least the edit-utils, text-modes, fsf-compat, cc-mode, - prog-modes and xemacs-devel packages. - Unpack the packages into, say, "c:\Program Files\XEmacs\xemacs-packages". - -3. At this point you can select X or Win32 native GUI support. - -If you want to build for native GUI: - -1. If you want XPM image and toolbar support grab the latest version of the - xpm sources (xpm-3.4k.tar.gz at time of writing) and unpack them somewhere. - Copy nt\xpm.mak from the xemacs sources to the lib subdirectory of the - xpm sources, cd to that directory and build xpm with 'nmake -f xpm.mak'. - -2. You probably also want PNG image support. Grab the latest versions of zlib - and libpng (zlib-1.1.3 and libpng-1.0.2 at time of writing), unpack them - somewhere and read the respective READMEs for details on how to build them. - The following build procedure works for zlib-1.1.3 and libpng-1.0.2: - - cd to the zlib directory, type 'copy msdos\makefile.w32 Makefile' and - then type 'nmake'. - - cd to the libpng directory, rename or move the zlib directory to ..\zlib - and type 'nmake -f scripts\makefile.w32'. - -3. If you want TIFF support, grap the latest version of libtiff (tiff-v3.4 - at time of writing) and unpack it somewhere. Copy nt\tiff.mak from the - xemacs sources to the contrib\winnt subdirectory of the tiff sources, - cd to that directory and build libtiff with 'nmake -f tiff.mak'. Note: - tiff.mak has only been verified to work under WinNT, not Win95 or 98. - However, the lastest distribution of libtiff includes a - contrib\win95\makefile.w95; that might work. - -4. If you want JPEG support grab the latest version of jpegsrc (jpeg-6b at - time of writing) and read the README for details on how to build it. - -5. cd to the nt subdirectory of the xemacs distribution and build xemacs: - `nmake install -f xemacs.mak`, but read on before hitting Enter. - -6. If you're building with XPM support, add this to the nmake command line: - HAVE_XPM=1 XPM_DIR="x:\location\of\your\xpm\sources" - and similarly for JPEG and TIFF support. - - If you're building with PNG support, add this to the nmake command line: - HAVE_PNG=1 PNG_DIR="x:\location\of\your\png\sources" - ZLIB_DIR="x:\location\of\your\zlib\sources" - - If you want to build with GIF support, add this to the nmake command line: - HAVE_GIF=1 - -7. By default, XEmacs will expect to find its packages in the subdirectories - "site-packages", "mule-packages" and "xemacs-packages" under the package - prefix directory "c:\Program Files\XEmacs". If you want it to look for - these subdirectories elsewhere, add this to the nmake command line: - PACKAGE_PREFIX="x:\your\package\directory" - If you change your mind and want to alter the package prefix directory - after you've built XEmacs, delete the file .\obj\emacs.obj and rebuild with - the new PACKAGE_PREFIX. - -8. By default, XEmacs will be installed in directories under the directory - "c:\Program Files\XEmacs\XEmacs-21.0". If you want to install it elsewhere, - add this to the nmake command line: - INSTALL_DIR="x:\your\installation\directory" - -9. Now you can press Enter. nmake will build temacs, the DOC file, update the - elc's, dump xemacs and install the relevant files in the directories under - the installation directory. Unless you set INSTALL_DIR above, the file that - you should run to start XEmacs will be installed as - "c:\Program Files\XEmacs\XEmacs-21.0\i386-pc-win32\runemacs.exe". You may - want to create a shortcut to that file from your Desktop or Start Menu. - -10. The build process always creates debugging and "Source Browser" information - in the source tree for use with MS DevStudio. If you actually want to debug - XEmacs you should run XEmacs from the source directory instead of from the - installation directory. You should probably also build a debug version of - XEmacs; to do this start with a clean source tree and add DEBUG_XEMACS=1 to - the nmake command line. You probably don't want to install your debug build - so you should tell nmake to build the 'all' target instead of the 'install' - target. - - To make use of the debugging and "Source Browser" information, create a new - "console" project in MS DevStudio and, under Project/Settings, set: - Debug: executable name = full path of src\xemacs.exe - Link: output file name = full path of src\temacs.exe - Browse Info: browse info file name = full path of src\temacs.bsc - Remember to close the Source Browser file in DevStudio before rebuilding. - - -If you want support for X you will need: - -1. An X server. MI/X is available on the Internet for free; It is - available from: http://www.microimages.com/www/html/freestuf/mixdlfrm.htm - -2. The MIT X11R6.3 libraries available from: ftp.x.org - -3. You'll need to compile the MIT libraries without multi-thread support. - To do this, there is an example Win32.cf and site.def provided which - set the relevant flags. You will also need to apply the patch in - nt/X11.patch in the xc/lib/X11 directory which will fix the DLL definition - file. Once compiled and installed, you will need to apply the following - patch to Xmd.h. This is messy and better solutions would be appreciated. - -4. Goto 2 under 'native GUI' above and add this to the nmake command line: - HAVE_X=1 X11_DIR=x:\root\directory\of\your\X11\installation - ---- Xmd.h~ Thu Jun 08 23:20:40 1995 -+++ Xmd.h Sun Mar 16 13:09:10 1997 -@@ -150,8 +150,9 @@ - typedef CARD16 BITS16; - typedef CARD8 BYTE; - -+#ifndef WIN32 - typedef CARD8 BOOL; -- -+#endif - -Known Problems: -Please look at the TODO list for the current list of problems and people -working on them. - -Any other problems you need clarified, please email us and we will endeavour -to provide any assistance we can: - -The XEmacs NT Mailing List: xemacs-nt@xemacs.org -Subscribe address: xemacs-nt-request@xemacs.org - -David Hobley -Marc Paquette -August Hill -Jonathan Harris - -and others. diff --git a/nt/config.h b/nt/config.h deleted file mode 100644 index e012c18..0000000 --- a/nt/config.h +++ /dev/null @@ -1,626 +0,0 @@ -/* XEmacs configuration file for Win32 -*- C -*- - Copyright (C) 1986, 1991, 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: FSF 19.30 (more or less). */ - -/* No code in XEmacs #includes config.h twice, but some of the code - intended to work with other packages as well (like gmalloc.c) - think they can include it as many times as they like. */ -#ifndef _SRC_CONFIG_H_ -#define _SRC_CONFIG_H_ - -#define NTHEAP_PROBE_BASE 1 -#undef LOSING_BYTECODE - -/* Use this to add code in a structured way to FSF-maintained source - files so as to make it obvious where XEmacs changes are. */ -#define XEMACS 1 - -/* Allow s&m files to differentiate OS versions without having - multiple files to maintain. */ -#undef OS_RELEASE - -/* The configuration name. This is used as the install directory name - for the lib-src programs. */ -/* #undef EMACS_CONFIGURATION -- defined in xemacs.mak */ - -/* The configuration options. This is exported to Lisp. */ -#undef EMACS_CONFIG_OPTIONS - -/* The version info from xemacs.mak via version.sh. Used in #pragma ident - in emacs.c */ -#if 0 -#undef EMACS_MAJOR_VERSION -#undef EMACS_MINOR_VERSION -#undef EMACS_BETA_VERSION -#undef EMACS_VERSION -#undef XEMACS_CODENAME -#endif - -/* Make all functions available on AIX. See AC_AIX. */ -#undef _ALL_SOURCE - -/* Used to identify the XEmacs version in stack traces. */ -#undef STACK_TRACE_EYE_CATCHER - -/* Allow the configurer to specify (additional) package directories. */ -/* #undef PACKAGE_PATH */ - -/* Define LISP_FLOAT_TYPE if you want XEmacs to support floating-point - numbers. */ -#undef LISP_FLOAT_TYPE - -/* Define GNU_MALLOC if you want to use the *new* GNU memory allocator. */ -#define GNU_MALLOC - -/* Define USE_SYSTEM_MALLOC if you forcing the use of it. */ -#undef USE_SYSTEM_MALLOC - -/* Define HAVE_TTY if you want TTY support compiled in. */ -#undef HAVE_TTY - -/* Compile in support for the X window system? */ -/* #undef HAVE_X_WINDOWS -- defined in xemacs.mak */ - -/* Defines for building X applications */ -#ifdef HAVE_X_WINDOWS -/* The following will be defined if xmkmf thinks they are necessary */ -#undef SVR4 -#undef SYSV -#undef AIXV3 -#undef _POSIX_SOURCE -#undef _BSD_SOURCE -#undef _GNU_SOURCE -#undef X_LOCALE -#undef NARROWPROTO -/* The following should always be defined, no matter what xmkmf thinks. */ -#ifndef NeedFunctionPrototypes -#define NeedFunctionPrototypes 1 -#endif -#ifndef FUNCPROTO -#define FUNCPROTO 15 -#endif - -/* Define this if you're using XFree386. */ -#undef HAVE_XFREE386 - -#undef THIS_IS_X11R4 -#undef THIS_IS_X11R5 -#define THIS_IS_X11R6 - -/* Define HAVE_XPM if you have the `xpm' library and want XEmacs to use it. */ -#undef HAVE_XPM - -/* Define HAVE_XFACE if you have the `compface' library and want to use it. - This will permit X-face pixmaps in mail and news messages to display - quickly. */ -#undef HAVE_XFACE - -/* #define HAVE_IMAGEMAGICK */ - -/* Define HAVE_XMU if you have the Xmu library. This should always be - the case except on losing HPUX systems. */ -#define HAVE_XMU - -/* Define HAVE_XAUTH if the Xauth library is present. This will add - some extra functionality to gnuserv. */ -#undef HAVE_XAUTH - -/* Define HAVE_XLOCALE_H if X11/Xlocale.h is present. */ -#define HAVE_XLOCALE_H -#define HAVE_UNIXOID_EVENT_LOOP - -#endif /* HAVE_X_WINDOWS */ - -/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_NEXTSTEP) || defined (HAVE_MS_WINDOWS) -#define HAVE_WINDOW_SYSTEM -#endif - - - -/* Define USER_FULL_NAME to return a string - that is the user's full name. - It can assume that the variable `pw' - points to the password file entry for this user. - - At some sites, the pw_gecos field contains - the user's full name. If neither this nor any other - field contains the right thing, use pw_name, - giving the user's login name, since that is better than nothing. */ -#define USER_FULL_NAME pw->pw_gecos - -/* Define AMPERSAND_FULL_NAME if you use the convention - that & in the full name stands for the login id. */ -#undef AMPERSAND_FULL_NAME - -/* Some things figured out by the configure script, grouped as they are in - configure.in. */ -#undef HAVE_MACH_MACH_H -#undef HAVE_SYS_STROPTS_H -#undef HAVE_SYS_TIMEB_H -#undef HAVE_UNISTD_H -#undef HAVE_UTIME_H -#undef HAVE_SYS_WAIT_H -#undef HAVE_LIBGEN_H -#undef HAVE_LINUX_VERSION_H -#undef WORDS_BIGENDIAN -#undef TIME_WITH_SYS_TIME - -#define HAVE_SYS_TIME_H -#define HAVE_LOCALE_H -#ifdef HAVE_X_WINDOWS -#define HAVE_X11_LOCALE_H -#endif -#define STDC_HEADERS -#define HAVE_LIMITS_H -#define HAVE_GETCWD - -#define HAVE_LONG_FILE_NAMES - -#undef HAVE_LIBKSTAT -#undef HAVE_LIBINTL -#undef HAVE_LIBDNET -#undef HAVE_LIBRESOLV - -/* Define if `sys_siglist' is declared by . */ -#undef SYS_SIGLIST_DECLARED - -/* Define if `struct utimbuf' is declared by . */ -#undef HAVE_STRUCT_UTIMBUF - -/* Define if `struct timeval' is declared by . */ -#define HAVE_TIMEVAL - -#undef TM_IN_SYS_TIME -#undef HAVE_TM_ZONE -#undef HAVE_TZNAME - -/* Define if netdb.h declares h_errno. */ -#undef HAVE_H_ERRNO - -/* Define if localtime caches TZ */ -#undef LOCALTIME_CACHE - -/* Define if gettimeofday can't accept two arguments */ -#ifdef HAVE_X_WINDOWS -#define GETTIMEOFDAY_ONE_ARGUMENT -#else -#undef GETTIMEOFDAY_ONE_ARGUMENT -#endif - -/* Is the timezone variable already declared in system headers? */ -#undef HAVE_TIMEZONE_DECL - -#undef HAVE_MMAP -#undef HAVE_STRCOLL -#undef HAVE_GETPGRP -#undef GETPGRP_VOID - -#undef SIZEOF_SHORT -#undef SIZEOF_INT -#undef SIZEOF_LONG -#undef SIZEOF_LONG_LONG -#undef SIZEOF_VOID_P - -#undef HAVE_ACOSH -#undef HAVE_ASINH -#undef HAVE_ATANH - -#if defined (HAVE_ACOSH) && defined (HAVE_ASINH) && defined (HAVE_ATANH) -#define HAVE_INVERSE_HYPERBOLIC -#endif - -#undef HAVE_CBRT -#define HAVE_CLOSEDIR -#undef HAVE_DUP2 -#undef HAVE_EACCESS -#undef HAVE_FMOD -#undef HAVE_FPATHCONF -#undef HAVE_FREXP -#undef HAVE_FTIME -#undef HAVE_GETHOSTNAME -#undef HAVE_GETPAGESIZE -#define HAVE_GETTIMEOFDAY -#define HAVE_GETWD -#undef HAVE_LOGB -#undef HAVE_LRAND48 -#undef HAVE_MATHERR -#undef HAVE_MKDIR -#undef HAVE_MKTIME -#undef HAVE_PERROR -#undef HAVE_POLL -#undef HAVE_RANDOM -#undef HAVE_REALPATH -#undef HAVE_RENAME -#undef HAVE_RES_INIT -#undef HAVE_RINT -#undef HAVE_RMDIR -#define HAVE_SELECT -#undef HAVE_SETITIMER -#undef HAVE_SETPGID -#undef HAVE_SETSID -#undef HAVE_SIGBLOCK -#undef HAVE_SIGHOLD -#undef HAVE_SIGPROCMASK -#undef HAVE_SIGSETJMP -#undef HAVE_STRCASECMP -#define HAVE_STRERROR -#undef HAVE_TZSET -#undef HAVE_UTIMES -#undef HAVE_WAITPID - -#define HAVE_SOCKETS -#undef HAVE_SOCKADDR_SUN_LEN -#undef HAVE_SYSVIPC - -#undef SYSV_SYSTEM_DIR -#undef NONSYSTEM_DIR_LIBRARY - -#undef HAVE_TERMIOS -#undef HAVE_TERMIO - -#undef NLIST_STRUCT - -/* Define HAVE_SOCKS if you have the `socks' library and want XEmacs to - use it. */ -#undef HAVE_SOCKS - -/* Define HAVE_TERM if you run the `term' program (e.g. under Linux) and - want XEmacs to use it. */ -#undef HAVE_TERM - -/* Define HAVE_DBM if you want to use the DBM libraries */ -#undef HAVE_DBM - -/* Define HAVE_BERKELEY_DB if you want to use the BerkDB libraries */ -#undef HAVE_BERKELEY_DB -/* Full #include file path for Berkeley DB's db.h */ -#undef DB_H_PATH - -#if defined (HAVE_DBM) || defined (HAVE_BERKELEY_DB) -# define HAVE_DATABASE -#endif - -/* Define HAVE_NCURSES if -lncurses is present. */ -#undef HAVE_NCURSES -/* Full #include file paths for ncurses' curses.h and term.h. */ -#undef CURSES_H_PATH -#undef TERM_H_PATH - -#define LOWTAGS - -#ifdef DEBUG_XEMACS - -/* Define USE_ASSERTIONS if you want the abort() to be changed to assert() - If the assertion fails, assert_failed() will be called. This is - recommended for general use because it gives more info about the crash - than just the abort() message. Too many people "Can't find the corefile" - or have limited core dumps out of existence. */ -#define USE_ASSERTIONS - -/* Check the entire extent structure of a buffer each time an extent - change is done, and do other extent-related checks. */ -#define ERROR_CHECK_EXTENTS - -/* Make sure that all X... macros are dereferencing the correct type, - and that all XSET... macros (as much as possible) are setting the - correct type of structure. Highly recommended for all - development work. */ -#define ERROR_CHECK_TYPECHECK -/* Make sure valid buffer positions are passed to BUF_* macros. */ -#define ERROR_CHECK_BUFPOS -/* Attempt to catch bugs related to garbage collection (e.g. - insufficient GCPRO'ing). */ -#define ERROR_CHECK_GC -/* Attempt to catch freeing of a non-malloc()ed block, heap corruption, - etc. */ -#define ERROR_CHECK_MALLOC - -#endif /* DEBUG_XEMACS */ - -/* Define MEMORY_USAGE_STATS if you want extra code compiled in to - determine where XEmacs's memory is going. */ -#undef MEMORY_USAGE_STATS - -/* Define QUANTIFY if using Quantify from Pure Software. This adds - some additional calls to control data collection. This is only - intended for use by the developers. */ -#undef QUANTIFY - -/* Define EXTERNAL_WIDGET to compile support for using the editor as a - widget in another program. */ -#undef EXTERNAL_WIDGET - -/* There are some special-case defines for gcc and lcc. */ -#undef USE_GCC -#undef USE_LCC - -/* Allow the user to override the default value of PURESIZE at configure - time. This must come before we include the sys files in order for - it to be able to override any changes in them. */ -#undef RAW_PURESIZE - -/* Define this if you want level 2 internationalization compliance - (localized collation and formatting). Generally this should be - defined, unless your system doesn't have the strcoll() and - setlocale() library routines. This really should be (NOT! -mrb) - defined in the appropriate s/ or m/ file. */ -#undef I18N2 - -/* Define this if you want level 3 internationalization compliance - (localized messaging). This will cause a small runtime performance - penalty, as the strings are read from the message catalog(s). - For this you need the gettext() and dgetext() library routines. - WARNING, this code is under construction. */ -#undef I18N3 - -/* Compile in support for CDE (Common Desktop Environment) drag and drop? - Requires libDtSvc, which typically must be present at runtime. */ -#undef HAVE_CDE - -/* Compile in support for OffiX Drag and Drop? */ -#undef HAVE_OFFIX_DND - -/* Compile in generic Drag'n'Drop API */ -#define HAVE_DRAGNDROP - -/* Compile in support for proper session-management. */ -#undef HAVE_SESSION - -/* Define this if you want Mule support (multi-byte character support). - There may be some performance penalty, although it should be small - if you're working with ASCII files. */ -/* #undef MULE */ - -#ifdef MULE -/* Do we want to use X window input methods for use with Mule? (requires X11R5) - If so, use raw Xlib or higher level Motif interface? */ -#undef HAVE_XIM -#undef XIM_XLIB -#undef XIM_MOTIF - -/* Non-XIM input methods for use with Mule. */ -#undef HAVE_CANNA -#undef HAVE_WNN -#undef WNN6 - -#endif - -/* enable special GNU Make features in the Makefiles. */ -#undef USE_GNU_MAKE - -/* Undocumented debugging option: Don't automatically rebuild the DOC - file. This saves a lot of time when you're repeatedly - compiling-running-crashing. */ -#undef NO_DOC_FILE - -#define CONST const - -/* If not defined, use unions instead of ints. A few systems (DEC Alpha) - seem to require this, probably because something with the int - definitions isn't right with 64-bit systems. - - (It's NO_UNION_TYPE instead of USE_UNION_TYPE for historical reasons.) -*/ -#undef NO_UNION_TYPE - -/* The configuration script defines opsysfile to be the name of the - s/...h file that describes the system type you are using. The file - is chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of systems and the - configuration names to use for them. - - See s/template.h for documentation on writing s/...h files. */ -#include "s/windowsnt.h" - -/* The configuration script defines machfile to be the name of the - m/...h file that describes the machine you are using. The file is - chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of machines and the - configuration names to use for them. - - See m/template.h for documentation on writing m/...h files. */ -#include "m/windowsnt.h" - -#if defined (USE_SYSTEM_MALLOC) && !defined (SYSTEM_MALLOC) -#define SYSTEM_MALLOC -#endif - -/* Define REL_ALLOC if you want to use the relocating allocator for - buffer space. */ -#undef REL_ALLOC - -/* Define the return type of signal handlers if the s-xxx file - did not already do so. */ -#define RETSIGTYPE void - -/* SIGTYPE is the macro we actually use. */ -#ifndef SIGTYPE -#define SIGTYPE RETSIGTYPE -#define SIGRETURN return -#endif - -/* Allow the source to use standard types */ -#undef size_t -#undef pid_t -#undef mode_t -#undef off_t -#undef uid_t -#undef gid_t - -/* Define DYNODUMP if it is necessary to properly dump on this system. - Currently this is only Solaris. */ -#undef DYNODUMP - -/* Define SUNPRO to compiled in support for Sun Sparcworks. */ -#undef SUNPRO - -/* Sun SparcStations, SGI machines, and HP9000s700s have support for playing - different sound files as beeps. If you are on a SparcStation but do not - have the sound option installed for some reason, then undefine - HAVE_NATIVE_SOUND. (It's usually found in /usr/demo/SOUND/ on SunOS 4 - and Solaris systems; on Solaris, you may need to install the "SUNWaudmo" - package.) - */ -/* #undef HAVE_NATIVE_SOUND */ - -/* If you wish to compile with support for the Network Audio System - system define HAVE_NAS_SOUND. - NAS_NO_ERROR_JUMP means that the NAS libraries don't inlcude some - error handling changes. - */ -#undef HAVE_NAS_SOUND -#undef NAS_NO_ERROR_JUMP - -/* Compile in support for SunPro usage-tracking code. */ -#undef USAGE_TRACKING - -/* Define TOOLTALK if your site supports the ToolTalk library. */ -#undef TOOLTALK - -#ifdef HAVE_X_WINDOWS - -#undef LWLIB_USES_MOTIF -#define LWLIB_MENUBARS_LUCID -#undef LWLIB_MENUBARS_MOTIF -#define LWLIB_SCROLLBARS_LUCID -#undef LWLIB_SCROLLBARS_MOTIF -#undef LWLIB_SCROLLBARS_ATHENA -#undef LWLIB_DIALOGS_MOTIF -#define LWLIB_DIALOGS_ATHENA - -/* Other things that can be disabled by configure. */ -#define HAVE_MENUBARS -#define HAVE_SCROLLBARS -#define HAVE_DIALOGS -#undef HAVE_TOOLBARS - -#endif - -#if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS) -#define HAVE_POPUPS -#endif - -/* If you are using SunOS 4.1.1 and X11r5, then you need this patch. - There is a stupid bug in the SunOS libc.a: two functions which X11r5 - uses, mbstowcs() and wcstombs(), are unusable when programs are - statically linked (as XEmacs must be) because the static version of - libc.a contains the *dynamic* versions of these functions. These - functions don't seem to be called when XEmacs is running, so it's - enough to define stubs for them. - - This appears to be fixed in SunOS 4.1.2. - - Also, SunOS 4.1.1 contains buggy versions of strcmp and strcpy that - sometimes reference memory past the end of the string, which can segv. - I don't know whether this is has been fixed as of 4.1.2 or 4.1.3. - */ -#if defined (sparc) && !defined (USG) -#define OBJECTS_SYSTEM sunOS-fix.o strcmp.o strcpy.o -#endif - -/* If you turn this flag on, it forces encapsulation in all -circumstances; this can be used to make sure things compile OK -on various systems. */ -#undef DEBUG_ENCAPSULATION - -/* System calls that are encapsulated */ -#define ENCAPSULATE_RENAME -#define ENCAPSULATE_OPEN -#define ENCAPSULATE_FOPEN -#define ENCAPSULATE_MKDIR - -#if defined (WIN32) && defined (USE_IME) -#define HAVE_FEP -#endif - -#if defined (HAVE_SOCKS) && !defined (DO_NOT_SOCKSIFY) -#define accept Raccept -#define bind Rbind -#define connect Rconnect -#define getsockname Rgetsockname -#define listen Rlisten -#endif /* HAVE_SOCKS && !DO_NOT_SOCKSIFY */ - -#ifndef BITS_PER_CHAR -#define BITS_PER_CHAR 8 -#endif -#define SHORTBITS (SIZEOF_SHORT * BITS_PER_CHAR) -#define INTBITS (SIZEOF_INT * BITS_PER_CHAR) -#define LONGBITS (SIZEOF_LONG * BITS_PER_CHAR) -#define LONG_LONG_BITS (SIZEOF_LONG_LONG * BITS_PER_CHAR) -#define VOID_P_BITS (SIZEOF_VOID_P * BITS_PER_CHAR) - -/* MSVC version >= 2.x without /Za supports __inline */ -#if (_MSC_VER < 900) || defined(__STDC__) -# define INLINE static -#else -# define INLINE __inline -#endif - -/* MSVC warnings no-no crap. When adding one to this section, - 1. Think twice - 2. Insert textual description of the warning. - 3. Think twice. Undo still works */ -#if (_MSC_VER >= 800) - -/* 'expression' : signed/unsigned mismatch */ -#pragma warning ( disable : 4018 ) - -#endif /* compiler understands #pragma warning*/ - -#define enum_field(enumeration_type) unsigned int - -/* We want to avoid saving the signal mask if possible, because - that necessitates a system call. */ -#ifdef HAVE_SIGSETJMP -# define SETJMP(x) sigsetjmp (x, 0) -# define LONGJMP(x, y) siglongjmp (x, y) -# define JMP_BUF sigjmp_buf -#else -# define SETJMP(x) setjmp (x) -# define LONGJMP(x, y) longjmp (x, y) -# define JMP_BUF jmp_buf -#endif - -/* movemail options */ -/* Should movemail use POP3 for mail access? */ -/* #undef MAIL_USE_POP */ -/* Should movemail use kerberos for POP authentication? */ -#undef KERBEROS -/* Should movemail use hesiod for getting POP server host? */ -#undef HESIOD -/* Determine type of mail locking. */ -/* Play preprocessor games so that configure options override s&m files */ -#undef REAL_MAIL_USE_LOCKF -#undef REAL_MAIL_USE_FLOCK -#undef MAIL_USE_LOCKF -#undef MAIL_USE_FLOCK -#ifdef REAL_MAIL_USE_FLOCK -#define MAIL_USE_FLOCK -#endif -#ifdef REAL_MAIL_USE_LOCKF -#define MAIL_USE_LOCKF -#endif - -#endif /* _SRC_CONFIG_H_ */ diff --git a/nt/minitar.c b/nt/minitar.c deleted file mode 100644 index 4d89875..0000000 --- a/nt/minitar.c +++ /dev/null @@ -1,211 +0,0 @@ - -/* Minitar: extract .tar.gz files on Win32 platforms. - Uses zlib for decompression. - - This is very simple-minded, it ignores checksums, and any type of file - that is not a plain file or a directory. Nonetheless it is useful. - - Author: Charles G. Waldman (cgw@pgt.com), Aug 4 1998 - - This file is placed in the public domain; you can - do whatever you like with it. There is NO WARRANTY. - If it breaks, you get to keep both pieces */ - - -#include -#include - -#include - -Usage(char *name) -{ - fprintf(stderr,"Usage: %s file.tar.gz [base-dir]\n",name); - fprintf(stderr,"\tExtracts the contents compressed tar file to base-dir\n"); - exit(-1); -} - - -#define BLOCKSIZE 512 -#define MAXNAMELEN 1024 - -int octal(char *str) -{ - int ret = -1; - sscanf(str,"%o",&ret); - return ret; -} - -/* this is like mkdir -p, except if there is no trailing slash, - the final component is assumed to be a file, rather than a - path component, so it is not created as a directory */ - -int makepath(char *path) -{ - char tmp[MAXNAMELEN]; - char *cp; - extern int errno; - - for (cp=path; cp; cp = (char*)strchr(cp+1,'/')){ - if (!*cp) - break; - if (*cp != '/') - continue; - strncpy(tmp, path, cp-path); - tmp[cp-path] = '\0'; - if (strlen(tmp) == 0) - continue; - if (mkdir(tmp,0777)){ - if (errno == EEXIST) - continue; - else - return -1; - } - } - return 0; -} - - - - -main(int argc, char **argv) -{ - char fullname[MAXNAMELEN]; - char *basedir = "."; - char *tarfile; - char *cp; - int size; - char osize[13]; - char name[101]; - char magic[7]; - char type; - - gzFile *infile = (gzFile*)0; - FILE *outfile = (FILE*)0; - - char block[BLOCKSIZE]; - int nbytes, nread, nwritten; - - int in_block = 0; - int directory = 0; - - if (argc < 2 || argc > 3) - Usage(argv[0]); - - tarfile = argv[1]; - if (argc==3) - basedir = argv[2]; - - if (! (infile = gzopen(tarfile,"rb"))){ - fprintf(stderr,"Cannot open %s\n", tarfile); - exit(-2); - } - - while (1){ - - - nread = gzread(infile,block,512); - - if (!in_block && nread == 0) - break; - - if (nread != BLOCKSIZE){ - fprintf(stderr,"Error: incomplete block read. Exiting.\n"); - exit(-2); - } - - if (!in_block){ - if (block[0]=='\0') /* We're done */ - break; - - strncpy(magic,block+257,6); - magic[6] = '\0'; - if (strcmp(magic,"ustar ")){ - fprintf(stderr, - "Error: incorrect magic number in tar header. Exiting\n"); - } - - strncpy(name,block,100); - name[100] = '\0'; - sprintf(fullname,"%s/%s",basedir,name); - printf("%s\n",fullname); - type = block[156]; - - switch(type){ - case '0': - case '\0': - directory = 0; - break; - case '5': - directory = 1; - break; - default: - fprintf(stderr,"Error: unknown type flag %c. Exiting.\n",type); - break; - } - - if (directory){ - in_block = 0; - - /* makepath will ignore the final path component, so make sure - dirnames have a trailing slash */ - - if (fullname[strlen(fullname)-1] != '/') - strcat(fullname,"/"); - if (makepath(fullname)){ - fprintf(stderr, "Error: cannot create directory %s. Exiting.\n", - fullname); - exit(-2); - } - continue; - } else { /*file */ - in_block = 1; - if (outfile){ - if (fclose(outfile)){ - fprintf(stderr,"Error: cannot close file %s. Exiting.\n", - fullname); - exit(-2); - } - outfile = (FILE*)0; - } - - if ( !(outfile = fopen(fullname,"wb"))){ - /*try creating the directory, maybe it's not there */ - if (makepath(fullname)){ - fprintf(stderr,"Error: cannot create file %s. Exiting.\n", - fullname); - exit(-2); - } - /* now try again to open the file */ - if (!(outfile = fopen(fullname,"wb"))){ - fprintf(stderr,"Error: cannot create file %s. Exiting.\n", - fullname); - exit(-2); - } - } - - strncpy(osize,block+124,12); - osize[12] = '\0'; - size = octal(osize); - if (size<0){ - fprintf(stderr,"Error: invalid size in tar header. Exiting.\n"); - exit(-2); - } - } - } else { /* write or continue writing file contents */ - nbytes = size>512? 512:size; - - nwritten = fwrite(block, 1, nbytes, outfile); - if (nwritten != nbytes){ - fprintf(stderr, "Error: only wrote %d bytes to file %s. Exiting.\n", - nwritten, fullname); - } - size -= nbytes; - if (size==0) - in_block = 0; - } - } -} - - - - diff --git a/nt/minitar.mak b/nt/minitar.mak deleted file mode 100644 index 6218f56..0000000 --- a/nt/minitar.mak +++ /dev/null @@ -1,10 +0,0 @@ -ZLIB=\path\to\zlib - -all: minitar.exe - -minitar.exe: minitar.obj - cl -o minitar.exe minitar.obj $(ZLIB)\zlib.lib - -minitar.obj: minitar.c - cl -c minitar.c -I $(ZLIB) - diff --git a/nt/xemacs.mak b/nt/xemacs.mak deleted file mode 100644 index 4743085..0000000 --- a/nt/xemacs.mak +++ /dev/null @@ -1,1082 +0,0 @@ -# Makefile for Microsoft NMAKE -# Copyright (C) 1995 Board of Trustees, University of Illinois. -# Copyright (C) 1995, 1996 Ben Wing. -# Copyright (C) 1995 Sun Microsystems, Inc. -# Copyright (C) 1998 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. -# - -XEMACS=.. -LISP=$(XEMACS)\lisp -MODULES=$(XEMACS)\modules -NT=$(XEMACS)\nt - -# Program name and version - -!include "..\version.sh" - -!if !defined(INFODOCK) -INFODOCK=0 -!endif - -!if $(INFODOCK) -INFODOCK_VERSION_STRING=$(infodock_major_version).$(infodock_minor_version).$(infodock_build_version) -PROGRAM_DEFINES=-DINFODOCK \ - -DPATH_VERSION=\"$(INFODOCK_VERSION_STRING)\" \ - -DPATH_PROGNAME=\"infodock\" \ - -DINFODOCK_MAJOR_VERSION=$(infodock_major_version) \ - -DINFODOCK_MINOR_VERSION=$(infodock_minor_version) \ - -DINFODOCK_BUILD_VERSION=$(infodock_build_version) -!else -!if "$(emacs_beta_version)" != "" -XEMACS_VERSION_STRING=$(emacs_major_version).$(emacs_minor_version)-b$(emacs_beta_version) -!else -XEMACS_VERSION_STRING=$(emacs_major_version).$(emacs_minor_version) -!endif -PROGRAM_DEFINES= \ - -DPATH_VERSION=\"$(XEMACS_VERSION_STRING)\" \ - -DPATH_PROGNAME=\"xemacs\" -!endif - -# -# Command line options defaults -# -!if !defined(INSTALL_DIR) -! if $(INFODOCK) -INSTALL_DIR=c:\Program Files\Infodock\Infodock-$(INFODOCK_VERSION_STRING) -! else -INSTALL_DIR=c:\Program Files\XEmacs\XEmacs-$(XEMACS_VERSION_STRING) -! endif -!endif -!if !defined(PACKAGE_PATH) -! if !defined(PACKAGE_PREFIX) -PACKAGE_PREFIX=c:\Program Files\XEmacs -! endif -PACKAGE_PATH=~\.xemacs;;$(PACKAGE_PREFIX)\site-packages;$(PACKAGE_PREFIX)\mule-packages;$(PACKAGE_PREFIX)\xemacs-packages -!endif -PATH_PACKAGEPATH="$(PACKAGE_PATH:\=\\)" -!if !defined(HAVE_MSW) -HAVE_MSW=1 -!endif -!if !defined(HAVE_X) -HAVE_X=0 -!endif -!if !defined(HAVE_MULE) -HAVE_MULE=0 -!endif -!if !defined(HAVE_XPM) -HAVE_XPM=0 -!endif -!if !defined(HAVE_PNG) -HAVE_PNG=0 -!endif -!if !defined(HAVE_TIFF) -HAVE_TIFF=0 -!endif -!if !defined(HAVE_JPEG) -HAVE_JPEG=0 -!endif -!if !defined(HAVE_GIF) -HAVE_GIF=1 -!endif -!if !defined(HAVE_TOOLBARS) -HAVE_TOOLBARS=$(HAVE_XPM) -!endif -!if !defined(HAVE_DIALOGS) -HAVE_DIALOGS=1 -!endif -!if !defined(HAVE_MSW_C_DIRED) -HAVE_MSW_C_DIRED=1 -!endif -!if !defined(HAVE_NATIVE_SOUND) -HAVE_NATIVE_SOUND=1 -!endif -!if !defined(DEBUG_XEMACS) -DEBUG_XEMACS=0 -!endif -!if !defined(USE_UNION_TYPE) -USE_UNION_TYPE=0 -!endif -!if !defined(USE_MINIMAL_TAGBITS) -USE_MINIMAL_TAGBITS=0 -!endif -!if !defined(USE_INDEXED_LRECORD_IMPLEMENTATION) -USE_INDEXED_LRECORD_IMPLEMENTATION=0 -!endif - -# -# System configuration -# -!if !defined(PROCESSOR_ARCHITECTURE) && "$(OS)" != "Windows_NT" -EMACS_CONFIGURATION=i586-pc-win32 -!else if "$(PROCESSOR_ARCHITECTURE)" == "x86" -EMACS_CONFIGURATION=i586-pc-win32 -!else if "$(PROCESSOR_ARCHITECTURE)" == "MIPS" -EMACS_CONFIGURATION=mips-pc-win32 -!else if "$(PROCESSOR_ARCHITECTURE)" == "ALPHA" -EMACS_CONFIGURATION=alpha-pc-win32 -!else if "$(PROCESSOR_ARCHITECTURE)" == "PPC" -EMACS_CONFIGURATION=ppc-pc-win32 -!else -! error Unknown processor architecture type $(PROCESSOR_ARCHITECTURE) -!endif - -# -# Conf error checks -# -CONFIG_ERROR=0 -!if $(INFODOCK) && !exist("..\..\Infodock.rules") -!message Cannot build InfoDock without InfoDock sources -CONFIG_ERROR=1 -!endif -!if !$(HAVE_MSW) && !$(HAVE_X) -!message Please specify at least one HAVE_MSW=1 and/or HAVE_X=1 -CONFIG_ERROR=1 -!endif -!if $(HAVE_X) && !defined(X11_DIR) -!message Please specify root directory for your X11 installation: X11_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_X) && defined(X11_DIR) && !exist("$(X11_DIR)\LIB\X11.LIB") -!message Specified X11 directory does not contain "$(X11_DIR)\LIB\X11.LIB" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_XPM) && !defined(XPM_DIR) -!message Please specify root directory for your XPM installation: XPM_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_XPM) && defined(XPM_DIR) && !exist("$(XPM_DIR)\lib\Xpm.lib") -!message Specified XPM directory does not contain "$(XPM_DIR)\lib\Xpm.lib" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_PNG) && !defined(PNG_DIR) -!message Please specify root directory for your PNG installation: PNG_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_PNG) && defined(PNG_DIR) && !exist("$(PNG_DIR)\libpng.lib") -!message Specified PNG directory does not contain "$(PNG_DIR)\libpng.lib" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_PNG) && !defined(ZLIB_DIR) -!message Please specify root directory for your ZLIB installation: ZLIB_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_PNG) && defined(ZLIB_DIR) && !exist("$(ZLIB_DIR)\zlib.lib") -!message Specified ZLIB directory does not contain "$(ZLIB_DIR)\zlib.lib" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_TIFF) && !defined(TIFF_DIR) -!message Please specify root directory for your TIFF installation: TIFF_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_TIFF) && !exist("$(TIFF_DIR)\libtiff\libtiff.lib") -!message Specified TIFF directory does not contain "$(TIFF_DIR)\libtiff\libtiff.lib" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_JPEG) && !defined(JPEG_DIR) -!message Please specify root directory for your JPEG installation: JPEG_DIR=path -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_JPEG) && !exist("$(JPEG_DIR)\libjpeg.lib") -!message Specified JPEG directory does not contain "$(JPEG_DIR)\libjpeg.lib" -CONFIG_ERROR=1 -!endif -!if $(HAVE_MSW) && $(HAVE_TOOLBARS) && !$(HAVE_XPM) -!error Toolbars require XPM support -CONFIG_ERROR=1 -!endif -!if $(CONFIG_ERROR) -!error Configuration error(s) found -!endif - -# -# Handle GUNG_HO -# -!if defined(GUNG_HO) -USE_MINIMAL_TAGBITS=$(GUNG_HO) -USE_INDEXED_LRECORD_IMPLEMENTATION=$(GUNG_HO) -!endif - -# -# Small configuration report -# -!if !defined(CONF_REPORT_ALREADY_PRINTED) -!if [set CONF_REPORT_ALREADY_PRINTED=1] -!endif -!message ------------------------------------------------ -!message XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename) configured for "$(EMACS_CONFIGURATION)". -!message -!message Installation directory is "$(INSTALL_DIR)". -!message Package path is "$(PACKAGE_PATH)". -!message -!if $(INFODOCK) -!message Building InfoDock. -!endif -!if $(HAVE_MSW) -!message Compiling in support for native GUI. -!endif -!if $(HAVE_X) -!message Compiling in support for X-Windows. -!endif -!if $(HAVE_MULE) -!message Compiling in MULE. -!endif -!if $(HAVE_XPM) -!message Compiling in support for XPM images. -!endif -!if $(HAVE_GIF) -!message Compiling in support for GIF images. -!endif -!if $(HAVE_PNG) -!message Compiling in support for PNG images. -!endif -!if $(HAVE_TIFF) -!message Compiling in support for TIFF images. -!endif -!if $(HAVE_JPEG) -!message Compiling in support for JPEG images. -!endif -!if $(HAVE_TOOLBARS) -!message Compiling in support for toolbars. -!endif -!if $(HAVE_DIALOGS) -!message Compiling in support for dialogs. -!endif -!if $(HAVE_NATIVE_SOUND) -!message Compiling in support for native sounds. -!endif -!if $(HAVE_MSW_C_DIRED) -# Define HAVE_MSW_C_DIRED to be non-zero if you want XEmacs to use C -# primitives to significantly speed up dired, at the expense of an -# additional ~4KB of code. -!message Compiling in fast dired implementation. -!endif -!if $(USE_MINIMAL_TAGBITS) -!message Using minimal tagbits. -!endif -!if $(USE_INDEXED_LRECORD_IMPLEMENTATION) -!message Using indexed lrecord implementation. -!endif -!if $(USE_UNION_TYPE) -!message Using union type for Lisp object storage. -!endif -!if $(DEBUG_XEMACS) -!message Compiling in extra debug checks. XEmacs will be slow! -!endif -!message ------------------------------------------------ -!message -!endif # !defined(CONF_REPORT_ALREADY_PRINTED) - -# -# Compiler command echo control. Define VERBOSECC=1 to get vebose compilation. -# -!if !defined(VERBOSECC) -VERBOSECC=0 -!endif -!if $(VERBOSECC) -CCV=$(CC) -!else -CCV=@$(CC) -!endif - -!if $(DEBUG_XEMACS) -OPT=-Od -Zi -!else -OPT=-O2 -G5 -Zi -!endif - -CFLAGS=-nologo -W3 $(OPT) - -!if $(HAVE_X) -X_DEFINES=-DHAVE_X_WINDOWS -X_INCLUDES=-I$(X11_DIR)\include -X_LIBS=-libpath:$(X11_DIR)\lib Xaw.lib Xmu.lib Xt.lib SM.lib ICE.lib Xext.lib X11.lib -!endif - -!if $(HAVE_MSW) -MSW_DEFINES=-DHAVE_MS_WINDOWS -DHAVE_SCROLLBARS -DHAVE_MENUBARS -MSW_INCLUDES= -MSW_LIBS= -!if $(HAVE_MSW_C_DIRED) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_MSW_C_DIRED -MSW_C_DIRED_SRC=$(XEMACS)\src\dired-msw.c -MSW_C_DIRED_OBJ=$(OUTDIR)\dired-msw.obj -!endif -!if $(HAVE_XPM) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_XPM -DFOR_MSW -MSW_INCLUDES=$(MSW_INCLUDES) -I"$(XPM_DIR)" -I"$(XPM_DIR)\lib" -MSW_LIBS=$(MSW_LIBS) "$(XPM_DIR)\lib\Xpm.lib" -!endif -!if $(HAVE_GIF) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_GIF -MSW_GIF_SRC=$(XEMACS)\src\dgif_lib.c $(XEMACS)\src\gif_io.c -MSW_GIF_OBJ=$(OUTDIR)\dgif_lib.obj $(OUTDIR)\gif_io.obj -!endif -!if $(HAVE_PNG) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_PNG -MSW_INCLUDES=$(MSW_INCLUDES) -I"$(PNG_DIR)" -I"$(ZLIB_DIR)" -MSW_LIBS=$(MSW_LIBS) "$(PNG_DIR)\libpng.lib" "$(ZLIB_DIR)\zlib.lib" -!endif -!if $(HAVE_TIFF) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_TIFF -MSW_INCLUDES=$(MSW_INCLUDES) -I"$(TIFF_DIR)\libtiff" -MSW_LIBS=$(MSW_LIBS) "$(TIFF_DIR)\libtiff\libtiff.lib" -!endif -!if $(HAVE_JPEG) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_JPEG -MSW_INCLUDES=$(MSW_INCLUDES) -I"$(JPEG_DIR)" -MSW_LIBS=$(MSW_LIBS) "$(JPEG_DIR)\libjpeg.lib" -!endif -!if $(HAVE_TOOLBARS) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_TOOLBARS -MSW_TOOLBAR_SRC=$(XEMACS)\src\toolbar.c $(XEMACS)\src\toolbar-msw.c -MSW_TOOLBAR_OBJ=$(OUTDIR)\toolbar.obj $(OUTDIR)\toolbar-msw.obj -MSW_LIBS=$(MSW_LIBS) comctl32.lib -!endif -!if $(HAVE_DIALOGS) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_DIALOGS -MSW_DIALOG_SRC=$(XEMACS)\src\dialog.c $(XEMACS)\src\dialog-msw.c -MSW_DIALOG_OBJ=$(OUTDIR)\dialog.obj $(OUTDIR)\dialog-msw.obj -!endif -!if $(HAVE_NATIVE_SOUND) -MSW_DEFINES=$(MSW_DEFINES) -DHAVE_NATIVE_SOUND -!endif -!endif - -!if $(HAVE_MULE) -MULE_DEFINES=-DMULE -!endif - -!if $(DEBUG_XEMACS) -DEBUG_DEFINES=-DDEBUG_XEMACS -D_DEBUG -DEBUG_FLAGS= -debugtype:both -debug:full -!endif - -!if $(USE_MINIMAL_TAGBITS) -TAGBITS_DEFINES=-DUSE_MINIMAL_TAGBITS -!endif -!if $(USE_INDEXED_LRECORD_IMPLEMENTATION) -LRECORD_DEFINES=-DUSE_INDEXED_LRECORD_IMPLEMENTATION -!endif -!if $(USE_UNION_TYPE) -UNION_DEFINES=-DUSE_UNION_TYPE -!endif - -# Hard-coded paths - -!if $(INFODOCK) -PATH_PREFIX=../.. -!else -PATH_PREFIX=.. -!endif - -PATH_DEFINES=-DPATH_PREFIX=\"$(PATH_PREFIX)\" - -# Generic variables - -INCLUDES=$(X_INCLUDES) $(MSW_INCLUDES) -I$(XEMACS)\nt\inc -I$(XEMACS)\src -I$(XEMACS)\lwlib - -DEFINES=$(X_DEFINES) $(MSW_DEFINES) $(MULE_DEFINES) \ - $(TAGBITS_DEFINES) $(LRECORD_DEFINES) $(UNION_DEFINES) \ - -DWIN32 -D_WIN32 -DWIN32_LEAN_AND_MEAN -DWINDOWSNT -Demacs \ - -DHAVE_CONFIG_H $(PROGRAM_DEFINES) $(PATH_DEFINES) - -OUTDIR=obj - -# -# Creating simplified versions of Installation and Installation.el -# -# Some values cannot be written on the same line with -# their key, since they cannot be put inside an echo command. -# Macro substitution (:"=\", :\=\\) can be performed on values in order -# to create a legal string in LISP for Installation.el. -# -!if [echo OS: $(OS)>Installation] ||\ -[echo XEmacs $(XEMACS_VERSION_STRING) $(xemacs_codename:"=\") configured for ^`$(EMACS_CONFIGURATION)^'.>>Installation] ||\ -[echo Where should the build process find the source code?>>Installation] ||\ -[echo $(MAKEDIR:\=\\)>>Installation] -!endif -# Compiler Information -!if defined(CCV) &&\ -[echo What compiler should XEmacs be built with?>>Installation] &&\ -[echo $(CC) $(CFLAGS)>>Installation] -!endif -# Window System Information -!if [echo What window system should XEmacs use?>>Installation] -!endif -!if (defined (HAVE_X) && $(HAVE_X) == 1) -!if [echo X11>>Installation] -!endif -!endif -!if (defined (HAVE_MSW) && $(HAVE_MSW) == 1) -!if [echo MS Windows>>Installation] -!endif -!endif -!if (!defined (HAVE_MSW) && !defined (HAVE_X)) -!if [echo Please specify at least one HAVE_MSW^=1 and^/or HAVE_X^=1>>Installation] -!endif -!endif -# Creation of Installation.el -!if [type Installation] ||\ -[echo (setq Installation-string ^">Installation.el] ||\ -[type Installation >>Installation.el] ||\ -[echo ^")>>Installation.el] -!endif - - -#------------------------------------------------------------------------------ - -default: $(OUTDIR)\nul all - -$(OUTDIR)\nul: - -@mkdir $(OUTDIR) - -XEMACS_INCLUDES=\ - $(XEMACS)\src\config.h \ - $(XEMACS)\src\Emacs.ad.h \ - $(XEMACS)\src\paths.h \ - $(XEMACS)\src\puresize-adjust.h - -$(XEMACS)\src\config.h: config.h - copy config.h $(XEMACS)\src - -$(XEMACS)\src\Emacs.ad.h: Emacs.ad.h - copy Emacs.ad.h $(XEMACS)\src - -$(XEMACS)\src\paths.h: paths.h - copy paths.h $(XEMACS)\src - -$(XEMACS)\src\puresize-adjust.h: puresize-adjust.h - copy puresize-adjust.h $(XEMACS)\src - -#------------------------------------------------------------------------------ - -# lib-src programs - -LIB_SRC = $(XEMACS)\lib-src -LIB_SRC_DEFINES = -DHAVE_CONFIG_H -DWIN32 -DWINDOWSNT - -# -# Creating config.values to be used by config.el -# -CONFIG_VALUES = $(LIB_SRC)\config.values -!if [echo Creating $(CONFIG_VALUES) && echo ;;; Do not edit this file!>$(CONFIG_VALUES)] -!endif -# MAKEDIR has to be made into a string. -!if [echo blddir>>$(CONFIG_VALUES) && echo ^"$(MAKEDIR:\=\\)\\..^">>$(CONFIG_VALUES)] -!endif -!if [echo CC>>$(CONFIG_VALUES) && echo ^"$(CC:\=\\)^">>$(CONFIG_VALUES)] -!endif -!if [echo CFLAGS>>$(CONFIG_VALUES) && echo ^"$(CFLAGS:\=\\)^">>$(CONFIG_VALUES)] -!endif -!if [echo CPP>>$(CONFIG_VALUES) && echo ^"$(CPP:\=\\)^">>$(CONFIG_VALUES)] -!endif -!if [echo CPPFLAGS>>$(CONFIG_VALUES) && echo ^"$(CPPFLAGS:\=\\)^">>$(CONFIG_VALUES)] -!endif -!if [echo LISPDIR>>$(CONFIG_VALUES) && echo ^"$(MAKEDIR:\=\\)\\$(LISP:\=\\)^">>$(CONFIG_VALUES)] -!endif -# PATH_PACKAGEPATH is already a quoted string. -!if [echo PACKAGE_PATH>>$(CONFIG_VALUES) && echo $(PATH_PACKAGEPATH)>>$(CONFIG_VALUES)] -!endif - -# Inferred rule -{$(LIB_SRC)}.c{$(LIB_SRC)}.exe : - @cd $(LIB_SRC) - $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** - @cd $(NT) - -# Individual dependencies -ETAGS_DEPS = $(LIB_SRC)/getopt.c $(LIB_SRC)/getopt1.c $(LIB_SRC)/../src/regex.c -$(LIB_SRC)/etags.exe : $(LIB_SRC)/etags.c $(ETAGS_DEPS) -$(LIB_SRC)/movemail.exe: $(LIB_SRC)/movemail.c $(LIB_SRC)/pop.c $(ETAGS_DEPS) - @cd $(LIB_SRC) - $(CCV) -I. -I$(XEMACS)/src -I$(XEMACS)/nt/inc $(LIB_SRC_DEFINES) $(CFLAGS) -Fe$@ $** wsock32.lib - @cd $(NT) - -LIB_SRC_TOOLS = \ - $(LIB_SRC)/make-docfile.exe \ - $(LIB_SRC)/hexl.exe \ - $(LIB_SRC)/movemail.exe \ - $(LIB_SRC)/mmencode.exe \ - $(LIB_SRC)/sorted-doc.exe \ - $(LIB_SRC)/wakeup.exe \ - $(LIB_SRC)/etags.exe - -#------------------------------------------------------------------------------ - -# runxemacs proglet - -RUNEMACS = $(XEMACS)\src\runxemacs.exe - -$(RUNEMACS): $(LIB_SRC)\run.c $(LIB_SRC)\run.res - $(CCV) -I$(LIB_SRC) -O2 -Fe$@ $** kernel32.lib user32.lib - -$(LIB_SRC)\run.res: $(LIB_SRC)\run.rc - rc -I$(LIB_SRC) -FO$(LIB_SRC)\run.res $(LIB_SRC)\run.rc - -#------------------------------------------------------------------------------ - -# LASTFILE Library - -LASTFILE=$(OUTDIR)\lastfile.lib -LASTFILE_SRC=$(XEMACS)\src -LASTFILE_FLAGS=$(CFLAGS) $(INCLUDES) -Fo$@ -c -LASTFILE_OBJS= \ - $(OUTDIR)\lastfile.obj - -$(LASTFILE): $(XEMACS_INCLUDES) $(LASTFILE_OBJS) - link.exe -lib -nologo -out:$@ $(LASTFILE_OBJS) - -$(OUTDIR)\lastfile.obj: $(LASTFILE_SRC)\lastfile.c - $(CCV) $(LASTFILE_FLAGS) $** - -#------------------------------------------------------------------------------ - -!if $(HAVE_X) - -# LWLIB Library - -LWLIB=$(OUTDIR)\lwlib.lib -LWLIB_SRC=$(XEMACS)\lwlib -LWLIB_FLAGS=$(CFLAGS) $(INCLUDES) $(DEFINES) \ - -DNEED_ATHENA -DNEED_LUCID \ - -D_WINDOWS -DMENUBARS_LUCID -DSCROLLBARS_LUCID -DDIALOGS_ATHENA \ - -Fo$@ -c -LWLIB_OBJS= \ - $(OUTDIR)\lwlib-config.obj \ - $(OUTDIR)\lwlib-utils.obj \ - $(OUTDIR)\lwlib-Xaw.obj \ - $(OUTDIR)\lwlib-Xlw.obj \ - $(OUTDIR)\lwlib.obj \ - $(OUTDIR)\xlwmenu.obj \ - $(OUTDIR)\xlwscrollbar.obj - -$(LWLIB): $(LWLIB_OBJS) - link.exe -lib -nologo $(DEBUG_FLAGS) -out:$@ $(LWLIB_OBJS) - -$(OUTDIR)\lwlib-config.obj: $(LWLIB_SRC)\lwlib-config.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-utils.obj: $(LWLIB_SRC)\lwlib-utils.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-Xaw.obj: $(LWLIB_SRC)\lwlib-Xaw.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib-Xlw.obj: $(LWLIB_SRC)\lwlib-Xlw.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\lwlib.obj: $(LWLIB_SRC)\lwlib.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\xlwmenu.obj: $(LWLIB_SRC)\xlwmenu.c - $(CCV) $(LWLIB_FLAGS) $** - -$(OUTDIR)\xlwscrollbar.obj: $(LWLIB_SRC)\xlwscrollbar.c - $(CCV) $(LWLIB_FLAGS) $** - -!endif -#------------------------------------------------------------------------------ - -DOC=$(LIB_SRC)\DOC -DOC_SRC1=\ - $(XEMACS)\src\abbrev.c \ - $(XEMACS)\src\alloc.c \ - $(XEMACS)\src\alloca.c \ - $(XEMACS)\src\blocktype.c \ - $(XEMACS)\src\buffer.c \ - $(XEMACS)\src\bytecode.c \ - $(XEMACS)\src\callint.c \ - $(XEMACS)\src\callproc.c \ - $(XEMACS)\src\casefiddle.c \ - $(XEMACS)\src\casetab.c \ - $(XEMACS)\src\chartab.c \ - $(XEMACS)\src\cmdloop.c \ - $(XEMACS)\src\cmds.c \ - $(XEMACS)\src\console-stream.c \ - $(XEMACS)\src\console.c \ - $(XEMACS)\src\data.c \ - $(XEMACS)\src\device.c -DOC_SRC2=\ - $(XEMACS)\src\dired.c \ - $(XEMACS)\src\doc.c \ - $(XEMACS)\src\doprnt.c \ - $(XEMACS)\src\dragdrop.c \ - $(XEMACS)\src\dynarr.c \ - $(XEMACS)\src\editfns.c \ - $(XEMACS)\src\elhash.c \ - $(XEMACS)\src\emacs.c \ - $(XEMACS)\src\eval.c \ - $(XEMACS)\src\event-stream.c \ - $(XEMACS)\src\events.c \ - $(XEMACS)\src\extents.c \ - $(XEMACS)\src\faces.c \ - $(XEMACS)\src\file-coding.c \ - $(XEMACS)\src\fileio.c \ - $(XEMACS)\src\filemode.c \ - $(XEMACS)\src\floatfns.c \ - $(XEMACS)\src\fns.c -DOC_SRC3=\ - $(XEMACS)\src\font-lock.c \ - $(XEMACS)\src\frame.c \ - $(XEMACS)\src\free-hook.c \ - $(XEMACS)\src\general.c \ - $(XEMACS)\src\glyphs.c \ - $(XEMACS)\src\glyphs-eimage.c \ - $(XEMACS)\src\glyphs-widget.c \ - $(XEMACS)\src\gmalloc.c \ - $(XEMACS)\src\gui.c \ - $(XEMACS)\src\hash.c \ - $(XEMACS)\src\imgproc.c \ - $(XEMACS)\src\indent.c \ - $(XEMACS)\src\insdel.c \ - $(XEMACS)\src\intl.c \ - $(XEMACS)\src\keymap.c \ - $(XEMACS)\src\line-number.c \ - $(XEMACS)\src\lread.c \ - $(XEMACS)\src\lstream.c \ - $(XEMACS)\src\macros.c \ - $(XEMACS)\src\marker.c -DOC_SRC4=\ - $(XEMACS)\src\md5.c \ - $(XEMACS)\src\menubar.c \ - $(XEMACS)\src\minibuf.c \ - $(XEMACS)\src\nt.c \ - $(XEMACS)\src\ntheap.c \ - $(XEMACS)\src\ntplay.c \ - $(XEMACS)\src\ntproc.c \ - $(XEMACS)\src\objects.c \ - $(XEMACS)\src\opaque.c \ - $(XEMACS)\src\print.c \ - $(XEMACS)\src\process.c \ - $(XEMACS)\src\process-nt.c \ - $(XEMACS)\src\profile.c \ - $(XEMACS)\src\rangetab.c \ - $(XEMACS)\src\realpath.c \ - $(XEMACS)\src\redisplay-output.c \ - $(XEMACS)\src\redisplay.c \ - $(XEMACS)\src\regex.c \ - $(XEMACS)\src\scrollbar.c \ - $(XEMACS)\src\search.c \ - $(XEMACS)\src\signal.c \ - $(XEMACS)\src\sound.c -DOC_SRC5=\ - $(XEMACS)\src\specifier.c \ - $(XEMACS)\src\strftime.c \ - $(XEMACS)\src\symbols.c \ - $(XEMACS)\src\syntax.c \ - $(XEMACS)\src\sysdep.c \ - $(XEMACS)\src\termcap.c \ - $(XEMACS)\src\tparam.c \ - $(XEMACS)\src\undo.c \ - $(XEMACS)\src\unexnt.c \ - $(XEMACS)\src\vm-limit.c \ - $(XEMACS)\src\window.c \ - $(XEMACS)\src\widget.c - -!if $(HAVE_X) -DOC_SRC6=\ - $(XEMACS)\src\balloon_help.c \ - $(XEMACS)\src\console-x.c \ - $(XEMACS)\src\device-x.c \ - $(XEMACS)\src\dialog-x.c \ - $(XEMACS)\src\EmacsFrame.c \ - $(XEMACS)\src\EmacsManager.c \ - $(XEMACS)\src\EmacsShell-sub.c\ - $(XEMACS)\src\EmacsShell.c \ - $(XEMACS)\src\event-Xt.c \ - $(XEMACS)\src\frame-x.c \ - $(XEMACS)\src\glyphs-x.c \ - $(XEMACS)\src\gui-x.c \ - $(XEMACS)\src\menubar.c \ - $(XEMACS)\src\menubar-x.c \ - $(XEMACS)\src\objects-x.c \ - $(XEMACS)\src\redisplay-x.c \ - $(XEMACS)\src\scrollbar-x.c \ - $(XEMACS)\src\balloon-x.c \ - $(XEMACS)\src\xgccache.c \ - $(XEMACS)\src\xmu.c \ - $(XEMACS)\src\xselect.c -!endif - -!if $(HAVE_MSW) -DOC_SRC7=\ - $(XEMACS)\src\console-msw.c \ - $(XEMACS)\src\device-msw.c \ - $(XEMACS)\src\event-msw.c \ - $(XEMACS)\src\frame-msw.c \ - $(XEMACS)\src\glyphs-msw.c \ - $(XEMACS)\src\gui-msw.c \ - $(XEMACS)\src\menubar-msw.c \ - $(XEMACS)\src\objects-msw.c \ - $(XEMACS)\src\redisplay-msw.c \ - $(XEMACS)\src\scrollbar-msw.c \ - $(XEMACS)\src\select-msw.c \ - $(MSW_C_DIRED_SRC) \ - $(MSW_TOOLBAR_SRC) \ - $(MSW_DIALOG_SRC) \ - $(MSW_GIF_SRC) -!endif - -!if $(HAVE_MULE) -DOC_SRC8=\ - $(XEMACS)\src\mule.c \ - $(XEMACS)\src\mule-charset.c \ - $(XEMACS)\src\mule-ccl.c \ - $(XEMACS)\src\mule-coding.c -! if $(HAVE_X) - DOC_SRC8=$(DOC_SRC8) $(XEMACS)\src\input-method-xlib.c -! endif -!endif - -!if $(DEBUG_XEMACS) -DOC_SRC9=\ - $(XEMACS)\src\debug.c -!endif - -#------------------------------------------------------------------------------ - -# TEMACS Executable - -# This may not exist -!if "$(emacs_beta_version)" != "" -EMACS_BETA_VERSION=-DEMACS_BETA_VERSION=$(emacs_beta_version) -!ENDIF - -TEMACS_DIR=$(XEMACS)\src -TEMACS=$(TEMACS_DIR)\temacs.exe -TEMACS_BROWSE=$(TEMACS_DIR)\temacs.bsc -TEMACS_SRC=$(XEMACS)\src -TEMACS_LIBS=$(LASTFILE) $(LWLIB) $(X_LIBS) $(MSW_LIBS) \ - kernel32.lib user32.lib gdi32.lib advapi32.lib \ - shell32.lib wsock32.lib winmm.lib libc.lib -TEMACS_LFLAGS=-nologo $(LIBRARIES) $(DEBUG_FLAGS) -base:0x1000000\ - -stack:0x800000 -entry:_start -subsystem:console\ - -pdb:$(TEMACS_DIR)\temacs.pdb -map:$(TEMACS_DIR)\temacs.map \ - -heap:0x00100000 -out:$@ -TEMACS_CPP_FLAGS=-ML -c $(CFLAGS) $(INCLUDES) $(DEFINES) $(DEBUG_DEFINES) \ - -DEMACS_MAJOR_VERSION=$(emacs_major_version) \ - -DEMACS_MINOR_VERSION=$(emacs_minor_version) \ - $(EMACS_BETA_VERSION) \ - -DXEMACS_CODENAME=\"$(xemacs_codename)\" \ - -DEMACS_CONFIGURATION=\"$(EMACS_CONFIGURATION)\" \ - -DPATH_PACKAGEPATH=\"$(PATH_PACKAGEPATH)\" - -!if $(HAVE_X) -TEMACS_X_OBJS=\ - $(OUTDIR)\balloon-x.obj \ - $(OUTDIR)\balloon_help.obj \ - $(OUTDIR)\console-x.obj \ - $(OUTDIR)\device-x.obj \ - $(OUTDIR)\dialog-x.obj \ - $(OUTDIR)\EmacsFrame.obj \ - $(OUTDIR)\EmacsManager.obj \ - $(OUTDIR)\EmacsShell.obj \ - $(OUTDIR)\TopLevelEmacsShell.obj\ - $(OUTDIR)\TransientEmacsShell.obj\ - $(OUTDIR)\event-Xt.obj \ - $(OUTDIR)\frame-x.obj \ - $(OUTDIR)\glyphs-x.obj \ - $(OUTDIR)\gui-x.obj \ - $(OUTDIR)\menubar-x.obj \ - $(OUTDIR)\objects-x.obj \ - $(OUTDIR)\redisplay-x.obj \ - $(OUTDIR)\scrollbar-x.obj \ - $(OUTDIR)\xgccache.obj \ - $(OUTDIR)\xmu.obj \ - $(OUTDIR)\xselect.obj -!endif - -!if $(HAVE_MSW) -TEMACS_MSW_OBJS=\ - $(OUTDIR)\console-msw.obj \ - $(OUTDIR)\device-msw.obj \ - $(OUTDIR)\event-msw.obj \ - $(OUTDIR)\frame-msw.obj \ - $(OUTDIR)\glyphs-msw.obj \ - $(OUTDIR)\gui-msw.obj \ - $(OUTDIR)\menubar-msw.obj \ - $(OUTDIR)\objects-msw.obj \ - $(OUTDIR)\redisplay-msw.obj \ - $(OUTDIR)\scrollbar-msw.obj \ - $(OUTDIR)\select-msw.obj \ - $(MSW_C_DIRED_OBJ) \ - $(MSW_TOOLBAR_OBJ) \ - $(MSW_DIALOG_OBJ) \ - $(MSW_GIF_OBJ) -!endif - -!if $(HAVE_MULE) -TEMACS_MULE_OBJS=\ - $(OUTDIR)\mule.obj \ - $(OUTDIR)\mule-charset.obj \ - $(OUTDIR)\mule-ccl.obj \ - $(OUTDIR)\mule-coding.obj -! if $(HAVE_X) -TEMACS_MULE_OBJS=\ - $(TEMACS_MULE_OBJS) $(OUTDIR)\input-method-xlib.obj -! endif -!endif - -!if $(DEBUG_XEMACS) -TEMACS_DEBUG_OBJS=\ - $(OUTDIR)\debug.obj -!endif - -TEMACS_OBJS= \ - $(TEMACS_X_OBJS)\ - $(TEMACS_MSW_OBJS)\ - $(TEMACS_CODING_OBJS)\ - $(TEMACS_MULE_OBJS)\ - $(TEMACS_DEBUG_OBJS)\ - $(OUTDIR)\abbrev.obj \ - $(OUTDIR)\alloc.obj \ - $(OUTDIR)\alloca.obj \ - $(OUTDIR)\blocktype.obj \ - $(OUTDIR)\buffer.obj \ - $(OUTDIR)\bytecode.obj \ - $(OUTDIR)\callint.obj \ - $(OUTDIR)\callproc.obj \ - $(OUTDIR)\casefiddle.obj \ - $(OUTDIR)\casetab.obj \ - $(OUTDIR)\chartab.obj \ - $(OUTDIR)\cmdloop.obj \ - $(OUTDIR)\cmds.obj \ - $(OUTDIR)\console-stream.obj \ - $(OUTDIR)\console.obj \ - $(OUTDIR)\data.obj \ - $(OUTDIR)\device.obj \ - $(OUTDIR)\dired.obj \ - $(OUTDIR)\doc.obj \ - $(OUTDIR)\doprnt.obj \ - $(OUTDIR)\dragdrop.obj \ - $(OUTDIR)\dynarr.obj \ - $(OUTDIR)\editfns.obj \ - $(OUTDIR)\elhash.obj \ - $(OUTDIR)\emacs.obj \ - $(OUTDIR)\eval.obj \ - $(OUTDIR)\event-stream.obj \ - $(OUTDIR)\events.obj \ - $(OUTDIR)\extents.obj \ - $(OUTDIR)\faces.obj \ - $(OUTDIR)\file-coding.obj \ - $(OUTDIR)\fileio.obj \ - $(OUTDIR)\filemode.obj \ - $(OUTDIR)\floatfns.obj \ - $(OUTDIR)\fns.obj \ - $(OUTDIR)\font-lock.obj \ - $(OUTDIR)\frame.obj \ - $(OUTDIR)\free-hook.obj \ - $(OUTDIR)\general.obj \ - $(OUTDIR)\glyphs.obj \ - $(OUTDIR)\glyphs-eimage.obj \ - $(OUTDIR)\glyphs-widget.obj \ - $(OUTDIR)\gmalloc.obj \ - $(OUTDIR)\gui.obj \ - $(OUTDIR)\hash.obj \ - $(OUTDIR)\indent.obj \ - $(OUTDIR)\imgproc.obj \ - $(OUTDIR)\insdel.obj \ - $(OUTDIR)\intl.obj \ - $(OUTDIR)\keymap.obj \ - $(OUTDIR)\line-number.obj \ - $(OUTDIR)\lread.obj \ - $(OUTDIR)\lstream.obj \ - $(OUTDIR)\macros.obj \ - $(OUTDIR)\menubar.obj \ - $(OUTDIR)\marker.obj \ - $(OUTDIR)\md5.obj \ - $(OUTDIR)\minibuf.obj \ - $(OUTDIR)\nt.obj \ - $(OUTDIR)\ntheap.obj \ - $(OUTDIR)\ntplay.obj \ - $(OUTDIR)\ntproc.obj \ - $(OUTDIR)\objects.obj \ - $(OUTDIR)\opaque.obj \ - $(OUTDIR)\print.obj \ - $(OUTDIR)\process.obj \ - $(OUTDIR)\process-nt.obj \ - $(OUTDIR)\profile.obj \ - $(OUTDIR)\rangetab.obj \ - $(OUTDIR)\realpath.obj \ - $(OUTDIR)\redisplay-output.obj \ - $(OUTDIR)\redisplay.obj \ - $(OUTDIR)\regex.obj \ - $(OUTDIR)\scrollbar.obj \ - $(OUTDIR)\search.obj \ - $(OUTDIR)\signal.obj \ - $(OUTDIR)\sound.obj \ - $(OUTDIR)\specifier.obj \ - $(OUTDIR)\strftime.obj \ - $(OUTDIR)\symbols.obj \ - $(OUTDIR)\syntax.obj \ - $(OUTDIR)\sysdep.obj \ - $(OUTDIR)\tparam.obj \ - $(OUTDIR)\undo.obj \ - $(OUTDIR)\unexnt.obj \ - $(OUTDIR)\vm-limit.obj \ - $(OUTDIR)\widget.obj \ - $(OUTDIR)\window.obj \ - $(NT)\xemacs.res - -# Rules - -.SUFFIXES: -.SUFFIXES: .c - -# nmake rule -{$(TEMACS_SRC)}.c{$(OUTDIR)}.obj: - $(CCV) $(TEMACS_CPP_FLAGS) $< -Fo$@ -Fr$*.sbr - -$(OUTDIR)\TopLevelEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c - $(CCV) $(TEMACS_CPP_FLAGS) -DDEFINE_TOP_LEVEL_EMACS_SHELL $** -Fo$@ - -$(OUTDIR)\TransientEmacsShell.obj: $(TEMACS_SRC)\EmacsShell-sub.c - $(CCV) $(TEMACS_CPP_FLAGS) -DDEFINE_TRANSIENT_EMACS_SHELL $** -Fo$@ - -$(OUTDIR)\alloc.obj: $(TEMACS_SRC)\alloc.c $(TEMACS_SRC)\puresize-adjust.h - -#$(TEMACS_SRC)\Emacs.ad.h: $(XEMACS)\etc\Emacs.ad -# !"sed -f ad2c.sed < $(XEMACS)\etc\Emacs.ad > $(TEMACS_SRC)\Emacs.ad.h" - -#$(TEMACS_SRC)\paths.h: $(TEMACS_SRC)\paths.h.in -# !"cd $(TEMACS_SRC); cp paths.h.in paths.h" - -$(TEMACS): $(TEMACS_INCLUDES) $(TEMACS_OBJS) - link.exe @<< - $(TEMACS_LFLAGS) $(TEMACS_OBJS) $(TEMACS_LIBS) -<< - -$(NT)\xemacs.res: xemacs.rc - rc xemacs.rc - -# MSDEV Source Broswer file. "*.sbr" is too inclusive but this is harmless -$(TEMACS_BROWSE): $(TEMACS_OBJS) - @dir /b/s $(OUTDIR)\*.sbr > bscmake.tmp - bscmake -nologo -o$@ @bscmake.tmp - @del bscmake.tmp - -#------------------------------------------------------------------------------ - -# LISP bits 'n bobs - -LOADPATH=$(LISP) - -$(DOC): $(LIB_SRC)\make-docfile.exe - -del $(DOC) - $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\make-docfile.el -- -o $(DOC) -i $(XEMACS)\site-packages - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC1) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC2) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC3) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC4) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC5) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC6) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC7) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC8) - $(LIB_SRC)\make-docfile.exe -a $(DOC) -d $(TEMACS_SRC) $(DOC_SRC9) - -$(LISP)\Installation.el: Installation.el - copy Installation.el $(LISP) - -update-elc: $(LISP)\Installation.el - set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) - set EMACSBOOTSTRAPMODULEPATH=$(MODULES) - $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\update-elc.el - -# This rule dumps xemacs and then possibly spawns sub-make if PURESPACE -# requirements has changed. -dump-xemacs: $(TEMACS) - @echo >$(TEMACS_DIR)\SATISFIED - cd $(TEMACS_DIR) - set EMACSBOOTSTRAPLOADPATH=$(LISP);$(PACKAGE_PATH) - -1 $(TEMACS) -batch -l $(TEMACS_DIR)\..\lisp\loadup.el dump - @cd $(NT) - @if not exist $(TEMACS_DIR)\SATISFIED nmake -nologo -f xemacs.mak $@ - -#------------------------------------------------------------------------------ - -# use this rule to build the complete system -all: $(OUTDIR)\nul $(LASTFILE) $(LWLIB) $(LIB_SRC_TOOLS) $(RUNEMACS) \ - $(TEMACS) $(TEMACS_BROWSE) update-elc $(DOC) dump-xemacs - -temacs: $(TEMACS) - -# use this rule to install the system -install: all - @echo Installing in $(INSTALL_DIR) ... - @echo PlaceHolder > PlaceHolder - @xcopy /q PROBLEMS "$(INSTALL_DIR)\" - @xcopy /q PlaceHolder "$(INSTALL_DIR)\lock\" - @del "$(INSTALL_DIR)\lock\PlaceHolder" - @xcopy /q $(LIB_SRC)\*.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)\" - @copy $(LIB_SRC)\DOC "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" - @copy $(CONFIG_VALUES) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" - @copy $(XEMACS)\src\xemacs.exe "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" - @copy $(RUNEMACS) "$(INSTALL_DIR)\$(EMACS_CONFIGURATION)" - @xcopy /e /q $(XEMACS)\etc "$(INSTALL_DIR)\etc\" - @xcopy /e /q $(XEMACS)\info "$(INSTALL_DIR)\info\" - @xcopy /e /q $(XEMACS)\lisp "$(INSTALL_DIR)\lisp\" - @echo Making skeleton package tree in $(PACKAGE_PREFIX) ... - @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\site-packages\" - @del "$(PACKAGE_PREFIX)\site-packages\PlaceHolder" - @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\mule-packages\" - @del "$(PACKAGE_PREFIX)\mule-packages\PlaceHolder" - @xcopy /q PlaceHolder "$(PACKAGE_PREFIX)\xemacs-packages\" - @del "$(PACKAGE_PREFIX)\xemacs-packages\PlaceHolder" - @del PlaceHolder - -distclean: - del *.bak - del *.orig - del *.rej - del *.pdb - del *.tmp - cd $(OUTDIR) - del *.obj - del *.sbr - del *.lib - cd $(XEMACS)\$(TEMACS_DIR) - del puresize-adjust.h - del config.h - del paths.h - del Emacs.ad.h - del *.bak - del *.orig - del *.rej - del *.exe - del *.map - del *.bsc - del *.pdb - cd $(LIB_SRC) - del DOC - del *.bak - del *.orig - del *.rej - del *.exe - del $(CONFIG_VALUES) - cd $(LISP) - -del /s /q *.bak *.elc *.orig *.rej - -depend: - mkdepend -f xemacs.mak -p$(OUTDIR)\ -o.obj -w9999 -- $(TEMACS_CPP_FLAGS) -- $(DOC_SRC1) $(DOC_SRC2) $(DOC_SRC3) $(DOC_SRC4) $(DOC_SRC5) $(DOC_SRC6) $(DOC_SRC7) $(DOC_SRC8) $(DOC_SRC9) $(LASTFILE_SRC)\lastfile.c $(LIB_SRC)\make-docfile.c $(LIB_SRC)\run.c - -# DO NOT DELETE THIS LINE -- make depend depends on it. - diff --git a/nt/xemacs.rc b/nt/xemacs.rc deleted file mode 100644 index 3c0f003..0000000 --- a/nt/xemacs.rc +++ /dev/null @@ -1,3 +0,0 @@ -XEmacs icon preload "xemacs.ico" -XEmacsFile icon "File.ico" -XEmacsLisp icon "Lisp.ico" diff --git a/nt/xpm.mak b/nt/xpm.mak deleted file mode 100644 index 1ebdb88..0000000 --- a/nt/xpm.mak +++ /dev/null @@ -1,47 +0,0 @@ -# -# XPM Makefile for Microsoft NMAKE without X libraries -# - -!if !defined(DEBUG_XEMACS) -DEBUG_XEMACS=0 -!endif - -!if $(DEBUG_XEMACS) -OPT=-Od -Zi -!else -OPT=-O2 -G5 -Zi -!endif - -WARN_CPP_FLAGS = -W3 - -CC=cl -CFLAGS=-nologo -DFOR_MSW $(WARN_CPP_FLAGS) $(OPT) $(INCLUDES) -Fo$@ -c - -OBJS= data.obj create.obj misc.obj rgb.obj scan.obj parse.obj hashtab.obj \ - WrFFrI.obj RdFToI.obj CrIFrDat.obj CrDatFrI.obj \ - CrIFrBuf.obj CrBufFrI.obj \ - RdFToDat.obj WrFFrDat.obj \ - Attrib.obj Image.obj Info.obj RdFToBuf.obj WrFFrBuf.obj \ - simx.obj - -# nmake rule - -.SUFFIXES: -.SUFFIXES: .c - -.c.obj: - $(CC) $(CFLAGS) $< -Fo$@ - - -# targets - -all: ..\X11\xpm.h Xpm.lib - -..\X11\xpm.h: ..\X11\NUL xpm.h - copy xpm.h ..\X11 - -..\X11\NUL: - mkdir ..\X11 - -Xpm.lib: $(OBJS) - link.exe -lib -nologo -out:$@ $(OBJS) diff --git a/src/.cvsignore b/src/.cvsignore deleted file mode 100644 index 941595c..0000000 --- a/src/.cvsignore +++ /dev/null @@ -1,11 +0,0 @@ -Makefile.in -paths.h -config.h -Emacs.ad.h -Makefile -GNUmakefile -puresize-adjust.h -sheap-adjust.h -temacs -SATISFIED -update-elc.stamp diff --git a/src/ChangeLog b/src/ChangeLog deleted file mode 100644 index 44798e3..0000000 --- a/src/ChangeLog +++ /dev/null @@ -1,4123 +0,0 @@ -1999-03-01 XEmacs Build Bot - - * XEmacs 21.2.11 is released - -1999-02-25 SL Baur - - * mule-charset.c (Qleading_byte): New variable to implement - charset-leading-byte function. - (Fcharset_property): Use it. - (syms_of_mule_charset): Initialize it. - From Kazuyuki IENAGA - -1999-02-17 Kazuo Oishi - - * glyphs-x.c (cononvert_EImage_to_XImage): correct - bytes per pixel counting. - -1999-02-15 Andy Piper - - * s/cygwin32.h (BROKEN_SIGIO): don't define this as it causes - major lockups. - -1999-02-16 Martin Buchholz - - * gdbinit: Fix up commands to run temacs. Add lisp-shadows command. - * alloc.c (xcalloc): undef xcalloc, just like xmalloc - -1999-02-10 Martin Buchholz - - * s/bsdos4.h: New file. Port to BSDI BSD/OS 4.0. - * xintrinsic.h: Redo CONST support for X11 R4 compatibility. - -1999-02-05 XEmacs Build Bot - - * XEmacs 21.2.10 is released - -1999-02-02 Gleb Arshinov - - * process-nt.c (nt_send_process): - Fix for process-send-region/process-send-string breaking when size - of the input > 128 chars: change maximum chunk size for process - stream from 512 to 128, thus guaranteeing that ntpipe_shove_writer - succeeds. - -1999-02-02 XEmacs Build Bot - - * XEmacs 21.2.9 is released - -1999-01-30 Martin Buchholz - - * bytecode.c (funcall_compiled_function): Call - UNBIND_TO_GCPRO instead of UNBIND_TO_GCPRO_VARIABLES_ONLY. - - * backtrace.h (UNBIND_TO_GCPRO_VARIABLES_ONLY): - #ifdef 0 out unused macro. - -1999-01-27 Martin Buchholz - - * gui.c (gui_parse_item_keywords_internal): Make static. - -1999-01-21 Andy Piper - - * glyphs-msw.c: add xface support. - (mswindows_xface_instantiate): new function copied from glyphs-x.c - (image_instantiator_format_create_glyphs_mswindows): do device - specific initialisation for xfaces. - (xbm_create_bitmap_from_data): line data must be padded to a word - boundary. - - * glyphs-x.c (xface_validate): moved to glyphs.c - (xface_normalize): ditto. - (xface_possible_dest_types): ditto. - (image_instantiator_format_create_glyphs_x): do device specific - initialisation for xfaces. - - * glyphs.h: declare xface symbol. - - * glyphs.c: move generic xface support here. - (xface_validate): moved from glyphs-x.c - (xface_normalize): ditto. - (xface_possible_dest_types): ditto. - (image_instantiator_format_create): xface declarations moved from - glyphs-x.c. - -1999-01-14 Adrian Aichner - - * event-stream.c (vars_of_event_stream): Fixing documentation. - -1999-01-17 Gunnar Evermann - - * glyphs-eimage.c (gif_instantiate): Correct handling of - interlaced gifs to avoid writing past the end of the eimage - buffer. - -1999-01-13 Hrvoje Niksic - - * search.c (Freplace_match): Handle single backslash at end of - NEWTEXT correctly. - -1999-01-12 William M. Perry - - * eldap.c (Fldap_open): slow down interrupts around ldap_open to - avoid connection errors. - -1999-01-12 Andy Piper - - * redisplay-output.c (redisplay_update_line): backout change that - shouldn't have gone ine. - -1999-01-09 Oscar Figueiredo - - * eldap.c (vars_of_ldap): Do no provide `ldap' here since it may - collide with ldap.el - -1999-01-11 Andy Piper - - * redisplay.h (DISPLAY_LINE_HEIGHT): new macro. - (DISPLAY_LINE_YPOS): new macro. - - * redisplay-msw.c (mswindows_output_string): use it. - (mswindows_output_pixmap): ditto. - (mswindows_output_display_block): ditto. - - * redisplay-output.c (redisplay_output_display_block): new - function. just call the devmeth, maybe insert some generic code - here later. - (compare_display_blocks): use it. - (output_display_line): ditto. - (redisplay_unmap_subwindows_maybe): new function. potentially - unmap subwindows in the given area. - - * glyphs.c (reset_subwindow_cachels): unmap subwindows that we are - resetting. - -1999-01-10 J. Kean Johnston - - * Makefile.in.in: Set value of moduledir - - Changed DUMPENV to include $(MODULEPATH) - - Added install rule to install header files for use by ellcc. - - * config.h.in: Added INHIBIT_SITE_MODULES - - Added HAVE__DLERROR - - Added HAVE_DLFCN_H - - Added DLSYM_NEEDS_UNDERSCORE - - * dll.c: Removed. - - * emodules.c: New file containing dynamic loading code. - - * emodules.h: New file. - - * emacs.c: Added variables Vmodule_directory, - Vsite_module_directory, Vconfigure_module_directory and - Vconfigure_site_module_directory. - - (main_1): Added new variable inhibit_site_modules and command - line options `-no-site-modules' and `--no-site-modules'. - - (main_1): Call syms_of_module() instead of syms_of_dll(). - - (main_1): Call vars_of_module(). - - (vars_of_emacs): Introduce inhibit-site-modules, - module-directory, configure-module-directory, - site-module-directory, and configure-site-module-directory to the - Lisp reader. - - * lisp.h: Declare load_module and list_modules, as well as - Vmodule_directory, Vsite_module_directory, - Vconfigure_module_directory and Vconfigure_site_module_directory. - - * paths.h.in: Added PATH_MODULESEARCH and PATH_SITE_MODULES. - - Added correct support for site-lisp directory. - - * symbols.c (defsubr): Modified to allow modules to add new subrs - after dump time. - - (defsubr_macro): Same. - - (defvar_magick): Only use purespace when not initialized, so - that loaded modules can still add symbols. - - * symsinit.h: Add definitions for syms_of_module(), - vars_of_module(). Removed syms_of_dll(). - - * sysdll.c: Include dlfcn.h if HAVE_DLFCN_H is defined. - - (dll_variable): Take DLSYM_NEEDS_UNDERSCORE into account. - - (dll_error): use _dlerror() if HAVE__DLERROR is defined. - - * s/sco5-shr.h (C_SWITCH_SYSTEM): Correct for modern gcc and - explicitly pass -belf for native cc. - - * s/sco5.h (LIB_GCC): Use -print-libgcc-file-name instead of - hard-coding the library name. - -1999-01-01 - - * device-x.c (Fx_set_font_path): - Add proper cast to permit compilation under C++. - - * buffer.c (directory_is_current_directory): - Add proper casts to permit compilation under C++. - -1998-12-30 Damon Lipparelli - - * event-msw.c (mswindows_wnd_proc): - Fixed failure when building with MSVC 5. - -1998-12-29 Martin Buchholz - - * file-coding.c (decode_coding_iso2022): - - Prevent crash when decoding ISO7/Lock detected files - - the usual martin fiddling - -1998-12-29 Jonathan Harris - - * event-msw.c: - glyphs-msw.c: - Fixed failures when building with MSVC. - * unexnt.c (dump_bss_and_heap): - Removed compiler warning by removing bss_data variable. - -1998-12-18 Jim Radford - - * device-x.c (Fx_set_font_path, Fx_get_font_path): New functions - so that packages that distribute their own fonts can access them. - -1998-12-28 Andy Piper - - * glyphs-msw.c (mswindows_button_instantiate): cope with buttons - that have an image provided. - - * glyphs.h: add Q_image decl. - - * glyphs-widget.c new functionality allowing images in - widgets. - (check_valid_glyph_or_image): new function to validate - glyphs passed in through :image. - (widget_normalize): new function. convert :image parameters into - real glyphs if not already so. - (widget_instantiate_1): mess with size parameters to be similar to - :image if provided. - (syms_of_glyphs_widget): new keyword :image. - (image_instantiator_format_create_glyphs_widget): normalize - buttons and allow :image. - -1998-12-27 Andy Piper - - * frame-msw.c (mswindows_init_frame_1): warning elimination. - - * glyphs-widget.c (check_valid_anything): no-op function. - (check_valid_callback): check callbacks in gui_items. - (check_valid_symbol): as it sounds. - (check_valid_string_or_vector): ditto. - (widget_validate): modified for descriptors that are vectors or - sequences of keyword/val pairs. - (widget_instantiate_1): ditto. - (image_instantiator_format_create_glyphs_widget): allow gui_item - keywords in the instantiator. - - * gui.c (gui_parse_item_keywords_internal): renamed from - gui_parse_item_keywords but taking error behaviour. - (gui_parse_item_keywords): use it. - (gui_parse_item_keywords_no_errors): ditto. - (gui_item_add_keyval_pair): add Error_behavior flag and only - signal invalid keywords if required. - - * gui.h: new gui signatures. - - * menubar.c (menu_parse_submenu_keywords): use new - gui_item_add_keyval_pair signature. - - * s/cygwin32.h: modify PTY_ITERATION to eliminate warnings. - -1998-12-28 Martin Buchholz - - * XEmacs 21.2.8 is released. - -1998-12-28 Martin Buchholz - - * editfns.c (get_home_directory): - (user-home-directory): Simplify. - - - * callproc.c (child_setup): - - Environment variables were being passed to inferior processes - using internal encoding. - - Convert to external encoding. - - Rename local var `tem' to better name `tail'. - - Use Flength instead of `manual' calculation. - - * buffer.c (kill-buffer): - (record-buffer): - (set-buffer-major-mode): - (current-buffer): - - Fix up parameter names to correspond to docstrings. - - Don't use `bufname' when a buffer will do as well. - - Remove one unneeded GCPRO. - - * buffer.h (initial_directory): - * buffer.c (init_initial_directory): - - use correct conversions between internal and external format. - (directory_is_current_directory): new function - (init_buffer): convert initial_directory to internal format. - - solve crashes when current working directory is non-ASCII. - - * alloc.c (xmalloc): - (xcalloc): - (xrealloc): - - remove stupid casts, since XEmacs requires an ANSI C system. - (lrecord_type_index): replace abort() with more readable assert(). - - (reset_lcrecord_stats): remove. - (sweep_lcrecords_1): - - replace call to reset_lcrecord_stats() with call to xzero(). - -1998-12-27 Martin Buchholz - - * process-unix.c (unix_create_process): - - Fix crash invoking program with non-ASCII name. - Try invoking xemacs with SHELL=/bin/sh, then M-x shell. - - Remove unused variable `env'. - - Rename `temp' to better name `save_errno'. - - Reorganize code for clarity. But still too chicken to nuke the - BSD 4.2 support. - -1998-12-24 Martin Buchholz - - * XEmacs 21.2.7 is released. - -1998-12-23 Martin Buchholz - - * glyphs.c (decode_device_ii_format): - - Fix indentation. - - Use GET_C_STRING_FILENAME_DATA_ALLOCA with char *, not Extbyte *. - - * glyphs-x.c (x_subwindow_instantiate): - - A image instance mask was being assigned to a image instance type! - - X_SUBWINDOW_INSTANCE_DATA (ii) is not an lvalue in C++. - - * glyphs-msw.c (mswindows_initialize_dibitmap_image_instance): - Fix indentation. - * glyphs-x.h: Make indentation consistent. - - * emacs.c (Fdump_emacs): Remove Steve Martin merge artifacts. - - * glyphs-widget.c (check_valid_glyph): Warning suppression. - - Make it static - - #ifdef it out, since it's not actually used yet (FIX THIS!) - - * glyphs-widget.c: - * glyphs.h: - Move declarations of decode_device_ii_format and - decode_image_instantiator_format into glyphs.h where they belong. - -1998-12-22 Martin Buchholz - - * frame-x.c (x_delete_frame): Revert part of my changes at the - suggestion of Gunnar Evermann - unfortunately no one really - understands this code. - - * callproc.c (init_callproc): code cleanup. - - * free-hook.c (malloc): - (check_malloc): - (__free_hook): - (__malloc_hook): - (__realloc_hook): - (block_input_malloc): - (block_input_realloc): - * device-x.c (x_delete_device): - * emacs.c (voodoo_free_hook): - * events.c (print_event): - (CHECK_EVENT_TYPE): - (CHECK_EVENT_TYPE2): - (CHECK_EVENT_TYPE3): - Use proper prototypes. - Make C_E_T macros a little faster. - Pedantic fiddly little changes. You really don't care. - -1998-12-22 Andy Piper - - * redisplay-output.c (redisplay_clear_region): make sure that - fg/bg colors get set even when we are in the border area. - -1998-12-13 Martin Buchholz - - * console-msw.c: Function definitions follow coding standards - - This prevents e.g. find-tag on Lisp_Event finding DEVENT - -1998-12-11 Martin Buchholz - - * events.h (struct timeout_data): - * event-tty.c (tty_timeout_to_emacs_event): - * event-msw.c (mswindows_wm_timer_callback): - * event-Xt.c (Xt_timeout_to_emacs_event): - * event-msw.c (mswindows_cancel_dispatch_event): - Make sure Lisp_Objects inside events are initialized to Qnil, not - Qnull_pointer, which is now illegal. - -1998-12-10 Martin Buchholz - - * lisp.h: Fix up prototypes to match alloc.c - -1998-12-08 Martin Buchholz - - * windowsnt.h: Remove `support' for using index and rindex - - * filelock.c (current_lock_owner): - - Change uses of index -> strchr, rindex -> strrchr - -1998-12-07 Martin Buchholz - - * sysdep.c (set_descriptor_non_blocking): - Since O_NONBLOCK is now always #defined, make use of fcntl - conditional on F_SETFL being defined. - - * console-msw.c (DHEADgER): - (DOPAQUE_DATA): - (DEVENT): - (DCONS): - (DCONSCDR): - (DSTRING): - (DVECTOR): - (DSYMBOL): - (DSYMNAME): - - max_align_t should not be visible to the user of the - XOPAQUE_DATA macro. - - use Bufbyte instead of char - - parens around (FOOP (obj)) are always redundant. - If they were necessary, we should fix the macro instead. - - Always use string_data(foo) instead of foo->data. - - -1998-12-06 Martin Buchholz - - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h - - * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. - - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! - - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. - -1998-12-01 Martin Buchholz - - * menubar-x.c (menu_item_descriptor_to_widget_value_1): Always use - Qnil, not NULL, to initialize `null' Lisp_Objects. - -1998-11-29 Hrvoje Niksic - - * specifier.c (display_table_validate): Update. - - * redisplay.c (create_text_block): Use them. - - * glyphs.c (display_table_entry): New function. - (get_display_tables): Ditto. - -1998-12-15 Oscar Figueiredo - - * eldap.c (toplevel): Mention that eldap.c compiles with - OpenLDAP libs - (Fldap_open): Use `GET_C_STRING_OS_DATA_ALLOCA' - (Fldap_search_internal): Ditto - -1998-12-11 Martin Buchholz - - * event-msw.c (mswindows_cancel_dispatch_event): - Gratuitous code prettification - - -1998-12-07 Hrvoje Niksic - - * fns.c (Fnconc): Fix use of wrong_type_argument(). - - * floatfns.c (Ffloat): Fix docstring. - (Ffloat): Fix use of wrong_type_argument(). - (Fabs): Ditto. - (extract_float): Ditto. - (Fceiling): Ditto. - (Fround): Ditto. - (Ftruncate): Ditto. - -1998-12-06 Martin Buchholz - - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h - - * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. - - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! - - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. - -1998-12-02 Didier Verna - - * menubar-x.c (menu_item_descriptor_to_widget_value_1): set the - accelerator field to nil for labels. - -1998-12-16 Jonathan Harris - - * menubar-msw.c (displayable_menu_item): - Escape occurrences of '&' and support occurrences of the - '%_' accelerator indicator in menus. - -1998-11-26 Didier Verna - - * dired.c (Fdirectory_files): use make_string instead of - make_ext_string on the filename. The conversion external->internal - format is already done in sys_readdir. - -1998-12-15 Gunnar Evermann - - * glyphs.c (normalize_image_instantiator): GCPRO instantiator - -1998-12-16 Jonathan Harris - - * event-msw.c - (Belatedly) added Kirill to list of file's authors. - emacs_mswindows_quit_p: Don't process WM_PAINT messages in - quit checking. WM_PAINT messages cause redisplay, but - windows' states are not necessarily stable when this function - gets called. - -1998-12-17 Andy Piper - - * strftime.c (zone_name): CONSTify. - -1998-12-15 Andy Piper - - * glyphs-msw.c (mswindows_combo_instantiate): ditto. - (mswindows_widget_property): return Qunbound when no property available. - (mswindows_button_property): ditto. - (mswindows_combo_property): ditto. - (mswindows_widget_set_property): ditto. - - * glyphs-widget.c (check_valid_item_list): use properties. - - * glyphs.h (struct Lisp_Image_Instance): we have properties now. - - * glyphs.c (Fset_image_instance_property): allow setting of arbitrary properties. - (Fimage_instance_property): ditto. - * glyphs-widget.c (widget_property): ditto. - (widget_set_property): ditto. - - * frame-msw.c (mswindows_set_frame_pointer): SetCursor() as well - as setting the class cursor so that GC actually changes the - cursor. - - * config.h: don't undef MAIL_USE_POP. - -1998-12-13 Andy Piper - - * glyphs-msw.c - (image_instantiator_format_create_glyphs_mswindows): line -> - label. - (mswindows_label_instantiate): ditto. Play with window flags. - (image_instantiator_format_create_glyphs_mswindows): ditto. - (vars_of_glyphs_mswindows): provide Qlabel as we support it now. - - * glyphs-widget.c (widget_instantiate_1): re-jig autosizing to - cope with lines and labels. - (static_instantiate): use widget_instantiate_1. - line -> label. - (image_instantiator_format_create_glyphs_widget): ditto. - -1998-12-10 Andy Piper - - * Makefile.in.in (objs): add gui.o - -1998-12-10 Andy Piper - - * gui.c: adjust defines of HAVE_POPUPS so that we can build with - no window system. - -1998-12-09 Andy Piper - - * glyphs.c (finalize_image_instance): mark glyphs changed when an - image instance is removed so that the subwindow cache gets reset - and thus destroyed images get GC'd. - -1998-12-08 Andy Piper - - * gui-msw.c (mswindows_handle_gui_wm_command): call - MARK_SUBWINDOWS_CHANGED. - - * glyphs-msw.c (mswindows_finalize_image_instance): make sure - subwindows really get deleted. - - * redisplay.c: new variable subwindows_changed[_set]. - (redisplay_window): use it. - (redisplay_frame): ditto. - (redisplay_device): ditto. - (redisplay_without_hooks): ditto. - - * device.h (MARK_DEVICE_SUBWINDOWS_CHANGED): new macro for - subwindows redisplay as per glyphs equivalent. - * redisplay.h: ditto. - (MARK_SUBWINDOWS_CHANGED): ditto. - (RESET_CHANGED_SET_FLAGS): ditto. - * frame.h (MARK_FRAME_SUBWINDOWS_CHANGED): ditto. - -1998-12-07 Andy Piper - - * frame.c (Fmake_frame): reset subwindow cachels on non-stream - frames. - - * redisplay.c (redisplay_frame): invalidate subwindow cachels. - - * event-msw.c (mswindows_wnd_proc): catch the various WM_CTLCOLOR* - messages and paint widget glyphs as appropriate with their face fg - & bg. - -1998-12-06 Andy Piper - - * glyphs-msw.c (vars_of_glyphs_mswindows): provide widget types - here rather than in glyphs-widget - do this because we only want - to provide what is really available. - - * glyphs.c (Fimage_instance_property): new function to get the - properties of image instances. wires through to console specific - methods and then to widget specific methods. - (Fset_image_instance_property): ditto but for setting widget properties. - (check_valid_face): make extern so that it can be used elsewhere. - - * glyphs-widget.c (widget_property): new function. gets the - properties of widgets in general and wires the function through to - widget specific ones. - (widget_set_property): ditto but for setting widget properties. - - * glyphs-msw.c (mswindows_combo_instantiate): Add functionality to - add items to the list. Play with window styles a bit to get the - desired effect. - (mswindows_widget_property): break out specific widget properties. - (mswindows_button_property): new function. gets the checked state - of a button. - (mswindows_combo_property): new function. gets the current - selection in the combo box. - (mswindows_widget_set_property): new function. sets specific - properties of specific widgets. - - * glyphs-widget.c (check_valid_item_list): new function. check - that items for a combo-box are just a list of strings. - (combo_validate): new function. check there is an item list. - (widget_instantiate_1): new function. renamed from - widget_instantiate so that we can do slightly different things for - other widgets. - (widget_instantiate): call widget_instantiate_1. - (combo_instantiate): new function to instantiate combo boxes, - defaults height to the pixel height of the number of items in the - box. - (syms_of_glyphs_widget): move widget keywords here. - (image_instantiator_format_create_glyphs_widget): use new combo - functions. - -1998-12-04 Andy Piper - - * event-msw.c (mswindows_wnd_proc): mule-ize. - - * glyphs.c (pixmap_to_lisp_data): mule-ize. - - * glyphs-msw.c (extract_xpm_color_names): mule-ize. - (resource_name_to_resource): ditto. - (mswindows_resource_instantiate): ditto. - (mswindows_widget_instantiate): ditto. - (mswindows_widget_set_property): ditto. - - * redisplay-output.c (redisplay_output_subwindow): don't show - subwindows if they are obscured at the edge of the frame, emacs - gets into some sort of redisplay loop otherwise. - - * gui.h: prototype gui_item_selected_p. - - * gui.c (gui_item_selected_p): new function to determine the - selected state of a gui_item. - - * frame.h (struct frame): add subwindows_changed flag. - - * redisplay.c (redisplay_frame): call update_frame_subwindows (). - - * glyphs.c (update_subwindow): new function to update a - subwindow's state. - (update_frame_subwindows): new function to update all the - subwindows on a frame. - - * console.h (struct console_methods): add update_subwindow. - - * glyphs-msw.c (mswindows_widget_property): return selected state - for selected property. - (mswindows_update_subwindow): new function. updates widget glyphs - in redisplay as per menubars or toolbars e.g. selected state. - (console_type_create_glyphs_mswindows): add update_subwindow. - -1998-12-03 Andy Piper - - * console-tty.c (syms_of_console_tty): MULE -> FILE_CODING since - tty coding system things are such. - - * glyphs-widget.c (widget_face_font_info): new function for - pulling out height and width metrics for a widget's face. - (widget_text_to_pixel_conversion): calculate pixel sizes of text - for widgets. - - * event-msw.c (mswindows_drain_windows_queue): translate messages - that are destined for subwindows. This makes edit fields interact - with the keyboard correctly. - nuke warnings by #ifndef'ing out stuff not required by msg select(). - - * glyphs.h (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM): new - macro defining the iiforma without the symbol required by widget. - (INITIALIZE_IMAGE_INSTANTIATOR_FORMAT): use it. - - * general.c (syms_of_general): add Qwidget, Qselected. - - * faces.c (complex_vars_of_faces): add widget face inheriting from - gui-element face. - -1998-11-09 Andy Piper - - * window.h (struct window): add a cache of subwindows on a - per-window basis. - - * window.c (mark_window): mark the subwindow_instance_cache. - (allocate_window): initialise the subwindow instance_cache. - - * toolbar-x.c (x_output_toolbar): call redisplay_clear_region - instead of the devmeth. - (x_clear_toolbar): ditto. - - * redisplay-x.c (x_output_display_block): call - redisplay_output_subwindow for subwindows and widgets. - - * redisplay-tty.c (tty_output_display_block): add IMAGE_WIDGET to - types to do nothing for. - - * lisp.h: declare new widget/subwindow symbols. - - * glyphs.c (image_instantiate): cache subwindows on a per-window - basis. - (subwindow_possible_dest_types): new function for subwindow dest - types. - (subwindow_instantiate): generic instantiation of a - subwindow. specialised by device multi-methods. - (Fsubwindowp): moved from glyphs-x.c. adapted for glyph-based - subwindows. - (Fimage_instance_subwindow_id): ditto. - (Fresize_subwindow): ditto. - (Fforce_subwindow_map): ditto. - - * glyphs-x.c (x_print_image_instance): remove subwindow - stuff. Handled genrically in glyphs.c. - (x_image_instance_equal): ditto. - (x_image_instance_hash): ditto. - (x_finalize_image_instance): delete subwindows when required. - (mark_subwindow) (print_subwindow) (finalize_subwindow) - (subwindow_hash) (Fmake_subwindow): deleted because of new, - glyph-based, subwindow implementation. - (Fsubwindow_height) (Fsubwindow_width) (Fsubwindow_xid): aliased - in glyphs.el - (Fsubwindowp) (Fresize_subwindow) (Fforce_subwindow_map): moved to - glyphs.c. - (x_unmap_subwindow): new function to unmap X subwindows. - (x_map_subwindow): new function to map X subwindows. - (x_subwindow_instantiate): new function to instantiate X - subwindows. - (x_resize_subwindow): new function to resize X subwindows. - (console_type_create_glyphs_x): add subwindow functions. - (image_instantiator_format_create_glyphs_x): add device - multi-methods for xpm, xbm and subwindow. - - * glyphs.el (subwindow-xid): old alias for new subwindow functions. - (subwindow-width): ditto. - (subwindow-height): ditto. - - * glyphs-msw.c (mswindows_widget_instantiate): new function for - generally instantiating ms subwindows. Used by - mswindows_*_instantiate. - (mswindows_edit_instantiate): instantiate an edit field on a - mswindows frame. - -1998-11-04 Andy Piper - - * symsinit.h: declare new functions. - - * redisplay.h: declare new functions. - - * redisplay-x.c (x_output_display_block): call - redisplay_clear_region rather than x_clear_region. - (x_output_string): ditto. - (x_output_pixmap): ditto. - (x_clear_to_window_end): ditto. - (x_output_eol_cursor): ditto. - (x_clear_region): only do X specific things. other duties handled - in redisplay_clear_region. - - * redisplay-tty.c (tty_clear_region): do tty specific things - some - duties moved to redisplay_clear_region. - - * redisplay-output.c (clear_left_border): use - redisplay_clear_region instead of device method. - (clear_right_border): ditto. - (output_display_line): ditto. - (redisplay_output_subwindow): ditto. - (redisplay_clear_top_of_window): ditto. - (redisplay_clear_region): perform duties previously handled by - device methods. call the appropriate device method at the - end. unmap subwindows if necessary. - - * redisplay-msw.c (mswindows_output_string): use - redisplay_clear_region instead of mswindows_clear_region. - (mswindows_clear_to_window_end): ditto. - (mswindows_output_display_block): output subwindows when required. - (mswindows_clear_region): only do mswindows specific things, - everything else is now handled in redisplay_clear_region. - - * gui.h: add item id hash defines and declare function prototypes. - - * gui.c (mark_gui_item): new function for marking gui_items. - (gui_item_hash): generic hash function for generating command ids - for gui_items. - - * gui-msw.c: new file. - (mswindows_handle_gui_wm_command): new function to handle widget - callbacks. - - * glyphs.h (MAYBE_IIFORMAT_DEVMETH): new function for device - multi-methods. - (IIFORMAT_HAS_SHARED_METHOD): ditto. - (DEFINE_DEVICE_IIFORMAT): ditto. - (INITIALIZE_DEVICE_IIFORMAT): ditto. - (struct Lisp_Image_Instance): add widget and subwindow data plus - appropriate access functions. - - * glyphs.c (decode_device_ii_format): new function for decoding - image instantiator functions based on a device type as well as an - image format. - (decode_image_instantiator_format): just call - decode_device_ii_format with nil device. - (add_entry_to_device_ii_format_list): new function for per device - method instances. - (add_entry_to_image_instantiator_format_list): just call - add_entry_to_device_ii_format_list with nil device. - (check_valid_vector): new function. - (instantiate_image_instantiator): instantiate using per-format - method and then per-format-per-device method (device - multi-methods). signal an error if neither is possible. - (mark_image_instance): cope with subwindows and widgets. - (print_image_instance): ditto. - (image_instance_equal): ditto. - (image_instance_hash): ditto. - (allocate_glyph): ditto. - (glyph_width): ditto. - (glyph_height_internal): ditto. - (xpm_instantiate): removed because of device multi-methods. - (mark_subwindow_cachels): new cachel functions for caching - instantiated subwindows on a per-frame basis. mostly copied from - glyph cachel functions. - (update_subwindow_cachel_data): ditto. - (add_subwindow_cachel): ditto. - (get_subwindow_cachel_index): ditto. - (reset_subwindow_cachels): ditto. - (mark_subwindow_cachels_as_not_updated): ditto. - (unmap_subwindow): generic unmapping of subwindows based on cachel - data. - (map_subwindow): ditto. - (initialize_subwindow_image_instance): generic initialisation of - subwindow data. - (syms_of_glyphs): add widget keywords. - - * glyphs-x.h (struct x_subwindow_data): convert Lisp_Subwindow to - x_subwindow_data. - -1998-11-04 Andy Piper - - * glyphs-widget.c: new file for instantiating widget type glyphs. - (widget_possible_dest_types): new general dest type function for - widgets. - (widget_validate): ditto. - (initialize_widget_image_instance): ditto - (widget_instantiate): ditto. Sets up fg/bg, gui_item parsing - before handing on control to device multi-methods. - (syms_of_glyphs_widget): new function. - (image_instantiator_format_create_glyphs_widget): new function, - added placeholders for button, edit, combo, scrollbar - (vars_of_glyphs_widget): new function. - - * glyphs-msw.h (WIDGET_INSTANCE_MSWINDOWS_HANDLE): new define for - storing window ids of widgets. - - * glyphs-msw.c (mswindows_finalize_image_instance): cope with - deletion of widget and subwindow glyphs. - (mswindows_unmap_subwindow): new device function for unmapping - subwindows on a msw frame. - (mswindows_map_subwindow): ditto. - (mswindows_register_image_instance): register instantiated widgets - with the widget hastable. - (mswindows_button_instantiate): instantiate a button type widget - on an msw frame. - (mswindows_subwindow_instantiate): instanttiate a subwindow on a - mswindows frame. - (image_instantiator_format_create_glyphs_mswindows): add device - multi-methods for xbm, xpm, subwindow, edit and button. - - * frame.h (struct frame): add subwindow_cachels dynarr for caching - information about subwindows visible on the current frame. used by - redisplay_clear_region to unmap subwindows as required. - - * frame.c (mark_frame): mark subwindow_cachels. - (allocate_frame_core): instantiate subwindow_cachels. - - * frame-msw.c (mswindows_init_frame_1): instntiate and mark the - widget hashtable. - - * event-msw.c (mswindows_wnd_proc): add call to - mswindows_handle_gui_wm_command to handle widget callbacks. - - * emacs.c (main_1): add calls to glyphs-widget initialisation - routines. - - * console.h (struct console_methods): add - unmap/map_subwindow_method for use be redisplay_clear_region to - map and unmap subwindows. Remove xpm and xbm stuff - now dealt - with by image instantiator multi-methods. Add - resize_subwindow_method. - - * console-stream.c (stream_clear_region): change signature to - match new generic clear region function. - - * Makefile.in.in: add glyphs-widget.o to list of objects. - - * console-msw.h (struct mswindows_frame): add widget hashtable for - wiring command ids to callbacks. - -1998-12-16 Andy Piper - - * XEmacs 21.2.6 is released - -1998-12-08 Hrvoje Niksic - - * md5.c (Fmd5): Correctly initiate string input stream. - - * Makefile.in.in (tests): Add md5-tests.el. - -1998-12-06 Martin Buchholz - - * lisp.h: - * alloc.c (make_vector): remove travesty - (Fmake_vector): - (make_pure_vector): - (pure_cons): - (make_bit_vector_internal): - (make_bit_vector): - (make_bit_vector_from_byte_vector): - (Fmake_bit_vector): - - make vector_equal a little faster. - - Don't use variable name `new'. - - Use size_t instead of EMACS_INT. - - usual Martin-style pointless bit-twiddling. - - * fns.c (mapcar1): - (Fmapconcat): - (Fmapcar): - (Fmapvector): - Make mapcar faster. In particular, make - (mapc #'identity long-string) - MUCH faster under Mule. - * tests/automated/lisp-tests.el: Test 'em! - -1998-12-06 Martin Buchholz - - * bytecode.c (Ffetch_bytecode): Fix crash when loading lazy-loaded - bytecode. - -1998-12-13 Martin Buchholz - - * console-msw.c: Function definitions follow coding standards - - This prevents e.g. find-tag on Lisp_Event finding DEVENT - -1998-12-11 Martin Buchholz - - * events.h (struct timeout_data): - * event-tty.c (tty_timeout_to_emacs_event): - * event-msw.c (mswindows_wm_timer_callback): - * event-Xt.c (Xt_timeout_to_emacs_event): - * event-msw.c (mswindows_cancel_dispatch_event): - Make sure Lisp_Objects inside events are initialized to Qnil, not - Qnull_pointer, which is now illegal. - -1998-12-10 Martin Buchholz - - * lisp.h: Fix up prototypes to match alloc.c - -1998-12-09 Andy Piper - - * glyphs-msw.c (init_image_instance_from_xbm_inline): don't use - XSETINT for assigning lisp objects. - -1998-12-07 Martin Buchholz - - * opaque.h: - * console-msw.c (DHEADER): - (DOPAQUE_DATA): - (DEVENT): - (DCONS): - (DCONSCDR): - (DSTRING): - (DVECTOR): - (DSYMBOL): - (DSYMNAME): - - max_align_t should not be visible to the user of the - XOPAQUE_DATA macro. - - use Bufbyte instead of char - - parens around (FOOP (obj)) are always redundant. - If they were necessary, we should fix the macro instead. - - Always use string_data(foo) instead of foo->data. - -1998-12-07 Martin Buchholz - - * sysdep.c (set_descriptor_non_blocking): - Since O_NONBLOCK is now always #defined, make use of fcntl - conditional on F_SETFL being defined. - -1998-12-09 Andy Piper - - * menubar-msw.c (mswindows_handle_wm_command): add back in checks - that got removed in the merge - -1998-11-30 Greg Klanderman - - * dired.c (vars_of_dired): bugfix for previous conditionalization - of user-name-completion on non- Windows NT. - -1998-12-08 Martin Buchholz - - * windowsnt.h: Remove `support' for using index and rindex - - * filelock.c (current_lock_owner): - - Change uses of index -> strchr, rindex -> strrchr - -1998-12-06 Martin Buchholz - - * frame-msw.c (mswindows_init_frame_1): - - use make_lisp_hash_table, not Fmake_hash_table - - include elhash.h - -1998-12-05 XEmacs Build Bot - - * XEmacs 21.2.5 is released - -1998-11-30 Martin Buchholz - - * xselect.c (receive_incremental_selection): - * xselect.c (x_get_window_property): - * xmu.c (XmuReadBitmapDataFromFile): - * xmu.c (XmuCursorNameToIndex): - * xgccache.c (describe_gc_cache): - * xgccache.c (gc_cache_lookup): - * xgccache.c (free_gc_cache): - * xgccache.c (make_gc_cache): - * window.h: - * window.c (map_windows_1): - * window.c (Fother_window_for_scrolling): - * window.c (window_scroll): - * window.c (change_window_height): - * window.c (Fsplit_window): - * window.c (window_left_gutter_width): - * window.c (window_modeline_height): - * window.c (invalidate_vertical_divider_cache_in_window): - * window.c (window_needs_vertical_divider_1): - * window.c (update_mirror_internal): - * window.c (SET_LAST_FACECHANGE): - * widget.c (Fwidget_plist_member): - * unexec.c (copy_text_and_data): - * unexcw.c (copy_executable_and_dump_data_section): - * tooltalk.doc: - * tooltalk.c (struct Lisp_Tooltalk_Pattern): - * tooltalk.c (struct Lisp_Tooltalk_Message): - * toolbar.h (struct toolbar_button): - * toolbar.c (default_toolbar_visible_p_changed_in_window): - * toolbar.c (recompute_overlaying_specifier): - * toolbar.c (toolbar_validate): - * toolbar.c (toolbar_button_at_pixpos): - * toolbar.c (get_toolbar_coords): - * toolbar.c (update_frame_toolbars): - * toolbar-x.c: - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): - * toolbar-msw.c (mswindows_find_toolbar_pos): - * toolbar-msw.c (mswindows_output_toolbar): - * toolbar-msw.c (mswindows_clear_toolbar): - * toolbar-msw.c: - * systty.h: - * syssignal.h: - * sysproc.h: - * sysfile.h: - * sysdll.c: - * sysdep.h: - * sysdep.c (rmdir): - * sysdep.c (sys_fopen): - * sysdep.c (sys_open): - * sysdep.c (tty_init_sys_modes_on_device): - * sysdep.c (get_eof_char): - * sysdep.c (child_setup_tty): - * sysdep.c (set_descriptor_non_blocking): - * syntax.h: - * syntax.c (scan_words): - * syntax.c: - * symsinit.h: - * symeval.h (struct symbol_value_varalias): - * symeval.h (struct symbol_value_forward): - * symbols.c (syms_of_symbols): - * symbols.c (init_symbols_once_early): - * symbols.c (Fbuilt_in_variable_type): - * symbols.c (Fsymbol_value_in_buffer): - * symbols.c (default_value): - * symbols.c (Fset): - * symbols.c (find_symbol_value_quickly): - * symbols.c (store_symval_forwarding): - * symbols.c (set_default_console_slot_variable): - * symbols.c (set_default_buffer_slot_variable): - * symbols.c (verify_ok_for_buffer_local): - * symbols.c (symbol_is_constant): - * symbols.c (oblookup): - * symbols.c (Funintern): - * symbols.c (Fintern): - * symbols.c (check_obarray): - * sunplay.c: - * specifier.h (struct specifier_methods): - * specifier.h: - * specifier.c (specifier_instance): - * specifier.c (specifier_instance_from_inst_list): - * specifier.c (decode_locale_type): - * specifier.c (specifier_equal): - * specifier.c (finalize_specifier): - * specifier.c (prune_specifiers): - * specifier.c (kill_specifier_buffer_locals): - * sound.c (init_native_sound): - * sound.c: - * signal.c (alarm): - * search.c (Fmatch_data): - * search.c (match_limit): - * search.c (Freplace_match): - * search.c (skip_chars): - * search.c (scan_buffer): - * search.c: - * scrollbar.c (specifier_vars_of_scrollbar): - * scrollbar.c (Fscrollbar_set_hscroll): - * scrollbar.c (vertical_scrollbar_changed_in_window): - * scrollbar.c (release_window_mirror_scrollbars): - * scrollbar.c (free_scrollbar_instance): - * scrollbar-x.c: - * scrollbar-msw.c: - * s/msdos.h (O_BINARY): - * s/linux.h: - * s/freebsd.h (LIBS_TERMCAP): - * regex.c (re_match_2_internal): - * regex.c (compile_extended_range): - * regex.c (POP_FAILURE_POINT): - * regex.c (PUSH_FAILURE_POINT): - * redisplay.h (RESET_CHANGED_SET_FLAGS): - * redisplay.h: - * redisplay.h (struct display_line): - * redisplay.h (struct rune): - * redisplay.c (vars_of_redisplay): - * redisplay.c (redisplay_variable_changed): - * redisplay.c (UPDATE_CACHE_RETURN): - * redisplay.c (validate_line_start_cache): - * redisplay.c (mark_redisplay_structs): - * redisplay.c (mark_glyph_block_dynarr): - * redisplay.c (window_line_number): - * redisplay.c (redisplay_frame): - * redisplay.c (redisplay_window): - * redisplay.c (generate_modeline): - * redisplay.c (create_right_glyph_block): - * redisplay.c (create_left_glyph_block): - * redisplay.c (create_text_block): - * redisplay.c: - * redisplay-x.c (x_output_hline): - * redisplay-x.c (x_output_vertical_divider): - * redisplay-tty.c (tty_output_display_block): - * redisplay-output.c (output_display_line): - * redisplay-output.c: - * redisplay-msw.c (mswindows_output_vertical_divider): - * redisplay-msw.c (mswindows_ring_bell): - * redisplay-msw.c (mswindows_output_cursor): - * redisplay-msw.c: - * rangetab.c: - * ralloc.c: - * puresize.h (RAW_PURESIZE): - * profile.c (syms_of_profile): - * profile.c (Fstart_profiling): - * profile.c (sigprof_handler): - * profile.c: - * procimpl.h: - * process.c (vars_of_process): - * process.c (read_process_output): - * process.c (get_process): - * process.c: - * process-unix.c (unix_open_multicast_group): - * process-unix.c (unix_get_tty_name): - * process-unix.c (unix_send_process): - * process-unix.c (unix_reap_exited_processes): - * process-unix.c (unix_create_process): - * process-unix.c (unix_init_process_io_handles): - * process-unix.c (allocate_pty): - * process-unix.c: - * process-nt.c (nt_open_network_stream): - * process-nt.c (nt_update_status_if_terminated): - * process-nt.c (nt_finalize_process_data): - * process-nt.c: - * print.c (debug_short_backtrace): - * print.c (debug_backtrace): - * print.c (print_symbol): - * print.c (print_internal): - * print.c (print_cons): - * print.c (Fwrite_char): - * print.c (print_prepare): - * print.c (canonicalize_printcharfun): - * print.c (output_string): - * print.c: - * opaque.h: - * opaque.c (allocate_managed_opaque): - * opaque.c: - * offix.c (DndSetData): - * objects.c (face_boolean_create): - * objects.c (font_instantiate): - * objects.c (font_create): - * objects.c (color_create): - * objects.c (finalize_font_instance): - * objects.c (finalize_color_instance): - * objects.c: - * objects-x.c (x_font_instance_truename): - * objects-x.c: - * objects-x.c (x_initialize_font_instance): - * objects-x.c (allocate_nearest_color): - * objects-tty.c (tty_initialize_font_instance): - * objects-tty.c (tty_initialize_color_instance): - * objects-msw.c (mswindows_initialize_color_instance): - * ntproc.c (syms_of_ntproc): - * ntproc.c (Fwin32_set_process_priority): - * ntproc.c (sys_spawnve): - * ntproc.c: - * ntheap.c (get_data_end): - * nt.c (period): - * nt.c: - * nt.c (stat): - * nt.c (generate_inode_val): - * nt.c (sys_rename): - * nas.c: - * mule-wnnfns.c (Fwnn_hinsi_number): - * mule-wnnfns.c (Fwnn_yuragi): - * mule-wnnfns.c (Fwnn_common_learn): - * mule-wnnfns.c (Fwnn_suffix_learn): - * mule-wnnfns.c (Fwnn_prefix_learn): - * mule-wnnfns.c (Fwnn_okuri_learn): - * mule-wnnfns.c (Fwnn_complex_conv): - * mule-wnnfns.c (Fwnn_last_is_first): - * mule-wnnfns.c (Fwnn_bmodify_dict_add): - * mule-wnnfns.c (Fwnn_notrans_dict_add): - * mule-wnnfns.c (Fwnn_fiusr_dict_add): - * mule-wnnfns.c (Fwnn_fisys_dict_add): - * mule-wnnfns.c (Fwnn_hinsi_list): - * mule-wnnfns.c (Fwnn_fuzokugo_set): - * mule-wnnfns.c (Fwnn_dict_search): - * mule-wnnfns.c (Fwnn_word_toroku): - * mule-wnnfns.c (Fwnn_hindo_update): - * mule-wnnfns.c (Fwnn_bunsetu_henkou): - * mule-wnnfns.c (Fwnn_kakutei): - * mule-wnnfns.c (Fwnn_begin_henkan): - * mule-wnnfns.c (Fwnn_dict_comment): - * mule-wnnfns.c (Fwnn_dict_add): - * mule-wnnfns.c (Fwnn_open): - * mule-mcpath.c (mc_getcwd): - * mule-coding.c (vars_of_mule_coding): - * mule-coding.c (convert_to_external_format): - * mule-coding.c (encoding_marker): - * mule-coding.c (decoding_marker): - * mule-coding.c (Fcopy_coding_system): - * mule-coding.c (Fmake_coding_system): - * mule-coding.c (Fcoding_system_list): - * mule-coding.c (Ffind_coding_system): - * mule-coding.c (symbol_to_eol_type): - * mule-coding.c: - * mule-charset.c (complex_vars_of_mule_charset): - * mule-charset.c (vars_of_mule_charset): - * mule-charset.c (Fset_charset_ccl_program): - * mule-charset.c (struct charset_list_closure): - * mule-charset.c (Ffind_charset): - * mule-charset.c (make_charset): - * mule-charset.c (non_ascii_valid_char_p): - * mule-charset.c: - * mule-ccl.c (ccl_driver): - * mule-canna.c (c2mu): - * mule-canna.c (Fcanna_henkan_begin): - * mule-canna.c (Fcanna_parse): - * mule-canna.c (Fcanna_store_yomi): - * mule-canna.c (Fcanna_touroku_string): - * mule-canna.c (Fcanna_initialize): - * minibuf.c: - * menubar.c (menu_parse_submenu_keywords): - * menubar-x.c (make_dummy_xbutton_event): - * menubar-x.c (set_frame_menubar): - * menubar-x.c (menu_item_descriptor_to_widget_value_1): - * menubar-x.c: - * menubar-msw.h: - * menubar-msw.c (mswindows_popup_menu): - * menubar-msw.c (mswindows_update_frame_menubars): - * menubar-msw.c (mswindows_handle_wm_command): - * menubar-msw.c (unsafe_handle_wm_initmenu_1): - * menubar-msw.c (unsafe_handle_wm_initmenupopup_1): - * menubar-msw.c (update_frame_menubar_maybe): - * menubar-msw.c (populate_or_checksum_helper): - * menubar-msw.c (empty_menu): - * menubar-msw.c: - * md5.c: - * marker.c (set_marker_internal): - * marker.c (print_marker): - * malloc.c: - * make-src-depend: - * lstream.c (lisp_buffer_rewinder): - * lstream.c (mark_lstream): - * lrecord.h: - * lrecord.h (struct lrecord_header): - * lread.c (readevalloop): - * lread.c (locate_file): - * lread.c (locate_file_in_directory): - * lread.c (Flocate_file): - * lread.c (load_force_doc_string_unwind): - * lread.c (ebolify_bytecode_constants): - * lread.c: - * lisp.h: - * lisp-union.h: - * lisp-disunion.h: - * linuxplay.c (linux_play_data_or_file): - * linuxplay.c (audio_init): - * line-number.c: - * keymap.h: - * keymap.c (describe_map): - * keymap.c (describe_map_mapper): - * keymap.c (Fdescribe_bindings_internal): - * keymap.c (Fsingle_key_description): - * keymap.c (map_keymap_sorted): - * keymap.c (get_relevant_keymaps): - * keymap.c (Flookup_key): - * keymap.c (raw_lookup_key_mapper): - * keymap.c (Fdefine_key): - * keymap.c (Fevent_matches_key_specifier_p): - * keymap.c (key_desc_list_to_event): - * keymap.c (define_key_parser): - * keymap.c (define_key_check_and_coerce_keysym): - * keymap.c (keymap_submaps): - * keymap.c (keymap_store_internal): - * keymap.c (keymap_delete_inverse_internal): - * keymap.c (keymap_store_inverse_internal): - * keymap.c (print_keymap): - * keymap.c (Lisp_Keymap): - * keymap.c: - * intl.c: - * insdel.c (convert_bufbyte_string_into_emchar_dynarr): - * insdel.c (make_gap): - * input-method-xlib.c (get_XIM_input): - * input-method-xlib.c (XIM_init_frame): - * imgproc.c: - * hash.h: - * hash.c: - * gui.c: - * gui-x.c (button_item_to_widget_value): - * gui-x.c (popup_selection_callback): - * glyphs.h (struct image_instantiator_methods): - * glyphs.c (mark_glyph_cachels): - * glyphs.c (Fglyph_type): - * glyphs.c (image_instantiate): - * glyphs.c (image_create): - * glyphs.c (make_image_instance_1): - * glyphs.c (finalize_image_instance): - * glyphs.c: - * glyphs-x.c (finalize_subwindow): - * glyphs-x.c (xface_validate): - * glyphs-x.c (x_locate_pixmap_file): - * glyphs-x.c (convert_EImage_to_XImage): - * glyphs-msw.c: - * glyphs-msw.c (mswindows_resource_instantiate): - * glyphs-msw.c (xpm_to_eimage): - * glyphs-msw.c (convert_EImage_to_DIBitmap): - * glyphs-eimage.c (tiff_instantiate): - * glyphs-eimage.c (png_instantiate): - * glyphs-eimage.c (struct png_error_struct): - * glyphs-eimage.c (gif_memory_storage): - * glyphs-eimage.c: - * gifrlib.h: - * getloadavg.c (getloadavg): - * getloadavg.c: - * gdbinit: - * free-hook.c (log_gcpro): - * free-hook.c (check_malloc): - * free-hook.c (check_free): - * free-hook.c (ROUND_UP_TO_PAGE): - * free-hook.c: - * frame.h (struct frame): - * frame.h: - * frame.c (change_frame_size_1): - * frame.c (allocate_frame_core): - * frame.c: - * frame-x.c (x_focus_on_frame): - * frame-x.c (x_init_frame_2): - * frame-x.c (x_popup_frame): - * frame-x.c (xemacs_XtPopup): - * frame-x.c: - * frame-x.c (Foffix_start_drag_internal): - * frame-x.c (x_cde_destroy_callback): - * frame-x.c (x_wm_hack_wm_protocols): - * frame-tty.c (tty_frame_visible_p): - * frame-msw.c (mswindows_make_frame_invisible): - * frame-msw.c (mswindows_after_init_frame): - * frame-msw.c (mswindows_init_frame_1): - * fns.c (syms_of_fns): - * fns.c (Fbase64_decode_string): - * fns.c (Fnconc): - * fns.c (Ffillarray): - * fns.c (Fobject_plist): - * fns.c (Fget): - * fns.c (Fcanonicalize_lax_plist): - * fns.c (Fcanonicalize_plist): - * fns.c (Fplist_remprop): - * fns.c (Fplist_get): - * fns.c (advance_plist_pointers): - * fns.c (internal_plist_put): - * fns.c (Fnreverse): - * fns.c (Fremassq): - * fns.c (Felt): - * fns.c (Fsubstring): - * fns.c (Fbvconcat): - * fns.c (Flength): - * fns.c (length_with_bytecode_hack): - * fns.c (print_bit_vector): - * fns.c: - * floatfns.c (Ffloor): - * floatfns.c: - * floatfns.c (in_float_error): - * fileio.c (Ffile_modes): - * fileio.c (Fexpand_file_name): - * fileio.c (Fmake_temp_name): - * fileio.c (Ffile_name_nondirectory): - * fileio.c (Ffile_name_directory): - * file-coding.h: - * file-coding.c (vars_of_mule_coding): - * file-coding.c (convert_to_external_format): - * file-coding.c (encoding_marker): - * file-coding.c (decoding_marker): - * file-coding.c (Fcopy_coding_system): - * file-coding.c (Fmake_coding_system): - * file-coding.c (struct coding_system_list_closure): - * file-coding.c (Ffind_coding_system): - * file-coding.c (symbol_to_eol_type): - * file-coding.c: - * faces.h (struct face_cachel): - * faces.c (vars_of_faces): - * faces.c (face_property_was_changed): - * faces.c (mark_face_cachels): - * faces.c (temporary_faces_list): - * faces.c (struct face_list_closure): - * faces.c: - * extents.h (struct extent): - * extents.c (vars_of_extents): - * extents.c (struct copy_string_extents_1_arg): - * extents.c (add_string_extents_mapper): - * extents.c (Fextent_property): - * extents.c (Fset_extent_property): - * extents.c (symbol_to_glyph_layout): - * extents.c (properties_equal): - * extents.c (print_extent): - * extents.c (print_extent_1): - * extents.c (extent_in_region_p): - * extents.c (gap_array_make_gap): - * extents.c: - * events.h (struct Lisp_Event): - * events.h: - * events.c (Fevent_properties): - * events.c (format_event_object): - * events.c (Fmake_event): - * events.c (event_equal): - * events.c (print_event): - * events.c (mark_event): - * event-stream.c ((read-char) - * event-stream.c (vars_of_event_stream): - * event-stream.c (syms_of_event_stream): - * event-stream.c (Fset_recent_keys_ring_size): - * event-stream.c (Fsit_for): - * event-stream.c (Fnext_event): - * event-stream.c (execute_help_form): - * event-stream.c (maybe_kbd_translate): - * event-stream.c: - * event-msw.c (vars_of_event_mswindows): - * event-msw.c (mswindows_wnd_proc): - * event-msw.c (mswindows_need_event): - * event-msw.c (mswindows_drain_windows_queue): - * event-msw.c (mswindows_pump_outstanding_events): - * event-msw.c: - * event-msw.c (slurp_thread): - * event-msw.c (struct ntpipe_slurp_stream): - * event-msw.c (HANDLE_TO_USID): - * event-Xt.c (emacs_Xt_handle_magic_event): - * event-Xt.c (x_event_to_emacs_event): - * event-Xt.c (x_reset_modifier_mapping): - * event-Xt.c (x_reset_key_mapping): - * event-Xt.c: - * eval.c (syms_of_eval): - * eval.c (warn_when_safe): - * eval.c (warn_when_safe_lispobj): - * eval.c (Fbacktrace_frame): - * eval.c (Fbacktrace): - * eval.c (top_level_set): - * eval.c (unbind_to_hairy): - * eval.c (specbind_magic): - * eval.c (specbind_unwind_wasnt_local): - * eval.c (call2_trapping_errors): - * eval.c (call1_trapping_errors): - * eval.c (catch_them_squirmers_call2): - * eval.c (call0_trapping_errors): - * eval.c (run_hook_trapping_errors): - * eval.c (catch_them_squirmers_eval_in_buffer): - * eval.c (call4_in_buffer): - * eval.c (call3_in_buffer): - * eval.c (call2_in_buffer): - * eval.c (call1_in_buffer): - * eval.c (call0_in_buffer): - * eval.c (run_hook): - * eval.c (run_hook_with_args_in_buffer): - * eval.c (Fapply): - * eval.c (Feval): - * eval.c (do_autoload): - * eval.c (un_autoload): - * eval.c (Fautoload): - * eval.c (Finteractive_p): - * eval.c (Fcommand_execute): - * eval.c (signal_quit): - * eval.c (call_with_suspended_errors): - * eval.c (signal_error): - * eval.c (return_from_signal): - * eval.c (Fcall_with_condition_handler): - * eval.c (run_condition_case_handlers): - * eval.c (condition_case_1): - * eval.c (Funwind_protect): - * eval.c (unwind_to_catch): - * eval.c (internal_catch): - * eval.c (Fmacroexpand_internal): - * eval.c (Fuser_variable_p): - * eval.c (Fdefconst): - * eval.c (Fdefvar): - * eval.c (Ffunction): - * eval.c (signal_call_debugger): - * eval.c (call_debugger): - * eval.c: - * emacs.c (main): - * emacs.c (sort_args): - * emacs.c (main_1): - * elhash.h: - * elhash.c: - * editfns.c (Fencode_time): - * editfns.c (Fdecode_time): - * editfns.c (Fuser_full_name): - * editfns.c: - * editfns.c (save_excursion_restore): - * ecrt0.c: - * dynarr.c: - * doprnt.c (emacs_doprnt_1): - * doc.c (verify_doc_mapper): - * doc.c (Fsnarf_documentation): - * doc.c (Fdocumentation): - * dll.c: - * dired.c (user_name_completion): - * dired.c (Fdirectory_files): - * dialog-x.c: - * dialog-msw.c: - * dgif_lib.c (FreeSavedImages): - * dgif_lib.c (DGifGetImageDesc): - * device.h: - * device.h (struct device): - * device.c (Fselect_device): - * device.c (allocate_device): - * device.c: - * device-x.c (Fx_keysym_on_keyboard_p): - * device-x.c (Fx_valid_keysym_name_p): - * device-x.c (x_IO_error_handler): - * device-x.c (x_delete_device): - * device-x.c (x_finish_init_device): - * device-x.c (x_init_device): - * device-x.c: - * device-msw.c (mswindows_init_device): - * dbxrc: - * database.c (vars_of_database): - * database.c (Fput_database): - * database.c (Fopen_database): - * database.c (berkdb_remove): - * database.c (berkdb_put): - * database.c (Fdatabasep): - * database.c (print_database): - * database.c: - * data.c (vars_of_data): - * data.c (syms_of_data): - * data.c (init_errors_once_early): - * data.c (prune_weak_lists): - * data.c (finish_marking_weak_lists): - * data.c (print_weak_list): - * data.c (Fmod): - * data.c (Fstring_to_number): - * data.c (Fnumber_to_string): - * data.c (Findirect_function): - * data.c (Fsetcdr): - * data.c (Ffloatp): - * data.c (Fsubr_interactive): - * data.c (Farrayp): - * data.c (Fkeywordp): - * data.c (Fnull): - * data.c: - * console.h (CONSOLE_NAME): - * console.h: - * console.c (vars_of_console): - * console.c (Fselect_console): - * console.c: - * console-x.h (DEVICE_X_COLORMAP): - * console-x.h (struct x_device): - * console-x.c (x_device_to_console_connection): - * console-tty.h (CONSOLE_TTY_FINAL_CURSOR_Y): - * console-tty.c (tty_init_console): - * console-tty.c: - * console-msw.h (struct mswindows_frame): - * conslots.h: - * config.h.in: - * cmds.c (internal_self_insert): - * cmds.c (Fforward_line): - * cmds.c (Fforward_char): - * cmds.c: - * cmdloop.c: - * chartab.c (mark_char_table_entry): - * chartab.c: - * casefiddle.c (casify_word): - * callproc.c (child_setup): - * callproc.c (Fcall_process_internal): - * callproc.c: - * callint.c (Fcall_interactively): - * bytecode.h: - * bytecode.c (execute_rare_opcode): - * bytecode.c (execute_optimized_program): - * bytecode.c: - * bufslots.h: - * buffer.h (BUFFER_REALLOC): - * buffer.h (GET_CHARPTR_INT_DATA_ALLOCA): - * buffer.h (GET_CHARPTR_EXT_DATA_ALLOCA): - * buffer.h: - * buffer.h (MAP_INDIRECT_BUFFERS): - * buffer.h (CHECK_LIVE_BUFFER): - * buffer.c (init_initial_directory): - * buffer.c (complex_vars_of_buffer): - * buffer.c (vars_of_buffer): - * buffer.c (finish_init_buffer): - * buffer.c (Fget_file_buffer): - * buffer.c (Fbuffer_list): - * buffer.c (mark_buffer): - * balloon_help.c (balloon_help_move_to_pointer): - * balloon_help.c (show_help): - * balloon_help.c: - * backtrace.h: - * alloc.c (garbage_collect_1): - * alloc.c (sweep_strings): - * alloc.c (sweep_compiled_functions): - * alloc.c (sweep_bit_vectors_1): - * alloc.c (sweep_vectors_1): - * alloc.c (sweep_lcrecords_1): - * alloc.c (tick_lcrecord_stats): - * alloc.c (pure_string_sizeof): - * alloc.c (mark_conses_in_list): - * alloc.c (mark_object): - * alloc.c (report_pure_usage): - * alloc.c (make_pure_float): - * alloc.c (make_pure_string): - * alloc.c (free_managed_lcrecord): - * alloc.c (mark_string): - * alloc.c (noseeum_make_marker): - * alloc.c (allocate_event): - * alloc.c (Fbit_vector): - * alloc.c (Fvector): - * alloc.c (make_float): - * alloc.c (Fmake_list): - * alloc.c (Flist): - * alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC): - * alloc.c (PUT_FIXED_TYPE_ON_FREE_LIST): - * alloc.c (DECLARE_FIXED_TYPE_ALLOC): - * alloc.c (dbg_constants): - * alloc.c (gc_record_type_p): - * alloc.c (free_lcrecord): - * alloc.c (xmalloc): - * alloc.c (NOSEEUM_INCREMENT_CONS_COUNTER): - * abbrev.c: - * Makefile.in.in (mostlyclean): - * Makefile.in.in (external_client_xlib_objs_nonshared): - * Makefile.in.in (temacs_link_args): - * Makefile.in.in (release): - * Makefile.in.in (dnd_objs): - * Makefile.in.in (objs): - * Makefile.in.in (PROGNAME): - * EmacsShell.c: cast strings to (XtPointer) - * EmacsFrame.c: cast strings to (XtPointer) - - mega patch - - rewrite basic lisp functions for speed - - rewrite bytecode interpreter for speed - - rewrite list looping constructs for speed and safety using - tortoise/hare. - - use size_t where appropriate. - - new hashtable implementation - - cleanup implementation of opaques - - opaques can now be purecopy'ed - - move some cl functionality into C for speed. - - remove last remaining VMS support - - spelling fixes - - improve gdb/dbx debugger support - - move pure.c back into alloc.c for performance - - enable report_pure_usage() if --memory-usage-stats - - remove remnants of Energize support (EMACS_BTL, cadillac...) - - don't use symbols with leading `_' or embedded `__' - - globally cleanup duplicated semicolons `;;' - - I give in on %p vs %lx - we use printf("%lx",(long) p) - globally. - - globally replace O_NDELAY with O_NONBLOCK. - - globally replace CDISABLE with _POSIX_VDISABLE. - - use O_RDONLY and O_RDWR instead of magic `0' and `2'. - - define (and maybe use!) STDERR_FILENO and friends. - - add support for macros defined in C - - `when', `unless', `not' and `defalias' now defined in C, - so that they are universally available. - - rename defvar_mumble to defvar_magic - - rename RETURN__ to RETURN_SANS_WARNINGS - - use consistent style of initial caps in error messages - - implement last, butlast, nbutlast, copy-list in C. - - provide typedefs for all struct Lisp_foo types - - Lisp_Objects must be initialized to Qnil rather than 0. - - make sure XEmacs runs (slowly) with always_gc == 1; - - fast and safe LOOP_* macros - - change calls to XSETOBJ to XSETFOO - - replace calls to XSETINT by make_int() - - plug up memory leaks - - use style markobj (foo), not silly ((markobj) (foo)) - - use XFLOAT_DATA (obj) instead of float_data (XFLOAT (obj)) - -1998-12-02 P. E. Jareth Hein - - * unexec.c: Changed a #ifndef statement to fix XEmacs on BSDI 3.0 - -1998-11-28 SL Baur - - * XEmacs 21.2-beta4 is released. - -1998-11-27 SL Baur - - * mule-charset.c (complex_vars_of_mule_charset): Fix graphic - property in control-1 charset. - From Julian Bradfield - -1998-11-26 Jan Vroonhof - - * gui-x.c (button_item_to_widget_value): Ignore :key-sequence - keyword. - Add stub for :label. - - * gui.c (gui_item_add_keyval_pair): ditto. - - * menubar-x.c (menu_item_descriptor_to_widget_value_1): Ignore - :key-sequence keyword. - Add stub for:label. - Support :active for submenus like the Windows code and FSF Emacs. - -1998-11-27 Hrvoje Niksic - - * dired.c (make_directory_hash_table): make_string() is OK because - readdir() Mule-encapsulates. - -1998-11-26 Hrvoje Niksic - - * fns.c (Fbase64_encode_string): Fix docstring. - (Fbase64_decode_string): Ditto. - -1998-11-26 Hrvoje Niksic - - * editfns.c (Ftranslate_region): Use - convert_bufbyte_string_into_emchar_string(). - -1998-11-25 Hrvoje Niksic - - * editfns.c (Ftranslate_region): Accept vectors and char-tables as - well as strings. - (Ftranslate_region): Turn table into an array of Emchars for - larger regions. - -1998-11-25 Hrvoje Niksic - - * chartab.c (Freset_char_table): Fix wrong placement of #endif. - -1998-11-24 Hrvoje Niksic - - * chartab.c (Freset_char_table): Don't blindly fill chartables of - type `char' with nils. - - * chartab.c (canonicalize_char_table_value): Coerce ints to chars - for tables of type `char'. - -1998-11-26 Didier Verna - - * input-method-xlib.c (Initialize_Locale): don't call - XtSetLanguageProc. We've done the whole work here. - * input-method-xfs.c (Initialize_Locale): ditto. - * input-method-motif.c (Initialize_Locale): ditto. - -1998-11-26 Didier Verna - - * process-unix.c (unix_create_process): handle properly - Vfile_name_coding_system for converting the program and directory - names. - -1998-11-27 SL Baur - - * m/arm.h: New file. - From James LewisMoss - -1998-11-27 Takeshi Hagiwara - - * m/mips-nec.h: - Fix the realpath() problem of UnixWare2.1.3. - Patches for NEC's sysv4.2 machine. - -1998-11-25 Hrvoje Niksic - - * dired.c (Fdirectory_files): Remove redundant code. - -1998-11-25 Hrvoje Niksic - - * fns.c (free_malloced_ptr): New function. - (XMALLOC_OR_ALLOCA): New macro. - (XMALLOC_UNBIND): Ditto. - (Fbase64_encode_region): Use malloc() for large blocks; arrange it - to be freed in case of non-local exit. - (Fbase64_encode_string): Ditto. - (Fbase64_decode_region): Ditto. - (Fbase64_decode_string): Ditto. - (STORE_BYTE): New macro. - (base64_decode_1): Use it. - -1998-11-25 Hrvoje Niksic - - * fns.c (base64_value_to_char): Base64 stuff. - -1998-11-24 Hrvoje Niksic - - * editfns.c (Fbuffer_substring): New function. - - * lisp.h: Declare make_string_from_buffer_no_extents(). - - * insdel.c (make_string_from_buffer_1): New function. - (make_string_from_buffer_no_extents): Ditto. - -1998-11-15 Michael Sperber [Mr. Preprocessor] - - * linuxplay.c: Including instead of makes - sound work on AIX with OSS installed. Linux should still work. - -1998-11-03 Andy Piper - - * config.h.in: name change for cygwin/version.h - - * configure.in: check for cygwin/version.h now. - - * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> - CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. - move cygwin32/version.h to cygwin/version.h - -1998-11-03 Olivier Galibert - - * lisp.h (struct Lisp_Bit_Vector): Fix declaration of bits from - int to long. - -1998-10-22 Andy Piper - - * cygwin32.h: track CYGWIN_DLL_VERSION_MAJOR -> - CYGWIN_VERSION_DLL_MAJOR name change in cygwin b20. - enable BROKEN_SIGIO under b20 to make QUIT work. - -1998-10-22 Andy Piper - - * frame-msw.c (mswindows_size_frame_internal): force frame sizing - to fit within the constraints of the screen size. I.e. make the - frame small enough to fit and move it if some of it will be - off-screen. - -1998-10-19 Greg Klanderman - - * dired.c: conditionalize inclusion of user-name-completion - primitives on non-Windows NT. The needed functions don't exist on NT. - -1998-11-24 SL Baur - - * gifrlib.h: Clean up types for 64 bit compile. - * dgif_lib.c (DGifInitRead): Ditto. - (MakeSavedImage): Ditto. - * emacs.c (decode_path): Ditto. - From Steve Carney - -1998-10-16 William M. Perry - - * glyphs-msw.c (bitmap_table): Fixed typo in builtin bitmaps - (cehckboxes instead of checkboxes). - -1998-10-15 SL Baur - - * XEmacs 21.2-beta3 is released. - -1998-10-13 Raymond Toy - - * runemacs.c (WinMain): If the basename is "rungnuclient.exe", run - gnuclient. Otherwise, we run xemacs as we always did. This gets - rid of the annoying DOS window when running gnuclient. - -1998-10-13 Andy Piper - - * dragdrop.c (vars_of_dragdrop): rename HAVE_MSWINDOWS -> - HAVE_MS_WINDOWS typo. - -1998-10-13 SL Baur - - * process-unix.c (unix_send_process): Set closed flag on writable - pipe after SIGPIPE is received and before we call deactivate_process. - -1998-10-03 Gunnar Evermann - - * window.c (Fset_window_start): respect narrowing when - checking wheter start is at the beginning of a line. - (Fset_window_buffer): Ditto - Fixes repeatable crash in VM. - -1998-10-09 SL Baur - - * window.c (specifier_vars_of_window): Set default vertical - divider width to 1 on ttys. - -1998-10-08 Martin Buchholz - - * alloc.c: - * unexec.c: - * malloc.c: - Add to get ptrdiff_t declaration - -1998-10-07 Jonathan Harris - - * scrollbar-msw.c: Use the same vertical scrollbar drag hack as - is used for Motif or Lucid scrollbars under X. - -1998-10-08 Pierre Wendling - - * m/alpha.h (UNEXEC): quoted to avoid bad expansion when running - `configure' - -1998-10-06 Takeshi Hagiwara - - * frame-x.c (x_delete_frame): Fix an argument of XtDestroyWidget. - -1998-10-05 Andy Piper - - * s/cygwin32.h: more cygwin b20 reorganisation. - -1998-10-03 Gunnar Evermann - - * window.c (Fset_window_start): Document me. - (Fset_window_buffer): Document me. - Fixes some sort of repeatable crash. - -1998-10-01 Raymond Toy - - * nas.c: Added necessary support functions to be able to handle - WAVE files in memory, just like the support for SND files in - memory. - -1998-09-30 SL Baur - - * callproc.c (child_setup): Fix spelling typo. - -1998-09-29 SL Baur - - * XEmacs 21.2-beta2 is released. - -1998-09-27 P. E. Jareth Hein - - * regex.c (re_match_2_internal): Add in code to reset lowest_active_reg - to prevent memory corruption in the case of jumping out of a series of - nested match patterns. This is a rather brute force approach, though. - -1998-09-02 Andy Piper - - * config.h.in: ditto. - - * s/cygwin32.h: rearrange declarations to cope with cygwin - b20. Include cygwin32/version.h if it exists. - -1998-09-20 Jonathan Harris - - * device-msw.c (mswindows_init_device): Call new - mswindows_enumerate_fonts() function in objects-msw.c instead - of font_enum_callback_1() to enumerate fonts. - - font_enum_callback_1() and _2() moved to objects-msw.c. - - * faces.c (complex_vars_of_faces): Make the mswindows default - face font fully specified and provide some fallbacks. - - * objects-msw.c: font_enum_callback_1() and _2() moved here - from objects-msw.c. Obtain the enumerated font's character - sets by table lookup instead of using the locale-specific - string provided by Windows. - - New public non-method mswindows_enumerate_fonts() that fills - in the supplied mswindows device's font list. - - mswindows_initialize_font_instance: Use the supplied name - variable instead of f->name when signalling errors. Match font - weights and character sets using lookup tables which handle - spaces instead of by frobbing. - -1998-09-20 Jonathan Harris - - * process-nt.c: Define an arbitrary limit, FRAGMENT_CODE_SIZE, - on the size of code fragments passed to run_in_other_process. - - run_in_other_process(): Use FRAGMENT_CODE_SIZE to determine - the amount of memory to allocate in the other process. - - Removed sigkill_code_end(), sigint_code_end() and - sig_enable_code_end() since they are now redundant. - - send_signal() and enable_child_signals(): Don't try to work - out the end of the code fragments passed to - run_in_other_process() - -1998-09-10 Kazuyuki IENAGA - - * src/s/freebsd.h: Added __ELF__ and compiler/liker flags for - FreeBSD-current. - - * src/unexelf.c: Partially synched with FSF's 20.3. - -1998-09-10 Hrvoje Niksic - - * insdel.c (signal_after_change): Map across indirect buffers - here, and not in the upper-level functions. - (signal_first_change): Don't check for Armageddon. - (signal_before_change): Map across indirect buffers here. - (prepare_to_modify_buffer): ...and here. - -1998-09-09 Hrvoje Niksic - - * insdel.c (signal_after_change): Add return value. - (buffer_insert_string_1): Use it. - (buffer_delete_range): Ditto. - (buffer_replace_char): Ditto. - (cancel_multiple_change): Map the indirect buffers. - -1998-09-06 Hrvoje Niksic - - * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. - (uninit_buffer_text): Ditto. - - * buffer.c (Fmake_indirect_buffer): Implement stricter - error-checking. - -1998-09-04 Hrvoje Niksic - - * insdel.c (change_function_restore): Reverse order of - function-call and assignment. - (first_change_hook_restore): Ditto. - - * extents.c (mark_extent_auxiliary): Mark them. - (Fset_extent_property): Set them. - (Fextent_property): Get them. - (Fextent_properties): Ditto. - (vars_of_extents): Set their default. - - * extents.h (struct extent_auxiliary): Add before_change_functions - and after_change_functions. - - * insdel.c (signal_before_change): Use it. - (signal_after_change): Ditto. - - * extents.c (report_extent_modification): New function. - - * insdel.c (signal_before_change): Don't check for Armageddon. - (signal_after_change): Ditto. - -1998-09-11 Gunnar Evermann - - * redisplay.c (redisplay_window): make sure a new starting point - is chosen if it somehow got moved from the beginning of the line - -- this can happen because Fwiden was called recently. - - * window.c (Fset_window_start): set start_at_line_beg correctly - (Fset_window_buffer): Ditto - -1998-09-06 Hrvoje Niksic - - * insdel.c (init_buffer_text): Remove INDIRECT_P parameter. - (uninit_buffer_text): Ditto. - - * buffer.c (Fmake_indirect_buffer): Implement stricter - error-checking. - -1998-05-14 Jan Vroonhof - - * emacs.c (main_1): Removed references to *vars_of_filelock. - - * lisp.h: Added Fsystem_name. - - * filelock.c: Replaced by version from FSF 20.2. Now implements - locking by using symlinks which is NFS safe. However keep the - GCPRO's in lock_file and the calls to callx_in_buffer like our old - version (and of course use ansi C, acessor macros, etc). - -1998-09-06 Jan Vroonhof - - * process-unix.c (unix_create_process): Reset SIGHUP handler to - SIG_DFL. We now try to conserve any inherted SIG_IGN settings - in init_signals_very_early. However these should not be passed - on to children attached to the new pty. - -1998-08-28 Andy Piper - - * glyphs-eimage.c (png_instantiate_unwind): clean up eimage after use. - -1998-09-07 Jonathan Harris - - * fileio.c (file-name-directory, file_name_as_directory): - Don't call CORRECT_DIR_SEPS, even when #defined WINDOWSNT. - -1998-09-02 Andy Piper - - * emacs.c (main_1): init_ralloc() if initialised and we have REL_ALLOC - - * ralloc.c: uncomment __morecore. - -1998-09-92 Jonathan Harris - - * event-msw.c(winsock_writer): Supply a dummy 4th argument to - WriteFile() to fix a winsock 1.x bug on Win95. - -1998-08-28 Hrvoje Niksic - - * event-Xt.c (emacs_Xt_mapping_action): Check for device being - deleted. - (x_event_to_emacs_event): Ditto. - (emacs_Xt_handle_focus_event): Ditto. - (emacs_Xt_handle_magic_event): Ditto. - - * console-x.h (struct x_device): New flag being_deleted. - (DEVICE_X_BEING_DELETED): New macro. - - * device-x.c (x_IO_error_handler): Throw to top-level instead of - returning. Before doing that, set the being_deleted flag on the - device. - -1998-08-27 Hrvoje Niksic - - * device-x.c (x-seppuku-on-epipe): Removed. - -1998-08-26 Gunnar Evermann - - * frame-x.c (x_delete_frame): Flush the X output buffer after - calling XtDestroyWidget to ensure that the windows are really - killed right now. - -1998-08-26 Hrvoje Niksic - - * menubar-x.c (my_run_hook): New unused function. - (pre_activate_callback): Use run_hook for Qactivate_menubar_hook, - since we ignore the results of the contained functions anyway. - -1998-08-26 P. E. Jareth Hein - - * glyphs-eimage.c (gif_instantiate): Fix a crash in handling - interlaced GIF files that are smaller than 4 lines high... - -1998-08-31 Hrvoje Niksic - - * buffer.c (map_over_sharing_buffers): Deleted. - - * insdel.c (MAP_INDIRECT_BUFFERS): Move to buffer.h. - - * buffer.c (Fkill_buffer): Keep indirect_children updated while - killing them. - -1998-08-31 Hrvoje Niksic - - * insdel.c (buffer_insert_string_1): Advance the point bytind in - all the buffers. - (buffer_delete_range): Ditto. - - * marker.c (init_buffer_markers): Set point-marker to the value of - point in an indirect buffer. - -1998-08-30 Hrvoje Niksic - - * undo.c (undo_prelude): Test last-undo-buffer against base - buffer. - - * insdel.c (MAP_INDIRECT_BUFFERS): Use it. - - * buffer.h (BUFFER_BASE_BUFFER): New macro. - -1998-08-30 Hrvoje Niksic - - * insdel.c (init_buffer_text): Initialize it here. - - * line-number.c: Address line_number_cache through buffer->text. - - * buffer.c (mark_buffer): Mark line number cache. - - * bufslots.h (line_number_cache): Move to struct buffer_text. - - * insdel.c (buffer_insert_string_1): Propagate signals and changes - across the children buffers. - (buffer_delete_range): Ditto. - (buffer_replace_char): Ditto. - (gap_left): Ditto. - (gap_right): Ditto. - - * insdel.c (MAP_INDIRECT_BUFFERS): New macro. - - * buffer.c (Fmake_indirect_buffer): Uncomment. - -1998-08-31 Hrvoje Niksic - - * macros.c (Fend_kbd_macro): Remove trailing period from error - message. - (Fexecute_kbd_macro): Ditto. - -1998-08-21 Greg Klanderman - - * dired.c (Fuser_name_completion): remove optional 2nd argument. - (Fuser_name_completion_1): new function to return uniqueness - indication in addition to the user name completion. - (user_name_completion): change type of `uniq' argument. - -1998-08-19 Michael Sperber [Mr. Preprocessor] - - * lread.c (vars_of_lread): Removed `source-directory' variable. - -1998-08-22 Hrvoje Niksic - - * fileio.c (Ffile_readable_p): Apply the DOS/Windows logic to - Cygwin. - -1998-08-19 SL Baur - - * dired.c (vars_of_dired): Fix misapplied patch. - -1998-08-16 Martin Buchholz - - * fns.c (Fremrassq, remrassq_no_quit): - A XCAR that should have been an XCDR turned Fremrassq into Fremassq - -1998-07-17 Didier Verna - - * redisplay-x.c (x_get_gc): returns a GC with a FillStipple fill - style as foreground GC for faces that have the `dim' property. - (x_output_string): when the `dim' face property is set, - ensure the gray pixmap has been created, and get a proper - foreground GC to draw the text. - -1998-08-09 Jonathan Harris - - * event-msw.c (mswindows_wnd_proc): Workaround for a Win95 bug: - Manually track the state of the left and right Ctrl and Alt - modifiers. - -1998-08-07 Matt Stupple - - * ntproc.c: don't wait on char_consumed at thread entry. - Additionally, to get the 'process' marked as finished, ensure - that the CHILD_ACTIVE macro returns false, so before exiting - close char_avail and set it to NULL, and close other handles - to reduce handle leak problems. - -1998-08-09 Jonathan Harris - - * menubar-msw.c (displayable_menu_item): take account of menu - depth when deciding whether to try to display accelerators. - -1998-08-04 Andy Piper - - * event-msw.c: use MsgWaitForMultipleObjects if there are no - subprocesses. - - * glyphs-msw.c: fix a couple of potential handle leaks. - -1998-08-04 P. E. Jareth Hein - - * dgif_lib.c gif_io.c gifrlib.h: New files to put GIF - *decoding ONLY* back into the core. - * glyphs-eimage.c: Change referenced header file for GIF - reading to point to the incore version. - -1998-07-20 Martin Buchholz - - * casefiddle.c (casify_object): - Change algorithm from O(N**2) to O(N). - Code cleanup. - Doc string cleanup. - -1998-07-22 Greg Klanderman - - * dired.c (file_name_completion_unwind): don't leak the cons. - -1998-07-20 Greg Klanderman - - * dired.c (Fuser_name_completion): new function. - (Fuser_name_all_completions): new function. - (user_name_completion): new function. - (syms_of_dired): 2 new DEFSUBRs. - (vars_of_dired): initialize user name cache vars. - -1998-07-29 P. E. Jareth Hein - - * glyphs-eimage.c (png_instantiate): Add proper handling for background - colors taken from the default face. Also correct a thinko in - transparency (not alpha) handling. - -1998-07-23 Martin Buchholz - - * s/decosf4-0.h: Use a perfectly ordinary link. Nuke BSD crap. - * unexalpha.c: ANSI C-ize. Clean compiler warnings. - * lread.c (Fload_internal): Be very careful with printfs of - size_t's - * gui-x.c (menu_name_to_accelerator): tolower wants an `int' - argument. - -1998-07-27 Gunnar Evermann - - * callint.c (Fcall_interactively): GCPRO prompt string before - passing it to Fread_key_sequence - -1998-07-27 SL Baur - - * keymap.c (vars_of_keymap): Initialize Vkey_translation_map and - Vvertical_divider_map. - - * mule-canna.c (vars_of_mule_canna): Initialize every symbol to - Qnil or 0, none were initialized prior to this change. - - Rename misnamed `V' prefixed integer variables: - Vcanna_empty_info, Vcanna_through_info, Vcanna_underline, - Vcanna_inhibit_hankakukana, Vcanna_henkan_length, Vcanna_henkan_revPos, - Vcanna_henkan_revLen, Vcanna_ichiran_length, Vcanna_ichiran_revPos, - Vcanna_ichiran_revLen. - - Rename misnamed `V' prefixed integer variables and initialize - properly in the vars_of routine. - Vcanna_mode_AlphaMode, Vcanna_mode_EmptyMode, Vcanna_mode_KigoMode, - Vcanna_mode_YomiMode, Vcanna_mode_JishuMode, Vcanna_mode_TankouhoMode, - Vcanna_mode_IchiranMode, Vcanna_mode_YesNoMode, Vcanna_mode_OnOffMode, - Vcanna_mode_AdjustBunsetsuMode, Vcanna_mode_ChikujiYomiMode, - Vcanna_mode_ChikujiTanMode, Vcanna_mode_HenkanMode, - Vcanna_mode_HenkanNyuryokuMode, Vcanna_mode_ZenHiraHenkanMode, - Vcanna_mode_HanHiraHenkanMode, Vcanna_mode_ZenKataHenkanMode, - Vcanna_mode_HanKataHenkanMode, Vcanna_mode_HanKataHenkanMode, - Vcanna_mode_ZenAlphaHenkanMode, Vcanna_mode_HanAlphaHenkanMode, - Vcanna_mode_ZenHiraKakuteiMode, Vcanna_mode_HanHiraKakuteiMode, - Vcanna_mode_ZenKataKakuteiMode, Vcanna_mode_HanKataKakuteiMode, - Vcanna_mode_ZenAlphaKakuteiMode, Vcanna_mode_HanAlphaKakuteiMode, - Vcanna_mode_HexMode, Vcanna_mode_BushuMode, Vcanna_mode_ExtendMode, - Vcanna_mode_RussianMode, Vcanna_mode_GreekMode, Vcanna_mode_LineMode, - Vcanna_mode_ChangingServerMode, Vcanna_mode_HenkanMethodMode, - Vcanna_mode_DeleteDicMode, Vcanna_mode_TourokuMode, - Vcanna_mode_TourokuEmptyMode, Vcanna_mode_TourokuHinshiMode, - Vcanna_mode_TourokuDicMode, Vcanna_mode_QuotedInsertMode, - Vcanna_mode_BubunMuhenkanMode, Vcanna_mode_MountDicMode, - Vcanna_fn_SelfInsert, Vcanna_fn_FunctionalInsert, - Vcanna_fn_QuotedInsert, Vcanna_fn_JapaneseMode, Vcanna_fn_AlphaMode, - Vcanna_fn_HenkanNyuryokuMode, Vcanna_fn_Forward, Vcanna_fn_Backward, - Vcanna_fn_Next, Vcanna_fn_Prev, Vcanna_fn_BeginningOfLine, - Vcanna_fn_EndOfLine, Vcanna_fn_DeleteNext, Vcanna_fn_DeletePrevious, - Vcanna_fn_KillToEndOfLine, Vcanna_fn_Henkan, Vcanna_fn_Kakutei, - Vcanna_fn_Extend, Vcanna_fn_Shrink, Vcanna_fn_AdjustBunsetsu, - Vcanna_fn_Quit, Vcanna_fn_ConvertAsHex, Vcanna_fn_ConvertAsBushu, - Vcanna_fn_KouhoIchiran, Vcanna_fn_BubunMuhenkan, Vcanna_fn_Zenkaku, - Vcanna_fn_Hankaku, Vcanna_fn_ExtendMode, Vcanna_fn_ToUpper, - Vcanna_fn_Capitalize, Vcanna_fn_ToLower, Vcanna_fn_Hiragana, - Vcanna_fn_Katakana, Vcanna_fn_Romaji, Vcanna_fn_BaseHiragana, - Vcanna_fn_BaseKatakana, Vcanna_fn_BaseEisu, Vcanna_fn_BaseZenkaku, - Vcanna_fn_BaseHankaku, Vcanna_fn_BaseKana, Vcanna_fn_BaseKakutei, - Vcanna_fn_BaseHenkan, Vcanna_fn_BaseHiraKataToggle, - Vcanna_fn_BaseZenHanToggle, Vcanna_fn_BaseKanaEisuToggle, - Vcanna_fn_BaseKakuteiHenkanToggle, Vcanna_fn_BaseRotateForward, - Vcanna_fn_BaseRotateBackward, Vcanna_fn_Touroku, Vcanna_fn_HexMode, - Vcanna_fn_BushuMode, Vcanna_fn_KigouMode, Vcanna_fn_Mark, - Vcanna_fn_TemporalMode, Vcanna_key_Nfer, Vcanna_key_Xfer, - Vcanna_key_Up, Vcanna_key_Left, Vcanna_key_Right, Vcanna_key_Down, - Vcanna_key_Insert, Vcanna_key_Rollup, Vcanna_key_Rolldown, - Vcanna_key_Home, Vcanna_key_Help, Vcanna_key_KP_Key, - Vcanna_key_Shift_Nfer, Vcanna_key_Shift_Xfer, Vcanna_key_Shift_Up, - Vcanna_key_Shift_Left, Vcanna_key_Shift_Right, Vcanna_key_Shift_Down, - Vcanna_key_Cntrl_Nfer, Vcanna_key_Cntrl_Xfer, Vcanna_key_Cntrl_Up, - Vcanna_key_Cntrl_Left, Vcanna_key_Cntrl_Right, Vcanna_key_Cntrl_Down - -1998-07-16 Jan Vroonhof - - * event-Xt.c (x_to_emacs_keysym): Return nil for modifier keysyms. - (x_event_to_emacs_event): Let x_to_emacs_keysym check for modifier - keys thus no longer considering all keysyms on a key. - -1998-07-19 SL Baur - - * XEmacs 21.2-beta1 is released. - -1998-07-12 Oscar Figueiredo - - * eldap.c (Fldap_search_internal): When converting the list of - attributes to search Copy the final 0 from Lisp strings to C - strings. - Check base, not Vldap_default_base as a a string - -1998-07-13 Jonathan Harris - - * nt.c: Remove Vstdio_str; already defined in console-stream.c. - - * unexnt.c: Unconditionally define bss_start and bss_size, and - ensure that they don't go in the .bss section. - -1998-07-17 Olivier Galibert - - * glyphs-x.c (convert_EImage_to_XImage): Fix previous patch (conv - byte order is dependant of the local byte order). - From Takeshi Hagiwara - -1998-07-18 SL Baur - - * glyphs-msw.c (mswindows_resource_normalize): Qresource -> - Qmswindows_resource. - From Jonathan Harris - -1998-07-12 SL Baur - - * general.c (syms_of_general): Add defsymbol for Qresource. - - * glyphs-msw.c (vars_of_glyphs_mswindows): Rename Qresource to - Qmswindows_resource. - (TopLevel): Rename 'resource image format to 'mswindows_resource. - (mswindows_resource_validate): Rename. - (mswindows_resource_normalize): Rename. - (mswindows_resource_possible_dest_types): Rename. - (mswindows_resource_instantiate): Rename. - (image_instantiator_format_create_glyphs_mswindows): Replace - `resource' with `mswindows.resource'. - - * XEmacs 21.0-pre5 is released. - -1998-07-10 SL Baur - - * mule-wnnfns.c (Fwnn_open): Correctly trap on misdefined Wnn - server type in environment. - Use alloca-ed strings instead of tiny fixed size ones. - -1998-07-09 SL Baur - - * XEmacs 21.0-pre4 is released. - -1998-07-01 James N. Potts - - * fileio.c: (expand_file_name): under win32: Don't treat names - as UNC names if a drive letter has been specified. If a drive - has been specified, strip out extra directory-seperators that - reportedly cause problems under Win95. - -1998-07-09 Jonathan Harris - - * windowsnt.h: Define DUMP_SEPARATE_SECTION when building with - MSVC >= 5.0. Put emacs init and zero-init data in a special - section of the executable when this is defined. - - * unexnt.c, ntheap.h: - Removed unused find_section() and get_section_size(). - - * unexnt.c: - Fix up the executable's checksum after dumping otherwise the - profiler complains. - When DUMP_SEPARATE_SECTION is defined, don't need to dump - zero-init data separately from init data. Dump emacs data - into a special section of the executable. - When DUMP_SEPARATE_SECTION not defined, dump .bss up to - my_ebss instead of up to the end of bss. - -1998-07-09 Jonathan Harris - - * filelock.c: Removed Vconfigure_lock_directory - already - defined in emacs.c. - - * frame-msw.c: Removed Qinitially_unmapped and Qpopup - already - defined in frame.c and general.c respectively. - - * glyphs-msw.c: Removed Qresource - already defined in - general.c. - -1998-07-05 Oscar Figueiredo - - * eldap.c (Fldap_search_internal): Docstring fixes - -1998-07-04 Jonathan Harris - - * nt.c (init_environment): Removed unused PRELOAD_WINSOCK, - EMACSDOC and TERM variables. Added EMACSDEBUGPATHS, - EMACSPACKAGEPATH and INFOPATH variables. - Removed unused get_emacs_configuration function. - - * s/windowsnt.h: Don't define EMACS_CONFIGURATION here because - it is now defined at build-time by the makefile. - -1998-07-01 James N. Potts - - * fileio.c: (expand_file_name): under win32: Don't treat names as - UNC names if a drive letter has been specified. If a drive has - been specified, strip out extra directory-seperators that - reportedly cause problems under Win95. - -1998-07-05 Andy Piper - - * faces.c (complex_vars_of_faces): for the gui-element face don't - fallback to the default face, instead provide reasonable default - fallbacks that were previously hardcoded elsewhere. - -1998-07-06 Olivier Galibert - - * glyphs-x.c (convert_EImage_to_XImage): Fix pixel writing problem - when the X server endianness is different than the client's one. - -1998-06-29 Kyle Jones - - * eval.c (run_hook_with_args_in_buffer): Check - default (non-buffer-local) value of hook for - nil before treating it as a function. Don't initialize - the `globals' variable twice. - -1998-06-24 Jonathan Harris - - * fileio.c: Don't do directory seperator canonicalisation in - substitute-in-file-name because we don't know that the - filename refers to a local file. - -1998-06-24 Adrian Aichner - - * process-nt.c (nt_create_process): Try appending the standard - executable file extensions to the filename if none supplied. - -1998-06-29 SL Baur - - * fileio.c (Fsubstitute_in_file_name): Enable double slash notation - for cygwin32. - From Keisuke Mori - -1998-06-24 Andy Piper - - * toolbar-msw.c (mswindows_output_toolbar): only enable masked - images if we have masks. This handles the xbm case (have masks) - and avoids overuse of resources in the xpm case (generally no masks). - Don't output small toolbars. - -1998-06-29 Kyle Jones - - * eval.c (run_hook_with_args_in_buffer): Don't treat - the default value of a buffer local hook as a list of - hooks unless it is both a cons and the car of that cons - is not Qlambda. - -1998-06-29 SL Baur - - * extents.c: Email address for Ben Wing is ben@xemacs.org. - * process-unix.c: Ditto. - * mule-coding.h: Ditto. - * mule-coding.c: Ditto. - * mule-charset.c: Ditto. - * mule-charset.h: Ditto. - * file-coding.c: Ditto. - * file-coding.h: Ditto. - -1998-06-22 Jonathan Harris - - * event-msw.c: Guard against recursion when freeing - FRAME_MSWINDOWS_TARGET_RECT struture in WM_SIZE processing. - - * frame-msw.c: Don't set WS_VISIBLE attribute on first frame. - Call ShowWindow twice in init_frame_3 to get round runemacs - weirdness. - -1998-06-27 Hrvoje Niksic - - * scrollbar.c (vertical_scrollbar_changed_in_window): Ditto. - - * winslots.h: Rename. - - * window.c (specifier_vars_of_window): Renamed - vertical-divider-draggable-p to vertical-divider-always-visible-p, - as suggested by Ben Wing. - (specifier_vars_of_window): Fix docstrings. - -1998-06-22 Michael Sperber [Mr. Preprocessor] - - * unexaix.c: Line number information works correctly again. - -1998-06-22 Olivier Galibert - - * emacs.c (__sti__iflPNGFile_c___): Added. See comment. Cry. - -1998-06-21 Martin Buchholz - - * editfns.c (get_home_directory): ANSIfy. - XEmacs is compilable under C *and* C++. - It's XEmacs, not Xemacs! - -1998-06-19 Jonathan Harris - - * console-msw.h: added a list of fonts to device data. - - * device-msw.c: enumerate list of available fonts in - mswindows_init_device. Free list in mswindows_delete_device. - - * objects-msw.c: Added helper function match_font used by - mswindows_initialize_font_instance and mswindows_list_fonts. - Allow a charset to be specified in a font string, even if - previous fields havn't been specified. - -1998-06-23 Greg Klanderman - - * indent.c (column_at_point): column cache bugfix. - Set last_known_column_point to the buffer position for - which the column was requested, not buffer's point. - - * redisplay.c (decode_mode_spec): for current-column, show - window's point's column, not buffer's point's column. - -1998-06-23 Andy Piper - - * menubar-msw.c (mswindows_handle_wm_command): use - enqueue_misc_user event rather than - mswindows_enqueue_msic_user_event to fix customize problems. Add some - checks that X does. - - * console-msw.h: declare mswindows_enqueue_magic_event. - - * event-msw.c (mswindows_enqueue_magic_event): make global. - -1998-06-24 Hrvoje Niksic - - * line-number.c (LINE_NUMBER_FAR): Reverted to 16384. - (buffer_line_number): Use EMACS_INT_MAX instead of random LOTS. - (add_position_to_cache): Use EMACS_INT instead of int. - -1998-06-21 Olivier Galibert - - * lisp-disunion.h (XMARKBIT): Have XMARKBIT return something - suitable for an int used as a boolean (btw, C sucks.). - -1998-06-18 Andy Piper - - * object-msw.c: remove warnings. - - * device-msw.c: #define wrongly named cygwin structure elements. - - * s/cygwin32.h: define DEMI_BOLD - -1998-06-19 Jonathan Harris - - * redisplay-msw.c: new function mswindows_apply_face_effects. - This is called by output_string and output_cursor to display - underline and strikeout on faces. - -1998-06-19 Jonathan Harris - - * console-msw.h: added a list of fonts to device data. - - * device-msw.c: enumerate list of available fonts in - mswindows_init_device. Free list in mswindows_delete_device. - - * objects-msw.c: Added helper function match_font used by - mswindows_initialize_font_instance and mswindows_list_fonts. - Allow a charset to be specified in a font string, even if - previous fields havn't been specified. - -1998-06-15 Jonathan Harris - - * objects-msw.c: - Removed compilation warnings from mswindows_string_to_color. - mswindows_list_fonts returns a more general bogus font. - New lisp-visible function mswindows-color-list. - -1998-06-19 David Bush - - * editfns.c (Fuser_login_name): Modify to user new function - user_login_name. - (user_login_name): C only function to avoid Lisp object overhead - Returns "unknown" instead of nil in Cygwin environment - - * fileio.c (Fexpand_file_name): Treat "~" and "~user" as - equivalent for current user in Cygwin environment. Use new - function user_login_name to get username. - - * lisp.h: Declare user_login_name - -1998-06-18 Michael Sperber [Mr. Preprocessor] - - * unexaix.c (make_hdr): Fixed bias computations so debugging info - works again. - Some other insignificant nitpicks. - -1998-06-18 Andy Piper - - * toolbar-msw.c (mswindows_output_toolbar): specify ILC_MASK when - creating the image list and make sure he bk color is transparent. - -1998-06-18 Jan Vroonhof - - * event-Xt.c (emacs_Xt_remove_timeout): Also remove timeout from - completed_timeouts. The timer could have expired. - -1998-06-17 Andy Piper - - * console-msw.h: move XEMACS_RECT_WH inside frame - parameters. define macors to access it. - - * frame-msw.c (mswindows_init_frame_1): use new target_rect - parameter to intialise desired sizing. (mswindows_init_frame_2): - enable and size the frame to something sensible when we get - here. (mswindows_set_frame_properites): use new - mswindows_size_frame_internal function and size frame if frame - parameters not just if init is finished - WM_SIZE happens too - early for some specs. (mswindows_size_frame_internal): new - function abstracted from mswindows_set_frame_properties. - (Vmswindows_use_system_frame_size_defaults): - new variable controls whether to allow the system to pick frame - size defaults, defaults to nil. - - * event-msw.c: in WM_SIZE use mswindows_size_frame_internal rather - than duplicated code. - -1998-06-15 Colin Rafferty - - * Makefile.in.in: Made EXTW_LINK expand properly. - -1998-06-12 Martin Buchholz - - * redisplay.c (vars_of_redisplay): default value of - column-number-start-at-one should be NIL! - -1998-06-11 Martin Buchholz - - * casefiddle.c: - (upcase-initials "fooBar") ==> "FooBar" instead of "Foobar" - -1998-06-05 Hrvoje Niksic - - * eldap.c (Fldap_search_internal): Use build_ext_string instead of - build_string to avoid crashes under Mule. - -1998-06-13 Andy Piper - - * ntplay.c (play_sound_data_1): don't delete the sound data until - the next sound is played and the previous one finished. - -1998-06-10 Samuel Mikes - - * fileio.c (directory-sep-char): Escape backslashes. - -1998-06-10 Hrvoje Niksic - - * event-stream.c: Fix docstring reference. - -1998-06-12 Hrvoje Niksic - - * alloc.c (make_float): Remove useless initialization of `next' - field. - (make_pure_float): Ditto. - - * lisp.h (struct Lisp_Float): Rename `next' to `__unused__next'. - -1998-06-08 Kirill M. Katsnelson - - * fileio.c (Fmake_directory_internal): Remove conditionals - on WINDOWSNT when calling mkdir. - - * ntproc.c: Deleted the following unused functions: - register_child, reap_subprocess, sys_wait. - - * nt.c (sys_rename): Ifzeroed this implementation. - Deleted the following unused functions: - sys_access, sys_chdir, sys_chmod, sys_creat, sys_link, sys_mkdir, - sys_mktemp, sys_rmdir, sys_unlink, sys_close, sys_dup, sys_dup2, - sys_read, sys_write. - Merger sys_fopen and sys_open with sysdep.c implementation. - - * sysdep.c: Removed MS-DOS code. - (sys_rename): Deal with Microsoft rename weirdness. - (sys_open): Implemented for Windows. - (sys_fopen): Ditto. - (sys_mkdir): Ditto. - -1998-06-08 Kirill M. Katsnelson - - * buffer.c (complex_vars_of_buffer): Removed %t description from - the docstring. - -1998-06-04 Rick Rankin - - * scrollbar-msw.c: initialize the cbSize element of the - SCROLLINFO struct before calling SetScrollInfo. WinNT seems - to ignore the value of cbSize, but Win95 (and I presume Win98) - appear to want it set to sizeof(SCROLLINFO). - -1998-06-04 Kirill M. Katsnelson - - * event-stream.c: Defined Qcancel_mode_internal. - (syms_of_event_stream): defsymbol'ed it. - - * events.h: Externed it. - - * event-msw.c (mswindows_wnd_proc, WM_CANCELMODE): Added this handler. - -1998-06-04 Oliver Graf - - * frame-x.c (x_cde_destroy_callback): free the data - (cde-start-drag-internal) corrected root position, 21.1 needs this - hardcoded in Button events - (offix-start-drag-internal) corrected root position - -1998-06-03 Kirill M. Katsnelson - - * process-nt.c (signal_cannot_launch): Use signal_simple_error() - instead of error(). - -1998-06-03 Kirill M. Katsnelson - - * dialog-msw.c (button_width): Removed `inline' from the function - declaration. - -1998-06-03 Rick Rankin - - * frame-msw.c: add WS_VISIBLE flag to the first frame created. - Note that adding this flag to subsequent frames causes problems. - -1998-06-03 Gunnar Evermann - - * glyphs-eimage.c (png_instantiate) move 'struct - png_memory_storage tbr' out of nested block to avoid dangling - reference - -1998-06-02 Andy Piper - - * faces.h: - * faces.c: rename 3d-object -> gui-element. add toolbar face which - inherits from gui-element. - - * glyphs-msw.c: use DIBitmaps for xbm bitmaps to be consistent - with existing code, generate masks correctly. - -1998-06-03 P. E. Jareth Hein - - * glyphs-eimage.c: Changed included header for gifs to use - Gifreader instead of giflib. - - * glyphs-x.c: removed the image-related functions that were - moved into glyphs-eimage. - -1998-06-02 David Bush - - * glyphs.c (bitmap_to_lisp_data) Define XFree to be free - if built without X Windows support. - -1998-06-02 Hrvoje Niksic - - * fns.c (Fconcat): Synch docstring with new reality. - -1998-06-03 SL Baur - - * frame.c: Remove reference to msdos.h (which is going away). - Suggested by Hrvoje Niksic and Kirill Katsnelson. - -1998-06-02 P. E. Jareth Hein - - * glyphs-eimage.c (jpeg_instantiate): Fix handling of - grayscale images/ - - -1998-05-30 Kirill M. Katsnelson - - * events.h: Fixed commentary about misc-user scrollbar events. - - * scrollbar-x.c (x_update_vertical_scrollbar_callback): Use frame - object as an event channel, instead of window object. - (x_update_horizontal_scrollbar_callback): Ditto. - -1998-05-29 Andy Piper - - * ntplay.c (play_sound_data_1) new function. convert alloca data - to malloc if necessary. - (play_sound_file): if the file is not in our path then convert to - data and play. - -1998-06-01 SL Baur - - * mule-mcpath.c (mc_chdir): Reverse parameters in call to memcpy. - * msdos.c (Frecent_doskeys): Ditto. - - * unexalpha.c (unexec): Reverse parameters in call to memcpy. - Suggested by Reggie Perry - - * buffer.h: Eliminate size in declaration. - -1998-06-01 Olivier Galibert - - * unexelfsgi.c (unexec): Cleanup n/nn and remove useless kludge. - -1998-06-01 Kirill M. Katsnelson - - * gui.c (gui_item_init): Changed the default value for config member - from Qunbound to Qnil. - -1998-06-01 Greg Klanderman - - * indent.c (vmotion_pixels): Don't #define abs(). - -1998-05-30 Kirill M. Katsnelson - - * s/windowsnt.h: Defined popen and pclose to be _popen and _pclose - respectively. - -1998-05-30 Andy Piper - - * glyphs.h: add xbm declarations. - - * console.h: add xbm_instantiate_method device method. - - * glyphs.c (check_valid_xbm_inline) (xbm_validate) - (bitmap_to_lisp_data) (xbm_mask_file_munging) (xbm_normalize) - (xbm_possible_dest_types): moved here from glyphs-x.c. use - locate_pixmap_file device method and read_bitmap_data_from_file - instead of XmuReadBitmapDataFromFile. - (xbm_instatntiate): make a device method. - - * glyphs-x.c: see glyphs.c changes. (read_bitmap_data_from_file) - new function that just calls XmuReadBitmapDataFromFile. - (x_xbm_instatntiate): device method from xbm_instantiate. - - * glyphs-msw.c (read_bitmap_data) (NextInt) - (read_bitmap_data_from_file): new functions copied from Xmu - sources. - (xbm_create_bitmap_from_data) from Ben convert - inline data to an mswindows bitmap. - (init_image_instance_from_xbm_inline) (xbm_instantiate_1) - (mswindows_xbm_instantiate): mswindows-ized versions of the X - functions. - -1998-05-30 Kirill M. Katsnelson - - * window.c (specifier_vars_of_window): Renamed `has_modeline-p' to - `modeline-visible-p'. - Declared specifier lisp variables at the beginning oh the file - as static. - - * procimpl.h (struct process_methods): Changed semantics of - create_process method so it accepts lisp strings instead of - char pointers. - - * process.c (Fstart_process_internal): Moved building of - unix style argv from here to process-unix.c, ... - - * process-unix.c (unix_create_process): ... right here. - - * process-nt.c (nt_create_process): Changed this function to - support new semantics, so avoided a GC problem. - - * events.c (Fmake_event): Document misc-user events properties. - (Fmake_event): Do not allow arbitrary objects for channel property - of misc-user events. - (Fmake_event): Change misc-user event validation: it is function - which is required, not button. - - * event-msw.c (mswindows_user_event_p): Recognize misc user events as - user events. - (mswindows_enqueue_misc_user_event): Added function. - (mswindows_bump_queue): Removed function. - (mswindows_enqueue_magic_event): Support NULL HWND parameter. - (mswindows_wnd_proc, WM_CLOSE): Use mswindows_enqueue_misc_user_event(). - (mswindows_wnd_proc, WM_EXITSIZEMOVE): Ditto. - (emacs_mswindows_handle_magic_event): Handle XM_BUMPQUEUE, by doing - really nothing, which is my personal favorite thing. - - * console-msw.h: Removed prototype for mswindows_bump_queue(). - Added prototype for mswindows_enqueue_misc_user_event(). - - * menubar-msw.c (mswindows_handle_wm_command): Use - mswindows_enqueue_misc_user_event(). - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. - - * dialog-msw.c (dialog_proc): Ditto. - - * scrollbar-msw.c (mswindows_handle_scrollbar_event): Ditto. - (mswindows_handle_scrollbar_event): Use frame, not window, for misc - user events channel. - -1998-05-29 Greg Klanderman - - * window.c (Fwindow_displayed_text_pixel_height): was relying on - incorrect semantics of vmotion_pixels which has been fixed. don't - use it anymore as it can't easily be used. - - * indent.c (vmotion_pixels): fix off by one bug moving up. also - the motion was reported incorrectly if you tried to go past end of - buffer. - -1998-05-30 Kirill M. Katsnelson - - * toolbar.h: Removed misleading commentary, as Martin suggested. - -1998-05-30 Kirill M. Katsnelson - - * lisp.h: Extern Qactivate_menubar_hook. - - * menubar-msw.c (unsafe_handle_wm_initmenu_1): Pass correct value to - run_hook (). - -1998-05-29 Andy Piper - - * glyphs-msw.c: use BPLINE macro. - - * select-msw.c (mswindows-selection-exists-p) - (mswindows-delete-selection): doc string fixes. - - * toolbar-msw.c (mswindows_output_toolbar): make disabled buttons - unpressable. warning elimination. - -1998-05-28 Martin Buchholz - - * alloc.c (dbg_constants): - * dbxrc: - * gdbinit: - Remove toolbar_data debugging code, since that lrecord has - also been removed. - -Wed May 27, 1998 Darryl Okahata - - * alloc.c: zap cached value of (user-home-directory), so that - it's not undumped. - - * buffer.c: From init_buffer(), separated out code that - determined the initial directory for the *scratch* buffer, and - put them into a function called "init_initial_directory()". - The initial directory is now available as a global "char *" - called initial_directory. - - * buffer.h: Added extern entries for initial_directory[] and - init_initial_directory(). - - * editfns.c: added new elisp function "user-home-directory", - which basically returns getenv("HOME"), but attempts to use - other values if $HOME isn't set.This may have to be tweaked in - the future as, under Unix, "/" is used if $HOME isn't set (this - probably should be set to the current directory). To support - this, a new C function, "get_home_directory()", now exists, - which returns the "home directory", as a "char *" string. - - * emacs.c: Rearrange NT initialization order so that - environment/registry variables will be properly entered into - Vprocess_enviroment. - - * fileio.c: replaced egetenv("HOME") with calls to the new - get_home_directory(). - - * lisp.h: Added function prototypes for uncache_home_directory() - and get_home_directory(), along with lisp prototypes for - Fuser_home_directory() and friends. - - * nt.c: replaced getenv("HOME") with calls to the new - get_home_directory(). - - * sysfile.h: for WINDOWSNT, #include , to suppress - warnings about getcwd(), etc. not having prototypes. - -1998-05-28 Kirill M. Katsnelson - - * process-nt.c (send_signal): Emulate SIGHUP. - (validate_signal_number): Ditto. - - * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Unconditionally - remove MOD_SHIFT from ASCII characters. - (mswindows_wnd_proc, WM_KEYDOWN): Do not activate the menubar when - F10 is pressed. - -1998-05-24 Oliver Graf - - * frame-x.c (cde-start-drag-internal): added filename and multi- - data transfers - (x_cde_convert_callback) dito - -1998-05-26 Oliver Graf - - * frame-x.c: include event-mod.h also with CDE - (x_cde_convert_callback) made the thing working - (cde-start-drag-internal) also debugging - -1998-05-25 Hans Guenter Weigand - - * m/sparc.h: - * getloadavg.c: - * malloc.c: - * unexec.c: - * mem-limits.h: - - add __OpenBSD__ where __NetBSD__ was found. - - TODO: replace platform-specific conditional compilation by - feature tests in configure.in. - -1998-05-15 Greg Klanderman - - * window.c (Fwindow_displayed_text_pixel_height): New function. - (syms_of_window): DEFSUBR it. - - * indent.c (Fvertical_motion_pixels): New function - request - movement in pixels. - (vmotion_pixels): helper. - (syms_of_indent): DEFSUBR. - * lisp.h: declaration for vmotion_pixels(). - - * indent.c (Fvertical_motion): Add optional third argument PIXELS, - to request returning motion in pixels. - (Fvertical_motion_pixels): Remove, functionality merged into - Fvertical_motion. - * window.c (window_scroll): call Fvertical_motion with 3 arguments. - (Fmove_to_window_line): ditto. - * lisp.h: Change declaration for Fvertical_motion. - - * window.c: rename window-text-pixel-{height,width,edges} to - window-text-area-pixel-*. - -1998-05-26 Gunnar Evermann - - * tooltalk.c (vars_of_tooltalk) added staticpro for - Tooltalk_Message_plist_str and Tooltalk_Pattern_plist_str - -1998-05-27 Andy Piper - - * faces.c: create a new 3d_object_face, make modeline and - vertical_divider faces fallback to this rather than the default. - -1998-05-21 Andy Piper - - * s/cygwin32.h: define charsets for cygwin. - -1998-05-25 Andy Piper - - * toolbar-msw.c (mswindows_output_toolbar): fix up button sizes - and coordinates. resize bitmaps if we have already settled on a - different size. - - * glyphs-msw.c (xpm_to_eimage): add ';' for mswindows compiler. - -1998-05-25 Hrvoje Niksic - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. - - * menubar-msw.c (mswindows_handle_wm_command): Ditto. - - * gui.h: Ditto. - - * gui-x.c (popup_selection_callback): Ditto. - - * dialog-msw.c (dialog_proc): get_callback -> get_gui_callback. - - * gui.c (get_callback): Renamed to get_gui_callback. - -1998-05-17 Martin Buchholz - - * glyphs.h: order rearrangement. - - * device-tty.c (tty_asynch_device_change): Warning suppression. - * device-x.c (x_device_system_metrics): Warning suppression. - Make Doc strings consistent with coding standards. - -1998-05-24 Martin Buchholz - - * general.c: multiple definition of `Qicon'. general.c seems - like a good home for Qicon. - -1998-05-20 Kirill M. Katsnelson - - * This patch is to fix compilation warnings under Windows. - - * s/windowsnt.h: Encapsulate getpid with sys_getpid. - Added prototypes for FSF inherited functions, with which XEmacs is - sprinkled thoroughly. - Removed some #if 0 code. Bracketed some more definitions, probably - related to Visual C versions prior to 4 (we do not support them). - - * sysfloat.h (logb): Finally, get logb() prototyped. - - * sysfile.h: Added Windows specific includes. - Removed old Windows specific code bracketed with #if 0. - - * sysdep.h: Added prototype for xrealpath(). - - * sysdep.c (sys_getpid): Added function, to support '95 negative pids. - - * symsinit.h: Added prototypes for syms_of_dired_mswindows, - vars_of_dired_mswindows and init_ntproc (Grrr). - - * realpath.c: Added Windows specific include files. - (xrealpath): Conditionalized declaration of some auto variables on - S_IFLNK, to avoid warnings. - - * ntproc.c: Disabled some compiler warnings. This file is going to - die, so I have not cleaned it up much. - (set_process_dir): Const parameter. - (Fwin32_short_file_name): Down CHECK_* macros to one argument. - (Fwin32_long_file_name): Ditto. - (Fwin32_set_process_priority): Ditto. Why didn't I remove these - three functions? - - * nt.h: Added prototypes for set_process_dir and convert_time. - - * nt.c: More include files. - (getpwnam): Consted char* argument. - (get_emacs_configuration): Const return value. - (opendir): Const argument. - (stat): Casted converstion long->short. - (stat): Removed ad hoc and questionable support for non-MSC compile. - (sys_pipe): Removed unused auto variable. - (_sys_read_ahead): Removed calls to DebPrint. - (sys_read): Ditto, in 2 places. - (term_ntproc): Added unused int parameter to signal handler, to - avoid a warning when compiling a call to signal(). - (msw_sigset): Properly return old signandler or NULL instead of void. - - * floatfns.c (Flogb): Casted arguments to unary minus to signed. - - * gmalloc.c (morecore): Ditto. - (_free_internal): Ditto. - - * lread.c (parse_integer): Ditto. - - * dired-msw.c: Added several include files. - - * cmdloop.c (Fcommand_loop_1): Added Microsoft C to the Big List - of Compilers to Shut Up. - - * callproc.c: Added #includes to suppress warnings under Windows. - (init_callproc): Removed #if0'ed code and unused variables. - -1998-05-25 Andy Piper - - * device-msw.c (mswindows_device_system_metrics): do planes in a - way consistent with X. - - * glyphs-msw.c (mswindows_initialize_image_instance_mask): don't - use SetPixel, use DIBits functions. - (xpm_to_eimage): frob colors more closely like xpm deos. - - * toolbar-msw.c: only resize bitmaps when shrinking. Adjust look - to be closer to X version. - - * event-msw.c: use tooltip string directly. - - * redisplay-msw.c: reinstate Kirill's bg pixmap change. - - * objects-msw.c: frob rgb colors that only Kyle uses. - - * dialog-msw.c (button_width): INLINE -> inline. - -1998-05-23 SL Baur - - * getloadavg.c (getloadavg): Fix typo. - -1998-05-23 Kirill M. Katsnelson - - * objects-msw.c (mswindows_initialize_font_instance): Added support - for font character sets. - Replaced 'XXX' with '####' in comments throughout the file. - -1998-05-23 Kirill M. Katsnelson - - * emacs.c (main_1): Added calls to vars_of_dialog_mswindows() and - console_type_create_dialog_mswindows(), to initialize Windows dialog - support. - - * symsinit.h: Prototyped the above functions. - - * dialog-x.c (x_popup_dialog_box): Moved dialog descriptor consistency - checks to dialog.c... - - * dialog.c (Fpopup_dialog_box): ...right here. Added more checks: a - device must support dialog boxes, and the descriptor must supply at - least one button. - - * dialog-msw.c: New file, dialogs for Windows. - -1998-05-21 Oscar Figueiredo - - * eldap.c (ldap_search_unwind): Return Qnil instead of nothing - (Fldap_search_internal): Removed unused variable `err' - - * eldap.h: Moved Lisp_LDAP declaration here instead of using a - forward declaration - -1998-05-17 Martin Buchholz - - * eldap.h: eldap.[ch] should never be used unless HAVE_LDAP is - defined. Therefore there is no need to handle the case when - HAVE_LDAP is undefined. Similarily, there is no reason to have - any code wrapped within `#ifdef emacs', since this code is only - useful within an emacs. This simplifies the code significantly. - - * inline.c: Include eldap.h only if HAVE_LDAP. - * inline.c: Don't bother including TT_C_H_PATH, since tooltalk.h - already does that. - -1998-05-21 Kirill M. Katsnelson - - * unexnt.c (copy_executable_and_dump_data_section): Suppress - printing dump stats when building without DEBUG_XEMACS. - (dump_bss_and_heap): Ditto. - -1998-05-21 Andy Piper - - * gnuclient.c: don't suppress window system if there is no display - and we are running under mswindows. send 'mswindows device type if - we are in this situation. - -1998-05-20 Andy Piper - - * general.c: - * lisp.h: Qbitmap, Qcursor, Qicon moved here from glyphs-msw.c. - - * glyphs-msw.c: change cursor imgae type name to resource. Fix - some nits. - -1998-05-20 Kirill M. Katsnelson - - * EmacsFrame.c (Xt_StringToScrollBarPlacement): Added support for - {top,bottom}-{left,right} values in addition to - {top,bottom}_{left,right}. - -1998-05-18 Hrvoje Niksic - - * fileio.c (Fmake_temp_name): Remove unreached code. - - * process-nt.c (validate_signal_number): Use - signal_simple_error(). - -1998-05-19 Martin Buchholz - - * unexhp9k800.c: - * sound.c (vars_of_sound): - * sysdep.c (reset_sigio_on_device): - * window.c (window_bottom_gutter_height): - unexhp9k800.c:258: warning: implicit declaration of function - `calculate_checksum' - sound.c:604: warning: implicit declaration of function `vars_of_hpplay' - sysdep.c:1012: warning: unused variable `owner' - window.c:993: warning: `window_right_toolbar_width' defined but not used - -1998-05-19 Andy Piper - - * glyphs-msw.c (mswindows_create_resized_mask) - (mswindows_create_resized_bitmap): new funnctions split out from - mswindows_resize_dibitmap_instance. - - * glyphs-msw.h: declare new resize functions. - - * toolbar-msw.c (mswindows_output_toolbar): use new bitmap resize - functions so that the original bitmaps are preserved. - - * sheap.c: fixup static heap exhausted error to avoid FAQs. - - * redisplay-msw.c (mswindows_output_blank): fixup brush from bg - color if we are trying to output 0 depth bg pixmap. - - * scrollbar-msw.c: warning elimination. - -1998-05-18 Martin Buchholz - - * frame-x.c (x_update_frame_external_traits): Start preprocessor - directives in column 1. - - * search.c (skip_chars): Avoid using xzero with arrays, since some - compilers get confused by the construct &array. - -1998-05-18 Kirill M. Katsnelson - - * objects-msw.h: - * objects-msw.c: Changed the charset value for a new font from - "don't care" to "ansi". - - * glyphs-msw.c (convert_EImage_to_DIBitmap): Warnings fix. - -1998-05-18 Kirill M. Katsnelson - - * event-msw.c (mswindows_wnd_proc, WM_KEYDOWN): Do not clear shift - modifier on control chars. - Use IsCharAlpha() instead of isaplha(). - -1998-05-19 Kazuyuki IENAGA - - * s/freebsd.h: FreeBSD 2.2.6 now supports setlocale(LC_ALL, ""). - -1998-05-18 Kirill M. Katsnelson - - * objects-msw.c (mswindows_initialize_font_instance): Use ANSI - charset when creating font. - (mswindows_initialize_color_instance): Do not create brush along - with a color. - (mswindows_finalize_color_instance): Do not delete it then. - - * objects-msw.h (struct mswindows_color_instance_data): Removed - brush slot, and corresponding accessor macro. - -1998-05-18 Kirill M. Katsnelson - - * toolbar.c: Removed toolbar_data lrecord implementation. - (mark_frame_toolbar_buttons_dirty): Replase usage of toolbar_data - with toolbar_buttons (via FRAME_TOOLBAR_BUTTONS). - (compute_frame_toolbar_buttons): Ditto. - (CHECK_TOOLBAR): Ditto. - (set_frame_toolbar): Removed allocation of toolbar_data lrecord. - (update_frame_toolbars): Do not check for changed buffer - here. Toolbar information is provided by cached specs in - windows. The check for buffer is eliminated becuase toolbars are - marked changed in set_frame_selected_window() in frame.c - Added check for changed toolbars geometry. - (compute_frame_toolbars_data): Removed unused second parameter; - Adjusted callers of this static function throughout the file. - (init_frame_toolbars): Initialize current_toolbar_size. - (update_frame_toolbars): Use DEVICE_SUPPORTS_TOOLBARS_P instead of - what is its current expansion, for clarity. - (init_frame_toolbars): Ditto. - (init_device_toolbars): Ditto. - (init_global_toolbars): Ditto. - - * toolbar.h: Removed definition of toolbar_data lrecord. - Added accessor macros FRAME_TOOLBAR_BUTTONS and - FRAME_CURRENT_TOOLBAR_SIZE. - Added macro DEVICE_SUPPORTS_TOOLBARS_P. - - * toolbar-x.c (x_output_toolbar): The same change as in - toolbar-msw.c - (x_output_toolbar): Ditto. - (x_redraw_exposed_toolbar): Ditto. - - * toolbar-msw.c (mswindows_output_toolbar): Retrieve current - buttons from toolbar_buttons using FRAME_TOOLBAR_BUTTONS macro. - (mswindows_output_toolbar): Ditto. - (mswindows_output_toolbar): Ditto. - - * frame.c (mark_frame): Removed marking of arrays, according to - frameslots.h change. - (nuke_all_frame_slots): Ditto. - (set_frame_selected_window): Mark toolbars changed when - last_nonminibuf_window changes. - - * frame.h (struct frame): Moved some slots to frameslots.h. - Added current_toolbar_size array. - Changed references from toolbar_data to toolbar_buttons in macros - FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE, - FRAME_RAW_THEORETICAL_TOOLBAR_SIZE and - FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH. - - * frameslots.h: Added macro MARKED_SLOT_ARRAY a la winslots.h - Moved arrays of lisp objects here from frame.h: toolbar_size, - toolbar_visible_p, toolbar_border_width. - Removed toolbar_data slot and added toolbar_buttons. - -1998-05-17 Kirill M. Katsnelson - - * symsinit.h: Externed syms_of_process_nt() - - * emacs.c (main_1): Call syms_of_process_nt() - - * process-nt.c: Quote process arguments by a call to Lisp function - `nt-quote-process-args'. - (syms_of_process_nt): New function. - (nt_send_process): Flush data stream after each write, to avoid - leaving buffered data. - (nt_send_process): When blocked on process output, wait for - process to slurp more for progressively increasing time intervals. - -1998-05-17 Martin Buchholz - - * window.c (have_undivided_common_edge): Make file-local function - static. - (map_windows): Return 0 if all map functions successful. - Fix typos. - - * winslots.h: Use unlikely names for local variables in macros to - avoid shadowing warnings. - -1998-05-17 Andy Piper - - * toolbar-msw.c (mswindows_output_toolbar): hash on toolbar width - so that we re-output if the toolbar size has changed. - -1998-05-17 Michael Sperber [Mr. Preprocessor] - - * s/aix4-2.h (ALIGN_DATA_RELOC): Undefined to support new unexaix.c. - - * s/aix3-1.h (ALIGN_DATA_RELOC): Defined to support new unexaix.c. - - * unexaix.c: Massive cleanup and support of AIX 4.2 (and hopefully - greater). - -1998-05-16 Kirill M. Katsnelson - - * glyphs-msw.c: Defined OEMRESOURCE before including windows.h to - get bitmap manifest constants defined. - - * console-msw.h: Include system files in angle brackets, not in - quotes. - - * window.c (specifier_vars_of_window): Fixed a typo in - `vertical-divider-line-width' docstirng. - -1998-05-16 Olivier Galibert - - * line-number.c (delete_invalidate_line_number_cache): Use an - EMACS_INT. - (buffer_line_number): Remove dangerous, plain wrong when using - 64bits emacs ints, cast. - - * insdel.c (buffer_delete_range): Use an EMACS_INT. - - * cmds.c (Fforward_line): Use EMACS_INTs. - - * search.c (bi_scan_buffer): Change to use EMACS_INTs. - (scan_buffer): Ditto. - (bi_find_next_newline_no_quit): Remove useless cast. - (find_next_newline_no_quit): Ditto. - (find_next_newline): Ditto. - (find_before_next_newline): Use an EMACS_INT. - - * lisp.h: Change scan_buffer to pass EMACS_INTs. - -1998-05-16 Hrvoje Niksic - - * menubar-msw.c (mswindows_handle_wm_command): Ditto. - - * toolbar-msw.c (mswindows_handle_toolbar_wm_command): Ditto. - - * gui-x.c (popup_selection_callback): Use it. - - * gui.h (get_callback): Declare it. - - * gui.c (get_callback): New function. - -1998-05-15 SL Baur - - * window.c (have_undivided_common_edge): Guard scrollbar specific - stuff. - (window_needs_vertical_divider_1): Ditto. - -1998-05-16 Hrvoje Niksic - - * emacs.c (decode_path): Eliminate compiler warning. - (Fdecode_path): Renamed to Fsplit_path. - (Fsplit_string_by_char): New function. - -1998-05-14 Damon Lipparelli - - * winslots.h: close comment - -1998-05-16 Kirill M. Katsnelson - - * callproc.c: Removed declared and unused variable Qbuffer_file_type. - - * bufslots.h: Removed buffer_file_type slot. - - * buffer.c (complex_vars_of_buffer): Removed buffer_file_type from - buffer local flags. - (complex_vars_of_buffer): Removed buffer-file-type variable and - its default reference. - -1998-05-15 Kirill M. Katsnelson - - * faces.c (complex_vars_of_faces): Defined - Vvertical_divider_face. - (vars_of_faces): Staticpro it. - - * faces.h: Externed Vvertical_divider_face. - - * redisplay-x.c (x_output_vertical_divider): Use - Vvertical_divider_face to draw the divider instead of modeline - face. - - * redisplay-msw.c (mswindows_output_vertical_divider): Draw - divider face using Vvertical_divider_face background. - Fix drawing spacing gaps around the divider. - -1998-05-14 Didier Verna - - * redisplay-x.c (x_output_vertical_divider): removed hard-wired - values for the vertical divider line width and spacing. Use the - cached values from the window structure instead. - (x_divider_width): ditto. - - * window.c (specifier_vars_of_window): new specifiers: - vertical-divier -line-width and -spacing. - (vertical_divider_global_width_changed): formerly known as - vertical_divider_shadow_thickness_changed. - - * winslots.h: new slots: vertical_specifier _line_width and - _spacing. Plus corrected a comment typo. - -1998-05-15 Kirill M. Katsnelson - - * window.h: Declared window_divider_width(). - - * console-stream.c (stream_divider_width): Removed method. - (console_type_create_stream): And declaration for it. - - * redisplay.c (pixel_to_glyph_translation): Use - window_divider_width() instead of divider_width redisplay method. - (pixel_to_glyph_translation): Fix top divider edge calculation - when scrollbar is on top. - - * window.c (window_divider_width): New function, an outphaser for - divider_width redisplay method. - (window_right_gutter_width): Use it. - (specifier_vars_of_window): For vertical-divider-{spacing,line-width} - specifiers, set fallback values differently on TTYs, and document - the behavior of these on TTYs in the docstrings. - - * scrollbar.c (update_scrollbar_instance): Use - window_divider_width() instead of divider_width redisplay method. - - * console.h (struct console_methods): Removed divider_width_method. - - * redisplay-tty.c (tty_divider_width): Removed device method. - (console_type_create_redisplay_tty): Removed definition for it. - (tty_output_vertical_divider): Respect the value returned by - window_divider_width thus divider line width specification. - - * redisplay-msw.c (mswindows_divider_width): Removed device method. - (console_type_create_redisplay_mswindows): Removed definition for it. - (mswinodws_output_vertical_divider): Respect the value returned by - window_divider_width thus divider line width specification. - -1998-05-15 Andy Piper - - * toolbar-msw.c: guess toolbar frame size a bit more accurately. - -1998-05-15 Andy Piper - - * glyphs-msw.c: resource loading implementation. - (cursor_normalize): new function. - (cursor_validate): ditto. - (cursor_instantiate): ditto. - (cursor_name_to_resource): ditto. - (cursor_possible_dest_types): ditto. - (check_valid_symbol): ditto. - (check_valid_string_or_int): ditto. - -1998-05-14 Martin Buchholz - - * sysdep.c (tty_init_sys_modes_on_device): Treat VSUSP just like - VINTR and VQUIT. - - * process-unix.c (process_signal_char): Use VSUSP instead of - non-standard VSWTCH. Always prefer VSUSP to VSWTCH. - -1998-05-14 Kirill M. Katsnelson - - * specifier.c (specifier_instance): Change locale precedence of - instantiation so window locale has higher priority than buffer - locale. - (Fspecifier_instance): Reflect this in docstring. - (Fadd_spec_list_to_specifier): Ditto. - (Fadd_spec_to_specifier): Ditto. - (Fremove_specifier): Ditto. - -1998-05-15 Kirill M. Katsnelson - - ** Dialog separation into a device method from Andy Piper - - * emacs.c (main_1): Call console_type_create_dialog_x(). - - * dialog-x.c (x_popup_dialog_box): Old Fpopup_dialog_box converted - into this device method. - (console_type_create_dialog_x): New function. - - * dialog.c (Fpopup_dialog_box): New function. - (syms_of_dialog): Defsubr it. - - * console.h (struct console_methods): Declared - popup_dialog_box_method(). - - * symsinit.h: Defined console_type_create_dialog_{x,mswindows} - -1998-05-14 Oliver Graf - - * dragdrop.c (vars_of_dragdrop): dragdrop-protocols created - * frame-x.c (x_cde_transfer_callback): checked for merge errors - -1998-05-13 Oliver Graf - - * dragdrop.c (vars_of_dragdrop): provide dragdrop-api - -1998-05-15 Kirill M. Katsnelson - - * console.h (device_metrics): Removed dbcs, input-method-editor - and right-to-left metrics. - - * device.c (Fdevice_system_metric): Ditto. - (Fdevice_system_metrics): Ditto. - (syms_of_device): Ditto. - (Fdevice_system_metric): Swapped DEVICE and METRIC parameters back - again. - -1998-05-14 Hrvoje Niksic - - * line-number.h (mark_line_number_cache): Remove unused - declaration. - - * line-number.c (LINE_NUMBER_FAR): Increase to 32768. - (get_nearest_line_number): Simplify. - (add_position_to_cache): Make the old marker point nowhere. - -1998-05-14 Kirill M. Katsnelson - - ** Renamed window-divider-map => vertical-divider-map - and event-over-divider-p => event-over-vertical-divider-p, - in the following files/functions: - * events.h: - * events.c (Fevent_over_divider_p): - * keymap.c (get_relevant_keymaps): - (vars_of_keymap): - - * redisplay.h (OVER_V_DIVIDER): Renamed so from OVER_DIVIDER. - - * redisplay.c (pixel_to_glyph_translation): Use OVER_V_DIVIDER. - -1998-05-14 Kirill M. Katsnelson - - * window.c (vertical_divider_changed_in_window): Renamed so. - (specifier_vars_of_window): Defined Vvertical_divider_draggable_p. - (window_needs_vertical_divider_1): Decide whether we need it based - on the value of the above specifier. If separators are unwanted, - put them only if there's no scrollbar between this window and its - right neighbor. - (have_undivided_common_edge): New function, helper for the above. - (window_needs_vertical_divider): Return either a cached value, - or clauclate and cache one. - (invalidate_vertical_divider_cache_in_window): Implemented. - (map_windows): Changed return type to int, return the value from - MAPFUN. - - * window.h: Prototype invalidate_vertical_divider_cache_in_window. - (struct window): Added need_vertical_divider_p and - need_vertical_divider_valid_p. - - * winslots.h: Added vertical_divider_draggable_p slot. - - * scrollbar.c (vertical_scrollbar_changed_in_window): Implemented. - (specifier_vars_of_scrollbar): Used it in all vertical specifiers. - - * frame.c (invalidate_vertical_divider_cache_in_frame): New function. - - * frame.h (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): Call - invalidate_vertical_divider_cache_in_frame(). - Prototype it. - -1998-05-14 Andy Piper - - * toolbar-msw.c: provide correct parameters to TB_SETROWS. - - * glyphs-msw.c (mswindows_initialize_image_instance_mask): size - masks correctly and don't select 0. - -1998-05-14 Kirill M. Katsnelson - - * winslots.h: New file, declaration of some struct window and - struct saved_window members. - - * window.h (struct window): Include it, with required preprocessor - magic. - - * window.c (mark_window): Ditto. - (allocate_window): Ditto. - (struct saved_window): Ditto. - (mark_window_config): Ditto. - (saved_window_equal): Ditto. - (Fset_window_configuration): Ditto. - -1998-05-14 Kirill M. Katsnelson - - * redisplay-msw.c (mswindows_output_vertical_divider): Syntax fix. - -1998-05-12 Didier Verna - - * redisplay-x.c (x_output_vertical_divider): draw shadows around - the divider line. The shadow thickness is currently - hard-wired. This will probably be turned into a specifier soon. - -1998-05-12 Didier Verna - - * console.h (struct console_methods): the divider_width console - method now requires a struct window * argument. - - * redisplay-x.c (x_divider_width): ditto. Plus remove - X_DIVIDER_WIDTH, X_DIVIDER_SHADOW_THICKNESS. - (x_output_vertical_divider): give a depressed look when the shadow - thickness is negative. - - * console-stream.c (stream_divider_width): pass a struct window * - argument. - - * redisplay-tty.c (tty_divider_width): ditto. - - * window.c (window_right_gutter_width): totdi. - - * redisplay.c (generate_modeline): ittod. - - * scrollbar.c (update_scrollbar_instance): ttido. - - * redisplay-msw.c (mswindows_divider_width): ottid. - WARNING: this enables to compile, but the feature is not functional. - - * window.h (struct window): new field - vertical_divider_shadow_thickness. - - * window.c (specifier_vars_of_window): new specifier - vertical-divider-shadow-thickness. - (vertical_divider_shadow_thickness_changed): new function to - inform redisplay that the window has changed. - (mark_window): handle new field vertical_divider_shadow_thickness - from struct window. - (allocate_window): ditto. - (saved_window_equal): toddi. - (Fset_window_configuration): totid. - (save_window_save): ttdio. - (struct saved_window): new field vertical_divider_shadow_thickness. - -1998-05-14 Kirill M. Katsnelson - - * device-msw.c (mswindows_device_system_metrics): Support a deluge - of metrics. - -1998-05-12 Oliver Graf - - * frame-x.c (x_cde_transfer_callback): fixed for the new protocol - * event-Xt.c (x_event_to_emacs_event): C++ compability - -1998-05-14 Hrvoje Niksic - - * emacs.c (Fdecode_path): Default SEPCHAR to value of - path-separator. - -1998-05-14 Hrvoje Niksic - - * emacs.c (vars_of_emacs): Do it here; change the meaning of - Vpath_separator. - - * fileio.c (vars_of_fileio): Don't define Vpath_separator here. - -1998-05-14 Hrvoje Niksic - - * emacs.c (decode_path_1): New function. - (decode_path): Use it. - (Fdecode_path): Renamed from Fdecode_path_internal; use - decode_path_1. - -1998-05-12 Hrvoje Niksic - - * macros.c (Fzap_last_kbd_macro_event): New function. - (Fend_kbd_macro): Remove REMOVE_LAST kludge. - -1998-05-10 Andy Piper - - * redisplay-msw.c (mswindows_output_dibitmap_region): make sure - multiple bitmaps are output vertically as well as horizontally. - * (mswindows_output_dibitmap): don't cope with bitmap boundaries - crossing lines this is handled by - mswindows_output_dibitmap_region. - -1998-05-12 Martin Buchholz - - * inline.c: Include eldap.h - - * menubar-x.c (x_update_frame_menubar_internal): - Remove: unused variable `container' - -1998-05-11 Martin Buchholz - - * s/aix4.h: Allow AIX 4.3 XEmacs to compile cleanly. - Unfortunately, the resulting temacs still cannot dump. - - * symbols.c (symbol_is_constant): - (verify_ok_for_buffer_local): - -Wswitch Warning suppression - add default case to switches. - - * redisplay.c (decode_mode_spec): Remove unused variables, - Replace Fcoding_system_property (codesys, Qmnemonic) with - XCODING_SYSTEM_MNEMONIC (codesys); - Fcoding_system_property is for users. - - * buffer.c: - * fileio.c: - * lread.c: - * xselect.c: - Change empty docstrings into no doc strings at all. - Fix bogus FSF-format docstrings. - - * extents.c: - Standardize docstrings. - - * floatfns.c: - Explain problems with matherr. - - * glyphs.c: make DEFUNs etags-readable, i.e. single-line - - * syssignal.h: - if BROKEN_SIGIO, then SIGIO wants to be undefined. - if SIGIO and not SIGPOLL, SIGPOLL wants to be SIGIO.\ - Fix the weird resultant interaction (causes windows problems) - - * gdbinit: - * dbxrc: - Take new EMACSBOOTSTRAPLOADPATH into account. - Update documentation strings - - * Makefile.in.in: - - Adjust for luser's CDPATH being set to something weird. - - Take into account bash 2.02's tendency to print the cwd when - using CDPATH. Always use `cd ./foo' instead of `cd foo'. - - fix the run-temacs target to use $(DUMPENV) - - fix the run-puremacs target to use $(DUMPENV) - - fix the `depend' target to properly $(RM) the right files - - Generate a better TAGS file for XEmacs' lisp code using - hand-crafted regexps. - - Use standard coding conventions for modules/Makefile.in - -1998-05-12 Didier Verna - - * redisplay.c: removed the scrolling modeline code that didn't - make it for 21.0. To be continued ... - -1998-05-13 Michael Sperber [Mr. Preprocessor] - - * emacs.c (Fdecode_path_internal): Removed bogus handling of nil - and empty string inputs. - -1998-05-12 Hrvoje Niksic - - * redisplay-x.c (x_output_vertical_divider): Fixed typo. - -1998-05-10 Oliver Graf - - * event-stream.c (enqueue_misc_user_event_pos): created - * lisp.h (enqueue_misc_user_event_pos): prototype added - * frame-x.c (x_cde_transfer_callback): debug code plus API changes - * emacs.c: call vars_of_dragdrop - * dragdrop.c (vars_of_dragdrop): provide dragdrop - -1998-05-11 Oliver Graf - - * frame-x.c (x_cde_transfer_callback): return at correct pos - * event-Xt.c (x_event_to_emacs_event): changed format of drop - object for MIME (see comment in dragdrop.c) - * dragdrop.c: API change documented in comment - removed provide of dragdrop [is provided by dragdrop.el] - -1998-05-12 Kirill M. Katsnelson - - * window.c (window_needs_vertical_divider): Enable vertical - dividers for every non-rightmost window. - (window_left_gutter_width): Left gutter consists of mythical - toolbar and a virtual scrollbar. - (window_right_gutter_width): The right one may have a divider - also. - - * scrollbar.c (update_scrollbar_instance): Position vertical - scrollbar left to divider if the latter present. - - * redisplay.h: Declared OVER_DIVIER constant. - - * redisplay.c (pixel_to_glyph_translation): Handle OVER_DIVIDER - case. - - * redisplay-x.c (x_output_vertical_divider): Output divider along - the right side of the window, down to window bottom. Swapped - foreground and background colors so it is visible by default. - - * redisplay-tty.c (tty_output_vertical_divider): Uncondiionally - stick the divider to the right window side. - - * redisplay-msw.c (mswindows_redisplay_deadbox_maybe): Fixed - deadbox painting. - (mswindows_divider_width): Ask system for user preferred value. - (mswindows_output_vertical_divider): Always output the divider on - the right side of a window, down to bottom. - - * keymap.c (get_relevant_keymaps): Route mouse button events which - happened over a window divider through window-divider-map. - (Fkey_binding): Documented that in the docstring. - Defined the variable Vwindow_divider_map. - - * events.c (Fevent_over_divider_p): Added this function. - - * events.h: EXFUNed it. - -1998-05-12 Kirill M. Katsnelson - - * toolbar.c (update_frame_toolbars): Re-layout frame windows if - toolbar geometry is suspected to change. - -1998-05-11 Jonathan Harris - - * src/device-msw.c - * src/event-msw.c - Condition dnd and dde code on HAVE_DRAGNDROP. - -1998-05-11 Hrvoje Niksic - - * events.c (format_event_object): Print space as SPC etc. - -1998-05-11 Hrvoje Niksic - - * print.c (print_internal): In the default case, abort() if - ERROR_CHECK_TYPECHECK. - - * fileio.c (Fmake_temp_name): Doc fix. - -1998-05-10 Hrvoje Niksic - - * xgccache.c (describe_gc_cache): Define only if DEBUG_XEMACS. - - * undo.c (Fprimitive_undo): Fixed typo. - -1998-05-11 Hrvoje Niksic - - * fns.c (concat): Signal error on integer argument. - -1998-05-10 Kirill M. Katsnelson - - * console.h (device_metrics): Prefixed each constatnt with DM_ - - * device.c: (Fdevice_system_metric): Renamed so from plural form - (metrics); Changed parameters order and added DEFAULT parameter; - Unabbreviated some metric constants; Fixed and untabified doc string. - (Fdevice_system_metrics): Added. Returns a plist of all provided - metrics. - - * device-msw.c (mswindows_device_system_metrics): Renamed - device_metrics enum constants. - Return Qunbound instead of Qnil. - - * device-tty.c (tty_device_system_metrics): Ditto. - - * device-x.c (x_device_system_metrics): Ditto. - -1998-05-10 Andy Piper - - * redisplay-msw.c: implement background pixmaps (really!). Make - sure bg color is transparent if we have bg pmaps. - * (mswindows_output_string) (mswindows_clear_region): output bg - pmap if required. - * (mswindows_output_dibitmap_region): new function. - * (mswindows_output_dibitmap): output offset pixmaps, blt masks in - the bg color rather than transparently. - - * toolbar-msw.c: use masks if they exist. - - * glyphs-msw.c: set up masks correctly. - - * event-msw.c: typedef SOCKET if cygwin and not msg select(). - -1998-05-10 Hrvoje Niksic - - * regex.c (re_match_2_internal): Check for quit. - -1998-05-10 Hrvoje Niksic - - * frame.c (Ffocus_frame): New function. - diff --git a/src/ChangeLog.1 b/src/ChangeLog.1 deleted file mode 100644 index fa31bc6..0000000 --- a/src/ChangeLog.1 +++ /dev/null @@ -1,8315 +0,0 @@ -1998-05-06 Oliver Graf - - * Makefile.in.in: removed dragdrop.o from objs - * config.h.in: HAVE_DRAGNDROP added - * emacs.c: do syms_of_dragdrop only if HAVE_DRAGNDROP is defined - * event-Xt.c: dragdrop.h include now depends on HAVE_DRAGNDROP - changed calls to dnd_url_hexify_string - MIME data is now a list of MIME strings or lists - this was required by CDE, and a good idea in any case - * dragdrop.c (dnd_url_hexify_string): method prefix code added - * dragdrop.h: dnd_url_hexify_string prototype changed - * frame-x.c (x_cde_transfer_callback): CDE adapted the new API - -1998-05-05 Jonathan Harris - - * event-msw.c: now creates misc-user-events on dnd drops - -1998-05-05 Oliver Graf - - * events.h: changed comment for misc_user_events - * events.c (make-event): removed dnd_data defs - * frame.c: removed everything referring to drag_and_drop_functions - * frame-x.c (x_cde_transfer_callback): disabled (needs to be changed) - * lisp.h: removed Qdnd_data - * general.c: removed Qdnd_data - * symsinit.h: added syms_of_dragdrop - * frame.el: deleted default-drag-and-drop-functions - -1998-05-04 Oliver Graf - - * events.c: removed all dnd_drop stuff - * events.h: extended misc_user_data by button info - removed dnd_drop event - * emacs.c: added call to syms_of_dragdrop - * dragdrop.c: created - * dragdrop.h: created - * event-stream.c (enqueue_misc_user_event): initialization of the - new fields of misc_user_data - dnd_drop stuff removed - * keymap.c: drop symbols removed - * Makefile.in.in: added dragdrop.o to objs - -1998-05-09 SL Baur - - * EmacsFrame.c (EmacsFrameSetValues): Fix typo. - Suggested by: Kirill M. Katsnelson - -1998-05-09 Kirill M. Katsnelson - - * This change adds four scrollbar specifiers: - {horizontal,vertical}-scrollbar-visible-p and - scrollbar-on-{top,left}-p. - Spare parts supplied by Didier Verna - - * frameslots.h: Added slots for the four specifier caching. - - * frame.h: FRAME_SCROLLBAR_{WIDTH,HEIGHT} count for scrollbar - visible specifiers. - Removed old resource-only controlled scrollbar_on_* ints. - - * frame-x.c (x_layout_widgets): Removed (to x-scrollbar.el) - initialization of old style scrollbar placement from resources. - - * frame-tty.c (tty_init_frame_1): Removed initialization of old - style scrollbar placement. - - * frame-msw.c (mswindows_init_frame_1): Removed random - initialization of scrollbar sizes to 15 pixel. - - * redisplay-msw.c (mswindows_redisplay_deadbox_maybe): Use - scrollbar placement specifiers cached values from window, instead - of the old per-frame values. - (mswindows_output_vertical_divider): Ditto. - - * redisplay-x.c (x_output_vertical_divider): Ditto. - - * redisplay-output.c (redisplay_clear_bottom_of_window): Ditto. - - * scrollbar.c (update_scrollbar_instance): Ditto. - (specifier_vars_of_scrollbar): Declared the four specifiers. - - * window.h (struct window): Defined slots for caching the new - specifiers. - - * window.c (mark_window): Mark them. - (allocate_window): Initialize them. - (struct saved_window): Store them in a cool place. - (saved_window_equal): Compare them. - (save_window_save): Save them. - (Fset_window_configuration): Fetch them back. - (window_needs_vertical_divider): Check for scrollbar placement - using window cached specs. - (window_top_gutter_height): Ditto. - (window_bottom_gutter_height): Ditto. - (window_left_gutter_width): Ditto. - (window_right_gutter_width): Ditto. - (window_scrollbar_width): Account for scrollbar visibility - specification in window. - (window_scrollbar_height): Ditto. - -1998-04-18 Kirill M. Katsnelson - - * device.c (Fdevice_system_metrics): Added function. - Moved (device-pixel-height), (device-pixel-width), - (device-mm-width), (device-mm-height), (device-bitplanes), - (device-color-cells) to device.el, amd make them call - (device-system-metrics). - - * console.h (struct console_methods): Replaced methods: - device_pixel_width_method(), device_pixel_height_method(), - device_mm_width_method(), device_mm_height_method(), - device_bitplanes_method(), device_color_cells_method() - with single device_system_metrics_method(). - (device_metrics): Declared enumeration of supported - device system metrics. - - * device-msw.c (mswindows_device_system_metrics): Implement - device_system_metrics_method(), remove six obsolete methods. - - * device-tty.c (tty_device_system_metrics): Ditto. - - * device-x.c (x_device_system_metrics): Ditto. - -1998-05-10 Kirill M. Katsnelson - - * EmacsFrame.c (update_various_frame_slots): Do not store internal - border width there. - (EmacsFrameInitialize): Do it rather here. - (EmacsFrameSetValues): If EditRes has changed internal border - width, mark frame size as slipped. - -1998-05-06 Kirill M. Katsnelson - - * frame.h (struct frame): Added char_{width,height} member - variables and access macros - Added size_slipped redisplay bit and mark/clear macros. - - * redisplay.c (redisplay_frame): Adjust frame size if size slipped - bit is set. - (redisplay_device): Call redisplay_frame if size slipped bit is set. - - * frame.c (adjust_frame_size): Redisplay beats frame back in shape - with this. Added. - (frame_size_slipped): Added. - (internal_set_frame_size): Clear size slipped bit. - (change_frame_size_1): Store real charsize into frame object. - (vars_of_frame): Declared adjust-frame-function. - - * frame-msw.c (mswindows_update_frame_external_traits): Same - change as for frame-x.c - (mswindows_frame_size_fixed_p): Implemented the method. - - * frame-x.c (x_update_frame_external_traits): Do not call - Fset_frame_size to adjust frame, redisplay will do. - - * faces.c (update_EmacsFrame): Mark frame as slipped when default - font changes. - - * toolbar.c (compute_frame_toolbars_data): Removed obsoleted call - to change_frame_size. Redisplay will fix it later. - Removed toolbar_*_changed_in_frame specifier - change handlers. - (specifier_vars_of_toolbar): Calls to these routed to - frame_size_slipped generic handler. - - * toolbar-x.c: Removed toolbar_*_changed_in_frame device methods. - - * scrollbar-x.c: Removed scrollbar_*_changed_in_frame device - methods. - - * scrollbar.c: Removed scrollbar_*_changed_in_frame specifier - change handlers. - (specifier_vars_of_scrollbar): Calls to the above changed to - frame_size_slipped generic handler. - - * menubar-x.c (x_update_frame_menubar_internal): Do not resize - frame, just mark frame size as slipped. - - * device-x.c: Removed declaration of in_specifier_change_function. - - * EmacsFrame.c (EmacsFrameSetValues): Do not check - in_specifier_change_function. - (EmacsFrameSetValues): Simulate a call to resize callback when no - actual geometry change happened. - - * console.h (struct console_methods): Removed declarations for all - _changed_in_frame methods for toolbars and scrollbars. - Added frame_size_fixed_p method. - -1998-05-08 SL Baur - - * redisplay.c (decode_mode_spec): Guard against garbage - overwriting the stack. - -1998-05-08 Kirill M. Katsnelson - - * dired-msw.c (vars_of_dired_mswindows): Syntax fix for union - lisp object type. - - * menubar-msw.c (populate_menu_add_item): Ditto. - - * ntheap.c (sbrk): Ditto. - - * ntproc.c (create_child): Ditto. - (syms_of_ntproc): Ditto. - -1998-05-07 Andy Piper - - * glyphs-msw.c: updates to support total transparency. - (mswindows_initialize_image_instance_icon): don't resize bitmaps - for icons. - (mswindows_initialize_image_instance_mask): new function. - Use these new functions as appropriate. - - * glyphs-msw.h (mswindows_initialize_image_instance_icon): - function renamed. - - * frame-msw.c: use renamed mswindows_initialize_image_instance_icon. - - * redisplay-msw.c: MaskBlt bitmaps if we have a mask, BitBlt - otherwise. - -1998-05-07 Kirill M. Katsnelson - - * unexnt.c (read_in_bss): Removed unused variables, replaced exits - with aborts. - (map_in_heap): Ditto. - -1998-05-06 SL Baur - - * frame.c (adjust_frame_size): Don't mix integers and Lisp_Objects. - -1998-05-07 Kirill M. Katsnelson - - * print.c (write_string_to_stdio_stream): Under MS Windows, flush - stdio and stderr after output. Ouch. - -1998-05-05 Andy Piper - - * event-msw.c: comment out broken dnd stuff and don't use msw socket - support if we have cygwin select. - -1998-05-03 Kirill M. Katsnelson - - * events.h (STREAM_* defines): Defined constants for the parameter - FLAGS to create_stream_pair_cb(). - - * process.c (Fopen_network_stream_internal): Use flags from events.h - (Fopen_multicast_group_internal): Ditto. - - * process-unix.c (unix_create_process): Ditto. - - * event-unixoid.c (event_stream_unixoid_create_stream_pair): Ditto. - Changed #ifdef process type logic to catch configuretion errors - when no process type is defined. - - * event-msw.c: Implemented winsock_stream - (get_process_input_waitable): Differentiate network connections. - (emacs_mswindows_select_process): Ditto. - (emacs_mswindows_create_stream_pair): Ditto. - (emacs_mswindows_delete_stream_pair): Ditto. - - * process-nt.c: Implemented network connections. - (nt_init_process): Initialize Winsock. - - * sysdep.c (init_system_name): Ask for the right name right from - the system. - - * ntproc.c: Removed select emulation crap and dynamic Windock - loading. - - * nt.c: Removed a lot of terrible wrappers for socket functions. - - * s/windowsnt.h: Removed sys_select encapsulation. - -1998-05-05 Hrvoje Niksic - - * search.c (Fmatch_data): Synch with FSF. - -1998-05-04 Greg Klanderman - - * events.h: Add extern declarations for focus_follows_mouse and - investigate_frame_change(). - * cmdloop.c (Fcommand_loop_1): cleanup focus-follows-mouse - handling - move externs to events.h. - -1998-05-05 Andy Piper - - * glyphs-msw.c: generate an AND mask when creating an icon and really - make it an icon if that is what is required. - - * glyphs-msw.h (mswindows_create_icon_from_image): new cursor - argument. - - * frame-msw.c (mswindows_set_frame_pointer): set the frame cursor when - asked. - -1998-05-05 Michael Sperber [Mr. Preprocessor] - - * s/windowsnt.h: - * s/rtu.h: - * s/aix4.h: - * m/wicat.h: - * m/gould.h: - * m/gould-np1.h - * unexhp9k3.c: - * unexconvex.c: - * unexalpha.c: - * unexaix.c: - * regex.c: - * process-unix.c: - * mule-mcpath.c: - * msdos.c: - * lisp.h: - * gmalloc.c: - * getloadavg.c: - * broken-sun.h: - Removed references to ancient bcmp, bzero, and bcopy. - -1998-05-04 Andy Piper - - * gui.el: make gui-button-face colors apply in the mswindows - domain as well as for x. - - * objects-msw.c (mswindows_string_to_color): grok - rgb:rrrr/gggg/bbbb color formats used by xpm-button.el. - -1998-05-04 Greg Klanderman - - * window.c (Fselect_window): Add optional second argument - `norecord' to avoid recording a buffer change. - * window.h: change the EXFUN for Fselect_window. - * window.c (Fdelete_window): call Fselect_window with 2nd arg Qnil. - (Fother_window): ditto. - (temp_output_buffer_show): ditto. - (Fset_window_configuration): ditto. - (Fset_window_configuration): ditto. - * frame.c (Fselect_frame): ditto. - (Fset_frame_selected_window): ditto. - (delete_frame_internal): ditto. - * device.c (Fselect_device): ditto. - * console.c (Fselect_console): ditto. - * callint.c (Fcall_interactively): ditto. - -1998-05-05 Hrvoje Niksic - - * search.c (Fregexp_quote): Loop by characters, not by bytes. - -1998-05-05 Jan Vroonhof - - * redisplay.c (window_line_number): Guard against selected_device - = nil. - - * frame-x.c (x_init_frame_2): Revert to updating frame title. - -1998-05-05 SL Baur - - * emacs.c (shut_down_emacs): Update crash report information. - -1998-05-04 Kyle Jones - - * linuxplay.c: Initialize audio_dev to /dev/dsp at - compile time instead of at run-time. Don't initialize - mixer_fd, audio_fd and audio_vol to -1; none of them need - it, and XEmacs will crash on some architectures when - these variable are modified after being initialized. - Declare audio_dev, audio_vol, audio_fd, and mixer_fd as - static, since none of them need to be visible outside - linuxplay.c. - -1998-04-27 Hrvoje Niksic - - * eldap.c (make_ldap): New function. - (finalize_ldap): Use it. - (Fldap_open): Ditto. - - * eldap.c (struct Lisp_LDAP): Removed connection status symbol. - - * eldap.h (LDAP_LIVE_P): Removed - (CHECK_LIVE_LDAP): Adapt to changes in struct Lisp_LDAP - -1998-05-03 Hrvoje Niksic - - * lread.c: (read_escape): Restore handling of \M-a; clarify - comment. - -1998-05-04 Kyle Jones - - * realpath.c: Rename realpath() to xrealpath(). - - * fileio.c: Call xrealpath() instead of realpath(). - - * sysdep.h: Use #define to map xrealpath() calls to - realpath() on systems that have realpath(). - -1998-05-04 Martin Buchholz - - * rangetab.c: - * rangetab.h: Move #include's from rangetab.h into rangetab.c for - consistency. - * inline.c: include rangetab.h to get GCC inlines - -1998-05-03 SL Baur - - * event-stream.c (event_stream_next_event): Reverse previous patch to - slow down poll for quit. - Suggested by Kyle Jones - - * lread.c (read_escape): Turn off interpretation of "\M..." - Suggested by Olivier Galibert - - * lread.c (read_escape): add explanatory comment about why - FSF_KEYS are being turned off. - -1998-05-02 SL Baur - - * lread.c (FSF_KEYS): Remove if built with Mule. - -1998-05-01 Kirill M. Katsnelson - - * event-msw.c (ntpipe_shove_flusher): Removed. - (init_shove_stream): Flusher undeclared. - -1998-05-02 SL Baur - - * rangetab.c: `default_dumped' removed. - -1998-05-02 Hrvoje Niksic - - * events.c (Fmake_event): Initialize key data for key-press - events. - -1998-05-02 Hrvoje Niksic - - * fileio.c (close_stream_unwind): Renamed to delete_stream_unwind. - Delete the stream. - (Finsert_file_contents_internal): Delete STREAM after use. - (Fmake_temp_name): Improve randomness of generated file names. - (Fmake_temp_name): Don't initialize COUNT if in temacs. - -1998-05-02 Olivier Galibert - - * buffer.h: Put the range_table lrecrod declaration where it - belongs... - - * rangetab.h: New file - ...which is here. - - * rangetab.c: Move declarations to rangetab.h - -1998-05-01 Hrvoje Niksic - - * data.c (Fneq): Fix docstring. - (arithcompare_many): Slightly simplify. - -1998-04-29 Andy Piper - - * s/cygwin32.h: don't define BROKEN_CYGWIN anymore since we normally - link with unixoid event loop now. - -1998-05-01 Kirill M. Katsnelson - - * event-stream.c (event_stream_next_event): Disable polling for - quit while XEmacs is blocked waiting for an event. - -1998-05-01 Kirill M. Katsnelson - - * specifier.h: Corrected documentation on magic specifiers. - Documented DEPTH parameter to instantiate_method. - Renamed reveal->unlock_ghost_specifiers_protected(). - - * specifier.c: Removed the reveal mechanism and made ghost - specifiers read-only, so they are accessible as fallbacks of magic - specifier, but aren't modifiable unless C code enables so. - (specifier_equal): Compare specifier fallbacks as well. - - * scrollbar.c (init_frame_scrollbars): - (init_device_scrollbars): - (init_global_scrollbars): Renamed - reveal->unlock_ghost_specifiers_protected(). - -1998-05-01 Hrvoje Niksic - - * fileio.c (Fcar_less_than_car): Fix Flss caller. - (Fcdr_less_than_cdr): Ditto. - - * lisp.h: Fix declarations. - - * data.c: Enable many arguments versions of <, >, <=, >= and /=. - - * bytecode.c (Fbyte_code): Use arithcompare. - - * data.c (arithcompare): Make non-static. - -1998-04-30 Greg Klanderman - - * frame.c (Fselect_frame): update docstring to describe - focus-follows-mouse behavior. - -1998-05-01 Hrvoje Niksic - - * print.c (Fwrite_char): Don't touch Vprint_gensym. - (print_error_message): Don't gcpro TAIL. - (Fdisplay_error): Simplify. - -1998-04-30 Hrvoje Niksic - - * print.c (print_internal): Use long_to_string(). - - * redisplay.c (decode_mode_spec): Remove bogus calculation of the - number of digits. - - * print.c (Fprin1): Removed THE_STREAM. - (Fprinc): Ditto. - (Fprint): Ditto. - (Fdisplay_error): Canonicalize STREAM here. - (print_error_message): Don't canonicalize STREAM. - (print_error_message): Use print_internal() instead of Fprin1 and - Fprinc. - - * print.c: (Fprin1_to_string): Delete internal stream explicitly. - (Ferror_message_string): Ditto. - (Fterpri): Use write_char_internal. - -1998-04-18 Martin Buchholz - - * console-x.h: Initialize_Locale should not depend on HAVE_XIM, - esp. in the future. - - * Makefile.in.in: be more careful generating depend. - - * *.c (F*): Unfortunately, etags can only detect per-line - patterns, and so the DEFUN macro must have the lisp name and the C - name on the same line for a complete TAGS file. Make it so. - - * signal.c (init_signals_very_early): - * process.c (Fsignal_process): Order the signals in decreasing - order of standardization. Provide helpful standardization - comments. Add missing signal names. - - * unexhp9k800.c: Remove undefined roundup. - * symsinit.h: Add prototype for init_hpplay(). - -1998-04-30 Hrvoje Niksic - - * window.c (Fcenter_to_window_line): New function. - (Frecenter): Use it. - -1998-04-30 Hrvoje Niksic - - * dired.c (make_directory_hash_table): Constify. - - * scrollbar.c (Fscrollbar_page_up): Use Fcenter_to_window_line - instead of Frecenter. - (Fscrollbar_page_down): Ditto. - (Fscrollbar_to_top): Ditto. - (Fscrollbar_to_bottom): Ditto. - - * window.c (Frecenter): Removed. - -1998-04-29 Andy Piper - - * console.h: xpm_normalize is not a console method anymore. - - * event-msw.c: honour toolbar help string length. - - * glyphs-msw.c: make copyright more meaningful. implement color - symbol support for Xpm. (extract_xpm_color_symbols) new function. - - * glyphs.c (pixmap_to_lisp_data) (xpm_normalize): fucntions moved - from glyphs-x.c - - * glyphs.h: declare pixmap_to_lisp_data. - - * toolbar-msw.c: more meaningful copyright. - -1998-04-30 Hrvoje Niksic - - * macros.c (Fend_kbd_macro): New arg REMOVE-LAST. - - * gui-x.c (popup_selection_callback): Treat anonymous interactive - and compiled-function interactive callbacks as commands. - -1998-04-28 Hrvoje Niksic - - * abbrev.c (obarray_has_blank_p): Simplify. - -1998-04-27 Hrvoje Niksic - - * getloadavg.c (getloadavg): Removed some code repetition. - -1998-05-01 Kirill M. Katsnelson - - * process-nt.c: Document usage of #pragma warning. - (alloc_process_memory): Spell _ALPHA_ correctly. - -1998-04-29 SL Baur - - * Makefile.in.in: Change `progname' to `PROGNAME' for - consistency. - -1998-04-29 Kirill M. Katsnelson - - * frame.c (change_frame_size_1): Adjust frame row/columns taking - real toolbar size into account, not the theoretical one. - - * toolbar.c (set_frame_toolbar): Removed unused parameter. - Return void, not unused int. - Logic which checks whether toolbar to be recomputed moved here - from macro COMPUTE_TOOLBAR_DATA (r.i.p) - (compute_frame_toolbars_data): Removed COMPUTE_TOOLBAR_DATA. It - did not work due to a bug, and also did not check whether toolbar - size has changed. - Compute new character sizes passed to change_frame_size, do not - use the old (pre-toolbar-change) ones. - (update_frame_toolbars): Honor frame_changed and clear frame bits. - (recompute_overlaying_specifier): New helper function, called from - default toolbar specifier change handlers. - (default_toolbar_specs_changed): Use it. - (default_toolbar_size_changed_in_frame): Ditto. - (default_toolbar_border_width_changed_in_frame): Ditto. - (default_toolbar_visible_p_changed_in_frame): Ditto. - (toolbar_geometry_changed_in_window): New handler. The old one, - some_windows_value_changed, did not do the trick. - (default_toolbar_size_changed_in_window): New handler for default - toolbar. - (default_toolbar_border_width_changed_in_window): Ditto. - (default_toolbar_visible_p_changed_in_window): Ditto. - (specifier_vars_of_toolbar): Use one of the above four handlers - instead of some_windows_value_changed in toolbar specifiers. - -1998-04-29 Andy Piper - - * redisplay-msw.c (mswindows_output_string) - (mswindows_output_string): output the background pixmap if we have - one. - -1998-04-28 Michael Sperber [Mr. Preprocessor] - - * paths.h.in: Added PATH_PROGNAME and PATH_VERSION. - -1998-04-28 Michael Sperber [Mr. Preprocessor] - - * emacs.c (complex_vars_of_emacs): Added `emacs-program-name' and - `emacs-program-version'. - -1998-04-29 Kirill M. Katsnelson - - * process-nt.c: Signal support for Windows NT. - New code under subheadings "Running remote threads" and "Sending - signals". - (nt_create_process): Create new process suspended, then enable - signals in it, then resume it. - (nt_kill_child_process): Implemented - (nt_kill_process_by_pid): Ditto. - (process_type_create_nt): Registered the two above. - -1998-04-28 P. E. Jareth Hein - - * glyphs-x.c : slight cleanup and bugfix related to memory - corruption and possible leaks. Also fix a visual problem - with XPM pointers - -1998-04-28 P. E. Jareth Hein - - * glyphs-x.c (x_init_image_instance_from_eimage): Make sure - automatic pointers are null... - -1998-04-27 Greg Klanderman - - * cmdloop.c (Fcommand_loop_1): Call investigate_frame_change if - focus_follows_mouse is true. - - * event-stream.c (next_event_internal): Only call - investigate_frame_change if focus_follows_mouse is false. - - * event-stream.c (investigate_frame_change): Fix - focus_follows_mouse handling. It was the case that, with - focus_follows_mouse true, (select-frame (next-frame)) could leave - next-frame with input focus, but not window manager focus. Now - needs to be called from 2 places, conditional on the value of - focus_follows_mouse. - -1998-04-24 Kirill M. Katsnelson - - * frame.c (Fmake_frame): GC-protect new frame immediately upon - creation. - -1998-04-27 Kirill M. Katsnelson - - * frame.c (delete_frame_internal): Fixed spurious minibuffer - frames when creating minibufferless frames (reverted to 20.3 - source, change not in ChangeLog) - -1998-04-26 Oscar Figueiredo - - * eldap.h: Added CONCHECK_LDAP macro - - * eldap.c: Moved definition of most Lisp_object keywords to - general.c - (Fldap_close): Modified semantics to match those of - `Fclose_database' - (Fldap_search_internal): Do not consider a - `LDAP_SIZELIMIT_EXCEEDED' a fatal error - - * general.c: Added several keywords needed by eldap.c. Sorted - keywords alphabetically. - -1998-04-24 Hrvoje Niksic - - * eldap.c (finalize_ldap): New function; use it when declaring - LDAP lrecord type. - -1998-04-27 Kirill M. Katsnelson - - * fileio.c (Fwrite_file_contents_internal): Prefer stat() over - fstat() back for Windows, where closing a file changes its - modification time. - -1998-04-26 Amir J. Katz - - * sysdep.h: Simplified definition of strerror() - -Sun Apr 23 1998 Andy Piper - - * emacs.c: - * symsinit.h: - * glyphs-eimage.c: rename glyphs_read to glyphs_eimage. - - * glyphs.c: - * console.h: - * glyphs-x.c: - * glyphx-msw.c: make xpm_normalize and xpm_instantiate device - methods and use them appropriately. Remove redundant pixmap file - handling functions. - -Sun Apr 23 1998 Andy Piper - - * glyphs-msw.c: use XINT for lisp ints. - - * console-msw.c: remove redundant functions that break under union - type. - - * frame-msw.c: build lisp ints for functions that expect them. - - * objects-msw.c: don't LISP_HASH COLORREF's. - - * sheap.c: remove dependency on VALMASK. - -1998-04-27 SL Baur - - * debug.c (vars_of_debug): Remove `Fprovide("internal-debug")'. - -1998-04-27 Jonathan Harris - - * device-msw.c: Unconditionally use InitCommonControls() instead - of InitcommonControlsEx() - the latter is not defined in all - environments. - -1998-04-26 SL Baur - - * Makefile.in.in: Religiously use ${progname}. - - * paths.h.in: Remove reference to user-defined site-lisp location. - * debug.c (vars_of_debug): Rename feature to 'internal-debug. - -1998-04-24 Martin Buchholz - - * mule-charset.h: - * mule-charset.c: - Use ints instead of bitfields for Lisp_Charset fields. This - should work around bugs in the latest egcs snapshot, and make - XEmacs faster. Introduce dimension and chars as fields in - Lisp_Charset instead of computing them every time. The extra - space is about 1k, a reasonable price. - -1998-04-25 SL Baur - - * glyphs-x.c (xface_normalize): Add console_type parameters to - calls to `potential_pixmap_file_instantiator'. - -Sat Apr 24 1998 Andy Piper - - * event-msw.c: fix and enable signal pipe handling when using msg - select(). - -1998-04-25 Michael Sperber [Mr. Preprocessor] - - * process-unix.c (allocate_pty): Typo fix. - -1998-04-25 Olivier Galibert - - * s/irix5-0.h (PTY_OPEN): Ditto - * s/irix4-0.h (PTY_OPEN): Restore the stb variable. - -1998-04-25 Michael Sperber [Mr. Preprocessor] - - * emacs.c (complex_vars_of_emacs): Typo fixes. - - * emacs.c: Added configure-exec-prefix-directory. - - * paths.h.in: Added PATH_EXEC_PREFIX. - -1998-04-25 Olivier Galibert - - * unexelfsgi.c (unexec): Kludge for Irix 5.3 which clears the - .sbss section no matter what. Defensively remove the alignment fix - if the .sbss section type isn't modified (Irix 6.5SE). Remove some - warnings. - -1998-04-24 Martin Buchholz - - * data.c (Fnot): There has traditionally been kludgy startup lisp - code that called `null' even if `not' was more appropriate, - because `not' was defined in lisp. This is one primitive - sufficiently important that it should ALWAYS be defined. - -Sat Apr 24 1998 Andy Piper - - * Makefile.in.in: add glyphs-eimage.o to build. - - * console.h: added console methods init_image_instance_from_eimage - and locate_pixmap_file. - - * emacs.c: add initialisation for glyphs-eimage.c - - * symsinit.h: declare glyphs-eimage functions. - - * glyphs-eimage.c: New file - generalised eimage support for gif, - tiff, png and jpeg, mainly from glyphs-x.c. - - * glyphs-msw.c: added init_image_instance_from_eimage. Tidied up - file location. - - * glyphs-x.c: disable gif, tiff, png and jpeg support in this - file. Added init_image_instance_from_eimage. Tidied up file - location. - - * glyphs.h: - * glyphs.c: abstract image location. - -Fri Apr 24 19:38:19 1998 Andy Piper - - * config.h.in: support our special select - - * event-msw.c: - * toolbar-msw.c: - * console-msw.h: toolbar cleanup. - - * device-msw.c: - * emacs.c: - * frame-msw.c: - * glyphs-msw.h: - * ntplay.c: - * process-unix.c: - * select-msw.c: - * sheap.c: - * s/cygwin32.h: warning elimination. - -1998-04-24 Hrvoje Niksic - - * fns.c (Fload_average): New argument USE_FLOATS. - - * alloc.c (Fstring): New function, synched with FSF 20.3. - -Thu Apr 23 19:38:19 1998 Andy Piper - - * unexcw.c: cope with the reversed executable sections written by - binutils-2.9 ld and egcs. - -1998-04-24 Kirill M. Katsnelson - - * menubar-msw.c (populate_or_checksum_helper): Fixed to compile - with union type. - -1998-04-23 Hrvoje Niksic - - * fns.c (Fload_average): Respect errno when reporting getloadavg() - errors. - - * getloadavg.c (getloadavg): Cleaner Solaris implementation, based - on sample code by Casper Dik. - -1998-04-23 SL Baur - - * frame-x.c (x_delete_frame): remove dead code. - -1998-04-22 SL Baur - - * print.c (Falternate_debugging_output): Unconditionally define. - -1998-04-22 Hrvoje Niksic - - * eval.c: Ditto. - - * alloc.c: Ditto. - - * lread.c: Ditto. - - * print.c: Removed standalone hacks. - -1998-04-23 Kirill M. Katsnelson - - * toolbar-msw.c (mswindows_clear_toolbar): Fixed wabbit buttons. - (mswindows_output_toolbar): Gave 3D look to toolbars. Still no - pretty, needs more work. - (mswindows_move_toolbar): Renamed so because it does not deal with - redrawing exposed toolbars. - Properly position toolbars. - (mswindows_redraw_exposed_toolbars): Changed calls to the above. - (mswindows_find_toolbar_pos): Do not assert if toolbar not - found: a command can come from a menu. - (mswindows_handle_toolbar_wm_command): Quickly return nil if - toolbar not found. - -1998-04-22 Kirill M. Katsnelson - - * device-msw.c (tagINITCOMMONCONTROLSEX): Uniform declaration - between SDK and cygwin. - (mswindows_init_device): InitCommonControls -> - InitCommonControlsEx typo fix. - -Wed Apr 22 12:59:35 1998 Andy Piper - - * glyphs-msw.c (EImage2DIBitmap): count the number of bytes correctly. - -Wed Apr 22 12:59:35 1998 Andy Piper - - * config.h.in: support for HAVE_MSG_SELECT. - - * console-msw.h: add support for four toolbars. - - * device-msw.c: init common controls. - - * event-msw.c: if HAVE_MSG_SELECT is defined use unixoid event - stream tye callbacks and select() on events rather than MWFMO. - Added event handling for tooltip messages. If you have this - special select then all process support works under cygwin. - - * frame-msw.c: add support for four toolbars. - - * redisplay-msw.c: update toolbars when an area is exposed. - - * signal.c: _WIN32 -> WINDOWSNT. - - * event-stream.c: enable unixoid initialization if we have it. - - * event-unixoid.c: allow us to turn off the signal pipe. - - * toolbar-msw.c: major overhaul. Enable support for all four - toolbars, fix display and sizing problems, enable tooltip support, - be more optimal about deleting toolbars. - - * toolbar.h: reinstate 0 toolbar border width for msw. - - * s/cygwin32.h: minor define updates. - -1998-04-22 Hrvoje Niksic - - * print.c (Falternate_debugging_output): Define only if - DEBUG_XEMACS. - -1998-04-21 Hrvoje Niksic - - * fileio.c (Fmake_temp_name): Updated docstring. - -1998-04-21 Hrvoje Niksic - - * print.c (print_prepare): New argument FRAME_KLUDGE. - (print_prepare): If writing to a frame, return a resizing buffer - stream. - (print_finish): Flush the stream. - (Fprin1): Adjust calls to print_prepare() and print_finish(). - (Fprinc): Ditto. - (Fprint): Ditto. - (print_internal): Optimize printing of characters. - - * print.c (RESET_PRINT_GENSYM): New macro. - (print_prepare): Use it. - (print_finish): Ditto. - (Fwrite_char): Ditto. - (Fprin1_to_string): Ditto. - -1998-04-22 SL Baur - - * config.h.in: add FOR_MSW variable. - From Itay Ben-Yaacov - -1998-04-20 Kirill M. Katsnelson - - * alloc.c (report_pure_usage): Remove ifdef WINDOWSNT around - "Don't panic, I will restart make". - -1998-04-19 Kirill M. Katsnelson - - * process.c (vars_of_process): Declared lisp variable - windowed-process-io. - - * procimpl.h: Externally declared it. - - * process-nt.c (nt_create_process): Changed to honor the above - variable, and to utilize SHGetFileInfo to determine file type. - -1998-04-21 Martin Buchholz - - * mule-ccl.c: Fix compiler warnings. I hate compiler warnings. - The code is clearer anyways without macros that goto. - -1998-04-22 SL Baur - - * glyphs.h: Add prototypes for signal_image_error and - signal_image_error_2. - Suggested by Hrvoje Niksic - -1998-04-18 Michael Sperber [Mr. Preprocessor] - - * fileio.c: Changed `directory-sep-char' to `path-separator', - following a change in GNU Emacs. - -1998-04-21 Oscar Figueiredo - - * eldap.c: As suggested by Hrvoje Niksic - (Fldap_search_internal): Loop and GCPRO cleanup - (print_ldap): Removed text translation - -1998-04-19 Oscar Figueiredo - - * eldap.c: (print_ldap): Ignore escapeflag - (Fldap_search_internal): Added unwind protection to appropriately - free the LDAP temporary structures in case of interruption. Added - a QUIT to the result fetching loop. - -1998-04-19 SL Baur - - * emacs.c (TopLevel): New variables: Vinfodock_major_version, - Vinfodock_minor_version, Vinfodock_build_version. - (vars_of_emacs): Initialize them. - - * config.h.in: Add InfoDock version numbers. - - * device-x.c (have_xemacs_resources_in_xrdb): distinguish whether - we're running as InfoDock or XEmacs. - -1998-04-18 SL Baur - - * glyphs-x.c: Remove definition of Q_color_symbols. - - * glyphs.h: Declare Q_color_symbols and evaluate_xpm_color_symbols. - -1998-04-17 Jonathan Harris - - * console-msw.h: - Added "commctrl.h" and "X11/xpm.h" includes to support toolbars - and XPM. - - * glyphs-msw.c: - Removed (!NILP (Vmswindows_bitmap_file_path)) check in - locate_pixmap_file() so that lookups of absolute paths don't fail - if this is unset. - Added new mswindows_xpm_normalize(); - - * glyphs.h: - * glyphs.c: - * glyphs-x.c: - Moved generic XPM support out of glyphs-x.c into glyphs.c. - Functions moved: - signal_image_error, signal_image_error_2, - check_valid_xpm_color_symbols, evaluate_xpm_color_symbols, - xpm_possible_dest_types. - xpm_normalize and xpm_instantiate in glyphs.c just call the - appropriate x_ or mswindows_ funtion in glyphs-x.c or - glyphs-msw.c. - - * toolbar-msw.c: - Don't assert on empty toolbar. - - * toolbar.c: - * toolbar.h: - Adjusted mswindows default toolbar height/widths so redisplay is - correct. - -1998-04-18 Hrvoje Niksic - - * tooltalk.c (tt_message_arg_ival_string): Ditto. - - * redisplay.c (window_line_number): Ditto. - (decode_mode_spec): Ditto. - - * glyphs.c (print_image_instance): Ditto. - - * doprnt.c (emacs_doprnt_1): Ditto. - - * data.c (Fnumber_to_string): Use long_to_string(). - - * lisp.h: Declare long_to_string(). - - * print.c (Fprin1_to_string): Do the Vprint_gensym_alist stunt. - - * emacs.c (main_1): Don't create print stream. - - * print.c: Removed print_stream implementation. - (print_prepare): Don't create a print_stream. - (long_to_string): New function, from GNU Wget. - (print_internal): Use it. - (output_string): alloca() copies only for strings smaller than - 65536 bytes; else, inhibit gc. - -1998-04-18 Hrvoje Niksic - - * config.h.in: Check for DLERROR. - - * sysdll.c: Cosmetic changes. - -1998-04-18 Hrvoje Niksic - - * sysdll.c (dll_error): It's `dlerror', not `dl_error'. - -1998-04-17 Kirill M. Katsnelson - - * specifier.c (prune_specifiers): Fix for Vall_specifiers - corruption. - - * specifier.h: Fixed GC_* macros to utilize GC_EQ, as suggested by - Steve. - -1998-04-17 Hrvoje Niksic - - * dll.c (Fdll_open): Simplify interface. - - * sysdll.c: Allocate BUF dynamically. - - * cmds.c (internal_self_insert): Removed `no-self-insert' hack. - -Fri Apr 17 12:59:35 1998 Andy Piper - - * event-msw.c: don't use LocalAlloc()/LocalFree(). With unix - processes use a filestream for output. This makes subprocess - support work under cygwin. - -1998-04-17 Michael Sperber [Mr. Preprocessor] - - * fileio.c (vars_of_fileio): Resurreced directory-sep-char to be - DIRECTORY_SEP instead of hardwired "/". - -1998-04-16 Michael Sperber [Mr. Preprocessor] - - * fileio.c (file_name_as_directory): Now returns "./" (or NT - equivalent) for "". - -1998-04-09 Oscar Figueiredo - - * eldap.c: Fully rewritten introducing a new opaque LDAP Lisp - data type. - - * eldap.h: Ditto - -1998-04-17 Olivier Galibert - - * fileio.c (vars_of_fileio): Finish directory_sep_char removal. - -1998-04-14 Michael Sperber [Mr. Preprocessor] - - * emacs.c (main_1): Added option --debug-paths and analogous - variable. - -1998-04-15 Hrvoje Niksic - - * frame-msw.c (Vmswindows_frame_being_created): Don't staticpro. - - * console-msw.h, event-msw.c, frame-msw.c: Renamed - mswindows_frame_being_created to Vmswindows_frame_being_created. - -1998-04-12 Kirill M. Katsnelson - - * event-msw.c (emacs_mswindows_quit_p): Do not check for quit - character in modal loop. - - * fileio.c: Removed Vdirectory_sep_char variable. - - * lisp.h: Removed extern decl for the above. - -1998-04-16 SL Baur - - * indent.c (vertical_motion_1): set_marker_restricted takes - Lisp_Objects. - -1998-04-17 Hrvoje Niksic - - * md5.c (Fmd5): Correctly rename argument. - - * print.c (Fprin1_to_string): Remove useless variable. - -1998-04-13 Greg Klanderman - - * indent.c (vertical_motion_1): new helper function to share - common code between Fvertical_motion and Fvertical_motion_pixels. - Properly handle the WINDOW argument as the doc string indicates it - should. Update docstrings to be more clear and concise. - (Fvertical_motion): use vertical_motion_1. - (Fvertical_motion_pixels): use vertical_motion_1. - -1998-04-15 Kirill M. Katsnelson - - * specifier.h: Introduced magic specifiers. Please read comments - in specifier.h. - - * specifier.c: Reworked many functions to support magic - specifiers. - - * scrollbar.c (specifier_vars_of_scrollbar): Made magic specifiers - Vscrollbar_width and Vscrollbar_height. - (init_frame_scrollbars): Enabled critical lisp code operate on - ghost specifiers. - (init_device_scrollbars): Ditto. - (init_global_scrollbars): Ditto. - - * scrollbar-msw.c (Fmswindows_init_scrollbar_metrics): Scrollbar - init function, called from init-scrollbars-from-resuorce in - lisp/scrollbar.c - (syms_of_scrollbar_mswindows): DEFSUBR it. - - * emacs.c (main_1): Called syms_of_scrollbar_mswindows() - - * symsinit.h: Declared syms_of_scrollbar_mswindows() - -Thu Apr 16 12:59:35 1998 Andy Piper - - * frame-msw.c: - * console-msw.h: add toolbars to frame parameters. - - * emacs.c: call console_type_create_mswindows_toolbar - - * event-msw.c: call toolbar handling code in main event loop. - - * glyphs-msw.c (mswindows_create_icon_from_image) - (mswindows_resize_dibitmap_instance): new functions. Remove mask - stuff from various others. - - * redisplay-msw.c: - * menubar-msw.c: warning elimination. - - * toolbar-msw.c: new file. Reasonable implementation of toolbars - for mswindows. Some features are not complete. - - * toolbar.c: enable toolbar parameters for mswindows. - - * toolbar.h: choose slightly different toolbar defaults for - mswindows. - -1998-04-16 Hrvoje Niksic - - * lisp.h (CHECK_IMPURE): Use it. - - * data.c (pure_write_error): Accept an argument. - - * emacs.c (vars_of_emacs): New variable `internal-error-checking'; - initialize it. - -1998-04-16 Hrvoje Niksic - - * fileio.c (Fmake_temp_name): Avoid random(); simplify. - -1998-04-13 Michael Sperber [Mr. Preprocessor] - - * emacs.c (complex_vars_of_emacs): Changed configure-exec-path to - configure-exec-directory. - (decode_path): Doesn't call file-name-as-directory no more as - empty components would lead to evil behavior. - -1998-04-16 Hrvoje Niksic - - * extents.c (decode_extent): Unify the error message. - -1998-04-17 Hrvoje Niksic - - * md5.c (Fmd5): Simplify; use only input and encoding streams. - (Fmd5): Separate coding guesswork into md5_coding_system(). - (Fmd5): Don't close the stream; deleting it is enough. - -1998-04-16 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Prefer fstat() over - stat. - -1998-04-15 Martin Buchholz - - * fns.c (Fsubseq): Make (subseq nil 0 0) return nil, not #*. - -1998-04-16 SL Baur - - * device-x.c (get_device_from_display): Use "infodock" as the - fallback name when running as InfoDock. - -1998-04-14 Greg Klanderman - - * device-x.c (compute_x_app_name): New function needed to compute - application name to use now that XtOpenDisplay is decomposed into - XOpenDisplay and XtDisplayInitialize. - (x_init_device): use it. - -1998-04-06 Greg Klanderman - - * device-x.c (have_xemacs_resources_in_xrdb): adhere to coding - standards and avoid opening display twice by breaking - XtOpenDisplay into XOpenDisplay and XtDisplayInitialize. - (x_init_device): Ditto. - -1998-04-15 Olivier Galibert - - * s/aix3-2-5.h: Ditto. - - * s/aix4-1.h: Ditto. - - * s/aix4-2.h: Ditto. - - * s/bsd386.h: Ditto. - - * s/bsdos2-1.h: Ditto. - - * s/dgux.h: Ditto. - - * s/esix.h: Ditto. - - * s/esix5r4.h: Ditto. - - * s/hpux8.h: Ditto. - - * s/hpux9-shr.h: Ditto. - - * s/hpux9-x11r4.h: Ditto. - - * s/hpux9.h: Ditto. - - * s/hpux9shxr4.h: Ditto. - - * s/isc3-0.h: Ditto. - - * s/isc4-0.h: Ditto. - - * s/ptx.h: Ditto. - - * s/sco4.h: Ditto. - - * s/sco5.h: Ditto. - - * s/usg5-3.h: Ditto. - - * s/usg5-4-2.h: Ditto. - - * s/usg5-4.h: Kill a bunch of now autodetected defines. - -1998-04-05 Greg Klanderman - - * window.c (Fwindow_displayed_pixel_height): rename more - appropriately as window-text-pixel-height. - (syms_of_window): Update the DEFSUBR. - (Fwindow_text_pixel_width): New function for completeness. - (Fwindow_text_pixel_edges): New function. - (syms_of_window): DEFSUBR 2 new functions. - -1998-04-13 Greg Klanderman - - * redisplay.c (redisplay_window): When echo area is active, and we - swap in the echo area buffer, restore the minibuffer's pointm and - startp when we restore the minibuffer to the window. This avoids - having the minibuffer point randomly change when it is active but - not selected and a message is shown. - -1998-04-16 Hrvoje Niksic - - * md5.c: replaced RSA reference code with GNU textutils implementation. - -1998-04-14 Martin Buchholz - - * signal.c (init_signals_very_early): Make `nohup xemacs &' work. - Wrap #ifdefs around uses of SIGQUIT and SIGILL. - -1998-04-12 Kirill M. Katsnelson - - * objects-msw.c (mswindows_initialize_font_instance): Fixed assert - abuse; proper cleanup on GDI error. - -1998-04-14 Kirill M. Katsnelson - - * console-msw.h: Declared get_nt_process_handle() and - mswindows_bump_queue(). - Removed declarations for mswindows_enqueue_dispatch_event() and - mswindows_enqueue_magic_event(). - - * event-msw.c (emacs_mswindows_create_stream_pair): Casts on - handle types and get_osfhandle() return type. From Andy Piper. - (emacs_mswindows_select_process): Get Win32 process handle - directly from process lrecord. - (get_process_handle): Removed function. - (emacs_mswindows_handle_magic_event): Removed handling of - XM_BUMPQUEUE magic event. - (mswindows_wnd_proc): Removed handling of WM_EXITMENULOOP message, - which called a do-nothing handler in menubar-msw.c - (mswindows_wnd_proc, WM_EXITSIZEMOVE): Queue an empty event - instead of magic event, via mswindows_bump_queue(). - (mswindows_wnd_proc, WM_CLOSE): Ditto. - (mswindows_need_event): Call mswindows_bump_queue() upon process - termination, in case process pipe does not get closed along. - Do not close process handle. - (mswindows_bump_queue): Added function. - (mswindows_enqueue_dispatch_event): Made static. - (ntpipe_slurp_*): Revamped the slurp thread implementation so the - stream does not expect the thread to terminate when stream is closed. - (ntpipe_slurp_reader): Fixed an attempt to read zero bytes from - the pipe. - - * event-stream.c (event_stream_deal_with_async_timeout): - Conditionalized timer-based polling for finished processes on - HAVE_UNIX_PROCESSES. - - * menubar-msw.c (mswindows_handle_wm_command): Queued proper bump - queue event. - (mswindows_handle_wm_exitmenuloop): Removed function. - - * menubar-msw.h: Removed unused function prototype. - - * process-nt.c (get_nt_process_handle): Added function. - - * signal.c (init_poll_for_sigchld): Conditionalized on - HAVE_UNIX_PROCESSES. - -1998-04-13 Kirill M. Katsnelson - - * frame-msw.c: Implemented the following methods: - mswindows_get_mouse_position() - mswindows_set_mouse_position() - mswindows_frame_totally_visible_p() - -1998-04-11 Michael Sperber [Mr. Preprocessor] - - * emacs.c: Renamed inhibit-package-init to inhibit-early-packages - to better reflect its semantics. - Renamed inhibit-update-autoloads to inhibit-package-autoloads. - (complex_vars_of_emacs): Added site-directory and lisp-directory. - -no-packages -> no-early-packages. - - * Makefile.in.in: Reflected reinstatement of paths.h.in. - - * paths.h.in: Reinstated. - - * paths.h.in.in: Removed. - - * config.h.in: Moved configure path and directory options from - paths.h.in.in. - -1998-04-11 Kirill M. Katsnelson - - * event-msw.c (emacs_mswindows_quit_p): don't recurse. - -1998-04-10 Kirill M. Katsnelson - - * callproc.c (init_callproc): Correctly initialize - `shell-file-name' for WINDOWSNT - - * emacs.c (main_1): Properly called new functions (see symsinit.h - entry for which). - - * event-msw.c (struct ntpipe_slurp_stream): - (slurp_thread): - (make_ntpipe_input_stream): - (get_ntpipe_input_stream_waitable): - (get_ntpipe_input_stream_param): - (ntpipe_slurp_reader): - (ntpipe_slurp_closer): - (init_slurp_stream): Win32 pipe input stream implementation. - (struct ntpipe_shove_stream): - (shove_thread): - (make_ntpipe_output_stream): - (get_ntpipe_output_stream_param): - (ntpipe_shove_writer): - (ntpipe_shove_was_blocked_p): - (ntpipe_shove_flusher): - (ntpipe_shove_closer): - (init_shove_stream): Win32 pipe output stream implementation. - (mswindows_enqueue_process_event): Dispatch helper. - (find_waitable_handle): - (add_waitable_handle): - (remove_waitable_handle): New three, waitable handles handling. - (mswindows_need_event_in_modal_loop): Simplified. - (mswindows_need_event): Simplified. - (mswindows_need_event): Generate process events on process output; - kick status_notify when a process ends. - (mswindows_find_console): Simplified. - (emacs_mswindows_event_pending_p): Adjusted parameters to - mswindows_need_event(). - (emacs_mswindows_next_event): Ditto. - (get_process_input_waitable): - (get_process_handle): Process select/unselect helpers. - (emacs_mswindows_select_process): Implemented. - (emacs_mswindows_unselect_process): Implemented. - (emacs_mswindows_quit_p): Call mswindows_drain_windows_queue() - directly so do not even try do dequeue process events. Saved a - byte and a tick. - (emacs_mswindows_create_stream_pair): Implemented. - (emacs_mswindows_delete_stream_pair): Implemented. - (vars_of_event_mswindows): Registered the above two. - (lstream_type_create_mswindows_selectable): Function called from - emacs.c to create two pipe lstream types. - - * ntproc.c (sys_select): Disgustful brain fart this file is. - - * process-nt.c: New file: Asynchronous subprocess implemenation - for Win32. - - * process.h: Declare Fprocess_id(). - - * signal.c (init_signals_very_early): Conditionalize possibly - nonexistent signals. - - * symsinit.h: Declared: - lstream_type_create_mswindows_selectable () - process_type_create_nt () - vars_of_process_nt () - - * s/windowsnt.h: Defined HAVE_WIN32_PROCESSES. - Removed fake SIGTRAP, SIGPIPE and SIGCHLD. - -1998-04-10 Martin Buchholz - - * fns.c (Fnthcdr): - Most times through the loop will get a cons, so optimize for that. - - * bytecode.c (Fbyte_code): Remove '91 vintage compiler bug workaround. - Add NATNUMP check for Bnth bytecode. - Bnth: Optimize case of n > length (list). - QUITs not necessary since even if list is circular, n will count - down to 0. - Bnthcdr: inline the code for nthcdr (we have a bytecode for it, - after all) - Bcdr, Bcar: Use tail recursion. - -1998-04-10 Hrvoje Niksic - - * redisplay.c (redisplay_window): Don't lose with negative - scroll_step. - -1998-04-09 Hrvoje Niksic - - * fileio.c (Fmake_temp_name): Don't use `+' in generated file - names. - (Fmake_temp_name): Randomize the initial values of counters. - -1998-04-07 Michael Sperber [Mr. Preprocessor] - - * Makefile.in.in: paths.h.in is now generated from paths.h.in.in. - - * emacs.c (decode_path): Removed parsing of "::" into nil component. - -1998-04-09 Martin Buchholz - - * lstream.c (make_filedesc_stream_1): Fix another Martin blooper. - -1998-04-07 SL Baur - - * emacs.c (Fdump_emacs): Delete superfluous open comment. - -1998-04-06 SL Baur - - * emacs.c (Fdump_emacs): Move call to disable_free_hook back to - Fdump_emacs where it belongs. - -1998-04-07 Kirill M. Katsnelson - - * nt.c (sys_mkdir): Added the second unused parameter, after UNIX - version. Suggested by Martin. - -1998-04-07 Kirill M. Katsnelson - - * event-msw.c (mswindows_wnd_proc): Fix member access macro names. - - * frame-msw.c (mswindows_frame_property): - (mswindows_internal_frame_property_p): - (mswindows_frame_properties): Implemented for the 'left and 'top - properties. - (console_type_create_frame_mswindows): Regsitered the above. - (mswindows_set_title_from_bufbyte): Update title only if it has - really changed. This avoids a bit of flashing. - - * console-msw.h (FRAME_MSWINDOWS_TITLE_CHECKSUM): To update title - smoother. - (MSWINDOWS_FRAME_*(f)): Were MSWINDOWS_FRAME_*(f). Eeek! - -1998-04-06 Kazuyuki IENAGA - - * unexfreebsd.c: introduce FreeBSD port's patch to avoid - FreeBSD-current warns "Absurd new brk addr". - -1998-04-06 Colin Rafferty - - * glyphs-x.c (struct gif_error_struct): Made the err_str point to - a CONST char* instead of non-const. - (tiff_memory_write): Add fake return statement to shut up warnings. - -1998-04-06 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Correctly handle - special files larger than 32K. - -1998-04-06 Hrvoje Niksic - - * fileio.c (Fmake_temp_name): Don't call mktemp(). - -1998-04-06 Andreas Jaeger - - * unexelf.c: include first. - -1998-04-04 Martin Buchholz - - * sysdep.c: Add #include for AIXHFT as suggested - on c.e.x. - - * nt.c: - * ntproc.c: - Change "config.h" to . Add dire warnings to code since - config.h is not included first. - - * powerpc.h: Avoid redefinition warning on START_FILES. - - * window.c: Rename Vminibuf_scroll_window to Vminibuffer_scroll_window. - * hpplay.c: Rename play_gain to hp_play_gain in accordance with - coding standards. - - * frame-x.c (x_lower_frame): - (x_raise_frame_1): Clarify code. Save a nanosecond if frame not - visible. - - * fileio.c (Fmake_temp_name): Use static CONST suffix; save a - nanosecond. - -1998-04-05 Amir J. Katz - - * sysproc.h: Added #include before - otherwise callproc.c does not compile on SunOS 4.1.4 with gcc 2.8.1 - - * sysdep.h: strerror() does not return CONST in gcc 2.8.1 - -1998-04-05 Hrvoje Niksic - - * redisplay.c (generate_fstring_runes): Grok specifiers and - symbols indirecting to specifiers. - -1998-04-06 Olivier Galibert - - * events.c (print_event): XINT() may return a long. - - * insdel.c (make_gap): Thou shan't cast EMACS_INT_MAX to int. - (buffer_insert_string_1): ditto. - - * regex.c (print_partial_compiled_pattern): Neither EMACS_INTs nor - ptrdiff_t are portably printable as an int. - - * redisplay.c (window_line_number): Don't assume that an EMACS_INT - in an int. - - * alloc.c (report_pure_usage): Don't assume that a size_t is - displayable as an int. - -1998-04-06 SL Baur - - * process-unix.c: Fix typo in #ifdef. - From Hrvoje Niksic - -1998-04-06 Olivier Galibert - - * unexelfsgi.c (unexec): Don't treat the sbss section as bss if it - isn't one. Needed for irix 6.5. - -1998-04-05 Martin Buchholz - - * sysdep.h: Two prototypes that weren't properly size_t'ed - -1998-04-04 Martin Buchholz - - * ralloc.c: mallopt <==> malloc.h. - -1998-04-04 Martin Buchholz - - * emacs.c: #include , not "paths.h" - This is a standard bug. It manifests if you configure in the - source tree, then configure elsewhere with --srcdir. - Remove misleading PATH_EXEC comment; PATH_PACKAGEPATH is also used. - -1998-04-04 Olivier Galibert - - * s/386bsd.h: Removed obsolete define. - -1998-04-04 Olivier Galibert - - * s/386-ix.h: Removed useless define. - - * sysdep.c (insque): Removed. Not used anywhere in the code. - -1998-04-04 Olivier Galibert - - * process-unix.c (unix_kill_child_process): Use TIOCSIGSEND or - TIOCSIGNAL as needed. - - * s/usg5-4.h: Remove kludgy TIOCSIGSEND #define which breaks on - irix 6.5. - -1998-03-28 Hrvoje Niksic - - * insdel.c (emchar_string_displayed_columns): Simplify for - non-Mule case. - - * events.c (WRONG_EVENT_TYPE_FOR_PROPERTY): Issue nicer output. - -1998-04-01 Martin Buchholz - - * sysdir.h (sys_mkdir): - * sysfile.h (sys_read): - (sys_write): - (sys_chmod): - (sys_creat): - - * sysdep.c (sys_read_1): - (sys_read): - (sys_write_1): - (sys_write): - (sys_mkdir): - (sys_readlink): - (sys_chmod): - (sys_creat): - - * nt.c (sys_read): - (sys_chmod): - (sys_creat): - (sys_write): Change types of sys_* in accordance with published - standards. Use size_t and mode_t instead of unsigned int and int. - -1998-04-03 Martin Buchholz - - * config.h.in (enum_field): - * lisp-union.h: - * extents.h: - * redisplay.c (add_margin_runes): - Prefer enums for use as bitfields in preference to unsigned int, - but allow the possibility to suppress it if a compiler disallows - it or emits annoying warnings. Currently only __SUNPRO_C cc -Xc - used unsigned ints. - - * event-stream.c: Fixup DEFVAR for - Vcomposed_character_default_binding; Real bug! - * event-msw.c: Rename mswindows_button2* to mswindows_mouse_button* - * emacs.c: Rename suppress_early_backtrace to - suppress_early_error_handler_backtrace - * objects-x.c: Rename handle_nonfull_spec_fonts to - x_handle_non_fully_specified_fonts - * lread.c: Rename puke_on_fsf_keys to - fail-on-bucky-bit-character-escapes - * lread.c: - * doc.c: Rename Vdoc_file_name to Vinternal_doc_file_name - * fileio.c: - * bufslots.h: - * buffer.c: Rename save_length to saved_size - * alloc.c: Rename pureptr to pure_bytes_used - * abbrev.c: Rename last_abbrev_point to last_abbrev_location - * lisp.h: - DEFVAR_* are supposed to be named following a standard convention. - -1998-04-03 Martin Buchholz - - * callint.c: - * ralloc.c: - * data.c: - * eldap.c: - * extents.c: - * frame-msw.c: - * frame-x.c: - * general.c: - * process.c: - * xselect.c: - Rationalize defsymbol handling. - defsymbols are supposed to have equivalent C and Lisp names, for - consistency. At least one real bug (end-glyph-layout) fixed. - Move multiply defsymbol'ed stuff into general.c. - -1998-04-03 Michael Sperber [Mr. Preprocessor] - - * m/ibmrs6000.inp: Removed; obsoleted by configure.in changes. - -1998-04-03 Martin Buchholz - - * console-tty.c (Fset_console_tty_input_coding_system): - (Fset_console_tty_output_coding_system): - Input/Output and encoding/decoding were reversed. - -1998-04-02 SL Baur - - * m/powerpc.h: Remove LD_SWITCH_MACHINE for Linux. - -1998-04-02 Greg Klanderman - - * window.c (set_window_pixsize): Move up call to - check_min_window_sizes. - - * indent.c (vmotion_1): renamed from vmotion() and added - additional argument to optionally return the pixel motion. - (vpix_motion): Helper for vmotion_1. - (vmotion): Wrapper - just call vmotion_1() with the right args. - (Fvertical_motion_pixels): New function. - (syms_of_indent): DEFSUBR it. - -1998-04-02 Martin Buchholz - - * xselect.c: - * event-Xt.c: - * emacs.c: - Remove last vestiges of #ifdef EPOCH code. It had no chance of - working anyways. In honour of seeing Marc Andreesen in person for - the first time today. - -1998-04-01 Martin Buchholz - - * extents.h: - * lisp-union.h: - Don't use enums as bitfields - only unsigned ints. - Fixes: warning: nonportable bit-field type - - * eval.c (call_with_suspended_errors): More volatilizing to - appease Sunpro cc. - - * mem-limits.h: - * ralloc.c: Remove #undef NULL; they're not even used! - - * process-unix.c (unix_send_process): send_process is a method, so - we can't include volatile in the prototype. We make the argument - non-volatile, make a volatile copy, and then use that instead. - - * frame-x.c (x_delete_frame): The `frame' variable is initialized - but not actually used. - - * Makefile.in.in (xselect.o): The last line of b34-pre2's - src/Makefile.in.in contains a dependency that should have been - patched away. - (mostlyclean): Remove the removal of depend.* - no such files - exist anymore - - * make-src-depend: include a dependency on only one of - lisp-union.h or lisp-disunion.h. - -1998-04-01 Martin Buchholz - - * specifier.c (specifier_instance_from_inst_list): A nanosecond - saved is a nanosecond earned. - -1998-03-31 Greg Klanderman - - * redisplay.c (update_line_start_cache): Fix bug involving - invisible text in which the line_start_cache gets hosed. - -Sun Mar 29 1998 Andy Piper - - * console-msw.h: define FRAME_MSWINDOWS_CDC. - - * frame-msw.c: (mswindows_set_frame_icon) new function. Works but - no masks as yet. - - * glyphs-msw.c: GNUize the code. Fix 24bpp display and make the - default. Add managment of icons. - - * glyphs-msw.h: add icon attributes. - - * redisplay-msw.c: (mswindows_output_pixmap) remove unused cursor - code. - - * objects-msw.c: eliminate char subscript warning. - -1998-04-01 SL Baur - - * sysdll.c (dll_close): fix typo. - Suggested by Marcus Thiessel - - -1998-03-28 Kyle Jones - - * device.c (Fset_device_class): Recompute cached - specifiers everywhere if device class is changed. - Set various redisplay flags so that the device's - various frames are redisplayed. - -1998-03-31 SL Baur - - * lrecord.h (DECLARE_NONRECORD): Remove redundant paren. - Suggested by Martin Buchholz - -1998-04-01 Kirill M. Katsnelson - - * gui.c (gui_item_display_flush_left): Fix suffix length. - -1998-04-01 Kirill M. Katsnelson - - * s/windowsnt.h: Defined SIZEOF_LONG_LONG and SIZEOF_VOID_P - - * dired-msw.c: Included - - * config.h.in (VOID_P_BITS): Fixed so that uses SIZEOF_VOID_P - -1998-03-31 SL Baur - - * glyphs.c (image_instantiate_cache_result): Correct order of - parameters to Fputhash. - Suggested by Kirill M. Katsnelson - -1998-03-30 Martin Buchholz - - * redisplay.c (create_right_glyph_block): glyph_type should really - be glyph_layout. - -1998-03-29 Martin Buchholz - - * sysfile.h: Move all encapsulations from lisp.h/emacsfns.h into - sysfile.h. Users of the functionality herein will have to - #include sysfile.h. - Check all .o files for missing #includes. - * config.h.in: - Discovered that config.h.in was missing ENCAPSULATE_CLOSEDIR, as a - result of fixing the above. - - * gui.c (gui_item_add_keyval_pair): We should not use the idiom - error ("%S", lisp_object) in C code. - I converted the code to use signal_simple_error_2 instead. - (signal_too_long_error): Ditto. - - * glyphs.c (image_instantiate_cache_result): Use XC[AD]R instead - of Fc[ad]r. This is always called with valid conses, and in fact, - already assumed it. - - * font-lock.c (find_context): Use context_none with context - instead of ccontext_none. - - * fns.c (Flength): The CONSP and NILP code can be combined. - Change the name of the arg to SEQUENCE from OBJ. - (Fnthcdr): CHECK_NATNUM instead of CHECK_INT. Optimize out Fcdr calls. - (Felt): Change argument from seq to sequence to match docstring. - -1998-03-28 Martin Buchholz - - * fns.c (string_putprop): - (string_getprop): Make method functions static. - - * window.c (find_window_by_pixel_pos): Warning suppression. - - * imgproc.c (splitbox): Warning suppression. - - * redisplay-x.c (x_output_eol_cursor): Remove redundant XSETWINDOW. - - * glyphs-x.c (signal_image_error): - (signal_image_error_2): - (convert_EImage_to_XImage): Make functions static. - - * editfns.c (Fbuffer_size): Rename the `F' function to - Fbuffer_size in accordance with coding standards. - - * dll.c (Fdll_open): Fix up data conversion. - Provide auxiliary function maybe_call_library_function(). - - * device-x.c (get_x_display): make function static. - - * data.c (Fcar): Should generate listp, not consp error. - (Fcdr): Should generate listp, not consp error. - -1998-03-27 Martin Buchholz - - * console-tty.c (free_tty_console_struct): - Replace con->console_data with CONSOLE_type_DATA (con) - - * *.[ch]: C++ compilability of xemacs, on Linux and Solaris. - - * casetab.c (Fcase_table_p): Optimize. - - * eval.c: - * bytecode.c: - Rename Fcondition_case_3 to condition_case_3 - it's not a DEFUN. - - * buffer.h: - Remove all *BUFFER_OR_STRING* macros - unused. - (memind_to_bytind): Merge two versions of function by moving - #ifdef ERROR_CHECK_BUFPOS into the function body. - (*_DATA_ALLOCA*): get types correct. rewrite for clarity. - - * balloon_help.c (balloon_help_destroy): rearrange order of - functions, and remove prototype from header file. - - * alloc.c (deadbeef_memory): Rewrite. Use size_t for clarity. - Don't bother with the left-over bytes, since in practice we will - always get called with a size multiple of 4. - (Fmake_list): CHECK_NATNUM instead of CHECK_INT - (vector[4567]): Currently unused; ifdef out. - (make_pure_float): make function static. - (garbage_collect_1): Optimize. - -1998-03-23 Martin Buchholz - - * marker.c (print_marker): Fix compiler warning, real bug! - - * device.h (MARK_DEVICE_FRAMES_FACES_CHANGED): - * frame.h (MARK_FRAME_FACES_CHANGED): - (MARK_FRAME_TOOLBARS_CHANGED): - (MARK_FRAME_SIZE_CHANGED): - (MARK_FRAME_CHANGED): - (MARK_FRAME_WINDOWS_CHANGED): - (MARK_FRAME_WINDOWS_STRUCTURE_CHANGED): - Fix multiple evaluation of macro arguments. - Macros are a fact of life. Callers have to use temp variables to - avoid multiple evaluation of arguments. - - * data.c (Ftrue_list_p): New function, with obvious meaning. - This is terminology from Cltl2. - Also define a corresponding macro TRUE_LIST_P. - - * device-x.c (validify_resource_component): Optimize. Rename. - Use the standard technique of using a precomputed table of valid chars. - - (x_get_resource_prefix): - (Fx_get_resource): - (Fx_get_resource_prefix): - Avoid fixed buffer sizes. Use a char_dynarr. - Run validify_resource_component on all computed components. - - * lisp.h: Define a char_dynarr type. - -1998-03-22 Martin Buchholz - - * fns.c (Fcopy_alist): Optimize. - - * alloc.c (acons): New function. Now used in the C code. - Definition in cl.el is commented out. Add docstring. - Use acons in functions which create alists. - * lisp/cl.el (acons): Add docstring. Really otta be a macro, tho. - - * buffer.c (Fbuffer_memory_usage): - * window.c (Fwindow_memory_usage): - Clean up horrible consing code using new acons function. - Fix incorrect value reported for gap-overhead. - - * fns.c (Fmember): - (Fold_member): - (Fmemq): - (Fold_memq): - (memq_no_quit): - (Fassoc): - (Fold_assoc): - (Fassq): - (Fold_assq): - (assq_no_quit): - (Frassoc): - (Fold_rassoc): - (Frassq): - (Fold_rassq): - (rassq_no_quit): - (Fdelete): - (Fold_delete): - (Fdelq): - (Fold_delq): - (delq_no_quit): - (delq_no_quit_and_free_cons): - (Fremassoc): - (Fremassq): - (remassq_no_quit): - (Fremrassoc): - (Fremrassq): - (remrassq_no_quit): - (Fnreverse): - (Freverse): - (Fnthcdr): - Optimize. - Replace calls to Fcar, Fcdr, Fsetcar with XCAR and XCDR. - Simplify logic. - Many of these functions wouldn't QUIT if called on cyclic lists. - e.g. try (progn (setq x '(nil)) (setcdr x x) (reverse x)) - One benchmark of delq showed it to be 3 times faster. - - * emacs.c: - * database.c: - Cleanup of database functions. - Make the get_subtype and get_type methods return Lisp_Objects, - instead of C strings. No more need for both dbm_type and dbm_lisp_type. - Rewrite the doc strings to be consistent with XEmacs tradition. - Replace old `dbm' names with `database'. - Rename struct database to struct Lisp_Database. - Rename DEFUN arguments to `database', when applicable. - - * buffer.c: - * chartab.c: - * console.c: - * data.c: - * database.c: - * device.c: - * elhash.c: - * eval.c: - * event-stream.c: - * extents.c: - * faces.c: - * frame.c: - * glyphs.c: - * keymap.c: - * lstream.c: - * mule-charset.c: - * mule-coding.c: - * objects.c: - * opaque.c: - * process.c: - * rangetab.c: - * specifier.c: - * symbols.c: - * tooltalk.c: - * window.c: - Place DEFINE_LRECORD_* after definition of static object methods, to - avoid redundant declarations. - - * console.c: - * console.h: - * device.c: - * device.h: - * extents.c: - * extents.h: - * frame.c: - * frame.h: - * glyphs.c: - * glyphs.h: - * lisp.h: - * lstream.c: - * lstream.h: - * signal.c: - * specifier.c: - * specifier.h: - Eliminate MAC_* macros. - The MAC_ macros use non-standard comiler extenstions which cause - gcc to generate bad code on Sparc/Solaris. Attractive though the - idea of using those compiler extensions is, they are just not - robust enough to use in the real world. So we eliminate them. - We put up with some sub-optimalities, like macros with multiple - evaluation. Such is life with C. The MAC_ macros were pretty - darn ugly anyways. We CAN use inline functions, since the advent - of C++ means that compilers must support those anyways. - -1998-03-21 Martin Buchholz - - * alloc.c (list*): Optimize recursion levels. - - * alloc.c: Add debugger support via enum dbg_constants. - * gdbinit: Complete rewrite. - * gdbinit.union: Remove - * gdbinit.pre-4.14: Remove - * dbxrc: Complete rewrite. - * man/xemacs-faq.texi: - Proper robust debugger support for gdb and Sun's dbx. - Support all combinations of Kylish DEFINEs. - Work out of the box with no user customizations. - See the updated faq for details. - - * emacsfns.h: Remove. Move declarations to lisp.h - * dynarr.h: Remove. Move declarations to lisp.h - * lisp.h. - Optimize header file handling to improve compile time over a network. - Introduce EXFUN macro for external declaration to correspond to DEFUN. - Include header files only when necessary, i.e. not from lisp.h: - - unistd.h, limits.h, fnctl.h, blocktype.h, dynarr.h, emacsfns.h - - - * lisp.h: - * lisp-union.h: - * lisp-disunion.h: - Rewrite low level object frobbing. - Make it safe to use XSETOBJ on uninitialized Lisp_Objects. - (markbit might have been set otherwise) - Move XPRNTRVAL->XPNTR computation out of lisp-*union.h, since it - is union-type-independent. - - * EmacsFrame.c: - * alloc.c: - * chartab.c: - * console.c: - * dialog-x.c: - * doc.c: - * elhash.c: - * eval.c: - * event-Xt.c: - * event-stream.c: - * event-unixoid.c: - * extents.c: - * faces.c: - * file-coding.c: - * frame.c: - * glyphs.c: - * insdel.c: - * keymap.c: - * lstream.c: - * marker.c: - * menubar-x.c: - * mule-coding.c: - * opaque.c: - * ralloc.c: - * rangetab.c: - * redisplay-msw.c: - * redisplay-output.c: - * redisplay-tty.c: - * redisplay-x.c: - * redisplay.c: - * scrollbar-x.c: - * scrollbar.c: - * specifier.c: - * symbols.c: - * toolbar-x.c: - * toolbar.c: - * window.c: - As a result of the above lisp*.h changes, we can now safely remove - initializations of Lisp_Objects before calling XSETOBJ on them. - This was only being done half the time, anyways. - - * Makefile.in.in (depend): New target. calls make-src-depend. - * depend: New file. Generated by make-src-depend - * make-src-depend: New file. generates up-to-date dependencies. - Makefile dependencies are now automagically maintained, and - CORRECT. lisp.h and friends are now included in the dependencies, - since this complies with the principle of least astonishment. - - * symbols.c (symbol_is_constant): Optimize. - -1998-03-30 SL Baur - - * frame.c (vars_of_frame): Default frame name should be InfoDock - for InfoDock. - -1998-03-29 SL Baur - - * emacs.c (voodoo_free_hook): ELF libraries built with newer - versions of GCC do horrible things in dumped binaries after exit() - is called. - (Fkill_emacs): Use it. - -1998-03-28 SL Baur - - * s/linux.h: For simplicity, do not use standard linking because - it is deadly with new GCC. - -Sat Mar 28 10:16:29 1998 Andy Piper - - * Makefile.in.in: fix fastdump target - - * console-msw.h: add memory dc to frame. - - * frame-msw.c: manage memory dc on frame creation/deleteion - - * frame.h: mess with toolbar macros so that xemacs doesn't die - in redisplay with a triple build. - - * g;yphs-msw.c: GNUize the code. Fix 24bpp display and make the - default. - - * glyphs-msw.h: remove memory dc from image attributes. - - * redisplay-msw.c: fix redisplay to use new frame memory dc. - - * sheap.c: bump initial sheap yet again to allow byyte - recompilation. - - * unexcw.c: fix section parsing for multiple idata and rdata - sections. - -1998-03-27 SL Baur - - * emacs.c: Enabled free-hook.c code if - LOSING_GCC_DESTRUCTOR_FREE_BUG is defined. - -1998-03-28 Kyle Jones - - * Fixed display bug where changes to builtin glyphs like - Vcontrol_arrow_glyph would not be propagated - immediately to the display. - - * device.h: Added glyphs_changed field to device - struct. Created MARK_DEVICE_GLYPHS_CHANGED macro. - - * frame.h: Added glyphs_changed field to frame - struct. Created MARK_FRAME_GLYPHS_CHANGED macro. - - * redisplay.h: Declared glyph_changed and - glyph_changed_set variables, mimicking clip_changed - and clip_changed_set. New macro MARK_GLYPHS_CHANGED. - - * redisplay.c: Defined glyph_changed and - glyph_changed_set variables, mimicking - clip_changed and clip_changed_set. - - (redisplay_window): Reset the window's glyph cache is - f->glyphs_changed is non-zero. Call regenerate_window - if f->glyphs_changed is non-zero. - - (redisplay_frame): Clear f->glyphs_changed after - successful redisplay of all windows on frame. - - (redisplay_device): Redisplay frame if f->glyphs_changed - is non-zero. Clear d->glyphs_changed after successful - redisplay of all frames on device - - (redisplay_without_hooks): Redisplay devices if - glyphs_changed is non-zero. Redisplay an individual - device if d->glyphs_changed is non-zero. Clear - glyphs_changed after successful redisplay of all - devices. - - (redisplay_glyphs_changed): Dropped use of - MARK_CLIP_CHANGED. Call MARK_FRAME_GLYPHS_CHANGED for - all affected frames. For locales that are not device - related, mark all frames. - - * redisplay-output.c (compare_display_blocks): - Output the whole display block if f->glyphs_changed is - non-nil. - -1998-03-27 Kyle Jones - - * callproc.c (Fcall_process_internal): In the case where - fd_error and fd1 are the same don't close that - descriptor twice. - -1998-03-27 SL Baur - - * frame-x.c (x_update_frame_external_traits): Need a Lisp_Object - frame as well as a struct frame. - -1998-03-27 Michael Sperber [Mr. Preprocessor] - - * emacs.c (main_1): Reinstated PATH searching for invocation data. - -1998-03-26 Kirill M. Katsnelson - - * menubar.c (Fmenu_find_real_submenu): See the entry for gui.h. - - * menubar-msw.c (populate_menu_add_item): Used GCPRO_GUI_ITEM - macro to aviod warnings, in 2 places. - (populate_or_checksum_helper): Ditto - (populate_or_checksum_helper): Added placeholder for menu right - flash customization. - - * gui.h (GCPRO_GUI_ITEM): Code which warning-free GC protects a - GUI_ITEM structure moved into this macro from menubar.c - - * frame-x.c (x_update_frame_external_traits): Moved part of the - former update_EmacsFrame() here. - (console_type_create_frame_x): Declared the above method. - - * frame-msw.c (mswindows_set_frame_properties): Do not try to - resize the frame if called from Fmake_frame the first time - (potential race condition). - (mswindows_init_frame_1): Fixed support for popup frames. - (mswindows_delete_frame): Fixed memory leak. - (mswindows_get_frame_parent): Implemented. - (mswindows_update_frame_external_traits): Moved part of the former - update_EmacsFrame() here. - (console_type_create_frame_mswindows): Declare get_frame_parent - and update_frame_external_traits methods. - - * faces.c (update_EmacsFrame): Converted into a device method - `update_frame_external_traits'. - - * event-msw.c (mswindows_wnd_proc, WM_SIZE): Rewrote to avoid - relying on an assumption on when Windows calls this handler. - (mswindows_find_frame): Return the frame being created if the - windows does not yet have associated frame object - (mswindows_find_frame): Casted long to Lisp_Object properly. - - * device.c (window_system_pixelated_geometry): Changed to call the - device_implementation_flags device method. - - * device-msw.c (mswindows_device_implementation_flags): - Implemented. - (console_type_create_device_mswindows): Declared the above. - - * console.h (struct console_methods): Added - device_implementation_flags_method and - update_frame_external_traits_method. - Defined flags retuned by device_implementation_flags_method. - - * console-msw.h (struct mswindows_frame): Added charheight and - charwidth fields. - Added macros for referring to these two, Rvalue. - Moved Windows-specific macros from frame.h here. - (typedef struct XEMACS_RECT_WH): Added. - Declared global variables. - -1998-03-19 Kirill M. Katsnelson - - * console-msw.h: Added prototypes for - mswindows_protect_modal_loop() and - mswindows_unmodalize_signal_maybe(). - - * scrollbar-msw.c (mswindows_update_scrollbar_instance_status): - Removed redundant call to set_frame_size method. - - * frame.c (Fframe_property): For a window system with pixel-based - geometry, convert passed char-based metrics to pixels. - (Fframe_properties): Ditto. - (Fset_frame_height): Ditto. - (Fset_frame_width): Ditto. - (Fset_frame_size): Ditto. - (frame_conversion_internal): Added a parameter, controlling - whether the function uses real char metrics or 1 when geometry is - pixel-based. - Allow NULL for output int* params. - (pixel_to_char_size): frame_conversion_internal() is called with - indication to fake font size to 1. - (char_to_pixel_size): Ditto. - (round_size_to_char): Ditto. - (pixel_to_real_char_size): - (char_to_real_pixel_size): - (round_size_to_real_char): New three counterparts of the above - metioned functions, which always use real character metrics. - (change_frame_size_1): Use real character metrics when computing - minibuffer height. - - * frame.h: Prototypes for pixel_to_real_char_size(), - char_to_real_pixel_size(), round_size_to_real_char(). - - * frame-msw.c (mswindows_init_frame_1): Rewritten to support - system-default new window width and height. - (mswindows_init_frame_2): Commented out, unused. - (mswindows_after_init_frame): Added frame method. - (mswindows_set_frame_size): Reworked to support pixel base - geometry. - (mswindows_set_frame_position): Cahnged to use SetWindowPos. - (mswindows_lower_frame): Ditto. - (mswindows_set_frame_properties): Fixed to perform correct - calculation, and to support pixel geometry. - (console_type_create_frame_mswindows): init_frame_2 removed, - after_init_frame added. - - * faces.c (default_face_height_and_width_1): Added. - (update_EmacsFrame): Changed method of notifying mswindwows frame, - so modeline border gets redrawn. - - * faces.h: Prototype for default_face_height_and_width_1(). - - * event-msw.c (mswindows_wnd_proc, WM_SIZE): Redisplay after - maximize/restore window. - (mswindows_wnd_proc, WM_WINDOWPOSCHANGING): Do not round size to - char if window is maximized. - Use real char metrics for rounding. - Call DefWindowProc to process WM_GETMINMAXINFO - (mswindows_set_chord_timer): Changed chord timeout from 1/2 to 1/3 - system double click time - - * device.c (domain_device_type): New function. - (window_system_pixelated_geometry): New function. - (Fdomain_device_type): New function, lisp interface to - domain_device_type(). - (syms_of_device): DEFSUBRed the above. - - * device.h: Ptorotypes for domain_device_type() and - window_system_pixelated_geometry(). - - * menubar-msw.c (mswindows_update_frame_menubars): Call - update_frame_menubar_maybe always. - -1998-03-27 SL Baur - - * s/hpux11.h: - * s/hpux11-shr.h: New files. - From Marcus Thiessel - - * Makefile.in.in: temporarily comment -lmcheck support. - Suggested by Marcus Thiessel - -1998-03-26 Michael Sperber [Mr. Preprocessor] - - * emacs.c (vars_of_emacs): Fixed bug: Now respects configure - setting of inhibit-site-lisp. - (main_1): inhibit-site-lisp is now exclusively - configure-initialized. - -1998-03-27 Hrvoje Niksic - - * events.c (WRONG_EVENT_TYPE_FOR_PROPERTY): Don't feed - error_with_frob() with LispObjects. - -1998-03-26 Kirill M. Katsnelson - - * redisplay-msw.c (mswindows_output_cursor): Added parameters for - character under cursor, and a flag indicating whether the cursir - is over an image. Draw bar cursor always over an image glyph. - Callers are changed accross the file. - Honor the value of window::text_cursor_visible_p. - (mswindows_output_pixmap): Cursor drawing code #if0ed. - (mswindows_output_display_block): Call to output cursor after - drawind an image. - -1998-03-27 P. E. Jareth Hein - - * glyphs-x.c: - * imgproc.c: - * imgproc.h: - * glyphs-x.h: Added in a colormap variable in the X specific image - struct to handle IMAGE_POINTER images which must be allocated in the - default colormap of the screen. Also reformated the code to follow - coding standards. - - * glyphs.h: - * glyphs.c: - * glyphs-x.c: added image-conversion-error type - - * objects-x.c (allocate_nearest_color): Corrected a minor bug involving - setting the values into XColor. - -1998-03-25 P. E. Jareth Hein - - * free-hook.c (check_realloc): Handle the degerate case of realloc with - a NULL value acting the same as malloc. - -1998-03-24 Kyle Jones - - * redisplay-x.c (x_output_eol_cursor): Use x_clear_region - instead of XClearArea to erase the cursor so that background - pixmaps are handled properly. New fourth parameter findex - added so that it can be passed to x_clear_region. - -1998-03-25 Kirill M. Katsnelson - - * process.c (Fprocess_send_eof): Close output stream before - deleting stream pair. - (deactivate_process): Ditto, both input and output streams. - - * event-unixoid.c (event_stream_unixoid_delete_stream_pair): Do - not close passed lstreams. - -1998-03-24 Kirill M. Katsnelson - - * fileio.c (Ffile_readable_p): GC protect fix, MS Windows specific. - -Mon Mar 23 22:14:12 1998 Andy Piper - - * configure.in: compile in glyphs-msw.o when compiling fopr - mswindows. - -Mon Mar 23 22:14:12 1998 Andy Piper - - * msw-glyphs.el: add support for xpm and bmp. change - eval-and-compile to progn. - -Mon Mar 23 22:14:12 1998 Andy Piper - - * Makefile.in.in: fastdump - new target for dumping bypassing - bytecompilation, DOC. Add dependencies for glyphs-msw.o. Move - imgproc.o to object list. - - * glyphs-msw.h: - * glyphs-msw.c: new files adding support for xpm and bmp and - EImages. - - * redisply-msw.c: add support for outputing color pixmaps. - - * console-msw.h: add bitspixel field to mswindows frame. - - * device-msw.c: initialise bitspixel field in mswindows frame. - - * glyphs-x.c (xpm_instantiate): call mswindows_xpm_instantiate if - the device type is mswindows. - - * emacs.c: call glyphs-msw.c init functions if compiling with - mswindows. - - * symsinit.h: add prototypes for glyphs-msw.c functions. - - * sheap.c: make includes src-dir compliant. - - * events.c: remove cygwin ^H <-> erase hack. - - * s/cygwin32.h: remove NOMULTIPLEJOBS defn. - -1998-03-24 P. E. Jareth Hein - - * glyphs-x.c (my_jpeg_output_message): Added new function to redirect - any error/warning messages from the jpeg library to XEmacs. Also - get rid of an unneeded temp variable in the tiff code. - -1998-03-14 Hrvoje Niksic - - * insdel.c (fixup_internal_substring): Protect asserts with #ifdef - ERROR_CHECK_BUFPOS. - - * minibuf.c (scmp_1): c1 and c2 are Emchar, not Bufbyte. - (Ftry_completion): Fixed typo. - - * dired.c (file_name_completion): Removed `readfunc', a remnant of - dead VMS code. - -1998-03-13 Hrvoje Niksic - - * dired.c (Fdirectory_files): Simplify logic. - - * symbols.c (reject_constant_symbols): Allow setting a keyword's - function slot. - -1998-03-23 Hrvoje Niksic - - * lread.c (readevalloop): Don't specbind Qstandard_input to - READCHARFUN. - -1998-03-09 Hrvoje Niksic - - * lread.c (read_atom): Ditto. - - * symbols.c (reject_constant_symbols): Do the keyword stunts only - if the symbol is in Vobarray. - - * symbols.c (reject_constant_symbols): Signal error when - attempting to assign a value to a keyword, unless the value is the - keyword itself. - - * symbols.c (Fintern): Initialize symbol's ->obarray to t only - when OBARRAY is Vobarray. - -1998-03-21 Hrvoje Niksic - - * events.c (Fmake_event): Allow creation of misc-user-events. - -1998-03-23 Michael Sperber [Mr. Preprocessor] - - * config.h.in, emacs.c: Changed allow-site-lisp to - inhibit-site-lisp. Made -no-autoloads set inhibit-site-lisp. - -1998-03-22 Michael Sperber [Mr. Preprocessor] - - * : The Big Path Searching Overhaul. - - * symsinit.h: Added declaration for complex_vars_of_emacs in - emacs.c. - - * paths.h.in: Adjusted the comments to reality as dictated by - configure. - - * filelock.c (complex_vars_of_filelock): Added support for lock - directories passed in from configure. - - * emacs.c (complex_vars_of_emacs): Added all relevant installation - paths passed from configure. They all have the prefix "configure-" now. - - * config.h.in: Added HAVE_SITE_LISP configuration option. - - * callproc.c (init_callproc): Ripped out all the bogus path setup. - - * Makefile.in.in: Updated all calls of "temacs -l" with absolute - file names because auf the more minimalistic load-path setup in - lread.c. Also set EMACSBOOTSTRAPLOADPATH on calling temacs rather - than EMACSLOADPATH because EMACSLOADPATH is now more persistent than - before. - - * lread.c (init_lread): Ripped out bogus load-path setup. - -1998-03-21 Kyle Jones - - * frame.h: Move the check for an initialize_frame_toolbars - method into FRAME_RAW_REAL_TOOLBAR_VISIBLE to avoid getting - clunked by toolbar-less builds. - -1998-03-20 SL Baur - - * m/powerpc.h (LD_SWITCH_MACHINE): Fix path to ppc.ldscript. - -1998-03-16 Hrvoje Niksic - - * redisplay.c (window_line_number_buf): Made it larger. - - * opaque.c (print_opaque): Ditto. - - * lstream.c (print_lstream): Avoid `%p'. - - * keymap.c (ensure_meta_prefix_char_keymapp): Use - error_with_frob(). - - * input-method-xlib.c (EmacsXtCvtStringToXIMStyles): Allocate buf - dynamically. - - * event-Xt.c (describe_event_window): Allocate buf dynamically. - - * doc.c (Fsubstitute_command_keys): Warn of sprintf(). - - * device-x.c (x_init_device): Allocate path dynamically. - (x_init_device): Allocate buf1 and buf2 dynamically. - -1998-03-14 Hrvoje Niksic - - * ExternalShell.c (GetGeometry): Use a larger buffer for - sprintf(). - -1998-03-19 Kirill M. Katsnelson - - * redisplay.c (point_would_be_visible): Fix - window::line_cache_validation_override reference counter. - (start_with_line_at_pixpos): Ditto. - -1998-03-20 Olivier Galibert - - * insdel.c (bytecount_to_charcount): Use 'L' suffix on long - constants probably too large for an int. - -1998-03-18 Hrvoje Niksic - - * lread.c (read_atom_0): Signal Qend_of_file if readcharfun - returned -1. - (read_escape): Ditto. - (FSF_LOSSAGE): Ditto. - -1998-03-20 SL Baur - - * emacs.c: path-separator (and parse-colon-path) moved from Lisp - into C because we need it for early initialization. - - * Makefile.in.in (libmcheck): Add. - - * config.h.in: Add HAVE_LIBMCHECK and HAVE_MCHECK_H. - - * hash.c (grow_hashtable): Fix tests to compare against - Qnull_pointer since this function may be called before any symbols - or the Lisp engine is initialized. - - * emacs.c (main_1): Restore usage of free-hook.c. - - * free-hook.c (check_realloc): Change aborts to printfs. - (check_free): Ditto. - -1998-03-18 SL Baur - - * emacs.c (Fkill_emacs): Use LIST_LOOP_DELETING because our - control variable is being modified underneath us. - - Avoid calling delete_console_internal on stream consoles. - - * console-tty.c (free_tty_console_struct): NULL out pointers after - xfree'ing. - - * console-stream.c (allocate_stream_console_struct): Fix memory - leak -- if the stream_console struct is already allocated, don't - reallocate it. - (free_stream_console_struct): Don't leave dangling freed pointer - around. - - * redisplay-output.c (redisplay_redraw_cursor): Fully bracket. - -1998-03-17 SL Baur - - * frame.c (delete_frame_internal): Correct check. - - * imgproc.c: Include . - -1998-03-13 P. E. Jareth Hein - - * glyphs-x.c: fix for upside-down TIFFs. - -1998-03-14 Kirill M. Katsnelson - - * fileio.c (Finsert_file_contents_internal): Removed all DOS_NT - specific code; rely on FILE_CODING streams instead. - (Fwrite_region_internal): Ditto. - (decide_buffer_type): Function removed. - (buf_decide_buffer_type): Function removed. - (Many places): References to DOS_NT replaced with WINDOWSNT. MSDOS- - specific code removed. - - * lread.c (Fload_internal): Removed ugly DOS style re-opening a - file in text mode. '\r' is perfectly handled in readevallop(). - - * redisplay.c (decode_mode_spec): Made %t decode to "T" unconditionally. - - * s/windowsnt.h (FILE_CODING): Define always. - -1998-03-15 Kirill M. Katsnelson - - * s/windowsnt.h: Added prototypes for generally used functions - implemented in nt.c - - * fileio.c (Ffile_readable_p): Conditionalized declared never used - variables. - (Fexpand_file_name): Ditto. - (check_executable): Ditto. - - * lread.c (parse_integer): Eliminated a warning resulted from - applying unary minus to unsigned int. - -1998-03-15 Oscar Figueiredo - - * eldap.c: (Fldap_search_internal): Print error information from - errno when connection fails - -1998-03-16 Hrvoje Niksic - - * lread.c: New macro, to avoid exposing an lstream to Lisp error - handlers. - (reader_nextchar): Use it. - (read1): Ditto. - -1998-03-15 Kyle Jones - - * cmds.c (Fforward_char): Dropped support for - signal-error-on-buffer-boundary. Added details to - doc string. - - (Fbackward_char): Dropped support for - signal-error-on-buffer-boundary by way of change to - Fforward_char. Added details to doc string. - - Definition of signal-error-on-buffer-boundary moved to - lisp/simple.el. - - * window.c (Fscroll_up): Dropped support for - signal-error-on-buffer-boundary. Added details to - doc string. - - (Fscroll_down): Dropped support for - signal-error-on-buffer-boundary. Added details to doc - string. - -1998-03-15 Kyle Jones - - * redisplay-tty.c (tty_clear_frame): Record that the - real location of teh cursor has been moved to 0,0. - Failure to do this makes the display code believe the - cursor is in a place where it is not. - -1998-03-15 Kyle Jones - - * console.h: Added set_final_cursor_coords method to console - struct. - - * console-tty.h: Added final_cursor_x and final_cursor_y - slots to console struct. Added CONSOLE_TTY_FINAL_CURSOR - macros to access them. - - * redisplay.c (create_text_block): No longer - turn off the cursor if computing a block when - cursor_in_echo_area is 0 and the echo area is - inactive. Needed so that the cursor will not be - frozen in the minibuffer when cursor_in_echo_area - is non-zero. - - * redisplay-output.c (redisplay_move_cursor): Don't - bail if we're moving the cursor in a selected - minibuffer window. Needed so that simple cursor - optimization can be done in the minibuffer even when - cursor_in_echo_area is non-zero. - - (redraw_cursor_in_window): Set final cursor coordinates - as a special case for cursor_in_echo_area != 0, since - the buffer switching between minibuffer and echo area - buffer seems to confuse the normal cursor positiong - code otherwise. Set final cursor coordinates in the - general case before calling output_display_line. - - * redisplay-tty.c: New function tty_set_final_cursor_coords. - - (tty_output_end): Set logical cursor position to the final - cursor position as specified in CONSOLE_TTY_CURSOR_{X,Y}, - and then go to it. - - (tty_redisplay_shutdown): Changed code to use - tty_set_final_cursor_coords() to go to the bottom - left of the screen instead of using cmgoto() - - (console_type_create_redisplay_tty): Declare that tty - consoles have the set_final_cursor_coords method. - -1998-03-13 Hrvoje Niksic - - * emacs.c (main_1): Avoid snprintf(); allocate the buffer - dynamically. - -1998-03-13 P. E. Jareth Hein - - * glyphs-x.c (png_instantiate): Added in override support - for png backgrounds. - -1998-03-13 P. E. Jareth Hein - - * glyphs-x.c (png_instantiate): Fixed a bug that was causing - overruns when attempting to display transparent pngs - -1998-03-13 P. E. Jareth Hein - - * glyphs-x.c (png_instantiate): Fix brainfart in error handling code. - -1998-03-13 SL Baur - - * emacs.c (main_1): Guard call to snprintf. - - * config.h.in: Add HAVE_SNPRINTF. - -1998-03-13 Kirill M. Katsnelson - - * event-stream.c (init_event_stream): Initialize mswindows event - loop in stream mode if no other window systems available. Thanks - to Darryl Okahata. - -1998-03-04 Kirill M. Katsnelson - - * alloc.c (garbage_collect_1): Removed #ifndef WINDOWSNT around - mark_profiling_info(). - -1998-03-11 SL Baur - - * console-tty.c (Fset_console_tty_coding_system): Guard against - terminal-coding-system being left unitialized by a locale. - From Kazuyuki IENAGA - -1998-03-11 P. E. Jareth Hein - - * config.h.in: Added in new feature check HAVE_VSNPRINT to check - for safe ways to deal with vsprintf and friends. - - * glyphs-x.c (gif_instantiate): Changed gif support to call external - library Giflib 3.1. Altered GIF/JPEG/PNG formats to use new EImage - format for dealing with images to better support color handling, and - facilitate the change to a device-neutral implementation. Added TIFF - support. - - * Makefile.in.in: Removed all gif related files - - * emacs.c (main_1): Removed reference to init_gif_err - * symsinit.h: ditto - - * dgif_lib.c: Removed from the source distribution - * gif_err.c: ditto - * gif_lib.h: ditto - * gifalloc.c: ditto - -Mon Mar 09 13:00:55 1998 Andy Piper - - * file-coding.c: warning elimination - - * ntplay.c: new file. basic implementation of sound support. - - * redisplay-msw.c (mswindows_update_dc): cachel bug is gone so we - don't need this code under cygwin. - - * sheap.c: need large heap slop for byte compiling with three - display types. - - * sound.c: eliminate warnings. enable sound under mswindows. - - * s/cygwin32.h: miscellaneous updates for sound support. - -1998-03-09 SL Baur - - * config.h.in: Add BITMAPDIR. - - * glyphs-x.c (locate_pixmap_file): Assume BITMAPDIR is a - colon-separated path. - - * emacs.c (main_1): Initialize dll support with the path the - binary. - (make_arg_list_1): Ditto. - - * sysdll.h: Add legalese. - * sysdll.c: Ditto. - - * sysdll.c: sysdll.h needs to be included with double quotes not - angle brackets. - Use RTLD_GLOBAL as an open flag if it exists. - -1998-03-09 Martin Buchholz > - - * eldap.c (Fldap_search_internal): call garbage_collect_1 instead - of Fgarbage_collect. The two are identical except the latter - generates some `fresh' garbage :) - -1998-03-09 SL Baur - - * keymap.c: Add symbols for mouse-4 and mouse-5. - (define_key_check_and_coerce_keysym): Mouse-4, Mouse-5 keysym support. - (syms_of_keymap): Ditto. - -1998-01-26 Hrvoje Niksic - - * marker.c (print_marker): Print marker's lheader.uid. - (Fbuffer_has_markers_at): New function, synched with FSFmacs 20.2. - (Fbuffer_has_markers_at): Disabled by default. - -1998-01-25 Hrvoje Niksic - - * sound.c (Fplay_sound_file): Place the result of continuable - error back to FILE. - -1998-03-09 SL Baur - - * emacs.c, config.h.in: New DLL support. - * sysdll.h, sysdll.c: New files. - * dll.c: renamed from dlopen.c, use interface defined in sysdll.c. - From William Perry - - * eldap.h: Fix copyright. - * eldap.c: Ditto. - -1998-03-08 SL Baur - - * Makefile.in.in: Add dependencies for process-unix.o. - -1998-03-08 Kyle Jones - - * glyphs-x.c (write_lisp_string_to_temp_file): - Don't explicitly initialize conversion_out_dynarr, because - doing so may cause it to be put into read-only space - and modifying it later would make XEmacs crash. - -1998-03-07 Kyle Jones - - * events.h: Add do_backspace_mapping parameter to - function prototype of character_to_event. - - * events.c: Add fifth parameter to character_to_event to - control the backspace mapping. In character_to_event map most - characters that match tty-erase-char to the backspace keysym, - but only if do_backspace_mapping paramter is non-zero. - - (Fcharacter_to_event): Tell character_to_event() to DO - backspace mapping. - - * event-stream.c: - (maybe_read_quit_event): Tell character_to_event() to DO - backspace mapping. - - (maybe_kbd_translate): Tell character_to_event() to DO backspace - mapping. - - (lookup_command_event): Tell character_to_event() to DO backspace - mapping. - - * event-unixoid.c: - (read_event_from_tty_or_stream_desc): Tell character_to_event() - to DO backspace mapping. - - * keymap.c: - (get_keyelt): Tell character_to_event() to NOT DO backspace - mapping. - - (define_key_parser): Tell character_to_event() to NOT DO backspace - mapping. - - (Fsingle_key_description): Tell character_to_event() to DO - backspace mapping. - -1998-03-04 Kirill M. Katsnelson - - * alloc.c (Fpurecopy): Do not mark symbols through - Vpure_uninterned_symbol_table twice: hash (OBJ, nil) instead of - (OBJ, OBJ). - -1998-03-07 SL Baur - - * emacs.c (shut_down_emacs): Disable forced auto-save in a crash. - It causes more problems than it solves. - -1998-03-02 Greg Klanderman - - * window.c (Fwindow_displayed_pixel_height) New function. - (Fenlarge_window_pixels): New function. - (Fshrink_window_pixels): New function. - (window_displayed_pixel_height): New, helper for - Fwindow_displayed_pixel_height. - (change_window_height): Add `inpixels' argument. - (syms_of_window): 3 new DEFSUBR's. - -Thu Mar 05 12:01:35 1998 Andy Piper - - * redisplay-msw.c (mswindows_output_cursor): separate getting - cachel index from retrieving cachel to work around apparent bug in - gcc. - -1998-03-06 Kyle Jones - - * events.c (character_to_event): The tty_erase_char test - doesn't do anything because it's in the wrong place. - Moved it to where it can take effect. - - * dired.c (Fdirectory_files): Initialize GCPRO'ed variable. - - * events.c (character_to_event): Never map '(control - foo) to QKbackspace. Only map ASCII 8 to QKbackspace; - don't map any other key. - -1998-03-05 Kyle Jones - - * src/redisplay-output.c (redisplay_move_cursor): Bail if - cursor_in_echo_area is non-zero and we're fiddling - with the cursor in a minibuffer window, since that is a - special case that is handled elsewhere and this function - need not handle it. Return 1 so the caller will assume we - succeeded. - -Wed Mar 04 08:55:12 1998 Andy Piper - - * device.c (init_global_resources): compile in based on window - system not just x. - - * console.c (select_console_1): add mswindows console type. - -1998-03-04 Kyle Jones - - * redisplay-output.c (redisplay_redraw_cursor): Redraw - the cursor in the minibuffer window if cursor_in_echo_area - is non-zero. - -Wed Mar 04 08:55:12 1998 Andy Piper - - * emacs.c (main_1): predicate display_use to mswindows only if x - is not already selected. - - * event-msw.c: comment out non-code for HAVE_TOOLBAR case. don't - compile debug_process_finalisation if x is compiled in. - - * event-stream.c (init_event_stream): don't make X and mswindows - mutually exclusive. Select msw event loop if started that way, - X/tty event loop otherwise. - - * frame.h: protect toolbar #defines from assuming ints are in - toolbar_data. This happens if you have two display types compiled - in and one supports toolbars and the other doesn't. - - * s/cygwin32.h: warning elimination. - -1998-03-03 SL Baur - - * editfns.c (Ftemp_directory): New function. - From Glynn Clements - - * editfns.c (Ftemp_directory): Use build_ext_string. - -1998-03-02 Martin Buchholz > - - * symsinit.h: add prototype for syms_of_dlopen - -1998-03-02 Kyle Jones - - * window.c (save_window_save): save value of - default_toolbar_height slot. - - (Fset_window_configuration): restore value of - default_toolbar_height slot. - -Fri Feb 20 21:22:34 1998 Darryl Okahata - - * "Fast" dired-in-C enhancements for Windows 95/NT: - - * ntproc.c: - * device-msw.c: - Moved definition of `Vwin32_downcase_file_names' from ntproc.c - to device-msw.c, and renamed it to - `Vmswindows_downcase_file_names'. It doesn't really belong - here, but I didn't want to create a new file, just for this one - variable. This fixes a bug in `expand-file-name' that caused - all returned filenames to be lowercased (this was supposed to be - conditional upon Vmswindows_downcase_file_names, but wasn't, as - it was never initialized due to obsolescence of ntproc.c). This - variable is also used by the dired-in-C enhancements. - - Also moved and renamed `Vwin32_get_true_file_attributes' to - `Vmswindows_get_true_file_attributes'. This affects stat() in - nt.c, and so it really does need to be initialized. - - However, there's still one more variable in ntproc.c that still - needs to be moved/renamed, `Vwin32_pipe_read_delay', but I - didn't touch this, as this is a subprocess issue. - - * dired-msw.c: New file for dired-in-C enhancements for - Windows 96/NT. - - * emacs.c: Initialization calls for dired-msw.c. - - * nt.c (convert_time): make into public function (dired-in-C - functions use it). - -1998-02-28 Kirill M. Katsnelson - - * sysdep.h: Prototypes for the above 2 functions - - * sysdep.c (get_pty_max_bytes): Moved here from process.c - (get_eof_char): Ditto - - * symsinit.h: Prototypes for initialization functions called from - emacs.c: process_type_create_mswindows, process_type_create_unix, - vars_of_process_mswindows, vars_of_process_unix. - - * procimpl.h: New file. Includes prototypes and other stuff shared - by process.c and implementation files (process-unix.c, - process-msw.c in future). - - * process.h (PROCESS_LIVE_P): Changed to test against stream - existence, to avoid dependency on fds. - - * process.c: Only process implementation independent code is now - in this file. Moved the rest into process-unix.c - (Fopen_network_stream_internal): Added 5th parameter, protocol - family. Defaults to 'tcp/ip when unspecified. - - * process-unix.c: New file, implementation of UNIX - processes. UNIX-specific code from the old process.c is here. - - * Lstream.c (Lstream_was_blocked_p): New function. Replaces - filedesc_stream_was_blocked_p. - (filedesc_was_blocked_p): Implementation of the method for - filedesc stream - (filedesc_stream_set_pty_flushing): set pty_flushing flag - (filedesc_stream_fd): New function, returns fd of the stream - - * lstream.h (lstream_implementation): was_blocked_p is a new - optional lstream method. - Added prototypes for functions in lstream.c - - * lisp.h: (USID): Typedef for Unique Stream IDentifier. Reuqired - by the new code in many places. - - * events.h (struct event_stream): Declaration of the two mandatory - event stream methods, required by process support. - - * event-unixoid.c (event_stream_unixoid_create_stream_pair): - Implementation of the method shared by TTY and X - (event_stream_unixoid_delete_stream_pair): Ditto - - * event-tty.c (emacs_tty_next_event): get_process_from_usid() - instead of get_process_from_fd() - (emacs_tty_create_stream_pair): New events tream method - (emacs_tty_delete_stream_pair): New events tream method - - * event-stream.c (event_stream_create_stream_pair): New event - stream method - (event_stream_delete_stream_pair): Ditto - - * event-msw.c (debug_process_finalization): Although if0'ed, - removed obsolete code - - * event-Xt.c (emacs_Xt_create_stream_pair): Implementation if the - new event stream method - (emacs_Xt_delete_stream_pair): Ditto - - * emacs.c (main_1): Added calls to process_type_create*() and - vars_of_process() - - * callproc.c: (many places): removed DOS support - -1998-03-02 SL Baur - - * process.c (Fprocess_status): Restore old behavior -- call - Fget_process on a string argument. - -Mon Mar 02 11:37:36 1998 Andy Piper - - * file-coding.h: - * file-coding.c: more cleanup by only including iso2022 stuff in a - mule build. (setup_eol_coding_systems) move (T) -> :T etc. - - * event-stream.c: (Fopen_dribble_file) Qescape_quoted only exists in - mule. - - * md5.c: remove warning. - - * unexcw.c: move .idata -> .rdata for cygwin b19. - - * Makefile.in.in: add msw dependencies. - - * sheap.c: up static heap parameters. - - * s/cygwin32.h: add prototypes to eliminate warnings. - -1998-03-02 SL Baur - - * Makefile.in.in (blddir): Import blddir. - Add blddir to dump-time load-path. - - * nas.c (play_sound_data): Add braces for clarity. - (play_sound_file): Ditto. - -1998-03-01 SL Baur - - * alloc.c: Boost static vector size for breathing room. Double - the size if we may be dynamically linking. - - * dlopen.c (Fdl_open): Use RTLD_GLOBAL flag on dlopen if available. - - * device-x.c (x_init_device): Hardcode `Emacs' as the filename - containing localized menubars. - - * config.h.in: Add HAVE_UNIX_PROCESSES for 20.6. - - * alloc.c (init_alloc_once_early): Document movement of mmap - enabling code to emacs.c. - - * Makefile.in.in: Update FILE_CODING dependencies. - -1998-03-01 Kyle Jones - - * file-coding.c (setup_eol_coding_systems): Don't try - to copy the mnemonic property of the coding system - unless it is a string. - - (allocate_coding_system): Initialize coding system - struct member 'mnemonic' to Qnil. Leaving its value - set to 0 causes a crash. - -1998-03-01 SL Baur - - * file-coding.c (DEFINE_SUB_CODESYS): Undo previous patch. - -1998-03-01 Kyle Jones - - * callint.c: Read coding system names for the 'z' and - 'Z' interactive specs if FILE_CODING or MULE is defined. - Previously, coding system names were read only if MULE was - defined. - - * file-coding.h: Removed charset-based category types - from enumerated coding_category_type if not building - with MULE. - - * file-coding.c (syms_of_mule_coding): Don't define - symbols for charset-based coding systems unless - building with MULE. - -1998-02-28 SL Baur - - * alloc.c (garbage_collect_1): Guard call to selected_frame so it - cannot be called during GC. - - Update current count of staticpro'ed objects. - -1998-02-28 Kyle Jones - - * menubar.c (Fmenu_find_real_submenu): Document the - "use struct as array" hack. Convert struct pointer to - array to avoid compiler warnings. - -1998-02-26 SL Baur - - * buffer.c (complex_vars_of_buffer): Fix DOC string for - buffer-file-coding-system. - -1998-02-26 Damon Lipparelli - - * symsinit.h: syms_of_ldap() is actually syms_of_eldap(). - - * eldap.c: removed duplicates. - -1998-02-26 SL Baur - - * file-coding.c (setup_eol_coding_systems): Disable SUB_CODESYS - feature -- it causes stack corruption in Mule. - -1998-02-27 Kirill M. Katsnelson - - * events.c (character_to_event): The code which guesses TTY - backspace character is conditionalized on HAVE_TTY - -1998-02-26 SL Baur - - * console.c (complex_vars_of_console): Guard tty_erase_char with - HAVE_TTY. - * conslots.h: Ditto. - -1998-02-25 SL Baur - - * events.c (character_to_event): Correct operations on tty_erase_char. - From Martin Buchholz - - * file-coding.c (setup_eol_coding_systems): Unix/Binary sub - coding-system display should default to the empty string. - - Use '(t)' for Mac/Text mode. - -Tue Feb 17 12:50:37 1998 Andy Piper - - * Makefile.in.in: make sure clean removes msw executables. This - prevents the build stalling after puresize has been adjusted. Add - file-coding.o to list of objects. - - * buffer.c: - * buffer.h: - * bufslots.h: - * callproc.c: - * console-tty.c: - * emacs.c: - * event-Xt.c: - * event-stream.c: - * glyphs-x.c: - * lread.c: - * md5.c: - * mule-canna.c: - * mule-ccl.c: - * process.c: - * redisplay-x.c: - * redisplay.c: remove #ifdef MULE's from stuff that relates to - file-coding. include file-coding.h rather than mule-coding.h - where applicable. - - * mule-coding.c: #if 0 out functionality until file-coding is - split up. - - * file-coding.h: - * file-coding.c: new files. copies of mule-coding.h and - mule-coding.c. The mule case is unchanged. The non-mule case - removes coding relating to other charsets - iso2022, big5, sjis, - ccl. (setup_eol_coding_systems) add the eol type to the subsidiary - coding system mnemonics so that it shows on the modeline, - currently (B) for unix style (T) for mac and dos styles. - - * fileio.c: remove #ifdef MULE's from stuff that relates to - file-coding. include file-coding.h rather than mule-coding.h where - applicable. FSFMACS_SPEEDY_INSERT is gone since file coding is - always on. - - * sheap.c: (more_static_core) remove spurious \n's from error - message. - -1998-02-25 Kyle Jones - - * lisp-disunion.h: Added XUINT macro. - - * lisp-union.h: Added XUINT macro. - - * data.c (Flsh): Used XUINT instead of XINT to - extract the value of the first argument to avoid sign - extension of the result. - -1998-02-25 SL Baur - - * s/decosf4-0.h: Add -D_BSD. - From Tore Olsen - -1998-02-21 Greg Klanderman - - * device-x.c (x_init_device): allow `x-emacs-application-class' to - be nil prior to connecting to the X server. When this is the - case, the application class is chosen based on whether the user - has any resources with application class `XEmacs' set in the - resource database. - (vars_of_device_x): make x-emacs-application-class nil by default - and document new behavior in its doc string. - -1998-02-23 Aki Vehtari - - * menubar.c: Doc fix: suffix can be form. - - * gui.c (gui_parse_item_keywords): Allow button descriptors - at least 2 long. - (gui_item_display_flush_left): Suffix can be form. - - * gui-x.c (button_item_to_widget_value): Allow button descriptors - at least 2 long. - (button_item_to_widget_value): Suffix can be form. - -1998-02-24 SL Baur - - * s/sol2.h: define HAVE_GETLOADAVG for late edition Solaris - From Georg Nikodym - -1998-02-24 Didier Verna - - * redisplay.c (generate_fstring_runes): fixed the modeline - scrolling lossage (the % constructs appearing in the - modeline). Now that we can have negative positions and boundaries, - max_pos == -1 can't mean 'no limit' anymore. Me, stupido! - (add_string_to_fstring_db_runes): Ditto. - (add_glyph_to_fstring_db_runes): Ditto. - -1998-02-19 Jim Radford - - * sysdep.c: Don't clobber SIGIO event flags we don't care about. - * device.h: removed old_sigio_flag, sigio_enabled from device - Secretly (on Solaris) F_SETOWN calls I_SETSIG. We unknowingly - clobbered the changes so restoring the owner would cause - F_SETOWN's I_SETSIG to fail therby causing an annoying syslog - message. Changed FASYNC version to match (untested). - -1998-02-22 SL Baur - - * emacs.c (main): Enable mmap for glibc-2.1 and Linux libc5. - Enable mmap only for non-Mule for glibc-2.0. - -1998-02-21 SL Baur - - * config.h.in: Define _NO_MALLOC_WARNING_ if using dlmalloc from - Linux libc5. - -1998-02-19 Andreas Jaeger - - * emacs.c: declare hooks only if !DOUG_LEA_MALLOC since the - declaration conflicts with glibc's own. - -1998-02-19 SL Baur - - * config.h.in: Remove HAVE_TERM, add USE_MINIMAL_TAGBITS and - USE_INDEXED_LRECORD_IMPLEMENTATION. - - * process.c (Fopen_network_stream_internal): Remove TERM support. - - * sysproc.h: Remove TERM support. - -1998-02-20 Kazuyuki IENAGA - - * input-method-xfs.c: add setlocale(LC_CTYPE, "") right after - setlocale(LC_NUMERIC, "C"). Because, without this, the LC_CTYPE - got a side effect of LC_NUMERIC then set to "C". - -1998-02-19 SL Baur - - * emacs.c (main): Enable mmap'ing with XEmacs/Mule. - - * redisplay.c (add_string_to_fstring_db_runes): Fix infloop - problem with long modelines and glyphs. - - * unexelf.c: The proper way to check for GNU libc is with __GLIBC__. - Suggested by Andreas Jaeger - -1998-02-18 SL Baur - - * Makefile.in.in: Remove all references to prefix-args. - -1998-02-18 Kirill M. Katsnelson - - * sysdep.c (mswindows_set_errno): New function - (mswindows_set_last_errno): Ditto - These convert Win32 error code to ANSI C errno. - - * sysdep.h: Prototypes for the above 2 functions. - - * menubar-msw.c (vars_of_menubar_mswindows): Fprovide - ('mswindows-menubar) removed. See the entry of 1998-01-03 - - * process.c: FSFmacs proc_buffered_char static array - #if0'ed in 2 places. It is never used. - -1998-02-01 Kyle Jones - - * window.c (save_window_save): Save window-cached - speciifer values. - (saved_window_equal): Added comparisons of window-cached - specifier values. - (Fset-window-configuration): Restore window-cached - specifier values. - -1998-02-18 Didier Verna - - * modeline.el (mouse-drag-modeline): added the horizontal - scrolling functionality for the modeline. This could still be - improved, for instance when the mouse goes out of the modeline. - -1998-02-18 Didier Verna - - * redisplay.c: - (generate_formatted_string_db): new flag to distinguish a modeline - string from a title or icon one, plus use a negative first pos to - indicate the modeline hscroll ammount. - (add_string_to_fstring_db_runes): completely rewrote this function - to handle the case of scrolled modelines. - (add_glyph_to_fstring_db_runes): handle the case of scrolled - modelines. - - * window.c: - (Fmodeline_hscroll): new function to return the modeline current - horizontal scroll ammount. - (Fset_modeline_hscroll): new function to scroll the modeline - horizontaly. - Plus some updates related to this new functionality (windows - configuration, notably). - - * window.h (struct window): added the new field modeline_hscroll. - -1998-02-18 SL Baur - - * m/alpha.h: - * unexelf.c: Synched with Emacs 20.2. - From Aki Vehtari - - * emacs.c (main): Don't call __sbrk(). - * gmalloc.c (__sbrk): Ditto. - Suggested by Andreas Jaeger - -1998-02-17 SL Baur - - * console-tty.c (Fset_console_tty_coding_system): New function. - From Kazuyuki IENAGA - -1998-02-15 SL Baur - - * ralloc.c (init_ralloc): DOUG_LEA_MALLOC support. - (r_alloc_reinit): Ditto. - [All non-HAVE_MMAP code]: Synched with Emacs 20.2. - - * emacs.c: Synch DOUG_LEA_MALLOC support from Emacs 20.2. - (main): Ditto. - Add LINUX_SBRK_BUG workaround, what is it? - (Fdump_emacs): DOUG_LEA_MALLOC support from Emacs 20.2. - - * alloc.c: Synch DOUG_LEA_MALLOC support from Emacs 20.2. - (init_alloc_once_early): Ditto. - - * config.h.in: Add DOUG_LEA_MALLOC symbol. - - * unexfreebsd.c (run_time_remap): Change printf format string to - match parameters given. - -1998-02-14 SL Baur - - * s/sco5.h: Define LIB_GCC as -lgcc for gcc 2.8 and egcs. - Suggested by Robert Lipe - -1998-02-14 Martin Buchholz - - * event-Xt.c (x_reset_key_mapping): - * device-x.c: - (x-keysym-on-keyboard-p): - (x-keysym-on-keyboard-sans-modifiers-p): - Use x-keysym-on-keyboard-sans-modifiers-p instead of - x-keysym-on-keyboard-p to detect backspace. - Use symbols instead of strings (now deprecated) with x-keysym-*-p. - Clean up symbols used with dead keys, checking Linux and solaris - keysyms. - Simplify x-win-*.el using above methods. - Change documentation for x-keysym-*-p functions. - -1998-02-13 SL Baur - - * unexelfsgi.c: Various changes. - From Olivier Galibert - - * s/freebsd.h: Avoid redefining BSD. - From Kazuyuki IENAGA - - * extents.c (extent_fragment_update): Break up a line to avoid a - Digital UNIX 3.2g C compiler bug. - From Tonny Madsen - - * process.c (create_process): Restore save_environ hackery. - -1998-02-10 SL Baur - - * emacsfns.h: Remove mocklisp declarations. - - * redisplay-msw.c (mswindows_update_dc): Enable evil kludge for - cygwin. - From Andy Piper - -1998-02-09 SL Baur - - * menubar-msw.c (vars_of_menubar_mswindows): Fix patch failure. - Suggested by: kny@tekla.fi - - * data.c (Fold_eq): PC-ize. - - * chartab.c: PC-ize. - - * window.c (toplevel): PC-ize. - (syms_of_window): Ditto. - - * search.c (Freplace_match): PC-ize. - - * lread.c: PC-ize. - - * buffer.c (Fbuffer_enable_undo): PC-ize. - (Fbuffer_disable_undo): ditto. - - * eval.c (return_from_signal): PC-ize. - - * casetab.c: PC-ize. - - * callproc.c (Fcall_process_internal): PC-ize. - -1998-02-02 Kirill M. Katsnelson - - * gui.h (struct gui_item): Menu item, submenu or GUI button - properties are abstracted into this new structure. - Added prototypes for the following functions - - * gui.c (gui_item_init): New function - (gui_item_add_keyval_pair): Ditto - (gui_parse_item_keywords): Ditto - (gui_item_active_p): Ditto - (gui_item_included_p): Ditto - (gui_item_display_flush_left): Ditto - (gui_item_display_flush_right): Ditto. The above listen new - functions manipulate on properties common to menu items and GUI - buttons. - - * menubar.c (current_frame_menubar): Moved from menubar-msw.c - (menu_parse_submenu_keywords): New function - (Fmenu_find_real_submenu): Ditto, lisp accessible. The last two - functions operate on menu properties stored in struct gui_item, - but are specific to menus only. - - * menubar.h: Prototypes for the above functions. - - * menubar-msw.c: Modified to utilize struct gui_item instead of - plists, to reduce garbage. Suggested by Ben Wing. - Unreachable menus are fixed. - -1998-01-03 Kirill M. Katsnelson - - * menubar-msw.c (allocate_menu_item_id): Added third parameter to - hash, suffix. Menus tend to put non-localizable items into suffix - with empty name. - (update_frame_menubar_maybe): top_level_menu is now set here. - (mswindows_popup_menu): Ditto. It was incorrect to set it from - populate. - (vars_of_menubar_mswindows): Fprovide ('mswindows-menubar) removed: - (featurep (and 'mswindows 'menubars)) tests the same. - (mswindows_update_frame_menubars): update_..._maybe () now called - only if frame->menubar_changed is set. Is it right to patch - menubar.c instead? - -1998-02-08 Jonathan Harris - - * objects-msw.c: - Updated color database to X11R6. Also added support for - "#RRRGGGBBB" and "#RRRRGGGGBBBB" in addition to "#RRGGBB". - -1998-02-08 Jonathan Harris - - * console.h: - * console-stream.c: - * redisplay.c: - * redisplay-msw.c: - * redisplay-tty.c: - * redisplay-x.c: - Added the frame as a parameter to the text_width device - method. - - * redisplay-msw.c: - Support for proportional fonts. - -1998-02-07 Hrvoje Niksic - - * window.c (map_windows): Don't return the value of map_windows_1. - (map_windows): If F is NULL, map through all the windows. - (mark_windows_in_use): Use map_windows(); made it static. - (mark_windows_in_use_closure): New function. - -1998-02-01 Hrvoje Niksic - - * alloc.c (Fpurecopy): Check for non-`nil'-ness instead of - checking for Vobarray. - - * dlopen.c (Fdl_open): Indirect FUNCTION explicitly, for clarity. - - * elhash.c: Removed broken hashtable_hash(). - -1998-01-28 Hrvoje Niksic - - * symbols.c (Fintern): Use Qt instead of the actual obarray. - (init_symbols_once_early): Ditto. - -1998-01-27 Hrvoje Niksic - - * lisp.h (DO_REALLOC): Name the variable `do_realloc_newsize' - instead of `newsize', to avoid name collisions. - -1998-01-26 Hrvoje Niksic - - * print.c (print_symbol): Be more wary about the contents of - Vprint_gensym_alist. - -1998-02-06 SL Baur - - * emacs.c (Frun_emacs_from_temacs): Disable largely meaning-free - purity/impurity summary. Compile with -DREPORT_PURE_USAGE to get - it back. - - * process.c (create_process): Unused variable elimination. - - * lread.c (Fload_internal): Compiler warning suppression. - - * alloc.c (report_pure_usage): Remove unused variable. - -Wed Jan 28 13:41:22 1998 Andy Piper - - * Makefile.in.in: add support for sheap-adjust.h generation for - static heap. - -Wed Jan 28 13:41:22 1998 Andy Piper - - * Makefile.in.in: add sheap-adjust.h support, basically copied - from puresize-adjust.h. predicate sheap.o on HEAP_IN_DATA. fix - xemacs target slightly to not be a single shell command, this - fixes an obscure bug in cygwin gmake. - - * alloc.c (report_pure_usage): call sheap_adjust_h if HEAP_IN_DATA - is defined. - - * sysfile.h: add abstracted OPEN_BINARY, OPEN_TEXT etc defines. On - Unix these are all 0 and have no effect. On systems defining - O_BINARY these use it. WINDOWSNT is currently unaffected because - there are individual #ifdefs in each source file, but with this - change they could be removed. - - * emacs.c: - * doc.c: - * lread.c: - * process.c: generalize open() calls with OPEN_BINARY. Does - nothing under Unix. - - * emacs.c: predicate inclusion of windows.h on WINDOWSNT not - _WIN32. - - * process.c: - * sysdep.c: - * signal.c: predicate SIGIO stuff also on !BROKEN_SIGIO, this is - required for building on cygwin32 b19 which has SIGIO that only - works on sockets. - - * fileio.c: - * event-stream.c: generalize open() calls with OPEN_BINARY. Does - nothing under Unix. Use open() instead of creat() to make this - possible. use CREAT_MODE from sysfile.h - - * config.h.in: add MULE_CODING, currently not used. add support - for HAVE_A_OUT_H. - - * elhash.c: - * menubar-msw.c: - * mule-ccl.c: - * device-msw.c: warning elimination. - - * event-msw.c: add undeclared Dde calls for cygwin. - - * redisplay-msw.c: warning elimination under mule. - - * gmalloc.c: make initalize() really do that. If HEAP_IN_DATA is - defined catch free() & realloc() calls with addresses in the data - space. __morecore calls more_static_core for temacs, when dumped - switches to sbrk(). - - * console-msw.h: undef CONST after windows.h inclusion since this - defines CONST. #ifdef out shellapi under cygwin. - - * device-msw.c: include sysdep.h - - * objects-msw.c: add dummy mswindows_font_spec_matches_charset and - mswindows_find_charset_font so that we can build with mule. - - * mem-limits: return -1 for get_lim_data() when HEAP_IN_DATA is - defined. - - * sheap.c: new file. defines sheap_adjust_h and more_static_core - so that data space can be used by gmalloc before dumping when - HEAP_IN_DATA is defined. beef up error message about what to do if - sheap space runs out. - - * sysdep.c: make start_of_data reurn something sensible for - HEAP_IN_DATA. - - * systime.h: don't use itimer stuff on cygwin b19. - - * unexcw.c: new file. Full unexec() support for cygwin using the - HEAP_IN_DATA setup provided by sheap.c and friends. No run-time - remapping is performed. This could be generalized to support many - platforms that use COFF. you need a.out.h from my website to build - this. cygwin b19 will have this. - - * s/cygwin32.h: fixed commentary. compile in unexcw.o for dumping - support. removed irrelevent things. define BROKEN_SIGIO. remove - include of windows.h. add correct process support defines, process - support might work when non-blocking io is implemented in cygwin. - -1998-02-02 P. E. Jareth Hein - - * glyphs.c: Removed ImageMagick support, re-instituted the previous - support for JPEG, GIF and PNG with the new color system. - -1998-02-05 Olivier Galibert - - * unexelf.c: Fix alignment problems on Linux. - -1998-02-01 Kyle Jones - - * redisplay.c (redisplay_window): After outputting - the window, invalidate its the line start cache if the - we're displaying the minibuffer window and the echo - area is active. The cache is only valid for the echo - area buffer, and that buffer isn't associated with the - minibuffer window anymore. - -1998-01-31 SL Baur - - * alloc.c (disksave_object_finalization): Additional checking for - sanity when zeroing out unused portions of string_chars_block's. - (Fpurecopy): Spelling fixes in comment. - (PURESIZE_SLOP): Set default slop to 0. - -1998-01-31 Kyle Jones - - * chartab.c (make_char_table): Initialize mirror - tables with Spunct in all the slots. Syntax table - initialization doesn't touch slots for nonexistent - characters sets. If character sets corresponding to - those slots are created later Qnil values in the slots - will cause crashes. - (copy_char_table_entry): Return copy not original. - -1998-01-28 Jonathon Harris - - * msw-proc.c: - * event-msw.h: - * event-msw.c: - * console-msw.h: - Deleted the first two and merged them into the last two files. - - * device-msw.c: - * event-msw.c: - * frame-msw.c: - Added file-based drag and drop support. The "System/Open" DDE command - is also implemented as if it were a drag and drop operation. - - * emacsfns.h: - * event-stream.c: - * events.c: - * events.h: - * frame.c: - * keymap.c: - Replaced all "#ifdef HAVE_OFFIX_DND" with - "#if defined(HAVE_OFFIX_DND) || defined(HAVE_MS_WINDOWS)" - - * device.h: Added DEVICE_MSWINDOWS_P and related macros. - - * objects-msw.c: - * select-msw.c: - Eliminated warnings. - - * redisplay-msw.c: Changed color of "dead" box between scrollbars - to windows' "button" color for compatibility with other windows apps. - -1998-01-20 Stephen Turnbull - - * Makefile.in.in: move `rm puresize-adjust.h' from distclean - to mostlyclean - -1998-01-29 SL Baur - - * Makefile.in.in (dlopen.o): Add dependencies. - - * s/sunos4-0.h: Conditionalize use of broken-sun.h for old Gccs. - Suggested by Amir J Katz - -1998-01-28 SL Baur - - * faces.c (init_device_faces): This function can call lisp. - -1998-01-28 P. E. Jareth Hein - - * mule-coding.h: - * mule-coding.c: (determine_real_coding_system): removed the - static declaration to allow reuse. - - * md5.c (Fmd5): Rewrote to fully support MULE, as well as streamline - the code. - - * mule-ccl.c (ccl_driver): Set initial values of variables to shut up - the compiler and to give better error message if a quit happens before - any ccl_code is generated. - -1998-01-28 SL Baur - - * glyphs.c (allocate_glyph): This function can GC. - Wrap GCPRO around unprotected function calls. - (specifier_vars_of_glyphs): Comment change -- Can we GC here? - -1998-01-27 SL Baur - - * lread.c (Fload_internal): Add extra GCPRO around call to - Fassoc. - Enable purespace usage counts always. - - * m/powerpc.h: Isolate changes for mklinux from AIX. - -1998-01-27 Hrvoje Niksic - - * symbols.c (init_symbols_once_early): Decreased default size of - Vpure_uninterned_symbol_table to 50. - -1998-01-27 SL Baur - - * redisplay-x.c (x_output_string): Correction for handling underlined - fonts when XGetFontProperty fails. - From Chris Felaco - -1998-01-27 Kyle Jones - - * alloc.c (Fpurecopy): Store symbols that aren't - interned in Vobarray into Vpure_uninterned_symbol_table. - - * symbols.c (init_symbols_once_early): Initialize - Vpure_uninterned_symbol_table. - - * emacsfns.h: Declare Vpure_uninterned_symbol_table. - -1998-01-26 SL Baur - - * alloc.c (report_pure_usage): New macro PURESIZE_SLOP to allow - for extra pure space. - -1998-01-23 SL Baur - - * sound.c (Fplay_sound_file): Use NILP for comparison of - Lisp_Object. - -Wed Jan 21 10:49:47 1998 Andy Piper - - * unexcw.cc: new file for cygwin32 unexec() requires cygwin32 - b19. Predicated on HAVE_COFF_H. - - * console.c: - * device-msw.c: - * event-msw.c: - * frame-msw.c: - * msw-proc.c: - * objects-msw.c: - Eliminate warnings. - - * redisplay-msw.c (mswindows_update_gc): eliminate warnings and - extend hack for bogus bg values. - - * symsinit.h: add msw headers to eliminate warnings. - - * s/cygwin32.h: various updates for unexec() support. - - * lastfile.c: add my_ebss for cygwin32 unexec() support. - - * gmalloc.c: made __malloc_initialized non-static so that - it goes into the bss where we expect it. - - * emacs.c: put run_time_remap() in a place where initialized is - not always true. - - * Makefile.in.in: add support for compiling .cc files. - - * config.h.in: added HAVE_COFF_H support. - -1998-01-23 Hrvoje Niksic - - * print.c (print_cons): Use XCAR/XCDR. - (print_string): Fix up so it Vprint_string_length works under Mule - correctly. - - * eval.c (Feval): Increase profile call count. - - * keymap.c: Fixed typo. - -1998-01-22 Hrvoje Niksic - - * symbols.c (Funintern): Reset symbol's obarray property. - -1998-01-22 Karl M. Hegbloom - - * alloc.c (size_vector): Declare *p as CONST to eliminate warning. - -1998-01-22 Hrvoje Niksic - - * print.c (print_symbol): Recognize Vprint_gensym being a cons; - use Vprint_gensym_alist. - - * symbols.c (init_symbols_once_early): Ditto. - - * alloc.c (Fmake_symbol): Reset it. - - * symbols.c (Fintern): Set it. - - * lisp.h (struct Lisp_Symbol): New element `obarray'. - - * print.c (print_prepare): Reset Vprint_gensym_alist. - (print_finish): Ditto. - - * lread.c: Recognize #n= and #n#. - (readevalloop): Reset read_objects to nil. - (Fread): Ditto. - -1998-01-23 SL Baur - - * toolbar.c (update_toolbar_button): Eliminate redundant NILP - checks. - From Martin Buchholz - -1998-01-21 Hrvoje Niksic - - * dlopen.c: New file. - -1998-01-19 Steven L Baur - - * eval.c (prog1): Don't GCPRO unitialized variable. - (prog2): Ditto. - From Martin Buchholz - -1998-01-19 Hrvoje Niksic - - * sound.c (Fplay_sound_file): Use - signal_simple_continuable_error() instead of error(). - -1998-01-18 Hrvoje Niksic - - * README: Updated. - -1998-01-18 SL Baur - - * glyphs-x.c (imagick_instantiate): Dynamically allocate pixar - with alloca. - From Damon Lipparelli - -1998-01-14 Martin Buchholz - - * eval.c (For, Fand, Fif, Fcond, Fprogn, Fprog1, Fprog2): - Modernize and streamline. - Replace Fcdr with XCDR, Fcar with XCAR for efficiency. - Remove REGISTER declarations. - -1998-01-13 Martin Buchholz - - * emacsfns.h: - * alloc.c: - Add proper prototypes for print_cons, print_vector, print_string. - - * dired.c (directory-files): - * elhash.c (elisp_maphash): - * elhash.h (elisp_maphash): - * lrecord.h: - * mule-ccl.c (setup_ccl_program): - * mule-coding.c (coding_system_charset): - * offix-cursors.h (cursor_bits): - Warning elimination. - - * redisplay.c (add_blank_rune): - * redisplay.c (add_glyph_rune): - * redisplay.c (add_emchar_rune): - Warning elimination. Avoid useless computation in non-mule case. - - * config.h.in: - Define HAVE_INVERSE_HYPERBOLIC using 1 configure test, not 3. - * src/alloc.c: - * src/events.c: - Rearrange order of declarations and definitions to avoid forward - * src/mem-limits.h: Add motivating comment for future cleanup. - - * s/linux.h: Cleanup. Remove old cruft. - - * config.h.in: - Always define _GNU_SOURCE when using GNU libc. - Support --without-FOO as a synonym for --with-FOO=no. - Always use $srcdir to locate config.guess. - Make it clear that CONFIGURATION is optional. - De-emphasize CONFIGURATION parameter. Random cleanup. - More compatible with standard GNU install instructions. - --with-menubars=athena3d ==> --with-menubars=lucid. - -1998-01-14 Hrvoje Niksic - - * fileio.c (Fexpand_file_name): Synched with FSF. - -1998-01-13 Hrvoje Niksic - - * objects-msw.c (mswindows_color_instance_rgb_components): - Multiply components by 257 instead of shifting by 8. - -1998-01-15 Hrvoje Niksic - - * elhash.c (Fhashtable_type): New function. - (Fhashtable_test_function): Ditto. - -1998-01-12 SL Baur - - * profile.c (Fclear_profiling_info): Fix typing error. - - * elhash.c (elisp_map_remhash): Fix typing error. - (elisp_maphash): Ditto. - -1998-01-12 Hrvoje Niksic - - * mule-ccl.c (Fccl_execute_on_string): Use Dynar_free to free a - Dynarr. - -1998-01-13 Hrvoje Niksic - - * profile.c (vars_of_profile): New variable - `call-count-profile-table'. - (Fclear_profiling_info): Clear call-count-profile-table. - - * eval.c (funcall_recording_as): Use it. - - * profile.c (profile_increase_call_count): New function. - - * lstream.c (stdio_flusher): Comment addition. - - * objects-msw.c (mswindows_string_to_color): Support #RRRGGGBBB, - as well as #RRGGBB. - (mswindows_X_color_map): Reformatted. - -1998-01-12 Hrvoje Niksic - - * line-number.c (invalidate_line_number_cache): Comment fixup. - - * symbols.c (Fapropos_internal): Docstring fix. - - * fns.c (Fstring_equal): Docstring fix. - -1998-01-12 Hrvoje Niksic - - * profile.c (get_profiling_info_maphash): Return int. - (mark_profiling_info_maphash): Ditto. - - * elhash.c (Finternal_hash_value): New debugging function, - undefined by default. - -1998-01-11 Hrvoje Niksic - - * mule-coding.c (add_coding_system_to_list_mapper): Ditto. - - * mule-charset.c (add_charset_to_list_mapper): Return int. - - * faces.c (add_face_to_list_mapper): Return int. - (mark_face_as_clean_mapper): Ditto. - (update_face_inheritance_mapper): Ditto. - - * keymap.c (keymap_submaps_mapper_0): Return int. - (keymap_submaps_mapper): Ditto. - (copy_keymap_inverse_mapper): Ditto. - (copy_keymap_mapper): Ditto. - (map_keymap_unsorted_mapper): Ditto. - (map_keymap_sorted_mapper): Ditto. - - * elhash.c (hashtable): Added a hash method. - (hashtable_hash): New function. - -1998-01-09 Hrvoje Niksic - - * elhash.c (lisp_maphash_function): Return 0. - (hashtable_equal_mapper): Bail out when an element is not `equal'. - - * hash.c (maphash): Bail out if map function returns non-zero. - -1998-01-11 SL Baur - - * eval.c (Fbacktrace): Treat first parameter to byte-code - specially. - -Sat Jan 10 11:36:11 1998 Andy Piper - - * config.h.in: undef HAVE_SYS_UN_H so that it gets defined by - configure for gnuserv with UNIX_DOMAIN_SOCKETS. - -1998-01-09 SL Baur - - * buffer.c (reset_buffer_local_variables): Synch case-table - resetting stuffs from Emacs 20.2. - Suggested by Aki Vehtari - - * src/symbols.c (Fsetq_default): Fix docstring. - From Didier Verna - -1998-01-07 Kirill M. Katsnelson - - * msw-proc.c (mswindows_wnd_proc): Calls to redisplay() from out - of WM_SIZE handler limited to the case of dragging frame borders. - - * redisplay-msw.c (mswindows_bevel_modeline): Added support for - negative modeline height. - (mswindows_output_cursor): Added bar cursor drawing - (mswindows_flash): Flash frame by inverting client area. - -1998-01-08 Andy Piper - - * lread.c: guess load path if its not set just like the dumped - version does. - - * doc.c: guess doc path if its not set just like the dumped - version does - -Thu Jan 08 09:42:36 1998 Andy Piper - - * emacs.c: don't load loadup.el when CANNOT_DUMP is set, this - is almost never right on XEmacs. - - * s/cygwin32.h: add comments about how to buid. Move some - variables into configure so that we don't have to set them. - - * config.h.in: define HAVE_WINDOW_SYSTEM if HAVE_MS_WINDOWS is - set. - -1998-01-06 Kirill M. Katsnelson - - * lread.c (Fload_internal): On Win32, this reopened the file - without first closing the handle. This caused running out of - handles. - - * nt.c (sys_open): This one made big mess when opening a handle - next after MAXDESC-1. Fixed. - -1998-01-06 Kirill M. Katsnelson - - * objects-msw.c (mswindows_string_to_color): Patched not to modify - const char* parameter. - (hexval): Modified to accept uppercase hex digits. - - * ntproc.c (sys_spawnve): char* arguments made CONST, to comply - with standard header declaration. - - * sysdep.c: Fixed ugly prototypes copied from system headers. Who - says the solution is as ugly, is right. - Added a couple of #include directives to avoid undefined functions. - (struct save_signal): Added parameter to function pointer - prototype when compiled under ANSI C. - (save_signal_handlers): Ditto - - * s/windowsnt.h: Added prototypes for functions defined via - sys_ which are not found or differ on Win32: pipe, sleep, - spawnve, wait, kill - Macros created from former nt.c functions: random srandom setpgrp - Defined HAVE_STRCASECMP, and strcasecmp defined to _stricmp which - is provided by the compiler. - Removed hack which prevented winsock.h from including. - - * nt.c (random): Removed and made a macro in s/windowsnt.h - (srandom): Ditto - (setpgrp): Ditto - (unrequest_sigio): #if0'ed. It is unreferenced; in XEmacs, calls - to it seem to be controlled by HAVE_SIGIO. - (request_sigio): Ditto - - * nt.h: Removed FD_* macros. Rely on definitions in winsock.h. - Changed EMACSDEBUG references to DEBUG_XEMACS - - * event-msw.c (mswindows_cancel_dispatch_event): Returns Qnil when - event not found in the queue. Used to return undefined value. - -1998-01-07 SL Baur - - * emacs.c (main_1): Add `-no-autoloads' to suppress loading - autoloads at startup. - - * Makefile.in.in (xemacs): Fix call to list load-path shadows. - -1998-01-02 Charles G. Waldman - - * frame.h: fix erroneous FRAME_RIGHT_BORDER_START macro. - Corrects display glitch when toolbar is on the right. - -1998-01-02 Kirill M. Katsnelson - - * emacs.c (make_arg_list_1): On Win32 platforms, GetModuleFileName - is consulted instead of argv[0] to get full path to the xemacs - executable. - -1998-01-01 SL Baur - - * m/sparc.h: Cleans up some warnings about unused variables in - getloadavg.c under Sparc/Linux. - From Stephen J. Turnbull - - * fileio.c (vars_of_fileio): Enable directory-sep-char always for - compatibility. - - * emacs.c (main_1): Inhibit reloading dumped lisp when using - `-batch' or `-vanilla'. - -1997-12-31 SL Baur - - * emacs.c: New variables `inhibit-update-dumped-lisp' and - `inhibit-update-autoloads'. - (vars_of_emacs): Initialize them. - -1997-12-29 Kirill M. Katsnelson - - * msw-proc.c (mswindows_enqueue_magic_event): Made extern. User by - menubar-msw.c - - * event-msw.h: Prototype for mswindows_enqueue_magic_event - - * event-msw.c (mswindows_wm_timer_callback): Fixed counter of - outstanding timer events (decremented only when KillTimer - succeeds) - (emacs_mswindows_remove_timeout): Ditto - - * console-msw.h: Added frame structure field for menu checksum - - * menubar-msw.c: Miscellaneous patches and bug fixes. - -1997-12-30 SL Baur - - * emacs.c (main): Clarify calls to main_1. - - * data.c (Fcompiled_function_annotation): Hide DEFUN from - make-docfile. - - * emacs.c (main_1): The invocation name requires recomputing when - running after dumping. - -1997-12-29 SL Baur - - * free-hook.c (check_free): Added explicit braces to avoid - dangling else clause. - * sound.c (Fplay_sound_file): Ditto. - * process.c (set_process_filter): Ditto. - * linuxplay.c (linux_play_data_or_file): Ditto. - * regex.c (regex_compile): Ditto. - -1997-12-28 SL Baur - - * emacs.c (main_1): Fix logic to run in place when XEmacs is a - login shell. - (main_1): New parameter restart. - (main): Use it. - - * bytecode.h: Disable COMPILED_FUNCTION_ANNOTATION_HACK. - - * print.c (debug_short_backtrace): Guard call to - Fcompiled_function_annotation. - - * alloc.c (disksave_object_finalization): Don't zero out - load-history if history of pure symbols is desired. - - * lread.c (build_load_history): If LOADHIST_DUMPED is defined, add - pure symbols to load-history. - - * emacsfns.h: New symbols added -- LOADHIST_DUMPED, define to get - a history of dumped lisp. LOADHIST_BUILTIN, define to get a - history of symbols defined in C source. - -1997-12-23 Andy Piper - - * Conditionals to enable XEmacs to compile (not run!) under - CygWin32. Files touched: - events.c - getloadavg.c - mem-limits.h - objects-msw.c - select-msw.c - sysdep.c - * s/cygwin.h: New file. - -1997-12-26 Kirill M. Katsnelson - - * menubar-msw.c, menubar-msw.h: New files. Menus support. - - * console-msw.h: Added frame menu hashtable variable. - - * gui.c: popup_up_p variable and Fpopup_up_p and - separator_string_p functions are moved from gui-x.c - - * gui.h: New file declaring the above. It is #included into the - following files: - dialog-x.c - gui-x.c - menubar-x.c - - * emacs.c: Added calls to *_of_menubar_mswindows() - - * event-msw.c: Generalization of modal pump interface so it may be - used bu menubars also. Some functions and vars renamed, to - reflect more general approach (event_pump -> modal_loop) - - * frame-msw.c: Initialization and marking of menu hashtable. - - * msw-proc.c: Added handling for menu window messages. - - * opaque.c: opaque objects given hash and equal methods, so they - can be compared with 'equal. Menubar uses opaque pointers as - hash keys in an 'equal style hastable. - - * Most of the above touched files: Eliminated compiler warnings. - -1997-12-18 Hrvoje Niksic - - * elhash.c (print_hashtable): Use `%u' for fullness. - (hashtable_equal): New function. - (hashtable_equal_mapper): Ditto. - - * lread.c (vars_of_lread): Initialize Vread_buffer_stream here - instead of in init_lread. - -1997-12-26 P. E. Jareth Hein - - * glyphs-x.c (imagick_instantiate): Add in error and - warning handling for ImageMagick files - -1997-12-26 SL Baur - - * Makefile.in.in (distclean): Remove `xemacs.*'. - -1997-12-22 SL Baur - - * device.c (vars_of_device): Provide `devices' feature so W3's - devices.el emulation won't bloat XEmacs. - - * lread.c (Fload_internal): Strip path and extension when - considering a file as a candidate for running after-load functions. - -1997-12-20 Kirill M. Katsnelson - - * s/windowsnt.h: SIZEOF_SHORT set to 16 bits instead of 32, to get - real. - - * redisplay-msw.c: (many functions): FillRect replaced with - ExtTextOut where possible, which is much faster. - (mswindows_redisplay_deadbox_maybe): New function which fixes - deadbox, a square bounded by scrollbar ends and window corner - (usually the lower right corner). - - * emacs.c (assert_failed): On Win32 platforms, when assertion - fails, debugger break occurs if DEBUG_XEMACS is defined. - - * event-msw.c (mswindows_pump_outstanding_events): Fixed so two - consequtive Fsignals are not lost. - - * scrollbar-msw.c (mswindows_update_scrollbar_instance_values): - Added SBF_DISABLENOSCROLL flag so the bar is greyed out when - all lines are visible. - (mswindows_update_scrollbar_instance_status): Ditto for freshly - assigned scrollbar. - - * scrollbar.c (Fscrollbar_set_hscroll): Fixed fitting scroll - limits into range. - -1997-12-18 Kirill M. Katsnelson - - * events-msw.c: Added support for modal event dispatch pump. - This mechanism is for scrollbars and menus. - - * events-msw.h: Public declaration for the pump function. - - * msw-proc.c: Pump scrollbar misc user events through the - brand new pump. Pumps! - - * scrollbar-msw.c: Minor range fixes. Added misc events for - horizontal bar, which did not fix it... - -Thu Dec 18 09:53:12 1997 - - * objects-msw.c (mswindows_print_color_instance): Scale 8 bit RGB - components up to 16 bit X sizes. - (mswindows_string_to_color): numeric colors are #RRGGBB not #BBGGRR. - - * objects-msw.c (mswindows_color_instance_rgb_components): ditto - - * objects.c (Fcolor_instance_rgb_components): Document range of - components as 0-65535. - -1997-12-18 SL Baur - - * doc.c (verify_doc_mapper): Fix return value and argument list - for map_obarray. - - * device-x.c: New variable -- Vx_app_defaults_directory. - (x_init_device): Use locale directory searched from package-path. - -1997-12-18 Kyle Jones - - * EmacsFrame.c: Added foregroundToolBarColor and - foreground resources to the resources[] definition. - Moved default gray8o color value from the - bcakgroundToolBarCOlor resource to th background - resource since the override order is now reversed in - toolbar-x.c. Don't provide a default value for the - foreground resource that the toolbar code looks at. - - * EmacsFrame.h: Define foregroundToolBarColor string - for use in the resoruces code. - - * EmacsFrameP.h: Added foreground_toolbar_pixel slot - to EmacsFramePart struct. - - * toolbar-x.c: Let the toolbar specific background - resource override the global background resource. Added - support for a toolbar specific foreground resource, - which is not currently used for anything internally. - -1997-12-17 Hrvoje Niksic - - * redisplay.c (decode_mode_spec): Comment fixup. - - * tooltalk.c (Freceive_tooltalk_message): Ditto. - - * search.c (Freplace_match): Ditto. - - * frame-x.c (x_frame_property): Ditto. - - * console.c (Fcurrent_input_mode): Ditto. - - * callint.c (Fcall_interactively): Ditto. - - * abbrev.c (Fexpand_abbrev): Ditto. - - * dired.c (file_name_completion): Use Qzero instead of - make_int(0). - - * fileio.c (Finsert_file_contents_internal): Use - report_file_error() to report reading error. - - * cmds.c (internal_self_insert): Don't self-insert if the expanded - symbol's hook has a non-nil `no-self-insert' property; synch with - FSF 20.2. - - * abbrev.c (Fexpand_abbrev): Return Vlast_abbrev, like in FSF - 20.2. - -1997-12-16 Hrvoje Niksic - - * abbrev.c (abbrev_match): User map_obarray() instead of - crockishly copying it. - (abbrev_match_mapper): New function. - (Fexpand_abbrev): Check whether `pre-abbrev-expand-hook' has - killed the buffer. - - * symbols.c (map_obarray): Accept a void * argument. - (mapatoms_1): Adapt. - (apropos_accum): Use fast_lisp_string_match(). - (Fapropos_internal): Don't cons. - (map_obarray): Stop mapping if FN returns non-zero. - - * marker.c (unchain_marker): Guard assert() with ERROR_CHECK_GC. - (bi_marker_position): Guard assert() with ERROR_CHECK_BUFPOS. - (set_bi_marker_position): Ditto. - -1997-12-15 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Use make_int when - checking for overflow. - (Finsert_file_contents_internal): Use EXTERNAL_LIST_LOOP. - (Ffind_file_name_handler): Ditto. - - * dired.c (file_name_completion): Use noseeum_cons. - (file_name_completion_unwind): Free the cons. - -1997-12-16 - - * scrollbar.c: Add HAVE_MS_WINDOWS to scrollbar-page functions. - - * msw-proc.c: Handle scrolling events. - - * frame-msw.c: Initialize scrollbar width and height. This should - not be necessary, since the window shouldn't be created until - init_frame_2 - - * emacs.c: Call mswindows scrolbar setup when appropriate. - - * scrollbar-msw.c: Created for mswindows-scrollbar support. - - * scrollbar-msw.h: Ditto. - -1997-12-16 Kirill M. Katsnelson - - * msw-proc.c: Minor bug in the middle button emulation code - exterminated. - - * msw-proc.c: Character translation procedure reworked, so C-M-char - keys now work properly. Keyboard layouts that use AltGr for - third register characters are detected and handled. The code - has been tested on French and UK keyboard layouts. - - * msw-proc.c: #if 0'ed remains of threaded code are removed. - - * event-msw.c: Mouse motion was incorrectly counted for a user event. - - * event-msw.c: lisp variables beginnig with w32- are renamed to - begin with mswindows-. - -1997-12-15 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Use it. - (Fcopy_file): Ditto. - - * sysdep.c (interruptible_open): New function. - -1997-12-16 Kyle Jones - - * frame-x.c (x_init_frame_2): Don't call - update_frame_title. Some modeline specs depend on - f->device->selected_frame being non-nil and that will - not be true during initialization of the first frame on - a device. - -1997-12-16 SL Baur - - * fileio.c: clean up paren levels between ifdefs. - From Hrvoje Niksic - -1997-12-15 P. E. Jareth Hein - - * glyphs-x.c (imagick_instantiate): Remove an assumption that - all machines have LSB XImage support. - -1997-12-14 Kyle Jones - - * Makefile.in.in: Moved $(OFFIX_O) from x_objs to - X11_objs to avoid having its initialized global - variables be dumped read-only. - -1997-12-14 SL Baur - - * offix.c (DndSetData): Use standard INT_MAX instead of MAXINT. - Replace with - -1997-12-13 Kirill M. Katsnelson - - * msw-proc.c: added emulation for middle mouse button by chording - left and right buttons - * event-msw.c: added lisp variables for resize behavior and middle - button emulation thresholds - * msw-proc.c: {un}map-frame-hook now are not called directly from - the window procedure, rather from magic event handler. - * Formulated golden rule for calling lisp from window procedure: - "NOOOOOO!". May be violated under circumstances although. - * frame-msw.c: corrected problem with setting frame width and height - properties, introduced by 95-style look. - -1997-12-12 SL Baur - - * input-method-xlib.c (describe_XIC): Add casts, use unsigned long - int. - - * eval.c (funcall_subr): Ifdef out as it is now unused. - - * emacsfns.h: Declare Fdisplay_error. - - * callint.c (Fquote_maybe): Don't use `==' on Lisp_Objects. - -1997-12-12 Michael Sperber - - * fileio.c: Removed stillborn set-buffer-modtime. - -1997-12-10 Hrvoje Niksic - - * elhash.c (hashtable_instantiate): If SIZE is nil, set it to - length of DATA. - (print_hashtable): Would bogusly print #(hashtable). - (verify_function): Use XCAR. - -1997-12-12 Hrvoje Niksic - - * elhash.c (print_hashtable_data_mapper): Use a C structure - instead of consing. - -1997-12-12 Hrvoje Niksic - - * callint.c (quotify_arg): Don't quotify vectors, keywords, - bit-vectors and lambdas. - (Fquote_maybe): New subr, from quotify_arg. - (quotify_args): Use it. - (Fcall_interactively): Ditto. - -1997-12-11 Hrvoje Niksic - - * window.c (Fset_window_point): Ditto for Fgoto_char. - (Fset_window_configuration): Ditto. - - * undo.c (Fprimitive_undo): Ditto for Fset_buffer_modified_p, - Fgoto_char and Fdelete_region. - - * print.c (temp_output_buffer_setup): Ditto. - - * glyphs.c (make_string_from_file): Ditto. - - * glyphs-x.c (pixmap_to_lisp_data): Ditto for Ferase_buffer. - (pixmap_to_lisp_data): Ditto for Fbuffer_substring. - - * bytecode.c (Fbyte_code): Use Qnil instead of Fcurrent_buffer() - when calling functions that use decode_buffer() internally -- it - is faster. - - Change done for Fgoto_char, Fchar_after, Ffollowing_char, - Fpreceding_char, Findent_to, Feolp, Feobp, Fbolp, Fbobp, - Fforward_char, Fforward_word, Fskip_chars_forward, - Fskip_chars_backward, Fforward_line, Fbuffer_substring, - Fdelete_region, Fnarrow_to_region, Fwiden, Fend_of_line, Fupcase - and Fdowncase. - -1997-12-11 Jonathan Harris , Kirill M. Katsnelson - - * The first collegial patch in the xemacs-nt history. Well... - * device-msw.c, event-msw.c, event-msw.h, frame-msw.c, msw-proc.c: - xemacs is now single-threaded application. Due to this, the - problem with crash during input events in GC got resolved. - * xemacs frames are given "95ish" look with raised border. - * stop character (ctrl+g) now works. SIGINT (ctrl+c or ctrl+break - at the console) is still broken although. - * frame "as lisp object" is now stored in window-associated space - provided by the system. This enables obtaining frame object given - window handle in constant time. - * mswindows_cancel_dispatch_event() now has limited handling - for key_press_event's in addition to timeout_event's. - -1997-12-11 SL Baur - - * intl.c (init_intl_very_early): Force LC_NUMERIC to "C". - * input-method-xfs.c (Initialize_Locale): Ditto. - * input-method-motif.c (Initialize_Locale): Ditto. - * input-method-xlib.c (Initialize_Locale): Ditto. - Suggested by Didier Verna and - Martin Buchholz - -1997-12-10 Karl M. Hegbloom - - * config.h.in: #undef MAGICK_HEADERS_ARE_UNDER_X11 - - * glyphs-x.c: #ifdef MAGICK_HEADERS_ARE_UNDER_X11 added. - -1997-12-11 SL Baur - - * glyphs-x.c (_XOS_H_): Try to avoid including Xos.h on Solaris. - Suggested by Samuel Tardieu - -1997-12-11 David Hobley - - * pure.c: Removed WINDOWSNT conditional. - -1997-12-10 SL Baur - - * Makefile.in.in: Doc changes, update dependencies. - - * frame-x.c (x_init_frame_1): Remove unused variable. - - * fns.c (internal_equal): Guard label with ifdef. - (internal_old_equal): Ditto. - - * symsinit.h: Declare structure_type_create_hashtable. - - * elhash.c (finish_marking_weak_hashtables): Move unused variable - so gcc doesn't complain about it. - - * elhash.h: Declare new weak hashtables. - - * elhash.c (print_hashtable): Fix format. - -1997-12-10 Hrvoje Niksic - - * frame-tty.c (tty_raise_frame_no_select): Use LIST_LOOP. - (tty_lower_frame): Ditto. - - * faces.c (face_validate): Don't check for doubly defined - keywords; the reader does that. - - * emacs.c (main_1): Call structure_type_create_hashtable(). - - * general.c (syms_of_general): Added Qtest and Qsize. - - * elhash.c (structure_type_create_hashtable): New function. - (hashtable_type_validate): Ditto. - (hashtable_test_validate): Ditto. - (hashtable_size_validate): Ditto. - (hashtable_data_validate): Ditto. - (hashtable_instantiate): Ditto. - - * extents.c (extent_putprop): Made it work. - (extent_remprop): Ditto. - -1997-12-08 Kirill M. Katsnelson - - * device.h: device::fdin and device::fdout are now defined for - systems which do not HAVE_UNIXOID_EVENT_LOOP. - * device-tty.c, process.c, signal.c: call to signal_fake_event() - bracketed out by #ifdef HAVE_UNIXOID_EVENT_LOOP / #endif - directives. - * signal.c: For Win32 systems, longjmp in signal handler excluded - * nt.c, syssignal.h, systime.h: emulation for SIGALRM and SIGPROF - and setitimer for Win32 platforms. Profiling now works. - * emacs.c: calls to syms_of_profile and vars_of_profile enabled - on Win32 platforms. - * ntproc.c: handling of SIGCHLD now done by the common signal - faking mechanism. (To no avail - subprocesses still broken) - * s/windowsnt.h: Signal constants added - * redisplay-msw.c: "Sticky" beep which blocked XEmacs until the - sound finishes is now repaired - -1997-12-06 Jonathan Harris - - * frame-msw.c, msw-proc.c - Further changes to resizing code so that changing default - font, either in .emacs or later, works properly. - - * msw-proc.c - Minor optimization: Mouse movement events aren't generated - while the user is resizing the frame. - Function keys are returned lower-case. - -1997-12-09 P. E. Jareth Hein - - * glyphs-x.c (imagick_instantiate): fix it so that it works - properly for PseudoClass files. Still needs some thinking for - full color... Also added support for old image instantiators - in various places using the OLDCOMPAT define - -1997-12-08 Kyle Jones - - * event-stream.c (Faccelerate_menu): Check for the - existence of a menubar associated with the selected frame - before trying to use it. Signal an error if there is - no menubar. - -1997-12-06 P E Jareth Hein - - * device-x.c: Change -privcmap to -privatecolormap. - * events.c: corret minor think-o. - -1997-12-04 Jonathon Harris - - * event-msw.c, faces.c, msw-proc.c: - Frame resizing happens in multiples of the default character size. - * frame-msw.c: - mswindows_set_frame_size() and - mswindows_set_frame_properties() now call AdjustWindowRect to - set the correct window size. - -1997-12-04 Jeff Sparkes - - * frame-msw.c: added frame functions for move, resize, - iconify, raise, lower, visible_p, iconified_p, focus, - make visible, make invisible, set title. - -1997-12-01 Jonathon Harris - - * event-msw.c, event-msw.h, frame-msw.c, msw-proc.c: - - Implemeted simple emacs_mswindows_event_pending_p(). - - Fixed deleting frames. - - Rewrote timeout code, eliminating "!NILP(rest)" bug. - - Special processing for 'Ctrl-@' keystroke. - - Support for some new keysyms. - -1997-12-03 Hrvoje Niksic - - * lstream.c (make_stdio_stream_1): Set it. - (make_filedesc_stream_1): Ditto. - (finalize_lstream): Use it. - - * lstream.h: New flag LSTREAM_FL_CLOSE_AT_DISKSAVE. - -1997-11-29 Jeff Miller - - * menubar-x.c: define restore_in_menu_callback() when motif - menubars are used. - - * menubar-x.c: change #ifdef LWLIB_MENUBARS_MOTIF to - #if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF - around code for incremental menu build. - - * event-stream.c: Changed HAVE_MENUBARS to HAVE_MENUBARS_LUCID in - the #ifdef wrappers around menubar accelerator stuff. - -1997-12-05 SL Baur - - * keymap.h: update describe_map_tree prototype - -1997-12-03 Hrvoje Niksic - - * lstream.c (make_stdio_stream_1): Set it. - (make_filedesc_stream_1): Ditto. - (finalize_lstream): Use it. - - * lstream.h: New flag LSTREAM_FL_CLOSE_AT_DISKSAVE. - -1997-12-03 Hrvoje Niksic - - * editfns.c (save_excursion_restore): Fix comment. - - * fns.c (Fmapvector): GCPRO the vector. - -1997-12-01 Hrvoje Niksic - - * cmdloop.c (default_error_handler): Respect - errors-deactivate-region; use display-error. - - * editfns.c (vars_of_editfns): New variable user-full-name. - (init_editfns): Initialize it. - (Fuser_full_name): Use it. - (vars_of_editfns): Docfixes. - - * dired.c (Fdirectory_files): Use FORMAT_FILENAME instead of - FORMAT_BINARY. - (make_directory_hash_table): Ditto. - (file_name_completion): Bind `completion-ignore-case' to t under - MS Windows. - (file_name_completion): Signal an error if a member of - `completion-ignored-extensions' is not a string. - -1997-11-30 Hrvoje Niksic - - * doc.c (Fsubstitute_command_keys): Don't use - Vprin1_to_string_buffer. - - * keymap.c (describe_map_tree): Accept a BUFFER argument. - (describe_map): Ditto. - (describe_command): Ditto. - -1997-11-29 Hrvoje Niksic - - * insdel.c (signal_before_change): Don't treat - Vprin1_to_string_buffer specially. - (signal_after_change): Ditto. - - * buffer.c (Fkill_buffer): Don't treat Vprin1_to_string_buffer - specially. - (complex_vars_of_buffer): Ditto. - - * print.c (Ferror_message_string): Use Vprin1_to_string_stream. - - * events.c (Fmake_event): Changed error message. - - * print.c (Fprin1_to_string): Use a resizing-buffer stream. - -1997-12-03 Hrvoje Niksic - - * buffer.c (Fkill_buffer): Use EXTERNAL_LIST_LOOP. - (Fget_file_buffer): Use LIST_LOOP. - -1997-12-02 Hrvoje Niksic - - * editfns.c (save_excursion_save): Don't save VISIBLE-P. - (save_excursion_restore): Changed accordingly. - (save_excursion_restore): Free the markers and conses even if the - buffer is dead. - (save_restriction_restore): Use XCAR/XCDR. - (Fencode_time): Use XCAR/XCDR, when safe. - - * menubar.c (Fnormalize_menu_item_name): Use INC_CHARPTR; allow - `%%' to mean `%'. - - * minibuf.c (regexp_ignore_completion_p): Use EXTERNAL_LIST_LOOP; - check type of list elements. - - * dired.c (file_name_completion): Set up a proper unwind form. - (file_name_completion_unwind): New function. - (file_name_completion): Allow errors. - - * line-number.c (invalidate_line_number_cache): Would lose in - precence of Finsert_before_markers. - (narrow_line_number_cache): Only mark LINE_NUMBER_BEGV as dirty. - (buffer_line_number): Recalculate LINE_NUMBER_BEGV on demand. - (buffer_line_number): Would ignore LINE_NUMBER_FAR. - -1997-12-01 Hrvoje Niksic - - * fns.c (Fmapvector): Don't stack-allocate args; allocate the - vector and call mapcar1 with its data. - -1997-12-02 P E Jareth Hein - - * objects-x.c: Added colormap/visual support, rewrote - allocate_nearest_color, and changed the x-color-instance to deal - with possibly not freeing a color. - - * objects-x.h: Added dealloc_on_gc flag for x-color-instances. - - * redisplay-x.c: Added colormap/visual support. - - * balloon-x.c: Added colormap/visual support. - - * console-x.h: Added colormap/visual support by adding visual, - depth and colormap slots to a device. - - * device-x.c: Added colormap/visual support with the command line - options "-privcmap" and "-visual" and Xresources - ".privateColormap" and ".EmacsVisual". Also changed the - device-init so that the app-shell is always realized to properly - deal with GCs (previously only realized when OFFIX was - supported), and added the x-display-visual-depth lisp function to - complement x-display-visual-class. - - * event-Xt.c: Added colormap/visual support, and stuck in a - patch/hack to change the way Xt inherits visuals to match the way - it inherits colormaps. - - * frame-x.c: Added colormap/visual support. - - * glyphs-x.c: Added colormap/visual support. Will probably need a - lot more work. - -1997-11-27 Kyle Jones - - * src/keymap.c (munging_key_map_event_binding): Don't do - the meta char hack when processing key-translation-map. - Return nil if the map to be processed (function-key-map - or key-translation-map) is not a keymap. - -1997-11-27 SL Baur - - * device-msw.c: Turn on italic flag if appropriate - * objects-msw.c: Set device-class to color. - From Jeff Sparkes - - * glyphs-x.c: Should include since that is what - is autodetected by configure. - -1997-11-26 SL Baur - - * events.c (Fmake_event): correct type bug. - From Colin Rafferty - -1997-11-26 Kyle Jones - - * lisp-disunion.h (VALMASK): Use 1UL instead of 1L to - shut up Sun's niggling compiler warnings about integer - overflow. - - * print.c (Fprin1_to_string): Don't change and - restore the current buffer; no buffer change is needed - to accomplish the task. - -1997-11-23 Jeff Miller - - * Makefile.in.in removed energize support - * buffer.c removed energize support - * config.h.in removed energize support - * console-x.h removed energize support - * doc.c removed energize support - * emacs.c removed energize support - * extents.c removed energize support - * extents.h removed energize support - * frame-x.c removed energize support - * gui-x.c removed energize support - * menubar-x.c removed energize support - * process.c removed energize support - * puresize.h removed energize support - * symsinit.h removed energize support - * sysproc.h removed energize support - * syssignal.h removed energize support - * undo.c removed energize support - * window.c removed energize support - - * energize.c removed - * energize.h removed - -1997-11-23 Kyle Jones - - * faces.c (face_property_was_changed): Don't call - update_faces_inheritance, it isn't needed. - -1997-11-22 Kyle Jones - - * redisplay-x.c (x_flash): Flash the root window - area instead of the entire frame area. - - * frame.h: Added echo_area_garbaged field to frame - struct. - - * frame.c (change_frame_size_1): Set the - echo_area_garbaged flag in a frame that has been - resized. - - * redisplay.c (redisplay_frame): Clear echo_area_garbaged - flag on frame after displaying the frame. - - (Fredisplay_echo_area): Clear echo_area_garbaged - flag on frame after displaying in echo area. - - * redisplay.c: Added hscroll_glyph_width_adjust field - to position_redisplay_data_type struct. - - (add_hscroll_rune): Compute the difference in width - between the hscroll glyph and a canonical space; store - it in data->hscroll_glyph_width_adjust. - - (create_text_block): In tab field computation, adjust - left margin to account for the difference between the - width of the hscroll glyph and the width of a canonical - space. - -1997-11-19 Kyle Jones - - * Emacs.ad: Change uses of Gray75 to Gray80. - Don't set modeline colors here. - - * EmacsFrame.c: Fetch "background" resource for use by - the toolbar initialization code; default this fetched - value to -1 if it is unspecified, which is different - from what is found in ef->core.background_pixel in that - case. - - * EmacsFrame.h: Define macros for "Background" and - "background" resource strings. - - * EmacsFrameP.h: Added background_pixel field to - EmascFrmaePart struct. - - * toolbar-x.c (x_initialize_frame_toolbar_gcs): Added - code to use the global background resource as the - toolbar background color if it is sepcified. Otherwise - fall back to the backgroundToolBarColor resource. - -1997-11-17 Marc Paquette - - * callproc.c (Fcall_process_internal): Fix for bug in - CRLF -> LF conversion. - -1997-11-19 Jonathan Harris - - * redisplay-msw.c: Calls GdiFlush() in _ouput_end, _clear_frame and - _redraw_exposed_area - - * frame-msw.c: mswindows_init_frame_2 - Sets frame's pixel width and height - -1997-11-19 Kyle Jones - - * callproc.c (call_process_cleanup): Actaully wait - for the process, rather than not doing it and saying we - did. - -1997-11-20 Hrvoje Niksic - - * callproc.c (Fcall_process_internal): Close fd_error. - -1997-11-19 Didier Verna - - * emacs.c (main_1): Added the missing argmatch call to check - for the '-h' option. - -1997-11-18 SL Baur - - * mule-coding.h: Replace freshly broken ENCODE_SJIS and - DECODE_SJIS macros with working versions from beta4. - -1997-11-17 Kyle Jones - - * frame-x.c (x_init_frame_1): Set frame visibility - flag to 1 immediately so that echo area message are - displayed in it promptly. - - * redisplay.c (Fredisplay_echo_area): If frame has - changed, clear it to avoid garbled messages. - - * window.c (set_window_pixsize): Restore the bail out - if no size change, but do it after the loop that recomputers - major child corner coordinates. - - * keymap.c (describe_map_mapper): Recognize the - buttonXup keysyms as mouse bindings. - -1997-11-17 Tor Arntsen - - * Makefile.in.in (update-elc.stamp): Add temacs to dependency. - -1997-11-16 Kyle Jones - - * Added suport for toolbar borders. - - * EmacsFrame.c: Added X resources for new toolbar - borders. - - (EmacsFrameSetValues): Added Fadd_spec_to_specifier - calls to move resourced toolbar border width data - into the speciifers. - - * EmacsFrame.h: Defined X resource strings for - toolbar border width resources. - - * EmacsFrameP.h: Added toolbar border width fields - to the EmacsFramePart struct. - - * console.h: Added toolbar_border_width_changed_in_frame_method - field to struct console. - - * events.c (event_x_y_pixel_internal): Factor the - toolbar border into pixel offset. - - * frame.c: Document new toolbar border width - speciifer as being usable as frame properties. - - (frame_conversion_internal): Factor the toolbar border - widths into the geometry calculations. - - (change_frame_size_1): Ditto. - - * frame.h: Added field to struct frame for toolbar - border widths. Modified geomtry macros and created - others in support of the new toolbar border widths. - - * frameslot.h: Added a default_toolbar_border_width - slot. - - * redisplay-x.c (x_clear_frame): Factor the toolbar - border widths into the geometry calculations. - - * toolbar-x.c (x_draw_blank_toolbar_button): Add - support for drawing a border along with the blank - button. Accept border_width and vertical args. - - (x_output_toolbar_button): Added support for drawing a - border along with the button. - - (X_OUTPUT_BUTTONS_LOOP): Pass border_width and vert - args to x_draw_blank_toolbar_button. Set vertical and - border_width fields in toolbar button. - - (x_output_toolbar): Support toolbar border widths. - - (x_toolbar_size_changed_in_frame_1): Mark all toolbar - buttons in the change toolbar as dirty so that they - are refreshed if had been painted over. - - New function: x_toolbar_border_width_changed_in_frame. - Used it as a console method. - - * toolbar.c: New function: mark_frame_toolbar_buttons_dirty. - - New function: toolbar_border_width_changed_in_frame. - Used it as a specifier frame slot change method. - - (get_toolbar_coords): Factor the toolbar border - widths into the geometry calculations. - - (Fset_default_toolbar_position): Update the fallback - border width specifiers for the affected toolbar - positions. - - (specifier_vars_of_toolbar): Added specifiers for the - toolbar border widths. - - * toolbar.h: Added vertical and border_width field - to the toolbar button struct. - - * window.h: Added default_toolbar_border_width slot - to window struct, along with four slots for the four - window local toolbar border width values. - -1997-11-16 Kyle Jones - - * frame-x.c: Fixed typo in the documentation of the - top-toolbar-shadow-color frame property. - -1997-11-16 Skip Montanaro - - * redisplay.c: suppress buffer computation in several places if - MULE is not defined. - -1997-11-16 Hrvoje Niksic - - * events.c (print_event): Use `event-x-pixel' and `event-y-pixel', - to be consistent with `make-event' and `event-properties'. - (Fmake_event): Allow nil dnd-data. - -1997-11-15 Jonathan Harris - - * console.h - mswindows is now a window-system according to - CONSOLE_TYPESYM_WIN_P - - * device.msw.c - Now calls init_baud_rate & init_one_device - - * msw-proc.c - Fixed C-key so key is returned unshifted - - * redisplay-msw.c - Modeline and vertical divider appearance tweaks - - -1997-11-14 SL Baur - - * console.c (Fsuspend_emacs): Fix docstring. Evaluating - `suspend-hook' cannot stop suspension. - -1997-11-14 Marc Paquette - - * callproc.c (Fcall_process_internal): Do CRLF -> LF - conversion when reading process output. - -1997-11-14 Hrvoje Niksic - - * redisplay.c (init_redisplay): Handle not having DISPLAY and not - having TTY support. - -1997-11-14 Hrvoje Niksic - - * events.c (Fmake_event): Support DND events. - -1997-11-10 Hrvoje Niksic - - * events.c (Fmake_event): Reenable the event creation code. - (Fmake_event): Canonicalize the plist. - -1997-11-13 SL Baur - - * mule-charset.c (Fcharset_id): Typecast result to Lisp_Object. - - * mule-ccl.c (CCL_WRITE_STRING): Reorder parens to avoid compiler - barf on Lisp_Object. - (Fregister_ccl_program): Remove unused variable idx. - - * mule-canna.c: Fix declaration of mule_strlen(). - - * mule-coding.h (ENCODE_SJIS): Parenthesize first two params to - avoid compilation problems. - -1997-11-13 Olivier Galibert - - * mule-charset.h: Added preliminary support for charset Ids. - - * mule-charset.c: Added preliminary support for charset Ids. - - * redisplay-msw.c (separate_textual_runs): Synched with FSF 20.2 - ccl API. - - * redisplay-x.c (separate_textual_runs): Synched with FSF 20.2 ccl - API. - - * mule-coding.c: Synched with FSF 20.2 ccl API. - - * mule-coding.h: Moved ccl part to mule-ccl.h. - - * mule-ccl.c: Synched with FSF 20.2. - - * mule-ccl.h: New file. - -Thu Nov 13 21:34:13 1997 Marc Paquette - - * nt.c (REG_ROOT): Use a registry key different that the one for - NTEmacs. - -1997-11-12 SL Baur - - * lrecord.h: Fix typo in set_lheader_implementation. - From: Robert Pluim - -1997-11-13 Olivier Galibert - - * configure.in: Remove HAVE_TIMEZONE_DECL test. - -1997-11-13 Olivier Galibert - - * s/freebsd.h: Remove HAVE_TIMEZONE_DECL forced value. - - * config.h.in: Remove HAVE_TIMEZONE_DECL reference. - - * systime.h: Remove timezone conditional declaration. - -1997-11-12 Kyle Jones - - * console.c: Use symbol_value_forward_lheader_initializer - in various DEFVAR* macros. Forgot this in previous - related patch. - - * lisp-disunion.h: Provide a no-op XUNMARK macro for - the GC error checking code even if GCMARKBITS is not - greater than 0. - - * lisp-union.h: Ditto. - -1997-11-10 Hrvoje Niksic - - * event-stream.c: Make echo_keystrokes a Lisp_Object. - (maybe_echo_keys): Adapt to that. - -1997-11-11 SL Baur - - * eval.c (throw_or_bomb_out): Remove abort. - Suggested by: Kyle Jones - -1997-11-11 Kyle Jones - - * Added support for referencing lrecord_implementations - via an index in an lrecord_header rather than a raw - pointer. Also added a mark bit and a pure bit. - - * alloc.c: Made lrecord_type_index() and - lrecord_implementations_table[] global, previously they - were static. Used new XRECORD_LHEADER_IMPLEMENTATION - and LHEADER_IMPLEMENTATION macros to access - lrecord_implementations found in Lisp_Objects and - lrecord_headers instead of referencing ->implementation. - - (gc_record_type_p): For USE_INDEXED_LRECORD_IMPLEMENTATION, - there's no need to check for equality to type or type + 1. - lrecords are no longer marked by incrementing the - implementation pointer. - - (init_alloc_once_early): Initialized subr and - symbol_value_forward lrecord indexes early so that the - staticly defined subrs and symbol_value_forward object - indexes match the lrecord_implementations_table. - - * buffer.c: Used symbol_value_forward_lheader_initializer in - various DEFVAR* macros. Used new XRECORD_LHEADER_IMPLEMENTATION - macro. - - * elhash.c: Used new XRECORD_LHEADER_IMPLEMENTATION - macro. - - * fns.c: Used new XRECORD_LHEADER_IMPLEMENTATION macro. - - * lisp.h: Defined subr_lheader_initializer macro, used it in - DEFUN macro. - - * lrecord.h: For USE_INDEXED_LRECORD_IMPLEMENTATION, - changed lrecord_header to contain an index into - lrecord_implementations_table[], plus a mark bit and a pure - bit. Added support code for this. Defined new - XRECORD_LHEADER_IMPLEMENTATION and LHEADER_IMPLEMENTATION - macros to be used to find the lrecord_implementation - of a Lisp_Object. - - * print.c: Used new XRECORD_LHEADER_IMPLEMENTATION and - LHEADER_IMPLEMENTATION macros. - - * symbols.c: Used symbol_value_forward_lheader_initializer in - definition of guts_of_unbound_marker. - - * symeval.h: Defined symbol_value_forward_lheader_initializer - macro. Used symbol_value_forward_lheader_initializer in various - macros. Used new XRECORD_LHEADER_IMPLEMENTATION macro. - - -1997-11-10 SL Baur - - * window.c (set_window_pixsize): Remove unused variable. - - * extents.c (print_extent_1): Fix type check error in sprintf. - - * doc.c (Fsnarf_documentation): Remove unused label weird_function. - - * symsinit.h: Restore declaration of vars_of_dialog_x. - - * database.c (Fopen_database): Fix unused variable message. - - * sysdep.c (sys_subshell): vfork() is a demented, obsolete hack. - - * offix.c (struct): Make ImageData, MaskData be unsigned char *. - - * event-Xt.c (x_event_to_emacs_event): Clean up typecasting. - * frame-x.c (Foffix_start_drag_internal): Ditto. - -1997-11-09 Kyle Jones - - * extents.c (print_extent_1): Use %lx instead of %p - to get the same output on all compilers. - -1997-11-09 Hrvoje Niksic - - * line-number.c: Use markers. - - * redisplay.c (window_line_number): Restored. - - * line-number.c (allocate_line_number_cache): Account for - narrowing. - (buffer_line_number): New function. - - * line-number.c (get_nearest_line_number): New function. - (window_line_number): Use it. - (narrow_line_number_cache): New function. - (invalidate_line_number_cache): Ditto. - (insert_invalidate_line_number_cache): Ditto. - (delete_invalidate_line_number_cache): Ditto. - (add_line_number): Ditto. - - * editfns.c (widen_buffer): Update line number cache. - (Fnarrow_to_region): Ditto. - (save_restriction_restore): Ditto. - - * insdel.c (buffer_insert_string_1): Invalidate cache for - insertion. - (buffer_delete_range): Invalidate cache for deletion. - - * line-number.c: New file. - (window_line_number): Moved from redisplay.c. - - * print.c (debug_print): Print a carriage return, too. - - * bufslots.h: New slot `line_number_cache'. - -1997-11-09 Kyle Jones - - * event-stream.c: New Lisp variable: last-command-event-time. - -1997-11-08 SL Baur - - * lread.c (init_lread): start from lisp, not lisp/prim. - - * Makefile.in.in: lisp/prim does exist any more. - -1997-11-07 Kyle Jones - - * abbrev.c (abbrev_lookup): Don't delete dash at the - abbrev start location; abbrev-prefix-mark no longer - inserts one. - -Wed November 05 23:40:00 1997 - - * fileio.c: insert-file-contents-internal - Added a bodge to do CRLF->LF conversion of text files, - conditioned on DOS_NT. This is currently only one-way, so all - text files written by XEmacs will be UNIXified. CRLF conversion - is required to make bytecompile work. - - * Added file headers to: - console-w32.c, console-w32.h, - device-w32.c, event-w32.c, event-w32.h, frame-w32.c, - objects-w32.c, objects-w32.h, redisplay-w32.c, w32-proc.c - -Sun November 01 12:00:00 1997 - - * redisplay-x.c: x_output_vertical_divider: - If HAVE_SCROLLBARS was not defined, coordinate of the right of - the divider was being used unitialised. - - * console.h: Added Qw32 and CONSOLE_W32* macros, conditioned on - HAVE_W32GUI. - - * emacs.c: Added calls to the following, conditioned on HAVE_W32GUI: - syms_of_*_w32, vars_of_*_w32, console_type_create_*w32. - - * event-stream.c: Conditioned on HAVE_W32GUI: - - vars_of_event_stream calls vars_of_event_w32. - - init_event_stream calls init_event_w32_late. - - * events-mod.h: Removed comment about having alternative making - MOD_* constants for different windowing systems. - - * events.c: Conditioned on HAVE_W32GUI: - - event-equal: Added case for w32 magic events. - - event-hash: Added case for w32 magic events. - - * events.h: Conditioned on HAVE_W32GUI: - Added struct underlying_w32_event to magic_data. - - * faces.c: complex_vars_of_faces - Added fallbacks for w32 faces, conditioned on HAVE_W32GUI. - - * frame.c: set-frame-properties - Added reference to default-w32-frame-plist to docstring. - - * general.c: Added new Lisp_Object Qw32 and defsymbol. - - * redisplay-output.c: redisplay_update_line - Conditioned reference to stupid_vertical_scrollbar_drag_hack on - HAVE_X_WINDOWS. This will need a proper fix when w32 gets - scrollbars. - - * redisplay-tty.c: init_tty_for_redisplay - Conditioned blocking and unblocking of SIGTTOU on !WIN32 because - these signals don't exist under win32. - - * redisplay.c: init_redisplay - Initialise window system to w32, conditioned on HAVE_W32GUI. - - * symsinit.h: Added syms_of_*_w32, vars_of_*_w32 and - init_event_w32_late. - - * sysdep.c: Conditioned various things on WIN32 in addition to - MSDOS. - - * New files: - console-w32.c, console-w32.h, - device-w32.c, event-w32.c, event-w32.h, frame-w32.c, - objects-w32.c, objects-w32.h, redisplay-w32.c, w32-proc.c - -1997-11-07 Hrvoje Niksic - - * doc.c (Fdocumentation_property): GCPRO doc. - (Fsubstitute_command_keys): Disallow zero bsize. - -1997-11-06 Hrvoje Niksic - - * events.c (Fevent_modeline_position): Return nil if event is not - over modeline, as the docstring says. - -1997-11-05 Martin Buchholz > - - * s/aix3-1.h: Remove ^L character wich confuses AIX make. - -1997-11-06 Tomasz Cholewo - - * event-stream.c (Fnext_command_event): Document keystroke echoing. - -1997-11-06 Hrvoje Niksic - - * fns.c (Ffeaturep): Use call1, to prevent stack thrashing with - circular lists. - - Update docstring. - -1997-11-06 Kyle Jones - - * frame-x.c (x_delete_frame): Removed code that - blocked the deletion of popup frames. No need for it. - -1997-11-05 SL Baur - - * balloon_help.h: Replace with "xintrinsic.h" - * balloon_help.c: Ditto. - * offix.h: Ditto. - - * mule-coding.c (coding_system_charset): Add prototype. - -1997-11-04 Kazuyuki IENAGA - - * s/freebsd.h: Add HAVE_TIMEZONE_DECL. Configure will fail at - checking for the existence of `extern long timezone'. - FreeBSD actualy has the `timezone', but due to its and - , it cannot be recognized by configure. - -1997-11-03 Hrvoje Niksic - - * data.c (Fsubr_interactive): New function. - -1997-11-03 Kyle Jones - - * frame.c (change_frame_size_1): Added explanatory - comment. - - * window.c (set_window_pixsize): Don't bail out - before looping over the major children if there is no - size change indicated. The top and left coordinates - may need to be recomputed, e.g. in toolbar visibility - updates. - -1997-11-02 Kyle Jones - - * fileio.c (Ffile_truename): Make the errno == EACCES case - behave the same as errno == ENOENT. - -1997-11-03 Kyle Jones - - * frame.c (Fframe_property, Fframe_properties): Check - for minibuffer-onlyness of frame before checking whether - it has a minibuffer. This makes the minibuffer property - value be reported as 'only when that is appropriate. The - check order was reversed which resulted in minibuffer-only - frames having the minibuffer property reported as t. - -1997-11-02 Andreas Jaeger - - * m/vax.h: - * s/cxux.h: - * s/xenix.h: - * s/umax.h: - * s/msdos.h: - * s/template.h: - * termcap.c: - * signal.c: - * lread.c: - * callproc.c - * buffer.c: Remove VMS dependent code. - -1997-11-02 Andreas Jaeger - - * syspwd.h: - * systty.h: - * systime.h: - * syssignal.h: - * sysproc.h: - * sysfloat.h: - * sysfile.h: - * regex.h: - * process.h: - * ndir.h: - * mule-mcpath.h: - * getpagesize.h: - * sysdep.h: - * fileio.c: - * process.c: Remove old VMS code. - -1997-11-02 SL Baur - - * glyphs-x.c: Use instead of - -1997-11-02 Andreas Jaeger - - * sysdep.c: - * getloadavg.c: - * malloc.c: Remove old VMS code. - -1997-11-02 Hrvoje Niksic - - * database.c (print_database): Don't use a static buffer to store - file name. - - * dired.c (make_directory_hash_table): Ditto. - - * fileio.c (Ffile_truename): Use `make_ext_string' instead of - `make_string'. - -1997-11-01 Hrvoje Niksic - - * database.c (CONCHECK_DATABASE): Define. - - * dired.c (Fdirectory_files): Use `make_ext_string' instead of - `make_string', to avoid crashes under Mule. - (file_name_completion): Use `make_ext_string'. - - * database.c (new_database): Renamed to `allocate_database', as - per coding conventions. - -1997-11-02 Andreas Jaeger - - * dired.c: Remove VMS dependent code. - -1997-11-01 Kyle Jones - - * buffer.h: Change XCHAR_OR_CHAR_INT to use XCHAR or - XINT as appropriate instead of using XREALINT. - - * regex.c (re_search_2): cast translate[*d] to - unsigned char when indexing fastmap to avoid sign - change when value has the 0x80 bit set. - -1997-10-31 SL Baur - - * linuxplay.c (audio_init): Update for newer Linux kernels. - From Robert Bihlmeyer - -1997-11-01 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Fix misleading - comment. - -1997-10-31 Kyle Jones - - * callproc.c: GC protect current_dir while infile and - error_file are being initialized. - -1997-10-30 SL Baur - - * config.h.in: Remove HAVE_GIF, HAVE_JPEG, HAVE_PNG, HAVE_TIFF and - replace with HAVE_IMAGEMAGICK. - -1997-10-30 Kyle Jones - - * process.c (Fprocess_send_string): Protect against - SIGPIPE when flushing outstream. - -1997-10-30 SL Baur - - * input-method-xfs.c: Xlocale.h must be included after config.h. - * input-method-motif.c: ditto. - * input-method-xlib.c: ditto. - -1997-10-28 Kyle Jones - - * Under LRECORD_VECTOR, moved vectors from being an basic - lrecord tpye to an lcrecord. - Added support for 31 bits Lisp integers. - Added support for maskless pointers to Lisp objects. - - * alloc.c - - (allocate_lisp_storage): Use XSETOBJ instead of - XSETCONS to avoid tripping the ERROR_CHECK_TYPECHECK - code with uninitialized data. XSETCONS used to work - until it became an lrecord type. - - Removed sweep_vectors_1, all_vectors and other vector - specific GC related objects in the LRECORD_VECTOR - case, as they are unneeded now that lrecord-based - vectors are lcrecords. - - Added `equal' methods for lrecord-based conses, vectors - and strings. I was mistaken before; they are needed. - - (pure_cons): moved XSETCONS call to after the - set_lheader_implementation call, to avoid tripping the - type checking code on an uninitialized implementation - pointer. - - (make_pure_vector): moved XSETVECTOR call to after the - set_lheader_implementation call, to avoid tripping the - type checking code on an uninitialized implementation - pointer. - - (Fpurecopy): return if given a null pointer. THis can - happen when initializing Qnil. - - (mark_object): return if passed a null pointer. I - think this can happen when marking through some kind of - objects that contain Lisp_Objects and null pointers. - - (marked_p): Ditto - - * buffer.c - - (mark_buffer): Don't mark conses in the indirect children - list is said list is in fact a null pointer. The - indirect children list gets reset to a null pointer - when a bfufer is killed. - - (complex_vars_of_buffer): initialize indirect_children - slow of Vbuffer_local_symbols and Vbuffer_defaults to - nil. - - * chartab.c - - (Fcheck_category_at): Don't use XREALINT to extract a - char from a Lisp_Object, use XCHAR instead. - - (Fchar_in_category): Ditto. - - * data.c - - (eq_with_ebola_notice): Use XCHAR_OR_INT instead of - XREALINT to extract data from a Lisp_Object that could - contain a charater or an integer. - - (make_int): use XSETINT in the USE_MINIMAL_TAGBITS - case. - - (make_char): use XSETINT in the USE_MINIMAL_TAGBITS - case. - - (Flsh): XUINT is gone; use XINT instead. - - * elhash.c - - (elisp_hvector_malloc): Use Qnull_pointer instead of - Qzero, as Qzero is no longer guaranteed to contain an - all-zero bit pattern. - - (make_lisp_hashtable): Ditto. - - (Fcopy_hashtable): Ditto. - - * emacsfns.h - - Conditionalize the declaration of make_char() on - whether a make_char macro exists or not. - - * fns.c - - (internal_equal): Conditionalize existence of cons, - string and vector comparison code on whether they are - lrecord-based. - - (internal_old_equal): Ditto. - - * lisp-disunion.h - - USE_MINIMAL_TAGBITS support. - - 31 bit Lisp integer support. - - Conditionalized existence of markbit related macros on - the existence of a markbit in a Lisp_Object. There are - no markbits in the USE_MINIMAL_TAGBITS implementation - of a Lisp_Object. - - Replaced XUINT with XPNTRVAL. - - Added declaration for Qnull_pointer. - - * lisp-union.h - - USE_MINIMAL_TAGBITS support. - - 31 bit Lisp integer support. - - Conditionalized existence of markbit related macros on - the existence of a markbit in a Lisp_Object. There are - no markbits in the USE_MINIMAL_TAGBITS implementation - of a Lisp_Object. - - Replaced XUINT with XPNTRVAL. - - Added a make_char macro, similar to the make_int - macro, for use with the GCC-specific XMAKE_LISP hack. - - * lisp.h - - USE_MINIMAL_TAGBITS support. - - 31 bit Lisp integer support. - - Added GCMARKBITS macro to specify how many markbits a - Lisp_Object contains. - - Support for lcrecord-based vectors. - - Added XCHAR_OR_INT for accessing data in an object - that might contain either a character or an integer. - - Made HACKEQ_UNSAFE use XCHAR_OR_INT instead of - XREALINT during its Ebola check. - - * print.c - - Made the printing code undestand the split Lisp integer type. - - * symbols.c - - Added declaration for Qnull_pointer. - -1997-10-27 Martin Buchholz - - * m/ibmrs6000.h: - * s/aix3-2.h: C_SWITCH_SYSTEM ==> configure.in - * s/aix4-1.h: -li18n ==> configure.in - * s/aix4.h: Always include strings.h - * config.h.in: Add AIXV3 define, suggested by xmkmf. Remove - AIX_SMT_EXP. - * unexaix.c: Fix nested comments compiler warning - -1997-10-27 Kyle Jones - - * profile.c (sigprof_handler): Don't call XUNMARK on - fun, it isn't needed. - - * faces.c (face_property_matching_instance): Check - for charset == Qunbound, which it can be if the - character set is unspecified. - -1997-10-27 SL Baur - - * mule-wnnfns.c (vars_of_mule_wnn): Provide 'wnn feature. - - * mule-canna.c (vars_of_mule_canna): Provide 'CANNA feature. - -1997-10-27 Kazuyuki IENAGA - - * device-x.c (x_init_device): To avoid crazy menubars due to - lack of suitable font loading. Disabled locale based app-defaults - loading when menubars=motif or menubars=lucid + xfs feature is not - used. Currently, the menubar resource has no effect for tty use. - -1997-10-25 Andreas Jaeger - - * README: Remove references to VMS. - - * vlimit.h: - * s/vms5-5.h: - * s/vms4-4.h: - * s/vms4-2.h: - * s/vms4-0.h: - * s/vms.h: Remove files since VMS isn't supported any more. - -1997-10-25 Kyle Jones - - * toolbar.h: Reduce MINIMUM_SHADOW_THICKNESS to 1. - -1997-10-24 Andreas Jaeger - - * database.c: Added support for Berkeley DB 2.x. - -1997-10-23 SL Baur - - * alloc.c: Disable purespace statistics unless --debug is in - effect. - - * console-stream.c (init_console_stream): At the price of a tiny - memory leak, reinitialize FILE fields of the console. - From Tonny Madsen - - * emacs.c: New variable `inhibit_package_init'. - (vars_of_emacs): Use it. - (main_1): Initialize from command line. - - * Makefile.in.in (xemacs): Specify -vanilla when searching for - shadows. - - * emacs.c: Remove VMS ifdefs. - (standard_args): Added -no-packages, --no-packages. - Added -vanilla, --vanilla. - (Frun_emacs_from_temacs): Guard pure usage report with DEBUG_XEMACS - (Fdump_emacs): Ditto. - -1997-10-22 Hrvoje Niksic - - * fns.c (Ffeaturep): Use `Fcar' with `or'. - -1997-10-22 Kyle Jones - - * alloc.c: drop the Lisp_Type_Record case clause - that I added to the switch statement in a previous - patch. The string, vector and cons cases belong in - the `default' clause with the other lrecord types. - -1997-10-22 Kyle Jones - - * Added support for strings as lrecords. - - * lisp.h: #ifdef'd out Lisp_Type_String enum value - if LRECORD_STRING is defined. - - * alloc.c: Added allocation and garbage collection - code for lrecord-based strings. - - * print.c: move Lisp_String printing code to a - separate function so that it could be used as a - `print' method for lrecord-based strings. - -1997-10-20 Jan Vroonhof - - * extents.c: Renamed shot property to initial-redisplay-function - (extent_fragment_update): Changed the bookkeeping whether an event - has been spawned. The initial-redisplay-function property is no - longer set to nil. - - * extents.h: ditto - -1997-10-20 Kyle Jones - - * Added support for conses and vectors to be lrecords. - - * alloc.c: Modified allocation and GC code for - LRECORD_CONS and LRECORD_VECTOR support. Moved some - macros to lrecord.h. - - * bytecode.c: Warning comment about LRECORD_CONS. - - * elhash.c: Let internal_hash handle vector hashing - if LRECORD_VECTOR is defined, just as it does when - LRECORD_VECTOR is not defined. The code could have - been copied into an `hash' method function but I don't - see any point to it. Added lrecord style marking code - to finish_marking_weak_hashtables. Bracketed code - that groks the non-lrecord method of marking vectors - with #ifdefs. - - * fns.c: Let internal_equal and internal_old_equal - handle vector comparisons when LRECORD_VECTOR is - defined, just as it does when LRECORD_VECTOR is not - defined. The code could have been copied into an - `equal' method function but I don't see any point to - it. - - * lisp.h: Added typecheck macros for LRECORD_CONS - support. LRECORD_VECTOR macros were already present. - - * print.c: New functions print_cons and print_vector - for LRECORD_CONS and LRECORD_VECTOR support. - Some GC protection also added. - - * lrecord.h: Received some macros from alloc.c, so - that they could be used in lisp.h. - -1997-10-20 Hrvoje Niksic - - * fns.c (Ffeaturep): Handle `not' correctly. - - * lread.c (vars_of_lread): Use defsymbol for featurep. - -1997-10-15 Olivier Galibert - - * s/irix5-0.h: Removed -G 0 from LD_SWITCH_SYSTEM. .sbss sections - are supported since unexelfsgi.c upgrade. - -1997-10-16 Kyle Jones - - * lstream.c (Lstream_close): Don't return early if the - closer method reports failure. Doing so caused GC and - memory corruption crashes. - -1997-10-14 Hrvoje Niksic - - * extents.c (Fset_extent_property): Allow `keymap' property to be - set to nil. - -1997-10-15 SL Baur - - * mule-coding.c (acceptable_control_char_p): Add C-_ for info. - (detect_coding_iso2022): Ditto. - From SENDA Shigeya - -1997-10-09 MORIOKA Tomohiko - - * mule-coding.c (make-coding-system, detect-coding-region): Modify - DOC-string because of renaming `automatic-conversion' -> - `undecided' to sync with Emacs 20.2. - - (make-coding-system, coding-system-type, detect-coding-region): - Rename `Qautomatic_conversion' -> `Qundecided'. - - * general.c (syms_of_general): Rename `automatic-conversion' -> - `undecided' to sync with Emacs 20.2. - - * emacsfns.h, event-Xt.c (x_to_emacs_keysym): Rename - `Qautomatic_conversion' -> `Qundecided'. - - * buffer.c (buffer-file-coding-system): Modify DOC-string because - of renaming `automatic-conversion' -> `undecided' to sync with - Emacs 20.2. - -1997-10-15 Olivier Galibert - - * lisp.h (MANY): Bump SUBR_MAX_ARGS to 12 and add corresponding - DEFUN_n macros. - -1997-10-13 Stephen J. Turnbull - - * console-tty.c: Include gpmevent.h - * gpmevent.c (connect_to_gpm): change to void - * gpmevent.h: Ditto. - -1997-10-13 Kyle Jones - - * lisp-disunion.h (XSETOBJ): cast Lisp type enum to - an EMACS_UINT quantity to avoid a compiler warning about - integer overflow when the most significat bit of the - type tag is shifted into the sign bit position of an - EMACS_INT. - -1997-10-12 SL Baur - - * s/freebsd.h: Add X11 guard for building without X11. - From Hrvoje Niksic - -1997-10-12 Kyle Jones - - * doprnt.c (emacs_doprnt_1): if forwarded field width - is negative, set minus_flag and make the field width - positive. Makes (format "%*s" -10 "abc") work like - (format "%-*s" 10 "abc"). - -1997-10-12 SL Baur - - * unexsol2.c (unexec): CONST isn't defined here. - From Adrian Aichner - -1997-10-11 SL Baur - - * realpath.c (realpath): CONST IS LOSING but removing it conflicts - with system headers. - - * callproc.c: New variable infopath-internal. - (complex_vars_of_callproc): Declare and initialized it. - - * paths.h.in: New variable PATH_INFOPATH. - -1997-10-10 Martin Buchholz - - * systty.h: - - change Xemacs --> XEmacs - - * buffer.c: - * editfns.c: - * msdos.c: - - Remove bogus FSF-origin \n\ sequences. - -1997-10-09 Kyle Jones - - * doprnt.c (parse_doprnt_spec): parse `*' field width - and precision specs and set up spec forwarding. - - * doprnt.c (emacs_doprnt_1): implement `*' by - forwarding flags, precision and field width data from a - spec to a subsequent spec. - - * editfns.c: document new `*' field width and - precision spec. - -1997-10-09 SL Baur - - * database.c (Fclose_database): Rename C function. - (Fdatabase_last_error): Ditto. - (Fopen_database): Ditto. - (Fput_database): Ditto. - (Fremove_database): Ditto. - (Fget_database): Ditto. - (syms_of_dbm): Reflect above changes. - From Martin Buchholz - -1997-10-08 Hrvoje Niksic - - * events.c (Fmake_event): Allow only frames as channel. - -1997-10-07 Hrvoje Niksic - - * extents.c (print_extent_1): Fixed typo. - -1997-10-07 Kyle Jones - - * insdel.c (buffer_replace_char): if doing delete/insert - because of characters with deiffering byte lengths,move - point forward with the insertion if it was moved backwrad - to equal the insertion point by the earlier deletion. - -1997-10-06 SL Baur - - * window.c (Fset_window_dedicated_p): register -> REGISTER. - - * unexalpha.c (update_dynamic_symbols): register-> REGISTER. - - * sysdep.c: Global change: register -> REGISTER. - - * strcat.c (strcat): register -> REGISTER. - - * search.c: Global change: register -> REGISTER. - - * regex.c: Global change: register -> REGISTER. - - Ensure REGISTER is always defined. - - * nt.c: Global change: register -> REGISTER. - - * linuxplay.c: Global change: register -> REGISTER. - - * input-method-xlib.c (best_style): register -> REGISTER. - - * gifalloc.c: Global change: register -> REGISTER. - - Ensure REGISTER is always defined. - - * getloadavg.c (getloadavg): register -> REGISTER. - - * eval.c (unwind_to_catch): [Unused variable] register -> REGISTER. - - * cmds.c (Fpoint_at_bol): register -> REGISTER. - - * chartab.c (check_category_char): register -> REGISTER. - - * buffer.c (assoc_ignore_text_properties): [Unused function] - register -> REGISTER. - - * alloca.c: Global change: register -> REGISTER. - - * xmu.h (XmuCopyISOLatin1Lowered): Global change: const -> CONST. - - * gif_lib.h: Global change: const -> CONST. - - * balloon_help.h (balloon_help_move_to_pointer): const -> CONST. - - * xmu.c: Global change: const -> CONST. - - * unexsol2.c (unexec): const -> CONST. - - * unexhp9k3.c (unexec_error): const -> CONST. - - * unexfreebsd.c (unexec_error): const -> CONST. - - * sunOS-fix.c (mbstowcs): const-> CONST. - (wcstombs): Ditto. - - * strcpy.c (strcpy): const -> CONST. - - * strcmp.c: Global change: const -> CONST. - - * strcat.c (strcat): const -> CONST. - - * realpath.c (realpath): const -> CONST. - - * keymap.c (where_is_recursive_mapper): const -> CONST. - - * extents.c (extent_priority_sort_function): const -> CONST. - - * dgif_lib.c (DGifOpenFileName): const -> CONST. - - * balloon_help.c: Global change: const -> CONST. - -1997-10-03 SL Baur - - * lisp.h: Nuke register declarations. - -1997-10-03 Karl M. Hegbloom - - * window.c (Frecenter): Correct variable names in docstring. - -1997-10-03 Karl M. Hegbloom - - * fns.c: Add some cross references between destructive and - non-destructive versions of similar functions. - -Fri Oct 3 12:28:08 1997 Kyle Jones - - * lisp-disunion.h: Move markbit to be between the - type bits and the value bits. Previously it was always - the sign bit of a EMACS_INT, unless modified by a - #define in a machine dependent .h file. - -1997-10-02 Hrvoje Niksic - - * profile.c (Fclear_profiling_info): Made interactive. - -1997-10-02 SL Baur - - * glyphs-x.c (USE_TEMP_FILES_FOR_PNG_IMAGES): Move outside of - HAVE_JPEG ifdef. - -1997-10-01 SL Baur - - * lisp.h (min): Fully parenthize. - (max): Ditto. - - * Makefile.in.in (widget.o): Insert dependencies. - - Insert HAVE_OFFIX_DND dependencies. - - * casefiddle.c (casify_object): Back out bogus undocumented patch - from 20.3-beta18. - -1997-09-30 SL Baur - - * events.c (Fevent_type): Add OffiX guard. - (command_event_p): Ditto. - (mark_event): Ditto. - (print_event): Ditto. - -1997-09-30 SL Baur - - * mule-canna.c (Fcanna_set_bunsetsu): Return a value. - (Fcanna_parse): Remove unused variables `ks' and `ksv'. - (Fcanna_henkan_begin): Remove unused variable `res'. - (Fcanna_henkan_next): Remove unused variable `nbun'. - (count_char): Change return type to void. - - * event-Xt.c (x_event_to_emacs_event): Remove unused variable - `event-size'. - - * menubar.c (Fnormalize_menu_item_name): Remove unused variable - `res'. - - * redisplay-x.c (x_flash): Reorganize test to prefer select over - poll. - - * xselect.c (Fx_store_cutbuffer_internal): Remove unused variable - `encoding'. - -1997-09-30 Hrvoje Niksic - - * frame.c (Fmake_frame): Call `custom-initialize-frame'. - -1997-09-24 MORIOKA Tomohiko - - * mule-coding.c: Rename `pathname-coding-system' to - `file-name-coding-system' to sync with Emacs 20.2. - -1997-09-26 Hrvoje Niksic - - * window.c (saved_window_equal): Ditto. - - * process.c (Fget_process): Use internal_equal. - - * lread.c (build_load_history): Use internal_equal. - (build_load_history): Use XCAR/XCDR where safe. - - * events.c (event_equal): Ditto. - - * event-stream.c (Fdispatch_event): Ditto. - - * elhash.c (lisp_object_eql_equal): Ditto. - (lisp_object_equal_equal): Ditto. - - * device.c (find_device_of_type): Ditto. - - * console.c (find_console_of_type): Ditto. - - * console-tty.c (tty_init_console): Ditto. - - * console-stream.c (stream_init_console): Use internal_equal. - (stream_canonicalize_console_connection): Ditto. - - * fns.c (Fmember): Use internal_equal, to avoid a necessary - funcall and NILP check. - (Fold_member): Ditto for internal_old_equal. - (Fassoc): Use XCAR when we know we deal with a cons. Use - internal_equal. Removed tem. - (Fold_assoc): Ditto. - (Fassq): Use XCAR. - (Frassoc): Use internal_equal; remove tem. - (Fold_rassoc): Ditto for internal_old_equal. - (Frassq): Use XCDR with what we know is a cons. - (Fold_rassq): Ditto. - (Fdelete): Use internal_equal. - (Fold_delete): Ditto for internal_old_equal. - (Fremassoc): Use internal_equal; use XCAR/XCDR with what we know - is a cons. - (Fremrassoc): Ditto. - - * dired.c (Fdirectory_files): Nreverse the list only if it will be - sorted. - -Fri Sep 26 13:55:28 1997 Kyle Jones - - * faces.c (update_face_cachel_data): Don't allow the - background pixmap of the default face to override the - background of a face if that color has been specified. - -1997-09-26 Hrvoje Niksic - - * dired.c (close_directory_fd): New function. - (Fdirectory_files): Use it to set up an unwind-protection to close - the descriptor. - (Fdirectory_files): Allow QUIT in re_search. - (Fdirectory_files): If the file is too big, allocate necessary - data with malloc. - (Fdirectory_files): Use simple Fcons to build the list. - (close_directory_fd): Free the opaque pointer. - -1997-09-25 Hrvoje Niksic - - * extents.c (Fset_extent_properties): New function. - -1997-09-24 SL Baur - - * dired.c (Fdirectory_files): Remove broken VMS stuff. - (file_name_completion_stat): Ditto. - (file_name_completion): Ditto. - (Top Level): Ditto. - (syms_of_dired): Ditto. - -1997-09-25 Hrvoje Niksic - - * widget.c (Fwidget_apply): Don't GCPRO result of Fwidget_get. - -1997-09-24 SL Baur - - * symsinit.h: Declare syms_of_widget. - - * emacsfns.h: Declare Fchar_syntax. - - * bytecode.c (Fbyte_code): Call Fchar_syntax for the Bchar_syntax - bytecode. - - * syntax.c (Fchar_syntax): convert nil input to \000 for - compatibility. - - * alloc.c (report_pure_usage): Increase slop to 512 bytes in betas - and reduce it to 4 bytes in releases. - -1997-09-23 SL Baur - - * Makefile.in.in (objs): Add new C file widget.o. - -1997-09-22 SL Baur - - * editfns.c (vars_of_editfns): New feature 'ampersand-full-name - declared if AMPERSAND_FULL_NAME configuration option is enabled. - - * callproc.c (vars_of_callproc): Update docstring of `data-directory'. - -Sun Sep 21 14:14:44 1997 Kyle Jones - - * lisp.h: underspecify lisp_fn_t function prototype - to avoid compiler errors in inline_funcall_subr(). - - * eval.c (Fprogn): Walk forms list with XCDR, access - with XCAR. Check forms list CONSP, so that XCDR and XCAR are - safe. - - * eval.c (Fsetq): replace Flength call with for-loop - to compute list length. Walk arg list with XCDR, - access with XCAR. Check arg list with CONSP, so that - XCDR and XCAR are safe. - - * eval.c: New macro inline_funcall_subr, an inline - version of funcall_subr + primitive_funcall. - - * eval.c (Feval): replace Flength call with for-loop - to compute list length. Use XCAR and XCDR in some - places where it is safe to do so. Use - inline_funcall_subr() in place of funcall_subr(). - - * eval.c (funcall_recording_as): Use XCAR instead of - Fcar where it was safe. - - * eval.c (Fapply): replace Flength call with for-loop - to compute list length. - - * eval.c (apply_lambda):Use XCAR and XCDR in some - places where it is safe to do so. - - * eval.c (funcall_lambda): Walk param list with XCDR, access - with XCAR. Check param list CONSP, so that XCDR and XCAR are - safe. - - * symbols.c (find_symbol_value): return quickly if no - symbol magic is involved, to avoid the expensive call - to find_symbol_value_1. - - * symbols.c (store_symval_forwarding): don't call - reject_constant_symbols unless there is a chance a - constant symbol is involved. This break the - encapsulation of the constants check, but symbol stores - are used heavily and speed is most important than - cleanliness in this case. - -1997-09-21 Joel Peterson - - * menubar.c (normalize-menu-item-name): New function. - -1997-09-21 SL Baur - - * keymap.c (get_relevant_extent_keymaps): Previous patch reversed. - -1997-09-20 SL Baur - - * Makefile.in.in (xemacs): Adoption of shadow.el to print - load-path shadowings after successful dump. - -1997-09-20 Hrvoje Niksic - - * redisplay.c (scroll_conservatively): New variable. - (redisplay_window): Use it. - -1997-09-16 SL Baur - - * events.c (Fmake_event): Add default case, remove unused variables. - -1997-08-21 Jan Vroonhof - - * extents.c (extent_fragment_update): Trigger one_shot_function - - * extents.c (set-extent-one-shot-function): New function - - * extents.h (struct extent_auxiliary): Added one_shot_function - - * extens.c: Added one_shot_function to assesor functions. - -1997-09-14 Hrvoje Niksic - - * fileio.c (Fexpand_file_name): Don't treat "//" and "~/" in the - middle of path specially. - -1997-09-10 Hrvoje Niksic - - * event-stream.c (inhibit_input_event_recording): New boolean - variable. - (Fnext_event): Use it. - -1997-09-13 Hrvoje Niksic - - * fns.c (Fmapc): Renamed from Fmapc_internal. - -1997-09-10 Hrvoje Niksic - - * database.c (Fmake_database): Expand FILE. - - * redisplay.c (window-system): Warn against using it. - -1997-09-08 SL Baur - - * emacs.c (PACKAGE_PATH): Reverse PACKAGE_PATH. - Suggested by Colin Rafferty - -1997-09-03 SL Baur - - * print.c (print_internal): Special treatment for C-\. - -1997-08-13 P E Jareth Hein - - * insdel.c (buffer_delete_range): Changed the location where point - was actually moved to after all other movement handling. This - prevents a MULE related crash in VALID_BYTIND. - -1997-08-11 SL Baur - - * doc.c (Fsnarf_documentation): Semi-clarify types of weird - functions. - -1997-08-05 Jens-Ulrik Holger Petersen - - * eval.c (vars_of_eval): Updated docstring for `debug_on_error' to - mention `debug-ignored-errors'. - -1997-08-01 SL Baur - - * emacsfns.h: Fix declaration. - - * event-stream.c (syms_of_event_stream): HAVE_MENUBARS not - HAVE_MENUBAR. - -1997-07-31 SL Baur - - * frame-x.c (x_offix_drop_event_handler): Use stderr_out instead - of fprintf. - - * mule-coding.c (parse_iso2022_esc): Add abort() trap on unhandled - condition. - - * mule-wnnfns.c (Fwnn_dict_search): Remove unused variable. - (Fwnn_hindo_update): Ditto. - (Fwnn_inspect): Ditto. - (Fwnn_bunsetu_henkou): Ditto. - - * eval.c (call_with_suspended_errors): Fix Gcc warning: - argument `retval' might be clobbered by `longjmp' or `vfork' - -1997-07-30 SL Baur - - * redisplay.c: `window-system' isn't going away any time soon. - -1997-07-29 SL Baur - - * callint.c (Fcall_interactively): Allow floating point numbers - for `n' and `N' interactive specs. - -1997-07-27 SL Baur - - * event-stream.c (command_builder_find_leaf): Fix typo in - HAVE_MENUBARS. - - * gui-x.c (popup_selection_callback): Fix typo in HAVE_MENUBARS. - - * event-stream.c (syms_of_event_stream): accelerate_menu needed - guards. - - * emacs.c (vars_of_emacs): Main default package directory is now - ${prefix}/lib/xemacs/packages. - -1997-07-25 David Moore - - * alloc.c (Fmake_byte_code): GC protect newly allocated function - when looking up filename. - -1997-07-25 SL Baur - - * Makefile.in.in: Added support for linking with dmalloc. - -1997-07-25 P E Jareth Hein - - * xselect.c (x_atom_to_symbol): Fixed a memory corruption bug - where a possibly MULEified string was getting freed before use. - -1997-07-21 SL Baur - - * callproc.c: New variable Vdata_directory_list. - * emacsfns.h: Declare it. - - * fns.c (Frequire): Undo previous change. - - * print.c (print_internal): Handle circular objects like Emacs - handles them (and as documented in the Lispref). - - * database.c (Fputdatabase): Complain when `val' is not a string. - - * event-stream.c (command_builder_find_leaf): Guard menubar - accelerator stuffs with HAVE_MENUBAR. - * gui-x.c (popup_selection_callback): Ditto. - -1997-07-20 SL Baur - - * event-stream.c (menu_move_up): Guard menubar accelerator code - with HAVE_MENUBARS. - - * emacs.c (decode_path): New function, derived from latter portion - of decode_env_path. - (decode_env_path): Break out the naughty bits -- shouldn't do - getenv and separator parsing in one function. - New variable Vpackage_path. - (vars_of_emacs): Use it. - - * editfns.c (Fstring_to_char): Return nil instead of `0' for empty - string. - -1997-07-10 Hrvoje Niksic - - * fileio.c (Finsert_file_contents_internal): Handle non-regular - files. - -1997-07-12 Steven L Baur - - * Makefile.in.in (LOCK_OBJ): Only include filelock.[co] when - CLASH_DETECTION is defined. - -1997-07-11 Steven L Baur - - * emacs.c (main_1): Spelling fix. - -1997-07-10 Steven L Baur - - * Makefile.in.in (dump-elcs): Shouldn't use SATISFIED hack. - (xemacs-no-site-file): Not supported any more. - (binary): New dependency for dumping XEmacs. - (xemacs): Attempt to be a little smarter about not dumping a new - XEmacs if it is not needed. - (temacs): Remove `xemacs' after success. - -1997-07-09 Hrvoje Niksic - - * extents.c: Allow non-symbol properties of extents. - -1997-07-08 Hrvoje Niksic - - * data.c (Fstring_to_number): Use `check_int_range'. - (Fstring_to_number): Would bug out on wrong type check. - -1997-07-07 Steven L Baur - - * data.c (Fcompiled_function_doc_string): Implement correctly. - Was forgotten cut & paste identical clone to - Fcompiled_function_interactive? - - * Makefile.in.in (alloc.o): Remove dependency on puresize_adjust.h - so alloc.c need not be recompiled when puresize changes. - - * alloc.c (PURIFIED): Use get_PURESIZE() instead of constant. - (check_purespace): Ditto. - (alloc_pure_lrecord): Ditto. - (report_pure_usage): Ditto. - (disksave_object_finalization): Ditto. - (report_pure_usage): Modify message reported when Build is - restarted due to change in PURESIZE_ADJUSTMENT. - - * puresize.h: Remove dependency on puresize_adjust.h. - (get_PURESIZE): New function -- declare it. - - * pure.c: Move final PURESIZE computation and include of - puresize_adjust.h into here so alloc.c need not be recompiled each - time the puresize is adjusted. - (get_PURESIZE): New function. - -1997-07-06 Steven L Baur - - * data.c (Fstring_to_number): Wrong parameter was being checked. - - * emacs.c (vars_of_emacs): Fprovide the system type as a feature. - -1997-07-03 Steven L Baur - - * data.c (Fstring_to_number): Fix typo. base isn't an integer. - -1997-07-01 Steven L Baur - - * data.c, emacsfns.h: This is the port of GNU Emacs capability. - I am still not sure what this buys us, but I guess it doesn't hurt - to have it. - From Hrvoje Niksic - - * glyphs.c (make_string_from_file): Use - insert-file-contents-literally instead of - insert-file-contents-internal. - -1997-06-30 Steven L Baur - - * fns.c (check_losing_bytecode): Correct reported version. - - * Makefile.in.in (${libsrc}DOC): Break up line length for stupid - make programs. - -1997-06-29 Steven L Baur - - * emacsfns.h: Put void in prototype. - Suggested by Ben Wing. - -1997-07-01 MORIOKA Tomohiko - - * glyphs.c (make_string_from_file): must protect from - `format-alist'. - -1997-06-28 Steven L Baur - - * config.h.in: Back out previous change to LOSING_BYTECODE. It's - just not worth it. - -1997-06-27 Mike Scheidler - - * s/sol2.h: Undefined _XOPEN_SOURCE for Solaris 2.4. - -1997-06-28 Hrvoje Niksic - - * abbrev.c (abbrev_match): New function. - (abbrev_oblookup): New function. - (obarray_has_blank_p): New function. - (abbrev_count_case): New function. - (Fexpand_abbrev): Use them. Allow abbreviations to contain - arbitrary characters. - -1997-06-28 Steven L Baur - - * config.h.in: LOSING_BYTECODE will not be compiled into XEmacs. - - * doc.c (Fsnarf_documentation): Remove VMS dependent stuff for - cleanliness. - -1997-06-28 Hrvoje Niksic - - * print.c (Ferror_message_string): Simplify. - -1997-06-27 Steven L Baur - - * symbols.c (Fdefine_function): Correct docstring. - (Fsetplist): Ditto. - (Ffset): Ditto. - (Fsetq_default): Ditto. - -1997-06-27 Hrvoje Niksic - - * eval.c (skip_debugger): Removed comment and #ifdef-ed code. - (signal_call_debugger): Call skip_debugger after wants_debugger. - (signal_call_debugger): Gcpro cons sent to skip_debugger. - -1997-06-26 Steven L Baur - - * process.c (create_process): Default to fork instead of vfork. - - * callproc.c (Fcall_process_internal): Default to fork instead of - vfork. - - * emacsfns.h: Add declarations of Ferror_message_string(), - Frunning_temacs_p(). - - * eval.c: Remove declarations of Ferror_message_string(), - Frunning_temacs_p(). - - * Makefile.in.in (${libsrc}DOC): Correct dependency for the docfile. - (${mo_dir}emacs.po): Remove obsolete references to lisp source. - -1997-06-29 MORIOKA Tomohiko - - * mule-charset.c: Modify charset DOC-strings to be more detailed. - -1997-06-25 Steven L Baur - - * alloc.c (Flist): Optimize. - From Hrvoje Niksic. - -1997-06-23 Steven L Baur - - * lisp.h: Get uintptr_t stuffs because it is needed for including - emacsfns.h. - - * sysdep.h: Removed uintptr_t stuffs. - -1997-06-22 Steven L Baur - - * fns.c (concat): Replace Fcar/Fcdr with XCAR/XCDR. - (Fnreverse): Ditto. - (internal_equal): Ditto. - (internal_old_equal): Ditto. - (Fnconc): Ditto. - (Freverse): Saner implementation. - From Hrvoje Niksic - - * s/linux.h: getpgrp with glibc is now properly detected by - configure. - Suggested by Andreas Jaeger - -1997-06-20 Steven L Baur - - * events.c: Remove declaration of Qempty. - -1997-06-20 Olivier Galibert - - * frame-x.c, EmacsFrame.c, menubar-x.c, redisplay-x.c, scrollbar-x.c: - Make 64 bit clean. - -1997-06-19 Martin Buchholz - - * config.h.in: - - Autodetect X defines using xmkmf. - - Compute rpath on *bsd* systems as well. - - rewrite PRINT_VAR m4 macro. - - detect sizes of void* and long long for future use by unex*.c - * regex.c: _GNU_SOURCE may be defined by config.h; don't redefine. - -1997-06-18 Martin Buchholz - - * Makefile.in: - * s/*.h: - * m/*.h: - * config.h.in: - * emacs.c: - * version.sh: - * configure.in: Another rewrite. - - support powerpcle (Solaris on ppc) - - Now just have one s/sol2.h for all Solaris versions - - Specifying colon-separated directories actually works now. - - OS_RELEASE is a new define to avoid proliferation of s&m files. - - extract more stuff from s&m files. - - more debugging info - - More changes to avoid the `echo -e' problem - - Add more tests: fcntl.h AC_TYPE_*, AC_FUNC_GETPGRP - - Back out -lPW test. - - More paranoid xpm test - - Put version information in version.sh instead of version.el - - Make quoted pre-processor string tokens out of all macro values - to be used only by configure. - * xmu.c: DON'T use Xos.h - * sysdep.c (wait_for_termination): - * search.c: - * editfns.c: - * console-*: - -1997-06-18 Steven L Baur - - * unexelfsgi.c: Some things that Needed To Be Done(tm) into - unexelfsgi: - - support for .sbss section (no more -G 0 needed, 0.00001% speed - increase) - - support for Elf64 (64bits executables) - From Olivier Galibert - - * fns.c (Fmapvector): New function converted from Lisp. - From Hrvoje Niksic - -Wed Jun 18 16:42:10 1997 Steven L Baur - - * Makefile.in.in: Convert two missed C style comments. - (LIBES): Remove LIBS_DEBUG which is no longer defined. - (LIBES): lwlibs_libs was misspelled. - -1997-06-17 Hrvoje Niksic - - * eval.c (vars_of_eval): New variable Vdebug_ignored_errors. - (skip_debugger): New function; use Vdebug_ignored_errors. - (signal_call_debugger): Use it. - -1997-06-17 Steven L Baur - - * emacs.c (vars_of_emacs): Moved symbols emacs-version, - emacs-major-version, and emacs-minor-version from version.el to - here. - - * general.c (syms_of_general): New symbols and, not, and or. - - * emacsfns.h: New symbols Qand, Qnot, Qor. - - * Makefile.in.in: Call temacs to compute lisp libraries to - include in the DOC file. - -1997-06-15 Steven L Baur - - * Makefile.in.in (lisp): Remove explicit mention of auto-autoloads.el. - -Sat Jun 14 21:55:27 1997 Kyle Jones - - * console.c (Fselect_console): - Check DEVICE_SELECTED_FRAME of console's selected - device for non-nil value before using it as a frame. - -1997-06-13 Steven L Baur - - * data.c (eq_with_ebola_notice): Remove horrible hack to avoid - unavoidable Ebola notices in the bytecompiler. - - * emacsfns.h: Fextent_in_region_p: Move. - - * keymap.c Fextent_in_region_p: Move. - -Fri Jun 13 00:38:29 1997 Kyle Jones - - * console.c (Fsuspend_console): - Disable input on ttys. Hide unhidden frames. - - * console.c (Fresume_console): - Enable input on ttys. Raise the device selected frame. - -Fri Jun 13 00:25:46 1997 Kyle Jones - - * process.c (status_notify): - Revert back to the code that does not use - save_excursion_restore. Just bounds check opoint - instead. - - * process.c (read_process_output): - Bounds check saved clip region and point values for - validity before using them. Call Fwiden before calling - Fnarrow_to_region to insure values will not be out of - range. - -1997-06-12 Steven L Baur - - * alloc.c: Make the GC cursor appear on all frames. - From Hrvoje Niksic - -1997-06-11 Steven L Baur - - * data.c (eq_with_ebola_notice): Add byte-optimize-logmumble and - byte-compile-push-constant to list of ignored functions. - -1997-06-11 Hrvoje Niksic - - * bytecode.c (Bsave_current_buffer): Register. - (Fbyte_code): Do action. - - * editfns.c (Fsave_current_buffer): New SUBR. - -1997-06-11 Steven L Baur - - * syntax.c (Fchar_syntax): Handle case of being passed nil. - - * data.c (eq_with_ebola_notice): Add more legitimate places in the - bytecompiler that should not get Ebola notices. - -Tue Jun 10 00:34:40 1997 Kyle Jones - - * process.c (status_notify): - Use record_unwind_protect and save_excursion_restore to - handle the point and buffer restoration. Cleaner. Doesn't - crash the editor if before/after-change-functions change - things behind our back. - -1997-06-10 Steven L Baur - - * data.c (vars_of_data): Set Ebola warning backtrace limit to 16. - (eq_with_ebola_notice): Bypass Ebola warnings for special - bytecompiler functions where they are 100% spurioius. - -1997-06-11 MORIOKA Tomohiko - - * Makefile.in.in: Use lisp/mule/language/misc-lang.el instead of - lisp/mule/ipa-hooks.el. - -1997-06-10 MORIOKA Tomohiko - - * Makefile.in.in: Use lisp/mule/language/thai.elc instead of - lisp/mule/thai-hooks.elc. - -1997-06-09 MORIOKA Tomohiko - - * Makefile.in.in: Use lisp/mule/language/chinese.el, - lisp/mule/language/cyrillic.el, lisp/mule/language/european.el, - lisp/mule/language/greek.el, lisp/mule/language/japanese.el and - lisp/mule/language/korean.el instead of - lisp/mule/chinese-hooks.el, lisp/mule/cyrillic-hooks.el, - lisp/mule/european-hooks.el, lisp/mule/greek-hooks.el, - lisp/mule/japanese-hooks.el and lisp/mule/korean-hooks.el. - -1997-06-09 Steven L Baur - - * keymap.c: Declare Fextent_in_region_p. - - * s/linux.h: Can't use ORDINARY_LINK in linux until usage of -lPW - is determined more sensibly. - -1997-06-09 Hrvoje Niksic - - * keydefs.c (get_relevant_extent_keymaps): Choose correct keymap - at extent boundaries. - -Mon Jun 9 19:35:19 1997 Kyle Jones - - * redisplay.c (pixel_to_glyph_translation): - Fixed off by one error in computation of closest - position when mouse is in the frame's right-side - border area. - -Sat Jun 7 22:07:41 1997 Kyle Jones - - * frame.c (delete_frame_internal): - Calling Fselect_frame isn't sufficient to set the - frame device's selected frame if the frame we're - selecting is on a different device. Call - set_device_selected_frame apprpriately in that case. - Also don't set the frame device's selected frame to a - frame that's on another device. - -1997-06-09 Steven L Baur - - * sysdep.c: MS Windows NT doesn't (yet) do child TTY processes. - From David Hobley - -Sat Jun 7 22:00:54 1997 Kyle Jones - - * device-x.c (x_delete_device): - Add an EQ check so that we don't set Vdefault_x_device - back to the device we're deleting. - -1997-06-05 Steven L Baur - - * frame.c (Fmake_frame): Correct checking of first_frame_on_device. - From Hrvoje Niksic - -1997-06-04 Steven L Baur - - * device.c (delete_deviceless_console): New function. - (Fmake_device): Use it. Fix problem of creation of a frame on a - tty where something fails during initialization. - From Kyle Jones - - * specifier.c (Fboolean_specifier_p): Correct spelling in - Docstring (synch from Infodock 3.5). - - * frame.c: Update docstring. - -1997-06-03 Hrvoje Niksic - - * sysdep.c (tty_init_sys_modes_on_device): Initialize it. - - * console.c (complex_vars_of_console): New variable - `tty-erase-char'. - - * conslots.h (MARKED_SLOT): New slot. - -Mon Jun 2 02:49:44 1997 Kyle Jones - - * frame.c, frame-tty.c - Treat tty frames like a cross between stacked window - system frames and frames on virtual displays. All - frames but the top frame are visible but hidden by - default. next-frame and previous-frame now skip - invisible tty frames by default. raise-frame and - lower-frame now control whether a frame is hidden - instead of whether it is visible. Frames are no - longer automatically raised when they are selected. - After a raise/lower operation selection of the new - topmost frame is deferred until a selection magic - event is read. - -Sat May 31 19:59:49 1997 Kyle Jones - - * frame-tty.c (tty_init_frame_3: - Defer selection of the newly created frame until - an event is read. - -1997-06-02 Steven L Baur - - * search.c (REGEXP_CACHE_SIZE): Bump to 20. - Suggested by Karl M. Hegbloom - -1997-05-30 Steven L Baur - - * device-tty.c (tty_asynch_device_change): - * gpmevent.c (connect_to_gpm): Makes it so it doesn't **ck up the - mouse stuff on an XTerm, and resets the internal GPM variables for - the width and height of the screen when we get a sigwinch. - From William M. Perry - -1997-05-29 Steven L Baur - - * eval.c (Fprogn): Delete mocklisp support. - (Fwhile): Ditto. - (Fcommandp): Ditto. - (Feval): Ditto. - (funcall_recording_as): Ditto. - (funcall_lambda): Ditto. - - * elhash.c (verify_function): Delete mocklisp support. - - * doc.c (Fdocumentation): Delete mocklisp support. - - * data.c (wrong_type_argument): Delete mocklisp support. - - * config.h.in: Delete mocklisp support. - - * callint.c (Fcall_interactively): Delete mocklisp support. - - * emacs.c (main_1): Delete mocklisp initialization. - - * symsinit.h: Delete mocklisp.c decls. - - * Makefile.in.in: Delete mocklisp stuffs. - -Thu May 29 03:00:16 1997 Kyle Jones - - * frame.c (change_frame_size_1): - Drop code that returns immediately if the old frame - size is equal to the new. - Leave the minibuffer height the same if the frame has - been initialized, and the minibuffer height is tall - enough to display at least one line of text in the default - font, and the old minibuffer height is a multiple of the - default font height. This should cause the minibuffer - height to be recomputed on font changes but not for - other frame size changes, which seems reasonable. - -1997-05-26 Steven L Baur - - * event-stream.c (Frecent_keys): Take optional parameter to - indicate how many keystrokes to return. - (Frecent_keys_ring_size): New function returns the maximum number - of events `recent-keys' can return. - (Fset_recent_keys_ring_size): New function. Modifies the above. - - From Hrvoje Niksic - - * event-stream.c: New variable recent_keys_ring_size replacing a - hard-coded macro. - -1997-05-23 Steven L Baur - From Hrvoje Niksic - - * sysdep.c: Correction of subprocess support when compiling - without ttys. - -1997-05-21 Steven L Baur - - * editfns.c (format-time-string): Update DOCstring. Make time - parameter optional. - -Wed May 21 11:58:17 1997 Kyle Jones - - * insdel.c (signal_first_change): - record the current buffer for the unwind instead of the - buffer that's about to become the current buffer. - -Tue May 20 23:23:39 1997 Steven L Baur - - * frame.c: Correct spelling typo in docstring. - -Mon May 19 03:40:46 1997 Kyle Jones - - * redisplay.c: (window_line_number) - don't prefer buffer point value over window point - value unless window, frame, device and console are - all selected. - - * redisplay.c: (redisplay_window) - don't prefer buffer point value over window point - value unless window, frame, device and console are - all selected. - - * redisplay.c: (create_text_block) - don't prefer buffer point value over window point - value unless window, frame, device and console are - all selected. - -Sun May 18 13:03:50 1997 Steven L Baur - - * Makefile.in.in (distclean): remove xemacs-version.h. - -Sun May 11 13:38:46 1997 Kyle Jones - - * frame.c (change_frame_size_1): - return without doing anything if the frame has benn - initialized and the new frame size is same as the - current frame size. - -Sat May 17 19:35:48 1997 Steven L Baur - - * device-tty.c (tty_asynch_device_change): Make - `no-redraw-on-reenter' work. Patch from Hrvoje Niksic. - -Sat May 17 23:39:03 1997 Hrvoje Niksic - - * frame-tty.c: Support multiple frames. - - * redisplay.c (decode_mode_spec): New coding `%N'. - -Sun May 11 23:36:08 1997 Steven L Baur - - * buffer.c: Rename Vdelete_auto_save_files to coding standards. - - * frame.c: Rename Vallow_deletion_of_last_visible_frame to coding - standards. - -Thu May 8 19:10:03 1997 Steven L Baur - - * frame.c: Change internal type of - `allow-deletion-of-last-visible-frame' to boolean. - - * buffer.c: Change internal type of `delete-auto-save-files' to - boolean. - -Sat May 3 15:28:56 1997 Steven L Baur - - * redisplay.c: `column-number-start-at-one' is a user customizable - variable. - - * event-stream.c (vars_of_event_stream): `focus-follows-mouse' is - a user customizable variable. - - * cmds.c (vars_of_cmds): `signal-error-on-buffer-boundary' is a - user customizable variable. - - * lread.c (parse_integer): Fix incorrect upper bounds on loop. - -Thu May 1 18:59:20 1997 Steven L Baur - - * glyphs-x.c (Fmake_subwindow): Update error message. - -Wed Apr 30 18:07:18 1997 Steven L Baur - - * lread.c: New variable featurep. - (read1): Add processing for #- and #+. - (read_list_conser): Handle case where a feature test has removed a - portion of the input stream. - (vars_of_lread): New feature `xemacs'. - - * fns.c (Ffeaturep): Remove function when using #-, #+ feature - reader syntax. - - * Makefile.in.in (lisp): Put features.elc in the dump list. - -Thu May 1 05:24:25 1997 Hrvoje Niksic - - * buffer.c (Fmake_indirect_buffer): Don't pretend it's there. - -Fri Apr 25 10:53:07 1997 Steven L Baur - - * glyphs-x.c: libpng already includes setjmp.h, so don't attempt - to include it twice. - -Thu Apr 24 09:14:13 1997 Steven L Baur - - * balloon-x.c (vars_of_balloon_x): Don't override advertised and - supported balloon-help. - -Tue Apr 22 11:54:02 1997 Steven L Baur - - * emacs.c (main_1): Add syms_of_balloon_x and guard with - HAVE_X_WINDOWS. - (main_1): Add vars_of_balloon_x and guard with HAVE_X_WINDOWS. - - * process.c (get_process): This function can be passed a BUFFER as - a parameter. - -Tue Apr 22 01:32:00 1997 Kyle Jones - - * menubar-x.c (pre_activate_hook): - set in_menu_callback around call to call to - menu_item_descriptor_to_widget_value. - - * event-stream.c (Fnext_event): - signal error if in_menu_callback non-nil to avoid - reentering the menubar code and causing a crash later. - - * cmdloop.c (command_loop_3): - signal error if in_menu_callback non-nil to avoid - inflooping calling Fnext_event, which will signal an - error if the situation is not caught earlier. - -Tue Apr 22 08:22:22 1997 Hrvoje Niksic - - * balloon-x.c, balloon_help.c, balloon_help.h: Modified to conform - to XEmacs coding standards. - -Thu Apr 17 17:16:34 1997 Steven L Baur - - * balloon-x.c: New file from Douglas Keller. - - * balloon_help.c: New file from Douglas Keller. - - * balloon_help.h: New file from Douglas Keller. - -Sun Apr 13 09:56:54 1997 Steven L Baur - - * emacs.c (shut_down_emacs): Advertise using send-pr as the - mechanism for submitting a bug report. - - * Makefile.in.in: Handle pathological case of mis-autodetected - TOOLTALK. - -Sun Apr 13 11:33:34 1997 David Moore - - * regex.c (re_search_2): Prevent incorrect matching and infinite - loop with \\` and MULE. - -Sat Apr 12 05:57:51 1997 Steven L Baur - - * Makefile.in.in (lisp): Dump cus-start.elc with XEmacs. - - * event-Xt.c (x_to_emacs_keysym): Allow for dead keys. (Patch - from Joachim Schnitter). - - * Makefile.in.in: Allow native sound for BSD/I. - - * linuxplay.c: Rename global sndbuf to linuxplay_sndbuf. - Make sndbuf, mix_fd, audio_vol, audio_fd, audio_dev non-static to - avoid dump time lossage. - (sndcnv8U_2mono): Rename global sndbuf to linuxplay_sndbuf. - (sndcnv8S_2mono): Ditto. - (sndcnv2monounsigned): Ditto. - (sndcnv2unsigned): Ditto. - (sndcnvULaw_2mono): Ditto. - (sndcnv16_2monoLE): Ditto. - (sndcnv16_2monoBE): Ditto. - (sndcnv2byteLE): Ditto. - (sndcnv2byteBE): Ditto. - (sndcnv2monobyteLE): Ditto. - (sndcnv2monobyteBE): Ditto. - (linux_play_data_or_file): Ditto. - (linux_play_data_or_file): Ditto. - (linux_play_data_or_file): Ditto. - -Sat Apr 12 01:59:14 1997 Kyle Jones - - * glyphs-x.c, glyphs.c, glyphs.h: Added domain parameter to all - image *_instantiate functions so that the domsin is available to - specifier lookups in the various instantiator functions. Passed - domain argument to extract_xpm_color_names for the - Fspecifier_instance call. - -Fri Apr 11 20:02:40 1997 Steven L Baur - - * glyphs-x.c (extract_xpm_color_names): Add checking to handle - case for when XEmacs is in initialization. - - * events.c (Fevent_type): Remove handling for dead_event. - (Fevent_properties): Remove handling for dead_event. - -Thu Apr 10 20:41:53 1997 David Moore - - * ntproc.c (sys_spawnve): Clean up GC protection. - - * fileio.c (Ffile_executable_p): Clean up GC protection. - -Thu Apr 10 12:48:49 1997 Steven L Baur - - * glyphs.c: Undo duplicate declaration of display_table. - - * glyphs.h: Back out name change of autodetect to - automatic_conversion. - - * glyphs.c: Back out name change of autodetect to - automatic_conversion. - - * glyphs-x.c (image_instantiator_format_create_glyphs_x): Back out - name change of autodetect to automatic_conversion. - - * events.c (Fevent_properties): Do something sensible for - dead_event and empty_event. - - * general.c: Restore autodetect symbol. - - * emacsfns.h: Declare new symbol Qempty. - - * general.c: Add symbol to identify empty events. - - * events.c (Fevent_type): Don't abort() when presented with an - empty_event or a dead_event. - -Mon Apr 7 18:12:26 1997 David Moore - - * xmu.c: Renamed local `initialized' variable to `hex_initialized' - and don't assign to static, as some compilers crash. - (initHexTable): Use it. - (XmuReadBitmapData): Use it. - -Sun Apr 6 18:03:47 1997 David Moore - - * fileio.c (Fexpand_file_name): Clean up GC protection. - - * dired.c (Fdirectory_files): Clean up GC protection. - - * insdel.c (signal_after_change): Don't run after_change_functions - on special Vprin1_to_string_buffer. - (signal_before_change): Ditto for before_change_functions. - -Fri Apr 4 14:41:17 1997 David Moore - - * buffer.c (Fkill_buffer): Don't kill special - Vprin1_to_string_buffer. - -Mon Apr 7 19:13:40 1997 Steven L Baur - - * Makefile.in.in (xemacs-version.h): Added to rename main_1 to - something reflecting the XEmacs version in use (for lusers - reporting crashes who forget to include the version number). - - * toolbar.c (specifier_vars_of_toolbar): Strip HAVE_NEXTSTEP. - - * sound.c: Strip HAVE_NEXTSTEP. - - * redisplay.c (init_redisplay): Strip HAVE_NEXTSTEP. - - * faces.c: Strip HAVE_NEXTSTEP. - (update_EmacsFrame): Ditto. - - * events.c (event_equal): Strip HAVE_NEXTSTEP. - (event_hash): Ditto. - (format_event_object): Ditto. - - * event-stream.c (init_event_stream): Strip HAVE_NEXTSTEP. - - * emacs.c (main_1): Strip HAVE_NEXTSTEP. - Attempt hack to change name of main_1 to something reflecting the - current version for lusers who don't include version numbers with - stack backtraces. - - * device.c: Strip HAVE_NEXTSTEP. - - * console.c (Fconsole_type): Remove reference to unimplemented ns - windows type. - -Sun Apr 6 08:08:33 1997 Steven L Baur - - * frame.h: Strip NeXTStep stuff. - - * device.h: Strip NeXTStep stuff. - - * console.h: More NeXTStep trimming. - - * console-x.h: Strip Epoch stuff. - - * symsinit.h (init_sunpro): Strip vms/Epoch stuff. - - * events.h (union magic_data): Strip NeXTStep stuff. - - * console.h: Strip NeXTStep stuff. - - * config.h.in: Strip unimplemented NeXTStep/Epoch stuff out. - - * Makefile.in.in: Remove unused NeXTStep support. It's all in the - cvs attic if someone wishes to revive it. - (epoch.o): Remove last vestiges of non-existent epoch support. - -Sat Apr 5 17:16:49 1997 Steven L Baur - - * fns.c: Correct DOC string to not equate integers and - characters. - -Thu Apr 3 08:01:50 1997 Steve Carney - - * s/decosf4.0-static.h: New file. - -Tue Apr 1 12:22:32 1997 Steven L Baur - - * config.h.in: MAIL_USE_POP, KERBEROS, HESIOD -- new parameters to - deal with upgraded movemail.c. - -Fri Mar 28 19:25:22 1997 Steven L Baur - - * inline.c: Restore this blasphemous file. - - * Makefile.in.in (inline.o): Restore the bletcherous - inline.c. - -Tue Mar 25 11:36:08 1997 David Moore - - * fileio.c (barf_or_query_if_file_exists): GC fixes. - (Ffile_readable_p): ditto. - (Ffile_writable_p): ditto. - (Ffile_symlink_p): ditto. - (Ffile_accessible_directory_p): ditto. - - * sound.c (Fplay_sound_file): Fix up gc problems with file - handlers. - - * buffer.c (Fkill_buffer): Fix up buffer killing problems with - file handlers. - - * sysdep.c (sys_subshell): Fix up gc problems with file handlers. - - * callproc.c (Fcall_process_internal): Fix up gc problems with - file handlers. -Tue Mar 25 17:16:14 1997 Steven L Baur - - * ralloc.c (MHASH): Make 64bit Alpha happier. - -Tue Mar 25 11:36:08 1997 David Moore - - * fileio.c (auto_save_expand_name_error): New function. - (auto_save_expand_name): Ditto. - (Fdo_auto_save): Protect against an error in Fexpand_file_name - from kicking us inappropriately out of auto-save. - -Mon Mar 24 21:50:13 1997 Steven L Baur - - * s/linux.h (GETPGRP_NEEDS_ARG): Define if compiling with glibc - 2.1 (suggested by Andreas Jaeger). - -Mon Mar 24 12:40:56 1997 David Moore - - * profile.c: Fixed some comments about GC status of functions. - - * profile.c (inside_profiling): New variable to lock the - profiling table. - (sigprof_handler): Check it. - (Fget_profiling_info): Set it. - (mark_profiling_info): Set it. - (Fclear_profiling_info): Set it. - - * eval.c (PUSH_BACKTRACE): New macro. - (POP_BACKTRACE): Ditto. - - * eval.c (Fcommand_execute): Use them and fix problem with - backtrace_list build ordering requirements for profiling code. - (Feval): Ditto. - (funcall_recording_as): Ditto. - -Fri Mar 21 20:19:09 1997 Steven L Baur - - * Makefile.in.in: strip inline.o. - -Fri Mar 21 18:54:04 1997 David Moore - - * fileio.c (call2_check_string_or_nil): New function. - (Ffile_name_directory): Use it. - (Fsubstitute_in_file_name): Use it. - - * fileio.c (Fexpand_file_name): GC protect against file handlers. - (Fdelete_file): ditto - (Ffile_writable_p): ditto - (Ffile_directory_p): ditto - (Ffile_regular_p): ditto - (Fset_file_modes): ditto - (Ffile_newer_than_file_p): ditto - (Fset_visited_file_modtime): ditto - - *fileio.c (Ffile_truename): Unneccessary GC protection. - (Fdelete_directory): Fix broken caller-must-GC-protect call. - - * filelock.c (lock_file): New comments warning that this function - may kill the current buffer. - (unlock_file): ditto - (Flock_buffer): ditto - (Funlock_buffer): ditto - (unlock_buffer): ditto - - * filelock.c (unlock_all_files): GC protect against unlock_file - killing random buffers. - - * buffer.c (Fkill_buffer): GC protect against unlock_file killing - the buffer. - - * insdel.c (prepare_to_modify_buffer): GC protect against - lock_file() killing the buffer. - -Fri Mar 21 19:11:15 1997 Steven L Baur - - * mule-coding.c (vars_of_mule_coding): Add - enable-multibyte-characters for MULE compatibility. - -Thu Mar 20 13:25:26 1997 Steven L Baur - - * glyphs-x.c: Implement a dummy function to insert a fake EOI - marker if called. Based on code from William Perry. - -Wed Mar 19 10:49:05 1997 Steven L Baur - - * menubar-x.c (pre_activate_callback): Attempt to avoid recursive - expansion of submenus via :filter expansion. - - * glyphs-x.c (x_print_image_instance): Move define of - HAVE_SUBWINDOWS to glyphs-x.h. - (our_skip_input_data): Implement with some error checking based on - patch by Dominic Froud. - - * glyphs-x.h (HAVE_SUBWINDOWS): Define to keep inline.c from - barfing. - -Tue Mar 18 11:15:23 1997 Steven L Baur - - * glyphs-x.c: Strip unimplemented subwindows code. - -Mon Mar 17 15:40:12 1997 David Moore - - * glyphs-x.c (our_own_dgif_slurp_from_gif2x11_c): Only get the - first image out of a multi-image or animated gif. - -Mon Mar 17 15:27:26 1997 Steven L Baur - - * Makefile.in.in (xemacs): Invert sense of test for successful - completion of XEmacs dump. - -Sat Mar 15 14:21:39 1997 David Moore - - * fileio.c (Fdo_auto_save): Protect against file handlers which - may kill the buffer being saved or otherwise modify Vbuffer_alist. - -Sat Mar 15 15:32:51 1997 Steven L Baur - - * Makefile.in.in (lisp): Add auto-customize.elc. - -Fri Mar 14 19:10:37 1997 David Moore - - * extents.c (extent_changed_for_redisplay): New parameter. - (extent_changed_for_redisplay): Notify redisplay if invisible text - has become visible. - (extent_maybe_changed_for_redisplay): New parameter. - (extent_attach): Use it. - (extent_detach): Use it. - (Fset_extent_parent): Use it. - (set_extent_invisible): Use visibility change parameter. - (Fset_extent_face): Ditto. - (Fset_extent_mouse_face): Ditto. - (set_extent_glyph): Ditto. - (do_highlight): Ditto. - -Thu Mar 13 10:40:37 1997 Steven L Baur - - * s/sunos4-1-4-shr.h: New file. - - * s/sunos4-1-4.h: New file. - - * s/sunos4-1.h (BROKEN_SIGIO): Define. - -Wed Mar 12 14:29:40 1997 Steven L Baur - - * emacs.c (fatal_error_signal): (mostly) useless check on - /usr/proc/bin/pstack removed. - - * s/bsdos3.h: New file for BSDI 3.0. - - * editfns.c (Fchar_equal): Correct DOC string. - (Fchar_Equal): (char=) CL Case sensitve comparison added. - - * data.c (Fcharacterp): Make DOC string less confrontational. - -Mon Mar 10 23:51:04 1997 Martin Buchholz - - * input-method-motif.c (XIM_init_frame): Fix XIM crash on some - versions of X11R6 XIM. - -Sun Mar 9 21:46:53 1997 Tomasz J. Cholewo - - * minibuf.c (regexp_ignore_completion_p): Reverse meaning of - completion-regexp-list. - -Thu Mar 6 19:15:29 1997 Steven L Baur - - * data.c (eq_with_ebola_notice): Unobfuscate Ebola warning!!! - message. - -Wed Mar 5 16:11:22 1997 Steven L Baur - - * process.c (get_internet_address): Put upper bounds on attempting - to get system name (similar to nearly identical processing in - sysdep.c. - -Tue Mar 4 17:30:48 1997 Steven L Baur - - * puresize.h (PURESIZE): *Must* use angle brackets for - puresize_adjust.h or build will lose with --srcdir. - - * alloc.c (report_pure_usage): Adjust error message printed when - too low on PURESIZE. - - * Makefile.in.in: Move site-packages. - Add vpath correction for puresize_adjust.h. - -Mon Mar 3 20:37:54 1997 Steven L Baur - - * Makefile.in.in (lisp): Remove custom-xmas.elc. - -Sat Mar 1 01:20:39 1997 Steven L Baur - - * doc.c (weird_doc): Don't print `duplicate' messages as they are - almost always due to symbols that are both autoloaded and dumped. - - * data.c (syms_of_data): char-int and int-char -> char-to-int and - int-to-char. - -Thu Feb 27 21:48:32 1997 Steven L Baur - - * Makefile.in.in (xemacs): Loop when dumping until SATISFIED. - - * lstream.c (signal_simple_internal_error): Remove the abort(). - - * alloc.c (Fpurecopy): Make it work for byte compiled functions. - (Fgarbage_collect): Disable garbage collection if we're dumping - XEmacs and we've overflowed purespace. - -Thu Feb 27 14:14:53 1997 Darrell Kindred - - * event-Xt.c (change_frame_visibility): New function. - (handle_map_event): Use it. - (emacs_Xt_handle_magic_event): Correction of handling of - VisibilityNotify. - -Thu Feb 27 14:12:57 1997 Steven L Baur - - * frame-x.c (x_frame_visible_p): Reverse previous change. - -Sun Mar 2 14:01:32 1997 David Moore - - * regex.c (re_search_2): Properly handle crossing the buffer gap - when doing a backwards search under MULE. - -Wed Feb 26 10:24:40 1997 Steven L Baur - - * Makefile.in.in: make-docfile takes a "-i" parameter to pass - site-loaded lisp files. - - * alloc.c (report_pure_usage): Adjust restart message. - -Tue Feb 25 10:58:12 1997 Steven L Baur - - * Makefile.in.in: Add PURESIZE.h to special treatment in vpath. - - * alloc.c (PURESIZE_h): New function. - (report_pure_usage): Use it. If PURESIZE is not the right amount, - use the correct value. - - * puresize.h: Use dynamic computation of PURESIZE. - - * PURESIZE.h: New file. - - * fns.c (Frandom): Fix docstring. - -Mon Feb 24 17:35:05 1997 Jonathan Edwards - - * process.c (record_exited_processes): Fix obvious typo in - checking for SIGCLD. - -Sun Feb 23 01:45:49 1997 Martin Buchholz - - * scrollbar.c (update_scrollbar_instance): Fix for - all-hail-xemacs scrollbar drag bug. - - * scrollbar.c (Fscrollbar_to_bottom): Now calls Frecenter(-3) - as end-of-buffer does, instead of hostile Frecenter(0). Makes - C-button-1 on down-arrow friendlier. - -Sun Feb 23 16:56:17 1997 David Hobley - Initial MS Windows NT support. - * unexnt.c: New file. - - * ntproc.c: New file. - - * ntheap.h: New file. - - * ntheap.c: New file. - - * nt.h: New file. - - * nt.c: New file. - -Sun Feb 23 15:56:58 1997 Steven L Baur - - * floatfns.c (_GNU_SOURCE): Define if compiling with glibc 2. - - * gmalloc.c: Guard __getpagesize definition against glibc 2. - -Sat Feb 22 17:12:47 1997 Steven L Baur - - * Makefile.in.in (lisp): Snarf docstrings from new file - itimer-autosave.elc. - -Fri Feb 21 18:21:32 1997 Jan Vroonhof - - * event-Xt.c (emacs_Xt_handle_magic_event): Correction for frame - freezing bug. - -Wed Feb 19 12:54:32 1997 Per Abrahamsen - - * buffer.c (Fbuffer_disable_undo): Default to current buffer. - -Tue Feb 18 12:37:28 1997 Steven L Baur - - * Makefile.in.in (lisp): Dump new file custom-xmas.elc. - -Mon Feb 17 11:29:07 1997 Steven L Baur - - * print.c (Ferror_message_string): New function, ported from Emacs - 19.34. - (print_error_message): Ditto. - - * extents.c (verify_extent_mapper): Experimental deletion of code - to allow deletion of read-only extents. - - * symbols.c (hash_string): Replace algorithm with one given in - Aho, Sethi & Ullman. - -Sun Feb 16 14:53:58 1997 Steven L Baur - - * keymap.c (lookup_keys): Wrong sense in test. - - * Makefile.in.in: Dont dump font.elc. - -Sat Feb 15 02:30:51 1997 Steven L Baur - - * cmds.c: Define new symbol signal-error-on-buffer-boundary. - (Fforward_char): Use it. - (Fbackward_char): Use it. - - * window.c (Fscroll_up): Use it. - (Fscroll_down): Use it. - - * keymap.c (syms_of_keymap): define mouse-[123] and - down-mouse-[123] pseudo-keysym aliases for Emacs compatibility. - -Thu Feb 13 21:28:35 1997 Steven L Baur - - * Makefile.in.in: Don't dump tm with XEmacs under any - circumstances. - - * puresize.h: Remove extra SunPro puresize for MULE+tm. - -Sun Feb 9 04:40:36 1997 Axel Seibert - - * emacs.c (main_1): Fix NeXT malloc initialization. - -Fri Feb 7 11:36:56 1997 Steven L Baur - - * mule-coding.c (Fdecode_coding_region): Make explicit call to - `barf_if_buffer_read_only'. - (Fencode_coding_region): Ditto. - -Thu Feb 6 22:39:39 1997 Steven L Baur - - * extents.c (syms_of_extents): Remove references to replicating - extents. - - * extents.h (struct extent): Remove references to replicating - extents. - -Thu Feb 6 01:11:43 1997 Jareth Hein - - * mule-coding.c (ENCODE_SJIS): Correct typo. - -Thu Feb 6 01:10:22 1997 Steven L Baur - - * frame.c (delete_frame_internal): Protect against deletion of - frames with living popup children. - -Wed Feb 5 17:13:17 1997 David Moore - - * emacs.c (main_1): Try to avoid collisions against potentially - incompatible system mallocs. - -Mon Feb 3 23:04:41 1997 Joel Peterson - - * redisplay.c: Activate face/charset redisplay caching. - -Mon Feb 3 22:01:09 1997 Kyle Jones - - * eval.c (do_debug_on_exit): Don't restore old value of - debug_on_next_call improperly. - -Fri Jan 31 10:28:47 1997 David Byers - - * frame.c (frame_matches_frametype): Fix next-window when the next - window is on another frame. - -Thu Jan 30 20:25:00 1997 Steven L Baur - - * syntax.c (scan_sexps_forward): Change test on targetdepth to - match Emacs 19.34. - -Wed Jan 29 22:11:53 1997 James LewisMoss - - * gmalloc.c: Corrections for namespace collision with Linux libc - malloc. - -Mon Jan 27 21:46:53 1997 Tomasz J. Cholewo - - * fileio.c (Fwrite_region_internal): pack lockname to write-region - handler. - -Mon Jan 27 04:50:50 1997 David Moore - - * gmalloc.c (malloc): Guard against incompatible system mallocs - with conflicting symbols. - -Sun Jan 26 12:27:04 1997 Steven L Baur - - * redisplay.c (add_emchar_rune): Back out optimization change of - caching last_charset. - -Sun Jan 26 09:10:45 1997 Hrvoje Niksic - - * s/decosf4-0.h: Digital Unix 4.0 has a realpath, but it's buggy. - And I *do* mean buggy. - -Thu Jan 23 10:41:19 1997 Steven L. Baur - - * puresize.h: Increase SUNPRO usage to reflect tm & cc-mode. - Decrease BASE_PURESIZE and increase MULE_PURESIZE_EXTRA. - -Wed Jan 22 21:09:52 1997 Steven L Baur - * puresize.h (BASE_PURESIZE): Tighten up. - - * scrollbar.c (scrollbar-page-up): Add Athena3d to Lucid/Motif - code. - (scrollbar-page-down): Ditto. - - * scrollbar-x.c (x_create_scrollbar_instance): Add Athena3d to - Lucid/Motif code. - (x_update_vertical_scrollbar_callback): Ditto. - (x_update_horizontal_scrollbar_callback): Add Athena3d to Lucid - special case code. - - * scrollbar-x.h (struct x_scrollbar_data): Add start drag position - for Athena3d. - - * redisplay-output.c (redisplay_update_line): A vain attempt to - get the Athena vertical thumb adjusted after drag. - - * EmacsFrame.c: Default to lower/right with Athena3d libraries. - -Wed Jan 22 18:38:52 1997 Ian Wells - - * m/aviion.h: Remove definition of m88k. - - * s/dgux5-4r4.h: New file. - -Wed Jan 22 18:32:49 1997 Steven L Baur - - * buffer.h: Put proper typecasts on calls to alloca(). - -Tue Jan 21 22:25:23 1997 Steven L. Baur - - * config.h.in: Add LWLIB_USES_ATHENA symbol - - * Makefile.in.in (TOOLKIT_LIBS): It is possible to have both - Athena and Motif in the same link. - -Tue Jan 21 20:43:41 1997 Hrvoje Niksic - - * redisplay-tty.c (tty_ring_bell): Don't ring tty bell if the - volume is set to 0. - -Tue Jan 21 20:38:58 1997 Axel Seibert - - * s/nextstep.h (signal_handler_t): define as int. - -Mon Jan 20 21:12:57 1997 Martin Buchholz - - * event-Xt.c (emacs_Xt_handle_magic_event): - (frame-totally-visible-p) sometimes incorrectly returned nil. - -Thu Jan 16 17:24:29 1997 Joel Peterson - - * menubar-x.c (pre_activate_callback): Correctly handle buffer - local variables in :included clauses. - (compute_menubar_data): Ditto. - -Wed Jan 15 21:44:53 1997 Joel Peterson - - * redisplay.c (add_emchar_rune): Enable last_charset display - optimization. - -Wed Jan 15 19:06:27 1997 David Moore - - * event-stream.c (Faccept_process_output): Avoid checking an - uninitialized variable. - -Wed Jan 15 14:14:24 1997 Steven L Baur - - * regex.c: Modify values of re_max_failures and MAX_FAILURE_ITEMS - to match Emacs 19.34. - -Mon Jan 13 00:36:01 1997 Martin Buchholz - - * sysdep.c (sys_execvp): Fix when compiled with - --const-is-losing=no. Old code could crash if argv contained - non-ascii characters and the execvp failed and then caller - examined argv (for error message, for example). - -Sun Jan 12 17:22:24 1997 Steven L Baur - - * Makefile.in.in: TM .elcs moved to SUNPRO_LISP only. - -Fri Jan 10 20:21:47 1997 Ben Wing - - * minibuf.c (Ftry_completion): Don't crash if not given a proper - obarray. - -Fri Jan 10 09:49:44 1997 Ted Phelps - - * objects-x.c (x_initialize_font_instance): Hardcode 'n' for - default font width. - -Mon Jan 6 15:16:46 1997 Carsten Leonhardt - - * Makefile.in.in: Linking with canna requires -lRKC. - -Mon Jan 6 12:22:57 1997 Frederic Poncin - - * gmalloc.c: Don't declare __sbrk on SparcLinux. - -Sun Jan 5 18:04:47 1997 Soren Dayton - - * Makefile.in.in: IRIX6 can use sgiplay.c too. - -Sat Jan 4 12:15:16 1997 Steven L Baur - - * toolbar.c (specifier_vars_of_toolbar): Clean up fallback - specifiers so XEmacs can be built without tty support. - - * console-stream.c: Moved function bodies of - semi_canonicalize_console_connection, - canonicalize_console_connection, - semi_canonicalize_device_connection, and - canonicalize_device_connection into this file from console-tty.c. - Moved variable Vstdio_str into this file. - - * console-tty.c: See above. - -Fri Jan 3 18:07:11 1997 Axel Seibert - - * m/next.h: Cleanup accumulated cruft. - - * s/nextstep.h: Remove useless #undef REL_ALLOC/HAVE_MMAP. - - * syssignal.h: Don't typedef SIGTYPE on NeXT. - -Fri Jan 3 12:06:44 1997 Michael Sperber - - * m/ibmrs6000.inp: Added various get.* symbols. - -Sun Dec 29 20:16:08 1996 Steven L Baur - - * m/next.h: Remove signal_handler_t #define. - - * s/nextstep.h: Remove signal_handler_t #define. - -Fri Dec 27 21:13:33 1996 Martin Buchholz - - * event-Xt.c (x_to_emacs_keysym): Corrections to SUNOS_GCC_LO_BUG. - -Mon Dec 23 11:37:16 1996 Martin Buchholz - - * fns.c (Ffillarray): Fix for (fillarray #*10 0) - -Mon Dec 23 10:27:14 1996 Steven L Baur - - * bitmaps.h: Change to unsigned char. - - * frame-x.c (x_cde_transfer_callback): Typecast fix. - - * keymap.c (define_key_check_and_coerce_keysym): Typecast fix. - -Fri Dec 20 19:21:56 1996 Steven L Baur - - * Makefile.in.in (lisp): Remove cc-mode as a dumped package. - - * keymap.c (define_key_check_and_coerce_keysym): Make obsolete - binding of kp_.* not lose. - - * bitmaps.h: Add left & right arrows to show extended lines. - -Fri Dec 20 15:32:53 1996 David Moore - - * event-stream.c (event_stream_wakeup_pending_p): New function. - (Faccept_process_output): Fix timeout handling race conditions. - (Fsleep_for): Ditto. - (Fsit_for): Ditto. - -Thu Dec 19 22:25:26 1996 Steve Carney - - * cmds.c (Fbeginning_of_line): Adjust for 64 bit machines. - -Thu Dec 19 00:44:10 1996 Bart Robinson - - * syssignal.h: The declaration of SIGTYPE shouldn't be protected - by HAVE_SIGPROCMASK. - -Wed Dec 18 20:40:21 1996 Martin Buchholz - - * dgif_lib.c: Miscellaneous cleanup, including removing signed - bitfields. - - * mule-charset.h: Change charset names. - - * mule-coding.c (struct iso2022_decoder): Uniform unsigned bitfields. - Change charset names. - - * mule-charset.c: Change charset names. - - * mule-canna.c: Change charset names. - - * EmacsShell-sub.c: Ansify and reformat. - - * console-tty.h (struct tty_console): Uniform unsigned bitfields. - - * glyphs-x.c: Ansify. - - * specifier.c: Use lisp_fn_t. - - * EmacsShell.c: Ansify. - - * vm-limit.c: Ansify. - - * emacsfns.h: Use lisp_fn_t. - - * lstream.c (struct filedesc_stream): Unsigned int bitfields. - - * xselect.c (hack_motif_clipboard_selection): Change charset name. - (Fx_store_cutbuffer_internal): Change charset name. - - * ralloc.c: Ansify and clean up. - - * frame.h (struct frame): Uniform unsigned bit fields. - - * event-Xt.c: Documentation change. - - * lisp.h: Introduce lisp_fn_t. - Remove SunPro C compiler warning message workaround. - - * xmu.c: Ansify. - - * doprnt.c (struct printf_spec): Use unsigned bitfields. - - * fileio.c: various code formatting changes. - - * eval.c: reorganize primitive funcalls. - - * config.h.in (NeedFunctionPrototypes): Force slightly better type - checking in X header files. - - * Makefile.in.in: #undef i386, move mime-setup.elc?. - - * s/sunos4-0-shr.h: Documentation change. - - * s/sol2.h (__EXTENSIONS__): Add. - Include under certain conditions. - -Mon Dec 16 19:13:10 1996 Steven L Baur - - * lstream.c (Lstream_pseudo_close): Return status on error. - (Lstream_close): Ditto. (Fixes disk full-no error on write bug). - -Sat Dec 14 16:54:52 1996 Steven L Baur - - * glyphs-x.c (jpeg_instantiate): Use file I/O for JPEG loading - because the in-core code is broken. - -Fri Dec 13 16:43:45 1996 Steven L Baur - - * device-x.c (x_init_device): Don't make nonexistent X server the - default when running on a tty. - - * event-Xt.c (x_to_emacs_keysym): Rename kp_.* keysyms to be kp-\1. - - * redisplay-tty.c (keys): Rename kp_.* keynames to kp-\1. - -Fri Dec 13 14:48:42 1996 Michael Sperber - - * lread.c (Fload_internal): Change arity of call to - file-name-handlers. - - * fileio.c (Finsert_file_contents_internal): Ditto. - -Thu Dec 12 16:55:34 1996 Lars Magne Ingebrigtsen - - * cmds.c (Fpoint_at_eol, Fpoint_at_bol): New functions. - (Fend_of_line, Fbeginning_of_line): Use them. - -Tue Dec 10 11:17:32 1996 Shane Holder - - * s/hpux9shxr4.h: hpux9shr.h -> hpux9-shr.h - - * s/hpux10.h: hpux9shr.h -> hpux9-shr.h - -Sat Dec 7 18:29:34 1996 Steven L Baur - - * puresize.h (BASE_PURESIZE): Bumped up PURESIZE by 10k. - -Sat Dec 7 16:26:34 1996 Martin Buchholz - - * config.h.in: configure for POSIX getcwd if available. - -Sat Dec 7 15:48:39 1996 Steven L Baur - - * s/sunos4-1-shr.h: Renamed from sunos4-1shr.h. - - * s/sunos4-1-3-shr.h: Renamed from sunos4-1-3shr.h. - - * s/sunos4-1-2-shr.h: Renamed from sunos4-1-2-shr.h. - - * s/sunos4-0-shr.h: Renamed from sunos4-0shr.h. - - * s/hpux9-shr.h: Renamed from hpux9shr.h. - - * s/hpux8-shr.h: Renamed from hpux8shr.h. - - * s/hpux10-shr.h: Renamed from hpux10shr.h. - -Wed Dec 4 23:38:03 1996 Steven L Baur - - * redisplay.c: Allow column numbers in modeline to start from 1. - diff --git a/src/EmacsFrame.c b/src/EmacsFrame.c deleted file mode 100644 index 2051ae4..0000000 --- a/src/EmacsFrame.c +++ /dev/null @@ -1,644 +0,0 @@ -/* The emacs frame widget. - Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -/* #### Note to potential hackers: Don't mess with this unless you're - sure you know what you're doing! Xt is a lot more subtle than - you may think. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "glyphs-x.h" -#include "objects-x.h" -#include -#include "EmacsFrameP.h" -#include "EmacsManager.h" /* for EmacsManagerChangeSize */ -#include "xmu.h" - -#include "faces.h" -#include "frame.h" -#include "toolbar.h" -#include "window.h" - -static void EmacsFrameClassInitialize (void); -static void EmacsFrameInitialize (Widget, Widget, ArgList, Cardinal *); -static void EmacsFrameRealize (Widget, XtValueMask*, XSetWindowAttributes*); -static void EmacsFrameResize (Widget widget); -static Boolean EmacsFrameSetValues (Widget, Widget, Widget, - ArgList, Cardinal *); -static XtGeometryResult EmacsFrameQueryGeometry (Widget, XtWidgetGeometry*, - XtWidgetGeometry*); - -extern void -emacs_Xt_mapping_action (Widget w, XEvent* event); - -#undef XtOffset -#define XtOffset(p_type,field) \ - ((Cardinal) (((char *) (&(((p_type)0)->field))) - ((char *)0))) -#define offset(field) XtOffset(EmacsFrame, emacs_frame.field) - -static XtResource resources[] = { - {XtNgeometry, XtCGeometry, XtRString, sizeof(String), - offset (geometry), XtRString, (XtPointer) 0}, - {XtNiconic, XtCIconic, XtRBoolean, sizeof(Boolean), - offset (iconic), XtRImmediate, (XtPointer) False}, - - {XtNemacsFrame, XtCEmacsFrame, XtRPointer, sizeof (XtPointer), - offset (frame), XtRImmediate, 0}, - {XtNmenubar, XtCMenubar, XtRBoolean, sizeof (Boolean), - offset (menubar_p), XtRImmediate, (XtPointer) True}, - {XtNinitiallyUnmapped, XtCInitiallyUnmapped, XtRBoolean, sizeof (Boolean), - offset (initially_unmapped), XtRImmediate, (XtPointer) False}, - {XtNminibuffer, XtCMinibuffer, XtRBoolean, sizeof (Boolean), - offset (minibuffer), XtRImmediate, (XtPointer) True}, - {XtNunsplittable, XtCUnsplittable, XtRBoolean, sizeof (Boolean), - offset (unsplittable), XtRImmediate, (XtPointer) False}, - {XtNinternalBorderWidth, XtCInternalBorderWidth, XtRInt, sizeof (int), - offset (internal_border_width), XtRImmediate, (XtPointer)4}, -#ifdef HAVE_SCROLLBARS - {XtNscrollBarWidth, XtCScrollBarWidth, XtRInt, sizeof (int), - offset (scrollbar_width), XtRImmediate, (XtPointer)-1}, - {XtNscrollBarHeight, XtCScrollBarHeight, XtRInt, sizeof (int), - offset (scrollbar_height), XtRImmediate, (XtPointer)-1}, - {XtNscrollBarPlacement, XtCScrollBarPlacement, XtRScrollBarPlacement, - sizeof(unsigned char), offset(scrollbar_placement), XtRImmediate, -#if defined (LWLIB_SCROLLBARS_MOTIF) || defined (LWLIB_SCROLLBARS_LUCID) || \ - defined (LWLIB_SCROLLBARS_ATHENA3D) - (XtPointer) XtBOTTOM_RIGHT -#else - (XtPointer) XtBOTTOM_LEFT -#endif - }, -#endif /* HAVE_SCROLLBARS */ -#ifdef HAVE_TOOLBARS - {XtNtopToolBarHeight, XtCTopToolBarHeight, XtRInt, sizeof (int), - offset (top_toolbar_height), XtRImmediate, (XtPointer)-1}, - {XtNbottomToolBarHeight, XtCBottomToolBarHeight, XtRInt, sizeof (int), - offset (bottom_toolbar_height), XtRImmediate, (XtPointer)-1}, - {XtNleftToolBarWidth, XtCLeftToolBarWidth, XtRInt, sizeof (int), - offset (left_toolbar_width), XtRImmediate, (XtPointer)-1}, - {XtNrightToolBarWidth, XtCRightToolBarWidth, XtRInt, sizeof (int), - offset (right_toolbar_width), XtRImmediate, (XtPointer)-1}, - {XtNtopToolBarBorderWidth, XtCTopToolBarBorderWidth, XtRInt, - sizeof (int), - offset (top_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNbottomToolBarBorderWidth, XtCBottomToolBarBorderWidth, XtRInt, - sizeof (int), - offset (bottom_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNleftToolBarBorderWidth, XtCLeftToolBarBorderWidth, XtRInt, - sizeof (int), - offset (left_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNrightToolBarBorderWidth, XtCRightToolBarBorderWidth, XtRInt, - sizeof (int), - offset (right_toolbar_border_width), XtRImmediate, (XtPointer)-1}, - {XtNtopToolBarShadowColor, XtCTopToolBarShadowColor, XtRPixel, sizeof(Pixel), - offset(top_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000"}, - {XtNbottomToolBarShadowColor, XtCBottomToolBarShadowColor, XtRPixel, - sizeof(Pixel), offset(bottom_toolbar_shadow_pixel), XtRString, (XtPointer) "#000000"}, - {XtNbackgroundToolBarColor, XtCBackgroundToolBarColor, XtRPixel, - sizeof(Pixel), offset(background_toolbar_pixel), XtRImmediate, - (XtPointer)-1}, - {XtNforegroundToolBarColor, XtCForegroundToolBarColor, XtRPixel, - sizeof(Pixel), offset(foreground_toolbar_pixel), XtRImmediate, - (XtPointer)-1}, - {XtNtopToolBarShadowPixmap, XtCTopToolBarShadowPixmap, XtRPixmap, - sizeof (Pixmap), offset(top_toolbar_shadow_pixmap), XtRImmediate, - (XtPointer)None}, - {XtNbottomToolBarShadowPixmap, XtCBottomToolBarShadowPixmap, XtRPixmap, - sizeof (Pixmap), offset(bottom_toolbar_shadow_pixmap), XtRImmediate, - (XtPointer)None}, - {XtNtoolBarShadowThickness, XtCToolBarShadowThickness, XtRDimension, - sizeof (Dimension), offset (toolbar_shadow_thickness), XtRImmediate, - (XtPointer)2}, -#endif /* HAVE_TOOLBARS */ - {XtNinterline, XtCInterline, XtRInt, sizeof (int), - offset (interline), XtRImmediate, (XtPointer)0}, - { -#ifdef I18N4 - XtNfontSet, XtCFontSet, XtRFontSet, sizeof(XFontSet), -#else - XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), -#endif - offset(font), XtRImmediate, (XtPointer)0 - }, - {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), - offset(foreground_pixel), XtRString, (XtPointer) "Black"}, - {XtNbackground, XtCBackground, XtRPixel, sizeof(Pixel), - offset(background_pixel), XtRString, (XtPointer) "Gray80"}, - {XtNcursorColor, XtCForeground, XtRPixel, sizeof(Pixel), - offset(cursor_color), XtRString, (XtPointer) "XtDefaultForeground"}, - {XtNbarCursor, XtCBarCursor, XtRBoolean, sizeof (Boolean), - offset (bar_cursor), XtRImmediate, (XtPointer)0}, - {XtNvisualBell, XtCVisualBell, XtRBoolean, sizeof (Boolean), - offset (visual_bell), XtRImmediate, (XtPointer)0}, - {XtNbellVolume, XtCBellVolume, XtRInt, sizeof (int), - offset (bell_volume), XtRImmediate, (XtPointer)0}, - {XtNuseBackingStore, XtCUseBackingStore, XtRBoolean, sizeof (Boolean), - offset (use_backing_store), XtRImmediate, (XtPointer)0}, - {XtNpreferredWidth, XtCPreferredWidth, XtRDimension, sizeof (Dimension), - offset (preferred_width), XtRImmediate, (XtPointer)0}, - {XtNpreferredHeight, XtCPreferredHeight, XtRDimension, sizeof (Dimension), - offset (preferred_height), XtRImmediate, (XtPointer)0}, -}; - -#undef offset - -/* Xt is stupid and dumb. - Xt is stupid and dumb. - Xt is stupid and dumb. */ - -static XtActionsRec -emacsFrameActionsTable [] = { - {"mapping", (XtActionProc) emacs_Xt_mapping_action}, -}; - -static char -emacsFrameTranslations [] = "\ -: mapping()\n\ -"; - -/* If we're running under Motif, make this widget a subclass - of XmPrimitive. It's not clear this is necessary, but it - may make focus behavior work better. */ - -EmacsFrameClassRec emacsFrameClassRec = { - { /* core fields */ -#ifdef LWLIB_USES_MOTIF - /* superclass */ (WidgetClass) &xmPrimitiveClassRec, -#else - /* superclass */ &widgetClassRec, -#endif - /* class_name */ "EmacsFrame", - /* widget_size */ sizeof(EmacsFrameRec), - /* class_initialize */ EmacsFrameClassInitialize, - /* class_part_initialize */ 0, - /* class_inited */ FALSE, - /* initialize */ EmacsFrameInitialize, - /* initialize_hook */ 0, - /* realize */ EmacsFrameRealize, - /* actions */ emacsFrameActionsTable, - /* num_actions */ XtNumber (emacsFrameActionsTable), - /* resources */ resources, - /* resource_count */ XtNumber(resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ TRUE, - /* compress_exposure */ TRUE, - /* compress_enterleave */ TRUE, - /* visible_interest */ FALSE, - /* destroy */ NULL, - /* resize */ EmacsFrameResize, - /* expose */ XtInheritExpose, - /* set_values */ EmacsFrameSetValues, - /* set_values_hook */ 0, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ 0, - /* accept_focus */ XtInheritAcceptFocus, - /* version */ XtVersion, - /* callback_private */ 0, - /* tm_table */ emacsFrameTranslations, - /* query_geometry */ EmacsFrameQueryGeometry, - /* display_accelerator */ XtInheritDisplayAccelerator, - /* extension */ 0 - }, -#ifdef LWLIB_USES_MOTIF - { /* XmPrimitiveClassPart - */ - (XtWidgetProc) _XtInherit, /* border_highlight */ - (XtWidgetProc) _XtInherit, /* border_unhighlight */ - /* Setting the following to NULL causes PrimitiveInitialize() - not to add traversal (TAB etc. to switch focus) and - focus-in/out (border highlight/unhighlight) translations. - If you want those translations, use the value XtInheritTranslations - instead. Doing this, however, will interfere with Emacs - focus handling (which highlights/unhighlights the text cursor), - and will lead to strange display results around the border of the - widget. */ - NULL, /* translations */ - NULL, /* arm_and_activate */ - NULL, /* get resources */ - 0, /* num get_resources */ - NULL, /* extension */ - }, -#endif /* LWLIB_USES_MOTIF */ - { - 0 - } -}; -WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec; - -static void -update_various_frame_slots (EmacsFrame ew) -{ - ew->emacs_frame.frame->pixheight = ew->core.height; - ew->emacs_frame.frame->pixwidth = ew->core.width; -} - -static void -EmacsFrameInitialize (Widget request, Widget new, - ArgList dum1, Cardinal *dum2) -{ - EmacsFrame ew = (EmacsFrame)new; - struct frame *f = ew->emacs_frame.frame; - - if (!f) - fatal ("can't create an emacs frame widget without a frame."); - - ew->emacs_frame.frame->internal_border_width = - ew->emacs_frame.internal_border_width; -} - -void emacs_Xt_event_handler (Widget wid /* unused */, - XtPointer closure /* unused */, - XEvent *event, - Boolean *continue_to_dispatch /* unused */); - -static void -EmacsFrameRealize (Widget widget, XtValueMask *mask, - XSetWindowAttributes *attrs) -{ - EmacsFrame ew = (EmacsFrame) widget; - struct frame *f = ew->emacs_frame.frame; - Widget shell_widget = FRAME_X_SHELL_WIDGET (f); - - attrs->event_mask = - ExposureMask | - VisibilityChangeMask | - PropertyChangeMask | - StructureNotifyMask | - SubstructureNotifyMask | - /*SubstructureRedirectMask |*/ /* Only for WMs! */ - KeyPressMask | - KeyReleaseMask | - ButtonPressMask | - ButtonReleaseMask | - FocusChangeMask | - PointerMotionHintMask | - PointerMotionMask | - LeaveWindowMask | - EnterWindowMask; - - -#ifdef I18N4 - /* Make sure that events wanted by the input method are selected. */ - attrs->event_mask |= input_method_event_mask; -#endif - - *mask |= CWEventMask; - - if (ew->emacs_frame.use_backing_store) - { - attrs->backing_store = Always; - *mask |= CWBackingStore; - } - XtCreateWindow (widget, InputOutput, (Visual *)CopyFromParent, *mask, - attrs); - - /* snarf the events we want. */ - XtInsertEventHandler (widget, attrs->event_mask, TRUE, - emacs_Xt_event_handler, NULL, XtListHead); - /* some events (e.g. map-notify and WM_DELETE_WINDOW) get sent - directly to the shell, and the above event handler won't see - them. So add a handler to get them. These events don't - propagate, so there's no danger of them being seen twice. */ - XtInsertEventHandler (shell_widget, - EnterWindowMask | LeaveWindowMask | - VisibilityChangeMask | StructureNotifyMask | - KeyPressMask, - TRUE, emacs_Xt_event_handler, NULL, XtListHead); - -#ifdef EXTERNAL_WIDGET - /* #### Not sure if this special case is necessary */ - if (!FRAME_X_EXTERNAL_WINDOW_P (f)) -#endif - /* This is necessary under Motif in order to make it possible to click in - a buffer and move focus out of a dialog box or control panel and back - into emacs-land; also necessary so that you can still type chars - if the cursor is over the menubar or scrollbar. */ - lw_set_keyboard_focus (shell_widget, FRAME_X_TEXT_WIDGET (f)); -} - -/* DO NOT CALL THIS FUNCTION! Only Xt is supposed to do this. */ - -static void -EmacsFrameResize (Widget widget) -{ - EmacsFrame ew = (EmacsFrame)widget; - struct frame *f = ew->emacs_frame.frame; - int columns; - int rows; - XtWidgetGeometry req, repl; - - update_various_frame_slots (ew); - - pixel_to_char_size (f, ew->core.width, ew->core.height, &columns, &rows); - change_frame_size (f, rows, columns, 0); - - /* Now we tell the EmacsShell that we've changed the size of the non-fixed - portion of the frame. Note that, if we the resize occurred as a result - of EmacsFrameSetCharSize(), this information will be stored twice. - This is not a big deal, as storing this information doesn't actually - do anything until the next resize. */ - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - x_wm_set_variable_size (FRAME_X_SHELL_WIDGET (f), columns, rows); - - /* Kick the manager so that it knows we've changed size. */ - req.request_mode = 0; - XtQueryGeometry (FRAME_X_CONTAINER_WIDGET (f), &req, &repl); - EmacsManagerChangeSize (FRAME_X_CONTAINER_WIDGET (f), repl.width, - repl.height); -} - -static Boolean -EmacsFrameSetValues (Widget cur_widget, Widget req_widget, Widget new_widget, - ArgList argv, Cardinal *argc) -{ - EmacsFrame cur = (EmacsFrame) cur_widget; - EmacsFrame new = (EmacsFrame) new_widget; - struct frame *f = new->emacs_frame.frame; - Lisp_Object frame; - - XSETFRAME (frame, f); - in_resource_setting++; - /* This function does not need to do much. Pretty much everything - interesting will get done in the resize method, which will - (if necessary) get called by Xt when this function returns - (see below). - */ - - /* #### This function will not work if it is not called from - update_EmacsFrame(), called from SET_FACE_PROPERTY(). - The code located there should be moved inside of here instead, - so that things work if either SET_FACE_PROPERTY() is - called or XtSetValues() is called. - */ - - if (cur->emacs_frame.iconic != new->emacs_frame.iconic && - FRAME_X_TOP_LEVEL_FRAME_P (new->emacs_frame.frame)) - x_wm_set_shell_iconic_p (FRAME_X_SHELL_WIDGET (new->emacs_frame.frame), - new->emacs_frame.iconic); - - /* If we got here, then we were likely called as a result of - the EditRes protocol, so go ahead and change scrollbar-width - and scrollbar-height. Otherwise, we're merely mirroring - a change made to scrollbar-width etc. so don't do anything - special. */ - if (cur->emacs_frame.internal_border_width != - new->emacs_frame.internal_border_width) - { - f->internal_border_width = new->emacs_frame.internal_border_width; - MARK_FRAME_SIZE_SLIPPED (f); - } - -#ifdef HAVE_SCROLLBARS - if (cur->emacs_frame.scrollbar_width != - new->emacs_frame.scrollbar_width) - Fadd_spec_to_specifier - (Vscrollbar_width, - make_int (new->emacs_frame.scrollbar_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.scrollbar_height != - new->emacs_frame.scrollbar_height) - Fadd_spec_to_specifier - (Vscrollbar_height, - make_int (new->emacs_frame.scrollbar_height), - frame, Qnil, Qnil); -#endif /* HAVE_SCROLLBARS */ -#ifdef HAVE_TOOLBARS - if (cur->emacs_frame.top_toolbar_height != - new->emacs_frame.top_toolbar_height) - Fadd_spec_to_specifier - (Vtoolbar_size[TOP_TOOLBAR], - make_int (new->emacs_frame.top_toolbar_height), - frame, Qnil, Qnil); - if (cur->emacs_frame.bottom_toolbar_height != - new->emacs_frame.bottom_toolbar_height) - Fadd_spec_to_specifier - (Vtoolbar_size[BOTTOM_TOOLBAR], - make_int (new->emacs_frame.bottom_toolbar_height), - frame, Qnil, Qnil); - if (cur->emacs_frame.left_toolbar_width != - new->emacs_frame.left_toolbar_width) - Fadd_spec_to_specifier - (Vtoolbar_size[LEFT_TOOLBAR], - make_int (new->emacs_frame.left_toolbar_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.right_toolbar_width != - new->emacs_frame.right_toolbar_width) - Fadd_spec_to_specifier - (Vtoolbar_size[RIGHT_TOOLBAR], - make_int (new->emacs_frame.right_toolbar_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.top_toolbar_border_width != - new->emacs_frame.top_toolbar_border_width) - Fadd_spec_to_specifier - (Vtoolbar_border_width[TOP_TOOLBAR], - make_int (new->emacs_frame.top_toolbar_border_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.bottom_toolbar_border_width != - new->emacs_frame.bottom_toolbar_border_width) - Fadd_spec_to_specifier - (Vtoolbar_border_width[BOTTOM_TOOLBAR], - make_int (new->emacs_frame.bottom_toolbar_border_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.left_toolbar_border_width != - new->emacs_frame.left_toolbar_border_width) - Fadd_spec_to_specifier - (Vtoolbar_border_width[LEFT_TOOLBAR], - make_int (new->emacs_frame.left_toolbar_border_width), - frame, Qnil, Qnil); - if (cur->emacs_frame.right_toolbar_border_width != - new->emacs_frame.right_toolbar_border_width) - Fadd_spec_to_specifier - (Vtoolbar_border_width[RIGHT_TOOLBAR], - make_int (new->emacs_frame.right_toolbar_border_width), - frame, Qnil, Qnil); -#endif /* HAVE_TOOLBARS */ - - in_resource_setting--; - - /* If the request was to resize us, but the size has not changed, Xt - will do nothing, and won't call our resize callback. Since such a - request might be issued as a result of hiding/showing menubar or - changing toolbar placement, where we rely on relayout made by the - callback, we go ahead and simulate such a call */ - if (cur->core.width == new->core.width - && cur->core.height == new->core.height) - { - int i; - for (i=0; i<*argc; i++) - if (strcmp (argv[i].name, XtNwidth) == 0 - || strcmp (argv[i].name, XtNheight) == 0) - { - EmacsFrameResize (new_widget); - break; - } - } - - return False; - - /* Note that if either (a) we return True, or (b) the width or - height has changed, an Expose event will be generated. The Xt - manual says you should not return True if the width or height has - changed, because then two Expose events will be generated. - - In any case, there is no need to return True because - SET_FACE_PROPERTY(), which does the resource - setting, automatically forces a redisplay as necessary. */ -} - -static XtGeometryResult -EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, - XtWidgetGeometry *result) -{ - EmacsFrame ew = (EmacsFrame) widget; - int mask = request->request_mode; - Dimension width, height; - int ok_width_int, ok_height_int; - Dimension ok_width, ok_height; - - /* We have a definite preference for what size we would like - to be. - - 1) If a preferred size was specified for us, use it. - (This is not currently used) - 2) If a proposed size was given, round it to the nearest - multiple of the default char size and return it. - 3) Otherwise, take our current size and round it to the - nearest multiple of the default char size. */ - - width = mask & CWWidth ? request->width : ew->core.width; - height = mask & CWHeight ? request->height : ew->core.height; - round_size_to_char (ew->emacs_frame.frame, width, height, - &ok_width_int, &ok_height_int); - ok_width = (Dimension) ok_width_int; - ok_height = (Dimension) ok_height_int; - if (ew->emacs_frame.preferred_width) - ok_width = ew->emacs_frame.preferred_width; - if (ew->emacs_frame.preferred_height) - ok_height = ew->emacs_frame.preferred_height; - result->request_mode |= CWWidth | CWHeight; - result->width = ok_width; - result->height = ok_height; - if (((mask & CWWidth) && ok_width != request->width) - || ((mask & CWHeight) && ok_height != request->height)) - return XtGeometryAlmost; - else - return XtGeometryYes; -} - -/* Xt string-to-scrollbar-placement converter */ -/* ### Convert this to a `new-style' converter (See XtAddTypeConverter) */ - -/* This variable cannot be a stack variable. */ -static unsigned char cvt_string_scrollbar_placement; - -/* ARGSUSED */ -static void -Xt_StringToScrollBarPlacement (XrmValuePtr args, /* unused */ - Cardinal *num_args, /* unused */ - XrmValuePtr fromVal, - XrmValuePtr toVal) -{ - XrmQuark q; - char *lowerName = (char *) alloca (strlen ((char *) fromVal->addr) + 1); - - XmuCopyISOLatin1Lowered (lowerName, (char *) fromVal->addr); - q = XrmStringToQuark (lowerName); - - toVal->size = sizeof (cvt_string_scrollbar_placement); - toVal->addr = (XPointer) &cvt_string_scrollbar_placement; - - if (q == XrmStringToQuark ("top-left") - || q == XrmStringToQuark ("top_left")) - cvt_string_scrollbar_placement = XtTOP_LEFT; - else if (q == XrmStringToQuark ("bottom-left") - || q == XrmStringToQuark ("bottom_left")) - cvt_string_scrollbar_placement = XtBOTTOM_LEFT; - else if (q == XrmStringToQuark ("top-right") - || q == XrmStringToQuark ("top_right")) - cvt_string_scrollbar_placement = XtTOP_RIGHT; - else if (q == XrmStringToQuark ("bottom-right") - || q == XrmStringToQuark ("bottom_right")) - cvt_string_scrollbar_placement = XtBOTTOM_RIGHT; - else - { - XtStringConversionWarning (fromVal->addr, "scrollBarPlacement"); - toVal->addr = NULL; - toVal->size = 0; - } -} - -static void -EmacsFrameClassInitialize (void) -{ - XtAddConverter (XtRString, XtRScrollBarPlacement, - Xt_StringToScrollBarPlacement, NULL, 0); -} - -/********************* Special entrypoints *******************/ - -void -EmacsFrameRecomputeCellSize (Widget w) -{ - EmacsFrame ew = (EmacsFrame) w; - int cw, ch; - struct frame *f = ew->emacs_frame.frame; - - if (! XtIsSubclass (w, emacsFrameClass)) - abort (); - - default_face_height_and_width (make_frame (f), &ch, &cw); - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - x_wm_set_cell_size (FRAME_X_SHELL_WIDGET (f), cw, ch); -} - -/* Set the size of the widget to have the number of rows and columns - specified. This both causes the X window to change and the - internal frame structures to get modified to match. */ - -void -EmacsFrameSetCharSize (Widget widget, int columns, int rows) -{ - EmacsFrame ew = (EmacsFrame) widget; - int pixel_width, pixel_height; - struct frame *f = ew->emacs_frame.frame; - - if (columns < 3) - columns = 3; /* no way buddy */ - if (rows < 1) - rows = 1; - - char_to_pixel_size (f, columns, rows, &pixel_width, &pixel_height); - - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - x_wm_set_variable_size (FRAME_X_SHELL_WIDGET (f), columns, rows); - - { - Arg al [2]; - XtSetArg (al [0], XtNwidth, pixel_width); - XtSetArg (al [1], XtNheight, pixel_height); - XtSetValues ((Widget) ew, al, countof (al)); - } -} diff --git a/src/EmacsFrame.h b/src/EmacsFrame.h deleted file mode 100644 index 79d62e7..0000000 --- a/src/EmacsFrame.h +++ /dev/null @@ -1,350 +0,0 @@ -/* Public header for the Emacs frame widget. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -#ifndef _EmacsFrame_h -#define _EmacsFrame_h - -#ifndef XtNminibuffer -#define XtNminibuffer "minibuffer" -#endif -#ifndef XtCMinibuffer -#define XtCMinibuffer "Minibuffer" -#endif - -#ifndef XtNunsplittable -#define XtNunsplittable "unsplittable" -#endif -#ifndef XtCUnsplittable -#define XtCUnsplittable "Unsplittable" -#endif - -#ifndef XtNinternalBorderWidth -#define XtNinternalBorderWidth "internalBorderWidth" -#endif -#ifndef XtCInternalBorderWidth -#define XtCInternalBorderWidth "InternalBorderWidth" -#endif - -#ifndef XtNscrollBarWidth -#define XtNscrollBarWidth "scrollBarWidth" -#endif -#ifndef XtCScrollBarWidth -#define XtCScrollBarWidth "ScrollBarWidth" -#endif - -#ifndef XtNscrollBarHeight -#define XtNscrollBarHeight "scrollBarHeight" -#endif -#ifndef XtCScrollBarHeight -#define XtCScrollBarHeight "ScrollBarHeight" -#endif - -#ifndef XtNtopToolBarHeight -#define XtNtopToolBarHeight "topToolBarHeight" -#endif -#ifndef XtCTopToolBarHeight -#define XtCTopToolBarHeight "TopToolBarHeight" -#endif - -#ifndef XtNbottomToolBarHeight -#define XtNbottomToolBarHeight "bottomToolBarHeight" -#endif -#ifndef XtCBottomToolBarHeight -#define XtCBottomToolBarHeight "BottomToolBarHeight" -#endif - -#ifndef XtNleftToolBarWidth -#define XtNleftToolBarWidth "leftToolBarWidth" -#endif -#ifndef XtCLeftToolBarWidth -#define XtCLeftToolBarWidth "LeftToolBarWidth" -#endif - -#ifndef XtNrightToolBarWidth -#define XtNrightToolBarWidth "rightToolBarWidth" -#endif -#ifndef XtCRightToolBarWidth -#define XtCRightToolBarWidth "RightToolBarWidth" -#endif - -#ifndef XtNtopToolBarBorderWidth -#define XtNtopToolBarBorderWidth "topToolBarBorderWidth" -#endif -#ifndef XtCTopToolBarBorderWidth -#define XtCTopToolBarBorderWidth "TopToolBarBorderWidth" -#endif - -#ifndef XtNbottomToolBarBorderWidth -#define XtNbottomToolBarBorderWidth "bottomToolBarBorderWidth" -#endif -#ifndef XtCBottomToolBarBorderWidth -#define XtCBottomToolBarBorderWidth "BottomToolBarBorderWidth" -#endif - -#ifndef XtNleftToolBarBorderWidth -#define XtNleftToolBarBorderWidth "leftToolBarBorderWidth" -#endif -#ifndef XtCLeftToolBarBorderWidth -#define XtCLeftToolBarBorderWidth "LeftToolBarBorderWidth" -#endif - -#ifndef XtNrightToolBarBorderWidth -#define XtNrightToolBarBorderWidth "rightToolBarBorderWidth" -#endif -#ifndef XtCRightToolBarBorderWidth -#define XtCRightToolBarBorderWidth "RightToolBarBorderWidth" -#endif - -#ifndef XtNtopToolBarShadowColor -#define XtNtopToolBarShadowColor "topToolBarShadowColor" -#endif -#ifndef XtCTopToolBarShadowColor -#define XtCTopToolBarShadowColor "TopToolBarShadowColor" -#endif - -#ifndef XtNbottomToolBarShadowColor -#define XtNbottomToolBarShadowColor "bottomToolBarShadowColor" -#endif -#ifndef XtCBottomToolBarShadowColor -#define XtCBottomToolBarShadowColor "BottomToolBarShadowColor" -#endif - -#ifndef XtNbackgroundToolBarColor -#define XtNbackgroundToolBarColor "backgroundToolBarColor" -#endif -#ifndef XtCBackgroundToolBarColor -#define XtCBackgroundToolBarColor "BackgroundToolBarColor" -#endif - -#ifndef XtNforegroundToolBarColor -#define XtNforegroundToolBarColor "foregroundToolBarColor" -#endif -#ifndef XtCForegroundToolBarColor -#define XtCForegroundToolBarColor "ForegroundToolBarColor" -#endif - -#ifndef XtNtopToolBarShadowPixmap -#define XtNtopToolBarShadowPixmap "topToolBarShadowPixmap" -#endif -#ifndef XtCTopToolBarShadowPixmap -#define XtCTopToolBarShadowPixmap "TopToolBarShadowPixmap" -#endif - -#ifndef XtNbottomToolBarShadowPixmap -#define XtNbottomToolBarShadowPixmap "bottomToolBarShadowPixmap" -#endif -#ifndef XtCBottomToolBarShadowPixmap -#define XtCBottomToolBarShadowPixmap "BottomToolBarShadowPixmap" -#endif - -#ifndef XtNtoolBarShadowThickness -#define XtNtoolBarShadowThickness "toolBarShadowThickness" -#endif -#ifndef XtCToolBarShadowThickness -#define XtCToolBarShadowThickness "ToolBarShadowThickness" -#endif - -#ifndef XtNscrollBarPlacement -#define XtNscrollBarPlacement "scrollBarPlacement" -#endif -#ifndef XtCScrollBarPlacement -#define XtCScrollBarPlacement "ScrollBarPlacement" -#endif -#ifndef XtRScrollBarPlacement -#define XtRScrollBarPlacement "ScrollBarPlacement" -#endif - -#ifndef XtNinterline -#define XtNinterline "interline" -#endif -#ifndef XtCInterline -#define XtCInterline "Interline" -#endif - -#ifndef XtNfont -#define XtNfont "font" -#endif -#ifndef XtCFont -#define XtCFont "Font" -#endif - -#ifndef XtNforeground -#define XtNforeground "foreground" -#endif -#ifndef XtCForeground -#define XtCForeground "Foreground" -#endif - -#ifndef XtNbackground -#define XtNbackground "background" -#endif -#ifndef XtCBackground -#define XtCBackground "Background" -#endif - -#ifndef XtNiconic -#define XtNiconic "iconic" -#endif -#ifndef XtCIconic -#define XtCIconic "Iconic" -#endif - -#ifndef XtNcursorColor -#define XtNcursorColor "cursorColor" -#endif -#ifndef XtCCursorColor -#define XtCCursorColor "CursorColor" -#endif - -#ifndef XtNbarCursor -#define XtNbarCursor "barCursor" -#endif -#ifndef XtCBarCursor -#define XtCBarCursor "BarCursor" -#endif - -#ifndef XtNvisualBell -#define XtNvisualBell "visualBell" -#endif -#ifndef XtCVisualBell -#define XtCVisualBell "VisualBell" -#endif - -#ifndef XtNbellVolume -#define XtNbellVolume "bellVolume" -#endif -#ifndef XtCBellVolume -#define XtCBellVolume "BellVolume" -#endif - -#ifndef XtNpointerBackground -#define XtNpointerBackground "pointerBackground" -#endif - -#ifndef XtNpointerColor -#define XtNpointerColor "pointerColor" -#endif - -#ifndef XtNtextPointer -#define XtNtextPointer "textPointer" -#endif - -#ifndef XtNspacePointer -#define XtNspacePointer "spacePointer" -#endif - -#ifndef XtNmodeLinePointer -#define XtNmodeLinePointer "modePointer" -#endif - -#ifndef XtNgcPointer -#define XtNgcPointer "gcPointer" -#endif - -#ifndef XtNemacsFrame -#define XtNemacsFrame "emacsFrame" -#endif -#ifndef XtCEmacsFrame -#define XtCEmacsFrame "EmacsFrame" -#endif - -#ifndef XtNgeometry -#define XtNgeometry "geometry" -#endif -#ifndef XtCGeometry -#define XtCGeometry "Geometry" -#endif - -#ifndef XtNinitialGeometry -#define XtNinitialGeometry "initialGeometry" -#endif -#ifndef XtCInitialGeometry -#define XtCInitialGeometry "InitialGeometry" -#endif - -#ifndef XtNmenubar -#define XtNmenubar "menubar" -#endif -#ifndef XtCMenubar -#define XtCMenubar "Menubar" -#endif - -#ifndef XtNinitiallyUnmapped -#define XtNinitiallyUnmapped "initiallyUnmapped" -#endif -#ifndef XtCInitiallyUnmapped -#define XtCInitiallyUnmapped "InitiallyUnmapped" -#endif - -#ifndef XtNpreferredWidth -#define XtNpreferredWidth "preferredWidth" -#endif -#ifndef XtCPreferredWidth -#define XtCPreferredWidth "PreferredWidth" -#endif - -#ifndef XtNpreferredHeight -#define XtNpreferredHeight "preferredHeight" -#endif -#ifndef XtCPreferredHeight -#define XtCPreferredHeight "PreferredHeight" -#endif - -#ifndef XtNuseBackingStore -#define XtNuseBackingStore "useBackingStore" -#endif -#ifndef XtCUseBackingStore -#define XtCUseBackingStore "UseBackingStore" -#endif - -#define XtNximStyles "ximStyles" -#define XtCXimStyles "XimStyles" -#define XtRXimStyles "XimStyles" - -#define XtNximForeground "ximForeground" -#define XtNximBackground "ximBackground" - -/* scrollbar placement types; like in ScrolledW.h */ -#define EM_TOP 1 -#define EM_BOTTOM 0 -#define EM_LEFT 2 -#define EM_RIGHT 0 - -#define XtTOP_LEFT (EM_TOP | EM_LEFT) -#define XtBOTTOM_LEFT (EM_BOTTOM | EM_LEFT) -#define XtTOP_RIGHT (EM_TOP | EM_RIGHT) -#define XtBOTTOM_RIGHT (EM_BOTTOM | EM_RIGHT) - -/* structures */ -typedef struct _EmacsFrameRec *EmacsFrame; -typedef struct _EmacsFrameClassRec *EmacsFrameClass; - -extern WidgetClass emacsFrameClass; - -extern struct _DisplayContext* display_context; - -/* Special entrypoints */ -void EmacsFrameRecomputeCellSize (Widget widget); -void EmacsFrameSetCharSize (Widget widget, int rows, int cols); - -#endif /* _EmacsFrame_h */ diff --git a/src/EmacsFrameP.h b/src/EmacsFrameP.h deleted file mode 100644 index df7f0ad..0000000 --- a/src/EmacsFrameP.h +++ /dev/null @@ -1,114 +0,0 @@ -/* Private header for the Emacs frame widget. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -#ifndef _EmacsFrameP_h -#define _EmacsFrameP_h - -#include "xintrinsicp.h" -#include -#ifdef LWLIB_USES_MOTIF -#include "xmprimitivep.h" -#endif -#include "EmacsFrame.h" - -typedef struct { - struct frame* frame; /* the *emacs* frame object */ - - /* Resources that can't be done from lisp. - */ - char* geometry; /* geometry spec of this frame */ - Boolean iconic; /* whether this frame is iconic */ - - /* The rest of this is crap and should be deleted. - */ - Boolean minibuffer; /* 0: normal frames with minibuffers. - * 1: frames without minibuffers - * 2: minibuffer only. */ - Boolean unsplittable; /* frame can only have one window */ - - int internal_border_width; /* internal borders */ - int scrollbar_width; /* width of frame vertical sb's */ - int scrollbar_height; /* height of frame horizontal sb's */ - int top_toolbar_height; /* height of top toolbar */ - int bottom_toolbar_height; /* height of bottom toolbar */ - int left_toolbar_width; /* width of left toolbar */ - int right_toolbar_width; /* width of right toolbar */ - int top_toolbar_border_width; /* border width */ - int bottom_toolbar_border_width; /* ... of bottom toolbar */ - int left_toolbar_border_width; /* ... of left toolbar */ - int right_toolbar_border_width; /* ... of right toolbar */ - Pixel top_toolbar_shadow_pixel; - Pixel bottom_toolbar_shadow_pixel; - Pixel background_toolbar_pixel; - Pixel foreground_toolbar_pixel; - Pixmap top_toolbar_shadow_pixmap; - Pixmap bottom_toolbar_shadow_pixmap; - Dimension toolbar_shadow_thickness; - unsigned char scrollbar_placement; - int interline; /* skips between lines */ - - XFontStruct* font; /* font */ - Pixel foreground_pixel; /* foreground */ - Pixel background_pixel; /* background */ - - Pixel cursor_color; /* text cursor color */ - Boolean bar_cursor; /* 1 if bar, 0 if block */ - - Boolean visual_bell; /* flash instead of beep */ - int bell_volume; /* how loud is beep */ - - Boolean menubar_p; /* initially show a menubar? */ - Boolean initially_unmapped; /* inhibit initial window mapping */ - Boolean use_backing_store; /* backing store for menubar & ew? */ - - Dimension preferred_width; /* if non-zero, preferred size for */ - Dimension preferred_height; /* QueryGeometry() */ - /* private state */ - -} EmacsFramePart; - -typedef struct _EmacsFrameRec { /* full instance record */ - CorePart core; -#ifdef LWLIB_USES_MOTIF - XmPrimitivePart primitive; -#endif - EmacsFramePart emacs_frame; -} EmacsFrameRec; - -typedef struct { /* new fields for EmacsFrame class */ - int dummy; -} EmacsFrameClassPart; - -typedef struct _EmacsFrameClassRec { /* full class record declaration */ - CoreClassPart core_class; -#ifdef LWLIB_USES_MOTIF - XmPrimitiveClassPart primitive_class; -#endif - EmacsFrameClassPart emacs_frame_class; -} EmacsFrameClassRec; - -extern EmacsFrameClassRec emacsFrameClassRec; /* class pointer */ - - - -#endif /* _EmacsFrameP_h */ diff --git a/src/EmacsManager.c b/src/EmacsManager.c deleted file mode 100644 index 2d02f8d..0000000 --- a/src/EmacsManager.c +++ /dev/null @@ -1,249 +0,0 @@ -/* Emacs manager widget. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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, May, 1994. */ - -#include - -#include -#include "EmacsManagerP.h" -#ifdef LWLIB_MENUBARS_MOTIF -#include -#endif /* LWLIB_MENUBARS_MOTIF */ - -/* For I, Emacs, am a kind god. Unlike the goddess Athena and the - Titan Motif, I require no ritual sacrifices to placate the lesser - daemons of geometry management. */ - -static XtResource resources[] = { -#define offset(field) XtOffset(EmacsManagerWidget, emacs_manager.field) - { XtNresizeCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(resize_callback), XtRImmediate, (XtPointer) 0 }, - { XtNqueryGeometryCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(query_geometry_callback), XtRImmediate, (XtPointer) 0 }, - { XtNuserData, XtCUserData, XtRPointer, sizeof(XtPointer), - offset(user_data), XtRImmediate, (XtPointer) 0 }, -}; - -/**************************************************************** - * - * Full class record constant - * - ****************************************************************/ - -static XtGeometryResult QueryGeometry (Widget wid, - XtWidgetGeometry *request, - XtWidgetGeometry *reply); -static void Resize (Widget w); -static XtGeometryResult GeometryManager (Widget w, XtWidgetGeometry *request, - XtWidgetGeometry *reply); -static void ChangeManaged (Widget w); -static void Realize (Widget w, Mask *valueMask, - XSetWindowAttributes *attributes); -static void ClassInitialize (void); - -EmacsManagerClassRec emacsManagerClassRec = { - { -/* core_class fields */ -#ifdef LWLIB_USES_MOTIF - /* superclass */ (WidgetClass) &xmManagerClassRec, -#else - /* superclass */ (WidgetClass) &compositeClassRec, -#endif - /* class_name */ "EmacsManager", - /* widget_size */ sizeof(EmacsManagerRec), - /* class_initialize */ ClassInitialize, - /* class_part_init */ NULL, - /* class_inited */ FALSE, - /* initialize */ NULL, - /* initialize_hook */ NULL, - /* realize */ Realize, - /* actions */ NULL, - /* num_actions */ 0, - /* resources */ resources, - /* num_resources */ XtNumber(resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ TRUE, - /* compress_exposure */ TRUE, - /* compress_enterleave*/ TRUE, - /* visible_interest */ FALSE, - /* destroy */ NULL, - /* resize */ Resize, - /* expose */ NULL, - /* set_values */ NULL, - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, - /* accept_focus */ NULL, - /* version */ XtVersion, - /* callback_private */ NULL, - /* tm_table */ XtInheritTranslations, - /* query_geometry */ QueryGeometry, - /* display_accelerator*/ XtInheritDisplayAccelerator, - /* extension */ NULL - }, - { -/* composite_class fields */ - /* geometry_manager */ GeometryManager, - /* change_managed */ ChangeManaged, - /* insert_child */ XtInheritInsertChild, - /* delete_child */ XtInheritDeleteChild, - /* extension */ NULL - }, -#ifdef LWLIB_USES_MOTIF - { - /* constraint_class fields */ - NULL, /* resource list */ - 0, /* num resources */ - 0, /* constraint size */ - (XtInitProc)NULL, /* init proc */ - (XtWidgetProc)NULL, /* destroy proc */ - (XtSetValuesFunc)NULL, /* set values proc */ - NULL, /* extension */ - }, - { -/* manager_class fields */ - XtInheritTranslations, /* translations */ - NULL, /* syn_resources */ - 0, /* num_syn_resources */ - NULL, /* syn_cont_resources */ - 0, /* num_syn_cont_resources */ - XmInheritParentProcess, /* parent_process */ - NULL, /* extension */ - }, -#endif - { -/* emacs_manager_class fields */ - /* empty */ 0, - } -}; - -WidgetClass emacsManagerWidgetClass = (WidgetClass)&emacsManagerClassRec; - -/* What is my preferred size? A suggested size may be given. */ - -static XtGeometryResult -QueryGeometry (Widget w, XtWidgetGeometry *request, XtWidgetGeometry *reply) -{ - EmacsManagerWidget emw = (EmacsManagerWidget) w; - EmacsManagerQueryGeometryStruct struc; - int mask = request->request_mode & (CWWidth | CWHeight); - - struc.request_mode = mask; - if (mask & CWWidth) struc.proposed_width = request->width; - if (mask & CWHeight) struc.proposed_height = request->height; - XtCallCallbackList (w, emw->emacs_manager.query_geometry_callback, &struc); - reply->request_mode = CWWidth | CWHeight; - reply->width = struc.proposed_width; - reply->height = struc.proposed_height; - if (((mask & CWWidth) && (request->width != reply->width)) || - ((mask & CWHeight) && (request->height != reply->height))) - return XtGeometryAlmost; - return XtGeometryYes; -} - -static void -Resize (Widget w) -{ - EmacsManagerWidget emw = (EmacsManagerWidget) w; - EmacsManagerResizeStruct struc; - - struc.width = w->core.width; - struc.height = w->core.height; - XtCallCallbackList (w, emw->emacs_manager.resize_callback, &struc); -} - -static XtGeometryResult -GeometryManager (Widget w, XtWidgetGeometry *request, XtWidgetGeometry *reply) -{ - /* Sure, any changes are fine. */ -#define COPY(field, mask) \ - if (request->request_mode & mask) w->core.field = request->field - - /* The Motif menubar will merrily request a new size every time a - child is added or deleted. Blow it off because it doesn't know - what it's talking about. */ -#ifdef LWLIB_MENUBARS_MOTIF - if (!(XtClass (w) == xmRowColumnWidgetClass)) -#endif /* LWLIB_MENUBARS_MOTIF */ - { - COPY (width, CWWidth); - COPY (height, CWHeight); - } - COPY (border_width, CWBorderWidth); - COPY (x, CWX); - COPY (y, CWY); -#undef COPY - - return XtGeometryYes; -} - -static void -ChangeManaged (Widget w) -{ - if (!XtIsRealized (w)) - { - XtWidgetGeometry req, repl; - - /* find out how big we'd like to be ... */ - - req.request_mode = 0; - XtQueryGeometry (w, &req, &repl); - EmacsManagerChangeSize (w, repl.width, repl.height); - } -} - -static void -Realize (Widget w, Mask *valueMask, XSetWindowAttributes *attributes) -{ - attributes->bit_gravity = NorthWestGravity; - *valueMask |= CWBitGravity; - - XtCreateWindow (w, (unsigned) InputOutput, (Visual *) CopyFromParent, - *valueMask, attributes); -} - -static void -ClassInitialize (void) -{ - return; -} - -void -EmacsManagerChangeSize (Widget w, Dimension width, Dimension height) -{ - if (width == 0) - width = w->core.width; - if (height == 0) - height = w->core.height; - - /* do nothing if we're already that size */ - if (w->core.width != width || w->core.height != height) - if (XtMakeResizeRequest (w, width, height, &w->core.width, &w->core.height) - == XtGeometryAlmost) - XtMakeResizeRequest (w, w->core.width, w->core.height, NULL, NULL); - - Resize (w); -} - - diff --git a/src/EmacsManager.h b/src/EmacsManager.h deleted file mode 100644 index 4fe91e4..0000000 --- a/src/EmacsManager.h +++ /dev/null @@ -1,62 +0,0 @@ -/* Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -#ifndef _EmacsManager_h -#define _EmacsManager_h - -#ifndef XtNresizeCallback -#define XtNresizeCallback "resizeCallback" -#endif - -#ifndef XtNqueryGeometryCallback -#define XtNqueryGeometryCallback "queryGeometryCallback" -#endif - -#ifndef XtNuserData -#define XtNuserData "userData" -#endif -#ifndef XtCUserData -#define XtCUserData "UserData" -#endif - -typedef struct _EmacsManagerClassRec *EmacsManagerWidgetClass; -typedef struct _EmacsManagerRec *EmacsManagerWidget; -extern WidgetClass emacsManagerWidgetClass; - -/* External entry points */ -typedef struct -{ - Dimension width, height; -} EmacsManagerResizeStruct; - -typedef struct -{ - Dimension proposed_width, proposed_height; - XtGeometryMask request_mode; -} EmacsManagerQueryGeometryStruct; - -void EmacsManagerChangeSize (Widget w, Dimension width, Dimension height); - -#endif /* _EmacsManager_h */ diff --git a/src/EmacsManagerP.h b/src/EmacsManagerP.h deleted file mode 100644 index d46b177..0000000 --- a/src/EmacsManagerP.h +++ /dev/null @@ -1,68 +0,0 @@ -/* Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1993-1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -#ifndef _EmacsManagerP_h -#define _EmacsManagerP_h - - -#include "xintrinsicp.h" -#ifdef LWLIB_USES_MOTIF -#include "xmmanagerp.h" -#endif -#include "EmacsManager.h" - -typedef struct { /* new fields for EmacsManager class */ - int dummy; -} EmacsManagerClassPart; - -typedef struct _EmacsManagerClassRec { /* full class record declaration */ - CoreClassPart core_class; - CompositeClassPart composite_class; -#ifdef LWLIB_USES_MOTIF - ConstraintClassPart constraint_class; - XmManagerClassPart manager_class; -#endif - EmacsManagerClassPart emacs_manager_class; -} EmacsManagerClassRec; - -typedef struct { /* new fields for EmacsManager widget */ - XtCallbackList resize_callback; - XtCallbackList query_geometry_callback; - XtPointer user_data; -} EmacsManagerPart; - -typedef struct _EmacsManagerRec { /* full instance record */ - CorePart core; - CompositePart composite; -#ifdef LWLIB_USES_MOTIF - ConstraintPart constraint; - XmManagerPart manager; -#endif - EmacsManagerPart emacs_manager; -} EmacsManagerRec; - -extern EmacsManagerClassRec emacsManagerClassRec; /* class pointer */ - -#endif /* _EmacsManagerP_h */ diff --git a/src/EmacsShell-sub.c b/src/EmacsShell-sub.c deleted file mode 100644 index 4abacff..0000000 --- a/src/EmacsShell-sub.c +++ /dev/null @@ -1,381 +0,0 @@ -/* Emacs shell widget -- define the two widgets. - Copyright (C) 1994, 1995 Sun Microsystems, 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. */ - -/* Written by Ben Wing, May, 1994. */ - -/* - It is rather unfortunate that we have to do this. Blame those - short-sighted people who designed the monstrosities known as - Xt and ICCCM. -*/ - -/* - This widget is not actually Emacs-specific; perhaps there could - be a better name than "EmacsShell". What it does is work around - a limitation in Xt in correctly dealing with the window-manager - size hints with applications that - - (a) dynamically change their window size - (b) have a cell size (width-inc and height-inc) other than 1 - - and - - (c) cannot predict in advance exactly what size their shell will be - (This is the more common situation, when you have a number - of widgets, each with their own size ideas) - - This widget assumes that your program contains a fixed "base size" - plus some number of cells (e.g. character cells). The WMShell - resources "widthInc" and "heightInc" specify the size of a - character cell, and the window manager will report the app's - size in cells rather than in pixels. - - If you use this widget, do not use the WMShell resources - "baseWidth", "baseHeight", "minWidth", or "minHeight". - Instead, use "widthCells" and "heightCells" to specify the - current size in cells (you must keep this up-to-date), - and "minWidthCells" and "minHeightCells" to specify the - minimum size in cells. - - Every time that the program issues a size command, the - "baseWidth", "baseHeight", "minWidth", and "minHeight" fields - of the WM_NORMAL_HINTS property will be updated to stay in - line with the resource values specified above. The calculations - are done once the desired shell size is known but before the - window-manager size-change request is issued. (We must do it - at this time because before then we don't know what size we - will request, and after the request the deed has already - been done.) - - After you change the "baseWidth", "baseHeight", "minWidth", - or "minHeight" resources, you need to call - EmacsShellUpdateSizeHints() to manually update the size - hints, except in the following two circumstances: - - (a) you are about to make a geometry request. - (b) you are changing only "baseWidth" and "baseHeight" - from within a resize procedure. (In this case, - the size hints are already correct.) - -*/ - -#include - -#include -#include -#include -#include "xintrinsicp.h" -#include -#include -#include -#include -#include "EmacsShellP.h" - -#if defined (DEFINE_TOP_LEVEL_EMACS_SHELL) -#define EMACS_SHELL_WIDGET TopLevelEmacsShellWidget -#define SUPERCLASS_WIDGET_CLASS topLevelShellWidgetClass -#define SUPERCLASS_CLASS_REC topLevelShellClassRec -#define EMACS_SHELL_REC TopLevelEmacsShellRec -#define EMACS_SHELL_CLASS_REC topLevelEmacsShellClassRec -#define EMACS_SHELL_CLASS_REC_TYPE TopLevelEmacsShellClassRec -#define EMACS_SHELL_CLASS_NAME "TopLevelEmacsShell" -#define EMACS_SHELL_WIDGET_CLASS topLevelEmacsShellWidgetClass -#define EMACS_SHELL_UPDATE_SIZE_HINTS TopLevelEmacsShellUpdateSizeHints -#elif defined (DEFINE_TRANSIENT_EMACS_SHELL) -#define EMACS_SHELL_WIDGET TransientEmacsShellWidget -#define SUPERCLASS_WIDGET_CLASS transientShellWidgetClass -#define SUPERCLASS_CLASS_REC transientShellClassRec -#define EMACS_SHELL_REC TransientEmacsShellRec -#define EMACS_SHELL_CLASS_REC transientEmacsShellClassRec -#define EMACS_SHELL_CLASS_REC_TYPE TransientEmacsShellClassRec -#define EMACS_SHELL_CLASS_NAME "TransientEmacsShell" -#define EMACS_SHELL_WIDGET_CLASS transientEmacsShellWidgetClass -#define EMACS_SHELL_UPDATE_SIZE_HINTS TransientEmacsShellUpdateSizeHints -#else -Error. Must define either DEFINE_TOP_LEVEL_EMACS_SHELL or -DEFINE_TRANSIENT_EMACS_SHELL. -#endif - -typedef struct { - XtPointer next_extension; - XrmQuark record_type; - long version; - Cardinal record_size; -} GenericClassExtRec; - -static XtGeometryResult RootGeometryManager (Widget gw, - XtWidgetGeometry *request, XtWidgetGeometry *reply); -static void ChangeManaged (Widget w); - -/* snarfed from Shell.c */ -#define BIGSIZE ((Dimension)32767) - -static XtResource resources[] = { -#define offset(field) XtOffset(EMACS_SHELL_WIDGET, emacs_shell.field) -#define coreoffset(field) XtOffset(EMACS_SHELL_WIDGET, core.field) -#ifdef LWLIB_USES_MOTIF - /* *** BOGOSITY^10! *** The Motif VendorShell fucks around with - the default values for X and Y, for no obvious reason. This - causes Shell to indicate that the defaults of (0,0) were - program-specified, instead of letting the WM do what it wants. */ - {XtNx, XtCPosition, XtRPosition, sizeof(Position), - coreoffset (x), XtRImmediate, (XtPointer)BIGSIZE}, - {XtNy, XtCPosition, XtRPosition, sizeof(Position), - coreoffset (y), XtRImmediate, (XtPointer)BIGSIZE}, -#endif - { XtNwidthCells, XtCWidthCells, XtRInt, sizeof(int), - offset (width_cells), XtRImmediate, (XtPointer)0}, - { XtNheightCells, XtCHeightCells, XtRInt, sizeof(int), - offset (height_cells), XtRImmediate, (XtPointer)0}, - { XtNminWidthCells, XtCMinWidthCells, XtRInt, sizeof(int), - offset (min_width_cells), XtRImmediate, (XtPointer)0}, - { XtNminHeightCells, XtCMinHeightCells, XtRInt, sizeof(int), - offset (min_height_cells), XtRImmediate, (XtPointer)0}, -}; - -static CompositeClassExtensionRec compositeClassExtRec = { - NULL, - NULLQUARK, - XtCompositeExtensionVersion, - sizeof(CompositeClassExtensionRec), - TRUE, -}; - -static ShellClassExtensionRec shellClassExtRec = { - NULL, - NULLQUARK, - XtShellExtensionVersion, - sizeof(ShellClassExtensionRec), - RootGeometryManager -}; - -EMACS_SHELL_CLASS_REC_TYPE EMACS_SHELL_CLASS_REC = { - { /* - * core_class fields - */ - /* superclass */ (WidgetClass) &SUPERCLASS_CLASS_REC, - /* class_name */ (String) EMACS_SHELL_CLASS_NAME, - /* size */ sizeof(EMACS_SHELL_REC), - /* Class Initializer */ NULL, - /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ - /* Class init'ed ? */ FALSE, - /* initialize */ NULL, - /* initialize_notify */ NULL, - /* realize */ XtInheritRealize, - /* actions */ NULL, - /* num_actions */ 0, - /* resources */ resources, - /* resource_count */ XtNumber (resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ FALSE, - /* compress_exposure */ TRUE, - /* compress_enterleave*/ FALSE, - /* visible_interest */ TRUE, - /* destroy */ NULL, - /* resize */ XtInheritResize, - /* expose */ NULL, - /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, - /* accept_focus */ NULL, - /* intrinsics version */ XtVersion, - /* callback offsets */ NULL, - /* tm_table */ NULL, - /* query_geometry */ NULL, - /* display_accelerator*/ NULL, - /* extension */ NULL - },{ /* Composite */ - /* geometry_manager */ XtInheritGeometryManager, - /* change_managed */ ChangeManaged, - /* insert_child */ XtInheritInsertChild, - /* delete_child */ XtInheritDeleteChild, - /* extension */ (XtPointer)&compositeClassExtRec - },{ /* Shell */ - /* extension */ (XtPointer)&shellClassExtRec - },{ /* WMShell */ - /* extension */ NULL - },{ /* VendorShell */ - /* extension */ NULL - },{ /* TopLevelShell or TransientShell */ - /* both have exactly one XtPointer here. */ - /* extension */ NULL - },{ /* EmacsShell */ - 0 - } -}; - -WidgetClass EMACS_SHELL_WIDGET_CLASS = (WidgetClass) &EMACS_SHELL_CLASS_REC; - -static void -update_size_hints_internal (EMACS_SHELL_WIDGET w, - int width, int height) -{ - int base_width, base_height; - int cell_width, cell_height; - Arg al [10]; - - /* time to update them thar size hints */ - cell_width = w->wm.size_hints.width_inc; - cell_height = w->wm.size_hints.height_inc; - base_width = width - cell_width * w->emacs_shell.width_cells; - base_height = height - cell_height * w->emacs_shell.height_cells; -#ifdef DEBUG_GEOMETRY_MANAGEMENT - /* Very useful info when debugging geometry management problems. - When it's guaranteed that no more such problems exist, take - this stuff out. */ - printf ("update_size_hints_internal:\n"); - printf (" actual pixel size: %d %d\n", width, height); - printf (" cell size in pixels: %d %d\n", cell_width, cell_height); - printf (" text area size in cells: %d %d\n", w->emacs_shell.width_cells, - w->emacs_shell.height_cells); - printf (" base size set to: %d %d\n", base_width, base_height); - fflush (stdout); -#endif - XtSetArg(al [0], XtNbaseWidth, base_width); - XtSetArg(al [1], XtNbaseHeight, base_height); - XtSetArg(al [2], XtNminWidth, base_width + - cell_width * w->emacs_shell.min_width_cells); - XtSetArg(al [3], XtNminHeight, base_height + - cell_height * w->emacs_shell.min_height_cells); - XtSetValues ((Widget) w, al, 4); -} - -static XtGeometryResult -SuperClassRootGeometryManager (Widget gw, - XtWidgetGeometry *request, - XtWidgetGeometry *reply) -{ - ShellWidgetClass swc = (ShellWidgetClass) SUPERCLASS_WIDGET_CLASS; - ShellClassExtensionRec *scer; - GenericClassExtRec *gcer; - - /* find the shell extension record that specifies the - root geometry manager method */ - for (gcer = (GenericClassExtRec *) swc->shell_class.extension; - gcer; - gcer = (GenericClassExtRec *) gcer->next_extension) - { - if (gcer->record_type == NULLQUARK) - break; - } - - if (!gcer) - abort (); - - /* call it to actually make the geometry request */ - scer = (ShellClassExtensionRec *) gcer; - return (scer->root_geometry_manager)(gw, request, reply); -} - -static XtGeometryResult -RootGeometryManager (Widget gw, - XtWidgetGeometry *request, - XtWidgetGeometry *reply) -{ - EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) gw; - /* OK since this file is not dumped */ - static int reentrant = 0; - XtGeometryResult result; - - if (reentrant) - abort (); - reentrant++; - -#ifdef DEBUG_GEOMETRY_MANAGEMENT - printf ("root_geometry_manager:\n"); - printf (" current shell size: %d %d\n", w->core.width, w->core.height); - if (request->request_mode & CWWidth) - printf ("width requested;"); - if (request->request_mode & CWHeight) - printf ("height requested;"); - printf ("\n"); - printf (" requested shell size: %d %d\n", request->width, request->height); -#endif - /* update the size hints */ - update_size_hints_internal (w, - request->request_mode & CWWidth ? - request->width : w->core.width, - request->request_mode & CWHeight ? - request->height : w->core.height); - - result = SuperClassRootGeometryManager (gw, request, reply); - -#ifdef DEBUG_GEOMETRY_MANAGEMENT - printf (" result: %s\n", - result == XtGeometryYes ? "XtGeometryYes" : - result == XtGeometryNo ? "XtGeometryNo" : - result == XtGeometryAlmost ? "XtGeometryAlmost" : - "XtGeometryDone"); - if (reply->request_mode & CWWidth) - printf ("width returned;"); - if (reply->request_mode & CWHeight) - printf ("height returned;"); - printf ("\n"); - printf (" resulting shell size: %d %d\n", reply->width, reply->height); - printf ("----------\n"); - fflush (stdout); -#endif - reentrant--; - return result; -} - -static void -ChangeManaged (Widget wid) -{ - EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) wid; - - /* If not realized, then we're being called from XtRealizeWidget(). - RootGeometryManager() has not yet been called, and thus our - base size is incorrect. We need to set it now or the Shell - will mess up geometry specifications with negative positional - offsets. */ - if (!XtIsRealized (wid)) - { - Widget child = NULL; - Cardinal i; - - /* the managed child indicates what our size is */ - for (i = 0; i < w->composite.num_children; i++) { - if (XtIsManaged(w->composite.children[i])) { - child = w->composite.children[i]; - break; - } - } - - update_size_hints_internal (w, child->core.width, child->core.height); - } - - /* call the real ChangeManaged */ - (((ShellWidgetClass) SUPERCLASS_WIDGET_CLASS)-> - composite_class.change_managed)(wid); -} - - -/******************* external entry points *********************/ - -void -EMACS_SHELL_UPDATE_SIZE_HINTS (Widget gw) -{ - EMACS_SHELL_WIDGET w = (EMACS_SHELL_WIDGET) gw; - update_size_hints_internal (w, w->core.width, w->core.height); -} diff --git a/src/EmacsShell.c b/src/EmacsShell.c deleted file mode 100644 index eef2edb..0000000 --- a/src/EmacsShell.c +++ /dev/null @@ -1,164 +0,0 @@ -/* Emacs shell widget -- glue. - Copyright (C) 1994, 1995 Sun Microsystems, 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. */ - -/* Written by Ben Wing, May, 1994. */ - -#include - -#include -#include -#include -#include "xintrinsicp.h" -#include -#include -#include "EmacsShell.h" -#include "ExternalShell.h" - -#if 0 /* Not currently used */ - -/* The root_geometry_manager() method in Shell.c is fucked up with regard - to the user-specified-position vs. program-specified-position and - user-specified-size vs. program-specified-size flag. (It always - sets program-specified whenever the program requests a change - in its size or position, even when this came from direct user - request.) So we provide external entry points to fix this after - the program requested a size or position change. If it turns - out that the user-specified-position flag needs to be set at the - *same* time that the geometry change request is made, then we - will have to duplicate the entire root_geometry_manager() method; - but I don't think there are any WM's that require this. */ - -/* junk stolen from IntrinsicI.h */ - -extern void _XtAllocError( String /* alloc_type */); - -/* junk ungraciously copied from Shell.c */ - -static void ComputeWMSizeHints(w, hints) - WMShellWidget w; - XSizeHints *hints; -{ - long flags; - hints->flags = flags = w->wm.size_hints.flags; -#define copy(field) hints->field = w->wm.size_hints.field - if (flags & (USPosition | PPosition)) { - copy(x); - copy(y); - } - if (flags & (USSize | PSize)) { - copy(width); - copy(height); - } - if (flags & PMinSize) { - copy(min_width); - copy(min_height); - } - if (flags & PMaxSize) { - copy(max_width); - copy(max_height); - } - if (flags & PResizeInc) { - copy(width_inc); - copy(height_inc); - } - if (flags & PAspect) { - copy(min_aspect.x); - copy(min_aspect.y); - copy(max_aspect.x); - copy(max_aspect.y); - } -#undef copy -#define copy(field) hints->field = w->wm.field - if (flags & PBaseSize) { - copy(base_width); - copy(base_height); - } - if (flags & PWinGravity) - copy(win_gravity); -#undef copy -} - -static void _SetWMSizeHints(w) - WMShellWidget w; -{ - XSizeHints *size_hints = XAllocSizeHints(); - - if (size_hints == NULL) _XtAllocError("XAllocSizeHints"); - ComputeWMSizeHints(w, size_hints); - XSetWMNormalHints(XtDisplay((Widget)w), XtWindow((Widget)w), size_hints); - XFree((char*)size_hints); -} - -/* end of junk ungraciously copied from Shell.c */ - -#endif /* 0 */ -#if 0 /* Not currently used */ - -void -EmacsShellSetSizeUserSpecified (Widget gw) -{ - WMShellWidget w = (WMShellWidget) gw; - w->wm.size_hints.flags |= USSize; - w->wm.size_hints.flags &= ~PSize; - if (!w->shell.override_redirect && XtIsRealized (gw)) - _SetWMSizeHints (w); -} - -void -EmacsShellSetPositionUserSpecified (Widget gw) -{ - WMShellWidget w = (WMShellWidget) gw; - w->wm.size_hints.flags |= USPosition; - w->wm.size_hints.flags &= ~PPosition; - if (!w->shell.override_redirect && XtIsRealized (gw)) - _SetWMSizeHints (w); -} - -#endif /* 0 */ - -void -EmacsShellSmashIconicHint (Widget shell, int iconic_p) -{ - /* See comment in frame-x.c about this */ - WMShellWidget wmshell = (WMShellWidget) shell; - assert (XtIsSubclass (shell, wmShellWidgetClass)); - /* old_state = (wmshell->wm.wm_hints.flags & StateHint - ? wmshell->wm.wm_hints.initial_state - : NormalState); */ - wmshell->wm.wm_hints.flags |= StateHint; - wmshell->wm.wm_hints.initial_state = iconic_p ? IconicState : NormalState; -} - -void -EmacsShellUpdateSizeHints (Widget gw) -{ - if (XtIsSubclass (gw, topLevelEmacsShellWidgetClass)) - TopLevelEmacsShellUpdateSizeHints (gw); -#ifdef EXTERNAL_WIDGET - else if (XtIsSubclass (gw, externalShellWidgetClass)) - /* do what ??? Don't abort! */; -#endif - else if (XtIsSubclass (gw, transientEmacsShellWidgetClass)) - TransientEmacsShellUpdateSizeHints (gw); - else - abort (); -} diff --git a/src/EmacsShell.h b/src/EmacsShell.h deleted file mode 100644 index 4804afb..0000000 --- a/src/EmacsShell.h +++ /dev/null @@ -1,71 +0,0 @@ -/* Emacs shell widget external header file. - Copyright (C) 1994 Sun Microsystems, 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. */ - -/* Written by Ben Wing, May, 1994. */ - -#ifndef _EmacsShell_h -#define _EmacsShell_h - -#ifndef XtNwidthCells -#define XtNwidthCells "widthCells" -#endif -#ifndef XtCWidthCells -#define XtCWidthCells "WidthCells" -#endif - -#ifndef XtNheightCells -#define XtNheightCells "heightCells" -#endif -#ifndef XtCHeightCells -#define XtCHeightCells "HeightCells" -#endif - -#ifndef XtNminWidthCells -#define XtNminWidthCells "minWidthCells" -#endif -#ifndef XtCMinWidthCells -#define XtCMinWidthCells "MinWidthCells" -#endif - -#ifndef XtNminHeightCells -#define XtNminHeightCells "minHeightCells" -#endif -#ifndef XtCMinHeightCells -#define XtCMinHeightCells "MinHeightCells" -#endif - -typedef struct _TopLevelEmacsShellClassRec *TopLevelEmacsShellWidgetClass; -typedef struct _TopLevelEmacsShellRec *TopLevelEmacsShellWidget; -extern WidgetClass topLevelEmacsShellWidgetClass; - -typedef struct _TransientEmacsShellClassRec *TransientEmacsShellWidgetClass; -typedef struct _TransientEmacsShellRec *TransientEmacsShellWidget; -extern WidgetClass transientEmacsShellWidgetClass; - -void EmacsShellUpdateSizeHints (Widget gw); -void TopLevelEmacsShellUpdateSizeHints (Widget gw); -void TransientEmacsShellUpdateSizeHints (Widget gw); -void EmacsShellSetSizeUserSpecified (Widget gw); -void EmacsShellSetPositionUserSpecified (Widget gw); -void EmacsShellSmashIconicHint (Widget shell, int iconic_p); - -#endif /* _EmacsShell_h */ diff --git a/src/EmacsShellP.h b/src/EmacsShellP.h deleted file mode 100644 index 4587f4a..0000000 --- a/src/EmacsShellP.h +++ /dev/null @@ -1,102 +0,0 @@ -/* Emacs shell widget internal header file. - Copyright (C) 1994, 1995 Sun Microsystems, 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. */ - -/* Written by Ben Wing, May, 1994. */ - -#ifndef _EmacsShellP_h -#define _EmacsShellP_h - -#include "xintrinsic.h" -#include -#include "EmacsShell.h" - -/****** TopLevelEmacsShell ******/ - -typedef struct { /* new fields for TopLevelEmacsShell class */ - int dummy; -} TopLevelEmacsShellClassPart; - -/* full class record declaration */ -typedef struct _TopLevelEmacsShellClassRec { - CoreClassPart core_class; - CompositeClassPart composite_class; - ShellClassPart shell_class; - WMShellClassPart wm_shell_class; - VendorShellClassPart vendor_shell_class; - TopLevelShellClassPart top_level_shell_class; - TopLevelEmacsShellClassPart emacs_shell_class; -} TopLevelEmacsShellClassRec; - -typedef struct { /* new fields for TopLevelEmacsShell widget */ - int width_cells, height_cells; - int min_width_cells, min_height_cells; -} TopLevelEmacsShellPart; - -typedef struct _TopLevelEmacsShellRec { /* full instance record */ - CorePart core; - CompositePart composite; - ShellPart shell; - WMShellPart wm; - VendorShellPart vendor; - TopLevelShellPart top_level; - TopLevelEmacsShellPart emacs_shell; -} TopLevelEmacsShellRec; - -/* class pointer */ -extern TopLevelEmacsShellClassRec topLevelEmacsShellClassRec; - -/****** TransientEmacsShell ******/ - -typedef struct { /* new fields for TransientEmacsShell class */ - int dummy; -} TransientEmacsShellClassPart; - -/* full class record declaration */ -typedef struct _TransientEmacsShellClassRec { - CoreClassPart core_class; - CompositeClassPart composite_class; - ShellClassPart shell_class; - WMShellClassPart wm_shell_class; - VendorShellClassPart vendor_shell_class; - TransientShellClassPart transient_shell_class; - TransientEmacsShellClassPart emacs_shell_class; -} TransientEmacsShellClassRec; - -typedef struct { /* new fields for TransientEmacsShell widget */ - int width_cells, height_cells; - int min_width_cells, min_height_cells; -} TransientEmacsShellPart; - -typedef struct _TransientEmacsShellRec { /* full instance record */ - CorePart core; - CompositePart composite; - ShellPart shell; - WMShellPart wm; - VendorShellPart vendor; - TransientShellPart transient; - TransientEmacsShellPart emacs_shell; -} TransientEmacsShellRec; - -/* class pointer */ -extern TransientEmacsShellClassRec transientEmacsShellClassRec; - -#endif /* _EmacsShellP_h */ diff --git a/src/ExternalClient.c b/src/ExternalClient.c deleted file mode 100644 index 00dc380..0000000 --- a/src/ExternalClient.c +++ /dev/null @@ -1,617 +0,0 @@ -/* External client widget. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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, September 1993. */ - -#ifdef emacs - -#include - -#ifndef EXTERNAL_WIDGET -ERROR! This ought not be getting compiled if EXTERNAL_WIDGET is undefined -#endif - -#endif /* emacs */ - -#include -#include -#include -#ifdef EXTW_USES_MOTIF -# include -# include -# include -#else -# include "xintrinsicp.h" -# include -#endif - -#include "ExternalClientP.h" -#include "extw-Xt.h" - -#ifdef TOOLTALK -#include TT_C_H_PATH -#endif - -/* This is the client widget, used to communicate with an ExternalShell - widget. */ - -#define NOTIFY(w, type, l0, l1, l2) \ - extw_send_notify_3(XtDisplay((Widget)(w)), XtWindow((Widget)(w)),\ - type, l0, l1, l2) - -static void externalClientInitialize (Widget req, Widget new, ArgList args, - Cardinal *num_args); -static void externalClientRealize (Widget widget, XtValueMask *mask, - XSetWindowAttributes *attrs); -static void Destroy (Widget w); -static void EventHandler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch); -static void MaskableEventHandler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch); -static XtGeometryResult QueryGeometry(Widget, XtWidgetGeometry *, - XtWidgetGeometry *); -static void ExternalClientFocusIn (Widget, XEvent *, String *, Cardinal *); -static void ExternalClientFocusOut (Widget, XEvent *, String *, Cardinal *); -static void ExternalClientEnter (Widget, XEvent *, String *, Cardinal *); -static void ExternalClientLeave (Widget, XEvent *, String *, Cardinal *); - -static int my_error_handler(Display *display, XErrorEvent *xev); -static int (*error_old_handler)(Display *, XErrorEvent *); - -static XtResource resources[] = { -#define offset(field) XtOffset(ExternalClientWidget, externalClient.field) - { XtNshellTimeout, XtCShellTimeout, XtRInt, sizeof(int), - offset(shell_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT}, - { XtNdeadShell, XtCDeadShell, XtRBoolean, sizeof(Boolean), - offset(dead_shell), XtRImmediate, (XtPointer)False}, -#ifdef EXTW_USES_MOTIF - { XmNnavigationType, XmCNavigationType, XmRNavigationType, - sizeof(XmNavigationType), XtOffset(ExternalClientWidget, - primitive.navigation_type), XtRImmediate, - (XtPointer)XmTAB_GROUP}, -#endif - { XtNemacsProcID, XtCEmacsProcID, XtRString, sizeof(String), - offset(emacs_procid), XtRImmediate, (XtPointer)NULL}, - { XtNshellReadyCallback, XtCCallback, XtRCallback, sizeof(XtCallbackList), - offset(shell_ready_callback), XtRImmediate, (XtPointer)NULL}, - { XtNshellName, XtCShellName, XtRString, sizeof(String), - offset(shell_name), XtRImmediate, (XtPointer)NULL}, - { XtNuseToolTalk, XtCUseToolTalk, XtRBoolean, sizeof(Boolean), - offset(use_tooltalk), XtRImmediate, (XtPointer)False} -}; - -static XtActionsRec actions[] = { - {"focusIn", ExternalClientFocusIn}, - {"focusOut", ExternalClientFocusOut}, - {"enter", ExternalClientEnter}, - {"leave", ExternalClientLeave}, -}; - -ExternalClientClassRec externalClientClassRec = { - { /* - * core_class fields - */ -#ifdef EXTW_USES_MOTIF - /* superclass */ (WidgetClass) &xmPrimitiveClassRec, -#else - /* superclass */ (WidgetClass) &coreClassRec, -#endif - /* class_name */ "ExternalClient", - /* size */ sizeof(ExternalClientRec), - /* Class Initializer */ NULL, - /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ - /* Class init'ed ? */ FALSE, - /* initialize */ externalClientInitialize, - /* initialize_notify */ NULL, - /* realize */ externalClientRealize, - /* actions */ actions, - /* num_actions */ XtNumber (actions), - /* resources */ resources, - /* resource_count */ XtNumber (resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ FALSE, - /* compress_exposure */ TRUE, - /* compress_enterleave*/ FALSE, - /* visible_interest */ TRUE, - /* destroy */ Destroy, /* XtInheritDestroy, */ - /* resize */ XtInheritResize, - /* expose */ NULL, - /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, - /* accept_focus */ NULL, - /* intrinsics version */ XtVersion, - /* callback offsets */ NULL, - /* tm_table */ "", /* MUST NOT BE NULL or - XtInheritTranslations in Motif!!!!! - Otherwise keyboard focus translations - will not work. */ - /* query_geometry */ QueryGeometry, - /* display_accelerator*/ NULL, - /* extension */ NULL - }, -#ifdef EXTW_USES_MOTIF - { - XmInheritBorderHighlight,/* Primitive border_highlight */ - XmInheritBorderHighlight,/* Primitive border_unhighlight */ - XtInheritTranslations, /* translations */ - NULL, /* arm_and_activate */ - NULL, /* get resources */ - 0, /* num get_resources */ - NULL, /* extension */ - }, -#endif - { - 0 - } -}; - -WidgetClass externalClientWidgetClass = (WidgetClass) &externalClientClassRec; - -static void -externalClientInitialize (Widget req, Widget new, ArgList args, - Cardinal *num_args) -{ - ExternalClientWidget ecw = (ExternalClientWidget) new; - static int error_handler_added = 0; - - extw_initialize_atoms (XtDisplay (new)); - extw_which_side = extw_client_send; - -#ifdef EXTW_USES_MOTIF - - /* yes I know this is horrible. However, the XmPrimitive class adds - the Tab translation in its initialization routine, so we have to - override it here. This is all the fault of Xt, which doesn't - provide a proper inheritance mechanism for translations. - - -- BPW - - */ - - XtOverrideTranslations (new, - XtParseTranslationTable ("NoneTab:\n" - ":focusIn()\n" - ":focusOut()\n" - ":enter()\n" - ":leave()\n")); - -#endif - - XtAddEventHandler (new, 0, TRUE, EventHandler, (XtPointer) NULL); - - ecw->externalClient.shell_ready = False; - ecw->externalClient.has_focus = False; - - if (!error_handler_added) - { - error_handler_added = 1; - error_old_handler = XSetErrorHandler (my_error_handler); - } -} - - -#ifdef TOOLTALK -static Tt_callback_action -tt_callback(Tt_message m, Tt_pattern p) -{ - ExternalClientWidget ecw = (ExternalClientWidget)tt_message_user (m, 0); - - switch (tt_message_state(m)) - { - case TT_FAILED: - /* handle errors here */ - break; - case TT_HANDLED: - ecw->externalClient.shell_name = tt_message_arg_val (m, 2); - XtCallCallbackList ((Widget) ecw, - ecw->externalClient.shell_ready_callback, NULL); - break; - } - - tt_message_destroy (m); - return TT_CALLBACK_PROCESSED; -} - -static void -send_tooltalk_handshake (ExternalClientWidget ecw, Window win, char *name) -{ - Tt_message m = tt_message_create (); - - tt_message_op_set (m, "emacs-make-client-screen"); - tt_message_scope_set (m, TT_SESSION); - tt_message_class_set (m, TT_REQUEST); - tt_message_arg_add (m, TT_IN, "string", name); - tt_message_iarg_add (m, TT_IN, "int", win); - tt_message_arg_add (m, TT_OUT, "string", NULL); - tt_message_user_set (m, 0, (void *)ecw); - tt_message_callback_add (m, tt_callback); - if (ecw->externalClient.emacs_procid) - { - tt_message_address_set (m, TT_HANDLER); - tt_message_handler_set (m, ecw->externalClient.emacs_procid); - } - else - tt_message_address_set (m, TT_PROCEDURE); - tt_message_send (m); -} - -#endif - - -static void -externalClientRealize (Widget w, XtValueMask *vm, XSetWindowAttributes *attrs) -{ - ExternalClientWidget ecw = (ExternalClientWidget)w; - -#ifdef EXTW_USES_MOTIF - (*xmPrimitiveWidgetClass->core_class.realize) (w, vm, attrs); -#else - (*coreWidgetClass->core_class.realize) (w, vm, attrs); -#endif - -#ifdef TOOLTALK - - /* Make sure that the server actually knows about this window id before - * telling Emacs about it. - */ - if (ecw->externalClient.use_tooltalk) - { - XSync (XtDisplay (w), False); - send_tooltalk_handshake (ecw, XtWindow (w), XtName (w)); - } -#endif -} - - -/***********************************************************************/ - -/* window-to-widget list. */ - -struct ww_list -{ - Window win; - Widget wid; - struct ww_list *next; -}; - -struct ww_list ww_list[1]; - -static int -add_ww (Window win, Widget wid) -{ - struct ww_list *ww = (struct ww_list *) malloc (sizeof (struct - ww_list)); - if (!ww) - return 0; - ww->win = win; - ww->wid = wid; - ww->next = ww_list->next; - ww_list->next = ww; - return 1; -} - -static Widget -remove_ww (Window win) -{ - struct ww_list *w1, *w2; - Widget wid = 0; - - for (w1=ww_list, w2=w1->next; w2; w1=w2, w2=w2->next) - if (w2->win == win) - { - w1->next = w2->next; - wid = w2->wid; - free (w2); - break; - } - return wid; -} - -/***********************************************************************/ - -/* stolen outright from Intrinsic.c */ - -static void ComputeWindowAttributes(widget,value_mask,values) - Widget widget; - XtValueMask *value_mask; - XSetWindowAttributes *values; -{ - *value_mask = CWEventMask | CWColormap; - (*values).event_mask = XtBuildEventMask(widget); - (*values).colormap = widget->core.colormap; - if (widget->core.background_pixmap != XtUnspecifiedPixmap) { - *value_mask |= CWBackPixmap; - (*values).background_pixmap = widget->core.background_pixmap; - } else { - *value_mask |= CWBackPixel; - (*values).background_pixel = widget->core.background_pixel; - } - if (widget->core.border_pixmap != XtUnspecifiedPixmap) { - *value_mask |= CWBorderPixmap; - (*values).border_pixmap = widget->core.border_pixmap; - } else { - *value_mask |= CWBorderPixel; - (*values).border_pixel = widget->core.border_pixel; - } - if (widget->core.widget_class->core_class.expose == (XtExposeProc) NULL) { - /* Try to avoid redisplay upon resize by making bit_gravity the same - as the default win_gravity */ - *value_mask |= CWBitGravity; - (*values).bit_gravity = NorthWestGravity; - } -} /* ComputeWindowAttributes */ - -static void -end_connection (ExternalClientWidget w) -{ - XSetWindowAttributes xswa; - XtValueMask mask; - Widget wid = (Widget) w; - - w->externalClient.shell_ready = False; - XtRemoveEventHandler (wid, w->externalClient.event_mask, - FALSE, MaskableEventHandler, (XtPointer) NULL); - ComputeWindowAttributes (wid, &mask, &xswa); - XChangeWindowAttributes (XtDisplay (wid), XtWindow (wid), mask, &xswa); - XClearArea (XtDisplay (wid), XtWindow (wid), 0, 0, 0, 0, True); -} - -static int -my_error_handler (Display *display, XErrorEvent *xev) -{ - Widget wid; - - if (xev->error_code != BadWindow) - goto call_old; - wid = remove_ww (xev->resourceid); - if (wid) - { - end_connection ((ExternalClientWidget) wid); - return 0; - } - - call_old: - return error_old_handler (display, xev); -} - -static void -MaskableEventHandler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch) - /* closure and continue_to_dispatch unused */ -{ - ExternalClientWidget w = (ExternalClientWidget) wid; - - if (w->externalClient.shell_ready) - { - if (event->type == KeyPress || event->type == KeyRelease || - event->type == ButtonPress || event->type == ButtonRelease || - event->type == MotionNotify) - event->xkey.subwindow = 0; -#ifdef EXTW_USES_MOTIF - /* hackkkkkkkkkkkkkk! Suppress CTRL-TAB, SHIFT-TAB, etc. so that - Emacs doesn't attempt to interpret focus-change keystrokes. */ - if (event->type == KeyPress && - XLookupKeysym ((XKeyEvent *) event, 0) == XK_Tab && - (event->xkey.state & ControlMask || - event->xkey.state & ShiftMask)) - return; -#endif - event->xany.window = w->core.window; - XSendEvent (XtDisplay (wid), w->externalClient.event_window, FALSE, 0, - event); - XSync (XtDisplay (wid), 0); /* make sure that any BadWindow errors - (meaning the server died) get handled - before XSendEvent is called again. */ - - } -} - -static void -EventHandler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch) - /* closure and continue_to_dispatch unused */ -{ - ExternalClientWidget w = (ExternalClientWidget) wid; - - if (w->core.window != event->xany.window) - { - XtAppErrorMsg (XtWidgetToApplicationContext (wid), - "invalidWindow","eventHandler",XtCXtToolkitError, - "Event with wrong window", - (String *)NULL, (Cardinal *)NULL); - return; - } - - if (event->type == ClientMessage && - event->xclient.message_type == a_EXTW_NOTIFY && - event->xclient.data.l[0] == extw_shell_send) - switch (event->xclient.data.l[1]) - { - - case extw_notify_qg: - /* shell is alive again. */ - - w->externalClient.dead_shell = False; - break; - - case extw_notify_gm: - { - XtWidgetGeometry xwg, xwg_return; - XtGeometryResult result; - - extw_get_geometry_value (XtDisplay (wid), XtWindow (wid), - a_EXTW_GEOMETRY_MANAGER, &xwg); - result = XtMakeGeometryRequest (wid, &xwg, &xwg_return); - - extw_send_geometry_value (XtDisplay (wid), XtWindow (wid), - a_EXTW_GEOMETRY_MANAGER, extw_notify_gm, - result == XtGeometryAlmost ? &xwg_return : - NULL, result); - break; - } - - case extw_notify_init: - w->externalClient.shell_ready = True; - w->externalClient.event_window = event->xclient.data.l[2]; - w->externalClient.event_mask = event->xclient.data.l[3]; - add_ww (w->externalClient.event_window, (Widget) w); - - XtAddEventHandler (wid, w->externalClient.event_mask, - FALSE, MaskableEventHandler, (XtPointer) NULL); -#ifdef EXTW_USES_MOTIF - NOTIFY (w, extw_notify_init, - EXTW_TYPE_MOTIF, - 0, 0); -#else - NOTIFY (w, extw_notify_init, - EXTW_TYPE_XT, - 0, 0); -#endif - break; - - case extw_notify_end: - end_connection (w); - remove_ww (w->externalClient.event_window); - break; - - case extw_notify_set_focus: -#ifdef EXTW_USES_MOTIF - XmProcessTraversal (wid, XmTRAVERSE_CURRENT); -#else - XtSetKeyboardFocus (wid, None); -#endif - break; - - } -} - -static void Destroy(wid) - Widget wid; -{ - ExternalClientWidget w = (ExternalClientWidget)wid; - - NOTIFY(w, extw_notify_end, 0, 0, 0); -} - -static XtGeometryResult QueryGeometry(gw, request, reply) - Widget gw; - XtWidgetGeometry *request, *reply; -{ - ExternalClientWidget w = (ExternalClientWidget)gw; - XEvent event; - unsigned long request_num; - Display *display = XtDisplay(gw); - XtWidgetGeometry req = *request; /* don't modify caller's structure */ - - if (!XtIsRealized((Widget)w) || !w->externalClient.shell_ready) - return XtGeometryYes; - - if (w->externalClient.dead_shell == TRUE) - /* The shell is sick. */ - return XtGeometryNo; - - req.sibling = None; - req.request_mode &= ~CWSibling; - request_num = NextRequest(display); - extw_send_geometry_value(XtDisplay(gw), XtWindow(gw), a_EXTW_QUERY_GEOMETRY, - extw_notify_qg, &req, 0); - - if (extw_wait_for_response(gw, &event, request_num, extw_notify_qg, - w->externalClient.shell_timeout)) { - XtGeometryResult result = (XtGeometryResult) event.xclient.data.l[0]; - - if (result == XtGeometryAlmost) { - extw_get_geometry_value(XtDisplay(gw), XtWindow(gw), - a_EXTW_QUERY_GEOMETRY, reply); - } - return result; - } else { - w->externalClient.dead_shell = TRUE; /* timed out; must be broken */ - return XtGeometryNo; - } -} - -static void ExternalClientFocusIn (Widget w, XEvent *event, String *params, - Cardinal *num_params) -{ - ExternalClientWidget ecw = (ExternalClientWidget) w; - - if (event->xfocus.send_event && !ecw->externalClient.has_focus) { - ecw->externalClient.has_focus = True; - NOTIFY(ecw, extw_notify_focus_in, 0, 0, 0); - } -#ifdef EXTW_USES_MOTIF - _XmPrimitiveFocusIn (w, event, params, num_params); -#endif -} - -static void ExternalClientFocusOut (Widget w, XEvent *event, String *params, - Cardinal *num_params) -{ - ExternalClientWidget ecw = (ExternalClientWidget) w; - - if (event->xfocus.send_event && ecw->externalClient.has_focus) { - ecw->externalClient.has_focus = False; - NOTIFY(ecw, extw_notify_focus_out, 0, 0, 0); - } -#ifdef EXTW_USES_MOTIF - _XmPrimitiveFocusOut(w, event, params, num_params); -#endif -} - -static void ExternalClientEnter (Widget w, XEvent *event, String *params, - Cardinal *num_params) -{ - ExternalClientWidget ecw = (ExternalClientWidget) w; - - if ( -#ifdef EXTW_USES_MOTIF - _XmGetFocusPolicy (w) != XmEXPLICIT && -#endif - !ecw->externalClient.has_focus && - event->xcrossing.focus && event->xcrossing.detail != NotifyInferior) { - ecw->externalClient.has_focus = True; - NOTIFY(ecw, extw_notify_focus_in, 0, 0, 0); - } -#ifdef EXTW_USES_MOTIF - _XmPrimitiveEnter (w, event, params, num_params); -#endif -} - -static void ExternalClientLeave (Widget w, XEvent *event, String *params, - Cardinal *num_params) -{ - ExternalClientWidget ecw = (ExternalClientWidget) w; - - if ( -#ifdef EXTW_USES_MOTIF - _XmGetFocusPolicy (w) != XmEXPLICIT && -#endif - ecw->externalClient.has_focus && - event->xcrossing.focus && event->xcrossing.detail != NotifyInferior) { - ecw->externalClient.has_focus = False; - NOTIFY(ecw, extw_notify_focus_out, 0, 0, 0); - } -#ifdef EXTW_USES_MOTIF - _XmPrimitiveLeave (w, event, params, num_params); -#endif -} diff --git a/src/ExternalClient.h b/src/ExternalClient.h deleted file mode 100644 index e1b0fc4..0000000 --- a/src/ExternalClient.h +++ /dev/null @@ -1,74 +0,0 @@ -/* External client widget external header file. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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. */ - -#ifndef _ExternalClient_h -#define _ExternalClient_h - -#ifndef XtNshellTimeout -#define XtNshellTimeout "shellTimeout" -#endif -#ifndef XtCShellTimeout -#define XtCShellTimeout "ShellTimeout" -#endif - -#ifndef XtNdeadShell -#define XtNdeadShell "deadShell" -#endif -#ifndef XtCDeadShell -#define XtCDeadShell "DeadShell" -#endif - -#ifndef XtNemacsProcID -#define XtNemacsProcID "emacsProcID" -#endif -#ifndef XtCEmacsProcID -#define XtCEmacsProcID "EmacsProcID" -#endif - -#ifndef XtNshellReadyCallback -#define XtNshellReadyCallback "shellReadyCallback" -#endif - -#ifndef XtNshellName -#define XtNshellName "shellName" -#endif -#ifndef XtCShellName -#define XtCShellName "ShellName" -#endif - -#ifndef XtNuseToolTalk -#define XtNuseToolTalk "useToolTalk" -#endif -#ifndef XtCUseToolTalk -#define XtCUseToolTalk "UseToolTalk" -#endif - -typedef struct _ExternalClientClassRec *ExternalClientWidgetClass; -typedef struct _ExternalClientRec *ExternalClientWidget; -extern WidgetClass externalClientWidgetClass; - -/* External entry points when using direct Xlib */ - -void ExternalClientInitialize (Display *display, Window win); -void ExternalClientEventHandler (Display *display, Window win, XEvent *event); - -#endif /* _ExternalClient_h */ diff --git a/src/ExternalClientP.h b/src/ExternalClientP.h deleted file mode 100644 index 257d6b2..0000000 --- a/src/ExternalClientP.h +++ /dev/null @@ -1,66 +0,0 @@ -/* External client widget internal header file. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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. */ - -#ifndef _ExternalClientP_h -#define _ExternalClientP_h - -#include "ExternalClient.h" -#ifdef EXTW_USES_MOTIF -#include -#endif - -typedef struct { /* new fields for ExternalClient class */ - int dummy; -} ExternalClientClassPart; - -typedef struct _ExternalClientClassRec { /* full class record declaration */ - CoreClassPart core_class; -#ifdef EXTW_USES_MOTIF - XmPrimitiveClassPart primitive_class; -#endif - ExternalClientClassPart externalClient_class; -} ExternalClientClassRec; - -typedef struct { /* new fields for ExternalClient widget */ - Bool dead_shell; /* is the shell dead? */ - unsigned long shell_timeout;/* how long to wait for shell's response */ - int shell_ready; /* is the shell ready? */ - Window event_window; - long event_mask; - Bool has_focus; - char *emacs_procid; - XtCallbackList shell_ready_callback; - String shell_name; - Bool use_tooltalk; -} ExternalClientPart; - -typedef struct _ExternalClientRec { /* full instance record */ - CorePart core; -#ifdef EXTW_USES_MOTIF - XmPrimitivePart primitive; -#endif - ExternalClientPart externalClient; -} ExternalClientRec; - -extern ExternalClientClassRec externalClientClassRec; /* class pointer */ - -#endif /* _ExternalClientP_h */ diff --git a/src/ExternalShell.c b/src/ExternalShell.c deleted file mode 100644 index 941a10d..0000000 --- a/src/ExternalShell.c +++ /dev/null @@ -1,717 +0,0 @@ -/* External shell widget. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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, September 1993. */ - -/* This is a special Shell that is designed to use an externally- - provided window created by someone else (possibly another process). - That other window should have an associated widget of class - ExternalClient. The two widgets communicate with each other using - ClientMessage events and properties on the external window. - - Ideally this feature should be independent of Emacs. Unfortunately - there are lots and lots of specifics that need to be dealt with - for this to work properly, and some of them can't conveniently - be handled within the widget's methods. Some day the code may - be rewritten so that the embedded-widget feature can be used by - any application, with appropriate entry points that are called - at specific points within the application. - - This feature is similar to the OLE (Object Linking & Embedding) - feature provided by MS Windows. - */ - -#ifdef emacs - -#include - -#ifndef EXTERNAL_WIDGET -ERROR! This ought not be getting compiled if EXTERNAL_WIDGET is undefined -#endif - -#endif /* emacs */ - -#include -#include -#include -#include "xintrinsicp.h" -#include -#include -#include -#include -#include "ExternalShellP.h" -#include "extw-Xt.h" - -#ifdef emacs -extern void emacs_Xt_handle_focus_event (XEvent *event); -#endif - -/* Communication between this shell and the client widget: - - Communication is through ClientMessage events with message_type - EXTW_NOTIFY and format 32. Both the shell and the client widget - communicate with each other by sending the message to the same - window (the "external window" below), and the data.l[0] value is - used to determine who sent the message. - - The data is formatted as follows: - - data.l[0] = who sent this message: external_shell_send (0) or - external_client_send (1) - data.l[1] = message type (see enum en_extw_notify below) - data.l[2-4] = data associated with this message - - EventHandler() handles messages from the other side. - - extw_send_notify_3() sends a message to the other side. - - extw_send_geometry_value() is used when an XtWidgetGeometry structure - needs to be sent. This is too much data to fit into a - ClientMessage, so the data is stored in a property and then - extw_send_notify_3() is called. - - extw_get_geometry_value() receives an XtWidgetGeometry structure from a - property. - - extw_wait_for_response() is used when a response to a sent message - is expected. It looks for a matching event within a - particular timeout. - - The particular message types are as follows: - -1) extw_notify_init (event_window, event_mask) - - This is sent from the shell to the client after the shell realizes - its EmacsFrame widget on the client's "external window". This - tells the client that it should start passing along events of the - types specified in event_mask. event_window specifies the window - of the EmacsFrame widget, which is a child of the client's - external window. - - extw_notify_init (client_type) - - When the client receives an extw_notify_init message from the - shell, it sends back a message of the same sort specifying the type - of the toolkit used by the client (Motif, generic Xt, or Xlib). - -2) extw_notify_end () - - This is sent from the shell to the client when the shell's - EmacsFrame widget is destroyed, and tells the client to stop - passing events along. - -3) extw_notify_qg (result) - - This is sent from the client to the shell when a QueryGeometry - request is received on the client. The XtWidgetGeometry structure - specified in the QueryGeometry request is passed on in the - EXTW_QUERY_GEOMETRY property (of type EXTW_WIDGET_GEOMETRY) on the - external window. result is unused. - - In response, the shell passes the QueryGeometry request down the - widget tree, and when a response is received, sends a message of - type extw_notify_qg back to the client, with result specifying the - GeometryResult value. If this value is XtGeometryAlmost, the - returned XtWidgetGeometry structure is stored into the same property - as above. [BPW is there a possible race condition here?] - -4) extw_notify_gm (result) - - A very similar procedure to that for extw_notify_qg is followed - when the shell's RootGeometryManager method is called, indicating - that a child widget wishes to change the shell's geometry. The - XtWidgetGeometry structure is stored in the EXTW_GEOMETRY_MANAGER - property. - -5) extw_notify_focus_in (), extw_notify_focus_out () - - These are sent from the client to the shell when the client gains - or loses the keyboard focus. It is done this way because Xt - maintains its own concept of keyboard focus and only the client - knows this information. -*/ - -#define NOTIFY(w, type, l0, l1, l2) \ - extw_send_notify_3(XtDisplay((Widget)(w)),\ - (w)->externalShell.external_window, type, l0, l1, l2) - -static void ExternalShellInitialize (Widget req, Widget new, ArgList args, - Cardinal *num_args); -static void ExternalShellRealize (Widget wid, Mask *vmask, XSetWindowAttributes - *attr); -static void ExternalShellDestroy (Widget w); -static void ChangeManaged (Widget wid); -static XtGeometryResult ExternalShellRootGeometryManager (Widget gw, - XtWidgetGeometry *request, XtWidgetGeometry *reply); -static void EventHandler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch); - -#ifndef DEFAULT_WM_TIMEOUT -# define DEFAULT_WM_TIMEOUT 5000 -#endif - -void ExternalShellUnrealize (Widget w); - -static XtResource resources[] = { -#define offset(field) XtOffset(ExternalShellWidget, externalShell.field) - { XtNwindow, XtCWindow, XtRWindow, sizeof (Window), - offset (external_window), XtRImmediate, (XtPointer)0}, - { XtNclientTimeout, XtCClientTimeout, XtRInt, sizeof(int), - offset(client_timeout), XtRImmediate,(XtPointer)DEFAULT_WM_TIMEOUT}, - { XtNdeadClient, XtCDeadClient, XtRBoolean, sizeof(Boolean), - offset(dead_client), XtRImmediate, (XtPointer)False}, -}; - -static CompositeClassExtensionRec compositeClassExtRec = { - NULL, - NULLQUARK, - XtCompositeExtensionVersion, - sizeof(CompositeClassExtensionRec), - TRUE, -}; - -static ShellClassExtensionRec shellClassExtRec = { - NULL, - NULLQUARK, - XtShellExtensionVersion, - sizeof(ShellClassExtensionRec), - ExternalShellRootGeometryManager -}; - -ExternalShellClassRec externalShellClassRec = { - { /* - * core_class fields - */ - /* superclass */ (WidgetClass) &shellClassRec, - /* class_name */ "ExternalShell", - /* size */ sizeof(ExternalShellRec), - /* Class Initializer */ NULL, - /* class_part_initialize*/ NULL, /* XtInheritClassPartInitialize, */ - /* Class init'ed ? */ FALSE, - /* initialize */ ExternalShellInitialize, - /* initialize_notify */ NULL, - /* realize */ ExternalShellRealize, - /* actions */ NULL, - /* num_actions */ 0, - /* resources */ resources, - /* resource_count */ XtNumber (resources), - /* xrm_class */ NULLQUARK, - /* compress_motion */ FALSE, - /* compress_exposure */ TRUE, - /* compress_enterleave*/ FALSE, - /* visible_interest */ TRUE, - /* destroy */ ExternalShellDestroy, /* XtInheritDestroy, */ - /* resize */ XtInheritResize, - /* expose */ NULL, - /* set_values */ NULL, /* XtInheritSetValues, */ - /* set_values_hook */ NULL, - /* set_values_almost */ XtInheritSetValuesAlmost, - /* get_values_hook */ NULL, - /* accept_focus */ NULL, - /* intrinsics version */ XtVersion, - /* callback offsets */ NULL, - /* tm_table */ NULL, - /* query_geometry */ NULL, - /* display_accelerator*/ NULL, - /* extension */ NULL - },{ /* Composite */ - /* geometry_manager */ XtInheritGeometryManager, - /* change_managed */ ChangeManaged, /* XtInheritChangeManaged */ - /* insert_child */ XtInheritInsertChild, - /* delete_child */ XtInheritDeleteChild, - /* extension */ (XtPointer)&compositeClassExtRec - },{ /* Shell */ - /* extension */ (XtPointer)&shellClassExtRec - },{ /* ExternalShell */ - 0 - } -}; - -WidgetClass externalShellWidgetClass = (WidgetClass) &externalShellClassRec; - -static void -ExternalShellInitialize (Widget req, Widget new, ArgList args, - Cardinal *num_args) -{ - XtAddEventHandler(new, 0, - TRUE, EventHandler, (XtPointer) NULL); - extw_initialize_atoms(XtDisplay(req)); - extw_which_side = extw_shell_send; -} - -static Widget -find_managed_child (CompositeWidget w) -{ - int i; - Widget *childP = w->composite.children; - - for (i = w->composite.num_children; i; i--, childP++) - if (XtIsWidget(*childP) && XtIsManaged(*childP)) - return *childP; - return NULL; -} - -#ifndef XtCXtToolkitError -# define XtCXtToolkitError "XtToolkitError" -#endif - -static void EventHandler(wid, closure, event, continue_to_dispatch) - Widget wid; - XtPointer closure; /* unused */ - XEvent *event; - Boolean *continue_to_dispatch; /* unused */ -{ - ExternalShellWidget w = (ExternalShellWidget) wid; - - if(w->core.window != event->xany.window) { - XtAppErrorMsg(XtWidgetToApplicationContext(wid), - "invalidWindow","eventHandler",XtCXtToolkitError, - "Event with wrong window", - (String *)NULL, (Cardinal *)NULL); - return; - } - - if (event->type == ClientMessage && - event->xclient.data.l[0] == extw_client_send && - event->xclient.message_type == a_EXTW_NOTIFY) - switch (event->xclient.data.l[1]) { - - case extw_notify_gm: - /* client is alive again. */ - w->externalShell.dead_client = False; - break; - - case extw_notify_qg: { - XtWidgetGeometry xwg, xwg_return; - XtGeometryResult result; - Widget child = find_managed_child((CompositeWidget) w); - - if (child) { - extw_get_geometry_value(XtDisplay(wid), XtWindow(wid), - a_EXTW_QUERY_GEOMETRY, &xwg); - result = XtQueryGeometry(child, &xwg, &xwg_return); - } else - result = XtGeometryYes; - - extw_send_geometry_value(XtDisplay(wid), XtWindow(wid), - a_EXTW_QUERY_GEOMETRY, extw_notify_qg, - result == XtGeometryAlmost ? &xwg_return : - NULL, result); - break; - } - - case extw_notify_focus_in: { - XFocusChangeEvent evnt; - - evnt.type = FocusIn; - evnt.serial = LastKnownRequestProcessed (XtDisplay (wid)); - evnt.send_event = True; - evnt.display = XtDisplay (wid); - evnt.window = XtWindow (wid); - evnt.mode = NotifyNormal; - evnt.detail = NotifyAncestor; -#ifdef emacs - emacs_Xt_handle_focus_event ((XEvent *) &evnt); -#else - XtDispatchEvent ((XEvent *) &evnt); -#endif - break; - } - - case extw_notify_focus_out: { - XFocusChangeEvent evnt; - - evnt.type = FocusOut; - evnt.serial = LastKnownRequestProcessed (XtDisplay (wid)); - evnt.send_event = True; - evnt.display = XtDisplay (wid); - evnt.window = XtWindow (wid); - evnt.mode = NotifyNormal; - evnt.detail = NotifyAncestor; -#ifdef emacs - emacs_Xt_handle_focus_event ((XEvent *) &evnt); -#else - XtDispatchEvent ((XEvent *) &evnt); -#endif - break; - } - - case extw_notify_end: - /* frame should be destroyed. */ - break; - } -} - -/* Lifted almost entirely from GetGeometry() in Shell.c - */ -static void -GetGeometry (Widget W, Widget child) -{ - ExternalShellWidget w = (ExternalShellWidget)W; - int x, y, win_gravity = -1, flag; - XSizeHints hints; - Window win = w->externalShell.external_window; - - { - Window dummy_root; - unsigned int dummy_bd_width, dummy_depth, width, height; - - /* determine the existing size of the window. */ - XGetGeometry(XtDisplay(W), win, &dummy_root, &x, &y, &width, - &height, &dummy_bd_width, &dummy_depth); - w->core.width = width; - w->core.height = height; - } - - if(w->shell.geometry != NULL) { - char def_geom[128]; - int width, height; - - x = w->core.x; - y = w->core.y; - width = w->core.width; - height = w->core.height; - hints.flags = 0; - - sprintf( def_geom, "%dx%d+%d+%d", width, height, x, y ); - flag = XWMGeometry( XtDisplay(W), - XScreenNumberOfScreen(XtScreen(W)), - w->shell.geometry, def_geom, - (unsigned int)w->core.border_width, - &hints, &x, &y, &width, &height, - &win_gravity - ); - if (flag) { - if (flag & XValue) w->core.x = (Position)x; - if (flag & YValue) w->core.y = (Position)y; - if (flag & WidthValue) w->core.width = (Dimension)width; - if (flag & HeightValue) w->core.height = (Dimension)height; - } - else { - String params[2]; - Cardinal num_params = 2; - params[0] = XtName(W); - params[1] = w->shell.geometry; - XtAppWarningMsg(XtWidgetToApplicationContext(W), - "badGeometry", "shellRealize", XtCXtToolkitError, - "Shell widget \"%s\" has an invalid geometry specification: \"%s\"", - params, &num_params); - } - } - else - flag = 0; - - w->shell.client_specified |= _XtShellGeometryParsed; -} - -/* Lifted almost entirely from Realize() in Shell.c - */ -static void ExternalShellRealize (Widget wid, Mask *vmask, - XSetWindowAttributes *attr) -{ - ExternalShellWidget w = (ExternalShellWidget) wid; - Mask mask = *vmask; - Window win = w->externalShell.external_window; - - if (!win) { - Cardinal count = 1; - XtErrorMsg("invalidWindow","shellRealize", XtCXtToolkitError, - "No external window specified for ExternalShell widget %s", - &wid->core.name, &count); - } - - if (! (w->shell.client_specified & _XtShellGeometryParsed)) { - /* we'll get here only if there was no child the first - time we were realized. If the shell was Unrealized - and then re-Realized, we probably don't want to - re-evaluate the defaults anyway. - */ - GetGeometry(wid, (Widget)NULL); - } - else if (w->core.background_pixmap == XtUnspecifiedPixmap) { - /* I attempt to inherit my child's background to avoid screen flash - * if there is latency between when I get resized and when my child - * is resized. Background=None is not satisfactory, as I want the - * user to get immediate feedback on the new dimensions (most - * particularly in the case of a non-reparenting wm). It is - * especially important to have the server clear any old cruft - * from the display when I am resized larger. - */ - Widget *childP = w->composite.children; - int i; - for (i = w->composite.num_children; i; i--, childP++) { - if (XtIsWidget(*childP) && XtIsManaged(*childP)) { - if ((*childP)->core.background_pixmap - != XtUnspecifiedPixmap) { - mask &= ~(CWBackPixel); - mask |= CWBackPixmap; - attr->background_pixmap = - w->core.background_pixmap = - (*childP)->core.background_pixmap; - } else { - attr->background_pixel = - w->core.background_pixel = - (*childP)->core.background_pixel; - } - break; - } - } - } - - if(w->shell.save_under) { - mask |= CWSaveUnder; - attr->save_under = TRUE; - } - if(w->shell.override_redirect) { - mask |= CWOverrideRedirect; - attr->override_redirect = TRUE; - } - if (wid->core.width == 0 || wid->core.height == 0) { - Cardinal count = 1; - XtErrorMsg("invalidDimension", "shellRealize", XtCXtToolkitError, - "Shell widget %s has zero width and/or height", - &wid->core.name, &count); - } - wid->core.window = win; - XChangeWindowAttributes(XtDisplay(wid), wid->core.window, - mask, attr); - -} - -static void ExternalShellDestroy(wid) - Widget wid; -{ - ExternalShellWidget w = (ExternalShellWidget)wid; - - if (XtIsRealized(wid)) - ExternalShellUnrealize(wid); - - NOTIFY(w, extw_notify_end, 0, 0, 0); -} - -/* Invoke matching routine from superclass, but first override its - geometry opinions with our own routine */ - -static void ChangeManaged(wid) - Widget wid; -{ - if (!XtIsRealized (wid)) - GetGeometry(wid, (Widget)NULL); - (*((ShellClassRec*)externalShellClassRec.core_class.superclass)-> - composite_class.change_managed)(wid); -} - -/* Based on RootGeometryManager() in Shell.c */ - -static XtGeometryResult ExternalShellRootGeometryManager(gw, request, reply) - Widget gw; - XtWidgetGeometry *request, *reply; -{ - ExternalShellWidget w = (ExternalShellWidget)gw; - unsigned int mask = request->request_mode; - XEvent event; - int oldx, oldy, oldwidth, oldheight, oldborder_width; - unsigned long request_num; - XtWidgetGeometry req = *request; /* don't modify caller's structure */ - - oldx = w->core.x; - oldy = w->core.y; - oldwidth = w->core.width; - oldheight = w->core.height; - oldborder_width = w->core.border_width; - -#define PutBackGeometry() \ - { w->core.x = oldx; \ - w->core.y = oldy; \ - w->core.width = oldwidth; \ - w->core.height = oldheight; \ - w->core.border_width = oldborder_width; } - - if (mask & CWX) { - if (w->core.x == request->x) mask &= ~CWX; - else - w->core.x = request->x; - } - if (mask & CWY) { - if (w->core.y == request->y) mask &= ~CWY; - else w->core.y = request->y; - } - if (mask & CWBorderWidth) { - if (w->core.border_width == request->border_width) - mask &= ~CWBorderWidth; - else w->core.border_width = request->border_width; - } - if (mask & CWWidth) { - if (w->core.width == request->width) mask &= ~CWWidth; - else w->core.width = request->width; - } - if (mask & CWHeight) { - if (w->core.height == request->height) mask &= ~CWHeight; - else w->core.height = request->height; - } - - if (!XtIsRealized((Widget)w)) return XtGeometryYes; - - req.sibling = None; - req.request_mode = mask & ~CWSibling; - request_num = NextRequest(XtDisplay(w)); - extw_send_geometry_value(XtDisplay(w), XtWindow(w), - a_EXTW_GEOMETRY_MANAGER, - extw_notify_gm, &req, 0); - - if (w->externalShell.dead_client == TRUE) { - /* The client is sick. Refuse the request. - * If the client recovers and decides to honor the - * request, it will be handled by Shell's EventHandler(). - */ - PutBackGeometry(); - return XtGeometryNo; - } - - if (extw_wait_for_response(gw, &event, request_num, extw_notify_gm, - w->externalShell.client_timeout)) { - XtGeometryResult result = (XtGeometryResult) event.xclient.data.l[2]; - - if (result != XtGeometryYes) - PutBackGeometry(); - if (result == XtGeometryAlmost) { - extw_get_geometry_value(XtDisplay(w), XtWindow(w), - a_EXTW_GEOMETRY_MANAGER, reply); - } - return result; - } else { - w->externalShell.dead_client = TRUE; /* timed out; must be broken */ - PutBackGeometry(); - return XtGeometryNo; - } -#undef PutBackGeometry -} - -static void -hack_event_masks_1 (Display *display, Window w, int this_window_propagate) -{ - Window root, parent, *children; - unsigned int nchildren; - int i; - - if (!XQueryTree (display, w, &root, &parent, &children, &nchildren)) - return; - for (i=0; iexternalShell.client_timeout)) - { - /* Xt/Xm extw's have more elaborate focus needs than mere - Xlib ones. - - Rather independently, they *don't* need the - ConfigureNotify event, having fixed up the window size in - ChangeManaged, above, but Xlib extw's do need this. - */ - ew->externalShell.client_type = event.xclient.data.l[2]; - if (ew->externalShell.client_type != EXTW_TYPE_XLIB) - { - hack_event_masks (XtDisplay (w), XtWindow (w)); - } - else - { - XConfigureEvent ev; - XWindowAttributes xwa; - ev.type = ConfigureNotify; - ev.display = XtDisplay (w); - ev.event = ev.window = XtWindow (w); - XGetWindowAttributes (ev.display, ev.window, &xwa); - ev.x = xwa.x; ev.y = xwa.y; - ev.width = xwa.width; ev.height = xwa.height; - ev.border_width = xwa.border_width; - ev.above = None; - ev.override_redirect = xwa.override_redirect; - XtDispatchEvent ((XEvent *) &ev); - } - return TRUE; - } - else - return FALSE; -} - -void -ExternalShellSetFocus (Widget wid) -{ - ExternalShellWidget w = (ExternalShellWidget) wid; - - NOTIFY(w, extw_notify_set_focus, 0, 0, 0); -} - -extern void _XtUnregisterWindow (Window, Widget); - -void -ExternalShellUnrealize (Widget w) -{ -#if (XT_REVISION > 5) - XtUnregisterDrawable (XtDisplay (w), w->core.window); -#else - extern void _XtUnregisterWindow (Window, Widget); - _XtUnregisterWindow (w->core.window, w); -#endif - w->core.window = 0; -} diff --git a/src/ExternalShell.h b/src/ExternalShell.h deleted file mode 100644 index 54c49b9..0000000 --- a/src/ExternalShell.h +++ /dev/null @@ -1,57 +0,0 @@ -/* External shell widget external header file. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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, September 1993. */ - -#ifndef _ExternalShell_h -#define _ExternalShell_h - -#ifndef XtNwindow -#define XtNwindow "window" -#endif -#ifndef XtCWindow -#define XtCWindow "Window" -#endif - -#ifndef XtNclientTimeout -#define XtNclientTimeout "clientTimeout" -#endif -#ifndef XtCClientTimeout -#define XtCClientTimeout "ClientTimeout" -#endif - -#ifndef XtNdeadClient -#define XtNdeadClient "deadClient" -#endif -#ifndef XtCDeadClient -#define XtCDeadClient "DeadClient" -#endif - -typedef struct _ExternalShellClassRec *ExternalShellWidgetClass; -typedef struct _ExternalShellRec *ExternalShellWidget; -extern WidgetClass externalShellWidgetClass; - -Bool ExternalShellReady(Widget w, Window win, long event_mask); -void ExternalShellSetFocus(Widget w); -void ExternalShellUnrealize(Widget w); - -#define is_external_shell(w) (XtClass (w) == externalShellWidgetClass) - -#endif /* _ExternalShell_h */ diff --git a/src/ExternalShellP.h b/src/ExternalShellP.h deleted file mode 100644 index 7fd9f76..0000000 --- a/src/ExternalShellP.h +++ /dev/null @@ -1,59 +0,0 @@ -/* External shell widget internal header file. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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, September 1993. */ - -#ifndef _ExternalShellP_h -#define _ExternalShellP_h - -#include "xintrinsic.h" -#include -#include "ExternalShell.h" - -typedef struct { /* new fields for ExternalShell class */ - int dummy; -} ExternalShellClassPart; - -typedef struct _ExternalShellClassRec { /* full class record declaration */ - CoreClassPart core_class; - CompositeClassPart composite_class; - ShellClassPart shell_class; - ExternalShellClassPart externalShell_class; -} ExternalShellClassRec; - -typedef struct { /* new fields for ExternalShell widget */ - Window external_window; /* an already-created window to run on */ - Bool dead_client; /* is the client dead? */ - unsigned long client_timeout;/* how long to wait for client's response */ - - /* private */ - unsigned char client_type; -} ExternalShellPart; - -typedef struct _ExternalShellRec { /* full instance record */ - CorePart core; - CompositePart composite; - ShellPart shell; - ExternalShellPart externalShell; -} ExternalShellRec; - -extern ExternalShellClassRec externalShellClassRec; /* class pointer */ - -#endif /* _ExternalShellP_h */ diff --git a/src/Makefile.in.in b/src/Makefile.in.in deleted file mode 100644 index 723d739..0000000 --- a/src/Makefile.in.in +++ /dev/null @@ -1,748 +0,0 @@ -## Makefile for src subdirectory in XEmacs. -## Copyright (C) 1985, 1987, 1988, 1993, 1994 Free Software Foundation, Inc. -## Copyright (C) 1994, 1995 Board of Trustees, University of Illinois -## Copyright (C) 1996, 1997 Sun Microsystems, Inc. -## Copyright (C) 1998, 1999 J. Kean Johnston. - -## 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. - -PROGNAME=@PROGNAME@ - -all: ${PROGNAME} -.PHONY : all release dump-elc dump-elcs all-elc all-elcs lint - -## For performance and consistency, no built-in rules. -.SUFFIXES: -.SUFFIXES: .c .h .o .i .s .dep - -#ifdef USE_GNU_MAKE -RECURSIVE_MAKE=$(MAKE) -#else -@SET_MAKE@ -RECURSIVE_MAKE=@RECURSIVE_MAKE@ -#endif - -SHELL=/bin/sh -RM = rm -f - -lispdir = ${srcdir}/../lisp/ -moduledir = ${srcdir}/../modules/ -libsrc = ../lib-src/ -etcdir = ../etc/ - -## Here are the things that we expect ../configure to edit. -prefix=@prefix@ -srcdir=@srcdir@ -blddir=@blddir@ -version=@version@ -CC=@XEMACS_CC@ -CPP=@CPP@ -CFLAGS=@CFLAGS@ -CPPFLAGS=@CPPFLAGS@ -LDFLAGS=@LDFLAGS@ - -c_switch_all=@c_switch_all@ -ld_switch_all=@ld_switch_all@ -ld_libs_all=@ld_libs_all@ -ld_dynamic_link_flags=@ld_dynamic_link_flags@ - -extra_objs=@extra_objs@ -LN_S=@LN_S@ - -ld_switch_shared=@ld_switch_shared@ -start_files=@start_files@ -start_flags=@start_flags@ -LD=@ld@ -lib_gcc=@lib_gcc@ -##libmcheck=@libmcheck@ - -#define NOT_C_CODE -#include "config.h" - -## With the traditional VPATH setting, it is not possible to -## simultaneously compile in-place and in another directory. The -## mistaken definition is that *all* dependencies are searched for in -## the VPATH directory, rather than just the dependencies that are not -## themselves targets. Thus, if there is an up-to-date .o file in the -## in-place location, it will not get recompiled in the not-in-place -## location. - -## The GNU Make "vpath" directive continues this tradition, but at -## least lets you restrict the classes of files that it applies to. -## This allows us to kludge around the problem. - -#ifdef USE_GNU_MAKE -vpath %.c @srcdir@ -vpath %.h @srcdir@ -## now list files that should NOT be searched in the srcdir. -## This includes any .c or .h built from something else -## (e.g. a .in file). -vpath config.h -vpath paths.h -vpath Emacs.ad.h -vpath puresize-adjust.h -vpath sheap-adjust.h -#else -VPATH=@srcdir@ -#endif - -RM = rm -f - -#ifdef HAVE_NATIVE_SOUND -sound_cflags=@sound_cflags@ -#endif - -LWLIB_SRCDIR = ${srcdir}/../lwlib - -#ifdef HAVE_X_WINDOWS -lwlib_libs = ../lwlib/liblw.a -lwlib_deps = $(lwlib_libs) -$(lwlib_libs) : - cd ../lwlib && $(RECURSIVE_MAKE) - -x_objs=balloon_help.o balloon-x.o console-x.o device-x.o event-Xt.o frame-x.o\ - glyphs-x.o objects-x.o redisplay-x.o xgccache.o xselect.o - -#ifdef AIX4 -LIBI18N = -li18n -#endif /* AIX4 */ - -X11_libs = $(LIBI18N) -#endif /* HAVE_X_WINDOWS */ - -#ifdef HEAP_IN_DATA -sheap_obj=sheap.o -#endif - -## -Demacs is needed to make some files produce the correct version -## for use in Emacs. - -cppflags = $(CPPFLAGS) -Demacs -I. $(c_switch_all) -cflags = $(CFLAGS) $(cppflags) -ldflags = $(LDFLAGS) $(ld_switch_all) $(ld_dynamic_link_flags) - -#ifdef SOLARIS2 -%.o : %.c -#else -.c.o: -#endif - $(CC) -c $(cflags) $< - -## Create preprocessor output (debugging purposes only) -.c.i: -#ifdef __GNUC__ - $(CC) -E $(cppflags) -o $@ $< -#else /* works on Solaris; what about other systems? */ - $(CC) -P $(cppflags) $< -#endif /* compiler */ - -## Create assembler output (debugging purposes only) -.c.s: - $(CC) -S -c $(cflags) $< - -## Create RTL files -%.c.rtl : %.c - $(CC) -dr -c $(cflags) $< - -## lastfile must follow all files whose initialized data areas should -## be dumped as pure by dump-emacs. - -## NOTE: The last line cannot be all macros, because make will barf -## if they all come out null. - -objs=\ - abbrev.o alloc.o blocktype.o buffer.o bytecode.o\ - callint.o callproc.o casefiddle.o casetab.o chartab.o\ - cmdloop.o cmds.o console.o console-stream.o\ - data.o device.o dired.o doc.o doprnt.o dynarr.o\ - editfns.o elhash.o emacs.o\ - eval.o events.o $(extra_objs)\ - event-stream.o extents.o faces.o\ - fileio.o $(LOCK_OBJ) filemode.o floatfns.o fns.o font-lock.o\ - frame.o general.o getloadavg.o glyphs.o glyphs-eimage.o glyphs-widget.o\ - gui.o $(gui_objs) hash.o imgproc.o indent.o insdel.o intl.o\ - keymap.o $(RTC_patch_objs) line-number.o lread.o lstream.o\ - macros.o marker.o md5.o minibuf.o objects.o opaque.o\ - print.o process.o profile.o\ - rangetab.o redisplay.o redisplay-output.o regex.o\ - search.o $(sheap_obj) signal.o sound.o\ - specifier.o strftime.o symbols.o syntax.o sysdep.o\ - undo.o $(x_objs) widget.o window.o - -obj_rtl = $(objs:.o=.c.rtl) - -#ifdef REL_ALLOC -rallocdocsrc = ralloc.c -rallocobjs = ralloc.o -#endif - -malloclib = $(libmcheck) -#ifndef SYSTEM_MALLOC -# ifdef GNU_MALLOC /* GNU malloc */ -# ifdef ERROR_CHECK_MALLOC -#ifdef DOUG_LEA_MALLOC -mallocobjs = free-hook.o vm-limit.o -#else -mallocobjs = gmalloc.o free-hook.o vm-limit.o -#endif -mallocdocsrc = free-hook.c -# else /* New GNU malloc, sans error checking */ -#ifdef DOUG_LEA_MALLOC -mallocobjs = vm-limit.o -#else -mallocobjs = gmalloc.o vm-limit.o -#endif -mallocdocsrc = -# endif /* ERROR_CHECK_MALLOC */ -# else /* Older GNU malloc */ -mallocobjs = malloc.o -mallocdocsrc = -# endif /* Older GNU malloc */ -#else /* SYSTEM_MALLOC */ -mallocobjs = -mallocdocsrc = -#ifdef USE_DEBUG_MALLOC -malloclib = -ldmalloc -#endif /* USE_DEBUG_MALLOC */ -#endif /* SYSTEM_MALLOC */ - -#ifdef HAVE_X_WINDOWS - -# ifdef EXTERNAL_WIDGET -external_widget_objs = ExternalShell.o extw-Xt-nonshared.o extw-Xlib-nonshared.o - -## Now we try to figure out how to link a shared library. -## If we cannot figure it out, leave EXTW_LINK undefined and a shared -## library will not be created. - -# ifdef USE_GCC -# ifdef USG5 -# define EXTW_LINK(objs, output) $(CC) -shared objs -Xlinker -z -Xlinker text -o output -extw_link_beg = $(CC) -shared -extw_link_mid = -Xlinker -z -Xlinker text -o -extw_link_end = -## I cannot figure out how to do shared a.out libraries, so just punt. -# elif !defined (LINUX) || defined (__ELF__) -# define EXTW_LINK(objs, output) $(CC) -shared objs -o output -extw_link_beg = $(CC) -shared -extw_link_mid = -o -extw_link_end = -# endif -# elif defined (USG5) -# if defined (IRIX) -# define EXTW_LINK(objs, output) $(LD) -shared -g -check_registry ${TOOLROOT}/usr/lib/so_locations objs -o output -extw_link_beg = $(LD) -shared -g -check_registry ${TOOLROOT}/usr/lib/so_locations -extw_link_mid = -o -extw_link_end = -# else /* not IRIX */ -# define EXTW_LINK(objs, output) $(CC) -G objs -z text -o output -extw_link_beg = $(CC) -G -extw_link_mid = -z text -o -extw_link_end = -# endif /* not IRIX */ -# else /* not USG5 */ -# if defined (DEC_ALPHA) && defined (OSF1) -# define EXTW_LINK(objs, output) $(LD) $(ldflags) $(ld_switch_shared) -d objs -o output $(LIBES) -extw_link_beg = $(LD) $(ldflags) $(ld_switch_shared) -d -extw_link_mid = -o -extw_link_end = $(LIBES) -# else /* !(DEC_ALPHA && OSF1) */ -# define EXTW_LINK(objs, output) $(LD) -dc objs -assert pure-text -o output -extw_link_beg = $(LD) -dc -extw_link_mid = -assert pure-text -o -extw_link_end = -# endif /* !(DEC_ALPHA && OSF1) */ -# endif /* not USG5 */ - -# ifdef LWLIB_USES_MOTIF -# ifdef EXTW_LINK -motif_other_files = libextcli_Xm.a libextcli_Xm.so.1 -# else -motif_other_files = libextcli_Xm.a -# endif -#endif /* LWLIB_USES_MOTIF */ - -# ifdef EXTW_LINK -shared_other_files = libextcli_Xt.so.1 libextcli_Xlib.so.1 -# endif -other_files=\ - ${motif_other_files}\ - libextcli_Xt.a libextcli_Xlib.a\ - ${shared_other_files} - -all: ${other_files} -# endif /* EXTERNAL_WIDGET */ - -# if defined (HAVE_OFFIX_DND) || defined (HAVE_CDE) -dnd_objs = @dnd_objs@ -# endif /* HAVE_OFFIX_DND || HAVE_CDE */ - -X11_objs = EmacsFrame.o EmacsShell.o TopLevelEmacsShell.o TransientEmacsShell.o EmacsManager.o $(external_widget_objs) $(dnd_objs) -#endif /* HAVE_X_WINDOWS */ - -## define otherobjs as list of object files that make-docfile -## should not be told about. -otherobjs = lastfile.o $(mallocobjs) $(rallocobjs) $(X11_objs) -otherrtls = $(otherobjs:.o=.c.rtl) -othersrcs = $(otherobjs:.o=.c) - -LIBES = $(lwlib_libs) $(malloclib) $(ld_libs_all) $(lib_gcc) - -#ifdef I18N3 -mo_dir = ${etcdir} -mo_file = ${mo_dir}emacs.mo -#endif - -LOADPATH = EMACSBOOTSTRAPLOADPATH="${lispdir}:${blddir}" -MODULEPATH = EMACSBOOTSTRAPMODULEPATH="${moduledir}:${blddir}" -DUMPENV = $(LOADPATH) $(MODULEPATH) -temacs_loadup = $(DUMPENV) ./temacs -batch -l ${srcdir}/../lisp/loadup.el -dump_temacs = ${temacs_loadup} dump -run_temacs = ${temacs_loadup} run-temacs - -release: temacs ${libsrc}DOC $(mo_file) ${other_files} -#ifdef CANNOT_DUMP - ln temacs ${PROGNAME} -#else -#ifdef HAVE_SHM - -if [ -w ${srcdir}/../lisp ]; then \ - w=`pwd`; cd ${srcdir} && $${w}/temacs -nl -batch -l ${srcdir}/../lisp/inc-vers; \ - else true; fi - @touch SATISFIED - -$(DUMPENV) ./temacs -nl -batch -l ${srcdir}/../lisp/loadup.el dump - @if test ! -f SATISFIED; then $(RECURSIVE_MAKE) $@; fi - @$(RM) SATISFIED -#else /* ! defined (HAVE_SHM) */ - -if [ -w ${srcdir}/../lisp ]; then \ - w=`pwd`; cd ${srcdir} && $${w}/temacs -batch -l ${srcdir}/../lisp/inc-vers; \ - else true; fi - @touch SATISFIED - -$(DUMPENV) ./temacs -batch -l ${srcdir}/../lisp/loadup.el dump - @if test ! -f SATISFIED; then $(RECURSIVE_MAKE) $@; fi - @$(RM) SATISFIED -#endif /* ! defined (HAVE_SHM) */ - touch release -#endif /* ! defined (CANNOT_DUMP) */ - -${PROGNAME}: temacs ${libsrc}DOC $(mo_file) ${other_files} update-elc.stamp - @$(RM) $@ && touch SATISFIED - -${dump_temacs} - @if test -f $@; then if test -f SATISFIED; then \ - echo "Testing for Lisp shadows ..."; \ - ./${PROGNAME} -batch -vanilla -f list-load-path-shadows; fi; \ - $(RM) SATISFIED; exit 0; fi; \ - if test -f SATISFIED; then $(RM) SATISFIED; exit 1; fi; \ - $(RECURSIVE_MAKE) $@; - -fastdump: temacs - @$(RM) ${PROGNAME} && touch SATISFIED - -${dump_temacs} - @if test -f ${PROGNAME}; then if test -f SATISFIED; then \ - ./${PROGNAME} -batch -vanilla -f list-load-path-shadows; fi; \ - $(RM) SATISFIED; exit 0; fi; \ - if test -f SATISFIED; then $(RM) SATISFIED; exit 1; fi; - -FRC.update-elc.stamp : - -update-elc.stamp : temacs FRC.update-elc.stamp - @touch NOBYTECOMPILE - ${DUMPENV} ./temacs -batch -l ${srcdir}/../lisp/update-elc.el - @if test ! -f $@ -o -f NOBYTECOMPILE; then touch $@; fi; \ - $(RM) NOBYTECOMPILE - -obj_src = $(objs:.o=.c) - -dortl : $(obj_rtl) $(otherrtls) - echo "(defvar source-files '(" > ${srcdir}/../lisp/source-files.el - (for a in $(obj_src) $(othersrcs);do \ - echo -n "\""$$a"\"" >> ${srcdir}/../lisp/source-files.el ;\ - done) - echo "))" >> ${srcdir}/../lisp/source-files.el - -#ifdef DYNODUMP -dynodump_deps = ../dynodump/dynodump.so -../dynodump/dynodump.so: - cd ../dynodump && $(RECURSIVE_MAKE) -#endif /* DYNODUMP */ - -${libsrc}DOC: temacs update-elc.stamp - $(RM) ${libsrc}DOC; \ - ${DUMPENV} ./temacs -batch -l ${srcdir}/../lisp/make-docfile.el -- \ - -o ${libsrc}DOC -d ${srcdir} -i ${libsrc}../site-packages \ - ${obj_src} ${mallocdocsrc} ${rallocdocsrc} - -dump_elcs: dump-elcs - -dump-elcs: temacs - -${DUMPENV} ./temacs -batch -l ${srcdir}/../lisp/update-elc.el - -all-elc all-elcs: - cd .. && $(RECURSIVE_MAKE) all-elc - -#ifdef I18N3 - -# if defined(SPARC) && !defined(USG) - xgettext= /usr/openwin/bin/xgettext - xgettext_args= -o emacs -m_X messages - msgfmt= /usr/openwin/bin/msgfmt -# else - xgettext= xgettext - xgettext_args= -s -d emacs -M_X messages - msgfmt= msgfmt -#endif - -${mo_dir}emacs.po: ${libsrc}make-msgfile ${libsrc}make-po ${objs} - ${libsrc}make-msgfile -o ${libsrc}messages ${objs} - cd ${libsrc} && ${xgettext} ${xgettext_args} - $(RM) ${mo_dir}emacs.po - cd ${libsrc} && ${libsrc}make-po -a ${mo_dir}emacs.po DOC - -${mo_dir}emacs.mo: ${mo_dir}emacs.po - cd ${mo_dir} && ${msgfmt} -o emacs.mo emacs.po - -${libsrc}make-msgfile: - cd ${libsrc} && $(RECURSIVE_MAKE) make-msgfile - -${libsrc}make-po: - cd ${libsrc} && $(RECURSIVE_MAKE) make-po - -#endif /* I18N3 */ - -${libsrc}make-docfile: - cd ${libsrc} && $(RECURSIVE_MAKE) make-docfile - -## Lint Section -LINT.c=$(LINT) $(LINTFLAGS) $(LINTINCLUDES) -LINTFILES= $(objs:.o=.ln) -LINTINCLUDES = $(cppflags) -## LINTFLAGS= -fd -m -p -s -u -v -x -LINTFLAGS= -fd -m -s -u -v -x -lint: $(LINTFILES) - $(LINT.c) $(LINTFILES) -## end of Lint Section - -temacs_deps=\ - $(start_files) ${objs} ${otherobjs}\ - $(lwlib_deps) $(dynodump_deps) - -temacs_link_args=\ - ${start_flags} ${ldflags}\ - -o $@ ${start_files} ${objs} ${otherobjs} ${LIBES} - -temacs: $(temacs_deps) - $(LD) $(temacs_link_args) - -.PHONY : run-temacs - -run-temacs: temacs - -${run_temacs} - -## We have automated tests!! -testdir = ${srcdir}/../tests/automated -tests = \ - ${testdir}/hash-table-tests.el \ - ${testdir}/lisp-tests.el \ - ${testdir}/database-tests.el \ - ${testdir}/byte-compiler-tests.el \ - ${testdir}/md5-tests.el -batch_test_emacs = -batch -l ${testdir}/test-harness.el -f batch-test-emacs ${tests} - -.PHONY: check check-temacs -check: - ./${PROGNAME} ${batch_test_emacs} -check-temacs: - ${run_temacs} ${batch_test_emacs} - -## Debugging targets: -## -## None of the debugging products work with a dumped xemacs binary, -## because it does unexpected things like free memory that has been -## malloc'ed in a *different* process!! So we need to run these on -## temacs. - -## RTC is Sun WorkShop's Run Time Checking, integrated with dbx -rtc_patch.o: - rtc_patch_area -o $@ - -rtcmacs: $(temacs_deps) rtc_patch.o - $(RM) temacs; $(RECURSIVE_MAKE) temacs RTC_patch_objs=rtc_patch.o - mv temacs rtcmacs - -.PHONY: run-rtcmacs -run-rtcmacs: rtcmacs - dbx -q -C -c \ - 'dbxenv rtc_error_log_file_name /dev/fd/1; \ - dbxenv suppress_startup_message 5.0; \ - ignore POLL; \ - check -access; \ - suppress rui; \ - runargs -batch -l ${srcdir}/../lisp/loadup.el run-temacs -q; \ - run' rtcmacs - -## Purify, Quantify, PureCoverage are software quality products from -## Rational, formerly Pure Atria, formerly Pure Software. -## -## Purify -PURIFY_PROG = purify -PURIFY_FLAGS = -chain-length=32 -ignore-signals=SIGPOLL -threads=yes \ - -cache-dir=./purecache -always-use-cache-dir=yes -pointer-mask=0x0fffffff -PURIFY_LIBS = -lpthread -puremacs: $(temacs_deps) - $(PURIFY_PROG) $(PURIFY_FLAGS) $(LD) $(temacs_link_args) $(PURIFY_LIBS) - cp $@ temacs - -## Quantify -#ifdef QUANTIFY -QUANTIFY_PROG = quantify -QUANTIFY_HOME = `$(QUANTIFY_PROG) -print-home-dir` -QUANTIFY_FLAGS = -cache-dir=./purecache -always-use-cache-dir=yes -cppflags += -I$(QUANTIFY_HOME) -temacs_link_args += $(QUANTIFY_HOME)/quantify_stubs.a - -quantmacs: $(temacs_deps) - $(QUANTIFY_PROG) $(QUANTIFY_FLAGS) $(LD) $(temacs_link_args) - cp $@ temacs -#endif /* QUANTIFY */ - - -PURECOV_PROG=purecov -covmacs: $(temacs_deps) - $(PURECOV_PROG) $(LD) $(temacs_link_args) - - -TopLevelEmacsShell.o : ${srcdir}/EmacsShell-sub.c config.h xintrinsicp.h EmacsShellP.h - $(CC) -c $(cflags) -DDEFINE_TOP_LEVEL_EMACS_SHELL ${srcdir}/EmacsShell-sub.c - mv EmacsShell-sub.o TopLevelEmacsShell.o - -TopLevelEmacsShell.c.rtl : ${srcdir}/EmacsShell-sub.c config.h xintrinsicp.h EmacsShellP.h - $(CC) -dr -c $(cflags) -DDEFINE_TOP_LEVEL_EMACS_SHELL ${srcdir}/EmacsShell-sub.c - mv EmacsShell-sub.c.rtl TopLevelEmacsShell.c.rtl - -TransientEmacsShell.o : ${srcdir}/EmacsShell-sub.c TopLevelEmacsShell.o config.h xintrinsicp.h EmacsShellP.h - $(CC) -c $(cflags) -DDEFINE_TRANSIENT_EMACS_SHELL ${srcdir}/EmacsShell-sub.c - mv EmacsShell-sub.o TransientEmacsShell.o - -TransientEmacsShell.c.rtl : ${srcdir}/EmacsShell-sub.c TopLevelEmacsShell.o config.h xintrinsicp.h EmacsShellP.h - $(CC) -dr -c $(cflags) -DDEFINE_TRANSIENT_EMACS_SHELL ${srcdir}/EmacsShell-sub.c - mv EmacsShell-sub.c.rtl TransientEmacsShell.c.rtl - -## Position-independent code for shared library creation -#if USE_GCC -pic_arg = -fpic -#elif defined (IRIX) -pic_arg = -KPIC -# else -pic_arg = -K pic -#endif - -#ifdef EXTERNAL_WIDGET - -external_client_motif_objs_shared = ExternalClient-Xm-shared.o extw-Xt-shared.o extw-Xlib-shared.o -external_client_xt_objs_shared = ExternalClient-Xt-shared.o extw-Xt-shared.o extw-Xlib-shared.o -external_client_xlib_objs_shared = ExternalClient-Xlib-shared.o extw-Xlib-shared.o -external_client_motif_objs_nonshared = ExternalClient-Xm-nonshared.o extw-Xt-nonshared.o extw-Xlib-nonshared.o -external_client_xt_objs_nonshared = ExternalClient-Xt-nonshared.o extw-Xt-nonshared.o extw-Xlib-nonshared.o -external_client_xlib_objs_nonshared = ExternalClient-Xlib-nonshared.o extw-Xlib-nonshared.o - -## Add dependencies so things work right with a parallel make -ExternalClient-Xm-shared.o: ${srcdir}/ExternalClient.c ExternalClient-Xt-shared.o ExternalClient-Xm-nonshared.o - $(CC) -c $(pic_arg) $(cflags) -DEXTW_USES_MOTIF ${srcdir}/ExternalClient.c - mv ExternalClient.o ExternalClient-Xm-shared.o - -ExternalClient-Xt-shared.o: ${srcdir}/ExternalClient.c ExternalClient-Xt-nonshared.o - $(CC) -c $(pic_arg) $(cflags) ${srcdir}/ExternalClient.c - mv ExternalClient.o ExternalClient-Xt-shared.o - -ExternalClient-Xlib-shared.o: ${srcdir}/ExternalClient-Xlib.c ExternalClient-Xlib-nonshared.o - $(CC) -c $(pic_arg) $(cflags) ${srcdir}/ExternalClient-Xlib.c - mv ExternalClient-Xlib.o ExternalClient-Xlib-shared.o - -ExternalClient-Xm-nonshared.o: ${srcdir}/ExternalClient.c ExternalClient-Xt-nonshared.o - $(CC) -c $(cflags) -DEXTW_USES_MOTIF ${srcdir}/ExternalClient.c - mv ExternalClient.o ExternalClient-Xm-nonshared.o - -ExternalClient-Xt-nonshared.o: ${srcdir}/ExternalClient.c - $(CC) -c $(cflags) ${srcdir}/ExternalClient.c - mv ExternalClient.o ExternalClient-Xt-nonshared.o - -ExternalClient-Xlib-nonshared.o: ${srcdir}/ExternalClient-Xlib.c - $(CC) -c $(cflags) ${srcdir}/ExternalClient-Xlib.c - mv ExternalClient-Xlib.o ExternalClient-Xlib-nonshared.o - -## We compile the common files twice (once with PIC and once without) -## because on some systems, compiling with PIC but not linking into -## a shared library messes things up. - -extw-Xt-shared.o: ${srcdir}/extw-Xt.c extw-Xt-nonshared.o - $(CC) -c $(pic_arg) $(cflags) ${srcdir}/extw-Xt.c - mv extw-Xt.o extw-Xt-shared.o - -extw-Xlib-shared.o: ${srcdir}/extw-Xlib.c extw-Xlib-nonshared.o - $(CC) -c $(pic_arg) $(cflags) ${srcdir}/extw-Xlib.c - mv extw-Xlib.o extw-Xlib-shared.o - -extw-Xt-nonshared.o: ${srcdir}/extw-Xt.c - $(CC) -c $(cflags) ${srcdir}/extw-Xt.c - mv extw-Xt.o extw-Xt-nonshared.o - -extw-Xlib-nonshared.o: ${srcdir}/extw-Xlib.c - $(CC) -c $(cflags) ${srcdir}/extw-Xlib.c - mv extw-Xlib.o extw-Xlib-nonshared.o - -libextcli_Xm.a: ${external_client_motif_objs_nonshared} - ar r libextcli_Xm.a ${external_client_motif_objs_nonshared} - -libextcli_Xt.a: ${external_client_xt_objs_nonshared} - ar r libextcli_Xt.a ${external_client_xt_objs_nonshared} - -libextcli_Xlib.a: ${external_client_xlib_objs_nonshared} - ar r libextcli_Xlib.a ${external_client_xlib_objs_nonshared} - -#ifdef EXTW_LINK - -libextcli_Xm.so.1: ${external_client_motif_objs_shared} - ${extw_link_beg} ${external_client_motif_objs_shared} ${extw_link_mid} libextcli_Xm.so.1 ${extw_link_end} - -libextcli_Xt.so.1: ${external_client_xt_objs_shared} - ${extw_link_beg} ${external_client_xt_objs_shared} ${extw_link_mid} libextcli_Xt.so.1 ${extw_link_end} - -libextcli_Xlib.so.1: ${external_client_xlib_objs_shared} - ${extw_link_beg} ${external_client_xlib_objs_shared} ${extw_link_mid} libextcli_Xlib.so.1 ${extw_link_end} - -#endif /* EXTW_LINK */ - -#endif /* EXTERNAL_WIDGET */ - -config.h: ${srcdir}/config.h.in -puresize-adjust.h: ${srcdir}/puresize.h -Emacs.ad.h: ${srcdir}/${etcdir}Emacs.ad - -config.h puresize-adjust.h sheap-adjust.h paths.h Emacs.ad.h : - @echo "The file $@ needs to be re-generated." - @echo "Please run a make in the top level directory." - @echo "Consult the file \`INSTALL' for instructions for building XEmacs." - @exit 1 - -## Some machines have alloca built-in. -## They should define HAVE_ALLOCA, or may just let alloca.s -## be used but generate no code. -## Some have it written in assembler in alloca.s. -## Some use the C version in alloca.c (these define C_ALLOCA in config.h). - - -#ifdef C_ALLOCA -## We could put something in alloca.c to #define free and malloc -## whenever emacs was #defined, but that's not appropriate for all -## users of alloca in Emacs. Check out ../lib-src/getopt.c. */ - -alloca.o : ${srcdir}/alloca.c - $(CC) -c -Dfree=xfree -Dmalloc=xmalloc $(cflags) ${srcdir}/alloca.c -#else -#ifndef HAVE_ALLOCA -alloca.o : ${srcdir}/alloca.s config.h -## $(CPP) is cc -E, which may get confused by filenames -## that do not end in .c. So copy file to a safe name. */ -## cp ${srcdir}/alloca.s allocatem.c -## Remove any ^L, blank lines, and preprocessor comments, -## since some assemblers barf on them. Use a different basename for the -## output file, since some stupid compilers (Green Hill) use that -## name for the intermediate assembler file. - $(CPP) $(cppflags) allocatem.c | \ - sed -e 's/ //' -e 's/^#.*//' | \ - sed -n -e '/^..*$$/p' > allocax.s - @$(RM) alloca.o -## Xenix, in particular, needs to run assembler via cc. - $(CC) -c allocax.s - mv allocax.o alloca.o - $(RM) allocax.s allocatem.c -#endif /* HAVE_ALLOCA */ -#endif /* ! defined (C_ALLOCA) */ - -#ifdef HAVE_NATIVE_SOUND -sunplay.o: ${srcdir}/sunplay.c - $(CC) -c $(sound_cflags) $(cflags) ${srcdir}/sunplay.c -hpplay.o: ${srcdir}/hpplay.c - $(CC) -c -Demacs $(sound_cflags) $(cflags) ${srcdir}/hpplay.c -#endif /* HAVE_NATIVE_SOUND */ - -## System-specific programs to be made. -## ${other_files}, $(objects_system) and $(objects_machine) -## select which of these should be compiled. */ - -.PHONY: mostlyclean clean distclean realclean versionclean extraclean -mostlyclean: - $(RM) temacs puremacs quantmacs prefix-args *.o *.i \ - core temacs.exe puresize-adjust.h sheap-adjust.h -clean: mostlyclean versionclean - $(RM) libextcli* update-elc.stamp -## This is used in making a distribution. -## Do not use it on development directories! -distclean: clean - $(RM) config.h paths.h Emacs.ad.h \ - GNUmakefile Makefile Makefile.in TAGS ${PROGNAME}.* -realclean: distclean -versionclean: - $(RM) ${PROGNAME} ${PROGNAME}.exe ${libsrc}DOC -extraclean: realclean - $(RM) *~ \#* m/*~ m/\#* s/*~ s/\#* - -.PHONY : lock unlock -SOURCES = *.[chm] *.pswm [sm]/* COPYING paths.h.in Makefile.in.in \ - config.h.in README COPYING ChangeLog -unlock: - chmod u+w $(SOURCES) - -relock: - chmod -w $(SOURCES) - -## Header files for ellcc -#ifdef HAVE_SHLIB -MAKEPATH=../lib-src/make-path -install: ${PROGNAME} - ${MAKEPATH} ${archlibdir}/include ${archlibdir}/include/m ${archlibdir}/include/s - -@echo "Copying include files for ellcc..." - -@hdir=`pwd`; \ - cd ${srcdir}; hdrdir2=`pwd`; cd $$hdir; \ - test "$$hdrdir2" != "$$hdir" && hdir="$$hdir $$hdrdir2"; \ - (for thisdir in $$hdir; do \ - cd $$hdir && \ - (hdrtars=; \ - for hdrfile in *.h; do \ - hdrtars="$$hdrtars $$hdrfile"; \ - done; \ - test -d s && hdrtars="$$hdrtars s/*"; \ - test -d m && hdrtars="$$hdrtars m/*"; \ - test -n "$$hdrtars" && (tar cf - $$hdrtars) | \ - (cd ${archlibdir}/include && umask 022 && tar xf -); \ - chmod 755 ${archlibdir}/include; \ - test -d ${archlibdir}/include/s && \ - chmod 755 ${archlibdir}/include/s; \ - test -d ${archlibdir}/include/m && \ - chmod 755 ${archlibdir}/include/s;) \ - done) -#endif - -## Dependency processing using home-grown script, not makedepend -.PHONY: depend -FRC.depend: -depend: FRC.depend - cd ${srcdir} && $(RM) depend.tmp && \ - perl make-src-depend > depend.tmp && \ - $(RM) depend && mv depend.tmp depend diff --git a/src/README b/src/README deleted file mode 100644 index 29dbb22..0000000 --- a/src/README +++ /dev/null @@ -1,93 +0,0 @@ -This directory contains the source files for the C component of XEmacs. -Nothing in this directory is needed for using XEmacs once it is built -and installed, if the dumped Emacs is copied elsewhere. - -See the files ../README and then ../INSTALL for installation instructions. - -Under Unix, the file `Makefile.in.in' is used as a template by the script -`../configure' to produce `Makefile.in'. The same script then uses `cpp' -to produce the machine-dependent `Makefile' from `Makefile.in'; -`Makefile' is the file which actually controls the compilation of -Emacs. Most of this should work transparently to the user; you should -only need to run `../configure', and then type `make'. - -General changes for XEmacs: ---------------------------- -1. Lisp objects. - - -- XFASTINT has been eliminated. Use of this expression as an lvalue - is incompatible with the union form of Lisp objects, and use as - an rvalue is likely to lead to errors and doesn't really save much - time. Expressions of the form `XFASTINT (obj) = num;' get replaced - by `obj = make_int (num);' or `XSETINT (obj, num);' and - expressions of the form `num = XFASTINT (obj);' get replaced by - `num = XINT (obj);'. Use Qzero in place of `make_int (0)'. - - -- Use of XTYPE gets replaced by the appropriate predicate. Using - XTYPE only works for the small number of types that are not stored - using the Lisp_Record type (int, cons, string, and vector). For - example, `(XTYPE (foo) == Lisp_Buffer)' gets replaced by - `(BUFFERP (foo))'. - - -- `XSET (obj, Lisp_Int, num)' gets replaced by `XSETINT (obj, num)', - for consistency. - - -- Some occurrences of XSET need to get replaced by XSETR -- - specifically, those where the type is not a primitive type - (primitive types are int, cons, string, and vector). - - -- References to `XSTRING (obj)->size' get replaced with - `XSTRING_LENGTH (obj)'. This is currently for cosmetic reasons - but there may be other reasons in the future. (This change is - currently incomplete in the source files.) - - -2. Storage classes: - - -- All occurrences of `const' should get replaced by CONST. This - is to work around a header conflict with X11R4. - - -- All occurrences of `register' should be replaced by `REGISTER'. - It interferes with backtraces so we disable it if DEBUG_XEMACS - is defined. - - -3. Errors, messages, I18N3 snarfing: - - -- Errors are continuable in XEmacs but are not in FSF Emacs. - Therefore, it's important that functions do something reasonable - if an error gets continued. If you want to signal a non- - continuable error, the call to Fsignal() gets put inside a - `while (1)' loop. To facilitate this, and also for proper I18N3 - message snarfing, most calls to Fsignal() have been replaced by - calls to signal_error(), signal_simple_error(), etc. Look at - eval.c for a classification of various error functions. - - -- Constant strings occurring in source files need to get wrapped - in a call to GETTEXT (or if inside of a call to `build_string', - change that function to `build_translated_string') if they don't - occur in certain places where the I18N3 message snarfer will see - them. For a complete discussion of this, see the file - lib-src/make-msgfile.lex. - - NOTE: I18N3 support is not currently working, so the above may - or may not apply. Thus it is not a good idea to add random - GETTEXTs, unless you really know what you are doing. - - -- Calls to `fprintf (stderr, ...)' and `printf (...)' get replaced - with calls to `stderr_out' and `stdout_out'. This is for I18N3 - message snarfing. - -4. Initialization: - - -- FSF constructs like `obj = intern ("string"); staticpro (&obj);' - get replaced by `defsymbol (&obj);'. This is for code cleanness - and better purespace usage. - -- FSF constructs like - obj = intern ("error"); - Fput (obj, Qerror_message, "message"); - Fput (obj, Qerror_conditions, some list); - get replaced by calls to deferror(). See the definition of - deferror() for how the correct arguments to pass. This is for - code cleanness and I18N3 message snarfing. - -- Code in keys_of_foo() functions has been moved into Lisp. diff --git a/src/abbrev.c b/src/abbrev.c deleted file mode 100644 index 2add8a9..0000000 --- a/src/abbrev.c +++ /dev/null @@ -1,463 +0,0 @@ -/* Primitives for word-abbrev mode. - Copyright (C) 1985, 1986, 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: FSF 19.30. Note that there are many more functions in - FSF's abbrev.c. These have been moved into Lisp in XEmacs. */ - -/* Authorship: - - FSF: Original version; a long time ago. - JWZ or Mly: Mostly moved into Lisp; maybe 1992. - Ben Wing: Some changes for Mule for 19.12. - Hrvoje Niksic: Largely rewritten in June 1997. -*/ - -/* This file has been Mule-ized. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "commands.h" -#include "insdel.h" -#include "syntax.h" -#include "window.h" - -/* An abbrev table is an obarray. - Each defined abbrev is represented by a symbol in that obarray - whose print name is the abbreviation. - The symbol's value is a string which is the expansion. - If its function definition is non-nil, it is called - after the expansion is done. - The plist slot of the abbrev symbol is its usage count. */ - -/* The table of global abbrevs. These are in effect - in any buffer in which abbrev mode is turned on. */ -Lisp_Object Vglobal_abbrev_table; - -int abbrev_all_caps; - -/* Non-nil => use this location as the start of abbrev to expand - (rather than taking the word before point as the abbrev) */ -Lisp_Object Vabbrev_start_location; - -/* Buffer that Vabbrev_start_location applies to */ -Lisp_Object Vabbrev_start_location_buffer; - -/* The symbol representing the abbrev most recently expanded */ -Lisp_Object Vlast_abbrev; - -/* A string for the actual text of the abbrev most recently expanded. - This has more info than Vlast_abbrev since case is significant. */ -Lisp_Object Vlast_abbrev_text; - -/* Character address of start of last abbrev expanded */ -int last_abbrev_location; - -/* Hook to run before expanding any abbrev. */ -Lisp_Object Vpre_abbrev_expand_hook, Qpre_abbrev_expand_hook; - - -struct abbrev_match_mapper_closure { - struct buffer *buf; - struct Lisp_Char_Table *chartab; - Charcount point, maxlen; - struct Lisp_Symbol *found; -}; - -/* For use by abbrev_match(): Match SYMBOL's name against buffer text - before point, case-insensitively. When found, return non-zero, so - that map_obarray terminates mapping. */ -static int -abbrev_match_mapper (Lisp_Object symbol, void *arg) -{ - struct abbrev_match_mapper_closure *closure = - (struct abbrev_match_mapper_closure *)arg; - Charcount abbrev_length; - struct Lisp_Symbol *sym = XSYMBOL (symbol); - struct Lisp_String *abbrev; - - /* symbol_value should be OK here, because abbrevs are not expected - to contain any SYMBOL_MAGIC stuff. */ - if (UNBOUNDP (symbol_value (sym)) || NILP (symbol_value (sym))) - { - /* The symbol value of nil means that abbrev got undefined. */ - return 0; - } - abbrev = symbol_name (sym); - abbrev_length = string_char_length (abbrev); - if (abbrev_length > closure->maxlen) - { - /* This abbrev is too large -- it wouldn't fit. */ - return 0; - } - /* If `bar' is an abbrev, and a user presses `fubar', we don't - normally want to expand it. OTOH, if the abbrev begins with - non-word syntax (e.g. `#if'), it is OK to abbreviate it anywhere. */ - if (abbrev_length < closure->maxlen && abbrev_length > 0 - && (WORD_SYNTAX_P (closure->chartab, string_char (abbrev, 0))) - && (WORD_SYNTAX_P (closure->chartab, - BUF_FETCH_CHAR (closure->buf, - closure->point - (abbrev_length + 1))))) - { - return 0; - } - /* Match abbreviation string against buffer text. */ - { - Bufbyte *ptr = string_data (abbrev); - Charcount idx; - - for (idx = 0; idx < abbrev_length; idx++) - { - if (DOWNCASE (closure->buf, - BUF_FETCH_CHAR (closure->buf, - closure->point - abbrev_length + idx)) - != DOWNCASE (closure->buf, charptr_emchar (ptr))) - { - break; - } - INC_CHARPTR (ptr); - } - if (idx == abbrev_length) - { - /* This is the one. */ - closure->found = sym; - return 1; - } - } - return 0; -} - -/* Match the buffer text against names of symbols in obarray. Returns - the matching symbol, or 0 if not found. */ -static struct Lisp_Symbol * -abbrev_match (struct buffer *buf, Lisp_Object obarray) -{ - struct abbrev_match_mapper_closure closure; - - /* Precalculate some stuff, so mapper function needn't to it in each - iteration. */ - closure.buf = buf; - closure.point = BUF_PT (buf); - closure.maxlen = closure.point - BUF_BEGV (buf); - closure.chartab = XCHAR_TABLE (buf->mirror_syntax_table); - closure.found = 0; - - map_obarray (obarray, abbrev_match_mapper, &closure); - - return closure.found; -} - -/* Take the word before point (or Vabbrev_start_location, if non-nil), - and look it up in OBARRAY, and return the symbol (or zero). This - used to be the default method of searching, with the obvious - limitation that the abbrevs may consist only of word characters. - It is an order of magnitude faster than the proper abbrev_match(), - but then again, vi is an order of magnitude faster than Emacs. - - This speed difference should be unnoticeable, though. I have tested - the degenerated cases of thousands of abbrevs being defined, and - abbrev_match() was still fast enough for normal operation. */ -static struct Lisp_Symbol * -abbrev_oblookup (struct buffer *buf, Lisp_Object obarray) -{ - Bufpos wordstart, wordend; - Bufbyte *word, *p; - Bytecount idx; - Lisp_Object lookup; - - CHECK_VECTOR (obarray); - - if (!NILP (Vabbrev_start_location)) - { - wordstart = get_buffer_pos_char (buf, Vabbrev_start_location, - GB_COERCE_RANGE); - Vabbrev_start_location = Qnil; -#if 0 - /* Previously, abbrev-prefix-mark crockishly inserted a dash to - indicate the abbrev start point. It now uses an extent with - a begin glyph so there's no dash to remove. */ - if (wordstart != BUF_ZV (buf) - && BUF_FETCH_CHAR (buf, wordstart) == '-') - { - buffer_delete_range (buf, wordstart, wordstart + 1, 0); - } -#endif - wordend = BUF_PT (buf); - } - else - { - Bufpos point = BUF_PT (buf); - - wordstart = scan_words (buf, point, -1); - if (!wordstart) - return 0; - - wordend = scan_words (buf, wordstart, 1); - if (!wordend) - return 0; - if (wordend > BUF_ZV (buf)) - wordend = BUF_ZV (buf); - if (wordend > point) - wordend = point; - /* Unlike the original function, we allow expansion only after - the abbrev, not preceded by a number of spaces. This is - because of consistency with abbrev_match. */ - if (wordend < point) - return 0; - if (wordend <= wordstart) - return 0; - } - - p = word = (Bufbyte *) alloca (MAX_EMCHAR_LEN * (wordend - wordstart)); - for (idx = wordstart; idx < wordend; idx++) - { - Emchar c = BUF_FETCH_CHAR (buf, idx); - if (UPPERCASEP (buf, c)) - c = DOWNCASE (buf, c); - p += set_charptr_emchar (p, c); - } - lookup = oblookup (obarray, word, p - word); - if (SYMBOLP (lookup) && !NILP (symbol_value (XSYMBOL (lookup)))) - return XSYMBOL (lookup); - else - return NULL; -} - -/* Return non-zero if OBARRAY contains an interned symbol ` '. */ -static int -obarray_has_blank_p (Lisp_Object obarray) -{ - return !ZEROP (oblookup (obarray, (Bufbyte *)" ", 1)); -} - -/* Analyze case in the buffer substring, and report it. */ -static void -abbrev_count_case (struct buffer *buf, Bufpos pos, Charcount length, - int *lccount, int *uccount) -{ - *lccount = *uccount = 0; - while (length--) - { - Emchar c = BUF_FETCH_CHAR (buf, pos); - if (UPPERCASEP (buf, c)) - ++*uccount; - else if (LOWERCASEP (buf, c)) - ++*lccount; - ++pos; - } -} - -DEFUN ("expand-abbrev", Fexpand_abbrev, 0, 0, "", /* -Expand the abbrev before point, if any. -Effective when explicitly called even when `abbrev-mode' is nil. -Returns the abbrev symbol, if expansion took place. -If no abbrev matched, but `pre-abbrev-expand-hook' changed the buffer, - returns t. -*/ - ()) -{ - /* This function can GC */ - struct buffer *buf = current_buffer; - int oldmodiff = BUF_MODIFF (buf); - Lisp_Object pre_modiff_p; - Bufpos point; /* position of point */ - Bufpos abbrev_start; /* position of abbreviation beginning */ - - struct Lisp_Symbol *(*fun) (struct buffer *, Lisp_Object); - - struct Lisp_Symbol *abbrev_symbol; - struct Lisp_String *abbrev_string; - Lisp_Object expansion, count, hook; - Charcount abbrev_length; - int lccount, uccount; - - run_hook (Qpre_abbrev_expand_hook); - /* If the hook changes the buffer, treat that as having "done an - expansion". */ - pre_modiff_p = (BUF_MODIFF (buf) != oldmodiff ? Qt : Qnil); - - abbrev_symbol = NULL; - if (!BUFFERP (Vabbrev_start_location_buffer) || - XBUFFER (Vabbrev_start_location_buffer) != buf) - Vabbrev_start_location = Qnil; - /* We use the more general abbrev_match() if the obarray blank flag - is not set, and Vabbrev_start_location is nil. Otherwise, use - abbrev_oblookup(). */ -#define MATCHFUN(tbl) ((obarray_has_blank_p (tbl) \ - && NILP (Vabbrev_start_location)) \ - ? abbrev_match : abbrev_oblookup) - if (!NILP (buf->abbrev_table)) - { - fun = MATCHFUN (buf->abbrev_table); - abbrev_symbol = fun (buf, buf->abbrev_table); - } - if (!abbrev_symbol && !NILP (Vglobal_abbrev_table)) - { - fun = MATCHFUN (Vglobal_abbrev_table); - abbrev_symbol = fun (buf, Vglobal_abbrev_table); - } - if (!abbrev_symbol) - return pre_modiff_p; - - /* NOTE: we hope that `pre-abbrev-expand-hook' didn't do something - nasty, such as changed the buffer. Here we protect against the - buffer getting killed. */ - if (! BUFFER_LIVE_P (buf)) - return Qnil; - point = BUF_PT (buf); - - /* OK, we're out of the must-be-fast part. An abbreviation matched. - Now find the parameters, insert the expansion, and make it all - look pretty. */ - abbrev_string = symbol_name (abbrev_symbol); - abbrev_length = string_char_length (abbrev_string); - abbrev_start = point - abbrev_length; - - expansion = symbol_value (abbrev_symbol); - CHECK_STRING (expansion); - - count = symbol_plist (abbrev_symbol); /* Gag */ - if (NILP (count)) - count = Qzero; - else - CHECK_NATNUM (count); - symbol_plist (abbrev_symbol) = make_int (1 + XINT (count)); - - /* Count the case in the original text. */ - abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount); - - /* Remember the last abbrev text, location, etc. */ - XSETSYMBOL (Vlast_abbrev, abbrev_symbol); - Vlast_abbrev_text = - make_string_from_buffer (buf, abbrev_start, abbrev_length); - last_abbrev_location = abbrev_start; - - /* Add an undo boundary, in case we are doing this for a - self-inserting command which has avoided making one so far. */ - if (INTERACTIVE) - Fundo_boundary (); - - /* Remove the abbrev */ - buffer_delete_range (buf, abbrev_start, point, 0); - /* And insert the expansion. */ - buffer_insert_lisp_string (buf, expansion); - point = BUF_PT (buf); - - /* Now fiddle with the case. */ - if (uccount && !lccount) - { - /* Abbrev was all caps */ - if (!abbrev_all_caps - && scan_words (buf, point, -1) > scan_words (buf, abbrev_start, 1)) - { - Fupcase_initials_region (make_int (abbrev_start), make_int (point), - make_buffer (buf)); - } - else - { - /* If expansion is one word, or if user says so, upcase it all. */ - Fupcase_region (make_int (abbrev_start), make_int (point), - make_buffer (buf)); - } - } - else if (uccount) - { - /* Abbrev included some caps. Cap first initial of expansion */ - Bufpos pos = abbrev_start; - /* Find the initial. */ - while (pos < point - && !WORD_SYNTAX_P (XCHAR_TABLE (buf->mirror_syntax_table), - BUF_FETCH_CHAR (buf, pos))) - pos++; - /* Change just that. */ - Fupcase_initials_region (make_int (pos), make_int (pos + 1), - make_buffer (buf)); - } - - hook = symbol_function (abbrev_symbol); - if (!NILP (hook) && !UNBOUNDP (hook)) - call0 (hook); - - return Vlast_abbrev; -} - - -void -syms_of_abbrev (void) -{ - defsymbol (&Qpre_abbrev_expand_hook, "pre-abbrev-expand-hook"); - DEFSUBR (Fexpand_abbrev); -} - -void -vars_of_abbrev (void) -{ - DEFVAR_LISP ("global-abbrev-table", &Vglobal_abbrev_table /* -The abbrev table whose abbrevs affect all buffers. -Each buffer may also have a local abbrev table. -If it does, the local table overrides the global one -for any particular abbrev defined in both. -*/ ); - Vglobal_abbrev_table = Qnil; /* setup by Lisp code */ - - DEFVAR_LISP ("last-abbrev", &Vlast_abbrev /* -The abbrev-symbol of the last abbrev expanded. -See the function `abbrev-symbol'. -*/ ); - - DEFVAR_LISP ("last-abbrev-text", &Vlast_abbrev_text /* -The exact text of the last abbrev expanded. -nil if the abbrev has already been unexpanded. -*/ ); - - DEFVAR_INT ("last-abbrev-location", &last_abbrev_location /* -The location of the start of the last abbrev expanded. -*/ ); - - Vlast_abbrev = Qnil; - Vlast_abbrev_text = Qnil; - last_abbrev_location = 0; - - DEFVAR_LISP ("abbrev-start-location", &Vabbrev_start_location /* -Buffer position for `expand-abbrev' to use as the start of the abbrev. -nil means use the word before point as the abbrev. -Calling `expand-abbrev' sets this to nil. -*/ ); - Vabbrev_start_location = Qnil; - - DEFVAR_LISP ("abbrev-start-location-buffer", &Vabbrev_start_location_buffer /* -Buffer that `abbrev-start-location' has been set for. -Trying to expand an abbrev in any other buffer clears `abbrev-start-location'. -*/ ); - Vabbrev_start_location_buffer = Qnil; - - DEFVAR_BOOL ("abbrev-all-caps", &abbrev_all_caps /* -*Non-nil means expand multi-word abbrevs all caps if abbrev was so. -*/ ); - abbrev_all_caps = 0; - - DEFVAR_LISP ("pre-abbrev-expand-hook", &Vpre_abbrev_expand_hook /* -Function or functions to be called before abbrev expansion is done. -This is the first thing that `expand-abbrev' does, and so this may change -the current abbrev table before abbrev lookup happens. -*/ ); - Vpre_abbrev_expand_hook = Qnil; -} diff --git a/src/alloc.c b/src/alloc.c deleted file mode 100644 index b53f506..0000000 --- a/src/alloc.c +++ /dev/null @@ -1,5088 +0,0 @@ -/* Storage allocation and gc for XEmacs Lisp interpreter. - Copyright (C) 1985-1998 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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.28, Mule 2.0. Substantially different from - FSF. */ - -/* Authorship: - - FSF: Original version; a long time ago. - Mly: Significantly rewritten to use new 3-bit tags and - nicely abstracted object definitions, for 19.8. - JWZ: Improved code to keep track of purespace usage and - issue nice purespace and GC stats. - Ben Wing: Cleaned up frob-block lrecord code, added error-checking - and various changes for Mule, for 19.12. - Added bit vectors for 19.13. - Added lcrecord lists for 19.14. - slb: Lots of work on the purification and dump time code. - Synched Doug Lea malloc support from Emacs 20.2. -*/ - -#include -#include "lisp.h" - -#include "backtrace.h" -#include "buffer.h" -#include "bytecode.h" -#include "chartab.h" -#include "device.h" -#include "elhash.h" -#include "events.h" -#include "extents.h" -#include "frame.h" -#include "glyphs.h" -#include "opaque.h" -#include "redisplay.h" -#include "specifier.h" -#include "sysfile.h" -#include "window.h" - -#include - -#ifdef DOUG_LEA_MALLOC -#include -#endif - -EXFUN (Fgarbage_collect, 0); - -/* Return the true size of a struct with a variable-length array field. */ -#define STRETCHY_STRUCT_SIZEOF(stretchy_struct_type, \ - stretchy_array_field, \ - stretchy_array_length) \ - (offsetof (stretchy_struct_type, stretchy_array_field) + \ - (offsetof (stretchy_struct_type, stretchy_array_field[1]) - \ - offsetof (stretchy_struct_type, stretchy_array_field[0])) * \ - (stretchy_array_length)) - -#if 0 /* this is _way_ too slow to be part of the standard debug options */ -#if defined(DEBUG_XEMACS) && defined(MULE) -#define VERIFY_STRING_CHARS_INTEGRITY -#endif -#endif - -/* Define this to see where all that space is going... */ -/* But the length of the printout is obnoxious, so limit it to testers */ -#ifdef MEMORY_USAGE_STATS -#define PURESTAT -#endif - -/* Define this to use malloc/free with no freelist for all datatypes, - the hope being that some debugging tools may help detect - freed memory references */ -#ifdef USE_DEBUG_MALLOC /* Taking the above comment at face value -slb */ -#include -#define ALLOC_NO_POOLS -#endif - -#include "puresize.h" - -#ifdef DEBUG_XEMACS -static int debug_allocation; -static int debug_allocation_backtrace_length; -#endif - -/* Number of bytes of consing done since the last gc */ -EMACS_INT consing_since_gc; -#define INCREMENT_CONS_COUNTER_1(size) (consing_since_gc += (size)) - -#define debug_allocation_backtrace() \ -do { \ - if (debug_allocation_backtrace_length > 0) \ - debug_short_backtrace (debug_allocation_backtrace_length); \ -} while (0) - -#ifdef DEBUG_XEMACS -#define INCREMENT_CONS_COUNTER(foosize, type) \ - do { \ - if (debug_allocation) \ - { \ - stderr_out ("allocating %s (size %ld)\n", type, (long)foosize); \ - debug_allocation_backtrace (); \ - } \ - INCREMENT_CONS_COUNTER_1 (foosize); \ - } while (0) -#define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type) \ - do { \ - if (debug_allocation > 1) \ - { \ - stderr_out ("allocating noseeum %s (size %ld)\n", type, (long)foosize); \ - debug_allocation_backtrace (); \ - } \ - INCREMENT_CONS_COUNTER_1 (foosize); \ - } while (0) -#else -#define INCREMENT_CONS_COUNTER(size, type) INCREMENT_CONS_COUNTER_1 (size) -#define NOSEEUM_INCREMENT_CONS_COUNTER(size, type) \ - INCREMENT_CONS_COUNTER_1 (size) -#endif - -#define DECREMENT_CONS_COUNTER(size) do { \ - consing_since_gc -= (size); \ - if (consing_since_gc < 0) \ - consing_since_gc = 0; \ -} while (0) - -/* Number of bytes of consing since gc before another gc should be done. */ -EMACS_INT gc_cons_threshold; - -/* Nonzero during gc */ -int gc_in_progress; - -/* Number of times GC has happened at this level or below. - * Level 0 is most volatile, contrary to usual convention. - * (Of course, there's only one level at present) */ -EMACS_INT gc_generation_number[1]; - -/* This is just for use by the printer, to allow things to print uniquely */ -static int lrecord_uid_counter; - -/* Nonzero when calling certain hooks or doing other things where - a GC would be bad */ -int gc_currently_forbidden; - -/* Hooks. */ -Lisp_Object Vpre_gc_hook, Qpre_gc_hook; -Lisp_Object Vpost_gc_hook, Qpost_gc_hook; - -/* "Garbage collecting" */ -Lisp_Object Vgc_message; -Lisp_Object Vgc_pointer_glyph; -static CONST char gc_default_message[] = "Garbage collecting"; -Lisp_Object Qgarbage_collecting; - -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ - EMACS_INT malloc_sbrk_used; - -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ - EMACS_INT malloc_sbrk_unused; - -/* Non-zero means defun should do purecopy on the function definition */ -int purify_flag; - -#ifdef HEAP_IN_DATA -extern void sheap_adjust_h(); -#endif - -/* Force linker to put it into data space! */ -EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = { (EMACS_INT) 0}; - -#define PUREBEG ((char *) pure) - -#if 0 /* This is breathing_space in XEmacs */ -/* Points to memory space allocated as "spare", - to be freed if we run out of memory. */ -static char *spare_memory; - -/* Amount of spare memory to keep in reserve. */ -#define SPARE_MEMORY (1 << 14) -#endif - -/* Index in pure at which next pure object will be allocated. */ -static size_t pure_bytes_used; - -#define PURIFIED(ptr) \ -((char *) (ptr) >= PUREBEG && \ - (char *) (ptr) < PUREBEG + get_PURESIZE()) - -/* Non-zero if pure_bytes_used > get_PURESIZE(); - accounts for excess purespace needs. */ -static size_t pure_lossage; - -#ifdef ERROR_CHECK_TYPECHECK - -Error_behavior ERROR_ME, ERROR_ME_NOT, ERROR_ME_WARN; - -#endif - -int -purified (Lisp_Object obj) -{ - return POINTER_TYPE_P (XGCTYPE (obj)) && PURIFIED (XPNTR (obj)); -} - -size_t -purespace_usage (void) -{ - return pure_bytes_used; -} - -static int -check_purespace (size_t size) -{ - if (pure_lossage) - { - pure_lossage += size; - return 0; - } - else if (pure_bytes_used + size > get_PURESIZE()) - { - /* This can cause recursive bad behavior, we'll yell at the end */ - /* when we're done. */ - /* message ("\nERROR: Pure Lisp storage exhausted!\n"); */ - pure_lossage = size; - return 0; - } - else - return 1; -} - - - -#ifndef PURESTAT - -#define bump_purestat(p,b) DO_NOTHING - -#else /* PURESTAT */ - -static int purecopying_function_constants; - -static size_t pure_sizeof (Lisp_Object); - -/* Keep statistics on how much of what is in purespace */ -static struct purestat -{ - int nobjects; - int nbytes; - CONST char *name; -} - purestat_cons = {0, 0, "cons cells"}, - purestat_float = {0, 0, "float objects"}, - purestat_string_pname = {0, 0, "symbol-name strings"}, - purestat_function = {0, 0, "compiled-function objects"}, - purestat_opaque_instructions = {0, 0, "compiled-function instructions"}, - purestat_vector_constants = {0, 0, "compiled-function constants vectors"}, - purestat_string_interactive = {0, 0, "interactive strings"}, -#ifdef I18N3 - purestat_string_domain = {0, 0, "domain strings"}, -#endif - purestat_string_documentation = {0, 0, "documentation strings"}, - purestat_string_other_function = {0, 0, "other function strings"}, - purestat_vector_other = {0, 0, "other vectors"}, - purestat_string_other = {0, 0, "other strings"}, - purestat_string_all = {0, 0, "all strings"}, - purestat_vector_all = {0, 0, "all vectors"}; - -static void -bump_purestat (struct purestat *purestat, size_t nbytes) -{ - if (pure_lossage) return; - purestat->nobjects += 1; - purestat->nbytes += nbytes; -} - -static void -print_purestat (struct purestat *purestat) -{ - char buf [100]; - sprintf(buf, "%s:", purestat->name); - message (" %-36s %5d %7d %2d%%", - buf, - purestat->nobjects, - purestat->nbytes, - (int) (purestat->nbytes / (pure_bytes_used / 100.0) + 0.5)); -} -#endif /* PURESTAT */ - - -/* Maximum amount of C stack to save when a GC happens. */ - -#ifndef MAX_SAVE_STACK -#define MAX_SAVE_STACK 0 /* 16000 */ -#endif - -/* Non-zero means ignore malloc warnings. Set during initialization. */ -int ignore_malloc_warnings; - - -static void *breathing_space; - -void -release_breathing_space (void) -{ - if (breathing_space) - { - void *tmp = breathing_space; - breathing_space = 0; - xfree (tmp); - } -} - -/* malloc calls this if it finds we are near exhausting storage */ -void -malloc_warning (CONST char *str) -{ - if (ignore_malloc_warnings) - return; - - warn_when_safe - (Qmemory, Qcritical, - "%s\n" - "Killing some buffers may delay running out of memory.\n" - "However, certainly by the time you receive the 95%% warning,\n" - "you should clean up, kill this Emacs, and start a new one.", - str); -} - -/* Called if malloc returns zero */ -DOESNT_RETURN -memory_full (void) -{ - /* Force a GC next time eval is called. - It's better to loop garbage-collecting (we might reclaim enough - to win) than to loop beeping and barfing "Memory exhausted" - */ - consing_since_gc = gc_cons_threshold + 1; - release_breathing_space (); - - /* Flush some histories which might conceivably contain garbalogical - inhibitors. */ - if (!NILP (Fboundp (Qvalues))) - Fset (Qvalues, Qnil); - Vcommand_history = Qnil; - - error ("Memory exhausted"); -} - -/* like malloc and realloc but check for no memory left, and block input. */ - -#ifdef xmalloc -#undef xmalloc -#endif - -void * -xmalloc (size_t size) -{ - void *val = malloc (size); - - if (!val && (size != 0)) memory_full (); - return val; -} - -#ifdef xcalloc -#undef xcalloc -#endif - -static void * -xcalloc (size_t nelem, size_t elsize) -{ - void *val = calloc (nelem, elsize); - - if (!val && (nelem != 0)) memory_full (); - return val; -} - -void * -xmalloc_and_zero (size_t size) -{ - return xcalloc (size, sizeof (char)); -} - -#ifdef xrealloc -#undef xrealloc -#endif - -void * -xrealloc (void *block, size_t size) -{ - /* We must call malloc explicitly when BLOCK is 0, since some - reallocs don't do this. */ - void *val = block ? realloc (block, size) : malloc (size); - - if (!val && (size != 0)) memory_full (); - return val; -} - -void -#ifdef ERROR_CHECK_MALLOC -xfree_1 (void *block) -#else -xfree (void *block) -#endif -{ -#ifdef ERROR_CHECK_MALLOC - /* Unbelievably, calling free() on 0xDEADBEEF doesn't cause an - error until much later on for many system mallocs, such as - the one that comes with Solaris 2.3. FMH!! */ - assert (block != (void *) 0xDEADBEEF); - assert (block); -#endif /* ERROR_CHECK_MALLOC */ - free (block); -} - -#ifdef ERROR_CHECK_GC - -#if SIZEOF_INT == 4 -typedef unsigned int four_byte_t; -#elif SIZEOF_LONG == 4 -typedef unsigned long four_byte_t; -#elif SIZEOF_SHORT == 4 -typedef unsigned short four_byte_t; -#else -What kind of strange-ass system are we running on? -#endif - -static void -deadbeef_memory (void *ptr, size_t size) -{ - four_byte_t *ptr4 = (four_byte_t *) ptr; - size_t beefs = size >> 2; - - /* In practice, size will always be a multiple of four. */ - while (beefs--) - (*ptr4++) = 0xDEADBEEF; -} - -#else /* !ERROR_CHECK_GC */ - - -#define deadbeef_memory(ptr, size) - -#endif /* !ERROR_CHECK_GC */ - -#ifdef xstrdup -#undef xstrdup -#endif - -char * -xstrdup (CONST char *str) -{ - int len = strlen (str) + 1; /* for stupid terminating 0 */ - - void *val = xmalloc (len); - if (val == 0) return 0; - memcpy (val, str, len); - return (char *) val; -} - -#ifdef NEED_STRDUP -char * -strdup (CONST char *s) -{ - return xstrdup (s); -} -#endif /* NEED_STRDUP */ - - -static void * -allocate_lisp_storage (size_t size) -{ - void *p = xmalloc (size); -#ifndef USE_MINIMAL_TAGBITS - char *lim = ((char *) p) + size; - Lisp_Object val; - - XSETOBJ (val, Lisp_Type_Record, lim); - if ((char *) XPNTR (val) != lim) - { - xfree (p); - memory_full (); - } -#endif /* ! USE_MINIMAL_TAGBITS */ - return p; -} - - -/* lrecords are chained together through their "next.v" field. - * After doing the mark phase, the GC will walk this linked - * list and free any record which hasn't been marked. - */ -static struct lcrecord_header *all_lcrecords; - -void * -alloc_lcrecord (size_t size, CONST struct lrecord_implementation *implementation) -{ - struct lcrecord_header *lcheader; - -#ifdef ERROR_CHECK_GC - if (implementation->static_size == 0) - assert (implementation->size_in_bytes_method); - else - assert (implementation->static_size == size); -#endif - - lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); - set_lheader_implementation (&(lcheader->lheader), implementation); - lcheader->next = all_lcrecords; -#if 1 /* mly prefers to see small ID numbers */ - lcheader->uid = lrecord_uid_counter++; -#else /* jwz prefers to see real addrs */ - lcheader->uid = (int) &lcheader; -#endif - lcheader->free = 0; - all_lcrecords = lcheader; - INCREMENT_CONS_COUNTER (size, implementation->name); - return lcheader; -} - -#if 0 /* Presently unused */ -/* Very, very poor man's EGC? - * This may be slow and thrash pages all over the place. - * Only call it if you really feel you must (and if the - * lrecord was fairly recently allocated). - * Otherwise, just let the GC do its job -- that's what it's there for - */ -void -free_lcrecord (struct lcrecord_header *lcrecord) -{ - if (all_lcrecords == lcrecord) - { - all_lcrecords = lcrecord->next; - } - else - { - struct lrecord_header *header = all_lcrecords; - for (;;) - { - struct lrecord_header *next = header->next; - if (next == lcrecord) - { - header->next = lrecord->next; - break; - } - else if (next == 0) - abort (); - else - header = next; - } - } - if (lrecord->implementation->finalizer) - lrecord->implementation->finalizer (lrecord, 0); - xfree (lrecord); - return; -} -#endif /* Unused */ - - -static void -disksave_object_finalization_1 (void) -{ - struct lcrecord_header *header; - - for (header = all_lcrecords; header; header = header->next) - { - if (LHEADER_IMPLEMENTATION(&header->lheader)->finalizer && - !header->free) - ((LHEADER_IMPLEMENTATION(&header->lheader)->finalizer) - (header, 1)); - } -} - - -/* This must not be called -- it just serves as for EQ test - * If lheader->implementation->finalizer is this_marks_a_marked_record, - * then lrecord has been marked by the GC sweeper - * header->implementation is put back to its correct value by - * sweep_records */ -void -this_marks_a_marked_record (void *dummy0, int dummy1) -{ - abort (); -} - -/* Semi-kludge -- lrecord_symbol_value_forward objects get stuck - in CONST space and you get SEGV's if you attempt to mark them. - This sits in lheader->implementation->marker. */ - -Lisp_Object -this_one_is_unmarkable (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - abort (); - return Qnil; -} - -/* XGCTYPE for records */ -int -gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type) -{ - CONST struct lrecord_implementation *imp; - - if (XGCTYPE (frob) != Lisp_Type_Record) - return 0; - - imp = XRECORD_LHEADER_IMPLEMENTATION (frob); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - return imp == type; -#else - return imp == type || imp == type + 1; -#endif -} - - -/************************************************************************/ -/* Debugger support */ -/************************************************************************/ -/* Give gdb/dbx enough information to decode Lisp Objects. - We make sure certain symbols are defined, so gdb doesn't complain - about expressions in src/gdbinit. Values are randomly chosen. - See src/gdbinit or src/dbxrc to see how this is used. */ - -enum dbg_constants -{ -#ifdef USE_MINIMAL_TAGBITS - dbg_valmask = (EMACS_INT) (((1UL << VALBITS) - 1) << GCBITS), - dbg_typemask = (EMACS_INT) ((1UL << GCTYPEBITS) - 1), - dbg_USE_MINIMAL_TAGBITS = 1, - dbg_Lisp_Type_Int = 100, -#else /* ! USE_MIMIMAL_TAGBITS */ - dbg_valmask = (EMACS_INT) ((1UL << VALBITS) - 1), - dbg_typemask = (EMACS_INT) (((1UL << GCTYPEBITS) - 1) << (VALBITS + GCMARKBITS)), - dbg_USE_MINIMAL_TAGBITS = 0, - dbg_Lisp_Type_Int = Lisp_Type_Int, -#endif /* ! USE_MIMIMAL_TAGBITS */ - -#ifdef USE_UNION_TYPE - dbg_USE_UNION_TYPE = 1, -#else - dbg_USE_UNION_TYPE = 0, -#endif - -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 1, -#else - dbg_USE_INDEXED_LRECORD_IMPLEMENTATION = 0, -#endif - - dbg_Lisp_Type_Char = Lisp_Type_Char, - dbg_Lisp_Type_Record = Lisp_Type_Record, -#ifdef LRECORD_CONS - dbg_Lisp_Type_Cons = 101, -#else - dbg_Lisp_Type_Cons = Lisp_Type_Cons, - lrecord_cons = 201, -#endif -#ifdef LRECORD_STRING - dbg_Lisp_Type_String = 102, -#else - dbg_Lisp_Type_String = Lisp_Type_String, - lrecord_string = 202, -#endif -#ifdef LRECORD_VECTOR - dbg_Lisp_Type_Vector = 103, -#else - dbg_Lisp_Type_Vector = Lisp_Type_Vector, - lrecord_vector = 203, -#endif -#ifdef LRECORD_SYMBOL - dbg_Lisp_Type_Symbol = 104, -#else - dbg_Lisp_Type_Symbol = Lisp_Type_Symbol, - lrecord_symbol = 204, -#endif -#ifndef MULE - lrecord_char_table_entry = 205, - lrecord_charset = 206, - lrecord_coding_system = 207, -#endif -#ifndef HAVE_TOOLBARS - lrecord_toolbar_button = 208, -#endif -#ifndef HAVE_TOOLTALK - lrecord_tooltalk_message = 210, - lrecord_tooltalk_pattern = 211, -#endif -#ifndef HAVE_DATABASE - lrecord_database = 212, -#endif - dbg_valbits = VALBITS, - dbg_gctypebits = GCTYPEBITS - /* If we don't have an actual object of this enum, pgcc (and perhaps - other compilers) might optimize away the entire type declaration :-( */ -} dbg_dummy; - -/* A few macros turned into functions for ease of debugging. - Debuggers don't know about macros! */ -int dbg_eq (Lisp_Object obj1, Lisp_Object obj2); -int -dbg_eq (Lisp_Object obj1, Lisp_Object obj2) -{ - return EQ (obj1, obj2); -} - - -/************************************************************************/ -/* Fixed-size type macros */ -/************************************************************************/ - -/* For fixed-size types that are commonly used, we malloc() large blocks - of memory at a time and subdivide them into chunks of the correct - size for an object of that type. This is more efficient than - malloc()ing each object separately because we save on malloc() time - and overhead due to the fewer number of malloc()ed blocks, and - also because we don't need any extra pointers within each object - to keep them threaded together for GC purposes. For less common - (and frequently large-size) types, we use lcrecords, which are - malloc()ed individually and chained together through a pointer - in the lcrecord header. lcrecords do not need to be fixed-size - (i.e. two objects of the same type need not have the same size; - however, the size of a particular object cannot vary dynamically). - It is also much easier to create a new lcrecord type because no - additional code needs to be added to alloc.c. Finally, lcrecords - may be more efficient when there are only a small number of them. - - The types that are stored in these large blocks (or "frob blocks") - are cons, float, compiled-function, symbol, marker, extent, event, - and string. - - Note that strings are special in that they are actually stored in - two parts: a structure containing information about the string, and - the actual data associated with the string. The former structure - (a struct Lisp_String) is a fixed-size structure and is managed the - same way as all the other such types. This structure contains a - pointer to the actual string data, which is stored in structures of - type struct string_chars_block. Each string_chars_block consists - of a pointer to a struct Lisp_String, followed by the data for that - string, followed by another pointer to a struct Lisp_String, - followed by the data for that string, etc. At GC time, the data in - these blocks is compacted by searching sequentially through all the - blocks and compressing out any holes created by unmarked strings. - Strings that are more than a certain size (bigger than the size of - a string_chars_block, although something like half as big might - make more sense) are malloc()ed separately and not stored in - string_chars_blocks. Furthermore, no one string stretches across - two string_chars_blocks. - - Vectors are each malloc()ed separately, similar to lcrecords. - - In the following discussion, we use conses, but it applies equally - well to the other fixed-size types. - - We store cons cells inside of cons_blocks, allocating a new - cons_block with malloc() whenever necessary. Cons cells reclaimed - by GC are put on a free list to be reallocated before allocating - any new cons cells from the latest cons_block. Each cons_block is - just under 2^n - MALLOC_OVERHEAD bytes long, since malloc (at least - the versions in malloc.c and gmalloc.c) really allocates in units - of powers of two and uses 4 bytes for its own overhead. - - What GC actually does is to search through all the cons_blocks, - from the most recently allocated to the oldest, and put all - cons cells that are not marked (whether or not they're already - free) on a cons_free_list. The cons_free_list is a stack, and - so the cons cells in the oldest-allocated cons_block end up - at the head of the stack and are the first to be reallocated. - If any cons_block is entirely free, it is freed with free() - and its cons cells removed from the cons_free_list. Because - the cons_free_list ends up basically in memory order, we have - a high locality of reference (assuming a reasonable turnover - of allocating and freeing) and have a reasonable probability - of entirely freeing up cons_blocks that have been more recently - allocated. This stage is called the "sweep stage" of GC, and - is executed after the "mark stage", which involves starting - from all places that are known to point to in-use Lisp objects - (e.g. the obarray, where are all symbols are stored; the - current catches and condition-cases; the backtrace list of - currently executing functions; the gcpro list; etc.) and - recursively marking all objects that are accessible. - - At the beginning of the sweep stage, the conses in the cons - blocks are in one of three states: in use and marked, in use - but not marked, and not in use (already freed). Any conses - that are marked have been marked in the mark stage just - executed, because as part of the sweep stage we unmark any - marked objects. The way we tell whether or not a cons cell - is in use is through the FREE_STRUCT_P macro. This basically - looks at the first 4 bytes (or however many bytes a pointer - fits in) to see if all the bits in those bytes are 1. The - resulting value (0xFFFFFFFF) is not a valid pointer and is - not a valid Lisp_Object. All current fixed-size types have - a pointer or Lisp_Object as their first element with the - exception of strings; they have a size value, which can - never be less than zero, and so 0xFFFFFFFF is invalid for - strings as well. Now assuming that a cons cell is in use, - the way we tell whether or not it is marked is to look at - the mark bit of its car (each Lisp_Object has one bit - reserved as a mark bit, in case it's needed). Note that - different types of objects use different fields to indicate - whether the object is marked, but the principle is the same. - - Conses on the free_cons_list are threaded through a pointer - stored in the bytes directly after the bytes that are set - to 0xFFFFFFFF (we cannot overwrite these because the cons - is still in a cons_block and needs to remain marked as - not in use for the next time that GC happens). This - implies that all fixed-size types must be at least big - enough to store two pointers, which is indeed the case - for all current fixed-size types. - - Some types of objects need additional "finalization" done - when an object is converted from in use to not in use; - this is the purpose of the ADDITIONAL_FREE_type macro. - For example, markers need to be removed from the chain - of markers that is kept in each buffer. This is because - markers in a buffer automatically disappear if the marker - is no longer referenced anywhere (the same does not - apply to extents, however). - - WARNING: Things are in an extremely bizarre state when - the ADDITIONAL_FREE_type macros are called, so beware! - - When ERROR_CHECK_GC is defined, we do things differently - so as to maximize our chances of catching places where - there is insufficient GCPROing. The thing we want to - avoid is having an object that we're using but didn't - GCPRO get freed by GC and then reallocated while we're - in the process of using it -- this will result in something - seemingly unrelated getting trashed, and is extremely - difficult to track down. If the object gets freed but - not reallocated, we can usually catch this because we - set all bytes of a freed object to 0xDEADBEEF. (The - first four bytes, however, are 0xFFFFFFFF, and the next - four are a pointer used to chain freed objects together; - we play some tricks with this pointer to make it more - bogus, so crashes are more likely to occur right away.) - - We want freed objects to stay free as long as possible, - so instead of doing what we do above, we maintain the - free objects in a first-in first-out queue. We also - don't recompute the free list each GC, unlike above; - this ensures that the queue ordering is preserved. - [This means that we are likely to have worse locality - of reference, and that we can never free a frob block - once it's allocated. (Even if we know that all cells - in it are free, there's no easy way to remove all those - cells from the free list because the objects on the - free list are unlikely to be in memory order.)] - Furthermore, we never take objects off the free list - unless there's a large number (usually 1000, but - varies depending on type) of them already on the list. - This way, we ensure that an object that gets freed will - remain free for the next 1000 (or whatever) times that - an object of that type is allocated. -*/ - -#ifndef MALLOC_OVERHEAD -#ifdef GNU_MALLOC -#define MALLOC_OVERHEAD 0 -#elif defined (rcheck) -#define MALLOC_OVERHEAD 20 -#else -#define MALLOC_OVERHEAD 8 -#endif -#endif /* MALLOC_OVERHEAD */ - -#if !defined(HAVE_MMAP) || defined(DOUG_LEA_MALLOC) -/* If we released our reserve (due to running out of memory), - and we have a fair amount free once again, - try to set aside another reserve in case we run out once more. - - This is called when a relocatable block is freed in ralloc.c. */ -void refill_memory_reserve (void); -void -refill_memory_reserve () -{ - if (breathing_space == 0) - breathing_space = (char *) malloc (4096 - MALLOC_OVERHEAD); -} -#endif - -#ifdef ALLOC_NO_POOLS -# define TYPE_ALLOC_SIZE(type, structtype) 1 -#else -# define TYPE_ALLOC_SIZE(type, structtype) \ - ((2048 - MALLOC_OVERHEAD - sizeof (struct type##_block *)) \ - / sizeof (structtype)) -#endif /* ALLOC_NO_POOLS */ - -#define DECLARE_FIXED_TYPE_ALLOC(type, structtype) \ - \ -struct type##_block \ -{ \ - struct type##_block *prev; \ - structtype block[TYPE_ALLOC_SIZE (type, structtype)]; \ -}; \ - \ -static struct type##_block *current_##type##_block; \ -static int current_##type##_block_index; \ - \ -static structtype *type##_free_list; \ -static structtype *type##_free_list_tail; \ - \ -static void \ -init_##type##_alloc (void) \ -{ \ - current_##type##_block = 0; \ - current_##type##_block_index = \ - countof (current_##type##_block->block); \ - type##_free_list = 0; \ - type##_free_list_tail = 0; \ -} \ - \ -static int gc_count_num_##type##_in_use; \ -static int gc_count_num_##type##_freelist - -#define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result) do { \ - if (current_##type##_block_index \ - == countof (current_##type##_block->block)) \ - { \ - struct type##_block *AFTFB_new = (struct type##_block *) \ - allocate_lisp_storage (sizeof (struct type##_block)); \ - AFTFB_new->prev = current_##type##_block; \ - current_##type##_block = AFTFB_new; \ - current_##type##_block_index = 0; \ - } \ - (result) = \ - &(current_##type##_block->block[current_##type##_block_index++]); \ -} while (0) - -/* Allocate an instance of a type that is stored in blocks. - TYPE is the "name" of the type, STRUCTTYPE is the corresponding - structure type. */ - -#ifdef ERROR_CHECK_GC - -/* Note: if you get crashes in this function, suspect incorrect calls - to free_cons() and friends. This happened once because the cons - cell was not GC-protected and was getting collected before - free_cons() was called. */ - -#define ALLOCATE_FIXED_TYPE_1(type, structtype, result) \ -do \ -{ \ - if (gc_count_num_##type##_freelist > \ - MINIMUM_ALLOWED_FIXED_TYPE_CELLS_##type) \ - { \ - result = type##_free_list; \ - /* Before actually using the chain pointer, we complement all its \ - bits; see FREE_FIXED_TYPE(). */ \ - type##_free_list = \ - (structtype *) ~(unsigned long) \ - (* (structtype **) ((char *) result + sizeof (void *))); \ - gc_count_num_##type##_freelist--; \ - } \ - else \ - ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \ - MARK_STRUCT_AS_NOT_FREE (result); \ -} while (0) - -#else /* !ERROR_CHECK_GC */ - -#define ALLOCATE_FIXED_TYPE_1(type, structtype, result) \ -do \ -{ \ - if (type##_free_list) \ - { \ - result = type##_free_list; \ - type##_free_list = \ - * (structtype **) ((char *) result + sizeof (void *)); \ - } \ - else \ - ALLOCATE_FIXED_TYPE_FROM_BLOCK (type, result); \ - MARK_STRUCT_AS_NOT_FREE (result); \ -} while (0) - -#endif /* !ERROR_CHECK_GC */ - -#define ALLOCATE_FIXED_TYPE(type, structtype, result) \ -do \ -{ \ - ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \ - INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \ -} while (0) - -#define NOSEEUM_ALLOCATE_FIXED_TYPE(type, structtype, result) \ -do \ -{ \ - ALLOCATE_FIXED_TYPE_1 (type, structtype, result); \ - NOSEEUM_INCREMENT_CONS_COUNTER (sizeof (structtype), #type); \ -} while (0) - -/* INVALID_POINTER_VALUE should be a value that is invalid as a pointer - to a Lisp object and invalid as an actual Lisp_Object value. We have - to make sure that this value cannot be an integer in Lisp_Object form. - 0xFFFFFFFF could be so on a 64-bit system, so we extend it to 64 bits. - On a 32-bit system, the type bits will be non-zero, making the value - be a pointer, and the pointer will be misaligned. - - Even if Emacs is run on some weirdo system that allows and allocates - byte-aligned pointers, this pointer is at the very top of the address - space and so it's almost inconceivable that it could ever be valid. */ - -#if INTBITS == 32 -# define INVALID_POINTER_VALUE 0xFFFFFFFF -#elif INTBITS == 48 -# define INVALID_POINTER_VALUE 0xFFFFFFFFFFFF -#elif INTBITS == 64 -# define INVALID_POINTER_VALUE 0xFFFFFFFFFFFFFFFF -#else -You have some weird system and need to supply a reasonable value here. -#endif - -#define FREE_STRUCT_P(ptr) \ - (* (void **) ptr == (void *) INVALID_POINTER_VALUE) -#define MARK_STRUCT_AS_FREE(ptr) \ - (* (void **) ptr = (void *) INVALID_POINTER_VALUE) -#define MARK_STRUCT_AS_NOT_FREE(ptr) \ - (* (void **) ptr = 0) - -#ifdef ERROR_CHECK_GC - -#define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) \ -do { if (type##_free_list_tail) \ - { \ - /* When we store the chain pointer, we complement all \ - its bits; this should significantly increase its \ - bogosity in case someone tries to use the value, and \ - should make us dump faster if someone stores something \ - over the pointer because when it gets un-complemented in \ - ALLOCATED_FIXED_TYPE(), the resulting pointer will be \ - extremely bogus. */ \ - * (structtype **) \ - ((char *) type##_free_list_tail + sizeof (void *)) = \ - (structtype *) ~(unsigned long) ptr; \ - } \ - else \ - type##_free_list = ptr; \ - type##_free_list_tail = ptr; \ - } while (0) - -#else /* !ERROR_CHECK_GC */ - -#define PUT_FIXED_TYPE_ON_FREE_LIST(type, structtype, ptr) \ -do { * (structtype **) ((char *) (ptr) + sizeof (void *)) = \ - type##_free_list; \ - type##_free_list = (ptr); \ - } while (0) - -#endif /* !ERROR_CHECK_GC */ - -/* TYPE and STRUCTTYPE are the same as in ALLOCATE_FIXED_TYPE(). */ - -#define FREE_FIXED_TYPE(type, structtype, ptr) do { \ - structtype *FFT_ptr = (ptr); \ - ADDITIONAL_FREE_##type (FFT_ptr); \ - deadbeef_memory (FFT_ptr, sizeof (structtype)); \ - PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ - MARK_STRUCT_AS_FREE (FFT_ptr); \ -} while (0) - -/* Like FREE_FIXED_TYPE() but used when we are explicitly - freeing a structure through free_cons(), free_marker(), etc. - rather than through the normal process of sweeping. - We attempt to undo the changes made to the allocation counters - as a result of this structure being allocated. This is not - completely necessary but helps keep things saner: e.g. this way, - repeatedly allocating and freeing a cons will not result in - the consing-since-gc counter advancing, which would cause a GC - and somewhat defeat the purpose of explicitly freeing. */ - -#define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ -do { FREE_FIXED_TYPE (type, structtype, ptr); \ - DECREMENT_CONS_COUNTER (sizeof (structtype)); \ - gc_count_num_##type##_freelist++; \ - } while (0) - - - -/************************************************************************/ -/* Cons allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (cons, struct Lisp_Cons); -/* conses are used and freed so often that we set this really high */ -/* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 20000 */ -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_cons 2000 - -#ifdef LRECORD_CONS -static Lisp_Object -mark_cons (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - if (GC_NILP (XCDR (obj))) - return XCAR (obj); - - markobj (XCAR (obj)); - return XCDR (obj); -} - -static int -cons_equal (Lisp_Object ob1, Lisp_Object ob2, int depth) -{ - while (internal_equal (XCAR (ob1), XCAR (ob2), depth + 1)) - { - ob1 = XCDR (ob1); - ob2 = XCDR (ob2); - if (! CONSP (ob1) || ! CONSP (ob2)) - return internal_equal (ob1, ob2, depth + 1); - } - return 0; -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons, - mark_cons, print_cons, 0, - cons_equal, - /* - * No `hash' method needed. - * internal_hash knows how to - * handle conses. - */ - 0, - struct Lisp_Cons); -#endif /* LRECORD_CONS */ - -DEFUN ("cons", Fcons, 2, 2, 0, /* -Create a new cons, give it CAR and CDR as components, and return it. -*/ - (car, cdr)) -{ - /* This cannot GC. */ - Lisp_Object val; - struct Lisp_Cons *c; - - ALLOCATE_FIXED_TYPE (cons, struct Lisp_Cons, c); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#endif - XSETCONS (val, c); - c->car = car; - c->cdr = cdr; - return val; -} - -/* This is identical to Fcons() but it used for conses that we're - going to free later, and is useful when trying to track down - "real" consing. */ -Lisp_Object -noseeum_cons (Lisp_Object car, Lisp_Object cdr) -{ - Lisp_Object val; - struct Lisp_Cons *c; - - NOSEEUM_ALLOCATE_FIXED_TYPE (cons, struct Lisp_Cons, c); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#endif - XSETCONS (val, c); - XCAR (val) = car; - XCDR (val) = cdr; - return val; -} - -DEFUN ("list", Flist, 0, MANY, 0, /* -Return a newly created list with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Object val = Qnil; - Lisp_Object *argp = args + nargs; - - while (argp > args) - val = Fcons (*--argp, val); - return val; -} - -Lisp_Object -list1 (Lisp_Object obj0) -{ - /* This cannot GC. */ - return Fcons (obj0, Qnil); -} - -Lisp_Object -list2 (Lisp_Object obj0, Lisp_Object obj1) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, Qnil)); -} - -Lisp_Object -list3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, Fcons (obj2, Qnil))); -} - -Lisp_Object -cons3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, obj2)); -} - -Lisp_Object -acons (Lisp_Object key, Lisp_Object value, Lisp_Object alist) -{ - return Fcons (Fcons (key, value), alist); -} - -Lisp_Object -list4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Qnil)))); -} - -Lisp_Object -list5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3, - Lisp_Object obj4) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Qnil))))); -} - -Lisp_Object -list6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3, - Lisp_Object obj4, Lisp_Object obj5) -{ - /* This cannot GC. */ - return Fcons (obj0, Fcons (obj1, Fcons (obj2, Fcons (obj3, Fcons (obj4, Fcons (obj5, Qnil)))))); -} - -DEFUN ("make-list", Fmake_list, 2, 2, 0, /* -Return a new list of length LENGTH, with each element being INIT. -*/ - (length, init)) -{ - CHECK_NATNUM (length); - - { - Lisp_Object val = Qnil; - int size = XINT (length); - - while (size-- > 0) - val = Fcons (init, val); - return val; - } -} - - -/************************************************************************/ -/* Float allocation */ -/************************************************************************/ - -#ifdef LISP_FLOAT_TYPE - -DECLARE_FIXED_TYPE_ALLOC (float, struct Lisp_Float); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_float 1000 - -Lisp_Object -make_float (double float_value) -{ - Lisp_Object val; - struct Lisp_Float *f; - - ALLOCATE_FIXED_TYPE (float, struct Lisp_Float, f); - set_lheader_implementation (&(f->lheader), lrecord_float); - float_data (f) = float_value; - XSETFLOAT (val, f); - return val; -} - -#endif /* LISP_FLOAT_TYPE */ - - -/************************************************************************/ -/* Vector allocation */ -/************************************************************************/ - -#ifdef LRECORD_VECTOR -static Lisp_Object -mark_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - Lisp_Vector *ptr = XVECTOR (obj); - int len = vector_length (ptr); - int i; - - for (i = 0; i < len - 1; i++) - markobj (ptr->contents[i]); - return (len > 0) ? ptr->contents[len - 1] : Qnil; -} - -static size_t -size_vector (CONST void *lheader) -{ - return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, - ((Lisp_Vector *) lheader)->size); -} - -static int -vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - int len = XVECTOR_LENGTH (obj1); - if (len != XVECTOR_LENGTH (obj2)) - return 0; - - { - Lisp_Object *ptr1 = XVECTOR_DATA (obj1); - Lisp_Object *ptr2 = XVECTOR_DATA (obj2); - while (len--) - if (!internal_equal (*ptr1++, *ptr2++, depth + 1)) - return 0; - } - return 1; -} - -DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector, - mark_vector, print_vector, 0, - vector_equal, - /* - * No `hash' method needed for - * vectors. internal_hash - * knows how to handle vectors. - */ - 0, - size_vector, Lisp_Vector); - -/* #### should allocate `small' vectors from a frob-block */ -static Lisp_Vector * -make_vector_internal (size_t sizei) -{ - /* no vector_next */ - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei); - Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, lrecord_vector); - - p->size = sizei; - return p; -} - -#else /* ! LRECORD_VECTOR */ - -static Lisp_Object all_vectors; - -/* #### should allocate `small' vectors from a frob-block */ -static Lisp_Vector * -make_vector_internal (size_t sizei) -{ - /* + 1 to account for vector_next */ - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei+1); - Lisp_Vector *p = (Lisp_Vector *) allocate_lisp_storage (sizem); - - INCREMENT_CONS_COUNTER (sizem, "vector"); - - p->size = sizei; - vector_next (p) = all_vectors; - XSETVECTOR (all_vectors, p); - return p; -} - -#endif /* ! LRECORD_VECTOR */ - -Lisp_Object -make_vector (size_t length, Lisp_Object init) -{ - Lisp_Vector *vecp = make_vector_internal (length); - Lisp_Object *p = vector_data (vecp); - - while (length--) - *p++ = init; - - { - Lisp_Object vector; - XSETVECTOR (vector, vecp); - return vector; - } -} - -DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /* -Return a new vector of length LENGTH, with each element being INIT. -See also the function `vector'. -*/ - (length, init)) -{ - CONCHECK_NATNUM (length); - return make_vector (XINT (length), init); -} - -DEFUN ("vector", Fvector, 0, MANY, 0, /* -Return a newly created vector with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Vector *vecp = make_vector_internal (nargs); - Lisp_Object *p = vector_data (vecp); - - while (nargs--) - *p++ = *args++; - - { - Lisp_Object vector; - XSETVECTOR (vector, vecp); - return vector; - } -} - -Lisp_Object -vector1 (Lisp_Object obj0) -{ - return Fvector (1, &obj0); -} - -Lisp_Object -vector2 (Lisp_Object obj0, Lisp_Object obj1) -{ - Lisp_Object args[2]; - args[0] = obj0; - args[1] = obj1; - return Fvector (2, args); -} - -Lisp_Object -vector3 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2) -{ - Lisp_Object args[3]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - return Fvector (3, args); -} - -#if 0 /* currently unused */ - -Lisp_Object -vector4 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object obj3) -{ - Lisp_Object args[4]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - args[3] = obj3; - return Fvector (4, args); -} - -Lisp_Object -vector5 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object obj3, Lisp_Object obj4) -{ - Lisp_Object args[5]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - args[3] = obj3; - args[4] = obj4; - return Fvector (5, args); -} - -Lisp_Object -vector6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5) -{ - Lisp_Object args[6]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - args[3] = obj3; - args[4] = obj4; - args[5] = obj5; - return Fvector (6, args); -} - -Lisp_Object -vector7 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5, - Lisp_Object obj6) -{ - Lisp_Object args[7]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - args[3] = obj3; - args[4] = obj4; - args[5] = obj5; - args[6] = obj6; - return Fvector (7, args); -} - -Lisp_Object -vector8 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object obj3, Lisp_Object obj4, Lisp_Object obj5, - Lisp_Object obj6, Lisp_Object obj7) -{ - Lisp_Object args[8]; - args[0] = obj0; - args[1] = obj1; - args[2] = obj2; - args[3] = obj3; - args[4] = obj4; - args[5] = obj5; - args[6] = obj6; - args[7] = obj7; - return Fvector (8, args); -} -#endif /* unused */ - -/************************************************************************/ -/* Bit Vector allocation */ -/************************************************************************/ - -static Lisp_Object all_bit_vectors; - -/* #### should allocate `small' bit vectors from a frob-block */ -static struct Lisp_Bit_Vector * -make_bit_vector_internal (size_t sizei) -{ - size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei); - size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs); - Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); - set_lheader_implementation (&(p->lheader), lrecord_bit_vector); - - INCREMENT_CONS_COUNTER (sizem, "bit-vector"); - - bit_vector_length (p) = sizei; - bit_vector_next (p) = all_bit_vectors; - /* make sure the extra bits in the last long are 0; the calling - functions might not set them. */ - p->bits[num_longs - 1] = 0; - XSETBIT_VECTOR (all_bit_vectors, p); - return p; -} - -Lisp_Object -make_bit_vector (size_t length, Lisp_Object init) -{ - struct Lisp_Bit_Vector *p = make_bit_vector_internal (length); - size_t num_longs = BIT_VECTOR_LONG_STORAGE (length); - - CHECK_BIT (init); - - if (ZEROP (init)) - memset (p->bits, 0, num_longs * sizeof (long)); - else - { - size_t bits_in_last = length & (LONGBITS_POWER_OF_2 - 1); - memset (p->bits, ~0, num_longs * sizeof (long)); - /* But we have to make sure that the unused bits in the - last long are 0, so that equal/hash is easy. */ - if (bits_in_last) - p->bits[num_longs - 1] &= (1 << bits_in_last) - 1; - } - - { - Lisp_Object bit_vector; - XSETBIT_VECTOR (bit_vector, p); - return bit_vector; - } -} - -Lisp_Object -make_bit_vector_from_byte_vector (unsigned char *bytevec, size_t length) -{ - int i; - Lisp_Bit_Vector *p = make_bit_vector_internal (length); - - for (i = 0; i < length; i++) - set_bit_vector_bit (p, i, bytevec[i]); - - { - Lisp_Object bit_vector; - XSETBIT_VECTOR (bit_vector, p); - return bit_vector; - } -} - -DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /* -Return a new bit vector of length LENGTH. with each bit being INIT. -Each element is set to INIT. See also the function `bit-vector'. -*/ - (length, init)) -{ - CONCHECK_NATNUM (length); - - return make_bit_vector (XINT (length), init); -} - -DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /* -Return a newly created bit vector with specified arguments as elements. -Any number of arguments, even zero arguments, are allowed. -*/ - (int nargs, Lisp_Object *args)) -{ - int i; - Lisp_Bit_Vector *p = make_bit_vector_internal (nargs); - - for (i = 0; i < nargs; i++) - { - CHECK_BIT (args[i]); - set_bit_vector_bit (p, i, !ZEROP (args[i])); - } - - { - Lisp_Object bit_vector; - XSETBIT_VECTOR (bit_vector, p); - return bit_vector; - } -} - - -/************************************************************************/ -/* Compiled-function allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (compiled_function, Lisp_Compiled_Function); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_compiled_function 1000 - -static Lisp_Object -make_compiled_function (int make_pure) -{ - Lisp_Compiled_Function *f; - Lisp_Object fun; - size_t size = sizeof (Lisp_Compiled_Function); - - if (make_pure && check_purespace (size)) - { - f = (Lisp_Compiled_Function *) (PUREBEG + pure_bytes_used); - set_lheader_implementation (&(f->lheader), lrecord_compiled_function); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - f->lheader.pure = 1; -#endif - pure_bytes_used += size; - bump_purestat (&purestat_function, size); - } - else - { - ALLOCATE_FIXED_TYPE (compiled_function, Lisp_Compiled_Function, f); - set_lheader_implementation (&(f->lheader), lrecord_compiled_function); - } - f->stack_depth = 0; - f->specpdl_depth = 0; - f->flags.documentationp = 0; - f->flags.interactivep = 0; - f->flags.domainp = 0; /* I18N3 */ - f->instructions = Qzero; - f->constants = Qzero; - f->arglist = Qnil; - f->doc_and_interactive = Qnil; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - f->annotated = Qnil; -#endif - XSETCOMPILED_FUNCTION (fun, f); - return fun; -} - -DEFUN ("make-byte-code", Fmake_byte_code, 4, MANY, 0, /* -Return a new compiled-function object. -Usage: (arglist instructions constants stack-depth - &optional doc-string interactive) -Note that, unlike all other emacs-lisp functions, calling this with five -arguments is NOT the same as calling it with six arguments, the last of -which is nil. If the INTERACTIVE arg is specified as nil, then that means -that this function was defined with `(interactive)'. If the arg is not -specified, then that means the function is not interactive. -This is terrible behavior which is retained for compatibility with old -`.elc' files which expect these semantics. -*/ - (int nargs, Lisp_Object *args)) -{ -/* In a non-insane world this function would have this arglist... - (arglist instructions constants stack_depth &optional doc_string interactive) - */ - Lisp_Object fun = make_compiled_function (purify_flag); - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - - Lisp_Object arglist = args[0]; - Lisp_Object instructions = args[1]; - Lisp_Object constants = args[2]; - Lisp_Object stack_depth = args[3]; - Lisp_Object doc_string = (nargs > 4) ? args[4] : Qnil; - Lisp_Object interactive = (nargs > 5) ? args[5] : Qunbound; - - /* Don't purecopy the doc references in instructions because it's - wasteful; they will get fixed up later. - - #### If something goes wrong and they don't get fixed up, - we're screwed, because pure stuff isn't marked and thus the - cons references won't be marked and will get reused. - - Note: there will be a window after the byte code is created and - before the doc references are fixed up in which there will be - impure objects inside a pure object, which apparently won't - get marked, leading to trouble. But during that entire window, - the objects are sitting on Vload_force_doc_string_list, which - is staticpro'd, so we're OK. */ - Lisp_Object (*cons) (Lisp_Object, Lisp_Object) - = purify_flag ? pure_cons : Fcons; - - if (nargs < 4 || nargs > 6) - return Fsignal (Qwrong_number_of_arguments, - list2 (intern ("make-byte-code"), make_int (nargs))); - - /* Check for valid formal parameter list now, to allow us to use - SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */ - { - Lisp_Object symbol, tail; - EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail) - { - CHECK_SYMBOL (symbol); - if (EQ (symbol, Qt) || - EQ (symbol, Qnil) || - SYMBOL_IS_KEYWORD (symbol)) - signal_simple_error_2 - ("Invalid constant symbol in formal parameter list", - symbol, arglist); - } - } - f->arglist = arglist; - - /* `instructions' is a string or a cons (string . int) for a - lazy-loaded function. */ - if (CONSP (instructions)) - { - CHECK_STRING (XCAR (instructions)); - CHECK_INT (XCDR (instructions)); - } - else - { - CHECK_STRING (instructions); - } - f->instructions = instructions; - - if (!NILP (constants)) - CHECK_VECTOR (constants); - f->constants = constants; - - CHECK_NATNUM (stack_depth); - f->stack_depth = XINT (stack_depth); - -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - if (!NILP (Vcurrent_compiled_function_annotation)) - f->annotated = Fpurecopy (Vcurrent_compiled_function_annotation); - else if (!NILP (Vload_file_name_internal_the_purecopy)) - f->annotated = Vload_file_name_internal_the_purecopy; - else if (!NILP (Vload_file_name_internal)) - { - struct gcpro gcpro1; - GCPRO1 (fun); /* don't let fun get reaped */ - Vload_file_name_internal_the_purecopy = - Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal)); - f->annotated = Vload_file_name_internal_the_purecopy; - UNGCPRO; - } -#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ - - /* doc_string may be nil, string, int, or a cons (string . int). - interactive may be list or string (or unbound). */ - f->doc_and_interactive = Qunbound; -#ifdef I18N3 - if ((f->flags.domainp = !NILP (Vfile_domain)) != 0) - f->doc_and_interactive = Vfile_domain; -#endif - if ((f->flags.interactivep = !UNBOUNDP (interactive)) != 0) - { - if (purify_flag) - { - interactive = Fpurecopy (interactive); - if (STRINGP (interactive)) - bump_purestat (&purestat_string_interactive, - pure_sizeof (interactive)); - } - f->doc_and_interactive - = (UNBOUNDP (f->doc_and_interactive) ? interactive : - cons (interactive, f->doc_and_interactive)); - } - if ((f->flags.documentationp = !NILP (doc_string)) != 0) - { - if (purify_flag) - { - doc_string = Fpurecopy (doc_string); - if (STRINGP (doc_string)) - /* These should have been snagged by make-docfile... */ - bump_purestat (&purestat_string_documentation, - pure_sizeof (doc_string)); - } - f->doc_and_interactive - = (UNBOUNDP (f->doc_and_interactive) ? doc_string : - cons (doc_string, f->doc_and_interactive)); - } - if (UNBOUNDP (f->doc_and_interactive)) - f->doc_and_interactive = Qnil; - - if (purify_flag) - { - - if (!purified (f->arglist)) - f->arglist = Fpurecopy (f->arglist); - - /* Statistics are kept differently for the constants */ - if (!purified (f->constants)) - { -#ifdef PURESTAT - int old = purecopying_function_constants; - purecopying_function_constants = 1; - f->constants = Fpurecopy (f->constants); - bump_purestat (&purestat_vector_constants, - pure_sizeof (f->constants)); - purecopying_function_constants = old; -#else - f->constants = Fpurecopy (f->constants); -#endif /* PURESTAT */ - } - - optimize_compiled_function (fun); - - bump_purestat (&purestat_opaque_instructions, - pure_sizeof (f->instructions)); - } - - return fun; -} - - -/************************************************************************/ -/* Symbol allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (symbol, struct Lisp_Symbol); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_symbol 1000 - -DEFUN ("make-symbol", Fmake_symbol, 1, 1, 0, /* -Return a newly allocated uninterned symbol whose name is NAME. -Its value and function definition are void, and its property list is nil. -*/ - (name)) -{ - Lisp_Object val; - struct Lisp_Symbol *p; - - CHECK_STRING (name); - - ALLOCATE_FIXED_TYPE (symbol, struct Lisp_Symbol, p); -#ifdef LRECORD_SYMBOL - set_lheader_implementation (&(p->lheader), lrecord_symbol); -#endif - p->name = XSTRING (name); - p->plist = Qnil; - p->value = Qunbound; - p->function = Qunbound; - p->obarray = Qnil; - symbol_next (p) = 0; - XSETSYMBOL (val, p); - return val; -} - - -/************************************************************************/ -/* Extent allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (extent, struct extent); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_extent 1000 - -struct extent * -allocate_extent (void) -{ - struct extent *e; - - ALLOCATE_FIXED_TYPE (extent, struct extent, e); - set_lheader_implementation (&(e->lheader), lrecord_extent); - extent_object (e) = Qnil; - set_extent_start (e, -1); - set_extent_end (e, -1); - e->plist = Qnil; - - xzero (e->flags); - - extent_face (e) = Qnil; - e->flags.end_open = 1; /* default is for endpoints to behave like markers */ - e->flags.detachable = 1; - - return e; -} - - -/************************************************************************/ -/* Event allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (event, struct Lisp_Event); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_event 1000 - -Lisp_Object -allocate_event (void) -{ - Lisp_Object val; - struct Lisp_Event *e; - - ALLOCATE_FIXED_TYPE (event, struct Lisp_Event, e); - set_lheader_implementation (&(e->lheader), lrecord_event); - - XSETEVENT (val, e); - return val; -} - - -/************************************************************************/ -/* Marker allocation */ -/************************************************************************/ - -DECLARE_FIXED_TYPE_ALLOC (marker, struct Lisp_Marker); -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_marker 1000 - -DEFUN ("make-marker", Fmake_marker, 0, 0, 0, /* -Return a new marker which does not point at any place. -*/ - ()) -{ - Lisp_Object val; - struct Lisp_Marker *p; - - ALLOCATE_FIXED_TYPE (marker, struct Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), lrecord_marker); - p->buffer = 0; - p->memind = 0; - marker_next (p) = 0; - marker_prev (p) = 0; - p->insertion_type = 0; - XSETMARKER (val, p); - return val; -} - -Lisp_Object -noseeum_make_marker (void) -{ - Lisp_Object val; - struct Lisp_Marker *p; - - NOSEEUM_ALLOCATE_FIXED_TYPE (marker, struct Lisp_Marker, p); - set_lheader_implementation (&(p->lheader), lrecord_marker); - p->buffer = 0; - p->memind = 0; - marker_next (p) = 0; - marker_prev (p) = 0; - p->insertion_type = 0; - XSETMARKER (val, p); - return val; -} - - -/************************************************************************/ -/* String allocation */ -/************************************************************************/ - -/* The data for "short" strings generally resides inside of structs of type - string_chars_block. The Lisp_String structure is allocated just like any - other Lisp object (except for vectors), and these are freelisted when - they get garbage collected. The data for short strings get compacted, - but the data for large strings do not. - - Previously Lisp_String structures were relocated, but this caused a lot - of bus-errors because the C code didn't include enough GCPRO's for - strings (since EVERY REFERENCE to a short string needed to be GCPRO'd so - that the reference would get relocated). - - This new method makes things somewhat bigger, but it is MUCH safer. */ - -DECLARE_FIXED_TYPE_ALLOC (string, struct Lisp_String); -/* strings are used and freed quite often */ -/* #define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 10000 */ -#define MINIMUM_ALLOWED_FIXED_TYPE_CELLS_string 1000 - -#ifdef LRECORD_STRING -static Lisp_Object -mark_string (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_String *ptr = XSTRING (obj); - - if (GC_CONSP (ptr->plist) && GC_EXTENT_INFOP (XCAR (ptr->plist))) - flush_cached_extent_info (XCAR (ptr->plist)); - return ptr->plist; -} - -static int -string_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - Bytecount len; - return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && - !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("string", string, - mark_string, print_string, - /* - * No `finalize', or `hash' methods. - * internal_hash already knows how - * to hash strings and finalization - * is done with the - * ADDITIONAL_FREE_string macro, - * which is the standard way to do - * finalization when using - * SWEEP_FIXED_TYPE_BLOCK(). - */ - 0, string_equal, 0, - struct Lisp_String); -#endif /* LRECORD_STRING */ - -/* String blocks contain this many useful bytes. */ -#define STRING_CHARS_BLOCK_SIZE \ -((Bytecount) (8192 - MALLOC_OVERHEAD - \ - ((2 * sizeof (struct string_chars_block *)) \ - + sizeof (EMACS_INT)))) -/* Block header for small strings. */ -struct string_chars_block -{ - EMACS_INT pos; - struct string_chars_block *next; - struct string_chars_block *prev; - /* Contents of string_chars_block->string_chars are interleaved - string_chars structures (see below) and the actual string data */ - unsigned char string_chars[STRING_CHARS_BLOCK_SIZE]; -}; - -struct string_chars_block *first_string_chars_block; -struct string_chars_block *current_string_chars_block; - -/* If SIZE is the length of a string, this returns how many bytes - * the string occupies in string_chars_block->string_chars - * (including alignment padding). - */ -#define STRING_FULLSIZE(s) \ - ALIGN_SIZE (((s) + 1 + sizeof (struct Lisp_String *)),\ - ALIGNOF (struct Lisp_String *)) - -#define BIG_STRING_FULLSIZE_P(fullsize) ((fullsize) >= STRING_CHARS_BLOCK_SIZE) -#define BIG_STRING_SIZE_P(size) (BIG_STRING_FULLSIZE_P (STRING_FULLSIZE(size))) - -#define CHARS_TO_STRING_CHAR(x) \ - ((struct string_chars *) \ - (((char *) (x)) - (slot_offset (struct string_chars, chars[0])))) - - -struct string_chars -{ - struct Lisp_String *string; - unsigned char chars[1]; -}; - -struct unused_string_chars -{ - struct Lisp_String *string; - EMACS_INT fullsize; -}; - -static void -init_string_chars_alloc (void) -{ - first_string_chars_block = xnew (struct string_chars_block); - first_string_chars_block->prev = 0; - first_string_chars_block->next = 0; - first_string_chars_block->pos = 0; - current_string_chars_block = first_string_chars_block; -} - -static struct string_chars * -allocate_string_chars_struct (struct Lisp_String *string_it_goes_with, - EMACS_INT fullsize) -{ - struct string_chars *s_chars; - - /* Allocate the string's actual data */ - if (BIG_STRING_FULLSIZE_P (fullsize)) - { - s_chars = (struct string_chars *) xmalloc (fullsize); - } - else if (fullsize <= - (countof (current_string_chars_block->string_chars) - - current_string_chars_block->pos)) - { - /* This string can fit in the current string chars block */ - s_chars = (struct string_chars *) - (current_string_chars_block->string_chars - + current_string_chars_block->pos); - current_string_chars_block->pos += fullsize; - } - else - { - /* Make a new current string chars block */ - struct string_chars_block *new_scb = xnew (struct string_chars_block); - - current_string_chars_block->next = new_scb; - new_scb->prev = current_string_chars_block; - new_scb->next = 0; - current_string_chars_block = new_scb; - new_scb->pos = fullsize; - s_chars = (struct string_chars *) - current_string_chars_block->string_chars; - } - - s_chars->string = string_it_goes_with; - - INCREMENT_CONS_COUNTER (fullsize, "string chars"); - - return s_chars; -} - -Lisp_Object -make_uninit_string (Bytecount length) -{ - struct Lisp_String *s; - struct string_chars *s_chars; - EMACS_INT fullsize = STRING_FULLSIZE (length); - Lisp_Object val; - - if ((length < 0) || (fullsize <= 0)) - abort (); - - /* Allocate the string header */ - ALLOCATE_FIXED_TYPE (string, struct Lisp_String, s); -#ifdef LRECORD_STRING - set_lheader_implementation (&(s->lheader), lrecord_string); -#endif - - s_chars = allocate_string_chars_struct (s, fullsize); - - set_string_data (s, &(s_chars->chars[0])); - set_string_length (s, length); - s->plist = Qnil; - - set_string_byte (s, length, 0); - - XSETSTRING (val, s); - return val; -} - -#ifdef VERIFY_STRING_CHARS_INTEGRITY -static void verify_string_chars_integrity (void); -#endif - -/* Resize the string S so that DELTA bytes can be inserted starting - at POS. If DELTA < 0, it means deletion starting at POS. If - POS < 0, resize the string but don't copy any characters. Use - this if you're planning on completely overwriting the string. -*/ - -void -resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta) -{ -#ifdef VERIFY_STRING_CHARS_INTEGRITY - verify_string_chars_integrity (); -#endif - -#ifdef ERROR_CHECK_BUFPOS - if (pos >= 0) - { - assert (pos <= string_length (s)); - if (delta < 0) - assert (pos + (-delta) <= string_length (s)); - } - else - { - if (delta < 0) - assert ((-delta) <= string_length (s)); - } -#endif /* ERROR_CHECK_BUFPOS */ - - if (pos >= 0 && delta < 0) - /* If DELTA < 0, the functions below will delete the characters - before POS. We want to delete characters *after* POS, however, - so convert this to the appropriate form. */ - pos += -delta; - - if (delta == 0) - /* simplest case: no size change. */ - return; - else - { - Bytecount oldfullsize = STRING_FULLSIZE (string_length (s)); - Bytecount newfullsize = STRING_FULLSIZE (string_length (s) + delta); - - if (oldfullsize == newfullsize) - { - /* next simplest case; size change but the necessary - allocation size won't change (up or down; code somewhere - depends on there not being any unused allocation space, - modulo any alignment constraints). */ - if (pos >= 0) - { - Bufbyte *addroff = pos + string_data (s); - - memmove (addroff + delta, addroff, - /* +1 due to zero-termination. */ - string_length (s) + 1 - pos); - } - } - else if (BIG_STRING_FULLSIZE_P (oldfullsize) && - BIG_STRING_FULLSIZE_P (newfullsize)) - { - /* next simplest case; the string is big enough to be malloc()ed - itself, so we just realloc. - - It's important not to let the string get below the threshold - for making big strings and still remain malloc()ed; if that - were the case, repeated calls to this function on the same - string could result in memory leakage. */ - set_string_data (s, (Bufbyte *) xrealloc (string_data (s), - newfullsize)); - if (pos >= 0) - { - Bufbyte *addroff = pos + string_data (s); - - memmove (addroff + delta, addroff, - /* +1 due to zero-termination. */ - string_length (s) + 1 - pos); - } - } - else - { - /* worst case. We make a new string_chars struct and copy - the string's data into it, inserting/deleting the delta - in the process. The old string data will either get - freed by us (if it was malloc()ed) or will be reclaimed - in the normal course of garbage collection. */ - struct string_chars *s_chars = - allocate_string_chars_struct (s, newfullsize); - Bufbyte *new_addr = &(s_chars->chars[0]); - Bufbyte *old_addr = string_data (s); - if (pos >= 0) - { - memcpy (new_addr, old_addr, pos); - memcpy (new_addr + pos + delta, old_addr + pos, - string_length (s) + 1 - pos); - } - set_string_data (s, new_addr); - if (BIG_STRING_FULLSIZE_P (oldfullsize)) - xfree (old_addr); - else - { - /* We need to mark this chunk of the string_chars_block - as unused so that compact_string_chars() doesn't - freak. */ - struct string_chars *old_s_chars = - (struct string_chars *) ((char *) old_addr - - sizeof (struct Lisp_String *)); - /* Sanity check to make sure we aren't hosed by strange - alignment/padding. */ - assert (old_s_chars->string == s); - MARK_STRUCT_AS_FREE (old_s_chars); - ((struct unused_string_chars *) old_s_chars)->fullsize = - oldfullsize; - } - } - - set_string_length (s, string_length (s) + delta); - /* If pos < 0, the string won't be zero-terminated. - Terminate now just to make sure. */ - string_data (s)[string_length (s)] = '\0'; - - if (pos >= 0) - { - Lisp_Object string; - - XSETSTRING (string, s); - /* We also have to adjust all of the extent indices after the - place we did the change. We say "pos - 1" because - adjust_extents() is exclusive of the starting position - passed to it. */ - adjust_extents (string, pos - 1, string_length (s), - delta); - } - } - -#ifdef VERIFY_STRING_CHARS_INTEGRITY - verify_string_chars_integrity (); -#endif -} - -#ifdef MULE - -void -set_string_char (struct Lisp_String *s, Charcount i, Emchar c) -{ - Bufbyte newstr[MAX_EMCHAR_LEN]; - Bytecount bytoff = charcount_to_bytecount (string_data (s), i); - Bytecount oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1); - Bytecount newlen = set_charptr_emchar (newstr, c); - - if (oldlen != newlen) - resize_string (s, bytoff, newlen - oldlen); - /* Remember, string_data (s) might have changed so we can't cache it. */ - memcpy (string_data (s) + bytoff, newstr, newlen); -} - -#endif /* MULE */ - -DEFUN ("make-string", Fmake_string, 2, 2, 0, /* -Return a new string of length LENGTH, with each character being INIT. -LENGTH must be an integer and INIT must be a character. -*/ - (length, init)) -{ - CHECK_NATNUM (length); - CHECK_CHAR_COERCE_INT (init); - { - Bufbyte init_str[MAX_EMCHAR_LEN]; - int len = set_charptr_emchar (init_str, XCHAR (init)); - Lisp_Object val = make_uninit_string (len * XINT (length)); - - if (len == 1) - /* Optimize the single-byte case */ - memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val)); - else - { - int i; - Bufbyte *ptr = XSTRING_DATA (val); - - for (i = XINT (length); i; i--) - { - Bufbyte *init_ptr = init_str; - switch (len) - { - case 4: *ptr++ = *init_ptr++; - case 3: *ptr++ = *init_ptr++; - case 2: *ptr++ = *init_ptr++; - case 1: *ptr++ = *init_ptr++; - } - } - } - return val; - } -} - -DEFUN ("string", Fstring, 0, MANY, 0, /* -Concatenate all the argument characters and make the result a string. -*/ - (int nargs, Lisp_Object *args)) -{ - Bufbyte *storage = alloca_array (Bufbyte, nargs * MAX_EMCHAR_LEN); - Bufbyte *p = storage; - - for (; nargs; nargs--, args++) - { - Lisp_Object lisp_char = *args; - CHECK_CHAR_COERCE_INT (lisp_char); - p += set_charptr_emchar (p, XCHAR (lisp_char)); - } - return make_string (storage, p - storage); -} - -/* Take some raw memory, which MUST already be in internal format, - and package it up into a Lisp string. */ -Lisp_Object -make_string (CONST Bufbyte *contents, Bytecount length) -{ - Lisp_Object val; - - /* Make sure we find out about bad make_string's when they happen */ -#if defined (ERROR_CHECK_BUFPOS) && defined (MULE) - bytecount_to_charcount (contents, length); /* Just for the assertions */ -#endif - - val = make_uninit_string (length); - memcpy (XSTRING_DATA (val), contents, length); - return val; -} - -/* Take some raw memory, encoded in some external data format, - and convert it into a Lisp string. */ -Lisp_Object -make_ext_string (CONST Extbyte *contents, EMACS_INT length, - enum external_data_format fmt) -{ - Bufbyte *intstr; - Bytecount intlen; - - GET_CHARPTR_INT_DATA_ALLOCA (contents, length, fmt, intstr, intlen); - return make_string (intstr, intlen); -} - -Lisp_Object -build_string (CONST char *str) -{ - /* Some strlen's crash and burn if passed null. */ - return make_string ((CONST Bufbyte *) str, (str ? strlen(str) : 0)); -} - -Lisp_Object -build_ext_string (CONST char *str, enum external_data_format fmt) -{ - /* Some strlen's crash and burn if passed null. */ - return make_ext_string ((CONST Extbyte *) str, (str ? strlen(str) : 0), fmt); -} - -Lisp_Object -build_translated_string (CONST char *str) -{ - return build_string (GETTEXT (str)); -} - - -/************************************************************************/ -/* lcrecord lists */ -/************************************************************************/ - -/* Lcrecord lists are used to manage the allocation of particular - sorts of lcrecords, to avoid calling alloc_lcrecord() (and thus - malloc() and garbage-collection junk) as much as possible. - It is similar to the Blocktype class. - - It works like this: - - 1) Create an lcrecord-list object using make_lcrecord_list(). - This is often done at initialization. Remember to staticpro - this object! The arguments to make_lcrecord_list() are the - same as would be passed to alloc_lcrecord(). - 2) Instead of calling alloc_lcrecord(), call allocate_managed_lcrecord() - and pass the lcrecord-list earlier created. - 3) When done with the lcrecord, call free_managed_lcrecord(). - The standard freeing caveats apply: ** make sure there are no - pointers to the object anywhere! ** - 4) Calling free_managed_lcrecord() is just like kissing the - lcrecord goodbye as if it were garbage-collected. This means: - -- the contents of the freed lcrecord are undefined, and the - contents of something produced by allocate_managed_lcrecord() - are undefined, just like for alloc_lcrecord(). - -- the mark method for the lcrecord's type will *NEVER* be called - on freed lcrecords. - -- the finalize method for the lcrecord's type will be called - at the time that free_managed_lcrecord() is called. - - */ - -static Lisp_Object -mark_lcrecord_list (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct lcrecord_list *list = XLCRECORD_LIST (obj); - Lisp_Object chain = list->free; - - while (!NILP (chain)) - { - struct lrecord_header *lheader = XRECORD_LHEADER (chain); - struct free_lcrecord_header *free_header = - (struct free_lcrecord_header *) lheader; - -#ifdef ERROR_CHECK_GC - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION(lheader); - - /* There should be no other pointers to the free list. */ - assert (!MARKED_RECORD_HEADER_P (lheader)); - /* Only lcrecords should be here. */ - assert (!implementation->basic_p); - /* Only free lcrecords should be here. */ - assert (free_header->lcheader.free); - /* The type of the lcrecord must be right. */ - assert (implementation == list->implementation); - /* So must the size. */ - assert (implementation->static_size == 0 - || implementation->static_size == list->size); -#endif /* ERROR_CHECK_GC */ - - MARK_RECORD_HEADER (lheader); - chain = free_header->chain; - } - - return Qnil; -} - -DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list, - mark_lcrecord_list, internal_object_printer, - 0, 0, 0, struct lcrecord_list); -Lisp_Object -make_lcrecord_list (size_t size, - CONST struct lrecord_implementation *implementation) -{ - struct lcrecord_list *p = alloc_lcrecord_type (struct lcrecord_list, - lrecord_lcrecord_list); - Lisp_Object val; - - p->implementation = implementation; - p->size = size; - p->free = Qnil; - XSETLCRECORD_LIST (val, p); - return val; -} - -Lisp_Object -allocate_managed_lcrecord (Lisp_Object lcrecord_list) -{ - struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); - if (!NILP (list->free)) - { - Lisp_Object val = list->free; - struct free_lcrecord_header *free_header = - (struct free_lcrecord_header *) XPNTR (val); - -#ifdef ERROR_CHECK_GC - struct lrecord_header *lheader = - (struct lrecord_header *) free_header; - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - - /* There should be no other pointers to the free list. */ - assert (!MARKED_RECORD_HEADER_P (lheader)); - /* Only lcrecords should be here. */ - assert (!implementation->basic_p); - /* Only free lcrecords should be here. */ - assert (free_header->lcheader.free); - /* The type of the lcrecord must be right. */ - assert (implementation == list->implementation); - /* So must the size. */ - assert (implementation->static_size == 0 - || implementation->static_size == list->size); -#endif /* ERROR_CHECK_GC */ - list->free = free_header->chain; - free_header->lcheader.free = 0; - return val; - } - else - { - Lisp_Object val; - - XSETOBJ (val, Lisp_Type_Record, - alloc_lcrecord (list->size, list->implementation)); - return val; - } -} - -void -free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord) -{ - struct lcrecord_list *list = XLCRECORD_LIST (lcrecord_list); - struct free_lcrecord_header *free_header = - (struct free_lcrecord_header *) XPNTR (lcrecord); - struct lrecord_header *lheader = - (struct lrecord_header *) free_header; - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - -#ifdef ERROR_CHECK_GC - /* Make sure the size is correct. This will catch, for example, - putting a window configuration on the wrong free list. */ - if (implementation->size_in_bytes_method) - assert (implementation->size_in_bytes_method (lheader) == list->size); - else - assert (implementation->static_size == list->size); -#endif /* ERROR_CHECK_GC */ - - if (implementation->finalizer) - implementation->finalizer (lheader, 0); - free_header->chain = list->free; - free_header->lcheader.free = 1; - list->free = lcrecord; -} - - -/************************************************************************/ -/* Purity of essence, peace on earth */ -/************************************************************************/ - -static int symbols_initialized; - -Lisp_Object -make_pure_string (CONST Bufbyte *data, Bytecount length, - Lisp_Object plist, int no_need_to_copy_data) -{ - Lisp_String *s; - size_t size = sizeof (Lisp_String) + - (no_need_to_copy_data ? 0 : (length + 1)); /* + 1 for terminating 0 */ - size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object)); - - if (symbols_initialized && !pure_lossage) - { - /* Try to share some names. Saves a few kbytes. */ - Lisp_Object tem = oblookup (Vobarray, data, length); - if (SYMBOLP (tem)) - { - s = XSYMBOL (tem)->name; - if (!PURIFIED (s)) abort (); - - { - Lisp_Object string; - XSETSTRING (string, s); - return string; - } - } - } - - if (!check_purespace (size)) - return make_string (data, length); - - s = (Lisp_String *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_STRING - set_lheader_implementation (&(s->lheader), lrecord_string); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - s->lheader.pure = 1; -#endif -#endif - set_string_length (s, length); - if (no_need_to_copy_data) - { - set_string_data (s, (Bufbyte *) data); - } - else - { - set_string_data (s, (Bufbyte *) s + sizeof (Lisp_String)); - memcpy (string_data (s), data, length); - set_string_byte (s, length, 0); - } - s->plist = Qnil; - pure_bytes_used += size; - -#ifdef PURESTAT - bump_purestat (&purestat_string_all, size); - if (purecopying_function_constants) - bump_purestat (&purestat_string_other_function, size); -#endif /* PURESTAT */ - - /* Do this after the official "completion" of the purecopying. */ - s->plist = Fpurecopy (plist); - - { - Lisp_Object string; - XSETSTRING (string, s); - return string; - } -} - - -Lisp_Object -make_pure_pname (CONST Bufbyte *data, Bytecount length, - int no_need_to_copy_data) -{ - Lisp_Object name = make_pure_string (data, length, Qnil, - no_need_to_copy_data); - bump_purestat (&purestat_string_pname, pure_sizeof (name)); - - /* We've made (at least) Qnil now, and Vobarray will soon be set up. */ - symbols_initialized = 1; - - return name; -} - - -Lisp_Object -pure_cons (Lisp_Object car, Lisp_Object cdr) -{ - Lisp_Cons *c; - - if (!check_purespace (sizeof (Lisp_Cons))) - return Fcons (Fpurecopy (car), Fpurecopy (cdr)); - - c = (Lisp_Cons *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_CONS - set_lheader_implementation (&(c->lheader), lrecord_cons); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - c->lheader.pure = 1; -#endif -#endif - pure_bytes_used += sizeof (Lisp_Cons); - bump_purestat (&purestat_cons, sizeof (Lisp_Cons)); - - c->car = Fpurecopy (car); - c->cdr = Fpurecopy (cdr); - - { - Lisp_Object cons; - XSETCONS (cons, c); - return cons; - } -} - -Lisp_Object -pure_list (int nargs, Lisp_Object *args) -{ - Lisp_Object val = Qnil; - - for (--nargs; nargs >= 0; nargs--) - val = pure_cons (args[nargs], val); - - return val; -} - -#ifdef LISP_FLOAT_TYPE - -static Lisp_Object -make_pure_float (double num) -{ - struct Lisp_Float *f; - Lisp_Object val; - - /* Make sure that PUREBEG + pure_bytes_used is aligned on at least a sizeof - (double) boundary. Some architectures (like the sparc) require - this, and I suspect that floats are rare enough that it's no - tragedy for those that don't. */ - { -#if defined (__GNUC__) && (__GNUC__ >= 2) - /* In gcc, we can directly ask what the alignment constraints of a - structure are, but in general, that's not possible... Arrgh!! - */ - int alignment = __alignof (struct Lisp_Float); -#else /* !GNUC */ - /* Best guess is to make the `double' slot be aligned to the size - of double (which is probably 8 bytes). This assumes that it's - ok to align the beginning of the structure to the same boundary - that the `double' slot in it is supposed to be aligned to; this - should be ok because presumably there is padding in the layout - of the struct to account for this. - */ - int alignment = sizeof (float_data (f)); -#endif /* !GNUC */ - char *p = ((char *) PUREBEG + pure_bytes_used); - - p = (char *) (((EMACS_UINT) p + alignment - 1) & - alignment); - pure_bytes_used = p - (char *) PUREBEG; - } - - if (!check_purespace (sizeof (struct Lisp_Float))) - return make_float (num); - - f = (struct Lisp_Float *) (PUREBEG + pure_bytes_used); - set_lheader_implementation (&(f->lheader), lrecord_float); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - f->lheader.pure = 1; -#endif - pure_bytes_used += sizeof (struct Lisp_Float); - bump_purestat (&purestat_float, sizeof (struct Lisp_Float)); - - float_data (f) = num; - XSETFLOAT (val, f); - return val; -} - -#endif /* LISP_FLOAT_TYPE */ - -Lisp_Object -make_pure_vector (size_t len, Lisp_Object init) -{ - Lisp_Vector *v; - size_t size = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len); - - init = Fpurecopy (init); - - if (!check_purespace (size)) - return make_vector (len, init); - - v = (Lisp_Vector *) (PUREBEG + pure_bytes_used); -#ifdef LRECORD_VECTOR - set_lheader_implementation (&(v->header.lheader), lrecord_vector); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - v->header.lheader.pure = 1; -#endif -#endif - pure_bytes_used += size; - bump_purestat (&purestat_vector_all, size); - - v->size = len; - - for (size = 0; size < len; size++) - v->contents[size] = init; - - { - Lisp_Object vector; - XSETVECTOR (vector, v); - return vector; - } -} - -#if 0 -/* Presently unused */ -void * -alloc_pure_lrecord (int size, struct lrecord_implementation *implementation) -{ - struct lrecord_header *header = (void *) (PUREBEG + pure_bytes_used); - - if (pure_bytes_used + size > get_PURESIZE()) - pure_storage_exhausted (); - - set_lheader_implementation (header, implementation); - header->next = 0; - return header; -} -#endif /* unused */ - - - -DEFUN ("purecopy", Fpurecopy, 1, 1, 0, /* -Make a copy of OBJECT in pure storage. -Recursively copies contents of vectors and cons cells. -Does not copy symbols. -*/ - (obj)) -{ - if (!purify_flag) - { - return obj; - } - else if (!POINTER_TYPE_P (XTYPE (obj)) - || PURIFIED (XPNTR (obj)) - /* happens when bootstrapping Qnil */ - || EQ (obj, Qnull_pointer)) - { - return obj; - } - /* Order of subsequent tests determined via profiling. */ - else if (SYMBOLP (obj)) - { - /* Symbols can't be made pure (and thus read-only), because - assigning to their function, value or plist slots would - produced a SEGV in the dumped XEmacs. So we previously would - just return the symbol unchanged. - - But purified aggregate objects like lists and vectors can - contain uninterned symbols. If there are no other non-pure - references to the symbol, then the symbol is not protected - from garbage collection because the collector does not mark - the contents of purified objects. So to protect the symbols, - an impure reference has to be kept for each uninterned symbol - that is referenced by a pure object. All such symbols are - stored in the hash table pointed to by - Vpure_uninterned_symbol_table, which is itself - staticpro'd. */ - if (NILP (XSYMBOL (obj)->obarray)) - Fputhash (obj, Qnil, Vpure_uninterned_symbol_table); - return obj; - } - else if (CONSP (obj)) - { - return pure_cons (XCAR (obj), XCDR (obj)); - } - else if (STRINGP (obj)) - { - return make_pure_string (XSTRING_DATA (obj), - XSTRING_LENGTH (obj), - XSTRING (obj)->plist, - 0); - } - else if (VECTORP (obj)) - { - int i; - Lisp_Vector *o = XVECTOR (obj); - Lisp_Object pure_obj = make_pure_vector (vector_length (o), Qnil); - for (i = 0; i < vector_length (o); i++) - XVECTOR_DATA (pure_obj)[i] = Fpurecopy (o->contents[i]); - return pure_obj; - } -#ifdef LISP_FLOAT_TYPE - else if (FLOATP (obj)) - { - return make_pure_float (XFLOAT_DATA (obj)); - } -#endif - else if (COMPILED_FUNCTIONP (obj)) - { - Lisp_Object pure_obj = make_compiled_function (1); - Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj); - Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (pure_obj); - n->flags = o->flags; - n->instructions = o->instructions; - n->constants = Fpurecopy (o->constants); - n->arglist = Fpurecopy (o->arglist); - n->doc_and_interactive = Fpurecopy (o->doc_and_interactive); - n->stack_depth = o->stack_depth; - optimize_compiled_function (pure_obj); - return pure_obj; - } - else if (OPAQUEP (obj)) - { - Lisp_Object pure_obj; - Lisp_Opaque *old_opaque = XOPAQUE (obj); - Lisp_Opaque *new_opaque = (Lisp_Opaque *) (PUREBEG + pure_bytes_used); - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - size_t size = implementation->size_in_bytes_method (lheader); - size_t pure_size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object)); - if (!check_purespace (pure_size)) - return obj; - pure_bytes_used += pure_size; - - memcpy (new_opaque, old_opaque, size); -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - lheader->pure = 1; -#endif - new_opaque->header.next = 0; - - XSETOPAQUE (pure_obj, new_opaque); - return pure_obj; - } - else - { - signal_simple_error ("Can't purecopy %S", obj); - } - return obj; /* Unreached */ -} - - - -static void -puresize_adjust_h (size_t puresize) -{ - FILE *stream = fopen ("puresize-adjust.h", "w"); - - if (stream == NULL) - report_file_error ("Opening puresize adjustment file", - Fcons (build_string ("puresize-adjust.h"), Qnil)); - - fprintf (stream, - "/*\tDo not edit this file!\n" - "\tAutomatically generated by XEmacs */\n" - "# define PURESIZE_ADJUSTMENT (%ld)\n", - (long) (puresize - RAW_PURESIZE)); - fclose (stream); -} - -void -report_pure_usage (int report_impurities, - int die_if_pure_storage_exceeded) -{ - int rc = 0; - - if (pure_lossage) - { - message ("\n****\tPure Lisp storage exhausted!\n" - "\tPurespace usage: %ld of %ld\n" - "****", - (long) get_PURESIZE() + pure_lossage, - (long) get_PURESIZE()); - if (die_if_pure_storage_exceeded) - { - puresize_adjust_h (get_PURESIZE() + pure_lossage); -#ifdef HEAP_IN_DATA - sheap_adjust_h(); -#endif - rc = -1; - } - } - else - { - size_t lost = (get_PURESIZE() - pure_bytes_used) / 1024; - char buf[200]; - /* extern Lisp_Object Vemacs_beta_version; */ - /* This used to be NILP(Vemacs_beta_version) ? 512 : 4; */ -#ifndef PURESIZE_SLOP -#define PURESIZE_SLOP 0 -#endif - size_t slop = PURESIZE_SLOP; - - sprintf (buf, "Purespace usage: %ld of %ld (%d%%", - (long) pure_bytes_used, - (long) get_PURESIZE(), - (int) (pure_bytes_used / (get_PURESIZE() / 100.0) + 0.5)); - if (lost > ((slop ? slop : 1) / 1024)) { - sprintf (buf + strlen (buf), " -- %ldk wasted", (long)lost); - if (die_if_pure_storage_exceeded) { - puresize_adjust_h (pure_bytes_used + slop); -#ifdef HEAP_IN_DATA - sheap_adjust_h(); -#endif - rc = -1; - } - } - - strcat (buf, ")."); - message ("%s", buf); - } - -#ifdef PURESTAT - - purestat_vector_other.nbytes = - purestat_vector_all.nbytes - - purestat_vector_constants.nbytes; - purestat_vector_other.nobjects = - purestat_vector_all.nobjects - - purestat_vector_constants.nobjects; - - purestat_string_other.nbytes = - purestat_string_all.nbytes - - (purestat_string_pname.nbytes + - purestat_string_interactive.nbytes + - purestat_string_documentation.nbytes + -#ifdef I18N3 - purestat_string_domain.nbytes + -#endif - purestat_string_other_function.nbytes); - - purestat_string_other.nobjects = - purestat_string_all.nobjects - - (purestat_string_pname.nobjects + - purestat_string_interactive.nobjects + - purestat_string_documentation.nobjects + -#ifdef I18N3 - purestat_string_domain.nobjects + -#endif - purestat_string_other_function.nobjects); - - message (" %-34s Objects Bytes", ""); - - print_purestat (&purestat_cons); - print_purestat (&purestat_float); - print_purestat (&purestat_string_pname); - print_purestat (&purestat_function); - print_purestat (&purestat_opaque_instructions); - print_purestat (&purestat_vector_constants); - print_purestat (&purestat_string_interactive); -#ifdef I18N3 - print_purestat (&purestat_string_domain); -#endif - print_purestat (&purestat_string_documentation); - print_purestat (&purestat_string_other_function); - print_purestat (&purestat_vector_other); - print_purestat (&purestat_string_other); - print_purestat (&purestat_string_all); - print_purestat (&purestat_vector_all); - -#endif /* PURESTAT */ - - - if (report_impurities) - { - Lisp_Object plist; - struct gcpro gcpro1; - plist = XCAR (XCDR (XCDR (XCDR (XCDR (XCDR (Fgarbage_collect())))))); - GCPRO1 (plist); - message ("\nImpurities:"); - for (; CONSP (plist); plist = XCDR (XCDR (plist))) - { - Lisp_Object symbol = XCAR (plist); - int size = XINT (XCAR (XCDR (plist))); - if (size > 0) - { - char buf [100]; - char *s = buf; - memcpy (buf, - string_data (XSYMBOL (symbol)->name), - string_length (XSYMBOL (symbol)->name) + 1); - while (*s++) if (*s == '-') *s = ' '; - *(s-1) = ':'; *s = 0; - message (" %-34s %6d", buf, size); - } - } - UNGCPRO; - garbage_collect_1 (); /* collect Fgarbage_collect()'s garbage */ - } - clear_message (); - - if (rc < 0) { - unlink("SATISFIED"); - fatal ("Pure size adjusted, Don't Panic! I will restart the `make'"); - } else if (pure_lossage && die_if_pure_storage_exceeded) { - fatal ("Pure storage exhausted"); - } -} - - -/************************************************************************/ -/* Garbage Collection */ -/************************************************************************/ - -/* This will be used more extensively In The Future */ -static int last_lrecord_type_index_assigned; - -CONST struct lrecord_implementation *lrecord_implementations_table[128]; -#define max_lrecord_type (countof (lrecord_implementations_table) - 1) - -struct gcpro *gcprolist; - -/* 415 used Mly 29-Jun-93 */ -/* 1327 used slb 28-Feb-98 */ -#ifdef HAVE_SHLIB -#define NSTATICS 4000 -#else -#define NSTATICS 2000 -#endif -/* Not "static" because of linker lossage on some systems */ -Lisp_Object *staticvec[NSTATICS] - /* Force it into data space! */ - = {0}; -static int staticidx; - -/* Put an entry in staticvec, pointing at the variable whose address is given - */ -void -staticpro (Lisp_Object *varaddress) -{ - if (staticidx >= countof (staticvec)) - /* #### This is now a dubious abort() since this routine may be called */ - /* by Lisp attempting to load a DLL. */ - abort (); - staticvec[staticidx++] = varaddress; -} - - -/* Mark reference to a Lisp_Object. If the object referred to has not been - seen yet, recursively mark all the references contained in it. */ - -static void -mark_object (Lisp_Object obj) -{ - tail_recurse: - -#ifdef ERROR_CHECK_GC - assert (! (GC_EQ (obj, Qnull_pointer))); -#endif - /* Checks we used to perform */ - /* if (EQ (obj, Qnull_pointer)) return; */ - /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return; */ - /* if (PURIFIED (XPNTR (obj))) return; */ - - switch (XGCTYPE (obj)) - { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: - { - struct Lisp_Cons *ptr = XCONS (obj); - if (PURIFIED (ptr)) - break; - if (CONS_MARKED_P (ptr)) - break; - MARK_CONS (ptr); - /* If the cdr is nil, tail-recurse on the car. */ - if (GC_NILP (ptr->cdr)) - { - obj = ptr->car; - } - else - { - mark_object (ptr->car); - obj = ptr->cdr; - } - goto tail_recurse; - } -#endif - - case Lisp_Type_Record: - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); -#if defined (ERROR_CHECK_GC) && defined (USE_INDEXED_LRECORD_IMPLEMENTATION) - assert (lheader->type <= last_lrecord_type_index_assigned); -#endif - if (PURIFIED (lheader)) - return; - - if (! MARKED_RECORD_HEADER_P (lheader) && - ! UNMARKABLE_RECORD_HEADER_P (lheader)) - { - CONST struct lrecord_implementation *implementation = - LHEADER_IMPLEMENTATION (lheader); - MARK_RECORD_HEADER (lheader); -#ifdef ERROR_CHECK_GC - if (!implementation->basic_p) - assert (! ((struct lcrecord_header *) lheader)->free); -#endif - if (implementation->marker) - { - obj = implementation->marker (obj, mark_object); - if (!GC_NILP (obj)) goto tail_recurse; - } - } - } - break; - -#ifndef LRECORD_STRING - case Lisp_Type_String: - { - struct Lisp_String *ptr = XSTRING (obj); - if (PURIFIED (ptr)) - return; - - if (!XMARKBIT (ptr->plist)) - { - if (CONSP (ptr->plist) && - EXTENT_INFOP (XCAR (ptr->plist))) - flush_cached_extent_info (XCAR (ptr->plist)); - XMARK (ptr->plist); - obj = ptr->plist; - goto tail_recurse; - } - } - break; -#endif /* ! LRECORD_STRING */ - -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: - { - struct Lisp_Vector *ptr = XVECTOR (obj); - int len, i; - - if (PURIFIED (ptr)) - return; - - len = vector_length (ptr); - - if (len < 0) - break; /* Already marked */ - ptr->size = -1 - len; /* Else mark it */ - for (i = 0; i < len - 1; i++) /* and then mark its elements */ - mark_object (ptr->contents[i]); - if (len > 0) - { - obj = ptr->contents[len - 1]; - goto tail_recurse; - } - } - break; -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: - { - struct Lisp_Symbol *sym = XSYMBOL (obj); - - if (PURIFIED (sym)) - return; - - while (!XMARKBIT (sym->plist)) - { - XMARK (sym->plist); - mark_object (sym->value); - mark_object (sym->function); - { - /* - * symbol->name is a struct Lisp_String *, not a - * Lisp_Object. Fix it up and pass to mark_object. - */ - Lisp_Object symname; - XSETSTRING (symname, sym->name); - mark_object (symname); - } - if (!symbol_next (sym)) - { - obj = sym->plist; - goto tail_recurse; - } - mark_object (sym->plist); - /* Mark the rest of the symbols in the hash-chain */ - sym = symbol_next (sym); - } - } - break; -#endif /* !LRECORD_SYMBOL */ - - /* Check for invalid Lisp_Object types */ -#if defined (ERROR_CHECK_GC) && ! defined (USE_MINIMAL_TAGBITS) - case Lisp_Type_Int: - case Lisp_Type_Char: - break; - default: - abort(); - break; -#endif /* ERROR_CHECK_GC && ! USE_MINIMAL_TAGBITS */ - } -} - -/* mark all of the conses in a list and mark the final cdr; but - DO NOT mark the cars. - - Use only for internal lists! There should never be other pointers - to the cons cells, because if so, the cars will remain unmarked - even when they maybe should be marked. */ -void -mark_conses_in_list (Lisp_Object obj) -{ - Lisp_Object rest; - - for (rest = obj; CONSP (rest); rest = XCDR (rest)) - { - if (CONS_MARKED_P (XCONS (rest))) - return; - MARK_CONS (XCONS (rest)); - } - - mark_object (rest); -} - - -#ifdef PURESTAT -/* Simpler than mark-object, because pure structure can't - have any circularities */ - -static size_t -pure_string_sizeof (Lisp_Object obj) -{ - struct Lisp_String *ptr = XSTRING (obj); - - if (string_data (ptr) != (Bufbyte *) ptr + sizeof (*ptr)) - { - /* string-data not allocated contiguously. - Probably (better be!!) a pointer constant "C" data. */ - return sizeof (*ptr); - } - else - { - size_t size = sizeof (*ptr) + string_length (ptr) + 1; - size = ALIGN_SIZE (size, sizeof (Lisp_Object)); - return size; - } -} - -static size_t -pure_sizeof (Lisp_Object obj) -{ - if (!POINTER_TYPE_P (XTYPE (obj)) - || !PURIFIED (XPNTR (obj))) - return 0; - /* symbol sizes are accounted for separately */ - else if (SYMBOLP (obj)) - return 0; - else if (STRINGP (obj)) - return pure_string_sizeof (obj); - else if (LRECORDP (obj)) - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); - CONST struct lrecord_implementation *implementation - = LHEADER_IMPLEMENTATION (lheader); - - return implementation->size_in_bytes_method - ? implementation->size_in_bytes_method (lheader) - : implementation->static_size; - } -#ifndef LRECORD_VECTOR - else if (VECTORP (obj)) - return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, XVECTOR_LENGTH (obj)); -#endif /* !LRECORD_VECTOR */ - -#ifndef LRECORD_CONS - else if (CONSP (obj)) - return sizeof (struct Lisp_Cons); -#endif /* !LRECORD_CONS */ - else - /* Others can't be purified */ - abort (); - return 0; /* unreached */ -} -#endif /* PURESTAT */ - - - - -/* Find all structures not marked, and free them. */ - -#ifndef LRECORD_VECTOR -static int gc_count_num_vector_used, gc_count_vector_total_size; -static int gc_count_vector_storage; -#endif -static int gc_count_num_bit_vector_used, gc_count_bit_vector_total_size; -static int gc_count_bit_vector_storage; -static int gc_count_num_short_string_in_use; -static int gc_count_string_total_size; -static int gc_count_short_string_total_size; - -/* static int gc_count_total_records_used, gc_count_records_total_size; */ - - -int -lrecord_type_index (CONST struct lrecord_implementation *implementation) -{ - int type_index = *(implementation->lrecord_type_index); - /* Have to do this circuitous validation test because of problems - dumping out initialized variables (ie can't set xxx_type_index to -1 - because that would make xxx_type_index read-only in a dumped emacs. */ - if (type_index < 0 || type_index > max_lrecord_type - || lrecord_implementations_table[type_index] != implementation) - { - assert (last_lrecord_type_index_assigned < max_lrecord_type); - type_index = ++last_lrecord_type_index_assigned; - lrecord_implementations_table[type_index] = implementation; - *(implementation->lrecord_type_index) = type_index; - } - return type_index; -} - -/* stats on lcrecords in use - kinda kludgy */ - -static struct -{ - int instances_in_use; - int bytes_in_use; - int instances_freed; - int bytes_freed; - int instances_on_free_list; -} lcrecord_stats [countof (lrecord_implementations_table)]; - -static void -tick_lcrecord_stats (CONST struct lrecord_header *h, int free_p) -{ - CONST struct lrecord_implementation *implementation = - LHEADER_IMPLEMENTATION (h); - int type_index = lrecord_type_index (implementation); - - if (((struct lcrecord_header *) h)->free) - { - assert (!free_p); - lcrecord_stats[type_index].instances_on_free_list++; - } - else - { - size_t sz = (implementation->size_in_bytes_method - ? implementation->size_in_bytes_method (h) - : implementation->static_size); - - if (free_p) - { - lcrecord_stats[type_index].instances_freed++; - lcrecord_stats[type_index].bytes_freed += sz; - } - else - { - lcrecord_stats[type_index].instances_in_use++; - lcrecord_stats[type_index].bytes_in_use += sz; - } - } -} - - -/* Free all unmarked records */ -static void -sweep_lcrecords_1 (struct lcrecord_header **prev, int *used) -{ - struct lcrecord_header *header; - int num_used = 0; - /* int total_size = 0; */ - - xzero (lcrecord_stats); /* Reset all statistics to 0. */ - - /* First go through and call all the finalize methods. - Then go through and free the objects. There used to - be only one loop here, with the call to the finalizer - occurring directly before the xfree() below. That - is marginally faster but much less safe -- if the - finalize method for an object needs to reference any - other objects contained within it (and many do), - we could easily be screwed by having already freed that - other object. */ - - for (header = *prev; header; header = header->next) - { - struct lrecord_header *h = &(header->lheader); - if (!MARKED_RECORD_HEADER_P (h) && ! (header->free)) - { - if (LHEADER_IMPLEMENTATION (h)->finalizer) - LHEADER_IMPLEMENTATION (h)->finalizer (h, 0); - } - } - - for (header = *prev; header; ) - { - struct lrecord_header *h = &(header->lheader); - if (MARKED_RECORD_HEADER_P (h)) - { - UNMARK_RECORD_HEADER (h); - num_used++; - /* total_size += n->implementation->size_in_bytes (h);*/ - prev = &(header->next); - header = *prev; - tick_lcrecord_stats (h, 0); - } - else - { - struct lcrecord_header *next = header->next; - *prev = next; - tick_lcrecord_stats (h, 1); - /* used to call finalizer right here. */ - xfree (header); - header = next; - } - } - *used = num_used; - /* *total = total_size; */ -} - -#ifndef LRECORD_VECTOR - -static void -sweep_vectors_1 (Lisp_Object *prev, - int *used, int *total, int *storage) -{ - Lisp_Object vector; - int num_used = 0; - int total_size = 0; - int total_storage = 0; - - for (vector = *prev; VECTORP (vector); ) - { - Lisp_Vector *v = XVECTOR (vector); - int len = v->size; - if (len < 0) /* marked */ - { - len = - (len + 1); - v->size = len; - total_size += len; - total_storage += - MALLOC_OVERHEAD + - STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len + 1); - num_used++; - prev = &(vector_next (v)); - vector = *prev; - } - else - { - Lisp_Object next = vector_next (v); - *prev = next; - xfree (v); - vector = next; - } - } - *used = num_used; - *total = total_size; - *storage = total_storage; -} - -#endif /* ! LRECORD_VECTOR */ - -static void -sweep_bit_vectors_1 (Lisp_Object *prev, - int *used, int *total, int *storage) -{ - Lisp_Object bit_vector; - int num_used = 0; - int total_size = 0; - int total_storage = 0; - - /* BIT_VECTORP fails because the objects are marked, which changes - their implementation */ - for (bit_vector = *prev; !EQ (bit_vector, Qzero); ) - { - Lisp_Bit_Vector *v = XBIT_VECTOR (bit_vector); - int len = v->size; - if (MARKED_RECORD_P (bit_vector)) - { - UNMARK_RECORD_HEADER (&(v->lheader)); - total_size += len; - total_storage += - MALLOC_OVERHEAD + - STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, - BIT_VECTOR_LONG_STORAGE (len)); - num_used++; - prev = &(bit_vector_next (v)); - bit_vector = *prev; - } - else - { - Lisp_Object next = bit_vector_next (v); - *prev = next; - xfree (v); - bit_vector = next; - } - } - *used = num_used; - *total = total_size; - *storage = total_storage; -} - -/* And the Lord said: Thou shalt use the `c-backslash-region' command - to make macros prettier. */ - -#ifdef ERROR_CHECK_GC - -#define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \ -do { \ - struct typename##_block *SFTB_current; \ - struct typename##_block **SFTB_prev; \ - int SFTB_limit; \ - int num_free = 0, num_used = 0; \ - \ - for (SFTB_prev = ¤t_##typename##_block, \ - SFTB_current = current_##typename##_block, \ - SFTB_limit = current_##typename##_block_index; \ - SFTB_current; \ - ) \ - { \ - int SFTB_iii; \ - \ - for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \ - { \ - obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \ - \ - if (FREE_STRUCT_P (SFTB_victim)) \ - { \ - num_free++; \ - } \ - else if (!MARKED_##typename##_P (SFTB_victim)) \ - { \ - num_free++; \ - FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ - } \ - else \ - { \ - num_used++; \ - UNMARK_##typename (SFTB_victim); \ - } \ - } \ - SFTB_prev = &(SFTB_current->prev); \ - SFTB_current = SFTB_current->prev; \ - SFTB_limit = countof (current_##typename##_block->block); \ - } \ - \ - gc_count_num_##typename##_in_use = num_used; \ - gc_count_num_##typename##_freelist = num_free; \ -} while (0) - -#else /* !ERROR_CHECK_GC */ - -#define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \ -do { \ - struct typename##_block *SFTB_current; \ - struct typename##_block **SFTB_prev; \ - int SFTB_limit; \ - int num_free = 0, num_used = 0; \ - \ - typename##_free_list = 0; \ - \ - for (SFTB_prev = ¤t_##typename##_block, \ - SFTB_current = current_##typename##_block, \ - SFTB_limit = current_##typename##_block_index; \ - SFTB_current; \ - ) \ - { \ - int SFTB_iii; \ - int SFTB_empty = 1; \ - obj_type *SFTB_old_free_list = typename##_free_list; \ - \ - for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \ - { \ - obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \ - \ - if (FREE_STRUCT_P (SFTB_victim)) \ - { \ - num_free++; \ - PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \ - } \ - else if (!MARKED_##typename##_P (SFTB_victim)) \ - { \ - num_free++; \ - FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ - } \ - else \ - { \ - SFTB_empty = 0; \ - num_used++; \ - UNMARK_##typename (SFTB_victim); \ - } \ - } \ - if (!SFTB_empty) \ - { \ - SFTB_prev = &(SFTB_current->prev); \ - SFTB_current = SFTB_current->prev; \ - } \ - else if (SFTB_current == current_##typename##_block \ - && !SFTB_current->prev) \ - { \ - /* No real point in freeing sole allocation block */ \ - break; \ - } \ - else \ - { \ - struct typename##_block *SFTB_victim_block = SFTB_current; \ - if (SFTB_victim_block == current_##typename##_block) \ - current_##typename##_block_index \ - = countof (current_##typename##_block->block); \ - SFTB_current = SFTB_current->prev; \ - { \ - *SFTB_prev = SFTB_current; \ - xfree (SFTB_victim_block); \ - /* Restore free list to what it was before victim was swept */ \ - typename##_free_list = SFTB_old_free_list; \ - num_free -= SFTB_limit; \ - } \ - } \ - SFTB_limit = countof (current_##typename##_block->block); \ - } \ - \ - gc_count_num_##typename##_in_use = num_used; \ - gc_count_num_##typename##_freelist = num_free; \ -} while (0) - -#endif /* !ERROR_CHECK_GC */ - - - - -static void -sweep_conses (void) -{ -#ifndef LRECORD_CONS -# define MARKED_cons_P(ptr) XMARKBIT ((ptr)->car) -# define UNMARK_cons(ptr) do { XUNMARK ((ptr)->car); } while (0) -#else /* LRECORD_CONS */ -# define MARKED_cons_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_cons(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#endif /* LRECORD_CONS */ -#define ADDITIONAL_FREE_cons(ptr) - - SWEEP_FIXED_TYPE_BLOCK (cons, struct Lisp_Cons); -} - -/* Explicitly free a cons cell. */ -void -free_cons (struct Lisp_Cons *ptr) -{ -#ifdef ERROR_CHECK_GC - /* If the CAR is not an int, then it will be a pointer, which will - always be four-byte aligned. If this cons cell has already been - placed on the free list, however, its car will probably contain - a chain pointer to the next cons on the list, which has cleverly - had all its 0's and 1's inverted. This allows for a quick - check to make sure we're not freeing something already freed. */ - if (POINTER_TYPE_P (XTYPE (ptr->car))) - ASSERT_VALID_POINTER (XPNTR (ptr->car)); -#endif /* ERROR_CHECK_GC */ - -#ifndef ALLOC_NO_POOLS - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, struct Lisp_Cons, ptr); -#endif /* ALLOC_NO_POOLS */ -} - -/* explicitly free a list. You **must make sure** that you have - created all the cons cells that make up this list and that there - are no pointers to any of these cons cells anywhere else. If there - are, you will lose. */ - -void -free_list (Lisp_Object list) -{ - Lisp_Object rest, next; - - for (rest = list; !NILP (rest); rest = next) - { - next = XCDR (rest); - free_cons (XCONS (rest)); - } -} - -/* explicitly free an alist. You **must make sure** that you have - created all the cons cells that make up this alist and that there - are no pointers to any of these cons cells anywhere else. If there - are, you will lose. */ - -void -free_alist (Lisp_Object alist) -{ - Lisp_Object rest, next; - - for (rest = alist; !NILP (rest); rest = next) - { - next = XCDR (rest); - free_cons (XCONS (XCAR (rest))); - free_cons (XCONS (rest)); - } -} - -static void -sweep_compiled_functions (void) -{ -#define MARKED_compiled_function_P(ptr) \ - MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -#define UNMARK_compiled_function(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_compiled_function(ptr) - - SWEEP_FIXED_TYPE_BLOCK (compiled_function, Lisp_Compiled_Function); -} - - -#ifdef LISP_FLOAT_TYPE -static void -sweep_floats (void) -{ -#define MARKED_float_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -#define UNMARK_float(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_float(ptr) - - SWEEP_FIXED_TYPE_BLOCK (float, struct Lisp_Float); -} -#endif /* LISP_FLOAT_TYPE */ - -static void -sweep_symbols (void) -{ -#ifndef LRECORD_SYMBOL -# define MARKED_symbol_P(ptr) XMARKBIT ((ptr)->plist) -# define UNMARK_symbol(ptr) do { XUNMARK ((ptr)->plist); } while (0) -#else -# define MARKED_symbol_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_symbol(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#endif /* !LRECORD_SYMBOL */ -#define ADDITIONAL_FREE_symbol(ptr) - - SWEEP_FIXED_TYPE_BLOCK (symbol, struct Lisp_Symbol); -} - -static void -sweep_extents (void) -{ -#define MARKED_extent_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -#define UNMARK_extent(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_extent(ptr) - - SWEEP_FIXED_TYPE_BLOCK (extent, struct extent); -} - -static void -sweep_events (void) -{ -#define MARKED_event_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -#define UNMARK_event(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_event(ptr) - - SWEEP_FIXED_TYPE_BLOCK (event, struct Lisp_Event); -} - -static void -sweep_markers (void) -{ -#define MARKED_marker_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -#define UNMARK_marker(ptr) UNMARK_RECORD_HEADER (&((ptr)->lheader)) -#define ADDITIONAL_FREE_marker(ptr) \ - do { Lisp_Object tem; \ - XSETMARKER (tem, ptr); \ - unchain_marker (tem); \ - } while (0) - - SWEEP_FIXED_TYPE_BLOCK (marker, struct Lisp_Marker); -} - -/* Explicitly free a marker. */ -void -free_marker (struct Lisp_Marker *ptr) -{ -#ifdef ERROR_CHECK_GC - /* Perhaps this will catch freeing an already-freed marker. */ - Lisp_Object temmy; - XSETMARKER (temmy, ptr); - assert (GC_MARKERP (temmy)); -#endif /* ERROR_CHECK_GC */ - -#ifndef ALLOC_NO_POOLS - FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, struct Lisp_Marker, ptr); -#endif /* ALLOC_NO_POOLS */ -} - - -#if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) - -static void -verify_string_chars_integrity (void) -{ - struct string_chars_block *sb; - - /* Scan each existing string block sequentially, string by string. */ - for (sb = first_string_chars_block; sb; sb = sb->next) - { - int pos = 0; - /* POS is the index of the next string in the block. */ - while (pos < sb->pos) - { - struct string_chars *s_chars = - (struct string_chars *) &(sb->string_chars[pos]); - struct Lisp_String *string; - int size; - int fullsize; - - /* If the string_chars struct is marked as free (i.e. the STRING - pointer is 0xFFFFFFFF) then this is an unused chunk of string - storage. (See below.) */ - - if (FREE_STRUCT_P (s_chars)) - { - fullsize = ((struct unused_string_chars *) s_chars)->fullsize; - pos += fullsize; - continue; - } - - string = s_chars->string; - /* Must be 32-bit aligned. */ - assert ((((int) string) & 3) == 0); - - size = string_length (string); - fullsize = STRING_FULLSIZE (size); - - assert (!BIG_STRING_FULLSIZE_P (fullsize)); - assert (string_data (string) == s_chars->chars); - pos += fullsize; - } - assert (pos == sb->pos); - } -} - -#endif /* MULE && ERROR_CHECK_GC */ - -/* Compactify string chars, relocating the reference to each -- - free any empty string_chars_block we see. */ -static void -compact_string_chars (void) -{ - struct string_chars_block *to_sb = first_string_chars_block; - int to_pos = 0; - struct string_chars_block *from_sb; - - /* Scan each existing string block sequentially, string by string. */ - for (from_sb = first_string_chars_block; from_sb; from_sb = from_sb->next) - { - int from_pos = 0; - /* FROM_POS is the index of the next string in the block. */ - while (from_pos < from_sb->pos) - { - struct string_chars *from_s_chars = - (struct string_chars *) &(from_sb->string_chars[from_pos]); - struct string_chars *to_s_chars; - struct Lisp_String *string; - int size; - int fullsize; - - /* If the string_chars struct is marked as free (i.e. the STRING - pointer is 0xFFFFFFFF) then this is an unused chunk of string - storage. This happens under Mule when a string's size changes - in such a way that its fullsize changes. (Strings can change - size because a different-length character can be substituted - for another character.) In this case, after the bogus string - pointer is the "fullsize" of this entry, i.e. how many bytes - to skip. */ - - if (FREE_STRUCT_P (from_s_chars)) - { - fullsize = ((struct unused_string_chars *) from_s_chars)->fullsize; - from_pos += fullsize; - continue; - } - - string = from_s_chars->string; - assert (!(FREE_STRUCT_P (string))); - - size = string_length (string); - fullsize = STRING_FULLSIZE (size); - - if (BIG_STRING_FULLSIZE_P (fullsize)) - abort (); - - /* Just skip it if it isn't marked. */ -#ifdef LRECORD_STRING - if (! MARKED_RECORD_HEADER_P (&(string->lheader))) -#else - if (!XMARKBIT (string->plist)) -#endif - { - from_pos += fullsize; - continue; - } - - /* If it won't fit in what's left of TO_SB, close TO_SB out - and go on to the next string_chars_block. We know that TO_SB - cannot advance past FROM_SB here since FROM_SB is large enough - to currently contain this string. */ - if ((to_pos + fullsize) > countof (to_sb->string_chars)) - { - to_sb->pos = to_pos; - to_sb = to_sb->next; - to_pos = 0; - } - - /* Compute new address of this string - and update TO_POS for the space being used. */ - to_s_chars = (struct string_chars *) &(to_sb->string_chars[to_pos]); - - /* Copy the string_chars to the new place. */ - if (from_s_chars != to_s_chars) - memmove (to_s_chars, from_s_chars, fullsize); - - /* Relocate FROM_S_CHARS's reference */ - set_string_data (string, &(to_s_chars->chars[0])); - - from_pos += fullsize; - to_pos += fullsize; - } - } - - /* Set current to the last string chars block still used and - free any that follow. */ - { - struct string_chars_block *victim; - - for (victim = to_sb->next; victim; ) - { - struct string_chars_block *next = victim->next; - xfree (victim); - victim = next; - } - - current_string_chars_block = to_sb; - current_string_chars_block->pos = to_pos; - current_string_chars_block->next = 0; - } -} - -#if 1 /* Hack to debug missing purecopy's */ -static int debug_string_purity; - -static void -debug_string_purity_print (struct Lisp_String *p) -{ - Charcount i; - Charcount s = string_char_length (p); - putc ('\"', stderr); - for (i = 0; i < s; i++) - { - Emchar ch = string_char (p, i); - if (ch < 32 || ch >= 126) - stderr_out ("\\%03o", ch); - else if (ch == '\\' || ch == '\"') - stderr_out ("\\%c", ch); - else - stderr_out ("%c", ch); - } - stderr_out ("\"\n"); -} -#endif /* 1 */ - - -static void -sweep_strings (void) -{ - int num_small_used = 0, num_small_bytes = 0, num_bytes = 0; - int debug = debug_string_purity; - -#ifdef LRECORD_STRING - -# define MARKED_string_P(ptr) MARKED_RECORD_HEADER_P (&((ptr)->lheader)) -# define UNMARK_string(ptr) \ - do { struct Lisp_String *p = (ptr); \ - int size = string_length (p); \ - UNMARK_RECORD_HEADER (&(p->lheader)); \ - num_bytes += size; \ - if (!BIG_STRING_SIZE_P (size)) \ - { num_small_bytes += size; \ - num_small_used++; \ - } \ - if (debug) debug_string_purity_print (p); \ - } while (0) -# define ADDITIONAL_FREE_string(p) \ - do { int size = string_length (p); \ - if (BIG_STRING_SIZE_P (size)) \ - xfree_1 (CHARS_TO_STRING_CHAR (string_data (p))); \ - } while (0) - -#else - -# define MARKED_string_P(ptr) XMARKBIT ((ptr)->plist) -# define UNMARK_string(ptr) \ - do { struct Lisp_String *p = (ptr); \ - int size = string_length (p); \ - XUNMARK (p->plist); \ - num_bytes += size; \ - if (!BIG_STRING_SIZE_P (size)) \ - { num_small_bytes += size; \ - num_small_used++; \ - } \ - if (debug) debug_string_purity_print (p); \ - } while (0) -# define ADDITIONAL_FREE_string(p) \ - do { int size = string_length (p); \ - if (BIG_STRING_SIZE_P (size)) \ - xfree_1 (CHARS_TO_STRING_CHAR (string_data (p))); \ - } while (0) - -#endif /* ! LRECORD_STRING */ - - SWEEP_FIXED_TYPE_BLOCK (string, struct Lisp_String); - - gc_count_num_short_string_in_use = num_small_used; - gc_count_string_total_size = num_bytes; - gc_count_short_string_total_size = num_small_bytes; -} - - -/* I hate duplicating all this crap! */ -static int -marked_p (Lisp_Object obj) -{ -#ifdef ERROR_CHECK_GC - assert (! (GC_EQ (obj, Qnull_pointer))); -#endif - /* Checks we used to perform. */ - /* if (EQ (obj, Qnull_pointer)) return 1; */ - /* if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1; */ - /* if (PURIFIED (XPNTR (obj))) return 1; */ - - switch (XGCTYPE (obj)) - { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: - { - struct Lisp_Cons *ptr = XCONS (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->car); - } -#endif - case Lisp_Type_Record: - { - struct lrecord_header *lheader = XRECORD_LHEADER (obj); -#if defined (ERROR_CHECK_GC) && defined (USE_INDEXED_LRECORD_IMPLEMENTATION) - assert (lheader->type <= last_lrecord_type_index_assigned); -#endif - return PURIFIED (lheader) || MARKED_RECORD_HEADER_P (lheader); - } -#ifndef LRECORD_STRING - case Lisp_Type_String: - { - struct Lisp_String *ptr = XSTRING (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->plist); - } -#endif /* ! LRECORD_STRING */ -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: - { - struct Lisp_Vector *ptr = XVECTOR (obj); - return PURIFIED (ptr) || vector_length (ptr) < 0; - } -#endif /* !LRECORD_VECTOR */ -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: - { - struct Lisp_Symbol *ptr = XSYMBOL (obj); - return PURIFIED (ptr) || XMARKBIT (ptr->plist); - } -#endif - - /* Ints and Chars don't need GC */ -#if defined (USE_MINIMAL_TAGBITS) || ! defined (ERROR_CHECK_GC) - default: - return 1; -#else - default: - abort(); - case Lisp_Type_Int: - case Lisp_Type_Char: - return 1; -#endif - } -} - -static void -gc_sweep (void) -{ - /* Free all unmarked records. Do this at the very beginning, - before anything else, so that the finalize methods can safely - examine items in the objects. sweep_lcrecords_1() makes - sure to call all the finalize methods *before* freeing anything, - to complete the safety. */ - { - int ignored; - sweep_lcrecords_1 (&all_lcrecords, &ignored); - } - - compact_string_chars (); - - /* Finalize methods below (called through the ADDITIONAL_FREE_foo - macros) must be *extremely* careful to make sure they're not - referencing freed objects. The only two existing finalize - methods (for strings and markers) pass muster -- the string - finalizer doesn't look at anything but its own specially- - created block, and the marker finalizer only looks at live - buffers (which will never be freed) and at the markers before - and after it in the chain (which, by induction, will never be - freed because if so, they would have already removed themselves - from the chain). */ - - /* Put all unmarked strings on free list, free'ing the string chars - of large unmarked strings */ - sweep_strings (); - - /* Put all unmarked conses on free list */ - sweep_conses (); - -#ifndef LRECORD_VECTOR - /* Free all unmarked vectors */ - sweep_vectors_1 (&all_vectors, - &gc_count_num_vector_used, &gc_count_vector_total_size, - &gc_count_vector_storage); -#endif - - /* Free all unmarked bit vectors */ - sweep_bit_vectors_1 (&all_bit_vectors, - &gc_count_num_bit_vector_used, - &gc_count_bit_vector_total_size, - &gc_count_bit_vector_storage); - - /* Free all unmarked compiled-function objects */ - sweep_compiled_functions (); - -#ifdef LISP_FLOAT_TYPE - /* Put all unmarked floats on free list */ - sweep_floats (); -#endif - - /* Put all unmarked symbols on free list */ - sweep_symbols (); - - /* Put all unmarked extents on free list */ - sweep_extents (); - - /* Put all unmarked markers on free list. - Dechain each one first from the buffer into which it points. */ - sweep_markers (); - - sweep_events (); - -} - -/* Clearing for disksave. */ - -void -disksave_object_finalization (void) -{ - /* It's important that certain information from the environment not get - dumped with the executable (pathnames, environment variables, etc.). - To make it easier to tell when this has happened with strings(1) we - clear some known-to-be-garbage blocks of memory, so that leftover - results of old evaluation don't look like potential problems. - But first we set some notable variables to nil and do one more GC, - to turn those strings into garbage. - */ - - /* Yeah, this list is pretty ad-hoc... */ - Vprocess_environment = Qnil; - Vexec_directory = Qnil; - Vdata_directory = Qnil; - Vsite_directory = Qnil; - Vdoc_directory = Qnil; - Vconfigure_info_directory = Qnil; - Vexec_path = Qnil; - Vload_path = Qnil; - /* Vdump_load_path = Qnil; */ - uncache_home_directory(); - -#if defined(LOADHIST) && !(defined(LOADHIST_DUMPED) || \ - defined(LOADHIST_BUILTIN)) - Vload_history = Qnil; -#endif - Vshell_file_name = Qnil; - - garbage_collect_1 (); - - /* Run the disksave finalization methods of all live objects. */ - disksave_object_finalization_1 (); - -#if 0 /* I don't see any point in this. The purespace starts out all 0's */ - /* Zero out the unused portion of purespace */ - if (!pure_lossage) - memset ( (char *) (PUREBEG + pure_bytes_used), 0, - (((char *) (PUREBEG + get_PURESIZE())) - - ((char *) (PUREBEG + pure_bytes_used)))); -#endif - - /* Zero out the uninitialized (really, unused) part of the containers - for the live strings. */ - { - struct string_chars_block *scb; - for (scb = first_string_chars_block; scb; scb = scb->next) - { - int count = sizeof (scb->string_chars) - scb->pos; - - assert (count >= 0 && count < STRING_CHARS_BLOCK_SIZE); - if (count != 0) { - /* from the block's fill ptr to the end */ - memset ((scb->string_chars + scb->pos), 0, count); - } - } - } - - /* There, that ought to be enough... */ - -} - - -Lisp_Object -restore_gc_inhibit (Lisp_Object val) -{ - gc_currently_forbidden = XINT (val); - return val; -} - -/* Maybe we want to use this when doing a "panic" gc after memory_full()? */ -static int gc_hooks_inhibited; - - -void -garbage_collect_1 (void) -{ -#if MAX_SAVE_STACK > 0 - char stack_top_variable; - extern char *stack_bottom; -#endif - int i; - struct frame *f; - int speccount; - int cursor_changed; - Lisp_Object pre_gc_cursor; - struct gcpro gcpro1; - - if (gc_in_progress - || gc_currently_forbidden - || in_display - || preparing_for_armageddon) - return; - - /* We used to call selected_frame() here. - - The following functions cannot be called inside GC - so we move to after the above tests. */ - { - Lisp_Object frame; - Lisp_Object device = Fselected_device (Qnil); - if (NILP (device)) /* Could happen during startup, eg. if always_gc */ - return; - frame = DEVICE_SELECTED_FRAME (XDEVICE (device)); - if (NILP (frame)) - signal_simple_error ("No frames exist on device", device); - f = XFRAME (frame); - } - - pre_gc_cursor = Qnil; - cursor_changed = 0; - - GCPRO1 (pre_gc_cursor); - - /* Very important to prevent GC during any of the following - stuff that might run Lisp code; otherwise, we'll likely - have infinite GC recursion. */ - speccount = specpdl_depth (); - record_unwind_protect (restore_gc_inhibit, - make_int (gc_currently_forbidden)); - gc_currently_forbidden = 1; - - if (!gc_hooks_inhibited) - run_hook_trapping_errors ("Error in pre-gc-hook", Qpre_gc_hook); - - /* Now show the GC cursor/message. */ - if (!noninteractive) - { - if (FRAME_WIN_P (f)) - { - Lisp_Object frame = make_frame (f); - Lisp_Object cursor = glyph_image_instance (Vgc_pointer_glyph, - FRAME_SELECTED_WINDOW (f), - ERROR_ME_NOT, 1); - pre_gc_cursor = f->pointer; - if (POINTER_IMAGE_INSTANCEP (cursor) - /* don't change if we don't know how to change back. */ - && POINTER_IMAGE_INSTANCEP (pre_gc_cursor)) - { - cursor_changed = 1; - Fset_frame_pointer (frame, cursor); - } - } - - /* Don't print messages to the stream device. */ - if (!cursor_changed && !FRAME_STREAM_P (f)) - { - char *msg = (STRINGP (Vgc_message) - ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) - : 0); - Lisp_Object args[2], whole_msg; - args[0] = build_string (msg ? msg : - GETTEXT ((CONST char *) gc_default_message)); - args[1] = build_string ("..."); - whole_msg = Fconcat (2, args); - echo_area_message (f, (Bufbyte *) 0, whole_msg, 0, -1, - Qgarbage_collecting); - } - } - - /***** Now we actually start the garbage collection. */ - - gc_in_progress = 1; - - gc_generation_number[0]++; - -#if MAX_SAVE_STACK > 0 - - /* Save a copy of the contents of the stack, for debugging. */ - if (!purify_flag) - { - /* Static buffer in which we save a copy of the C stack at each GC. */ - static char *stack_copy; - static size_t stack_copy_size; - - ptrdiff_t stack_diff = &stack_top_variable - stack_bottom; - size_t stack_size = (stack_diff > 0 ? stack_diff : -stack_diff); - if (stack_size < MAX_SAVE_STACK) - { - if (stack_copy_size < stack_size) - { - stack_copy = (char *) xrealloc (stack_copy, stack_size); - stack_copy_size = stack_size; - } - - memcpy (stack_copy, - stack_diff > 0 ? stack_bottom : &stack_top_variable, - stack_size); - } - } -#endif /* MAX_SAVE_STACK > 0 */ - - /* Do some totally ad-hoc resource clearing. */ - /* #### generalize this? */ - clear_event_resource (); - cleanup_specifiers (); - - /* Mark all the special slots that serve as the roots of accessibility. */ - { - struct gcpro *tail; - struct catchtag *catch; - struct backtrace *backlist; - struct specbinding *bind; - - for (i = 0; i < staticidx; i++) - { - mark_object (*(staticvec[i])); - } - - for (tail = gcprolist; tail; tail = tail->next) - { - for (i = 0; i < tail->nvars; i++) - mark_object (tail->var[i]); - } - - for (bind = specpdl; bind != specpdl_ptr; bind++) - { - mark_object (bind->symbol); - mark_object (bind->old_value); - } - - for (catch = catchlist; catch; catch = catch->next) - { - mark_object (catch->tag); - mark_object (catch->val); - } - - for (backlist = backtrace_list; backlist; backlist = backlist->next) - { - int nargs = backlist->nargs; - - mark_object (*backlist->function); - if (nargs == UNEVALLED || nargs == MANY) - mark_object (backlist->args[0]); - else - for (i = 0; i < nargs; i++) - mark_object (backlist->args[i]); - } - - mark_redisplay (mark_object); - mark_profiling_info (mark_object); - } - - /* OK, now do the after-mark stuff. This is for things that - are only marked when something else is marked (e.g. weak hash tables). - There may be complex dependencies between such objects -- e.g. - a weak hash table might be unmarked, but after processing a later - weak hash table, the former one might get marked. So we have to - iterate until nothing more gets marked. */ - - while (finish_marking_weak_hash_tables (marked_p, mark_object) > 0 || - finish_marking_weak_lists (marked_p, mark_object) > 0) - ; - - /* And prune (this needs to be called after everything else has been - marked and before we do any sweeping). */ - /* #### this is somewhat ad-hoc and should probably be an object - method */ - prune_weak_hash_tables (marked_p); - prune_weak_lists (marked_p); - prune_specifiers (marked_p); - prune_syntax_tables (marked_p); - - gc_sweep (); - - consing_since_gc = 0; -#ifndef DEBUG_XEMACS - /* Allow you to set it really fucking low if you really want ... */ - if (gc_cons_threshold < 10000) - gc_cons_threshold = 10000; -#endif - - gc_in_progress = 0; - - /******* End of garbage collection ********/ - - run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook); - - /* Now remove the GC cursor/message */ - if (!noninteractive) - { - if (cursor_changed) - Fset_frame_pointer (make_frame (f), pre_gc_cursor); - else if (!FRAME_STREAM_P (f)) - { - char *msg = (STRINGP (Vgc_message) - ? GETTEXT ((char *) XSTRING_DATA (Vgc_message)) - : 0); - - /* Show "...done" only if the echo area would otherwise be empty. */ - if (NILP (clear_echo_area (selected_frame (), - Qgarbage_collecting, 0))) - { - Lisp_Object args[2], whole_msg; - args[0] = build_string (msg ? msg : - GETTEXT ((CONST char *) - gc_default_message)); - args[1] = build_string ("... done"); - whole_msg = Fconcat (2, args); - echo_area_message (selected_frame (), (Bufbyte *) 0, - whole_msg, 0, -1, - Qgarbage_collecting); - } - } - } - - /* now stop inhibiting GC */ - unbind_to (speccount, Qnil); - - if (!breathing_space) - { - breathing_space = malloc (4096 - MALLOC_OVERHEAD); - } - - UNGCPRO; - return; -} - -/* Debugging aids. */ - -static Lisp_Object -gc_plist_hack (CONST char *name, int value, Lisp_Object tail) -{ - /* C doesn't have local functions (or closures, or GC, or readable syntax, - or portable numeric datatypes, or bit-vectors, or characters, or - arrays, or exceptions, or ...) */ - return cons3 (intern (name), make_int (value), tail); -} - -#define HACK_O_MATIC(type, name, pl) do { \ - int s = 0; \ - struct type##_block *x = current_##type##_block; \ - while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ - (pl) = gc_plist_hack ((name), s, (pl)); \ -} while (0) - -DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* -Reclaim storage for Lisp objects no longer needed. -Return info on amount of space in use: - ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) - (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS - PLIST) - where `PLIST' is a list of alternating keyword/value pairs providing - more detailed information. -Garbage collection happens automatically if you cons more than -`gc-cons-threshold' bytes of Lisp data since previous garbage collection. -*/ - ()) -{ - Lisp_Object pl = Qnil; - int i; -#ifdef LRECORD_VECTOR - int gc_count_vector_total_size = 0; -#endif - - if (purify_flag && pure_lossage) - return Qnil; - - garbage_collect_1 (); - - for (i = 0; i < last_lrecord_type_index_assigned; i++) - { - if (lcrecord_stats[i].bytes_in_use != 0 - || lcrecord_stats[i].bytes_freed != 0 - || lcrecord_stats[i].instances_on_free_list != 0) - { - char buf [255]; - CONST char *name = lrecord_implementations_table[i]->name; - int len = strlen (name); -#ifdef LRECORD_VECTOR - /* save this for the FSFmacs-compatible part of the summary */ - if (i == *lrecord_vector[0].lrecord_type_index) - gc_count_vector_total_size = - lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed; -#endif - sprintf (buf, "%s-storage", name); - pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); - /* Okay, simple pluralization check for `symbol-value-varalias' */ - if (name[len-1] == 's') - sprintf (buf, "%ses-freed", name); - else - sprintf (buf, "%ss-freed", name); - if (lcrecord_stats[i].instances_freed != 0) - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_freed, pl); - if (name[len-1] == 's') - sprintf (buf, "%ses-on-free-list", name); - else - sprintf (buf, "%ss-on-free-list", name); - if (lcrecord_stats[i].instances_on_free_list != 0) - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_on_free_list, - pl); - if (name[len-1] == 's') - sprintf (buf, "%ses-used", name); - else - sprintf (buf, "%ss-used", name); - pl = gc_plist_hack (buf, lcrecord_stats[i].instances_in_use, pl); - } - } - - HACK_O_MATIC (extent, "extent-storage", pl); - pl = gc_plist_hack ("extents-free", gc_count_num_extent_freelist, pl); - pl = gc_plist_hack ("extents-used", gc_count_num_extent_in_use, pl); - HACK_O_MATIC (event, "event-storage", pl); - pl = gc_plist_hack ("events-free", gc_count_num_event_freelist, pl); - pl = gc_plist_hack ("events-used", gc_count_num_event_in_use, pl); - HACK_O_MATIC (marker, "marker-storage", pl); - pl = gc_plist_hack ("markers-free", gc_count_num_marker_freelist, pl); - pl = gc_plist_hack ("markers-used", gc_count_num_marker_in_use, pl); -#ifdef LISP_FLOAT_TYPE - HACK_O_MATIC (float, "float-storage", pl); - pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl); - pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl); -#endif /* LISP_FLOAT_TYPE */ - HACK_O_MATIC (string, "string-header-storage", pl); - pl = gc_plist_hack ("long-strings-total-length", - gc_count_string_total_size - - gc_count_short_string_total_size, pl); - HACK_O_MATIC (string_chars, "short-string-storage", pl); - pl = gc_plist_hack ("short-strings-total-length", - gc_count_short_string_total_size, pl); - pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl); - pl = gc_plist_hack ("long-strings-used", - gc_count_num_string_in_use - - gc_count_num_short_string_in_use, pl); - pl = gc_plist_hack ("short-strings-used", - gc_count_num_short_string_in_use, pl); - - HACK_O_MATIC (compiled_function, "compiled-function-storage", pl); - pl = gc_plist_hack ("compiled-functions-free", - gc_count_num_compiled_function_freelist, pl); - pl = gc_plist_hack ("compiled-functions-used", - gc_count_num_compiled_function_in_use, pl); - -#ifndef LRECORD_VECTOR - pl = gc_plist_hack ("vector-storage", gc_count_vector_storage, pl); - pl = gc_plist_hack ("vectors-total-length", - gc_count_vector_total_size, pl); - pl = gc_plist_hack ("vectors-used", gc_count_num_vector_used, pl); -#endif - - pl = gc_plist_hack ("bit-vector-storage", gc_count_bit_vector_storage, pl); - pl = gc_plist_hack ("bit-vectors-total-length", - gc_count_bit_vector_total_size, pl); - pl = gc_plist_hack ("bit-vectors-used", gc_count_num_bit_vector_used, pl); - - HACK_O_MATIC (symbol, "symbol-storage", pl); - pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl); - pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl); - - HACK_O_MATIC (cons, "cons-storage", pl); - pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl); - pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl); - - /* The things we do for backwards-compatibility */ - return - list6 (Fcons (make_int (gc_count_num_cons_in_use), - make_int (gc_count_num_cons_freelist)), - Fcons (make_int (gc_count_num_symbol_in_use), - make_int (gc_count_num_symbol_freelist)), - Fcons (make_int (gc_count_num_marker_in_use), - make_int (gc_count_num_marker_freelist)), - make_int (gc_count_string_total_size), - make_int (gc_count_vector_total_size), - pl); -} -#undef HACK_O_MATIC - -DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* -Return the number of bytes consed since the last garbage collection. -\"Consed\" is a misnomer in that this actually counts allocation -of all different kinds of objects, not just conses. - -If this value exceeds `gc-cons-threshold', a garbage collection happens. -*/ - ()) -{ - return make_int (consing_since_gc); -} - -DEFUN ("memory-limit", Fmemory_limit, 0, 0, "", /* -Return the address of the last byte Emacs has allocated, divided by 1024. -This may be helpful in debugging Emacs's memory usage. -The value is divided by 1024 to make sure it will fit in a lisp integer. -*/ - ()) -{ - return make_int ((EMACS_INT) sbrk (0) / 1024); -} - - - -int -object_dead_p (Lisp_Object obj) -{ - return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) || - (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) || - (WINDOWP (obj) && !WINDOW_LIVE_P (XWINDOW (obj))) || - (DEVICEP (obj) && !DEVICE_LIVE_P (XDEVICE (obj))) || - (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) || - (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) || - (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj)))); -} - -#ifdef MEMORY_USAGE_STATS - -/* Attempt to determine the actual amount of space that is used for - the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE". - - It seems that the following holds: - - 1. When using the old allocator (malloc.c): - - -- blocks are always allocated in chunks of powers of two. For - each block, there is an overhead of 8 bytes if rcheck is not - defined, 20 bytes if it is defined. In other words, a - one-byte allocation needs 8 bytes of overhead for a total of - 9 bytes, and needs to have 16 bytes of memory chunked out for - it. - - 2. When using the new allocator (gmalloc.c): - - -- blocks are always allocated in chunks of powers of two up - to 4096 bytes. Larger blocks are allocated in chunks of - an integral multiple of 4096 bytes. The minimum block - size is 2*sizeof (void *), or 16 bytes if SUNOS_LOCALTIME_BUG - is defined. There is no per-block overhead, but there - is an overhead of 3*sizeof (size_t) for each 4096 bytes - allocated. - - 3. When using the system malloc, anything goes, but they are - generally slower and more space-efficient than the GNU - allocators. One possibly reasonable assumption to make - for want of better data is that sizeof (void *), or maybe - 2 * sizeof (void *), is required as overhead and that - blocks are allocated in the minimum required size except - that some minimum block size is imposed (e.g. 16 bytes). */ - -size_t -malloced_storage_size (void *ptr, size_t claimed_size, - struct overhead_stats *stats) -{ - size_t orig_claimed_size = claimed_size; - -#ifdef GNU_MALLOC - - if (claimed_size < 2 * sizeof (void *)) - claimed_size = 2 * sizeof (void *); -# ifdef SUNOS_LOCALTIME_BUG - if (claimed_size < 16) - claimed_size = 16; -# endif - if (claimed_size < 4096) - { - int log = 1; - - /* compute the log base two, more or less, then use it to compute - the block size needed. */ - claimed_size--; - /* It's big, it's heavy, it's wood! */ - while ((claimed_size /= 2) != 0) - ++log; - claimed_size = 1; - /* It's better than bad, it's good! */ - while (log > 0) - { - claimed_size *= 2; - log--; - } - /* We have to come up with some average about the amount of - blocks used. */ - if ((size_t) (rand () & 4095) < claimed_size) - claimed_size += 3 * sizeof (void *); - } - else - { - claimed_size += 4095; - claimed_size &= ~4095; - claimed_size += (claimed_size / 4096) * 3 * sizeof (size_t); - } - -#elif defined (SYSTEM_MALLOC) - - if (claimed_size < 16) - claimed_size = 16; - claimed_size += 2 * sizeof (void *); - -#else /* old GNU allocator */ - -# ifdef rcheck /* #### may not be defined here */ - claimed_size += 20; -# else - claimed_size += 8; -# endif - { - int log = 1; - - /* compute the log base two, more or less, then use it to compute - the block size needed. */ - claimed_size--; - /* It's big, it's heavy, it's wood! */ - while ((claimed_size /= 2) != 0) - ++log; - claimed_size = 1; - /* It's better than bad, it's good! */ - while (log > 0) - { - claimed_size *= 2; - log--; - } - } - -#endif /* old GNU allocator */ - - if (stats) - { - stats->was_requested += orig_claimed_size; - stats->malloc_overhead += claimed_size - orig_claimed_size; - } - return claimed_size; -} - -size_t -fixed_type_block_overhead (size_t size) -{ - size_t per_block = TYPE_ALLOC_SIZE (cons, unsigned char); - size_t overhead = 0; - size_t storage_size = malloced_storage_size (0, per_block, 0); - while (size >= per_block) - { - size -= per_block; - overhead += sizeof (void *) + per_block - storage_size; - } - if (rand () % per_block < size) - overhead += sizeof (void *) + per_block - storage_size; - return overhead; -} - -#endif /* MEMORY_USAGE_STATS */ - - -/* Initialization */ -void -init_alloc_once_early (void) -{ - int iii; - - last_lrecord_type_index_assigned = -1; - for (iii = 0; iii < countof (lrecord_implementations_table); iii++) - { - lrecord_implementations_table[iii] = 0; - } - -#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION - /* - * If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, all the staticly - * defined subr lrecords were initialized with lheader->type == 0. - * See subr_lheader_initializer in lisp.h. Force type index 0 to be - * assigned to lrecord_subr so that those predefined indexes match - * reality. - */ - lrecord_type_index (lrecord_subr); - assert (*(lrecord_subr[0].lrecord_type_index) == 0); - /* - * The same is true for symbol_value_forward objects, except the - * type is 1. - */ - lrecord_type_index (lrecord_symbol_value_forward); - assert (*(lrecord_symbol_value_forward[0].lrecord_type_index) == 1); -#endif /* USE_INDEXED_LRECORD_IMPLEMENTATION */ - - symbols_initialized = 0; - - gc_generation_number[0] = 0; - /* purify_flag 1 is correct even if CANNOT_DUMP. - * loadup.el will set to nil at end. */ - purify_flag = 1; - pure_bytes_used = 0; - pure_lossage = 0; - breathing_space = 0; -#ifndef LRECORD_VECTOR - XSETINT (all_vectors, 0); /* Qzero may not be set yet. */ -#endif - XSETINT (all_bit_vectors, 0); /* Qzero may not be set yet. */ - XSETINT (Vgc_message, 0); - all_lcrecords = 0; - ignore_malloc_warnings = 1; -#ifdef DOUG_LEA_MALLOC - mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ - mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */ -#if 0 /* Moved to emacs.c */ - mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */ -#endif -#endif - init_string_alloc (); - init_string_chars_alloc (); - init_cons_alloc (); - init_symbol_alloc (); - init_compiled_function_alloc (); -#ifdef LISP_FLOAT_TYPE - init_float_alloc (); -#endif /* LISP_FLOAT_TYPE */ - init_marker_alloc (); - init_extent_alloc (); - init_event_alloc (); - - ignore_malloc_warnings = 0; - staticidx = 0; - consing_since_gc = 0; -#if 1 - gc_cons_threshold = 500000; /* XEmacs change */ -#else - gc_cons_threshold = 15000; /* debugging */ -#endif -#ifdef VIRT_ADDR_VARIES - malloc_sbrk_unused = 1<<22; /* A large number */ - malloc_sbrk_used = 100000; /* as reasonable as any number */ -#endif /* VIRT_ADDR_VARIES */ - lrecord_uid_counter = 259; - debug_string_purity = 0; - gcprolist = 0; - - gc_currently_forbidden = 0; - gc_hooks_inhibited = 0; - -#ifdef ERROR_CHECK_TYPECHECK - ERROR_ME.really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = - 666; - ERROR_ME_NOT. - really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = 42; - ERROR_ME_WARN. - really_unlikely_name_to_have_accidentally_in_a_non_errb_structure = - 3333632; -#endif /* ERROR_CHECK_TYPECHECK */ -} - -void -reinit_alloc (void) -{ - gcprolist = 0; -} - -void -syms_of_alloc (void) -{ - defsymbol (&Qpre_gc_hook, "pre-gc-hook"); - defsymbol (&Qpost_gc_hook, "post-gc-hook"); - defsymbol (&Qgarbage_collecting, "garbage-collecting"); - - DEFSUBR (Fcons); - DEFSUBR (Flist); - DEFSUBR (Fvector); - DEFSUBR (Fbit_vector); - DEFSUBR (Fmake_byte_code); - DEFSUBR (Fmake_list); - DEFSUBR (Fmake_vector); - DEFSUBR (Fmake_bit_vector); - DEFSUBR (Fmake_string); - DEFSUBR (Fstring); - DEFSUBR (Fmake_symbol); - DEFSUBR (Fmake_marker); - DEFSUBR (Fpurecopy); - DEFSUBR (Fgarbage_collect); - DEFSUBR (Fmemory_limit); - DEFSUBR (Fconsing_since_gc); -} - -void -vars_of_alloc (void) -{ - DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold /* -*Number of bytes of consing between garbage collections. -\"Consing\" is a misnomer in that this actually counts allocation -of all different kinds of objects, not just conses. -Garbage collection can happen automatically once this many bytes have been -allocated since the last garbage collection. All data types count. - -Garbage collection happens automatically when `eval' or `funcall' are -called. (Note that `funcall' is called implicitly as part of evaluation.) -By binding this temporarily to a large number, you can effectively -prevent garbage collection during a part of the program. - -See also `consing-since-gc'. -*/ ); - - DEFVAR_INT ("pure-bytes-used", &pure_bytes_used /* -Number of bytes of sharable Lisp data allocated so far. -*/ ); - -#if 0 - DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used /* -Number of bytes of unshared memory allocated in this session. -*/ ); - - DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused /* -Number of bytes of unshared memory remaining available in this session. -*/ ); -#endif - -#ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-allocation", &debug_allocation /* -If non-zero, print out information to stderr about all objects allocated. -See also `debug-allocation-backtrace-length'. -*/ ); - debug_allocation = 0; - - DEFVAR_INT ("debug-allocation-backtrace-length", - &debug_allocation_backtrace_length /* -Length (in stack frames) of short backtrace printed out by `debug-allocation'. -*/ ); - debug_allocation_backtrace_length = 2; -#endif - - DEFVAR_BOOL ("purify-flag", &purify_flag /* -Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. -*/ ); - - DEFVAR_LISP ("pre-gc-hook", &Vpre_gc_hook /* -Function or functions to be run just before each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, avoid -consing, and do not interact with the user. -*/ ); - Vpre_gc_hook = Qnil; - - DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook /* -Function or functions to be run just after each garbage collection. -Interrupts, garbage collection, and errors are inhibited while this hook -runs, so be extremely careful in what you add here. In particular, avoid -consing, and do not interact with the user. -*/ ); - Vpost_gc_hook = Qnil; - - DEFVAR_LISP ("gc-message", &Vgc_message /* -String to print to indicate that a garbage collection is in progress. -This is printed in the echo area. If the selected frame is on a -window system and `gc-pointer-glyph' specifies a value (i.e. a pointer -image instance) in the domain of the selected frame, the mouse pointer -will change instead of this message being printed. -*/ ); - Vgc_message = make_pure_string ((CONST Bufbyte *) gc_default_message, - countof (gc_default_message) - 1, - Qnil, 1); - - DEFVAR_LISP ("gc-pointer-glyph", &Vgc_pointer_glyph /* -Pointer glyph used to indicate that a garbage collection is in progress. -If the selected window is on a window system and this glyph specifies a -value (i.e. a pointer image instance) in the domain of the selected -window, the pointer will be changed as specified during garbage collection. -Otherwise, a message will be printed in the echo area, as controlled -by `gc-message'. -*/ ); -} - -void -complex_vars_of_alloc (void) -{ - Vgc_pointer_glyph = Fmake_glyph_internal (Qpointer); -} diff --git a/src/alloca.c b/src/alloca.c deleted file mode 100644 index d2f7f0c..0000000 --- a/src/alloca.c +++ /dev/null @@ -1,513 +0,0 @@ -/* alloca.c -- allocate automatically reclaimed memory - (Mostly) portable public-domain implementation -- D A Gwyn - - This implementation of the PWB library alloca function, - which is used to allocate space off the run-time stack so - that it is automatically reclaimed upon procedure exit, - was inspired by discussions with J. Q. Johnson of Cornell. - J.Otto Tennant contributed the Cray support. - - There are some preprocessor constants that can - be defined when compiling for your specific system, for - improved efficiency; however, the defaults should be okay. - - The general concept of this implementation is to keep - track of all alloca-allocated blocks, and reclaim any - that are found to be deeper in the stack than the current - invocation. This heuristic does not reclaim storage as - soon as it becomes invalid, but it will do so eventually. - - As a special case, alloca(0) reclaims storage without - allocating any. It is a good idea to use alloca(0) in - your main control loop, etc. to force garbage collection. */ - -/* Synched up with: FSF 19.30. */ - -/* Authorsip: - - FSF: A long time ago. - Very few changes for XEmacs. - */ - -#ifdef HAVE_CONFIG_H -#include -#endif - -/* XEmacs: If compiling with GCC 2, this file is theoretically not needed. - However, alloca() is broken under GCC 2 on many machines: you - cannot put a call to alloca() as part of an argument to a function. - */ -/* If someone has defined alloca as a macro, - there must be some other way alloca is supposed to work. */ -/* XEmacs sometimes uses the C alloca even when a builtin alloca is available, - because it's safer. */ -#if defined (EMACS_WANTS_C_ALLOCA) || (!defined (alloca) && (!defined (__GNUC__) || __GNUC__ < 2)) - -#ifdef emacs -#ifdef static -/* actually, only want this if static is defined as "" - -- this is for usg, in which emacs must undefine static - in order to make unexec workable - */ -#ifndef STACK_DIRECTION -you -lose --- must know STACK_DIRECTION at compile-time -#endif /* STACK_DIRECTION undefined */ -#endif /* static */ -#endif /* emacs */ - -/* If your stack is a linked list of frames, you have to - provide an "address metric" ADDRESS_FUNCTION macro. */ - -#if defined (CRAY) && defined (CRAY_STACKSEG_END) -long i00afunc (); -#define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) -#else -#define ADDRESS_FUNCTION(arg) &(arg) -#endif - -#ifdef __STDC__ /* XEmacs change */ -typedef void *pointer; -#else -typedef char *pointer; -#endif - -/* XEmacs: With ERROR_CHECK_MALLOC defined, there is no xfree -- it's - a macro that does some stuff to try and trap invalid frees, - and then calls xfree_1 to actually do the work. */ - -#ifdef emacs -# ifdef ERROR_CHECK_MALLOC -void xfree_1 (pointer); -# define xfree xfree_1 -# else -void xfree (pointer); -# endif -#endif - -#ifndef WINDOWSNT -#define NULL 0 -#endif - -/* Different portions of Emacs need to call different versions of - malloc. The Emacs executable needs alloca to call xmalloc, because - ordinary malloc isn't protected from input signals. On the other - hand, the utilities in lib-src need alloca to call malloc; some of - them are very simple, and don't have an xmalloc routine. - - Non-Emacs programs expect this to call use xmalloc. - - Callers below should use malloc. */ - -#ifndef emacs -#define malloc xmalloc -#endif -#ifndef WINDOWSNT -extern pointer malloc (); -#else -extern void *malloc(); -#endif - -/* Define STACK_DIRECTION if you know the direction of stack - growth for your system; otherwise it will be automatically - deduced at run-time. - - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ - -#ifndef STACK_DIRECTION -#define STACK_DIRECTION 0 /* Direction unknown. */ -#endif - -#if STACK_DIRECTION != 0 - -#define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ - -#else /* STACK_DIRECTION == 0; need run-time code. */ - -static int stack_dir; /* 1 or -1 once known. */ -#define STACK_DIR stack_dir - -static void -find_stack_direction () -{ - static char *addr = NULL; /* Address of first `dummy', once known. */ - auto char dummy; /* To get stack address. */ - - if (addr == NULL) - { /* Initial entry. */ - addr = ADDRESS_FUNCTION (dummy); - - find_stack_direction (); /* Recurse once. */ - } - else - { - /* Second entry. */ - if (ADDRESS_FUNCTION (dummy) > addr) - stack_dir = 1; /* Stack grew upward. */ - else - stack_dir = -1; /* Stack grew downward. */ - } -} - -#endif /* STACK_DIRECTION == 0 */ - -/* An "alloca header" is used to: - (a) chain together all alloca'ed blocks; - (b) keep track of stack depth. - - It is very important that sizeof(header) agree with malloc - alignment chunk size. The following default should work okay. */ - -#ifndef ALIGN_SIZE -#define ALIGN_SIZE sizeof(double) -#endif - -typedef union hdr -{ - char align[ALIGN_SIZE]; /* To force sizeof(header). */ - struct - { - union hdr *next; /* For chaining headers. */ - char *deep; /* For stack depth measure. */ - } h; -} header; - -static header *last_alloca_header = NULL; /* -> last alloca header. */ - -/* Return a pointer to at least SIZE bytes of storage, - which will be automatically reclaimed upon exit from - the procedure that called alloca. Originally, this space - was supposed to be taken from the current stack frame of the - caller, but that method cannot be made to work for some - implementations of C, for example under Gould's UTX/32. */ - -pointer -#ifdef EMACS_WANTS_C_ALLOCA -c_alloca (size) -#else -alloca (size) -#endif - unsigned size; -{ - auto char probe; /* Probes stack depth: */ - REGISTER char *depth = ADDRESS_FUNCTION (probe); - -#if STACK_DIRECTION == 0 - if (STACK_DIR == 0) /* Unknown growth direction. */ - find_stack_direction (); -#endif - - /* Reclaim garbage, defined as all alloca'd storage that - was allocated from deeper in the stack than currently. */ - - { - REGISTER header *hp; /* Traverses linked list. */ - - for (hp = last_alloca_header; hp != NULL;) - if ((STACK_DIR > 0 && hp->h.deep > depth) - || (STACK_DIR < 0 && hp->h.deep < depth)) - { - REGISTER header *np = hp->h.next; - - free ((pointer) hp); /* Collect garbage. */ - - hp = np; /* -> next header. */ - } - else - break; /* Rest are not deeper. */ - - last_alloca_header = hp; /* -> last valid storage. */ - } - - if (size == 0) - return NULL; /* No allocation required. */ - - /* Allocate combined header + user data storage. */ - - { - REGISTER pointer new = malloc (sizeof (header) + size); - /* Address of header. */ - - ((header *) new)->h.next = last_alloca_header; - ((header *) new)->h.deep = depth; - - last_alloca_header = (header *) new; - - /* User storage begins just after header. */ - - return (pointer) ((char *) new + sizeof (header)); - } -} - -#if defined (CRAY) && defined (CRAY_STACKSEG_END) - -#ifdef DEBUG_I00AFUNC -#include -#endif - -#ifndef CRAY_STACK -#define CRAY_STACK -#ifndef CRAY2 -/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ -struct stack_control_header - { - long shgrow:32; /* Number of times stack has grown. */ - long shaseg:32; /* Size of increments to stack. */ - long shhwm:32; /* High water mark of stack. */ - long shsize:32; /* Current size of stack (all segments). */ - }; - -/* The stack segment linkage control information occurs at - the high-address end of a stack segment. (The stack - grows from low addresses to high addresses.) The initial - part of the stack segment linkage control information is - 0200 (octal) words. This provides for register storage - for the routine which overflows the stack. */ - -struct stack_segment_linkage - { - long ss[0200]; /* 0200 overflow words. */ - long sssize:32; /* Number of words in this segment. */ - long ssbase:32; /* Offset to stack base. */ - long:32; - long sspseg:32; /* Offset to linkage control of previous - segment of stack. */ - long:32; - long sstcpt:32; /* Pointer to task common address block. */ - long sscsnm; /* Private control structure number for - microtasking. */ - long ssusr1; /* Reserved for user. */ - long ssusr2; /* Reserved for user. */ - long sstpid; /* Process ID for pid based multi-tasking. */ - long ssgvup; /* Pointer to multitasking thread giveup. */ - long sscray[7]; /* Reserved for Cray Research. */ - long ssa0; - long ssa1; - long ssa2; - long ssa3; - long ssa4; - long ssa5; - long ssa6; - long ssa7; - long sss0; - long sss1; - long sss2; - long sss3; - long sss4; - long sss5; - long sss6; - long sss7; - }; - -#else /* CRAY2 */ -/* The following structure defines the vector of words - returned by the STKSTAT library routine. */ -struct stk_stat - { - long now; /* Current total stack size. */ - long maxc; /* Amount of contiguous space which would - be required to satisfy the maximum - stack demand to date. */ - long high_water; /* Stack high-water mark. */ - long overflows; /* Number of stack overflow ($STKOFEN) calls. */ - long hits; /* Number of internal buffer hits. */ - long extends; /* Number of block extensions. */ - long stko_mallocs; /* Block allocations by $STKOFEN. */ - long underflows; /* Number of stack underflow calls ($STKRETN). */ - long stko_free; /* Number of deallocations by $STKRETN. */ - long stkm_free; /* Number of deallocations by $STKMRET. */ - long segments; /* Current number of stack segments. */ - long maxs; /* Maximum number of stack segments so far. */ - long pad_size; /* Stack pad size. */ - long current_address; /* Current stack segment address. */ - long current_size; /* Current stack segment size. This - number is actually corrupted by STKSTAT to - include the fifteen word trailer area. */ - long initial_address; /* Address of initial segment. */ - long initial_size; /* Size of initial segment. */ - }; - -/* The following structure describes the data structure which trails - any stack segment. I think that the description in 'asdef' is - out of date. I only describe the parts that I am sure about. */ - -struct stk_trailer - { - long this_address; /* Address of this block. */ - long this_size; /* Size of this block (does not include - this trailer). */ - long unknown2; - long unknown3; - long link; /* Address of trailer block of previous - segment. */ - long unknown5; - long unknown6; - long unknown7; - long unknown8; - long unknown9; - long unknown10; - long unknown11; - long unknown12; - long unknown13; - long unknown14; - }; - -#endif /* CRAY2 */ -#endif /* not CRAY_STACK */ - -#ifdef CRAY2 -/* Determine a "stack measure" for an arbitrary ADDRESS. - I doubt that "lint" will like this much. */ - -static long -i00afunc (long *address) -{ - struct stk_stat status; - struct stk_trailer *trailer; - long *block, size; - long result = 0; - - /* We want to iterate through all of the segments. The first - step is to get the stack status structure. We could do this - more quickly and more directly, perhaps, by referencing the - $LM00 common block, but I know that this works. */ - - STKSTAT (&status); - - /* Set up the iteration. */ - - trailer = (struct stk_trailer *) (status.current_address - + status.current_size - - 15); - - /* There must be at least one stack segment. Therefore it is - a fatal error if "trailer" is null. */ - - if (trailer == 0) - abort (); - - /* Discard segments that do not contain our argument address. */ - - while (trailer != 0) - { - block = (long *) trailer->this_address; - size = trailer->this_size; - if (block == 0 || size == 0) - abort (); - trailer = (struct stk_trailer *) trailer->link; - if ((block <= address) && (address < (block + size))) - break; - } - - /* Set the result to the offset in this segment and add the sizes - of all predecessor segments. */ - - result = address - block; - - if (trailer == 0) - { - return result; - } - - do - { - if (trailer->this_size <= 0) - abort (); - result += trailer->this_size; - trailer = (struct stk_trailer *) trailer->link; - } - while (trailer != 0); - - /* We are done. Note that if you present a bogus address (one - not in any segment), you will get a different number back, formed - from subtracting the address of the first block. This is probably - not what you want. */ - - return (result); -} - -#else /* not CRAY2 */ -/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. - Determine the number of the cell within the stack, - given the address of the cell. The purpose of this - routine is to linearize, in some sense, stack addresses - for alloca. */ - -static long -i00afunc (long address) -{ - long stkl = 0; - - long size, pseg, this_segment, stack; - long result = 0; - - struct stack_segment_linkage *ssptr; - - /* Register B67 contains the address of the end of the - current stack segment. If you (as a subprogram) store - your registers on the stack and find that you are past - the contents of B67, you have overflowed the segment. - - B67 also points to the stack segment linkage control - area, which is what we are really interested in. */ - - stkl = CRAY_STACKSEG_END (); - ssptr = (struct stack_segment_linkage *) stkl; - - /* If one subtracts 'size' from the end of the segment, - one has the address of the first word of the segment. - - If this is not the first segment, 'pseg' will be - nonzero. */ - - pseg = ssptr->sspseg; - size = ssptr->sssize; - - this_segment = stkl - size; - - /* It is possible that calling this routine itself caused - a stack overflow. Discard stack segments which do not - contain the target address. */ - - while (!(this_segment <= address && address <= stkl)) - { -#ifdef DEBUG_I00AFUNC - fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); -#endif - if (pseg == 0) - break; - stkl = stkl - pseg; - ssptr = (struct stack_segment_linkage *) stkl; - size = ssptr->sssize; - pseg = ssptr->sspseg; - this_segment = stkl - size; - } - - result = address - this_segment; - - /* If you subtract pseg from the current end of the stack, - you get the address of the previous stack segment's end. - This seems a little convoluted to me, but I'll bet you save - a cycle somewhere. */ - - while (pseg != 0) - { -#ifdef DEBUG_I00AFUNC - fprintf (stderr, "%011o %011o\n", pseg, size); -#endif - stkl = stkl - pseg; - ssptr = (struct stack_segment_linkage *) stkl; - size = ssptr->sssize; - pseg = ssptr->sspseg; - result += size; - } - return (result); -} - -#endif /* not CRAY2 */ -#endif /* CRAY */ - -#endif /* complicated expression at top of file */ diff --git a/src/backtrace.h b/src/backtrace.h deleted file mode 100644 index 126ac25..0000000 --- a/src/backtrace.h +++ /dev/null @@ -1,326 +0,0 @@ -/* The lisp stack. - Copyright (C) 1985, 1986, 1987, 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: FSF 19.30. Contained redundantly in various C files - in FSFmacs. */ - -/* Authorship: - - FSF: Original version; a long time ago. - XEmacs: split out of some C files. (For some obscure reason, a header - file couldn't be used in FSF Emacs, but XEmacs doesn't have - that problem.) - Mly (probably) or JWZ: Some changes. - */ - -#ifndef _XEMACS_BACKTRACE_H_ -#define _XEMACS_BACKTRACE_H_ - -#include - -/* These definitions are used in eval.c and alloc.c */ - -struct backtrace - { - struct backtrace *next; - Lisp_Object *function; - Lisp_Object *args; /* Points to vector of args. */ - int nargs; /* Length of vector. - If nargs is UNEVALLED, args points to - slot holding list of unevalled args */ - int pdlcount; /* specpdl_depth () when invoked */ - char evalargs; - /* Nonzero means call value of debugger when done with this operation. */ - char debug_on_exit; - }; - -/* This structure helps implement the `catch' and `throw' control - structure. A struct catchtag contains all the information needed - to restore the state of the interpreter after a non-local jump. - - Handlers for error conditions (represented by `struct handler' - structures) just point to a catch tag to do the cleanup required - for their jumps. - - catchtag structures are chained together in the C calling stack; - the `next' member points to the next outer catchtag. - - A call like (throw TAG VAL) searches for a catchtag whose `tag' - member is TAG, and then unbinds to it. The `val' member is used to - hold VAL while the stack is unwound; `val' is returned as the value - of the catch form. - - All the other members are concerned with restoring the interpreter - state. */ - -struct catchtag - { - Lisp_Object tag; - Lisp_Object val; - struct catchtag *next; - struct gcpro *gcpro; - JMP_BUF jmp; - struct backtrace *backlist; -#if 0 /* FSFmacs */ - /* #### */ - struct handler *handlerlist; -#endif - int lisp_eval_depth; - int pdlcount; -#if 0 /* FSFmacs */ - /* This is the equivalent of async_timer_suppress_count. - We probably don't have to bother with this. */ - int poll_suppress_count; -#endif - }; - -/* Dynamic-binding-o-rama */ - -/* Structure for recording Lisp call stack for backtrace purposes. */ - -/* The special binding stack holds the outer values of variables while - they are bound by a function application or a let form, stores the - code to be executed for Lisp unwind-protect forms, and stores the C - functions to be called for record_unwind_protect. - - If func is non-zero, undoing this binding applies func to old_value; - This implements record_unwind_protect. - If func is zero and symbol is nil, undoing this binding evaluates - the list of forms in old_value; this implements Lisp's unwind-protect - form. - Otherwise, undoing this binding stores old_value as symbol's value; this - undoes the bindings made by a let form or function call. */ - -struct specbinding - { - Lisp_Object symbol; - Lisp_Object old_value; - Lisp_Object (*func) (Lisp_Object); /* for unwind-protect */ - }; - -#if 0 /* FSFmacs */ -/* #### */ -/* Everything needed to describe an active condition case. */ -struct handler - { - /* The handler clauses and variable from the condition-case form. */ - Lisp_Object handler; - Lisp_Object var; - /* Fsignal stores here the condition-case clause that applies, - and Fcondition_case thus knows which clause to run. */ - Lisp_Object chosen_clause; - - /* Used to effect the longjmp() out to the handler. */ - struct catchtag *tag; - - /* The next enclosing handler. */ - struct handler *next; - }; - -extern struct handler *handlerlist; - -#endif - -/* These are extern because GC needs to mark them */ -extern struct specbinding *specpdl; -extern struct specbinding *specpdl_ptr; -extern struct catchtag *catchlist; -extern struct backtrace *backtrace_list; - -/* Most callers should simply use specbind() and unbind_to(), but if - speed is REALLY IMPORTANT, you can use the faster macros below */ -void specbind_magic (Lisp_Object, Lisp_Object); -void grow_specpdl (size_t reserved); -void unbind_to_hairy (int); -extern int specpdl_size; - -/* Inline version of specbind(). - Use this instead of specbind() if speed is sufficiently important - to save the overhead of even a single function call. */ -#define SPECBIND(symbol_object, value_object) do { \ - Lisp_Object SB_symbol = (symbol_object); \ - Lisp_Object SB_newval = (value_object); \ - Lisp_Object SB_oldval; \ - struct Lisp_Symbol *SB_sym; \ - \ - SPECPDL_RESERVE (1); \ - \ - CHECK_SYMBOL (SB_symbol); \ - SB_sym = XSYMBOL (SB_symbol); \ - SB_oldval = SB_sym->value; \ - \ - if (!SYMBOL_VALUE_MAGIC_P (SB_oldval) || UNBOUNDP (SB_oldval)) \ - { \ - /* ### the following test will go away when we have a constant \ - symbol magic object */ \ - if (EQ (SB_symbol, Qnil) || \ - EQ (SB_symbol, Qt) || \ - SYMBOL_IS_KEYWORD (SB_symbol)) \ - reject_constant_symbols (SB_symbol, SB_newval, 0, \ - UNBOUNDP (SB_newval) ? \ - Qmakunbound : Qset); \ - \ - specpdl_ptr->symbol = SB_symbol; \ - specpdl_ptr->old_value = SB_oldval; \ - specpdl_ptr->func = 0; \ - specpdl_ptr++; \ - specpdl_depth_counter++; \ - \ - SB_sym->value = (SB_newval); \ - } \ - else \ - specbind_magic (SB_symbol, SB_newval); \ -} while (0) - -/* An even faster, but less safe inline version of specbind(). - Caller guarantees that: - - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword). - - specpdl_depth_counter >= specpdl_size. - Else we crash. */ -#define SPECBIND_FAST_UNSAFE(symbol_object, value_object) do { \ - Lisp_Object SFU_symbol = (symbol_object); \ - Lisp_Object SFU_newval = (value_object); \ - struct Lisp_Symbol *SFU_sym = XSYMBOL (SFU_symbol); \ - Lisp_Object SFU_oldval = SFU_sym->value; \ - if (!SYMBOL_VALUE_MAGIC_P (SFU_oldval) || UNBOUNDP (SFU_oldval)) \ - { \ - specpdl_ptr->symbol = SFU_symbol; \ - specpdl_ptr->old_value = SFU_oldval; \ - specpdl_ptr->func = 0; \ - specpdl_ptr++; \ - specpdl_depth_counter++; \ - \ - SFU_sym->value = (SFU_newval); \ - } \ - else \ - specbind_magic (SFU_symbol, SFU_newval); \ -} while (0) - -/* Request enough room for SIZE future entries on special binding stack */ -#define SPECPDL_RESERVE(size) do { \ - size_t SR_size = (size); \ - if (specpdl_depth() + SR_size >= specpdl_size) \ - grow_specpdl (SR_size); \ -} while (0) - -/* Inline version of unbind_to(). - Use this instead of unbind_to() if speed is sufficiently important - to save the overhead of even a single function call. - - Most of the time, unbind_to() is called only on ordinary - variables, so optimize for that. */ -#define UNBIND_TO_GCPRO(count, value) do { \ - int UNBIND_TO_count = (count); \ - while (specpdl_depth_counter != UNBIND_TO_count) \ - { \ - struct Lisp_Symbol *sym; \ - --specpdl_ptr; \ - --specpdl_depth_counter; \ - \ - if (specpdl_ptr->func != 0 || \ - ((sym = XSYMBOL (specpdl_ptr->symbol)), \ - SYMBOL_VALUE_MAGIC_P (sym->value))) \ - { \ - struct gcpro gcpro1; \ - GCPRO1 (value); \ - unbind_to_hairy (UNBIND_TO_count); \ - UNGCPRO; \ - break; \ - } \ - \ - sym->value = specpdl_ptr->old_value; \ - } \ -} while (0) - -/* A slightly faster inline version of unbind_to, - that doesn't offer GCPROing services. */ -#define UNBIND_TO(count) do { \ - int UNBIND_TO_count = (count); \ - while (specpdl_depth_counter != UNBIND_TO_count) \ - { \ - struct Lisp_Symbol *sym; \ - --specpdl_ptr; \ - --specpdl_depth_counter; \ - \ - if (specpdl_ptr->func != 0 || \ - ((sym = XSYMBOL (specpdl_ptr->symbol)), \ - SYMBOL_VALUE_MAGIC_P (sym->value))) \ - { \ - unbind_to_hairy (UNBIND_TO_count); \ - break; \ - } \ - \ - sym->value = specpdl_ptr->old_value; \ - } \ -} while (0) - -#ifdef ERROR_CHECK_TYPECHECK -#define CHECK_SPECBIND_VARIABLE assert (specpdl_ptr->func == 0) -#else -#define CHECK_SPECBIND_VARIABLE DO_NOTHING -#endif - -#if 0 -/* Unused. It's too hard to guarantee that the current bindings - contain only variables. */ -/* Another inline version of unbind_to(). VALUE is GC-protected. - Caller guarantees that: - - all of the elements on the binding stack are variable bindings. - Else we crash. */ -#define UNBIND_TO_GCPRO_VARIABLES_ONLY(count, value) do { \ - int UNBIND_TO_count = (count); \ - while (specpdl_depth_counter != UNBIND_TO_count) \ - { \ - struct Lisp_Symbol *sym; \ - --specpdl_ptr; \ - --specpdl_depth_counter; \ - \ - CHECK_SPECBIND_VARIABLE; \ - sym = XSYMBOL (specpdl_ptr->symbol); \ - if (!SYMBOL_VALUE_MAGIC_P (sym->value)) \ - sym->value = specpdl_ptr->old_value; \ - else \ - { \ - struct gcpro gcpro1; \ - GCPRO1 (value); \ - unbind_to_hairy (UNBIND_TO_count); \ - UNGCPRO; \ - break; \ - } \ - } \ -} while (0) -#endif /* unused */ - -/* A faster, but less safe inline version of Fset(). - Caller guarantees that: - - SYMBOL is a non-constant symbol (i.e. not Qnil, Qt, or keyword). - Else we crash. */ -#define FSET_FAST_UNSAFE(sym, newval) do { \ - Lisp_Object FFU_sym = (sym); \ - Lisp_Object FFU_newval = (newval); \ - struct Lisp_Symbol *FFU_symbol = XSYMBOL (FFU_sym); \ - Lisp_Object FFU_oldval = FFU_symbol->value; \ - if (!SYMBOL_VALUE_MAGIC_P (FFU_oldval) || UNBOUNDP (FFU_oldval)) \ - FFU_symbol->value = FFU_newval; \ - else \ - Fset (FFU_sym, FFU_newval); \ -} while (0) - -#endif /* _XEMACS_BACKTRACE_H_ */ diff --git a/src/balloon-x.c b/src/balloon-x.c deleted file mode 100644 index 69e1a82..0000000 --- a/src/balloon-x.c +++ /dev/null @@ -1,163 +0,0 @@ -/* - Copyright (c) 1997 Douglas Keller - -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. */ - - -#include -#include "lisp.h" - -#include "device.h" -#include "console-x.h" - -#include "balloon_help.h" - -/* ### start of hack */ - -static unsigned long -alloc_color (Display* dpy, CONST char* colorname, int light) -{ - Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(Vdefault_x_device)); - unsigned long pixel = 0; - XColor color; - - if (XParseColor(dpy, cmap, colorname, &color) && XAllocColor(dpy, cmap, &color)) - { - pixel = color.pixel; - } - else - { - if (light) - { - printf ("Warning: could not allocate color \"%s\", using \"white\"\n", - colorname); - pixel = alloc_color (dpy, "white", True); - } - else - { - printf ("Warning: could not allocate color \"%s\", using \"black\"\n", - colorname); - pixel = alloc_color (dpy, "black", True); - } - } - return pixel; -} - -static XFontStruct * -open_font (Display* dpy, CONST char* font_name) -{ - XFontStruct* fontStruct = NULL; - - fontStruct = XLoadQueryFont (dpy, font_name ? font_name : "fixed"); - if (fontStruct == NULL) - { - printf ("Warning: could not load font \"%s\", using \"fixed\".\n", font_name); - fontStruct = XLoadQueryFont (dpy, "fixed"); - assert (fontStruct != NULL); - } - return fontStruct; -} - -static void -init (void) -{ - static int init_p = 0; - - if (!init_p) - { - Pixel fg, bg, shine, shadow; - XFontStruct* font; - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device)); - - fg = alloc_color (dpy, "grey60", 1); - bg = alloc_color (dpy, "black", 0); - - shine = alloc_color (dpy, "grey80", 1); - shadow = alloc_color (dpy, "grey40", 0); - - font = open_font (dpy, "-adobe-helvetica-medium-r-normal--12-*"); - - balloon_help_create (dpy, bg, fg, shine, shadow, font); - init_p = 1; - } -} - -/* ### end of hack */ - -DEFUN ("show-balloon-help", Fshow_balloon_help, 1, 1, 0, /* -Show balloon help. -*/ - (string)) -{ - char *p; - CHECK_STRING (string); - - p = (char *) XSTRING_DATA (string); - - init (); - - balloon_help_show (p); - - return Qnil; -} - -DEFUN ("hide-balloon-help", Fhide_balloon_help, 0, 0, 0, /* -Hide balloon help. -*/ - ()) -{ - init (); - - balloon_help_hide (); - - return Qnil; -} - -DEFUN ("balloon-help-move-to-pointer", Fballoon_help_move_to_pointer, 0, 0, 0, /* -Move the balloon help to the place where the pointer currently resides. -*/ - ()) -{ - init (); - - balloon_help_move_to_pointer (); - - return Qnil; -} - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_balloon_x (void) -{ - DEFSUBR (Fshow_balloon_help); - DEFSUBR (Fhide_balloon_help); - DEFSUBR (Fballoon_help_move_to_pointer); -} - -void -vars_of_balloon_x (void) -{ - Fprovide (intern ("c-balloon-help")); -} diff --git a/src/balloon_help.c b/src/balloon_help.c deleted file mode 100644 index 8efbbeb..0000000 --- a/src/balloon_help.c +++ /dev/null @@ -1,606 +0,0 @@ -/* Balloon Help - Copyright (c) 1997 Douglas Keller - -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. */ - -/* - * Balloon Help - * - * Version: 1.337 (Sun Apr 13 04:52:10 1997) - * - * Written by Douglas Keller - * - * - */ - -#include -#include -#include -#include - -#include -#include -#include - -#include "xintrinsic.h" - -#include "balloon_help.h" - -#ifndef WINDOWSNT -#define max(x,y) (x>y?x:y) -#endif - -#undef bool -#define bool int - -#define MARGIN_WIDTH 4 -#define POINTER_OFFSET 8 -#define BORDER_WIDTH 2 -#define BORDER_WIDTH_HALF 1 - -#define CONE_HEIGHT 20 -#define CONE_WIDTH 50 - -#define SHAPE_CONE_TOP (1<<0) -#define SHAPE_CONE_LEFT (1<<1) -#define SHAPE_CONE_TOP_LEFT (SHAPE_CONE_TOP | SHAPE_CONE_LEFT) -#define SHAPE_CONE_TOP_RIGHT (SHAPE_CONE_TOP) -#define SHAPE_CONE_BOTTOM_LEFT (SHAPE_CONE_LEFT) -#define SHAPE_CONE_BOTTOM_RIGHT (0) -#define SHAPE_CONE_FREE (-1) - - -static Display* b_dpy; - -static XFontStruct* b_fontStruct; -static GC b_gc; - -static GC b_shineGC; -static GC b_shadowGC; - -static Window b_win; -static bool b_winMapped; - -static Pixmap b_mask; -static int b_maskWidth, b_maskHeight; -static GC b_maskGC; - -static CONST char* b_text; -static int b_width, b_height; - -static XtIntervalId b_timer; -static unsigned long b_delay; - -static int b_screenWidth, b_screenHeight; - -static int b_lastShape; - -/*============================================================================ - -============================================================================*/ - -static GC -create_gc (Display* dpy, Window win, unsigned long fg, unsigned long bg, - XFontStruct* fontStruct) -{ - XGCValues gcv; - unsigned long mask; - - gcv.foreground = fg; - gcv.background = bg; - gcv.font = fontStruct->fid; - gcv.join_style = JoinMiter; - gcv.line_width = BORDER_WIDTH; - - mask = GCFont | GCBackground | GCForeground | GCJoinStyle | GCLineWidth; - - return XCreateGC (dpy, win, mask, &gcv); -} - -static void -destroy_gc (Display* dpy, GC gc) -{ - if (gc) - { - XFreeGC (dpy, gc); - } -} - -/*============================================================================ - -============================================================================*/ - -static Window -create_window (Display* dpy, unsigned long bg) -{ - Window win; - XSetWindowAttributes attr; - unsigned long attr_mask; - - attr_mask = CWOverrideRedirect | CWBackPixel | CWSaveUnder; - attr.override_redirect = True; - attr.background_pixel = bg; - attr.save_under = True; - - win = - XCreateWindow (dpy, - DefaultRootWindow (dpy), - 0, 0, 1, 1, - 0, - CopyFromParent, InputOutput, CopyFromParent, - attr_mask, &attr); - - XSelectInput (dpy, win, - SubstructureRedirectMask | - SubstructureNotifyMask | - ExposureMask | - EnterWindowMask | - LeaveWindowMask); - return win; -} - -static void -destroy_window (Display* dpy, Window win) -{ - if (win) - { - XDestroyWindow (dpy, win); - } -} - -/*============================================================================ - -============================================================================*/ - -static void -get_pointer_xy (Display* dpy, int* x_return, int* y_return) -{ - int dummy; - unsigned int mask; - Window dummy_win; - - XQueryPointer (dpy, RootWindow(dpy, DefaultScreen(dpy)), &dummy_win, &dummy_win, - x_return, y_return, &dummy, &dummy, &mask); -} - -/*============================================================================ - -============================================================================*/ - -static void -create_pixmap_mask (int width, int height) -{ - b_maskWidth = width; - b_maskHeight = height; - b_mask = XCreatePixmap (b_dpy, b_win, width, height, 1); -} - -static void -destroy_pixmap_mask(void) -{ - XFreePixmap (b_dpy, b_mask); -} - -static void -grow_pixmap_mask (int width, int height) -{ - if (width > b_maskWidth || height > b_maskHeight) - { - destroy_pixmap_mask (); - create_pixmap_mask (width, height); - } -} - -/*============================================================================ - -============================================================================*/ - -static void -text_extent (XFontStruct* fontStruct, CONST char* text, int len, - int* width, int* height) -{ - XCharStruct extent; - int dummy; - - XTextExtents (fontStruct, text, len, &dummy, &dummy, &dummy, &extent); - - *width = extent.width; - *height = fontStruct->ascent + fontStruct->descent; -} - -static void -get_text_size (Display* dpy, XFontStruct* fontStruct, CONST char* text, - int* max_width, int* max_height) -{ - int width; - int height; - CONST char* start; - CONST char* end; - - *max_width = *max_height = 0; - - start = text; - while ((end = strchr(start, '\n'))) - { - text_extent (fontStruct, start, end - start, &width, &height); - *max_width = max (width, *max_width); - *max_height += height; - - start = end + 1; - } - text_extent (fontStruct, start, strlen (start), &width, &height); - *max_width = max (width, *max_width); - *max_height += height; - - /* Min width */ - *max_width = max (*max_width, CONE_WIDTH / 2 * 3); - -} - -static void -draw_text (Display* dpy, Window win, GC gc, XFontStruct* fontStruct, - int x, int y, CONST char* text) -{ - CONST char* start; - CONST char* end; - int font_height; - - y += fontStruct->ascent; - - font_height = fontStruct->ascent + fontStruct->descent; - - start = text; - while ((end = strchr(start, '\n'))) - { - XDrawString (dpy, win, gc, x, y, start, end - start); - - start = end + 1; - y += font_height; - } - XDrawString (dpy, win, gc, x, y, start, strlen (start)); -} - -/*============================================================================ - -============================================================================*/ - -static int -get_shape (int last_shape, int x, int y, int width, int height, - int screen_width, int screen_height) -{ - /* Can we use last_shape? */ - if (((last_shape == SHAPE_CONE_TOP_LEFT) && - (x + width < screen_width) && (y + height < screen_height)) || - ((last_shape == SHAPE_CONE_TOP_RIGHT) && - (x - width > 0) && (y + height < screen_height)) || - ((last_shape == SHAPE_CONE_BOTTOM_LEFT) && - (x + width < screen_width) && (y - height > 0)) || - ((last_shape == SHAPE_CONE_BOTTOM_RIGHT) && - (x - width > 0) && (y - height > 0))) - return last_shape; - - /* Try to pick a shape that will not get changed, - e.g. if top left quadrant, top_left */ - return (x < screen_width / 2) ? - (y < screen_height / 2 ? SHAPE_CONE_TOP_LEFT: SHAPE_CONE_BOTTOM_LEFT) : - (y < screen_height / 2 ? SHAPE_CONE_TOP_RIGHT: SHAPE_CONE_BOTTOM_RIGHT); -} - -static void -make_mask (int shape, int x, int y, int width, int height) -{ - XPoint cone[ 3 ]; - - grow_pixmap_mask (width, height); - - /* Clear mask */ - XSetForeground (b_dpy, b_maskGC, 0); - XFillRectangle (b_dpy, b_mask, b_maskGC, - 0, 0, width, height); - - /* Enable text area */ - XSetForeground (b_dpy, b_maskGC, 1); - XFillRectangle (b_dpy, b_mask, b_maskGC, 0, - shape & SHAPE_CONE_TOP ? CONE_HEIGHT : 0, width, height - CONE_HEIGHT); - - /* Enable for cone area */ - cone[0].x = (shape & SHAPE_CONE_LEFT) ? CONE_WIDTH / 2 : width - (CONE_WIDTH / 2); - cone[0].y = (shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : height - CONE_HEIGHT; - cone[1].x = (shape & SHAPE_CONE_LEFT) ? 0 : width; - cone[1].y = (shape & SHAPE_CONE_TOP) ? 0 : height; - cone[2].x = (shape & SHAPE_CONE_LEFT) ? CONE_WIDTH : width - CONE_WIDTH; - cone[2].y = (shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : height - CONE_HEIGHT; - - XFillPolygon (b_dpy, b_mask, b_maskGC, cone, 3, Nonconvex, CoordModeOrigin); - -} - -static void -show_help (XtPointer data, XtIntervalId* id) -{ - int x, y; - int shape; - XPoint border[ 3 ]; - - if (id == NULL || ((id && b_timer) && b_text)) - { - b_timer = None; - - /* size */ - get_text_size (b_dpy, b_fontStruct, b_text, &b_width, &b_height); - b_width += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH; - b_height += 2 * MARGIN_WIDTH + 2 * BORDER_WIDTH + CONE_HEIGHT; - - /* origin */ - get_pointer_xy (b_dpy, &x, &y); - - /* guess at shape */ - shape = get_shape(b_lastShape, x, y, b_width, b_height, - b_screenWidth, b_screenHeight); - - x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; - y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; - - /* make sure it is still ok with offset */ - shape = get_shape (shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight); - - b_lastShape = shape; - - make_mask (shape, x, y, b_width, b_height); - - XShapeCombineMask (b_dpy, b_win, ShapeBounding, 0, 0, b_mask, ShapeSet); - - XMoveResizeWindow(b_dpy, b_win, - (shape & SHAPE_CONE_LEFT) ? x : x - b_width, - (shape & SHAPE_CONE_TOP) ? y : y - b_height, - b_width, b_height); - - XClearWindow (b_dpy, b_win); - - XMapRaised (b_dpy, b_win); - b_winMapped = True; - - draw_text (b_dpy, b_win, b_gc, b_fontStruct, - BORDER_WIDTH + MARGIN_WIDTH, - BORDER_WIDTH + MARGIN_WIDTH + ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0), - b_text); - - /* 3d border */ - /* shine- top left */ - border[0].x = 0 + BORDER_WIDTH_HALF; - border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; - border[1].x = 0 + BORDER_WIDTH_HALF; - border[1].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; - border[2].x = b_width - BORDER_WIDTH_HALF; - border[2].y = border[1].y; - XDrawLines (b_dpy, b_win, b_shineGC, border, 3, CoordModeOrigin); - - /* shadow- bottom right */ - border[0].x = 0 + BORDER_WIDTH_HALF; - border[0].y = ((shape & SHAPE_CONE_TOP) ? b_height : b_height - CONE_HEIGHT) - BORDER_WIDTH_HALF; - border[1].x = b_width - BORDER_WIDTH_HALF; - border[1].y = border[0].y; - border[2].x = b_width - BORDER_WIDTH_HALF; - border[2].y = ((shape & SHAPE_CONE_TOP) ? CONE_HEIGHT : 0) + BORDER_WIDTH_HALF; - XDrawLines (b_dpy, b_win, b_shadowGC, border, 3, CoordModeOrigin); - - /* cone */ - if (SHAPE_CONE_TOP_LEFT == shape) - { - XClearArea (b_dpy, b_win, - CONE_WIDTH / 2 + BORDER_WIDTH, - CONE_HEIGHT, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False); - XDrawLine (b_dpy, b_win, b_shadowGC, - 0, - 0, - CONE_WIDTH / 2 + BORDER_WIDTH_HALF, - CONE_HEIGHT); - XDrawLine (b_dpy, b_win, b_shineGC, - 0, - 0, - CONE_WIDTH - BORDER_WIDTH_HALF, - CONE_HEIGHT); - } - else if (SHAPE_CONE_TOP_RIGHT == shape) - { - XClearArea (b_dpy, b_win, - b_width - CONE_WIDTH + BORDER_WIDTH, - CONE_HEIGHT, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False); - XDrawLine (b_dpy, b_win, b_shadowGC, - b_width, - 0, - b_width - CONE_WIDTH / 2 - BORDER_WIDTH_HALF, - CONE_HEIGHT); - XDrawLine (b_dpy, b_win, b_shineGC, - b_width, - 0, - b_width - CONE_WIDTH + BORDER_WIDTH_HALF, - CONE_HEIGHT); - } - else if (SHAPE_CONE_BOTTOM_LEFT == shape) - { - XClearArea (b_dpy, b_win, - CONE_WIDTH / 2 + BORDER_WIDTH, - b_height - CONE_HEIGHT - BORDER_WIDTH, - CONE_WIDTH / 2 - BORDER_WIDTH, - BORDER_WIDTH, False); - XDrawLine (b_dpy, b_win, b_shadowGC, - 0, - b_height - 1, - CONE_WIDTH, - b_height - 1 - CONE_HEIGHT); - XDrawLine (b_dpy, b_win, b_shineGC, - 0, - b_height - 1, - CONE_WIDTH / 2 + BORDER_WIDTH, - b_height - 1 - CONE_HEIGHT); - } - else if (SHAPE_CONE_BOTTOM_RIGHT == shape) - { - XClearArea (b_dpy, b_win, - b_width - 1 - CONE_WIDTH + BORDER_WIDTH, - b_height - CONE_HEIGHT - BORDER_WIDTH, - CONE_WIDTH / 2 - BORDER_WIDTH - 1, - BORDER_WIDTH, False); - XDrawLine (b_dpy, b_win, b_shadowGC, - b_width - 1, - b_height - 1, - b_width - 1 - CONE_WIDTH, - b_height - 1 - CONE_HEIGHT); - XDrawLine (b_dpy, b_win, b_shineGC, - b_width - 1, - b_height - 1, - b_width - 1 - CONE_WIDTH / 2 - BORDER_WIDTH, - b_height - 1 - CONE_HEIGHT); - } - } - -} - -/*============================================================================ - -============================================================================*/ - -static void -balloon_help_destroy (void) -{ - assert (b_dpy != NULL); - b_dpy = NULL; - - destroy_window (b_dpy, b_win); - destroy_gc (b_dpy, b_gc); - - destroy_gc (b_dpy, b_shineGC); - destroy_gc (b_dpy, b_shadowGC); - - destroy_pixmap_mask (); - destroy_gc (b_dpy, b_maskGC); - - if (b_timer) XtRemoveTimeOut (b_timer); -} - -void -balloon_help_create (Display* dpy, - Pixel fg, Pixel bg, Pixel shine, Pixel shadow, - XFontStruct* font) -{ - if (b_dpy) balloon_help_destroy (); - - b_dpy = dpy; - - b_fontStruct = font; - - b_win = create_window (dpy, bg); - b_gc = create_gc (dpy, b_win, fg, bg, b_fontStruct); - - b_shineGC = create_gc (dpy, b_win, shine, bg, b_fontStruct); - b_shadowGC = create_gc (dpy, b_win, shadow, bg, b_fontStruct); - - create_pixmap_mask (1, 1); - b_maskGC = create_gc (dpy, b_mask, bg, fg, b_fontStruct); - - b_winMapped = False; - b_timer = None; - b_delay = 500; - - b_screenWidth = DisplayWidth (b_dpy, DefaultScreen(b_dpy)); - b_screenHeight = DisplayHeight (b_dpy, DefaultScreen(b_dpy)); - - b_lastShape = SHAPE_CONE_FREE; -} - -void -balloon_help_set_delay (unsigned long milliseconds) -{ - b_delay = milliseconds; -} - -void -balloon_help_show (CONST char* text) -{ - assert (b_dpy != NULL); - - /* We don't copy the text */ - b_text = text; - b_lastShape = SHAPE_CONE_FREE; - - if (b_winMapped) - { - /* If help is already being shown, don't delay just update */ - show_help (NULL, NULL); - } - else - { - b_timer = - XtAppAddTimeOut (XtDisplayToApplicationContext(b_dpy), - b_delay, show_help, NULL); - } -} - -void -balloon_help_hide (void) -{ - assert (b_dpy != NULL); - - b_text = NULL; - XUnmapWindow (b_dpy, b_win); - b_winMapped = False; - if (b_timer) - { - XtRemoveTimeOut (b_timer); - b_timer = None; - } -} - -void -balloon_help_move_to_pointer (void) -{ - assert (b_dpy != NULL); - - if (b_winMapped) - { - int x, y; - int shape = b_lastShape; - - get_pointer_xy (b_dpy, &x, &y); - - x += (shape & SHAPE_CONE_LEFT) ? POINTER_OFFSET : -POINTER_OFFSET; - y += (shape & SHAPE_CONE_TOP) ? POINTER_OFFSET : -POINTER_OFFSET; - - shape = get_shape (shape, x, y, b_width, b_height, b_screenWidth, b_screenHeight); - - if (shape == b_lastShape) - { - XMoveWindow (b_dpy, b_win, - shape & SHAPE_CONE_LEFT ? x : x - b_width, - shape & SHAPE_CONE_TOP ? y : y - b_height); - } - else - { - /* text would be off screen, rebuild with new shape */ - b_lastShape = SHAPE_CONE_FREE; - show_help (NULL, NULL); - } - } -} diff --git a/src/balloon_help.h b/src/balloon_help.h deleted file mode 100644 index 8e82602..0000000 --- a/src/balloon_help.h +++ /dev/null @@ -1,36 +0,0 @@ -/* Balloon Help - Copyright (c) 1997 Douglas Keller - -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. */ - -#ifndef BALLOON_HELP_H -#define BALLOON_HELP_H - -#include "xintrinsic.h" - -void balloon_help_create (Display* dpy, - Pixel fg, Pixel bg, Pixel shine, Pixel shadow, - XFontStruct* font); -void balloon_help_set_delay (unsigned long milliseconds); -void balloon_help_show (CONST char* text); -void balloon_help_hide (void); -void balloon_help_move_to_pointer (void); - -#endif /* BALLOON_HELP_H */ diff --git a/src/bitmaps.h b/src/bitmaps.h deleted file mode 100644 index 955c10e..0000000 --- a/src/bitmaps.h +++ /dev/null @@ -1,167 +0,0 @@ -/* 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. */ - -/* Authorship: - - JWZ (?): 1992?. - */ - -#ifndef _XEMACS_BITMAPS_H_ -#define _XEMACS_BITMAPS_H_ - -#if 0 -/* A gnu, like on the back of the emacs manual, for icons. */ -#include "../etc/gnu.xbm" - -/* The kitchen-sink icon. */ -#include "../etc/sink.xbm" -#endif /* 0 */ - -#include "../etc/xemacs.xbm" - -#if 0 -/* Vertical bars */ -#define compress_width 16 -#define compress_height 10 -static unsigned char compress_bits[] = { - 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, - 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66, 0x66}; - -/* Bracketed dash */ -#define compress_width 15 -#define compress_height 10 -static unsigned char compress_bits[] = { - 0x1f, 0x7c, 0x1f, 0x7c, 0x03, 0x60, 0x03, 0x60, 0xe3, 0x63, 0xe3, 0x63, - 0x03, 0x60, 0x03, 0x60, 0x1f, 0x7c, 0x1f, 0x7c}; -#endif - -#if 0 -/* Rectangled dash */ -#define compress_width 15 -#define compress_height 10 -static unsigned char compress_bits[] = { - 0xff, 0x7f, 0xff, 0x7f, 0x03, 0x60, 0x03, 0x60, 0xe3, 0x63, 0xe3, 0x63, - 0x03, 0x60, 0x03, 0x60, 0xff, 0x7f, 0xff, 0x7f}; -#endif - -#if 0 -#define extent_begin_width 18 -#define extent_begin_height 10 -static unsigned char extent_begin_bits[] = { - 0x0c, 0x00, 0x00, 0xcc, 0x00, 0x00, 0xcc, 0x0c, 0x00, 0xcc, 0xcc, 0x00, - 0xcc, 0xcc, 0x00, 0xcc, 0xcc, 0x00, 0xcc, 0xcc, 0x00, 0xcc, 0x0c, 0x00, - 0xcc, 0x00, 0x00, 0x0c, 0x00, 0x00}; - -#define extent_end_width 18 -#define extent_end_height 10 -static unsigned char extent_end_bits[] = { - 0x00, 0xc0, 0x00, 0x00, 0xcc, 0x00, 0xc0, 0xcc, 0x00, 0xcc, 0xcc, 0x00, - 0xcc, 0xcc, 0x00, 0xcc, 0xcc, 0x00, 0xcc, 0xcc, 0x00, 0xc0, 0xcc, 0x00, - 0x00, 0xcc, 0x00, 0x00, 0xc0, 0x00}; -#endif - -#if 0 -/* A diamond. */ -#define continuer_width 8 -#define continuer_height 10 -static unsigned char continuer_bits[] = { - 0x18, 0x18, 0x34, 0x34, 0x62, 0x62, 0x34, 0x34, 0x18, 0x18}; - -/* A left-pointing triangle. */ -#define truncator_width 8 -#define truncator_height 10 -static unsigned char truncator_bits[] = { - 0x40, 0x60, 0x70, 0x78, 0x7c, 0x7c, 0x78, 0x70, 0x60, 0x40}; -#endif - -/* An arrow pointing to the next line */ -#define continuer_width 7 -#define continuer_height 10 -static unsigned char continuer_bits[] = { - 0x00, 0xbc, 0xfc, 0xe0, 0xe0, 0x72, 0x3e, 0x1e, 0x1e, 0x3e}; - -#if 0 -/* Three dots indicating truncation */ -#define truncator_width 7 -#define truncator_height 8 -static unsigned char truncator_bits[] = { - 0x06, 0x06, 0x00, 0x18, 0x18, 0x00, 0x60, 0x60}; -#endif - -/* A Right pointing Arrow */ -#define truncator_width 8 -#define truncator_height 10 -static unsigned char truncator_bits[] = { - 0x00, 0x18, 0x30, 0x60, 0xff, 0xff, 0x60, 0x30, 0x18, 0x00}; - -/* A Left pointing Arrow */ -#define hscroll_width 8 -#define hscroll_height 10 -static unsigned char hscroll_bits[] = { - 0x00, 0x18, 0x0c, 0x06, 0xff, 0xff, 0x06, 0x0c, 0x18, 0x00}; - -#if 0 -#define rarrow_width 12 -#define rarrow_height 10 -static unsigned char rarrow_bits[] = { - 0x40, 0x00, 0xc0, 0x00, 0x80, 0x01, 0x80, 0x03, 0xfe, 0x07, 0xfe, 0x07, - 0x80, 0x03, 0x80, 0x01, 0xc0, 0x00, 0x40, 0x00}; -#endif - -/* Stipples */ - -#if 0 -/* A stipple for hilighting. */ -#define selection_width 16 -#define selection_height 16 -static unsigned char selection_bits[] = { - 0x04, 0x84, 0x80, 0x00, 0x00, 0x20, 0x02, 0x04, 0x40, 0x00, 0x08, 0x82, - 0x00, 0x10, 0x40, 0x00, 0x02, 0x40, 0x00, 0x02, 0x10, 0x00, 0x80, 0x80, - 0x00, 0x08, 0x08, 0x00, 0x01, 0x02, 0x40, 0x20}; - -#define secondary_selection_width 16 -#define secondary_selection_height 16 -static unsigned char secondary_selection_bits[] = { - 0x08, 0x08, 0x04, 0x04, 0x02, 0x02, 0x01, 0x01, 0x80, 0x80, 0x40, 0x40, - 0x20, 0x20, 0x10, 0x10, 0x08, 0x08, 0x04, 0x04, 0x02, 0x02, 0x01, 0x01, - 0x80, 0x80, 0x40, 0x40, 0x20, 0x20, 0x10, 0x10}; - -#define overlap_selection_width 16 -#define overlap_selection_height 16 -static unsigned char overlap_selection_bits[] = { - 0x09, 0x88, 0x84, 0x04, 0x02, 0x22, 0x01, 0x05, 0x80, 0x80, 0x48, 0x42, - 0x20, 0x20, 0x50, 0x10, 0x0a, 0x48, 0x04, 0x04, 0x12, 0x02, 0x01, 0x01, - 0x80, 0x88, 0x48, 0x40, 0x21, 0xa2, 0x50, 0x10}; - -#define default0_stipple_width 16 -#define default0_stipple_height 16 -static unsigned char default0_stipple_bits[] = { - 0x00, 0x00, 0x66, 0x66, 0x66, 0x66, 0x00, 0x00, 0x00, 0x00, 0x66, 0x66, - 0x66, 0x66, 0x00, 0x00, 0x00, 0x00, 0x66, 0x66, 0x66, 0x66, 0x00, 0x00, - 0x00, 0x00, 0x66, 0x66, 0x66, 0x66, 0x00, 0x00}; - -#define default1_stipple_width 16 -#define default1_stipple_height 16 -static unsigned char default1_stipple_bits[] = { - 0x00, 0x00, 0x22, 0x22, 0x22, 0x22, 0x00, 0x00, 0x00, 0x00, 0x22, 0x22, - 0x22, 0x22, 0x00, 0x00, 0x00, 0x00, 0x22, 0x22, 0x22, 0x22, 0x00, 0x00, - 0x00, 0x00, 0x22, 0x22, 0x22, 0x22, 0x00, 0x00}; -#endif - -#endif /* _XEMACS_BITMAPS_H_ */ diff --git a/src/blocktype.h b/src/blocktype.h deleted file mode 100644 index c4f9b24..0000000 --- a/src/blocktype.h +++ /dev/null @@ -1,45 +0,0 @@ -/* Fixed-size block allocator -- include file. - Copyright (C) 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. */ - -/* Authorship: - - Ben Wing: December 1994, for 19.12. - */ - -#ifndef _XEMACS_BLOCKTYPE_H_ -#define _XEMACS_BLOCKTYPE_H_ - -#define Blocktype_declare(type) \ - type *free; \ - int elsize; \ - type *tempel - -void *Blocktype_newf (size_t elsize); -void Blocktype_allocf (void *b); -void Blocktype_free (void *bbb, void *el); - -#define Blocktype_new(structype) \ - (structype *) Blocktype_newf (sizeof(*(((structype *) NULL)->free))) -#define Blocktype_alloc(b) (Blocktype_allocf (b), (b)->tempel) - -#endif /* _XEMACS_BLOCKTYPE_H_ */ diff --git a/src/broken-sun.h b/src/broken-sun.h deleted file mode 100644 index 2bf0429..0000000 --- a/src/broken-sun.h +++ /dev/null @@ -1,167 +0,0 @@ -/* 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. */ - -/* Authorship: - - JWZ: long ago. - */ - -/* Sun's standard and GCC's header files leave out prototypes for - all sorts of functions. */ - -#ifndef _XEMACS_BROKEN_SUN_H_ -#define _XEMACS_BROKEN_SUN_H_ - -#ifdef __GNUC__ -#include -#include - -/*********************** stdlib functions *********************/ - -/* void * memchr (CONST void *, int, size_t); */ - -/* int memcmp (CONST void *, CONST void *, size_t); */ -/* void * memcpy (void *, CONST void *, size_t); */ -/* void * memmove (void *, CONST void *, size_t);*/ -/* void * memset (void *, int, int); */ -/* char * strcat (char *, CONST char *); */ -/* char * strchr (CONST char *, int); */ -/* int strcmp (CONST char *, CONST char *); */ -int strcasecmp (char *, char *); - -/* Yes, they even left these functions out! */ -int tolower (int); -int toupper (int); - -/*********************** stdio functions *********************/ - -#include /* else can't declare FILE */ - -/* FILE *fopen (CONST char *, CONST char *); */ -/* FILE *freopen (CONST char *, CONST char *, FILE *); */ -FILE *tmpfile (void); -int fclose (FILE *); -char *fgets (char *, int, FILE *); -int fgetc (FILE *); -int fflush (FILE *); -int fprintf (FILE *, CONST char *, ...); -int fputc (char, FILE *); -int fputs (CONST char *, FILE *); -size_t fread (void *, size_t, size_t, FILE *); -int fscanf (FILE *, CONST char *, ...); -int fgetpos (FILE *, long *); -int fseek (FILE *, long, int); -int fsetpos (FILE *, CONST long *); -long ftell (FILE *); -size_t fwrite (CONST void *, size_t, size_t, FILE *); -char *gets (char *); -int pclose (FILE *); -void perror (CONST char *); -int printf (CONST char *, ...); -int puts (CONST char *); -int remove (CONST char *); -int rename (CONST char *, CONST char *); -int rewind (FILE *); -int scanf (CONST char *, ...); -int sscanf (CONST char *, CONST char *, ...); -void setbuf (FILE *, char *); -int setvbuf (FILE *, char *, int, size_t); -int ungetc (int, FILE *); -int vprintf (CONST char *, void *); -int vfprintf (FILE *, CONST char *, void *); -char *vsprintf (char *, CONST char *, void *); - -/*********************** signal functions *********************/ - -int sigblock (int); -#ifndef sigmask -int sigmask (int); -#endif -int sigsetmask (int); -int sigpause (int); - -/*********************** time functions ***********************/ - -struct timeval; -struct timezone; - -int utimes (CONST char *, struct timeval *); -void tzset (void); -time_t time (time_t *); -int gettimeofday (struct timeval *, struct timezone *); - -/*********************** file-system functions *********************/ - -struct stat; -#include - -int fsync (int); -int lstat (CONST char *, struct stat *); -int fchmod (int, mode_t); -char *mktemp (char *); -/* int creat (CONST char *, mode_t); better no decl than a conflicting one... */ -int symlink (CONST char *, CONST char *); -int readlink (CONST char *, char *, int); -void sync (void); -int select (int, fd_set *, fd_set *, fd_set *, struct timeval *); -char * getwd (char *); -/* int lseek (int, long, int); better no decl than a conflicting one... */ -int _filbuf (); -int _flsbuf (); - -/**************** interprocess communication functions ******************/ - -int recv (int, char *, int, int); -int socket (int, int, int); -struct sockaddr; -int connect (int, struct sockaddr *, int); -int bind (int, struct sockaddr *, int); -int listen (int, int); -int accept (int, struct sockaddr *, int *); -int gethostname (char *, int); -struct rusage; -int wait3 (void *, int, struct rusage *); -int nice (int); -int killpg (int, int); -int system (char *); - - -/*********************** low-level OS functions *********************/ - -int ioctl (int, int, ...); -struct nlist; -int nlist (CONST char *, struct nlist *); -int munmap (void *, int); -int brk (void *); -void * sbrk (int); -struct rlimit; -int getrlimit (int, struct rlimit *); -int getpagesize (void); -int shutdown (int, int); -int mprotect (void *, int, int); - -/*********************** miscellaneous functions *********************/ - -void tputs (CONST char *cp, int affcnt, void (*)(int)); -long random (void); -int srandom (int seed); - -#endif /* __GNUC__ */ - -#endif /* _XEMACS_BROKEN_SUN_H_ */ diff --git a/src/buffer.c b/src/buffer.c deleted file mode 100644 index d5d69c9..0000000 --- a/src/buffer.c +++ /dev/null @@ -1,2766 +0,0 @@ -/* Buffer manipulation primitives for XEmacs. - Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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: Mule 2.0, FSF 19.30. */ - -/* Authorship: - - FSF: long ago. - JWZ: some changes for Lemacs, long ago. (e.g. separate buffer - list per frame.) - Mly: a few changes for buffer-local vars, 19.8 or 19.9. - Ben Wing: some changes and cleanups for Mule, 19.12. - */ - -/* This file contains functions that work with buffer objects. - Functions that manipulate a buffer's text, however, are not - in this file: - - 1) The low-level functions that actually know about the - implementation of a buffer's text are located in insdel.c. - 2) The higher-level (mostly Lisp) functions that manipulate a - buffer's text are in editfns.c. - 3) The highest-level Lisp commands are in cmds.c. - - However: - - -- Functions that know about syntax tables (forward-word, - scan-sexps, etc.) are in syntax.c, as are functions - that manipulate syntax tables. - -- Functions that know about case tables (upcase, downcase, - etc.) are in casefiddle.c. Functions that manipulate - case tables (case-table-p, set-case-table, etc.) are - in casetab.c. - -- Functions that do searching and replacing are in - search.c. The low-level functions that implement - regular expressions are in regex.c. - - Also: - - -- Some file and process functions (in fileio.c and process.c) - copy text from or insert text into a buffer; they call - low-level functions in insdel.c to do this. - -- insdel.c calls low-level functions in undo.c and extents.c - to record buffer modifications for undoing and to handle - extent adjustment and extent-data creation and insertion. - -*/ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "chartab.h" -#include "commands.h" -#include "elhash.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "insdel.h" -#include "process.h" /* for kill_buffer_processes */ -#ifdef REGION_CACHE_NEEDS_WORK -#include "region-cache.h" -#endif -#include "specifier.h" -#include "syntax.h" -#include "sysdep.h" /* for getwd */ -#include "window.h" - -#include "sysfile.h" - -struct buffer *current_buffer; /* the current buffer */ - -/* This structure holds the default values of the buffer-local variables - defined with DEFVAR_BUFFER_LOCAL, that have special slots in each buffer. - The default value occupies the same slot in this structure - as an individual buffer's value occupies in that buffer. - Setting the default value also goes through the alist of buffers - and stores into each buffer that does not say it has a local value. */ -Lisp_Object Vbuffer_defaults; - -/* This structure marks which slots in a buffer have corresponding - default values in Vbuffer_defaults. - Each such slot has a nonzero value in this structure. - The value has only one nonzero bit. - - When a buffer has its own local value for a slot, - the bit for that slot (found in the same slot in this structure) - is turned on in the buffer's local_var_flags slot. - - If a slot in this structure is 0, then there is a DEFVAR_BUFFER_LOCAL - for the slot, but there is no default value for it; the corresponding - slot in Vbuffer_defaults is not used except to initialize newly-created - buffers. - - If a slot is -1, then there is a DEFVAR_BUFFER_LOCAL for it - as well as a default value which is used to initialize newly-created - buffers and as a reset-value when local-vars are killed. - - If a slot is -2, there is no DEFVAR_BUFFER_LOCAL for it. - (The slot is always local, but there's no lisp variable for it.) - The default value is only used to initialize newly-creation buffers. - - If a slot is -3, then there is no DEFVAR_BUFFER_LOCAL for it but - there is a default which is used to initialize newly-creation - buffers and as a reset-value when local-vars are killed. */ -struct buffer buffer_local_flags; - -/* This is the initial (startup) directory, as used for the *scratch* buffer. - We're making this a global to make others aware of the startup directory. - `initial_directory' is stored in external format. - */ -char initial_directory[MAXPATHLEN+1]; - -/* This structure holds the names of symbols whose values may be - buffer-local. It is indexed and accessed in the same way as the above. */ -static Lisp_Object Vbuffer_local_symbols; - -/* Alist of all buffer names vs the buffers. */ -/* This used to be a variable, but is no longer, - to prevent lossage due to user rplac'ing this alist or its elements. - Note that there is a per-frame copy of this as well; the frame slot - and the global variable contain the same data, but possibly in different - orders, so that the buffer ordering can be per-frame. - */ -Lisp_Object Vbuffer_alist; - -/* Functions to call before and after each text change. */ -Lisp_Object Qbefore_change_functions; -Lisp_Object Qafter_change_functions; -Lisp_Object Vbefore_change_functions; -Lisp_Object Vafter_change_functions; - -/* #### Obsolete, for compatibility */ -Lisp_Object Qbefore_change_function; -Lisp_Object Qafter_change_function; -Lisp_Object Vbefore_change_function; -Lisp_Object Vafter_change_function; - -#if 0 /* FSFmacs */ -Lisp_Object Vtransient_mark_mode; -#endif - -/* t means ignore all read-only text properties. - A list means ignore such a property if its value is a member of the list. - Any non-nil value means ignore buffer-read-only. */ -Lisp_Object Vinhibit_read_only; - -/* List of functions to call that can query about killing a buffer. - If any of these functions returns nil, we don't kill it. */ -Lisp_Object Vkill_buffer_query_functions; - -/* Non-nil means delete a buffer's auto-save file when the buffer is saved. */ -int delete_auto_save_files; - -Lisp_Object Qbuffer_live_p; -Lisp_Object Qbuffer_or_string_p; - -/* List of functions to call before changing an unmodified buffer. */ -Lisp_Object Vfirst_change_hook; -Lisp_Object Qfirst_change_hook; - -Lisp_Object Qfundamental_mode; -Lisp_Object Qmode_class; -Lisp_Object Qpermanent_local; - -Lisp_Object Qprotected_field; - -Lisp_Object QSFundamental; /* A string "Fundamental" */ -Lisp_Object QSscratch; /* "*scratch*" */ -Lisp_Object Qdefault_directory; - -Lisp_Object Qkill_buffer_hook; -Lisp_Object Qbuffer_file_name, Qbuffer_undo_list; - -Lisp_Object Qrename_auto_save_file; - -Lisp_Object Qget_file_buffer; -Lisp_Object Qchange_major_mode_hook, Vchange_major_mode_hook; - -Lisp_Object Qfind_file_compare_truenames; - -Lisp_Object Qswitch_to_buffer; - -/* Two thresholds controlling how much undo information to keep. */ -int undo_threshold; -int undo_high_threshold; - -int find_file_compare_truenames; -int find_file_use_truenames; - - -static void reset_buffer_local_variables (struct buffer *, int first_time); -static void nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap); - -Lisp_Object -make_buffer (struct buffer *buf) -{ - Lisp_Object obj; - XSETBUFFER (obj, buf); - return obj; -} - -static Lisp_Object -mark_buffer (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct buffer *buf = XBUFFER (obj); - - /* Truncate undo information. */ - buf->undo_list = truncate_undo_list (buf->undo_list, - undo_threshold, - undo_high_threshold); - -#define MARKED_SLOT(x) ((void) (markobj (buf->x))); -#include "bufslots.h" -#undef MARKED_SLOT - - markobj (buf->extent_info); - if (buf->text) - markobj (buf->text->line_number_cache); - - /* Don't mark normally through the children slot. - (Actually, in this case, it doesn't matter.) */ - if (! EQ (buf->indirect_children, Qnull_pointer)) - mark_conses_in_list (buf->indirect_children); - - return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil; -} - -static void -print_buffer (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct buffer *b = XBUFFER (obj); - - if (print_readably) - { - if (!BUFFER_LIVE_P (b)) - error ("printing unreadable object #"); - else - error ("printing unreadable object #", - XSTRING_DATA (b->name)); - } - else if (!BUFFER_LIVE_P (b)) - write_c_string ("#", printcharfun); - else if (escapeflag) - { - write_c_string ("#name, printcharfun, 1); - write_c_string (">", printcharfun); - } - else - { - print_internal (b->name, printcharfun, 0); - } -} - -/* We do not need a finalize method to handle a buffer's children list - because all buffers have `kill-buffer' applied to them before - they disappear, and the children removal happens then. */ -DEFINE_LRECORD_IMPLEMENTATION ("buffer", buffer, - mark_buffer, print_buffer, 0, 0, 0, - struct buffer); - -DEFUN ("bufferp", Fbufferp, 1, 1, 0, /* -Return t if OBJECT is an editor buffer. -*/ - (object)) -{ - return BUFFERP (object) ? Qt : Qnil; -} - -DEFUN ("buffer-live-p", Fbuffer_live_p, 1, 1, 0, /* -Return t if OBJECT is an editor buffer that has not been deleted. -*/ - (object)) -{ - return BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)) ? Qt : Qnil; -} - -static void -nsberror (Lisp_Object spec) -{ - if (STRINGP (spec)) - error ("No buffer named %s", XSTRING_DATA (spec)); - signal_simple_error ("Invalid buffer argument", spec); -} - -DEFUN ("buffer-list", Fbuffer_list, 0, 1, 0, /* -Return a list of all existing live buffers. -The order is specific to the selected frame; if the optional FRAME -argument is provided, the ordering for that frame is returned instead. -If the FRAME argument is t, then the global (non-frame) ordering is -returned instead. -*/ - (frame)) -{ - return Fmapcar (Qcdr, - EQ (frame, Qt) ? Vbuffer_alist : - decode_frame (frame)->buffer_alist); -} - -Lisp_Object -get_buffer (Lisp_Object name, int error_if_deleted_or_does_not_exist) -{ - if (BUFFERP (name)) - { - if (!BUFFER_LIVE_P (XBUFFER (name))) - { - if (error_if_deleted_or_does_not_exist) - nsberror (name); - return Qnil; - } - return name; - } - else - { - Lisp_Object buf; - struct gcpro gcpro1; - - CHECK_STRING (name); - name = LISP_GETTEXT (name); /* I18N3 */ - GCPRO1 (name); - buf = Fcdr (Fassoc (name, Vbuffer_alist)); - UNGCPRO; - if (NILP (buf) && error_if_deleted_or_does_not_exist) - nsberror (name); - return buf; - } -} - -struct buffer * -decode_buffer (Lisp_Object buffer, int allow_string) -{ - if (NILP (buffer)) - return current_buffer; - - if (allow_string && STRINGP (buffer)) - return XBUFFER (get_buffer (buffer, 1)); - - CHECK_LIVE_BUFFER (buffer); - return XBUFFER (buffer); -} - -DEFUN ("decode-buffer", Fdecode_buffer, 1, 1, 0, /* -Validate BUFFER or if BUFFER is nil, return the current buffer. -If BUFFER is a valid buffer or a string representing a valid buffer, -the corresponding buffer object will be returned. Otherwise an error -will be signaled. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - XSETBUFFER (buffer, b); - return buffer; -} - -#if 0 /* FSFmacs */ -/* bleagh!!! */ -/* Like Fassoc, but use Fstring_equal to compare - (which ignores text properties), - and don't ever QUIT. */ - -static Lisp_Object -assoc_ignore_text_properties (REGISTER Lisp_Object key, Lisp_Object list) -{ - REGISTER Lisp_Object tail; - for (tail = list; !NILP (tail); tail = Fcdr (tail)) - { - REGISTER Lisp_Object elt, tem; - elt = Fcar (tail); - tem = Fstring_equal (Fcar (elt), key); - if (!NILP (tem)) - return elt; - } - return Qnil; -} - -#endif /* FSFmacs */ - -DEFUN ("get-buffer", Fget_buffer, 1, 1, 0, /* -Return the buffer named NAME (a string). -If there is no live buffer named NAME, return nil. -NAME may also be a buffer; if so, the value is that buffer. -*/ - (name)) -{ -#ifdef I18N3 - /* #### Doc string should indicate that the buffer name will get - translated. */ -#endif - - /* #### This might return a dead buffer. This is gross. This is - called FSF compatibility. */ - if (BUFFERP (name)) - return name; - return get_buffer (name, 0); - /* FSFmacs 19.29 calls assoc_ignore_text_properties() here. - Bleagh!! */ -} - - -DEFUN ("get-file-buffer", Fget_file_buffer, 1, 1, 0, /* -Return the buffer visiting file FILENAME (a string). -The buffer's `buffer-file-name' must match exactly the expansion of FILENAME. -If there is no such live buffer, return nil. - -Normally, the comparison is done by canonicalizing FILENAME (using -`expand-file-name') and comparing that to the value of `buffer-file-name' -for each existing buffer. However, If `find-file-compare-truenames' is -non-nil, FILENAME will be converted to its truename and the search will be -done on each buffer's value of `buffer-file-truename' instead of -`buffer-file-name'. Otherwise, if `find-file-use-truenames' is non-nil, -FILENAME will be converted to its truename and used for searching, but -the search will still be done on `buffer-file-name'. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.06. */ - REGISTER Lisp_Object buf; - struct gcpro gcpro1; - -#ifdef I18N3 - /* DO NOT translate the filename. */ -#endif - GCPRO1 (filename); - CHECK_STRING (filename); - filename = Fexpand_file_name (filename, Qnil); - { - /* If the file name has special constructs in it, - call the corresponding file handler. */ - Lisp_Object handler = Ffind_file_name_handler (filename, Qget_file_buffer); - if (!NILP (handler)) - { - UNGCPRO; - return call2 (handler, Qget_file_buffer, filename); - } - } - UNGCPRO; - - if (find_file_compare_truenames || find_file_use_truenames) - { - struct gcpro ngcpro1, ngcpro2, ngcpro3; - Lisp_Object fn = Qnil; - Lisp_Object dn = Qnil; - - NGCPRO3 (fn, dn, filename); - fn = Ffile_truename (filename, Qnil); - if (NILP (fn)) - { - dn = Ffile_name_directory (filename); - fn = Ffile_truename (dn, Qnil); - if (! NILP (fn)) dn = fn; - fn = Fexpand_file_name (Ffile_name_nondirectory (filename), - dn); - } - filename = fn; - NUNGCPRO; - } - - { - Lisp_Object elt; - LIST_LOOP_2 (elt, Vbuffer_alist) - { - buf = Fcdr (elt); - if (!BUFFERP (buf)) continue; - if (!STRINGP (XBUFFER (buf)->filename)) continue; - if (!NILP (Fstring_equal (filename, - (find_file_compare_truenames - ? XBUFFER (buf)->file_truename - : XBUFFER (buf)->filename)))) - return buf; - } - } - return Qnil; -} - - -static void -push_buffer_alist (Lisp_Object name, Lisp_Object buf) -{ - Lisp_Object cons = Fcons (name, buf); - Lisp_Object frmcons, devcons, concons; - - Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (cons, Qnil)); - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - struct frame *f; - f = XFRAME (XCAR (frmcons)); - f->buffer_alist = nconc2 (f->buffer_alist, Fcons (cons, Qnil)); - } -} - -static void -delete_from_buffer_alist (Lisp_Object buf) -{ - Lisp_Object cons = Frassq (buf, Vbuffer_alist); - Lisp_Object frmcons, devcons, concons; - if (NILP (cons)) - return; /* abort() ? */ - Vbuffer_alist = delq_no_quit (cons, Vbuffer_alist); - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - struct frame *f; - f = XFRAME (XCAR (frmcons)); - f->buffer_alist = delq_no_quit (cons, f->buffer_alist); - } -} - -Lisp_Object -get_truename_buffer (REGISTER Lisp_Object filename) -{ - /* FSFmacs has its own code here and doesn't call get-file-buffer. - That's because their equivalent of find-file-compare-truenames - (find-file-existing-other-name) isn't looked at in get-file-buffer. - This way is more correct. */ - int count = specpdl_depth (); - - specbind (Qfind_file_compare_truenames, Qt); - return unbind_to (count, Fget_file_buffer (filename)); -} - -static struct buffer * -allocate_buffer (void) -{ - struct buffer *b = alloc_lcrecord_type (struct buffer, lrecord_buffer); - - copy_lcrecord (b, XBUFFER (Vbuffer_defaults)); - - return b; -} - -static Lisp_Object -finish_init_buffer (struct buffer *b, Lisp_Object name) -{ - Lisp_Object buf; - - XSETBUFFER (buf, b); - - name = Fcopy_sequence (name); - /* #### This really does not need to be called. We already - initialized the buffer-local variables in allocate_buffer(). - local_var_alist is set to Qnil at the same point, in - nuke_all_buffer_slots(). */ - reset_buffer_local_variables (b, 1); - b->directory = ((current_buffer) ? current_buffer->directory : Qnil); - - b->last_window_start = 1; - - b->name = name; - if (string_byte (XSTRING (name), 0) != ' ') - b->undo_list = Qnil; - else - b->undo_list = Qt; - - /* initialize the extent list */ - init_buffer_extents (b); - - /* Put this in the alist of all live buffers. */ - push_buffer_alist (name, buf); - - init_buffer_markers (b); - - b->generated_modeline_string = Fmake_string (make_int (84), make_int (' ')); - b->modeline_extent_table = make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, - HASH_TABLE_EQ); - - return buf; -} - -DEFUN ("get-buffer-create", Fget_buffer_create, 1, 1, 0, /* -Return the buffer named NAME, or create such a buffer and return it. -A new buffer is created if there is no live buffer named NAME. -If NAME starts with a space, the new buffer does not keep undo information. -If NAME is a buffer instead of a string, then it is the value returned. -The value is never nil. -*/ - (name)) -{ - /* This function can GC */ - Lisp_Object buf; - REGISTER struct buffer *b; - -#ifdef I18N3 - /* #### Doc string should indicate that the buffer name will get - translated. */ -#endif - - name = LISP_GETTEXT (name); - buf = Fget_buffer (name); - if (!NILP (buf)) - return buf; - - if (XSTRING_LENGTH (name) == 0) - error ("Empty string for buffer name is not allowed"); - - b = allocate_buffer (); - - b->text = &b->own_text; - b->base_buffer = 0; - b->indirect_children = Qnil; - init_buffer_text (b); - - return finish_init_buffer (b, name); -} - -DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, 2, 2, - "bMake indirect buffer (to buffer): \nBName of indirect buffer: ", /* -Create and return an indirect buffer for buffer BASE, named NAME. -BASE should be an existing buffer (or buffer name). -NAME should be a string which is not the name of an existing buffer. -If BASE is an indirect buffer itself, the base buffer for that buffer - is made the base buffer for the newly created buffer. (Thus, there will - never be indirect buffers whose base buffers are themselves indirect.) -*/ - (base_buffer, name)) -{ - /* This function can GC */ - - /* #### The above interactive specification is totally bogus, - because it offers an existing buffer as default answer to the - second question. However, the second argument may not BE an - existing buffer! */ - struct buffer *b; - - base_buffer = get_buffer (base_buffer, 1); - -#ifdef I18N3 - /* #### Doc string should indicate that the buffer name will get - translated. */ -#endif - CHECK_STRING (name); - name = LISP_GETTEXT (name); - if (!NILP (Fget_buffer (name))) - signal_simple_error ("Buffer name already in use", name); - if (XSTRING_LENGTH (name) == 0) - error ("Empty string for buffer name is not allowed"); - - b = allocate_buffer (); - - b->base_buffer = BUFFER_BASE_BUFFER (XBUFFER (base_buffer)); - - /* Use the base buffer's text object. */ - b->text = b->base_buffer->text; - b->indirect_children = Qnil; - b->base_buffer->indirect_children = - Fcons (make_buffer (b), b->base_buffer->indirect_children); - init_buffer_text (b); - - return finish_init_buffer (b, name); -} - - - -static void -reset_buffer_local_variables (struct buffer *b, int first_time) -{ - struct buffer *def = XBUFFER (Vbuffer_defaults); - - b->local_var_flags = 0; - /* For each slot that has a default value, - copy that into the slot. */ -#define MARKED_SLOT(slot) \ - { int mask = XINT (buffer_local_flags.slot); \ - if ((mask > 0 || mask == -1 || mask == -3) \ - && (first_time \ - || NILP (Fget (XBUFFER (Vbuffer_local_symbols)->slot, \ - Qpermanent_local, Qnil)))) \ - b->slot = def->slot; \ - } -#include "bufslots.h" -#undef MARKED_SLOT -#if 0 -#define STRING256_P(obj) \ - (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256) - /* If the standard case table has been altered and invalidated, - fix up its insides first. */ - if (!(STRING256_P(Vascii_upcase_table) && - STRING256_P(Vascii_canon_table) && - STRING256_P(Vascii_eqv_table))) - { - Fset_standard_case_table (Vascii_downcase_table); - } - b->downcase_table = Vascii_downcase_table; - b->upcase_table = Vascii_upcase_table; - b->case_canon_table = Vascii_canon_table; - b->case_eqv_table = Vascii_eqv_table; -#ifdef MULE - b->mirror_downcase_table = Vmirror_ascii_downcase_table; - b->mirror_upcase_table = Vmirror_ascii_upcase_table; - b->mirror_case_canon_table = Vmirror_ascii_canon_table; - b->mirror_case_eqv_table = Vmirror_ascii_eqv_table; -#endif -#endif -} - - -/* We split this away from generate-new-buffer, because rename-buffer - and set-visited-file-name ought to be able to use this to really - rename the buffer properly. */ - -DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name, 1, 2, 0, /* -Return a string that is the name of no existing buffer based on NAME. -If there is no live buffer named NAME, then return NAME. -Otherwise modify name by appending `', incrementing NUMBER -until an unused name is found, and then return that name. -Optional second argument IGNORE specifies a name that is okay to use -\(if it is in the sequence to be tried) -even if a buffer with that name exists. -*/ - (name, ignore)) -{ - REGISTER Lisp_Object gentemp, tem; - int count; - char number[10]; - - CHECK_STRING (name); - - name = LISP_GETTEXT (name); -#ifdef I18N3 - /* #### Doc string should indicate that the buffer name will get - translated. */ -#endif - - tem = Fget_buffer (name); - if (NILP (tem)) - return name; - - count = 1; - while (1) - { - sprintf (number, "<%d>", ++count); - gentemp = concat2 (name, build_string (number)); - if (!NILP (ignore)) - { - tem = Fstring_equal (gentemp, ignore); - if (!NILP (tem)) - return gentemp; - } - tem = Fget_buffer (gentemp); - if (NILP (tem)) - return gentemp; - } -} - - -DEFUN ("buffer-name", Fbuffer_name, 0, 1, 0, /* -Return the name of BUFFER, as a string. -With no argument or nil as argument, return the name of the current buffer. -*/ - (buffer)) -{ - /* For compatibility, we allow a dead buffer here. - Earlier versions of Emacs didn't provide buffer-live-p. */ - if (NILP (buffer)) - return current_buffer->name; - CHECK_BUFFER (buffer); - return XBUFFER (buffer)->name; -} - -DEFUN ("buffer-file-name", Fbuffer_file_name, 0, 1, 0, /* -Return name of file BUFFER is visiting, or nil if none. -No argument or nil as argument means use the current buffer. -*/ - (buffer)) -{ - /* For compatibility, we allow a dead buffer here. Yuck! */ - if (NILP (buffer)) - return current_buffer->filename; - CHECK_BUFFER (buffer); - return XBUFFER (buffer)->filename; -} - -DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, 0, 1, 0, /* -Return the base buffer of indirect buffer BUFFER. -If BUFFER is not indirect, return nil. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - return buf->base_buffer ? make_buffer (buf->base_buffer) : Qnil; -} - -DEFUN ("buffer-indirect-children", Fbuffer_indirect_children, 0, 1, 0, /* -Return a list of all indirect buffers whose base buffer is BUFFER. -If BUFFER is indirect, the return value will always be nil; see -`make-indirect-buffer'. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - return Fcopy_sequence (buf->indirect_children); -} - -DEFUN ("buffer-local-variables", Fbuffer_local_variables, 0, 1, 0, /* -Return an alist of variables that are buffer-local in BUFFER. -Most elements look like (SYMBOL . VALUE), describing one variable. -For a symbol that is locally unbound, just the symbol appears in the value. -Note that storing new VALUEs in these elements doesn't change the variables. -No argument or nil as argument means use current buffer as BUFFER. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - Lisp_Object result = Qnil; - - { - Lisp_Object tail; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object elt = XCAR (tail); - /* Reference each variable in the alist in buf. - If inquiring about the current buffer, this gets the current values, - so store them into the alist so the alist is up to date. - If inquiring about some other buffer, this swaps out any values - for that buffer, making the alist up to date automatically. */ - Lisp_Object val = find_symbol_value (XCAR (elt)); - /* Use the current buffer value only if buf is the current buffer. */ - if (buf != current_buffer) - val = XCDR (elt); - - /* If symbol is unbound, put just the symbol in the list. */ - if (UNBOUNDP (val)) - result = Fcons (XCAR (elt), result); - /* Otherwise, put (symbol . value) in the list. */ - else - result = Fcons (Fcons (XCAR (elt), val), result); - } - } - - /* Add on all the variables stored in special slots. */ - { - struct buffer *syms = XBUFFER (Vbuffer_local_symbols); -#define MARKED_SLOT(slot) \ - { int mask = XINT (buffer_local_flags.slot); \ - if (mask == 0 || mask == -1 \ - || ((mask > 0) && (buf->local_var_flags & mask))) \ - result = Fcons (Fcons (syms->slot, buf->slot), result); \ - } -#include "bufslots.h" -#undef MARKED_SLOT - } - return result; -} - -DEFUN ("buffer-dedicated-frame", Fbuffer_dedicated_frame, 0, 1, 0, /* -Return the frame dedicated to this BUFFER, or nil if there is none. -No argument or nil as argument means use current buffer as BUFFER. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - /* XEmacs addition: if the frame is dead, silently make it go away. */ - if (!NILP (buf->dedicated_frame) && - !FRAME_LIVE_P (XFRAME (buf->dedicated_frame))) - buf->dedicated_frame = Qnil; - - return buf->dedicated_frame; -} - -DEFUN ("set-buffer-dedicated-frame", Fset_buffer_dedicated_frame, 2, 2, 0, /* -For this BUFFER, set the FRAME dedicated to it. -FRAME must be a frame or nil. -*/ - (buffer, frame)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - if (!NILP (frame)) - CHECK_LIVE_FRAME (frame); /* XEmacs change */ - - return buf->dedicated_frame = frame; -} - - - -DEFUN ("buffer-modified-p", Fbuffer_modified_p, 0, 1, 0, /* -Return t if BUFFER was modified since its file was last read or saved. -No argument or nil as argument means use current buffer as BUFFER. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - return BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf) ? Qt : Qnil; -} - -DEFUN ("set-buffer-modified-p", Fset_buffer_modified_p, 1, 2, 0, /* -Mark BUFFER as modified or unmodified according to FLAG. -A non-nil FLAG means mark the buffer modified. No argument or nil -as BUFFER means use current buffer. -*/ - (flag, buffer)) -{ - /* This function can GC */ - struct buffer *buf = decode_buffer (buffer, 0); - -#ifdef CLASH_DETECTION - /* If buffer becoming modified, lock the file. - If buffer becoming unmodified, unlock the file. */ - - Lisp_Object fn = buf->file_truename; - if (!NILP (fn)) - { - int already = BUF_SAVE_MODIFF (buf) < BUF_MODIFF (buf); - if (already == NILP (flag)) - { - int count = specpdl_depth (); - /* lock_file() and unlock_file() currently use current_buffer */ - /* #### - dmoore, what if lock_file or unlock_file kill - the current buffer? */ - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - if (!already && !NILP (flag)) - lock_file (fn); - else if (already && NILP (flag)) - unlock_file (fn); - unbind_to (count, Qnil); - } - } -#endif /* CLASH_DETECTION */ - - /* This is often called when the buffer contents are altered but we - don't want to treat the changes that way (e.g. selective - display). We still need to make sure redisplay realizes that the - contents have potentially altered and it needs to do some - work. */ - buf = decode_buffer(buffer, 0); - BUF_MODIFF (buf)++; - BUF_SAVE_MODIFF (buf) = NILP (flag) ? BUF_MODIFF (buf) : 0; - MARK_MODELINE_CHANGED; - - return flag; -} - -DEFUN ("buffer-modified-tick", Fbuffer_modified_tick, 0, 1, 0, /* -Return BUFFER's tick counter, incremented for each change in text. -Each buffer has a tick counter which is incremented each time the text in -that buffer is changed. It wraps around occasionally. -No argument or nil as argument means use current buffer as BUFFER. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - return make_int (BUF_MODIFF (buf)); -} - -DEFUN ("rename-buffer", Frename_buffer, 1, 2, - "sRename buffer (to new name): \nP", /* -Change current buffer's name to NEWNAME (a string). -If second arg UNIQUE is nil or omitted, it is an error if a -buffer named NEWNAME already exists. -If UNIQUE is non-nil, come up with a new name using -`generate-new-buffer-name'. -Interactively, one can set UNIQUE with a prefix argument. -Returns the name we actually gave the buffer. -This does not change the name of the visited file (if any). -*/ - (newname, unique)) -{ - /* This function can GC */ - Lisp_Object tem, buf; - -#ifdef I18N3 - /* #### Doc string should indicate that the buffer name will get - translated. */ -#endif - CHECK_STRING (newname); - newname = LISP_GETTEXT (newname); - - if (XSTRING_LENGTH (newname) == 0) - error ("Empty string is invalid as a buffer name"); - - tem = Fget_buffer (newname); - /* Don't short-circuit if UNIQUE is t. That is a useful way to rename - the buffer automatically so you can create another with the original name. - It makes UNIQUE equivalent to - (rename-buffer (generate-new-buffer-name NEWNAME)). */ - /* XEmacs change: added check for nil */ - if (NILP (unique) && !NILP (tem) && XBUFFER (tem) == current_buffer) - return current_buffer->name; - if (!NILP (tem)) - { - if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, current_buffer->name); - else - error ("Buffer name \"%s\" is in use", - XSTRING_DATA (newname)); - } - - current_buffer->name = newname; - - /* Catch redisplay's attention. Unless we do this, the modelines for - any windows displaying current_buffer will stay unchanged. */ - MARK_MODELINE_CHANGED; - - buf = Fcurrent_buffer (); - - /* The aconses in the Vbuffer_alist are shared with frame->buffer_alist, - so this will change it in the per-frame ordering as well. */ - Fsetcar (Frassq (buf, Vbuffer_alist), newname); - if (NILP (current_buffer->filename) - && !NILP (current_buffer->auto_save_file_name)) - call0 (Qrename_auto_save_file); - /* refetch since that last call may have done GC */ - /* (hypothetical relocating GC) */ - return current_buffer->name; -} - -DEFUN ("other-buffer", Fother_buffer, 0, 3, 0, /* -Return most recently selected buffer other than BUFFER. -Buffers not visible in windows are preferred to visible buffers, -unless optional third argument VISIBLE-OK is non-nil. -If no other buffer exists, the buffer `*scratch*' is returned. -If BUFFER is omitted or nil, some interesting buffer is returned. - -The ordering is for this frame; If second optional argument FRAME -is provided, then the ordering is for that frame. If the second arg -is t, then the global ordering is returned. - -Note: In FSF Emacs, this function takes two arguments: BUFFER and -VISIBLE-OK. -*/ - (buffer, frame, visible_ok)) -{ - /* This function can GC */ - Lisp_Object tail, buf, notsogood, tem; - Lisp_Object alist; - - notsogood = Qnil; - - if (EQ (frame, Qt)) - alist = Vbuffer_alist; - else - { - struct frame *f = decode_frame (frame); - - XSETFRAME (frame, f); - alist = f->buffer_alist; - } - - for (tail = alist; !NILP (tail); tail = Fcdr (tail)) - { - buf = Fcdr (Fcar (tail)); - if (EQ (buf, buffer)) - continue; - if (string_byte (XSTRING (XBUFFER (buf)->name), 0) == ' ') - continue; - /* If FRAME has a buffer_predicate, - disregard buffers that don't fit the predicate. */ - if (FRAMEP (frame)) - { - tem = XFRAME (frame)->buffer_predicate; - if (!NILP (tem)) - { - tem = call1 (tem, buf); - if (NILP (tem)) - continue; - } - } - - if (NILP (visible_ok)) - { - /* get-buffer-window will handle nil or t frame */ - tem = Fget_buffer_window (buf, frame, Qnil); - } - else - tem = Qnil; - if (NILP (tem)) - return buf; - if (NILP (notsogood)) - notsogood = buf; - } - if (!NILP (notsogood)) - return notsogood; - return Fget_buffer_create (QSscratch); -} - -DEFUN ("buffer-disable-undo", Fbuffer_disable_undo, 0, 1, "", /* -Make BUFFER stop keeping undo information. -Any undo records it already has are discarded. -No argument or nil as argument means do this for the current buffer. -*/ - (buffer)) -{ - /* Allowing nil is an RMSism */ - struct buffer *real_buf = decode_buffer (buffer, 1); - real_buf->undo_list = Qt; - return Qnil; -} - -DEFUN ("buffer-enable-undo", Fbuffer_enable_undo, 0, 1, "", /* -Start keeping undo information for buffer BUFFER. -No argument or nil as argument means do this for the current buffer. -*/ - (buffer)) -{ - /* Allowing nil is an RMSism */ - struct buffer *real_buf = decode_buffer (buffer, 1); - if (EQ (real_buf->undo_list, Qt)) - real_buf->undo_list = Qnil; - - return Qnil; -} - -DEFUN ("kill-buffer", Fkill_buffer, 1, 1, "bKill buffer: ", /* -Kill the buffer BUFFER. -The argument may be a buffer or may be the name of a buffer. -An argument of nil means kill the current buffer. - -Value is t if the buffer is actually killed, nil if user says no. - -The value of `kill-buffer-hook' (which may be local to that buffer), -if not void, is a list of functions to be called, with no arguments, -before the buffer is actually killed. The buffer to be killed is current -when the hook functions are called. - -Any processes that have this buffer as the `process-buffer' are killed -with `delete-process'. -*/ - (buffer)) -{ - /* This function can call lisp */ - Lisp_Object buf; - REGISTER struct buffer *b; - struct gcpro gcpro1, gcpro2; - - if (NILP (buffer)) - buf = Fcurrent_buffer (); - else if (BUFFERP (buffer)) - buf = buffer; - else - { - buf = get_buffer (buffer, 0); - if (NILP (buf)) nsberror (buffer); - } - - b = XBUFFER (buf); - - /* OK to delete an already-deleted buffer. */ - if (!BUFFER_LIVE_P (b)) - return Qnil; - - /* Don't kill the minibuffer now current. */ - if (EQ (buf, Vminibuffer_zero)) - return Qnil; - - /* Or the echo area. */ - if (EQ (buf, Vecho_area_buffer)) - return Qnil; - - /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (b->filename) - && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) - { - Lisp_Object killp; - GCPRO1 (buf); - killp = call1 - (Qyes_or_no_p, - (emacs_doprnt_string_c - ((CONST Bufbyte *) GETTEXT ("Buffer %s modified; kill anyway? "), - Qnil, -1, XSTRING_DATA (b->name)))); - UNGCPRO; - if (NILP (killp)) - return Qnil; - b = XBUFFER (buf); /* Hypothetical relocating GC. */ - } - - /* Run hooks with the buffer to be killed temporarily selected, - unless the buffer is already dead (could have been deleted - in the question above). - */ - if (BUFFER_LIVE_P (b)) - { - int speccount = specpdl_depth (); - Lisp_Object tail = Qnil; - - GCPRO2 (buf, tail); - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - Fset_buffer (buf); - - /* First run the query functions; if any query is answered no, - don't kill the buffer. */ - EXTERNAL_LIST_LOOP (tail, Vkill_buffer_query_functions) - { - if (NILP (call0 (Fcar (tail)))) - { - UNGCPRO; - return unbind_to (speccount, Qnil); - } - } - - /* Then run the hooks. */ - run_hook (Qkill_buffer_hook); -#ifdef HAVE_X_WINDOWS - /* If an X selection was in this buffer, disown it. - We could have done this by simply adding this function to the - kill-buffer-hook, but the user might mess that up. - */ - if (EQ (Vwindow_system, Qx)) - call0 (intern ("xselect-kill-buffer-hook")); - /* #### generalize me! */ -#endif /* HAVE_X_WINDOWS */ - unbind_to (speccount, Qnil); - UNGCPRO; - b = XBUFFER (buf); /* Hypothetical relocating GC. */ - } - - /* We have no more questions to ask. Verify that it is valid - to kill the buffer. This must be done after the questions - since anything can happen within yes-or-no-p. */ - - /* Might have been deleted during the last question above */ - if (!BUFFER_LIVE_P (b)) - return Qnil; - - /* Don't kill the minibuffer now current. */ - if (EQ (buf, XWINDOW (minibuf_window)->buffer)) - return Qnil; - - /* When we kill a base buffer, kill all its indirect buffers. - We do it at this stage so nothing terrible happens if they - ask questions or their hooks get errors. */ - if (! b->base_buffer) - { - Lisp_Object rest; - - GCPRO1 (buf); - - LIST_LOOP (rest, b->indirect_children) - { - Fkill_buffer (XCAR (rest)); - /* Keep indirect_children updated in case a - query-function/hook throws. */ - b->indirect_children = XCDR (rest); - } - - UNGCPRO; - } - - /* Make this buffer not be current. - In the process, notice if this is the sole visible buffer - and give up if so. */ - if (b == current_buffer) - { - Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); - if (b == current_buffer) - return Qnil; - } - - /* Now there is no question: we can kill the buffer. */ - -#ifdef CLASH_DETECTION - /* Unlock this buffer's file, if it is locked. unlock_buffer - can both GC and kill the current buffer, and wreak general - havok by running lisp code. */ - GCPRO1 (buf); - unlock_buffer (b); - UNGCPRO; - b = XBUFFER (buf); - - if (!BUFFER_LIVE_P (b)) - return Qnil; - - if (b == current_buffer) - { - Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); - if (b == current_buffer) - return Qnil; - } -#endif /* CLASH_DETECTION */ - - { - int speccount = specpdl_depth (); - specbind (Qinhibit_quit, Qt); - - kill_buffer_processes (buf); - - /* #### This is a problem if this buffer is in a dedicated window. - Need to undedicate any windows of this buffer first (and delete them?) - */ - Freplace_buffer_in_windows (buf); - - delete_from_buffer_alist (buf); - - font_lock_buffer_was_killed (b); - - /* Delete any auto-save file, if we saved it in this session. */ - if (STRINGP (b->auto_save_file_name) - && b->auto_save_modified != 0 - && BUF_SAVE_MODIFF (b) < b->auto_save_modified) - { - if (delete_auto_save_files != 0) - { - /* deleting the auto save file might kill b! */ - /* #### dmoore - fix this crap, we do this same gcpro and - buffer liveness check multiple times. Let's get a - macro or something for it. */ - GCPRO1 (buf); - internal_delete_file (b->auto_save_file_name); - UNGCPRO; - b = XBUFFER (buf); - - if (!BUFFER_LIVE_P (b)) - return Qnil; - - if (b == current_buffer) - { - Fset_buffer (Fother_buffer (buf, Qnil, Qnil)); - if (b == current_buffer) - return Qnil; - } - } - } - - uninit_buffer_markers (b); - - kill_buffer_local_variables (b); - - b->name = Qnil; - uninit_buffer_text (b); - b->undo_list = Qnil; - uninit_buffer_extents (b); - if (b->base_buffer) - { -#ifdef ERROR_CHECK_BUFPOS - assert (!NILP (memq_no_quit (buf, b->base_buffer->indirect_children))); -#endif - b->base_buffer->indirect_children = - delq_no_quit (buf, b->base_buffer->indirect_children); - } - - /* Clear away all Lisp objects, so that they - won't be protected from GC. */ - nuke_all_buffer_slots (b, Qnil); - - unbind_to (speccount, Qnil); - } - return Qt; -} - -DEFUN ("record-buffer", Frecord_buffer, 1, 1, 0, /* -Place buffer BUFFER first in the buffer order. -Call this function when a buffer is selected "visibly". - -This function changes the global buffer order and the per-frame buffer -order for the selected frame. The buffer order keeps track of recency -of selection so that `other-buffer' will return a recently selected -buffer. See `other-buffer' for more information. -*/ - (buffer)) -{ - REGISTER Lisp_Object lynk, prev; - struct frame *f = selected_frame (); - - prev = Qnil; - for (lynk = Vbuffer_alist; CONSP (lynk); lynk = XCDR (lynk)) - { - if (EQ (XCDR (XCAR (lynk)), buffer)) - break; - prev = lynk; - } - /* Effectively do Vbuffer_alist = delq_no_quit (lynk, Vbuffer_alist) */ - if (NILP (prev)) - Vbuffer_alist = XCDR (Vbuffer_alist); - else - XCDR (prev) = XCDR (XCDR (prev)); - XCDR (lynk) = Vbuffer_alist; - Vbuffer_alist = lynk; - - /* That was the global one. Now do the same thing for the - per-frame buffer-alist. */ - prev = Qnil; - for (lynk = f->buffer_alist; CONSP (lynk); lynk = XCDR (lynk)) - { - if (EQ (XCDR (XCAR (lynk)), buffer)) - break; - prev = lynk; - } - /* Effectively do f->buffer_alist = delq_no_quit (lynk, f->buffer_alist) */ - if (NILP (prev)) - f->buffer_alist = XCDR (f->buffer_alist); - else - XCDR (prev) = XCDR (XCDR (prev)); - XCDR (lynk) = f->buffer_alist; - f->buffer_alist = lynk; - return Qnil; -} - -DEFUN ("set-buffer-major-mode", Fset_buffer_major_mode, 1, 1, 0, /* -Set an appropriate major mode for BUFFER, according to `default-major-mode'. -Use this function before selecting the buffer, since it may need to inspect -the current buffer's major mode. -*/ - (buffer)) -{ - int speccount = specpdl_depth (); - Lisp_Object function = XBUFFER (Vbuffer_defaults)->major_mode; - - if (NILP (function)) - { - Lisp_Object tem = Fget (current_buffer->major_mode, Qmode_class, Qnil); - if (NILP (tem)) - function = current_buffer->major_mode; - } - - if (NILP (function) || EQ (function, Qfundamental_mode)) - return Qnil; - - /* To select a nonfundamental mode, - select the buffer temporarily and then call the mode function. */ - - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - - Fset_buffer (buffer); - call0 (function); - - return unbind_to (speccount, Qnil); -} - -void -switch_to_buffer (Lisp_Object bufname, Lisp_Object norecord) -{ - call2 (Qswitch_to_buffer, bufname, norecord); -} - - -DEFUN ("current-buffer", Fcurrent_buffer, 0, 0, 0, /* -Return the current buffer as a Lisp object. -*/ - ()) -{ - Lisp_Object buffer; - XSETBUFFER (buffer, current_buffer); - return buffer; -} - -/* Set the current buffer to B. */ - -void -set_buffer_internal (struct buffer *b) -{ - REGISTER struct buffer *old_buf; - REGISTER Lisp_Object tail; - - if (current_buffer == b) - return; - - INVALIDATE_PIXEL_TO_GLYPH_CACHE; - - old_buf = current_buffer; - current_buffer = b; - invalidate_current_column (); /* invalidate indentation cache */ - -#ifdef HAVE_FEP - if (!noninteractive && initialized) - { - extern Lisp_Object Ffep_force_on (), Ffep_force_off (), Ffep_get_mode (); - - old_buf->fep_mode = Ffep_get_mode (); - - if (!NILP (current_buffer->fep_mode)) - Ffep_force_on (); - else - Ffep_force_off (); - } -#endif /* HAVE_FEP */ - - if (old_buf) - { - /* Put the undo list back in the base buffer, so that it appears - that an indirect buffer shares the undo list of its base. */ - if (old_buf->base_buffer) - old_buf->base_buffer->undo_list = old_buf->undo_list; - } - - /* Get the undo list from the base buffer, so that it appears - that an indirect buffer shares the undo list of its base. */ - if (b->base_buffer) - b->undo_list = b->base_buffer->undo_list; - - /* Look down buffer's list of local Lisp variables - to find and update any that forward into C variables. */ - - LIST_LOOP (tail, b->local_var_alist) - { - Lisp_Object sym = XCAR (XCAR (tail)); - Lisp_Object valcontents = XSYMBOL (sym)->value; - if (SYMBOL_VALUE_MAGIC_P (valcontents)) - { - /* Just reference the variable - to cause it to become set for this buffer. */ - /* Use find_symbol_value_quickly to avoid an unnecessary O(n) - lookup. */ - (void) find_symbol_value_quickly (XCAR (tail), 1); - } - } - - /* Do the same with any others that were local to the previous buffer */ - - if (old_buf) - { - LIST_LOOP (tail, old_buf->local_var_alist) - { - Lisp_Object sym = XCAR (XCAR (tail)); - Lisp_Object valcontents = XSYMBOL (sym)->value; - - if (SYMBOL_VALUE_MAGIC_P (valcontents)) - { - /* Just reference the variable - to cause it to become set for this buffer. */ - /* Use find_symbol_value_quickly with find_it_p as 0 to avoid an - unnecessary O(n) lookup which is guaranteed to be worst case. - Any symbols which are local are guaranteed to have been - handled in the previous loop, above. */ - (void) find_symbol_value_quickly (sym, 0); - } - } - } -} - -DEFUN ("set-buffer", Fset_buffer, 1, 1, 0, /* -Make the buffer BUFFER current for editing operations. -BUFFER may be a buffer or the name of an existing buffer. -See also `save-excursion' when you want to make a buffer current temporarily. -This function does not display the buffer, so its effect ends -when the current command terminates. -Use `switch-to-buffer' or `pop-to-buffer' to switch buffers permanently. -*/ - (buffer)) -{ - buffer = get_buffer (buffer, 0); - if (NILP (buffer)) - error ("Selecting deleted or non-existent buffer"); - set_buffer_internal (XBUFFER (buffer)); - return buffer; -} - - -DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, 0, 3, 0, /* -Signal a `buffer-read-only' error if the buffer is read-only. -Optional argument BUFFER defaults to the current buffer. - -If optional argument START is non-nil, all extents in the buffer -which overlap that part of the buffer are checked to ensure none has a -`read-only' property. (Extents that lie completely within the range, -however, are not checked.) END defaults to the value of START. - -If START and END are equal, the range checked is [START, END] (i.e. -closed on both ends); otherwise, the range checked is (START, END) -\(open on both ends), except that extents that lie completely within -[START, END] are not checked. See `extent-in-region-p' for a fuller -discussion. -*/ - (buffer, start, end)) -{ - struct buffer *b = decode_buffer (buffer, 0); - Bufpos s, e; - - if (NILP (start)) - s = e = -1; - else - { - if (NILP (end)) - end = start; - get_buffer_range_char (b, start, end, &s, &e, 0); - } - barf_if_buffer_read_only (b, s, e); - - return Qnil; -} - -static void -bury_buffer_1 (Lisp_Object buffer, Lisp_Object before, - Lisp_Object *buffer_alist) -{ - Lisp_Object aelt = rassq_no_quit (buffer, *buffer_alist); - Lisp_Object lynk = memq_no_quit (aelt, *buffer_alist); - Lisp_Object iter, before_before; - - *buffer_alist = delq_no_quit (aelt, *buffer_alist); - for (before_before = Qnil, iter = *buffer_alist; - !NILP (iter) && !EQ (XCDR (XCAR (iter)), before); - before_before = iter, iter = XCDR (iter)) - ; - XCDR (lynk) = iter; - if (!NILP (before_before)) - XCDR (before_before) = lynk; - else - *buffer_alist = lynk; -} - -DEFUN ("bury-buffer", Fbury_buffer, 0, 2, "", /* -Put BUFFER at the end of the list of all buffers. -There it is the least likely candidate for `other-buffer' to return; -thus, the least likely buffer for \\[switch-to-buffer] to select by default. -If BUFFER is nil or omitted, bury the current buffer. -Also, if BUFFER is nil or omitted, remove the current buffer from the -selected window if it is displayed there. -If BEFORE is non-nil, it specifies a buffer before which BUFFER -will be placed, instead of being placed at the end. -*/ - (buffer, before)) -{ - /* This function can GC */ - struct buffer *buf = decode_buffer (buffer, 1); - /* If we're burying the current buffer, unshow it. */ - /* Note that the behavior of (bury-buffer nil) and - (bury-buffer (current-buffer)) is not the same. - This is illogical but is historical. Changing it - breaks mh-e and TeX and such packages. */ - if (NILP (buffer)) - switch_to_buffer (Fother_buffer (Fcurrent_buffer (), Qnil, Qnil), Qnil); - XSETBUFFER (buffer, buf); - - if (!NILP (before)) - before = get_buffer (before, 1); - - if (EQ (before, buffer)) - error ("Cannot place a buffer before itself"); - - bury_buffer_1 (buffer, before, &Vbuffer_alist); - bury_buffer_1 (buffer, before, &selected_frame ()->buffer_alist); - - return Qnil; -} - - -DEFUN ("erase-buffer", Ferase_buffer, 0, 1, "*", /* -Delete the entire contents of the BUFFER. -Any clipping restriction in effect (see `narrow-to-region') is removed, -so the buffer is truly empty after this. -BUFFER defaults to the current buffer if omitted. -*/ - (buffer)) -{ - /* This function can GC */ - struct buffer *b = decode_buffer (buffer, 1); - /* #### yuck yuck yuck. This is gross. The old echo-area code, - however, was the only place that called erase_buffer() with a - non-zero NO_CLIP argument. - - Someone needs to fix up the redisplay code so it is smarter - about this, so that the NO_CLIP junk isn't necessary. */ - int no_clip = (b == XBUFFER (Vecho_area_buffer)); - - INVALIDATE_PIXEL_TO_GLYPH_CACHE; - - widen_buffer (b, no_clip); - buffer_delete_range (b, BUF_BEG (b), BUF_Z (b), 0); - b->last_window_start = 1; - - /* Prevent warnings, or suspension of auto saving, that would happen - if future size is less than past size. Use of erase-buffer - implies that the future text is not really related to the past text. */ - b->saved_size = Qzero; - - zmacs_region_stays = 0; - return Qnil; -} - - - -DEFUN ("kill-all-local-variables", Fkill_all_local_variables, 0, 0, 0, /* -Switch to Fundamental mode by killing current buffer's local variables. -Most local variable bindings are eliminated so that the default values -become effective once more. Also, the syntax table is set from -`standard-syntax-table', the category table is set from -`standard-category-table' (if support for Mule exists), local keymap is set -to nil, the abbrev table is set from `fundamental-mode-abbrev-table', -and all specifier specifications whose locale is the current buffer -are removed. This function also forces redisplay of the modeline. - -Every function to select a new major mode starts by -calling this function. - -As a special exception, local variables whose names have -a non-nil `permanent-local' property are not eliminated by this function. - -The first thing this function does is run -the normal hook `change-major-mode-hook'. -*/ - ()) -{ - /* This function can GC */ - run_hook (Qchange_major_mode_hook); - - reset_buffer_local_variables (current_buffer, 0); - - kill_buffer_local_variables (current_buffer); - - kill_specifier_buffer_locals (Fcurrent_buffer ()); - - /* Force modeline redisplay. Useful here because all major mode - commands call this function. */ - MARK_MODELINE_CHANGED; - - return Qnil; -} - -#ifdef MEMORY_USAGE_STATS - -struct buffer_stats -{ - int text; - int markers; - int extents; - int other; -}; - -static size_t -compute_buffer_text_usage (struct buffer *b, struct overhead_stats *ovstats) -{ - int was_requested = b->text->z - 1; - size_t gap = b->text->gap_size + b->text->end_gap_size; - size_t malloc_use = malloced_storage_size (b->text->beg, was_requested + gap, 0); - - ovstats->gap_overhead += gap; - ovstats->was_requested += was_requested; - ovstats->malloc_overhead += malloc_use - (was_requested + gap); - return malloc_use; -} - -static void -compute_buffer_usage (struct buffer *b, struct buffer_stats *stats, - struct overhead_stats *ovstats) -{ - xzero (*stats); - stats->other += malloced_storage_size (b, sizeof (*b), ovstats); - stats->text += compute_buffer_text_usage (b, ovstats); - stats->markers += compute_buffer_marker_usage (b, ovstats); - stats->extents += compute_buffer_extent_usage (b, ovstats); -} - -DEFUN ("buffer-memory-usage", Fbuffer_memory_usage, 1, 1, 0, /* -Return stats about the memory usage of buffer BUFFER. -The values returned are in the form of an alist of usage types and byte -counts. The byte counts attempt to encompass all the memory used -by the buffer (separate from the memory logically associated with a -buffer or frame), including internal structures and any malloc() -overhead associated with them. In practice, the byte counts are -underestimated because certain memory usage is very hard to determine -\(e.g. the amount of memory used inside the Xt library or inside the -X server) and because there is other stuff that might logically -be associated with a window, buffer, or frame (e.g. window configurations, -glyphs) but should not obviously be included in the usage counts. - -Multiple slices of the total memory usage may be returned, separated -by a nil. Each slice represents a particular view of the memory, a -particular way of partitioning it into groups. Within a slice, there -is no overlap between the groups of memory, and each slice collectively -represents all the memory concerned. -*/ - (buffer)) -{ - struct buffer_stats stats; - struct overhead_stats ovstats; - Lisp_Object val = Qnil; - - CHECK_BUFFER (buffer); /* dead buffers should be allowed, no? */ - xzero (ovstats); - compute_buffer_usage (XBUFFER (buffer), &stats, &ovstats); - - val = acons (Qtext, make_int (stats.text), val); - val = acons (Qmarkers, make_int (stats.markers), val); - val = acons (Qextents, make_int (stats.extents), val); - val = acons (Qother, make_int (stats.other), val); - val = Fcons (Qnil, val); - val = acons (Qactually_requested, make_int (ovstats.was_requested), val); - val = acons (Qmalloc_overhead, make_int (ovstats.malloc_overhead), val); - val = acons (Qgap_overhead, make_int (ovstats.gap_overhead), val); - val = acons (Qdynarr_overhead, make_int (ovstats.dynarr_overhead), val); - - return Fnreverse (val); -} - -#endif /* MEMORY_USAGE_STATS */ - -void -syms_of_buffer (void) -{ - defsymbol (&Qbuffer_live_p, "buffer-live-p"); - defsymbol (&Qbuffer_or_string_p, "buffer-or-string-p"); - defsymbol (&Qmode_class, "mode-class"); - defsymbol (&Qrename_auto_save_file, "rename-auto-save-file"); - defsymbol (&Qkill_buffer_hook, "kill-buffer-hook"); - defsymbol (&Qpermanent_local, "permanent-local"); - - defsymbol (&Qfirst_change_hook, "first-change-hook"); - defsymbol (&Qbefore_change_functions, "before-change-functions"); - defsymbol (&Qafter_change_functions, "after-change-functions"); - - /* #### Obsolete, for compatibility */ - defsymbol (&Qbefore_change_function, "before-change-function"); - defsymbol (&Qafter_change_function, "after-change-function"); - - defsymbol (&Qbuffer_file_name, "buffer-file-name"); - defsymbol (&Qbuffer_undo_list, "buffer-undo-list"); - defsymbol (&Qdefault_directory, "default-directory"); - - defsymbol (&Qget_file_buffer, "get-file-buffer"); - defsymbol (&Qchange_major_mode_hook, "change-major-mode-hook"); - - defsymbol (&Qfundamental_mode, "fundamental-mode"); - - defsymbol (&Qfind_file_compare_truenames, "find-file-compare-truenames"); - - defsymbol (&Qswitch_to_buffer, "switch-to-buffer"); - - DEFSUBR (Fbufferp); - DEFSUBR (Fbuffer_live_p); - DEFSUBR (Fbuffer_list); - DEFSUBR (Fdecode_buffer); - DEFSUBR (Fget_buffer); - DEFSUBR (Fget_file_buffer); - DEFSUBR (Fget_buffer_create); - DEFSUBR (Fmake_indirect_buffer); - - DEFSUBR (Fgenerate_new_buffer_name); - DEFSUBR (Fbuffer_name); - DEFSUBR (Fbuffer_file_name); - DEFSUBR (Fbuffer_base_buffer); - DEFSUBR (Fbuffer_indirect_children); - DEFSUBR (Fbuffer_local_variables); - DEFSUBR (Fbuffer_dedicated_frame); - DEFSUBR (Fset_buffer_dedicated_frame); - DEFSUBR (Fbuffer_modified_p); - DEFSUBR (Fset_buffer_modified_p); - DEFSUBR (Fbuffer_modified_tick); - DEFSUBR (Frename_buffer); - DEFSUBR (Fother_buffer); - DEFSUBR (Fbuffer_disable_undo); - DEFSUBR (Fbuffer_enable_undo); - DEFSUBR (Fkill_buffer); - DEFSUBR (Ferase_buffer); - DEFSUBR (Frecord_buffer); - DEFSUBR (Fset_buffer_major_mode); - DEFSUBR (Fcurrent_buffer); - DEFSUBR (Fset_buffer); - DEFSUBR (Fbarf_if_buffer_read_only); - DEFSUBR (Fbury_buffer); - DEFSUBR (Fkill_all_local_variables); -#ifdef MEMORY_USAGE_STATS - DEFSUBR (Fbuffer_memory_usage); -#endif - - deferror (&Qprotected_field, "protected-field", - "Attempt to modify a protected field", Qerror); -} - -/* initialize the buffer routines */ -void -vars_of_buffer (void) -{ - /* This function can GC */ - staticpro (&QSFundamental); - staticpro (&QSscratch); - staticpro (&Vbuffer_alist); - - QSFundamental = Fpurecopy (build_string ("Fundamental")); - QSscratch = Fpurecopy (build_string (DEFER_GETTEXT ("*scratch*"))); - - Vbuffer_alist = Qnil; - current_buffer = 0; - - DEFVAR_LISP ("change-major-mode-hook", &Vchange_major_mode_hook /* -List of hooks to be run before killing local variables in a buffer. -This should be used by any mode that temporarily alters the contents or -the read-only state of the buffer. See also `kill-all-local-variables'. -*/ ); - Vchange_major_mode_hook = Qnil; - - DEFVAR_BOOL ("find-file-compare-truenames", &find_file_compare_truenames /* -If this is true, then the find-file command will check the truenames -of all visited files when deciding whether a given file is already in -a buffer, instead of just the buffer-file-name. This means that if you -attempt to visit another file which is a symbolic-link to a file which is -already in a buffer, the existing buffer will be found instead of a newly- -created one. This works if any component of the pathname (including a non- -terminal component) is a symbolic link as well, but doesn't work with hard -links (nothing does). - -See also the variable find-file-use-truenames. -*/ ); - find_file_compare_truenames = 0; - - DEFVAR_BOOL ("find-file-use-truenames", &find_file_use_truenames /* -If this is true, then a buffer's visited file-name will always be -chased back to the real file; it will never be a symbolic link, and there -will never be a symbolic link anywhere in its directory path. -That is, the buffer-file-name and buffer-file-truename will be equal. -This doesn't work with hard links. - -See also the variable find-file-compare-truenames. -*/ ); - find_file_use_truenames = 0; - - DEFVAR_LISP ("before-change-functions", &Vbefore_change_functions /* -List of functions to call before each text change. -Two arguments are passed to each function: the positions of -the beginning and end of the range of old text to be changed. -\(For an insertion, the beginning and end are at the same place.) -No information is given about the length of the text after the change. - -Buffer changes made while executing the `before-change-functions' -don't call any before-change or after-change functions. -*/ ); - Vbefore_change_functions = Qnil; - - /* FSF Emacs has the following additional doc at the end of - before-change-functions and after-change-functions: - -That's because these variables are temporarily set to nil. -As a result, a hook function cannot straightforwardly alter the value of -these variables. See the Emacs Lisp manual for a way of -accomplishing an equivalent result by using other variables. - - But this doesn't apply under XEmacs because things are - handled better. */ - - DEFVAR_LISP ("after-change-functions", &Vafter_change_functions /* -List of functions to call after each text change. -Three arguments are passed to each function: the positions of -the beginning and end of the range of changed text, -and the length of the pre-change text replaced by that range. -\(For an insertion, the pre-change length is zero; -for a deletion, that length is the number of characters deleted, -and the post-change beginning and end are at the same place.) - -Buffer changes made while executing `after-change-functions' -don't call any before-change or after-change functions. -*/ ); - Vafter_change_functions = Qnil; - - DEFVAR_LISP ("before-change-function", &Vbefore_change_function /* - -*/ ); /* obsoleteness will be documented */ - Vbefore_change_function = Qnil; - - DEFVAR_LISP ("after-change-function", &Vafter_change_function /* - -*/ ); /* obsoleteness will be documented */ - Vafter_change_function = Qnil; - - DEFVAR_LISP ("first-change-hook", &Vfirst_change_hook /* -A list of functions to call before changing a buffer which is unmodified. -The functions are run using the `run-hooks' function. -*/ ); - Vfirst_change_hook = Qnil; - -#if 0 /* FSFmacs */ - xxDEFVAR_LISP ("transient-mark-mode", &Vtransient_mark_mode /* -*Non-nil means deactivate the mark when the buffer contents change. -*/ ); - Vtransient_mark_mode = Qnil; -#endif /* FSFmacs */ - - DEFVAR_INT ("undo-threshold", &undo_threshold /* -Keep no more undo information once it exceeds this size. -This threshold is applied when garbage collection happens. -The size is counted as the number of bytes occupied, -which includes both saved text and other data. -*/ ); - undo_threshold = 20000; - - DEFVAR_INT ("undo-high-threshold", &undo_high_threshold /* -Don't keep more than this much size of undo information. -A command which pushes past this size is itself forgotten. -This threshold is applied when garbage collection happens. -The size is counted as the number of bytes occupied, -which includes both saved text and other data. -*/ ); - undo_high_threshold = 30000; - - DEFVAR_LISP ("inhibit-read-only", &Vinhibit_read_only /* -*Non-nil means disregard read-only status of buffers or characters. -If the value is t, disregard `buffer-read-only' and all `read-only' -text properties. If the value is a list, disregard `buffer-read-only' -and disregard a `read-only' extent property or text property if the -property value is a member of the list. -*/ ); - Vinhibit_read_only = Qnil; - - DEFVAR_LISP ("kill-buffer-query-functions", &Vkill_buffer_query_functions /* -List of functions called with no args to query before killing a buffer. -*/ ); - Vkill_buffer_query_functions = Qnil; - - DEFVAR_BOOL ("delete-auto-save-files", &delete_auto_save_files /* -*Non-nil means delete auto-save file when a buffer is saved or killed. -*/ ); - delete_auto_save_files = 1; -} - -/* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ - -/* Renamed from DEFVAR_PER_BUFFER because FSFmacs D_P_B takes - a bogus extra arg, which confuses an otherwise identical make-docfile.c */ - -/* Declaring this stuff as const produces 'Cannot reinitialize' messages - from SunPro C's fix-and-continue feature (a way neato feature that - makes debugging unbelievably more bearable) */ -#define DEFVAR_BUFFER_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ - static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { symbol_value_forward_lheader_initializer, \ - (struct lcrecord_header *) &(buffer_local_flags.field_name), 69 }, \ - forward_type }, magicfun }; \ - { \ - int offset = ((char *)symbol_value_forward_forward (&I_hate_C) - \ - (char *)&buffer_local_flags); \ - defvar_magic (lname, &I_hate_C); \ - \ - *((Lisp_Object *)(offset + (char *)XBUFFER (Vbuffer_local_symbols))) \ - = intern (lname); \ - } \ -} while (0) - -#define DEFVAR_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ - DEFVAR_BUFFER_LOCAL_1 (lname, field_name, \ - SYMVAL_CURRENT_BUFFER_FORWARD, magicfun) -#define DEFVAR_BUFFER_LOCAL(lname, field_name) \ - DEFVAR_BUFFER_LOCAL_MAGIC (lname, field_name, 0) -#define DEFVAR_CONST_BUFFER_LOCAL_MAGIC(lname, field_name, magicfun) \ - DEFVAR_BUFFER_LOCAL_1 (lname, field_name, \ - SYMVAL_CONST_CURRENT_BUFFER_FORWARD, magicfun) -#define DEFVAR_CONST_BUFFER_LOCAL(lname, field_name) \ - DEFVAR_CONST_BUFFER_LOCAL_MAGIC (lname, field_name, 0) - -#define DEFVAR_BUFFER_DEFAULTS_MAGIC(lname, field_name, magicfun) \ - DEFVAR_SYMVAL_FWD (lname, &(buffer_local_flags.field_name), \ - SYMVAL_DEFAULT_BUFFER_FORWARD, magicfun) -#define DEFVAR_BUFFER_DEFAULTS(lname, field_name) \ - DEFVAR_BUFFER_DEFAULTS_MAGIC (lname, field_name, 0) - -static void -nuke_all_buffer_slots (struct buffer *b, Lisp_Object zap) -{ - zero_lcrecord (b); - - b->extent_info = Qnil; - b->indirect_children = Qnil; - b->own_text.line_number_cache = Qnil; - -#define MARKED_SLOT(x) b->x = (zap); -#include "bufslots.h" -#undef MARKED_SLOT -} - -void -complex_vars_of_buffer (void) -{ - /* Make sure all markable slots in buffer_defaults - are initialized reasonably, so mark_buffer won't choke. */ - struct buffer *defs = alloc_lcrecord_type (struct buffer, lrecord_buffer); - struct buffer *syms = alloc_lcrecord_type (struct buffer, lrecord_buffer); - - staticpro (&Vbuffer_defaults); - staticpro (&Vbuffer_local_symbols); - XSETBUFFER (Vbuffer_defaults, defs); - XSETBUFFER (Vbuffer_local_symbols, syms); - - nuke_all_buffer_slots (syms, Qnil); - nuke_all_buffer_slots (defs, Qnil); - defs->text = &defs->own_text; - syms->text = &syms->own_text; - - /* Set up the non-nil default values of various buffer slots. - Must do these before making the first buffer. */ - defs->major_mode = Qfundamental_mode; - defs->mode_name = QSFundamental; - defs->abbrev_table = Qnil; /* real default setup by Lisp code */ - - defs->downcase_table = Vascii_downcase_table; - defs->upcase_table = Vascii_upcase_table; - defs->case_canon_table = Vascii_canon_table; - defs->case_eqv_table = Vascii_eqv_table; -#ifdef MULE - defs->mirror_downcase_table = Vmirror_ascii_downcase_table; - defs->mirror_upcase_table = Vmirror_ascii_upcase_table; - defs->mirror_case_canon_table = Vmirror_ascii_canon_table; - defs->mirror_case_eqv_table = Vmirror_ascii_eqv_table; - - defs->category_table = Vstandard_category_table; -#endif /* MULE */ - defs->syntax_table = Vstandard_syntax_table; - defs->mirror_syntax_table = - XCHAR_TABLE (Vstandard_syntax_table)->mirror_table; - defs->modeline_format = build_string ("%-"); /* reset in loaddefs.el */ - defs->case_fold_search = Qt; - defs->selective_display_ellipses = Qt; - defs->tab_width = make_int (8); - defs->ctl_arrow = Qt; - defs->fill_column = make_int (70); - defs->left_margin = Qzero; - defs->saved_size = Qzero; /* lisp code wants int-or-nil */ - defs->modtime = 0; - defs->auto_save_modified = 0; - defs->auto_save_failure_time = -1; - defs->invisibility_spec = Qt; - - defs->indirect_children = Qnil; - syms->indirect_children = Qnil; - - { - /* 0 means var is always local. Default used only at creation. - * -1 means var is always local. Default used only at reset and - * creation. - * -2 means there's no lisp variable corresponding to this slot - * and the default is only used at creation. - * -3 means no Lisp variable. Default used only at reset and creation. - * >0 is mask. Var is local if ((buffer->local_var_flags & mask) != 0) - * Otherwise default is used. - */ - Lisp_Object always_local_no_default = make_int (0); - Lisp_Object always_local_resettable = make_int (-1); - Lisp_Object resettable = make_int (-3); - - /* Assign the local-flags to the slots that have default values. - The local flag is a bit that is used in the buffer - to say that it has its own local value for the slot. - The local flag bits are in the local_var_flags slot of the - buffer. */ - - nuke_all_buffer_slots (&buffer_local_flags, make_int (-2)); - buffer_local_flags.filename = always_local_no_default; - buffer_local_flags.directory = always_local_no_default; - buffer_local_flags.backed_up = always_local_no_default; - buffer_local_flags.saved_size = always_local_no_default; - buffer_local_flags.auto_save_file_name = always_local_no_default; - buffer_local_flags.read_only = always_local_no_default; - - buffer_local_flags.major_mode = always_local_resettable; - buffer_local_flags.mode_name = always_local_resettable; - buffer_local_flags.undo_list = always_local_no_default; -#if 0 /* FSFmacs */ - buffer_local_flags.mark_active = always_local_resettable; -#endif - buffer_local_flags.point_before_scroll = always_local_resettable; - buffer_local_flags.file_truename = always_local_no_default; - buffer_local_flags.invisibility_spec = always_local_resettable; - buffer_local_flags.file_format = always_local_resettable; - buffer_local_flags.generated_modeline_string = always_local_no_default; - - buffer_local_flags.keymap = resettable; - buffer_local_flags.downcase_table = resettable; - buffer_local_flags.upcase_table = resettable; - buffer_local_flags.case_canon_table = resettable; - buffer_local_flags.case_eqv_table = resettable; - buffer_local_flags.syntax_table = resettable; -#ifdef MULE - buffer_local_flags.category_table = resettable; -#endif - - buffer_local_flags.modeline_format = make_int (1<<0); - buffer_local_flags.abbrev_mode = make_int (1<<1); - buffer_local_flags.overwrite_mode = make_int (1<<2); - buffer_local_flags.case_fold_search = make_int (1<<3); - buffer_local_flags.auto_fill_function = make_int (1<<4); - buffer_local_flags.selective_display = make_int (1<<5); - buffer_local_flags.selective_display_ellipses = make_int (1<<6); - buffer_local_flags.tab_width = make_int (1<<7); - buffer_local_flags.truncate_lines = make_int (1<<8); - buffer_local_flags.ctl_arrow = make_int (1<<9); - buffer_local_flags.fill_column = make_int (1<<10); - buffer_local_flags.left_margin = make_int (1<<11); - buffer_local_flags.abbrev_table = make_int (1<<12); -#ifdef REGION_CACHE_NEEDS_WORK - buffer_local_flags.cache_long_line_scans = make_int (1<<13); -#endif -#ifdef FILE_CODING - buffer_local_flags.buffer_file_coding_system = make_int (1<<14); -#endif - - /* #### Warning: 1<<28 is the largest number currently allowable - due to the XINT() handling of this value. With some - rearrangement you can get 3 more bits. */ - } - - DEFVAR_BUFFER_DEFAULTS ("default-modeline-format", modeline_format /* -Default value of `modeline-format' for buffers that don't override it. -This is the same as (default-value 'modeline-format). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-abbrev-mode", abbrev_mode /* -Default value of `abbrev-mode' for buffers that do not override it. -This is the same as (default-value 'abbrev-mode). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-ctl-arrow", ctl_arrow /* -Default value of `ctl-arrow' for buffers that do not override it. -This is the same as (default-value 'ctl-arrow). -*/ ); - -#if 0 /* #### make this a specifier! */ - DEFVAR_BUFFER_DEFAULTS ("default-display-direction", display_direction /* -Default display-direction for buffers that do not override it. -This is the same as (default-value 'display-direction). -Note: This is not yet implemented. -*/ ); -#endif - - DEFVAR_BUFFER_DEFAULTS ("default-truncate-lines", truncate_lines /* -Default value of `truncate-lines' for buffers that do not override it. -This is the same as (default-value 'truncate-lines). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-fill-column", fill_column /* -Default value of `fill-column' for buffers that do not override it. -This is the same as (default-value 'fill-column). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-left-margin", left_margin /* -Default value of `left-margin' for buffers that do not override it. -This is the same as (default-value 'left-margin). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-tab-width", tab_width /* -Default value of `tab-width' for buffers that do not override it. -This is the same as (default-value 'tab-width). -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-case-fold-search", case_fold_search /* -Default value of `case-fold-search' for buffers that don't override it. -This is the same as (default-value 'case-fold-search). -*/ ); - - DEFVAR_BUFFER_LOCAL ("modeline-format", modeline_format /* -Template for displaying modeline for current buffer. -Each buffer has its own value of this variable. -Value may be a string, a symbol or a list or cons cell. -For a symbol, its value is used (but it is ignored if t or nil). - A string appearing directly as the value of a symbol is processed verbatim - in that the %-constructs below are not recognized. -For a glyph, it is inserted as is. -For a list whose car is a symbol, the symbol's value is taken, - and if that is non-nil, the cadr of the list is processed recursively. - Otherwise, the caddr of the list (if there is one) is processed. -For a list whose car is a string or list, each element is processed - recursively and the results are effectively concatenated. -For a list whose car is an integer, the cdr of the list is processed - and padded (if the number is positive) or truncated (if negative) - to the width specified by that number. -For a list whose car is an extent, the cdr of the list is processed - normally but the results are displayed using the face of the - extent, and mouse clicks over this section are processed using the - keymap of the extent. (In addition, if the extent has a help-echo - property, that string will be echoed when the mouse moves over this - section.) See `generated-modeline-string' for more information. -For a list whose car is a face, the cdr of the list is processed - normally but the results will be displayed using the face in the car. -For a list whose car is a keymap, the cdr of the list is processed - normally but the keymap will apply for mouse clicks over the results, - in addition to `modeline-map'. Nested keymap specifications are - handled properly. -A string is printed verbatim in the modeline except for %-constructs: - (%-constructs are processed when the string is the entire modeline-format - or when it is found in a cons-cell or a list) - %b -- print buffer name. %c -- print the current column number. - %f -- print visited file name. - %* -- print %, * or hyphen. %+ -- print *, % or hyphen. - % means buffer is read-only and * means it is modified. - For a modified read-only buffer, %* gives % and %+ gives *. - %s -- print process status. %l -- print the current line number. - %S -- print name of selected frame (only meaningful under X Windows). - %p -- print percent of buffer above top of window, or Top, Bot or All. - %P -- print percent of buffer above bottom of window, perhaps plus Top, - or print Bottom or All. - %n -- print Narrow if appropriate. - %C -- under XEmacs/mule, print the mnemonic for `buffer-file-coding-system'. - %[ -- print one [ for each recursive editing level. %] similar. - %% -- print %. %- -- print infinitely many dashes. -Decimal digits after the % specify field width to which to pad. -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode /* -*Major mode for new buffers. Defaults to `fundamental-mode'. -nil here means use current buffer's major mode. -*/ ); - - DEFVAR_BUFFER_DEFAULTS ("fundamental-mode-abbrev-table", abbrev_table /* -The abbrev table of mode-specific abbrevs for Fundamental Mode. -*/ ); - - DEFVAR_BUFFER_LOCAL ("major-mode", major_mode /* -Symbol for current buffer's major mode. -*/ ); - - DEFVAR_BUFFER_LOCAL ("mode-name", mode_name /* -Pretty name of current buffer's major mode (a string). -*/ ); - - DEFVAR_BUFFER_LOCAL ("abbrev-mode", abbrev_mode /* -Non-nil turns on automatic expansion of abbrevs as they are inserted. -Automatically becomes buffer-local when set in any fashion. -*/ ); - - DEFVAR_BUFFER_LOCAL ("case-fold-search", case_fold_search /* -*Non-nil if searches should ignore case. -Automatically becomes buffer-local when set in any fashion. - -BUG: Under XEmacs/Mule, translations to or from non-ASCII characters - (this includes chars in the range 128 - 255) are ignored by - the string/buffer-searching routines. Thus, `case-fold-search' - will not correctly conflate a-umlaut and A-umlaut even if the - case tables call for this. -*/ ); - - DEFVAR_BUFFER_LOCAL ("fill-column", fill_column /* -*Column beyond which automatic line-wrapping should happen. -Automatically becomes buffer-local when set in any fashion. -*/ ); - - DEFVAR_BUFFER_LOCAL ("left-margin", left_margin /* -*Column for the default indent-line-function to indent to. -Linefeed indents to this column in Fundamental mode. -Automatically becomes buffer-local when set in any fashion. -Do not confuse this with the specifier `left-margin-width'; -that controls the size of a margin that is displayed outside -of the text area. -*/ ); - - DEFVAR_BUFFER_LOCAL_MAGIC ("tab-width", tab_width /* -*Distance between tab stops (for display of tab characters), in columns. -Automatically becomes buffer-local when set in any fashion. -*/ , redisplay_variable_changed); - - DEFVAR_BUFFER_LOCAL_MAGIC ("ctl-arrow", ctl_arrow /* -*Non-nil means display control chars with uparrow. -Nil means use backslash and octal digits. -An integer means characters >= ctl-arrow are assumed to be printable, and -will be displayed as a single glyph. -Any other value is the same as 160 - the code SPC with the high bit on. - -The interpretation of this variable is likely to change in the future. - -Automatically becomes buffer-local when set in any fashion. -This variable does not apply to characters whose display is specified -in the current display table (if there is one). -*/ , redisplay_variable_changed); - -#if 0 /* #### Make this a specifier! */ - xxDEFVAR_BUFFER_LOCAL ("display-direction", display_direction /* -*Non-nil means lines in the buffer are displayed right to left. -Nil means left to right. (Not yet implemented.) -*/ ); -#endif /* Not yet implemented */ - - DEFVAR_BUFFER_LOCAL_MAGIC ("truncate-lines", truncate_lines /* -*Non-nil means do not display continuation lines; -give each line of text one frame line. -Automatically becomes buffer-local when set in any fashion. - -Note that this is overridden by the variable -`truncate-partial-width-windows' if that variable is non-nil -and this buffer is not full-frame width. -*/ , redisplay_variable_changed); - - DEFVAR_BUFFER_LOCAL ("default-directory", directory /* -Name of default directory of current buffer. Should end with slash. -Each buffer has its own value of this variable. -*/ ); - -#ifdef FILE_CODING - DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-coding-system", buffer_file_coding_system /* -Default value of `buffer-file-coding-system' for buffers that do not override it. -This is the same as (default-value 'buffer-file-coding-system). -This value is used both for buffers without associated files and -for buffers whose files do not have any apparent coding system. -See `buffer-file-coding-system'. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-file-coding-system", buffer_file_coding_system /* -*Current coding system for the current buffer. -When the buffer is written out into a file, this coding system will be -used for the encoding. Automatically buffer-local when set in any -fashion. This is normally set automatically when a file is loaded in -based on the determined coding system of the file (assuming that -`buffer-file-coding-system-for-read' is set to `undecided', which -calls for automatic determination of the file's coding system). -Normally the modeline indicates the current file coding system using -its mnemonic abbreviation. - -The default value for this variable (which is normally used for -buffers without associated files) is also used when automatic -detection of a file's encoding is called for and there was no -discernible encoding in the file (i.e. it was entirely or almost -entirely ASCII). The default value should generally *not* be set to -nil (equivalent to `no-conversion'), because if extended characters -are ever inserted into the buffer, they will be lost when the file is -written out. A good choice is `iso-2022-8' (the simple ISO 2022 8-bit -encoding), which will write out ASCII and Latin-1 characters in the -standard (and highly portable) fashion and use standard escape -sequences for other charsets. Another reasonable choice is -`escape-quoted', which is equivalent to `iso-2022-8' but prefixes -certain control characters with ESC to make sure they are not -interpreted as escape sequences when read in. This latter coding -system results in more "correct" output in the presence of control -characters in the buffer, in the sense that when read in again using -the same coding system, the result will virtually always match the -original contents of the buffer, which is not the case with -`iso-2022-8'; but the output is less portable when dealing with binary -data -- there may be stray ESC characters when the file is read by -another program. - -`buffer-file-coding-system' does *not* control the coding system used when -a file is read in. Use the variables `buffer-file-coding-system-for-read' -and `buffer-file-coding-system-alist' for that. From a Lisp program, if -you wish to unilaterally specify the coding system used for one -particular operation, you should bind the variable -`coding-system-for-read' rather than changing the other two -variables just mentioned, which are intended to be used for -global environment specification. -*/ ); -#endif /* FILE_CODING */ - - DEFVAR_BUFFER_LOCAL ("auto-fill-function", auto_fill_function /* -Function called (if non-nil) to perform auto-fill. -It is called after self-inserting a space at a column beyond `fill-column'. -Each buffer has its own value of this variable. -NOTE: This variable is not an ordinary hook; -It may not be a list of functions. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-file-name", filename /* -Name of file visited in current buffer, or nil if not visiting a file. -Each buffer has its own value of this variable. -*/ ); - -#if 0 /* FSFmacs */ -/* -Abbreviated truename of file visited in current buffer, or nil if none. -The truename of a file is calculated by `file-truename' -and then abbreviated with `abbreviate-file-name'. -Each buffer has its own value of this variable. -*/ -#endif /* FSFmacs */ - - DEFVAR_BUFFER_LOCAL ("buffer-file-truename", file_truename /* -The real name of the file visited in the current buffer, -or nil if not visiting a file. This is the result of passing -buffer-file-name to the `file-truename' function. Every buffer has -its own value of this variable. This variable is automatically -maintained by the functions that change the file name associated -with a buffer. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-auto-save-file-name", auto_save_file_name /* -Name of file for auto-saving current buffer, -or nil if buffer should not be auto-saved. -Each buffer has its own value of this variable. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-read-only", read_only /* -Non-nil if this buffer is read-only. -Each buffer has its own value of this variable. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-backed-up", backed_up /* -Non-nil if this buffer's file has been backed up. -Backing up is done before the first time the file is saved. -Each buffer has its own value of this variable. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-saved-size", saved_size /* -Length of current buffer when last read in, saved or auto-saved. -0 initially. -Each buffer has its own value of this variable. -*/ ); - - DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display", selective_display /* -Non-nil enables selective display: -Integer N as value means display only lines - that start with less than n columns of space. -A value of t means, after a ^M, all the rest of the line is invisible. - Then ^M's in the file are written into files as newlines. - -Automatically becomes buffer-local when set in any fashion. -*/, redisplay_variable_changed); - -#ifndef old - DEFVAR_BUFFER_LOCAL_MAGIC ("selective-display-ellipses", - selective_display_ellipses /* -t means display ... on previous line when a line is invisible. -Automatically becomes buffer-local when set in any fashion. -*/, redisplay_variable_changed); -#endif - - DEFVAR_BUFFER_LOCAL ("local-abbrev-table", abbrev_table /* -Local (mode-specific) abbrev table of current buffer. -*/ ); - - DEFVAR_BUFFER_LOCAL ("overwrite-mode", overwrite_mode /* -Non-nil if self-insertion should replace existing text. -The value should be one of `overwrite-mode-textual', -`overwrite-mode-binary', or nil. -If it is `overwrite-mode-textual', self-insertion still -inserts at the end of a line, and inserts when point is before a tab, -until the tab is filled in. -If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. -Automatically becomes buffer-local when set in any fashion. - -Normally, you shouldn't modify this variable by hand, but use the functions -`overwrite-mode' and `binary-overwrite-mode' instead. However, you can -customize the default value from the options menu. -*/ ); - -#if 0 /* FSFmacs */ - /* Adds the following to the doc string for buffer-undo-list: - -An entry (nil PROPERTY VALUE BEG . END) indicates that a text property -was modified between BEG and END. PROPERTY is the property name, -and VALUE is the old value. -*/ -#endif /* FSFmacs */ - - DEFVAR_BUFFER_LOCAL ("buffer-undo-list", undo_list /* -List of undo entries in current buffer. -Recent changes come first; older changes follow newer. - -An entry (BEG . END) represents an insertion which begins at -position BEG and ends at position END. - -An entry (TEXT . POSITION) represents the deletion of the string TEXT -from (abs POSITION). If POSITION is positive, point was at the front -of the text being deleted; if negative, point was at the end. - -An entry (t HIGH . LOW) indicates that the buffer previously had -"unmodified" status. HIGH and LOW are the high and low 16-bit portions -of the visited file's modification time, as of that time. If the -modification time of the most recent save is different, this entry is -obsolete. - -An entry of the form EXTENT indicates that EXTENT was attached in -the buffer. Undoing an entry of this form detaches EXTENT. - -An entry of the form (EXTENT START END) indicates that EXTENT was -detached from the buffer. Undoing an entry of this form attaches -EXTENT from START to END. - -An entry of the form POSITION indicates that point was at the buffer -location given by the integer. Undoing an entry of this form places -point at POSITION. - -nil marks undo boundaries. The undo command treats the changes -between two undo boundaries as a single step to be undone. - -If the value of the variable is t, undo information is not recorded. -*/ ); - -#if 0 /* FSFmacs */ - xxDEFVAR_BUFFER_LOCAL ("mark-active", mark_active /* -Non-nil means the mark and region are currently active in this buffer. -Automatically local in all buffers. -*/ ); -#endif /* FSFmacs */ - -#ifdef REGION_CACHE_NEEDS_WORK - xxDEFVAR_BUFFER_LOCAL ("cache-long-line-scans", cache_long_line_scans /* -Non-nil means that Emacs should use caches to handle long lines more quickly. -This variable is buffer-local, in all buffers. - -Normally, the line-motion functions work by scanning the buffer for -newlines. Columnar operations (like move-to-column and -compute-motion) also work by scanning the buffer, summing character -widths as they go. This works well for ordinary text, but if the -buffer's lines are very long (say, more than 500 characters), these -motion functions will take longer to execute. Emacs may also take -longer to update the display. - -If cache-long-line-scans is non-nil, these motion functions cache the -results of their scans, and consult the cache to avoid rescanning -regions of the buffer until the text is modified. The caches are most -beneficial when they prevent the most searching---that is, when the -buffer contains long lines and large regions of characters with the -same, fixed screen width. - -When cache-long-line-scans is non-nil, processing short lines will -become slightly slower (because of the overhead of consulting the -cache), and the caches will use memory roughly proportional to the -number of newlines and characters whose screen width varies. - -The caches require no explicit maintenance; their accuracy is -maintained internally by the Emacs primitives. Enabling or disabling -the cache should not affect the behavior of any of the motion -functions; it should only affect their performance. -*/ ); -#endif /* REGION_CACHE_NEEDS_WORK */ - - DEFVAR_BUFFER_LOCAL ("point-before-scroll", point_before_scroll /* -Value of point before the last series of scroll operations, or nil. -*/ ); - - DEFVAR_BUFFER_LOCAL ("buffer-file-format", file_format /* -List of formats to use when saving this buffer. -Formats are defined by `format-alist'. This variable is -set when a file is visited. Automatically local in all buffers. -*/ ); - - DEFVAR_BUFFER_LOCAL_MAGIC ("buffer-invisibility-spec", invisibility_spec /* -Invisibility spec of this buffer. -The default is t, which means that text is invisible -if it has (or is covered by an extent with) a non-nil `invisible' property. -If the value is a list, a text character is invisible if its `invisible' -property is an element in that list. -If an element is a cons cell of the form (PROP . ELLIPSIS), -then characters with property value PROP are invisible, -and they have an ellipsis as well if ELLIPSIS is non-nil. -Note that the actual characters used for the ellipsis are controllable -using `invisible-text-glyph', and default to "...". -*/, redisplay_variable_changed); - - DEFVAR_CONST_BUFFER_LOCAL ("generated-modeline-string", - generated_modeline_string /* -String of characters in this buffer's modeline as of the last redisplay. -Each time the modeline is recomputed, the resulting characters are -stored in this string, which is resized as necessary. You may not -set this variable, and modifying this string will not change the -modeline; you have to change `modeline-format' if you want that. - -For each extent in `modeline-format' that is encountered when -processing the modeline, a corresponding extent is placed in -`generated-modeline-string' and covers the text over which the -extent in `modeline-format' applies. The extent in -`generated-modeline-string' is made a child of the extent in -`modeline-format', which means that it inherits all properties from -that extent. Note that the extents in `generated-modeline-string' -are managed automatically. You should not explicitly put any extents -in `generated-modeline-string'; if you do, they will disappear the -next time the modeline is processed. - -For extents in `modeline-format', the following properties are currently -handled: - -`face' - Affects the face of the modeline text. Currently, faces do - not merge properly; only the most recently encountered face - is used. This is a bug. - -`keymap' - Affects the disposition of button events over the modeline - text. Multiple applicable keymaps *are* handled properly, - and `modeline-map' still applies to any events that don't - have bindings in extent-specific keymaps. - -`help-echo' - If a string, causes the string to be displayed when the mouse - moves over the text. -*/ ); - - /* Check for DEFVAR_BUFFER_LOCAL without initializing the corresponding - slot of buffer_local_flags and vice-versa. Must be done after all - DEFVAR_BUFFER_LOCAL() calls. */ -#define MARKED_SLOT(slot) \ - if ((XINT (buffer_local_flags.slot) != -2 && \ - XINT (buffer_local_flags.slot) != -3) \ - != !(NILP (XBUFFER (Vbuffer_local_symbols)->slot))) \ - abort () -#include "bufslots.h" -#undef MARKED_SLOT - - { - Lisp_Object scratch = Fget_buffer_create (QSscratch); - Fset_buffer (scratch); - /* Want no undo records for *scratch* until after Emacs is dumped */ - Fbuffer_disable_undo (scratch); - } -} - -/* Is PWD another name for `.' ? */ -static int -directory_is_current_directory (char *pwd) -{ - Bufbyte *pwd_internal; - struct stat dotstat, pwdstat; - - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (pwd, pwd_internal); - - return (IS_DIRECTORY_SEP (*pwd_internal) - && stat ((char *) pwd_internal, &pwdstat) == 0 - && stat (".", &dotstat) == 0 - && dotstat.st_ino == pwdstat.st_ino - && dotstat.st_dev == pwdstat.st_dev - && (int) strlen ((char *) pwd_internal) < MAXPATHLEN); -} - -void -init_initial_directory (void) -{ - /* This function can GC */ - - char *pwd; - - initial_directory[0] = 0; - - /* If PWD is accurate, use it instead of calling getcwd. This is faster - when PWD is right, and may avoid a fatal error. */ - if ((pwd = getenv ("PWD")) != NULL - && directory_is_current_directory (pwd)) - strcpy (initial_directory, pwd); - else if (getcwd (initial_directory, MAXPATHLEN) == NULL) - fatal ("`getcwd' failed: %s\n", strerror (errno)); - - /* Make sure pwd is DIRECTORY_SEP-terminated. - Maybe this should really use some standard subroutine - whose definition is filename syntax dependent. */ - { - int len = strlen (initial_directory); - - if (! IS_DIRECTORY_SEP (initial_directory[len - 1])) - { - initial_directory[len] = DIRECTORY_SEP; - initial_directory[len + 1] = '\0'; - } - } - - /* XEmacs change: store buffer's default directory - using preferred (i.e. as defined at compile-time) - directory separator. --marcpa */ -#ifdef DOS_NT -#define CORRECT_DIR_SEPS(s) \ - do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ - else unixtodos_filename (s); \ - } while (0) - - CORRECT_DIR_SEPS(initial_directory); -#endif -} - -void -init_buffer (void) -{ - /* This function can GC */ - - Fset_buffer (Fget_buffer_create (QSscratch)); - - current_buffer->directory = - build_ext_string (initial_directory, FORMAT_FILENAME); - -#if 0 /* FSFmacs */ - /* #### is this correct? */ - temp = get_minibuffer (0); - XBUFFER (temp)->directory = current_buffer->directory; -#endif /* FSFmacs */ -} diff --git a/src/buffer.h b/src/buffer.h deleted file mode 100644 index 9347064..0000000 --- a/src/buffer.h +++ /dev/null @@ -1,1789 +0,0 @@ -/* Header file for the buffer manipulation primitives. - Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 - Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: FSF 19.30. */ - -/* Authorship: - - FSF: long ago. - JWZ: separated out bufslots.h, early in Lemacs. - Ben Wing: almost completely rewritten for Mule, 19.12. - */ - -#ifndef _XEMACS_BUFFER_H_ -#define _XEMACS_BUFFER_H_ - -#ifdef MULE -#include "mule-charset.h" -#endif - -/************************************************************************/ -/* */ -/* definition of Lisp buffer object */ -/* */ -/************************************************************************/ - -/* Note: we keep both Bytind and Bufpos versions of some of the - important buffer positions because they are accessed so much. - If we didn't do this, we would constantly be invalidating the - bufpos<->bytind cache under Mule. - - Note that under non-Mule, both versions will always be the - same so we don't really need to keep track of them. But it - simplifies the logic to go ahead and do so all the time and - the memory loss is insignificant. */ - -/* Formerly, it didn't much matter what went inside the struct buffer_text - and what went outside it. Now it does, with the advent of "indirect - buffers" that share text with another buffer. An indirect buffer - shares the same *text* as another buffer, but has its own buffer-local - variables, its own accessible region, and its own markers and extents. - (Due to the nature of markers, it doesn't actually matter much whether - we stick them inside or out of the struct buffer_text -- the user won't - notice any difference -- but we go ahead and put them outside for - consistency and overall saneness of algorithm.) - - FSFmacs gets away with not maintaining any "children" pointers from - a buffer to the indirect buffers that refer to it by putting the - markers inside of the struct buffer_text, using markers to keep track - of BEGV and ZV in indirect buffers, and relying on the fact that - all intervals (text properties and overlays) use markers for their - start and end points. We don't do this for extents (markers are - inefficient anyway and take up space), so we have to maintain - children pointers. This is not terribly hard, though, and the - code to maintain this is just like the code already present in - extent-parent and extent-children. - */ - -struct buffer_text -{ - Bufbyte *beg; /* Actual address of buffer contents. */ - Bytind gpt; /* Index of gap in buffer. */ - Bytind z; /* Index of end of buffer. */ - Bufpos bufz; /* Equivalent as a Bufpos. */ - int gap_size; /* Size of buffer's gap */ - int end_gap_size; /* Size of buffer's end gap */ - long modiff; /* This counts buffer-modification events - for this buffer. It is incremented for - each such event, and never otherwise - changed. */ - long save_modiff; /* Previous value of modiff, as of last - time buffer visited or saved a file. */ - -#ifdef MULE - /* We keep track of a "known" region for very fast access. - This information is text-only so it goes here. */ - Bufpos mule_bufmin, mule_bufmax; - Bytind mule_bytmin, mule_bytmax; - int mule_shifter, mule_three_p; - - /* And we also cache 16 positions for fairly fast access near those - positions. */ - Bufpos mule_bufpos_cache[16]; - Bytind mule_bytind_cache[16]; -#endif - - /* Similar to the above, we keep track of positions for which line - number has last been calculated. See line-number.c. */ - Lisp_Object line_number_cache; - - /* Change data that goes with the text. */ - struct buffer_text_change_data *changes; - -}; - -struct buffer -{ - struct lcrecord_header header; - - /* This structure holds the coordinates of the buffer contents - in ordinary buffers. In indirect buffers, this is not used. */ - struct buffer_text own_text; - - /* This points to the `struct buffer_text' that is used for this buffer. - In an ordinary buffer, this is the own_text field above. - In an indirect buffer, this is the own_text field of another buffer. */ - struct buffer_text *text; - - Bytind pt; /* Position of point in buffer. */ - Bufpos bufpt; /* Equivalent as a Bufpos. */ - Bytind begv; /* Index of beginning of accessible range. */ - Bufpos bufbegv; /* Equivalent as a Bufpos. */ - Bytind zv; /* Index of end of accessible range. */ - Bufpos bufzv; /* Equivalent as a Bufpos. */ - - int face_change; /* This is set when a change in how the text should - be displayed (e.g., font, color) is made. */ - - /* change data indicating what portion of the text has changed - since the last time this was reset. Used by redisplay. - Logically we should keep this with the text structure, but - redisplay resets it for each buffer individually and we don't - want interference between an indirect buffer and its base - buffer. */ - struct each_buffer_change_data *changes; - -#ifdef REGION_CACHE_NEEDS_WORK - /* If the long line scan cache is enabled (i.e. the buffer-local - variable cache-long-line-scans is non-nil), newline_cache - points to the newline cache, and width_run_cache points to the - width run cache. - - The newline cache records which stretches of the buffer are - known *not* to contain newlines, so that they can be skipped - quickly when we search for newlines. - - The width run cache records which stretches of the buffer are - known to contain characters whose widths are all the same. If - the width run cache maps a character to a value > 0, that value - is the character's width; if it maps a character to zero, we - don't know what its width is. This allows compute_motion to - process such regions very quickly, using algebra instead of - inspecting each character. See also width_table, below. */ - struct region_cache *newline_cache; - struct region_cache *width_run_cache; -#endif /* REGION_CACHE_NEEDS_WORK */ - - /* The markers that refer to this buffer. This is actually a single - marker -- successive elements in its marker `chain' are the other - markers referring to this buffer */ - struct Lisp_Marker *markers; - - /* The buffer's extent info. This is its own type, an extent-info - object (done this way for ease in marking / finalizing). */ - Lisp_Object extent_info; - - /* ----------------------------------------------------------------- */ - /* All the stuff above this line is the responsibility of insdel.c, - with some help from marker.c and extents.c. - All the stuff below this line is the responsibility of buffer.c. */ - - /* In an indirect buffer, this points to the base buffer. - In an ordinary buffer, it is 0. - We DO mark through this slot. */ - struct buffer *base_buffer; - - /* List of indirect buffers whose base is this buffer. - If we are an indirect buffer, this will be nil. - Do NOT mark through this. */ - Lisp_Object indirect_children; - - /* Flags saying which DEFVAR_PER_BUFFER variables - are local to this buffer. */ - int local_var_flags; - - /* Set to the modtime of the visited file when read or written. - -1 means visited file was nonexistent. - 0 means visited file modtime unknown; in no case complain - about any mismatch on next save attempt. */ - int modtime; - - /* the value of text->modiff at the last auto-save. */ - int auto_save_modified; - - /* The time at which we detected a failure to auto-save, - Or -1 if we didn't have a failure. */ - int auto_save_failure_time; - - /* Position in buffer at which display started - the last time this buffer was displayed. */ - int last_window_start; - - /* Everything from here down must be a Lisp_Object */ - -#define MARKED_SLOT(x) Lisp_Object x -#include "bufslots.h" -#undef MARKED_SLOT -}; - -DECLARE_LRECORD (buffer, struct buffer); -#define XBUFFER(x) XRECORD (x, buffer, struct buffer) -#define XSETBUFFER(x, p) XSETRECORD (x, p, buffer) -#define BUFFERP(x) RECORDP (x, buffer) -#define GC_BUFFERP(x) GC_RECORDP (x, buffer) -#define CHECK_BUFFER(x) CHECK_RECORD (x, buffer) -#define CONCHECK_BUFFER(x) CONCHECK_RECORD (x, buffer) - -#define BUFFER_LIVE_P(b) (!NILP ((b)->name)) - -#define CHECK_LIVE_BUFFER(x) do { \ - CHECK_BUFFER (x); \ - if (!BUFFER_LIVE_P (XBUFFER (x))) \ - dead_wrong_type_argument (Qbuffer_live_p, (x)); \ -} while (0) - -#define CONCHECK_LIVE_BUFFER(x) do { \ - CONCHECK_BUFFER (x); \ - if (!BUFFER_LIVE_P (XBUFFER (x))) \ - x = wrong_type_argument (Qbuffer_live_p, (x)); \ -} while (0) - - -#define BUFFER_BASE_BUFFER(b) ((b)->base_buffer ? (b)->base_buffer : (b)) - -/* Map over buffers sharing the same text as MPS_BUF. MPS_BUFVAR is a - variable that gets the buffer values (beginning with the base - buffer, then the children), and MPS_BUFCONS should be a temporary - Lisp_Object variable. */ -#define MAP_INDIRECT_BUFFERS(mps_buf, mps_bufvar, mps_bufcons) \ -for (mps_bufcons = Qunbound, \ - mps_bufvar = BUFFER_BASE_BUFFER (mps_buf); \ - UNBOUNDP (mps_bufcons) ? \ - (mps_bufcons = mps_bufvar->indirect_children, \ - 1) \ - : (!NILP (mps_bufcons) \ - && (mps_bufvar = XBUFFER (XCAR (mps_bufcons)), 1) \ - && (mps_bufcons = XCDR (mps_bufcons), 1)); \ - ) - - - -/************************************************************************/ -/* */ -/* working with raw internal-format data */ -/* */ -/************************************************************************/ - -/* NOTE: In all the following macros, we follow these rules concerning - multiple evaluation of the arguments: - - 1) Anything that's an lvalue can be evaluated more than once. - 2) Anything that's a Lisp Object can be evaluated more than once. - This should probably be changed, but this follows the way - that all the macros in lisp.h do things. - 3) 'struct buffer *' arguments can be evaluated more than once. - 4) Nothing else can be evaluated more than once. Use inline - functions, if necessary, to prevent multiple evaluation. - 5) An exception to (4) is that there are some macros below that - may evaluate their arguments more than once. They are all - denoted with the word "unsafe" in their name and are generally - meant to be called only by other macros that have already - stored the calling values in temporary variables. - - - Use the following functions/macros on contiguous strings of data. - If the text you're operating on is known to come from a buffer, use - the buffer-level functions below -- they know about the gap and may - be more efficient. - - - (A) For working with charptr's (pointers to internally-formatted text): - ----------------------------------------------------------------------- - - VALID_CHARPTR_P (ptr): - Given a charptr, does it point to the beginning of a character? - - ASSERT_VALID_CHARPTR (ptr): - If error-checking is enabled, assert that the given charptr - points to the beginning of a character. Otherwise, do nothing. - - INC_CHARPTR (ptr): - Given a charptr (assumed to point at the beginning of a character), - modify that pointer so it points to the beginning of the next - character. - - DEC_CHARPTR (ptr): - Given a charptr (assumed to point at the beginning of a - character or at the very end of the text), modify that pointer - so it points to the beginning of the previous character. - - VALIDATE_CHARPTR_BACKWARD (ptr): - Make sure that PTR is pointing to the beginning of a character. - If not, back up until this is the case. Note that there are not - too many places where it is legitimate to do this sort of thing. - It's an error if you're passed an "invalid" char * pointer. - NOTE: PTR *must* be pointing to a valid part of the string (i.e. - not the very end, unless the string is zero-terminated or - something) in order for this function to not cause crashes. - - VALIDATE_CHARPTR_FORWARD (ptr): - Make sure that PTR is pointing to the beginning of a character. - If not, move forward until this is the case. Note that there - are not too many places where it is legitimate to do this sort - of thing. It's an error if you're passed an "invalid" char * - pointer. - - - (B) For working with the length (in bytes and characters) of a - section of internally-formatted text: - -------------------------------------------------------------- - - bytecount_to_charcount (ptr, nbi): - Given a pointer to a text string and a length in bytes, - return the equivalent length in characters. - - charcount_to_bytecount (ptr, nch): - Given a pointer to a text string and a length in characters, - return the equivalent length in bytes. - - charptr_n_addr (ptr, n): - Return a pointer to the beginning of the character offset N - (in characters) from PTR. - - - (C) For retrieving or changing the character pointed to by a charptr: - --------------------------------------------------------------------- - - charptr_emchar (ptr): - Retrieve the character pointed to by PTR as an Emchar. - - charptr_emchar_n (ptr, n): - Retrieve the character at offset N (in characters) from PTR, - as an Emchar. - - set_charptr_emchar (ptr, ch): - Store the character CH (an Emchar) as internally-formatted - text starting at PTR. Return the number of bytes stored. - - charptr_copy_char (ptr, ptr2): - Retrieve the character pointed to by PTR and store it as - internally-formatted text in PTR2. - - - (D) For working with Emchars: - ----------------------------- - - [Note that there are other functions/macros for working with Emchars - in mule-charset.h, for retrieving the charset of an Emchar - and such. These are only valid when MULE is defined.] - - valid_char_p (ch): - Return whether the given Emchar is valid. - - CHARP (ch): - Return whether the given Lisp_Object is a character. - - CHECK_CHAR_COERCE_INT (ch): - Signal an error if CH is not a valid character or integer Lisp_Object. - If CH is an integer Lisp_Object, convert it to a character Lisp_Object, - but merely by repackaging, without performing tests for char validity. - - MAX_EMCHAR_LEN: - Maximum number of buffer bytes per Emacs character. - -*/ - - -/* ---------------------------------------------------------------------- */ -/* (A) For working with charptr's (pointers to internally-formatted text) */ -/* ---------------------------------------------------------------------- */ - -#ifdef MULE -# define VALID_CHARPTR_P(ptr) BUFBYTE_FIRST_BYTE_P (* (unsigned char *) ptr) -#else -# define VALID_CHARPTR_P(ptr) 1 -#endif - -#ifdef ERROR_CHECK_BUFPOS -# define ASSERT_VALID_CHARPTR(ptr) assert (VALID_CHARPTR_P (ptr)) -#else -# define ASSERT_VALID_CHARPTR(ptr) -#endif - -/* Note that INC_CHARPTR() and DEC_CHARPTR() have to be written in - completely separate ways. INC_CHARPTR() cannot use the DEC_CHARPTR() - trick of looking for a valid first byte because it might run off - the end of the string. DEC_CHARPTR() can't use the INC_CHARPTR() - method because it doesn't have easy access to the first byte of - the character it's moving over. */ - -#define REAL_INC_CHARPTR(ptr) \ - ((void) ((ptr) += REP_BYTES_BY_FIRST_BYTE (* (unsigned char *) (ptr)))) - -#define REAL_DEC_CHARPTR(ptr) do { \ - (ptr)--; \ -} while (!VALID_CHARPTR_P (ptr)) - -#ifdef ERROR_CHECK_BUFPOS -#define INC_CHARPTR(ptr) do { \ - ASSERT_VALID_CHARPTR (ptr); \ - REAL_INC_CHARPTR (ptr); \ -} while (0) - -#define DEC_CHARPTR(ptr) do { \ - CONST Bufbyte *dc_ptr1 = (ptr); \ - CONST Bufbyte *dc_ptr2 = dc_ptr1; \ - REAL_DEC_CHARPTR (dc_ptr2); \ - assert (dc_ptr1 - dc_ptr2 == \ - REP_BYTES_BY_FIRST_BYTE (*dc_ptr2)); \ - (ptr) = dc_ptr2; \ -} while (0) - -#else /* ! ERROR_CHECK_BUFPOS */ -#define INC_CHARPTR(ptr) REAL_INC_CHARPTR (ptr) -#define DEC_CHARPTR(ptr) REAL_DEC_CHARPTR (ptr) -#endif /* ! ERROR_CHECK_BUFPOS */ - -#ifdef MULE - -#define VALIDATE_CHARPTR_BACKWARD(ptr) do { \ - while (!VALID_CHARPTR_P (ptr)) ptr--; \ -} while (0) - -/* This needs to be trickier to avoid the possibility of running off - the end of the string. */ - -#define VALIDATE_CHARPTR_FORWARD(ptr) do { \ - Bufbyte *vcf_ptr = (ptr); \ - VALIDATE_CHARPTR_BACKWARD (vcf_ptr); \ - if (vcf_ptr != (ptr)) \ - { \ - (ptr) = vcf_ptr; \ - INC_CHARPTR (ptr); \ - } \ -} while (0) - -#else /* not MULE */ -#define VALIDATE_CHARPTR_BACKWARD(ptr) -#define VALIDATE_CHARPTR_FORWARD(ptr) -#endif /* not MULE */ - -/* -------------------------------------------------------------- */ -/* (B) For working with the length (in bytes and characters) of a */ -/* section of internally-formatted text */ -/* -------------------------------------------------------------- */ - -INLINE CONST Bufbyte *charptr_n_addr (CONST Bufbyte *ptr, Charcount offset); -INLINE CONST Bufbyte * -charptr_n_addr (CONST Bufbyte *ptr, Charcount offset) -{ - return ptr + charcount_to_bytecount (ptr, offset); -} - -/* -------------------------------------------------------------------- */ -/* (C) For retrieving or changing the character pointed to by a charptr */ -/* -------------------------------------------------------------------- */ - -#define simple_charptr_emchar(ptr) ((Emchar) (ptr)[0]) -#define simple_set_charptr_emchar(ptr, x) ((ptr)[0] = (Bufbyte) (x), 1) -#define simple_charptr_copy_char(ptr, ptr2) ((ptr2)[0] = *(ptr), 1) - -#ifdef MULE - -Emchar non_ascii_charptr_emchar (CONST Bufbyte *ptr); -Bytecount non_ascii_set_charptr_emchar (Bufbyte *ptr, Emchar c); -Bytecount non_ascii_charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2); - -INLINE Emchar charptr_emchar (CONST Bufbyte *ptr); -INLINE Emchar -charptr_emchar (CONST Bufbyte *ptr) -{ - return BYTE_ASCII_P (*ptr) ? - simple_charptr_emchar (ptr) : - non_ascii_charptr_emchar (ptr); -} - -INLINE Bytecount set_charptr_emchar (Bufbyte *ptr, Emchar x); -INLINE Bytecount -set_charptr_emchar (Bufbyte *ptr, Emchar x) -{ - return !CHAR_MULTIBYTE_P (x) ? - simple_set_charptr_emchar (ptr, x) : - non_ascii_set_charptr_emchar (ptr, x); -} - -INLINE Bytecount charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2); -INLINE Bytecount -charptr_copy_char (CONST Bufbyte *ptr, Bufbyte *ptr2) -{ - return BYTE_ASCII_P (*ptr) ? - simple_charptr_copy_char (ptr, ptr2) : - non_ascii_charptr_copy_char (ptr, ptr2); -} - -#else /* not MULE */ - -# define charptr_emchar(ptr) simple_charptr_emchar (ptr) -# define set_charptr_emchar(ptr, x) simple_set_charptr_emchar (ptr, x) -# define charptr_copy_char(ptr, ptr2) simple_charptr_copy_char (ptr, ptr2) - -#endif /* not MULE */ - -#define charptr_emchar_n(ptr, offset) \ - charptr_emchar (charptr_n_addr (ptr, offset)) - - -/* ---------------------------- */ -/* (D) For working with Emchars */ -/* ---------------------------- */ - -#ifdef MULE - -int non_ascii_valid_char_p (Emchar ch); - -INLINE int valid_char_p (Emchar ch); -INLINE int -valid_char_p (Emchar ch) -{ - return ((unsigned int) (ch) <= 0xff) || non_ascii_valid_char_p (ch); -} - -#else /* not MULE */ - -#define valid_char_p(ch) ((unsigned int) (ch) <= 0xff) - -#endif /* not MULE */ - -#define CHAR_INTP(x) (INTP (x) && valid_char_p (XINT (x))) - -#define CHAR_OR_CHAR_INTP(x) (CHARP (x) || CHAR_INTP (x)) - -#ifdef ERROR_CHECK_TYPECHECK - -INLINE Emchar XCHAR_OR_CHAR_INT (Lisp_Object obj); -INLINE Emchar -XCHAR_OR_CHAR_INT (Lisp_Object obj) -{ - assert (CHAR_OR_CHAR_INTP (obj)); - return CHARP (obj) ? XCHAR (obj) : XINT (obj); -} - -#else - -#define XCHAR_OR_CHAR_INT(obj) (CHARP ((obj)) ? XCHAR ((obj)) : XINT ((obj))) - -#endif - -#define CHECK_CHAR_COERCE_INT(x) do { \ - if (CHARP (x)) \ - ; \ - else if (CHAR_INTP (x)) \ - x = make_char (XINT (x)); \ - else \ - x = wrong_type_argument (Qcharacterp, x); \ -} while (0) - -#ifdef MULE -# define MAX_EMCHAR_LEN 4 -#else -# define MAX_EMCHAR_LEN 1 -#endif - - -/*----------------------------------------------------------------------*/ -/* Accessor macros for important positions in a buffer */ -/*----------------------------------------------------------------------*/ - -/* We put them here because some stuff below wants them before the - place where we would normally put them. */ - -/* None of these are lvalues. Use the settor macros below to change - the positions. */ - -/* Beginning of buffer. */ -#define BI_BUF_BEG(buf) ((Bytind) 1) -#define BUF_BEG(buf) ((Bufpos) 1) - -/* Beginning of accessible range of buffer. */ -#define BI_BUF_BEGV(buf) ((buf)->begv + 0) -#define BUF_BEGV(buf) ((buf)->bufbegv + 0) - -/* End of accessible range of buffer. */ -#define BI_BUF_ZV(buf) ((buf)->zv + 0) -#define BUF_ZV(buf) ((buf)->bufzv + 0) - -/* End of buffer. */ -#define BI_BUF_Z(buf) ((buf)->text->z + 0) -#define BUF_Z(buf) ((buf)->text->bufz + 0) - -/* Point. */ -#define BI_BUF_PT(buf) ((buf)->pt + 0) -#define BUF_PT(buf) ((buf)->bufpt + 0) - -/*----------------------------------------------------------------------*/ -/* Converting between positions and addresses */ -/*----------------------------------------------------------------------*/ - -/* Convert the address of a byte in the buffer into a position. */ -INLINE Bytind BI_BUF_PTR_BYTE_POS (struct buffer *buf, Bufbyte *ptr); -INLINE Bytind -BI_BUF_PTR_BYTE_POS (struct buffer *buf, Bufbyte *ptr) -{ - return ((ptr) - (buf)->text->beg + 1 - - ((ptr - (buf)->text->beg + 1) > (buf)->text->gpt - ? (buf)->text->gap_size : 0)); -} - -#define BUF_PTR_BYTE_POS(buf, ptr) \ - bytind_to_bufpos (buf, BI_BUF_PTR_BYTE_POS (buf, ptr)) - -/* Address of byte at position POS in buffer. */ -INLINE Bufbyte * BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytind pos); -INLINE Bufbyte * -BI_BUF_BYTE_ADDRESS (struct buffer *buf, Bytind pos) -{ - return ((buf)->text->beg + - ((pos >= (buf)->text->gpt ? (pos + (buf)->text->gap_size) : pos) - - 1)); -} - -#define BUF_BYTE_ADDRESS(buf, pos) \ - BI_BUF_BYTE_ADDRESS (buf, bufpos_to_bytind (buf, pos)) - -/* Address of byte before position POS in buffer. */ -INLINE Bufbyte * BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytind pos); -INLINE Bufbyte * -BI_BUF_BYTE_ADDRESS_BEFORE (struct buffer *buf, Bytind pos) -{ - return ((buf)->text->beg + - ((pos > (buf)->text->gpt ? (pos + (buf)->text->gap_size) : pos) - - 2)); -} - -#define BUF_BYTE_ADDRESS_BEFORE(buf, pos) \ - BI_BUF_BYTE_ADDRESS_BEFORE (buf, bufpos_to_bytind (buf, pos)) - -/*----------------------------------------------------------------------*/ -/* Converting between byte indices and memory indices */ -/*----------------------------------------------------------------------*/ - -INLINE int valid_memind_p (struct buffer *buf, Memind x); -INLINE int -valid_memind_p (struct buffer *buf, Memind x) -{ - return ((x >= 1 && x <= (Memind) (buf)->text->gpt) || - (x > (Memind) ((buf)->text->gpt + (buf)->text->gap_size) && - x <= (Memind) ((buf)->text->z + (buf)->text->gap_size))); -} - -INLINE Memind bytind_to_memind (struct buffer *buf, Bytind x); -INLINE Memind -bytind_to_memind (struct buffer *buf, Bytind x) -{ - return (Memind) ((x > (buf)->text->gpt) ? (x + (buf)->text->gap_size) : x); -} - - -INLINE Bytind memind_to_bytind (struct buffer *buf, Memind x); -INLINE Bytind -memind_to_bytind (struct buffer *buf, Memind x) -{ -#ifdef ERROR_CHECK_BUFPOS - assert (valid_memind_p (buf, x)); -#endif - return (Bytind) ((x > (Memind) (buf)->text->gpt) ? - x - (buf)->text->gap_size : - x); -} - -#define memind_to_bufpos(buf, x) \ - bytind_to_bufpos (buf, memind_to_bytind (buf, x)) -#define bufpos_to_memind(buf, x) \ - bytind_to_memind (buf, bufpos_to_bytind (buf, x)) - -/* These macros generalize many standard buffer-position functions to - either a buffer or a string. */ - -/* Converting between Meminds and Bytinds, for a buffer-or-string. - For strings, this is a no-op. For buffers, this resolves - to the standard memind<->bytind converters. */ - -#define buffer_or_string_bytind_to_memind(obj, ind) \ - (BUFFERP (obj) ? bytind_to_memind (XBUFFER (obj), ind) : (Memind) ind) - -#define buffer_or_string_memind_to_bytind(obj, ind) \ - (BUFFERP (obj) ? memind_to_bytind (XBUFFER (obj), ind) : (Bytind) ind) - -/* Converting between Bufpos's and Bytinds, for a buffer-or-string. - For strings, this maps to the bytecount<->charcount converters. */ - -#define buffer_or_string_bufpos_to_bytind(obj, pos) \ - (BUFFERP (obj) ? bufpos_to_bytind (XBUFFER (obj), pos) : \ - (Bytind) charcount_to_bytecount (XSTRING_DATA (obj), pos)) - -#define buffer_or_string_bytind_to_bufpos(obj, ind) \ - (BUFFERP (obj) ? bytind_to_bufpos (XBUFFER (obj), ind) : \ - (Bufpos) bytecount_to_charcount (XSTRING_DATA (obj), ind)) - -/* Similar for Bufpos's and Meminds. */ - -#define buffer_or_string_bufpos_to_memind(obj, pos) \ - (BUFFERP (obj) ? bufpos_to_memind (XBUFFER (obj), pos) : \ - (Memind) charcount_to_bytecount (XSTRING_DATA (obj), pos)) - -#define buffer_or_string_memind_to_bufpos(obj, ind) \ - (BUFFERP (obj) ? memind_to_bufpos (XBUFFER (obj), ind) : \ - (Bufpos) bytecount_to_charcount (XSTRING_DATA (obj), ind)) - -/************************************************************************/ -/* */ -/* working with buffer-level data */ -/* */ -/************************************************************************/ - -/* - - (A) Working with byte indices: - ------------------------------ - - VALID_BYTIND_P(buf, bi): - Given a byte index, does it point to the beginning of a character? - - ASSERT_VALID_BYTIND_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and points to the beginning of a character - or to the end of the buffer. Otherwise, do nothing. - - ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and satisfies ASSERT_VALID_BYTIND() and also - does not refer to the beginning of the buffer. (i.e. movement - backwards is OK.) Otherwise, do nothing. - - ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, bi): - If error-checking is enabled, assert that the given byte index - is within range and satisfies ASSERT_VALID_BYTIND() and also - does not refer to the end of the buffer. (i.e. movement - forwards is OK.) Otherwise, do nothing. - - VALIDATE_BYTIND_BACKWARD(buf, bi): - Make sure that the given byte index is pointing to the beginning - of a character. If not, back up until this is the case. Note - that there are not too many places where it is legitimate to do - this sort of thing. It's an error if you're passed an "invalid" - byte index. - - VALIDATE_BYTIND_FORWARD(buf, bi): - Make sure that the given byte index is pointing to the beginning - of a character. If not, move forward until this is the case. - Note that there are not too many places where it is legitimate - to do this sort of thing. It's an error if you're passed an - "invalid" byte index. - - INC_BYTIND(buf, bi): - Given a byte index (assumed to point at the beginning of a - character), modify that value so it points to the beginning - of the next character. - - DEC_BYTIND(buf, bi): - Given a byte index (assumed to point at the beginning of a - character), modify that value so it points to the beginning - of the previous character. Unlike for DEC_CHARPTR(), we can - do all the assert()s because there are sentinels at the - beginning of the gap and the end of the buffer. - - BYTIND_INVALID: - A constant representing an invalid Bytind. Valid Bytinds - can never have this value. - - - (B) Converting between Bufpos's and Bytinds: - -------------------------------------------- - - bufpos_to_bytind(buf, bu): - Given a Bufpos, return the equivalent Bytind. - - bytind_to_bufpos(buf, bi): - Given a Bytind, return the equivalent Bufpos. - - make_bufpos(buf, bi): - Given a Bytind, return the equivalent Bufpos as a Lisp Object. - */ - - -/*----------------------------------------------------------------------*/ -/* working with byte indices */ -/*----------------------------------------------------------------------*/ - -#ifdef MULE -# define VALID_BYTIND_P(buf, x) \ - BUFBYTE_FIRST_BYTE_P (*BI_BUF_BYTE_ADDRESS (buf, x)) -#else -# define VALID_BYTIND_P(buf, x) 1 -#endif - -#ifdef ERROR_CHECK_BUFPOS - -# define ASSERT_VALID_BYTIND_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) >= BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \ - assert (VALID_BYTIND_P (buf, x)); \ -} while (0) -# define ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) > BI_BUF_BEG (buf) && x <= BI_BUF_Z (buf)); \ - assert (VALID_BYTIND_P (buf, x)); \ -} while (0) -# define ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, x) do { \ - assert (BUFFER_LIVE_P (buf)); \ - assert ((x) >= BI_BUF_BEG (buf) && x < BI_BUF_Z (buf)); \ - assert (VALID_BYTIND_P (buf, x)); \ -} while (0) - -#else /* not ERROR_CHECK_BUFPOS */ -# define ASSERT_VALID_BYTIND_UNSAFE(buf, x) -# define ASSERT_VALID_BYTIND_BACKWARD_UNSAFE(buf, x) -# define ASSERT_VALID_BYTIND_FORWARD_UNSAFE(buf, x) - -#endif /* not ERROR_CHECK_BUFPOS */ - -/* Note that, although the Mule version will work fine for non-Mule - as well (it should reduce down to nothing), we provide a separate - version to avoid compilation warnings and possible non-optimal - results with stupid compilers. */ - -#ifdef MULE -# define VALIDATE_BYTIND_BACKWARD(buf, x) do { \ - Bufbyte *VBB_ptr = BI_BUF_BYTE_ADDRESS (buf, x); \ - while (!BUFBYTE_FIRST_BYTE_P (*VBB_ptr)) \ - VBB_ptr--, (x)--; \ -} while (0) -#else -# define VALIDATE_BYTIND_BACKWARD(buf, x) -#endif - -/* Note that, although the Mule version will work fine for non-Mule - as well (it should reduce down to nothing), we provide a separate - version to avoid compilation warnings and possible non-optimal - results with stupid compilers. */ - -#ifdef MULE -# define VALIDATE_BYTIND_FORWARD(buf, x) do { \ - Bufbyte *VBF_ptr = BI_BUF_BYTE_ADDRESS (buf, x); \ - while (!BUFBYTE_FIRST_BYTE_P (*VBF_ptr)) \ - VBF_ptr++, (x)++; \ -} while (0) -#else -# define VALIDATE_BYTIND_FORWARD(buf, x) -#endif - -/* Note that in the simplest case (no MULE, no ERROR_CHECK_BUFPOS), - this crap reduces down to simply (x)++. */ - -#define INC_BYTIND(buf, x) do \ -{ \ - ASSERT_VALID_BYTIND_FORWARD_UNSAFE (buf, x); \ - /* Note that we do the increment first to \ - make sure that the pointer in \ - VALIDATE_BYTIND_FORWARD() ends up on \ - the correct side of the gap */ \ - (x)++; \ - VALIDATE_BYTIND_FORWARD (buf, x); \ -} while (0) - -/* Note that in the simplest case (no MULE, no ERROR_CHECK_BUFPOS), - this crap reduces down to simply (x)--. */ - -#define DEC_BYTIND(buf, x) do \ -{ \ - ASSERT_VALID_BYTIND_BACKWARD_UNSAFE (buf, x); \ - /* Note that we do the decrement first to \ - make sure that the pointer in \ - VALIDATE_BYTIND_BACKWARD() ends up on \ - the correct side of the gap */ \ - (x)--; \ - VALIDATE_BYTIND_BACKWARD (buf, x); \ -} while (0) - -INLINE Bytind prev_bytind (struct buffer *buf, Bytind x); -INLINE Bytind -prev_bytind (struct buffer *buf, Bytind x) -{ - DEC_BYTIND (buf, x); - return x; -} - -INLINE Bytind next_bytind (struct buffer *buf, Bytind x); -INLINE Bytind -next_bytind (struct buffer *buf, Bytind x) -{ - INC_BYTIND (buf, x); - return x; -} - -#define BYTIND_INVALID ((Bytind) -1) - -/*----------------------------------------------------------------------*/ -/* Converting between buffer positions and byte indices */ -/*----------------------------------------------------------------------*/ - -#ifdef MULE - -Bytind bufpos_to_bytind_func (struct buffer *buf, Bufpos x); -Bufpos bytind_to_bufpos_func (struct buffer *buf, Bytind x); - -/* The basic algorithm we use is to keep track of a known region of - characters in each buffer, all of which are of the same width. We - keep track of the boundaries of the region in both Bufpos and - Bytind coordinates and also keep track of the char width, which - is 1 - 4 bytes. If the position we're translating is not in - the known region, then we invoke a function to update the known - region to surround the position in question. This assumes - locality of reference, which is usually the case. - - Note that the function to update the known region can be simple - or complicated depending on how much information we cache. - For the moment, we don't cache any information, and just move - linearly forward or back from the known region, with a few - shortcuts to catch all-ASCII buffers. (Note that this will - thrash with bad locality of reference.) A smarter method would - be to keep some sort of pseudo-extent layer over the buffer; - maybe keep track of the bufpos/bytind correspondence at the - beginning of each line, which would allow us to do a binary - search over the pseudo-extents to narrow things down to the - correct line, at which point you could use a linear movement - method. This would also mesh well with efficiently - implementing a line-numbering scheme. - - Note also that we have to multiply or divide by the char width - in order to convert the positions. We do some tricks to avoid - ever actually having to do a multiply or divide, because that - is typically an expensive operation (esp. divide). Multiplying - or dividing by 1, 2, or 4 can be implemented simply as a - shift left or shift right, and we keep track of a shifter value - (0, 1, or 2) indicating how much to shift. Multiplying by 3 - can be implemented by doubling and then adding the original - value. Dividing by 3, alas, cannot be implemented in any - simple shift/subtract method, as far as I know; so we just - do a table lookup. For simplicity, we use a table of size - 128K, which indexes the "divide-by-3" values for the first - 64K non-negative numbers. (Note that we can increase the - size up to 384K, i.e. indexing the first 192K non-negative - numbers, while still using shorts in the array.) This also - means that the size of the known region can be at most - 64K for width-three characters. - */ - -extern short three_to_one_table[]; - -INLINE int real_bufpos_to_bytind (struct buffer *buf, Bufpos x); -INLINE int -real_bufpos_to_bytind (struct buffer *buf, Bufpos x) -{ - if (x >= buf->text->mule_bufmin && x <= buf->text->mule_bufmax) - return (buf->text->mule_bytmin + - ((x - buf->text->mule_bufmin) << buf->text->mule_shifter) + - (buf->text->mule_three_p ? (x - buf->text->mule_bufmin) : 0)); - else - return bufpos_to_bytind_func (buf, x); -} - -INLINE int real_bytind_to_bufpos (struct buffer *buf, Bytind x); -INLINE int -real_bytind_to_bufpos (struct buffer *buf, Bytind x) -{ - if (x >= buf->text->mule_bytmin && x <= buf->text->mule_bytmax) - return (buf->text->mule_bufmin + - ((buf->text->mule_three_p - ? three_to_one_table[x - buf->text->mule_bytmin] - : (x - buf->text->mule_bytmin) >> buf->text->mule_shifter))); - else - return bytind_to_bufpos_func (buf, x); -} - -#else /* not MULE */ - -# define real_bufpos_to_bytind(buf, x) ((Bytind) x) -# define real_bytind_to_bufpos(buf, x) ((Bufpos) x) - -#endif /* not MULE */ - -#ifdef ERROR_CHECK_BUFPOS - -Bytind bufpos_to_bytind (struct buffer *buf, Bufpos x); -Bufpos bytind_to_bufpos (struct buffer *buf, Bytind x); - -#else /* not ERROR_CHECK_BUFPOS */ - -#define bufpos_to_bytind real_bufpos_to_bytind -#define bytind_to_bufpos real_bytind_to_bufpos - -#endif /* not ERROR_CHECK_BUFPOS */ - -#define make_bufpos(buf, ind) make_int (bytind_to_bufpos (buf, ind)) - -/*----------------------------------------------------------------------*/ -/* Converting between buffer bytes and Emacs characters */ -/*----------------------------------------------------------------------*/ - -/* The character at position POS in buffer. */ -#define BI_BUF_FETCH_CHAR(buf, pos) \ - charptr_emchar (BI_BUF_BYTE_ADDRESS (buf, pos)) -#define BUF_FETCH_CHAR(buf, pos) \ - BI_BUF_FETCH_CHAR (buf, bufpos_to_bytind (buf, pos)) - -/* The character at position POS in buffer, as a string. This is - equivalent to set_charptr_emchar (str, BUF_FETCH_CHAR (buf, pos)) - but is faster for Mule. */ - -# define BI_BUF_CHARPTR_COPY_CHAR(buf, pos, str) \ - charptr_copy_char (BI_BUF_BYTE_ADDRESS (buf, pos), str) -#define BUF_CHARPTR_COPY_CHAR(buf, pos, str) \ - BI_BUF_CHARPTR_COPY_CHAR (buf, bufpos_to_bytind (buf, pos), str) - - - - -/************************************************************************/ -/* */ -/* working with externally-formatted data */ -/* */ -/************************************************************************/ - -/* Sometimes strings need to be converted into one or another - external format, for passing to a library function. (Note - that we encapsulate and automatically convert the arguments - of some functions, but not others.) At times this conversion - also has to go the other way -- i.e. when we get external- - format strings back from a library function. -*/ - -#ifdef FILE_CODING - -/* WARNING: These use a static buffer. This can lead to disaster if - these functions are not used *very* carefully. Under normal - circumstances, do not call these functions; call the front ends - below. */ - -Extbyte *convert_to_external_format (CONST Bufbyte *ptr, - Bytecount len, - Extcount *len_out, - enum external_data_format fmt); -Bufbyte *convert_from_external_format (CONST Extbyte *ptr, - Extcount len, - Bytecount *len_out, - enum external_data_format fmt); - -#else /* ! MULE */ - -#define convert_to_external_format(ptr, len, len_out, fmt) \ - (*(len_out) = (int) (len), (Extbyte *) (ptr)) -#define convert_from_external_format(ptr, len, len_out, fmt) \ - (*(len_out) = (Bytecount) (len), (Bufbyte *) (ptr)) - -#endif /* ! MULE */ - -/* In all of the following macros we use the following general principles: - - -- Functions that work with charptr's accept two sorts of charptr's: - - a) Pointers to memory with a length specified. The pointer will be - fundamentally of type `unsigned char *' (although labelled - as `Bufbyte *' for internal-format data and `Extbyte *' for - external-format data) and the length will be fundamentally of - type `int' (although labelled as `Bytecount' for internal-format - data and `Extcount' for external-format data). The length is - always a count in bytes. - b) Zero-terminated pointers; no length specified. The pointer - is of type `char *', whether the data pointed to is internal-format - or external-format. These sorts of pointers are available for - convenience in working with C library functions and literal - strings. In general you should use these sorts of pointers only - to interface to library routines and not for general manipulation, - as you are liable to lose embedded nulls and such. This could - be a big problem for routines that want Unicode-formatted data, - which is likely to have lots of embedded nulls in it. - (In the real world, though, external Unicode data will be UTF-8, - which will not have embedded nulls and is ASCII-compatible - martin) - - -- Functions that work with Lisp strings accept strings as Lisp Objects - (as opposed to the `struct Lisp_String *' for some of the other - string accessors). This is for convenience in working with the - functions, as otherwise you will almost always have to call - XSTRING() on the object. - - -- Functions that work with charptr's are not guaranteed to copy - their data into alloca()ed space. Functions that work with - Lisp strings are, however. The reason is that Lisp strings can - be relocated any time a GC happens, and it could happen at some - rather unexpected times. The internal-external conversion is - rarely done in time-critical functions, and so the slight - extra time required for alloca() and copy is well-worth the - safety of knowing your string data won't be relocated out from - under you. - */ - - -/* Maybe convert charptr's data into ext-format and store the result in - alloca()'ed space. - - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ - -#ifdef MULE - -#define GET_CHARPTR_EXT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - Bytecount gceda_len_in = (Bytecount) (len); \ - Extcount gceda_len_out; \ - CONST Bufbyte *gceda_ptr_in = (ptr); \ - Extbyte *gceda_ptr_out = \ - convert_to_external_format (gceda_ptr_in, gceda_len_in, \ - &gceda_len_out, fmt); \ - /* If the new string is identical to the old (will be the case most \ - of the time), just return the same string back. This saves \ - on alloca()ing, which can be useful on C alloca() machines and \ - on stack-space-challenged environments. */ \ - \ - if (gceda_len_in == gceda_len_out && \ - !memcmp (gceda_ptr_in, gceda_ptr_out, gceda_len_out)) \ - { \ - (ptr_out) = (Extbyte *) gceda_ptr_in; \ - } \ - else \ - { \ - (ptr_out) = (Extbyte *) alloca (1 + gceda_len_out); \ - memcpy ((void *) ptr_out, gceda_ptr_out, 1 + gceda_len_out); \ - } \ - (len_out) = gceda_len_out; \ -} while (0) - -#else /* ! MULE */ - -#define GET_CHARPTR_EXT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - (ptr_out) = (Extbyte *) (ptr); \ - (len_out) = (Extcount) (len); \ -} while (0) - -#endif /* ! MULE */ - -#define GET_C_CHARPTR_EXT_DATA_ALLOCA(ptr, fmt, ptr_out) do \ -{ \ - Extcount gcceda_ignored_len; \ - CONST Bufbyte *gcceda_ptr_in = (CONST Bufbyte *) (ptr); \ - Extbyte *gcceda_ptr_out; \ - \ - GET_CHARPTR_EXT_DATA_ALLOCA (gcceda_ptr_in, \ - strlen ((char *) gcceda_ptr_in), \ - fmt, \ - gcceda_ptr_out, \ - gcceda_ignored_len); \ - (ptr_out) = (char *) gcceda_ptr_out; \ -} while (0) - -#define GET_C_CHARPTR_EXT_BINARY_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_BINARY, ptr_out) -#define GET_CHARPTR_EXT_BINARY_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_BINARY, ptr_out, len_out) - -#define GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_FILENAME, ptr_out) -#define GET_CHARPTR_EXT_FILENAME_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_FILENAME, ptr_out, len_out) - -#define GET_C_CHARPTR_EXT_CTEXT_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_EXT_DATA_ALLOCA (ptr, FORMAT_CTEXT, ptr_out) -#define GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_EXT_DATA_ALLOCA (ptr, len, FORMAT_CTEXT, ptr_out, len_out) - -/* Maybe convert external charptr's data into internal format and store - the result in alloca()'ed space. - - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ - -#ifdef MULE - -#define GET_CHARPTR_INT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - Extcount gcida_len_in = (Extcount) (len); \ - Bytecount gcida_len_out; \ - CONST Extbyte *gcida_ptr_in = (ptr); \ - Bufbyte *gcida_ptr_out = \ - convert_from_external_format (gcida_ptr_in, gcida_len_in, \ - &gcida_len_out, fmt); \ - /* If the new string is identical to the old (will be the case most \ - of the time), just return the same string back. This saves \ - on alloca()ing, which can be useful on C alloca() machines and \ - on stack-space-challenged environments. */ \ - \ - if (gcida_len_in == gcida_len_out && \ - !memcmp (gcida_ptr_in, gcida_ptr_out, gcida_len_out)) \ - { \ - (ptr_out) = (Bufbyte *) gcida_ptr_in; \ - } \ - else \ - { \ - (ptr_out) = (Extbyte *) alloca (1 + gcida_len_out); \ - memcpy ((void *) ptr_out, gcida_ptr_out, 1 + gcida_len_out); \ - } \ - (len_out) = gcida_len_out; \ -} while (0) - -#else /* ! MULE */ - -#define GET_CHARPTR_INT_DATA_ALLOCA(ptr, len, fmt, ptr_out, len_out) do \ -{ \ - (ptr_out) = (Bufbyte *) (ptr); \ - (len_out) = (Bytecount) (len); \ -} while (0) - -#endif /* ! MULE */ - -#define GET_C_CHARPTR_INT_DATA_ALLOCA(ptr, fmt, ptr_out) do \ -{ \ - Bytecount gccida_ignored_len; \ - CONST Extbyte *gccida_ptr_in = (CONST Extbyte *) (ptr); \ - Bufbyte *gccida_ptr_out; \ - \ - GET_CHARPTR_INT_DATA_ALLOCA (gccida_ptr_in, \ - strlen ((char *) gccida_ptr_in), \ - fmt, \ - gccida_ptr_out, \ - gccida_ignored_len); \ - (ptr_out) = gccida_ptr_out; \ -} while (0) - -#define GET_C_CHARPTR_INT_BINARY_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_BINARY, ptr_out) -#define GET_CHARPTR_INT_BINARY_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_BINARY, ptr_out, len_out) - -#define GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_FILENAME, ptr_out) -#define GET_CHARPTR_INT_FILENAME_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_FILENAME, ptr_out, len_out) - -#define GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA(ptr, ptr_out) \ - GET_C_CHARPTR_INT_DATA_ALLOCA (ptr, FORMAT_CTEXT, ptr_out) -#define GET_CHARPTR_INT_CTEXT_DATA_ALLOCA(ptr, len, ptr_out, len_out) \ - GET_CHARPTR_INT_DATA_ALLOCA (ptr, len, FORMAT_CTEXT, ptr_out, len_out) - - -/* Maybe convert Lisp string's data into ext-format and store the result in - alloca()'ed space. - - You may wonder why this is written in this fashion and not as a - function call. With a little trickery it could certainly be - written this way, but it won't work because of those DAMN GCC WANKERS - who couldn't be bothered to handle alloca() properly on the x86 - architecture. (If you put a call to alloca() in the argument to - a function call, the stack space gets allocated right in the - middle of the arguments to the function call and you are unbelievably - hosed.) */ - -#define GET_STRING_EXT_DATA_ALLOCA(s, fmt, ptr_out, len_out) do \ -{ \ - Extcount gseda_len_out; \ - struct Lisp_String *gseda_s = XSTRING (s); \ - Extbyte * gseda_ptr_out = \ - convert_to_external_format (string_data (gseda_s), \ - string_length (gseda_s), \ - &gseda_len_out, fmt); \ - (ptr_out) = (Extbyte *) alloca (1 + gseda_len_out); \ - memcpy ((void *) ptr_out, gseda_ptr_out, 1 + gseda_len_out); \ - (len_out) = gseda_len_out; \ -} while (0) - - -#define GET_C_STRING_EXT_DATA_ALLOCA(s, fmt, ptr_out) do \ -{ \ - Extcount gcseda_ignored_len; \ - Extbyte *gcseda_ptr_out; \ - \ - GET_STRING_EXT_DATA_ALLOCA (s, fmt, gcseda_ptr_out, \ - gcseda_ignored_len); \ - (ptr_out) = (char *) gcseda_ptr_out; \ -} while (0) - -#define GET_STRING_BINARY_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_BINARY, ptr_out, len_out) -#define GET_C_STRING_BINARY_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_BINARY, ptr_out) - -#define GET_STRING_FILENAME_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_FILENAME, ptr_out, len_out) -#define GET_C_STRING_FILENAME_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_FILENAME, ptr_out) - -#define GET_STRING_OS_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_OS, ptr_out, len_out) -#define GET_C_STRING_OS_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_OS, ptr_out) - -#define GET_STRING_CTEXT_DATA_ALLOCA(s, ptr_out, len_out) \ - GET_STRING_EXT_DATA_ALLOCA (s, FORMAT_CTEXT, ptr_out, len_out) -#define GET_C_STRING_CTEXT_DATA_ALLOCA(s, ptr_out) \ - GET_C_STRING_EXT_DATA_ALLOCA (s, FORMAT_CTEXT, ptr_out) - - - -/************************************************************************/ -/* */ -/* fake charset functions */ -/* */ -/************************************************************************/ - -/* used when MULE is not defined, so that Charset-type stuff can still - be done */ - -#ifndef MULE - -#define Vcharset_ascii Qnil - -#define CHAR_CHARSET(ch) Vcharset_ascii -#define CHAR_LEADING_BYTE(ch) LEADING_BYTE_ASCII -#define LEADING_BYTE_ASCII 0x80 -#define NUM_LEADING_BYTES 1 -#define MIN_LEADING_BYTE 0x80 -#define CHARSETP(cs) 1 -#define CHARSET_BY_LEADING_BYTE(lb) Vcharset_ascii -#define XCHARSET_LEADING_BYTE(cs) LEADING_BYTE_ASCII -#define XCHARSET_GRAPHIC(cs) -1 -#define XCHARSET_COLUMNS(cs) 1 -#define XCHARSET_DIMENSION(cs) 1 -#define REP_BYTES_BY_FIRST_BYTE(fb) 1 -#define BREAKUP_CHAR(ch, charset, byte1, byte2) do { \ - (charset) = Vcharset_ascii; \ - (byte1) = (ch); \ - (byte2) = 0; \ -} while (0) -#define BYTE_ASCII_P(byte) 1 - -#endif /* ! MULE */ - -/************************************************************************/ -/* */ -/* higher-level buffer-position functions */ -/* */ -/************************************************************************/ - -/*----------------------------------------------------------------------*/ -/* Settor macros for important positions in a buffer */ -/*----------------------------------------------------------------------*/ - -/* Set beginning of accessible range of buffer. */ -#define SET_BOTH_BUF_BEGV(buf, val, bival) \ -do \ -{ \ - (buf)->begv = (bival); \ - (buf)->bufbegv = (val); \ -} while (0) - -/* Set end of accessible range of buffer. */ -#define SET_BOTH_BUF_ZV(buf, val, bival) \ -do \ -{ \ - (buf)->zv = (bival); \ - (buf)->bufzv = (val); \ -} while (0) - -/* Set point. */ -/* Since BEGV and ZV are almost never set, it's reasonable to enforce - the restriction that the Bufpos and Bytind values must both be - specified. However, point is set in lots and lots of places. So - we provide the ability to specify both (for efficiency) or just - one. */ -#define BOTH_BUF_SET_PT(buf, val, bival) set_buffer_point (buf, val, bival) -#define BI_BUF_SET_PT(buf, bival) \ - BOTH_BUF_SET_PT (buf, bytind_to_bufpos (buf, bival), bival) -#define BUF_SET_PT(buf, value) \ - BOTH_BUF_SET_PT (buf, value, bufpos_to_bytind (buf, value)) - - -#if 0 /* FSFmacs */ -/* These macros exist in FSFmacs because SET_PT() in FSFmacs incorrectly - does too much stuff, such as moving out of invisible extents. */ -#define TEMP_SET_PT(position) (temp_set_point ((position), current_buffer)) -#define SET_BUF_PT(buf, value) ((buf)->pt = (value)) -#endif /* FSFmacs */ - -/*----------------------------------------------------------------------*/ -/* Miscellaneous buffer values */ -/*----------------------------------------------------------------------*/ - -/* Number of characters in buffer */ -#define BUF_SIZE(buf) (BUF_Z (buf) - BUF_BEG (buf)) - -/* Is this buffer narrowed? */ -#define BUF_NARROWED(buf) \ - ((BI_BUF_BEGV (buf) != BI_BUF_BEG (buf)) || \ - (BI_BUF_ZV (buf) != BI_BUF_Z (buf))) - -/* Modification count. */ -#define BUF_MODIFF(buf) ((buf)->text->modiff) - -/* Saved modification count. */ -#define BUF_SAVE_MODIFF(buf) ((buf)->text->save_modiff) - -/* Face changed. */ -#define BUF_FACECHANGE(buf) ((buf)->face_change) - -#define POINT_MARKER_P(marker) \ - (XMARKER (marker)->buffer != 0 && \ - EQ ((marker), XMARKER (marker)->buffer->point_marker)) - -#define BUF_MARKERS(buf) ((buf)->markers) - -/* WARNING: - - The new definitions of CEILING_OF() and FLOOR_OF() differ semantically - from the old ones (in FSF Emacs and XEmacs 19.11 and before). - Conversion is as follows: - - OLD_BI_CEILING_OF(n) = NEW_BI_CEILING_OF(n) - 1 - OLD_BI_FLOOR_OF(n) = NEW_BI_FLOOR_OF(n + 1) - - The definitions were changed because the new definitions are more - consistent with the way everything else works in Emacs. - */ - -/* Properties of CEILING_OF and FLOOR_OF (also apply to BI_ variants): - - 1) FLOOR_OF (CEILING_OF (n)) = n - CEILING_OF (FLOOR_OF (n)) = n - - 2) CEILING_OF (n) = n if and only if n = ZV - FLOOR_OF (n) = n if and only if n = BEGV - - 3) CEILING_OF (CEILING_OF (n)) = ZV - FLOOR_OF (FLOOR_OF (n)) = BEGV - - 4) The bytes in the regions - - [BYTE_ADDRESS (n), BYTE_ADDRESS_BEFORE (CEILING_OF (n))] - - and - - [BYTE_ADDRESS (FLOOR_OF (n)), BYTE_ADDRESS_BEFORE (n)] - - are contiguous. - */ - - -/* Return the maximum index in the buffer it is safe to scan forwards - past N to. This is used to prevent buffer scans from running into - the gap (e.g. search.c). All characters between N and CEILING_OF(N) - are located contiguous in memory. Note that the character *at* - CEILING_OF(N) is not contiguous in memory. */ -#define BI_BUF_CEILING_OF(b, n) \ - ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_ZV (b) ? \ - (b)->text->gpt : BI_BUF_ZV (b)) -#define BUF_CEILING_OF(b, n) \ - bytind_to_bufpos (b, BI_BUF_CEILING_OF (b, bufpos_to_bytind (b, n))) - -/* Return the minimum index in the buffer it is safe to scan backwards - past N to. All characters between FLOOR_OF(N) and N are located - contiguous in memory. Note that the character *at* N may not be - contiguous in memory. */ -#define BI_BUF_FLOOR_OF(b, n) \ - (BI_BUF_BEGV (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ - (b)->text->gpt : BI_BUF_BEGV (b)) -#define BUF_FLOOR_OF(b, n) \ - bytind_to_bufpos (b, BI_BUF_FLOOR_OF (b, bufpos_to_bytind (b, n))) - -#define BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \ - ((n) < (b)->text->gpt && (b)->text->gpt < BI_BUF_Z (b) ? \ - (b)->text->gpt : BI_BUF_Z (b)) -#define BUF_CEILING_OF_IGNORE_ACCESSIBLE(b, n) \ - bytind_to_bufpos \ - (b, BI_BUF_CEILING_OF_IGNORE_ACCESSIBLE (b, bufpos_to_bytind (b, n))) - -#define BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \ - (BI_BUF_BEG (b) < (b)->text->gpt && (b)->text->gpt < (n) ? \ - (b)->text->gpt : BI_BUF_BEG (b)) -#define BUF_FLOOR_OF_IGNORE_ACCESSIBLE(b, n) \ - bytind_to_bufpos \ - (b, BI_BUF_FLOOR_OF_IGNORE_ACCESSIBLE (b, bufpos_to_bytind (b, n))) - - -extern struct buffer *current_buffer; - -/* This is the initial (startup) directory, as used for the *scratch* buffer. - We're making this a global to make others aware of the startup directory. - `initial_directory' is stored in external format. - */ -extern char initial_directory[]; -extern void init_initial_directory (void); /* initialize initial_directory */ - -EXFUN (Fbuffer_disable_undo, 1); -EXFUN (Fbuffer_modified_p, 1); -EXFUN (Fbuffer_name, 1); -EXFUN (Fcurrent_buffer, 0); -EXFUN (Ferase_buffer, 1); -EXFUN (Fget_buffer, 1); -EXFUN (Fget_buffer_create, 1); -EXFUN (Fget_file_buffer, 1); -EXFUN (Fkill_buffer, 1); -EXFUN (Fother_buffer, 3); -EXFUN (Frecord_buffer, 1); -EXFUN (Fset_buffer, 1); -EXFUN (Fset_buffer_modified_p, 2); - -extern Lisp_Object QSscratch, Qafter_change_function, Qafter_change_functions; -extern Lisp_Object Qbefore_change_function, Qbefore_change_functions; -extern Lisp_Object Qbuffer_or_string_p, Qdefault_directory, Qfirst_change_hook; -extern Lisp_Object Qpermanent_local, Vafter_change_function; -extern Lisp_Object Vafter_change_functions, Vbefore_change_function; -extern Lisp_Object Vbefore_change_functions, Vbuffer_alist, Vbuffer_defaults; -extern Lisp_Object Vinhibit_read_only, Vtransient_mark_mode; - -/* This structure marks which slots in a buffer have corresponding - default values in Vbuffer_defaults. - Each such slot has a nonzero value in this structure. - The value has only one nonzero bit. - - When a buffer has its own local value for a slot, - the bit for that slot (found in the same slot in this structure) - is turned on in the buffer's local_var_flags slot. - - If a slot in this structure is zero, then even though there may - be a DEFVAR_BUFFER_LOCAL for the slot, there is no default value for it; - and the corresponding slot in Vbuffer_defaults is not used. */ - -extern struct buffer buffer_local_flags; - - -/* Allocation of buffer data. */ - -#ifdef REL_ALLOC - -char *r_alloc (unsigned char **, unsigned long); -char *r_re_alloc (unsigned char **, unsigned long); -void r_alloc_free (unsigned char **); - -#define BUFFER_ALLOC(data, size) \ - ((Bufbyte *) r_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte))) -#define BUFFER_REALLOC(data, size) \ - ((Bufbyte *) r_re_alloc ((unsigned char **) &data, (size) * sizeof(Bufbyte))) -#define BUFFER_FREE(data) r_alloc_free ((unsigned char **) &(data)) -#define R_ALLOC_DECLARE(var,data) r_alloc_declare (&(var), data) - -#else /* !REL_ALLOC */ - -#define BUFFER_ALLOC(data,size)\ - (data = xnew_array (Bufbyte, size)) -#define BUFFER_REALLOC(data,size)\ - ((Bufbyte *) xrealloc (data, (size) * sizeof(Bufbyte))) -/* Avoid excess parentheses, or syntax errors may rear their heads. */ -#define BUFFER_FREE(data) xfree (data) -#define R_ALLOC_DECLARE(var,data) - -#endif /* !REL_ALLOC */ - -extern Lisp_Object Vbuffer_alist; -void set_buffer_internal (struct buffer *b); -struct buffer *decode_buffer (Lisp_Object buffer, int allow_string); - -/* from editfns.c */ -void widen_buffer (struct buffer *b, int no_clip); -int beginning_of_line_p (struct buffer *b, Bufpos pt); - -/* from insdel.c */ -void set_buffer_point (struct buffer *buf, Bufpos pos, Bytind bipos); -void find_charsets_in_bufbyte_string (unsigned char *charsets, - CONST Bufbyte *str, - Bytecount len); -void find_charsets_in_emchar_string (unsigned char *charsets, - CONST Emchar *str, - Charcount len); -int bufbyte_string_displayed_columns (CONST Bufbyte *str, Bytecount len); -int emchar_string_displayed_columns (CONST Emchar *str, Charcount len); -void convert_bufbyte_string_into_emchar_dynarr (CONST Bufbyte *str, - Bytecount len, - Emchar_dynarr *dyn); -Charcount convert_bufbyte_string_into_emchar_string (CONST Bufbyte *str, - Bytecount len, - Emchar *arr); -void convert_emchar_string_into_bufbyte_dynarr (Emchar *arr, int nels, - Bufbyte_dynarr *dyn); -Bufbyte *convert_emchar_string_into_malloced_string (Emchar *arr, int nels, - Bytecount *len_out); -/* from marker.c */ -void init_buffer_markers (struct buffer *b); -void uninit_buffer_markers (struct buffer *b); - -/* flags for get_buffer_pos_char(), get_buffer_range_char(), etc. */ -/* At most one of GB_COERCE_RANGE and GB_NO_ERROR_IF_BAD should be - specified. At most one of GB_NEGATIVE_FROM_END and GB_NO_ERROR_IF_BAD - should be specified. */ - -#define GB_ALLOW_PAST_ACCESSIBLE (1 << 0) -#define GB_ALLOW_NIL (1 << 1) -#define GB_CHECK_ORDER (1 << 2) -#define GB_COERCE_RANGE (1 << 3) -#define GB_NO_ERROR_IF_BAD (1 << 4) -#define GB_NEGATIVE_FROM_END (1 << 5) -#define GB_HISTORICAL_STRING_BEHAVIOR (GB_NEGATIVE_FROM_END | GB_ALLOW_NIL) - -Bufpos get_buffer_pos_char (struct buffer *b, Lisp_Object pos, - unsigned int flags); -Bytind get_buffer_pos_byte (struct buffer *b, Lisp_Object pos, - unsigned int flags); -void get_buffer_range_char (struct buffer *b, Lisp_Object from, Lisp_Object to, - Bufpos *from_out, Bufpos *to_out, - unsigned int flags); -void get_buffer_range_byte (struct buffer *b, Lisp_Object from, Lisp_Object to, - Bytind *from_out, Bytind *to_out, - unsigned int flags); -Charcount get_string_pos_char (Lisp_Object string, Lisp_Object pos, - unsigned int flags); -Bytecount get_string_pos_byte (Lisp_Object string, Lisp_Object pos, - unsigned int flags); -void get_string_range_char (Lisp_Object string, Lisp_Object from, - Lisp_Object to, Charcount *from_out, - Charcount *to_out, unsigned int flags); -void get_string_range_byte (Lisp_Object string, Lisp_Object from, - Lisp_Object to, Bytecount *from_out, - Bytecount *to_out, unsigned int flags); -Bufpos get_buffer_or_string_pos_char (Lisp_Object object, Lisp_Object pos, - unsigned int flags); -Bytind get_buffer_or_string_pos_byte (Lisp_Object object, Lisp_Object pos, - unsigned int flags); -void get_buffer_or_string_range_char (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Bufpos *from_out, - Bufpos *to_out, unsigned int flags); -void get_buffer_or_string_range_byte (Lisp_Object object, Lisp_Object from, - Lisp_Object to, Bytind *from_out, - Bytind *to_out, unsigned int flags); -Bufpos buffer_or_string_accessible_begin_char (Lisp_Object object); -Bufpos buffer_or_string_accessible_end_char (Lisp_Object object); -Bytind buffer_or_string_accessible_begin_byte (Lisp_Object object); -Bytind buffer_or_string_accessible_end_byte (Lisp_Object object); -Bufpos buffer_or_string_absolute_begin_char (Lisp_Object object); -Bufpos buffer_or_string_absolute_end_char (Lisp_Object object); -Bytind buffer_or_string_absolute_begin_byte (Lisp_Object object); -Bytind buffer_or_string_absolute_end_byte (Lisp_Object object); -void record_buffer (Lisp_Object buf); -Lisp_Object get_buffer (Lisp_Object name, - int error_if_deleted_or_does_not_exist); -int map_over_sharing_buffers (struct buffer *buf, - int (*mapfun) (struct buffer *buf, - void *closure), - void *closure); - - -/************************************************************************/ -/* Case conversion */ -/************************************************************************/ - -/* A "trt" table is a mapping from characters to other characters, - typically used to convert between uppercase and lowercase. For - compatibility reasons, trt tables are currently in the form of - a Lisp string of 256 characters, specifying the conversion for each - of the first 256 Emacs characters (i.e. the 256 Latin-1 characters). - This should be generalized at some point to support conversions for - all of the allowable Mule characters. - */ - -/* The _1 macros are named as such because they assume that you have - already guaranteed that the character values are all in the range - 0 - 255. Bad lossage will happen otherwise. */ - -# define MAKE_TRT_TABLE() Fmake_string (make_int (256), make_char (0)) -# define TRT_TABLE_AS_STRING(table) XSTRING_DATA (table) -# define TRT_TABLE_CHAR_1(table, ch) \ - string_char (XSTRING (table), (Charcount) ch) -# define SET_TRT_TABLE_CHAR_1(table, ch1, ch2) \ - set_string_char (XSTRING (table), (Charcount) ch1, ch2) - -#ifdef MULE -# define MAKE_MIRROR_TRT_TABLE() make_opaque (256, 0) -# define MIRROR_TRT_TABLE_AS_STRING(table) ((Bufbyte *) XOPAQUE_DATA (table)) -# define MIRROR_TRT_TABLE_CHAR_1(table, ch) \ - ((Emchar) (MIRROR_TRT_TABLE_AS_STRING (table)[ch])) -# define SET_MIRROR_TRT_TABLE_CHAR_1(table, ch1, ch2) \ - (MIRROR_TRT_TABLE_AS_STRING (table)[ch1] = (Bufbyte) (ch2)) -#endif - -# define IN_TRT_TABLE_DOMAIN(c) (((EMACS_UINT) (c)) <= 255) - -#ifdef MULE -#define MIRROR_DOWNCASE_TABLE_AS_STRING(buf) \ - MIRROR_TRT_TABLE_AS_STRING (buf->mirror_downcase_table) -#define MIRROR_UPCASE_TABLE_AS_STRING(buf) \ - MIRROR_TRT_TABLE_AS_STRING (buf->mirror_upcase_table) -#define MIRROR_CANON_TABLE_AS_STRING(buf) \ - MIRROR_TRT_TABLE_AS_STRING (buf->mirror_case_canon_table) -#define MIRROR_EQV_TABLE_AS_STRING(buf) \ - MIRROR_TRT_TABLE_AS_STRING (buf->mirror_case_eqv_table) -#else -#define MIRROR_DOWNCASE_TABLE_AS_STRING(buf) \ - TRT_TABLE_AS_STRING (buf->downcase_table) -#define MIRROR_UPCASE_TABLE_AS_STRING(buf) \ - TRT_TABLE_AS_STRING (buf->upcase_table) -#define MIRROR_CANON_TABLE_AS_STRING(buf) \ - TRT_TABLE_AS_STRING (buf->case_canon_table) -#define MIRROR_EQV_TABLE_AS_STRING(buf) \ - TRT_TABLE_AS_STRING (buf->case_eqv_table) -#endif - -INLINE Emchar TRT_TABLE_OF (Lisp_Object trt, Emchar c); -INLINE Emchar -TRT_TABLE_OF (Lisp_Object trt, Emchar c) -{ - return IN_TRT_TABLE_DOMAIN (c) ? TRT_TABLE_CHAR_1 (trt, c) : c; -} - -/* Macros used below. */ -#define DOWNCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->downcase_table, c) -#define UPCASE_TABLE_OF(buf, c) TRT_TABLE_OF (buf->upcase_table, c) - -/* 1 if CH is upper case. */ - -INLINE int UPPERCASEP (struct buffer *buf, Emchar ch); -INLINE int -UPPERCASEP (struct buffer *buf, Emchar ch) -{ - return DOWNCASE_TABLE_OF (buf, ch) != ch; -} - -/* 1 if CH is lower case. */ - -INLINE int LOWERCASEP (struct buffer *buf, Emchar ch); -INLINE int -LOWERCASEP (struct buffer *buf, Emchar ch) -{ - return (UPCASE_TABLE_OF (buf, ch) != ch && - DOWNCASE_TABLE_OF (buf, ch) == ch); -} - -/* 1 if CH is neither upper nor lower case. */ - -INLINE int NOCASEP (struct buffer *buf, Emchar ch); -INLINE int -NOCASEP (struct buffer *buf, Emchar ch) -{ - return UPCASE_TABLE_OF (buf, ch) == ch; -} - -/* Upcase a character, or make no change if that cannot be done. */ - -INLINE Emchar UPCASE (struct buffer *buf, Emchar ch); -INLINE Emchar -UPCASE (struct buffer *buf, Emchar ch) -{ - return (DOWNCASE_TABLE_OF (buf, ch) == ch) ? UPCASE_TABLE_OF (buf, ch) : ch; -} - -/* Upcase a character known to be not upper case. Unused. */ - -#define UPCASE1(buf, ch) UPCASE_TABLE_OF (buf, ch) - -/* Downcase a character, or make no change if that cannot be done. */ - -#define DOWNCASE(buf, ch) DOWNCASE_TABLE_OF (buf, ch) - -#endif /* _XEMACS_BUFFER_H_ */ diff --git a/src/bufslots.h b/src/bufslots.h deleted file mode 100644 index 88f5daf..0000000 --- a/src/bufslots.h +++ /dev/null @@ -1,243 +0,0 @@ -/* Definitions of marked slots in buffers - Copyright (C) 1990, 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: Mule 2.0, FSF 19.30. Split out of buffer.h. */ - -/* Authorship: - - FSF: long ago (part of buffer.h). - JWZ: separated out from buffer.h, early in Lemacs. - XEmacs: a few other changes. - */ - -/* In the declaration of the buffer structure, this file is included - after defining MARKED_SLOT(x) to be Lisp_Object x; i.e. just a slot - definition. In the garbage collector this file is included after - defining MARKED_SLOT(x) to be mark_object(buffer->x). */ - - /* The name of this buffer. */ - MARKED_SLOT (name); - - /* The name of the file visited in this buffer, or nil. */ - MARKED_SLOT (filename); - - /* Dir for expanding relative file names. */ - MARKED_SLOT (directory); - - /* True iff this buffer has been backed up (if you write to the - visited file and it hasn't been backed up, then a backup will - be made). */ - /* #### This isn't really used by the C code, so could be deleted. */ - MARKED_SLOT (backed_up); - - /* Length of file when last read or saved. - This is not in the struct buffer_text - because it's not used in indirect buffers at all. */ - MARKED_SLOT (saved_size); - - /* File name used for auto-saving this buffer. - This is not in the struct buffer_text - because it's not used in indirect buffers at all. */ - MARKED_SLOT (auto_save_file_name); - - /* Non-nil if buffer read-only. */ - MARKED_SLOT (read_only); - - /* "The mark". This is a marker which may - point into this buffer or may point nowhere. */ - MARKED_SLOT (mark); - - /* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) - for all per-buffer variables of this buffer. - Specifically, this lists those variables that have - a buffer-local value in this buffer: i.e. those - whose value does not shadow the default value. - (Remember that for any particular variable created - with `make-local-variable' or `make-variable-buffer-local', - it will have a per-buffer value in some buffers and a - default value in others.) - - Variables declared in C with DEFVAR_BUFFER_LOCAL() (i.e. - those stored in the struct buffer) are not listed here. */ - MARKED_SLOT (local_var_alist); - - /* Symbol naming major mode (eg, lisp-mode). */ - MARKED_SLOT (major_mode); - - /* Pretty name of major mode (eg, "Lisp"). */ - MARKED_SLOT (mode_name); - - /* Modeline element that controls format of modeline. */ - MARKED_SLOT (modeline_format); - - /* Keys that are bound local to this buffer. */ - MARKED_SLOT (keymap); - - /* This buffer's local abbrev table. */ - MARKED_SLOT (abbrev_table); - /* This buffer's syntax table. */ - MARKED_SLOT (syntax_table); - /* Massaged values from the syntax table, for faster lookup. */ - MARKED_SLOT (mirror_syntax_table); - -#ifdef MULE - /* This buffer's category table. */ - MARKED_SLOT (category_table); -#endif /* MULE */ -#ifdef FILE_CODING - /* This buffer's coding system. */ - MARKED_SLOT (buffer_file_coding_system); -#endif - /* Values of several buffer-local variables. - - tab-width is buffer-local so that redisplay can find it - in buffers that are not current */ - MARKED_SLOT (case_fold_search); - MARKED_SLOT (tab_width); - MARKED_SLOT (fill_column); - MARKED_SLOT (left_margin); - - /* Function to call when insert space past fill column. */ - MARKED_SLOT (auto_fill_function); - - /* Case table for case-conversion in this buffer. - This char-table maps each char into its lower-case version. */ - MARKED_SLOT (downcase_table); - /* Char-table mapping each char to its upper-case version. */ - MARKED_SLOT (upcase_table); - - /* Char-table for conversion for case-folding search. */ - MARKED_SLOT (case_canon_table); - /* Char-table of equivalences for case-folding search. */ - MARKED_SLOT (case_eqv_table); - -#ifdef MULE - /* #### The purpose of these bogos is to deal with the fact that - the Boyer-Moore and regex searching routines don't know how to - deal with translating multi-byte characters. Fixing this is hard, - so instead we maintain these mirror tables that have all incorrect - mappings (see casetab.c) sanitized out of them. If we don't do - this, we may get weird and unpredictable results in the presence - of extended chars and extended mappings, and it could even lead - to a crash. - - #### Eventually we should deal with this properly. */ - MARKED_SLOT (mirror_downcase_table); - MARKED_SLOT (mirror_upcase_table); - MARKED_SLOT (mirror_case_canon_table); - MARKED_SLOT (mirror_case_eqv_table); -#endif - - /* #### This ought to be a specifier: */ - /* Non-nil means do not display continuation lines. */ - MARKED_SLOT (truncate_lines); - /* #### This ought to be a specifier: */ - /* #### Better yet, it ought to be junked. It really sucks. */ - /* Non-nil means display ctl chars with uparrow. */ - MARKED_SLOT (ctl_arrow); - /* #### This ought to be a specifier: */ - /* #### Better yet, it ought to be junked. It really sucks. */ - /* Non-nil means do selective display; - see doc string in syms_of_buffer (buffer.c) for details. */ - MARKED_SLOT (selective_display); - /* #### This ought to be a specifier: */ - /* #### Better yet, it ought to be junked. It really sucks. */ - /* Non-nil means show ... at end of line followed by invisible lines. */ - MARKED_SLOT (selective_display_ellipses); - /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */ - /* Unused: MARKED_SLOT (minor_modes); */ - /* t if "self-insertion" should overwrite */ - MARKED_SLOT (overwrite_mode); - /* non-nil means abbrev mode is on. Expand abbrevs automatically. */ - MARKED_SLOT (abbrev_mode); - - /* No display table here. It's a specifier. */ -#if 0 /* FSFmacs */ - /* t means the mark and region are currently active. */ - MARKED_SLOT (mark_active); -#endif - - /* Changes in the buffer are recorded here for undo. - t means don't record anything. - This information belongs to the base buffer of an indirect buffer, - But we can't store it in the struct buffer_text - because local variables have to be right in the struct buffer. - So we copy it around in set_buffer_internal. */ - MARKED_SLOT (undo_list); - - /* FSFmacs has overlay stuff here. We have extent info elsewhere in the - struct buffer. */ - - /* If dedicated_frame is non-nil, display_buffer tries to use it instead - of the current frame */ - MARKED_SLOT (dedicated_frame); - - /* Lisp of symbols naming the file format used for visited file. */ - MARKED_SLOT (file_format); - -#ifdef REGION_CACHE_NEEDS_WORK - /* True if the newline position cache and width run cache are - enabled. See search.c and indent.c. */ - MARKED_SLOT (cache_long_line_scans); - - /* If the width run cache is enabled, this table contains the - character widths width_run_cache (see above) assumes. When we - do a thorough redisplay, we compare this against the buffer's - current display table to see whether the display table has - affected the widths of any characters. If it has, we - invalidate the width run cache, and re-initialize width_table. */ - MARKED_SLOT (width_table); -#endif /* REGION_CACHE_NEEDS_WORK */ - - /* A redundant copy of text.pt, in the form of a marker. Every time one - is updated, so is the other. - */ - MARKED_SLOT (point_marker); - - /* FSFmacs has pt_marker, begv_marker, zv_marker here, used for - indirect buffers. We don't need them because we handle these - values directly instead of playing games with markers. */ - - /* This holds the point value before the last scroll operation. - Explicitly setting point sets this to nil. */ - MARKED_SLOT (point_before_scroll); - - /* Truename of the visited file (via the realpath() system call), - or nil. */ - MARKED_SLOT (file_truename); - - /* Invisibility spec of this buffer. - t => any non-nil `invisible' property means invisible. - A list => `invisible' property means invisible - if it is memq in that list. */ - MARKED_SLOT (invisibility_spec); - - /* The string generated by formatting the modeline in this buffer. */ - MARKED_SLOT (generated_modeline_string); - - /* A hash table that maps from a "generic extent" (an extent in - `modeline-format') into a buffer-specific extent. */ - MARKED_SLOT (modeline_extent_table); -#if 0 /* FSFmacs */ - /* This is silly and stupid */ - /* These are so we don't have to recompile everything - the next few times we add a new slot. */ - MARKED_SLOT (extra1, extra2, extra3); -#endif diff --git a/src/bytecode.c b/src/bytecode.c deleted file mode 100644 index 09e4908..0000000 --- a/src/bytecode.c +++ /dev/null @@ -1,2465 +0,0 @@ -/* Execution of byte code produced by bytecomp.el. - Implementation of compiled-function objects. - 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: Mule 2.0, FSF 19.30. */ - -/* This file has been Mule-ized. */ - - -/* Authorship: - - FSF: long ago. - -hacked on by jwz@netscape.com 1991-06 - o added a compile-time switch to turn on simple sanity checking; - o put back the obsolete byte-codes for error-detection; - o added a new instruction, unbind_all, which I will use for - tail-recursion elimination; - o made temp_output_buffer_show be called with the right number - of args; - o made the new bytecodes be called with args in the right order; - o added metering support. - -by Hallvard: - o added relative jump instructions; - o all conditionals now only do QUIT if they jump. - - Ben Wing: some changes for Mule, 1995-06. - - Martin Buchholz: performance hacking, 1998-09. - See Internals Manual, Evaluation. - */ - -#include -#include "lisp.h" -#include "backtrace.h" -#include "buffer.h" -#include "bytecode.h" -#include "opaque.h" -#include "syntax.h" - -#include -#include - -EXFUN (Ffetch_bytecode, 1); - -Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; - -enum Opcode /* Byte codes */ -{ - Bvarref = 010, - Bvarset = 020, - Bvarbind = 030, - Bcall = 040, - Bunbind = 050, - - Bnth = 070, - Bsymbolp = 071, - Bconsp = 072, - Bstringp = 073, - Blistp = 074, - Bold_eq = 075, - Bold_memq = 076, - Bnot = 077, - Bcar = 0100, - Bcdr = 0101, - Bcons = 0102, - Blist1 = 0103, - Blist2 = 0104, - Blist3 = 0105, - Blist4 = 0106, - Blength = 0107, - Baref = 0110, - Baset = 0111, - Bsymbol_value = 0112, - Bsymbol_function = 0113, - Bset = 0114, - Bfset = 0115, - Bget = 0116, - Bsubstring = 0117, - Bconcat2 = 0120, - Bconcat3 = 0121, - Bconcat4 = 0122, - Bsub1 = 0123, - Badd1 = 0124, - Beqlsign = 0125, - Bgtr = 0126, - Blss = 0127, - Bleq = 0130, - Bgeq = 0131, - Bdiff = 0132, - Bnegate = 0133, - Bplus = 0134, - Bmax = 0135, - Bmin = 0136, - Bmult = 0137, - - Bpoint = 0140, - Beq = 0141, /* was Bmark, - but no longer generated as of v18 */ - Bgoto_char = 0142, - Binsert = 0143, - Bpoint_max = 0144, - Bpoint_min = 0145, - Bchar_after = 0146, - Bfollowing_char = 0147, - Bpreceding_char = 0150, - Bcurrent_column = 0151, - Bindent_to = 0152, - Bequal = 0153, /* was Bscan_buffer, - but no longer generated as of v18 */ - Beolp = 0154, - Beobp = 0155, - Bbolp = 0156, - Bbobp = 0157, - Bcurrent_buffer = 0160, - Bset_buffer = 0161, - Bsave_current_buffer = 0162, /* was Bread_char, - but no longer generated as of v19 */ - Bmemq = 0163, /* was Bset_mark, - but no longer generated as of v18 */ - Binteractive_p = 0164, /* Needed since interactive-p takes - unevalled args */ - Bforward_char = 0165, - Bforward_word = 0166, - Bskip_chars_forward = 0167, - Bskip_chars_backward = 0170, - Bforward_line = 0171, - Bchar_syntax = 0172, - Bbuffer_substring = 0173, - Bdelete_region = 0174, - Bnarrow_to_region = 0175, - Bwiden = 0176, - Bend_of_line = 0177, - - Bconstant2 = 0201, - Bgoto = 0202, - Bgotoifnil = 0203, - Bgotoifnonnil = 0204, - Bgotoifnilelsepop = 0205, - Bgotoifnonnilelsepop = 0206, - Breturn = 0207, - Bdiscard = 0210, - Bdup = 0211, - - Bsave_excursion = 0212, - Bsave_window_excursion= 0213, - Bsave_restriction = 0214, - Bcatch = 0215, - - Bunwind_protect = 0216, - Bcondition_case = 0217, - Btemp_output_buffer_setup = 0220, - Btemp_output_buffer_show = 0221, - - Bunbind_all = 0222, - - Bset_marker = 0223, - Bmatch_beginning = 0224, - Bmatch_end = 0225, - Bupcase = 0226, - Bdowncase = 0227, - - Bstring_equal = 0230, - Bstring_lessp = 0231, - Bold_equal = 0232, - Bnthcdr = 0233, - Belt = 0234, - Bold_member = 0235, - Bold_assq = 0236, - Bnreverse = 0237, - Bsetcar = 0240, - Bsetcdr = 0241, - Bcar_safe = 0242, - Bcdr_safe = 0243, - Bnconc = 0244, - Bquo = 0245, - Brem = 0246, - Bnumberp = 0247, - Bintegerp = 0250, - - BRgoto = 0252, - BRgotoifnil = 0253, - BRgotoifnonnil = 0254, - BRgotoifnilelsepop = 0255, - BRgotoifnonnilelsepop = 0256, - - BlistN = 0257, - BconcatN = 0260, - BinsertN = 0261, - Bmember = 0266, /* new in v20 */ - Bassq = 0267, /* new in v20 */ - - Bconstant = 0300 -}; -typedef enum Opcode Opcode; -typedef unsigned char Opbyte; - - -static void invalid_byte_code_error (char *error_message, ...); - -Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr, - CONST Opbyte *program_ptr, - Opcode opcode); - -static Lisp_Object execute_optimized_program (CONST Opbyte *program, - int stack_depth, - Lisp_Object *constants_data); - -extern Lisp_Object Qand_rest, Qand_optional; - -/* Define ERROR_CHECK_BYTE_CODE to enable some minor sanity checking. - Useful for debugging the byte compiler. */ -#ifdef DEBUG_XEMACS -#define ERROR_CHECK_BYTE_CODE -#endif - -/* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram. - This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */ -/* #define BYTE_CODE_METER */ - - -#ifdef BYTE_CODE_METER - -Lisp_Object Vbyte_code_meter, Qbyte_code_meter; -int byte_metering_on; - -#define METER_2(code1, code2) \ - XINT (XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[(code1)])[(code2)]) - -#define METER_1(code) METER_2 (0, (code)) - -#define METER_CODE(last_code, this_code) do { \ - if (byte_metering_on) \ - { \ - if (METER_1 (this_code) != ((1< ival2 ? 1 : 0; - } - - arithcompare_float: - - { - double dval1, dval2; - - if (FLOATP (obj1)) dval1 = XFLOAT_DATA (obj1); - else if (INTP (obj1)) dval1 = (double) XINT (obj1); - else if (CHARP (obj1)) dval1 = (double) XCHAR (obj1); - else if (MARKERP (obj1)) dval1 = (double) marker_position (obj1); - else - { - obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1); - goto retry; - } - - if (FLOATP (obj2)) dval2 = XFLOAT_DATA (obj2); - else if (INTP (obj2)) dval2 = (double) XINT (obj2); - else if (CHARP (obj2)) dval2 = (double) XCHAR (obj2); - else if (MARKERP (obj2)) dval2 = (double) marker_position (obj2); - else - { - obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2); - goto retry; - } - - return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0; - } -#else /* !LISP_FLOAT_TYPE */ - { - int ival1, ival2; - - if (INTP (obj1)) ival1 = XINT (obj1); - else if (CHARP (obj1)) ival1 = XCHAR (obj1); - else if (MARKERP (obj1)) ival1 = marker_position (obj1); - else - { - obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1); - goto retry; - } - - if (INTP (obj2)) ival2 = XINT (obj2); - else if (CHARP (obj2)) ival2 = XCHAR (obj2); - else if (MARKERP (obj2)) ival2 = marker_position (obj2); - else - { - obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2); - goto retry; - } - - return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; - } -#endif /* !LISP_FLOAT_TYPE */ -} - -static Lisp_Object -bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode) -{ -#ifdef LISP_FLOAT_TYPE - int ival1, ival2; - int float_p; - - retry: - - float_p = 0; - - if (INTP (obj1)) ival1 = XINT (obj1); - else if (CHARP (obj1)) ival1 = XCHAR (obj1); - else if (MARKERP (obj1)) ival1 = marker_position (obj1); - else if (FLOATP (obj1)) ival1 = 0, float_p = 1; - else - { - obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1); - goto retry; - } - - if (INTP (obj2)) ival2 = XINT (obj2); - else if (CHARP (obj2)) ival2 = XCHAR (obj2); - else if (MARKERP (obj2)) ival2 = marker_position (obj2); - else if (FLOATP (obj2)) ival2 = 0, float_p = 1; - else - { - obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2); - goto retry; - } - - if (!float_p) - { - switch (opcode) - { - case Bplus: ival1 += ival2; break; - case Bdiff: ival1 -= ival2; break; - case Bmult: ival1 *= ival2; break; - case Bquo: - if (ival2 == 0) Fsignal (Qarith_error, Qnil); - ival1 /= ival2; - break; - case Bmax: if (ival1 < ival2) ival1 = ival2; break; - case Bmin: if (ival1 > ival2) ival1 = ival2; break; - } - return make_int (ival1); - } - else - { - double dval1 = FLOATP (obj1) ? XFLOAT_DATA (obj1) : (double) ival1; - double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2; - switch (opcode) - { - case Bplus: dval1 += dval2; break; - case Bdiff: dval1 -= dval2; break; - case Bmult: dval1 *= dval2; break; - case Bquo: - if (dval2 == 0) Fsignal (Qarith_error, Qnil); - dval1 /= dval2; - break; - case Bmax: if (dval1 < dval2) dval1 = dval2; break; - case Bmin: if (dval1 > dval2) dval1 = dval2; break; - } - return make_float (dval1); - } -#else /* !LISP_FLOAT_TYPE */ - int ival1, ival2; - - retry: - - if (INTP (obj1)) ival1 = XINT (obj1); - else if (CHARP (obj1)) ival1 = XCHAR (obj1); - else if (MARKERP (obj1)) ival1 = marker_position (obj1); - else - { - obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1); - goto retry; - } - - if (INTP (obj2)) ival2 = XINT (obj2); - else if (CHARP (obj2)) ival2 = XCHAR (obj2); - else if (MARKERP (obj2)) ival2 = marker_position (obj2); - else - { - obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2); - goto retry; - } - - switch (opcode) - { - case Bplus: ival1 += ival2; break; - case Bdiff: ival1 -= ival2; break; - case Bmult: ival1 *= ival2; break; - case Bquo: - if (ival2 == 0) Fsignal (Qarith_error, Qnil); - ival1 /= ival2; - break; - case Bmax: if (ival1 < ival2) ival1 = ival2; break; - case Bmin: if (ival1 > ival2) ival1 = ival2; break; - } - return make_int (ival1); -#endif /* !LISP_FLOAT_TYPE */ -} - -/* Apply compiled-function object FUN to the NARGS evaluated arguments - in ARGS, and return the result of evaluation. */ -Lisp_Object -funcall_compiled_function (Lisp_Object fun, int nargs, Lisp_Object args[]) -{ - /* This function can GC */ - Lisp_Object symbol, tail; - int speccount = specpdl_depth(); - REGISTER int i = 0; - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - int optional = 0; - - if (!OPAQUEP (f->instructions)) - /* Lazily munge the instructions into a more efficient form */ - optimize_compiled_function (fun); - - /* optimize_compiled_function() guaranteed that f->specpdl_depth is - the required space on the specbinding stack for binding the args - and local variables of fun. So just reserve it once. */ - SPECPDL_RESERVE (f->specpdl_depth); - - /* Fmake_byte_code() guaranteed that f->arglist is a valid list - containing only non-constant symbols. */ - LIST_LOOP_3 (symbol, f->arglist, tail) - { - if (EQ (symbol, Qand_rest)) - { - tail = XCDR (tail); - symbol = XCAR (tail); - SPECBIND_FAST_UNSAFE (symbol, Flist (nargs - i, &args[i])); - goto run_code; - } - else if (EQ (symbol, Qand_optional)) - optional = 1; - else if (i == nargs && !optional) - goto wrong_number_of_arguments; - else - SPECBIND_FAST_UNSAFE (symbol, i < nargs ? args[i++] : Qnil); - } - - if (i < nargs) - goto wrong_number_of_arguments; - - run_code: - - { - Lisp_Object value = - execute_optimized_program ((Opbyte *) XOPAQUE_DATA (f->instructions), - f->stack_depth, - XVECTOR_DATA (f->constants)); - - /* The attempt to optimize this by only unbinding variables failed - because using buffer-local variables as function parameters - leads to specpdl_ptr->func != 0 */ - /* UNBIND_TO_GCPRO_VARIABLES_ONLY (speccount, value); */ - UNBIND_TO_GCPRO (speccount, value); - return value; - } - - wrong_number_of_arguments: - return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); -} - - -/* Read next uint8 from the instruction stream. */ -#define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++) - -/* Read next uint16 from the instruction stream. */ -#define READ_UINT_2 \ - (program_ptr += 2, \ - (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \ - ((unsigned int) (unsigned char) program_ptr[-2]))) - -/* Read next int8 from the instruction stream. */ -#define READ_INT_1 ((int) (signed char) *program_ptr++) - -/* Read next int16 from the instruction stream. */ -#define READ_INT_2 \ - (program_ptr += 2, \ - (((int) ( signed char) program_ptr[-1]) * 256 + \ - ((int) (unsigned char) program_ptr[-2]))) - -/* Read next int8 from instruction stream; don't advance program_pointer */ -#define PEEK_INT_1 ((int) (signed char) program_ptr[0]) - -/* Read next int16 from instruction stream; don't advance program_pointer */ -#define PEEK_INT_2 \ - ((((int) ( signed char) program_ptr[1]) * 256) | \ - ((int) (unsigned char) program_ptr[0])) - -/* Do relative jumps from the current location. - We only do a QUIT if we jump backwards, for efficiency. - No infloops without backward jumps! */ -#define JUMP_RELATIVE(jump) do { \ - int JR_jump = (jump); \ - if (JR_jump < 0) QUIT; \ - program_ptr += JR_jump; \ -} while (0) - -#define JUMP JUMP_RELATIVE (PEEK_INT_2) -#define JUMPR JUMP_RELATIVE (PEEK_INT_1) - -#define JUMP_NEXT ((void) (program_ptr += 2)) -#define JUMPR_NEXT ((void) (program_ptr += 1)) - -/* Push x onto the execution stack. */ -#define PUSH(x) (*++stack_ptr = (x)) - -/* Pop a value off the execution stack. */ -#define POP (*stack_ptr--) - -/* Discard n values from the execution stack. */ -#define DISCARD(n) (stack_ptr -= (n)) - -/* Get the value which is at the top of the execution stack, - but don't pop it. */ -#define TOP (*stack_ptr) - -/* The actual interpreter for byte code. - This function has been seriously optimized for performance. - Don't change the constructs unless you are willing to do - real benchmarking and profiling work -- martin */ - - -static Lisp_Object -execute_optimized_program (CONST Opbyte *program, - int stack_depth, - Lisp_Object *constants_data) -{ - /* This function can GC */ - REGISTER CONST Opbyte *program_ptr = (Opbyte *) program; - REGISTER Lisp_Object *stack_ptr - = alloca_array (Lisp_Object, stack_depth + 1); - int speccount = specpdl_depth (); - struct gcpro gcpro1; - -#ifdef BYTE_CODE_METER - Opcode this_opcode = 0; - Opcode prev_opcode; -#endif - -#ifdef ERROR_CHECK_BYTE_CODE - Lisp_Object *stack_beg = stack_ptr; - Lisp_Object *stack_end = stack_beg + stack_depth; -#endif - - /* Initialize all the objects on the stack to Qnil, - so we can GCPRO the whole stack. - The first element of the stack is actually a dummy. */ - { - int i; - Lisp_Object *p; - for (i = stack_depth, p = stack_ptr; i--;) - *++p = Qnil; - } - - GCPRO1 (stack_ptr[1]); - gcpro1.nvars = stack_depth; - - while (1) - { - REGISTER Opcode opcode = (Opcode) READ_UINT_1; -#ifdef ERROR_CHECK_BYTE_CODE - if (stack_ptr > stack_end) - invalid_byte_code_error ("byte code stack overflow"); - if (stack_ptr < stack_beg) - invalid_byte_code_error ("byte code stack underflow"); -#endif - -#ifdef BYTE_CODE_METER - prev_opcode = this_opcode; - this_opcode = opcode; - METER_CODE (prev_opcode, this_opcode); -#endif - - switch (opcode) - { - REGISTER int n; - - default: - if (opcode >= Bconstant) - PUSH (constants_data[opcode - Bconstant]); - else - stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode); - break; - - case Bvarref: - case Bvarref+1: - case Bvarref+2: - case Bvarref+3: - case Bvarref+4: - case Bvarref+5: n = opcode - Bvarref; goto do_varref; - case Bvarref+7: n = READ_UINT_2; goto do_varref; - case Bvarref+6: n = READ_UINT_1; /* most common */ - do_varref: - { - Lisp_Object symbol = constants_data[n]; - Lisp_Object value = XSYMBOL (symbol)->value; - if (SYMBOL_VALUE_MAGIC_P (value)) - value = Fsymbol_value (symbol); - PUSH (value); - break; - } - - case Bvarset: - case Bvarset+1: - case Bvarset+2: - case Bvarset+3: - case Bvarset+4: - case Bvarset+5: n = opcode - Bvarset; goto do_varset; - case Bvarset+7: n = READ_UINT_2; goto do_varset; - case Bvarset+6: n = READ_UINT_1; /* most common */ - do_varset: - { - Lisp_Object symbol = constants_data[n]; - struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); - Lisp_Object old_value = symbol_ptr->value; - Lisp_Object new_value = POP; - if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value)) - symbol_ptr->value = new_value; - else - Fset (symbol, new_value); - break; - } - - case Bvarbind: - case Bvarbind+1: - case Bvarbind+2: - case Bvarbind+3: - case Bvarbind+4: - case Bvarbind+5: n = opcode - Bvarbind; goto do_varbind; - case Bvarbind+7: n = READ_UINT_2; goto do_varbind; - case Bvarbind+6: n = READ_UINT_1; /* most common */ - do_varbind: - { - Lisp_Object symbol = constants_data[n]; - struct Lisp_Symbol *symbol_ptr = XSYMBOL (symbol); - Lisp_Object old_value = symbol_ptr->value; - Lisp_Object new_value = POP; - if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value)) - { - specpdl_ptr->symbol = symbol; - specpdl_ptr->old_value = old_value; - specpdl_ptr->func = 0; - specpdl_ptr++; - specpdl_depth_counter++; - - symbol_ptr->value = new_value; - } - else - specbind_magic (symbol, new_value); - break; - } - - case Bcall: - case Bcall+1: - case Bcall+2: - case Bcall+3: - case Bcall+4: - case Bcall+5: - case Bcall+6: - case Bcall+7: - n = (opcode < Bcall+6 ? opcode - Bcall : - opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2); - DISCARD (n); -#ifdef BYTE_CODE_METER - if (byte_metering_on && SYMBOLP (TOP)) - { - Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil); - if (INTP (val)) - Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1)); - } -#endif - TOP = Ffuncall (n + 1, &TOP); - break; - - case Bunbind: - case Bunbind+1: - case Bunbind+2: - case Bunbind+3: - case Bunbind+4: - case Bunbind+5: - case Bunbind+6: - case Bunbind+7: - UNBIND_TO (specpdl_depth() - - (opcode < Bunbind+6 ? opcode-Bunbind : - opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2)); - break; - - case Bgoto: - JUMP; - break; - - case Bgotoifnil: - if (NILP (POP)) - JUMP; - else - JUMP_NEXT; - break; - - case Bgotoifnonnil: - if (!NILP (POP)) - JUMP; - else - JUMP_NEXT; - break; - - case Bgotoifnilelsepop: - if (NILP (TOP)) - JUMP; - else - { - DISCARD (1); - JUMP_NEXT; - } - break; - - case Bgotoifnonnilelsepop: - if (!NILP (TOP)) - JUMP; - else - { - DISCARD (1); - JUMP_NEXT; - } - break; - - - case BRgoto: - JUMPR; - break; - - case BRgotoifnil: - if (NILP (POP)) - JUMPR; - else - JUMPR_NEXT; - break; - - case BRgotoifnonnil: - if (!NILP (POP)) - JUMPR; - else - JUMPR_NEXT; - break; - - case BRgotoifnilelsepop: - if (NILP (TOP)) - JUMPR; - else - { - DISCARD (1); - JUMPR_NEXT; - } - break; - - case BRgotoifnonnilelsepop: - if (!NILP (TOP)) - JUMPR; - else - { - DISCARD (1); - JUMPR_NEXT; - } - break; - - case Breturn: - UNGCPRO; -#ifdef ERROR_CHECK_BYTE_CODE - /* Binds and unbinds are supposed to be compiled balanced. */ - if (specpdl_depth() != speccount) - invalid_byte_code_error ("unbalanced specbinding stack"); -#endif - return TOP; - - case Bdiscard: - DISCARD (1); - break; - - case Bdup: - { - Lisp_Object arg = TOP; - PUSH (arg); - break; - } - - case Bconstant2: - PUSH (constants_data[READ_UINT_2]); - break; - - case Bcar: - TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP); - break; - - case Bcdr: - TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP); - break; - - - case Bunbind_all: - /* To unbind back to the beginning of this frame. Not used yet, - but will be needed for tail-recursion elimination. */ - unbind_to (speccount, Qnil); - break; - - case Bnth: - { - Lisp_Object arg = POP; - TOP = Fcar (Fnthcdr (TOP, arg)); - break; - } - - case Bsymbolp: - TOP = SYMBOLP (TOP) ? Qt : Qnil; - break; - - case Bconsp: - TOP = CONSP (TOP) ? Qt : Qnil; - break; - - case Bstringp: - TOP = STRINGP (TOP) ? Qt : Qnil; - break; - - case Blistp: - TOP = LISTP (TOP) ? Qt : Qnil; - break; - - case Bnumberp: - TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil; - break; - - case Bintegerp: - TOP = INTP (TOP) ? Qt : Qnil; - break; - - case Beq: - { - Lisp_Object arg = POP; - TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil; - break; - } - - case Bnot: - TOP = NILP (TOP) ? Qt : Qnil; - break; - - case Bcons: - { - Lisp_Object arg = POP; - TOP = Fcons (TOP, arg); - break; - } - - case Blist1: - TOP = Fcons (TOP, Qnil); - break; - - - case BlistN: - n = READ_UINT_1; - goto do_list; - - case Blist2: - case Blist3: - case Blist4: - /* common case */ - n = opcode - (Blist1 - 1); - do_list: - { - Lisp_Object list = Qnil; - list_loop: - list = Fcons (TOP, list); - if (--n) - { - DISCARD (1); - goto list_loop; - } - TOP = list; - break; - } - - - case Bconcat2: - case Bconcat3: - case Bconcat4: - n = opcode - (Bconcat2 - 2); - goto do_concat; - - case BconcatN: - /* common case */ - n = READ_UINT_1; - do_concat: - DISCARD (n - 1); - TOP = Fconcat (n, &TOP); - break; - - - case Blength: - TOP = Flength (TOP); - break; - - case Baset: - { - Lisp_Object arg2 = POP; - Lisp_Object arg1 = POP; - TOP = Faset (TOP, arg1, arg2); - break; - } - - case Bsymbol_value: - TOP = Fsymbol_value (TOP); - break; - - case Bsymbol_function: - TOP = Fsymbol_function (TOP); - break; - - case Bget: - { - Lisp_Object arg = POP; - TOP = Fget (TOP, arg, Qnil); - break; - } - - case Bsub1: - TOP = INTP (TOP) ? make_int (XINT (TOP) - 1) : Fsub1 (TOP); - break; - - case Badd1: - TOP = INTP (TOP) ? make_int (XINT (TOP) + 1) : Fadd1 (TOP); - break; - - - case Beqlsign: - { - Lisp_Object arg = POP; - TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil; - break; - } - - case Bgtr: - { - Lisp_Object arg = POP; - TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil; - break; - } - - case Blss: - { - Lisp_Object arg = POP; - TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil; - break; - } - - case Bleq: - { - Lisp_Object arg = POP; - TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil; - break; - } - - case Bgeq: - { - Lisp_Object arg = POP; - TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil; - break; - } - - - case Bnegate: - TOP = bytecode_negate (TOP); - break; - - case Bnconc: - DISCARD (1); - TOP = bytecode_nconc2 (&TOP); - break; - - case Bplus: - { - Lisp_Object arg2 = POP; - Lisp_Object arg1 = TOP; - TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) + XINT (arg2)) : - bytecode_arithop (arg1, arg2, opcode); - break; - } - - case Bdiff: - { - Lisp_Object arg2 = POP; - Lisp_Object arg1 = TOP; - TOP = INTP (arg1) && INTP (arg2) ? - make_int (XINT (arg1) - XINT (arg2)) : - bytecode_arithop (arg1, arg2, opcode); - break; - } - - case Bmult: - case Bquo: - case Bmax: - case Bmin: - { - Lisp_Object arg = POP; - TOP = bytecode_arithop (TOP, arg, opcode); - break; - } - - case Bpoint: - PUSH (make_int (BUF_PT (current_buffer))); - break; - - case Binsert: - TOP = Finsert (1, &TOP); - break; - - case BinsertN: - n = READ_UINT_1; - DISCARD (n - 1); - TOP = Finsert (n, &TOP); - break; - - case Baref: - { - Lisp_Object arg = POP; - TOP = Faref (TOP, arg); - break; - } - - case Bmemq: - { - Lisp_Object arg = POP; - TOP = Fmemq (TOP, arg); - break; - } - - - case Bset: - { - Lisp_Object arg = POP; - TOP = Fset (TOP, arg); - break; - } - - case Bequal: - { - Lisp_Object arg = POP; - TOP = Fequal (TOP, arg); - break; - } - - case Bnthcdr: - { - Lisp_Object arg = POP; - TOP = Fnthcdr (TOP, arg); - break; - } - - case Belt: - { - Lisp_Object arg = POP; - TOP = Felt (TOP, arg); - break; - } - - case Bmember: - { - Lisp_Object arg = POP; - TOP = Fmember (TOP, arg); - break; - } - - case Bgoto_char: - TOP = Fgoto_char (TOP, Qnil); - break; - - case Bcurrent_buffer: - { - Lisp_Object buffer; - XSETBUFFER (buffer, current_buffer); - PUSH (buffer); - break; - } - - case Bset_buffer: - TOP = Fset_buffer (TOP); - break; - - case Bpoint_max: - PUSH (make_int (BUF_ZV (current_buffer))); - break; - - case Bpoint_min: - PUSH (make_int (BUF_BEGV (current_buffer))); - break; - - case Bskip_chars_forward: - { - Lisp_Object arg = POP; - TOP = Fskip_chars_forward (TOP, arg, Qnil); - break; - } - - case Bassq: - { - Lisp_Object arg = POP; - TOP = Fassq (TOP, arg); - break; - } - - case Bsetcar: - { - Lisp_Object arg = POP; - TOP = Fsetcar (TOP, arg); - break; - } - - case Bsetcdr: - { - Lisp_Object arg = POP; - TOP = Fsetcdr (TOP, arg); - break; - } - - case Bnreverse: - TOP = bytecode_nreverse (TOP); - break; - - case Bcar_safe: - TOP = CONSP (TOP) ? XCAR (TOP) : Qnil; - break; - - case Bcdr_safe: - TOP = CONSP (TOP) ? XCDR (TOP) : Qnil; - break; - - } - } -} - -/* It makes a worthwhile performance difference (5%) to shunt - lesser-used opcodes off to a subroutine, to keep the switch in - execute_optimized_program small. If you REALLY care about - performance, you want to keep your heavily executed code away from - rarely executed code, to minimize cache misses. - - Don't make this function static, since then the compiler might inline it. */ -Lisp_Object * -execute_rare_opcode (Lisp_Object *stack_ptr, - CONST Opbyte *program_ptr, - Opcode opcode) -{ - switch (opcode) - { - - case Bsave_excursion: - record_unwind_protect (save_excursion_restore, - save_excursion_save ()); - break; - - case Bsave_window_excursion: - { - int count = specpdl_depth (); - record_unwind_protect (save_window_excursion_unwind, - Fcurrent_window_configuration (Qnil)); - TOP = Fprogn (TOP); - unbind_to (count, Qnil); - break; - } - - case Bsave_restriction: - record_unwind_protect (save_restriction_restore, - save_restriction_save ()); - break; - - case Bcatch: - { - Lisp_Object arg = POP; - TOP = internal_catch (TOP, Feval, arg, 0); - break; - } - - case Bskip_chars_backward: - { - Lisp_Object arg = POP; - TOP = Fskip_chars_backward (TOP, arg, Qnil); - break; - } - - case Bunwind_protect: - record_unwind_protect (Fprogn, POP); - break; - - case Bcondition_case: - { - Lisp_Object arg2 = POP; /* handlers */ - Lisp_Object arg1 = POP; /* bodyform */ - TOP = condition_case_3 (arg1, TOP, arg2); - break; - } - - case Bset_marker: - { - Lisp_Object arg2 = POP; - Lisp_Object arg1 = POP; - TOP = Fset_marker (TOP, arg1, arg2); - break; - } - - case Brem: - { - Lisp_Object arg = POP; - TOP = Frem (TOP, arg); - break; - } - - case Bmatch_beginning: - TOP = Fmatch_beginning (TOP); - break; - - case Bmatch_end: - TOP = Fmatch_end (TOP); - break; - - case Bupcase: - TOP = Fupcase (TOP, Qnil); - break; - - case Bdowncase: - TOP = Fdowncase (TOP, Qnil); - break; - - case Bfset: - { - Lisp_Object arg = POP; - TOP = Ffset (TOP, arg); - break; - } - - case Bstring_equal: - { - Lisp_Object arg = POP; - TOP = Fstring_equal (TOP, arg); - break; - } - - case Bstring_lessp: - { - Lisp_Object arg = POP; - TOP = Fstring_lessp (TOP, arg); - break; - } - - case Bsubstring: - { - Lisp_Object arg2 = POP; - Lisp_Object arg1 = POP; - TOP = Fsubstring (TOP, arg1, arg2); - break; - } - - case Bcurrent_column: - PUSH (make_int (current_column (current_buffer))); - break; - - case Bchar_after: - TOP = Fchar_after (TOP, Qnil); - break; - - case Bindent_to: - TOP = Findent_to (TOP, Qnil, Qnil); - break; - - case Bwiden: - PUSH (Fwiden (Qnil)); - break; - - case Bfollowing_char: - PUSH (Ffollowing_char (Qnil)); - break; - - case Bpreceding_char: - PUSH (Fpreceding_char (Qnil)); - break; - - case Beolp: - PUSH (Feolp (Qnil)); - break; - - case Beobp: - PUSH (Feobp (Qnil)); - break; - - case Bbolp: - PUSH (Fbolp (Qnil)); - break; - - case Bbobp: - PUSH (Fbobp (Qnil)); - break; - - case Bsave_current_buffer: - record_unwind_protect (save_current_buffer_restore, - Fcurrent_buffer ()); - break; - - case Binteractive_p: - PUSH (Finteractive_p ()); - break; - - case Bforward_char: - TOP = Fforward_char (TOP, Qnil); - break; - - case Bforward_word: - TOP = Fforward_word (TOP, Qnil); - break; - - case Bforward_line: - TOP = Fforward_line (TOP, Qnil); - break; - - case Bchar_syntax: - TOP = Fchar_syntax (TOP, Qnil); - break; - - case Bbuffer_substring: - { - Lisp_Object arg = POP; - TOP = Fbuffer_substring (TOP, arg, Qnil); - break; - } - - case Bdelete_region: - { - Lisp_Object arg = POP; - TOP = Fdelete_region (TOP, arg, Qnil); - break; - } - - case Bnarrow_to_region: - { - Lisp_Object arg = POP; - TOP = Fnarrow_to_region (TOP, arg, Qnil); - break; - } - - case Bend_of_line: - TOP = Fend_of_line (TOP, Qnil); - break; - - case Btemp_output_buffer_setup: - temp_output_buffer_setup (TOP); - TOP = Vstandard_output; - break; - - case Btemp_output_buffer_show: - { - Lisp_Object arg = POP; - temp_output_buffer_show (TOP, Qnil); - TOP = arg; - /* GAG ME!! */ - /* pop binding of standard-output */ - unbind_to (specpdl_depth() - 1, Qnil); - break; - } - - case Bold_eq: - { - Lisp_Object arg = POP; - TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil; - break; - } - - case Bold_memq: - { - Lisp_Object arg = POP; - TOP = Fold_memq (TOP, arg); - break; - } - - case Bold_equal: - { - Lisp_Object arg = POP; - TOP = Fold_equal (TOP, arg); - break; - } - - case Bold_member: - { - Lisp_Object arg = POP; - TOP = Fold_member (TOP, arg); - break; - } - - case Bold_assq: - { - Lisp_Object arg = POP; - TOP = Fold_assq (TOP, arg); - break; - } - - default: - abort(); - break; - } - return stack_ptr; -} - - -static void -invalid_byte_code_error (char *error_message, ...) -{ - Lisp_Object obj; - va_list args; - char *buf = alloca_array (char, strlen (error_message) + 128); - - sprintf (buf, "%s", error_message); - va_start (args, error_message); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (buf), Qnil, -1, - args); - va_end (args); - - signal_error (Qinvalid_byte_code, list1 (obj)); -} - -/* Check for valid opcodes. Change this when adding new opcodes. */ -static void -check_opcode (Opcode opcode) -{ - if ((opcode < Bvarref) || - (opcode == 0251) || - (opcode > Bassq && opcode < Bconstant)) - invalid_byte_code_error - ("invalid opcode %d in instruction stream", opcode); -} - -/* Check that IDX is a valid offset into the `constants' vector */ -static void -check_constants_index (int idx, Lisp_Object constants) -{ - if (idx < 0 || idx >= XVECTOR_LENGTH (constants)) - invalid_byte_code_error - ("reference %d to constants array out of range 0, %d", - idx, XVECTOR_LENGTH (constants) - 1); -} - -/* Get next character from Lisp instructions string. */ -#define READ_INSTRUCTION_CHAR(lvalue) do { \ - (lvalue) = charptr_emchar (ptr); \ - INC_CHARPTR (ptr); \ - *icounts_ptr++ = program_ptr - program; \ - if (lvalue > UCHAR_MAX) \ - invalid_byte_code_error \ - ("Invalid character %c in byte code string"); \ -} while (0) - -/* Get opcode from Lisp instructions string. */ -#define READ_OPCODE do { \ - unsigned int c; \ - READ_INSTRUCTION_CHAR (c); \ - opcode = (Opcode) c; \ -} while (0) - -/* Get next operand, a uint8, from Lisp instructions string. */ -#define READ_OPERAND_1 do { \ - READ_INSTRUCTION_CHAR (arg); \ - argsize = 1; \ -} while (0) - -/* Get next operand, a uint16, from Lisp instructions string. */ -#define READ_OPERAND_2 do { \ - unsigned int arg1, arg2; \ - READ_INSTRUCTION_CHAR (arg1); \ - READ_INSTRUCTION_CHAR (arg2); \ - arg = arg1 + (arg2 << 8); \ - argsize = 2; \ -} while (0) - -/* Write 1 byte to PTR, incrementing PTR */ -#define WRITE_INT8(value, ptr) do { \ - *((ptr)++) = (value); \ -} while (0) - -/* Write 2 bytes to PTR, incrementing PTR */ -#define WRITE_INT16(value, ptr) do { \ - WRITE_INT8 (((unsigned) (value)) & 0x00ff, (ptr)); \ - WRITE_INT8 (((unsigned) (value)) >> 8 , (ptr)); \ -} while (0) - -/* We've changed our minds about the opcode we've already written. */ -#define REWRITE_OPCODE(new_opcode) ((void) (program_ptr[-1] = new_opcode)) - -/* Encode an op arg within the opcode, or as a 1 or 2-byte operand. */ -#define WRITE_NARGS(base_opcode) do { \ - if (arg <= 5) \ - { \ - REWRITE_OPCODE (base_opcode + arg); \ - } \ - else if (arg <= UCHAR_MAX) \ - { \ - REWRITE_OPCODE (base_opcode + 6); \ - WRITE_INT8 (arg, program_ptr); \ - } \ - else \ - { \ - REWRITE_OPCODE (base_opcode + 7); \ - WRITE_INT16 (arg, program_ptr); \ - } \ -} while (0) - -/* Encode a constants reference within the opcode, or as a 2-byte operand. */ -#define WRITE_CONSTANT do { \ - check_constants_index(arg, constants); \ - if (arg <= UCHAR_MAX - Bconstant) \ - { \ - REWRITE_OPCODE (Bconstant + arg); \ - } \ - else \ - { \ - REWRITE_OPCODE (Bconstant2); \ - WRITE_INT16 (arg, program_ptr); \ - } \ -} while (0) - -#define WRITE_OPCODE WRITE_INT8 (opcode, program_ptr) - -/* Compile byte code instructions into free space provided by caller, with - size >= (2 * string_char_length (instructions) + 1) * sizeof (Opbyte). - Returns length of compiled code. */ -static void -optimize_byte_code (/* in */ - Lisp_Object instructions, - Lisp_Object constants, - /* out */ - Opbyte * CONST program, - int * CONST program_length, - int * CONST varbind_count) -{ - size_t instructions_length = XSTRING_LENGTH (instructions); - size_t comfy_size = 2 * instructions_length; - - int * CONST icounts = alloca_array (int, comfy_size); - int * icounts_ptr = icounts; - - /* We maintain a table of jumps in the source code. */ - struct jump - { - int from; - int to; - }; - struct jump * CONST jumps = alloca_array (struct jump, comfy_size); - struct jump *jumps_ptr = jumps; - - Opbyte *program_ptr = program; - - CONST Bufbyte *ptr = XSTRING_DATA (instructions); - CONST Bufbyte * CONST end = ptr + instructions_length; - - *varbind_count = 0; - - while (ptr < end) - { - Opcode opcode; - int arg; - int argsize = 0; - READ_OPCODE; - WRITE_OPCODE; - - switch (opcode) - { - Lisp_Object val; - - case Bvarref+7: READ_OPERAND_2; goto do_varref; - case Bvarref+6: READ_OPERAND_1; goto do_varref; - case Bvarref: case Bvarref+1: case Bvarref+2: - case Bvarref+3: case Bvarref+4: case Bvarref+5: - arg = opcode - Bvarref; - do_varref: - check_constants_index (arg, constants); - val = XVECTOR_DATA (constants) [arg]; - if (!SYMBOLP (val)) - invalid_byte_code_error ("variable reference to non-symbol %S", val); - if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val))) - invalid_byte_code_error ("variable reference to constant symbol %s", - string_data (XSYMBOL (val)->name)); - WRITE_NARGS (Bvarref); - break; - - case Bvarset+7: READ_OPERAND_2; goto do_varset; - case Bvarset+6: READ_OPERAND_1; goto do_varset; - case Bvarset: case Bvarset+1: case Bvarset+2: - case Bvarset+3: case Bvarset+4: case Bvarset+5: - arg = opcode - Bvarset; - do_varset: - check_constants_index (arg, constants); - val = XVECTOR_DATA (constants) [arg]; - if (!SYMBOLP (val)) - invalid_byte_code_error ("attempt to set non-symbol %S", val); - if (EQ (val, Qnil) || EQ (val, Qt)) - invalid_byte_code_error ("attempt to set constant symbol %s", - string_data (XSYMBOL (val)->name)); - /* Ignore assignments to keywords by converting to Bdiscard. - For backward compatibility only - we'd like to make this an error. */ - if (SYMBOL_IS_KEYWORD (val)) - REWRITE_OPCODE (Bdiscard); - else - WRITE_NARGS (Bvarset); - break; - - case Bvarbind+7: READ_OPERAND_2; goto do_varbind; - case Bvarbind+6: READ_OPERAND_1; goto do_varbind; - case Bvarbind: case Bvarbind+1: case Bvarbind+2: - case Bvarbind+3: case Bvarbind+4: case Bvarbind+5: - arg = opcode - Bvarbind; - do_varbind: - (*varbind_count)++; - check_constants_index (arg, constants); - val = XVECTOR_DATA (constants) [arg]; - if (!SYMBOLP (val)) - invalid_byte_code_error ("attempt to let-bind non-symbol %S", val); - if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val))) - invalid_byte_code_error ("attempt to let-bind constant symbol %s", - string_data (XSYMBOL (val)->name)); - WRITE_NARGS (Bvarbind); - break; - - case Bcall+7: READ_OPERAND_2; goto do_call; - case Bcall+6: READ_OPERAND_1; goto do_call; - case Bcall: case Bcall+1: case Bcall+2: - case Bcall+3: case Bcall+4: case Bcall+5: - arg = opcode - Bcall; - do_call: - WRITE_NARGS (Bcall); - break; - - case Bunbind+7: READ_OPERAND_2; goto do_unbind; - case Bunbind+6: READ_OPERAND_1; goto do_unbind; - case Bunbind: case Bunbind+1: case Bunbind+2: - case Bunbind+3: case Bunbind+4: case Bunbind+5: - arg = opcode - Bunbind; - do_unbind: - WRITE_NARGS (Bunbind); - break; - - case Bgoto: - case Bgotoifnil: - case Bgotoifnonnil: - case Bgotoifnilelsepop: - case Bgotoifnonnilelsepop: - READ_OPERAND_2; - /* Make program_ptr-relative */ - arg += icounts - (icounts_ptr - argsize); - goto do_jump; - - case BRgoto: - case BRgotoifnil: - case BRgotoifnonnil: - case BRgotoifnilelsepop: - case BRgotoifnonnilelsepop: - READ_OPERAND_1; - /* Make program_ptr-relative */ - arg -= 127; - do_jump: - /* Record program-relative goto addresses in `jumps' table */ - jumps_ptr->from = icounts_ptr - icounts - argsize; - jumps_ptr->to = jumps_ptr->from + arg; - jumps_ptr++; - if (arg >= -1 && arg <= argsize) - invalid_byte_code_error - ("goto instruction is its own target"); - if (arg <= SCHAR_MIN || - arg > SCHAR_MAX) - { - if (argsize == 1) - REWRITE_OPCODE (opcode + Bgoto - BRgoto); - WRITE_INT16 (arg, program_ptr); - } - else - { - if (argsize == 2) - REWRITE_OPCODE (opcode + BRgoto - Bgoto); - WRITE_INT8 (arg, program_ptr); - } - break; - - case Bconstant2: - READ_OPERAND_2; - WRITE_CONSTANT; - break; - - case BlistN: - case BconcatN: - case BinsertN: - READ_OPERAND_1; - WRITE_INT8 (arg, program_ptr); - break; - - default: - if (opcode < Bconstant) - check_opcode (opcode); - else - { - arg = opcode - Bconstant; - WRITE_CONSTANT; - } - break; - } - } - - /* Fix up jumps table to refer to NEW offsets. */ - { - struct jump *j; - for (j = jumps; j < jumps_ptr; j++) - { -#ifdef ERROR_CHECK_BYTE_CODE - assert (j->from < icounts_ptr - icounts); - assert (j->to < icounts_ptr - icounts); -#endif - j->from = icounts[j->from]; - j->to = icounts[j->to]; -#ifdef ERROR_CHECK_BYTE_CODE - assert (j->from < program_ptr - program); - assert (j->to < program_ptr - program); - check_opcode ((Opcode) (program[j->from-1])); -#endif - check_opcode ((Opcode) (program[j->to])); - } - } - - /* Fixup jumps in byte-code until no more fixups needed */ - { - int more_fixups_needed = 1; - - while (more_fixups_needed) - { - struct jump *j; - more_fixups_needed = 0; - for (j = jumps; j < jumps_ptr; j++) - { - int from = j->from; - int to = j->to; - int jump = to - from; - Opbyte *p = program + from; - Opcode opcode = (Opcode) p[-1]; - if (!more_fixups_needed) - check_opcode ((Opcode) p[jump]); - assert (to >= 0 && program + to < program_ptr); - switch (opcode) - { - case Bgoto: - case Bgotoifnil: - case Bgotoifnonnil: - case Bgotoifnilelsepop: - case Bgotoifnonnilelsepop: - WRITE_INT16 (jump, p); - break; - - case BRgoto: - case BRgotoifnil: - case BRgotoifnonnil: - case BRgotoifnilelsepop: - case BRgotoifnonnilelsepop: - if (jump > SCHAR_MIN && - jump <= SCHAR_MAX) - { - WRITE_INT8 (jump, p); - } - else /* barf */ - { - struct jump *jj; - for (jj = jumps; jj < jumps_ptr; jj++) - { - assert (jj->from < program_ptr - program); - assert (jj->to < program_ptr - program); - if (jj->from > from) jj->from++; - if (jj->to > from) jj->to++; - } - p[-1] += Bgoto - BRgoto; - more_fixups_needed = 1; - memmove (p+1, p, program_ptr++ - p); - WRITE_INT16 (jump, p); - } - break; - - default: - abort(); - break; - } - } - } - } - - /* *program_ptr++ = 0; */ - *program_length = program_ptr - program; -} - -/* Optimize the byte code and store the optimized program, only - understood by bytecode.c, in an opaque object in the - instructions slot of the Compiled_Function object. */ -void -optimize_compiled_function (Lisp_Object compiled_function) -{ - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function); - int program_length; - int varbind_count; - Opbyte *program; - - /* If we have not actually read the bytecode string - and constants vector yet, fetch them from the file. */ - if (CONSP (f->instructions)) - Ffetch_bytecode (compiled_function); - - if (STRINGP (f->instructions)) - { - /* XSTRING_LENGTH() is more efficient than XSTRING_CHAR_LENGTH(), - which would be slightly more `proper' */ - program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions)); - optimize_byte_code (f->instructions, f->constants, - program, &program_length, &varbind_count); - f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count; - f->instructions = - Fpurecopy (make_opaque (program_length * sizeof (Opbyte), - (CONST void *) program)); - } - - assert (OPAQUEP (f->instructions)); -} - -/************************************************************************/ -/* The compiled-function object type */ -/************************************************************************/ -static void -print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag) -{ - /* This function can GC */ - Lisp_Compiled_Function *f = - XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */ - int docp = f->flags.documentationp; - int intp = f->flags.interactivep; - struct gcpro gcpro1, gcpro2; - char buf[100]; - GCPRO2 (obj, printcharfun); - - write_c_string (print_readably ? "#[" : "#", printcharfun); -} - - -static Lisp_Object -mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj); - - markobj (f->instructions); - markobj (f->arglist); - markobj (f->doc_and_interactive); -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - markobj (f->annotated); -#endif - /* tail-recurse on constants */ - return f->constants; -} - -static int -compiled_function_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - Lisp_Compiled_Function *f1 = XCOMPILED_FUNCTION (obj1); - Lisp_Compiled_Function *f2 = XCOMPILED_FUNCTION (obj2); - return - (f1->flags.documentationp == f2->flags.documentationp && - f1->flags.interactivep == f2->flags.interactivep && - f1->flags.domainp == f2->flags.domainp && /* I18N3 */ - internal_equal (compiled_function_instructions (f1), - compiled_function_instructions (f2), depth + 1) && - internal_equal (f1->constants, f2->constants, depth + 1) && - internal_equal (f1->arglist, f2->arglist, depth + 1) && - internal_equal (f1->doc_and_interactive, - f2->doc_and_interactive, depth + 1)); -} - -static unsigned long -compiled_function_hash (Lisp_Object obj, int depth) -{ - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj); - return HASH3 ((f->flags.documentationp << 2) + - (f->flags.interactivep << 1) + - f->flags.domainp, - internal_hash (f->instructions, depth + 1), - internal_hash (f->constants, depth + 1)); -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function, - mark_compiled_function, - print_compiled_function, 0, - compiled_function_equal, - compiled_function_hash, - Lisp_Compiled_Function); - -DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* -Return t if OBJECT is a byte-compiled function object. -*/ - (object)) -{ - return COMPILED_FUNCTIONP (object) ? Qt : Qnil; -} - -/************************************************************************/ -/* compiled-function object accessor functions */ -/************************************************************************/ - -Lisp_Object -compiled_function_arglist (Lisp_Compiled_Function *f) -{ - return f->arglist; -} - -Lisp_Object -compiled_function_instructions (Lisp_Compiled_Function *f) -{ - if (! OPAQUEP (f->instructions)) - return f->instructions; - - { - /* Invert action performed by optimize_byte_code() */ - Lisp_Opaque *opaque = XOPAQUE (f->instructions); - - Bufbyte * CONST buffer = - alloca_array (Bufbyte, OPAQUE_SIZE (opaque) * MAX_EMCHAR_LEN); - Bufbyte *bp = buffer; - - CONST Opbyte * CONST program = (CONST Opbyte *) OPAQUE_DATA (opaque); - CONST Opbyte *program_ptr = program; - CONST Opbyte * CONST program_end = program_ptr + OPAQUE_SIZE (opaque); - - while (program_ptr < program_end) - { - Opcode opcode = (Opcode) READ_UINT_1; - bp += set_charptr_emchar (bp, opcode); - switch (opcode) - { - case Bvarref+7: - case Bvarset+7: - case Bvarbind+7: - case Bcall+7: - case Bunbind+7: - case Bconstant2: - bp += set_charptr_emchar (bp, READ_UINT_1); - bp += set_charptr_emchar (bp, READ_UINT_1); - break; - - case Bvarref+6: - case Bvarset+6: - case Bvarbind+6: - case Bcall+6: - case Bunbind+6: - case BlistN: - case BconcatN: - case BinsertN: - bp += set_charptr_emchar (bp, READ_UINT_1); - break; - - case Bgoto: - case Bgotoifnil: - case Bgotoifnonnil: - case Bgotoifnilelsepop: - case Bgotoifnonnilelsepop: - { - int jump = READ_INT_2; - Opbyte buf2[2]; - Opbyte *buf2p = buf2; - /* Convert back to program-relative address */ - WRITE_INT16 (jump + (program_ptr - 2 - program), buf2p); - bp += set_charptr_emchar (bp, buf2[0]); - bp += set_charptr_emchar (bp, buf2[1]); - break; - } - - case BRgoto: - case BRgotoifnil: - case BRgotoifnonnil: - case BRgotoifnilelsepop: - case BRgotoifnonnilelsepop: - bp += set_charptr_emchar (bp, READ_INT_1 + 127); - break; - - default: - break; - } - } - return make_string (buffer, bp - buffer); - } -} - -Lisp_Object -compiled_function_constants (Lisp_Compiled_Function *f) -{ - return f->constants; -} - -int -compiled_function_stack_depth (Lisp_Compiled_Function *f) -{ - return f->stack_depth; -} - -/* The compiled_function->doc_and_interactive slot uses the minimal - number of conses, based on compiled_function->flags; it may take - any of the following forms: - - doc - interactive - domain - (doc . interactive) - (doc . domain) - (interactive . domain) - (doc . (interactive . domain)) - */ - -/* Caller must check flags.interactivep first */ -Lisp_Object -compiled_function_interactive (Lisp_Compiled_Function *f) -{ - assert (f->flags.interactivep); - if (f->flags.documentationp && f->flags.domainp) - return XCAR (XCDR (f->doc_and_interactive)); - else if (f->flags.documentationp) - return XCDR (f->doc_and_interactive); - else if (f->flags.domainp) - return XCAR (f->doc_and_interactive); - else - return f->doc_and_interactive; -} - -/* Caller need not check flags.documentationp first */ -Lisp_Object -compiled_function_documentation (Lisp_Compiled_Function *f) -{ - if (! f->flags.documentationp) - return Qnil; - else if (f->flags.interactivep && f->flags.domainp) - return XCAR (f->doc_and_interactive); - else if (f->flags.interactivep) - return XCAR (f->doc_and_interactive); - else if (f->flags.domainp) - return XCAR (f->doc_and_interactive); - else - return f->doc_and_interactive; -} - -/* Caller need not check flags.domainp first */ -Lisp_Object -compiled_function_domain (Lisp_Compiled_Function *f) -{ - if (! f->flags.domainp) - return Qnil; - else if (f->flags.documentationp && f->flags.interactivep) - return XCDR (XCDR (f->doc_and_interactive)); - else if (f->flags.documentationp) - return XCDR (f->doc_and_interactive); - else if (f->flags.interactivep) - return XCDR (f->doc_and_interactive); - else - return f->doc_and_interactive; -} - -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - -Lisp_Object -compiled_function_annotation (Lisp_Compiled_Function *f) -{ - return f->annotated; -} - -#endif - -/* used only by Snarf-documentation; there must be doc already. */ -void -set_compiled_function_documentation (Lisp_Compiled_Function *f, - Lisp_Object new_doc) -{ - assert (f->flags.documentationp); - assert (INTP (new_doc) || STRINGP (new_doc)); - - if (f->flags.interactivep && f->flags.domainp) - XCAR (f->doc_and_interactive) = new_doc; - else if (f->flags.interactivep) - XCAR (f->doc_and_interactive) = new_doc; - else if (f->flags.domainp) - XCAR (f->doc_and_interactive) = new_doc; - else - f->doc_and_interactive = new_doc; -} - - -DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /* -Return the argument list of the compiled-function object FUNCTION. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return compiled_function_arglist (XCOMPILED_FUNCTION (function)); -} - -DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /* -Return the byte-opcode string of the compiled-function object FUNCTION. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return compiled_function_instructions (XCOMPILED_FUNCTION (function)); -} - -DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /* -Return the constants vector of the compiled-function object FUNCTION. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return compiled_function_constants (XCOMPILED_FUNCTION (function)); -} - -DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /* -Return the max stack depth of the compiled-function object FUNCTION. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return make_int (compiled_function_stack_depth (XCOMPILED_FUNCTION (function))); -} - -DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /* -Return the doc string of the compiled-function object FUNCTION, if available. -Functions that had their doc strings snarfed into the DOC file will have -an integer returned instead of a string. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return compiled_function_documentation (XCOMPILED_FUNCTION (function)); -} - -DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /* -Return the interactive spec of the compiled-function object FUNCTION, or nil. -If non-nil, the return value will be a list whose first element is -`interactive' and whose second element is the interactive spec. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return XCOMPILED_FUNCTION (function)->flags.interactivep - ? list2 (Qinteractive, - compiled_function_interactive (XCOMPILED_FUNCTION (function))) - : Qnil; -} - -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - -/* Remove the `xx' if you wish to restore this feature */ -xxDEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /* -Return the annotation of the compiled-function object FUNCTION, or nil. -The annotation is a piece of information indicating where this -compiled-function object came from. Generally this will be -a symbol naming a function; or a string naming a file, if the -compiled-function object was not defined in a function; or nil, -if the compiled-function object was not created as a result of -a `load'. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return compiled_function_annotation (XCOMPILED_FUNCTION (function)); -} - -#endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ - -DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /* -Return the domain of the compiled-function object FUNCTION, or nil. -This is only meaningful if I18N3 was enabled when emacs was compiled. -*/ - (function)) -{ - CHECK_COMPILED_FUNCTION (function); - return XCOMPILED_FUNCTION (function)->flags.domainp - ? compiled_function_domain (XCOMPILED_FUNCTION (function)) - : Qnil; -} - - - -DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /* -If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now. -*/ - (function)) -{ - Lisp_Compiled_Function *f; - CHECK_COMPILED_FUNCTION (function); - f = XCOMPILED_FUNCTION (function); - - if (OPAQUEP (f->instructions) || STRINGP (f->instructions)) - return function; - - if (CONSP (f->instructions)) - { - Lisp_Object tem = read_doc_string (f->instructions); - if (!CONSP (tem)) - signal_simple_error ("Invalid lazy-loaded byte code", tem); - /* v18 or v19 bytecode file. Need to Ebolify. */ - if (f->flags.ebolified && VECTORP (XCDR (tem))) - ebolify_bytecode_constants (XCDR (tem)); - /* VERY IMPORTANT to purecopy here!!!!! - See load_force_doc_string_unwind. */ - f->instructions = Fpurecopy (XCAR (tem)); - f->constants = Fpurecopy (XCDR (tem)); - return function; - } - abort (); - return Qnil; /* not reached */ -} - -DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /* -Convert compiled function FUNCTION into an optimized internal form. -*/ - (function)) -{ - Lisp_Compiled_Function *f; - CHECK_COMPILED_FUNCTION (function); - f = XCOMPILED_FUNCTION (function); - - if (OPAQUEP (f->instructions)) /* Already optimized? */ - return Qnil; - - optimize_compiled_function (function); - return Qnil; -} - -DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /* -Function used internally in byte-compiled code. -First argument INSTRUCTIONS is a string of byte code. -Second argument CONSTANTS is a vector of constants. -Third argument STACK-DEPTH is the maximum stack depth used in this function. -If STACK-DEPTH is incorrect, Emacs may crash. -*/ - (instructions, constants, stack_depth)) -{ - /* This function can GC */ - int varbind_count; - int program_length; - Opbyte *program; - - CHECK_STRING (instructions); - CHECK_VECTOR (constants); - CHECK_NATNUM (stack_depth); - - /* Optimize the `instructions' string, just like when executing a - regular compiled function, but don't save it for later since this is - likely to only be executed once. */ - program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (instructions)); - optimize_byte_code (instructions, constants, program, - &program_length, &varbind_count); - SPECPDL_RESERVE (varbind_count); - return execute_optimized_program (program, - XINT (stack_depth), - XVECTOR_DATA (constants)); -} - - -void -syms_of_bytecode (void) -{ - deferror (&Qinvalid_byte_code, "invalid-byte-code", - "Invalid byte code", Qerror); - defsymbol (&Qbyte_code, "byte-code"); - defsymbol (&Qcompiled_functionp, "compiled-function-p"); - - DEFSUBR (Fbyte_code); - DEFSUBR (Ffetch_bytecode); - DEFSUBR (Foptimize_compiled_function); - - DEFSUBR (Fcompiled_function_p); - DEFSUBR (Fcompiled_function_instructions); - DEFSUBR (Fcompiled_function_constants); - DEFSUBR (Fcompiled_function_stack_depth); - DEFSUBR (Fcompiled_function_arglist); - DEFSUBR (Fcompiled_function_interactive); - DEFSUBR (Fcompiled_function_doc_string); - DEFSUBR (Fcompiled_function_domain); -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - DEFSUBR (Fcompiled_function_annotation); -#endif - -#ifdef BYTE_CODE_METER - defsymbol (&Qbyte_code_meter, "byte-code-meter"); -#endif -} - -void -vars_of_bytecode (void) -{ -#ifdef BYTE_CODE_METER - - DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /* -A vector of vectors which holds a histogram of byte code usage. -\(aref (aref byte-code-meter 0) CODE) indicates how many times the byte -opcode CODE has been executed. -\(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0, -indicates how many times the byte opcodes CODE1 and CODE2 have been -executed in succession. -*/ ); - DEFVAR_BOOL ("byte-metering-on", &byte_metering_on /* -If non-nil, keep profiling information on byte code usage. -The variable `byte-code-meter' indicates how often each byte opcode is used. -If a symbol has a property named `byte-code-meter' whose value is an -integer, it is incremented each time that symbol's function is called. -*/ ); - - byte_metering_on = 0; - Vbyte_code_meter = make_vector (256, Qzero); - { - int i = 256; - while (i--) - XVECTOR_DATA (Vbyte_code_meter)[i] = make_vector (256, Qzero); - } -#endif /* BYTE_CODE_METER */ -} diff --git a/src/bytecode.h b/src/bytecode.h deleted file mode 100644 index 3387b93..0000000 --- a/src/bytecode.h +++ /dev/null @@ -1,124 +0,0 @@ -/* Definitions for bytecode interpretation and compiled-function objects. - Copyright (C) 1985, 1986, 1987, 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. */ - -/* Authorship: - - FSF: long ago. - Mly: rewrote for 19.8, properly abstracted. - Jon Reid: some changes for I18N3 (domain, etc), for 19.8. - */ - -#ifndef _XEMACS_BYTECODE_H_ -#define _XEMACS_BYTECODE_H_ - -/* Meanings of slots in a Lisp_Compiled_Function. - Don't use these! For backward compatibility only. */ -#define COMPILED_ARGLIST 0 -#define COMPILED_INSTRUCTIONS 1 -#define COMPILED_CONSTANTS 2 -#define COMPILED_STACK_DEPTH 3 -#define COMPILED_DOC_STRING 4 -#define COMPILED_INTERACTIVE 5 -#define COMPILED_DOMAIN 6 - -/* It doesn't make sense to have this and also have load-history */ -/* #define COMPILED_FUNCTION_ANNOTATION_HACK */ - -struct Lisp_Compiled_Function -{ - struct lrecord_header lheader; - unsigned short stack_depth; - unsigned short specpdl_depth; - struct - { - unsigned int documentationp: 1; - unsigned int interactivep: 1; - /* Only used if I18N3, but always defined for simplicity. */ - unsigned int domainp: 1; - /* Non-zero if this bytecode came from a v18 or v19 file. - We need to Ebolify the `assoc', `delq', etc. functions. */ - unsigned int ebolified: 1; - } flags; - Lisp_Object instructions; - Lisp_Object constants; - Lisp_Object arglist; - /* This uses the minimal number of conses; see accessors in data.c. */ - Lisp_Object doc_and_interactive; -#ifdef COMPILED_FUNCTION_ANNOTATION_HACK - /* Something indicating where the bytecode came from */ - Lisp_Object annotated; -#endif -}; -typedef struct Lisp_Compiled_Function Lisp_Compiled_Function; - -Lisp_Object run_byte_code (Lisp_Object compiled_function_or_instructions, ...); - -Lisp_Object compiled_function_arglist (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_instructions (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_constants (Lisp_Compiled_Function *f); -int compiled_function_stack_depth (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_documentation (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_annotation (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_domain (Lisp_Compiled_Function *f); -Lisp_Object compiled_function_interactive (Lisp_Compiled_Function *f); - -void set_compiled_function_documentation (Lisp_Compiled_Function *f, - Lisp_Object new_doc); - -Lisp_Object funcall_compiled_function (Lisp_Object fun, - int nargs, Lisp_Object args[]); -void optimize_compiled_function (Lisp_Object compiled_function); - -DECLARE_LRECORD (compiled_function, Lisp_Compiled_Function); -#define XCOMPILED_FUNCTION(x) XRECORD (x, compiled_function, \ - Lisp_Compiled_Function) -#define XSETCOMPILED_FUNCTION(x, p) XSETRECORD (x, p, compiled_function) -#define COMPILED_FUNCTIONP(x) RECORDP (x, compiled_function) -#define GC_COMPILED_FUNCTIONP(x) GC_RECORDP (x, compiled_function) -#define CHECK_COMPILED_FUNCTION(x) CHECK_RECORD (x, compiled_function) -#define CONCHECK_COMPILED_FUNCTION(x) CONCHECK_RECORD (x, compiled_function) - -extern Lisp_Object Qbyte_code; - -/* total 1765 internal 101 doc-and-int 775 doc-only 389 int-only 42 neither 559 - no doc slot, no int slot - overhead : (* 1765 0) = 0 - doc-and-int (args . (doc . int)): (* 775 4) = 3100 - doc-only (args . doc) : (* 389 2) = 778 - int-only (args . int) : (* 42 2) = 84 - neither args : (* 559 0) = 0 = 3962 - combined - overhead : (* 1765 1) = 1765 - doc-and-int (doc . int) : (* 775 2) = 1550 - doc-only doc : (* 389 0) = 0 - int-only int : (* 42 0) = 0 - neither - : (* 559 0) = 0 = 3315 - both - overhead : (* 1765 2) = 3530 - doc-and-int - : (* 775 0) = 0 - doc-only - : (* 389 0) = 0 - int-only - : (* 42 0) = 0 - neither - : (* 559 0) = 0 = 3530 -*/ - -#endif /* _XEMACS_BYTECODE_H_ */ - diff --git a/src/callint.c b/src/callint.c deleted file mode 100644 index 14d9e23..0000000 --- a/src/callint.c +++ /dev/null @@ -1,1058 +0,0 @@ -/* Call a Lisp function interactively. - Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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, Mule 2.0. */ - -/* Authorship: - - FSF: long ago. - Mly or JWZ: various changes. - */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "bytecode.h" -#include "commands.h" -#include "events.h" -#include "insdel.h" -#include "window.h" - -extern int num_input_chars; - -Lisp_Object Vcurrent_prefix_arg; -Lisp_Object Qcall_interactively; -Lisp_Object Vcommand_history; - -Lisp_Object Vcommand_debug_status, Qcommand_debug_status; -Lisp_Object Qenable_recursive_minibuffers; - -#if 0 /* FSFmacs */ -/* Non-nil means treat the mark as active - even if mark_active is 0. */ -Lisp_Object Vmark_even_if_inactive; -#endif - -#if 0 /* ill-conceived */ -Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; -#endif - -Lisp_Object Qlet, QletX, Qsave_excursion; - -Lisp_Object Qcurrent_prefix_arg; - -Lisp_Object Quser_variable_p; -Lisp_Object Qread_from_minibuffer; -Lisp_Object Qread_file_name; -Lisp_Object Qread_directory_name; -Lisp_Object Qcompleting_read; -Lisp_Object Qread_buffer; -Lisp_Object Qread_function; -Lisp_Object Qread_variable; -Lisp_Object Qread_expression; -Lisp_Object Qread_command; -Lisp_Object Qread_number; -Lisp_Object Qread_string; -Lisp_Object Qevents_to_keys; - -#if defined(MULE) || defined(FILE_CODING) -Lisp_Object Qread_coding_system; -Lisp_Object Qread_non_nil_coding_system; -#endif - -/* ARGSUSED */ -DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /* -Specify a way of parsing arguments for interactive use of a function. -For example, write - (defun foo (arg) "Doc string" (interactive "p") ...use arg...) -to make ARG be the prefix argument when `foo' is called as a command. -The "call" to `interactive' is actually a declaration rather than a function; - it tells `call-interactively' how to read arguments - to pass to the function. -When actually called, `interactive' just returns nil. - -The argument of `interactive' is usually a string containing a code letter - followed by a prompt. (Some code letters do not use I/O to get - the argument and do not need prompts.) To prompt for multiple arguments, - give a code letter, its prompt, a newline, and another code letter, etc. - Prompts are passed to format, and may use % escapes to print the - arguments that have already been read. -If the argument is not a string, it is evaluated to get a list of - arguments to pass to the function. -Just `(interactive)' means pass no args when calling interactively. - -Code letters available are: -a -- Function name: symbol with a function definition. -b -- Name of existing buffer. -B -- Name of buffer, possibly nonexistent. -c -- Character. -C -- Command name: symbol with interactive function definition. -d -- Value of point as number. Does not do I/O. -D -- Directory name. -e -- Last mouse-button or misc-user event that invoked this command. - If used more than once, the Nth `e' returns the Nth such event. - Does not do I/O. -f -- Existing file name. -F -- Possibly nonexistent file name. -i -- Always nil, ignore. Use to skip arguments when interactive. -k -- Key sequence (a vector of events). -K -- Key sequence to be redefined (do not automatically down-case). -m -- Value of mark as number. Does not do I/O. -n -- Number read using minibuffer. -N -- Prefix arg converted to number, or if none, do like code `n'. -p -- Prefix arg converted to number. Does not do I/O. -P -- Prefix arg in raw form. Does not do I/O. -r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O. -s -- Any string. -S -- Any symbol. -v -- Variable name: symbol that is user-variable-p. -x -- Lisp expression read but not evaluated. -X -- Lisp expression read and evaluated. -z -- Coding system. (Always nil if no Mule support.) -Z -- Coding system, nil if no prefix arg. (Always nil if no Mule support.) -In addition, if the string begins with `*' - then an error is signaled if the buffer is read-only. - This happens before reading any arguments. -If the string begins with `@', then the window the mouse is over is selected - before anything else is done. -If the string begins with `_', then this command will not cause the region - to be deactivated when it completes; that is, `zmacs-region-stays' will be - set to t when the command exits successfully. -You may use any of `@', `*' and `_' at the beginning of the string; - they are processed in the order that they appear. -*/ - (args)) -{ - return Qnil; -} - -/* Originally, this was just a function -- but `custom' used a - garden-variety version, so why not make it a subr? */ -/* #### Move it to another file! */ -DEFUN ("quote-maybe", Fquote_maybe, 1, 1, 0, /* -Quote EXPR if it is not self quoting. -*/ - (expr)) -{ - return ((NILP (expr) - || EQ (expr, Qt) - || INTP (expr) - || FLOATP (expr) - || CHARP (expr) - || STRINGP (expr) - || VECTORP (expr) - || KEYWORDP (expr) - || BIT_VECTORP (expr) - || (CONSP (expr) && EQ (XCAR (expr), Qlambda))) - ? expr : list2 (Qquote, expr)); -} - -/* Modify EXPR by quotifying each element (except the first). */ -static Lisp_Object -quotify_args (Lisp_Object expr) -{ - REGISTER Lisp_Object tail; - REGISTER struct Lisp_Cons *ptr; - for (tail = expr; CONSP (tail); tail = ptr->cdr) - { - ptr = XCONS (tail); - ptr->car = Fquote_maybe (ptr->car); - } - return expr; -} - -static Bufpos -check_mark (void) -{ - Lisp_Object tem; - - if (zmacs_regions && !zmacs_region_active_p) - error ("The region is not active now"); - - tem = Fmarker_buffer (current_buffer->mark); - if (NILP (tem) || (XBUFFER (tem) != current_buffer)) - error ("The mark is not set now"); - - return marker_position (current_buffer->mark); -} - -static Lisp_Object -callint_prompt (CONST Bufbyte *prompt_start, Bytecount prompt_length, - CONST Lisp_Object *args, int nargs) -{ - Lisp_Object s = make_string (prompt_start, prompt_length); - struct gcpro gcpro1; - - /* Fformat no longer smashes its arg vector, so no need to copy it. */ - - if (!strchr ((char *) XSTRING_DATA (s), '%')) - return s; - GCPRO1 (s); - RETURN_UNGCPRO (emacs_doprnt_string_lisp (0, s, 0, nargs, args)); -} - -/* `lambda' for RECORD-FLAG is an XEmacs addition. */ - -DEFUN ("call-interactively", Fcall_interactively, 1, 3, 0, /* -Call FUNCTION, reading args according to its interactive calling specs. -Return the value FUNCTION returns. -The function contains a specification of how to do the argument reading. -In the case of user-defined functions, this is specified by placing a call -to the function `interactive' at the top level of the function body. -See `interactive'. - -If optional second arg RECORD-FLAG is the symbol `lambda', the interactive -calling arguments for FUNCTION are read and returned as a list, -but the function is not called on them. - -If RECORD-FLAG is `t' then unconditionally put this command in the -command-history. Otherwise, this is done only if an arg is read using -the minibuffer. - -The argument KEYS specifies the value to use instead of (this-command-keys) -when reading the arguments. -*/ - (function, record_flag, keys)) -{ - /* This function can GC */ - int speccount = specpdl_depth (); - Lisp_Object prefix; - - Lisp_Object fun; - Lisp_Object specs = Qnil; -#ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS - Lisp_Object enable; -#endif - /* If SPECS is a string, we reset prompt_data to string_data - * (XSTRING (specs)) every time a GC might have occurred */ - CONST char *prompt_data = 0; - int prompt_index = 0; - int argcount; - int set_zmacs_region_stays = 0; - int mouse_event_count = 0; - - if (!NILP (keys)) - { - int i, len; - - CHECK_VECTOR (keys); - len = XVECTOR_LENGTH (keys); - for (i = 0; i < len; i++) - CHECK_LIVE_EVENT (XVECTOR_DATA (keys)[i]); - } - - /* Save this now, since use of minibuffer will clobber it. */ - prefix = Vcurrent_prefix_arg; - - retry: - -#ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS - /* Marginal kludge. Use an evaluated interactive spec instead of this! */ - if (SYMBOLP (function)) - enable = Fget (function, Qenable_recursive_minibuffers, Qnil); -#endif - - fun = indirect_function (function, 1); - - /* Decode the kind of function. Either handle it and return, - or go to `lose' if not interactive, or go to `retry' - to specify a different function, or set either PROMPT_DATA or SPECS. */ - - if (SUBRP (fun)) - { - prompt_data = XSUBR (fun)->prompt; - if (!prompt_data) - { - lose: - function = wrong_type_argument (Qcommandp, function); - goto retry; - } -#if 0 /* FSFmacs */ /* Huh? Where is this used? */ - if ((EMACS_INT) prompt_data == 1) - /* Let SPECS (which is nil) be used as the args. */ - prompt_data = 0; -#endif - } - else if (COMPILED_FUNCTIONP (fun)) - { - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - if (! f->flags.interactivep) - goto lose; - specs = compiled_function_interactive (f); - } - else if (!CONSP (fun)) - goto lose; - else - { - Lisp_Object funcar = Fcar (fun); - - if (EQ (funcar, Qautoload)) - { - struct gcpro gcpro1, gcpro2; - GCPRO2 (function, prefix); - do_autoload (fun, function); - UNGCPRO; - goto retry; - } - else if (EQ (funcar, Qlambda)) - { - specs = Fassq (Qinteractive, Fcdr (Fcdr (fun))); - if (NILP (specs)) - goto lose; - specs = Fcar (Fcdr (specs)); - } - else - goto lose; - } - - /* FSFmacs makes an alloca() copy of prompt_data here. - We're more intelligent about this and just reset prompt_data - as necessary. */ - /* If either specs or prompt_data is set to a string, use it. */ - if (!STRINGP (specs) && prompt_data == 0) - { - struct gcpro gcpro1, gcpro2, gcpro3; - int i = num_input_chars; - Lisp_Object input = specs; - - GCPRO3 (function, specs, input); - /* Compute the arg values using the user's expression. */ - specs = Feval (specs); - if (EQ (record_flag, Qlambda)) /* XEmacs addition */ - { - UNGCPRO; - return specs; - } - if (!NILP (record_flag) || i != num_input_chars) - { - /* We should record this command on the command history. */ - /* #### The following is too specific; should have general - mechanism for doing this. */ - Lisp_Object values, car; - /* Make a copy of the list of values, for the command history, - and turn them into things we can eval. */ - values = quotify_args (Fcopy_sequence (specs)); - /* If the list of args was produced with an explicit call to `list', - look for elements that were computed with (region-beginning) - or (region-end), and put those expressions into VALUES - instead of the present values. */ - if (CONSP (input)) - { - car = XCAR (input); - /* Skip through certain special forms. */ - while (EQ (car, Qlet) || EQ (car, QletX) - || EQ (car, Qsave_excursion)) - { - while (CONSP (XCDR (input))) - input = XCDR (input); - input = XCAR (input); - if (!CONSP (input)) - break; - car = XCAR (input); - } - if (EQ (car, Qlist)) - { - Lisp_Object intail, valtail; - for (intail = Fcdr (input), valtail = values; - CONSP (valtail); - intail = Fcdr (intail), valtail = Fcdr (valtail)) - { - Lisp_Object elt; - elt = Fcar (intail); - if (CONSP (elt)) - { - Lisp_Object eltcar = Fcar (elt); - if (EQ (eltcar, Qpoint) || - EQ (eltcar, Qmark) || - EQ (eltcar, Qregion_beginning) || - EQ (eltcar, Qregion_end)) - Fsetcar (valtail, Fcar (intail)); - } - } - } - } - Vcommand_history - = Fcons (Fcons (function, values), Vcommand_history); - } - single_console_state (); - RETURN_UNGCPRO (apply1 (fun, specs)); - } - - /* Here if function specifies a string to control parsing the defaults */ - -#ifdef I18N3 - /* Translate interactive prompt. */ - if (STRINGP (specs)) - { - Lisp_Object domain = Qnil; - if (COMPILED_FUNCTIONP (fun)) - domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); - if (NILP (domain)) - specs = Fgettext (specs); - else - specs = Fdgettext (domain, specs); - } - else if (prompt_data) - /* We do not have to worry about domains in this case because - prompt_data is non-nil only for built-in functions, which - always use the default domain. */ - prompt_data = gettext (prompt_data); -#endif - - /* Handle special starting chars `*' and `@' and `_'. */ - /* Note that `+' is reserved for user extensions. */ - prompt_index = 0; - { - struct gcpro gcpro1, gcpro2; - GCPRO2 (function, specs); - - for (;;) - { - if (STRINGP (specs)) - prompt_data = (CONST char *) XSTRING_DATA (specs); - - if (prompt_data[prompt_index] == '+') - error ("`+' is not used in `interactive' for ordinary commands"); - else if (prompt_data[prompt_index] == '*') - { - prompt_index++; - if (!NILP (current_buffer->read_only)) - barf_if_buffer_read_only (current_buffer, -1, -1); - } - else if (prompt_data[prompt_index] == '@') - { - Lisp_Object event; - prompt_index++; - - if (!NILP (keys)) - event = extract_vector_nth_mouse_event (keys, 0); - else -#if 0 - event = extract_this_command_keys_nth_mouse_event (0); -#else - /* Doesn't work; see below */ - event = Vcurrent_mouse_event; -#endif - if (! NILP (event)) - { - Lisp_Object window = Fevent_window (event); - if (!NILP (window)) - { - if (MINI_WINDOW_P (XWINDOW (window)) - && ! (minibuf_level > 0 && EQ (window, - minibuf_window))) - error ("Attempt to select inactive minibuffer window"); - -#if 0 /* unclean! see event-stream.c */ - /* If the current buffer wants to clean up, let it. */ - if (!NILP (Vmouse_leave_buffer_hook)) - run_hook (Qmouse_leave_buffer_hook); -#endif - - Fselect_window (window, Qnil); - } - } - } - else if (prompt_data[prompt_index] == '_') - { - prompt_index++; - set_zmacs_region_stays = 1; - } - else - { - UNGCPRO; - break; - } - } - } - - /* Count the number of arguments the interactive spec would have - us give to the function. */ - argcount = 0; - { - CONST char *tem; - for (tem = prompt_data + prompt_index; *tem; ) - { - /* 'r' specifications ("point and mark as 2 numeric args") - produce *two* arguments. */ - if (*tem == 'r') - argcount += 2; - else - argcount += 1; - tem = (CONST char *) strchr (tem + 1, '\n'); - if (!tem) - break; - tem++; - } - } - -#ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS - if (!NILP (enable)) - specbind (Qenable_recursive_minibuffers, Qt); -#endif - - if (argcount == 0) - { - /* Interactive function or no arguments; just call it */ - if (EQ (record_flag, Qlambda)) - return Qnil; - if (!NILP (record_flag)) - { - Vcommand_history = Fcons (list1 (function), Vcommand_history); - } - specbind (Qcommand_debug_status, Qnil); - /* XEmacs: was fun = call0 (fun), but that's backtraced wrong */ - { - struct gcpro gcpro1; - - GCPRO1 (fun); - fun = Ffuncall (1, &fun); - UNGCPRO; - } - if (set_zmacs_region_stays) - zmacs_region_stays = 1; - return unbind_to (speccount, fun); - } - - /* Read interactive arguments */ - { - /* args[-1] is the function to call */ - /* args[n] is the n'th argument to the function */ - int alloca_size = (1 /* function to call */ - + argcount /* actual arguments */ - + argcount /* visargs */ - + argcount /* varies */ - ); - Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1; - /* visargs is an array of either Qnil or user-friendlier versions (often - * strings) of previous arguments, to use in prompts for successive - * arguments. ("Often strings" because emacs didn't used to have - * format %S and prin1-to-string.) */ - Lisp_Object *visargs = args + argcount; - /* If varies[i] is non-null, the i'th argument shouldn't just have - its value in this call quoted in the command history. It should be - recorded as a call to the function named varies[i]]. */ - Lisp_Object *varies = visargs + argcount; - int arg_from_tty = 0; - REGISTER int argnum; - struct gcpro gcpro1, gcpro2; - - args[-1] = function; - for (argnum = 0; argnum < alloca_size - 1; argnum++) - args[argnum] = Qnil; - - /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */ - /* `function' itself isn't GC-protected -- use args[-1] from here - (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */ - GCPRO2 (prefix, args[-1]); - gcpro2.nvars = alloca_size; - - for (argnum = 0; ; argnum++) - { - CONST char *prompt_start = prompt_data + prompt_index + 1; - CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n'); - int prompt_length; - prompt_length = ((prompt_limit) - ? (prompt_limit - prompt_start) - : strlen (prompt_start)); - if (prompt_limit && prompt_limit[1] == 0) - { - prompt_limit = 0; /* "sfoo:\n" -- strip tailing return */ - prompt_length -= 1; - } - /* This uses `visargs' instead of `args' so that global-set-key - prompts with "Set key C-x C-f to command: "instead of printing - event objects in there. - */ -#define PROMPT() callint_prompt ((CONST Bufbyte *) prompt_start, prompt_length, visargs, argnum) - switch (prompt_data[prompt_index]) - { - case 'a': /* Symbol defined as a function */ - { - Lisp_Object tem = call1 (Qread_function, PROMPT ()); - args[argnum] = tem; - arg_from_tty = 1; - break; - } - case 'b': /* Name of existing buffer */ - { - Lisp_Object def = Fcurrent_buffer (); - if (EQ (Fselected_window (Qnil), minibuf_window)) - def = Fother_buffer (def, Qnil, Qnil); - /* read-buffer returns a buffer name, not a buffer! */ - args[argnum] = call3 (Qread_buffer, PROMPT (), def, - Qt); - arg_from_tty = 1; - break; - } - case 'B': /* Name of buffer, possibly nonexistent */ - { - /* read-buffer returns a buffer name, not a buffer! */ - args[argnum] = call2 (Qread_buffer, PROMPT (), - Fother_buffer (Fcurrent_buffer (), Qnil, - Qnil)); - arg_from_tty = 1; - break; - } - case 'c': /* Character */ - { - Lisp_Object tem; - int shadowing_speccount = specpdl_depth (); - - specbind (Qcursor_in_echo_area, Qt); - message ("%s", XSTRING_DATA (PROMPT ())); - tem = (call0 (Qread_char)); - args[argnum] = tem; - /* visargs[argnum] = Fsingle_key_description (tem); */ - /* FSF has visargs[argnum] = Fchar_to_string (tem); */ - - unbind_to (shadowing_speccount, Qnil); - - /* #### `C-x / a' should not leave the prompt in the minibuffer. - This isn't the right fix, because (message ...) (read-char) - shouldn't leave the message there either... */ - clear_message (); - - arg_from_tty = 1; - break; - } - case 'C': /* Command: symbol with interactive function */ - { - Lisp_Object tem = call1 (Qread_command, PROMPT ()); - args[argnum] = tem; - arg_from_tty = 1; - break; - } - case 'd': /* Value of point. Does not do I/O. */ - { - args[argnum] = Fcopy_marker (current_buffer->point_marker, Qt); - varies[argnum] = Qpoint; - break; - } - case 'e': - { - Lisp_Object event; - - if (!NILP (keys)) - event = extract_vector_nth_mouse_event (keys, - mouse_event_count); - else -#if 0 - /* This doesn't quite work because this-command-keys - behaves in utterly counterintuitive ways. Sometimes - it retrieves an event back in the future, e.g. when - one command invokes another command and both are - invoked with the mouse. */ - event = (extract_this_command_keys_nth_mouse_event - (mouse_event_count)); -#else - event = Vcurrent_mouse_event; -#endif - - if (NILP (event)) - error ("%s must be bound to a mouse or misc-user event", - (SYMBOLP (function) - ? (char *) string_data (XSYMBOL (function)->name) - : "command")); - args[argnum] = event; - mouse_event_count++; - break; - } - case 'D': /* Directory name. */ - { - args[argnum] = call4 (Qread_directory_name, PROMPT (), - Qnil, /* dir */ - current_buffer->directory, /* default */ - Qt /* must-match */ - ); - arg_from_tty = 1; - break; - } - case 'f': /* Existing file name. */ - { - Lisp_Object tem = call4 (Qread_file_name, PROMPT (), - Qnil, /* dir */ - Qnil, /* default */ - Qzero /* must-match */ - ); - args[argnum] = tem; - arg_from_tty = 1; - break; - } - case 'F': /* Possibly nonexistent file name. */ - { - args[argnum] = call4 (Qread_file_name, PROMPT (), - Qnil, /* dir */ - Qnil, /* default */ - Qnil /* must-match */ - ); - arg_from_tty = 1; - break; - } - case 'i': /* Ignore: always nil. Use to skip arguments. */ - { - args[argnum] = Qnil; - break; - } - case 'k': /* Key sequence (vector of events) */ - { - struct gcpro ngcpro1; - Lisp_Object tem; - Lisp_Object key_prompt = PROMPT (); - - NGCPRO1(key_prompt); - tem = Fread_key_sequence (key_prompt, Qnil, Qnil); - NUNGCPRO; - - visargs[argnum] = Fkey_description (tem); - /* The following makes `describe-key' not work with - extent-local keymaps and such; and anyway, it's - contrary to the documentation. */ - /* args[argnum] = call1 (Qevents_to_keys, tem); */ - args[argnum] = tem; - arg_from_tty = 1; - break; - } - case 'K': /* Key sequence (vector of events), - no automatic downcasing */ - { - struct gcpro ngcpro1; - Lisp_Object tem; - Lisp_Object key_prompt = PROMPT (); - - NGCPRO1(key_prompt); - tem = Fread_key_sequence (key_prompt, Qnil, Qt); - NUNGCPRO; - - visargs[argnum] = Fkey_description (tem); - /* The following makes `describe-key' not work with - extent-local keymaps and such; and anyway, it's - contrary to the documentation. */ - /* args[argnum] = call1 (Qevents_to_keys, tem); */ - args[argnum] = tem; - arg_from_tty = 1; - break; - } - - case 'm': /* Value of mark. Does not do I/O. */ - { - args[argnum] = current_buffer->mark; - varies[argnum] = Qmark; - break; - } - case 'n': /* Read number from minibuffer. */ - { - read_number: - args[argnum] = call2 (Qread_number, PROMPT (), Qnil); - /* numbers are too boring to go on command history */ - /* arg_from_tty = 1; */ - break; - } - case 'N': /* Prefix arg, else number from minibuffer */ - { - if (NILP (prefix)) - goto read_number; - else - goto prefix_value; - } - case 'P': /* Prefix arg in raw form. Does no I/O. */ - { - args[argnum] = prefix; - break; - } - case 'p': /* Prefix arg converted to number. No I/O. */ - { - prefix_value: - { - Lisp_Object tem = Fprefix_numeric_value (prefix); - args[argnum] = tem; - } - break; - } - case 'r': /* Region, point and mark as 2 args. */ - { - Bufpos tem = check_mark (); - args[argnum] = (BUF_PT (current_buffer) < tem - ? Fcopy_marker (current_buffer->point_marker, Qt) - : current_buffer->mark); - varies[argnum] = Qregion_beginning; - args[++argnum] = (BUF_PT (current_buffer) > tem - ? Fcopy_marker (current_buffer->point_marker, - Qt) - : current_buffer->mark); - varies[argnum] = Qregion_end; - break; - } - case 's': /* String read via minibuffer. */ - { - args[argnum] = call1 (Qread_string, PROMPT ()); - arg_from_tty = 1; - break; - } - case 'S': /* Any symbol. */ - { -#if 0 /* Historical crock */ - Lisp_Object tem = intern ("minibuffer-local-ns-map"); - tem = find_symbol_value (tem); - if (UNBOUNDP (tem)) tem = Qnil; - tem = call3 (Qread_from_minibuffer, PROMPT (), Qnil, - tem); - args[argnum] = Fintern (tem, Qnil); -#else /* 1 */ - visargs[argnum] = Qnil; - for (;;) - { - Lisp_Object tem = call5 (Qcompleting_read, - PROMPT (), - Vobarray, - Qnil, - Qnil, - /* nil, or prev attempt */ - visargs[argnum]); - visargs[argnum] = tem; - /* I could use condition-case with this loser, but why bother? - * tem = Fread (tem); check-symbol-p; - */ - tem = Fintern (tem, Qnil); - args[argnum] = tem; - if (string_length (XSYMBOL (tem)->name) > 0) - /* Don't accept the empty-named symbol. If the loser - really wants this s/he can call completing-read - directly */ - break; - } -#endif /* 1 */ - arg_from_tty = 1; - break; - } - case 'v': /* Variable name: user-variable-p symbol */ - { - Lisp_Object tem = call1 (Qread_variable, PROMPT ()); - args[argnum] = tem; - arg_from_tty = 1; - break; - } - case 'x': /* Lisp expression read but not evaluated */ - { - args[argnum] = call1 (Qread_expression, PROMPT ()); - /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */ - arg_from_tty = 1; - break; - } - case 'X': /* Lisp expression read and evaluated */ - { - Lisp_Object tem = call1 (Qread_expression, PROMPT ()); - /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */ - args[argnum] = Feval (tem); - arg_from_tty = 1; - break; - } - case 'Z': /* Coding-system symbol or nil if no prefix */ - { -#if defined(MULE) || defined(FILE_CODING) - if (NILP (prefix)) - { - args[argnum] = Qnil; - } - else - { - args[argnum] = - call1 (Qread_non_nil_coding_system, PROMPT ()); - arg_from_tty = 1; - } -#else - args[argnum] = Qnil; -#endif - break; - } - case 'z': /* Coding-system symbol */ - { -#if defined(MULE) || defined(FILE_CODING) - args[argnum] = call1 (Qread_coding_system, PROMPT ()); - arg_from_tty = 1; -#else - args[argnum] = Qnil; -#endif - break; - } - - /* We have a case for `+' so we get an error - if anyone tries to define one here. */ - case '+': - default: - { - error ("Invalid `interactive' control letter \"%c\" (#o%03o).", - prompt_data[prompt_index], - prompt_data[prompt_index]); - } - } -#undef PROMPT - if (NILP (visargs[argnum])) - visargs[argnum] = args[argnum]; - - if (!prompt_limit) - break; - if (STRINGP (specs)) - prompt_data = (CONST char *) XSTRING_DATA (specs); - prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */ - } - unbind_to (speccount, Qnil); - - QUIT; - - if (EQ (record_flag, Qlambda)) - { - RETURN_UNGCPRO (Flist (argcount, args)); - } - - if (arg_from_tty || !NILP (record_flag)) - { - /* Reuse visargs as a temporary for constructing the command history */ - for (argnum = 0; argnum < argcount; argnum++) - { - if (!NILP (varies[argnum])) - visargs[argnum] = list1 (varies[argnum]); - else - visargs[argnum] = Fquote_maybe (args[argnum]); - } - Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)), - Vcommand_history); - } - - /* If we used a marker to hold point, mark, or an end of the region, - temporarily, convert it to an integer now. */ - for (argnum = 0; argnum < argcount; argnum++) - if (!NILP (varies[argnum])) - XSETINT (args[argnum], marker_position (args[argnum])); - - single_console_state (); - specbind (Qcommand_debug_status, Qnil); - fun = Ffuncall (argcount + 1, args - 1); - UNGCPRO; - if (set_zmacs_region_stays) - zmacs_region_stays = 1; - return unbind_to (speccount, fun); - } -} - -DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /* -Return numeric meaning of raw prefix argument ARG. -A raw prefix argument is what you get from `(interactive "P")'. -Its numeric meaning is what you would get from `(interactive "p")'. -*/ - (raw)) -{ - if (NILP (raw)) - return make_int (1); - if (EQ (raw, Qminus)) - return make_int (-1); - if (INTP (raw)) - return raw; - if (CONSP (raw) && INTP (XCAR (raw))) - return XCAR (raw); - - return make_int (1); -} - -void -syms_of_callint (void) -{ - defsymbol (&Qcall_interactively, "call-interactively"); - defsymbol (&Qread_from_minibuffer, "read-from-minibuffer"); - defsymbol (&Qcompleting_read, "completing-read"); - defsymbol (&Qread_file_name, "read-file-name"); - defsymbol (&Qread_directory_name, "read-directory-name"); - defsymbol (&Qread_string, "read-string"); - defsymbol (&Qread_buffer, "read-buffer"); - defsymbol (&Qread_variable, "read-variable"); - defsymbol (&Qread_function, "read-function"); - defsymbol (&Qread_command, "read-command"); - defsymbol (&Qread_number, "read-number"); - defsymbol (&Qread_expression, "read-expression"); -#if defined(MULE) || defined(FILE_CODING) - defsymbol (&Qread_coding_system, "read-coding-system"); - defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system"); -#endif - defsymbol (&Qevents_to_keys, "events-to-keys"); - defsymbol (&Qcommand_debug_status, "command-debug-status"); - defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); - defsymbol (&Quser_variable_p, "user-variable-p"); - defsymbol (&Qcurrent_prefix_arg, "current-prefix-arg"); - - defsymbol (&Qlet, "let"); - defsymbol (&QletX, "let*"); - defsymbol (&Qsave_excursion, "save-excursion"); -#if 0 /* ill-conceived */ - defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); -#endif - - DEFSUBR (Finteractive); - DEFSUBR (Fquote_maybe); - DEFSUBR (Fcall_interactively); - DEFSUBR (Fprefix_numeric_value); -} - -void -vars_of_callint (void) -{ - DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg /* -The value of the prefix argument for this editing command. -It may be a number, or the symbol `-' for just a minus sign as arg, -or a list whose car is a number for just one or more C-U's -or nil if no argument has been specified. -This is what `(interactive "P")' returns. -*/ ); - Vcurrent_prefix_arg = Qnil; - - DEFVAR_LISP ("command-history", &Vcommand_history /* -List of recent commands that read arguments from terminal. -Each command is represented as a form to evaluate. -*/ ); - Vcommand_history = Qnil; - - DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status /* -Debugging status of current interactive command. -Bound each time `call-interactively' is called; -may be set by the debugger as a reminder for itself. -*/ ); - Vcommand_debug_status = Qnil; - -#if 0 /* FSFmacs */ - xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /* -*Non-nil means you can use the mark even when inactive. -This option makes a difference in Transient Mark mode. -When the option is non-nil, deactivation of the mark -turns off region highlighting, but commands that use the mark -behave as if the mark were still active. -*/ ); - Vmark_even_if_inactive = Qnil; -#endif - -#if 0 /* Doesn't work and is totally ill-conceived anyway. */ - xxDEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook /* -Hook to run when about to switch windows with a mouse command. -Its purpose is to give temporary modes such as Isearch mode -a way to turn themselves off when a mouse command switches windows. -*/ ); - Vmouse_leave_buffer_hook = Qnil; -#endif -} diff --git a/src/callproc.c b/src/callproc.c deleted file mode 100644 index 5bdcb78..0000000 --- a/src/callproc.c +++ /dev/null @@ -1,900 +0,0 @@ -/* Synchronous subprocess invocation for XEmacs. - Copyright (C) 1985, 86, 87, 88, 93, 94, 95 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: Mule 2.0, FSF 19.30. */ -/* Partly sync'ed with 19.36.4 */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "commands.h" -#include "insdel.h" -#include "lstream.h" -#include "process.h" -#include "sysdep.h" -#include "window.h" -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -#include "systime.h" -#include "sysproc.h" -#include "sysfile.h" /* Always include after sysproc.h */ -#include "syssignal.h" /* Always include before systty.h */ -#include "systty.h" - -#ifdef WINDOWSNT -#define _P_NOWAIT 1 /* from process.h */ -#include -#include "nt.h" -#endif - -#ifdef DOS_NT -/* When we are starting external processes we need to know whether they - take binary input (no conversion) or text input (\n is converted to - \r\n). Similarly for output: if newlines are written as \r\n then it's - text process output, otherwise it's binary. */ -Lisp_Object Vbinary_process_input; -Lisp_Object Vbinary_process_output; -#endif /* DOS_NT */ - -Lisp_Object Vshell_file_name; - -/* The environment to pass to all subprocesses when they are started. - This is in the semi-bogus format of ("VAR=VAL" "VAR2=VAL2" ... ) - */ -Lisp_Object Vprocess_environment; - -/* True iff we are about to fork off a synchronous process or if we - are waiting for it. */ -volatile int synch_process_alive; - -/* Nonzero => this is a string explaining death of synchronous subprocess. */ -CONST char *synch_process_death; - -/* If synch_process_death is zero, - this is exit code of synchronous subprocess. */ -int synch_process_retcode; - -/* Clean up when exiting Fcall_process_internal. - On MSDOS, delete the temporary file on any kind of termination. - On Unix, kill the process and any children on termination by signal. */ - -/* Nonzero if this is termination due to exit. */ -static int call_process_exited; - - -static Lisp_Object -call_process_kill (Lisp_Object fdpid) -{ - Lisp_Object fd = Fcar (fdpid); - Lisp_Object pid = Fcdr (fdpid); - - if (!NILP (fd)) - close (XINT (fd)); - - if (!NILP (pid)) - EMACS_KILLPG (XINT (pid), SIGKILL); - - synch_process_alive = 0; - return Qnil; -} - -static Lisp_Object -call_process_cleanup (Lisp_Object fdpid) -{ - int fd = XINT (Fcar (fdpid)); - int pid = XINT (Fcdr (fdpid)); - - if (!call_process_exited && - EMACS_KILLPG (pid, SIGINT) == 0) - { - int speccount = specpdl_depth (); - - record_unwind_protect (call_process_kill, fdpid); - /* #### "c-G" -- need non-consing Single-key-description */ - message ("Waiting for process to die...(type C-g again to kill it instantly)"); - - wait_for_termination (pid); - - /* "Discard" the unwind protect. */ - XCAR (fdpid) = Qnil; - XCDR (fdpid) = Qnil; - unbind_to (speccount, Qnil); - - message ("Waiting for process to die... done"); - } - synch_process_alive = 0; - close (fd); - return Qnil; -} - -static Lisp_Object fork_error; -#if 0 /* UNUSED */ -static void -report_fork_error (char *string, Lisp_Object data) -{ - Lisp_Object errstring = lisp_strerror (errno); - - fork_error = Fcons (build_string (string), Fcons (errstring, data)); - - /* terminate this branch of the fork, without closing stdin/out/etc. */ - _exit (1); -} -#endif /* unused */ - -DEFUN ("call-process-internal", Fcall_process_internal, 1, MANY, 0, /* -Call PROGRAM synchronously in separate process, with coding-system specified. -Arguments are - (PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS). -The program's input comes from file INFILE (nil means `/dev/null'). -Insert output in BUFFER before point; t means current buffer; - nil for BUFFER means discard it; 0 means discard and don't wait. -BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, -REAL-BUFFER says what to do with standard output, as above, -while STDERR-FILE says what to do with standard error in the child. -STDERR-FILE may be nil (discard standard error output), -t (mix it with ordinary output), or a file name string. - -Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. -Remaining arguments are strings passed as command arguments to PROGRAM. - -If BUFFER is 0, `call-process' returns immediately with value nil. -Otherwise it waits for PROGRAM to terminate and returns a numeric exit status - or a signal description string. -If you quit, the process is killed with SIGINT, or SIGKILL if you - quit again. -*/ - (int nargs, Lisp_Object *args)) -{ - /* This function can GC */ - Lisp_Object infile, buffer, current_dir, display, path; - int fd[2]; - int filefd; - int pid; - char buf[16384]; - char *bufptr = buf; - int bufsize = 16384; - int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2; - char **new_argv = alloca_array (char *, max (2, nargs - 2)); - - /* File to use for stderr in the child. - t means use same as standard output. */ - Lisp_Object error_file; - - CHECK_STRING (args[0]); - - error_file = Qt; - -#if defined (NO_SUBPROCESSES) - /* Without asynchronous processes we cannot have BUFFER == 0. */ - if (nargs >= 3 && !INTP (args[2])) - error ("Operating system cannot handle asynchronous subprocesses"); -#endif /* NO_SUBPROCESSES */ - - /* Do this before building new_argv because GC in Lisp code - * called by various filename-hacking routines might relocate strings */ - locate_file (Vexec_path, args[0], EXEC_SUFFIXES, &path, X_OK); - - /* Make sure that the child will be able to chdir to the current - buffer's current directory, or its unhandled equivalent. We - can't just have the child check for an error when it does the - chdir, since it's in a vfork. */ - { - struct gcpro ngcpro1, ngcpro2; - /* Do this test before building new_argv because GC in Lisp code - * called by various filename-hacking routines might relocate strings */ - /* Make sure that the child will be able to chdir to the current - buffer's current directory. We can't just have the child check - for an error when it does the chdir, since it's in a vfork. */ - - NGCPRO2 (current_dir, path); /* Caller gcprotects args[] */ - current_dir = current_buffer->directory; - current_dir = Funhandled_file_name_directory (current_dir); - current_dir = expand_and_dir_to_file (current_dir, Qnil); -#if 0 - /* This is in FSF, but it breaks everything in the presence of - ange-ftp-visited files, so away with it. */ - if (NILP (Ffile_accessible_directory_p (current_dir))) - report_file_error ("Setting current directory", - Fcons (current_buffer->directory, Qnil)); -#endif /* 0 */ - NUNGCPRO; - } - - GCPRO1 (current_dir); - - if (nargs >= 2 && ! NILP (args[1])) - { - struct gcpro ngcpro1; - NGCPRO1 (current_buffer->directory); - infile = Fexpand_file_name (args[1], current_buffer->directory); - NUNGCPRO; - CHECK_STRING (infile); - } - else - infile = build_string (NULL_DEVICE); - - UNGCPRO; - - GCPRO2 (infile, current_dir); /* Fexpand_file_name might trash it */ - - if (nargs >= 3) - { - buffer = args[2]; - - /* If BUFFER is a list, its meaning is - (BUFFER-FOR-STDOUT FILE-FOR-STDERR). */ - if (CONSP (buffer)) - { - if (CONSP (XCDR (buffer))) - { - Lisp_Object file_for_stderr = XCAR (XCDR (buffer)); - - if (NILP (file_for_stderr) || EQ (Qt, file_for_stderr)) - error_file = file_for_stderr; - else - error_file = Fexpand_file_name (file_for_stderr, Qnil); - } - - buffer = XCAR (buffer); - } - - if (!(EQ (buffer, Qnil) - || EQ (buffer, Qt) - || ZEROP (buffer))) - { - Lisp_Object spec_buffer = buffer; - buffer = Fget_buffer (buffer); - /* Mention the buffer name for a better error message. */ - if (NILP (buffer)) - CHECK_BUFFER (spec_buffer); - CHECK_BUFFER (buffer); - } - } - else - buffer = Qnil; - - UNGCPRO; - - display = ((nargs >= 4) ? args[3] : Qnil); - - /* From here we assume we won't GC (unless an error is signaled). */ - { - REGISTER int i; - for (i = 4; i < nargs; i++) - { - CHECK_STRING (args[i]); - new_argv[i - 3] = (char *) XSTRING_DATA (args[i]); - } - new_argv[nargs - 3] = 0; - } - - if (NILP (path)) - report_file_error ("Searching for program", Fcons (args[0], Qnil)); - new_argv[0] = (char *) XSTRING_DATA (path); - - filefd = open ((char *) XSTRING_DATA (infile), O_RDONLY | OPEN_BINARY, 0); - if (filefd < 0) - report_file_error ("Opening process input file", Fcons (infile, Qnil)); - - if (INTP (buffer)) - { - fd[1] = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0); - fd[0] = -1; - } - else - { - pipe (fd); -#if 0 - /* Replaced by close_process_descs */ - set_exclusive_use (fd[0]); -#endif - } - - { - /* child_setup must clobber environ in systems with true vfork. - Protect it from permanent change. */ - REGISTER char **save_environ = environ; - REGISTER int fd1 = fd[1]; - int fd_error = fd1; - char **env; - - env = environ; - - /* Record that we're about to create a synchronous process. */ - synch_process_alive = 1; - - /* These vars record information from process termination. - Clear them now before process can possibly terminate, - to avoid timing error if process terminates soon. */ - synch_process_death = 0; - synch_process_retcode = 0; - - if (NILP (error_file)) - fd_error = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY); - else if (STRINGP (error_file)) - { - fd_error = open ((CONST char *) XSTRING_DATA (error_file), -#ifdef DOS_NT - O_WRONLY | O_TRUNC | O_CREAT | O_TEXT, - S_IREAD | S_IWRITE -#else /* not DOS_NT */ - O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, - CREAT_MODE -#endif /* not DOS_NT */ - ); - } - - if (fd_error < 0) - { - close (filefd); - close (fd[0]); - if (fd1 >= 0) - close (fd1); - report_file_error ("Cannot open", Fcons(error_file, Qnil)); - } - - fork_error = Qnil; -#ifdef WINDOWSNT - pid = child_setup (filefd, fd1, fd_error, new_argv, - (char *) XSTRING_DATA (current_dir)); -#else /* not WINDOWSNT */ - pid = fork (); - - if (pid == 0) - { - if (fd[0] >= 0) - close (fd[0]); - /* This is necessary because some shells may attempt to - access the current controlling terminal and will hang - if they are run in the background, as will be the case - when XEmacs is started in the background. Martin - Buchholz observed this problem running a subprocess - that used zsh to call gzip to uncompress an info - file. */ - disconnect_controlling_terminal (); - child_setup (filefd, fd1, fd_error, new_argv, - (char *) XSTRING_DATA (current_dir)); - } - if (fd_error >= 0) - close (fd_error); - -#endif /* not WINDOWSNT */ - - environ = save_environ; - - /* Close most of our fd's, but not fd[0] - since we will use that to read input from. */ - close (filefd); - if (fd1 >= 0) - close (fd1); - } - - if (!NILP (fork_error)) - signal_error (Qfile_error, fork_error); - - if (pid < 0) - { - if (fd[0] >= 0) - close (fd[0]); - report_file_error ("Doing fork", Qnil); - } - - if (INTP (buffer)) - { - if (fd[0] >= 0) - close (fd[0]); -#if defined (NO_SUBPROCESSES) - /* If Emacs has been built with asynchronous subprocess support, - we don't need to do this, I think because it will then have - the facilities for handling SIGCHLD. */ - wait_without_blocking (); -#endif /* NO_SUBPROCESSES */ - return Qnil; - } - - { - int nread; - int first = 1; - int total_read = 0; - Lisp_Object instream; - struct gcpro ngcpro1; - - /* Enable sending signal if user quits below. */ - call_process_exited = 0; - - record_unwind_protect (call_process_cleanup, - Fcons (make_int (fd[0]), make_int (pid))); - - /* FSFmacs calls Fset_buffer() here. We don't have to because - we can insert into buffers other than the current one. */ - if (EQ (buffer, Qt)) - XSETBUFFER (buffer, current_buffer); - instream = make_filedesc_input_stream (fd[0], 0, -1, LSTR_ALLOW_QUIT); -#ifdef FILE_CODING - instream = - make_decoding_input_stream - (XLSTREAM (instream), - Fget_coding_system (Vcoding_system_for_read)); - Lstream_set_character_mode (XLSTREAM (instream)); -#endif - NGCPRO1 (instream); - while (1) - { - QUIT; - /* Repeatedly read until we've filled as much as possible - of the buffer size we have. But don't read - less than 1024--save that for the next bufferfull. */ - - nread = 0; - while (nread < bufsize - 1024) - { - int this_read - = Lstream_read (XLSTREAM (instream), bufptr + nread, - bufsize - nread); - - if (this_read < 0) - goto give_up; - - if (this_read == 0) - goto give_up_1; - - nread += this_read; - } - - give_up_1: - - /* Now NREAD is the total amount of data in the buffer. */ - if (nread == 0) - break; - -#ifdef DOS_NT - /* Until we pull out of MULE things like - make_decoding_input_stream(), we do the following which is - less elegant. --marcpa */ - { - int lf_count = 0; - if (NILP (Vbinary_process_output)) { - nread = crlf_to_lf(nread, bufptr, &lf_count); - } - } -#endif - - total_read += nread; - - if (!NILP (buffer)) - buffer_insert_raw_string (XBUFFER (buffer), (Bufbyte *) bufptr, - nread); - - /* Make the buffer bigger as we continue to read more data, - but not past 64k. */ - if (bufsize < 64 * 1024 && total_read > 32 * bufsize) - { - bufsize *= 2; - bufptr = (char *) alloca (bufsize); - } - - if (!NILP (display) && INTERACTIVE) - { - first = 0; - redisplay (); - } - } - give_up: - Lstream_close (XLSTREAM (instream)); - NUNGCPRO; - - QUIT; - /* Wait for it to terminate, unless it already has. */ - wait_for_termination (pid); - - /* Don't kill any children that the subprocess may have left behind - when exiting. */ - call_process_exited = 1; - unbind_to (speccount, Qnil); - - if (synch_process_death) - return build_string (synch_process_death); - return make_int (synch_process_retcode); - } -} - - - -/* Move the file descriptor FD so that its number is not less than MIN. * - The original file descriptor remains open. */ -static int -relocate_fd (int fd, int min) -{ - if (fd >= min) - return fd; - else - { - int newfd = dup (fd); - if (newfd == -1) - { - stderr_out ("Error while setting up child: %s\n", - strerror (errno)); - _exit (1); - } - return relocate_fd (newfd, min); - } -} - -/* This is the last thing run in a newly forked inferior - either synchronous or asynchronous. - Copy descriptors IN, OUT and ERR - as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO. - Initialize inferior's priority, pgrp, connected dir and environment. - then exec another program based on new_argv. - - This function may change environ for the superior process. - Therefore, the superior process must save and restore the value - of environ around the fork and the call to this function. - - ENV is the environment for the subprocess. - - XEmacs: We've removed the SET_PGRP argument because it's already - done by the callers of child_setup. - - CURRENT_DIR is an elisp string giving the path of the current - directory the subprocess should have. Since we can't really signal - a decent error from within the child, this should be verified as an - executable directory by the parent. */ - -#ifdef WINDOWSNT -int -#else -void -#endif -child_setup (int in, int out, int err, char **new_argv, - CONST char *current_dir) -{ - char **env; - char *pwd; -#ifdef WINDOWSNT - int cpid; - HANDLE handles[4]; -#endif /* WINDOWSNT */ - -#ifdef SET_EMACS_PRIORITY - if (emacs_priority != 0) - nice (- emacs_priority); -#endif - -#if !defined (NO_SUBPROCESSES) && !defined (WINDOWSNT) - /* Close Emacs's descriptors that this process should not have. */ - close_process_descs (); -#endif /* not NO_SUBPROCESSES */ - close_load_descs (); - - /* Note that use of alloca is always safe here. It's obvious for systems - that do not have true vfork or that have true (stack) alloca. - If using vfork and C_ALLOCA it is safe because that changes - the superior's static variables as if the superior had done alloca - and will be cleaned up in the usual way. */ - { - REGISTER int i; - - i = strlen (current_dir); - pwd = alloca_array (char, i + 6); - memcpy (pwd, "PWD=", 4); - memcpy (pwd + 4, current_dir, i); - i += 4; - if (!IS_DIRECTORY_SEP (pwd[i - 1])) - pwd[i++] = DIRECTORY_SEP; - pwd[i] = 0; - - /* We can't signal an Elisp error here; we're in a vfork. Since - the callers check the current directory before forking, this - should only return an error if the directory's permissions - are changed between the check and this chdir, but we should - at least check. */ - if (chdir (pwd + 4) < 0) - { - /* Don't report the chdir error, or ange-ftp.el doesn't work. */ - /* (FSFmacs does _exit (errno) here.) */ - pwd = 0; - } - else - { - /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */ - /* leave "//" (from FSF) */ - while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1])) - pwd[--i] = 0; - } - } - - /* Set `env' to a vector of the strings in Vprocess_environment. */ - /* + 2 to include PWD and terminating 0. */ - env = alloca_array (char *, XINT (Flength (Vprocess_environment)) + 2); - { - REGISTER Lisp_Object tail; - char **new_env = env; - - /* If we have a PWD envvar and we know the real current directory, - pass one down, but with corrected value. */ - if (pwd && getenv ("PWD")) - *new_env++ = pwd; - - /* Copy the Vprocess_environment strings into new_env. */ - for (tail = Vprocess_environment; - CONSP (tail) && STRINGP (XCAR (tail)); - tail = XCDR (tail)) - { - char **ep = env; - char *envvar_external; - Bufbyte *envvar_internal = XSTRING_DATA (XCAR (tail)); - - GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (envvar_internal, envvar_external); - - /* See if envvar_external duplicates any string already in the env. - If so, don't put it in. - When an env var has multiple definitions, - we keep the definition that comes first in process-environment. */ - for (; ep != new_env; ep++) - { - char *p = *ep, *q = envvar_external; - while (1) - { - if (*q == 0) - /* The string is malformed; might as well drop it. */ - goto duplicate; - if (*q != *p) - break; - if (*q == '=') - goto duplicate; - p++, q++; - } - } - if (pwd && !strncmp ("PWD=", envvar_external, 4)) - { - *new_env++ = pwd; - pwd = 0; - } - else - *new_env++ = envvar_external; - - duplicate: ; - } - *new_env = 0; - } - -#ifdef WINDOWSNT - prepare_standard_handles (in, out, err, handles); - set_process_dir (current_dir); -#else /* not WINDOWSNT */ - /* Make sure that in, out, and err are not actually already in - descriptors zero, one, or two; this could happen if Emacs is - started with its standard in, out, or error closed, as might - happen under X. */ - in = relocate_fd (in, 3); - out = relocate_fd (out, 3); - err = relocate_fd (err, 3); - - /* Set the standard input/output channels of the new process. */ - close (STDIN_FILENO); - close (STDOUT_FILENO); - close (STDERR_FILENO); - - dup2 (in, STDIN_FILENO); - dup2 (out, STDOUT_FILENO); - dup2 (err, STDERR_FILENO); - - close (in); - close (out); - close (err); - - /* I can't think of any reason why child processes need any more - than the standard 3 file descriptors. It would be cleaner to - close just the ones that need to be, but the following brute - force approach is certainly effective, and not too slow. */ - { - int fd; - for (fd=3; fd<=64; fd++) - close (fd); - } -#endif /* not WINDOWSNT */ - -#ifdef vipc - something missing here; -#endif /* vipc */ - -#ifdef WINDOWSNT - /* Spawn the child. (See ntproc.c:Spawnve). */ - cpid = spawnve (_P_NOWAIT, new_argv[0], new_argv, env); - if (cpid == -1) - /* An error occurred while trying to spawn the process. */ - report_file_error ("Spawning child process", Qnil); - reset_standard_handles (in, out, err, handles); - return cpid; -#else /* not WINDOWSNT */ - /* execvp does not accept an environment arg so the only way - to pass this environment is to set environ. Our caller - is responsible for restoring the ambient value of environ. */ - environ = env; - execvp (new_argv[0], new_argv); - - stdout_out ("Can't exec program %s\n", new_argv[0]); - _exit (1); -#endif /* not WINDOWSNT */ -} - -static int -getenv_internal (CONST Bufbyte *var, - Bytecount varlen, - Bufbyte **value, - Bytecount *valuelen) -{ - Lisp_Object scan; - - for (scan = Vprocess_environment; CONSP (scan); scan = XCDR (scan)) - { - Lisp_Object entry = XCAR (scan); - - if (STRINGP (entry) - && XSTRING_LENGTH (entry) > varlen - && XSTRING_BYTE (entry, varlen) == '=' -#ifdef WINDOWSNT - /* NT environment variables are case insensitive. */ - && ! memicmp (XSTRING_DATA (entry), var, varlen) -#else /* not WINDOWSNT */ - && ! memcmp (XSTRING_DATA (entry), var, varlen) -#endif /* not WINDOWSNT */ - ) - { - *value = XSTRING_DATA (entry) + (varlen + 1); - *valuelen = XSTRING_LENGTH (entry) - (varlen + 1); - return 1; - } - } - - return 0; -} - -DEFUN ("getenv", Fgetenv, 1, 2, "sEnvironment variable: \np", /* -Return the value of environment variable VAR, as a string. -VAR is a string, the name of the variable. -When invoked interactively, prints the value in the echo area. -*/ - (var, interactivep)) -{ - Bufbyte *value; - Bytecount valuelen; - Lisp_Object v = Qnil; - struct gcpro gcpro1; - - CHECK_STRING (var); - GCPRO1 (v); - if (getenv_internal (XSTRING_DATA (var), XSTRING_LENGTH (var), - &value, &valuelen)) - v = make_string (value, valuelen); - if (!NILP (interactivep)) - { - if (NILP (v)) - message ("%s not defined in environment", XSTRING_DATA (var)); - else - /* #### Should use Fprin1_to_string or Fprin1 to handle string - containing quotes correctly. */ - message ("\"%s\"", value); - } - RETURN_UNGCPRO (v); -} - -/* A version of getenv that consults process_environment, easily - callable from C. */ -char * -egetenv (CONST char *var) -{ - Bufbyte *value; - Bytecount valuelen; - - if (getenv_internal ((CONST Bufbyte *) var, strlen (var), &value, &valuelen)) - return (char *) value; - else - return 0; -} - - -void -init_callproc (void) -{ - /* This function can GC */ - - { - /* jwz: always initialize Vprocess_environment, so that egetenv() - works in temacs. */ - char **envp; - Vprocess_environment = Qnil; - for (envp = environ; envp && *envp; envp++) - { - Vprocess_environment = Fcons (build_ext_string (*envp, FORMAT_OS), - Vprocess_environment); - } - } - - { - /* Initialize shell-file-name from environment variables or best guess. */ -#ifdef WINDOWSNT - CONST char *shell = egetenv ("COMSPEC"); - if (!shell) shell = "\\WINNT\\system32\\cmd.exe"; -#else /* not WINDOWSNT */ - CONST char *shell = egetenv ("SHELL"); - if (!shell) shell = "/bin/sh"; -#endif - - Vshell_file_name = build_string (shell); - } -} - -#if 0 -void -set_process_environment (void) -{ - REGISTER char **envp; - - Vprocess_environment = Qnil; -#ifndef CANNOT_DUMP - if (initialized) -#endif - for (envp = environ; *envp; envp++) - Vprocess_environment = Fcons (build_string (*envp), - Vprocess_environment); -} -#endif /* unused */ - -void -syms_of_callproc (void) -{ - DEFSUBR (Fcall_process_internal); - DEFSUBR (Fgetenv); -} - -void -vars_of_callproc (void) -{ - /* This function can GC */ -#ifdef DOS_NT - DEFVAR_LISP ("binary-process-input", &Vbinary_process_input /* -*If non-nil then new subprocesses are assumed to take binary input. -*/ ); - Vbinary_process_input = Qnil; - - DEFVAR_LISP ("binary-process-output", &Vbinary_process_output /* -*If non-nil then new subprocesses are assumed to produce binary output. -*/ ); - Vbinary_process_output = Qnil; -#endif /* DOS_NT */ - - DEFVAR_LISP ("shell-file-name", &Vshell_file_name /* -*File name to load inferior shells from. -Initialized from the SHELL environment variable. -*/ ); - - DEFVAR_LISP ("process-environment", &Vprocess_environment /* -List of environment variables for subprocesses to inherit. -Each element should be a string of the form ENVVARNAME=VALUE. -The environment which Emacs inherits is placed in this variable -when Emacs starts. -*/ ); -} diff --git a/src/casefiddle.c b/src/casefiddle.c deleted file mode 100644 index b8a9d1c..0000000 --- a/src/casefiddle.c +++ /dev/null @@ -1,342 +0,0 @@ -/* XEmacs case conversion functions. - Copyright (C) 1985, 1992, 1993, 1994, 1997, 1998 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: FSF 19.34, but substantially rewritten by Martin. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "insdel.h" -#include "syntax.h" - -enum case_action {CASE_UP, CASE_DOWN, CASE_CAPITALIZE, CASE_CAPITALIZE_UP}; - -static Lisp_Object -casify_object (enum case_action flag, Lisp_Object obj, Lisp_Object buffer) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - retry: - - if (CHAR_OR_CHAR_INTP (obj)) - { - Emchar c; - CHECK_CHAR_COERCE_INT (obj); - c = XCHAR (obj); - c = (flag == CASE_DOWN) ? DOWNCASE (buf, c) : UPCASE (buf, c); - return make_char (c); - } - - if (STRINGP (obj)) - { - struct Lisp_Char_Table *syntax_table = - XCHAR_TABLE (buf->mirror_syntax_table); - Bufbyte *storage = - alloca_array (Bufbyte, XSTRING_LENGTH (obj) * MAX_EMCHAR_LEN); - Bufbyte *newp = storage; - Bufbyte *oldp = XSTRING_DATA (obj); - int wordp = 0, wordp_prev; - - while (*oldp) - { - Emchar c = charptr_emchar (oldp); - switch (flag) - { - case CASE_UP: - c = UPCASE (buf, c); - break; - case CASE_DOWN: - c = DOWNCASE (buf, c); - break; - case CASE_CAPITALIZE: - case CASE_CAPITALIZE_UP: - wordp_prev = wordp; - wordp = WORD_SYNTAX_P (syntax_table, c); - if (!wordp) break; - if (wordp_prev) - { - if (flag == CASE_CAPITALIZE) - c = DOWNCASE (buf, c); - } - else - c = UPCASE (buf, c); - break; - } - - newp += set_charptr_emchar (newp, c); - INC_CHARPTR (oldp); - } - - return make_string (storage, newp - storage); - } - - obj = wrong_type_argument (Qchar_or_string_p, obj); - goto retry; -} - -DEFUN ("upcase", Fupcase, 1, 2, 0, /* -Convert OBJECT to upper case and return that. -OBJECT may be a character or string. The result has the same type. -OBJECT is not altered--the value is a copy. -See also `capitalize', `downcase' and `upcase-initials'. -Optional second arg BUFFER specifies which buffer's case tables to use, - and defaults to the current buffer. -*/ - (object, buffer)) -{ - return casify_object (CASE_UP, object, buffer); -} - -DEFUN ("downcase", Fdowncase, 1, 2, 0, /* -Convert OBJECT to lower case and return that. -OBJECT may be a character or string. The result has the same type. -OBJECT is not altered--the value is a copy. -Optional second arg BUFFER specifies which buffer's case tables to use, - and defaults to the current buffer. -*/ - (object, buffer)) -{ - return casify_object (CASE_DOWN, object, buffer); -} - -DEFUN ("capitalize", Fcapitalize, 1, 2, 0, /* -Convert OBJECT to capitalized form and return that. -This means that each word's first character is upper case -and the rest is lower case. -OBJECT may be a character or string. The result has the same type. -OBJECT is not altered--the value is a copy. -Optional second arg BUFFER specifies which buffer's case tables to use, - and defaults to the current buffer. -*/ - (object, buffer)) -{ - return casify_object (CASE_CAPITALIZE, object, buffer); -} - -/* Like Fcapitalize but change only the initial characters. */ - -DEFUN ("upcase-initials", Fupcase_initials, 1, 2, 0, /* -Convert the initial of each word in OBJECT to upper case. -Do not change the other letters of each word. -OBJECT may be a character or string. The result has the same type. -OBJECT is not altered--the value is a copy. -Optional second arg BUFFER specifies which buffer's case tables to use, - and defaults to the current buffer. -*/ - (object, buffer)) -{ - return casify_object (CASE_CAPITALIZE_UP, object, buffer); -} - -/* flag is CASE_UP, CASE_DOWN or CASE_CAPITALIZE or CASE_CAPITALIZE_UP. - b and e specify range of buffer to operate on. */ - -static void -casify_region_internal (enum case_action flag, Lisp_Object b, Lisp_Object e, - struct buffer *buf) -{ - /* This function can GC */ - REGISTER Bufpos i; - Bufpos start, end; - struct Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); - int mccount; - Emchar oldc, c; - int wordp = 0, wordp_prev; - - if (EQ (b, e)) - /* Not modifying because nothing marked */ - return; - - get_buffer_range_char (buf, b, e, &start, &end, 0); - - mccount = begin_multiple_change (buf, start, end); - record_change (buf, start, end - start); - - for (i = start; i < end; i++) - { - c = oldc = BUF_FETCH_CHAR (buf, i); - - switch (flag) - { - case CASE_UP: - c = UPCASE (buf, oldc); - break; - case CASE_DOWN: - c = DOWNCASE (buf, oldc); - break; - case CASE_CAPITALIZE: - case CASE_CAPITALIZE_UP: - /* !!#### need to revalidate the start and end pointers in case - the buffer was changed */ - wordp_prev = wordp; - wordp = WORD_SYNTAX_P (syntax_table, c); - if (!wordp) continue; - if (wordp_prev) - { - if (flag == CASE_CAPITALIZE) - c = DOWNCASE (buf, c); - } - else - c = UPCASE (buf, c); - break; - } - - if (oldc == c) continue; - buffer_replace_char (buf, i, c, 1, (i == start)); - BUF_MODIFF (buf)++; - } - - end_multiple_change (buf, mccount); -} - -static Lisp_Object -casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e, - Lisp_Object buffer) -{ - casify_region_internal (flag, b, e, decode_buffer (buffer, 1)); - return Qnil; -} - -DEFUN ("upcase-region", Fupcase_region, 2, 3, "r", /* -Convert the region to upper case. In programs, wants two arguments. -These arguments specify the starting and ending character numbers of - the region to operate on. When used as a command, the text between - point and the mark is operated on. -See also `capitalize-region'. -Optional third arg BUFFER defaults to the current buffer. -*/ - (b, e, buffer)) -{ - /* This function can GC */ - return casify_region (CASE_UP, b, e, buffer); -} - -DEFUN ("downcase-region", Fdowncase_region, 2, 3, "r", /* -Convert the region to lower case. In programs, wants two arguments. -These arguments specify the starting and ending character numbers of - the region to operate on. When used as a command, the text between - point and the mark is operated on. -Optional third arg BUFFER defaults to the current buffer. -*/ - (b, e, buffer)) -{ - /* This function can GC */ - return casify_region (CASE_DOWN, b, e, buffer); -} - -DEFUN ("capitalize-region", Fcapitalize_region, 2, 3, "r", /* -Convert the region to capitalized form. -Capitalized form means each word's first character is upper case - and the rest of it is lower case. -In programs, give two arguments, the starting and ending - character positions to operate on. -Optional third arg BUFFER defaults to the current buffer. -*/ - (b, e, buffer)) -{ - /* This function can GC */ - return casify_region (CASE_CAPITALIZE, b, e, buffer); -} - -/* Like Fcapitalize_region but change only the initials. */ - -DEFUN ("upcase-initials-region", Fupcase_initials_region, 2, 3, "r", /* -Upcase the initial of each word in the region. -Subsequent letters of each word are not changed. -In programs, give two arguments, the starting and ending - character positions to operate on. -Optional third arg BUFFER defaults to the current buffer. -*/ - (b, e, buffer)) -{ - return casify_region (CASE_CAPITALIZE_UP, b, e, buffer); -} - - -static Lisp_Object -casify_word (enum case_action flag, Lisp_Object arg, Lisp_Object buffer) -{ - Bufpos farend; - struct buffer *buf = decode_buffer (buffer, 1); - - CHECK_INT (arg); - - farend = scan_words (buf, BUF_PT (buf), XINT (arg)); - if (!farend) - farend = XINT (arg) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); - - casify_region_internal (flag, make_int (BUF_PT (buf)), make_int (farend), buf); - BUF_SET_PT (buf, max (BUF_PT (buf), farend)); - return Qnil; -} - -DEFUN ("upcase-word", Fupcase_word, 1, 2, "p", /* -Convert following word (or N words) to upper case, moving over. -With negative argument, convert previous words but do not move. -See also `capitalize-word'. -Optional second arg BUFFER defaults to the current buffer. -*/ - (n, buffer)) -{ - /* This function can GC */ - return casify_word (CASE_UP, n, buffer); -} - -DEFUN ("downcase-word", Fdowncase_word, 1, 2, "p", /* -Convert following word (or N words) to lower case, moving over. -With negative argument, convert previous words but do not move. -Optional second arg BUFFER defaults to the current buffer. -*/ - (n, buffer)) -{ - /* This function can GC */ - return casify_word (CASE_DOWN, n, buffer); -} - -DEFUN ("capitalize-word", Fcapitalize_word, 1, 2, "p", /* -Capitalize the following word (or N words), moving over. -This gives the word(s) a first character in upper case - and the rest lower case. -With negative argument, capitalize previous words but do not move. -Optional second arg BUFFER defaults to the current buffer. -*/ - (n, buffer)) -{ - /* This function can GC */ - return casify_word (CASE_CAPITALIZE, n, buffer); -} - - -void -syms_of_casefiddle (void) -{ - DEFSUBR (Fupcase); - DEFSUBR (Fdowncase); - DEFSUBR (Fcapitalize); - DEFSUBR (Fupcase_initials); - DEFSUBR (Fupcase_region); - DEFSUBR (Fdowncase_region); - DEFSUBR (Fcapitalize_region); - DEFSUBR (Fupcase_initials_region); - DEFSUBR (Fupcase_word); - DEFSUBR (Fdowncase_word); - DEFSUBR (Fcapitalize_word); -} diff --git a/src/casetab.c b/src/casetab.c deleted file mode 100644 index ff9443c..0000000 --- a/src/casetab.c +++ /dev/null @@ -1,349 +0,0 @@ -/* XEmacs routines to deal with case tables. - Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c - was rewritten to use junky FSF char tables. Meanwhile I rewrote it - to use more logical char tables. RMS also discards the "list of four - tables" format and instead stuffs the other tables as "extra slots" - in the downcase table. I've kept the four-lists format for now. */ - -/* Written by Howard Gayle. See some mythical and not-in-the-Emacs- - distribution file chartab.c for details. */ - -/* Modified for Mule by Ben Wing. */ - -/* #### We do not currently deal properly with translating non-ASCII - (including Latin-1!) characters under Mule. Getting this right is - *hard*, way fucking hard. So we at least preserve consistency by - sanitizing all the case tables to remove translations that would - get us into trouble and possibly result in inconsistent internal - text, which would likely lead to crashes. */ - -#include -#include "lisp.h" -#include "buffer.h" -#include "opaque.h" - -Lisp_Object Qcase_table_p; -Lisp_Object Vascii_downcase_table, Vascii_upcase_table; -Lisp_Object Vascii_canon_table, Vascii_eqv_table; -#ifdef MULE -Lisp_Object Vmirror_ascii_downcase_table, Vmirror_ascii_upcase_table; -Lisp_Object Vmirror_ascii_canon_table, Vmirror_ascii_eqv_table; -#endif -Lisp_Object Qtranslate_table; - -static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse); - -#define STRING256_P(obj) (STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256) - -DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /* -Return t if ARG is a case table. -See `set-case-table' for more information on these data structures. -*/ - (table)) -{ - Lisp_Object down, up, canon, eqv; - if (!CONSP (table)) return Qnil; down = XCAR (table); table = XCDR (table); - if (!CONSP (table)) return Qnil; up = XCAR (table); table = XCDR (table); - if (!CONSP (table)) return Qnil; canon = XCAR (table); table = XCDR (table); - if (!CONSP (table)) return Qnil; eqv = XCAR (table); - - return (STRING256_P (down) - && (NILP (up) || STRING256_P (up)) - && ((NILP (canon) && NILP (eqv)) - || (STRING256_P (canon) - && (NILP (eqv) || STRING256_P (eqv)))) - ? Qt : Qnil); -} - -static Lisp_Object -check_case_table (Lisp_Object obj) -{ - REGISTER Lisp_Object tem; - - while (tem = Fcase_table_p (obj), NILP (tem)) - obj = wrong_type_argument (Qcase_table_p, obj); - return (obj); -} - -DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* -Return the case table of BUFFER, which defaults to the current buffer. -*/ - (buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - - return list4 (buf->downcase_table, - buf->upcase_table, - buf->case_canon_table, - buf->case_eqv_table); -} - -DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /* -Return the standard case table. -This is the one used for new buffers. -*/ - ()) -{ - return list4 (Vascii_downcase_table, - Vascii_upcase_table, - Vascii_canon_table, - Vascii_eqv_table); -} - -static Lisp_Object set_case_table (Lisp_Object table, int standard); - - -DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* -Select a new case table for the current buffer. -A case table is a list (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES) - where each element is either nil or a string of length 256. -DOWNCASE maps each character to its lower-case equivalent. -UPCASE maps each character to its upper-case equivalent; - if lower and upper case characters are in 1-1 correspondence, - you may use nil and the upcase table will be deduced from DOWNCASE. -CANONICALIZE maps each character to a canonical equivalent; - any two characters that are related by case-conversion have the same - canonical equivalent character; it may be nil, in which case it is - deduced from DOWNCASE and UPCASE. -EQUIVALENCES is a map that cyclicly permutes each equivalence class - (of characters with the same canonical equivalent); it may be nil, - in which case it is deduced from CANONICALIZE. - -BUG: Under XEmacs/Mule, translations to or from non-ASCII characters - (this includes chars in the range 128 - 255) are ignored by - the string/buffer-searching routines. Thus, `case-fold-search' - will not correctly conflate a-umlaut and A-umlaut even if the - case tables call for this. -*/ - (table)) -{ - return set_case_table (table, 0); -} - -DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /* -Select a new standard case table for new buffers. -See `set-case-table' for more info on case tables. -*/ - (table)) -{ - return set_case_table (table, 1); -} - -#ifdef MULE - -static Lisp_Object -make_mirror_trt_table (Lisp_Object table) -{ - Lisp_Object new_table; - - if (!STRING256_P (table)) - { -#ifdef DEBUG_XEMACS - /* This should be caught farther up. */ - abort (); -#else - signal_simple_error ("Invalid translate table", table); -#endif - } - - new_table = MAKE_MIRROR_TRT_TABLE (); - { - int i; - - for (i = 0; i < 256; i++) - { - Emchar newval = string_char (XSTRING (table), i); - if ((i >= 128 && newval != i) - || (i < 128 && newval >= 128)) - { - newval = (Emchar) i; - } - SET_MIRROR_TRT_TABLE_CHAR_1 (new_table, i, newval); - } - } - return new_table; -} - -#endif /* MULE */ - -static Lisp_Object -set_case_table (Lisp_Object table, int standard) -{ - Lisp_Object down, up, canon, eqv, tail = table; - struct buffer *buf = current_buffer; - - check_case_table (table); - - down = XCAR (tail); tail = XCDR (tail); - up = XCAR (tail); tail = XCDR (tail); - canon = XCAR (tail); tail = XCDR (tail); - eqv = XCAR (tail); - - if (NILP (up)) - { - up = MAKE_TRT_TABLE (); - compute_trt_inverse (down, up); - } - - if (NILP (canon)) - { - REGISTER Charcount i; - - canon = MAKE_TRT_TABLE (); - - /* Set up the CANON vector; for each character, - this sequence of upcasing and downcasing ought to - get the "preferred" lowercase equivalent. */ - for (i = 0; i < 256; i++) - SET_TRT_TABLE_CHAR_1 (canon, i, - TRT_TABLE_CHAR_1 - (down, - TRT_TABLE_CHAR_1 - (up, - TRT_TABLE_CHAR_1 (down, i)))); - } - - if (NILP (eqv)) - { - eqv = MAKE_TRT_TABLE (); - - compute_trt_inverse (canon, eqv); - } - - if (standard) - { - Vascii_downcase_table = down; - Vascii_upcase_table = up; - Vascii_canon_table = canon; - Vascii_eqv_table = eqv; -#ifdef MULE - Vmirror_ascii_downcase_table = make_mirror_trt_table (down); - Vmirror_ascii_upcase_table = make_mirror_trt_table (up); - Vmirror_ascii_canon_table = make_mirror_trt_table (canon); - Vmirror_ascii_eqv_table = make_mirror_trt_table (eqv); -#endif - } - else - { - buf->downcase_table = down; - buf->upcase_table = up; - buf->case_canon_table = canon; - buf->case_eqv_table = eqv; -#ifdef MULE - buf->mirror_downcase_table = make_mirror_trt_table (down); - buf->mirror_upcase_table = make_mirror_trt_table (up); - buf->mirror_case_canon_table = make_mirror_trt_table (canon); - buf->mirror_case_eqv_table = make_mirror_trt_table (eqv); -#endif - } - return table; -} - -/* Given a translate table TRT, store the inverse mapping into INVERSE. - Since TRT is not one-to-one, INVERSE is not a simple mapping. - Instead, it divides the space of characters into equivalence classes. - All characters in a given class form one circular list, chained through - the elements of INVERSE. */ - -static void -compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse) -{ - Charcount i = 0400; - Emchar c, q; - - while (--i) - SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i); - i = 0400; - while (--i) - { - if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i) - { - c = TRT_TABLE_CHAR_1 (inverse, q); - SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i); - SET_TRT_TABLE_CHAR_1 (inverse, i, c); - } - } -} - - -void -syms_of_casetab (void) -{ - defsymbol (&Qcase_table_p, "case-table-p"); - defsymbol (&Qtranslate_table, "translate-table"); - - DEFSUBR (Fcase_table_p); - DEFSUBR (Fcurrent_case_table); - DEFSUBR (Fstandard_case_table); - DEFSUBR (Fset_case_table); - DEFSUBR (Fset_standard_case_table); -} - -void -complex_vars_of_casetab (void) -{ - REGISTER Emchar i; - Lisp_Object tem; - - staticpro (&Vascii_downcase_table); - staticpro (&Vascii_upcase_table); - staticpro (&Vascii_canon_table); - staticpro (&Vascii_eqv_table); - - tem = MAKE_TRT_TABLE (); - Vascii_downcase_table = tem; - Vascii_canon_table = tem; - - /* Under Mule, can't do set_string_char() until Vcharset_control_1 - and Vcharset_ascii are initialized. */ - for (i = 0; i < 256; i++) - { - unsigned char lowered = tolower (i); - - SET_TRT_TABLE_CHAR_1 (tem, i, lowered); - } - -#ifdef MULE - tem = make_mirror_trt_table (tem); - Vmirror_ascii_downcase_table = tem; - Vmirror_ascii_canon_table = tem; -#endif - - tem = MAKE_TRT_TABLE (); - Vascii_upcase_table = tem; - Vascii_eqv_table = tem; - - for (i = 0; i < 256; i++) - { - unsigned char flipped = (isupper (i) ? tolower (i) - : (islower (i) ? toupper (i) : i)); - - SET_TRT_TABLE_CHAR_1 (tem, i, flipped); - } - -#ifdef MULE - tem = make_mirror_trt_table (tem); - Vmirror_ascii_upcase_table = tem; - Vmirror_ascii_eqv_table = tem; -#endif -} diff --git a/src/chartab.c b/src/chartab.c deleted file mode 100644 index 996027d..0000000 --- a/src/chartab.c +++ /dev/null @@ -1,1779 +0,0 @@ -/* XEmacs routines to deal with char tables. - Copyright (C) 1992, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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: Mule 2.3. Not synched with FSF. - - This file was written independently of the FSF implementation, - and is not compatible. */ - -/* Authorship: - - Ben Wing: wrote, for 19.13 (Mule). Some category table stuff - loosely based on the original Mule. - Jareth Hein: fixed a couple of bugs in the implementation, and - added regex support for categories with check_category_at - */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "chartab.h" -#include "syntax.h" - -Lisp_Object Qchar_tablep, Qchar_table; - -Lisp_Object Vall_syntax_tables; - -#ifdef MULE -Lisp_Object Qcategory_table_p; -Lisp_Object Qcategory_designator_p; -Lisp_Object Qcategory_table_value_p; - -Lisp_Object Vstandard_category_table; -#endif /* MULE */ - - -/* A char table maps from ranges of characters to values. - - Implementing a general data structure that maps from arbitrary - ranges of numbers to values is tricky to do efficiently. As it - happens, it should suffice (and is usually more convenient, anyway) - when dealing with characters to restrict the sorts of ranges that - can be assigned values, as follows: - - 1) All characters. - 2) All characters in a charset. - 3) All characters in a particular row of a charset, where a "row" - means all characters with the same first byte. - 4) A particular character in a charset. - - We use char tables to generalize the 256-element vectors now - littering the Emacs code. - - Possible uses (all should be converted at some point): - - 1) category tables - 2) syntax tables - 3) display tables - 4) case tables - 5) keyboard-translate-table? - - We provide an - abstract type to generalize the Emacs vectors and Mule - vectors-of-vectors goo. - */ - -/************************************************************************/ -/* Char Table object */ -/************************************************************************/ - -#ifdef MULE - -static Lisp_Object -mark_char_table_entry (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); - int i; - - for (i = 0; i < 96; i++) - { - markobj (cte->level2[i]); - } - return Qnil; -} - -static int -char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); - struct Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); - int i; - - for (i = 0; i < 96; i++) - if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1)) - return 0; - - return 1; -} - -static unsigned long -char_table_entry_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); - - return internal_array_hash (cte->level2, 96, depth); -} - -DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry, - mark_char_table_entry, internal_object_printer, - 0, char_table_entry_equal, - char_table_entry_hash, - struct Lisp_Char_Table_Entry); -#endif /* MULE */ - -static Lisp_Object -mark_char_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); - int i; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - markobj (ct->ascii[i]); -#ifdef MULE - for (i = 0; i < NUM_LEADING_BYTES; i++) - markobj (ct->level1[i]); -#endif - return ct->mirror_table; -} - -/* WARNING: All functions of this nature need to be written extremely - carefully to avoid crashes during GC. Cf. prune_specifiers() - and prune_weak_hash_tables(). */ - -void -prune_syntax_tables (int (*obj_marked_p) (Lisp_Object)) -{ - Lisp_Object rest, prev = Qnil; - - for (rest = Vall_syntax_tables; - !GC_NILP (rest); - rest = XCHAR_TABLE (rest)->next_table) - { - if (! obj_marked_p (rest)) - { - /* This table is garbage. Remove it from the list. */ - if (GC_NILP (prev)) - Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; - else - XCHAR_TABLE (prev)->next_table = - XCHAR_TABLE (rest)->next_table; - } - } -} - -static Lisp_Object -char_table_type_to_symbol (enum char_table_type type) -{ - switch (type) - { - default: abort(); - case CHAR_TABLE_TYPE_GENERIC: return Qgeneric; - case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax; - case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay; - case CHAR_TABLE_TYPE_CHAR: return Qchar; -#ifdef MULE - case CHAR_TABLE_TYPE_CATEGORY: return Qcategory; -#endif - } -} - -static enum char_table_type -symbol_to_char_table_type (Lisp_Object symbol) -{ - CHECK_SYMBOL (symbol); - - if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC; - if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX; - if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY; - if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR; -#ifdef MULE - if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; -#endif - - signal_simple_error ("Unrecognized char table type", symbol); - return CHAR_TABLE_TYPE_GENERIC; /* not reached */ -} - -static void -print_chartab_range (Emchar first, Emchar last, Lisp_Object val, - Lisp_Object printcharfun) -{ - if (first != last) - { - write_c_string (" (", printcharfun); - print_internal (make_char (first), printcharfun, 0); - write_c_string (" ", printcharfun); - print_internal (make_char (last), printcharfun, 0); - write_c_string (") ", printcharfun); - } - else - { - write_c_string (" ", printcharfun); - print_internal (make_char (first), printcharfun, 0); - write_c_string (" ", printcharfun); - } - print_internal (val, printcharfun, 1); -} - -#ifdef MULE - -static void -print_chartab_charset_row (Lisp_Object charset, - int row, - struct Lisp_Char_Table_Entry *cte, - Lisp_Object printcharfun) -{ - int i; - Lisp_Object cat = Qunbound; - int first = -1; - - for (i = 32; i < 128; i++) - { - Lisp_Object pam = cte->level2[i - 32]; - - if (first == -1) - { - first = i; - cat = pam; - continue; - } - - if (!EQ (cat, pam)) - { - if (row == -1) - print_chartab_range (MAKE_CHAR (charset, first, 0), - MAKE_CHAR (charset, i - 1, 0), - cat, printcharfun); - else - print_chartab_range (MAKE_CHAR (charset, row, first), - MAKE_CHAR (charset, row, i - 1), - cat, printcharfun); - first = -1; - i--; - } - } - - if (first != -1) - { - if (row == -1) - print_chartab_range (MAKE_CHAR (charset, first, 0), - MAKE_CHAR (charset, i - 1, 0), - cat, printcharfun); - else - print_chartab_range (MAKE_CHAR (charset, row, first), - MAKE_CHAR (charset, row, i - 1), - cat, printcharfun); - } -} - -static void -print_chartab_two_byte_charset (Lisp_Object charset, - struct Lisp_Char_Table_Entry *cte, - Lisp_Object printcharfun) -{ - int i; - - for (i = 32; i < 128; i++) - { - Lisp_Object jen = cte->level2[i - 32]; - - if (!CHAR_TABLE_ENTRYP (jen)) - { - char buf[100]; - - write_c_string (" [", printcharfun); - print_internal (XCHARSET_NAME (charset), printcharfun, 0); - sprintf (buf, " %d] ", i); - write_c_string (buf, printcharfun); - print_internal (jen, printcharfun, 0); - } - else - print_chartab_charset_row (charset, i, XCHAR_TABLE_ENTRY (jen), - printcharfun); - } -} - -#endif /* MULE */ - -static void -print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); - char buf[200]; - - sprintf (buf, "#s(char-table type %s data (", - string_data (symbol_name (XSYMBOL - (char_table_type_to_symbol (ct->type))))); - write_c_string (buf, printcharfun); - - /* Now write out the ASCII/Control-1 stuff. */ - { - int i; - int first = -1; - Lisp_Object val = Qunbound; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - { - if (first == -1) - { - first = i; - val = ct->ascii[i]; - continue; - } - - if (!EQ (ct->ascii[i], val)) - { - print_chartab_range (first, i - 1, val, printcharfun); - first = -1; - i--; - } - } - - if (first != -1) - print_chartab_range (first, i - 1, val, printcharfun); - } - -#ifdef MULE - { - int i; - - for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; - i++) - { - Lisp_Object ann = ct->level1[i - MIN_LEADING_BYTE]; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i); - - if (!CHARSETP (charset) || i == LEADING_BYTE_ASCII - || i == LEADING_BYTE_CONTROL_1) - continue; - if (!CHAR_TABLE_ENTRYP (ann)) - { - write_c_string (" ", printcharfun); - print_internal (XCHARSET_NAME (charset), - printcharfun, 0); - write_c_string (" ", printcharfun); - print_internal (ann, printcharfun, 0); - } - else - { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (ann); - if (XCHARSET_DIMENSION (charset) == 1) - print_chartab_charset_row (charset, -1, cte, printcharfun); - else - print_chartab_two_byte_charset (charset, cte, printcharfun); - } - } - } -#endif /* MULE */ - - write_c_string ("))", printcharfun); -} - -static int -char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); - struct Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); - int i; - - if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) - return 0; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1)) - return 0; - -#ifdef MULE - for (i = 0; i < NUM_LEADING_BYTES; i++) - if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1)) - return 0; -#endif /* MULE */ - - return 1; -} - -static unsigned long -char_table_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Char_Table *ct = XCHAR_TABLE (obj); - unsigned long hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, - depth); -#ifdef MULE - hashval = HASH2 (hashval, - internal_array_hash (ct->level1, NUM_LEADING_BYTES, depth)); -#endif /* MULE */ - return hashval; -} - -DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table, - mark_char_table, print_char_table, 0, - char_table_equal, char_table_hash, - struct Lisp_Char_Table); - -DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* -Return non-nil if OBJECT is a char table. - -A char table is a table that maps characters (or ranges of characters) -to values. Char tables are specialized for characters, only allowing -particular sorts of ranges to be assigned values. Although this -loses in generality, it makes for extremely fast (constant-time) -lookups, and thus is feasible for applications that do an extremely -large number of lookups (e.g. scanning a buffer for a character in -a particular syntax, where a lookup in the syntax table must occur -once per character). - -When Mule support exists, the types of ranges that can be assigned -values are - --- all characters --- an entire charset --- a single row in a two-octet charset --- a single character - -When Mule support is not present, the types of ranges that can be -assigned values are - --- all characters --- a single character - -To create a char table, use `make-char-table'. To modify a char -table, use `put-char-table' or `remove-char-table'. To retrieve the -value for a particular character, use `get-char-table'. See also -`map-char-table', `clear-char-table', `copy-char-table', -`valid-char-table-type-p', `char-table-type-list', `valid-char-table-value-p', -and `check-char-table-value'. -*/ - (object)) -{ - return CHAR_TABLEP (object) ? Qt : Qnil; -} - -DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* -Return a list of the recognized char table types. -See `valid-char-table-type-p'. -*/ - ()) -{ -#ifdef MULE - return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); -#else - return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); -#endif -} - -DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* -Return t if TYPE if a recognized char table type. - -Each char table type is used for a different purpose and allows different -sorts of values. The different char table types are - -`category' - Used for category tables, which specify the regexp categories - that a character is in. The valid values are nil or a - bit vector of 95 elements. Higher-level Lisp functions are - provided for working with category tables. Currently categories - and category tables only exist when Mule support is present. -`char' - A generalized char table, for mapping from one character to - another. Used for case tables, syntax matching tables, - `keyboard-translate-table', etc. The valid values are characters. -`generic' - An even more generalized char table, for mapping from a - character to anything. -`display' - Used for display tables, which specify how a particular character - is to appear when displayed. #### Not yet implemented. -`syntax' - Used for syntax tables, which specify the syntax of a particular - character. Higher-level Lisp functions are provided for - working with syntax tables. The valid values are integers. - -*/ - (type)) -{ - return (EQ (type, Qchar) || -#ifdef MULE - EQ (type, Qcategory) || -#endif - EQ (type, Qdisplay) || - EQ (type, Qgeneric) || - EQ (type, Qsyntax)) ? Qt : Qnil; -} - -DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* -Return the type of char table TABLE. -See `valid-char-table-type-p'. -*/ - (table)) -{ - CHECK_CHAR_TABLE (table); - return char_table_type_to_symbol (XCHAR_TABLE (table)->type); -} - -void -fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value) -{ - int i; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - ct->ascii[i] = value; -#ifdef MULE - for (i = 0; i < NUM_LEADING_BYTES; i++) - ct->level1[i] = value; -#endif /* MULE */ - - if (ct->type == CHAR_TABLE_TYPE_SYNTAX) - update_syntax_table (ct); -} - -DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* -Reset a char table to its default state. -*/ - (table)) -{ - struct Lisp_Char_Table *ct; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - - switch (ct->type) - { - case CHAR_TABLE_TYPE_CHAR: - fill_char_table (ct, make_char (0)); - break; - case CHAR_TABLE_TYPE_DISPLAY: - case CHAR_TABLE_TYPE_GENERIC: -#ifdef MULE - case CHAR_TABLE_TYPE_CATEGORY: -#endif /* MULE */ - fill_char_table (ct, Qnil); - break; - - case CHAR_TABLE_TYPE_SYNTAX: - fill_char_table (ct, make_int (Sinherit)); - break; - - default: - abort (); - } - - return Qnil; -} - -DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* -Return a new, empty char table of type TYPE. -Currently recognized types are 'char, 'category, 'display, 'generic, -and 'syntax. See `valid-char-table-type-p'. -*/ - (type)) -{ - struct Lisp_Char_Table *ct; - Lisp_Object obj; - enum char_table_type ty = symbol_to_char_table_type (type); - - ct = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); - ct->type = ty; - if (ty == CHAR_TABLE_TYPE_SYNTAX) - { - ct->mirror_table = Fmake_char_table (Qgeneric); - fill_char_table (XCHAR_TABLE (ct->mirror_table), - make_int (Spunct)); - } - else - ct->mirror_table = Qnil; - ct->next_table = Qnil; - XSETCHAR_TABLE (obj, ct); - if (ty == CHAR_TABLE_TYPE_SYNTAX) - { - ct->next_table = Vall_syntax_tables; - Vall_syntax_tables = obj; - } - Freset_char_table (obj); - return obj; -} - -#ifdef MULE - -static Lisp_Object -make_char_table_entry (Lisp_Object initval) -{ - Lisp_Object obj; - int i; - struct Lisp_Char_Table_Entry *cte = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - lrecord_char_table_entry); - - for (i = 0; i < 96; i++) - cte->level2[i] = initval; - - XSETCHAR_TABLE_ENTRY (obj, cte); - return obj; -} - -static Lisp_Object -copy_char_table_entry (Lisp_Object entry) -{ - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); - Lisp_Object obj; - int i; - struct Lisp_Char_Table_Entry *ctenew = - alloc_lcrecord_type (struct Lisp_Char_Table_Entry, - lrecord_char_table_entry); - - for (i = 0; i < 96; i++) - { - Lisp_Object new = cte->level2[i]; - if (CHAR_TABLE_ENTRYP (new)) - ctenew->level2[i] = copy_char_table_entry (new); - else - ctenew->level2[i] = new; - } - - XSETCHAR_TABLE_ENTRY (obj, ctenew); - return obj; -} - -#endif /* MULE */ - -DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* -Make a new char table which is a copy of OLD-TABLE. -It will contain the same values for the same characters and ranges -as OLD-TABLE. The values will not themselves be copied. -*/ - (old_table)) -{ - struct Lisp_Char_Table *ct, *ctnew; - Lisp_Object obj; - int i; - - CHECK_CHAR_TABLE (old_table); - ct = XCHAR_TABLE (old_table); - ctnew = alloc_lcrecord_type (struct Lisp_Char_Table, lrecord_char_table); - ctnew->type = ct->type; - - for (i = 0; i < NUM_ASCII_CHARS; i++) - { - Lisp_Object new = ct->ascii[i]; -#ifdef MULE - assert (! (CHAR_TABLE_ENTRYP (new))); -#endif /* MULE */ - ctnew->ascii[i] = new; - } - -#ifdef MULE - - for (i = 0; i < NUM_LEADING_BYTES; i++) - { - Lisp_Object new = ct->level1[i]; - if (CHAR_TABLE_ENTRYP (new)) - ctnew->level1[i] = copy_char_table_entry (new); - else - ctnew->level1[i] = new; - } - -#endif /* MULE */ - - if (CHAR_TABLEP (ct->mirror_table)) - ctnew->mirror_table = Fcopy_char_table (ct->mirror_table); - else - ctnew->mirror_table = ct->mirror_table; - XSETCHAR_TABLE (obj, ctnew); - return obj; -} - -static void -decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) -{ - if (EQ (range, Qt)) - outrange->type = CHARTAB_RANGE_ALL; - else if (CHAR_OR_CHAR_INTP (range)) - { - outrange->type = CHARTAB_RANGE_CHAR; - outrange->ch = XCHAR_OR_CHAR_INT (range); - } -#ifndef MULE - else - signal_simple_error ("Range must be t or a character", range); -#else /* MULE */ - else if (VECTORP (range)) - { - struct Lisp_Vector *vec = XVECTOR (range); - Lisp_Object *elts = vector_data (vec); - if (vector_length (vec) != 2) - signal_simple_error ("Length of charset row vector must be 2", - range); - outrange->type = CHARTAB_RANGE_ROW; - outrange->charset = Fget_charset (elts[0]); - CHECK_INT (elts[1]); - outrange->row = XINT (elts[1]); - switch (XCHARSET_TYPE (outrange->charset)) - { - case CHARSET_TYPE_94: - case CHARSET_TYPE_96: - signal_simple_error ("Charset in row vector must be multi-byte", - outrange->charset); - case CHARSET_TYPE_94X94: - check_int_range (outrange->row, 33, 126); - break; - case CHARSET_TYPE_96X96: - check_int_range (outrange->row, 32, 127); - break; - default: - abort (); - } - } - else - { - if (!CHARSETP (range) && !SYMBOLP (range)) - signal_simple_error - ("Char table range must be t, charset, char, or vector", range); - outrange->type = CHARTAB_RANGE_CHARSET; - outrange->charset = Fget_charset (range); - } -#endif /* MULE */ -} - -#ifdef MULE - -/* called from CHAR_TABLE_VALUE(). */ -Lisp_Object -get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, int leading_byte, - Emchar c) -{ - Lisp_Object val; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (leading_byte); - int byte1, byte2; - - BREAKUP_CHAR_1_UNSAFE (c, charset, byte1, byte2); - val = ct->level1[leading_byte - MIN_LEADING_BYTE]; - if (CHAR_TABLE_ENTRYP (val)) - { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); - val = cte->level2[byte1 - 32]; - if (CHAR_TABLE_ENTRYP (val)) - { - cte = XCHAR_TABLE_ENTRY (val); - assert (byte2 >= 32); - val = cte->level2[byte2 - 32]; - assert (!CHAR_TABLE_ENTRYP (val)); - } - } - - return val; -} - -#endif /* MULE */ - -Lisp_Object -get_char_table (Emchar ch, struct Lisp_Char_Table *ct) -{ -#ifdef MULE - { - Lisp_Object charset; - int byte1, byte2; - Lisp_Object val; - - BREAKUP_CHAR (ch, charset, byte1, byte2); - - if (EQ (charset, Vcharset_ascii)) - val = ct->ascii[byte1]; - else if (EQ (charset, Vcharset_control_1)) - val = ct->ascii[byte1 + 128]; - else - { - int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; - val = ct->level1[lb]; - if (CHAR_TABLE_ENTRYP (val)) - { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); - val = cte->level2[byte1 - 32]; - if (CHAR_TABLE_ENTRYP (val)) - { - cte = XCHAR_TABLE_ENTRY (val); - assert (byte2 >= 32); - val = cte->level2[byte2 - 32]; - assert (!CHAR_TABLE_ENTRYP (val)); - } - } - } - - return val; - } -#else /* not MULE */ - return ct->ascii[(unsigned char)ch]; -#endif /* not MULE */ -} - - -DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* -Find value for char CH in TABLE. -*/ - (ch, table)) -{ - struct Lisp_Char_Table *ct; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - CHECK_CHAR_COERCE_INT (ch); - - return get_char_table (XCHAR (ch), ct); -} - -DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* -Find value for a range in TABLE. -If there is more than one value, return MULTI (defaults to nil). -*/ - (range, table, multi)) -{ - struct Lisp_Char_Table *ct; - struct chartab_range rainj; - - if (CHAR_OR_CHAR_INTP (range)) - return Fget_char_table (range, table); - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - - decode_char_table_range (range, &rainj); - switch (rainj.type) - { - case CHARTAB_RANGE_ALL: - { - int i; - Lisp_Object first = ct->ascii[0]; - - for (i = 1; i < NUM_ASCII_CHARS; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - -#ifdef MULE - for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; - i++) - { - if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i)) - || i == LEADING_BYTE_ASCII - || i == LEADING_BYTE_CONTROL_1) - continue; - if (!EQ (first, ct->level1[i - MIN_LEADING_BYTE])) - return multi; - } -#endif /* MULE */ - - return first; - } - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - if (EQ (rainj.charset, Vcharset_ascii)) - { - int i; - Lisp_Object first = ct->ascii[0]; - - for (i = 1; i < 128; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - return first; - } - - if (EQ (rainj.charset, Vcharset_control_1)) - { - int i; - Lisp_Object first = ct->ascii[128]; - - for (i = 129; i < 160; i++) - if (!EQ (first, ct->ascii[i])) - return multi; - return first; - } - - { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - - MIN_LEADING_BYTE]; - if (CHAR_TABLE_ENTRYP (val)) - return multi; - return val; - } - - case CHARTAB_RANGE_ROW: - { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) - - MIN_LEADING_BYTE]; - if (!CHAR_TABLE_ENTRYP (val)) - return val; - val = XCHAR_TABLE_ENTRY (val)->level2[rainj.row - 32]; - if (CHAR_TABLE_ENTRYP (val)) - return multi; - return val; - } -#endif /* not MULE */ - - default: - abort (); - } - - return Qnil; /* not reached */ -} - -static int -check_valid_char_table_value (Lisp_Object value, enum char_table_type type, - Error_behavior errb) -{ - switch (type) - { - case CHAR_TABLE_TYPE_SYNTAX: - if (!ERRB_EQ (errb, ERROR_ME)) - return INTP (value) || (CONSP (value) && INTP (XCAR (value)) - && CHAR_OR_CHAR_INTP (XCDR (value))); - if (CONSP (value)) - { - Lisp_Object cdr = XCDR (value); - CHECK_INT (XCAR (value)); - CHECK_CHAR_COERCE_INT (cdr); - } - else - CHECK_INT (value); - break; - -#ifdef MULE - case CHAR_TABLE_TYPE_CATEGORY: - if (!ERRB_EQ (errb, ERROR_ME)) - return CATEGORY_TABLE_VALUEP (value); - CHECK_CATEGORY_TABLE_VALUE (value); - break; -#endif /* MULE */ - - case CHAR_TABLE_TYPE_GENERIC: - return 1; - - case CHAR_TABLE_TYPE_DISPLAY: - /* #### fix this */ - maybe_signal_simple_error ("Display char tables not yet implemented", - value, Qchar_table, errb); - return 0; - - case CHAR_TABLE_TYPE_CHAR: - if (!ERRB_EQ (errb, ERROR_ME)) - return CHAR_OR_CHAR_INTP (value); - CHECK_CHAR_COERCE_INT (value); - break; - - default: - abort (); - } - - return 0; /* not reached */ -} - -static Lisp_Object -canonicalize_char_table_value (Lisp_Object value, enum char_table_type type) -{ - switch (type) - { - case CHAR_TABLE_TYPE_SYNTAX: - if (CONSP (value)) - { - Lisp_Object car = XCAR (value); - Lisp_Object cdr = XCDR (value); - CHECK_CHAR_COERCE_INT (cdr); - return Fcons (car, cdr); - } - break; - case CHAR_TABLE_TYPE_CHAR: - CHECK_CHAR_COERCE_INT (value); - break; - default: - break; - } - return value; -} - -DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /* -Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE. -*/ - (value, char_table_type)) -{ - enum char_table_type type = symbol_to_char_table_type (char_table_type); - - return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil; -} - -DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /* -Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. -*/ - (value, char_table_type)) -{ - enum char_table_type type = symbol_to_char_table_type (char_table_type); - - check_valid_char_table_value (value, type, ERROR_ME); - return Qnil; -} - -/* Assign VAL to all characters in RANGE in char table CT. */ - -void -put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, - Lisp_Object val) -{ - switch (range->type) - { - case CHARTAB_RANGE_ALL: - fill_char_table (ct, val); - return; /* avoid the duplicate call to update_syntax_table() below, - since fill_char_table() also did that. */ - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - if (EQ (range->charset, Vcharset_ascii)) - { - int i; - for (i = 0; i < 128; i++) - ct->ascii[i] = val; - } - else if (EQ (range->charset, Vcharset_control_1)) - { - int i; - for (i = 128; i < 160; i++) - ct->ascii[i] = val; - } - else - { - int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; - ct->level1[lb] = val; - } - break; - - case CHARTAB_RANGE_ROW: - { - struct Lisp_Char_Table_Entry *cte; - int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; - /* make sure that there is a separate entry for the row. */ - if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) - ct->level1[lb] = make_char_table_entry (ct->level1[lb]); - cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); - cte->level2[range->row - 32] = val; - } - break; -#endif /* MULE */ - - case CHARTAB_RANGE_CHAR: -#ifdef MULE - { - Lisp_Object charset; - int byte1, byte2; - - BREAKUP_CHAR (range->ch, charset, byte1, byte2); - if (EQ (charset, Vcharset_ascii)) - ct->ascii[byte1] = val; - else if (EQ (charset, Vcharset_control_1)) - ct->ascii[byte1 + 128] = val; - else - { - struct Lisp_Char_Table_Entry *cte; - int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; - /* make sure that there is a separate entry for the row. */ - if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) - ct->level1[lb] = make_char_table_entry (ct->level1[lb]); - cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); - /* now CTE is a char table entry for the charset; - each entry is for a single row (or character of - a one-octet charset). */ - if (XCHARSET_DIMENSION (charset) == 1) - cte->level2[byte1 - 32] = val; - else - { - /* assigning to one character in a two-octet charset. */ - /* make sure that the charset row contains a separate - entry for each character. */ - if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32])) - cte->level2[byte1 - 32] = - make_char_table_entry (cte->level2[byte1 - 32]); - cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]); - cte->level2[byte2 - 32] = val; - } - } - } -#else /* not MULE */ - ct->ascii[(unsigned char) (range->ch)] = val; - break; -#endif /* not MULE */ - } - - if (ct->type == CHAR_TABLE_TYPE_SYNTAX) - update_syntax_table (ct); -} - -DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* -Set the value for chars in RANGE to be VAL in TABLE. - -RANGE specifies one or more characters to be affected and should be -one of the following: - --- t (all characters are affected) --- A charset (only allowed when Mule support is present) --- A vector of two elements: a two-octet charset and a row number - (only allowed when Mule support is present) --- A single character - -VAL must be a value appropriate for the type of TABLE. -See `valid-char-table-type-p'. -*/ - (range, val, table)) -{ - struct Lisp_Char_Table *ct; - struct chartab_range rainj; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - check_valid_char_table_value (val, ct->type, ERROR_ME); - decode_char_table_range (range, &rainj); - val = canonicalize_char_table_value (val, ct->type); - put_char_table (ct, &rainj, val); - return Qnil; -} - -/* Map FN over the ASCII chars in CT. */ - -static int -map_over_charset_ascii (struct Lisp_Char_Table *ct, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - struct chartab_range rainj; - int i, retval; - int start = 0; -#ifdef MULE - int stop = 128; -#else - int stop = 256; -#endif - - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = (Emchar) i; - retval = (fn) (&rainj, ct->ascii[i], arg); - } - - return retval; -} - -#ifdef MULE - -/* Map FN over the Control-1 chars in CT. */ - -static int -map_over_charset_control_1 (struct Lisp_Char_Table *ct, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - struct chartab_range rainj; - int i, retval; - int start = 128; - int stop = start + 32; - - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = (Emchar) (i); - retval = (fn) (&rainj, ct->ascii[i], arg); - } - - return retval; -} - -/* Map FN over the row ROW of two-byte charset CHARSET. - There must be a separate value for that row in the char table. - CTE specifies the char table entry for CHARSET. */ - -static int -map_over_charset_row (struct Lisp_Char_Table_Entry *cte, - Lisp_Object charset, int row, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - Lisp_Object val = cte->level2[row - 32]; - - if (!CHAR_TABLE_ENTRYP (val)) - { - struct chartab_range rainj; - - rainj.type = CHARTAB_RANGE_ROW; - rainj.charset = charset; - rainj.row = row; - return (fn) (&rainj, val, arg); - } - else - { - struct chartab_range rainj; - int i, retval; - int charset94_p = (XCHARSET_CHARS (charset) == 94); - int start = charset94_p ? 33 : 32; - int stop = charset94_p ? 127 : 128; - - cte = XCHAR_TABLE_ENTRY (val); - - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = MAKE_CHAR (charset, row, i); - retval = (fn) (&rainj, cte->level2[i - 32], arg); - } - return retval; - } -} - - -static int -map_over_other_charset (struct Lisp_Char_Table *ct, int lb, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb); - - if (!CHARSETP (charset) - || lb == LEADING_BYTE_ASCII - || lb == LEADING_BYTE_CONTROL_1) - return 0; - - if (!CHAR_TABLE_ENTRYP (val)) - { - struct chartab_range rainj; - - rainj.type = CHARTAB_RANGE_CHARSET; - rainj.charset = charset; - return (fn) (&rainj, val, arg); - } - - { - struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); - int charset94_p = (XCHARSET_CHARS (charset) == 94); - int start = charset94_p ? 33 : 32; - int stop = charset94_p ? 127 : 128; - int i, retval; - - if (XCHARSET_DIMENSION (charset) == 1) - { - struct chartab_range rainj; - rainj.type = CHARTAB_RANGE_CHAR; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - rainj.ch = MAKE_CHAR (charset, i, 0); - retval = (fn) (&rainj, cte->level2[i - 32], arg); - } - } - else - { - for (i = start, retval = 0; i < stop && retval == 0; i++) - retval = map_over_charset_row (cte, charset, i, fn, arg); - } - - return retval; - } -} - -#endif /* MULE */ - -/* Map FN (with client data ARG) over range RANGE in char table CT. - Mapping stops the first time FN returns non-zero, and that value - becomes the return value of map_char_table(). */ - -int -map_char_table (struct Lisp_Char_Table *ct, - struct chartab_range *range, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg) -{ - switch (range->type) - { - case CHARTAB_RANGE_ALL: - { - int retval; - - retval = map_over_charset_ascii (ct, fn, arg); - if (retval) - return retval; -#ifdef MULE - retval = map_over_charset_control_1 (ct, fn, arg); - if (retval) - return retval; - { - int i; - int start = MIN_LEADING_BYTE; - int stop = start + NUM_LEADING_BYTES; - - for (i = start, retval = 0; i < stop && retval == 0; i++) - { - retval = map_over_other_charset (ct, i, fn, arg); - } - } -#endif /* MULE */ - return retval; - } - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - return map_over_other_charset (ct, - XCHARSET_LEADING_BYTE (range->charset), - fn, arg); - - case CHARTAB_RANGE_ROW: - { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE]; - if (!CHAR_TABLE_ENTRYP (val)) - { - struct chartab_range rainj; - - rainj.type = CHARTAB_RANGE_ROW; - rainj.charset = range->charset; - rainj.row = range->row; - return (fn) (&rainj, val, arg); - } - else - return map_over_charset_row (XCHAR_TABLE_ENTRY (val), - range->charset, range->row, - fn, arg); - } -#endif /* MULE */ - - case CHARTAB_RANGE_CHAR: - { - Emchar ch = range->ch; - Lisp_Object val = CHAR_TABLE_VALUE_UNSAFE (ct, ch); - struct chartab_range rainj; - - rainj.type = CHARTAB_RANGE_CHAR; - rainj.ch = ch; - return (fn) (&rainj, val, arg); - } - - default: - abort (); - } - - return 0; -} - -struct slow_map_char_table_arg -{ - Lisp_Object function; - Lisp_Object retval; -}; - -static int -slow_map_char_table_fun (struct chartab_range *range, - Lisp_Object val, void *arg) -{ - Lisp_Object ranjarg = Qnil; - struct slow_map_char_table_arg *closure = - (struct slow_map_char_table_arg *) arg; - - switch (range->type) - { - case CHARTAB_RANGE_ALL: - ranjarg = Qt; - break; - -#ifdef MULE - case CHARTAB_RANGE_CHARSET: - ranjarg = XCHARSET_NAME (range->charset); - break; - - case CHARTAB_RANGE_ROW: - ranjarg = vector2 (XCHARSET_NAME (range->charset), - make_int (range->row)); - break; -#endif /* MULE */ - case CHARTAB_RANGE_CHAR: - ranjarg = make_char (range->ch); - break; - default: - abort (); - } - - closure->retval = call2 (closure->function, ranjarg, val); - return !NILP (closure->retval); -} - -DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* -Map FUNCTION over entries in TABLE, calling it with two args, -each key and value in the table. - -RANGE specifies a subrange to map over and is in the same format as -the RANGE argument to `put-range-table'. If omitted or t, it defaults to -the entire table. -*/ - (function, table, range)) -{ - struct Lisp_Char_Table *ct; - struct slow_map_char_table_arg slarg; - struct gcpro gcpro1, gcpro2; - struct chartab_range rainj; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - if (NILP (range)) - range = Qt; - decode_char_table_range (range, &rainj); - slarg.function = function; - slarg.retval = Qnil; - GCPRO2 (slarg.function, slarg.retval); - map_char_table (ct, &rainj, slow_map_char_table_fun, &slarg); - UNGCPRO; - - return slarg.retval; -} - - - -/************************************************************************/ -/* Char table read syntax */ -/************************************************************************/ - -static int -chartab_type_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - /* #### should deal with ERRB */ - symbol_to_char_table_type (value); - return 1; -} - -static int -chartab_data_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - Lisp_Object rest; - - /* #### should deal with ERRB */ - EXTERNAL_LIST_LOOP (rest, value) - { - Lisp_Object range = XCAR (rest); - struct chartab_range dummy; - - rest = XCDR (rest); - if (!CONSP (rest)) - signal_simple_error ("Invalid list format", value); - if (CONSP (range)) - { - if (!CONSP (XCDR (range)) - || !NILP (XCDR (XCDR (range)))) - signal_simple_error ("Invalid range format", range); - decode_char_table_range (XCAR (range), &dummy); - decode_char_table_range (XCAR (XCDR (range)), &dummy); - } - else - decode_char_table_range (range, &dummy); - } - - return 1; -} - -static Lisp_Object -chartab_instantiate (Lisp_Object data) -{ - Lisp_Object chartab; - Lisp_Object type = Qgeneric; - Lisp_Object dataval = Qnil; - - while (!NILP (data)) - { - Lisp_Object keyw = Fcar (data); - Lisp_Object valw; - - data = Fcdr (data); - valw = Fcar (data); - data = Fcdr (data); - if (EQ (keyw, Qtype)) - type = valw; - else if (EQ (keyw, Qdata)) - dataval = valw; - } - - chartab = Fmake_char_table (type); - - data = dataval; - while (!NILP (data)) - { - Lisp_Object range = Fcar (data); - Lisp_Object val = Fcar (Fcdr (data)); - - data = Fcdr (Fcdr (data)); - if (CONSP (range)) - { - if (CHAR_OR_CHAR_INTP (XCAR (range))) - { - Emchar first = XCHAR_OR_CHAR_INT (Fcar (range)); - Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range))); - Emchar i; - - for (i = first; i <= last; i++) - Fput_char_table (make_char (i), val, chartab); - } - else - abort (); - } - else - Fput_char_table (range, val, chartab); - } - - return chartab; -} - -#ifdef MULE - - -/************************************************************************/ -/* Category Tables, specifically */ -/************************************************************************/ - -DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /* -Return t if ARG is a category table. -A category table is a type of char table used for keeping track of -categories. Categories are used for classifying characters for use -in regexps -- you can refer to a category rather than having to use -a complicated [] expression (and category lookups are significantly -faster). - -There are 95 different categories available, one for each printable -character (including space) in the ASCII charset. Each category -is designated by one such character, called a "category designator". -They are specified in a regexp using the syntax "\\cX", where X is -a category designator. - -A category table specifies, for each character, the categories that -the character is in. Note that a character can be in more than one -category. More specifically, a category table maps from a character -to either the value nil (meaning the character is in no categories) -or a 95-element bit vector, specifying for each of the 95 categories -whether the character is in that category. - -Special Lisp functions are provided that abstract this, so you do not -have to directly manipulate bit vectors. -*/ - (obj)) -{ - return (CHAR_TABLEP (obj) && - XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_CATEGORY) ? - Qt : Qnil; -} - -static Lisp_Object -check_category_table (Lisp_Object obj, Lisp_Object def) -{ - if (NILP (obj)) - obj = def; - while (NILP (Fcategory_table_p (obj))) - obj = wrong_type_argument (Qcategory_table_p, obj); - return obj; -} - -int -check_category_char (Emchar ch, Lisp_Object table, - unsigned int designator, unsigned int not) -{ - REGISTER Lisp_Object temp; - struct Lisp_Char_Table *ctbl; -#ifdef ERROR_CHECK_TYPECHECK - if (NILP (Fcategory_table_p (table))) - signal_simple_error ("Expected category table", table); -#endif - ctbl = XCHAR_TABLE (table); - temp = get_char_table (ch, ctbl); - if (NILP (temp)) - return not; - - designator -= ' '; - return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not; -} - -DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* -Return t if category of a character at POS includes DESIGNATOR, -else return nil. Optional third arg specifies which buffer -\(defaulting to current), and fourth specifies the CATEGORY-TABLE, -\(defaulting to the buffer's category table). -*/ - (pos, designator, buffer, category_table)) -{ - Lisp_Object ctbl; - Emchar ch; - unsigned int des; - struct buffer *buf = decode_buffer (buffer, 0); - - CHECK_INT (pos); - CHECK_CATEGORY_DESIGNATOR (designator); - des = XCHAR (designator); - ctbl = check_category_table (category_table, Vstandard_category_table); - ch = BUF_FETCH_CHAR (buf, XINT (pos)); - return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; -} - -DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* -Return t if category of character CHR includes DESIGNATOR, else nil. -Optional third arg specifies the CATEGORY-TABLE to use, -which defaults to the system default table. -*/ - (chr, designator, category_table)) -{ - Lisp_Object ctbl; - Emchar ch; - unsigned int des; - - CHECK_CATEGORY_DESIGNATOR (designator); - des = XCHAR (designator); - CHECK_CHAR (chr); - ch = XCHAR (chr); - ctbl = check_category_table (category_table, Vstandard_category_table); - return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; -} - -DEFUN ("category-table", Fcategory_table, 0, 1, 0, /* -Return the current category table. -This is the one specified by the current buffer, or by BUFFER if it -is non-nil. -*/ - (buffer)) -{ - return decode_buffer (buffer, 0)->category_table; -} - -DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /* -Return the standard category table. -This is the one used for new buffers. -*/ - ()) -{ - return Vstandard_category_table; -} - -DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /* -Construct a new category table and return it. -It is a copy of the TABLE, which defaults to the standard category table. -*/ - (table)) -{ - if (NILP (Vstandard_category_table)) - return Fmake_char_table (Qcategory); - - table = check_category_table (table, Vstandard_category_table); - return Fcopy_char_table (table); -} - -DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /* -Select a new category table for BUFFER. -One argument, a category table. -BUFFER defaults to the current buffer if omitted. -*/ - (table, buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 0); - table = check_category_table (table, Qnil); - buf->category_table = table; - /* Indicate that this buffer now has a specified category table. */ - buf->local_var_flags |= XINT (buffer_local_flags.category_table); - return table; -} - -DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /* -Return t if ARG is a category designator (a char in the range ' ' to '~'). -*/ - (obj)) -{ - return CATEGORY_DESIGNATORP (obj) ? Qt : Qnil; -} - -DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /* -Return t if ARG is a category table value. -Valid values are nil or a bit vector of size 95. -*/ - (obj)) -{ - return CATEGORY_TABLE_VALUEP (obj) ? Qt : Qnil; -} - -#endif /* MULE */ - - -void -syms_of_chartab (void) -{ -#ifdef MULE - defsymbol (&Qcategory_table_p, "category-table-p"); - defsymbol (&Qcategory_designator_p, "category-designator-p"); - defsymbol (&Qcategory_table_value_p, "category-table-value-p"); -#endif /* MULE */ - - defsymbol (&Qchar_table, "char-table"); - defsymbol (&Qchar_tablep, "char-table-p"); - - DEFSUBR (Fchar_table_p); - DEFSUBR (Fchar_table_type_list); - DEFSUBR (Fvalid_char_table_type_p); - DEFSUBR (Fchar_table_type); - DEFSUBR (Freset_char_table); - DEFSUBR (Fmake_char_table); - DEFSUBR (Fcopy_char_table); - DEFSUBR (Fget_char_table); - DEFSUBR (Fget_range_char_table); - DEFSUBR (Fvalid_char_table_value_p); - DEFSUBR (Fcheck_valid_char_table_value); - DEFSUBR (Fput_char_table); - DEFSUBR (Fmap_char_table); - -#ifdef MULE - DEFSUBR (Fcategory_table_p); - DEFSUBR (Fcategory_table); - DEFSUBR (Fstandard_category_table); - DEFSUBR (Fcopy_category_table); - DEFSUBR (Fset_category_table); - DEFSUBR (Fcheck_category_at); - DEFSUBR (Fchar_in_category_p); - DEFSUBR (Fcategory_designator_p); - DEFSUBR (Fcategory_table_value_p); -#endif /* MULE */ - - /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ - Vall_syntax_tables = Qnil; -} - -void -structure_type_create_chartab (void) -{ - struct structure_type *st; - - st = define_structure_type (Qchar_table, 0, chartab_instantiate); - - define_structure_type_keyword (st, Qtype, chartab_type_validate); - define_structure_type_keyword (st, Qdata, chartab_data_validate); -} - -void -complex_vars_of_chartab (void) -{ -#ifdef MULE - /* Set this now, so first buffer creation can refer to it. */ - /* Make it nil before calling copy-category-table - so that copy-category-table will know not to try to copy from garbage */ - Vstandard_category_table = Qnil; - Vstandard_category_table = Fcopy_category_table (Qnil); - staticpro (&Vstandard_category_table); -#endif /* MULE */ -} diff --git a/src/chartab.h b/src/chartab.h deleted file mode 100644 index 2aa4931..0000000 --- a/src/chartab.h +++ /dev/null @@ -1,233 +0,0 @@ -/* Declarations having to do with Mule char tables. - Copyright (C) 1992 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: Mule 2.3. Not synched with FSF. - - This file was written independently of the FSF implementation, - and is not compatible. */ - -#ifndef _MULE_CHARTAB_H -#define _MULE_CHARTAB_H - -/************************************************************************/ -/* Char Tables */ -/************************************************************************/ - -/* Under Mule, we use a complex representation (see below). - When not under Mule, there are only 256 possible characters - so we just represent them directly. */ - -#ifdef MULE - -DECLARE_LRECORD (char_table_entry, struct Lisp_Char_Table_Entry); -#define XCHAR_TABLE_ENTRY(x) \ - XRECORD (x, char_table_entry, struct Lisp_Char_Table_Entry) -#define XSETCHAR_TABLE_ENTRY(x, p) XSETRECORD (x, p, char_table_entry) -#define CHAR_TABLE_ENTRYP(x) RECORDP (x, char_table_entry) -#define GC_CHAR_TABLE_ENTRYP(x) GC_RECORDP (x, char_table_entry) -/* #define CHECK_CHAR_TABLE_ENTRY(x) CHECK_RECORD (x, char_table_entry) - char table entries should never escape to Lisp */ - -struct Lisp_Char_Table_Entry -{ - struct lcrecord_header header; - - /* In the interests of simplicity, we just use a fixed 96-entry - table. If we felt like being smarter, we could make this - variable-size and add an offset value into this structure. */ - Lisp_Object level2[96]; -}; - -#endif /* MULE */ - -DECLARE_LRECORD (char_table, struct Lisp_Char_Table); -#define XCHAR_TABLE(x) \ - XRECORD (x, char_table, struct Lisp_Char_Table) -#define XSETCHAR_TABLE(x, p) XSETRECORD (x, p, char_table) -#define CHAR_TABLEP(x) RECORDP (x, char_table) -#define GC_CHAR_TABLEP(x) GC_RECORDP (x, char_table) -#define CHECK_CHAR_TABLE(x) CHECK_RECORD (x, char_table) -#define CONCHECK_CHAR_TABLE(x) CONCHECK_RECORD (x, char_table) - -#define CHAR_TABLE_TYPE(ct) ((ct)->type) -#define XCHAR_TABLE_TYPE(ct) CHAR_TABLE_TYPE (XCHAR_TABLE (ct)) - -enum char_table_type -{ - CHAR_TABLE_TYPE_GENERIC, -#ifdef MULE - CHAR_TABLE_TYPE_CATEGORY, -#endif - CHAR_TABLE_TYPE_SYNTAX, - CHAR_TABLE_TYPE_DISPLAY, - CHAR_TABLE_TYPE_CHAR -}; - -#ifdef MULE -#define NUM_ASCII_CHARS 160 -#else -#define NUM_ASCII_CHARS 256 -#endif - -struct Lisp_Char_Table -{ - struct lcrecord_header header; - - Lisp_Object ascii[NUM_ASCII_CHARS]; - -#ifdef MULE - /* We basically duplicate the Mule vectors-of-vectors implementation. - We can do this because we know a great deal about the sorts of - things we are going to be indexing. - - The current implementation is as follows: - - ascii[0-159] is used for ASCII and Control-1 characters. - - level1[0 .. (NUM_LEADING_BYTES-1)] indexes charsets by leading - byte (subtract MIN_LEADING_BYTE from the leading byte). If the - value of this is not an opaque, then it specifies a value for all - characters in the charset. Otherwise, it will be a - 96-Lisp-Object opaque that we created, specifying a value for - each row. If the value of this is not an opaque, then it - specifies a value for all characters in the row. Otherwise, it - will be a 96-Lisp-Object opaque that we created, specifying a - value for each character. - - NOTE: 1) This will fail if some C routine passes an opaque to - Fput_char_table(). Currently this is not a problem - since all char tables that are created are Lisp-visible - and thus no one should ever be putting an opaque in - a char table. Another possibility is to consider - adding a type to */ - - Lisp_Object level1[NUM_LEADING_BYTES]; - -#endif /* MULE */ - - enum char_table_type type; - - /* stuff used for syntax tables */ - Lisp_Object mirror_table; - Lisp_Object next_table; /* DO NOT mark through this. */ -}; - -#ifdef MULE - -Lisp_Object get_non_ascii_char_table_value (struct Lisp_Char_Table *ct, - int leading_byte, - Emchar c); - -INLINE Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch); -INLINE Lisp_Object -CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (struct Lisp_Char_Table *ct, Emchar ch) -{ - unsigned char lb = CHAR_LEADING_BYTE (ch); - if (!CHAR_TABLE_ENTRYP ((ct)->level1[lb - MIN_LEADING_BYTE])) - return (ct)->level1[lb - MIN_LEADING_BYTE]; - else - return get_non_ascii_char_table_value (ct, lb, ch); -} - -#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) \ - ((ch) < NUM_ASCII_CHARS \ - ? (ct)->ascii[ch] \ - : CHAR_TABLE_NON_ASCII_VALUE_UNSAFE (ct, ch)) - -#else /* not MULE */ - -#define CHAR_TABLE_VALUE_UNSAFE(ct, ch) ((ct)->ascii[(unsigned char) (ch)]) - -#endif /* not MULE */ - -enum chartab_range_type -{ - CHARTAB_RANGE_ALL, -#ifdef MULE - CHARTAB_RANGE_CHARSET, - CHARTAB_RANGE_ROW, -#endif - CHARTAB_RANGE_CHAR -}; - -struct chartab_range -{ - enum chartab_range_type type; - Emchar ch; - Lisp_Object charset; - int row; -}; - -void fill_char_table (struct Lisp_Char_Table *ct, Lisp_Object value); -void put_char_table (struct Lisp_Char_Table *ct, struct chartab_range *range, - Lisp_Object val); -Lisp_Object get_char_table (Emchar, struct Lisp_Char_Table *); -int map_char_table (struct Lisp_Char_Table *ct, - struct chartab_range *range, - int (*fn) (struct chartab_range *range, - Lisp_Object val, void *arg), - void *arg); -void prune_syntax_tables (int (*obj_marked_p) (Lisp_Object)); - -EXFUN (Fcopy_char_table, 1); -EXFUN (Fmake_char_table, 1); -EXFUN (Fput_char_table, 3); - -extern Lisp_Object Vall_syntax_tables; - - - -#ifdef MULE -int check_category_char(Emchar ch, Lisp_Object ctbl, - unsigned int designator, unsigned int not); - -extern Lisp_Object Vstandard_category_table; - -#define CATEGORY_DESIGNATORP(x) \ - (CHARP (x) && XCHAR (x) >= 32 && XCHAR (x) <= 126) - -#define CHECK_CATEGORY_DESIGNATOR(x) do { \ - if (!CATEGORY_DESIGNATORP (x)) \ - dead_wrong_type_argument (Qcategory_designator_p, x); \ -} while (0) - -#define CONCHECK_CATEGORY_DESIGNATOR(x) do { \ - if (!CATEGORY_DESIGNATORP (x)) \ - x = wrong_type_argument (Qcategory_designator_p, x); \ -} while (0) - -#define CATEGORY_TABLE_VALUEP(x) \ - (NILP (x) || (BIT_VECTORP (x) && (bit_vector_length (XBIT_VECTOR (x)) == 95))) - -#define CHECK_CATEGORY_TABLE_VALUE(x) do { \ - if (!CATEGORY_TABLE_VALUEP (x)) \ - dead_wrong_type_argument (Qcategory_table_value_p, x); \ -} while (0) - -#define CONCHECK_CATEGORY_TABLE_VALUE(x) do { \ - if (!CATEGORY_TABLE_VALUEP (x)) \ - x = wrong_type_argument (Qcategory_table_value_p, x); \ -} while (0) - -#endif /* MULE */ - -#endif /* _MULE_CHARTAB_H */ diff --git a/src/cm.c b/src/cm.c deleted file mode 100644 index c0dfd09..0000000 --- a/src/cm.c +++ /dev/null @@ -1,494 +0,0 @@ -/* Cursor motion subroutines for XEmacs. - Copyright (C) 1985, 1994, 1995 Free Software Foundation, Inc. - loosely based primarily on public domain code written by Chris Torek - -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. Substantially different from FSF. */ - -/* #### This file is extremely junky and needs major fixup. */ - -#include -#include "lisp.h" - -#include "console-tty.h" -#include "frame.h" -#include "lstream.h" -#include "redisplay.h" - -#define EXPENSIVE 2000 - -#ifdef __cplusplus -extern "C" { -#endif -extern char *tgoto (CONST char *cm, int hpos, int vpos); -extern void tputs (CONST char *, int, void (*)(int)); -#ifdef __cplusplus -} -#endif - -static void cmgoto_for_real (struct console *c, int row, int col); - -static int cm_cost_counter; /* sums up costs */ - -static void -evalcost (int c) -{ - cm_cost_counter++; -} - -/* Ugh -- cmputc() can't take a console argument, so we pass it in a global */ -struct console *cmputc_console; - -void -send_string_to_tty_console (struct console *c, unsigned char *str, int len) -{ - /* #### Ben sez: don't some terminals need nulls outputted - for proper timing? */ - Lstream *lstr = XLSTREAM (CONSOLE_TTY_DATA (c)->outstream); - - if (CONSOLE_TTY_REAL_CURSOR_X (c) != CONSOLE_TTY_CURSOR_X (c) - || CONSOLE_TTY_REAL_CURSOR_Y (c) != CONSOLE_TTY_CURSOR_Y (c)) - { - int row = CONSOLE_TTY_CURSOR_Y (c); - int col = CONSOLE_TTY_CURSOR_X (c); - cmgoto_for_real (c, row, col); - } - - if (len == 1) - Lstream_putc (lstr, *str); - else if (len > 0) - Lstream_write (lstr, str, len); -} - -void -cmputc (int c) -{ - unsigned char ch = (unsigned char) c; - - if (termscript) - fputc (c, termscript); - - send_string_to_tty_console (cmputc_console, &ch, 1); -} - -#if 0 - -/* - * Terminals with magicwrap (xn) don't all behave identically. - * The VT100 leaves the cursor in the last column but will wrap before - * printing the next character. I hear that the Concept terminal does - * the wrap immediately but ignores the next newline it sees. And some - * terminals just have buggy firmware, and think that the cursor is still - * in limbo if we use direct cursor addressing from the phantom column. - * The only guaranteed safe thing to do is to emit a CRLF immediately - * after we reach the last column; this takes us to a known state. - */ -void -cmcheckmagic (void) -{ - if (curX == FrameCols) - { - if (!MagicWrap || curY >= FrameRows - 1) - abort (); - if (termscript) - putc ('\r', termscript); - putchar ('\r'); - if (termscript) - putc ('\n', termscript); - putchar ('\n'); - curX = 0; - curY++; - } -} - -#endif /* 0 */ - -/* - * (Re)Initialize the cost factors, given the output speed of the - * terminal in DEVICE_TTY_DATA (dev)->ospeed. (Note: this holds B300, - * B9600, etc -- ie stuff out of .) - */ -void -cm_cost_init (struct console *c) -{ - char *tmp; - - cm_cost_counter = 0; -#define COST(x,e) (x \ - ? (cm_cost_counter = 0, tputs (x, 1, e), cm_cost_counter) \ - : EXPENSIVE) -#define MINCOST(x,e) ((x == 0) \ - ? EXPENSIVE \ - : (tmp = tgoto(x, 0, 0), COST(tmp,e))) - - TTY_COST (c).cm_up = COST (TTY_CM (c).up, evalcost); - TTY_COST (c).cm_down = COST (TTY_CM (c).down, evalcost); - TTY_COST (c).cm_left = COST (TTY_CM (c).left, evalcost); - TTY_COST (c).cm_right = COST (TTY_CM (c).right, evalcost); - TTY_COST (c).cm_home = COST (TTY_CM (c).home, evalcost); - TTY_COST (c).cm_low_left = COST (TTY_CM (c).low_left, evalcost); - TTY_COST (c).cm_car_return = COST (TTY_CM (c).car_return, evalcost); - - /* - * These last three are actually minimum costs. When (if) they are - * candidates for the least-cost motion, the real cost is computed. - * (Note that "0" is the assumed to generate the minimum cost. - * While this is not necessarily true, I have yet to see a terminal - * for which is not; all the terminals that have variable-cost - * cursor motion seem to take straight numeric values. --ACT) - */ - - TTY_COST (c).cm_abs = MINCOST (TTY_CM (c).abs, evalcost); - TTY_COST (c).cm_hor_abs = MINCOST (TTY_CM (c).hor_abs, evalcost); - TTY_COST (c).cm_ver_abs = MINCOST (TTY_CM (c).ver_abs, evalcost); - -#undef MINCOST -#undef COST -} - -/* - * Calculate the cost to move from (srcy, srcx) to (dsty, dstx) using - * up and down, and left and right, and motions. If doit is set - * actually perform the motion. - */ - -#ifdef NOT_YET -static int -calccost (struct frame *f, int srcy, int srcx, int dsty, int dstx, int doit) -{ - struct console *c = XCONSOLE (FRAME_CONSOLE (f)); - int totalcost = 0; - int deltay, deltax; - char *motion; - int motion_cost; - -#if 0 - int ntabs, n2tabs, tabx, tab2x, tabcost; -#endif - - cmputc_console = c; -#if 0 - /* If have just wrapped on a terminal with xn, - don't believe the cursor position: give up here - and force use of absolute positioning. */ - if (curX == Wcm.cm_cols) - goto fail; -#endif - - deltay = dsty - srcy; - if (!deltay) - goto calculate_x; - - if (deltay < 0) - { - motion = TTY_CM (c).up; - motion_cost = TTY_COST (c).cm_up; - deltay = -deltay; - } - else - { - motion = TTY_CM (c).down; - motion_cost = TTY_COST (c).cm_down; - } - - if (motion_cost == EXPENSIVE) - { -/* if (doit) */ - /* #### printing OOF is not acceptable */ - return motion_cost; - } - - totalcost = motion_cost * deltay; - - if (doit) - while (--deltay >= 0) - tputs (motion, 1, cmputc); - -calculate_x: - - deltax = dstx - srcx; - if (!deltax) - goto done; - - if (deltax < 0) - { - motion = TTY_CM (c).left; - motion_cost = TTY_COST (c).cm_left; - deltax = -deltax; - } - else - { - motion = TTY_CM (c).right; - motion_cost = TTY_COST (c).cm_right; - } - - if (motion_cost == EXPENSIVE) - { -/* if (doit) */ - /* #### printing OOF is not acceptable */ - return motion_cost; - } - - totalcost += motion_cost * deltax; - - if (doit) - while (--deltax >= 0) - tputs (motion, 1, cmputc); - -done: - return totalcost; -} -#endif /* NOT_YET */ - -#define USEREL 0 -#define USEHOME 1 -#define USELL 2 -#define USECR 3 - -#if OLD_CURSOR_MOTION_SHIT -void -cmgoto (struct frame *f, int row, int col) -{ - struct console *c = XCONSOLE (FRAME_CONSOLE (f)); - char *motion; -#if 0 - int frame_x = FRAME_CURSOR_X(f); - int frame_y = FRAME_CURSOR_Y(f); - int relcost, directcost, llcost; - int homecost; - int use; - char *dcm; -#endif - - cmputc_console = c; - - /* First the degenerate case */ -#if 0 - if (row == frame_y && col == frame_x) - return; -#endif - - /* #### something is fucked with the non-absolute cases */ - motion = tgoto (TTY_CM (c).abs, col, row); - tputs (motion, 1, cmputc); - CONSOLE_TTY_DATA (c)->cursor_x = col; - CONSOLE_TTY_DATA (c)->cursor_y = row; - return; - -#if 0 - if (frame_y >= 0 && frame_x >= 0) - { - /* - * Pick least-cost motions - */ - - relcost = calccost (f, frame_y, frame_x, row, col, 0); - use = USEREL; - - homecost = TTY_COST (c).cm_home; - if (homecost < EXPENSIVE) - homecost += calccost (f, 0, 0, row, col, 0); - - if (homecost < relcost) - { - relcost = homecost; - use = USEHOME; - } - - llcost = TTY_COST (c).cm_low_left; - if (llcost < EXPENSIVE) - llcost += calccost (f, frame_y - 1, 0, row, col, 0); - - if (llcost < relcost) - { - relcost = llcost; - use = USELL; - } - -#if 0 - if ((crcost = Wcm.cc_cr) < BIG) { - if (Wcm.cm_autolf) - if (curY + 1 >= Wcm.cm_rows) - crcost = BIG; - else - crcost += calccost (curY + 1, 0, row, col, 0); - else - crcost += calccost (curY, 0, row, col, 0); - } - if (crcost < relcost) - relcost = crcost, use = USECR; -#endif - - directcost = TTY_COST (c).cm_abs; - dcm = TTY_CM (c).abs; - - if (row == frame_y && TTY_COST (c).cm_hor_abs < EXPENSIVE) - { - directcost = TTY_COST (c).cm_hor_abs; - dcm = TTY_CM (c).hor_abs; - } - else if (col == frame_x && TTY_COST (c).cm_ver_abs < EXPENSIVE) - { - directcost = TTY_COST (c).cm_ver_abs; - dcm = TTY_CM (c).ver_abs; - } - } - else - { - directcost = 0; - relcost = 100000; - dcm = TTY_CM (c).abs; - } - - /* - * In the following comparison, the = in <= is because when the costs - * are the same, it looks nicer (I think) to move directly there. - */ - if (directcost <= relcost) - { - /* compute REAL direct cost */ - cm_cost_counter = 0; - motion = (dcm == TTY_CM (c).hor_abs - ? tgoto (dcm, row, col) - : tgoto (dcm, col, row)); - tputs (motion, 1, evalcost); - if (cm_cost_counter <= relcost) - { /* really is cheaper */ - tputs (motion, 1, cmputc); - FRAME_CURSOR_Y (f) = row; - FRAME_CURSOR_X (f) = col; - return; - } - } - - switch (use) - { - case USEHOME: - tputs (TTY_CM (c).home, 1, cmputc); - FRAME_CURSOR_X (f) = 0; - FRAME_CURSOR_Y (f) = 0; - break; - - case USELL: - tputs (TTY_CM (c).low_left, 1, cmputc); - FRAME_CURSOR_Y (f) = FRAME_HEIGHT (f) - 1; - FRAME_CURSOR_X (f) = 0; - break; - -#if 0 - case USECR: - tputs (Wcm.cm_cr, 1, cmputc); - if (Wcm.cm_autolf) - curY++; - curX = 0; - break; -#endif - } - - calccost (f, FRAME_CURSOR_Y (f), FRAME_CURSOR_X (f), row, col, 1); - FRAME_CURSOR_Y (f) = row; - FRAME_CURSOR_X (f) = col; -#endif -} -#endif /* OLD_CURSOR_MOTION_SHIT */ - -/***************************************************************************** - cmgoto - - This function is responsible for getting the cursor from its current - location to the passed location in the most efficient manner - possible. - ****************************************************************************/ -static void -cmgoto_for_real (struct console *c, int row, int col) -{ - char *motion; - - cmputc_console = c; - - /* First make sure that we actually have to do any work at all. */ - if (CONSOLE_TTY_REAL_CURSOR_X (c) == col - && CONSOLE_TTY_REAL_CURSOR_Y (c) == row) - return; - - CONSOLE_TTY_REAL_CURSOR_X (c) = col; - CONSOLE_TTY_REAL_CURSOR_Y (c) = row; - - /* #### Need to reimplement cost analysis and potential relative - movement. */ - - /* If all else fails, use absolute movement. */ - motion = tgoto (TTY_CM (c).abs, col, row); - tputs (motion, 1, cmputc); - CONSOLE_TTY_CURSOR_X (c) = col; - CONSOLE_TTY_CURSOR_Y (c) = row; -} - -void -cmgoto (struct frame *f, int row, int col) -{ - /* We delay cursor motion until we do something other than cursor motion, - to optimize the case where cmgoto() is called twice in a row. */ - struct console *c = XCONSOLE (FRAME_CONSOLE (f)); - CONSOLE_TTY_CURSOR_X (c) = col; - CONSOLE_TTY_CURSOR_Y (c) = row; -} - -#if 0 -/* Clear out all terminal info. - Used before copying into it the info on the actual terminal. - */ - -void -Wcm_clear (void) -{ - xzero (Wcm); - UP = 0; - BC = 0; -} -#endif - -#if 0 -/* - * Initialized stuff - * Return 0 if can do CM. - * Return -1 if cannot. - * Return -2 if size not specified. - */ - -int -Wcm_init (void) -{ -#if 0 - if (Wcm.cm_abs && !Wcm.cm_ds) - return 0; -#endif - if (Wcm.cm_abs) - return 0; - /* Require up and left, and, if no absolute, down and right */ - if (!Wcm.cm_up || !Wcm.cm_left) - return - 1; - if (!Wcm.cm_abs && (!Wcm.cm_down || !Wcm.cm_right)) - return - 1; - /* Check that we know the size of the frame.... */ - if (Wcm.cm_rows <= 0 || Wcm.cm_cols <= 0) - return - 2; - return 0; -} -#endif diff --git a/src/cm.h b/src/cm.h deleted file mode 100644 index 0442b20..0000000 --- a/src/cm.h +++ /dev/null @@ -1,184 +0,0 @@ -/* Cursor motion calculation definitions for XEmacs - Copyright (C) 1985, 1989, 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: FSF 19.30. */ - -/* #### Chuck -- This file should be deleted. I'm not deleting it yet - because there might be something you want out of it. */ - -#ifndef _XEMACS_CM_H_ -#define _XEMACS_CM_H_ - -/* Holds the minimum and maximum costs for the parametrized capabilities. */ -struct parmcap - { - int mincost, maxcost; - }; - -/* This structure holds everything needed to do cursor motion except the pad - character (PC) and the output speed of the terminal (ospeed), which - termcap wants in global variables. */ - -struct cm - { -#if 0 - /* Cursor position. -1 in *both* variables means the cursor - position is unknown, in order to force absolute cursor motion. */ - - int cm_curY; /* Current row */ - int cm_curX; /* Current column */ - - /* Capabilities from termcap */ - CONST char *cm_up; /* up (up) */ - CONST char *cm_down; /* down (do) */ - CONST char *cm_left; /* left (le) */ - CONST char *cm_right; /* right (nd) */ - CONST char *cm_home; /* home (ho) */ - CONST char *cm_cr; /* carriage return (cr) */ - CONST char *cm_ll; /* last line (ll) */ -#endif /* 0 */ - CONST char *cm_tab; /* tab (ta) */ - CONST char *cm_backtab; /* backtab (bt) */ -#if 0 - CONST char *cm_abs; /* absolute (cm) */ - CONST char *cm_habs; /* horizontal absolute (ch) */ - CONST char *cm_vabs; /* vertical absolute (cv) */ - CONST char *cm_ds; /* "don't send" string (ds) */ - CONST char *cm_multiup; /* multiple up (UP) */ - CONST char *cm_multidown; /* multiple down (DO) */ - CONST char *cm_multileft; /* multiple left (LE) */ - CONST char *cm_multiright; /* multiple right (RI) */ - int cm_cols; /* number of cols on frame (co) */ - int cm_rows; /* number of rows on frame (li) */ - int cm_tabwidth; /* tab width (it) */ - unsigned int cm_autowrap:1; /* autowrap flag (am) */ - unsigned int cm_magicwrap:1; /* VT-100: cursor stays in last col but - will cm_wrap if next char is - printing (xn) */ - unsigned int cm_usetabs:1; /* if set, use tabs */ - unsigned int cm_losewrap:1; /* if reach right margin, forget cursor - location */ - unsigned int cm_autolf:1; /* \r performs a \r\n (rn) */ -#endif - - /* Parametrized capabilities. This needs to be a struct since - the costs are accessed through pointers. */ - -#if 0 - struct parmcap cc_abs; /* absolute (cm) */ - struct parmcap cc_habs; /* horizontal absolute (ch) */ - struct parmcap cc_vabs; /* vertical absolute (cv) */ - struct parmcap cc_multiup; /* multiple up (UP) */ - struct parmcap cc_multidown; /* multiple down (DO) */ - struct parmcap cc_multileft; /* multiple left (LE) */ - struct parmcap cc_multiright; /* multiple right (RI) */ -#endif - -#if 0 - /* Costs for the non-parametrized capabilities */ - int cc_up; /* cost for up */ - int cc_down; /* etc. */ - int cc_left; - int cc_right; - int cc_home; - int cc_cr; - int cc_ll; - int cc_tab; - int cc_backtab; - /* These are temporary, until the code is installed to use the - struct parmcap fields above. */ - int cc_abs; - int cc_habs; - int cc_vabs; -#endif - }; - -#if 0 -extern struct cm Wcm; /* Terminal capabilities */ -extern char PC; /* Pad character */ - -/* Shorthand */ -#ifndef NoCMShortHand -#define curY Wcm.cm_curY -#define curX Wcm.cm_curX -#define Up Wcm.cm_up -#define Down Wcm.cm_down -#define Left Wcm.cm_left -#define Right Wcm.cm_right -#define Tab Wcm.cm_tab -#define BackTab Wcm.cm_backtab -#define TabWidth Wcm.cm_tabwidth -#define CR Wcm.cm_cr -#define Home Wcm.cm_home -#define LastLine Wcm.cm_ll -#define AbsPosition Wcm.cm_abs -#define ColPosition Wcm.cm_habs -#define RowPosition Wcm.cm_vabs -#define MultiUp Wcm.cm_multiup -#define MultiDown Wcm.cm_multidown -#define MultiLeft Wcm.cm_multileft -#define MultiRight Wcm.cm_multiright -#define AutoWrap Wcm.cm_autowrap -#define MagicWrap Wcm.cm_magicwrap -#define UseTabs Wcm.cm_usetabs -#define FrameRows Wcm.cm_rows -#define FrameCols Wcm.cm_cols - -#define UpCost Wcm.cc_up -#define DownCost Wcm.cc_down -#define LeftCost Wcm.cc_left -#define RightCost Wcm.cc_right -#define HomeCost Wcm.cc_home -#define CRCost Wcm.cc_cr -#define LastLineCost Wcm.cc_ll -#define TabCost Wcm.cc_tab -#define BackTabCost Wcm.cc_backtab -#define AbsPositionCost Wcm.cc_abs -#define ColPositionCost Wcm.cc_habs -#define RowPositionCost Wcm.cc_vabs -#define MultiUpCost Wcm.cc_multiup -#define MultiDownCost Wcm.cc_multidown -#define MultiLeftCost Wcm.cc_multileft -#define MultiRightCost Wcm.cc_multiright -#endif -#endif /* 0 */ - -#define cmat(row,col) (curY = (row), curX = (col)) -#define cmplus(n) \ - { \ - if ((curX += (n)) >= FrameCols && !MagicWrap) \ - { \ - if (Wcm.cm_losewrap) losecursor (); \ - else if (AutoWrap) curX = 0, curY++; \ - else curX--; \ - } \ - } - -#define losecursor() (curX = -1, curY = -1) - -extern int cost; -void cmputc (int c); -void cmcheckmagic (void); -void cm_cost_init (struct console *c); -void cmgoto (int, int); -void Wcm_clear (void); -int Wcm_init (void); - -#endif /* _XEMACS_CM_H_ */ diff --git a/src/cmdloop.c b/src/cmdloop.c deleted file mode 100644 index 5c3d8a6..0000000 --- a/src/cmdloop.c +++ /dev/null @@ -1,653 +0,0 @@ -/* Editor command loop. - Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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: Mule 2.0. Not synched with FSF. - This was renamed from keyboard.c. However, it only contains the - command-loop stuff from FSF's keyboard.c; all the rest is in - event*.c, console.c, or signal.c. */ - -/* #### This module purports to separate out the command-loop stuff - from event-stream.c, but it doesn't really. Perhaps this file - should just be merged into event-stream.c, given its shortness. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "commands.h" -#include "frame.h" -#include "events.h" -#include "window.h" - -/* Current depth in recursive edits. */ -int command_loop_level; - -/* Total number of times command_loop has read a key sequence. */ -int num_input_keys; - -#ifndef LISP_COMMAND_LOOP -/* Form to evaluate (if non-nil) when Emacs is started. */ -Lisp_Object Vtop_level; -#else -/* Function to call to evaluate to read and process events. */ -Lisp_Object Vcommand_loop; -#endif /* LISP_COMMAND_LOOP */ - -Lisp_Object Venter_window_hook, Vleave_window_hook; - -/* The error handler. */ -Lisp_Object Qcommand_error; - -/* The emergency error handler, before we're ready. */ -Lisp_Object Qreally_early_error_handler; - -/* Variable defined in Lisp. */ -Lisp_Object Qerrors_deactivate_region; - -Lisp_Object Qtop_level; - -static Lisp_Object command_loop_1 (Lisp_Object dummy); -EXFUN (Fcommand_loop_1, 0); - -/* There are two possible command loops -- one written entirely in - C and one written mostly in Lisp, except stuff written in C for - speed. The advantage of the Lisp command loop is that the user - can specify their own command loop to use by changing the variable - `command-loop'. Its disadvantage is that it's slow. */ - -static Lisp_Object -default_error_handler (Lisp_Object data) -{ - int speccount = specpdl_depth (); - - /* None of this is invoked, normally. This code is almost identical - to the `command-error' function, except `command-error' does cool - tricks with sounds. This function is a fallback, invoked if - command-error is unavailable. */ - - Fding (Qnil, Qnil, Qnil); - - if (!NILP (Fboundp (Qerrors_deactivate_region)) - && !NILP (Fsymbol_value (Qerrors_deactivate_region))) - zmacs_deactivate_region (); - Fdiscard_input (); - specbind (Qinhibit_quit, Qt); - Vstandard_output = Qt; - Vstandard_input = Qt; - Vexecuting_macro = Qnil; - Fset (intern ("last-error"), data); - clear_echo_area (selected_frame (), Qnil, 0); - Fdisplay_error (data, Qt); - check_quit (); /* make Vquit_flag accurate */ - Vquit_flag = Qnil; - return (unbind_to (speccount, Qt)); -} - -DEFUN ("really-early-error-handler", Freally_early_error_handler, 1, 1, 0, /* -You should almost certainly not be using this. -*/ - (x)) -{ - /* This is an error handler used when we're running temacs and when - we're in the early stages of XEmacs. No errors ought to be - occurring in those cases (or they ought to be trapped and - dealt with elsewhere), but if an error slips through, we need - to deal with it. We could write this function in Lisp (and it - used to be this way, at the beginning of loadup.el), but we do - it this way in case an error occurs before we get to loading - loadup.el. Note that there is also an `early-error-handler', - used in startup.el to catch more reasonable errors that - might occur during startup if the sysadmin or whoever fucked - up. This function is more conservative in what it does - and is used only as a last resort, indicating that the - programmer himself fucked up somewhere. */ - stderr_out ("*** Error in XEmacs initialization"); - Fprint (x, Qexternal_debugging_output); - stderr_out ("*** Backtrace\n"); - Fbacktrace (Qexternal_debugging_output, Qt); - stderr_out ("*** Killing XEmacs\n"); - return Fkill_emacs (make_int (-1)); -} - - -/**********************************************************************/ -/* Command-loop (in C) */ -/**********************************************************************/ - -#ifndef LISP_COMMAND_LOOP - -/* The guts of the command loop are in command_loop_1(). This function - doesn't catch errors, though -- that's the job of command_loop_2(), - which is a condition-case wrapper around command_loop_1(). - command_loop_1() never returns, but may get thrown out of. - - When an error occurs, cmd_error() is called, which usually - invokes the Lisp error handler in `command-error'; however, - a default error handler is provided if `command-error' is nil - (e.g. during startup). The purpose of the error handler is - simply to display the error message and do associated cleanup; - it does not need to throw anywhere. When the error handler - finishes, the condition-case in command_loop_2() will finish and - command_loop_2() will reinvoke command_loop_1(). - - command_loop_2() is invoked from three places: from - initial_command_loop() (called from main() at the end of - internal initialization), from the Lisp function `recursive-edit', - and from call_command_loop(). - - call_command_loop() is called when a macro is started and when the - minibuffer is entered; normal termination of the macro or - minibuffer causes a throw out of the recursive command loop. (To - 'execute-kbd-macro for macros and 'exit for minibuffers. Note also - that the low-level minibuffer-entering function, - `read-minibuffer-internal', provides its own error handling and - does not need command_loop_2()'s error encapsulation; so it tells - call_command_loop() to invoke command_loop_1() directly.) - - Note that both read-minibuffer-internal and recursive-edit set - up a catch for 'exit; this is why `abort-recursive-edit', which - throws to this catch, exits out of either one. - - initial_command_loop(), called from main(), sets up a catch - for 'top-level when invoking command_loop_2(), allowing functions - to throw all the way to the top level if they really need to. - Before invoking command_loop_2(), initial_command_loop() calls - top_level_1(), which handles all of the startup stuff (creating - the initial frame, handling the command-line options, loading - the user's .emacs file, etc.). The function that actually does this - is in Lisp and is pointed to by the variable `top-level'; - normally this function is `normal-top-level'. top_level_1() is - just an error-handling wrapper similar to command_loop_2(). - Note also that initial_command_loop() sets up a catch for 'top-level - when invoking top_level_1(), just like when it invokes - command_loop_2(). */ - - -static Lisp_Object -cmd_error (Lisp_Object data, Lisp_Object dummy) -{ - /* This function can GC */ - check_quit (); /* make Vquit_flag accurate */ - Vquit_flag = Qnil; - - any_console_state (); - - if (!NILP (Ffboundp (Qcommand_error))) - return call1 (Qcommand_error, data); - - return default_error_handler (data); -} - -static Lisp_Object -top_level_1 (Lisp_Object dummy) -{ - /* This function can GC */ - /* On entry to the outer level, run the startup file */ - if (!NILP (Vtop_level)) - condition_case_1 (Qerror, Feval, Vtop_level, cmd_error, Qnil); -#if 1 - else - { - message ("\ntemacs can only be run in -batch mode."); - noninteractive = 1; /* prevent things under kill-emacs from blowing up */ - Fkill_emacs (make_int (-1)); - } -#else - else if (purify_flag) - message ("Bare impure Emacs (standard Lisp code not loaded)"); - else - message ("Bare Emacs (standard Lisp code not loaded)"); -#endif - - return Qnil; -} - -/* Here we catch errors in execution of commands within the - editing loop, and reenter the editing loop. - When there is an error, cmd_error runs and the call - to condition_case_1() returns. */ - -/* Avoid confusing the compiler. A helper function for command_loop_2 */ -static DOESNT_RETURN -command_loop_3 (void) -{ -#ifdef LWLIB_MENUBARS_LUCID - extern int in_menu_callback; /* defined in menubar-x.c */ -#endif /* LWLIB_MENUBARS_LUCID */ - -#ifdef LWLIB_MENUBARS_LUCID - /* - * #### Fix the menu code so this isn't necessary. - * - * We cannot allow the lwmenu code to be reentered, because the - * code is not written to be reentrant and will crash. Therefore - * paths from the menu callbacks back into the menu code have to - * be blocked. Fnext_event is the normal path into the menu code, - * but waiting to signal an error there is too late in case where - * a new command loop has been started. The error will be caught - * and Fnext_event will be called again, looping forever. So we - * signal an error here to avoid the loop. - */ - if (in_menu_callback) - error ("Attempt to enter command_loop_3 inside menu callback"); -#endif /* LWLIB_MENUBARS_LUCID */ - /* This function can GC */ - for (;;) - { - condition_case_1 (Qerror, command_loop_1, Qnil, cmd_error, Qnil); - /* #### wrong with selected-console? */ - /* See command in initial_command_loop about why this value - is 0. */ - reset_this_command_keys (Vselected_console, 0); - } -} - -static Lisp_Object -command_loop_2 (Lisp_Object dummy) -{ - command_loop_3(); /* doesn't return */ - return Qnil; -} - -/* This is called from emacs.c when it's done with initialization. */ - -DOESNT_RETURN -initial_command_loop (Lisp_Object load_me) -{ - /* This function can GC */ - if (!NILP (load_me)) - Vtop_level = list2 (Qload, load_me); - - /* First deal with startup and command-line arguments. A throw - to 'top-level gets us back here directly (does this ever happen?). - Otherwise, this function will return normally when all command- - line arguments have been processed, the user's initialization - file has been read in, and the first frame has been created. */ - internal_catch (Qtop_level, top_level_1, Qnil, 0); - - /* If an error occurred during startup and the initial console - wasn't created, then die now (the error was already printed out - on the terminal device). */ - if (!noninteractive && - (!CONSOLEP (Vselected_console) || - CONSOLE_STREAM_P (XCONSOLE (Vselected_console)))) - Fkill_emacs (make_int (-1)); - - /* End of -batch run causes exit here. */ - if (noninteractive) - Fkill_emacs (Qt); - - for (;;) - { - command_loop_level = 0; - MARK_MODELINE_CHANGED; - /* Now invoke the command loop. It never returns; however, a - throw to 'top-level will place us at the end of this loop. */ - internal_catch (Qtop_level, command_loop_2, Qnil, 0); - /* #### wrong with selected-console? */ - /* We don't actually call clear_echo_area() here, partially - at least because that runs Lisp code and it may be unsafe - to do so -- we are outside of the normal catches for - errors and such. */ - reset_this_command_keys (Vselected_console, 0); - } -} - -/* This function is invoked when a macro or minibuffer starts up. - Normal termination of the macro or minibuffer causes a throw past us. - See the comment above. - - Note that this function never returns (but may be thrown out of). */ - -Lisp_Object -call_command_loop (Lisp_Object catch_errors) -{ - /* This function can GC */ - if (NILP (catch_errors)) - return (command_loop_1 (Qnil)); - else - return (command_loop_2 (Qnil)); -} - -static Lisp_Object -recursive_edit_unwind (Lisp_Object buffer) -{ - if (!NILP (buffer)) - Fset_buffer (buffer); - - command_loop_level--; - MARK_MODELINE_CHANGED; - - return Qnil; -} - -DEFUN ("recursive-edit", Frecursive_edit, 0, 0, "", /* -Invoke the editor command loop recursively. -To get out of the recursive edit, a command can do `(throw 'exit nil)'; -that tells this function to return. -Alternately, `(throw 'exit t)' makes this function signal an error. -*/ - ()) -{ - /* This function can GC */ - Lisp_Object val; - int speccount = specpdl_depth (); - - command_loop_level++; - MARK_MODELINE_CHANGED; - - record_unwind_protect (recursive_edit_unwind, - ((current_buffer - != XBUFFER (XWINDOW (Fselected_window - (Qnil))->buffer)) - ? Fcurrent_buffer () - : Qnil)); - - specbind (Qstandard_output, Qt); - specbind (Qstandard_input, Qt); - - val = internal_catch (Qexit, command_loop_2, Qnil, 0); - - if (EQ (val, Qt)) - /* Turn abort-recursive-edit into a quit. */ - Fsignal (Qquit, Qnil); - - return unbind_to (speccount, Qnil); -} - -#endif /* !LISP_COMMAND_LOOP */ - - -/**********************************************************************/ -/* Alternate command-loop (largely in Lisp) */ -/**********************************************************************/ - -#ifdef LISP_COMMAND_LOOP - -static Lisp_Object -load1 (Lisp_Object name) -{ - /* This function can GC */ - call4 (Qload, name, Qnil, Qt, Qnil); - return (Qnil); -} - -/* emergency backups for cold-load-stream use */ -static Lisp_Object -cold_load_command_error (Lisp_Object datum, Lisp_Object ignored) -{ - /* This function can GC */ - check_quit (); /* make Vquit_flag accurate */ - Vquit_flag = Qnil; - - return default_error_handler (datum); -} - -static Lisp_Object -cold_load_command_loop (Lisp_Object dummy) -{ - /* This function can GC */ - return (condition_case_1 (Qt, - command_loop_1, Qnil, - cold_load_command_error, Qnil)); -} - -Lisp_Object -call_command_loop (Lisp_Object catch_errors) -{ - /* This function can GC */ - reset_this_command_keys (Vselected_console, Qnil); /* #### bleagh */ - - loop: - for (;;) - { - if (NILP (Vcommand_loop)) - break; - call1 (Vcommand_loop, catch_errors); - } - - /* This isn't a "correct" definition, but you're pretty hosed if - you broke "command-loop" anyway */ - /* #### not correct with Vselected_console */ - XCONSOLE (Vselected_console)->prefix_arg = Qnil; - if (NILP (catch_errors)) - Fcommand_loop_1 (); - else - internal_catch (Qtop_level, - cold_load_command_loop, Qnil, 0); - goto loop; - return Qnil; -} - -static Lisp_Object -initial_error_handler (Lisp_Object datum, Lisp_Object ignored) -{ - /* This function can GC */ - Vcommand_loop = Qnil; - Fding (Qnil, Qnil, Qnil); - - if (CONSP (datum) && EQ (XCAR (datum), Qquit)) - /* Don't bother with the message */ - return (Qt); - - message ("Error in command-loop!!"); - Fset (intern ("last-error"), datum); /* #### Better/different name? */ - Fsit_for (make_int (2), Qnil); - cold_load_command_error (datum, Qnil); - return (Qt); -} - -DOESNT_RETURN -initial_command_loop (Lisp_Object load_me) -{ - /* This function can GC */ - if (!NILP (load_me)) - { - if (!NILP (condition_case_1 (Qt, load1, load_me, - initial_error_handler, Qnil))) - Fkill_emacs (make_int (-1)); - } - - for (;;) - { - command_loop_level = 0; - MARK_MODELINE_CHANGED; - - condition_case_1 (Qt, - call_command_loop, Qtop_level, - initial_error_handler, Qnil); - } -} - -#endif /* LISP_COMMAND_LOOP */ - - -/**********************************************************************/ -/* Guts of command loop */ -/**********************************************************************/ - -static Lisp_Object -command_loop_1 (Lisp_Object dummy) -{ - /* This function can GC */ - /* #### not correct with Vselected_console */ - XCONSOLE (Vselected_console)->prefix_arg = Qnil; - return (Fcommand_loop_1 ()); -} - -/* This is the actual command reading loop, sans error-handling - encapsulation. This is used for both the C and Lisp command - loops. Originally this function was written in Lisp when - the Lisp command loop was used, but it was too slow that way. - - Under the C command loop, this function will never return - (although someone might throw past it). Under the Lisp - command loop, this will return only when the user specifies - a new command loop by changing the command-loop variable. */ - -DEFUN ("command-loop-1", Fcommand_loop_1, 0, 0, 0, /* -Invoke the internals of the canonical editor command loop. -Don't call this unless you know what you're doing. -*/ - ()) -{ - /* This function can GC */ - Lisp_Object event = Fmake_event (Qnil, Qnil); - Lisp_Object old_loop = Qnil; - struct gcpro gcpro1, gcpro2; - int was_locked = in_single_console_state (); - GCPRO2 (event, old_loop); - - /* cancel_echoing (); */ - /* This magically makes single character keyboard macros work just - like the real thing. This is slightly bogus, but it's in here for - compatibility with Emacs 18. It's not even clear what the "right - thing" is. */ - if (!(((STRINGP (Vexecuting_macro) || VECTORP (Vexecuting_macro)) - && XINT (Flength (Vexecuting_macro)) == 1))) - Vlast_command = Qt; - -#ifndef LISP_COMMAND_LOOP - while (1) -#else - old_loop = Vcommand_loop; - while (EQ (Vcommand_loop, old_loop)) -#endif /* LISP_COMMAND_LOOP */ - { - /* If focus_follows_mouse, make sure the frame with window manager - focus is selected. */ - if (focus_follows_mouse) - investigate_frame_change (); - - /* Make sure the current window's buffer is selected. */ - { - Lisp_Object selected_window = Fselected_window (Qnil); - - if (!NILP (selected_window) && - (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer)) - { - set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); - } - } - - /* If ^G was typed before we got here (that is, before emacs was - idle and waiting for input) then we treat that as an interrupt. */ - QUIT; - - /* If minibuffer on and echo area in use, wait 2 sec and redraw - minibuffer. Treat a ^G here as a command, not an interrupt. - */ - if (minibuf_level > 0 && echo_area_active (selected_frame ())) - { - /* Bind dont_check_for_quit to 1 so that C-g gets read in - rather than quitting back to the minibuffer. */ - int count = specpdl_depth (); - begin_dont_check_for_quit (); - Fsit_for (make_int (2), Qnil); - clear_echo_area (selected_frame (), Qnil, 0); - unbind_to (count, Qnil); - } - - Fnext_event (event, Qnil); - /* If ^G was typed while emacs was reading input from the user, then - Fnext_event() will have read it as a normal event and - next_event_internal() will have set Vquit_flag. We reset this - so that the ^G is treated as just another key. This is strange, - but it is what emacs 18 did. - - Do not call check_quit() here. */ - Vquit_flag = Qnil; - Fdispatch_event (event); - - if (!was_locked) - any_console_state (); -#if (defined (_MSC_VER) \ - || defined (__SUNPRO_C) \ - || defined (__SUNPRO_CC) \ - || (defined (DEC_ALPHA) \ - && defined (OSF1))) - if (0) return Qnil; /* Shut up compiler */ -#endif - } -#ifdef LISP_COMMAND_LOOP - UNGCPRO; - return Qnil; -#endif -} - - -/**********************************************************************/ -/* Initialization */ -/**********************************************************************/ - -void -syms_of_cmdloop (void) -{ - defsymbol (&Qcommand_error, "command-error"); - defsymbol (&Qreally_early_error_handler, "really-early-error-handler"); - defsymbol (&Qtop_level, "top-level"); - defsymbol (&Qerrors_deactivate_region, "errors-deactivate-region"); - -#ifndef LISP_COMMAND_LOOP - DEFSUBR (Frecursive_edit); -#endif - DEFSUBR (Freally_early_error_handler); - DEFSUBR (Fcommand_loop_1); -} - -void -vars_of_cmdloop (void) -{ - DEFVAR_INT ("command-loop-level", &command_loop_level /* -Number of recursive edits in progress. -*/ ); - command_loop_level = 0; - - DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook /* -Value is called instead of any command that is disabled, -i.e. has a non-nil `disabled' property. -*/ ); - Vdisabled_command_hook = intern ("disabled-command-hook"); - - DEFVAR_LISP ("leave-window-hook", &Vleave_window_hook /* -Not yet implemented. -*/ ); - Vleave_window_hook = Qnil; - - DEFVAR_LISP ("enter-window-hook", &Venter_window_hook /* -Not yet implemented. -*/ ); - Venter_window_hook = Qnil; - -#ifndef LISP_COMMAND_LOOP - DEFVAR_LISP ("top-level", &Vtop_level /* -Form to evaluate when Emacs starts up. -Useful to set before you dump a modified Emacs. -*/ ); - Vtop_level = Qnil; -#else - DEFVAR_LISP ("command-loop", &Vcommand_loop /* -Function or one argument to call to read and process keyboard commands. -The passed argument specifies whether or not to handle errors. -*/ ); - Vcommand_loop = Qnil; -#endif /* LISP_COMMAND_LOOP */ -} diff --git a/src/cmds.c b/src/cmds.c deleted file mode 100644 index 8e68640..0000000 --- a/src/cmds.c +++ /dev/null @@ -1,501 +0,0 @@ -/* Simple built-in editing commands. - Copyright (C) 1985, 1992, 1993, 1994, 1995 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: Mule 2.0, FSF 19.30. */ - -#include -#include "lisp.h" -#include "commands.h" -#include "buffer.h" -#include "syntax.h" -#include "insdel.h" - -Lisp_Object Qkill_forward_chars; -Lisp_Object Qself_insert_command; -Lisp_Object Qno_self_insert; - -Lisp_Object Vblink_paren_function; - -/* A possible value for a buffer's overwrite-mode variable. */ -Lisp_Object Qoverwrite_mode_binary; - -/* Non-nil means put this face on the next self-inserting character. */ -Lisp_Object Vself_insert_face; - -/* This is the command that set up Vself_insert_face. */ -Lisp_Object Vself_insert_face_command; - -DEFUN ("forward-char", Fforward_char, 0, 2, "_p", /* -Move point right N characters (left if N negative). -On attempt to pass end of buffer, stop and signal `end-of-buffer'. -On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. -On reaching end of buffer, stop and signal error. -*/ - (n, buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 1); - EMACS_INT count; - - if (NILP (n)) - count = 1; - else - { - CHECK_INT (n); - count = XINT (n); - } - - /* This used to just set point to point + XINT (n), and then check - to see if it was within boundaries. But now that SET_PT can - potentially do a lot of stuff (calling entering and exiting - hooks, etcetera), that's not a good approach. So we validate the - proposed position, then set point. */ - { - Bufpos new_point = BUF_PT (buf) + count; - - if (new_point < BUF_BEGV (buf)) - { - BUF_SET_PT (buf, BUF_BEGV (buf)); - Fsignal (Qbeginning_of_buffer, Qnil); - return Qnil; - } - if (new_point > BUF_ZV (buf)) - { - BUF_SET_PT (buf, BUF_ZV (buf)); - Fsignal (Qend_of_buffer, Qnil); - return Qnil; - } - - BUF_SET_PT (buf, new_point); - } - - return Qnil; -} - -DEFUN ("backward-char", Fbackward_char, 0, 2, "_p", /* -Move point left N characters (right if N negative). -On attempt to pass end of buffer, stop and signal `end-of-buffer'. -On attempt to pass beginning of buffer, stop and signal `beginning-of-buffer'. -*/ - (n, buffer)) -{ - if (NILP (n)) - n = make_int (-1); - else - { - CHECK_INT (n); - XSETINT (n, - XINT (n)); - } - return Fforward_char (n, buffer); -} - -DEFUN ("forward-line", Fforward_line, 0, 2, "_p", /* -Move N lines forward (backward if N is negative). -Precisely, if point is on line I, move to the start of line I + N. -If there isn't room, go as far as possible (no error). -Returns the count of lines left to move. If moving forward, -that is N - number of lines moved; if backward, N + number moved. -With positive N, a non-empty line at the end counts as one line - successfully moved (for the return value). -If BUFFER is nil, the current buffer is assumed. -*/ - (n, buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 1); - Bufpos pos2 = BUF_PT (buf); - Bufpos pos; - EMACS_INT count, shortage, negp; - - if (NILP (n)) - count = 1; - else - { - CHECK_INT (n); - count = XINT (n); - } - - negp = count <= 0; - pos = scan_buffer (buf, '\n', pos2, 0, count - negp, &shortage, 1); - if (shortage > 0 - && (negp - || (BUF_ZV (buf) > BUF_BEGV (buf) - && pos != pos2 - && BUF_FETCH_CHAR (buf, pos - 1) != '\n'))) - shortage--; - BUF_SET_PT (buf, pos); - return make_int (negp ? - shortage : shortage); -} - -DEFUN ("point-at-bol", Fpoint_at_bol, 0, 2, 0, /* -Return the character position of the first character on the current line. -With argument N not nil or 1, move forward N - 1 lines first. -If scan reaches end of buffer, return that position. -This function does not move point. -*/ - (n, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - REGISTER int orig, end; - - XSETBUFFER (buffer, b); - if (NILP (n)) - n = make_int (0); - else - { - CHECK_INT (n); - n = make_int (XINT (n) - 1); - } - - orig = BUF_PT (b); - Fforward_line (n, buffer); - end = BUF_PT (b); - BUF_SET_PT (b, orig); - - return make_int (end); -} - -DEFUN ("beginning-of-line", Fbeginning_of_line, 0, 2, "_p", /* -Move point to beginning of current line. -With argument N not nil or 1, move forward N - 1 lines first. -If scan reaches end of buffer, stop there without error. -If BUFFER is nil, the current buffer is assumed. -*/ - (n, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - - BUF_SET_PT (b, XINT (Fpoint_at_bol (n, buffer))); - return Qnil; -} - -DEFUN ("point-at-eol", Fpoint_at_eol, 0, 2, 0, /* -Return the character position of the last character on the current line. -With argument N not nil or 1, move forward N - 1 lines first. -If scan reaches end of buffer, return that position. -This function does not move point. -*/ - (n, buffer)) -{ - struct buffer *buf = decode_buffer (buffer, 1); - int count; - - if (NILP (n)) - count = 1; - else - { - CHECK_INT (n); - count = XINT (n); - } - - return make_int (find_before_next_newline (buf, BUF_PT (buf), 0, - count - (count <= 0))); -} - -DEFUN ("end-of-line", Fend_of_line, 0, 2, "_p", /* -Move point to end of current line. -With argument N not nil or 1, move forward N - 1 lines first. -If scan reaches end of buffer, stop there without error. -If BUFFER is nil, the current buffer is assumed. -*/ - (n, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - - BUF_SET_PT (b, XINT (Fpoint_at_eol (n, buffer))); - return Qnil; -} - -DEFUN ("delete-char", Fdelete_char, 1, 2, "*p\nP", /* -Delete the following N characters (previous, with negative N). -Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). -Interactively, N is the prefix arg, and KILLFLAG is set if -N was explicitly specified. -*/ - (n, killflag)) -{ - /* This function can GC */ - Bufpos pos; - struct buffer *buf = current_buffer; - int count; - - CHECK_INT (n); - count = XINT (n); - - pos = BUF_PT (buf) + count; - if (NILP (killflag)) - { - if (count < 0) - { - if (pos < BUF_BEGV (buf)) - signal_error (Qbeginning_of_buffer, Qnil); - else - buffer_delete_range (buf, pos, BUF_PT (buf), 0); - } - else - { - if (pos > BUF_ZV (buf)) - signal_error (Qend_of_buffer, Qnil); - else - buffer_delete_range (buf, BUF_PT (buf), pos, 0); - } - } - else - { - call1 (Qkill_forward_chars, n); - } - return Qnil; -} - -DEFUN ("delete-backward-char", Fdelete_backward_char, 1, 2, "*p\nP", /* -Delete the previous N characters (following, with negative N). -Optional second arg KILLFLAG non-nil means kill instead (save in kill ring). -Interactively, N is the prefix arg, and KILLFLAG is set if -N was explicitly specified. -*/ - (n, killflag)) -{ - /* This function can GC */ - CHECK_INT (n); - return Fdelete_char (make_int (- XINT (n)), killflag); -} - -static void internal_self_insert (Emchar ch, int noautofill); - -DEFUN ("self-insert-command", Fself_insert_command, 1, 1, "*p", /* -Insert the character you type. -Whichever character you type to run this command is inserted. -*/ - (n)) -{ - /* This function can GC */ - Emchar ch; - Lisp_Object c; - int count; - - CHECK_NATNUM (n); - count = XINT (n); - - if (CHAR_OR_CHAR_INTP (Vlast_command_char)) - c = Vlast_command_char; - else - c = Fevent_to_character (Vlast_command_event, Qnil, Qnil, Qt); - - if (NILP (c)) - signal_simple_error ("Last typed character has no ASCII equivalent", - Fcopy_event (Vlast_command_event, Qnil)); - - CHECK_CHAR_COERCE_INT (c); - - ch = XCHAR (c); - - while (count--) - internal_self_insert (ch, (count != 0)); - - return Qnil; -} - -/* Insert character C1. If NOAUTOFILL is nonzero, don't do autofill - even if it is enabled. - - FSF: - - If this insertion is suitable for direct output (completely simple), - return 0. A value of 1 indicates this *might* not have been simple. - A value of 2 means this did things that call for an undo boundary. */ - -static void -internal_self_insert (Emchar c1, int noautofill) -{ - /* This function can GC */ - /* int hairy = 0; -- unused */ - REGISTER enum syntaxcode synt; - REGISTER Emchar c2; - Lisp_Object overwrite; - struct Lisp_Char_Table *syntax_table; - struct buffer *buf = current_buffer; - int tab_width; - - overwrite = buf->overwrite_mode; - syntax_table = XCHAR_TABLE (buf->mirror_syntax_table); - -#if 0 - /* No, this is very bad, it makes undo *always* undo a character at a time - instead of grouping consecutive self-inserts together. Nasty nasty. - */ - if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions) - || !NILP (Vbefore_change_function) || !NILP (Vafter_change_function)) - hairy = 1; -#endif - - if (!NILP (overwrite) - && BUF_PT (buf) < BUF_ZV (buf) - && (EQ (overwrite, Qoverwrite_mode_binary) - || (c1 != '\n' && BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\n')) - && (EQ (overwrite, Qoverwrite_mode_binary) - || BUF_FETCH_CHAR (buf, BUF_PT (buf)) != '\t' - || ((tab_width = XINT (buf->tab_width), tab_width <= 0) - || tab_width > 20 - || !((current_column (buf) + 1) % tab_width)))) - { - buffer_delete_range (buf, BUF_PT (buf), BUF_PT (buf) + 1, 0); - /* hairy = 2; */ - } - - if (!NILP (buf->abbrev_mode) - && !WORD_SYNTAX_P (syntax_table, c1) - && NILP (buf->read_only) - && BUF_PT (buf) > BUF_BEGV (buf)) - { - c2 = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1); - - if (WORD_SYNTAX_P (syntax_table, c2)) - { -#if 1 - Fexpand_abbrev (); -#else /* FSFmacs */ - Lisp_Object sym = Fexpand_abbrev (); - - /* I think this is too bogus to add. The function should - have a way of examining the character to be inserted, so - it can decide whether to insert it or not. We should - design it better than that. */ - - /* Here FSFmacs remembers MODIFF, compares it after - Fexpand_abbrev() finishes, and updates HAIRY. */ - - /* NOTE: we cannot simply check for Vlast_abbrev, because - Fexpand_abbrev() can bail out before setting it to - anything meaningful, leaving us stuck with an old value. - Thus Fexpand_abbrev() was extended to return the actual - abbrev symbol. */ - if (!NILP (sym) - && !NILP (symbol_function (XSYMBOL (sym))) - && SYMBOLP (symbol_function (XSYMBOL (sym)))) - { - Lisp_Object prop = Fget (symbol_function (XSYMBOL (sym)), - Qno_self_insert, Qnil); - if (!NILP (prop)) - return; - } -#endif /* FSFmacs */ - } - } - if ((c1 == ' ' || c1 == '\n') - && !noautofill - && !NILP (buf->auto_fill_function)) - { - buffer_insert_emacs_char (buf, c1); - if (c1 == '\n') - /* After inserting a newline, move to previous line and fill */ - /* that. Must have the newline in place already so filling and */ - /* justification, if any, know where the end is going to be. */ - BUF_SET_PT (buf, BUF_PT (buf) - 1); - call0 (buf->auto_fill_function); - if (c1 == '\n') - BUF_SET_PT (buf, BUF_PT (buf) + 1); - /* hairy = 2; */ - } - else - buffer_insert_emacs_char (buf, c1); - - /* If previous command specified a face to use, use it. */ - if (!NILP (Vself_insert_face) - && EQ (Vlast_command, Vself_insert_face_command)) - { - Lisp_Object before = make_int (BUF_PT (buf) - 1); - Lisp_Object after = make_int (BUF_PT (buf)); - Fput_text_property (before, after, Qface, Vself_insert_face, Qnil); - Fput_text_property (before, after, Qstart_open, Qt, Qnil); - Fput_text_property (before, after, Qend_open, Qnil, Qnil); - /* #### FSFmacs properties are normally closed ("sticky") on the - end but not the beginning. It's the opposite for us. */ - Vself_insert_face = Qnil; - } - synt = SYNTAX (syntax_table, c1); - if ((synt == Sclose || synt == Smath) - && !NILP (Vblink_paren_function) && INTERACTIVE - && !noautofill) - { - call0 (Vblink_paren_function); - /* hairy = 2; */ - } - - /* return hairy; */ -} - -/* (this comes from Mule but is a generally good idea) */ - -DEFUN ("self-insert-internal", Fself_insert_internal, 1, 1, 0, /* -Invoke `self-insert-command' as if CH is entered from keyboard. -*/ - (ch)) -{ - /* This function can GC */ - CHECK_CHAR_COERCE_INT (ch); - internal_self_insert (XCHAR (ch), 0); - return Qnil; -} - -/* module initialization */ - -void -syms_of_cmds (void) -{ - defsymbol (&Qkill_forward_chars, "kill-forward-chars"); - defsymbol (&Qself_insert_command, "self-insert-command"); - defsymbol (&Qoverwrite_mode_binary, "overwrite-mode-binary"); - defsymbol (&Qno_self_insert, "no-self-insert"); - - DEFSUBR (Fforward_char); - DEFSUBR (Fbackward_char); - DEFSUBR (Fforward_line); - DEFSUBR (Fbeginning_of_line); - DEFSUBR (Fend_of_line); - - DEFSUBR (Fpoint_at_bol); - DEFSUBR (Fpoint_at_eol); - - DEFSUBR (Fdelete_char); - DEFSUBR (Fdelete_backward_char); - - DEFSUBR (Fself_insert_command); - DEFSUBR (Fself_insert_internal); -} - -void -vars_of_cmds (void) -{ - DEFVAR_LISP ("self-insert-face", &Vself_insert_face /* -If non-nil, set the face of the next self-inserting character to this. -See also `self-insert-face-command'. -*/ ); - Vself_insert_face = Qnil; - - DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command /* -This is the command that set up `self-insert-face'. -If `last-command' does not equal this value, we ignore `self-insert-face'. -*/ ); - Vself_insert_face_command = Qnil; - - DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function /* -Function called, if non-nil, whenever a close parenthesis is inserted. -More precisely, a char with closeparen syntax is self-inserted. -*/ ); - Vblink_paren_function = Qnil; -} diff --git a/src/commands.h b/src/commands.h deleted file mode 100644 index 3fcfcda..0000000 --- a/src/commands.h +++ /dev/null @@ -1,128 +0,0 @@ -/* Definitions needed by most editing commands. - Copyright (C) 1985-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: FSF 19.30. */ - -#ifndef _XEMACS_COMMANDS_H_ -#define _XEMACS_COMMANDS_H_ - -#if 0 /* FSFmacs */ -#define Ctl(c) ((c)&037) -#endif - -/* bunches of FSF keymap and minibuffer stuff not here (in Lisp) */ - -extern Lisp_Object Vlast_command_event; - -extern Lisp_Object Vlast_input_event; - -/* These next two for compatibility; they are V... because they can be - nil. (Many FSFmacs equivalent variables incorrectly omit the V - even though they are Lisp_Objects.) */ -/* Last character of last key sequence. */ -extern Lisp_Object Vlast_command_char; - -extern Lisp_Object Vlast_input_char; - -#if 0 /* FSFmacs */ -/* Last input character read as a command, not counting menus - reached by the mouse. */ -extern Lisp_Object Vlast_nonmenu_event; -#endif - -#if 0 /* Local to event-stream.c */ -/* List of command events to be re-read, or Qnil. */ -extern Lisp_Object Vunread_command_events; -#endif - -#if 0 /* FSFmacs */ -/* Command char event to be re-read, or -1 if none. - Setting this is obsolete, but some things should still check it. */ -extern int unread_command_char; -#endif - -/* Last command executed by the editor command loop, not counting - commands that set the prefix argument. */ - -extern Lisp_Object Vlast_command; - -/* The command being executed by the command loop. - Commands may set this, and the value set will be copied into - Vlast_command instead of the actual command. */ -extern Lisp_Object Vthis_command; - -#if 0 /* FSFmacs */ -/* If not Qnil, this is a switch-frame event which we decided to put - off until the end of a key sequence. This should be read as the - next command input, after any Vunread_command_events. - - read_key_sequence uses this to delay switch-frame events until the - end of the key sequence; Fread_char uses it to put off switch-frame - events until a non-ASCII event is acceptable as input. */ -extern Lisp_Object unread_switch_frame; -#endif - -#if 0 /* Local to event-stream.c */ -/* The value of point when the last command was executed. */ -extern int last_point_position; - -/* The buffer that was current when the last command was started. */ -extern Lisp_Object last_point_position_buffer; -#endif - -/* This is so incredibly losing that it's been completely eliminated - from the code. Trust me, there are cleaner, safer ways of - achieving the same functionality (e.g. use select()). */ -/* extern int immediate_quit; Nonzero means ^G can quit instantly */ - -/* Nonzero if input is coming from the keyboard */ - -#define INTERACTIVE (NILP (Vexecuting_macro) && !noninteractive) - -/* Set this nonzero to force reconsideration of modeline. */ - -extern int modeline_changed; - -extern Lisp_Object recent_keys_ring; -extern int recent_keys_ring_index; - -/* #ifndef LISP_COMMAND_LOOP */ -extern Lisp_Object Vtop_level; -/* #else */ -extern Lisp_Object Vcommand_loop; -/* #endif */ -DECLARE_DOESNT_RETURN (initial_command_loop (Lisp_Object)); -Lisp_Object call_command_loop (Lisp_Object catch_errors); -extern int command_loop_level; - -extern Lisp_Object Vkeyboard_translate_table; -extern Lisp_Object Vlast_input_time; -extern Lisp_Object Vcurrent_mouse_event; - -extern int zmacs_regions; -extern int zmacs_region_active_p; -extern int zmacs_region_stays; -void zmacs_update_region (void); -void zmacs_deactivate_region (void); -Lisp_Object zmacs_region_buffer (void); - -extern Lisp_Object Vthis_command_keys; /* event-stream.c */ - -#endif /* _XEMACS_COMMANDS_H_ */ diff --git a/src/config.h.in b/src/config.h.in deleted file mode 100644 index 40b56c3..0000000 --- a/src/config.h.in +++ /dev/null @@ -1,816 +0,0 @@ -/* XEmacs site configuration template file. -*- C -*- - Copyright (C) 1986, 1991-1994, 1998, 1999 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. */ - -/* Significantly divergent from FSF. */ - -/* No code in XEmacs #includes config.h twice, but some of the code - intended to work with other packages as well (like gmalloc.c) - think they can include it as many times as they like. */ -#ifndef _SRC_CONFIG_H_ -#define _SRC_CONFIG_H_ - -/* alloca twiddling belongs in one place, not the s&m headers - AIX requires this to be the first thing in the file. */ -#undef HAVE_ALLOCA_H - -#ifndef NOT_C_CODE -#ifdef __GNUC__ -#define alloca __builtin_alloca -#elif HAVE_ALLOCA_H -#include -#elif defined(_AIX) -#pragma alloca -#elif ! defined (alloca) -char *alloca(); -#endif -#endif /* C code */ - - -/* Use this to add code in a structured way to FSF-maintained source - files so as to make it obvious where XEmacs changes are. */ -#define XEMACS 1 - -/* Allow s&m files to differentiate OS versions without having - multiple files to maintain. */ -#undef OS_RELEASE - -/* The configuration name. This is used as the install directory name - for the lib-src programs. */ -#undef EMACS_CONFIGURATION - -/* The configuration options. This is exported to Lisp. */ -#undef EMACS_CONFIG_OPTIONS - -/* The version info from version.sh. Used in #pragma ident in emacs.c */ -#undef EMACS_MAJOR_VERSION -#undef EMACS_MINOR_VERSION -#undef EMACS_BETA_VERSION -#undef EMACS_VERSION -#undef XEMACS_CODENAME -/* InfoDock versions, not used with XEmacs */ -#undef INFODOCK_MAJOR_VERSION -#undef INFODOCK_MINOR_VERSION -#undef INFODOCK_BUILD_VERSION - -/* Make all functions available on AIX. See AC_AIX. */ -#undef _ALL_SOURCE - -/* Make all functions available on GNU libc systems. See features.h. */ -#undef _GNU_SOURCE - -/* Used to identify the XEmacs version in stack traces. */ -#undef STACK_TRACE_EYE_CATCHER - -/* Allow the configurer to specify if she wants site-lisp. */ -#undef INHIBIT_SITE_LISP - -/* Allow the configurer to specify if she wants site-modules. */ -#undef INHIBIT_SITE_MODULES - -/* This will be removed in 19.15. */ -/* Hah! Try 20.3 ... */ -/* Hah! Try never ... */ -/* If at first you don't succeed, try, try again. */ -/* #define LOSING_BYTECODE */ - -/* Undefine on systems which don't have processes */ -#undef HAVE_UNIX_PROCESSES - -/* Does XEmacs support floating-point numbers? */ -#undef LISP_FLOAT_TYPE - -/* Define GNU_MALLOC if you want to use the GNU memory allocator. */ -#undef GNU_MALLOC - -/* Define if you are using the GNU C Library. -- experimental. */ -#undef DOUG_LEA_MALLOC - -/* Define if you are using libmcheck.a from the GNU C Library. */ -#undef HAVE_LIBMCHECK - -/* Define if you are using dlmalloc from the Linux C library. */ -#undef _NO_MALLOC_WARNING_ - -/* Use the system malloc? */ -#undef USE_SYSTEM_MALLOC - -/* Use a debugging malloc? -- experimental */ -#undef USE_DEBUG_MALLOC - -/* Compile in TTY support? */ -#undef HAVE_TTY - -/* Compile in support for MS windows? */ -#undef HAVE_MS_WINDOWS - -/* special cygwin process handling? */ -#undef HAVE_MSG_SELECT - -/* Compile in support for the X window system? */ -#undef HAVE_X_WINDOWS - -/* Defines for building X applications */ -#ifdef HAVE_X_WINDOWS -/* The following will be defined if xmkmf thinks they are necessary */ -#undef SVR4 -#undef SYSV -#undef AIXV3 -#undef _POSIX_SOURCE -#undef _BSD_SOURCE -#undef _SVID_SOURCE -#undef X_LOCALE -#undef NARROWPROTO -/* The following should always be defined, no matter what xmkmf thinks. */ -#ifndef NeedFunctionPrototypes -#define NeedFunctionPrototypes 1 -#endif -#ifndef FUNCPROTO -#define FUNCPROTO 15 -#endif -#endif /* HAVE_X_WINDOWS */ - -/* Define HAVE_WINDOW_SYSTEM if any windowing system is available. */ -#if defined (HAVE_X_WINDOWS) || defined(HAVE_MS_WINDOWS) /* || defined (HAVE_NEXTSTEP) */ -#define HAVE_WINDOW_SYSTEM -#endif - -/* Define HAVE_UNIXOID_EVENT_LOOP if we use select() to wait for events. */ -#if defined (HAVE_X_WINDOWS) || defined (HAVE_TTY) || defined(HAVE_MSG_SELECT) -#define HAVE_UNIXOID_EVENT_LOOP -#endif - -/* Are we using XFree386? */ -#undef HAVE_XFREE386 - -#undef THIS_IS_X11R4 -#undef THIS_IS_X11R5 -#undef THIS_IS_X11R6 - -/* Where do we find bitmaps? */ -#undef BITMAPDIR - -/* USER_FULL_NAME returns a string that is the user's full name. - It can assume that the variable `pw' points to the password file - entry for this user. - - At some sites, the pw_gecos field contains the user's full name. - If neither this nor any other field contains the right thing, use - pw_name, giving the user's login name, since that is better than - nothing. */ -#define USER_FULL_NAME pw->pw_gecos - -/* Define AMPERSAND_FULL_NAME if you use the convention - that & in the full name stands for the login id. */ -#undef AMPERSAND_FULL_NAME - -/* Some things figured out by the configure script, grouped as they are in - configure.in. */ -#undef HAVE_MCHECK_H -#undef HAVE_MACH_MACH_H -#undef HAVE_SYS_STROPTS_H -#undef HAVE_SYS_TIMEB_H -#undef HAVE_SYS_TIME_H -#undef HAVE_UNISTD_H -#undef HAVE_UTIME_H -#undef HAVE_SYS_WAIT_H -#undef HAVE_LIBINTL_H -#undef HAVE_LIBGEN_H -#undef HAVE_LOCALE_H -#undef HAVE_FCNTL_H -#undef HAVE_ULIMIT_H -#undef HAVE_X11_XLOCALE_H -#undef HAVE_LINUX_VERSION_H -#undef HAVE_CYGWIN_VERSION_H -#undef HAVE_INTTYPES_H -#undef HAVE_SYS_UN_H -#undef HAVE_A_OUT_H -#undef STDC_HEADERS -#undef TIME_WITH_SYS_TIME -#undef WORDS_BIGENDIAN -#undef HAVE_VFORK_H -#undef HAVE_KSTAT_H -#undef HAVE_SYS_PSTAT_H -#undef vfork - -#undef HAVE_LONG_FILE_NAMES - -/* Use lock files to detect multiple edits of the same file? */ -#undef CLASH_DETECTION - -/* Have shared library support */ -#undef HAVE_DLOPEN -#undef HAVE_DLERROR -#undef HAVE__DLERROR -#undef HAVE_SHL_LOAD -#undef HAVE_DLD_INIT -#undef HAVE_SHLIB -#undef HAVE_DLFCN_H - -#undef HAVE_LIBKSTAT -#undef HAVE_LIBINTL -#undef HAVE_LIBDNET -#undef HAVE_LIBRESOLV - -/* Is `sys_siglist' declared by ? */ -#undef SYS_SIGLIST_DECLARED - -/* Is `struct utimbuf' declared by ? */ -#undef HAVE_STRUCT_UTIMBUF - -/* Is `struct timeval' declared by ? */ -#undef HAVE_TIMEVAL - - -#undef TM_IN_SYS_TIME -#undef HAVE_TM_ZONE -#undef HAVE_TZNAME - -/* Is `h_errno' declared by ? */ -#undef HAVE_H_ERRNO - -/* Does `localtime' cache TZ? */ -#undef LOCALTIME_CACHE - -/* Can `gettimeofday' accept two arguments? */ -#undef GETTIMEOFDAY_ONE_ARGUMENT - -#undef HAVE_MMAP -#undef HAVE_STRCOLL -#undef HAVE_GETPGRP -#undef GETPGRP_VOID - -#undef HAVE_INVERSE_HYPERBOLIC - -#undef HAVE_CBRT -#undef HAVE_CLOSEDIR -#undef HAVE_DUP2 -#undef HAVE_EACCESS -#undef HAVE_FMOD -#undef HAVE_FPATHCONF -#undef HAVE_FREXP -#undef HAVE_FTIME -#undef HAVE_GETHOSTNAME -#undef HAVE_GETPAGESIZE -#undef HAVE_GETTIMEOFDAY -#undef HAVE_GETWD -#undef HAVE_GETCWD -#undef HAVE_LOGB -#undef HAVE_LRAND48 -#undef HAVE_MATHERR -#undef HAVE_MKDIR -#undef HAVE_MKTIME -#undef HAVE_PERROR -#undef HAVE_POLL -#undef HAVE_RANDOM -#undef HAVE_REALPATH -#undef HAVE_RENAME -#undef HAVE_RES_INIT -#undef HAVE_RINT -#undef HAVE_RMDIR -#undef HAVE_SELECT -#undef HAVE_SETITIMER -#undef HAVE_SETPGID -#undef HAVE_SETSID -#undef HAVE_SIGBLOCK -#undef HAVE_SIGHOLD -#undef HAVE_SIGPROCMASK -#undef HAVE_SIGSETJMP -#undef HAVE_SNPRINTF -#undef HAVE_STRCASECMP -#undef HAVE_STRERROR -#undef HAVE_TZSET -#undef HAVE_ULIMIT -#undef HAVE_USLEEP -#undef HAVE_UTIMES -#undef HAVE_WAITPID -#undef HAVE_VSNPRINTF -#undef HAVE_SOCKETS -#undef HAVE_SOCKADDR_SUN_LEN -#undef HAVE_MULTICAST -#undef HAVE_SYSVIPC - -#undef SYSV_SYSTEM_DIR -#undef NONSYSTEM_DIR_LIBRARY - -#undef HAVE_TERMIOS -#undef HAVE_TERMIO -#undef NO_TERMIO -#undef SIGNALS_VIA_CHARACTERS - -#undef NLIST_STRUCT - -/* Compile in support for SOCKS? */ -#undef HAVE_SOCKS - -/* Compile in support for X pixmaps via the `xpm' library? */ -#undef HAVE_XPM -#undef FOR_MSW - -/* Compile in support for "X faces" via the `compface' library? - This enables graphical display of X-face headers in mail/news messages */ -#undef HAVE_XFACE - -/* Compile in support for JPEG images */ -#undef HAVE_JPEG - -/* Compile in support for TIFF images */ -#undef HAVE_TIFF - -/* Compile in support for GIF images */ -#undef HAVE_GIF - -/* Compile in support for PNG images */ -#undef HAVE_PNG - -/* Do you have the Xmu library? - This should always be the case except on losing HP-UX systems. */ -#undef HAVE_XMU - -/* Compile in support for DBM databases? May require libgdbm or libdbm. */ -#undef HAVE_DBM - -/* Compile in support for Berkeley DB style databases? May require libdb. */ -#undef HAVE_BERKELEY_DB -/* Full #include file path for Berkeley DB's db.h */ -#undef DB_H_PATH - -/* Do we have either DBM or Berkeley DB database support? */ -#undef HAVE_DATABASE - -/* Do we have LDAP support? */ -#undef HAVE_LDAP -/* Do we have the LDAP library of the University of Michigan ? */ -#undef HAVE_UMICH_LDAP -/* Do we have Netscape LDAP SDK library */ -#undef HAVE_NS_LDAP - -/* Do you have the Xauth library present? This will add some extra - functionality to gnuserv. */ -#undef HAVE_XAUTH - -/* Compile in support for gpm (General Purpose Mouse)? */ -#undef HAVE_GPM - -/* Compile in support for ncurses? */ -#undef HAVE_NCURSES -/* Full #include file paths for ncurses' curses.h and term.h. */ -#undef CURSES_H_PATH -#undef TERM_H_PATH - -/* Define USE_ASSERTIONS if you want the abort() to be changed to assert(). - If the assertion fails, assert_failed() will be called. This is - recommended for general use because it gives more info about the crash - than just the abort() message. Too many people "Can't find the corefile" - or have limit-ed core dumps out of existence. */ -#undef USE_ASSERTIONS - -/* Define one or more of the following if you want lots of extra checks - (e.g. structure validation) compiled in. These should be turned - on during the beta-test cycle. */ - -/* Check the entire extent structure of a buffer each time an extent - change is done, and do other extent-related checks. */ -#undef ERROR_CHECK_EXTENTS -/* Make sure that all X... macros are dereferencing the correct type, - and that all XSET... macros (as much as possible) are setting the - correct type of structure. Highly recommended for all - development work. */ -#undef ERROR_CHECK_TYPECHECK -/* Make sure valid buffer positions are passed to BUF_* macros. */ -#undef ERROR_CHECK_BUFPOS -/* Attempt to catch bugs related to garbage collection (e.g. not GCPRO'ing). */ -#undef ERROR_CHECK_GC -/* Attempt to catch freeing of a non-malloc()ed block, heap corruption, etc. */ -#undef ERROR_CHECK_MALLOC - -/* Define DEBUG_XEMACS if you want extra debugging code compiled in. - This is mainly intended for use by developers. */ -#undef DEBUG_XEMACS - -/* Define MEMORY_USAGE_STATS if you want extra code compiled in to - determine where XEmacs' memory is going. */ -#undef MEMORY_USAGE_STATS - -/* Define QUANTIFY if using Quantify from Rational/Pure/Atria Software. - This adds some additional calls to control data collection. - It is only intended for use by the developers. */ -#undef QUANTIFY - -/* Define QUANTIFY if using Purify from Rational/Pure/Atria Software. - It is only intended for use by the developers. */ -#undef PURIFY - -#if (defined (QUANTIFY) || defined (PURIFY)) && !defined (XLIB_ILLEGAL_ACCESS) -#define XLIB_ILLEGAL_ACCESS 1 -#endif - -/* Define EXTERNAL_WIDGET to compile support for using the editor as a - widget within another program. */ -#undef EXTERNAL_WIDGET - -/* There are some special-case defines for gcc and lcc. */ -#undef USE_GCC -#undef USE_LCC - -/* Allow the user to override the default value of PURESIZE at configure - time. This must come before we include the sys files in order for - it to be able to override any changes in them. */ -#undef RAW_PURESIZE - -/* Define this if you want level 2 internationalization compliance - (localized collation and formatting). Generally this should be - defined, unless your system doesn't have the strcoll() and - setlocale() library routines. This really should be (NOT! -mrb) - defined in the appropriate s/ or m/ file. */ -#undef I18N2 - -/* Define this if you want level 3 internationalization compliance - (localized messaging). This will cause a small runtime performance - penalty, as the strings are read from the message catalog(s). - For this you need the gettext() and dgetext() library routines. - WARNING, this code is under construction. */ -#undef I18N3 - -/* Compile in support for CDE (Common Desktop Environment) drag and drop? - Requires libDtSvc, which typically must be present at runtime. */ -#undef HAVE_CDE - -/* Compile in support for OffiX Drag and Drop? */ -#undef HAVE_OFFIX_DND - -/* Compile in generic Drag'n'Drop API */ -#undef HAVE_DRAGNDROP - -/* Compile in support for proper session-management. */ -#undef HAVE_SESSION - -/* Define this if you want Mule support (multi-byte character support). - There may be some performance penalty, although it should be small - if you're working with ASCII files. */ -#undef MULE - -/* Define this if you want file coding support */ -#undef FILE_CODING - -/* Do we want to use X window input methods for use with Mule? (requires X11R5) - If so, use raw Xlib or higher level Motif interface? */ -#undef HAVE_XIM -#undef XIM_XLIB -#undef XIM_MOTIF -#undef USE_XFONTSET - -/* Non-XIM input methods for use with Mule. */ -#undef HAVE_CANNA -#undef HAVE_WNN -#undef WNN6 - -/* Enable special GNU Make features in the Makefiles. */ -#undef USE_GNU_MAKE - -/* Debugging option: Don't automatically rebuild the DOC file. - This saves a lot of time when you're repeatedly - compiling-running-crashing. */ -#undef NO_DOC_FILE - -/* Defined by AC_C_CONST in configure.in */ -#undef const - -#define CONST const - -/* If defined, use unions instead of ints. A few systems (DEC Alpha) - seem to require this, probably because something with the int - definitions isn't right with 64-bit systems. */ -#undef USE_UNION_TYPE - -/* If defined, use a minimal number of tagbits. This allows usage of more - advanced versions of malloc (like the Doug Lea new GNU malloc) and larger - integers. */ -/* --use-minimal-tagbits */ -#undef USE_MINIMAL_TAGBITS - -/* --use-indexed-lrecord-implementation */ -#undef USE_INDEXED_LRECORD_IMPLEMENTATION - -/* The configuration script defines opsysfile to be the name of the - s/...h file that describes the system type you are using. - The file is chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of systems and the - configuration names to use for them. - - See s/template.h for documentation on writing s/...h files. */ - -#if defined (__cplusplus) && !defined (NOT_C_CODE) -extern "C" { -#endif -#undef config_opsysfile -#include config_opsysfile - -/* The configuration script defines machfile to be the name of the - m/...h file that describes the machine you are using. The file is - chosen based on the configuration name you give. - - See the file ../etc/MACHINES for a list of machines and the - configuration names to use for them. - - See m/template.h for documentation on writing m/...h files. */ -#undef config_machfile -#include config_machfile -#if defined (__cplusplus) && !defined (NOT_C_CODE) -} -#endif - -#if defined (USE_SYSTEM_MALLOC) && !defined (SYSTEM_MALLOC) -#define SYSTEM_MALLOC -#endif - -/* Use the relocating allocator for buffer space? */ -#undef REL_ALLOC - -/* Define the return type of signal handlers if the s/xxx.h file - did not already do so. */ -#define RETSIGTYPE void - -/* SIGTYPE is the macro we actually use. */ -#ifndef SIGTYPE -#define SIGTYPE RETSIGTYPE -#define SIGRETURN return -#endif - -/* Allow the source to use standard types */ -#undef size_t -#undef pid_t -#undef mode_t -#undef off_t -#undef uid_t -#undef gid_t - -/* Define DYNODUMP if it is necessary to properly dump on this system. - Currently this is only Solaris 2.x, for x < 6. */ -#undef DYNODUMP - -/* Compile in support for Sun Sparcworks/WorkShop? */ -#undef SUNPRO - -/* Sun SparcStations, SGI machines, and HP9000s700s have built-in - support for playing sound files. (On Suns, the sound support is - usually found in /usr/demo/SOUND - you may need to install the - "SUNWaudmo" package.) */ -#undef HAVE_NATIVE_SOUND -/* Native sound may be provided via soundcard.h, in various directories */ -#undef SOUNDCARD_H_PATH - -/* Compile in support for NAS (Network Audio System)? - NAS_NO_ERROR_JUMP means that the NAS libraries don't include some - error handling changes. */ -#undef HAVE_NAS_SOUND -#undef NAS_NO_ERROR_JUMP - -/* Compile in support for SunPro usage-tracking code? */ -#undef USAGE_TRACKING - -/* Compile in support for Tooltalk? */ -#undef TOOLTALK -/* tt_c.h might be in "Tt" or "desktop" subdirectories */ -#undef TT_C_H_PATH - -/* Toolkits used by lwlib for various widgets... */ -#undef LWLIB_USES_MOTIF -#undef LWLIB_USES_ATHENA -#undef LWLIB_MENUBARS_LUCID -#undef LWLIB_MENUBARS_MOTIF -#undef LWLIB_SCROLLBARS_LUCID -#undef LWLIB_SCROLLBARS_MOTIF -#undef LWLIB_SCROLLBARS_ATHENA -#undef LWLIB_SCROLLBARS_ATHENA3D -#undef LWLIB_DIALOGS_MOTIF -#undef LWLIB_DIALOGS_ATHENA -#undef LWLIB_DIALOGS_ATHENA3D - -/* Other things that can be disabled by configure. */ -#undef HAVE_MENUBARS -#undef HAVE_SCROLLBARS -#undef HAVE_DIALOGS -#undef HAVE_TOOLBARS - - -#if defined (HAVE_MENUBARS) || defined (HAVE_DIALOGS) -#define HAVE_POPUPS -#endif - -/* If you are using SunOS 4.1.1 and X11r5, then you need this patch. - There is a stupid bug in the SunOS libc.a: two functions which X11r5 - uses, mbstowcs() and wcstombs(), are unusable when programs are - statically linked (as XEmacs must be) because the static version of - libc.a contains the *dynamic* versions of these functions. These - functions don't seem to be called when XEmacs is running, so it's - enough to define stubs for them. - - This appears to be fixed in SunOS 4.1.2. - - Also, SunOS 4.1.1 contains buggy versions of strcmp and strcpy that - sometimes reference memory past the end of the string, which can segv. - I don't know whether this is has been fixed as of 4.1.2 or 4.1.3. */ -#if defined (sparc) && !defined (USG) -#define OBJECTS_SYSTEM sunOS-fix.o strcmp.o strcpy.o -#endif - -/* If you turn this flag on, it forces encapsulation in all -circumstances; this can be used to make sure things compile OK -on various systems. */ -#define DEBUG_ENCAPSULATION - -/* basic system calls */ - -#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_READ -# define ENCAPSULATE_WRITE -#endif -#if defined (INTERRUPTIBLE_OPEN) || defined (MULE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_OPEN -#endif -#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_CLOSE -#endif - -/* stdio calls */ - -#if defined (INTERRUPTIBLE_IO) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FREAD -# define ENCAPSULATE_FWRITE -#endif -#if defined (INTERRUPTIBLE_OPEN) || defined (MULE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FOPEN -#endif -#if defined (INTERRUPTIBLE_CLOSE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_FCLOSE -#endif - -/* directory calls */ - -#if defined (MULE) || defined (DEBUG_ENCAPSULATION) -# define ENCAPSULATE_CHDIR -# define ENCAPSULATE_MKDIR -# define ENCAPSULATE_OPENDIR -# define ENCAPSULATE_CLOSEDIR -# define ENCAPSULATE_READDIR -# define ENCAPSULATE_RMDIR - -/* file-information calls */ - -#ifdef HAVE_EACCESS -# define ENCAPSULATE_EACCESS -#endif -# define ENCAPSULATE_ACCESS -# define ENCAPSULATE_LSTAT -# define ENCAPSULATE_READLINK -# define ENCAPSULATE_STAT - -/* file-manipulation calls */ - -# define ENCAPSULATE_CHMOD -# define ENCAPSULATE_CREAT -# define ENCAPSULATE_LINK -# define ENCAPSULATE_RENAME -# define ENCAPSULATE_SYMLINK -# define ENCAPSULATE_UNLINK -# define ENCAPSULATE_EXECVP -#endif /* defined (MULE) || defined (DEBUG_ENCAPSULATION) */ - -#ifdef HAVE_CANNA -# define CANNA2 -# define CANNA_MULE -# define CANNA_PURESIZE 0 -#else /* not CANNA */ -# define CANNA_PURESIZE 0 -#endif /* not CANNA */ - -#if (defined (MSDOS) && defined (FEPCTRL)) || (defined (WIN32) && defined (USE_IME)) -#define HAVE_FEP -#endif - -#if defined (HAVE_SOCKS) && !defined (DO_NOT_SOCKSIFY) -#define accept Raccept -#define bind Rbind -#define connect Rconnect -#define getsockname Rgetsockname -#define listen Rlisten -#endif /* HAVE_SOCKS && !DO_NOT_SOCKSIFY */ - -#undef SIZEOF_SHORT -#undef SIZEOF_INT -#undef SIZEOF_LONG -#undef SIZEOF_LONG_LONG -#undef SIZEOF_VOID_P - -#ifndef BITS_PER_CHAR -#define BITS_PER_CHAR 8 -#endif -#define SHORTBITS (SIZEOF_SHORT * BITS_PER_CHAR) -#define INTBITS (SIZEOF_INT * BITS_PER_CHAR) -#define LONGBITS (SIZEOF_LONG * BITS_PER_CHAR) -#define LONG_LONG_BITS (SIZEOF_LONG_LONG * BITS_PER_CHAR) -#define VOID_P_BITS (SIZEOF_VOID_P * BITS_PER_CHAR) - -#ifndef NOT_C_CODE -#ifdef __cplusplus -#define HAVE_INLINE 1 -#define INLINE inline -#else /* not C++ */ -/* Does the keyword `inline' exist? */ -#undef HAVE_INLINE -#undef inline - -# ifdef HAVE_INLINE -# ifdef __GNUC__ -# ifdef DONT_EXTERN_INLINE_FUNCTIONS -# define INLINE inline -# else -# define INLINE extern inline -# endif -# else -# define INLINE static inline -# endif /* __GNUC__ */ -# else -# define INLINE static -# endif /* HAVE_INLINE */ -#endif /* not C++ */ -#endif /* C code */ - -#if defined (__cplusplus) && !defined (NOT_C_CODE) -/* Avoid C++ keywords used as ordinary C identifiers */ -#define class c_class -#define new c_new -#define this c_this -#define catch c_catch -#endif /* C++ */ - -/* Strictly speaking, only int or unsigned int are valid types in a - bitfield. In practice, we would like to use enums as bitfields. - The following should just result in warning avoidance: - warning: nonportable bit-field type */ -#ifdef __GNUC__ -#define enum_field(enumeration_type) enum enumeration_type -#else -#define enum_field(enumeration_type) unsigned int -#endif - -/* We want to avoid saving the signal mask if possible, because - that necessitates a system call. */ -#ifdef HAVE_SIGSETJMP -# define SETJMP(x) sigsetjmp (x, 0) -# define LONGJMP(x, y) siglongjmp (x, y) -# define JMP_BUF sigjmp_buf -#else -# define SETJMP(x) setjmp (x) -# define LONGJMP(x, y) longjmp (x, y) -# define JMP_BUF jmp_buf -#endif - -/* movemail options */ -/* Should movemail use POP3 for mail access? */ -#undef MAIL_USE_POP -/* Should movemail use kerberos for POP authentication? */ -#undef KERBEROS -/* Should movemail use hesiod for getting POP server host? */ -#undef HESIOD -/* Determine type of mail locking. */ -/* Play preprocessor games so that configure options override s&m files */ -#undef REAL_MAIL_USE_LOCKF -#undef REAL_MAIL_USE_FLOCK -#undef MAIL_USE_LOCKF -#undef MAIL_USE_FLOCK -#ifdef REAL_MAIL_USE_FLOCK -#define MAIL_USE_FLOCK -#endif -#ifdef REAL_MAIL_USE_LOCKF -#define MAIL_USE_LOCKF -#endif - -#undef LISPDIR_USER_DEFINED -#undef PACKAGE_PATH_USER_DEFINED -#undef SITELISPDIR_USER_DEFINED -#undef ARCHLIBDIR_USER_DEFINED -#undef ETCDIR_USER_DEFINED -#undef LOCKDIR_USER_DEFINED -#undef INFODIR_USER_DEFINED -#undef INFOPATH_USER_DEFINED - -#endif /* _SRC_CONFIG_H_ */ diff --git a/src/conslots.h b/src/conslots.h deleted file mode 100644 index dfa9752..0000000 --- a/src/conslots.h +++ /dev/null @@ -1,96 +0,0 @@ -/* Definitions of marked slots in consoles - Copyright (C) 1990, 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: Mule 2.0, FSF 19.30. (see FSF keyboard.h.) */ - -/* In the declaration of the console structure, this file is included - after defining MARKED_SLOT(x) to be Lisp_Object x; i.e. just a slot - definition. In the garbage collector this file is included after - defining MARKED_SLOT(x) to be mark_object(console->x). */ - - /* Name of this console, for resourcing and printing purposes. - If not explicitly given, it's initialized in a console-specific - manner. */ - MARKED_SLOT (name); - - /* What this console is connected to */ - MARKED_SLOT (connection); - - /* A canonical name for the connection that is used to determine - whether create_console() is being called on an existing console. */ - MARKED_SLOT (canon_connection); - - /* List of devices on this console. */ - MARKED_SLOT (device_list); - - /* Currently selected device. */ - MARKED_SLOT (selected_device); - - /* Most-recently-selected non-minibuffer-only frame. Always - the same as the selected frame, unless that's a minibuffer-only - frame. */ - MARKED_SLOT (last_nonminibuf_frame); - - /* If non-nil, a keymap that overrides all others but applies only to - this console. Lisp code that uses this instead of calling next-event - can effectively wait for input in the any-console state, and hence - avoid blocking out the other consoles. See universal-argument in - lisp/simple.el for an example. - - #### This comes from FSF Emacs; but there's probably a better - solution that involves making next-event itself work over all - consoles. */ - MARKED_SLOT (overriding_terminal_local_map); - - /* Last command executed by the editor command loop, not counting - commands that set the prefix argument. */ - MARKED_SLOT (last_command); - - /* The prefix argument for the next command, in raw form. */ - MARKED_SLOT (prefix_arg); - - /* Where information about a partially completed key sequence - is kept. */ - MARKED_SLOT (command_builder); - - /* Non-nil while a kbd macro is being defined. */ - MARKED_SLOT (defining_kbd_macro); - - /* This is a lisp vector, which contains the events of the keyboard macro - currently being read. It is reallocated when the macro gets too large. - */ - MARKED_SLOT (kbd_macro_builder); - - /* Last anonymous kbd macro defined. */ - MARKED_SLOT (last_kbd_macro); - -#ifdef HAVE_TTY - /* ERASE character from stty settings. */ - MARKED_SLOT (tty_erase_char); -#endif - - /* Minibufferless frames on this console use this frame's minibuffer. */ - MARKED_SLOT (default_minibuffer_frame); - - /* Keymap mapping ASCII function key sequences onto their preferred forms. - Initialized by the terminal-specific lisp files. */ - MARKED_SLOT (function_key_map); - - diff --git a/src/console-msw.c b/src/console-msw.c deleted file mode 100644 index ddda9f6..0000000 --- a/src/console-msw.c +++ /dev/null @@ -1,141 +0,0 @@ -/* Console functions for mswindows. - Copyright (C) 1996 Ben Wing. - -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. */ - -/* Authorship: - - Ben Wing: January 1996, for 19.14. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0 - */ - -#include -#include "lisp.h" - -#include "console-msw.h" - - -DEFINE_CONSOLE_TYPE (mswindows); - - -static int -mswindows_initially_selected_for_input (struct console *con) -{ - return 1; -} - - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_console_mswindows (void) -{ -} - -void -console_type_create_mswindows (void) -{ - INITIALIZE_CONSOLE_TYPE (mswindows, "mswindows", "console-mswindows-p"); - - /* console methods */ -/* CONSOLE_HAS_METHOD (mswindows, init_console); */ -/* CONSOLE_HAS_METHOD (mswindows, mark_console); */ - CONSOLE_HAS_METHOD (mswindows, initially_selected_for_input); -/* CONSOLE_HAS_METHOD (mswindows, delete_console); */ -/* CONSOLE_HAS_METHOD (mswindows, canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (mswindows, canonicalize_device_connection); */ -/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_console_connection); */ -/* CONSOLE_HAS_METHOD (mswindows, semi_canonicalize_device_connection); */ -} - -void -vars_of_console_mswindows (void) -{ - Fprovide (Qmswindows); -} - - -#ifdef DEBUG_XEMACS -#include "events.h" -#include "opaque.h" -/* - * Random helper functions for debugging. - * Intended for use in the MSVC "Watch" window which doesn't like - * the aborts that the error_check_foo() functions can make. - */ -struct lrecord_header * -DHEADER (Lisp_Object obj) -{ - return LRECORDP (obj) ? XRECORD_LHEADER (obj) : NULL; -} - -void * -DOPAQUE_DATA (Lisp_Object obj) -{ - return OPAQUEP (obj) ? OPAQUE_DATA (XOPAQUE (obj)) : NULL; -} - -struct Lisp_Event * -DEVENT (Lisp_Object obj) -{ - return EVENTP (obj) ? XEVENT (obj) : NULL; -} - -struct Lisp_Cons * -DCONS (Lisp_Object obj) -{ - return CONSP (obj) ? XCONS (obj) : NULL; -} - -struct Lisp_Cons * -DCONSCDR (Lisp_Object obj) -{ - return (CONSP (obj) && CONSP (XCDR (obj))) ? XCONS (XCDR (obj)) : 0; -} - -Bufbyte * -DSTRING (Lisp_Object obj) -{ - return STRINGP (obj) ? XSTRING_DATA (obj) : NULL; -} - -struct Lisp_Vector * -DVECTOR (Lisp_Object obj) -{ - return VECTORP (obj) ? XVECTOR (obj) : NULL; -} - -struct Lisp_Symbol * -DSYMBOL (Lisp_Object obj) -{ - return SYMBOLP (obj) ? XSYMBOL (obj) : NULL; -} - -Bufbyte * -DSYMNAME (Lisp_Object obj) -{ - return SYMBOLP (obj) ? string_data (XSYMBOL (obj)->name) : NULL; -} - -#endif diff --git a/src/console-msw.h b/src/console-msw.h deleted file mode 100644 index 25d3293..0000000 --- a/src/console-msw.h +++ /dev/null @@ -1,261 +0,0 @@ -/* Define mswindows-specific console, device, and frame object for XEmacs. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - -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. */ - - -/* Authorship: - - Ultimately based on FSF, then later on JWZ work for Lemacs. - Rewritten over time by Ben Wing and Chuck Thompson. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - */ - -#ifndef _XEMACS_CONSOLE_MSW_H_ -#define _XEMACS_CONSOLE_MSW_H_ - -#include "console.h" -#ifdef CONST /* I suspect this is safe */ -#undef CONST -#endif -#include -#include /* DDE management library */ -#ifndef __CYGWIN32__ -#include /* FileManager/Explorer drag and drop */ -#include -#endif - -#ifdef HAVE_XPM -#include -#endif - -/* - * XXX FIXME: The following X modifier defs in events-mod.h clash with win32 - * hotkey defs in winuser.h. For the moment lose the win32 versions. - * Maybe we should rename all of MOD_* to something that doesn't clash. - */ -#ifdef MOD_CONTROL -# undef MOD_CONTROL -#endif -#ifdef MOD_ALT -# undef MOD_ALT -#endif -#ifdef MOD_SHIFT -# undef MOD_SHIFT -#endif - - -/* The name of the main window class */ -#define XEMACS_CLASS "XEmacs" - - -/* - * Console - */ - -DECLARE_CONSOLE_TYPE (mswindows); - -struct mswindows_console -{ - int infd, outfd; -}; - - -/* - * Device - */ - -#define MSW_FONTSIZE (LF_FACESIZE*4+12) - -struct mswindows_font_enum -{ - char fontname[MSW_FONTSIZE]; - struct mswindows_font_enum *next; -}; - -struct mswindows_device -{ - int logpixelsx, logpixelsy; - int planes, cells; - int horzres, vertres; /* Size in pixels */ - int horzsize, vertsize; /* Size in mm */ - int bitspixel; - struct mswindows_font_enum *fontlist; -}; - -#define DEVICE_MSWINDOWS_DATA(d) DEVICE_TYPE_DATA (d, mswindows) -#define DEVICE_MSWINDOWS_LOGPIXELSX(d) (DEVICE_MSWINDOWS_DATA (d)->logpixelsx) -#define DEVICE_MSWINDOWS_LOGPIXELSY(d) (DEVICE_MSWINDOWS_DATA (d)->logpixelsy) -#define DEVICE_MSWINDOWS_PLANES(d) (DEVICE_MSWINDOWS_DATA (d)->planes) -#define DEVICE_MSWINDOWS_CELLS(d) (DEVICE_MSWINDOWS_DATA (d)->cells) -#define DEVICE_MSWINDOWS_HORZRES(d) (DEVICE_MSWINDOWS_DATA (d)->horzres) -#define DEVICE_MSWINDOWS_VERTRES(d) (DEVICE_MSWINDOWS_DATA (d)->vertres) -#define DEVICE_MSWINDOWS_HORZSIZE(d) (DEVICE_MSWINDOWS_DATA (d)->horzsize) -#define DEVICE_MSWINDOWS_VERTSIZE(d) (DEVICE_MSWINDOWS_DATA (d)->vertsize) -#define DEVICE_MSWINDOWS_BITSPIXEL(d) (DEVICE_MSWINDOWS_DATA (d)->bitspixel) -#define DEVICE_MSWINDOWS_FONTLIST(d) (DEVICE_MSWINDOWS_DATA (d)->fontlist) - - -/* - * Frame - */ -typedef struct -{ - int left; - int top; - int width; - int height; -} XEMACS_RECT_WH; - -struct mswindows_frame -{ - /* win32 window handle */ - HWND hwnd; - - /* DC for this win32 window */ - HDC hdc; - - /* compatible DC for bitmap operations */ - HDC cdc; - - /* Time of last click event, for button 2 emul */ - DWORD last_click_time; - - /* Coordinates of last click event, screen-relative */ - POINTS last_click_point; -#ifdef HAVE_TOOLBARS - /* Toolbar hash table. See toolbar-msw.c */ - Lisp_Object toolbar_hash_table; - unsigned int toolbar_checksum[4]; -#endif - - /* Menu hash table. See menubar-msw.c */ - Lisp_Object menu_hash_table; - - /* Menu checksum. See menubar-msw.c */ - unsigned int menu_checksum; - - /* Widget glyphs attached to this frame. See glyphs-msw.c */ - Lisp_Object widget_hash_table; - - /* Frame title hash value. See frame-msw.c */ - unsigned int title_checksum; - - /* Real character width and height of the frame. - FRAME_{HEIGHT,WIDTH} do not work for pixel geometry! */ - int charheight, charwidth; - - /* Misc flags */ - int button2_need_lbutton : 1; - int button2_need_rbutton : 1; - int button2_is_down : 1; - int ignore_next_lbutton_up : 1; - int ignore_next_rbutton_up : 1; - int sizing : 1; - - /* Geometry, in characters, as specified by proplist during frame - creation. Memebers are set to -1 for unspecified */ - XEMACS_RECT_WH* target_rect; -}; - -#define FRAME_MSWINDOWS_DATA(f) FRAME_TYPE_DATA (f, mswindows) - -#define FRAME_MSWINDOWS_HANDLE(f) (FRAME_MSWINDOWS_DATA (f)->hwnd) -#define FRAME_MSWINDOWS_DC(f) (FRAME_MSWINDOWS_DATA (f)->hdc) -#define FRAME_MSWINDOWS_CDC(f) (FRAME_MSWINDOWS_DATA (f)->cdc) -#define FRAME_MSWINDOWS_MENU_HASH_TABLE(f) (FRAME_MSWINDOWS_DATA (f)->menu_hash_table) -#define FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) \ - (FRAME_MSWINDOWS_DATA (f)->toolbar_hash_table) -#define FRAME_MSWINDOWS_WIDGET_HASH_TABLE(f) \ - (FRAME_MSWINDOWS_DATA (f)->widget_hash_table) -#define FRAME_MSWINDOWS_TOOLBAR_CHECKSUM(f,pos) \ - (FRAME_MSWINDOWS_DATA (f)->toolbar_checksum[pos]) -#define FRAME_MSWINDOWS_MENU_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->menu_checksum) -#define FRAME_MSWINDOWS_TITLE_CHECKSUM(f) (FRAME_MSWINDOWS_DATA (f)->title_checksum) -#define FRAME_MSWINDOWS_CHARWIDTH(f) (FRAME_MSWINDOWS_DATA (f)->charwidth) -#define FRAME_MSWINDOWS_CHARHEIGHT(f) (FRAME_MSWINDOWS_DATA (f)->charheight) -#define FRAME_MSWINDOWS_TARGET_RECT(f) (FRAME_MSWINDOWS_DATA (f)->target_rect) - -/* Frame check and validation macros */ -#define FRAME_MSWINDOWS_P(frm) CONSOLE_TYPESYM_MSWINDOWS_P (FRAME_TYPE (frm)) -#define CHECK_MSWINDOWS_FRAME(z) CHECK_FRAME_TYPE (z, mswindows) -#define CONCHECK_MSWINDOWS_FRAME(z) CONCHECK_FRAME_TYPE (z, mswindows) - -/* win32 window LONG indices */ -#define XWL_FRAMEOBJ 0 -#define XWL_COUNT 1 /* Number of LONGs that we use */ -#define MSWINDOWS_WINDOW_EXTRA_BYTES (XWL_COUNT*4) - - -/* - * Events - */ - -/* win32 messages / magic event types */ -#define EVENT_MSWINDOWS_MAGIC_TYPE(e) \ - ((e)->event.magic.underlying_mswindows_event) -#define XM_BUMPQUEUE (WM_USER + 101) -#define XM_MAPFRAME (WM_USER + 102) -#define XM_UNMAPFRAME (WM_USER + 103) - - -/* - * Random globals - */ - -/* win32 "Windows" procedure */ -LRESULT WINAPI mswindows_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, - LPARAM lParam); - -void mswindows_redraw_exposed_area (struct frame *f, int x, int y, - int width, int height); -void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest); -void mswindows_enqueue_magic_event (HWND hwnd, UINT message); - -/* win32 DDE management library */ -#define MSWINDOWS_DDE_ITEM_OPEN "Open" -extern DWORD mswindows_dde_mlid; -extern HSZ mswindows_dde_service; -extern HSZ mswindows_dde_topic_system; -extern HSZ mswindows_dde_item_open; -HDDEDATA CALLBACK mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, - HSZ hszTopic, HSZ hszItem, HDDEDATA hdata, - DWORD dwData1, DWORD dwData2); - -void mswindows_enqueue_misc_user_event (Lisp_Object channel, - Lisp_Object function, - Lisp_Object object); -Lisp_Object mswindows_cancel_dispatch_event (struct Lisp_Event* event); -Lisp_Object mswindows_pump_outstanding_events (void); -Lisp_Object mswindows_protect_modal_loop (Lisp_Object (*bfun) (Lisp_Object barg), - Lisp_Object barg); -void mswindows_unmodalize_signal_maybe (void); - -#ifdef HAVE_WIN32_PROCESSES -HANDLE get_nt_process_handle (struct Lisp_Process *p); -#endif - -extern Lisp_Object Vmswindows_frame_being_created; -extern Lisp_Object mswindows_frame_being_created; - -void mswindows_enumerate_fonts (struct device *d); - -#endif /* _XEMACS_CONSOLE_MSW_H_ */ diff --git a/src/console-stream.c b/src/console-stream.c deleted file mode 100644 index 74d8e4a..0000000 --- a/src/console-stream.c +++ /dev/null @@ -1,353 +0,0 @@ -/* Stream device functions. - Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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 file has been Mule-ized. */ - -/* Written by Ben Wing. */ - -#include -#include "lisp.h" - -#include "console-stream.h" -#include "console-tty.h" -#include "events.h" -#include "frame.h" -#include "redisplay.h" -#include "sysdep.h" -#include "sysfile.h" -#include "window.h" - -DEFINE_CONSOLE_TYPE (stream); - -Lisp_Object Vterminal_console; -Lisp_Object Vterminal_device; -Lisp_Object Vterminal_frame; - -Lisp_Object Vstdio_str; - -static void -allocate_stream_console_struct (struct console *con) -{ - if (!CONSOLE_STREAM_DATA (con)) - CONSOLE_STREAM_DATA (con) = xnew_and_zero (struct stream_console); - else - xzero (*CONSOLE_STREAM_DATA (con)); -} - -static void -stream_init_console (struct console *con, Lisp_Object params) -{ - Lisp_Object tty = CONSOLE_CONNECTION (con); - FILE *infd, *outfd, *errfd; - - /* Open the specified console */ - - if (NILP (tty) || internal_equal (tty, Vstdio_str, 0)) - { - infd = stdin; - outfd = stdout; - errfd = stderr; - } - else - { - CHECK_STRING (tty); - infd = outfd = errfd = - fopen ((char *) XSTRING_DATA (tty), "r+"); - if (!infd) - error ("Unable to open tty %s", XSTRING_DATA (tty)); - } - - allocate_stream_console_struct (con); - CONSOLE_STREAM_DATA (con)->infd = infd; - CONSOLE_STREAM_DATA (con)->outfd = outfd; - CONSOLE_STREAM_DATA (con)->errfd = errfd; -} - -static void -stream_init_device (struct device *d, Lisp_Object params) -{ - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - - DEVICE_INFD (d) = fileno (CONSOLE_STREAM_DATA (con)->infd); - DEVICE_OUTFD (d) = fileno (CONSOLE_STREAM_DATA (con)->outfd); - init_baud_rate (d); - init_one_device (d); -} - -static int -stream_initially_selected_for_input (struct console *con) -{ - return noninteractive && initialized; -} - -static void -free_stream_console_struct (struct console *con) -{ - if (CONSOLE_STREAM_DATA (con)) - { - xfree (CONSOLE_STREAM_DATA (con)); - CONSOLE_STREAM_DATA (con) = NULL; - } -} - -extern int stdout_needs_newline; - -static void -stream_delete_console (struct console *con) -{ - if (/* CONSOLE_STREAM_DATA (con)->needs_newline */ - stdout_needs_newline) /* #### clean this up */ - { - fputc ('\n', CONSOLE_STREAM_DATA (con)->outfd); - fflush (CONSOLE_STREAM_DATA (con)->outfd); - } - if (CONSOLE_STREAM_DATA (con)->infd != stdin) - fclose (CONSOLE_STREAM_DATA (con)->infd); - free_stream_console_struct (con); -} - -Lisp_Object -stream_semi_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb) -{ - return NILP (connection) ? Vstdio_str : connection; -} - -Lisp_Object -stream_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb) -{ - if (NILP (connection) || internal_equal (connection, Vstdio_str, 0)) - return Vstdio_str; - - if (!ERRB_EQ (errb, ERROR_ME)) - { - if (!STRINGP (connection)) - return Qunbound; - } - else - CHECK_STRING (connection); - - return Ffile_truename (connection, Qnil); -} - -Lisp_Object -stream_semi_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_semi_canonicalize_console_connection (connection, errb); -} - -Lisp_Object -stream_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_canonicalize_console_connection (connection, errb); -} - - -static void -stream_init_frame_1 (struct frame *f, Lisp_Object props) -{ -#if 0 - struct device *d = XDEVICE (FRAME_DEVICE (f)); - if (!NILP (DEVICE_FRAME_LIST (d))) - error ("Only one frame allowed on stream devices"); -#endif - f->name = build_string ("stream"); - f->height = 80; - f->width = 24; - f->visible = 0; /* so redisplay doesn't try to do anything */ -} - - -static int -stream_text_width (struct frame *f, struct face_cachel *cachel, - CONST Emchar *str, Charcount len) -{ - return len; -} - -static int -stream_left_margin_width (struct window *w) -{ - return 0; -} - -static int -stream_right_margin_width (struct window *w) -{ - return 0; -} - -static int -stream_divider_height (void) -{ - return 1; -} - -static int -stream_eol_cursor_width (void) -{ - return 1; -} - -static void -stream_output_begin (struct device *d) -{ -} - -static void -stream_output_end (struct device *d) -{ -} - -static void -stream_output_display_block (struct window *w, struct display_line *dl, - int block, int start, int end, - int start_pixpos, int cursor_start, - int cursor_width, int cursor_height) -{ -} - -static void -stream_output_vertical_divider (struct window *w, int clear) -{ -} - -static void -stream_clear_to_window_end (struct window *w, int ypos1, int ypos2) -{ -} - -static void -stream_clear_region (Lisp_Object window, struct device* d, struct frame * f, - face_index findex, int x, int y, - int width, int height, Lisp_Object fcolor, Lisp_Object bcolor, - Lisp_Object background_pixmap) -{ -} - -static void -stream_clear_frame (struct frame *f) -{ -} - -static int -stream_flash (struct device *d) -{ - return 0; /* sorry can't do it */ -} - -static void -stream_ring_bell (struct device *d, int volume, int pitch, int duration) -{ - struct console *c = XCONSOLE (DEVICE_CONSOLE (d)); - fputc (07, CONSOLE_STREAM_DATA (c)->outfd); - fflush (CONSOLE_STREAM_DATA (c)->outfd); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -console_type_create_stream (void) -{ - INITIALIZE_CONSOLE_TYPE (stream, "stream", "console-stream-p"); - - /* console methods */ - CONSOLE_HAS_METHOD (stream, init_console); - CONSOLE_HAS_METHOD (stream, initially_selected_for_input); - CONSOLE_HAS_METHOD (stream, delete_console); - CONSOLE_HAS_METHOD (stream, canonicalize_console_connection); - CONSOLE_HAS_METHOD (stream, canonicalize_device_connection); - CONSOLE_HAS_METHOD (stream, semi_canonicalize_console_connection); - CONSOLE_HAS_METHOD (stream, semi_canonicalize_device_connection); - - /* device methods */ - CONSOLE_HAS_METHOD (stream, init_device); - - /* frame methods */ - CONSOLE_HAS_METHOD (stream, init_frame_1); - - /* redisplay methods */ - CONSOLE_HAS_METHOD (stream, left_margin_width); - CONSOLE_HAS_METHOD (stream, right_margin_width); - CONSOLE_HAS_METHOD (stream, text_width); - CONSOLE_HAS_METHOD (stream, output_display_block); - CONSOLE_HAS_METHOD (stream, output_vertical_divider); - CONSOLE_HAS_METHOD (stream, divider_height); - CONSOLE_HAS_METHOD (stream, eol_cursor_width); - CONSOLE_HAS_METHOD (stream, clear_to_window_end); - CONSOLE_HAS_METHOD (stream, clear_region); - CONSOLE_HAS_METHOD (stream, clear_frame); - CONSOLE_HAS_METHOD (stream, output_begin); - CONSOLE_HAS_METHOD (stream, output_end); - CONSOLE_HAS_METHOD (stream, flash); - CONSOLE_HAS_METHOD (stream, ring_bell); -} - -void -vars_of_console_stream (void) -{ - DEFVAR_LISP ("terminal-console", &Vterminal_console /* -The initial console-object, which represents XEmacs' stdout. -*/ ); - Vterminal_console = Qnil; - - DEFVAR_LISP ("terminal-device", &Vterminal_device /* -The initial device-object, which represents XEmacs' stdout. -*/ ); - Vterminal_device = Qnil; - - DEFVAR_LISP ("terminal-frame", &Vterminal_frame /* -The initial frame-object, which represents XEmacs' stdout. -*/ ); - Vterminal_frame = Qnil; - - /* Moved from console-tty.c */ - Vstdio_str = build_string ("stdio"); - staticpro (&Vstdio_str); -} - -void -init_console_stream (void) -{ - /* This function can GC */ - if (!initialized) - { - Vterminal_device = Fmake_device (Qstream, Qnil, Qnil); - Vterminal_console = Fdevice_console (Vterminal_device); - Vterminal_frame = Fmake_frame (Qnil, Vterminal_device); - minibuf_window = XFRAME (Vterminal_frame)->minibuffer_window; - } - else - { - /* Re-initialize the FILE fields of the console. */ - stream_init_console (XCONSOLE (Vterminal_console), Qnil); - if (noninteractive) - event_stream_select_console (XCONSOLE (Vterminal_console)); - } -} diff --git a/src/console-stream.h b/src/console-stream.h deleted file mode 100644 index e532bd0..0000000 --- a/src/console-stream.h +++ /dev/null @@ -1,49 +0,0 @@ -/* Define stream specific console, device, and frame object for XEmacs. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 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. */ - -/* Written by Ben Wing. */ - -#ifndef _XEMACS_CONSOLE_STREAM_H_ -#define _XEMACS_CONSOLE_STREAM_H_ - -#include "console.h" - -DECLARE_CONSOLE_TYPE (stream); - -struct stream_console -{ - FILE *infd, *outfd, *errfd; - int needs_newline; -}; - -#define CONSOLE_STREAM_DATA(con) CONSOLE_TYPE_DATA (con, stream) - -Lisp_Object stream_semi_canonicalize_console_connection(Lisp_Object, - Error_behavior); -Lisp_Object stream_canonicalize_console_connection(Lisp_Object, - Error_behavior); -Lisp_Object stream_semi_canonicalize_device_connection(Lisp_Object, - Error_behavior); -Lisp_Object stream_canonicalize_device_connection(Lisp_Object, - Error_behavior); -#endif /* _XEMACS_CONSOLE_STREAM_H_ */ diff --git a/src/console-tty.c b/src/console-tty.c deleted file mode 100644 index ec63358..0000000 --- a/src/console-tty.c +++ /dev/null @@ -1,373 +0,0 @@ -/* TTY console functions. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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. */ - -/* Authors: Ben Wing and Chuck Thompson. */ - -#include -#include "lisp.h" - -#include "console-tty.h" -#include "console-stream.h" -#include "faces.h" -#include "frame.h" -#include "lstream.h" -#include "sysdep.h" -#include "sysfile.h" -#ifdef FILE_CODING -#include "file-coding.h" -#endif -#ifdef HAVE_GPM -#include "gpmevent.h" -#endif - -DEFINE_CONSOLE_TYPE (tty); - -Lisp_Object Qterminal_type; -Lisp_Object Qcontrolling_process; - - -static void -allocate_tty_console_struct (struct console *con) -{ - /* zero out all slots except the lisp ones ... */ - CONSOLE_TTY_DATA (con) = xnew_and_zero (struct tty_console); - CONSOLE_TTY_DATA (con)->terminal_type = Qnil; - CONSOLE_TTY_DATA (con)->instream = Qnil; - CONSOLE_TTY_DATA (con)->outstream = Qnil; -} - -static void -tty_init_console (struct console *con, Lisp_Object props) -{ - Lisp_Object tty = CONSOLE_CONNECTION (con); - Lisp_Object terminal_type = Qnil; - Lisp_Object controlling_process = Qnil; - struct tty_console *tty_con; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (terminal_type, controlling_process); - - terminal_type = Fplist_get (props, Qterminal_type, Qnil); - controlling_process = Fplist_get (props, Qcontrolling_process, Qnil); - - /* Determine the terminal type */ - - if (!NILP (terminal_type)) - CHECK_STRING (terminal_type); - else - { - char *temp_type = getenv ("TERM"); - - if (!temp_type) - { - error ("Cannot determine terminal type"); - } - else - terminal_type = build_string (temp_type); - } - - /* Determine the controlling process */ - if (!NILP (controlling_process)) - CHECK_INT (controlling_process); - - /* Open the specified console */ - - allocate_tty_console_struct (con); - tty_con = CONSOLE_TTY_DATA (con); - - if (internal_equal (tty, Vstdio_str, 0)) - { - tty_con->infd = fileno (stdin); - tty_con->outfd = fileno (stdout); - tty_con->is_stdio = 1; - } - else - { - tty_con->infd = tty_con->outfd = - open ((char *) XSTRING_DATA (tty), O_RDWR); - if (tty_con->infd < 0) - error ("Unable to open tty %s", XSTRING_DATA (tty)); - tty_con->is_stdio = 0; - } - - tty_con->instream = make_filedesc_input_stream (tty_con->infd, 0, -1, 0); - tty_con->outstream = make_filedesc_output_stream (tty_con->outfd, 0, -1, 0); -#ifdef MULE - tty_con->instream = - make_decoding_input_stream (XLSTREAM (tty_con->instream), - Fget_coding_system (Vkeyboard_coding_system)); - Lstream_set_character_mode (XLSTREAM (tty_con->instream)); - tty_con->outstream = - make_encoding_output_stream (XLSTREAM (tty_con->outstream), - Fget_coding_system (Vterminal_coding_system)); -#endif /* MULE */ - tty_con->terminal_type = terminal_type; - tty_con->controlling_process = controlling_process; - -#ifdef HAVE_GPM - connect_to_gpm (con); -#endif - - if (NILP (CONSOLE_NAME (con))) - CONSOLE_NAME (con) = Ffile_name_nondirectory (tty); - { - int tty_pg; - int controlling_tty_pg; - int cfd; - - /* OK, the only sure-fire way I can think of to determine - whether a particular TTY is our controlling TTY is to check - if it has the same foreground process group as our controlling - TTY. This is OK because a process group can never simultaneously - be the foreground process group of two TTY's (in that case it - would have two controlling TTY's, which is not allowed). */ - - EMACS_GET_TTY_PROCESS_GROUP (tty_con->infd, &tty_pg); - cfd = open ("/dev/tty", O_RDWR, 0); - EMACS_GET_TTY_PROCESS_GROUP (cfd, &controlling_tty_pg); - close (cfd); - if (tty_pg == controlling_tty_pg) - { - tty_con->controlling_terminal = 1; - XSETCONSOLE (Vcontrolling_terminal, con); - munge_tty_process_group (); - } - else - tty_con->controlling_terminal = 0; - } - - UNGCPRO; -} - -static void -tty_mark_console (struct console *con, void (*markobj) (Lisp_Object)) -{ - struct tty_console *tty_con = CONSOLE_TTY_DATA (con); - markobj (tty_con->terminal_type); - markobj (tty_con->instream); - markobj (tty_con->outstream); -} - -static int -tty_initially_selected_for_input (struct console *con) -{ - return 1; -} - -static void -free_tty_console_struct (struct console *con) -{ - struct tty_console *tty_con = CONSOLE_TTY_DATA (con); - if (tty_con) - { - if (tty_con->term_entry_buffer) /* allocated in term_init () */ - { - xfree (tty_con->term_entry_buffer); - tty_con->term_entry_buffer = NULL; - } - xfree (tty_con); - CONSOLE_TTY_DATA (con) = NULL; - } -} - -static void -tty_delete_console (struct console *con) -{ - Lstream_close (XLSTREAM (CONSOLE_TTY_DATA (con)->instream)); - Lstream_close (XLSTREAM (CONSOLE_TTY_DATA (con)->outstream)); - if (!CONSOLE_TTY_DATA (con)->is_stdio) - close (CONSOLE_TTY_DATA (con)->infd); - if (CONSOLE_TTY_DATA (con)->controlling_terminal) - { - Vcontrolling_terminal = Qnil; - unmunge_tty_process_group (); - } - free_tty_console_struct (con); -} - - -static struct console * -decode_tty_console (Lisp_Object console) -{ - XSETCONSOLE (console, decode_console (console)); - CHECK_TTY_CONSOLE (console); - return XCONSOLE (console); -} - -DEFUN ("console-tty-terminal-type", Fconsole_tty_terminal_type, - 0, 1, 0, /* -Return the terminal type of TTY console CONSOLE. -*/ - (console)) -{ - return CONSOLE_TTY_DATA (decode_tty_console (console))->terminal_type; -} - -DEFUN ("console-tty-controlling-process", Fconsole_tty_controlling_process, - 0, 1, 0, /* -Return the controlling process of tty console CONSOLE. -*/ - (console)) -{ - return CONSOLE_TTY_DATA (decode_tty_console (console))->controlling_process; -} - -#ifdef FILE_CODING - -DEFUN ("console-tty-input-coding-system", Fconsole_tty_input_coding_system, - 0, 1, 0, /* -Return the input coding system of tty console CONSOLE. -*/ - (console)) -{ - return decoding_stream_coding_system - (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->instream)); -} - -DEFUN ("set-console-tty-input-coding-system", Fset_console_tty_input_coding_system, - 0, 2, 0, /* -Set the input coding system of tty console CONSOLE to CODESYS. -CONSOLE defaults to the selected console. -CODESYS defaults to the value of `keyboard-coding-system'. -*/ - (console, codesys)) -{ - set_decoding_stream_coding_system - (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->instream), - Fget_coding_system (NILP (codesys) ? Vkeyboard_coding_system : codesys)); - return Qnil; -} - -DEFUN ("console-tty-output-coding-system", Fconsole_tty_output_coding_system, - 0, 1, 0, /* -Return TTY CONSOLE's output coding system. -*/ - (console)) -{ - return encoding_stream_coding_system - (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->outstream)); -} - -DEFUN ("set-console-tty-output-coding-system", Fset_console_tty_output_coding_system, - 0, 2, 0, /* -Set the coding system of tty output of console CONSOLE to CODESYS. -CONSOLE defaults to the selected console. -CODESYS defaults to the value of `terminal-coding-system'. -*/ - (console, codesys)) -{ - set_encoding_stream_coding_system - (XLSTREAM (CONSOLE_TTY_DATA (decode_tty_console (console))->outstream), - Fget_coding_system (NILP (codesys) ? Vterminal_coding_system : codesys)); - return Qnil; -} - -/* ### Move this function to lisp */ -DEFUN ("set-console-tty-coding-system", Fset_console_tty_coding_system, - 0, 2, 0, /* -Set the input and output coding systems of tty console CONSOLE to CODESYS. -CONSOLE defaults to the selected console. -If CODESYS is nil, the values of `keyboard-coding-system' and -`terminal-coding-system' will be used for the input and -output coding systems of CONSOLE. -*/ - (console, codesys)) -{ - Fset_console_tty_input_coding_system (console, codesys); - Fset_console_tty_output_coding_system (console, codesys); - return Qnil; -} -#endif /* FILE_CODING */ - - -Lisp_Object -tty_semi_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_semi_canonicalize_console_connection (connection, errb); -} - -Lisp_Object -tty_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_canonicalize_console_connection (connection, errb); -} - -Lisp_Object -tty_semi_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_semi_canonicalize_console_connection (connection, errb); -} - -Lisp_Object -tty_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb) -{ - return stream_canonicalize_console_connection (connection, errb); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_console_tty (void) -{ - DEFSUBR (Fconsole_tty_terminal_type); - DEFSUBR (Fconsole_tty_controlling_process); - defsymbol (&Qterminal_type, "terminal-type"); - defsymbol (&Qcontrolling_process, "controlling-process"); -#ifdef FILE_CODING - DEFSUBR (Fconsole_tty_output_coding_system); - DEFSUBR (Fset_console_tty_output_coding_system); - DEFSUBR (Fconsole_tty_input_coding_system); - DEFSUBR (Fset_console_tty_input_coding_system); - DEFSUBR (Fset_console_tty_coding_system); -#endif /* FILE_CODING */ -} - -void -console_type_create_tty (void) -{ - INITIALIZE_CONSOLE_TYPE (tty, "tty", "console-tty-p"); - - /* console methods */ - CONSOLE_HAS_METHOD (tty, init_console); - CONSOLE_HAS_METHOD (tty, mark_console); - CONSOLE_HAS_METHOD (tty, initially_selected_for_input); - CONSOLE_HAS_METHOD (tty, delete_console); - CONSOLE_HAS_METHOD (tty, canonicalize_console_connection); - CONSOLE_HAS_METHOD (tty, canonicalize_device_connection); - CONSOLE_HAS_METHOD (tty, semi_canonicalize_console_connection); - CONSOLE_HAS_METHOD (tty, semi_canonicalize_device_connection); -} - -void -vars_of_console_tty (void) -{ - Fprovide (Qtty); -} diff --git a/src/console-tty.h b/src/console-tty.h deleted file mode 100644 index bc5aacd..0000000 --- a/src/console-tty.h +++ /dev/null @@ -1,298 +0,0 @@ -/* Define TTY specific console, device, and frame object for XEmacs. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1996 Ben Wing. - -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 Chuck Thompson and Ben Wing. */ - -/* NOTE: Currently each TTY console can have only one device. - Therefore, all stuff for both input and output is lumped into - the console structure. If it ever becomes meaningful to - have more than one device on a TTY console, the output stuff - will have to get separated out. */ - -#ifndef _XEMACS_CONSOLE_TTY_H_ -#define _XEMACS_CONSOLE_TTY_H_ - -#include "console.h" -#include "syssignal.h" /* Always include before systty.h */ -#include "systty.h" - -DECLARE_CONSOLE_TYPE (tty); - -struct tty_console -{ - int infd, outfd; -#ifdef HAVE_GPM - int mouse_fd; -#endif - Lisp_Object instream, outstream; - Lisp_Object terminal_type; - Lisp_Object controlling_process; - char *term_entry_buffer; - - /* Physical location of cursor on this console. */ - int cursor_x; - int cursor_y; - - /* The real location of the cursor. The above physical location may - be ahead of where we really are. */ - int real_cursor_x; - int real_cursor_y; - - int final_cursor_x; - int final_cursor_y; - - int height; - int width; - - /* The count of frame number. */ - int frame_count; - - /* flags indicating presence, absence or value of various features */ - struct - { - unsigned int must_write_spaces :1; /* terminal inserts nulls, not - spaces to fill whitespace on - screen */ - unsigned int insert_mode_motion :1; /* cursor movement commands - work while in insert mode */ - unsigned int standout_motion :1; /* cursor movement is graceful - in standout or underline mode */ - unsigned int memory_above_frame :1; /* display retained above screen */ - unsigned int memory_below_frame :1; /* display retained below screen */ - unsigned int meta_key :2; /* 0 == mask off top bit; - 1 == top bit is meta; - 2 == top bit is useful as - character info */ - unsigned int flow_control :1; /* Nonzero means use ^S/^Q as - cretinous flow control. */ - int standout_width; /* # of spaces printed when - change to standout mode */ - int underline_width; /* # of spaces printed when - change to underline mode */ - } flags; - - /* cursor motion entries - each entry is commented with the terminfo - and the termcap entry */ - struct - { - /* local cursor movement */ - CONST char *up; /* cuu1, up */ - CONST char *down; /* cud1, do */ - CONST char *left; /* cub1, le */ - CONST char *right; /* cuf1, nd */ - CONST char *home; /* home, ho */ - CONST char *low_left; /* ll, ll */ - CONST char *car_return; /* cr, cr */ - - /* parameterized local cursor movement */ - CONST char *multi_up; /* cuu, UP */ - CONST char *multi_down; /* cud, DO */ - CONST char *multi_left; /* cub, LE */ - CONST char *multi_right; /* cuf, RI */ - - /* absolute cursor motion */ - CONST char *abs; /* cup, cm */ - CONST char *hor_abs; /* hpa, ch */ - CONST char *ver_abs; /* vpa, cv */ - - /* scrolling */ - CONST char *scroll_forw; /* ind, sf */ - CONST char *scroll_back; /* ri, sr */ - CONST char *multi_scroll_forw; /* indn, SF */ - CONST char *multi_scroll_back; /* rin, SR */ - CONST char *set_scroll_region; /* csr, cs */ - } cm; - - /* screen editing entries - each entry is commented with the - terminfo and the termcap entry */ - struct - { - /* adding to the screen */ - CONST char *ins_line; /* il1, al */ - CONST char *multi_ins_line; /* il, AL */ - CONST char *repeat; /* rep, rp */ - CONST char *begin_ins_mode; /* smir, im */ - CONST char *end_ins_mode; /* rmir, ei */ - CONST char *ins_char; /* ich1, ic */ - CONST char *multi_ins_char; /* ich, IC */ - CONST char *insert_pad; /* ip, ip */ - - /* deleting from the screen */ - CONST char *clr_frame; /* clear, cl */ - CONST char *clr_from_cursor; /* ed, cd */ - CONST char *clr_to_eol; /* el, ce */ - CONST char *del_line; /* dl1, dl */ - CONST char *multi_del_line; /* dl, DL */ - CONST char *del_char; /* dch1, dc */ - CONST char *multi_del_char; /* dch, DC */ - CONST char *begin_del_mode; /* smdc, dm */ - CONST char *end_del_mode; /* rmdc, ed */ - CONST char *erase_at_cursor; /* ech, ec */ - } se; - - /* screen display entries - each entry is commented with the - terminfo and termcap entry */ - struct - { - CONST char *begin_standout; /* smso, so */ - CONST char *end_standout; /* rmso, se */ - CONST char *begin_underline; /* smul, us */ - CONST char *end_underline; /* rmul, ue */ - CONST char *begin_alternate; /* smacs, as */ - CONST char *end_alternate; /* rmacs, ae */ - - CONST char *turn_on_reverse; /* rev, mr */ - CONST char *turn_on_blinking; /* blink, mb */ - CONST char *turn_on_bold; /* bold, md */ - CONST char *turn_on_dim; /* dim, mh */ - CONST char *turn_off_attributes; /* sgr0, me */ - - CONST char *visual_bell; /* flash, vb */ - CONST char *audio_bell; /* bel, bl */ - - CONST char *cursor_visible; /* cvvis, vs */ - CONST char *cursor_normal; /* cnorm, ve */ - CONST char *init_motion; /* smcup, ti */ - CONST char *end_motion; /* rmcup, te */ - CONST char *keypad_on; /* smkx, ks */ - CONST char *keypad_off; /* rmkx, ke */ - - CONST char *orig_pair; /* op, op */ - } sd; - - /* costs of various operations */ - struct - { - int cm_up; - int cm_down; - int cm_left; - int cm_right; - int cm_home; - int cm_low_left; - int cm_car_return; - int cm_abs; - int cm_hor_abs; - int cm_ver_abs; - } cost; - - /* The initial tty mode bits */ - struct emacs_tty old_tty; - - /* Is this TTY our controlling terminal? */ - unsigned int controlling_terminal :1; - unsigned int is_stdio :1; -}; - -#ifdef HAVE_GPM -#define CONSOLE_TTY_MOUSE_FD(c) (CONSOLE_TTY_DATA (c)->mouse_fd) -#endif -#define CONSOLE_TTY_DATA(c) CONSOLE_TYPE_DATA (c, tty) -#define CONSOLE_TTY_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->cursor_x) -#define CONSOLE_TTY_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->cursor_y) -#define CONSOLE_TTY_REAL_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->real_cursor_x) -#define CONSOLE_TTY_REAL_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->real_cursor_y) -#define CONSOLE_TTY_FINAL_CURSOR_X(c) (CONSOLE_TTY_DATA (c)->final_cursor_x) -#define CONSOLE_TTY_FINAL_CURSOR_Y(c) (CONSOLE_TTY_DATA (c)->final_cursor_y) - -#define TTY_CM(c) (CONSOLE_TTY_DATA (c)->cm) -#define TTY_SE(c) (CONSOLE_TTY_DATA (c)->se) -#define TTY_SD(c) (CONSOLE_TTY_DATA (c)->sd) -#define TTY_FLAGS(c) (CONSOLE_TTY_DATA (c)->flags) -#define TTY_COST(c) (CONSOLE_TTY_DATA (c)->cost) - -#define TTY_INC_CURSOR_X(c, n) do { \ - int TICX_n = (n); \ - assert (CONSOLE_TTY_CURSOR_X (c) == CONSOLE_TTY_REAL_CURSOR_X (c)); \ - CONSOLE_TTY_CURSOR_X (c) += TICX_n; \ - CONSOLE_TTY_REAL_CURSOR_X (c) += TICX_n; \ -} while (0) - -#define TTY_INC_CURSOR_Y(c, n) do { \ - int TICY_n = (n); \ - CONSOLE_TTY_CURSOR_Y (c) += TICY_n; \ - CONSOLE_TTY_REAL_CURSOR_Y (c) += TICY_n; \ -} while (0) - -struct tty_device -{ -#ifdef HAVE_TERMIOS - speed_t ospeed; /* Output speed (from sg_ospeed) */ -#else - short ospeed; /* Output speed (from sg_ospeed) */ -#endif -}; - -#define DEVICE_TTY_DATA(d) DEVICE_TYPE_DATA (d, tty) - -/* termcap requires this to be global */ -#ifndef HAVE_TERMIOS -extern short ospeed; /* Output speed (from sg_ospeed) */ -#endif - -extern FILE *termscript; - -EXFUN (Fconsole_tty_controlling_process, 1); - -/****************** Prototypes from cm.c *******************/ - -/* #### Verify that all of these are still needed. */ - -void cm_cost_init (struct console *c); -void cmputc (int c); -void cmgoto (struct frame *f, int row, int col); -extern struct console *cmputc_console; -void send_string_to_tty_console (struct console *c, unsigned char *str, - int len); - - -/*************** Prototypes from redisplay-tty.c ****************/ - -enum term_init_status -{ - TTY_UNABLE_OPEN_DATABASE, - TTY_TYPE_UNDEFINED, - TTY_TYPE_INSUFFICIENT, - TTY_SIZE_UNSPECIFIED, - TTY_INIT_SUCCESS -}; - -int init_tty_for_redisplay (struct device *d, char *terminal_type); -/* #### These should probably be methods. */ -void set_tty_modes (struct console *c); -void reset_tty_modes (struct console *c); - -/* Used in sysdep.c to properly clear and position the cursor when exiting. */ -void tty_redisplay_shutdown (struct console *c); - -/* called from console-stream.c */ -Lisp_Object tty_semi_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb); -Lisp_Object tty_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb); -Lisp_Object tty_semi_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb); -Lisp_Object tty_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb); -struct console * tty_find_console_from_fd (int fd); - -#endif /* _XEMACS_CONSOLE_TTY_H_ */ diff --git a/src/console-x.c b/src/console-x.c deleted file mode 100644 index 4a4ab21..0000000 --- a/src/console-x.c +++ /dev/null @@ -1,282 +0,0 @@ -/* Console functions for X windows. - Copyright (C) 1996 Ben Wing. - -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. */ - -/* Authorship: - - Ben Wing: January 1996, for 19.14. - */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "process.h" /* canonicalize_host_name */ -#include "redisplay.h" /* for display_arg */ - -DEFINE_CONSOLE_TYPE (x); - -static int -x_initially_selected_for_input (struct console *con) -{ - return 1; -} - -static void -split_up_display_spec (Lisp_Object display, int *hostname_length, - int *display_length, int *screen_length) -{ - char *dotptr; - - dotptr = strrchr ((char *) XSTRING_DATA (display), ':'); - if (!dotptr) - { - *hostname_length = XSTRING_LENGTH (display); - *display_length = 0; - } - else - { - *hostname_length = dotptr - (char *) XSTRING_DATA (display); - - dotptr = strchr (dotptr, '.'); - if (dotptr) - *display_length = (dotptr - (char *) XSTRING_DATA (display) - - *hostname_length); - else - *display_length = XSTRING_LENGTH (display) - *hostname_length; - } - - *screen_length = (XSTRING_LENGTH (display) - *display_length - - *hostname_length); -} - -/* Remember, in all of the following functions, we have to verify - the integrity of our input, because the generic functions don't. */ - -static Lisp_Object -x_device_to_console_connection (Lisp_Object connection, Error_behavior errb) -{ - /* Strip the trailing .# off of the connection, if it's there. */ - - if (NILP (connection)) - return Qnil; - else - { - int hostname_length, display_length, screen_length; - - if (!ERRB_EQ (errb, ERROR_ME)) - { - if (!STRINGP (connection)) - return Qunbound; - } - else - CHECK_STRING (connection); - - split_up_display_spec (connection, &hostname_length, &display_length, - &screen_length); - connection = make_string (XSTRING_DATA (connection), - hostname_length + display_length); - } - - return connection; -} - -static Lisp_Object -get_display_arg_connection (void) -{ - CONST char *disp_name; - - /* If the user didn't explicitly specify a display to use when - they called make-x-device, then we first check to see if a - display was specified on the command line with -display. If - so, we set disp_name to it. Otherwise we use XDisplayName to - see what DISPLAY is set to. XtOpenDisplay knows how to do - both of these things, but we need to know the name to use. */ - if (display_arg) - { - int elt; - int argc; - char **argv; - Lisp_Object conn; - - make_argc_argv (Vx_initial_argv_list, &argc, &argv); - - disp_name = NULL; - for (elt = 0; elt < argc; elt++) - { - if (!strcmp (argv[elt], "-d") || !strcmp (argv[elt], "-display")) - { - if (elt + 1 == argc) - { - suppress_early_error_handler_backtrace = 1; - error ("-display specified with no arg"); - } - else - { - disp_name = argv[elt + 1]; - break; - } - } - } - - /* assert: display_arg is only set if we found the display - arg earlier so we can't fail to find it now. */ - assert (disp_name != NULL); - conn = build_ext_string (disp_name, FORMAT_CTEXT); - free_argc_argv (argv); - return conn; - } - else - return build_ext_string (XDisplayName (0), FORMAT_CTEXT); -} - -/* "semi-canonicalize" means convert to a nicer form for printing, but - don't completely canonicalize (into some likely ugly form) */ - -static Lisp_Object -x_semi_canonicalize_console_connection (Lisp_Object connection, - Error_behavior errb) -{ - struct gcpro gcpro1; - - GCPRO1 (connection); - - if (NILP (connection)) - connection = get_display_arg_connection (); - else - { - if (!ERRB_EQ (errb, ERROR_ME)) - { - if (!STRINGP (connection)) - RETURN_UNGCPRO (Qunbound); - } - else - CHECK_STRING (connection); - } - - - /* Be lenient, allow people to specify a device connection instead of - a console connection -- e.g. "foo:0.0" instead of "foo:0". This - only happens in `find-console' and `get-console'. */ - connection = x_device_to_console_connection (connection, errb); - - /* Check for a couple of standard special cases */ - if (string_byte (XSTRING (connection), 0) == ':') - connection = concat2 (build_string ("localhost"), connection); - else if (!strncmp ((CONST char *) XSTRING_DATA (connection), - "unix:", 5)) - connection = concat2 (build_string ("localhost:"), - Fsubstring (connection, make_int (5), Qnil)); - - RETURN_UNGCPRO (connection); -} - -static Lisp_Object -x_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb) -{ - Lisp_Object hostname = Qnil; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (connection, hostname); - - connection = x_semi_canonicalize_console_connection (connection, errb); - if (UNBOUNDP (connection)) - RETURN_UNGCPRO (Qunbound); - - { - int hostname_length, display_length, screen_length; - - split_up_display_spec (connection, &hostname_length, &display_length, - &screen_length); - hostname = Fsubstring (connection, Qzero, make_int (hostname_length)); - hostname = canonicalize_host_name (hostname); - connection = concat2 (hostname, - make_string (XSTRING_DATA (connection) - + hostname_length, display_length)); - } - - RETURN_UNGCPRO (connection); -} - -static Lisp_Object -x_semi_canonicalize_device_connection (Lisp_Object connection, - Error_behavior errb) -{ - int hostname_length, display_length, screen_length; - struct gcpro gcpro1; - - GCPRO1 (connection); - if (NILP (connection)) - connection = get_display_arg_connection (); - else - { - if (!ERRB_EQ (errb, ERROR_ME)) - { - if (!STRINGP (connection)) - RETURN_UNGCPRO (Qunbound); - } - else - CHECK_STRING (connection); - } - - split_up_display_spec (connection, &hostname_length, &display_length, - &screen_length); - - if (!screen_length) - connection = concat2 (connection, build_string (".0")); - RETURN_UNGCPRO (connection); -} - -static Lisp_Object -x_canonicalize_device_connection (Lisp_Object connection, Error_behavior errb) -{ - int hostname_length, display_length, screen_length; - Lisp_Object screen_str = Qnil; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (screen_str, connection); - connection = x_semi_canonicalize_device_connection (connection, errb); - if (UNBOUNDP (connection)) - RETURN_UNGCPRO (Qunbound); - - split_up_display_spec (connection, &hostname_length, &display_length, - &screen_length); - - screen_str = build_string ((CONST char *) XSTRING_DATA (connection) - + hostname_length + display_length); - connection = x_canonicalize_console_connection (connection, errb); - - RETURN_UNGCPRO (concat2 (connection, screen_str)); -} - -void -console_type_create_x (void) -{ - INITIALIZE_CONSOLE_TYPE (x, "x", "console-x-p"); - - CONSOLE_HAS_METHOD (x, semi_canonicalize_console_connection); - CONSOLE_HAS_METHOD (x, canonicalize_console_connection); - CONSOLE_HAS_METHOD (x, semi_canonicalize_device_connection); - CONSOLE_HAS_METHOD (x, canonicalize_device_connection); - CONSOLE_HAS_METHOD (x, device_to_console_connection); - CONSOLE_HAS_METHOD (x, initially_selected_for_input); -} - diff --git a/src/console-x.h b/src/console-x.h deleted file mode 100644 index e285226..0000000 --- a/src/console-x.h +++ /dev/null @@ -1,496 +0,0 @@ -/* Define X specific console, device, and frame object for XEmacs. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - -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. */ - - -/* Authorship: - - Ultimately based on FSF, then later on JWZ work for Lemacs. - Rewritten over time by Ben Wing and Chuck Thompson (original - multi-device work by Chuck Thompson). - */ - -#ifndef _XEMACS_CONSOLE_X_H_ -#define _XEMACS_CONSOLE_X_H_ - -#ifdef HAVE_X_WINDOWS - -#include "console.h" -#include "xintrinsic.h" - -#include -#include -#include - -#if 0 /* mrb - Xos sux. */ -#ifdef USG -#undef USG /* ####KLUDGE for Solaris 2.2 and up */ -#include -#define USG -#else -#include -#endif -#endif /* 0 */ - -#include - -#ifdef HAVE_XPM -#include -#endif - -/* R5 defines the XPointer type, but R4 doesn't. - R4 also doesn't define a version number, but R5 does. */ -#if (XlibSpecificationRelease < 5) -# define XPointer char * -#endif - -DECLARE_CONSOLE_TYPE (x); - -struct x_device -{ - /* The X connection of this device. */ - Display *display; - - /* Set by x_IO_error_handler(). */ - int being_deleted; - - /* Xt application info. */ - Widget Xt_app_shell; - - /* Cache of GC's for frame's on this device. */ - struct gc_cache *gc_cache; - - /* Selected visual, depth and colormap for this device */ - Visual *visual; - int depth; - Colormap device_cmap; - - /* Used by x_bevel_modeline in redisplay-x.c */ - Pixmap gray_pixmap; - - /* Atoms associated with this device. */ - /* allocated in Xatoms_of_xfns in xfns.c */ - Atom Xatom_WM_PROTOCOLS; - Atom Xatom_WM_DELETE_WINDOW; - Atom Xatom_WM_SAVE_YOURSELF; - Atom Xatom_WM_TAKE_FOCUS; - Atom Xatom_WM_STATE; - - /* allocated in Xatoms_of_xselect in xselect.c */ - Atom Xatom_CLIPBOARD; - Atom Xatom_TIMESTAMP; - Atom Xatom_TEXT; - Atom Xatom_DELETE; - Atom Xatom_MULTIPLE; - Atom Xatom_INCR; - Atom Xatom_EMACS_TMP; - Atom Xatom_TARGETS; - Atom Xatom_NULL; - Atom Xatom_ATOM_PAIR; - Atom Xatom_COMPOUND_TEXT; - - /* allocated in Xatoms_of_objects_x in objects-x.c */ - Atom Xatom_FOUNDRY; - Atom Xatom_FAMILY_NAME; - Atom Xatom_WEIGHT_NAME; - Atom Xatom_SLANT; - Atom Xatom_SETWIDTH_NAME; - Atom Xatom_ADD_STYLE_NAME; - Atom Xatom_PIXEL_SIZE; - Atom Xatom_POINT_SIZE; - Atom Xatom_RESOLUTION_X; - Atom Xatom_RESOLUTION_Y; - Atom Xatom_SPACING; - Atom Xatom_AVERAGE_WIDTH; - Atom Xatom_CHARSET_REGISTRY; - Atom Xatom_CHARSET_ENCODING; - - /* The following items are all used exclusively in event-Xt.c. */ - int MetaMask, HyperMask, SuperMask, AltMask, ModeMask; - KeySym lock_interpretation; - - XModifierKeymap *x_modifier_keymap; - - KeySym *x_keysym_map; - int x_keysym_map_min_code; - int x_keysym_map_max_code; - int x_keysym_map_keysyms_per_code; - Lisp_Object x_keysym_map_hash_table; - - /* frame that holds the WM_COMMAND property; there should be exactly - one of these per device. */ - Lisp_Object WM_COMMAND_frame; - - /* #### It's not clear that there is much distinction anymore - between mouse_timestamp and global_mouse_timestamp, now that - Emacs doesn't see most (all?) events not destined for it. */ - - /* The timestamp of the last button or key event used by emacs itself. - This is used for asserting selections and input focus. */ - Time mouse_timestamp; - - /* This is the timestamp the last button or key event whether it was - dispatched to emacs or widgets. */ - Time global_mouse_timestamp; - - /* This is the last known timestamp received from the server. It is - maintained by x_event_to_emacs_event and used to patch bogus - WM_TAKE_FOCUS messages sent by Mwm. */ - Time last_server_timestamp; - - /* Used by Xlib to preserve information across calls to - XLookupString(), to implement compose processing. - - According to The X Window System, p. 467, "The creation of - XComposeStatus structures is implementation dependent; - a portable program must pass NULL for this argument." - But this means that a portable program cannot implement - compose processing! WTF? - - So we just set it to all zeros. */ - - /* No X Server ever used this, AFAIK -- mrb */ - /* XComposeStatus x_compose_status; */ - -#ifdef HAVE_XIM - XIM xim; - XIMStyles *xim_styles; -#endif /* HAVE_XIM */ - - /* stuff for sticky modifiers: */ - - unsigned int need_to_add_mask, down_mask; - KeyCode last_downkey; - Time release_time; -}; - -#define DEVICE_X_DATA(d) DEVICE_TYPE_DATA (d, x) - -#define FRAME_X_DISPLAY(f) (DEVICE_X_DISPLAY (XDEVICE (f->device))) -#define DEVICE_X_DISPLAY(d) (DEVICE_X_DATA (d)->display) -#define DEVICE_X_BEING_DELETED(d) (DEVICE_X_DATA (d)->being_deleted) -#define DEVICE_X_VISUAL(d) (DEVICE_X_DATA (d)->visual) -#define DEVICE_X_DEPTH(d) (DEVICE_X_DATA (d)->depth) -#define DEVICE_X_COLORMAP(d) (DEVICE_X_DATA (d)->device_cmap) -#define DEVICE_XT_APP_SHELL(d) (DEVICE_X_DATA (d)->Xt_app_shell) -#define DEVICE_X_GC_CACHE(d) (DEVICE_X_DATA (d)->gc_cache) -#define DEVICE_X_GRAY_PIXMAP(d) (DEVICE_X_DATA (d)->gray_pixmap) -#define DEVICE_X_WM_COMMAND_FRAME(d) (DEVICE_X_DATA (d)->WM_COMMAND_frame) -#define DEVICE_X_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->mouse_timestamp) -#define DEVICE_X_GLOBAL_MOUSE_TIMESTAMP(d) (DEVICE_X_DATA (d)->global_mouse_timestamp) -#define DEVICE_X_LAST_SERVER_TIMESTAMP(d) (DEVICE_X_DATA (d)->last_server_timestamp) -#define DEVICE_X_KEYSYM_MAP_HASH_TABLE(d) (DEVICE_X_DATA (d)->x_keysym_map_hash_table) -/* #define DEVICE_X_X_COMPOSE_STATUS(d) (DEVICE_X_DATA (d)->x_compose_status) */ -#ifdef HAVE_XIM -#define DEVICE_X_XIM(d) (DEVICE_X_DATA (d)->xim) -#define DEVICE_X_XIM_STYLES(d) (DEVICE_X_DATA (d)->xim_styles) -#define DEVICE_X_FONTSET(d) (DEVICE_X_DATA (d)->fontset) -#endif /* HAVE_XIM */ - -/* allocated in Xatoms_of_xfns in xfns.c */ -#define DEVICE_XATOM_WM_PROTOCOLS(d) (DEVICE_X_DATA (d)->Xatom_WM_PROTOCOLS) -#define DEVICE_XATOM_WM_DELETE_WINDOW(d) (DEVICE_X_DATA (d)->Xatom_WM_DELETE_WINDOW) -#define DEVICE_XATOM_WM_SAVE_YOURSELF(d) (DEVICE_X_DATA (d)->Xatom_WM_SAVE_YOURSELF) -#define DEVICE_XATOM_WM_TAKE_FOCUS(d) (DEVICE_X_DATA (d)->Xatom_WM_TAKE_FOCUS) -#define DEVICE_XATOM_WM_STATE(d) (DEVICE_X_DATA (d)->Xatom_WM_STATE) - -/* allocated in Xatoms_of_xselect in xselect.c */ -#define DEVICE_XATOM_CLIPBOARD(d) (DEVICE_X_DATA (d)->Xatom_CLIPBOARD) -#define DEVICE_XATOM_TIMESTAMP(d) (DEVICE_X_DATA (d)->Xatom_TIMESTAMP) -#define DEVICE_XATOM_TEXT(d) (DEVICE_X_DATA (d)->Xatom_TEXT) -#define DEVICE_XATOM_DELETE(d) (DEVICE_X_DATA (d)->Xatom_DELETE) -#define DEVICE_XATOM_MULTIPLE(d) (DEVICE_X_DATA (d)->Xatom_MULTIPLE) -#define DEVICE_XATOM_INCR(d) (DEVICE_X_DATA (d)->Xatom_INCR) -#define DEVICE_XATOM_EMACS_TMP(d) (DEVICE_X_DATA (d)->Xatom_EMACS_TMP) -#define DEVICE_XATOM_TARGETS(d) (DEVICE_X_DATA (d)->Xatom_TARGETS) -#define DEVICE_XATOM_NULL(d) (DEVICE_X_DATA (d)->Xatom_NULL) -#define DEVICE_XATOM_ATOM_PAIR(d) (DEVICE_X_DATA (d)->Xatom_ATOM_PAIR) -#define DEVICE_XATOM_COMPOUND_TEXT(d) (DEVICE_X_DATA (d)->Xatom_COMPOUND_TEXT) - -/* allocated in Xatoms_of_objects_x in objects-x.c */ -#define DEVICE_XATOM_FOUNDRY(d) (DEVICE_X_DATA (d)->Xatom_FOUNDRY) -#define DEVICE_XATOM_FAMILY_NAME(d) (DEVICE_X_DATA (d)->Xatom_FAMILY_NAME) -#define DEVICE_XATOM_WEIGHT_NAME(d) (DEVICE_X_DATA (d)->Xatom_WEIGHT_NAME) -#define DEVICE_XATOM_SLANT(d) (DEVICE_X_DATA (d)->Xatom_SLANT) -#define DEVICE_XATOM_SETWIDTH_NAME(d) (DEVICE_X_DATA (d)->Xatom_SETWIDTH_NAME) -#define DEVICE_XATOM_ADD_STYLE_NAME(d) (DEVICE_X_DATA (d)->Xatom_ADD_STYLE_NAME) -#define DEVICE_XATOM_PIXEL_SIZE(d) (DEVICE_X_DATA (d)->Xatom_PIXEL_SIZE) -#define DEVICE_XATOM_POINT_SIZE(d) (DEVICE_X_DATA (d)->Xatom_POINT_SIZE) -#define DEVICE_XATOM_RESOLUTION_X(d) (DEVICE_X_DATA (d)->Xatom_RESOLUTION_X) -#define DEVICE_XATOM_RESOLUTION_Y(d) (DEVICE_X_DATA (d)->Xatom_RESOLUTION_Y) -#define DEVICE_XATOM_SPACING(d) (DEVICE_X_DATA (d)->Xatom_SPACING) -#define DEVICE_XATOM_AVERAGE_WIDTH(d) (DEVICE_X_DATA (d)->Xatom_AVERAGE_WIDTH) -#define DEVICE_XATOM_CHARSET_REGISTRY(d) (DEVICE_X_DATA (d)->Xatom_CHARSET_REGISTRY) -#define DEVICE_XATOM_CHARSET_ENCODING(d) (DEVICE_X_DATA (d)->Xatom_CHARSET_ENCODING) - -#define Xt_SET_VALUE(widget, resource, value) do { \ - Arg al; \ - XtSetArg (al, resource, value); \ - XtSetValues (widget, &al, 1); \ -} while (0) - -#define Xt_GET_VALUE(widget, resource, location) do { \ - Arg al; \ - XtSetArg (al, resource, location); \ - XtGetValues (widget, &al, 1); \ -} while (0) - -/* The maximum number of widgets that can be displayed above the text - area at one time. Currently no more than 3 will ever actually be - displayed (menubar, psheet, debugger panel). */ -#define MAX_CONCURRENT_TOP_WIDGETS 8 - -struct x_frame -{ - /* The widget of this frame. This is an EmacsShell or an - ExternalShell. */ - Widget widget; - - /* The parent of the EmacsFrame, the menubar, and the scrollbars. - This is an EmacsManager. */ - Widget container; - - /* The widget of the menubar, of whatever widget class it happens to be. */ - Widget menubar_widget; - - /* The widget of the edit portion of this frame; this is an EmacsFrame, - and the window of this widget is what the redisplay code draws on. */ - Widget edit_widget; - - /* Lists the widgets above the text area, in the proper order. - Used by the EmacsManager. */ - Widget top_widgets[MAX_CONCURRENT_TOP_WIDGETS]; - int num_top_widgets; - - /*************************** Miscellaneous **************************/ - - /* The icon pixmaps; these are Lisp_Image_Instance objects, or Qnil. */ - Lisp_Object icon_pixmap; - Lisp_Object icon_pixmap_mask; - -#ifdef HAVE_TOOLBARS - int old_toolbar_size[4]; - - /* We don't provide a mechanism for changing these after they are - initialized so we might as well keep pointers to them and avoid - lots of expensive calls to gc_cache_lookup. */ - GC toolbar_top_shadow_gc; - GC toolbar_bottom_shadow_gc; - GC toolbar_blank_background_gc; - GC toolbar_pixmap_background_gc; -#endif /* HAVE_TOOLBARS */ - - /* geometry string that ought to be freed. */ - char *geom_free_me_please; - -#ifdef HAVE_XIM - XPoint xic_spot; /* Spot Location cache */ -#ifdef XIM_XLIB - XIC xic; - /* Could get these at any time by asking xic, but... */ - XIMStyle xic_style; /* XIM Style cache */ -#endif /* XIM_XLIB */ -#endif /* HAVE_XIM */ - - /* 1 if the frame is completely visible on the display, 0 otherwise. - if 0 the frame may have been iconified or may be totally - or partially hidden by another X window */ - unsigned int totally_visible_p :1; - - /* NB: Both of the following flags are derivable from the 'shell' - field above, but it's easier if we also have them separately here. */ - - /* Are we a top-level frame? This means that our shell is a - TopLevelShell, and we should do certain things to interact with - the window manager. */ - unsigned int top_level_frame_p :1; - -#ifdef EXTERNAL_WIDGET - /* Are we using somebody else's window for our shell window? This - means that our shell is an ExternalShell. If this flag is set, then - `top_level_frame_p' will never be set. */ - unsigned int external_window_p :1; -#endif /* EXTERNAL_WIDGET */ -}; - -#define FRAME_X_DATA(f) FRAME_TYPE_DATA (f, x) - -#define FRAME_X_SHELL_WIDGET(f) (FRAME_X_DATA (f)->widget) -#define FRAME_X_CONTAINER_WIDGET(f) (FRAME_X_DATA (f)->container) -#define FRAME_X_MENUBAR_WIDGET(f) (FRAME_X_DATA (f)->menubar_widget) -#define FRAME_X_TEXT_WIDGET(f) (FRAME_X_DATA (f)->edit_widget) -#define FRAME_X_TOP_WIDGETS(f) (FRAME_X_DATA (f)->top_widgets) -#define FRAME_X_NUM_TOP_WIDGETS(f) (FRAME_X_DATA (f)->num_top_widgets) - -#define FRAME_X_ICON_PIXMAP(f) (FRAME_X_DATA (f)->icon_pixmap) -#define FRAME_X_ICON_PIXMAP_MASK(f) (FRAME_X_DATA (f)->icon_pixmap_mask) - -#ifdef HAVE_TOOLBARS -#define FRAME_X_OLD_TOOLBAR_SIZE(f, pos) (FRAME_X_DATA (f)->old_toolbar_size[pos]) - -#define FRAME_X_TOOLBAR_TOP_SHADOW_GC(f) (FRAME_X_DATA (f)->toolbar_top_shadow_gc) -#define FRAME_X_TOOLBAR_BOTTOM_SHADOW_GC(f) (FRAME_X_DATA (f)->toolbar_bottom_shadow_gc) -#define FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC(f) (FRAME_X_DATA (f)->toolbar_blank_background_gc) -#define FRAME_X_TOOLBAR_PIXMAP_BACKGROUND_GC(f) (FRAME_X_DATA (f)->toolbar_pixmap_background_gc) -#endif /* HAVE_TOOLBARS */ - -#define FRAME_X_GEOM_FREE_ME_PLEASE(f) (FRAME_X_DATA (f)->geom_free_me_please) - -#define FRAME_X_TOTALLY_VISIBLE_P(f) (FRAME_X_DATA (f)->totally_visible_p) -#define FRAME_X_TOP_LEVEL_FRAME_P(f) (FRAME_X_DATA (f)->top_level_frame_p) - -#ifdef EXTERNAL_WIDGET -#define FRAME_X_EXTERNAL_WINDOW_P(f) (FRAME_X_DATA (f)->external_window_p) -#endif - -#ifdef HAVE_XIM -#define FRAME_X_XIC_SPOT(f) (FRAME_X_DATA (f)->xic_spot) -#ifdef XIM_XLIB -#define FRAME_X_XIC(f) (FRAME_X_DATA (f)->xic) -#define FRAME_X_XIC_STYLE(f) (FRAME_X_DATA (f)->xic_style) -#endif /* XIM_XLIB */ -#endif /* HAVE_XIM */ - -/* Variables associated with the X display frame this emacs is using. */ -extern XtAppContext Xt_app_con; - -extern Lisp_Object Vx_gc_pointer_shape; -extern Lisp_Object Vx_scrollbar_pointer_shape; -extern Lisp_Object Qx_error; - -extern struct console_type *x_console_type; -extern Lisp_Object Vdefault_x_device; - -/* Number of pixels below each line. */ -extern int x_interline_space; - -extern int x_selection_timeout; - -struct frame *x_any_window_to_frame (struct device *d, Window); -struct frame *x_any_widget_or_parent_to_frame (struct device *d, - Widget widget); -struct frame *decode_x_frame (Lisp_Object); -struct frame *x_window_to_frame (struct device *d, Window); -struct device *get_device_from_display (Display *dpy); -struct device *decode_x_device (Lisp_Object); - -void x_handle_selection_notify (XSelectionEvent *event); -void x_handle_selection_request (XSelectionRequestEvent *event); -void x_handle_selection_clear (XSelectionClearEvent *event); -void x_handle_property_notify (XPropertyEvent *event); - -void Xatoms_of_xselect (struct device *d); -void Xatoms_of_objects_x (struct device *d); - -void x_wm_set_shell_iconic_p (Widget shell, int iconic_p); -void x_wm_set_cell_size (Widget wmshell, int cw, int ch); -void x_wm_set_variable_size (Widget wmshell, int width, int height); - -CONST char *x_event_name (int event_type); -int x_error_handler (Display *disp, XErrorEvent *event); -void expect_x_error (Display *dpy); -int x_error_occurred_p (Display *dpy); -int signal_if_x_error (Display *dpy, int resumable_p); -int x_IO_error_handler (Display *disp); - -void x_redraw_exposed_area (struct frame *f, int x, int y, - int width, int height); -void x_output_string (struct window *w, struct display_line *dl, - Emchar_dynarr *buf, int xpos, int xoffset, - int start_pixpos, int width, face_index findex, - int cursor, int cursor_start, int cursor_width, - int cursor_height); -void x_output_x_pixmap (struct frame *f, struct Lisp_Image_Instance *p, - int x, int y, int clip_x, int clip_y, - int clip_width, int clip_height, int width, - int height, int pixmap_offset, - unsigned long fg, unsigned long bg, - GC override_gc); -void x_output_shadows (struct frame *f, int x, int y, int width, - int height, GC top_shadow_gc, - GC bottom_shadow_gc, GC background_gc, - int shadow_thickness); -void x_generate_shadow_pixels (struct frame *f, - unsigned long *top_shadow, - unsigned long *bottom_shadow, - unsigned long background, - unsigned long core_background); - -int x_initialize_frame_menubar (struct frame *f); -void x_init_modifier_mapping (struct device *d); - -#define X_ERROR_OCCURRED(dpy, body) \ - (expect_x_error ((dpy)), (body), x_error_occurred_p (dpy)) - -#define HANDLING_X_ERROR(dpy, body) \ - ( expect_x_error ((dpy)), (body), signal_if_x_error ((dpy), 0)) - -void Initialize_Locale (void); - -#ifdef HAVE_XIM - -/* X Input Method `methods' */ -void XIM_init_device (struct device *d); -void XIM_init_frame (struct frame *f); -void XIM_SetSpotLocation (struct frame *f, int x, int y); -void XIM_SetGeometry (struct frame *f); -void XIM_focus_event (struct frame *f, int in_p); - -#ifdef XIM_XLIB -/* XtTypeConverter */ -Boolean EmacsXtCvtStringToXIMStyles ( - Display *dpy, - XrmValuePtr args, - Cardinal *num_args, - XrmValuePtr from, - XrmValuePtr to_in_out, - XtPointer *converter_data); - -/* XtDestructor */ -void EmacsFreeXIMStyles ( - XtAppContext app, - XrmValuePtr to, - XtPointer converter_data, - XrmValuePtr args, - Cardinal *num_args); - -#ifdef DEBUG_XEMACS -void describe_Window (Window win); -void describe_XFontSet (XFontSet font_set); -void describe_XIM (XIM im); -void describe_XIMStyle (XIMStyle style); -void describe_XIMStyles (XIMStyles *styles); -void describe_XIC (XIC ic); -void describe_event_mask (unsigned long mask); -void describe_XRectangle (char *name, XRectangle *rect); -void describe_Status (Status status); -#endif /* DEBUG_XEMACS */ -#endif /* XIM_XLIB */ -#endif /* HAVE_XIM */ - -extern int in_resource_setting; -extern int in_specifier_change_function; - -extern Lisp_Object Vx_initial_argv_list; /* #### ugh! */ - -#endif /* HAVE_X_WINDOWS */ -#endif /* _XEMACS_DEVICE_X_H_ */ diff --git a/src/console.c b/src/console.c deleted file mode 100644 index 550e5f8..0000000 --- a/src/console.c +++ /dev/null @@ -1,1350 +0,0 @@ -/* The console object. - Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "console-tty.h" -#include "events.h" -#include "frame.h" -#include "redisplay.h" -#include "sysdep.h" -#include "window.h" - -Lisp_Object Vconsole_list, Vselected_console; - -Lisp_Object Vcreate_console_hook, Vdelete_console_hook; - -Lisp_Object Qconsolep, Qconsole_live_p; -Lisp_Object Qcreate_console_hook; -Lisp_Object Qdelete_console_hook; - -Lisp_Object Qsuspend_hook; -Lisp_Object Qsuspend_resume_hook; - -/* This structure holds the default values of the console-local - variables defined with DEFVAR_CONSOLE_LOCAL, that have special - slots in each console. The default value occupies the same slot - in this structure as an individual console's value occupies in - that console. Setting the default value also goes through the - list of consoles and stores into each console that does not say - it has a local value. */ -Lisp_Object Vconsole_defaults; - -/* This structure marks which slots in a console have corresponding - default values in console_defaults. - Each such slot has a nonzero value in this structure. - The value has only one nonzero bit. - - When a console has its own local value for a slot, - the bit for that slot (found in the same slot in this structure) - is turned on in the console's local_var_flags slot. - - If a slot in this structure is 0, then there is a DEFVAR_CONSOLE_LOCAL - for the slot, but there is no default value for it; the corresponding - slot in console_defaults is not used except to initialize newly-created - consoles. - - If a slot is -1, then there is a DEFVAR_CONSOLE_LOCAL for it - as well as a default value which is used to initialize newly-created - consoles and as a reset-value when local-vars are killed. - - If a slot is -2, there is no DEFVAR_CONSOLE_LOCAL for it. - (The slot is always local, but there's no lisp variable for it.) - The default value is only used to initialize newly-creation consoles. - - If a slot is -3, then there is no DEFVAR_CONSOLE_LOCAL for it but - there is a default which is used to initialize newly-creation - consoles and as a reset-value when local-vars are killed. - - - */ -struct console console_local_flags; - -/* This structure holds the names of symbols whose values may be - console-local. It is indexed and accessed in the same way as the above. */ -static Lisp_Object Vconsole_local_symbols; - -DEFINE_CONSOLE_TYPE (dead); - -Lisp_Object Vconsole_type_list; - -console_type_entry_dynarr *the_console_type_entry_dynarr; - - -static Lisp_Object -mark_console (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct console *con = XCONSOLE (obj); - -#define MARKED_SLOT(x) ((void) (markobj (con->x))); -#include "conslots.h" -#undef MARKED_SLOT - - /* Can be zero for Vconsole_defaults, Vconsole_local_symbols */ - if (con->conmeths) - { - markobj (con->conmeths->symbol); - MAYBE_CONMETH (con, mark_console, (con, markobj)); - } - - return Qnil; -} - -static void -print_console (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct console *con = XCONSOLE (obj); - char buf[256]; - - if (print_readably) - error ("printing unreadable object #", - XSTRING_DATA (con->name), con->header.uid); - - sprintf (buf, "#<%s-console", !CONSOLE_LIVE_P (con) ? "dead" : - CONSOLE_TYPE_NAME (con)); - write_c_string (buf, printcharfun); - if (CONSOLE_LIVE_P (con)) - { - write_c_string (" on ", printcharfun); - print_internal (CONSOLE_CONNECTION (con), printcharfun, 1); - } - sprintf (buf, " 0x%x>", con->header.uid); - write_c_string (buf, printcharfun); -} - -DEFINE_LRECORD_IMPLEMENTATION ("console", console, - mark_console, print_console, 0, 0, 0, - struct console); - -static struct console * -allocate_console (void) -{ - Lisp_Object console; - struct console *con = alloc_lcrecord_type (struct console, lrecord_console); - struct gcpro gcpro1; - - copy_lcrecord (con, XCONSOLE (Vconsole_defaults)); - - XSETCONSOLE (console, con); - GCPRO1 (console); - - con->quit_char = 7; /* C-g */ - con->command_builder = allocate_command_builder (console); - con->function_key_map = Fmake_sparse_keymap (Qnil); - - UNGCPRO; - return con; -} - -struct console * -decode_console (Lisp_Object console) -{ - if (NILP (console)) - console = Fselected_console (); - /* quietly accept devices and frames for the console arg */ - if (DEVICEP (console) || FRAMEP (console)) - console = DEVICE_CONSOLE (decode_device (console)); - CHECK_LIVE_CONSOLE (console); - return XCONSOLE (console); -} - - -struct console_methods * -decode_console_type (Lisp_Object type, Error_behavior errb) -{ - int i; - - for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) - if (EQ (type, Dynarr_at (the_console_type_entry_dynarr, i).symbol)) - return Dynarr_at (the_console_type_entry_dynarr, i).meths; - - maybe_signal_simple_error ("Invalid console type", type, Qconsole, errb); - - return 0; -} - -int -valid_console_type_p (Lisp_Object type) -{ - return decode_console_type (type, ERROR_ME_NOT) != 0; -} - -DEFUN ("valid-console-type-p", Fvalid_console_type_p, 1, 1, 0, /* -Given a CONSOLE-TYPE, return t if it is valid. -Valid types are 'x, 'tty, and 'stream. -*/ - (console_type)) -{ - return valid_console_type_p (console_type) ? Qt : Qnil; -} - -DEFUN ("console-type-list", Fconsole_type_list, 0, 0, 0, /* -Return a list of valid console types. -*/ - ()) -{ - return Fcopy_sequence (Vconsole_type_list); -} - -DEFUN ("cdfw-console", Fcdfw_console, 1, 1, 0, /* -Given a console, device, frame, or window, return the associated console. -Return nil otherwise. -*/ - (obj)) -{ - return CDFW_CONSOLE (obj); -} - - -DEFUN ("selected-console", Fselected_console, 0, 0, 0, /* -Return the console which is currently active. -*/ - ()) -{ - return Vselected_console; -} - -/* Called from selected_device_1(), called from selected_frame_1(), - called from Fselect_window() */ -void -select_console_1 (Lisp_Object console) -{ - /* perhaps this should do something more complicated */ - Vselected_console = console; - - /* #### Schedule this to be removed in 19.14 */ -#ifdef HAVE_X_WINDOWS - if (CONSOLE_X_P (XCONSOLE (console))) - Vwindow_system = Qx; - else -#endif -#ifdef HAVE_MS_WINDOWS - if (CONSOLE_MSWINDOWS_P (XCONSOLE (console))) - Vwindow_system = Qmswindows; - else -#endif - Vwindow_system = Qnil; -} - -DEFUN ("select-console", Fselect_console, 1, 1, 0, /* -Select the console CONSOLE. -Subsequent editing commands apply to its selected device, selected frame, -and selected window. The selection of CONSOLE lasts until the next time -the user does something to select a different console, or until the next -time this function is called. -*/ - (console)) -{ - Lisp_Object device; - - CHECK_LIVE_CONSOLE (console); - - device = CONSOLE_SELECTED_DEVICE (XCONSOLE (console)); - if (!NILP (device)) - { - struct device *d = XDEVICE (device); - Lisp_Object frame = DEVICE_SELECTED_FRAME (d); - if (!NILP (frame)) - { - struct frame *f = XFRAME(frame); - Fselect_window (FRAME_SELECTED_WINDOW (f), Qnil); - } - else - error ("Can't select console with no frames."); - } - else - error ("Can't select a console with no devices"); - return Qnil; -} - -void -set_console_last_nonminibuf_frame (struct console *con, - Lisp_Object frame) -{ - con->last_nonminibuf_frame = frame; -} - -DEFUN ("consolep", Fconsolep, 1, 1, 0, /* -Return non-nil if OBJECT is a console. -*/ - (object)) -{ - return CONSOLEP (object) ? Qt : Qnil; -} - -DEFUN ("console-live-p", Fconsole_live_p, 1, 1, 0, /* -Return non-nil if OBJECT is a console that has not been deleted. -*/ - (object)) -{ - return CONSOLEP (object) && CONSOLE_LIVE_P (XCONSOLE (object)) ? Qt : Qnil; -} - -DEFUN ("console-type", Fconsole_type, 0, 1, 0, /* -Return the type of the specified console (e.g. `x' or `tty'). -Value is `tty' for a tty console (a character-only terminal), -`x' for a console that is an X display, -`mswindows' for a console that is a Windows NT/95/97 connection, -`pc' for a console that is a direct-write MS-DOS connection (not yet - implemented), -`stream' for a stream console (which acts like a stdio stream), and -`dead' for a deleted console. -*/ - (console)) -{ - /* don't call decode_console() because we want to allow for dead - consoles. */ - if (NILP (console)) - console = Fselected_console (); - CHECK_CONSOLE (console); - return CONSOLE_TYPE (XCONSOLE (console)); -} - -DEFUN ("console-name", Fconsole_name, 0, 1, 0, /* -Return the name of the specified console. -*/ - (console)) -{ - return CONSOLE_NAME (decode_console (console)); -} - -DEFUN ("console-connection", Fconsole_connection, 0, 1, 0, /* -Return the connection of the specified console. -CONSOLE defaults to the selected console if omitted. -*/ - (console)) -{ - return CONSOLE_CONNECTION (decode_console (console)); -} - -Lisp_Object -make_console (struct console *con) -{ - Lisp_Object console; - XSETCONSOLE (console, con); - return console; -} - -static Lisp_Object -semi_canonicalize_console_connection (struct console_methods *meths, - Lisp_Object name, Error_behavior errb) -{ - return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_console_connection, - (name, errb), name); -} - -static Lisp_Object -canonicalize_console_connection (struct console_methods *meths, - Lisp_Object name, Error_behavior errb) -{ - return CONTYPE_METH_OR_GIVEN (meths, canonicalize_console_connection, - (name, errb), name); -} - -static Lisp_Object -find_console_of_type (struct console_methods *meths, Lisp_Object canon) -{ - Lisp_Object concons; - - CONSOLE_LOOP (concons) - { - Lisp_Object console = XCAR (concons); - - if (EQ (CONMETH_TYPE (meths), CONSOLE_TYPE (XCONSOLE (console))) - && internal_equal (CONSOLE_CANON_CONNECTION (XCONSOLE (console)), - canon, 0)) - return console; - } - - return Qnil; -} - -DEFUN ("find-console", Ffind_console, 1, 2, 0, /* -Look for an existing console attached to connection CONNECTION. -Return the console if found; otherwise, return nil. - -If TYPE is specified, only return consoles of that type; otherwise, -return consoles of any type. (It is possible, although unlikely, -that two consoles of different types could have the same connection -name; in such a case, the first console found is returned.) -*/ - (connection, type)) -{ - Lisp_Object canon = Qnil; - struct gcpro gcpro1; - - GCPRO1 (canon); - - if (!NILP (type)) - { - struct console_methods *conmeths = decode_console_type (type, ERROR_ME); - canon = canonicalize_console_connection (conmeths, connection, - ERROR_ME_NOT); - if (UNBOUNDP (canon)) - RETURN_UNGCPRO (Qnil); - - RETURN_UNGCPRO (find_console_of_type (conmeths, canon)); - } - else - { - int i; - - for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) - { - struct console_methods *conmeths = - Dynarr_at (the_console_type_entry_dynarr, i).meths; - canon = canonicalize_console_connection (conmeths, connection, - ERROR_ME_NOT); - if (!UNBOUNDP (canon)) - { - Lisp_Object console = find_console_of_type (conmeths, canon); - if (!NILP (console)) - RETURN_UNGCPRO (console); - } - } - - RETURN_UNGCPRO (Qnil); - } -} - -DEFUN ("get-console", Fget_console, 1, 2, 0, /* -Look for an existing console attached to connection CONNECTION. -Return the console if found; otherwise, signal an error. - -If TYPE is specified, only return consoles of that type; otherwise, -return consoles of any type. (It is possible, although unlikely, -that two consoles of different types could have the same connection -name; in such a case, the first console found is returned.) -*/ - (connection, type)) -{ - Lisp_Object console = Ffind_console (connection, type); - if (NILP (console)) - { - if (NILP (type)) - signal_simple_error ("No such console", connection); - else - signal_simple_error_2 ("No such console", type, connection); - } - return console; -} - -Lisp_Object -create_console (Lisp_Object name, Lisp_Object type, Lisp_Object connection, - Lisp_Object props) -{ - /* This function can GC */ - struct console *con; - Lisp_Object console; - struct gcpro gcpro1; - - console = Ffind_console (connection, type); - if (!NILP (console)) - return console; - - con = allocate_console (); - XSETCONSOLE (console, con); - - GCPRO1 (console); - - con->conmeths = decode_console_type (type, ERROR_ME); - - CONSOLE_NAME (con) = name; - CONSOLE_CONNECTION (con) = - semi_canonicalize_console_connection (con->conmeths, connection, - ERROR_ME); - CONSOLE_CANON_CONNECTION (con) = - canonicalize_console_connection (con->conmeths, connection, - ERROR_ME); - - MAYBE_CONMETH (con, init_console, (con, props)); - - /* Do it this way so that the console list is in order of creation */ - Vconsole_list = nconc2 (Vconsole_list, Fcons (console, Qnil)); - - if (CONMETH (con, initially_selected_for_input, (con))) - event_stream_select_console (con); - - UNGCPRO; - return console; -} - -void -add_entry_to_console_type_list (Lisp_Object symbol, - struct console_methods *meths) -{ - struct console_type_entry entry; - - entry.symbol = symbol; - entry.meths = meths; - Dynarr_add (the_console_type_entry_dynarr, entry); - Vconsole_type_list = Fcons (symbol, Vconsole_type_list); -} - -/* find a console other than the selected one. Prefer non-stream - consoles over stream consoles. */ - -static Lisp_Object -find_other_console (Lisp_Object console) -{ - Lisp_Object concons; - - /* look for a non-stream console */ - CONSOLE_LOOP (concons) - { - Lisp_Object con = XCAR (concons); - if (!CONSOLE_STREAM_P (XCONSOLE (con)) - && !EQ (con, console) - && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) - && !NILP (DEVICE_SELECTED_FRAME - (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) - break; - } - if (!NILP (concons)) - return XCAR (concons); - - /* OK, now look for a stream console */ - CONSOLE_LOOP (concons) - { - Lisp_Object con = XCAR (concons); - if (!EQ (con, console) - && !NILP (CONSOLE_SELECTED_DEVICE (XCONSOLE (con))) - && !NILP (DEVICE_SELECTED_FRAME - (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (con)))))) - break; - } - if (!NILP (concons)) - return XCAR (concons); - - /* Sorry, there ain't none */ - return Qnil; -} - -static int -find_nonminibuffer_frame_not_on_console_predicate (Lisp_Object frame, - void *closure) -{ - Lisp_Object console; - - VOID_TO_LISP (console, closure); - if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) - return 0; - if (EQ (console, FRAME_CONSOLE (XFRAME (frame)))) - return 0; - return 1; -} - -static Lisp_Object -find_nonminibuffer_frame_not_on_console (Lisp_Object console) -{ - return find_some_frame (find_nonminibuffer_frame_not_on_console_predicate, - LISP_TO_VOID (console)); -} - -/* Delete console CON. - - If FORCE is non-zero, allow deletion of the only frame. - - If CALLED_FROM_KILL_EMACS is non-zero, then, if - deleting the last console, just delete it, - instead of calling `save-buffers-kill-emacs'. - - If FROM_IO_ERROR is non-zero, then the console is gone due - to an I/O error. This affects what happens if we exit - (we do an emergency exit instead of `save-buffers-kill-emacs'.) -*/ - -void -delete_console_internal (struct console *con, int force, - int called_from_kill_emacs, int from_io_error) -{ - /* This function can GC */ - Lisp_Object console; - struct gcpro gcpro1; - - /* OK to delete an already-deleted console. */ - if (!CONSOLE_LIVE_P (con)) - return; - - XSETCONSOLE (console, con); - GCPRO1 (console); - - if (!called_from_kill_emacs) - { - int down_we_go = 0; - - if ((XINT (Flength (Vconsole_list)) == 1) - /* if we just created the console, it might not be listed, - or something ... */ - && !NILP (memq_no_quit (console, Vconsole_list))) - down_we_go = 1; - /* If there aren't any nonminibuffer frames that would - be left, then exit. */ - else if (NILP (find_nonminibuffer_frame_not_on_console (console))) - down_we_go = 1; - - if (down_we_go) - { - if (!force) - error ("Attempt to delete the only frame"); - else if (from_io_error) - { - /* Mayday mayday! We're going down! */ - stderr_out (" Autosaving and exiting...\n"); - Vwindow_system = Qnil; /* let it lie! */ - preparing_for_armageddon = 1; - Fkill_emacs (make_int (70)); - } - else - { - call0 (Qsave_buffers_kill_emacs); - UNGCPRO; - /* If we get here, the user said they didn't want - to exit, so don't. */ - return; - } - } - } - - /* Breathe a sigh of relief. We're still alive. */ - - { - Lisp_Object frmcons, devcons; - - /* First delete all frames without their own minibuffers, - to avoid errors coming from attempting to delete a frame - that is a surrogate for another frame. - - We don't set "called_from_delete_console" because we want the - device to go ahead and get deleted if we delete the last frame - on a device. We won't run into trouble here because for any - frame without a minibuffer, there has to be another one on - the same console with a minibuffer, and we're not deleting that, - so delete_console_internal() won't get recursively called. - - WRONG! With surrogate minibuffers this isn't true. Frames - with only a minibuffer are not enough to prevent - delete_frame_internal from triggering a device deletion. */ - CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) - { - struct frame *f = XFRAME (XCAR (frmcons)); - /* delete_frame_internal() might do anything such as run hooks, - so be defensive. */ - if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) - delete_frame_internal (f, 1, 1, from_io_error); - - if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't - go ahead and delete anything */ - { - UNGCPRO; - return; - } - } - - CONSOLE_DEVICE_LOOP (devcons, con) - { - struct device *d = XDEVICE (XCAR (devcons)); - /* delete_device_internal() might do anything such as run hooks, - so be defensive. */ - if (DEVICE_LIVE_P (d)) - delete_device_internal (d, 1, 1, from_io_error); - if (!CONSOLE_LIVE_P (con)) /* make sure the delete-*-hook didn't - go ahead and delete anything */ - { - UNGCPRO; - return; - } - } - } - - CONSOLE_SELECTED_DEVICE (con) = Qnil; - - /* try to select another console */ - - if (EQ (console, Fselected_console ())) - { - Lisp_Object other_dev = find_other_console (console); - if (!NILP (other_dev)) - Fselect_console (other_dev); - else - { - /* necessary? */ - Vselected_console = Qnil; - Vwindow_system = Qnil; - } - } - - if (con->input_enabled) - event_stream_unselect_console (con); - - MAYBE_CONMETH (con, delete_console, (con)); - - Vconsole_list = delq_no_quit (console, Vconsole_list); - RESET_CHANGED_SET_FLAGS; - con->conmeths = dead_console_methods; - - UNGCPRO; -} - -void -io_error_delete_console (Lisp_Object console) -{ - delete_console_internal (XCONSOLE (console), 1, 0, 1); -} - -DEFUN ("delete-console", Fdelete_console, 1, 2, 0, /* -Delete CONSOLE, permanently eliminating it from use. -Normally, you cannot delete the last non-minibuffer-only frame (you must -use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional -second argument FORCE is non-nil, you can delete the last frame. (This -will automatically call `save-buffers-kill-emacs'.) -*/ - (console, force)) -{ - CHECK_CONSOLE (console); - delete_console_internal (XCONSOLE (console), !NILP (force), 0, 0); - return Qnil; -} - -DEFUN ("console-list", Fconsole_list, 0, 0, 0, /* -Return a list of all consoles. -*/ - ()) -{ - return Fcopy_sequence (Vconsole_list); -} - -DEFUN ("console-device-list", Fconsole_device_list, 0, 1, 0, /* -Return a list of all devices on CONSOLE. -If CONSOLE is nil, the selected console will be used. -*/ - (console)) -{ - return Fcopy_sequence (CONSOLE_DEVICE_LIST (decode_console (console))); -} - -DEFUN ("console-enable-input", Fconsole_enable_input, 1, 1, 0, /* -Enable input on console CONSOLE. -*/ - (console)) -{ - struct console *con = decode_console (console); - if (!con->input_enabled) - event_stream_select_console (con); - return Qnil; -} - -DEFUN ("console-disable-input", Fconsole_disable_input, 1, 1, 0, /* -Disable input on console CONSOLE. -*/ - (console)) -{ - struct console *con = decode_console (console); - if (con->input_enabled) - event_stream_unselect_console (con); - return Qnil; -} - -DEFUN ("console-on-window-system-p", Fconsole_on_window_system_p, 0, 1, 0, /* -Return non-nil if this console is on a window system. -This generally means that there is support for the mouse, the menubar, -the toolbar, glyphs, etc. -*/ - (console)) -{ - Lisp_Object type = CONSOLE_TYPE (decode_console (console)); - - return !EQ (type, Qtty) && !EQ (type, Qstream) ? Qt : Qnil; -} - - - -/**********************************************************************/ -/* Miscellaneous low-level functions */ -/**********************************************************************/ - -static Lisp_Object -unwind_init_sys_modes (Lisp_Object console) -{ - reinit_initial_console (); - - if (!no_redraw_on_reenter && - CONSOLEP (console) && - CONSOLE_LIVE_P (XCONSOLE (console))) - { - struct frame *f = - XFRAME (DEVICE_SELECTED_FRAME - (XDEVICE (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))))); - MARK_FRAME_CHANGED (f); - } - return Qnil; -} - -DEFUN ("suspend-emacs", Fsuspend_emacs, 0, 1, "", /* -Stop Emacs and return to superior process. You can resume later. -On systems that don't have job control, run a subshell instead. - -If optional arg STUFFSTRING is non-nil, its characters are stuffed -to be read as terminal input by Emacs's superior shell. - -Before suspending, run the normal hook `suspend-hook'. -After resumption run the normal hook `suspend-resume-hook'. - -Some operating systems cannot stop the Emacs process and resume it later. -On such systems, Emacs will start a subshell and wait for it to exit. -*/ - (stuffstring)) -{ - int speccount = specpdl_depth (); - struct gcpro gcpro1; - - if (!NILP (stuffstring)) - CHECK_STRING (stuffstring); - GCPRO1 (stuffstring); - - /* There used to be a check that the initial console is TTY. - This is bogus. Even checking to see whether any console - is a controlling terminal is not correct -- maybe - the user used the -t option or something. If we want to - suspend, then we suspend. Period. */ - - /* Call value of suspend-hook. */ - run_hook (Qsuspend_hook); - - reset_initial_console (); - /* sys_suspend can get an error if it tries to fork a subshell - and the system resources aren't available for that. */ - record_unwind_protect (unwind_init_sys_modes, Vcontrolling_terminal); - stuff_buffered_input (stuffstring); - sys_suspend (); - /* the console is un-reset inside of the unwind-protect. */ - unbind_to (speccount, Qnil); - -#ifdef SIGWINCH - /* It is possible that a size change occurred while we were - suspended. Assume one did just to be safe. It won't hurt - anything if one didn't. */ - asynch_device_change_pending++; -#endif - - /* Call value of suspend-resume-hook - if it is bound and value is non-nil. */ - run_hook (Qsuspend_resume_hook); - - UNGCPRO; - return Qnil; -} - -/* If STUFFSTRING is a string, stuff its contents as pending terminal input. - Then in any case stuff anything Emacs has read ahead and not used. */ - -void -stuff_buffered_input (Lisp_Object stuffstring) -{ -/* stuff_char works only in BSD, versions 4.2 and up. */ -#if defined (BSD) - if (!CONSOLEP (Vcontrolling_terminal) || - !CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) - return; - - if (STRINGP (stuffstring)) - { - Extcount count; - Extbyte *p; - - GET_STRING_EXT_DATA_ALLOCA (stuffstring, FORMAT_KEYBOARD, p, count); - while (count-- > 0) - stuff_char (XCONSOLE (Vcontrolling_terminal), *p++); - stuff_char (XCONSOLE (Vcontrolling_terminal), '\n'); - } - /* Anything we have read ahead, put back for the shell to read. */ -# if 0 /* oh, who cares about this silliness */ - while (kbd_fetch_ptr != kbd_store_ptr) - { - if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) - kbd_fetch_ptr = kbd_buffer; - stuff_char (XCONSOLE (Vcontrolling_terminal), *kbd_fetch_ptr++); - } -# endif -#endif /* BSD */ -} - -DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /* -Suspend a console. For tty consoles, it sends a signal to suspend -the process in charge of the tty, and removes the devices and -frames of that console from the display. - -If optional arg CONSOLE is non-nil, it is the console to be suspended. -Otherwise it is assumed to be the selected console. - -Some operating systems cannot stop processes and resume them later. -On such systems, who knows what will happen. -*/ - (console)) -{ -#ifdef HAVE_TTY - struct console *con = decode_console (console); - - if (CONSOLE_TTY_P (con)) - { - /* - * hide all the unhidden frames so the display code won't update - * them while the console is suspended. - */ - Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); - if (!NILP (device)) - { - struct device *d = XDEVICE (device); - Lisp_Object frame_list = DEVICE_FRAME_LIST (d); - while (CONSP (frame_list)) - { - struct frame *f = XFRAME (XCAR (frame_list)); - if (FRAME_REPAINT_P (f)) - f->visible = -1; - frame_list = XCDR (frame_list); - } - } - reset_one_console (con); - event_stream_unselect_console (con); - sys_suspend_process (XINT (Fconsole_tty_controlling_process (console))); - } -#endif /* HAVE_TTY */ - - return Qnil; -} - -DEFUN ("resume-console", Fresume_console, 1, 1, "", /* -Re-initialize a previously suspended console. -For tty consoles, do stuff to the tty to make it sane again. -*/ - (console)) -{ -#ifdef HAVE_TTY - struct console *con = decode_console (console); - - if (CONSOLE_TTY_P (con)) - { - /* raise the selected frame */ - Lisp_Object device = CONSOLE_SELECTED_DEVICE (con); - if (!NILP (device)) - { - struct device *d = XDEVICE (device); - Lisp_Object frame = DEVICE_SELECTED_FRAME (d); - if (!NILP (frame)) - { - /* force the frame to be cleared */ - SET_FRAME_CLEAR (XFRAME (frame)); - Fraise_frame (frame); - } - } - init_one_console (con); - event_stream_select_console (con); -#ifdef SIGWINCH - /* The same as in Fsuspend_emacs: it is possible that a size - change occurred while we were suspended. Assume one did just - to be safe. It won't hurt anything if one didn't. */ - asynch_device_change_pending++; -#endif - } -#endif /* HAVE_TTY */ - - return Qnil; -} - -DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* -Set mode of reading keyboard input. -First arg is ignored, for backward compatibility. -Second arg FLOW non-nil means use ^S/^Q flow control for output to terminal - (no effect except in CBREAK mode). -Third arg META t means accept 8-bit input (for a Meta key). - META nil means ignore the top bit, on the assumption it is parity. - Otherwise, accept 8-bit input and don't use the top bit for Meta. -First three arguments only apply to TTY consoles. -Optional fourth arg QUIT if non-nil specifies character to use for quitting. -Optional fifth arg CONSOLE specifies console to make changes to; nil means - the selected console. -See also `current-input-mode'. -*/ - (ignored, flow, meta, quit, console)) -{ - struct console *con = decode_console (console); - int meta_key = (!CONSOLE_TTY_P (con) ? 1 : - EQ (meta, Qnil) ? 0 : - EQ (meta, Qt) ? 1 : - 2); - - if (!NILP (quit)) - { - CHECK_CHAR_COERCE_INT (quit); - CONSOLE_QUIT_CHAR (con) = - ((unsigned int) XCHAR (quit)) & (meta_key ? 0377 : 0177); - } - -#ifdef HAVE_TTY - if (CONSOLE_TTY_P (con)) - { - reset_one_console (con); - TTY_FLAGS (con).flow_control = !NILP (flow); - TTY_FLAGS (con).meta_key = meta_key; - init_one_console (con); - } -#endif - - return Qnil; -} - -DEFUN ("current-input-mode", Fcurrent_input_mode, 0, 1, 0, /* -Return information about the way Emacs currently reads keyboard input. -Optional arg CONSOLE specifies console to return information about; nil means - the selected console. -The value is a list of the form (nil FLOW META QUIT), where - FLOW is non-nil if Emacs uses ^S/^Q flow control for output to the - terminal; this does not apply if Emacs uses interrupt-driven input. - META is t if accepting 8-bit input with 8th bit as Meta flag. - META nil means ignoring the top bit, on the assumption it is parity. - META is neither t nor nil if accepting 8-bit input and using - all 8 bits as the character code. - QUIT is the character Emacs currently uses to quit. -FLOW, and META are only meaningful for TTY consoles. -The elements of this list correspond to the arguments of -`set-input-mode'. -*/ - (console)) -{ - struct console *con = decode_console (console); - Lisp_Object flow, meta, quit; - -#ifdef HAVE_TTY - flow = CONSOLE_TTY_P (con) && TTY_FLAGS (con).flow_control ? Qt : Qnil; - meta = (!CONSOLE_TTY_P (con) ? Qt : - TTY_FLAGS (con).meta_key == 1 ? Qt : - TTY_FLAGS (con).meta_key == 2 ? Qzero : - Qnil); -#else - flow = Qnil; - meta = Qt; -#endif - quit = make_char (CONSOLE_QUIT_CHAR (con)); - - return list4 (Qnil, flow, meta, quit); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_console (void) -{ - DEFSUBR (Fvalid_console_type_p); - DEFSUBR (Fconsole_type_list); - DEFSUBR (Fcdfw_console); - DEFSUBR (Fselected_console); - DEFSUBR (Fselect_console); - DEFSUBR (Fconsolep); - DEFSUBR (Fconsole_live_p); - DEFSUBR (Fconsole_type); - DEFSUBR (Fconsole_name); - DEFSUBR (Fconsole_connection); - DEFSUBR (Ffind_console); - DEFSUBR (Fget_console); - DEFSUBR (Fdelete_console); - DEFSUBR (Fconsole_list); - DEFSUBR (Fconsole_device_list); - DEFSUBR (Fconsole_enable_input); - DEFSUBR (Fconsole_disable_input); - DEFSUBR (Fconsole_on_window_system_p); - DEFSUBR (Fsuspend_console); - DEFSUBR (Fresume_console); - - DEFSUBR (Fsuspend_emacs); - DEFSUBR (Fset_input_mode); - DEFSUBR (Fcurrent_input_mode); - - defsymbol (&Qconsolep, "consolep"); - defsymbol (&Qconsole_live_p, "console-live-p"); - - defsymbol (&Qcreate_console_hook, "create-console-hook"); - defsymbol (&Qdelete_console_hook, "delete-console-hook"); - - defsymbol (&Qsuspend_hook, "suspend-hook"); - defsymbol (&Qsuspend_resume_hook, "suspend-resume-hook"); -} - -void -console_type_create (void) -{ - the_console_type_entry_dynarr = Dynarr_new (console_type_entry); - - Vconsole_type_list = Qnil; - staticpro (&Vconsole_type_list); - - /* Initialize the dead console type */ - INITIALIZE_CONSOLE_TYPE (dead, "dead", "console-dead-p"); - - /* then reset the console-type lists, because `dead' is not really - a valid console type */ - Dynarr_reset (the_console_type_entry_dynarr); - Vconsole_type_list = Qnil; -} - -void -vars_of_console (void) -{ - DEFVAR_LISP ("create-console-hook", &Vcreate_console_hook /* -Function or functions to call when a console is created. -One argument, the newly-created console. -This is called after the first frame has been created, but before - calling the `create-device-hook' or `create-frame-hook'. -Note that in general the console will not be selected. -*/ ); - Vcreate_console_hook = Qnil; - - DEFVAR_LISP ("delete-console-hook", &Vdelete_console_hook /* -Function or functions to call when a console is deleted. -One argument, the to-be-deleted console. -*/ ); - Vdelete_console_hook = Qnil; - - staticpro (&Vconsole_list); - Vconsole_list = Qnil; - staticpro (&Vselected_console); - Vselected_console = Qnil; - -#ifdef HAVE_WINDOW_SYSTEM - Fprovide (intern ("window-system")); -#endif -} - -/* The docstrings for DEFVAR_* are recorded externally by make-docfile. */ - -/* Declaring this stuff as const produces 'Cannot reinitialize' messages - from SunPro C's fix-and-continue feature (a way neato feature that - makes debugging unbelievably more bearable) */ -#define DEFVAR_CONSOLE_LOCAL_1(lname, field_name, forward_type, magicfun) do { \ - static CONST_IF_NOT_DEBUG struct symbol_value_forward I_hate_C \ - = { { { symbol_value_forward_lheader_initializer, \ - (struct lcrecord_header *) &(console_local_flags.field_name), 69 }, \ - forward_type }, magicfun }; \ - { \ - int offset = ((char *)symbol_value_forward_forward (&I_hate_C) \ - - (char *)&console_local_flags); \ - \ - defvar_magic (lname, &I_hate_C); \ - \ - *((Lisp_Object *)(offset + (char *)XCONSOLE (Vconsole_local_symbols))) \ - = intern (lname); \ - } \ -} while (0) - -#define DEFVAR_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ - DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \ - SYMVAL_SELECTED_CONSOLE_FORWARD, magicfun) -#define DEFVAR_CONSOLE_LOCAL(lname, field_name) \ - DEFVAR_CONSOLE_LOCAL_MAGIC (lname, field_name, 0) -#define DEFVAR_CONST_CONSOLE_LOCAL_MAGIC(lname, field_name, magicfun) \ - DEFVAR_CONSOLE_LOCAL_1 (lname, field_name, \ - SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, magicfun) -#define DEFVAR_CONST_CONSOLE_LOCAL(lname, field_name) \ - DEFVAR_CONST_CONSOLE_LOCAL_MAGIC (lname, field_name, 0) - -#define DEFVAR_CONSOLE_DEFAULTS_MAGIC(lname, field_name, magicfun) \ - DEFVAR_SYMVAL_FWD(lname, &(console_local_flags.field_name), \ - SYMVAL_DEFAULT_CONSOLE_FORWARD, magicfun) -#define DEFVAR_CONSOLE_DEFAULTS(lname, field_name) \ - DEFVAR_CONSOLE_DEFAULTS_MAGIC (lname, field_name, 0) - -static void -nuke_all_console_slots (struct console *con, Lisp_Object zap) -{ - zero_lcrecord (con); - -#define MARKED_SLOT(x) con->x = (zap); -#include "conslots.h" -#undef MARKED_SLOT -} - -void -complex_vars_of_console (void) -{ - /* Make sure all markable slots in console_defaults - are initialized reasonably, so mark_console won't choke. - */ - struct console *defs = alloc_lcrecord_type (struct console, lrecord_console); - struct console *syms = alloc_lcrecord_type (struct console, lrecord_console); - - staticpro (&Vconsole_defaults); - staticpro (&Vconsole_local_symbols); - XSETCONSOLE (Vconsole_defaults, defs); - XSETCONSOLE (Vconsole_local_symbols, syms); - - nuke_all_console_slots (syms, Qnil); - nuke_all_console_slots (defs, Qnil); - - /* Set up the non-nil default values of various console slots. - Must do these before making the first console. - */ - /* #### Anything needed here? */ - - { - /* 0 means var is always local. Default used only at creation. - * -1 means var is always local. Default used only at reset and - * creation. - * -2 means there's no lisp variable corresponding to this slot - * and the default is only used at creation. - * -3 means no Lisp variable. Default used only at reset and creation. - * >0 is mask. Var is local if ((console->local_var_flags & mask) != 0) - * Otherwise default is used. - * - * #### We don't currently ever reset console variables, so there - * is no current distinction between 0 and -1, and between -2 and -3. - */ - Lisp_Object always_local_resettable = make_int (-1); - -#if 0 /* not used */ - Lisp_Object always_local_no_default = make_int (0); - Lisp_Object resettable = make_int (-3); -#endif - - /* Assign the local-flags to the slots that have default values. - The local flag is a bit that is used in the console - to say that it has its own local value for the slot. - The local flag bits are in the local_var_flags slot of the - console. */ - - nuke_all_console_slots (&console_local_flags, make_int (-2)); - console_local_flags.defining_kbd_macro = always_local_resettable; - console_local_flags.last_kbd_macro = always_local_resettable; - console_local_flags.prefix_arg = always_local_resettable; - console_local_flags.default_minibuffer_frame = always_local_resettable; - console_local_flags.overriding_terminal_local_map = - always_local_resettable; -#ifdef HAVE_TTY - console_local_flags.tty_erase_char = always_local_resettable; -#endif - - console_local_flags.function_key_map = make_int (1); - - /* #### Warning, 0x4000000 (that's six zeroes) is the largest number - currently allowable due to the XINT() handling of this value. - With some rearrangement you can get 4 more bits. */ - } - - DEFVAR_CONSOLE_DEFAULTS ("default-function-key-map", function_key_map /* -Default value of `function-key-map' for consoles that don't override it. -This is the same as (default-value 'function-key-map). -*/ ); - - DEFVAR_CONSOLE_LOCAL ("function-key-map", function_key_map /* -Keymap mapping ASCII function key sequences onto their preferred forms. -This allows Emacs to recognize function keys sent from ASCII -terminals at any point in a key sequence. - -The `read-key-sequence' function replaces any subsequence bound by -`function-key-map' with its binding. More precisely, when the active -keymaps have no binding for the current key sequence but -`function-key-map' binds a suffix of the sequence to a vector or string, -`read-key-sequence' replaces the matching suffix with its binding, and -continues with the new sequence. - -The events that come from bindings in `function-key-map' are not -themselves looked up in `function-key-map'. - -For example, suppose `function-key-map' binds `ESC O P' to [f1]. -Typing `ESC O P' to `read-key-sequence' would return -\[#]. Typing `C-x ESC O P' would return -\[# #]. If [f1] -were a prefix key, typing `ESC O P x' would return -\[# #]. -*/ ); - -#ifdef HAVE_TTY - /* ### Should this somehow go to TTY data? How do we make it - accessible from Lisp, then? */ - DEFVAR_CONSOLE_LOCAL ("tty-erase-char", tty_erase_char /* -The ERASE character as set by the user with stty. -When this value cannot be determined or would be meaningless (on non-TTY -consoles, for example), it is set to nil. -*/ ); -#endif - - /* While this should be CONST it can't be because some things - (i.e. edebug) do manipulate it. */ - DEFVAR_CONSOLE_LOCAL ("defining-kbd-macro", defining_kbd_macro /* -Non-nil while a console macro is being defined. Don't set this! -*/ ); - - DEFVAR_CONSOLE_LOCAL ("last-kbd-macro", last_kbd_macro /* -Last kbd macro defined, as a vector of events; nil if none defined. -*/ ); - - DEFVAR_CONSOLE_LOCAL ("prefix-arg", prefix_arg /* -The value of the prefix argument for the next editing command. -It may be a number, or the symbol `-' for just a minus sign as arg, -or a list whose car is a number for just one or more C-U's -or nil if no argument has been specified. - -You cannot examine this variable to find the argument for this command -since it has been set to nil by the time you can look. -Instead, you should use the variable `current-prefix-arg', although -normally commands can get this prefix argument with (interactive "P"). -*/ ); - - DEFVAR_CONSOLE_LOCAL ("default-minibuffer-frame", - default_minibuffer_frame /* -Minibufferless frames use this frame's minibuffer. - -Emacs cannot create minibufferless frames unless this is set to an -appropriate surrogate. - -XEmacs consults this variable only when creating minibufferless -frames; once the frame is created, it sticks with its assigned -minibuffer, no matter what this variable is set to. This means that -this variable doesn't necessarily say anything meaningful about the -current set of frames, or where the minibuffer is currently being -displayed. -*/ ); - - DEFVAR_CONSOLE_LOCAL ("overriding-terminal-local-map", - overriding_terminal_local_map /* -Keymap that overrides all other local keymaps, for the selected console only. -If this variable is non-nil, it is used as a keymap instead of the -buffer's local map, and the minor mode keymaps and text property keymaps. -*/ ); - - /* Check for DEFVAR_CONSOLE_LOCAL without initializing the corresponding - slot of console_local_flags and vice-versa. Must be done after all - DEFVAR_CONSOLE_LOCAL() calls. */ -#define MARKED_SLOT(slot) \ - if ((XINT (console_local_flags.slot) != -2 && \ - XINT (console_local_flags.slot) != -3) \ - != !(NILP (XCONSOLE (Vconsole_local_symbols)->slot))) \ - abort () -#include "conslots.h" -#undef MARKED_SLOT -} diff --git a/src/console.h b/src/console.h deleted file mode 100644 index 034c585..0000000 --- a/src/console.h +++ /dev/null @@ -1,556 +0,0 @@ -/* Define console object for XEmacs. - Copyright (C) 1996 Ben Wing - -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. */ - -#ifndef _XEMACS_CONSOLE_H_ -#define _XEMACS_CONSOLE_H_ - -/* Devices and consoles are similar entities. The idea is that - a console represents a physical keyboard/mouse/other-input-source - while a device represents a display where frames appear on. - In the X world, a console is a "Display" while a device is a - "Screen". Implementationally, it can sometimes get confusing: - under X, multiple devices on a single console are different - "Display" connections to what is in reality the same Display on - the same server. Because of this, input comes from the device - and not from the console. This is OK because events are basically - always tagged to a particular X window (i.e. frame), - which exists on only one screen; therefore the event won't be - reported multiple times even if there are multiple devices on - the same physical display. This is an implementation detail - specific to X consoles (e.g. under NeXTstep or Windows, this - could be different, and input would come directly from the console). -*/ - - -/* GCC does not like forward enum declaration. This needs to be - defined here. What a disgust! */ - -enum device_metrics -{ - DM_color_default, DM_color_select, DM_color_balloon, DM_color_3d_face, - DM_color_3d_light, DM_color_3d_dark, DM_color_menu, DM_color_menu_highlight, - DM_color_menu_button, DM_color_menu_disabled, DM_color_toolbar, - DM_color_scrollbar, DM_color_desktop, DM_color_workspace, DM_font_default, - DM_font_menubar, DM_font_dialog, DM_size_cursor, DM_size_scrollbar, - DM_size_menu, DM_size_toolbar, DM_size_toolbar_button, - DM_size_toolbar_border, DM_size_icon, DM_size_icon_small, DM_size_device, - DM_size_workspace, DM_size_device_mm, DM_device_dpi, DM_num_bit_planes, - DM_num_color_cells, DM_mouse_buttons, DM_swap_buttons, DM_show_sounds, - DM_slow_device, DM_security -}; - -struct console_methods -{ - CONST char *name; /* Used by print_console, print_device, print_frame */ - Lisp_Object symbol; - Lisp_Object predicate_symbol; - - /* console methods */ - void (*init_console_method) (struct console *, Lisp_Object props); - void (*mark_console_method) (struct console *, void (*)(Lisp_Object)); - int (*initially_selected_for_input_method) (struct console *); - void (*delete_console_method) (struct console *); - Lisp_Object (*semi_canonicalize_console_connection_method) - (Lisp_Object connection, Error_behavior errb); - Lisp_Object (*semi_canonicalize_device_connection_method) - (Lisp_Object connection, Error_behavior errb); - Lisp_Object (*canonicalize_console_connection_method) - (Lisp_Object connection, Error_behavior errb); - Lisp_Object (*canonicalize_device_connection_method) - (Lisp_Object connection, Error_behavior errb); - Lisp_Object (*device_to_console_connection_method) - (Lisp_Object connection, Error_behavior errb); - - /* device methods */ - void (*init_device_method) (struct device *, Lisp_Object props); - void (*finish_init_device_method) (struct device *, Lisp_Object props); - void (*delete_device_method) (struct device *); - void (*mark_device_method) (struct device *, void (*)(Lisp_Object)); - void (*asynch_device_change_method) (void); - Lisp_Object (*device_system_metrics_method) (struct device *, enum device_metrics); - unsigned int (*device_implementation_flags_method) (); - - /* frame methods */ - Lisp_Object *device_specific_frame_props; - void (*init_frame_1_method) (struct frame *, Lisp_Object properties); - void (*init_frame_2_method) (struct frame *, Lisp_Object properties); - void (*init_frame_3_method) (struct frame *); - void (*after_init_frame_method) (struct frame *, int first_on_device, - int first_on_console); - void (*mark_frame_method) (struct frame *, void (*)(Lisp_Object)); - void (*delete_frame_method) (struct frame *); - void (*focus_on_frame_method) (struct frame *); - void (*raise_frame_method) (struct frame *); - void (*lower_frame_method) (struct frame *); - int (*get_mouse_position_method) (struct device *d, Lisp_Object *frame, - int *x, int *y); - void (*set_mouse_position_method) (struct window *w, int x, int y); - void (*make_frame_visible_method) (struct frame *f); - void (*make_frame_invisible_method) (struct frame *f); - void (*iconify_frame_method) (struct frame *f); - Lisp_Object (*frame_property_method) (struct frame *f, Lisp_Object prop); - int (*internal_frame_property_p_method) (struct frame *f, - Lisp_Object prop); - Lisp_Object (*frame_properties_method) (struct frame *f); - void (*set_frame_properties_method) (struct frame *f, Lisp_Object plist); - void (*set_frame_size_method) (struct frame *f, int width, int height); - void (*set_frame_position_method) (struct frame *f, int xoff, int yoff); - int (*frame_visible_p_method) (struct frame *f); - int (*frame_totally_visible_p_method) (struct frame *f); - int (*frame_iconified_p_method) (struct frame *f); - void (*set_title_from_bufbyte_method) (struct frame *f, Bufbyte *title); - void (*set_icon_name_from_bufbyte_method) (struct frame *f, Bufbyte *title); - void (*set_frame_pointer_method) (struct frame *f); - void (*set_frame_icon_method) (struct frame *f); - void (*popup_menu_method) (Lisp_Object menu, Lisp_Object event); - Lisp_Object (*get_frame_parent_method) (struct frame *f); - void (*update_frame_external_traits_method) (struct frame *f, Lisp_Object name); - int (*frame_size_fixed_p_method) (struct frame *f); - - /* redisplay methods */ - int (*left_margin_width_method) (struct window *); - int (*right_margin_width_method) (struct window *); - int (*text_width_method) (struct frame *f, struct face_cachel *cachel, - CONST Emchar *str, Charcount len); - void (*output_display_block_method) (struct window *, struct display_line *, - int, int, int, int, int, int, int); - int (*divider_height_method) (void); - int (*eol_cursor_width_method) (void); - void (*output_vertical_divider_method) (struct window *, int); - void (*clear_to_window_end_method) (struct window *, int, int); - void (*clear_region_method) (Lisp_Object, struct device*, struct frame*, face_index, - int, int, int, int, - Lisp_Object, Lisp_Object, Lisp_Object); - void (*clear_frame_method) (struct frame *); - void (*output_begin_method) (struct device *); - void (*output_end_method) (struct device *); - int (*flash_method) (struct device *); - void (*ring_bell_method) (struct device *, int volume, int pitch, - int duration); - void (*frame_redraw_cursor_method) (struct frame *f); - void (*set_final_cursor_coords_method) (struct frame *, int, int); - - /* color methods */ - int (*initialize_color_instance_method) (struct Lisp_Color_Instance *, - Lisp_Object name, - Lisp_Object device, - Error_behavior errb); - void (*mark_color_instance_method) (struct Lisp_Color_Instance *, - void (*)(Lisp_Object)); - void (*print_color_instance_method) (struct Lisp_Color_Instance *, - Lisp_Object printcharfun, - int escapeflag); - void (*finalize_color_instance_method) (struct Lisp_Color_Instance *); - int (*color_instance_equal_method) (struct Lisp_Color_Instance *, - struct Lisp_Color_Instance *, - int depth); - unsigned long (*color_instance_hash_method) (struct Lisp_Color_Instance *, - int depth); - Lisp_Object (*color_instance_rgb_components_method) - (struct Lisp_Color_Instance *); - int (*valid_color_name_p_method) (struct device *, Lisp_Object color); - - /* font methods */ - int (*initialize_font_instance_method) (struct Lisp_Font_Instance *, - Lisp_Object name, - Lisp_Object device, - Error_behavior errb); - void (*mark_font_instance_method) (struct Lisp_Font_Instance *, - void (*)(Lisp_Object)); - void (*print_font_instance_method) (struct Lisp_Font_Instance *, - Lisp_Object printcharfun, - int escapeflag); - void (*finalize_font_instance_method) (struct Lisp_Font_Instance *); - Lisp_Object (*font_instance_truename_method) (struct Lisp_Font_Instance *, - Error_behavior errb); - Lisp_Object (*font_instance_properties_method) (struct Lisp_Font_Instance *); - Lisp_Object (*list_fonts_method) (Lisp_Object pattern, - Lisp_Object device); - Lisp_Object (*find_charset_font_method) (Lisp_Object device, - Lisp_Object font, - Lisp_Object charset); - int (*font_spec_matches_charset_method) (struct device *d, - Lisp_Object charset, - CONST Bufbyte *nonreloc, - Lisp_Object reloc, - Bytecount offset, - Bytecount length); - - /* image methods */ - void (*mark_image_instance_method) (struct Lisp_Image_Instance *, - void (*)(Lisp_Object)); - void (*print_image_instance_method) (struct Lisp_Image_Instance *, - Lisp_Object printcharfun, - int escapeflag); - void (*finalize_image_instance_method) (struct Lisp_Image_Instance *); - void (*unmap_subwindow_method) (struct Lisp_Image_Instance *); - void (*map_subwindow_method) (struct Lisp_Image_Instance *, int x, int y); - void (*resize_subwindow_method) (struct Lisp_Image_Instance *, int w, int h); - void (*update_subwindow_method) (struct Lisp_Image_Instance *); - int (*image_instance_equal_method) (struct Lisp_Image_Instance *, - struct Lisp_Image_Instance *, - int depth); - unsigned long (*image_instance_hash_method) (struct Lisp_Image_Instance *, - int depth); - void (*init_image_instance_from_eimage_method) (struct Lisp_Image_Instance *ii, - int width, int height, - unsigned char *eimage, - int dest_mask, - Lisp_Object instantiator, - Lisp_Object domain); - Lisp_Object (*locate_pixmap_file_method) (Lisp_Object file_method); - int (*colorize_image_instance_method) (Lisp_Object image_instance, - Lisp_Object fg, Lisp_Object bg); - Lisp_Object image_conversion_list; - -#ifdef HAVE_TOOLBARS - /* toolbar methods */ - void (*output_frame_toolbars_method) (struct frame *); - void (*initialize_frame_toolbars_method) (struct frame *); - void (*free_frame_toolbars_method) (struct frame *); - void (*output_toolbar_button_method) (struct frame *, Lisp_Object); - void (*redraw_frame_toolbars_method) (struct frame *); - void (*redraw_exposed_toolbars_method) (struct frame *f, int x, int y, - int width, int height); -#endif - -#ifdef HAVE_SCROLLBARS - /* scrollbar methods */ - int (*inhibit_scrollbar_slider_size_change_method) (void); - void (*free_scrollbar_instance_method) (struct scrollbar_instance *); - void (*release_scrollbar_instance_method) (struct scrollbar_instance *); - void (*create_scrollbar_instance_method) (struct frame *, int, - struct scrollbar_instance *); - void (*update_scrollbar_instance_values_method) (struct window *, - struct scrollbar_instance *, - int, int, int, int, int, - int, int, int, int, int); - void (*update_scrollbar_instance_status_method) (struct window *, int, int, - struct - scrollbar_instance *); - void (*scrollbar_pointer_changed_in_window_method) (struct window *w); -#ifdef MEMORY_USAGE_STATS - int (*compute_scrollbar_instance_usage_method) (struct device *, - struct scrollbar_instance *, - struct overhead_stats *); -#endif -#endif /* HAVE_SCROLLBARS */ - -#ifdef HAVE_MENUBARS - /* menubar methods */ - void (*update_frame_menubars_method) (struct frame *); - void (*free_frame_menubars_method) (struct frame *); -#endif - -#ifdef HAVE_DIALOGS - /* dialog methods */ - void (*popup_dialog_box_method) (struct frame *, Lisp_Object dbox_desc); -#endif -}; - -/* - * Constants returned by device_implementation_flags_method - */ -/* Set when device uses pixel-based geometry */ -#define XDEVIMPF_PIXEL_GEOMETRY 0x00000001L - - -#define CONSOLE_TYPE_NAME(c) ((c)->conmeths->name) -#define CONSOLE_TYPE(c) ((c)->conmeths->symbol) -#define CONMETH_TYPE(meths) ((meths)->symbol) - -/******** Accessing / calling a console method *********/ - -#define HAS_CONTYPE_METH_P(meth, m) ((meth)->m##_method) -#define CONTYPE_METH(meth, m, args) (((meth)->m##_method) args) - -/* Call a void-returning console method, if it exists */ -#define MAYBE_CONTYPE_METH(meth, m, args) do { \ - struct console_methods *maybe_contype_meth_meth = (meth); \ - if (HAS_CONTYPE_METH_P (maybe_contype_meth_meth, m)) \ - CONTYPE_METH (maybe_contype_meth_meth, m, args); \ -} while (0) - -/* Call a console method, if it exists; otherwise return - the specified value - meth is multiply evaluated. */ -#define CONTYPE_METH_OR_GIVEN(meth, m, args, given) \ - (HAS_CONTYPE_METH_P (meth, m) ? \ - CONTYPE_METH (meth, m, args) : (given)) - -/* Call an int-returning console method, if it exists; otherwise - return 0 */ -#define MAYBE_INT_CONTYPE_METH(meth, m, args) \ - CONTYPE_METH_OR_GIVEN (meth, m, args, 0) - -/* Call an Lisp-Object-returning console method, if it exists; - otherwise return Qnil */ -#define MAYBE_LISP_CONTYPE_METH(meth, m, args) \ - CONTYPE_METH_OR_GIVEN (meth, m, args, Qnil) - -/******** Same functions, operating on a console instead of a - struct console_methods ********/ - -#define HAS_CONMETH_P(c, m) HAS_CONTYPE_METH_P ((c)->conmeths, m) -#define CONMETH(c, m, args) CONTYPE_METH ((c)->conmeths, m, args) -#define MAYBE_CONMETH(c, m, args) MAYBE_CONTYPE_METH ((c)->conmeths, m, args) -#define CONMETH_OR_GIVEN(c, m, args, given) \ - CONTYPE_METH_OR_GIVEN((c)->conmeths, m, args, given) -#define MAYBE_INT_CONMETH(c, m, args) \ - MAYBE_INT_CONTYPE_METH ((c)->conmeths, m, args) -#define MAYBE_LISP_CONMETH(c, m, args) \ - MAYBE_LISP_CONTYPE_METH ((c)->conmeths, m, args) - -/******** Defining new console types ********/ - -typedef struct console_type_entry console_type_entry; -struct console_type_entry -{ - Lisp_Object symbol; - struct console_methods *meths; -}; - -#define DECLARE_CONSOLE_TYPE(type) \ -extern struct console_methods * type##_console_methods - -#define DEFINE_CONSOLE_TYPE(type) \ -struct console_methods * type##_console_methods - -#define INITIALIZE_CONSOLE_TYPE(type, obj_name, pred_sym) do { \ - type##_console_methods = xnew_and_zero (struct console_methods); \ - type##_console_methods->name = obj_name; \ - type##_console_methods->symbol = Q##type; \ - defsymbol (&type##_console_methods->predicate_symbol, pred_sym); \ - add_entry_to_console_type_list (Q##type, type##_console_methods); \ - type##_console_methods->image_conversion_list = Qnil; \ - staticpro (&type##_console_methods->image_conversion_list); \ -} while (0) - -/* Declare that console-type TYPE has method M; used in - initialization routines */ -#define CONSOLE_HAS_METHOD(type, m) \ - (type##_console_methods->m##_method = type##_##m) - -struct console -{ - struct lcrecord_header header; - - /* Description of this console's methods. */ - struct console_methods *conmeths; - - /* A structure of auxiliary data specific to the console type. - struct x_console is used for X window frames; defined in console-x.h - struct tty_console is used to TTY's; defined in console-tty.h */ - void *console_data; - - /* Character that causes a quit. Normally C-g. - #### Should be possible for this not to be ASCII. */ - int quit_char; - - /* ----- begin partially-completed console localization of - event loop ---- */ - - int local_var_flags; - -#define MARKED_SLOT(x) Lisp_Object x -#include "conslots.h" -#undef MARKED_SLOT - - /* Where to store the next keystroke of the macro. - Index into con->kbd_macro_builder. */ - int kbd_macro_ptr; - - /* The finalized section of the macro starts at kbd_macro_buffer and - ends before this. This is not the same as kbd_macro_pointer, because - we advance this to kbd_macro_pointer when a key's command is complete. - This way, the keystrokes for "end-kbd-macro" are not included in the - macro. */ - int kbd_macro_end; - - /* ----- end partially-completed console localization of event loop ---- */ - - unsigned int input_enabled :1; -}; - -DECLARE_LRECORD (console, struct console); -#define XCONSOLE(x) XRECORD (x, console, struct console) -#define XSETCONSOLE(x, p) XSETRECORD (x, p, console) -#define CONSOLEP(x) RECORDP (x, console) -#define GC_CONSOLEP(x) GC_RECORDP (x, console) -#define CHECK_CONSOLE(x) CHECK_RECORD (x, console) -#define CONCHECK_CONSOLE(x) CONCHECK_RECORD (x, console) - -#define CHECK_LIVE_CONSOLE(x) do { \ - CHECK_CONSOLE (x); \ - if (! CONSOLE_LIVE_P (XCONSOLE (x))) \ - dead_wrong_type_argument (Qconsole_live_p, (x)); \ -} while (0) -#define CONCHECK_LIVE_CONSOLE(x) do { \ - CONCHECK_CONSOLE (x); \ - if (! CONSOLE_LIVE_P (XCONSOLE (x))) \ - x = wrong_type_argument (Qconsole_live_p, (x)); \ -} while (0) - -#define CONSOLE_TYPE_P(con, type) EQ (CONSOLE_TYPE (con), Q##type) - -#ifdef ERROR_CHECK_TYPECHECK -INLINE struct console * -error_check_console_type (struct console *con, Lisp_Object sym); -INLINE struct console * -error_check_console_type (struct console *con, Lisp_Object sym) -{ - assert (EQ (CONSOLE_TYPE (con), sym)); - return con; -} -# define CONSOLE_TYPE_DATA(con, type) \ - (*(struct type##_console **) \ - &(error_check_console_type (con, Q##type))->console_data) -#else -# define CONSOLE_TYPE_DATA(con, type) \ - (*(struct type##_console **) &((con)->console_data)) -#endif - -#define CHECK_CONSOLE_TYPE(x, type) do { \ - CHECK_CONSOLE (x); \ - if (! CONSOLE_TYPE_P (XCONSOLE (x), type)) \ - dead_wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ -} while (0) -#define CONCHECK_CONSOLE_TYPE(x, type) do { \ - CONCHECK_CONSOLE (x); \ - if (!(CONSOLEP (x) && \ - CONSOLE_TYPE_P (XCONSOLE (x), type))) \ - x = wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ -} while (0) - -/* #### These should be in the console-*.h files but there are - too many places where the abstraction is broken. Need to - fix. */ - -#ifdef HAVE_X_WINDOWS -#define CONSOLE_TYPESYM_X_P(typesym) EQ (typesym, Qx) -#else -#define CONSOLE_TYPESYM_X_P(typesym) 0 -#endif -#ifdef HAVE_TTY -#define CONSOLE_TYPESYM_TTY_P(typesym) EQ (typesym, Qtty) -#else -#define CONSOLE_TYPESYM_TTY_P(typesym) 0 -#endif -#ifdef HAVE_MS_WINDOWS -#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) EQ (typesym, Qmswindows) -#else -#define CONSOLE_TYPESYM_MSWINDOWS_P(typesym) 0 -#endif -#define CONSOLE_TYPESYM_STREAM_P(typesym) EQ (typesym, Qstream) - -#define CONSOLE_TYPESYM_WIN_P(typesym) \ - (CONSOLE_TYPESYM_X_P (typesym) || CONSOLE_TYPESYM_MSWINDOWS_P (typesym)) - -#define CONSOLE_X_P(con) CONSOLE_TYPESYM_X_P (CONSOLE_TYPE (con)) -#define CHECK_X_CONSOLE(z) CHECK_CONSOLE_TYPE (z, x) -#define CONCHECK_X_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, x) - -#define CONSOLE_TTY_P(con) CONSOLE_TYPESYM_TTY_P (CONSOLE_TYPE (con)) -#define CHECK_TTY_CONSOLE(z) CHECK_CONSOLE_TYPE (z, tty) -#define CONCHECK_TTY_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, tty) - -#define CONSOLE_MSWINDOWS_P(con) CONSOLE_TYPESYM_MSWINDOWS_P (CONSOLE_TYPE (con)) -#define CHECK_MSWINDOWS_CONSOLE(z) CHECK_CONSOLE_TYPE (z, mswindows) -#define CONCHECK_MSWINDOWS_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, mswindows) - -#define CONSOLE_STREAM_P(con) CONSOLE_TYPESYM_STREAM_P (CONSOLE_TYPE (con)) -#define CHECK_STREAM_CONSOLE(z) CHECK_CONSOLE_TYPE (z, stream) -#define CONCHECK_STREAM_CONSOLE(z) CONCHECK_CONSOLE_TYPE (z, stream) - -#define CONSOLE_WIN_P(con) CONSOLE_TYPESYM_WIN_P (CONSOLE_TYPE (con)) - -EXFUN (Fconsole_disable_input, 1); -EXFUN (Fdelete_console, 2); -EXFUN (Fselect_console, 1); -EXFUN (Fselected_console, 0); - -extern Lisp_Object Qcreate_console_hook, Qdelete_console_hook; -extern Lisp_Object Vconsole_defaults, Vconsole_type_list, Vselected_console; - -/* This structure marks which slots in a console have corresponding - default values in console_defaults. - Each such slot has a nonzero value in this structure. - The value has only one nonzero bit. - - When a console has its own local value for a slot, - the bit for that slot (found in the same slot in this structure) - is turned on in the console's local_var_flags slot. - - If a slot in this structure is zero, then even though there may - be a DEFVAR_CONSOLE_LOCAL for the slot, there is no default value for it; - and the corresponding slot in console_defaults is not used. */ - -extern struct console console_local_flags; - -int valid_console_type_p (Lisp_Object type); - -#define CONSOLE_LIVE_P(con) (!EQ (CONSOLE_TYPE (con), Qdead)) - -#define CONSOLE_NAME(con) ((con)->name) -#define CONSOLE_CONNECTION(con) ((con)->connection) -#define CONSOLE_CANON_CONNECTION(con) ((con)->canon_connection) -#define CONSOLE_FUNCTION_KEY_MAP(con) ((con)->function_key_map) -#define CONSOLE_DEVICE_LIST(con) ((con)->device_list) -#define CONSOLE_SELECTED_DEVICE(con) ((con)->selected_device) -#define CONSOLE_SELECTED_FRAME(con) \ - DEVICE_SELECTED_FRAME (XDEVICE ((con)->selected_device)) -#define CONSOLE_LAST_NONMINIBUF_FRAME(con) NON_LVALUE ((con)->last_nonminibuf_frame) -#define CONSOLE_QUIT_CHAR(con) ((con)->quit_char) - -#define CDFW_CONSOLE(obj) \ - (WINDOWP (obj) ? WINDOW_CONSOLE (XWINDOW (obj)) \ - : (FRAMEP (obj) ? FRAME_CONSOLE (XFRAME (obj)) \ - : (DEVICEP (obj) ? DEVICE_CONSOLE (XDEVICE (obj)) \ - : (CONSOLEP (obj) ? obj \ - : Qnil)))) - -#define CONSOLE_LOOP(concons) LIST_LOOP (concons, Vconsole_list) -#define CONSOLE_DEVICE_LOOP(devcons, con) \ - LIST_LOOP (devcons, CONSOLE_DEVICE_LIST (con)) - -DECLARE_CONSOLE_TYPE (dead); -extern console_type_entry_dynarr *the_console_type_entry_dynarr; - -Lisp_Object create_console (Lisp_Object name, Lisp_Object type, - Lisp_Object connection, Lisp_Object props); -void select_console_1 (Lisp_Object); -struct console *decode_console (Lisp_Object); -Lisp_Object make_console (struct console *c); -void add_entry_to_console_type_list (Lisp_Object symbol, - struct console_methods *type); -struct console_methods *decode_console_type (Lisp_Object type, - Error_behavior errb); -void delete_console_internal (struct console *con, int force, - int from_kill_emacs, int from_io_error); -void io_error_delete_console (Lisp_Object console); -void set_console_last_nonminibuf_frame (struct console *con, - Lisp_Object frame); - -#endif /* _XEMACS_CONSOLE_H_ */ diff --git a/src/data.c b/src/data.c deleted file mode 100644 index 4e4a274..0000000 --- a/src/data.c +++ /dev/null @@ -1,2246 +0,0 @@ -/* Primitive operations on Lisp data types for XEmacs Lisp interpreter. - Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995 - 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: Mule 2.0, FSF 19.30. Some of FSF's data.c is in - XEmacs' symbols.c. */ - -/* This file has been Mule-ized. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "bytecode.h" -#include "syssignal.h" - -#ifdef LISP_FLOAT_TYPE -/* Need to define a differentiating symbol -- see sysfloat.h */ -# define THIS_FILENAME data_c -# include "sysfloat.h" -#endif /* LISP_FLOAT_TYPE */ - -Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; -Lisp_Object Qerror_conditions, Qerror_message; -Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; -Lisp_Object Qvoid_variable, Qcyclic_variable_indirection; -Lisp_Object Qvoid_function, Qcyclic_function_indirection; -Lisp_Object Qsetting_constant, Qinvalid_read_syntax; -Lisp_Object Qmalformed_list, Qmalformed_property_list; -Lisp_Object Qcircular_list, Qcircular_property_list; -Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; -Lisp_Object Qio_error, Qend_of_file; -Lisp_Object Qarith_error, Qrange_error, Qdomain_error; -Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error; -Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; -Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp; -Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp; -Lisp_Object Qconsp, Qsubrp; -Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp; -Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp; -Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p; -Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p; -Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore; - -#ifdef LISP_FLOAT_TYPE -Lisp_Object Qfloatp; -#endif - -#ifdef DEBUG_XEMACS - -int debug_issue_ebola_notices; - -int debug_ebola_backtrace_length; - -#if 0 -/*#ifndef LRECORD_SYMBOL*/ -#include "backtrace.h" -#endif - -int -eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2) -{ - if (debug_issue_ebola_notices != -42 /* abracadabra */ && - (((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))) - && (debug_issue_ebola_notices >= 2 - || XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2)))) - { - write_c_string ("Comparison between integer and character is constant nil (", - Qexternal_debugging_output); - Fprinc (obj1, Qexternal_debugging_output); - write_c_string (" and ", Qexternal_debugging_output); - Fprinc (obj2, Qexternal_debugging_output); - write_c_string (")\n", Qexternal_debugging_output); - debug_short_backtrace (debug_ebola_backtrace_length); - } - return EQ (obj1, obj2); -} - -#endif /* DEBUG_XEMACS */ - - - -Lisp_Object -wrong_type_argument (Lisp_Object predicate, Lisp_Object value) -{ - /* This function can GC */ - REGISTER Lisp_Object tem; - do - { - value = Fsignal (Qwrong_type_argument, list2 (predicate, value)); - tem = call1 (predicate, value); - } - while (NILP (tem)); - return value; -} - -DOESNT_RETURN -dead_wrong_type_argument (Lisp_Object predicate, Lisp_Object value) -{ - signal_error (Qwrong_type_argument, list2 (predicate, value)); -} - -DEFUN ("wrong-type-argument", Fwrong_type_argument, 2, 2, 0, /* -Signal an error until the correct type value is given by the user. -This function loops, signalling a continuable `wrong-type-argument' error -with PREDICATE and VALUE as the data associated with the error and then -calling PREDICATE on the returned value, until the value gotten satisfies -PREDICATE. At that point, the gotten value is returned. -*/ - (predicate, value)) -{ - return wrong_type_argument (predicate, value); -} - -DOESNT_RETURN -pure_write_error (Lisp_Object obj) -{ - signal_simple_error ("Attempt to modify read-only object", obj); -} - -DOESNT_RETURN -args_out_of_range (Lisp_Object a1, Lisp_Object a2) -{ - signal_error (Qargs_out_of_range, list2 (a1, a2)); -} - -DOESNT_RETURN -args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) -{ - signal_error (Qargs_out_of_range, list3 (a1, a2, a3)); -} - -void -check_int_range (int val, int min, int max) -{ - if (val < min || val > max) - args_out_of_range_3 (make_int (val), make_int (min), make_int (max)); -} - -/* On some machines, XINT needs a temporary location. - Here it is, in case it is needed. */ - -EMACS_INT sign_extend_temp; - -/* On a few machines, XINT can only be done by calling this. */ -/* XEmacs: only used by m/convex.h */ -int sign_extend_lisp_int (EMACS_INT num); -int -sign_extend_lisp_int (EMACS_INT num) -{ - if (num & (1L << (VALBITS - 1))) - return num | ((-1L) << VALBITS); - else - return num & ((1L << VALBITS) - 1); -} - - -/* Data type predicates */ - -DEFUN ("eq", Feq, 2, 2, 0, /* -Return t if the two args are the same Lisp object. -*/ - (obj1, obj2)) -{ - return EQ_WITH_EBOLA_NOTICE (obj1, obj2) ? Qt : Qnil; -} - -DEFUN ("old-eq", Fold_eq, 2, 2, 0, /* -Return t if the two args are (in most cases) the same Lisp object. - -Special kludge: A character is considered `old-eq' to its equivalent integer -even though they are not the same object and are in fact of different -types. This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to -preserve byte-code compatibility with v19. This kludge is known as the -\"char-int confoundance disease\" and appears in a number of other -functions with `old-foo' equivalents. - -Do not use this function! -*/ - (obj1, obj2)) -{ - /* #### blasphemy */ - return HACKEQ_UNSAFE (obj1, obj2) ? Qt : Qnil; -} - -DEFUN ("null", Fnull, 1, 1, 0, /* -Return t if OBJECT is nil. -*/ - (object)) -{ - return NILP (object) ? Qt : Qnil; -} - -DEFUN ("consp", Fconsp, 1, 1, 0, /* -Return t if OBJECT is a cons cell. `nil' is not a cons cell. -*/ - (object)) -{ - return CONSP (object) ? Qt : Qnil; -} - -DEFUN ("atom", Fatom, 1, 1, 0, /* -Return t if OBJECT is not a cons cell. `nil' is not a cons cell. -*/ - (object)) -{ - return CONSP (object) ? Qnil : Qt; -} - -DEFUN ("listp", Flistp, 1, 1, 0, /* -Return t if OBJECT is a list. `nil' is a list. -*/ - (object)) -{ - return LISTP (object) ? Qt : Qnil; -} - -DEFUN ("nlistp", Fnlistp, 1, 1, 0, /* -Return t if OBJECT is not a list. `nil' is a list. -*/ - (object)) -{ - return LISTP (object) ? Qnil : Qt; -} - -DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /* -Return t if OBJECT is a non-dotted, i.e. nil-terminated, list. -*/ - (object)) -{ - return TRUE_LIST_P (object) ? Qt : Qnil; -} - -DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /* -Return t if OBJECT is a symbol. -*/ - (object)) -{ - return SYMBOLP (object) ? Qt : Qnil; -} - -DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /* -Return t if OBJECT is a keyword. -*/ - (object)) -{ - return KEYWORDP (object) ? Qt : Qnil; -} - -DEFUN ("vectorp", Fvectorp, 1, 1, 0, /* -Return t if OBJECT is a vector. -*/ - (object)) -{ - return VECTORP (object) ? Qt : Qnil; -} - -DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /* -Return t if OBJECT is a bit vector. -*/ - (object)) -{ - return BIT_VECTORP (object) ? Qt : Qnil; -} - -DEFUN ("stringp", Fstringp, 1, 1, 0, /* -Return t if OBJECT is a string. -*/ - (object)) -{ - return STRINGP (object) ? Qt : Qnil; -} - -DEFUN ("arrayp", Farrayp, 1, 1, 0, /* -Return t if OBJECT is an array (string, vector, or bit vector). -*/ - (object)) -{ - return (VECTORP (object) || - STRINGP (object) || - BIT_VECTORP (object)) - ? Qt : Qnil; -} - -DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* -Return t if OBJECT is a sequence (list or array). -*/ - (object)) -{ - return (LISTP (object) || - VECTORP (object) || - STRINGP (object) || - BIT_VECTORP (object)) - ? Qt : Qnil; -} - -DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* -Return t if OBJECT is a marker (editor pointer). -*/ - (object)) -{ - return MARKERP (object) ? Qt : Qnil; -} - -DEFUN ("subrp", Fsubrp, 1, 1, 0, /* -Return t if OBJECT is a built-in function. -*/ - (object)) -{ - return SUBRP (object) ? Qt : Qnil; -} - -DEFUN ("subr-min-args", Fsubr_min_args, 1, 1, 0, /* -Return minimum number of args built-in function SUBR may be called with. -*/ - (subr)) -{ - CHECK_SUBR (subr); - return make_int (XSUBR (subr)->min_args); -} - -DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* -Return maximum number of args built-in function SUBR may be called with, -or nil if it takes an arbitrary number of arguments or is a special form. -*/ - (subr)) -{ - int nargs; - CHECK_SUBR (subr); - nargs = XSUBR (subr)->max_args; - if (nargs == MANY || nargs == UNEVALLED) - return Qnil; - else - return make_int (nargs); -} - -DEFUN ("subr-interactive", Fsubr_interactive, 1, 1, 0, /* -Return the interactive spec of the subr object, or nil. -If non-nil, the return value will be a list whose first element is -`interactive' and whose second element is the interactive spec. -*/ - (subr)) -{ - CONST char *prompt; - CHECK_SUBR (subr); - prompt = XSUBR (subr)->prompt; - return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil; -} - - -DEFUN ("characterp", Fcharacterp, 1, 1, 0, /* -Return t if OBJECT is a character. -Unlike in XEmacs v19 and FSF Emacs, a character is its own primitive type. -Any character can be converted into an equivalent integer using -`char-int'. To convert the other way, use `int-char'; however, -only some integers can be converted into characters. Such an integer -is called a `char-int'; see `char-int-p'. - -Some functions that work on integers (e.g. the comparison functions -<, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.) -accept characters and implicitly convert them into integers. In -general, functions that work on characters also accept char-ints and -implicitly convert them into characters. WARNING: Neither of these -behaviors is very desirable, and they are maintained for backward -compatibility with old E-Lisp programs that confounded characters and -integers willy-nilly. These behaviors may change in the future; therefore, -do not rely on them. Instead, use the character-specific functions such -as `char='. -*/ - (object)) -{ - return CHARP (object) ? Qt : Qnil; -} - -DEFUN ("char-to-int", Fchar_to_int, 1, 1, 0, /* -Convert a character into an equivalent integer. -The resulting integer will always be non-negative. The integers in -the range 0 - 255 map to characters as follows: - -0 - 31 Control set 0 -32 - 127 ASCII -128 - 159 Control set 1 -160 - 255 Right half of ISO-8859-1 - -If support for Mule does not exist, these are the only valid character -values. When Mule support exists, the values assigned to other characters -may vary depending on the particular version of XEmacs, the order in which -character sets were loaded, etc., and you should not depend on them. -*/ - (ch)) -{ - CHECK_CHAR (ch); - return make_int (XCHAR (ch)); -} - -DEFUN ("int-to-char", Fint_to_char, 1, 1, 0, /* -Convert an integer into the equivalent character. -Not all integers correspond to valid characters; use `char-int-p' to -determine whether this is the case. If the integer cannot be converted, -nil is returned. -*/ - (integer)) -{ - CHECK_INT (integer); - if (CHAR_INTP (integer)) - return make_char (XINT (integer)); - else - return Qnil; -} - -DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /* -Return t if OBJECT is an integer that can be converted into a character. -See `char-int'. -*/ - (object)) -{ - return CHAR_INTP (object) ? Qt : Qnil; -} - -DEFUN ("char-or-char-int-p", Fchar_or_char_int_p, 1, 1, 0, /* -Return t if OBJECT is a character or an integer that can be converted into one. -*/ - (object)) -{ - return CHAR_OR_CHAR_INTP (object) ? Qt : Qnil; -} - -DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /* -Return t if OBJECT is a character (or a char-int) or a string. -It is semi-hateful that we allow a char-int here, as it goes against -the name of this function, but it makes the most sense considering the -other steps we take to maintain compatibility with the old character/integer -confoundedness in older versions of E-Lisp. -*/ - (object)) -{ - return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; -} - -DEFUN ("integerp", Fintegerp, 1, 1, 0, /* -Return t if OBJECT is an integer. -*/ - (object)) -{ - return INTP (object) ? Qt : Qnil; -} - -DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* -Return t if OBJECT is an integer or a marker (editor pointer). -*/ - (object)) -{ - return INTP (object) || MARKERP (object) ? Qt : Qnil; -} - -DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /* -Return t if OBJECT is an integer or a character. -*/ - (object)) -{ - return INTP (object) || CHARP (object) ? Qt : Qnil; -} - -DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /* -Return t if OBJECT is an integer, character or a marker (editor pointer). -*/ - (object)) -{ - return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; -} - -DEFUN ("natnump", Fnatnump, 1, 1, 0, /* -Return t if OBJECT is a nonnegative integer. -*/ - (object)) -{ - return NATNUMP (object) ? Qt : Qnil; -} - -DEFUN ("bitp", Fbitp, 1, 1, 0, /* -Return t if OBJECT is a bit (0 or 1). -*/ - (object)) -{ - return BITP (object) ? Qt : Qnil; -} - -DEFUN ("numberp", Fnumberp, 1, 1, 0, /* -Return t if OBJECT is a number (floating point or integer). -*/ - (object)) -{ - return INT_OR_FLOATP (object) ? Qt : Qnil; -} - -DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* -Return t if OBJECT is a number or a marker. -*/ - (object)) -{ - return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil; -} - -DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /* -Return t if OBJECT is a number, character or a marker. -*/ - (object)) -{ - return (INT_OR_FLOATP (object) || - CHARP (object) || - MARKERP (object)) - ? Qt : Qnil; -} - -#ifdef LISP_FLOAT_TYPE -DEFUN ("floatp", Ffloatp, 1, 1, 0, /* -Return t if OBJECT is a floating point number. -*/ - (object)) -{ - return FLOATP (object) ? Qt : Qnil; -} -#endif /* LISP_FLOAT_TYPE */ - -DEFUN ("type-of", Ftype_of, 1, 1, 0, /* -Return a symbol representing the type of OBJECT. -*/ - (object)) -{ - switch (XTYPE (object)) - { -#ifndef LRECORD_CONS - case Lisp_Type_Cons: return Qcons; -#endif - -#ifndef LRECORD_SYMBOL - case Lisp_Type_Symbol: return Qsymbol; -#endif - -#ifndef LRECORD_STRING - case Lisp_Type_String: return Qstring; -#endif - -#ifndef LRECORD_VECTOR - case Lisp_Type_Vector: return Qvector; -#endif - - case Lisp_Type_Record: - return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name); - - case Lisp_Type_Char: return Qcharacter; - - default: return Qinteger; - } -} - - -/* Extract and set components of lists */ - -DEFUN ("car", Fcar, 1, 1, 0, /* -Return the car of LIST. If arg is nil, return nil. -Error if arg is not nil and not a cons cell. See also `car-safe'. -*/ - (list)) -{ - while (1) - { - if (CONSP (list)) - return XCAR (list); - else if (NILP (list)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } -} - -DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /* -Return the car of OBJECT if it is a cons cell, or else nil. -*/ - (object)) -{ - return CONSP (object) ? XCAR (object) : Qnil; -} - -DEFUN ("cdr", Fcdr, 1, 1, 0, /* -Return the cdr of LIST. If arg is nil, return nil. -Error if arg is not nil and not a cons cell. See also `cdr-safe'. -*/ - (list)) -{ - while (1) - { - if (CONSP (list)) - return XCDR (list); - else if (NILP (list)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } -} - -DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /* -Return the cdr of OBJECT if it is a cons cell, else nil. -*/ - (object)) -{ - return CONSP (object) ? XCDR (object) : Qnil; -} - -DEFUN ("setcar", Fsetcar, 2, 2, 0, /* -Set the car of CONSCELL to be NEWCAR. Return NEWCAR. -*/ - (conscell, newcar)) -{ - if (!CONSP (conscell)) - conscell = wrong_type_argument (Qconsp, conscell); - - CHECK_IMPURE (conscell); - XCAR (conscell) = newcar; - return newcar; -} - -DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /* -Set the cdr of CONSCELL to be NEWCDR. Return NEWCDR. -*/ - (conscell, newcdr)) -{ - if (!CONSP (conscell)) - conscell = wrong_type_argument (Qconsp, conscell); - - CHECK_IMPURE (conscell); - XCDR (conscell) = newcdr; - return newcdr; -} - -/* Find the function at the end of a chain of symbol function indirections. - - If OBJECT is a symbol, find the end of its function chain and - return the value found there. If OBJECT is not a symbol, just - return it. If there is a cycle in the function chain, signal a - cyclic-function-indirection error. - - This is like Findirect_function, except that it doesn't signal an - error if the chain ends up unbound. */ -Lisp_Object -indirect_function (Lisp_Object object, int errorp) -{ -#define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16 - Lisp_Object tortoise, hare; - int count; - - for (hare = tortoise = object, count = 0; - SYMBOLP (hare); - hare = XSYMBOL (hare)->function, count++) - { - if (count < FUNCTION_INDIRECTION_SUSPICION_LENGTH) continue; - - if (count & 1) - tortoise = XSYMBOL (tortoise)->function; - if (EQ (hare, tortoise)) - return Fsignal (Qcyclic_function_indirection, list1 (object)); - } - - if (errorp && UNBOUNDP (hare)) - signal_void_function_error (object); - - return hare; -} - -DEFUN ("indirect-function", Findirect_function, 1, 1, 0, /* -Return the function at the end of OBJECT's function chain. -If OBJECT is a symbol, follow all function indirections and return -the final function binding. -If OBJECT is not a symbol, just return it. -Signal a void-function error if the final symbol is unbound. -Signal a cyclic-function-indirection error if there is a loop in the -function chain of symbols. -*/ - (object)) -{ - return indirect_function (object, 1); -} - -/* Extract and set vector and string elements */ - -DEFUN ("aref", Faref, 2, 2, 0, /* -Return the element of ARRAY at index INDEX. -ARRAY may be a vector, bit vector, or string. INDEX starts at 0. -*/ - (array, index_)) -{ - int idx; - - retry: - - if (INTP (index_)) idx = XINT (index_); - else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ - else - { - index_ = wrong_type_argument (Qinteger_or_char_p, index_); - goto retry; - } - - if (idx < 0) goto range_error; - - if (VECTORP (array)) - { - if (idx >= XVECTOR_LENGTH (array)) goto range_error; - return XVECTOR_DATA (array)[idx]; - } - else if (BIT_VECTORP (array)) - { - if (idx >= bit_vector_length (XBIT_VECTOR (array))) goto range_error; - return make_int (bit_vector_bit (XBIT_VECTOR (array), idx)); - } - else if (STRINGP (array)) - { - if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error; - return make_char (string_char (XSTRING (array), idx)); - } -#ifdef LOSING_BYTECODE - else if (COMPILED_FUNCTIONP (array)) - { - /* Weird, gross compatibility kludge */ - return Felt (array, index_); - } -#endif - else - { - check_losing_bytecode ("aref", array); - array = wrong_type_argument (Qarrayp, array); - goto retry; - } - - range_error: - args_out_of_range (array, index_); - return Qnil; /* not reached */ -} - -DEFUN ("aset", Faset, 3, 3, 0, /* -Store into the element of ARRAY at index INDEX the value NEWVAL. -ARRAY may be a vector, bit vector, or string. INDEX starts at 0. -*/ - (array, index_, newval)) -{ - int idx; - - retry: - - if (INTP (index_)) idx = XINT (index_); - else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ - else - { - index_ = wrong_type_argument (Qinteger_or_char_p, index_); - goto retry; - } - - if (idx < 0) goto range_error; - - CHECK_IMPURE (array); - - if (VECTORP (array)) - { - if (idx >= XVECTOR_LENGTH (array)) goto range_error; - XVECTOR_DATA (array)[idx] = newval; - } - else if (BIT_VECTORP (array)) - { - if (idx >= bit_vector_length (XBIT_VECTOR (array))) goto range_error; - CHECK_BIT (newval); - set_bit_vector_bit (XBIT_VECTOR (array), idx, !ZEROP (newval)); - } - else if (STRINGP (array)) - { - CHECK_CHAR_COERCE_INT (newval); - if (idx >= XSTRING_CHAR_LENGTH (array)) goto range_error; - set_string_char (XSTRING (array), idx, XCHAR (newval)); - bump_string_modiff (array); - } - else - { - array = wrong_type_argument (Qarrayp, array); - goto retry; - } - - return newval; - - range_error: - args_out_of_range (array, index_); - return Qnil; /* not reached */ -} - - -/**********************************************************************/ -/* Arithmetic functions */ -/**********************************************************************/ -typedef struct -{ - int int_p; - union - { - int ival; - double dval; - } c; -} int_or_double; - -static void -number_char_or_marker_to_int_or_double (Lisp_Object obj, int_or_double *p) -{ - retry: - p->int_p = 1; - if (INTP (obj)) p->c.ival = XINT (obj); - else if (CHARP (obj)) p->c.ival = XCHAR (obj); - else if (MARKERP (obj)) p->c.ival = marker_position (obj); -#ifdef LISP_FLOAT_TYPE - else if (FLOATP (obj)) p->c.dval = XFLOAT_DATA (obj), p->int_p = 0; -#endif - else - { - obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); - goto retry; - } -} - -static double -number_char_or_marker_to_double (Lisp_Object obj) -{ - retry: - if (INTP (obj)) return (double) XINT (obj); - else if (CHARP (obj)) return (double) XCHAR (obj); - else if (MARKERP (obj)) return (double) marker_position (obj); -#ifdef LISP_FLOAT_TYPE - else if (FLOATP (obj)) return XFLOAT_DATA (obj); -#endif - else - { - obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); - goto retry; - } -} - -static int -integer_char_or_marker_to_int (Lisp_Object obj) -{ - retry: - if (INTP (obj)) return XINT (obj); - else if (CHARP (obj)) return XCHAR (obj); - else if (MARKERP (obj)) return marker_position (obj); - else - { - obj = wrong_type_argument (Qinteger_char_or_marker_p, obj); - goto retry; - } -} - -#define ARITHCOMPARE_MANY(op) \ -{ \ - int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \ - Lisp_Object *args_end = args + nargs; \ - \ - number_char_or_marker_to_int_or_double (*args++, p); \ - \ - while (args < args_end) \ - { \ - number_char_or_marker_to_int_or_double (*args++, q); \ - \ - if (!((p->int_p && q->int_p) ? \ - (p->c.ival op q->c.ival) : \ - ((p->int_p ? (double) p->c.ival : p->c.dval) op \ - (q->int_p ? (double) q->c.ival : q->c.dval)))) \ - return Qnil; \ - \ - { /* swap */ int_or_double *r = p; p = q; q = r; } \ - } \ - return Qt; \ -} - -DEFUN ("=", Feqlsign, 1, MANY, 0, /* -Return t if all the arguments are numerically equal. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - ARITHCOMPARE_MANY (==) -} - -DEFUN ("<", Flss, 1, MANY, 0, /* -Return t if the sequence of arguments is monotonically increasing. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - ARITHCOMPARE_MANY (<) -} - -DEFUN (">", Fgtr, 1, MANY, 0, /* -Return t if the sequence of arguments is monotonically decreasing. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - ARITHCOMPARE_MANY (>) -} - -DEFUN ("<=", Fleq, 1, MANY, 0, /* -Return t if the sequence of arguments is monotonically nondecreasing. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - ARITHCOMPARE_MANY (<=) -} - -DEFUN (">=", Fgeq, 1, MANY, 0, /* -Return t if the sequence of arguments is monotonically nonincreasing. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - ARITHCOMPARE_MANY (>=) -} - -DEFUN ("/=", Fneq, 1, MANY, 0, /* -Return t if no two arguments are numerically equal. -The arguments may be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Object *args_end = args + nargs; - Lisp_Object *p, *q; - - /* Unlike all the other comparisons, this is an N*N algorithm. - We could use a hash table for nargs > 50 to make this linear. */ - for (p = args; p < args_end; p++) - { - int_or_double iod1, iod2; - number_char_or_marker_to_int_or_double (*p, &iod1); - - for (q = p + 1; q < args_end; q++) - { - number_char_or_marker_to_int_or_double (*q, &iod2); - - if (!((iod1.int_p && iod2.int_p) ? - (iod1.c.ival != iod2.c.ival) : - ((iod1.int_p ? (double) iod1.c.ival : iod1.c.dval) != - (iod2.int_p ? (double) iod2.c.ival : iod2.c.dval)))) - return Qnil; - } - } - return Qt; -} - -DEFUN ("zerop", Fzerop, 1, 1, 0, /* -Return t if NUMBER is zero. -*/ - (number)) -{ - retry: - if (INTP (number)) - return EQ (number, Qzero) ? Qt : Qnil; -#ifdef LISP_FLOAT_TYPE - else if (FLOATP (number)) - return XFLOAT_DATA (number) == 0.0 ? Qt : Qnil; -#endif /* LISP_FLOAT_TYPE */ - else - { - number = wrong_type_argument (Qnumberp, number); - goto retry; - } -} - -/* Convert between a 32-bit value and a cons of two 16-bit values. - This is used to pass 32-bit integers to and from the user. - Use time_to_lisp() and lisp_to_time() for time values. - - If you're thinking of using this to store a pointer into a Lisp Object - for internal purposes (such as when calling record_unwind_protect()), - try using make_opaque_ptr()/get_opaque_ptr() instead. */ -Lisp_Object -word_to_lisp (unsigned int item) -{ - return Fcons (make_int (item >> 16), make_int (item & 0xffff)); -} - -unsigned int -lisp_to_word (Lisp_Object item) -{ - if (INTP (item)) - return XINT (item); - else - { - Lisp_Object top = Fcar (item); - Lisp_Object bot = Fcdr (item); - CHECK_INT (top); - CHECK_INT (bot); - return (XINT (top) << 16) | (XINT (bot) & 0xffff); - } -} - - -DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /* -Convert NUM to a string by printing it in decimal. -Uses a minus sign if negative. -NUM may be an integer or a floating point number. -*/ - (num)) -{ - char buffer[VALBITS]; - - CHECK_INT_OR_FLOAT (num); - -#ifdef LISP_FLOAT_TYPE - if (FLOATP (num)) - { - char pigbuf[350]; /* see comments in float_to_string */ - - float_to_string (pigbuf, XFLOAT_DATA (num)); - return build_string (pigbuf); - } -#endif /* LISP_FLOAT_TYPE */ - - long_to_string (buffer, XINT (num)); - return build_string (buffer); -} - -static int -digit_to_number (int character, int base) -{ - /* Assumes ASCII */ - int digit = ((character >= '0' && character <= '9') ? character - '0' : - (character >= 'a' && character <= 'z') ? character - 'a' + 10 : - (character >= 'A' && character <= 'Z') ? character - 'A' + 10 : - -1); - - return digit >= base ? -1 : digit; -} - -DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /* -Convert STRING to a number by parsing it as a decimal number. -This parses both integers and floating point numbers. -It ignores leading spaces and tabs. - -If BASE, interpret STRING as a number in that base. If BASE isn't -present, base 10 is used. BASE must be between 2 and 16 (inclusive). -Floating point numbers always use base 10. -*/ - (string, base)) -{ - char *p; - int b; - - CHECK_STRING (string); - - if (NILP (base)) - b = 10; - else - { - CHECK_INT (base); - b = XINT (base); - check_int_range (b, 2, 16); - } - - p = (char *) XSTRING_DATA (string); - - /* Skip any whitespace at the front of the number. Some versions of - atoi do this anyway, so we might as well make Emacs lisp consistent. */ - while (*p == ' ' || *p == '\t') - p++; - -#ifdef LISP_FLOAT_TYPE - if (isfloat_string (p)) - return make_float (atof (p)); -#endif /* LISP_FLOAT_TYPE */ - - if (b == 10) - { - /* Use the system-provided functions for base 10. */ -#if SIZEOF_EMACS_INT == SIZEOF_INT - return make_int (atoi (p)); -#elif SIZEOF_EMACS_INT == SIZEOF_LONG - return make_int (atol (p)); -#elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG - return make_int (atoll (p)); -#endif - } - else - { - int digit, negative = 1; - EMACS_INT v = 0; - - if (*p == '-') - { - negative = -1; - p++; - } - else if (*p == '+') - p++; - while (1) - { - digit = digit_to_number (*p++, b); - if (digit < 0) - break; - v = v * b + digit; - } - return make_int (negative * v); - } -} - - -DEFUN ("+", Fplus, 0, MANY, 0, /* -Return sum of any number of arguments. -The arguments should all be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT iaccum = 0; - Lisp_Object *args_end = args + nargs; - - while (args < args_end) - { - int_or_double iod; - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - iaccum += iod.c.ival; - else - { - double daccum = (double) iaccum + iod.c.dval; - while (args < args_end) - daccum += number_char_or_marker_to_double (*args++); - return make_float (daccum); - } - } - - return make_int (iaccum); -} - -DEFUN ("-", Fminus, 1, MANY, 0, /* -Negate number or subtract numbers, characters or markers. -With one arg, negates it. With more than one arg, -subtracts all but the first from the first. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT iaccum; - double daccum; - Lisp_Object *args_end = args + nargs; - int_or_double iod; - - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - iaccum = nargs > 1 ? iod.c.ival : - iod.c.ival; - else - { - daccum = nargs > 1 ? iod.c.dval : - iod.c.dval; - goto do_float; - } - - while (args < args_end) - { - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - iaccum -= iod.c.ival; - else - { - daccum = (double) iaccum - iod.c.dval; - goto do_float; - } - } - - return make_int (iaccum); - - do_float: - for (; args < args_end; args++) - daccum -= number_char_or_marker_to_double (*args); - return make_float (daccum); -} - -DEFUN ("*", Ftimes, 0, MANY, 0, /* -Return product of any number of arguments. -The arguments should all be numbers, characters or markers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT iaccum = 1; - Lisp_Object *args_end = args + nargs; - - while (args < args_end) - { - int_or_double iod; - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - iaccum *= iod.c.ival; - else - { - double daccum = (double) iaccum * iod.c.dval; - while (args < args_end) - daccum *= number_char_or_marker_to_double (*args++); - return make_float (daccum); - } - } - - return make_int (iaccum); -} - -DEFUN ("/", Fquo, 1, MANY, 0, /* -Return first argument divided by all the remaining arguments. -The arguments must be numbers, characters or markers. -With one argument, reciprocates the argument. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT iaccum; - double daccum; - Lisp_Object *args_end = args + nargs; - int_or_double iod; - - if (nargs == 1) - iaccum = 1; - else - { - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - iaccum = iod.c.ival; - else - { - daccum = iod.c.dval; - goto divide_floats; - } - } - - while (args < args_end) - { - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - { - if (iod.c.ival == 0) goto divide_by_zero; - iaccum /= iod.c.ival; - } - else - { - if (iod.c.dval == 0) goto divide_by_zero; - daccum = (double) iaccum / iod.c.dval; - goto divide_floats; - } - } - - return make_int (iaccum); - - divide_floats: - for (; args < args_end; args++) - { - double dval = number_char_or_marker_to_double (*args); - if (dval == 0) goto divide_by_zero; - daccum /= dval; - } - return make_float (daccum); - - divide_by_zero: - Fsignal (Qarith_error, Qnil); - return Qnil; /* not reached */ -} - -DEFUN ("max", Fmax, 1, MANY, 0, /* -Return largest of all the arguments. -All arguments must be numbers, characters or markers. -The value is always a number; markers and characters are converted -to numbers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT imax; - double dmax; - Lisp_Object *args_end = args + nargs; - int_or_double iod; - - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - imax = iod.c.ival; - else - { - dmax = iod.c.dval; - goto max_floats; - } - - while (args < args_end) - { - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - { - if (imax < iod.c.ival) imax = iod.c.ival; - } - else - { - dmax = (double) imax; - if (dmax < iod.c.dval) dmax = iod.c.dval; - goto max_floats; - } - } - - return make_int (imax); - - max_floats: - while (args < args_end) - { - double dval = number_char_or_marker_to_double (*args++); - if (dmax < dval) dmax = dval; - } - return make_float (dmax); -} - -DEFUN ("min", Fmin, 1, MANY, 0, /* -Return smallest of all the arguments. -All arguments must be numbers, characters or markers. -The value is always a number; markers and characters are converted -to numbers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT imin; - double dmin; - Lisp_Object *args_end = args + nargs; - int_or_double iod; - - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - imin = iod.c.ival; - else - { - dmin = iod.c.dval; - goto min_floats; - } - - while (args < args_end) - { - number_char_or_marker_to_int_or_double (*args++, &iod); - if (iod.int_p) - { - if (imin > iod.c.ival) imin = iod.c.ival; - } - else - { - dmin = (double) imin; - if (dmin > iod.c.dval) dmin = iod.c.dval; - goto min_floats; - } - } - - return make_int (imin); - - min_floats: - while (args < args_end) - { - double dval = number_char_or_marker_to_double (*args++); - if (dmin > dval) dmin = dval; - } - return make_float (dmin); -} - -DEFUN ("logand", Flogand, 0, MANY, 0, /* -Return bitwise-and of all the arguments. -Arguments may be integers, or markers or characters converted to integers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT bits = ~0; - Lisp_Object *args_end = args + nargs; - - while (args < args_end) - bits &= integer_char_or_marker_to_int (*args++); - - return make_int (bits); -} - -DEFUN ("logior", Flogior, 0, MANY, 0, /* -Return bitwise-or of all the arguments. -Arguments may be integers, or markers or characters converted to integers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT bits = 0; - Lisp_Object *args_end = args + nargs; - - while (args < args_end) - bits |= integer_char_or_marker_to_int (*args++); - - return make_int (bits); -} - -DEFUN ("logxor", Flogxor, 0, MANY, 0, /* -Return bitwise-exclusive-or of all the arguments. -Arguments may be integers, or markers or characters converted to integers. -*/ - (int nargs, Lisp_Object *args)) -{ - EMACS_INT bits = 0; - Lisp_Object *args_end = args + nargs; - - while (args < args_end) - bits ^= integer_char_or_marker_to_int (*args++); - - return make_int (bits); -} - -DEFUN ("lognot", Flognot, 1, 1, 0, /* -Return the bitwise complement of NUMBER. -NUMBER may be an integer, marker or character converted to integer. -*/ - (number)) -{ - return make_int (~ integer_char_or_marker_to_int (number)); -} - -DEFUN ("%", Frem, 2, 2, 0, /* -Return remainder of first arg divided by second. -Both must be integers, characters or markers. -*/ - (num1, num2)) -{ - int ival1 = integer_char_or_marker_to_int (num1); - int ival2 = integer_char_or_marker_to_int (num2); - - if (ival2 == 0) - Fsignal (Qarith_error, Qnil); - - return make_int (ival1 % ival2); -} - -/* Note, ANSI *requires* the presence of the fmod() library routine. - If your system doesn't have it, complain to your vendor, because - that is a bug. */ - -#ifndef HAVE_FMOD -double -fmod (double f1, double f2) -{ - if (f2 < 0.0) - f2 = -f2; - return f1 - f2 * floor (f1/f2); -} -#endif /* ! HAVE_FMOD */ - - -DEFUN ("mod", Fmod, 2, 2, 0, /* -Return X modulo Y. -The result falls between zero (inclusive) and Y (exclusive). -Both X and Y must be numbers, characters or markers. -If either argument is a float, a float will be returned. -*/ - (x, y)) -{ - int_or_double iod1, iod2; - number_char_or_marker_to_int_or_double (x, &iod1); - number_char_or_marker_to_int_or_double (y, &iod2); - -#ifdef LISP_FLOAT_TYPE - if (!iod1.int_p || !iod2.int_p) - { - double dval1 = iod1.int_p ? (double) iod1.c.ival : iod1.c.dval; - double dval2 = iod2.int_p ? (double) iod2.c.ival : iod2.c.dval; - if (dval2 == 0) goto divide_by_zero; - dval1 = fmod (dval1, dval2); - - /* If the "remainder" comes out with the wrong sign, fix it. */ - if (dval2 < 0 ? dval1 > 0 : dval1 < 0) - dval1 += dval2; - - return make_float (dval1); - } -#endif /* LISP_FLOAT_TYPE */ - { - int ival; - if (iod2.c.ival == 0) goto divide_by_zero; - - ival = iod1.c.ival % iod2.c.ival; - - /* If the "remainder" comes out with the wrong sign, fix it. */ - if (iod2.c.ival < 0 ? ival > 0 : ival < 0) - ival += iod2.c.ival; - - return make_int (ival); - } - - divide_by_zero: - Fsignal (Qarith_error, Qnil); - return Qnil; /* not reached */ -} - -DEFUN ("ash", Fash, 2, 2, 0, /* -Return VALUE with its bits shifted left by COUNT. -If COUNT is negative, shifting is actually to the right. -In this case, the sign bit is duplicated. -*/ - (value, count)) -{ - CHECK_INT_COERCE_CHAR (value); - CONCHECK_INT (count); - - return make_int (XINT (count) > 0 ? - XINT (value) << XINT (count) : - XINT (value) >> -XINT (count)); -} - -DEFUN ("lsh", Flsh, 2, 2, 0, /* -Return VALUE with its bits shifted left by COUNT. -If COUNT is negative, shifting is actually to the right. -In this case, zeros are shifted in on the left. -*/ - (value, count)) -{ - CHECK_INT_COERCE_CHAR (value); - CONCHECK_INT (count); - - return make_int (XINT (count) > 0 ? - XUINT (value) << XINT (count) : - XUINT (value) >> -XINT (count)); -} - -DEFUN ("1+", Fadd1, 1, 1, 0, /* -Return NUMBER plus one. NUMBER may be a number, character or marker. -Markers and characters are converted to integers. -*/ - (number)) -{ - retry: - - if (INTP (number)) return make_int (XINT (number) + 1); - if (CHARP (number)) return make_int (XCHAR (number) + 1); - if (MARKERP (number)) return make_int (marker_position (number) + 1); -#ifdef LISP_FLOAT_TYPE - if (FLOATP (number)) return make_float (XFLOAT_DATA (number) + 1.0); -#endif /* LISP_FLOAT_TYPE */ - - number = wrong_type_argument (Qnumber_char_or_marker_p, number); - goto retry; -} - -DEFUN ("1-", Fsub1, 1, 1, 0, /* -Return NUMBER minus one. NUMBER may be a number, character or marker. -Markers and characters are converted to integers. -*/ - (number)) -{ - retry: - - if (INTP (number)) return make_int (XINT (number) - 1); - if (CHARP (number)) return make_int (XCHAR (number) - 1); - if (MARKERP (number)) return make_int (marker_position (number) - 1); -#ifdef LISP_FLOAT_TYPE - if (FLOATP (number)) return make_float (XFLOAT_DATA (number) - 1.0); -#endif /* LISP_FLOAT_TYPE */ - - number = wrong_type_argument (Qnumber_char_or_marker_p, number); - goto retry; -} - - -/************************************************************************/ -/* weak lists */ -/************************************************************************/ - -/* A weak list is like a normal list except that elements automatically - disappear when no longer in use, i.e. when no longer GC-protected. - The basic idea is that we don't mark the elements during GC, but - wait for them to be marked elsewhere. If they're not marked, we - remove them. This is analogous to weak hash tables; see the explanation - there for more info. */ - -static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */ - -static Lisp_Object encode_weak_list_type (enum weak_list_type type); - -static Lisp_Object -mark_weak_list (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - return Qnil; /* nichts ist gemarkt */ -} - -static void -print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - if (print_readably) - error ("printing unreadable object #"); - - write_c_string ("#type), - printcharfun, 0); - write_c_string (" ", printcharfun); - print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag); - write_c_string (">", printcharfun); -} - -static int -weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct weak_list *w1 = XWEAK_LIST (obj1); - struct weak_list *w2 = XWEAK_LIST (obj2); - - return ((w1->type == w2->type) && - internal_equal (w1->list, w2->list, depth + 1)); -} - -static unsigned long -weak_list_hash (Lisp_Object obj, int depth) -{ - struct weak_list *w = XWEAK_LIST (obj); - - return HASH2 ((unsigned long) w->type, - internal_hash (w->list, depth + 1)); -} - -Lisp_Object -make_weak_list (enum weak_list_type type) -{ - Lisp_Object result; - struct weak_list *wl = - alloc_lcrecord_type (struct weak_list, lrecord_weak_list); - - wl->list = Qnil; - wl->type = type; - XSETWEAK_LIST (result, wl); - wl->next_weak = Vall_weak_lists; - Vall_weak_lists = result; - return result; -} - -DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list, - mark_weak_list, print_weak_list, - 0, weak_list_equal, weak_list_hash, - struct weak_list); -/* - -- we do not mark the list elements (either the elements themselves - or the cons cells that hold them) in the normal marking phase. - -- at the end of marking, we go through all weak lists that are - marked, and mark the cons cells that hold all marked - objects, and possibly parts of the objects themselves. - (See alloc.c, "after-mark".) - -- after that, we prune away all the cons cells that are not marked. - - WARNING WARNING WARNING WARNING WARNING: - - The code in the following two functions is *unbelievably* tricky. - Don't mess with it. You'll be sorry. - - Linked lists just majorly suck, d'ya know? -*/ - -int -finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)) -{ - Lisp_Object rest; - int did_mark = 0; - - for (rest = Vall_weak_lists; - !GC_NILP (rest); - rest = XWEAK_LIST (rest)->next_weak) - { - Lisp_Object rest2; - enum weak_list_type type = XWEAK_LIST (rest)->type; - - if (! obj_marked_p (rest)) - /* The weak list is probably garbage. Ignore it. */ - continue; - - for (rest2 = XWEAK_LIST (rest)->list; - /* We need to be trickier since we're inside of GC; - use CONSP instead of !NILP in case of user-visible - imperfect lists */ - GC_CONSP (rest2); - rest2 = XCDR (rest2)) - { - Lisp_Object elem; - /* If the element is "marked" (meaning depends on the type - of weak list), we need to mark the cons containing the - element, and maybe the element itself (if only some part - was already marked). */ - int need_to_mark_cons = 0; - int need_to_mark_elem = 0; - - /* If a cons is already marked, then its car is already marked - (either because of an external pointer or because of - a previous call to this function), and likewise for all - the rest of the elements in the list, so we can stop now. */ - if (obj_marked_p (rest2)) - break; - - elem = XCAR (rest2); - - switch (type) - { - case WEAK_LIST_SIMPLE: - if (obj_marked_p (elem)) - need_to_mark_cons = 1; - break; - - case WEAK_LIST_ASSOC: - if (!GC_CONSP (elem)) - { - /* just leave bogus elements there */ - need_to_mark_cons = 1; - need_to_mark_elem = 1; - } - else if (obj_marked_p (XCAR (elem)) && - obj_marked_p (XCDR (elem))) - { - need_to_mark_cons = 1; - /* We still need to mark elem, because it's - probably not marked. */ - need_to_mark_elem = 1; - } - break; - - case WEAK_LIST_KEY_ASSOC: - if (!GC_CONSP (elem)) - { - /* just leave bogus elements there */ - need_to_mark_cons = 1; - need_to_mark_elem = 1; - } - else if (obj_marked_p (XCAR (elem))) - { - need_to_mark_cons = 1; - /* We still need to mark elem and XCDR (elem); - marking elem does both */ - need_to_mark_elem = 1; - } - break; - - case WEAK_LIST_VALUE_ASSOC: - if (!GC_CONSP (elem)) - { - /* just leave bogus elements there */ - need_to_mark_cons = 1; - need_to_mark_elem = 1; - } - else if (obj_marked_p (XCDR (elem))) - { - need_to_mark_cons = 1; - /* We still need to mark elem and XCAR (elem); - marking elem does both */ - need_to_mark_elem = 1; - } - break; - - default: - abort (); - } - - if (need_to_mark_elem && ! obj_marked_p (elem)) - { - markobj (elem); - did_mark = 1; - } - - /* We also need to mark the cons that holds the elem or - assoc-pair. We do *not* want to call (markobj) here - because that will mark the entire list; we just want to - mark the cons itself. - */ - if (need_to_mark_cons) - { - struct Lisp_Cons *ptr = XCONS (rest2); - if (!CONS_MARKED_P (ptr)) - { - MARK_CONS (ptr); - did_mark = 1; - } - } - } - - /* In case of imperfect list, need to mark the final cons - because we're not removing it */ - if (!GC_NILP (rest2) && ! obj_marked_p (rest2)) - { - markobj (rest2); - did_mark = 1; - } - } - - return did_mark; -} - -void -prune_weak_lists (int (*obj_marked_p) (Lisp_Object)) -{ - Lisp_Object rest, prev = Qnil; - - for (rest = Vall_weak_lists; - !GC_NILP (rest); - rest = XWEAK_LIST (rest)->next_weak) - { - if (! (obj_marked_p (rest))) - { - /* This weak list itself is garbage. Remove it from the list. */ - if (GC_NILP (prev)) - Vall_weak_lists = XWEAK_LIST (rest)->next_weak; - else - XWEAK_LIST (prev)->next_weak = - XWEAK_LIST (rest)->next_weak; - } - else - { - Lisp_Object rest2, prev2 = Qnil; - Lisp_Object tortoise; - int go_tortoise = 0; - - for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2; - /* We need to be trickier since we're inside of GC; - use CONSP instead of !NILP in case of user-visible - imperfect lists */ - GC_CONSP (rest2);) - { - /* It suffices to check the cons for marking, - regardless of the type of weak list: - - -- if the cons is pointed to somewhere else, - then it should stay around and will be marked. - -- otherwise, if it should stay around, it will - have been marked in finish_marking_weak_lists(). - -- otherwise, it's not marked and should disappear. - */ - if (! obj_marked_p (rest2)) - { - /* bye bye :-( */ - if (GC_NILP (prev2)) - XWEAK_LIST (rest)->list = XCDR (rest2); - else - XCDR (prev2) = XCDR (rest2); - rest2 = XCDR (rest2); - /* Ouch. Circularity checking is even trickier - than I thought. When we cut out a link - like this, we can't advance the turtle or - it'll catch up to us. Imagine that we're - standing on floor tiles and moving forward -- - what we just did here is as if the floor - tile under us just disappeared and all the - ones ahead of us slid one tile towards us. - In other words, we didn't move at all; - if the tortoise was one step behind us - previously, it still is, and therefore - it must not move. */ - } - else - { - prev2 = rest2; - - /* Implementing circularity checking is trickier here - than in other places because we have to guarantee - that we've processed all elements before exiting - due to a circularity. (In most places, an error - is issued upon encountering a circularity, so it - doesn't really matter if all elements are processed.) - The idea is that we process along with the hare - rather than the tortoise. If at any point in - our forward process we encounter the tortoise, - we must have already visited the spot, so we exit. - (If we process with the tortoise, we can fail to - process cases where a cons points to itself, or - where cons A points to cons B, which points to - cons A.) */ - - rest2 = XCDR (rest2); - if (go_tortoise) - tortoise = XCDR (tortoise); - go_tortoise = !go_tortoise; - if (GC_EQ (rest2, tortoise)) - break; - } - } - - prev = rest; - } - } -} - -static enum weak_list_type -decode_weak_list_type (Lisp_Object symbol) -{ - CHECK_SYMBOL (symbol); - if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE; - if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC; - if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */ - if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC; - if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC; - - signal_simple_error ("Invalid weak list type", symbol); - return WEAK_LIST_SIMPLE; /* not reached */ -} - -static Lisp_Object -encode_weak_list_type (enum weak_list_type type) -{ - switch (type) - { - case WEAK_LIST_SIMPLE: return Qsimple; - case WEAK_LIST_ASSOC: return Qassoc; - case WEAK_LIST_KEY_ASSOC: return Qkey_assoc; - case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc; - default: - abort (); - } - - return Qnil; /* not reached */ -} - -DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /* -Return non-nil if OBJECT is a weak list. -*/ - (object)) -{ - return WEAK_LISTP (object) ? Qt : Qnil; -} - -DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /* -Return a new weak list object of type TYPE. -A weak list object is an object that contains a list. This list behaves -like any other list except that its elements do not count towards -garbage collection -- if the only pointer to an object in inside a weak -list (other than pointers in similar objects such as weak hash tables), -the object is garbage collected and automatically removed from the list. -This is used internally, for example, to manage the list holding the -children of an extent -- an extent that is unused but has a parent will -still be reclaimed, and will automatically be removed from its parent's -list of children. - -Optional argument TYPE specifies the type of the weak list, and defaults -to `simple'. Recognized types are - -`simple' Objects in the list disappear if not pointed to. -`assoc' Objects in the list disappear if they are conses - and either the car or the cdr of the cons is not - pointed to. -`key-assoc' Objects in the list disappear if they are conses - and the car is not pointed to. -`value-assoc' Objects in the list disappear if they are conses - and the cdr is not pointed to. -*/ - (type)) -{ - if (NILP (type)) - type = Qsimple; - - return make_weak_list (decode_weak_list_type (type)); -} - -DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /* -Return the type of the given weak-list object. -*/ - (weak)) -{ - CHECK_WEAK_LIST (weak); - return encode_weak_list_type (XWEAK_LIST (weak)->type); -} - -DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /* -Return the list contained in a weak-list object. -*/ - (weak)) -{ - CHECK_WEAK_LIST (weak); - return XWEAK_LIST_LIST (weak); -} - -DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /* -Change the list contained in a weak-list object. -*/ - (weak, new_list)) -{ - CHECK_WEAK_LIST (weak); - XWEAK_LIST_LIST (weak) = new_list; - return new_list; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -static SIGTYPE -arith_error (int signo) -{ - EMACS_REESTABLISH_SIGNAL (signo, arith_error); - EMACS_UNBLOCK_SIGNAL (signo); - signal_error (Qarith_error, Qnil); -} - -void -init_data_very_early (void) -{ - /* Don't do this if just dumping out. - We don't want to call `signal' in this case - so that we don't have trouble with dumping - signal-delivering routines in an inconsistent state. */ -#ifndef CANNOT_DUMP - if (!initialized) - return; -#endif /* CANNOT_DUMP */ - signal (SIGFPE, arith_error); -#ifdef uts - signal (SIGEMT, arith_error); -#endif /* uts */ -} - -void -init_errors_once_early (void) -{ - defsymbol (&Qerror_conditions, "error-conditions"); - defsymbol (&Qerror_message, "error-message"); - - /* We declare the errors here because some other deferrors depend - on some of the errors below. */ - - /* ERROR is used as a signaler for random errors for which nothing - else is right */ - - deferror (&Qerror, "error", "error", Qnil); - deferror (&Qquit, "quit", "Quit", Qnil); - - deferror (&Qwrong_type_argument, "wrong-type-argument", - "Wrong type argument", Qerror); - deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range", - Qerror); - deferror (&Qvoid_function, "void-function", - "Symbol's function definition is void", Qerror); - deferror (&Qcyclic_function_indirection, "cyclic-function-indirection", - "Symbol's chain of function indirections contains a loop", Qerror); - deferror (&Qvoid_variable, "void-variable", - "Symbol's value as variable is void", Qerror); - deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection", - "Symbol's chain of variable indirections contains a loop", Qerror); - deferror (&Qsetting_constant, "setting-constant", - "Attempt to set a constant symbol", Qerror); - deferror (&Qinvalid_read_syntax, "invalid-read-syntax", - "Invalid read syntax", Qerror); - - /* Generated by list traversal macros */ - deferror (&Qmalformed_list, "malformed-list", - "Malformed list", Qerror); - deferror (&Qmalformed_property_list, "malformed-property-list", - "Malformed property list", Qmalformed_list); - deferror (&Qcircular_list, "circular-list", - "Circular list", Qerror); - deferror (&Qcircular_property_list, "circular-property-list", - "Circular property list", Qcircular_list); - - deferror (&Qinvalid_function, "invalid-function", "Invalid function", - Qerror); - deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments", - "Wrong number of arguments", Qerror); - deferror (&Qno_catch, "no-catch", "No catch for tag", - Qerror); - deferror (&Qbeginning_of_buffer, "beginning-of-buffer", - "Beginning of buffer", Qerror); - deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror); - deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only", - Qerror); - - deferror (&Qio_error, "io-error", "IO Error", Qerror); - deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error); - - deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror); - deferror (&Qrange_error, "range-error", "Arithmetic range error", - Qarith_error); - deferror (&Qdomain_error, "domain-error", "Arithmetic domain error", - Qarith_error); - deferror (&Qsingularity_error, "singularity-error", - "Arithmetic singularity error", Qdomain_error); - deferror (&Qoverflow_error, "overflow-error", - "Arithmetic overflow error", Qdomain_error); - deferror (&Qunderflow_error, "underflow-error", - "Arithmetic underflow error", Qdomain_error); -} - -void -syms_of_data (void) -{ - defsymbol (&Qcons, "cons"); - defsymbol (&Qkeyword, "keyword"); - defsymbol (&Qquote, "quote"); - defsymbol (&Qlambda, "lambda"); - defsymbol (&Qignore, "ignore"); - defsymbol (&Qlistp, "listp"); - defsymbol (&Qtrue_list_p, "true-list-p"); - defsymbol (&Qconsp, "consp"); - defsymbol (&Qsubrp, "subrp"); - defsymbol (&Qsymbolp, "symbolp"); - defsymbol (&Qkeywordp, "keywordp"); - defsymbol (&Qintegerp, "integerp"); - defsymbol (&Qcharacterp, "characterp"); - defsymbol (&Qnatnump, "natnump"); - defsymbol (&Qstringp, "stringp"); - defsymbol (&Qarrayp, "arrayp"); - defsymbol (&Qsequencep, "sequencep"); - defsymbol (&Qbufferp, "bufferp"); - defsymbol (&Qbitp, "bitp"); - defsymbol (&Qbit_vectorp, "bit-vector-p"); - defsymbol (&Qvectorp, "vectorp"); - defsymbol (&Qchar_or_string_p, "char-or-string-p"); - defsymbol (&Qmarkerp, "markerp"); - defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p"); - defsymbol (&Qinteger_or_char_p, "integer-or-char-p"); - defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p"); - defsymbol (&Qnumberp, "numberp"); - defsymbol (&Qnumber_or_marker_p, "number-or-marker-p"); - defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p"); - defsymbol (&Qcdr, "cdr"); - defsymbol (&Qweak_listp, "weak-list-p"); - -#ifdef LISP_FLOAT_TYPE - defsymbol (&Qfloatp, "floatp"); -#endif /* LISP_FLOAT_TYPE */ - - DEFSUBR (Fwrong_type_argument); - - DEFSUBR (Feq); - DEFSUBR (Fold_eq); - DEFSUBR (Fnull); - Ffset (intern ("not"), intern ("null")); - DEFSUBR (Flistp); - DEFSUBR (Fnlistp); - DEFSUBR (Ftrue_list_p); - DEFSUBR (Fconsp); - DEFSUBR (Fatom); - DEFSUBR (Fchar_or_string_p); - DEFSUBR (Fcharacterp); - DEFSUBR (Fchar_int_p); - DEFSUBR (Fchar_to_int); - DEFSUBR (Fint_to_char); - DEFSUBR (Fchar_or_char_int_p); - DEFSUBR (Fintegerp); - DEFSUBR (Finteger_or_marker_p); - DEFSUBR (Finteger_or_char_p); - DEFSUBR (Finteger_char_or_marker_p); - DEFSUBR (Fnumberp); - DEFSUBR (Fnumber_or_marker_p); - DEFSUBR (Fnumber_char_or_marker_p); -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Ffloatp); -#endif /* LISP_FLOAT_TYPE */ - DEFSUBR (Fnatnump); - DEFSUBR (Fsymbolp); - DEFSUBR (Fkeywordp); - DEFSUBR (Fstringp); - DEFSUBR (Fvectorp); - DEFSUBR (Fbitp); - DEFSUBR (Fbit_vector_p); - DEFSUBR (Farrayp); - DEFSUBR (Fsequencep); - DEFSUBR (Fmarkerp); - DEFSUBR (Fsubrp); - DEFSUBR (Fsubr_min_args); - DEFSUBR (Fsubr_max_args); - DEFSUBR (Fsubr_interactive); - DEFSUBR (Ftype_of); - DEFSUBR (Fcar); - DEFSUBR (Fcdr); - DEFSUBR (Fcar_safe); - DEFSUBR (Fcdr_safe); - DEFSUBR (Fsetcar); - DEFSUBR (Fsetcdr); - DEFSUBR (Findirect_function); - DEFSUBR (Faref); - DEFSUBR (Faset); - - DEFSUBR (Fnumber_to_string); - DEFSUBR (Fstring_to_number); - DEFSUBR (Feqlsign); - DEFSUBR (Flss); - DEFSUBR (Fgtr); - DEFSUBR (Fleq); - DEFSUBR (Fgeq); - DEFSUBR (Fneq); - DEFSUBR (Fzerop); - DEFSUBR (Fplus); - DEFSUBR (Fminus); - DEFSUBR (Ftimes); - DEFSUBR (Fquo); - DEFSUBR (Frem); - DEFSUBR (Fmod); - DEFSUBR (Fmax); - DEFSUBR (Fmin); - DEFSUBR (Flogand); - DEFSUBR (Flogior); - DEFSUBR (Flogxor); - DEFSUBR (Flsh); - DEFSUBR (Fash); - DEFSUBR (Fadd1); - DEFSUBR (Fsub1); - DEFSUBR (Flognot); - - DEFSUBR (Fweak_list_p); - DEFSUBR (Fmake_weak_list); - DEFSUBR (Fweak_list_type); - DEFSUBR (Fweak_list_list); - DEFSUBR (Fset_weak_list_list); -} - -void -vars_of_data (void) -{ - /* This must not be staticpro'd */ - Vall_weak_lists = Qnil; - -#ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* -If non-zero, note when your code may be suffering from char-int confoundance. -That is to say, if XEmacs encounters a usage of `eq', `memq', `equal', -etc. where an int and a char with the same value are being compared, -it will issue a notice on stderr to this effect, along with a backtrace. -In such situations, the result would be different in XEmacs 19 versus -XEmacs 20, and you probably don't want this. - -Note that in order to see these notices, you have to byte compile your -code under XEmacs 20 -- any code byte-compiled under XEmacs 19 will -have its chars and ints all confounded in the byte code, making it -impossible to accurately determine Ebola infection. -*/ ); - - debug_issue_ebola_notices = 2; /* #### temporary hack */ - - DEFVAR_INT ("debug-ebola-backtrace-length", - &debug_ebola_backtrace_length /* -Length (in stack frames) of short backtrace printed out in Ebola notices. -See `debug-issue-ebola-notices'. -*/ ); - debug_ebola_backtrace_length = 32; - -#endif /* DEBUG_XEMACS */ -} diff --git a/src/database.c b/src/database.c deleted file mode 100644 index 350f9af..0000000 --- a/src/database.c +++ /dev/null @@ -1,806 +0,0 @@ -/* Database access routines - Copyright (C) 1996, William M. Perry - -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 Bill Perry */ -/* Substantially rewritten by Martin Buchholz */ -/* db 2.x support added by Andreas Jaeger */ - -#include -#include "lisp.h" -#include "sysfile.h" -#include "buffer.h" -#include - -#ifndef HAVE_DATABASE -#error HAVE_DATABASE not defined!! -#endif - -#include "database.h" /* Our include file */ - -#ifdef HAVE_BERKELEY_DB -/* Work around Berkeley DB's use of int types which are defined - slightly differently in the not quite yet standard . - See db.h for details of why we're resorting to this... */ -/* glibc 2.1 doesn't have this problem with DB 2.x */ -#if !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) -#ifdef HAVE_INTTYPES_H -#define __BIT_TYPES_DEFINED__ -#include -typedef uint8_t u_int8_t; -typedef uint16_t u_int16_t; -typedef uint32_t u_int32_t; -#ifdef WE_DONT_NEED_QUADS -typedef uint64_t u_int64_t; -#endif /* WE_DONT_NEED_QUADS */ -#endif /* HAVE_INTTYPES_H */ -#endif /* !(defined __GLIBC__ && __GLIBC_MINOR__ >= 1) */ -#include DB_H_PATH /* Berkeley db's header file */ -#ifndef DB_VERSION_MAJOR -# define DB_VERSION_MAJOR 1 -#endif /* DB_VERSION_MAJOR */ -Lisp_Object Qberkeley_db; -Lisp_Object Qhash, Qbtree, Qrecno, Qunknown; -#endif /* HAVE_BERKELEY_DB */ - -#ifdef HAVE_DBM -#include -Lisp_Object Qdbm; -#endif /* HAVE_DBM */ - -#ifdef MULE -/* #### The following should be settable on a per-database level. - But the whole coding-system infrastructure should be rewritten someday. - We really need coding-system aliases. -- martin */ -Lisp_Object Vdatabase_coding_system; -#endif - -Lisp_Object Qdatabasep; - -struct Lisp_Database; -typedef struct Lisp_Database Lisp_Database; - -typedef struct -{ - Lisp_Object (*get_subtype) (Lisp_Database *); - Lisp_Object (*get_type) (Lisp_Database *); - Lisp_Object (*get) (Lisp_Database *, Lisp_Object); - int (*put) (Lisp_Database *, Lisp_Object, Lisp_Object, Lisp_Object); - int (*rem) (Lisp_Database *, Lisp_Object); - void (*map) (Lisp_Database *, Lisp_Object); - void (*close) (Lisp_Database *); - Lisp_Object (*last_error) (Lisp_Database *); -} DB_FUNCS; - -struct Lisp_Database -{ - struct lcrecord_header header; - Lisp_Object fname; - int mode; - int access_; - int dberrno; - int live_p; -#ifdef HAVE_DBM - DBM *dbm_handle; -#endif -#ifdef HAVE_BERKELEY_DB - DB *db_handle; -#endif - DB_FUNCS *funcs; -#ifdef MULE - Lisp_Object coding_system; -#endif -}; - -#define XDATABASE(x) XRECORD (x, database, Lisp_Database) -#define XSETDATABASE(x, p) XSETRECORD (x, p, database) -#define DATABASEP(x) RECORDP (x, database) -#define GC_DATABASEP(x) GC_RECORDP (x, database) -#define CHECK_DATABASE(x) CHECK_RECORD (x, database) -#define CONCHECK_DATABASE(x) CONCHECK_RECORD (x, database) -#define DATABASE_LIVE_P(x) (x->live_p) - -#define CHECK_LIVE_DATABASE(db) do { \ - CHECK_DATABASE (db); \ - if (!DATABASE_LIVE_P (XDATABASE(db))) \ - signal_simple_error ("Attempting to access closed database", db); \ -} while (0) - - -static Lisp_Database * -allocate_database (void) -{ - Lisp_Database *db = alloc_lcrecord_type (Lisp_Database, lrecord_database); - - db->fname = Qnil; - db->live_p = 0; -#ifdef HAVE_BERKELEY_DB - db->db_handle = NULL; -#endif -#ifdef HAVE_DBM - db->dbm_handle = NULL; -#endif - db->access_ = 0; - db->mode = 0; - db->dberrno = 0; -#ifdef MULE - db->coding_system = Fget_coding_system (Qbinary); -#endif - return db; -} - -static Lisp_Object -mark_database (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - Lisp_Database *db = XDATABASE (obj); - - markobj (db->fname); - return Qnil; -} - -static void -print_database (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - char buf[64]; - Lisp_Database *db = XDATABASE (obj); - - if (print_readably) - error ("printing unreadable object #", db->header.uid); - - write_c_string ("#fname, printcharfun, 0); - sprintf (buf, "\" (%s/%s/%s) 0x%x>", - (char *) string_data (XSYMBOL (db->funcs->get_type (db))->name), - (char *) string_data (XSYMBOL (db->funcs->get_subtype (db))->name), - (!DATABASE_LIVE_P (db) ? "closed" : - (db->access_ & O_WRONLY) ? "writeonly" : - (db->access_ & O_RDWR) ? "readwrite" : "readonly"), - db->header.uid); - write_c_string (buf, printcharfun); -} - -static void -finalize_database (void *header, int for_disksave) -{ - Lisp_Database *db = (Lisp_Database *) header; - - if (for_disksave) - { - Lisp_Object obj; - XSETDATABASE (obj, db); - - signal_simple_error - ("Can't dump an emacs containing database objects", obj); - } - db->funcs->close (db); -} - -DEFINE_LRECORD_IMPLEMENTATION ("database", database, - mark_database, print_database, - finalize_database, 0, 0, - Lisp_Database); - -DEFUN ("close-database", Fclose_database, 1, 1, 0, /* -Close database DATABASE. -*/ - (database)) -{ - Lisp_Database *db; - CHECK_LIVE_DATABASE (database); - db = XDATABASE (database); - db->funcs->close (db); - db->live_p = 0; - return Qnil; -} - -DEFUN ("database-type", Fdatabase_type, 1, 1, 0, /* -Return the type of database DATABASE. -*/ - (database)) -{ - CHECK_DATABASE (database); - - return XDATABASE (database)->funcs->get_type (XDATABASE (database)); -} - -DEFUN ("database-subtype", Fdatabase_subtype, 1, 1, 0, /* -Return the subtype of database DATABASE, if any. -*/ - (database)) -{ - CHECK_DATABASE (database); - - return XDATABASE (database)->funcs->get_subtype (XDATABASE (database)); -} - -DEFUN ("database-live-p", Fdatabase_live_p, 1, 1, 0, /* -Return t if OBJ is an active database. -*/ - (obj)) -{ - return DATABASEP (obj) && DATABASE_LIVE_P (XDATABASE (obj)) ? Qt : Qnil; -} - -DEFUN ("database-file-name", Fdatabase_file_name, 1, 1, 0, /* -Return the filename associated with the database DATABASE. -*/ - (database)) -{ - CHECK_DATABASE (database); - - return XDATABASE (database)->fname; -} - -DEFUN ("databasep", Fdatabasep, 1, 1, 0, /* -Return t if OBJ is a database. -*/ - (obj)) -{ - return DATABASEP (obj) ? Qt : Qnil; -} - -#ifdef HAVE_DBM -static void -dbm_map (Lisp_Database *db, Lisp_Object func) -{ - datum keydatum, valdatum; - Lisp_Object key, val; - - for (keydatum = dbm_firstkey (db->dbm_handle); - keydatum.dptr != NULL; - keydatum = dbm_nextkey (db->dbm_handle)) - { - valdatum = dbm_fetch (db->dbm_handle, keydatum); - key = make_string ((unsigned char *) keydatum.dptr, keydatum.dsize); - val = make_string ((unsigned char *) valdatum.dptr, valdatum.dsize); - call2 (func, key, val); - } -} - -static Lisp_Object -dbm_get (Lisp_Database *db, Lisp_Object key) -{ - datum keydatum, valdatum; - - keydatum.dptr = (char *) XSTRING_DATA (key); - keydatum.dsize = XSTRING_LENGTH (key); - valdatum = dbm_fetch (db->dbm_handle, keydatum); - - return (valdatum.dptr - ? make_string ((unsigned char *) valdatum.dptr, valdatum.dsize) - : Qnil); -} - -static int -dbm_put (Lisp_Database *db, - Lisp_Object key, Lisp_Object val, Lisp_Object replace) -{ - datum keydatum, valdatum; - - valdatum.dptr = (char *) XSTRING_DATA (val); - valdatum.dsize = XSTRING_LENGTH (val); - keydatum.dptr = (char *) XSTRING_DATA (key); - keydatum.dsize = XSTRING_LENGTH (key); - - return !dbm_store (db->dbm_handle, keydatum, valdatum, - NILP (replace) ? DBM_INSERT : DBM_REPLACE); -} - -static int -dbm_remove (Lisp_Database *db, Lisp_Object key) -{ - datum keydatum; - - keydatum.dptr = (char *) XSTRING_DATA (key); - keydatum.dsize = XSTRING_LENGTH (key); - - return dbm_delete (db->dbm_handle, keydatum); -} - -static Lisp_Object -dbm_type (Lisp_Database *db) -{ - return Qdbm; -} - -static Lisp_Object -dbm_subtype (Lisp_Database *db) -{ - return Qnil; -} - -static Lisp_Object -dbm_lasterr (Lisp_Database *db) -{ - return lisp_strerror (db->dberrno); -} - -static void -dbm_closeit (Lisp_Database *db) -{ - if (db->dbm_handle) - { - dbm_close (db->dbm_handle); - db->dbm_handle = NULL; - } -} - -static DB_FUNCS ndbm_func_block = -{ - dbm_subtype, - dbm_type, - dbm_get, - dbm_put, - dbm_remove, - dbm_map, - dbm_closeit, - dbm_lasterr -}; -#endif /* HAVE_DBM */ - -#ifdef HAVE_BERKELEY_DB -static Lisp_Object -berkdb_type (Lisp_Database *db) -{ - return Qberkeley_db; -} - -static Lisp_Object -berkdb_subtype (Lisp_Database *db) -{ - if (!db->db_handle) - return Qnil; - - switch (db->db_handle->type) - { - case DB_BTREE: return Qbtree; - case DB_HASH: return Qhash; - case DB_RECNO: return Qrecno; - default: return Qunknown; - } -} - -static Lisp_Object -berkdb_lasterr (Lisp_Database *db) -{ - return lisp_strerror (db->dberrno); -} - -static Lisp_Object -berkdb_get (Lisp_Database *db, Lisp_Object key) -{ - DBT keydatum, valdatum; - int status = 0; - - /* DB Version 2 requires DBT's to be zeroed before use. */ - xzero (keydatum); - xzero (valdatum); - - keydatum.data = XSTRING_DATA (key); - keydatum.size = XSTRING_LENGTH (key); - -#if DB_VERSION_MAJOR == 1 - status = db->db_handle->get (db->db_handle, &keydatum, &valdatum, 0); -#else - status = db->db_handle->get (db->db_handle, NULL, &keydatum, &valdatum, 0); -#endif /* DB_VERSION_MAJOR */ - - if (!status) - /* #### Not mule-ized! will crash! */ - return make_string ((Bufbyte *) valdatum.data, valdatum.size); - -#if DB_VERSION_MAJOR == 1 - db->dberrno = (status == 1) ? -1 : errno; -#else - db->dberrno = (status < 0) ? -1 : errno; -#endif /* DB_VERSION_MAJOR */ - - return Qnil; -} - -static int -berkdb_put (Lisp_Database *db, - Lisp_Object key, - Lisp_Object val, - Lisp_Object replace) -{ - DBT keydatum, valdatum; - int status = 0; - - /* DB Version 2 requires DBT's to be zeroed before use. */ - xzero (keydatum); - xzero (valdatum); - - keydatum.data = XSTRING_DATA (key); - keydatum.size = XSTRING_LENGTH (key); - valdatum.data = XSTRING_DATA (val); - valdatum.size = XSTRING_LENGTH (val); -#if DB_VERSION_MAJOR == 1 - status = db->db_handle->put (db->db_handle, &keydatum, &valdatum, - NILP (replace) ? R_NOOVERWRITE : 0); - db->dberrno = (status == 1) ? -1 : errno; -#else - status = db->db_handle->put (db->db_handle, NULL, &keydatum, &valdatum, - NILP (replace) ? DB_NOOVERWRITE : 0); - db->dberrno = (status < 0) ? -1 : errno; -#endif/* DV_VERSION_MAJOR = 2 */ - - return status; -} - -static int -berkdb_remove (Lisp_Database *db, Lisp_Object key) -{ - DBT keydatum; - int status; - - /* DB Version 2 requires DBT's to be zeroed before use. */ - xzero (keydatum); - - keydatum.data = XSTRING_DATA (key); - keydatum.size = XSTRING_LENGTH (key); - -#if DB_VERSION_MAJOR == 1 - status = db->db_handle->del (db->db_handle, &keydatum, 0); -#else - status = db->db_handle->del (db->db_handle, NULL, &keydatum, 0); -#endif /* DB_VERSION_MAJOR */ - - if (!status) - return 0; - -#if DB_VERSION_MAJOR == 1 - db->dberrno = (status == 1) ? -1 : errno; -#else - db->dberrno = (status < 0) ? -1 : errno; -#endif /* DB_VERSION_MAJOR */ - - return 1; -} - -static void -berkdb_map (Lisp_Database *db, Lisp_Object func) -{ - DBT keydatum, valdatum; - Lisp_Object key, val; - DB *dbp = db->db_handle; - int status; - - xzero (keydatum); - xzero (valdatum); - -#if DB_VERSION_MAJOR == 1 - for (status = dbp->seq (dbp, &keydatum, &valdatum, R_FIRST); - status == 0; - status = dbp->seq (dbp, &keydatum, &valdatum, R_NEXT)) - { - /* ### Needs mule-izing */ - key = make_string ((Bufbyte *) keydatum.data, keydatum.size); - val = make_string ((Bufbyte *) valdatum.data, valdatum.size); - call2 (func, key, val); - } -#else - { - DBC *dbcp; - - status = dbp->cursor (dbp, NULL, &dbcp); - for (status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_FIRST); - status == 0; - status = dbcp->c_get (dbcp, &keydatum, &valdatum, DB_NEXT)) - { - /* ### Needs mule-izing */ - key = make_string ((Bufbyte *) keydatum.data, keydatum.size); - val = make_string ((Bufbyte *) valdatum.data, valdatum.size); - call2 (func, key, val); - } - dbcp->c_close (dbcp); - } -#endif /* DB_VERSION_MAJOR */ -} - -static void -berkdb_close (Lisp_Database *db) -{ - if (db->db_handle) - { -#if DB_VERSION_MAJOR == 1 - db->db_handle->sync (db->db_handle, 0); - db->db_handle->close (db->db_handle); -#else - db->db_handle->sync (db->db_handle, 0); - db->db_handle->close (db->db_handle, 0); -#endif /* DB_VERSION_MAJOR */ - db->db_handle = NULL; - } -} - -static DB_FUNCS berk_func_block = -{ - berkdb_subtype, - berkdb_type, - berkdb_get, - berkdb_put, - berkdb_remove, - berkdb_map, - berkdb_close, - berkdb_lasterr -}; -#endif /* HAVE_BERKELEY_DB */ - -DEFUN ("database-last-error", Fdatabase_last_error, 0, 1, 0, /* -Return the last error associated with DATABASE. -*/ - (database)) -{ - if (NILP (database)) - return lisp_strerror (errno); - - CHECK_DATABASE (database); - - return XDATABASE (database)->funcs->last_error (XDATABASE (database)); -} - -DEFUN ("open-database", Fopen_database, 1, 5, 0, /* -Return a new database object opened on FILE. -Optional arguments TYPE and SUBTYPE specify the database type. -Optional argument ACCESS specifies the access rights, which may be any -combination of 'r' 'w' and '+', for read, write, and creation flags. -Optional argument MODE gives the permissions to use when opening FILE, -and defaults to 0755. -*/ - (file, type, subtype, access_, mode)) -{ - /* This function can GC */ - int modemask; - int accessmask = 0; - Lisp_Database *db = NULL; - char *filename; - struct gcpro gcpro1, gcpro2; - - CHECK_STRING (file); - GCPRO2 (file, access_); - file = Fexpand_file_name (file, Qnil); - UNGCPRO; - - GET_C_CHARPTR_EXT_FILENAME_DATA_ALLOCA (XSTRING_DATA (file), filename); - - if (NILP (access_)) - { - accessmask = O_RDWR | O_CREAT; - } - else - { - char *acc; - CHECK_STRING (access_); - acc = (char *) XSTRING_DATA (access_); - - if (strchr (acc, '+')) - accessmask |= O_CREAT; - - { - char *rp = strchr (acc, 'r'); - char *wp = strchr (acc, 'w'); - if (rp && wp) accessmask |= O_RDWR; - else if (wp) accessmask |= O_WRONLY; - else accessmask |= O_RDONLY; - } - } - - if (NILP (mode)) - { - modemask = 0755; /* rwxr-xr-x */ - } - else - { - CHECK_INT (mode); - modemask = XINT (mode); - } - -#ifdef HAVE_DBM - if (NILP (type) || EQ (type, Qdbm)) - { - DBM *dbase = dbm_open (filename, accessmask, modemask); - if (!dbase) - return Qnil; - - db = allocate_database (); - db->dbm_handle = dbase; - db->funcs = &ndbm_func_block; - goto db_done; - } -#endif /* HAVE_DBM */ - -#ifdef HAVE_BERKELEY_DB - if (NILP (type) || EQ (type, Qberkeley_db)) - { - DBTYPE real_subtype; - DB *dbase; -#if DB_VERSION_MAJOR != 1 - int status; -#endif - - if (EQ (subtype, Qhash) || NILP (subtype)) - real_subtype = DB_HASH; - else if (EQ (subtype, Qbtree)) - real_subtype = DB_BTREE; - else if (EQ (subtype, Qrecno)) - real_subtype = DB_RECNO; - else - signal_simple_error ("Unsupported subtype", subtype); - -#if DB_VERSION_MAJOR == 1 - dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL); - if (!dbase) - return Qnil; -#else - /* Berkeley DB Version 2 has only the accessmask DB_CREATE and DB_RDONLY, - other flags shouldn't be set */ - if (NILP (access_)) - accessmask = DB_CREATE; - else - { - char *acc; - CHECK_STRING (access_); - acc = (char *) XSTRING_DATA (access_); - accessmask = 0; - - if (strchr (acc, '+')) - accessmask |= DB_CREATE; - - if (strchr (acc, 'r') && !strchr (acc, 'w')) - accessmask |= DB_RDONLY; - } - status = db_open (filename, real_subtype, accessmask, - modemask, NULL , NULL, &dbase); - if (status) - return Qnil; -#endif /* DB_VERSION_MAJOR */ - - db = allocate_database (); - db->db_handle = dbase; - db->funcs = &berk_func_block; - goto db_done; - } -#endif /* HAVE_BERKELEY_DB */ - - signal_simple_error ("Unsupported database type", type); - return Qnil; - - db_done: - db->live_p = 1; - db->fname = file; - db->mode = modemask; - db->access_ = accessmask; - - { - Lisp_Object retval; - XSETDATABASE (retval, db); - return retval; - } -} - -DEFUN ("put-database", Fput_database, 3, 4, 0, /* -Store KEY and VALUE in DATABASE. -If optional fourth arg REPLACE is non-nil, -replace any existing entry in the database. -*/ - (key, value, database, replace)) -{ - CHECK_LIVE_DATABASE (database); - CHECK_STRING (key); - CHECK_STRING (value); - { - Lisp_Database *db = XDATABASE (database); - int status = db->funcs->put (db, key, value, replace); - return status ? Qt : Qnil; - } -} - -DEFUN ("remove-database", Fremove_database, 2, 2, 0, /* -Remove KEY from DATABASE. -*/ - (key, database)) -{ - CHECK_LIVE_DATABASE (database); - CHECK_STRING (key); - { - Lisp_Database *db = XDATABASE (database); - int status = db->funcs->rem (db, key); - return status ? Qt : Qnil; - } -} - -DEFUN ("get-database", Fget_database, 2, 3, 0, /* -Return value for KEY in DATABASE. -If there is no corresponding value, return DEFAULT (defaults to nil). -*/ - (key, database, default_)) -{ - CHECK_LIVE_DATABASE (database); - CHECK_STRING (key); - { - Lisp_Database *db = XDATABASE (database); - Lisp_Object retval = db->funcs->get (db, key); - return NILP (retval) ? default_ : retval; - } -} - -DEFUN ("map-database", Fmapdatabase, 2, 2, 0, /* -Map FUNCTION over entries in DATABASE, calling it with two args, -each key and value in the database. -*/ - (function, database)) -{ - CHECK_LIVE_DATABASE (database); - - XDATABASE (database)->funcs->map (XDATABASE (database), function); - - return Qnil; -} - -void -syms_of_database (void) -{ - defsymbol (&Qdatabasep, "databasep"); -#ifdef HAVE_DBM - defsymbol (&Qdbm, "dbm"); -#endif -#ifdef HAVE_BERKELEY_DB - defsymbol (&Qberkeley_db, "berkeley-db"); - defsymbol (&Qhash, "hash"); - defsymbol (&Qbtree, "btree"); - defsymbol (&Qrecno, "recno"); - defsymbol (&Qunknown, "unknown"); -#endif - - DEFSUBR (Fopen_database); - DEFSUBR (Fdatabasep); - DEFSUBR (Fmapdatabase); - DEFSUBR (Fput_database); - DEFSUBR (Fget_database); - DEFSUBR (Fremove_database); - DEFSUBR (Fdatabase_type); - DEFSUBR (Fdatabase_subtype); - DEFSUBR (Fdatabase_last_error); - DEFSUBR (Fdatabase_live_p); - DEFSUBR (Fdatabase_file_name); - DEFSUBR (Fclose_database); -} - -void -vars_of_database (void) -{ -#ifdef HAVE_DBM - Fprovide (Qdbm); -#endif -#ifdef HAVE_BERKELEY_DB - Fprovide (Qberkeley_db); -#endif - -#if 0 /* #### implement me! */ -#ifdef MULE - DEFVAR_LISP ("database-coding-system", &Vdatabase_coding_system /* -Coding system used to convert data in database files. -*/ ); - Vdatabase_coding_system = Qnil; -#endif -#endif /* 0 */ -} diff --git a/src/database.h b/src/database.h deleted file mode 100644 index d9555ca..0000000 --- a/src/database.h +++ /dev/null @@ -1,29 +0,0 @@ -/* Header file for database functions - Copyright (C) 1995 Sun Microsystems, 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. */ - -/* This file is only necessary to get INLINE handling correct. - See inline.c */ - -#ifndef _XEMACS_DATABASE_H -#define _XEMACS_DATABASE_H - -DECLARE_LRECORD (database, struct Lisp_Database); - -#endif diff --git a/src/debug.c b/src/debug.c deleted file mode 100644 index d3eb58d..0000000 --- a/src/debug.c +++ /dev/null @@ -1,216 +0,0 @@ -/* Debugging aids -- togglable assertions. - Copyright (C) 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. */ - -/* This file has been Mule-ized. */ - -/* Written by Chuck Thompson */ - -#include -#include "lisp.h" -#include "debug.h" -#include "bytecode.h" - -/* - * To add a new debug class: - * 1. Add a symbol definition for it here, if one doesn't exist - * elsewhere. If you add it here, make sure to add a defsymbol - * line for it in syms_of_debug. - * 2. Add an extern definition for the symbol to debug.h. - * 3. Add entries for the class to struct debug_classes in debug.h. - * 4. Add a FROB line for it in xemacs_debug_loop. - */ - -Lisp_Object Qredisplay, Qbuffers, Qfaces; -Lisp_Object Qwindows, Qframes, Qdevices; - -struct debug_classes active_debug_classes; - -enum debug_loop -{ - ADD, - DELETE, - LIST, - ACTIVE, - INIT, - VALIDATE, - TYPE, - SETTYPE -}; - -static Lisp_Object -xemacs_debug_loop (enum debug_loop op, Lisp_Object class, Lisp_Object type) -{ - int flag = (op == ADD) ? 1 : 0; - Lisp_Object retval = Qnil; - -#define FROB(item) \ - if (op == LIST || op == ACTIVE || op == INIT || EQ (class, Q##item)) \ - { \ - if (op == ADD || op == DELETE || op == INIT) \ - active_debug_classes.item = flag; \ - else if (op == LIST \ - || (op == ACTIVE && active_debug_classes.item)) \ - retval = Fcons (Q##item, retval); \ - else if (op == VALIDATE) \ - return Qt; \ - else if (op == SETTYPE) \ - active_debug_classes.types_of_##item = XINT (type); \ - else if (op == TYPE) \ - retval = make_int (active_debug_classes.types_of_##item); \ - if (op == INIT) active_debug_classes.types_of_##item = VALBITS; \ - } - - FROB (redisplay); - FROB (buffers); - FROB (extents); - FROB (faces); - FROB (windows); - FROB (frames); - FROB (devices); - FROB (byte_code); - - return retval; -#undef FROB -} - -DEFUN ("add-debug-class-to-check", Fadd_debug_class_to_check, 1, 1, 0, /* -Add a debug class to the list of active classes. -*/ - (class)) -{ - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) - error ("No such debug class exists"); - else - xemacs_debug_loop (ADD, class, Qnil); - - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); -} - -DEFUN ("delete-debug-class-to-check", Fdelete_debug_class_to_check, 1, 1, 0, /* -Delete a debug class from the list of active classes. -*/ - (class)) -{ - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) - error ("No such debug class exists"); - else - xemacs_debug_loop (DELETE, class, Qnil); - - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); -} - -DEFUN ("debug-classes-being-checked", Fdebug_classes_being_checked, 0, 0, 0, /* -Return a list of active debug classes. -*/ - ()) -{ - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); -} - -DEFUN ("debug-classes-list", Fdebug_classes_list, 0, 0, 0, /* -Return a list of all defined debug classes. -*/ - ()) -{ - return (xemacs_debug_loop (LIST, Qnil, Qnil)); -} - -DEFUN ("set-debug-classes-to-check", Fset_debug_classes_to_check, 1, 1, 0, /* -Set which classes of debug statements should be active. -CLASSES should be a list of debug classes. -*/ - (classes)) -{ - Lisp_Object rest; - - CHECK_LIST (classes); - - /* Make sure all objects in the list are valid. If anyone is not - valid, reject the entire list without doing anything. */ - LIST_LOOP (rest, classes ) - { - if (NILP (xemacs_debug_loop (VALIDATE, XCAR (rest), Qnil))) - error ("Invalid object in class list"); - } - - LIST_LOOP (rest, classes) - Fadd_debug_class_to_check (XCAR (rest)); - - return (xemacs_debug_loop (ACTIVE, Qnil, Qnil)); -} - -DEFUN ("set-debug-class-types-to-check", Fset_debug_class_types_to_check, 2, 2, 0, /* -For the given debug CLASS, set which TYPES are actually interesting. -TYPES should be an integer representing the or'd value of all desired types. -Lists of defined types and their values are located in the source code. -*/ - (class, type)) -{ - CHECK_INT (type); - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) - error ("Invalid debug class"); - - xemacs_debug_loop (SETTYPE, class, type); - - return (xemacs_debug_loop (TYPE, class, Qnil)); -} - -DEFUN ("debug-types-being-checked", Fdebug_types_being_checked, 1, 1, 0, /* -For the given CLASS, return the associated type value. -*/ - (class)) -{ - if (NILP (xemacs_debug_loop (VALIDATE, class, Qnil))) - error ("Invalid debug class"); - - return (xemacs_debug_loop (TYPE, class, Qnil)); -} - -void -syms_of_debug (void) -{ - defsymbol (&Qredisplay, "redisplay"); - defsymbol (&Qbuffers, "buffers"); - defsymbol (&Qfaces, "faces"); - defsymbol (&Qwindows, "windows"); - defsymbol (&Qframes, "frames"); - defsymbol (&Qdevices, "devices"); - /* defsymbol (&Qbyte_code, "byte-code"); in bytecode.c */ - - DEFSUBR (Fadd_debug_class_to_check); - DEFSUBR (Fdelete_debug_class_to_check); - DEFSUBR (Fdebug_classes_being_checked); - DEFSUBR (Fdebug_classes_list); - DEFSUBR (Fset_debug_classes_to_check); - DEFSUBR (Fset_debug_class_types_to_check); - DEFSUBR (Fdebug_types_being_checked); -} - -void -vars_of_debug (void) -{ - /* If you need to have any classes active early on in startup, then - the flags should be set here. - All functions called by this function are "allowed" according - to emacs.c. */ - xemacs_debug_loop (INIT, Qnil, Qnil); -} diff --git a/src/debug.h b/src/debug.h deleted file mode 100644 index 06efdd3..0000000 --- a/src/debug.h +++ /dev/null @@ -1,81 +0,0 @@ -/* Debugging aids -- togglable assertions. - Copyright (C) 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. */ - -/* Written by Chuck Thompson */ - -#ifndef _XEMACS_DEBUG_H_ -#define _XEMACS_DEBUG_H_ - -#define DEBUG_STDERR 1 -#define DEBUG_ABORT 2 - -#ifdef DEBUG_XEMACS - -#include - -struct debug_classes -{ - unsigned int redisplay :1; - unsigned int buffers :1; - unsigned int extents :1; - unsigned int faces :1; - unsigned int windows :1; - unsigned int frames :1; - unsigned int devices :1; - unsigned int byte_code :1; - - unsigned int types_of_redisplay; - unsigned int types_of_buffers; - unsigned int types_of_extents; - unsigned int types_of_faces; - unsigned int types_of_windows; - unsigned int types_of_frames; - unsigned int types_of_devices; - unsigned int types_of_byte_code; -}; - -extern Lisp_Object Qbuffers, Qdevices, Qfaces, Qframes, Qredisplay, Qwindows; - -extern struct debug_classes active_debug_classes; - -#define DASSERT(class, desired_type, action, assertion) do \ -{ \ - if (active_debug_classes.##class \ - && (active_debug_classes.types_of_##class & desired_type)) \ - { \ - if (! (assertion)) \ - { \ - if (action == DEBUG_STDERR) \ - stderr_out ("Assertion failed in %s at line %d\n", \ - __FILE__, __LINE__); \ - else \ - abort (); \ - } \ - } \ -} while (0) -#else /* !DEBUG_XEMACS */ - -#define DASSERT(class, desired_type, action, assertion) ((void) 0) - -#endif /* !DEBUG_XEMACS */ - -#endif /* _XEMACS_DEBUG_H_ */ diff --git a/src/depend b/src/depend deleted file mode 100644 index d26e1c9..0000000 --- a/src/depend +++ /dev/null @@ -1,213 +0,0 @@ -## This file automatically generated by make-src-depend. Do not modify. - -#ifdef USE_UNION_TYPE -LISP_UNION_H=lisp-union.h -#else -LISP_UNION_H=lisp-disunion.h -#endif -LISP_H = lisp.h config.h $(LISP_UNION_H) -#ifdef HAVE_MS_WINDOWS -console-msw.o: $(LISP_H) conslots.h console-msw.h console.h events.h lisp-disunion.h lisp-union.h lrecord.h opaque.h symeval.h symsinit.h systime.h -device-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console-stream.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h -dialog-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -dired-msw.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h nt.h regex.h symeval.h symsinit.h sysdir.h sysfile.h sysproc.h systime.h -event-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h dragdrop.h events-mod.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h menubar-msw.h mule-charset.h objects-msw.h objects.h process.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h systime.h syswait.h toolbar.h -frame-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -glyphs-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h faces.h file-coding.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-msw.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h window.h winslots.h -gui-msw.o: $(LISP_H) conslots.h console-msw.h console.h device.h elhash.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -menubar-msw.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-msw.h console.h device.h elhash.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar-msw.h menubar.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -objects-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h hash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-msw.h objects.h specifier.h symeval.h symsinit.h -redisplay-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h debug.h device.h events.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h systime.h toolbar.h window.h winslots.h -scrollbar-msw.o: $(LISP_H) conslots.h console-msw.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar-msw.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -select-msw.o: $(LISP_H) conslots.h console-msw.h console.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -toolbar-msw.o: $(LISP_H) buffer.h bufslots.h conslots.h console-msw.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs-msw.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-msw.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -#endif -#ifdef HAVE_X_WINDOWS -balloon-x.o: $(LISP_H) balloon_help.h conslots.h console-x.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h xintrinsic.h -console-x.o: $(LISP_H) conslots.h console-x.h console.h lisp-disunion.h lisp-union.h lrecord.h process.h redisplay.h symeval.h symsinit.h xintrinsic.h -device-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h offix-types.h offix.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h systime.h toolbar.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmu.h -dialog-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h -frame-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h EmacsShell.h ExternalShell.h buffer.h bufslots.h conslots.h console-x.h console.h device.h dragdrop.h events-mod.h events.h extents.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h offix-types.h offix.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h xintrinsicp.h xmprimitivep.h xmu.h -glyphs-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h bitmaps.h buffer.h bufslots.h conslots.h console-x.h console.h device.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h imgproc.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h window.h winslots.h xintrinsic.h xmu.h -gui-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h -input-method-xfs.o: $(LISP_H) EmacsFrame.h buffer.h bufslots.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h -input-method-xlib.o: $(LISP_H) EmacsFrame.h buffer.h bufslots.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h -menubar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h events.h frame.h frameslots.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h xintrinsic.h -objects-x.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h specifier.h symeval.h symsinit.h xintrinsic.h -redisplay-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h conslots.h console-x.h console.h debug.h device.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysproc.h systime.h toolbar.h window.h winslots.h xgccache.h xintrinsic.h xintrinsicp.h xmprimitivep.h -scrollbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar-x.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h -toolbar-x.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h buffer.h bufslots.h conslots.h console-x.h console.h device.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h xintrinsicp.h xmprimitivep.h -#endif -#ifdef HAVE_DATABASE -database.o: $(LISP_H) buffer.h bufslots.h database.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfile.h -#endif -#ifdef MULE -mule-canna.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -mule-ccl.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h mule-ccl.h mule-charset.h symeval.h symsinit.h -mule-charset.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h -mule-coding.o: $(LISP_H) buffer.h bufslots.h elhash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h mule-coding.h symeval.h symsinit.h -mule-mcpath.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfile.h -mule-wnnfns.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h window.h winslots.h -mule.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h regex.h symeval.h symsinit.h -#endif -#ifdef EXTERNAL_WIDGET -ExternalClient-Xlib.o: extw-Xlib.h -ExternalClient.o: ExternalClient.h ExternalClientP.h config.h extw-Xlib.h extw-Xt.h xintrinsicp.h -ExternalShell.o: ExternalShell.h ExternalShellP.h config.h extw-Xlib.h extw-Xt.h xintrinsic.h xintrinsicp.h -extw-Xlib.o: config.h extw-Xlib.h -extw-Xt.o: config.h extw-Xlib.h extw-Xt.h -#endif -EmacsFrame.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h EmacsFrameP.h EmacsManager.h buffer.h bufslots.h conslots.h console-x.h console.h device.h faces.h frame.h frameslots.h glyphs-x.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h xintrinsic.h xintrinsicp.h xmprimitivep.h xmu.h -EmacsManager.o: EmacsManager.h EmacsManagerP.h config.h xintrinsicp.h xmmanagerp.h -EmacsShell-sub.o: EmacsShell.h EmacsShellP.h config.h xintrinsic.h xintrinsicp.h -EmacsShell.o: EmacsShell.h ExternalShell.h config.h xintrinsicp.h -abbrev.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h syntax.h window.h winslots.h -alloc.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h chartab.h conslots.h console.h device.h elhash.h events.h extents.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h puresize-adjust.h puresize.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h systime.h toolbar.h window.h winslots.h -alloca.o: config.h -balloon_help.o: balloon_help.h config.h xintrinsic.h -blocktype.o: $(LISP_H) blocktype.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -buffer.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h sysdep.h sysfile.h toolbar.h window.h winslots.h -bytecode.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h syntax.h -callint.o: $(LISP_H) buffer.h bufslots.h bytecode.h commands.h events.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h symeval.h symsinit.h systime.h window.h winslots.h -callproc.o: $(LISP_H) buffer.h bufslots.h commands.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h nt.h process.h redisplay.h scrollbar.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h window.h winslots.h -casefiddle.o: $(LISP_H) buffer.h bufslots.h chartab.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -casetab.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h -chartab.o: $(LISP_H) buffer.h bufslots.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -cm.o: $(LISP_H) conslots.h console-tty.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systty.h toolbar.h -cmdloop.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -cmds.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -console-stream.o: $(LISP_H) conslots.h console-stream.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -console-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h faces.h file-coding.h frame.h frameslots.h glyphs.h gpmevent.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systty.h toolbar.h -console.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -data.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfloat.h syssignal.h -debug.o: $(LISP_H) bytecode.h debug.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -device-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h -device.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h events.h faces.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h toolbar.h window.h winslots.h -dgif_lib.o: gifrlib.h -dialog.o: $(LISP_H) conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -dired.o: $(LISP_H) buffer.h bufslots.h commands.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h opaque.h regex.h symeval.h symsinit.h sysdir.h sysfile.h syspwd.h systime.h -doc.o: $(LISP_H) buffer.h bufslots.h bytecode.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h sysfile.h -doprnt.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h -dragdrop.o: $(LISP_H) dragdrop.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -dynarr.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -ecrt0.o: config.h -editfns.o: $(LISP_H) buffer.h bufslots.h chartab.h commands.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syspwd.h systime.h toolbar.h window.h winslots.h -eldap.o: $(LISP_H) buffer.h bufslots.h eldap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h sysdep.h -elhash.o: $(LISP_H) bytecode.h elhash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -emacs.o: $(LISP_H) backtrace.h buffer.h bufslots.h commands.h conslots.h console.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h paths.h process.h redisplay.h symeval.h symsinit.h sysdep.h sysdll.h sysfile.h syssignal.h systime.h systty.h -emodules.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h emodules.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdll.h toolbar.h window.h winslots.h -eval.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h commands.h conslots.h console.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h symeval.h symsinit.h -event-Xt.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h EmacsFrame.h blocktype.h buffer.h bufslots.h conslots.h console-tty.h console-x.h console.h device.h dragdrop.h elhash.h events-mod.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-x.h objects.h offix-types.h offix.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h toolbar.h xintrinsic.h xintrinsicp.h -event-stream.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h blocktype.h buffer.h bufslots.h commands.h conslots.h console-x.h console.h device.h elhash.h events-mod.h events.h file-coding.h frame.h frameslots.h glyphs.h gui-x.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h lstream.h macros.h mule-charset.h opaque.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h syssignal.h systime.h toolbar.h window.h winslots.h xintrinsic.h -event-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h process.h scrollbar.h specifier.h symeval.h symsinit.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h -event-unixoid.o: $(LISP_H) conslots.h console-stream.h console-tty.h console.h device.h events.h gpmevent.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h -events.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console-x.h console.h device.h events-mod.h events.h extents.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h xintrinsic.h -extents.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h debug.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -faces.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -file-coding.o: $(LISP_H) buffer.h bufslots.h elhash.h file-coding.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-ccl.h mule-charset.h symeval.h symsinit.h -fileio.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h ndir.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h sysproc.h syspwd.h systime.h toolbar.h window.h winslots.h -filelock.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h paths.h symeval.h symsinit.h sysdir.h sysfile.h syspwd.h syssignal.h -filemode.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h -floatfns.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfloat.h syssignal.h -fns.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h events.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h -font-lock.o: $(LISP_H) buffer.h bufslots.h chartab.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -frame-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systime.h systty.h toolbar.h -frame.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -free-hook.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -general.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -getloadavg.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h -gif_io.o: gifrlib.h -glyphs-eimage.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h file-coding.h frame.h frameslots.h gifrlib.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h toolbar.h -glyphs-widget.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -glyphs.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -gmalloc.o: config.h getpagesize.h -gpmevent.o: $(LISP_H) conslots.h console-tty.h console.h device.h events-mod.h events.h gpmevent.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h -gui.o: $(LISP_H) bytecode.h elhash.h gui.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -hash.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -hftctl.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -hpplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -imgproc.o: $(LISP_H) imgproc.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -indent.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h extents.h faces.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -inline.o: $(LISP_H) $(LWLIB_SRCDIR)/lwlib.h buffer.h bufslots.h bytecode.h chartab.h conslots.h console.h database.h device.h eldap.h elhash.h events.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs-x.h glyphs.h gui-x.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects.h opaque.h process.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syntax.h systime.h toolbar.h tooltalk.h window.h winslots.h xintrinsic.h -input-method-motif.o: $(LISP_H) EmacsFrame.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h xintrinsic.h -insdel.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h -intl.o: $(LISP_H) bytecode.h conslots.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -keymap.o: $(LISP_H) buffer.h bufslots.h bytecode.h conslots.h console.h device.h elhash.h events-mod.h events.h frame.h frameslots.h glyphs.h gui.h insdel.h keymap.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -libsst.o: $(LISP_H) libsst.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -line-number.o: $(LISP_H) buffer.h bufslots.h line-number.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -linuxplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h syssignal.h -lread.o: $(LISP_H) buffer.h bufslots.h bytecode.h elhash.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h symeval.h symsinit.h sysfile.h sysfloat.h -lstream.o: $(LISP_H) buffer.h bufslots.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h sysfile.h -macros.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h keymap.h lisp-disunion.h lisp-union.h lrecord.h macros.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -malloc.o: config.h getpagesize.h -marker.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -md5.o: $(LISP_H) buffer.h bufslots.h file-coding.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h symeval.h symsinit.h -menubar.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -minibuf.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-stream.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h window.h winslots.h -nas.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h -nt.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h nt.h ntheap.h symeval.h symsinit.h sysproc.h syssignal.h systime.h -ntheap.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h ntheap.h symeval.h symsinit.h -ntplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysfile.h -ntproc.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h nt.h ntheap.h process.h symeval.h symsinit.h sysproc.h syssignal.h systime.h syswait.h -objects-tty.o: $(LISP_H) conslots.h console-tty.h console.h device.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-tty.h objects.h specifier.h symeval.h symsinit.h syssignal.h systty.h -objects.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -offix.o: offix-cursors.h offix-types.h offix.h xintrinsic.h -opaque.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h opaque.h symeval.h symsinit.h -print.o: $(LISP_H) backtrace.h buffer.h bufslots.h bytecode.h conslots.h console-stream.h console-tty.h console.h device.h extents.h frame.h frameslots.h glyphs.h gui.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h syssignal.h systty.h toolbar.h -process-nt.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h process.h procimpl.h symeval.h symsinit.h sysdep.h -process-unix.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h hash.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h process.h procimpl.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h -process.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h events.h file-coding.h frame.h frameslots.h glyphs.h gui.h hash.h insdel.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h opaque.h process.h procimpl.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysfile.h sysproc.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h -profile.o: $(LISP_H) backtrace.h bytecode.h elhash.h hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h syssignal.h systime.h -pure.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h puresize-adjust.h puresize.h symeval.h symsinit.h -ralloc.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -rangetab.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h rangetab.h symeval.h symsinit.h -realpath.o: config.h -redisplay-output.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -redisplay-tty.o: $(LISP_H) buffer.h bufslots.h conslots.h console-tty.h console.h device.h events.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h lstream.h mule-charset.h objects-tty.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h systty.h toolbar.h window.h winslots.h -redisplay.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console-tty.h console.h debug.h device.h elhash.h extents.h faces.h file-coding.h frame.h frameslots.h glyphs.h gui.h insdel.h line-number.h lisp-disunion.h lisp-union.h lrecord.h menubar.h mule-charset.h objects.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h syssignal.h systty.h toolbar.h window.h winslots.h -regex.o: $(LISP_H) buffer.h bufslots.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h regex.h symeval.h symsinit.h syntax.h -scrollbar.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -search.o: $(LISP_H) buffer.h bufslots.h chartab.h insdel.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h regex.h symeval.h symsinit.h syntax.h -sgiplay.o: $(LISP_H) libst.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -sheap.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h sheap-adjust.h symeval.h symsinit.h -signal.o: $(LISP_H) conslots.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h syssignal.h systime.h toolbar.h -sound.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h symeval.h symsinit.h sysdep.h xintrinsic.h -specifier.o: $(LISP_H) buffer.h bufslots.h chartab.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h opaque.h rangetab.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -strcat.o: config.h -strcmp.o: config.h -strcpy.o: config.h -strftime.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -sunOS-fix.o: config.h -sunplay.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h sysdep.h syssignal.h -sunpro.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -symbols.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -syntax.o: $(LISP_H) buffer.h bufslots.h chartab.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h syntax.h -sysdep.o: $(LISP_H) buffer.h bufslots.h conslots.h console-stream.h console-tty.h console.h device.h events.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h ndir.h ntheap.h process.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h sysdep.h sysdir.h sysfile.h syssignal.h systime.h systty.h syswait.h toolbar.h window.h winslots.h -sysdll.o: config.h sysdll.h -termcap.o: $(LISP_H) conslots.h console.h device.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -terminfo.o: config.h -toolbar.o: $(LISP_H) buffer.h bufslots.h conslots.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -tooltalk.o: $(LISP_H) buffer.h bufslots.h elhash.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h process.h symeval.h symsinit.h tooltalk.h -tparam.o: config.h -undo.o: $(LISP_H) buffer.h bufslots.h extents.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -unexaix.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -unexalpha.o: config.h -unexapollo.o: config.h -unexconvex.o: config.h getpagesize.h -unexcw.o: config.h sysfile.h -unexec.o: $(LISP_H) getpagesize.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -unexelf.o: config.h -unexelfsgi.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h -unexenix.o: config.h -unexfreebsd.o: config.h -unexhp9k3.o: config.h sysdep.h -unexhp9k800.o: config.h -unexmips.o: config.h getpagesize.h -unexnt.o: config.h ntheap.h -unexsunos4.o: config.h -vm-limit.o: $(LISP_H) lisp-disunion.h lisp-union.h lrecord.h mem-limits.h symeval.h symsinit.h -widget.o: $(LISP_H) buffer.h bufslots.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h symeval.h symsinit.h -window.o: $(LISP_H) buffer.h bufslots.h commands.h conslots.h console.h device.h elhash.h faces.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects.h redisplay.h scrollbar.h specifier.h symeval.h symsinit.h toolbar.h window.h winslots.h -xgccache.o: $(LISP_H) hash.h lisp-disunion.h lisp-union.h lrecord.h symeval.h symsinit.h xgccache.h -xmu.o: config.h -xselect.o: $(LISP_H) buffer.h bufslots.h conslots.h console-x.h console.h device.h frame.h frameslots.h glyphs.h gui.h lisp-disunion.h lisp-union.h lrecord.h mule-charset.h objects-x.h objects.h opaque.h scrollbar.h specifier.h symeval.h symsinit.h systime.h toolbar.h xintrinsic.h diff --git a/src/device-msw.c b/src/device-msw.c deleted file mode 100644 index 6c81ef8..0000000 --- a/src/device-msw.c +++ /dev/null @@ -1,332 +0,0 @@ -/* device functions for mswindows. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 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. */ - -/* Authorship: - - Original authors: Jamie Zawinski and the FSF - Rewritten by Ben Wing and Chuck Thompson. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. -*/ - - -#include -#include "lisp.h" - -#include "console-msw.h" -#include "console-stream.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "sysdep.h" - -/* win32 DDE management library globals */ -#ifdef HAVE_DRAGNDROP -DWORD mswindows_dde_mlid; -HSZ mswindows_dde_service; -HSZ mswindows_dde_topic_system; -HSZ mswindows_dde_item_open; -#endif - -/* Control conversion of upper case file names to lower case. - nil means no, t means yes. */ -Lisp_Object Vmswindows_downcase_file_names; - -/* Control whether stat() attempts to determine file type and link count - exactly, at the expense of slower operation. Since true hard links - are supported on NTFS volumes, this is only relevant on NT. */ -Lisp_Object Vmswindows_get_true_file_attributes; - -Lisp_Object Qinit_pre_mswindows_win, Qinit_post_mswindows_win; - - -/************************************************************************/ -/* helpers */ -/************************************************************************/ - -static Lisp_Object -build_syscolor_string (int index) -{ - DWORD clr; - char buf[16]; - - if (index < 0) - return Qnil; - - clr = GetSysColor (index); - sprintf (buf, "#%02X%02X%02X", - GetRValue (clr), - GetGValue (clr), - GetBValue (clr)); - return build_string (buf); -} - -static Lisp_Object -build_syscolor_cons (int index1, int index2) -{ - Lisp_Object color1, color2; - struct gcpro gcpro1; - GCPRO1 (color1); - color1 = build_syscolor_string (index1); - color2 = build_syscolor_string (index2); - RETURN_UNGCPRO (Fcons (color1, color2)); -} - -static Lisp_Object -build_sysmetrics_cons (int index1, int index2) -{ - return Fcons (index1 < 0 ? Qnil : make_int (GetSystemMetrics (index1)), - index2 < 0 ? Qnil : make_int (GetSystemMetrics (index2))); -} - - - -/************************************************************************/ -/* methods */ -/************************************************************************/ - -static void -mswindows_init_device (struct device *d, Lisp_Object props) -{ - WNDCLASSEX wc; - HDC hdc; - - DEVICE_CLASS (d) = Qcolor; - DEVICE_INFD (d) = DEVICE_OUTFD (d) = -1; - init_baud_rate (d); - init_one_device (d); - - d->device_data = xnew_and_zero (struct mswindows_device); - hdc = CreateCompatibleDC (NULL); - assert (hdc!=NULL); - DEVICE_MSWINDOWS_LOGPIXELSX(d) = GetDeviceCaps(hdc, LOGPIXELSX); - DEVICE_MSWINDOWS_LOGPIXELSY(d) = GetDeviceCaps(hdc, LOGPIXELSY); - DEVICE_MSWINDOWS_PLANES(d) = GetDeviceCaps(hdc, PLANES); - /* #### SIZEPALETTE only valid if RC_PALETTE bit set in RASTERCAPS, - what should we return for a non-palette-based device? */ - DEVICE_MSWINDOWS_CELLS(d) = GetDeviceCaps(hdc, SIZEPALETTE); - DEVICE_MSWINDOWS_HORZRES(d) = GetDeviceCaps(hdc, HORZRES); - DEVICE_MSWINDOWS_VERTRES(d) = GetDeviceCaps(hdc, VERTRES); - DEVICE_MSWINDOWS_HORZSIZE(d) = GetDeviceCaps(hdc, HORZSIZE); - DEVICE_MSWINDOWS_VERTSIZE(d) = GetDeviceCaps(hdc, VERTSIZE); - DEVICE_MSWINDOWS_BITSPIXEL(d) = GetDeviceCaps(hdc, BITSPIXEL); - DeleteDC (hdc); - - mswindows_enumerate_fonts (d); - - /* Register the main window class */ - wc.cbSize = sizeof (WNDCLASSEX); - wc.style = CS_OWNDC; /* One DC per window */ - wc.lpfnWndProc = (WNDPROC) mswindows_wnd_proc; - wc.cbClsExtra = 0; - wc.cbWndExtra = MSWINDOWS_WINDOW_EXTRA_BYTES; - wc.hInstance = NULL; /* ? */ - wc.hIcon = LoadIcon (GetModuleHandle(NULL), XEMACS_CLASS); - wc.hCursor = LoadCursor (NULL, IDC_ARROW); - /* Background brush is only used during sizing, when XEmacs cannot - take over */ - wc.hbrBackground = (HBRUSH)(COLOR_APPWORKSPACE + 1); - wc.lpszMenuName = NULL; - - wc.lpszClassName = XEMACS_CLASS; - wc.hIconSm = LoadImage (GetModuleHandle (NULL), XEMACS_CLASS, - IMAGE_ICON, 16, 16, 0); - RegisterClassEx (&wc); -#ifdef HAVE_TOOLBARS - InitCommonControls (); -#endif -} - -static void -mswindows_finish_init_device (struct device *d, Lisp_Object props) -{ - /* Initialize DDE management library and our related globals. We execute a - * dde Open("file") by simulating a drop, so this depends on dnd support. */ -#ifdef HAVE_DRAGNDROP - mswindows_dde_mlid = 0; - DdeInitialize (&mswindows_dde_mlid, (PFNCALLBACK)mswindows_dde_callback, - APPCMD_FILTERINITS|CBF_FAIL_SELFCONNECTIONS|CBF_FAIL_ADVISES| - CBF_FAIL_POKES|CBF_FAIL_REQUESTS|CBF_SKIP_ALLNOTIFICATIONS, 0); - - mswindows_dde_service = DdeCreateStringHandle (mswindows_dde_mlid, XEMACS_CLASS, 0); - mswindows_dde_topic_system = DdeCreateStringHandle (mswindows_dde_mlid, SZDDESYS_TOPIC, 0); - mswindows_dde_item_open = DdeCreateStringHandle (mswindows_dde_mlid, - TEXT(MSWINDOWS_DDE_ITEM_OPEN), 0); - DdeNameService (mswindows_dde_mlid, mswindows_dde_service, 0L, DNS_REGISTER); -#endif -} - -static void -mswindows_delete_device (struct device *d) -{ - struct mswindows_font_enum *fontlist, *next; - - fontlist = DEVICE_MSWINDOWS_FONTLIST (d); - while (fontlist) - { - next = fontlist->next; - free (fontlist); - fontlist = next; - } - -#ifdef HAVE_DRAGNDROP - DdeNameService (mswindows_dde_mlid, 0L, 0L, DNS_REGISTER); - DdeUninitialize (mswindows_dde_mlid); -#endif - - free (d->device_data); -} - -static Lisp_Object -mswindows_device_system_metrics (struct device *d, - enum device_metrics m) -{ - switch (m) - { - case DM_size_device: - return Fcons (make_int (DEVICE_MSWINDOWS_HORZRES(d)), - make_int (DEVICE_MSWINDOWS_VERTRES(d))); - break; - case DM_size_device_mm: - return Fcons (make_int (DEVICE_MSWINDOWS_HORZSIZE(d)), - make_int (DEVICE_MSWINDOWS_VERTSIZE(d))); - break; - case DM_num_bit_planes: - /* this is what X means by bitplanes therefore we ought to be - consistent. num planes is always 1 under mswindows and - therefore useless */ - return make_int (DEVICE_MSWINDOWS_BITSPIXEL(d)); - break; - case DM_num_color_cells: - return make_int (DEVICE_MSWINDOWS_CELLS(d)); - break; - - /*** Colors ***/ -#define FROB(met, index1, index2) \ - case DM_##met: \ - return build_syscolor_cons (index1, index2); - - FROB (color_default, COLOR_WINDOW, COLOR_WINDOWTEXT); - FROB (color_select, COLOR_HIGHLIGHT, COLOR_HIGHLIGHTTEXT); - FROB (color_balloon, COLOR_INFOBK, COLOR_INFOTEXT); - FROB (color_3d_face, COLOR_3DFACE, COLOR_BTNTEXT); - FROB (color_3d_light, COLOR_3DLIGHT, COLOR_3DHILIGHT); - FROB (color_3d_dark, COLOR_3DSHADOW, COLOR_3DDKSHADOW); - FROB (color_menu, COLOR_MENU, COLOR_MENUTEXT); - FROB (color_menu_highlight, COLOR_HIGHLIGHT, COLOR_HIGHLIGHTTEXT); - FROB (color_menu_button, COLOR_MENU, COLOR_MENUTEXT); - FROB (color_menu_disabled, COLOR_MENU, COLOR_GRAYTEXT); - FROB (color_toolbar, COLOR_BTNFACE, COLOR_BTNTEXT); - FROB (color_scrollbar, COLOR_SCROLLBAR, COLOR_CAPTIONTEXT); - FROB (color_desktop, -1, COLOR_DESKTOP); - FROB (color_workspace, -1, COLOR_APPWORKSPACE); -#undef FROB - - /*** Sizes ***/ -#define FROB(met, index1, index2) \ - case DM_##met: \ - return build_sysmetrics_cons (index1, index2); - - FROB (size_cursor, SM_CXCURSOR, SM_CYCURSOR); - FROB (size_scrollbar, SM_CXVSCROLL, SM_CYHSCROLL); - FROB (size_menu, -1, SM_CYMENU); - FROB (size_icon, SM_CXICON, SM_CYICON); - FROB (size_icon_small, SM_CXSMICON, SM_CYSMICON); -#undef FROB - - case DM_size_workspace: - { - RECT rc; - SystemParametersInfo (SPI_GETWORKAREA, 0, &rc, 0); - return Fcons (make_int (rc.right - rc.left), - make_int (rc.bottom - rc.top)); - } - /* - case DM_size_toolbar: - case DM_size_toolbar_button: - case DM_size_toolbar_border: - */ - - /*** Features ***/ -#define FROB(met, index) \ - case DM_##met: \ - return make_int (GetSystemMetrics (index)); - - FROB (mouse_buttons, SM_CMOUSEBUTTONS); - FROB (swap_buttons, SM_SWAPBUTTON); - FROB (show_sounds, SM_SHOWSOUNDS); - FROB (slow_device, SM_SLOWMACHINE); - FROB (security, SM_SECURE); -#undef FROB - - } - - /* Do not know such property */ - return Qunbound; -} - -static unsigned int -mswindows_device_implementation_flags (void) -{ - return XDEVIMPF_PIXEL_GEOMETRY; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_device_mswindows (void) -{ - defsymbol (&Qinit_pre_mswindows_win, "init-pre-mswindows-win"); - defsymbol (&Qinit_post_mswindows_win, "init-post-mswindows-win"); - - DEFVAR_LISP ("mswindows-downcase-file-names", &Vmswindows_downcase_file_names /* -Non-nil means convert all-upper case file names to lower case. -This applies when performing completions and file name expansion.*/ ); - Vmswindows_downcase_file_names = Qnil; - - DEFVAR_LISP ("mswindows-get-true-file-attributes", &Vmswindows_get_true_file_attributes /* - "Non-nil means determine accurate link count in file-attributes. -This option slows down file-attributes noticeably, so is disabled by -default. Note that it is only useful for files on NTFS volumes, -where hard links are supported. -*/ ); - Vmswindows_get_true_file_attributes = Qnil; -} - -void -console_type_create_device_mswindows (void) -{ - CONSOLE_HAS_METHOD (mswindows, init_device); - CONSOLE_HAS_METHOD (mswindows, finish_init_device); -/* CONSOLE_HAS_METHOD (mswindows, mark_device); */ - CONSOLE_HAS_METHOD (mswindows, delete_device); - CONSOLE_HAS_METHOD (mswindows, device_system_metrics); - CONSOLE_HAS_METHOD (mswindows, device_implementation_flags); -} - -void -vars_of_device_mswindows (void) -{ -} diff --git a/src/device-tty.c b/src/device-tty.c deleted file mode 100644 index 754905d..0000000 --- a/src/device-tty.c +++ /dev/null @@ -1,228 +0,0 @@ -/* TTY device functions. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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. */ - -/* Authors: Ben Wing and Chuck Thompson. */ - -#include -#include "lisp.h" - -#include "console-tty.h" -#include "console-stream.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "lstream.h" -#include "redisplay.h" -#include "sysdep.h" - -#include "syssignal.h" /* for SIGWINCH */ - -#ifdef HAVE_GPM -#include -#endif - -#include - -Lisp_Object Qinit_pre_tty_win, Qinit_post_tty_win; - - -static void -allocate_tty_device_struct (struct device *d) -{ - d->device_data = xnew_and_zero (struct tty_device); -} - -static void -tty_init_device (struct device *d, Lisp_Object props) -{ - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - Lisp_Object terminal_type = CONSOLE_TTY_DATA (con)->terminal_type; - - DEVICE_INFD (d) = CONSOLE_TTY_DATA (con)->infd; - DEVICE_OUTFD (d) = CONSOLE_TTY_DATA (con)->outfd; - - allocate_tty_device_struct (d); - init_baud_rate (d); - - switch (init_tty_for_redisplay (d, (char *) XSTRING_DATA (terminal_type))) - { -#if 0 - case TTY_UNABLE_OPEN_DATABASE: - suppress_early_error_handler_backtrace = 1; - error ("Can't access terminal information database"); - break; -#endif - case TTY_TYPE_UNDEFINED: - suppress_early_error_handler_backtrace = 1; - error ("Terminal type `%s' undefined (or can't access database?)", - XSTRING_DATA (terminal_type)); - break; - case TTY_TYPE_INSUFFICIENT: - suppress_early_error_handler_backtrace = 1; - error ("Terminal type `%s' not powerful enough to run Emacs", - XSTRING_DATA (terminal_type)); - break; - case TTY_SIZE_UNSPECIFIED: - suppress_early_error_handler_backtrace = 1; - error ("Can't determine window size of terminal"); - break; - case TTY_INIT_SUCCESS: - break; - default: - abort (); - } - - init_one_device (d); - - /* Run part of the elisp side of the TTY device initialization. - The post-init is run in the tty_after_init_frame() method. */ - call0 (Qinit_pre_tty_win); -} - -static void -free_tty_device_struct (struct device *d) -{ - struct tty_device *td = (struct tty_device *) d->device_data; - if (td) - xfree (td); -} - -static void -tty_delete_device (struct device *d) -{ - free_tty_device_struct (d); -} - -#ifdef SIGWINCH - -static SIGTYPE -tty_device_size_change_signal (int signo) -{ - int old_errno = errno; - asynch_device_change_pending++; -#ifdef HAVE_UNIXOID_EVENT_LOOP - signal_fake_event (); -#endif - EMACS_REESTABLISH_SIGNAL (SIGWINCH, tty_device_size_change_signal); - errno = old_errno; - SIGRETURN; -} - -/* frame_change_signal does nothing but set a flag that it was called. - When redisplay is called, it will notice that the flag is set and - call handle_pending_device_size_change to do the actual work. */ -static void -tty_asynch_device_change (void) -{ - Lisp_Object devcons, concons; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - int width, height; - Lisp_Object tail; - struct device *d = XDEVICE (XCAR (devcons)); - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - - if (!DEVICE_TTY_P (d)) - continue; - - get_tty_device_size (d, &width, &height); - if (width > 0 && height > 0 - && (CONSOLE_TTY_DATA (con)->width != width - || CONSOLE_TTY_DATA (con)->height != height)) - { - CONSOLE_TTY_DATA (con)->width = width; - CONSOLE_TTY_DATA (con)->height = height; - -#ifdef HAVE_GPM - /* We need to tell GPM how big our screen is now - ** I am pretty sure the GPM library will get incredibly confused - ** if you try to connect to more than one mouse-capable device, - ** so I don't think it will cause any more damage in that case. - */ - gpm_mx = width; - gpm_my = height; -#endif - for (tail = DEVICE_FRAME_LIST (d); - !NILP (tail); - tail = XCDR (tail)) - { - struct frame *f = XFRAME (XCAR (tail)); - - /* We know the frame is tty because we made sure that the - device is tty. */ - change_frame_size (f, height, width, 1); - } - } - } -} - -#endif /* SIGWINCH */ - -static Lisp_Object -tty_device_system_metrics (struct device *d, - enum device_metrics m) -{ - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - switch (m) - { - case DM_size_device: - return Fcons (make_int (CONSOLE_TTY_DATA (con)->width), - make_int (CONSOLE_TTY_DATA (con)->height)); - default: /* No such device metric property for TTY devices */ - return Qunbound; - } -} - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_device_tty (void) -{ - defsymbol (&Qinit_pre_tty_win, "init-pre-tty-win"); - defsymbol (&Qinit_post_tty_win, "init-post-tty-win"); -} - -void -console_type_create_device_tty (void) -{ - /* device methods */ - CONSOLE_HAS_METHOD (tty, init_device); - CONSOLE_HAS_METHOD (tty, delete_device); -#ifdef SIGWINCH - CONSOLE_HAS_METHOD (tty, asynch_device_change); -#endif /* SIGWINCH */ - CONSOLE_HAS_METHOD (tty, device_system_metrics); -} - -void -init_device_tty (void) -{ -#ifdef SIGWINCH - if (initialized && !noninteractive) - signal (SIGWINCH, tty_device_size_change_signal); -#endif /* SIGWINCH */ -} diff --git a/src/device-x.c b/src/device-x.c deleted file mode 100644 index c9ded38..0000000 --- a/src/device-x.c +++ /dev/null @@ -1,1822 +0,0 @@ -/* Device functions for X windows. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 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. */ - -/* Original authors: Jamie Zawinski and the FSF */ -/* Rewritten by Ben Wing and Chuck Thompson. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "xintrinsicp.h" /* CoreP.h needs this */ -#include /* Numerous places access the fields of - a core widget directly. We could - use XtGetValues(), but ... */ -#include "xgccache.h" -#include -#include "xmu.h" -#include "glyphs-x.h" -#include "objects-x.h" - -#include "buffer.h" -#include "elhash.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "redisplay.h" -#include "sysdep.h" -#include "window.h" - -#include "sysfile.h" -#include "systime.h" - -#ifdef HAVE_OFFIX_DND -#include "offix.h" -#endif - -Lisp_Object Vdefault_x_device; -#if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)) -Lisp_Object Vx_app_defaults_directory; -#endif - -/* Qdisplay in general.c */ -Lisp_Object Qx_error; -Lisp_Object Qinit_pre_x_win, Qinit_post_x_win; - -/* The application class of Emacs. */ -Lisp_Object Vx_emacs_application_class; - -Lisp_Object Vx_initial_argv_list; /* #### ugh! */ - -static XrmOptionDescRec emacs_options[] = -{ - {"-geometry", ".geometry", XrmoptionSepArg, NULL}, - {"-iconic", ".iconic", XrmoptionNoArg, "yes"}, - - {"-internal-border-width", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL}, - {"-ib", "*EmacsFrame.internalBorderWidth", XrmoptionSepArg, NULL}, - {"-scrollbar-width", "*EmacsFrame.scrollBarWidth", XrmoptionSepArg, NULL}, - {"-scrollbar-height", "*EmacsFrame.scrollBarHeight", XrmoptionSepArg, NULL}, - - {"-privatecolormap", ".privateColormap", XrmoptionNoArg, "yes"}, - {"-visual", ".EmacsVisual", XrmoptionSepArg, NULL}, - - /* #### Beware! If the type of the shell changes, update this. */ - {"-T", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, - {"-wn", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, - {"-title", "*TopLevelEmacsShell.title", XrmoptionSepArg, NULL}, - - {"-iconname", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL}, - {"-in", "*TopLevelEmacsShell.iconName", XrmoptionSepArg, NULL}, - {"-mc", "*pointerColor", XrmoptionSepArg, NULL}, - {"-cr", "*cursorColor", XrmoptionSepArg, NULL}, - {"-fontset", "*FontSet", XrmoptionSepArg, NULL}, -}; - -/* Functions to synchronize mirroring resources and specifiers */ -int in_resource_setting; - -/************************************************************************/ -/* helper functions */ -/************************************************************************/ - -/* JH 97/11/25 removed the static declaration because I need it during setup in event-Xt... */ -struct device * get_device_from_display_1 (Display *dpy); -struct device * -get_device_from_display_1 (Display *dpy) -{ - Lisp_Object devcons, concons; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - struct device *d = XDEVICE (XCAR (devcons)); - if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d) == dpy) - return d; - } - - return 0; -} - -struct device * -get_device_from_display (Display *dpy) -{ - struct device *d = get_device_from_display_1 (dpy); - -#if !defined(INFODOCK) -# define FALLBACK_RESOURCE_NAME "xemacs" -# else -# define FALLBACK_RESOURCE_NAME "infodock" -#endif - - if (!d) { - /* This isn't one of our displays. Let's crash? */ - stderr_out - ("\n%s: Fatal X Condition. Asked about display we don't own: \"%s\"\n", - (STRINGP (Vinvocation_name) ? - (char *) XSTRING_DATA (Vinvocation_name) : FALLBACK_RESOURCE_NAME), - DisplayString (dpy) ? DisplayString (dpy) : "???"); - abort(); - } - -#undef FALLBACK_RESOURCE_NAME - - return d; -} - -struct device * -decode_x_device (Lisp_Object device) -{ - XSETDEVICE (device, decode_device (device)); - CHECK_X_DEVICE (device); - return XDEVICE (device); -} - -static Display * -get_x_display (Lisp_Object device) -{ - return DEVICE_X_DISPLAY (decode_x_device (device)); -} - - -/************************************************************************/ -/* initializing an X connection */ -/************************************************************************/ - -static void -allocate_x_device_struct (struct device *d) -{ - d->device_data = xnew_and_zero (struct x_device); -} - -static void -Xatoms_of_device_x (struct device *d) -{ - Display *D = DEVICE_X_DISPLAY (d); - - DEVICE_XATOM_WM_PROTOCOLS (d) = XInternAtom (D, "WM_PROTOCOLS", False); - DEVICE_XATOM_WM_DELETE_WINDOW(d) = XInternAtom (D, "WM_DELETE_WINDOW",False); - DEVICE_XATOM_WM_SAVE_YOURSELF(d) = XInternAtom (D, "WM_SAVE_YOURSELF",False); - DEVICE_XATOM_WM_TAKE_FOCUS (d) = XInternAtom (D, "WM_TAKE_FOCUS", False); - DEVICE_XATOM_WM_STATE (d) = XInternAtom (D, "WM_STATE", False); -} - -static void -sanity_check_geometry_resource (Display *dpy) -{ - char *app_name, *app_class, *s; - char buf1 [255], buf2 [255]; - char *type; - XrmValue value; - XtGetApplicationNameAndClass (dpy, &app_name, &app_class); - strcpy (buf1, app_name); - strcpy (buf2, app_class); - for (s = buf1; *s; s++) if (*s == '.') *s = '_'; - strcat (buf1, "._no_._such_._resource_.geometry"); - strcat (buf2, "._no_._such_._resource_.Geometry"); - if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) - { - warn_when_safe (Qgeometry, Qerror, - "\n" -"Apparently \"%s*geometry: %s\" or \"%s*geometry: %s\" was\n" -"specified in the resource database. Specifying \"*geometry\" will make\n" -"XEmacs (and most other X programs) malfunction in obscure ways. (i.e.\n" -"the Xt or Xm libraries will probably crash, which is a very bad thing.)\n" -"You should always use \".geometry\" or \"*EmacsFrame.geometry\" instead.\n", - app_name, (char *) value.addr, - app_class, (char *) value.addr); - suppress_early_error_handler_backtrace = 1; - error ("Invalid geometry resource"); - } -} - -static void -x_init_device_class (struct device *d) -{ - if (DEVICE_X_DEPTH(d) > 2) - { - switch (DEVICE_X_VISUAL(d)->class) - { - case StaticGray: - case GrayScale: - DEVICE_CLASS (d) = Qgrayscale; - break; - default: - DEVICE_CLASS (d) = Qcolor; - } - } - else - DEVICE_CLASS (d) = Qmono; -} - -/* - * Figure out what application name to use for xemacs - * - * Since we have decomposed XtOpenDisplay into XOpenDisplay and - * XtDisplayInitialize, we no longer get this for free. - * - * If there is a `-name' argument in argv, use that. - * Otherwise use the last component of argv[0]. - * - * I have removed the gratuitous use of getenv("RESOURCE_NAME") - * which was in X11R5, but left the matching of any prefix of `-name'. - * Finally, if all else fails, return `xemacs', as it is more - * appropriate (X11R5 returns `main'). - */ -static char * -compute_x_app_name (int argc, char **argv) -{ - int i; - char *ptr; - - for (i = 1; i < argc - 1; i++) - if (!strncmp(argv[i], "-name", max (2, strlen (argv[1])))) - return argv[i+1]; - - if (argc > 0 && argv[0] && *argv[0]) - return (ptr = strrchr (argv[0], '/')) ? ++ptr : argv[0]; - - return "xemacs"; -} - -/* - * This function figures out whether the user has any resources of the - * form "XEmacs.foo" or "XEmacs*foo". - * - * Currently we only consult the display's global resources; to look - * for screen specific resources, we would need to also consult: - * xdefs = XScreenResourceString(ScreenOfDisplay(dpy, scrno)); - */ -static int -have_xemacs_resources_in_xrdb (Display *dpy) -{ - char *xdefs, *key; - int len; - -#ifdef INFODOCK - key = "InfoDock"; -#else - key = "XEmacs"; -#endif - len = strlen (key); - - if (!dpy) - return 0; - - xdefs = XResourceManagerString (dpy); /* don't free - owned by X */ - while (xdefs && *xdefs) - { - if (strncmp (xdefs, key, len) == 0 && - (xdefs[len] == '*' || xdefs[len] == '.')) - return 1; - - while (*xdefs && *xdefs++ != '\n') /* find start of next entry.. */ - ; - } - - return 0; -} - -/* Only the characters [-_A-Za-z0-9] are allowed in the individual - components of a resource. Convert invalid characters to `-' */ - -static char valid_resource_char_p[256]; - -static void -validify_resource_component (char *str, size_t len) -{ - for (; len; len--, str++) - if (!valid_resource_char_p[(unsigned char) (*str)]) - *str = '-'; -} - -static void -Dynarr_add_validified_lisp_string (char_dynarr *cda, Lisp_Object str) -{ - Bytecount len = XSTRING_LENGTH (str); - Dynarr_add_many (cda, (char *) XSTRING_DATA (str), len); - validify_resource_component (Dynarr_atp (cda, Dynarr_length (cda) - len), len); -} - -static void -x_init_device (struct device *d, Lisp_Object props) -{ - Lisp_Object display; - Lisp_Object device; - Display *dpy; - Widget app_shell; - int argc; - char **argv; - CONST char *app_class; - CONST char *app_name; - CONST char *disp_name; - Visual *visual = NULL; - int depth = 8; /* shut up the compiler */ - Colormap cmap; - int screen; - - XSETDEVICE (device, d); - display = DEVICE_CONNECTION (d); - - allocate_x_device_struct (d); - - make_argc_argv (Vx_initial_argv_list, &argc, &argv); - - GET_C_STRING_CTEXT_DATA_ALLOCA (display, disp_name); - - /* - * Break apart the old XtOpenDisplay call into XOpenDisplay and - * XtDisplayInitialize so we can figure out whether there - * are any XEmacs resources in the resource database before - * we intitialize Xt. This is so we can automagically support - * both `Emacs' and `XEmacs' application classes. - */ - slow_down_interrupts (); - /* May not be needed but XtOpenDisplay could not deal with signals here. */ - dpy = DEVICE_X_DISPLAY (d) = XOpenDisplay (disp_name); - speed_up_interrupts (); - - if (dpy == 0) - { - suppress_early_error_handler_backtrace = 1; - signal_simple_error ("X server not responding\n", display); - } - - if (STRINGP (Vx_emacs_application_class) && - XSTRING_LENGTH (Vx_emacs_application_class) > 0) - GET_C_STRING_CTEXT_DATA_ALLOCA (Vx_emacs_application_class, app_class); - else - { - app_class = (NILP (Vx_emacs_application_class) && - have_xemacs_resources_in_xrdb (dpy)) -#ifdef INFODOCK - ? "InfoDock" -#else - ? "XEmacs" -#endif - : "Emacs"; - /* need to update Vx_emacs_application_class: */ - Vx_emacs_application_class = build_string (app_class); - } - - slow_down_interrupts (); - /* May not be needed but XtOpenDisplay could not deal with signals here. - Yuck. */ - XtDisplayInitialize (Xt_app_con, dpy, compute_x_app_name (argc, argv), - app_class, emacs_options, - XtNumber (emacs_options), &argc, argv); - speed_up_interrupts (); - - screen = DefaultScreen (dpy); - if (NILP (Vdefault_x_device)) - Vdefault_x_device = device; - -#ifdef MULE -#if defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET) - { - /* Read in locale-specific resources from - data-directory/app-defaults/$LANG/Emacs. - This is in addition to the standard app-defaults files, and - does not override resources defined elsewhere */ - CONST char *data_dir; - char *path; - XrmDatabase db = XtDatabase (dpy); /* #### XtScreenDatabase(dpy) ? */ - CONST char *locale = XrmLocaleOfDatabase (db); - - if (STRINGP (Vx_app_defaults_directory) && - XSTRING_LENGTH (Vx_app_defaults_directory) > 0) - { - GET_C_STRING_FILENAME_DATA_ALLOCA(Vx_app_defaults_directory, data_dir); - path = (char *)alloca (strlen (data_dir) + strlen (locale) + 7); - sprintf (path, "%s%s/Emacs", data_dir, locale); - if (!access (path, R_OK)) - XrmCombineFileDatabase (path, &db, False); - } - else if (STRINGP (Vdata_directory) && XSTRING_LENGTH (Vdata_directory) > 0) - { - GET_C_STRING_FILENAME_DATA_ALLOCA (Vdata_directory, data_dir); - path = (char *)alloca (strlen (data_dir) + 13 + strlen (locale) + 7); - sprintf (path, "%sapp-defaults/%s/Emacs", data_dir, locale); - if (!access (path, R_OK)) - XrmCombineFileDatabase (path, &db, False); - } - } -#endif /* LWLIB_MENUBARS_MOTIF or HAVE_XIM USE_XFONTSET */ -#endif /* MULE */ - - if (NILP (DEVICE_NAME (d))) - DEVICE_NAME (d) = display; - - /* We're going to modify the string in-place, so be a nice XEmacs */ - DEVICE_NAME (d) = Fcopy_sequence (DEVICE_NAME (d)); - /* colons and periods can't appear in individual elements of resource - strings */ - - XtGetApplicationNameAndClass (dpy, (char **) &app_name, (char **) &app_class); - /* search for a matching visual if requested by the user, or setup the display default */ - { - char *buf1 = (char *)alloca (strlen (app_name) + 17); - char *buf2 = (char *)alloca (strlen (app_class) + 17); - char *type; - XrmValue value; - - sprintf (buf1, "%s.emacsVisual", app_name); - sprintf (buf2, "%s.EmacsVisual", app_class); - if (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True) - { - int cnt = 0, vis_class = PseudoColor; - XVisualInfo vinfo; - char *res, *str = (char*)value.addr; - -#define CHECK_VIS_CLASS(class) \ - else if (strncmp (str, #class, sizeof (#class) - 1) == 0) \ - cnt = sizeof (#class) - 1, vis_class = class - - if (1) - ; - CHECK_VIS_CLASS (StaticGray); - CHECK_VIS_CLASS (StaticColor); - CHECK_VIS_CLASS (TrueColor); - CHECK_VIS_CLASS (GrayScale); - CHECK_VIS_CLASS (PseudoColor); - CHECK_VIS_CLASS (DirectColor); - - if (cnt) - { - res = str + cnt; - depth = atoi (res); - if (depth == 0) - { - stderr_out ("Invalid Depth specification in %s... ignoring...\n", str); - } - else - { - if (XMatchVisualInfo (dpy, screen, depth, vis_class, &vinfo)) - { - visual = vinfo.visual; - } - else - { - stderr_out ("Can't match the requested visual %s... using defaults\n", str); - } - } - } - else - { - stderr_out( "Invalid Visual specification in %s... ignoring.\n", str); - } - } - if (visual == NULL) - { - visual = DefaultVisual (dpy, screen); - depth = DefaultDepth (dpy, screen); - } - - /* If we've got the same visual as the default and it's PseudoColor, - check to see if the user specified that we need a private colormap */ - if (visual == DefaultVisual (dpy, screen)) - { - sprintf (buf1, "%s.privateColormap", app_name); - sprintf (buf2, "%s.PrivateColormap", app_class); - if ((visual->class == PseudoColor) && - (XrmGetResource (XtDatabase (dpy), buf1, buf2, &type, &value) == True)) - { - cmap = XCopyColormapAndFree (dpy, DefaultColormap (dpy, screen)); - } - else - { - cmap = DefaultColormap (dpy, screen); - } - } - else - { - /* We have to create a matching colormap anyway... - ### think about using standard colormaps (need the Xmu libs?) */ - cmap = XCreateColormap (dpy, RootWindow(dpy, screen), visual, AllocNone); - XInstallColormap (dpy, cmap); - } - } - - DEVICE_X_VISUAL (d) = visual; - DEVICE_X_COLORMAP (d) = cmap; - DEVICE_X_DEPTH (d) = depth; - validify_resource_component ((char *) XSTRING_DATA (DEVICE_NAME (d)), - XSTRING_LENGTH (DEVICE_NAME (d))); - - { - Arg al[3]; - XtSetArg (al[0], XtNvisual, visual); - XtSetArg (al[1], XtNdepth, depth); - XtSetArg (al[2], XtNcolormap, cmap); - - app_shell = XtAppCreateShell (NULL, app_class, - applicationShellWidgetClass, - dpy, al, countof (al)); - } - - DEVICE_XT_APP_SHELL (d) = app_shell; - -#ifdef HAVE_XIM - XIM_init_device(d); -#endif /* HAVE_XIM */ - - /* Realize the app_shell so that its window exists for GC creation purposes, - and set it to the size of the root window for child placement purposes */ - { - Arg al[5]; - XtSetArg (al[0], XtNmappedWhenManaged, False); - XtSetArg (al[1], XtNx, 0); - XtSetArg (al[2], XtNy, 0); - XtSetArg (al[3], XtNwidth, WidthOfScreen (ScreenOfDisplay (dpy, screen))); - XtSetArg (al[4], XtNheight, HeightOfScreen (ScreenOfDisplay (dpy, screen))); - XtSetValues (app_shell, al, countof (al)); - XtRealizeWidget (app_shell); - } - -#ifdef HAVE_SESSION - { - int new_argc; - char **new_argv; - make_argc_argv (Vcommand_line_args, &new_argc, &new_argv); - XSetCommand (XtDisplay (app_shell), XtWindow (app_shell), new_argv, new_argc); - free_argc_argv (new_argv); - } -#endif /* HAVE_SESSION */ - - -#ifdef HAVE_OFFIX_DND - DndInitialize ( app_shell ); -#endif - - Vx_initial_argv_list = make_arg_list (argc, argv); - free_argc_argv (argv); - - DEVICE_X_WM_COMMAND_FRAME (d) = Qnil; - - sanity_check_geometry_resource (dpy); - - /* In event-Xt.c */ - x_init_modifier_mapping (d); - - DEVICE_INFD (d) = DEVICE_OUTFD (d) = ConnectionNumber (dpy); - init_baud_rate (d); - init_one_device (d); - - DEVICE_X_GC_CACHE (d) = make_gc_cache (dpy, XtWindow(app_shell)); - DEVICE_X_GRAY_PIXMAP (d) = None; - Xatoms_of_device_x (d); - Xatoms_of_xselect (d); - Xatoms_of_objects_x (d); - x_init_device_class (d); - - /* Run the elisp side of the X device initialization. */ - call0 (Qinit_pre_x_win); -} - -static void -x_finish_init_device (struct device *d, Lisp_Object props) -{ - call0 (Qinit_post_x_win); -} - -static void -x_mark_device (struct device *d, void (*markobj) (Lisp_Object)) -{ - markobj (DEVICE_X_WM_COMMAND_FRAME (d)); - markobj (DEVICE_X_DATA (d)->x_keysym_map_hash_table); -} - - -/************************************************************************/ -/* closing an X connection */ -/************************************************************************/ - -static void -free_x_device_struct (struct device *d) -{ - xfree (d->device_data); -} - -static void -x_delete_device (struct device *d) -{ - Lisp_Object device; - Display *display; -#ifdef FREE_CHECKING - extern void (*__free_hook) (void *); - int checking_free; -#endif - - XSETDEVICE (device, d); - display = DEVICE_X_DISPLAY (d); - - if (display) - { -#ifdef FREE_CHECKING - checking_free = (__free_hook != 0); - - /* Disable strict free checking, to avoid bug in X library */ - if (checking_free) - disable_strict_free_check (); -#endif - - free_gc_cache (DEVICE_X_GC_CACHE (d)); - if (DEVICE_X_DATA (d)->x_modifier_keymap) - XFreeModifiermap (DEVICE_X_DATA (d)->x_modifier_keymap); - if (DEVICE_X_DATA (d)->x_keysym_map) - XFree ((char *) DEVICE_X_DATA (d)->x_keysym_map); - - if (DEVICE_XT_APP_SHELL (d)) - { - XtDestroyWidget (DEVICE_XT_APP_SHELL (d)); - DEVICE_XT_APP_SHELL (d) = NULL; - } - - XtCloseDisplay (display); - DEVICE_X_DISPLAY (d) = 0; -#ifdef FREE_CHECKING - if (checking_free) - enable_strict_free_check (); -#endif - } - - if (EQ (device, Vdefault_x_device)) - { - Lisp_Object devcons, concons; - /* #### handle deleting last X device */ - Vdefault_x_device = Qnil; - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - if (DEVICE_X_P (XDEVICE (XCAR (devcons))) && - !EQ (device, XCAR (devcons))) - { - Vdefault_x_device = XCAR (devcons); - goto double_break; - } - } - } - double_break: - free_x_device_struct (d); -} - - -/************************************************************************/ -/* handle X errors */ -/************************************************************************/ - -CONST char * -x_event_name (int event_type) -{ - static CONST char *events[] = - { - "0: ERROR!", - "1: REPLY", - "KeyPress", - "KeyRelease", - "ButtonPress", - "ButtonRelease", - "MotionNotify", - "EnterNotify", - "LeaveNotify", - "FocusIn", - "FocusOut", - "KeymapNotify", - "Expose", - "GraphicsExpose", - "NoExpose", - "VisibilityNotify", - "CreateNotify", - "DestroyNotify", - "UnmapNotify", - "MapNotify", - "MapRequest", - "ReparentNotify", - "ConfigureNotify", - "ConfigureRequest", - "GravityNotify", - "ResizeRequest", - "CirculateNotify", - "CirculateRequest", - "PropertyNotify", - "SelectionClear", - "SelectionRequest", - "SelectionNotify", - "ColormapNotify", - "ClientMessage", - "MappingNotify", - "LASTEvent" - }; - - if (event_type < 0 || event_type >= countof (events)) - return NULL; - return events [event_type]; -} - -/* Handling errors. - - If an X error occurs which we are not expecting, we have no alternative - but to print it to stderr. It would be nice to stuff it into a pop-up - buffer, or to print it in the minibuffer, but that's not possible, because - one is not allowed to do any I/O on the display connection from an error - handler. The guts of Xlib expect these functions to either return or exit. - - However, there are occasions when we might expect an error to reasonably - occur. The interface to this is as follows: - - Before calling some X routine which may error, call - expect_x_error (dpy); - - Just after calling the X routine, call either: - - x_error_occurred_p (dpy); - - to ask whether an error happened (and was ignored), or: - - signal_if_x_error (dpy, resumable_p); - - which will call Fsignal() with args appropriate to the X error, if there - was one. (Resumable_p is whether the debugger should be allowed to - continue from the call to signal.) - - You must call one of these two routines immediately after calling the X - routine; think of them as bookends like BLOCK_INPUT and UNBLOCK_INPUT. - */ - -static int error_expected; -static int error_occurred; -static XErrorEvent last_error; - -/* OVERKILL! */ - -#ifdef EXTERNAL_WIDGET -static Lisp_Object -x_error_handler_do_enqueue (Lisp_Object frame) -{ - enqueue_magic_eval_event (io_error_delete_frame, frame); - return Qt; -} - -static Lisp_Object -x_error_handler_error (Lisp_Object data, Lisp_Object dummy) -{ - return Qnil; -} -#endif /* EXTERNAL_WIDGET */ - -int -x_error_handler (Display *disp, XErrorEvent *event) -{ - if (error_expected) - { - error_expected = 0; - error_occurred = 1; - last_error = *event; - } - else - { -#ifdef EXTERNAL_WIDGET - struct frame *f; - struct device *d = get_device_from_display (disp); - - if ((event->error_code == BadWindow || - event->error_code == BadDrawable) - && ((f = x_any_window_to_frame (d, event->resourceid)) != 0)) - { - Lisp_Object frame; - - /* one of the windows comprising one of our frames has died. - This occurs particularly with ExternalShell frames when the - client that owns the ExternalShell's window dies. - - We cannot do any I/O on the display connection so we need - to enqueue an eval event so that the deletion happens - later. - - Furthermore, we need to trap any errors (out-of-memory) that - may occur when Fenqueue_eval_event is called. - */ - - if (f->being_deleted) - return 0; - XSETFRAME (frame, f); - if (!NILP (condition_case_1 (Qerror, x_error_handler_do_enqueue, - frame, x_error_handler_error, Qnil))) - { - f->being_deleted = 1; - f->visible = 0; - } - return 0; - } -#endif /* EXTERNAL_WIDGET */ - - stderr_out ("\n%s: ", - (STRINGP (Vinvocation_name) - ? (char *) XSTRING_DATA (Vinvocation_name) - : "xemacs")); - XmuPrintDefaultErrorMessage (disp, event, stderr); - } - return 0; -} - -void -expect_x_error (Display *dpy) -{ - assert (!error_expected); - XSync (dpy, 0); /* handle pending errors before setting flag */ - error_expected = 1; - error_occurred = 0; -} - -int -x_error_occurred_p (Display *dpy) -{ - int val; - XSync (dpy, 0); /* handle pending errors before setting flag */ - val = error_occurred; - error_expected = 0; - error_occurred = 0; - return val; -} - -int -signal_if_x_error (Display *dpy, int resumable_p) -{ - char buf[1024]; - Lisp_Object data; - if (! x_error_occurred_p (dpy)) - return 0; - data = Qnil; - sprintf (buf, "0x%X", (unsigned int) last_error.resourceid); - data = Fcons (build_string (buf), data); - { - char num [32]; - sprintf (num, "%d", last_error.request_code); - XGetErrorDatabaseText (last_error.display, "XRequest", num, "", - buf, sizeof (buf)); - if (! *buf) - sprintf (buf, "Request-%d", last_error.request_code); - data = Fcons (build_string (buf), data); - } - XGetErrorText (last_error.display, last_error.error_code, buf, sizeof (buf)); - data = Fcons (build_string (buf), data); - again: - Fsignal (Qx_error, data); - if (! resumable_p) goto again; - return 1; -} - -int -x_IO_error_handler (Display *disp) -{ - /* This function can GC */ - Lisp_Object dev; - struct device *d = get_device_from_display_1 (disp); - - assert (d != NULL); - XSETDEVICE (dev, d); - - if (NILP (find_nonminibuffer_frame_not_on_device (dev))) - { - /* We're going down. */ - stderr_out - ("\n%s: Fatal I/O Error %d (%s) on display connection \"%s\"\n", - (STRINGP (Vinvocation_name) ? - (char *) XSTRING_DATA (Vinvocation_name) : "xemacs"), - errno, strerror (errno), DisplayString (disp)); - stderr_out - (" after %lu requests (%lu known processed) with %d events remaining.\n", - NextRequest (disp) - 1, LastKnownRequestProcessed (disp), - QLength (disp)); - /* assert (!_Xdebug); */ - } - else - { - warn_when_safe - (Qx, Qcritical, - "I/O Error %d (%s) on display connection\n" - " \"%s\" after after %lu requests (%lu known processed)\n" - " with %d events remaining.\n" - " Throwing to top level.\n", - errno, strerror (errno), DisplayString (disp), - NextRequest (disp) - 1, LastKnownRequestProcessed (disp), - QLength (disp)); - } - - /* According to X specs, we should not return from this function, or - Xlib might just decide to exit(). So we mark the offending - console for deletion and throw to top level. */ - if (d) - enqueue_magic_eval_event (io_error_delete_device, dev); - DEVICE_X_BEING_DELETED (d) = 1; - Fthrow (Qtop_level, Qnil); - - return 0; /* not reached */ -} - -DEFUN ("x-debug-mode", Fx_debug_mode, 1, 2, 0, /* -With a true arg, make the connection to the X server synchronous. -With false, make it asynchronous. Synchronous connections are much slower, -but are useful for debugging. (If you get X errors, make the connection -synchronous, and use a debugger to set a breakpoint on `x_error_handler'. -Your backtrace of the C stack will now be useful. In asynchronous mode, -the stack above `x_error_handler' isn't helpful because of buffering.) -If DEVICE is not specified, the selected device is assumed. - -Calling this function is the same as calling the C function `XSynchronize', -or starting the program with the `-sync' command line argument. -*/ - (arg, device)) -{ - struct device *d = decode_x_device (device); - - XSynchronize (DEVICE_X_DISPLAY (d), !NILP (arg)); - - if (!NILP (arg)) - message ("X connection is synchronous"); - else - message ("X connection is asynchronous"); - - return arg; -} - - -/************************************************************************/ -/* X resources */ -/************************************************************************/ - -#if 0 /* bah humbug. The whole "widget == resource" stuff is such - a crock of shit that I'm just going to ignore it all. */ - -/* If widget is NULL, we are retrieving device or global face data. */ - -static void -construct_name_list (Display *display, Widget widget, char *fake_name, - char *fake_class, char *name, char *class) -{ - char *stack [100][2]; - Widget this; - int count = 0; - char *name_tail, *class_tail; - - if (widget) - { - for (this = widget; this; this = XtParent (this)) - { - stack [count][0] = this->core.name; - stack [count][1] = XtClass (this)->core_class.class_name; - count++; - } - count--; - } - else if (fake_name && fake_class) - { - stack [count][0] = fake_name; - stack [count][1] = fake_class; - count++; - } - - /* The root widget is an application shell; resource lookups use the - specified application name and application class in preference to - the name/class of that widget (which is argv[0] / "ApplicationShell"). - Generally the app name and class will be argv[0] / "Emacs" but - the former can be set via the -name command-line option, and the - latter can be set by changing `x-emacs-application-class' in - lisp/term/x-win.el. - */ - XtGetApplicationNameAndClass (display, - &stack [count][0], - &stack [count][1]); - - name [0] = 0; - class [0] = 0; - - name_tail = name; - class_tail = class; - for (; count >= 0; count--) - { - strcat (name_tail, stack [count][0]); - for (; *name_tail; name_tail++) - if (*name_tail == '.') *name_tail = '_'; - strcat (name_tail, "."); - name_tail++; - - strcat (class_tail, stack [count][1]); - for (; *class_tail; class_tail++) - if (*class_tail == '.') *class_tail = '_'; - strcat (class_tail, "."); - class_tail++; - } -} - -#endif /* 0 */ - -static char_dynarr *name_char_dynarr; -static char_dynarr *class_char_dynarr; - -/* Given a locale and device specification from x-get-resource or -x-get-resource-prefix, return the resource prefix and display to -fetch the resource on. */ - -static void -x_get_resource_prefix (Lisp_Object locale, Lisp_Object device, - Display **display_out, char_dynarr *name, - char_dynarr *class) -{ - if (NILP (locale)) - locale = Qglobal; - if (NILP (Fvalid_specifier_locale_p (locale))) - signal_simple_error ("Invalid locale", locale); - if (WINDOWP (locale)) - /* #### I can't come up with any coherent way of naming windows. - By relative position? That seems tricky because windows - can change position, be split, etc. By order of creation? - That seems less than useful. */ - signal_simple_error ("Windows currently can't be resourced", locale); - - if (!NILP (device) && !DEVICEP (device)) - CHECK_DEVICE (device); - if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) - device = Qnil; - if (NILP (device)) - { - device = DFW_DEVICE (locale); - if (DEVICEP (device) && !DEVICE_X_P (XDEVICE (device))) - device = Qnil; - if (NILP (device)) - device = Vdefault_x_device; - if (NILP (device)) - { - *display_out = 0; - return; - } - } - - *display_out = DEVICE_X_DISPLAY (XDEVICE (device)); - - { - char *appname, *appclass; - int name_len, class_len; - XtGetApplicationNameAndClass (*display_out, &appname, &appclass); - name_len = strlen (appname); - class_len = strlen (appclass); - Dynarr_add_many (name , appname, name_len); - Dynarr_add_many (class, appclass, class_len); - validify_resource_component (Dynarr_atp (name, 0), name_len); - validify_resource_component (Dynarr_atp (class, 0), class_len); - } - - if (EQ (locale, Qglobal)) - return; - if (BUFFERP (locale)) - { - Dynarr_add_literal_string (name, ".buffer."); - /* we know buffer is live; otherwise we got an error above. */ - Dynarr_add_validified_lisp_string (name, Fbuffer_name (locale)); - Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsBuffer"); - } - else if (FRAMEP (locale)) - { - Dynarr_add_literal_string (name, ".frame."); - /* we know frame is live; otherwise we got an error above. */ - Dynarr_add_validified_lisp_string (name, Fframe_name (locale)); - Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsFrame"); - } - else - { - assert (DEVICEP (locale)); - Dynarr_add_literal_string (name, ".device."); - /* we know device is live; otherwise we got an error above. */ - Dynarr_add_validified_lisp_string (name, Fdevice_name (locale)); - Dynarr_add_literal_string (class, ".EmacsLocaleType.EmacsDevice"); - } - return; -} - -DEFUN ("x-get-resource", Fx_get_resource, 3, 6, 0, /* -Retrieve an X resource from the resource manager. - -The first arg is the name of the resource to retrieve, such as "font". -The second arg is the class of the resource to retrieve, such as "Font". -The third arg must be one of the symbols 'string, 'integer, 'natnum, or - 'boolean, specifying the type of object that the database is searched for. -The fourth arg is the locale to search for the resources on, and can - currently be a buffer, a frame, a device, or 'global. If omitted, it - defaults to 'global. -The fifth arg is the device to search for the resources on. (The resource - database for a particular device is constructed by combining non-device- - specific resources such as any command-line resources specified and any - app-defaults files found [or the fallback resources supplied by XEmacs, - if no app-defaults file is found] with device-specific resources such as - those supplied using xrdb.) If omitted, it defaults to the device of - LOCALE, if a device can be derived (i.e. if LOCALE is a frame or device), - and otherwise defaults to the value of `default-x-device'. -The sixth arg NOERROR, if non-nil, means do not signal an error if a - bogus resource specification was retrieved (e.g. if a non-integer was - given when an integer was requested). In this case, a warning is issued - instead. - -The resource names passed to this function are looked up relative to the -locale. - -If you want to search for a subresource, you just need to specify the -resource levels in NAME and CLASS. For example, NAME could be -"modeline.attributeFont", and CLASS "Face.AttributeFont". - -Specifically, - -1) If LOCALE is a buffer, a call - - (x-get-resource "foreground" "Foreground" 'string SOME-BUFFER) - -is an interface to a C call something like - - XrmGetResource (db, "xemacs.buffer.BUFFER-NAME.foreground", - "Emacs.EmacsLocaleType.EmacsBuffer.Foreground", - "String"); - -2) If LOCALE is a frame, a call - - (x-get-resource "foreground" "Foreground" 'string SOME-FRAME) - -is an interface to a C call something like - - XrmGetResource (db, "xemacs.frame.FRAME-NAME.foreground", - "Emacs.EmacsLocaleType.EmacsFrame.Foreground", - "String"); - -3) If LOCALE is a device, a call - - (x-get-resource "foreground" "Foreground" 'string SOME-DEVICE) - -is an interface to a C call something like - - XrmGetResource (db, "xemacs.device.DEVICE-NAME.foreground", - "Emacs.EmacsLocaleType.EmacsDevice.Foreground", - "String"); - -4) If LOCALE is 'global, a call - - (x-get-resource "foreground" "Foreground" 'string 'global) - -is an interface to a C call something like - - XrmGetResource (db, "xemacs.foreground", - "Emacs.Foreground", - "String"); - -Note that for 'global, no prefix is added other than that of the -application itself; thus, you can use this locale to retrieve -arbitrary application resources, if you really want to. - -The returned value of this function is nil if the queried resource is not -found. If the third arg is `string', a string is returned, and if it is -`integer', an integer is returned. If the third arg is `boolean', then the -returned value is the list (t) for true, (nil) for false, and is nil to -mean ``unspecified.'' -*/ - (name, class, type, locale, device, no_error)) -{ - char* name_string, *class_string; - char *raw_result; - XrmDatabase db; - Display *display; - Error_behavior errb = decode_error_behavior_flag (no_error); - - CHECK_STRING (name); - CHECK_STRING (class); - CHECK_SYMBOL (type); - - Dynarr_reset (name_char_dynarr); - Dynarr_reset (class_char_dynarr); - - x_get_resource_prefix (locale, device, &display, - name_char_dynarr, class_char_dynarr); - if (!display) - return Qnil; - - db = XtDatabase (display); - - Dynarr_add (name_char_dynarr, '.'); - Dynarr_add_lisp_string (name_char_dynarr, name); - Dynarr_add (class_char_dynarr, '.'); - Dynarr_add_lisp_string (class_char_dynarr, class); - Dynarr_add (name_char_dynarr, '\0'); - Dynarr_add (class_char_dynarr, '\0'); - - name_string = Dynarr_atp (name_char_dynarr, 0); - class_string = Dynarr_atp (class_char_dynarr, 0); - - { - XrmValue xrm_value; - XrmName namelist[100]; - XrmClass classlist[100]; - XrmName *namerest = namelist; - XrmClass *classrest = classlist; - XrmRepresentation xrm_type; - XrmRepresentation string_quark; - int result; - XrmStringToNameList (name_string, namelist); - XrmStringToClassList (class_string, classlist); - string_quark = XrmStringToQuark ("String"); - - /* ensure that they have the same length */ - while (namerest[0] && classrest[0]) - namerest++, classrest++; - if (namerest[0] || classrest[0]) - signal_simple_error_2 - ("class list and name list must be the same length", name, class); - result = XrmQGetResource (db, namelist, classlist, &xrm_type, &xrm_value); - - if (result != True || xrm_type != string_quark) - return Qnil; - raw_result = (char *) xrm_value.addr; - } - - if (EQ (type, Qstring)) - return build_string (raw_result); - else if (EQ (type, Qboolean)) - { - if (!strcasecmp (raw_result, "off") || - !strcasecmp (raw_result, "false") || - !strcasecmp (raw_result, "no")) - return Fcons (Qnil, Qnil); - if (!strcasecmp (raw_result, "on") || - !strcasecmp (raw_result, "true") || - !strcasecmp (raw_result, "yes")) - return Fcons (Qt, Qnil); - return maybe_continuable_error - (Qresource, errb, - "can't convert %s: %s to a Boolean", name_string, raw_result); - } - else if (EQ (type, Qinteger) || EQ (type, Qnatnum)) - { - int i; - char c; - if (1 != sscanf (raw_result, "%d%c", &i, &c)) - return maybe_continuable_error - (Qresource, errb, - "can't convert %s: %s to an integer", name_string, raw_result); - else if (EQ (type, Qnatnum) && i < 0) - return maybe_continuable_error - (Qresource, errb, - "invalid numerical value %d for resource %s", i, name_string); - else - return make_int (i); - } - else - { - return maybe_signal_continuable_error - (Qwrong_type_argument, - list2 (build_translated_string - ("should be string, integer, natnum or boolean"), - type), - Qresource, errb); - } -} - -DEFUN ("x-get-resource-prefix", Fx_get_resource_prefix, 1, 2, 0, /* -Return the resource prefix for LOCALE on DEVICE. -The resource prefix is the strings used to prefix resources if -the LOCALE and DEVICE arguments were passed to `x-get-resource'. -The returned value is a cons of a name prefix and a class prefix. -For example, if LOCALE is a frame, the returned value might be -\("xemacs.frame.FRAME-NAME" . "Emacs.EmacsLocaleType.EmacsFrame"). -If no valid X device for resourcing can be obtained, this function -returns nil. (In such a case, `x-get-resource' would always return nil.) -*/ - (locale, device)) -{ - Display *display; - - Dynarr_reset (name_char_dynarr ); - Dynarr_reset (class_char_dynarr); - - x_get_resource_prefix (locale, device, &display, - name_char_dynarr, class_char_dynarr); - if (!display) - return Qnil; - - return Fcons (make_string ((Bufbyte *) Dynarr_atp (name_char_dynarr, 0), - Dynarr_length (name_char_dynarr)), - make_string ((Bufbyte *) Dynarr_atp (class_char_dynarr, 0), - Dynarr_length (class_char_dynarr))); -} - -DEFUN ("x-put-resource", Fx_put_resource, 1, 2, 0, /* -Add a resource to the resource database for DEVICE. -RESOURCE-LINE specifies the resource to add and should be a -standard resource specification. -*/ - (resource_line, device)) -{ - struct device *d = decode_device (device); - char *str, *colon_pos; - - CHECK_STRING (resource_line); - str = (char *) XSTRING_DATA (resource_line); - if (!(colon_pos = strchr (str, ':')) || strchr (str, '\n')) - invalid: - signal_simple_error ("Invalid resource line", resource_line); - if (strspn (str, - /* Only the following chars are allowed before the colon */ - " \t.*?abcdefghijklmnopqrstuvwxyz" - "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-") - != (size_t) (colon_pos - str)) - goto invalid; - - if (DEVICE_X_P (d)) - { - XrmDatabase db = XtDatabase (DEVICE_X_DISPLAY (d)); - XrmPutLineResource (&db, str); - } - - return Qnil; -} - - -/************************************************************************/ -/* display information functions */ -/************************************************************************/ - -DEFUN ("default-x-device", Fdefault_x_device, 0, 0, 0, /* -Return the default X device for resourcing. -This is the first-created X device that still exists. -*/ - ()) -{ - return Vdefault_x_device; -} - -DEFUN ("x-display-visual-class", Fx_display_visual_class, 0, 1, 0, /* -Return the visual class of the X display DEVICE is using. -This can be altered from the default at startup using the XResource "EmacsVisual". -The returned value will be one of the symbols `static-gray', `gray-scale', -`static-color', `pseudo-color', `true-color', or `direct-color'. -*/ - (device)) -{ - Visual *vis = DEVICE_X_VISUAL (decode_x_device (device)); - switch (vis->class) - { - case StaticGray: return intern ("static-gray"); - case GrayScale: return intern ("gray-scale"); - case StaticColor: return intern ("static-color"); - case PseudoColor: return intern ("pseudo-color"); - case TrueColor: return intern ("true-color"); - case DirectColor: return intern ("direct-color"); - default: - error ("display has an unknown visual class"); - return Qnil; /* suppress compiler warning */ - } -} - -DEFUN ("x-display-visual-depth", Fx_display_visual_depth, 0, 1, 0, /* -Return the bitplane depth of the visual the X display DEVICE is using. -*/ - (device)) -{ - return make_int (DEVICE_X_DEPTH (decode_x_device (device))); -} - -static Lisp_Object -x_device_system_metrics (struct device *d, - enum device_metrics m) -{ - Display *dpy = DEVICE_X_DISPLAY (d); - - switch (m) - { - case DM_size_device: - return Fcons (make_int (DisplayWidth (dpy, DefaultScreen (dpy))), - make_int (DisplayHeight (dpy, DefaultScreen (dpy)))); - case DM_size_device_mm: - return Fcons (make_int (DisplayWidthMM (dpy, DefaultScreen (dpy))), - make_int (DisplayHeightMM (dpy, DefaultScreen (dpy)))); - case DM_num_bit_planes: - return make_int (DisplayPlanes (dpy, DefaultScreen (dpy))); - case DM_num_color_cells: - return make_int (DisplayCells (dpy, DefaultScreen (dpy))); - default: /* No such device metric property for X devices */ - return Qunbound; - } -} - -DEFUN ("x-server-vendor", Fx_server_vendor, 0, 1, 0, /* -Return the vendor ID string of the X server DEVICE is on. -Return the empty string if the vendor ID string cannot be determined. -*/ - (device)) -{ - Display *dpy = get_x_display (device); - char *vendor = ServerVendor (dpy); - - return build_string (vendor ? vendor : ""); -} - -DEFUN ("x-server-version", Fx_server_version, 0, 1, 0, /* -Return the version numbers of the X server DEVICE is on. -The returned value is a list of three integers: the major and minor -version numbers of the X Protocol in use, and the vendor-specific release -number. See also `x-server-vendor'. -*/ - (device)) -{ - Display *dpy = get_x_display (device); - - return list3 (make_int (ProtocolVersion (dpy)), - make_int (ProtocolRevision (dpy)), - make_int (VendorRelease (dpy))); -} - -DEFUN ("x-valid-keysym-name-p", Fx_valid_keysym_name_p, 1, 1, 0, /* -Return true if KEYSYM names a keysym that the X library knows about. -Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in -/usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -*/ - (keysym)) -{ - CONST char *keysym_ext; - - CHECK_STRING (keysym); - GET_C_STRING_CTEXT_DATA_ALLOCA (keysym, keysym_ext); - - return XStringToKeysym (keysym_ext) ? Qt : Qnil; -} - -DEFUN ("x-keysym-hash-table", Fx_keysym_hash_table, 0, 1, 0, /* -Return a hash table which contains a hash key for all keysyms which -name keys on the keyboard. See `x-keysym-on-keyboard-p'. -*/ - (device)) -{ - struct device *d = decode_device (device); - if (!DEVICE_X_P (d)) - signal_simple_error ("Not an X device", device); - - return DEVICE_X_DATA (d)->x_keysym_map_hash_table; -} - -DEFUN ("x-keysym-on-keyboard-sans-modifiers-p", Fx_keysym_on_keyboard_sans_modifiers_p, - 1, 2, 0, /* -Return true if KEYSYM names a key on the keyboard of DEVICE. -More precisely, return true if pressing a physical key -on the keyboard of DEVICE without any modifier keys generates KEYSYM. -Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in -/usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -The keysym name can be provided in two forms: -- if keysym is a string, it must be the name as known to X windows. -- if keysym is a symbol, it must be the name as known to XEmacs. -The two names differ in capitalization and underscoring. -*/ - (keysym, device)) -{ - struct device *d = decode_device (device); - if (!DEVICE_X_P (d)) - signal_simple_error ("Not an X device", device); - - return (EQ (Qsans_modifiers, - Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? - Qt : Qnil); -} - - -DEFUN ("x-keysym-on-keyboard-p", Fx_keysym_on_keyboard_p, 1, 2, 0, /* -Return true if KEYSYM names a key on the keyboard of DEVICE. -More precisely, return true if some keystroke (possibly including modifiers) -on the keyboard of DEVICE keys generates KEYSYM. -Valid keysyms are listed in the files /usr/include/X11/keysymdef.h and in -/usr/lib/X11/XKeysymDB, or whatever the equivalents are on your system. -The keysym name can be provided in two forms: -- if keysym is a string, it must be the name as known to X windows. -- if keysym is a symbol, it must be the name as known to XEmacs. -The two names differ in capitalization and underscoring. -*/ - (keysym, device)) -{ - struct device *d = decode_device (device); - if (!DEVICE_X_P (d)) - signal_simple_error ("Not an X device", device); - - return (NILP (Fgethash (keysym, DEVICE_X_KEYSYM_MAP_HASH_TABLE (d), Qnil)) ? - Qnil : Qt); -} - - -/************************************************************************/ -/* grabs and ungrabs */ -/************************************************************************/ - -DEFUN ("x-grab-pointer", Fx_grab_pointer, 0, 3, 0, /* -Grab the pointer and restrict it to its current window. -If optional DEVICE argument is nil, the default device will be used. -If optional CURSOR argument is non-nil, change the pointer shape to that - until `x-ungrab-pointer' is called (it should be an object returned by the - `make-cursor-glyph' function). -If the second optional argument IGNORE-KEYBOARD is non-nil, ignore all - keyboard events during the grab. -Returns t if the grab is successful, nil otherwise. -*/ - (device, cursor, ignore_keyboard)) -{ - Window w; - int pointer_mode, result; - struct device *d = decode_x_device (device); - - if (!NILP (cursor)) - { - CHECK_POINTER_GLYPH (cursor); - cursor = glyph_image_instance (cursor, device, ERROR_ME, 0); - } - - if (!NILP (ignore_keyboard)) - pointer_mode = GrabModeSync; - else - pointer_mode = GrabModeAsync; - - w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); - - /* #### Possibly this needs to gcpro the cursor somehow, but it doesn't - seem to cause a problem if XFreeCursor is called on a cursor in use - in a grab; I suppose the X server counts the grab as a reference - and doesn't free it until it exits? */ - result = XGrabPointer (DEVICE_X_DISPLAY (d), w, - False, - ButtonMotionMask | - ButtonPressMask | - ButtonReleaseMask | - PointerMotionHintMask, - GrabModeAsync, /* Keep pointer events flowing */ - pointer_mode, /* Stall keyboard events */ - w, /* Stay in this window */ - (NILP (cursor) ? 0 - : XIMAGE_INSTANCE_X_CURSOR (cursor)), - CurrentTime); - return (result == GrabSuccess) ? Qt : Qnil; -} - -DEFUN ("x-ungrab-pointer", Fx_ungrab_pointer, 0, 1, 0, /* -Release a pointer grab made with `x-grab-pointer'. -If optional first arg DEVICE is nil the default device is used. -If it is t the pointer will be released on all X devices. -*/ - (device)) -{ - if (!EQ (device, Qt)) - { - Display *dpy = get_x_display (device); - XUngrabPointer (dpy, CurrentTime); - } - else - { - Lisp_Object devcons, concons; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - struct device *d = XDEVICE (XCAR (devcons)); - - if (DEVICE_X_P (d)) - XUngrabPointer (DEVICE_X_DISPLAY (d), CurrentTime); - } - } - - return Qnil; -} - -DEFUN ("x-grab-keyboard", Fx_grab_keyboard, 0, 1, 0, /* -Grab the keyboard on the given device (defaulting to the selected one). -So long as the keyboard is grabbed, all keyboard events will be delivered -to emacs -- it is not possible for other X clients to eavesdrop on them. -Ungrab the keyboard with `x-ungrab-keyboard' (use an unwind-protect). -Returns t if the grab was successful; nil otherwise. -*/ - (device)) -{ - struct device *d = decode_x_device (device); - Window w = XtWindow (FRAME_X_TEXT_WIDGET (device_selected_frame (d))); - Display *dpy = DEVICE_X_DISPLAY (d); - Status status; - XSync (dpy, False); - status = XGrabKeyboard (dpy, w, True, - /* I don't really understand sync-vs-async - grabs, but this is what xterm does. */ - GrabModeAsync, GrabModeAsync, - /* Use the timestamp of the last user action - read by emacs proper; xterm uses CurrentTime - but there's a comment that says "wrong"... - (Despite the name this is the time of the - last key or mouse event.) */ - DEVICE_X_MOUSE_TIMESTAMP (d)); - if (status == GrabSuccess) - { - /* The XUngrabKeyboard should generate a FocusIn back to this - window but it doesn't unless we explicitly set focus to the - window first (which should already have it. The net result - is that without this call when x-ungrab-keyboard is called - the selected frame ends up not having focus. */ - XSetInputFocus (dpy, w, RevertToParent, DEVICE_X_MOUSE_TIMESTAMP (d)); - return Qt; - } - else - return Qnil; -} - -DEFUN ("x-ungrab-keyboard", Fx_ungrab_keyboard, 0, 1, 0, /* -Release a keyboard grab made with `x-grab-keyboard'. -*/ - (device)) -{ - Display *dpy = get_x_display (device); - XUngrabKeyboard (dpy, CurrentTime); - return Qnil; -} - -DEFUN ("x-get-font-path", Fx_get_font_path, 0, 1, 0, /* -Get the X Server's font path. - -See also `x-set-font-path'. -*/ - (device)) -{ - Display *dpy = get_x_display (device); - int ndirs_return; - CONST char **directories = (CONST char **) XGetFontPath (dpy, &ndirs_return); - Lisp_Object font_path = Qnil; - - if (!directories) - signal_simple_error ("Can't get X font path", device); - - while (ndirs_return--) - font_path = Fcons (build_ext_string (directories[ndirs_return], - FORMAT_FILENAME), font_path); - - return font_path; -} - -DEFUN ("x-set-font-path", Fx_set_font_path, 1, 2, 0, /* -Set the X Server's font path to FONT-PATH. - -There is only one font path per server, not one per client. Use this -sparingly. It uncaches all of the X server's font information. - -Font directories should end in the path separator and should contain -a file called fonts.dir usually created with the program mkfontdir. - -Setting the FONT-PATH to nil tells the X server to use the default -font path. - -See also `x-get-font-path'. -*/ - (font_path, device)) -{ - Display *dpy = get_x_display (device); - Lisp_Object path_entry; - CONST char **directories; - int i=0,ndirs=0; - - EXTERNAL_LIST_LOOP (path_entry, font_path) - { - CHECK_STRING (XCAR (path_entry)); - ndirs++; - } - - directories = alloca_array (CONST char *, ndirs); - - EXTERNAL_LIST_LOOP (path_entry, font_path) - { - GET_C_STRING_FILENAME_DATA_ALLOCA (XCAR (path_entry), directories[i++]); - } - - expect_x_error (dpy); - XSetFontPath (dpy, (char **) directories, ndirs); - signal_if_x_error (dpy, 1/*resumable_p*/); - - return Qnil; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_device_x (void) -{ - DEFSUBR (Fx_debug_mode); - DEFSUBR (Fx_get_resource); - DEFSUBR (Fx_get_resource_prefix); - DEFSUBR (Fx_put_resource); - - DEFSUBR (Fdefault_x_device); - DEFSUBR (Fx_display_visual_class); - DEFSUBR (Fx_display_visual_depth); - DEFSUBR (Fx_server_vendor); - DEFSUBR (Fx_server_version); - DEFSUBR (Fx_valid_keysym_name_p); - DEFSUBR (Fx_keysym_hash_table); - DEFSUBR (Fx_keysym_on_keyboard_p); - DEFSUBR (Fx_keysym_on_keyboard_sans_modifiers_p); - - DEFSUBR (Fx_grab_pointer); - DEFSUBR (Fx_ungrab_pointer); - DEFSUBR (Fx_grab_keyboard); - DEFSUBR (Fx_ungrab_keyboard); - - DEFSUBR (Fx_get_font_path); - DEFSUBR (Fx_set_font_path); - - defsymbol (&Qx_error, "x-error"); - defsymbol (&Qinit_pre_x_win, "init-pre-x-win"); - defsymbol (&Qinit_post_x_win, "init-post-x-win"); -} - -void -console_type_create_device_x (void) -{ - CONSOLE_HAS_METHOD (x, init_device); - CONSOLE_HAS_METHOD (x, finish_init_device); - CONSOLE_HAS_METHOD (x, mark_device); - CONSOLE_HAS_METHOD (x, delete_device); - CONSOLE_HAS_METHOD (x, device_system_metrics); - - { - /* Initialize variables to speed up X resource interactions */ - CONST char *valid_resource_chars = - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_"; - while (*valid_resource_chars) - valid_resource_char_p[(unsigned int) (*valid_resource_chars++)] = 1; - - name_char_dynarr = Dynarr_new (char); - class_char_dynarr = Dynarr_new (char); - } -} - -void -vars_of_device_x (void) -{ - DEFVAR_LISP ("x-emacs-application-class", &Vx_emacs_application_class /* -The X application class of the XEmacs process. -This controls, among other things, the name of the `app-defaults' file -that XEmacs will use. For changes to this variable to take effect, they -must be made before the connection to the X server is initialized, that is, -this variable may only be changed before emacs is dumped, or by setting it -in the file lisp/term/x-win.el. - -If this variable is nil before the connection to the X server is first -initialized (which it is by default), the X resource database will be -consulted and the value will be set according to whether any resources -are found for the application class `XEmacs'. If the user has set any -resources for the XEmacs application class, the XEmacs process will use -the application class `XEmacs'. Otherwise, the XEmacs process will use -the application class `Emacs' which is backwards compatible to previous -XEmacs versions but may conflict with resources intended for GNU Emacs. -*/ ); - Vx_emacs_application_class = Qnil; - - DEFVAR_LISP ("x-initial-argv-list", &Vx_initial_argv_list /* -You don't want to know. -This is used during startup to communicate the remaining arguments in -`command-line-args-left' to the C code, which passes the args to -the X initialization code, which removes some args, and then the -args are placed back into `x-initial-arg-list' and thence into -`command-line-args-left'. Perhaps `command-line-args-left' should -just reside in C. -*/ ); - Vx_initial_argv_list = Qnil; - -#if defined(MULE) && (defined(LWLIB_MENUBARS_MOTIF) || defined(HAVE_XIM) || defined (USE_XFONTSET)) - DEFVAR_LISP ("x-app-defaults-directory", &Vx_app_defaults_directory /* -Used by the Lisp code to communicate to the low level X initialization -where the localized init files are. -*/ ); - Vx_app_defaults_directory = Qnil; -#endif - - Fprovide (Qx); - - staticpro (&Vdefault_x_device); - Vdefault_x_device = Qnil; - - error_expected = 0; - error_occurred = 0; - - in_resource_setting = 0; -} diff --git a/src/device.c b/src/device.c deleted file mode 100644 index 4c1feab..0000000 --- a/src/device.c +++ /dev/null @@ -1,1329 +0,0 @@ - /* Generic device functions. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing - -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. */ - -/* Original version by Chuck Thompson; - rewritten and expanded by Ben Wing. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "console.h" -#include "device.h" -#include "elhash.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "keymap.h" -#include "redisplay.h" -#include "specifier.h" -#include "sysdep.h" -#include "window.h" - -#ifdef HAVE_SCROLLBARS -#include "scrollbar.h" -#endif - -#include "syssignal.h" - -/* Vdefault_device is the firstly-created non-stream device that's still - around. We don't really use it anywhere currently, but it might - be used for resourcing at some point. (Currently we use - Vdefault_x_device.) */ -Lisp_Object Vdefault_device; - -Lisp_Object Vcreate_device_hook, Vdelete_device_hook; - -/* Device classes */ -/* Qcolor defined in general.c */ -Lisp_Object Qgrayscale, Qmono; - -/* Device metrics symbols */ -Lisp_Object - Qcolor_default, Qcolor_select, Qcolor_balloon, Qcolor_3d_face, - Qcolor_3d_light, Qcolor_3d_dark, Qcolor_menu, Qcolor_menu_highlight, - Qcolor_menu_button, Qcolor_menu_disabled, Qcolor_toolbar, - Qcolor_scrollbar, Qcolor_desktop, Qcolor_workspace, Qfont_default, - Qfont_menubar, Qfont_dialog, Qsize_cursor, Qsize_scrollbar, - Qsize_menu, Qsize_toolbar, Qsize_toolbar_button, - Qsize_toolbar_border, Qsize_icon, Qsize_icon_small, Qsize_device, - Qsize_workspace, Qsize_device_mm, Qdevice_dpi, Qnum_bit_planes, - Qnum_color_cells, Qmouse_buttons, Qswap_buttons, Qshow_sounds, - Qslow_device, Qsecurity; - -Lisp_Object Qdevicep, Qdevice_live_p; -Lisp_Object Qdelete_device; -Lisp_Object Qcreate_device_hook; -Lisp_Object Qdelete_device_hook; -Lisp_Object Vdevice_class_list; - - -static Lisp_Object -mark_device (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct device *d = XDEVICE (obj); - - markobj (d->name); - markobj (d->connection); - markobj (d->canon_connection); - markobj (d->console); - markobj (d->selected_frame); - markobj (d->frame_with_focus_real); - markobj (d->frame_with_focus_for_hooks); - markobj (d->frame_that_ought_to_have_focus); - markobj (d->device_class); - markobj (d->user_defined_tags); - markobj (d->pixel_to_glyph_cache.obj1); - markobj (d->pixel_to_glyph_cache.obj2); - - markobj (d->color_instance_cache); - markobj (d->font_instance_cache); -#ifdef MULE - markobj (d->charset_font_cache); -#endif - markobj (d->image_instance_cache); - - if (d->devmeths) - { - markobj (d->devmeths->symbol); - MAYBE_DEVMETH (d, mark_device, (d, markobj)); - } - - return (d->frame_list); -} - -static void -print_device (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct device *d = XDEVICE (obj); - char buf[256]; - - if (print_readably) - error ("printing unreadable object #", - XSTRING_DATA (d->name), d->header.uid); - - sprintf (buf, "#<%s-device", !DEVICE_LIVE_P (d) ? "dead" : - DEVICE_TYPE_NAME (d)); - write_c_string (buf, printcharfun); - if (DEVICE_LIVE_P (d)) - { - write_c_string (" on ", printcharfun); - print_internal (DEVICE_CONNECTION (d), printcharfun, 1); - } - sprintf (buf, " 0x%x>", d->header.uid); - write_c_string (buf, printcharfun); -} - -DEFINE_LRECORD_IMPLEMENTATION ("device", device, - mark_device, print_device, 0, 0, 0, - struct device); - -int -valid_device_class_p (Lisp_Object class) -{ - return !NILP (memq_no_quit (class, Vdevice_class_list)); -} - -DEFUN ("valid-device-class-p", Fvalid_device_class_p, 1, 1, 0, /* -Given a DEVICE-CLASS, return t if it is valid. -Valid classes are 'color, 'grayscale, and 'mono. -*/ - (device_class)) -{ - return valid_device_class_p (device_class) ? Qt : Qnil; -} - -DEFUN ("device-class-list", Fdevice_class_list, 0, 0, 0, /* -Return a list of valid device classes. -*/ - ()) -{ - return Fcopy_sequence (Vdevice_class_list); -} - -static struct device * -allocate_device (Lisp_Object console) -{ - Lisp_Object device; - struct device *d = alloc_lcrecord_type (struct device, lrecord_device); - struct gcpro gcpro1; - - zero_lcrecord (d); - - XSETDEVICE (device, d); - GCPRO1 (device); - - d->name = Qnil; - d->console = console; - d->connection = Qnil; - d->canon_connection = Qnil; - d->frame_list = Qnil; - d->selected_frame = Qnil; - d->frame_with_focus_real = Qnil; - d->frame_with_focus_for_hooks = Qnil; - d->frame_that_ought_to_have_focus = Qnil; - d->device_class = Qnil; - d->user_defined_tags = Qnil; - d->pixel_to_glyph_cache.obj1 = Qnil; - d->pixel_to_glyph_cache.obj2 = Qnil; - - d->infd = d->outfd = -1; - - /* #### is 20 reasonable? */ - d->color_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); - d->font_instance_cache = - make_lisp_hash_table (20, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQUAL); -#ifdef MULE - /* Note that the following table is bi-level. */ - d->charset_font_cache = - make_lisp_hash_table (20, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); -#endif - /* - Note that the image instance cache is actually bi-level. - See device.h. We use a low number here because most of the - time there aren't very many different masks that will be used. - */ - d->image_instance_cache = - make_lisp_hash_table (5, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - - UNGCPRO; - return d; -} - -struct device * -decode_device (Lisp_Object device) -{ - if (NILP (device)) - device = Fselected_device (Qnil); - /* quietly accept frames for the device arg */ - else if (FRAMEP (device)) - device = FRAME_DEVICE (decode_frame (device)); - CHECK_LIVE_DEVICE (device); - return XDEVICE (device); -} - -DEFUN ("dfw-device", Fdfw_device, 1, 1, 0, /* -Given a device, frame, or window, return the associated device. -Return nil otherwise. -*/ - (obj)) -{ - return DFW_DEVICE (obj); -} - - -DEFUN ("selected-device", Fselected_device, 0, 1, 0, /* -Return the device which is currently active. -If optional CONSOLE is non-nil, return the device that would be currently -active if CONSOLE were the selected console. -*/ - (console)) -{ - if (NILP (console) && NILP (Vselected_console)) - return Qnil; /* happens early in temacs */ - return CONSOLE_SELECTED_DEVICE (decode_console (console)); -} - -/* Called from selected_frame_1(), called from Fselect_window() */ -void -select_device_1 (Lisp_Object device) -{ - struct device *dev = XDEVICE (device); - Lisp_Object old_selected_device = Fselected_device (Qnil); - - if (EQ (device, old_selected_device)) - return; - - /* now select the device's console */ - CONSOLE_SELECTED_DEVICE (XCONSOLE (DEVICE_CONSOLE (dev))) = device; - select_console_1 (DEVICE_CONSOLE (dev)); -} - -DEFUN ("select-device", Fselect_device, 1, 1, 0, /* -Select the device DEVICE. -Subsequent editing commands apply to its console, selected frame, -and selected window. -The selection of DEVICE lasts until the next time the user does -something to select a different device, or until the next time this -function is called. -*/ - (device)) -{ - CHECK_LIVE_DEVICE (device); - - /* select the device's selected frame's selected window. This will call - selected_frame_1()->selected_device_1()->selected_console_1(). */ - if (!NILP (DEVICE_SELECTED_FRAME (XDEVICE (device)))) - Fselect_window (FRAME_SELECTED_WINDOW - (XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device)))), - Qnil); - else - error ("Can't select a device with no frames"); - return Qnil; -} - -void -set_device_selected_frame (struct device *d, Lisp_Object frame) -{ - if (!NILP (frame) && !FRAME_MINIBUF_ONLY_P (XFRAME (frame))) - set_console_last_nonminibuf_frame (XCONSOLE (DEVICE_CONSOLE (d)), frame); - d->selected_frame = frame; -} - -DEFUN ("set-device-selected-frame", Fset_device_selected_frame, 2, 2, 0, /* -Set the selected frame of device object DEVICE to FRAME. -If DEVICE is nil, the selected device is used. -If DEVICE is the selected device, this makes FRAME the selected frame. -*/ - (device, frame)) -{ - XSETDEVICE (device, decode_device (device)); - CHECK_LIVE_FRAME (frame); - - if (! EQ (device, FRAME_DEVICE (XFRAME (frame)))) - error ("In `set-device-selected-frame', FRAME is not on DEVICE"); - - if (EQ (device, Fselected_device (Qnil))) - return Fselect_frame (frame); - - set_device_selected_frame (XDEVICE (device), frame); - return frame; -} - -DEFUN ("devicep", Fdevicep, 1, 1, 0, /* -Return non-nil if OBJECT is a device. -*/ - (object)) -{ - return DEVICEP (object) ? Qt : Qnil; -} - -DEFUN ("device-live-p", Fdevice_live_p, 1, 1, 0, /* -Return non-nil if OBJECT is a device that has not been deleted. -*/ - (object)) -{ - return DEVICEP (object) && DEVICE_LIVE_P (XDEVICE (object)) ? Qt : Qnil; -} - -DEFUN ("device-name", Fdevice_name, 0, 1, 0, /* -Return the name of the specified device. -DEVICE defaults to the selected device if omitted. -*/ - (device)) -{ - return DEVICE_NAME (decode_device (device)); -} - -DEFUN ("device-connection", Fdevice_connection, 0, 1, 0, /* -Return the connection of the specified device. -DEVICE defaults to the selected device if omitted. -*/ - (device)) -{ - return DEVICE_CONNECTION (decode_device (device)); -} - -DEFUN ("device-console", Fdevice_console, 0, 1, 0, /* -Return the console of the specified device. -DEVICE defaults to the selected device if omitted. -*/ - (device)) -{ - return DEVICE_CONSOLE (decode_device (device)); -} - -#ifdef HAVE_WINDOW_SYSTEM - -static void -init_global_resources (struct device *d) -{ - init_global_faces (d); -#ifdef HAVE_SCROLLBARS - init_global_scrollbars (d); -#endif -#ifdef HAVE_TOOLBARS - init_global_toolbars (d); -#endif -} - -#endif - -static void -init_device_resources (struct device *d) -{ - init_device_faces (d); -#ifdef HAVE_SCROLLBARS - init_device_scrollbars (d); -#endif -#ifdef HAVE_TOOLBARS - init_device_toolbars (d); -#endif -} - -static Lisp_Object -semi_canonicalize_device_connection (struct console_methods *meths, - Lisp_Object name, Error_behavior errb) -{ - return CONTYPE_METH_OR_GIVEN (meths, semi_canonicalize_device_connection, - (name, errb), name); -} - -static Lisp_Object -canonicalize_device_connection (struct console_methods *meths, - Lisp_Object name, Error_behavior errb) -{ - return CONTYPE_METH_OR_GIVEN (meths, canonicalize_device_connection, - (name, errb), name); -} - -static Lisp_Object -find_device_of_type (struct console_methods *meths, Lisp_Object canon) -{ - Lisp_Object devcons, concons; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - Lisp_Object device = XCAR (devcons); - - if (EQ (CONMETH_TYPE (meths), DEVICE_TYPE (XDEVICE (device))) - && internal_equal (DEVICE_CANON_CONNECTION (XDEVICE (device)), - canon, 0)) - return device; - } - - return Qnil; -} - -DEFUN ("find-device", Ffind_device, 1, 2, 0, /* -Look for an existing device attached to connection CONNECTION. -Return the device if found; otherwise, return nil. - -If TYPE is specified, only return devices of that type; otherwise, -return devices of any type. (It is possible, although unlikely, -that two devices of different types could have the same connection -name; in such a case, the first device found is returned.) -*/ - (connection, type)) -{ - Lisp_Object canon = Qnil; - struct gcpro gcpro1; - - GCPRO1 (canon); - - if (!NILP (type)) - { - struct console_methods *conmeths = decode_console_type (type, ERROR_ME); - canon = canonicalize_device_connection (conmeths, connection, - ERROR_ME_NOT); - if (UNBOUNDP (canon)) - RETURN_UNGCPRO (Qnil); - - RETURN_UNGCPRO (find_device_of_type (conmeths, canon)); - } - else - { - int i; - - for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) - { - struct console_methods *conmeths = - Dynarr_at (the_console_type_entry_dynarr, i).meths; - canon = canonicalize_device_connection (conmeths, connection, - ERROR_ME_NOT); - if (!UNBOUNDP (canon)) - { - Lisp_Object device = find_device_of_type (conmeths, canon); - if (!NILP (device)) - RETURN_UNGCPRO (device); - } - } - - RETURN_UNGCPRO (Qnil); - } -} - -DEFUN ("get-device", Fget_device, 1, 2, 0, /* -Look for an existing device attached to connection CONNECTION. -Return the device if found; otherwise, signal an error. - -If TYPE is specified, only return devices of that type; otherwise, -return devices of any type. (It is possible, although unlikely, -that two devices of different types could have the same connection -name; in such a case, the first device found is returned.) -*/ - (connection, type)) -{ - Lisp_Object device = Ffind_device (connection, type); - if (NILP (device)) - { - if (NILP (type)) - signal_simple_error ("No such device", connection); - else - signal_simple_error_2 ("No such device", type, connection); - } - return device; -} - -static Lisp_Object -delete_deviceless_console (Lisp_Object console) -{ - if (NILP (XCONSOLE (console)->device_list)) - Fdelete_console (console, Qnil); - return Qnil; -} - -DEFUN ("make-device", Fmake_device, 2, 3, 0, /* -Return a new device of type TYPE, attached to connection CONNECTION. - -The valid values for CONNECTION are device-specific; however, -CONNECTION is generally a string. (Specifically, for X devices, -CONNECTION should be a display specification such as "foo:0", and -for TTY devices, CONNECTION should be the filename of a TTY device -file, such as "/dev/ttyp4", or nil to refer to XEmacs' standard -input/output.) - -PROPS, if specified, should be a plist of properties controlling -device creation. - -If CONNECTION specifies an already-existing device connection, that -device is simply returned; no new device is created, and PROPS -have no effect. -*/ - (type, connection, props)) -{ - /* This function can GC */ - struct device *d; - struct console *con; - Lisp_Object device = Qnil; - Lisp_Object console = Qnil; - Lisp_Object name = Qnil; - struct console_methods *conmeths; - int speccount = specpdl_depth(); - - struct gcpro gcpro1, gcpro2, gcpro3; -#ifdef HAVE_X_WINDOWS - /* #### icky-poo. If this is the first X device we are creating, - then retrieve the global face resources. We have to do it - here, at the same time as (or just before) the device face - resources are retrieved; specifically, it needs to be done - after the device has been created but before any frames have - been popped up or much anything else has been done. It's - possible for other devices to specify different global - resources (there's a property on each X server's root window - that holds some resources); tough luck for the moment. - - This is a nasty violation of device independence, but - there's not a whole lot I can figure out to do about it. - The real problem is that the concept of resources is not - generalized away from X. Similar resource-related - device-independence violations occur in faces.el. */ - int first_x_device = NILP (Vdefault_x_device) && EQ (type, Qx); -#endif - - GCPRO3 (device, console, name); - - conmeths = decode_console_type (type, ERROR_ME_NOT); - if (!conmeths) - signal_simple_error ("Invalid device type", type); - - device = Ffind_device (connection, type); - if (!NILP (device)) - RETURN_UNGCPRO (device); - - name = Fplist_get (props, Qname, Qnil); - - { - Lisp_Object conconnect = - (HAS_CONTYPE_METH_P (conmeths, device_to_console_connection)) ? - CONTYPE_METH (conmeths, device_to_console_connection, - (connection, ERROR_ME)) : - connection; - console = create_console (name, type, conconnect, props); - } - - record_unwind_protect(delete_deviceless_console, console); - - con = XCONSOLE (console); - d = allocate_device (console); - XSETDEVICE (device, d); - - d->devmeths = con->conmeths; - - DEVICE_NAME (d) = name; - DEVICE_CONNECTION (d) = - semi_canonicalize_device_connection (conmeths, connection, ERROR_ME); - DEVICE_CANON_CONNECTION (d) = - canonicalize_device_connection (conmeths, connection, ERROR_ME); - - MAYBE_DEVMETH (d, init_device, (d, props)); - - /* Do it this way so that the device list is in order of creation */ - con->device_list = nconc2 (con->device_list, Fcons (device, Qnil)); - RESET_CHANGED_SET_FLAGS; - if (NILP (Vdefault_device) || DEVICE_STREAM_P (XDEVICE (Vdefault_device))) - Vdefault_device = device; - - init_device_sound (d); -#ifdef HAVE_X_WINDOWS - if (first_x_device) - init_global_resources (d); -#endif - init_device_resources (d); - - MAYBE_DEVMETH (d, finish_init_device, (d, props)); - - /* If this is the first device on the console, make it the selected one. */ - if (NILP (CONSOLE_SELECTED_DEVICE (con))) - CONSOLE_SELECTED_DEVICE (con) = device; - - /* #### the following should trap errors. */ - setup_device_initial_specifier_tags (d); - - UNGCPRO; - unbind_to(speccount, Qnil); - return device; -} - -/* find a device other than the selected one. Prefer non-stream - devices over stream devices. Maybe stay on the same console. */ - -static Lisp_Object -find_other_device (Lisp_Object device, int on_same_console) -{ - Lisp_Object devcons = Qnil, concons; - Lisp_Object console = DEVICE_CONSOLE (XDEVICE (device)); - - /* look for a non-stream device */ - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - Lisp_Object dev = XCAR (devcons); - if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) - continue; - if (!DEVICE_STREAM_P (XDEVICE (dev)) && !EQ (dev, device) && - !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) - goto double_break_1; - } - - double_break_1: - if (!NILP (devcons)) - return XCAR (devcons); - - /* OK, now look for a stream device */ - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - Lisp_Object dev = XCAR (devcons); - if (on_same_console && !EQ (console, DEVICE_CONSOLE (XDEVICE (dev)))) - continue; - if (!EQ (dev, device) && !NILP (DEVICE_SELECTED_FRAME (XDEVICE (dev)))) - goto double_break_2; - } - double_break_2: - if (!NILP (devcons)) - return XCAR (devcons); - - /* Sorry, there ain't none */ - return Qnil; -} - -static int -find_nonminibuffer_frame_not_on_device_predicate (Lisp_Object frame, - void *closure) -{ - Lisp_Object device; - - VOID_TO_LISP (device, closure); - if (FRAME_MINIBUF_ONLY_P (XFRAME (frame))) - return 0; - if (EQ (device, FRAME_DEVICE (XFRAME (frame)))) - return 0; - return 1; -} - -Lisp_Object -find_nonminibuffer_frame_not_on_device (Lisp_Object device) -{ - return find_some_frame (find_nonminibuffer_frame_not_on_device_predicate, - LISP_TO_VOID (device)); -} - - -/* Delete device D. - - If FORCE is non-zero, allow deletion of the only frame. - - If CALLED_FROM_DELETE_CONSOLE is non-zero, then, if - deleting the last device on a console, just delete it, - instead of calling `delete-console'. - - If FROM_IO_ERROR is non-zero, then the device is gone due - to an I/O error. This affects what happens if we exit - (we do an emergency exit instead of `save-buffers-kill-emacs'.) -*/ - -void -delete_device_internal (struct device *d, int force, - int called_from_delete_console, - int from_io_error) -{ - /* This function can GC */ - struct console *c; - Lisp_Object device; - struct gcpro gcpro1; - - /* OK to delete an already-deleted device. */ - if (!DEVICE_LIVE_P (d)) - return; - - XSETDEVICE (device, d); - GCPRO1 (device); - - c = XCONSOLE (DEVICE_CONSOLE (d)); - - if (!called_from_delete_console) - { - int delete_console = 0; - /* If we're deleting the only device on the console, - delete the console. */ - if ((XINT (Flength (CONSOLE_DEVICE_LIST (c))) == 1) - /* if we just created the device, it might not be listed, - or something ... */ - && !NILP (memq_no_quit (device, CONSOLE_DEVICE_LIST (c)))) - delete_console = 1; - /* Or if there aren't any nonminibuffer frames that would be - left, delete the console (this will make XEmacs exit). */ - else if (NILP (find_nonminibuffer_frame_not_on_device (device))) - delete_console = 1; - - if (delete_console) - { - delete_console_internal (c, force, 0, from_io_error); - UNGCPRO; - return; - } - } - - reset_one_device (d); - - { - Lisp_Object frmcons; - - /* First delete all frames without their own minibuffers, - to avoid errors coming from attempting to delete a frame - that is a surrogate for another frame. */ - DEVICE_FRAME_LOOP (frmcons, d) - { - struct frame *f = XFRAME (XCAR (frmcons)); - /* delete_frame_internal() might do anything such as run hooks, - so be defensive. */ - if (FRAME_LIVE_P (f) && !FRAME_HAS_MINIBUF_P (f)) - delete_frame_internal (f, 1, 1, from_io_error); - - if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't - go ahead and delete anything */ - { - UNGCPRO; - return; - } - } - - /* #### This should probably be a device method but it is time for - 19.14 to go out the door. */ -#ifdef HAVE_X_WINDOWS - /* Next delete all frames which have the popup property to avoid - deleting a child after its parent. */ - DEVICE_FRAME_LOOP (frmcons, d) - { - struct frame *f = XFRAME (XCAR (frmcons)); - - if (FRAME_LIVE_P (f)) - { - Lisp_Object popup = Fframe_property (XCAR (frmcons), Qpopup, Qnil); - if (!NILP (popup)) - delete_frame_internal (f, 1, 1, from_io_error); - - if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't - go ahead and delete anything */ - { - UNGCPRO; - return; - } - } - } -#endif /* HAVE_X_WINDOWS */ - - DEVICE_FRAME_LOOP (frmcons, d) - { - struct frame *f = XFRAME (XCAR (frmcons)); - /* delete_frame_internal() might do anything such as run hooks, - so be defensive. */ - if (FRAME_LIVE_P (f)) - delete_frame_internal (f, 1, 1, from_io_error); - - if (!DEVICE_LIVE_P (d)) /* make sure the delete-*-hook didn't - go ahead and delete anything */ - { - UNGCPRO; - return; - } - } - } - - set_device_selected_frame (d, Qnil); - - /* try to select another device */ - - if (EQ (device, Fselected_device (DEVICE_CONSOLE (d)))) - { - Lisp_Object other_dev = find_other_device (device, 1); - if (!NILP (other_dev)) - Fselect_device (other_dev); - } - - if (EQ (device, Vdefault_device)) - Vdefault_device = find_other_device (device, 0); - - MAYBE_DEVMETH (d, delete_device, (d)); - - CONSOLE_DEVICE_LIST (c) = delq_no_quit (device, CONSOLE_DEVICE_LIST (c)); - RESET_CHANGED_SET_FLAGS; - d->devmeths = dead_console_methods; - UNGCPRO; -} - -/* delete a device as a result of an I/O error. Called from - an enqueued magic-eval event. */ - -void -io_error_delete_device (Lisp_Object device) -{ - /* Note: it's the console that should get deleted, but - delete_device_internal() contains a hack that also deletes the - console when called from this function. */ - delete_device_internal (XDEVICE (device), 1, 0, 1); -} - -DEFUN ("delete-device", Fdelete_device, 1, 2, 0, /* -Delete DEVICE, permanently eliminating it from use. -Normally, you cannot delete the last non-minibuffer-only frame (you must -use `save-buffers-kill-emacs' or `kill-emacs'). However, if optional -second argument FORCE is non-nil, you can delete the last frame. (This -will automatically call `save-buffers-kill-emacs'.) -*/ - (device, force)) -{ - CHECK_DEVICE (device); - delete_device_internal (XDEVICE (device), !NILP (force), 0, 0); - return Qnil; -} - -DEFUN ("device-frame-list", Fdevice_frame_list, 0, 1, 0, /* -Return a list of all frames on DEVICE. -If DEVICE is nil, the selected device will be used. -*/ - (device)) -{ - return Fcopy_sequence (DEVICE_FRAME_LIST (decode_device (device))); -} - -DEFUN ("device-class", Fdevice_class, 0, 1, 0, /* -Return the class (color behavior) of DEVICE. -This will be one of 'color, 'grayscale, or 'mono. -*/ - (device)) -{ - return DEVICE_CLASS (decode_device (device)); -} - -DEFUN ("set-device-class", Fset_device_class, 2, 2, 0, /* -Set the class (color behavior) of DEVICE. -CLASS should be one of 'color, 'grayscale, or 'mono. -This is only allowed on device such as TTY devices, where the color -behavior cannot necessarily be determined automatically. -*/ - (device, class)) -{ - struct device *d = decode_device (device); - XSETDEVICE (device, d); - if (!DEVICE_TTY_P (d)) - signal_simple_error ("Cannot change the class of this device", device); - if (!EQ (class, Qcolor) && !EQ (class, Qmono) && !EQ (class, Qgrayscale)) - signal_simple_error ("Must be color, mono, or grayscale", class); - if (! EQ (DEVICE_CLASS (d), class)) - { - Lisp_Object frmcons; - DEVICE_CLASS (d) = class; - DEVICE_FRAME_LOOP (frmcons, d) - { - struct frame *f = XFRAME (XCAR (frmcons)); - - recompute_all_cached_specifiers_in_frame (f); - MARK_FRAME_FACES_CHANGED (f); - MARK_FRAME_GLYPHS_CHANGED (f); - MARK_FRAME_SUBWINDOWS_CHANGED (f); - MARK_FRAME_TOOLBARS_CHANGED (f); - f->menubar_changed = 1; - } - } - return Qnil; -} - -DEFUN ("set-device-baud-rate", Fset_device_baud_rate, 2, 2, 0, /* -Set the output baud rate of DEVICE to RATE. -On most systems, changing this value will affect the amount of padding -and other strategic decisions made during redisplay. -*/ - (device, rate)) -{ - CHECK_INT (rate); - - DEVICE_BAUD_RATE (decode_device (device)) = XINT (rate); - - return rate; -} - -DEFUN ("device-baud-rate", Fdevice_baud_rate, 0, 1, 0, /* -Return the output baud rate of DEVICE. -*/ - (device)) -{ - return make_int (DEVICE_BAUD_RATE (decode_device (device))); -} - -DEFUN ("device-system-metric", Fdevice_system_metric, 1, 3, 0, /* -Get a metric for DEVICE as provided by the system. - -METRIC must be a symbol specifying requested metric. Note that the metrics -returned are these provided by the system internally, not read from resources, -so obtained from the most internal level. - -If a metric is not provided by the system, then DEFAULT is returned. - -When DEVICE is nil, selected device is assumed - -Metrics, by group, are: - -COLORS. Colors are returned as valid color instantiators. No other assumption -on the returned value should be made (i.e. it can be a string on one system but -a color instance on another). For colors, returned value is a cons of -foreground and background colors. Note that if the system provides only one -color of the pair, the second one may be nil. - -color-default Standard window text foreground and background. -color-select Selection highlight text and background colors. -color-balloon Balloon popup text and background colors. -color-3d-face 3-D object (button, modeline) text and surface colors. -color-3d-light Fore and back colors for 3-D edges facing light source. -color-3d-dark Fore and back colors for 3-D edges facing away from - light source. -color-menu Text and background for menus -color-menu-highlight Selected menu item colors -color-menu-button Menu button colors -color-menu-disabled Unselectable menu item colors -color-toolbar Toolbar foreground and background colors -color-scrollbar Scrollbar foreground and background colors -color-desktop Desktop window colors -color-workspace Workspace window colors - -FONTS. Fonts are returned as valid font instantiators. No other assumption on -the returned value should be made (i.e. it can be a string on one system but -font instance on another). - -font-default Default fixed width font. -font-menubar Menubar font -font-dialog Dialog boxes font - -GEOMETRY. These metrics are returned as conses of (X . Y). As with colors, -either car or cdr of the cons may be nil if the system does not provide one -of the corresponding dimensions. - -size-cursor Mouse cursor size. -size-scrollbar Scrollbars (WIDTH . HEIGHT) -size-menu Menubar height, as (nil . HEIGHT) -size-toolbar Toolbar width and height. -size-toolbar-button Toolbar button size. -size-toolbar-border Toolbar border width and height. -size-icon Icon dimensions. -size-icon-small Small icon dimensions. -size-device Device screen size in pixels. -size-workspace Workspace size in pixels. This can be less than the - above if window manager has decorations which - effectively shrink the area remaining for application - windows. -size-device-mm Device screen size in millimeters. -device-dpi Device resolution, in dots per inch. -num-bit-planes Integer, number of device bit planes. -num-color-cells Integer, number of device color cells. - -FEATURES. This group reports various device features. If a feature is -present, integer 1 (one) is returned, if it is not present, then integer -0 (zero) is returned. If the system is unaware of the feature, then -DEFAULT is returned. - -mouse-buttons Integer, number of mouse buttons, or zero if no mouse. -swap-buttons Non-zero if left and right mouse buttons are swapped. -show-sounds User preference for visual over audible bell. -slow-device Device is slow, avoid animation. -security Non-zero if user environment is secure. -*/ - (device, metric, default_)) -{ - struct device *d = decode_device (device); - enum device_metrics m; - Lisp_Object res; - - /* Decode metric */ -#define FROB(met) \ - else if (EQ (metric, Q##met)) \ - m = DM_##met - - if (0) - ; - FROB (color_default); - FROB (color_select); - FROB (color_balloon); - FROB (color_3d_face); - FROB (color_3d_light); - FROB (color_3d_dark); - FROB (color_menu); - FROB (color_menu_highlight); - FROB (color_menu_button); - FROB (color_menu_disabled); - FROB (color_toolbar); - FROB (color_scrollbar); - FROB (color_desktop); - FROB (color_workspace); - FROB (font_default); - FROB (font_menubar); - FROB (font_dialog); - FROB (size_cursor); - FROB (size_scrollbar); - FROB (size_menu); - FROB (size_toolbar); - FROB (size_toolbar_button); - FROB (size_toolbar_border); - FROB (size_icon); - FROB (size_icon_small); - FROB (size_device); - FROB (size_workspace); - FROB (size_device_mm); - FROB (device_dpi); - FROB (num_bit_planes); - FROB (num_color_cells); - FROB (mouse_buttons); - FROB (swap_buttons); - FROB (show_sounds); - FROB (slow_device); - FROB (security); - else - signal_simple_error ("Invalid device metric symbol", metric); - - res = DEVMETH_OR_GIVEN (d, device_system_metrics, (d, m), Qunbound); - return UNBOUNDP(res) ? default_ : res; - -#undef FROB -} - -DEFUN ("device-system-metrics", Fdevice_system_metrics, 0, 1, 0, /* -Get a property list of device metric for DEVICE. - -See `device-system-metric' for the description of available metrics. -DEVICE defaults to selected device when omitted. -*/ - (device)) -{ - struct device *d = decode_device (device); - Lisp_Object plist = Qnil, one_metric; - -#define FROB(m) \ - if (!UNBOUNDP ((one_metric = \ - DEVMETH_OR_GIVEN (d, device_system_metrics, \ - (d, DM_##m), Qunbound)))) \ - plist = Fcons (Q##m, Fcons (one_metric, plist)); - - FROB (color_default); - FROB (color_select); - FROB (color_balloon); - FROB (color_3d_face); - FROB (color_3d_light); - FROB (color_3d_dark); - FROB (color_menu); - FROB (color_menu_highlight); - FROB (color_menu_button); - FROB (color_menu_disabled); - FROB (color_toolbar); - FROB (color_scrollbar); - FROB (color_desktop); - FROB (color_workspace); - FROB (font_default); - FROB (font_menubar); - FROB (font_dialog); - FROB (size_cursor); - FROB (size_scrollbar); - FROB (size_menu); - FROB (size_toolbar); - FROB (size_toolbar_button); - FROB (size_toolbar_border); - FROB (size_icon); - FROB (size_icon_small); - FROB (size_device); - FROB (size_workspace); - FROB (size_device_mm); - FROB (device_dpi); - FROB (num_bit_planes); - FROB (num_color_cells); - FROB (mouse_buttons); - FROB (swap_buttons); - FROB (show_sounds); - FROB (slow_device); - FROB (security); - - return plist; - -#undef FROB -} - -Lisp_Object -domain_device_type (Lisp_Object domain) -{ - /* This cannot GC */ - assert (WINDOWP (domain) || FRAMEP (domain) - || DEVICEP (domain) || CONSOLEP (domain)); - - if (WINDOWP (domain)) - { - if (!WINDOW_LIVE_P (XWINDOW (domain))) - return Qdead; - domain = WINDOW_FRAME (XWINDOW (domain)); - } - if (FRAMEP (domain)) - { - if (!FRAME_LIVE_P (XFRAME (domain))) - return Qdead; - domain = FRAME_DEVICE (XFRAME (domain)); - } - if (DEVICEP (domain)) - { - if (!DEVICE_LIVE_P (XDEVICE (domain))) - return Qdead; - domain = DEVICE_CONSOLE (XDEVICE (domain)); - } - return CONSOLE_TYPE (XCONSOLE (domain)); -} - -/* - * Determine whether window system bases window geometry on character - * or pixel counts. - * Return non-zero for pixel-based geometry, zero for character-based. - */ -int -window_system_pixelated_geometry (Lisp_Object domain) -{ - /* This cannot GC */ - Lisp_Object winsy = domain_device_type (domain); - struct console_methods *meth = decode_console_type (winsy, ERROR_ME_NOT); - assert (meth); - return (MAYBE_INT_CONTYPE_METH (meth, device_implementation_flags, ()) - & XDEVIMPF_PIXEL_GEOMETRY); -} - -DEFUN ("domain-device-type", Fdomain_device_type, 0, 1, 0, /* -Return the device type symbol for a DOMAIN, e.g. 'x or 'tty. -DOMAIN can be either a window, frame, device or console. -*/ - (domain)) -{ - if (!WINDOWP (domain) && !FRAMEP (domain) - && !DEVICEP (domain) && !CONSOLEP (domain)) - signal_simple_error - ("Domain must be either a window, frame, device or console", domain); - - return domain_device_type (domain); -} - -void -handle_asynch_device_change (void) -{ - int i; - int old_asynch_device_change_pending = asynch_device_change_pending; - for (i = 0; i < Dynarr_length (the_console_type_entry_dynarr); i++) - { - if (Dynarr_at (the_console_type_entry_dynarr, i).meths-> - asynch_device_change_method) - (Dynarr_at (the_console_type_entry_dynarr, i).meths-> - asynch_device_change_method) (); - } - /* reset the flag to 0 unless another notification occurred while - we were processing this one. Block SIGWINCH during this - check to prevent a possible race condition. */ -#ifndef WINDOWSNT - EMACS_BLOCK_SIGNAL (SIGWINCH); -#endif - if (old_asynch_device_change_pending == asynch_device_change_pending) - asynch_device_change_pending = 0; -#ifndef WINDOWSNT - EMACS_UNBLOCK_SIGNAL (SIGWINCH); -#endif -} - -void -call_critical_lisp_code (struct device *d, Lisp_Object function, - Lisp_Object object) -{ - int old_gc_currently_forbidden = gc_currently_forbidden; - Lisp_Object old_inhibit_quit = Vinhibit_quit; - - /* There's no reason to bother doing specbinds here, because if - initialize-*-faces signals an error, emacs is going to crash - immediately. - */ - gc_currently_forbidden = 1; - Vinhibit_quit = Qt; - LOCK_DEVICE (d); - - /* But it's useful to have an error handler; otherwise an infinite - loop may result. */ - if (!NILP (object)) - call1_with_handler (Qreally_early_error_handler, function, object); - else - call0_with_handler (Qreally_early_error_handler, function); - - UNLOCK_DEVICE (d); - Vinhibit_quit = old_inhibit_quit; - gc_currently_forbidden = old_gc_currently_forbidden; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_device (void) -{ - DEFSUBR (Fvalid_device_class_p); - DEFSUBR (Fdevice_class_list); - - DEFSUBR (Fdfw_device); - DEFSUBR (Fselected_device); - DEFSUBR (Fselect_device); - DEFSUBR (Fset_device_selected_frame); - DEFSUBR (Fdevicep); - DEFSUBR (Fdevice_live_p); - DEFSUBR (Fdevice_name); - DEFSUBR (Fdevice_connection); - DEFSUBR (Fdevice_console); - DEFSUBR (Ffind_device); - DEFSUBR (Fget_device); - DEFSUBR (Fmake_device); - DEFSUBR (Fdelete_device); - DEFSUBR (Fdevice_frame_list); - DEFSUBR (Fdevice_class); - DEFSUBR (Fset_device_class); - DEFSUBR (Fdevice_system_metrics); - DEFSUBR (Fdevice_system_metric); - DEFSUBR (Fset_device_baud_rate); - DEFSUBR (Fdevice_baud_rate); - DEFSUBR (Fdomain_device_type); - - defsymbol (&Qdevicep, "devicep"); - defsymbol (&Qdevice_live_p, "device-live-p"); - defsymbol (&Qdelete_device, "delete-device"); - - defsymbol (&Qcreate_device_hook, "create-device-hook"); - defsymbol (&Qdelete_device_hook, "delete-device-hook"); - - /* Qcolor defined in general.c */ - defsymbol (&Qgrayscale, "grayscale"); - defsymbol (&Qmono, "mono"); - - /* Device metrics symbols */ - defsymbol (&Qcolor_default, "color-default"); - defsymbol (&Qcolor_select, "color-select"); - defsymbol (&Qcolor_balloon, "color-balloon"); - defsymbol (&Qcolor_3d_face, "color-3d-face"); - defsymbol (&Qcolor_3d_light, "color-3d-light"); - defsymbol (&Qcolor_3d_dark, "color-3d-dark"); - defsymbol (&Qcolor_menu, "color-menu"); - defsymbol (&Qcolor_menu_highlight, "color-menu-highlight"); - defsymbol (&Qcolor_menu_button, "color-menu-button"); - defsymbol (&Qcolor_menu_disabled, "color-menu-disabled"); - defsymbol (&Qcolor_toolbar, "color-toolbar"); - defsymbol (&Qcolor_scrollbar, "color-scrollbar"); - defsymbol (&Qcolor_desktop, "color-desktop"); - defsymbol (&Qcolor_workspace, "color-workspace"); - defsymbol (&Qfont_default, "font-default"); - defsymbol (&Qfont_menubar, "font-menubar"); - defsymbol (&Qfont_dialog, "font-dialog"); - defsymbol (&Qsize_cursor, "size-cursor"); - defsymbol (&Qsize_scrollbar, "size-scrollbar"); - defsymbol (&Qsize_menu, "size-menu"); - defsymbol (&Qsize_toolbar, "size-toolbar"); - defsymbol (&Qsize_toolbar_button, "size-toolbar-button"); - defsymbol (&Qsize_toolbar_border, "size-toolbar-border"); - defsymbol (&Qsize_icon, "size-icon"); - defsymbol (&Qsize_icon_small, "size-icon-small"); - defsymbol (&Qsize_device, "size-device"); - defsymbol (&Qsize_workspace, "size-workspace"); - defsymbol (&Qsize_device_mm, "size-device-mm"); - defsymbol (&Qnum_bit_planes, "num-bit-planes"); - defsymbol (&Qnum_color_cells, "num-color-cells"); - defsymbol (&Qdevice_dpi, "device-dpi"); - defsymbol (&Qmouse_buttons, "mouse-buttons"); - defsymbol (&Qswap_buttons, "swap-buttons"); - defsymbol (&Qshow_sounds, "show-sounds"); - defsymbol (&Qslow_device, "slow-device"); - defsymbol (&Qsecurity, "security"); -} - -void -vars_of_device (void) -{ - DEFVAR_LISP ("create-device-hook", &Vcreate_device_hook /* -Function or functions to call when a device is created. -One argument, the newly-created device. -This is called after the first frame has been created, but before - calling the `create-frame-hook'. -Note that in general the device will not be selected. -*/ ); - Vcreate_device_hook = Qnil; - - DEFVAR_LISP ("delete-device-hook", &Vdelete_device_hook /* -Function or functions to call when a device is deleted. -One argument, the to-be-deleted device. -*/ ); - Vdelete_device_hook = Qnil; - - staticpro (&Vdefault_device); - Vdefault_device = Qnil; - - asynch_device_change_pending = 0; - - Vdevice_class_list = list3 (Qcolor, Qgrayscale, Qmono); - staticpro (&Vdevice_class_list); - - /* Death to devices.el !!! */ - Fprovide(intern("devices")); -} diff --git a/src/device.h b/src/device.h deleted file mode 100644 index aad12fd..0000000 --- a/src/device.h +++ /dev/null @@ -1,408 +0,0 @@ -/* Define device-object for XEmacs. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Ben Wing - Copyright (C) 1995 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 Chuck Thompson and Ben Wing. */ - -#ifndef _XEMACS_DEVICE_H_ -#define _XEMACS_DEVICE_H_ - -#include "console.h" - -/* This should really be in redisplay.h but by putting it here we - won't have to ensure that redisplay.h is always included before - this file. */ -struct pixel_to_glyph_translation_cache -{ - unsigned int valid :1; - struct frame *frame; - int low_x_coord, high_x_coord, col, obj_x; - int low_y_coord, high_y_coord, row, obj_y; - struct window *w; - Bufpos bufpos; - Bufpos closest; - Charcount modeline_closest; - Lisp_Object obj1, obj2; - int retval; -}; - -#define DEVICE_TYPE_NAME(d) ((d)->devmeths->name) -#define DEVICE_TYPE(d) ((d)->devmeths->symbol) -#define DEVICE_SPECIFIC_FRAME_PROPS(d) \ - ((d)->devmeths->device_specific_frame_props) - -/******** Accessing / calling a device method *********/ - -#define HAS_DEVMETH_P(d, m) HAS_CONTYPE_METH_P ((d)->devmeths, m) -#define DEVMETH(d, m, args) CONTYPE_METH ((d)->devmeths, m, args) -#define MAYBE_DEVMETH(d, m, args) MAYBE_CONTYPE_METH ((d)->devmeths, m, args) -#define DEVMETH_OR_GIVEN(d, m, args, given) \ - CONTYPE_METH_OR_GIVEN((d)->devmeths, m, args, given) -#define MAYBE_INT_DEVMETH(d, m, args) \ - MAYBE_INT_CONTYPE_METH ((d)->devmeths, m, args) -#define MAYBE_LISP_DEVMETH(d, m, args) \ - MAYBE_LISP_CONTYPE_METH ((d)->devmeths, m, args) - -struct device -{ - struct lcrecord_header header; - - /* Methods for this device's console. This can also be retrieved - through device->console, but it's faster this way. */ - struct console_methods *devmeths; - - /* Name of this device, for resourcing and printing purposes. - If not explicitly given, it's initialized in a device-specific - manner. */ - Lisp_Object name; - - /* What this device is connected to */ - Lisp_Object connection; - - /* A canonical name for the connection that is used to determine - whether `make-device' is being called on an existing device. */ - Lisp_Object canon_connection; - - /* List of frames on this device. */ - Lisp_Object frame_list; - - /* The console this device is on. */ - Lisp_Object console; - - /* Frame which is "currently selected". This is what `selected-frame' - returns and is the default frame for many operations. This may - not be the same as frame_with_focus; `select-frame' changes the - selected_frame but not the frame_with_focus. However, eventually - either the two values will be the same, or frame_with_focus will - be nil: right before waiting for an event, the focus is changed - to point to the selected_frame if XEmacs currently has the focus - on this device. Note that frame_with_focus may be nil (none of the - frames on this device have the window-system focus), but - selected_frame will never be nil if there are any frames on - the device. */ - Lisp_Object selected_frame; - /* Frame that currently contains the window-manager focus, or none. - Note that we've split frame_with_focus into two variables. - frame_with_focus_real is the value we use most of the time, - but frame_with_focus_for_hooks is used for running the select-frame-hook - and deselect-frame-hook. We do this because we split the focus handling - into two parts: one part (deals with drawing the solid/box cursor) - runs as soon as a focus event is received; the other (running the - hooks) runs after any pending sit-for/sleep-for/accept-process-output - calls are done. */ - Lisp_Object frame_with_focus_real; - Lisp_Object frame_with_focus_for_hooks; - /* If we have recently issued a request to change the focus as a - result of select-frame having been called, the following variable - records the frame we are trying to focus on. The reason for this - is that the window manager may not grant our request to change - the focus (so we can't just change frame_with_focus), and we don't - want to keep sending requests again and again to the window manager. - This variable is reset whenever a focus-change event is seen. */ - Lisp_Object frame_that_ought_to_have_focus; - - /* Color class of this device. */ - Lisp_Object device_class; - - /* Alist of values for user-defined tags in this device. */ - Lisp_Object user_defined_tags; - - /* Hash tables for device-specific objects (fonts, colors, etc). - These are key-weak hash tables (or hash tables containing key-weak - hash tables) so that they disappear when the key goes away. */ - - /* This is a simple key-weak hash table hashing color names to - instances. */ - Lisp_Object color_instance_cache; - - /* This is a simple key-weak hash table hashing font names to - instances. */ - Lisp_Object font_instance_cache; - -#ifdef MULE - /* This is a bi-level cache, where the hash table in this slot here - indexes charset objects to key-weak hash tables, which in turn - index font names to more specific font names that match the - given charset's registry. This speeds up the horrendously - slow XListFonts() operation that needs to be done in order - to determine an appropriate font. */ - Lisp_Object charset_font_cache; -#endif - - /* This is a bi-level cache, where the hash table in this slot here - indexes image-instance-type masks (there are currently 6 - image-instance types and thus 64 possible masks) to key-weak hash - tables like the one for colors. */ - Lisp_Object image_instance_cache; - - /* A structure of auxiliary data specific to the device type. - struct x_device is used for X window frames; defined in console-x.h - struct tty_device is used to TTY's; defined in console-tty.h */ - void *device_data; - - /* redisplay flags */ - unsigned int buffers_changed :1; - unsigned int clip_changed :1; - unsigned int extents_changed :1; - unsigned int faces_changed :1; - unsigned int frame_changed :1; - unsigned int glyphs_changed :1; - unsigned int subwindows_changed :1; - unsigned int icon_changed :1; - unsigned int menubar_changed :1; - unsigned int modeline_changed :1; - unsigned int point_changed :1; - unsigned int size_changed :1; - unsigned int toolbar_changed :1; - unsigned int windows_changed :1; - unsigned int windows_structure_changed :1; - - unsigned int locked :1; - - /* Cache information about last pixel position translated to a - glyph. The law of locality applies very heavily here so caching - the value leads to a significant win. At the moment this is - really X specific but once we have generic mouse support it won't - be. */ - struct pixel_to_glyph_translation_cache pixel_to_glyph_cache; - - /* Output baud rate of device; used for redisplay decisions. */ - int baud_rate; - - /* sound flags */ - unsigned int on_console_p :1; - unsigned int connected_to_nas_p :1; - - - /* File descriptors for input and output. Much of the time - (but not always) these will be the same. For an X device, - these both hold the file descriptor of the socket used - to communicate with the X server. For a TTY device, these - may or may not be the same and point to the terminal that - is used for I/O. */ - int infd, outfd; - - /* infd and outfd are moved outside HAVE_UNIXOID_EVENT_LOOP conditionals, - because Win32, presumably the first port which does not use select() - polling, DOES have handles for a console device. -- kkm */ - -#ifdef HAVE_UNIXOID_EVENT_LOOP - /* holds some data necessary for SIGIO control. Perhaps this should - be inside of device_data; but it is used for both TTY's and X - device. Perhaps it should be conditionalized on SIGIO; but - this requires including syssignal.h and systty.h. */ - int old_fcntl_owner; -#endif -}; - -DECLARE_LRECORD (device, struct device); -#define XDEVICE(x) XRECORD (x, device, struct device) -#define XSETDEVICE(x, p) XSETRECORD (x, p, device) -#define DEVICEP(x) RECORDP (x, device) -#define GC_DEVICEP(x) GC_RECORDP (x, device) -#define CHECK_DEVICE(x) CHECK_RECORD (x, device) -#define CONCHECK_DEVICE(x) CONCHECK_RECORD (x, device) - -#define CHECK_LIVE_DEVICE(x) do { \ - CHECK_DEVICE (x); \ - if (! DEVICE_LIVE_P (XDEVICE (x))) \ - dead_wrong_type_argument (Qdevice_live_p, (x)); \ -} while (0) -#define CONCHECK_LIVE_DEVICE(x) do { \ - CONCHECK_DEVICE (x); \ - if (! DEVICE_LIVE_P (XDEVICE (x))) \ - x = wrong_type_argument (Qdevice_live_p, (x)); \ -} while (0) - -#define DEVICE_TYPE_P(d, type) EQ (DEVICE_TYPE (d), Q##type) - -#ifdef ERROR_CHECK_TYPECHECK -INLINE struct device * -error_check_device_type (struct device *d, Lisp_Object sym); -INLINE struct device * -error_check_device_type (struct device *d, Lisp_Object sym) -{ - assert (EQ (DEVICE_TYPE (d), sym)); - return d; -} -# define DEVICE_TYPE_DATA(d, type) \ - ((struct type##_device *) (error_check_device_type (d, Q##type))->device_data) -#else -# define DEVICE_TYPE_DATA(d, type) \ - ((struct type##_device *) (d)->device_data) -#endif - -#define CHECK_DEVICE_TYPE(x, type) \ - do { \ - CHECK_DEVICE (x); \ - if (!(DEVICEP (x) && DEVICE_TYPE_P (XDEVICE (x), \ - type))) \ - dead_wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ - } while (0) -#define CONCHECK_DEVICE_TYPE(x, type) \ - do { \ - CONCHECK_DEVICE (x); \ - if (!(DEVICEP (x) && DEVICE_TYPE_P (XDEVICE (x), \ - type))) \ - x = wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ - } while (0) - -/* #### These should be in the device-*.h files but there are - too many places where the abstraction is broken. Need to - fix. */ - -#define DEVICE_X_P(dev) CONSOLE_TYPESYM_X_P (DEVICE_TYPE (dev)) -#define CHECK_X_DEVICE(z) CHECK_DEVICE_TYPE (z, x) -#define CONCHECK_X_DEVICE(z) CONCHECK_DEVICE_TYPE (z, x) - -#define DEVICE_MSWINDOWS_P(dev) CONSOLE_TYPESYM_MSWINDOWS_P (DEVICE_TYPE (dev)) -#define CHECK_MSWINDOWS_DEVICE(z) CHECK_DEVICE_TYPE (z, mswindows) -#define CONCHECK_MSWINDOWS_DEVICE(z) CONCHECK_DEVICE_TYPE (z, mswindows) - -#define DEVICE_TTY_P(dev) CONSOLE_TYPESYM_TTY_P (DEVICE_TYPE (dev)) -#define CHECK_TTY_DEVICE(z) CHECK_DEVICE_TYPE (z, tty) -#define CONCHECK_TTY_DEVICE(z) CONCHECK_DEVICE_TYPE (z, tty) - -#define DEVICE_STREAM_P(dev) CONSOLE_TYPESYM_STREAM_P (DEVICE_TYPE (dev)) -#define CHECK_STREAM_DEVICE(z) CHECK_DEVICE_TYPE (z, stream) -#define CONCHECK_STREAM_DEVICE(z) CONCHECK_DEVICE_TYPE (z, stream) - -#define DEVICE_WIN_P(dev) CONSOLE_TYPESYM_WIN_P (DEVICE_TYPE (dev)) - -EXFUN (Fdevice_console, 1); -EXFUN (Fdevice_name, 1); -EXFUN (Fmake_device, 3); -EXFUN (Fselected_device, 1); - -extern Lisp_Object Qcreate_device_hook, Qdelete_device_hook, Qgrayscale; -extern Lisp_Object Qinit_post_tty_win, Qmono, Vdefault_x_device; -extern Lisp_Object Vdevice_class_list; - -int valid_device_class_p (Lisp_Object class); - -#define DEVICE_LIVE_P(d) (!EQ (DEVICE_TYPE (d), Qdead)) - -#define DEVICE_REDISPLAY_INFO(d) ((d)->redisplay_info) - -#define DEVICE_NAME(d) ((d)->name) -#define DEVICE_CLASS(d) ((d)->device_class) -/* Catch people attempting to set this. */ -#define DEVICE_SELECTED_FRAME(d) NON_LVALUE ((d)->selected_frame) -#define DEVICE_FRAME_WITH_FOCUS_REAL(d) ((d)->frame_with_focus_real) -#define DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS(d) ((d)->frame_with_focus_for_hooks) -#define DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS(d) \ - ((d)->frame_that_ought_to_have_focus) -#define DEVICE_USER_DEFINED_TAGS(d) ((d)->user_defined_tags) -#define DEVICE_FRAME_LIST(d) ((d)->frame_list) -#define DEVICE_CONNECTION(d) ((d)->connection) -#define DEVICE_CANON_CONNECTION(d) ((d)->canon_connection) -#define DEVICE_CONSOLE(d) ((d)->console) -#define DEVICE_BAUD_RATE(d) ((d)->baud_rate) -#define DEVICE_INFD(d) ((d)->infd) -#define DEVICE_OUTFD(d) ((d)->outfd) -#define DEVICE_OLD_FCNTL_OWNER(d) ((d)->old_fcntl_owner) -#define DEVICE_ON_CONSOLE_P(d) ((d)->on_console_p) -#define DEVICE_CONNECTED_TO_NAS_P(d) ((d)->connected_to_nas_p) - -#define LOCK_DEVICE(d) ((void) ((d)->locked = 1)) -#define UNLOCK_DEVICE(d) ((void) ((d)->locked = 0)) - -#define INVALIDATE_DEVICE_PIXEL_TO_GLYPH_CACHE(d) \ - ((void) ((d)->pixel_to_glyph_cache.valid = 0)) - -#define INVALIDATE_PIXEL_TO_GLYPH_CACHE do { \ - Lisp_Object IPTGC_devcons, IPTGC_concons; \ - DEVICE_LOOP_NO_BREAK (IPTGC_devcons, IPTGC_concons) \ - INVALIDATE_DEVICE_PIXEL_TO_GLYPH_CACHE (XDEVICE (XCAR (IPTGC_devcons))); \ -} while (0) - -#define MARK_DEVICE_FACES_CHANGED(d) \ - ((void) (faces_changed = (d)->faces_changed = 1)) - -#define MARK_DEVICE_GLYPHS_CHANGED(d) \ - ((void) (glyphs_changed = (d)->glyphs_changed = 1)) - -#define MARK_DEVICE_SUBWINDOWS_CHANGED(d) \ - ((void) (subwindows_changed = (d)->subwindows_changed = 1)) - -#define MARK_DEVICE_TOOLBARS_CHANGED(d) \ - ((void) (toolbar_changed = (d)->toolbar_changed = 1)) - -#define MARK_DEVICE_SIZE_CHANGED(d) \ - ((void) (size_changed = (d)->size_changed = 1)) - -#define MARK_DEVICE_FRAMES_FACES_CHANGED(d) do { \ - struct device *mdffc_d = (d); \ - Lisp_Object frmcons; \ - DEVICE_FRAME_LOOP (frmcons, mdffc_d) \ - XFRAME (XCAR (frmcons))->faces_changed = 1; \ - MARK_DEVICE_FACES_CHANGED (mdffc_d); \ -} while (0) - -#define MARK_DEVICE_FRAME_CHANGED(d) \ - ((void) (frame_changed = (d)->frame_changed = 1)) - -#define MARK_DEVICE_WINDOWS_CHANGED(d) \ - ((void) (windows_changed = (d)->windows_changed = 1)) - -#define MARK_DEVICE_WINDOWS_STRUCTURE_CHANGED(d) \ - ((void) (windows_structure_changed = (d)->windows_structure_changed = 1)) - -/* This turns out to be used heavily so we make it a macro to make it - inline. Also, the majority of the time the object will turn out to - be a window so we move it from being checked last to being checked - first. */ -#define DFW_DEVICE(obj) \ - (WINDOWP (obj) ? WINDOW_DEVICE (XWINDOW (obj)) \ - : (FRAMEP (obj) ? FRAME_DEVICE (XFRAME (obj)) \ - : (DEVICEP (obj) ? obj \ - : Qnil))) - -/* NO_BREAK means that "break" doesn't do what you think it does! - Use goto instead. "continue" is OK, though. */ -#define DEVICE_LOOP_NO_BREAK(devcons, concons) \ - CONSOLE_LOOP (concons) \ - CONSOLE_DEVICE_LOOP (devcons, XCONSOLE (XCAR (concons))) -#define DEVICE_FRAME_LOOP(frmcons, d) \ - LIST_LOOP (frmcons, DEVICE_FRAME_LIST (d)) -#define CONSOLE_FRAME_LOOP_NO_BREAK(frmcons, devcons, con) \ - CONSOLE_DEVICE_LOOP (devcons, con) \ - DEVICE_FRAME_LOOP (frmcons, XDEVICE (XCAR (devcons))) - -void select_device_1 (Lisp_Object); -struct device *decode_device (Lisp_Object); -void handle_asynch_device_change (void); -void call_critical_lisp_code (struct device *d, Lisp_Object function, - Lisp_Object object); -void delete_device_internal (struct device *d, int force, - int called_from_delete_console, - int from_io_error); -void io_error_delete_device (Lisp_Object device); -Lisp_Object find_nonminibuffer_frame_not_on_device (Lisp_Object device); -void set_device_selected_frame (struct device *d, Lisp_Object frame); -Lisp_Object domain_device_type (Lisp_Object domain); -int window_system_pixelated_geometry (Lisp_Object domain); - -#endif /* _XEMACS_DEVICE_H_ */ diff --git a/src/dgif_lib.c b/src/dgif_lib.c deleted file mode 100644 index b53b85e..0000000 --- a/src/dgif_lib.c +++ /dev/null @@ -1,965 +0,0 @@ -/****************************************************************************** -* "Gif-Lib" - Yet another gif library. * -* * -* Written by: Gershon Elber IBM PC Ver 1.1, Aug. 1990 * -******************************************************************************* -* The kernel of the GIF Decoding process can be found here. * -******************************************************************************* -* History: * -* 16 Jun 89 - Version 1.0 by Gershon Elber. * -* 3 Sep 90 - Version 1.1 by Gershon Elber (Support for Gif89, Unique names). * -* 19 Feb 98 - Version 1.2 by Jareth Hein (Support for user specified I/O) * -******************************************************************************/ - -#ifdef __MSDOS__ -#include -#include -#include -#include -#else -#include -#include -#endif /* __MSDOS__ */ - -#include -#include -#include - -#ifdef HAVE_FCNTL_H -#include -#endif - -#include "gifrlib.h" - -#define PROGRAM_NAME "GIFLIB" - - -static void DGifGetWord(GifFileType *GifFile, int *Word); -static void DGifSetupDecompress(GifFileType *GifFile); -static void DGifDecompressLine(GifFileType *GifFile, GifPixelType *Line, - int LineLen); -static int DGifGetPrefixChar(unsigned int *Prefix, int Code, int ClearCode); -static void DGifDecompressInput(GifFileType *GifFile, int *Code); -static void DGifBufferedInput(GifFileType *GifFile, GifByteType *NextByte); - -/****************************************************************************** -* Open a new gif file for read, given by its name. * -* Returns GifFileType pointer dynamically allocated which serves as the gif * -* info record. * -******************************************************************************/ -void DGifOpenFileName(GifFileType *GifFile, const char *FileName) -{ - FILE *f; - - if ((f = fopen(FileName, -#ifdef __MSDOS__ - "rb" -#else - "r" -#endif /* __MSDOS__ */ - )) == NULL) - GifInternError(GifFile, D_GIF_ERR_OPEN_FAILED); - - GifStdIOInit(GifFile, f, -1); - DGifInitRead(GifFile); -} - -/****************************************************************************** -* Update a new gif file, given its file handle. * -* Returns GifFileType pointer dynamically allocated which serves as the gif * -* info record. * -******************************************************************************/ -void DGifOpenFileHandle(GifFileType *GifFile, int FileHandle) -{ - FILE *f; - -#ifdef __MSDOS__ - setmode(FileHandle, O_BINARY); /* Make sure it is in binary mode. */ - f = fdopen(FileHandle, "rb"); /* Make it into a stream: */ - setvbuf(f, NULL, _IOFBF, GIF_FILE_BUFFER_SIZE);/* And inc. stream buffer.*/ -#else - f = fdopen(FileHandle, "r"); /* Make it into a stream: */ -#endif /* __MSDOS__ */ - - GifStdIOInit(GifFile, f, -1); - DGifInitRead(GifFile); -} - -/****************************************************************************** -* Update a new gif file, given its file handle. * -* Returns GifFileType pointer dynamically allocated which serves as the gif * -* info record. _GifError is cleared if succesfull. * -******************************************************************************/ -void DGifInitRead(GifFileType *GifFile) -{ - GifByteType Buf[GIF_STAMP_LEN+1]; - GifFilePrivateType *Private; - - if ((Private = (GifFilePrivateType *) malloc(sizeof(GifFilePrivateType))) - == NULL) { - GifInternError(GifFile, D_GIF_ERR_NOT_ENOUGH_MEM); - } - memset(Private, '\0', sizeof(GifFilePrivateType)); - GifFile->Private = (VoidPtr) Private; - - Private->FileState = 0; /* Make sure bit 0 = 0 (File open for read). */ - - /* Lets see if this is a GIF file: */ - GifRead(Buf, GIF_STAMP_LEN, GifFile); - - /* The GIF Version number is ignored at this time. Maybe we should do */ - /* something more useful with it. */ - Buf[GIF_STAMP_LEN] = 0; - if (strncmp(GIF_STAMP, (const char *) Buf, GIF_VERSION_POS) != 0) { - GifInternError(GifFile, D_GIF_ERR_NOT_GIF_FILE); - } - - DGifGetScreenDesc(GifFile); -} - -/****************************************************************************** -* This routine should be called before any other DGif calls. Note that * -* this routine is called automatically from DGif file open routines. * -******************************************************************************/ -void DGifGetScreenDesc(GifFileType *GifFile) -{ - int i, BitsPerPixel; - GifByteType Buf[3]; - GifFilePrivateType *Private = (GifFilePrivateType*) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - /* Put the screen descriptor into the file: */ - DGifGetWord(GifFile, &GifFile->SWidth); - DGifGetWord(GifFile, &GifFile->SHeight); - - GifRead(Buf, 3, GifFile); - GifFile->SColorResolution = (((Buf[0] & 0x70) + 1) >> 4) + 1; - BitsPerPixel = (Buf[0] & 0x07) + 1; - GifFile->SBackGroundColor = Buf[1]; - if (Buf[0] & 0x80) { /* Do we have global color map? */ - - GifFile->SColorMap = MakeMapObject(1 << BitsPerPixel, NULL); - - /* Get the global color map: */ - for (i = 0; i < GifFile->SColorMap->ColorCount; i++) { - GifRead(Buf, 3, GifFile); - GifFile->SColorMap->Colors[i].Red = Buf[0]; - GifFile->SColorMap->Colors[i].Green = Buf[1]; - GifFile->SColorMap->Colors[i].Blue = Buf[2]; - } - } else { - /* We should always have a colormap */ - GifFile->SColorMap = MakeMapObject(2, NULL); - GifFile->SColorMap->Colors[0].Red = 0; - GifFile->SColorMap->Colors[0].Green = 0; - GifFile->SColorMap->Colors[0].Blue = 0; - GifFile->SColorMap->Colors[1].Red = 0xff; - GifFile->SColorMap->Colors[1].Green = 0xff; - GifFile->SColorMap->Colors[1].Blue = 0xff; - } -} - -/****************************************************************************** -* This routine should be called before any attemp to read an image. * -******************************************************************************/ -void DGifGetRecordType(GifFileType *GifFile, GifRecordType *Type) -{ - GifByteType Buf; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - GifRead(&Buf, 1, GifFile); - - switch (Buf) { - case ',': - *Type = IMAGE_DESC_RECORD_TYPE; - break; - case '!': - *Type = EXTENSION_RECORD_TYPE; - break; - case ';': - *Type = TERMINATE_RECORD_TYPE; - break; - default: - *Type = UNDEFINED_RECORD_TYPE; - GifInternError(GifFile, D_GIF_ERR_WRONG_RECORD); - } -} - -/****************************************************************************** -* This routine should be called before any attemp to read an image. * -* Note it is assumed the Image desc. header (',') has been read. * -******************************************************************************/ -void DGifGetImageDesc(GifFileType *GifFile) -{ - int i, BitsPerPixel; - GifByteType Buf[3]; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - DGifGetWord(GifFile, &GifFile->Image.Left); - DGifGetWord(GifFile, &GifFile->Image.Top); - DGifGetWord(GifFile, &GifFile->Image.Width); - DGifGetWord(GifFile, &GifFile->Image.Height); - - GifRead(Buf, 1, GifFile); - BitsPerPixel = (Buf[0] & 0x07) + 1; - GifFile->Image.Interlace = (Buf[0] & 0x40); - if (Buf[0] & 0x80) { /* Does this image have local color map? */ - - if (GifFile->Image.ColorMap && GifFile->SavedImages == NULL) - FreeMapObject(GifFile->Image.ColorMap); - - GifFile->Image.ColorMap = MakeMapObject(1 << BitsPerPixel, NULL); - - /* Get the image local color map: */ - for (i = 0; i < GifFile->Image.ColorMap->ColorCount; i++) { - GifRead(Buf, 3, GifFile); - GifFile->Image.ColorMap->Colors[i].Red = Buf[0]; - GifFile->Image.ColorMap->Colors[i].Green = Buf[1]; - GifFile->Image.ColorMap->Colors[i].Blue = Buf[2]; - } - } - - if (GifFile->SavedImages) { - SavedImage *sp; - - if ((GifFile->SavedImages = (SavedImage *)realloc(GifFile->SavedImages, - sizeof(SavedImage) * (GifFile->ImageCount + 1))) == NULL) { - GifInternError(GifFile, D_GIF_ERR_NOT_ENOUGH_MEM); - } - - sp = &GifFile->SavedImages[GifFile->ImageCount]; - memcpy(&sp->ImageDesc, &GifFile->Image, sizeof(GifImageDesc)); - if (GifFile->Image.ColorMap) - { - sp->ImageDesc.ColorMap = - MakeMapObject (GifFile->Image.ColorMap->ColorCount, - GifFile->Image.ColorMap->Colors); - } - sp->RasterBits = NULL; - sp->ExtensionBlockCount = 0; - sp->ExtensionBlocks = (ExtensionBlock *)NULL; - } - - GifFile->ImageCount++; - - Private->PixelCount = (long) GifFile->Image.Width * - (long) GifFile->Image.Height; - - DGifSetupDecompress(GifFile); /* Reset decompress algorithm parameters. */ -} - -/****************************************************************************** -* Get one full scanned line (Line) of length LineLen from GIF file. * -******************************************************************************/ -void DGifGetLine(GifFileType *GifFile, GifPixelType *Line, int LineLen) -{ - GifByteType *Dummy; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - if (!LineLen) LineLen = GifFile->Image.Width; - -#if defined(__MSDOS__) || defined(__GNUC__) - if ((Private->PixelCount -= LineLen) > 0xffff0000UL) -#else - if ((Private->PixelCount -= LineLen) > 0xffff0000) -#endif /* __MSDOS__ */ - { - GifInternError(GifFile, D_GIF_ERR_DATA_TOO_BIG); - } - - DGifDecompressLine(GifFile, Line, LineLen); - if (Private->PixelCount == 0) { - /* We probably would not be called any more, so lets clean */ - /* everything before we return: need to flush out all rest of */ - /* image until empty block (size 0) detected. We use GetCodeNext.*/ - do - DGifGetCodeNext(GifFile, &Dummy); - while (Dummy != NULL); - } -} - -/****************************************************************************** -* Put one pixel (Pixel) into GIF file. * -******************************************************************************/ -void DGifGetPixel(GifFileType *GifFile, GifPixelType Pixel) -{ - GifByteType *Dummy; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - -#if defined(__MSDOS__) || defined(__GNUC__) - if (--Private->PixelCount > 0xffff0000UL) -#else - if (--Private->PixelCount > 0xffff0000) -#endif /* __MSDOS__ */ - { - GifInternError(GifFile, D_GIF_ERR_DATA_TOO_BIG); - } - - DGifDecompressLine(GifFile, &Pixel, 1); - if (Private->PixelCount == 0) { - /* We probably would not be called any more, so lets clean */ - /* everything before we return: need to flush out all rest of */ - /* image until empty block (size 0) detected. We use GetCodeNext.*/ - do - DGifGetCodeNext(GifFile, &Dummy); - while (Dummy != NULL); - } -} - -/****************************************************************************** -* Get an extension block (see GIF manual) from gif file. This routine only * -* returns the first data block, and DGifGetExtensionNext shouldbe called * -* after this one until NULL extension is returned. * -* The Extension should NOT be freed by the user (not dynamically allocated).* -* Note it is assumed the Extension desc. header ('!') has been read. * -******************************************************************************/ -void DGifGetExtension(GifFileType *GifFile, int *ExtCode, - GifByteType **Extension) -{ - GifByteType Buf; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - GifRead(&Buf, 1, GifFile); - *ExtCode = Buf; - - DGifGetExtensionNext(GifFile, Extension); -} - -/****************************************************************************** -* Get a following extension block (see GIF manual) from gif file. This * -* routine sould be called until NULL Extension is returned. * -* The Extension should NOT be freed by the user (not dynamically allocated).* -******************************************************************************/ -void DGifGetExtensionNext(GifFileType *GifFile, GifByteType **Extension) -{ - GifByteType Buf; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - GifRead(&Buf, 1, GifFile); - if (Buf > 0) { - *Extension = Private->Buf; /* Use private unused buffer. */ - (*Extension)[0] = Buf; /* Pascal strings notation (pos. 0 is len.). */ - GifRead(&((*Extension)[1]), Buf, GifFile); - } - else - *Extension = NULL; -} - -/****************************************************************************** -* This routine should be called second to last, to close the GIF file. * -******************************************************************************/ -int DGifCloseFile(GifFileType *GifFile) -{ - GifFilePrivateType *Private = (GifFilePrivateType *)GifFile->Private; - - if (GifFile == NULL) return -1; - - if (!IS_READABLE(Private)) - { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - if (GifClose (GifFile)) - { - GifInternError(GifFile, D_GIF_ERR_CLOSE_FAILED); - } - return 0; -} - -/****************************************************************************** -* Get 2 bytes (word) from the given file: * -******************************************************************************/ -static void DGifGetWord(GifFileType *GifFile, int *Word) -{ - unsigned char c[2]; - - GifRead(c, 2, GifFile); - - *Word = (((unsigned int) c[1]) << 8) + c[0]; -} - -/****************************************************************************** -* Get the image code in compressed form. his routine can be called if the * -* information needed to be piped out as is. Obviously this is much faster * -* than decoding and encoding again. This routine should be followed by calls * -* to DGifGetCodeNext, until NULL block is returned. * -* The block should NOT be freed by the user (not dynamically allocated). * -******************************************************************************/ -void DGifGetCode(GifFileType *GifFile, int *CodeSize, GifByteType **CodeBlock) -{ - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - *CodeSize = Private->BitsPerPixel; - - DGifGetCodeNext(GifFile, CodeBlock); -} - -/****************************************************************************** -* Continue to get the image code in compressed form. This routine should be * -* called until NULL block is returned. * -* The block should NOT be freed by the user (not dynamically allocated). * -******************************************************************************/ -void DGifGetCodeNext(GifFileType *GifFile, GifByteType **CodeBlock) -{ - GifByteType Buf; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - GifRead(&Buf, 1, GifFile); - - if (Buf > 0) { - *CodeBlock = Private->Buf; /* Use private unused buffer. */ - (*CodeBlock)[0] = Buf; /* Pascal strings notation (pos. 0 is len.). */ - GifRead(&((*CodeBlock)[1]), Buf, GifFile); - } - else { - *CodeBlock = NULL; - Private->Buf[0] = 0; /* Make sure the buffer is empty! */ - Private->PixelCount = 0; /* And local info. indicate image read. */ - } - -} - -/****************************************************************************** -* Setup the LZ decompression for this image: * -******************************************************************************/ -static void DGifSetupDecompress(GifFileType *GifFile) -{ - int i, BitsPerPixel; - GifByteType CodeSize; - unsigned int *Prefix; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - GifRead(&CodeSize, 1, GifFile); /* Read Code size from file. */ - BitsPerPixel = CodeSize; - - Private->Buf[0] = 0; /* Input Buffer empty. */ - Private->BitsPerPixel = BitsPerPixel; - Private->ClearCode = (1 << BitsPerPixel); - Private->EOFCode = Private->ClearCode + 1; - Private->RunningCode = Private->EOFCode + 1; - Private->RunningBits = BitsPerPixel + 1; /* Number of bits per code. */ - Private->MaxCode1 = 1 << Private->RunningBits; /* Max. code + 1. */ - Private->StackPtr = 0; /* No pixels on the pixel stack. */ - Private->LastCode = NO_SUCH_CODE; - Private->CrntShiftState = 0; /* No information in CrntShiftDWord. */ - Private->CrntShiftDWord = 0; - - Prefix = Private->Prefix; - for (i = 0; i <= LZ_MAX_CODE; i++) Prefix[i] = NO_SUCH_CODE; -} - -/****************************************************************************** -* The LZ decompression routine: * -* This version decompress the given gif file into Line of length LineLen. * -* This routine can be called few times (one per scan line, for example), in * -* order the complete the whole image. * -******************************************************************************/ -static void DGifDecompressLine(GifFileType *GifFile, GifPixelType *Line, - int LineLen) -{ - int i = 0, j, CrntCode, EOFCode, ClearCode, CrntPrefix, LastCode, StackPtr; - GifByteType *Stack, *Suffix; - unsigned int *Prefix; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - StackPtr = Private->StackPtr; - Prefix = Private->Prefix; - Suffix = Private->Suffix; - Stack = Private->Stack; - EOFCode = Private->EOFCode; - ClearCode = Private->ClearCode; - LastCode = Private->LastCode; - - CrntPrefix = 0; - if (StackPtr != 0) { - /* Let pop the stack off before continueing to read the gif file: */ - while (StackPtr != 0 && i < LineLen) Line[i++] = Stack[--StackPtr]; - } - - while (i < LineLen) { /* Decode LineLen items. */ - DGifDecompressInput(GifFile, &CrntCode); - - if (CrntCode == EOFCode) { - /* Note however that usually we will not be here as we will stop */ - /* decoding as soon as we got all the pixel, or EOF code will */ - /* not be read at all, and DGifGetLine/Pixel clean everything. */ - if (i != LineLen - 1 || Private->PixelCount != 0) { - GifInternError(GifFile, D_GIF_ERR_EOF_TOO_SOON); - } - i++; - } - else if (CrntCode == ClearCode) { - /* We need to start over again: */ - for (j = 0; j <= LZ_MAX_CODE; j++) Prefix[j] = NO_SUCH_CODE; - Private->RunningCode = Private->EOFCode + 1; - Private->RunningBits = Private->BitsPerPixel + 1; - Private->MaxCode1 = 1 << Private->RunningBits; - LastCode = Private->LastCode = NO_SUCH_CODE; - } - else { - /* Its regular code - if in pixel range simply add it to output */ - /* stream, otherwise trace to codes linked list until the prefix */ - /* is in pixel range: */ - if (CrntCode < ClearCode) { - /* This is simple - its pixel scalar, so add it to output: */ - Line[i++] = CrntCode; - } - else { - /* Its a code to needed to be traced: trace the linked list */ - /* until the prefix is a pixel, while pushing the suffix */ - /* pixels on our stack. If we done, pop the stack in reverse */ - /* (thats what stack is good for!) order to output. */ - if (Prefix[CrntCode] == NO_SUCH_CODE) { - /* Only allowed if CrntCode is exactly the running code: */ - /* In that case CrntCode = XXXCode, CrntCode or the */ - /* prefix code is last code and the suffix char is */ - /* exactly the prefix of last code! */ - if (CrntCode == Private->RunningCode - 2) { - CrntPrefix = LastCode; - Suffix[Private->RunningCode - 2] = - Stack[StackPtr++] = DGifGetPrefixChar(Prefix, - LastCode, ClearCode); - } - else { - GifInternError(GifFile, D_GIF_ERR_IMAGE_DEFECT); - } - } - else - CrntPrefix = CrntCode; - - /* Now (if image is O.K.) we should not get an NO_SUCH_CODE */ - /* During the trace. As we might loop forever, in case of */ - /* defective image, we count the number of loops we trace */ - /* and stop if we got LZ_MAX_CODE. obviously we can not */ - /* loop more than that. */ - j = 0; - while (j++ <= LZ_MAX_CODE && - CrntPrefix > ClearCode && - CrntPrefix <= LZ_MAX_CODE) { - Stack[StackPtr++] = Suffix[CrntPrefix]; - CrntPrefix = Prefix[CrntPrefix]; - } - if (j >= LZ_MAX_CODE || CrntPrefix > LZ_MAX_CODE) { - GifInternError(GifFile, D_GIF_ERR_IMAGE_DEFECT); - } - /* Push the last character on stack: */ - Stack[StackPtr++] = CrntPrefix; - - /* Now lets pop all the stack into output: */ - while (StackPtr != 0 && i < LineLen) - Line[i++] = Stack[--StackPtr]; - } - if (LastCode != NO_SUCH_CODE) { - Prefix[Private->RunningCode - 2] = LastCode; - - if (CrntCode == Private->RunningCode - 2) { - /* Only allowed if CrntCode is exactly the running code: */ - /* In that case CrntCode = XXXCode, CrntCode or the */ - /* prefix code is last code and the suffix char is */ - /* exactly the prefix of last code! */ - Suffix[Private->RunningCode - 2] = - DGifGetPrefixChar(Prefix, LastCode, ClearCode); - } - else { - Suffix[Private->RunningCode - 2] = - DGifGetPrefixChar(Prefix, CrntCode, ClearCode); - } - } - LastCode = CrntCode; - } - } - - Private->LastCode = LastCode; - Private->StackPtr = StackPtr; -} - -/****************************************************************************** -* Routine to trace the Prefixes linked list until we get a prefix which is * -* not code, but a pixel value (less than ClearCode). Returns that pixel value.* -* If image is defective, we might loop here forever, so we limit the loops to * -* the maximum possible if image O.k. - LZ_MAX_CODE times. * -******************************************************************************/ -static int DGifGetPrefixChar(unsigned int *Prefix, int Code, int ClearCode) -{ - int i = 0; - - while (Code > ClearCode && i++ <= LZ_MAX_CODE) Code = Prefix[Code]; - return Code; -} - -/****************************************************************************** -* Interface for accessing the LZ codes directly. Set Code to the real code * -* (12bits), or to -1 if EOF code is returned. * -******************************************************************************/ -void DGifGetLZCodes(GifFileType *GifFile, int *Code) -{ - GifByteType *CodeBlock; - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - - if (!IS_READABLE(Private)) { - /* This file was NOT open for reading: */ - GifInternError(GifFile, D_GIF_ERR_NOT_READABLE); - } - - DGifDecompressInput(GifFile, Code); - - if (*Code == Private->EOFCode) { - /* Skip rest of codes (hopefully only NULL terminating block): */ - do - DGifGetCodeNext(GifFile, &CodeBlock); - while (CodeBlock != NULL); - - *Code = -1; - } - else if (*Code == Private->ClearCode) { - /* We need to start over again: */ - Private->RunningCode = Private->EOFCode + 1; - Private->RunningBits = Private->BitsPerPixel + 1; - Private->MaxCode1 = 1 << Private->RunningBits; - } -} - -/****************************************************************************** -* The LZ decompression input routine: * -* This routine is responsable for the decompression of the bit stream from * -* 8 bits (bytes) packets, into the real codes. * -* Returns GIF_OK if read succesfully. * -******************************************************************************/ -static void DGifDecompressInput(GifFileType *GifFile, int *Code) -{ - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - GifByteType NextByte; - static unsigned int CodeMasks[] = { - 0x0000, 0x0001, 0x0003, 0x0007, - 0x000f, 0x001f, 0x003f, 0x007f, - 0x00ff, 0x01ff, 0x03ff, 0x07ff, - 0x0fff - }; - - while (Private->CrntShiftState < Private->RunningBits) { - /* Needs to get more bytes from input stream for next code: */ - DGifBufferedInput(GifFile, &NextByte); - Private->CrntShiftDWord |= - ((unsigned long) NextByte) << Private->CrntShiftState; - Private->CrntShiftState += 8; - } - *Code = Private->CrntShiftDWord & CodeMasks[Private->RunningBits]; - - Private->CrntShiftDWord >>= Private->RunningBits; - Private->CrntShiftState -= Private->RunningBits; - - /* If code cannt fit into RunningBits bits, must raise its size. Note */ - /* however that codes above 4095 are used for special signaling. */ - if (++Private->RunningCode > Private->MaxCode1 && - Private->RunningBits < LZ_BITS) { - Private->MaxCode1 <<= 1; - Private->RunningBits++; - } -} - -/****************************************************************************** -* This routines read one gif data block at a time and buffers it internally * -* so that the decompression routine could access it. * -* The routine returns the next byte from its internal buffer (or read next * -* block in if buffer empty) * -******************************************************************************/ -static void DGifBufferedInput(GifFileType *GifFile, GifByteType *NextByte) -{ - GifFilePrivateType *Private = (GifFilePrivateType *) GifFile->Private; - GifByteType *Buf = Private->Buf; - - if (Buf[0] == 0) { - /* Needs to read the next buffer - this one is empty: */ - GifRead(Buf, 1, GifFile); - GifRead((Buf + 1), Buf[0], GifFile); - *NextByte = Buf[1]; - Buf[1] = 2; /* We use now the second place as last char read! */ - Buf[0]--; - } - else { - *NextByte = Buf[Buf[1]++]; - Buf[0]--; - } -} - -/****************************************************************************** -* This routine reads an entire GIF into core, hanging all its state info off * -* the GifFileType pointer. Call DGifOpenFileName() or DGifOpenFileHandle() * -* first to initialize I/O. Its inverse is EGifSpew(). * -******************************************************************************/ -void DGifSlurp(GifFileType *GifFile) -{ - int ImageSize; - GifRecordType RecordType; - SavedImage *sp; - GifByteType *ExtData; - - /* Some versions of malloc dislike 0-length requests */ - GifFile->SavedImages = (SavedImage *)malloc(sizeof(SavedImage)); - memset(GifFile->SavedImages, 0, sizeof(SavedImage)); - sp = &GifFile->SavedImages[0]; - - do { - DGifGetRecordType(GifFile, &RecordType); - - switch (RecordType) { - case IMAGE_DESC_RECORD_TYPE: - DGifGetImageDesc(GifFile); - - sp = &GifFile->SavedImages[GifFile->ImageCount-1]; - ImageSize = sp->ImageDesc.Width * sp->ImageDesc.Height; - - sp->RasterBits - = (GifPixelType*) malloc (ImageSize * sizeof(GifPixelType)); - - DGifGetLine(GifFile, sp->RasterBits, ImageSize); - break; - - case EXTENSION_RECORD_TYPE: - DGifGetExtension(GifFile,&sp->Function,&ExtData); - - do { - if (AddExtensionBlock(sp, ExtData[0], ExtData+1) == GIF_ERROR) - GifInternError(GifFile, D_GIF_ERR_NOT_ENOUGH_MEM); - DGifGetExtensionNext(GifFile, &ExtData); - } while (ExtData != NULL); - break; - - case TERMINATE_RECORD_TYPE: - break; - - default: /* Should be trapped by DGifGetRecordType */ - break; - } - } while (RecordType != TERMINATE_RECORD_TYPE); -} - -/****************************************************************************** -* Extension record functions * -******************************************************************************/ - -void MakeExtension(SavedImage *New, int Function) -{ - New->Function = Function; - /* - * Someday we might have to deal with multiple extensions. - */ -} - -int AddExtensionBlock(SavedImage *New, int Len, GifByteType *data) -{ - int size; - ExtensionBlock *ep; - - if (New->ExtensionBlocks == NULL) - New->ExtensionBlocks = (ExtensionBlock *)malloc(sizeof(ExtensionBlock)); - else - New->ExtensionBlocks = - (ExtensionBlock *)realloc(New->ExtensionBlocks, - sizeof(ExtensionBlock) * (New->ExtensionBlockCount + 1)); - - if (New->ExtensionBlocks == NULL) - return(GIF_ERROR); - - ep = &New->ExtensionBlocks[New->ExtensionBlockCount++]; - ep->ByteCount = Len; - size = Len * sizeof(GifByteType); - ep->Bytes = (GifByteType *)malloc(size); - memcpy(ep->Bytes, data, size); - return(GIF_OK); -} - -void FreeExtension(SavedImage *Image) -{ - ExtensionBlock *ep; - - for (ep = Image->ExtensionBlocks; - ep < Image->ExtensionBlocks + Image->ExtensionBlockCount; - ep++) - (void) free((char *)ep->Bytes); - free((char *)Image->ExtensionBlocks); - Image->ExtensionBlocks = NULL; -} - -/****************************************************************************** -* Image block allocation functions * -******************************************************************************/ -SavedImage *MakeSavedImage(GifFileType *GifFile, SavedImage *CopyFrom) -/* - * Append an image block to the SavedImages array - */ -{ - SavedImage *sp; - - if (GifFile->SavedImages == NULL) - GifFile->SavedImages = (SavedImage *)malloc(sizeof(SavedImage)); - else - GifFile->SavedImages = (SavedImage *)realloc(GifFile->SavedImages, - sizeof(SavedImage) * (GifFile->ImageCount+1)); - - if (GifFile->SavedImages == NULL) - return((SavedImage *)NULL); - else - { - sp = &GifFile->SavedImages[GifFile->ImageCount++]; - memset((char *)sp, '\0', sizeof(SavedImage)); - - if (CopyFrom) - { - memcpy((char *)sp, CopyFrom, sizeof(SavedImage)); - - /* - * Make our own allocated copies of the heap fields in the - * copied record. This guards against potential aliasing - * problems. - */ - - /* first, the local color map */ - if (sp->ImageDesc.ColorMap) - sp->ImageDesc.ColorMap = - MakeMapObject(CopyFrom->ImageDesc.ColorMap->ColorCount, - CopyFrom->ImageDesc.ColorMap->Colors); - - /* next, the raster */ - sp->RasterBits = (GifPixelType *) malloc(sizeof(GifPixelType) - * CopyFrom->ImageDesc.Height - * CopyFrom->ImageDesc.Width); - memcpy(sp->RasterBits, - CopyFrom->RasterBits, - sizeof(GifPixelType) - * CopyFrom->ImageDesc.Height - * CopyFrom->ImageDesc.Width); - - /* finally, the extension blocks */ - if (sp->ExtensionBlocks) - { - sp->ExtensionBlocks - = (ExtensionBlock*)malloc(sizeof(ExtensionBlock) - * CopyFrom->ExtensionBlockCount); - memcpy(sp->ExtensionBlocks, - CopyFrom->ExtensionBlocks, - sizeof(ExtensionBlock) - * CopyFrom->ExtensionBlockCount); - - /* - * For the moment, the actual blocks can take their - * chances with free(). We'll fix this later. - */ - } - } - - return(sp); - } -} - -void FreeSavedImages(GifFileType *GifFile) -{ - SavedImage *sp; - - for (sp = GifFile->SavedImages; - sp < GifFile->SavedImages + GifFile->ImageCount; - sp++) - { - if (sp->ImageDesc.ColorMap) - FreeMapObject(sp->ImageDesc.ColorMap); - - if (sp->RasterBits) - free((char *)sp->RasterBits); - - if (sp->ExtensionBlocks) - FreeExtension(sp); - } - free((char *) GifFile->SavedImages); -} - -/****************************************************************************** -* Miscellaneous utility functions * -******************************************************************************/ - -static int BitSize(int n) -/* return smallest bitfield size n will fit in */ -{ - register int i; - - for (i = 1; i <= 8; i++) - if ((1 << i) >= n) - break; - return(i); -} - -/****************************************************************************** -* Color map object functions * -******************************************************************************/ - -ColorMapObject *MakeMapObject(int ColorCount, GifColorType *ColorMap) -/* - * Allocate a color map of given size; initialize with contents of - * ColorMap if that pointer is non-NULL. - */ -{ - ColorMapObject *Object; - - if (ColorCount != (1 << BitSize(ColorCount))) - return((ColorMapObject *)NULL); - - Object = (ColorMapObject *)malloc(sizeof(ColorMapObject)); - if (Object == (ColorMapObject *)NULL) - return((ColorMapObject *)NULL); - - Object->Colors = (GifColorType *)calloc(ColorCount, sizeof(GifColorType)); - if (Object->Colors == (GifColorType *)NULL) - return((ColorMapObject *)NULL); - - Object->ColorCount = ColorCount; - Object->BitsPerPixel = BitSize(ColorCount); - - if (ColorMap) - memcpy((char *)Object->Colors, - (char *)ColorMap, ColorCount * sizeof(GifColorType)); - - return(Object); -} - -void FreeMapObject(ColorMapObject *Object) -/* - * Free a color map object - */ -{ - free(Object->Colors); - free(Object); -} diff --git a/src/dialog-msw.c b/src/dialog-msw.c deleted file mode 100644 index 24c272c..0000000 --- a/src/dialog-msw.c +++ /dev/null @@ -1,421 +0,0 @@ -/* Implements elisp-programmable dialog boxes -- MS Windows interface. - Copyright (C) 1998 Kirill M. Katsnelson - -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: - Initially written by kkm, May 1998 -*/ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "console-msw.h" -#include "frame.h" -#include "gui.h" -#include "opaque.h" - -/* List containing all dialog data structures of currently popped up - dialogs. Each item is a cons of frame object and a vector of - callbacks for buttons in the dialog, in order */ -static Lisp_Object Vdialog_data_list; - -/* DLUs per character metrics */ -#define X_DLU_PER_CHAR 4 -#define Y_DLU_PER_CHAR 8 - -/* - Button metrics - -------------- - All buttons have height of 15 DLU. The minimum width for a button is 32 DLU, - but it can be expanded to accommodate its text, so the width is calculated as - 8 DLU per button plus 4 DLU per character. - max (32, 6 * text_length). The factor of six is rather empirical, but it - works better than 8 which comes from the definition of a DLU. Buttons are - spaced with 6 DLU gap. Minimum distance from the button to the left or right - dialog edges is 6 DLU, and the distance between the dialog bottom edge and - buttons is 7 DLU. -*/ - -#define X_MIN_BUTTON 32 -#define X_BUTTON_MARGIN 8 -#define Y_BUTTON 15 -#define X_BUTTON_SPACING 6 -#define X_BUTTON_FROM_EDGE 6 -#define Y_BUTTON_FROM_EDGE 7 - -/* - Text field metrics - ------------------ - Text distance from left and right edges is the same as for buttons, and the - top margin is 11 DLU. The static control has height of 2 DLU per control - plus 8 DLU per each line of text. Distance between the bottom edge of the - control and the button row is 15 DLU. Minimum width of the static control - is 100 DLU, thus giving minimum dialog weight of 112 DLU. Maximum width is - 300 DLU, and, if the text is wider than that, the text is wrapped on the - next line. Each character in the text is considered 4 DLU wide. -*/ - -#define X_MIN_TEXT 100 -#define X_AVE_TEXT 200 -#define X_MAX_TEXT 300 -#define X_TEXT_FROM_EDGE X_BUTTON_FROM_EDGE -#define Y_TEXT_FROM_EDGE 11 -#define Y_TEXT_MARGIN 2 -#define Y_TEXT_FROM_BUTTON 15 - -#define X_MIN_TEXT_CHAR (X_MIN_TEXT / X_DLU_PER_CHAR) -#define X_AVE_TEXT_CHAR (X_AVE_TEXT / X_DLU_PER_CHAR) -#define X_MAX_TEXT_CHAR (X_MAX_TEXT / X_DLU_PER_CHAR) - -/* - Layout algorithm - ---------------- - First we calculate the minimum width of the button row, excluding "from - edge" distances. Note that the static control text can be narrower than - X_AVE_TEXT only if both text and button row are narrower than that (so, - even if text *can* be wrapped into 2 rows narrower than ave width, it is not - done). Let WBR denote the width of the button row. - - Next, the width of the static field is determined. - First, if all lines of text fit into max (WBR, X_MAX_TEXT), the width of the - control is the same as the width of the longest line. - Second, if all lines of text are narrower than X_MIN_TEXT, then width of - the control is set to X_MIN_TEXT. - Otherwise, width is set to max(WBR, X_AVE_TEXT). In this case, line wrapping will - happen. - - If width of the text control is larger than that of the button row, then the - latter is centered across the dialog, by giving it extra edge - margins. Otherwise, minimal margins are given to the button row. -*/ - -#define ID_ITEM_BIAS 32 - -typedef struct gui_item struct_gui_item; -typedef struct -{ - Dynarr_declare (struct gui_item); -} struct_gui_item_dynarr; - -/* Dialog procedure */ -static BOOL CALLBACK -dialog_proc (HWND hwnd, UINT msg, WPARAM w_param, LPARAM l_param) -{ - switch (msg) - { - case WM_INITDIALOG: - SetWindowLong (hwnd, DWL_USER, l_param); - break; - - case WM_DESTROY: - { - Lisp_Object data; - VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER)); - Vdialog_data_list = delq_no_quit (data, Vdialog_data_list); - } - break; - - case WM_COMMAND: - { - Lisp_Object fn, arg, data; - VOID_TO_LISP (data, GetWindowLong (hwnd, DWL_USER)); - - assert (w_param >= ID_ITEM_BIAS - && w_param < XVECTOR_LENGTH (XCDR (data)) + ID_ITEM_BIAS); - - get_gui_callback (XVECTOR_DATA (XCDR (data)) [w_param - ID_ITEM_BIAS], - &fn, &arg); - mswindows_enqueue_misc_user_event (XCAR (data), fn, arg); - - DestroyWindow (hwnd); - } - break; - - default: - return FALSE; - } - return TRUE; -} - -/* Helper function which converts the supplied string STRING into Unicode and - pushes it at the end of DYNARR */ -static void -push_lisp_string_as_unicode (unsigned_char_dynarr* dynarr, Lisp_Object string) -{ - Extbyte *mbcs_string; - Charcount length = XSTRING_CHAR_LENGTH (string); - LPWSTR uni_string; - - GET_C_CHARPTR_EXT_DATA_ALLOCA (XSTRING_DATA (string), - FORMAT_OS, mbcs_string); - uni_string = alloca_array (WCHAR, length + 1); - length = MultiByteToWideChar (CP_ACP, 0, mbcs_string, -1, - uni_string, sizeof(WCHAR) * (length + 1)); - Dynarr_add_many (dynarr, uni_string, sizeof(WCHAR) * length); -} - -/* Given button TEXT, return button width in DLU */ -static unsigned int -button_width (Lisp_Object text) -{ - unsigned int width = X_DLU_PER_CHAR * XSTRING_CHAR_LENGTH (text); - return max (X_MIN_BUTTON, width); -} - -/* Unwind protection routine frees a dynarr opaqued into arg */ -static Lisp_Object -free_dynarr_opaque_ptr (Lisp_Object arg) -{ - Dynarr_free (get_opaque_ptr (arg)); - return arg; -} - - -#define ALIGN_TEMPLATE \ -{ \ - unsigned int slippage = Dynarr_length (template) & 3; \ - if (slippage) \ - Dynarr_add_many (template, &zeroes, slippage); \ -} - -static void -mswindows_popup_dialog_box (struct frame* f, Lisp_Object desc) -{ - struct_gui_item_dynarr *dialog_items = Dynarr_new (struct_gui_item); - unsigned_char_dynarr *template = Dynarr_new (unsigned_char); - unsigned int button_row_width = 0; - unsigned int text_width, text_height; - - int unbind_count = specpdl_depth (); - record_unwind_protect (free_dynarr_opaque_ptr, - make_opaque_ptr (dialog_items)); - record_unwind_protect (free_dynarr_opaque_ptr, - make_opaque_ptr (template)); - - /* A big NO NEED to GCPRO gui_items stored in the array: they are just - pointers into DESC list, which is GC-protected by the caller */ - - /* Parse each item in the dialog into gui_item structs, and stuff a dynarr - of these. Calculate button row width in this loop too */ - { - Lisp_Object item_cons; - - EXTERNAL_LIST_LOOP (item_cons, XCDR (desc)) - { - if (!NILP (XCAR (item_cons))) - { - struct gui_item gitem; - gui_item_init (&gitem); - gui_parse_item_keywords (XCAR (item_cons), &gitem); - Dynarr_add (dialog_items, gitem); - button_row_width += button_width (gitem.name) + X_BUTTON_MARGIN; - } - } - if (Dynarr_length (dialog_items) == 0) - signal_simple_error ("Dialog descriptor provides no active items", desc); - button_row_width -= X_BUTTON_MARGIN; - } - - /* Determine the final width layout */ - { - Bufbyte *p = XSTRING_DATA (XCAR (desc)); - Charcount string_max = 0, this_length = 0; - while (1) - { - Emchar ch = charptr_emchar (p); - INC_CHARPTR (p); - - if (ch == (Emchar)'\n' || ch == (Emchar)'\0') - { - string_max = max (this_length, string_max); - this_length = 0; - } - else - ++this_length; - - if (ch == (Emchar)'\0') - break; - } - - if (string_max * X_DLU_PER_CHAR > max (X_MAX_TEXT, button_row_width)) - text_width = X_AVE_TEXT; - else if (string_max * X_DLU_PER_CHAR < X_MIN_TEXT) - text_width = X_MIN_TEXT; - else - text_width = string_max * X_DLU_PER_CHAR; - text_width = max (text_width, button_row_width); - } - - /* Now calculate the height for the text control */ - { - Bufbyte *p = XSTRING_DATA (XCAR (desc)); - Charcount break_at = text_width / X_DLU_PER_CHAR; - Charcount char_pos = 0; - int num_lines = 1; - Emchar ch; - - while ((ch = charptr_emchar (p)) != (Emchar)'\0') - { - INC_CHARPTR (p); - char_pos += ch != (Emchar)'\n'; - if (ch == (Emchar)'\n' || char_pos == break_at) - { - ++num_lines; - char_pos = 0; - } - } - text_height = Y_TEXT_MARGIN + Y_DLU_PER_CHAR * num_lines; - } - - /* Ok, now we are ready to stuff the dialog template and lay out controls */ - { - DLGTEMPLATE dlg_tem; - DLGITEMTEMPLATE item_tem; - int i; - const unsigned int zeroes = 0; - const unsigned int ones = 0xFFFFFFFF; - const WORD static_class_id = 0x0082; - const WORD button_class_id = 0x0080; - - /* Create and stuff in DLGTEMPLATE header */ - dlg_tem.style = (DS_CENTER | DS_MODALFRAME | DS_SETFONT - | WS_CAPTION | WS_POPUP | WS_VISIBLE); - dlg_tem.dwExtendedStyle = 0; - dlg_tem.cdit = Dynarr_length (dialog_items) + 1; - dlg_tem.x = 0; - dlg_tem.y = 0; - dlg_tem.cx = text_width + 2 * X_TEXT_FROM_EDGE; - dlg_tem.cy = (Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON - + Y_BUTTON + Y_BUTTON_FROM_EDGE); - Dynarr_add_many (template, &dlg_tem, sizeof (dlg_tem)); - - /* We want no menu and standard class */ - Dynarr_add_many (template, &zeroes, 4); - - /* And the third is the dialog title. "XEmacs" as long as we do not supply - one in descriptor. Note that the string must be in Unicode. */ - Dynarr_add_many (template, L"XEmacs", 14); - - /* We want standard dialog font */ - Dynarr_add_many (template, L"\x08MS Shell Dlg", 28); - - /* Next add text control. */ - item_tem.style = WS_CHILD | WS_VISIBLE | SS_LEFT | SS_NOPREFIX; - item_tem.dwExtendedStyle = 0; - item_tem.x = X_TEXT_FROM_EDGE; - item_tem.y = Y_TEXT_FROM_EDGE; - item_tem.cx = text_width; - item_tem.cy = text_height; - item_tem.id = 0xFFFF; - - ALIGN_TEMPLATE; - Dynarr_add_many (template, &item_tem, sizeof (item_tem)); - - /* Right after class id follows */ - Dynarr_add_many (template, &ones, 2); - Dynarr_add_many (template, &static_class_id, sizeof (static_class_id)); - - /* Next thing to add is control text, as Unicode string */ - push_lisp_string_as_unicode (template, XCAR (desc)); - - /* Specify 0 length creation data */ - Dynarr_add_many (template, &zeroes, 2); - - /* Now it's the button time */ - item_tem.y = Y_TEXT_FROM_EDGE + text_height + Y_TEXT_FROM_BUTTON; - item_tem.x = X_BUTTON_FROM_EDGE + (button_row_width < text_width - ? (text_width - button_row_width) / 2 - : 0); - item_tem.cy = Y_BUTTON; - item_tem.dwExtendedStyle = 0; - - for (i = 0; i < Dynarr_length (dialog_items); ++i) - { - struct gui_item *pgui_item = Dynarr_atp (dialog_items, i); - - item_tem.style = (WS_CHILD | WS_VISIBLE | WS_TABSTOP | BS_PUSHBUTTON - | (gui_item_active_p (pgui_item) ? 0 : WS_DISABLED)); - item_tem.cx = button_width (pgui_item->name); - /* Item ids are indices into dialog_items plus offset, to avoid having - items by reserved ids (IDOK, IDCANCEL) */ - item_tem.id = i + ID_ITEM_BIAS; - - ALIGN_TEMPLATE; - Dynarr_add_many (template, &item_tem, sizeof (item_tem)); - - /* Right after 0xFFFF and class id atom follows */ - Dynarr_add_many (template, &ones, 2); - Dynarr_add_many (template, &button_class_id, sizeof (button_class_id)); - - /* Next thing to add is control text, as Unicode string */ - push_lisp_string_as_unicode (template, pgui_item->name); - - /* Specify 0 length creation data. */ - Dynarr_add_many (template, &zeroes, 2); - - item_tem.x += item_tem.cx + X_BUTTON_SPACING; - } - } - - /* Now the Windows dialog structure is ready. We need to prepare a - data structure for the new dialog, which will contain callbacks - and the frame for these callbacks. This structure has to be - GC-protected. The data structure itself is a cons of frame object - and a vector of callbacks; for the protection reasons it is put - into a statically protected list. */ - { - Lisp_Object frame, vector, dialog_data; - int i; - - XSETFRAME (frame, f); - vector = make_vector (Dynarr_length (dialog_items), Qunbound); - dialog_data = Fcons (frame, vector); - for (i = 0; i < Dynarr_length (dialog_items); i++) - XVECTOR_DATA (vector) [i] = Dynarr_atp (dialog_items, i)->callback; - - /* Woof! Everything is ready. Pop pop pop in now! */ - if (!CreateDialogIndirectParam (NULL, - (LPDLGTEMPLATE) Dynarr_atp (template, 0), - FRAME_MSWINDOWS_HANDLE (f), dialog_proc, - (LPARAM) LISP_TO_VOID (dialog_data))) - /* Something went wrong creating the dialog */ - signal_simple_error ("System error creating dialog", desc); - - Vdialog_data_list = Fcons (dialog_data, Vdialog_data_list); - } - - /* Cease protection and free dynarrays */ - unbind_to (unbind_count, Qnil); -} - -void -console_type_create_dialog_mswindows (void) -{ - CONSOLE_HAS_METHOD (mswindows, popup_dialog_box); -} - -void -vars_of_dialog_mswindows (void) -{ - Vdialog_data_list = Qnil; - staticpro (&Vdialog_data_list); -} diff --git a/src/dialog-x.c b/src/dialog-x.c deleted file mode 100644 index 918b632..0000000 --- a/src/dialog-x.c +++ /dev/null @@ -1,274 +0,0 @@ -/* Implements elisp-programmable dialog boxes -- X interface. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -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. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "EmacsFrame.h" -#include "gui-x.h" - -#include "buffer.h" -#include "commands.h" /* zmacs_regions */ -#include "events.h" -#include "frame.h" -#include "gui.h" -#include "opaque.h" -#include "window.h" - - -static void -maybe_run_dbox_text_callback (LWLIB_ID id) -{ - /* !!#### This function has not been Mule-ized */ - widget_value *wv; - int got_some; - wv = xmalloc_widget_value (); - wv->name = (char *) "value"; - got_some = lw_get_some_values (id, wv); - if (got_some) - { - Lisp_Object text_field_callback; - char *text_field_value = wv->value; - VOID_TO_LISP (text_field_callback, wv->call_data); - if (text_field_value) - { - void *tmp = LISP_TO_VOID (list2 (text_field_callback, - build_string (text_field_value))); - popup_selection_callback (0, id, (XtPointer) tmp); - xfree (text_field_value); - } - } - free_widget_value (wv); -} - -static void -dbox_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) -{ - /* This is called with client_data == -1 when WM_DELETE_WINDOW is sent - instead of a button being selected. */ - struct device *d = get_device_from_display (XtDisplay (widget)); - struct frame *f = 0; - Widget cur_widget = widget; - - /* The parent which is actually connected to our EmacsFrame may be a - ways up the tree. */ - while (!f && cur_widget) - { - f = x_any_window_to_frame (d, XtWindow (cur_widget)); - cur_widget = XtParent (cur_widget); - } - - if (popup_handled_p (id)) - return; - assert (popup_up_p != 0); - ungcpro_popup_callbacks (id); - popup_up_p--; - maybe_run_dbox_text_callback (id); - popup_selection_callback (widget, id, client_data); - lw_destroy_all_widgets (id); - - /* The Motif dialog box sets the keyboard focus to itself. When it - goes away we have to take care of getting the focus back - ourselves. */ -#ifdef EXTERNAL_WIDGET - /* #### Not sure if this special case is necessary. */ - if (!FRAME_X_EXTERNAL_WINDOW_P (f) && f) -#else - if (f) -#endif - lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), FRAME_X_TEXT_WIDGET (f)); -} - -static CONST char * CONST button_names [] = { - "button1", "button2", "button3", "button4", "button5", - "button6", "button7", "button8", "button9", "button10" }; - -/* can't have static frame locals because of some broken compilers */ -static char tmp_dbox_name [255]; - -static widget_value * -dbox_descriptor_to_widget_value (Lisp_Object desc) -{ - /* !!#### This function has not been Mule-ized */ - /* This function can GC */ - char *name; - int lbuttons = 0, rbuttons = 0; - int partition_seen = 0; - int text_field_p = 0; - int allow_text_p = 1; - widget_value *prev = 0, *kids = 0; - int n = 0; - int count = specpdl_depth (); - Lisp_Object wv_closure; - - CHECK_CONS (desc); - CHECK_STRING (XCAR (desc)); - name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); - desc = XCDR (desc); - if (!CONSP (desc)) - error ("dialog boxes must have some buttons"); - - /* Inhibit GC during this conversion. The reasons for this are - the same as in menu_item_descriptor_to_widget_value(); see - the large comment above that function. */ - - record_unwind_protect (restore_gc_inhibit, - make_int (gc_currently_forbidden)); - gc_currently_forbidden = 1; - - kids = prev = xmalloc_widget_value (); - - /* Also make sure that we free the partially-created widget_value - tree on Lisp error. */ - - wv_closure = make_opaque_ptr (kids); - record_unwind_protect (widget_value_unwind, wv_closure); - prev->name = (char *) "message"; - prev->value = xstrdup (name); - prev->enabled = 1; - - for (; !NILP (desc); desc = Fcdr (desc)) - { - Lisp_Object button = XCAR (desc); - widget_value *wv; - - if (NILP (button)) - { - if (partition_seen) - error ("more than one partition (nil) seen in dbox spec"); - partition_seen = 1; - continue; - } - CHECK_VECTOR (button); - wv = xmalloc_widget_value (); - - if (!button_item_to_widget_value (button, wv, allow_text_p, 1)) - { - free_widget_value (wv); - continue; - } - - if (wv->type == TEXT_TYPE) - { - text_field_p = 1; - allow_text_p = 0; /* only allow one */ - } - else /* it's a button */ - { - allow_text_p = 0; /* only allow text field at the front */ - wv->value = xstrdup (wv->name); /* what a mess... */ - wv->name = (char *) button_names [n]; - - if (partition_seen) - rbuttons++; - else - lbuttons++; - n++; - - if (lbuttons > 9 || rbuttons > 9) - error ("too many buttons (9)"); /* #### this leaks */ - } - - prev->next = wv; - prev = wv; - } - - if (n == 0) - error ("dialog boxes must have some buttons"); - { - char type = (text_field_p ? 'P' : 'Q'); - widget_value *dbox; - sprintf (tmp_dbox_name, "%c%dBR%d", type, lbuttons + rbuttons, rbuttons); - dbox = xmalloc_widget_value (); - dbox->name = tmp_dbox_name; - dbox->contents = kids; - - /* No more need to free the half-filled-in structures. */ - set_opaque_ptr (wv_closure, 0); - unbind_to (count, Qnil); - return dbox; - } -} - -static void -x_popup_dialog_box (struct frame* f, Lisp_Object dbox_desc) -{ - int dbox_id; - widget_value *data; - Widget parent, dbox; - - data = dbox_descriptor_to_widget_value (dbox_desc); - - parent = FRAME_X_SHELL_WIDGET (f); - - dbox_id = new_lwlib_id (); - dbox = lw_create_widget (data->name, "dialog", dbox_id, data, parent, 1, 0, - dbox_selection_callback, 0); - lw_modify_all_widgets (dbox_id, data, True); - lw_modify_all_widgets (dbox_id, data->contents, True); - free_popup_widget_value_tree (data); - - gcpro_popup_callbacks (dbox_id); - - /* Setting zmacs-region-stays is necessary here because executing a - command from a dialog is really a two-command process: the first - command (bound to the button-click) simply pops up the dialog, - and returns. This causes a sequence of magic-events (destined - for the dialog widget) to begin. Eventually, a dialog item is - selected, and a misc-user-event blip is pushed onto the end of - the input stream, which is then executed by the event loop. - - So there are two command-events, with a bunch of magic-events - between them. We don't want the *first* command event to alter - the state of the region, so that the region can be available as - an argument for the second command. */ - if (zmacs_regions) - zmacs_region_stays = 1; - - popup_up_p++; - lw_pop_up_all_widgets (dbox_id); -} - -void -syms_of_dialog_x (void) -{ -} - -void -console_type_create_dialog_x (void) -{ - CONSOLE_HAS_METHOD (x, popup_dialog_box); -} - -void -vars_of_dialog_x (void) -{ -#if defined (LWLIB_DIALOGS_LUCID) - Fprovide (intern ("lucid-dialogs")); -#elif defined (LWLIB_DIALOGS_MOTIF) - Fprovide (intern ("motif-dialogs")); -#elif defined (LWLIB_DIALOGS_ATHENA) - Fprovide (intern ("athena-dialogs")); -#endif -} diff --git a/src/dialog.c b/src/dialog.c deleted file mode 100644 index 0f0af99..0000000 --- a/src/dialog.c +++ /dev/null @@ -1,92 +0,0 @@ -/* Implements elisp-programmable dialog boxes -- generic. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - -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. */ - -/* #### There ain't nothin' here because dialog boxes have not been - properly abstracted yet. */ - -#include -#include "lisp.h" -#include "frame.h" -#include "device.h" - -DEFUN ("popup-dialog-box", Fpopup_dialog_box, 1, 1, 0, /* -Pop up a dialog box. -A dialog box description is a list. - -The first element of a dialog box must be a string, which is the title or -question. - -The rest of the elements are descriptions of the dialog box's buttons. -Each of these is a vector, the syntax of which is essentially the same as -that of popup menu items. They may have any of the following forms: - - [ "name" callback ] - [ "name" callback "suffix" ] - [ "name" callback : : ... ] - -The name is the string to display on the button; it is filtered through the -resource database, so it is possible for resources to override what string -is actually displayed. - -If the `callback' of a button is a symbol, then it must name a command. -It will be invoked with `call-interactively'. If it is a list, then it is -evaluated with `eval'. - -One (and only one) of the buttons may be `nil'. This marker means that all -following buttons should be flushright instead of flushleft. - -Though the keyword/value syntax is supported for dialog boxes just as in -popup menus, the only keyword which is both meaningful and fully implemented -for dialog box buttons is `:active'. -*/ - (dbox_desc)) -{ - struct frame *f = selected_frame (); - struct device *d = XDEVICE (f->device); - - if (!HAS_DEVMETH_P (d, popup_dialog_box)) - signal_simple_error ("Device does not support dialogs", f->device); - - if (SYMBOLP (dbox_desc)) - dbox_desc = Fsymbol_value (dbox_desc); - CHECK_CONS (dbox_desc); - CHECK_STRING (XCAR (dbox_desc)); - if (!CONSP (XCDR (dbox_desc))) - signal_simple_error ("Dialog descriptor must supply at least one button", dbox_desc); - - DEVMETH (d, popup_dialog_box, (f, dbox_desc)); - - return Qnil; -} - -void -syms_of_dialog (void) -{ - DEFSUBR (Fpopup_dialog_box); -} - -void -vars_of_dialog (void) -{ - Fprovide (intern ("dialog")); -} diff --git a/src/dired-msw.c b/src/dired-msw.c deleted file mode 100644 index f717c65..0000000 --- a/src/dired-msw.c +++ /dev/null @@ -1,665 +0,0 @@ -/* fast dired replacement routines for mswindows. - Copyright (C) 1998 Darryl Okahata - Portions Copyright (C) 1992, 1994 by Sebastian Kremer - -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. */ - -/* - * Parts of this code (& comments) were taken from ls-lisp.el - * Author: Sebastian Kremer - */ - -/* - * insert-directory - * - must insert _exactly_one_line_ describing FILE if WILDCARD and - * FULL-DIRECTORY-P is nil. - * The single line of output must display FILE's name as it was - * given, namely, an absolute path name. - * - must insert exactly one line for each file if WILDCARD or - * FULL-DIRECTORY-P is t, plus one optional "total" line - * before the file lines, plus optional text after the file lines. - * Lines are delimited by "\n", so filenames containing "\n" are not - * allowed. - * File lines should display the basename. - * - must be consistent with - * - functions dired-move-to-filename, (these two define what a file line is) - * dired-move-to-end-of-filename, - * dired-between-files, (shortcut for (not (dired-move-to-filename))) - * dired-insert-headerline - * dired-after-subdir-garbage (defines what a "total" line is) - * - variable dired-subdir-regexp - */ - -/* - * Insert directory listing for FILE, formatted according to SWITCHES. - * Leaves point after the inserted text. - * SWITCHES may be a string of options, or a list of strings. - * Optional third arg WILDCARD means treat FILE as shell wildcard. - * Optional fourth arg FULL-DIRECTORY-P means file is a directory and - * switches do not contain `d', so that a full listing is expected. - * - * This works by running a directory listing program - * whose name is in the variable `insert-directory-program'. - * If WILDCARD, it also runs the shell specified by `shell-file-name'." - */ - -/* - * Set INDENT_LISTING to non-zero if the inserted text should be shifted - * over by two spaces. - */ -#define INDENT_LISTING 0 - -#define ROUND_FILE_SIZES 4096 - - -#include -#include "lisp.h" - -#include "buffer.h" -#include "regex.h" - -#include "sysdir.h" -#include "sysfile.h" -#include "sysproc.h" - -#include -#include -#include - -#include /* To make nt.h happy */ -#include "nt.h" /* For prototypes */ - -#if ROUND_FILE_SIZES > 0 -#include /* for floor() */ -#endif - - -static int mswindows_ls_sort_case_insensitive; -static int mswindows_ls_round_file_size; - -Lisp_Object Qmswindows_insert_directory; - -extern Lisp_Object Vmswindows_downcase_file_names; /* in device-msw.c */ - - - -enum mswindows_sortby { - MSWINDOWS_SORT_BY_NAME, - MSWINDOWS_SORT_BY_NAME_NOCASE, - MSWINDOWS_SORT_BY_MOD_DATE, - MSWINDOWS_SORT_BY_SIZE -}; - - -static enum mswindows_sortby mswindows_sort_method; -static int mswindows_reverse_sort; - - -#define CMPDWORDS(t1a, t1b, t2a, t2b) \ -(((t1a) == (t2a)) ? (((t1b) == (t2b)) ? 0 : (((t1b) < (t2b)) ? -1 : 1)) \ - : (((t1a) < (t2a)) ? -1 : 1)) - - -static int -mswindows_ls_sort_fcn (const void *elem1, const void *elem2) -{ - WIN32_FIND_DATA *e1, *e2; - int status; - - e1 = *(WIN32_FIND_DATA **)elem1; - e2 = *(WIN32_FIND_DATA **)elem2; - switch (mswindows_sort_method) - { - case MSWINDOWS_SORT_BY_NAME: - status = strcmp(e1->cFileName, e2->cFileName); - break; - case MSWINDOWS_SORT_BY_NAME_NOCASE: - status = _stricmp(e1->cFileName, e2->cFileName); - break; - case MSWINDOWS_SORT_BY_MOD_DATE: - status = CMPDWORDS(e1->ftLastWriteTime.dwHighDateTime, - e1->ftLastWriteTime.dwLowDateTime, - e2->ftLastWriteTime.dwHighDateTime, - e2->ftLastWriteTime.dwLowDateTime); - break; - case MSWINDOWS_SORT_BY_SIZE: - status = CMPDWORDS(e1->nFileSizeHigh, e1->nFileSizeLow, - e2->nFileSizeHigh, e2->nFileSizeLow); - break; - default: - status = 0; - break; - } - if (mswindows_reverse_sort) - { - status = -status; - } - return (status); -} - - -static void -mswindows_sort_files (WIN32_FIND_DATA **files, int nfiles, - enum mswindows_sortby sort_by, int reverse) -{ - mswindows_sort_method = sort_by; - mswindows_reverse_sort = reverse; - qsort(files, nfiles, sizeof(WIN32_FIND_DATA *), mswindows_ls_sort_fcn); -} - - -static WIN32_FIND_DATA * -mswindows_get_files (char *dirfile, int nowild, Lisp_Object pattern, - int hide_dot, int hide_system, int *nfiles) -{ - WIN32_FIND_DATA *files; - int array_size; - struct re_pattern_buffer *bufp = NULL; - int findex, len; - char win32pattern[MAXNAMLEN+3]; - HANDLE fh; - - /* - * Much of the following code and comments were taken from dired.c. - * Yes, this is something of a waste, but we want speed, speed, SPEED. - */ - files = NULL; - array_size = *nfiles = 0; - while (1) - { - if (!NILP(pattern)) - { - /* PATTERN might be a flawed regular expression. Rather than - catching and signalling our own errors, we just call - compile_pattern to do the work for us. */ - bufp = compile_pattern (pattern, 0, 0, 0, ERROR_ME); - } - /* Now *bufp is the compiled form of PATTERN; don't call anything - which might compile a new regexp until we're done with the loop! */ - - /* Initialize file info array */ - array_size = 100; /* initial size */ - files = xmalloc(array_size * sizeof (WIN32_FIND_DATA)); - - /* for Win32, we need to insure that the pathname ends with "\*". */ - strcpy (win32pattern, dirfile); - if (!nowild) - { - len = strlen (win32pattern) - 1; - if (!IS_DIRECTORY_SEP (win32pattern[len])) - strcat (win32pattern, "\\"); - strcat (win32pattern, "*"); - } - - /* - * Here, we use FindFirstFile()/FindNextFile() instead of opendir(), - * stat(), & friends, because stat() is VERY expensive in terms of - * time. Hence, we take the time to write complicated Win32-specific - * code, instead of simple Unix-style stuff. - */ - findex = 0; - fh = INVALID_HANDLE_VALUE; - - while (1) - { - int len; - char *filename; - int result; - - if (fh == INVALID_HANDLE_VALUE) - { - fh = FindFirstFile(win32pattern, &files[findex]); - if (fh == INVALID_HANDLE_VALUE) - { - report_file_error ("Opening directory", - list1(build_string(dirfile))); - } - } - else - { - if (!FindNextFile(fh, &files[findex])) - { - if (GetLastError() == ERROR_NO_MORE_FILES) - { - break; - } - FindClose(fh); - report_file_error ("Reading directory", - list1(build_string(dirfile))); - } - } - - filename = files[findex].cFileName; - if (!NILP(Vmswindows_downcase_file_names)) - { - strlwr(filename); - } - len = strlen(filename); - result = (NILP(pattern) - || (0 <= re_search (bufp, filename, - len, 0, len, 0))); - if (result) - { - if ( ! (filename[0] == '.' && - ((hide_system && (filename[1] == '\0' || - (filename[1] == '.' && - filename[2] == '\0'))) || - hide_dot))) - { - if (++findex >= array_size) - { - array_size = findex * 2; - files = xrealloc(files, - array_size * sizeof(WIN32_FIND_DATA)); - } - } - } - } - if (fh != INVALID_HANDLE_VALUE) - { - FindClose (fh); - } - *nfiles = findex; - break; - } - return (files); -} - - -static void -mswindows_format_file (WIN32_FIND_DATA *file, char *buf, int display_size, - int add_newline) -{ - char *cptr; - int len; - Lisp_Object luser; - double file_size; - - len = strlen(file->cFileName); - file_size = - file->nFileSizeHigh * (double)UINT_MAX + file->nFileSizeLow; - cptr = buf; -#if INDENT_LISTING - *cptr++ = ' '; - *cptr++ = ' '; -#endif - if (display_size) - { - sprintf(cptr, "%6d ", (int)((file_size + 1023.) / 1024.)); - cptr += 7; - } - if (file->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - { - *cptr++ = 'd'; - } else { - *cptr++ = '-'; - } - cptr[0] = cptr[3] = cptr[6] = 'r'; - if (file->dwFileAttributes & FILE_ATTRIBUTE_READONLY) - { - cptr[1] = cptr[4] = cptr[7] = '-'; - } else { - cptr[1] = cptr[4] = cptr[7] = 'w'; - } - if ((file->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) || - len > 4 && - (_stricmp(&file->cFileName[len - 4], ".exe") == 0 - || _stricmp(&file->cFileName[len - 4], ".com") == 0 - || _stricmp(&file->cFileName[len - 4], ".bat") == 0 -#if 0 - || _stricmp(&file->cFileName[len - 4], ".pif") == 0 -#endif - )) - { - cptr[2] = cptr[5] = cptr[8] = 'x'; - } else { - cptr[2] = cptr[5] = cptr[8] = '-'; - } - cptr += 9; - if (file->dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - { - strcpy(cptr, " 2 "); - } else { - strcpy(cptr, " 1 "); - } - cptr += 5; - luser = Fuser_login_name(Qnil); - if (!STRINGP(luser)) - { - sprintf(cptr, "%-9d", 0); - } else { - char *str; - - str = XSTRING_DATA(luser); - sprintf(cptr, "%-8s ", str); - } - while (*cptr) - { - ++cptr; - } - sprintf(cptr, "%-8d ", getgid()); - cptr += 9; - if (file_size > 99999999.0) - { - file_size = (file_size + 1023.0) / 1024.; - if (file_size > 999999.0) - { - sprintf(cptr, "%6.0fMB ", (file_size + 1023.0) / 1024.); - } else { - sprintf(cptr, "%6.0fKB ", file_size); - } - } else { - sprintf(cptr, "%8.0f ", file_size); - } - while (*cptr) - { - ++cptr; - } - { - time_t t, now; - char *ctimebuf; - extern char *sys_ctime(const time_t *t); /* in nt.c */ - - if ( -#if 0 - /* - * This doesn't work. - * This code should be correct ... - */ - FileTimeToLocalFileTime(&file->ftLastWriteTime, &localtime) && - ((t = convert_time(localtime)) != 0) && -#else - /* - * But this code "works" ... - */ - ((t = convert_time(file->ftLastWriteTime)) != 0) && -#endif - ((ctimebuf = sys_ctime(&t)) != NULL)) - { - memcpy(cptr, &ctimebuf[4], 7); - now = time(NULL); - if (now - t > (365. / 2.0) * 86400.) - { - /* more than 6 months */ - cptr[7] = ' '; - memcpy(&cptr[8], &ctimebuf[20], 4); - } else { - /* less than 6 months */ - memcpy(&cptr[7], &ctimebuf[11], 5); - } - cptr += 12; - *cptr++ = ' '; - } - } - if (add_newline) - { - sprintf(cptr, "%s\n", file->cFileName); - } - else - { - strcpy(cptr, file->cFileName); - } -} - - -DEFUN ("mswindows-insert-directory", Fmswindows_insert_directory, 2, 4, 0, /* -Insert directory listing for FILE, formatted according to SWITCHES. -Leaves point after the inserted text. -SWITCHES may be a string of options, or a list of strings. -Optional third arg WILDCARD means treat FILE as shell wildcard. -Optional fourth arg FULL-DIRECTORY-P means file is a directory and -switches do not contain `d', so that a full listing is expected. -*/ - (file, switches, wildcard, full_directory_p)) -{ - Lisp_Object result, handler, wildpat, fns, basename; - char *filename; - char *switchstr; - int len, nfiles, i; - int hide_system, hide_dot, reverse, display_size; - WIN32_FIND_DATA *files, **sorted_files; - enum mswindows_sortby sort_by; - char fmtbuf[MAXNAMLEN+100]; /* larger than necessary */ - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - result = Qnil; - wildpat = Qnil; - fns = Qnil; - basename = Qnil; - GCPRO5(result, file, wildpat, fns, basename); - sorted_files = NULL; - switchstr = NULL; - hide_system = 1; - hide_dot = 1; - display_size = 0; - reverse = 0; - sort_by = (mswindows_ls_sort_case_insensitive - ? MSWINDOWS_SORT_BY_NAME_NOCASE - : MSWINDOWS_SORT_BY_NAME); - nfiles = 0; - while (1) - { - handler = Ffind_file_name_handler (file, Qmswindows_insert_directory); - if (!NILP(handler)) - { - result = call5(handler, Qmswindows_insert_directory, file, switches, - wildcard, full_directory_p); - break; - } - CHECK_STRING (file); - if (!NILP(switches)) - { - char *cptr; - - CHECK_STRING (switches); - switchstr = XSTRING_DATA(switches); - for (cptr = switchstr; *cptr; ++cptr) - { - switch (*cptr) - { - case 'A': - hide_dot = 0; - break; - case 'a': - hide_system = 0; - hide_dot = 0; - break; - case 'r': - reverse = 1; - break; - case 's': - display_size = 1; - break; - case 'S': - sort_by = MSWINDOWS_SORT_BY_SIZE; - break; - case 't': - sort_by = MSWINDOWS_SORT_BY_MOD_DATE; - break; - } - } - } - - /* - * Sometimes we get ".../foo* /" as FILE (without the space). - * While the shell and `ls' don't mind, we certainly do, - * because it makes us think there is no wildcard, only a - * directory name. - */ - if (!NILP(Fstring_match(build_string("[[?*]"), file, Qnil, Qnil))) - { - wildcard = Qt; - filename = XSTRING_DATA(file); - len = strlen(filename); - if (len > 0 && (filename[len - 1] == '\\' || - filename[len - 1] == '/')) - { - filename[len - 1] = '\0'; - } - file = build_string(filename); - } - if (!NILP(wildcard)) - { - Lisp_Object newfile; - - basename = Ffile_name_nondirectory(file); - fns = intern("wildcard-to-regexp"); - wildpat = call1(fns, basename); - newfile = Ffile_name_directory(file); - if (NILP(newfile)) - { - /* Ffile_name_directory() can GC */ - newfile = Ffile_name_directory(Fexpand_file_name(file, Qnil)); - } - file = newfile; - } - if (!NILP(wildcard) || !NILP(full_directory_p)) - { - CHECK_STRING(file); - if (!NILP(wildpat)) - { - CHECK_STRING(wildpat); - } - - files = mswindows_get_files(XSTRING_DATA(file), FALSE, wildpat, - hide_dot, hide_system, &nfiles); - if (files == NULL || nfiles == 0) - { - break; - } - } - else - { - files = mswindows_get_files(XSTRING_DATA(file), TRUE, wildpat, - hide_dot, hide_system, &nfiles); - } - if ((sorted_files = xmalloc(nfiles * sizeof(WIN32_FIND_DATA *))) - == NULL) - { - break; - } - for (i = 0; i < nfiles; ++i) - { - sorted_files[i] = &files[i]; - } - if (nfiles > 1) - { - mswindows_sort_files(sorted_files, nfiles, sort_by, reverse); - } - if (!NILP(wildcard) || !NILP(full_directory_p)) - { - /* - * By using doubles, we can handle files up to 2^53 bytes in - * size (IEEE doubles have 53 bits of resolution). However, - * as we divide by 1024 (or 2^10), the total size is - * accurate up to 2^(53+10) --> 2^63 bytes. - * - * Hopefully, we won't have to handle these file sizes anytime - * soon. - */ - double total_size, file_size, block_size; - - if ((block_size = mswindows_ls_round_file_size) <= 0) - { - block_size = 0; - } - total_size = 0; - for (i = 0; i < nfiles; ++i) - { - file_size = - sorted_files[i]->nFileSizeHigh * (double)UINT_MAX + - sorted_files[i]->nFileSizeLow; - if (block_size > 0) - { - /* - * Round file_size up to the next nearest block size. - */ - file_size = - floor((file_size + block_size - 1) / block_size) - * block_size; - } - /* Here, we round to the nearest 1K */ - total_size += floor((file_size + 512.) / 1024.); - } - sprintf(fmtbuf, -#if INDENT_LISTING - /* ANSI C compilers auto-concatenate adjacent strings */ - " " -#endif - "total %.0f\n", total_size); - buffer_insert1(current_buffer, build_string(fmtbuf)); - } - for (i = 0; i < nfiles; ++i) - { - mswindows_format_file(sorted_files[i], fmtbuf, display_size, TRUE); - buffer_insert1(current_buffer, build_string(fmtbuf)); - } - break; - } - if (sorted_files) - { - xfree(sorted_files); - } - UNGCPRO; - return (result); -} - - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_dired_mswindows (void) -{ - defsymbol (&Qmswindows_insert_directory, "mswindows-insert-directory"); - - DEFSUBR (Fmswindows_insert_directory); -} - - -void -vars_of_dired_mswindows (void) -{ - DEFVAR_BOOL ("mswindows-ls-sort-case-insensitive", &mswindows_ls_sort_case_insensitive, /* -*Non-nil means filenames are sorted in a case-insensitive fashion. -Nil means filenames are sorted in a case-sensitive fashion, just like Unix. -*/ ); - mswindows_ls_sort_case_insensitive = 1; - - DEFVAR_INT ("mswindows-ls-round-file-size", &mswindows_ls_round_file_size /* -*If non-zero, file sizes are rounded in terms of this block size when -the file totals are being calculated. This is useful for getting a more -accurate estimate of allocated disk space. Note that this only affects -the total size calculation; the individual displayed file sizes are not -changed. This block size should also be a power of 2 (but this is not -enforced), as filesystem block (cluster) sizes are typically powers-of-2. -*/ ); - /* - * Here, we choose 4096 because it's the cluster size for both FAT32 - * and NTFS (?). This is probably much too small for people using - * plain FAT, but, hopefully, plain FAT will go away someday. - * - * We should allow something like a alist here, to make the size - * dependent on the drive letter, etc.. - */ - mswindows_ls_round_file_size = 4096; -} diff --git a/src/dired.c b/src/dired.c deleted file mode 100644 index e2aed07..0000000 --- a/src/dired.c +++ /dev/null @@ -1,964 +0,0 @@ - /* Lisp functions for making directory listings. - Copyright (C) 1985, 1986, 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: FSF 19.30. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "commands.h" -#include "elhash.h" -#include "regex.h" -#include "opaque.h" -#include "sysfile.h" -#include "sysdir.h" -#include "systime.h" -#include "syspwd.h" - -Lisp_Object Vcompletion_ignored_extensions; -Lisp_Object Qdirectory_files; -Lisp_Object Qfile_name_completion; -Lisp_Object Qfile_name_all_completions; -Lisp_Object Qfile_attributes; - -static Lisp_Object -close_directory_unwind (Lisp_Object unwind_obj) -{ - DIR *d = (DIR *)get_opaque_ptr (unwind_obj); - closedir (d); - free_opaque_ptr (unwind_obj); - return Qnil; -} - -DEFUN ("directory-files", Fdirectory_files, 1, 5, 0, /* -Return a list of names of files in DIRECTORY. -There are four optional arguments: -If FULL is non-nil, absolute pathnames of the files are returned. -If MATCH is non-nil, only pathnames containing that regexp are returned. -If NOSORT is non-nil, the list is not sorted--its order is unpredictable. - NOSORT is useful if you plan to sort the result yourself. -If FILES-ONLY is the symbol t, then only the "files" in the directory - will be returned; subdirectories will be excluded. If FILES-ONLY is not - nil and not t, then only the subdirectories will be returned. Otherwise, - if FILES-ONLY is nil (the default) then both files and subdirectories will - be returned. -*/ - (dirname, full, match, nosort, files_only)) -{ - /* This function can GC */ - DIR *d; - Lisp_Object list = Qnil; - Bytecount dirnamelen; - Lisp_Object handler; - struct re_pattern_buffer *bufp = NULL; - int speccount = specpdl_depth (); - char *statbuf, *statbuf_tail; - - struct gcpro gcpro1, gcpro2; - GCPRO2 (dirname, list); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qdirectory_files); - if (!NILP (handler)) - { - UNGCPRO; - if (!NILP (files_only)) - return call6 (handler, Qdirectory_files, dirname, full, match, nosort, - files_only); - else - return call5 (handler, Qdirectory_files, dirname, full, match, - nosort); - } - - /* #### why do we do Fexpand_file_name after file handlers here, - but earlier everywhere else? */ - dirname = Fexpand_file_name (dirname, Qnil); - dirname = Ffile_name_as_directory (dirname); - dirnamelen = XSTRING_LENGTH (dirname); - - statbuf = (char *)alloca (dirnamelen + MAXNAMLEN + 1); - memcpy (statbuf, XSTRING_DATA (dirname), dirnamelen); - statbuf_tail = statbuf + dirnamelen; - - /* XEmacs: this should come after Ffile_name_as_directory() to avoid - potential regexp cache smashage. It comes before the opendir() - because it might signal an error. */ - if (!NILP (match)) - { - CHECK_STRING (match); - - /* MATCH might be a flawed regular expression. Rather than - catching and signalling our own errors, we just call - compile_pattern to do the work for us. */ - bufp = compile_pattern (match, 0, 0, 0, ERROR_ME); - } - - /* Now *bufp is the compiled form of MATCH; don't call anything - which might compile a new regexp until we're done with the loop! */ - - /* Do this opendir after anything which might signal an error. - NOTE: the above comment is old; previously, there was no - unwind-protection in case of error, but now there is. */ - d = opendir ((char *) XSTRING_DATA (dirname)); - if (!d) - report_file_error ("Opening directory", list1 (dirname)); - - record_unwind_protect (close_directory_unwind, make_opaque_ptr ((void *)d)); - - /* Loop reading blocks */ - while (1) - { - DIRENTRY *dp = readdir (d); - int len; - - if (!dp) - break; - len = NAMLEN (dp); - if (DIRENTRY_NONEMPTY (dp) - && (NILP (match) - || (0 <= re_search (bufp, dp->d_name, len, 0, len, 0)))) - { - if (!NILP (files_only)) - { - int dir_p; - struct stat st; - char *cur_statbuf = statbuf; - char *cur_statbuf_tail = statbuf_tail; - - /* #### I don't think the code under `if' is necessary - anymore. The crashes in this function were reported - because MAXNAMLEN was used to remember the *whole* - statbuf, instead of using MAXPATHLEN. This should be - tested after 21.0 is released. */ - - /* We normally use the buffer created by alloca. - However, if the file name we get too big, we'll use a - malloced buffer, and free it. It is undefined how - stat() will react to this, but we avoid a buffer - overrun. */ - if (len > MAXNAMLEN) - { - cur_statbuf = (char *)xmalloc (dirnamelen + len + 1); - memcpy (cur_statbuf, statbuf, dirnamelen); - cur_statbuf_tail = cur_statbuf + dirnamelen; - } - memcpy (cur_statbuf_tail, dp->d_name, len); - cur_statbuf_tail[len] = 0; - - if (stat (cur_statbuf, &st) < 0) - dir_p = 0; - else - dir_p = ((st.st_mode & S_IFMT) == S_IFDIR); - - if (cur_statbuf != statbuf) - xfree (cur_statbuf); - - if (EQ (files_only, Qt) && dir_p) - continue; - else if (!EQ (files_only, Qt) && !dir_p) - continue; - } - - { - Lisp_Object name = - make_string ((Bufbyte *)dp->d_name, len); - if (!NILP (full)) - name = concat2 (dirname, name); - - list = Fcons (name, list); - } - } - } - unbind_to (speccount, Qnil); /* This will close the dir */ - - if (NILP (nosort)) - list = Fsort (Fnreverse (list), Qstring_lessp); - - RETURN_UNGCPRO (list); -} - -static Lisp_Object file_name_completion (Lisp_Object file, - Lisp_Object dirname, - int all_flag, int ver_flag); - -DEFUN ("file-name-completion", Ffile_name_completion, 2, 2, 0, /* -Complete file name FILE in directory DIR. -Returns the longest string common to all filenames in DIR -that start with FILE. -If there is only one and FILE matches it exactly, returns t. -Returns nil if DIR contains no name starting with FILE. - -Filenames which end with any member of `completion-ignored-extensions' -are not considered as possible completions for FILE unless there is no -other possible completion. `completion-ignored-extensions' is not applied -to the names of directories. -*/ - (file, dirname)) -{ - /* This function can GC. GC checked 1996.04.06. */ - Lisp_Object handler; - - /* If the directory name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qfile_name_completion); - if (!NILP (handler)) - return call3 (handler, Qfile_name_completion, file, dirname); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (file, Qfile_name_completion); - if (!NILP (handler)) - return call3 (handler, Qfile_name_completion, file, dirname); - - return file_name_completion (file, dirname, 0, 0); -} - -DEFUN ("file-name-all-completions", Ffile_name_all_completions, 2, 2, 0, /* -Return a list of all completions of file name FILE in directory DIR. -These are all file names in directory DIR which begin with FILE. - -Filenames which end with any member of `completion-ignored-extensions' -are not considered as possible completions for FILE unless there is no -other possible completion. `completion-ignored-extensions' is not applied -to the names of directories. -*/ - (file, dirname)) -{ - /* This function can GC. GC checked 1997.06.04. */ - Lisp_Object handler; - struct gcpro gcpro1; - - GCPRO1 (dirname); - dirname = Fexpand_file_name (dirname, Qnil); - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (dirname, Qfile_name_all_completions); - UNGCPRO; - if (!NILP (handler)) - return call3 (handler, Qfile_name_all_completions, file, - dirname); - - return file_name_completion (file, dirname, 1, 0); -} - -static int -file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, - struct stat *st_addr) -{ - Bytecount len = NAMLEN (dp); - Bytecount pos = XSTRING_LENGTH (dirname); - int value; - char *fullname = (char *) alloca (len + pos + 2); - - memcpy (fullname, XSTRING_DATA (dirname), pos); - if (!IS_DIRECTORY_SEP (fullname[pos - 1])) - fullname[pos++] = DIRECTORY_SEP; - - memcpy (fullname + pos, dp->d_name, len); - fullname[pos + len] = 0; - -#ifdef S_IFLNK - /* We want to return success if a link points to a nonexistent file, - but we want to return the status for what the link points to, - in case it is a directory. */ - value = lstat (fullname, st_addr); - if (S_ISLNK (st_addr->st_mode)) - stat (fullname, st_addr); -#else - value = stat (fullname, st_addr); -#endif - return value; -} - -static Lisp_Object -file_name_completion_unwind (Lisp_Object locative) -{ - DIR *d; - Lisp_Object obj = XCAR (locative); - - if (!NILP (obj)) - { - d = (DIR *)get_opaque_ptr (obj); - closedir (d); - free_opaque_ptr (obj); - } - free_cons (XCONS (locative)); - return Qnil; -} - -static Lisp_Object -file_name_completion (Lisp_Object file, Lisp_Object dirname, int all_flag, - int ver_flag) -{ - /* This function can GC */ - DIR *d = 0; - int matchcount = 0; - Lisp_Object bestmatch = Qnil; - Charcount bestmatchsize = 0; - struct stat st; - int passcount; - int speccount = specpdl_depth (); - Charcount file_name_length; - Lisp_Object locative; - struct gcpro gcpro1, gcpro2, gcpro3; - - GCPRO3 (file, dirname, bestmatch); - - CHECK_STRING (file); - -#ifdef WINDOWSNT - /* Filename completion on Windows ignores case, since Windows - filesystems do. */ - specbind (Qcompletion_ignore_case, Qt); -#endif /* WINDOWSNT */ - -#ifdef FILE_SYSTEM_CASE - file = FILE_SYSTEM_CASE (file); -#endif - dirname = Fexpand_file_name (dirname, Qnil); - file_name_length = XSTRING_CHAR_LENGTH (file); - - /* With passcount = 0, ignore files that end in an ignored extension. - If nothing found then try again with passcount = 1, don't ignore them. - If looking for all completions, start with passcount = 1, - so always take even the ignored ones. - - ** It would not actually be helpful to the user to ignore any possible - completions when making a list of them.** */ - - /* We cannot use close_directory_unwind() because we change the - directory. The old code used to just avoid signaling errors, and - call closedir, but it was wrong, because it made sane handling of - QUIT impossible and, besides, various utility functions like - regexp_ignore_completion_p can signal errors. */ - locative = noseeum_cons (Qnil, Qnil); - record_unwind_protect (file_name_completion_unwind, locative); - - for (passcount = !!all_flag; NILP (bestmatch) && passcount < 2; passcount++) - { - d = opendir ((char *) XSTRING_DATA (Fdirectory_file_name (dirname))); - if (!d) - report_file_error ("Opening directory", list1 (dirname)); - XCAR (locative) = make_opaque_ptr ((void *)d); - - /* Loop reading blocks */ - while (1) - { - DIRENTRY *dp; - Bytecount len; - /* scmp() works in characters, not bytes, so we have to compute - this value: */ - Charcount cclen; - int directoryp; - int ignored_extension_p = 0; - Bufbyte *d_name; - - dp = readdir (d); - if (!dp) break; - - /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */ - d_name = (Bufbyte *) dp->d_name; - len = NAMLEN (dp); - cclen = bytecount_to_charcount (d_name, len); - - QUIT; - - if (! DIRENTRY_NONEMPTY (dp) - || cclen < file_name_length - || 0 <= scmp (d_name, XSTRING_DATA (file), file_name_length)) - continue; - - if (file_name_completion_stat (dirname, dp, &st) < 0) - continue; - - directoryp = ((st.st_mode & S_IFMT) == S_IFDIR); - if (directoryp) - { -#ifndef TRIVIAL_DIRECTORY_ENTRY -#define TRIVIAL_DIRECTORY_ENTRY(n) (!strcmp (n, ".") || !strcmp (n, "..")) -#endif - /* "." and ".." are never interesting as completions, but are - actually in the way in a directory containing only one file. */ - if (!passcount && TRIVIAL_DIRECTORY_ENTRY (dp->d_name)) - continue; - } - else - { - /* Compare extensions-to-be-ignored against end of this file name */ - /* if name is not an exact match against specified string. */ - if (!passcount && cclen > file_name_length) - { - Lisp_Object tem; - /* and exit this for loop if a match is found */ - EXTERNAL_LIST_LOOP (tem, Vcompletion_ignored_extensions) - { - Lisp_Object elt = XCAR (tem); - Charcount skip; - - CHECK_STRING (elt); - - skip = cclen - XSTRING_CHAR_LENGTH (elt); - if (skip < 0) continue; - - if (0 > scmp (charptr_n_addr (d_name, skip), - XSTRING_DATA (elt), - XSTRING_CHAR_LENGTH (elt))) - { - ignored_extension_p = 1; - break; - } - } - } - } - - /* If an ignored-extensions match was found, - don't process this name as a completion. */ - if (!passcount && ignored_extension_p) - continue; - - if (!passcount && regexp_ignore_completion_p (d_name, Qnil, 0, cclen)) - continue; - - /* Update computation of how much all possible completions match */ - matchcount++; - - if (all_flag || NILP (bestmatch)) - { - Lisp_Object name = Qnil; - struct gcpro ngcpro1; - NGCPRO1 (name); - /* This is a possible completion */ - name = make_string (d_name, len); - if (directoryp) /* Completion is a directory; end it with '/' */ - name = Ffile_name_as_directory (name); - if (all_flag) - { - bestmatch = Fcons (name, bestmatch); - } - else - { - bestmatch = name; - bestmatchsize = XSTRING_CHAR_LENGTH (name); - } - NUNGCPRO; - } - else - { - Charcount compare = min (bestmatchsize, cclen); - Bufbyte *p1 = XSTRING_DATA (bestmatch); - Bufbyte *p2 = d_name; - Charcount matchsize = scmp (p1, p2, compare); - - if (matchsize < 0) - matchsize = compare; - if (completion_ignore_case) - { - /* If this is an exact match except for case, - use it as the best match rather than one that is not - an exact match. This way, we get the case pattern - of the actual match. */ - if ((matchsize == cclen - && matchsize + !!directoryp - < XSTRING_CHAR_LENGTH (bestmatch)) - || - /* If there is no exact match ignoring case, - prefer a match that does not change the case - of the input. */ - (((matchsize == cclen) - == - (matchsize + !!directoryp - == XSTRING_CHAR_LENGTH (bestmatch))) - /* If there is more than one exact match aside from - case, and one of them is exact including case, - prefer that one. */ - && 0 > scmp_1 (p2, XSTRING_DATA (file), - file_name_length, 0) - && 0 <= scmp_1 (p1, XSTRING_DATA (file), - file_name_length, 0))) - { - bestmatch = make_string (d_name, len); - if (directoryp) - bestmatch = Ffile_name_as_directory (bestmatch); - } - } - - /* If this dirname all matches, - see if implicit following slash does too. */ - if (directoryp - && compare == matchsize - && bestmatchsize > matchsize - && IS_ANY_SEP (charptr_emchar_n (p1, matchsize))) - matchsize++; - bestmatchsize = matchsize; - } - } - closedir (d); - free_opaque_ptr (XCAR (locative)); - XCAR (locative) = Qnil; - } - - unbind_to (speccount, Qnil); - - UNGCPRO; - - if (all_flag || NILP (bestmatch)) - return bestmatch; - if (matchcount == 1 && bestmatchsize == file_name_length) - return Qt; - return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); -} - - - -/* The *pwent() functions do not exist on NT */ -#ifndef WINDOWSNT - -static Lisp_Object user_name_completion (Lisp_Object user, - int all_flag, - int *uniq); - -DEFUN ("user-name-completion", Fuser_name_completion, 1, 1, 0, /* -Complete user name USER. - -Returns the longest string common to all user names that start -with USER. If there is only one and USER matches it exactly, -returns t. Returns nil if there is no user name starting with USER. -*/ - (user)) -{ - return user_name_completion (user, 0, NULL); -} - -DEFUN ("user-name-completion-1", Fuser_name_completion_1, 1, 1, 0, /* -Complete user name USER. - -This function is identical to `user-name-completion', except that -the cons of the completion and an indication of whether the -completion was unique is returned. - -The car of the returned value is the longest string common to all -user names that start with USER. If there is only one and USER -matches it exactly, the car is t. The car is nil if there is no -user name starting with USER. The cdr of the result is non-nil -if and only if the completion returned in the car was unique. -*/ - (user)) -{ - int uniq; - Lisp_Object completed; - - completed = user_name_completion (user, 0, &uniq); - return Fcons (completed, uniq ? Qt : Qnil); -} - -DEFUN ("user-name-all-completions", Fuser_name_all_completions, 1, 1, 0, /* -Return a list of all completions of user name USER. -These are all user names which begin with USER. -*/ - (user)) -{ - return user_name_completion (user, 1, NULL); -} - -static Lisp_Object -user_name_completion_unwind (Lisp_Object locative) -{ - Lisp_Object obj1 = XCAR (locative); - Lisp_Object obj2 = XCDR (locative); - char **cache; - int clen, i; - - - if (!NILP (obj1) && !NILP (obj2)) - { - /* clean up if interrupted building cache */ - cache = *(char ***)get_opaque_ptr (obj1); - clen = *(int *)get_opaque_ptr (obj2); - free_opaque_ptr (obj1); - free_opaque_ptr (obj2); - for (i = 0; i < clen; i++) - free (cache[i]); - free (cache); - } - - free_cons (XCONS (locative)); - endpwent (); - - return Qnil; -} - -static char **user_cache; -static int user_cache_len; -static int user_cache_max; -static long user_cache_time; - -#define USER_CACHE_REBUILD (24*60*60) /* 1 day, in seconds */ - -static Lisp_Object -user_name_completion (Lisp_Object user, int all_flag, int *uniq) -{ - /* This function can GC */ - struct passwd *pw; - int matchcount = 0; - Lisp_Object bestmatch = Qnil; - Charcount bestmatchsize = 0; - int speccount = specpdl_depth (); - int i, cmax, clen; - char **cache; - Charcount user_name_length; - Lisp_Object locative; - EMACS_TIME t; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (user, bestmatch); - - CHECK_STRING (user); - - user_name_length = XSTRING_CHAR_LENGTH (user); - - /* Cache user name lookups because it tends to be quite slow. - * Rebuild the cache occasionally to catch changes */ - EMACS_GET_TIME (t); - if (user_cache && - EMACS_SECS (t) - user_cache_time > USER_CACHE_REBUILD) - { - for (i = 0; i < user_cache_len; i++) - free (user_cache[i]); - free (user_cache); - user_cache = NULL; - user_cache_len = 0; - user_cache_max = 0; - } - - if (user_cache == NULL || user_cache_max <= 0) - { - cmax = 200; - clen = 0; - cache = (char **) malloc (cmax*sizeof (char *)); - - setpwent (); - locative = noseeum_cons (Qnil, Qnil); - XCAR (locative) = make_opaque_ptr ((void *) &cache); - XCDR (locative) = make_opaque_ptr ((void *) &clen); - record_unwind_protect (user_name_completion_unwind, locative); - /* #### may need to slow down interrupts around call to getpwent - * below. at least the call to getpwnam in Fuser_full_name - * is documented as needing it on irix. */ - while ((pw = getpwent ())) - { - if (clen >= cmax) - { - cmax *= 2; - cache = (char **) realloc (cache, cmax*sizeof (char *)); - } - - QUIT; - - cache[clen++] = strdup (pw->pw_name); - } - free_opaque_ptr (XCAR (locative)); - free_opaque_ptr (XCDR (locative)); - XCAR (locative) = Qnil; - XCDR (locative) = Qnil; - - unbind_to (speccount, Qnil); /* free locative cons, endpwent() */ - - user_cache_max = cmax; - user_cache_len = clen; - user_cache = cache; - user_cache_time = EMACS_SECS (t); - } - - for (i = 0; i < user_cache_len; i++) - { - Bufbyte *d_name = (Bufbyte *) user_cache[i]; - Bytecount len = strlen ((char *) d_name); - /* scmp() works in chars, not bytes, so we have to compute this: */ - Charcount cclen = bytecount_to_charcount (d_name, len); - - QUIT; - - if (cclen < user_name_length || - 0 <= scmp (d_name, XSTRING_DATA (user), user_name_length)) - continue; - - matchcount++; /* count matching completions */ - - if (all_flag || NILP (bestmatch)) - { - Lisp_Object name = Qnil; - struct gcpro ngcpro1; - NGCPRO1 (name); - /* This is a possible completion */ - name = make_string (d_name, len); - if (all_flag) - { - bestmatch = Fcons (name, bestmatch); - } - else - { - bestmatch = name; - bestmatchsize = XSTRING_CHAR_LENGTH (name); - } - NUNGCPRO; - } - else - { - Charcount compare = min (bestmatchsize, cclen); - Bufbyte *p1 = XSTRING_DATA (bestmatch); - Bufbyte *p2 = d_name; - Charcount matchsize = scmp (p1, p2, compare); - - if (matchsize < 0) - matchsize = compare; - if (completion_ignore_case) - { - /* If this is an exact match except for case, - use it as the best match rather than one that is not - an exact match. This way, we get the case pattern - of the actual match. */ - if ((matchsize == cclen - && matchsize < XSTRING_CHAR_LENGTH (bestmatch)) - || - /* If there is no exact match ignoring case, - prefer a match that does not change the case - of the input. */ - (((matchsize == cclen) - == - (matchsize == XSTRING_CHAR_LENGTH (bestmatch))) - /* If there is more than one exact match aside from - case, and one of them is exact including case, - prefer that one. */ - && 0 > scmp_1 (p2, XSTRING_DATA (user), - user_name_length, 0) - && 0 <= scmp_1 (p1, XSTRING_DATA (user), - user_name_length, 0))) - { - bestmatch = make_string (d_name, len); - } - } - - bestmatchsize = matchsize; - } - } - - UNGCPRO; - - if (uniq) - *uniq = (matchcount == 1); - - if (all_flag || NILP (bestmatch)) - return bestmatch; - if (matchcount == 1 && bestmatchsize == user_name_length) - return Qt; - return Fsubstring (bestmatch, Qzero, make_int (bestmatchsize)); -} -#endif /* ! defined WINDOWSNT */ - - -Lisp_Object -make_directory_hash_table (CONST char *path) -{ - DIR *d; - Lisp_Object hash = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); - if ((d = opendir (path))) - { - DIRENTRY *dp; - - while ((dp = readdir (d))) - { - Bytecount len = NAMLEN (dp); - if (DIRENTRY_NONEMPTY (dp)) - /* Cast to Bufbyte* is OK, as readdir() Mule-encapsulates. */ - Fputhash (make_string ((Bufbyte *) dp->d_name, len), Qt, hash); - } - closedir (d); - } - return hash; -} - -Lisp_Object -wasteful_word_to_lisp (unsigned int item) -{ - /* Compatibility: in other versions, file-attributes returns a LIST - of two 16 bit integers... */ - Lisp_Object cons = word_to_lisp (item); - XCDR (cons) = Fcons (XCDR (cons), Qnil); - return cons; -} - -DEFUN ("file-attributes", Ffile_attributes, 1, 1, 0, /* -Return a list of attributes of file FILENAME. -Value is nil if specified file cannot be opened. -Otherwise, list elements are: - 0. t for directory, string (name linked to) for symbolic link, or nil. - 1. Number of links to file. - 2. File uid. - 3. File 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. - 7. Size in bytes. (-1, if number is out of range). - 8. File modes, as a string of ten letters or dashes as in ls -l. - 9. t iff file's gid would change if file were deleted and recreated. -10. inode number. -11. Device number. - -If file does not exist, returns nil. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.06.04. */ - Lisp_Object values[12]; - Lisp_Object dirname = Qnil; - struct stat s; - char modes[10]; - Lisp_Object handler; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (filename, dirname); - filename = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qfile_attributes); - if (!NILP (handler)) - { - UNGCPRO; - return call2 (handler, Qfile_attributes, filename); - } - - if (lstat ((char *) XSTRING_DATA (filename), &s) < 0) - { - UNGCPRO; - return Qnil; - } - -#ifdef BSD4_2 - dirname = Ffile_name_directory (filename); -#endif - -#ifdef MSDOS - { - char *tmpnam = (char *) XSTRING_DATA (Ffile_name_nondirectory (filename)); - int l = strlen (tmpnam); - - if (l >= 5 - && S_ISREG (s.st_mode) - && (stricmp (&tmpnam[l - 4], ".com") == 0 || - stricmp (&tmpnam[l - 4], ".exe") == 0 || - stricmp (&tmpnam[l - 4], ".bat") == 0)) - { - s.st_mode |= S_IEXEC; - } - } -#endif /* MSDOS */ - - switch (s.st_mode & S_IFMT) - { - default: - values[0] = Qnil; - break; - case S_IFDIR: - values[0] = Qt; - break; -#ifdef S_IFLNK - case S_IFLNK: - values[0] = Ffile_symlink_p (filename); - break; -#endif - } - values[1] = make_int (s.st_nlink); - values[2] = make_int (s.st_uid); - values[3] = make_int (s.st_gid); - values[4] = wasteful_word_to_lisp (s.st_atime); - values[5] = wasteful_word_to_lisp (s.st_mtime); - values[6] = wasteful_word_to_lisp (s.st_ctime); - values[7] = make_int ((EMACS_INT) s.st_size); - /* If the size is out of range, give back -1. */ - /* #### Fix when Emacs gets bignums! */ - if (XINT (values[7]) != s.st_size) - values[7] = make_int (-1); - filemodestring (&s, modes); - values[8] = make_string ((Bufbyte *) modes, 10); -#if defined (BSD4_2) || defined (BSD4_3) /* file gid will be dir gid */ - { - struct stat sdir; - - if (!NILP (dirname) && stat ((char *) XSTRING_DATA (dirname), &sdir) == 0) - values[9] = (sdir.st_gid != s.st_gid) ? Qt : Qnil; - else /* if we can't tell, assume worst */ - values[9] = Qt; - } -#else /* file gid will be egid */ - values[9] = (s.st_gid != getegid ()) ? Qt : Qnil; -#endif /* BSD4_2 or BSD4_3 */ - values[10] = make_int (s.st_ino); - values[11] = make_int (s.st_dev); - UNGCPRO; - return Flist (countof (values), values); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_dired (void) -{ - defsymbol (&Qdirectory_files, "directory-files"); - defsymbol (&Qfile_name_completion, "file-name-completion"); - defsymbol (&Qfile_name_all_completions, "file-name-all-completions"); - defsymbol (&Qfile_attributes, "file-attributes"); - - DEFSUBR (Fdirectory_files); - DEFSUBR (Ffile_name_completion); - DEFSUBR (Ffile_name_all_completions); -#ifndef WINDOWSNT - DEFSUBR (Fuser_name_completion); - DEFSUBR (Fuser_name_completion_1); - DEFSUBR (Fuser_name_all_completions); -#endif - DEFSUBR (Ffile_attributes); -} - -void -vars_of_dired (void) -{ - DEFVAR_LISP ("completion-ignored-extensions", &Vcompletion_ignored_extensions /* -*Completion ignores filenames ending in any string in this list. -This variable does not affect lists of possible completions, -but does affect the commands that actually do completions. -It is used by the functions `file-name-completion' and -`file-name-all-completions'. -*/ ); - Vcompletion_ignored_extensions = Qnil; - -#ifndef WINDOWSNT - user_cache = NULL; - user_cache_len = 0; - user_cache_max = 0; -#endif -} diff --git a/src/doc.c b/src/doc.c deleted file mode 100644 index 8174a02..0000000 --- a/src/doc.c +++ /dev/null @@ -1,1006 +0,0 @@ -/* Record indices of function doc strings stored in a file. - Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 - 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: FSF 19.30. */ - -/* This file has been Mule-ized except as noted. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "bytecode.h" -#include "insdel.h" -#include "keymap.h" -#include "sysfile.h" - -Lisp_Object Vinternal_doc_file_name; - -Lisp_Object QSsubstitute; - -/* Read and return doc string from open file descriptor FD - at position POSITION. Does not close the file. Returns - string; or if error, returns a cons holding the error - data to pass to Fsignal. NAME_NONRELOC and NAME_RELOC - are only used for the error messages. */ - -Lisp_Object -unparesseuxify_doc_string (int fd, EMACS_INT position, - char *name_nonreloc, Lisp_Object name_reloc) -{ - char buf[512 * 32 + 1]; - char *buffer = buf; - int buffer_size = sizeof (buf); - char *from, *to; - REGISTER char *p = buffer; - Lisp_Object return_me; - - if (0 > lseek (fd, position, 0)) - { - if (name_nonreloc) - name_reloc = build_string (name_nonreloc); - return_me = list3 (build_string - ("Position out of range in doc string file"), - name_reloc, make_int (position)); - goto done; - } - - /* Read the doc string into a buffer. - Use the fixed buffer BUF if it is big enough; otherwise allocate one. - We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */ - - while (1) - { - int space_left = buffer_size - (p - buffer); - int nread; - - /* Switch to a bigger buffer if we need one. */ - if (space_left == 0) - { - char * old_buffer = buffer; - if (buffer == buf) { - buffer = (char *) xmalloc (buffer_size *= 2); - memcpy (buffer, old_buffer, p - old_buffer); - } else { - buffer = (char *) xrealloc (buffer, buffer_size *= 2); - } - p += buffer - old_buffer; - space_left = buffer_size - (p - buffer); - } - - /* Don't read too much at one go. */ - if (space_left > 1024 * 8) - space_left = 1024 * 8; - nread = read (fd, p, space_left); - if (nread < 0) - { - return_me = list1 (build_string - ("Read error on documentation file")); - goto done; - } - p[nread] = 0; - if (!nread) - break; - { - char *p1 = strchr (p, '\037'); /* End of doc string marker */ - if (p1) - { - *p1 = 0; - p = p1; - break; - } - } - p += nread; - } - - /* Scan the text and remove quoting with ^A (char code 1). - ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ - from = to = buffer; - while (from < p) - { - if (*from != 1 /*^A*/) - *to++ = *from++; - else - { - int c = *(++from); - - from++; - switch (c) - { - case 1: *to++ = c; break; - case '0': *to++ = '\0'; break; - case '_': *to++ = '\037'; break; - default: - return_me = list2 (build_string - ("Invalid data in documentation file -- ^A followed by weird code"), - make_int (c)); - goto done; - } - } - } - - /* #### mrb: following STILL completely broken */ - return_me = make_ext_string ((Bufbyte *) buffer, to - buffer, FORMAT_BINARY); - - done: - if (buffer != buf) /* We must have allocated buffer above */ - xfree (buffer); - return return_me; -} - -#define string_join(dest, s1, s2) \ - memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \ - memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \ - (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2)); \ - dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0' - -/* Extract a doc string from a file. FILEPOS says where to get it. - (This could actually be byte code instructions/constants instead - of a doc string.) - If it is an integer, use that position in the standard DOC file. - If it is (FILE . INTEGER), use FILE as the file name - and INTEGER as the position in that file. - But if INTEGER is negative, make it positive. - (A negative integer is used for user variables, so we can distinguish - them without actually fetching the doc string.) */ - -static Lisp_Object -get_doc_string (Lisp_Object filepos) -{ - /* !!#### This function has not been Mule-ized */ - REGISTER int fd; - REGISTER char *name_nonreloc = 0; - int minsize; - EMACS_INT position; - Lisp_Object file, tem; - Lisp_Object name_reloc = Qnil; - - if (INTP (filepos)) - { - file = Vinternal_doc_file_name; - position = XINT (filepos); - } - else if (CONSP (filepos) && INTP (XCDR (filepos))) - { - file = XCAR (filepos); - position = XINT (XCDR (filepos)); - if (position < 0) - position = - position; - } - else - return Qnil; - - if (!STRINGP (file)) - return Qnil; - - /* Put the file name in NAME as a C string. - If it is relative, combine it with Vdoc_directory. */ - - tem = Ffile_name_absolute_p (file); - if (NILP (tem)) - { - /* XEmacs: Move this check here. OK if called during loadup to - load byte code instructions. */ - if (!STRINGP (Vdoc_directory)) - return Qnil; - - minsize = XSTRING_LENGTH (Vdoc_directory); - /* sizeof ("../lib-src/") == 12 */ - if (minsize < 12) - minsize = 12; - name_nonreloc = (char *) alloca (minsize + XSTRING_LENGTH (file) + 8); - string_join (name_nonreloc, Vdoc_directory, file); - } - else - name_reloc = file; - - fd = open (name_nonreloc ? name_nonreloc : - (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); - if (fd < 0) - { -#ifndef CANNOT_DUMP - if (purify_flag) - { - /* sizeof ("../lib-src/") == 12 */ - name_nonreloc = (char *) alloca (12 + XSTRING_LENGTH (file) + 8); - /* Preparing to dump; DOC file is probably not installed. - So check in ../lib-src. */ - strcpy (name_nonreloc, "../lib-src/"); - strcat (name_nonreloc, (char *) XSTRING_DATA (file)); - - fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); - } -#endif /* CANNOT_DUMP */ - - if (fd < 0) - error ("Cannot open doc string file \"%s\"", - name_nonreloc ? name_nonreloc : - (char *) XSTRING_DATA (name_reloc)); - } - - tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc); - close (fd); - - if (!STRINGP (tem)) - signal_error (Qerror, tem); - - return tem; -} - -/* Get a string from position FILEPOS and pass it through the Lisp reader. - We use this for fetching the bytecode string and constants vector - of a compiled function from the .elc file. */ - -Lisp_Object -read_doc_string (Lisp_Object filepos) -{ - Lisp_Object string = get_doc_string (filepos); - - if (!STRINGP (string)) - signal_simple_error ("loading bytecode failed to return string", string); - return Fread (string); -} - -DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* -Return the documentation string of FUNCTION. -Unless a non-nil second argument is given, the -string is passed through `substitute-command-keys'. -*/ - (function, raw)) -{ - /* This function can GC */ - Lisp_Object fun; - Lisp_Object doc; - - fun = Findirect_function (function); - - if (SUBRP (fun)) - { - if (XSUBR (fun)->doc == 0) - return Qnil; - if ((EMACS_INT) XSUBR (fun)->doc >= 0) - doc = build_string (XSUBR (fun)->doc); - else - doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc)); - } - else if (COMPILED_FUNCTIONP (fun)) - { - Lisp_Object tem; - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - if (! (f->flags.documentationp)) - return Qnil; - tem = compiled_function_documentation (f); - if (STRINGP (tem)) - doc = tem; - else if (NATNUMP (tem) || CONSP (tem)) - doc = get_doc_string (tem); - else - return Qnil; - } - else if (KEYMAPP (fun)) - return build_translated_string ("Prefix command (definition is a keymap of subcommands)."); - else if (STRINGP (fun) || VECTORP (fun)) - return build_translated_string ("Keyboard macro."); - else if (CONSP (fun)) - { - Lisp_Object funcar = Fcar (fun); - - if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, list1 (fun)); - else if (EQ (funcar, Qlambda) - || EQ (funcar, Qautoload)) - { - Lisp_Object tem, tem1; - tem1 = Fcdr (Fcdr (fun)); - tem = Fcar (tem1); - if (STRINGP (tem)) - doc = tem; - /* Handle a doc reference--but these never come last - in the function body, so reject them if they are last. */ - else if ((NATNUMP (tem) || CONSP (tem)) - && ! NILP (XCDR (tem1))) - doc = get_doc_string (tem); - else - return Qnil; - } - else if (EQ (funcar, Qmacro)) - return Fdocumentation (Fcdr (fun), raw); - else - goto oops; - } - else - { - oops: - return Fsignal (Qinvalid_function, list1 (fun)); - } - - if (NILP (raw)) - { - struct gcpro gcpro1; -#ifdef I18N3 - Lisp_Object domain = Qnil; - if (COMPILED_FUNCTIONP (fun)) - domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); - if (NILP (domain)) - doc = Fgettext (doc); - else - doc = Fdgettext (domain, doc); -#endif - - GCPRO1 (doc); - doc = Fsubstitute_command_keys (doc); - UNGCPRO; - } - return doc; -} - -DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /* -Return the documentation string that is SYMBOL's PROP property. -This is like `get', but it can refer to strings stored in the -`doc-directory/DOC' file; and if the value is a string, it is passed -through `substitute-command-keys'. A non-nil third argument avoids this -translation. -*/ - (sym, prop, raw)) -{ - /* This function can GC */ - REGISTER Lisp_Object doc = Qnil; -#ifdef I18N3 - REGISTER Lisp_Object domain; -#endif - struct gcpro gcpro1; - - GCPRO1 (doc); - - doc = Fget (sym, prop, Qnil); - if (INTP (doc)) - doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc))); - else if (CONSP (doc)) - doc = get_doc_string (doc); -#ifdef I18N3 - if (!NILP (doc)) - { - domain = Fget (sym, Qvariable_domain, Qnil); - if (NILP (domain)) - doc = Fgettext (doc); - else - doc = Fdgettext (domain, doc); - } -#endif - if (NILP (raw) && STRINGP (doc)) - doc = Fsubstitute_command_keys (doc); - UNGCPRO; - return doc; -} - -static void -weird_doc (Lisp_Object sym, CONST char *weirdness, CONST char *type, int pos) -{ - if (!strcmp (weirdness, GETTEXT ("duplicate"))) return; - message ("Note: Strange doc (%s) for %s %s @ %d", - weirdness, type, string_data (XSYMBOL (sym)->name), pos); -} - - -DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* -Used during Emacs initialization, before dumping runnable Emacs, -to find pointers to doc strings stored in `.../lib-src/DOC' and -record them in function definitions. -One arg, FILENAME, a string which does not include a directory. -The file is written to `../lib-src', and later found in `exec-directory' -when doc strings are referred to in the dumped Emacs. -*/ - (filename)) -{ - /* !!#### This function has not been Mule-ized */ - int fd; - char buf[1024 + 1]; - REGISTER int filled; - REGISTER int pos; - REGISTER char *p, *end; - Lisp_Object sym, fun, tem; - char *name; - -#ifndef CANNOT_DUMP - if (!purify_flag) - error ("Snarf-documentation can only be called in an undumped Emacs"); -#endif - - CHECK_STRING (filename); - -#ifdef CANNOT_DUMP - if (!NILP(Vdoc_directory)) - { - CHECK_STRING (Vdoc_directory); - name = (char *) alloca (XSTRING_LENGTH (filename) - + XSTRING_LENGTH (Vdoc_directory) - + 1); - strcpy (name, (char *) XSTRING_DATA (Vdoc_directory)); - } - else -#endif /* CANNOT_DUMP */ - { - name = (char *) alloca (XSTRING_LENGTH (filename) + 14); - strcpy (name, "../lib-src/"); - } - - strcat (name, (char *) XSTRING_DATA (filename)); - - fd = open (name, O_RDONLY | OPEN_BINARY, 0); - if (fd < 0) - report_file_error ("Opening doc string file", - Fcons (build_string (name), Qnil)); - Vinternal_doc_file_name = filename; - filled = 0; - pos = 0; - while (1) - { - if (filled < 512) - filled += read (fd, &buf[filled], sizeof buf - 1 - filled); - if (!filled) - break; - - buf[filled] = 0; - p = buf; - end = buf + (filled < 512 ? filled : filled - 128); - while (p != end && *p != '\037') p++; - /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ - if (p != end) - { - end = strchr (p, '\n'); - sym = oblookup (Vobarray, (Bufbyte *) p + 2, end - p - 2); - if (SYMBOLP (sym)) - { - Lisp_Object offset = make_int (pos + end + 1 - buf); - /* Attach a docstring to a variable */ - if (p[1] == 'V') - { - /* Install file-position as variable-documentation property - and make it negative for a user-variable - (doc starts with a `*'). */ - Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero); - if (!ZEROP (old)) - { - weird_doc (sym, GETTEXT ("duplicate"), - GETTEXT ("variable"), pos); - /* In the case of duplicate doc file entries, always - take the later one. But if the doc is not an int - (a string, say) leave it alone. */ - if (!INTP (old)) - goto weird; - } - Fput (sym, Qvariable_documentation, - ((end[1] == '*') - ? make_int (- XINT (offset)) - : offset)); - } - /* Attach a docstring to a function. - The type determines where the docstring is stored. */ - else if (p[1] == 'F') - { - fun = indirect_function (sym,0); - - if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) - fun = XCDR (fun); - - if (UNBOUNDP (fun)) - { - /* May have been #if'ed out or something */ - weird_doc (sym, GETTEXT ("not fboundp"), - GETTEXT ("function"), pos); - goto weird; - } - else if (SUBRP (fun)) - { - /* Lisp_Subrs have a slot for it. */ - if (XSUBR (fun)->doc) - { - weird_doc (sym, GETTEXT ("duplicate"), - GETTEXT ("subr"), pos); - goto weird; - } - XSUBR (fun)->doc = (char *) (- XINT (offset)); - } - else if (CONSP (fun)) - { - /* If it's a lisp form, stick it in the form. */ - tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) - { - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && - INTP (XCAR (tem))) - { - Lisp_Object old = XCAR (tem); - if (!ZEROP (old)) - { - weird_doc (sym, GETTEXT ("duplicate"), - (EQ (tem, Qlambda) - ? GETTEXT ("lambda") - : GETTEXT ("autoload")), - pos); - /* In the case of duplicate doc file entries, - always take the later one. But if the doc - is not an int (a string, say) leave it - alone. */ - if (!INTP (old)) - goto weird; - } - XCAR (tem) = offset; - } - else if (!CONSP (tem)) - { - weird_doc (sym, GETTEXT ("!CONSP(tem)"), - GETTEXT ("function"), pos); - goto cont; - } - else - { - /* DOC string is a string not integer 0 */ -#if 0 - weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"), - GETTEXT ("function"), pos); -#endif - goto cont; - } - } - else - { - weird_doc (sym, GETTEXT ("not lambda or autoload"), - GETTEXT ("function"), pos); - goto cont; - } - } - else if (COMPILED_FUNCTIONP (fun)) - { - /* Compiled-Function objects sometimes have - slots for it. */ - struct Lisp_Compiled_Function *f = - XCOMPILED_FUNCTION (fun); - - /* This compiled-function object must have a - slot for the docstring, since we've found a - docstring for it. Unless there were multiple - definitions of it, and the latter one didn't - have any doc, which is a legal if slightly - bogus situation, so don't blow up. */ - - if (! (f->flags.documentationp)) - { - weird_doc (sym, GETTEXT ("no doc slot"), - GETTEXT ("bytecode"), pos); - goto weird; - } - else - { - Lisp_Object old = - compiled_function_documentation (f); - if (!ZEROP (old)) - { - weird_doc (sym, GETTEXT ("duplicate"), - GETTEXT ("bytecode"), pos); - /* In the case of duplicate doc file entries, - always take the later one. But if the doc is - not an int (a string, say) leave it alone. */ - if (!INTP (old)) - goto weird; - } - set_compiled_function_documentation (f, offset); - } - } - else - { - /* Otherwise the function is undefined or - otherwise weird. Ignore it. */ - weird_doc (sym, GETTEXT ("weird function"), - GETTEXT ("function"), pos); - goto weird; - } - } - else - { - /* lose: */ - error ("DOC file invalid at position %d", pos); - weird: - /* goto lose */; - } - } - } - cont: - pos += end - buf; - filled -= end - buf; - memmove (buf, end, filled); - } - close (fd); - return Qnil; -} - - -#if 1 /* Don't warn about functions whose doc was lost because they were - wrapped by advice-freeze.el... */ -static int -kludgily_ignore_lost_doc_p (Lisp_Object sym) -{ -# define kludge_prefix "ad-Orig-" - struct Lisp_String *name = XSYMBOL (sym)->name; - return (string_length (name) > (Bytecount) (sizeof (kludge_prefix)) && - !strncmp ((char *) string_data (name), kludge_prefix, - sizeof (kludge_prefix) - 1)); -# undef kludge_prefix -} -#else -# define kludgily_ignore_lost_doc_p(sym) 0 -#endif - - -static int -verify_doc_mapper (Lisp_Object sym, void *arg) -{ - Lisp_Object closure = *(Lisp_Object *)arg; - - if (!NILP (Ffboundp (sym))) - { - int doc = 0; - Lisp_Object fun = XSYMBOL (sym)->function; - if (CONSP (fun) && - EQ (XCAR (fun), Qmacro)) - fun = XCDR (fun); - - if (SUBRP (fun)) - doc = (EMACS_INT) XSUBR (fun)->doc; - else if (SYMBOLP (fun)) - doc = -1; - else if (KEYMAPP (fun)) - doc = -1; - else if (CONSP (fun)) - { - Lisp_Object tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) - { - doc = -1; - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && - INTP (XCAR (tem))) - doc = XINT (XCAR (tem)); - } - } - else if (COMPILED_FUNCTIONP (fun)) - { - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); - if (! (f->flags.documentationp)) - doc = -1; - else - { - Lisp_Object tem = compiled_function_documentation (f); - if (INTP (tem)) - doc = XINT (tem); - } - } - - if (doc == 0 && !kludgily_ignore_lost_doc_p (sym)) - { - message ("Warning: doc lost for function %s.", - string_data (XSYMBOL (sym)->name)); - XCDR (closure) = Qt; - } - } - if (!NILP (Fboundp (sym))) - { - Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil); - if (ZEROP (doc)) - { - message ("Warning: doc lost for variable %s.", - string_data (XSYMBOL (sym)->name)); - XCDR (closure) = Qt; - } - } - return 0; /* Never stop */ -} - -DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /* -Used to make sure everything went well with Snarf-documentation. -Writes to stderr if not. -*/ - ()) -{ - Lisp_Object closure = Fcons (Qnil, Qnil); - struct gcpro gcpro1; - GCPRO1 (closure); - map_obarray (Vobarray, verify_doc_mapper, &closure); - if (!NILP (Fcdr (closure))) - message ("\n" -"This is usually because some files were preloaded by loaddefs.el or\n" -"site-load.el, but were not passed to make-docfile by Makefile.\n"); - UNGCPRO; - return NILP (Fcdr (closure)) ? Qt : Qnil; -} - - -DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /* -Substitute key descriptions for command names in STRING. -Return a new string which is STRING with substrings of the form \\=\\[COMMAND] -replaced by either: a keystroke sequence that will invoke COMMAND, -or "M-x COMMAND" if COMMAND is not on any keys. -Substrings of the form \\=\\{MAPVAR} are replaced by summaries -\(made by describe-bindings) of the value of MAPVAR, taken as a keymap. -Substrings of the form \\=\\ specify to use the value of MAPVAR -as the keymap for future \\=\\[COMMAND] substrings. -\\=\\= quotes the following character and is discarded; -thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. -*/ - (str)) -{ - /* This function can GC */ - Bufbyte *buf; - int changed = 0; - REGISTER Bufbyte *strdata; - REGISTER Bufbyte *bufp; - Bytecount strlength; - Bytecount idx; - Bytecount bsize; - Bufbyte *new; - Lisp_Object tem; - Lisp_Object keymap; - Bufbyte *start; - Bytecount length; - Lisp_Object name; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - if (NILP (str)) - return Qnil; - - CHECK_STRING (str); - tem = Qnil; - keymap = Qnil; - name = Qnil; - GCPRO4 (str, tem, keymap, name); - - /* There is the possibility that the string is not destined for a - translating stream, and it could be argued that we should do the - same thing here as in Fformat(), but there are very few times - when this will be the case and many calls to this function - would have to have `gettext' calls added. (I18N3) */ - str = LISP_GETTEXT (str); - - /* KEYMAP is either nil (which means search all the active keymaps) - or a specified local map (which means search just that and the - global map). If non-nil, it might come from Voverriding_local_map, - or from a \\ construct in STR itself.. */ -#if 0 /* FSFmacs */ - /* This is really weird and garbagey. If keymap is nil and there's - an overriding-local-map, `where-is-internal' will correctly note - this, so there's no reason to do it here. Maybe FSFmacs - `where-is-internal' is broken. */ - /* - keymap = current_kboard->Voverriding_terminal_local_map; - if (NILP (keymap)) - keymap = Voverriding_local_map; - */ -#endif - - strlength = XSTRING_LENGTH (str); - bsize = 1 + strlength; - buf = (Bufbyte *) xmalloc (bsize); - bufp = buf; - - /* Have to reset strdata every time GC might be called */ - strdata = XSTRING_DATA (str); - for (idx = 0; idx < strlength; ) - { - Bufbyte *strp = strdata + idx; - - if (strp[0] != '\\') - { - /* just copy other chars */ - /* As it happens, this will work with Mule even if the - character quoted is multi-byte; the remaining multi-byte - characters will just be copied by this loop. */ - *bufp++ = *strp; - idx++; - } - else switch (strp[1]) - { - default: - { - /* just copy unknown escape sequences */ - *bufp++ = *strp; - idx++; - break; - } - case '=': - { - /* \= quotes the next character; - thus, to put in \[ without its special meaning, use \=\[. */ - /* As it happens, this will work with Mule even if the - character quoted is multi-byte; the remaining multi-byte - characters will just be copied by this loop. */ - changed = 1; - *bufp++ = strp[2]; - idx += 3; - break; - } - case '[': - { - changed = 1; - idx += 2; /* skip \[ */ - strp += 2; - start = strp; - - while ((idx < strlength) - && *strp != ']') - { - strp++; - idx++; - } - length = strp - start; - idx++; /* skip ] */ - - tem = Fintern (make_string (start, length), Qnil); - tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); - -#if 0 /* FSFmacs */ - /* Disregard menu bar bindings; it is positively annoying to - mention them when there's no menu bar, and it isn't terribly - useful even when there is a menu bar. */ - if (!NILP (tem)) - { - firstkey = Faref (tem, Qzero); - if (EQ (firstkey, Qmenu_bar)) - tem = Qnil; - } -#endif - - if (NILP (tem)) /* but not on any keys */ - { - new = (Bufbyte *) xrealloc (buf, bsize += 4); - bufp += new - buf; - buf = new; - memcpy (bufp, "M-x ", 4); - bufp += 4; - goto subst; - } - else - { /* function is on a key */ - tem = Fkey_description (tem); - goto subst_string; - } - } - case '{': - case '<': - { - /* ### jump to label `subst_string|subst' crosses - initialization of `buffer|_buf' */ - Lisp_Object buffer; - struct buffer *buf_; - - buffer = Fget_buffer_create (QSsubstitute); - buf_ = XBUFFER (buffer); - - Fbuffer_disable_undo (buffer); - Ferase_buffer (buffer); - - /* \{foo} is replaced with a summary of keymap (symbol-value foo). - \ just sets the keymap used for \[cmd]. */ - changed = 1; - idx += 2; /* skip \{ or \< */ - strp += 2; - start = strp; - - while ((idx < strlength) - && *strp != '}' && *strp != '>') - { - strp++; - idx++; - } - length = strp - start; - idx++; /* skip } or > */ - - /* Get the value of the keymap in TEM, or nil if undefined. - Do this while still in the user's current buffer - in case it is a local variable. */ - name = Fintern (make_string (start, length), Qnil); - tem = Fboundp (name); - if (! NILP (tem)) - { - tem = Fsymbol_value (name); - if (! NILP (tem)) - tem = get_keymap (tem, 0, 1); - } - - if (NILP (tem)) - { - char boof[255], *b = boof; - *b++ = '\n'; - /* #### This sprintf() is potentially dangerous! */ - sprintf (b, GETTEXT ( - "Uses keymap \"%s\", which is not currently defined."), - (char *) XSTRING_DATA (Fsymbol_name (name))); - b += strlen (b); - *b++ = '\n'; - *b++ = 0; - buffer_insert_c_string (buf_, boof); - - if (start[-1] == '<') keymap = Qnil; - } - else if (start[-1] == '<') - keymap = tem; - else - describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer); - - tem = make_string_from_buffer (buf_, BUF_BEG (buf_), - BUF_Z (buf_) - BUF_BEG (buf_)); - Ferase_buffer (buffer); - goto subst_string; - - subst_string: - start = XSTRING_DATA (tem); - length = XSTRING_LENGTH (tem); - subst: - bsize += length; - new = (Bufbyte *) xrealloc (buf, bsize); - bufp += new - buf; - buf = new; - memcpy (bufp, start, length); - bufp += length; - - /* Reset STRDATA in case gc relocated it. */ - strdata = XSTRING_DATA (str); - - break; - } - } - } - - if (changed) /* don't bother if nothing substituted */ - tem = make_string (buf, bufp - buf); - else - tem = str; - xfree (buf); - UNGCPRO; - return tem; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_doc (void) -{ - DEFSUBR (Fdocumentation); - DEFSUBR (Fdocumentation_property); - DEFSUBR (Fsnarf_documentation); - DEFSUBR (Fverify_documentation); - DEFSUBR (Fsubstitute_command_keys); -} - -void -vars_of_doc (void) -{ - DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /* -Name of file containing documentation strings of built-in symbols. -*/ ); - Vinternal_doc_file_name = Qnil; - - QSsubstitute = build_string (" *substitute*"); - staticpro (&QSsubstitute); -} diff --git a/src/doprnt.c b/src/doprnt.c deleted file mode 100644 index 8259c5a..0000000 --- a/src/doprnt.c +++ /dev/null @@ -1,890 +0,0 @@ -/* Output like sprintf to a buffer of specified size. - Also takes args differently: pass one pointer to an array of strings - in addition to the format string which is separate. - Copyright (C) 1995 Free Software Foundation, Inc. - Rewritten by mly to use varargs.h. - Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded - to full printf spec. - -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: Rewritten. Not in FSF. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "lstream.h" - -static CONST char *valid_flags = "-+ #0"; - -static CONST char *valid_converters = "diouxXfeEgGcsS"; -static CONST char *int_converters = "dic"; -static CONST char *unsigned_int_converters = "ouxX"; -static CONST char *double_converters = "feEgG"; -static CONST char *string_converters = "sS"; - -typedef struct printf_spec printf_spec; -struct printf_spec -{ - int argnum; /* which argument does this spec want? This is one-based: - The first argument given is numbered 1, the second - is 2, etc. This is to handle %##$x-type specs. */ - int minwidth; - int precision; - unsigned int minus_flag:1; - unsigned int plus_flag:1; - unsigned int space_flag:1; - unsigned int number_flag:1; - unsigned int zero_flag:1; - unsigned int h_flag:1; - unsigned int l_flag:1; - unsigned int forwarding_precision:1; - char converter; /* converter character or 0 for dummy marker - indicating literal text at the end of the - specification */ - Bytecount text_before; /* position of the first character of the - block of literal text before this spec */ - Bytecount text_before_len; /* length of that text */ -}; - -typedef union printf_arg printf_arg; -union printf_arg -{ - int i; - unsigned int ui; - long l; - unsigned long ul; - double d; - Bufbyte *bp; -}; - -/* We maintain a list of all the % specs in the specification, - along with the offset and length of the block of literal text - before each spec. In addition, we have a "dummy" spec that - represents all the literal text at the end of the specification. - Its converter is 0. */ - -typedef struct -{ - Dynarr_declare (struct printf_spec); -} printf_spec_dynarr; - -typedef struct -{ - Dynarr_declare (union printf_arg); -} printf_arg_dynarr; - -/* Append STRING (of length LEN) to STREAM. MINLEN is the minimum field - width. If MINUS_FLAG is set, left-justify the string in its field; - otherwise, right-justify. If ZERO_FLAG is set, pad with 0's; otherwise - pad with spaces. If MAXLEN is non-negative, the string is first - truncated to that many character. - - Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */ - -static void -doprnt_1 (Lisp_Object stream, CONST Bufbyte *string, Bytecount len, - Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag) -{ - Charcount cclen; - Bufbyte pad; - Lstream *lstr = XLSTREAM (stream); - - cclen = bytecount_to_charcount (string, len); - - if (zero_flag) - pad = '0'; - else - pad = ' '; - - /* Padding at beginning to right-justify ... */ - if (minlen > cclen && !minus_flag) - { - int to_add = minlen - cclen; - while (to_add > 0) - { - Lstream_putc (lstr, pad); - to_add--; - } - } - - if (maxlen >= 0) - len = charcount_to_bytecount (string, min (maxlen, cclen)); - Lstream_write (lstr, string, len); - - /* Padding at end to left-justify ... */ - if (minlen > cclen && minus_flag) - { - int to_add = minlen - cclen; - while (to_add > 0) - { - Lstream_putc (lstr, pad); - to_add--; - } - } -} - -static CONST Bufbyte * -parse_off_posnum (CONST Bufbyte *start, CONST Bufbyte *end, int *returned_num) -{ - Bufbyte arg_convert[100]; - REGISTER Bufbyte *arg_ptr = arg_convert; - - *returned_num = -1; - while (start != end && isdigit (*start)) - { - if ((size_t) (arg_ptr - arg_convert) >= sizeof (arg_convert) - 1) - error ("Format converter number too large"); - *arg_ptr++ = *start++; - } - *arg_ptr = '\0'; - if (arg_convert != arg_ptr) - *returned_num = atoi ((char *) arg_convert); - return start; -} - -#define NEXT_ASCII_BYTE(ch) \ - do { \ - if (fmt == fmt_end) \ - error ("Premature end of format string"); \ - ch = *fmt; \ - if (ch >= 0200) \ - error ("Non-ASCII character in format converter spec"); \ - fmt++; \ - } while (0) - -#define RESOLVE_FLAG_CONFLICTS(spec) \ - do { \ - if (spec.space_flag && spec.plus_flag) \ - spec.space_flag = 0; \ - if (spec.zero_flag && spec.space_flag) \ - spec.zero_flag = 0; \ - } while (0) - -static printf_spec_dynarr * -parse_doprnt_spec (CONST Bufbyte *format, Bytecount format_length) -{ - CONST Bufbyte *fmt = format; - CONST Bufbyte *fmt_end = format + format_length; - printf_spec_dynarr *specs = Dynarr_new (printf_spec); - int prev_argnum = 0; - - while (1) - { - struct printf_spec spec; - CONST Bufbyte *text_end; - Bufbyte ch; - - xzero (spec); - if (fmt == fmt_end) - return specs; - text_end = (Bufbyte *) memchr (fmt, '%', fmt_end - fmt); - if (!text_end) - text_end = fmt_end; - spec.text_before = fmt - format; - spec.text_before_len = text_end - fmt; - fmt = text_end; - if (fmt != fmt_end) - { - fmt++; /* skip over % */ - - /* A % is special -- no arg number. According to ANSI specs, - field width does not apply to %% conversion. */ - if (fmt != fmt_end && *fmt == '%') - { - spec.converter = '%'; - Dynarr_add (specs, spec); - fmt++; - continue; - } - - /* Is there a field number specifier? */ - { - CONST Bufbyte *ptr; - int fieldspec; - - ptr = parse_off_posnum (fmt, fmt_end, &fieldspec); - if (fieldspec > 0 && ptr != fmt_end && *ptr == '$') - { - /* There is a format specifier */ - prev_argnum = fieldspec; - fmt = ptr + 1; - } - else - prev_argnum++; - spec.argnum = prev_argnum; - } - - /* Parse off any flags */ - NEXT_ASCII_BYTE (ch); - while (strchr (valid_flags, ch)) - { - switch (ch) - { - case '-': spec.minus_flag = 1; break; - case '+': spec.plus_flag = 1; break; - case ' ': spec.space_flag = 1; break; - case '#': spec.number_flag = 1; break; - case '0': spec.zero_flag = 1; break; - default: abort (); - } - NEXT_ASCII_BYTE (ch); - } - - /* Parse off the minimum field width */ - fmt--; /* back up */ - - /* - * * means the field width was passed as an argument. - * Mark the current spec as one that forwards its - * field width and flags to the next spec in the array. - * Then create a new spec and continue with the parsing. - */ - if (fmt != fmt_end && *fmt == '*') - { - spec.converter = '*'; - RESOLVE_FLAG_CONFLICTS(spec); - Dynarr_add (specs, spec); - xzero (spec); - spec.argnum = ++prev_argnum; - fmt++; - } - else - { - fmt = parse_off_posnum (fmt, fmt_end, &spec.minwidth); - if (spec.minwidth == -1) - spec.minwidth = 0; - } - - /* Parse off any precision specified */ - NEXT_ASCII_BYTE (ch); - if (ch == '.') - { - /* - * * means the precision was passed as an argument. - * Mark the current spec as one that forwards its - * fieldwidth, flags and precision to the next spec in - * the array. Then create a new spec and continue - * with the parse. - */ - if (fmt != fmt_end && *fmt == '*') - { - spec.converter = '*'; - spec.forwarding_precision = 1; - RESOLVE_FLAG_CONFLICTS(spec); - Dynarr_add (specs, spec); - xzero (spec); - spec.argnum = ++prev_argnum; - fmt++; - } - else - { - fmt = parse_off_posnum (fmt, fmt_end, &spec.precision); - if (spec.precision == -1) - spec.precision = 0; - } - NEXT_ASCII_BYTE (ch); - } - else - /* No precision specified */ - spec.precision = -1; - - /* Parse off h or l flag */ - if (ch == 'h' || ch == 'l') - { - if (ch == 'h') - spec.h_flag = 1; - else - spec.l_flag = 1; - NEXT_ASCII_BYTE (ch); - } - - if (!strchr (valid_converters, ch)) - error ("Invalid converter character %c", ch); - spec.converter = ch; - } - - RESOLVE_FLAG_CONFLICTS(spec); - Dynarr_add (specs, spec); - } - - RETURN_NOT_REACHED(specs) /* suppress compiler warning */ -} - -static int -get_args_needed (printf_spec_dynarr *specs) -{ - int args_needed = 0; - REGISTER int i; - - /* Figure out how many args are needed. This may be less than - the number of specs because a spec could be %% or could be - missing (literal text at end of format string) or there - could be specs where the field number is explicitly given. - We just look for the maximum argument number that's referenced. */ - - for (i = 0; i < Dynarr_length (specs); i++) - { - char ch = Dynarr_at (specs, i).converter; - if (ch && ch != '%') - { - int argnum = Dynarr_at (specs, i).argnum; - if (argnum > args_needed) - args_needed = argnum; - } - } - - return args_needed; -} - -static printf_arg_dynarr * -get_doprnt_args (printf_spec_dynarr *specs, va_list vargs) -{ - printf_arg_dynarr *args = Dynarr_new (printf_arg); - union printf_arg arg; - REGISTER int i; - int args_needed = get_args_needed (specs); - - xzero (arg); - for (i = 1; i <= args_needed; i++) - { - int j; - char ch; - struct printf_spec *spec = 0; - - for (j = 0; j < Dynarr_length (specs); j++) - { - spec = Dynarr_atp (specs, j); - if (spec->argnum == i) - break; - } - - if (j == Dynarr_length (specs)) - error ("No conversion spec for argument %d", i); - - ch = spec->converter; - - /* int even if ch == 'c': "the type used in va_arg is supposed to - match the actual type **after default promotions**." */ - - if (strchr (int_converters, ch)) - { - if (spec->h_flag) - arg.i = va_arg (vargs, short); - else if (spec->l_flag) - arg.l = va_arg (vargs, long); - else - arg.i = va_arg (vargs, int); - } - else if (strchr (unsigned_int_converters, ch)) - { - if (spec->h_flag) - arg.ui = va_arg (vargs, unsigned short); - else if (spec->l_flag) - arg.ul = va_arg (vargs, unsigned long); - else - arg.ui = va_arg (vargs, unsigned int); - } - else if (strchr (double_converters, ch)) - arg.d = va_arg (vargs, double); - else if (strchr (string_converters, ch)) - arg.bp = va_arg (vargs, Bufbyte *); - else abort (); - - Dynarr_add (args, arg); - } - - return args; -} - -/* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH. - Output goes in BUFFER, which has room for BUFSIZE bytes. - If the output does not fit, truncate it to fit. - Returns the number of bytes stored into BUFFER. - LARGS or VARGS points to the arguments, and NARGS says how many. - if LARGS is non-zero, it should be a pointer to NARGS worth of - Lisp arguments. Otherwise, VARGS should be a va_list referring - to the arguments. */ - -static Bytecount -emacs_doprnt_1 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - int nargs, - /* #### Gag me, gag me, gag me */ - CONST Lisp_Object *largs, va_list vargs) -{ - printf_spec_dynarr *specs = 0; - printf_arg_dynarr *args = 0; - REGISTER int i; - int init_byte_count = Lstream_byte_count (XLSTREAM (stream)); - - if (!NILP (format_reloc)) - { - format_nonreloc = XSTRING_DATA (format_reloc); - format_length = XSTRING_LENGTH (format_reloc); - } - if (format_length < 0) - format_length = (Bytecount) strlen ((CONST char *) format_nonreloc); - - specs = parse_doprnt_spec (format_nonreloc, format_length); - if (largs) - { - /* allow too many args for string, but not too few */ - if (nargs < get_args_needed (specs)) - signal_error (Qwrong_number_of_arguments, - list3 (Qformat, - make_int (nargs), - !NILP (format_reloc) ? format_reloc : - make_string (format_nonreloc, format_length))); - } - else - { - args = get_doprnt_args (specs, vargs); - } - - for (i = 0; i < Dynarr_length (specs); i++) - { - struct printf_spec *spec = Dynarr_atp (specs, i); - char ch; - - /* Copy the text before */ - if (!NILP (format_reloc)) /* refetch in case of GC below */ - format_nonreloc = XSTRING_DATA (format_reloc); - doprnt_1 (stream, format_nonreloc + spec->text_before, - spec->text_before_len, 0, -1, 0, 0); - - ch = spec->converter; - - if (!ch) - continue; - - if (ch == '%') - { - doprnt_1 (stream, (Bufbyte *) &ch, 1, 0, -1, 0, 0); - continue; - } - - /* The char '*' as converter means the field width, precision - was specified as an argument. Extract the data and forward - it to the next spec, to which it will apply. */ - if (ch == '*') - { - struct printf_spec *nextspec = Dynarr_atp (specs, i + 1); - Lisp_Object obj = largs[spec->argnum - 1]; - - if (INTP (obj)) - { - if (spec->forwarding_precision) - { - nextspec->precision = XINT (obj); - nextspec->minwidth = spec->minwidth; - } - else - { - nextspec->minwidth = XINT (obj); - if (XINT(obj) < 0) - { - spec->minus_flag = 1; - nextspec->minwidth = - nextspec->minwidth; - } - } - nextspec->minus_flag = spec->minus_flag; - nextspec->plus_flag = spec->plus_flag; - nextspec->space_flag = spec->space_flag; - nextspec->number_flag = spec->number_flag; - nextspec->zero_flag = spec->zero_flag; - } - continue; - } - - if (largs && (spec->argnum < 1 || spec->argnum > nargs)) - error ("Invalid repositioning argument %d", spec->argnum); - - else if (ch == 'S' || ch == 's') - { - Bufbyte *string; - Bytecount string_len; - - if (!largs) - { - string = Dynarr_at (args, spec->argnum - 1).bp; - /* error() can be called with null string arguments. - E.g., in fileio.c, the return value of strerror() - is never checked. We'll print (null), like some - printf implementations do. Would it be better (and safe) - to signal an error instead? Or should we just use the - empty string? -dkindred@cs.cmu.edu 8/1997 - */ - if (!string) - string = (Bufbyte *) "(null)"; - string_len = strlen ((char *) string); - } - else - { - Lisp_Object obj = largs[spec->argnum - 1]; - struct Lisp_String *ls; - - if (ch == 'S') - { - /* For `S', prin1 the argument and then treat like - a string. */ - ls = XSTRING (Fprin1_to_string (obj, Qnil)); - } - else if (STRINGP (obj)) - ls = XSTRING (obj); - else if (SYMBOLP (obj)) - ls = XSYMBOL (obj)->name; - else - { - /* convert to string using princ. */ - ls = XSTRING (Fprin1_to_string (obj, Qt)); - } - string = string_data (ls); - string_len = string_length (ls); - } - - doprnt_1 (stream, string, string_len, spec->minwidth, - spec->precision, spec->minus_flag, spec->zero_flag); - } - - else - { - /* Must be a number. */ - union printf_arg arg; - - if (!largs) - { - arg = Dynarr_at (args, spec->argnum - 1); - } - else - { - Lisp_Object obj = largs[spec->argnum - 1]; - if (CHARP (obj)) - obj = make_int (XCHAR (obj)); - if (!INT_OR_FLOATP (obj)) - { - error ("format specifier %%%c doesn't match argument type", - ch); - } - else if (strchr (double_converters, ch)) - arg.d = XFLOATINT (obj); - else - { - int val; - - if (FLOATP (obj)) - val = XINT (Ftruncate (obj)); - else - val = XINT (obj); - if (strchr (unsigned_int_converters, ch)) - { - if (spec->l_flag) - arg.ul = (unsigned long) val; - else - arg.ui = (unsigned int) val; - } - else - { - if (spec->l_flag) - arg.l = (long) val; - else - arg.i = val; - } - } - } - - - if (ch == 'c') - { - Emchar a; - Bytecount charlen; - Bufbyte charbuf[MAX_EMCHAR_LEN]; - - if (spec->l_flag) - a = (Emchar) arg.l; - else - a = (Emchar) arg.i; - - if (!valid_char_p (a)) - error ("invalid character value %d to %%c spec", a); - - charlen = set_charptr_emchar (charbuf, a); - doprnt_1 (stream, charbuf, charlen, spec->minwidth, - -1, spec->minus_flag, spec->zero_flag); - } - - else - { - char text_to_print[500]; - char constructed_spec[100]; - - /* Partially reconstruct the spec and use sprintf() to - format the string. */ - - /* Make sure nothing stupid happens */ - /* DO NOT REMOVE THE (int) CAST! Incorrect results will - follow! */ - spec->precision = min (spec->precision, - (int) (sizeof (text_to_print) - 50)); - - constructed_spec[0] = 0; - strcat (constructed_spec, "%"); - if (spec->plus_flag) - strcat (constructed_spec, "+"); - if (spec->space_flag) - strcat (constructed_spec, " "); - if (spec->number_flag) - strcat (constructed_spec, "#"); - if (spec->precision >= 0) - { - strcat (constructed_spec, "."); - long_to_string (constructed_spec + strlen (constructed_spec), - spec->precision); - } - sprintf (constructed_spec + strlen (constructed_spec), "%c", ch); - - /* sprintf the mofo */ - /* we have to use separate calls to sprintf(), rather than - a single big conditional, because of the different types - of the arguments */ - if (strchr (double_converters, ch)) - sprintf (text_to_print, constructed_spec, arg.d); - else if (strchr (unsigned_int_converters, ch)) - { - if (spec->l_flag) - sprintf (text_to_print, constructed_spec, arg.ul); - else - sprintf (text_to_print, constructed_spec, arg.ui); - } - else - { - if (spec->l_flag) - sprintf (text_to_print, constructed_spec, arg.l); - else - sprintf (text_to_print, constructed_spec, arg.i); - } - - doprnt_1 (stream, (Bufbyte *) text_to_print, - strlen (text_to_print), - spec->minwidth, -1, spec->minus_flag, spec->zero_flag); - } - } - } - - /* #### will not get freed if error */ - if (specs) - Dynarr_free (specs); - if (args) - Dynarr_free (args); - return Lstream_byte_count (XLSTREAM (stream)) - init_byte_count; -} - -/* You really don't want to know why this is necessary... */ -static Bytecount -emacs_doprnt_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, int nargs, - CONST Lisp_Object *largs, ...) -{ - va_list vargs; - Bytecount val; - va_start (vargs, largs); - val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc, - format_length, nargs, largs, vargs); - va_end (vargs); - return val; -} - -/*********************** external entry points ***********************/ - -#ifdef I18N3 - /* A note about I18N3 translating: the format string should get - translated, but not under all circumstances. When the format - string is a Lisp string, what should happen is that Fformat() - should format the untranslated args[0] and return that, and also - call Fgettext() on args[0] and, if that is different, format it - and store it in the `string-translatable' property of - the returned string. See Fgettext(). */ -#endif - -/* Send formatted output to STREAM. The format string comes from - either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use - strlen() to determine the length) or from FORMAT_RELOC, which - should be a Lisp string. Return the number of bytes written - to the stream. - - DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC - parameter, because this function can cause GC. */ - -Bytecount -emacs_doprnt_c (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - ...) -{ - int val; - va_list vargs; - - va_start (vargs, format_length); - val = emacs_doprnt_1 (stream, format_nonreloc, format_reloc, - format_length, 0, 0, vargs); - va_end (vargs); - return val; -} - -/* Like emacs_doprnt_c but the args come in va_list format. */ - -Bytecount -emacs_doprnt_va (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - va_list vargs) -{ - return emacs_doprnt_1 (stream, format_nonreloc, format_reloc, - format_length, 0, 0, vargs); -} - -/* Like emacs_doprnt_c but the args are Lisp objects instead of - C arguments. This causes somewhat different behavior from - the above two functions (which should act like printf). - See `format' for a description of this behavior. */ - -Bytecount -emacs_doprnt_lisp (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - int nargs, CONST Lisp_Object *largs) -{ - return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, - format_length, nargs, largs); -} - -/* Like the previous function but takes a variable number of arguments. */ - -Bytecount -emacs_doprnt_lisp_2 (Lisp_Object stream, CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - int nargs, ...) -{ - va_list vargs; - int i; - Lisp_Object *foo = alloca_array (Lisp_Object, nargs); - - va_start (vargs, nargs); - for (i = 0; i < nargs; i++) - foo[i] = va_arg (vargs, Lisp_Object); - va_end (vargs); - - return emacs_doprnt_2 (stream, format_nonreloc, format_reloc, - format_length, nargs, foo); -} - -/* The following four functions work like the above three but - return their output as a Lisp string instead of sending it - to a stream. */ - -Lisp_Object -emacs_doprnt_string_c (CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - ...) -{ - va_list vargs; - Lisp_Object obj; - Lisp_Object stream = make_resizing_buffer_output_stream (); - struct gcpro gcpro1; - - GCPRO1 (stream); - va_start (vargs, format_length); - emacs_doprnt_1 (stream, format_nonreloc, format_reloc, - format_length, 0, 0, vargs); - va_end (vargs); - Lstream_flush (XLSTREAM (stream)); - obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), - Lstream_byte_count (XLSTREAM (stream))); - UNGCPRO; - Lstream_delete (XLSTREAM (stream)); - return obj; -} - -Lisp_Object -emacs_doprnt_string_va (CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - va_list vargs) -{ - /* I'm fairly sure that this function cannot actually GC. - That can only happen when the arguments to emacs_doprnt_1() are - Lisp objects rather than C args. */ - Lisp_Object obj; - Lisp_Object stream = make_resizing_buffer_output_stream (); - struct gcpro gcpro1; - - GCPRO1 (stream); - emacs_doprnt_1 (stream, format_nonreloc, format_reloc, - format_length, 0, 0, vargs); - Lstream_flush (XLSTREAM (stream)); - obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), - Lstream_byte_count (XLSTREAM (stream))); - UNGCPRO; - Lstream_delete (XLSTREAM (stream)); - return obj; -} - -Lisp_Object -emacs_doprnt_string_lisp (CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - int nargs, CONST Lisp_Object *largs) -{ - Lisp_Object obj; - Lisp_Object stream = make_resizing_buffer_output_stream (); - struct gcpro gcpro1; - - GCPRO1 (stream); - emacs_doprnt_2 (stream, format_nonreloc, format_reloc, - format_length, nargs, largs); - Lstream_flush (XLSTREAM (stream)); - obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), - Lstream_byte_count (XLSTREAM (stream))); - UNGCPRO; - Lstream_delete (XLSTREAM (stream)); - return obj; -} - -Lisp_Object -emacs_doprnt_string_lisp_2 (CONST Bufbyte *format_nonreloc, - Lisp_Object format_reloc, Bytecount format_length, - int nargs, ...) -{ - Lisp_Object obj; - Lisp_Object stream = make_resizing_buffer_output_stream (); - struct gcpro gcpro1; - va_list vargs; - int i; - Lisp_Object *foo = alloca_array (Lisp_Object, nargs); - - va_start (vargs, nargs); - for (i = 0; i < nargs; i++) - foo[i] = va_arg (vargs, Lisp_Object); - va_end (vargs); - - GCPRO1 (stream); - emacs_doprnt_2 (stream, format_nonreloc, format_reloc, - format_length, nargs, foo); - Lstream_flush (XLSTREAM (stream)); - obj = make_string (resizing_buffer_stream_ptr (XLSTREAM (stream)), - Lstream_byte_count (XLSTREAM (stream))); - UNGCPRO; - Lstream_delete (XLSTREAM (stream)); - return obj; -} diff --git a/src/dragdrop.c b/src/dragdrop.c deleted file mode 100644 index 713355d..0000000 --- a/src/dragdrop.c +++ /dev/null @@ -1,142 +0,0 @@ -/* Drag'n'Drop definitions - created 03-may-98 by Oliver Graf - Copyright (C) 1998 Oliver Graf - -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 file should be Mule-ized. */ - -/* A short introduction to the new Drag'n'Drop Model: - - Currently only drops from OffiX are implemented. - - A drop generates a extended misc-user-event, as defined in events.[ch]. - This event contains the same as a eval and a button event. - The function of a drop is set to 'dragdrop-drop-dispatch' which will be - defined in ../lisp/dragdrop.el. - The object of the misc-user-event has the following format: - ( TYPE . DATA ) - TYPE is one of 'dragdrop-MIME and 'dragdrop-URL - DATA - if TYPE is 'dragdrop-URL, DATA is a list of valid URL strings. It - is always a list, also if only one URL string is within it. - - if TYPE is 'dragdrop-MIME, DATA is a list of MIME elements. - Each can be a string or a list. - if it is a string it is the pure MIME data complete with header - and body. - if it is a list it should look like - ( MIME-TYPE MIME-ENCODING MIME-DATA ) - MIME-TYPE list of type and key.value conses. Same as in tm-view - MIME-ENC the same (a string in this case) - MIME-DATA is a string -*/ - -#include -#include "lisp.h" -#include "dragdrop.h" - -/* The supported protocol list */ -Lisp_Object Vdragdrop_protocols; - -/* Drag'n'Drop data types known by XEmacs */ -Lisp_Object Qdragdrop_MIME; -Lisp_Object Qdragdrop_URL; - -/* External defined functions to handle Drag'n'Drop */ -Lisp_Object Qdragdrop_drop_dispatch; - -/* from wget -- thanxx Hrvoje */ -/* A list of unsafe characters for encoding, as per RFC1738. '@' and - ':' (not listed in RFC) were added because of user/password - encoding, and \033 for safe printing. */ - -#define URL_UNSAFE " <>\"#%{}|\\^~[]`@:\033" - -/* HEX digit -> ASCII char */ -#define HEXD2ASC(x) (((x) < 10) ? ((x) + '0') : ((x) - 10 + 'A')) - -/* Encodes the unsafe characters (listed in URL_UNSAFE) in a given - string, returning a malloc-ed %XX encoded string. - if method is != NULL it is prepended to the string. */ -char * -dnd_url_hexify_string (const char *s, const char *m) -{ - const char *b; - char *p, *res; - int i; - - b = s; - for (i = 0; *s; s++, i++) - if (strchr (URL_UNSAFE, *s)) - i += 2; /* Two more characters (hex digits) */ - if (m) - { - res = (char *)xmalloc (i + 1 + strlen (m)); - strcpy (res, m); - p = res + strlen (m); - } - else - { - res = (char *)xmalloc (i + 1); - p = res; - } - for (s = b; *s; s++) - if (strchr (URL_UNSAFE, *s)) - { - const unsigned char c = *s; - *p++ = '%'; - *p++ = HEXD2ASC (c >> 4); - *p++ = HEXD2ASC (c & 0xf); - } - else - *p++ = *s; - *p = '\0'; - return res; -} - -void -syms_of_dragdrop (void) -{ - defsymbol (&Qdragdrop_MIME, "dragdrop-MIME"); - defsymbol (&Qdragdrop_URL, "dragdrop-URL"); - defsymbol (&Qdragdrop_drop_dispatch, "dragdrop-drop-dispatch"); -} - -void -vars_of_dragdrop (void) -{ - Fprovide (intern ("dragdrop-api")); - - DEFVAR_CONST_LISP ("dragdrop-protocols", &Vdragdrop_protocols /* -A list of supported Drag'n'drop protocols. -Each element is the feature symbol of the protocol. -*/ ); - - Vdragdrop_protocols = Qnil; - -#ifdef HAVE_MS_WINDOWS - Vdragdrop_protocols = Fcons ( Qmswindows , Vdragdrop_protocols ); -#endif -#ifdef HAVE_CDE - Vdragdrop_protocols = Fcons ( intern ("cde") , Vdragdrop_protocols ); -#endif -#ifdef HAVE_OFFIX_DND - Vdragdrop_protocols = Fcons ( intern ("offix") , Vdragdrop_protocols ); -#endif -} diff --git a/src/dragdrop.h b/src/dragdrop.h deleted file mode 100644 index 4ad3227..0000000 --- a/src/dragdrop.h +++ /dev/null @@ -1,40 +0,0 @@ -/* Definitions for the new drag and drop model; - created 03-may-98 by Oliver Graf - Copyright (C) 1998 Oliver Graf - -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. */ - -#ifndef _XEMACS_DRAGDROP_H_ -#define _XEMACS_DRAGDROP_H_ - -/* Drag'n'Drop data types known by XEmacs */ -extern Lisp_Object Qdragdrop_MIME; -extern Lisp_Object Qdragdrop_URL; - -/* External defined functions to handle Drag'n'Drop */ -extern Lisp_Object Qdragdrop_drop_dispatch; - -/* some utility functions */ -char *dnd_url_hexify_string (const char *s, const char *m); - -/* emacs interface */ -void syms_of_dragdrop (void); - -#endif /* _XEMACS_DRAGDROP_H_ */ diff --git a/src/dynarr.c b/src/dynarr.c deleted file mode 100644 index 4167b5b..0000000 --- a/src/dynarr.c +++ /dev/null @@ -1,236 +0,0 @@ -/* Simple 'n' stupid dynamic-array module. - Copyright (C) 1993 Sun Microsystems, 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. */ - -/* Written by Ben Wing, December 1993. */ - -/* - -A "dynamic array" is a contiguous array of fixed-size elements where there -is no upper limit (except available memory) on the number of elements in the -array. Because the elements are maintained contiguously, space is used -efficiently (no per-element pointers necessary) and random access to a -particular element is in constant time. At any one point, the block of memory -that holds the array has an upper limit; if this limit is exceeded, the -memory is realloc()ed into a new array that is twice as big. Assuming that -the time to grow the array is on the order of the new size of the array -block, this scheme has a provably constant amortized time (i.e. average -time over all additions). - -When you add elements or retrieve elements, pointers are used. Note that -the element itself (of whatever size it is), and not the pointer to it, -is stored in the array; thus you do not have to allocate any heap memory -on your own. Also, returned pointers are only guaranteed to be valid -until the next operation that changes the length of the array. - -This is a container object. Declare a dynamic array of a specific type -as follows: - -typedef struct -{ - Dynarr_declare (mytype); -} mytype_dynarr; - -Use the following functions/macros: - - void *Dynarr_new(type) - [MACRO] Create a new dynamic-array object, with each element of the - specified type. The return value is cast to (type##_dynarr). - This requires following the convention that types are declared in - such a way that this type concatenation works. In particular, TYPE - must be a symbol, not an arbitrary C type. - - Dynarr_add(d, el) - [MACRO] Add an element to the end of a dynamic array. EL is a pointer - to the element; the element itself is stored in the array, however. - No function call is performed unless the array needs to be resized. - - Dynarr_add_many(d, base, len) - [MACRO] Add LEN elements to the end of the dynamic array. The elements - should be contiguous in memory, starting at BASE. - - Dynarr_insert_many_at_start(d, base, len) - [MACRO] Append LEN elements to the beginning of the dynamic array. - The elements should be contiguous in memory, starting at BASE. - - Dynarr_insert_many(d, base, len, start) - Insert LEN elements to the dynamic array starting at position - START. The elements should be contiguous in memory, starting at BASE. - - int Dynarr_length(d) - [MACRO] Return the number of elements currently in a dynamic array. - - int Dynarr_largest(d) - [MACRO] Return the maximum value that Dynarr_length(d) would - ever have returned. - - type Dynarr_at(d, i) - [MACRO] Return the element at the specified index (no bounds checking - done on the index). The element itself is returned, not a pointer - to it. - - type *Dynarr_atp(d, i) - [MACRO] Return a pointer to the element at the specified index (no - bounds checking done on the index). The pointer may not be valid - after an element is added to or removed from the array. - - Dynarr_reset(d) - [MACRO] Reset the length of a dynamic array to 0. - - Dynarr_free(d) - Destroy a dynamic array and the memory allocated to it. - -Use the following global variable: - - Dynarr_min_size - Minimum allowable size for a dynamic array when it is resized. The - default is 32 and does not normally need to be changed. - -*/ - -#include -#include "lisp.h" - -int Dynarr_min_size = 1; - -void * -Dynarr_newf (int elsize) -{ - Dynarr *d = xnew_and_zero (Dynarr); - d->elsize = elsize; - - return d; -} - -void -Dynarr_resize (void *d, int size) -{ - int newsize; - double multiplier; - Dynarr *dy = (Dynarr *) d; - - if (dy->max <= 8) - multiplier = 2; - else - multiplier = 1.5; - - for (newsize = dy->max; newsize < size;) - newsize = max (Dynarr_min_size, (int) (multiplier * newsize)); - - /* Don't do anything if the array is already big enough. */ - if (newsize > dy->max) - { - dy->base = xrealloc (dy->base, newsize*dy->elsize); - dy->max = newsize; - } -} - -/* Add a number of contiguous elements to the array starting at START. */ -void -Dynarr_insert_many (void *d, CONST void *el, int len, int start) -{ - Dynarr *dy = (Dynarr *) d; - - Dynarr_resize (dy, dy->cur+len); - /* Silently adjust start to be valid. */ - if (start > dy->cur) - start = dy->cur; - else if (start < 0) - start = 0; - - if (start != dy->cur) - { - memmove ((char *) dy->base + (start + len)*dy->elsize, - (char *) dy->base + start*dy->elsize, - (dy->cur - start)*dy->elsize); - } - memcpy ((char *) dy->base + start*dy->elsize, el, len*dy->elsize); - dy->cur += len; - - if (dy->cur > dy->largest) - dy->largest = dy->cur; -} - -void -Dynarr_delete_many (void *d, int start, int len) -{ - Dynarr *dy = (Dynarr *) d; - - assert (start >= 0 && len >= 0 && start + len <= dy->cur); - memmove ((char *) dy->base + start*dy->elsize, - (char *) dy->base + (start + len)*dy->elsize, - (dy->cur - start - len)*dy->elsize); - dy->cur -= len; -} - -void -Dynarr_free (void *d) -{ - Dynarr *dy = (Dynarr *) d; - - if (dy->base) - xfree (dy->base); - xfree (dy); -} - -#ifdef MEMORY_USAGE_STATS - -/* Return memory usage for Dynarr D. The returned value is the total - amount of bytes actually being used for the Dynarr, including all - overhead. The extra amount of space in the Dynarr that is - allocated beyond what was requested is returned in DYNARR_OVERHEAD - in STATS. The extra amount of space that malloc() allocates beyond - what was requested of it is returned in MALLOC_OVERHEAD in STATS. - See the comment above the definition of this structure. */ - -size_t -Dynarr_memory_usage (void *d, struct overhead_stats *stats) -{ - size_t total = 0; - Dynarr *dy = (Dynarr *) d; - - /* We have to be a bit tricky here because not all of the - memory that malloc() will claim as "requested" was actually - requested. */ - - if (dy->base) - { - size_t malloc_used = malloced_storage_size (dy->base, - dy->elsize * dy->max, 0); - /* #### This may or may not be correct. Some Dynarrs would - prefer that we use dy->cur instead of dy->largest here. */ - int was_requested = dy->elsize * dy->largest; - int dynarr_overhead = dy->elsize * (dy->max - dy->largest); - - total += malloc_used; - stats->was_requested += was_requested; - stats->dynarr_overhead += dynarr_overhead; - /* And the remainder must be malloc overhead. */ - stats->malloc_overhead += - malloc_used - was_requested - dynarr_overhead; - } - - total += malloced_storage_size (d, sizeof (*dy), stats); - - return total; -} - -#endif /* MEMORY_USAGE_STATS */ diff --git a/src/editfns.c b/src/editfns.c deleted file mode 100644 index ce1f101..0000000 --- a/src/editfns.c +++ /dev/null @@ -1,2541 +0,0 @@ -/* Lisp functions pertaining to editing. - Copyright (C) 1985-1987, 1989, 1992-1995 Free Software Foundation, Inc. - Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 1996 Ben Wing. - -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: Mule 2.0, FSF 19.30. */ - -/* This file has been Mule-ized. */ - -/* Hacked on for Mule by Ben Wing, December 1994. */ - -#include -#include "lisp.h" -#ifdef HAVE_UNISTD_H -#include -#endif - -#include "buffer.h" -#include "commands.h" -#include "events.h" /* for EVENTP */ -#include "extents.h" -#include "frame.h" -#include "insdel.h" -#include "window.h" -#include "chartab.h" -#include "line-number.h" - -#include "systime.h" -#include "sysdep.h" -#include "syspwd.h" - -/* Some static data, and a function to initialize it for each run */ - -Lisp_Object Vsystem_name; /* #### - I don't see why this should be */ - /* static, either... --Stig */ -#if 0 /* XEmacs - this is now dynamic */ - /* if at some point it's deemed desirable to - use lisp variables here, then they can be - initialized to nil and then set to their - real values upon the first call to the - functions that generate them. --stig */ -Lisp_Object Vuser_real_login_name; /* login name of current user ID */ -Lisp_Object Vuser_login_name; /* user name from LOGNAME or USER. */ -#endif - -/* It's useful to be able to set this as user customization, so we'll - keep it. */ -Lisp_Object Vuser_full_name; -EXFUN (Fuser_full_name, 1); - -char *get_system_name (void); - -Lisp_Object Qformat; - -Lisp_Object Qpoint, Qmark, Qregion_beginning, Qregion_end; - -Lisp_Object Quser_files_and_directories; - -/* This holds the value of `environ' produced by the previous - call to Fset_time_zone_rule, or 0 if Fset_time_zone_rule - has never been called. */ -static char **environbuf; - -void -init_editfns (void) -{ -/* Only used in removed code below. */ - char *p; - - environbuf = 0; - - /* Set up system_name even when dumping. */ - init_system_name (); - -#ifndef CANNOT_DUMP - if (!initialized) - return; -#endif - - if ((p = getenv ("NAME"))) - /* I don't think it's the right thing to do the ampersand - modification on NAME. Not that it matters anymore... -hniksic */ - Vuser_full_name = build_ext_string (p, FORMAT_OS); - else - Vuser_full_name = Fuser_full_name (Qnil); -} - -DEFUN ("char-to-string", Fchar_to_string, 1, 1, 0, /* -Convert arg CH to a one-character string containing that character. -*/ - (ch)) -{ - Bytecount len; - Bufbyte str[MAX_EMCHAR_LEN]; - - if (EVENTP (ch)) - { - Lisp_Object ch2 = Fevent_to_character (ch, Qt, Qnil, Qnil); - if (NILP (ch2)) - return - signal_simple_continuable_error - ("character has no ASCII equivalent:", Fcopy_event (ch, Qnil)); - ch = ch2; - } - - CHECK_CHAR_COERCE_INT (ch); - - len = set_charptr_emchar (str, XCHAR (ch)); - return make_string (str, len); -} - -DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /* -Convert arg STRING to a character, the first character of that string. -An empty string will return the constant `nil'. -*/ - (str)) -{ - struct Lisp_String *p; - CHECK_STRING (str); - - p = XSTRING (str); - if (string_length (p) != 0) - return make_char (string_char (p, 0)); - else - /* This used to return Qzero. That is broken, broken, broken. */ - /* It might be kinder to signal an error directly. -slb */ - return Qnil; -} - - -static Lisp_Object -buildmark (Bufpos val, Lisp_Object buffer) -{ - Lisp_Object mark = Fmake_marker (); - Fset_marker (mark, make_int (val), buffer); - return mark; -} - -DEFUN ("point", Fpoint, 0, 1, 0, /* -Return value of point, as an integer. -Beginning of buffer is position (point-min). -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return make_int (BUF_PT (b)); -} - -DEFUN ("point-marker", Fpoint_marker, 0, 2, 0, /* -Return value of point, as a marker object. -This marker is a copy; you may modify it with reckless abandon. -If optional argument DONT-COPY-P is non-nil, then it returns the real -point-marker; modifying the position of this marker will move point. -It is illegal to change the buffer of it, or make it point nowhere. -If BUFFER is nil, the current buffer is assumed. -*/ - (dont_copy_p, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - if (NILP (dont_copy_p)) - return Fcopy_marker (b->point_marker, Qnil); - else - return b->point_marker; -} - -/* The following two functions end up being identical but it's - cleaner to declare them separately. */ - -Bufpos -bufpos_clip_to_bounds (Bufpos lower, Bufpos num, Bufpos upper) -{ - return (num < lower ? lower : - num > upper ? upper : - num); -} - -Bytind -bytind_clip_to_bounds (Bytind lower, Bytind num, Bytind upper) -{ - return (num < lower ? lower : - num > upper ? upper : - num); -} - -/* - * Chuck says: - * There is no absolute way to determine if goto-char is the function - * being run. this-command doesn't work because it is often eval'd - * and this-command ends up set to eval-expression. So this flag gets - * added for now. - * - * Jamie thinks he's wrong, but we'll leave this in for now. - */ -int atomic_extent_goto_char_p; - -DEFUN ("goto-char", Fgoto_char, 1, 2, "NGoto char: ", /* -Set point to POSITION, a number or marker. -Beginning of buffer is position (point-min), end is (point-max). -If BUFFER is nil, the current buffer is assumed. -Return value of POSITION, as an integer. -*/ - (position, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - Bufpos n = get_buffer_pos_char (b, position, GB_COERCE_RANGE); - BUF_SET_PT (b, n); - atomic_extent_goto_char_p = 1; - return make_int (n); -} - -static Lisp_Object -region_limit (int beginningp, struct buffer *b) -{ - Lisp_Object m; - -#if 0 /* FSFmacs */ - if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) - && NILP (b->mark_active)) - Fsignal (Qmark_inactive, Qnil); -#endif - m = Fmarker_position (b->mark); - if (NILP (m)) error ("There is no region now"); - if (!!(BUF_PT (b) < XINT (m)) == !!beginningp) - return make_int (BUF_PT (b)); - else - return m; -} - -DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /* -Return position of beginning of region in BUFFER, as an integer. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - return region_limit (1, decode_buffer (buffer, 1)); -} - -DEFUN ("region-end", Fregion_end, 0, 1, 0, /* -Return position of end of region in BUFFER, as an integer. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - return region_limit (0, decode_buffer (buffer, 1)); -} - -/* Whether to use lispm-style active-regions */ -int zmacs_regions; - -/* Whether the zmacs region is active. This is not per-buffer because - there can be only one active region at a time. #### Now that the - zmacs region are not directly tied to the X selections this may not - necessarily have to be true. */ -int zmacs_region_active_p; - -int zmacs_region_stays; - -Lisp_Object Qzmacs_update_region, Qzmacs_deactivate_region; -Lisp_Object Qzmacs_region_buffer; - -void -zmacs_update_region (void) -{ - /* This function can GC */ - if (zmacs_region_active_p) - call0 (Qzmacs_update_region); -} - -void -zmacs_deactivate_region (void) -{ - /* This function can GC */ - if (zmacs_region_active_p) - call0 (Qzmacs_deactivate_region); -} - -Lisp_Object -zmacs_region_buffer (void) -{ - if (zmacs_region_active_p) - return call0 (Qzmacs_region_buffer); - else - return Qnil; -} - -DEFUN ("mark-marker", Fmark_marker, 0, 2, 0, /* -Return this buffer's mark, as a marker object. -If `zmacs-regions' is true, then this returns nil unless the region is -currently in the active (highlighted) state. If optional argument FORCE -is t, this returns the mark (if there is one) regardless of the zmacs-region -state. You should *generally* not use the mark unless the region is active, -if the user has expressed a preference for the zmacs-region model. -Watch out! Moving this marker changes the mark position. -If you set the marker not to point anywhere, the buffer will have no mark. -If BUFFER is nil, the current buffer is assumed. -*/ - (force, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - if (! zmacs_regions || zmacs_region_active_p || !NILP (force)) - return b->mark; - return Qnil; -} - - -/* The saved object is a cons: - - (COPY-OF-POINT-MARKER . COPY-OF-MARK) - - We used to have another cons for a VISIBLE-P element, which was t - if `(eq (current-buffer) (window-buffer (selected-window)))' but it - was unused for a long time, so I removed it. --hniksic */ -Lisp_Object -save_excursion_save (void) -{ - struct buffer *b; - - /* #### Huh? --hniksic */ - /*if (preparing_for_armageddon) return Qnil;*/ - -#ifdef ERROR_CHECK_BUFPOS - assert (XINT (Fpoint (Qnil)) == - XINT (Fmarker_position (Fpoint_marker (Qt, Qnil)))); -#endif - - b = current_buffer; - - return noseeum_cons (noseeum_copy_marker (b->point_marker, Qnil), - noseeum_copy_marker (b->mark, Qnil)); -} - -Lisp_Object -save_excursion_restore (Lisp_Object info) -{ - Lisp_Object buffer = Fmarker_buffer (XCAR (info)); - - /* If buffer being returned to is now deleted, avoid error -- - otherwise could get error here while unwinding to top level and - crash. In that case, Fmarker_buffer returns nil now. */ - if (!NILP (buffer)) - { - struct buffer *buf = XBUFFER (buffer); - struct gcpro gcpro1; - GCPRO1 (info); - set_buffer_internal (buf); - Fgoto_char (XCAR (info), buffer); - Fset_marker (buf->mark, XCDR (info), buffer); - -#if 0 /* We used to make the current buffer visible in the selected window - if that was true previously. That avoids some anomalies. - But it creates others, and it wasn't documented, and it is simpler - and cleaner never to alter the window/buffer connections. */ - /* I'm certain some code somewhere depends on this behavior. --jwz */ - /* Even if it did, it certainly doesn't matter anymore, because - this has been the behavior for countless XEmacs releases - now. --hniksic */ - if (visible - && (current_buffer != XBUFFER (XWINDOW (selected_window)->buffer))) - switch_to_buffer (Fcurrent_buffer (), Qnil); -#endif - - UNGCPRO; - } - - /* Free all the junk we allocated, so that a `save-excursion' comes - for free in terms of GC junk. */ - free_marker (XMARKER (XCAR (info))); - free_marker (XMARKER (XCDR (info))); - free_cons (XCONS (info)); - return Qnil; -} - -DEFUN ("save-excursion", Fsave_excursion, 0, UNEVALLED, 0, /* -Save point, mark, and current buffer; execute BODY; restore those things. -Executes BODY just like `progn'. -The values of point, mark and the current buffer are restored -even in case of abnormal exit (throw or error). -*/ - (args)) -{ - /* This function can GC */ - int speccount = specpdl_depth (); - - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - - return unbind_to (speccount, Fprogn (args)); -} - -Lisp_Object -save_current_buffer_restore (Lisp_Object buffer) -{ - struct buffer *buf = XBUFFER (buffer); - /* Avoid signaling an error if the buffer is no longer alive. This - is for consistency with save-excursion. */ - if (BUFFER_LIVE_P (buf)) - set_buffer_internal (buf); - return Qnil; -} - -DEFUN ("save-current-buffer", Fsave_current_buffer, 0, UNEVALLED, 0, /* -Save the current buffer; execute BODY; restore the current buffer. -Executes BODY just like `progn'. -*/ - (args)) -{ - /* This function can GC */ - int speccount = specpdl_depth (); - - record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ()); - - return unbind_to (speccount, Fprogn (args)); -} - -DEFUN ("buffer-size", Fbuffer_size, 0, 1, 0, /* -Return the number of characters in BUFFER. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return make_int (BUF_SIZE (b)); -} - -DEFUN ("point-min", Fpoint_min, 0, 1, 0, /* -Return the minimum permissible value of point in BUFFER. -This is 1, unless narrowing (a buffer restriction) is in effect. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return make_int (BUF_BEGV (b)); -} - -DEFUN ("point-min-marker", Fpoint_min_marker, 0, 1, 0, /* -Return a marker to the minimum permissible value of point in BUFFER. -This is the beginning, unless narrowing (a buffer restriction) is in effect. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return buildmark (BUF_BEGV (b), make_buffer (b)); -} - -DEFUN ("point-max", Fpoint_max, 0, 1, 0, /* -Return the maximum permissible value of point in BUFFER. -This is (1+ (buffer-size)), unless narrowing (a buffer restriction) -is in effect, in which case it is less. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return make_int (BUF_ZV (b)); -} - -DEFUN ("point-max-marker", Fpoint_max_marker, 0, 1, 0, /* -Return a marker to the maximum permissible value of point BUFFER. -This is (1+ (buffer-size)), unless narrowing (a buffer restriction) -is in effect, in which case it is less. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return buildmark (BUF_ZV (b), make_buffer (b)); -} - -DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /* -Return the character following point. -At the end of the buffer or accessible region, return 0. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - if (BUF_PT (b) >= BUF_ZV (b)) - return Qzero; /* #### Gag me! */ - else - return make_char (BUF_FETCH_CHAR (b, BUF_PT (b))); -} - -DEFUN ("preceding-char", Fpreceding_char, 0, 1, 0, /* -Return the character preceding point. -At the beginning of the buffer or accessible region, return 0. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - if (BUF_PT (b) <= BUF_BEGV (b)) - return Qzero; /* #### Gag me! */ - else - return make_char (BUF_FETCH_CHAR (b, BUF_PT (b) - 1)); -} - -DEFUN ("bobp", Fbobp, 0, 1, 0, /* -Return t if point is at the beginning of the buffer. -If the buffer is narrowed, this means the beginning of the narrowed part. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return BUF_PT (b) == BUF_BEGV (b) ? Qt : Qnil; -} - -DEFUN ("eobp", Feobp, 0, 1, 0, /* -Return t if point is at the end of the buffer. -If the buffer is narrowed, this means the end of the narrowed part. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return BUF_PT (b) == BUF_ZV (b) ? Qt : Qnil; -} - -int -beginning_of_line_p (struct buffer *b, Bufpos pt) -{ - return pt <= BUF_BEGV (b) || BUF_FETCH_CHAR (b, pt - 1) == '\n'; -} - - -DEFUN ("bolp", Fbolp, 0, 1, 0, /* -Return t if point is at the beginning of a line. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return beginning_of_line_p (b, BUF_PT (b)) ? Qt : Qnil; -} - -DEFUN ("eolp", Feolp, 0, 1, 0, /* -Return t if point is at the end of a line. -`End of a line' includes point being at the end of the buffer. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - return (BUF_PT (b) == BUF_ZV (b) || BUF_FETCH_CHAR (b, BUF_PT (b)) == '\n') - ? Qt : Qnil; -} - -DEFUN ("char-after", Fchar_after, 0, 2, 0, /* -Return character in BUFFER at position POS. -POS is an integer or a buffer pointer. -If POS is out of range, the value is nil. -If BUFFER is nil, the current buffer is assumed. -if POS is nil, the value of point is assumed. -*/ - (pos, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - Bufpos n = (NILP (pos) ? BUF_PT (b) : - get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD)); - - if (n < 0 || n == BUF_ZV (b)) - return Qnil; - return make_char (BUF_FETCH_CHAR (b, n)); -} - -DEFUN ("char-before", Fchar_before, 0, 2, 0, /* -Return character in BUFFER before position POS. -POS is an integer or a buffer pointer. -If POS is out of range, the value is nil. -If BUFFER is nil, the current buffer is assumed. -if POS is nil, the value of point is assumed. -*/ - (pos, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - Bufpos n = ((NILP (pos) ? BUF_PT (b) : - get_buffer_pos_char (b, pos, GB_NO_ERROR_IF_BAD))); - - n--; - - if (n < BUF_BEGV (b)) - return Qnil; - return make_char (BUF_FETCH_CHAR (b, n)); -} - - -DEFUN ("temp-directory", Ftemp_directory, 0, 0, 0, /* -Return the pathname to the directory to use for temporary files. -On NT/MSDOS, this is obtained from the TEMP or TMP environment variables, -defaulting to / if they are both undefined. -On Unix it is obtained from TMPDIR, with /tmp as the default -*/ - ()) -{ - char *tmpdir; -#if defined(WINDOWSNT) || defined(MSDOS) - tmpdir = getenv ("TEMP"); - if (!tmpdir) - tmpdir = getenv ("TMP"); - if (!tmpdir) - tmpdir = "/"; -#else /* WINDOWSNT || MSDOS */ - tmpdir = getenv ("TMPDIR"); - if (!tmpdir) - tmpdir = "/tmp"; -#endif - - return build_ext_string (tmpdir, FORMAT_FILENAME); -} - -DEFUN ("user-login-name", Fuser_login_name, 0, 1, 0, /* -Return the name under which the user logged in, as a string. -This is based on the effective uid, not the real uid. -Also, if the environment variable LOGNAME or USER is set, -that determines the value of this function. -If the optional argument UID is present, then environment variables are -ignored and this function returns the login name for that UID, or nil. -*/ - (uid)) -{ - char *returned_name; - int local_uid; - - if (!NILP (uid)) - { - CHECK_INT (uid); - local_uid = XINT(uid); - returned_name = user_login_name(&local_uid); - } - else - { - returned_name = user_login_name(NULL); - } - /* #### - I believe this should return nil instead of "unknown" when pw==0 - pw=0 is indicated by a null return from user_login_name - */ - return returned_name ? build_string (returned_name) : Qnil; -} - -/* This function may be called from other C routines when a - character string representation of the user_login_name is - needed but a Lisp Object is not. The UID is passed by - reference. If UID == NULL, then the USER name - for the user running XEmacs will be returned. This - corresponds to a nil argument to Fuser_login_name. -*/ -char* -user_login_name (int *uid) -{ - struct passwd *pw = NULL; - - /* uid == NULL to return name of this user */ - if (uid != NULL) - { - pw = getpwuid (*uid); - return pw ? pw->pw_name : NULL; - } - else - { - /* #### - when euid != uid, then LOGNAME and USER are leftovers from the - old environment (I site observed behavior on sunos and linux), so the - environment variables should be disregarded in that case. --Stig */ - char *user_name = getenv ("LOGNAME"); - if (!user_name) - user_name = getenv ( -#ifdef WINDOWSNT - "USERNAME" /* it's USERNAME on NT */ -#else - "USER" -#endif - ); - if (user_name) - return (user_name); - else - { - pw = getpwuid (geteuid ()); -#ifdef __CYGWIN32__ - /* Since the Cygwin environment may not have an /etc/passwd, - return "unknown" instead of the null if the username - cannot be determined. - */ - return pw ? pw->pw_name : "unknown"; -#else - /* For all but Cygwin return NULL (nil) */ - return pw ? pw->pw_name : NULL; -#endif - } - } -} - -DEFUN ("user-real-login-name", Fuser_real_login_name, 0, 0, 0, /* -Return the name of the user's real uid, as a string. -This ignores the environment variables LOGNAME and USER, so it differs from -`user-login-name' when running under `su'. -*/ - ()) -{ - struct passwd *pw = getpwuid (getuid ()); - /* #### - I believe this should return nil instead of "unknown" when pw==0 */ - -#ifdef MSDOS - /* We let the real user name default to "root" because that's quite - accurate on MSDOG and because it lets Emacs find the init file. - (The DVX libraries override the Djgpp libraries here.) */ - Lisp_Object tem = build_string (pw ? pw->pw_name : "root");/* no gettext */ -#else - Lisp_Object tem = build_string (pw ? pw->pw_name : "unknown");/* no gettext */ -#endif - return tem; -} - -DEFUN ("user-uid", Fuser_uid, 0, 0, 0, /* -Return the effective uid of Emacs, as an integer. -*/ - ()) -{ - return make_int (geteuid ()); -} - -DEFUN ("user-real-uid", Fuser_real_uid, 0, 0, 0, /* -Return the real uid of Emacs, as an integer. -*/ - ()) -{ - return make_int (getuid ()); -} - -DEFUN ("user-full-name", Fuser_full_name, 0, 1, 0, /* -Return the full name of the user logged in, as a string. -If the optional argument USER is given, then the full name for that -user is returned, or nil. USER may be either a login name or a uid. - -If USER is nil, and `user-full-name' contains a string, the -value of `user-full-name' is returned. -*/ - (user)) -{ - Lisp_Object user_name; - struct passwd *pw = NULL; - Lisp_Object tem; - const char *p, *q; - - if (NILP (user) && STRINGP (Vuser_full_name)) - return Vuser_full_name; - - user_name = (STRINGP (user) ? user : Fuser_login_name (user)); - if (!NILP (user_name)) /* nil when nonexistent UID passed as arg */ - { - CONST char *user_name_ext; - - /* Fuck me. getpwnam() can call select() and (under IRIX at least) - things get wedged if a SIGIO arrives during this time. */ - GET_C_STRING_OS_DATA_ALLOCA (user_name, user_name_ext); - slow_down_interrupts (); - pw = (struct passwd *) getpwnam (user_name_ext); - speed_up_interrupts (); - } - - /* #### - Stig sez: this should return nil instead of "unknown" when pw==0 */ - /* Ben sez: bad idea because it's likely to break something */ -#ifndef AMPERSAND_FULL_NAME - p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */ - q = strchr (p, ','); -#else - p = ((pw) ? USER_FULL_NAME : "unknown"); /* don't gettext */ - q = strchr (p, ','); -#endif - tem = ((!NILP (user) && !pw) - ? Qnil - : make_ext_string ((Extbyte *) p, (q ? q - p : strlen (p)), - FORMAT_OS)); - -#ifdef AMPERSAND_FULL_NAME - if (!NILP (tem)) - { - p = (char *) XSTRING_DATA (tem); - q = strchr (p, '&'); - /* Substitute the login name for the &, upcasing the first character. */ - if (q) - { - char *r = (char *) alloca (strlen (p) + XSTRING_LENGTH (user_name) + 1); - memcpy (r, p, q - p); - r[q - p] = 0; - strcat (r, (char *) XSTRING_DATA (user_name)); - /* #### current_buffer dependency! */ - r[q - p] = UPCASE (current_buffer, r[q - p]); - strcat (r, q + 1); - tem = build_string (r); - } - } -#endif /* AMPERSAND_FULL_NAME */ - - return tem; -} - -static char *cached_home_directory; - -void -uncache_home_directory (void) -{ - cached_home_directory = NULL; /* in some cases, this may cause the leaking - of a few bytes */ -} - -/* Returns the home directory, in external format */ -char * -get_home_directory (void) -{ - int output_home_warning = 0; - - if (cached_home_directory == NULL) - { - if ((cached_home_directory = getenv("HOME")) == NULL) - { -#if defined(WINDOWSNT) && !defined(__CYGWIN32__) - char *homedrive, *homepath; - - if ((homedrive = getenv("HOMEDRIVE")) != NULL && - (homepath = getenv("HOMEPATH")) != NULL) - { - cached_home_directory = - (char *) xmalloc(strlen(homedrive) + strlen(homepath) + 1); - sprintf(cached_home_directory, "%s%s", homedrive, homepath); - } - else - { -# if 1 - /* - * Use the current directory. - * This preserves the existing XEmacs behavior, but is different - * from NT Emacs. - */ - if (initial_directory[0] != '\0') - { - cached_home_directory = initial_directory; - } - else - { - /* This will probably give the wrong value */ - cached_home_directory = getcwd (NULL, 0); - } -# else - /* - * This is NT Emacs behavior - */ - cached_home_directory = "C:\\"; - output_home_warning = 1; -# endif - } -#else /* !WINDOWSNT */ - /* - * Unix, typically. - * Using "/" isn't quite right, but what should we do? - * We probably should try to extract pw_dir from /etc/passwd, - * before falling back to this. - */ - cached_home_directory = "/"; - output_home_warning = 1; -#endif /* !WINDOWSNT */ - } - if (initialized && output_home_warning) - { - warn_when_safe (Quser_files_and_directories, Qwarning, "\n" -" XEmacs was unable to determine a good value for the user's $HOME\n" -" directory, and will be using the value:\n" -" %s\n" -" This is probably incorrect.", - cached_home_directory - ); - } - } - return cached_home_directory; -} - -DEFUN ("user-home-directory", Fuser_home_directory, 0, 0, 0, /* -Return the user's home directory, as a string. -*/ - ()) -{ - char *path = get_home_directory (); - - return path == NULL ? Qnil : - Fexpand_file_name (Fsubstitute_in_file_name - (build_ext_string (path, FORMAT_FILENAME)), - Qnil); -} - -DEFUN ("system-name", Fsystem_name, 0, 0, 0, /* -Return the name of the machine you are running on, as a string. -*/ - ()) -{ - return Fcopy_sequence (Vsystem_name); -} - -/* For the benefit of callers who don't want to include lisp.h. - Caller must free! */ -char * -get_system_name (void) -{ - return xstrdup ((char *) XSTRING_DATA (Vsystem_name)); -} - -DEFUN ("emacs-pid", Femacs_pid, 0, 0, 0, /* -Return the process ID of Emacs, as an integer. -*/ - ()) -{ - return make_int (getpid ()); -} - -DEFUN ("current-time", Fcurrent_time, 0, 0, 0, /* -Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of three integers. The first has the -most significant 16 bits of the seconds, while the second has the -least significant 16 bits. The third integer gives the microsecond -count. - -The microsecond count is zero on systems that do not provide -resolution finer than a second. -*/ - ()) -{ - EMACS_TIME t; - - EMACS_GET_TIME (t); - return list3 (make_int ((EMACS_SECS (t) >> 16) & 0xffff), - make_int ((EMACS_SECS (t) >> 0) & 0xffff), - make_int (EMACS_USECS (t))); -} - -DEFUN ("current-process-time", Fcurrent_process_time, 0, 0, 0, /* -Return the amount of time used by this XEmacs process so far. -The return value is a list of three floating-point numbers, expressing -the user, system, and real times used by the process. The user time -measures the time actually spent by the CPU executing the code in this -process. The system time measures time spent by the CPU executing kernel -code on behalf of this process (e.g. I/O requests made by the process). - -Note that the user and system times measure processor time, as opposed -to real time, and only accrue when the processor is actually doing -something: Time spent in an idle wait (waiting for user events to come -in or for I/O on a disk drive or other device to complete) does not -count. Thus, the user and system times will often be considerably -less than the real time. - -Some systems do not allow the user and system times to be distinguished. -In this case, the user time will be the total processor time used by -the process, and the system time will be 0. - -Some systems do not allow the real and processor times to be distinguished. -In this case, the user and real times will be the same and the system -time will be 0. -*/ - ()) -{ - double user, sys, real; - - get_process_times (&user, &sys, &real); - return list3 (make_float (user), make_float (sys), make_float (real)); -} - - -int lisp_to_time (Lisp_Object specified_time, time_t *result); -int -lisp_to_time (Lisp_Object specified_time, time_t *result) -{ - Lisp_Object high, low; - - if (NILP (specified_time)) - return time (result) != -1; - - CHECK_CONS (specified_time); - high = XCAR (specified_time); - low = XCDR (specified_time); - if (CONSP (low)) - low = XCAR (low); - CHECK_INT (high); - CHECK_INT (low); - *result = (XINT (high) << 16) + (XINT (low) & 0xffff); - return *result >> 16 == XINT (high); -} - -Lisp_Object time_to_lisp (time_t the_time); -Lisp_Object -time_to_lisp (time_t the_time) -{ - unsigned int item = (unsigned int) the_time; - return Fcons (make_int (item >> 16), make_int (item & 0xffff)); -} - -size_t emacs_strftime (char *string, size_t max, CONST char *format, - CONST struct tm *tm); -static long difftm (CONST struct tm *a, CONST struct tm *b); - - -DEFUN ("format-time-string", Fformat_time_string, 1, 2, 0, /* -Use FORMAT-STRING to format the time TIME. -TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as from -`current-time' and `file-attributes'. If TIME is not specified it -defaults to the current time. -FORMAT-STRING may contain %-sequences to substitute parts of the time. -%a is replaced by the abbreviated name of the day of week. -%A is replaced by the full name of the day of week. -%b is replaced by the abbreviated name of the month. -%B is replaced by the full name of the month. -%c is a synonym for "%x %X". -%C is a locale-specific synonym, which defaults to "%A, %B %e, %Y" in the C locale. -%d is replaced by the day of month, zero-padded. -%D is a synonym for "%m/%d/%y". -%e is replaced by the day of month, blank-padded. -%h is a synonym for "%b". -%H is replaced by the hour (00-23). -%I is replaced by the hour (00-12). -%j is replaced by the day of the year (001-366). -%k is replaced by the hour (0-23), blank padded. -%l is replaced by the hour (1-12), blank padded. -%m is replaced by the month (01-12). -%M is replaced by the minute (00-59). -%n is a synonym for "\\n". -%p is replaced by AM or PM, as appropriate. -%r is a synonym for "%I:%M:%S %p". -%R is a synonym for "%H:%M". -%S is replaced by the second (00-60). -%t is a synonym for "\\t". -%T is a synonym for "%H:%M:%S". -%U is replaced by the week of the year (00-53), first day of week is Sunday. -%w is replaced by the day of week (0-6), Sunday is day 0. -%W is replaced by the week of the year (00-53), first day of week is Monday. -%x is a locale-specific synonym, which defaults to "%D" in the C locale. -%X is a locale-specific synonym, which defaults to "%T" in the C locale. -%y is replaced by the year without century (00-99). -%Y is replaced by the year with century. -%Z is replaced by the time zone abbreviation. - -The number of options reflects the `strftime' function. - -BUG: If the charset used by the current locale is not ISO 8859-1, the -characters appearing in the day and month names may be incorrect. -*/ - (format_string, time_)) -{ - time_t value; - size_t size; - - CHECK_STRING (format_string); - - if (! lisp_to_time (time_, &value)) - error ("Invalid time specification"); - - /* This is probably enough. */ - size = XSTRING_LENGTH (format_string) * 6 + 50; - - while (1) - { - char *buf = (char *) alloca (size); - *buf = 1; - if (emacs_strftime (buf, size, - (CONST char *) XSTRING_DATA (format_string), - localtime (&value)) - || !*buf) - return build_ext_string (buf, FORMAT_BINARY); - /* If buffer was too small, make it bigger. */ - size *= 2; - } -} - -DEFUN ("decode-time", Fdecode_time, 0, 1, 0, /* -Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE). -The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED) -or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil' -to use the current time. The list has the following nine members: -SEC is an integer between 0 and 60; SEC is 60 for a leap second, which -only some operating systems support. MINUTE is an integer between 0 and 59. -HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31. -MONTH is an integer between 1 and 12. YEAR is an integer indicating the -four-digit year. DOW is the day of week, an integer between 0 and 6, where -0 is Sunday. DST is t if daylight savings time is effect, otherwise nil. -ZONE is an integer indicating the number of seconds east of Greenwich. -\(Note that Common Lisp has different meanings for DOW and ZONE.) -*/ - (specified_time)) -{ - time_t time_spec; - struct tm save_tm; - struct tm *decoded_time; - Lisp_Object list_args[9]; - - if (! lisp_to_time (specified_time, &time_spec)) - error ("Invalid time specification"); - - decoded_time = localtime (&time_spec); - list_args[0] = make_int (decoded_time->tm_sec); - list_args[1] = make_int (decoded_time->tm_min); - list_args[2] = make_int (decoded_time->tm_hour); - list_args[3] = make_int (decoded_time->tm_mday); - list_args[4] = make_int (decoded_time->tm_mon + 1); - list_args[5] = make_int (decoded_time->tm_year + 1900); - list_args[6] = make_int (decoded_time->tm_wday); - list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; - - /* Make a copy, in case gmtime modifies the struct. */ - save_tm = *decoded_time; - decoded_time = gmtime (&time_spec); - if (decoded_time == 0) - list_args[8] = Qnil; - else - list_args[8] = make_int (difftm (&save_tm, decoded_time)); - return Flist (9, list_args); -} - -static void set_time_zone_rule (char *tzstring); - -DEFUN ("encode-time", Fencode_time, 6, MANY, 0, /* - Convert SECOND, MINUTE, HOUR, DAY, MONTH, YEAR and ZONE to internal time. -This is the reverse operation of `decode-time', which see. -ZONE defaults to the current time zone rule. This can -be a string (as from `set-time-zone-rule'), or it can be a list -\(as from `current-time-zone') or an integer (as from `decode-time') -applied without consideration for daylight savings time. - -You can pass more than 7 arguments; then the first six arguments -are used as SECOND through YEAR, and the *last* argument is used as ZONE. -The intervening arguments are ignored. -This feature lets (apply 'encode-time (decode-time ...)) work. - -Out-of-range values for SEC, MINUTE, HOUR, DAY, or MONTH are allowed; -for example, a DAY of 0 means the day preceding the given month. -Year numbers less than 100 are treated just like other year numbers. -If you want them to stand for years in this century, you must do that yourself. -*/ - (int nargs, Lisp_Object *args)) -{ - time_t the_time; - struct tm tm; - Lisp_Object zone = (nargs > 6) ? args[nargs - 1] : Qnil; - - CHECK_INT (*args); tm.tm_sec = XINT (*args++); /* second */ - CHECK_INT (*args); tm.tm_min = XINT (*args++); /* minute */ - CHECK_INT (*args); tm.tm_hour = XINT (*args++); /* hour */ - CHECK_INT (*args); tm.tm_mday = XINT (*args++); /* day */ - CHECK_INT (*args); tm.tm_mon = XINT (*args++) - 1; /* month */ - CHECK_INT (*args); tm.tm_year = XINT (*args++) - 1900;/* year */ - - tm.tm_isdst = -1; - - if (CONSP (zone)) - zone = XCAR (zone); - if (NILP (zone)) - the_time = mktime (&tm); - else - { - char tzbuf[100]; - char *tzstring; - char **oldenv = environ, **newenv; - - if (STRINGP (zone)) - tzstring = (char *) XSTRING_DATA (zone); - else if (INTP (zone)) - { - int abszone = abs (XINT (zone)); - sprintf (tzbuf, "XXX%s%d:%02d:%02d", "-" + (XINT (zone) < 0), - abszone / (60*60), (abszone/60) % 60, abszone % 60); - tzstring = tzbuf; - } - else - error ("Invalid time zone specification"); - - /* Set TZ before calling mktime; merely adjusting mktime's returned - value doesn't suffice, since that would mishandle leap seconds. */ - set_time_zone_rule (tzstring); - - the_time = mktime (&tm); - - /* Restore TZ to previous value. */ - newenv = environ; - environ = oldenv; - free (newenv); -#ifdef LOCALTIME_CACHE - tzset (); -#endif - } - - if (the_time == (time_t) -1) - error ("Specified time is not representable"); - - return wasteful_word_to_lisp (the_time); -} - -DEFUN ("current-time-string", Fcurrent_time_string, 0, 1, 0, /* -Return the current time, as a human-readable string. -Programs can use this function to decode a time, -since the number of columns in each field is fixed. -The format is `Sun Sep 16 01:03:52 1973'. -If an argument is given, it specifies a time to format -instead of the current time. The argument should have the form: - (HIGH . LOW) -or the form: - (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' -and from `file-attributes'. -*/ - (specified_time)) -{ - time_t value; - char buf[30]; - char *tem; - - if (! lisp_to_time (specified_time, &value)) - value = -1; - tem = (char *) ctime (&value); - - strncpy (buf, tem, 24); - buf[24] = 0; - - return build_ext_string (buf, FORMAT_BINARY); -} - -#define TM_YEAR_ORIGIN 1900 - -/* Yield A - B, measured in seconds. */ -static long -difftm (CONST struct tm *a, CONST struct tm *b) -{ - int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); - int by = b->tm_year + (TM_YEAR_ORIGIN - 1); - /* Some compilers can't handle this as a single return statement. */ - long days = ( - /* difference in day of year */ - a->tm_yday - b->tm_yday - /* + intervening leap days */ - + ((ay >> 2) - (by >> 2)) - - (ay/100 - by/100) - + ((ay/100 >> 2) - (by/100 >> 2)) - /* + difference in years * 365 */ - + (long)(ay-by) * 365 - ); - return (60*(60*(24*days + (a->tm_hour - b->tm_hour)) - + (a->tm_min - b->tm_min)) - + (a->tm_sec - b->tm_sec)); -} - -DEFUN ("current-time-zone", Fcurrent_time_zone, 0, 1, 0, /* -Return the offset and name for the local time zone. -This returns a list of the form (OFFSET NAME). -OFFSET is an integer number of seconds ahead of UTC (east of Greenwich). - A negative value means west of Greenwich. -NAME is a string giving the name of the time zone. -If an argument is given, it specifies when the time zone offset is determined -instead of using the current time. The argument should have the form: - (HIGH . LOW) -or the form: - (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' -and from `file-attributes'. - -Some operating systems cannot provide all this information to Emacs; -in this case, `current-time-zone' returns a list containing nil for -the data it can't find. -*/ - (specified_time)) -{ - time_t value; - struct tm *t = NULL; - - if (lisp_to_time (specified_time, &value) - && (t = gmtime (&value)) != 0) - { - struct tm gmt = *t; /* Make a copy, in case localtime modifies *t. */ - long offset; - char *s, buf[6]; - - t = localtime (&value); - offset = difftm (t, &gmt); - s = 0; -#ifdef HAVE_TM_ZONE - if (t->tm_zone) - s = (char *)t->tm_zone; -#else /* not HAVE_TM_ZONE */ -#ifdef HAVE_TZNAME - if (t->tm_isdst == 0 || t->tm_isdst == 1) - s = tzname[t->tm_isdst]; -#endif -#endif /* not HAVE_TM_ZONE */ - if (!s) - { - /* No local time zone name is available; use "+-NNNN" instead. */ - int am = (offset < 0 ? -offset : offset) / 60; - sprintf (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am/60, am%60); - s = buf; - } - return list2 (make_int (offset), build_string (s)); - } - else - return list2 (Qnil, Qnil); -} - -#ifdef LOCALTIME_CACHE - -/* These two values are known to load tz files in buggy implementations, - i.e. Solaris 1 executables running under either Solaris 1 or Solaris 2. - Their values shouldn't matter in non-buggy implementations. - We don't use string literals for these strings, - since if a string in the environment is in readonly - storage, it runs afoul of bugs in SVR4 and Solaris 2.3. - See Sun bugs 1113095 and 1114114, ``Timezone routines - improperly modify environment''. */ - -static char set_time_zone_rule_tz1[] = "TZ=GMT+0"; -static char set_time_zone_rule_tz2[] = "TZ=GMT+1"; - -#endif - -/* Set the local time zone rule to TZSTRING. - This allocates memory into `environ', which it is the caller's - responsibility to free. */ -static void -set_time_zone_rule (char *tzstring) -{ - int envptrs; - char **from, **to, **newenv; - - for (from = environ; *from; from++) - continue; - envptrs = from - environ + 2; - newenv = to = (char **) xmalloc (envptrs * sizeof (char *) - + (tzstring ? strlen (tzstring) + 4 : 0)); - if (tzstring) - { - char *t = (char *) (to + envptrs); - strcpy (t, "TZ="); - strcat (t, tzstring); - *to++ = t; - } - - for (from = environ; *from; from++) - if (strncmp (*from, "TZ=", 3) != 0) - *to++ = *from; - *to = 0; - - environ = newenv; - -#ifdef LOCALTIME_CACHE - { - /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like - "US/Pacific" that loads a tz file, then changes to a value like - "XXX0" that does not load a tz file, and then changes back to - its original value, the last change is (incorrectly) ignored. - Also, if TZ changes twice in succession to values that do - not load a tz file, tzset can dump core (see Sun bug#1225179). - The following code works around these bugs. */ - - if (tzstring) - { - /* Temporarily set TZ to a value that loads a tz file - and that differs from tzstring. */ - char *tz = *newenv; - *newenv = (strcmp (tzstring, set_time_zone_rule_tz1 + 3) == 0 - ? set_time_zone_rule_tz2 : set_time_zone_rule_tz1); - tzset (); - *newenv = tz; - } - else - { - /* The implied tzstring is unknown, so temporarily set TZ to - two different values that each load a tz file. */ - *to = set_time_zone_rule_tz1; - to[1] = 0; - tzset (); - *to = set_time_zone_rule_tz2; - tzset (); - *to = 0; - } - - /* Now TZ has the desired value, and tzset can be invoked safely. */ - } - - tzset (); -#endif -} - -DEFUN ("set-time-zone-rule", Fset_time_zone_rule, 1, 1, 0, /* -Set the local time zone using TZ, a string specifying a time zone rule. -If TZ is nil, use implementation-defined default time zone information. -*/ - (tz)) -{ - char *tzstring; - - if (NILP (tz)) - tzstring = 0; - else - { - CHECK_STRING (tz); - tzstring = (char *) XSTRING_DATA (tz); - } - - set_time_zone_rule (tzstring); - if (environbuf) - xfree (environbuf); - environbuf = environ; - - return Qnil; -} - - -void -buffer_insert1 (struct buffer *buf, Lisp_Object arg) -{ - /* This function can GC */ - struct gcpro gcpro1; - GCPRO1 (arg); - retry: - if (CHAR_OR_CHAR_INTP (arg)) - { - buffer_insert_emacs_char (buf, XCHAR_OR_CHAR_INT (arg)); - } - else if (STRINGP (arg)) - { - buffer_insert_lisp_string (buf, arg); - } - else - { - arg = wrong_type_argument (Qchar_or_string_p, arg); - goto retry; - } - zmacs_region_stays = 0; - UNGCPRO; -} - - -/* Callers passing one argument to Finsert need not gcpro the - argument "array", since the only element of the array will - not be used after calling insert_emacs_char or insert_lisp_string, - so we don't care if it gets trashed. */ - -DEFUN ("insert", Finsert, 0, MANY, 0, /* -Insert the arguments, either strings or characters, at point. -Point moves forward so that it ends up after the inserted text. -Any other markers at the point of insertion remain before the text. -If a string has non-null string-extent-data, new extents will be created. -*/ - (int nargs, Lisp_Object *args)) -{ - /* This function can GC */ - REGISTER int argnum; - - for (argnum = 0; argnum < nargs; argnum++) - { - buffer_insert1 (current_buffer, args[argnum]); - } - - return Qnil; -} - -DEFUN ("insert-before-markers", Finsert_before_markers, 0, MANY, 0, /* -Insert strings or characters at point, relocating markers after the text. -Point moves forward so that it ends up after the inserted text. -Any other markers at the point of insertion also end up after the text. -*/ - (int nargs, Lisp_Object *args)) -{ - /* This function can GC */ - REGISTER int argnum; - REGISTER Lisp_Object tem; - - for (argnum = 0; argnum < nargs; argnum++) - { - tem = args[argnum]; - retry: - if (CHAR_OR_CHAR_INTP (tem)) - { - buffer_insert_emacs_char_1 (current_buffer, -1, - XCHAR_OR_CHAR_INT (tem), - INSDEL_BEFORE_MARKERS); - } - else if (STRINGP (tem)) - { - buffer_insert_lisp_string_1 (current_buffer, -1, tem, - INSDEL_BEFORE_MARKERS); - } - else - { - tem = wrong_type_argument (Qchar_or_string_p, tem); - goto retry; - } - } - zmacs_region_stays = 0; - return Qnil; -} - -DEFUN ("insert-string", Finsert_string, 1, 2, 0, /* -Insert STRING into BUFFER at BUFFER's point. -Point moves forward so that it ends up after the inserted text. -Any other markers at the point of insertion remain before the text. -If a string has non-null string-extent-data, new extents will be created. -BUFFER defaults to the current buffer. -*/ - (string, buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - CHECK_STRING (string); - buffer_insert_lisp_string (b, string); - zmacs_region_stays = 0; - return Qnil; -} - -/* Third argument in FSF is INHERIT: - -"The optional third arg INHERIT, if non-nil, says to inherit text properties -from adjoining text, if those properties are sticky." - -Jamie thinks this is bogus. */ - - -DEFUN ("insert-char", Finsert_char, 1, 4, 0, /* -Insert COUNT (second arg) copies of CHR (first arg). -Point and all markers are affected as in the function `insert'. -COUNT defaults to 1 if omitted. -The optional third arg IGNORED is INHERIT under FSF Emacs. -This is highly bogus, however, and XEmacs always behaves as if -`t' were passed to INHERIT. -The optional fourth arg BUFFER specifies the buffer to insert the -text into. If BUFFER is nil, the current buffer is assumed. -*/ - (chr, count, ignored, buffer)) -{ - /* This function can GC */ - REGISTER Bufbyte *string; - REGISTER int slen; - REGISTER int i, j; - REGISTER Bytecount n; - REGISTER Bytecount charlen; - Bufbyte str[MAX_EMCHAR_LEN]; - struct buffer *b = decode_buffer (buffer, 1); - int cou; - - CHECK_CHAR_COERCE_INT (chr); - if (NILP (count)) - cou = 1; - else - { - CHECK_INT (count); - cou = XINT (count); - } - - charlen = set_charptr_emchar (str, XCHAR (chr)); - n = cou * charlen; - if (n <= 0) - return Qnil; - slen = min (n, 768); - string = alloca_array (Bufbyte, slen); - /* Write as many copies of the character into the temp string as will fit. */ - for (i = 0; i + charlen <= slen; i += charlen) - for (j = 0; j < charlen; j++) - string[i + j] = str[j]; - slen = i; - while (n >= slen) - { - buffer_insert_raw_string (b, string, slen); - n -= slen; - } - if (n > 0) -#if 0 /* FSFmacs bogosity */ - { - if (!NILP (inherit)) - insert_and_inherit (string, n); - else - insert (string, n); - } -#else - buffer_insert_raw_string (b, string, n); -#endif - - zmacs_region_stays = 0; - return Qnil; -} - - -/* Making strings from buffer contents. */ - -DEFUN ("buffer-substring", Fbuffer_substring, 0, 3, 0, /* -Return the contents of part of BUFFER as a string. -The two arguments START and END are character positions; -they can be in either order. If omitted, they default to the beginning -and end of BUFFER, respectively. -If there are duplicable extents in the region, the string remembers -them in its extent data. -If BUFFER is nil, the current buffer is assumed. -*/ - (start, end, buffer)) -{ - /* This function can GC */ - Bufpos begv, zv; - struct buffer *b = decode_buffer (buffer, 1); - - get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL); - return make_string_from_buffer (b, begv, zv - begv); -} - -/* It might make more sense to name this - `buffer-substring-no-extents', but this name is FSFmacs-compatible, - and what the function does is probably good enough for what the - user-code will typically want to use it for. */ -DEFUN ("buffer-substring-no-properties", Fbuffer_substring_no_properties, 0, 3, 0, /* -Return the text from BEG to END, as a string, without copying the extents. -*/ - (start, end, buffer)) -{ - /* This function can GC */ - Bufpos begv, zv; - struct buffer *b = decode_buffer (buffer, 1); - - get_buffer_range_char (b, start, end, &begv, &zv, GB_ALLOW_NIL); - return make_string_from_buffer_no_extents (b, begv, zv - begv); -} - -DEFUN ("insert-buffer-substring", Finsert_buffer_substring, 1, 3, 0, /* -Insert before point a substring of the contents of buffer BUFFER. -BUFFER may be a buffer or a buffer name. -Arguments START and END are character numbers specifying the substring. -They default to the beginning and the end of BUFFER. -*/ - (buffer, start, end)) -{ - /* This function can GC */ - Bufpos b, e; - struct buffer *bp; - - bp = XBUFFER (get_buffer (buffer, 1)); - get_buffer_range_char (bp, start, end, &b, &e, GB_ALLOW_NIL); - - if (b < e) - buffer_insert_from_buffer (current_buffer, bp, b, e - b); - - return Qnil; -} - -DEFUN ("compare-buffer-substrings", Fcompare_buffer_substrings, 6, 6, 0, /* -Compare two substrings of two buffers; return result as number. -the value is -N if first string is less after N-1 chars, -+N if first string is greater after N-1 chars, or 0 if strings match. -Each substring is represented as three arguments: BUFFER, START and END. -That makes six args in all, three for each substring. - -The value of `case-fold-search' in the current buffer -determines whether case is significant or ignored. -*/ - (buffer1, start1, end1, buffer2, start2, end2)) -{ - Bufpos begp1, endp1, begp2, endp2; - REGISTER Charcount len1, len2, length, i; - struct buffer *bp1, *bp2; - Lisp_Object trt = ((!NILP (current_buffer->case_fold_search)) ? - current_buffer->case_canon_table : Qnil); - - /* Find the first buffer and its substring. */ - - bp1 = decode_buffer (buffer1, 1); - get_buffer_range_char (bp1, start1, end1, &begp1, &endp1, GB_ALLOW_NIL); - - /* Likewise for second substring. */ - - bp2 = decode_buffer (buffer2, 1); - get_buffer_range_char (bp2, start2, end2, &begp2, &endp2, GB_ALLOW_NIL); - - len1 = endp1 - begp1; - len2 = endp2 - begp2; - length = len1; - if (len2 < length) - length = len2; - - for (i = 0; i < length; i++) - { - Emchar c1 = BUF_FETCH_CHAR (bp1, begp1 + i); - Emchar c2 = BUF_FETCH_CHAR (bp2, begp2 + i); - if (!NILP (trt)) - { - c1 = TRT_TABLE_OF (trt, c1); - c2 = TRT_TABLE_OF (trt, c2); - } - if (c1 < c2) - return make_int (- 1 - i); - if (c1 > c2) - return make_int (i + 1); - } - - /* The strings match as far as they go. - If one is shorter, that one is less. */ - if (length < len1) - return make_int (length + 1); - else if (length < len2) - return make_int (- length - 1); - - /* Same length too => they are equal. */ - return Qzero; -} - - -static Lisp_Object -subst_char_in_region_unwind (Lisp_Object arg) -{ - XBUFFER (XCAR (arg))->undo_list = XCDR (arg); - return Qnil; -} - -static Lisp_Object -subst_char_in_region_unwind_1 (Lisp_Object arg) -{ - XBUFFER (XCAR (arg))->filename = XCDR (arg); - return Qnil; -} - -DEFUN ("subst-char-in-region", Fsubst_char_in_region, 4, 5, 0, /* -From START to END, replace FROMCHAR with TOCHAR each time it occurs. -If optional arg NOUNDO is non-nil, don't record this change for undo -and don't mark the buffer as really changed. -*/ - (start, end, fromchar, tochar, noundo)) -{ - /* This function can GC */ - Bufpos pos, stop; - Emchar fromc, toc; - int mc_count; - struct buffer *buf = current_buffer; - int count = specpdl_depth (); - - get_buffer_range_char (buf, start, end, &pos, &stop, 0); - CHECK_CHAR_COERCE_INT (fromchar); - CHECK_CHAR_COERCE_INT (tochar); - - fromc = XCHAR (fromchar); - toc = XCHAR (tochar); - - /* If we don't want undo, turn off putting stuff on the list. - That's faster than getting rid of things, - and it prevents even the entry for a first change. - Also inhibit locking the file. */ - if (!NILP (noundo)) - { - record_unwind_protect (subst_char_in_region_unwind, - Fcons (Fcurrent_buffer (), buf->undo_list)); - buf->undo_list = Qt; - /* Don't do file-locking. */ - record_unwind_protect (subst_char_in_region_unwind_1, - Fcons (Fcurrent_buffer (), buf->filename)); - buf->filename = Qnil; - } - - mc_count = begin_multiple_change (buf, pos, stop); - while (pos < stop) - { - if (BUF_FETCH_CHAR (buf, pos) == fromc) - { - /* There used to be some code here that set the buffer to - unmodified if NOUNDO was specified and there was only - one change to the buffer since it was last saved. - This is a crock of shit, so I'm not duplicating this - behavior. I think this was left over from when - prepare_to_modify_buffer() actually bumped MODIFF, - so that code was supposed to undo this change. --ben */ - buffer_replace_char (buf, pos, toc, !NILP (noundo), 0); - - /* If noundo is not nil then we don't mark the buffer as - modified. In reality that needs to happen externally - only. Internally redisplay needs to know that the actual - contents it should be displaying have changed. */ - if (!NILP (noundo)) - Fset_buffer_modified_p (Fbuffer_modified_p (Qnil), Qnil); - } - pos++; - } - end_multiple_change (buf, mc_count); - - unbind_to (count, Qnil); - return Qnil; -} - -/* #### Shouldn't this also accept a BUFFER argument, in the good old - XEmacs tradition? */ -DEFUN ("translate-region", Ftranslate_region, 3, 3, 0, /* -Translate characters from START to END according to TABLE. - -If TABLE is a string, the Nth character in it is the mapping for the -character with code N. - -If TABLE is a vector, its Nth element is the mapping for character -with code N. The values of elements may be characters, strings, or -nil (nil meaning don't replace.) - -If TABLE is a char-table, its elements describe the mapping between -characters and their replacements. The char-table should be of type -`char' or `generic'. - -Returns the number of substitutions performed. -*/ - (start, end, table)) -{ - /* This function can GC */ - Bufpos pos, stop; /* Limits of the region. */ - int cnt = 0; /* Number of changes made. */ - int mc_count; - struct buffer *buf = current_buffer; - Emchar oc; - - get_buffer_range_char (buf, start, end, &pos, &stop, 0); - mc_count = begin_multiple_change (buf, pos, stop); - if (STRINGP (table)) - { - struct Lisp_String *stable = XSTRING (table); - Charcount size = string_char_length (stable); -#ifdef MULE - /* Under Mule, string_char(n) is O(n), so for large tables or - large regions it makes sense to create an array of Emchars. */ - if (size * (stop - pos) > 65536) - { - Emchar *etable = alloca_array (Emchar, size); - convert_bufbyte_string_into_emchar_string - (string_data (stable), string_length (stable), etable); - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) - { - if (oc < size) - { - Emchar nc = etable[oc]; - if (nc != oc) - { - buffer_replace_char (buf, pos, nc, 0, 0); - ++cnt; - } - } - } - } - else -#endif /* MULE */ - { - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) - { - if (oc < size) - { - Emchar nc = string_char (stable, oc); - if (nc != oc) - { - buffer_replace_char (buf, pos, nc, 0, 0); - ++cnt; - } - } - } - } - } - else if (VECTORP (table)) - { - Charcount size = XVECTOR_LENGTH (table); - Lisp_Object *vtable = XVECTOR_DATA (table); - - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) - { - if (oc < size) - { - Lisp_Object replacement = vtable[oc]; - retry: - if (CHAR_OR_CHAR_INTP (replacement)) - { - Emchar nc = XCHAR_OR_CHAR_INT (replacement); - if (nc != oc) - { - buffer_replace_char (buf, pos, nc, 0, 0); - ++cnt; - } - } - else if (STRINGP (replacement)) - { - Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; - buffer_delete_range (buf, pos, pos + 1, 0); - buffer_insert_lisp_string_1 (buf, pos, replacement, 0); - pos += incr, stop += incr; - ++cnt; - } - else if (!NILP (replacement)) - { - replacement = wrong_type_argument (Qchar_or_string_p, replacement); - goto retry; - } - } - } - } - else if (CHAR_TABLEP (table) - && (XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC - || XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR)) - { - struct Lisp_Char_Table *ctable = XCHAR_TABLE (table); - - for (; pos < stop && (oc = BUF_FETCH_CHAR (buf, pos), 1); pos++) - { - Lisp_Object replacement = get_char_table (oc, ctable); - retry2: - if (CHAR_OR_CHAR_INTP (replacement)) - { - Emchar nc = XCHAR_OR_CHAR_INT (replacement); - if (nc != oc) - { - buffer_replace_char (buf, pos, nc, 0, 0); - ++cnt; - } - } - else if (STRINGP (replacement)) - { - Charcount incr = XSTRING_CHAR_LENGTH (replacement) - 1; - buffer_delete_range (buf, pos, pos + 1, 0); - buffer_insert_lisp_string_1 (buf, pos, replacement, 0); - pos += incr, stop += incr; - ++cnt; - } - else if (!NILP (replacement)) - { - replacement = wrong_type_argument (Qchar_or_string_p, replacement); - goto retry2; - } - } - } - else - dead_wrong_type_argument (Qstringp, table); - end_multiple_change (buf, mc_count); - - return make_int (cnt); -} - -DEFUN ("delete-region", Fdelete_region, 2, 3, "r", /* -Delete the text between point and mark. -When called from a program, expects two arguments, -positions (integers or markers) specifying the stretch to be deleted. -If BUFFER is nil, the current buffer is assumed. -*/ - (b, e, buffer)) -{ - /* This function can GC */ - Bufpos start, end; - struct buffer *buf = decode_buffer (buffer, 1); - - get_buffer_range_char (buf, b, e, &start, &end, 0); - buffer_delete_range (buf, start, end, 0); - zmacs_region_stays = 0; - return Qnil; -} - -void -widen_buffer (struct buffer *b, int no_clip) -{ - if (BUF_BEGV (b) != BUF_BEG (b)) - { - clip_changed = 1; - SET_BOTH_BUF_BEGV (b, BUF_BEG (b), BI_BUF_BEG (b)); - } - if (BUF_ZV (b) != BUF_Z (b)) - { - clip_changed = 1; - SET_BOTH_BUF_ZV (b, BUF_Z (b), BI_BUF_Z (b)); - } - if (clip_changed) - { - if (!no_clip) - MARK_CLIP_CHANGED; - /* Changing the buffer bounds invalidates any recorded current - column. */ - invalidate_current_column (); - narrow_line_number_cache (b); - } -} - -DEFUN ("widen", Fwiden, 0, 1, "", /* -Remove restrictions (narrowing) from BUFFER. -This allows the buffer's full text to be seen and edited. -If BUFFER is nil, the current buffer is assumed. -*/ - (buffer)) -{ - struct buffer *b = decode_buffer (buffer, 1); - widen_buffer (b, 0); - zmacs_region_stays = 0; - return Qnil; -} - -DEFUN ("narrow-to-region", Fnarrow_to_region, 2, 3, "r", /* -Restrict editing in BUFFER to the current region. -The rest of the text becomes temporarily invisible and untouchable -but is not deleted; if you save the buffer in a file, the invisible -text is included in the file. \\[widen] makes all visible again. -If BUFFER is nil, the current buffer is assumed. -See also `save-restriction'. - -When calling from a program, pass two arguments; positions (integers -or markers) bounding the text that should remain visible. -*/ - (b, e, buffer)) -{ - Bufpos start, end; - struct buffer *buf = decode_buffer (buffer, 1); - Bytind bi_start, bi_end; - - get_buffer_range_char (buf, b, e, &start, &end, GB_ALLOW_PAST_ACCESSIBLE); - bi_start = bufpos_to_bytind (buf, start); - bi_end = bufpos_to_bytind (buf, end); - - SET_BOTH_BUF_BEGV (buf, start, bi_start); - SET_BOTH_BUF_ZV (buf, end, bi_end); - if (BUF_PT (buf) < start) - BUF_SET_PT (buf, start); - if (BUF_PT (buf) > end) - BUF_SET_PT (buf, end); - MARK_CLIP_CHANGED; - /* Changing the buffer bounds invalidates any recorded current column. */ - invalidate_current_column (); - narrow_line_number_cache (buf); - zmacs_region_stays = 0; - return Qnil; -} - -Lisp_Object -save_restriction_save (void) -{ - Lisp_Object bottom, top; - /* Note: I tried using markers here, but it does not win - because insertion at the end of the saved region - does not advance mh and is considered "outside" the saved region. */ - bottom = make_int (BUF_BEGV (current_buffer) - BUF_BEG (current_buffer)); - top = make_int (BUF_Z (current_buffer) - BUF_ZV (current_buffer)); - - return noseeum_cons (Fcurrent_buffer (), noseeum_cons (bottom, top)); -} - -Lisp_Object -save_restriction_restore (Lisp_Object data) -{ - struct buffer *buf; - Charcount newhead, newtail; - Lisp_Object tem; - int local_clip_changed = 0; - - buf = XBUFFER (XCAR (data)); - if (!BUFFER_LIVE_P (buf)) - { - /* someone could have killed the buffer in the meantime ... */ - free_cons (XCONS (XCDR (data))); - free_cons (XCONS (data)); - return Qnil; - } - tem = XCDR (data); - newhead = XINT (XCAR (tem)); - newtail = XINT (XCDR (tem)); - - free_cons (XCONS (XCDR (data))); - free_cons (XCONS (data)); - - if (newhead + newtail > BUF_Z (buf) - BUF_BEG (buf)) - { - newhead = 0; - newtail = 0; - } - - { - Bufpos start, end; - Bytind bi_start, bi_end; - - start = BUF_BEG (buf) + newhead; - end = BUF_Z (buf) - newtail; - - bi_start = bufpos_to_bytind (buf, start); - bi_end = bufpos_to_bytind (buf, end); - - if (BUF_BEGV (buf) != start) - { - local_clip_changed = 1; - SET_BOTH_BUF_BEGV (buf, start, bi_start); - narrow_line_number_cache (buf); - } - if (BUF_ZV (buf) != end) - { - local_clip_changed = 1; - SET_BOTH_BUF_ZV (buf, end, bi_end); - } - } - if (local_clip_changed) - MARK_CLIP_CHANGED; - - /* If point is outside the new visible range, move it inside. */ - BUF_SET_PT (buf, - bufpos_clip_to_bounds (BUF_BEGV (buf), - BUF_PT (buf), - BUF_ZV (buf))); - - return Qnil; -} - -DEFUN ("save-restriction", Fsave_restriction, 0, UNEVALLED, 0, /* -Execute BODY, saving and restoring current buffer's restrictions. -The buffer's restrictions make parts of the beginning and end invisible. -\(They are set up with `narrow-to-region' and eliminated with `widen'.) -This special form, `save-restriction', saves the current buffer's restrictions -when it is entered, and restores them when it is exited. -So any `narrow-to-region' within BODY lasts only until the end of the form. -The old restrictions settings are restored -even in case of abnormal exit (throw or error). - -The value returned is the value of the last form in BODY. - -`save-restriction' can get confused if, within the BODY, you widen -and then make changes outside the area within the saved restrictions. - -Note: if you are using both `save-excursion' and `save-restriction', -use `save-excursion' outermost: - (save-excursion (save-restriction ...)) -*/ - (body)) -{ - /* This function can GC */ - int speccount = specpdl_depth (); - - record_unwind_protect (save_restriction_restore, save_restriction_save ()); - - return unbind_to (speccount, Fprogn (body)); -} - - -DEFUN ("format", Fformat, 1, MANY, 0, /* -Format a string out of a control-string and arguments. -The first argument is a control string. -The other arguments are substituted into it to make the result, a string. -It may contain %-sequences meaning to substitute the next argument. -%s means print all objects as-is, using `princ'. -%S means print all objects as s-expressions, using `prin1'. -%d or %i means print as an integer in decimal (%o octal, %x lowercase hex, - %X uppercase hex). -%c means print as a single character. -%f means print as a floating-point number in fixed notation (e.g. 785.200). -%e or %E means print as a floating-point number in scientific notation - (e.g. 7.85200e+03). -%g or %G means print as a floating-point number in "pretty format"; - depending on the number, either %f or %e/%E format will be used, and - trailing zeroes are removed from the fractional part. -The argument used for all but %s and %S must be a number. It will be - converted to an integer or a floating-point number as necessary. - -%$ means reposition to read a specific numbered argument; for example, - %3$s would apply the `%s' to the third argument after the control string, - and the next format directive would use the fourth argument, the - following one the fifth argument, etc. (There must be a positive integer - between the % and the $). -Zero or more of the flag characters `-', `+', ` ', `0', and `#' may be - specified between the optional repositioning spec and the conversion - character; see below. -An optional minimum field width may be specified after any flag characters - and before the conversion character; it specifies the minimum number of - characters that the converted argument will take up. Padding will be - added on the left (or on the right, if the `-' flag is specified), as - necessary. Padding is done with spaces, or with zeroes if the `0' flag - is specified. -If the field width is specified as `*', the field width is assumed to have - been specified as an argument. Any repositioning specification that - would normally specify the argument to be converted will now specify - where to find this field width argument, not where to find the argument - to be converted. If there is no repositioning specification, the normal - next argument is used. The argument to be converted will be the next - argument after the field width argument unless the precision is also - specified as `*' (see below). - -An optional period character and precision may be specified after any - minimum field width. It specifies the minimum number of digits to - appear in %d, %i, %o, %x, and %X conversions (the number is padded - on the left with zeroes as necessary); the number of digits printed - after the decimal point for %f, %e, and %E conversions; the number - of significant digits printed in %g and %G conversions; and the - maximum number of non-padding characters printed in %s and %S - conversions. The default precision for floating-point conversions - is six. -If the precision is specified as `*', the precision is assumed to have been - specified as an argument. The argument used will be the next argument - after the field width argument, if any. If the field width was not - specified as an argument, any repositioning specification that would - normally specify the argument to be converted will now specify where to - find the precision argument. If there is no repositioning specification, - the normal next argument is used. - -The ` ' and `+' flags mean prefix non-negative numbers with a space or - plus sign, respectively. -The `#' flag means print numbers in an alternate, more verbose format: - octal numbers begin with zero; hex numbers begin with a 0x or 0X; - a decimal point is printed in %f, %e, and %E conversions even if no - numbers are printed after it; and trailing zeroes are not omitted in - %g and %G conversions. - -Use %% to put a single % into the output. -*/ - (int nargs, Lisp_Object *args)) -{ - /* It should not be necessary to GCPRO ARGS, because - the caller in the interpreter should take care of that. */ - - CHECK_STRING (args[0]); - return emacs_doprnt_string_lisp (0, args[0], 0, nargs - 1, args + 1); -} - - -DEFUN ("char-equal", Fchar_equal, 2, 3, 0, /* -Return t if two characters match, optionally ignoring case. -Both arguments must be characters (i.e. NOT integers). -Case is ignored if `case-fold-search' is non-nil in BUFFER. -If BUFFER is nil, the current buffer is assumed. -*/ - (c1, c2, buffer)) -{ - Emchar x1, x2; - struct buffer *b = decode_buffer (buffer, 1); - - CHECK_CHAR_COERCE_INT (c1); - CHECK_CHAR_COERCE_INT (c2); - x1 = XCHAR (c1); - x2 = XCHAR (c2); - - return (!NILP (b->case_fold_search) - ? DOWNCASE (b, x1) == DOWNCASE (b, x2) - : x1 == x2) - ? Qt : Qnil; -} - -DEFUN ("char=", Fchar_Equal, 2, 3, 0, /* -Return t if two characters match, case is significant. -Both arguments must be characters (i.e. NOT integers). -The optional buffer argument is for symmetry and is ignored. -*/ - (c1, c2, buffer)) -{ - CHECK_CHAR_COERCE_INT (c1); - CHECK_CHAR_COERCE_INT (c2); - - return XCHAR(c1) == XCHAR(c2) ? Qt : Qnil; -} - -#if 0 /* Undebugged FSFmacs code */ -/* Transpose the markers in two regions of the current buffer, and - adjust the ones between them if necessary (i.e.: if the regions - differ in size). - - Traverses the entire marker list of the buffer to do so, adding an - appropriate amount to some, subtracting from some, and leaving the - rest untouched. Most of this is copied from adjust_markers in insdel.c. - - It's the caller's job to see that (start1 <= end1 <= start2 <= end2). */ - -void -transpose_markers (Bufpos start1, Bufpos end1, Bufpos start2, Bufpos end2) -{ - Charcount amt1, amt2, diff; - Lisp_Object marker; - struct buffer *buf = current_buffer; - - /* Update point as if it were a marker. */ - if (BUF_PT (buf) < start1) - ; - else if (BUF_PT (buf) < end1) - BUF_SET_PT (buf, BUF_PT (buf) + (end2 - end1)); - else if (BUF_PT (buf) < start2) - BUF_SET_PT (buf, BUF_PT (buf) + (end2 - start2) - (end1 - start1)); - else if (BUF_PT (buf) < end2) - BUF_SET_PT (buf, BUF_PT (buf) - (start2 - start1)); - - /* We used to adjust the endpoints here to account for the gap, but that - isn't good enough. Even if we assume the caller has tried to move the - gap out of our way, it might still be at start1 exactly, for example; - and that places it `inside' the interval, for our purposes. The amount - of adjustment is nontrivial if there's a `denormalized' marker whose - position is between GPT and GPT + GAP_SIZE, so it's simpler to leave - the dirty work to Fmarker_position, below. */ - - /* The difference between the region's lengths */ - diff = (end2 - start2) - (end1 - start1); - - /* For shifting each marker in a region by the length of the other - * region plus the distance between the regions. - */ - amt1 = (end2 - start2) + (start2 - end1); - amt2 = (end1 - start1) + (start2 - end1); - - for (marker = BUF_MARKERS (buf); !NILP (marker); - marker = XMARKER (marker)->chain) - { - Bufpos mpos = marker_position (marker); - if (mpos >= start1 && mpos < end2) - { - if (mpos < end1) - mpos += amt1; - else if (mpos < start2) - mpos += diff; - else - mpos -= amt2; - set_marker_position (marker, mpos); - } - } -} - -#endif /* 0 */ - -DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /* -Transpose region START1 to END1 with START2 to END2. -The regions may not be overlapping, because the size of the buffer is -never changed in a transposition. - -Optional fifth arg LEAVE_MARKERS, if non-nil, means don't transpose -any markers that happen to be located in the regions. (#### BUG: currently -this function always acts as if LEAVE_MARKERS is non-nil.) - -Transposing beyond buffer boundaries is an error. -*/ - (startr1, endr1, startr2, endr2, leave_markers)) -{ - Bufpos start1, end1, start2, end2; - Charcount len1, len2; - Lisp_Object string1, string2; - struct buffer *buf = current_buffer; - - get_buffer_range_char (buf, startr1, endr1, &start1, &end1, 0); - get_buffer_range_char (buf, startr2, endr2, &start2, &end2, 0); - - len1 = end1 - start1; - len2 = end2 - start2; - - if (start2 < end1) - error ("transposed regions not properly ordered"); - else if (start1 == end1 || start2 == end2) - error ("transposed region may not be of length 0"); - - string1 = make_string_from_buffer (buf, start1, len1); - string2 = make_string_from_buffer (buf, start2, len2); - buffer_delete_range (buf, start2, end2, 0); - buffer_insert_lisp_string_1 (buf, start2, string1, 0); - buffer_delete_range (buf, start1, end1, 0); - buffer_insert_lisp_string_1 (buf, start1, string2, 0); - - /* In FSFmacs there is a whole bunch of really ugly code here - to attempt to transpose the regions without using up any - extra memory. Although the intent may be good, the result - was highly bogus. */ - - return Qnil; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_editfns (void) -{ - defsymbol (&Qpoint, "point"); - defsymbol (&Qmark, "mark"); - defsymbol (&Qregion_beginning, "region-beginning"); - defsymbol (&Qregion_end, "region-end"); - defsymbol (&Qformat, "format"); - defsymbol (&Quser_files_and_directories, "user-files-and-directories"); - - DEFSUBR (Fchar_equal); - DEFSUBR (Fchar_Equal); - DEFSUBR (Fgoto_char); - DEFSUBR (Fstring_to_char); - DEFSUBR (Fchar_to_string); - DEFSUBR (Fbuffer_substring); - DEFSUBR (Fbuffer_substring_no_properties); - - DEFSUBR (Fpoint_marker); - DEFSUBR (Fmark_marker); - DEFSUBR (Fpoint); - DEFSUBR (Fregion_beginning); - DEFSUBR (Fregion_end); - DEFSUBR (Fsave_excursion); - DEFSUBR (Fsave_current_buffer); - - DEFSUBR (Fbuffer_size); - DEFSUBR (Fpoint_max); - DEFSUBR (Fpoint_min); - DEFSUBR (Fpoint_min_marker); - DEFSUBR (Fpoint_max_marker); - - DEFSUBR (Fbobp); - DEFSUBR (Feobp); - DEFSUBR (Fbolp); - DEFSUBR (Feolp); - DEFSUBR (Ffollowing_char); - DEFSUBR (Fpreceding_char); - DEFSUBR (Fchar_after); - DEFSUBR (Fchar_before); - DEFSUBR (Finsert); - DEFSUBR (Finsert_string); - DEFSUBR (Finsert_before_markers); - DEFSUBR (Finsert_char); - - DEFSUBR (Ftemp_directory); - DEFSUBR (Fuser_login_name); - DEFSUBR (Fuser_real_login_name); - DEFSUBR (Fuser_uid); - DEFSUBR (Fuser_real_uid); - DEFSUBR (Fuser_full_name); - DEFSUBR (Fuser_home_directory); - DEFSUBR (Femacs_pid); - DEFSUBR (Fcurrent_time); - DEFSUBR (Fcurrent_process_time); - DEFSUBR (Fformat_time_string); - DEFSUBR (Fdecode_time); - DEFSUBR (Fencode_time); - DEFSUBR (Fcurrent_time_string); - DEFSUBR (Fcurrent_time_zone); - DEFSUBR (Fset_time_zone_rule); - DEFSUBR (Fsystem_name); - DEFSUBR (Fformat); - - DEFSUBR (Finsert_buffer_substring); - DEFSUBR (Fcompare_buffer_substrings); - DEFSUBR (Fsubst_char_in_region); - DEFSUBR (Ftranslate_region); - DEFSUBR (Fdelete_region); - DEFSUBR (Fwiden); - DEFSUBR (Fnarrow_to_region); - DEFSUBR (Fsave_restriction); - DEFSUBR (Ftranspose_regions); - - defsymbol (&Qzmacs_update_region, "zmacs-update-region"); - defsymbol (&Qzmacs_deactivate_region, "zmacs-deactivate-region"); - defsymbol (&Qzmacs_region_buffer, "zmacs-region-buffer"); -} - -void -vars_of_editfns (void) -{ - staticpro (&Vsystem_name); -#if 0 - staticpro (&Vuser_name); - staticpro (&Vuser_real_name); -#endif - DEFVAR_BOOL ("zmacs-regions", &zmacs_regions /* -*Whether LISPM-style active regions should be used. -This means that commands which operate on the region (the area between the -point and the mark) will only work while the region is in the ``active'' -state, which is indicated by highlighting. Executing most commands causes -the region to not be in the active state, so (for example) \\[kill-region] will only -work immediately after activating the region. - -More specifically: - - - Commands which operate on the region only work if the region is active. - - Only a very small set of commands cause the region to become active: - Those commands whose semantics are to mark an area, like mark-defun. - - The region is deactivated after each command that is executed, except that: - - "Motion" commands do not change whether the region is active or not. - -set-mark-command (C-SPC) pushes a mark and activates the region. Moving the -cursor with normal motion commands (C-n, C-p, etc) will cause the region -between point and the recently-pushed mark to be highlighted. It will -remain highlighted until some non-motion command is executed. - -exchange-point-and-mark (\\[exchange-point-and-mark]) activates the region. So if you mark a -region and execute a command that operates on it, you can reactivate the -same region with \\[exchange-point-and-mark] (or perhaps \\[exchange-point-and-mark] \\[exchange-point-and-mark]) to operate on it -again. - -Generally, commands which push marks as a means of navigation (like -beginning-of-buffer and end-of-buffer (M-< and M->)) do not activate the -region. But commands which push marks as a means of marking an area of -text (like mark-defun (\\[mark-defun]), mark-word (\\[mark-word]) or mark-whole-buffer (\\[mark-whole-buffer])) -do activate the region. - -The way the command loop actually works with regard to deactivating the -region is as follows: - -- If the variable `zmacs-region-stays' has been set to t during the command - just executed, the region is left alone (this is how the motion commands - make the region stay around; see the `_' flag in the `interactive' - specification). `zmacs-region-stays' is reset to nil before each command - is executed. -- If the function `zmacs-activate-region' has been called during the command - just executed, the region is left alone. Very few functions should - actually call this function. -- Otherwise, if the region is active, the region is deactivated and - the `zmacs-deactivate-region-hook' is called. -*/ ); - /* Zmacs style active regions are now ON by default */ - zmacs_regions = 1; - - DEFVAR_BOOL ("zmacs-region-active-p", &zmacs_region_active_p /* -Do not alter this. It is for internal use only. -*/ ); - zmacs_region_active_p = 0; - - DEFVAR_BOOL ("zmacs-region-stays", &zmacs_region_stays /* -Whether the current command will deactivate the region. -Commands which do not wish to affect whether the region is currently -highlighted should set this to t. Normally, the region is turned off after -executing each command that did not explicitly turn it on with the function -zmacs-activate-region. Setting this to true lets a command be non-intrusive. -See the variable `zmacs-regions'. - -The same effect can be achieved using the `_' interactive specification. -*/ ); - zmacs_region_stays = 0; - - DEFVAR_BOOL ("atomic-extent-goto-char-p", &atomic_extent_goto_char_p /* -Do not use this -- it will be going away soon. -Indicates if `goto-char' has just been run. This information is allegedly -needed to get the desired behavior for atomic extents and unfortunately -is not available by any other means. -*/ ); - atomic_extent_goto_char_p = 0; -#ifdef AMPERSAND_FULL_NAME - Fprovide(intern("ampersand-full-name")); -#endif - - DEFVAR_LISP ("user-full-name", &Vuser_full_name /* -*The name of the user. -The function `user-full-name', which will return the value of this - variable, when called without arguments. -This is initialized to the value of the NAME environment variable. -*/ ); - /* Initialized at run-time. */ - Vuser_full_name = Qnil; -} diff --git a/src/eldap.c b/src/eldap.c deleted file mode 100644 index 325daa8..0000000 --- a/src/eldap.c +++ /dev/null @@ -1,587 +0,0 @@ -/* LDAP client interface for XEmacs. - Copyright (C) 1998 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. */ - -/* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */ - -/* This file provides lisp primitives for access to an LDAP library - conforming to the API defined in RFC 1823. - It has been tested with: - - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) - - OpenLDAP 1.0.3 (http://www.openldap.org/) - - Netscape's LDAP SDK 1.0 (http://developer.netscape.com/) */ - - -#include -#include "lisp.h" -#include "opaque.h" -#include "sysdep.h" -#include "buffer.h" - -#include - -#include "eldap.h" - -#ifdef HAVE_NS_LDAP -# define HAVE_LDAP_SET_OPTION 1 -# define HAVE_LDAP_GET_ERRNO 1 -#else -# undef HAVE_LDAP_SET_OPTION -# undef HAVE_LDAP_GET_ERRNO -#endif - -static int ldap_default_port; -static Lisp_Object Vldap_default_base; - -/* Needed by the lrecord definition */ -Lisp_Object Qldapp; - -/* ldap-open plist keywords */ -extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, - Qsizelimit; -/* Search scope limits */ -extern Lisp_Object Qbase, Qonelevel, Qsubtree; -/* Authentication methods */ -extern Lisp_Object Qkrbv41, Qkrbv42; -/* Deref policy */ -extern Lisp_Object Qnever, Qalways, Qfind; - -/************************************************************************/ -/* Utility Functions */ -/************************************************************************/ - -static void -signal_ldap_error (LDAP *ld) -{ -#ifdef HAVE_LDAP_GET_ERRNO - signal_simple_error - ("LDAP error", - build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL)))); -#else - signal_simple_error ("LDAP error", - build_string (ldap_err2string (ld->ld_errno))); -#endif -} - - -/************************************************************************/ -/* ldap lrecord basic functions */ -/************************************************************************/ - -static Lisp_Object -make_ldap (struct Lisp_LDAP *ldap) -{ - Lisp_Object lisp_ldap; - XSETLDAP (lisp_ldap, ldap); - return lisp_ldap; -} - -static Lisp_Object -mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - return XLDAP (obj)->host; -} - -static void -print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - char buf[32]; - - struct Lisp_LDAP *ldap = XLDAP (obj); - - if (print_readably) - error ("printing unreadable object #", - XSTRING_DATA (ldap->host)); - - write_c_string ("#host, printcharfun, 1); - if (!ldap->livep) - write_c_string ("(dead) ",printcharfun); - sprintf (buf, " 0x%x>", (unsigned int)ldap); - write_c_string (buf, printcharfun); -} - -static struct Lisp_LDAP * -allocate_ldap (void) -{ - struct Lisp_LDAP *ldap = - alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap); - - ldap->ld = NULL; - ldap->host = Qnil; - ldap->livep = 0; - return ldap; -} - -static void -finalize_ldap (void *header, int for_disksave) -{ - struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header; - - if (for_disksave) - signal_simple_error ("Can't dump an emacs containing LDAP objects", - make_ldap (ldap)); - - if (ldap->livep) - ldap_unbind (ldap->ld); -} - -DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, - mark_ldap, print_ldap, finalize_ldap, - NULL, NULL, struct Lisp_LDAP); - - - - -/************************************************************************/ -/* Basic ldap accessors */ -/************************************************************************/ - -DEFUN ("ldapp", Fldapp, 1, 1, 0, /* -Return t if OBJECT is a LDAP connection. -*/ - (object)) -{ - return LDAPP (object) ? Qt : Qnil; -} - -DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /* -Return the server host of the connection LDAP, as a string. -*/ - (ldap)) -{ - CHECK_LDAP (ldap); - return (XLDAP (ldap))->host; -} - -DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /* -Return t if LDAP is an active LDAP connection. -*/ - (ldap)) -{ - CHECK_LDAP (ldap); - return (XLDAP (ldap))->livep ? Qt : Qnil; -} - -/************************************************************************/ -/* Opening/Closing a LDAP connection */ -/************************************************************************/ - - -DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /* -Open a LDAP connection to HOST. -PLIST is a plist containing additional parameters for the connection. -Valid keys in that list are: - `port' the TCP port to use for the connection if different from -`ldap-default-port'. - `auth' is the authentication method to use, possible values depend on -the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. - `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). - `passwd' is the password to use for simple authentication. - `deref' is one of the symbols `never', `always', `search' or `find'. - `timelimit' is the timeout limit for the connection in seconds. - `sizelimit' is the maximum number of matches to return. -*/ - (host, plist)) -{ - /* This function can GC */ - struct Lisp_LDAP *ldap; - LDAP *ld; - int ldap_port = 0; - int ldap_auth = LDAP_AUTH_SIMPLE; - char *ldap_binddn = NULL; - char *ldap_passwd = NULL; - int ldap_deref = LDAP_DEREF_NEVER; - int ldap_timelimit = 0; - int ldap_sizelimit = 0; - int err; - - Lisp_Object list, keyword, value; - - CHECK_STRING (host); - - EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist) - { - /* TCP Port */ - if (EQ (keyword, Qport)) - { - CHECK_INT (value); - ldap_port = XINT (value); - } - /* Authentication method */ - if (EQ (keyword, Qauth)) - { - if (EQ (value, Qsimple)) - ldap_auth = LDAP_AUTH_SIMPLE; -#ifdef LDAP_AUTH_KRBV41 - else if (EQ (value, Qkrbv41)) - ldap_auth = LDAP_AUTH_KRBV41; -#endif -#ifdef LDAP_AUTH_KRBV42 - else if (EQ (value, Qkrbv42)) - ldap_auth = LDAP_AUTH_KRBV42; -#endif - else - signal_simple_error ("Invalid authentication method", value); - } - /* Bind DN */ - else if (EQ (keyword, Qbinddn)) - { - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn); - } - /* Password */ - else if (EQ (keyword, Qpasswd)) - { - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd); - } - /* Deref */ - else if (EQ (keyword, Qderef)) - { - if (EQ (value, Qnever)) - ldap_deref = LDAP_DEREF_NEVER; - else if (EQ (value, Qsearch)) - ldap_deref = LDAP_DEREF_SEARCHING; - else if (EQ (value, Qfind)) - ldap_deref = LDAP_DEREF_FINDING; - else if (EQ (value, Qalways)) - ldap_deref = LDAP_DEREF_ALWAYS; - else - signal_simple_error ("Invalid deref value", value); - } - /* Timelimit */ - else if (EQ (keyword, Qtimelimit)) - { - CHECK_INT (value); - ldap_timelimit = XINT (value); - } - /* Sizelimit */ - else if (EQ (keyword, Qsizelimit)) - { - CHECK_INT (value); - ldap_sizelimit = XINT (value); - } - } - - if (ldap_port == 0) - { - ldap_port = ldap_default_port; - } - - /* Connect to the server and bind */ - slow_down_interrupts (); - ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port); - speed_up_interrupts (); - - if (ld == NULL ) - signal_simple_error_2 ("Failed connecting to host", - host, - lisp_strerror (errno)); - - -#ifdef HAVE_LDAP_SET_OPTION - if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, - (void *)&ldap_timelimit) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, - (void *)&ldap_sizelimit) != LDAP_SUCCESS) - signal_ldap_error (ld); - if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS) - signal_ldap_error (ld); -#else /* not HAVE_LDAP_SET_OPTION */ - ld->ld_deref = ldap_deref; - ld->ld_timelimit = ldap_timelimit; - ld->ld_sizelimit = ldap_sizelimit; -#ifdef LDAP_REFERRALS - ld->ld_options = LDAP_OPT_REFERRALS; -#else /* not LDAP_REFERRALS */ - ld->ld_options = 0; -#endif /* not LDAP_REFERRALS */ -#endif /* not HAVE_LDAP_SET_OPTION */ - - /* ldap_bind_s calls select and may be wedged by SIGIO. */ - slow_down_interrupts (); - err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth); - speed_up_interrupts (); - if (err != LDAP_SUCCESS) - signal_simple_error ("Failed binding to the server", - build_string (ldap_err2string (err))); - - ldap = allocate_ldap (); - ldap->ld = ld; - ldap->host = host; - ldap->livep = 1; - - return make_ldap (ldap); -} - - - -DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /* -Close an LDAP connection. -*/ - (ldap)) -{ - struct Lisp_LDAP *lldap; - CHECK_LIVE_LDAP (ldap); - lldap = XLDAP (ldap); - ldap_unbind (lldap->ld); - lldap->livep = 0; - return Qnil; -} - - - -/************************************************************************/ -/* Working on a LDAP connection */ -/************************************************************************/ -struct ldap_unwind_struct -{ - LDAPMessage *res; - char **vals; -}; - - -static Lisp_Object -ldap_search_unwind (Lisp_Object unwind_obj) -{ - struct ldap_unwind_struct *unwind = - (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj); - if (unwind->res) - ldap_msgfree (unwind->res); - if (unwind->vals) - ldap_value_free (unwind->vals); - return Qnil; -} - -DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /* -Perform a search on an open LDAP connection. -LDAP is an LDAP connection object created with `ldap-open'. -FILTER is a filter string for the search as described in RFC 1558. -BASE is the distinguished name at which to start the search. -SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating -the scope of the search. -ATTRS is a list of strings indicating which attributes to retrieve - for each matching entry. If nil return all available attributes. -If ATTRSONLY is non-nil then only the attributes are retrieved, not -the associated values. -The function returns a list of matching entries. Each entry is itself -an alist of attribute/values. -*/ - (ldap, filter, base, scope, attrs, attrsonly)) -{ - /* This function can GC */ - - /* Vars for query */ - LDAP *ld; - LDAPMessage *e; - BerElement *ptr; - char *a; - int i, rc; - int matches; - struct ldap_unwind_struct unwind; - - int ldap_scope = LDAP_SCOPE_SUBTREE; - char **ldap_attributes = NULL; - - int speccount = specpdl_depth (); - - Lisp_Object list, entry, result; - struct gcpro gcpro1, gcpro2, gcpro3; - - list = entry = result = Qnil; - GCPRO3 (list, entry, result); - - unwind.res = NULL; - unwind.vals = NULL; - - /* Do all the parameter checking */ - CHECK_LIVE_LDAP (ldap); - ld = XLDAP (ldap)->ld; - - /* Filter */ - CHECK_STRING (filter); - - /* Search base */ - if (NILP (base)) - { - base = Vldap_default_base; - } - if (!NILP (base)) - { - CHECK_STRING (base); - } - - /* Search scope */ - if (!NILP (scope)) - { - if (EQ (scope, Qbase)) - ldap_scope = LDAP_SCOPE_BASE; - else if (EQ (scope, Qonelevel)) - ldap_scope = LDAP_SCOPE_ONELEVEL; - else if (EQ (scope, Qsubtree)) - ldap_scope = LDAP_SCOPE_SUBTREE; - else - signal_simple_error ("Invalid scope", scope); - } - - /* Attributes to search */ - if (!NILP (attrs)) - { - CHECK_CONS (attrs); - ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs))); - - i = 0; - EXTERNAL_LIST_LOOP (attrs, attrs) - { - Lisp_Object current = XCAR (attrs); - CHECK_STRING (current); - GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]); - ++i; - } - ldap_attributes[i] = NULL; - } - - /* Attributes only ? */ - CHECK_SYMBOL (attrsonly); - - /* Perform the search */ - if (ldap_search (ld, - NILP (base) ? "" : (char *) XSTRING_DATA (base), - ldap_scope, - NILP (filter) ? "" : (char *) XSTRING_DATA (filter), - ldap_attributes, - NILP (attrsonly) ? 0 : 1) - == -1) - { - signal_ldap_error (ld); - } - - /* Ensure we don't exit without cleaning up */ - record_unwind_protect (ldap_search_unwind, - make_opaque_ptr (&unwind)); - - /* Build the results list */ - matches = 0; - - /* ldap_result calls select() and can get wedged by EINTR signals */ - slow_down_interrupts (); - rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); - speed_up_interrupts (); - while (rc == LDAP_RES_SEARCH_ENTRY) - { - QUIT; - matches ++; - e = ldap_first_entry (ld, unwind.res); - /* #### This call to message() is pretty fascist, because it - destroys the current echo area contents, even when invoked - from Lisp. It should use echo_area_message() instead, and - restore the old echo area contents later. */ - message ("Parsing ldap results... %d", matches); - entry = Qnil; - for (a= ldap_first_attribute (ld, e, &ptr); - a != NULL; - a= ldap_next_attribute (ld, e, ptr) ) - { - list = Fcons (build_ext_string (a, FORMAT_OS), Qnil); - unwind.vals = ldap_get_values (ld, e, a); - if (unwind.vals != NULL) - { - for (i = 0; unwind.vals[i] != NULL; i++) - { - list = Fcons (build_ext_string (unwind.vals[i], FORMAT_OS), - list); - } - } - entry = Fcons (Fnreverse (list), - entry); - ldap_value_free (unwind.vals); - unwind.vals = NULL; - } - result = Fcons (Fnreverse (entry), - result); - ldap_msgfree (unwind.res); - unwind.res = NULL; - - slow_down_interrupts (); - rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); - speed_up_interrupts (); - } - - if (rc == -1) - { - signal_ldap_error (ld); - } - rc = ldap_result2error (ld, unwind.res, 0); - if ((rc != LDAP_SUCCESS) && - (rc != LDAP_SIZELIMIT_EXCEEDED)) - { - signal_ldap_error (ld); - } - - ldap_msgfree (unwind.res); - unwind.res = (LDAPMessage *)NULL; - /* #### See above for calling message(). */ - message ("Parsing ldap results... done"); - - unbind_to (speccount, Qnil); - UNGCPRO; - return Fnreverse (result); -} - - -void -syms_of_eldap (void) -{ - defsymbol (&Qldapp, "ldapp"); - DEFSUBR (Fldapp); - DEFSUBR (Fldap_host); - DEFSUBR (Fldap_status); - DEFSUBR (Fldap_open); - DEFSUBR (Fldap_close); - DEFSUBR (Fldap_search_internal); -} - -void -vars_of_eldap (void) -{ - - ldap_default_port = LDAP_PORT; - Vldap_default_base = Qnil; - - DEFVAR_INT ("ldap-default-port", &ldap_default_port /* -Default TCP port for LDAP connections. -Initialized from the LDAP library. Default value is 389. -*/ ); - - DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /* -Default base for LDAP searches. -This is a string using the syntax of RFC 1779. -For instance, "o=ACME, c=US" limits the search to the -Acme organization in the United States. -*/ ); - -} - - diff --git a/src/eldap.h b/src/eldap.h deleted file mode 100644 index fb0abbb..0000000 --- a/src/eldap.h +++ /dev/null @@ -1,74 +0,0 @@ -/* Definitions for the LDAP client interface for XEmacs. - Copyright (C) 1998 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. */ - -#ifndef _XEMACS_ELDAP_H_ -#define _XEMACS_ELDAP_H_ - -#include -#include - -/* - * The following structure records pertinent information about a - * LDAP connection. - */ - -struct Lisp_LDAP -{ - /* lcrecord header */ - struct lcrecord_header header; - /* The LDAP connection handle used by the LDAP API */ - LDAP *ld; - /* Name of the host we connected to */ - Lisp_Object host; - /* Status of the LDAP connection. */ - int livep; -}; - - -DECLARE_LRECORD (ldap, struct Lisp_LDAP); -#define XLDAP(x) XRECORD (x, ldap, struct Lisp_LDAP) -#define XSETLDAP(x, p) XSETRECORD (x, p, ldap) -#define LDAPP(x) RECORDP (x, ldap) -#define GC_LDAPP(x) GC_RECORDP (x, ldap) -#define CHECK_LDAP(x) CHECK_RECORD (x, ldap) -#define CONCHECK_LDAP(x) CONCHECK_RECORD (x, ldap) - -#define CHECK_LIVE_LDAP(ldap) do { \ - CHECK_LDAP (ldap); \ - if (!XLDAP (ldap)->livep) \ - signal_simple_error ("Attempting to access closed LDAP connection", \ - ldap); \ -} while (0) - - -Lisp_Object Fldapp (Lisp_Object object); -Lisp_Object Fldap_host (Lisp_Object ldap); -Lisp_Object Fldap_status (Lisp_Object ldap); -Lisp_Object Fldap_open (Lisp_Object host, - Lisp_Object ldap_plist); -Lisp_Object Fldap_close (Lisp_Object ldap); -Lisp_Object Fldap_search_internal (Lisp_Object ldap, - Lisp_Object filter, - Lisp_Object base, - Lisp_Object scope, - Lisp_Object attrs, - Lisp_Object attrsonly); - -#endif /* _XEMACS_ELDAP_H_ */ diff --git a/src/elhash.c b/src/elhash.c deleted file mode 100644 index e956a2f..0000000 --- a/src/elhash.c +++ /dev/null @@ -1,1384 +0,0 @@ -/* Implementation of the hash table lisp object type. - Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 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 MERCNTABILITY or -FITNESS FOR A PARTICULAR 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. */ - -#include -#include "lisp.h" -#include "bytecode.h" -#include "elhash.h" - -Lisp_Object Qhash_tablep, Qhashtable, Qhash_table; -Lisp_Object Qweak, Qkey_weak, Qvalue_weak, Qnon_weak; -static Lisp_Object Vall_weak_hash_tables; -static Lisp_Object Qrehash_size, Qrehash_threshold; -static Lisp_Object Q_size, Q_test, Q_type, Q_rehash_size, Q_rehash_threshold; - -typedef struct hentry -{ - Lisp_Object key; - Lisp_Object value; -} hentry; - -struct Lisp_Hash_Table -{ - struct lcrecord_header header; - size_t size; - size_t count; - size_t rehash_count; - double rehash_size; - double rehash_threshold; - size_t golden; - hash_table_hash_function_t hash_function; - hash_table_test_function_t test_function; - hentry *hentries; - enum hash_table_type type; /* whether and how this hash table is weak */ - Lisp_Object next_weak; /* Used to chain together all of the weak - hash tables. Don't mark through this. */ -}; -typedef struct Lisp_Hash_Table Lisp_Hash_Table; - -#define HENTRY_CLEAR_P(hentry) ((*(EMACS_UINT*)(&((hentry)->key))) == 0) -#define CLEAR_HENTRY(hentry) ((*(EMACS_UINT*)(&((hentry)->key))) = 0) - -#define HASH_TABLE_DEFAULT_SIZE 16 -#define HASH_TABLE_DEFAULT_REHASH_SIZE 1.3 -#define HASH_TABLE_MIN_SIZE 10 - -#define HASH_CODE(key, ht) \ - (((((ht)->hash_function ? (ht)->hash_function (key) : LISP_HASH (key)) \ - * (ht)->golden) \ - % (ht)->size)) - -#define KEYS_EQUAL_P(key1, key2, testfun) \ - (EQ ((key1), (key2)) || ((testfun) && (testfun) ((key1), (key2)))) - -#define LINEAR_PROBING_LOOP(probe, entries, size) \ - for (; \ - !HENTRY_CLEAR_P (probe) || \ - (probe == entries + size ? \ - (probe = entries, !HENTRY_CLEAR_P (probe)) : 0); \ - probe++) - -#ifndef ERROR_CHECK_HASH_TABLE -# ifdef ERROR_CHECK_TYPECHECK -# define ERROR_CHECK_HASH_TABLE 1 -# else -# define ERROR_CHECK_HASH_TABLE 0 -# endif -#endif - -#if ERROR_CHECK_HASH_TABLE -static void -check_hash_table_invariants (Lisp_Hash_Table *ht) -{ - assert (ht->count < ht->size); - assert (ht->count <= ht->rehash_count); - assert (ht->rehash_count < ht->size); - assert ((double) ht->count * ht->rehash_threshold - 1 <= (double) ht->rehash_count); - assert (HENTRY_CLEAR_P (ht->hentries + ht->size)); -} -#else -#define check_hash_table_invariants(ht) -#endif - -/* We use linear probing instead of double hashing, despite its lack - of blessing by Knuth and company, because, as a result of the - increasing discrepancy between CPU speeds and memory speeds, cache - behavior is becoming increasingly important, e.g: - - For a trivial loop, the penalty for non-sequential access of an array is: - - a factor of 3-4 on Pentium Pro 200 Mhz - - a factor of 10 on Ultrasparc 300 Mhz */ - -/* Return a suitable size for a hash table, with at least SIZE slots. */ -static size_t -hash_table_size (size_t requested_size) -{ - /* Return some prime near, but greater than or equal to, SIZE. - Decades from the time of writing, someone will have a system large - enough that the list below will be too short... */ - static CONST size_t primes [] = - { - 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, - 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, - 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, - 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, - 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301, - 10445899, 13579681, 17653589, 22949669, 29834603, 38784989, - 50420551, 65546729, 85210757, 110774011, 144006217, 187208107, - 243370577, 316381771, 411296309, 534685237, 695090819, 903618083, - 1174703521, 1527114613, 1985248999, 2580823717UL, 3355070839UL - }; - /* We've heard of binary search. */ - int low, high; - for (low = 0, high = countof (primes) - 1; high - low > 1;) - { - /* Loop Invariant: size < primes [high] */ - int mid = (low + high) / 2; - if (primes [mid] < requested_size) - low = mid; - else - high = mid; - } - return primes [high]; -} - - -#if 0 /* I don't think these are needed any more. - If using the general lisp_object_equal_*() functions - causes efficiency problems, these can be resurrected. --ben */ -/* equality and hash functions for Lisp strings */ -int -lisp_string_equal (Lisp_Object str1, Lisp_Object str2) -{ - /* This is wrong anyway. You can't use strcmp() on Lisp strings, - because they can contain zero characters. */ - return !strcmp ((char *) XSTRING_DATA (str1), (char *) XSTRING_DATA (str2)); -} - -static hashcode_t -lisp_string_hash (Lisp_Object obj) -{ - return hash_string (XSTRING_DATA (str), XSTRING_LENGTH (str)); -} - -#endif /* 0 */ - -static int -lisp_object_eql_equal (Lisp_Object obj1, Lisp_Object obj2) -{ - return EQ (obj1, obj2) || (FLOATP (obj1) && internal_equal (obj1, obj2, 0)); -} - -static hashcode_t -lisp_object_eql_hash (Lisp_Object obj) -{ - return FLOATP (obj) ? internal_hash (obj, 0) : LISP_HASH (obj); -} - -static int -lisp_object_equal_equal (Lisp_Object obj1, Lisp_Object obj2) -{ - return internal_equal (obj1, obj2, 0); -} - -static hashcode_t -lisp_object_equal_hash (Lisp_Object obj) -{ - return internal_hash (obj, 0); -} - - -static Lisp_Object -mark_hash_table (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - Lisp_Hash_Table *ht = XHASH_TABLE (obj); - - /* If the hash table is weak, we don't want to mark the keys and - values (we scan over them after everything else has been marked, - and mark or remove them as necessary). */ - if (ht->type == HASH_TABLE_NON_WEAK) - { - hentry *e, *sentinel; - - for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - markobj (e->key); - markobj (e->value); - } - } - return Qnil; -} - -/* Equality of hash tables. Two hash tables are equal when they are of - the same type and test function, they have the same number of - elements, and for each key in the hash table, the values are `equal'. - - This is similar to Common Lisp `equalp' of hash tables, with the - difference that CL requires the keys to be compared with the test - function, which we don't do. Doing that would require consing, and - consing is a bad idea in `equal'. Anyway, our method should provide - the same result -- if the keys are not equal according to the test - function, then Fgethash() in hash_table_equal_mapper() will fail. */ -static int -hash_table_equal (Lisp_Object hash_table1, Lisp_Object hash_table2, int depth) -{ - Lisp_Hash_Table *ht1 = XHASH_TABLE (hash_table1); - Lisp_Hash_Table *ht2 = XHASH_TABLE (hash_table2); - hentry *e, *sentinel; - - if ((ht1->test_function != ht2->test_function) || - (ht1->type != ht2->type) || - (ht1->count != ht2->count)) - return 0; - - depth++; - - for (e = ht1->hentries, sentinel = e + ht1->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - /* Look up the key in the other hash table, and compare the values. */ - { - Lisp_Object value_in_other = Fgethash (e->key, hash_table2, Qunbound); - if (UNBOUNDP (value_in_other) || - !internal_equal (e->value, value_in_other, depth)) - return 0; /* Give up */ - } - - return 1; -} - -/* Printing hash tables. - - This is non-trivial, because we use a readable structure-style - syntax for hash tables. This means that a typical hash table will be - readably printed in the form of: - - #s(hash-table size 2 data (key1 value1 key2 value2)) - - The supported keywords are `type' (non-weak (or nil), weak, - key-weak and value-weak), `test' (eql (or nil), eq or equal), - `size' (a natnum or nil) and `data' (a list). - - If `print-readably' is non-nil, then a simpler syntax is used; for - instance: - - # - - The data is truncated to four pairs, and the rest is shown with - `...'. This printer does not cons. */ - - -/* Print the data of the hash table. This maps through a Lisp - hash table and prints key/value pairs using PRINTCHARFUN. */ -static void -print_hash_table_data (Lisp_Hash_Table *ht, Lisp_Object printcharfun) -{ - int count = 0; - hentry *e, *sentinel; - - write_c_string (" data (", printcharfun); - - for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - if (count > 0) - write_c_string (" ", printcharfun); - if (!print_readably && count > 3) - { - write_c_string ("...", printcharfun); - break; - } - print_internal (e->key, printcharfun, 1); - write_c_string (" ", printcharfun); - print_internal (e->value, printcharfun, 1); - count++; - } - - write_c_string (")", printcharfun); -} - -static void -print_hash_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - Lisp_Hash_Table *ht = XHASH_TABLE (obj); - char buf[128]; - - write_c_string (print_readably ? "#s(hash-table" : "#type != HASH_TABLE_NON_WEAK) - { - sprintf (buf, " type %s", - (ht->type == HASH_TABLE_WEAK ? "weak" : - ht->type == HASH_TABLE_KEY_WEAK ? "key-weak" : - ht->type == HASH_TABLE_VALUE_WEAK ? "value-weak" : - "you-d-better-not-see-this")); - write_c_string (buf, printcharfun); - } - - /* These checks have a kludgy look to them, but they are safe. - Due to nature of hashing, you cannot use arbitrary - test functions anyway. */ - if (!ht->test_function) - write_c_string (" test eq", printcharfun); - else if (ht->test_function == lisp_object_equal_equal) - write_c_string (" test equal", printcharfun); - else if (ht->test_function == lisp_object_eql_equal) - DO_NOTHING; - else - abort (); - - if (ht->count || !print_readably) - { - if (print_readably) - sprintf (buf, " size %lu", (unsigned long) ht->count); - else - sprintf (buf, " size %lu/%lu", - (unsigned long) ht->count, - (unsigned long) ht->size); - write_c_string (buf, printcharfun); - } - - if (ht->count) - print_hash_table_data (ht, printcharfun); - - if (print_readably) - write_c_string (")", printcharfun); - else - { - sprintf (buf, " 0x%x>", ht->header.uid); - write_c_string (buf, printcharfun); - } -} - -static void -finalize_hash_table (void *header, int for_disksave) -{ - if (!for_disksave) - { - Lisp_Hash_Table *ht = (Lisp_Hash_Table *) header; - - xfree (ht->hentries); - ht->hentries = 0; - } -} - -DEFINE_LRECORD_IMPLEMENTATION ("hash-table", hash_table, - mark_hash_table, print_hash_table, - finalize_hash_table, - /* #### Implement hash_table_hash()! */ - hash_table_equal, 0, - Lisp_Hash_Table); - -static Lisp_Hash_Table * -xhash_table (Lisp_Object hash_table) -{ - if (!gc_in_progress) - CHECK_HASH_TABLE (hash_table); - check_hash_table_invariants (XHASH_TABLE (hash_table)); - return XHASH_TABLE (hash_table); -} - - -/************************************************************************/ -/* Creation of Hash Tables */ -/************************************************************************/ - -/* Creation of hash tables, without error-checking. */ -static double -hash_table_rehash_threshold (Lisp_Hash_Table *ht) -{ - return - ht->rehash_threshold > 0.0 ? ht->rehash_threshold : - ht->size > 4096 && !ht->test_function ? 0.7 : 0.6; -} - -static void -compute_hash_table_derived_values (Lisp_Hash_Table *ht) -{ - ht->rehash_count = (size_t) - ((double) ht->size * hash_table_rehash_threshold (ht)); - ht->golden = (size_t) - ((double) ht->size * (.6180339887 / (double) sizeof (Lisp_Object))); -} - -Lisp_Object -make_general_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test, - double rehash_size, - double rehash_threshold) -{ - Lisp_Object hash_table; - Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); - - ht->type = type; - ht->rehash_size = rehash_size; - ht->rehash_threshold = rehash_threshold; - - switch (test) - { - case HASH_TABLE_EQ: - ht->test_function = 0; - ht->hash_function = 0; - break; - - case HASH_TABLE_EQL: - ht->test_function = lisp_object_eql_equal; - ht->hash_function = lisp_object_eql_hash; - break; - - case HASH_TABLE_EQUAL: - ht->test_function = lisp_object_equal_equal; - ht->hash_function = lisp_object_equal_hash; - break; - - default: - abort (); - } - - if (ht->rehash_size <= 0.0) - ht->rehash_size = HASH_TABLE_DEFAULT_REHASH_SIZE; - if (size < HASH_TABLE_MIN_SIZE) - size = HASH_TABLE_MIN_SIZE; - if (rehash_threshold < 0.0) - rehash_threshold = 0.75; - ht->size = - hash_table_size ((size_t) ((double) size / hash_table_rehash_threshold (ht)) + 1); - ht->count = 0; - compute_hash_table_derived_values (ht); - - /* We leave room for one never-occupied sentinel hentry at the end. */ - ht->hentries = xnew_array (hentry, ht->size + 1); - - { - hentry *e, *sentinel; - for (e = ht->hentries, sentinel = e + ht->size; e <= sentinel; e++) - CLEAR_HENTRY (e); - } - - XSETHASH_TABLE (hash_table, ht); - - if (type == HASH_TABLE_NON_WEAK) - ht->next_weak = Qunbound; - else - ht->next_weak = Vall_weak_hash_tables, Vall_weak_hash_tables = hash_table; - - return hash_table; -} - -Lisp_Object -make_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test) -{ - return make_general_lisp_hash_table (size, type, test, - HASH_TABLE_DEFAULT_REHASH_SIZE, -1.0); -} - -/* Pretty reading of hash tables. - - Here we use the existing structures mechanism (which is, - unfortunately, pretty cumbersome) for validating and instantiating - the hash tables. The idea is that the side-effect of reading a - #s(hash-table PLIST) object is creation of a hash table with desired - properties, and that the hash table is returned. */ - -/* Validation functions: each keyword provides its own validation - function. The errors should maybe be continuable, but it is - unclear how this would cope with ERRB. */ -static int -hash_table_size_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (NATNUMP (value)) - return 1; - - maybe_signal_error (Qwrong_type_argument, list2 (Qnatnump, value), - Qhash_table, errb); - return 0; -} - -static size_t -decode_hash_table_size (Lisp_Object obj) -{ - return NILP (obj) ? HASH_TABLE_DEFAULT_SIZE : XINT (obj); -} - -static int -hash_table_type_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (EQ (value, Qnil)) return 1; - if (EQ (value, Qnon_weak)) return 1; - if (EQ (value, Qweak)) return 1; - if (EQ (value, Qkey_weak)) return 1; - if (EQ (value, Qvalue_weak)) return 1; - - maybe_signal_simple_error ("Invalid hash table type", - value, Qhash_table, errb); - return 0; -} - -static enum hash_table_type -decode_hash_table_type (Lisp_Object obj) -{ - if (EQ (obj, Qnil)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qnon_weak)) return HASH_TABLE_NON_WEAK; - if (EQ (obj, Qweak)) return HASH_TABLE_WEAK; - if (EQ (obj, Qkey_weak)) return HASH_TABLE_KEY_WEAK; - if (EQ (obj, Qvalue_weak)) return HASH_TABLE_VALUE_WEAK; - - signal_simple_error ("Invalid hash table type", obj); - return HASH_TABLE_NON_WEAK; /* not reached */ -} - -static int -hash_table_test_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (EQ (value, Qnil)) return 1; - if (EQ (value, Qeq)) return 1; - if (EQ (value, Qequal)) return 1; - if (EQ (value, Qeql)) return 1; - - maybe_signal_simple_error ("Invalid hash table test", - value, Qhash_table, errb); - return 0; -} - -static enum hash_table_test -decode_hash_table_test (Lisp_Object obj) -{ - if (EQ (obj, Qnil)) return HASH_TABLE_EQL; - if (EQ (obj, Qeq)) return HASH_TABLE_EQ; - if (EQ (obj, Qequal)) return HASH_TABLE_EQUAL; - if (EQ (obj, Qeql)) return HASH_TABLE_EQL; - - signal_simple_error ("Invalid hash table test", obj); - return HASH_TABLE_EQ; /* not reached */ -} - -static int -hash_table_rehash_size_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (!FLOATP (value)) - { - maybe_signal_error (Qwrong_type_argument, list2 (Qfloatp, value), - Qhash_table, errb); - return 0; - } - - { - double rehash_size = XFLOAT_DATA (value); - if (rehash_size <= 1.0) - { - maybe_signal_simple_error - ("Hash table rehash size must be greater than 1.0", - value, Qhash_table, errb); - return 0; - } - } - - return 1; -} - -static double -decode_hash_table_rehash_size (Lisp_Object rehash_size) -{ - return NILP (rehash_size) ? -1.0 : XFLOAT_DATA (rehash_size); -} - -static int -hash_table_rehash_threshold_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (!FLOATP (value)) - { - maybe_signal_error (Qwrong_type_argument, list2 (Qfloatp, value), - Qhash_table, errb); - return 0; - } - - { - double rehash_threshold = XFLOAT_DATA (value); - if (rehash_threshold <= 0.0 || rehash_threshold >= 1.0) - { - maybe_signal_simple_error - ("Hash table rehash threshold must be between 0.0 and 1.0", - value, Qhash_table, errb); - return 0; - } - } - - return 1; -} - -static double -decode_hash_table_rehash_threshold (Lisp_Object rehash_threshold) -{ - return NILP (rehash_threshold) ? -1.0 : XFLOAT_DATA (rehash_threshold); -} - -static int -hash_table_data_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - int len; - - GET_EXTERNAL_LIST_LENGTH (value, len); - - if (len & 1) - { - maybe_signal_simple_error - ("Hash table data must have alternating key/value pairs", - value, Qhash_table, errb); - return 0; - } - return 1; -} - -/* The actual instantiation of a hash table. This does practically no - error checking, because it relies on the fact that the paranoid - functions above have error-checked everything to the last details. - If this assumption is wrong, we will get a crash immediately (with - error-checking compiled in), and we'll know if there is a bug in - the structure mechanism. So there. */ -static Lisp_Object -hash_table_instantiate (Lisp_Object plist) -{ - Lisp_Object hash_table; - Lisp_Object test = Qnil; - Lisp_Object type = Qnil; - Lisp_Object size = Qnil; - Lisp_Object data = Qnil; - Lisp_Object rehash_size = Qnil; - Lisp_Object rehash_threshold = Qnil; - - while (!NILP (plist)) - { - Lisp_Object key, value; - key = XCAR (plist); plist = XCDR (plist); - value = XCAR (plist); plist = XCDR (plist); - - if (EQ (key, Qtest)) test = value; - else if (EQ (key, Qtype)) type = value; - else if (EQ (key, Qsize)) size = value; - else if (EQ (key, Qdata)) data = value; - else if (EQ (key, Qrehash_size)) rehash_size = value; - else if (EQ (key, Qrehash_threshold)) rehash_threshold = value; - else - abort (); - } - - /* Create the hash table. */ - hash_table = make_general_lisp_hash_table - (decode_hash_table_size (size), - decode_hash_table_type (type), - decode_hash_table_test (test), - decode_hash_table_rehash_size (rehash_size), - decode_hash_table_rehash_threshold (rehash_threshold)); - - /* I'm not sure whether this can GC, but better safe than sorry. */ - { - struct gcpro gcpro1; - GCPRO1 (hash_table); - - /* And fill it with data. */ - while (!NILP (data)) - { - Lisp_Object key, value; - key = XCAR (data); data = XCDR (data); - value = XCAR (data); data = XCDR (data); - Fputhash (key, value, hash_table); - } - UNGCPRO; - } - - return hash_table; -} - -static void -structure_type_create_hash_table_structure_name (Lisp_Object structure_name) -{ - struct structure_type *st; - - st = define_structure_type (structure_name, 0, hash_table_instantiate); - define_structure_type_keyword (st, Qsize, hash_table_size_validate); - define_structure_type_keyword (st, Qtest, hash_table_test_validate); - define_structure_type_keyword (st, Qtype, hash_table_type_validate); - define_structure_type_keyword (st, Qdata, hash_table_data_validate); - define_structure_type_keyword (st, Qrehash_size, hash_table_rehash_size_validate); - define_structure_type_keyword (st, Qrehash_threshold, hash_table_rehash_threshold_validate); -} - -/* Create a built-in Lisp structure type named `hash-table'. - We make #s(hashtable ...) equivalent to #s(hash-table ...), - for backward comptabibility. - This is called from emacs.c. */ -void -structure_type_create_hash_table (void) -{ - structure_type_create_hash_table_structure_name (Qhash_table); - structure_type_create_hash_table_structure_name (Qhashtable); /* compat */ -} - - -/************************************************************************/ -/* Definition of Lisp-visible methods */ -/************************************************************************/ - -DEFUN ("hash-table-p", Fhash_table_p, 1, 1, 0, /* -Return t if OBJECT is a hash table, else nil. -*/ - (object)) -{ - return HASH_TABLEP (object) ? Qt : Qnil; -} - -DEFUN ("make-hash-table", Fmake_hash_table, 0, MANY, 0, /* -Return a new empty hash table object. -Use Common Lisp style keywords to specify hash table properties. - (make-hash-table &key :size :test :type :rehash-size :rehash-threshold) - -Keyword :size specifies the number of keys likely to be inserted. -This number of entries can be inserted without enlarging the hash table. - -Keyword :test can be `eq', `eql' (default) or `equal'. -Comparison between keys is done using this function. -If speed is important, consider using `eq'. -When storing strings in the hash table, you will likely need to use `equal'. - -Keyword :type can be `non-weak' (default), `weak', `key-weak' or `value-weak'. - -A weak hash table is one whose pointers do not count as GC referents: -for any key-value pair in the hash table, if the only remaining pointer -to either the key or the value is in a weak hash table, then the pair -will be removed from the hash table, and the key and value collected. -A non-weak hash table (or any other pointer) would prevent the object -from being collected. - -A key-weak hash table is similar to a fully-weak hash table except that -a key-value pair will be removed only if the key remains unmarked -outside of weak hash tables. The pair will remain in the hash table if -the key is pointed to by something other than a weak hash table, even -if the value is not. - -A value-weak hash table is similar to a fully-weak hash table except -that a key-value pair will be removed only if the value remains -unmarked outside of weak hash tables. The pair will remain in the -hash table if the value is pointed to by something other than a weak -hash table, even if the key is not. - -Keyword :rehash-size must be a float greater than 1.0, and specifies -the factor by which to increase the size of the hash table when enlarging. - -Keyword :rehash-threshold must be a float between 0.0 and 1.0, -and specifies the load factor of the hash table which triggers enlarging. - -*/ - (int nargs, Lisp_Object *args)) -{ - int j = 0; - Lisp_Object size = Qnil; - Lisp_Object type = Qnil; - Lisp_Object test = Qnil; - Lisp_Object rehash_size = Qnil; - Lisp_Object rehash_threshold = Qnil; - - while (j < nargs) - { - Lisp_Object keyword, value; - - keyword = args[j++]; - if (!KEYWORDP (keyword)) - signal_simple_error ("Invalid hash table property keyword", keyword); - if (j == nargs) - signal_simple_error ("Hash table property requires a value", keyword); - - value = args[j++]; - - if (EQ (keyword, Q_size)) size = value; - else if (EQ (keyword, Q_type)) type = value; - else if (EQ (keyword, Q_test)) test = value; - else if (EQ (keyword, Q_rehash_size)) rehash_size = value; - else if (EQ (keyword, Q_rehash_threshold)) rehash_threshold = value; - else signal_simple_error ("Invalid hash table property keyword", keyword); - } - -#define VALIDATE_VAR(var) \ -if (!NILP (var)) hash_table_##var##_validate (Q##var, var, ERROR_ME); - - VALIDATE_VAR (size); - VALIDATE_VAR (type); - VALIDATE_VAR (test); - VALIDATE_VAR (rehash_size); - VALIDATE_VAR (rehash_threshold); - - return make_general_lisp_hash_table - (decode_hash_table_size (size), - decode_hash_table_type (type), - decode_hash_table_test (test), - decode_hash_table_rehash_size (rehash_size), - decode_hash_table_rehash_threshold (rehash_threshold)); -} - -DEFUN ("copy-hash-table", Fcopy_hash_table, 1, 1, 0, /* -Return a new hash table containing the same keys and values as HASH-TABLE. -The keys and values will not themselves be copied. -*/ - (hash_table)) -{ - CONST Lisp_Hash_Table *ht_old = xhash_table (hash_table); - Lisp_Hash_Table *ht = alloc_lcrecord_type (Lisp_Hash_Table, lrecord_hash_table); - - copy_lcrecord (ht, ht_old); - - ht->hentries = xnew_array (hentry, ht_old->size + 1); - memcpy (ht->hentries, ht_old->hentries, (ht_old->size + 1) * sizeof (hentry)); - - XSETHASH_TABLE (hash_table, ht); - - if (! EQ (ht->next_weak, Qunbound)) - { - ht->next_weak = Vall_weak_hash_tables; - Vall_weak_hash_tables = hash_table; - } - - return hash_table; -} - -static void -enlarge_hash_table (Lisp_Hash_Table *ht) -{ - hentry *old_entries, *new_entries, *old_sentinel, *new_sentinel, *e; - size_t old_size, new_size; - - old_size = ht->size; - new_size = ht->size = - hash_table_size ((size_t) ((double) old_size * ht->rehash_size)); - - old_entries = ht->hentries; - - ht->hentries = xnew_array (hentry, new_size + 1); - new_entries = ht->hentries; - - old_sentinel = old_entries + old_size; - new_sentinel = new_entries + new_size; - - for (e = new_entries; e <= new_sentinel; e++) - CLEAR_HENTRY (e); - - compute_hash_table_derived_values (ht); - - for (e = old_entries; e < old_sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - hentry *probe = new_entries + HASH_CODE (e->key, ht); - LINEAR_PROBING_LOOP (probe, new_entries, new_size) - ; - *probe = *e; - } - - xfree (old_entries); -} - -static hentry * -find_hentry (Lisp_Object key, CONST Lisp_Hash_Table *ht) -{ - hash_table_test_function_t test_function = ht->test_function; - hentry *entries = ht->hentries; - hentry *probe = entries + HASH_CODE (key, ht); - - LINEAR_PROBING_LOOP (probe, entries, ht->size) - if (KEYS_EQUAL_P (probe->key, key, test_function)) - break; - - return probe; -} - -DEFUN ("gethash", Fgethash, 2, 3, 0, /* -Find hash value for KEY in HASH-TABLE. -If there is no corresponding value, return DEFAULT (which defaults to nil). -*/ - (key, hash_table, default_)) -{ - CONST Lisp_Hash_Table *ht = xhash_table (hash_table); - hentry *e = find_hentry (key, ht); - - return HENTRY_CLEAR_P (e) ? default_ : e->value; -} - -DEFUN ("puthash", Fputhash, 3, 3, 0, /* -Hash KEY to VALUE in HASH-TABLE. -*/ - (key, value, hash_table)) -{ - Lisp_Hash_Table *ht = xhash_table (hash_table); - hentry *e = find_hentry (key, ht); - - if (!HENTRY_CLEAR_P (e)) - return e->value = value; - - e->key = key; - e->value = value; - - if (++ht->count >= ht->rehash_count) - enlarge_hash_table (ht); - - return value; -} - -/* Remove hentry pointed at by PROBE. - Subsequent entries are removed and reinserted. - We don't use tombstones - too wasteful. */ -static void -remhash_1 (Lisp_Hash_Table *ht, hentry *entries, hentry *probe) -{ - size_t size = ht->size; - CLEAR_HENTRY (probe++); - ht->count--; - - LINEAR_PROBING_LOOP (probe, entries, size) - { - Lisp_Object key = probe->key; - hentry *probe2 = entries + HASH_CODE (key, ht); - LINEAR_PROBING_LOOP (probe2, entries, size) - if (EQ (probe2->key, key)) - /* hentry at probe doesn't need to move. */ - goto continue_outer_loop; - /* Move hentry from probe to new home at probe2. */ - *probe2 = *probe; - CLEAR_HENTRY (probe); - continue_outer_loop: continue; - } -} - -DEFUN ("remhash", Fremhash, 2, 2, 0, /* -Remove the entry for KEY from HASH-TABLE. -Do nothing if there is no entry for KEY in HASH-TABLE. -*/ - (key, hash_table)) -{ - Lisp_Hash_Table *ht = xhash_table (hash_table); - hentry *e = find_hentry (key, ht); - - if (HENTRY_CLEAR_P (e)) - return Qnil; - - remhash_1 (ht, ht->hentries, e); - return Qt; -} - -DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* -Remove all entries from HASH-TABLE, leaving it empty. -*/ - (hash_table)) -{ - Lisp_Hash_Table *ht = xhash_table (hash_table); - hentry *e, *sentinel; - - for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - CLEAR_HENTRY (e); - ht->count = 0; - - return hash_table; -} - -/************************************************************************/ -/* Accessor Functions */ -/************************************************************************/ - -DEFUN ("hash-table-count", Fhash_table_count, 1, 1, 0, /* -Return the number of entries in HASH-TABLE. -*/ - (hash_table)) -{ - return make_int (xhash_table (hash_table)->count); -} - -DEFUN ("hash-table-size", Fhash_table_size, 1, 1, 0, /* -Return the size of HASH-TABLE. -This is the current number of slots in HASH-TABLE, whether occupied or not. -*/ - (hash_table)) -{ - return make_int (xhash_table (hash_table)->size); -} - -DEFUN ("hash-table-type", Fhash_table_type, 1, 1, 0, /* -Return the type of HASH-TABLE. -This can be one of `non-weak', `weak', `key-weak' or `value-weak'. -*/ - (hash_table)) -{ - switch (xhash_table (hash_table)->type) - { - case HASH_TABLE_WEAK: return Qweak; - case HASH_TABLE_KEY_WEAK: return Qkey_weak; - case HASH_TABLE_VALUE_WEAK: return Qvalue_weak; - default: return Qnon_weak; - } -} - -DEFUN ("hash-table-test", Fhash_table_test, 1, 1, 0, /* -Return the test function of HASH-TABLE. -This can be one of `eq', `eql' or `equal'. -*/ - (hash_table)) -{ - hash_table_test_function_t fun = xhash_table (hash_table)->test_function; - - return (fun == lisp_object_eql_equal ? Qeql : - fun == lisp_object_equal_equal ? Qequal : - Qeq); -} - -DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, 1, 1, 0, /* -Return the current rehash size of HASH-TABLE. -This is a float greater than 1.0; the factor by which HASH-TABLE -is enlarged when the rehash threshold is exceeded. -*/ - (hash_table)) -{ - return make_float (xhash_table (hash_table)->rehash_size); -} - -DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, 1, 1, 0, /* -Return the current rehash threshold of HASH-TABLE. -This is a float between 0.0 and 1.0; the maximum `load factor' of HASH-TABLE, -beyond which the HASH-TABLE is enlarged by rehashing. -*/ - (hash_table)) -{ - return make_float (hash_table_rehash_threshold (xhash_table (hash_table))); -} - -/************************************************************************/ -/* Mapping Functions */ -/************************************************************************/ -DEFUN ("maphash", Fmaphash, 2, 2, 0, /* -Map FUNCTION over entries in HASH-TABLE, calling it with two args, -each key and value in HASH-TABLE. - -FUNCTION may not modify HASH-TABLE, with the one exception that FUNCTION -may remhash or puthash the entry currently being processed by FUNCTION. -*/ - (function, hash_table)) -{ - CONST Lisp_Hash_Table *ht = xhash_table (hash_table); - CONST hentry *e, *sentinel; - - for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - Lisp_Object args[3], key; - again: - key = e->key; - args[0] = function; - args[1] = key; - args[2] = e->value; - Ffuncall (countof (args), args); - /* Has FUNCTION done a remhash? */ - if (!EQ (key, e->key) && !HENTRY_CLEAR_P (e)) - goto again; - } - - return Qnil; -} - -/* Map *C* function FUNCTION over the elements of a lisp hash table. */ -void -elisp_maphash (maphash_function_t function, - Lisp_Object hash_table, void *extra_arg) -{ - CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - CONST hentry *e, *sentinel; - - for (e = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - Lisp_Object key; - again: - key = e->key; - if (function (key, e->value, extra_arg)) - return; - /* Has FUNCTION done a remhash? */ - if (!EQ (key, e->key) && !HENTRY_CLEAR_P (e)) - goto again; - } -} - -/* Remove all elements of a lisp hash table satisfying *C* predicate PREDICATE. */ -void -elisp_map_remhash (maphash_function_t predicate, - Lisp_Object hash_table, void *extra_arg) -{ - Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - hentry *e, *entries, *sentinel; - - for (e = entries = ht->hentries, sentinel = e + ht->size; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - again: - if (predicate (e->key, e->value, extra_arg)) - { - remhash_1 (ht, entries, e); - if (!HENTRY_CLEAR_P (e)) - goto again; - } - } -} - - -/************************************************************************/ -/* garbage collecting weak hash tables */ -/************************************************************************/ - -/* Complete the marking for semi-weak hash tables. */ -int -finish_marking_weak_hash_tables (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)) -{ - Lisp_Object hash_table; - int did_mark = 0; - - for (hash_table = Vall_weak_hash_tables; - !GC_NILP (hash_table); - hash_table = XHASH_TABLE (hash_table)->next_weak) - { - CONST Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - CONST hentry *e = ht->hentries; - CONST hentry *sentinel = e + ht->size; - - if (! obj_marked_p (hash_table)) - /* The hash table is probably garbage. Ignore it. */ - continue; - - /* Now, scan over all the pairs. For all pairs that are - half-marked, we may need to mark the other half if we're - keeping this pair. */ -#define MARK_OBJ(obj) \ -do { if (!obj_marked_p (obj)) markobj (obj), did_mark = 1; } while (0) - - switch (ht->type) - { - case HASH_TABLE_KEY_WEAK: - for (; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - if (obj_marked_p (e->key)) - MARK_OBJ (e->value); - break; - - case HASH_TABLE_VALUE_WEAK: - for (; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - if (obj_marked_p (e->value)) - MARK_OBJ (e->key); - break; - - case HASH_TABLE_KEY_CAR_WEAK: - for (; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - if (!CONSP (e->key) || obj_marked_p (XCAR (e->key))) - { - MARK_OBJ (e->key); - MARK_OBJ (e->value); - } - break; - - case HASH_TABLE_VALUE_CAR_WEAK: - for (; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - if (!CONSP (e->value) || obj_marked_p (XCAR (e->value))) - { - MARK_OBJ (e->key); - MARK_OBJ (e->value); - } - break; - - default: - break; - } - } - - return did_mark; -} - -void -prune_weak_hash_tables (int (*obj_marked_p) (Lisp_Object)) -{ - Lisp_Object hash_table, prev = Qnil; - for (hash_table = Vall_weak_hash_tables; - !GC_NILP (hash_table); - hash_table = XHASH_TABLE (hash_table)->next_weak) - { - if (! obj_marked_p (hash_table)) - { - /* This hash table itself is garbage. Remove it from the list. */ - if (GC_NILP (prev)) - Vall_weak_hash_tables = XHASH_TABLE (hash_table)->next_weak; - else - XHASH_TABLE (prev)->next_weak = XHASH_TABLE (hash_table)->next_weak; - } - else - { - /* Now, scan over all the pairs. Remove all of the pairs - in which the key or value, or both, is unmarked - (depending on the type of weak hash table). */ - Lisp_Hash_Table *ht = XHASH_TABLE (hash_table); - hentry *entries = ht->hentries; - hentry *sentinel = entries + ht->size; - hentry *e; - - for (e = entries; e < sentinel; e++) - if (!HENTRY_CLEAR_P (e)) - { - again: - if (!obj_marked_p (e->key) || !obj_marked_p (e->value)) - { - remhash_1 (ht, entries, e); - if (!HENTRY_CLEAR_P (e)) - goto again; - } - } - - prev = hash_table; - } - } -} - -/* Return a hash value for an array of Lisp_Objects of size SIZE. */ - -hashcode_t -internal_array_hash (Lisp_Object *arr, int size, int depth) -{ - int i; - unsigned long hash = 0; - - if (size <= 5) - { - for (i = 0; i < size; i++) - hash = HASH2 (hash, internal_hash (arr[i], depth + 1)); - return hash; - } - - /* just pick five elements scattered throughout the array. - A slightly better approach would be to offset by some - noise factor from the points chosen below. */ - for (i = 0; i < 5; i++) - hash = HASH2 (hash, internal_hash (arr[i*size/5], depth + 1)); - - return hash; -} - -/* Return a hash value for a Lisp_Object. This is for use when hashing - objects with the comparison being `equal' (for `eq', you can just - use the Lisp_Object itself as the hash value). You need to make a - tradeoff between the speed of the hash function and how good the - hashing is. In particular, the hash function needs to be FAST, - so you can't just traipse down the whole tree hashing everything - together. Most of the time, objects will differ in the first - few elements you hash. Thus, we only go to a short depth (5) - and only hash at most 5 elements out of a vector. Theoretically - we could still take 5^5 time (a big big number) to compute a - hash, but practically this won't ever happen. */ - -hashcode_t -internal_hash (Lisp_Object obj, int depth) -{ - if (depth > 5) - return 0; - if (CONSP (obj)) - { - /* no point in worrying about tail recursion, since we're not - going very deep */ - return HASH2 (internal_hash (XCAR (obj), depth + 1), - internal_hash (XCDR (obj), depth + 1)); - } - if (STRINGP (obj)) - { - return hash_string (XSTRING_DATA (obj), XSTRING_LENGTH (obj)); - } - if (VECTORP (obj)) - { - return HASH2 (XVECTOR_LENGTH (obj), - internal_array_hash (XVECTOR_DATA (obj), - XVECTOR_LENGTH (obj), - depth + 1)); - } - if (LRECORDP (obj)) - { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (obj); - if (imp->hash) - return imp->hash (obj, depth); - } - - return LISP_HASH (obj); -} - -#if 0 -xxDEFUN ("internal-hash-value", Finternal_hash_value, 1, 1, 0, /* -Hash value of OBJECT. For debugging. -The value is returned as (HIGH . LOW). -*/ - (object)) -{ - /* This function is pretty 32bit-centric. */ - unsigned long hash = internal_hash (object, 0); - return Fcons (hash >> 16, hash & 0xffff); -} -#endif - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_elhash (void) -{ - DEFSUBR (Fhash_table_p); - DEFSUBR (Fmake_hash_table); - DEFSUBR (Fcopy_hash_table); - DEFSUBR (Fgethash); - DEFSUBR (Fremhash); - DEFSUBR (Fputhash); - DEFSUBR (Fclrhash); - DEFSUBR (Fmaphash); - DEFSUBR (Fhash_table_count); - DEFSUBR (Fhash_table_size); - DEFSUBR (Fhash_table_rehash_size); - DEFSUBR (Fhash_table_rehash_threshold); - DEFSUBR (Fhash_table_type); - DEFSUBR (Fhash_table_test); -#if 0 - DEFSUBR (Finternal_hash_value); -#endif - - defsymbol (&Qhash_tablep, "hash-table-p"); - defsymbol (&Qhash_table, "hash-table"); - defsymbol (&Qhashtable, "hashtable"); - defsymbol (&Qweak, "weak"); - defsymbol (&Qkey_weak, "key-weak"); - defsymbol (&Qvalue_weak, "value-weak"); - defsymbol (&Qnon_weak, "non-weak"); - defsymbol (&Qrehash_size, "rehash-size"); - defsymbol (&Qrehash_threshold, "rehash-threshold"); - - defkeyword (&Q_size, ":size"); - defkeyword (&Q_test, ":test"); - defkeyword (&Q_type, ":type"); - defkeyword (&Q_rehash_size, ":rehash-size"); - defkeyword (&Q_rehash_threshold, ":rehash-threshold"); -} - -void -vars_of_elhash (void) -{ - /* This must NOT be staticpro'd */ - Vall_weak_hash_tables = Qnil; -} diff --git a/src/elhash.h b/src/elhash.h deleted file mode 100644 index 982a729..0000000 --- a/src/elhash.h +++ /dev/null @@ -1,86 +0,0 @@ -/* Lisp interface to hash tables -- include file. - Copyright (C) 1995, 1996 Ben Wing. - -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. */ - -#ifndef _XEMACS_ELHASH_H_ -#define _XEMACS_ELHASH_H_ - -DECLARE_LRECORD (hash_table, struct Lisp_Hash_Table); - -#define XHASH_TABLE(x) XRECORD (x, hash_table, struct Lisp_Hash_Table) -#define XSETHASH_TABLE(x, p) XSETRECORD (x, p, hash_table) -#define HASH_TABLEP(x) RECORDP (x, hash_table) -#define GC_HASH_TABLEP(x) GC_RECORDP (x, hash_table) -#define CHECK_HASH_TABLE(x) CHECK_RECORD (x, hash_table) -#define CONCHECK_HASH_TABLE(x) CONCHECK_RECORD (x, hash_table) - -enum hash_table_type -{ - HASH_TABLE_NON_WEAK, - HASH_TABLE_KEY_WEAK, - HASH_TABLE_VALUE_WEAK, - HASH_TABLE_KEY_CAR_WEAK, - HASH_TABLE_VALUE_CAR_WEAK, - HASH_TABLE_WEAK -}; - -enum hash_table_test -{ - HASH_TABLE_EQ, - HASH_TABLE_EQL, - HASH_TABLE_EQUAL -}; - -EXFUN (Fcopy_hash_table, 1); -EXFUN (Fhash_table_count, 1); -EXFUN (Fgethash, 3); -EXFUN (Fputhash, 3); -EXFUN (Fremhash, 2); -EXFUN (Fclrhash, 1); - -typedef unsigned long hashcode_t; -typedef int (*hash_table_test_function_t) (Lisp_Object obj1, Lisp_Object obj2); -typedef unsigned long (*hash_table_hash_function_t) (Lisp_Object obj); -typedef int (*maphash_function_t) (Lisp_Object key, Lisp_Object value, - void* extra_arg); - - -Lisp_Object make_general_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test, - double rehash_threshold, - double rehash_size); - -Lisp_Object make_lisp_hash_table (size_t size, - enum hash_table_type type, - enum hash_table_test test); - -void elisp_maphash (maphash_function_t function, - Lisp_Object hash_table, void *extra_arg); - -void elisp_map_remhash (maphash_function_t predicate, - Lisp_Object hash_table, void *extra_arg); - -int finish_marking_weak_hash_tables (int (*obj_marked_p) (Lisp_Object), - void (*markobj) (Lisp_Object)); -void prune_weak_hash_tables (int (*obj_marked_p) (Lisp_Object)); - -#endif /* _XEMACS_ELHASH_H_ */ diff --git a/src/emacs.c b/src/emacs.c deleted file mode 100644 index d648161..0000000 --- a/src/emacs.c +++ /dev/null @@ -1,3138 +0,0 @@ -/* XEmacs -- Fully extensible Emacs, running on Unix and other platforms. - Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994 - Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: Mule 2.0, FSF 19.28. */ - -/* Note: It is necessary to specify and not "config.h" in - order for the --srcdir type of compilation to work properly. - Otherwise the config.h from the srcdir, rather than the one from - the build dir, will be used. */ - -#include -#include "lisp.h" - -#include "backtrace.h" /* run-emacs-from-temacs needs this */ -#include "buffer.h" -#include "commands.h" -#include "console.h" -#include "process.h" -#include "redisplay.h" -#include "sysdep.h" - -#include "syssignal.h" /* Always include before systty.h */ -#include "systty.h" -#include "sysfile.h" -#include "systime.h" - -#ifdef QUANTIFY -#include -#endif - -#ifdef HAVE_SHLIB -#include "sysdll.h" -#endif - -#if defined (HAVE_LOCALE_H) && \ - (defined (I18N2) || defined (I18N3) || defined (I18N4)) -#include -#endif - -#ifdef TOOLTALK -#include TT_C_H_PATH -#endif - -#ifdef APOLLO -#ifndef APOLLO_SR10 -#include -#endif -#endif - -#if defined (WINDOWSNT) -#include -#endif - -/* For PATH_EXEC */ -#include - -#if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC -extern void *(*__malloc_hook)(size_t); -extern void *(*__realloc_hook)(void *, size_t); -extern void (*__free_hook)(void *); -#endif /* not SYSTEM_MALLOC && not DOUG_LEA_MALLOC */ - -/* Command line args from shell, as list of strings */ -Lisp_Object Vcommand_line_args; - -/* Set nonzero after XEmacs has started up the first time. - Prevents reinitialization of the Lisp world and keymaps - on subsequent starts. */ -int initialized; - -#ifdef DOUG_LEA_MALLOC -# include -/* Preserves a pointer to the memory allocated that copies that - static data inside glibc's malloc. */ -static void *malloc_state_ptr; -#endif /* DOUG_LEA_MALLOC */ - -# ifdef REL_ALLOC -void r_alloc_reinit (void); -# endif - -/* Variable whose value is symbol giving operating system type. */ -Lisp_Object Vsystem_type; - -/* Variable whose value is string giving configuration built for. */ -Lisp_Object Vsystem_configuration; - -/* Variable whose value is string containing the configuration options - XEmacs was built with. */ -Lisp_Object Vsystem_configuration_options; - -/* Version numbers and strings */ -Lisp_Object Vemacs_major_version; -Lisp_Object Vemacs_minor_version; -Lisp_Object Vemacs_beta_version; -Lisp_Object Vxemacs_codename; -#ifdef INFODOCK -Lisp_Object Vinfodock_major_version; -Lisp_Object Vinfodock_minor_version; -Lisp_Object Vinfodock_build_version; -#endif - -/* The path under which XEmacs was invoked. */ -Lisp_Object Vinvocation_path; - -/* The name under which XEmacs was invoked, with any leading directory - names discarded. */ -Lisp_Object Vinvocation_name; - -/* The directory name from which XEmacs was invoked. */ -Lisp_Object Vinvocation_directory; - -#if 0 /* FSFmacs */ -/* The directory name in which to find subdirs such as lisp and etc. - nil means get them only from PATH_LOADSEARCH. */ -Lisp_Object Vinstallation_directory; -#endif - -Lisp_Object Vemacs_program_name, Vemacs_program_version; -Lisp_Object Vexec_path; -Lisp_Object Vexec_directory, Vconfigure_exec_directory; -Lisp_Object Vlisp_directory, Vconfigure_lisp_directory; -Lisp_Object Vmodule_directory, Vconfigure_module_directory; -Lisp_Object Vsite_module_directory, Vconfigure_site_module_directory; -Lisp_Object Vconfigure_package_path; -Lisp_Object Vdata_directory, Vconfigure_data_directory; -Lisp_Object Vdoc_directory, Vconfigure_doc_directory; -Lisp_Object Vconfigure_lock_directory; -Lisp_Object Vdata_directory_list; -Lisp_Object Vinfo_directory, Vconfigure_info_directory; -Lisp_Object Vsite_directory, Vconfigure_site_directory; -Lisp_Object Vconfigure_info_path; -Lisp_Object Vinternal_error_checking; -Lisp_Object Vpath_separator; - -/* The default base directory XEmacs is installed under. */ -Lisp_Object Vconfigure_exec_prefix_directory, Vconfigure_prefix_directory; - -/* If nonzero, set XEmacs to run at this priority. This is also used - in child_setup and sys_suspend to make sure subshells run at normal - priority. */ -int emacs_priority; - -/* If non-zero a filter or a sentinel is running. Tested to save the match - data on the first attempt to change it inside asynchronous code. */ -int running_asynch_code; - -/* If non-zero, a window-system was specified on the command line. */ -int display_arg; - -/* Type of display specified. We cannot use a Lisp symbol here because - Lisp symbols may not initialized at the time that we set this - variable. */ -CONST char *display_use; - -/* If non-zero, then the early error handler will only print the error - message and exit. */ -int suppress_early_error_handler_backtrace; - -/* An address near the bottom of the stack. - Tells GC how to save a copy of the stack. */ -char *stack_bottom; - -#ifdef USG_SHARED_LIBRARIES -/* If nonzero, this is the place to put the end of the writable segment - at startup. */ - -uintptr_t bss_end = 0; -#endif - -/* Number of bytes of writable memory we can expect to be able to get */ -unsigned int lim_data; - -/* Nonzero means running XEmacs without interactive terminal. */ - -int noninteractive; - -/* Value of Lisp variable `noninteractive'. - Normally same as C variable `noninteractive' - but nothing terrible happens if user sets this one. */ - -int noninteractive1; - -/* Nonzero means don't perform site-lisp searches at startup */ -int inhibit_site_lisp; - -/* Nonzero means don't perform site-modules searches at startup */ -int inhibit_site_modules; - -/* Nonzero means don't respect early packages at startup */ -int inhibit_early_packages; - -/* Nonzero means don't load package autoloads at startup */ -int inhibit_autoloads; - -/* Nonzero means print debug information about path searching */ -int debug_paths; - -/* Save argv and argc. */ -char **initial_argv; -int initial_argc; - -static void sort_args (int argc, char **argv); - -Lisp_Object Qkill_emacs_hook; -Lisp_Object Qsave_buffers_kill_emacs; - - -/* Signal code for the fatal signal that was received */ -static int fatal_error_code; - -/* Nonzero if handling a fatal error already */ -static int fatal_error_in_progress; - -static void shut_down_emacs (int sig, Lisp_Object stuff); - -/* Handle bus errors, illegal instruction, etc. */ -SIGTYPE -fatal_error_signal (int sig) -{ - fatal_error_code = sig; - signal (sig, SIG_DFL); - /* Unblock the signal so that if the same signal gets sent in the - code below, we avoid a deadlock. */ - EMACS_UNBLOCK_SIGNAL (fatal_error_code); - - /* If fatal error occurs in code below, avoid infinite recursion. */ - if (! fatal_error_in_progress) - { - fatal_error_in_progress = dont_check_for_quit = 1; - shut_down_emacs (sig, Qnil); - stderr_out ("\nLisp backtrace follows:\n\n"); - Fbacktrace (Qexternal_debugging_output, Qt); -# if 0 /* This is evil, rarely useful, and causes grief in some cases. */ - /* Check for Sun-style stack printing via /proc */ - { - CONST char *pstack = "/usr/proc/bin/pstack"; - if (access (pstack, X_OK) == 0) - { - char buf[100]; - stderr_out ("\nC backtrace follows:\n" - "(A real debugger may provide better information)\n\n"); - sprintf (buf, "%s %d >&2", pstack, (int)getpid()); - system (buf); - } - } -# endif - } - /* Signal the same code; this time it will really be fatal. */ - kill (getpid (), fatal_error_code); - SIGRETURN; -} - - -DOESNT_RETURN -fatal (CONST char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - - fprintf (stderr, "\nXEmacs: "); - vfprintf (stderr, GETTEXT (fmt), args); - fprintf (stderr, "\n"); - - va_end (args); - fflush (stderr); - exit (1); -} - -/* #### The following two functions should be replaced with - calls to emacs_doprnt_*() functions, with STREAM set to send out - to stdout or stderr. This is the only way to ensure that - I18N3 works properly (many implementations of the *printf() - functions, including the ones included in glibc, do not implement - the %###$ argument-positioning syntax). */ - -/* exactly equivalent to fprintf (stderr, fmt, ...) except that it calls - GETTEXT on the format string. */ - -int -stderr_out (CONST char *fmt, ...) -{ - int retval; - va_list args; - va_start (args, fmt); - - retval = vfprintf (stderr, GETTEXT (fmt), args); - - va_end (args); - /* fflush (stderr); */ - return retval; -} - -/* exactly equivalent to fprintf (stdout, fmt, ...) except that it calls - GETTEXT on the format string. */ - -int -stdout_out (CONST char *fmt, ...) -{ - int retval; - va_list args; - va_start (args, fmt); - - retval = vfprintf (stdout, GETTEXT (fmt), args); - - va_end (args); - return retval; -} - -#ifdef SIGDANGER - -/* Handler for SIGDANGER. */ -SIGTYPE -memory_warning_signal (int sig) -{ - /* #### bad bad bad; this function shouldn't do anything except - set a flag, or weird corruption could happen. */ - signal (sig, memory_warning_signal); - - malloc_warning - (GETTEXT ("Operating system warns that virtual memory is running low.\n")); - - /* It might be unsafe to call do_auto_save now. */ - force_auto_save_soon (); -} -#endif /* SIGDANGER */ - -/* Code for dealing with Lisp access to the Unix command line */ - -static Lisp_Object -make_arg_list_1 (int argc, char **argv, int skip_args) -{ - Lisp_Object result = Qnil; - REGISTER int i; - - for (i = argc - 1; i >= 0; i--) - { - if (i == 0 || i > skip_args) - { -#ifdef WINDOWSNT - if (i == 0) - { - /* Do not trust to what crt0 has stuffed into argv[0] */ - char full_exe_path [MAX_PATH]; - GetModuleFileName (NULL, full_exe_path, MAX_PATH); - result = Fcons (build_ext_string (full_exe_path, FORMAT_FILENAME), - result); -#if defined(HAVE_SHLIB) - (void)dll_init(full_exe_path); -#endif - } - else -#endif - result = Fcons (build_ext_string (argv [i], FORMAT_FILENAME), result); - } - } - return result; -} - -Lisp_Object -make_arg_list (int argc, char **argv) -{ - return make_arg_list_1 (argc, argv, 0); -} - -/* Calling functions are also responsible for calling free_argc_argv - when they are done with the generated list. */ -void -make_argc_argv (Lisp_Object argv_list, int *argc, char ***argv) -{ - Lisp_Object next; - int n = XINT (Flength (argv_list)); - REGISTER int i; - *argv = (char**) xmalloc ((n+1) * sizeof (char*)); - - for (i = 0, next = argv_list; i < n; i++, next = XCDR (next)) - { - CONST char *temp; - CHECK_STRING (XCAR (next)); - - GET_C_STRING_EXT_DATA_ALLOCA (XCAR (next), FORMAT_OS, temp); - (*argv) [i] = xstrdup (temp); - } - (*argv) [n] = 0; - *argc = i; -} - -void -free_argc_argv (char **argv) -{ - int elt = 0; - - while (argv[elt]) - { - xfree (argv[elt]); - elt++; - } - xfree (argv); -} - -static void -init_cmdargs (int argc, char **argv, int skip_args) -{ - initial_argv = argv; - initial_argc = argc; - - Vcommand_line_args = make_arg_list_1 (argc, argv, skip_args); -} - -DEFUN ("invocation-name", Finvocation_name, 0, 0, 0, /* -Return the program name that was used to run XEmacs. -Any directory names are omitted. -*/ - ()) -{ - return Fcopy_sequence (Vinvocation_name); -} - -DEFUN ("invocation-directory", Finvocation_directory, 0, 0, 0, /* -Return the directory name in which the Emacs executable was located. -*/ - ()) -{ - return Fcopy_sequence (Vinvocation_directory); -} - - -#ifdef I18N4 - /* #### - don't know why I18N4 on SunOS/JLE - can't deal with this. It's a potential - bug that needs to be looked at. */ -# undef RUN_TIME_REMAP -#endif - -#if defined (MULE) && defined (MSDOS) && defined (EMX) -/* Setup all of files be input/output'ed with binary translation mode. */ -asm (" .text"); -asm ("L_setbinmode:"); -asm (" movl $1, __fmode_bin"); -asm (" ret"); -asm (" .stabs \"___CTOR_LIST__\", 23, 0, 0, L_setbinmode"); -#endif - -/* Test whether the next argument in ARGV matches SSTR or a prefix of - LSTR (at least MINLEN characters). If so, then if VALPTR is non-null - (the argument is supposed to have a value) store in *VALPTR either - the next argument or the portion of this one after the equal sign. - ARGV is read starting at position *SKIPPTR; this index is advanced - by the number of arguments used. - - Too bad we can't just use getopt for all of this, but we don't have - enough information to do it right. */ - -static int -argmatch (char **argv, int argc, char *sstr, char *lstr, - int minlen, char **valptr, int *skipptr) -{ - char *p = NULL; - int arglen; - char *arg; - - /* Don't access argv[argc]; give up in advance. */ - if (argc <= *skipptr + 1) - return 0; - - arg = argv[*skipptr+1]; - if (arg == NULL) - return 0; - if (strcmp (arg, sstr) == 0) - { - if (valptr != NULL) - { - *valptr = argv[*skipptr+2]; - *skipptr += 2; - } - else - *skipptr += 1; - return 1; - } - arglen = (valptr != NULL && (p = strchr (arg, '=')) != NULL - ? p - arg : strlen (arg)); - if (lstr == 0 || arglen < minlen || strncmp (arg, lstr, arglen) != 0) - return 0; - else if (valptr == NULL) - { - *skipptr += 1; - return 1; - } - else if (p != NULL) - { - *valptr = p+1; - *skipptr += 1; - return 1; - } - else if (argv[*skipptr+2] != NULL) - { - *valptr = argv[*skipptr+2]; - *skipptr += 2; - return 1; - } - else - { - return 0; - } -} - -/* Make stack traces always identify version + configuration */ -#define main_1 STACK_TRACE_EYE_CATCHER - -/* This function is not static, so that the compiler is less likely to - inline it, which would make it not show up in stack traces. */ -DECLARE_DOESNT_RETURN (main_1 (int, char **, char **, int)); -DOESNT_RETURN -main_1 (int argc, char **argv, char **envp, int restart) -{ - char stack_bottom_variable; - int skip_args = 0; - Lisp_Object load_me; - int inhibit_window_system; -#ifdef NeXT - extern int malloc_cookie; -#endif - -#if !defined(SYSTEM_MALLOC) && !defined(HAVE_LIBMCHECK) - /* Make sure that any libraries we link against haven't installed a - hook for a gmalloc of a potentially incompatible version. */ - /* If we're using libmcheck, the hooks have already been initialized, */ - /* don't touch them. -slb */ - __malloc_hook = NULL; - __realloc_hook = NULL; - __free_hook = NULL; -#endif /* not SYSTEM_MALLOC */ - - noninteractive = 0; - -#ifdef NeXT - /* 19-Jun-1995 -baw - * NeXT secret magic, ripped from Emacs-for-NS by Carl Edman - * . Note that even Carl doesn't know what this - * does; it was provided by NeXT, and it presumable makes NS's mallocator - * work with dumping. But malloc_jumpstart() and malloc_freezedry() in - * unexnext.c are both completely undocumented, even in NS header files! - * But hey, it solves all NS related memory problems, so who's - * complaining? */ - if (initialized && malloc_jumpstart (malloc_cookie) != 0) - fprintf (stderr, "malloc jumpstart failed!\n"); -#endif /* NeXT */ - - /* -#if defined (GNU_MALLOC) && \ - defined (ERROR_CHECK_MALLOC) && \ - !defined (HAVE_LIBMCHECK) - */ -#if defined(LOSING_GCC_DESTRUCTOR_FREE_BUG) - /* Prior to XEmacs 21, this was `#if 0'ed out. */ - /* I'm enabling this because it is the only reliable way I've found to */ - /* prevent a very annoying problem where GCC will attempt to free(3) */ - /* memory at exit() and cause a coredump. */ - init_free_hook (); -#endif - - sort_args (argc, argv); - - /* Map in shared memory, if we are using that. */ -#ifdef HAVE_SHM - if (argmatch (argv, argc, "-nl", "--no-shared-memory", 6, NULL, &skip_args)) - { - map_in_data (0); - /* The shared memory was just restored, which clobbered this. */ - skip_args = 1; - } - else - { - map_in_data (1); - /* The shared memory was just restored, which clobbered this. */ - skip_args = 0; - } -#endif /* HAVE_SHM */ - -#if (defined (MSDOS) && defined (EMX)) || defined (WIN32) || defined (_SCO_DS) - environ = envp; -#endif - - /* Record (approximately) where the stack begins. */ - stack_bottom = &stack_bottom_variable; - -#ifdef USG_SHARED_LIBRARIES - if (bss_end) - brk ((void *) bss_end); -#endif - - clearerr (stdin); - -#ifdef APOLLO -#ifndef APOLLO_SR10 - /* If USE_DOMAIN_ACLS environment variable exists, - use ACLs rather than UNIX modes. */ - if (egetenv ("USE_DOMAIN_ACLS")) - default_acl (USE_DEFACL); -#endif -#endif /* APOLLO */ - -#if defined (HAVE_MMAP) && defined (REL_ALLOC) - /* ralloc can only be used if using the GNU memory allocator. */ - init_ralloc (); -#elif defined (REL_ALLOC) && !defined(DOUG_LEA_MALLOC) - if (initialized) - init_ralloc(); -#endif - -#ifdef HAVE_SOCKS - if (initialized) - SOCKSinit (argv[0]); -#endif /* HAVE_SOCKS */ - -#ifndef SYSTEM_MALLOC - if (!initialized) - /* Arrange to get warning messages as memory fills up. */ - memory_warnings (0, malloc_warning); -#endif /* not SYSTEM_MALLOC */ - -#ifdef MSDOS - /* We do all file input/output as binary files. When we need to translate - newlines, we do that manually. */ - _fmode = O_BINARY; - (stdin) ->_flag &= ~_IOTEXT; - (stdout)->_flag &= ~_IOTEXT; - (stderr)->_flag &= ~_IOTEXT; -#endif /* MSDOS */ - -#ifdef SET_EMACS_PRIORITY - if (emacs_priority != 0) - nice (-emacs_priority); - setuid (getuid ()); -#endif /* SET_EMACS_PRIORITY */ - -#ifdef EXTRA_INITIALIZE - EXTRA_INITIALIZE; -#endif - -#ifdef HAVE_WINDOW_SYSTEM - inhibit_window_system = 0; -#else - inhibit_window_system = 1; -#endif - - /* Handle the -t switch, which specifies filename to use as terminal */ - { - char *term; - if (argmatch (argv, argc, "-t", "--terminal", 4, &term, &skip_args)) - { - close (0); - close (1); - if (open (term, O_RDWR | OPEN_BINARY, 2) < 0) - fatal ("%s: %s", term, strerror (errno)); - dup (0); - if (! isatty (0)) - fatal ("%s: not a tty", term); - -#if 0 - stderr_out ("Using %s", ttyname (0)); -#endif - stderr_out ("Using %s", term); - inhibit_window_system = 1; /* -t => -nw */ - } - } - - /* Handle -nw switch */ - if (argmatch (argv, argc, "-nw", "--no-windows", 6, NULL, &skip_args)) - inhibit_window_system = 1; - - /* Handle the -batch switch, which means don't do interactive display. */ - if (argmatch (argv, argc, "-batch", "--batch", 5, NULL, &skip_args)) - { -#if 0 /* I don't think this is correct. */ - inhibit_autoloads = 1; -#endif - noninteractive = 1; - } - - if (argmatch (argv, argc, "-debug-paths", "--debug-paths", - 11, NULL, &skip_args)) - debug_paths = 1; - - /* Partially handle -no-autoloads, -no-early-packages and -vanilla. Packages */ - /* are searched prior to the rest of the command line being parsed in */ - /* startup.el */ - if (argmatch (argv, argc, "-no-early-packages", "--no-early-packages", - 6, NULL, &skip_args)) - { - inhibit_early_packages = 1; - skip_args--; - } -#ifdef HAVE_SHLIB - if (argmatch (argv, argc, "-no-site-modules", "--no-site-modules", - 9, NULL, &skip_args)) - { - inhibit_site_modules = 1; - skip_args--; - } -#else - inhibit_site_modules = 1; -#endif - if (argmatch (argv, argc, "-vanilla", "--vanilla", - 7, NULL, &skip_args)) - { - inhibit_early_packages = 1; - skip_args--; - } - - if (argmatch (argv, argc, "-no-autoloads", "--no-autoloads", - 7, NULL, &skip_args)) - { - /* Inhibit everything */ - inhibit_autoloads = 1; - skip_args--; - } - - if (argmatch (argv, argc, "-debug-paths", "--debug-paths", - 6, NULL, &skip_args)) - { - debug_paths = 1; - skip_args--; - } - - - /* Partially handle the -version and -help switches: they imply -batch, - but are not removed from the list. */ - if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)) - noninteractive = 1, skip_args--; - - if (argmatch (argv, argc, "-version", "--version", 3, NULL, &skip_args) || - argmatch (argv, argc, "-V", 0, 2, NULL, &skip_args)) - noninteractive = 1, skip_args--; - - /* Now, figure out which type of console is our first console. */ - - display_arg = 0; - - if (noninteractive) - display_use = "stream"; - else - display_use = "tty"; - -#ifndef HAVE_TTY - if (inhibit_window_system) - fatal ("Sorry, this XEmacs was not compiled with TTY support"); -#endif - -#ifdef HAVE_WINDOW_SYSTEM - /* Stupid kludge to catch command-line display spec. We can't - handle this argument entirely in window-system-dependent code - because we don't even know which window-system-dependent code - to run until we've recognized this argument. */ - if (!inhibit_window_system && !noninteractive) - { -#ifdef HAVE_X_WINDOWS - char *dpy = 0; - int count_before = skip_args; - - if (argmatch (argv, argc, "-d", "--display", 3, &dpy, &skip_args) || - argmatch (argv, argc, "-display", 0, 3, &dpy, &skip_args)) - { - display_arg = 1; - display_use = "x"; - } - /* If we have the form --display=NAME, - convert it into -d name. - This requires inserting a new element into argv. */ - if (dpy != 0 && skip_args - count_before == 1) - { - char **new = (char **) xmalloc (sizeof (char *) * (argc + 2)); - int j; - - for (j = 0; j < count_before + 1; j++) - new[j] = argv[j]; - new[count_before + 1] = "-d"; - new[count_before + 2] = dpy; - for (j = count_before + 2; j count_before - && argv[count_before + 1][1] == '-') - argv[count_before + 1] = "-d"; - - /* Don't actually discard this arg. */ - skip_args = count_before; - - /* If there is a non-empty environment var DISPLAY, set - `display_use', but not `display_arg', which is only to be set - if the display was specified on the command line. */ - if ((dpy = getenv ("DISPLAY")) && dpy[0]) - display_use = "x"; - -#endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_MS_WINDOWS - if (strcmp(display_use, "x") != 0) - display_use = "mswindows"; -#endif /* HAVE_MS_WINDOWS */ - } -#endif /* HAVE_WINDOW_SYSTEM */ - - noninteractive1 = noninteractive; - - /****** Now initialize everything *******/ - - /* First, do really basic environment initialization -- catching signals - and the like. These functions have no dependence on any part of - the Lisp engine and need to be done both at dump time and at run time. */ - - init_signals_very_early (); - init_data_very_early (); /* Catch math errors. */ -#ifdef LISP_FLOAT_TYPE - init_floatfns_very_early (); /* Catch floating-point math errors. */ -#endif - init_process_times_very_early (); /* Initialize our process timers. - As early as possible, of course, - so we can be fairly accurate. */ - init_intl_very_early (); /* set up the locale and domain for gettext and - such. */ - - /* Now initialize the Lisp engine and the like. Done only during - dumping. No dependence on anything that may be in the user's - environment when the dumped XEmacs is run. - - We try to do things in an order that minimizes the non-obvious - dependencies between functions. */ - - if (!initialized) - { - /* Initialize things so that new Lisp objects - can be created and objects can be staticpro'd. - Must be basically the very first thing done - because pretty much all of the initialization - routines below create new objects. */ - init_alloc_once_early (); - - /* Initialize Qnil, Qt, Qunbound, and the - obarray. After this, symbols can be - interned. This depends on init_alloc_once(). */ - init_symbols_once_early (); - - /* Declare the basic symbols pertaining to errors, - So that deferror() can be called. */ - init_errors_once_early (); - - /* Make sure that opaque pointers can be created. */ - init_opaque_once_early (); - - /* Now declare all the symbols and define all the Lisp primitives. - - The *only* thing that the syms_of_*() functions are allowed to do - is call one of the following three functions: - - defsymbol() - defsubr() (i.e. DEFSUBR) - deferror() - defkeyword() - - Order does not matter in these functions. - */ - - syms_of_abbrev (); - syms_of_alloc (); -#ifdef HAVE_X_WINDOWS - syms_of_balloon_x (); -#endif - syms_of_buffer (); - syms_of_bytecode (); - syms_of_callint (); - syms_of_callproc (); - syms_of_casefiddle (); - syms_of_casetab (); - syms_of_chartab (); - syms_of_cmdloop (); - syms_of_cmds (); - syms_of_console (); - syms_of_data (); -#ifdef DEBUG_XEMACS - syms_of_debug (); -#endif /* DEBUG_XEMACS */ - syms_of_device (); -#ifdef HAVE_DIALOGS - syms_of_dialog (); -#endif - syms_of_dired (); - syms_of_doc (); - syms_of_editfns (); - syms_of_elhash (); - syms_of_emacs (); - syms_of_eval (); -#ifdef HAVE_X_WINDOWS - syms_of_event_Xt (); -#endif -#ifdef HAVE_DRAGNDROP - syms_of_dragdrop (); -#endif - syms_of_event_stream (); - syms_of_events (); - syms_of_extents (); - syms_of_faces (); - syms_of_fileio (); -#ifdef CLASH_DETECTION - syms_of_filelock (); -#endif /* CLASH_DETECTION */ - syms_of_floatfns (); - syms_of_fns (); - syms_of_font_lock (); - syms_of_frame (); - syms_of_general (); - syms_of_glyphs (); - syms_of_glyphs_eimage (); - syms_of_glyphs_widget (); -#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) - syms_of_gui (); -#endif - syms_of_indent (); - syms_of_intl (); - syms_of_keymap (); - syms_of_lread (); - syms_of_macros (); - syms_of_marker (); - syms_of_md5 (); -#ifdef HAVE_DATABASE - syms_of_database (); -#endif -#ifdef HAVE_MENUBARS - syms_of_menubar (); -#endif - syms_of_minibuf (); -#ifdef HAVE_SHLIB - syms_of_module (); -#endif - syms_of_objects (); - syms_of_print (); -#if !defined (NO_SUBPROCESSES) - syms_of_process (); -#ifdef HAVE_WIN32_PROCESSES - syms_of_process_nt (); -#endif -#endif - syms_of_profile (); -#if defined (HAVE_MMAP) && defined (REL_ALLOC) && !defined(DOUG_LEA_MALLOC) - syms_of_ralloc (); -#endif /* HAVE_MMAP && REL_ALLOC */ - syms_of_rangetab (); - syms_of_redisplay (); - syms_of_search (); - syms_of_signal (); - syms_of_sound (); - syms_of_specifier (); - syms_of_symbols (); - syms_of_syntax (); -#ifdef HAVE_SCROLLBARS - syms_of_scrollbar (); -#endif -#ifdef HAVE_TOOLBARS - syms_of_toolbar (); -#endif - syms_of_undo (); - syms_of_widget (); - syms_of_window (); - -#ifdef HAVE_TTY - syms_of_console_tty (); - syms_of_device_tty (); - syms_of_objects_tty (); -#endif - -#ifdef HAVE_X_WINDOWS - syms_of_device_x (); -#ifdef HAVE_DIALOGS - syms_of_dialog_x (); -#endif - syms_of_frame_x (); - syms_of_glyphs_x (); - syms_of_objects_x (); -#ifdef HAVE_MENUBARS - syms_of_menubar_x (); -#endif - syms_of_xselect (); -#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) - syms_of_gui_x (); -#endif -#endif /* HAVE_X_WINDOWS */ - -#ifdef HAVE_MS_WINDOWS - syms_of_console_mswindows (); - syms_of_device_mswindows (); - syms_of_frame_mswindows (); - syms_of_objects_mswindows (); - syms_of_select_mswindows (); - syms_of_glyphs_mswindows (); -#ifdef HAVE_MENUBARS - syms_of_menubar_mswindows (); -#endif -#ifdef HAVE_SCROLLBARS - syms_of_scrollbar_mswindows (); -#endif -#ifdef HAVE_MSW_C_DIRED - syms_of_dired_mswindows (); -#endif -#endif /* HAVE_MS_WINDOWS */ - -#ifdef MULE - syms_of_mule (); - syms_of_mule_ccl (); - syms_of_mule_charset (); -#endif -#ifdef FILE_CODING - syms_of_mule_coding (); -#endif -#ifdef MULE -#ifdef HAVE_WNN - syms_of_mule_wnn (); -#endif -#ifdef HAVE_CANNA - syms_of_mule_canna (); -#endif /* HAVE_CANNA */ -#endif /* MULE */ - -#ifdef SYMS_SYSTEM - SYMS_SYSTEM; -#endif - -#ifdef SYMS_MACHINE - SYMS_MACHINE; -#endif - - /* -#if defined (GNU_MALLOC) && \ - defined (ERROR_CHECK_MALLOC) && \ - !defined (HAVE_LIBMCHECK) - */ - /* Prior to XEmacs 21, this was `#if 0'ed out. -slb */ -#if defined (LOSING_GCC_DESTRUCTOR_FREE_BUG) - syms_of_free_hook (); -#endif - -#ifdef TOOLTALK - syms_of_tooltalk (); -#endif - -#ifdef SUNPRO - syms_of_sunpro (); -#endif - -#ifdef HAVE_LDAP - syms_of_eldap (); -#endif - - /* Now create the subtypes for the types that have them. - We do this before the vars_*() because more symbols - may get initialized here. */ - - /* Now initialize the console types and associated symbols. - Other than the first function below, the functions may - make exactly the following function/macro calls: - - INITIALIZE_CONSOLE_TYPE() - CONSOLE_HAS_METHOD() - - For any given console type, the former macro must be called - before the any calls to the latter macro. */ - - console_type_create (); - - console_type_create_stream (); - -#ifdef HAVE_TTY - console_type_create_tty (); - console_type_create_device_tty (); - console_type_create_frame_tty (); - console_type_create_objects_tty (); - console_type_create_redisplay_tty (); -#endif - -#ifdef HAVE_X_WINDOWS - console_type_create_x (); - console_type_create_device_x (); - console_type_create_frame_x (); - console_type_create_glyphs_x (); -#ifdef HAVE_MENUBARS - console_type_create_menubar_x (); -#endif - console_type_create_objects_x (); - console_type_create_redisplay_x (); -#ifdef HAVE_SCROLLBARS - console_type_create_scrollbar_x (); -#endif -#ifdef HAVE_TOOLBARS - console_type_create_toolbar_x (); -#endif -#ifdef HAVE_DIALOGS - console_type_create_dialog_x (); -#endif -#endif /* HAVE_X_WINDOWS */ - -#ifdef HAVE_MS_WINDOWS - console_type_create_mswindows (); - console_type_create_device_mswindows (); - console_type_create_frame_mswindows (); - console_type_create_objects_mswindows (); - console_type_create_redisplay_mswindows (); - console_type_create_glyphs_mswindows (); -# ifdef HAVE_SCROLLBARS - console_type_create_scrollbar_mswindows (); -# endif -#ifdef HAVE_MENUBARS - console_type_create_menubar_mswindows (); -#endif -#ifdef HAVE_TOOLBARS - console_type_create_toolbar_mswindows (); -#endif -#ifdef HAVE_DIALOGS - console_type_create_dialog_mswindows (); -#endif -#endif - - /* Now initialize the specifier types and associated symbols. - Other than the first function below, the functions may - make exactly the following function/macro calls: - - INITIALIZE_SPECIFIER_TYPE() - SPECIFIER_HAS_METHOD() - - For any given specifier type, the former macro must be called - before the any calls to the latter macro. */ - - specifier_type_create (); - - specifier_type_create_image (); - specifier_type_create_objects (); -#ifdef HAVE_TOOLBARS - specifier_type_create_toolbar (); -#endif - - /* Now initialize the structure types and associated symbols. - Other than the first function below, the functions may - make exactly the following function/macro calls: - - define_structure_type() - define_structure_type_keyword() - - */ - - structure_type_create (); - - structure_type_create_chartab (); - structure_type_create_faces (); - structure_type_create_rangetab (); - structure_type_create_hash_table (); - - /* Now initialize the image instantiator formats and associated symbols. - Other than the first function below, the functions may - make exactly the following function/macro calls: - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT() - IIFORMAT_HAS_METHOD() - IIFORMAT_VALID_KEYWORD() - - For any given image instantiator format, the first macro must be - called before the any calls to the other macros. */ - - image_instantiator_format_create (); - image_instantiator_format_create_glyphs_eimage (); - image_instantiator_format_create_glyphs_widget (); -#ifdef HAVE_X_WINDOWS - image_instantiator_format_create_glyphs_x (); -#endif /* HAVE_X_WINDOWS */ -#ifdef HAVE_MS_WINDOWS - image_instantiator_format_create_glyphs_mswindows (); -#endif /* HAVE_MSWINDOWS_WINDOWS */ - - /* Now initialize the lstream types and associated symbols. - Other than the first function below, the functions may - make exactly the following function/macro calls: - - LSTREAM_HAS_METHOD() - - */ - - lstream_type_create (); -#ifdef FILE_CODING - lstream_type_create_mule_coding (); -#endif -#if defined (HAVE_MS_WINDOWS) && !defined(HAVE_MSG_SELECT) - lstream_type_create_mswindows_selectable (); -#endif - - /* Initialize processes implementation. - The functions may make exactly the following function/macro calls: - - PROCESS_HAS_METHOD() - */ -#ifdef HAVE_UNIX_PROCESSES - process_type_create_unix (); -#endif -#ifdef HAVE_WIN32_PROCESSES - process_type_create_nt (); -#endif - - /* Now initialize most variables. - - These functions may do exactly the following: - - DEFVAR_INT() - DEFVAR_LISP() - DEFVAR_BOOL() - DEFER_GETTEXT() - Dynarr_*() - Blocktype_*() - staticpro() - Fprovide(symbol) - intern() - pure_put() - xmalloc() - defsymbol(), if it's absolutely necessary and you're sure that - the symbol isn't referenced anywhere else in the initialization - code - Fset() on a symbol that is unbound - assigning a symbol or constant value to a variable - using a global variable that has been initialized - earlier on in the same function - - Any of the object-creating functions on alloc.c: e.g. - - make_pure_*() - Fpurecopy() - make_string() - build_string() - make_vector() - make_int() - make_extent() - alloc_lcrecord() - Fcons() - listN() - make_opaque_ptr() - make_opaque_long() - - perhaps a few others. - */ - - /* Now allow Fprovide() statements to be made. */ - init_provide_once (); - - vars_of_abbrev (); - vars_of_alloc (); -#ifdef HAVE_X_WINDOWS - vars_of_balloon_x (); -#endif - vars_of_buffer (); - vars_of_bytecode (); - vars_of_callint (); - vars_of_callproc (); - vars_of_cmdloop (); - vars_of_cmds (); - vars_of_console (); - vars_of_data (); -#ifdef DEBUG_XEMACS - vars_of_debug (); -#endif - vars_of_console_stream (); - vars_of_device (); -#ifdef HAVE_DIALOGS - vars_of_dialog (); -#endif - vars_of_dired (); - vars_of_doc (); -#ifdef HAVE_DRAGNDROP - vars_of_dragdrop (); -#endif - vars_of_editfns (); - vars_of_elhash (); - vars_of_emacs (); - vars_of_eval (); - -#ifdef HAVE_X_WINDOWS - vars_of_event_Xt (); -#endif -#if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS)) - vars_of_event_tty (); -#endif -#ifdef HAVE_MS_WINDOWS - vars_of_event_mswindows (); -#endif - vars_of_event_stream (); - - vars_of_events (); - vars_of_extents (); - vars_of_faces (); - vars_of_fileio (); - vars_of_floatfns (); - vars_of_font_lock (); - vars_of_frame (); - vars_of_glyphs (); - vars_of_glyphs_eimage (); - vars_of_glyphs_widget (); -#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) - vars_of_gui (); -#endif - vars_of_indent (); - vars_of_insdel (); - vars_of_intl (); -#ifdef HAVE_XIM -#ifdef XIM_MOTIF - vars_of_input_method_motif (); -#else /* XIM_XLIB */ - vars_of_input_method_xlib (); -#endif -#endif /* HAVE_XIM */ - vars_of_keymap (); - vars_of_lread (); - vars_of_lstream (); - vars_of_macros (); - vars_of_md5 (); -#ifdef HAVE_DATABASE - vars_of_database (); -#endif -#ifdef HAVE_MENUBARS - vars_of_menubar (); -#endif - vars_of_minibuf (); -#ifdef HAVE_SHLIB - vars_of_module (); -#endif - vars_of_objects (); - vars_of_print (); - -#ifndef NO_SUBPROCESSES - vars_of_process (); -#ifdef HAVE_UNIX_PROCESSES - vars_of_process_unix (); -#endif -#ifdef HAVE_WIN32_PROCESSES - vars_of_process_nt (); -#endif -#endif - - vars_of_profile (); -#if defined (HAVE_MMAP) && defined (REL_ALLOC) && !defined(DOUG_LEA_MALLOC) - vars_of_ralloc (); -#endif /* HAVE_MMAP && REL_ALLOC */ - vars_of_redisplay (); -#ifdef HAVE_SCROLLBARS - vars_of_scrollbar (); -#endif - vars_of_search (); - vars_of_sound (); - vars_of_specifier (); - vars_of_symbols (); - vars_of_syntax (); -#ifdef HAVE_TOOLBARS - vars_of_toolbar (); -#endif - vars_of_undo (); - vars_of_window (); - -#ifdef HAVE_TTY - vars_of_console_tty (); - vars_of_frame_tty (); - vars_of_objects_tty (); -#endif - -#ifdef HAVE_X_WINDOWS - vars_of_device_x (); -#ifdef HAVE_DIALOGS - vars_of_dialog_x (); -#endif - vars_of_frame_x (); - vars_of_glyphs_x (); -#ifdef HAVE_MENUBARS - vars_of_menubar_x (); -#endif - vars_of_objects_x (); - vars_of_xselect (); -#ifdef HAVE_SCROLLBARS - vars_of_scrollbar_x (); -#endif -#if defined (HAVE_MENUBARS) || defined (HAVE_SCROLLBARS) || defined (HAVE_DIALOGS) || defined (HAVE_TOOLBARS) - vars_of_gui_x (); -#endif -#endif - -#ifdef HAVE_MS_WINDOWS - vars_of_device_mswindows (); - vars_of_console_mswindows (); - vars_of_frame_mswindows (); - vars_of_objects_mswindows (); - vars_of_select_mswindows (); - vars_of_glyphs_mswindows (); -#ifdef HAVE_SCROLLBARS - vars_of_scrollbar_mswindows (); -#endif -#ifdef HAVE_MENUBARS - vars_of_menubar_mswindows (); -#endif -#ifdef HAVE_MSW_C_DIRED - vars_of_dired_mswindows (); -#endif -#ifdef HAVE_DIALOGS - vars_of_dialog_mswindows (); -#endif -#endif /* HAVE_MS_WINDOWS */ - -#ifdef MULE - vars_of_mule (); - vars_of_mule_charset (); -#endif -#ifdef FILE_CODING - vars_of_mule_coding (); -#endif -#ifdef MULE -#ifdef HAVE_WNN - vars_of_mule_wnn (); -#endif -#ifdef HAVE_CANNA - vars_of_mule_canna (); -#endif /* HAVE_CANNA */ -#endif /* MULE */ - -#ifdef TOOLTALK - vars_of_tooltalk (); -#endif - -#ifdef SUNPRO - vars_of_sunpro (); -#endif - -#ifdef HAVE_LDAP - vars_of_eldap (); -#endif - - /* Now initialize any specifier variables. We do this later - because it has some dependence on the vars initialized - above. - - These functions should *only* initialize specifier variables, - and may make use of the following functions/macros in addition - to the ones listed above: - - DEFVAR_SPECIFIER() - Fmake_specifier() - set_specifier_fallback() - set_specifier_caching() - */ - - specifier_vars_of_glyphs (); -#ifdef HAVE_MENUBARS - specifier_vars_of_menubar (); -#endif - specifier_vars_of_redisplay (); -#ifdef HAVE_SCROLLBARS - specifier_vars_of_scrollbar (); -#endif -#ifdef HAVE_TOOLBARS - specifier_vars_of_toolbar (); -#endif - specifier_vars_of_window (); - - /* Now comes all the rest of the variables that couldn't - be handled above. There may be dependencies on variables - initialized above, and dependencies between one complex_vars_() - function and another. */ - - /* Calls Fmake_range_table(). */ - complex_vars_of_regex (); - /* Calls Fmake_range_table(). */ - complex_vars_of_search (); - - /* Calls make_lisp_hash_table(). */ - complex_vars_of_extents (); - - /* Depends on hash tables and specifiers. */ - complex_vars_of_faces (); - -#ifdef MULE - /* These two depend on hash tables and various variables declared - earlier. The second may also depend on the first. */ - complex_vars_of_mule_charset (); -#endif -#if defined(FILE_CODING) - complex_vars_of_mule_coding (); -#endif - - /* This calls allocate_glyph(), which creates specifiers - and also relies on a variable (Vthe_nothing_vector) initialized - above. It also calls make_ext_string(), which under Mule - could require that the charsets be initialized. */ - complex_vars_of_glyphs (); - - /* These rely on the glyphs just created in the previous function, - and call Fadd_spec_to_specifier(), which relies on various - variables initialized above. */ -#ifdef HAVE_X_WINDOWS - complex_vars_of_glyphs_x (); -#endif -#ifdef HAVE_MS_WINDOWS - complex_vars_of_glyphs_mswindows (); -#endif - - /* This calls Fmake_glyph_internal(). */ - complex_vars_of_alloc (); - - /* This calls Fmake_glyph_internal(). */ -#ifdef HAVE_MENUBARS - complex_vars_of_menubar (); -#endif - - /* This calls Fmake_glyph_internal(). */ -#ifdef HAVE_SCROLLBARS - complex_vars_of_scrollbar (); -#endif - - /* This calls allocate_glyph(). */ - complex_vars_of_frame (); - - /* This calls Fcopy_category_table() under Mule, which calls who - knows what. */ - complex_vars_of_chartab (); - - /* This calls set_string_char(), which (under Mule) depends on the - charsets being initialized. */ - complex_vars_of_casetab (); - - /* This calls Fcopy_syntax_table(), which relies on char tables. */ - complex_vars_of_syntax (); - - /* This initializes buffer-local variables, sets things up so - that buffers can be created, and creates a couple of basic - buffers. This depends on Vstandard_syntax_table and - Vstandard_category_table (initialized in the previous - functions), as well as a whole horde of variables that may - have been initialized above. */ - complex_vars_of_buffer (); - - /* This initializes console-local variables. */ - complex_vars_of_console (); - - /* This creates a couple more buffers, and depends on the - previous function. */ - complex_vars_of_minibuf (); - - /* These two might call Ffile_name_as_directory(), which - might depend on all sorts of things; I'm not sure. */ - complex_vars_of_emacs (); - - /* This creates a couple of basic keymaps and depends on Lisp - hash tables and Ffset() (both of which depend on some variables - initialized in the vars_of_*() section) and possibly other - stuff. */ - complex_vars_of_keymap (); - - /* Calls make_lisp_hash_table() and creates a keymap */ - complex_vars_of_event_stream (); - -#ifdef ERROR_CHECK_GC - { - extern int always_gc; - if (always_gc) /* purification debugging hack */ - garbage_collect_1 (); - } -#endif - } - - /* CONGRATULATIONS!!! We have successfully initialized the Lisp - engine. */ - - if (initialized) - { - /* Stuff that needs to be reset at run time. Order below should - not matter. */ - reinit_alloc (); - reinit_eval (); -#ifdef MULE_REGEXP - reinit_mule_category (); -#endif - } - - /* Now do further initialization/setup of stuff that is not needed by the - syms_of_() routines. This involves stuff that only is enabled in - an interactive run (redisplay, user input, etc.) and stuff that is - not needed until we start loading Lisp code (the reader). A lot - of this stuff involves querying the current environment and needs - to be done both at dump time and at run time. */ - - init_initial_directory(); /* get the directory to use for the - "*scratch*" buffer, etc. */ - -#ifdef WINDOWSNT - /* - * For Win32, call init_environment() now, so that environment/registry - * variables will be properly entered into Vprocess_environment. - */ - init_environment(); -#endif - - init_callproc (); /* Set up the process environment (so that egetenv - works), the basic directory variables - (exec-directory and so on), and stuff - related to subprocesses. This should be - first because many of the functions below - call egetenv() to get environment variables. */ - init_lread (); /* Set up the Lisp reader. */ -#ifdef MSDOS - /* Call early 'cause init_environment needs it. */ - init_dosfns (); - /* Set defaults for several environment variables. */ - init_environment (argc, argv, skip_args); -#endif - init_cmdargs (argc, argv, skip_args); /* Create list Vcommand_line_args */ - init_buffer (); /* Set default directory of *scratch* buffer */ - -#ifdef WINDOWSNT - init_ntproc(); -#endif - - init_redisplay (); /* Determine terminal type. - init_sys_modes uses results */ - init_event_stream (); /* Set up so we can get user input. */ - init_macros (); /* set up so we can run macros. */ - init_editfns (); /* Determine the name of the user we're running as */ - init_xemacs_process (); /* set up for calling subprocesses */ -#ifdef SUNPRO - init_sunpro (); /* Set up Sunpro usage tracking */ -#endif -#if defined (HAVE_NATIVE_SOUND) && defined (hp9000s800) - init_hpplay (); -#endif -#ifdef HAVE_TTY - init_device_tty (); -#endif - init_console_stream (); /* Create the first console */ - - /* try to get the actual pathname of the exec file we are running */ - if (!restart) - { - Vinvocation_name = Fcar (Vcommand_line_args); - if (XSTRING_DATA(Vinvocation_name)[0] == '-') - { - /* XEmacs as a login shell, oh goody! */ - Vinvocation_name = build_string(getenv("SHELL")); - } - Vinvocation_directory = Vinvocation_name; - - if (!NILP (Ffile_name_directory (Vinvocation_name))) - { - /* invocation-name includes a directory component -- presumably it - is relative to cwd, not $PATH */ - Vinvocation_directory = Fexpand_file_name (Vinvocation_name, - Qnil); - Vinvocation_path = Qnil; - } - else - { - Vinvocation_path = decode_env_path ("PATH", NULL); - locate_file (Vinvocation_path, Vinvocation_name, EXEC_SUFFIXES, - &Vinvocation_directory, X_OK); - } - - if (NILP (Vinvocation_directory)) - Vinvocation_directory = Vinvocation_name; - - Vinvocation_name = Ffile_name_nondirectory (Vinvocation_directory); - Vinvocation_directory = Ffile_name_directory (Vinvocation_directory); - } - -#if defined(HAVE_SHLIB) && !defined(WINDOWSNT) - /* This is Unix only. MS Windows NT has a library call that does - The Right Thing on that system. Rumor has it, this must be - called for GNU dld in temacs and xemacs. */ - { - char *buf = (char *)alloca (XSTRING_LENGTH (Vinvocation_directory) - + XSTRING_LENGTH (Vinvocation_name) - + 2); - sprintf (buf, "%s/%s", XSTRING_DATA (Vinvocation_directory), - XSTRING_DATA (Vinvocation_name)); - - /* All we can do is cry if an error happens, so ignore it. */ - (void) dll_init (buf); - } -#endif - -#if defined (LOCALTIME_CACHE) && defined (HAVE_TZSET) - /* sun's localtime() has a bug. it caches the value of the time - zone rather than looking it up every time. Since localtime() is - called to bolt the undumping time into the undumped emacs, this - results in localtime() ignoring the TZ environment variable. - This flushes the new TZ value into localtime(). */ - tzset (); -#endif /* LOCALTIME_CACHE and TZSET */ - - load_me = Qnil; - if (!initialized) - { - /* Handle -l loadup-and-dump, args passed by Makefile. */ - if (argc > 2 + skip_args && !strcmp (argv[1 + skip_args], "-l")) - load_me = build_string (argv[2 + skip_args]); -#if 0 /* CANNOT_DUMP - this can never be right in XEmacs --andyp */ - /* Unless next switch is -nl, load "loadup.el" first thing. */ - if (!(argc > 1 + skip_args && !strcmp (argv[1 + skip_args], "-nl"))) - load_me = build_string ("loadup.el"); -#endif /* CANNOT_DUMP */ - } - -#ifdef QUANTIFY - if (initialized) - quantify_start_recording_data (); -#endif /* QUANTIFY */ - - initialized = 1; - - /* This never returns. */ - initial_command_loop (load_me); - /* NOTREACHED */ -} - - -/* Sort the args so we can find the most important ones - at the beginning of argv. */ - -/* First, here's a table of all the standard options. */ - -struct standard_args -{ - CONST char * CONST name; - CONST char * CONST longname; - int priority; - int nargs; -}; - -static struct standard_args standard_args[] = -{ - /* Handled by main_1 above: */ - { "-nl", "--no-shared-memory", 100, 0 }, - { "-t", "--terminal", 95, 1 }, - { "-nw", "--no-windows", 90, 0 }, - { "-batch", "--batch", 85, 0 }, - { "-debug-paths", "--debug-paths", 82, 0 }, - { "-help", "--help", 80, 0 }, - { "-version", "--version", 75, 0 }, - { "-V", 0, 75, 0 }, - { "-d", "--display", 80, 1 }, - { "-display", 0, 80, 1 }, - { "-NXHost", 0, 79, 0 }, - { "-MachLaunch", 0, 79, 0}, - - /* Handled by command-line-early in startup.el: */ - { "-q", "--no-init-file", 50, 0 }, - { "-unmapped", 0, 50, 0 }, - { "-no-init-file", 0, 50, 0 }, - { "-vanilla", "--vanilla", 50, 0 }, - { "-no-autoloads", "--no-autoloads", 50, 0 }, - { "-no-site-file", "--no-site-file", 40, 0 }, - { "-no-early-packages", "--no-early-packages", 35, 0 }, - { "-u", "--user", 30, 1 }, - { "-user", 0, 30, 1 }, - { "-debug-init", "--debug-init", 20, 0 }, - { "-debug-paths", "--debug-paths", 20, 0 }, - - /* Xt options: */ - { "-i", "--icon-type", 15, 0 }, - { "-itype", 0, 15, 0 }, - { "-iconic", "--iconic", 15, 0 }, - { "-bg", "--background-color", 10, 1 }, - { "-background", 0, 10, 1 }, - { "-fg", "--foreground-color", 10, 1 }, - { "-foreground", 0, 10, 1 }, - { "-bd", "--border-color", 10, 1 }, - { "-bw", "--border-width", 10, 1 }, - { "-ib", "--internal-border", 10, 1 }, - { "-ms", "--mouse-color", 10, 1 }, - { "-cr", "--cursor-color", 10, 1 }, - { "-fn", "--font", 10, 1 }, - { "-font", 0, 10, 1 }, - { "-g", "--geometry", 10, 1 }, - { "-geometry", 0, 10, 1 }, - { "-T", "--title", 10, 1 }, - { "-title", 0, 10, 1 }, - { "-name", "--name", 10, 1 }, - { "-xrm", "--xrm", 10, 1 }, - { "-r", "--reverse-video", 5, 0 }, - { "-rv", 0, 5, 0 }, - { "-reverse", 0, 5, 0 }, - { "-hb", "--horizontal-scroll-bars", 5, 0 }, - { "-vb", "--vertical-scroll-bars", 5, 0 }, - - /* These have the same priority as ordinary file name args, - so they are not reordered with respect to those. */ - { "-L", "--directory", 0, 1 }, - { "-directory", 0, 0, 1 }, - { "-l", "--load", 0, 1 }, - { "-load", 0, 0, 1 }, - { "-f", "--funcall", 0, 1 }, - { "-funcall", 0, 0, 1 }, - { "-eval", "--eval", 0, 1 }, - { "-insert", "--insert", 0, 1 }, - /* This should be processed after ordinary file name args and the like. */ - { "-kill", "--kill", -10, 0 }, -}; - -/* Reorder the elements of ARGV (assumed to have ARGC elements) - so that the highest priority ones come first. - Do not change the order of elements of equal priority. - If an option takes an argument, keep it and its argument together. */ - -static void -sort_args (int argc, char **argv) -{ - char **new_argv = xnew_array (char *, argc); - /* For each element of argv, - the corresponding element of options is: - 0 for an option that takes no arguments, - 1 for an option that takes one argument, etc. - -1 for an ordinary non-option argument. */ - int *options = xnew_array (int, argc); - int *priority = xnew_array (int, argc); - int to = 1; - int from; - int i; - int end_of_options_p = 0; - - /* Categorize all the options, - and figure out which argv elts are option arguments. */ - for (from = 1; from < argc; from++) - { - options[from] = -1; - priority[from] = 0; - /* Pseudo options "--" and "run-temacs" indicate end of options */ - if (!strcmp (argv[from], "--") || - !strcmp (argv[from], "run-temacs")) - end_of_options_p = 1; - if (!end_of_options_p && argv[from][0] == '-') - { - int match, thislen; - char *equals; - - /* Look for a match with a known old-fashioned option. */ - for (i = 0; i < countof (standard_args); i++) - if (!strcmp (argv[from], standard_args[i].name)) - { - options[from] = standard_args[i].nargs; - priority[from] = standard_args[i].priority; - if (from + standard_args[i].nargs >= argc) - fatal ("Option `%s' requires an argument\n", argv[from]); - from += standard_args[i].nargs; - goto done; - } - - /* Look for a match with a known long option. - MATCH is -1 if no match so far, -2 if two or more matches so far, - >= 0 (the table index of the match) if just one match so far. */ - if (argv[from][1] == '-') - { - match = -1; - thislen = strlen (argv[from]); - equals = strchr (argv[from], '='); - if (equals != 0) - thislen = equals - argv[from]; - - for (i = 0; i < countof (standard_args); i++) - if (standard_args[i].longname - && !strncmp (argv[from], standard_args[i].longname, - thislen)) - { - if (match == -1) - match = i; - else - match = -2; - } - - /* If we found exactly one match, use that. */ - if (match >= 0) - { - options[from] = standard_args[match].nargs; - priority[from] = standard_args[match].priority; - /* If --OPTION=VALUE syntax is used, - this option uses just one argv element. */ - if (equals != 0) - options[from] = 0; - if (from + options[from] >= argc) - fatal ("Option `%s' requires an argument\n", argv[from]); - from += options[from]; - } - } - done: ; - } - } - - /* Copy the arguments, in order of decreasing priority, to NEW_ARGV. */ - new_argv[0] = argv[0]; - while (to < argc) - { - int best = -1; - int best_priority = -9999; - - /* Find the highest priority remaining option. - If several have equal priority, take the first of them. */ - for (from = 1; from < argc; from++) - { - if (argv[from] != 0 && priority[from] > best_priority) - { - best_priority = priority[from]; - best = from; - } - /* Skip option arguments--they are tied to the options. */ - if (options[from] > 0) - from += options[from]; - } - - if (best < 0) - abort (); - - /* Copy the highest priority remaining option, with its args, to NEW_ARGV. */ - new_argv[to++] = argv[best]; - for (i = 0; i < options[best]; i++) - new_argv[to++] = argv[best + i + 1]; - - /* Clear out this option in ARGV. */ - argv[best] = 0; - for (i = 0; i < options[best]; i++) - argv[best + i + 1] = 0; - } - - memcpy (argv, new_argv, sizeof (char *) * argc); - xfree (new_argv); - xfree (options); - xfree (priority); -} - -static JMP_BUF run_temacs_catch; - -static int run_temacs_argc; -static char **run_temacs_argv; -static char *run_temacs_args; -static size_t run_temacs_argv_size; -static size_t run_temacs_args_size; - -DEFUN ("running-temacs-p", Frunning_temacs_p, 0, 0, 0, /* -True if running temacs. This means we are in the dumping stage. -This is false during normal execution of the `xemacs' program, and -becomes false once `run-emacs-from-temacs' is run. -*/ - ()) -{ - return run_temacs_argc >= 0 ? Qt : Qnil; -} - -DEFUN ("run-emacs-from-temacs", Frun_emacs_from_temacs, 0, MANY, 0, /* -Do not call this. It will reinitialize your XEmacs. You'll be sorry. -*/ -/* If this function is called from startup.el, it will be possible to run - temacs as an editor using 'temacs -batch -l loadup.el run-temacs', instead - of having to dump an emacs and then run that (when debugging emacs itself, - this can be much faster)). [Actually, the speed difference isn't that - much as long as your filesystem is local, and you don't end up with - a dumped version in case you want to rerun it. This function is most - useful when used as part of the `make all-elc' command. --ben] - This will "restart" emacs with the specified command-line arguments. - - Martin thinks this function is most useful when using debugging - tools like Purify or tcov that get confused by XEmacs' dumping. */ - (int nargs, Lisp_Object *args)) -{ - int ac; - CONST Extbyte *wampum; - int namesize; - int total_len; - Lisp_Object orig_invoc_name = Fcar (Vcommand_line_args); - CONST Extbyte **wampum_all = alloca_array (CONST Extbyte *, nargs); - int *wampum_all_len = alloca_array (int, nargs); - - assert (!gc_in_progress); - - if (run_temacs_argc < 0) - error ("I've lost my temacs-hood."); - - /* Need to convert the orig_invoc_name and all of the arguments - to external format. */ - - GET_STRING_EXT_DATA_ALLOCA (orig_invoc_name, FORMAT_OS, wampum, - namesize); - namesize++; - - for (ac = 0, total_len = namesize; ac < nargs; ac++) - { - CHECK_STRING (args[ac]); - GET_STRING_EXT_DATA_ALLOCA (args[ac], FORMAT_OS, - wampum_all[ac], - wampum_all_len[ac]); - wampum_all_len[ac]++; - total_len += wampum_all_len[ac]; - } - DO_REALLOC (run_temacs_args, run_temacs_args_size, total_len, char); - DO_REALLOC (run_temacs_argv, run_temacs_argv_size, nargs+1, char *); - - memcpy (run_temacs_args, wampum, namesize); - run_temacs_argv [0] = run_temacs_args; - for (ac = 0; ac < nargs; ac++) - { - memcpy (run_temacs_args + namesize, - wampum_all[ac], wampum_all_len[ac]); - run_temacs_argv [ac + 1] = run_temacs_args + namesize; - namesize += wampum_all_len[ac]; - } - run_temacs_argv [nargs + 1] = 0; - catchlist = NULL; /* Important! Otherwise free_cons() calls in - condition_case_unwind() may lead to GC death. */ - unbind_to (0, Qnil); /* this closes loadup.el */ - purify_flag = 0; - run_temacs_argc = nargs + 1; -#if 0 -#ifdef REPORT_PURE_USAGE - report_pure_usage (1, 0); -#else - report_pure_usage (0, 0); -#endif -#endif /* 0 */ - LONGJMP (run_temacs_catch, 1); - return Qnil; /* not reached; warning suppression */ -} - -/* ARGSUSED */ -int -main (int argc, char **argv, char **envp) -{ - int volatile vol_argc = argc; - char ** volatile vol_argv = argv; - char ** volatile vol_envp = envp; - /* This is hairy. We need to compute where the XEmacs binary was invoked - from because temacs initialization requires it to find the lisp - directories. The code that recomputes the path is guarded by the - restarted flag. There are three possible paths I've found so far - through this: - - temacs -- When running temacs for basic build stuff, the first main_1 - will be the only one invoked. It must compute the path else there - will be a very ugly bomb in startup.el (can't find obvious location - for doc-directory data-directory, etc.). - - temacs w/ run-temacs on the command line -- This is run to bytecompile - all the out of date dumped lisp. It will execute both of the main_1 - calls and the second one must not touch the first computation because - argc/argv are hosed the second time through. - - xemacs -- Only the second main_1 is executed. The invocation path must - computed but this only matters when running in place or when running - as a login shell. - - As a bonus for straightening this out, XEmacs can now be run in place - as a login shell. This never used to work. - - As another bonus, we can now guarantee that - (concat invocation-directory invocation-name) contains the filename - of the XEmacs binary we are running. This can now be used in a - definite test for out of date dumped files. -slb */ - int restarted = 0; -#ifdef QUANTIFY - quantify_stop_recording_data (); - quantify_clear_data (); -#endif /* QUANTIFY */ - - suppress_early_error_handler_backtrace = 0; - lim_data = 0; /* force reinitialization of this variable */ - - /* Lisp_Object must fit in a word; check VALBITS and GCTYPEBITS */ - assert (sizeof (Lisp_Object) == sizeof (void *)); - -#ifdef LINUX_SBRK_BUG - sbrk (1); -#endif - - if (!initialized) - { -#ifdef DOUG_LEA_MALLOC - mallopt (M_MMAP_MAX, 0); -#endif - run_temacs_argc = 0; - if (! SETJMP (run_temacs_catch)) - { - main_1 (vol_argc, vol_argv, vol_envp, 0); - } - /* run-emacs-from-temacs called */ - restarted = 1; - vol_argc = run_temacs_argc; - vol_argv = run_temacs_argv; -#ifdef _SCO_DS - /* This makes absolutely no sense to anyone involved. There are - several people using this stuff. We've compared versions on - everything we can think of. We can find no difference. - However, on both my systems environ is a plain old global - variable initialized to zero. _environ is the one that - contains pointers to the actual environment. - - Since we can't figure out the difference (and we're hours - away from a release), this takes a very cowardly approach and - is bracketed with both a system specific preprocessor test - and a runtime "do you have this problem" test - - 06/20/96 robertl@dgii.com */ - { - extern char *_environ; - if ((unsigned) environ == 0) - environ=_environ; - } -#endif /* _SCO_DS */ - vol_envp = environ; - } -#ifdef RUN_TIME_REMAP - else - /* obviously no-one uses this because where it was before initialized was - *always* true */ - run_time_remap (argv[0]); -#endif - -#ifdef DOUG_LEA_MALLOC - if (initialized && (malloc_state_ptr != NULL)) - { - int rc = malloc_set_state (malloc_state_ptr); - if (rc != 0) - { - fprintf (stderr, "malloc_set_state failed, rc = %d\n", rc); - abort (); - } -#if 0 - free (malloc_state_ptr); -#endif - /* mmap works in glibc-2.1, glibc-2.0 (Non-Mule only) and Linux libc5 */ -#if (defined(__GLIBC__) && __GLIBC_MINOR__ >= 1) || \ - defined(_NO_MALLOC_WARNING_) || \ - (defined(__GLIBC__) && __GLIBC_MINOR__ < 1 && !defined(MULE)) || \ - defined(DEBUG_DOUG_LEA_MALLOC) - mallopt (M_MMAP_MAX, 64); -#endif -#ifdef REL_ALLOC - r_alloc_reinit (); -#endif - } -#endif /* DOUG_LEA_MALLOC */ - - run_temacs_argc = -1; - - main_1 (vol_argc, vol_argv, vol_envp, restarted); - return 0; /* unreached */ -} - - -/* Dumping apparently isn't supported by versions of GCC >= 2.8. */ -/* The following needs conditionalization on whether either XEmacs or */ -/* various system shared libraries have been built and linked with */ -/* GCC >= 2.8. -slb */ -#if defined(GNU_MALLOC) -static void -voodoo_free_hook (void *mem) -{ - /* Disable all calls to free() when XEmacs is exiting and it doesn't */ - /* matter. */ - __free_hook = voodoo_free_hook; -} -#endif - -DEFUN ("kill-emacs", Fkill_emacs, 0, 1, "P", /* -Exit the XEmacs job and kill it. Ask for confirmation, without argument. -If ARG is an integer, return ARG as the exit program code. -If ARG is a string, stuff it as keyboard input. - -The value of `kill-emacs-hook', if not void, -is a list of functions (of no args), -all of which are called before XEmacs is actually killed. -*/ - (arg)) -{ - /* This function can GC */ - struct gcpro gcpro1; - - GCPRO1 (arg); - - if (feof (stdin)) - arg = Qt; - - if (!preparing_for_armageddon && !noninteractive) - run_hook (Qkill_emacs_hook); - - /* make sure no quitting from now on!! */ - dont_check_for_quit = 1; - Vinhibit_quit = Qt; - - if (!preparing_for_armageddon) - { - Lisp_Object concons, nextcons; - - /* Normally, go ahead and delete all the consoles now. - Some unmentionably lame window systems (MS Wwwww...... eek, - I can't even say it) don't properly clean up after themselves, - and even for those that do, it might be cleaner this way. - If we're going down, however, we don't do this (might - be too dangerous), and if we get a crash somewhere within - this loop, we'll still autosave and won't try this again. */ - - LIST_LOOP_DELETING(concons, nextcons, Vconsole_list) - { - /* There is very little point in deleting the stream console. - It uses stdio, which should flush any buffered output and - something can only go wrong. -slb */ - /* I changed my mind. There's a stupid hack in close to add - a trailing newline. */ - /*if (!CONSOLE_STREAM_P (XCONSOLE (XCAR (concons))))*/ - delete_console_internal (XCONSOLE (XCAR (concons)), 1, 1, 0); - } - } - - UNGCPRO; - - shut_down_emacs (0, ((STRINGP (arg)) ? arg : Qnil)); - -#if defined(GNU_MALLOC) - __free_hook = voodoo_free_hook; -#endif - - exit ((INTP (arg)) ? XINT (arg) : 0); - /* NOTREACHED */ - return Qnil; /* I'm sick of the compiler warning */ -} - -/* Perform an orderly shutdown of XEmacs. Autosave any modified - buffers, kill any child processes, clean up the terminal modes (if - we're in the foreground), and other stuff like that. Don't perform - any redisplay; this may be called when XEmacs is shutting down in - the background, or after its X connection has died. - - If SIG is a signal number, print a message for it. - - This is called by fatal signal handlers, X protocol error handlers, - and Fkill_emacs. */ -static void -shut_down_emacs (int sig, Lisp_Object stuff) -{ - /* This function can GC */ - /* Prevent running of hooks and other non-essential stuff - from now on. */ - preparing_for_armageddon = 1; - - /* In case frames or windows are screwed up, avoid assertion - failures here */ - Vinhibit_quit = Qt; - -#ifdef QUANTIFY - quantify_stop_recording_data (); -#endif /* QUANTIFY */ - -#if 0 - /* This is absolutely the most important thing to do, so make sure - we do it now, before anything else. We might have crashed and - be in a weird inconsistent state, and potentially anything could - set off another protection fault and cause us to bail out - immediately. */ - /* I'm not removing the code entirely, yet. We have run up against - a spate of problems in diagnosing crashes due to crashes within - crashes. It has very definitely been determined that code called - during auto-saving cannot work if XEmacs crashed inside of GC. - We already auto-save on an itimer so there cannot be too much - unsaved stuff around, and if we get better crash reports we might - be able to get more problems fixed so I'm disabling this. -slb */ - Fdo_auto_save (Qt, Qnil); /* do this before anything hazardous */ -#endif - - fflush (stdout); - reset_all_consoles (); - if (sig && sig != SIGTERM) - { - stderr_out ("\nFatal error (%d).\n", sig); - stderr_out - ("Your files have been auto-saved.\n" - "Use `M-x recover-session' to recover them.\n" - "\n" -#ifdef INFODOCK - "Please report this bug by selecting `Report-Bug' in the InfoDock\n" - "menu.\n" -#else - "Please report this bug by running the send-pr script included\n" - "with XEmacs, or selecting `Send Bug Report' from the help menu.\n" - "As a last resort send ordinary email to `crashes@xemacs.org'.\n" -#endif - "*MAKE SURE* to include the information in the command\n" - "M-x describe-installation.\n" - "\n" - "If at all possible, *please* try to obtain a C stack backtrace;\n" - "it will help us immensely in determining what went wrong.\n" - "To do this, locate the core file that was produced as a result\n" - "of this crash (it's usually called `core' and is located in the\n" - "directory in which you started the editor, or maybe in your home\n" - "directory), and type\n" - "\n" - " gdb "); - { - CONST char *name; - char *dir = 0; - - /* Now try to determine the actual path to the executable, - to try to make the backtrace-determination process as foolproof - as possible. */ - if (GC_STRINGP (Vinvocation_name)) - name = (char *) XSTRING_DATA (Vinvocation_name); - else - name = "xemacs"; - if (GC_STRINGP (Vinvocation_directory)) - dir = (char *) XSTRING_DATA (Vinvocation_directory); - if (!dir || dir[0] != '/') - stderr_out ("`which %s`", name); - else if (dir[strlen (dir) - 1] != '/') - stderr_out ("%s/%s", dir, name); - else - stderr_out ("%s%s", dir, name); - } - stderr_out - (" core\n\n" - "then type `where' when the debugger prompt comes up.\n" - "(If you don't have GDB on your system, you might have DBX,\n" - "or XDB, or SDB. A similar procedure should work for all of\n" - "these. Ask your system administrator if you need more help.)\n"); - } - - stuff_buffered_input (stuff); - - kill_buffer_processes (Qnil); - -#ifdef CLASH_DETECTION - unlock_all_files (); -#endif - -#ifdef TOOLTALK - tt_session_quit (tt_default_session ()); -#if 0 - /* The following crashes when built on X11R5 and run on X11R6 */ - tt_close (); -#endif -#endif /* TOOLTALK */ - -} - - -#ifndef CANNOT_DUMP -/* Nothing like this can be implemented on an Apollo. - What a loss! */ - -extern char my_edata[]; - -#ifdef HAVE_SHM - -DEFUN ("dump-emacs-data", Fdump_emacs_data, 1, 1, 0, /* -Dump current state of XEmacs into data file FILENAME. -This function exists on systems that use HAVE_SHM. -*/ - (intoname)) -{ - /* This function can GC */ - int opurify; - struct gcpro gcpro1; - GCPRO1 (intoname); - - CHECK_STRING (intoname); - intoname = Fexpand_file_name (intoname, Qnil); - - opurify = purify_flag; - purify_flag = 0; - - fflush (stderr); - fflush (stdout); - - disksave_object_finalization (); - release_breathing_space (); - - /* Tell malloc where start of impure now is */ - /* Also arrange for warnings when nearly out of space. */ -#ifndef SYSTEM_MALLOC - memory_warnings (my_edata, malloc_warning); -#endif - UNGCPRO; - map_out_data (XSTRING_DATA (intoname)); - - purify_flag = opurify; - - return Qnil; -} - -#else /* not HAVE_SHM */ -extern void disable_free_hook (void); - -DEFUN ("dump-emacs", Fdump_emacs, 2, 2, 0, /* -Dump current state of XEmacs into executable file FILENAME. -Take symbols from SYMFILE (presumably the file you executed to run XEmacs). -This is used in the file `loadup.el' when building XEmacs. - -Remember to set `command-line-processed' to nil before dumping -if you want the dumped XEmacs to process its command line -and announce itself normally when it is run. -*/ - (intoname, symname)) -{ - /* This function can GC */ - struct gcpro gcpro1, gcpro2; - int opurify; - - GCPRO2 (intoname, symname); - -#ifdef FREE_CHECKING - Freally_free (Qnil); - - /* When we're dumping, we can't use the debugging free() */ - disable_free_hook (); -#endif - - CHECK_STRING (intoname); - intoname = Fexpand_file_name (intoname, Qnil); - if (!NILP (symname)) - { - CHECK_STRING (symname); - if (XSTRING_LENGTH (symname) > 0) - symname = Fexpand_file_name (symname, Qnil); - else - symname = Qnil; - } - - opurify = purify_flag; - purify_flag = 0; - -#ifdef DEBUG_XEMACS - report_pure_usage (1, 1); -#else - report_pure_usage (0, 1); -#endif - - fflush (stderr); - fflush (stdout); - - disksave_object_finalization (); - release_breathing_space (); - - /* Tell malloc where start of impure now is */ - /* Also arrange for warnings when nearly out of space. */ -#ifndef SYSTEM_MALLOC - memory_warnings (my_edata, malloc_warning); -#endif - - UNGCPRO; - -#if defined (MSDOS) && defined (EMX) - { - int fd = open ((char *) XSTRING_DATA (intoname), - O_WRONLY|O_CREAT|O_TRUNC, S_IREAD|S_IWRITE); - if (!fd) { - error ("Failure operating on %s", XSTRING_DATA (intoname)); - } else { - _core (fd); - close (fd); - } - } -#else /* not MSDOS and EMX */ - { - char *intoname_ext; - char *symname_ext; - - GET_C_STRING_FILENAME_DATA_ALLOCA (intoname, intoname_ext); - if (STRINGP (symname)) - GET_C_STRING_FILENAME_DATA_ALLOCA (symname, symname_ext); - else - symname_ext = 0; - - garbage_collect_1 (); -#ifdef DOUG_LEA_MALLOC - malloc_state_ptr = malloc_get_state (); -#endif - /* here we break our rule that the filename conversion should - be performed at the actual time that the system call is made. - It's a whole lot easier to do the conversion here than to - modify all the unexec routines to ensure that filename - conversion is applied everywhere. Don't worry about memory - leakage because this call only happens once. */ - unexec (intoname_ext, symname_ext, (uintptr_t) my_edata, 0, 0); -#ifdef DOUG_LEA_MALLOC - free (malloc_state_ptr); -#endif - } -#endif /* not MSDOS and EMX */ - - purify_flag = opurify; - - return Qnil; -} - -#endif /* not HAVE_SHM */ - -#endif /* not CANNOT_DUMP */ - -#ifndef SEPCHAR -#define SEPCHAR ':' -#endif - -/* Split STRING into a list of substrings. The substrings are the - parts of original STRING separated by SEPCHAR. */ -static Lisp_Object -split_string_by_emchar_1 (CONST Bufbyte *string, Bytecount size, - Emchar sepchar) -{ - Lisp_Object result = Qnil; - CONST Bufbyte *end = string + size; - - while (1) - { - CONST Bufbyte *p = string; - while (p < end) - { - if (charptr_emchar (p) == sepchar) - break; - INC_CHARPTR (p); - } - result = Fcons (make_string (string, p - string), result); - if (p < end) - { - string = p; - INC_CHARPTR (string); /* skip sepchar */ - } - else - break; - } - return Fnreverse (result); -} - -/* The same as the above, except PATH is an external C string (it is - converted as FORMAT_FILENAME), and sepchar is hardcoded to SEPCHAR - (':' or whatever). */ -Lisp_Object -decode_path (CONST char *path) -{ - int len; - Bufbyte *newpath; - if (!path) - return Qnil; - - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (path, newpath); - - len = strlen ((const char *) newpath); - /* #### Does this make sense? It certainly does for - decode_env_path(), but it looks dubious here. Does any code - depend on decode_path("") returning nil instead of an empty - string? */ - if (!len) - return Qnil; - - return split_string_by_emchar_1 (newpath, (Bytecount)len, SEPCHAR); -} - -Lisp_Object -decode_env_path (CONST char *evarname, CONST char *default_) -{ - CONST char *path = 0; - if (evarname) - path = egetenv (evarname); - if (!path) - path = default_; - return decode_path (path); -} - -/* Ben thinks this function should not exist or be exported to Lisp. - We use it to define split-path-string in subr.el (not!). */ - -DEFUN ("split-string-by-char", Fsplit_string_by_char, 1, 2, 0, /* -Split STRING into a list of substrings originally separated by SEPCHAR. -*/ - (string, sepchar)) -{ - CHECK_STRING (string); - CHECK_CHAR (sepchar); - return split_string_by_emchar_1 (XSTRING_DATA (string), - XSTRING_LENGTH (string), - XCHAR (sepchar)); -} - -/* #### This was supposed to be in subr.el, but is used VERY early in - the bootstrap process, so it goes here. Damn. */ - -DEFUN ("split-path", Fsplit_path, 1, 1, 0, /* -Explode a search path into a list of strings. -The path components are separated with the characters specified -with `path-separator'. -*/ - (path)) -{ - CHECK_STRING (path); - - while (!STRINGP (Vpath_separator) - || (XSTRING_CHAR_LENGTH (Vpath_separator) != 1)) - Vpath_separator = signal_simple_continuable_error - ("`path-separator' should be set to a single-character string", - Vpath_separator); - - return (split_string_by_emchar_1 - (XSTRING_DATA (path), XSTRING_LENGTH (path), - charptr_emchar (XSTRING_DATA (Vpath_separator)))); -} - -DEFUN ("noninteractive", Fnoninteractive, 0, 0, 0, /* -Non-nil return value means XEmacs is running without interactive terminal. -*/ - ()) -{ - return noninteractive ? Qt : Qnil; -} - -/* This flag is useful to define if you're under a debugger; this way, you - can put a breakpoint of assert_failed() and debug multiple problems - in one session without having to recompile. */ -/* #define ASSERTIONS_DONT_ABORT */ - -#ifdef USE_ASSERTIONS -/* This highly dubious kludge ... shut up Jamie, I'm tired of your slagging. */ - -DOESNT_RETURN -assert_failed (CONST char *file, int line, CONST char *expr) -{ - stderr_out ("Fatal error: assertion failed, file %s, line %d, %s\n", - file, line, expr); -#undef abort /* avoid infinite #define loop... */ -#if defined (WINDOWSNT) && defined (DEBUG_XEMACS) - DebugBreak (); -#elif !defined (ASSERTIONS_DONT_ABORT) - abort (); -#endif -} -#endif /* USE_ASSERTIONS */ - -#ifdef QUANTIFY -DEFUN ("quantify-start-recording-data", Fquantify_start_recording_data, - 0, 0, "", /* -Start recording Quantify data. -*/ - ()) -{ - quantify_start_recording_data (); - return Qnil; -} - -DEFUN ("quantify-stop-recording-data", Fquantify_stop_recording_data, - 0, 0, "", /* -Stop recording Quantify data. -*/ - ()) -{ - quantify_stop_recording_data (); - return Qnil; -} - -DEFUN ("quantify-clear-data", Fquantify_clear_data, 0, 0, "", /* -Clear all Quantify data. -*/ - ()) -{ - quantify_clear_data (); - return Qnil; -} -#endif /* QUANTIFY */ - -void -syms_of_emacs (void) -{ -#ifndef CANNOT_DUMP -#ifdef HAVE_SHM - DEFSUBR (Fdump_emacs_data); -#else - DEFSUBR (Fdump_emacs); -#endif -#endif /* !CANNOT_DUMP */ - - DEFSUBR (Frun_emacs_from_temacs); - DEFSUBR (Frunning_temacs_p); - DEFSUBR (Finvocation_name); - DEFSUBR (Finvocation_directory); - DEFSUBR (Fkill_emacs); - DEFSUBR (Fnoninteractive); - -#ifdef QUANTIFY - DEFSUBR (Fquantify_start_recording_data); - DEFSUBR (Fquantify_stop_recording_data); - DEFSUBR (Fquantify_clear_data); -#endif /* QUANTIFY */ - - DEFSUBR (Fsplit_string_by_char); - DEFSUBR (Fsplit_path); /* #### */ - - defsymbol (&Qkill_emacs_hook, "kill-emacs-hook"); - defsymbol (&Qsave_buffers_kill_emacs, "save-buffers-kill-emacs"); -} - -void -vars_of_emacs (void) -{ - DEFVAR_BOOL ("suppress-early-error-handler-backtrace", - &suppress_early_error_handler_backtrace /* -Non-nil means early error handler shouldn't print a backtrace. -*/ ); - - DEFVAR_LISP ("command-line-args", &Vcommand_line_args /* -Args passed by shell to XEmacs, as a list of strings. -*/ ); - - DEFVAR_LISP ("invocation-name", &Vinvocation_name /* -The program name that was used to run XEmacs. -Any directory names are omitted. -*/ ); - - DEFVAR_LISP ("invocation-directory", &Vinvocation_directory /* -The directory in which the XEmacs executable was found, to run it. -The value is simply the program name if that directory's name is not known. -*/ ); - - DEFVAR_LISP ("invocation-path", &Vinvocation_path /* -The path in which the XEmacs executable was found, to run it. -The value is simply the value of environment variable PATH on startup -if XEmacs was found there. -*/ ); - -#if 0 /* FSFmacs */ - xxDEFVAR_LISP ("installation-directory", &Vinstallation_directory, - "A directory within which to look for the `lib-src' and `etc' directories.\n" -"This is non-nil when we can't find those directories in their standard\n" -"installed locations, but we can find them\n" -"near where the XEmacs executable was found."); -#endif - - DEFVAR_LISP ("system-type", &Vsystem_type /* -Symbol indicating type of operating system you are using. -*/ ); - Vsystem_type = intern (SYSTEM_TYPE); - Fprovide (intern(SYSTEM_TYPE)); - -#ifndef EMACS_CONFIGURATION -# define EMACS_CONFIGURATION "UNKNOWN" -#endif - DEFVAR_LISP ("system-configuration", &Vsystem_configuration /* -String naming the configuration XEmacs was built for. -*/ ); - Vsystem_configuration = Fpurecopy (build_string (EMACS_CONFIGURATION)); - -#ifndef EMACS_CONFIG_OPTIONS -# define EMACS_CONFIG_OPTIONS "UNKNOWN" -#endif - DEFVAR_LISP ("system-configuration-options", &Vsystem_configuration_options /* -String containing the configuration options XEmacs was built with. -*/ ); - Vsystem_configuration_options = Fpurecopy (build_string - (EMACS_CONFIG_OPTIONS)); - - DEFVAR_LISP ("emacs-major-version", &Vemacs_major_version /* -Major version number of this version of Emacs, as an integer. -Warning: this variable did not exist in Emacs versions earlier than: - FSF Emacs: 19.23 - XEmacs: 19.10 -*/ ); - Vemacs_major_version = make_int (EMACS_MAJOR_VERSION); - - DEFVAR_LISP ("emacs-minor-version", &Vemacs_minor_version /* -Minor version number of this version of Emacs, as an integer. -Warning: this variable did not exist in Emacs versions earlier than: - FSF Emacs: 19.23 - XEmacs: 19.10 -*/ ); - Vemacs_minor_version = make_int (EMACS_MINOR_VERSION); - - DEFVAR_LISP ("emacs-beta-version", &Vemacs_beta_version /* -Beta number of this version of Emacs, as an integer. -The value is nil if this is an officially released version of XEmacs. -Warning: this variable does not exist in FSF Emacs or in XEmacs versions -earlier than 20.3. -*/ ); -#ifdef EMACS_BETA_VERSION - Vemacs_beta_version = make_int (EMACS_BETA_VERSION); -#else - Vemacs_beta_version = Qnil; -#endif - -#ifdef INFODOCK - DEFVAR_LISP ("infodock-major-version", &Vinfodock_major_version /* -Major version number of this InfoDock release. -*/ ); - Vinfodock_major_version = make_int (INFODOCK_MAJOR_VERSION); - - DEFVAR_LISP ("infodock-minor-version", &Vinfodock_minor_version /* -Minor version number of this InfoDock release. -*/ ); - Vinfodock_minor_version = make_int (INFODOCK_MINOR_VERSION); - - DEFVAR_LISP ("infodock-build-version", &Vinfodock_build_version /* -Build version of this InfoDock release. -*/ ); - Vinfodock_build_version = make_int (INFODOCK_BUILD_VERSION); -#endif - - DEFVAR_LISP ("xemacs-codename", &Vxemacs_codename /* -Codename of this version of Emacs (a string). -*/ ); -#ifndef XEMACS_CODENAME -#define XEMACS_CODENAME "Noname" -#endif - Vxemacs_codename = Fpurecopy (build_string (XEMACS_CODENAME)); - - DEFVAR_BOOL ("noninteractive", &noninteractive1 /* -Non-nil means XEmacs is running without interactive terminal. -*/ ); - - DEFVAR_BOOL ("inhibit-early-packages", &inhibit_early_packages /* -Set to non-nil when the early packages should not be respected at startup. -*/ ); - - DEFVAR_BOOL ("inhibit-autoloads", &inhibit_autoloads /* -Set to non-nil when autoloads should not be loaded at startup. -*/ ); - - DEFVAR_BOOL ("debug-paths", &debug_paths /* -Set to non-nil when debug information about paths should be printed. -*/ ); - - DEFVAR_BOOL ("inhibit-site-lisp", &inhibit_site_lisp /* -Set to non-nil when the site-lisp should not be searched at startup. -*/ ); -#ifdef INHIBIT_SITE_LISP - inhibit_site_lisp = 1; -#endif - - DEFVAR_BOOL ("inhibit-site-modules", &inhibit_site_modules /* -Set to non-nil when site-modules should not be searched at startup. -*/ ); -#ifdef INHIBIT_SITE_MODULES - inhibit_site_modules = 1; -#endif - - DEFVAR_INT ("emacs-priority", &emacs_priority /* -Priority for XEmacs to run at. -This value is effective only if set before XEmacs is dumped, -and only if the XEmacs executable is installed with setuid to permit -it to change priority. (XEmacs sets its uid back to the real uid.) -Currently, you need to define SET_EMACS_PRIORITY in `config.h' -before you compile XEmacs, to enable the code for this feature. -*/ ); - emacs_priority = 0; - - DEFVAR_CONST_LISP ("internal-error-checking", &Vinternal_error_checking /* -Internal error checking built-in into this instance of XEmacs. -This is a list of symbols, initialized at build-time. Legal symbols -are: - -extents - check extents prior to each extent change; -typecheck - check types strictly, aborting in case of error; -malloc - check operation of malloc; -gc - check garbage collection; -bufpos - check buffer positions. -*/ ); - Vinternal_error_checking = Qnil; -#ifdef ERROR_CHECK_EXTENTS - Vinternal_error_checking = Fcons (intern ("extents"), - Vinternal_error_checking); -#endif -#ifdef ERROR_CHECK_TYPECHECK - Vinternal_error_checking = Fcons (intern ("typecheck"), - Vinternal_error_checking); -#endif -#ifdef ERROR_CHECK_MALLOC - Vinternal_error_checking = Fcons (intern ("malloc"), - Vinternal_error_checking); -#endif -#ifdef ERROR_CHECK_GC - Vinternal_error_checking = Fcons (intern ("gc"), - Vinternal_error_checking); -#endif -#ifdef ERROR_CHECK_BUFPOS - Vinternal_error_checking = Fcons (intern ("bufpos"), - Vinternal_error_checking); -#endif - Vinternal_error_checking = Fpurecopy (Vinternal_error_checking); - - DEFVAR_LISP ("path-separator", &Vpath_separator /* -The directory separator in search paths, as a string. -*/ ); - { - char c = SEPCHAR; - Vpath_separator = make_string ((Bufbyte *)&c, 1); - } -} - -void -complex_vars_of_emacs (void) -{ - /* This is all related to path searching. */ - - DEFVAR_LISP ("emacs-program-name", &Vemacs_program_name /* -*Name of the Emacs variant. -For example, this may be \"xemacs\" or \"infodock\". -This is mainly meant for use in path searching. -*/ ); - Vemacs_program_name = build_string ((char *) PATH_PROGNAME); - - DEFVAR_LISP ("emacs-program-version", &Vemacs_program_version /* -*Version of the Emacs variant. -This typically has the form XX.XX[-bXX]. -This is mainly meant for use in path searching. -*/ ); - Vemacs_program_version = build_string ((char *) PATH_VERSION); - - DEFVAR_LISP ("exec-path", &Vexec_path /* -*List of directories to search programs to run in subprocesses. -Each element is a string (directory name) or nil (try default directory). -*/ ); - Vexec_path = Qnil; - - DEFVAR_LISP ("exec-directory", &Vexec_directory /* -*Directory of architecture-dependent files that come with XEmacs, -especially executable programs intended for XEmacs to invoke. -*/ ); - Vexec_directory = Qnil; - - DEFVAR_LISP ("configure-exec-directory", &Vconfigure_exec_directory /* -For internal use by the build procedure only. -configure's idea of what EXEC-DIRECTORY will be. -*/ ); -#ifdef PATH_EXEC - Vconfigure_exec_directory = Ffile_name_as_directory - (build_string ((char *) PATH_EXEC)); -#else - Vconfigure_exec_directory = Qnil; -#endif - - DEFVAR_LISP ("lisp-directory", &Vlisp_directory /* -*Directory of core Lisp files that come with XEmacs. -*/ ); - Vlisp_directory = Qnil; - - DEFVAR_LISP ("configure-lisp-directory", &Vconfigure_lisp_directory /* -For internal use by the build procedure only. -configure's idea of what LISP-DIRECTORY will be. -*/ ); -#ifdef PATH_LOADSEARCH - Vconfigure_lisp_directory = Ffile_name_as_directory - (build_string ((char *) PATH_LOADSEARCH)); -#else - Vconfigure_lisp_directory = Qnil; -#endif - - DEFVAR_LISP ("module-directory", &Vmodule_directory /* -*Directory of core dynamic modules that come with XEmacs. -*/ ); - Vmodule_directory = Qnil; - - DEFVAR_LISP ("configure-module-directory", &Vconfigure_module_directory /* -For internal use by the build procedure only. -configure's idea of what MODULE-DIRECTORY will be. -*/ ); -#ifdef PATH_MODULESEARCH - Vconfigure_module_directory = Ffile_name_as_directory - (build_string ((char *) PATH_MODULESEARCH)); -#else - Vconfigure_module_directory = Qnil; -#endif - - DEFVAR_LISP ("configure-package-path", &Vconfigure_package_path /* -For internal use by the build procedure only. -configure's idea of what the package path will be. -*/ ); -#ifdef PATH_PACKAGEPATH - Vconfigure_package_path = decode_path (PATH_PACKAGEPATH); -#else - Vconfigure_package_path = Qnil; -#endif - - DEFVAR_LISP ("data-directory", &Vdata_directory /* -*Directory of architecture-independent files that come with XEmacs, -intended for XEmacs to use. -Use of this variable in new code is almost never correct. See the -function `locate-data-directory' and the variable `data-directory-list'. -*/ ); - Vdata_directory = Qnil; - - DEFVAR_LISP ("configure-data-directory", &Vconfigure_data_directory /* -For internal use by the build procedure only. -configure's idea of what DATA-DIRECTORY will be. -*/ ); -#ifdef PATH_DATA - Vconfigure_data_directory = Ffile_name_as_directory - (build_string ((char *) PATH_DATA)); -#else - Vconfigure_data_directory = Qnil; -#endif - - DEFVAR_LISP ("data-directory-list", &Vdata_directory_list /* -*List of directories of architecture-independent files that come with XEmacs -or were installed as packages, and are intended for XEmacs to use. -*/ ); - Vdata_directory_list = Qnil; - -#ifdef CLASH_DETECTION - DEFVAR_LISP ("configure-lock-directory", &Vconfigure_lock_directory /* -For internal use by the build procedure only. -configure's idea of what LOCK-DIRECTORY will be. -*/ ); -#ifdef PATH_LOCK - Vconfigure_lock_directory = Ffile_name_as_directory - (build_string ((char *) PATH_LOCK)); -#else - Vconfigure_lock_directory = Qnil; -#endif -#endif /* CLASH_DETECTION */ - - DEFVAR_LISP ("site-directory", &Vsite_directory /* -*Directory of site-specific Lisp files that come with XEmacs. -*/ ); - Vsite_directory = Qnil; - - DEFVAR_LISP ("configure-site-directory", &Vconfigure_site_directory /* -For internal use by the build procedure only. -configure's idea of what SITE-DIRECTORY will be. -*/ ); -#ifdef PATH_SITE - Vconfigure_site_directory = Ffile_name_as_directory - (build_string ((char *) PATH_SITE)); -#else - Vconfigure_site_directory = Qnil; -#endif - - DEFVAR_LISP ("site-module-directory", &Vsite_module_directory /* -*Directory of site-specific loadable modules that come with XEmacs. -*/ ); - Vsite_module_directory = Qnil; - - DEFVAR_LISP ("configure-site-module-directory", &Vconfigure_site_module_directory /* -For internal use by the build procedure only. -configure's idea of what SITE-DIRECTORY will be. -*/ ); -#ifdef PATH_SITE_MODULES - Vconfigure_site_module_directory = Ffile_name_as_directory - (build_string ((char *) PATH_SITE_MODULES)); -#else - Vconfigure_site_module_directory = Qnil; -#endif - - DEFVAR_LISP ("doc-directory", &Vdoc_directory /* -*Directory containing the DOC file that comes with XEmacs. -This is usually the same as exec-directory. -*/ ); - Vdoc_directory = Qnil; - - DEFVAR_LISP ("configure-doc-directory", &Vconfigure_doc_directory /* -For internal use by the build procedure only. -configure's idea of what DOC-DIRECTORY will be. -*/ ); -#ifdef PATH_DOC - Vconfigure_doc_directory = Ffile_name_as_directory - (build_string ((char *) PATH_DOC)); -#else - Vconfigure_doc_directory = Qnil; -#endif - - DEFVAR_LISP ("configure-exec-prefix-directory", &Vconfigure_exec_prefix_directory /* -For internal use by the build procedure only. -configure's idea of what EXEC-PREFIX-DIRECTORY will be. -*/ ); -#ifdef PATH_EXEC_PREFIX - Vconfigure_exec_prefix_directory = Ffile_name_as_directory - (build_string ((char *) PATH_EXEC_PREFIX)); -#else - Vconfigure_exec_prefix_directory = Qnil; -#endif - - DEFVAR_LISP ("configure-prefix-directory", &Vconfigure_prefix_directory /* -For internal use by the build procedure only. -configure's idea of what PREFIX-DIRECTORY will be. -*/ ); -#ifdef PATH_PREFIX - Vconfigure_prefix_directory = Ffile_name_as_directory - (build_string ((char *) PATH_PREFIX)); -#else - Vconfigure_prefix_directory = Qnil; -#endif - - DEFVAR_LISP ("configure-info-directory", &Vconfigure_info_directory /* -For internal use by the build procedure only. -This is the name of the directory in which the build procedure installed -Emacs's info files; the default value for Info-default-directory-list -includes this. -*/ ); -#ifdef PATH_INFO - Vconfigure_info_directory = - Ffile_name_as_directory (build_string (PATH_INFO)); -#else - Vconfigure_info_directory = Qnil; -#endif - - DEFVAR_LISP ("configure-info-path", &Vconfigure_info_path /* -The configured initial path for info documentation. -*/ ); -#ifdef PATH_INFOPATH - Vconfigure_info_path = decode_path (PATH_INFOPATH); -#else - Vconfigure_info_path = Qnil; -#endif -} - -#ifdef __sgi -/* This is so tremendously ugly I'd puke. But then, it works. - * The target is to override the static constructor from the - * libiflPNG.so library which is maskerading as libz, and - * cores on us when re-started from the dumped executable. - * This will have to go for 21.1 -- OG. - */ -void __sti__iflPNGFile_c___() -{ -} - -#endif diff --git a/src/emodules.c b/src/emodules.c deleted file mode 100644 index 1a5d896..0000000 --- a/src/emodules.c +++ /dev/null @@ -1,579 +0,0 @@ -/* emodules.c - Support routines for dynamic module loading -(C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. - -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. */ - -#include "emodules.h" -#include "sysdll.h" - -#ifdef HAVE_SHLIB - -/* CE-Emacs version number */ -Lisp_Object Vmodule_version; - -/* Do we do our work quietly? */ -int load_modules_quietly; - -/* Load path */ -Lisp_Object Vmodule_load_path; - -typedef struct _emodules_list -{ - int used; /* Is this slot used? */ - char *soname; /* Name of the shared object loaded (full path) */ - char *modname; /* The name of the module */ - char *modver; /* The version that the module is at */ - char *modtitle; /* How the module announces itself */ - dll_handle dlhandle; /* Dynamic lib handle */ -} emodules_list; - -static int emodules_depth; -static dll_handle dlhandle; -static emodules_list *modules; -static int modnum; - -static int find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int make_or_find); -static Lisp_Object module_load_unwind (Lisp_Object); -static void attempt_module_delete (int mod); - -DEFUN ("load-module", Fload_module, 1, 3, "FLoad dynamic module: ", /* -Load in a C Emacs Extension module named FILE. -The optional NAME and VERSION are used to identify specific modules. - -This function is similar in intent to `load' except that it loads in -pre-compiled C or C++ code, using dynamic shared objects. If NAME is -specified, then the module is only loaded if its internal name matches -the NAME specified. If VERSION is specified, then the module is only -loaded if it matches that VERSION. This function will check to make -sure that the same module is not loaded twice. Modules are searched -for in the same way as Lisp files, except that the valid file -extensions are `.so', `.dll' or `.ell'. - -All symbols in the shared module must be completely resolved in order -for this function to be successful. Any modules which the specified -FILE depends on will be automatically loaded. You can determine which -modules have been loaded as dynamic shared objects by examining the -return value of the function `list-modules'. - -It is possible, although unwise, to unload modules using `unload-module'. -The prefered mechanism for unloading or reloading modules is to quit -XEmacs, and then reload those new or changed modules that are required. - -Messages informing you of the progress of the load are displayed unless -the variable `load-modules-quietly' is non-NIL. -*/ - (file,name,version)) -{ - char *mod, *mname, *mver; - int speccount = specpdl_depth(); - - CHECK_STRING(file); - - mod = (char *)XSTRING_DATA (file); - - if (NILP (name)) - mname = ""; - else - mname = (char *)XSTRING_DATA (name); - - if (NILP (version)) - mver = ""; - else - mver = (char *)XSTRING_DATA (version); - - dlhandle = 0; - record_unwind_protect (module_load_unwind, make_int(modnum)); - emodules_load (mod, mname, mver); - unbind_to (speccount, Qnil); - - return Qt; -} - -#ifdef DANGEROUS_NASTY_SCARY_MONSTER - -DEFUN ("unload-module", Fmodule_unload, 1, 3, 0, /* -Unload a module previously loaded with load-module. - -As with load-module, this function requires at least the module FILE, and -optionally the module NAME and VERSION to unload. It may not be possible -for the module to be unloaded from memory, as there may be Lisp objects -refering to variables inside the module code. However, once you have -requested a module to be unloaded, it will be unloaded from memory as -soon as the last reference to symbols within the module is destroyed. -*/ - (file,name,version)) -{ - int x; - char *mod, *mname, *mver; - - CHECK_STRING(file); - - mod = (char *)XSTRING_DATA (file); - - if (NILP (name)) - mname = ""; - else - mname = (char *)XSTRING_DATA (name); - - if (NILP (version)) - mver = ""; - else - mver = (char *)XSTRING_DATA (version); - - x = find_make_module (mod, mname, mver, 1); - if (x != -1) - attempt_module_delete (x); - return Qt; -} -#endif /* DANGEROUS_NASTY_SCARY_MONSTER */ - -DEFUN ("list-modules", Flist_modules, 0, 0, "", /* -Produce a list of loaded dynamic modules. - -This function will return a list of all the loaded dynamic modules. -Each element in the list is a list in the form (SONAME NAME VER DESC), -where SONAME is the name of the shared object that was loaded, NAME -is the internal module name, VER is the version of the module, and DESC -is how the module describes itself. - -This function returns a list, so you will need to assign the return value -to a variable and then examine the variable with `describe-variable'. -For example: - - (setq mylist (list-modules)) - (describe-variable 'mylist) - - -NOTE: It is possible for the same module to be loaded more than once, -at different versions. However, you should never see the same module, -with the same name and version, loaded more than once. If you do, this -is a bug, and you are encouraged to report it. -*/ - ()) -{ - Lisp_Object mlist = Qnil; - int i; - - for (i = 0; i < modnum; i++) - { - if (modules[i].used == 1) - mlist = Fcons (list4 (build_string (modules[i].soname), - build_string (modules[i].modname), - build_string (modules[i].modver), - build_string (modules[i].modtitle)), mlist); - } - - return mlist; -} - -static int -find_make_module (CONST char *mod, CONST char *name, CONST char *ver, int mof) -{ - int i, fs = -1; - - for (i = 0; i < modnum; i++) - { - if (fs == -1 && modules[i].used == 0) - fs = i; - if (strcmp (modules[i].soname, mod) == 0) - { - if (name && name[0] && strcmp (modules[i].modname, name)) - continue; - if (ver && ver[0] && strcmp (modules[i].modver, ver)) - continue; - return i; /* Found a match */ - } - } - - if (mof) - return fs; - - if (fs != -1) - return fs; /* First free slot */ - - /* - * We only get here if we havent found a free slot and the module was - * not previously loaded. - */ - if (modules == (emodules_list *)0) - modules = (emodules_list *)xmalloc (sizeof(emodules_list)); - modnum++; - modules = xrealloc (modules, modnum * sizeof(emodules_list)); - - fs = modnum - 1; - memset (&modules[fs], 0, sizeof(emodules_list)); - return fs; -} - -static void -attempt_module_delete (int mod) -{ - if (dll_close (modules[mod].dlhandle) == 0) - { - xfree (modules[mod].soname); - xfree (modules[mod].modname); - xfree (modules[mod].modver); - xfree (modules[mod].modtitle); - modules[mod].dlhandle = 0; - modules[mod].used = 0; - } - else if (modules[mod].used > 1) - modules[mod].used = 1; /* We couldn't delete it - it stays */ -} - -static Lisp_Object -module_load_unwind (Lisp_Object upto) -{ - int x,l=0; - - /* - * First close off the current handle if it is open. - */ - if (dlhandle != 0) - dll_close (dlhandle); - dlhandle = 0; - - if (CONSP (upto)) - { - if (INTP (XCAR (upto))) - l = XINT (XCAR (upto)); - free_cons (XCONS (upto)); - } - else - l = XINT (upto); - - /* - * Here we need to go through and dlclose() (IN REVERSE ORDER!) any - * modules that were loaded as part of this load chain. We only mark - * the slots as closed if the dlclose() succeeds. - */ - for (x = modnum-1; x >= l; x--) - { - if (modules[x].used > 1) - attempt_module_delete (x); - } - emodules_depth = 0; - - return Qnil; -} - -/* - * Do the actual grunt-work of loading in a module. We first try and - * dlopen() the module. If that fails, we have an error and we bail - * out immediately. If the dlopen() succeeds, we need to check for the - * existance of certain special symbols. - * - * All modules will have complete access to the variables and functions - * defined within XEmacs itself. It is up to the module to declare any - * variables or functions it uses, however. Modules will also have access - * to other functions and variables in other loaded modules, unless they - * are defined as STATIC. - * - * We need to be very careful with how we load modules. If we encounter an - * error along the way, we need to back out completely to the point at - * which the user started. Since we can be called resursively, we need to - * take care with marking modules as loaded. When we first start loading - * modules, we set the counter to zero. As we enter the function each time, - * we incremement the counter, and before we leave we decrement it. When - * we get back down to 0, we know we are at the end of the chain and we - * can mark all the modules in the list as loaded. - * - * When we signal an error, we need to be sure to unwind all modules loaded - * thus far (but only for this module chain). It is assumed that if any - * modules in a chain fail, then they all do. This is logical, considering - * that the only time we recurse is when we have dependant modules. So in - * the error handler we take great care to close off the module chain before - * we call "error" and let the Fmodule_load unwind_protect() function handle - * the cleaning up. - */ -void -emodules_load(CONST char *module, CONST char *modname, CONST char *modver) -{ - Lisp_Object filename; - Lisp_Object foundname; - int fd, x, mpx; - char *soname, *tmod; - CONST char **f; - CONST long *ellcc_rev; - char *mver, *mname, *mtitle, *symname; - void (*modload)(void) = 0; - void (*modsyms)(void) = 0; - void (*modvars)(void) = 0; - void (*moddocs)(void) = 0; - emodules_list *mp; - struct gcpro gcpro1,gcpro2; - - filename = Qnil; - foundname = Qnil; - - emodules_depth++; - dlhandle = 0; - - if ((module == (CONST char *)0) || (module[0] == '\0')) - error ("Empty module name"); - - /* This is to get around the fact that build_string() is not declared - as taking a const char * as an argument. I HATE compiler warnings. */ - tmod = (char *)alloca (strlen (module) + 1); - strcpy (tmod, module); - - GCPRO2(filename, foundname); - filename = build_string (tmod); - fd = locate_file(Vmodule_load_path, filename, ":.ell:.so:.dll", &foundname, -1); - UNGCPRO; - - if (fd < 0) - signal_simple_error ("Cannot open dynamic module", filename); - - soname = (char *)alloca (XSTRING_LENGTH (foundname) + 1); - strcpy (soname, (char *)XSTRING_DATA (foundname)); - - dlhandle = dll_open (soname); - if (dlhandle == (dll_handle)0) - error ("Opening dynamic module: %s", dll_error (dlhandle)); - - ellcc_rev = (CONST long *)dll_variable (dlhandle, "emodule_compiler"); - if ((ellcc_rev == (CONST long *)0) || (*ellcc_rev <= 0)) - error ("Missing symbol `emodule_compiler': Invalid dynamic module"); - if (*ellcc_rev > EMODULES_REVISION) - error ("Unsupported version `%ld(%ld)': Invalid dynamic module", - *ellcc_rev, EMODULES_REVISION); - - f = (CONST char **)dll_variable (dlhandle, "emodule_name"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) - error ("Missing symbol `emodule_name': Invalid dynamic module"); - - mname = (char *)alloca (strlen (*f) + 1); - strcpy (mname, *f); - if (mname[0] == '\0') - error ("Empty value for `emodule_name': Invalid dynamic module"); - - f = (CONST char **)dll_variable (dlhandle, "emodule_version"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) - error ("Missing symbol `emodule_version': Invalid dynamic module"); - - mver = (char *)alloca (strlen (*f) + 1); - strcpy (mver, *f); - - f = (CONST char **)dll_variable (dlhandle, "emodule_title"); - if ((f == (CONST char **)0) || (*f == (CONST char *)0)) - error ("Missing symbol `emodule_title': Invalid dynamic module"); - - mtitle = (char *)alloca (strlen (*f) + 1); - strcpy (mtitle, *f); - - symname = (char *)alloca (strlen (mname) + 15); - - strcpy (symname, "modules_of_"); - strcat (symname, mname); - modload = (void (*)(void))dll_function (dlhandle, symname); - /* - * modload is optional. If the module doesnt require other modules it can - * be left out. - */ - - strcpy (symname, "syms_of_"); - strcat (symname, mname); - modsyms = (void (*)(void))dll_function (dlhandle, symname); - if (modsyms == (void (*)(void))0) - error ("Missing symbol `%s': Invalid dynamic module", symname); - - strcpy (symname, "vars_of_"); - strcat (symname, mname); - modvars = (void (*)(void))dll_function (dlhandle, symname); - if (modvars == (void (*)(void))0) - error ("Missing symbol `%s': Invalid dynamic module", symname); - - strcpy (symname, "docs_of_"); - strcat (symname, mname); - moddocs = (void (*)(void))dll_function (dlhandle, symname); - if (moddocs == (void (*)(void))0) - error ("Missing symbol `%s': Invalid dynamic module", symname); - - if (modname && modname[0] && strcmp (modname, mname)) - error ("Module name mismatch"); - - if (modver && modver[0] && strcmp (modver, mver)) - error ("Module version mismatch"); - - /* - * Attempt to make a new slot for this module. If this really is the - * first time we are loading this module, the used member will be 0. - * If that is non-zero, we know that we have a previously loaded module - * of the same name and version, and we dont need to go any further. - */ - mpx = find_make_module (soname, mname, mver, 0); - mp = &modules[mpx]; - if (mp->used > 0) - { - emodules_depth--; - dll_close (dlhandle); - return; - } - - if (!load_modules_quietly) - message ("Loading %s v%s (%s)", mname, mver, mtitle); - - /* - * We have passed the basic initialization, and can now add this - * module to the list of modules. - */ - mp->used = emodules_depth + 1; - mp->soname = xstrdup (soname); - mp->modname = xstrdup (mname); - mp->modver = xstrdup (mver); - mp->modtitle = xstrdup (mtitle); - mp->dlhandle = dlhandle; - dlhandle = 0; - - /* - * Now we need to call the module init function and perform the various - * startup tasks. - */ - if (modload != 0) - (*modload)(); - - /* - * Now we can get the module to initialize its symbols, and then its - * variables, and lastly the documentation strings. - */ - (*modsyms)(); - (*modvars)(); - (*moddocs)(); - - if (!load_modules_quietly) - message ("Loaded module %s v%s (%s)", mname, mver, mtitle); - - - emodules_depth--; - if (emodules_depth == 0) - { - /* - * We have reached the end of the load chain. We now go through the - * list of loaded modules and mark all the valid modules as just - * that. - */ - for (x = 0; x < modnum; x++) - if (modules[x].used > 1) - modules[x].used = 1; - } -} - -void -emodules_doc_subr(CONST char *symname, CONST char *doc) -{ - Bytecount len = strlen (symname); - Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); - struct Lisp_Subr *subr; - - if (SYMBOLP(sym)) - { - subr = XSUBR( XSYMBOL(sym)->function); - subr->doc = xstrdup (doc); - } - /* - * FIXME: I wish there was some way to avoid the xstrdup(). Is it - * possible to just set a pointer to the string, or somehow create a - * symbol whose value we can point to the constant string? Can someone - * look into this? - */ -} - -void -emodules_doc_sym (CONST char *symname, CONST char *doc) -{ - Bytecount len = strlen (symname); - Lisp_Object sym = oblookup (Vobarray, (CONST Bufbyte *)symname, len); - Lisp_Object docstr; - struct gcpro gcpro1; - - if (SYMBOLP(sym)) - { - docstr = build_string (doc); - GCPRO1(docstr); - Fput (sym, Qvariable_documentation, docstr); - UNGCPRO; - } -} - - -void -syms_of_module (void) -{ - DEFSUBR(Fload_module); - DEFSUBR(Flist_modules); -#ifdef DANGEROUS_NASTY_SCARY_MONSTER - DEFSUBR(Funload_module); -#endif -} - -void -vars_of_module (void) -{ - DEFVAR_LISP ("module-version", &Vmodule_version /* -Emacs dynamic loading mechanism version, as a string. - -This string is in the form XX.YY.ppp, where XX is the major version -number, YY is the minor version number, and ppp is the patch level. -This variable can be used to distinquish between different versions of -the dynamic loading technology used in Emacs, if required. It is not -a given that this value will be the same as the Emacs version number. -*/ ); - Vmodule_version = Fpurecopy (build_string (EMODULES_VERSION)); - - DEFVAR_BOOL ("load-modules-quietly", &load_modules_quietly /* -*Set to t if module loading is to be silent. - -Normally, when loading dynamic modules, Emacs will inform you of its -progress, and will display the module name and version if the module -is loaded correctly. Setting this variable to `t' will suppress these -messages. This would normally only be done if `load-module' was being -called by a Lisp function. -*/); - - DEFVAR_LISP ("module-load-path", &Vmodule_load_path /* -*List of directories to search for dynamic modules to load. -Each element is a string (directory name) or nil (try default directory). - -Note that elements of this list *may not* begin with "~", so you must -call `expland-file-name' on them before adding them to this list. - -Initialized based on EMACSMODULEPATH environment variable, if any, otherwise -to default specified the file `paths.h' when XEmacs was built. If there -were no paths specified in `paths.h', then XEmacs chooses a default -value for this variable by looking around in the file-system near the -directory in which the XEmacs executable resides. - -Due to the nature of dynamic modules, the path names should almost always -refer to architecture-dependant directories. It is unwise to attempt to -store dynamic modules in a hetrogenous environment. Some environments -are similar enough to each other that XEmacs will be unable to determine -the correctness of a dynamic module, which can have unpredictable results -when a dynamic module is loaded. -*/); - - load_modules_quietly = 0; - emodules_depth = 0; - modules = (emodules_list *)0; - modnum = 0; - Vmodule_load_path = Qnil; - Fprovide (intern ("modules")); -} - -#endif /* HAVE_SHLIB */ - diff --git a/src/emodules.h b/src/emodules.h deleted file mode 100644 index 9cfd639..0000000 --- a/src/emodules.h +++ /dev/null @@ -1,86 +0,0 @@ -/* emodules.h - Declarations and definitions for XEmacs loadable modules. -(C) Copyright 1998, 1999 J. Kean Johnston. All rights reserved. - -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. */ - -#ifndef EMODULES_HDR - -#ifndef EMODULES_GATHER_VERSION -#define EMODULES_HDR -#endif - -#define EMODULES_VERSION "1.0.0" -#define EMODULES_MAJOR 1 -#define EMODULES_MINOR 0 -#define EMODULES_PATCH 0 -#define EMODULES_REVISION (long)((EMODULES_MAJOR * 1000) + \ - (EMODULES_MINOR * 10) + \ - (EMODULES_PATCH)) - -#ifndef EMODULES_GATHER_VERSION -#include -#include "lisp.h" -#include "sysdep.h" -#include "window.h" -#include "buffer.h" -#include "insdel.h" -#include "frame.h" -#include "lstream.h" -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -/* Module loading technology version number */ -extern Lisp_Object Vmodule_version; - -/* Load path */ -extern Lisp_Object Vmodule_load_path; - -/* XEmacs version Information */ -extern Lisp_Object Vemacs_major_version; -extern Lisp_Object Vemacs_minor_version; - -/* - * Load in a C module. The first argument is the name of the .so file, the - * second is the name of the module, and the third is the module version. - * If the module name is NULL, we will always reload the .so. If it is not - * NULL, we check to make sure we haven't loaded it before. If the version - * is specified, we check to make sure we didnt load the module of the - * specified version before. We also use these as checks when we open the - * module to make sure we have the right module. - */ -extern void emodules_load (CONST char *module, CONST char *name, CONST char *version); - -/* - * Because subrs and symbols added by a dynamic module are not part of - * the make-docfile process, we need a clean way to get the variables - * and functions documented. Since people dont like the idea of making - * shared modules use different versions of DEFSUBR() and DEFVAR_LISP() - * and friends, we need these two functions to insert the documentation - * into the right place. These functions will be called by the module - * init code, generated by ellcc during initialization mode. - */ -extern void emodules_doc_subr (CONST char *objname, CONST char *docstr); -extern void emodules_doc_sym (CONST char *objname, CONST char *docstr); - -#define CDOCSUBR(Fname, DOC) emodules_doc_subr (Fname, DOC) -#define CDOCSYM(Sname, DOC) emodules_doc_sym (Sname, DOC) -#endif /* EMODULES_GATHER_VERSION */ - -#endif /* EMODULES_HDR */ - diff --git a/src/eval.c b/src/eval.c deleted file mode 100644 index 0f07512..0000000 --- a/src/eval.c +++ /dev/null @@ -1,5192 +0,0 @@ -/* Evaluator for XEmacs Lisp interpreter. - Copyright (C) 1985-1987, 1992-1994 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: FSF 19.30 (except for Fsignal), Mule 2.0. */ - -#include -#include "lisp.h" - -#include "commands.h" -#include "backtrace.h" -#include "bytecode.h" -#include "buffer.h" -#include "console.h" -#include "opaque.h" - -#ifdef ERROR_CHECK_GC -int always_gc; /* Debugging hack */ -#else -#define always_gc 0 -#endif - -struct backtrace *backtrace_list; - -/* Note: you must always fill in all of the fields in a backtrace structure - before pushing them on the backtrace_list. The profiling code depends - on this. */ - -#define PUSH_BACKTRACE(bt) do { \ - (bt).next = backtrace_list; \ - backtrace_list = &(bt); \ -} while (0) - -#define POP_BACKTRACE(bt) do { \ - backtrace_list = (bt).next; \ -} while (0) - -/* Macros for calling subrs with an argument list whose length is only - known at runtime. See EXFUN and DEFUN for similar hackery. */ - -#define AV_0(av) -#define AV_1(av) av[0] -#define AV_2(av) AV_1(av), av[1] -#define AV_3(av) AV_2(av), av[2] -#define AV_4(av) AV_3(av), av[3] -#define AV_5(av) AV_4(av), av[4] -#define AV_6(av) AV_5(av), av[5] -#define AV_7(av) AV_6(av), av[6] -#define AV_8(av) AV_7(av), av[7] - -#define PRIMITIVE_FUNCALL_1(fn, av, ac) \ -(((Lisp_Object (*)(EXFUN_##ac)) (fn)) (AV_##ac (av))) - -/* If subrs take more than 8 arguments, more cases need to be added - to this switch. (But wait - don't do it - if you really need - a SUBR with more than 8 arguments, use max_args == MANY. - See the DEFUN macro in lisp.h) */ -#define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ - void (*PF_fn)() = (void (*)()) (fn); \ - Lisp_Object *PF_av = (av); \ - switch (ac) \ - { \ - default: abort(); \ - case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ - case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \ - case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \ - case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \ - case 4: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 4); break; \ - case 5: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 5); break; \ - case 6: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 6); break; \ - case 7: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 7); break; \ - case 8: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 8); break; \ - } \ -} while (0) - -#define FUNCALL_SUBR(rv, subr, av, ac) \ - PRIMITIVE_FUNCALL (rv, subr_function (subr), av, ac); - - -/* This is the list of current catches (and also condition-cases). - This is a stack: the most recent catch is at the head of the - list. Catches are created by declaring a 'struct catchtag' - locally, filling the .TAG field in with the tag, and doing - a setjmp() on .JMP. Fthrow() will store the value passed - to it in .VAL and longjmp() back to .JMP, back to the function - that established the catch. This will always be either - internal_catch() (catches established internally or through - `catch') or condition_case_1 (condition-cases established - internally or through `condition-case'). - - The catchtag also records the current position in the - call stack (stored in BACKTRACE_LIST), the current position - in the specpdl stack (used for variable bindings and - unwind-protects), the value of LISP_EVAL_DEPTH, and the - current position in the GCPRO stack. All of these are - restored by Fthrow(). - */ - -struct catchtag *catchlist; - -Lisp_Object Qautoload, Qmacro, Qexit; -Lisp_Object Qinteractive, Qcommandp, Qdefun, Qprogn, Qvalues; -Lisp_Object Vquit_flag, Vinhibit_quit; -Lisp_Object Qand_rest, Qand_optional; -Lisp_Object Qdebug_on_error, Qstack_trace_on_error; -Lisp_Object Qdebug_on_signal, Qstack_trace_on_signal; -Lisp_Object Qdebugger; -Lisp_Object Qinhibit_quit; -Lisp_Object Qrun_hooks; -Lisp_Object Qsetq; -Lisp_Object Qdisplay_warning; -Lisp_Object Vpending_warnings, Vpending_warnings_tail; -Lisp_Object Qif; - -/* Records whether we want errors to occur. This will be a boolean, - nil (errors OK) or t (no errors). If t, an error will cause a - throw to Qunbound_suspended_errors_tag. - - See call_with_suspended_errors(). */ -Lisp_Object Vcurrent_error_state; - -/* Current warning class when warnings occur, or nil for no warnings. - Only meaningful when Vcurrent_error_state is non-nil. - See call_with_suspended_errors(). */ -Lisp_Object Vcurrent_warning_class; - -/* Special catch tag used in call_with_suspended_errors(). */ -Lisp_Object Qunbound_suspended_errors_tag; - -/* Non-nil means we're going down, so we better not run any hooks - or do other non-essential stuff. */ -int preparing_for_armageddon; - -/* Non-nil means record all fset's and provide's, to be undone - if the file being autoloaded is not fully loaded. - They are recorded by being consed onto the front of Vautoload_queue: - (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide. */ -Lisp_Object Vautoload_queue; - -/* Current number of specbindings allocated in specpdl. */ -int specpdl_size; - -/* Pointer to beginning of specpdl. */ -struct specbinding *specpdl; - -/* Pointer to first unused element in specpdl. */ -struct specbinding *specpdl_ptr; - -/* specpdl_ptr - specpdl */ -int specpdl_depth_counter; - -/* Maximum size allowed for specpdl allocation */ -int max_specpdl_size; - -/* Depth in Lisp evaluations and function calls. */ -int lisp_eval_depth; - -/* Maximum allowed depth in Lisp evaluations and function calls. */ -int max_lisp_eval_depth; - -/* Nonzero means enter debugger before next function call */ -static int debug_on_next_call; - -/* List of conditions (non-nil atom means all) which cause a backtrace - if an error is handled by the command loop's error handler. */ -Lisp_Object Vstack_trace_on_error; - -/* List of conditions (non-nil atom means all) which enter the debugger - if an error is handled by the command loop's error handler. */ -Lisp_Object Vdebug_on_error; - -/* List of conditions and regexps specifying error messages which - do not enter the debugger even if Vdebug_on_error says they should. */ -Lisp_Object Vdebug_ignored_errors; - -/* List of conditions (non-nil atom means all) which cause a backtrace - if any error is signalled. */ -Lisp_Object Vstack_trace_on_signal; - -/* List of conditions (non-nil atom means all) which enter the debugger - if any error is signalled. */ -Lisp_Object Vdebug_on_signal; - -/* Nonzero means enter debugger if a quit signal - is handled by the command loop's error handler. - - From lisp, this is a boolean variable and may have the values 0 and 1. - But, eval.c temporarily uses the second bit of this variable to indicate - that a critical_quit is in progress. The second bit is reset immediately - after it is processed in signal_call_debugger(). */ -int debug_on_quit; - -#if 0 /* FSFmacs */ -/* entering_debugger is basically equivalent */ -/* The value of num_nonmacro_input_chars as of the last time we - started to enter the debugger. If we decide to enter the debugger - again when this is still equal to num_nonmacro_input_chars, then we - know that the debugger itself has an error, and we should just - signal the error instead of entering an infinite loop of debugger - invocations. */ -int when_entered_debugger; -#endif - -/* Nonzero means we are trying to enter the debugger. - This is to prevent recursive attempts. - Cleared by the debugger calling Fbacktrace */ -static int entering_debugger; - -/* Function to call to invoke the debugger */ -Lisp_Object Vdebugger; - -/* Chain of condition handlers currently in effect. - The elements of this chain are contained in the stack frames - of Fcondition_case and internal_condition_case. - When an error is signaled (by calling Fsignal, below), - this chain is searched for an element that applies. - - Each element of this list is one of the following: - - A list of a handler function and possibly args to pass to - the function. This is a handler established with - `call-with-condition-handler' (q.v.). - - A list whose car is Qunbound and whose cdr is Qt. - This is a special condition-case handler established - by C code with condition_case_1(). All errors are - trapped; the debugger is not invoked even if - `debug-on-error' was set. - - A list whose car is Qunbound and whose cdr is Qerror. - This is a special condition-case handler established - by C code with condition_case_1(). It is like Qt - except that the debugger is invoked normally if it is - called for. - - A list whose car is Qunbound and whose cdr is a list - of lists (CONDITION-NAME BODY ...) exactly as in - `condition-case'. This is a normal `condition-case' - handler. - - Note that in all cases *except* the first, there is a - corresponding catch, whose TAG is the value of - Vcondition_handlers just after the handler data just - described is pushed onto it. The reason is that - `condition-case' handlers need to throw back to the - place where the handler was installed before invoking - it, while `call-with-condition-handler' handlers are - invoked in the environment that `signal' was invoked - in. -*/ -static Lisp_Object Vcondition_handlers; - - -#if 0 /* no longer used */ -/* Used for error catching purposes by throw_or_bomb_out */ -static int throw_level; -#endif /* unused */ - - -/************************************************************************/ -/* The subr object type */ -/************************************************************************/ - -static void -print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - Lisp_Subr *subr = XSUBR (obj); - CONST char *header = - (subr->max_args == UNEVALLED) ? "#prompt ? " (interactive)>" : ">"; - - if (print_readably) - error ("printing unreadable object %s%s%s", header, name, trailer); - - write_c_string (header, printcharfun); - write_c_string (name, printcharfun); - write_c_string (trailer, printcharfun); -} - -DEFINE_LRECORD_IMPLEMENTATION ("subr", subr, - this_one_is_unmarkable, print_subr, 0, 0, 0, - Lisp_Subr); - -/************************************************************************/ -/* Entering the debugger */ -/************************************************************************/ - -/* unwind-protect used by call_debugger() to restore the value of - entering_debugger. (We cannot use specbind() because the - variable is not Lisp-accessible.) */ - -static Lisp_Object -restore_entering_debugger (Lisp_Object arg) -{ - entering_debugger = ! NILP (arg); - return arg; -} - -/* Actually call the debugger. ARG is a list of args that will be - passed to the debugger function, as follows; - -If due to frame exit, args are `exit' and the value being returned; - this function's value will be returned instead of that. -If due to error, args are `error' and a list of the args to `signal'. -If due to `apply' or `funcall' entry, one arg, `lambda'. -If due to `eval' entry, one arg, t. - -*/ - -static Lisp_Object -call_debugger_259 (Lisp_Object arg) -{ - return apply1 (Vdebugger, arg); -} - -/* Call the debugger, doing some encapsulation. We make sure we have - some room on the eval and specpdl stacks, and bind entering_debugger - to 1 during this call. This is used to trap errors that may occur - when entering the debugger (e.g. the value of `debugger' is invalid), - so that the debugger will not be recursively entered if debug-on-error - is set. (Otherwise, XEmacs would infinitely recurse, attempting to - enter the debugger.) entering_debugger gets reset to 0 as soon - as a backtrace is displayed, so that further errors can indeed be - handled normally. - - We also establish a catch for 'debugger. If the debugger function - throws to this instead of returning a value, it means that the user - pressed 'c' (pretend like the debugger was never entered). The - function then returns Qunbound. (If the user pressed 'r', for - return a value, then the debugger function returns normally with - this value.) - - The difference between 'c' and 'r' is as follows: - - debug-on-call: - No difference. The call proceeds as normal. - debug-on-exit: - With 'r', the specified value is returned as the function's - return value. With 'c', the value that would normally be - returned is returned. - signal: - With 'r', the specified value is returned as the return - value of `signal'. (This is the only time that `signal' - can return, instead of making a non-local exit.) With `c', - `signal' will continue looking for handlers as if the - debugger was never entered, and will probably end up - throwing to a handler or to top-level. -*/ - -static Lisp_Object -call_debugger (Lisp_Object arg) -{ - int threw; - Lisp_Object val; - int speccount; - - if (lisp_eval_depth + 20 > max_lisp_eval_depth) - max_lisp_eval_depth = lisp_eval_depth + 20; - if (specpdl_size + 40 > max_specpdl_size) - max_specpdl_size = specpdl_size + 40; - debug_on_next_call = 0; - - speccount = specpdl_depth(); - record_unwind_protect (restore_entering_debugger, - (entering_debugger ? Qt : Qnil)); - entering_debugger = 1; - val = internal_catch (Qdebugger, call_debugger_259, arg, &threw); - - return unbind_to (speccount, ((threw) - ? Qunbound /* Not returning a value */ - : val)); -} - -/* Called when debug-on-exit behavior is called for. Enter the debugger - with the appropriate args for this. VAL is the exit value that is - about to be returned. */ - -static Lisp_Object -do_debug_on_exit (Lisp_Object val) -{ - /* This is falsified by call_debugger */ - Lisp_Object v = call_debugger (list2 (Qexit, val)); - - return !UNBOUNDP (v) ? v : val; -} - -/* Called when debug-on-call behavior is called for. Enter the debugger - with the appropriate args for this. VAL is either t for a call - through `eval' or 'lambda for a call through `funcall'. - - #### The differentiation here between EVAL and FUNCALL is bogus. - FUNCALL can be defined as - - (defmacro func (fun &rest args) - (cons (eval fun) args)) - - and should be treated as such. - */ - -static void -do_debug_on_call (Lisp_Object code) -{ - debug_on_next_call = 0; - backtrace_list->debug_on_exit = 1; - call_debugger (list1 (code)); -} - -/* LIST is the value of one of the variables `debug-on-error', - `debug-on-signal', `stack-trace-on-error', or `stack-trace-on-signal', - and CONDITIONS is the list of error conditions associated with - the error being signalled. This returns non-nil if LIST - matches CONDITIONS. (A nil value for LIST does not match - CONDITIONS. A non-list value for LIST does match CONDITIONS. - A list matches CONDITIONS when one of the symbols in LIST is the - same as one of the symbols in CONDITIONS.) */ - -static int -wants_debugger (Lisp_Object list, Lisp_Object conditions) -{ - if (NILP (list)) - return 0; - if (! CONSP (list)) - return 1; - - while (CONSP (conditions)) - { - Lisp_Object this, tail; - this = XCAR (conditions); - for (tail = list; CONSP (tail); tail = XCDR (tail)) - if (EQ (XCAR (tail), this)) - return 1; - conditions = XCDR (conditions); - } - return 0; -} - - -/* Return 1 if an error with condition-symbols CONDITIONS, - and described by SIGNAL-DATA, should skip the debugger - according to debugger-ignore-errors. */ - -static int -skip_debugger (Lisp_Object conditions, Lisp_Object data) -{ - /* This function can GC */ - Lisp_Object tail; - int first_string = 1; - Lisp_Object error_message = Qnil; - - for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail)) - { - if (STRINGP (XCAR (tail))) - { - if (first_string) - { - error_message = Ferror_message_string (data); - first_string = 0; - } - if (fast_lisp_string_match (XCAR (tail), error_message) >= 0) - return 1; - } - else - { - Lisp_Object contail; - - for (contail = conditions; CONSP (contail); contail = XCDR (contail)) - if (EQ (XCAR (tail), XCAR (contail))) - return 1; - } - } - - return 0; -} - -/* Actually generate a backtrace on STREAM. */ - -static Lisp_Object -backtrace_259 (Lisp_Object stream) -{ - return Fbacktrace (stream, Qt); -} - -/* An error was signaled. Maybe call the debugger, if the `debug-on-error' - etc. variables call for this. CONDITIONS is the list of conditions - associated with the error being signalled. SIG is the actual error - being signalled, and DATA is the associated data (these are exactly - the same as the arguments to `signal'). ACTIVE_HANDLERS is the - list of error handlers that are to be put in place while the debugger - is called. This is generally the remaining handlers that are - outside of the innermost handler trapping this error. This way, - if the same error occurs inside of the debugger, you usually don't get - the debugger entered recursively. - - This function returns Qunbound if it didn't call the debugger or if - the user asked (through 'c') that XEmacs should pretend like the - debugger was never entered. Otherwise, it returns the value - that the user specified with `r'. (Note that much of the time, - the user will abort with C-], and we will never have a chance to - return anything at all.) - - SIGNAL_VARS_ONLY means we should only look at debug-on-signal - and stack-trace-on-signal to control whether we do anything. - This is so that debug-on-error doesn't make handled errors - cause the debugger to get invoked. - - STACK_TRACE_DISPLAYED and DEBUGGER_ENTERED are used so that - those functions aren't done more than once in a single `signal' - session. */ - -static Lisp_Object -signal_call_debugger (Lisp_Object conditions, - Lisp_Object sig, Lisp_Object data, - Lisp_Object active_handlers, - int signal_vars_only, - int *stack_trace_displayed, - int *debugger_entered) -{ - /* This function can GC */ - Lisp_Object val = Qunbound; - Lisp_Object all_handlers = Vcondition_handlers; - Lisp_Object temp_data = Qnil; - int speccount = specpdl_depth(); - struct gcpro gcpro1, gcpro2; - GCPRO2 (all_handlers, temp_data); - - Vcondition_handlers = active_handlers; - - temp_data = Fcons (sig, data); /* needed for skip_debugger */ - - if (!entering_debugger && !*stack_trace_displayed && !signal_vars_only - && wants_debugger (Vstack_trace_on_error, conditions) - && !skip_debugger (conditions, temp_data)) - { - specbind (Qdebug_on_error, Qnil); - specbind (Qstack_trace_on_error, Qnil); - specbind (Qdebug_on_signal, Qnil); - specbind (Qstack_trace_on_signal, Qnil); - - internal_with_output_to_temp_buffer (build_string ("*Backtrace*"), - backtrace_259, - Qnil, - Qnil); - unbind_to (speccount, Qnil); - *stack_trace_displayed = 1; - } - - if (!entering_debugger && !*debugger_entered && !signal_vars_only - && (EQ (sig, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) - && !skip_debugger (conditions, temp_data)) - { - debug_on_quit &= ~2; /* reset critical bit */ - specbind (Qdebug_on_error, Qnil); - specbind (Qstack_trace_on_error, Qnil); - specbind (Qdebug_on_signal, Qnil); - specbind (Qstack_trace_on_signal, Qnil); - - val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); - *debugger_entered = 1; - } - - if (!entering_debugger && !*stack_trace_displayed - && wants_debugger (Vstack_trace_on_signal, conditions)) - { - specbind (Qdebug_on_error, Qnil); - specbind (Qstack_trace_on_error, Qnil); - specbind (Qdebug_on_signal, Qnil); - specbind (Qstack_trace_on_signal, Qnil); - - internal_with_output_to_temp_buffer (build_string ("*Backtrace*"), - backtrace_259, - Qnil, - Qnil); - unbind_to (speccount, Qnil); - *stack_trace_displayed = 1; - } - - if (!entering_debugger && !*debugger_entered - && (EQ (sig, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_signal, conditions))) - { - debug_on_quit &= ~2; /* reset critical bit */ - specbind (Qdebug_on_error, Qnil); - specbind (Qstack_trace_on_error, Qnil); - specbind (Qdebug_on_signal, Qnil); - specbind (Qstack_trace_on_signal, Qnil); - - val = call_debugger (list2 (Qerror, (Fcons (sig, data)))); - *debugger_entered = 1; - } - - UNGCPRO; - Vcondition_handlers = all_handlers; - return unbind_to (speccount, val); -} - - -/************************************************************************/ -/* The basic special forms */ -/************************************************************************/ - -/* Except for Fprogn(), the basic special forms below are only called - from interpreted code. The byte compiler turns them into bytecodes. */ - -DEFUN ("or", For, 0, UNEVALLED, 0, /* -Eval args until one of them yields non-nil, then return that value. -The remaining args are not evalled at all. -If all args return nil, return nil. -*/ - (args)) -{ - /* This function can GC */ - REGISTER Lisp_Object arg, val; - - LIST_LOOP_2 (arg, args) - { - if (!NILP (val = Feval (arg))) - return val; - } - - return Qnil; -} - -DEFUN ("and", Fand, 0, UNEVALLED, 0, /* -Eval args until one of them yields nil, then return nil. -The remaining args are not evalled at all. -If no arg yields nil, return the last arg's value. -*/ - (args)) -{ - /* This function can GC */ - REGISTER Lisp_Object arg, val = Qt; - - LIST_LOOP_2 (arg, args) - { - if (NILP (val = Feval (arg))) - return val; - } - - return val; -} - -DEFUN ("if", Fif, 2, UNEVALLED, 0, /* -\(if COND THEN ELSE...): if COND yields non-nil, do THEN, else do ELSE... -Returns the value of THEN or the value of the last of the ELSE's. -THEN must be one expression, but ELSE... can be zero or more expressions. -If COND yields nil, and there are no ELSE's, the value is nil. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object condition = XCAR (args); - Lisp_Object then_form = XCAR (XCDR (args)); - Lisp_Object else_forms = XCDR (XCDR (args)); - - if (!NILP (Feval (condition))) - return Feval (then_form); - else - return Fprogn (else_forms); -} - -/* Macros `when' and `unless' are trivially defined in Lisp, - but it helps for bootstrapping to have them ALWAYS defined. */ - -DEFUN ("when", Fwhen, 1, MANY, 0, /* -\(when COND BODY...): if COND yields non-nil, do BODY, else return nil. -BODY can be zero or more expressions. If BODY is nil, return nil. -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Object cond = args[0]; - Lisp_Object body; - - switch (nargs) - { - case 1: body = Qnil; break; - case 2: body = args[1]; break; - default: body = Fcons (Qprogn, Flist (nargs-1, args+1)); break; - } - - return list3 (Qif, cond, body); -} - -DEFUN ("unless", Funless, 1, MANY, 0, /* -\(unless COND BODY...): if COND yields nil, do BODY, else return nil. -BODY can be zero or more expressions. If BODY is nil, return nil. -*/ - (int nargs, Lisp_Object *args)) -{ - Lisp_Object cond = args[0]; - Lisp_Object body = Flist (nargs-1, args+1); - return Fcons (Qif, Fcons (cond, Fcons (Qnil, body))); -} - -DEFUN ("cond", Fcond, 0, UNEVALLED, 0, /* -(cond CLAUSES...): try each clause until one succeeds. -Each clause looks like (CONDITION BODY...). CONDITION is evaluated -and, if the value is non-nil, this clause succeeds: -then the expressions in BODY are evaluated and the last one's -value is the value of the cond-form. -If no clause succeeds, cond returns nil. -If a clause has one element, as in (CONDITION), -CONDITION's value if non-nil is returned from the cond-form. -*/ - (args)) -{ - /* This function can GC */ - REGISTER Lisp_Object val, clause; - - LIST_LOOP_2 (clause, args) - { - CHECK_CONS (clause); - if (!NILP (val = Feval (XCAR (clause)))) - { - if (!NILP (clause = XCDR (clause))) - { - CHECK_TRUE_LIST (clause); - val = Fprogn (clause); - } - return val; - } - } - - return Qnil; -} - -DEFUN ("progn", Fprogn, 0, UNEVALLED, 0, /* -\(progn BODY...): eval BODY forms sequentially and return value of last one. -*/ - (args)) -{ - /* This function can GC */ - /* Caller must provide a true list in ARGS */ - REGISTER Lisp_Object form, val = Qnil; - struct gcpro gcpro1; - - GCPRO1 (args); - - { - LIST_LOOP_2 (form, args) - val = Feval (form); - } - - UNGCPRO; - return val; -} - -/* Fprog1() is the canonical example of a function that must GCPRO a - Lisp_Object across calls to Feval(). */ - -DEFUN ("prog1", Fprog1, 1, UNEVALLED, 0, /* -Similar to `progn', but the value of the first form is returned. -\(prog1 FIRST BODY...): All the arguments are evaluated sequentially. -The value of FIRST is saved during evaluation of the remaining args, -whose values are discarded. -*/ - (args)) -{ - /* This function can GC */ - REGISTER Lisp_Object val, form; - struct gcpro gcpro1; - - val = Feval (XCAR (args)); - - GCPRO1 (val); - - { - LIST_LOOP_2 (form, XCDR (args)) - Feval (form); - } - - UNGCPRO; - return val; -} - -DEFUN ("prog2", Fprog2, 2, UNEVALLED, 0, /* -Similar to `progn', but the value of the second form is returned. -\(prog2 FIRST SECOND BODY...): All the arguments are evaluated sequentially. -The value of SECOND is saved during evaluation of the remaining args, -whose values are discarded. -*/ - (args)) -{ - /* This function can GC */ - REGISTER Lisp_Object val, form, tail; - struct gcpro gcpro1; - - Feval (XCAR (args)); - args = XCDR (args); - val = Feval (XCAR (args)); - args = XCDR (args); - - GCPRO1 (val); - - LIST_LOOP_3 (form, args, tail) - Feval (form); - - UNGCPRO; - return val; -} - -DEFUN ("let*", FletX, 1, UNEVALLED, 0, /* -\(let* VARLIST BODY...): bind variables according to VARLIST then eval BODY. -The value of the last form in BODY is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -Each VALUEFORM can refer to the symbols already bound by this VARLIST. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object var, tail; - Lisp_Object varlist = XCAR (args); - Lisp_Object body = XCDR (args); - int speccount = specpdl_depth(); - - EXTERNAL_LIST_LOOP_3 (var, varlist, tail) - { - Lisp_Object symbol, value, tem; - if (SYMBOLP (var)) - symbol = var, value = Qnil; - else - { - CHECK_CONS (var); - symbol = XCAR (var); - tem = XCDR (var); - if (NILP (tem)) - value = Qnil; - else - { - CHECK_CONS (tem); - value = Feval (XCAR (tem)); - if (!NILP (XCDR (tem))) - signal_simple_error - ("`let' bindings can have only one value-form", var); - } - } - specbind (symbol, value); - } - return unbind_to (speccount, Fprogn (body)); -} - -DEFUN ("let", Flet, 1, UNEVALLED, 0, /* -\(let VARLIST BODY...): bind variables according to VARLIST then eval BODY. -The value of the last form in BODY is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -All the VALUEFORMs are evalled before any symbols are bound. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object var, tail; - Lisp_Object varlist = XCAR (args); - Lisp_Object body = XCDR (args); - int speccount = specpdl_depth(); - Lisp_Object *temps; - int idx; - struct gcpro gcpro1; - - /* Make space to hold the values to give the bound variables. */ - { - int varcount; - GET_EXTERNAL_LIST_LENGTH (varlist, varcount); - temps = alloca_array (Lisp_Object, varcount); - } - - /* Compute the values and store them in `temps' */ - GCPRO1 (*temps); - gcpro1.nvars = 0; - - idx = 0; - LIST_LOOP_3 (var, varlist, tail) - { - Lisp_Object *value = &temps[idx++]; - if (SYMBOLP (var)) - *value = Qnil; - else - { - Lisp_Object tem; - CHECK_CONS (var); - tem = XCDR (var); - if (NILP (tem)) - *value = Qnil; - else - { - CHECK_CONS (tem); - *value = Feval (XCAR (tem)); - gcpro1.nvars = idx; - - if (!NILP (XCDR (tem))) - signal_simple_error - ("`let' bindings can have only one value-form", var); - } - } - } - - idx = 0; - LIST_LOOP_3 (var, varlist, tail) - { - specbind (SYMBOLP (var) ? var : XCAR (var), temps[idx++]); - } - - UNGCPRO; - - return unbind_to (speccount, Fprogn (body)); -} - -DEFUN ("while", Fwhile, 1, UNEVALLED, 0, /* -\(while TEST BODY...): if TEST yields non-nil, eval BODY... and repeat. -The order of execution is thus TEST, BODY, TEST, BODY and so on -until TEST returns nil. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object test = XCAR (args); - Lisp_Object body = XCDR (args); - - while (!NILP (Feval (test))) - { - QUIT; - Fprogn (body); - } - - return Qnil; -} - -DEFUN ("setq", Fsetq, 0, UNEVALLED, 0, /* -\(setq SYM VAL SYM VAL ...): set each SYM to the value of its VAL. -The symbols SYM are variables; they are literal (not evaluated). -The values VAL are expressions; they are evaluated. -Thus, (setq x (1+ y)) sets `x' to the value of `(1+ y)'. -The second VAL is not computed until after the first SYM is set, and so on; -each VAL can use the new value of variables set earlier in the `setq'. -The return value of the `setq' form is the value of the last VAL. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object symbol, tail, val = Qnil; - int nargs; - struct gcpro gcpro1; - - GET_LIST_LENGTH (args, nargs); - - if (nargs & 1) /* Odd number of arguments? */ - Fsignal (Qwrong_number_of_arguments, list2 (Qsetq, make_int (nargs))); - - GCPRO1 (val); - - PROPERTY_LIST_LOOP (tail, symbol, val, args) - { - val = Feval (val); - Fset (symbol, val); - } - - UNGCPRO; - return val; -} - -DEFUN ("quote", Fquote, 1, UNEVALLED, 0, /* -Return the argument, without evaluating it. `(quote x)' yields `x'. -*/ - (args)) -{ - return XCAR (args); -} - -DEFUN ("function", Ffunction, 1, UNEVALLED, 0, /* -Like `quote', but preferred for objects which are functions. -In byte compilation, `function' causes its argument to be compiled. -`quote' cannot do that. -*/ - (args)) -{ - return XCAR (args); -} - - -/************************************************************************/ -/* Defining functions/variables */ -/************************************************************************/ -static Lisp_Object -define_function (Lisp_Object name, Lisp_Object defn) -{ - if (purify_flag) - defn = Fpurecopy (defn); - Ffset (name, defn); - LOADHIST_ATTACH (name); - return name; -} - -DEFUN ("defun", Fdefun, 2, UNEVALLED, 0, /* -\(defun NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. -The definition is (lambda ARGLIST [DOCSTRING] BODY...). -See also the function `interactive'. -*/ - (args)) -{ - /* This function can GC */ - return define_function (XCAR (args), - Fcons (Qlambda, XCDR (args))); -} - -DEFUN ("defmacro", Fdefmacro, 2, UNEVALLED, 0, /* -\(defmacro NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. -The definition is (macro lambda ARGLIST [DOCSTRING] BODY...). -When the macro is called, as in (NAME ARGS...), -the function (lambda ARGLIST BODY...) is applied to -the list ARGS... as it appears in the expression, -and the result should be a form to be evaluated instead of the original. -*/ - (args)) -{ - /* This function can GC */ - return define_function (XCAR (args), - Fcons (Qmacro, Fcons (Qlambda, XCDR (args)))); -} - -DEFUN ("defvar", Fdefvar, 1, UNEVALLED, 0, /* -\(defvar SYMBOL INITVALUE DOCSTRING): define SYMBOL as a variable. -You are not required to define a variable in order to use it, - but the definition can supply documentation and an initial value - in a way that tags can recognize. - -INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is - void. (However, when you evaluate a defvar interactively, it acts like a - defconst: SYMBOL's value is always set regardless of whether it's currently - void.) -If SYMBOL is buffer-local, its default value is what is set; - buffer-local values are not affected. -INITVALUE and DOCSTRING are optional. -If DOCSTRING starts with *, this variable is identified as a user option. - This means that M-x set-variable and M-x edit-options recognize it. -If INITVALUE is missing, SYMBOL's value is not set. - -In lisp-interaction-mode defvar is treated as defconst. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object sym = XCAR (args); - - if (!NILP (args = XCDR (args))) - { - Lisp_Object val = XCAR (args); - - if (NILP (Fdefault_boundp (sym))) - { - struct gcpro gcpro1; - GCPRO1 (val); - val = Feval (val); - Fset_default (sym, val); - UNGCPRO; - } - - if (!NILP (args = XCDR (args))) - { - Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); - Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif - if (!NILP (args = XCDR (args))) - error ("too many arguments"); - } - } - -#ifdef I18N3 - if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); -#endif - - LOADHIST_ATTACH (sym); - return sym; -} - -DEFUN ("defconst", Fdefconst, 2, UNEVALLED, 0, /* -\(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant -variable. -The intent is that programs do not change this value, but users may. -Always sets the value of SYMBOL to the result of evalling INITVALUE. -If SYMBOL is buffer-local, its default value is what is set; - buffer-local values are not affected. -DOCSTRING is optional. -If DOCSTRING starts with *, this variable is identified as a user option. - This means that M-x set-variable and M-x edit-options recognize it. - -Note: do not use `defconst' for user options in libraries that are not - normally loaded, since it is useful for users to be able to specify - their own values for such variables before loading the library. -Since `defconst' unconditionally assigns the variable, - it would override the user's choice. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object sym = XCAR (args); - Lisp_Object val = Feval (XCAR (args = XCDR (args))); - struct gcpro gcpro1; - - GCPRO1 (val); - - Fset_default (sym, val); - - UNGCPRO; - - if (!NILP (args = XCDR (args))) - { - Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); - Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif - if (!NILP (args = XCDR (args))) - error ("too many arguments"); - } - -#ifdef I18N3 - if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); -#endif - - LOADHIST_ATTACH (sym); - return sym; -} - -DEFUN ("user-variable-p", Fuser_variable_p, 1, 1, 0, /* -Return t if VARIABLE is intended to be set and modified by users. -\(The alternative is a variable used internally in a Lisp program.) -Determined by whether the first character of the documentation -for the variable is `*'. -*/ - (variable)) -{ - Lisp_Object documentation = Fget (variable, Qvariable_documentation, Qnil); - - return - ((INTP (documentation) && XINT (documentation) < 0) || - - ((STRINGP (documentation)) && - (string_byte (XSTRING (documentation), 0) == '*')) || - - /* If (STRING . INTEGER), a negative integer means a user variable. */ - (CONSP (documentation) - && STRINGP (XCAR (documentation)) - && INTP (XCDR (documentation)) - && XINT (XCDR (documentation)) < 0)) ? - Qt : Qnil; -} - -DEFUN ("macroexpand-internal", Fmacroexpand_internal, 1, 2, 0, /* -Return result of expanding macros at top level of FORM. -If FORM is not a macro call, it is returned unchanged. -Otherwise, the macro is expanded and the expansion is considered -in place of FORM. When a non-macro-call results, it is returned. - -The second optional arg ENVIRONMENT species an environment of macro -definitions to shadow the loaded ones for use in file byte-compilation. -*/ - (form, env)) -{ - /* This function can GC */ - /* With cleanups from Hallvard Furuseth. */ - REGISTER Lisp_Object expander, sym, def, tem; - - while (1) - { - /* Come back here each time we expand a macro call, - in case it expands into another macro call. */ - if (!CONSP (form)) - break; - /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */ - def = sym = XCAR (form); - tem = Qnil; - /* Trace symbols aliases to other symbols - until we get a symbol that is not an alias. */ - while (SYMBOLP (def)) - { - QUIT; - sym = def; - tem = Fassq (sym, env); - if (NILP (tem)) - { - def = XSYMBOL (sym)->function; - if (!UNBOUNDP (def)) - continue; - } - break; - } - /* Right now TEM is the result from SYM in ENV, - and if TEM is nil then DEF is SYM's function definition. */ - if (NILP (tem)) - { - /* SYM is not mentioned in ENV. - Look at its function definition. */ - if (UNBOUNDP (def) - || !CONSP (def)) - /* Not defined or definition not suitable */ - break; - if (EQ (XCAR (def), Qautoload)) - { - /* Autoloading function: will it be a macro when loaded? */ - tem = Felt (def, make_int (4)); - if (EQ (tem, Qt) || EQ (tem, Qmacro)) - { - /* Yes, load it and try again. */ - do_autoload (def, sym); - continue; - } - else - break; - } - else if (!EQ (XCAR (def), Qmacro)) - break; - else expander = XCDR (def); - } - else - { - expander = XCDR (tem); - if (NILP (expander)) - break; - } - form = apply1 (expander, XCDR (form)); - } - return form; -} - - -/************************************************************************/ -/* Non-local exits */ -/************************************************************************/ - -DEFUN ("catch", Fcatch, 1, UNEVALLED, 0, /* -\(catch TAG BODY...): eval BODY allowing nonlocal exits using `throw'. -TAG is evalled to get the tag to use. Then the BODY is executed. -Within BODY, (throw TAG) with same tag exits BODY and exits this `catch'. -If no throw happens, `catch' returns the value of the last BODY form. -If a throw happens, it specifies the value to return from `catch'. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object tag = Feval (XCAR (args)); - Lisp_Object body = XCDR (args); - return internal_catch (tag, Fprogn, body, 0); -} - -/* Set up a catch, then call C function FUNC on argument ARG. - FUNC should return a Lisp_Object. - This is how catches are done from within C code. */ - -Lisp_Object -internal_catch (Lisp_Object tag, - Lisp_Object (*func) (Lisp_Object arg), - Lisp_Object arg, - int * volatile threw) -{ - /* This structure is made part of the chain `catchlist'. */ - struct catchtag c; - - /* Fill in the components of c, and put it on the list. */ - c.next = catchlist; - c.tag = tag; - c.val = Qnil; - c.backlist = backtrace_list; -#if 0 /* FSFmacs */ - /* #### */ - c.handlerlist = handlerlist; -#endif - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = specpdl_depth(); -#if 0 /* FSFmacs */ - c.poll_suppress_count = async_timer_suppress_count; -#endif - c.gcpro = gcprolist; - catchlist = &c; - - /* Call FUNC. */ - if (SETJMP (c.jmp)) - { - /* Throw works by a longjmp that comes right here. */ - if (threw) *threw = 1; - return c.val; - } - c.val = (*func) (arg); - if (threw) *threw = 0; - catchlist = c.next; - return c.val; -} - - -/* Unwind the specbind, catch, and handler stacks back to CATCH, and - jump to that CATCH, returning VALUE as the value of that catch. - - This is the guts Fthrow and Fsignal; they differ only in the way - they choose the catch tag to throw to. A catch tag for a - condition-case form has a TAG of Qnil. - - Before each catch is discarded, unbind all special bindings and - execute all unwind-protect clauses made above that catch. Unwind - the handler stack as we go, so that the proper handlers are in - effect for each unwind-protect clause we run. At the end, restore - some static info saved in CATCH, and longjmp to the location - specified in the - - This is used for correct unwinding in Fthrow and Fsignal. */ - -static void -unwind_to_catch (struct catchtag *c, Lisp_Object val) -{ -#if 0 /* FSFmacs */ - /* #### */ - REGISTER int last_time; -#endif - - /* Unwind the specbind, catch, and handler stacks back to CATCH - Before each catch is discarded, unbind all special bindings - and execute all unwind-protect clauses made above that catch. - At the end, restore some static info saved in CATCH, - and longjmp to the location specified. - */ - - /* Save the value somewhere it will be GC'ed. - (Can't overwrite tag slot because an unwind-protect may - want to throw to this same tag, which isn't yet invalid.) */ - c->val = val; - -#if 0 /* FSFmacs */ - /* Restore the polling-suppression count. */ - set_poll_suppress_count (catch->poll_suppress_count); -#endif - -#if 0 /* FSFmacs */ - /* #### FSFmacs has the following loop. Is it more correct? */ - do - { - last_time = catchlist == c; - - /* Unwind the specpdl stack, and then restore the proper set of - handlers. */ - unbind_to (catchlist->pdlcount, Qnil); - handlerlist = catchlist->handlerlist; - catchlist = catchlist->next; - } - while (! last_time); -#else /* Actual XEmacs code */ - /* Unwind the specpdl stack */ - unbind_to (c->pdlcount, Qnil); - catchlist = c->next; -#endif - - gcprolist = c->gcpro; - backtrace_list = c->backlist; - lisp_eval_depth = c->lisp_eval_depth; - -#if 0 /* no longer used */ - throw_level = 0; -#endif - LONGJMP (c->jmp, 1); -} - -static DOESNT_RETURN -throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p, - Lisp_Object sig, Lisp_Object data) -{ -#if 0 - /* die if we recurse more than is reasonable */ - if (++throw_level > 20) - abort(); -#endif - - /* If bomb_out_p is t, this is being called from Fsignal as a - "last resort" when there is no handler for this error and - the debugger couldn't be invoked, so we are throwing to - 'top-level. If this tag doesn't exist (happens during the - initialization stages) we would get in an infinite recursive - Fsignal/Fthrow loop, so instead we bomb out to the - really-early-error-handler. - - Note that in fact the only time that the "last resort" - occurs is when there's no catch for 'top-level -- the - 'top-level catch and the catch-all error handler are - established at the same time, in initial_command_loop/ - top_level_1. - - #### Fix this horrifitude! - */ - - while (1) - { - REGISTER struct catchtag *c; - -#if 0 /* FSFmacs */ - if (!NILP (tag)) /* #### */ -#endif - for (c = catchlist; c; c = c->next) - { - if (EQ (c->tag, tag)) - unwind_to_catch (c, val); - } - if (!bomb_out_p) - tag = Fsignal (Qno_catch, list2 (tag, val)); - else - call1 (Qreally_early_error_handler, Fcons (sig, data)); - } - - /* can't happen. who cares? - (Sun's compiler does) */ - /* throw_level--; */ - /* getting tired of compilation warnings */ - /* return Qnil; */ -} - -/* See above, where CATCHLIST is defined, for a description of how - Fthrow() works. - - Fthrow() is also called by Fsignal(), to do a non-local jump - back to the appropriate condition-case handler after (maybe) - the debugger is entered. In that case, TAG is the value - of Vcondition_handlers that was in place just after the - condition-case handler was set up. The car of this will be - some data referring to the handler: Its car will be Qunbound - (thus, this tag can never be generated by Lisp code), and - its CDR will be the HANDLERS argument to condition_case_1() - (either Qerror, Qt, or a list of handlers as in `condition-case'). - This works fine because Fthrow() does not care what TAG was - passed to it: it just looks up the catch list for something - that is EQ() to TAG. When it finds it, it will longjmp() - back to the place that established the catch (in this case, - condition_case_1). See below for more info. -*/ - -DEFUN ("throw", Fthrow, 2, 2, 0, /* -\(throw TAG VALUE): throw to the catch for TAG and return VALUE from it. -Both TAG and VALUE are evalled. -*/ - (tag, val)) -{ - throw_or_bomb_out (tag, val, 0, Qnil, Qnil); /* Doesn't return */ - return Qnil; -} - -DEFUN ("unwind-protect", Funwind_protect, 1, UNEVALLED, 0, /* -Do BODYFORM, protecting with UNWINDFORMS. -Usage looks like (unwind-protect BODYFORM UNWINDFORMS...). -If BODYFORM completes normally, its value is returned -after executing the UNWINDFORMS. -If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway. -*/ - (args)) -{ - /* This function can GC */ - int speccount = specpdl_depth(); - - record_unwind_protect (Fprogn, XCDR (args)); - return unbind_to (speccount, Feval (XCAR (args))); -} - - -/************************************************************************/ -/* Signalling and trapping errors */ -/************************************************************************/ - -static Lisp_Object -condition_bind_unwind (Lisp_Object loser) -{ - struct Lisp_Cons *victim; - /* ((handler-fun . handler-args) ... other handlers) */ - Lisp_Object tem = XCAR (loser); - - while (CONSP (tem)) - { - victim = XCONS (tem); - tem = victim->cdr; - free_cons (victim); - } - victim = XCONS (loser); - - if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */ - Vcondition_handlers = victim->cdr; - - free_cons (victim); - return Qnil; -} - -static Lisp_Object -condition_case_unwind (Lisp_Object loser) -{ - struct Lisp_Cons *victim; - - /* (( . clauses) ... other handlers */ - victim = XCONS (XCAR (loser)); - free_cons (victim); - - victim = XCONS (loser); - if (EQ (loser, Vcondition_handlers)) /* may have been rebound to some tail */ - Vcondition_handlers = victim->cdr; - - free_cons (victim); - return Qnil; -} - -/* Split out from condition_case_3 so that primitive C callers - don't have to cons up a lisp handler form to be evaluated. */ - -/* Call a function BFUN of one argument BARG, trapping errors as - specified by HANDLERS. If no error occurs that is indicated by - HANDLERS as something to be caught, the return value of this - function is the return value from BFUN. If such an error does - occur, HFUN is called, and its return value becomes the - return value of condition_case_1(). The second argument passed - to HFUN will always be HARG. The first argument depends on - HANDLERS: - - If HANDLERS is Qt, all errors (this includes QUIT, but not - non-local exits with `throw') cause HFUN to be invoked, and VAL - (the first argument to HFUN) is a cons (SIG . DATA) of the - arguments passed to `signal'. The debugger is not invoked even if - `debug-on-error' was set. - - A HANDLERS value of Qerror is the same as Qt except that the - debugger is invoked if `debug-on-error' was set. - - Otherwise, HANDLERS should be a list of lists (CONDITION-NAME BODY ...) - exactly as in `condition-case', and errors will be trapped - as indicated in HANDLERS. VAL (the first argument to HFUN) will - be a cons whose car is the cons (SIG . DATA) and whose CDR is the - list (BODY ...) from the appropriate slot in HANDLERS. - - This function pushes HANDLERS onto the front of Vcondition_handlers - (actually with a Qunbound marker as well -- see Fthrow() above - for why), establishes a catch whose tag is this new value of - Vcondition_handlers, and calls BFUN. When Fsignal() is called, - it calls Fthrow(), setting TAG to this same new value of - Vcondition_handlers and setting VAL to the same thing that will - be passed to HFUN, as above. Fthrow() longjmp()s back to the - jump point we just established, and we in turn just call the - HFUN and return its value. - - For a real condition-case, HFUN will always be - run_condition_case_handlers() and HARG is the argument VAR - to condition-case. That function just binds VAR to the cons - (SIG . DATA) that is the CAR of VAL, and calls the handler - (BODY ...) that is the CDR of VAL. Note that before calling - Fthrow(), Fsignal() restored Vcondition_handlers to the value - it had *before* condition_case_1() was called. This maintains - consistency (so that the state of things at exit of - condition_case_1() is the same as at entry), and implies - that the handler can signal the same error again (possibly - after processing of its own), without getting in an infinite - loop. */ - -Lisp_Object -condition_case_1 (Lisp_Object handlers, - Lisp_Object (*bfun) (Lisp_Object barg), - Lisp_Object barg, - Lisp_Object (*hfun) (Lisp_Object val, Lisp_Object harg), - Lisp_Object harg) -{ - int speccount = specpdl_depth(); - struct catchtag c; - struct gcpro gcpro1; - -#if 0 /* FSFmacs */ - c.tag = Qnil; -#else - /* Do consing now so out-of-memory error happens up front */ - /* (unbound . stuff) is a special condition-case kludge marker - which is known specially by Fsignal. - This is an abomination, but to fix it would require either - making condition_case cons (a union of the conditions of the clauses) - or changing the byte-compiler output (no thanks). */ - c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers), - Vcondition_handlers); -#endif - c.val = Qnil; - c.backlist = backtrace_list; -#if 0 /* FSFmacs */ - /* #### */ - c.handlerlist = handlerlist; -#endif - c.lisp_eval_depth = lisp_eval_depth; - c.pdlcount = specpdl_depth(); -#if 0 /* FSFmacs */ - c.poll_suppress_count = async_timer_suppress_count; -#endif - c.gcpro = gcprolist; - /* #### FSFmacs does the following statement *after* the setjmp(). */ - c.next = catchlist; - - if (SETJMP (c.jmp)) - { - /* throw does ungcpro, etc */ - return (*hfun) (c.val, harg); - } - - record_unwind_protect (condition_case_unwind, c.tag); - - catchlist = &c; -#if 0 /* FSFmacs */ - h.handler = handlers; - h.var = Qnil; - h.next = handlerlist; - h.tag = &c; - handlerlist = &h; -#else - Vcondition_handlers = c.tag; -#endif - GCPRO1 (harg); /* Somebody has to gc-protect */ - - c.val = ((*bfun) (barg)); - - /* The following is *not* true: (ben) - - ungcpro, restoring catchlist and condition_handlers are actually - redundant since unbind_to now restores them. But it looks funny not to - have this code here, and it doesn't cost anything, so I'm leaving it.*/ - UNGCPRO; - catchlist = c.next; - Vcondition_handlers = XCDR (c.tag); - - return unbind_to (speccount, c.val); -} - -static Lisp_Object -run_condition_case_handlers (Lisp_Object val, Lisp_Object var) -{ - /* This function can GC */ -#if 0 /* FSFmacs */ - if (!NILP (h.var)) - specbind (h.var, c.val); - val = Fprogn (Fcdr (h.chosen_clause)); - - /* Note that this just undoes the binding of h.var; whoever - longjmp()ed to us unwound the stack to c.pdlcount before - throwing. */ - unbind_to (c.pdlcount, Qnil); - return val; -#else - int speccount; - - CHECK_TRUE_LIST (val); - if (NILP (var)) - return Fprogn (Fcdr (val)); /* tail call */ - - speccount = specpdl_depth(); - specbind (var, Fcar (val)); - val = Fprogn (Fcdr (val)); - return unbind_to (speccount, val); -#endif -} - -/* Here for bytecode to call non-consfully. This is exactly like - condition-case except that it takes three arguments rather - than a single list of arguments. */ -Lisp_Object -condition_case_3 (Lisp_Object bodyform, Lisp_Object var, Lisp_Object handlers) -{ - /* This function can GC */ - Lisp_Object handler; - - EXTERNAL_LIST_LOOP_2 (handler, handlers) - { - if (NILP (handler)) - ; - else if (CONSP (handler)) - { - Lisp_Object conditions = XCAR (handler); - /* CONDITIONS must a condition name or a list of condition names */ - if (SYMBOLP (conditions)) - ; - else - { - Lisp_Object condition; - EXTERNAL_LIST_LOOP_2 (condition, conditions) - if (!SYMBOLP (condition)) - goto invalid_condition_handler; - } - } - else - { - invalid_condition_handler: - signal_simple_error ("Invalid condition handler", handler); - } - } - - CHECK_SYMBOL (var); - - return condition_case_1 (handlers, - Feval, bodyform, - run_condition_case_handlers, - var); -} - -DEFUN ("condition-case", Fcondition_case, 2, UNEVALLED, 0, /* -Regain control when an error is signalled. -Usage looks like (condition-case VAR BODYFORM HANDLERS...). -Executes BODYFORM and returns its value if no error happens. -Each element of HANDLERS looks like (CONDITION-NAME BODY...) -where the BODY is made of Lisp expressions. - -A handler is applicable to an error if CONDITION-NAME is one of the -error's condition names. If an error happens, the first applicable -handler is run. As a special case, a CONDITION-NAME of t matches -all errors, even those without the `error' condition name on them -\(e.g. `quit'). - -The car of a handler may be a list of condition names -instead of a single condition name. - -When a handler handles an error, -control returns to the condition-case and the handler BODY... is executed -with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA). -VAR may be nil; then you do not get access to the signal information. - -The value of the last BODY form is returned from the condition-case. -See also the function `signal' for more info. - -Note that at the time the condition handler is invoked, the Lisp stack -and the current catches, condition-cases, and bindings have all been -popped back to the state they were in just before the call to -`condition-case'. This means that resignalling the error from -within the handler will not result in an infinite loop. - -If you want to establish an error handler that is called with the -Lisp stack, bindings, etc. as they were when `signal' was called, -rather than when the handler was set, use `call-with-condition-handler'. -*/ - (args)) -{ - /* This function can GC */ - Lisp_Object var = XCAR (args); - Lisp_Object bodyform = XCAR (XCDR (args)); - Lisp_Object handlers = XCDR (XCDR (args)); - return condition_case_3 (bodyform, var, handlers); -} - -DEFUN ("call-with-condition-handler", Fcall_with_condition_handler, 2, MANY, 0, /* -Regain control when an error is signalled, without popping the stack. -Usage looks like (call-with-condition-handler HANDLER FUNCTION &rest ARGS). -This function is similar to `condition-case', but the handler is invoked -with the same environment (Lisp stack, bindings, catches, condition-cases) -that was current when `signal' was called, rather than when the handler -was established. - -HANDLER should be a function of one argument, which is a cons of the args -\(SIG . DATA) that were passed to `signal'. It is invoked whenever -`signal' is called (this differs from `condition-case', which allows -you to specify which errors are trapped). If the handler function -returns, `signal' continues as if the handler were never invoked. -\(It continues to look for handlers established earlier than this one, -and invokes the standard error-handler if none is found.) -*/ - (int nargs, Lisp_Object *args)) /* Note! Args side-effected! */ -{ - /* This function can GC */ - int speccount = specpdl_depth(); - Lisp_Object tem; - - /* #### If there were a way to check that args[0] were a function - which accepted one arg, that should be done here ... */ - - /* (handler-fun . handler-args) */ - tem = noseeum_cons (list1 (args[0]), Vcondition_handlers); - record_unwind_protect (condition_bind_unwind, tem); - Vcondition_handlers = tem; - - /* Caller should have GC-protected args */ - return unbind_to (speccount, Ffuncall (nargs - 1, args + 1)); -} - -static int -condition_type_p (Lisp_Object type, Lisp_Object conditions) -{ - if (EQ (type, Qt)) - /* (condition-case c # (t c)) catches -all- signals - * Use with caution! */ - return 1; - - if (SYMBOLP (type)) - return !NILP (Fmemq (type, conditions)); - - for (; CONSP (type); type = XCDR (type)) - if (!NILP (Fmemq (XCAR (type), conditions))) - return 1; - - return 0; -} - -static Lisp_Object -return_from_signal (Lisp_Object value) -{ -#if 1 - /* Most callers are not prepared to handle gc if this - returns. So, since this feature is not very useful, - take it out. */ - /* Have called debugger; return value to signaller */ - return value; -#else /* But the reality is that that stinks, because: */ - /* GACK!!! Really want some way for debug-on-quit errors - to be continuable!! */ - error ("Returning a value from an error is no longer supported"); -#endif -} - -extern int in_display; - - -/************************************************************************/ -/* the workhorse error-signaling function */ -/************************************************************************/ - -/* #### This function has not been synched with FSF. It diverges - significantly. */ - -static Lisp_Object -signal_1 (Lisp_Object sig, Lisp_Object data) -{ - /* This function can GC */ - struct gcpro gcpro1, gcpro2; - Lisp_Object conditions; - Lisp_Object handlers; - /* signal_call_debugger() could get called more than once - (once when a call-with-condition-handler is about to - be dealt with, and another when a condition-case handler - is about to be invoked). So make sure the debugger and/or - stack trace aren't done more than once. */ - int stack_trace_displayed = 0; - int debugger_entered = 0; - GCPRO2 (conditions, handlers); - - if (!initialized) - { - /* who knows how much has been initialized? Safest bet is - just to bomb out immediately. */ - fprintf (stderr, "Error before initialization is complete!\n"); - abort (); - } - - if (gc_in_progress || in_display) - /* This is one of many reasons why you can't run lisp code from redisplay. - There is no sensible way to handle errors there. */ - abort (); - - conditions = Fget (sig, Qerror_conditions, Qnil); - - for (handlers = Vcondition_handlers; - CONSP (handlers); - handlers = XCDR (handlers)) - { - Lisp_Object handler_fun = XCAR (XCAR (handlers)); - Lisp_Object handler_data = XCDR (XCAR (handlers)); - Lisp_Object outer_handlers = XCDR (handlers); - - if (!UNBOUNDP (handler_fun)) - { - /* call-with-condition-handler */ - Lisp_Object tem; - Lisp_Object all_handlers = Vcondition_handlers; - struct gcpro ngcpro1; - NGCPRO1 (all_handlers); - Vcondition_handlers = outer_handlers; - - tem = signal_call_debugger (conditions, sig, data, - outer_handlers, 1, - &stack_trace_displayed, - &debugger_entered); - if (!UNBOUNDP (tem)) - RETURN_NUNGCPRO (return_from_signal (tem)); - - tem = Fcons (sig, data); - if (NILP (handler_data)) - tem = call1 (handler_fun, tem); - else - { - /* (This code won't be used (for now?).) */ - struct gcpro nngcpro1; - Lisp_Object args[3]; - NNGCPRO1 (args[0]); - nngcpro1.nvars = 3; - args[0] = handler_fun; - args[1] = tem; - args[2] = handler_data; - nngcpro1.var = args; - tem = Fapply (3, args); - NNUNGCPRO; - } - NUNGCPRO; -#if 0 - if (!EQ (tem, Qsignal)) - return return_from_signal (tem); -#endif - /* If handler didn't throw, try another handler */ - Vcondition_handlers = all_handlers; - } - - /* It's a condition-case handler */ - - /* t is used by handlers for all conditions, set up by C code. - * debugger is not called even if debug_on_error */ - else if (EQ (handler_data, Qt)) - { - UNGCPRO; - return Fthrow (handlers, Fcons (sig, data)); - } - /* `error' is used similarly to the way `t' is used, but in - addition it invokes the debugger if debug_on_error. - This is normally used for the outer command-loop error - handler. */ - else if (EQ (handler_data, Qerror)) - { - Lisp_Object tem = signal_call_debugger (conditions, sig, data, - outer_handlers, 0, - &stack_trace_displayed, - &debugger_entered); - - UNGCPRO; - if (!UNBOUNDP (tem)) - return return_from_signal (tem); - - tem = Fcons (sig, data); - return Fthrow (handlers, tem); - } - else - { - /* handler established by real (Lisp) condition-case */ - Lisp_Object h; - - for (h = handler_data; CONSP (h); h = Fcdr (h)) - { - Lisp_Object clause = Fcar (h); - Lisp_Object tem = Fcar (clause); - - if (condition_type_p (tem, conditions)) - { - tem = signal_call_debugger (conditions, sig, data, - outer_handlers, 1, - &stack_trace_displayed, - &debugger_entered); - UNGCPRO; - if (!UNBOUNDP (tem)) - return return_from_signal (tem); - - /* Doesn't return */ - tem = Fcons (Fcons (sig, data), Fcdr (clause)); - return Fthrow (handlers, tem); - } - } - } - } - - /* If no handler is present now, try to run the debugger, - and if that fails, throw to top level. - - #### The only time that no handler is present is during - temacs or perhaps very early in XEmacs. In both cases, - there is no 'top-level catch. (That's why the - "bomb-out" hack was added.) - - #### Fix this horrifitude! - */ - signal_call_debugger (conditions, sig, data, Qnil, 0, - &stack_trace_displayed, - &debugger_entered); - UNGCPRO; - throw_or_bomb_out (Qtop_level, Qt, 1, sig, data); /* Doesn't return */ - return Qnil; -} - - -/****************** Error functions class 1 ******************/ - -/* Class 1: General functions that signal an error. - These functions take an error type and a list of associated error - data. */ - -/* The simplest external error function: it would be called - signal_continuable_error() in the terminology below, but it's - Lisp-callable. */ - -DEFUN ("signal", Fsignal, 2, 2, 0, /* -Signal a continuable error. Args are ERROR-SYMBOL, and associated DATA. -An error symbol is a symbol defined using `define-error'. -DATA should be a list. Its elements are printed as part of the error message. -If the signal is handled, DATA is made available to the handler. -See also the function `signal-error', and the functions to handle errors: -`condition-case' and `call-with-condition-handler'. - -Note that this function can return, if the debugger is invoked and the -user invokes the "return from signal" option. -*/ - (error_symbol, data)) -{ - /* Fsignal() is one of these functions that's called all the time - with newly-created Lisp objects. We allow this; but we must GC- - protect the objects because all sorts of weird stuff could - happen. */ - - struct gcpro gcpro1; - - GCPRO1 (data); - if (!NILP (Vcurrent_error_state)) - { - if (!NILP (Vcurrent_warning_class)) - warn_when_safe_lispobj (Vcurrent_warning_class, Qwarning, - Fcons (error_symbol, data)); - Fthrow (Qunbound_suspended_errors_tag, Qnil); - abort (); /* Better not get here! */ - } - RETURN_UNGCPRO (signal_1 (error_symbol, data)); -} - -/* Signal a non-continuable error. */ - -DOESNT_RETURN -signal_error (Lisp_Object sig, Lisp_Object data) -{ - for (;;) - Fsignal (sig, data); -} - -static Lisp_Object -call_with_suspended_errors_1 (Lisp_Object opaque_arg) -{ - Lisp_Object val; - Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg); - PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]), - kludgy_args + 2, XINT (kludgy_args[1])); - return val; -} - -static Lisp_Object -restore_current_warning_class (Lisp_Object warning_class) -{ - Vcurrent_warning_class = warning_class; - return Qnil; -} - -static Lisp_Object -restore_current_error_state (Lisp_Object error_state) -{ - Vcurrent_error_state = error_state; - return Qnil; -} - -/* Many functions would like to do one of three things if an error - occurs: - - (1) signal the error, as usual. - (2) silently fail and return some error value. - (3) do as (2) but issue a warning in the process. - - Currently there's lots of stuff that passes an Error_behavior - value and calls maybe_signal_error() and other such functions. - This approach is inherently error-prone and broken. A much - more robust and easier approach is to use call_with_suspended_errors(). - Wrap this around any function in which you might want errors - to not be errors. -*/ - -Lisp_Object -call_with_suspended_errors (lisp_fn_t fun, volatile Lisp_Object retval, - Lisp_Object class, Error_behavior errb, - int nargs, ...) -{ - va_list vargs; - int speccount; - Lisp_Object kludgy_args[22]; - Lisp_Object *args = kludgy_args + 2; - int i; - Lisp_Object no_error; - - assert (SYMBOLP (class)); /* sanity-check */ - assert (!NILP (class)); - assert (nargs >= 0 && nargs < 20); - - /* ERROR_ME means don't trap errors. (However, if errors are - already trapped, we leave them trapped.) - - Otherwise, we trap errors, and trap warnings if ERROR_ME_WARN. - - If ERROR_ME_NOT, it causes no warnings even if warnings - were previously enabled. However, we never change the - warning class from one to another. */ - if (!ERRB_EQ (errb, ERROR_ME)) - { - if (ERRB_EQ (errb, ERROR_ME_NOT)) /* person wants no warnings */ - class = Qnil; - errb = ERROR_ME_NOT; - no_error = Qt; - } - else - no_error = Qnil; - - va_start (vargs, nargs); - for (i = 0; i < nargs; i++) - args[i] = va_arg (vargs, Lisp_Object); - va_end (vargs); - - /* If error-checking is not disabled, just call the function. - It's important not to override disabled error-checking with - enabled error-checking. */ - - if (ERRB_EQ (errb, ERROR_ME)) - { - Lisp_Object val; - PRIMITIVE_FUNCALL (val, fun, args, nargs); - return val; - } - - speccount = specpdl_depth(); - if (NILP (class) || NILP (Vcurrent_warning_class)) - { - /* If we're currently calling for no warnings, then make it so. - If we're currently calling for warnings and we weren't - previously, then set our warning class; otherwise, leave - the existing one alone. */ - record_unwind_protect (restore_current_warning_class, - Vcurrent_warning_class); - Vcurrent_warning_class = class; - } - if (!EQ (Vcurrent_error_state, no_error)) - { - record_unwind_protect (restore_current_error_state, - Vcurrent_error_state); - Vcurrent_error_state = no_error; - } - - { - int threw; - Lisp_Object the_retval; - Lisp_Object opaque1 = make_opaque_ptr (kludgy_args); - Lisp_Object opaque2 = make_opaque_ptr ((void *) fun); - struct gcpro gcpro1, gcpro2; - - GCPRO2 (opaque1, opaque2); - kludgy_args[0] = opaque2; - kludgy_args[1] = make_int (nargs); - the_retval = internal_catch (Qunbound_suspended_errors_tag, - call_with_suspended_errors_1, - opaque1, &threw); - free_opaque_ptr (opaque1); - free_opaque_ptr (opaque2); - UNGCPRO; - /* Use the returned value except in non-local exit, when - RETVAL applies. */ - /* Some perverse compilers require the perverse cast below. */ - return unbind_to (speccount, - threw ? *((Lisp_Object*) &(retval)) : the_retval); - } -} - -/* Signal a non-continuable error or display a warning or do nothing, - according to ERRB. CLASS is the class of warning and should - refer to what sort of operation is being done (e.g. Qtoolbar, - Qresource, etc.). */ - -void -maybe_signal_error (Lisp_Object sig, Lisp_Object data, Lisp_Object class, - Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - else if (ERRB_EQ (errb, ERROR_ME_WARN)) - warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data)); - else - for (;;) - Fsignal (sig, data); -} - -/* Signal a continuable error or display a warning or do nothing, - according to ERRB. */ - -Lisp_Object -maybe_signal_continuable_error (Lisp_Object sig, Lisp_Object data, - Lisp_Object class, Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qnil; - else if (ERRB_EQ (errb, ERROR_ME_WARN)) - { - warn_when_safe_lispobj (class, Qwarning, Fcons (sig, data)); - return Qnil; - } - else - return Fsignal (sig, data); -} - - -/****************** Error functions class 2 ******************/ - -/* Class 2: Printf-like functions that signal an error. - These functions signal an error of type Qerror, whose data - is a single string, created using the arguments. */ - -/* dump an error message; called like printf */ - -DOESNT_RETURN -error (CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - signal_error (Qerror, list1 (obj)); -} - -void -maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - maybe_signal_error (Qerror, list1 (obj), class, errb); -} - -Lisp_Object -continuable_error (CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - return Fsignal (Qerror, list1 (obj)); -} - -Lisp_Object -maybe_continuable_error (Lisp_Object class, Error_behavior errb, - CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qnil; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - return maybe_signal_continuable_error (Qerror, list1 (obj), class, errb); -} - - -/****************** Error functions class 3 ******************/ - -/* Class 3: Signal an error with a string and an associated object. - These functions signal an error of type Qerror, whose data - is two objects, a string and a related Lisp object (usually the object - where the error is occurring). */ - -DOESNT_RETURN -signal_simple_error (CONST char *reason, Lisp_Object frob) -{ - signal_error (Qerror, list2 (build_translated_string (reason), frob)); -} - -void -maybe_signal_simple_error (CONST char *reason, Lisp_Object frob, - Lisp_Object class, Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - maybe_signal_error (Qerror, list2 (build_translated_string (reason), frob), - class, errb); -} - -Lisp_Object -signal_simple_continuable_error (CONST char *reason, Lisp_Object frob) -{ - return Fsignal (Qerror, list2 (build_translated_string (reason), frob)); -} - -Lisp_Object -maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob, - Lisp_Object class, Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qnil; - return maybe_signal_continuable_error - (Qerror, list2 (build_translated_string (reason), - frob), class, errb); -} - - -/****************** Error functions class 4 ******************/ - -/* Class 4: Printf-like functions that signal an error. - These functions signal an error of type Qerror, whose data - is a two objects, a string (created using the arguments) and a - Lisp object. -*/ - -DOESNT_RETURN -error_with_frob (Lisp_Object frob, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - signal_error (Qerror, list2 (obj, frob)); -} - -void -maybe_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - maybe_signal_error (Qerror, list2 (obj, frob), class, errb); -} - -Lisp_Object -continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - return Fsignal (Qerror, list2 (obj, frob)); -} - -Lisp_Object -maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qnil; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, - args); - va_end (args); - - /* Fsignal GC-protects its args */ - return maybe_signal_continuable_error (Qerror, list2 (obj, frob), - class, errb); -} - - -/****************** Error functions class 5 ******************/ - -/* Class 5: Signal an error with a string and two associated objects. - These functions signal an error of type Qerror, whose data - is three objects, a string and two related Lisp objects. */ - -DOESNT_RETURN -signal_simple_error_2 (CONST char *reason, - Lisp_Object frob0, Lisp_Object frob1) -{ - signal_error (Qerror, list3 (build_translated_string (reason), frob0, - frob1)); -} - -void -maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0, - Lisp_Object frob1, Lisp_Object class, - Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - maybe_signal_error (Qerror, list3 (build_translated_string (reason), frob0, - frob1), class, errb); -} - - -Lisp_Object -signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, - Lisp_Object frob1) -{ - return Fsignal (Qerror, list3 (build_translated_string (reason), frob0, - frob1)); -} - -Lisp_Object -maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, - Lisp_Object frob1, Lisp_Object class, - Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qnil; - return maybe_signal_continuable_error - (Qerror, list3 (build_translated_string (reason), frob0, - frob1), - class, errb); -} - - -/* This is what the QUIT macro calls to signal a quit */ -void -signal_quit (void) -{ - /* This function can GC */ - if (EQ (Vquit_flag, Qcritical)) - debug_on_quit |= 2; /* set critical bit. */ - Vquit_flag = Qnil; - /* note that this is continuable. */ - Fsignal (Qquit, Qnil); -} - - -/* Used in core lisp functions for efficiency */ -void -signal_void_function_error (Lisp_Object function) -{ - Fsignal (Qvoid_function, list1 (function)); -} - -static void -signal_invalid_function_error (Lisp_Object function) -{ - Fsignal (Qinvalid_function, list1 (function)); -} - -static void -signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs) -{ - Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs))); -} - -/* Used in list traversal macros for efficiency. */ -void -signal_malformed_list_error (Lisp_Object list) -{ - Fsignal (Qmalformed_list, list1 (list)); -} - -void -signal_malformed_property_list_error (Lisp_Object list) -{ - Fsignal (Qmalformed_property_list, list1 (list)); -} - -void -signal_circular_list_error (Lisp_Object list) -{ - Fsignal (Qcircular_list, list1 (list)); -} - -void -signal_circular_property_list_error (Lisp_Object list) -{ - Fsignal (Qcircular_property_list, list1 (list)); -} - -/************************************************************************/ -/* User commands */ -/************************************************************************/ - -DEFUN ("commandp", Fcommandp, 1, 1, 0, /* -Return t if FUNCTION makes provisions for interactive calling. -This means it contains a description for how to read arguments to give it. -The value is nil for an invalid function or a symbol with no function -definition. - -Interactively callable functions include - --- strings and vectors (treated as keyboard macros) --- lambda-expressions that contain a top-level call to `interactive' --- autoload definitions made by `autoload' with non-nil fourth argument - (i.e. the interactive flag) --- compiled-function objects with a non-nil `compiled-function-interactive' - value --- subrs (built-in functions) that are interactively callable - -Also, a symbol satisfies `commandp' if its function definition does so. -*/ - (function)) -{ - Lisp_Object fun = indirect_function (function, 0); - - if (COMPILED_FUNCTIONP (fun)) - return XCOMPILED_FUNCTION (fun)->flags.interactivep ? Qt : Qnil; - - /* Lists may represent commands. */ - if (CONSP (fun)) - { - Lisp_Object funcar = XCAR (fun); - if (EQ (funcar, Qlambda)) - return Fassq (Qinteractive, Fcdr (Fcdr (fun))); - if (EQ (funcar, Qautoload)) - return Fcar (Fcdr (Fcdr (Fcdr (fun)))); - else - return Qnil; - } - - /* Emacs primitives are interactive if their DEFUN specifies an - interactive spec. */ - if (SUBRP (fun)) - return XSUBR (fun)->prompt ? Qt : Qnil; - - /* Strings and vectors are keyboard macros. */ - if (VECTORP (fun) || STRINGP (fun)) - return Qt; - - /* Everything else (including Qunbound) is not a command. */ - return Qnil; -} - -DEFUN ("command-execute", Fcommand_execute, 1, 3, 0, /* -Execute CMD as an editor command. -CMD must be an object that satisfies the `commandp' predicate. -Optional second arg RECORD-FLAG is as in `call-interactively'. -The argument KEYS specifies the value to use instead of (this-command-keys) -when reading the arguments. -*/ - (cmd, record, keys)) -{ - /* This function can GC */ - Lisp_Object prefixarg; - Lisp_Object final = cmd; - struct backtrace backtrace; - struct console *con = XCONSOLE (Vselected_console); - - prefixarg = con->prefix_arg; - con->prefix_arg = Qnil; - Vcurrent_prefix_arg = prefixarg; - debug_on_next_call = 0; /* #### from FSFmacs; correct? */ - - if (SYMBOLP (cmd) && !NILP (Fget (cmd, Qdisabled, Qnil))) - return run_hook (Vdisabled_command_hook); - - for (;;) - { - final = indirect_function (cmd, 1); - if (CONSP (final) && EQ (Fcar (final), Qautoload)) - do_autoload (final, cmd); - else - break; - } - - if (CONSP (final) || SUBRP (final) || COMPILED_FUNCTIONP (final)) - { - backtrace.function = &Qcall_interactively; - backtrace.args = &cmd; - backtrace.nargs = 1; - backtrace.evalargs = 0; - backtrace.pdlcount = specpdl_depth(); - backtrace.debug_on_exit = 0; - PUSH_BACKTRACE (backtrace); - - final = Fcall_interactively (cmd, record, keys); - - POP_BACKTRACE (backtrace); - return final; - } - else if (STRINGP (final) || VECTORP (final)) - { - return Fexecute_kbd_macro (final, prefixarg); - } - else - { - Fsignal (Qwrong_type_argument, - Fcons (Qcommandp, - ((EQ (cmd, final)) - ? list1 (cmd) - : list2 (cmd, final)))); - return Qnil; - } -} - -DEFUN ("interactive-p", Finteractive_p, 0, 0, 0, /* -Return t if function in which this appears was called interactively. -This means that the function was called with call-interactively (which -includes being called as the binding of a key) -and input is currently coming from the keyboard (not in keyboard macro). -*/ - ()) -{ - REGISTER struct backtrace *btp; - REGISTER Lisp_Object fun; - - if (!INTERACTIVE) - return Qnil; - - /* Unless the object was compiled, skip the frame of interactive-p itself - (if interpreted) or the frame of byte-code (if called from a compiled - function). Note that *btp->function may be a symbol pointing at a - compiled function. */ - btp = backtrace_list; - -#if 0 /* FSFmacs */ - - /* #### FSFmacs does the following instead. I can't figure - out which one is more correct. */ - /* If this isn't a byte-compiled function, there may be a frame at - the top for Finteractive_p itself. If so, skip it. */ - fun = Findirect_function (*btp->function); - if (SUBRP (fun) && XSUBR (fun) == &Sinteractive_p) - btp = btp->next; - - /* If we're running an Emacs 18-style byte-compiled function, there - may be a frame for Fbyte_code. Now, given the strictest - definition, this function isn't really being called - interactively, but because that's the way Emacs 18 always builds - byte-compiled functions, we'll accept it for now. */ - if (EQ (*btp->function, Qbyte_code)) - btp = btp->next; - - /* If this isn't a byte-compiled function, then we may now be - looking at several frames for special forms. Skip past them. */ - while (btp && - btp->nargs == UNEVALLED) - btp = btp->next; - -#else - - if (! (COMPILED_FUNCTIONP (Findirect_function (*btp->function)))) - btp = btp->next; - for (; - btp && (btp->nargs == UNEVALLED - || EQ (*btp->function, Qbyte_code)); - btp = btp->next) - {} - /* btp now points at the frame of the innermost function - that DOES eval its args. - If it is a built-in function (such as load or eval-region) - return nil. */ - /* Beats me why this is necessary, but it is */ - if (btp && EQ (*btp->function, Qcall_interactively)) - return Qt; - -#endif - - fun = Findirect_function (*btp->function); - if (SUBRP (fun)) - return Qnil; - /* btp points to the frame of a Lisp function that called interactive-p. - Return t if that function was called interactively. */ - if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) - return Qt; - return Qnil; -} - - -/************************************************************************/ -/* Autoloading */ -/************************************************************************/ - -DEFUN ("autoload", Fautoload, 2, 5, 0, /* -Define FUNCTION to autoload from FILE. -FUNCTION is a symbol; FILE is a file name string to pass to `load'. -Third arg DOCSTRING is documentation for the function. -Fourth arg INTERACTIVE if non-nil says function can be called interactively. -Fifth arg TYPE indicates the type of the object: - nil or omitted says FUNCTION is a function, - `keymap' says FUNCTION is really a keymap, and - `macro' or t says FUNCTION is really a macro. -Third through fifth args give info about the real definition. -They default to nil. -If FUNCTION is already defined other than as an autoload, -this does nothing and returns nil. -*/ - (function, file, docstring, interactive, type)) -{ - /* This function can GC */ - CHECK_SYMBOL (function); - CHECK_STRING (file); - - /* If function is defined and not as an autoload, don't override */ - { - Lisp_Object f = XSYMBOL (function)->function; - if (!UNBOUNDP (f) && !(CONSP (f) && EQ (XCAR (f), Qautoload))) - return Qnil; - } - - if (purify_flag) - { - /* Attempt to avoid consing identical (string=) pure strings. */ - file = Fsymbol_name (Fintern (file, Qnil)); - } - - return Ffset (function, - Fpurecopy (Fcons (Qautoload, list4 (file, - docstring, - interactive, - type)))); -} - -Lisp_Object -un_autoload (Lisp_Object oldqueue) -{ - /* This function can GC */ - REGISTER Lisp_Object queue, first, second; - - /* Queue to unwind is current value of Vautoload_queue. - oldqueue is the shadowed value to leave in Vautoload_queue. */ - queue = Vautoload_queue; - Vautoload_queue = oldqueue; - while (CONSP (queue)) - { - first = XCAR (queue); - second = Fcdr (first); - first = Fcar (first); - if (NILP (second)) - Vfeatures = first; - else - Ffset (first, second); - queue = Fcdr (queue); - } - return Qnil; -} - -void -do_autoload (Lisp_Object fundef, - Lisp_Object funname) -{ - /* This function can GC */ - int speccount = specpdl_depth(); - Lisp_Object fun = funname; - struct gcpro gcpro1, gcpro2; - - CHECK_SYMBOL (funname); - GCPRO2 (fun, funname); - - /* Value saved here is to be restored into Vautoload_queue */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; - call4 (Qload, Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil); - - { - Lisp_Object queue; - - /* Save the old autoloads, in case we ever do an unload. */ - for (queue = Vautoload_queue; CONSP (queue); queue = XCDR (queue)) - { - Lisp_Object first = XCAR (queue); - Lisp_Object second = Fcdr (first); - - first = Fcar (first); - - /* Note: This test is subtle. The cdr of an autoload-queue entry - may be an atom if the autoload entry was generated by a defalias - or fset. */ - if (CONSP (second)) - Fput (first, Qautoload, (XCDR (second))); - } - } - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - unbind_to (speccount, Qnil); - - fun = indirect_function (fun, 0); - -#if 0 /* FSFmacs */ - if (!NILP (Fequal (fun, fundef))) -#else - if (UNBOUNDP (fun) - || (CONSP (fun) - && EQ (XCAR (fun), Qautoload))) -#endif - error ("Autoloading failed to define function %s", - string_data (XSYMBOL (funname)->name)); - UNGCPRO; -} - - -/************************************************************************/ -/* eval, funcall, apply */ -/************************************************************************/ - -static Lisp_Object funcall_lambda (Lisp_Object fun, - int nargs, Lisp_Object args[]); -static int in_warnings; - -static Lisp_Object -in_warnings_restore (Lisp_Object minimus) -{ - in_warnings = 0; - return Qnil; -} - -DEFUN ("eval", Feval, 1, 1, 0, /* -Evaluate FORM and return its value. -*/ - (form)) -{ - /* This function can GC */ - Lisp_Object fun, val, original_fun, original_args; - int nargs; - struct backtrace backtrace; - - /* I think this is a pretty safe place to call Lisp code, don't you? */ - while (!in_warnings && !NILP (Vpending_warnings)) - { - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - int speccount = specpdl_depth(); - Lisp_Object this_warning_cons, this_warning, class, level, messij; - - record_unwind_protect (in_warnings_restore, Qnil); - in_warnings = 1; - this_warning_cons = Vpending_warnings; - this_warning = XCAR (this_warning_cons); - /* in case an error occurs in the warn function, at least - it won't happen infinitely */ - Vpending_warnings = XCDR (Vpending_warnings); - free_cons (XCONS (this_warning_cons)); - class = XCAR (this_warning); - level = XCAR (XCDR (this_warning)); - messij = XCAR (XCDR (XCDR (this_warning))); - free_list (this_warning); - - if (NILP (Vpending_warnings)) - Vpending_warnings_tail = Qnil; /* perhaps not strictly necessary, - but safer */ - - GCPRO4 (form, class, level, messij); - if (!STRINGP (messij)) - messij = Fprin1_to_string (messij, Qnil); - call3 (Qdisplay_warning, class, messij, level); - UNGCPRO; - unbind_to (speccount, Qnil); - } - - if (!CONSP (form)) - { - if (SYMBOLP (form)) - return Fsymbol_value (form); - else - return form; - } - - QUIT; - if ((consing_since_gc > gc_cons_threshold) || always_gc) - { - struct gcpro gcpro1; - GCPRO1 (form); - garbage_collect_1 (); - UNGCPRO; - } - - if (++lisp_eval_depth > max_lisp_eval_depth) - { - if (max_lisp_eval_depth < 100) - max_lisp_eval_depth = 100; - if (lisp_eval_depth > max_lisp_eval_depth) - error ("Lisp nesting exceeds `max-lisp-eval-depth'"); - } - - /* We guaranteed CONSP (form) above */ - original_fun = XCAR (form); - original_args = XCDR (form); - - GET_EXTERNAL_LIST_LENGTH (original_args, nargs); - - backtrace.pdlcount = specpdl_depth(); - backtrace.function = &original_fun; /* This also protects them from gc */ - backtrace.args = &original_args; - backtrace.nargs = UNEVALLED; - backtrace.evalargs = 1; - backtrace.debug_on_exit = 0; - PUSH_BACKTRACE (backtrace); - - if (debug_on_next_call) - do_debug_on_call (Qt); - - if (profiling_active) - profile_increase_call_count (original_fun); - - /* At this point, only original_fun and original_args - have values that will be used below. */ - retry: - fun = indirect_function (original_fun, 1); - - if (SUBRP (fun)) - { - Lisp_Subr *subr = XSUBR (fun); - int max_args = subr->max_args; - - if (nargs < subr->min_args) - goto wrong_number_of_arguments; - - if (max_args == UNEVALLED) /* Optimize for the common case */ - { - backtrace.evalargs = 0; - val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) - (original_args)); - } - else if (nargs <= max_args) - { - struct gcpro gcpro1; - Lisp_Object args[SUBR_MAX_ARGS]; - REGISTER Lisp_Object *p = args; - - GCPRO1 (args[0]); - gcpro1.nvars = 0; - - { - REGISTER Lisp_Object arg; - LIST_LOOP_2 (arg, original_args) - { - *p++ = Feval (arg); - gcpro1.nvars++; - } - } - - /* &optional args default to nil. */ - while (p - args < max_args) - *p++ = Qnil; - - backtrace.args = args; - backtrace.nargs = nargs; - - FUNCALL_SUBR (val, subr, args, max_args); - - UNGCPRO; - } - else if (max_args == MANY) - { - /* Pass a vector of evaluated arguments */ - struct gcpro gcpro1; - Lisp_Object *args = alloca_array (Lisp_Object, nargs); - REGISTER Lisp_Object *p = args; - - GCPRO1 (args[0]); - gcpro1.nvars = 0; - - { - REGISTER Lisp_Object arg; - LIST_LOOP_2 (arg, original_args) - { - *p++ = Feval (arg); - gcpro1.nvars++; - } - } - - backtrace.args = args; - backtrace.nargs = nargs; - - val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) - (nargs, args)); - - UNGCPRO; - } - else - { - wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, nargs); - } - } - else if (COMPILED_FUNCTIONP (fun)) - { - struct gcpro gcpro1; - Lisp_Object *args = alloca_array (Lisp_Object, nargs); - REGISTER Lisp_Object *p = args; - - GCPRO1 (args[0]); - gcpro1.nvars = 0; - - { - REGISTER Lisp_Object arg; - LIST_LOOP_2 (arg, original_args) - { - *p++ = Feval (arg); - gcpro1.nvars++; - } - } - - backtrace.args = args; - backtrace.nargs = nargs; - backtrace.evalargs = 0; - - val = funcall_compiled_function (fun, nargs, args); - - /* Do the debug-on-exit now, while args is still GCPROed. */ - if (backtrace.debug_on_exit) - val = do_debug_on_exit (val); - /* Don't do it again when we return to eval. */ - backtrace.debug_on_exit = 0; - - UNGCPRO; - } - else if (CONSP (fun)) - { - Lisp_Object funcar = XCAR (fun); - - if (EQ (funcar, Qautoload)) - { - do_autoload (fun, original_fun); - goto retry; - } - else if (EQ (funcar, Qmacro)) - { - val = Feval (apply1 (XCDR (fun), original_args)); - } - else if (EQ (funcar, Qlambda)) - { - struct gcpro gcpro1; - Lisp_Object *args = alloca_array (Lisp_Object, nargs); - REGISTER Lisp_Object *p = args; - - GCPRO1 (args[0]); - gcpro1.nvars = 0; - - { - REGISTER Lisp_Object arg; - LIST_LOOP_2 (arg, original_args) - { - *p++ = Feval (arg); - gcpro1.nvars++; - } - } - - UNGCPRO; - - backtrace.args = args; /* this also GCPROs `args' */ - backtrace.nargs = nargs; - backtrace.evalargs = 0; - - val = funcall_lambda (fun, nargs, args); - - /* Do the debug-on-exit now, while args is still GCPROed. */ - if (backtrace.debug_on_exit) - val = do_debug_on_exit (val); - /* Don't do it again when we return to eval. */ - backtrace.debug_on_exit = 0; - } - else - { - goto invalid_function; - } - } - else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */ - { - invalid_function: - signal_invalid_function_error (fun); - } - - lisp_eval_depth--; - if (backtrace.debug_on_exit) - val = do_debug_on_exit (val); - POP_BACKTRACE (backtrace); - return val; -} - - -DEFUN ("funcall", Ffuncall, 1, MANY, 0, /* -Call first argument as a function, passing the remaining arguments to it. -Thus, (funcall 'cons 'x 'y) returns (x . y). -*/ - (int nargs, Lisp_Object *args)) -{ - /* This function can GC */ - Lisp_Object fun; - Lisp_Object val; - struct backtrace backtrace; - int fun_nargs = nargs - 1; - Lisp_Object *fun_args = args + 1; - - QUIT; - if ((consing_since_gc > gc_cons_threshold) || always_gc) - /* Callers should gcpro lexpr args */ - garbage_collect_1 (); - - if (++lisp_eval_depth > max_lisp_eval_depth) - { - if (max_lisp_eval_depth < 100) - max_lisp_eval_depth = 100; - if (lisp_eval_depth > max_lisp_eval_depth) - error ("Lisp nesting exceeds `max-lisp-eval-depth'"); - } - - backtrace.pdlcount = specpdl_depth(); - backtrace.function = &args[0]; - backtrace.args = fun_args; - backtrace.nargs = fun_nargs; - backtrace.evalargs = 0; - backtrace.debug_on_exit = 0; - PUSH_BACKTRACE (backtrace); - - if (debug_on_next_call) - do_debug_on_call (Qlambda); - - retry: - - fun = args[0]; - - /* It might be useful to place this *after* all the checks. */ - if (profiling_active) - profile_increase_call_count (fun); - - /* We could call indirect_function directly, but profiling shows - this is worth optimizing by partially unrolling the loop. */ - if (SYMBOLP (fun)) - { - fun = XSYMBOL (fun)->function; - if (SYMBOLP (fun)) - { - fun = XSYMBOL (fun)->function; - if (SYMBOLP (fun)) - fun = indirect_function (fun, 1); - } - } - - if (SUBRP (fun)) - { - Lisp_Subr *subr = XSUBR (fun); - int max_args = subr->max_args; - Lisp_Object spacious_args[SUBR_MAX_ARGS]; - - if (fun_nargs < subr->min_args) - goto wrong_number_of_arguments; - - if (fun_nargs == max_args) /* Optimize for the common case */ - { - funcall_subr: - FUNCALL_SUBR (val, subr, fun_args, max_args); - } - else if (fun_nargs < max_args) - { - Lisp_Object *p = spacious_args; - - /* Default optionals to nil */ - while (fun_nargs--) - *p++ = *fun_args++; - while (p - spacious_args < max_args) - *p++ = Qnil; - - fun_args = spacious_args; - goto funcall_subr; - } - else if (max_args == MANY) - { - val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) - (fun_nargs, fun_args); - } - else if (max_args == UNEVALLED) /* Can't funcall a special form */ - { - goto invalid_function; - } - else - { - wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, fun_nargs); - } - } - else if (COMPILED_FUNCTIONP (fun)) - { - val = funcall_compiled_function (fun, fun_nargs, fun_args); - } - else if (CONSP (fun)) - { - Lisp_Object funcar = XCAR (fun); - - if (EQ (funcar, Qlambda)) - { - val = funcall_lambda (fun, fun_nargs, fun_args); - } - else if (EQ (funcar, Qautoload)) - { - do_autoload (fun, args[0]); - goto retry; - } - else /* Can't funcall a macro */ - { - goto invalid_function; - } - } - else if (UNBOUNDP (fun)) - { - signal_void_function_error (args[0]); - } - else - { - invalid_function: - signal_invalid_function_error (fun); - } - - lisp_eval_depth--; - if (backtrace.debug_on_exit) - val = do_debug_on_exit (val); - POP_BACKTRACE (backtrace); - return val; -} - -DEFUN ("functionp", Ffunctionp, 1, 1, 0, /* -Return t if OBJECT can be called as a function, else nil. -A function is an object that can be applied to arguments, -using for example `funcall' or `apply'. -*/ - (object)) -{ - if (SYMBOLP (object)) - object = indirect_function (object, 0); - - return - (SUBRP (object) || - COMPILED_FUNCTIONP (object) || - (CONSP (object) && - (EQ (XCAR (object), Qlambda) || - EQ (XCAR (object), Qautoload)))) - ? Qt : Qnil; -} - -static Lisp_Object -function_argcount (Lisp_Object function, int function_min_args_p) -{ - Lisp_Object orig_function = function; - Lisp_Object arglist; - - retry: - - if (SYMBOLP (function)) - function = indirect_function (function, 1); - - if (SUBRP (function)) - { - return function_min_args_p ? - Fsubr_min_args (function): - Fsubr_max_args (function); - } - else if (COMPILED_FUNCTIONP (function)) - { - arglist = compiled_function_arglist (XCOMPILED_FUNCTION (function)); - } - else if (CONSP (function)) - { - Lisp_Object funcar = XCAR (function); - - if (EQ (funcar, Qmacro)) - { - function = XCDR (function); - goto retry; - } - else if (EQ (funcar, Qautoload)) - { - do_autoload (function, orig_function); - goto retry; - } - else if (EQ (funcar, Qlambda)) - { - arglist = Fcar (XCDR (function)); - } - else - { - goto invalid_function; - } - } - else - { - invalid_function: - return Fsignal (Qinvalid_function, list1 (function)); - } - - { - int argcount = 0; - Lisp_Object arg; - - EXTERNAL_LIST_LOOP_2 (arg, arglist) - { - if (EQ (arg, Qand_optional)) - { - if (function_min_args_p) - break; - } - else if (EQ (arg, Qand_rest)) - { - if (function_min_args_p) - break; - else - return Qnil; - } - else - { - argcount++; - } - } - - return make_int (argcount); - } -} - -DEFUN ("function-min-args", Ffunction_min_args, 1, 1, 0, /* -Return the number of arguments a function may be called with. -The function may be any form that can be passed to `funcall', -any special form, or any macro. -*/ - (function)) -{ - return function_argcount (function, 1); -} - -DEFUN ("function-max-args", Ffunction_max_args, 1, 1, 0, /* -Return the number of arguments a function may be called with. -The function may be any form that can be passed to `funcall', -any special form, or any macro. -If the function takes an arbitrary number of arguments or is -a built-in special form, nil is returned. -*/ - (function)) -{ - return function_argcount (function, 0); -} - - -DEFUN ("apply", Fapply, 2, MANY, 0, /* -Call FUNCTION with the remaining args, using the last arg as a list of args. -Thus, (apply '+ 1 2 '(3 4)) returns 10. -*/ - (int nargs, Lisp_Object *args)) -{ - /* This function can GC */ - Lisp_Object fun = args[0]; - Lisp_Object spread_arg = args [nargs - 1]; - int numargs; - int funcall_nargs; - - GET_EXTERNAL_LIST_LENGTH (spread_arg, numargs); - - if (numargs == 0) - /* (apply foo 0 1 '()) */ - return Ffuncall (nargs - 1, args); - else if (numargs == 1) - { - /* (apply foo 0 1 '(2)) */ - args [nargs - 1] = XCAR (spread_arg); - return Ffuncall (nargs, args); - } - - /* -1 for function, -1 for spread arg */ - numargs = nargs - 2 + numargs; - /* +1 for function */ - funcall_nargs = 1 + numargs; - - if (SYMBOLP (fun)) - fun = indirect_function (fun, 0); - - if (SUBRP (fun)) - { - Lisp_Subr *subr = XSUBR (fun); - int max_args = subr->max_args; - - if (numargs < subr->min_args - || (max_args >= 0 && max_args < numargs)) - { - /* Let funcall get the error */ - } - else if (max_args > numargs) - { - /* Avoid having funcall cons up yet another new vector of arguments - by explicitly supplying nil's for optional values */ - funcall_nargs += (max_args - numargs); - } - } - else if (UNBOUNDP (fun)) - { - /* Let funcall get the error */ - fun = args[0]; - } - - { - REGISTER int i; - Lisp_Object *funcall_args = alloca_array (Lisp_Object, funcall_nargs); - struct gcpro gcpro1; - - GCPRO1 (*funcall_args); - gcpro1.nvars = funcall_nargs; - - /* Copy in the unspread args */ - memcpy (funcall_args, args, (nargs - 1) * sizeof (Lisp_Object)); - /* Spread the last arg we got. Its first element goes in - the slot that it used to occupy, hence this value of I. */ - for (i = nargs - 1; - !NILP (spread_arg); /* i < 1 + numargs */ - i++, spread_arg = XCDR (spread_arg)) - { - funcall_args [i] = XCAR (spread_arg); - } - /* Supply nil for optional args (to subrs) */ - for (; i < funcall_nargs; i++) - funcall_args[i] = Qnil; - - - RETURN_UNGCPRO (Ffuncall (funcall_nargs, funcall_args)); - } -} - - -/* Apply lambda list FUN to the NARGS evaluated arguments in ARGS and - return the result of evaluation. */ - -static Lisp_Object -funcall_lambda (Lisp_Object fun, int nargs, Lisp_Object args[]) -{ - /* This function can GC */ - Lisp_Object symbol, arglist, body, tail; - int speccount = specpdl_depth(); - REGISTER int i = 0; - - tail = XCDR (fun); - - if (!CONSP (tail)) - goto invalid_function; - - arglist = XCAR (tail); - body = XCDR (tail); - - { - int optional = 0, rest = 0; - - EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail) - { - if (!SYMBOLP (symbol)) - goto invalid_function; - if (EQ (symbol, Qand_rest)) - rest = 1; - else if (EQ (symbol, Qand_optional)) - optional = 1; - else if (rest) - { - specbind (symbol, Flist (nargs - i, &args[i])); - i = nargs; - } - else if (i < nargs) - specbind (symbol, args[i++]); - else if (!optional) - goto wrong_number_of_arguments; - else - specbind (symbol, Qnil); - } - } - - if (i < nargs) - goto wrong_number_of_arguments; - - return unbind_to (speccount, Fprogn (body)); - - wrong_number_of_arguments: - return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); - - invalid_function: - return Fsignal (Qinvalid_function, list1 (fun)); -} - - -/************************************************************************/ -/* Run hook variables in various ways. */ -/************************************************************************/ - -DEFUN ("run-hooks", Frun_hooks, 1, MANY, 0, /* -Run each hook in HOOKS. Major mode functions use this. -Each argument should be a symbol, a hook variable. -These symbols are processed in the order specified. -If a hook symbol has a non-nil value, that value may be a function -or a list of functions to be called to run the hook. -If the value is a function, it is called with no arguments. -If it is a list, the elements are called, in order, with no arguments. - -To make a hook variable buffer-local, use `make-local-hook', -not `make-local-variable'. -*/ - (int nargs, Lisp_Object *args)) -{ - REGISTER int i; - - for (i = 0; i < nargs; i++) - run_hook_with_args (1, args + i, RUN_HOOKS_TO_COMPLETION); - - return Qnil; -} - -DEFUN ("run-hook-with-args", Frun_hook_with_args, 1, MANY, 0, /* -Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. If HOOK has a non-nil -value, that value may be a function or a list of functions to be -called to run the hook. If the value is a function, it is called with -the given arguments and its return value is returned. If it is a list -of functions, those functions are called, in order, -with the given arguments ARGS. -It is best not to depend on the value return by `run-hook-with-args', -as that may change. - -To make a hook variable buffer-local, use `make-local-hook', -not `make-local-variable'. -*/ - (int nargs, Lisp_Object *args)) -{ - return run_hook_with_args (nargs, args, RUN_HOOKS_TO_COMPLETION); -} - -DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success, 1, MANY, 0, /* -Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. Its value should -be a list of functions. We call those functions, one by one, -passing arguments ARGS to each of them, until one of them -returns a non-nil value. Then we return that value. -If all the functions return nil, we return nil. - -To make a hook variable buffer-local, use `make-local-hook', -not `make-local-variable'. -*/ - (int nargs, Lisp_Object *args)) -{ - return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_SUCCESS); -} - -DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure, 1, MANY, 0, /* -Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. Its value should -be a list of functions. We call those functions, one by one, -passing arguments ARGS to each of them, until one of them -returns nil. Then we return nil. -If all the functions return non-nil, we return non-nil. - -To make a hook variable buffer-local, use `make-local-hook', -not `make-local-variable'. -*/ - (int nargs, Lisp_Object *args)) -{ - return run_hook_with_args (nargs, args, RUN_HOOKS_UNTIL_FAILURE); -} - -/* ARGS[0] should be a hook symbol. - Call each of the functions in the hook value, passing each of them - as arguments all the rest of ARGS (all NARGS - 1 elements). - COND specifies a condition to test after each call - to decide whether to stop. - The caller (or its caller, etc) must gcpro all of ARGS, - except that it isn't necessary to gcpro ARGS[0]. */ - -Lisp_Object -run_hook_with_args_in_buffer (struct buffer *buf, int nargs, Lisp_Object *args, - enum run_hooks_condition cond) -{ - Lisp_Object sym, val, ret; - - if (!initialized || preparing_for_armageddon) - /* We need to bail out of here pronto. */ - return Qnil; - - /* Whenever gc_in_progress is true, preparing_for_armageddon - will also be true unless something is really hosed. */ - assert (!gc_in_progress); - - sym = args[0]; - val = symbol_value_in_buffer (sym, make_buffer (buf)); - ret = (cond == RUN_HOOKS_UNTIL_FAILURE ? Qt : Qnil); - - if (UNBOUNDP (val) || NILP (val)) - return ret; - else if (!CONSP (val) || EQ (XCAR (val), Qlambda)) - { - args[0] = val; - return Ffuncall (nargs, args); - } - else - { - struct gcpro gcpro1, gcpro2; - GCPRO2 (sym, val); - - for (; - CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION) - || (cond == RUN_HOOKS_UNTIL_SUCCESS ? NILP (ret) - : !NILP (ret))); - val = XCDR (val)) - { - if (EQ (XCAR (val), Qt)) - { - /* t indicates this hook has a local binding; - it means to run the global binding too. */ - Lisp_Object globals = Fdefault_value (sym); - - if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) && - ! NILP (globals)) - { - args[0] = globals; - ret = Ffuncall (nargs, args); - } - else - { - for (; - CONSP (globals) && ((cond == RUN_HOOKS_TO_COMPLETION) - || (cond == RUN_HOOKS_UNTIL_SUCCESS - ? NILP (ret) - : !NILP (ret))); - globals = XCDR (globals)) - { - args[0] = XCAR (globals); - /* In a global value, t should not occur. If it does, we - must ignore it to avoid an endless loop. */ - if (!EQ (args[0], Qt)) - ret = Ffuncall (nargs, args); - } - } - } - else - { - args[0] = XCAR (val); - ret = Ffuncall (nargs, args); - } - } - - UNGCPRO; - return ret; - } -} - -Lisp_Object -run_hook_with_args (int nargs, Lisp_Object *args, - enum run_hooks_condition cond) -{ - return run_hook_with_args_in_buffer (current_buffer, nargs, args, cond); -} - -#if 0 - -/* From FSF 19.30, not currently used */ - -/* Run a hook symbol ARGS[0], but use FUNLIST instead of the actual - present value of that symbol. - Call each element of FUNLIST, - passing each of them the rest of ARGS. - The caller (or its caller, etc) must gcpro all of ARGS, - except that it isn't necessary to gcpro ARGS[0]. */ - -Lisp_Object -run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args) -{ - Lisp_Object sym = args[0]; - Lisp_Object val; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (sym, val); - - for (val = funlist; CONSP (val); val = XCDR (val)) - { - if (EQ (XCAR (val), Qt)) - { - /* t indicates this hook has a local binding; - it means to run the global binding too. */ - Lisp_Object globals; - - for (globals = Fdefault_value (sym); - CONSP (globals); - globals = XCDR (globals)) - { - args[0] = XCAR (globals); - /* In a global value, t should not occur. If it does, we - must ignore it to avoid an endless loop. */ - if (!EQ (args[0], Qt)) - Ffuncall (nargs, args); - } - } - else - { - args[0] = XCAR (val); - Ffuncall (nargs, args); - } - } - UNGCPRO; - return Qnil; -} - -#endif /* 0 */ - -void -va_run_hook_with_args (Lisp_Object hook_var, int nargs, ...) -{ - /* This function can GC */ - struct gcpro gcpro1; - int i; - va_list vargs; - Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); - - va_start (vargs, nargs); - funcall_args[0] = hook_var; - for (i = 0; i < nargs; i++) - funcall_args[i + 1] = va_arg (vargs, Lisp_Object); - va_end (vargs); - - GCPRO1 (*funcall_args); - gcpro1.nvars = nargs + 1; - run_hook_with_args (nargs + 1, funcall_args, RUN_HOOKS_TO_COMPLETION); - UNGCPRO; -} - -void -va_run_hook_with_args_in_buffer (struct buffer *buf, Lisp_Object hook_var, - int nargs, ...) -{ - /* This function can GC */ - struct gcpro gcpro1; - int i; - va_list vargs; - Lisp_Object *funcall_args = alloca_array (Lisp_Object, 1 + nargs); - - va_start (vargs, nargs); - funcall_args[0] = hook_var; - for (i = 0; i < nargs; i++) - funcall_args[i + 1] = va_arg (vargs, Lisp_Object); - va_end (vargs); - - GCPRO1 (*funcall_args); - gcpro1.nvars = nargs + 1; - run_hook_with_args_in_buffer (buf, nargs + 1, funcall_args, - RUN_HOOKS_TO_COMPLETION); - UNGCPRO; -} - -Lisp_Object -run_hook (Lisp_Object hook) -{ - Frun_hooks (1, &hook); - return Qnil; -} - - -/************************************************************************/ -/* Front-ends to eval, funcall, apply */ -/************************************************************************/ - -/* Apply fn to arg */ -Lisp_Object -apply1 (Lisp_Object fn, Lisp_Object arg) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[2]; - - if (NILP (arg)) - return Ffuncall (1, &fn); - GCPRO1 (args[0]); - gcpro1.nvars = 2; - args[0] = fn; - args[1] = arg; - RETURN_UNGCPRO (Fapply (2, args)); -} - -/* Call function fn on no arguments */ -Lisp_Object -call0 (Lisp_Object fn) -{ - /* This function can GC */ - struct gcpro gcpro1; - - GCPRO1 (fn); - RETURN_UNGCPRO (Ffuncall (1, &fn)); -} - -/* Call function fn with argument arg0 */ -Lisp_Object -call1 (Lisp_Object fn, - Lisp_Object arg0) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[2]; - args[0] = fn; - args[1] = arg0; - GCPRO1 (args[0]); - gcpro1.nvars = 2; - RETURN_UNGCPRO (Ffuncall (2, args)); -} - -/* Call function fn with arguments arg0, arg1 */ -Lisp_Object -call2 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[3]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - GCPRO1 (args[0]); - gcpro1.nvars = 3; - RETURN_UNGCPRO (Ffuncall (3, args)); -} - -/* Call function fn with arguments arg0, arg1, arg2 */ -Lisp_Object -call3 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[4]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - GCPRO1 (args[0]); - gcpro1.nvars = 4; - RETURN_UNGCPRO (Ffuncall (4, args)); -} - -/* Call function fn with arguments arg0, arg1, arg2, arg3 */ -Lisp_Object -call4 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[5]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - args[4] = arg3; - GCPRO1 (args[0]); - gcpro1.nvars = 5; - RETURN_UNGCPRO (Ffuncall (5, args)); -} - -/* Call function fn with arguments arg0, arg1, arg2, arg3, arg4 */ -Lisp_Object -call5 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[6]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - args[4] = arg3; - args[5] = arg4; - GCPRO1 (args[0]); - gcpro1.nvars = 6; - RETURN_UNGCPRO (Ffuncall (6, args)); -} - -Lisp_Object -call6 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[7]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - args[4] = arg3; - args[5] = arg4; - args[6] = arg5; - GCPRO1 (args[0]); - gcpro1.nvars = 7; - RETURN_UNGCPRO (Ffuncall (7, args)); -} - -Lisp_Object -call7 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, - Lisp_Object arg6) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[8]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - args[4] = arg3; - args[5] = arg4; - args[6] = arg5; - args[7] = arg6; - GCPRO1 (args[0]); - gcpro1.nvars = 8; - RETURN_UNGCPRO (Ffuncall (8, args)); -} - -Lisp_Object -call8 (Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3, Lisp_Object arg4, Lisp_Object arg5, - Lisp_Object arg6, Lisp_Object arg7) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[9]; - args[0] = fn; - args[1] = arg0; - args[2] = arg1; - args[3] = arg2; - args[4] = arg3; - args[5] = arg4; - args[6] = arg5; - args[7] = arg6; - args[8] = arg7; - GCPRO1 (args[0]); - gcpro1.nvars = 9; - RETURN_UNGCPRO (Ffuncall (9, args)); -} - -Lisp_Object -call0_in_buffer (struct buffer *buf, Lisp_Object fn) -{ - if (current_buffer == buf) - return call0 (fn); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = call0 (fn); - unbind_to (speccount, Qnil); - return val; - } -} - -Lisp_Object -call1_in_buffer (struct buffer *buf, Lisp_Object fn, - Lisp_Object arg0) -{ - if (current_buffer == buf) - return call1 (fn, arg0); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = call1 (fn, arg0); - unbind_to (speccount, Qnil); - return val; - } -} - -Lisp_Object -call2_in_buffer (struct buffer *buf, Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1) -{ - if (current_buffer == buf) - return call2 (fn, arg0, arg1); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = call2 (fn, arg0, arg1); - unbind_to (speccount, Qnil); - return val; - } -} - -Lisp_Object -call3_in_buffer (struct buffer *buf, Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2) -{ - if (current_buffer == buf) - return call3 (fn, arg0, arg1, arg2); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = call3 (fn, arg0, arg1, arg2); - unbind_to (speccount, Qnil); - return val; - } -} - -Lisp_Object -call4_in_buffer (struct buffer *buf, Lisp_Object fn, - Lisp_Object arg0, Lisp_Object arg1, Lisp_Object arg2, - Lisp_Object arg3) -{ - if (current_buffer == buf) - return call4 (fn, arg0, arg1, arg2, arg3); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = call4 (fn, arg0, arg1, arg2, arg3); - unbind_to (speccount, Qnil); - return val; - } -} - -Lisp_Object -eval_in_buffer (struct buffer *buf, Lisp_Object form) -{ - if (current_buffer == buf) - return Feval (form); - else - { - Lisp_Object val; - int speccount = specpdl_depth(); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (buf); - val = Feval (form); - unbind_to (speccount, Qnil); - return val; - } -} - - -/************************************************************************/ -/* Error-catching front-ends to eval, funcall, apply */ -/************************************************************************/ - -/* Call function fn on no arguments, with condition handler */ -Lisp_Object -call0_with_handler (Lisp_Object handler, Lisp_Object fn) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[2]; - args[0] = handler; - args[1] = fn; - GCPRO1 (args[0]); - gcpro1.nvars = 2; - RETURN_UNGCPRO (Fcall_with_condition_handler (2, args)); -} - -/* Call function fn with argument arg0, with condition handler */ -Lisp_Object -call1_with_handler (Lisp_Object handler, Lisp_Object fn, - Lisp_Object arg0) -{ - /* This function can GC */ - struct gcpro gcpro1; - Lisp_Object args[3]; - args[0] = handler; - args[1] = fn; - args[2] = arg0; - GCPRO1 (args[0]); - gcpro1.nvars = 3; - RETURN_UNGCPRO (Fcall_with_condition_handler (3, args)); -} - - -/* The following functions provide you with error-trapping versions - of the various front-ends above. They take an additional - "warning_string" argument; if non-zero, a warning with this - string and the actual error that occurred will be displayed - in the *Warnings* buffer if an error occurs. In all cases, - QUIT is inhibited while these functions are running, and if - an error occurs, Qunbound is returned instead of the normal - return value. - */ - -/* #### This stuff needs to catch throws as well. We need to - improve internal_catch() so it can take a "catch anything" - argument similar to Qt or Qerror for condition_case_1(). */ - -static Lisp_Object -caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg) -{ - if (!NILP (errordata)) - { - Lisp_Object args[2]; - - if (!NILP (arg)) - { - char *str = (char *) get_opaque_ptr (arg); - args[0] = build_string (str); - } - else - args[0] = build_string ("error"); - /* #### This should call - (with-output-to-string (display-error errordata)) - but that stuff is all in Lisp currently. */ - args[1] = errordata; - warn_when_safe_lispobj - (Qerror, Qwarning, - emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", - Qnil, -1, 2, args)); - } - return Qunbound; -} - -static Lisp_Object -allow_quit_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg) -{ - if (CONSP (errordata) && EQ (XCAR (errordata), Qquit)) - return Fsignal (Qquit, XCDR (errordata)); - return caught_a_squirmer (errordata, arg); -} - -static Lisp_Object -safe_run_hook_caught_a_squirmer (Lisp_Object errordata, Lisp_Object arg) -{ - Lisp_Object hook = Fcar (arg); - arg = Fcdr (arg); - /* Clear out the hook. */ - Fset (hook, Qnil); - return caught_a_squirmer (errordata, arg); -} - -static Lisp_Object -allow_quit_safe_run_hook_caught_a_squirmer (Lisp_Object errordata, - Lisp_Object arg) -{ - Lisp_Object hook = Fcar (arg); - arg = Fcdr (arg); - if (!CONSP (errordata) || !EQ (XCAR (errordata), Qquit)) - /* Clear out the hook. */ - Fset (hook, Qnil); - return allow_quit_caught_a_squirmer (errordata, arg); -} - -static Lisp_Object -catch_them_squirmers_eval_in_buffer (Lisp_Object cons) -{ - return eval_in_buffer (XBUFFER (XCAR (cons)), XCDR (cons)); -} - -Lisp_Object -eval_in_buffer_trapping_errors (CONST char *warning_string, - struct buffer *buf, Lisp_Object form) -{ - int speccount = specpdl_depth(); - Lisp_Object tem; - Lisp_Object buffer; - Lisp_Object cons; - Lisp_Object opaque; - struct gcpro gcpro1, gcpro2; - - XSETBUFFER (buffer, buf); - - specbind (Qinhibit_quit, Qt); - /* gc_currently_forbidden = 1; Currently no reason to do this; */ - - cons = noseeum_cons (buffer, form); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); - GCPRO2 (cons, opaque); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_eval_in_buffer, cons, - caught_a_squirmer, opaque); - free_cons (XCONS (cons)); - if (OPAQUEP (opaque)) - free_opaque_ptr (opaque); - UNGCPRO; - - /* gc_currently_forbidden = 0; */ - return unbind_to (speccount, tem); -} - -static Lisp_Object -catch_them_squirmers_run_hook (Lisp_Object hook_symbol) -{ - /* This function can GC */ - run_hook (hook_symbol); - return Qnil; -} - -Lisp_Object -run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol) -{ - int speccount; - Lisp_Object tem; - Lisp_Object opaque; - struct gcpro gcpro1; - - if (!initialized || preparing_for_armageddon) - return Qnil; - tem = find_symbol_value (hook_symbol); - if (NILP (tem) || UNBOUNDP (tem)) - return Qnil; - - speccount = specpdl_depth(); - specbind (Qinhibit_quit, Qt); - - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); - GCPRO1 (opaque); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_run_hook, hook_symbol, - caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) - free_opaque_ptr (opaque); - UNGCPRO; - - return unbind_to (speccount, tem); -} - -/* Same as run_hook_trapping_errors() but also set the hook to nil - if an error occurs. */ - -Lisp_Object -safe_run_hook_trapping_errors (CONST char *warning_string, - Lisp_Object hook_symbol, - int allow_quit) -{ - int speccount = specpdl_depth(); - Lisp_Object tem; - Lisp_Object cons = Qnil; - struct gcpro gcpro1; - - if (!initialized || preparing_for_armageddon) - return Qnil; - tem = find_symbol_value (hook_symbol); - if (NILP (tem) || UNBOUNDP (tem)) - return Qnil; - - if (!allow_quit) - specbind (Qinhibit_quit, Qt); - - cons = noseeum_cons (hook_symbol, - warning_string ? make_opaque_ptr (warning_string) - : Qnil); - GCPRO1 (cons); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_run_hook, - hook_symbol, - allow_quit ? - allow_quit_safe_run_hook_caught_a_squirmer : - safe_run_hook_caught_a_squirmer, - cons); - if (OPAQUEP (XCDR (cons))) - free_opaque_ptr (XCDR (cons)); - free_cons (XCONS (cons)); - UNGCPRO; - - return unbind_to (speccount, tem); -} - -static Lisp_Object -catch_them_squirmers_call0 (Lisp_Object function) -{ - /* This function can GC */ - return call0 (function); -} - -Lisp_Object -call0_trapping_errors (CONST char *warning_string, Lisp_Object function) -{ - int speccount; - Lisp_Object tem; - Lisp_Object opaque = Qnil; - struct gcpro gcpro1, gcpro2; - - if (SYMBOLP (function)) - { - tem = XSYMBOL (function)->function; - if (NILP (tem) || UNBOUNDP (tem)) - return Qnil; - } - - GCPRO2 (opaque, function); - speccount = specpdl_depth(); - specbind (Qinhibit_quit, Qt); - /* gc_currently_forbidden = 1; Currently no reason to do this; */ - - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_call0, function, - caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) - free_opaque_ptr (opaque); - UNGCPRO; - - /* gc_currently_forbidden = 0; */ - return unbind_to (speccount, tem); -} - -static Lisp_Object -catch_them_squirmers_call1 (Lisp_Object cons) -{ - /* This function can GC */ - return call1 (XCAR (cons), XCDR (cons)); -} - -static Lisp_Object -catch_them_squirmers_call2 (Lisp_Object cons) -{ - /* This function can GC */ - return call2 (XCAR (cons), XCAR (XCDR (cons)), XCAR (XCDR (XCDR (cons)))); -} - -Lisp_Object -call1_trapping_errors (CONST char *warning_string, Lisp_Object function, - Lisp_Object object) -{ - int speccount = specpdl_depth(); - Lisp_Object tem; - Lisp_Object cons = Qnil; - Lisp_Object opaque = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - if (SYMBOLP (function)) - { - tem = XSYMBOL (function)->function; - if (NILP (tem) || UNBOUNDP (tem)) - return Qnil; - } - - GCPRO4 (cons, opaque, function, object); - - specbind (Qinhibit_quit, Qt); - /* gc_currently_forbidden = 1; Currently no reason to do this; */ - - cons = noseeum_cons (function, object); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_call1, cons, - caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) - free_opaque_ptr (opaque); - free_cons (XCONS (cons)); - UNGCPRO; - - /* gc_currently_forbidden = 0; */ - return unbind_to (speccount, tem); -} - -Lisp_Object -call2_trapping_errors (CONST char *warning_string, Lisp_Object function, - Lisp_Object object1, Lisp_Object object2) -{ - int speccount = specpdl_depth(); - Lisp_Object tem; - Lisp_Object cons = Qnil; - Lisp_Object opaque = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - if (SYMBOLP (function)) - { - tem = XSYMBOL (function)->function; - if (NILP (tem) || UNBOUNDP (tem)) - return Qnil; - } - - GCPRO5 (cons, opaque, function, object1, object2); - specbind (Qinhibit_quit, Qt); - /* gc_currently_forbidden = 1; Currently no reason to do this; */ - - cons = list3 (function, object1, object2); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); - /* Qerror not Qt, so you can get a backtrace */ - tem = condition_case_1 (Qerror, - catch_them_squirmers_call2, cons, - caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) - free_opaque_ptr (opaque); - free_list (cons); - UNGCPRO; - - /* gc_currently_forbidden = 0; */ - return unbind_to (speccount, tem); -} - - -/************************************************************************/ -/* The special binding stack */ -/* Most C code should simply use specbind() and unbind_to(). */ -/* When performance is critical, use the macros in backtrace.h. */ -/************************************************************************/ - -#define min_max_specpdl_size 400 - -void -grow_specpdl (size_t reserved) -{ - size_t size_needed = specpdl_depth() + reserved; - if (size_needed >= max_specpdl_size) - { - if (max_specpdl_size < min_max_specpdl_size) - max_specpdl_size = min_max_specpdl_size; - if (size_needed >= max_specpdl_size) - { - if (!NILP (Vdebug_on_error) || - !NILP (Vdebug_on_signal)) - /* Leave room for some specpdl in the debugger. */ - max_specpdl_size = size_needed + 100; - continuable_error - ("Variable binding depth exceeds max-specpdl-size"); - } - } - while (specpdl_size < size_needed) - { - specpdl_size *= 2; - if (specpdl_size > max_specpdl_size) - specpdl_size = max_specpdl_size; - } - XREALLOC_ARRAY (specpdl, struct specbinding, specpdl_size); - specpdl_ptr = specpdl + specpdl_depth(); -} - - -/* Handle unbinding buffer-local variables */ -static Lisp_Object -specbind_unwind_local (Lisp_Object ovalue) -{ - Lisp_Object current = Fcurrent_buffer (); - Lisp_Object symbol = specpdl_ptr->symbol; - struct Lisp_Cons *victim = XCONS (ovalue); - Lisp_Object buf = get_buffer (victim->car, 0); - ovalue = victim->cdr; - - free_cons (victim); - - if (NILP (buf)) - { - /* Deleted buffer -- do nothing */ - } - else if (symbol_value_buffer_local_info (symbol, XBUFFER (buf)) == 0) - { - /* Was buffer-local when binding was made, now no longer is. - * (kill-local-variable can do this.) - * Do nothing in this case. - */ - } - else if (EQ (buf, current)) - Fset (symbol, ovalue); - else - { - /* Urk! Somebody switched buffers */ - struct gcpro gcpro1; - GCPRO1 (current); - Fset_buffer (buf); - Fset (symbol, ovalue); - Fset_buffer (current); - UNGCPRO; - } - return symbol; -} - -static Lisp_Object -specbind_unwind_wasnt_local (Lisp_Object buffer) -{ - Lisp_Object current = Fcurrent_buffer (); - Lisp_Object symbol = specpdl_ptr->symbol; - - buffer = get_buffer (buffer, 0); - if (NILP (buffer)) - { - /* Deleted buffer -- do nothing */ - } - else if (symbol_value_buffer_local_info (symbol, XBUFFER (buffer)) == 0) - { - /* Was buffer-local when binding was made, now no longer is. - * (kill-local-variable can do this.) - * Do nothing in this case. - */ - } - else if (EQ (buffer, current)) - Fkill_local_variable (symbol); - else - { - /* Urk! Somebody switched buffers */ - struct gcpro gcpro1; - GCPRO1 (current); - Fset_buffer (buffer); - Fkill_local_variable (symbol); - Fset_buffer (current); - UNGCPRO; - } - return symbol; -} - - -void -specbind (Lisp_Object symbol, Lisp_Object value) -{ - SPECBIND (symbol, value); -} - -void -specbind_magic (Lisp_Object symbol, Lisp_Object value) -{ - int buffer_local = - symbol_value_buffer_local_info (symbol, current_buffer); - - if (buffer_local == 0) - { - specpdl_ptr->old_value = find_symbol_value (symbol); - specpdl_ptr->func = 0; /* Handled specially by unbind_to */ - } - else if (buffer_local > 0) - { - /* Already buffer-local */ - specpdl_ptr->old_value = noseeum_cons (Fcurrent_buffer (), - find_symbol_value (symbol)); - specpdl_ptr->func = specbind_unwind_local; - } - else - { - /* About to become buffer-local */ - specpdl_ptr->old_value = Fcurrent_buffer (); - specpdl_ptr->func = specbind_unwind_wasnt_local; - } - - specpdl_ptr->symbol = symbol; - specpdl_ptr++; - specpdl_depth_counter++; - - Fset (symbol, value); -} - -void -record_unwind_protect (Lisp_Object (*function) (Lisp_Object arg), - Lisp_Object arg) -{ - SPECPDL_RESERVE (1); - specpdl_ptr->func = function; - specpdl_ptr->symbol = Qnil; - specpdl_ptr->old_value = arg; - specpdl_ptr++; - specpdl_depth_counter++; -} - -extern int check_sigio (void); - -/* Unwind the stack till specpdl_depth() == COUNT. - VALUE is not used, except that, purely as a convenience to the - caller, it is protected from garbage-protection. */ -Lisp_Object -unbind_to (int count, Lisp_Object value) -{ - UNBIND_TO_GCPRO (count, value); - return value; -} - -/* Don't call this directly. - Only for use by UNBIND_TO* macros in backtrace.h */ -void -unbind_to_hairy (int count) -{ - int quitf; - - check_quit (); /* make Vquit_flag accurate */ - quitf = !NILP (Vquit_flag); - Vquit_flag = Qnil; - - ++specpdl_ptr; - ++specpdl_depth_counter; - - while (specpdl_depth_counter != count) - { - --specpdl_ptr; - --specpdl_depth_counter; - - if (specpdl_ptr->func != 0) - /* An unwind-protect */ - (*specpdl_ptr->func) (specpdl_ptr->old_value); - else - { - /* We checked symbol for validity when we specbound it, - so only need to call Fset if symbol has magic value. */ - struct Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); - if (!SYMBOL_VALUE_MAGIC_P (sym->value)) - sym->value = specpdl_ptr->old_value; - else - Fset (specpdl_ptr->symbol, specpdl_ptr->old_value); - } - -#if 0 /* martin */ -#ifndef EXCEEDINGLY_QUESTIONABLE_CODE - /* There should never be anything here for us to remove. - If so, it indicates a logic error in Emacs. Catches - should get removed when a throw or signal occurs, or - when a catch or condition-case exits normally. But - it's too dangerous to just remove this code. --ben */ - - /* Furthermore, this code is not in FSFmacs!!! - Braino on mly's part? */ - /* If we're unwound past the pdlcount of a catch frame, - that catch can't possibly still be valid. */ - while (catchlist && catchlist->pdlcount > specpdl_depth_counter) - { - catchlist = catchlist->next; - /* Don't mess with gcprolist, backtrace_list here */ - } -#endif -#endif - } - if (quitf) - Vquit_flag = Qt; -} - - - -/* Get the value of symbol's global binding, even if that binding is - not now dynamically visible. May return Qunbound or magic values. */ - -Lisp_Object -top_level_value (Lisp_Object symbol) -{ - REGISTER struct specbinding *ptr = specpdl; - - CHECK_SYMBOL (symbol); - for (; ptr != specpdl_ptr; ptr++) - { - if (EQ (ptr->symbol, symbol)) - return ptr->old_value; - } - return XSYMBOL (symbol)->value; -} - -#if 0 - -Lisp_Object -top_level_set (Lisp_Object symbol, Lisp_Object newval) -{ - REGISTER struct specbinding *ptr = specpdl; - - CHECK_SYMBOL (symbol); - for (; ptr != specpdl_ptr; ptr++) - { - if (EQ (ptr->symbol, symbol)) - { - ptr->old_value = newval; - return newval; - } - } - return Fset (symbol, newval); -} - -#endif /* 0 */ - - -/************************************************************************/ -/* Backtraces */ -/************************************************************************/ - -DEFUN ("backtrace-debug", Fbacktrace_debug, 2, 2, 0, /* -Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. -The debugger is entered when that frame exits, if the flag is non-nil. -*/ - (level, flag)) -{ - REGISTER struct backtrace *backlist = backtrace_list; - REGISTER int i; - - CHECK_INT (level); - - for (i = 0; backlist && i < XINT (level); i++) - { - backlist = backlist->next; - } - - if (backlist) - backlist->debug_on_exit = !NILP (flag); - - return flag; -} - -static void -backtrace_specials (int speccount, int speclimit, Lisp_Object stream) -{ - int printing_bindings = 0; - - for (; speccount > speclimit; speccount--) - { - if (specpdl[speccount - 1].func == 0 - || specpdl[speccount - 1].func == specbind_unwind_local - || specpdl[speccount - 1].func == specbind_unwind_wasnt_local) - { - write_c_string (((!printing_bindings) ? " # bind (" : " "), - stream); - Fprin1 (specpdl[speccount - 1].symbol, stream); - printing_bindings = 1; - } - else - { - if (printing_bindings) write_c_string (")\n", stream); - write_c_string (" # (unwind-protect ...)\n", stream); - printing_bindings = 0; - } - } - if (printing_bindings) write_c_string (")\n", stream); -} - -DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* -Print a trace of Lisp function calls currently active. -Option arg STREAM specifies the output stream to send the backtrace to, -and defaults to the value of `standard-output'. Optional second arg -DETAILED means show places where currently active variable bindings, -catches, condition-cases, and unwind-protects were made as well as -function calls. -*/ - (stream, detailed)) -{ - /* This function can GC */ - struct backtrace *backlist = backtrace_list; - struct catchtag *catches = catchlist; - int speccount = specpdl_depth(); - - int old_nl = print_escape_newlines; - int old_pr = print_readably; - Lisp_Object old_level = Vprint_level; - Lisp_Object oiq = Vinhibit_quit; - struct gcpro gcpro1, gcpro2; - - /* We can't allow quits in here because that could cause the values - of print_readably and print_escape_newlines to get screwed up. - Normally we would use a record_unwind_protect but that would - screw up the functioning of this function. */ - Vinhibit_quit = Qt; - - entering_debugger = 0; - - Vprint_level = make_int (3); - print_readably = 0; - print_escape_newlines = 1; - - GCPRO2 (stream, old_level); - - if (NILP (stream)) - stream = Vstandard_output; - if (!noninteractive && (NILP (stream) || EQ (stream, Qt))) - stream = Fselected_frame (Qnil); - - for (;;) - { - if (!NILP (detailed) && catches && catches->backlist == backlist) - { - int catchpdl = catches->pdlcount; - if (specpdl[catchpdl].func == condition_case_unwind - && speccount > catchpdl) - /* This is a condition-case catchpoint */ - catchpdl = catchpdl + 1; - - backtrace_specials (speccount, catchpdl, stream); - - speccount = catches->pdlcount; - if (catchpdl == speccount) - { - write_c_string (" # (catch ", stream); - Fprin1 (catches->tag, stream); - write_c_string (" ...)\n", stream); - } - else - { - write_c_string (" # (condition-case ... . ", stream); - Fprin1 (Fcdr (Fcar (catches->tag)), stream); - write_c_string (")\n", stream); - } - catches = catches->next; - } - else if (!backlist) - break; - else - { - if (!NILP (detailed) && backlist->pdlcount < speccount) - { - backtrace_specials (speccount, backlist->pdlcount, stream); - speccount = backlist->pdlcount; - } - write_c_string (((backlist->debug_on_exit) ? "* " : " "), - stream); - if (backlist->nargs == UNEVALLED) - { - Fprin1 (Fcons (*backlist->function, *backlist->args), stream); - write_c_string ("\n", stream); /* from FSFmacs 19.30 */ - } - else - { - Lisp_Object tem = *backlist->function; - Fprin1 (tem, stream); /* This can QUIT */ - write_c_string ("(", stream); - if (backlist->nargs == MANY) - { - int i; - Lisp_Object tail = Qnil; - struct gcpro ngcpro1; - - NGCPRO1 (tail); - for (tail = *backlist->args, i = 0; - !NILP (tail); - tail = Fcdr (tail), i++) - { - if (i != 0) write_c_string (" ", stream); - Fprin1 (Fcar (tail), stream); - } - NUNGCPRO; - } - else - { - int i; - for (i = 0; i < backlist->nargs; i++) - { - if (!i && EQ(tem, Qbyte_code)) { - write_c_string("\"...\"", stream); - continue; - } - if (i != 0) write_c_string (" ", stream); - Fprin1 (backlist->args[i], stream); - } - } - } - write_c_string (")\n", stream); - backlist = backlist->next; - } - } - Vprint_level = old_level; - print_readably = old_pr; - print_escape_newlines = old_nl; - UNGCPRO; - Vinhibit_quit = oiq; - return Qnil; -} - - -DEFUN ("backtrace-frame", Fbacktrace_frame, 1, 1, "", /* -Return the function and arguments N frames up from current execution point. -If that frame has not evaluated the arguments yet (or is a special form), -the value is (nil FUNCTION ARG-FORMS...). -If that frame has evaluated its arguments and called its function already, -the value is (t FUNCTION ARG-VALUES...). -A &rest arg is represented as the tail of the list ARG-VALUES. -FUNCTION is whatever was supplied as car of evaluated list, -or a lambda expression for macro calls. -If N is more than the number of frames, the value is nil. -*/ - (nframes)) -{ - REGISTER struct backtrace *backlist = backtrace_list; - REGISTER int i; - Lisp_Object tem; - - CHECK_NATNUM (nframes); - - /* Find the frame requested. */ - for (i = XINT (nframes); backlist && (i-- > 0);) - backlist = backlist->next; - - if (!backlist) - return Qnil; - if (backlist->nargs == UNEVALLED) - return Fcons (Qnil, Fcons (*backlist->function, *backlist->args)); - else - { - if (backlist->nargs == MANY) - tem = *backlist->args; - else - tem = Flist (backlist->nargs, backlist->args); - - return Fcons (Qt, Fcons (*backlist->function, tem)); - } -} - - -/************************************************************************/ -/* Warnings */ -/************************************************************************/ - -void -warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level, - Lisp_Object obj) -{ - obj = list1 (list3 (class, level, obj)); - if (NILP (Vpending_warnings)) - Vpending_warnings = Vpending_warnings_tail = obj; - else - { - Fsetcdr (Vpending_warnings_tail, obj); - Vpending_warnings_tail = obj; - } -} - -/* #### This should probably accept Lisp objects; but then we have - to make sure that Feval() isn't called, since it might not be safe. - - An alternative approach is to just pass some non-string type of - Lisp_Object to warn_when_safe_lispobj(); `prin1-to-string' will - automatically be called when it is safe to do so. */ - -void -warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...) -{ - Lisp_Object obj; - va_list args; - - va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), - Qnil, -1, args); - va_end (args); - - warn_when_safe_lispobj (class, level, obj); -} - - - - -/************************************************************************/ -/* Initialization */ -/************************************************************************/ - -void -syms_of_eval (void) -{ - defsymbol (&Qinhibit_quit, "inhibit-quit"); - defsymbol (&Qautoload, "autoload"); - defsymbol (&Qdebug_on_error, "debug-on-error"); - defsymbol (&Qstack_trace_on_error, "stack-trace-on-error"); - defsymbol (&Qdebug_on_signal, "debug-on-signal"); - defsymbol (&Qstack_trace_on_signal, "stack-trace-on-signal"); - defsymbol (&Qdebugger, "debugger"); - defsymbol (&Qmacro, "macro"); - defsymbol (&Qand_rest, "&rest"); - defsymbol (&Qand_optional, "&optional"); - /* Note that the process code also uses Qexit */ - defsymbol (&Qexit, "exit"); - defsymbol (&Qsetq, "setq"); - defsymbol (&Qinteractive, "interactive"); - defsymbol (&Qcommandp, "commandp"); - defsymbol (&Qdefun, "defun"); - defsymbol (&Qprogn, "progn"); - defsymbol (&Qvalues, "values"); - defsymbol (&Qdisplay_warning, "display-warning"); - defsymbol (&Qrun_hooks, "run-hooks"); - defsymbol (&Qif, "if"); - - DEFSUBR (For); - DEFSUBR (Fand); - DEFSUBR (Fif); - DEFSUBR_MACRO (Fwhen); - DEFSUBR_MACRO (Funless); - DEFSUBR (Fcond); - DEFSUBR (Fprogn); - DEFSUBR (Fprog1); - DEFSUBR (Fprog2); - DEFSUBR (Fsetq); - DEFSUBR (Fquote); - DEFSUBR (Ffunction); - DEFSUBR (Fdefun); - DEFSUBR (Fdefmacro); - DEFSUBR (Fdefvar); - DEFSUBR (Fdefconst); - DEFSUBR (Fuser_variable_p); - DEFSUBR (Flet); - DEFSUBR (FletX); - DEFSUBR (Fwhile); - DEFSUBR (Fmacroexpand_internal); - DEFSUBR (Fcatch); - DEFSUBR (Fthrow); - DEFSUBR (Funwind_protect); - DEFSUBR (Fcondition_case); - DEFSUBR (Fcall_with_condition_handler); - DEFSUBR (Fsignal); - DEFSUBR (Finteractive_p); - DEFSUBR (Fcommandp); - DEFSUBR (Fcommand_execute); - DEFSUBR (Fautoload); - DEFSUBR (Feval); - DEFSUBR (Fapply); - DEFSUBR (Ffuncall); - DEFSUBR (Ffunctionp); - DEFSUBR (Ffunction_min_args); - DEFSUBR (Ffunction_max_args); - DEFSUBR (Frun_hooks); - DEFSUBR (Frun_hook_with_args); - DEFSUBR (Frun_hook_with_args_until_success); - DEFSUBR (Frun_hook_with_args_until_failure); - DEFSUBR (Fbacktrace_debug); - DEFSUBR (Fbacktrace); - DEFSUBR (Fbacktrace_frame); -} - -void -reinit_eval (void) -{ - specpdl_ptr = specpdl; - specpdl_depth_counter = 0; - catchlist = 0; - Vcondition_handlers = Qnil; - backtrace_list = 0; - Vquit_flag = Qnil; - debug_on_next_call = 0; - lisp_eval_depth = 0; - entering_debugger = 0; -} - -void -vars_of_eval (void) -{ - DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /* -Limit on number of Lisp variable bindings & unwind-protects before error. -*/ ); - - DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth /* -Limit on depth in `eval', `apply' and `funcall' before error. -This limit is to catch infinite recursions for you before they cause -actual stack overflow in C, which would be fatal for Emacs. -You can safely make it considerably larger than its default value, -if that proves inconveniently small. -*/ ); - - DEFVAR_LISP ("quit-flag", &Vquit_flag /* -Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. -Typing C-G sets `quit-flag' non-nil, regardless of `inhibit-quit'. -*/ ); - Vquit_flag = Qnil; - - DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit /* -Non-nil inhibits C-g quitting from happening immediately. -Note that `quit-flag' will still be set by typing C-g, -so a quit will be signalled as soon as `inhibit-quit' is nil. -To prevent this happening, set `quit-flag' to nil -before making `inhibit-quit' nil. The value of `inhibit-quit' is -ignored if a critical quit is requested by typing control-shift-G in -an X frame. -*/ ); - Vinhibit_quit = Qnil; - - DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error /* -*Non-nil means automatically display a backtrace buffer -after any error that is not handled by a `condition-case'. -If the value is a list, an error only means to display a backtrace -if one of its condition symbols appears in the list. -See also variable `stack-trace-on-signal'. -*/ ); - Vstack_trace_on_error = Qnil; - - DEFVAR_LISP ("stack-trace-on-signal", &Vstack_trace_on_signal /* -*Non-nil means automatically display a backtrace buffer -after any error that is signalled, whether or not it is handled by -a `condition-case'. -If the value is a list, an error only means to display a backtrace -if one of its condition symbols appears in the list. -See also variable `stack-trace-on-error'. -*/ ); - Vstack_trace_on_signal = Qnil; - - DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors /* -*List of errors for which the debugger should not be called. -Each element may be a condition-name or a regexp that matches error messages. -If any element applies to a given error, that error skips the debugger -and just returns to top level. -This overrides the variable `debug-on-error'. -It does not apply to errors handled by `condition-case'. -*/ ); - Vdebug_ignored_errors = Qnil; - - DEFVAR_LISP ("debug-on-error", &Vdebug_on_error /* -*Non-nil means enter debugger if an unhandled error is signalled. -The debugger will not be entered if the error is handled by -a `condition-case'. -If the value is a list, an error only means to enter the debugger -if one of its condition symbols appears in the list. -This variable is overridden by `debug-ignored-errors'. -See also variables `debug-on-quit' and `debug-on-signal'. -*/ ); - Vdebug_on_error = Qnil; - - DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal /* -*Non-nil means enter debugger if an error is signalled. -The debugger will be entered whether or not the error is handled by -a `condition-case'. -If the value is a list, an error only means to enter the debugger -if one of its condition symbols appears in the list. -See also variable `debug-on-quit'. -*/ ); - Vdebug_on_signal = Qnil; - - DEFVAR_BOOL ("debug-on-quit", &debug_on_quit /* -*Non-nil means enter debugger if quit is signalled (C-G, for example). -Does not apply if quit is handled by a `condition-case'. Entering the -debugger can also be achieved at any time (for X11 console) by typing -control-shift-G to signal a critical quit. -*/ ); - debug_on_quit = 0; - - DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call /* -Non-nil means enter debugger before next `eval', `apply' or `funcall'. -*/ ); - - DEFVAR_LISP ("debugger", &Vdebugger /* -Function to call to invoke debugger. -If due to frame exit, args are `exit' and the value being returned; - this function's value will be returned instead of that. -If due to error, args are `error' and a list of the args to `signal'. -If due to `apply' or `funcall' entry, one arg, `lambda'. -If due to `eval' entry, one arg, t. -*/ ); - Vdebugger = Qnil; - - preparing_for_armageddon = 0; - - staticpro (&Vpending_warnings); - Vpending_warnings = Qnil; - Vpending_warnings_tail = Qnil; /* no need to protect this */ - - in_warnings = 0; - - staticpro (&Vautoload_queue); - Vautoload_queue = Qnil; - - staticpro (&Vcondition_handlers); - - staticpro (&Vcurrent_warning_class); - Vcurrent_warning_class = Qnil; - - staticpro (&Vcurrent_error_state); - Vcurrent_error_state = Qnil; /* errors as normal */ - - Qunbound_suspended_errors_tag = make_opaque_long (0); - staticpro (&Qunbound_suspended_errors_tag); - - specpdl_size = 50; - specpdl_depth_counter = 0; - specpdl = xnew_array (struct specbinding, specpdl_size); - /* XEmacs change: increase these values. */ - max_specpdl_size = 3000; - max_lisp_eval_depth = 500; -#if 0 /* no longer used */ - throw_level = 0; -#endif - - reinit_eval (); -} diff --git a/src/event-Xt.c b/src/event-Xt.c deleted file mode 100644 index b729cfa..0000000 --- a/src/event-Xt.c +++ /dev/null @@ -1,3011 +0,0 @@ -/* The event_stream interface for X11 with Xt, and/or tty frames. - Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996 Ben Wing. - -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. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "../lwlib/lwlib.h" -#include "EmacsFrame.h" - -#include "blocktype.h" -#include "buffer.h" -#include "console.h" -#include "console-tty.h" -#include "events.h" -#include "frame.h" -#include "objects-x.h" -#include "process.h" -#include "redisplay.h" -#include "elhash.h" - -#include "systime.h" -#include "sysproc.h" /* for MAXDESC */ - -#include "xintrinsicp.h" /* CoreP.h needs this */ -#include /* Numerous places access the fields of - a core widget directly. We could - use XtGetValues(), but ... */ -#include - -#ifdef HAVE_XIM -#ifdef XIM_MOTIF -#include -#endif -#include "lstream.h" -#include "file-coding.h" -#endif - -#ifdef HAVE_DRAGNDROP -#include "dragdrop.h" -#endif - -#if defined (HAVE_OFFIX_DND) -#include "offix.h" -#endif - -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - -#include "events-mod.h" - -static void enqueue_Xt_dispatch_event (Lisp_Object event); - -static struct event_stream *Xt_event_stream; - -/* With the new event model, all events go through XtDispatchEvent() - and are picked up by an event handler that is added to each frame - widget. (This is how it's supposed to be.) In the old method, - Emacs sucks out events directly from XtNextEvent() and only - dispatches the events that it doesn't need to deal with. This - old way has lots of corresponding junk that is no longer - necessary: lwlib extensions, synthetic XAnyEvents, unnecessary - magic events, etc. */ - -/* The one and only one application context that Emacs uses. */ -XtAppContext Xt_app_con; - -/* Do we accept events sent by other clients? */ -int x_allow_sendevents; - -int modifier_keys_are_sticky; - -#ifdef DEBUG_XEMACS -int x_debug_events; -#endif - -static int process_events_occurred; -static int tty_events_occurred; - -/* Mask of bits indicating the descriptors that we wait for input on */ -extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask; - -static CONST String x_fallback_resources[] = -{ - /* This file is automatically generated from the app-defaults file - in ../etc/Emacs.ad. These resources are consulted only if no - app-defaults file is found at all. - */ -#include - 0 -}; - -static Lisp_Object x_keysym_to_emacs_keysym (KeySym keysym, int simple_p); -void emacs_Xt_mapping_action (Widget w, XEvent *event); -void debug_process_finalization (struct Lisp_Process *p); -void emacs_Xt_event_handler (Widget wid, XtPointer closure, XEvent *event, - Boolean *continue_to_dispatch); - -static int last_quit_check_signal_tick_count; - -Lisp_Object Qkey_mapping; -Lisp_Object Qsans_modifiers; - - -/************************************************************************/ -/* keymap handling */ -/************************************************************************/ - -/* X bogusly doesn't define the interpretations of any bits besides - ModControl, ModShift, and ModLock; so the Interclient Communication - Conventions Manual says that we have to bend over backwards to figure - out what the other modifier bits mean. According to ICCCM: - - - Any keycode which is assigned ModControl is a "control" key. - - - Any modifier bit which is assigned to a keycode which generates Meta_L - or Meta_R is the modifier bit meaning "meta". Likewise for Super, Hyper, - etc. - - - Any keypress event which contains ModControl in its state should be - interpreted as a "control" character. - - - Any keypress event which contains a modifier bit in its state which is - generated by a keycode whose corresponding keysym is Meta_L or Meta_R - should be interpreted as a "meta" character. Likewise for Super, Hyper, - etc. - - - It is illegal for a keysym to be associated with more than one modifier - bit. - - This means that the only thing that emacs can reasonably interpret as a - "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates - one of the modifier bits Mod1-Mod5. - - Unfortunately, many keyboards don't have Meta keys in their default - configuration. So, if there are no Meta keys, but there are "Alt" keys, - emacs will interpret Alt as Meta. If there are both Meta and Alt keys, - then the Meta keys mean "Meta", and the Alt keys mean "Alt" (it used to - mean "Symbol," but that just confused the hell out of way too many people). - - This works with the default configurations of the 19 keyboard-types I've - checked. - - Emacs detects keyboard configurations which violate the above rules, and - prints an error message on the standard-error-output. (Perhaps it should - use a pop-up-window instead.) - */ - -static void -x_reset_key_mapping (struct device *d) -{ - Display *display = DEVICE_X_DISPLAY (d); - struct x_device *xd = DEVICE_X_DATA (d); - KeySym *keysym, *keysym_end; - Lisp_Object hash_table; - int key_code_count, keysyms_per_code; - - if (xd->x_keysym_map) - XFree ((char *) xd->x_keysym_map); - XDisplayKeycodes (display, - &xd->x_keysym_map_min_code, - &xd->x_keysym_map_max_code); - key_code_count = xd->x_keysym_map_max_code - xd->x_keysym_map_min_code + 1; - xd->x_keysym_map = - XGetKeyboardMapping (display, xd->x_keysym_map_min_code, key_code_count, - &xd->x_keysym_map_keysyms_per_code); - - hash_table = xd->x_keysym_map_hash_table; - if (HASH_TABLEP (hash_table)) - Fclrhash (hash_table); - else - xd->x_keysym_map_hash_table = hash_table = - make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); - - for (keysym = xd->x_keysym_map, - keysyms_per_code = xd->x_keysym_map_keysyms_per_code, - keysym_end = keysym + (key_code_count * keysyms_per_code); - keysym < keysym_end; - keysym += keysyms_per_code) - { - int j; - - if (keysym[0] == NoSymbol) - continue; - - { - char *name = XKeysymToString (keysym[0]); - Lisp_Object sym = x_keysym_to_emacs_keysym (keysym[0], 0); - if (name) - { - Fputhash (build_string (name), Qsans_modifiers, hash_table); - Fputhash (sym, Qsans_modifiers, hash_table); - } - } - - for (j = 1; j < keysyms_per_code; j++) - { - if (keysym[j] != keysym[0] && - keysym[j] != NoSymbol) - { - char *name = XKeysymToString (keysym[j]); - Lisp_Object sym = x_keysym_to_emacs_keysym (keysym[j], 0); - if (name && NILP (Fgethash (sym, hash_table, Qnil))) - { - Fputhash (build_string (name), Qt, hash_table); - Fputhash (sym, Qt, hash_table); - } - } - } - } -} - -static CONST char * -index_to_name (int indice) -{ - switch (indice) - { - case ShiftMapIndex: return "ModShift"; - case LockMapIndex: return "ModLock"; - case ControlMapIndex: return "ModControl"; - case Mod1MapIndex: return "Mod1"; - case Mod2MapIndex: return "Mod2"; - case Mod3MapIndex: return "Mod3"; - case Mod4MapIndex: return "Mod4"; - case Mod5MapIndex: return "Mod5"; - default: return "???"; - } -} - -/* Boy, I really wish C had local functions... */ -struct c_doesnt_have_closures /* #### not yet used */ -{ - int warned_about_overlapping_modifiers; - int warned_about_predefined_modifiers; - int warned_about_duplicate_modifiers; - int meta_bit; - int hyper_bit; - int super_bit; - int alt_bit; - int mode_bit; -}; - -static void -x_reset_modifier_mapping (struct device *d) -{ - Display *display = DEVICE_X_DISPLAY (d); - struct x_device *xd = DEVICE_X_DATA (d); - int modifier_index, modifier_key, column, mkpm; - int warned_about_overlapping_modifiers = 0; - int warned_about_predefined_modifiers = 0; - int warned_about_duplicate_modifiers = 0; - int meta_bit = 0; - int hyper_bit = 0; - int super_bit = 0; - int alt_bit = 0; - int mode_bit = 0; - - xd->lock_interpretation = 0; - - if (xd->x_modifier_keymap) - XFreeModifiermap (xd->x_modifier_keymap); - - x_reset_key_mapping (d); - - xd->x_modifier_keymap = XGetModifierMapping (display); - - /* Boy, I really wish C had local functions... - */ - - /* The call to warn_when_safe must be on the same line as the string or - make-msgfile won't pick it up properly (the newline doesn't confuse - it, but the backslash does). */ - -#define modwarn(name,old,other) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates %s, which is generated by %s.", \ - name, code, index_to_name (old), other), \ - warned_about_overlapping_modifiers = 1 - -#define modbarf(name,other) \ - warn_when_safe (Qkey_mapping, Qwarning, "XEmacs: %s (0x%x) generates %s, which is nonsensical.", \ - name, code, other), \ - warned_about_predefined_modifiers = 1 - -#define check_modifier(name,mask) \ - if ((1<x_modifier_keymap->max_keypermod; - for (modifier_index = 0; modifier_index < 8; modifier_index++) - for (modifier_key = 0; modifier_key < mkpm; modifier_key++) { - KeySym last_sym = 0; - for (column = 0; column < 4; column += 2) { - KeyCode code = xd->x_modifier_keymap->modifiermap[modifier_index * mkpm - + modifier_key]; - KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0); - if (sym == last_sym) continue; - last_sym = sym; - switch (sym) { - case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break; - case XK_Meta_L: store_modifier ("Meta_L", meta_bit); break; - case XK_Meta_R: store_modifier ("Meta_R", meta_bit); break; - case XK_Super_L: store_modifier ("Super_L", super_bit); break; - case XK_Super_R: store_modifier ("Super_R", super_bit); break; - case XK_Hyper_L: store_modifier ("Hyper_L", hyper_bit); break; - case XK_Hyper_R: store_modifier ("Hyper_R", hyper_bit); break; - case XK_Alt_L: store_modifier ("Alt_L", alt_bit); break; - case XK_Alt_R: store_modifier ("Alt_R", alt_bit); break; - case XK_Control_L: check_modifier ("Control_L", ControlMask); break; - case XK_Control_R: check_modifier ("Control_R", ControlMask); break; - case XK_Shift_L: check_modifier ("Shift_L", ShiftMask); break; - case XK_Shift_R: check_modifier ("Shift_R", ShiftMask); break; - case XK_Shift_Lock: check_modifier ("Shift_Lock", LockMask); - xd->lock_interpretation = XK_Shift_Lock; break; - case XK_Caps_Lock: check_modifier ("Caps_Lock", LockMask); - xd->lock_interpretation = XK_Caps_Lock; break; - - /* It probably doesn't make any sense for a modifier bit to be - assigned to a key that is not one of the above, but OpenWindows - assigns modifier bits to a couple of random function keys for - no reason that I can discern, so printing a warning here would - be annoying. */ - } - } - } -#undef store_modifier -#undef check_modifier -#undef modwarn -#undef modbarf - - /* If there was no Meta key, then try using the Alt key instead. - If there is both a Meta key and an Alt key, then the Alt key - is not disturbed and remains an Alt key. */ - if (! meta_bit && alt_bit) - meta_bit = alt_bit, alt_bit = 0; - - /* mode_bit overrides everything, since it's processed down inside of - XLookupString() instead of by us. If Meta and Mode_switch both - generate the same modifier bit (which is an error), then we don't - interpret that bit as Meta, because we can't make XLookupString() - not interpret it as Mode_switch; and interpreting it as both would - be totally wrong. */ - if (mode_bit) - { - CONST char *warn = 0; - if (mode_bit == meta_bit) warn = "Meta", meta_bit = 0; - else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0; - else if (mode_bit == super_bit) warn = "Super", super_bit = 0; - else if (mode_bit == alt_bit) warn = "Alt", alt_bit = 0; - if (warn) - { - warn_when_safe - (Qkey_mapping, Qwarning, - "XEmacs: %s is being used for both Mode_switch and %s.", - index_to_name (mode_bit), warn), - warned_about_overlapping_modifiers = 1; - } - } -#undef index_to_name - - xd->MetaMask = (meta_bit ? (1 << meta_bit) : 0); - xd->HyperMask = (hyper_bit ? (1 << hyper_bit) : 0); - xd->SuperMask = (super_bit ? (1 << super_bit) : 0); - xd->AltMask = (alt_bit ? (1 << alt_bit) : 0); - xd->ModeMask = (mode_bit ? (1 << mode_bit) : 0); /* unused */ - - - if (warned_about_overlapping_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" Two distinct modifier keys (such as Meta and Hyper) cannot generate\n" -" the same modifier bit, because Emacs won't be able to tell which\n" -" modifier was actually held down when some other key is pressed. It\n" -" won't be able to tell Meta-x and Hyper-x apart, for example. Change\n" -" one of these keys to use some other modifier bit. If you intend for\n" -" these keys to have the same behavior, then change them to have the\n" -" same keysym as well as the same modifier bit."); - - if (warned_about_predefined_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" The semantics of the modifier bits ModShift, ModLock, and ModControl\n" -" are predefined. It does not make sense to assign ModControl to any\n" -" keysym other than Control_L or Control_R, or to assign any modifier\n" -" bits to the \"control\" keysyms other than ModControl. You can't\n" -" turn a \"control\" key into a \"meta\" key (or vice versa) by simply\n" -" assigning the key a different modifier bit. You must also make that\n" -" key generate an appropriate keysym (Control_L, Meta_L, etc)."); - - /* No need to say anything more for warned_about_duplicate_modifiers. */ - - if (warned_about_overlapping_modifiers || warned_about_predefined_modifiers) - warn_when_safe (Qkey_mapping, Qwarning, "\n" -" The meanings of the modifier bits Mod1 through Mod5 are determined\n" -" by the keysyms used to control those bits. Mod1 does NOT always\n" -" mean Meta, although some non-ICCCM-compliant programs assume that."); -} - -void -x_init_modifier_mapping (struct device *d) -{ - struct x_device *xd = DEVICE_X_DATA (d); - xd->x_keysym_map_hash_table = Qnil; - xd->x_keysym_map = NULL; - xd->x_modifier_keymap = NULL; - x_reset_modifier_mapping (d); -} - -static int -x_key_is_modifier_p (KeyCode keycode, struct device *d) -{ - struct x_device *xd = DEVICE_X_DATA (d); - KeySym *syms; - int i; - - if (keycode < xd->x_keysym_map_min_code || - keycode > xd->x_keysym_map_max_code) - return 0; - - syms = &xd->x_keysym_map [(keycode - xd->x_keysym_map_min_code) * - xd->x_keysym_map_keysyms_per_code]; - for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++) - if (IsModifierKey (syms [i]) || - syms [i] == XK_Mode_switch) /* why doesn't IsModifierKey count this? */ - return 1; - return 0; -} - -/* key-handling code is always ugly. It just ends up working out - that way. - - Here are some pointers: - - -- DOWN_MASK indicates which modifiers should be treated as "down" - when the corresponding upstroke happens. It gets reset for - a particular modifier when that modifier goes up, and reset - for all modifiers when a non-modifier key is pressed. Example: - - I press Control-A-Shift and then release Control-A-Shift. - I want the Shift key to be sticky but not the Control key. - - -- LAST_DOWNKEY and RELEASE_TIME are used to keep track of - auto-repeat -- see below. - - -- If a modifier key is sticky, I can unstick it by pressing - the modifier key again. */ - -static void -x_handle_sticky_modifiers (XEvent *ev, struct device *d) -{ - struct x_device *xd; - KeyCode keycode; - int type; - - if (!modifier_keys_are_sticky) /* Optimize for non-sticky modifiers */ - return; - - xd = DEVICE_X_DATA (d); - keycode = ev->xkey.keycode; - type = ev->type; - - if (keycode < xd->x_keysym_map_min_code || - keycode > xd->x_keysym_map_max_code) - return; - - if (! ((type == KeyPress || type == KeyRelease) && - x_key_is_modifier_p (keycode, d))) - { /* Not a modifier key */ - Bool key_event_p = (type == KeyPress || type == KeyRelease); - - if (type == KeyPress && !xd->last_downkey) - xd->last_downkey = keycode; - else if (type == ButtonPress || - (type == KeyPress && xd->last_downkey && - (keycode != xd->last_downkey || - ev->xkey.time != xd->release_time))) - { - xd->need_to_add_mask = 0; - xd->last_downkey = 0; - } - if (type == KeyPress) - xd->release_time = 0; - if (type == KeyPress || type == ButtonPress) - xd->down_mask = 0; - - if (key_event_p) - ev->xkey.state |= xd->need_to_add_mask; - else - ev->xbutton.state |= xd->need_to_add_mask; - - if (type == KeyRelease && keycode == xd->last_downkey) - /* If I hold press-and-release the Control key and then press - and hold down the right arrow, I want it to auto-repeat - Control-Right. On the other hand, if I do the same but - manually press the Right arrow a bunch of times, I want - to see one Control-Right and then a bunch of Rights. - This means that we need to distinguish between an - auto-repeated key and a key pressed and released a bunch - of times. - - Naturally, the designers of the X spec didn't see fit - to provide an obvious way to distinguish these cases. - So we assume that if the release and the next press - occur at the same time, the key was actually auto- - repeated. Under Open-Windows, at least, this works. */ - xd->release_time = key_event_p ? ev->xkey.time : ev->xbutton.time; - } - else /* Modifier key pressed */ - { - int i; - KeySym *syms = &xd->x_keysym_map [(keycode - xd->x_keysym_map_min_code) * - xd->x_keysym_map_keysyms_per_code]; - - /* If a non-modifier key was pressed in the middle of a bunch - of modifiers, then it unsticks all the modifiers that were - previously pressed. We cannot unstick the modifiers until - now because we want to check for auto-repeat of the - non-modifier key. */ - - if (xd->last_downkey) - { - xd->last_downkey = 0; - xd->need_to_add_mask = 0; - } - -#define FROB(mask) \ -do { \ - if (type == KeyPress) \ - { \ - /* If modifier key is already sticky, \ - then unstick it. Note that we do \ - not test down_mask to deal with the \ - unlikely but possible case that the \ - modifier key auto-repeats. */ \ - if (xd->need_to_add_mask & mask) \ - { \ - xd->need_to_add_mask &= ~mask; \ - xd->down_mask &= ~mask; \ - } \ - else \ - xd->down_mask |= mask; \ - } \ - else \ - { \ - if (xd->down_mask & mask) \ - { \ - xd->down_mask &= ~mask; \ - xd->need_to_add_mask |= mask; \ - } \ - } \ -} while (0) - - for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++) - switch (syms[i]) - { - case XK_Control_L: case XK_Control_R: FROB (ControlMask); break; - case XK_Shift_L: case XK_Shift_R: FROB (ShiftMask); break; - case XK_Meta_L: case XK_Meta_R: FROB (xd->MetaMask); break; - case XK_Super_L: case XK_Super_R: FROB (xd->SuperMask); break; - case XK_Hyper_L: case XK_Hyper_R: FROB (xd->HyperMask); break; - case XK_Alt_L: case XK_Alt_R: FROB (xd->AltMask); break; - } - } -#undef FROB -} - -static void -clear_sticky_modifiers (struct device *d) -{ - struct x_device *xd = DEVICE_X_DATA (d); - - xd->need_to_add_mask = 0; - xd->last_downkey = 0; - xd->release_time = 0; - xd->down_mask = 0; -} - -static int -keysym_obeys_caps_lock_p (KeySym sym, struct device *d) -{ - struct x_device *xd = DEVICE_X_DATA (d); - /* Eeeeevil hack. Don't apply Caps_Lock to things that aren't alphabetic - characters, where "alphabetic" means something more than simply A-Z. - That is, if Caps_Lock is down, typing ESC doesn't produce Shift-ESC. - But if shift-lock is down, then it does. */ - if (xd->lock_interpretation == XK_Shift_Lock) - return 1; - - return - ((sym >= XK_A) && (sym <= XK_Z)) || - ((sym >= XK_a) && (sym <= XK_z)) || - ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis)) || - ((sym >= XK_agrave) && (sym <= XK_odiaeresis)) || - ((sym >= XK_Ooblique) && (sym <= XK_Thorn)) || - ((sym >= XK_oslash) && (sym <= XK_thorn)); -} - -/* called from EmacsFrame.c (actually from Xt itself) when a - MappingNotify event is received. In its infinite wisdom, Xt - decided that Xt event handlers never get MappingNotify events. - O'Reilly Xt Programming Manual 9.1.2 says: - - MappingNotify is automatically handled by Xt, so it isn't passed - to event handlers and you don't need to worry about it. - - Of course, we DO worry about it, so we need a special translation. */ -void -emacs_Xt_mapping_action (Widget w, XEvent* event) -{ - struct device *d = get_device_from_display (event->xany.display); - - if (DEVICE_X_BEING_DELETED (d)) - return; -#if 0 - /* nyet. Now this is handled by Xt. */ - XRefreshKeyboardMapping (&event->xmapping); -#endif - /* xmodmap generates about a billion MappingKeyboard events, followed - by a single MappingModifier event, so it might be worthwhile to - take extra MappingKeyboard events out of the queue before requesting - the current keymap from the server. */ - switch (event->xmapping.request) - { - case MappingKeyboard: x_reset_key_mapping (d); break; - case MappingModifier: x_reset_modifier_mapping (d); break; - case MappingPointer: /* Do something here? */ break; - default: abort(); - } -} - - -/************************************************************************/ -/* X to Emacs event conversion */ -/************************************************************************/ - -static Lisp_Object -x_keysym_to_emacs_keysym (KeySym keysym, int simple_p) -{ - char *name; - if (keysym >= XK_exclam && keysym <= XK_asciitilde) - /* We must assume that the X keysym numbers for the ASCII graphic - characters are the same as their ASCII codes. */ - return make_char (keysym); - - switch (keysym) - { - /* These would be handled correctly by the default case, but by - special-casing them here we don't garbage a string or call - intern(). */ - case XK_BackSpace: return QKbackspace; - case XK_Tab: return QKtab; - case XK_Linefeed: return QKlinefeed; - case XK_Return: return QKreturn; - case XK_Escape: return QKescape; - case XK_space: return QKspace; - case XK_Delete: return QKdelete; - case 0: return Qnil; - default: - if (simple_p) return Qnil; - /* !!#### not Mule-ized */ - name = XKeysymToString (keysym); - if (!name || !name[0]) - /* This happens if there is a mismatch between the Xlib of - XEmacs and the Xlib of the X server... - - Let's hard-code in some knowledge of common keysyms introduced - in recent X11 releases. Snarfed from X11/keysymdef.h - - Probably we should add some stuff here for X11R6. */ - switch (keysym) - { - case 0xFF95: return KEYSYM ("kp-home"); - case 0xFF96: return KEYSYM ("kp-left"); - case 0xFF97: return KEYSYM ("kp-up"); - case 0xFF98: return KEYSYM ("kp-right"); - case 0xFF99: return KEYSYM ("kp-down"); - case 0xFF9A: return KEYSYM ("kp-prior"); - case 0xFF9B: return KEYSYM ("kp-next"); - case 0xFF9C: return KEYSYM ("kp-end"); - case 0xFF9D: return KEYSYM ("kp-begin"); - case 0xFF9E: return KEYSYM ("kp-insert"); - case 0xFF9F: return KEYSYM ("kp-delete"); - - case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */ - case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */ - default: - { - char buf [64]; - sprintf (buf, "unknown-keysym-0x%X", (int) keysym); - return KEYSYM (buf); - } - } - /* If it's got a one-character name, that's good enough. */ - if (!name[1]) - return make_char (name[0]); - - /* If it's in the "Keyboard" character set, downcase it. - The case of those keysyms is too totally random for us to - force anyone to remember them. - The case of the other character sets is significant, however. - */ - if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00)) - { - char buf [255]; - char *s1, *s2; - for (s1 = name, s2 = buf; *s1; s1++, s2++) { - if (*s1 == '_') { - *s2 = '-'; - } else { - *s2 = tolower (* (unsigned char *) s1); - } - } - *s2 = 0; - return KEYSYM (buf); - } - return KEYSYM (name); - } -} - -static Lisp_Object -x_to_emacs_keysym (XKeyPressedEvent *event, int simple_p) - /* simple_p means don't try too hard (ASCII only) */ -{ - KeySym keysym = 0; - -#ifdef HAVE_XIM - int len; - char buffer[64]; - char *bufptr = buffer; - int bufsiz = sizeof (buffer); - Status status; -#ifdef XIM_XLIB - XIC xic = FRAME_X_XIC (x_any_window_to_frame - (get_device_from_display (event->display), - event->window)); -#endif /* XIM_XLIB */ -#endif /* HAVE_XIM */ - - /* We use XLookupString if we're not using XIM, or are using - XIM_XLIB but input context creation failed. */ -#if ! (defined (HAVE_XIM) && defined (XIM_MOTIF)) -#if defined (HAVE_XIM) && defined (XIM_XLIB) - if (!xic) -#endif /* XIM_XLIB */ - { - /* Apparently it's necessary to specify a dummy here (rather - than passing in 0) to avoid crashes on German IRIX */ - char dummy[256]; - XLookupString (event, dummy, 200, &keysym, 0); - return (IsModifierKey (keysym) || keysym == XK_Mode_switch ) - ? Qnil : x_keysym_to_emacs_keysym (keysym, simple_p); - } -#endif /* ! XIM_MOTIF */ - -#ifdef HAVE_XIM - Lookup_String: /* Come-From XBufferOverflow */ -#ifdef XIM_MOTIF - len = XmImMbLookupString (XtWindowToWidget (event->display, event->window), - event, bufptr, bufsiz, &keysym, &status); -#else /* XIM_XLIB */ - len = XmbLookupString (xic, event, bufptr, bufsiz, &keysym, &status); -#endif /* HAVE_XIM */ - -#ifdef DEBUG_XEMACS - if (x_debug_events > 0) - { - stderr_out (" status="); -#define print_status_when(S) if (status == S) stderr_out (#S) - print_status_when (XLookupKeySym); - print_status_when (XLookupBoth); - print_status_when (XLookupChars); - print_status_when (XLookupNone); - print_status_when (XBufferOverflow); - - if (status == XLookupKeySym || status == XLookupBoth) - stderr_out (" keysym=%s", XKeysymToString (keysym)); - if (status == XLookupChars || status == XLookupBoth) - { - if (len != 1) - { - int j; - stderr_out (" chars=\""); - for (j=0; j= 127) - stderr_out (" char=0x%x", bufptr[0]); - else - stderr_out (" char=%c", bufptr[0]); - } - stderr_out ("\n"); - } -#endif /* DEBUG_XEMACS */ - - switch (status) - { - case XLookupKeySym: - case XLookupBoth: - return (IsModifierKey (keysym) || keysym == XK_Mode_switch ) - ? Qnil : x_keysym_to_emacs_keysym (keysym, simple_p); - - case XLookupChars: - { - /* Generate multiple emacs events */ - struct device *d = get_device_from_display (event->display); - Emchar ch; - Lisp_Object instream, fb_instream; - Lstream *istr; - struct gcpro gcpro1, gcpro2; - - fb_instream = - make_fixed_buffer_input_stream ((unsigned char *) bufptr, len); - - /* ### Use Fget_coding_system (Vcomposed_input_coding_system) */ - instream = - make_decoding_input_stream (XLSTREAM (fb_instream), - Fget_coding_system (Qundecided)); - - istr = XLSTREAM (instream); - - GCPRO2 (instream, fb_instream); - while ((ch = Lstream_get_emchar (istr)) != EOF) - { - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event *ev = XEVENT (emacs_event); - ev->channel = DEVICE_CONSOLE (d); - ev->event_type = key_press_event; - ev->timestamp = event->time; - ev->event.key.modifiers = 0; - ev->event.key.keysym = make_char (ch); - enqueue_Xt_dispatch_event (emacs_event); - } - Lstream_close (istr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (XLSTREAM (fb_instream)); - return Qnil; - } - case XLookupNone: return Qnil; - case XBufferOverflow: - bufptr = (char *) alloca (len+1); - bufsiz = len+1; - goto Lookup_String; - } - return Qnil; /* not reached */ -#endif /* HAVE_XIM */ -} - -static void -set_last_server_timestamp (struct device *d, XEvent *x_event) -{ - Time t; - switch (x_event->type) - { - case KeyPress: - case KeyRelease: t = x_event->xkey.time; break; - case ButtonPress: - case ButtonRelease: t = x_event->xbutton.time; break; - case EnterNotify: - case LeaveNotify: t = x_event->xcrossing.time; break; - case MotionNotify: t = x_event->xmotion.time; break; - case PropertyNotify: t = x_event->xproperty.time; break; - case SelectionClear: t = x_event->xselectionclear.time; break; - case SelectionRequest: t = x_event->xselectionrequest.time; break; - case SelectionNotify: t = x_event->xselection.time; break; - default: return; - } - DEVICE_X_LAST_SERVER_TIMESTAMP (d) = t; -} - -static int -x_event_to_emacs_event (XEvent *x_event, struct Lisp_Event *emacs_event) -{ - Display *display = x_event->xany.display; - struct device *d = get_device_from_display (display); - struct x_device *xd = DEVICE_X_DATA (d); - - if (DEVICE_X_BEING_DELETED (d)) - /* #### Uh, is this 0 correct? */ - return 0; - - set_last_server_timestamp (d, x_event); - - switch (x_event->type) - { - case KeyRelease: - x_handle_sticky_modifiers (x_event, d); - return 0; - - case KeyPress: - case ButtonPress: - case ButtonRelease: - { - unsigned int modifiers = 0; - int shift_p, lock_p; - Bool key_event_p = (x_event->type == KeyPress); - unsigned int *state = - key_event_p ? &x_event->xkey.state : &x_event->xbutton.state; - - /* If this is a synthetic KeyPress or Button event, and the user - has expressed a disinterest in this security hole, then drop - it on the floor. */ - if ((key_event_p - ? x_event->xkey.send_event - : x_event->xbutton.send_event) -#ifdef EXTERNAL_WIDGET - /* ben: events get sent to an ExternalShell using XSendEvent. - This is not a perfect solution. */ - && !FRAME_X_EXTERNAL_WINDOW_P - (x_any_window_to_frame (d, x_event->xany.window)) -#endif - && !x_allow_sendevents) - return 0; - - DEVICE_X_MOUSE_TIMESTAMP (d) = - DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d) = - key_event_p ? x_event->xkey.time : x_event->xbutton.time; - - x_handle_sticky_modifiers (x_event, d); - - if (*state & ControlMask) modifiers |= MOD_CONTROL; - if (*state & xd->MetaMask) modifiers |= MOD_META; - if (*state & xd->SuperMask) modifiers |= MOD_SUPER; - if (*state & xd->HyperMask) modifiers |= MOD_HYPER; - if (*state & xd->AltMask) modifiers |= MOD_ALT; - - /* Ignore the Caps_Lock key if: - - any other modifiers are down, so that Caps_Lock doesn't - turn C-x into C-X, which would suck. - - the event was a mouse event. */ - if (modifiers || ! key_event_p) - *state &= (~LockMask); - - shift_p = *state & ShiftMask; - lock_p = *state & LockMask; - - if (shift_p || lock_p) - modifiers |= MOD_SHIFT; - - if (key_event_p) - { - Lisp_Object keysym; - XKeyEvent *ev = &x_event->xkey; - /* This used to compute the frame from the given X window and - store it here, but we really don't care about the frame. */ - emacs_event->channel = DEVICE_CONSOLE (d); - keysym = x_to_emacs_keysym (&x_event->xkey, 0); - - /* If the emacs keysym is nil, then that means that the X - keysym was either a Modifier or NoSymbol, which - probably means that we're in the midst of reading a - Multi_key sequence, or a "dead" key prefix, or XIM - input. Ignore it. */ - if (NILP (keysym)) - return 0; - - /* More Caps_Lock garbage: Caps_Lock should *only* add the - shift modifier to two-case keys (that is, A-Z and - related characters). So at this point (after looking up - the keysym) if the keysym isn't a dual-case alphabetic, - and if the caps lock key was down but the shift key - wasn't, then turn off the shift modifier. Gag barf */ - /* #### type lossage: assuming equivalence of emacs and - X keysyms */ - /* !!#### maybe fix for Mule */ - if (lock_p && !shift_p && - ! (CHAR_OR_CHAR_INTP (keysym) - && keysym_obeys_caps_lock_p - ((KeySym) XCHAR_OR_CHAR_INT (keysym), d))) - modifiers &= (~MOD_SHIFT); - - /* If this key contains two distinct keysyms, that is, - "shift" generates a different keysym than the - non-shifted key, then don't apply the shift modifier - bit: it's implicit. Otherwise, if there would be no - other way to tell the difference between the shifted - and unshifted version of this key, apply the shift bit. - Non-graphics, like Backspace and F1 get the shift bit - in the modifiers slot. Neither the characters "a", - "A", "2", nor "@" normally have the shift bit set. - However, "F1" normally does. */ - if (modifiers & MOD_SHIFT) - { - int Mode_switch_p = *state & xd->ModeMask; - KeySym bot = XLookupKeysym (ev, Mode_switch_p ? 2 : 0); - KeySym top = XLookupKeysym (ev, Mode_switch_p ? 3 : 1); - if (top && bot && top != bot) - modifiers &= ~MOD_SHIFT; - } - emacs_event->event_type = key_press_event; - emacs_event->timestamp = ev->time; - emacs_event->event.key.modifiers = modifiers; - emacs_event->event.key.keysym = keysym; - } - else /* Mouse press/release event */ - { - XButtonEvent *ev = &x_event->xbutton; - struct frame *frame = x_window_to_frame (d, ev->window); - if (! frame) - return 0; /* not for us */ - XSETFRAME (emacs_event->channel, frame); - - emacs_event->event_type = (x_event->type == ButtonPress) ? - button_press_event : button_release_event; - - emacs_event->event.button.modifiers = modifiers; - emacs_event->timestamp = ev->time; - emacs_event->event.button.button = ev->button; - emacs_event->event.button.x = ev->x; - emacs_event->event.button.y = ev->y; - - } - } - break; - - case MotionNotify: - { - XMotionEvent *ev = &x_event->xmotion; - struct frame *frame = x_window_to_frame (d, ev->window); - unsigned int modifiers = 0; - XMotionEvent event2; - - if (! frame) - return 0; /* not for us */ - - /* We use MotionHintMask, so we will get only one motion event - until the next time we call XQueryPointer or the user - clicks the mouse. So call XQueryPointer now (meaning that - the event will be in sync with the server just before - Fnext_event() returns). If the mouse is still in motion, - then the server will immediately generate exactly one more - motion event, which will be on the queue waiting for us - next time around. */ - event2 = *ev; - if (XQueryPointer (event2.display, event2.window, - &event2.root, &event2.subwindow, - &event2.x_root, &event2.y_root, - &event2.x, &event2.y, - &event2.state)) - ev = &event2; /* only one structure copy */ - - DEVICE_X_MOUSE_TIMESTAMP (d) = ev->time; - - XSETFRAME (emacs_event->channel, frame); - emacs_event->event_type = pointer_motion_event; - emacs_event->timestamp = ev->time; - emacs_event->event.motion.x = ev->x; - emacs_event->event.motion.y = ev->y; - if (ev->state & ShiftMask) modifiers |= MOD_SHIFT; - if (ev->state & ControlMask) modifiers |= MOD_CONTROL; - if (ev->state & xd->MetaMask) modifiers |= MOD_META; - if (ev->state & xd->SuperMask) modifiers |= MOD_SUPER; - if (ev->state & xd->HyperMask) modifiers |= MOD_HYPER; - if (ev->state & xd->AltMask) modifiers |= MOD_ALT; - /* Currently ignores Shift_Lock but probably shouldn't - (but it definitely should ignore Caps_Lock). */ - emacs_event->event.motion.modifiers = modifiers; - } - break; - - case ClientMessage: - { - /* Patch bogus TAKE_FOCUS messages from MWM; CurrentTime is - passed as the timestamp of the TAKE_FOCUS, which the ICCCM - explicitly prohibits. */ - XClientMessageEvent *ev = &x_event->xclient; -#ifdef HAVE_OFFIX_DND - if (DndIsDropMessage(x_event)) - { - unsigned int state, modifiers = 0, button=0; - struct frame *frame = x_any_window_to_frame (d, ev->window); - Extbyte *data; - unsigned long size, dtype; - Lisp_Object l_type = Qnil, l_data = Qnil; - Lisp_Object l_dndlist = Qnil, l_item = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - GCPRO4 (l_type, l_data, l_dndlist, l_item); - - if (! frame) - return 0; /* not for us */ - XSETFRAME (emacs_event->channel, frame); - - emacs_event->event_type = misc_user_event; - emacs_event->timestamp = DEVICE_X_LAST_SERVER_TIMESTAMP (d); - - state=DndDragButtons(x_event); - - if (state & ShiftMask) modifiers |= MOD_SHIFT; - if (state & ControlMask) modifiers |= MOD_CONTROL; - if (state & xd->MetaMask) modifiers |= MOD_META; - if (state & xd->SuperMask) modifiers |= MOD_SUPER; - if (state & xd->HyperMask) modifiers |= MOD_HYPER; - if (state & xd->AltMask) modifiers |= MOD_ALT; - - if (state & Button5Mask) button = Button5; - if (state & Button4Mask) button = Button4; - if (state & Button3Mask) button = Button3; - if (state & Button2Mask) button = Button2; - if (state & Button1Mask) button = Button1; - - emacs_event->event.misc.modifiers = modifiers; - emacs_event->event.misc.button = button; - - DndDropCoordinates(FRAME_X_TEXT_WIDGET(frame), x_event, - &(emacs_event->event.misc.x), - &(emacs_event->event.misc.y) ); - - DndGetData(x_event,&data,&size); - - dtype=DndDataType(x_event); - switch (dtype) - { - case DndFiles: /* null terminated strings, end null */ - { - int len; - char *hurl = NULL; - - while (*data) - { - len = strlen ((char*)data); - hurl = dnd_url_hexify_string ((char *)data, "file:"); - l_item = make_string ((Bufbyte *)hurl, strlen (hurl)); - l_dndlist = Fcons (l_item, l_dndlist); - data += len + 1; - xfree (hurl); - } - l_type = Qdragdrop_URL; - } - break; - case DndText: - l_type = Qdragdrop_MIME; - l_dndlist = list1 ( list3 ( list1 ( make_string ((Bufbyte *)"text/plain", 10) ), - make_string ((Bufbyte *)"8bit", 4), - make_ext_string ((Extbyte *)data, - strlen((char *)data), - FORMAT_CTEXT) ) ); - break; - case DndMIME: - /* we have to parse this in some way to extract - content-type and params (in the tm way) and - content encoding. - OR: if data is string, let tm do the job - if data is list[2], give the first two - to tm... - */ - l_type = Qdragdrop_MIME; - l_dndlist = list1 ( make_ext_string ((Extbyte *)data, - strlen((char *)data), - FORMAT_BINARY) ); - break; - case DndFile: - case DndDir: - case DndLink: - case DndExe: - { - char *hurl = dnd_url_hexify_string ((char *) data, "file:"); - - l_dndlist = list1 ( make_string ((Bufbyte *)hurl, - strlen (hurl)) ); - l_type = Qdragdrop_URL; - - xfree (hurl); - } - break; - case DndURL: - /* as it is a real URL it should already be escaped - and escaping again will break them (cause % is unsave) */ - l_dndlist = list1 ( make_ext_string ((Extbyte *)data, - strlen ((char *)data), - FORMAT_FILENAME) ); - l_type = Qdragdrop_URL; - break; - default: /* Unknown, RawData and any other type */ - l_dndlist = list1 ( list3 ( list1 ( make_string ((Bufbyte *)"application/octet-stream", 24) ), - make_string ((Bufbyte *)"8bit", 4), - make_ext_string ((Extbyte *)data, - size, - FORMAT_BINARY) ) ); - l_type = Qdragdrop_MIME; - break; - } - - emacs_event->event.misc.function = Qdragdrop_drop_dispatch; - emacs_event->event.misc.object = Fcons (l_type, l_dndlist); - - UNGCPRO; - - break; - } -#endif /* HAVE_OFFIX_DND */ - if (ev->message_type == DEVICE_XATOM_WM_PROTOCOLS (d) - && (Atom) (ev->data.l[0]) == DEVICE_XATOM_WM_TAKE_FOCUS (d) - && (Atom) (ev->data.l[1]) == 0) - { - ev->data.l[1] = DEVICE_X_LAST_SERVER_TIMESTAMP (d); - } - } - /* fall through */ - - default: /* it's a magic event */ - { - struct frame *frame; - Window w; - XEvent *x_event_copy = &emacs_event->event.magic.underlying_x_event; - -#define FROB(event_member, window_member) \ - x_event_copy->event_member = x_event->event_member; \ - w = x_event->event_member.window_member - - switch (x_event->type) - { - case SelectionRequest: FROB(xselectionrequest, owner); break; - case SelectionClear: FROB(xselectionclear, window); break; - case SelectionNotify: FROB(xselection, requestor); break; - case PropertyNotify: FROB(xproperty, window); break; - case ClientMessage: FROB(xclient, window); break; - case ConfigureNotify: FROB(xconfigure, window); break; - case Expose: - case GraphicsExpose: FROB(xexpose, window); break; - case MapNotify: - case UnmapNotify: FROB(xmap, window); break; - case EnterNotify: - case LeaveNotify: FROB(xcrossing, window); break; - case FocusIn: - case FocusOut: FROB(xfocus, window); break; - case VisibilityNotify: FROB(xvisibility, window); break; - default: - w = x_event->xany.window; - *x_event_copy = *x_event; - break; - } -#undef FROB - frame = x_any_window_to_frame (d, w); - - if (!frame) - return 0; - - emacs_event->event_type = magic_event; - XSETFRAME (emacs_event->channel, frame); - - break; - } - } - return 1; -} - - - -/************************************************************************/ -/* magic-event handling */ -/************************************************************************/ - -static void -handle_focus_event_1 (struct frame *f, int in_p) -{ -#ifdef HAVE_XIM - XIM_focus_event (f, in_p); -#endif /* HAVE_XIM */ - - /* On focus change, clear all memory of sticky modifiers - to avoid non-intuitive behavior. */ - clear_sticky_modifiers (XDEVICE (FRAME_DEVICE (f))); - - /* We don't want to handle the focus change now, because we might - be in an accept-process-output, sleep-for, or sit-for. So - we enqueue it. - - Actually, we half handle it: we handle it as far as changing the - box cursor for redisplay, but we don't call any hooks or do any - select-frame stuff until after the sit-for. - */ - { - Lisp_Object frm; - Lisp_Object conser; - struct gcpro gcpro1; - - XSETFRAME (frm, f); - conser = Fcons (frm, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil)); - GCPRO1 (conser); - emacs_handle_focus_change_preliminary (conser); - enqueue_magic_eval_event (emacs_handle_focus_change_final, - conser); - UNGCPRO; - } -} - -/* This is called from the external-widget code */ - -void emacs_Xt_handle_focus_event (XEvent *event); -void -emacs_Xt_handle_focus_event (XEvent *event) -{ - struct device *d = get_device_from_display (event->xany.display); - struct frame *f; - - if (DEVICE_X_BEING_DELETED (d)) - return; - - /* - * It's curious that we're using x_any_window_to_frame() instead - * of x_window_to_frame(). I don't know what the impact of this is. - */ - f = x_any_window_to_frame (d, event->xfocus.window); - if (!f) - /* focus events are sometimes generated just before - a frame is destroyed. */ - return; - handle_focus_event_1 (f, event->type == FocusIn); -} - -/* both MapNotify and VisibilityNotify can cause this - JV is_visible has the same semantics as f->visible*/ -static void -change_frame_visibility (struct frame *f, int is_visible) -{ - Lisp_Object frame; - - XSETFRAME (frame, f); - - if (!FRAME_VISIBLE_P (f) && is_visible) - { - FRAME_VISIBLE_P (f) = is_visible; - /* This improves the double flicker when uniconifying a frame - some. A lot of it is not showing a buffer which has changed - while the frame was iconified. To fix it further requires - the good 'ol double redisplay structure. */ - MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); - va_run_hook_with_args (Qmap_frame_hook, 1, frame); - } - else if (FRAME_VISIBLE_P (f) && !is_visible) - { - FRAME_VISIBLE_P (f) = 0; - va_run_hook_with_args (Qunmap_frame_hook, 1, frame); - } - else if (FRAME_VISIBLE_P (f) * is_visible < 0) - { - FRAME_VISIBLE_P(f) = - FRAME_VISIBLE_P(f); - if (FRAME_REPAINT_P(f)) - MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); - va_run_hook_with_args (Qmap_frame_hook, 1, frame); - } -} - -static void -handle_map_event (struct frame *f, XEvent *event) -{ - Lisp_Object frame; - - XSETFRAME (frame, f); - if (event->type == MapNotify) - { - XWindowAttributes xwa; - - /* Bleagh!!!!!! Apparently some window managers (e.g. MWM) - send synthetic MapNotify events when a window is first - created, EVENT IF IT'S CREATED ICONIFIED OR INVISIBLE. - Or something like that. We initially tried a different - solution below, but that ran into a different window- - manager bug. - - It seems that the only reliable way is to treat a - MapNotify event as a "hint" that the window might or - might not be visible, and check explicitly. */ - - XGetWindowAttributes (event->xany.display, event->xmap.window, - &xwa); - if (xwa.map_state != IsViewable) - { - /* Calling Fframe_iconified_p is the only way we have to - correctly update FRAME_ICONIFIED_P */ - Fframe_iconified_p (frame); - return; - } - - FRAME_X_TOTALLY_VISIBLE_P (f) = 1; -#if 0 - /* Bleagh again!!!! We initially tried the following hack - around the MWM problem, but it turns out that TWM - has a race condition when you un-iconify, where it maps - the window and then tells the server that the window - is un-iconified. Usually, XEmacs wakes up between - those two occurrences, and thus thinks that un-iconified - windows are still iconified. - - Ah, the joys of X. */ - - /* By Emacs definition, a frame that is iconified is not - visible. Marking a frame as visible will automatically cause - frame-iconified-p to return nil, regardless of whether the - frame is actually iconified. Therefore, we have to ignore - MapNotify events on iconified frames. (It's not obvious - to me why these are being sent, but it happens at startup - with frames that are initially iconified; perhaps they are - synthetic MapNotify events coming from the window manager.) - Note that `frame-iconified-p' queries the server - to determine whether the frame is currently iconified, - rather than consulting some internal (and likely - inaccurate) state flag. Therefore, ignoring the MapNotify - is correct. */ - if (!FRAME_VISIBLE_P (f) && NILP (Fframe_iconified_p (frame))) -#endif /* 0 */ - change_frame_visibility (f, 1); - } - else - { - FRAME_X_TOTALLY_VISIBLE_P (f) = 0; - change_frame_visibility (f, 0); - /* Calling Fframe_iconified_p is the only way we have to - correctly update FRAME_ICONIFIED_P */ - Fframe_iconified_p (frame); - } -} - -static void -handle_client_message (struct frame *f, XEvent *event) -{ - struct device *d = XDEVICE (FRAME_DEVICE (f)); - Lisp_Object frame; - - XSETFRAME (frame, f); - - if (event->xclient.message_type == DEVICE_XATOM_WM_PROTOCOLS (d) && - (Atom) (event->xclient.data.l[0]) == DEVICE_XATOM_WM_DELETE_WINDOW (d)) - { - /* WM_DELETE_WINDOW is a misc-user event, but other ClientMessages, - such as WM_TAKE_FOCUS, are eval events. That's because delete-window - was probably executed with a mouse click, while the others could - have been sent as a result of mouse motion or some other implicit - action. (Call this a "heuristic"...) The reason for caring about - this is so that clicking on the close-box will make emacs prompt - using a dialog box instead of the minibuffer if there are unsaved - buffers. - */ - enqueue_misc_user_event (frame, Qeval, - list3 (Qdelete_frame, frame, Qt)); - } - else if (event->xclient.message_type == DEVICE_XATOM_WM_PROTOCOLS (d) && - (Atom) event->xclient.data.l[0] == DEVICE_XATOM_WM_TAKE_FOCUS (d)) - { - handle_focus_event_1 (f, 1); -#if 0 - /* If there is a dialog box up, focus on it. - - #### Actually, we're raising it too, which is wrong. We should - #### just focus on it, but lwlib doesn't currently give us an - #### easy way to do that. This should be fixed. - */ - unsigned long take_focus_timestamp = event->xclient.data.l[1]; - Widget widget = lw_raise_all_pop_up_widgets (); - if (widget) - { - /* kludge: raise_all returns bottommost widget, but we really - want the topmost. So just raise it for now. */ - XMapRaised (XtDisplay (widget), XtWindow (widget)); - /* Grab the focus with the timestamp of the TAKE_FOCUS. */ - XSetInputFocus (XtDisplay (widget), XtWindow (widget), - RevertToParent, take_focus_timestamp); - } -#endif - } -} - -static void -emacs_Xt_handle_magic_event (struct Lisp_Event *emacs_event) -{ - /* This function can GC */ - XEvent *event = &emacs_event->event.magic.underlying_x_event; - struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event)); - - if (!FRAME_LIVE_P (f) || DEVICE_X_BEING_DELETED (XDEVICE (FRAME_DEVICE (f)))) - return; - - switch (event->type) - { - case SelectionRequest: - x_handle_selection_request (&event->xselectionrequest); - break; - - case SelectionClear: - x_handle_selection_clear (&event->xselectionclear); - break; - - case SelectionNotify: - x_handle_selection_notify (&event->xselection); - break; - - case PropertyNotify: - x_handle_property_notify (&event->xproperty); - break; - - case Expose: - x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y, - event->xexpose.width, event->xexpose.height); - break; - - case GraphicsExpose: /* This occurs when an XCopyArea's source area was - obscured or not available. */ - x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y, - event->xexpose.width, event->xexpose.height); - break; - - case MapNotify: - case UnmapNotify: - handle_map_event (f, event); - break; - - case EnterNotify: - if (event->xcrossing.detail != NotifyInferior) - { - Lisp_Object frame; - - XSETFRAME (frame, f); - /* FRAME_X_MOUSE_P (f) = 1; */ - va_run_hook_with_args (Qmouse_enter_frame_hook, 1, frame); - } - break; - - case LeaveNotify: - if (event->xcrossing.detail != NotifyInferior) - { - Lisp_Object frame; - - XSETFRAME (frame, f); - /* FRAME_X_MOUSE_P (f) = 0; */ - va_run_hook_with_args (Qmouse_leave_frame_hook, 1, frame); - } - break; - - case FocusIn: - case FocusOut: -#ifdef EXTERNAL_WIDGET - /* External widget lossage: Ben said: - YUCK. The only way to make focus changes work properly is to - completely ignore all FocusIn/FocusOut events and depend only - on notifications from the ExternalClient widget. */ - if (FRAME_X_EXTERNAL_WINDOW_P (f)) - break; -#endif - handle_focus_event_1 (f, event->type == FocusIn); - break; - - case ClientMessage: - handle_client_message (f, event); - break; - - case VisibilityNotify: /* window visibility has changed */ - if (event->xvisibility.window == XtWindow (FRAME_X_SHELL_WIDGET (f))) - { - FRAME_X_TOTALLY_VISIBLE_P (f) = - (event->xvisibility.state == VisibilityUnobscured); - /* Note that the fvwm pager only sends VisibilityNotify when - changing pages. Is this all we need to do ? JV */ - /* Nope. We must at least trigger a redisplay here. - Since this case seems similar to MapNotify, I've - factored out some code to change_frame_visibility(). - This triggers the necessary redisplay and runs - (un)map-frame-hook. - dkindred@cs.cmu.edu */ - /* Changed it again to support the tristate visibility flag */ - change_frame_visibility (f, (event->xvisibility.state - != VisibilityFullyObscured) ? 1 : -1); - } - break; - - case ConfigureNotify: -#ifdef HAVE_XIM - XIM_SetGeometry (f); -#endif - break; - - default: - break; - } -} - - -/************************************************************************/ -/* timeout events */ -/************************************************************************/ - -static int timeout_id_tick; - -/* Xt interval id's might not fit into an int (they're pointers, as it - happens), so we need to provide a conversion list. */ - -struct Xt_timeout -{ - int id; - XtIntervalId interval_id; - struct Xt_timeout *next; -} *pending_timeouts, *completed_timeouts; - -struct Xt_timeout_blocktype -{ - Blocktype_declare (struct Xt_timeout); -} *the_Xt_timeout_blocktype; - -/* called by XtAppNextEvent() */ -static void -Xt_timeout_callback (XtPointer closure, XtIntervalId *id) -{ - struct Xt_timeout *timeout = (struct Xt_timeout *) closure; - struct Xt_timeout *t2 = pending_timeouts; - /* Remove this one from the list of pending timeouts */ - if (t2 == timeout) - pending_timeouts = pending_timeouts->next; - else - { - while (t2->next && t2->next != timeout) t2 = t2->next; - assert (t2->next); - t2->next = t2->next->next; - } - /* Add this one to the list of completed timeouts */ - timeout->next = completed_timeouts; - completed_timeouts = timeout; -} - -static int -emacs_Xt_add_timeout (EMACS_TIME thyme) -{ - struct Xt_timeout *timeout = Blocktype_alloc (the_Xt_timeout_blocktype); - EMACS_TIME current_time; - int milliseconds; - - timeout->id = timeout_id_tick++; - timeout->next = pending_timeouts; - pending_timeouts = timeout; - EMACS_GET_TIME (current_time); - EMACS_SUB_TIME (thyme, thyme, current_time); - milliseconds = EMACS_SECS (thyme) * 1000 + - EMACS_USECS (thyme) / 1000; - if (milliseconds < 1) - milliseconds = 1; - timeout->interval_id = XtAppAddTimeOut (Xt_app_con, milliseconds, - Xt_timeout_callback, - (XtPointer) timeout); - return timeout->id; -} - -static void -emacs_Xt_remove_timeout (int id) -{ - struct Xt_timeout *timeout, *t2; - - timeout = NULL; - - /* Find the timeout on the list of pending ones, if it's still there. */ - if (pending_timeouts) - { - if (id == pending_timeouts->id) - { - timeout = pending_timeouts; - pending_timeouts = pending_timeouts->next; - } - else - { - t2 = pending_timeouts; - while (t2->next && t2->next->id != id) t2 = t2->next; - if ( t2->next) /*found it */ - { - timeout = t2->next; - t2->next = t2->next->next; - } - } - /* if it was pending, we have removed it from the list */ - if (timeout) - XtRemoveTimeOut (timeout->interval_id); - } - - /* It could be that the Xt call back was already called but we didn't convert - into an Emacs event yet */ - if (!timeout && completed_timeouts) - { - /* Code duplication! */ - if (id == completed_timeouts->id) - { - timeout = completed_timeouts; - completed_timeouts = completed_timeouts->next; - } - else - { - t2 = completed_timeouts; - while (t2->next && t2->next->id != id) t2 = t2->next; - if ( t2->next) /*found it */ - { - timeout = t2->next; - t2->next = t2->next->next; - } - } - } - - /* If we found the thing on the lists of timeouts, - and removed it, deallocate - */ - if (timeout) - Blocktype_free (the_Xt_timeout_blocktype, timeout); -} - -static void -Xt_timeout_to_emacs_event (struct Lisp_Event *emacs_event) -{ - struct Xt_timeout *timeout = completed_timeouts; - assert (timeout); - completed_timeouts = completed_timeouts->next; - emacs_event->event_type = timeout_event; - /* timeout events have nil as channel */ - emacs_event->timestamp = 0; /* #### wrong!! */ - emacs_event->event.timeout.interval_id = timeout->id; - emacs_event->event.timeout.function = Qnil; - emacs_event->event.timeout.object = Qnil; - Blocktype_free (the_Xt_timeout_blocktype, timeout); -} - - -/************************************************************************/ -/* process and tty events */ -/************************************************************************/ - -struct what_is_ready_closure -{ - int fd; - Lisp_Object what; - XtInputId id; -}; - -static Lisp_Object *filedesc_with_input; -static struct what_is_ready_closure **filedesc_to_what_closure; - -static void -init_what_input_once (void) -{ - int i; - - filedesc_with_input = xnew_array (Lisp_Object, MAXDESC); - filedesc_to_what_closure = - xnew_array (struct what_is_ready_closure *, MAXDESC); - - for (i = 0; i < MAXDESC; i++) - { - filedesc_to_what_closure[i] = 0; - filedesc_with_input[i] = Qnil; - } - - process_events_occurred = 0; - tty_events_occurred = 0; -} - -static void -mark_what_as_being_ready (struct what_is_ready_closure *closure) -{ - if (NILP (filedesc_with_input[closure->fd])) - { - SELECT_TYPE temp_mask; - FD_ZERO (&temp_mask); - FD_SET (closure->fd, &temp_mask); - /* Check to make sure there's *really* input available. - Sometimes things seem to get confused and this gets called - for the tty fd when there's really only input available - on some process's fd. (It will subsequently get called - for that process's fd, so returning without setting any - flags will take care of it.) To see the problem, uncomment - the stderr_out below, turn NORMAL_QUIT_CHECK_TIMEOUT_MSECS - down to 25, do sh -c 'xemacs -nw -q -f shell 2>/tmp/log' - and press return repeatedly. (Seen under AIX & Linux.) - -dkindred@cs.cmu.edu */ - if (!poll_fds_for_input (temp_mask)) - { -#if 0 - stderr_out ("mark_what_as_being_ready: no input available (fd=%d)\n", - closure->fd); -#endif - return; - } - filedesc_with_input[closure->fd] = closure->what; - if (PROCESSP (closure->what)) - /* Don't increment this if the current process is already marked - * as having input. */ - process_events_occurred++; - else - tty_events_occurred++; - } -} - -static void -Xt_what_callback (void *closure, int *source, XtInputId *id) -{ - /* If closure is 0, then we got a fake event from a signal handler. - The only purpose of this is to make XtAppProcessEvent() stop - blocking. */ - if (closure) - mark_what_as_being_ready ((struct what_is_ready_closure *) closure); - else - { - fake_event_occurred++; - drain_signal_event_pipe (); - } -} - -static void -select_filedesc (int fd, Lisp_Object what) -{ - struct what_is_ready_closure *closure; - - /* If somebody is trying to select something that's already selected - for, then something went wrong. The generic routines ought to - detect this and error before here. */ - assert (!filedesc_to_what_closure[fd]); - - closure = xnew (struct what_is_ready_closure); - closure->fd = fd; - closure->what = what; - closure->id = - XtAppAddInput (Xt_app_con, fd, - (XtPointer) (XtInputReadMask /* | XtInputExceptMask */), - Xt_what_callback, closure); - filedesc_to_what_closure[fd] = closure; -} - -static void -unselect_filedesc (int fd) -{ - struct what_is_ready_closure *closure = filedesc_to_what_closure[fd]; - - assert (closure); - if (!NILP (filedesc_with_input[fd])) - { - /* We are unselecting this process before we have drained the rest of - the input from it, probably from status_notify() in the command loop. - This can happen like so: - - - We are waiting in XtAppNextEvent() - - Process generates output - - Process is marked as being ready - - Process dies, SIGCHLD gets generated before we return (!?) - It could happen I guess. - - sigchld_handler() marks process as dead - - Somehow we end up getting a new KeyPress event on the queue - at the same time (I'm really so sure how that happens but I'm - not sure it can't either so let's assume it can...). - - Key events have priority so we return that instead of the proc. - - Before dispatching the lisp key event we call status_notify() - - Which deselects the process that SIGCHLD marked as dead. - - Thus we never remove it from _with_input and turn it into a lisp - event, so we need to do it here. But this does not mean that we're - throwing away the last block of output - status_notify() has already - taken care of running the proc filter or whatever. - */ - filedesc_with_input[fd] = Qnil; - if (PROCESSP (closure->what)) - { - assert (process_events_occurred > 0); - process_events_occurred--; - } - else - { - assert (tty_events_occurred > 0); - tty_events_occurred--; - } - } - XtRemoveInput (closure->id); - xfree (closure); - filedesc_to_what_closure[fd] = 0; -} - -static void -emacs_Xt_select_process (struct Lisp_Process *p) -{ - Lisp_Object process; - int infd = event_stream_unixoid_select_process (p); - - XSETPROCESS (process, p); - select_filedesc (infd, process); -} - -static void -emacs_Xt_unselect_process (struct Lisp_Process *p) -{ - int infd = event_stream_unixoid_unselect_process (p); - - unselect_filedesc (infd); -} - -static USID -emacs_Xt_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, Lisp_Object* outstream, int flags) -{ - USID u = event_stream_unixoid_create_stream_pair - (inhandle, outhandle, instream, outstream, flags); - if (u != USID_ERROR) - u = USID_DONTHASH; - return u; -} - -static USID -emacs_Xt_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream) -{ - event_stream_unixoid_delete_stream_pair (instream, outstream); - return USID_DONTHASH; -} - -/* This is called from GC when a process object is about to be freed. - If we've still got pointers to it in this file, we're gonna lose hard. - */ -void -debug_process_finalization (struct Lisp_Process *p) -{ -#if 0 /* #### */ - int i; - Lisp_Object instr, outstr; - - get_process_streams (p, &instr, &outstr); - /* if it still has fds, then it hasn't been killed yet. */ - assert (NILP(instr)); - assert (NILP(outstr)); - /* Better not still be in the "with input" table; we know it's got no fds. */ - for (i = 0; i < MAXDESC; i++) - { - Lisp_Object process = filedesc_fds_with_input [i]; - assert (!PROCESSP (process) || XPROCESS (process) != p); - } -#endif -} - -static void -Xt_process_to_emacs_event (struct Lisp_Event *emacs_event) -{ - int i; - Lisp_Object process; - - assert (process_events_occurred > 0); - for (i = 0; i < MAXDESC; i++) - { - process = filedesc_with_input[i]; - if (PROCESSP (process)) - break; - } - assert (i < MAXDESC); - filedesc_with_input[i] = Qnil; - process_events_occurred--; - /* process events have nil as channel */ - emacs_event->event_type = process_event; - emacs_event->timestamp = 0; /* #### */ - emacs_event->event.process.process = process; -} - -static void -emacs_Xt_select_console (struct console *con) -{ - Lisp_Object console; - int infd; -#ifdef HAVE_GPM - int mousefd; -#endif - - if (CONSOLE_X_P (con)) - return; /* X consoles are automatically selected for when we - initialize them in Xt */ - infd = event_stream_unixoid_select_console (con); - XSETCONSOLE (console, con); - select_filedesc (infd, console); -#ifdef HAVE_GPM - /* On a stream device (ie: noninteractive), bad things can happen. */ - if (EQ (CONSOLE_TYPE (con), Qtty)) { - mousefd = CONSOLE_TTY_MOUSE_FD (con); - /* We check filedesc_to_what_closure[fd] here because if you run - ** XEmacs from a TTY, it will fire up GPM, select the mouse fd, then - ** if you run gnuattach to connect to another TTY, it will fire up - ** GPM again, and try to reselect the mouse fd. GPM uses the same - ** fd for every connection apparently, and select_filedesc will - ** fail its assertion if we try to select it twice. - */ - if ((mousefd >= 0) && !filedesc_to_what_closure[mousefd]) { - select_filedesc (mousefd, console); - } - } -#endif -} - -static void -emacs_Xt_unselect_console (struct console *con) -{ - Lisp_Object console; - int infd; -#ifdef HAVE_GPM - int mousefd; -#endif - - if (CONSOLE_X_P (con)) - return; /* X consoles are automatically selected for when we - initialize them in Xt */ - infd = event_stream_unixoid_unselect_console (con); - XSETCONSOLE (console, con); - unselect_filedesc (infd); -#ifdef HAVE_GPM - /* On a stream device (ie: noninteractive), bad things can happen. */ - if (EQ (CONSOLE_TYPE (con), Qtty)) { - mousefd = CONSOLE_TTY_MOUSE_FD (con); - if (mousefd >= 0) { - unselect_filedesc (mousefd); - } - } -#endif -} - -/* read an event from a tty, if one is available. Returns non-zero - if an event was available. Note that when this function is - called, there should always be a tty marked as ready for input. - However, the input condition might actually be EOF, so there - may not really be any input available. (In this case, - read_event_from_tty_or_stream_desc() will arrange for the TTY device - to be deleted.) */ - -static int -Xt_tty_to_emacs_event (struct Lisp_Event *emacs_event) -{ - int i; - - assert (tty_events_occurred > 0); - for (i = 0; i < MAXDESC; i++) - { - Lisp_Object console = filedesc_with_input[i]; - if (CONSOLEP (console)) - { - assert (tty_events_occurred > 0); - tty_events_occurred--; - filedesc_with_input[i] = Qnil; - if (read_event_from_tty_or_stream_desc - (emacs_event, XCONSOLE (console), i)) - return 1; - } - } - - return 0; -} - - -/************************************************************************/ -/* debugging functions to decipher an event */ -/************************************************************************/ - -#ifdef DEBUG_XEMACS -#include "xintrinsicp.h" /* only describe_event() needs this */ -#include /* only describe_event() needs this */ - -static void -describe_event_window (Window window, Display *display) -{ - struct frame *f; - Widget w; - stderr_out (" window: 0x%lx", (unsigned long) window); - w = XtWindowToWidget (display, window); - if (w) - stderr_out (" %s", w->core.widget_class->core_class.class_name); - f = x_any_window_to_frame (get_device_from_display (display), window); - if (f) - { - char *buf = alloca_array (char, XSTRING_LENGTH (f->name) + 4); - sprintf (buf, " \"%s\"", XSTRING_DATA (f->name)); - write_string_to_stdio_stream (stderr, 0, (Bufbyte *) buf, 0, - strlen (buf), FORMAT_TERMINAL); - } - stderr_out ("\n"); -} - -static CONST char * -XEvent_mode_to_string (int mode) -{ - switch (mode) - { - case NotifyNormal: return "Normal"; - case NotifyGrab: return "Grab"; - case NotifyUngrab: return "Ungrab"; - case NotifyWhileGrabbed: return "WhileGrabbed"; - default: return "???"; - } -} - -static CONST char * -XEvent_detail_to_string (int detail) -{ - switch (detail) - { - case NotifyAncestor: return "Ancestor"; - case NotifyInferior: return "Inferior"; - case NotifyNonlinear: return "Nonlinear"; - case NotifyNonlinearVirtual: return "NonlinearVirtual"; - case NotifyPointer: return "Pointer"; - case NotifyPointerRoot: return "PointerRoot"; - case NotifyDetailNone: return "DetailNone"; - default: return "???"; - } -} - -static CONST char * -XEvent_visibility_to_string (int state) -{ - switch (state) - { - case VisibilityFullyObscured: return "FullyObscured"; - case VisibilityPartiallyObscured: return "PartiallyObscured"; - case VisibilityUnobscured: return "Unobscured"; - default: return "???"; - } -} - -static void -describe_event (XEvent *event) -{ - char buf[100]; - struct device *d = get_device_from_display (event->xany.display); - - sprintf (buf, "%s%s", x_event_name (event->type), - event->xany.send_event ? " (send)" : ""); - stderr_out ("%-30s", buf); - switch (event->type) - { - case FocusIn: - case FocusOut: - { - XFocusChangeEvent *ev = &event->xfocus; - describe_event_window (ev->window, ev->display); - stderr_out (" mode: %s\n", XEvent_mode_to_string (ev->mode)); - stderr_out (" detail: %s\n", XEvent_detail_to_string(ev->detail)); - break; - } - - case KeyPress: - { - XKeyEvent *ev = &event->xkey; - unsigned int state = ev->state; - - describe_event_window (ev->window, ev->display); - stderr_out (" subwindow: %ld\n", ev->subwindow); - stderr_out (" state: "); - /* Complete list of modifier key masks */ - if (state & ShiftMask) stderr_out ("Shift "); - if (state & LockMask) stderr_out ("Lock "); - if (state & ControlMask) stderr_out ("Control "); - if (state & Mod1Mask) stderr_out ("Mod1 "); - if (state & Mod2Mask) stderr_out ("Mod2 "); - if (state & Mod3Mask) stderr_out ("Mod3 "); - if (state & Mod4Mask) stderr_out ("Mod4 "); - if (state & Mod5Mask) stderr_out ("Mod5 "); - - if (! state) - stderr_out ("vanilla\n"); - else - stderr_out ("\n"); - if (x_key_is_modifier_p (ev->keycode, d)) - stderr_out (" Modifier key"); - stderr_out (" keycode: 0x%x\n", ev->keycode); - } - break; - - case Expose: - if (x_debug_events > 1) - { - XExposeEvent *ev = &event->xexpose; - describe_event_window (ev->window, ev->display); - stderr_out (" region: x=%d y=%d width=%d height=%d\n", - ev->x, ev->y, ev->width, ev->height); - stderr_out (" count: %d\n", ev->count); - } - else - stderr_out ("\n"); - break; - - case GraphicsExpose: - if (x_debug_events > 1) - { - XGraphicsExposeEvent *ev = &event->xgraphicsexpose; - describe_event_window (ev->drawable, ev->display); - stderr_out (" major: %s\n", - (ev ->major_code == X_CopyArea ? "CopyArea" : - (ev->major_code == X_CopyPlane ? "CopyPlane" : "?"))); - stderr_out (" region: x=%d y=%d width=%d height=%d\n", - ev->x, ev->y, ev->width, ev->height); - stderr_out (" count: %d\n", ev->count); - } - else - stderr_out ("\n"); - break; - - case EnterNotify: - case LeaveNotify: - if (x_debug_events > 1) - { - XCrossingEvent *ev = &event->xcrossing; - describe_event_window (ev->window, ev->display); -#if 0 - stderr_out(" subwindow: 0x%x\n", ev->subwindow); - stderr_out(" pos: %d %d\n", ev->x, ev->y); - stderr_out(" root pos: %d %d\n", ev->x_root, ev->y_root); -#endif - stderr_out(" mode: %s\n", XEvent_mode_to_string(ev->mode)); - stderr_out(" detail: %s\n", XEvent_detail_to_string(ev->detail)); - stderr_out(" focus: %d\n", ev->focus); -#if 0 - stderr_out(" state: 0x%x\n", ev->state); -#endif - } - else - stderr_out("\n"); - break; - - case ConfigureNotify: - if (x_debug_events > 1) - { - XConfigureEvent *ev = &event->xconfigure; - describe_event_window (ev->window, ev->display); - stderr_out(" above: 0x%lx\n", ev->above); - stderr_out(" size: %d %d %d %d\n", ev->x, ev->y, - ev->width, ev->height); - stderr_out(" redirect: %d\n", ev->override_redirect); - } - else - stderr_out("\n"); - break; - - case VisibilityNotify: - if (x_debug_events > 1) - { - XVisibilityEvent *ev = &event->xvisibility; - describe_event_window (ev->window, ev->display); - stderr_out(" state: %s\n", XEvent_visibility_to_string(ev->state)); - } - else - stderr_out ("\n"); - break; - - case ClientMessage: - { - XClientMessageEvent *ev = &event->xclient; - char *name = XGetAtomName (ev->display, ev->message_type); - stderr_out ("%s", name); - if (!strcmp (name, "WM_PROTOCOLS")) { - char *protname = XGetAtomName (ev->display, ev->data.l[0]); - stderr_out ("(%s)", protname); - XFree (protname); - } - XFree (name); - stderr_out ("\n"); - break; - } - - default: - stderr_out ("\n"); - break; - } - - fflush (stdout); -} - -#endif /* include describe_event definition */ - - -/************************************************************************/ -/* get the next event from Xt */ -/************************************************************************/ - -static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail; - -static void -enqueue_Xt_dispatch_event (Lisp_Object event) -{ - enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail); -} - -static Lisp_Object -dequeue_Xt_dispatch_event (void) -{ - return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail); -} - -/* This business exists because menu events "happen" when - menubar_selection_callback() is called from somewhere deep - within XtAppProcessEvent in emacs_Xt_next_event(). The - callback needs to terminate the modal loop in that function - or else it will continue waiting until another event is - received. - - Same business applies to scrollbar events. */ - -void -signal_special_Xt_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = channel; - XEVENT (event)->event.eval.function = function; - XEVENT (event)->event.eval.object = object; - - enqueue_Xt_dispatch_event (event); -} - -static void -emacs_Xt_next_event (struct Lisp_Event *emacs_event) -{ - we_didnt_get_an_event: - - while (NILP (dispatch_event_queue) && - !completed_timeouts && - !fake_event_occurred && - !process_events_occurred && - !tty_events_occurred) - { - - /* Stupid logic in XtAppProcessEvent() dictates that, if process - events and X events are both available, the process event gets - taken first. This will cause an infinite loop if we're being - called from Fdiscard_input(). - */ - if (XtAppPending (Xt_app_con) & XtIMXEvent) - XtAppProcessEvent (Xt_app_con, XtIMXEvent); - else - { - Lisp_Object devcons, concons; - - /* We're about to block. Xt has a bug in it (big surprise, - there) in that it blocks using select() and doesn't - flush the Xlib output buffers (XNextEvent() does this - automatically before blocking). So it's necessary - for us to do this ourselves. If we don't do it, then - display output may not be seen until the next time - an X event is received. (This happens esp. with - subprocess output that gets sent to a visible buffer.) - - #### The above comment may not have any validity. */ - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - struct device *d; - d = XDEVICE (XCAR (devcons)); - - if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) - /* emacs may be exiting */ - XFlush (DEVICE_X_DISPLAY (d)); - } - XtAppProcessEvent (Xt_app_con, XtIMAll); - } - } - - if (!NILP (dispatch_event_queue)) - { - Lisp_Object event, event2; - XSETEVENT (event2, emacs_event); - event = dequeue_Xt_dispatch_event (); - Fcopy_event (event, event2); - Fdeallocate_event (event); - } - else if (tty_events_occurred) - { - if (!Xt_tty_to_emacs_event (emacs_event)) - goto we_didnt_get_an_event; - } - else if (completed_timeouts) - Xt_timeout_to_emacs_event (emacs_event); - else if (fake_event_occurred) - { - /* A dummy event, so that a cycle of the command loop will occur. */ - fake_event_occurred = 0; - /* eval events have nil as channel */ - emacs_event->event_type = eval_event; - emacs_event->event.eval.function = Qidentity; - emacs_event->event.eval.object = Qnil; - } - else /* if (process_events_occurred) */ - Xt_process_to_emacs_event (emacs_event); - - /* No need to call XFilterEvent; Xt does it for us */ -} - -void -emacs_Xt_event_handler (Widget wid /* unused */, - XtPointer closure /* unused */, - XEvent *event, - Boolean *continue_to_dispatch /* unused */) -{ - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - -#ifdef DEBUG_XEMACS - if (x_debug_events > 0) - { - describe_event (event); - } -#endif /* DEBUG_XEMACS */ - if (x_event_to_emacs_event (event, XEVENT (emacs_event))) - enqueue_Xt_dispatch_event (emacs_event); - else - Fdeallocate_event (emacs_event); -} - - -/************************************************************************/ -/* input pending / C-g checking */ -/************************************************************************/ - -static Bool -quit_char_predicate (Display *display, XEvent *event, XPointer data) -{ - struct device *d = get_device_from_display (display); - struct x_device *xd = DEVICE_X_DATA (d); - char c, quit_char; - Bool *critical = (Bool *) data; - Lisp_Object keysym; - - if (critical) - *critical = False; - if ((event->type != KeyPress) || - (! x_any_window_to_frame (d, event->xany.window)) || - (event->xkey.state - & (xd->MetaMask | xd->HyperMask | xd->SuperMask | xd->AltMask))) - return 0; - - /* This duplicates some code that exists elsewhere, but it's relatively - fast and doesn't cons. */ - keysym = x_to_emacs_keysym (&event->xkey, 1); - if (NILP (keysym)) return 0; - if (CHAR_OR_CHAR_INTP (keysym)) - c = XCHAR_OR_CHAR_INT (keysym); - /* Highly doubtful that these are the quit character, but... */ - else if (EQ (keysym, QKbackspace)) c = '\b'; - else if (EQ (keysym, QKtab)) c = '\t'; - else if (EQ (keysym, QKlinefeed)) c = '\n'; - else if (EQ (keysym, QKreturn)) c = '\r'; - else if (EQ (keysym, QKescape)) c = 27; - else if (EQ (keysym, QKspace)) c = ' '; - else if (EQ (keysym, QKdelete)) c = 127; - else return 0; - - if (event->xkey.state & xd->MetaMask) c |= 0x80; - if ((event->xkey.state & ControlMask) && !(c >= 'A' && c <= 'Z')) - c &= 0x1F; /* unshifted control characters */ - quit_char = CONSOLE_QUIT_CHAR (XCONSOLE (DEVICE_CONSOLE (d))); - if (c == quit_char) - return True; - /* If we've got Control-Shift-G instead of Control-G, that means - we have a critical_quit. Caps_Lock is its own modifier, so it - won't cause ^G to act differently than before. */ - if (event->xkey.state & ControlMask) c &= 0x1F; - if (c == quit_char) - { - if (critical) *critical = True; - return True; - } - return False; -} - -/* This scans the X input queue for a KeyPress event that matches the - quit character, and sets Vquit_flag. This is called from the - QUIT macro to determine whether we should quit. - - In a SIGIO world, this won't be called unless a SIGIO has happened - since the last time we checked. - - In a non-SIGIO world, this is called from emacs_Xt_event_pending_p - (which is called from input_pending_p). - */ -static void -x_check_for_quit_char (Display *display) -{ - XEvent event; - int queued; - Bool critical_quit = False; - XEventsQueued (display, QueuedAfterReading); - queued = XCheckIfEvent (display, &event, - quit_char_predicate, - (char *) &critical_quit); - if (queued) - { - Vquit_flag = (critical_quit ? Qcritical : Qt); - /* don't put the event back onto the queue. Those functions that - wanted to read a ^G directly have arranged to do this. */ - } -} - -static void -check_for_tty_quit_char (struct device *d) -{ - SELECT_TYPE temp_mask; - int infd = DEVICE_INFD (d); - struct console *con = XCONSOLE (DEVICE_CONSOLE (d)); - Emchar quit_char = CONSOLE_QUIT_CHAR (con); - - FD_ZERO (&temp_mask); - FD_SET (infd, &temp_mask); - - while (1) - { - Lisp_Object event; - Emchar the_char; - - if (!poll_fds_for_input (temp_mask)) - return; - - event = Fmake_event (Qnil, Qnil); - if (!read_event_from_tty_or_stream_desc (XEVENT (event), con, infd)) - /* EOF, or something ... */ - return; - /* #### bogus. quit-char should be allowed to be any sort - of event. */ - the_char = event_to_character (XEVENT (event), 1, 0, 0); - if (the_char >= 0 && the_char == quit_char) - { - Vquit_flag = Qt; - /* do not queue the C-g. See above. */ - return; - } - - /* queue the read event to be read for real later. */ - enqueue_Xt_dispatch_event (event); - } -} - -static void -emacs_Xt_quit_p (void) -{ - Lisp_Object devcons, concons; - CONSOLE_LOOP (concons) - { - struct console *con = XCONSOLE (XCAR (concons)); - if (!con->input_enabled) - continue; - - CONSOLE_DEVICE_LOOP (devcons, con) - { - struct device *d; - d = XDEVICE (XCAR (devcons)); - - if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) - /* emacs may be exiting */ - x_check_for_quit_char (DEVICE_X_DISPLAY (d)); - else if (DEVICE_TTY_P (d)) - check_for_tty_quit_char (d); - } - } -} - -static void -drain_X_queue (void) -{ - while (XtAppPending (Xt_app_con) & XtIMXEvent) - XtAppProcessEvent (Xt_app_con, XtIMXEvent); -} - -static int -emacs_Xt_event_pending_p (int user_p) -{ - Lisp_Object event; - int tick_count_val; - - /* If `user_p' is false, then this function returns whether there are any - X, timeout, or fd events pending (that is, whether emacs_Xt_next_event() - would return immediately without blocking). - - if `user_p' is true, then this function returns whether there are any - *user generated* events available (that is, whether there are keyboard - or mouse-click events ready to be read). This also implies that - emacs_Xt_next_event() would not block. - - In a non-SIGIO world, this also checks whether the user has typed ^G, - since this is a convenient place to do so. We don't need to do this - in a SIGIO world, since input causes an interrupt. - */ - -#if 0 - /* I don't think there's any point to this and it will nullify - the speed gains achieved by the sigio_happened checking below. - Its only advantage is that it may possibly make C-g response - a bit faster. The C-g will be noticed within 0.25 second, anyway, - even without this. */ -#ifndef SIGIO - /* First check for C-g if necessary */ - emacs_Xt_quit_p (); -#endif -#endif - - /* This function used to simply check whether there were any X - events (or if user_p was 1, it iterated over all the pending - X events using XCheckIfEvent(), looking for keystrokes and - button events). That worked in the old cheesoid event loop, - which didn't go through XtAppDispatchEvent(), but it doesn't - work any more -- X events may not result in anything. For - example, a button press in a blank part of the menubar appears - as an X event but will not result in any Emacs events (a - button press that activates the menubar results in an Emacs - event through the stop_next_event mechanism). - - The only accurate way of determining whether these X events - translate into Emacs events is to go ahead and dispatch them - until there's something on the dispatch queue. */ - - /* See if there are any user events already on the queue. */ - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - - /* See if there's any TTY input available. - */ - if (poll_fds_for_input (tty_only_mask)) - return 1; - - if (!user_p) - { - /* If not user_p and there are any timer or file-desc events - pending, we know there will be an event so we're through. */ - XtInputMask pending_value; - - /* Note that formerly we just checked the value of XtAppPending() - to determine if there was file-desc input. This doesn't - work any more with the signal_event_pipe; XtAppPending() - will says "yes" in this case but there isn't really any - input. Another way of fixing this problem is for the - signal_event_pipe to generate actual input in the form - of an identity eval event or something. (#### maybe this - actually happens?) */ - - if (poll_fds_for_input (process_only_mask)) - return 1; - - pending_value = XtAppPending (Xt_app_con); - - if (pending_value & XtIMTimer) - return 1; - } - - /* XtAppPending() can be super-slow, esp. over a network connection. - Quantify results have indicated that in some cases the - call to detect_input_pending() completely dominates the - running time of redisplay(). Fortunately, in a SIGIO world - we can more quickly determine whether there are any X events: - if an event has happened since the last time we checked, then - a SIGIO will have happened. On a machine with broken SIGIO, - we'll still be in an OK state -- the sigio_happened flag - will get set at least once a second, so we'll be no more than - one second behind reality. (In general it's OK if we - erroneously report no input pending when input is actually - pending() -- preemption is just a bit less efficient, that's - all. It's bad bad bad if you err the other way -- you've - promised that `next-event' won't block but it actually will, - and some action might get delayed until the next time you - hit a key.) - */ - - /* quit_check_signal_tick_count is volatile so try to avoid race conditions - by using a temporary variable */ - tick_count_val = quit_check_signal_tick_count; - if (last_quit_check_signal_tick_count != tick_count_val) - { - last_quit_check_signal_tick_count = tick_count_val; - - /* We need to drain the entire queue now -- if we only - drain part of it, we may later on end up with events - actually pending but detect_input_pending() returning - false because there wasn't another SIGIO. */ - drain_X_queue (); - - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - } - - return 0; -} - - -/************************************************************************/ -/* replacement for standard string-to-pixel converter */ -/************************************************************************/ - -/* This was constructed by ripping off the standard string-to-pixel - converter from Converters.c in the Xt source code and modifying - appropriately. */ - -#if 0 - -/* This is exported by the Xt library (at least by mine). If this - isn't the case somewhere, rename this appropriately and remove - the '#if 0'. Note, however, that I got "unknown structure" - errors when I tried this. */ -XtConvertArgRec Const colorConvertArgs[] = { - {XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.screen), - sizeof(Screen *)}, - {XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.colormap), - sizeof(Colormap)} -}; - -#endif - -#define done(type, value) \ - if (toVal->addr != NULL) { \ - if (toVal->size < sizeof(type)) { \ - toVal->size = sizeof(type); \ - return False; \ - } \ - *(type*)(toVal->addr) = (value); \ - } else { \ - static type static_val; \ - static_val = (value); \ - toVal->addr = (XPointer)&static_val; \ - } \ - toVal->size = sizeof(type); \ - return True /* Caller supplies `;' */ - -/* JH: We use this because I think there's a possibility this - is called before the device is properly set up, in which case - I don't want to abort. */ -extern struct device *get_device_from_display_1 (Display *dpy); - -static -Boolean EmacsXtCvtStringToPixel ( - Display *dpy, - XrmValuePtr args, - Cardinal *num_args, - XrmValuePtr fromVal, - XrmValuePtr toVal, - XtPointer *closure_ret) -{ - String str = (String)fromVal->addr; - XColor screenColor; - XColor exactColor; - Screen *screen; - Colormap colormap; - Visual *visual; - struct device *d; - Status status; - String params[1]; - Cardinal num_params = 1; - XtAppContext the_app_con = XtDisplayToApplicationContext (dpy); - - if (*num_args != 2) { - XtAppWarningMsg(the_app_con, "wrongParameters", "cvtStringToPixel", - "XtToolkitError", - "String to pixel conversion needs screen and colormap arguments", - (String *)NULL, (Cardinal *)NULL); - return False; - } - - screen = *((Screen **) args[0].addr); - colormap = *((Colormap *) args[1].addr); - - /* The original uses the private function CompareISOLatin1(). - Use XmuCompareISOLatin1() if you want, but I don't think it - makes any difference here. */ - if (strcmp(str, XtDefaultBackground) == 0) { - *closure_ret = False; - /* This refers to the display's "*reverseVideo" resource. - These display resources aren't documented anywhere that - I can find, so I'm going to ignore this. */ - /* if (pd->rv) done(Pixel, BlackPixelOfScreen(screen)) else */ - done(Pixel, WhitePixelOfScreen(screen)); - } - if (strcmp(str, XtDefaultForeground) == 0) { - *closure_ret = False; - /* if (pd->rv) done(Pixel, WhitePixelOfScreen(screen)) else */ - done(Pixel, BlackPixelOfScreen(screen)); - } - - /* Originally called XAllocNamedColor() here. */ - if ((d = get_device_from_display_1(dpy))) { - visual = DEVICE_X_VISUAL(d); - if (colormap != DEVICE_X_COLORMAP(d)) { - XtAppWarningMsg(the_app_con, "wierdColormap", "cvtStringToPixel", - "XtToolkitWarning", - "The colormap passed to cvtStringToPixel doesn't match the one registerd to the device.\n", - NULL, 0); - status = XAllocNamedColor(dpy, colormap, (char*)str, &screenColor, &exactColor); - } else { - status = XParseColor (dpy, colormap, (char*)str, &screenColor); - if (status) { - status = allocate_nearest_color (dpy, colormap, visual, &screenColor); - } - } - } else { - /* We haven't set up this device totally yet, so just punt */ - status = XAllocNamedColor(dpy, colormap, (char*)str, &screenColor, &exactColor); - } - if (status == 0) { - params[0] = str; - /* Server returns a specific error code but Xlib discards it. Ugh */ - if (XLookupColor(DisplayOfScreen(screen), colormap, (char*) str, - &exactColor, &screenColor)) { - XtAppWarningMsg(the_app_con, "noColormap", "cvtStringToPixel", - "XtToolkitError", - "Cannot allocate colormap entry for \"%s\"", - params, &num_params); - - } else { - XtAppWarningMsg(the_app_con, "badValue", "cvtStringToPixel", - "XtToolkitError", - "Color name \"%s\" is not defined", params, &num_params); - } - - *closure_ret = False; - return False; - } else { - *closure_ret = (char*)True; - done(Pixel, screenColor.pixel); - } -} - -/* ARGSUSED */ -static void EmacsFreePixel ( - XtAppContext app, - XrmValuePtr toVal, - XtPointer closure, - XrmValuePtr args, - Cardinal *num_args) -{ - if (*num_args != 2) { - XtAppWarningMsg(app, "wrongParameters","freePixel","XtToolkitError", - "Freeing a pixel requires screen and colormap arguments", - (String *)NULL, (Cardinal *)NULL); - return; - } - - if (closure) { - Screen *screen = *((Screen **) args[0].addr); - Colormap colormap = *((Colormap *) args[1].addr); - XFreeColors(DisplayOfScreen(screen), colormap, - (unsigned long*)toVal->addr, 1, (unsigned long)0); - } -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_event_Xt (void) -{ - defsymbol (&Qkey_mapping, "key-mapping"); - defsymbol (&Qsans_modifiers, "sans-modifiers"); -} - -void -vars_of_event_Xt (void) -{ - dispatch_event_queue = Qnil; - staticpro (&dispatch_event_queue); - dispatch_event_queue_tail = Qnil; - - /* this function only makes safe calls */ - init_what_input_once (); - - Xt_event_stream = xnew (struct event_stream); - Xt_event_stream->event_pending_p = emacs_Xt_event_pending_p; - Xt_event_stream->next_event_cb = emacs_Xt_next_event; - Xt_event_stream->handle_magic_event_cb = emacs_Xt_handle_magic_event; - Xt_event_stream->add_timeout_cb = emacs_Xt_add_timeout; - Xt_event_stream->remove_timeout_cb = emacs_Xt_remove_timeout; - Xt_event_stream->select_console_cb = emacs_Xt_select_console; - Xt_event_stream->unselect_console_cb = emacs_Xt_unselect_console; - Xt_event_stream->select_process_cb = emacs_Xt_select_process; - Xt_event_stream->unselect_process_cb = emacs_Xt_unselect_process; - Xt_event_stream->quit_p_cb = emacs_Xt_quit_p; - Xt_event_stream->create_stream_pair_cb = emacs_Xt_create_stream_pair; - Xt_event_stream->delete_stream_pair_cb = emacs_Xt_delete_stream_pair; - - DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /* -*Non-nil makes modifier keys sticky. -This means that you can release the modifier key before pressing down -the key that you wish to be modified. Although this is non-standard -behavior, it is recommended because it reduces the strain on your hand, -thus reducing the incidence of the dreaded Emacs-pinky syndrome. -*/ ); - modifier_keys_are_sticky = 0; - - DEFVAR_BOOL ("x-allow-sendevents", &x_allow_sendevents /* -*Non-nil means to allow synthetic events. Nil means they are ignored. -Beware: allowing emacs to process SendEvents opens a big security hole. -*/ ); - x_allow_sendevents = 0; - -#ifdef DEBUG_XEMACS - DEFVAR_INT ("x-debug-events", &x_debug_events /* -If non-zero, display debug information about X events that XEmacs sees. -Information is displayed on stderr. Currently defined values are: - -1 == non-verbose output -2 == verbose output -*/ ); - x_debug_events = 0; -#endif - - the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype); - - last_quit_check_signal_tick_count = 0; -} - -/* This mess is a hack that patches the shell widget to treat visual inheritance - the same as colormap and depth inheritance */ - -static XtInitProc orig_shell_init_proc; - -static void ShellVisualPatch(Widget wanted, Widget new, - ArgList args, Cardinal *num_args) -{ - Widget p; - ShellWidget w = (ShellWidget) new; - - /* first, call the original setup */ - (*orig_shell_init_proc)(wanted, new, args, num_args); - - /* if the visual isn't explicitly set, grab it from the nearest shell ancestor */ - if (w->shell.visual == CopyFromParent) { - p = XtParent(w); - while (p && !XtIsShell(p)) p = XtParent(p); - if (p) w->shell.visual = ((ShellWidget)p)->shell.visual; - } -} - -void -init_event_Xt_late (void) /* called when already initialized */ -{ - timeout_id_tick = 1; - pending_timeouts = 0; - completed_timeouts = 0; - - event_stream = Xt_event_stream; - -#if defined(HAVE_XIM) || defined(USE_XFONTSET) - Initialize_Locale(); -#endif /* HAVE_XIM || USE_XFONTSET */ - - XtToolkitInitialize (); - Xt_app_con = XtCreateApplicationContext (); - XtAppSetFallbackResources (Xt_app_con, (String *) x_fallback_resources); - - /* In xselect.c */ - x_selection_timeout = (XtAppGetSelectionTimeout (Xt_app_con) / 1000); - XSetErrorHandler (x_error_handler); - XSetIOErrorHandler (x_IO_error_handler); - -#ifndef WINDOWSNT - XtAppAddInput (Xt_app_con, signal_event_pipe[0], - (XtPointer) (XtInputReadMask /* | XtInputExceptMask */), - Xt_what_callback, 0); -#endif - - XtAppSetTypeConverter (Xt_app_con, XtRString, XtRPixel, - EmacsXtCvtStringToPixel, - (XtConvertArgList) colorConvertArgs, - 2, XtCacheByDisplay, EmacsFreePixel); - -#ifdef XIM_XLIB - XtAppSetTypeConverter (Xt_app_con, XtRString, XtRXimStyles, - EmacsXtCvtStringToXIMStyles, - NULL, 0, - XtCacheByDisplay, EmacsFreeXIMStyles); -#endif /* XIM_XLIB */ - - /* insert the visual inheritance patch/hack described above */ - orig_shell_init_proc = shellClassRec.core_class.initialize; - shellClassRec.core_class.initialize = ShellVisualPatch; - -} diff --git a/src/event-msw.c b/src/event-msw.c deleted file mode 100644 index 4042366..0000000 --- a/src/event-msw.c +++ /dev/null @@ -1,2971 +0,0 @@ -/* The mswindows event_stream interface. - Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996 Ben Wing. - Copyright (C) 1997 Jonathan Harris. - -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. */ - -/* Authorship: - - Ultimately based on FSF. - Rewritten by Ben Wing. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - Subprocess and modal loop support by Kirill M. Katsnelson. - */ - -#include -#include "lisp.h" - -#include "console-msw.h" - -#ifdef HAVE_SCROLLBARS -# include "scrollbar-msw.h" -#endif - -#ifdef HAVE_MENUBARS -# include "menubar-msw.h" -#endif - -#ifdef HAVE_DRAGNDROP -# include "dragdrop.h" -#endif - -#include "device.h" -#include "events.h" -#include "frame.h" -#include "buffer.h" -#include "faces.h" -#include "lstream.h" -#include "process.h" -#include "redisplay.h" -#include "sysproc.h" -#include "syswait.h" -#include "systime.h" -#include "sysdep.h" -#include "objects-msw.h" - -#include "events-mod.h" -#ifdef HAVE_MSG_SELECT -#include "sysfile.h" -#include "console-tty.h" -#elif defined(__CYGWIN32__) -typedef unsigned int SOCKET; -#endif -#include -#include - -#ifdef HAVE_MENUBARS -#define ADJR_MENUFLAG TRUE -#else -#define ADJR_MENUFLAG FALSE -#endif - -/* Fake key modifier which is attached to a quit char event. - Removed upon dequeueing an event */ -#define FAKE_MOD_QUIT 0x80 - -/* Timer ID used for button2 emulation */ -#define BUTTON_2_TIMER_ID 1 - -extern Lisp_Object -mswindows_get_toolbar_button_text (struct frame* f, int command_id); -extern Lisp_Object -mswindows_handle_toolbar_wm_command (struct frame* f, HWND ctrl, WORD id); -extern Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id); - -static Lisp_Object mswindows_find_frame (HWND hwnd); -static Lisp_Object mswindows_find_console (HWND hwnd); -static Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods); -static int mswindows_modifier_state (BYTE* keymap, int has_AltGr); -static void mswindows_set_chord_timer (HWND hwnd); -static int mswindows_button2_near_enough (POINTS p1, POINTS p2); -static int mswindows_current_layout_has_AltGr (void); - -static struct event_stream *mswindows_event_stream; - -#ifdef HAVE_MSG_SELECT -extern SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; -extern SELECT_TYPE process_only_mask, tty_only_mask; -SELECT_TYPE zero_mask; -extern int signal_event_pipe_initialized; -int windows_fd; -#endif - -/* - * Two separate queues, for efficiency, one (_u_) for user events, and - * another (_s_) for non-user ones. We always return events out of the - * first one until it is empty and only then proceed with the second - * one. - */ -static Lisp_Object mswindows_u_dispatch_event_queue, mswindows_u_dispatch_event_queue_tail; -static Lisp_Object mswindows_s_dispatch_event_queue, mswindows_s_dispatch_event_queue_tail; - -/* The number of things we can wait on */ -#define MAX_WAITABLE (MAXIMUM_WAIT_OBJECTS - 1) - -#ifndef HAVE_MSG_SELECT -/* List of mswindows waitable handles. */ -static HANDLE mswindows_waitable_handles[MAX_WAITABLE]; - -/* Number of wait handles */ -static int mswindows_waitable_count=0; -#endif /* HAVE_MSG_SELECT */ -/* Brush for painting widgets */ -static HBRUSH widget_brush = 0; -static LONG last_widget_brushed = 0; - -/* Count of quit chars currently in the queue */ -/* Incremented in WM_[SYS]KEYDOWN handler in the mswindows_wnd_proc() - Decremented in mswindows_dequeue_dispatch_event() */ -int mswindows_quit_chars_count = 0; - -/* These are Lisp integers; see DEFVARS in this file for description. */ -int mswindows_dynamic_frame_resize; -int mswindows_num_mouse_buttons; -int mswindows_mouse_button_max_skew_x; -int mswindows_mouse_button_max_skew_y; -int mswindows_mouse_button_tolerance; - -/* This is the event signaled by the event pump. - See mswindows_pump_outstanding_events for comments */ -static Lisp_Object mswindows_error_caught_in_modal_loop; -static int mswindows_in_modal_loop; - -/* Count of wound timers */ -static int mswindows_pending_timers_count; - -/************************************************************************/ -/* Pipe instream - reads process output */ -/************************************************************************/ - -#define PIPE_READ_DELAY 20 - -#define HANDLE_TO_USID(h) ((USID)(h)) - -#define NTPIPE_SLURP_STREAM_DATA(stream) \ - LSTREAM_TYPE_DATA (stream, ntpipe_slurp) - -/* This structure is allocated by the main thread, and is deallocated - in the thread upon exit. There are situations when a thread - remains blocked for a long time, much longer than the lstream - exists. For example, "start notepad" command is issued from the - shell, then the shell is closed by C-c C-d. Although the shell - process exits, its output pipe will not get closed until the - notepad process exits also, because it inherits the pipe form the - shell. In this case, we abandon the thread, and let it live until - all such processes exit. While struct ntpipe_slurp_stream is - deallocated in this case, ntpipe_slurp_stream_shared_data are not. */ - -struct ntpipe_slurp_stream_shared_data -{ - HANDLE hev_thread; /* Our thread blocks on this, signaled by caller */ - /* This is a manual-reset object. */ - HANDLE hev_caller; /* Caller blocks on this, and we signal it */ - /* This is a manual-reset object. */ - HANDLE hev_unsleep; /* Pipe read delay is canceled if this is set */ - /* This is a manual-reset object. */ - HANDLE hpipe; /* Pipe read end handle. */ - LONG die_p; /* Thread must exit ASAP if non-zero */ - BOOL eof_p : 1; /* Set when thread saw EOF */ - BOOL error_p : 1; /* Read error other than EOF/broken pipe */ - BOOL inuse_p : 1; /* this structure is in use */ - LONG lock_count; /* Client count of this struct, 0=safe to free */ - BYTE onebyte; /* One byte buffer read by thread */ -}; - -#define MAX_SLURP_STREAMS 32 -struct ntpipe_slurp_stream_shared_data -shared_data_block[MAX_SLURP_STREAMS]={{0}}; - -struct ntpipe_slurp_stream -{ - LPARAM user_data; /* Any user data stored in the stream object */ - struct ntpipe_slurp_stream_shared_data* thread_data; -}; - -DEFINE_LSTREAM_IMPLEMENTATION ("ntpipe-input", lstream_ntpipe_slurp, - sizeof (struct ntpipe_slurp_stream)); - -/* This function is thread-safe, and is called from either thread - context. It serializes freeing shared data structure */ -static void -slurper_free_shared_data_maybe (struct ntpipe_slurp_stream_shared_data* s) -{ - if (InterlockedDecrement (&s->lock_count) == 0) - { - /* Destroy events */ - CloseHandle (s->hev_thread); - CloseHandle (s->hev_caller); - CloseHandle (s->hev_unsleep); - s->inuse_p = 0; - } -} - -static struct ntpipe_slurp_stream_shared_data* -slurper_allocate_shared_data() -{ - int i=0; - for (i=0; ihpipe, &s->onebyte, 1, &actually_read, NULL)) - { - DWORD err = GetLastError (); - if (err == ERROR_BROKEN_PIPE || err == ERROR_NO_DATA) - s->eof_p = TRUE; - else - s->error_p = TRUE; - } - else if (actually_read == 0) - s->eof_p = TRUE; - - /* We must terminate on an error or eof */ - if (s->eof_p || s->error_p) - InterlockedIncrement (&s->die_p); - - /* Before we notify caller, we unsignal our event. */ - ResetEvent (s->hev_thread); - - /* Now we got something to notify caller, either a byte or an - error/eof indication. Before we do, allow internal pipe - buffer to accumulate little bit more data. - Reader function pulses this event before waiting for - a character, to avoid pipe delay, and to get the byte - immediately. */ - if (!s->die_p) - WaitForSingleObject (s->hev_unsleep, PIPE_READ_DELAY); - - /* Either make event loop generate a process event, or - inblock reader */ - SetEvent (s->hev_caller); - - /* Cleanup and exit if we're shot off */ - if (s->die_p) - break; - - /* Block until the client finishes with retrieving the rest of - pipe data */ - WaitForSingleObject (s->hev_thread, INFINITE); - } - - slurper_free_shared_data_maybe (s); - - return 0; -} - -static Lisp_Object -make_ntpipe_input_stream (HANDLE hpipe, LPARAM param) -{ - Lisp_Object obj; - Lstream *lstr = Lstream_new (lstream_ntpipe_slurp, "r"); - struct ntpipe_slurp_stream* s = NTPIPE_SLURP_STREAM_DATA (lstr); - DWORD thread_id_unused; - HANDLE hthread; - - /* We deal only with pipes, for we're using PeekNamedPipe api */ - assert (GetFileType (hpipe) == FILE_TYPE_PIPE); - - s->thread_data = slurper_allocate_shared_data(); - - /* Create reader thread. This could fail, so do not create events - until thread is created */ - hthread = CreateThread (NULL, 0, slurp_thread, (LPVOID)s->thread_data, - CREATE_SUSPENDED, &thread_id_unused); - if (hthread == NULL) - { - Lstream_delete (lstr); - s->thread_data->inuse_p=0; - return Qnil; - } - - /* Shared data are initially owned by both main and slurper - threads. */ - s->thread_data->lock_count = 2; - s->thread_data->die_p = 0; - s->thread_data->eof_p = FALSE; - s->thread_data->error_p = FALSE; - s->thread_data->hpipe = hpipe; - s->user_data = param; - - /* hev_thread is a manual-reset event, initially signaled */ - s->thread_data->hev_thread = CreateEvent (NULL, TRUE, TRUE, NULL); - /* hev_caller is a manual-reset event, initially nonsignaled */ - s->thread_data->hev_caller = CreateEvent (NULL, TRUE, FALSE, NULL); - /* hev_unsleep is a manual-reset event, initially nonsignaled */ - s->thread_data->hev_unsleep = CreateEvent (NULL, TRUE, FALSE, NULL); - - /* Now let it go */ - ResumeThread (hthread); - CloseHandle (hthread); - - lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; - XSETLSTREAM (obj, lstr); - return obj; -} - -static LPARAM -get_ntpipe_input_stream_param (Lstream *stream) -{ - struct ntpipe_slurp_stream* s = NTPIPE_SLURP_STREAM_DATA(stream); - return s->user_data; -} - -static HANDLE -get_ntpipe_input_stream_waitable (Lstream *stream) -{ - struct ntpipe_slurp_stream* s = NTPIPE_SLURP_STREAM_DATA(stream); - return s->thread_data->hev_caller; -} - -static int -ntpipe_slurp_reader (Lstream *stream, unsigned char *data, size_t size) -{ - /* This function must be called from the main thread only */ - struct ntpipe_slurp_stream_shared_data* s = - NTPIPE_SLURP_STREAM_DATA(stream)->thread_data; - - if (!s->die_p) - { - DWORD wait_result; - /* Disallow pipe read delay for the thread: we need a character - ASAP */ - SetEvent (s->hev_unsleep); - - /* Check if we have a character ready. Give it a short delay, - for the thread to awake from pipe delay, just ion case*/ - wait_result = WaitForSingleObject (s->hev_caller, 2); - - /* Revert to the normal sleep behavior. */ - ResetEvent (s->hev_unsleep); - - /* If there's no byte buffered yet, give up */ - if (wait_result == WAIT_TIMEOUT) - { - errno = EAGAIN; - return -1; - } - } - - /* Reset caller unlock event now, as we've handled the pending - process output event */ - ResetEvent (s->hev_caller); - - /* It is now safe to do anything with contents of S, except for - changing s->die_p, which still should be interlocked */ - - if (s->eof_p) - return 0; - if (s->error_p || s->die_p) - return -1; - - /* Ok, there were no error neither eof - we've got a byte from the - pipe */ - *(data++) = s->onebyte; - --size; - - { - DWORD bytes_read = 0; - if (size > 0) - { - DWORD bytes_available; - - /* If the api call fails, return at least one byte already - read. ReadFile in thread will return error */ - if (PeekNamedPipe (s->hpipe, NULL, 0, NULL, &bytes_available, NULL)) - { - - /* Fetch available bytes. The same consideration applies, - so do not check for errors. ReadFile in the thread will - fail if the next call fails. */ - if (bytes_available) - ReadFile (s->hpipe, data, min (bytes_available, size), - &bytes_read, NULL); - } - - /* Now we can unblock thread, so it attempts to read more */ - SetEvent (s->hev_thread); - return bytes_read + 1; - } - } - return 0; -} - -static int -ntpipe_slurp_closer (Lstream *stream) -{ - /* This function must be called from the main thread only */ - struct ntpipe_slurp_stream_shared_data* s = - NTPIPE_SLURP_STREAM_DATA(stream)->thread_data; - - /* Force thread to stop */ - InterlockedIncrement (&s->die_p); - - /* Set events which could possibly block slurper. Let it finish soon - or later. */ - SetEvent (s->hev_unsleep); - SetEvent (s->hev_thread); - - /* Unlock and maybe free shared data */ - slurper_free_shared_data_maybe (s); - - return 0; -} - -static void -init_slurp_stream (void) -{ - LSTREAM_HAS_METHOD (ntpipe_slurp, reader); - LSTREAM_HAS_METHOD (ntpipe_slurp, closer); -} - -/************************************************************************/ -/* Pipe outstream - writes process input */ -/************************************************************************/ - -#define NTPIPE_SHOVE_STREAM_DATA(stream) \ - LSTREAM_TYPE_DATA (stream, ntpipe_shove) - -#define MAX_SHOVE_BUFFER_SIZE 128 - -struct ntpipe_shove_stream -{ - LPARAM user_data; /* Any user data stored in the stream object */ - HANDLE hev_thread; /* Our thread blocks on this, signaled by caller */ - /* This is an auto-reset object. */ - HANDLE hpipe; /* Pipe write end handle. */ - HANDLE hthread; /* Reader thread handle. */ - char buffer[MAX_SHOVE_BUFFER_SIZE]; /* Buffer being written */ - DWORD size; /* Number of bytes to write */ - LONG die_p; /* Thread must exit ASAP if non-zero */ - LONG idle_p; /* Non-zero if thread is waiting for job */ - BOOL error_p : 1; /* Read error other than EOF/broken pipe */ - BOOL blocking_p : 1;/* Last write attempt would cause blocking */ -}; - -DEFINE_LSTREAM_IMPLEMENTATION ("ntpipe-output", lstream_ntpipe_shove, - sizeof (struct ntpipe_shove_stream)); - -#ifndef HAVE_MSG_SELECT -static DWORD WINAPI -shove_thread (LPVOID vparam) -{ - struct ntpipe_shove_stream *s = (struct ntpipe_shove_stream*) vparam; - - for (;;) - { - DWORD bytes_written; - - /* Block on event and wait for a job */ - InterlockedIncrement (&s->idle_p); - WaitForSingleObject (s->hev_thread, INFINITE); - - if (s->die_p) - break; - - /* Write passed buffer */ - if (!WriteFile (s->hpipe, s->buffer, s->size, &bytes_written, NULL) - || bytes_written != s->size) - { - s->error_p = TRUE; - InterlockedIncrement (&s->die_p); - } - - if (s->die_p) - break; - } - - return 0; -} - -static Lisp_Object -make_ntpipe_output_stream (HANDLE hpipe, LPARAM param) -{ - Lisp_Object obj; - Lstream *lstr = Lstream_new (lstream_ntpipe_shove, "w"); - struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA (lstr); - DWORD thread_id_unused; - - s->die_p = 0; - s->error_p = FALSE; - s->hpipe = hpipe; - s->user_data = param; - - /* Create reader thread. This could fail, so do not - create the event until thread is created */ - s->hthread = CreateThread (NULL, 0, shove_thread, (LPVOID)s, - CREATE_SUSPENDED, &thread_id_unused); - if (s->hthread == NULL) - { - Lstream_delete (lstr); - return Qnil; - } - - /* hev_thread is an auto-reset event, initially nonsignaled */ - s->hev_thread = CreateEvent (NULL, FALSE, FALSE, NULL); - - /* Now let it go */ - ResumeThread (s->hthread); - - lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; - XSETLSTREAM (obj, lstr); - return obj; -} - -static LPARAM -get_ntpipe_output_stream_param (Lstream *stream) -{ - struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); - return s->user_data; -} -#endif - -static int -ntpipe_shove_writer (Lstream *stream, const unsigned char *data, size_t size) -{ - struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); - - if (s->error_p) - return -1; - - s->blocking_p = !s->idle_p; - if (s->blocking_p) - return 0; - - if (size>MAX_SHOVE_BUFFER_SIZE) - return 0; - - memcpy (s->buffer, data, size); - s->size = size; - - /* Start output */ - InterlockedDecrement (&s->idle_p); - SetEvent (s->hev_thread); - return size; -} - -static int -ntpipe_shove_was_blocked_p (Lstream *stream) -{ - struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); - return s->blocking_p; -} - -static int -ntpipe_shove_closer (Lstream *stream) -{ - struct ntpipe_shove_stream* s = NTPIPE_SHOVE_STREAM_DATA(stream); - - /* Force thread stop */ - InterlockedIncrement (&s->die_p); - - /* Close pipe handle, possibly breaking it */ - CloseHandle (s->hpipe); - - /* Thread will end upon unblocking */ - SetEvent (s->hev_thread); - - /* Wait while thread terminates */ - WaitForSingleObject (s->hthread, INFINITE); - CloseHandle (s->hthread); - - /* Destroy the event */ - CloseHandle (s->hev_thread); - - return 0; -} - -static void -init_shove_stream (void) -{ - LSTREAM_HAS_METHOD (ntpipe_shove, writer); - LSTREAM_HAS_METHOD (ntpipe_shove, was_blocked_p); - LSTREAM_HAS_METHOD (ntpipe_shove, closer); -} - -/************************************************************************/ -/* Winsock I/O stream */ -/************************************************************************/ -#if defined (HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - -#define WINSOCK_READ_BUFFER_SIZE 1024 - -struct winsock_stream -{ - LPARAM user_data; /* Any user data stored in the stream object */ - SOCKET s; /* Socket handle (which is a Win32 handle) */ - OVERLAPPED ov; /* Overlapped I/O structure */ - void* buffer; /* Buffer. Allocated for input stream only */ - unsigned int bufsize; /* Number of bytes last read */ - unsigned int bufpos; /* Position in buffer for next fetch */ - unsigned int error_p :1; /* I/O Error seen */ - unsigned int eof_p :1; /* EOF Error seen */ - unsigned int pending_p :1; /* There is a pending I/O operation */ - unsigned int blocking_p :1; /* Last write attempt would block */ -}; - -#define WINSOCK_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, winsock) - -DEFINE_LSTREAM_IMPLEMENTATION ("winsock", lstream_winsock, - sizeof (struct winsock_stream)); - -static void -winsock_initiate_read (struct winsock_stream *str) -{ - ResetEvent (str->ov.hEvent); - str->bufpos = 0; - - if (!ReadFile ((HANDLE)str->s, str->buffer, WINSOCK_READ_BUFFER_SIZE, - &str->bufsize, &str->ov)) - { - if (GetLastError () == ERROR_IO_PENDING) - str->pending_p = 1; - else if (GetLastError () == ERROR_HANDLE_EOF) - str->eof_p = 1; - else - str->error_p = 1; - } - else if (str->bufsize == 0) - str->eof_p = 1; -} - -static int -winsock_reader (Lstream *stream, unsigned char *data, size_t size) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (stream); - - /* If the current operation is not yet complete, there's nothing to - give back */ - if (str->pending_p) - { - if (WaitForSingleObject (str->ov.hEvent, 0) == WAIT_TIMEOUT) - { - errno = EAGAIN; - return -1; - } - else - { - if (!GetOverlappedResult ((HANDLE)str->s, &str->ov, &str->bufsize, TRUE)) - { - if (GetLastError() == ERROR_HANDLE_EOF) - str->bufsize = 0; - else - str->error_p = 1; - } - if (str->bufsize == 0) - str->eof_p = 1; - str->pending_p = 0; - } - } - - if (str->eof_p) - return 0; - if (str->error_p) - return -1; - - /* Return as much of buffer as we have */ - size = min (size, (size_t) (str->bufsize - str->bufpos)); - memcpy (data, (void*)((BYTE*)str->buffer + str->bufpos), size); - str->bufpos += size; - - /* Read more if buffer is exhausted */ - if (str->bufsize == str->bufpos) - winsock_initiate_read (str); - - return size; -} - -static int -winsock_writer (Lstream *stream, CONST unsigned char *data, size_t size) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (stream); - - if (str->pending_p) - { - if (WaitForSingleObject (str->ov.hEvent, 0) == WAIT_TIMEOUT) - { - str->blocking_p = 1; - return -1; - } - else - { - DWORD dw_unused; - if (!GetOverlappedResult ((HANDLE)str->s, &str->ov, &dw_unused, TRUE)) - str->error_p = 1; - str->pending_p = 0; - } - } - - str->blocking_p = 0; - - if (str->error_p) - return -1; - - if (size == 0) - return 0; - - { - ResetEvent (str->ov.hEvent); - - /* Docs indicate that 4th parameter to WriteFile can be NULL since this is - * an overlapped operation. This fails on Win95 with winsock 1.x so we - * supply a spare address which is ignored by Win95 anyway. Sheesh. */ - if (WriteFile ((HANDLE)str->s, data, size, (LPDWORD)&str->buffer, &str->ov) - || GetLastError() == ERROR_IO_PENDING) - str->pending_p = 1; - else - str->error_p = 1; - } - - return str->error_p ? -1 : size; -} - -static int -winsock_closer (Lstream *lstr) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (lstr); - - if (lstr->flags & LSTREAM_FL_READ) - shutdown (str->s, 0); - else - shutdown (str->s, 1); - - CloseHandle ((HANDLE)str->s); - if (str->pending_p) - WaitForSingleObject (str->ov.hEvent, INFINITE); - - if (lstr->flags & LSTREAM_FL_READ) - xfree (str->buffer); - - CloseHandle (str->ov.hEvent); - return 0; -} - -static int -winsock_was_blocked_p (Lstream *stream) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (stream); - return str->blocking_p; -} - -static Lisp_Object -make_winsock_stream_1 (SOCKET s, LPARAM param, CONST char *mode) -{ - Lisp_Object obj; - Lstream *lstr = Lstream_new (lstream_winsock, mode); - struct winsock_stream *str = WINSOCK_STREAM_DATA (lstr); - - str->s = s; - str->blocking_p = 0; - str->error_p = 0; - str->eof_p = 0; - str->pending_p = 0; - str->user_data = param; - - xzero (str->ov); - str->ov.hEvent = CreateEvent (NULL, TRUE, FALSE, NULL); - - if (lstr->flags & LSTREAM_FL_READ) - { - str->buffer = xmalloc (WINSOCK_READ_BUFFER_SIZE); - winsock_initiate_read (str); - } - - lstr->flags |= LSTREAM_FL_CLOSE_AT_DISKSAVE; - XSETLSTREAM (obj, lstr); - return obj; -} - -static Lisp_Object -make_winsock_input_stream (SOCKET s, LPARAM param) -{ - return make_winsock_stream_1 (s, param, "r"); -} - -static Lisp_Object -make_winsock_output_stream (SOCKET s, LPARAM param) -{ - return make_winsock_stream_1 (s, param, "w"); -} - -static HANDLE -get_winsock_stream_waitable (Lstream *lstr) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (lstr); - return str->ov.hEvent; -} - -static LPARAM -get_winsock_stream_param (Lstream *lstr) -{ - struct winsock_stream *str = WINSOCK_STREAM_DATA (lstr); - return str->user_data; -} - -static void -init_winsock_stream (void) -{ - LSTREAM_HAS_METHOD (winsock, reader); - LSTREAM_HAS_METHOD (winsock, writer); - LSTREAM_HAS_METHOD (winsock, closer); - LSTREAM_HAS_METHOD (winsock, was_blocked_p); -} -#endif /* defined (HAVE_SOCKETS) */ - -/************************************************************************/ -/* Dispatch queue management */ -/************************************************************************/ - -static int -mswindows_user_event_p (struct Lisp_Event* sevt) -{ - return (sevt->event_type == key_press_event - || sevt->event_type == button_press_event - || sevt->event_type == button_release_event - || sevt->event_type == misc_user_event); -} - -/* - * Add an emacs event to the proper dispatch queue - */ -static void -mswindows_enqueue_dispatch_event (Lisp_Object event) -{ - int user_p = mswindows_user_event_p (XEVENT(event)); - enqueue_event (event, - user_p ? &mswindows_u_dispatch_event_queue : - &mswindows_s_dispatch_event_queue, - user_p ? &mswindows_u_dispatch_event_queue_tail : - &mswindows_s_dispatch_event_queue_tail); - - /* Avoid blocking on WaitMessage */ - PostMessage (NULL, XM_BUMPQUEUE, 0, 0); -} - -/* - * Add a misc-user event to the dispatch queue. - * - * Stuff it into our own dispatch queue, so we have something - * to return from next_event callback. - */ -void -mswindows_enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* e = XEVENT (event); - - e->event_type = misc_user_event; - e->channel = channel; - e->event.misc.function = function; - e->event.misc.object = object; - - mswindows_enqueue_dispatch_event (event); -} - -void -mswindows_enqueue_magic_event (HWND hwnd, UINT message) -{ - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); - - event->channel = hwnd ? mswindows_find_frame (hwnd) : Qnil; - event->timestamp = GetMessageTime(); - event->event_type = magic_event; - EVENT_MSWINDOWS_MAGIC_TYPE (event) = message; - - mswindows_enqueue_dispatch_event (emacs_event); -} - -static void -mswindows_enqueue_process_event (struct Lisp_Process* p) -{ - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); - Lisp_Object process; - XSETPROCESS (process, p); - - event->event_type = process_event; - event->timestamp = GetTickCount (); - event->event.process.process = process; - - mswindows_enqueue_dispatch_event (emacs_event); -} - -static void -mswindows_enqueue_mouse_button_event (HWND hwnd, UINT message, POINTS where, DWORD when) -{ - - /* We always use last message time, because mouse button - events may get delayed, and XEmacs double click - recognition will fail */ - - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT(emacs_event); - - event->channel = mswindows_find_frame(hwnd); - event->timestamp = when; - event->event.button.button = - (message==WM_LBUTTONDOWN || message==WM_LBUTTONUP) ? 1 : - ((message==WM_RBUTTONDOWN || message==WM_RBUTTONUP) ? 3 : 2); - event->event.button.x = where.x; - event->event.button.y = where.y; - event->event.button.modifiers = mswindows_modifier_state (NULL, 0); - - if (message==WM_LBUTTONDOWN || message==WM_MBUTTONDOWN || - message==WM_RBUTTONDOWN) - { - event->event_type = button_press_event; - SetCapture (hwnd); - /* we need this to make sure the main window regains the focus - from control subwindows */ - if (GetFocus() != hwnd) - { - SetFocus (hwnd); - mswindows_enqueue_magic_event (hwnd, WM_SETFOCUS); - } - } - else - { - event->event_type = button_release_event; - ReleaseCapture (); - } - - mswindows_enqueue_dispatch_event (emacs_event); -} - -static void -mswindows_enqueue_keypress_event (HWND hwnd, Lisp_Object keysym, int mods) -{ - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT(emacs_event); - - event->channel = mswindows_find_console(hwnd); - event->timestamp = GetMessageTime(); - event->event_type = key_press_event; - event->event.key.keysym = keysym; - event->event.key.modifiers = mods; - mswindows_enqueue_dispatch_event (emacs_event); -} - -/* - * Remove and return the first emacs event on the dispatch queue. - * Give a preference to user events over non-user ones. - */ -static Lisp_Object -mswindows_dequeue_dispatch_event () -{ - Lisp_Object event; - struct Lisp_Event* sevt; - - assert (!NILP(mswindows_u_dispatch_event_queue) || - !NILP(mswindows_s_dispatch_event_queue)); - - event = dequeue_event ( - NILP(mswindows_u_dispatch_event_queue) ? - &mswindows_s_dispatch_event_queue : - &mswindows_u_dispatch_event_queue, - NILP(mswindows_u_dispatch_event_queue) ? - &mswindows_s_dispatch_event_queue_tail : - &mswindows_u_dispatch_event_queue_tail); - - sevt = XEVENT(event); - if (sevt->event_type == key_press_event - && (sevt->event.key.modifiers & FAKE_MOD_QUIT)) - { - sevt->event.key.modifiers &= ~FAKE_MOD_QUIT; - --mswindows_quit_chars_count; - } - - return event; -} - -/* - * Remove and return the first emacs event on the dispatch queue that matches - * the supplied event. - * Timeout event matches if interval_id is equal to that of the given event. - * Keypress event matches if logical AND between modifiers bitmask of the - * event in the queue and that of the given event is non-zero. - * For all other event types, this function aborts. - */ - -Lisp_Object -mswindows_cancel_dispatch_event (struct Lisp_Event *match) -{ - Lisp_Object event; - Lisp_Object previous_event = Qnil; - int user_p = mswindows_user_event_p (match); - Lisp_Object* head = user_p ? &mswindows_u_dispatch_event_queue : - &mswindows_s_dispatch_event_queue; - Lisp_Object* tail = user_p ? &mswindows_u_dispatch_event_queue_tail : - &mswindows_s_dispatch_event_queue_tail; - - assert (match->event_type == timeout_event - || match->event_type == key_press_event); - - EVENT_CHAIN_LOOP (event, *head) - { - struct Lisp_Event *e = XEVENT (event); - if ((e->event_type == match->event_type) && - ((e->event_type == timeout_event) ? - (e->event.timeout.interval_id == match->event.timeout.interval_id) : - /* Must be key_press_event */ - ((e->event.key.modifiers & match->event.key.modifiers) != 0))) - { - if (NILP (previous_event)) - dequeue_event (head, tail); - else - { - XSET_EVENT_NEXT (previous_event, XEVENT_NEXT (event)); - if (EQ (*tail, event)) - *tail = previous_event; - } - - return event; - } - previous_event = event; - } - return Qnil; -} - -#ifndef HAVE_MSG_SELECT -/************************************************************************/ -/* Waitable handles manipulation */ -/************************************************************************/ -static int -find_waitable_handle (HANDLE h) -{ - int i; - for (i = 0; i < mswindows_waitable_count; ++i) - if (mswindows_waitable_handles[i] == h) - return i; - - return -1; -} - -static BOOL -add_waitable_handle (HANDLE h) -{ - assert (find_waitable_handle (h) < 0); - if (mswindows_waitable_count == MAX_WAITABLE) - return FALSE; - - mswindows_waitable_handles [mswindows_waitable_count++] = h; - return TRUE; -} - -static void -remove_waitable_handle (HANDLE h) -{ - int ix = find_waitable_handle (h); - if (ix < 0) - return; - - mswindows_waitable_handles [ix] = - mswindows_waitable_handles [--mswindows_waitable_count]; -} -#endif /* HAVE_MSG_SELECT */ - - -/************************************************************************/ -/* Event pump */ -/************************************************************************/ - -static Lisp_Object -mswindows_modal_loop_error_handler (Lisp_Object cons_sig_data, - Lisp_Object u_n_u_s_e_d) -{ - mswindows_error_caught_in_modal_loop = cons_sig_data; - return Qunbound; -} - -Lisp_Object -mswindows_protect_modal_loop (Lisp_Object (*bfun) (Lisp_Object barg), - Lisp_Object barg) -{ - Lisp_Object tmp; - - ++mswindows_in_modal_loop; - tmp = condition_case_1 (Qt, - bfun, barg, - mswindows_modal_loop_error_handler, Qnil); - --mswindows_in_modal_loop; - - return tmp; -} - -void -mswindows_unmodalize_signal_maybe (void) -{ - if (!NILP (mswindows_error_caught_in_modal_loop)) - { - /* Got an error while messages were pumped while - in window procedure - have to resignal */ - Lisp_Object sym = XCAR (mswindows_error_caught_in_modal_loop); - Lisp_Object data = XCDR (mswindows_error_caught_in_modal_loop); - mswindows_error_caught_in_modal_loop = Qnil; - Fsignal (sym, data); - } -} - -/* - * This is an unsafe part of event pump, guarded by - * condition_case. See mswindows_pump_outstanding_events - */ -static Lisp_Object -mswindows_unsafe_pump_events (Lisp_Object u_n_u_s_e_d) -{ - /* This function can call lisp */ - Lisp_Object event = Fmake_event (Qnil, Qnil); - struct gcpro gcpro1; - int do_redisplay = 0; - GCPRO1 (event); - - while (detect_input_pending ()) - { - Fnext_event (event, Qnil); - Fdispatch_event (event); - do_redisplay = 1; - } - - if (do_redisplay) - redisplay (); - - Fdeallocate_event (event); - UNGCPRO; - - /* Qt becomes return value of mswindows_pump_outstanding_events - once we get here */ - return Qt; -} - -/* - * This function pumps emacs events, while available, by using - * next_message/dispatch_message loop. Errors are trapped around - * the loop so the function always returns. - * - * Windows message queue is not looked into during the call, - * neither are waitable handles checked. The function pumps - * thus only dispatch events already queued, as well as those - * resulted in dispatching thereof. This is done by setting - * module local variable mswindows_in_modal_loop to nonzero. - * - * Return value is Qt if no errors was trapped, or Qunbound if - * there was an error. - * - * In case of error, a cons representing the error, in the - * form (SIGNAL . DATA), is stored in the module local variable - * mswindows_error_caught_in_modal_loop. This error is signaled - * again when DispatchMessage returns. Thus, Windows internal - * modal loops are protected against throws, which are proven - * to corrupt internal Windows structures. - * - * In case of success, mswindows_error_caught_in_modal_loop is - * assigned Qnil. - * - * If the value of mswindows_error_caught_in_modal_loop is not - * nil already upon entry, the function just returns non-nil. - * This situation means that a new event has been queued while - * in cancel mode. The event will be dequeued on the next regular - * call of next-event; the pump is off since error is caught. - * The caller must *unconditionally* cancel modal loop if the - * value returned by this function is nil. Otherwise, everything - * will become frozen until the modal loop exits under normal - * condition (scrollbar drag is released, menu closed etc.) - */ -Lisp_Object -mswindows_pump_outstanding_events (void) -{ - /* This function can call lisp */ - - Lisp_Object result = Qt; - struct gcpro gcpro1; - GCPRO1 (result); - - if (NILP(mswindows_error_caught_in_modal_loop)) - result = mswindows_protect_modal_loop (mswindows_unsafe_pump_events, Qnil); - UNGCPRO; - return result; -} - -static void -mswindows_drain_windows_queue () -{ - MSG msg; - while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) - { - /* we have to translate messages that are not sent to the main - window. this is so that key presses work ok in things like - edit fields. however, we *musn't* translate message for the - main window as this is handled in the wnd proc. */ - if ( GetWindowLong (msg.hwnd, GWL_STYLE) & WS_CHILD ) - { - TranslateMessage (&msg); - } - DispatchMessage (&msg); - mswindows_unmodalize_signal_maybe (); - } -} - -/* - * This is a special flavor of the mswindows_need_event function, - * used while in event pump. Actually, there is only kind of events - * allowed while in event pump: a timer. An attempt to fetch any - * other event leads to a deadlock, as there's no source of user input - * ('cause event pump mirrors windows modal loop, which is a sole - * owner of thread message queue). - * - * To detect this, we use a counter of active timers, and allow - * fetching WM_TIMER messages. Instead of trying to fetch a WM_TIMER - * which will never come when there are no pending timers, which leads - * to deadlock, we simply signal an error. - */ -static void -mswindows_need_event_in_modal_loop (int badly_p) -{ - MSG msg; - - /* Check if already have one */ - if (!NILP (mswindows_u_dispatch_event_queue) - || !NILP (mswindows_s_dispatch_event_queue)) - return; - - /* No event is ok */ - if (!badly_p) - return; - - /* We do not check the _u_ queue, because timers go to _s_ */ - while (NILP (mswindows_s_dispatch_event_queue)) - { - /* We'll deadlock if go waiting */ - if (mswindows_pending_timers_count == 0) - error ("Deadlock due to an attempt to call next-event in a wrong context"); - - /* Fetch and dispatch any pending timers */ - GetMessage (&msg, NULL, WM_TIMER, WM_TIMER); - DispatchMessage (&msg); - } -} - -/* - * This drains the event queue and fills up two internal queues until - * an event of a type specified by USER_P is retrieved. - * - * - * Used by emacs_mswindows_event_pending_p and emacs_mswindows_next_event - */ -static void -mswindows_need_event (int badly_p) -{ - int active; - - if (mswindows_in_modal_loop) - { - mswindows_need_event_in_modal_loop (badly_p); - return; - } - - /* Have to drain Windows message queue first, otherwise, we may miss - quit char when called from quit_p */ - mswindows_drain_windows_queue (); - - while (NILP (mswindows_u_dispatch_event_queue) - && NILP (mswindows_s_dispatch_event_queue)) - { -#ifdef HAVE_MSG_SELECT - int i; - SELECT_TYPE temp_mask = input_wait_mask; - EMACS_TIME sometime; - EMACS_SELECT_TIME select_time_to_block, *pointer_to_this; - - if (badly_p) - pointer_to_this = 0; - else - { - EMACS_SET_SECS_USECS (sometime, 0, 0); - EMACS_TIME_TO_SELECT_TIME (sometime, select_time_to_block); - pointer_to_this = &select_time_to_block; - } - - active = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this); - - if (active == 0) - { - return; /* timeout */ - } - else if (active > 0) - { - if (FD_ISSET (windows_fd, &temp_mask)) - { - mswindows_drain_windows_queue (); - } -#ifdef HAVE_TTY - /* Look for a TTY event */ - for (i = 0; i < MAXDESC-1; i++) - { - /* To avoid race conditions (among other things, an infinite - loop when called from Fdiscard_input()), we must return - user events ahead of process events. */ - if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask)) - { - struct console *c = tty_find_console_from_fd (i); - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event* event = XEVENT (emacs_event); - - assert (c); - if (read_event_from_tty_or_stream_desc (event, c, i)) - { - mswindows_enqueue_dispatch_event (emacs_event); - return; - } - } - } -#endif - /* Look for a process event */ - for (i = 0; i < MAXDESC-1; i++) - { - if (FD_ISSET (i, &temp_mask)) - { - if (FD_ISSET (i, &process_only_mask)) - { - struct Lisp_Process *p = - get_process_from_usid (FD_TO_USID(i)); - - mswindows_enqueue_process_event (p); - } - else - { - /* We might get here when a fake event came - through a signal. Return a dummy event, so - that a cycle of the command loop will - occur. */ - drain_signal_event_pipe (); - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); - } - } - } - } - else if (active==-1) - { - if (errno != EINTR) - { - /* something bad happened */ - assert(0); - } - } - else - { - assert(0); - } -#else - /* Now try getting a message or process event */ - active = MsgWaitForMultipleObjects (mswindows_waitable_count, - mswindows_waitable_handles, - FALSE, badly_p ? INFINITE : 0, - QS_ALLINPUT); - - /* This will assert if handle being waited for becomes abandoned. - Not the case currently tho */ - assert ((!badly_p && active == WAIT_TIMEOUT) || - (active >= WAIT_OBJECT_0 && - active <= WAIT_OBJECT_0 + mswindows_waitable_count)); - - if (active == WAIT_TIMEOUT) - { - /* No luck trying - just return what we've already got */ - return; - } - else if (active == WAIT_OBJECT_0 + mswindows_waitable_count) - { - /* Got your message, thanks */ - mswindows_drain_windows_queue (); - } - else - { - int ix = active - WAIT_OBJECT_0; - /* First, try to find which process' output has signaled */ - struct Lisp_Process *p = - get_process_from_usid (HANDLE_TO_USID (mswindows_waitable_handles[ix])); - if (p != NULL) - { - /* Found a signaled process input handle */ - mswindows_enqueue_process_event (p); - } - else - { - /* None. This means that the process handle itself has signaled. - Remove the handle from the wait vector, and make status_notify - note the exited process */ - mswindows_waitable_handles [ix] = - mswindows_waitable_handles [--mswindows_waitable_count]; - kick_status_notify (); - /* Have to return something: there may be no accompanying - process event */ - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); - } - } -#endif - } /* while */ -} - -/************************************************************************/ -/* Event generators */ -/************************************************************************/ - -/* - * Callback procedure for synchronous timer messages - */ -static void CALLBACK -mswindows_wm_timer_callback (HWND hwnd, UINT umsg, UINT id_timer, DWORD dwtime) -{ - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - struct Lisp_Event *event = XEVENT (emacs_event); - - if (KillTimer (NULL, id_timer)) - --mswindows_pending_timers_count; - - event->channel = Qnil; - event->timestamp = dwtime; - event->event_type = timeout_event; - event->event.timeout.interval_id = id_timer; - event->event.timeout.function = Qnil; - event->event.timeout.object = Qnil; - - mswindows_enqueue_dispatch_event (emacs_event); -} - -/* - * Callback procedure for dde messages - * - * We execute a dde Open("file") by simulating a file drop, so dde support - * depends on dnd support. - */ -#ifdef HAVE_DRAGNDROP -HDDEDATA CALLBACK -mswindows_dde_callback (UINT uType, UINT uFmt, HCONV hconv, - HSZ hszTopic, HSZ hszItem, HDDEDATA hdata, - DWORD dwData1, DWORD dwData2) -{ - switch (uType) - { - case XTYP_CONNECT: - if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)) - return (HDDEDATA)TRUE; - return (HDDEDATA)FALSE; - - case XTYP_WILDCONNECT: - { - /* We only support one {service,topic} pair */ - HSZPAIR pairs[2] = { - { mswindows_dde_service, mswindows_dde_topic_system }, { 0, 0 } }; - - if (!(hszItem || DdeCmpStringHandles (hszItem, mswindows_dde_service)) && - !(hszTopic || DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system))); - return (DdeCreateDataHandle (mswindows_dde_mlid, (LPBYTE)pairs, - sizeof (pairs), 0L, 0, uFmt, 0)); - } - return (HDDEDATA)NULL; - - case XTYP_EXECUTE: - if (!DdeCmpStringHandles (hszTopic, mswindows_dde_topic_system)) - { - DWORD len = DdeGetData (hdata, NULL, 0, 0); - char *cmd = alloca (len+1); - char *end; - char *filename; - struct gcpro gcpro1, gcpro2; - Lisp_Object l_dndlist = Qnil; - Lisp_Object emacs_event = Fmake_event (Qnil, Qnil); - Lisp_Object frmcons, devcons, concons; - struct Lisp_Event *event = XEVENT (emacs_event); - - DdeGetData (hdata, cmd, len, 0); - cmd[len] = '\0'; - DdeFreeDataHandle (hdata); - - /* Check syntax & that it's an [Open("foo")] command, which we - * treat like a file drop */ - /* #### Ought to be generalised and accept some other commands */ - if (*cmd == '[') - cmd++; - if (strnicmp (cmd, MSWINDOWS_DDE_ITEM_OPEN, - strlen (MSWINDOWS_DDE_ITEM_OPEN))) - return DDE_FNOTPROCESSED; - cmd += strlen (MSWINDOWS_DDE_ITEM_OPEN); - while (*cmd==' ') - cmd++; - if (*cmd!='(' || *(cmd+1)!='\"') - return DDE_FNOTPROCESSED; - end = (cmd+=2); - while (*end && *end!='\"') - end++; - if (!*end) - return DDE_FNOTPROCESSED; - *end = '\0'; - if (*(++end)!=')') - return DDE_FNOTPROCESSED; - if (*(++end)==']') - end++; - if (*end) - return DDE_FNOTPROCESSED; - -#ifdef __CYGWIN32__ - filename = alloca (cygwin32_win32_to_posix_path_list_buf_size (cmd) + 5); - strcpy (filename, "file:"); - cygwin32_win32_to_posix_path_list (cmd, filename+5); -#else - dostounix_filename (cmd); - filename = alloca (strlen (cmd)+6); - strcpy (filename, "file:"); - strcat (filename, cmd); -#endif - GCPRO2 (emacs_event, l_dndlist); - l_dndlist = make_string (filename, strlen (filename)); - - /* Find a mswindows frame */ - event->channel = Qnil; - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - Lisp_Object frame = XCAR (frmcons); - if (FRAME_TYPE_P (XFRAME (frame), mswindows)) - event->channel = frame; - }; - assert (!NILP (event->channel)); - - event->timestamp = GetTickCount(); - event->event_type = misc_user_event; - event->event.misc.button = 1; - event->event.misc.modifiers = 0; - event->event.misc.x = -1; - event->event.misc.y = -1; - event->event.misc.function = Qdragdrop_drop_dispatch; - event->event.misc.object = Fcons (Qdragdrop_URL, - Fcons (l_dndlist, Qnil)); - mswindows_enqueue_dispatch_event (emacs_event); - UNGCPRO; - return (HDDEDATA) DDE_FACK; - } - DdeFreeDataHandle (hdata); - return (HDDEDATA) DDE_FNOTPROCESSED; - - default: - return (HDDEDATA) NULL; - } -} -#endif - -/* - * The windows procedure for the window class XEMACS_CLASS - */ -LRESULT WINAPI -mswindows_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) -{ - /* Note: Remember to initialize emacs_event and event before use. - This code calls code that can GC. You must GCPRO before calling such code. */ - Lisp_Object emacs_event = Qnil; - Lisp_Object fobj = Qnil; - - struct Lisp_Event *event; - struct frame *frame; - struct mswindows_frame* msframe; - - switch (message) - { - case WM_ERASEBKGND: - /* Erase background only during non-dynamic sizing */ - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (msframe->sizing && !mswindows_dynamic_frame_resize) - goto defproc; - return 1; - - case WM_CLOSE: - fobj = mswindows_find_frame (hwnd); - mswindows_enqueue_misc_user_event (fobj, Qeval, list3 (Qdelete_frame, fobj, Qt)); - break; - - case WM_KEYUP: - case WM_SYSKEYUP: - /* See Win95 comment under WM_KEYDOWN */ - { - BYTE keymap[256]; - - if (wParam == VK_CONTROL) - { - GetKeyboardState (keymap); - keymap [(lParam & 0x1000000) ? VK_RCONTROL : VK_LCONTROL] &= ~0x80; - SetKeyboardState (keymap); - } - else if (wParam == VK_MENU) - { - GetKeyboardState (keymap); - keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] &= ~0x80; - SetKeyboardState (keymap); - } - }; - goto defproc; - - case WM_KEYDOWN: - case WM_SYSKEYDOWN: - /* In some locales the right-hand Alt key is labelled AltGr. This key - * should produce alternative charcaters when combined with another key. - * eg on a German keyboard pressing AltGr+q should produce '@'. - * AltGr generates exactly the same keystrokes as LCtrl+RAlt. But if - * TranslateMessage() is called with *any* combination of Ctrl+Alt down, - * it translates as if AltGr were down. - * We get round this by removing all modifiers from the keymap before - * calling TranslateMessage() unless AltGr is *really* down. */ - { - BYTE keymap[256]; - int has_AltGr = mswindows_current_layout_has_AltGr (); - int mods; - Lisp_Object keysym; - - GetKeyboardState (keymap); - mods = mswindows_modifier_state (keymap, has_AltGr); - - /* Handle those keys for which TranslateMessage won't generate a WM_CHAR */ - if (!NILP (keysym = mswindows_key_to_emacs_keysym(wParam, mods))) - mswindows_enqueue_keypress_event (hwnd, keysym, mods); - else - { - int quit_ch = CONSOLE_QUIT_CHAR (XCONSOLE (mswindows_find_console (hwnd))); - BYTE keymap_orig[256]; - POINT pnt = { LOWORD (GetMessagePos()), HIWORD (GetMessagePos()) }; - MSG msg; - - msg.hwnd = hwnd; - msg.message = message; - msg.wParam = wParam; - msg.lParam = lParam; - msg.time = GetMessageTime(); - msg.pt = pnt; - - /* GetKeyboardState() does not work as documented on Win95. We have - * to loosely track Left and Right modifiers on behalf of the OS, - * without screwing up Windows NT which tracks them properly. */ - if (wParam == VK_CONTROL) - keymap [(lParam & 0x1000000) ? VK_RCONTROL : VK_LCONTROL] |= 0x80; - else if (wParam == VK_MENU) - keymap [(lParam & 0x1000000) ? VK_RMENU : VK_LMENU] |= 0x80; - - memcpy (keymap_orig, keymap, 256); - - /* Remove shift modifier from an ascii character */ - mods &= ~MOD_SHIFT; - - /* Clear control and alt modifiers unless AltGr is pressed */ - keymap [VK_RCONTROL] = 0; - keymap [VK_LMENU] = 0; - if (!has_AltGr || !(keymap [VK_LCONTROL] & 0x80) || !(keymap [VK_RMENU] & 0x80)) - { - keymap [VK_LCONTROL] = 0; - keymap [VK_CONTROL] = 0; - keymap [VK_RMENU] = 0; - keymap [VK_MENU] = 0; - } - SetKeyboardState (keymap); - - /* Maybe generate some WM_[SYS]CHARs in the queue */ - TranslateMessage (&msg); - - while (PeekMessage (&msg, hwnd, WM_CHAR, WM_CHAR, PM_REMOVE) - || PeekMessage (&msg, hwnd, WM_SYSCHAR, WM_SYSCHAR, PM_REMOVE)) - { - int mods1 = mods; - WPARAM ch = msg.wParam; - - /* If a quit char with no modifiers other than control and - shift, then mark it with a fake modifier, which is removed - upon dequeueing the event */ - /* #### This might also not withstand localization, if - quit character is not a latin-1 symbol */ - if (((quit_ch < ' ' && (mods & MOD_CONTROL) && quit_ch + 'a' - 1 == ch) - || (quit_ch >= ' ' && !(mods & MOD_CONTROL) && quit_ch == ch)) - && ((mods & ~(MOD_CONTROL | MOD_SHIFT)) == 0)) - { - mods1 |= FAKE_MOD_QUIT; - ++mswindows_quit_chars_count; - } - - mswindows_enqueue_keypress_event (hwnd, make_char(ch), mods1); - } /* while */ - SetKeyboardState (keymap_orig); - } /* else */ - } - /* F10 causes menu activation by default. We do not want this */ - if (wParam != VK_F10) - goto defproc; - break; - - case WM_MBUTTONDOWN: - case WM_MBUTTONUP: - /* Real middle mouse button has nothing to do with emulated one: - if one wants to exercise fingers playing chords on the mouse, - he is allowed to do that! */ - mswindows_enqueue_mouse_button_event (hwnd, message, - MAKEPOINTS (lParam), GetMessageTime()); - break; - - case WM_LBUTTONUP: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->last_click_time = GetMessageTime(); - - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - if (msframe->ignore_next_lbutton_up) - { - msframe->ignore_next_lbutton_up = 0; - } - else if (msframe->button2_is_down) - { - msframe->button2_is_down = 0; - msframe->ignore_next_rbutton_up = 1; - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - else - { - if (msframe->button2_need_rbutton) - { - msframe->button2_need_rbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - break; - - case WM_RBUTTONUP: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->last_click_time = GetMessageTime(); - - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_rbutton = 0; - if (msframe->ignore_next_rbutton_up) - { - msframe->ignore_next_rbutton_up = 0; - } - else if (msframe->button2_is_down) - { - msframe->button2_is_down = 0; - msframe->ignore_next_lbutton_up = 1; - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - else - { - if (msframe->button2_need_lbutton) - { - msframe->button2_need_lbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONUP, - MAKEPOINTS (lParam), GetMessageTime()); - } - break; - - case WM_LBUTTONDOWN: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - - if (msframe->button2_need_lbutton) - { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - msframe->button2_need_rbutton = 0; - if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) - { - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - msframe->button2_is_down = 1; - } - else - { - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } - } - else - { - mswindows_set_chord_timer (hwnd); - msframe->button2_need_rbutton = 1; - msframe->last_click_point = MAKEPOINTS (lParam); - } - msframe->last_click_time = GetMessageTime(); - break; - - case WM_RBUTTONDOWN: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - - if (msframe->button2_need_rbutton) - { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - msframe->button2_need_lbutton = 0; - msframe->button2_need_rbutton = 0; - if (mswindows_button2_near_enough (msframe->last_click_point, MAKEPOINTS (lParam))) - { - mswindows_enqueue_mouse_button_event (hwnd, WM_MBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - msframe->button2_is_down = 1; - } - else - { - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - MAKEPOINTS (lParam), GetMessageTime()); - } - } - else - { - mswindows_set_chord_timer (hwnd); - msframe->button2_need_lbutton = 1; - msframe->last_click_point = MAKEPOINTS (lParam); - } - msframe->last_click_time = GetMessageTime(); - break; - - case WM_TIMER: - if (wParam == BUTTON_2_TIMER_ID) - { - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - KillTimer (hwnd, BUTTON_2_TIMER_ID); - - if (msframe->button2_need_lbutton) - { - msframe->button2_need_lbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_RBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - } - else if (msframe->button2_need_rbutton) - { - msframe->button2_need_rbutton = 0; - mswindows_enqueue_mouse_button_event (hwnd, WM_LBUTTONDOWN, - msframe->last_click_point, msframe->last_click_time); - } - } - else - assert ("Spurious timer fired" == 0); - break; - - case WM_MOUSEMOVE: - /* Optimization: don't report mouse movement while size is changing */ - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - if (!msframe->sizing) - { - /* When waiting for the second mouse button to finish - button2 emulation, and have moved too far, just pretend - as if timer has expired. This improves drag-select feedback */ - if ((msframe->button2_need_lbutton || msframe->button2_need_rbutton) - && !mswindows_button2_near_enough (msframe->last_click_point, - MAKEPOINTS (lParam))) - { - KillTimer (hwnd, BUTTON_2_TIMER_ID); - SendMessage (hwnd, WM_TIMER, BUTTON_2_TIMER_ID, 0); - } - - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - event->channel = mswindows_find_frame(hwnd); - event->timestamp = GetMessageTime(); - event->event_type = pointer_motion_event; - event->event.motion.x = MAKEPOINTS(lParam).x; - event->event.motion.y = MAKEPOINTS(lParam).y; - event->event.motion.modifiers = mswindows_modifier_state (NULL, 0); - - mswindows_enqueue_dispatch_event (emacs_event); - } - break; - - case WM_CANCELMODE: - ReleaseCapture (); - /* Queue a `cancel-mode-internal' misc user event, so mouse - selection would be canceled if any */ - mswindows_enqueue_misc_user_event (mswindows_find_frame (hwnd), - Qcancel_mode_internal, Qnil); - break; - -#ifdef HAVE_TOOLBARS - case WM_NOTIFY: - { - LPTOOLTIPTEXT tttext = (LPTOOLTIPTEXT)lParam; - Lisp_Object btext; - if (tttext->hdr.code == TTN_NEEDTEXT) - { - /* find out which toolbar */ - frame = XFRAME (mswindows_find_frame (hwnd)); - btext = mswindows_get_toolbar_button_text ( frame, - tttext->hdr.idFrom ); - - tttext->lpszText = NULL; - tttext->hinst = NULL; - - if (!NILP(btext)) - { - /* I think this is safe since the text will only go away - when the toolbar does...*/ - GET_C_STRING_EXT_DATA_ALLOCA (btext, FORMAT_OS, - tttext->lpszText); - } -#if 0 - tttext->uFlags |= TTF_DI_SETITEM; -#endif - } - } - break; -#endif - - case WM_PAINT: - { - PAINTSTRUCT paintStruct; - - frame = XFRAME (mswindows_find_frame (hwnd)); - - BeginPaint (hwnd, &paintStruct); - mswindows_redraw_exposed_area (frame, - paintStruct.rcPaint.left, paintStruct.rcPaint.top, - paintStruct.rcPaint.right, paintStruct.rcPaint.bottom); - EndPaint (hwnd, &paintStruct); - } - break; - - case WM_SIZE: - /* We only care about this message if our size has really changed */ - if (wParam==SIZE_RESTORED || wParam==SIZE_MAXIMIZED || wParam==SIZE_MINIMIZED) - { - RECT rect; - int columns, rows; - - fobj = mswindows_find_frame (hwnd); - frame = XFRAME (fobj); - msframe = FRAME_MSWINDOWS_DATA (frame); - - /* We cannot handle frame map and unmap hooks right in - this routine, because these may throw. We queue - magic events to run these hooks instead - kkm */ - - if (wParam==SIZE_MINIMIZED) - { - /* Iconified */ - FRAME_VISIBLE_P (frame) = 0; - mswindows_enqueue_magic_event (hwnd, XM_UNMAPFRAME); - } - else - { - GetClientRect(hwnd, &rect); - FRAME_PIXWIDTH(frame) = rect.right; - FRAME_PIXHEIGHT(frame) = rect.bottom; - - pixel_to_real_char_size (frame, rect.right, rect.bottom, - &FRAME_MSWINDOWS_CHARWIDTH (frame), - &FRAME_MSWINDOWS_CHARHEIGHT (frame)); - - pixel_to_char_size (frame, rect.right, rect.bottom, &columns, &rows); - change_frame_size (frame, rows, columns, 1); - - /* If we are inside frame creation, we have to apply geometric - properties now. */ - if (FRAME_MSWINDOWS_TARGET_RECT (frame)) - { - /* Yes, we have to size again */ - mswindows_size_frame_internal ( frame, - FRAME_MSWINDOWS_TARGET_RECT - (frame)); - /* Reset so we do not get here again. The SetWindowPos call in - * mswindows_size_frame_internal can cause recursion here. */ - if (FRAME_MSWINDOWS_TARGET_RECT (frame)) - { - xfree (FRAME_MSWINDOWS_TARGET_RECT (frame)); - FRAME_MSWINDOWS_TARGET_RECT (frame) = 0; - } - } - else - { - if (!msframe->sizing && !FRAME_VISIBLE_P (frame)) - mswindows_enqueue_magic_event (hwnd, XM_MAPFRAME); - FRAME_VISIBLE_P (frame) = 1; - - if (!msframe->sizing || mswindows_dynamic_frame_resize) - redisplay (); - } - } - } - break; - - /* Misc magic events which only require that the frame be identified */ - case WM_SETFOCUS: - case WM_KILLFOCUS: - mswindows_enqueue_magic_event (hwnd, message); - break; - - case WM_WINDOWPOSCHANGING: - { - WINDOWPOS *wp = (LPWINDOWPOS) lParam; - WINDOWPLACEMENT wpl = { sizeof(WINDOWPLACEMENT) }; - GetWindowPlacement(hwnd, &wpl); - - /* Only interested if size is changing and we're not being iconified */ - if (wpl.showCmd != SW_SHOWMINIMIZED - && wpl.showCmd != SW_SHOWMAXIMIZED - && !(wp->flags & SWP_NOSIZE)) - { - RECT ncsize = { 0, 0, 0, 0 }; - int pixwidth, pixheight; - AdjustWindowRectEx (&ncsize, GetWindowLong (hwnd, GWL_STYLE), - GetMenu(hwnd) != NULL, - GetWindowLong (hwnd, GWL_EXSTYLE)); - - round_size_to_real_char (XFRAME (mswindows_find_frame (hwnd)), - wp->cx - (ncsize.right - ncsize.left), - wp->cy - (ncsize.bottom - ncsize.top), - &pixwidth, &pixheight); - - /* Convert client sizes to window sizes */ - pixwidth += (ncsize.right - ncsize.left); - pixheight += (ncsize.bottom - ncsize.top); - - if (wpl.showCmd != SW_SHOWMAXIMIZED) - { - /* Adjust so that the bottom or right doesn't move if it's - * the top or left that's being changed */ - RECT rect; - GetWindowRect (hwnd, &rect); - - if (rect.left != wp->x) - wp->x += wp->cx - pixwidth; - if (rect.top != wp->y) - wp->y += wp->cy - pixheight; - } - - wp->cx = pixwidth; - wp->cy = pixheight; - } - /* DefWindowProc sends useful WM_GETMINMAXINFO message, and adjusts - window position if the user tries to track window too small */ - } - goto defproc; - - case WM_ENTERSIZEMOVE: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->sizing = 1; - return 0; - - case WM_EXITSIZEMOVE: - msframe = FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (hwnd))); - msframe->sizing = 0; - /* Queue noop event */ - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); - return 0; - -#ifdef HAVE_SCROLLBARS - case WM_VSCROLL: - case WM_HSCROLL: - { - /* Direction of scroll is determined by scrollbar instance. */ - int code = (int) LOWORD(wParam); - int pos = (short int) HIWORD(wParam); - HWND hwndScrollBar = (HWND) lParam; - struct gcpro gcpro1, gcpro2; - - mswindows_handle_scrollbar_event (hwndScrollBar, code, pos); - GCPRO2 (emacs_event, fobj); - if (UNBOUNDP(mswindows_pump_outstanding_events())) /* Can GC */ - { - /* Error during event pumping - cancel scroll */ - SendMessage (hwndScrollBar, WM_CANCELMODE, 0, 0); - } - UNGCPRO; - break; - } -#endif - -#ifdef HAVE_MENUBARS - case WM_INITMENU: - if (UNBOUNDP (mswindows_handle_wm_initmenu ( - (HMENU) wParam, - XFRAME (mswindows_find_frame (hwnd))))) - SendMessage (hwnd, WM_CANCELMODE, 0, 0); - break; - - case WM_INITMENUPOPUP: - if (!HIWORD(lParam)) - { - if (UNBOUNDP (mswindows_handle_wm_initmenupopup ( - (HMENU) wParam, - XFRAME (mswindows_find_frame (hwnd))))) - SendMessage (hwnd, WM_CANCELMODE, 0, 0); - } - break; - -#endif /* HAVE_MENUBARS */ - - case WM_COMMAND: - { - WORD id = LOWORD (wParam); - WORD nid = HIWORD (wParam); - HWND cid = (HWND)lParam; - frame = XFRAME (mswindows_find_frame (hwnd)); - -#ifdef HAVE_TOOLBARS - if (!NILP (mswindows_handle_toolbar_wm_command (frame, cid, id))) - break; -#endif - /* widgets in a buffer only eval a callback for suitable events.*/ - switch (nid) - { - case BN_CLICKED: - case EN_CHANGE: - case CBN_EDITCHANGE: - case CBN_SELCHANGE: - if (!NILP (mswindows_handle_gui_wm_command (frame, cid, id))) - return 0; - } - /* menubars always must come last since the hashtables do not - always exist*/ -#ifdef HAVE_MENUBARS - if (!NILP (mswindows_handle_wm_command (frame, id))) - break; -#endif - - return DefWindowProc (hwnd, message, wParam, lParam); - /* Bite me - a spurious command. This used to not be able to - happen but with the introduction of widgets its now - possible. */ - } - break; - - case WM_CTLCOLORBTN: - case WM_CTLCOLORLISTBOX: - case WM_CTLCOLOREDIT: - case WM_CTLCOLORSTATIC: - case WM_CTLCOLORSCROLLBAR: - { - /* if we get an opportunity to paint a widget then do so if - there is an appropriate face */ - HWND crtlwnd = (HWND)lParam; - LONG ii = GetWindowLong (crtlwnd, GWL_USERDATA); - if (ii) - { - Lisp_Object image_instance; - VOID_TO_LISP (image_instance, ii); - if (IMAGE_INSTANCEP (image_instance) - && - IMAGE_INSTANCE_TYPE_P (image_instance, IMAGE_WIDGET) - && - !NILP (XIMAGE_INSTANCE_WIDGET_FACE (image_instance))) - { - /* set colors for the buttons */ - HDC hdc = (HDC)wParam; - if (last_widget_brushed != ii) - { - if (widget_brush) - DeleteObject (widget_brush); - widget_brush = CreateSolidBrush - (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - } - last_widget_brushed = ii; - SetTextColor - (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_FOREGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - SetBkMode (hdc, OPAQUE); - SetBkColor - (hdc, - COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (image_instance))))); - return (LRESULT)widget_brush; - } - } - } - goto defproc; - -#ifdef HAVE_DRAGNDROP - case WM_DROPFILES: /* implementation ripped-off from event-Xt.c */ - { - UINT filecount, i, len; - POINT point; - char* filename; -#ifdef __CYGWIN32__ - char* fname; -#endif - Lisp_Object l_dndlist = Qnil, l_item = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; - - emacs_event = Fmake_event (Qnil, Qnil); - event = XEVENT(emacs_event); - - GCPRO3 (emacs_event, l_dndlist, l_item); - - if (!DragQueryPoint ((HANDLE) wParam, &point)) - point.x = point.y = -1; /* outside client area */ - - event->event_type = misc_user_event; - event->channel = mswindows_find_frame(hwnd); - event->timestamp = GetMessageTime(); - event->event.misc.button = 1; /* #### Should try harder */ - event->event.misc.modifiers = mswindows_modifier_state (NULL, 0); - event->event.misc.x = point.x; - event->event.misc.y = point.y; - event->event.misc.function = Qdragdrop_drop_dispatch; - - filecount = DragQueryFile ((HANDLE) wParam, 0xffffffff, NULL, 0); - for (i=0; i/ part and - * because they may contain reserved characters. But that's OK. */ -#ifdef __CYGWIN32__ - fname = (char *)xmalloc (len+1); - DragQueryFile ((HANDLE) wParam, i, fname, len+1); - filename = xmalloc (cygwin32_win32_to_posix_path_list_buf_size (fname) + 5); - strcpy (filename, "file:"); - cygwin32_win32_to_posix_path_list (fname, filename+5); - xfree (fname); -#else - filename = (char *)xmalloc (len+6); - strcpy (filename, "file:"); - DragQueryFile ((HANDLE) wParam, i, filename+5, len+1); - dostounix_filename (filename+5); -#endif - l_item = make_string (filename, strlen (filename)); - l_dndlist = Fcons (l_item, l_dndlist); - xfree (filename); - } - DragFinish ((HANDLE) wParam); - - event->event.misc.object = Fcons (Qdragdrop_URL, l_dndlist); - mswindows_enqueue_dispatch_event (emacs_event); - UNGCPRO; - } - break; -#endif - - defproc: - default: - return DefWindowProc (hwnd, message, wParam, lParam); - } - return (0); -} - - -/************************************************************************/ -/* keyboard, mouse & other helpers for the windows procedure */ -/************************************************************************/ -static void -mswindows_set_chord_timer (HWND hwnd) -{ - int interval; - - /* We get one third half system double click threshold */ - if (mswindows_mouse_button_tolerance <= 0) - interval = GetDoubleClickTime () / 3; - else - interval = mswindows_mouse_button_tolerance; - - SetTimer (hwnd, BUTTON_2_TIMER_ID, interval, 0); -} - -static int -mswindows_button2_near_enough (POINTS p1, POINTS p2) -{ - int dx, dy; - if (mswindows_mouse_button_max_skew_x <= 0) - dx = GetSystemMetrics (SM_CXDOUBLECLK) / 2; - else - dx = mswindows_mouse_button_max_skew_x; - - if (mswindows_mouse_button_max_skew_y <= 0) - dy = GetSystemMetrics (SM_CYDOUBLECLK) / 2; - else - dy = mswindows_mouse_button_max_skew_y; - - return abs (p1.x - p2.x) < dx && abs (p1.y- p2.y)< dy; -} - -static int -mswindows_current_layout_has_AltGr (void) -{ - /* This simple caching mechanism saves 10% of CPU - time when a key typed at autorepeat rate of 30 cps! */ - static HKL last_hkl = 0; - static int last_hkl_has_AltGr; - - HKL current_hkl = GetKeyboardLayout (0); - if (current_hkl != last_hkl) - { - TCHAR c; - last_hkl_has_AltGr = 0; - /* In this loop, we query whether a character requires - AltGr to be down to generate it. If at least such one - found, this means that the layout does regard AltGr */ - for (c = ' '; c <= 0xFFU && c != 0 && !last_hkl_has_AltGr; ++c) - if (HIBYTE (VkKeyScan (c)) == 6) - last_hkl_has_AltGr = 1; - last_hkl = current_hkl; - } - return last_hkl_has_AltGr; -} - - -/* Returns the state of the modifier keys in the format expected by the - * Lisp_Event key_data, button_data and motion_data modifiers member */ -int mswindows_modifier_state (BYTE* keymap, int has_AltGr) -{ - int mods = 0; - - if (keymap == NULL) - { - keymap = (BYTE*) alloca(256); - GetKeyboardState (keymap); - has_AltGr = mswindows_current_layout_has_AltGr (); - } - - if (has_AltGr && (keymap [VK_LCONTROL] & 0x80) && (keymap [VK_RMENU] & 0x80)) - { - mods |= (keymap [VK_LMENU] & 0x80) ? MOD_META : 0; - mods |= (keymap [VK_RCONTROL] & 0x80) ? MOD_CONTROL : 0; - } - else - { - mods |= (keymap [VK_MENU] & 0x80) ? MOD_META : 0; - mods |= (keymap [VK_CONTROL] & 0x80) ? MOD_CONTROL : 0; - } - - mods |= (keymap [VK_SHIFT] & 0x80) ? MOD_SHIFT : 0; - - return mods; -} - -/* - * Translate a mswindows virtual key to a keysym. - * Only returns non-Qnil for keys that don't generate WM_CHAR messages - * or whose ASCII codes (like space) xemacs doesn't like. - * Virtual key values are defined in winresrc.h - * XXX I'm not sure that KEYSYM("name") is the best thing to use here. - */ -Lisp_Object mswindows_key_to_emacs_keysym(int mswindows_key, int mods) -{ - switch (mswindows_key) - { - /* First the predefined ones */ - case VK_BACK: return QKbackspace; - case VK_TAB: return QKtab; - case '\n': return QKlinefeed; /* No VK_LINEFEED in winresrc.h */ - case VK_RETURN: return QKreturn; - case VK_ESCAPE: return QKescape; - case VK_SPACE: return QKspace; - case VK_DELETE: return QKdelete; - - /* The rest */ - case VK_CLEAR: return KEYSYM ("clear"); /* Should do ^L ? */ - case VK_PRIOR: return KEYSYM ("prior"); - case VK_NEXT: return KEYSYM ("next"); - case VK_END: return KEYSYM ("end"); - case VK_HOME: return KEYSYM ("home"); - case VK_LEFT: return KEYSYM ("left"); - case VK_UP: return KEYSYM ("up"); - case VK_RIGHT: return KEYSYM ("right"); - case VK_DOWN: return KEYSYM ("down"); - case VK_SELECT: return KEYSYM ("select"); - case VK_PRINT: return KEYSYM ("print"); - case VK_EXECUTE: return KEYSYM ("execute"); - case VK_SNAPSHOT: return KEYSYM ("print"); - case VK_INSERT: return KEYSYM ("insert"); - case VK_HELP: return KEYSYM ("help"); -#if 0 /* XXX What are these supposed to do? */ - case VK_LWIN return KEYSYM (""); - case VK_RWIN return KEYSYM (""); -#endif - case VK_APPS: return KEYSYM ("menu"); - case VK_F1: return KEYSYM ("f1"); - case VK_F2: return KEYSYM ("f2"); - case VK_F3: return KEYSYM ("f3"); - case VK_F4: return KEYSYM ("f4"); - case VK_F5: return KEYSYM ("f5"); - case VK_F6: return KEYSYM ("f6"); - case VK_F7: return KEYSYM ("f7"); - case VK_F8: return KEYSYM ("f8"); - case VK_F9: return KEYSYM ("f9"); - case VK_F10: return KEYSYM ("f10"); - case VK_F11: return KEYSYM ("f11"); - case VK_F12: return KEYSYM ("f12"); - case VK_F13: return KEYSYM ("f13"); - case VK_F14: return KEYSYM ("f14"); - case VK_F15: return KEYSYM ("f15"); - case VK_F16: return KEYSYM ("f16"); - case VK_F17: return KEYSYM ("f17"); - case VK_F18: return KEYSYM ("f18"); - case VK_F19: return KEYSYM ("f19"); - case VK_F20: return KEYSYM ("f20"); - case VK_F21: return KEYSYM ("f21"); - case VK_F22: return KEYSYM ("f22"); - case VK_F23: return KEYSYM ("f23"); - case VK_F24: return KEYSYM ("f24"); - } - return Qnil; -} - -/* - * Find the console that matches the supplied mswindows window handle - */ -Lisp_Object -mswindows_find_console (HWND hwnd) -{ - /* We only support one console */ - return XCAR (Vconsole_list); -} - -/* - * Find the frame that matches the supplied mswindows window handle - */ -static Lisp_Object -mswindows_find_frame (HWND hwnd) -{ - LONG l = GetWindowLong (hwnd, XWL_FRAMEOBJ); - Lisp_Object f; - if (l == 0) - { - /* We are in progress of frame creation. Return the frame - being created, as it still not remembered in the window - extra storage. */ - assert (!NILP (Vmswindows_frame_being_created)); - return Vmswindows_frame_being_created; - } - VOID_TO_LISP (f, l); - return f; -} - - -/************************************************************************/ -/* methods */ -/************************************************************************/ - -static int -emacs_mswindows_add_timeout (EMACS_TIME thyme) -{ - int milliseconds; - EMACS_TIME current_time; - EMACS_GET_TIME (current_time); - EMACS_SUB_TIME (thyme, thyme, current_time); - milliseconds = EMACS_SECS (thyme) * 1000 + - (EMACS_USECS (thyme) + 500) / 1000; - if (milliseconds < 1) - milliseconds = 1; - ++mswindows_pending_timers_count; - return SetTimer (NULL, 0, milliseconds, - (TIMERPROC) mswindows_wm_timer_callback); -} - -static void -emacs_mswindows_remove_timeout (int id) -{ - struct Lisp_Event match_against; - Lisp_Object emacs_event; - - if (KillTimer (NULL, id)) - --mswindows_pending_timers_count; - - /* If there is a dispatch event generated by this - timeout in the queue, we have to remove it too. */ - match_against.event_type = timeout_event; - match_against.event.timeout.interval_id = id; - emacs_event = mswindows_cancel_dispatch_event (&match_against); - if (!NILP (emacs_event)) - Fdeallocate_event(emacs_event); -} - -/* If `user_p' is false, then return whether there are any win32, timeout, - * or subprocess events pending (that is, whether - * emacs_mswindows_next_event() would return immediately without blocking). - * - * if `user_p' is true, then return whether there are any *user generated* - * events available (that is, whether there are keyboard or mouse-click - * events ready to be read). This also implies that - * emacs_mswindows_next_event() would not block. - */ -static int -emacs_mswindows_event_pending_p (int user_p) -{ - mswindows_need_event (0); - return (!NILP (mswindows_u_dispatch_event_queue) - || (!user_p && !NILP (mswindows_s_dispatch_event_queue))); -} - -/* - * Return the next event - */ -static void -emacs_mswindows_next_event (struct Lisp_Event *emacs_event) -{ - Lisp_Object event, event2; - - mswindows_need_event (1); - - event = mswindows_dequeue_dispatch_event (!NILP(mswindows_u_dispatch_event_queue)); - XSETEVENT (event2, emacs_event); - Fcopy_event (event, event2); - Fdeallocate_event (event); -} - -/* - * Handle a magic event off the dispatch queue. - */ -static void -emacs_mswindows_handle_magic_event (struct Lisp_Event *emacs_event) -{ - switch (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event)) - { - case XM_BUMPQUEUE: - break; - - case WM_SETFOCUS: - case WM_KILLFOCUS: - { - Lisp_Object frame = EVENT_CHANNEL (emacs_event); - struct frame *f = XFRAME (frame); - int in_p = (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) == WM_SETFOCUS); - Lisp_Object conser; - - /* struct gcpro gcpro1; */ - - /* Clear sticky modifiers here (if we had any) */ - - conser = Fcons (frame, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil)); - /* GCPRO1 (conser); XXX Not necessary? */ - emacs_handle_focus_change_preliminary (conser); - /* Under X the stuff up to here is done in the X event handler. - I Don't know why */ - emacs_handle_focus_change_final (conser); - /* UNGCPRO; */ - - } - break; - - case XM_MAPFRAME: - case XM_UNMAPFRAME: - { - Lisp_Object frame = EVENT_CHANNEL (emacs_event); - va_run_hook_with_args (EVENT_MSWINDOWS_MAGIC_TYPE(emacs_event) - == XM_MAPFRAME ? - Qmap_frame_hook : Qunmap_frame_hook, - 1, frame); - } - break; - - /* #### What about Enter & Leave */ -#if 0 - va_run_hook_with_args (in_p ? Qmouse_enter_frame_hook : - Qmouse_leave_frame_hook, 1, frame); -#endif - - default: - assert(0); - } -} - -#ifndef HAVE_MSG_SELECT -static HANDLE -get_process_input_waitable (struct Lisp_Process *process) -{ - Lisp_Object instr, outstr, p; - XSETPROCESS (p, process); - get_process_streams (process, &instr, &outstr); - assert (!NILP (instr)); -#if defined (HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - return (network_connection_p (p) - ? get_winsock_stream_waitable (XLSTREAM (instr)) - : get_ntpipe_input_stream_waitable (XLSTREAM (instr))); -#else - return get_ntpipe_input_stream_waitable (XLSTREAM (instr)); -#endif -} - -static void -emacs_mswindows_select_process (struct Lisp_Process *process) -{ - HANDLE hev = get_process_input_waitable (process); - - if (!add_waitable_handle (hev)) - error ("Too many active processes"); - -#ifdef HAVE_WIN32_PROCESSES - { - Lisp_Object p; - XSETPROCESS (p, process); - if (!network_connection_p (p)) - { - HANDLE hprocess = get_nt_process_handle (process); - if (!add_waitable_handle (hprocess)) - { - remove_waitable_handle (hev); - error ("Too many active processes"); - } - } - } -#endif -} - -static void -emacs_mswindows_unselect_process (struct Lisp_Process *process) -{ - /* Process handle is removed in the event loop as soon - as it is signaled, so don't bother here about it */ - HANDLE hev = get_process_input_waitable (process); - remove_waitable_handle (hev); -} -#endif /* HAVE_MSG_SELECT */ - -static void -emacs_mswindows_select_console (struct console *con) -{ -#ifdef HAVE_MSG_SELECT - if (CONSOLE_MSWINDOWS_P (con)) - return; /* mswindows consoles are automatically selected */ - - event_stream_unixoid_select_console (con); -#endif -} - -static void -emacs_mswindows_unselect_console (struct console *con) -{ -#ifdef HAVE_MSG_SELECT - if (CONSOLE_MSWINDOWS_P (con)) - return; /* mswindows consoles are automatically selected */ - - event_stream_unixoid_unselect_console (con); -#endif -} - -static void -emacs_mswindows_quit_p (void) -{ - MSG msg; - - /* Quit cannot happen in modal loop: all program - input is dedicated to Windows. */ - if (mswindows_in_modal_loop) - return; - - /* Drain windows queue. This sets up number of quit characters in the queue - * (and also processes wm focus change, move, resize, etc messages). - * We don't want to process WM_PAINT messages because this function can be - * called from almost anywhere and the windows' states may be changing. */ - while (PeekMessage (&msg, NULL, 0, WM_PAINT-1, PM_REMOVE) || - PeekMessage (&msg, NULL, WM_PAINT+1, WM_USER-1, PM_REMOVE)) - DispatchMessage (&msg); - - if (mswindows_quit_chars_count > 0) - { - /* Yes there's a hidden one... Throw it away */ - struct Lisp_Event match_against; - Lisp_Object emacs_event; - - match_against.event_type = key_press_event; - match_against.event.key.modifiers = FAKE_MOD_QUIT; - - emacs_event = mswindows_cancel_dispatch_event (&match_against); - assert (!NILP (emacs_event)); - - Vquit_flag = (XEVENT(emacs_event)->event.key.modifiers & MOD_SHIFT - ? Qcritical : Qt); - - Fdeallocate_event(emacs_event); - --mswindows_quit_chars_count; - } -} - -USID -emacs_mswindows_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, - Lisp_Object* outstream, - int flags) -{ - /* Handles for streams */ - HANDLE hin, hout; - /* fds. These just stored along with the streams, and are closed in - delete stream pair method, because we need to handle fake unices - here. */ - int fdi, fdo; - - /* Decode inhandle and outhandle. Their meaning depends on - the process implementation being used. */ -#if defined (HAVE_WIN32_PROCESSES) - /* We're passed in Windows handles. That's what we like most... */ - hin = (HANDLE) inhandle; - hout = (HANDLE) outhandle; - fdi = fdo = -1; -#elif defined (HAVE_UNIX_PROCESSES) - /* We are passed UNIX fds. This must be Cygwin. - Fetch os handles */ - hin = inhandle >= 0 ? (HANDLE)get_osfhandle ((int)inhandle) : INVALID_HANDLE_VALUE; - hout = outhandle >= 0 ? (HANDLE)get_osfhandle ((int)outhandle) : INVALID_HANDLE_VALUE; - fdi=(int)inhandle; - fdo=(int)outhandle; -#else -#error "So, WHICH kind of processes do you want?" -#endif - - *instream = (hin == INVALID_HANDLE_VALUE - ? Qnil -#if defined (HAVE_SOCKETS) && !defined (HAVE_MSG_SELECT) - : flags & STREAM_NETWORK_CONNECTION - ? make_winsock_input_stream ((SOCKET)hin, fdi) -#endif - : make_ntpipe_input_stream (hin, fdi)); - -#ifdef HAVE_WIN32_PROCESSES - *outstream = (hout == INVALID_HANDLE_VALUE - ? Qnil -#if defined (HAVE_SOCKETS) && !defined (HAVE_MSG_SELECT) - : flags & STREAM_NETWORK_CONNECTION - ? make_winsock_output_stream ((SOCKET)hout, fdo) -#endif - : make_ntpipe_output_stream (hout, fdo)); -#elif defined (HAVE_UNIX_PROCESSES) - *outstream = (fdo >= 0 - ? make_filedesc_output_stream (fdo, 0, -1, LSTR_BLOCKED_OK) - : Qnil); - -#if defined(HAVE_UNIX_PROCESSES) && defined(HAVE_PTYS) - /* FLAGS is process->pty_flag for UNIX_PROCESSES */ - if ((flags & STREAM_PTY_FLUSHING) && fdo >= 0) - { - Bufbyte eof_char = get_eof_char (fdo); - int pty_max_bytes = get_pty_max_bytes (fdo); - filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes, eof_char); - } -#endif -#endif - - return (NILP (*instream) - ? USID_ERROR -#if defined(HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - : flags & STREAM_NETWORK_CONNECTION - ? HANDLE_TO_USID (get_winsock_stream_waitable (XLSTREAM (*instream))) -#endif - : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM (*instream)))); -} - -USID -emacs_mswindows_delete_stream_pair (Lisp_Object instream, - Lisp_Object outstream) -{ - /* Oh nothing special here for Win32 at all */ -#if defined (HAVE_UNIX_PROCESSES) - int in = (NILP(instream) - ? -1 -#if defined(HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - : LSTREAM_TYPE_P (XLSTREAM (instream), winsock) - ? get_winsock_stream_param (XLSTREAM (instream)) -#endif - : get_ntpipe_input_stream_param (XLSTREAM (instream))); - int out = (NILP(outstream) ? -1 - : filedesc_stream_fd (XLSTREAM (outstream))); - - if (in >= 0) - close (in); - if (out != in && out >= 0) - close (out); -#endif - - return (NILP (instream) - ? USID_DONTHASH -#if defined(HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - : LSTREAM_TYPE_P (XLSTREAM (instream), winsock) - ? HANDLE_TO_USID (get_winsock_stream_waitable (XLSTREAM (instream))) -#endif - : HANDLE_TO_USID (get_ntpipe_input_stream_waitable (XLSTREAM (instream)))); -} - -#ifndef HAVE_X_WINDOWS -/* This is called from GC when a process object is about to be freed. - If we've still got pointers to it in this file, we're gonna lose hard. - */ -void -debug_process_finalization (struct Lisp_Process *p) -{ -#if 0 /* #### */ - Lisp_Object instr, outstr; - - get_process_streams (p, &instr, &outstr); - /* if it still has fds, then it hasn't been killed yet. */ - assert (NILP(instr)); - assert (NILP(outstr)); - - /* #### More checks here */ -#endif -} -#endif - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -vars_of_event_mswindows (void) -{ - mswindows_u_dispatch_event_queue = Qnil; - staticpro (&mswindows_u_dispatch_event_queue); - mswindows_u_dispatch_event_queue_tail = Qnil; - - mswindows_s_dispatch_event_queue = Qnil; - staticpro (&mswindows_s_dispatch_event_queue); - mswindows_s_dispatch_event_queue_tail = Qnil; - - mswindows_error_caught_in_modal_loop = Qnil; - staticpro (&mswindows_error_caught_in_modal_loop); - mswindows_in_modal_loop = 0; - mswindows_pending_timers_count = 0; - - mswindows_event_stream = xnew (struct event_stream); - - mswindows_event_stream->event_pending_p = emacs_mswindows_event_pending_p; - mswindows_event_stream->next_event_cb = emacs_mswindows_next_event; - mswindows_event_stream->handle_magic_event_cb = emacs_mswindows_handle_magic_event; - mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; - mswindows_event_stream->remove_timeout_cb = emacs_mswindows_remove_timeout; - mswindows_event_stream->quit_p_cb = emacs_mswindows_quit_p; - mswindows_event_stream->select_console_cb = emacs_mswindows_select_console; - mswindows_event_stream->unselect_console_cb = emacs_mswindows_unselect_console; -#ifdef HAVE_MSG_SELECT - mswindows_event_stream->select_process_cb = - (void (*)(struct Lisp_Process*))event_stream_unixoid_select_process; - mswindows_event_stream->unselect_process_cb = - (void (*)(struct Lisp_Process*))event_stream_unixoid_unselect_process; - mswindows_event_stream->create_stream_pair_cb = event_stream_unixoid_create_stream_pair; - mswindows_event_stream->delete_stream_pair_cb = event_stream_unixoid_delete_stream_pair; -#else - mswindows_event_stream->select_process_cb = emacs_mswindows_select_process; - mswindows_event_stream->unselect_process_cb = emacs_mswindows_unselect_process; - mswindows_event_stream->create_stream_pair_cb = emacs_mswindows_create_stream_pair; - mswindows_event_stream->delete_stream_pair_cb = emacs_mswindows_delete_stream_pair; -#endif - - DEFVAR_BOOL ("mswindows-dynamic-frame-resize", &mswindows_dynamic_frame_resize /* -*Controls redrawing frame contents during mouse-drag or keyboard resize -operation. When non-nil, the frame is redrawn while being resized. When -nil, frame is not redrawn, and exposed areas are filled with default -MDI application background color. Note that this option only has effect -if "Show window contents while dragging" is on in system Display/Plus! -settings. -Default is t on fast machines, nil on slow. -*/ ); - -/* The description copied verbatim from nt-emacs. (C) Geoff Voelker */ - DEFVAR_INT ("mswindows-mouse-button-tolerance", &mswindows_mouse_button_tolerance /* -*Analogue of double click interval for faking middle mouse events. -The value is the minimum time in milliseconds that must elapse between -left/right button down events before they are considered distinct events. -If both mouse buttons are depressed within this interval, a middle mouse -button down event is generated instead. -If negative or zero, currently set system default is used instead. -*/ ); - -/* The description copied verbatim from nt-emacs. (C) Geoff Voelker */ - DEFVAR_INT ("mswindows-num-mouse-buttons", &mswindows_num_mouse_buttons /* -Number of physical mouse buttons. -*/ ); - - DEFVAR_INT ("mswindows-mouse-button-max-skew-x", &mswindows_mouse_button_max_skew_x /* -*Maximum horizontal distance in pixels between points in which left and -right button clicks occurred for them to be translated into single -middle button event. Clicks must occur in time not longer than defined -by the variable `mswindows-mouse-button-tolerance'. -If negative or zero, currently set system default is used instead. -*/ ); - - DEFVAR_INT ("mswindows-mouse-button-max-skew-y", &mswindows_mouse_button_max_skew_y /* -*Maximum vertical distance in pixels between points in which left and -right button clicks occurred for them to be translated into single -middle button event. Clicks must occur in time not longer than defined -by the variable `mswindows-mouse-button-tolerance'. -If negative or zero, currently set system default is used instead. -*/ ); - - mswindows_mouse_button_max_skew_x = 0; - mswindows_mouse_button_max_skew_y = 0; - mswindows_mouse_button_tolerance = 0; -} - -void -syms_of_event_mswindows (void) -{ -} - -void -lstream_type_create_mswindows_selectable (void) -{ - init_slurp_stream (); - init_shove_stream (); -#if defined (HAVE_SOCKETS) && !defined(HAVE_MSG_SELECT) - init_winsock_stream (); -#endif -} - -void -init_event_mswindows_late (void) -{ -#ifdef HAVE_MSG_SELECT - windows_fd = open("/dev/windows", O_RDONLY | O_NONBLOCK, 0); - assert (windows_fd>=0); - FD_SET (windows_fd, &input_wait_mask); - FD_ZERO(&zero_mask); -#endif - - event_stream = mswindows_event_stream; - - mswindows_dynamic_frame_resize = !GetSystemMetrics (SM_SLOWMACHINE); - mswindows_num_mouse_buttons = GetSystemMetrics (SM_CMOUSEBUTTONS); -} diff --git a/src/event-stream.c b/src/event-stream.c deleted file mode 100644 index 52e8006..0000000 --- a/src/event-stream.c +++ /dev/null @@ -1,5528 +0,0 @@ -/* The portable interface to event streams. - Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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 file has been Mule-ized. */ - -/* - * DANGER!! - * - * If you ever change ANYTHING in this file, you MUST run the - * testcases at the end to make sure that you haven't changed - * the semantics of recent-keys, last-input-char, or keyboard - * macros. You'd be surprised how easy it is to break this. - * - */ - -/* TODO: - This stuff is way too hard to maintain - needs rework. - - (global-set-key "\C-p" global-map) causes a crash - need recursion check. - - C-x @ h x causes a crash. - - The command builder should deal only with key and button events. - Other command events should be able to come in the MIDDLE of a key - sequence, without disturbing the key sequence composition, or the - command builder structure representing it. - - Someone should rethink universal-argument and figure out how an - arbitrary command can influence the next command (universal-argument - or universal-coding-system-argument) or the next key (hyperify). - - Both C-h and Help in the middle of a key sequence should trigger - prefix-help-command. help-char is stupid. Maybe we need - keymap-of-last-resort? - - After prefix-help is run, one should be able to CONTINUE TYPING, - instead of RETYPING, the key sequence. - */ - -#include -#include "lisp.h" - -#ifdef HAVE_X_WINDOWS -#include "console-x.h" /* for menu accelerators ... */ -#include "gui-x.h" -#include "../lwlib/lwlib.h" -#else -#define lw_menu_active 0 -#endif - -#include "blocktype.h" -#include "buffer.h" -#include "commands.h" -#include "device.h" -#include "elhash.h" -#include "events.h" -#include "frame.h" -#include "insdel.h" /* for buffer_reset_changes */ -#include "keymap.h" -#include "lstream.h" -#include "macros.h" /* for defining_keyboard_macro */ -#include "opaque.h" -#include "process.h" -#include "window.h" - -#include "sysdep.h" /* init_poll_for_quit() */ -#include "syssignal.h" /* SIGCHLD, etc. */ -#include "sysfile.h" -#include "systime.h" /* to set Vlast_input_time */ - -#include "events-mod.h" -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -#include - -/* The number of keystrokes between auto-saves. */ -static int auto_save_interval; - -Lisp_Object Qundefined_keystroke_sequence; - -Lisp_Object Qcommand_execute; - -Lisp_Object Qcommand_event_p; - -/* Hooks to run before and after each command. */ -Lisp_Object Vpre_command_hook, Vpost_command_hook; -Lisp_Object Qpre_command_hook, Qpost_command_hook; - -/* Hook run when XEmacs is about to be idle. */ -Lisp_Object Qpre_idle_hook, Vpre_idle_hook; - -/* Control gratuitous keyboard focus throwing. */ -int focus_follows_mouse; - -#ifdef ILL_CONCEIVED_HOOK -/* Hook run after a command if there's no more input soon. */ -Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook; - -/* Delay time in microseconds before running post-command-idle-hook. */ -int post_command_idle_delay; -#endif /* ILL_CONCEIVED_HOOK */ - -#ifdef DEFERRED_ACTION_CRAP -/* List of deferred actions to be performed at a later time. - The precise format isn't relevant here; we just check whether it is nil. */ -Lisp_Object Vdeferred_action_list; - -/* Function to call to handle deferred actions, when there are any. */ -Lisp_Object Vdeferred_action_function; -Lisp_Object Qdeferred_action_function; -#endif /* DEFERRED_ACTION_CRAP */ - -/* Non-nil disable property on a command means - do not execute it; call disabled-command-hook's value instead. */ -Lisp_Object Qdisabled, Vdisabled_command_hook; - -EXFUN (Fnext_command_event, 2); - -static void pre_command_hook (void); -static void post_command_hook (void); - -/* Last keyboard or mouse input event read as a command. */ -Lisp_Object Vlast_command_event; - -/* The nearest ASCII equivalent of the above. */ -Lisp_Object Vlast_command_char; - -/* Last keyboard or mouse event read for any purpose. */ -Lisp_Object Vlast_input_event; - -/* The nearest ASCII equivalent of the above. */ -Lisp_Object Vlast_input_char; - -Lisp_Object Vcurrent_mouse_event; - -/* This is fbound in cmdloop.el, see the commentary there */ -Lisp_Object Qcancel_mode_internal; - -/* If not Qnil, event objects to be read as the next command input */ -Lisp_Object Vunread_command_events; -Lisp_Object Vunread_command_event; /* obsoleteness support */ - -static Lisp_Object Qunread_command_events, Qunread_command_event; - -/* Previous command, represented by a Lisp object. - Does not include prefix commands and arg setting commands */ -Lisp_Object Vlast_command; - -/* If a command sets this, the value goes into - previous-command for the next command. */ -Lisp_Object Vthis_command; - -/* The value of point when the last command was executed. */ -Bufpos last_point_position; - -/* The frame that was current when the last command was started. */ -Lisp_Object Vlast_selected_frame; - -/* The buffer that was current when the last command was started. */ -Lisp_Object last_point_position_buffer; - -/* A (16bit . 16bit) representation of the time of the last-command-event. */ -Lisp_Object Vlast_input_time; - -/* A (16bit 16bit usec) representation of the time - of the last-command-event. */ -Lisp_Object Vlast_command_event_time; - -/* Character to recognize as the help char. */ -Lisp_Object Vhelp_char; - -/* Form to execute when help char is typed. */ -Lisp_Object Vhelp_form; - -/* Command to run when the help character follows a prefix key. */ -Lisp_Object Vprefix_help_command; - -/* Flag to tell QUIT that some interesting occurrence (e.g. a keypress) - may have happened. */ -volatile int something_happened; - -/* Hash table to translate keysyms through */ -Lisp_Object Vkeyboard_translate_table; - -/* If control-meta-super-shift-X is undefined, try control-meta-super-x */ -Lisp_Object Vretry_undefined_key_binding_unshifted; -Lisp_Object Qretry_undefined_key_binding_unshifted; - -#ifdef HAVE_XIM -/* If composed input is undefined, use self-insert-char */ -Lisp_Object Vcomposed_character_default_binding; -#endif /* HAVE_XIM */ - -/* Console that corresponds to our controlling terminal */ -Lisp_Object Vcontrolling_terminal; - -/* An event (actually an event chain linked through event_next) or Qnil. - */ -Lisp_Object Vthis_command_keys; -Lisp_Object Vthis_command_keys_tail; - -/* #### kludge! */ -Lisp_Object Qauto_show_make_point_visible; - -/* File in which we write all commands we read; an lstream */ -static Lisp_Object Vdribble_file; - -/* Recent keys ring location; a vector of events or nil-s */ -Lisp_Object Vrecent_keys_ring; -int recent_keys_ring_size; -int recent_keys_ring_index; - -/* Boolean specifying whether keystrokes should be added to - recent-keys. */ -int inhibit_input_event_recording; - -/* prefix key(s) that must match in order to activate menu. - This is ugly. fix me. - */ -Lisp_Object Vmenu_accelerator_prefix; - -/* list of modifier keys to match accelerator for top level menus */ -Lisp_Object Vmenu_accelerator_modifiers; - -/* whether menu accelerators are enabled */ -Lisp_Object Vmenu_accelerator_enabled; - -/* keymap for auxiliary menu accelerator functions */ -Lisp_Object Vmenu_accelerator_map; - -Lisp_Object Qmenu_force; -Lisp_Object Qmenu_fallback; -Lisp_Object Qmenu_quit; -Lisp_Object Qmenu_up; -Lisp_Object Qmenu_down; -Lisp_Object Qmenu_left; -Lisp_Object Qmenu_right; -Lisp_Object Qmenu_select; -Lisp_Object Qmenu_escape; - -/* this is in keymap.c */ -extern Lisp_Object Fmake_keymap (Lisp_Object name); - -#ifdef DEBUG_XEMACS -int debug_emacs_events; - -static void -external_debugging_print_event (char *event_description, Lisp_Object event) -{ - write_c_string ("(", Qexternal_debugging_output); - write_c_string (event_description, Qexternal_debugging_output); - write_c_string (") ", Qexternal_debugging_output); - print_internal (event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); -} -#define DEBUG_PRINT_EMACS_EVENT(event_description, event) do { \ - if (debug_emacs_events) \ - external_debugging_print_event (event_description, event); \ -} while (0) -#else -#define DEBUG_PRINT_EMACS_EVENT(string, event) -#endif - - -/* The callback routines for the window system or terminal driver */ -struct event_stream *event_stream; - -/* This structure is what we use to encapsulate the state of a command sequence - being composed; key events are executed by adding themselves to the command - builder; if the command builder is then complete (does not still represent - a prefix key sequence) it executes the corresponding command. - */ -struct command_builder -{ - struct lcrecord_header header; - Lisp_Object console; /* back pointer to the console this command - builder is for */ - /* Qnil, or a Lisp_Event representing the first event read - * after the last command completed. Threaded. */ - /* #### NYI */ - Lisp_Object prefix_events; - /* Qnil, or a Lisp_Event representing event in the current - * keymap-lookup sequence. Subsequent events are threaded via - * the event's next slot */ - Lisp_Object current_events; - /* Last elt of above */ - Lisp_Object most_current_event; - /* Last elt before function map code took over. What this means is: - All prefixes up to (but not including) this event have non-nil - bindings, but the prefix including this event has a nil binding. - Any events in the chain after this one were read solely because - we're part of a possible function key. If we end up with - something that's not part of a possible function key, we have to - unread all of those events. */ - Lisp_Object last_non_munged_event; - /* One set of values for function-key-map, one for key-translation-map */ - struct munging_key_translation - { - /* First event that can begin a possible function key sequence - (to be translated according to function-key-map). Normally - this is the first event in the chain. However, once we've - translated a sequence through function-key-map, this will point - to the first event after the translated sequence: we don't ever - want to translate any events twice through function-key-map, or - things could get really screwed up (e.g. if the user created a - translation loop). If this is nil, then the next-read event is - the first that can begin a function key sequence. */ - Lisp_Object first_mungeable_event; - } munge_me[2]; - - Bufbyte *echo_buf; - Bytecount echo_buf_length; /* size of echo_buf */ - Bytecount echo_buf_index; /* index into echo_buf - * -1 before doing echoing for new cmd */ - /* Self-insert-command is magic in that it doesn't always push an undo- - boundary: up to 20 consecutive self-inserts can happen before an undo- - boundary is pushed. This variable is that counter. - */ - int self_insert_countdown; -}; - -static void echo_key_event (struct command_builder *, Lisp_Object event); -static void maybe_kbd_translate (Lisp_Object event); - -/* This structure is basically a typeahead queue: things like - wait-reading-process-output will delay the execution of - keyboard and mouse events by pushing them here. - - Chained through event_next() - command_event_queue_tail is a pointer to the last-added element. - */ -static Lisp_Object command_event_queue; -static Lisp_Object command_event_queue_tail; - -/* Nonzero means echo unfinished commands after this many seconds of pause. */ -static Lisp_Object Vecho_keystrokes; - -/* The number of keystrokes since the last auto-save. */ -static int keystrokes_since_auto_save; - -/* Used by the C-g signal handler so that it will never "hard quit" - when waiting for an event. Otherwise holding down C-g could - cause a suspension back to the shell, which is generally - undesirable. (#### This doesn't fully work.) */ - -int emacs_is_blocking; - -/* Handlers which run during sit-for, sleep-for and accept-process-output - are not allowed to recursively call these routines. We record here - if we are in that situation. */ - -static Lisp_Object recursive_sit_for; - - - -/**********************************************************************/ -/* Command-builder object */ -/**********************************************************************/ - -#define XCOMMAND_BUILDER(x) \ - XRECORD (x, command_builder, struct command_builder) -#define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder) -#define COMMAND_BUILDERP(x) RECORDP (x, command_builder) -#define GC_COMMAND_BUILDERP(x) GC_RECORDP (x, command_builder) -#define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) - -static Lisp_Object -mark_command_builder (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct command_builder *builder = XCOMMAND_BUILDER (obj); - markobj (builder->prefix_events); - markobj (builder->current_events); - markobj (builder->most_current_event); - markobj (builder->last_non_munged_event); - markobj (builder->munge_me[0].first_mungeable_event); - markobj (builder->munge_me[1].first_mungeable_event); - return builder->console; -} - -static void -finalize_command_builder (void *header, int for_disksave) -{ - if (!for_disksave) - { - xfree (((struct command_builder *) header)->echo_buf); - ((struct command_builder *) header)->echo_buf = 0; - } -} - -DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, - mark_command_builder, internal_object_printer, - finalize_command_builder, 0, 0, - struct command_builder); - -static void -reset_command_builder_event_chain (struct command_builder *builder) -{ - builder->prefix_events = Qnil; - builder->current_events = Qnil; - builder->most_current_event = Qnil; - builder->last_non_munged_event = Qnil; - builder->munge_me[0].first_mungeable_event = Qnil; - builder->munge_me[1].first_mungeable_event = Qnil; -} - -Lisp_Object -allocate_command_builder (Lisp_Object console) -{ - Lisp_Object builder_obj; - struct command_builder *builder = - alloc_lcrecord_type (struct command_builder, lrecord_command_builder); - - builder->console = console; - reset_command_builder_event_chain (builder); - builder->echo_buf_length = 300; /* #### Kludge */ - builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length); - builder->echo_buf[0] = 0; - builder->echo_buf_index = -1; - builder->echo_buf_index = -1; - builder->self_insert_countdown = 0; - - XSETCOMMAND_BUILDER (builder_obj, builder); - return builder_obj; -} - -static void -command_builder_append_event (struct command_builder *builder, - Lisp_Object event) -{ - assert (EVENTP (event)); - - if (EVENTP (builder->most_current_event)) - XSET_EVENT_NEXT (builder->most_current_event, event); - else - builder->current_events = event; - - builder->most_current_event = event; - if (NILP (builder->munge_me[0].first_mungeable_event)) - builder->munge_me[0].first_mungeable_event = event; - if (NILP (builder->munge_me[1].first_mungeable_event)) - builder->munge_me[1].first_mungeable_event = event; -} - - -/**********************************************************************/ -/* Low-level interfaces onto event methods */ -/**********************************************************************/ - -enum event_stream_operation -{ - EVENT_STREAM_PROCESS, - EVENT_STREAM_TIMEOUT, - EVENT_STREAM_CONSOLE, - EVENT_STREAM_READ -}; - -static void -check_event_stream_ok (enum event_stream_operation op) -{ - if (!event_stream && noninteractive) - { - switch (op) - { - case EVENT_STREAM_PROCESS: - error ("Can't start subprocesses in -batch mode"); - case EVENT_STREAM_TIMEOUT: - error ("Can't add timeouts in -batch mode"); - case EVENT_STREAM_CONSOLE: - error ("Can't add consoles in -batch mode"); - case EVENT_STREAM_READ: - error ("Can't read events in -batch mode"); - default: - abort (); - } - } - else if (!event_stream) - { - error ("event-stream callbacks not initialized (internal error?)"); - } -} - -static int -event_stream_event_pending_p (int user) -{ - return event_stream && event_stream->event_pending_p (user); -} - -static int -maybe_read_quit_event (struct Lisp_Event *event) -{ - /* A C-g that came from `sigint_happened' will always come from the - controlling terminal. If that doesn't exist, however, then the - user manually sent us a SIGINT, and we pretend the C-g came from - the selected console. */ - struct console *con; - - if (CONSOLEP (Vcontrolling_terminal) && - CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) - con = XCONSOLE (Vcontrolling_terminal); - else - con = XCONSOLE (Fselected_console ()); - - if (sigint_happened) - { - int ch = CONSOLE_QUIT_CHAR (con); - sigint_happened = 0; - Vquit_flag = Qnil; - character_to_event (ch, event, con, 1, 1); - event->channel = make_console (con); - return 1; - } - return 0; -} - -void -event_stream_next_event (struct Lisp_Event *event) -{ - Lisp_Object event_obj; - - check_event_stream_ok (EVENT_STREAM_READ); - - XSETEVENT (event_obj, event); - zero_event (event); - /* If C-g was pressed, treat it as a character to be read. - Note that if C-g was pressed while we were blocking, - the SIGINT signal handler will be called. It will - set Vquit_flag and write a byte on our "fake pipe", - which will unblock us. */ - if (maybe_read_quit_event (event)) - { - DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); - return; - } - - /* If a longjmp() happens in the callback, we're screwed. - Let's hope it doesn't. I think the code here is fairly - clean and doesn't do this. */ - emacs_is_blocking = 1; -#if 0 - /* Do this if the poll-for-quit timer seems to be taking too - much CPU time when idle ... */ - reset_poll_for_quit (); -#endif - event_stream->next_event_cb (event); -#if 0 - init_poll_for_quit (); -#endif - emacs_is_blocking = 0; - -#ifdef DEBUG_XEMACS - /* timeout events have more info set later, so - print the event out in next_event_internal(). */ - if (event->event_type != timeout_event) - DEBUG_PRINT_EMACS_EVENT ("real", event_obj); -#endif - maybe_kbd_translate (event_obj); -} - -void -event_stream_handle_magic_event (struct Lisp_Event *event) -{ - check_event_stream_ok (EVENT_STREAM_READ); - event_stream->handle_magic_event_cb (event); -} - -static int -event_stream_add_timeout (EMACS_TIME timeout) -{ - check_event_stream_ok (EVENT_STREAM_TIMEOUT); - return event_stream->add_timeout_cb (timeout); -} - -static void -event_stream_remove_timeout (int id) -{ - check_event_stream_ok (EVENT_STREAM_TIMEOUT); - event_stream->remove_timeout_cb (id); -} - -void -event_stream_select_console (struct console *con) -{ - check_event_stream_ok (EVENT_STREAM_CONSOLE); - if (!con->input_enabled) - { - event_stream->select_console_cb (con); - con->input_enabled = 1; - } -} - -void -event_stream_unselect_console (struct console *con) -{ - check_event_stream_ok (EVENT_STREAM_CONSOLE); - if (con->input_enabled) - { - event_stream->unselect_console_cb (con); - con->input_enabled = 0; - } -} - -void -event_stream_select_process (struct Lisp_Process *proc) -{ - check_event_stream_ok (EVENT_STREAM_PROCESS); - if (!get_process_selected_p (proc)) - { - event_stream->select_process_cb (proc); - set_process_selected_p (proc, 1); - } -} - -void -event_stream_unselect_process (struct Lisp_Process *proc) -{ - check_event_stream_ok (EVENT_STREAM_PROCESS); - if (get_process_selected_p (proc)) - { - event_stream->unselect_process_cb (proc); - set_process_selected_p (proc, 0); - } -} - -USID -event_stream_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, Lisp_Object* outstream, int flags) -{ - check_event_stream_ok (EVENT_STREAM_PROCESS); - return event_stream->create_stream_pair_cb - (inhandle, outhandle, instream, outstream, flags); -} - -USID -event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream) -{ - check_event_stream_ok (EVENT_STREAM_PROCESS); - return event_stream->delete_stream_pair_cb (instream, outstream); -} - -void -event_stream_quit_p (void) -{ - if (event_stream) - event_stream->quit_p_cb (); -} - - - -/**********************************************************************/ -/* Character prompting */ -/**********************************************************************/ - -static void -echo_key_event (struct command_builder *command_builder, - Lisp_Object event) -{ - /* This function can GC */ - char buf[255]; - Bytecount buf_index = command_builder->echo_buf_index; - Bufbyte *e; - Bytecount len; - - if (buf_index < 0) - { - buf_index = 0; /* We're echoing now */ - clear_echo_area (selected_frame (), Qnil, 0); - } - - format_event_object (buf, XEVENT (event), 1); - len = strlen (buf); - - if (len + buf_index + 4 > command_builder->echo_buf_length) - return; - e = command_builder->echo_buf + buf_index; - memcpy (e, buf, len); - e += len; - - e[0] = ' '; - e[1] = '-'; - e[2] = ' '; - e[3] = 0; - - command_builder->echo_buf_index = buf_index + len + 1; -} - -static void -regenerate_echo_keys_from_this_command_keys (struct command_builder * - builder) -{ - Lisp_Object event; - - builder->echo_buf_index = 0; - - EVENT_CHAIN_LOOP (event, Vthis_command_keys) - echo_key_event (builder, event); -} - -static void -maybe_echo_keys (struct command_builder *command_builder, int no_snooze) -{ - /* This function can GC */ - double echo_keystrokes; - struct frame *f = selected_frame (); - /* Message turns off echoing unless more keystrokes turn it on again. */ - if (echo_area_active (f) && !EQ (Qcommand, echo_area_status (f))) - return; - - if (INTP (Vecho_keystrokes) || FLOATP (Vecho_keystrokes)) - echo_keystrokes = extract_float (Vecho_keystrokes); - else - echo_keystrokes = 0; - - if (minibuf_level == 0 - && echo_keystrokes > 0.0 - && !lw_menu_active) - { - if (!no_snooze) - { - /* #### C-g here will cause QUIT. Setting dont_check_for_quit - doesn't work. See check_quit. */ - if (NILP (Fsit_for (Vecho_keystrokes, Qnil))) - /* input came in, so don't echo. */ - return; - } - - echo_area_message (f, command_builder->echo_buf, Qnil, 0, - /* not echo_buf_index. That doesn't include - the terminating " - ". */ - strlen ((char *) command_builder->echo_buf), - Qcommand); - } -} - -static void -reset_key_echo (struct command_builder *command_builder, - int remove_echo_area_echo) -{ - /* This function can GC */ - struct frame *f = selected_frame (); - - command_builder->echo_buf_index = -1; - - if (remove_echo_area_echo) - clear_echo_area (f, Qcommand, 0); -} - - -/**********************************************************************/ -/* random junk */ -/**********************************************************************/ - -static void -maybe_kbd_translate (Lisp_Object event) -{ - Emchar c; - int did_translate = 0; - - if (XEVENT_TYPE (event) != key_press_event) - return; - if (!HASH_TABLEP (Vkeyboard_translate_table)) - return; - if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero)) - return; - - c = event_to_character (XEVENT (event), 0, 0, 0); - if (c != -1) - { - Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table, - Qnil); - if (!NILP (traduit) && SYMBOLP (traduit)) - { - XEVENT (event)->event.key.keysym = traduit; - XEVENT (event)->event.key.modifiers = 0; - did_translate = 1; - } - else if (CHARP (traduit)) - { - struct Lisp_Event ev2; - - /* This used to call Fcharacter_to_event() directly into EVENT, - but that can eradicate timestamps and other such stuff. - This way is safer. */ - zero_event (&ev2); - character_to_event (XCHAR (traduit), &ev2, - XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1); - XEVENT (event)->event.key.keysym = ev2.event.key.keysym; - XEVENT (event)->event.key.modifiers = ev2.event.key.modifiers; - did_translate = 1; - } - } - - if (!did_translate) - { - Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym, - Vkeyboard_translate_table, Qnil); - if (!NILP (traduit) && SYMBOLP (traduit)) - { - XEVENT (event)->event.key.keysym = traduit; - did_translate = 1; - } - } - -#ifdef DEBUG_XEMACS - if (did_translate) - DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event); -#endif -} - -/* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and - keystrokes_since_auto_save is equivalent to the difference between - num_nonmacro_input_chars and last_auto_save. */ - -/* When an auto-save happens, record the "time", and don't do again soon. */ - -void -record_auto_save (void) -{ - keystrokes_since_auto_save = 0; -} - -/* Make an auto save happen as soon as possible at command level. */ - -void -force_auto_save_soon (void) -{ - keystrokes_since_auto_save = 1 + max (auto_save_interval, 20); - -#if 0 /* FSFmacs */ - record_asynch_buffer_change (); -#endif -} - -static void -maybe_do_auto_save (void) -{ - /* This function can call lisp */ - keystrokes_since_auto_save++; - if (auto_save_interval > 0 && - keystrokes_since_auto_save > max (auto_save_interval, 20) && - !detect_input_pending ()) - { - Fdo_auto_save (Qnil, Qnil); - record_auto_save (); - } -} - -static Lisp_Object -print_help (Lisp_Object object) -{ - Fprinc (object, Qnil); - return Qnil; -} - -static void -execute_help_form (struct command_builder *command_builder, - Lisp_Object event) -{ - /* This function can GC */ - Lisp_Object help = Qnil; - int speccount = specpdl_depth (); - Bytecount buf_index = command_builder->echo_buf_index; - Lisp_Object echo = ((buf_index <= 0) - ? Qnil - : make_string (command_builder->echo_buf, - buf_index)); - struct gcpro gcpro1, gcpro2; - GCPRO2 (echo, help); - - record_unwind_protect (save_window_excursion_unwind, - Fcurrent_window_configuration (Qnil)); - reset_key_echo (command_builder, 1); - - help = Feval (Vhelp_form); - if (STRINGP (help)) - internal_with_output_to_temp_buffer (build_string ("*Help*"), - print_help, help, Qnil); - Fnext_command_event (event, Qnil); - /* Remove the help from the frame */ - unbind_to (speccount, Qnil); - /* Hmmmm. Tricky. The unbind restores an old window configuration, - apparently bypassing any setting of windows_structure_changed. - So we need to set it so that things get redrawn properly. */ - /* #### This is massive overkill. Look at doing it better once the - new redisplay is fully in place. */ - { - Lisp_Object frmcons, devcons, concons; - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - struct frame *f = XFRAME (XCAR (frmcons)); - MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); - } - } - - redisplay (); - if (event_matches_key_specifier_p (XEVENT (event), make_char (' '))) - { - /* Discard next key if it is a space */ - reset_key_echo (command_builder, 1); - Fnext_command_event (event, Qnil); - } - - command_builder->echo_buf_index = buf_index; - if (buf_index > 0) - memcpy (command_builder->echo_buf, - XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */ - UNGCPRO; -} - - -/**********************************************************************/ -/* input pending */ -/**********************************************************************/ - -int -detect_input_pending (void) -{ - /* Always call the event_pending_p hook even if there's an unread - character, because that might do some needed ^G detection (on - systems without SIGIO, for example). - */ - if (event_stream_event_pending_p (1)) - return 1; - if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) - return 1; - if (!NILP (command_event_queue)) - { - Lisp_Object event; - - EVENT_CHAIN_LOOP (event, command_event_queue) - { - if (XEVENT_TYPE (event) != eval_event - && XEVENT_TYPE (event) != magic_eval_event) - return 1; - } - } - return 0; -} - -DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /* -Return t if command input is currently available with no waiting. -Actually, the value is nil only if we can be sure that no input is available. -*/ - ()) -{ - return detect_input_pending () ? Qt : Qnil; -} - - -/**********************************************************************/ -/* timeouts */ -/**********************************************************************/ - -/**** Low-level timeout functions. **** - - These functions maintain a sorted list of one-shot timeouts (where - the timeouts are in absolute time). They are intended for use by - functions that need to convert a list of absolute timeouts into a - series of intervals to wait for. */ - -/* We ensure that 0 is never a valid ID, so that a value of 0 can be - used to indicate an absence of a timer. */ -static int low_level_timeout_id_tick; - -struct low_level_timeout_blocktype -{ - Blocktype_declare (struct low_level_timeout); -} *the_low_level_timeout_blocktype; - -/* Add a one-shot timeout at time TIME to TIMEOUT_LIST. Return - a unique ID identifying the timeout. */ - -int -add_low_level_timeout (struct low_level_timeout **timeout_list, - EMACS_TIME thyme) -{ - struct low_level_timeout *tm; - struct low_level_timeout *t, **tt; - - /* Allocate a new time struct. */ - - tm = Blocktype_alloc (the_low_level_timeout_blocktype); - tm->next = NULL; - if (low_level_timeout_id_tick == 0) - low_level_timeout_id_tick++; - tm->id = low_level_timeout_id_tick++; - tm->time = thyme; - - /* Add it to the queue. */ - - tt = timeout_list; - t = *tt; - while (t && EMACS_TIME_EQUAL_OR_GREATER (tm->time, t->time)) - { - tt = &t->next; - t = *tt; - } - tm->next = t; - *tt = tm; - - return tm->id; -} - -/* Remove the low-level timeout identified by ID from TIMEOUT_LIST. - If the timeout is not there, do nothing. */ - -void -remove_low_level_timeout (struct low_level_timeout **timeout_list, int id) -{ - struct low_level_timeout *t, *prev; - - /* find it */ - - for (t = *timeout_list, prev = NULL; t && t->id != id; t = t->next) - prev = t; - - if (!t) - return; /* couldn't find it */ - - if (!prev) - *timeout_list = t->next; - else prev->next = t->next; - - Blocktype_free (the_low_level_timeout_blocktype, t); -} - -/* If there are timeouts on TIMEOUT_LIST, store the relative time - interval to the first timeout on the list into INTERVAL and - return 1. Otherwise, return 0. */ - -int -get_low_level_timeout_interval (struct low_level_timeout *timeout_list, - EMACS_TIME *interval) -{ - if (!timeout_list) /* no timer events; block indefinitely */ - return 0; - else - { - EMACS_TIME current_time; - - /* The time to block is the difference between the first - (earliest) timer on the queue and the current time. - If that is negative, then the timer will fire immediately - but we still have to call select(), with a zero-valued - timeout: user events must have precedence over timer events. */ - EMACS_GET_TIME (current_time); - if (EMACS_TIME_GREATER (timeout_list->time, current_time)) - EMACS_SUB_TIME (*interval, timeout_list->time, - current_time); - else - EMACS_SET_SECS_USECS (*interval, 0, 0); - return 1; - } -} - -/* Pop the first (i.e. soonest) timeout off of TIMEOUT_LIST and return - its ID. Also, if TIME_OUT is not 0, store the absolute time of the - timeout into TIME_OUT. */ - -int -pop_low_level_timeout (struct low_level_timeout **timeout_list, - EMACS_TIME *time_out) -{ - struct low_level_timeout *tm = *timeout_list; - int id; - - assert (tm); - id = tm->id; - if (time_out) - *time_out = tm->time; - *timeout_list = tm->next; - Blocktype_free (the_low_level_timeout_blocktype, tm); - return id; -} - - -/**** High-level timeout functions. ****/ - -static int timeout_id_tick; - -/* Since timeout structures contain Lisp_Objects, they need to be GC'd - properly. The opaque data type provides a convenient way of doing - this without having to create a new Lisp object, since we can - provide our own mark function. */ - -struct timeout -{ - int id; /* Id we use to identify the timeout over its lifetime */ - int interval_id; /* Id for this particular interval; this may - be different each time the timeout is - signalled.*/ - Lisp_Object function, object; /* Function and object associated - with timeout. */ - EMACS_TIME next_signal_time; /* Absolute time when the timeout - is next going to be signalled. */ - unsigned int resignal_msecs; /* How far after the next timeout - should the one after that - occur? */ -}; - -static Lisp_Object pending_timeout_list, pending_async_timeout_list; - -static Lisp_Object Vtimeout_free_list; - -static Lisp_Object -mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj); - markobj (tm->function); - return tm->object; -} - -/* Generate a timeout and return its ID. */ - -int -event_stream_generate_wakeup (unsigned int milliseconds, - unsigned int vanilliseconds, - Lisp_Object function, Lisp_Object object, - int async_p) -{ - Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0); - struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op); - EMACS_TIME current_time; - EMACS_TIME interval; - - timeout->id = timeout_id_tick++; - timeout->resignal_msecs = vanilliseconds; - timeout->function = function; - timeout->object = object; - - EMACS_GET_TIME (current_time); - EMACS_SET_SECS_USECS (interval, milliseconds / 1000, - 1000 * (milliseconds % 1000)); - EMACS_ADD_TIME (timeout->next_signal_time, current_time, interval); - - if (async_p) - { - timeout->interval_id = - event_stream_add_async_timeout (timeout->next_signal_time); - pending_async_timeout_list = noseeum_cons (op, - pending_async_timeout_list); - } - else - { - timeout->interval_id = - event_stream_add_timeout (timeout->next_signal_time); - pending_timeout_list = noseeum_cons (op, pending_timeout_list); - } - return timeout->id; -} - -/* Given the INTERVAL-ID of a timeout just signalled, resignal the timeout - as necessary and return the timeout's ID and function and object slots. - - This should be called as a result of receiving notice that a timeout - has fired. INTERVAL-ID is *not* the timeout's ID, but is the ID that - identifies this particular firing of the timeout. INTERVAL-ID's and - timeout ID's are in separate number spaces and bear no relation to - each other. The INTERVAL-ID is all that the event callback routines - work with: they work only with one-shot intervals, not with timeouts - that may fire repeatedly. - - NOTE: The returned FUNCTION and OBJECT are *not* GC-protected at all. -*/ - -static int -event_stream_resignal_wakeup (int interval_id, int async_p, - Lisp_Object *function, Lisp_Object *object) -{ - Lisp_Object op = Qnil, rest; - struct timeout *timeout; - Lisp_Object *timeout_list; - struct gcpro gcpro1; - int id; - - GCPRO1 (op); /* just in case ... because it's removed from the list - for awhile. */ - - timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list; - - /* Find the timeout on the list of pending ones. */ - LIST_LOOP (rest, *timeout_list) - { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); - if (timeout->interval_id == interval_id) - break; - } - - assert (!NILP (rest)); - op = XCAR (rest); - timeout = (struct timeout *) XOPAQUE_DATA (op); - /* We make sure to snarf the data out of the timeout object before - we free it with free_managed_opaque(). */ - id = timeout->id; - *function = timeout->function; - *object = timeout->object; - - /* Remove this one from the list of pending timeouts */ - *timeout_list = delq_no_quit_and_free_cons (op, *timeout_list); - - /* If this timeout wants to be resignalled, do it now. */ - if (timeout->resignal_msecs) - { - EMACS_TIME current_time; - EMACS_TIME interval; - - /* Determine the time that the next resignalling should occur. - We do that by adding the interval time to the last signalled - time until we get a time that's current. - - (This way, it doesn't matter if the timeout was signalled - exactly when we asked for it, or at some time later.) - */ - EMACS_GET_TIME (current_time); - EMACS_SET_SECS_USECS (interval, timeout->resignal_msecs / 1000, - 1000 * (timeout->resignal_msecs % 1000)); - do - { - EMACS_ADD_TIME (timeout->next_signal_time, timeout->next_signal_time, - interval); - } while (EMACS_TIME_GREATER (current_time, timeout->next_signal_time)); - - if (async_p) - timeout->interval_id = - event_stream_add_async_timeout (timeout->next_signal_time); - else - timeout->interval_id = - event_stream_add_timeout (timeout->next_signal_time); - /* Add back onto the list. Note that the effect of this - is to move frequently-hit timeouts to the front of the - list, which is a good thing. */ - *timeout_list = noseeum_cons (op, *timeout_list); - } - else - free_managed_opaque (Vtimeout_free_list, op); - - UNGCPRO; - return id; -} - -void -event_stream_disable_wakeup (int id, int async_p) -{ - struct timeout *timeout = 0; - Lisp_Object rest; - Lisp_Object *timeout_list; - - if (async_p) - timeout_list = &pending_async_timeout_list; - else - timeout_list = &pending_timeout_list; - - /* Find the timeout on the list of pending ones, if it's still there. */ - LIST_LOOP (rest, *timeout_list) - { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); - if (timeout->id == id) - break; - } - - /* If we found it, remove it from the list and disable the pending - one-shot. */ - if (!NILP (rest)) - { - Lisp_Object op = XCAR (rest); - *timeout_list = - delq_no_quit_and_free_cons (op, *timeout_list); - if (async_p) - event_stream_remove_async_timeout (timeout->interval_id); - else - event_stream_remove_timeout (timeout->interval_id); - free_managed_opaque (Vtimeout_free_list, op); - } -} - -static int -event_stream_wakeup_pending_p (int id, int async_p) -{ - struct timeout *timeout; - Lisp_Object rest; - Lisp_Object timeout_list; - int found = 0; - - - if (async_p) - timeout_list = pending_async_timeout_list; - else - timeout_list = pending_timeout_list; - - /* Find the element on the list of pending ones, if it's still there. */ - LIST_LOOP (rest, timeout_list) - { - timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest)); - if (timeout->id == id) - { - found = 1; - break; - } - } - - return found; -} - - -/**** Asynch. timeout functions (see also signal.c) ****/ - -#if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT) -extern int poll_for_quit_id; -#endif - -#if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD) -extern int poll_for_sigchld_id; -#endif - -void -event_stream_deal_with_async_timeout (int interval_id) -{ - /* This function can GC */ - Lisp_Object humpty, dumpty; -#if ((!defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT)) \ - || defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD)) - int id = -#endif - event_stream_resignal_wakeup (interval_id, 1, &humpty, &dumpty); - -#if !defined (SIGIO) && !defined (DONT_POLL_FOR_QUIT) - if (id == poll_for_quit_id) - { - quit_check_signal_happened = 1; - quit_check_signal_tick_count++; - return; - } -#endif - -#if defined(HAVE_UNIX_PROCESSES) && !defined(SIGCHLD) - if (id == poll_for_sigchld_id) - { - kick_status_notify (); - return; - } -#endif - - /* call1 GC-protects its arguments */ - call1_trapping_errors ("Error in asynchronous timeout callback", - humpty, dumpty); -} - - -/**** Lisp-level timeout functions. ****/ - -static unsigned long -lisp_number_to_milliseconds (Lisp_Object secs, int allow_0) -{ -#ifdef LISP_FLOAT_TYPE - double fsecs; - CHECK_INT_OR_FLOAT (secs); - fsecs = XFLOATINT (secs); -#else - long fsecs; - CHECK_INT (secs); - fsecs = XINT (secs); -#endif - if (fsecs < 0) - signal_simple_error ("timeout is negative", secs); - if (!allow_0 && fsecs == 0) - signal_simple_error ("timeout is non-positive", secs); - if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000)) - signal_simple_error - ("timeout would exceed 32 bits when represented in milliseconds", secs); - - return (unsigned long) (1000 * fsecs); -} - -DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /* -Add a timeout, to be signaled after the timeout period has elapsed. -SECS is a number of seconds, expressed as an integer or a float. -FUNCTION will be called after that many seconds have elapsed, with one -argument, the given OBJECT. If the optional RESIGNAL argument is provided, -then after this timeout expires, `add-timeout' will automatically be called -again with RESIGNAL as the first argument. - -This function returns an object which is the id number of this particular -timeout. You can pass that object to `disable-timeout' to turn off the -timeout before it has been signalled. - -NOTE: Id numbers as returned by this function are in a distinct namespace -from those returned by `add-async-timeout'. This means that the same id -number could refer to a pending synchronous timeout and a different pending -asynchronous timeout, and that you cannot pass an id from `add-timeout' -to `disable-async-timeout', or vice-versa. - -The number of seconds may be expressed as a floating-point number, in which -case some fractional part of a second will be used. Caveat: the usable -timeout granularity will vary from system to system. - -Adding a timeout causes a timeout event to be returned by `next-event', and -the function will be invoked by `dispatch-event,' so if emacs is in a tight -loop, the function will not be invoked until the next call to sit-for or -until the return to top-level (the same is true of process filters). - -If you need to have a timeout executed even when XEmacs is in the midst of -running Lisp code, use `add-async-timeout'. - -WARNING: if you are thinking of calling add-timeout from inside of a -callback function as a way of resignalling a timeout, think again. There -is a race condition. That's why the RESIGNAL argument exists. -*/ - (secs, function, object, resignal)) -{ - unsigned long msecs = lisp_number_to_milliseconds (secs, 0); - unsigned long msecs2 = (NILP (resignal) ? 0 : - lisp_number_to_milliseconds (resignal, 0)); - int id; - Lisp_Object lid; - id = event_stream_generate_wakeup (msecs, msecs2, function, object, 0); - lid = make_int (id); - if (id != XINT (lid)) abort (); - return lid; -} - -DEFUN ("disable-timeout", Fdisable_timeout, 1, 1, 0, /* -Disable a timeout from signalling any more. -ID should be a timeout id number as returned by `add-timeout'. If ID -corresponds to a one-shot timeout that has already signalled, nothing -will happen. - -It will not work to call this function on an id number returned by -`add-async-timeout'. Use `disable-async-timeout' for that. -*/ - (id)) -{ - CHECK_INT (id); - event_stream_disable_wakeup (XINT (id), 0); - return Qnil; -} - -DEFUN ("add-async-timeout", Fadd_async_timeout, 3, 4, 0, /* -Add an asynchronous timeout, to be signaled after an interval has elapsed. -SECS is a number of seconds, expressed as an integer or a float. -FUNCTION will be called after that many seconds have elapsed, with one -argument, the given OBJECT. If the optional RESIGNAL argument is provided, -then after this timeout expires, `add-async-timeout' will automatically be -called again with RESIGNAL as the first argument. - -This function returns an object which is the id number of this particular -timeout. You can pass that object to `disable-async-timeout' to turn off -the timeout before it has been signalled. - -NOTE: Id numbers as returned by this function are in a distinct namespace -from those returned by `add-timeout'. This means that the same id number -could refer to a pending synchronous timeout and a different pending -asynchronous timeout, and that you cannot pass an id from -`add-async-timeout' to `disable-timeout', or vice-versa. - -The number of seconds may be expressed as a floating-point number, in which -case some fractional part of a second will be used. Caveat: the usable -timeout granularity will vary from system to system. - -Adding an asynchronous timeout causes the function to be invoked as soon -as the timeout occurs, even if XEmacs is in the midst of executing some -other code. (This is unlike the synchronous timeouts added with -`add-timeout', where the timeout will only be signalled when XEmacs is -waiting for events, i.e. the next return to top-level or invocation of -`sit-for' or related functions.) This means that the function that is -called *must* not signal an error or change any global state (e.g. switch -buffers or windows) except when locking code is in place to make sure -that race conditions don't occur in the interaction between the -asynchronous timeout function and other code. - -Under most circumstances, you should use `add-timeout' instead, as it is -much safer. Asynchronous timeouts should only be used when such behavior -is really necessary. - -Asynchronous timeouts are blocked and will not occur when `inhibit-quit' -is non-nil. As soon as `inhibit-quit' becomes nil again, any pending -asynchronous timeouts will get called immediately. (Multiple occurrences -of the same asynchronous timeout are not queued, however.) While the -callback function of an asynchronous timeout is invoked, `inhibit-quit' -is automatically bound to non-nil, and thus other asynchronous timeouts -will be blocked unless the callback function explicitly sets `inhibit-quit' -to nil. - -WARNING: if you are thinking of calling `add-async-timeout' from inside of a -callback function as a way of resignalling a timeout, think again. There -is a race condition. That's why the RESIGNAL argument exists. -*/ - (secs, function, object, resignal)) -{ - unsigned long msecs = lisp_number_to_milliseconds (secs, 0); - unsigned long msecs2 = (NILP (resignal) ? 0 : - lisp_number_to_milliseconds (resignal, 0)); - int id; - Lisp_Object lid; - id = event_stream_generate_wakeup (msecs, msecs2, function, object, 1); - lid = make_int (id); - if (id != XINT (lid)) abort (); - return lid; -} - -DEFUN ("disable-async-timeout", Fdisable_async_timeout, 1, 1, 0, /* -Disable an asynchronous timeout from signalling any more. -ID should be a timeout id number as returned by `add-async-timeout'. If ID -corresponds to a one-shot timeout that has already signalled, nothing -will happen. - -It will not work to call this function on an id number returned by -`add-timeout'. Use `disable-timeout' for that. -*/ - (id)) -{ - CHECK_INT (id); - event_stream_disable_wakeup (XINT (id), 1); - return Qnil; -} - - -/**********************************************************************/ -/* enqueuing and dequeuing events */ -/**********************************************************************/ - -/* Add an event to the back of the command-event queue: it will be the next - event read after all pending events. This only works on keyboard, - mouse-click, misc-user, and eval events. - */ -static void -enqueue_command_event (Lisp_Object event) -{ - enqueue_event (event, &command_event_queue, &command_event_queue_tail); -} - -static Lisp_Object -dequeue_command_event (void) -{ - return dequeue_event (&command_event_queue, &command_event_queue_tail); -} - -/* put the event on the typeahead queue, unless - the event is the quit char, in which case the `QUIT' - which will occur on the next trip through this loop is - all the processing we should do - leaving it on the queue - would cause the quit to be processed twice. - */ -static void -enqueue_command_event_1 (Lisp_Object event_to_copy) -{ - /* do not call check_quit() here. Vquit_flag was set in - next_event_internal. */ - if (NILP (Vquit_flag)) - enqueue_command_event (Fcopy_event (event_to_copy, Qnil)); -} - -void -enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = magic_eval_event; - /* channel for magic_eval events is nil */ - XEVENT (event)->event.magic_eval.internal_function = fun; - XEVENT (event)->event.magic_eval.object = object; - enqueue_command_event (event); -} - -DEFUN ("enqueue-eval-event", Fenqueue_eval_event, 2, 2, 0, /* -Add an eval event to the back of the eval event queue. -When this event is dispatched, FUNCTION (which should be a function -of one argument) will be called with OBJECT as its argument. -See `next-event' for a description of event types and how events -are received. -*/ - (function, object)) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = eval_event; - /* channel for eval events is nil */ - XEVENT (event)->event.eval.function = function; - XEVENT (event)->event.eval.object = object; - enqueue_command_event (event); - - return event; -} - -Lisp_Object -enqueue_misc_user_event (Lisp_Object channel, Lisp_Object function, - Lisp_Object object) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = channel; - XEVENT (event)->event.misc.function = function; - XEVENT (event)->event.misc.object = object; - XEVENT (event)->event.misc.button = 0; - XEVENT (event)->event.misc.modifiers = 0; - XEVENT (event)->event.misc.x = -1; - XEVENT (event)->event.misc.y = -1; - enqueue_command_event (event); - - return event; -} - -Lisp_Object -enqueue_misc_user_event_pos (Lisp_Object channel, Lisp_Object function, - Lisp_Object object, - int button, int modifiers, int x, int y) -{ - Lisp_Object event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = channel; - XEVENT (event)->event.misc.function = function; - XEVENT (event)->event.misc.object = object; - XEVENT (event)->event.misc.button = button; - XEVENT (event)->event.misc.modifiers = modifiers; - XEVENT (event)->event.misc.x = x; - XEVENT (event)->event.misc.y = y; - enqueue_command_event (event); - - return event; -} - - -/**********************************************************************/ -/* focus-event handling */ -/**********************************************************************/ - -/* - -Ben's capsule lecture on focus: - -In FSFmacs `select-frame' never changes the window-manager frame -focus. All it does is change the "selected frame". This is similar -to what happens when we call `select-device' or `select-console'. -Whenever an event comes in (including a keyboard event), its frame is -selected; therefore, evaluating `select-frame' in *scratch* won't -cause any effects because the next received event (in the same frame) -will cause a switch back to the frame displaying *scratch*. - -Whenever a focus-change event is received from the window manager, it -generates a `switch-frame' event, which causes the Lisp function -`handle-switch-frame' to get run. This basically just runs -`select-frame' (see below, however). - -In FSFmacs, if you want to have an operation run when a frame is -selected, you supply an event binding for `switch-frame' (and then -maybe call `handle-switch-frame', or something ...). - -In XEmacs, we *do* change the window-manager frame focus as a result -of `select-frame', but not until the next time an event is received, -so that a function that momentarily changes the selected frame won't -cause WM focus flashing. (#### There's something not quite right here; -this is causing the wrong-cursor-focus problems that you occasionally -see. But the general idea is correct.) This approach is winning for -people who use the explicit-focus model, but is trickier to implement. - -We also don't make the `switch-frame' event visible but instead have -`select-frame-hook', which is a better approach. - -There is the problem of surrogate minibuffers, where when we enter the -minibuffer, you essentially want to temporarily switch the WM focus to -the frame with the minibuffer, and switch it back when you exit the -minibuffer. - -FSFmacs solves this with the crockish `redirect-frame-focus', which -says "for keyboard events received from FRAME, act like they're -coming from FOCUS-FRAME". I think what this means is that, when -a keyboard event comes in and the event manager is about to select the -event's frame, if that frame has its focus redirected, the redirected-to -frame is selected instead. That way, if you're in a minibufferless -frame and enter the minibuffer, then all Lisp functions that run see -the selected frame as the minibuffer's frame rather than the minibufferless -frame you came from, so that (e.g.) your typing actually appears in -the minibuffer's frame and things behave sanely. - -There's also some weird logic that switches the redirected frame focus -from one frame to another if Lisp code explicitly calls `select-frame' -\(but not if `handle-switch-frame' is called), and saves and restores -the frame focus in window configurations, etc. etc. All of this logic -is heavily #if 0'd, with lots of comments saying "No, this approach -doesn't seem to work, so I'm trying this ... is it reasonable? -Well, I'm not sure ..." that are a red flag indicating crockishness. - -Because of our way of doing things, we can avoid all this crock. -Keyboard events never cause a select-frame (who cares what frame -they're associated with? They come from a console, only). We change -the actual WM focus to a surrogate minibuffer frame, so we don't have -to do any internal redirection. In order to get the focus back, -I took the approach in minibuf.el of just checking to see if the -frame we moved to is still the selected frame, and move back to the -old one if so. Conceivably we might have to do the weird "tracking" -that FSFmacs does when `select-frame' is called, but I don't think -so. If the selected frame moved from the minibuffer frame, then -we just leave it there, figuring that someone knows what they're -doing. Because we don't have any redirection recorded anywhere, -it's safe to do this, and we don't end up with unwanted redirection. - -*/ - -static void -run_select_frame_hook (void) -{ - run_hook (Qselect_frame_hook); -} - -static void -run_deselect_frame_hook (void) -{ -#if 0 /* unclean! FSF calls this at all sorts of random places, - including a bunch of places in their mouse.el. If this - is implemented, it has to be done cleanly. */ - run_hook (Qmouse_leave_buffer_hook); /* #### Correct? It's also - called in `call-interactively'. - Does this mean it will be - called twice? Oh well, FSF - bug -- FSF calls it in - `handle-switch-frame', - which is approximately the - same as the caller of this - function. */ -#endif - run_hook (Qdeselect_frame_hook); -} - -/* When select-frame is called and focus_follows_mouse is false, we want - to tell the window system that the focus should be changed to point to - the new frame. However, - sometimes Lisp functions will temporarily change the selected frame - (e.g. to call a function that operates on the selected frame), - and it's annoying if this focus-change happens exactly when - select-frame is called, because then you get some flickering of the - window-manager border and perhaps other undesirable results. We - really only want to change the focus when we're about to retrieve - an event from the user. To do this, we keep track of the frame - where the window-manager focus lies on, and just before waiting - for user events, check the currently selected frame and change - the focus as necessary. - - On the other hand, if focus_follows_mouse is true, we need to switch the - selected frame back to the frame with window manager focus just before we - execute the next command in Fcommand_loop_1, just as the selected buffer is - reverted after a set-buffer. - - Both cases are handled by this function. It must be called as appropriate - from these two places, depending on the value of focus_follows_mouse. */ - -void -investigate_frame_change (void) -{ - Lisp_Object devcons, concons; - - /* if the selected frame was changed, change the window-system - focus to the new frame. We don't do it when select-frame was - called, to avoid flickering and other unwanted side effects when - the frame is just changed temporarily. */ - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - struct device *d = XDEVICE (XCAR (devcons)); - Lisp_Object sel_frame = DEVICE_SELECTED_FRAME (d); - - /* You'd think that maybe we should use FRAME_WITH_FOCUS_REAL, - but that can cause us to end up in an infinite loop focusing - between two frames. It seems that since the call to `select-frame' - in emacs_handle_focus_change_final() is based on the _FOR_HOOKS - value, we need to do so too. */ - if (!NILP (sel_frame) && - !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) && - !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) && - !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame)) - { - /* At this point, we know that the frame has been changed. Now, if - * focus_follows_mouse is not set, we finish off the frame change, - * so that user events will now come from the new frame. Otherwise, - * if focus_follows_mouse is set, no gratuitous frame changing - * should take place. Set the focus back to the frame which was - * originally selected for user input. - */ - if (!focus_follows_mouse) - { - /* prevent us from issuing the same request more than once */ - DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = sel_frame; - MAYBE_DEVMETH (d, focus_on_frame, (XFRAME (sel_frame))); - } - else - { - Lisp_Object old_frame = Qnil; - - /* #### Do we really want to check OUGHT ?? - * It seems to make sense, though I have never seen us - * get here and have it be non-nil. - */ - if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d))) - old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d); - else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d))) - old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); - - /* #### Can old_frame ever be NIL? play it safe.. */ - if (!NILP (old_frame)) - { - /* Fselect_frame is not really the right thing: it frobs the - * buffer stack. But there's no easy way to do the right - * thing, and this code already had this problem anyway. - */ - Fselect_frame (old_frame); - } - } - } - } -} - -static Lisp_Object -cleanup_after_missed_defocusing (Lisp_Object frame) -{ - if (FRAMEP (frame) && FRAME_LIVE_P (XFRAME (frame))) - Fselect_frame (frame); - return Qnil; -} - -void -emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev) -{ - Lisp_Object frame = Fcar (frame_inp_and_dev); - Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev)); - int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev))); - struct device *d; - - if (!DEVICE_LIVE_P (XDEVICE (device))) - return; - else - d = XDEVICE (device); - - /* Any received focus-change notifications render invalid any - pending focus-change requests. */ - DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil; - if (in_p) - { - Lisp_Object focus_frame; - - if (!FRAME_LIVE_P (XFRAME (frame))) - return; - else - focus_frame = DEVICE_FRAME_WITH_FOCUS_REAL (d); - - /* Mark the minibuffer as changed to make sure it gets updated - properly if the echo area is active. */ - { - struct window *w = XWINDOW (FRAME_MINIBUF_WINDOW (XFRAME (frame))); - MARK_WINDOWS_CHANGED (w); - } - - if (FRAMEP (focus_frame) && !EQ (frame, focus_frame)) - { - /* Oops, we missed a focus-out event. */ - DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil; - redisplay_redraw_cursor (XFRAME (focus_frame), 1); - } - DEVICE_FRAME_WITH_FOCUS_REAL (d) = frame; - if (!EQ (frame, focus_frame)) - { - redisplay_redraw_cursor (XFRAME (frame), 1); - } - } - else - { - /* We ignore the frame reported in the event. If it's different - from where we think the focus was, oh well -- we messed up. - Nonetheless, we pretend we were right, for sensible behavior. */ - frame = DEVICE_FRAME_WITH_FOCUS_REAL (d); - if (!NILP (frame)) - { - DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil; - - if (FRAME_LIVE_P (XFRAME (frame))) - redisplay_redraw_cursor (XFRAME (frame), 1); - } - } -} - -/* Called from the window-system-specific code when we receive a - notification that the focus lies on a particular frame. - Argument is a cons: (frame . (device . in-p)) where in-p is non-nil - for focus-in. - */ -void -emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev) -{ - Lisp_Object frame = Fcar (frame_inp_and_dev); - Lisp_Object device = Fcar (Fcdr (frame_inp_and_dev)); - int in_p = !NILP (Fcdr (Fcdr (frame_inp_and_dev))); - struct device *d; - int count; - - if (!DEVICE_LIVE_P (XDEVICE (device))) - return; - else - d = XDEVICE (device); - - if (in_p) - { - Lisp_Object focus_frame; - - if (!FRAME_LIVE_P (XFRAME (frame))) - return; - else - focus_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); - - DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = frame; - if (FRAMEP (focus_frame) && !EQ (frame, focus_frame)) - { - /* Oops, we missed a focus-out event. */ - Fselect_frame (focus_frame); - /* Do an unwind-protect in case an error occurs in - the deselect-frame-hook */ - count = specpdl_depth (); - record_unwind_protect (cleanup_after_missed_defocusing, frame); - run_deselect_frame_hook (); - unbind_to (count, Qnil); - /* the cleanup method changed the focus frame to nil, so - we need to reflect this */ - focus_frame = Qnil; - } - else - Fselect_frame (frame); - if (!EQ (frame, focus_frame)) - run_select_frame_hook (); - } - else - { - /* We ignore the frame reported in the event. If it's different - from where we think the focus was, oh well -- we messed up. - Nonetheless, we pretend we were right, for sensible behavior. */ - frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d); - if (!NILP (frame)) - { - DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil; - run_deselect_frame_hook (); - } - } -} - - -/**********************************************************************/ -/* retrieving the next event */ -/**********************************************************************/ - -static int in_single_console; - -/* #### These functions don't currently do anything. */ -void -single_console_state (void) -{ - in_single_console = 1; -} - -void -any_console_state (void) -{ - in_single_console = 0; -} - -int -in_single_console_state (void) -{ - return in_single_console; -} - -/* the number of keyboard characters read. callint.c wants this. */ -Charcount num_input_chars; - -static void -next_event_internal (Lisp_Object target_event, int allow_queued) -{ - struct gcpro gcpro1; - /* QUIT; This is incorrect - the caller must do this because some - callers (ie, Fnext_event()) do not want to QUIT. */ - - assert (NILP (XEVENT_NEXT (target_event))); - - GCPRO1 (target_event); - - /* When focus_follows_mouse is nil, if a frame change took place, we need - * to actually switch window manager focus to the selected window now. - */ - if (!focus_follows_mouse) - investigate_frame_change (); - - if (allow_queued && !NILP (command_event_queue)) - { - Lisp_Object event = dequeue_command_event (); - Fcopy_event (event, target_event); - Fdeallocate_event (event); - DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event); - } - else - { - struct Lisp_Event *e = XEVENT (target_event); - - /* The command_event_queue was empty. Wait for an event. */ - event_stream_next_event (e); - /* If this was a timeout, then we need to extract some data - out of the returned closure and might need to resignal - it. */ - if (e->event_type == timeout_event) - { - Lisp_Object tristan, isolde; - - e->event.timeout.id_number = - event_stream_resignal_wakeup (e->event.timeout.interval_id, 0, - &tristan, &isolde); - - e->event.timeout.function = tristan; - e->event.timeout.object = isolde; - /* next_event_internal() doesn't print out timeout events - because of the extra info we just set. */ - DEBUG_PRINT_EMACS_EVENT ("real, timeout", target_event); - } - - /* If we read a ^G, then set quit-flag but do not discard the ^G. - The callers of next_event_internal() will do one of two things: - - -- set Vquit_flag to Qnil. (next-event does this.) This will - cause the ^G to be treated as a normal keystroke. - -- not change Vquit_flag but attempt to enqueue the ^G, at - which point it will be discarded. The next time QUIT is - called, it will notice that Vquit_flag was set. - - */ - if (e->event_type == key_press_event && - event_matches_key_specifier_p - (e, make_char (CONSOLE_QUIT_CHAR (XCONSOLE (EVENT_CHANNEL (e)))))) - { - Vquit_flag = Qt; - } - } - - UNGCPRO; -} - -static void -run_pre_idle_hook (void) -{ - if (!NILP (Vpre_idle_hook) - && !detect_input_pending ()) - safe_run_hook_trapping_errors - ("Error in `pre-idle-hook' (setting hook to nil)", - Qpre_idle_hook, 1); -} - -static void push_this_command_keys (Lisp_Object event); -static void push_recent_keys (Lisp_Object event); -static void dribble_out_event (Lisp_Object event); -static void execute_internal_event (Lisp_Object event); - -DEFUN ("next-event", Fnext_event, 0, 2, 0, /* -Return the next available event. -Pass this object to `dispatch-event' to handle it. -In most cases, you will want to use `next-command-event', which returns -the next available "user" event (i.e. keypress, button-press, -button-release, or menu selection) instead of this function. - -If EVENT is non-nil, it should be an event object and will be filled in -and returned; otherwise a new event object will be created and returned. -If PROMPT is non-nil, it should be a string and will be displayed in the -echo area while this function is waiting for an event. - -The next available event will be - --- any events in `unread-command-events' or `unread-command-event'; else --- the next event in the currently executing keyboard macro, if any; else --- an event queued by `enqueue-eval-event', if any; else --- the next available event from the window system or terminal driver. - -In the last case, this function will block until an event is available. - -The returned event will be one of the following types: - --- a key-press event. --- a button-press or button-release event. --- a misc-user-event, meaning the user selected an item on a menu or used - the scrollbar. --- a process event, meaning that output from a subprocess is available. --- a timeout event, meaning that a timeout has elapsed. --- an eval event, which simply causes a function to be executed when the - event is dispatched. Eval events are generated by `enqueue-eval-event' - or by certain other conditions happening. --- a magic event, indicating that some window-system-specific event - happened (such as a focus-change notification) that must be handled - synchronously with other events. `dispatch-event' knows what to do with - these events. -*/ - (event, prompt)) -{ - /* This function can call lisp */ - /* #### We start out using the selected console before an event - is received, for echoing the partially completed command. - This is most definitely wrong -- there needs to be a separate - echo area for each console! */ - struct console *con = XCONSOLE (Vselected_console); - struct command_builder *command_builder = - XCOMMAND_BUILDER (con->command_builder); - int store_this_key = 0; - struct gcpro gcpro1; -#ifdef LWLIB_MENUBARS_LUCID - extern int in_menu_callback; /* defined in menubar-x.c */ -#endif /* LWLIB_MENUBARS_LUCID */ - - GCPRO1 (event); - /* DO NOT do QUIT anywhere within this function or the functions it calls. - We want to read the ^G as an event. */ - -#ifdef LWLIB_MENUBARS_LUCID - /* - * #### Fix the menu code so this isn't necessary. - * - * We cannot allow the lwmenu code to be reentered, because the - * code is not written to be reentrant and will crash. Therefore - * paths from the menu callbacks back into the menu code have to - * be blocked. Fnext_event is the normal path into the menu code, - * so we signal an error here. - */ - if (in_menu_callback) - error ("Attempt to call next-event inside menu callback"); -#endif /* LWLIB_MENUBARS_LUCID */ - - if (NILP (event)) - event = Fmake_event (Qnil, Qnil); - else - CHECK_LIVE_EVENT (event); - - if (!NILP (prompt)) - { - Bytecount len; - CHECK_STRING (prompt); - - len = XSTRING_LENGTH (prompt); - if (command_builder->echo_buf_length < len) - len = command_builder->echo_buf_length - 1; - memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len); - command_builder->echo_buf[len] = 0; - command_builder->echo_buf_index = len; - echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)), - command_builder->echo_buf, - Qnil, 0, - command_builder->echo_buf_index, - Qcommand); - } - - start_over_and_avoid_hosage: - - /* If there is something in unread-command-events, simply return it. - But do some error checking to make sure the user hasn't put something - in the unread-command-events that they shouldn't have. - This does not update this-command-keys and recent-keys. - */ - if (!NILP (Vunread_command_events)) - { - if (!CONSP (Vunread_command_events)) - { - Vunread_command_events = Qnil; - signal_error (Qwrong_type_argument, - list3 (Qconsp, Vunread_command_events, - Qunread_command_events)); - } - else - { - Lisp_Object e = XCAR (Vunread_command_events); - Vunread_command_events = XCDR (Vunread_command_events); - if (!EVENTP (e) || !command_event_p (e)) - signal_error (Qwrong_type_argument, - list3 (Qcommand_event_p, e, Qunread_command_events)); - redisplay (); - if (!EQ (e, event)) - Fcopy_event (e, event); - DEBUG_PRINT_EMACS_EVENT ("unread-command-events", event); - } - } - - /* Do similar for unread-command-event (obsoleteness support). */ - else if (!NILP (Vunread_command_event)) - { - Lisp_Object e = Vunread_command_event; - Vunread_command_event = Qnil; - - if (!EVENTP (e) || !command_event_p (e)) - { - signal_error (Qwrong_type_argument, - list3 (Qeventp, e, Qunread_command_event)); - } - if (!EQ (e, event)) - Fcopy_event (e, event); - redisplay (); - DEBUG_PRINT_EMACS_EVENT ("unread-command-event", event); - } - - /* If we're executing a keyboard macro, take the next event from that, - and update this-command-keys and recent-keys. - Note that the unread-command-events take precedence over kbd macros. - */ - else - { - if (!NILP (Vexecuting_macro)) - { - redisplay (); - pop_kbd_macro_event (event); /* This throws past us at - end-of-macro. */ - store_this_key = 1; - DEBUG_PRINT_EMACS_EVENT ("keyboard macro", event); - } - /* Otherwise, read a real event, possibly from the - command_event_queue, and update this-command-keys and - recent-keys. */ - else - { - run_pre_idle_hook (); - redisplay (); - next_event_internal (event, 1); - Vquit_flag = Qnil; /* Read C-g as an event. */ - store_this_key = 1; - } - } - - status_notify (); /* Notice process change */ - -#ifdef C_ALLOCA - alloca (0); /* Cause a garbage collection now */ - /* Since we can free the most stuff here - * (since this is typically called from - * the command-loop top-level). */ -#endif /* C_ALLOCA */ - - if (object_dead_p (XEVENT (event)->channel)) - /* event_console_or_selected may crash if the channel is dead. - Best just to eat it and get the next event. */ - goto start_over_and_avoid_hosage; - - /* OK, now we can stop the selected-console kludge and use the - actual console from the event. */ - con = event_console_or_selected (event); - command_builder = XCOMMAND_BUILDER (con->command_builder); - - switch (XEVENT_TYPE (event)) - { - default: - goto RETURN; - case button_release_event: - case misc_user_event: - /* don't echo menu accelerator keys */ - reset_key_echo (command_builder, 1); - goto EXECUTE_KEY; - case button_press_event: /* key or mouse input can trigger prompting */ - goto STORE_AND_EXECUTE_KEY; - case key_press_event: /* any key input can trigger autosave */ - break; - } - - maybe_do_auto_save (); - num_input_chars++; - STORE_AND_EXECUTE_KEY: - if (store_this_key) - { - echo_key_event (command_builder, event); - } - - EXECUTE_KEY: - /* Store the last-input-event. The semantics of this is that it is - the thing most recently returned by next-command-event. It need - not have come from the keyboard or a keyboard macro, it may have - come from unread-command-events. It's always a command-event (a - key, click, or menu selection), never a motion or process event. - */ - if (!EVENTP (Vlast_input_event)) - Vlast_input_event = Fmake_event (Qnil, Qnil); - if (XEVENT_TYPE (Vlast_input_event) == dead_event) - { - Vlast_input_event = Fmake_event (Qnil, Qnil); - error ("Someone deallocated last-input-event!"); - } - if (! EQ (event, Vlast_input_event)) - Fcopy_event (event, Vlast_input_event); - - /* last-input-char and last-input-time are derived from - last-input-event. - Note that last-input-char will never have its high-bit set, in an - effort to sidestep the ambiguity between M-x and oslash. - */ - Vlast_input_char = Fevent_to_character (Vlast_input_event, - Qnil, Qnil, Qnil); - { - EMACS_TIME t; - EMACS_GET_TIME (t); - if (!CONSP (Vlast_input_time)) - Vlast_input_time = Fcons (Qnil, Qnil); - XCAR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 16) & 0xffff); - XCDR (Vlast_input_time) = make_int ((EMACS_SECS (t) >> 0) & 0xffff); - if (!CONSP (Vlast_command_event_time)) - Vlast_command_event_time = list3 (Qnil, Qnil, Qnil); - XCAR (Vlast_command_event_time) = - make_int ((EMACS_SECS (t) >> 16) & 0xffff); - XCAR (XCDR (Vlast_command_event_time)) = - make_int ((EMACS_SECS (t) >> 0) & 0xffff); - XCAR (XCDR (XCDR (Vlast_command_event_time))) - = make_int (EMACS_USECS (t)); - } - /* If this key came from the keyboard or from a keyboard macro, then - it goes into the recent-keys and this-command-keys vectors. - If this key came from the keyboard, and we're defining a keyboard - macro, then it goes into the macro. - */ - if (store_this_key) - { - push_this_command_keys (event); - if (!inhibit_input_event_recording) - push_recent_keys (event); - dribble_out_event (event); - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - { - if (!EVENTP (command_builder->current_events)) - finalize_kbd_macro_chars (con); - store_kbd_macro_event (event); - } - } - /* If this is the help char and there is a help form, then execute the - help form and swallow this character. This is the only place where - calling Fnext_event() can cause arbitrary lisp code to run. Note - that execute_help_form() calls Fnext_command_event(), which calls - this function, as well as Fdispatch_event. - */ - if (!NILP (Vhelp_form) && - event_matches_key_specifier_p (XEVENT (event), Vhelp_char)) - execute_help_form (command_builder, event); - - RETURN: - UNGCPRO; - return event; -} - -DEFUN ("next-command-event", Fnext_command_event, 0, 2, 0, /* -Return the next available "user" event. -Pass this object to `dispatch-event' to handle it. - -If EVENT is non-nil, it should be an event object and will be filled in -and returned; otherwise a new event object will be created and returned. -If PROMPT is non-nil, it should be a string and will be displayed in the -echo area while this function is waiting for an event. - -The event returned will be a keyboard, mouse press, or mouse release event. -If there are non-command events available (mouse motion, sub-process output, -etc) then these will be executed (with `dispatch-event') and discarded. This -function is provided as a convenience; it is roughly equivalent to the lisp code - - (while (progn - (next-event event prompt) - (not (or (key-press-event-p event) - (button-press-event-p event) - (button-release-event-p event) - (misc-user-event-p event)))) - (dispatch-event event)) - -but it also makes a provision for displaying keystrokes in the echo area. -*/ - (event, prompt)) -{ - /* This function can GC */ - struct gcpro gcpro1; - GCPRO1 (event); - maybe_echo_keys (XCOMMAND_BUILDER - (XCONSOLE (Vselected_console)-> - command_builder), 0); /* #### This sucks bigtime */ - for (;;) - { - event = Fnext_event (event, prompt); - if (command_event_p (event)) - break; - else - execute_internal_event (event); - } - UNGCPRO; - return event; -} - -static void -reset_current_events (struct command_builder *command_builder) -{ - Lisp_Object event = command_builder->current_events; - reset_command_builder_event_chain (command_builder); - if (EVENTP (event)) - deallocate_event_chain (event); -} - -DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* -Discard any pending "user" events. -Also cancel any kbd macro being defined. -A user event is a key press, button press, button release, or -"misc-user" event (menu selection or scrollbar action). -*/ - ()) -{ - /* This throws away user-input on the queue, but doesn't process any - events. Calling dispatch_event() here leads to a race condition. - */ - Lisp_Object event = Fmake_event (Qnil, Qnil); - Lisp_Object head = Qnil, tail = Qnil; - Lisp_Object oiq = Vinhibit_quit; - struct gcpro gcpro1, gcpro2; - /* #### not correct here with Vselected_console? Should - discard-input take a console argument, or maybe map over - all consoles? */ - struct console *con = XCONSOLE (Vselected_console); - - /* next_event_internal() can cause arbitrary Lisp code to be evalled */ - GCPRO2 (event, oiq); - Vinhibit_quit = Qt; - /* If a macro was being defined then we have to mark the modeline - has changed to ensure that it gets updated correctly. */ - if (!NILP (con->defining_kbd_macro)) - MARK_MODELINE_CHANGED; - con->defining_kbd_macro = Qnil; - reset_current_events (XCOMMAND_BUILDER (con->command_builder)); - - while (!NILP (command_event_queue) - || event_stream_event_pending_p (1)) - { - /* This will take stuff off the command_event_queue, or read it - from the event_stream, but it will not block. - */ - next_event_internal (event, 1); - Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it). - It is vitally important that we reset - Vquit_flag here. Otherwise, if we're - reading from a TTY console, - maybe_read_quit_event() will notice - that C-g has been set and send us - another C-g. That will cause us - to get right back here, and read - another C-g, ad infinitum ... */ - - /* If the event is a user event, ignore it. */ - if (!command_event_p (event)) - { - /* Otherwise, chain the event onto our list of events not to ignore, - and keep reading until the queue is empty. This does not mean - that if a subprocess is generating an infinite amount of output, - we will never terminate (*provided* that the behavior of - next_event_cb() is correct -- see the comment in events.h), - because this loop ends as soon as there are no more user events - on the command_event_queue or event_stream. - */ - enqueue_event (Fcopy_event (event, Qnil), &head, &tail); - } - } - - if (!NILP (command_event_queue) || !NILP (command_event_queue_tail)) - abort (); - - /* Now tack our chain of events back on to the front of the queue. - Actually, since the queue is now drained, we can just replace it. - The effect of this will be that we have deleted all user events - from the input stream without changing the relative ordering of - any other events. (Some events may have been taken from the - event_stream and added to the command_event_queue, however.) - - At this time, the command_event_queue will contain only eval_events. - */ - - command_event_queue = head; - command_event_queue_tail = tail; - - Fdeallocate_event (event); - UNGCPRO; - - Vinhibit_quit = oiq; - return Qnil; -} - - -/**********************************************************************/ -/* pausing until an action occurs */ -/**********************************************************************/ - -/* This is used in accept-process-output, sleep-for and sit-for. - Before running any process_events in these routines, we set - recursive_sit_for to Qt, and use this unwind protect to reset it to - Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will - cause it to return immediately. - - All of these routines install timeouts, so we clear the installed - timeout as well. - - Note: It's very easy to break the desired behaviors of these - 3 routines. If you make any changes to anything in this area, run - the regression tests at the bottom of the file. -- dmoore */ - - -static Lisp_Object -sit_for_unwind (Lisp_Object timeout_id) -{ - if (!NILP(timeout_id)) - Fdisable_timeout (timeout_id); - - recursive_sit_for = Qnil; - return Qnil; -} - -/* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)? - */ - -DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /* -Allow any pending output from subprocesses to be read by Emacs. -It is read into the process' buffers or given to their filter functions. -Non-nil arg PROCESS means do not return until some output has been received - from PROCESS. Nil arg PROCESS means do not return until some output has - been received from any process. -If the second arg is non-nil, it is the maximum number of seconds to wait: - this function will return after that much time even if no input has arrived - from PROCESS. This argument may be a float, meaning wait some fractional - part of a second. -If the third arg is non-nil, it is a number of milliseconds that is added - to the second arg. (This exists only for compatibility.) -Return non-nil iff we received any output before the timeout expired. -*/ - (process, timeout_secs, timeout_msecs)) -{ - /* This function can GC */ - struct gcpro gcpro1, gcpro2; - Lisp_Object event = Qnil; - Lisp_Object result = Qnil; - int timeout_id = -1; - int timeout_enabled = 0; - int done = 0; - struct buffer *old_buffer = current_buffer; - int count; - - /* We preserve the current buffer but nothing else. If a focus - change alters the selected window then the top level event loop - will eventually alter current_buffer to match. In the mean time - we don't want to mess up whatever called this function. */ - - if (!NILP (process)) - CHECK_PROCESS (process); - - GCPRO2 (event, process); - - if (!NILP (timeout_secs) || !NILP (timeout_msecs)) - { - unsigned long msecs = 0; - if (!NILP (timeout_secs)) - msecs = lisp_number_to_milliseconds (timeout_secs, 1); - if (!NILP (timeout_msecs)) - { - CHECK_NATNUM (timeout_msecs); - msecs += XINT (timeout_msecs); - } - if (msecs) - { - timeout_id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); - timeout_enabled = 1; - } - } - - event = Fmake_event (Qnil, Qnil); - - count = specpdl_depth (); - record_unwind_protect (sit_for_unwind, - timeout_enabled ? make_int (timeout_id) : Qnil); - recursive_sit_for = Qt; - - while (!done && - ((NILP (process) && timeout_enabled) || - (NILP (process) && event_stream_event_pending_p (0)) || - (!NILP (process)))) - /* Calling detect_input_pending() is the wrong thing here, because - that considers the Vunread_command_events and command_event_queue. - We don't need to look at the command_event_queue because we are - only interested in process events, which don't go on that. In - fact, we can't read from it anyway, because we put stuff on it. - - Note that event_stream->event_pending_p must be called in such - a way that it says whether any events *of any kind* are ready, - not just user events, or (accept-process-output nil) will fail - to dispatch any process events that may be on the queue. It is - not clear to me that this is important, because the top-level - loop will process it, and I don't think that there is ever a - time when one calls accept-process-output with a nil argument - and really need the processes to be handled. */ - { - /* If our timeout has arrived, we move along. */ - if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0)) - { - timeout_enabled = 0; - done = 1; /* We're done. */ - continue; /* Don't call next_event_internal */ - } - - QUIT; /* next_event_internal() does not QUIT, so check for ^G - before reading output from the process - this makes it - less likely that the filter will actually be aborted. - */ - - next_event_internal (event, 0); - /* If C-g was pressed while we were waiting, Vquit_flag got - set and next_event_internal() also returns C-g. When - we enqueue the C-g below, it will get discarded. The - next time through, QUIT will be called and will signal a quit. */ - switch (XEVENT_TYPE (event)) - { - case process_event: - { - if (NILP (process) || - EQ (XEVENT (event)->event.process.process, process)) - { - done = 1; - /* RMS's version always returns nil when proc is nil, - and only returns t if input ever arrived on proc. */ - result = Qt; - } - - execute_internal_event (event); - break; - } - case timeout_event: - /* We execute the event even if it's ours, and notice that it's - happened above. */ - case pointer_motion_event: - case magic_event: - { - execute_internal_event (event); - break; - } - default: - { - enqueue_command_event_1 (event); - break; - } - } - } - - unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil); - - Fdeallocate_event (event); - UNGCPRO; - current_buffer = old_buffer; - return result; -} - -DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* -Pause, without updating display, for ARG seconds. -ARG may be a float, meaning pause for some fractional part of a second. - -It is recommended that you never call sleep-for from inside of a process - filter function or timer event (either synchronous or asynchronous). -*/ - (seconds)) -{ - /* This function can GC */ - unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); - int id; - Lisp_Object event = Qnil; - int count; - struct gcpro gcpro1; - - GCPRO1 (event); - - id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); - event = Fmake_event (Qnil, Qnil); - - count = specpdl_depth (); - record_unwind_protect (sit_for_unwind, make_int (id)); - recursive_sit_for = Qt; - - while (1) - { - /* If our timeout has arrived, we move along. */ - if (!event_stream_wakeup_pending_p (id, 0)) - goto DONE_LABEL; - - QUIT; /* next_event_internal() does not QUIT, so check for ^G - before reading output from the process - this makes it - less likely that the filter will actually be aborted. - */ - /* We're a generator of the command_event_queue, so we can't be a - consumer as well. We don't care about command and eval-events - anyway. - */ - next_event_internal (event, 0); /* blocks */ - /* See the comment in accept-process-output about Vquit_flag */ - switch (XEVENT_TYPE (event)) - { - case timeout_event: - /* We execute the event even if it's ours, and notice that it's - happened above. */ - case process_event: - case pointer_motion_event: - case magic_event: - { - execute_internal_event (event); - break; - } - default: - { - enqueue_command_event_1 (event); - break; - } - } - } - DONE_LABEL: - unbind_to (count, make_int (id)); - Fdeallocate_event (event); - UNGCPRO; - return Qnil; -} - -DEFUN ("sit-for", Fsit_for, 1, 2, 0, /* -Perform redisplay, then wait ARG seconds or until user input is available. -ARG may be a float, meaning a fractional part of a second. -Optional second arg non-nil means don't redisplay, just wait for input. -Redisplay is preempted as always if user input arrives, and does not - happen if input is available before it starts. -Value is t if waited the full time with no input arriving. - -If sit-for is called from within a process filter function or timer - event (either synchronous or asynchronous) it will return immediately. -*/ - (seconds, nodisplay)) -{ - /* This function can GC */ - unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); - Lisp_Object event, result; - struct gcpro gcpro1; - int id; - int count; - - /* The unread-command-events count as pending input */ - if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) - return Qnil; - - /* If the command-builder already has user-input on it (not eval events) - then that means we're done too. - */ - if (!NILP (command_event_queue)) - { - EVENT_CHAIN_LOOP (event, command_event_queue) - { - if (command_event_p (event)) - return Qnil; - } - } - - /* If we're in a macro, or noninteractive, or early in temacs, then - don't wait. */ - if (noninteractive || !NILP (Vexecuting_macro)) - return Qnil; - - /* Recursive call from a filter function or timeout handler. */ - if (!NILP(recursive_sit_for)) - { - if (!event_stream_event_pending_p (1) && NILP (nodisplay)) - { - run_pre_idle_hook (); - redisplay (); - } - return Qnil; - } - - - /* Otherwise, start reading events from the event_stream. - Do this loop at least once even if (sit-for 0) so that we - redisplay when no input pending. - */ - GCPRO1 (event); - event = Fmake_event (Qnil, Qnil); - - /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc. - events get processed. The old (pre-19.12) code special-cased this - and didn't generate a wakeup, but the resulting behavior was less than - ideal; viz. the occurrence of (sit-for 0.001) scattered throughout - the E-Lisp universe. */ - - id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); - - count = specpdl_depth (); - record_unwind_protect (sit_for_unwind, make_int (id)); - recursive_sit_for = Qt; - - while (1) - { - /* If there is no user input pending, then redisplay. - */ - if (!event_stream_event_pending_p (1) && NILP (nodisplay)) - { - run_pre_idle_hook (); - redisplay (); - } - - /* If our timeout has arrived, we move along. */ - if (!event_stream_wakeup_pending_p (id, 0)) - { - result = Qt; - goto DONE_LABEL; - } - - QUIT; /* next_event_internal() does not QUIT, so check for ^G - before reading output from the process - this makes it - less likely that the filter will actually be aborted. - */ - /* We're a generator of the command_event_queue, so we can't be a - consumer as well. In fact, we know there's nothing on the - command_event_queue that we didn't just put there. - */ - next_event_internal (event, 0); /* blocks */ - /* See the comment in accept-process-output about Vquit_flag */ - - if (command_event_p (event)) - { - QUIT; /* If the command was C-g check it here - so that we abort out of the sit-for, - not the next command. sleep-for and - accept-process-output continue looping - so they check QUIT again implicitly.*/ - result = Qnil; - goto DONE_LABEL; - } - switch (XEVENT_TYPE (event)) - { - case eval_event: - { - /* eval-events get delayed until later. */ - enqueue_command_event (Fcopy_event (event, Qnil)); - break; - } - - case timeout_event: - /* We execute the event even if it's ours, and notice that it's - happened above. */ - default: - { - execute_internal_event (event); - break; - } - } - } - - DONE_LABEL: - unbind_to (count, make_int (id)); - - /* Put back the event (if any) that made Fsit_for() exit before the - timeout. Note that it is being added to the back of the queue, which - would be inappropriate if there were any user events on the queue - already: we would be misordering them. But we know that there are - no user-events on the queue, or else we would not have reached this - point at all. - */ - if (NILP (result)) - enqueue_command_event (event); - else - Fdeallocate_event (event); - - UNGCPRO; - return result; -} - -/* This handy little function is used by xselect.c and energize.c to - wait for replies from processes that aren't really processes (that is, - the X server and the Energize server). - */ -void -wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg) -{ - /* This function can GC */ - Lisp_Object event = Fmake_event (Qnil, Qnil); - struct gcpro gcpro1; - GCPRO1 (event); - - while (!(*predicate) (predicate_arg)) - { - QUIT; /* next_event_internal() does not QUIT. */ - - /* We're a generator of the command_event_queue, so we can't be a - consumer as well. Also, we have no reason to consult the - command_event_queue; there are only user and eval-events there, - and we'd just have to put them back anyway. - */ - next_event_internal (event, 0); - /* See the comment in accept-process-output about Vquit_flag */ - if (command_event_p (event) - || (XEVENT_TYPE (event) == eval_event) - || (XEVENT_TYPE (event) == magic_eval_event)) - enqueue_command_event_1 (event); - else - execute_internal_event (event); - } - UNGCPRO; -} - - -/**********************************************************************/ -/* dispatching events; command builder */ -/**********************************************************************/ - -static void -execute_internal_event (Lisp_Object event) -{ - /* events on dead channels get silently eaten */ - if (object_dead_p (XEVENT (event)->channel)) - return; - - /* This function can GC */ - switch (XEVENT_TYPE (event)) - { - case empty_event: - return; - - case eval_event: - { - call1 (XEVENT (event)->event.eval.function, - XEVENT (event)->event.eval.object); - return; - } - - case magic_eval_event: - { - (XEVENT (event)->event.magic_eval.internal_function) - (XEVENT (event)->event.magic_eval.object); - return; - } - - case pointer_motion_event: - { - if (!NILP (Vmouse_motion_handler)) - call1 (Vmouse_motion_handler, event); - return; - } - - case process_event: - { - Lisp_Object p = XEVENT (event)->event.process.process; - Charcount readstatus; - - assert (PROCESSP (p)); - while ((readstatus = read_process_output (p)) > 0) - ; - if (readstatus > 0) - ; /* this clauses never gets executed but allows the #ifdefs - to work cleanly. */ -#ifdef EWOULDBLOCK - else if (readstatus == -1 && errno == EWOULDBLOCK) - ; -#endif /* EWOULDBLOCK */ -#ifdef EAGAIN - else if (readstatus == -1 && errno == EAGAIN) - ; -#endif /* EAGAIN */ - else if ((readstatus == 0 && - /* Note that we cannot distinguish between no input - available now and a closed pipe. - With luck, a closed pipe will be accompanied by - subprocess termination and SIGCHLD. */ - (!network_connection_p (p) || - /* - When connected to ToolTalk (i.e. - connected_via_filedesc_p()), it's not possible to - reliably determine whether there is a message - waiting for ToolTalk to receive. ToolTalk expects - to have tt_message_receive() called exactly once - every time the file descriptor becomes active, so - the filter function forces this by returning 0. - Emacs must not interpret this as a closed pipe. */ - connected_via_filedesc_p (XPROCESS (p)))) -#ifdef HAVE_PTYS - /* On some OSs with ptys, when the process on one end of - a pty exits, the other end gets an error reading with - errno = EIO instead of getting an EOF (0 bytes read). - Therefore, if we get an error reading and errno = - EIO, just continue, because the child process has - exited and should clean itself up soon (e.g. when we - get a SIGCHLD). */ - || (readstatus == -1 && errno == EIO) -#endif - ) - { - /* Currently, we rely on SIGCHLD to indicate that the - process has terminated. Unfortunately, on some systems - the SIGCHLD gets missed some of the time. So we put an - additional check in status_notify() to see whether a - process has terminated. We must tell status_notify() - to enable that check, and we do so now. */ - kick_status_notify (); - } - else - { - /* Deactivate network connection */ - Lisp_Object status = Fprocess_status (p); - if (EQ (status, Qopen) - /* In case somebody changes the theory of whether to - return open as opposed to run for network connection - "processes"... */ - || EQ (status, Qrun)) - update_process_status (p, Qexit, 256, 0); - deactivate_process (p); - } - - /* We must call status_notify here to allow the - event_stream->unselect_process_cb to be run if appropriate. - Otherwise, dead fds may be selected for, and we will get a - continuous stream of process events for them. Since we don't - return until all process events have been flushed, we would - get stuck here, processing events on a process whose status - was 'exit. Call this after dispatch-event, or the fds will - have been closed before we read the last data from them. - It's safe for the filter to signal an error because - status_notify() will be called on return to top-level. - */ - status_notify (); - return; - } - - case timeout_event: - { - struct Lisp_Event *e = XEVENT (event); - if (!NILP (e->event.timeout.function)) - call1 (e->event.timeout.function, - e->event.timeout.object); - return; - } - case magic_event: - { - event_stream_handle_magic_event (XEVENT (event)); - return; - } - default: - abort (); - } -} - - - -static void -this_command_keys_replace_suffix (Lisp_Object suffix, Lisp_Object chain) -{ - Lisp_Object first_before_suffix = - event_chain_find_previous (Vthis_command_keys, suffix); - - if (NILP (first_before_suffix)) - Vthis_command_keys = chain; - else - XSET_EVENT_NEXT (first_before_suffix, chain); - deallocate_event_chain (suffix); - Vthis_command_keys_tail = event_chain_tail (chain); -} - -static void -command_builder_replace_suffix (struct command_builder *builder, - Lisp_Object suffix, Lisp_Object chain) -{ - Lisp_Object first_before_suffix = - event_chain_find_previous (builder->current_events, suffix); - - if (NILP (first_before_suffix)) - builder->current_events = chain; - else - XSET_EVENT_NEXT (first_before_suffix, chain); - deallocate_event_chain (suffix); - builder->most_current_event = event_chain_tail (chain); -} - -static Lisp_Object -command_builder_find_leaf_1 (struct command_builder *builder) -{ - Lisp_Object event0 = builder->current_events; - - if (NILP (event0)) - return Qnil; - - return event_binding (event0, 1); -} - -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) -static void -menu_move_up (void) -{ - widget_value *current, *prev; - widget_value *entries; - - current = lw_get_entries (False); - entries = lw_get_entries (True); - prev = NULL; - if (current != entries) - { - while (entries != current) - { - if (entries->name /*&& entries->enabled*/) prev = entries; - entries = entries->next; - assert (entries); - } - } - - if (!prev) - /* move to last item */ - { - while (entries->next) - { - if (entries->name /*&& entries->enabled*/) prev = entries; - entries = entries->next; - } - if (prev) - { - if (entries->name /*&& entries->enabled*/) - prev = entries; - } - else - { - /* no selectable items in this menu, pop up to previous level */ - lw_pop_menu (); - return; - } - } - lw_set_item (prev); -} - -static void -menu_move_down (void) -{ - widget_value *current; - widget_value *new; - - current = lw_get_entries (False); - new = current; - - while (new->next) - { - new = new->next; - if (new->name /*&& new->enabled*/) break; - } - - if (new==current||!(new->name/*||new->enabled*/)) - { - new = lw_get_entries (True); - while (new!=current) - { - if (new->name /*&& new->enabled*/) break; - new = new->next; - } - if (new==current&&!(new->name /*|| new->enabled*/)) - { - lw_pop_menu (); - return; - } - } - - lw_set_item (new); -} - -static void -menu_move_left (void) -{ - int level = lw_menu_level (); - int l = level; - widget_value *current; - - while (level >= 3) - { - --level; - lw_pop_menu (); - } - menu_move_up (); - current = lw_get_entries (False); - if (l > 2 && current->contents) - lw_push_menu (current->contents); -} - -static void -menu_move_right (void) -{ - int level = lw_menu_level (); - int l = level; - widget_value *current; - - while (level >= 3) - { - --level; - lw_pop_menu (); - } - menu_move_down (); - current = lw_get_entries (False); - if (l > 2 && current->contents) - lw_push_menu (current->contents); -} - -static void -menu_select_item (widget_value *val) -{ - if (val == NULL) - val = lw_get_entries (False); - - /* is match a submenu? */ - - if (val->contents) - { - /* enter the submenu */ - - lw_set_item (val); - lw_push_menu (val->contents); - } - else - { - /* Execute the menu entry by calling the menu's `select' - callback function - */ - lw_kill_menus (val); - } -} - -static Lisp_Object -command_builder_operate_menu_accelerator (struct command_builder *builder) -{ - /* this function can GC */ - - struct console *con = XCONSOLE (Vselected_console); - Lisp_Object evee = builder->most_current_event; - Lisp_Object binding; - widget_value *entries; - - extern int lw_menu_accelerate; /* lwlib.c */ - -#if 0 - { - int i; - Lisp_Object t; - char buf[50]; - - t = builder->current_events; - i = 0; - while (!NILP (t)) - { - i++; - sprintf (buf,"OPERATE (%d): ",i); - write_c_string (buf, Qexternal_debugging_output); - print_internal (t, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - t = XEVENT_NEXT (t); - } - } -#endif /* 0 */ - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - /* don't echo menu accelerator keys */ - /*reset_key_echo (builder, 1);*/ - - if (!lw_menu_accelerate) - { - /* `convert' mouse display to keyboard display - by entering the open submenu - */ - entries = lw_get_entries (False); - if (entries->contents) - { - lw_push_menu (entries->contents); - lw_display_menu (CurrentTime); - } - } - - /* compare event to the current menu accelerators */ - - entries=lw_get_entries (True); - - while (entries) - { - Lisp_Object accel; - VOID_TO_LISP (accel, entries->accel); - if (entries->name && !NILP (accel)) - { - if (event_matches_key_specifier_p (XEVENT (evee), accel)) - { - /* a match! */ - - menu_select_item (entries); - - if (lw_menu_active) lw_display_menu (CurrentTime); - - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return Vmenu_accelerator_map; - } - } - entries = entries->next; - } - - /* try to look up event in menu-accelerator-map */ - - binding = event_binding_in (evee, Vmenu_accelerator_map, 1); - - if (NILP (binding)) - { - /* beep at user for undefined key */ - return Qnil; - } - else - { - if (EQ (binding, Qmenu_quit)) - { - /* turn off menus and set quit flag */ - lw_kill_menus (NULL); - Vquit_flag = Qt; - } - else if (EQ (binding, Qmenu_up)) - { - int level = lw_menu_level (); - if (level > 2) - menu_move_up (); - } - else if (EQ (binding, Qmenu_down)) - { - int level = lw_menu_level (); - if (level > 2) - menu_move_down (); - else - menu_select_item (NULL); - } - else if (EQ (binding, Qmenu_left)) - { - int level = lw_menu_level (); - if (level > 3) - { - lw_pop_menu (); - lw_display_menu (CurrentTime); - } - else - menu_move_left (); - } - else if (EQ (binding, Qmenu_right)) - { - int level = lw_menu_level (); - if (level > 2 && - lw_get_entries (False)->contents) - { - widget_value *current = lw_get_entries (False); - if (current->contents) - menu_select_item (NULL); - } - else - menu_move_right (); - } - else if (EQ (binding, Qmenu_select)) - menu_select_item (NULL); - else if (EQ (binding, Qmenu_escape)) - { - int level = lw_menu_level (); - - if (level > 2) - { - lw_pop_menu (); - lw_display_menu (CurrentTime); - } - else - { - /* turn off menus quietly */ - lw_kill_menus (NULL); - } - } - else if (KEYMAPP (binding)) - { - /* prefix key */ - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return binding; - } - else - { - /* turn off menus and execute binding */ - lw_kill_menus (NULL); - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - return binding; - } - } - - if (lw_menu_active) lw_display_menu (CurrentTime); - - reset_this_command_keys (Vselected_console, 1); - /*reset_command_builder_event_chain (builder);*/ - - return Vmenu_accelerator_map; -} - -static Lisp_Object -menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored) -{ - Vmenu_accelerator_prefix = Qnil; - Vmenu_accelerator_modifiers = Qnil; - Vmenu_accelerator_enabled = Qnil; - if (!NILP (errordata)) - { - Lisp_Object args[2]; - - args[0] = build_string ("Error in menu accelerators (setting to nil)"); - /* #### This should call - (with-output-to-string (display-error errordata)) - but that stuff is all in Lisp currently. */ - args[1] = errordata; - warn_when_safe_lispobj - (Qerror, Qwarning, - emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", - Qnil, -1, 2, args)); - } - - return Qnil; -} - -static Lisp_Object -menu_accelerator_safe_compare (Lisp_Object event0) -{ - if (CONSP (Vmenu_accelerator_prefix)) - { - Lisp_Object t; - t=Vmenu_accelerator_prefix; - while (!NILP (t) - && !NILP (event0) - && event_matches_key_specifier_p (XEVENT (event0), Fcar (t))) - { - t = Fcdr (t); - event0 = XEVENT_NEXT (event0); - } - if (!NILP (t)) - return Qnil; - } - else if (NILP (event0)) - return Qnil; - else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix)) - event0 = XEVENT_NEXT (event0); - else - return Qnil; - return event0; -} - -static Lisp_Object -menu_accelerator_safe_mod_compare (Lisp_Object cons) -{ - return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons)) - ? Qt - : Qnil); -} - -static Lisp_Object -command_builder_find_menu_accelerator (struct command_builder *builder) -{ - /* this function can GC */ - Lisp_Object event0 = builder->current_events; - struct console *con = XCONSOLE (Vselected_console); - struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); - Widget menubar_widget; - - /* compare entries in event0 against the menu prefix */ - - if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) || - XEVENT (event0)->event_type != key_press_event) - return Qnil; - - if (!NILP (Vmenu_accelerator_prefix)) - { - event0 = condition_case_1 (Qerror, - menu_accelerator_safe_compare, - event0, - menu_accelerator_junk_on_error, - Qnil); - } - - if (NILP (event0)) - return Qnil; - - menubar_widget = FRAME_X_MENUBAR_WIDGET (f); - if (menubar_widget - && CONSP (Vmenu_accelerator_modifiers)) - { - Lisp_Object fake; - Lisp_Object last = Qnil; - struct gcpro gcpro1; - Lisp_Object matchp; - - widget_value *val; - LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id; - - val = lw_get_all_values (id); - if (val) - { - val = val->contents; - - fake = Fcopy_sequence (Vmenu_accelerator_modifiers); - last = fake; - - while (!NILP (Fcdr (last))) - last = Fcdr (last); - - Fsetcdr (last, Fcons (Qnil, Qnil)); - last = Fcdr (last); - } - - fake = Fcons (Qnil, fake); - - GCPRO1 (fake); - - while (val) - { - Lisp_Object accel; - VOID_TO_LISP (accel, val->accel); - if (val->name && !NILP (accel)) - { - Fsetcar (last, accel); - Fsetcar (fake, event0); - matchp = condition_case_1 (Qerror, - menu_accelerator_safe_mod_compare, - fake, - menu_accelerator_junk_on_error, - Qnil); - if (!NILP (matchp)) - { - /* we found one! */ - - lw_set_menu (menubar_widget, val); - /* yah - yet another hack. - pretend emacs timestamp is the same as an X timestamp, - which for the moment it is. (read events.h) - */ - lw_map_menu (XEVENT (event0)->timestamp); - - if (val->contents) - lw_push_menu (val->contents); - - lw_display_menu (CurrentTime); - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - /* don't echo menu accelerator keys */ - /*reset_key_echo (builder, 1);*/ - reset_this_command_keys (Vselected_console, 1); - UNGCPRO; - - return Vmenu_accelerator_map; - } - } - - val = val->next; - } - - UNGCPRO; - } - return Qnil; -} - - -DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* -Make the menubar active. Menu items can be selected using menu accelerators -or by actions defined in menu-accelerator-map. -*/ - ()) -{ - struct console *con = XCONSOLE (Vselected_console); - struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); - LWLIB_ID id; - widget_value *val; - - if (NILP (f->menubar_data)) - error ("Frame has no menubar."); - - id = XPOPUP_DATA (f->menubar_data)->id; - val = lw_get_all_values (id); - val = val->contents; - lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val); - lw_map_menu (CurrentTime); - - lw_display_menu (CurrentTime); - - /* menu accelerator keys don't go into keyboard macros */ - if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) - con->kbd_macro_ptr = con->kbd_macro_end; - - return Qnil; -} -#endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */ - -/* See if we can do function-key-map or key-translation-map translation - on the current events in the command builder. If so, do this, and - return the resulting binding, if any. */ - -static Lisp_Object -munge_keymap_translate (struct command_builder *builder, - enum munge_me_out_the_door munge, - int has_normal_binding_p) -{ - Lisp_Object suffix; - - EVENT_CHAIN_LOOP (suffix, builder->munge_me[munge].first_mungeable_event) - { - Lisp_Object result = munging_key_map_event_binding (suffix, munge); - - if (NILP (result)) - continue; - - if (KEYMAPP (result)) - { - if (NILP (builder->last_non_munged_event) - && !has_normal_binding_p) - builder->last_non_munged_event = builder->most_current_event; - } - else - builder->last_non_munged_event = Qnil; - - if (!KEYMAPP (result) && - !VECTORP (result) && - !STRINGP (result)) - { - struct gcpro gcpro1; - GCPRO1 (suffix); - result = call1 (result, Qnil); - UNGCPRO; - if (NILP (result)) - return Qnil; - } - - if (KEYMAPP (result)) - return result; - - if (VECTORP (result) || STRINGP (result)) - { - Lisp_Object new_chain = key_sequence_to_event_chain (result); - Lisp_Object tempev; - int n, tckn; - - /* If the first_mungeable_event of the other munger is - within the events we're munging, then it will point to - deallocated events afterwards, which is bad -- so make it - point at the beginning of the munged events. */ - EVENT_CHAIN_LOOP (tempev, suffix) - { - Lisp_Object *mungeable_event = - &builder->munge_me[1 - munge].first_mungeable_event; - if (EQ (tempev, *mungeable_event)) - { - *mungeable_event = new_chain; - break; - } - } - - n = event_chain_count (suffix); - command_builder_replace_suffix (builder, suffix, new_chain); - builder->munge_me[munge].first_mungeable_event = Qnil; - /* Now hork this-command-keys as well. */ - - /* We just assume that the events we just replaced are - sitting in copied form at the end of this-command-keys. - If the user did weird things with `dispatch-event' this - may not be the case, but at least we make sure we won't - crash. */ - new_chain = copy_event_chain (new_chain); - tckn = event_chain_count (Vthis_command_keys); - if (tckn >= n) - { - this_command_keys_replace_suffix - (event_chain_nth (Vthis_command_keys, tckn - n), - new_chain); - } - - result = command_builder_find_leaf_1 (builder); - return result; - } - - signal_simple_error ((munge == MUNGE_ME_FUNCTION_KEY ? - "Invalid binding in function-key-map" : - "Invalid binding in key-translation-map"), - result); - } - - return Qnil; -} - -/* Compare the current state of the command builder against the local and - global keymaps, and return the binding. If there is no match, try again, - case-insensitively. The return value will be one of: - -- nil (there is no binding) - -- a keymap (part of a command has been specified) - -- a command (anything that satisfies `commandp'; this includes - some symbols, lists, subrs, strings, vectors, and - compiled-function objects) - */ -static Lisp_Object -command_builder_find_leaf (struct command_builder *builder, - int allow_misc_user_events_p) -{ - /* This function can GC */ - Lisp_Object result; - Lisp_Object evee = builder->current_events; - - if (XEVENT_TYPE (evee) == misc_user_event) - { - if (allow_misc_user_events_p && (NILP (XEVENT_NEXT (evee)))) - return list2 (XEVENT (evee)->event.eval.function, - XEVENT (evee)->event.eval.object); - else - return Qnil; - } - - /* if we're currently in a menu accelerator, check there for further events */ -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) - if (lw_menu_active) - { - return command_builder_operate_menu_accelerator (builder); - } - else - { - result = Qnil; - if (EQ (Vmenu_accelerator_enabled, Qmenu_force)) - result = command_builder_find_menu_accelerator (builder); - if (NILP (result)) -#endif - result = command_builder_find_leaf_1 (builder); -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) - if (NILP (result) - && EQ (Vmenu_accelerator_enabled, Qmenu_fallback)) - result = command_builder_find_menu_accelerator (builder); - } -#endif - - /* Check to see if we have a potential function-key-map match. */ - if (NILP (result)) - { - result = munge_keymap_translate (builder, MUNGE_ME_FUNCTION_KEY, 0); - regenerate_echo_keys_from_this_command_keys (builder); - } - /* Check to see if we have a potential key-translation-map match. */ - { - Lisp_Object key_translate_result = - munge_keymap_translate (builder, MUNGE_ME_KEY_TRANSLATION, - !NILP (result)); - if (!NILP (key_translate_result)) - { - result = key_translate_result; - regenerate_echo_keys_from_this_command_keys (builder); - } - } - - if (!NILP (result)) - return result; - - /* If key-sequence wasn't bound, we'll try some fallbacks. */ - - /* If we didn't find a binding, and the last event in the sequence is - a shifted character, then try again with the lowercase version. */ - - if (XEVENT_TYPE (builder->most_current_event) == key_press_event - && !NILP (Vretry_undefined_key_binding_unshifted)) - { - Lisp_Object terminal = builder->most_current_event; - struct key_data* key = & XEVENT (terminal)->event.key; - Emchar c = 0; - if ((key->modifiers & MOD_SHIFT) - || (CHAR_OR_CHAR_INTP (key->keysym) - && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z'))) - { - struct Lisp_Event terminal_copy = *XEVENT (terminal); - - if (key->modifiers & MOD_SHIFT) - key->modifiers &= (~ MOD_SHIFT); - else - key->keysym = make_char (c + 'a' - 'A'); - - result = command_builder_find_leaf (builder, allow_misc_user_events_p); - if (!NILP (result)) - return result; - /* If there was no match with the lower-case version either, - then put back the upper-case event for the error - message. But make sure that function-key-map didn't - change things out from under us. */ - if (EQ (terminal, builder->most_current_event)) - *XEVENT (terminal) = terminal_copy; - } - } - - /* help-char is `auto-bound' in every keymap */ - if (!NILP (Vprefix_help_command) && - event_matches_key_specifier_p (XEVENT (builder->most_current_event), - Vhelp_char)) - return Vprefix_help_command; - -#ifdef HAVE_XIM - /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */ - if (XEVENT_TYPE (builder->most_current_event) == key_press_event - && !NILP (Vcomposed_character_default_binding)) - { - Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym; - if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym))) - return Vcomposed_character_default_binding; - } -#endif /* HAVE_XIM */ - - /* If we read extra events attempting to match a function key but end - up failing, then we release those events back to the command loop - and fail on the original lookup. The released events will then be - reprocessed in the context of the first part having failed. */ - if (!NILP (builder->last_non_munged_event)) - { - Lisp_Object event0 = builder->last_non_munged_event; - - /* Put the commands back on the event queue. */ - enqueue_event_chain (XEVENT_NEXT (event0), - &command_event_queue, - &command_event_queue_tail); - - /* Then remove them from the command builder. */ - XSET_EVENT_NEXT (event0, Qnil); - builder->most_current_event = event0; - builder->last_non_munged_event = Qnil; - } - - return Qnil; -} - - -/* Every time a command-event (a key, button, or menu selection) is read by - Fnext_event(), it is stored in the recent_keys_ring, in Vlast_input_event, - and in Vthis_command_keys. (Eval-events are not stored there.) - - Every time a command is invoked, Vlast_command_event is set to the last - event in the sequence. - - This means that Vthis_command_keys is really about "input read since the - last command was executed" rather than about "what keys invoked this - command." This is a little counterintuitive, but that's the way it - has always worked. - - As an extra kink, the function read-key-sequence resets/updates the - last-command-event and this-command-keys. It doesn't append to the - command-keys as read-char does. Such are the pitfalls of having to - maintain compatibility with a program for which the only specification - is the code itself. - - (We could implement recent_keys_ring and Vthis_command_keys as the same - data structure.) - */ - -DEFUN ("recent-keys", Frecent_keys, 0, 1, 0, /* -Return a vector of recent keyboard or mouse button events read. -If NUMBER is non-nil, not more than NUMBER events will be returned. -Change number of events stored using `set-recent-keys-ring-size'. - -This copies the event objects into a new vector; it is safe to keep and -modify them. -*/ - (number)) -{ - struct gcpro gcpro1; - Lisp_Object val = Qnil; - int nwanted; - int start, nkeys, i, j; - GCPRO1 (val); - - if (NILP (number)) - nwanted = recent_keys_ring_size; - else - { - CHECK_NATNUM (number); - nwanted = XINT (number); - } - - /* Create the keys ring vector, if none present. */ - if (NILP (Vrecent_keys_ring)) - { - Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil); - /* And return nothing in particular. */ - return make_vector (0, Qnil); - } - - if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index])) - /* This means the vector has not yet wrapped */ - { - nkeys = recent_keys_ring_index; - start = 0; - } - else - { - nkeys = recent_keys_ring_size; - start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index); - } - - if (nwanted < nkeys) - { - start += nkeys - nwanted; - if (start >= recent_keys_ring_size) - start -= recent_keys_ring_size; - nkeys = nwanted; - } - else - nwanted = nkeys; - - val = make_vector (nwanted, Qnil); - - for (i = 0, j = start; i < nkeys; i++) - { - Lisp_Object e = XVECTOR_DATA (Vrecent_keys_ring)[j]; - - if (NILP (e)) - abort (); - XVECTOR_DATA (val)[i] = Fcopy_event (e, Qnil); - if (++j >= recent_keys_ring_size) - j = 0; - } - UNGCPRO; - return val; -} - - -DEFUN ("recent-keys-ring-size", Frecent_keys_ring_size, 0, 0, 0, /* -The maximum number of events `recent-keys' can return. -*/ - ()) -{ - return make_int (recent_keys_ring_size); -} - -DEFUN ("set-recent-keys-ring-size", Fset_recent_keys_ring_size, 1, 1, 0, /* -Set the maximum number of events to be stored internally. -*/ - (size)) -{ - Lisp_Object new_vector = Qnil; - int i, j, nkeys, start, min; - struct gcpro gcpro1; - GCPRO1 (new_vector); - - CHECK_INT (size); - if (XINT (size) <= 0) - error ("Recent keys ring size must be positive"); - if (XINT (size) == recent_keys_ring_size) - return size; - - new_vector = make_vector (XINT (size), Qnil); - - if (NILP (Vrecent_keys_ring)) - { - Vrecent_keys_ring = new_vector; - return size; - } - - if (NILP (XVECTOR_DATA (Vrecent_keys_ring)[recent_keys_ring_index])) - /* This means the vector has not yet wrapped */ - { - nkeys = recent_keys_ring_index; - start = 0; - } - else - { - nkeys = recent_keys_ring_size; - start = ((recent_keys_ring_index == nkeys) ? 0 : recent_keys_ring_index); - } - - if (XINT (size) > nkeys) - min = nkeys; - else - min = XINT (size); - - for (i = 0, j = start; i < min; i++) - { - XVECTOR_DATA (new_vector)[i] = XVECTOR_DATA (Vrecent_keys_ring)[j]; - if (++j >= recent_keys_ring_size) - j = 0; - } - recent_keys_ring_size = XINT (size); - recent_keys_ring_index = (i < recent_keys_ring_size) ? i : 0; - - Vrecent_keys_ring = new_vector; - - UNGCPRO; - return size; -} - -/* Vthis_command_keys having value Qnil means that the next time - push_this_command_keys is called, it should start over. - The times at which the command-keys are reset - (instead of merely being augmented) are pretty counterintuitive. - (More specifically: - - -- We do not reset this-command-keys when we finish reading a - command. This is because some commands (e.g. C-u) act - like command prefixes; they signal this by setting prefix-arg - to non-nil. - -- Therefore, we reset this-command-keys when we finish - executing a command, unless prefix-arg is set. - -- However, if we ever do a non-local exit out of a command - loop (e.g. an error in a command), we need to reset - this-command-keys. We do this by calling reset_this_command_keys() - from cmdloop.c, whenever an error causes an invocation of the - default error handler, and whenever there's a throw to top-level.) - */ - -void -reset_this_command_keys (Lisp_Object console, int clear_echo_area_p) -{ - struct command_builder *command_builder = - XCOMMAND_BUILDER (XCONSOLE (console)->command_builder); - - reset_key_echo (command_builder, clear_echo_area_p); - - deallocate_event_chain (Vthis_command_keys); - Vthis_command_keys = Qnil; - Vthis_command_keys_tail = Qnil; - - reset_current_events (command_builder); -} - -static void -push_this_command_keys (Lisp_Object event) -{ - Lisp_Object new = Fmake_event (Qnil, Qnil); - - Fcopy_event (event, new); - enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail); -} - -/* The following two functions are used in call-interactively, - for the @ and e specifications. We used to just use - `current-mouse-event' (i.e. the last mouse event in this-command-keys), - but FSF does it more generally so we follow their lead. */ - -Lisp_Object -extract_this_command_keys_nth_mouse_event (int n) -{ - Lisp_Object event; - - EVENT_CHAIN_LOOP (event, Vthis_command_keys) - { - if (EVENTP (event) - && (XEVENT_TYPE (event) == button_press_event - || XEVENT_TYPE (event) == button_release_event - || XEVENT_TYPE (event) == misc_user_event)) - { - if (!n) - { - /* must copy to avoid an abort() in next_event_internal() */ - if (!NILP (XEVENT_NEXT (event))) - return Fcopy_event (event, Qnil); - else - return event; - } - n--; - } - } - - return Qnil; -} - -Lisp_Object -extract_vector_nth_mouse_event (Lisp_Object vector, int n) -{ - int i; - int len = XVECTOR_LENGTH (vector); - - for (i = 0; i < len; i++) - { - Lisp_Object event = XVECTOR_DATA (vector)[i]; - if (EVENTP (event)) - switch (XEVENT_TYPE (event)) - { - case button_press_event : - case button_release_event : - case misc_user_event : - if (n == 0) - return event; - n--; - break; - default: - continue; - } - } - - return Qnil; -} - -static void -push_recent_keys (Lisp_Object event) -{ - Lisp_Object e; - - if (NILP (Vrecent_keys_ring)) - Vrecent_keys_ring = make_vector (recent_keys_ring_size, Qnil); - - e = XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index]; - - if (NILP (e)) - { - e = Fmake_event (Qnil, Qnil); - XVECTOR_DATA (Vrecent_keys_ring) [recent_keys_ring_index] = e; - } - Fcopy_event (event, e); - if (++recent_keys_ring_index == recent_keys_ring_size) - recent_keys_ring_index = 0; -} - - -static Lisp_Object -current_events_into_vector (struct command_builder *command_builder) -{ - Lisp_Object vector; - Lisp_Object event; - int n = event_chain_count (command_builder->current_events); - - /* Copy the vector and the events in it. */ - /* No need to copy the events, since they're already copies, and - nobody other than the command-builder has pointers to them */ - vector = make_vector (n, Qnil); - n = 0; - EVENT_CHAIN_LOOP (event, command_builder->current_events) - XVECTOR_DATA (vector)[n++] = event; - reset_command_builder_event_chain (command_builder); - return vector; -} - - -/* - Given the current state of the command builder and a new command event - that has just been dispatched: - - -- add the event to the event chain forming the current command - (doing meta-translation as necessary) - -- return the binding of this event chain; this will be one of: - -- nil (there is no binding) - -- a keymap (part of a command has been specified) - -- a command (anything that satisfies `commandp'; this includes - some symbols, lists, subrs, strings, vectors, and - compiled-function objects) - */ -static Lisp_Object -lookup_command_event (struct command_builder *command_builder, - Lisp_Object event, int allow_misc_user_events_p) -{ - /* This function can GC */ - struct frame *f = selected_frame (); - /* Clear output from previous command execution */ - if (!EQ (Qcommand, echo_area_status (f)) - /* but don't let mouse-up clear what mouse-down just printed */ - && (XEVENT (event)->event_type != button_release_event)) - clear_echo_area (f, Qnil, 0); - - /* Add the given event to the command builder. - Extra hack: this also updates the recent_keys_ring and Vthis_command_keys - vectors to translate "ESC x" to "M-x" (for any "x" of course). - */ - { - Lisp_Object recent = command_builder->most_current_event; - - if (EVENTP (recent) - && event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char)) - { - struct Lisp_Event *e; - /* When we see a sequence like "ESC x", pretend we really saw "M-x". - DoubleThink the recent-keys and this-command-keys as well. */ - - /* Modify the previous most-recently-pushed event on the command - builder to be a copy of this one with the meta-bit set instead of - pushing a new event. - */ - Fcopy_event (event, recent); - e = XEVENT (recent); - if (e->event_type == key_press_event) - e->event.key.modifiers |= MOD_META; - else if (e->event_type == button_press_event - || e->event_type == button_release_event) - e->event.button.modifiers |= MOD_META; - else - abort (); - - { - int tckn = event_chain_count (Vthis_command_keys); - if (tckn >= 2) - /* ??? very strange if it's < 2. */ - this_command_keys_replace_suffix - (event_chain_nth (Vthis_command_keys, tckn - 2), - Fcopy_event (recent, Qnil)); - } - - regenerate_echo_keys_from_this_command_keys (command_builder); - } - else - { - event = Fcopy_event (event, Fmake_event (Qnil, Qnil)); - - command_builder_append_event (command_builder, event); - } - } - - { - Lisp_Object leaf = command_builder_find_leaf (command_builder, - allow_misc_user_events_p); - struct gcpro gcpro1; - GCPRO1 (leaf); - - if (KEYMAPP (leaf)) - { - if (!lw_menu_active) - { - Lisp_Object prompt = Fkeymap_prompt (leaf, Qt); - if (STRINGP (prompt)) - { - /* Append keymap prompt to key echo buffer */ - int buf_index = command_builder->echo_buf_index; - Bytecount len = XSTRING_LENGTH (prompt); - - if (len + buf_index + 1 <= command_builder->echo_buf_length) - { - Bufbyte *echo = command_builder->echo_buf + buf_index; - memcpy (echo, XSTRING_DATA (prompt), len); - echo[len] = 0; - } - maybe_echo_keys (command_builder, 1); - } - else - maybe_echo_keys (command_builder, 0); - } - else if (!NILP (Vquit_flag)) { - Lisp_Object quit_event = Fmake_event(Qnil, Qnil); - struct Lisp_Event *e = XEVENT (quit_event); - /* if quit happened during menu acceleration, pretend we read it */ - struct console *con = XCONSOLE (Fselected_console ()); - int ch = CONSOLE_QUIT_CHAR (con); - - character_to_event (ch, e, con, 1, 1); - e->channel = make_console (con); - - enqueue_command_event (quit_event); - Vquit_flag = Qnil; - } - } - else if (!NILP (leaf)) - { - if (EQ (Qcommand, echo_area_status (f)) - && command_builder->echo_buf_index > 0) - { - /* If we had been echoing keys, echo the last one (without - the trailing dash) and redisplay before executing the - command. */ - command_builder->echo_buf[command_builder->echo_buf_index] = 0; - maybe_echo_keys (command_builder, 1); - Fsit_for (Qzero, Qt); - } - } - RETURN_UNGCPRO (leaf); - } -} - -static void -execute_command_event (struct command_builder *command_builder, - Lisp_Object event) -{ - /* This function can GC */ - struct console *con = XCONSOLE (command_builder->console); - struct gcpro gcpro1; - - GCPRO1 (event); /* event may be freshly created */ - reset_current_events (command_builder); - - switch (XEVENT (event)->event_type) - { - case key_press_event: - Vcurrent_mouse_event = Qnil; - break; - case button_press_event: - case button_release_event: - case misc_user_event: - Vcurrent_mouse_event = Fcopy_event (event, Qnil); - break; - default: break; - } - - /* Store the last-command-event. The semantics of this is that it - is the last event most recently involved in command-lookup. */ - if (!EVENTP (Vlast_command_event)) - Vlast_command_event = Fmake_event (Qnil, Qnil); - if (XEVENT (Vlast_command_event)->event_type == dead_event) - { - Vlast_command_event = Fmake_event (Qnil, Qnil); - error ("Someone deallocated the last-command-event!"); - } - - if (! EQ (event, Vlast_command_event)) - Fcopy_event (event, Vlast_command_event); - - /* Note that last-command-char will never have its high-bit set, in - an effort to sidestep the ambiguity between M-x and oslash. */ - Vlast_command_char = Fevent_to_character (Vlast_command_event, - Qnil, Qnil, Qnil); - - /* Actually call the command, with all sorts of hair to preserve or clear - the echo-area and region as appropriate and call the pre- and post- - command-hooks. */ - { - int old_kbd_macro = con->kbd_macro_end; - struct window *w = XWINDOW (Fselected_window (Qnil)); - - /* We're executing a new command, so the old value is irrelevant. */ - zmacs_region_stays = 0; - - /* If the previous command tried to force a specific window-start, - reset the flag in case this command moves point far away from - that position. Also, reset the window's buffer's change - information so that we don't trigger an incremental update. */ - if (w->force_start) - { - w->force_start = 0; - buffer_reset_changes (XBUFFER (w->buffer)); - } - - pre_command_hook (); - - if (XEVENT (event)->event_type == misc_user_event) - { - call1 (XEVENT (event)->event.eval.function, - XEVENT (event)->event.eval.object); - } - else - { - Fcommand_execute (Vthis_command, Qnil, Qnil); - } - - post_command_hook (); - -#if 0 /* #### here was an attempted fix that didn't work */ - if (XEVENT (event)->event_type == misc_user_event) - ; - else -#endif - if (!NILP (con->prefix_arg)) - { - /* Commands that set the prefix arg don't update last-command, don't - reset the echoing state, and don't go into keyboard macros unless - followed by another command. */ - maybe_echo_keys (command_builder, 0); - - /* If we're recording a keyboard macro, and the last command - executed set a prefix argument, then decrement the pointer to - the "last character really in the macro" to be just before this - command. This is so that the ^U in "^U ^X )" doesn't go onto - the end of macro. */ - if (!NILP (con->defining_kbd_macro)) - con->kbd_macro_end = old_kbd_macro; - } - else - { - /* Start a new command next time */ - Vlast_command = Vthis_command; - /* Emacs 18 doesn't unconditionally clear the echoed keystrokes, - so we don't either */ - reset_this_command_keys (make_console (con), 0); - } - } - - UNGCPRO; -} - -/* Run the pre command hook. */ - -static void -pre_command_hook (void) -{ - last_point_position = BUF_PT (current_buffer); - XSETBUFFER (last_point_position_buffer, current_buffer); - /* This function can GC */ - safe_run_hook_trapping_errors - ("Error in `pre-command-hook' (setting hook to nil)", - Qpre_command_hook, 1); -} - -/* Run the post command hook. */ - -static void -post_command_hook (void) -{ - /* This function can GC */ - /* Turn off region highlighting unless this command requested that - it be left on, or we're in the minibuffer. We don't turn it off - when we're in the minibuffer so that things like M-x write-region - still work! - - This could be done via a function on the post-command-hook, but - we don't want the user to accidentally remove it. - */ - - Lisp_Object win = Fselected_window (Qnil); - -#if 0 - /* If the last command deleted the frame, `win' might be nil. - It seems safest to do nothing in this case. */ - /* ### This doesn't really fix the problem, - if delete-frame is called by some hook */ - if (NILP (win)) - return; -#endif - - if (! zmacs_region_stays - && (!MINI_WINDOW_P (XWINDOW (win)) - || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win))))) - zmacs_deactivate_region (); - else - zmacs_update_region (); - - safe_run_hook_trapping_errors - ("Error in `post-command-hook' (setting hook to nil)", - Qpost_command_hook, 1); - -#ifdef DEFERRED_ACTION_CRAP - if (!NILP (Vdeferred_action_list)) - call0 (Vdeferred_action_function); -#endif - -#ifdef ILL_CONCEIVED_HOOK - if (NILP (Vunread_command_events) - && NILP (Vexecuting_macro) - && !NILP (Vpost_command_idle_hook) - && !NILP (Fsit_for (make_float ((double) post_command_idle_delay - / 1000000), Qnil))) - safe_run_hook_trapping_errors - ("Error in `post-command-idle-hook' (setting hook to nil)", - Qpost_command_idle_hook, 1); -#endif - -#if 0 /* FSFmacs */ - if (!NILP (current_buffer->mark_active)) - { - if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode)) - { - current_buffer->mark_active = Qnil; - run_hook (intern ("deactivate-mark-hook")); - } - else if (current_buffer != prev_buffer || - BUF_MODIFF (current_buffer) != prev_modiff) - run_hook (intern ("activate-mark-hook")); - } -#endif /* FSFmacs */ - - /* #### Kludge!!! This is necessary to make sure that things - are properly positioned even if post-command-hook moves point. - #### There should be a cleaner way of handling this. */ - call0 (Qauto_show_make_point_visible); -} - - -DEFUN ("dispatch-event", Fdispatch_event, 1, 1, 0, /* -Given an event object as returned by `next-event', execute it. - -Key-press, button-press, and button-release events get accumulated -until a complete key sequence (see `read-key-sequence') is reached, -at which point the sequence is looked up in the current keymaps and -acted upon. - -Mouse motion events cause the low-level handling function stored in -`mouse-motion-handler' to be called. (There are very few circumstances -under which you should change this handler. Use `mode-motion-hook' -instead.) - -Menu, timeout, and eval events cause the associated function or handler -to be called. - -Process events cause the subprocess's output to be read and acted upon -appropriately (see `start-process'). - -Magic events are handled as necessary. -*/ - (event)) -{ - /* This function can GC */ - struct command_builder *command_builder; - struct Lisp_Event *ev; - Lisp_Object console; - Lisp_Object channel; - - CHECK_LIVE_EVENT (event); - ev = XEVENT (event); - - /* events on dead channels get silently eaten */ - channel = EVENT_CHANNEL (ev); - if (object_dead_p (channel)) - return Qnil; - - /* Some events don't have channels (e.g. eval events). */ - console = CDFW_CONSOLE (channel); - if (NILP (console)) - console = Vselected_console; - else if (!EQ (console, Vselected_console)) - Fselect_console (console); - - command_builder = XCOMMAND_BUILDER (XCONSOLE (console)->command_builder); - switch (XEVENT (event)->event_type) - { - case button_press_event: - case button_release_event: - case key_press_event: - { - Lisp_Object leaf = lookup_command_event (command_builder, event, 1); - - if (KEYMAPP (leaf)) - /* Incomplete key sequence */ - break; - if (NILP (leaf)) - { - /* At this point, we know that the sequence is not bound to a - command. Normally, we beep and print a message informing the - user of this. But we do not beep or print a message when: - - o the last event in this sequence is a mouse-up event; or - o the last event in this sequence is a mouse-down event and - there is a binding for the mouse-up version. - - That is, if the sequence ``C-x button1'' is typed, and is not - bound to a command, but the sequence ``C-x button1up'' is bound - to a command, we do not complain about the ``C-x button1'' - sequence. If neither ``C-x button1'' nor ``C-x button1up'' is - bound to a command, then we complain about the ``C-x button1'' - sequence, but later will *not* complain about the - ``C-x button1up'' sequence, which would be redundant. - - This is pretty hairy, but I think it's the most intuitive - behavior. - */ - Lisp_Object terminal = command_builder->most_current_event; - - if (XEVENT_TYPE (terminal) == button_press_event) - { - int no_bitching; - /* Temporarily pretend the last event was an "up" instead of a - "down", and look up its binding. */ - XEVENT_TYPE (terminal) = button_release_event; - /* If the "up" version is bound, don't complain. */ - no_bitching - = !NILP (command_builder_find_leaf (command_builder, 0)); - /* Undo the temporary changes we just made. */ - XEVENT_TYPE (terminal) = button_press_event; - if (no_bitching) - { - /* Pretend this press was not seen (treat as a prefix) */ - if (EQ (command_builder->current_events, terminal)) - { - reset_current_events (command_builder); - } - else - { - Lisp_Object eve; - - EVENT_CHAIN_LOOP (eve, command_builder->current_events) - if (EQ (XEVENT_NEXT (eve), terminal)) - break; - - Fdeallocate_event (command_builder-> - most_current_event); - XSET_EVENT_NEXT (eve, Qnil); - command_builder->most_current_event = eve; - } - maybe_echo_keys (command_builder, 1); - break; - } - } - - /* Complain that the typed sequence is not defined, if this is the - kind of sequence that warrants a complaint. */ - XCONSOLE (console)->defining_kbd_macro = Qnil; - XCONSOLE (console)->prefix_arg = Qnil; - /* Don't complain about undefined button-release events */ - if (XEVENT_TYPE (terminal) != button_release_event) - { - Lisp_Object keys = current_events_into_vector (command_builder); - struct gcpro gcpro1; - - /* Run the pre-command-hook before barfing about an undefined - key. */ - Vthis_command = Qnil; - GCPRO1 (keys); - pre_command_hook (); - UNGCPRO; - /* The post-command-hook doesn't run. */ - Fsignal (Qundefined_keystroke_sequence, list1 (keys)); - } - /* Reset the command builder for reading the next sequence. */ - reset_this_command_keys (console, 1); - } - else /* key sequence is bound to a command */ - { - Vthis_command = leaf; - /* Don't push an undo boundary if the command set the prefix arg, - or if we are executing a keyboard macro, or if in the - minibuffer. If the command we are about to execute is - self-insert, it's tricky: up to 20 consecutive self-inserts may - be done without an undo boundary. This counter is reset as - soon as a command other than self-insert-command is executed. - */ - if (! EQ (leaf, Qself_insert_command)) - command_builder->self_insert_countdown = 0; - if (NILP (XCONSOLE (console)->prefix_arg) - && NILP (Vexecuting_macro) -#if 0 - /* This was done in the days when there was no undo - in the minibuffer. If we don't disable this code, - then each instance of "undo" undoes everything in - the minibuffer. */ - && !EQ (minibuf_window, Fselected_window (Qnil)) -#endif - && command_builder->self_insert_countdown == 0) - Fundo_boundary (); - - if (EQ (leaf, Qself_insert_command)) - { - if (--command_builder->self_insert_countdown < 0) - command_builder->self_insert_countdown = 20; - } - execute_command_event - (command_builder, - internal_equal (event, command_builder-> most_current_event, 0) - ? event - /* Use the translated event that was most recently seen. - This way, last-command-event becomes f1 instead of - the P from ESC O P. But we must copy it, else we'll - lose when the command-builder events are deallocated. */ - : Fcopy_event (command_builder-> most_current_event, Qnil)); - } - break; - } - case misc_user_event: - { - /* Jamie said: - - We could just always use the menu item entry, whatever it is, but - this might break some Lisp code that expects `this-command' to - always contain a symbol. So only store it if this is a simple - `call-interactively' sort of menu item. - - But this is bogus. `this-command' could be a string or vector - anyway (for keyboard macros). There's even one instance - (in pending-del.el) of `this-command' getting set to a cons - (a lambda expression). So in the `eval' case I'll just - convert it into a lambda expression. - */ - if (EQ (XEVENT (event)->event.eval.function, Qcall_interactively) - && SYMBOLP (XEVENT (event)->event.eval.object)) - Vthis_command = XEVENT (event)->event.eval.object; - else if (EQ (XEVENT (event)->event.eval.function, Qeval)) - Vthis_command = - Fcons (Qlambda, Fcons (Qnil, XEVENT (event)->event.eval.object)); - else if (SYMBOLP (XEVENT (event)->event.eval.function)) - /* A scrollbar command or the like. */ - Vthis_command = XEVENT (event)->event.eval.function; - else - /* Huh? */ - Vthis_command = Qnil; - - /* clear the echo area */ - reset_key_echo (command_builder, 1); - - command_builder->self_insert_countdown = 0; - if (NILP (XCONSOLE (console)->prefix_arg) - && NILP (Vexecuting_macro) - && !EQ (minibuf_window, Fselected_window (Qnil))) - Fundo_boundary (); - execute_command_event (command_builder, event); - break; - } - default: - { - execute_internal_event (event); - break; - } - } - return Qnil; -} - -DEFUN ("read-key-sequence", Fread_key_sequence, 1, 3, 0, /* -Read a sequence of keystrokes or mouse clicks. -Returns a vector of the event objects read. The vector and the event -objects it contains are freshly created (and will not be side-effected -by subsequent calls to this function). - -The sequence read is sufficient to specify a non-prefix command starting -from the current local and global keymaps. A C-g typed while in this -function is treated like any other character, and `quit-flag' is not set. - -First arg PROMPT is a prompt string. If nil, do not prompt specially. -Second (optional) arg CONTINUE-ECHO, if non-nil, means this key echoes -as a continuation of the previous key. - -The third (optional) arg DONT-DOWNCASE-LAST, if non-nil, means do not -convert the last event to lower case. (Normally any upper case event -is converted to lower case if the original event is undefined and the lower -case equivalent is defined.) This argument is provided mostly for -FSF compatibility; the equivalent effect can be achieved more generally -by binding `retry-undefined-key-binding-unshifted' to nil around the -call to `read-key-sequence'. - -A C-g typed while in this function is treated like any other character, -and `quit-flag' is not set. - -If the user selects a menu item while we are prompting for a key-sequence, -the returned value will be a vector of a single menu-selection event. -An error will be signalled if you pass this value to `lookup-key' or a -related function. - -`read-key-sequence' checks `function-key-map' for function key -sequences, where they wouldn't conflict with ordinary bindings. See -`function-key-map' for more details. -*/ - (prompt, continue_echo, dont_downcase_last)) -{ - /* This function can GC */ - struct console *con = XCONSOLE (Vselected_console); /* #### correct? - Probably not -- see - comment in - next-event */ - struct command_builder *command_builder = - XCOMMAND_BUILDER (con->command_builder); - Lisp_Object result; - Lisp_Object event = Fmake_event (Qnil, Qnil); - int speccount = specpdl_depth (); - struct gcpro gcpro1; - GCPRO1 (event); - - if (!NILP (prompt)) - CHECK_STRING (prompt); - /* else prompt = Fkeymap_prompt (current_buffer->keymap); may GC */ - QUIT; - - if (NILP (continue_echo)) - reset_this_command_keys (make_console (con), 1); - - specbind (Qinhibit_quit, Qt); - - if (!NILP (dont_downcase_last)) - specbind (Qretry_undefined_key_binding_unshifted, Qnil); - - for (;;) - { - Fnext_event (event, prompt); - /* restore the selected-console damage */ - con = event_console_or_selected (event); - command_builder = XCOMMAND_BUILDER (con->command_builder); - if (! command_event_p (event)) - execute_internal_event (event); - else - { - if (XEVENT (event)->event_type == misc_user_event) - reset_current_events (command_builder); - result = lookup_command_event (command_builder, event, 1); - if (!KEYMAPP (result)) - { - result = current_events_into_vector (command_builder); - reset_key_echo (command_builder, 0); - break; - } - prompt = Qnil; - } - } - - Vquit_flag = Qnil; /* In case we read a ^G; do not call check_quit() here */ - Fdeallocate_event (event); - RETURN_UNGCPRO (unbind_to (speccount, result)); -} - -DEFUN ("this-command-keys", Fthis_command_keys, 0, 0, 0, /* -Return a vector of the keyboard or mouse button events that were used -to invoke this command. This copies the vector and the events; it is safe -to keep and modify them. -*/ - ()) -{ - Lisp_Object event; - Lisp_Object result; - int len; - - if (NILP (Vthis_command_keys)) - return make_vector (0, Qnil); - - len = event_chain_count (Vthis_command_keys); - - result = make_vector (len, Qnil); - len = 0; - EVENT_CHAIN_LOOP (event, Vthis_command_keys) - XVECTOR_DATA (result)[len++] = Fcopy_event (event, Qnil); - return result; -} - -DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, 0, 0, 0, /* -Used for complicated reasons in `universal-argument-other-key'. - -`universal-argument-other-key' rereads the event just typed. -It then gets translated through `function-key-map'. -The translated event gets included in the echo area and in -the value of `this-command-keys' in addition to the raw original event. -That is not right. - -Calling this function directs the translated event to replace -the original event, so that only one version of the event actually -appears in the echo area and in the value of `this-command-keys.'. -*/ - ()) -{ - /* #### I don't understand this at all, so currently it does nothing. - If there is ever a problem, maybe someone should investigate. */ - return Qnil; -} - - -static void -dribble_out_event (Lisp_Object event) -{ - if (NILP (Vdribble_file)) - return; - - if (XEVENT (event)->event_type == key_press_event && - !XEVENT (event)->event.key.modifiers) - { - Lisp_Object keysym = XEVENT (event)->event.key.keysym; - if (CHARP (XEVENT (event)->event.key.keysym)) - { - Emchar ch = XCHAR (keysym); - Bufbyte str[MAX_EMCHAR_LEN]; - Bytecount len; - - len = set_charptr_emchar (str, ch); - Lstream_write (XLSTREAM (Vdribble_file), str, len); - } - else if (string_char_length (XSYMBOL (keysym)->name) == 1) - /* one-char key events are printed with just the key name */ - Fprinc (keysym, Vdribble_file); - else if (EQ (keysym, Qreturn)) - Lstream_putc (XLSTREAM (Vdribble_file), '\n'); - else if (EQ (keysym, Qspace)) - Lstream_putc (XLSTREAM (Vdribble_file), ' '); - else - Fprinc (event, Vdribble_file); - } - else - Fprinc (event, Vdribble_file); - Lstream_flush (XLSTREAM (Vdribble_file)); -} - -DEFUN ("open-dribble-file", Fopen_dribble_file, 1, 1, - "FOpen dribble file: ", /* -Start writing all keyboard characters to a dribble file called FILE. -If FILE is nil, close any open dribble file. -*/ - (file)) -{ - /* This function can GC */ - /* XEmacs change: always close existing dribble file. */ - /* FSFmacs uses FILE *'s here. With lstreams, that's unnecessary. */ - if (!NILP (Vdribble_file)) - { - Lstream_close (XLSTREAM (Vdribble_file)); - Vdribble_file = Qnil; - } - if (!NILP (file)) - { - int fd; - - file = Fexpand_file_name (file, Qnil); - fd = open ((char*) XSTRING_DATA (file), - O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, - CREAT_MODE); - if (fd < 0) - error ("Unable to create dribble file"); - Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING); -#ifdef MULE - Vdribble_file = - make_encoding_output_stream (XLSTREAM (Vdribble_file), - Fget_coding_system (Qescape_quoted)); -#endif - } - return Qnil; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_event_stream (void) -{ - defsymbol (&Qdisabled, "disabled"); - defsymbol (&Qcommand_event_p, "command-event-p"); - - deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence", - "Undefined keystroke sequence", Qerror); - defsymbol (&Qcommand_execute, "command-execute"); - - DEFSUBR (Frecent_keys); - DEFSUBR (Frecent_keys_ring_size); - DEFSUBR (Fset_recent_keys_ring_size); - DEFSUBR (Finput_pending_p); - DEFSUBR (Fenqueue_eval_event); - DEFSUBR (Fnext_event); - DEFSUBR (Fnext_command_event); - DEFSUBR (Fdiscard_input); - DEFSUBR (Fsit_for); - DEFSUBR (Fsleep_for); - DEFSUBR (Faccept_process_output); - DEFSUBR (Fadd_timeout); - DEFSUBR (Fdisable_timeout); - DEFSUBR (Fadd_async_timeout); - DEFSUBR (Fdisable_async_timeout); - DEFSUBR (Fdispatch_event); - DEFSUBR (Fread_key_sequence); - DEFSUBR (Fthis_command_keys); - DEFSUBR (Freset_this_command_lengths); - DEFSUBR (Fopen_dribble_file); -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) - DEFSUBR (Faccelerate_menu); -#endif - - defsymbol (&Qpre_command_hook, "pre-command-hook"); - defsymbol (&Qpost_command_hook, "post-command-hook"); - defsymbol (&Qunread_command_events, "unread-command-events"); - defsymbol (&Qunread_command_event, "unread-command-event"); - defsymbol (&Qpre_idle_hook, "pre-idle-hook"); -#ifdef ILL_CONCEIVED_HOOK - defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook"); -#endif -#ifdef DEFERRED_ACTION_CRAP - defsymbol (&Qdeferred_action_function, "deferred-action-function"); -#endif - defsymbol (&Qretry_undefined_key_binding_unshifted, - "retry-undefined-key-binding-unshifted"); - defsymbol (&Qauto_show_make_point_visible, - "auto-show-make-point-visible"); - - defsymbol (&Qmenu_force, "menu-force"); - defsymbol (&Qmenu_fallback, "menu-fallback"); - - defsymbol (&Qmenu_quit, "menu-quit"); - defsymbol (&Qmenu_up, "menu-up"); - defsymbol (&Qmenu_down, "menu-down"); - defsymbol (&Qmenu_left, "menu-left"); - defsymbol (&Qmenu_right, "menu-right"); - defsymbol (&Qmenu_select, "menu-select"); - defsymbol (&Qmenu_escape, "menu-escape"); - - defsymbol (&Qcancel_mode_internal, "cancel-mode-internal"); -} - -void -vars_of_event_stream (void) -{ - recent_keys_ring_index = 0; - recent_keys_ring_size = 100; - Vrecent_keys_ring = Qnil; - staticpro (&Vrecent_keys_ring); - - Vthis_command_keys = Qnil; - staticpro (&Vthis_command_keys); - Vthis_command_keys_tail = Qnil; - - num_input_chars = 0; - - command_event_queue = Qnil; - staticpro (&command_event_queue); - command_event_queue_tail = Qnil; - - Vlast_selected_frame = Qnil; - staticpro (&Vlast_selected_frame); - - pending_timeout_list = Qnil; - staticpro (&pending_timeout_list); - - pending_async_timeout_list = Qnil; - staticpro (&pending_async_timeout_list); - - Vtimeout_free_list = make_opaque_list (sizeof (struct timeout), - mark_timeout); - staticpro (&Vtimeout_free_list); - - the_low_level_timeout_blocktype = - Blocktype_new (struct low_level_timeout_blocktype); - - something_happened = 0; - - last_point_position_buffer = Qnil; - staticpro (&last_point_position_buffer); - - recursive_sit_for = Qnil; - - DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /* -*Nonzero means echo unfinished commands after this many seconds of pause. -*/ ); - Vecho_keystrokes = make_int (1); - - DEFVAR_INT ("auto-save-interval", &auto_save_interval /* -*Number of keyboard input characters between auto-saves. -Zero means disable autosaving due to number of characters typed. -See also the variable `auto-save-timeout'. -*/ ); - auto_save_interval = 300; - - DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook /* -Function or functions to run before every command. -This may examine the `this-command' variable to find out what command -is about to be run, or may change it to cause a different command to run. -Function on this hook must be careful to avoid signalling errors! -*/ ); - Vpre_command_hook = Qnil; - - DEFVAR_LISP ("post-command-hook", &Vpost_command_hook /* -Function or functions to run after every command. -This may examine the `this-command' variable to find out what command -was just executed. -*/ ); - Vpost_command_hook = Qnil; - - DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /* -Normal hook run when XEmacs it about to be idle. -This occurs whenever it is going to block, waiting for an event. -This generally happens as a result of a call to `next-event', -`next-command-event', `sit-for', `sleep-for', `accept-process-output', -`x-get-selection', or various Energize-specific commands. -Errors running the hook are caught and ignored. -*/ ); - Vpre_idle_hook = Qnil; - - DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /* -*Variable to control XEmacs behavior with respect to focus changing. -If this variable is set to t, then XEmacs will not gratuitously change -the keyboard focus. XEmacs cannot in general detect when this mode is -used by the window manager, so it is up to the user to set it. -*/ ); - focus_follows_mouse = 0; - -#ifdef ILL_CONCEIVED_HOOK - /* Ill-conceived because it's not run in all sorts of cases - where XEmacs is blocking. That's what `pre-idle-hook' - is designed to solve. */ - xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /* -Normal hook run after each command is executed, if idle. -`post-command-idle-delay' specifies a time in microseconds that XEmacs -must be idle for in order for the functions on this hook to be called. -Errors running the hook are caught and ignored. -*/ ); - Vpost_command_idle_hook = Qnil; - - xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /* -Delay time before running `post-command-idle-hook'. -This is measured in microseconds. -*/ ); - post_command_idle_delay = 5000; -#endif /* ILL_CONCEIVED_HOOK */ - -#ifdef DEFERRED_ACTION_CRAP - /* Random FSFmacs crap. There is absolutely nothing to gain, - and a great deal to lose, in using this in place of just - setting `post-command-hook'. */ - xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /* -List of deferred actions to be performed at a later time. -The precise format isn't relevant here; we just check whether it is nil. -*/ ); - Vdeferred_action_list = Qnil; - - xxDEFVAR_LISP ("deferred-action-function", &Vdeferred_action_function /* -Function to call to handle deferred actions, after each command. -This function is called with no arguments after each command -whenever `deferred-action-list' is non-nil. -*/ ); - Vdeferred_action_function = Qnil; -#endif /* DEFERRED_ACTION_CRAP */ - - DEFVAR_LISP ("last-command-event", &Vlast_command_event /* -Last keyboard or mouse button event that was part of a command. This -variable is off limits: you may not set its value or modify the event that -is its value, as it is destructively modified by `read-key-sequence'. If -you want to keep a pointer to this value, you must use `copy-event'. -*/ ); - Vlast_command_event = Qnil; - - DEFVAR_LISP ("last-command-char", &Vlast_command_char /* -If the value of `last-command-event' is a keyboard event, then -this is the nearest ASCII equivalent to it. This is the value that -`self-insert-command' will put in the buffer. Remember that there is -NOT a 1:1 mapping between keyboard events and ASCII characters: the set -of keyboard events is much larger, so writing code that examines this -variable to determine what key has been typed is bad practice, unless -you are certain that it will be one of a small set of characters. -*/ ); - Vlast_command_char = Qnil; - - DEFVAR_LISP ("last-input-event", &Vlast_input_event /* -Last keyboard or mouse button event received. This variable is off -limits: you may not set its value or modify the event that is its value, as -it is destructively modified by `next-event'. If you want to keep a pointer -to this value, you must use `copy-event'. -*/ ); - Vlast_input_event = Qnil; - - DEFVAR_LISP ("current-mouse-event", &Vcurrent_mouse_event /* -The mouse-button event which invoked this command, or nil. -This is usually what `(interactive "e")' returns. -*/ ); - Vcurrent_mouse_event = Qnil; - - DEFVAR_LISP ("last-input-char", &Vlast_input_char /* -If the value of `last-input-event' is a keyboard event, then -this is the nearest ASCII equivalent to it. Remember that there is -NOT a 1:1 mapping between keyboard events and ASCII characters: the set -of keyboard events is much larger, so writing code that examines this -variable to determine what key has been typed is bad practice, unless -you are certain that it will be one of a small set of characters. -*/ ); - Vlast_input_char = Qnil; - - DEFVAR_LISP ("last-input-time", &Vlast_input_time /* -The time (in seconds since Jan 1, 1970) of the last-command-event, -represented as a cons of two 16-bit integers. This is destructively -modified, so copy it if you want to keep it. -*/ ); - Vlast_input_time = Qnil; - - DEFVAR_LISP ("last-command-event-time", &Vlast_command_event_time /* -The time (in seconds since Jan 1, 1970) of the last-command-event, -represented as a list of three integers. The first integer contains -the most significant 16 bits of the number of seconds, and the second -integer contains the least significant 16 bits. The third integer -contains the remainder number of microseconds, if the current system -supports microsecond clock resolution. This list is destructively -modified, so copy it if you want to keep it. -*/ ); - Vlast_command_event_time = Qnil; - - DEFVAR_LISP ("unread-command-events", &Vunread_command_events /* -List of event objects to be read as next command input events. -This can be used to simulate the receipt of events from the user. -Normally this is nil. -Events are removed from the front of this list. -*/ ); - Vunread_command_events = Qnil; - - DEFVAR_LISP ("unread-command-event", &Vunread_command_event /* -Obsolete. Use `unread-command-events' instead. -*/ ); - Vunread_command_event = Qnil; - - DEFVAR_LISP ("last-command", &Vlast_command /* -The last command executed. Normally a symbol with a function definition, -but can be whatever was found in the keymap, or whatever the variable -`this-command' was set to by that command. -*/ ); - Vlast_command = Qnil; - - DEFVAR_LISP ("this-command", &Vthis_command /* -The command now being executed. -The command can set this variable; whatever is put here -will be in `last-command' during the following command. -*/ ); - Vthis_command = Qnil; - - DEFVAR_LISP ("help-char", &Vhelp_char /* -Character to recognize as meaning Help. -When it is read, do `(eval help-form)', and display result if it's a string. -If the value of `help-form' is nil, this char can be read normally. -This can be any form recognized as a single key specifier. -The help-char cannot be a negative number in XEmacs. -*/ ); - Vhelp_char = make_char (8); /* C-h */ - - DEFVAR_LISP ("help-form", &Vhelp_form /* -Form to execute when character help-char is read. -If the form returns a string, that string is displayed. -If `help-form' is nil, the help char is not recognized. -*/ ); - Vhelp_form = Qnil; - - DEFVAR_LISP ("prefix-help-command", &Vprefix_help_command /* -Command to run when `help-char' character follows a prefix key. -This command is used only when there is no actual binding -for that character after that prefix key. -*/ ); - Vprefix_help_command = Qnil; - - DEFVAR_CONST_LISP ("keyboard-translate-table", &Vkeyboard_translate_table /* -Hash table used as translate table for keyboard input. -Use `keyboard-translate' to portably add entries to this table. -Each key-press event is looked up in this table as follows: - --- If an entry maps a symbol to a symbol, then a key-press event whose - keysym is the former symbol (with any modifiers at all) gets its - keysym changed and its modifiers left alone. This is useful for - dealing with non-standard X keyboards, such as the grievous damage - that Sun has inflicted upon the world. --- If an entry maps a character to a character, then a key-press event - matching the former character gets converted to a key-press event - matching the latter character. This is useful on ASCII terminals - for (e.g.) making C-\\ look like C-s, to get around flow-control - problems. --- If an entry maps a character to a symbol, then a key-press event - matching the character gets converted to a key-press event whose - keysym is the given symbol and which has no modifiers. -*/ ); - - DEFVAR_LISP ("retry-undefined-key-binding-unshifted", - &Vretry_undefined_key_binding_unshifted /* -If a key-sequence which ends with a shifted keystroke is undefined -and this variable is non-nil then the command lookup is retried again -with the last key unshifted. (e.g. C-X C-F would be retried as C-X C-f.) -If lookup still fails, a normal error is signalled. In general, -you should *bind* this, not set it. -*/ ); - Vretry_undefined_key_binding_unshifted = Qt; - -#ifdef HAVE_XIM - DEFVAR_LISP ("composed-character-default-binding", - &Vcomposed_character_default_binding /* -The default keybinding to use for key events from composed input. -Window systems frequently have ways to allow the user to compose -single characters in a language using multiple keystrokes. -XEmacs sees these as single character keypress events. -*/ ); - Vcomposed_character_default_binding = Qself_insert_command; -#endif /* HAVE_XIM */ - - Vcontrolling_terminal = Qnil; - staticpro (&Vcontrolling_terminal); - - Vdribble_file = Qnil; - staticpro (&Vdribble_file); - -#ifdef DEBUG_XEMACS - DEFVAR_INT ("debug-emacs-events", &debug_emacs_events /* -If non-zero, display debug information about Emacs events that XEmacs sees. -Information is displayed on stderr. - -Before the event, the source of the event is displayed in parentheses, -and is one of the following: - -\(real) A real event from the window system or - terminal driver, as far as XEmacs can tell. - -\(keyboard macro) An event generated from a keyboard macro. - -\(unread-command-events) An event taken from `unread-command-events'. - -\(unread-command-event) An event taken from `unread-command-event'. - -\(command event queue) An event taken from an internal queue. - Events end up on this queue when - `enqueue-eval-event' is called or when - user or eval events are received while - XEmacs is blocking (e.g. in `sit-for', - `sleep-for', or `accept-process-output', - or while waiting for the reply to an - X selection). - -\(->keyboard-translate-table) The result of an event translated through - keyboard-translate-table. Note that in - this case, two events are printed even - though only one is really generated. - -\(SIGINT) A faked C-g resulting when XEmacs receives - a SIGINT (e.g. C-c was pressed in XEmacs' - controlling terminal or the signal was - explicitly sent to the XEmacs process). -*/ ); - debug_emacs_events = 0; -#endif - - DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /* -Non-nil inhibits recording of input-events to recent-keys ring. -*/ ); - inhibit_input_event_recording = 0; - - DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /* -Prefix key(s) that must be typed before menu accelerators will be activated. -Set this to a value acceptable by define-key. -*/ ); - Vmenu_accelerator_prefix = Qnil; - - DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /* -Modifier keys which must be pressed to get to the top level menu accelerators. -This is a list of modifier key symbols. All modifier keys must be held down -while a valid menu accelerator key is pressed in order for the top level -menu to become active. - -See also menu-accelerator-enabled and menu-accelerator-prefix. -*/ ); - Vmenu_accelerator_modifiers = list1 (Qmeta); - - DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /* -Whether menu accelerator keys can cause the menubar to become active. -If 'menu-force or 'menu-fallback, then menu accelerator keys can -be used to activate the top level menu. Once the menubar becomes active, the -accelerator keys can be used regardless of the value of this variable. - -menu-force is used to indicate that the menu accelerator key takes -precedence over bindings in the current keymap(s). menu-fallback means -that bindings in the current keymap take precedence over menu accelerator keys. -Thus a top level menu with an accelerator of "T" would be activated on a -keypress of Meta-t if menu-accelerator-enabled is menu-force. -However, if menu-accelerator-enabled is menu-fallback, then -Meta-t will not activate the menubar and will instead run the function -transpose-words, to which it is normally bound. - -See also menu-accelerator-modifiers and menu-accelerator-prefix. -*/ ); - Vmenu_accelerator_enabled = Qnil; -} - -void -complex_vars_of_event_stream (void) -{ - Vkeyboard_translate_table = - make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - - DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /* -Keymap for use when the menubar is active. -The actions menu-quit, menu-up, menu-down, menu-left, menu-right, -menu-select and menu-escape can be mapped to keys in this map. - -menu-quit Immediately deactivate the menubar and any open submenus without - selecting an item. -menu-up Move the menu cursor up one row in the current menu. If the - move extends past the top of the menu, wrap around to the bottom. -menu-down Move the menu cursor down one row in the current menu. If the - move extends past the bottom of the menu, wrap around to the top. - If executed while the cursor is in the top level menu, move down - into the selected menu. -menu-left Move the cursor from a submenu into the parent menu. If executed - while the cursor is in the top level menu, move the cursor to the - left. If the move extends past the left edge of the menu, wrap - around to the right edge. -menu-right Move the cursor into a submenu. If the cursor is located in the - top level menu or is not currently on a submenu heading, then move - the cursor to the next top level menu entry. If the move extends - past the right edge of the menu, wrap around to the left edge. -menu-select Activate the item under the cursor. If the cursor is located on - a submenu heading, then move the cursor into the submenu. -menu-escape Pop up to the next level of menus. Moves from a submenu into its - parent menu. From the top level menu, this deactivates the - menubar. - -This keymap can also contain normal key-command bindings, in which case the -menubar is deactivated and the corresponding command is executed. - -The action bindings used by the menu accelerator code are designed to mimic -the actions of menu traversal keys in a commonly used PC operating system. -*/ ); - Vmenu_accelerator_map = Fmake_keymap(Qnil); -} - -void -init_event_stream (void) -{ - if (initialized) - { -#ifdef HAVE_UNIXOID_EVENT_LOOP - init_event_unixoid (); -#endif -#ifdef HAVE_X_WINDOWS - if (!strcmp (display_use, "x")) - init_event_Xt_late (); - else -#endif -#ifdef HAVE_MS_WINDOWS - if (!strcmp (display_use, "mswindows")) - init_event_mswindows_late (); - else -#endif - { - /* For TTY's, use the Xt event loop if we can; it allows - us to later open an X connection. */ -#if defined (HAVE_MS_WINDOWS) && defined (HAVE_MSG_SELECT) \ - && !defined (DEBUG_TTY_EVENT_STREAM) - init_event_mswindows_late (); -#elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM) - init_event_Xt_late (); -#elif defined (HAVE_TTY) - init_event_tty_late (); -#endif - } - init_interrupts_late (); - } -} - - -/* -useful testcases for v18/v19 compatibility: - -(defun foo () - (interactive) - (setq unread-command-event (character-to-event ?A (allocate-event))) - (setq x (list (read-char) -; (read-key-sequence "") ; try it with and without this - last-command-char last-input-char - (recent-keys) (this-command-keys)))) -(global-set-key "\^Q" 'foo) - -without the read-key-sequence: - ^Q ==> (65 17 65 [... ^Q] [^Q]) - ^U^U^Q ==> (65 17 65 [... ^U ^U ^Q] [^U ^U ^Q]) - ^U^U^U^G^Q ==> (65 17 65 [... ^U ^U ^U ^G ^Q] [^Q]) - -with the read-key-sequence: - ^Qb ==> (65 [b] 17 98 [... ^Q b] [b]) - ^U^U^Qb ==> (65 [b] 17 98 [... ^U ^U ^Q b] [b]) - ^U^U^U^G^Qb ==> (65 [b] 17 98 [... ^U ^U ^U ^G ^Q b] [b]) - -;the evi-mode command "4dlj.j.j.j.j.j." is also a good testcase (gag) - -;(setq x (list (read-char) quit-flag))^J^G -;(let ((inhibit-quit t)) (setq x (list (read-char) quit-flag)))^J^G -;for BOTH, x should get set to (7 t), but no result should be printed. - -;also do this: make two frames, one viewing "*scratch*", the other "foo". -;in *scratch*, type (sit-for 20)^J -;wait a couple of seconds, move cursor to foo, type "a" -;a should be inserted in foo. Cursor highlighting should not change in -;the meantime. - -;do it with sleep-for. move cursor into foo, then back into *scratch* -;before typing. -;repeat also with (accept-process-output nil 20) - -;make sure ^G aborts sit-for, sleep-for and accept-process-output: - - (defun tst () - (list (condition-case c - (sleep-for 20) - (quit c)) - (read-char))) - - (tst)^Ja^G ==> ((quit) 97) with no signal - (tst)^J^Ga ==> ((quit) 97) with no signal - (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer - -; with sit-for only do the 2nd test. -; Do all 3 tests with (accept-process-output nil 20) - -Do this: - (setq enable-recursive-minibuffers t - minibuffer-max-depth nil) - ESC ESC ESC ESC - there are now two minibuffers active - C-g C-g C-g - there should be active 0, not 1 -Similarly: - C-x C-f ~ / ? - wait for "Making completion list..." to display - C-g - wait for "Quit" to display - C-g - minibuffer should not be active -however C-g before "Quit" is displayed should leave minibuffer active. - -;do it all in both v18 and v19 and make sure all results are the same. -;all of these cases matter a lot, but some in quite subtle ways. -*/ - -/* -Additional test cases for accept-process-output, sleep-for, sit-for. -Be sure you do all of the above checking for C-g and focus, too! - -; Make sure that timer handlers are run during, not after sit-for: -(defun timer-check () - (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil) - (sit-for 5) - (message "after sit-for")) - -; The first message should appear after 2 seconds, and the final message -; 3 seconds after that. -; repeat above test with (sleep-for 5) and (accept-process-output nil 5) - - - -; Make sure that process filters are run during, not after sit-for. -(defun fubar () - (message "sit-for = %s" (sit-for 30))) -(add-hook 'post-command-hook 'fubar) - -; Now type M-x shell RET -; wait for the shell prompt then send: ls RET -; the output of ls should fill immediately, and not wait 30 seconds. - -; repeat above test with (sleep-for 30) and (accept-process-output nil 30) - - - -; Make sure that recursive invocations return immediately: -(defmacro test-diff-time (start end) - `(+ (* (- (car ,end) (car ,start)) 65536.0) - (- (cadr ,end) (cadr ,start)) - (/ (- (caddr ,end) (caddr ,start)) 1000000.0))) - -(defun testee (ignore) - (sit-for 10)) - -(defun test-them () - (let ((start (current-time)) - end) - (add-timeout 2 'testee nil) - (sit-for 5) - (add-timeout 2 'testee nil) - (sleep-for 5) - (add-timeout 2 'testee nil) - (accept-process-output nil 5) - (setq end (current-time)) - (test-diff-time start end))) - -(test-them) should sit for 15 seconds. -Repeat with testee set to sleep-for and accept-process-output. -These should each delay 36 seconds. - -*/ diff --git a/src/event-tty.c b/src/event-tty.c deleted file mode 100644 index 0e44cf4..0000000 --- a/src/event-tty.c +++ /dev/null @@ -1,270 +0,0 @@ -/* The event_stream interface for tty's. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995 Ben Wing. - -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. */ - -#include -#include "lisp.h" - -#include "device.h" -#include "console-tty.h" -#include "events.h" -#include "frame.h" -#include "process.h" - -#include "sysproc.h" -#include "syswait.h" -#include "systime.h" - -/* Mask of bits indicating the descriptors that we wait for input on */ -extern SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; -extern SELECT_TYPE process_only_mask, tty_only_mask; - -static struct event_stream *tty_event_stream; - - -/************************************************************************/ -/* timeout events */ -/************************************************************************/ - -/* The pending timers are stored in an ordered list, where the first timer - on the list is the first one to fire. Times recorded here are - absolute. */ -static struct low_level_timeout *tty_timer_queue; - -static int -emacs_tty_add_timeout (EMACS_TIME thyme) -{ - return add_low_level_timeout (&tty_timer_queue, thyme); -} - -static void -emacs_tty_remove_timeout (int id) -{ - remove_low_level_timeout (&tty_timer_queue, id); -} - -static void -tty_timeout_to_emacs_event (struct Lisp_Event *emacs_event) -{ - emacs_event->event_type = timeout_event; - /* timeout events have nil as channel */ - emacs_event->timestamp = 0; /* #### */ - emacs_event->event.timeout.interval_id = - pop_low_level_timeout (&tty_timer_queue, 0); - emacs_event->event.timeout.function = Qnil; - emacs_event->event.timeout.object = Qnil; -} - - - -static int -emacs_tty_event_pending_p (int user_p) -{ - if (!user_p) - { - EMACS_TIME sometime; - /* see if there's a pending timeout. */ - EMACS_GET_TIME (sometime); - if (tty_timer_queue && - EMACS_TIME_EQUAL_OR_GREATER (sometime, tty_timer_queue->time)) - return 1; - } - - return poll_fds_for_input (user_p ? tty_only_mask : - non_fake_input_wait_mask); -} - -struct console * -tty_find_console_from_fd (int fd) -{ - Lisp_Object concons; - - CONSOLE_LOOP (concons) - { - struct console *c; - - c = XCONSOLE (XCAR (concons)); - if (CONSOLE_TTY_P (c) && CONSOLE_TTY_DATA (c)->infd == fd) - return c; - } - - return 0; -} - -static void -emacs_tty_next_event (struct Lisp_Event *emacs_event) -{ - while (1) - { - int ndesc; - int i; - SELECT_TYPE temp_mask = input_wait_mask; - EMACS_TIME time_to_block; - EMACS_SELECT_TIME select_time_to_block, *pointer_to_this; - - if (!get_low_level_timeout_interval (tty_timer_queue, &time_to_block)) - /* no timer events; block indefinitely */ - pointer_to_this = 0; - else - { - EMACS_TIME_TO_SELECT_TIME (time_to_block, select_time_to_block); - pointer_to_this = &select_time_to_block; - } - - ndesc = select (MAXDESC, &temp_mask, 0, 0, pointer_to_this); - if (ndesc > 0) - { - /* Look for a TTY event */ - for (i = 0; i < MAXDESC; i++) - { - /* To avoid race conditions (among other things, an infinite - loop when called from Fdiscard_input()), we must return - user events ahead of process events. */ - if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &tty_only_mask)) - { - struct console *c = tty_find_console_from_fd (i); - - assert (c); - if (read_event_from_tty_or_stream_desc (emacs_event, c, i)) - return; - } - } - - /* Look for a process event */ - for (i = 0; i < MAXDESC; i++) - { - if (FD_ISSET (i, &temp_mask) && FD_ISSET (i, &process_only_mask)) - { - Lisp_Object process; - struct Lisp_Process *p = - get_process_from_usid (FD_TO_USID(i)); - - assert (p); - XSETPROCESS (process, p); - emacs_event->event_type = process_event; - /* process events have nil as channel */ - emacs_event->timestamp = 0; /* #### */ - emacs_event->event.process.process = process; - return; - } - } - - /* We might get here when a fake event came through a signal. */ - /* Return a dummy event, so that a cycle of the command loop will - occur. */ - drain_signal_event_pipe (); - emacs_event->event_type = eval_event; - /* eval events have nil as channel */ - emacs_event->event.eval.function = Qidentity; - emacs_event->event.eval.object = Qnil; - return; - } - else if (ndesc == 0) /* timeout fired */ - { - tty_timeout_to_emacs_event (emacs_event); - return; - } - } -} - -static void -emacs_tty_handle_magic_event (struct Lisp_Event *emacs_event) -{ - /* Nothing to do currently */ -} - - -static void -emacs_tty_select_process (struct Lisp_Process *process) -{ - event_stream_unixoid_select_process (process); -} - -static void -emacs_tty_unselect_process (struct Lisp_Process *process) -{ - event_stream_unixoid_unselect_process (process); -} - -static void -emacs_tty_select_console (struct console *con) -{ - event_stream_unixoid_select_console (con); -} - -static void -emacs_tty_unselect_console (struct console *con) -{ - event_stream_unixoid_unselect_console (con); -} - -static void -emacs_tty_quit_p (void) -{ - /* Nothing to do currently because QUIT is handled through SIGINT. - This could change. */ -} - -static USID -emacs_tty_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, Lisp_Object* outstream, int flags) -{ - return event_stream_unixoid_create_stream_pair - (inhandle, outhandle, instream, outstream, flags); -} - -static USID -emacs_tty_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream) -{ - return event_stream_unixoid_delete_stream_pair (instream, outstream); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -vars_of_event_tty (void) -{ - tty_event_stream = xnew (struct event_stream); - - tty_event_stream->event_pending_p = emacs_tty_event_pending_p; - tty_event_stream->next_event_cb = emacs_tty_next_event; - tty_event_stream->handle_magic_event_cb = emacs_tty_handle_magic_event; - tty_event_stream->add_timeout_cb = emacs_tty_add_timeout; - tty_event_stream->remove_timeout_cb = emacs_tty_remove_timeout; - tty_event_stream->select_console_cb = emacs_tty_select_console; - tty_event_stream->unselect_console_cb = emacs_tty_unselect_console; - tty_event_stream->select_process_cb = emacs_tty_select_process; - tty_event_stream->unselect_process_cb = emacs_tty_unselect_process; - tty_event_stream->quit_p_cb = emacs_tty_quit_p; - tty_event_stream->create_stream_pair_cb = emacs_tty_create_stream_pair; - tty_event_stream->delete_stream_pair_cb = emacs_tty_delete_stream_pair; -} - -void -init_event_tty_late (void) -{ - event_stream = tty_event_stream; -} diff --git a/src/event-unixoid.c b/src/event-unixoid.c deleted file mode 100644 index 072ac61..0000000 --- a/src/event-unixoid.c +++ /dev/null @@ -1,364 +0,0 @@ -/* Code shared between all event loops that use select() and have a - different input descriptor for each device. - Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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 file has been Mule-ized. */ - -#include -#include "lisp.h" - -#include "console-stream.h" -#include "console-tty.h" -#include "device.h" -#include "events.h" -#include "lstream.h" -#include "process.h" - -#include "sysdep.h" -#include "sysfile.h" -#include "sysproc.h" /* select stuff */ -#include "systime.h" - -#ifdef HAVE_GPM -#include "gpmevent.h" -#endif - -/* Mask of bits indicating the descriptors that we wait for input on. - These work as follows: - - input_wait_mask == mask of all file descriptors we select() on, - including TTY/stream console descriptors, - process descriptors, and the signal event pipe. - Only used in event-tty.c; event-Xt.c uses - XtAppAddInput(), and the call to select() is down in - the guts of Xt. - - non_fake_input_wait_mask == same as input_wait_mask but minus the - signal event pipe. Also only used in - event-tty.c. - - process_only_mask == only the process descriptors. - - tty_only_mask == only the TTY/stream console descriptors. - */ -SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; -SELECT_TYPE process_only_mask, tty_only_mask; - -/* This is used to terminate the select(), when an event came in - through a signal (e.g. window-change or C-g on controlling TTY). */ -int signal_event_pipe[2]; - -int signal_event_pipe_initialized; - -int fake_event_occurred; - -int -read_event_from_tty_or_stream_desc (struct Lisp_Event *event, - struct console *con, int fd) -{ - unsigned char ch; - int nread; - Lisp_Object console; - - XSETCONSOLE (console, con); - -#ifdef HAVE_GPM - if (fd == CONSOLE_TTY_MOUSE_FD (con)) { - return handle_gpm_read (event,con,fd); - } -#endif - - nread = read (fd, &ch, 1); - if (nread <= 0) - { - /* deleting the console might not be safe right now ... */ - enqueue_magic_eval_event (io_error_delete_console, console); - /* but we definitely need to unselect it to avoid infinite - loops reading EOF's */ - Fconsole_disable_input (console); - } - else - { - character_to_event (ch, event, con, 1, 1); - event->channel = console; - return 1; - } - return 0; -} - -void -signal_fake_event (void) -{ - char byte = 0; - /* We do the write always. Formerly I tried to "optimize" this - by setting a flag indicating whether we're blocking and only - doing the write in that case, but there is a race condition - if the signal occurs after we've checked for the signal - occurrence (which could occur in many places throughout - an iteration of the command loop, e.g. in status_notify()), - but before we set the blocking flag. - - This should be OK as long as write() is reentrant, which - I'm fairly sure it is since it's a system call. */ - - if (signal_event_pipe_initialized) - /* In case a signal comes through while we're dumping */ - { - int old_errno = errno; - write (signal_event_pipe[1], &byte, 1); - errno = old_errno; - } -} - -void -drain_signal_event_pipe (void) -{ - char chars[128]; - /* The input end of the pipe has been set to non-blocking. */ - while (read (signal_event_pipe[0], chars, sizeof (chars)) > 0) - ; -} - -int -event_stream_unixoid_select_console (struct console *con) -{ - int infd; - - if (CONSOLE_STREAM_P (con)) - infd = fileno (CONSOLE_STREAM_DATA (con)->infd); - else - { - assert (CONSOLE_TTY_P (con)); - infd = CONSOLE_TTY_DATA (con)->infd; - } - - assert (infd >= 0); - - FD_SET (infd, &input_wait_mask); - FD_SET (infd, &non_fake_input_wait_mask); - FD_SET (infd, &tty_only_mask); - return infd; -} - -int -event_stream_unixoid_unselect_console (struct console *con) -{ - int infd; - - if (CONSOLE_STREAM_P (con)) - infd = fileno (CONSOLE_STREAM_DATA (con)->infd); - else - { - assert (CONSOLE_TTY_P (con)); - infd = CONSOLE_TTY_DATA (con)->infd; - } - - assert (infd >= 0); - - FD_CLR (infd, &input_wait_mask); - FD_CLR (infd, &non_fake_input_wait_mask); - FD_CLR (infd, &tty_only_mask); - return infd; -} - -static int -get_process_infd (struct Lisp_Process *p) -{ - Lisp_Object instr, outstr; - get_process_streams (p, &instr, &outstr); - assert (!NILP (instr)); - return filedesc_stream_fd (XLSTREAM (instr)); -} - -int -event_stream_unixoid_select_process (struct Lisp_Process *proc) -{ - int infd = get_process_infd (proc); - - FD_SET (infd, &input_wait_mask); - FD_SET (infd, &non_fake_input_wait_mask); - FD_SET (infd, &process_only_mask); - return infd; -} - -int -event_stream_unixoid_unselect_process (struct Lisp_Process *proc) -{ - int infd = get_process_infd (proc); - - FD_CLR (infd, &input_wait_mask); - FD_CLR (infd, &non_fake_input_wait_mask); - FD_CLR (infd, &process_only_mask); - return infd; -} - -int -poll_fds_for_input (SELECT_TYPE mask) -{ - EMACS_TIME sometime; - EMACS_SELECT_TIME select_time; - SELECT_TYPE temp_mask; - int retval; - - while (1) - { - EMACS_SET_SECS_USECS (sometime, 0, 0); - EMACS_TIME_TO_SELECT_TIME (sometime, select_time); - temp_mask = mask; - /* To effect a poll, tell select() to block for zero seconds. */ - retval = select (MAXDESC, &temp_mask, 0, 0, &select_time); - if (retval >= 0) - return retval; - if (errno != EINTR) - { - /* Something went seriously wrong; don't abort since maybe - the TTY just died at the wrong time. */ - fprintf (stderr, "xemacs: select failed: errno = %d\n", errno); - return 0; - } - /* else, we got interrupted by a signal, so try again. */ - } - - RETURN_NOT_REACHED(0) /* not reached */ -} - -/****************************************************************************/ -/* Unixoid (file descriptors based) process I/O streams routines */ -/****************************************************************************/ - -USID -event_stream_unixoid_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, - Lisp_Object* outstream, - int flags) -{ - int infd, outfd; - /* Decode inhandle and outhandle. Their meaning depends on - the process implementation being used. */ -#if defined (HAVE_WIN32_PROCESSES) - /* We're passed in Windows handles. Open new fds for them */ - if ((HANDLE)inhandle != INVALID_HANDLE_VALUE) - { - infd = open_osfhandle ((HANDLE)inhandle, 0); - if (infd < 0) - return USID_ERROR; - } - else - infd = -1; - - if ((HANDLE)outhandle != INVALID_HANDLE_VALUE) - { - outfd = open_osfhandle ((HANDLE)outhandle, 0); - if (outfd < 0) - { - if (infd >= 0) - close (infd); - return USID_ERROR; - } - } - else - outfd = -1; - - flags = 0; -#elif defined (HAVE_UNIX_PROCESSES) - /* We are passed plain old file descs */ - infd = (int)inhandle; - outfd = (int)outhandle; -#else -# error Which processes do you have? -#endif - - *instream = (infd >= 0 - ? make_filedesc_input_stream (infd, 0, -1, 0) - : Qnil); - - *outstream = (outfd >= 0 - ? make_filedesc_output_stream (outfd, 0, -1, LSTR_BLOCKED_OK) - : Qnil); - -#if defined(HAVE_UNIX_PROCESSES) && defined(HAVE_PTYS) - /* FLAGS is process->pty_flag for UNIX_PROCESSES */ - if ((flags & STREAM_PTY_FLUSHING) && outfd >= 0) - { - Bufbyte eof_char = get_eof_char (outfd); - int pty_max_bytes = get_pty_max_bytes (outfd); - filedesc_stream_set_pty_flushing (XLSTREAM(*outstream), pty_max_bytes, eof_char); - } -#endif - - return FD_TO_USID (infd); -} - -USID -event_stream_unixoid_delete_stream_pair (Lisp_Object instream, - Lisp_Object outstream) -{ - int in = (NILP(instream) ? -1 - : filedesc_stream_fd (XLSTREAM (instream))); - int out = (NILP(outstream) ? -1 - : filedesc_stream_fd (XLSTREAM (outstream))); - - if (in >= 0) - close (in); - if (out != in && out >= 0) - close (out); - - return FD_TO_USID (in); -} - - -void -init_event_unixoid (void) -{ - /* Do this first; the init_event_*_late() functions - pay attention to it. */ - if (pipe (signal_event_pipe) < 0) - { - perror ("XEmacs: can't open pipe"); - exit (-1); - } - signal_event_pipe_initialized = 1; - - /* Set it non-blocking so we can drain its output. */ - set_descriptor_non_blocking (signal_event_pipe[0]); - - /* Also set the write descriptor non-blocking so we don't - hang in case a long time passes between times when - we drain the pipe. */ - set_descriptor_non_blocking (signal_event_pipe[1]); - - /* WARNING: In order for the signal-event pipe to work correctly - and not cause lockups, the following need to be followed: - - 1) event_pending_p() must ignore input on the signal-event pipe. - 2) As soon as next_event() notices input on the signal-event - pipe, it must drain it. */ - FD_ZERO (&input_wait_mask); - FD_ZERO (&non_fake_input_wait_mask); - FD_ZERO (&process_only_mask); - FD_ZERO (&tty_only_mask); - - FD_SET (signal_event_pipe[0], &input_wait_mask); -} diff --git a/src/events-mod.h b/src/events-mod.h deleted file mode 100644 index 48da194..0000000 --- a/src/events-mod.h +++ /dev/null @@ -1,8 +0,0 @@ -/* The modifiers XEmacs knows about; these appear in key and button events. */ - -#define MOD_CONTROL (1<<0) -#define MOD_META (1<<1) -#define MOD_SUPER (1<<2) -#define MOD_HYPER (1<<3) -#define MOD_ALT (1<<4) -#define MOD_SHIFT (1<<5) /* not used for dual-case characters */ diff --git a/src/events.c b/src/events.c deleted file mode 100644 index 143782f..0000000 --- a/src/events.c +++ /dev/null @@ -1,2264 +0,0 @@ -/* Events: printing them, converting them to and from characters. - Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - -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 file has been Mule-ized. */ - -#include -#include "lisp.h" -#include "buffer.h" -#include "console.h" -#include "console-tty.h" /* for stuff in character_to_event */ -#include "device.h" -#include "console-x.h" /* for x_event_name prototype */ -#include "extents.h" /* Just for the EXTENTP abort check... */ -#include "events.h" -#include "frame.h" -#include "glyphs.h" -#include "keymap.h" /* for key_desc_list_to_event() */ -#include "redisplay.h" -#include "window.h" - -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - -#include "events-mod.h" - -/* Where old events go when they are explicitly deallocated. - The event chain here is cut loose before GC, so these will be freed - eventually. - */ -static Lisp_Object Vevent_resource; - -Lisp_Object Qeventp; -Lisp_Object Qevent_live_p; -Lisp_Object Qkey_press_event_p; -Lisp_Object Qbutton_event_p; -Lisp_Object Qmouse_event_p; -Lisp_Object Qprocess_event_p; - -Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user; -Lisp_Object Qascii_character; - -EXFUN (Fevent_x_pixel, 1); -EXFUN (Fevent_y_pixel, 1); - -/* #### Ad-hoc hack. Should be part of define_lrecord_implementation */ -void -clear_event_resource (void) -{ - Vevent_resource = Qnil; -} - -/* Make sure we lose quickly if we try to use this event */ -static void -deinitialize_event (Lisp_Object ev) -{ - int i; - struct Lisp_Event *event = XEVENT (ev); - - for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++) - ((int *) event) [i] = 0xdeadbeef; - event->event_type = dead_event; - event->channel = Qnil; - set_lheader_implementation (&(event->lheader), lrecord_event); - XSET_EVENT_NEXT (ev, Qnil); -} - -/* Set everything to zero or nil so that it's predictable. */ -void -zero_event (struct Lisp_Event *e) -{ - xzero (*e); - set_lheader_implementation (&(e->lheader), lrecord_event); - e->event_type = empty_event; - e->next = Qnil; - e->channel = Qnil; -} - -static Lisp_Object -mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Event *event = XEVENT (obj); - - switch (event->event_type) - { - case key_press_event: - markobj (event->event.key.keysym); - break; - case process_event: - markobj (event->event.process.process); - break; - case timeout_event: - markobj (event->event.timeout.function); - markobj (event->event.timeout.object); - break; - case eval_event: - case misc_user_event: - markobj (event->event.eval.function); - markobj (event->event.eval.object); - break; - case magic_eval_event: - markobj (event->event.magic_eval.object); - break; - case button_press_event: - case button_release_event: - case pointer_motion_event: - case magic_event: - case empty_event: - case dead_event: - break; - default: - abort (); - } - markobj (event->channel); - return event->next; -} - -static void -print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun) -{ - char buf[255]; - write_c_string (str, printcharfun); - format_event_object (buf, XEVENT (obj), 0); - write_c_string (buf, printcharfun); -} - -static void -print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - if (print_readably) - error ("Printing unreadable object #"); - - switch (XEVENT (obj)->event_type) - { - case key_press_event: - print_event_1 ("#event.process.process, printcharfun, 1); - break; - case timeout_event: - write_c_string ("#event.timeout.object, printcharfun, 1); - break; - case empty_event: - write_c_string ("#event.misc.function, printcharfun, 1); - write_c_string (" ", printcharfun); - print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1); - write_c_string (")", printcharfun); - break; - case eval_event: - write_c_string ("#event.eval.function, printcharfun, 1); - write_c_string (" ", printcharfun); - print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1); - write_c_string (")", printcharfun); - break; - case dead_event: - write_c_string ("#", printcharfun); -} - -static int -event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Event *e1 = XEVENT (obj1); - struct Lisp_Event *e2 = XEVENT (obj2); - - if (e1->event_type != e2->event_type) return 0; - if (!EQ (e1->channel, e2->channel)) return 0; -/* if (e1->timestamp != e2->timestamp) return 0; */ - switch (e1->event_type) - { - default: abort (); - - case process_event: - return EQ (e1->event.process.process, e2->event.process.process); - - case timeout_event: - return (internal_equal (e1->event.timeout.function, - e2->event.timeout.function, 0) && - internal_equal (e1->event.timeout.object, - e2->event.timeout.object, 0)); - - case key_press_event: - return (EQ (e1->event.key.keysym, e2->event.key.keysym) && - (e1->event.key.modifiers == e2->event.key.modifiers)); - - case button_press_event: - case button_release_event: - return (e1->event.button.button == e2->event.button.button && - e1->event.button.modifiers == e2->event.button.modifiers); - - case pointer_motion_event: - return (e1->event.motion.x == e2->event.motion.x && - e1->event.motion.y == e2->event.motion.y); - - case misc_user_event: - return (internal_equal (e1->event.eval.function, - e2->event.eval.function, 0) && - internal_equal (e1->event.eval.object, - e2->event.eval.object, 0) && - /* is this really needed for equality - or is x and y also important? */ - e1->event.misc.button == e2->event.misc.button && - e1->event.misc.modifiers == e2->event.misc.modifiers); - - case eval_event: - return (internal_equal (e1->event.eval.function, - e2->event.eval.function, 0) && - internal_equal (e1->event.eval.object, - e2->event.eval.object, 0)); - - case magic_eval_event: - return (e1->event.magic_eval.internal_function == - e2->event.magic_eval.internal_function && - internal_equal (e1->event.magic_eval.object, - e2->event.magic_eval.object, 0)); - - case magic_event: - { - struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel)); - -#ifdef HAVE_X_WINDOWS - if (CONSOLE_X_P (con)) - return (e1->event.magic.underlying_x_event.xany.serial == - e2->event.magic.underlying_x_event.xany.serial); -#endif -#ifdef HAVE_TTY - if (CONSOLE_TTY_P (con)) - return (e1->event.magic.underlying_tty_event == - e2->event.magic.underlying_tty_event); -#endif -#ifdef HAVE_MS_WINDOWS - if (CONSOLE_MSWINDOWS_P (con)) - return (!memcmp(&e1->event.magic.underlying_mswindows_event, - &e2->event.magic.underlying_mswindows_event, - sizeof(union magic_data))); -#endif - return 1; /* not reached */ - } - - case empty_event: /* Empty and deallocated events are equal. */ - case dead_event: - return 1; - } -} - -static unsigned long -event_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Event *e = XEVENT (obj); - unsigned long hash; - - hash = HASH2 (e->event_type, LISP_HASH (e->channel)); - switch (e->event_type) - { - case process_event: - return HASH2 (hash, LISP_HASH (e->event.process.process)); - - case timeout_event: - return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1), - internal_hash (e->event.timeout.object, depth + 1)); - - case key_press_event: - return HASH3 (hash, LISP_HASH (e->event.key.keysym), - e->event.key.modifiers); - - case button_press_event: - case button_release_event: - return HASH3 (hash, e->event.button.button, e->event.button.modifiers); - - case pointer_motion_event: - return HASH3 (hash, e->event.motion.x, e->event.motion.y); - - case misc_user_event: - return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1), - internal_hash (e->event.misc.object, depth + 1), - e->event.misc.button, e->event.misc.modifiers); - - case eval_event: - return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1), - internal_hash (e->event.eval.object, depth + 1)); - - case magic_eval_event: - return HASH3 (hash, - (unsigned long) e->event.magic_eval.internal_function, - internal_hash (e->event.magic_eval.object, depth + 1)); - - case magic_event: - { - struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e))); -#ifdef HAVE_X_WINDOWS - if (CONSOLE_X_P (con)) - return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial); -#endif -#ifdef HAVE_TTY - if (CONSOLE_TTY_P (con)) - return HASH2 (hash, e->event.magic.underlying_tty_event); -#endif -#ifdef HAVE_MS_WINDOWS - if (CONSOLE_MSWINDOWS_P (con)) - return HASH2 (hash, e->event.magic.underlying_mswindows_event); -#endif - } - - case empty_event: - case dead_event: - return hash; - - default: - abort (); - } - - return 0; /* unreached */ -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, - mark_event, print_event, 0, event_equal, - event_hash, struct Lisp_Event); - - -DEFUN ("make-event", Fmake_event, 0, 2, 0, /* -Return a new event of type TYPE, with properties described by PLIST. - -TYPE is a symbol, either `empty', `key-press', `button-press', - `button-release', `misc-user' or `motion'. If TYPE is nil, it - defaults to `empty'. - -PLIST is a property list, the properties being compatible to those - returned by `event-properties'. The following properties are - allowed: - - channel -- The event channel, a frame or a console. For - button-press, button-release, misc-user and motion events, - this must be a frame. For key-press events, it must be - a console. If channel is unspecified, it will be set to - the selected frame or selected console, as appropriate. - key -- The event key, a symbol or character. Allowed only for - keypress events. - button -- The event button, integer 1, 2 or 3. Allowed for - button-press, button-release and misc-user events. - modifiers -- The event modifiers, a list of modifier symbols. Allowed - for key-press, button-press, button-release, motion and - misc-user events. - function -- Function. Allowed for misc-user events only. - object -- An object, function's parameter. Allowed for misc-user - events only. - x -- The event X coordinate, an integer. This is relative - to the left of CHANNEL's root window. Allowed for - motion, button-press, button-release and misc-user events. - y -- The event Y coordinate, an integer. This is relative - to the top of CHANNEL's root window. Allowed for - motion, button-press, button-release and misc-user events. - timestamp -- The event timestamp, a non-negative integer. Allowed for - all types of events. If unspecified, it will be set to 0 - by default. - -For event type `empty', PLIST must be nil. - `button-release', or `motion'. If TYPE is left out, it defaults to - `empty'. -PLIST is a list of properties, as returned by `event-properties'. Not - all properties are allowed for all kinds of events, and some are - required. - -WARNING: the event object returned may be a reused one; see the function - `deallocate-event'. -*/ - (type, plist)) -{ - Lisp_Object tail, keyword, value; - Lisp_Object event = Qnil; - struct Lisp_Event *e; - EMACS_INT coord_x = 0, coord_y = 0; - struct gcpro gcpro1; - - GCPRO1 (event); - - if (NILP (type)) - type = Qempty; - - if (!NILP (Vevent_resource)) - { - event = Vevent_resource; - Vevent_resource = XEVENT_NEXT (event); - } - else - { - event = allocate_event (); - } - e = XEVENT (event); - zero_event (e); - - if (EQ (type, Qempty)) - { - /* For empty event, we return immediately, without processing - PLIST. In fact, processing PLIST would be wrong, because the - sanitizing process would fill in the properties - (e.g. CHANNEL), which we don't want in empty events. */ - e->event_type = empty_event; - if (!NILP (plist)) - error ("Cannot set properties of empty event"); - UNGCPRO; - return event; - } - else if (EQ (type, Qkey_press)) - { - e->event_type = key_press_event; - e->event.key.keysym = Qunbound; - } - else if (EQ (type, Qbutton_press)) - e->event_type = button_press_event; - else if (EQ (type, Qbutton_release)) - e->event_type = button_release_event; - else if (EQ (type, Qmotion)) - e->event_type = pointer_motion_event; - else if (EQ (type, Qmisc_user)) - { - e->event_type = misc_user_event; - e->event.eval.function = e->event.eval.object = Qnil; - } - else - { - /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */ - signal_simple_error ("Invalid event type", type); - } - - EVENT_CHANNEL (e) = Qnil; - - plist = Fcopy_sequence (plist); - Fcanonicalize_plist (plist, Qnil); - -#define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \ - error_with_frob (prop, "Invalid property for %s event", \ - string_data (symbol_name (XSYMBOL (type)))) - - EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist) - { - if (EQ (keyword, Qchannel)) - { - if (e->event_type == key_press_event) - { - if (!CONSOLEP (value)) - value = wrong_type_argument (Qconsolep, value); - } - else - { - if (!FRAMEP (value)) - value = wrong_type_argument (Qframep, value); - } - EVENT_CHANNEL (e) = value; - } - else if (EQ (keyword, Qkey)) - { - switch (e->event_type) - { - case key_press_event: - if (!SYMBOLP (value) && !CHARP (value)) - signal_simple_error ("Invalid event key", value); - e->event.key.keysym = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qbutton)) - { - CHECK_NATNUM (value); - check_int_range (XINT (value), 0, 7); - - switch (e->event_type) - { - case button_press_event: - case button_release_event: - e->event.button.button = XINT (value); - break; - case misc_user_event: - e->event.misc.button = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qmodifiers)) - { - int modifiers = 0; - Lisp_Object sym; - - EXTERNAL_LIST_LOOP_2 (sym, value) - { - if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; - else if (EQ (sym, Qmeta)) modifiers |= MOD_META; - else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; - else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; - else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; - else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; - else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; - else - signal_simple_error ("Invalid key modifier", sym); - } - - switch (e->event_type) - { - case key_press_event: - e->event.key.modifiers = modifiers; - break; - case button_press_event: - case button_release_event: - e->event.button.modifiers = modifiers; - break; - case pointer_motion_event: - e->event.motion.modifiers = modifiers; - break; - case misc_user_event: - e->event.misc.modifiers = modifiers; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qx)) - { - switch (e->event_type) - { - case pointer_motion_event: - case button_press_event: - case button_release_event: - case misc_user_event: - /* Allow negative values, so we can specify toolbar - positions. */ - CHECK_INT (value); - coord_x = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qy)) - { - switch (e->event_type) - { - case pointer_motion_event: - case button_press_event: - case button_release_event: - case misc_user_event: - /* Allow negative values; see above. */ - CHECK_INT (value); - coord_y = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qtimestamp)) - { - CHECK_NATNUM (value); - e->timestamp = XINT (value); - } - else if (EQ (keyword, Qfunction)) - { - switch (e->event_type) - { - case misc_user_event: - e->event.eval.function = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qobject)) - { - switch (e->event_type) - { - case misc_user_event: - e->event.eval.object = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else - signal_simple_error_2 ("Invalid property", keyword, value); - } - - /* Insert the channel, if missing. */ - if (NILP (EVENT_CHANNEL (e))) - { - if (e->event_type == key_press_event) - EVENT_CHANNEL (e) = Vselected_console; - else - EVENT_CHANNEL (e) = Fselected_frame (Qnil); - } - - /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative - to the frame, so we must adjust accordingly. */ - if (FRAMEP (EVENT_CHANNEL (e))) - { - coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e))); - coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e))); - - switch (e->event_type) - { - case pointer_motion_event: - e->event.motion.x = coord_x; - e->event.motion.y = coord_y; - break; - case button_press_event: - case button_release_event: - e->event.button.x = coord_x; - e->event.button.y = coord_y; - break; - case misc_user_event: - e->event.misc.x = coord_x; - e->event.misc.y = coord_y; - break; - default: - abort(); - } - } - - /* Finally, do some more validation. */ - switch (e->event_type) - { - case key_press_event: - if (UNBOUNDP (e->event.key.keysym)) - error ("A key must be specified to make a keypress event"); - break; - case button_press_event: - if (!e->event.button.button) - error ("A button must be specified to make a button-press event"); - break; - case button_release_event: - if (!e->event.button.button) - error ("A button must be specified to make a button-release event"); - break; - case misc_user_event: - if (NILP (e->event.misc.function)) - error ("A function must be specified to make a misc-user event"); - break; - default: - break; - } - - UNGCPRO; - return event; -} - -DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /* -Allow the given event structure to be reused. -You MUST NOT use this event object after calling this function with it. -You will lose. It is not necessary to call this function, as event -objects are garbage-collected like all other objects; however, it may -be more efficient to explicitly deallocate events when you are sure -that it is safe to do so. -*/ - (event)) -{ - CHECK_EVENT (event); - - if (XEVENT_TYPE (event) == dead_event) - error ("this event is already deallocated!"); - - assert (XEVENT_TYPE (event) <= last_event_type); - -#if 0 - { - int i, len; - - if (EQ (event, Vlast_command_event) || - EQ (event, Vlast_input_event) || - EQ (event, Vunread_command_event)) - abort (); - - len = XVECTOR_LENGTH (Vthis_command_keys); - for (i = 0; i < len; i++) - if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])) - abort (); - if (!NILP (Vrecent_keys_ring)) - { - int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring); - for (i = 0; i < recent_ring_len; i++) - if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])) - abort (); - } - } -#endif /* 0 */ - - assert (!EQ (event, Vevent_resource)); - deinitialize_event (event); -#ifndef ALLOC_NO_POOLS - XSET_EVENT_NEXT (event, Vevent_resource); - Vevent_resource = event; -#endif - return Qnil; -} - -DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* -Make a copy of the given event object. -If a second argument is given, the first event is copied into the second -and the second is returned. If the second argument is not supplied (or -is nil) then a new event will be made as with `allocate-event.' See also -the function `deallocate-event'. -*/ - (event1, event2)) -{ - CHECK_LIVE_EVENT (event1); - if (NILP (event2)) - event2 = Fmake_event (Qnil, Qnil); - else CHECK_LIVE_EVENT (event2); - if (EQ (event1, event2)) - return signal_simple_continuable_error_2 - ("copy-event called with `eq' events", event1, event2); - - assert (XEVENT_TYPE (event1) <= last_event_type); - assert (XEVENT_TYPE (event2) <= last_event_type); - - { - Lisp_Object save_next = XEVENT_NEXT (event2); - - *XEVENT (event2) = *XEVENT (event1); - XSET_EVENT_NEXT (event2, save_next); - return event2; - } -} - - - -/* Given a chain of events (or possibly nil), deallocate them all. */ - -void -deallocate_event_chain (Lisp_Object event_chain) -{ - while (!NILP (event_chain)) - { - Lisp_Object next = XEVENT_NEXT (event_chain); - Fdeallocate_event (event_chain); - event_chain = next; - } -} - -/* Return the last event in a chain. - NOTE: You cannot pass nil as a value here! The routine will - abort if you do. */ - -Lisp_Object -event_chain_tail (Lisp_Object event_chain) -{ - while (1) - { - Lisp_Object next = XEVENT_NEXT (event_chain); - if (NILP (next)) - return event_chain; - event_chain = next; - } -} - -/* Enqueue a single event onto the end of a chain of events. - HEAD points to the first event in the chain, TAIL to the last event. - If the chain is empty, both values should be nil. */ - -void -enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail) -{ - assert (NILP (XEVENT_NEXT (event))); - assert (!EQ (*tail, event)); - - if (!NILP (*tail)) - XSET_EVENT_NEXT (*tail, event); - else - *head = event; - *tail = event; - - assert (!EQ (event, XEVENT_NEXT (event))); -} - -/* Remove an event off the head of a chain of events and return it. - HEAD points to the first event in the chain, TAIL to the last event. */ - -Lisp_Object -dequeue_event (Lisp_Object *head, Lisp_Object *tail) -{ - Lisp_Object event; - - event = *head; - *head = XEVENT_NEXT (event); - XSET_EVENT_NEXT (event, Qnil); - if (NILP (*head)) - *tail = Qnil; - return event; -} - -/* Enqueue a chain of events (or possibly nil) onto the end of another - chain of events. HEAD points to the first event in the chain being - queued onto, TAIL to the last event. If the chain is empty, both values - should be nil. */ - -void -enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head, - Lisp_Object *tail) -{ - if (NILP (event_chain)) - return; - - if (NILP (*head)) - { - *head = event_chain; - *tail = event_chain; - } - else - { - XSET_EVENT_NEXT (*tail, event_chain); - *tail = event_chain_tail (event_chain); - } -} - -/* Return the number of events (possibly 0) on an event chain. */ - -int -event_chain_count (Lisp_Object event_chain) -{ - Lisp_Object event; - int n = 0; - - EVENT_CHAIN_LOOP (event, event_chain) - n++; - - return n; -} - -/* Find the event before EVENT in an event chain. This aborts - if the event is not in the chain. */ - -Lisp_Object -event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event) -{ - Lisp_Object previous = Qnil; - - while (!NILP (event_chain)) - { - if (EQ (event_chain, event)) - return previous; - previous = event_chain; - event_chain = XEVENT_NEXT (event_chain); - } - - abort (); - return Qnil; -} - -Lisp_Object -event_chain_nth (Lisp_Object event_chain, int n) -{ - Lisp_Object event; - EVENT_CHAIN_LOOP (event, event_chain) - { - if (!n) - return event; - n--; - } - return Qnil; -} - -Lisp_Object -copy_event_chain (Lisp_Object event_chain) -{ - Lisp_Object new_chain = Qnil; - Lisp_Object new_chain_tail = Qnil; - Lisp_Object event; - - EVENT_CHAIN_LOOP (event, event_chain) - { - Lisp_Object copy = Fcopy_event (event, Qnil); - enqueue_event (copy, &new_chain, &new_chain_tail); - } - - return new_chain; -} - - - -Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape, - QKspace, QKdelete; - -int -command_event_p (Lisp_Object event) -{ - switch (XEVENT_TYPE (event)) - { - case key_press_event: - case button_press_event: - case button_release_event: - case misc_user_event: - return 1; - default: - return 0; - } -} - - -void -character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, - int use_console_meta_flag, int do_backspace_mapping) -{ - Lisp_Object k = Qnil; - unsigned int m = 0; - if (event->event_type == dead_event) - error ("character-to-event called with a deallocated event!"); - -#ifndef MULE - c &= 255; -#endif - if (c > 127 && c <= 255) - { - int meta_flag = 1; - if (use_console_meta_flag && CONSOLE_TTY_P (con)) - meta_flag = TTY_FLAGS (con).meta_key; - switch (meta_flag) - { - case 0: /* ignore top bit; it's parity */ - c -= 128; - break; - case 1: /* top bit is meta */ - c -= 128; - m = MOD_META; - break; - default: /* this is a real character */ - break; - } - } - if (c < ' ') c += '@', m |= MOD_CONTROL; - if (m & MOD_CONTROL) - { - switch (c) - { - case 'I': k = QKtab; m &= ~MOD_CONTROL; break; - case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break; - case 'M': k = QKreturn; m &= ~MOD_CONTROL; break; - case '[': k = QKescape; m &= ~MOD_CONTROL; break; - default: -#if defined(HAVE_TTY) - if (do_backspace_mapping && - CHARP (con->tty_erase_char) && - c - '@' == XCHAR (con->tty_erase_char)) - { - k = QKbackspace; - m &= ~MOD_CONTROL; - } -#endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ - break; - } - if (c >= 'A' && c <= 'Z') c -= 'A'-'a'; - } -#if defined(HAVE_TTY) - else if (do_backspace_mapping && - CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) - k = QKbackspace; -#endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ - else if (c == 127) - k = QKdelete; - else if (c == ' ') - k = QKspace; - - event->event_type = key_press_event; - event->timestamp = 0; /* #### */ - event->channel = make_console (con); - event->event.key.keysym = (!NILP (k) ? k : make_char (c)); - event->event.key.modifiers = m; -} - - -/* This variable controls what character name -> character code mapping - we are using. Window-system-specific code sets this to some symbol, - and we use that symbol as the plist key to convert keysyms into 8-bit - codes. In this way one can have several character sets predefined and - switch them by changing this. - */ -Lisp_Object Vcharacter_set_property; - -Emchar -event_to_character (struct Lisp_Event *event, - int allow_extra_modifiers, - int allow_meta, - int allow_non_ascii) -{ - Emchar c = 0; - Lisp_Object code; - - if (event->event_type != key_press_event) - { - if (event->event_type == dead_event) abort (); - return -1; - } - if (!allow_extra_modifiers && - event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT)) - return -1; - if (CHAR_OR_CHAR_INTP (event->event.key.keysym)) - c = XCHAR_OR_CHAR_INT (event->event.key.keysym); - else if (!SYMBOLP (event->event.key.keysym)) - abort (); - else if (allow_non_ascii && !NILP (Vcharacter_set_property) - /* Allow window-system-specific extensibility of - keysym->code mapping */ - && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym, - Vcharacter_set_property, - Qnil))) - c = XCHAR_OR_CHAR_INT (code); - else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym, - Qascii_character, Qnil))) - c = XCHAR_OR_CHAR_INT (code); - else - return -1; - - if (event->event.key.modifiers & MOD_CONTROL) - { - if (c >= 'a' && c <= 'z') - c -= ('a' - 'A'); - else - /* reject Control-Shift- keys */ - if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers) - return -1; - - if (c >= '@' && c <= '_') - c -= '@'; - else if (c == ' ') /* C-space and C-@ are the same. */ - c = 0; - else - /* reject keys that can't take Control- modifiers */ - if (! allow_extra_modifiers) return -1; - } - - if (event->event.key.modifiers & MOD_META) - { - if (! allow_meta) return -1; - if (c & 0200) return -1; /* don't allow M-oslash (overlap) */ -#ifdef MULE - if (c >= 256) return -1; -#endif - c |= 0200; - } - return c; -} - -DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /* -Return the closest ASCII approximation to the given event object. -If the event isn't a keypress, this returns nil. -If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in - its translation; it will ignore modifier keys other than control and meta, - and will ignore the shift modifier on those characters which have no - shifted ASCII equivalent (Control-Shift-A for example, will be mapped to - the same ASCII code as Control-A). -If the ALLOW-META argument is non-nil, then the Meta modifier will be - represented by turning on the high bit of the byte returned; otherwise, nil - will be returned for events containing the Meta modifier. -If the ALLOW-NON-ASCII argument is non-nil, then characters which are - present in the prevailing character set (see the `character-set-property' - variable) will be returned as their code in that character set, instead of - the return value being restricted to ASCII. -Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as - both use the high bit; `M-x' and `oslash' will be indistinguishable. -*/ - (event, allow_extra_modifiers, allow_meta, allow_non_ascii)) -{ - Emchar c; - CHECK_LIVE_EVENT (event); - c = event_to_character (XEVENT (event), - !NILP (allow_extra_modifiers), - !NILP (allow_meta), - !NILP (allow_non_ascii)); - return c < 0 ? Qnil : make_char (c); -} - -DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /* -Convert keystroke CH into an event structure ,replete with bucky bits. -The keystroke is the first argument, and the event to fill -in is the second. This function contains knowledge about what the codes -``mean'' -- for example, the number 9 is converted to the character ``Tab'', -not the distinct character ``Control-I''. - -Note that CH (the keystroke specifier) can be an integer, a character, -a symbol such as 'clear, or a list such as '(control backspace). - -If the optional second argument is an event, it is modified; -otherwise, a new event object is created. - -Optional third arg CONSOLE is the console to store in the event, and -defaults to the selected console. - -If CH is an integer or character, the high bit may be interpreted as the -meta key. (This is done for backward compatibility in lots of places.) -If USE-CONSOLE-META-FLAG is nil, this will always be the case. If -USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects -whether the high bit is interpreted as a meta key. (See `set-input-mode'.) -If you don't want this silly meta interpretation done, you should pass -in a list containing the character. - -Beware that character-to-event and event-to-character are not strictly -inverse functions, since events contain much more information than the -ASCII character set can encode. -*/ - (ch, event, console, use_console_meta_flag)) -{ - struct console *con = decode_console (console); - if (NILP (event)) - event = Fmake_event (Qnil, Qnil); - else - CHECK_LIVE_EVENT (event); - if (CONSP (ch) || SYMBOLP (ch)) - key_desc_list_to_event (ch, event, 1); - else - { - CHECK_CHAR_COERCE_INT (ch); - character_to_event (XCHAR (ch), XEVENT (event), con, - !NILP (use_console_meta_flag), 1); - } - return event; -} - -void -nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event) -{ - assert (STRINGP (seq) || VECTORP (seq)); - assert (n < XINT (Flength (seq))); - - if (STRINGP (seq)) - { - Emchar ch = string_char (XSTRING (seq), n); - Fcharacter_to_event (make_char (ch), event, Qnil, Qnil); - } - else - { - Lisp_Object keystroke = XVECTOR_DATA (seq)[n]; - if (EVENTP (keystroke)) - Fcopy_event (keystroke, event); - else - Fcharacter_to_event (keystroke, event, Qnil, Qnil); - } -} - -Lisp_Object -key_sequence_to_event_chain (Lisp_Object seq) -{ - int len = XINT (Flength (seq)); - int i; - Lisp_Object head = Qnil, tail = Qnil; - - for (i = 0; i < len; i++) - { - Lisp_Object event = Fmake_event (Qnil, Qnil); - nth_of_key_sequence_as_event (seq, i, event); - enqueue_event (event, &head, &tail); - } - - return head; -} - -void -format_event_object (char *buf, struct Lisp_Event *event, int brief) -{ - int mouse_p = 0; - int mod = 0; - Lisp_Object key; - - switch (event->event_type) - { - case key_press_event: - { - mod = event->event.key.modifiers; - key = event->event.key.keysym; - /* Hack. */ - if (! brief && CHARP (key) && - mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) - { - int k = XCHAR (key); - if (k >= 'a' && k <= 'z') - key = make_char (k - ('a' - 'A')); - else if (k >= 'A' && k <= 'Z') - mod |= MOD_SHIFT; - } - break; - } - case button_release_event: - mouse_p++; - /* Fall through */ - case button_press_event: - { - mouse_p++; - mod = event->event.button.modifiers; - key = make_char (event->event.button.button + '0'); - break; - } - case magic_event: - { - CONST char *name = NULL; - -#ifdef HAVE_X_WINDOWS - { - Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); - if (CONSOLE_X_P (XCONSOLE (console))) - name = x_event_name (event->event.magic.underlying_x_event.type); - } -#endif /* HAVE_X_WINDOWS */ - if (name) strcpy (buf, name); - else strcpy (buf, "???"); - return; - } - case magic_eval_event: strcpy (buf, "magic-eval"); return; - case pointer_motion_event: strcpy (buf, "motion"); return; - case misc_user_event: strcpy (buf, "misc-user"); return; - case eval_event: strcpy (buf, "eval"); return; - case process_event: strcpy (buf, "process"); return; - case timeout_event: strcpy (buf, "timeout"); return; - case empty_event: strcpy (buf, "empty"); return; - case dead_event: strcpy (buf, "DEAD-EVENT"); return; - default: - abort (); - } -#define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0) -#define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0) - if (mod & MOD_CONTROL) modprint ("control-", "C-"); - if (mod & MOD_META) modprint ("meta-", "M-"); - if (mod & MOD_SUPER) modprint ("super-", "S-"); - if (mod & MOD_HYPER) modprint ("hyper-", "H-"); - if (mod & MOD_ALT) modprint ("alt-", "A-"); - if (mod & MOD_SHIFT) modprint ("shift-", "Sh-"); - if (mouse_p) - { - modprint1 ("button"); - --mouse_p; - } - -#undef modprint -#undef modprint1 - - if (CHARP (key)) - { - buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key)); - *buf = 0; - } - else if (SYMBOLP (key)) - { - CONST char *str = 0; - if (brief) - { - if (EQ (key, QKlinefeed)) str = "LFD"; - else if (EQ (key, QKtab)) str = "TAB"; - else if (EQ (key, QKreturn)) str = "RET"; - else if (EQ (key, QKescape)) str = "ESC"; - else if (EQ (key, QKdelete)) str = "DEL"; - else if (EQ (key, QKspace)) str = "SPC"; - else if (EQ (key, QKbackspace)) str = "BS"; - } - if (str) - { - int i = strlen (str); - memcpy (buf, str, i+1); - str += i; - } - else - { - struct Lisp_String *name = XSYMBOL (key)->name; - memcpy (buf, string_data (name), string_length (name) + 1); - str += string_length (name); - } - } - else - abort (); - if (mouse_p) - strncpy (buf, "up", 4); -} - -DEFUN ("eventp", Feventp, 1, 1, 0, /* -True if OBJECT is an event object. -*/ - (object)) -{ - return EVENTP (object) ? Qt : Qnil; -} - -DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /* -True if OBJECT is an event object that has not been deallocated. -*/ - (object)) -{ - return EVENTP (object) && XEVENT (object)->event_type != dead_event ? - Qt : Qnil; -} - -#if 0 /* debugging functions */ - -xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /* -Return the event object's `next' event, or nil if it has none. -The `next-event' field is changed by calling `set-next-event'. -*/ - (event)) -{ - struct Lisp_Event *e; - CHECK_LIVE_EVENT (event); - - return XEVENT_NEXT (event); -} - -xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /* -Set the `next event' of EVENT to NEXT-EVENT. -NEXT-EVENT must be an event object or nil. -*/ - (event, next_event)) -{ - Lisp_Object ev; - - CHECK_LIVE_EVENT (event); - if (NILP (next_event)) - { - XSET_EVENT_NEXT (event, Qnil); - return Qnil; - } - - CHECK_LIVE_EVENT (next_event); - - EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event)) - { - QUIT; - if (EQ (ev, event)) - signal_error (Qerror, - list3 (build_string ("Cyclic event-next"), - event, - next_event)); - } - XSET_EVENT_NEXT (event, next_event); - return next_event; -} - -#endif /* 0 */ - -DEFUN ("event-type", Fevent_type, 1, 1, 0, /* -Return the type of EVENT. -This will be a symbol; one of - -key-press A key was pressed. -button-press A mouse button was pressed. -button-release A mouse button was released. -misc-user Some other user action happened; typically, this is - a menu selection or scrollbar action. -motion The mouse moved. -process Input is available from a subprocess. -timeout A timeout has expired. -eval This causes a specified action to occur when dispatched. -magic Some window-system-specific event has occurred. -empty The event has been allocated but not assigned. - -*/ - (event)) -{ - CHECK_LIVE_EVENT (event); - switch (XEVENT (event)->event_type) - { - case key_press_event: return Qkey_press; - case button_press_event: return Qbutton_press; - case button_release_event: return Qbutton_release; - case misc_user_event: return Qmisc_user; - case pointer_motion_event: return Qmotion; - case process_event: return Qprocess; - case timeout_event: return Qtimeout; - case eval_event: return Qeval; - case magic_event: - case magic_eval_event: - return Qmagic; - - case empty_event: - return Qempty; - - default: - abort (); - return Qnil; - } -} - -DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* -Return the timestamp of the event object EVENT. -*/ - (event)) -{ - CHECK_LIVE_EVENT (event); - /* This junk is so that timestamps don't get to be negative, but contain - as many bits as this particular emacs will allow. - */ - return make_int (((1L << (VALBITS - 1)) - 1) & - XEVENT (event)->timestamp); -} - -#define CHECK_EVENT_TYPE(e,t1,sym) do { \ - CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1)) \ - e = wrong_type_argument (sym,e); \ -} while (0) - -#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ - CHECK_LIVE_EVENT (e); \ - { \ - emacs_event_type CET_type = XEVENT (e)->event_type; \ - if (CET_type != (t1) && \ - CET_type != (t2)) \ - e = wrong_type_argument (sym,e); \ - } \ -} while (0) - -#define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ - CHECK_LIVE_EVENT (e); \ - { \ - emacs_event_type CET_type = XEVENT (e)->event_type; \ - if (CET_type != (t1) && \ - CET_type != (t2) && \ - CET_type != (t3)) \ - e = wrong_type_argument (sym,e); \ - } \ -} while (0) - -DEFUN ("event-key", Fevent_key, 1, 1, 0, /* -Return the Keysym of the key-press event EVENT. -This will be a character if the event is associated with one, else a symbol. -*/ - (event)) -{ - CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p); - return XEVENT (event)->event.key.keysym; -} - -DEFUN ("event-button", Fevent_button, 1, 1, 0, /* -Return the button-number of the given button-press or button-release event. -*/ - (event)) -{ - - CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event, - misc_user_event, Qbutton_event_p); -#ifdef HAVE_WINDOW_SYSTEM - if ( XEVENT (event)->event_type == misc_user_event) - return make_int (XEVENT (event)->event.misc.button); - else - return make_int (XEVENT (event)->event.button.button); -#else /* !HAVE_WINDOW_SYSTEM */ - return Qzero; -#endif /* !HAVE_WINDOW_SYSTEM */ - -} - -DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* -Return a number representing the modifier keys which were down -when the given mouse or keyboard event was produced. -See also the function event-modifiers. -*/ - (event)) -{ - again: - CHECK_LIVE_EVENT (event); - switch (XEVENT (event)->event_type) - { - case key_press_event: - return make_int (XEVENT (event)->event.key.modifiers); - case button_press_event: - case button_release_event: - return make_int (XEVENT (event)->event.button.modifiers); - case pointer_motion_event: - return make_int (XEVENT (event)->event.motion.modifiers); - case misc_user_event: - return make_int (XEVENT (event)->event.misc.modifiers); - default: - event = wrong_type_argument (intern ("key-or-mouse-event-p"), event); - goto again; - } -} - -DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* -Return a list of symbols, the names of the modifier keys -which were down when the given mouse or keyboard event was produced. -See also the function event-modifier-bits. -*/ - (event)) -{ - int mod = XINT (Fevent_modifier_bits (event)); - Lisp_Object result = Qnil; - if (mod & MOD_SHIFT) result = Fcons (Qshift, result); - if (mod & MOD_ALT) result = Fcons (Qalt, result); - if (mod & MOD_HYPER) result = Fcons (Qhyper, result); - if (mod & MOD_SUPER) result = Fcons (Qsuper, result); - if (mod & MOD_META) result = Fcons (Qmeta, result); - if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result); - return result; -} - -static int -event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative) -{ - struct window *w; - struct frame *f; - - if (XEVENT (event)->event_type == pointer_motion_event) - { - *x = XEVENT (event)->event.motion.x; - *y = XEVENT (event)->event.motion.y; - } - else if (XEVENT (event)->event_type == button_press_event || - XEVENT (event)->event_type == button_release_event) - { - *x = XEVENT (event)->event.button.x; - *y = XEVENT (event)->event.button.y; - } - else if (XEVENT (event)->event_type == misc_user_event) - { - *x = XEVENT (event)->event.misc.x; - *y = XEVENT (event)->event.misc.y; - } - else - return 0; - - f = XFRAME (EVENT_CHANNEL (XEVENT (event))); - - if (relative) - { - w = find_window_by_pixel_pos (*x, *y, f->root_window); - - if (!w) - return 1; /* #### What should really happen here. */ - - *x -= w->pixel_left; - *y -= w->pixel_top; - } - else - { - *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f); - *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f); - } - - return 1; -} - -DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /* -Return the X position in pixels of mouse event EVENT. -The value returned is relative to the window the event occurred in. -This will signal an error if the event is not a mouse event. -See also `mouse-event-p' and `event-x-pixel'. -*/ - (event)) -{ - int x, y; - - CHECK_LIVE_EVENT (event); - - if (!event_x_y_pixel_internal (event, &x, &y, 1)) - return wrong_type_argument (Qmouse_event_p, event); - else - return make_int (x); -} - -DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /* -Return the Y position in pixels of mouse event EVENT. -The value returned is relative to the window the event occurred in. -This will signal an error if the event is not a mouse event. -See also `mouse-event-p' and `event-y-pixel'. -*/ - (event)) -{ - int x, y; - - CHECK_LIVE_EVENT (event); - - if (!event_x_y_pixel_internal (event, &x, &y, 1)) - return wrong_type_argument (Qmouse_event_p, event); - else - return make_int (y); -} - -DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /* -Return the X position in pixels of mouse event EVENT. -The value returned is relative to the frame the event occurred in. -This will signal an error if the event is not a mouse event. -See also `mouse-event-p' and `event-window-x-pixel'. -*/ - (event)) -{ - int x, y; - - CHECK_LIVE_EVENT (event); - - if (!event_x_y_pixel_internal (event, &x, &y, 0)) - return wrong_type_argument (Qmouse_event_p, event); - else - return make_int (x); -} - -DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /* -Return the Y position in pixels of mouse event EVENT. -The value returned is relative to the frame the event occurred in. -This will signal an error if the event is not a mouse event. -See also `mouse-event-p' `event-window-y-pixel'. -*/ - (event)) -{ - int x, y; - - CHECK_LIVE_EVENT (event); - - if (!event_x_y_pixel_internal (event, &x, &y, 0)) - return wrong_type_argument (Qmouse_event_p, event); - else - return make_int (y); -} - -/* Given an event, return a value: - - OVER_TOOLBAR: over one of the 4 frame toolbars - OVER_MODELINE: over a modeline - OVER_BORDER: over an internal border - OVER_NOTHING: over the text area, but not over text - OVER_OUTSIDE: outside of the frame border - OVER_TEXT: over text in the text area - OVER_V_DIVIDER: over windows vertical divider - - and return: - - The X char position in CHAR_X, if not a null pointer. - The Y char position in CHAR_Y, if not a null pointer. - (These last two values are relative to the window the event is over.) - The window it's over in W, if not a null pointer. - The buffer position it's over in BUFP, if not a null pointer. - The closest buffer position in CLOSEST, if not a null pointer. - - OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation(). -*/ - -static int -event_pixel_translation (Lisp_Object event, int *char_x, int *char_y, - int *obj_x, int *obj_y, - struct window **w, Bufpos *bufp, Bufpos *closest, - Charcount *modeline_closest, - Lisp_Object *obj1, Lisp_Object *obj2) -{ - int pix_x = 0; - int pix_y = 0; - int result; - Lisp_Object frame; - - int ret_x, ret_y, ret_obj_x, ret_obj_y; - struct window *ret_w; - Bufpos ret_bufp, ret_closest; - Charcount ret_modeline_closest; - Lisp_Object ret_obj1, ret_obj2; - - CHECK_LIVE_EVENT (event); - frame = XEVENT (event)->channel; - switch (XEVENT (event)->event_type) - { - case pointer_motion_event : - pix_x = XEVENT (event)->event.motion.x; - pix_y = XEVENT (event)->event.motion.y; - break; - case button_press_event : - case button_release_event : - pix_x = XEVENT (event)->event.button.x; - pix_y = XEVENT (event)->event.button.y; - break; - case misc_user_event : - pix_x = XEVENT (event)->event.misc.x; - pix_y = XEVENT (event)->event.misc.y; - break; - default: - dead_wrong_type_argument (Qmouse_event_p, event); - } - - result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y, - &ret_x, &ret_y, &ret_obj_x, &ret_obj_y, - &ret_w, &ret_bufp, &ret_closest, - &ret_modeline_closest, - &ret_obj1, &ret_obj2); - - if (result == OVER_NOTHING || result == OVER_OUTSIDE) - ret_bufp = 0; - else if (ret_w && NILP (ret_w->buffer)) - /* Why does this happen? (Does it still happen?) - I guess the window has gotten reused as a non-leaf... */ - ret_w = 0; - - /* #### pixel_to_glyph_translation() sometimes returns garbage... - The word has type Lisp_Type_Record (presumably meaning `extent') but the - pointer points to random memory, often filled with 0, sometimes not. - */ - /* #### Chuck, do we still need this crap? */ - if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1) -#ifdef HAVE_TOOLBARS - || TOOLBAR_BUTTONP (ret_obj1) -#endif - )) - abort (); - if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2))) - abort (); - - if (char_x) - *char_x = ret_x; - if (char_y) - *char_y = ret_y; - if (obj_x) - *obj_x = ret_obj_x; - if (obj_y) - *obj_y = ret_obj_y; - if (w) - *w = ret_w; - if (bufp) - *bufp = ret_bufp; - if (closest) - *closest = ret_closest; - if (modeline_closest) - *modeline_closest = ret_modeline_closest; - if (obj1) - *obj1 = ret_obj1; - if (obj2) - *obj2 = ret_obj2; - - return result; -} - -DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /* -Return t if the mouse event EVENT occurred over the text area of a window. -The modeline is not considered to be part of the text area. -*/ - (event)) -{ - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil; -} - -DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /* -Return t if the mouse event EVENT occurred over the modeline of a window. -*/ - (event)) -{ - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return result == OVER_MODELINE ? Qt : Qnil; -} - -DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /* -Return t if the mouse event EVENT occurred over an internal border. -*/ - (event)) -{ - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return result == OVER_BORDER ? Qt : Qnil; -} - -DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /* -Return t if the mouse event EVENT occurred over a toolbar. -*/ - (event)) -{ - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return result == OVER_TOOLBAR ? Qt : Qnil; -} - -DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /* -Return t if the mouse event EVENT occurred over a window divider. -*/ - (event)) -{ - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return result == OVER_V_DIVIDER ? Qt : Qnil; -} - -struct console * -event_console_or_selected (Lisp_Object event) -{ - Lisp_Object channel = EVENT_CHANNEL (XEVENT (event)); - Lisp_Object console = CDFW_CONSOLE (channel); - - if (NILP (console)) - console = Vselected_console; - - return XCONSOLE (console); -} - -DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /* -Return the channel that the event EVENT occurred on. -This will be a frame, device, console, or nil for some types -of events (e.g. eval events). -*/ - (event)) -{ - CHECK_LIVE_EVENT (event); - return EVENT_CHANNEL (XEVENT (event)); -} - -DEFUN ("event-window", Fevent_window, 1, 1, 0, /* -Return the window over which mouse event EVENT occurred. -This may be nil if the event occurred in the border or over a toolbar. -The modeline is considered to be within the window it describes. -*/ - (event)) -{ - struct window *w; - - event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0); - - if (!w) - return Qnil; - else - { - Lisp_Object window; - - XSETWINDOW (window, w); - return window; - } -} - -DEFUN ("event-point", Fevent_point, 1, 1, 0, /* -Return the character position of the mouse event EVENT. -If the event did not occur over a window, or did not occur over text, -then this returns nil. Otherwise, it returns a position in the buffer -visible in the event's window. -*/ - (event)) -{ - Bufpos bufp; - struct window *w; - - event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0); - - return w && bufp ? make_int (bufp) : Qnil; -} - -DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /* -Return the character position closest to the mouse event EVENT. -If the event did not occur over a window or over text, return the -closest point to the location of the event. If the Y pixel position -overlaps a window and the X pixel position is to the left of that -window, the closest point is the beginning of the line containing the -Y position. If the Y pixel position overlaps a window and the X pixel -position is to the right of that window, the closest point is the end -of the line containing the Y position. If the Y pixel position is -above a window, return 0. If it is below the last character in a window, -return the value of (window-end). -*/ - (event)) -{ - Bufpos bufp; - - event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0); - - return bufp ? make_int (bufp) : Qnil; -} - -DEFUN ("event-x", Fevent_x, 1, 1, 0, /* -Return the X position of the mouse event EVENT in characters. -This is relative to the window the event occurred over. -*/ - (event)) -{ - int char_x; - - event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0); - - return make_int (char_x); -} - -DEFUN ("event-y", Fevent_y, 1, 1, 0, /* -Return the Y position of the mouse event EVENT in characters. -This is relative to the window the event occurred over. -*/ - (event)) -{ - int char_y; - - event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0); - - return make_int (char_y); -} - -DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /* -Return the character position in the modeline that EVENT occurred over. -EVENT should be a mouse event. If EVENT did not occur over a modeline, -nil is returned. You can determine the actual character that the -event occurred over by looking in `generated-modeline-string' at the -returned character position. Note that `generated-modeline-string' -is buffer-local, and you must use EVENT's buffer when retrieving -`generated-modeline-string' in order to get accurate results. -*/ - (event)) -{ - Charcount mbufp; - int where; - - where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0); - - return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp); -} - -DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /* -Return the glyph that the mouse event EVENT occurred over, or nil. -*/ - (event)) -{ - Lisp_Object glyph; - struct window *w; - - event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0); - - return w && GLYPHP (glyph) ? glyph : Qnil; -} - -DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /* -Return the extent of the glyph that the mouse event EVENT occurred over. -If the event did not occur over a glyph, nil is returned. -*/ - (event)) -{ - Lisp_Object extent; - struct window *w; - - event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent); - - return w && EXTENTP (extent) ? extent : Qnil; -} - -DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /* -Return the X pixel position of EVENT relative to the glyph it occurred over. -EVENT should be a mouse event. If the event did not occur over a glyph, -nil is returned. -*/ - (event)) -{ - Lisp_Object extent; - struct window *w; - int obj_x; - - event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent); - - return w && EXTENTP (extent) ? make_int (obj_x) : Qnil; -} - -DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /* -Return the Y pixel position of EVENT relative to the glyph it occurred over. -EVENT should be a mouse event. If the event did not occur over a glyph, -nil is returned. -*/ - (event)) -{ - Lisp_Object extent; - struct window *w; - int obj_y; - - event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent); - - return w && EXTENTP (extent) ? make_int (obj_y) : Qnil; -} - -DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /* -Return the toolbar button that the mouse event EVENT occurred over. -If the event did not occur over a toolbar button, nil is returned. -*/ - (event)) -{ -#ifdef HAVE_TOOLBARS - Lisp_Object button; - - int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0); - - return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil; -#else - return Qnil; -#endif -} - -DEFUN ("event-process", Fevent_process, 1, 1, 0, /* -Return the process of the given process-output event. -*/ - (event)) -{ - CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p); - return XEVENT (event)->event.process.process; -} - -DEFUN ("event-function", Fevent_function, 1, 1, 0, /* -Return the callback function of EVENT. -EVENT should be a timeout, misc-user, or eval event. -*/ - (event)) -{ - again: - CHECK_LIVE_EVENT (event); - switch (XEVENT (event)->event_type) - { - case timeout_event: - return XEVENT (event)->event.timeout.function; - case misc_user_event: - return XEVENT (event)->event.misc.function; - case eval_event: - return XEVENT (event)->event.eval.function; - default: - event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); - goto again; - } -} - -DEFUN ("event-object", Fevent_object, 1, 1, 0, /* -Return the callback function argument of EVENT. -EVENT should be a timeout, misc-user, or eval event. -*/ - (event)) -{ - again: - CHECK_LIVE_EVENT (event); - switch (XEVENT (event)->event_type) - { - case timeout_event: - return XEVENT (event)->event.timeout.object; - case misc_user_event: - return XEVENT (event)->event.misc.object; - case eval_event: - return XEVENT (event)->event.eval.object; - default: - event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); - goto again; - } -} - -DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /* -Return a list of all of the properties of EVENT. -This is in the form of a property list (alternating keyword/value pairs). -*/ - (event)) -{ - Lisp_Object props = Qnil; - struct Lisp_Event *e; - struct gcpro gcpro1; - - CHECK_LIVE_EVENT (event); - e = XEVENT (event); - GCPRO1 (props); - - props = cons3 (Qtimestamp, Fevent_timestamp (event), props); - - switch (e->event_type) - { - default: abort (); - - case process_event: - props = cons3 (Qprocess, e->event.process.process, props); - break; - - case timeout_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - props = cons3 (Qid, make_int (e->event.timeout.id_number), props); - break; - - case key_press_event: - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qkey, Fevent_key (event), props); - break; - - case button_press_event: - case button_release_event: - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qbutton, Fevent_button (event), props); - break; - - case pointer_motion_event: - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - break; - - case misc_user_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - props = cons3 (Qy, Fevent_y_pixel (event), props); - props = cons3 (Qx, Fevent_x_pixel (event), props); - props = cons3 (Qmodifiers, Fevent_modifiers (event), props); - props = cons3 (Qbutton, Fevent_button (event), props); - break; - - case eval_event: - props = cons3 (Qobject, Fevent_object (event), props); - props = cons3 (Qfunction, Fevent_function (event), props); - break; - - case magic_eval_event: - case magic_event: - break; - - case empty_event: - RETURN_UNGCPRO (Qnil); - break; - } - - props = cons3 (Qchannel, Fevent_channel (event), props); - UNGCPRO; - - return props; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_events (void) -{ - DEFSUBR (Fcharacter_to_event); - DEFSUBR (Fevent_to_character); - - DEFSUBR (Fmake_event); - DEFSUBR (Fdeallocate_event); - DEFSUBR (Fcopy_event); - DEFSUBR (Feventp); - DEFSUBR (Fevent_live_p); - DEFSUBR (Fevent_type); - DEFSUBR (Fevent_properties); - - DEFSUBR (Fevent_timestamp); - DEFSUBR (Fevent_key); - DEFSUBR (Fevent_button); - DEFSUBR (Fevent_modifier_bits); - DEFSUBR (Fevent_modifiers); - DEFSUBR (Fevent_x_pixel); - DEFSUBR (Fevent_y_pixel); - DEFSUBR (Fevent_window_x_pixel); - DEFSUBR (Fevent_window_y_pixel); - DEFSUBR (Fevent_over_text_area_p); - DEFSUBR (Fevent_over_modeline_p); - DEFSUBR (Fevent_over_border_p); - DEFSUBR (Fevent_over_toolbar_p); - DEFSUBR (Fevent_over_vertical_divider_p); - DEFSUBR (Fevent_channel); - DEFSUBR (Fevent_window); - DEFSUBR (Fevent_point); - DEFSUBR (Fevent_closest_point); - DEFSUBR (Fevent_x); - DEFSUBR (Fevent_y); - DEFSUBR (Fevent_modeline_position); - DEFSUBR (Fevent_glyph); - DEFSUBR (Fevent_glyph_extent); - DEFSUBR (Fevent_glyph_x_pixel); - DEFSUBR (Fevent_glyph_y_pixel); - DEFSUBR (Fevent_toolbar_button); - DEFSUBR (Fevent_process); - DEFSUBR (Fevent_function); - DEFSUBR (Fevent_object); - - defsymbol (&Qeventp, "eventp"); - defsymbol (&Qevent_live_p, "event-live-p"); - defsymbol (&Qkey_press_event_p, "key-press-event-p"); - defsymbol (&Qbutton_event_p, "button-event-p"); - defsymbol (&Qmouse_event_p, "mouse-event-p"); - defsymbol (&Qprocess_event_p, "process-event-p"); - defsymbol (&Qkey_press, "key-press"); - defsymbol (&Qbutton_press, "button-press"); - defsymbol (&Qbutton_release, "button-release"); - defsymbol (&Qmisc_user, "misc-user"); - defsymbol (&Qascii_character, "ascii-character"); -} - -void -vars_of_events (void) -{ - DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /* -A symbol used to look up the 8-bit character of a keysym. -To convert a keysym symbol to an 8-bit code, as when that key is -bound to self-insert-command, we will look up the property that this -variable names on the property list of the keysym-symbol. The window- -system-specific code will set up appropriate properties and set this -variable. -*/ ); - Vcharacter_set_property = Qnil; - - Vevent_resource = Qnil; - - QKbackspace = KEYSYM ("backspace"); - QKtab = KEYSYM ("tab"); - QKlinefeed = KEYSYM ("linefeed"); - QKreturn = KEYSYM ("return"); - QKescape = KEYSYM ("escape"); - QKspace = KEYSYM ("space"); - QKdelete = KEYSYM ("delete"); - - staticpro (&QKbackspace); - staticpro (&QKtab); - staticpro (&QKlinefeed); - staticpro (&QKreturn); - staticpro (&QKescape); - staticpro (&QKspace); - staticpro (&QKdelete); -} diff --git a/src/events.h b/src/events.h deleted file mode 100644 index 04e7cd4..0000000 --- a/src/events.h +++ /dev/null @@ -1,641 +0,0 @@ -/* Definitions for the new event model; - created 16-jul-91 by Jamie Zawinski - Copyright (C) 1991, 1992, 1993 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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. */ - -#ifndef _XEMACS_EVENTS_H_ -#define _XEMACS_EVENTS_H_ - -#include "systime.h" - -/* There is one object called an event_stream. This object contains - callback functions for doing the window-system-dependent operations - that XEmacs requires. - - If XEmacs is compiled with support for X11 and the X Toolkit, then this - event_stream structure will contain functions that can cope with input - on XEmacs windows on multiple displays, as well as input from dumb tty - frames. - - If it is desired to have XEmacs able to open frames on the displays of - multiple heterogeneous machines, X11 and SunView, or X11 and NeXT, for - example, then it will be necessary to construct an event_stream structure - that can cope with the given types. Currently, the only implemented - event_streams are for dumb-ttys, and for X11 plus dumb-ttys. - - To implement this for one window system is relatively simple. - To implement this for multiple window systems is trickier and may - not be possible in all situations, but it's been done for X and TTY. - - Note that these callbacks are *NOT* console methods; that's because - the routines are not specific to a particular console type but must - be able to simultaneously cope with all allowable console types. - - The slots of the event_stream structure: - - next_event_cb A function which fills in an XEmacs_event structure - with the next event available. If there is no event - available, then this should block. - - IMPORTANT: timer events and especially process - events *must not* be returned if there are - events of other types available; otherwise you - can end up with an infinite loop in Fdiscard_input(). - - event_pending_cb A function which says whether there are events to be - read. If called with an argument of 0, then this - should say whether calling the next_event_cb will - block. If called with an argument of 1, then this - should say whether there are user-generated events - pending (that is, keypresses or mouse-clicks). This - is used for redisplay optimization, among other - things. On dumb ttys, these two results are the - same, but under a window system, they are not. - - If this function is not sure whether there are events - to be read, it *must* return 0. Otherwise various - undesirable effects will occur, such as redisplay - not occurring until the next event occurs. - - handle_magic_event_cb XEmacs calls this with an event structure which - contains window-system dependent information that - XEmacs doesn't need to know about, but which must - happen in order. If the next_event_cb never returns - an event of type "magic", this will never be used. - - add_timeout_cb Called with an EMACS_TIME, the absolute time at - which a wakeup event should be generated; and a - void *, which is an arbitrary value that will be - returned in the timeout event. The timeouts - generated by this function should be one-shots: - they fire once and then disappear. This callback - should return an int id-number which uniquely - identifies this wakeup. If an implementation - doesn't have microseconds or millisecond - granularity, it should round up to the closest - value it can deal with. - - remove_timeout_cb Called with an int, the id number of a wakeup to - discard. This id number must have been returned by - the add_timeout_cb. If the given wakeup has - already expired, this should do nothing. - - select_process_cb These callbacks tell the underlying implementation to - unselect_process_cb add or remove a file descriptor from the list of fds - which are polled for inferior-process input. When - input becomes available on the given process - connection, an event of type "process" should be - generated. - - select_console_cb These callbacks tell the underlying implementation - unselect_console_cb to add or remove a console from the list of consoles - which are polled for user-input. - - select_device_cb These callbacks are used by Unixoid event loops - unselect_device_cb (those that use select() and file descriptors and - have a separate input fd per device). - - create_stream_pair_cb These callbacks are called by process code to - delete_stream_pair_cb create and delete a pair of input and output lstreams - which are used for subprocess I/O. - - quitp_cb A handler function called from the `QUIT' macro which - should check whether the quit character has been - typed. On systems with SIGIO, this will not be called - unless the `sigio_happened' flag is true (it is set - from the SIGIO handler). - - XEmacs has its own event structures, which are distinct from the event - structures used by X or any other window system. It is the job of the - event_stream layer to translate to this format. - - NOTE: #### All timestamps should be measured as milliseconds since XEmacs - started. Currently many or most events have a 0 as their - timestamp value, and for other timestamps, they are raw server - timestamps. (The X protocol doesn't provide any easy way of - translating between server time and real process time; yuck.) - - Every event type has the following structures: - - channel Where this event occurred on. This will be - a frame, device, console, or nil, depending on the - event type. It is important that an object of - a more specific type than is actually generated - is not substituted -- e.g. there should not be - a frame inserted when a key-press event occurs, - because events on dead channels are automatically - ignored. - - Specifically: - - -- for button and mouse-motion events, channel - will be a frame. (The translation to a window - occurs later.) - -- for keyboard events, channel will be a console. - Note that fake keyboard events (generated - by `character-to-event' or something that - calls this, such as macros) need to have - the selected console stored into them when - the event is created. This is so that the - correct console-local variables (e.g. the - command builder) will get affected. - -- for timer, process, magic-eval, and eval events, - channel will be nil. - -- for misc-user events, channel will be a frame. - -- for magic events, channel will be a frame - (usually) or a device. - - timestamp When this event occurred -- if not known, this - is made up. - - In addition, the following structures are specific to particular event - types: - - key_press_event - key What keysym this is; an integer or a symbol. - If this is an integer, it will be in the printing - ASCII range: >32 and <127. - modifiers Bucky-bits on that key: control, meta, etc. - For many keys, Shift is not a bit; that is implicit - in the keyboard layout. - - button_press_event - button_release_event - button What button went down or up. - modifiers Bucky-bits on that button: shift, control, meta, etc. - x, y Where it was at the button-state-change (in pixels). - - pointer_motion_event - x, y Where it was after it moved (in pixels). - modifiers Bucky-bits down when the motion was detected. - (Possibly not all window systems will provide this?) - - process_event - process the XEmacs "process" object in question - - timeout_event - interval_id The ID returned when the associated call to - add_timeout_cb() was made - ------ the rest of the fields are filled in by XEmacs ----- - id_number The XEmacs timeout ID for this timeout (more - than one timeout event can have the same value - here, since XEmacs timeouts, as opposed to - add_timeout_cb() timeouts, can resignal - themselves) - function An elisp function to call when this timeout is - processed. - object The object passed to that function. - - eval_event - function An elisp function to call with this event object. - internal_function An unexported function to call with this event - object. This allows eval events to call internal - functions. For a normal eval event, this field - will always be 0. - object Anything. - This kind of event is used internally; sometimes the - window system interface would like to inform XEmacs of - some user action (such as focusing on another frame) - but needs that to happen synchronously with the other - user input, like keypresses. This is useful when - events are reported through callbacks rather - than in the standard event stream. - - misc_user_event - function An elisp function to call with this event object. - internal_function Ignored. - object Anything. - button What button went down or up. - modifiers Bucky-bits on that button: shift, control, meta, etc. - x, y Where it was at the button-state-change (in pixels). - This is similar to an eval_event, except that it is - generated by user actions: selections in the - menubar, scrollbar actions, or drag and drop actions. - It is a "command" event, like key and mouse presses - (and unlike mouse motion, process output, and enter - and leave window hooks). In many ways, eval_events - are not the same as keypresses or misc_user_events. - The button, modifiers, x, and y parts are only used - by the XEmacs Drag'n'Drop system. Don't depend on their - values for other types of misc_user_events. - - magic_event - No user-serviceable parts within. This is for things - like KeymapNotify and ExposeRegion events and so on - that XEmacs itself doesn't care about, but which it - must do something with for proper interaction with - the window system. - - Magic_events are handled somewhat asynchronously, just - like subprocess filters. However, occasionally a - magic_event needs to be handled synchronously; in that - case, the asynchronous handling of the magic_event will - push an eval_event back onto the queue, which will be - handled synchronously later. This is one of the - reasons why eval_events exist; I'm not entirely happy - with this aspect of this event model. - - magic_eval_event - This is like an eval event but its contents are - not Lisp-accessible. This allows for "internal - eval events" that call non-Lisp-accessible functions. - Externally, a magic_eval_event just appears as - a magic_event; the Lisp programmer need not know - anything more. - -*/ - -/* - Stream pairs description - ------------------------ - - Since there are many possible processes/event loop combinations, the event code - is responsible for creating an appropriate lstream type. The process - implementation does not care about that implementation. - - The Create stream pair function is passed two void* values, which identify - process-dependent 'handles'. The process implementation uses these handles - to communicate with child processes. The function must be prepared to receive - handle types of any process implementation. Since there only one process - implementation exists in a particular XEmacs configuration, preprocessing - is a mean of compiling in the support for the code which deals with particular - handle types. - - For example, a unixoid type loop, which relies on file descriptors, may be - asked to create a pair of streams by a unix-style process implementation. - In this case, the handles passed are unix file descriptors, and the code - may deal with these directly. Although, the same code may be used on Win32 - system with X-Windows. In this case, Win32 process implementation passes - handles of type HANDLE, and the create_stream_pair function must call - appropriate function to get file descriptors given HANDLEs, so that these - descriptors may be passed to XtAddInput. - - The handle given may have special denying value, in which case the - corresponding lstream should not be created. - - The return value of the function is a unique stream identifier. It is used - by processes implementation, in its platform-independent part. There is - the get_process_from_usid function, which returns process object given its - USID. The event stream is responsible for converting its internal handle - type into USID. - - Example is the TTY event stream. When a file descriptor signals input, the - event loop must determine process to which the input is destined. Thus, - the implementation uses process input stream file descriptor as USID, by - simply casting the fd value to USID type. - - There are two special USID values. One, USID_ERROR, indicates that the stream - pair cannot be created. The second, USID_DONTHASH, indicates that streams are - created, but the event stream does not wish to be able to find the process - by its USID. Specifically, if an event stream implementation never calls - get_process_from_usid, this value should always be returned, to prevent - accumulating useless information on USID to process relationship. -*/ - -/* typedef unsigned int USID; in lisp.h */ -#define USID_ERROR ((USID)-1) -#define USID_DONTHASH ((USID)0) - - -struct Lisp_Event; -struct Lisp_Process; - -struct event_stream -{ - int (*event_pending_p) (int); - void (*next_event_cb) (struct Lisp_Event *); - void (*handle_magic_event_cb) (struct Lisp_Event *); - int (*add_timeout_cb) (EMACS_TIME); - void (*remove_timeout_cb) (int); - void (*select_console_cb) (struct console *); - void (*unselect_console_cb) (struct console *); - void (*select_process_cb) (struct Lisp_Process *); - void (*unselect_process_cb) (struct Lisp_Process *); - void (*quit_p_cb) (void); - USID (*create_stream_pair_cb) (void* /* inhandle*/, void* /*outhandle*/ , - Lisp_Object* /* instream */, - Lisp_Object* /* outstream */, - int /* flags */); - USID (*delete_stream_pair_cb) (Lisp_Object /* instream */, - Lisp_Object /* outstream */); -}; - -/* Flags for create_stream_pair_cb() FLAGS parameter */ -#define STREAM_PTY_FLUSHING 0x0001 -#define STREAM_NETWORK_CONNECTION 0x0002 - -extern struct event_stream *event_stream; - -typedef enum emacs_event_type -{ - empty_event, - key_press_event, - button_press_event, - button_release_event, - pointer_motion_event, - process_event, - timeout_event, - magic_event, - magic_eval_event, - eval_event, - misc_user_event, - dead_event -} emacs_event_type; - -#define first_event_type empty_event -#define last_event_type dead_event - - -struct key_data -{ - Lisp_Object keysym; - unsigned char modifiers; -}; - -struct button_data -{ - int button; - unsigned char modifiers; - int x, y; -}; - -struct motion_data -{ - int x, y; - unsigned char modifiers; -}; - -struct process_data -{ - Lisp_Object process; -}; - -struct timeout_data -{ - int interval_id; - int id_number; - Lisp_Object function; - Lisp_Object object; -}; - -struct eval_data -{ - Lisp_Object function; - Lisp_Object object; -}; - -struct misc_user_data -{ - Lisp_Object function; - Lisp_Object object; - int button; - unsigned char modifiers; - int x, y; -}; - -struct magic_eval_data -{ - void (*internal_function) (Lisp_Object); - Lisp_Object object; -}; - -#if defined (HAVE_X_WINDOWS) && defined(emacs) -# include -#endif - -union magic_data -{ -#ifdef HAVE_TTY - char underlying_tty_event; -#endif -#ifdef HAVE_X_WINDOWS - XEvent underlying_x_event; -#endif -#ifdef HAVE_MS_WINDOWS - int underlying_mswindows_event; -#endif -}; - -struct Lisp_Event -{ - /* header->next (aka XEVENT_NEXT ()) is used as follows: - - For dead events, this is the next dead one. - - For events on the command_event_queue, the next one on the queue. - - Likewise for events chained in the command builder. - - Otherwise it's Qnil. - */ - struct lrecord_header lheader; - Lisp_Object next; - emacs_event_type event_type; - Lisp_Object channel; - unsigned int timestamp; - union - { - struct key_data key; - struct button_data button; - struct motion_data motion; - struct process_data process; - struct timeout_data timeout; - struct eval_data eval; /* misc_user_event no longer uses this */ - struct misc_user_data misc; /* because it needs position information */ - union magic_data magic; - struct magic_eval_data magic_eval; - } event; -}; - -DECLARE_LRECORD (event, struct Lisp_Event); -#define XEVENT(x) XRECORD (x, event, struct Lisp_Event) -#define XSETEVENT(x, p) XSETRECORD (x, p, event) -#define EVENTP(x) RECORDP (x, event) -#define GC_EVENTP(x) GC_RECORDP (x, event) -#define CHECK_EVENT(x) CHECK_RECORD (x, event) -#define CONCHECK_EVENT(x) CONCHECK_RECORD (x, event) - -DECLARE_LRECORD (command_builder, struct command_builder); - -#define EVENT_CHANNEL(a) ((a)->channel) -#define EVENT_TYPE(a) ((a)->event_type) -#define XEVENT_TYPE(a) (XEVENT (a)->event_type) -#define EVENT_NEXT(a) ((a)->next) -#define XEVENT_NEXT(e) (XEVENT (e)->next) -#define XSET_EVENT_NEXT(e, n) do { (XEVENT (e)->next = (n)); } while (0) - -#define EVENT_CHAIN_LOOP(event, chain) \ - for (event = chain; !NILP (event); event = XEVENT_NEXT (event)) - -#define EVENT_LIVE_P(a) (EVENT_TYPE (a) != dead_event) - -#define CHECK_LIVE_EVENT(x) do { \ - CHECK_EVENT (x); \ - if (! EVENT_LIVE_P (XEVENT (x))) \ - dead_wrong_type_argument (Qevent_live_p, (x)); \ -} while (0) -#define CONCHECK_LIVE_EVENT(x) do { \ - CONCHECK_EVENT (x); \ - if (! EVENT_LIVE_P (XEVENT (x))) \ - x = wrong_type_argument (Qevent_live_p, (x)); \ -} while (0) - - -EXFUN (Fcharacter_to_event, 4); -EXFUN (Fdeallocate_event, 1); -EXFUN (Fevent_glyph_extent, 1); -EXFUN (Fevent_modeline_position, 1); -EXFUN (Fevent_over_modeline_p, 1); -EXFUN (Fevent_over_toolbar_p, 1); -EXFUN (Fevent_over_vertical_divider_p, 1); -EXFUN (Fevent_point, 1); -EXFUN (Fevent_window, 1); -EXFUN (Fmake_event, 2); - -extern Lisp_Object QKbackspace, QKdelete, QKescape, QKlinefeed, QKreturn; -extern Lisp_Object QKspace, QKtab, Qmouse_event_p, Vcharacter_set_property; -extern Lisp_Object Qcancel_mode_internal; - -/* Note: under X Windows, MOD_ALT is generated by the Alt key if there are - both Alt and Meta keys. If there are no Meta keys, then Alt generates - MOD_META instead. - */ - -#ifdef emacs -/* Maybe this should be trickier */ -#define KEYSYM(x) (intern (x)) - -/* from events.c */ -void format_event_object (char *buf, struct Lisp_Event *e, int brief); -void character_to_event (Emchar c, struct Lisp_Event *event, - struct console *con, - int use_console_meta_flag, - int do_backspace_mapping); -void zero_event (struct Lisp_Event *e); -void deallocate_event_chain (Lisp_Object event); -Lisp_Object event_chain_tail (Lisp_Object event); -void enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail); -Lisp_Object dequeue_event (Lisp_Object *head, Lisp_Object *tail); -void enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head, - Lisp_Object *tail); -int event_chain_count (Lisp_Object event_chain); -void nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event); -Lisp_Object key_sequence_to_event_chain (Lisp_Object seq); -Lisp_Object event_chain_find_previous (Lisp_Object event_chain, - Lisp_Object event); -Lisp_Object event_chain_nth (Lisp_Object event_chain, int n); -Lisp_Object copy_event_chain (Lisp_Object event_chain); -/* True if this is a non-internal event - (keyboard press, menu, scrollbar, mouse button) */ -int command_event_p (Lisp_Object event); -struct console *event_console_or_selected (Lisp_Object event); - -/* from event-stream.c */ -Lisp_Object allocate_command_builder (Lisp_Object console); -void enqueue_magic_eval_event (void (*fun) (Lisp_Object), Lisp_Object object); -void event_stream_next_event (struct Lisp_Event *event); -void event_stream_handle_magic_event (struct Lisp_Event *event); -void event_stream_select_console (struct console *con); -void event_stream_unselect_console (struct console *con); -void event_stream_select_process (struct Lisp_Process *proc); -void event_stream_unselect_process (struct Lisp_Process *proc); -USID event_stream_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, Lisp_Object* outstream, int flags); -USID event_stream_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream); -void event_stream_quit_p (void); - -struct low_level_timeout -{ - int id; - EMACS_TIME time; - struct low_level_timeout *next; -}; - -int add_low_level_timeout (struct low_level_timeout **timeout_list, - EMACS_TIME thyme); -void remove_low_level_timeout (struct low_level_timeout **timeout_list, - int id); -int get_low_level_timeout_interval (struct low_level_timeout * - timeout_list, EMACS_TIME *interval); -int pop_low_level_timeout (struct low_level_timeout **timeout_list, - EMACS_TIME *time_out); -int event_stream_generate_wakeup (unsigned int milliseconds, - unsigned int vanilliseconds, - Lisp_Object function, - Lisp_Object object, - int async_p); -void event_stream_disable_wakeup (int id, int async_p); -void event_stream_deal_with_async_timeout (int interval_id); - -int event_stream_add_async_timeout (EMACS_TIME thyme); -void event_stream_remove_async_timeout (int id); - -/* from event-stream.c -- focus sanity */ -extern int focus_follows_mouse; -void investigate_frame_change (void); - -void emacs_handle_focus_change_preliminary (Lisp_Object frame_inp_and_dev); -void emacs_handle_focus_change_final (Lisp_Object frame_inp_and_dev); - -Lisp_Object extract_this_command_keys_nth_mouse_event (int n); -Lisp_Object extract_vector_nth_mouse_event (Lisp_Object vector, int n); - -void single_console_state (void); -void any_console_state (void); -int in_single_console_state (void); - -extern int emacs_is_blocking; - -extern volatile int sigint_happened; - -#ifdef HAVE_UNIXOID_EVENT_LOOP -/* from event-unixoid.c */ - -/* Ceci n'est pas un pipe. */ -extern int signal_event_pipe[]; - -void signal_fake_event (void); -void drain_signal_event_pipe (void); - -extern int fake_event_occurred; - -int event_stream_unixoid_select_console (struct console *con); -int event_stream_unixoid_unselect_console (struct console *con); -int event_stream_unixoid_select_process (struct Lisp_Process *proc); -int event_stream_unixoid_unselect_process (struct Lisp_Process *proc); -int read_event_from_tty_or_stream_desc (struct Lisp_Event *event, - struct console *con, int fd); -USID event_stream_unixoid_create_stream_pair (void* inhandle, void* outhandle, - Lisp_Object* instream, - Lisp_Object* outstream, - int flags); -USID event_stream_unixoid_delete_stream_pair (Lisp_Object instream, - Lisp_Object outstream); - -/* Beware: this evil macro evaluates its arg many times */ -#define FD_TO_USID(fd) ((fd)==0 ? (USID)999999 : ((fd)<0 ? USID_DONTHASH : (USID)(fd))) - -#endif /* HAVE_UNIXOID_EVENT_LOOP */ - -/* Define this if you want the tty event stream to be used when the - first console is tty, even if HAVE_X_WINDOWS is defined */ -/* #define DEBUG_TTY_EVENT_STREAM */ - -#endif /* emacs */ - -#endif /* _XEMACS_EVENTS_H_ */ diff --git a/src/extents.c b/src/extents.c deleted file mode 100644 index 1c7c5b3..0000000 --- a/src/extents.c +++ /dev/null @@ -1,6852 +0,0 @@ -/* Copyright (c) 1994, 1995 Free Software Foundation, Inc. - Copyright (c) 1995 Sun Microsystems, Inc. - Copyright (c) 1995, 1996 Ben Wing. - -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 file has been Mule-ized. */ - -/* Written by Ben Wing . - - [Originally written by some people at Lucid. - Hacked on by jwz. - Start/end-open stuff added by John Rose (john.rose@eng.sun.com). - Rewritten from scratch by Ben Wing, December 1994.] */ - -/* Commentary: - - Extents are regions over a buffer, with a start and an end position - denoting the region of the buffer included in the extent. In - addition, either end can be closed or open, meaning that the endpoint - is or is not logically included in the extent. Insertion of a character - at a closed endpoint causes the character to go inside the extent; - insertion at an open endpoint causes the character to go outside. - - Extent endpoints are stored using memory indices (see insdel.c), - to minimize the amount of adjusting that needs to be done when - characters are inserted or deleted. - - (Formerly, extent endpoints at the gap could be either before or - after the gap, depending on the open/closedness of the endpoint. - The intent of this was to make it so that insertions would - automatically go inside or out of extents as necessary with no - further work needing to be done. It didn't work out that way, - however, and just ended up complexifying and buggifying all the - rest of the code.) - - Extents are compared using memory indices. There are two orderings - for extents and both orders are kept current at all times. The normal - or "display" order is as follows: - - Extent A is "less than" extent B, that is, earlier in the display order, - if: A-start < B-start, - or if: A-start = B-start, and A-end > B-end - - So if two extents begin at the same position, the larger of them is the - earlier one in the display order (EXTENT_LESS is true). - - For the e-order, the same thing holds: Extent A is "less than" extent B - in e-order, that is, later in the buffer, - if: A-end < B-end, - or if: A-end = B-end, and A-start > B-start - - So if two extents end at the same position, the smaller of them is the - earlier one in the e-order (EXTENT_E_LESS is true). - - The display order and the e-order are complementary orders: any - theorem about the display order also applies to the e-order if you - swap all occurrences of "display order" and "e-order", "less than" - and "greater than", and "extent start" and "extent end". - - Extents can be zero-length, and will end up that way if their endpoints - are explicitly set that way or if their detachable property is nil - and all the text in the extent is deleted. (The exception is open-open - zero-length extents, which are barred from existing because there is - no sensible way to define their properties. Deletion of the text in - an open-open extent causes it to be converted into a closed-open - extent.) Zero-length extents are primarily used to represent - annotations, and behave as follows: - - 1) Insertion at the position of a zero-length extent expands the extent - if both endpoints are closed; goes after the extent if it is closed-open; - and goes before the extent if it is open-closed. - - 2) Deletion of a character on a side of a zero-length extent whose - corresponding endpoint is closed causes the extent to be detached if - it is detachable; if the extent is not detachable or the corresponding - endpoint is open, the extent remains in the buffer, moving as necessary. - - Note that closed-open, non-detachable zero-length extents behave exactly - like markers and that open-closed, non-detachable zero-length extents - behave like the "point-type" marker in Mule. - - - #### The following information is wrong in places. - - More about the different orders: - -------------------------------- - - The extents in a buffer are ordered by "display order" because that - is that order that the redisplay mechanism needs to process them in. - The e-order is an auxiliary ordering used to facilitate operations - over extents. The operations that can be performed on the ordered - list of extents in a buffer are - - 1) Locate where an extent would go if inserted into the list. - 2) Insert an extent into the list. - 3) Remove an extent from the list. - 4) Map over all the extents that overlap a range. - - (4) requires being able to determine the first and last extents - that overlap a range. - - NOTE: "overlap" is used as follows: - - -- two ranges overlap if they have at least one point in common. - Whether the endpoints are open or closed makes a difference here. - -- a point overlaps a range if the point is contained within the - range; this is equivalent to treating a point P as the range - [P, P]. - -- In the case of an *extent* overlapping a point or range, the - extent is normally treated as having closed endpoints. This - applies consistently in the discussion of stacks of extents - and such below. Note that this definition of overlap is not - necessarily consistent with the extents that `map-extents' - maps over, since `map-extents' sometimes pays attention to - whether the endpoints of an extents are open or closed. - But for our purposes, it greatly simplifies things to treat - all extents as having closed endpoints. - - First, define >, <, <=, etc. as applied to extents to mean - comparison according to the display order. Comparison between an - extent E and an index I means comparison between E and the range - [I, I]. - Also define e>, e<, e<=, etc. to mean comparison according to the - e-order. - For any range R, define R(0) to be the starting index of the range - and R(1) to be the ending index of the range. - For any extent E, define E(next) to be the extent directly following - E, and E(prev) to be the extent directly preceding E. Assume - E(next) and E(prev) can be determined from E in constant time. - (This is because we store the extent list as a doubly linked - list.) - Similarly, define E(e-next) and E(e-prev) to be the extents - directly following and preceding E in the e-order. - - Now: - - Let R be a range. - Let F be the first extent overlapping R. - Let L be the last extent overlapping R. - - Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next). - - This follows easily from the definition of display order. The - basic reason that this theorem applies is that the display order - sorts by increasing starting index. - - Therefore, we can determine L just by looking at where we would - insert R(1) into the list, and if we know F and are moving forward - over extents, we can easily determine when we've hit L by comparing - the extent we're at to R(1). - - Theorem 2: F(e-prev) e< [1, R(0)] e<= F. - - This is the analog of Theorem 1, and applies because the e-order - sorts by increasing ending index. - - Therefore, F can be found in the same amount of time as operation (1), - i.e. the time that it takes to locate where an extent would go if - inserted into the e-order list. - - If the lists were stored as balanced binary trees, then operation (1) - would take logarithmic time, which is usually quite fast. However, - currently they're stored as simple doubly-linked lists, and instead - we do some caching to try to speed things up. - - Define a "stack of extents" (or "SOE") as the set of extents - (ordered in the display order) that overlap an index I, together with - the SOE's "previous" extent, which is an extent that precedes I in - the e-order. (Hopefully there will not be very many extents between - I and the previous extent.) - - Now: - - Let I be an index, let S be the stack of extents on I, let F be - the first extent in S, and let P be S's previous extent. - - Theorem 3: The first extent in S is the first extent that overlaps - any range [I, J]. - - Proof: Any extent that overlaps [I, J] but does not include I must - have a start index > I, and thus be greater than any extent in S. - - Therefore, finding the first extent that overlaps a range R is the - same as finding the first extent that overlaps R(0). - - Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the - first extent that overlaps I2. Then, either F2 is in S or F2 is - greater than any extent in S. - - Proof: If F2 does not include I then its start index is greater - than I and thus it is greater than any extent in S, including F. - Otherwise, F2 includes I and thus is in S, and thus F2 >= F. - -*/ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "debug.h" -#include "device.h" -#include "elhash.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" -#include "insdel.h" -#include "keymap.h" -#include "opaque.h" -#include "process.h" -#include "redisplay.h" - -/* ------------------------------- */ -/* gap array */ -/* ------------------------------- */ - -/* Note that this object is not extent-specific and should perhaps be - moved into another file. */ - -/* Holds a marker that moves as elements in the array are inserted and - deleted, similar to standard markers. */ - -typedef struct gap_array_marker -{ - int pos; - struct gap_array_marker *next; -} Gap_Array_Marker; - -/* Holds a "gap array", which is an array of elements with a gap located - in it. Insertions and deletions with a high degree of locality - are very fast, essentially in constant time. Array positions as - used and returned in the gap array functions are independent of - the gap. */ - -typedef struct gap_array -{ - char *array; - int gap; - int gapsize; - int numels; - int elsize; - Gap_Array_Marker *markers; -} Gap_Array; - -Gap_Array_Marker *gap_array_marker_freelist; - -/* Convert a "memory position" (i.e. taking the gap into account) into - the address of the element at (i.e. after) that position. "Memory - positions" are only used internally and are of type Memind. - "Array positions" are used externally and are of type int. */ -#define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel)) - -/* Number of elements currently in a gap array */ -#define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels) - -#define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \ - ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize) - -#define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \ - ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize) - -/* Convert an array position into the address of the element at - (i.e. after) that position. */ -#define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \ - GAP_ARRAY_MEMEL_ADDR(ga, pos) : \ - GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize)) - -/* ------------------------------- */ -/* extent list */ -/* ------------------------------- */ - -typedef struct extent_list_marker -{ - Gap_Array_Marker *m; - int endp; - struct extent_list_marker *next; -} Extent_List_Marker; - -typedef struct extent_list -{ - Gap_Array *start; - Gap_Array *end; - Extent_List_Marker *markers; -} Extent_List; - -Extent_List_Marker *extent_list_marker_freelist; - -#define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \ - ((extent_start (e) == (st)) && \ - (extent_end (e) > (nd)))) - -#define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \ - (extent_end (e) == (nd))) - -#define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \ - ((extent_start (e) == (st)) && \ - (extent_end (e) >= (nd)))) - -/* Is extent E1 less than extent E2 in the display order? */ -#define EXTENT_LESS(e1,e2) \ - EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2)) - -/* Is extent E1 equal to extent E2? */ -#define EXTENT_EQUAL(e1,e2) \ - EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) - -/* Is extent E1 less than or equal to extent E2 in the display order? */ -#define EXTENT_LESS_EQUAL(e1,e2) \ - EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) - -#define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ - ((extent_end (e) == (nd)) && \ - (extent_start (e) > (st)))) - -#define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \ - ((extent_end (e) == (nd)) && \ - (extent_start (e) >= (st)))) - -/* Is extent E1 less than extent E2 in the e-order? */ -#define EXTENT_E_LESS(e1,e2) \ - EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2)) - -/* Is extent E1 less than or equal to extent E2 in the e-order? */ -#define EXTENT_E_LESS_EQUAL(e1,e2) \ - EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2)) - -#define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos)) - -/* ------------------------------- */ -/* auxiliary extent structure */ -/* ------------------------------- */ - -struct extent_auxiliary extent_auxiliary_defaults; - -/* ------------------------------- */ -/* buffer-extent primitives */ -/* ------------------------------- */ - -typedef struct stack_of_extents -{ - Extent_List *extents; - Memind pos; /* Position of stack of extents. EXTENTS is the list of - all extents that overlap this position. This position - can be -1 if the stack of extents is invalid (this - happens when a buffer is first created or a string's - stack of extents is created [a string's stack of extents - is nuked when a GC occurs, to conserve memory]). */ -} Stack_Of_Extents; - -/* ------------------------------- */ -/* map-extents */ -/* ------------------------------- */ - -typedef int Endpoint_Index; - -#define memind_to_startind(x, start_open) \ - ((Endpoint_Index) (((x) << 1) + !!(start_open))) -#define memind_to_endind(x, end_open) \ - ((Endpoint_Index) (((x) << 1) - !!(end_open))) - -/* Combination macros */ -#define bytind_to_startind(buf, x, start_open) \ - memind_to_startind (bytind_to_memind (buf, x), start_open) -#define bytind_to_endind(buf, x, end_open) \ - memind_to_endind (bytind_to_memind (buf, x), end_open) - -/* ------------------------------- */ -/* buffer-or-string primitives */ -/* ------------------------------- */ - -/* Similar for Bytinds and start/end indices. */ - -#define buffer_or_string_bytind_to_startind(obj, ind, start_open) \ - memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind), \ - start_open) - -#define buffer_or_string_bytind_to_endind(obj, ind, end_open) \ - memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind), \ - end_open) - -/* ------------------------------- */ -/* Lisp-level functions */ -/* ------------------------------- */ - -/* flags for decode_extent() */ -#define DE_MUST_HAVE_BUFFER 1 -#define DE_MUST_BE_ATTACHED 2 - -Lisp_Object Vlast_highlighted_extent; -int mouse_highlight_priority; - -Lisp_Object Qextentp; -Lisp_Object Qextent_live_p; - -Lisp_Object Qall_extents_closed; -Lisp_Object Qall_extents_open; -Lisp_Object Qall_extents_closed_open; -Lisp_Object Qall_extents_open_closed; -Lisp_Object Qstart_in_region; -Lisp_Object Qend_in_region; -Lisp_Object Qstart_and_end_in_region; -Lisp_Object Qstart_or_end_in_region; -Lisp_Object Qnegate_in_region; - -Lisp_Object Qdetached; -Lisp_Object Qdestroyed; -Lisp_Object Qbegin_glyph; -Lisp_Object Qend_glyph; -Lisp_Object Qstart_open; -Lisp_Object Qend_open; -Lisp_Object Qstart_closed; -Lisp_Object Qend_closed; -Lisp_Object Qread_only; -/* Qhighlight defined in general.c */ -Lisp_Object Qunique; -Lisp_Object Qduplicable; -Lisp_Object Qdetachable; -Lisp_Object Qpriority; -Lisp_Object Qmouse_face; -Lisp_Object Qinitial_redisplay_function; - -Lisp_Object Qglyph_layout; /* This exists only for backwards compatibility. */ -Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout; -Lisp_Object Qoutside_margin; -Lisp_Object Qinside_margin; -Lisp_Object Qwhitespace; -/* Qtext defined in general.c */ - -/* partially used in redisplay */ -Lisp_Object Qglyph_invisible; - -Lisp_Object Qcopy_function; -Lisp_Object Qpaste_function; - -/* The idea here is that if we're given a list of faces, we - need to "memoize" this so that two lists of faces that are `equal' - turn into the same object. When `set-extent-face' is called, we - "memoize" into a list of actual faces; when `extent-face' is called, - we do a reverse lookup to get the list of symbols. */ - -static Lisp_Object canonicalize_extent_property (Lisp_Object prop, - Lisp_Object value); -Lisp_Object Vextent_face_memoize_hash_table; -Lisp_Object Vextent_face_reverse_memoize_hash_table; -Lisp_Object Vextent_face_reusable_list; -/* FSFmacs bogosity */ -Lisp_Object Vdefault_text_properties; - - -EXFUN (Fextent_properties, 1); -EXFUN (Fset_extent_property, 3); - - -/************************************************************************/ -/* Generalized gap array */ -/************************************************************************/ - -/* This generalizes the "array with a gap" model used to store buffer - characters. This is based on the stuff in insdel.c and should - probably be merged with it. This is not extent-specific and should - perhaps be moved into a separate file. */ - -/* ------------------------------- */ -/* internal functions */ -/* ------------------------------- */ - -/* Adjust the gap array markers in the range (FROM, TO]. Parallel to - adjust_markers() in insdel.c. */ - -static void -gap_array_adjust_markers (Gap_Array *ga, Memind from, - Memind to, int amount) -{ - Gap_Array_Marker *m; - - for (m = ga->markers; m; m = m->next) - m->pos = do_marker_adjustment (m->pos, from, to, amount); -} - -/* Move the gap to array position POS. Parallel to move_gap() in - insdel.c but somewhat simplified. */ - -static void -gap_array_move_gap (Gap_Array *ga, int pos) -{ - int gap = ga->gap; - int gapsize = ga->gapsize; - - assert (ga->array); - if (pos < gap) - { - memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize), - GAP_ARRAY_MEMEL_ADDR (ga, pos), - (gap - pos)*ga->elsize); - gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap, - gapsize); - } - else if (pos > gap) - { - memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap), - GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize), - (pos - gap)*ga->elsize); - gap_array_adjust_markers (ga, (Memind) (gap + gapsize), - (Memind) (pos + gapsize), - gapsize); - } - ga->gap = pos; -} - -/* Make the gap INCREMENT characters longer. Parallel to make_gap() in - insdel.c. */ - -static void -gap_array_make_gap (Gap_Array *ga, int increment) -{ - char *ptr = ga->array; - int real_gap_loc; - int old_gap_size; - - /* If we have to get more space, get enough to last a while. We use - a geometric progression that saves on realloc space. */ - increment += 100 + ga->numels / 8; - - ptr = (char *) xrealloc (ptr, - (ga->numels + ga->gapsize + increment)*ga->elsize); - if (ptr == 0) - memory_full (); - ga->array = ptr; - - real_gap_loc = ga->gap; - old_gap_size = ga->gapsize; - - /* Call the newly allocated space a gap at the end of the whole space. */ - ga->gap = ga->numels + ga->gapsize; - ga->gapsize = increment; - - /* Move the new gap down to be consecutive with the end of the old one. - This adjusts the markers properly too. */ - gap_array_move_gap (ga, real_gap_loc + old_gap_size); - - /* Now combine the two into one large gap. */ - ga->gapsize += old_gap_size; - ga->gap = real_gap_loc; -} - -/* ------------------------------- */ -/* external functions */ -/* ------------------------------- */ - -/* Insert NUMELS elements (pointed to by ELPTR) into the specified - gap array at POS. */ - -static void -gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels) -{ - assert (pos >= 0 && pos <= ga->numels); - if (ga->gapsize < numels) - gap_array_make_gap (ga, numels - ga->gapsize); - if (pos != ga->gap) - gap_array_move_gap (ga, pos); - - memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr, - numels*ga->elsize); - ga->gapsize -= numels; - ga->gap += numels; - ga->numels += numels; - /* This is the equivalent of insert-before-markers. - - #### Should only happen if marker is "moves forward at insert" type. - */ - - gap_array_adjust_markers (ga, pos - 1, pos, numels); -} - -/* Delete NUMELS elements from the specified gap array, starting at FROM. */ - -static void -gap_array_delete_els (Gap_Array *ga, int from, int numdel) -{ - int to = from + numdel; - int gapsize = ga->gapsize; - - assert (from >= 0); - assert (numdel >= 0); - assert (to <= ga->numels); - - /* Make sure the gap is somewhere in or next to what we are deleting. */ - if (to < ga->gap) - gap_array_move_gap (ga, to); - if (from > ga->gap) - gap_array_move_gap (ga, from); - - /* Relocate all markers pointing into the new, larger gap - to point at the end of the text before the gap. */ - gap_array_adjust_markers (ga, to + gapsize, to + gapsize, - - numdel - gapsize); - - ga->gapsize += numdel; - ga->numels -= numdel; - ga->gap = from; -} - -static Gap_Array_Marker * -gap_array_make_marker (Gap_Array *ga, int pos) -{ - Gap_Array_Marker *m; - - assert (pos >= 0 && pos <= ga->numels); - if (gap_array_marker_freelist) - { - m = gap_array_marker_freelist; - gap_array_marker_freelist = gap_array_marker_freelist->next; - } - else - m = xnew (Gap_Array_Marker); - - m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); - m->next = ga->markers; - ga->markers = m; - return m; -} - -static void -gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m) -{ - Gap_Array_Marker *p, *prev; - - for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next) - ; - assert (p); - if (prev) - prev->next = p->next; - else - ga->markers = p->next; - m->next = gap_array_marker_freelist; - m->pos = 0xDEADBEEF; /* -559038737 as an int */ - gap_array_marker_freelist = m; -} - -static void -gap_array_delete_all_markers (Gap_Array *ga) -{ - Gap_Array_Marker *p, *next; - - for (p = ga->markers; p; p = next) - { - next = p->next; - p->next = gap_array_marker_freelist; - p->pos = 0xDEADBEEF; /* -559038737 as an int */ - gap_array_marker_freelist = p; - } -} - -static void -gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos) -{ - assert (pos >= 0 && pos <= ga->numels); - m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos); -} - -#define gap_array_marker_pos(ga, m) \ - GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos) - -static Gap_Array * -make_gap_array (int elsize) -{ - Gap_Array *ga = xnew_and_zero (Gap_Array); - ga->elsize = elsize; - return ga; -} - -static void -free_gap_array (Gap_Array *ga) -{ - if (ga->array) - xfree (ga->array); - gap_array_delete_all_markers (ga); - xfree (ga); -} - - -/************************************************************************/ -/* Extent list primitives */ -/************************************************************************/ - -/* A list of extents is maintained as a double gap array: one gap array - is ordered by start index (the "display order") and the other is - ordered by end index (the "e-order"). Note that positions in an - extent list should logically be conceived of as referring *to* - a particular extent (as is the norm in programs) rather than - sitting between two extents. Note also that callers of these - functions should not be aware of the fact that the extent list is - implemented as an array, except for the fact that positions are - integers (this should be generalized to handle integers and linked - list equally well). -*/ - -/* Number of elements in an extent list */ -#define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start) - -/* Return the position at which EXTENT is located in the specified extent - list (in the display order if ENDP is 0, in the e-order otherwise). - If the extent is not found, the position where the extent would - be inserted is returned. If ENDP is 0, the insertion would go after - all other equal extents. If ENDP is not 0, the insertion would go - before all other equal extents. If FOUNDP is not 0, then whether - the extent was found will get written into it. */ - -static int -extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp) -{ - Gap_Array *ga = endp ? el->end : el->start; - int left = 0, right = GAP_ARRAY_NUM_ELS (ga); - int oldfoundpos, foundpos; - int found; - - while (left != right) - { - /* RIGHT might not point to a valid extent (i.e. it's at the end - of the list), so NEWPOS must round down. */ - unsigned int newpos = (left + right) >> 1; - EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos); - - if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent)) - left = newpos+1; - else - right = newpos; - } - - /* Now we're at the beginning of all equal extents. */ - found = 0; - oldfoundpos = foundpos = left; - while (foundpos < GAP_ARRAY_NUM_ELS (ga)) - { - EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos); - if (e == extent) - { - found = 1; - break; - } - if (!EXTENT_EQUAL (e, extent)) - break; - foundpos++; - } - if (foundp) - *foundp = found; - if (found || !endp) - return foundpos; - else - return oldfoundpos; -} - -/* Return the position of the first extent that begins at or after POS - (or ends at or after POS, if ENDP is not 0). - - An out-of-range value for POS is allowed, and guarantees that the - position at the beginning or end of the extent list is returned. */ - -static int -extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp) -{ - struct extent fake_extent; - /* - - Note that if we search for [POS, POS], then we get the following: - - -- if ENDP is 0, then all extents whose start position is <= POS - lie before the returned position, and all extents whose start - position is > POS lie at or after the returned position. - - -- if ENDP is not 0, then all extents whose end position is < POS - lie before the returned position, and all extents whose end - position is >= POS lie at or after the returned position. - - */ - set_extent_start (&fake_extent, endp ? pos : pos-1); - set_extent_end (&fake_extent, endp ? pos : pos-1); - return extent_list_locate (el, &fake_extent, endp, 0); -} - -/* Return the extent at POS. */ - -static EXTENT -extent_list_at (Extent_List *el, Memind pos, int endp) -{ - Gap_Array *ga = endp ? el->end : el->start; - - assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga)); - return EXTENT_GAP_ARRAY_AT (ga, pos); -} - -/* Insert an extent into an extent list. */ - -static void -extent_list_insert (Extent_List *el, EXTENT extent) -{ - int pos, foundp; - - pos = extent_list_locate (el, extent, 0, &foundp); - assert (!foundp); - gap_array_insert_els (el->start, pos, &extent, 1); - pos = extent_list_locate (el, extent, 1, &foundp); - assert (!foundp); - gap_array_insert_els (el->end, pos, &extent, 1); -} - -/* Delete an extent from an extent list. */ - -static void -extent_list_delete (Extent_List *el, EXTENT extent) -{ - int pos, foundp; - - pos = extent_list_locate (el, extent, 0, &foundp); - assert (foundp); - gap_array_delete_els (el->start, pos, 1); - pos = extent_list_locate (el, extent, 1, &foundp); - assert (foundp); - gap_array_delete_els (el->end, pos, 1); -} - -static void -extent_list_delete_all (Extent_List *el) -{ - gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start)); - gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end)); -} - -static Extent_List_Marker * -extent_list_make_marker (Extent_List *el, int pos, int endp) -{ - Extent_List_Marker *m; - - if (extent_list_marker_freelist) - { - m = extent_list_marker_freelist; - extent_list_marker_freelist = extent_list_marker_freelist->next; - } - else - m = xnew (Extent_List_Marker); - - m->m = gap_array_make_marker (endp ? el->end : el->start, pos); - m->endp = endp; - m->next = el->markers; - el->markers = m; - return m; -} - -#define extent_list_move_marker(el, mkr, pos) \ - gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos) - -static void -extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m) -{ - Extent_List_Marker *p, *prev; - - for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next) - ; - assert (p); - if (prev) - prev->next = p->next; - else - el->markers = p->next; - m->next = extent_list_marker_freelist; - extent_list_marker_freelist = m; - gap_array_delete_marker (m->endp ? el->end : el->start, m->m); -} - -#define extent_list_marker_pos(el, mkr) \ - gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m) - -static Extent_List * -allocate_extent_list (void) -{ - Extent_List *el = xnew (Extent_List); - el->start = make_gap_array (sizeof(EXTENT)); - el->end = make_gap_array (sizeof(EXTENT)); - el->markers = 0; - return el; -} - -static void -free_extent_list (Extent_List *el) -{ - free_gap_array (el->start); - free_gap_array (el->end); - xfree (el); -} - - -/************************************************************************/ -/* Auxiliary extent structure */ -/************************************************************************/ - -static Lisp_Object -mark_extent_auxiliary (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj); - markobj (data->begin_glyph); - markobj (data->end_glyph); - markobj (data->invisible); - markobj (data->children); - markobj (data->read_only); - markobj (data->mouse_face); - markobj (data->initial_redisplay_function); - markobj (data->before_change_functions); - markobj (data->after_change_functions); - return data->parent; -} - -DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary, - mark_extent_auxiliary, internal_object_printer, - 0, 0, 0, struct extent_auxiliary); - -void -allocate_extent_auxiliary (EXTENT ext) -{ - Lisp_Object extent_aux; - struct extent_auxiliary *data = - alloc_lcrecord_type (struct extent_auxiliary, lrecord_extent_auxiliary); - - copy_lcrecord (data, &extent_auxiliary_defaults); - XSETEXTENT_AUXILIARY (extent_aux, data); - ext->plist = Fcons (extent_aux, ext->plist); - ext->flags.has_aux = 1; -} - - -/************************************************************************/ -/* Extent info structure */ -/************************************************************************/ - -/* An extent-info structure consists of a list of the buffer or string's - extents and a "stack of extents" that lists all of the extents over - a particular position. The stack-of-extents info is used for - optimization purposes -- it basically caches some info that might - be expensive to compute. Certain otherwise hard computations are easy - given the stack of extents over a particular position, and if the - stack of extents over a nearby position is known (because it was - calculated at some prior point in time), it's easy to move the stack - of extents to the proper position. - - Given that the stack of extents is an optimization, and given that - it requires memory, a string's stack of extents is wiped out each - time a garbage collection occurs. Therefore, any time you retrieve - the stack of extents, it might not be there. If you need it to - be there, use the _force version. - - Similarly, a string may or may not have an extent_info structure. - (Generally it won't if there haven't been any extents added to the - string.) So use the _force version if you need the extent_info - structure to be there. */ - -static struct stack_of_extents *allocate_soe (void); -static void free_soe (struct stack_of_extents *soe); -static void soe_invalidate (Lisp_Object obj); - -static Lisp_Object -mark_extent_info (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj); - int i; - Extent_List *list = data->extents; - - /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like - objects that are created specially and never have their extent - list initialized (or rather, it is set to zero in - nuke_all_buffer_slots()). However, these objects get - garbage-collected so we have to deal. - - (Also the list can be zero when we're dealing with a destroyed - buffer.) */ - - if (list) - { - for (i = 0; i < extent_list_num_els (list); i++) - { - struct extent *extent = extent_list_at (list, i, 0); - Lisp_Object exobj; - - XSETEXTENT (exobj, extent); - markobj (exobj); - } - } - - return Qnil; -} - -static void -finalize_extent_info (void *header, int for_disksave) -{ - struct extent_info *data = (struct extent_info *) header; - - if (for_disksave) - return; - - if (data->soe) - { - free_soe (data->soe); - data->soe = 0; - } - if (data->extents) - { - free_extent_list (data->extents); - data->extents = 0; - } -} - -DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info, - mark_extent_info, internal_object_printer, - finalize_extent_info, 0, 0, - struct extent_info); - -static Lisp_Object -allocate_extent_info (void) -{ - Lisp_Object extent_info; - struct extent_info *data = - alloc_lcrecord_type (struct extent_info, lrecord_extent_info); - - XSETEXTENT_INFO (extent_info, data); - data->extents = allocate_extent_list (); - data->soe = 0; - return extent_info; -} - -void -flush_cached_extent_info (Lisp_Object extent_info) -{ - struct extent_info *data = XEXTENT_INFO (extent_info); - - if (data->soe) - { - free_soe (data->soe); - data->soe = 0; - } -} - - -/************************************************************************/ -/* Buffer/string extent primitives */ -/************************************************************************/ - -/* The functions in this section are the ONLY ones that should know - about the internal implementation of the extent lists. Other functions - should only know that there are two orderings on extents, the "display" - order (sorted by start position, basically) and the e-order (sorted - by end position, basically), and that certain operations are provided - to manipulate the list. */ - -/* ------------------------------- */ -/* basic primitives */ -/* ------------------------------- */ - -static Lisp_Object -decode_buffer_or_string (Lisp_Object object) -{ - if (NILP (object)) - XSETBUFFER (object, current_buffer); - else if (BUFFERP (object)) - CHECK_LIVE_BUFFER (object); - else if (STRINGP (object)) - ; - else - dead_wrong_type_argument (Qbuffer_or_string_p, object); - - return object; -} - -EXTENT -extent_ancestor_1 (EXTENT e) -{ - while (e->flags.has_parent) - { - /* There should be no circularities except in case of a logic - error somewhere in the extent code */ - e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent); - } - return e; -} - -/* Given an extent object (string or buffer or nil), return its extent info. - This may be 0 for a string. */ - -static struct extent_info * -buffer_or_string_extent_info (Lisp_Object object) -{ - if (STRINGP (object)) - { - Lisp_Object plist = XSTRING (object)->plist; - if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist))) - return 0; - return XEXTENT_INFO (XCAR (plist)); - } - else if (NILP (object)) - return 0; - else - return XEXTENT_INFO (XBUFFER (object)->extent_info); -} - -/* Given a string or buffer, return its extent list. This may be - 0 for a string. */ - -static Extent_List * -buffer_or_string_extent_list (Lisp_Object object) -{ - struct extent_info *info = buffer_or_string_extent_info (object); - - if (!info) - return 0; - return info->extents; -} - -/* Given a string or buffer, return its extent info. If it's not there, - create it. */ - -static struct extent_info * -buffer_or_string_extent_info_force (Lisp_Object object) -{ - struct extent_info *info = buffer_or_string_extent_info (object); - - if (!info) - { - Lisp_Object extent_info; - - assert (STRINGP (object)); /* should never happen for buffers -- - the only buffers without an extent - info are those after finalization, - destroyed buffers, or special - Lisp-inaccessible buffer objects. */ - extent_info = allocate_extent_info (); - XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist); - return XEXTENT_INFO (extent_info); - } - - return info; -} - -/* Detach all the extents in OBJECT. Called from redisplay. */ - -void -detach_all_extents (Lisp_Object object) -{ - struct extent_info *data = buffer_or_string_extent_info (object); - - if (data) - { - if (data->extents) - { - int i; - - for (i = 0; i < extent_list_num_els (data->extents); i++) - { - EXTENT e = extent_list_at (data->extents, i, 0); - /* No need to do detach_extent(). Just nuke the damn things, - which results in the equivalent but faster. */ - set_extent_start (e, -1); - set_extent_end (e, -1); - } - } - - /* But we need to clear all the lists containing extents or - havoc will result. */ - extent_list_delete_all (data->extents); - soe_invalidate (object); - } -} - - -void -init_buffer_extents (struct buffer *b) -{ - b->extent_info = allocate_extent_info (); -} - -void -uninit_buffer_extents (struct buffer *b) -{ - struct extent_info *data = XEXTENT_INFO (b->extent_info); - - /* Don't destroy the extents here -- there may still be children - extents pointing to the extents. */ - detach_all_extents (make_buffer (b)); - finalize_extent_info (data, 0); -} - -/* Retrieve the extent list that an extent is a member of; the - return value will never be 0 except in destroyed buffers (in which - case the only extents that can refer to this buffer are detached - ones). */ - -#define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e)) - -/* ------------------------------- */ -/* stack of extents */ -/* ------------------------------- */ - -#ifdef ERROR_CHECK_EXTENTS - -void -sledgehammer_extent_check (Lisp_Object object) -{ - int i; - int endp; - Extent_List *el = buffer_or_string_extent_list (object); - struct buffer *buf = 0; - - if (!el) - return; - - if (BUFFERP (object)) - buf = XBUFFER (object); - - for (endp = 0; endp < 2; endp++) - for (i = 1; i < extent_list_num_els (el); i++) - { - EXTENT e1 = extent_list_at (el, i-1, endp); - EXTENT e2 = extent_list_at (el, i, endp); - if (buf) - { - assert (extent_start (e1) <= buf->text->gpt || - extent_start (e1) > buf->text->gpt + buf->text->gap_size); - assert (extent_end (e1) <= buf->text->gpt || - extent_end (e1) > buf->text->gpt + buf->text->gap_size); - } - assert (extent_start (e1) <= extent_end (e1)); - assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) : - (EXTENT_LESS_EQUAL (e1, e2))); - } -} - -#endif - -static Stack_Of_Extents * -buffer_or_string_stack_of_extents (Lisp_Object object) -{ - struct extent_info *info = buffer_or_string_extent_info (object); - if (!info) - return 0; - return info->soe; -} - -static Stack_Of_Extents * -buffer_or_string_stack_of_extents_force (Lisp_Object object) -{ - struct extent_info *info = buffer_or_string_extent_info_force (object); - if (!info->soe) - info->soe = allocate_soe (); - return info->soe; -} - -/* #define SOE_DEBUG */ - -#ifdef SOE_DEBUG - -static void print_extent_1 (char *buf, Lisp_Object extent); - -static void -print_extent_2 (EXTENT e) -{ - Lisp_Object extent; - char buf[200]; - - XSETEXTENT (extent, e); - print_extent_1 (buf, extent); - fputs (buf, stdout); -} - -static void -soe_dump (Lisp_Object obj) -{ - int i; - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); - Extent_List *sel; - int endp; - - if (!soe) - { - printf ("No SOE"); - return; - } - sel = soe->extents; - printf ("SOE pos is %d (memind %d)\n", - soe->pos < 0 ? soe->pos : - buffer_or_string_memind_to_bytind (obj, soe->pos), - soe->pos); - for (endp = 0; endp < 2; endp++) - { - printf (endp ? "SOE end:" : "SOE start:"); - for (i = 0; i < extent_list_num_els (sel); i++) - { - EXTENT e = extent_list_at (sel, i, endp); - putchar ('\t'); - print_extent_2 (e); - } - putchar ('\n'); - } - putchar ('\n'); -} - -#endif - -/* Insert EXTENT into OBJ's stack of extents, if necessary. */ - -static void -soe_insert (Lisp_Object obj, EXTENT extent) -{ - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); - -#ifdef SOE_DEBUG - printf ("Inserting into SOE: "); - print_extent_2 (extent); - putchar ('\n'); -#endif - if (!soe || soe->pos < extent_start (extent) || - soe->pos > extent_end (extent)) - { -#ifdef SOE_DEBUG - printf ("(not needed)\n\n"); -#endif - return; - } - extent_list_insert (soe->extents, extent); -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); -#endif -} - -/* Delete EXTENT from OBJ's stack of extents, if necessary. */ - -static void -soe_delete (Lisp_Object obj, EXTENT extent) -{ - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); - -#ifdef SOE_DEBUG - printf ("Deleting from SOE: "); - print_extent_2 (extent); - putchar ('\n'); -#endif - if (!soe || soe->pos < extent_start (extent) || - soe->pos > extent_end (extent)) - { -#ifdef SOE_DEBUG - puts ("(not needed)\n"); -#endif - return; - } - extent_list_delete (soe->extents, extent); -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); -#endif -} - -/* Move OBJ's stack of extents to lie over the specified position. */ - -static void -soe_move (Lisp_Object obj, Memind pos) -{ - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); - Extent_List *sel = soe->extents; - int numsoe = extent_list_num_els (sel); - Extent_List *bel = buffer_or_string_extent_list (obj); - int direction; - int endp; - -#ifdef ERROR_CHECK_EXTENTS - assert (bel); -#endif - -#ifdef SOE_DEBUG - printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n", - soe->pos < 0 ? soe->pos : - buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos, - buffer_or_string_memind_to_bytind (obj, pos), pos); -#endif - if (soe->pos < pos) - { - direction = 1; - endp = 0; - } - else if (soe->pos > pos) - { - direction = -1; - endp = 1; - } - else - { -#ifdef SOE_DEBUG - puts ("(not needed)\n"); -#endif - return; - } - - /* For DIRECTION = 1: Any extent that overlaps POS is either in the - SOE (if the extent starts at or before SOE->POS) or is greater - (in the display order) than any extent in the SOE (if it starts - after SOE->POS). - - For DIRECTION = -1: Any extent that overlaps POS is either in the - SOE (if the extent ends at or after SOE->POS) or is less (in the - e-order) than any extent in the SOE (if it ends before SOE->POS). - - We proceed in two stages: - - 1) delete all extents in the SOE that don't overlap POS. - 2) insert all extents into the SOE that start (or end, when - DIRECTION = -1) in (SOE->POS, POS] and that overlap - POS. (Don't include SOE->POS in the range because those - extents would already be in the SOE.) - */ - - /* STAGE 1. */ - - if (numsoe > 0) - { - /* Delete all extents in the SOE that don't overlap POS. - This is all extents that end before (or start after, - if DIRECTION = -1) POS. - */ - - /* Deleting extents from the SOE is tricky because it changes - the positions of extents. If we are deleting in the forward - direction we have to call extent_list_at() on the same position - over and over again because positions after the deleted element - get shifted back by 1. To make life simplest, we delete forward - irrespective of DIRECTION. - */ - int start, end; - int i; - - if (direction > 0) - { - start = 0; - end = extent_list_locate_from_pos (sel, pos, 1); - } - else - { - start = extent_list_locate_from_pos (sel, pos+1, 0); - end = numsoe; - } - - for (i = start; i < end; i++) - extent_list_delete (sel, extent_list_at (sel, start /* see above */, - !endp)); - } - - /* STAGE 2. */ - - { - int start_pos; - - if (direction < 0) - start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1; - else - start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp); - - for (; start_pos >= 0 && start_pos < extent_list_num_els (bel); - start_pos += direction) - { - EXTENT e = extent_list_at (bel, start_pos, endp); - if ((direction > 0) ? - (extent_start (e) > pos) : - (extent_end (e) < pos)) - break; /* All further extents lie on the far side of POS - and thus can't overlap. */ - if ((direction > 0) ? - (extent_end (e) >= pos) : - (extent_start (e) <= pos)) - extent_list_insert (sel, e); - } - } - - soe->pos = pos; -#ifdef SOE_DEBUG - puts ("SOE afterwards is:"); - soe_dump (obj); -#endif -} - -static void -soe_invalidate (Lisp_Object obj) -{ - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj); - - if (soe) - { - extent_list_delete_all (soe->extents); - soe->pos = -1; - } -} - -static struct stack_of_extents * -allocate_soe (void) -{ - struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents); - soe->extents = allocate_extent_list (); - soe->pos = -1; - return soe; -} - -static void -free_soe (struct stack_of_extents *soe) -{ - free_extent_list (soe->extents); - xfree (soe); -} - -/* ------------------------------- */ -/* other primitives */ -/* ------------------------------- */ - -/* Return the start (endp == 0) or end (endp == 1) of an extent as - a byte index. If you want the value as a memory index, use - extent_endpoint(). If you want the value as a buffer position, - use extent_endpoint_bufpos(). */ - -static Bytind -extent_endpoint_bytind (EXTENT extent, int endp) -{ - assert (EXTENT_LIVE_P (extent)); - assert (!extent_detached_p (extent)); - { - Memind i = (endp) ? (extent_end (extent)) : - (extent_start (extent)); - Lisp_Object obj = extent_object (extent); - return buffer_or_string_memind_to_bytind (obj, i); - } -} - -static Bufpos -extent_endpoint_bufpos (EXTENT extent, int endp) -{ - assert (EXTENT_LIVE_P (extent)); - assert (!extent_detached_p (extent)); - { - Memind i = (endp) ? (extent_end (extent)) : - (extent_start (extent)); - Lisp_Object obj = extent_object (extent); - return buffer_or_string_memind_to_bufpos (obj, i); - } -} - -/* A change to an extent occurred that will change the display, so - notify redisplay. Maybe also recurse over all the extent's - descendants. */ - -static void -extent_changed_for_redisplay (EXTENT extent, int descendants_too, - int invisibility_change) -{ - Lisp_Object object; - Lisp_Object rest; - - /* we could easily encounter a detached extent while traversing the - children, but we should never be able to encounter a dead extent. */ - assert (EXTENT_LIVE_P (extent)); - - if (descendants_too) - { - Lisp_Object children = extent_children (extent); - - if (!NILP (children)) - { - /* first mark all of the extent's children. We will lose big-time - if there are any circularities here, so we sure as hell better - ensure that there aren't. */ - LIST_LOOP (rest, XWEAK_LIST_LIST (children)) - extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1, - invisibility_change); - } - } - - /* now mark the extent itself. */ - - object = extent_object (extent); - - if (!BUFFERP (object) || extent_detached_p (extent)) - /* #### Can changes to string extents affect redisplay? - I will have to think about this. What about string glyphs? - Things in the modeline? etc. */ - /* #### changes to string extents can certainly affect redisplay - if the extent is in some generated-modeline-string: when - we change an extent in generated-modeline-string, this changes - its parent, which is in `modeline-format', so we should - force the modeline to be updated. But how to determine whether - a string is a `generated-modeline-string'? Looping through - all buffers is not very efficient. Should we add all - `generated-modeline-string' strings to a hash table? - Maybe efficiency is not the greatest concern here and there's - no big loss in looping over the buffers. */ - return; - - { - struct buffer *b; - b = XBUFFER (object); - BUF_FACECHANGE (b)++; - MARK_EXTENTS_CHANGED; - if (invisibility_change) - MARK_CLIP_CHANGED; - buffer_extent_signal_changed_region (b, - extent_endpoint_bufpos (extent, 0), - extent_endpoint_bufpos (extent, 1)); - } -} - -/* A change to an extent occurred that might affect redisplay. - This is called when properties such as the endpoints, the layout, - or the priority changes. Redisplay will be affected only if - the extent has any displayable attributes. */ - -static void -extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too, - int invisibility_change) -{ - /* Retrieve the ancestor for efficiency */ - EXTENT anc = extent_ancestor (extent); - if (!NILP (extent_face (anc)) || - !NILP (extent_begin_glyph (anc)) || - !NILP (extent_end_glyph (anc)) || - !NILP (extent_mouse_face (anc)) || - !NILP (extent_invisible (anc)) || - !NILP (extent_initial_redisplay_function (anc)) || - invisibility_change) - extent_changed_for_redisplay (extent, descendants_too, - invisibility_change); -} - -static EXTENT -make_extent_detached (Lisp_Object object) -{ - EXTENT extent = allocate_extent (); - - assert (NILP (object) || STRINGP (object) || - (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object)))); - extent_object (extent) = object; - /* Now make sure the extent info exists. */ - if (!NILP (object)) - buffer_or_string_extent_info_force (object); - return extent; -} - -/* A "real" extent is any extent other than the internal (not-user-visible) - extents used by `map-extents'. */ - -static EXTENT -real_extent_at_forward (Extent_List *el, int pos, int endp) -{ - for (; pos < extent_list_num_els (el); pos++) - { - EXTENT e = extent_list_at (el, pos, endp); - if (!extent_internal_p (e)) - return e; - } - return 0; -} - -static EXTENT -real_extent_at_backward (Extent_List *el, int pos, int endp) -{ - for (; pos >= 0; pos--) - { - EXTENT e = extent_list_at (el, pos, endp); - if (!extent_internal_p (e)) - return e; - } - return 0; -} - -static EXTENT -extent_first (Lisp_Object obj) -{ - Extent_List *el = buffer_or_string_extent_list (obj); - - if (!el) - return 0; - return real_extent_at_forward (el, 0, 0); -} - -#ifdef DEBUG_XEMACS -static EXTENT -extent_e_first (Lisp_Object obj) -{ - Extent_List *el = buffer_or_string_extent_list (obj); - - if (!el) - return 0; - return real_extent_at_forward (el, 0, 1); -} -#endif - -static EXTENT -extent_next (EXTENT e) -{ - Extent_List *el = extent_extent_list (e); - int foundp; - int pos = extent_list_locate (el, e, 0, &foundp); - assert (foundp); - return real_extent_at_forward (el, pos+1, 0); -} - -#ifdef DEBUG_XEMACS -static EXTENT -extent_e_next (EXTENT e) -{ - Extent_List *el = extent_extent_list (e); - int foundp; - int pos = extent_list_locate (el, e, 1, &foundp); - assert (foundp); - return real_extent_at_forward (el, pos+1, 1); -} -#endif - -static EXTENT -extent_last (Lisp_Object obj) -{ - Extent_List *el = buffer_or_string_extent_list (obj); - - if (!el) - return 0; - return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0); -} - -#ifdef DEBUG_XEMACS -static EXTENT -extent_e_last (Lisp_Object obj) -{ - Extent_List *el = buffer_or_string_extent_list (obj); - - if (!el) - return 0; - return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1); -} -#endif - -static EXTENT -extent_previous (EXTENT e) -{ - Extent_List *el = extent_extent_list (e); - int foundp; - int pos = extent_list_locate (el, e, 0, &foundp); - assert (foundp); - return real_extent_at_backward (el, pos-1, 0); -} - -#ifdef DEBUG_XEMACS -static EXTENT -extent_e_previous (EXTENT e) -{ - Extent_List *el = extent_extent_list (e); - int foundp; - int pos = extent_list_locate (el, e, 1, &foundp); - assert (foundp); - return real_extent_at_backward (el, pos-1, 1); -} -#endif - -static void -extent_attach (EXTENT extent) -{ - Extent_List *el = extent_extent_list (extent); - - extent_list_insert (el, extent); - soe_insert (extent_object (extent), extent); - /* only this extent changed */ - extent_maybe_changed_for_redisplay (extent, 0, - !NILP (extent_invisible (extent))); -} - -static void -extent_detach (EXTENT extent) -{ - Extent_List *el; - - if (extent_detached_p (extent)) - return; - el = extent_extent_list (extent); - - /* call this before messing with the extent. */ - extent_maybe_changed_for_redisplay (extent, 0, - !NILP (extent_invisible (extent))); - extent_list_delete (el, extent); - soe_delete (extent_object (extent), extent); - set_extent_start (extent, -1); - set_extent_end (extent, -1); -} - -/* ------------------------------- */ -/* map-extents et al. */ -/* ------------------------------- */ - -/* Returns true iff map_extents() would visit the given extent. - See the comments at map_extents() for info on the overlap rule. - Assumes that all validation on the extent and buffer positions has - already been performed (see Fextent_in_region_p ()). - */ -static int -extent_in_region_p (EXTENT extent, Bytind from, Bytind to, - unsigned int flags) -{ - Lisp_Object obj = extent_object (extent); - Endpoint_Index start, end, exs, exe; - int start_open, end_open; - unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK; - unsigned int in_region_flags = flags & ME_IN_REGION_MASK; - int retval; - - /* A zero-length region is treated as closed-closed. */ - if (from == to) - { - flags |= ME_END_CLOSED; - flags &= ~ME_START_OPEN; - } - - /* So is a zero-length extent. */ - if (extent_start (extent) == extent_end (extent)) - start_open = 0, end_open = 0; - /* `all_extents_flags' will almost always be zero. */ - else if (all_extents_flags == 0) - { - start_open = extent_start_open_p (extent); - end_open = extent_end_open_p (extent); - } - else - switch (all_extents_flags) - { - case ME_ALL_EXTENTS_CLOSED: start_open = 0, end_open = 0; break; - case ME_ALL_EXTENTS_OPEN: start_open = 1, end_open = 1; break; - case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break; - case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break; - default: abort(); break; - } - - start = buffer_or_string_bytind_to_startind (obj, from, - flags & ME_START_OPEN); - end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED)); - exs = memind_to_startind (extent_start (extent), start_open); - exe = memind_to_endind (extent_end (extent), end_open); - - /* It's easy to determine whether an extent lies *outside* the - region -- just determine whether it's completely before - or completely after the region. Reject all such extents, so - we're now left with only the extents that overlap the region. - */ - - if (exs > end || exe < start) - return 0; - - /* See if any further restrictions are called for. */ - /* in_region_flags will almost always be zero. */ - if (in_region_flags == 0) - retval = 1; - else - switch (in_region_flags) - { - case ME_START_IN_REGION: - retval = start <= exs && exs <= end; break; - case ME_END_IN_REGION: - retval = start <= exe && exe <= end; break; - case ME_START_AND_END_IN_REGION: - retval = start <= exs && exe <= end; break; - case ME_START_OR_END_IN_REGION: - retval = (start <= exs && exs <= end) || (start <= exe && exe <= end); - break; - default: - abort(); break; - } - return flags & ME_NEGATE_IN_REGION ? !retval : retval; -} - -struct map_extents_struct -{ - Extent_List *el; - Extent_List_Marker *mkr; - EXTENT range; -}; - -static Lisp_Object -map_extents_unwind (Lisp_Object obj) -{ - struct map_extents_struct *closure = - (struct map_extents_struct *) get_opaque_ptr (obj); - free_opaque_ptr (obj); - if (closure->range) - extent_detach (closure->range); - if (closure->mkr) - extent_list_delete_marker (closure->el, closure->mkr); - return Qnil; -} - -/* This is the guts of `map-extents' and the other functions that - map over extents. In theory the operation of this function is - simple: just figure out what extents we're mapping over, and - call the function on each one of them in the range. Unfortunately - there are a wide variety of things that the mapping function - might do, and we have to be very tricky to avoid getting messed - up. Furthermore, this function needs to be very fast (it is - called multiple times every time text is inserted or deleted - from a buffer), and so we can't always afford the overhead of - dealing with all the possible things that the mapping function - might do; thus, there are many flags that can be specified - indicating what the mapping function might or might not do. - - The result of all this is that this is the most complicated - function in this file. Change it at your own risk! - - A potential simplification to the logic below is to determine - all the extents that the mapping function should be called on - before any calls are actually made and save them in an array. - That introduces its own complications, however (the array - needs to be marked for garbage-collection, and a static array - cannot be used because map_extents() needs to be reentrant). - Furthermore, the results might be a little less sensible than - the logic below. */ - - -static void -map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg, - Lisp_Object obj, EXTENT after, unsigned int flags) -{ - Memind st, en; /* range we're mapping over */ - EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */ - Extent_List *el = 0; /* extent list we're iterating over */ - Extent_List_Marker *posm = 0; /* marker for extent list, - if ME_MIGHT_MODIFY_EXTENTS */ - /* count and struct for unwind-protect, if ME_MIGHT_THROW */ - int count = 0; - struct map_extents_struct closure; - -#ifdef ERROR_CHECK_EXTENTS - assert (from <= to); - assert (from >= buffer_or_string_absolute_begin_byte (obj) && - from <= buffer_or_string_absolute_end_byte (obj) && - to >= buffer_or_string_absolute_begin_byte (obj) && - to <= buffer_or_string_absolute_end_byte (obj)); -#endif - - if (after) - { - assert (EQ (obj, extent_object (after))); - assert (!extent_detached_p (after)); - } - - el = buffer_or_string_extent_list (obj); - if (!el || !extent_list_num_els(el)) - return; - el = 0; - - st = buffer_or_string_bytind_to_memind (obj, from); - en = buffer_or_string_bytind_to_memind (obj, to); - - if (flags & ME_MIGHT_MODIFY_TEXT) - { - /* The mapping function might change the text in the buffer, - so make an internal extent to hold the range we're mapping - over. */ - range = make_extent_detached (obj); - set_extent_start (range, st); - set_extent_end (range, en); - range->flags.start_open = flags & ME_START_OPEN; - range->flags.end_open = !(flags & ME_END_CLOSED); - range->flags.internal = 1; - range->flags.detachable = 0; - extent_attach (range); - } - - if (flags & ME_MIGHT_THROW) - { - /* The mapping function might throw past us so we need to use an - unwind_protect() to eliminate the internal extent and range - that we use. */ - count = specpdl_depth (); - closure.range = range; - closure.mkr = 0; - record_unwind_protect (map_extents_unwind, - make_opaque_ptr (&closure)); - } - - /* ---------- Figure out where we start and what direction - we move in. This is the trickiest part of this - function. ---------- */ - - /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION - was specified and ME_NEGATE_IN_REGION was not specified, our job - is simple because of the presence of the display order and e-order. - (Note that theoretically do something similar for - ME_START_OR_END_IN_REGION, but that would require more trickiness - than it's worth to avoid hitting the same extent twice.) - - In the general case, all the extents that overlap a range can be - divided into two classes: those whose start position lies within - the range (including the range's end but not including the - range's start), and those that overlap the start position, - i.e. those in the SOE for the start position. Or equivalently, - the extents can be divided into those whose end position lies - within the range and those in the SOE for the end position. Note - that for this purpose we treat both the range and all extents in - the buffer as closed on both ends. If this is not what the ME_ - flags specified, then we've mapped over a few too many extents, - but no big deal because extent_in_region_p() will filter them - out. Ideally, we could move the SOE to the closer of the range's - two ends and work forwards or backwards from there. However, in - order to make the semantics of the AFTER argument work out, we - have to always go in the same direction; so we choose to always - move the SOE to the start position. - - When it comes time to do the SOE stage, we first call soe_move() - so that the SOE gets set up. Note that the SOE might get - changed while we are mapping over its contents. If we can - guarantee that the SOE won't get moved to a new position, we - simply need to put a marker in the SOE and we will track deletions - and insertions of extents in the SOE. If the SOE might get moved, - however (this would happen as a result of a recursive invocation - of map-extents or a call to a redisplay-type function), then - trying to track its changes is hopeless, so we just keep a - marker to the first (or last) extent in the SOE and use that as - our bound. - - Finally, if DONT_USE_SOE is defined, we don't use the SOE at all - and instead just map from the beginning of the buffer. This is - used for testing purposes and allows the SOE to be calculated - using map_extents() instead of the other way around. */ - - { - int range_flag; /* ME_*_IN_REGION subset of flags */ - int do_soe_stage = 0; /* Are we mapping over the SOE? */ - /* Does the range stage map over start or end positions? */ - int range_endp; - /* If type == 0, we include the start position in the range stage mapping. - If type == 1, we exclude the start position in the range stage mapping. - If type == 2, we begin at range_start_pos, an extent-list position. - */ - int range_start_type = 0; - int range_start_pos = 0; - int stage; - - range_flag = flags & ME_IN_REGION_MASK; - if ((range_flag == ME_START_IN_REGION || - range_flag == ME_START_AND_END_IN_REGION) && - !(flags & ME_NEGATE_IN_REGION)) - { - /* map over start position in [range-start, range-end]. No SOE - stage. */ - range_endp = 0; - } - else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION)) - { - /* map over end position in [range-start, range-end]. No SOE - stage. */ - range_endp = 1; - } - else - { - /* Need to include the SOE extents. */ -#ifdef DONT_USE_SOE - /* Just brute-force it: start from the beginning. */ - range_endp = 0; - range_start_type = 2; - range_start_pos = 0; -#else - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj); - int numsoe; - - /* Move the SOE to the closer end of the range. This dictates - whether we map over start positions or end positions. */ - range_endp = 0; - soe_move (obj, st); - numsoe = extent_list_num_els (soe->extents); - if (numsoe) - { - if (flags & ME_MIGHT_MOVE_SOE) - { - int foundp; - /* Can't map over SOE, so just extend range to cover the - SOE. */ - EXTENT e = extent_list_at (soe->extents, 0, 0); - range_start_pos = - extent_list_locate (buffer_or_string_extent_list (obj), e, 0, - &foundp); - assert (foundp); - range_start_type = 2; - } - else - { - /* We can map over the SOE. */ - do_soe_stage = 1; - range_start_type = 1; - } - } - else - { - /* No extents in the SOE to map over, so we act just as if - ME_START_IN_REGION or ME_END_IN_REGION was specified. - RANGE_ENDP already specified so no need to do anything else. */ - } - } -#endif - - /* ---------- Now loop over the extents. ---------- */ - - /* We combine the code for the two stages because much of it - overlaps. */ - for (stage = 0; stage < 2; stage++) - { - int pos = 0; /* Position in extent list */ - - /* First set up start conditions */ - if (stage == 0) - { /* The SOE stage */ - if (!do_soe_stage) - continue; - el = buffer_or_string_stack_of_extents_force (obj)->extents; - /* We will always be looping over start extents here. */ - assert (!range_endp); - pos = 0; - } - else - { /* The range stage */ - el = buffer_or_string_extent_list (obj); - switch (range_start_type) - { - case 0: - pos = extent_list_locate_from_pos (el, st, range_endp); - break; - case 1: - pos = extent_list_locate_from_pos (el, st + 1, range_endp); - break; - case 2: - pos = range_start_pos; - break; - } - } - - if (flags & ME_MIGHT_MODIFY_EXTENTS) - { - /* Create a marker to track changes to the extent list */ - if (posm) - /* Delete the marker used in the SOE stage. */ - extent_list_delete_marker - (buffer_or_string_stack_of_extents_force (obj)->extents, posm); - posm = extent_list_make_marker (el, pos, range_endp); - /* tell the unwind function about the marker. */ - closure.el = el; - closure.mkr = posm; - } - - /* Now loop! */ - for (;;) - { - EXTENT e; - Lisp_Object obj2; - - /* ----- update position in extent list - and fetch next extent ----- */ - - if (posm) - /* fetch POS again to track extent insertions or deletions */ - pos = extent_list_marker_pos (el, posm); - if (pos >= extent_list_num_els (el)) - break; - e = extent_list_at (el, pos, range_endp); - pos++; - if (posm) - /* now point the marker to the next one we're going to process. - This ensures graceful behavior if this extent is deleted. */ - extent_list_move_marker (el, posm, pos); - - /* ----- deal with internal extents ----- */ - - if (extent_internal_p (e)) - { - if (!(flags & ME_INCLUDE_INTERNAL)) - continue; - else if (e == range) - { - /* We're processing internal extents and we've - come across our own special range extent. - (This happens only in adjust_extents*() and - process_extents*(), which handle text - insertion and deletion.) We need to omit - processing of this extent; otherwise - we will probably end up prematurely - terminating this loop. */ - continue; - } - } - - /* ----- deal with AFTER condition ----- */ - - if (after) - { - /* if e > after, then we can stop skipping extents. */ - if (EXTENT_LESS (after, e)) - after = 0; - else /* otherwise, skip this extent. */ - continue; - } - - /* ----- stop if we're completely outside the range ----- */ - - /* fetch ST and EN again to track text insertions or deletions */ - if (range) - { - st = extent_start (range); - en = extent_end (range); - } - if (extent_endpoint (e, range_endp) > en) - { - /* Can't be mapping over SOE because all extents in - there should overlap ST */ - assert (stage == 1); - break; - } - - /* ----- Now actually call the function ----- */ - - obj2 = extent_object (e); - if (extent_in_region_p (e, - buffer_or_string_memind_to_bytind (obj2, - st), - buffer_or_string_memind_to_bytind (obj2, - en), - flags)) - { - if ((*fn)(e, arg)) - { - /* Function wants us to stop mapping. */ - stage = 1; /* so outer for loop will terminate */ - break; - } - } - } - } - /* ---------- Finished looping. ---------- */ - } - - if (flags & ME_MIGHT_THROW) - /* This deletes the range extent and frees the marker. */ - unbind_to (count, Qnil); - else - { - /* Delete them ourselves */ - if (range) - extent_detach (range); - if (posm) - extent_list_delete_marker (el, posm); - } -} - -void -map_extents (Bufpos from, Bufpos to, map_extents_fun fn, - void *arg, Lisp_Object obj, EXTENT after, unsigned int flags) -{ - map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from), - buffer_or_string_bufpos_to_bytind (obj, to), fn, arg, - obj, after, flags); -} - -/* ------------------------------- */ -/* adjust_extents() */ -/* ------------------------------- */ - -/* Add AMOUNT to all extent endpoints in the range (FROM, TO]. This - happens whenever the gap is moved or (under Mule) a character in a - string is substituted for a different-length one. The reason for - this is that extent endpoints behave just like markers (all memory - indices do) and this adjustment correct for markers -- see - adjust_markers(). Note that it is important that we visit all - extent endpoints in the range, irrespective of whether the - endpoints are open or closed. - - We could use map_extents() for this (and in fact the function - was originally written that way), but the gap is in an incoherent - state when this function is called and this function plays - around with extent endpoints without detaching and reattaching - the extents (this is provably correct and saves lots of time), - so for safety we make it just look at the extent lists directly. */ - -void -adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount) -{ - int endp; - int pos; - int startpos[2]; - Extent_List *el; - Stack_Of_Extents *soe; - -#ifdef ERROR_CHECK_EXTENTS - sledgehammer_extent_check (obj); -#endif - el = buffer_or_string_extent_list (obj); - - if (!el || !extent_list_num_els(el)) - return; - - /* IMPORTANT! Compute the starting positions of the extents to - modify BEFORE doing any modification! Otherwise the starting - position for the second time through the loop might get - incorrectly calculated (I got bit by this bug real bad). */ - startpos[0] = extent_list_locate_from_pos (el, from+1, 0); - startpos[1] = extent_list_locate_from_pos (el, from+1, 1); - for (endp = 0; endp < 2; endp++) - { - for (pos = startpos[endp]; pos < extent_list_num_els (el); - pos++) - { - EXTENT e = extent_list_at (el, pos, endp); - if (extent_endpoint (e, endp) > to) - break; - set_extent_endpoint (e, - do_marker_adjustment (extent_endpoint (e, endp), - from, to, amount), - endp); - } - } - - /* The index for the buffer's SOE is a memory index and thus - needs to be adjusted like a marker. */ - soe = buffer_or_string_stack_of_extents (obj); - if (soe && soe->pos >= 0) - soe->pos = do_marker_adjustment (soe->pos, from, to, amount); -} - -/* ------------------------------- */ -/* adjust_extents_for_deletion() */ -/* ------------------------------- */ - -struct adjust_extents_for_deletion_arg -{ - EXTENT_dynarr *list; -}; - -static int -adjust_extents_for_deletion_mapper (EXTENT extent, void *arg) -{ - struct adjust_extents_for_deletion_arg *closure = - (struct adjust_extents_for_deletion_arg *) arg; - - Dynarr_add (closure->list, extent); - return 0; /* continue mapping */ -} - -/* For all extent endpoints in the range (FROM, TO], move them to the beginning - of the new gap. Note that it is important that we visit all extent - endpoints in the range, irrespective of whether the endpoints are open or - closed. - - This function deals with weird stuff such as the fact that extents - may get reordered. - - There is no string correspondent for this because you can't - delete characters from a string. - */ - -void -adjust_extents_for_deletion (Lisp_Object object, Bytind from, - Bytind to, int gapsize, int numdel, - int movegapsize) -{ - struct adjust_extents_for_deletion_arg closure; - int i; - Memind adjust_to = (Memind) (to + gapsize); - Bytecount amount = - numdel - movegapsize; - Memind oldsoe = 0, newsoe = 0; - Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object); - -#ifdef ERROR_CHECK_EXTENTS - sledgehammer_extent_check (object); -#endif - closure.list = Dynarr_new (EXTENT); - - /* We're going to be playing weird games below with extents and the SOE - and such, so compute the list now of all the extents that we're going - to muck with. If we do the mapping and adjusting together, things can - get all screwed up. */ - - map_extents_bytind (from, to, adjust_extents_for_deletion_mapper, - (void *) &closure, object, 0, - /* extent endpoints move like markers regardless - of their open/closeness. */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL); - - /* - Old and new values for the SOE's position. (It gets adjusted - like a marker, just like extent endpoints.) - */ - - if (soe) - { - oldsoe = soe->pos; - if (soe->pos >= 0) - newsoe = do_marker_adjustment (soe->pos, - adjust_to, adjust_to, - amount); - else - newsoe = soe->pos; - } - - for (i = 0; i < Dynarr_length (closure.list); i++) - { - EXTENT extent = Dynarr_at (closure.list, i); - Memind new_start = extent_start (extent); - Memind new_end = extent_end (extent); - - /* do_marker_adjustment() will not adjust values that should not be - adjusted. We're passing the same funky arguments to - do_marker_adjustment() as buffer_delete_range() does. */ - new_start = - do_marker_adjustment (new_start, - adjust_to, adjust_to, - amount); - new_end = - do_marker_adjustment (new_end, - adjust_to, adjust_to, - amount); - - /* We need to be very careful here so that the SOE doesn't get - corrupted. We are shrinking extents out of the deleted region - and simultaneously moving the SOE's pos out of the deleted - region, so the SOE should contain the same extents at the end - as at the beginning. However, extents may get reordered - by this process, so we have to operate by pulling the extents - out of the buffer and SOE, changing their bounds, and then - reinserting them. In order for the SOE not to get screwed up, - we have to make sure that the SOE's pos points to its old - location whenever we pull an extent out, and points to its - new location whenever we put the extent back in. - */ - - if (new_start != extent_start (extent) || - new_end != extent_end (extent)) - { - extent_detach (extent); - set_extent_start (extent, new_start); - set_extent_end (extent, new_end); - if (soe) - soe->pos = newsoe; - extent_attach (extent); - if (soe) - soe->pos = oldsoe; - } - } - - if (soe) - soe->pos = newsoe; - -#ifdef ERROR_CHECK_EXTENTS - sledgehammer_extent_check (object); -#endif - Dynarr_free (closure.list); -} - -/* ------------------------------- */ -/* extent fragments */ -/* ------------------------------- */ - -/* Imagine that the buffer is divided up into contiguous, - nonoverlapping "runs" of text such that no extent - starts or ends within a run (extents that abut the - run don't count). - - An extent fragment is a structure that holds data about - the run that contains a particular buffer position (if - the buffer position is at the junction of two runs, the - run after the position is used) -- the beginning and - end of the run, a list of all of the extents in that - run, the "merged face" that results from merging all of - the faces corresponding to those extents, the begin and - end glyphs at the beginning of the run, etc. This is - the information that redisplay needs in order to - display this run. - - Extent fragments have to be very quick to update to - a new buffer position when moving linearly through - the buffer. They rely on the stack-of-extents code, - which does the heavy-duty algorithmic work of determining - which extents overly a particular position. */ - -/* This function returns the position of the beginning of - the first run that begins after POS, or returns POS if - there are no such runs. */ - -static Bytind -extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible) -{ - Extent_List *sel; - Extent_List *bel = buffer_or_string_extent_list (obj); - Bytind pos1, pos2; - int elind1, elind2; - Memind mempos = buffer_or_string_bytind_to_memind (obj, pos); - Bytind limit = outside_accessible ? - buffer_or_string_absolute_end_byte (obj) : - buffer_or_string_accessible_end_byte (obj); - - if (!bel || !extent_list_num_els(bel)) - return limit; - - sel = buffer_or_string_stack_of_extents_force (obj)->extents; - soe_move (obj, mempos); - - /* Find the first start position after POS. */ - elind1 = extent_list_locate_from_pos (bel, mempos+1, 0); - if (elind1 < extent_list_num_els (bel)) - pos1 = buffer_or_string_memind_to_bytind - (obj, extent_start (extent_list_at (bel, elind1, 0))); - else - pos1 = limit; - - /* Find the first end position after POS. The extent corresponding - to this position is either in the SOE or is greater than or - equal to POS1, so we just have to look in the SOE. */ - elind2 = extent_list_locate_from_pos (sel, mempos+1, 1); - if (elind2 < extent_list_num_els (sel)) - pos2 = buffer_or_string_memind_to_bytind - (obj, extent_end (extent_list_at (sel, elind2, 1))); - else - pos2 = limit; - - return min (min (pos1, pos2), limit); -} - -static Bytind -extent_find_beginning_of_run (Lisp_Object obj, Bytind pos, - int outside_accessible) -{ - Extent_List *sel; - Extent_List *bel = buffer_or_string_extent_list (obj); - Bytind pos1, pos2; - int elind1, elind2; - Memind mempos = buffer_or_string_bytind_to_memind (obj, pos); - Bytind limit = outside_accessible ? - buffer_or_string_absolute_begin_byte (obj) : - buffer_or_string_accessible_begin_byte (obj); - - if (!bel || !extent_list_num_els(bel)) - return limit; - - sel = buffer_or_string_stack_of_extents_force (obj)->extents; - soe_move (obj, mempos); - - /* Find the first end position before POS. */ - elind1 = extent_list_locate_from_pos (bel, mempos, 1); - if (elind1 > 0) - pos1 = buffer_or_string_memind_to_bytind - (obj, extent_end (extent_list_at (bel, elind1 - 1, 1))); - else - pos1 = limit; - - /* Find the first start position before POS. The extent corresponding - to this position is either in the SOE or is less than or - equal to POS1, so we just have to look in the SOE. */ - elind2 = extent_list_locate_from_pos (sel, mempos, 0); - if (elind2 > 0) - pos2 = buffer_or_string_memind_to_bytind - (obj, extent_start (extent_list_at (sel, elind2 - 1, 0))); - else - pos2 = limit; - - return max (max (pos1, pos2), limit); -} - -struct extent_fragment * -extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm) -{ - struct extent_fragment *ef = xnew_and_zero (struct extent_fragment); - - ef->object = buffer_or_string; - ef->frm = frm; - ef->extents = Dynarr_new (EXTENT); - ef->begin_glyphs = Dynarr_new (glyph_block); - ef->end_glyphs = Dynarr_new (glyph_block); - - return ef; -} - -void -extent_fragment_delete (struct extent_fragment *ef) -{ - Dynarr_free (ef->extents); - Dynarr_free (ef->begin_glyphs); - Dynarr_free (ef->end_glyphs); - xfree (ef); -} - -/* Note: CONST is losing, but `const' is part of the interface of qsort() */ -static int -extent_priority_sort_function (const void *humpty, const void *dumpty) -{ - CONST EXTENT foo = * (CONST EXTENT *) humpty; - CONST EXTENT bar = * (CONST EXTENT *) dumpty; - if (extent_priority (foo) < extent_priority (bar)) - return -1; - return extent_priority (foo) > extent_priority (bar); -} - -static void -extent_fragment_sort_by_priority (EXTENT_dynarr *extarr) -{ - int i; - - /* Sort our copy of the stack by extent_priority. We use a bubble - sort here because it's going to be faster than qsort() for small - numbers of extents (less than 10 or so), and 99.999% of the time - there won't ever be more extents than this in the stack. */ - if (Dynarr_length (extarr) < 10) - { - for (i = 1; i < Dynarr_length (extarr); i++) - { - int j = i - 1; - while (j >= 0 && - (extent_priority (Dynarr_at (extarr, j)) > - extent_priority (Dynarr_at (extarr, j+1)))) - { - EXTENT tmp = Dynarr_at (extarr, j); - Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1); - Dynarr_at (extarr, j+1) = tmp; - j--; - } - } - } - else - /* But some loser programs mess up and may create a large number - of extents overlapping the same spot. This will result in - catastrophic behavior if we use the bubble sort above. */ - qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr), - sizeof (EXTENT), extent_priority_sort_function); -} - -/* If PROP is the `invisible' property of an extent, - this is 1 if the extent should be treated as invisible. */ - -#define EXTENT_PROP_MEANS_INVISIBLE(buf, prop) \ - (EQ (buf->invisibility_spec, Qt) \ - ? ! NILP (prop) \ - : invisible_p (prop, buf->invisibility_spec)) - -/* If PROP is the `invisible' property of a extent, - this is 1 if the extent should be treated as invisible - and should have an ellipsis. */ - -#define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop) \ - (EQ (buf->invisibility_spec, Qt) \ - ? 0 \ - : invisible_ellipsis_p (prop, buf->invisibility_spec)) - -/* This is like a combination of memq and assq. - Return 1 if PROPVAL appears as an element of LIST - or as the car of an element of LIST. - If PROPVAL is a list, compare each element against LIST - in that way, and return 1 if any element of PROPVAL is found in LIST. - Otherwise return 0. - This function cannot quit. */ - -static int -invisible_p (REGISTER Lisp_Object propval, Lisp_Object list) -{ - REGISTER Lisp_Object tail, proptail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - REGISTER Lisp_Object tem; - tem = XCAR (tail); - if (EQ (propval, tem)) - return 1; - if (CONSP (tem) && EQ (propval, XCAR (tem))) - return 1; - } - if (CONSP (propval)) - for (proptail = propval; CONSP (proptail); - proptail = XCDR (proptail)) - { - Lisp_Object propelt; - propelt = XCAR (proptail); - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - REGISTER Lisp_Object tem; - tem = XCAR (tail); - if (EQ (propelt, tem)) - return 1; - if (CONSP (tem) && EQ (propelt, XCAR (tem))) - return 1; - } - } - return 0; -} - -/* Return 1 if PROPVAL appears as the car of an element of LIST - and the cdr of that element is non-nil. - If PROPVAL is a list, check each element of PROPVAL in that way, - and the first time some element is found, - return 1 if the cdr of that element is non-nil. - Otherwise return 0. - This function cannot quit. */ - -static int -invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list) -{ - REGISTER Lisp_Object tail, proptail; - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - REGISTER Lisp_Object tem; - tem = XCAR (tail); - if (CONSP (tem) && EQ (propval, XCAR (tem))) - return ! NILP (XCDR (tem)); - } - if (CONSP (propval)) - for (proptail = propval; CONSP (proptail); - proptail = XCDR (proptail)) - { - Lisp_Object propelt; - propelt = XCAR (proptail); - for (tail = list; CONSP (tail); tail = XCDR (tail)) - { - REGISTER Lisp_Object tem; - tem = XCAR (tail); - if (CONSP (tem) && EQ (propelt, XCAR (tem))) - return ! NILP (XCDR (tem)); - } - } - return 0; -} - -face_index -extent_fragment_update (struct window *w, struct extent_fragment *ef, - Bytind pos) -{ - int i; - Extent_List *sel = - buffer_or_string_stack_of_extents_force (ef->object)->extents; - EXTENT lhe = 0; - struct extent dummy_lhe_extent; - Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos); - -#ifdef ERROR_CHECK_EXTENTS - assert (pos >= buffer_or_string_accessible_begin_byte (ef->object) - && pos <= buffer_or_string_accessible_end_byte (ef->object)); -#endif - - Dynarr_reset (ef->extents); - Dynarr_reset (ef->begin_glyphs); - Dynarr_reset (ef->end_glyphs); - - ef->previously_invisible = ef->invisible; - if (ef->invisible) - { - if (ef->invisible_ellipses) - ef->invisible_ellipses_already_displayed = 1; - } - else - ef->invisible_ellipses_already_displayed = 0; - ef->invisible = 0; - ef->invisible_ellipses = 0; - - /* Set up the begin and end positions. */ - ef->pos = pos; - ef->end = extent_find_end_of_run (ef->object, pos, 0); - - /* Note that extent_find_end_of_run() already moved the SOE for us. */ - /* soe_move (ef->object, mempos); */ - - /* Determine the begin glyphs at POS. */ - for (i = 0; i < extent_list_num_els (sel); i++) - { - EXTENT e = extent_list_at (sel, i, 0); - if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e))) - { - Lisp_Object glyph = extent_begin_glyph (e); - struct glyph_block gb; - - gb.glyph = glyph; - XSETEXTENT (gb.extent, e); - Dynarr_add (ef->begin_glyphs, gb); - } - } - - /* Determine the end glyphs at POS. */ - for (i = 0; i < extent_list_num_els (sel); i++) - { - EXTENT e = extent_list_at (sel, i, 1); - if (extent_end (e) == mempos && !NILP (extent_end_glyph (e))) - { - Lisp_Object glyph = extent_end_glyph (e); - struct glyph_block gb; - - gb.glyph = glyph; - XSETEXTENT (gb.extent, e); - Dynarr_add (ef->end_glyphs, gb); - } - } - - /* We tried determining all the charsets used in the run here, - but that fails even if we only do the current line -- display - tables or non-printable characters might cause other charsets - to be used. */ - - /* Determine whether the last-highlighted-extent is present. */ - if (EXTENTP (Vlast_highlighted_extent)) - lhe = XEXTENT (Vlast_highlighted_extent); - - /* Now add all extents that overlap the character after POS and - have a non-nil face. Also check if the character is invisible. */ - for (i = 0; i < extent_list_num_els (sel); i++) - { - EXTENT e = extent_list_at (sel, i, 0); - if (extent_end (e) > mempos) - { - Lisp_Object invis_prop = extent_invisible (e); - - if (!NILP (invis_prop)) - { - if (!BUFFERP (ef->object)) - /* #### no `string-invisibility-spec' */ - ef->invisible = 1; - else - { - if (!ef->invisible_ellipses_already_displayed && - EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS - (XBUFFER (ef->object), invis_prop)) - { - ef->invisible = 1; - ef->invisible_ellipses = 1; - } - else if (EXTENT_PROP_MEANS_INVISIBLE - (XBUFFER (ef->object), invis_prop)) - ef->invisible = 1; - } - } - - /* Remember that one of the extents in the list might be our - dummy extent representing the highlighting that is - attached to some other extent that is currently - mouse-highlighted. When an extent is mouse-highlighted, - it is as if there are two extents there, of potentially - different priorities: the extent being highlighted, with - whatever face and priority it has; and an ephemeral - extent in the `mouse-face' face with - `mouse-highlight-priority'. - */ - - if (!NILP (extent_face (e))) - Dynarr_add (ef->extents, e); - if (e == lhe) - { - Lisp_Object f; - /* zeroing isn't really necessary; we only deref `priority' - and `face' */ - xzero (dummy_lhe_extent); - set_extent_priority (&dummy_lhe_extent, - mouse_highlight_priority); - /* Need to break up the following expression, due to an */ - /* error in the Digital UNIX 3.2g C compiler (Digital */ - /* UNIX Compiler Driver 3.11). */ - f = extent_mouse_face (lhe); - extent_face (&dummy_lhe_extent) = f; - Dynarr_add (ef->extents, &dummy_lhe_extent); - } - /* since we are looping anyway, we might as well do this here */ - if ((!NILP(extent_initial_redisplay_function (e))) && - !extent_in_red_event_p(e)) - { - Lisp_Object function = extent_initial_redisplay_function (e); - Lisp_Object obj; - - /* printf ("initial redisplay function called!\n "); */ - - /* print_extent_2 (e); - printf ("\n"); */ - - /* FIXME: One should probably inhibit the displaying of - this extent to reduce flicker */ - extent_in_red_event_p(e) = 1; - - /* call the function */ - XSETEXTENT(obj,e); - if(!NILP(function)) - Fenqueue_eval_event(function,obj); - } - } - } - - extent_fragment_sort_by_priority (ef->extents); - - /* Now merge the faces together into a single face. The code to - do this is in faces.c because it involves manipulating faces. */ - return get_extent_fragment_face_cache_index (w, ef); -} - - -/************************************************************************/ -/* extent-object methods */ -/************************************************************************/ - -/* These are the basic helper functions for handling the allocation of - extent objects. They are similar to the functions for other - lrecord objects. allocate_extent() is in alloc.c, not here. */ - -static Lisp_Object mark_extent (Lisp_Object, void (*) (Lisp_Object)); -static int extent_equal (Lisp_Object, Lisp_Object, int depth); -static unsigned long extent_hash (Lisp_Object obj, int depth); -static void print_extent (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag); -static Lisp_Object extent_getprop (Lisp_Object obj, Lisp_Object prop); -static int extent_putprop (Lisp_Object obj, Lisp_Object prop, - Lisp_Object value); -static int extent_remprop (Lisp_Object obj, Lisp_Object prop); -static Lisp_Object extent_plist (Lisp_Object obj); - -DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent, - mark_extent, - print_extent, - /* NOTE: If you declare a - finalization method here, - it will NOT be called. - Shaft city. */ - 0, - extent_equal, extent_hash, - extent_getprop, extent_putprop, - extent_remprop, extent_plist, - struct extent); - -static Lisp_Object -mark_extent (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct extent *extent = XEXTENT (obj); - - markobj (extent_object (extent)); - markobj (extent_no_chase_normal_field (extent, face)); - return extent->plist; -} - -static void -print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - EXTENT ext = XEXTENT (obj); - EXTENT anc = extent_ancestor (ext); - Lisp_Object tail; - char buf[64], *bp = buf; - - /* Retrieve the ancestor and use it, for faster retrieval of properties */ - - if (!NILP (extent_begin_glyph (anc))) *bp++ = '*'; - *bp++ = (extent_start_open_p (anc) ? '(': '['); - if (extent_detached_p (ext)) - strcpy (bp, "detached"); - else - { - Bufpos from = XINT (Fextent_start_position (obj)); - Bufpos to = XINT (Fextent_end_position (obj)); - sprintf (bp, "%d, %d", from, to); - } - bp += strlen (bp); - *bp++ = (extent_end_open_p (anc) ? ')': ']'); - if (!NILP (extent_end_glyph (anc))) *bp++ = '*'; - *bp++ = ' '; - - if (!NILP (extent_read_only (anc))) *bp++ = '%'; - if (!NILP (extent_mouse_face (anc))) *bp++ = 'H'; - if (extent_unique_p (anc)) *bp++ = 'U'; - else if (extent_duplicable_p (anc)) *bp++ = 'D'; - if (!NILP (extent_invisible (anc))) *bp++ = 'I'; - - if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) || - extent_unique_p (anc) || - extent_duplicable_p (anc) || !NILP (extent_invisible (anc))) - *bp++ = ' '; - *bp = '\0'; - write_c_string (buf, printcharfun); - - tail = extent_plist_slot (anc); - - for (; !NILP (tail); tail = Fcdr (Fcdr (tail))) - { - Lisp_Object v = XCAR (XCDR (tail)); - if (NILP (v)) continue; - print_internal (XCAR (tail), printcharfun, escapeflag); - write_c_string (" ", printcharfun); - } - - sprintf (buf, "0x%lx", (long) ext); - write_c_string (buf, printcharfun); -} - -static void -print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - if (escapeflag) - { - CONST char *title = ""; - CONST char *name = ""; - CONST char *posttitle = ""; - Lisp_Object obj2 = Qnil; - - /* Destroyed extents have 't' in the object field, causing - extent_object() to abort (maybe). */ - if (EXTENT_LIVE_P (XEXTENT (obj))) - obj2 = extent_object (XEXTENT (obj)); - - if (NILP (obj2)) - title = "no buffer"; - else if (BUFFERP (obj2)) - { - if (BUFFER_LIVE_P (XBUFFER (obj2))) - { - title = "buffer "; - name = (char *) XSTRING_DATA (XBUFFER (obj2)->name); - } - else - { - title = "Killed Buffer"; - name = ""; - } - } - else - { - assert (STRINGP (obj2)); - title = "string \""; - posttitle = "\""; - name = (char *) XSTRING_DATA (obj2); - } - - if (print_readably) - { - if (!EXTENT_LIVE_P (XEXTENT (obj))) - error ("printing unreadable object #"); - else - error ("printing unreadable object #", - (long) XEXTENT (obj)); - } - - if (!EXTENT_LIVE_P (XEXTENT (obj))) - write_c_string ("#"); - write_c_string ("#", printcharfun); -} - -static int -properties_equal (EXTENT e1, EXTENT e2, int depth) -{ - /* When this function is called, all indirections have been followed. - Thus, the indirection checks in the various macros below will not - amount to anything, and could be removed. However, the time - savings would probably not be significant. */ - if (!(EQ (extent_face (e1), extent_face (e2)) && - extent_priority (e1) == extent_priority (e2) && - internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2), - depth + 1) && - internal_equal (extent_end_glyph (e1), extent_end_glyph (e2), - depth + 1))) - return 0; - - /* compare the bit flags. */ - { - /* The has_aux field should not be relevant. */ - int e1_has_aux = e1->flags.has_aux; - int e2_has_aux = e2->flags.has_aux; - int value; - - e1->flags.has_aux = e2->flags.has_aux = 0; - value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags)); - e1->flags.has_aux = e1_has_aux; - e2->flags.has_aux = e2_has_aux; - if (value) - return 0; - } - - /* compare the random elements of the plists. */ - return !plists_differ (extent_no_chase_plist (e1), - extent_no_chase_plist (e2), - 0, 0, depth + 1); -} - -static int -extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct extent *e1 = XEXTENT (obj1); - struct extent *e2 = XEXTENT (obj2); - return - (extent_start (e1) == extent_start (e2) && - extent_end (e1) == extent_end (e2) && - internal_equal (extent_object (e1), extent_object (e2), depth + 1) && - properties_equal (extent_ancestor (e1), extent_ancestor (e2), - depth)); -} - -static unsigned long -extent_hash (Lisp_Object obj, int depth) -{ - struct extent *e = XEXTENT (obj); - /* No need to hash all of the elements; that would take too long. - Just hash the most common ones. */ - return HASH3 (extent_start (e), extent_end (e), - internal_hash (extent_object (e), depth + 1)); -} - -static Lisp_Object -extent_getprop (Lisp_Object obj, Lisp_Object prop) -{ - return Fextent_property (obj, prop, Qunbound); -} - -static int -extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) -{ - Fset_extent_property (obj, prop, value); - return 1; -} - -static int -extent_remprop (Lisp_Object obj, Lisp_Object prop) -{ - EXTENT ext = XEXTENT (obj); - - /* This list is taken from Fset_extent_property, and should be kept - in synch. */ - if (EQ (prop, Qread_only) - || EQ (prop, Qunique) - || EQ (prop, Qduplicable) - || EQ (prop, Qinvisible) - || EQ (prop, Qdetachable) - || EQ (prop, Qdetached) - || EQ (prop, Qdestroyed) - || EQ (prop, Qpriority) - || EQ (prop, Qface) - || EQ (prop, Qinitial_redisplay_function) - || EQ (prop, Qafter_change_functions) - || EQ (prop, Qbefore_change_functions) - || EQ (prop, Qmouse_face) - || EQ (prop, Qhighlight) - || EQ (prop, Qbegin_glyph_layout) - || EQ (prop, Qend_glyph_layout) - || EQ (prop, Qglyph_layout) - || EQ (prop, Qbegin_glyph) - || EQ (prop, Qend_glyph) - || EQ (prop, Qstart_open) - || EQ (prop, Qend_open) - || EQ (prop, Qstart_closed) - || EQ (prop, Qend_closed) - || EQ (prop, Qkeymap)) - { - /* #### Is this correct, anyway? */ - return -1; - } - - return external_remprop (&ext->plist, prop, 0, ERROR_ME); -} - -static Lisp_Object -extent_plist (Lisp_Object obj) -{ - return Fextent_properties (obj); -} - - -/************************************************************************/ -/* basic extent accessors */ -/************************************************************************/ - -/* These functions are for checking externally-passed extent objects - and returning an extent's basic properties, which include the - buffer the extent is associated with, the endpoints of the extent's - range, the open/closed-ness of those endpoints, and whether the - extent is detached. Manipulating these properties requires - manipulating the ordered lists that hold extents; thus, functions - to do that are in a later section. */ - -/* Given a Lisp_Object that is supposed to be an extent, make sure it - is OK and return an extent pointer. Extents can be in one of four - states: - - 1) destroyed - 2) detached and not associated with a buffer - 3) detached and associated with a buffer - 4) attached to a buffer - - If FLAGS is 0, types 2-4 are allowed. If FLAGS is DE_MUST_HAVE_BUFFER, - types 3-4 are allowed. If FLAGS is DE_MUST_BE_ATTACHED, only type 4 - is allowed. - */ - -static EXTENT -decode_extent (Lisp_Object extent_obj, unsigned int flags) -{ - EXTENT extent; - Lisp_Object obj; - - CHECK_LIVE_EXTENT (extent_obj); - extent = XEXTENT (extent_obj); - obj = extent_object (extent); - - /* the following condition will fail if we're dealing with a freed extent */ - assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj)); - - if (flags & DE_MUST_BE_ATTACHED) - flags |= DE_MUST_HAVE_BUFFER; - - /* if buffer is dead, then convert extent to have no buffer. */ - if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) - obj = extent_object (extent) = Qnil; - - assert (!NILP (obj) || extent_detached_p (extent)); - - if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER)) - || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED))) - { - signal_simple_error ("extent doesn't belong to a buffer or string", - extent_obj); - } - - return extent; -} - -/* Note that the returned value is a buffer position, not a byte index. */ - -static Lisp_Object -extent_endpoint_external (Lisp_Object extent_obj, int endp) -{ - EXTENT extent = decode_extent (extent_obj, 0); - - if (extent_detached_p (extent)) - return Qnil; - else - return make_int (extent_endpoint_bufpos (extent, endp)); -} - -DEFUN ("extentp", Fextentp, 1, 1, 0, /* -Return t if OBJECT is an extent. -*/ - (object)) -{ - return EXTENTP (object) ? Qt : Qnil; -} - -DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /* -Return t if OBJECT is an extent that has not been destroyed. -*/ - (object)) -{ - return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil; -} - -DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /* -Return t if EXTENT is detached. -*/ - (extent)) -{ - return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil; -} - -DEFUN ("extent-object", Fextent_object, 1, 1, 0, /* -Return object (buffer or string) that EXTENT refers to. -*/ - (extent)) -{ - return extent_object (decode_extent (extent, 0)); -} - -DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /* -Return start position of EXTENT, or nil if EXTENT is detached. -*/ - (extent)) -{ - return extent_endpoint_external (extent, 0); -} - -DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /* -Return end position of EXTENT, or nil if EXTENT is detached. -*/ - (extent)) -{ - return extent_endpoint_external (extent, 1); -} - -DEFUN ("extent-length", Fextent_length, 1, 1, 0, /* -Return length of EXTENT in characters. -*/ - (extent)) -{ - EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED); - return make_int (extent_endpoint_bufpos (e, 1) - - extent_endpoint_bufpos (e, 0)); -} - -DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /* -Find next extent after EXTENT. -If EXTENT is a buffer return the first extent in the buffer; likewise - for strings. -Extents in a buffer are ordered in what is called the "display" - order, which sorts by increasing start positions and then by *decreasing* - end positions. -If you want to perform an operation on a series of extents, use - `map-extents' instead of this function; it is much more efficient. - The primary use of this function should be to enumerate all the - extents in a buffer. -Note: The display order is not necessarily the order that `map-extents' - processes extents in! -*/ - (extent)) -{ - Lisp_Object val; - EXTENT next; - - if (EXTENTP (extent)) - next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); - else - next = extent_first (decode_buffer_or_string (extent)); - - if (!next) - return Qnil; - XSETEXTENT (val, next); - return val; -} - -DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /* -Find last extent before EXTENT. -If EXTENT is a buffer return the last extent in the buffer; likewise - for strings. -This function is analogous to `next-extent'. -*/ - (extent)) -{ - Lisp_Object val; - EXTENT prev; - - if (EXTENTP (extent)) - prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); - else - prev = extent_last (decode_buffer_or_string (extent)); - - if (!prev) - return Qnil; - XSETEXTENT (val, prev); - return val; -} - -#ifdef DEBUG_XEMACS - -DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /* -Find next extent after EXTENT using the "e" order. -If EXTENT is a buffer return the first extent in the buffer; likewise - for strings. -*/ - (extent)) -{ - Lisp_Object val; - EXTENT next; - - if (EXTENTP (extent)) - next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED)); - else - next = extent_e_first (decode_buffer_or_string (extent)); - - if (!next) - return Qnil; - XSETEXTENT (val, next); - return val; -} - -DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /* -Find last extent before EXTENT using the "e" order. -If EXTENT is a buffer return the last extent in the buffer; likewise - for strings. -This function is analogous to `next-e-extent'. -*/ - (extent)) -{ - Lisp_Object val; - EXTENT prev; - - if (EXTENTP (extent)) - prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED)); - else - prev = extent_e_last (decode_buffer_or_string (extent)); - - if (!prev) - return Qnil; - XSETEXTENT (val, prev); - return val; -} - -#endif - -DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /* -Return the next position after POS where an extent begins or ends. -If POS is at the end of the buffer or string, POS will be returned; - otherwise a position greater than POS will always be returned. -If BUFFER is nil, the current buffer is assumed. -*/ - (pos, object)) -{ - Lisp_Object obj = decode_buffer_or_string (object); - Bytind bpos; - - bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); - bpos = extent_find_end_of_run (obj, bpos, 1); - return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos)); -} - -DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /* -Return the last position before POS where an extent begins or ends. -If POS is at the beginning of the buffer or string, POS will be returned; - otherwise a position less than POS will always be returned. -If OBJECT is nil, the current buffer is assumed. -*/ - (pos, object)) -{ - Lisp_Object obj = decode_buffer_or_string (object); - Bytind bpos; - - bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE); - bpos = extent_find_beginning_of_run (obj, bpos, 1); - return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos)); -} - - -/************************************************************************/ -/* parent and children stuff */ -/************************************************************************/ - -DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /* -Return the parent (if any) of EXTENT. -If an extent has a parent, it derives all its properties from that extent -and has no properties of its own. (The only "properties" that the -extent keeps are the buffer/string it refers to and the start and end -points.) It is possible for an extent's parent to itself have a parent. -*/ - (extent)) -/* do I win the prize for the strangest split infinitive? */ -{ - EXTENT e = decode_extent (extent, 0); - return extent_parent (e); -} - -DEFUN ("extent-children", Fextent_children, 1, 1, 0, /* -Return a list of the children (if any) of EXTENT. -The children of an extent are all those extents whose parent is that extent. -This function does not recursively trace children of children. -\(To do that, use `extent-descendants'.) -*/ - (extent)) -{ - EXTENT e = decode_extent (extent, 0); - Lisp_Object children = extent_children (e); - - if (!NILP (children)) - return Fcopy_sequence (XWEAK_LIST_LIST (children)); - else - return Qnil; -} - -static void -remove_extent_from_children_list (EXTENT e, Lisp_Object child) -{ - Lisp_Object children = extent_children (e); - -#ifdef ERROR_CHECK_EXTENTS - assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); -#endif - XWEAK_LIST_LIST (children) = - delq_no_quit (child, XWEAK_LIST_LIST (children)); -} - -static void -add_extent_to_children_list (EXTENT e, Lisp_Object child) -{ - Lisp_Object children = extent_children (e); - - if (NILP (children)) - { - children = make_weak_list (WEAK_LIST_SIMPLE); - set_extent_no_chase_aux_field (e, children, children); - } - -#ifdef ERROR_CHECK_EXTENTS - assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children)))); -#endif - XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children)); -} - -DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /* -Set the parent of EXTENT to PARENT (may be nil). -See `extent-parent'. -*/ - (extent, parent)) -{ - EXTENT e = decode_extent (extent, 0); - Lisp_Object cur_parent = extent_parent (e); - Lisp_Object rest; - - XSETEXTENT (extent, e); - if (!NILP (parent)) - CHECK_LIVE_EXTENT (parent); - if (EQ (parent, cur_parent)) - return Qnil; - for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest))) - if (EQ (rest, extent)) - signal_simple_error ("Circular parent chain would result", extent); - if (NILP (parent)) - { - remove_extent_from_children_list (XEXTENT (cur_parent), extent); - set_extent_no_chase_aux_field (e, parent, Qnil); - e->flags.has_parent = 0; - } - else - { - add_extent_to_children_list (XEXTENT (parent), extent); - set_extent_no_chase_aux_field (e, parent, parent); - e->flags.has_parent = 1; - } - /* changing the parent also changes the properties of all children. */ - { - int old_invis = (!NILP (cur_parent) && - !NILP (extent_invisible (XEXTENT (cur_parent)))); - int new_invis = (!NILP (parent) && - !NILP (extent_invisible (XEXTENT (parent)))); - - extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis); - } - - return Qnil; -} - - -/************************************************************************/ -/* basic extent mutators */ -/************************************************************************/ - -/* Note: If you track non-duplicable extents by undo, you'll get bogus - undo records for transient extents via update-extent. - For example, query-replace will do this. - */ - -static void -set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end) -{ -#ifdef ERROR_CHECK_EXTENTS - Lisp_Object obj = extent_object (extent); - - assert (start <= end); - if (BUFFERP (obj)) - { - assert (valid_memind_p (XBUFFER (obj), start)); - assert (valid_memind_p (XBUFFER (obj), end)); - } -#endif - - /* Optimization: if the extent is already where we want it to be, - do nothing. */ - if (!extent_detached_p (extent) && extent_start (extent) == start && - extent_end (extent) == end) - return; - - if (extent_detached_p (extent)) - { - if (extent_duplicable_p (extent)) - { - Lisp_Object extent_obj; - XSETEXTENT (extent_obj, extent); - record_extent (extent_obj, 1); - } - } - else - extent_detach (extent); - - set_extent_start (extent, start); - set_extent_end (extent, end); - extent_attach (extent); -} - -/* Set extent's endpoints to S and E, and put extent in buffer or string - OBJECT. (If OBJECT is nil, do not change the extent's object.) */ - -void -set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object) -{ - Memind start, end; - - if (NILP (object)) - { - object = extent_object (extent); - assert (!NILP (object)); - } - else if (!EQ (object, extent_object (extent))) - { - extent_detach (extent); - extent_object (extent) = object; - } - - start = s < 0 ? extent_start (extent) : - buffer_or_string_bytind_to_memind (object, s); - end = e < 0 ? extent_end (extent) : - buffer_or_string_bytind_to_memind (object, e); - set_extent_endpoints_1 (extent, start, end); -} - -static void -set_extent_openness (EXTENT extent, int start_open, int end_open) -{ - if (start_open != -1) - extent_start_open_p (extent) = start_open; - if (end_open != -1) - extent_end_open_p (extent) = end_open; - /* changing the open/closedness of an extent does not affect - redisplay. */ -} - -static EXTENT -make_extent_internal (Lisp_Object object, Bytind from, Bytind to) -{ - EXTENT extent; - - extent = make_extent_detached (object); - set_extent_endpoints (extent, from, to, Qnil); - return extent; -} - -static EXTENT -copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object) -{ - EXTENT e; - - e = make_extent_detached (object); - if (from >= 0) - set_extent_endpoints (e, from, to, Qnil); - - e->plist = Fcopy_sequence (original->plist); - memcpy (&e->flags, &original->flags, sizeof (e->flags)); - if (e->flags.has_aux) - { - /* also need to copy the aux struct. It won't work for - this extent to share the same aux struct as the original - one. */ - struct extent_auxiliary *data = - alloc_lcrecord_type (struct extent_auxiliary, - lrecord_extent_auxiliary); - - copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist))); - XSETEXTENT_AUXILIARY (XCAR (e->plist), data); - } - - { - /* we may have just added another child to the parent extent. */ - Lisp_Object parent = extent_parent (e); - if (!NILP (parent)) - { - Lisp_Object extent; - XSETEXTENT (extent, e); - add_extent_to_children_list (XEXTENT (parent), extent); - } - } - - return e; -} - -static void -destroy_extent (EXTENT extent) -{ - Lisp_Object rest, nextrest, children; - Lisp_Object extent_obj; - - if (!extent_detached_p (extent)) - extent_detach (extent); - /* disassociate the extent from its children and parent */ - children = extent_children (extent); - if (!NILP (children)) - { - LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children)) - Fset_extent_parent (XCAR (rest), Qnil); - } - XSETEXTENT (extent_obj, extent); - Fset_extent_parent (extent_obj, Qnil); - /* mark the extent as destroyed */ - extent_object (extent) = Qt; -} - -DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /* -Make an extent for the range [FROM, TO) in BUFFER-OR-STRING. -BUFFER-OR-STRING defaults to the current buffer. Insertions at point -TO will be outside of the extent; insertions at FROM will be inside the -extent, causing the extent to grow. (This is the same way that markers -behave.) You can change the behavior of insertions at the endpoints -using `set-extent-property'. The extent is initially detached if both -FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil, -meaning the extent is in no buffer and no string. -*/ - (from, to, buffer_or_string)) -{ - Lisp_Object extent_obj; - Lisp_Object obj; - - obj = decode_buffer_or_string (buffer_or_string); - if (NILP (from) && NILP (to)) - { - if (NILP (buffer_or_string)) - obj = Qnil; - XSETEXTENT (extent_obj, make_extent_detached (obj)); - } - else - { - Bytind start, end; - - get_buffer_or_string_range_byte (obj, from, to, &start, &end, - GB_ALLOW_PAST_ACCESSIBLE); - XSETEXTENT (extent_obj, make_extent_internal (obj, start, end)); - } - return extent_obj; -} - -DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /* -Make a copy of EXTENT. It is initially detached. -Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string. -*/ - (extent, buffer_or_string)) -{ - EXTENT ext = decode_extent (extent, 0); - - if (NILP (buffer_or_string)) - buffer_or_string = extent_object (ext); - else - buffer_or_string = decode_buffer_or_string (buffer_or_string); - - XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string)); - return extent; -} - -DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /* -Remove EXTENT from its buffer and destroy it. -This does not modify the buffer's text, only its display properties. -The extent cannot be used thereafter. -*/ - (extent)) -{ - EXTENT ext; - - /* We do not call decode_extent() here because already-destroyed - extents are OK. */ - CHECK_EXTENT (extent); - ext = XEXTENT (extent); - - if (!EXTENT_LIVE_P (ext)) - return Qnil; - destroy_extent (ext); - return Qnil; -} - -DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /* -Remove EXTENT from its buffer in such a way that it can be re-inserted. -An extent is also detached when all of its characters are all killed by a -deletion, unless its `detachable' property has been unset. - -Extents which have the `duplicable' attribute are tracked by the undo -mechanism. Detachment via `detach-extent' and string deletion is recorded, -as is attachment via `insert-extent' and string insertion. Extent motion, -face changes, and attachment via `make-extent' and `set-extent-endpoints' -are not recorded. This means that extent changes which are to be undo-able -must be performed by character editing, or by insertion and detachment of -duplicable extents. -*/ - (extent)) -{ - EXTENT ext = decode_extent (extent, 0); - - if (extent_detached_p (ext)) - return extent; - if (extent_duplicable_p (ext)) - record_extent (extent, 0); - extent_detach (ext); - - return extent; -} - -DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /* -Set the endpoints of EXTENT to START, END. -If START and END are null, call detach-extent on EXTENT. -BUFFER-OR-STRING specifies the new buffer or string that the extent should -be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT -is in no buffer and no string, it defaults to the current buffer.) -See documentation on `detach-extent' for a discussion of undo recording. -*/ - (extent, start, end, buffer_or_string)) -{ - EXTENT ext; - Bytind s, e; - - ext = decode_extent (extent, 0); - - if (NILP (buffer_or_string)) - { - buffer_or_string = extent_object (ext); - if (NILP (buffer_or_string)) - buffer_or_string = Fcurrent_buffer (); - } - else - buffer_or_string = decode_buffer_or_string (buffer_or_string); - - if (NILP (start) && NILP (end)) - return Fdetach_extent (extent); - - get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, - GB_ALLOW_PAST_ACCESSIBLE); - - set_extent_endpoints (ext, s, e, buffer_or_string); - return extent; -} - - -/************************************************************************/ -/* mapping over extents */ -/************************************************************************/ - -static unsigned int -decode_map_extents_flags (Lisp_Object flags) -{ - unsigned int retval = 0; - unsigned int all_extents_specified = 0; - unsigned int in_region_specified = 0; - - if (EQ (flags, Qt)) /* obsoleteness compatibility */ - return ME_END_CLOSED; - if (NILP (flags)) - return 0; - if (SYMBOLP (flags)) - flags = Fcons (flags, Qnil); - while (!NILP (flags)) - { - Lisp_Object sym; - CHECK_CONS (flags); - sym = XCAR (flags); - CHECK_SYMBOL (sym); - if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) || - EQ (sym, Qall_extents_closed_open) || - EQ (sym, Qall_extents_open_closed)) - { - if (all_extents_specified) - error ("Only one `all-extents-*' flag may be specified"); - all_extents_specified = 1; - } - if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) || - EQ (sym, Qstart_and_end_in_region) || - EQ (sym, Qstart_or_end_in_region)) - { - if (in_region_specified) - error ("Only one `*-in-region' flag may be specified"); - in_region_specified = 1; - } - - /* I do so love that conditional operator ... */ - retval |= - EQ (sym, Qend_closed) ? ME_END_CLOSED : - EQ (sym, Qstart_open) ? ME_START_OPEN : - EQ (sym, Qall_extents_closed) ? ME_ALL_EXTENTS_CLOSED : - EQ (sym, Qall_extents_open) ? ME_ALL_EXTENTS_OPEN : - EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN : - EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED : - EQ (sym, Qstart_in_region) ? ME_START_IN_REGION : - EQ (sym, Qend_in_region) ? ME_END_IN_REGION : - EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION : - EQ (sym, Qstart_or_end_in_region) ? ME_START_OR_END_IN_REGION : - EQ (sym, Qnegate_in_region) ? ME_NEGATE_IN_REGION : - (signal_simple_error ("Invalid `map-extents' flag", sym), 0); - - flags = XCDR (flags); - } - return retval; -} - -DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /* -Return whether EXTENT overlaps a specified region. -This is equivalent to whether `map-extents' would visit EXTENT when called -with these args. -*/ - (extent, from, to, flags)) -{ - Bytind start, end; - EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED); - Lisp_Object obj = extent_object (ext); - - get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL | - GB_ALLOW_PAST_ACCESSIBLE); - - return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ? - Qt : Qnil; -} - -struct slow_map_extents_arg -{ - Lisp_Object map_arg; - Lisp_Object map_routine; - Lisp_Object result; - Lisp_Object property; - Lisp_Object value; -}; - -static int -slow_map_extents_function (EXTENT extent, void *arg) -{ - /* This function can GC */ - struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg; - Lisp_Object extent_obj; - - XSETEXTENT (extent_obj, extent); - - /* make sure this extent qualifies according to the PROPERTY - and VALUE args */ - - if (!NILP (closure->property)) - { - Lisp_Object value = Fextent_property (extent_obj, closure->property, - Qnil); - if ((NILP (closure->value) && NILP (value)) || - (!NILP (closure->value) && !EQ (value, closure->value))) - return 0; - } - - closure->result = call2 (closure->map_routine, extent_obj, - closure->map_arg); - return !NILP (closure->result); -} - -DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /* -Map FUNCTION over the extents which overlap a region in OBJECT. -OBJECT is normally a buffer or string but could be an extent (see below). -The region is normally bounded by [FROM, TO) (i.e. the beginning of the -region is closed and the end of the region is open), but this can be -changed with the FLAGS argument (see below for a complete discussion). - -FUNCTION is called with the arguments (extent, MAPARG). The arguments -OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to -the current buffer, the beginning of OBJECT, the end of OBJECT, nil, -and nil, respectively. `map-extents' returns the first non-nil result -produced by FUNCTION, and no more calls to FUNCTION are made after it -returns non-nil. - -If OBJECT is an extent, FROM and TO default to the extent's endpoints, -and the mapping omits that extent and its predecessors. This feature -supports restarting a loop based on `map-extents'. Note: OBJECT must -be attached to a buffer or string, and the mapping is done over that -buffer or string. - -An extent overlaps the region if there is any point in the extent that is -also in the region. (For the purpose of overlap, zero-length extents and -regions are treated as closed on both ends regardless of their endpoints' -specified open/closedness.) Note that the endpoints of an extent or region -are considered to be in that extent or region if and only if the -corresponding end is closed. For example, the extent [5,7] overlaps the -region [2,5] because 5 is in both the extent and the region. However, (5,7] -does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor -\(5,7] overlaps the region [2,5) because 5 is not in the region. - -The optional FLAGS can be a symbol or a list of one or more symbols, -modifying the behavior of `map-extents'. Allowed symbols are: - -end-closed The region's end is closed. - -start-open The region's start is open. - -all-extents-closed Treat all extents as closed on both ends for the - purpose of determining whether they overlap the - region, irrespective of their actual open- or - closedness. -all-extents-open Treat all extents as open on both ends. -all-extents-closed-open Treat all extents as start-closed, end-open. -all-extents-open-closed Treat all extents as start-open, end-closed. - -start-in-region In addition to the above conditions for extent - overlap, the extent's start position must lie within - the specified region. Note that, for this - condition, open start positions are treated as if - 0.5 was added to the endpoint's value, and open - end positions are treated as if 0.5 was subtracted - from the endpoint's value. -end-in-region The extent's end position must lie within the - region. -start-and-end-in-region Both the extent's start and end positions must lie - within the region. -start-or-end-in-region Either the extent's start or end position must lie - within the region. - -negate-in-region The condition specified by a `*-in-region' flag - must NOT hold for the extent to be considered. - - -At most one of `all-extents-closed', `all-extents-open', -`all-extents-closed-open', and `all-extents-open-closed' may be specified. - -At most one of `start-in-region', `end-in-region', -`start-and-end-in-region', and `start-or-end-in-region' may be specified. - -If optional arg PROPERTY is non-nil, only extents with that property set -on them will be visited. If optional arg VALUE is non-nil, only extents -whose value for that property is `eq' to VALUE will be visited. -*/ - (function, object, from, to, maparg, flags, property, value)) -{ - /* This function can GC */ - struct slow_map_extents_arg closure; - unsigned int me_flags; - Bytind start, end; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - EXTENT after = 0; - - if (EXTENTP (object)) - { - after = decode_extent (object, DE_MUST_BE_ATTACHED); - if (NILP (from)) - from = Fextent_start_position (object); - if (NILP (to)) - to = Fextent_end_position (object); - object = extent_object (after); - } - else - object = decode_buffer_or_string (object); - - get_buffer_or_string_range_byte (object, from, to, &start, &end, - GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); - - me_flags = decode_map_extents_flags (flags); - - if (!NILP (property)) - { - if (!NILP (value)) - value = canonicalize_extent_property (property, value); - } - - GCPRO5 (function, maparg, object, property, value); - - closure.map_arg = maparg; - closure.map_routine = function; - closure.result = Qnil; - closure.property = property; - closure.value = value; - - map_extents_bytind (start, end, slow_map_extents_function, - (void *) &closure, object, after, - /* You never know what the user might do ... */ - me_flags | ME_MIGHT_CALL_ELISP); - - UNGCPRO; - return closure.result; -} - - -/************************************************************************/ -/* mapping over extents -- other functions */ -/************************************************************************/ - -/* ------------------------------- */ -/* map-extent-children */ -/* ------------------------------- */ - -struct slow_map_extent_children_arg -{ - Lisp_Object map_arg; - Lisp_Object map_routine; - Lisp_Object result; - Lisp_Object property; - Lisp_Object value; - Bytind start_min; - Bytind prev_start; - Bytind prev_end; -}; - -static int -slow_map_extent_children_function (EXTENT extent, void *arg) -{ - /* This function can GC */ - struct slow_map_extent_children_arg *closure = - (struct slow_map_extent_children_arg *) arg; - Lisp_Object extent_obj; - Bytind start = extent_endpoint_bytind (extent, 0); - Bytind end = extent_endpoint_bytind (extent, 1); - /* Make sure the extent starts inside the region of interest, - rather than just overlaps it. - */ - if (start < closure->start_min) - return 0; - /* Make sure the extent is not a child of a previous visited one. - We know already, because of extent ordering, - that start >= prev_start, and that if - start == prev_start, then end <= prev_end. - */ - if (start == closure->prev_start) - { - if (end < closure->prev_end) - return 0; - } - else /* start > prev_start */ - { - if (start < closure->prev_end) - return 0; - /* corner case: prev_end can be -1 if there is no prev */ - } - XSETEXTENT (extent_obj, extent); - - /* make sure this extent qualifies according to the PROPERTY - and VALUE args */ - - if (!NILP (closure->property)) - { - Lisp_Object value = Fextent_property (extent_obj, closure->property, - Qnil); - if ((NILP (closure->value) && NILP (value)) || - (!NILP (closure->value) && !EQ (value, closure->value))) - return 0; - } - - closure->result = call2 (closure->map_routine, extent_obj, - closure->map_arg); - - /* Since the callback may change the buffer, compute all stored - buffer positions here. - */ - closure->start_min = -1; /* no need for this any more */ - closure->prev_start = extent_endpoint_bytind (extent, 0); - closure->prev_end = extent_endpoint_bytind (extent, 1); - - return !NILP (closure->result); -} - -DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /* -Map FUNCTION over the extents in the region from FROM to TO. -FUNCTION is called with arguments (extent, MAPARG). See `map-extents' -for a full discussion of the arguments FROM, TO, and FLAGS. - -The arguments are the same as for `map-extents', but this function differs -in that it only visits extents which start in the given region, and also -in that, after visiting an extent E, it skips all other extents which start -inside E but end before E's end. - -Thus, this function may be used to walk a tree of extents in a buffer: - (defun walk-extents (buffer &optional ignore) - (map-extent-children 'walk-extents buffer)) -*/ - (function, object, from, to, maparg, flags, property, value)) -{ - /* This function can GC */ - struct slow_map_extent_children_arg closure; - unsigned int me_flags; - Bytind start, end; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - EXTENT after = 0; - - if (EXTENTP (object)) - { - after = decode_extent (object, DE_MUST_BE_ATTACHED); - if (NILP (from)) - from = Fextent_start_position (object); - if (NILP (to)) - to = Fextent_end_position (object); - object = extent_object (after); - } - else - object = decode_buffer_or_string (object); - - get_buffer_or_string_range_byte (object, from, to, &start, &end, - GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE); - - me_flags = decode_map_extents_flags (flags); - - if (!NILP (property)) - { - if (!NILP (value)) - value = canonicalize_extent_property (property, value); - } - - GCPRO5 (function, maparg, object, property, value); - - closure.map_arg = maparg; - closure.map_routine = function; - closure.result = Qnil; - closure.property = property; - closure.value = value; - closure.start_min = start; - closure.prev_start = -1; - closure.prev_end = -1; - map_extents_bytind (start, end, slow_map_extent_children_function, - (void *) &closure, object, after, - /* You never know what the user might do ... */ - me_flags | ME_MIGHT_CALL_ELISP); - - UNGCPRO; - return closure.result; -} - -/* ------------------------------- */ -/* extent-at */ -/* ------------------------------- */ - -/* find "smallest" matching extent containing pos -- (flag == 0) means - all extents match, else (EXTENT_FLAGS (extent) & flag) must be true; - for more than one matching extent with precisely the same endpoints, - we choose the last extent in the extents_list. - The search stops just before "before", if that is non-null. - */ - -struct extent_at_arg -{ - EXTENT best_match; - Memind best_start; - Memind best_end; - Lisp_Object prop; - EXTENT before; -}; - -enum extent_at_flag -{ - EXTENT_AT_AFTER, - EXTENT_AT_BEFORE, - EXTENT_AT_AT -}; - -static enum extent_at_flag -decode_extent_at_flag (Lisp_Object at_flag) -{ - if (NILP (at_flag)) - return EXTENT_AT_AFTER; - - CHECK_SYMBOL (at_flag); - if (EQ (at_flag, Qafter)) return EXTENT_AT_AFTER; - if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE; - if (EQ (at_flag, Qat)) return EXTENT_AT_AT; - - signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag); - return EXTENT_AT_AFTER; /* unreached */ -} - -static int -extent_at_mapper (EXTENT e, void *arg) -{ - struct extent_at_arg *closure = (struct extent_at_arg *) arg; - - if (e == closure->before) - return 1; - - /* If closure->prop is non-nil, then the extent is only acceptable - if it has a non-nil value for that property. */ - if (!NILP (closure->prop)) - { - Lisp_Object extent; - XSETEXTENT (extent, e); - if (NILP (Fextent_property (extent, closure->prop, Qnil))) - return 0; - } - - { - EXTENT current = closure->best_match; - - if (!current) - goto accept; - /* redundant but quick test */ - else if (extent_start (current) > extent_start (e)) - return 0; - - /* we return the "last" best fit, instead of the first -- - this is because then the glyph closest to two equivalent - extents corresponds to the "extent-at" the text just past - that same glyph */ - else if (!EXTENT_LESS_VALS (e, closure->best_start, - closure->best_end)) - goto accept; - else - return 0; - accept: - closure->best_match = e; - closure->best_start = extent_start (e); - closure->best_end = extent_end (e); - } - - return 0; -} - -static Lisp_Object -extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property, - EXTENT before, enum extent_at_flag at_flag) -{ - struct extent_at_arg closure; - Lisp_Object extent_obj; - - /* it might be argued that invalid positions should cause - errors, but the principle of least surprise dictates that - nil should be returned (extent-at is often used in - response to a mouse event, and in many cases previous events - have changed the buffer contents). - - Also, the openness stuff in the text-property code currently - does not check its limits and might go off the end. */ - if ((at_flag == EXTENT_AT_BEFORE - ? position <= buffer_or_string_absolute_begin_byte (object) - : position < buffer_or_string_absolute_begin_byte (object)) - || (at_flag == EXTENT_AT_AFTER - ? position >= buffer_or_string_absolute_end_byte (object) - : position > buffer_or_string_absolute_end_byte (object))) - return Qnil; - - closure.best_match = 0; - closure.prop = property; - closure.before = before; - - map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position, - at_flag == EXTENT_AT_AFTER ? position + 1 : position, - extent_at_mapper, (void *) &closure, object, 0, - ME_START_OPEN | ME_ALL_EXTENTS_CLOSED); - - if (!closure.best_match) - return Qnil; - - XSETEXTENT (extent_obj, closure.best_match); - return extent_obj; -} - -DEFUN ("extent-at", Fextent_at, 1, 5, 0, /* -Find "smallest" extent at POS in OBJECT having PROPERTY set. -Normally, an extent is "at" POS if it overlaps the region (POS, POS+1); - i.e. if it covers the character after POS. (However, see the definition - of AT-FLAG.) "Smallest" means the extent that comes last in the display - order; this normally means the extent whose start position is closest to - POS. See `next-extent' for more information. -OBJECT specifies a buffer or string and defaults to the current buffer. -PROPERTY defaults to nil, meaning that any extent will do. -Properties are attached to extents with `set-extent-property', which see. -Returns nil if POS is invalid or there is no matching extent at POS. -If the fourth argument BEFORE is not nil, it must be an extent; any returned - extent will precede that extent. This feature allows `extent-at' to be - used by a loop over extents. -AT-FLAG controls how end cases are handled, and should be one of: - -nil or `after' An extent is at POS if it covers the character - after POS. This is consistent with the way - that text properties work. -`before' An extent is at POS if it covers the character - before POS. -`at' An extent is at POS if it overlaps or abuts POS. - This includes all zero-length extents at POS. - -Note that in all cases, the start-openness and end-openness of the extents -considered is ignored. If you want to pay attention to those properties, -you should use `map-extents', which gives you more control. -*/ - (pos, object, property, before, at_flag)) -{ - Bytind position; - EXTENT before_extent; - enum extent_at_flag fl; - - object = decode_buffer_or_string (object); - position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); - if (NILP (before)) - before_extent = 0; - else - before_extent = decode_extent (before, DE_MUST_BE_ATTACHED); - if (before_extent && !EQ (object, extent_object (before_extent))) - signal_simple_error ("extent not in specified buffer or string", object); - fl = decode_extent_at_flag (at_flag); - - return extent_at_bytind (position, object, property, before_extent, fl); -} - -/* ------------------------------- */ -/* verify_extent_modification() */ -/* ------------------------------- */ - -/* verify_extent_modification() is called when a buffer or string is - modified to check whether the modification is occuring inside a - read-only extent. - */ - -struct verify_extents_arg -{ - Lisp_Object object; - Memind start; - Memind end; - Lisp_Object iro; /* value of inhibit-read-only */ -}; - -static int -verify_extent_mapper (EXTENT extent, void *arg) -{ - struct verify_extents_arg *closure = (struct verify_extents_arg *) arg; - Lisp_Object prop = extent_read_only (extent); - - if (NILP (prop)) - return 0; - - if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro))) - return 0; - -#if 0 /* Nobody seems to care for this any more -sb */ - /* Allow deletion if the extent is completely contained in - the region being deleted. - This is important for supporting tokens which are internally - write-protected, but which can be killed and yanked as a whole. - Ignore open/closed distinctions at this point. - -- Rose - */ - if (closure->start != closure->end && - extent_start (extent) >= closure->start && - extent_end (extent) <= closure->end) - return 0; -#endif - - while (1) - Fsignal (Qbuffer_read_only, (list1 (closure->object))); - - RETURN_NOT_REACHED(0) -} - -/* Value of Vinhibit_read_only is precomputed and passed in for - efficiency */ - -void -verify_extent_modification (Lisp_Object object, Bytind from, Bytind to, - Lisp_Object inhibit_read_only_value) -{ - int closed; - struct verify_extents_arg closure; - - /* If insertion, visit closed-endpoint extents touching the insertion - point because the text would go inside those extents. If deletion, - treat the range as open on both ends so that touching extents are not - visited. Note that we assume that an insertion is occurring if the - changed range has zero length, and a deletion otherwise. This - fails if a change (i.e. non-insertion, non-deletion) is happening. - As far as I know, this doesn't currently occur in XEmacs. --ben */ - closed = (from==to); - closure.object = object; - closure.start = buffer_or_string_bytind_to_memind (object, from); - closure.end = buffer_or_string_bytind_to_memind (object, to); - closure.iro = inhibit_read_only_value; - - map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure, - object, 0, closed ? ME_END_CLOSED : ME_START_OPEN); -} - -/* ------------------------------------ */ -/* process_extents_for_insertion() */ -/* ------------------------------------ */ - -struct process_extents_for_insertion_arg -{ - Bytind opoint; - int length; - Lisp_Object object; -}; - -/* A region of length LENGTH was just inserted at OPOINT. Modify all - of the extents as required for the insertion, based on their - start-open/end-open properties. - */ - -static int -process_extents_for_insertion_mapper (EXTENT extent, void *arg) -{ - struct process_extents_for_insertion_arg *closure = - (struct process_extents_for_insertion_arg *) arg; - Memind indice = buffer_or_string_bytind_to_memind (closure->object, - closure->opoint); - - /* When this function is called, one end of the newly-inserted text should - be adjacent to some endpoint of the extent, or disjoint from it. If - the insertion overlaps any existing extent, something is wrong. - */ -#ifdef ERROR_CHECK_EXTENTS - if (extent_start (extent) > indice && - extent_start (extent) < indice + closure->length) - abort (); - if (extent_end (extent) > indice && - extent_end (extent) < indice + closure->length) - abort (); -#endif - - /* The extent-adjustment code adjusted the extent's endpoints as if - they were markers -- endpoints at the gap (i.e. the insertion - point) go to the left of the insertion point, which is correct - for [) extents. We need to fix the other kinds of extents. - - Note that both conditions below will hold for zero-length (] - extents at the gap. Zero-length () extents would get adjusted - such that their start is greater than their end; we treat them - as [) extents. This is unfortunately an inelegant part of the - extent model, but there is no way around it. */ - - { - Memind new_start, new_end; - - new_start = extent_start (extent); - new_end = extent_end (extent); - if (indice == extent_start (extent) && extent_start_open_p (extent) && - /* coerce zero-length () extents to [) */ - new_start != new_end) - new_start += closure->length; - if (indice == extent_end (extent) && !extent_end_open_p (extent)) - new_end += closure->length; - set_extent_endpoints_1 (extent, new_start, new_end); - } - - return 0; -} - -void -process_extents_for_insertion (Lisp_Object object, Bytind opoint, - Bytecount length) -{ - struct process_extents_for_insertion_arg closure; - - closure.opoint = opoint; - closure.length = length; - closure.object = object; - - map_extents_bytind (opoint, opoint + length, - process_extents_for_insertion_mapper, - (void *) &closure, object, 0, - ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS | - ME_INCLUDE_INTERNAL); -} - -/* ------------------------------------ */ -/* process_extents_for_deletion() */ -/* ------------------------------------ */ - -struct process_extents_for_deletion_arg -{ - Memind start, end; - int destroy_included_extents; -}; - -/* This function is called when we're about to delete the range [from, to]. - Detach all of the extents that are completely inside the range [from, to], - if they're detachable or open-open. */ - -static int -process_extents_for_deletion_mapper (EXTENT extent, void *arg) -{ - struct process_extents_for_deletion_arg *closure = - (struct process_extents_for_deletion_arg *) arg; - - /* If the extent lies completely within the range that - is being deleted, then nuke the extent if it's detachable - (otherwise, it will become a zero-length extent). */ - - if (closure->start <= extent_start (extent) && - extent_end (extent) <= closure->end) - { - if (extent_detachable_p (extent)) - { - if (closure->destroy_included_extents) - destroy_extent (extent); - else - extent_detach (extent); - } - } - - return 0; -} - -/* DESTROY_THEM means destroy the extents instead of just deleting them. - It is unused currently, but perhaps might be used (there used to - be a function process_extents_for_destruction(), #if 0'd out, - that did the equivalent). */ -void -process_extents_for_deletion (Lisp_Object object, Bytind from, - Bytind to, int destroy_them) -{ - struct process_extents_for_deletion_arg closure; - - closure.start = buffer_or_string_bytind_to_memind (object, from); - closure.end = buffer_or_string_bytind_to_memind (object, to); - closure.destroy_included_extents = destroy_them; - - map_extents_bytind (from, to, process_extents_for_deletion_mapper, - (void *) &closure, object, 0, - ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS); -} - -/* ------------------------------- */ -/* report_extent_modification() */ -/* ------------------------------- */ -struct report_extent_modification_closure { - Lisp_Object buffer; - Bufpos start, end; - int afterp; - int speccount; -}; - -/* This juggling with the pointer to another file's global variable is - kind of yucky. Perhaps I should just export the variable. */ -static int *inside_change_hook_pointer; - -static Lisp_Object -report_extent_modification_restore (Lisp_Object buffer) -{ - *inside_change_hook_pointer = 0; - if (current_buffer != XBUFFER (buffer)) - Fset_buffer (buffer); - return Qnil; -} - -static int -report_extent_modification_mapper (EXTENT extent, void *arg) -{ - struct report_extent_modification_closure *closure = - (struct report_extent_modification_closure *)arg; - Lisp_Object exobj, startobj, endobj; - Lisp_Object hook = (closure->afterp - ? extent_after_change_functions (extent) - : extent_before_change_functions (extent)); - if (NILP (hook)) - return 0; - - XSETEXTENT (exobj, extent); - XSETINT (startobj, closure->start); - XSETINT (endobj, closure->end); - - /* Now that we are sure to call elisp, set up an unwind-protect so - inside_change_hook gets restored in case we throw. Also record - the current buffer, in case we change it. Do the recording only - once. */ - if (closure->speccount == -1) - { - closure->speccount = specpdl_depth (); - record_unwind_protect (report_extent_modification_restore, - Fcurrent_buffer ()); - } - - /* The functions will expect closure->buffer to be the current - buffer, so change it if it isn't. */ - if (current_buffer != XBUFFER (closure->buffer)) - Fset_buffer (closure->buffer); - - /* #### It's a shame that we can't use any of the existing run_hook* - functions here. This is so because all of them work with - symbols, to be able to retrieve default values of local hooks. - */ - - if (!CONSP (hook) || EQ (XCAR (hook), Qlambda)) - call3 (hook, exobj, startobj, endobj); - else - { - Lisp_Object tail; - EXTERNAL_LIST_LOOP (tail, hook) - call3 (XCAR (tail), exobj, startobj, endobj); - } - return 0; -} - -void -report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end, - int *inside, int afterp) -{ - struct report_extent_modification_closure closure; - - closure.buffer = buffer; - closure.start = start; - closure.end = end; - closure.afterp = afterp; - closure.speccount = -1; - - inside_change_hook_pointer = inside; - *inside = 1; - - map_extents (start, end, report_extent_modification_mapper, (void *)&closure, - buffer, NULL, ME_MIGHT_CALL_ELISP); - - if (closure.speccount == -1) - *inside = 0; - else - { - /* We mustn't unbind when closure.speccount != -1 because - map_extents_bytind has already done that. */ - assert (*inside == 0); - } -} - - -/************************************************************************/ -/* extent properties */ -/************************************************************************/ - -static void -set_extent_invisible (EXTENT extent, Lisp_Object value) -{ - if (!EQ (extent_invisible (extent), value)) - { - set_extent_invisible_1 (extent, value); - extent_changed_for_redisplay (extent, 1, 1); - } -} - -/* This function does "memoization" -- similar to the interning - that happens with symbols. Given a list of faces, an equivalent - list is returned such that if this function is called twice with - input that is `equal', the resulting outputs will be `eq'. - - Note that the inputs and outputs are in general *not* `equal' -- - faces in symbol form become actual face objects in the output. - This is necessary so that temporary faces stay around. */ - -static Lisp_Object -memoize_extent_face_internal (Lisp_Object list) -{ - int len; - int thelen; - Lisp_Object cons, thecons; - Lisp_Object oldtail, tail; - struct gcpro gcpro1; - - if (NILP (list)) - return Qnil; - if (!CONSP (list)) - return Fget_face (list); - - /* To do the memoization, we use a hash table mapping from - external lists to internal lists. We do `equal' comparisons - on the keys so the memoization works correctly. - - Note that we canonicalize things so that the keys in the - hash table (the external lists) always contain symbols and - the values (the internal lists) always contain face objects. - - We also maintain a "reverse" table that maps from the internal - lists to the external equivalents. The idea here is twofold: - - 1) `extent-face' wants to return a list containing face symbols - rather than face objects. - 2) We don't want things to get quite so messed up if the user - maliciously side-effects the returned lists. - */ - - len = XINT (Flength (list)); - thelen = XINT (Flength (Vextent_face_reusable_list)); - oldtail = Qnil; - tail = Qnil; - GCPRO1 (oldtail); - - /* We canonicalize the given list into another list. - We try to avoid consing except when necessary, so we have - a reusable list. - */ - - if (thelen < len) - { - cons = Vextent_face_reusable_list; - while (!NILP (XCDR (cons))) - cons = XCDR (cons); - XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil); - } - else if (thelen > len) - { - int i; - - /* Truncate the list temporarily so it's the right length; - remember the old tail. */ - cons = Vextent_face_reusable_list; - for (i = 0; i < len - 1; i++) - cons = XCDR (cons); - tail = cons; - oldtail = XCDR (cons); - XCDR (cons) = Qnil; - } - - thecons = Vextent_face_reusable_list; - EXTERNAL_LIST_LOOP (cons, list) - { - Lisp_Object face = Fget_face (XCAR (cons)); - - XCAR (thecons) = Fface_name (face); - thecons = XCDR (thecons); - } - - list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table, - Qnil); - if (NILP (list)) - { - Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list); - Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list); - - LIST_LOOP (cons, facelist) - { - XCAR (cons) = Fget_face (XCAR (cons)); - } - Fputhash (symlist, facelist, Vextent_face_memoize_hash_table); - Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table); - list = facelist; - } - - /* Now restore the truncated tail of the reusable list, if necessary. */ - if (!NILP (tail)) - XCDR (tail) = oldtail; - - UNGCPRO; - return list; -} - -static Lisp_Object -external_of_internal_memoized_face (Lisp_Object face) -{ - if (NILP (face)) - return Qnil; - else if (!CONSP (face)) - return XFACE (face)->name; - else - { - face = Fgethash (face, Vextent_face_reverse_memoize_hash_table, - Qunbound); - assert (!UNBOUNDP (face)); - return face; - } -} - -static Lisp_Object -canonicalize_extent_property (Lisp_Object prop, Lisp_Object value) -{ - if (EQ (prop, Qface) || EQ (prop, Qmouse_face)) - value = (external_of_internal_memoized_face - (memoize_extent_face_internal (value))); - return value; -} - -/* Do we need a lisp-level function ? */ -DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function, - 2,2,0,/* -Note: This feature is experimental! - -Set initial-redisplay-function of EXTENT to the function -FUNCTION. - -The first time the EXTENT is (re)displayed, an eval event will be -dispatched calling FUNCTION with EXTENT as its only argument. -*/ - (extent, function)) -{ - EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED); - - e = extent_ancestor (e); /* Is this needed? Macro also does chasing!*/ - set_extent_initial_redisplay_function(e,function); - extent_in_red_event_p(e) = 0; /* If the function changed we can spawn - new events */ - extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/ - - return function; -} - -DEFUN ("extent-face", Fextent_face, 1, 1, 0, /* -Return the name of the face in which EXTENT is displayed, or nil -if the extent's face is unspecified. This might also return a list -of face names. -*/ - (extent)) -{ - Lisp_Object face; - - CHECK_EXTENT (extent); - face = extent_face (XEXTENT (extent)); - - return external_of_internal_memoized_face (face); -} - -DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /* -Make the given EXTENT have the graphic attributes specified by FACE. -FACE can also be a list of faces, and all faces listed will apply, -with faces earlier in the list taking priority over those later in the -list. -*/ - (extent, face)) -{ - EXTENT e = decode_extent(extent, 0); - Lisp_Object orig_face = face; - - /* retrieve the ancestor for efficiency and proper redisplay noting. */ - e = extent_ancestor (e); - - face = memoize_extent_face_internal (face); - - extent_face (e) = face; - extent_changed_for_redisplay (e, 1, 0); - - return orig_face; -} - - -DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /* -Return the face used to highlight EXTENT when the mouse passes over it. -The return value will be a face name, a list of face names, or nil -if the extent's mouse face is unspecified. -*/ - (extent)) -{ - Lisp_Object face; - - CHECK_EXTENT (extent); - face = extent_mouse_face (XEXTENT (extent)); - - return external_of_internal_memoized_face (face); -} - -DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /* -Set the face used to highlight EXTENT when the mouse passes over it. -FACE can also be a list of faces, and all faces listed will apply, -with faces earlier in the list taking priority over those later in the -list. -*/ - (extent, face)) -{ - EXTENT e; - Lisp_Object orig_face = face; - - CHECK_EXTENT (extent); - e = XEXTENT (extent); - /* retrieve the ancestor for efficiency and proper redisplay noting. */ - e = extent_ancestor (e); - - face = memoize_extent_face_internal (face); - - set_extent_mouse_face (e, face); - extent_changed_for_redisplay (e, 1, 0); - - return orig_face; -} - -void -set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, - glyph_layout layout) -{ - extent = extent_ancestor (extent); - - if (!endp) - { - set_extent_begin_glyph (extent, glyph); - extent_begin_glyph_layout (extent) = layout; - } - else - { - set_extent_end_glyph (extent, glyph); - extent_end_glyph_layout (extent) = layout; - } - - extent_changed_for_redisplay (extent, 1, 0); -} - -static Lisp_Object -glyph_layout_to_symbol (glyph_layout layout) -{ - switch (layout) - { - case GL_TEXT: return Qtext; - case GL_OUTSIDE_MARGIN: return Qoutside_margin; - case GL_INSIDE_MARGIN: return Qinside_margin; - case GL_WHITESPACE: return Qwhitespace; - default: - abort (); - return Qnil; /* unreached */ - } -} - -static glyph_layout -symbol_to_glyph_layout (Lisp_Object layout_obj) -{ - if (NILP (layout_obj)) - return GL_TEXT; - - CHECK_SYMBOL (layout_obj); - if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN; - if (EQ (layout_obj, Qinside_margin)) return GL_INSIDE_MARGIN; - if (EQ (layout_obj, Qwhitespace)) return GL_WHITESPACE; - if (EQ (layout_obj, Qtext)) return GL_TEXT; - - signal_simple_error ("Unknown glyph layout type", layout_obj); - return GL_TEXT; /* unreached */ -} - -static Lisp_Object -set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp, - Lisp_Object layout_obj) -{ - EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER); - glyph_layout layout = symbol_to_glyph_layout (layout_obj); - - /* Make sure we've actually been given a glyph or it's nil (meaning - we're deleting a glyph from an extent). */ - if (!NILP (glyph)) - CHECK_GLYPH (glyph); - - set_extent_glyph (extent, glyph, endp, layout); - return glyph; -} - -DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /* -Display a bitmap, subwindow or string at the beginning of EXTENT. -BEGIN-GLYPH must be a glyph object. The layout policy defaults to `text'. -*/ - (extent, begin_glyph, layout)) -{ - return set_extent_glyph_1 (extent, begin_glyph, 0, layout); -} - -DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /* -Display a bitmap, subwindow or string at the end of EXTENT. -END-GLYPH must be a glyph object. The layout policy defaults to `text'. -*/ - (extent, end_glyph, layout)) -{ - return set_extent_glyph_1 (extent, end_glyph, 1, layout); -} - -DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /* -Return the glyph object displayed at the beginning of EXTENT. -If there is none, nil is returned. -*/ - (extent)) -{ - return extent_begin_glyph (decode_extent (extent, 0)); -} - -DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /* -Return the glyph object displayed at the end of EXTENT. -If there is none, nil is returned. -*/ - (extent)) -{ - return extent_end_glyph (decode_extent (extent, 0)); -} - -DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /* -Set the layout policy of EXTENT's begin glyph. -Access this using the `extent-begin-glyph-layout' function. -*/ - (extent, layout)) -{ - EXTENT e = decode_extent (extent, 0); - e = extent_ancestor (e); - extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout); - extent_maybe_changed_for_redisplay (e, 1, 0); - return layout; -} - -DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /* -Set the layout policy of EXTENT's end glyph. -Access this using the `extent-end-glyph-layout' function. -*/ - (extent, layout)) -{ - EXTENT e = decode_extent (extent, 0); - e = extent_ancestor (e); - extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout); - extent_maybe_changed_for_redisplay (e, 1, 0); - return layout; -} - -DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /* -Return the layout policy associated with EXTENT's begin glyph. -Set this using the `set-extent-begin-glyph-layout' function. -*/ - (extent)) -{ - EXTENT e = decode_extent (extent, 0); - return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e)); -} - -DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /* -Return the layout policy associated with EXTENT's end glyph. -Set this using the `set-extent-end-glyph-layout' function. -*/ - (extent)) -{ - EXTENT e = decode_extent (extent, 0); - return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e)); -} - -DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /* -Set the display priority of EXTENT to PRIORITY (an integer). -When the extent attributes are being merged for display, the priority -is used to determine which extent takes precedence in the event of a -conflict (two extents whose faces both specify font, for example: the -font of the extent with the higher priority will be used). -Extents are created with priority 0; priorities may be negative. -*/ - (extent, priority)) -{ - EXTENT e = decode_extent (extent, 0); - - CHECK_INT (priority); - e = extent_ancestor (e); - set_extent_priority (e, XINT (priority)); - extent_maybe_changed_for_redisplay (e, 1, 0); - return priority; -} - -DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /* -Return the display priority of EXTENT; see `set-extent-priority'. -*/ - (extent)) -{ - EXTENT e = decode_extent (extent, 0); - return make_int (extent_priority (e)); -} - -DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /* -Change a property of an extent. -PROPERTY may be any symbol; the value stored may be accessed with - the `extent-property' function. -The following symbols have predefined meanings: - - detached Removes the extent from its buffer; setting this is - the same as calling `detach-extent'. - - destroyed Removes the extent from its buffer, and makes it - unusable in the future; this is the same calling - `delete-extent'. - - priority Change redisplay priority; same as `set-extent-priority'. - - start-open Whether the set of characters within the extent is - treated being open on the left, that is, whether - the start position is an exclusive, rather than - inclusive, boundary. If true, then characters - inserted exactly at the beginning of the extent - will remain outside of the extent; otherwise they - will go into the extent, extending it. - - end-open Whether the set of characters within the extent is - treated being open on the right, that is, whether - the end position is an exclusive, rather than - inclusive, boundary. If true, then characters - inserted exactly at the end of the extent will - remain outside of the extent; otherwise they will - go into the extent, extending it. - - By default, extents have the `end-open' but not the - `start-open' property set. - - read-only Text within this extent will be unmodifiable. - - initial-redisplay-function (EXPERIMENTAL) - function to be called the first time (part of) the extent - is redisplayed. It will be called with the extent as its - first argument. - Note: The function will not be called immediately - during redisplay, an eval event will be dispatched. - - detachable Whether the extent gets detached (as with - `detach-extent') when all the text within the - extent is deleted. This is true by default. If - this property is not set, the extent becomes a - zero-length extent when its text is deleted. (In - such a case, the `start-open' property is - automatically removed if both the `start-open' and - `end-open' properties are set, since zero-length - extents open on both ends are not allowed.) - - face The face in which to display the text. Setting - this is the same as calling `set-extent-face'. - - mouse-face If non-nil, the extent will be highlighted in this - face when the mouse moves over it. - - pointer If non-nil, and a valid pointer glyph, this specifies - the shape of the mouse pointer while over the extent. - - highlight Obsolete: Setting this property is equivalent to - setting a `mouse-face' property of `highlight'. - Reading this property returns non-nil if - the extent has a non-nil `mouse-face' property. - - duplicable Whether this extent should be copied into strings, - so that kill, yank, and undo commands will restore - or copy it. `duplicable' extents are copied from - an extent into a string when `buffer-substring' or - a similar function creates a string. The extents - in a string are copied into other strings created - from the string using `concat' or `substring'. - When `insert' or a similar function inserts the - string into a buffer, the extents are copied back - into the buffer. - - unique Meaningful only in conjunction with `duplicable'. - When this is set, there may be only one instance - of this extent attached at a time: if it is copied - to the kill ring and then yanked, the extent is - not copied. If, however, it is killed (removed - from the buffer) and then yanked, it will be - re-attached at the new position. - - invisible If the value is non-nil, text under this extent - may be treated as not present for the purpose of - redisplay, or may be displayed using an ellipsis - or other marker; see `buffer-invisibility-spec' - and `invisible-text-glyph'. In all cases, - however, the text is still visible to other - functions that examine a buffer's text. - - keymap This keymap is consulted for mouse clicks on this - extent, or keypresses made while point is within the - extent. - - copy-function This is a hook that is run when a duplicable extent - is about to be copied from a buffer to a string (or - the kill ring). It is called with three arguments, - the extent, and the buffer-positions within it - which are being copied. If this function returns - nil, then the extent will not be copied; otherwise - it will. - - paste-function This is a hook that is run when a duplicable extent is - about to be copied from a string (or the kill ring) - into a buffer. It is called with three arguments, - the original extent, and the buffer positions which - the copied extent will occupy. (This hook is run - after the corresponding text has already been - inserted into the buffer.) Note that the extent - argument may be detached when this function is run. - If this function returns nil, no extent will be - inserted. Otherwise, there will be an extent - covering the range in question. - - If the original extent is not attached to a buffer, - then it will be re-attached at this range. - Otherwise, a copy will be made, and that copy - attached here. - - The copy-function and paste-function are meaningful - only for extents with the `duplicable' flag set, - and if they are not specified, behave as if `t' was - the returned value. When these hooks are invoked, - the current buffer is the buffer which the extent - is being copied from/to, respectively. - - begin-glyph A glyph to be displayed at the beginning of the extent, - or nil. - - end-glyph A glyph to be displayed at the end of the extent, - or nil. - - begin-glyph-layout The layout policy (one of `text', `whitespace', - `inside-margin', or `outside-margin') of the extent's - begin glyph. - - end-glyph-layout The layout policy of the extent's end glyph. -*/ - (extent, property, value)) -{ - /* This function can GC if property is `keymap' */ - EXTENT e = decode_extent (extent, 0); - - if (EQ (property, Qread_only)) - set_extent_read_only (e, value); - else if (EQ (property, Qunique)) - extent_unique_p (e) = !NILP (value); - else if (EQ (property, Qduplicable)) - extent_duplicable_p (e) = !NILP (value); - else if (EQ (property, Qinvisible)) - set_extent_invisible (e, value); - else if (EQ (property, Qdetachable)) - extent_detachable_p (e) = !NILP (value); - - else if (EQ (property, Qdetached)) - { - if (NILP (value)) - error ("can only set `detached' to t"); - Fdetach_extent (extent); - } - else if (EQ (property, Qdestroyed)) - { - if (NILP (value)) - error ("can only set `destroyed' to t"); - Fdelete_extent (extent); - } - else if (EQ (property, Qpriority)) - Fset_extent_priority (extent, value); - else if (EQ (property, Qface)) - Fset_extent_face (extent, value); - else if (EQ (property, Qinitial_redisplay_function)) - Fset_extent_initial_redisplay_function (extent, value); - else if (EQ (property, Qbefore_change_functions)) - set_extent_before_change_functions (e, value); - else if (EQ (property, Qafter_change_functions)) - set_extent_after_change_functions (e, value); - else if (EQ (property, Qmouse_face)) - Fset_extent_mouse_face (extent, value); - /* Obsolete: */ - else if (EQ (property, Qhighlight)) - Fset_extent_mouse_face (extent, Qhighlight); - else if (EQ (property, Qbegin_glyph_layout)) - Fset_extent_begin_glyph_layout (extent, value); - else if (EQ (property, Qend_glyph_layout)) - Fset_extent_end_glyph_layout (extent, value); - /* For backwards compatibility. We use begin glyph because it is by - far the more used of the two. */ - else if (EQ (property, Qglyph_layout)) - Fset_extent_begin_glyph_layout (extent, value); - else if (EQ (property, Qbegin_glyph)) - Fset_extent_begin_glyph (extent, value, Qnil); - else if (EQ (property, Qend_glyph)) - Fset_extent_end_glyph (extent, value, Qnil); - else if (EQ (property, Qstart_open)) - set_extent_openness (e, !NILP (value), -1); - else if (EQ (property, Qend_open)) - set_extent_openness (e, -1, !NILP (value)); - /* Support (but don't document...) the obvious *_closed antonyms. */ - else if (EQ (property, Qstart_closed)) - set_extent_openness (e, NILP (value), -1); - else if (EQ (property, Qend_closed)) - set_extent_openness (e, -1, NILP (value)); - else - { - if (EQ (property, Qkeymap)) - while (!NILP (value) && NILP (Fkeymapp (value))) - value = wrong_type_argument (Qkeymapp, value); - - external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME); - } - - return value; -} - -DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /* -Change some properties of EXTENT. -PLIST is a property list. -For a list of built-in properties, see `set-extent-property'. -*/ - (extent, plist)) -{ - /* This function can GC, if one of the properties is `keymap' */ - Lisp_Object property, value; - struct gcpro gcpro1; - GCPRO1 (plist); - - plist = Fcopy_sequence (plist); - Fcanonicalize_plist (plist, Qnil); - - while (!NILP (plist)) - { - property = Fcar (plist); plist = Fcdr (plist); - value = Fcar (plist); plist = Fcdr (plist); - Fset_extent_property (extent, property, value); - } - UNGCPRO; - return Qnil; -} - -DEFUN ("extent-property", Fextent_property, 2, 3, 0, /* -Return EXTENT's value for property PROPERTY. -See `set-extent-property' for the built-in property names. -*/ - (extent, property, default_)) -{ - EXTENT e = decode_extent (extent, 0); - - if (EQ (property, Qdetached)) - return extent_detached_p (e) ? Qt : Qnil; - else if (EQ (property, Qdestroyed)) - return !EXTENT_LIVE_P (e) ? Qt : Qnil; - else if (EQ (property, Qstart_open)) - return extent_normal_field (e, start_open) ? Qt : Qnil; - else if (EQ (property, Qend_open)) - return extent_normal_field (e, end_open) ? Qt : Qnil; - else if (EQ (property, Qunique)) - return extent_normal_field (e, unique) ? Qt : Qnil; - else if (EQ (property, Qduplicable)) - return extent_normal_field (e, duplicable) ? Qt : Qnil; - else if (EQ (property, Qdetachable)) - return extent_normal_field (e, detachable) ? Qt : Qnil; - /* Support (but don't document...) the obvious *_closed antonyms. */ - else if (EQ (property, Qstart_closed)) - return extent_start_open_p (e) ? Qnil : Qt; - else if (EQ (property, Qend_closed)) - return extent_end_open_p (e) ? Qnil : Qt; - else if (EQ (property, Qpriority)) - return make_int (extent_priority (e)); - else if (EQ (property, Qread_only)) - return extent_read_only (e); - else if (EQ (property, Qinvisible)) - return extent_invisible (e); - else if (EQ (property, Qface)) - return Fextent_face (extent); - else if (EQ (property, Qinitial_redisplay_function)) - return extent_initial_redisplay_function (e); - else if (EQ (property, Qbefore_change_functions)) - return extent_before_change_functions (e); - else if (EQ (property, Qafter_change_functions)) - return extent_after_change_functions (e); - else if (EQ (property, Qmouse_face)) - return Fextent_mouse_face (extent); - /* Obsolete: */ - else if (EQ (property, Qhighlight)) - return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil; - else if (EQ (property, Qbegin_glyph_layout)) - return Fextent_begin_glyph_layout (extent); - else if (EQ (property, Qend_glyph_layout)) - return Fextent_end_glyph_layout (extent); - /* For backwards compatibility. We use begin glyph because it is by - far the more used of the two. */ - else if (EQ (property, Qglyph_layout)) - return Fextent_begin_glyph_layout (extent); - else if (EQ (property, Qbegin_glyph)) - return extent_begin_glyph (e); - else if (EQ (property, Qend_glyph)) - return extent_end_glyph (e); - else - { - Lisp_Object value = external_plist_get (extent_plist_addr (e), - property, 0, ERROR_ME); - return UNBOUNDP (value) ? default_ : value; - } -} - -DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /* -Return a property list of the attributes of EXTENT. -Do not modify this list; use `set-extent-property' instead. -*/ - (extent)) -{ - EXTENT e, anc; - Lisp_Object result, face, anc_obj; - glyph_layout layout; - - CHECK_EXTENT (extent); - e = XEXTENT (extent); - if (!EXTENT_LIVE_P (e)) - return cons3 (Qdestroyed, Qt, Qnil); - - anc = extent_ancestor (e); - XSETEXTENT (anc_obj, anc); - - /* For efficiency, use the ancestor for all properties except detached */ - - result = extent_plist_slot (anc); - - if (!NILP (face = Fextent_face (anc_obj))) - result = cons3 (Qface, face, result); - - if (!NILP (face = Fextent_mouse_face (anc_obj))) - result = cons3 (Qmouse_face, face, result); - - if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT) - { - Lisp_Object sym = glyph_layout_to_symbol (layout); - result = cons3 (Qglyph_layout, sym, result); /* compatibility */ - result = cons3 (Qbegin_glyph_layout, sym, result); - } - - if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT) - result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result); - - if (!NILP (extent_end_glyph (anc))) - result = cons3 (Qend_glyph, extent_end_glyph (anc), result); - - if (!NILP (extent_begin_glyph (anc))) - result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result); - - if (extent_priority (anc) != 0) - result = cons3 (Qpriority, make_int (extent_priority (anc)), result); - - if (!NILP (extent_initial_redisplay_function (anc))) - result = cons3 (Qinitial_redisplay_function, - extent_initial_redisplay_function (anc), result); - - if (!NILP (extent_before_change_functions (anc))) - result = cons3 (Qbefore_change_functions, - extent_before_change_functions (anc), result); - - if (!NILP (extent_after_change_functions (anc))) - result = cons3 (Qafter_change_functions, - extent_after_change_functions (anc), result); - - if (!NILP (extent_invisible (anc))) - result = cons3 (Qinvisible, extent_invisible (anc), result); - - if (!NILP (extent_read_only (anc))) - result = cons3 (Qread_only, extent_read_only (anc), result); - - if (extent_normal_field (anc, end_open)) - result = cons3 (Qend_open, Qt, result); - - if (extent_normal_field (anc, start_open)) - result = cons3 (Qstart_open, Qt, result); - - if (extent_normal_field (anc, detachable)) - result = cons3 (Qdetachable, Qt, result); - - if (extent_normal_field (anc, duplicable)) - result = cons3 (Qduplicable, Qt, result); - - if (extent_normal_field (anc, unique)) - result = cons3 (Qunique, Qt, result); - - /* detached is not an inherited property */ - if (extent_detached_p (e)) - result = cons3 (Qdetached, Qt, result); - - return result; -} - - -/************************************************************************/ -/* highlighting */ -/************************************************************************/ - -/* The display code looks into the Vlast_highlighted_extent variable to - correctly display highlighted extents. This updates that variable, - and marks the appropriate buffers as needing some redisplay. - */ -static void -do_highlight (Lisp_Object extent_obj, int highlight_p) -{ - if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) || - (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil)))) - return; - if (EXTENTP (Vlast_highlighted_extent) && - EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent))) - { - /* do not recurse on descendants. Only one extent is highlighted - at a time. */ - extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0); - } - Vlast_highlighted_extent = Qnil; - if (!NILP (extent_obj) - && BUFFERP (extent_object (XEXTENT (extent_obj))) - && highlight_p) - { - extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0); - Vlast_highlighted_extent = extent_obj; - } -} - -DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /* -Highlight or unhighlight the given extent. -If the second arg is non-nil, it will be highlighted, else dehighlighted. -This is the same as `highlight-extent', except that it will work even -on extents without the `mouse-face' property. -*/ - (extent, highlight_p)) -{ - if (NILP (extent)) - highlight_p = Qnil; - else - XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED)); - do_highlight (extent, !NILP (highlight_p)); - return Qnil; -} - -DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /* -Highlight EXTENT, if it is highlightable. -\(that is, if it has the `mouse-face' property). -If the second arg is non-nil, it will be highlighted, else dehighlighted. -Highlighted extents are displayed as if they were merged with the face -or faces specified by the `mouse-face' property. -*/ - (extent, highlight_p)) -{ - if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent)))) - return Qnil; - else - return Fforce_highlight_extent (extent, highlight_p); -} - - -/************************************************************************/ -/* strings and extents */ -/************************************************************************/ - -/* copy/paste hooks */ - -static int -run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to, - Lisp_Object object, - Lisp_Object prop) -{ - /* This function can GC */ - Lisp_Object extent; - Lisp_Object copy_fn; - XSETEXTENT (extent, e); - copy_fn = Fextent_property (extent, prop, Qnil); - if (!NILP (copy_fn)) - { - Lisp_Object flag; - struct gcpro gcpro1, gcpro2, gcpro3; - GCPRO3 (extent, copy_fn, object); - if (BUFFERP (object)) - flag = call3_in_buffer (XBUFFER (object), copy_fn, extent, - make_int (from), make_int (to)); - else - flag = call3 (copy_fn, extent, make_int (from), make_int (to)); - UNGCPRO; - if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent))) - return 0; - } - return 1; -} - -static int -run_extent_copy_function (EXTENT e, Bytind from, Bytind to) -{ - Lisp_Object object = extent_object (e); - /* This function can GC */ - return run_extent_copy_paste_internal - (e, buffer_or_string_bytind_to_bufpos (object, from), - buffer_or_string_bytind_to_bufpos (object, to), object, - Qcopy_function); -} - -static int -run_extent_paste_function (EXTENT e, Bytind from, Bytind to, - Lisp_Object object) -{ - /* This function can GC */ - return run_extent_copy_paste_internal - (e, buffer_or_string_bytind_to_bufpos (object, from), - buffer_or_string_bytind_to_bufpos (object, to), object, - Qpaste_function); -} - -static void -update_extent (EXTENT extent, Bytind from, Bytind to) -{ - set_extent_endpoints (extent, from, to, Qnil); -} - -/* Insert an extent, usually from the dup_list of a string which - has just been inserted. - This code does not handle the case of undo. - */ -static Lisp_Object -insert_extent (EXTENT extent, Bytind new_start, Bytind new_end, - Lisp_Object object, int run_hooks) -{ - /* This function can GC */ - Lisp_Object tmp; - - if (!EQ (extent_object (extent), object)) - goto copy_it; - - if (extent_detached_p (extent)) - { - if (run_hooks && - !run_extent_paste_function (extent, new_start, new_end, object)) - /* The paste-function said don't re-attach this extent here. */ - return Qnil; - else - update_extent (extent, new_start, new_end); - } - else - { - Bytind exstart = extent_endpoint_bytind (extent, 0); - Bytind exend = extent_endpoint_bytind (extent, 1); - - if (exend < new_start || exstart > new_end) - goto copy_it; - else - { - new_start = min (exstart, new_start); - new_end = max (exend, new_end); - if (exstart != new_start || exend != new_end) - update_extent (extent, new_start, new_end); - } - } - - XSETEXTENT (tmp, extent); - return tmp; - - copy_it: - if (run_hooks && - !run_extent_paste_function (extent, new_start, new_end, object)) - /* The paste-function said don't attach a copy of the extent here. */ - return Qnil; - else - { - XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object)); - return tmp; - } -} - -DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /* -Insert EXTENT from START to END in BUFFER-OR-STRING. -BUFFER-OR-STRING defaults to the current buffer if omitted. -This operation does not insert any characters, -but otherwise acts as if there were a replicating extent whose -parent is EXTENT in some string that was just inserted. -Returns the newly-inserted extent. -The fourth arg, NO-HOOKS, can be used to inhibit the running of the - extent's `paste-function' property if it has one. -See documentation on `detach-extent' for a discussion of undo recording. -*/ - (extent, start, end, no_hooks, buffer_or_string)) -{ - EXTENT ext = decode_extent (extent, 0); - Lisp_Object copy; - Bytind s, e; - - buffer_or_string = decode_buffer_or_string (buffer_or_string); - get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e, - GB_ALLOW_PAST_ACCESSIBLE); - - copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks)); - if (EXTENTP (copy)) - { - if (extent_duplicable_p (XEXTENT (copy))) - record_extent (copy, 1); - } - return copy; -} - - -/* adding buffer extents to a string */ - -struct add_string_extents_arg -{ - Bytind from; - Bytecount length; - Lisp_Object string; -}; - -static int -add_string_extents_mapper (EXTENT extent, void *arg) -{ - /* This function can GC */ - struct add_string_extents_arg *closure = - (struct add_string_extents_arg *) arg; - Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from; - Bytecount end = extent_endpoint_bytind (extent, 1) - closure->from; - - if (extent_duplicable_p (extent)) - { - start = max (start, 0); - end = min (end, closure->length); - - /* Run the copy-function to give an extent the option of - not being copied into the string (or kill ring). - */ - if (extent_duplicable_p (extent) && - !run_extent_copy_function (extent, start + closure->from, - end + closure->from)) - return 0; - copy_extent (extent, start, end, closure->string); - } - - return 0; -} - -/* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to - the string STRING. */ -void -add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint, - Bytecount length) -{ - /* This function can GC */ - struct add_string_extents_arg closure; - struct gcpro gcpro1, gcpro2; - Lisp_Object buffer; - - closure.from = opoint; - closure.length = length; - closure.string = string; - buffer = make_buffer (buf); - GCPRO2 (buffer, string); - map_extents_bytind (opoint, opoint + length, add_string_extents_mapper, - (void *) &closure, buffer, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); - UNGCPRO; -} - -struct splice_in_string_extents_arg -{ - Bytecount pos; - Bytecount length; - Bytind opoint; - Lisp_Object buffer; -}; - -static int -splice_in_string_extents_mapper (EXTENT extent, void *arg) -{ - /* This function can GC */ - struct splice_in_string_extents_arg *closure = - (struct splice_in_string_extents_arg *) arg; - /* BASE_START and BASE_END are the limits in the buffer of the string - that was just inserted. - - NEW_START and NEW_END are the prospective buffer positions of the - extent that is going into the buffer. */ - Bytind base_start = closure->opoint; - Bytind base_end = base_start + closure->length; - Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) - - closure->pos); - Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) - - closure->pos); - - if (new_start < base_start) - new_start = base_start; - if (new_end > base_end) - new_end = base_end; - if (new_end <= new_start) - return 0; - - if (!extent_duplicable_p (extent)) - return 0; - - if (!inside_undo && - !run_extent_paste_function (extent, new_start, new_end, - closure->buffer)) - return 0; - copy_extent (extent, new_start, new_end, closure->buffer); - - return 0; -} - -/* We have just inserted a section of STRING (starting at POS, of - length LENGTH) into buffer BUF at OPOINT. Do whatever is necessary - to get the string's extents into the buffer. */ - -void -splice_in_string_extents (Lisp_Object string, struct buffer *buf, - Bytind opoint, Bytecount length, Bytecount pos) -{ - struct splice_in_string_extents_arg closure; - struct gcpro gcpro1, gcpro2; - Lisp_Object buffer; - - buffer = make_buffer (buf); - closure.opoint = opoint; - closure.pos = pos; - closure.length = length; - closure.buffer = buffer; - GCPRO2 (buffer, string); - map_extents_bytind (pos, pos + length, - splice_in_string_extents_mapper, - (void *) &closure, string, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); - UNGCPRO; -} - -struct copy_string_extents_arg -{ - Bytecount new_pos; - Bytecount old_pos; - Bytecount length; - Lisp_Object new_string; -}; - -struct copy_string_extents_1_arg -{ - Lisp_Object parent_in_question; - EXTENT found_extent; -}; - -static int -copy_string_extents_mapper (EXTENT extent, void *arg) -{ - struct copy_string_extents_arg *closure = - (struct copy_string_extents_arg *) arg; - Bytecount old_start, old_end, new_start, new_end; - - old_start = extent_endpoint_bytind (extent, 0); - old_end = extent_endpoint_bytind (extent, 1); - - old_start = max (closure->old_pos, old_start); - old_end = min (closure->old_pos + closure->length, old_end); - - if (old_start >= old_end) - return 0; - - new_start = old_start + closure->new_pos - closure->old_pos; - new_end = old_end + closure->new_pos - closure->old_pos; - - copy_extent (extent, new_start, new_end, closure->new_string); - return 0; -} - -/* The string NEW_STRING was partially constructed from OLD_STRING. - In particular, the section of length LEN starting at NEW_POS in - NEW_STRING came from the section of the same length starting at - OLD_POS in OLD_STRING. Copy the extents as appropriate. */ - -void -copy_string_extents (Lisp_Object new_string, Lisp_Object old_string, - Bytecount new_pos, Bytecount old_pos, - Bytecount length) -{ - struct copy_string_extents_arg closure; - struct gcpro gcpro1, gcpro2; - - closure.new_pos = new_pos; - closure.old_pos = old_pos; - closure.new_string = new_string; - closure.length = length; - GCPRO2 (new_string, old_string); - map_extents_bytind (old_pos, old_pos + length, - copy_string_extents_mapper, - (void *) &closure, old_string, 0, - /* ignore extents that just abut the region */ - ME_END_CLOSED | ME_ALL_EXTENTS_OPEN | - /* we are calling E-Lisp (the extent's copy function) - so anything might happen */ - ME_MIGHT_CALL_ELISP); - UNGCPRO; -} - -/* Checklist for sanity checking: - - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent - - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer - */ - - -/************************************************************************/ -/* text properties */ -/************************************************************************/ - -/* Text properties - Originally this stuff was implemented in lisp (all of the functionality - exists to make that possible) but speed was a problem. - */ - -Lisp_Object Qtext_prop; -Lisp_Object Qtext_prop_extent_paste_function; - -static Lisp_Object -get_text_property_bytind (Bytind position, Lisp_Object prop, - Lisp_Object object, enum extent_at_flag fl, - int text_props_only) -{ - Lisp_Object extent; - - /* text_props_only specifies whether we only consider text-property - extents (those with the 'text-prop property set) or all extents. */ - if (!text_props_only) - extent = extent_at_bytind (position, object, prop, 0, fl); - else - { - EXTENT prior = 0; - while (1) - { - extent = extent_at_bytind (position, object, Qtext_prop, prior, - fl); - if (NILP (extent)) - return Qnil; - if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil))) - break; - prior = XEXTENT (extent); - } - } - - if (!NILP (extent)) - return Fextent_property (extent, prop, Qnil); - if (!NILP (Vdefault_text_properties)) - return Fplist_get (Vdefault_text_properties, prop, Qnil); - return Qnil; -} - -static Lisp_Object -get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object, - Lisp_Object at_flag, int text_props_only) -{ - Bytind position; - int invert = 0; - - object = decode_buffer_or_string (object); - position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD); - - /* We canonicalize the start/end-open/closed properties to the - non-default version -- "adding" the default property really - needs to remove the non-default one. See below for more - on this. */ - if (EQ (prop, Qstart_closed)) - { - prop = Qstart_open; - invert = 1; - } - - if (EQ (prop, Qend_open)) - { - prop = Qend_closed; - invert = 1; - } - - { - Lisp_Object val = - get_text_property_bytind (position, prop, object, - decode_extent_at_flag (at_flag), - text_props_only); - if (invert) - val = NILP (val) ? Qt : Qnil; - return val; - } -} - -DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /* -Return the value of the PROP property at the given position. -Optional arg OBJECT specifies the buffer or string to look in, and - defaults to the current buffer. -Optional arg AT-FLAG controls what it means for a property to be "at" - a position, and has the same meaning as in `extent-at'. -This examines only those properties added with `put-text-property'. -See also `get-char-property'. -*/ - (pos, prop, object, at_flag)) -{ - return get_text_property_1 (pos, prop, object, at_flag, 1); -} - -DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /* -Return the value of the PROP property at the given position. -Optional arg OBJECT specifies the buffer or string to look in, and - defaults to the current buffer. -Optional arg AT-FLAG controls what it means for a property to be "at" - a position, and has the same meaning as in `extent-at'. -This examines properties on all extents. -See also `get-text-property'. -*/ - (pos, prop, object, at_flag)) -{ - return get_text_property_1 (pos, prop, object, at_flag, 0); -} - -/* About start/end-open/closed: - - These properties have to be handled specially because of their - strange behavior. If I put the "start-open" property on a region, - then *all* text-property extents in the region have to have their - start be open. This is unlike all other properties, which don't - affect the extents of text properties other than their own. - - So: - - 1) We have to map start-closed to (not start-open) and end-open - to (not end-closed) -- i.e. adding the default is really the - same as remove the non-default property. It won't work, for - example, to have both "start-open" and "start-closed" on - the same region. - 2) Whenever we add one of these properties, we go through all - text-property extents in the region and set the appropriate - open/closedness on them. - 3) Whenever we change a text-property extent for a property, - we have to make sure we set the open/closedness properly. - - (2) and (3) together rely on, and maintain, the invariant - that the open/closedness of text-property extents is correct - at the beginning and end of each operation. - */ - -struct put_text_prop_arg -{ - Lisp_Object prop, value; /* The property and value we are storing */ - Bytind start, end; /* The region into which we are storing it */ - Lisp_Object object; - Lisp_Object the_extent; /* Our chosen extent; this is used for - communication between subsequent passes. */ - int changed_p; /* Output: whether we have modified anything */ -}; - -static int -put_text_prop_mapper (EXTENT e, void *arg) -{ - struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; - - Lisp_Object object = closure->object; - Lisp_Object value = closure->value; - Bytind e_start, e_end; - Bytind start = closure->start; - Bytind end = closure->end; - Lisp_Object extent, e_val; - int is_eq; - - XSETEXTENT (extent, e); - - /* Note: in some cases when the property itself is 'start-open - or 'end-closed, the checks to set the openness may do a bit - of extra work; but it won't hurt because we then fix up the - openness later on in put_text_prop_openness_mapper(). */ - if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop)) - /* It's not for this property; do nothing. */ - return 0; - - e_start = extent_endpoint_bytind (e, 0); - e_end = extent_endpoint_bytind (e, 1); - e_val = Fextent_property (extent, closure->prop, Qnil); - is_eq = EQ (value, e_val); - - if (!NILP (value) && NILP (closure->the_extent) && is_eq) - { - /* We want there to be an extent here at the end, and we haven't picked - one yet, so use this one. Extend it as necessary. We only reuse an - extent which has an EQ value for the prop in question to avoid - side-effecting the kill ring (that is, we never change the property - on an extent after it has been created.) - */ - if (e_start != start || e_end != end) - { - Bytind new_start = min (e_start, start); - Bytind new_end = max (e_end, end); - set_extent_endpoints (e, new_start, new_end, Qnil); - /* If we changed the endpoint, then we need to set its - openness. */ - set_extent_openness (e, new_start != e_start - ? !NILP (get_text_property_bytind - (start, Qstart_open, object, - EXTENT_AT_AFTER, 1)) : -1, - new_end != e_end - ? NILP (get_text_property_bytind - (end - 1, Qend_closed, object, - EXTENT_AT_AFTER, 1)) - : -1); - closure->changed_p = 1; - } - closure->the_extent = extent; - } - - /* Even if we're adding a prop, at this point, we want all other extents of - this prop to go away (as now they overlap). So the theory here is that, - when we are adding a prop to a region that has multiple (disjoint) - occurrences of that prop in it already, we pick one of those and extend - it, and remove the others. - */ - - else if (EQ (extent, closure->the_extent)) - { - /* just in case map-extents hits it again (does that happen?) */ - ; - } - else if (e_start >= start && e_end <= end) - { - /* Extent is contained in region; remove it. Don't destroy or modify - it, because we don't want to change the attributes pointed to by the - duplicates in the kill ring. - */ - extent_detach (e); - closure->changed_p = 1; - } - else if (!NILP (closure->the_extent) && - is_eq && - e_start <= end && - e_end >= start) - { - EXTENT te = XEXTENT (closure->the_extent); - /* This extent overlaps, and has the same prop/value as the extent we've - decided to reuse, so we can remove this existing extent as well (the - whole thing, even the part outside of the region) and extend - the-extent to cover it, resulting in the minimum number of extents in - the buffer. - */ - Bytind the_start = extent_endpoint_bytind (te, 0); - Bytind the_end = extent_endpoint_bytind (te, 1); - if (e_start != the_start && /* note AND not OR -- hmm, why is this - the case? I think it's because the - assumption that the text-property - extents don't overlap makes it - OK; changing it to an OR would - result in changed_p sometimes getting - falsely marked. Is this bad? */ - e_end != the_end) - { - Bytind new_start = min (e_start, the_start); - Bytind new_end = max (e_end, the_end); - set_extent_endpoints (te, new_start, new_end, Qnil); - /* If we changed the endpoint, then we need to set its - openness. We are setting the endpoint to be the same as - that of the extent we're about to remove, and we assume - (the invariant mentioned above) that extent has the - proper endpoint setting, so we just use it. */ - set_extent_openness (te, new_start != e_start ? - (int) extent_start_open_p (e) : -1, - new_end != e_end ? - (int) extent_end_open_p (e) : -1); - closure->changed_p = 1; - } - extent_detach (e); - } - else if (e_end <= end) - { - /* Extent begins before start but ends before end, so we can just - decrease its end position. - */ - if (e_end != start) - { - set_extent_endpoints (e, e_start, start, Qnil); - set_extent_openness (e, -1, NILP (get_text_property_bytind - (start - 1, Qend_closed, object, - EXTENT_AT_AFTER, 1))); - closure->changed_p = 1; - } - } - else if (e_start >= start) - { - /* Extent ends after end but begins after start, so we can just - increase its start position. - */ - if (e_start != end) - { - set_extent_endpoints (e, end, e_end, Qnil); - set_extent_openness (e, !NILP (get_text_property_bytind - (end, Qstart_open, object, - EXTENT_AT_AFTER, 1)), -1); - closure->changed_p = 1; - } - } - else - { - /* Otherwise, `extent' straddles the region. We need to split it. - */ - set_extent_endpoints (e, e_start, start, Qnil); - set_extent_openness (e, -1, NILP (get_text_property_bytind - (start - 1, Qend_closed, object, - EXTENT_AT_AFTER, 1))); - set_extent_openness (copy_extent (e, end, e_end, extent_object (e)), - !NILP (get_text_property_bytind - (end, Qstart_open, object, - EXTENT_AT_AFTER, 1)), -1); - closure->changed_p = 1; - } - - return 0; /* to continue mapping. */ -} - -static int -put_text_prop_openness_mapper (EXTENT e, void *arg) -{ - struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg; - Bytind e_start, e_end; - Bytind start = closure->start; - Bytind end = closure->end; - Lisp_Object extent; - XSETEXTENT (extent, e); - e_start = extent_endpoint_bytind (e, 0); - e_end = extent_endpoint_bytind (e, 1); - - if (NILP (Fextent_property (extent, Qtext_prop, Qnil))) - { - /* It's not a text-property extent; do nothing. */ - ; - } - /* Note end conditions and NILP/!NILP's carefully. */ - else if (EQ (closure->prop, Qstart_open) - && e_start >= start && e_start < end) - set_extent_openness (e, !NILP (closure->value), -1); - else if (EQ (closure->prop, Qend_closed) - && e_end > start && e_end <= end) - set_extent_openness (e, -1, NILP (closure->value)); - - return 0; /* to continue mapping. */ -} - -static int -put_text_prop (Bytind start, Bytind end, Lisp_Object object, - Lisp_Object prop, Lisp_Object value, - int duplicable_p) -{ - /* This function can GC */ - struct put_text_prop_arg closure; - - if (start == end) /* There are no characters in the region. */ - return 0; - - /* convert to the non-default versions, since a nil property is - the same as it not being present. */ - if (EQ (prop, Qstart_closed)) - { - prop = Qstart_open; - value = NILP (value) ? Qt : Qnil; - } - else if (EQ (prop, Qend_open)) - { - prop = Qend_closed; - value = NILP (value) ? Qt : Qnil; - } - - value = canonicalize_extent_property (prop, value); - - closure.prop = prop; - closure.value = value; - closure.start = start; - closure.end = end; - closure.object = object; - closure.changed_p = 0; - closure.the_extent = Qnil; - - map_extents_bytind (start, end, - put_text_prop_mapper, - (void *) &closure, object, 0, - /* get all extents that abut the region */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - /* it might QUIT or error if the user has - fucked with the extent plist. */ - /* #### dmoore - I think this should include - ME_MIGHT_MOVE_SOE, since the callback function - might recurse back into map_extents_bytind. */ - ME_MIGHT_THROW | - ME_MIGHT_MODIFY_EXTENTS); - - /* If we made it through the loop without reusing an extent - (and we want there to be one) make it now. - */ - if (!NILP (value) && NILP (closure.the_extent)) - { - Lisp_Object extent; - - XSETEXTENT (extent, make_extent_internal (object, start, end)); - closure.changed_p = 1; - Fset_extent_property (extent, Qtext_prop, prop); - Fset_extent_property (extent, prop, value); - if (duplicable_p) - { - extent_duplicable_p (XEXTENT (extent)) = 1; - Fset_extent_property (extent, Qpaste_function, - Qtext_prop_extent_paste_function); - } - set_extent_openness (XEXTENT (extent), - !NILP (get_text_property_bytind - (start, Qstart_open, object, - EXTENT_AT_AFTER, 1)), - NILP (get_text_property_bytind - (end - 1, Qend_closed, object, - EXTENT_AT_AFTER, 1))); - } - - if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed)) - { - map_extents_bytind (start, end, - put_text_prop_openness_mapper, - (void *) &closure, object, 0, - /* get all extents that abut the region */ - ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED | - ME_MIGHT_MODIFY_EXTENTS); - } - - return closure.changed_p; -} - -DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /* -Adds the given property/value to all characters in the specified region. -The property is conceptually attached to the characters rather than the -region. The properties are copied when the characters are copied/pasted. -Fifth argument OBJECT is the buffer or string containing the text, and -defaults to the current buffer. -*/ - (start, end, prop, value, object)) -{ - /* This function can GC */ - Bytind s, e; - - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); - put_text_prop (s, e, object, prop, value, 1); - return prop; -} - -DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property, - 4, 5, 0, /* -Adds the given property/value to all characters in the specified region. -The property is conceptually attached to the characters rather than the -region, however the properties will not be copied when the characters -are copied. -Fifth argument OBJECT is the buffer or string containing the text, and -defaults to the current buffer. -*/ - (start, end, prop, value, object)) -{ - /* This function can GC */ - Bytind s, e; - - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); - put_text_prop (s, e, object, prop, value, 0); - return prop; -} - -DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /* -Add properties to the characters from START to END. -The third argument PROPS is a property list specifying the property values -to add. The optional fourth argument, OBJECT, is the buffer or string -containing the text and defaults to the current buffer. Returns t if -any property was changed, nil otherwise. -*/ - (start, end, props, object)) -{ - /* This function can GC */ - int changed = 0; - Bytind s, e; - - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); - CHECK_LIST (props); - for (; !NILP (props); props = Fcdr (Fcdr (props))) - { - Lisp_Object prop = XCAR (props); - Lisp_Object value = Fcar (XCDR (props)); - changed |= put_text_prop (s, e, object, prop, value, 1); - } - return changed ? Qt : Qnil; -} - - -DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties, - 3, 4, 0, /* -Add nonduplicable properties to the characters from START to END. -\(The properties will not be copied when the characters are copied.) -The third argument PROPS is a property list specifying the property values -to add. The optional fourth argument, OBJECT, is the buffer or string -containing the text and defaults to the current buffer. Returns t if -any property was changed, nil otherwise. -*/ - (start, end, props, object)) -{ - /* This function can GC */ - int changed = 0; - Bytind s, e; - - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); - CHECK_LIST (props); - for (; !NILP (props); props = Fcdr (Fcdr (props))) - { - Lisp_Object prop = XCAR (props); - Lisp_Object value = Fcar (XCDR (props)); - changed |= put_text_prop (s, e, object, prop, value, 0); - } - return changed ? Qt : Qnil; -} - -DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /* -Remove the given properties from all characters in the specified region. -PROPS should be a plist, but the values in that plist are ignored (treated -as nil). Returns t if any property was changed, nil otherwise. -Fourth argument OBJECT is the buffer or string containing the text, and -defaults to the current buffer. -*/ - (start, end, props, object)) -{ - /* This function can GC */ - int changed = 0; - Bytind s, e; - - object = decode_buffer_or_string (object); - get_buffer_or_string_range_byte (object, start, end, &s, &e, 0); - CHECK_LIST (props); - for (; !NILP (props); props = Fcdr (Fcdr (props))) - { - Lisp_Object prop = XCAR (props); - changed |= put_text_prop (s, e, object, prop, Qnil, 1); - } - return changed ? Qt : Qnil; -} - -/* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert' - or whatever) we attach the properties to the buffer by calling - `put-text-property' instead of by simply allowing the extent to be copied or - re-attached. Then we return nil, telling the extents code not to attach it - again. By handing the insertion hackery in this way, we make kill/yank - behave consistently with put-text-property and not fragment the extents - (since text-prop extents must partition, not overlap). - - The lisp implementation of this was probably fast enough, but since I moved - the rest of the put-text-prop code here, I moved this as well for - completeness. - */ -DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function, - 3, 3, 0, /* -Used as the `paste-function' property of `text-prop' extents. -*/ - (extent, from, to)) -{ - /* This function can GC */ - Lisp_Object prop, val; - - prop = Fextent_property (extent, Qtext_prop, Qnil); - if (NILP (prop)) - signal_simple_error ("Internal error: no text-prop", extent); - val = Fextent_property (extent, prop, Qnil); -#if 0 - /* removed by bill perry, 2/9/97 - ** This little bit of code would not allow you to have a text property - ** with a value of Qnil. This is bad bad bad. - */ - if (NILP (val)) - signal_simple_error_2 ("Internal error: no text-prop", - extent, prop); -#endif - Fput_text_property (from, to, prop, val, Qnil); - return Qnil; /* important! */ -} - -/* This function could easily be written in Lisp but the C code wants - to use it in connection with invisible extents (at least currently). - If this changes, consider moving this back into Lisp. */ - -DEFUN ("next-single-property-change", Fnext_single_property_change, - 2, 4, 0, /* -Return the position of next property change for a specific property. -Scans characters forward from POS till it finds a change in the PROP - property, then returns the position of the change. The optional third - argument OBJECT is the buffer or string to scan (defaults to the current - buffer). -The property values are compared with `eq'. -Return nil if the property is constant all the way to the end of BUFFER. -If the value is non-nil, it is a position greater than POS, never equal. - -If the optional fourth argument LIMIT is non-nil, don't search - past position LIMIT; return LIMIT if nothing is found before LIMIT. -If two or more extents with conflicting non-nil values for PROP overlap - a particular character, it is undefined which value is considered to be - the value of PROP. (Note that this situation will not happen if you always - use the text-property primitives.) -*/ - (pos, prop, object, limit)) -{ - Bufpos bpos; - Bufpos blim; - Lisp_Object extent, value; - int limit_was_nil; - - object = decode_buffer_or_string (object); - bpos = get_buffer_or_string_pos_char (object, pos, 0); - if (NILP (limit)) - { - blim = buffer_or_string_accessible_end_char (object); - limit_was_nil = 1; - } - else - { - blim = get_buffer_or_string_pos_char (object, limit, 0); - limit_was_nil = 0; - } - - extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil); - if (!NILP (extent)) - value = Fextent_property (extent, prop, Qnil); - else - value = Qnil; - - while (1) - { - bpos = XINT (Fnext_extent_change (make_int (bpos), object)); - if (bpos >= blim) - break; /* property is the same all the way to the end */ - extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil); - if ((NILP (extent) && !NILP (value)) || - (!NILP (extent) && !EQ (value, - Fextent_property (extent, prop, Qnil)))) - return make_int (bpos); - } - - /* I think it's more sensible for this function to return nil always - in this situation and it used to do it this way, but it's been changed - for FSF compatibility. */ - if (limit_was_nil) - return Qnil; - else - return make_int (blim); -} - -/* See comment on previous function about why this is written in C. */ - -DEFUN ("previous-single-property-change", Fprevious_single_property_change, - 2, 4, 0, /* -Return the position of next property change for a specific property. -Scans characters backward from POS till it finds a change in the PROP - property, then returns the position of the change. The optional third - argument OBJECT is the buffer or string to scan (defaults to the current - buffer). -The property values are compared with `eq'. -Return nil if the property is constant all the way to the start of BUFFER. -If the value is non-nil, it is a position less than POS, never equal. - -If the optional fourth argument LIMIT is non-nil, don't search back - past position LIMIT; return LIMIT if nothing is found until LIMIT. -If two or more extents with conflicting non-nil values for PROP overlap - a particular character, it is undefined which value is considered to be - the value of PROP. (Note that this situation will not happen if you always - use the text-property primitives.) -*/ - (pos, prop, object, limit)) -{ - Bufpos bpos; - Bufpos blim; - Lisp_Object extent, value; - int limit_was_nil; - - object = decode_buffer_or_string (object); - bpos = get_buffer_or_string_pos_char (object, pos, 0); - if (NILP (limit)) - { - blim = buffer_or_string_accessible_begin_char (object); - limit_was_nil = 1; - } - else - { - blim = get_buffer_or_string_pos_char (object, limit, 0); - limit_was_nil = 0; - } - - /* extent-at refers to the character AFTER bpos, but we want the - character before bpos. Thus the - 1. extent-at simply - returns nil on bogus positions, so not to worry. */ - extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil); - if (!NILP (extent)) - value = Fextent_property (extent, prop, Qnil); - else - value = Qnil; - - while (1) - { - bpos = XINT (Fprevious_extent_change (make_int (bpos), object)); - if (bpos <= blim) - break; /* property is the same all the way to the beginning */ - extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil); - if ((NILP (extent) && !NILP (value)) || - (!NILP (extent) && !EQ (value, - Fextent_property (extent, prop, Qnil)))) - return make_int (bpos); - } - - /* I think it's more sensible for this function to return nil always - in this situation and it used to do it this way, but it's been changed - for FSF compatibility. */ - if (limit_was_nil) - return Qnil; - else - return make_int (blim); -} - -#ifdef MEMORY_USAGE_STATS - -int -compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats) -{ - /* #### not yet written */ - return 0; -} - -#endif /* MEMORY_USAGE_STATS */ - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_extents (void) -{ - defsymbol (&Qextentp, "extentp"); - defsymbol (&Qextent_live_p, "extent-live-p"); - - defsymbol (&Qall_extents_closed, "all-extents-closed"); - defsymbol (&Qall_extents_open, "all-extents-open"); - defsymbol (&Qall_extents_closed_open, "all-extents-closed-open"); - defsymbol (&Qall_extents_open_closed, "all-extents-open-closed"); - defsymbol (&Qstart_in_region, "start-in-region"); - defsymbol (&Qend_in_region, "end-in-region"); - defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region"); - defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region"); - defsymbol (&Qnegate_in_region, "negate-in-region"); - - defsymbol (&Qdetached, "detached"); - defsymbol (&Qdestroyed, "destroyed"); - defsymbol (&Qbegin_glyph, "begin-glyph"); - defsymbol (&Qend_glyph, "end-glyph"); - defsymbol (&Qstart_open, "start-open"); - defsymbol (&Qend_open, "end-open"); - defsymbol (&Qstart_closed, "start-closed"); - defsymbol (&Qend_closed, "end-closed"); - defsymbol (&Qread_only, "read-only"); - /* defsymbol (&Qhighlight, "highlight"); in faces.c */ - defsymbol (&Qunique, "unique"); - defsymbol (&Qduplicable, "duplicable"); - defsymbol (&Qdetachable, "detachable"); - defsymbol (&Qpriority, "priority"); - defsymbol (&Qmouse_face, "mouse-face"); - defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function"); - - - defsymbol (&Qglyph_layout, "glyph-layout"); /* backwards compatibility */ - defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout"); - defsymbol (&Qend_glyph_layout, "end-glyph-layout"); - defsymbol (&Qoutside_margin, "outside-margin"); - defsymbol (&Qinside_margin, "inside-margin"); - defsymbol (&Qwhitespace, "whitespace"); - /* Qtext defined in general.c */ - - defsymbol (&Qglyph_invisible, "glyph-invisible"); - - defsymbol (&Qpaste_function, "paste-function"); - defsymbol (&Qcopy_function, "copy-function"); - - defsymbol (&Qtext_prop, "text-prop"); - defsymbol (&Qtext_prop_extent_paste_function, - "text-prop-extent-paste-function"); - - DEFSUBR (Fextentp); - DEFSUBR (Fextent_live_p); - DEFSUBR (Fextent_detached_p); - DEFSUBR (Fextent_start_position); - DEFSUBR (Fextent_end_position); - DEFSUBR (Fextent_object); - DEFSUBR (Fextent_length); - - DEFSUBR (Fmake_extent); - DEFSUBR (Fcopy_extent); - DEFSUBR (Fdelete_extent); - DEFSUBR (Fdetach_extent); - DEFSUBR (Fset_extent_endpoints); - DEFSUBR (Fnext_extent); - DEFSUBR (Fprevious_extent); -#if DEBUG_XEMACS - DEFSUBR (Fnext_e_extent); - DEFSUBR (Fprevious_e_extent); -#endif - DEFSUBR (Fnext_extent_change); - DEFSUBR (Fprevious_extent_change); - - DEFSUBR (Fextent_parent); - DEFSUBR (Fextent_children); - DEFSUBR (Fset_extent_parent); - - DEFSUBR (Fextent_in_region_p); - DEFSUBR (Fmap_extents); - DEFSUBR (Fmap_extent_children); - DEFSUBR (Fextent_at); - - DEFSUBR (Fset_extent_initial_redisplay_function); - DEFSUBR (Fextent_face); - DEFSUBR (Fset_extent_face); - DEFSUBR (Fextent_mouse_face); - DEFSUBR (Fset_extent_mouse_face); - DEFSUBR (Fset_extent_begin_glyph); - DEFSUBR (Fset_extent_end_glyph); - DEFSUBR (Fextent_begin_glyph); - DEFSUBR (Fextent_end_glyph); - DEFSUBR (Fset_extent_begin_glyph_layout); - DEFSUBR (Fset_extent_end_glyph_layout); - DEFSUBR (Fextent_begin_glyph_layout); - DEFSUBR (Fextent_end_glyph_layout); - DEFSUBR (Fset_extent_priority); - DEFSUBR (Fextent_priority); - DEFSUBR (Fset_extent_property); - DEFSUBR (Fset_extent_properties); - DEFSUBR (Fextent_property); - DEFSUBR (Fextent_properties); - - DEFSUBR (Fhighlight_extent); - DEFSUBR (Fforce_highlight_extent); - - DEFSUBR (Finsert_extent); - - DEFSUBR (Fget_text_property); - DEFSUBR (Fget_char_property); - DEFSUBR (Fput_text_property); - DEFSUBR (Fput_nonduplicable_text_property); - DEFSUBR (Fadd_text_properties); - DEFSUBR (Fadd_nonduplicable_text_properties); - DEFSUBR (Fremove_text_properties); - DEFSUBR (Ftext_prop_extent_paste_function); - DEFSUBR (Fnext_single_property_change); - DEFSUBR (Fprevious_single_property_change); -} - -void -vars_of_extents (void) -{ - DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /* -The priority to use for the mouse-highlighting pseudo-extent -that is used to highlight extents with the `mouse-face' attribute set. -See `set-extent-priority'. -*/ ); - /* Set mouse-highlight-priority (which ends up being used both for the - mouse-highlighting pseudo-extent and the primary selection extent) - to a very high value because very few extents should override it. - 1000 gives lots of room below it for different-prioritized extents. - 10 doesn't. ediff, for example, likes to use priorities around 100. - --ben */ - mouse_highlight_priority = /* 10 */ 1000; - - DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /* -Property list giving default values for text properties. -Whenever a character does not specify a value for a property, the value -stored in this list is used instead. This only applies when the -functions `get-text-property' or `get-char-property' are called. -*/ ); - Vdefault_text_properties = Qnil; - - staticpro (&Vlast_highlighted_extent); - Vlast_highlighted_extent = Qnil; - - Vextent_face_reusable_list = Fcons (Qnil, Qnil); - staticpro (&Vextent_face_reusable_list); - - extent_auxiliary_defaults.begin_glyph = Qnil; - extent_auxiliary_defaults.end_glyph = Qnil; - extent_auxiliary_defaults.parent = Qnil; - extent_auxiliary_defaults.children = Qnil; - extent_auxiliary_defaults.priority = 0; - extent_auxiliary_defaults.invisible = Qnil; - extent_auxiliary_defaults.read_only = Qnil; - extent_auxiliary_defaults.mouse_face = Qnil; - extent_auxiliary_defaults.initial_redisplay_function = Qnil; - extent_auxiliary_defaults.before_change_functions = Qnil; - extent_auxiliary_defaults.after_change_functions = Qnil; -} - -void -complex_vars_of_extents (void) -{ - staticpro (&Vextent_face_memoize_hash_table); - /* The memoize hash table maps from lists of symbols to lists of - faces. It needs to be `equal' to implement the memoization. - The reverse table maps in the other direction and just needs - to do `eq' comparison because the lists of faces are already - memoized. */ - Vextent_face_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); - staticpro (&Vextent_face_reverse_memoize_hash_table); - Vextent_face_reverse_memoize_hash_table = - make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ); -} diff --git a/src/extents.h b/src/extents.h deleted file mode 100644 index 457031e..0000000 --- a/src/extents.h +++ /dev/null @@ -1,403 +0,0 @@ -/* Copyright (c) 1994, 1995 Free Software Foundation. - Copyright (c) 1995 Ben Wing. - -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. */ - -#ifndef _XEMACS_EXTENTS_H_ -#define _XEMACS_EXTENTS_H_ - -DECLARE_LRECORD (extent, struct extent); -#define XEXTENT(x) XRECORD (x, extent, struct extent) -#define XSETEXTENT(x, p) XSETRECORD (x, p, extent) -#define EXTENTP(x) RECORDP (x, extent) -#define GC_EXTENTP(x) GC_RECORDP (x, extent) -#define CHECK_EXTENT(x) CHECK_RECORD (x, extent) -#define CONCHECK_EXTENT(x) CONCHECK_RECORD (x, extent) - -/* the layouts for glyphs (extent->flags.glyph_layout). Must fit in 2 bits. */ -typedef enum glyph_layout -{ - GL_TEXT, - GL_OUTSIDE_MARGIN, - GL_INSIDE_MARGIN, - GL_WHITESPACE -} glyph_layout; - -struct extent -{ - struct lrecord_header lheader; - - Memind start; - Memind end; - Lisp_Object object; /* A buffer, string, Qnil (extent detached from no - buffer), Qt (destroyed extent) */ - - /* Extent properties are conceptually a plist, but the most common - props are implemented as bits instead of conses. */ - struct - { - Lisp_Object face; - - /* These flags are simply an optimization for common boolean properties - which go onto the extent's property list. Any of them would work if - done in the normal way, but the space savings of doing these in this - way is significant. Note that if you add a flag, there are numerous - places in extents.c that need to know about it. - - Another consideration is that some of these properties are accessed - during redisplay, so it's good for access to them to be fast (a bit - reference instead of a search down a plist). - - `begin_glyph_layout' and `end_glyph_layout' are unusual in that - they have 4 states instead of 2. - - Other special extent properties are stored in an auxiliary - structure that sits at the beginning of the plist. The has_aux - flag indicates whether this structure exists. The has_parent - flag is an optimization indicating whether the extent has a parent - (this could also be determined by looking in the aux structure). */ - - enum_field (glyph_layout) begin_glyph_layout :2; - /* 2 text, margins, or whitespace */ - enum_field (glyph_layout) end_glyph_layout :2; - /* 4 text, margins, or whitespace */ - unsigned int has_parent :1; /* 5 extent has a parent */ - unsigned int has_aux :1; /* 6 extent has an aux. structure */ - unsigned int start_open :1; /* 7 insertion behavior at start */ - unsigned int end_open :1; /* 8 insertion behavior at end */ - unsigned int unique :1; /* 9 there may be only one attached */ - unsigned int duplicable :1; /* 10 copied to strings by kill/undo */ - unsigned int detachable :1; /* 11 extent detaches if text deleted */ - unsigned int internal :1; /* 12 used by map-extents etc. */ - unsigned int in_red_event :1; /* 13 An event has been spawned for - initial redisplay. - (not exported to lisp) */ - unsigned int unused16 :1; /* 16 unused bits */ - /* --- Adding more flags will cause the extent struct to grow by another - word. It's not clear that this would make a difference, however, - because on 32-bit machines things tend to get allocated in chunks - of 4 bytes. */ - } flags; - /* The plist may have an auxiliary structure as its first element */ - Lisp_Object plist; -}; - -/* Basic properties of an extent (not affected by the extent's parent) */ -#define extent_object(e) ((e)->object) -#define extent_start(e) ((e)->start + 0) -#define extent_end(e) ((e)->end + 0) -#define set_extent_start(e, val) ((void) ((e)->start = (val))) -#define set_extent_end(e, val) ((void) ((e)->end = (val))) -#define extent_endpoint(e, endp) ((endp) ? extent_end (e) : extent_start (e)) -#define set_extent_endpoint(e, val, endp) \ - ((endp) ? set_extent_end (e, val) : set_extent_start (e, val)) -#define extent_detached_p(e) (extent_start (e) < 0) - -/* Additional information that may be present in an extent. The idea is - that fast access is provided to this information, but since (hopefully) - most extents won't have this set on them, we usually don't need to - have this structure around and thus the size of an extent is smaller. */ - -typedef struct extent_auxiliary extent_auxiliary; -struct extent_auxiliary -{ - struct lcrecord_header header; - - Lisp_Object begin_glyph; - Lisp_Object end_glyph; - Lisp_Object parent; - /* We use a weak list here. Originally I didn't do this and - depended on having the extent's finalization method remove - itself from its parent's children list. This runs into - lots and lots of problems though because everything is in - a really really bizarre state when an extent's finalization - method is called (it happens in sweep_extents() by way of - ADDITIONAL_FREE_extent()) and it's extremely difficult to - avoid getting hosed by just-freed objects. */ - Lisp_Object children; - Lisp_Object invisible; - Lisp_Object read_only; - Lisp_Object mouse_face; - Lisp_Object initial_redisplay_function; - Lisp_Object before_change_functions, after_change_functions; - int priority; -}; - -extern struct extent_auxiliary extent_auxiliary_defaults; - -DECLARE_LRECORD (extent_auxiliary, struct extent_auxiliary); -#define XEXTENT_AUXILIARY(x) \ - XRECORD (x, extent_auxiliary, struct extent_auxiliary) -#define XSETEXTENT_AUXILIARY(x, p) XSETRECORD (x, p, extent_auxiliary) -#define EXTENT_AUXILIARYP(x) RECORDP (x, extent_auxiliary) -#define GC_EXTENT_AUXILIARYP(x) GC_RECORDP (x, extent_auxiliary) -#define CHECK_EXTENT_AUXILIARY(x) CHECK_RECORD (x, extent_auxiliary) -#define CONCHECK_EXTENT_AUXILIARY(x) CONCHECK_RECORD (x, extent_auxiliary) - -struct extent_info -{ - struct lcrecord_header header; - - struct extent_list *extents; - struct stack_of_extents *soe; -}; - -DECLARE_LRECORD (extent_info, struct extent_info); -#define XEXTENT_INFO(x) XRECORD (x, extent_info, struct extent_info) -#define XSETEXTENT_INFO(x, p) XSETRECORD (x, p, extent_info) -#define EXTENT_INFOP(x) RECORDP (x, extent_info) -#define GC_EXTENT_INFOP(x) GC_RECORDP (x, extent_info) -#define CHECK_EXTENT_INFO(x) CHECK_RECORD (x, extent_info) -#define CONCHECK_EXTENT_INFO(x) CONCHECK_RECORD (x, extent_info) - -void flush_cached_extent_info (Lisp_Object extent_info); - -/* A "normal" field is one that is stored in the `struct flags' structure - in an extent. an "aux" field is one that is stored in the extent's - auxiliary structure. - - The functions below that have `extent_no_chase' in their name operate - on an extent directly (ignoring its parent), and should normally - only be used on extents known not to have a parent. The other - versions chase down any parent links. */ - -#define extent_no_chase_normal_field(e, field) ((e)->flags.field) - -INLINE struct extent_auxiliary *extent_aux_or_default (EXTENT e); -INLINE struct extent_auxiliary * -extent_aux_or_default (EXTENT e) -{ - return e->flags.has_aux ? - XEXTENT_AUXILIARY (XCAR (e->plist)) : - & extent_auxiliary_defaults; -} - -#define extent_no_chase_aux_field(e, field) (extent_aux_or_default(e)->field) - -#define extent_normal_field(e, field) \ - extent_no_chase_normal_field (extent_ancestor (e), field) - -#define extent_aux_field(e, field) \ - extent_no_chase_aux_field (extent_ancestor (e), field) - -#define set_extent_no_chase_aux_field(e, field, value) do { \ - EXTENT sencaf_e = (e); \ - if (! sencaf_e->flags.has_aux) \ - allocate_extent_auxiliary (sencaf_e); \ - XEXTENT_AUXILIARY (XCAR (sencaf_e->plist))->field = (value);\ -} while (0) - -#define set_extent_no_chase_normal_field(e, field, value) \ - extent_no_chase_normal_field (e, field) = (value) - -#define set_extent_aux_field(e, field, value) \ - set_extent_no_chase_aux_field (extent_ancestor (e), field, value) - -#define set_extent_normal_field(e, field, value) \ - set_extent_ancestor_normal_field (extent_no_chase (e), field, value) - -/* The `parent' and `children' fields are not affected by any - parent links. We don't provide any settors for these fields - because they need special handling and it's cleaner just to - do this in the particular functions that need to do this. */ - -#define extent_parent(e) extent_no_chase_aux_field (e, parent) -#define extent_children(e) extent_no_chase_aux_field (e, children) - -#define extent_begin_glyph(e) extent_aux_field (e, begin_glyph) -#define extent_end_glyph(e) extent_aux_field (e, end_glyph) -#define extent_priority(e) extent_aux_field (e, priority) -#define extent_invisible(e) extent_aux_field (e, invisible) -#define extent_read_only(e) extent_aux_field (e, read_only) -#define extent_mouse_face(e) extent_aux_field (e, mouse_face) -#define extent_initial_redisplay_function(e) extent_aux_field (e, initial_redisplay_function) -#define extent_before_change_functions(e) extent_aux_field (e, before_change_functions) -#define extent_after_change_functions(e) extent_aux_field (e, after_change_functions) - -#define set_extent_begin_glyph(e, value) \ - set_extent_aux_field (e, begin_glyph, value) -#define set_extent_end_glyph(e, value) \ - set_extent_aux_field (e, end_glyph, value) -#define set_extent_priority(e, value) \ - set_extent_aux_field (e, priority, value) -#define set_extent_invisible_1(e, value) \ - set_extent_aux_field (e, invisible, value) -#define set_extent_read_only(e, value) \ - set_extent_aux_field (e, read_only, value) -#define set_extent_mouse_face(e, value) \ - set_extent_aux_field (e, mouse_face, value) -/* Use Fset_extent_initial_redisplay_function unless you know what you're doing */ -#define set_extent_initial_redisplay_function(e, value) \ - set_extent_aux_field (e, initial_redisplay_function, value) -#define set_extent_before_change_functions(e, value) \ - set_extent_aux_field (e, before_change_functions, value) -#define set_extent_after_change_functions(e, value) \ - set_extent_aux_field (e, after_change_functions, value) - -#define extent_face(e) extent_normal_field (e, face) -#define extent_begin_glyph_layout(e) extent_normal_field (e, begin_glyph_layout) -#define extent_end_glyph_layout(e) extent_normal_field (e, end_glyph_layout) -#define extent_start_open_p(e) extent_normal_field (e, start_open) -#define extent_end_open_p(e) extent_normal_field (e, end_open) -#define extent_unique_p(e) extent_normal_field (e, unique) -#define extent_duplicable_p(e) extent_normal_field (e, duplicable) -#define extent_detachable_p(e) extent_normal_field (e, detachable) -#define extent_internal_p(e) extent_normal_field (e, internal) -#define extent_in_red_event_p(e) extent_normal_field (e, in_red_event) - -INLINE Lisp_Object * extent_no_chase_plist_addr (EXTENT e); -INLINE Lisp_Object * -extent_no_chase_plist_addr (EXTENT e) -{ - return e->flags.has_aux ? &XCDR (e->plist) : &e->plist; -} - -#define extent_no_chase_plist(e) (*extent_no_chase_plist_addr (e)) - -#define extent_plist_addr(e) extent_no_chase_plist_addr (extent_ancestor (e)) -#define extent_plist_slot(e) extent_no_chase_plist (extent_ancestor (e)) - -/* flags for map_extents() and friends */ -#define ME_END_CLOSED (1 << 0) -#define ME_START_OPEN (1 << 1) -#define ME_ALL_EXTENTS_CLOSED (1 << 2) -#define ME_ALL_EXTENTS_OPEN (2 << 2) -#define ME_ALL_EXTENTS_CLOSED_OPEN (3 << 2) -#define ME_ALL_EXTENTS_OPEN_CLOSED (4 << 2) -#define ME_ALL_EXTENTS_MASK (7 << 2) -#define ME_START_IN_REGION (1 << 5) -#define ME_END_IN_REGION (2 << 5) -#define ME_START_AND_END_IN_REGION (3 << 5) -#define ME_START_OR_END_IN_REGION (4 << 5) -#define ME_IN_REGION_MASK (7 << 5) -#define ME_NEGATE_IN_REGION (1 << 8) -/* the following flags are internal-only */ -#define ME_INCLUDE_INTERNAL (1 << 9) -#define ME_MIGHT_THROW (1 << 10) -#define ME_MIGHT_MODIFY_TEXT (1 << 11) -#define ME_MIGHT_MODIFY_EXTENTS (1 << 12) -#define ME_MIGHT_MOVE_SOE (1 << 13) -#define ME_MIGHT_CALL_ELISP (ME_MIGHT_THROW | ME_MIGHT_MODIFY_TEXT | \ - ME_MIGHT_MODIFY_EXTENTS | ME_MIGHT_MOVE_SOE) - - -#define EXTENT_LIVE_P(e) (!EQ (extent_object (e), Qt)) - -#define CHECK_LIVE_EXTENT(x) do { \ - CHECK_EXTENT (x); \ - if (!EXTENT_LIVE_P (XEXTENT (x))) \ - dead_wrong_type_argument (Qextent_live_p, (x)); \ -} while (0) -#define CONCHECK_LIVE_EXTENT(x) do { \ - CONCHECK_EXTENT (x); \ - if (!EXTENT_LIVE_P (XEXTENT (x))) \ - x = wrong_type_argument (Qextent_live_p, (x)); \ -} while (0) - -EXFUN (Fdetach_extent, 1); -EXFUN (Fextent_end_position, 1); -EXFUN (Fextent_object, 1); -EXFUN (Fextent_start_position, 1); -EXFUN (Fmake_extent, 3); -EXFUN (Fprevious_single_property_change, 4); -EXFUN (Fset_extent_endpoints, 4); -EXFUN (Fset_extent_parent, 2); - -extern int inside_undo; - -struct extent_fragment *extent_fragment_new (Lisp_Object buffer_or_string, - struct frame *frm); -face_index extent_fragment_update (struct window *w, - struct extent_fragment *ef, - /* Note this is in Bytinds */ - Bytind pos); -void extent_fragment_delete (struct extent_fragment *ef); - - -#ifdef emacs /* things other than emacs want the structs */ - -/* from alloc.c */ -struct extent *allocate_extent (void); - -/* from extents.c */ -EXTENT extent_ancestor_1 (EXTENT e); - -/* extent_ancestor() chases all the parent links until there aren't any - more. extent_ancestor_1() does the same thing but it a function; - the following optimizes the most common case. */ -INLINE EXTENT extent_ancestor (EXTENT e); -INLINE EXTENT -extent_ancestor (EXTENT e) -{ - return e->flags.has_parent ? extent_ancestor_1 (e) : e; -} - -void allocate_extent_auxiliary (EXTENT ext); -void init_buffer_extents (struct buffer *b); -void uninit_buffer_extents (struct buffer *b); -typedef int (*map_extents_fun) (EXTENT extent, void *arg); -void map_extents (Bufpos from, Bufpos to, map_extents_fun fn, - void *arg, Lisp_Object obj, EXTENT after, - unsigned int flags); - -/* Note the following five functions are NOT in Bufpos's */ -void adjust_extents (Lisp_Object object, Memind from, - Memind to, int amount); -void adjust_extents_for_deletion (Lisp_Object object, Bytind from, - Bytind to, int gapsize, - int numdel, int movegapsize); -void verify_extent_modification (Lisp_Object object, Bytind from, - Bytind to, - Lisp_Object inhibit_read_only_value); -void process_extents_for_insertion (Lisp_Object object, - Bytind opoint, Bytecount length); -void process_extents_for_deletion (Lisp_Object object, Bytind from, - Bytind to, int destroy_them); -void report_extent_modification (Lisp_Object, Bufpos, Bufpos, int *, int); - -void set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp, - glyph_layout layout); - -void add_string_extents (Lisp_Object string, struct buffer *buf, - Bytind opoint, Bytecount length); -void splice_in_string_extents (Lisp_Object string, struct buffer *buf, - Bytind opoint, Bytecount length, - Bytecount pos); -void copy_string_extents (Lisp_Object new_string, - Lisp_Object old_string, - Bytecount new_pos, Bytecount old_pos, - Bytecount length); - -void detach_all_extents (Lisp_Object object); -void set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, - Lisp_Object object); - -#ifdef ERROR_CHECK_EXTENTS -void sledgehammer_extent_check (Lisp_Object obj); -#endif - -#ifdef MEMORY_USAGE_STATS -int compute_buffer_extent_usage (struct buffer *b, - struct overhead_stats *ovstats); -#endif - -#endif /* emacs */ - -#endif /* _XEMACS_EXTENTS_H_ */ diff --git a/src/extw-Xlib.h b/src/extw-Xlib.h deleted file mode 100644 index da9e8a5..0000000 --- a/src/extw-Xlib.h +++ /dev/null @@ -1,51 +0,0 @@ -/* Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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. */ - -#ifndef _EXTW_XLIB_H_ -#define _EXTW_XLIB_H_ - -#define extw_shell_send 0 -#define extw_client_send 1 - -typedef enum { - extw_notify_init, - extw_notify_end, - extw_notify_qg, - extw_notify_gm, - extw_notify_set_focus, - extw_notify_focus_in, - extw_notify_focus_out -} en_extw_notify; - -extern Atom a_EXTW_QUERY_GEOMETRY, a_EXTW_GEOMETRY_MANAGER, - a_EXTW_WIDGET_GEOMETRY, a_EXTW_NOTIFY; -extern int extw_which_side; - -typedef enum { - EXTW_TYPE_NONE, - EXTW_TYPE_XLIB, - EXTW_TYPE_XT, - EXTW_TYPE_MOTIF -} en_extw_type; - -void extw_initialize_atoms(Display *display); -void extw_send_notify_3(Display *display, Window win, en_extw_notify type, - long data0, long data1, long data2); - -#endif /* _EXTW_XLIB_H_ */ diff --git a/src/extw-Xt.c b/src/extw-Xt.c deleted file mode 100644 index eac11fe..0000000 --- a/src/extw-Xt.c +++ /dev/null @@ -1,243 +0,0 @@ -/* Common code between client and shell widgets -- Xt only. - Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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, September 1993. */ - -#ifdef emacs - -#include - -#ifndef EXTERNAL_WIDGET -ERROR! This ought not be getting compiled if EXTERNAL_WIDGET is undefined -#endif - -void fatal (CONST char *fmt, ...); -#else /* not emacs */ -static void fatal (char *msg); -#endif - -#include -#include -#include -#include -#include "extw-Xt.h" - -/* Yeah, that's portable! - - Why the hell didn't the Xt people just export this function - for real? */ - -#if (XT_REVISION > 5) -int _XtWaitForSomething( - XtAppContext app, - _XtBoolean ignoreEvents, - _XtBoolean ignoreTimers, - _XtBoolean ignoreInputs, - _XtBoolean ignoreSignals, - _XtBoolean block, -#ifdef XTHREADS - _XtBoolean drop_lock, -#endif - unsigned long *howlong); - -# ifndef XTHREADS -# define _XtwaitForSomething(timers,inputs,events,block,howlong,appCtx) \ - _XtWaitForSomething(appCtx,events,timers,inputs,0,block,howlong) -# else -# define _XtwaitForSomething(timers,inputs,events,block,howlong,appCtx) \ - _XtWaitForSomething(appCtx,events,timers,inputs,0,block,1,howlong) -# endif -#else -int _XtwaitForSomething( - Boolean ignoreTimers, - Boolean ignoreInputs, - Boolean ignoreEvents, - Boolean block, - unsigned long *howlong, - XtAppContext app - ); -#endif - -#ifdef DEBUG_WIDGET - -static int geom_masks[] = { - CWX, CWY, CWWidth, CWHeight, CWBorderWidth, CWSibling, CWStackMode, - XtCWQueryOnly }; -static char *geom_mask_strings[] = { - "CWX", "CWY", "CWWidth", "CWHeight", "CWBorderWidth", - "CWSibling", "CWStackMode", "XtCWQueryOnly" }; -static int stack_modes[] = { - Below, TopIf, BottomIf, Opposite, XtSMDontChange }; -static char *stack_mode_strings[] = { - "Below", "TopIf", "BottomIf", "Opposite", "XtSMDontChange" }; - -static void -print_geometry_structure(XtWidgetGeometry *xwg) -{ - int num = sizeof(geom_masks)/sizeof(int); - int i; - - printf (" masks:"); - for (i=0; irequest_mode & geom_masks[i]) - printf (" %s", geom_mask_strings[i]); - printf ("\n"); - printf (" x:%d y:%d\n", xwg->x, xwg->y); - printf (" width:%d height:%d border_width:%d\n", xwg->width, - xwg->height, xwg->border_width); - printf (" sibling: %x\n", xwg->sibling); - printf (" stack_mode: "); - for (i=0, num=sizeof(stack_modes)/sizeof(int); istack_mode == stack_modes[i]) { - printf ("%s", stack_mode_strings[i]); - break; - } - printf ("\n"); -} - -static void -print_geometry_result (XtGeometryResult res) -{ - printf ("result: %s\n", - res == XtGeometryYes ? "XtGeometryYes" : - res == XtGeometryNo ? "XtGeometryNo" : - res == XtGeometryAlmost ? "XtGeometryAlmost" : - res == XtGeometryDone ? "XtGeometryDone" : - "unknown"); -} - -#endif - -#ifndef emacs - -static void -fatal (char *msg) -{ - fprintf (stderr, "%s", msg); - exit (1); -} - -#endif - -/* put a geometry specification in the specified property on the window - of the specified widget, and send a notification message to tell the - client-side widget about this. */ - -void -extw_send_geometry_value(Display *display, Window win, Atom property, - en_extw_notify type, XtWidgetGeometry *xwg, - long data0) -{ - if (xwg != NULL) - XChangeProperty(display, win, property, - a_EXTW_WIDGET_GEOMETRY, 32, PropModeReplace, - (unsigned char *) xwg, sizeof(*xwg)/sizeof(int)); - extw_send_notify_3(display, win, type, data0, 0, 0); -} - -/* get the geometry specification stored in the specified property of the - specified widget's window. */ - -void -extw_get_geometry_value(Display *display, Window win, Atom property, - XtWidgetGeometry *xwg) -{ - Atom dummy; - int format; - unsigned long nitems, bytes_after; - unsigned char *prop; - - if (XGetWindowProperty(display, win, property, 0, - sizeof(*xwg)/4, False, a_EXTW_WIDGET_GEOMETRY, - &dummy, &format, &nitems, &bytes_after, - &prop) != Success) - goto error; - if (format != 8*sizeof(int) || bytes_after) { - XFree((char *) prop); - goto error; - } - *xwg = * (XtWidgetGeometry *) prop; - return; - - error: - fatal("Unable to retrieve property for widget-geometry"); -#if 0 - XtAppErrorMsg(XtWidgetToApplicationContext((Widget)w), - "invalidProperty","get_geometry_value",XtCXtToolkitError, - "Unable to retrieve property for widget-geometry", - (String *)NULL, (Cardinal *)NULL); -#endif -} - -typedef struct { - Widget w; - unsigned long request_num; - en_extw_notify type; -} QueryStruct; - -/* check if an event is of the sort we're looking for */ - -static Bool -isMine(Display *dpy, XEvent *event, char *arg) -{ - QueryStruct *q = (QueryStruct *) arg; - Widget w = q->w; - - if ( (dpy != XtDisplay(w)) || (event->xany.window != XtWindow(w)) ) { - return FALSE; - } - if (event->xany.serial >= q->request_num) { - if (event->type == ClientMessage && - event->xclient.message_type == a_EXTW_NOTIFY && - event->xclient.data.l[0] == 1 - extw_which_side && - event->xclient.data.l[1] == q->type) - return TRUE; - } - return FALSE; -} - -/* wait for a ClientMessage of the specified type from the other widget, or - time-out. isMine() determines whether an event matches. Culled from - Shell.c. */ - -Bool -extw_wait_for_response(Widget w, XEvent *event, unsigned long request_num, - en_extw_notify type, unsigned long timeout) -{ - XtAppContext app = XtWidgetToApplicationContext(w); - QueryStruct q; - - XFlush(XtDisplay(w)); - q.w = w; - q.request_num = request_num; - q.type = type; - - for(;;) { - /* - * look for match event - */ - if (XCheckIfEvent( XtDisplay(w), event, isMine, (char*)&q)) - return TRUE; - if (_XtwaitForSomething(TRUE, TRUE, FALSE, TRUE, &timeout, app) - != -1) continue; - if (timeout == 0) - return FALSE; - } -} diff --git a/src/extw-Xt.h b/src/extw-Xt.h deleted file mode 100644 index ffea0ea..0000000 --- a/src/extw-Xt.h +++ /dev/null @@ -1,44 +0,0 @@ -/* Copyright (C) 1993, 1994 Sun Microsystems, Inc. - -This file is part of XEmacs. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public -License as published by the Free Software Foundation; either -version 2 of the License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU Library General Public -License along with this library; 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. */ - -#ifndef _EXTW_XT_H_ -#define _EXTW_XT_H_ - -#include "extw-Xlib.h" - -#ifndef XtCXtToolkitError -#define XtCXtToolkitError "XtToolkitError" -#endif - -#ifndef DEFAULT_WM_TIMEOUT -#define DEFAULT_WM_TIMEOUT 5000 -#endif - -void extw_send_geometry_value(Display *display, Window win, Atom property, - en_extw_notify type, XtWidgetGeometry *xwg, - long data0); -void extw_get_geometry_value(Display *display, Window win, Atom property, - XtWidgetGeometry *xwg); -Bool extw_wait_for_response(Widget w, XEvent *event, unsigned long request_num, - en_extw_notify type, unsigned long timeout); - - -#endif /* _EXTW_XT_H_ */ diff --git a/src/faces.c b/src/faces.c deleted file mode 100644 index 44fbd98..0000000 --- a/src/faces.c +++ /dev/null @@ -1,2029 +0,0 @@ -/* "Face" primitives - Copyright (C) 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, 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. */ - -/* Written by Chuck Thompson and Ben Wing, - based loosely on old face code by Jamie Zawinski. */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "device.h" -#include "elhash.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" -#include "objects.h" -#include "specifier.h" -#include "window.h" - -Lisp_Object Qfacep; -Lisp_Object Qforeground, Qbackground, Qdisplay_table; -Lisp_Object Qbackground_pixmap, Qunderline, Qdim; -Lisp_Object Qblinking, Qstrikethru; - -Lisp_Object Qinit_face_from_resources; -Lisp_Object Qinit_frame_faces; -Lisp_Object Qinit_device_faces; -Lisp_Object Qinit_global_faces; - -/* These faces are used directly internally. We use these variables - to be able to reference them directly and save the overhead of - calling Ffind_face. */ -Lisp_Object Vdefault_face, Vmodeline_face, Vgui_element_face; -Lisp_Object Vleft_margin_face, Vright_margin_face, Vtext_cursor_face; -Lisp_Object Vpointer_face, Vvertical_divider_face, Vtoolbar_face, Vwidget_face; - -/* Qdefault, Qhighlight defined in general.c */ -Lisp_Object Qmodeline, Qgui_element, Qleft_margin, Qright_margin, Qtext_cursor; -Lisp_Object Qvertical_divider; - -/* In the old implementation Vface_list was a list of the face names, - not the faces themselves. We now distinguish between permanent and - temporary faces. Permanent faces are kept in a regular hash table, - temporary faces in a weak hash table. */ -Lisp_Object Vpermanent_faces_cache; -Lisp_Object Vtemporary_faces_cache; - -Lisp_Object Vbuilt_in_face_specifiers; - - - -static Lisp_Object -mark_face (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Face *face = XFACE (obj); - - markobj (face->name); - markobj (face->doc_string); - - markobj (face->foreground); - markobj (face->background); - markobj (face->font); - markobj (face->display_table); - markobj (face->background_pixmap); - markobj (face->underline); - markobj (face->strikethru); - markobj (face->highlight); - markobj (face->dim); - markobj (face->blinking); - markobj (face->reverse); - - markobj (face->charsets_warned_about); - - return face->plist; -} - -static void -print_face (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct Lisp_Face *face = XFACE (obj); - - if (print_readably) - { - write_c_string ("#s(face name ", printcharfun); - print_internal (face->name, printcharfun, 1); - write_c_string (")", printcharfun); - } - else - { - write_c_string ("#name, printcharfun, 1); - if (!NILP (face->doc_string)) - { - write_c_string (" ", printcharfun); - print_internal (face->doc_string, printcharfun, 1); - } - write_c_string (">", printcharfun); - } -} - -/* Faces are equal if all of their display attributes are equal. We - don't compare names or doc-strings, because that would make equal - be eq. - - This isn't concerned with "unspecified" attributes, that's what - #'face-differs-from-default-p is for. */ -static int -face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Face *f1 = XFACE (obj1); - struct Lisp_Face *f2 = XFACE (obj2); - - depth++; - - return - (internal_equal (f1->foreground, f2->foreground, depth) && - internal_equal (f1->background, f2->background, depth) && - internal_equal (f1->font, f2->font, depth) && - internal_equal (f1->display_table, f2->display_table, depth) && - internal_equal (f1->background_pixmap, f2->background_pixmap, depth) && - internal_equal (f1->underline, f2->underline, depth) && - internal_equal (f1->strikethru, f2->strikethru, depth) && - internal_equal (f1->highlight, f2->highlight, depth) && - internal_equal (f1->dim, f2->dim, depth) && - internal_equal (f1->blinking, f2->blinking, depth) && - internal_equal (f1->reverse, f2->reverse, depth) && - - ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1)); -} - -static unsigned long -face_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Face *f = XFACE (obj); - - depth++; - - /* No need to hash all of the elements; that would take too long. - Just hash the most common ones. */ - return HASH3 (internal_hash (f->foreground, depth), - internal_hash (f->background, depth), - internal_hash (f->font, depth)); -} - -static Lisp_Object -face_getprop (Lisp_Object obj, Lisp_Object prop) -{ - struct Lisp_Face *f = XFACE (obj); - - return - ((EQ (prop, Qforeground)) ? f->foreground : - (EQ (prop, Qbackground)) ? f->background : - (EQ (prop, Qfont)) ? f->font : - (EQ (prop, Qdisplay_table)) ? f->display_table : - (EQ (prop, Qbackground_pixmap)) ? f->background_pixmap : - (EQ (prop, Qunderline)) ? f->underline : - (EQ (prop, Qstrikethru)) ? f->strikethru : - (EQ (prop, Qhighlight)) ? f->highlight : - (EQ (prop, Qdim)) ? f->dim : - (EQ (prop, Qblinking)) ? f->blinking : - (EQ (prop, Qreverse)) ? f->reverse : - (EQ (prop, Qdoc_string)) ? f->doc_string : - external_plist_get (&f->plist, prop, 0, ERROR_ME)); -} - -static int -face_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) -{ - struct Lisp_Face *f = XFACE (obj); - - if (EQ (prop, Qforeground) || - EQ (prop, Qbackground) || - EQ (prop, Qfont) || - EQ (prop, Qdisplay_table) || - EQ (prop, Qbackground_pixmap) || - EQ (prop, Qunderline) || - EQ (prop, Qstrikethru) || - EQ (prop, Qhighlight) || - EQ (prop, Qdim) || - EQ (prop, Qblinking) || - EQ (prop, Qreverse)) - return 0; - - if (EQ (prop, Qdoc_string)) - { - if (!NILP (value)) - CHECK_STRING (value); - f->doc_string = value; - return 1; - } - - external_plist_put (&f->plist, prop, value, 0, ERROR_ME); - return 1; -} - -static int -face_remprop (Lisp_Object obj, Lisp_Object prop) -{ - struct Lisp_Face *f = XFACE (obj); - - if (EQ (prop, Qforeground) || - EQ (prop, Qbackground) || - EQ (prop, Qfont) || - EQ (prop, Qdisplay_table) || - EQ (prop, Qbackground_pixmap) || - EQ (prop, Qunderline) || - EQ (prop, Qstrikethru) || - EQ (prop, Qhighlight) || - EQ (prop, Qdim) || - EQ (prop, Qblinking) || - EQ (prop, Qreverse)) - return -1; - - if (EQ (prop, Qdoc_string)) - { - f->doc_string = Qnil; - return 1; - } - - return external_remprop (&f->plist, prop, 0, ERROR_ME); -} - -static Lisp_Object -face_plist (Lisp_Object obj) -{ - struct Lisp_Face *face = XFACE (obj); - Lisp_Object result = face->plist; - - result = cons3 (Qreverse, face->reverse, result); - result = cons3 (Qblinking, face->blinking, result); - result = cons3 (Qdim, face->dim, result); - result = cons3 (Qhighlight, face->highlight, result); - result = cons3 (Qstrikethru, face->strikethru, result); - result = cons3 (Qunderline, face->underline, result); - result = cons3 (Qbackground_pixmap, face->background_pixmap, result); - result = cons3 (Qdisplay_table, face->display_table, result); - result = cons3 (Qfont, face->font, result); - result = cons3 (Qbackground, face->background, result); - result = cons3 (Qforeground, face->foreground, result); - - return result; -} - -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("face", face, - mark_face, print_face, 0, face_equal, - face_hash, face_getprop, - face_putprop, face_remprop, - face_plist, struct Lisp_Face); - -/************************************************************************/ -/* face read syntax */ -/************************************************************************/ - -static int -face_name_validate (Lisp_Object keyword, Lisp_Object value, - Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME)) - { - CHECK_SYMBOL (value); - return 1; - } - - return SYMBOLP (value); -} - -static int -face_validate (Lisp_Object data, Error_behavior errb) -{ - int name_seen = 0; - Lisp_Object valw = Qnil; - - data = Fcdr (data); /* skip over Qface */ - while (!NILP (data)) - { - Lisp_Object keyw = Fcar (data); - - data = Fcdr (data); - valw = Fcar (data); - data = Fcdr (data); - if (EQ (keyw, Qname)) - name_seen = 1; - else - abort (); - } - - if (!name_seen) - { - maybe_error (Qface, errb, "No face name given"); - return 0; - } - - if (NILP (Ffind_face (valw))) - { - maybe_signal_simple_error ("No such face", valw, Qface, errb); - return 0; - } - - return 1; -} - -static Lisp_Object -face_instantiate (Lisp_Object data) -{ - return Fget_face (Fcar (Fcdr (data))); -} - - -/**************************************************************************** - * utility functions * - ****************************************************************************/ - -static void -reset_face (struct Lisp_Face *f) -{ - f->name = Qnil; - f->doc_string = Qnil; - f->dirty = 0; - f->foreground = Qnil; - f->background = Qnil; - f->font = Qnil; - f->display_table = Qnil; - f->background_pixmap = Qnil; - f->underline = Qnil; - f->strikethru = Qnil; - f->highlight = Qnil; - f->dim = Qnil; - f->blinking = Qnil; - f->reverse = Qnil; - f->plist = Qnil; - f->charsets_warned_about = Qnil; -} - -static struct Lisp_Face * -allocate_face (void) -{ - struct Lisp_Face *result = - alloc_lcrecord_type (struct Lisp_Face, lrecord_face); - - reset_face (result); - return result; -} - - -/* We store the faces in hash tables with the names as the key and the - actual face object as the value. Occasionally we need to use them - in a list format. These routines provide us with that. */ -struct face_list_closure -{ - Lisp_Object *face_list; -}; - -static int -add_face_to_list_mapper (Lisp_Object key, Lisp_Object value, - void *face_list_closure) -{ - /* This function can GC */ - struct face_list_closure *fcl = - (struct face_list_closure *) face_list_closure; - - *(fcl->face_list) = Fcons (XFACE (value)->name, (*fcl->face_list)); - return 0; -} - -static Lisp_Object -faces_list_internal (Lisp_Object list) -{ - Lisp_Object face_list = Qnil; - struct gcpro gcpro1; - struct face_list_closure face_list_closure; - - GCPRO1 (face_list); - face_list_closure.face_list = &face_list; - elisp_maphash (add_face_to_list_mapper, list, &face_list_closure); - UNGCPRO; - - return face_list; -} - -static Lisp_Object -permanent_faces_list (void) -{ - return faces_list_internal (Vpermanent_faces_cache); -} - -static Lisp_Object -temporary_faces_list (void) -{ - return faces_list_internal (Vtemporary_faces_cache); -} - - -static int -mark_face_as_clean_mapper (Lisp_Object key, Lisp_Object value, - void *flag_closure) -{ - /* This function can GC */ - int *flag = (int *) flag_closure; - XFACE (value)->dirty = *flag; - return 0; -} - -static void -mark_all_faces_internal (int flag) -{ - elisp_maphash (mark_face_as_clean_mapper, Vpermanent_faces_cache, &flag); - elisp_maphash (mark_face_as_clean_mapper, Vtemporary_faces_cache, &flag); -} - -void -mark_all_faces_as_clean (void) -{ - mark_all_faces_internal (0); -} - -/* Currently unused (see the comment in face_property_was_changed()). */ -#if 0 -/* #### OBSOLETE ME, PLEASE. Maybe. Maybe this is just as good as - any other solution. */ -struct face_inheritance_closure -{ - Lisp_Object face; - Lisp_Object property; -}; - -static void -update_inheritance_mapper_internal (Lisp_Object cur_face, - Lisp_Object inh_face, - Lisp_Object property) -{ - /* #### fix this function */ - Lisp_Object elt = Qnil; - struct gcpro gcpro1; - - GCPRO1 (elt); - - for (elt = FACE_PROPERTY_SPEC_LIST (cur_face, property, Qall); - !NILP (elt); - elt = XCDR (elt)) - { - Lisp_Object values = XCDR (XCAR (elt)); - - for (; !NILP (values); values = XCDR (values)) - { - Lisp_Object value = XCDR (XCAR (values)); - if (VECTORP (value) && XVECTOR_LENGTH (value)) - { - if (EQ (Ffind_face (XVECTOR_DATA (value)[0]), inh_face)) - Fset_specifier_dirty_flag - (FACE_PROPERTY_SPECIFIER (inh_face, property)); - } - } - } - - UNGCPRO; -} - -static int -update_face_inheritance_mapper (CONST void *hash_key, void *hash_contents, - void *face_inheritance_closure) -{ - Lisp_Object key, contents; - struct face_inheritance_closure *fcl = - (struct face_inheritance_closure *) face_inheritance_closure; - - CVOID_TO_LISP (key, hash_key); - VOID_TO_LISP (contents, hash_contents); - - if (EQ (fcl->property, Qfont)) - { - update_inheritance_mapper_internal (contents, fcl->face, Qfont); - } - else if (EQ (fcl->property, Qforeground) || - EQ (fcl->property, Qbackground)) - { - update_inheritance_mapper_internal (contents, fcl->face, Qforeground); - update_inheritance_mapper_internal (contents, fcl->face, Qbackground); - } - else if (EQ (fcl->property, Qunderline) || - EQ (fcl->property, Qstrikethru) || - EQ (fcl->property, Qhighlight) || - EQ (fcl->property, Qdim) || - EQ (fcl->property, Qblinking) || - EQ (fcl->property, Qreverse)) - { - update_inheritance_mapper_internal (contents, fcl->face, Qunderline); - update_inheritance_mapper_internal (contents, fcl->face, Qstrikethru); - update_inheritance_mapper_internal (contents, fcl->face, Qhighlight); - update_inheritance_mapper_internal (contents, fcl->face, Qdim); - update_inheritance_mapper_internal (contents, fcl->face, Qblinking); - update_inheritance_mapper_internal (contents, fcl->face, Qreverse); - } - return 0; -} - -static void -update_faces_inheritance (Lisp_Object face, Lisp_Object property) -{ - struct face_inheritance_closure face_inheritance_closure; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (face, property); - face_inheritance_closure.face = face; - face_inheritance_closure.property = property; - - elisp_maphash (update_face_inheritance_mapper, Vpermanent_faces_cache, - &face_inheritance_closure); - elisp_maphash (update_face_inheritance_mapper, Vtemporary_faces_cache, - &face_inheritance_closure); - - UNGCPRO; -} -#endif /* 0 */ - -Lisp_Object -face_property_matching_instance (Lisp_Object face, Lisp_Object property, - Lisp_Object charset, Lisp_Object domain, - Error_behavior errb, int no_fallback, - Lisp_Object depth) -{ - Lisp_Object retval = - specifier_instance_no_quit (Fget (face, property, Qnil), charset, - domain, errb, no_fallback, depth); - - if (UNBOUNDP (retval) && !no_fallback) - { - if (EQ (property, Qfont)) - { - if (NILP (memq_no_quit (charset, - XFACE (face)->charsets_warned_about))) - { -#ifdef MULE - if (! UNBOUNDP (charset)) - warn_when_safe - (Qfont, Qwarning, - "Unable to instantiate font for face %s, charset %s", - string_data (symbol_name - (XSYMBOL (XFACE (face)->name))), - string_data (symbol_name - (XSYMBOL (XCHARSET_NAME (charset))))); - else -#endif - warn_when_safe (Qfont, Qwarning, - "Unable to instantiate font for face %s", - string_data (symbol_name - (XSYMBOL (XFACE (face)->name)))); - XFACE (face)->charsets_warned_about = - Fcons (charset, XFACE (face)->charsets_warned_about); - } - retval = Vthe_null_font_instance; - } - } - - return retval; -} - - -DEFUN ("facep", Ffacep, 1, 1, 0, /* -Return non-nil if OBJECT is a face. -*/ - (object)) -{ - return FACEP (object) ? Qt : Qnil; -} - -DEFUN ("find-face", Ffind_face, 1, 1, 0, /* -Retrieve the face of the given name. -If FACE-OR-NAME is a face object, it is simply returned. -Otherwise, FACE-OR-NAME should be a symbol. If there is no such face, -nil is returned. Otherwise the associated face object is returned. -*/ - (face_or_name)) -{ - Lisp_Object retval; - - if (FACEP (face_or_name)) - return face_or_name; - CHECK_SYMBOL (face_or_name); - - /* Check if the name represents a permanent face. */ - retval = Fgethash (face_or_name, Vpermanent_faces_cache, Qnil); - if (!NILP (retval)) - return retval; - - /* Check if the name represents a temporary face. */ - return Fgethash (face_or_name, Vtemporary_faces_cache, Qnil); -} - -DEFUN ("get-face", Fget_face, 1, 1, 0, /* -Retrieve the face of the given name. -Same as `find-face' except an error is signalled if there is no such -face instead of returning nil. -*/ - (name)) -{ - Lisp_Object face = Ffind_face (name); - - if (NILP (face)) - signal_simple_error ("No such face", name); - return face; -} - -DEFUN ("face-name", Fface_name, 1, 1, 0, /* -Return the name of the given face. -*/ - (face)) -{ - return XFACE (Fget_face (face))->name; -} - -DEFUN ("built-in-face-specifiers", Fbuilt_in_face_specifiers, 0, 0, 0, /* -Return a list of all built-in face specifier properties. -Don't modify this list! -*/ - ()) -{ - return Vbuilt_in_face_specifiers; -} - -/* These values are retrieved so often that we make a special - function. -*/ - -void -default_face_font_info (Lisp_Object domain, int *ascent, int *descent, - int *height, int *width, int *proportional_p) -{ - Lisp_Object font_instance; - - if (noninteractive) - { - if (ascent) - *ascent = 1; - if (descent) - *descent = 0; - if (height) - *height = 1; - if (width) - *width = 1; - if (proportional_p) - *proportional_p = 0; - return; - } - - /* We use ASCII here. This is probably reasonable because the - people calling this function are using the resulting values to - come up with overall sizes for windows and frames. */ - if (WINDOWP (domain)) - { - struct face_cachel *cachel; - struct window *w = XWINDOW (domain); - - /* #### It's possible for this function to get called when the - face cachels have not been initialized. I don't know why. */ - if (!Dynarr_length (w->face_cachels)) - reset_face_cachels (w); - cachel = WINDOW_FACE_CACHEL (w, DEFAULT_INDEX); - font_instance = FACE_CACHEL_FONT (cachel, Vcharset_ascii); - } - else - { - font_instance = FACE_FONT (Vdefault_face, domain, Vcharset_ascii); - } - - if (height) - *height = XFONT_INSTANCE (font_instance)->height; - if (width) - *width = XFONT_INSTANCE (font_instance)->width; - if (ascent) - *ascent = XFONT_INSTANCE (font_instance)->ascent; - if (descent) - *descent = XFONT_INSTANCE (font_instance)->descent; - if (proportional_p) - *proportional_p = XFONT_INSTANCE (font_instance)->proportional_p; -} - -void -default_face_height_and_width (Lisp_Object domain, - int *height, int *width) -{ - default_face_font_info (domain, 0, 0, height, width, 0); -} - -void -default_face_height_and_width_1 (Lisp_Object domain, - int *height, int *width) -{ - if (window_system_pixelated_geometry (domain)) - { - if (height) - *height = 1; - if (width) - *width = 1; - } - else - default_face_height_and_width (domain, height, width); -} - -DEFUN ("face-list", Fface_list, 0, 1, 0, /* -Return a list of the names of all defined faces. -If TEMPORARY is nil, only the permanent faces are included. -If it is t, only the temporary faces are included. If it is any -other non-nil value both permanent and temporary are included. -*/ - (temporary)) -{ - Lisp_Object face_list = Qnil; - - /* Added the permanent faces, if requested. */ - if (NILP (temporary) || !EQ (Qt, temporary)) - face_list = permanent_faces_list (); - - if (!NILP (temporary)) - { - struct gcpro gcpro1; - GCPRO1 (face_list); - face_list = nconc2 (face_list, temporary_faces_list ()); - UNGCPRO; - } - - return face_list; -} - -DEFUN ("make-face", Fmake_face, 1, 3, 0, /* -Define and return a new FACE described by DOC-STRING. -You can modify the font, color, etc of a face with the set-face-* functions. -If the face already exists, it is unmodified. -If TEMPORARY is non-nil, this face will cease to exist if not in use. -*/ - (name, doc_string, temporary)) -{ - /* This function can GC if initialized is non-zero */ - struct Lisp_Face *f; - Lisp_Object face; - - CHECK_SYMBOL (name); - if (!NILP (doc_string)) - CHECK_STRING (doc_string); - - face = Ffind_face (name); - if (!NILP (face)) - return face; - - f = allocate_face (); - XSETFACE (face, f); - - f->name = name; - f->doc_string = doc_string; - f->foreground = Fmake_specifier (Qcolor); - set_color_attached_to (f->foreground, face, Qforeground); - f->background = Fmake_specifier (Qcolor); - set_color_attached_to (f->background, face, Qbackground); - f->font = Fmake_specifier (Qfont); - set_font_attached_to (f->font, face, Qfont); - f->background_pixmap = Fmake_specifier (Qimage); - set_image_attached_to (f->background_pixmap, face, Qbackground_pixmap); - f->display_table = Fmake_specifier (Qdisplay_table); - f->underline = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->underline, face, Qunderline); - f->strikethru = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->strikethru, face, Qstrikethru); - f->highlight = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->highlight, face, Qhighlight); - f->dim = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->dim, face, Qdim); - f->blinking = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->blinking, face, Qblinking); - f->reverse = Fmake_specifier (Qface_boolean); - set_face_boolean_attached_to (f->reverse, face, Qreverse); - if (!NILP (Vdefault_face)) - { - /* If the default face has already been created, set it as - the default fallback specifier for all the specifiers we - just created. This implements the standard "all faces - inherit from default" behavior. */ - set_specifier_fallback (f->foreground, - Fget (Vdefault_face, Qforeground, Qunbound)); - set_specifier_fallback (f->background, - Fget (Vdefault_face, Qbackground, Qunbound)); - set_specifier_fallback (f->font, - Fget (Vdefault_face, Qfont, Qunbound)); - set_specifier_fallback (f->background_pixmap, - Fget (Vdefault_face, Qbackground_pixmap, - Qunbound)); - set_specifier_fallback (f->display_table, - Fget (Vdefault_face, Qdisplay_table, Qunbound)); - set_specifier_fallback (f->underline, - Fget (Vdefault_face, Qunderline, Qunbound)); - set_specifier_fallback (f->strikethru, - Fget (Vdefault_face, Qstrikethru, Qunbound)); - set_specifier_fallback (f->highlight, - Fget (Vdefault_face, Qhighlight, Qunbound)); - set_specifier_fallback (f->dim, - Fget (Vdefault_face, Qdim, Qunbound)); - set_specifier_fallback (f->blinking, - Fget (Vdefault_face, Qblinking, Qunbound)); - set_specifier_fallback (f->reverse, - Fget (Vdefault_face, Qreverse, Qunbound)); - } - - /* Add the face to the appropriate list. */ - if (NILP (temporary)) - Fputhash (name, face, Vpermanent_faces_cache); - else - Fputhash (name, face, Vtemporary_faces_cache); - - /* Note that it's OK if we dump faces. - When we start up again when we're not noninteractive, - `init-global-faces' is called and it resources all - existing faces. */ - if (initialized && !noninteractive) - { - struct gcpro gcpro1, gcpro2; - - GCPRO2 (name, face); - call1 (Qinit_face_from_resources, name); - UNGCPRO; - } - - return face; -} - - -/***************************************************************************** - initialization code - ****************************************************************************/ - -void -init_global_faces (struct device *d) -{ - /* When making the initial terminal device, there is no Lisp code - loaded, so we can't do this. */ - if (initialized && !noninteractive) - { - call_critical_lisp_code (d, Qinit_global_faces, Qnil); - } -} - -void -init_device_faces (struct device *d) -{ - /* This function can call lisp */ - - /* When making the initial terminal device, there is no Lisp code - loaded, so we can't do this. */ - if (initialized) - { - Lisp_Object tdevice; - XSETDEVICE (tdevice, d); - call_critical_lisp_code (d, Qinit_device_faces, tdevice); - } -} - -void -init_frame_faces (struct frame *frm) -{ - /* When making the initial terminal device, there is no Lisp code - loaded, so we can't do this. */ - if (initialized) - { - Lisp_Object tframe; - XSETFRAME (tframe, frm); - - /* DO NOT change the selected frame here. If the debugger goes off - it will try and display on the frame being created, but it is not - ready for that yet and a horrible death will occur. Any random - code depending on the selected-frame as an implicit arg should be - tracked down and shot. For the benefit of the one known, - xpm-color-symbols, make-frame sets the variable - Vframe_being_created to the frame it is making and sets it to nil - when done. Internal functions that this could trigger which are - currently depending on selected-frame should use this instead. It - is not currently visible at the lisp level. */ - call_critical_lisp_code (XDEVICE (FRAME_DEVICE (frm)), - Qinit_frame_faces, tframe); - } -} - - -/**************************************************************************** - * face cache element functions * - ****************************************************************************/ - -/* - -#### Here is a description of how the face cache elements ought -to be redone. It is *NOT* how they work currently: - -However, when I started to go about implementing this, I realized -that there are all sorts of subtle problems with cache coherency -that are coming up. As it turns out, these problems don't -manifest themselves now due to the brute-force "kill 'em all" -approach to cache invalidation when faces change; but if this -is ever made smarter, these problems are going to come up, and -some of them are very non-obvious. - -I'm thinking of redoing the cache code a bit to avoid these -coherency problems. The bulk of the problems will arise because -the current display structures have simple indices into the -face cache, but the cache can be changed at various times, -which could make the current display structures incorrect. -I guess the dirty and updated flags are an attempt to fix -this, but this approach doesn't really work. - -Here's an approach that should keep things clean and unconfused: - -1) Imagine a "virtual face cache" that can grow arbitrarily - big and for which the only thing allowed is to add new - elements. Existing elements cannot be removed or changed. - This way, any pointers in the existing redisplay structure - into the cache never get screwed up. (This is important - because even if a cache element is out of date, if there's - a pointer to it then its contents still accurately describe - the way the text currently looks on the screen.) -2) Each element in the virtual cache either describes exactly - one face, or describes the merger of a number of faces - by some process. In order to simplify things, for mergers - we do not record which faces or ordering was used, but - simply that this cache element is the result of merging. - Unlike the current implementation, it's important that a - single cache element not be used to both describe a - single face and describe a merger, even if all the property - values are the same. -3) Each cache element can be clean or dirty. "Dirty" means - that the face that the element points to has been changed; - this gets set at the time the face is changed. This - way, when looking up a value in the cache, you can determine - whether it's out of date or not. For merged faces it - does not matter -- we don't record the faces or priority - used to create the merger, so it's impossible to look up - one of these faces. We have to recompute it each time. - Luckily, this is fine -- doing the merge is much - less expensive than recomputing the properties of a - single face. -4) For each cache element, we keep a hash value. (In order - to hash the boolean properties, we convert each of them - into a different large prime number so that the hashing works - well.) This allows us, when comparing runes, to properly - determine whether the face for that rune has changed. - This will be especially important for TTY's, where there - aren't that many faces and minimizing redraw is very - important. -5) We can't actually keep an infinite cache, but that doesn't - really matter that much. The only elements we care about - are those that are used by either the current or desired - display structs. Therefore, we keep a per-window - redisplay iteration number, and mark each element with - that number as we use it. Just after outputting the - window and synching the redisplay structs, we go through - the cache and invalidate all elements that are not clean - elements referring to a particular face and that do not - have an iteration number equal to the current one. We - keep them in a chain, and use them to allocate new - elements when possible instead of increasing the Dynarr. - - */ - -/* mark for GC a dynarr of face cachels. */ - -void -mark_face_cachels (face_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) -{ - int elt; - - if (!elements) - return; - - for (elt = 0; elt < Dynarr_length (elements); elt++) - { - struct face_cachel *cachel = Dynarr_atp (elements, elt); - - { - int i; - - for (i = 0; i < NUM_LEADING_BYTES; i++) - if (!NILP (cachel->font[i]) && !UNBOUNDP (cachel->font[i])) - markobj (cachel->font[i]); - } - markobj (cachel->face); - markobj (cachel->foreground); - markobj (cachel->background); - markobj (cachel->display_table); - markobj (cachel->background_pixmap); - } -} - -/* ensure that the given cachel contains an updated font value for - the given charset. Return the updated font value. */ - -Lisp_Object -ensure_face_cachel_contains_charset (struct face_cachel *cachel, - Lisp_Object domain, Lisp_Object charset) -{ - Lisp_Object new_val; - Lisp_Object face = cachel->face; - int bound = 1; - int offs = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; - - if (!UNBOUNDP (cachel->font[offs]) - && cachel->font_updated[offs]) - return cachel->font[offs]; - - if (UNBOUNDP (face)) - { - /* a merged face. */ - int i; - struct window *w = XWINDOW (domain); - - new_val = Qunbound; - cachel->font_specified[offs] = 0; - for (i = 0; i < cachel->nfaces; i++) - { - struct face_cachel *oth; - - oth = Dynarr_atp (w->face_cachels, - FACE_CACHEL_FINDEX_UNSAFE (cachel, i)); - /* Tout le monde aime la recursion */ - ensure_face_cachel_contains_charset (oth, domain, charset); - - if (oth->font_specified[offs]) - { - new_val = oth->font[offs]; - cachel->font_specified[offs] = 1; - break; - } - } - - if (!cachel->font_specified[offs]) - /* need to do the default face. */ - { - struct face_cachel *oth = - Dynarr_atp (w->face_cachels, DEFAULT_INDEX); - ensure_face_cachel_contains_charset (oth, domain, charset); - - new_val = oth->font[offs]; - } - - if (!UNBOUNDP (cachel->font[offs]) && !EQ (cachel->font[offs], new_val)) - cachel->dirty = 1; - cachel->font_updated[offs] = 1; - cachel->font[offs] = new_val; - return new_val; - } - - new_val = face_property_matching_instance (face, Qfont, charset, domain, - /* #### look into ERROR_ME_NOT */ - ERROR_ME_NOT, 1, Qzero); - if (UNBOUNDP (new_val)) - { - bound = 0; - new_val = face_property_matching_instance (face, Qfont, - charset, domain, - /* #### look into - ERROR_ME_NOT */ - ERROR_ME_NOT, 0, Qzero); - } - if (!UNBOUNDP (cachel->font[offs]) && !EQ (new_val, cachel->font[offs])) - cachel->dirty = 1; - cachel->font_updated[offs] = 1; - cachel->font[offs] = new_val; - cachel->font_specified[offs] = (bound || EQ (face, Vdefault_face)); - return new_val; -} - -/* Ensure that the given cachel contains updated fonts for all - the charsets specified. */ - -void -ensure_face_cachel_complete (struct face_cachel *cachel, - Lisp_Object domain, unsigned char *charsets) -{ - int i; - - for (i = 0; i < NUM_LEADING_BYTES; i++) - if (charsets[i]) - { - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); - assert (CHARSETP (charset)); - ensure_face_cachel_contains_charset (cachel, domain, charset); - } -} - -void -face_cachel_charset_font_metric_info (struct face_cachel *cachel, - unsigned char *charsets, - struct font_metric_info *fm) -{ - int i; - - fm->width = 1; - fm->height = fm->ascent = 1; - fm->descent = 0; - fm->proportional_p = 0; - - for (i = 0; i < NUM_LEADING_BYTES; i++) - { - if (charsets[i]) - { - Lisp_Object charset = CHARSET_BY_LEADING_BYTE (i + MIN_LEADING_BYTE); - Lisp_Object font_instance = FACE_CACHEL_FONT (cachel, charset); - struct Lisp_Font_Instance *fi = XFONT_INSTANCE (font_instance); - - assert (CHARSETP (charset)); - assert (FONT_INSTANCEP (font_instance)); - - if (fm->ascent < (int) fi->ascent) fm->ascent = (int) fi->ascent; - if (fm->descent < (int) fi->descent) fm->descent = (int) fi->descent; - fm->height = fm->ascent + fm->descent; - if (fi->proportional_p) - fm->proportional_p = 1; - if (EQ (charset, Vcharset_ascii)) - fm->width = fi->width; - } - } -} - -/* Called when the updated flag has been cleared on a cachel. */ - -void -update_face_cachel_data (struct face_cachel *cachel, - Lisp_Object domain, - Lisp_Object face) -{ - if (XFACE (face)->dirty || UNBOUNDP (cachel->face)) - { - int default_face = EQ (face, Vdefault_face); - cachel->face = face; - - /* We normally only set the _specified flags if the value was - actually bound. The exception is for the default face where - we always set it since it is the ultimate fallback. */ - -#define FROB(field) \ - do { \ - Lisp_Object new_val = \ - FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ - int bound = 1; \ - if (UNBOUNDP (new_val)) \ - { \ - bound = 0; \ - new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ - } \ - if (!EQ (new_val, cachel->field)) \ - { \ - cachel->field = new_val; \ - cachel->dirty = 1; \ - } \ - cachel->field##_specified = (bound || default_face); \ - } while (0) - - FROB (foreground); - FROB (background); - FROB (display_table); - FROB (background_pixmap); - - /* - * A face's background pixmap will override the face's - * background color. But the background pixmap of the - * default face should not override the background color of - * a face if the background color has been specified or - * inherited. - * - * To accomplish this we remove the background pixmap of the - * cachel and mark it as having been specified so that cachel - * merging won't override it later. - */ - if (! default_face - && cachel->background_specified - && ! cachel->background_pixmap_specified) - { - cachel->background_pixmap = Qunbound; - cachel->background_pixmap_specified = 1; - } - -#undef FROB - - ensure_face_cachel_contains_charset (cachel, domain, Vcharset_ascii); - -#define FROB(field) \ - do { \ - Lisp_Object new_val = \ - FACE_PROPERTY_INSTANCE (face, Q##field, domain, 1, Qzero); \ - int bound = 1; \ - unsigned int new_val_int; \ - if (UNBOUNDP (new_val)) \ - { \ - bound = 0; \ - new_val = FACE_PROPERTY_INSTANCE (face, Q##field, domain, 0, Qzero); \ - } \ - new_val_int = EQ (new_val, Qt); \ - if (cachel->field != new_val_int) \ - { \ - cachel->field = new_val_int; \ - cachel->dirty = 1; \ - } \ - cachel->field##_specified = bound; \ - } while (0) - - FROB (underline); - FROB (strikethru); - FROB (highlight); - FROB (dim); - FROB (reverse); - FROB (blinking); -#undef FROB - } - - cachel->updated = 1; -} - -/* Merge the cachel identified by FINDEX in window W into the given - cachel. */ - -static void -merge_face_cachel_data (struct window *w, face_index findex, - struct face_cachel *cachel) -{ -#define FINDEX_FIELD(field) \ - Dynarr_atp (w->face_cachels, findex)->field - -#define FROB(field) \ - do { \ - if (!cachel->field##_specified && FINDEX_FIELD (field##_specified)) \ - { \ - cachel->field = FINDEX_FIELD (field); \ - cachel->field##_specified = 1; \ - cachel->dirty = 1; \ - } \ - } while (0) - - FROB (foreground); - FROB (background); - FROB (display_table); - FROB (background_pixmap); - FROB (underline); - FROB (strikethru); - FROB (highlight); - FROB (dim); - FROB (reverse); - FROB (blinking); - /* And do ASCII, of course. */ - { - int offs = LEADING_BYTE_ASCII - MIN_LEADING_BYTE; - - if (!cachel->font_specified[offs] && FINDEX_FIELD (font_specified[offs])) - { - cachel->font[offs] = FINDEX_FIELD (font[offs]); - cachel->font_specified[offs] = 1; - cachel->dirty = 1; - } - } - -#undef FROB -#undef FINDEX_FIELD - - cachel->updated = 1; -} - -/* Initialize a cachel. */ - -void -reset_face_cachel (struct face_cachel *cachel) -{ - xzero (*cachel); - cachel->face = Qunbound; - cachel->nfaces = 0; - cachel->merged_faces = 0; - cachel->foreground = Qunbound; - cachel->background = Qunbound; - { - int i; - - for (i = 0; i < NUM_LEADING_BYTES; i++) - cachel->font[i] = Qunbound; - } - cachel->display_table = Qunbound; - cachel->background_pixmap = Qunbound; -} - -/* Add a cachel for the given face to the given window's cache. */ - -static void -add_face_cachel (struct window *w, Lisp_Object face) -{ - struct face_cachel new_cachel; - Lisp_Object window; - - reset_face_cachel (&new_cachel); - XSETWINDOW (window, w); - update_face_cachel_data (&new_cachel, window, face); - Dynarr_add (w->face_cachels, new_cachel); -} - -/* Retrieve the index to a cachel for window W that corresponds to - the specified face. If necessary, add a new element to the - cache. */ - -face_index -get_builtin_face_cache_index (struct window *w, Lisp_Object face) -{ - int elt; - - if (noninteractive) - return 0; - - for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) - { - struct face_cachel *cachel = WINDOW_FACE_CACHEL (w, elt); - - if (EQ (cachel->face, face)) - { - Lisp_Object window; - XSETWINDOW (window, w); - if (!cachel->updated) - update_face_cachel_data (cachel, window, face); - return elt; - } - } - - /* If we didn't find the face, add it and then return its index. */ - add_face_cachel (w, face); - return elt; -} - -void -reset_face_cachels (struct window *w) -{ - /* #### Not initialized in batch mode for the stream device. */ - if (w->face_cachels) - { - int i; - - for (i = 0; i < Dynarr_length (w->face_cachels); i++) - { - struct face_cachel *cachel = Dynarr_atp (w->face_cachels, i); - if (cachel->merged_faces) - Dynarr_free (cachel->merged_faces); - } - Dynarr_reset (w->face_cachels); - get_builtin_face_cache_index (w, Vdefault_face); - get_builtin_face_cache_index (w, Vmodeline_face); - XFRAME (w->frame)->window_face_cache_reset = 1; - } -} - -void -mark_face_cachels_as_clean (struct window *w) -{ - int elt; - - for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) - Dynarr_atp (w->face_cachels, elt)->dirty = 0; -} - -void -mark_face_cachels_as_not_updated (struct window *w) -{ - int elt; - - for (elt = 0; elt < Dynarr_length (w->face_cachels); elt++) - { - struct face_cachel *cachel = Dynarr_atp (w->face_cachels, elt); - int i; - - cachel->updated = 0; - for (i = 0; i < NUM_LEADING_BYTES; i++) - cachel->font_updated[i] = 0; - } -} - -#ifdef MEMORY_USAGE_STATS - -int -compute_face_cachel_usage (face_cachel_dynarr *face_cachels, - struct overhead_stats *ovstats) -{ - int total = 0; - - if (face_cachels) - { - int i; - - total += Dynarr_memory_usage (face_cachels, ovstats); - for (i = 0; i < Dynarr_length (face_cachels); i++) - { - int_dynarr *merged = Dynarr_at (face_cachels, i).merged_faces; - if (merged) - total += Dynarr_memory_usage (merged, ovstats); - } - } - - return total; -} - -#endif /* MEMORY_USAGE_STATS */ - - -/***************************************************************************** - * merged face functions * - *****************************************************************************/ - -/* Compare two merged face cachels to determine whether we have to add - a new entry to the face cache. - - Note that we do not compare the attributes, but just the faces the - cachels are based on. If they are the same, then the cachels certainly - ought to have the same attributes, except in the case where fonts - for different charsets have been determined in the two -- and in that - case this difference is fine. */ - -static int -compare_merged_face_cachels (struct face_cachel *cachel1, - struct face_cachel *cachel2) -{ - int i; - - if (!EQ (cachel1->face, cachel2->face) - || cachel1->nfaces != cachel2->nfaces) - return 0; - - for (i = 0; i < cachel1->nfaces; i++) - if (FACE_CACHEL_FINDEX_UNSAFE (cachel1, i) - != FACE_CACHEL_FINDEX_UNSAFE (cachel2, i)) - return 0; - - return 1; -} - -/* Retrieve the index to a cachel for window W that corresponds to - the specified cachel. If necessary, add a new element to the - cache. This is similar to get_builtin_face_cache_index() but - is intended for merged cachels rather than for cachels representing - just a face. - - Note that a merged cachel for just one face is not the same as - the simple cachel for that face, because it is also merged with - the default face. */ - -static face_index -get_merged_face_cache_index (struct window *w, - struct face_cachel *merged_cachel) -{ - int elt; - int cache_size = Dynarr_length (w->face_cachels); - - for (elt = 0; elt < cache_size; elt++) - { - struct face_cachel *cachel = - Dynarr_atp (w->face_cachels, elt); - - if (compare_merged_face_cachels (cachel, merged_cachel)) - return elt; - } - - /* We didn't find it so add this instance to the cache. */ - merged_cachel->updated = 1; - merged_cachel->dirty = 1; - Dynarr_add (w->face_cachels, *merged_cachel); - return cache_size; -} - -face_index -get_extent_fragment_face_cache_index (struct window *w, - struct extent_fragment *ef) -{ - struct face_cachel cachel; - int len = Dynarr_length (ef->extents); - face_index findex = 0; - Lisp_Object window; - XSETWINDOW (window, w); - - /* Optimize the default case. */ - if (len == 0) - return DEFAULT_INDEX; - else - { - int i; - - /* Merge the faces of the extents together in order. */ - - reset_face_cachel (&cachel); - - for (i = len - 1; i >= 0; i--) - { - EXTENT current = Dynarr_at (ef->extents, i); - int has_findex = 0; - Lisp_Object face = extent_face (current); - - if (FACEP (face)) - { - findex = get_builtin_face_cache_index (w, face); - has_findex = 1; - merge_face_cachel_data (w, findex, &cachel); - } - /* remember, we're called from within redisplay - so we can't error. */ - else while (CONSP (face)) - { - Lisp_Object one_face = XCAR (face); - if (FACEP (one_face)) - { - findex = get_builtin_face_cache_index (w, one_face); - merge_face_cachel_data (w, findex, &cachel); - - /* code duplication here but there's no clean - way to avoid it. */ - if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) - { - if (!cachel.merged_faces) - cachel.merged_faces = Dynarr_new (int); - Dynarr_add (cachel.merged_faces, findex); - } - else - cachel.merged_faces_static[cachel.nfaces] = findex; - cachel.nfaces++; - } - face = XCDR (face); - } - - if (has_findex) - { - if (cachel.nfaces >= NUM_STATIC_CACHEL_FACES) - { - if (!cachel.merged_faces) - cachel.merged_faces = Dynarr_new (int); - Dynarr_add (cachel.merged_faces, findex); - } - else - cachel.merged_faces_static[cachel.nfaces] = findex; - cachel.nfaces++; - } - } - - /* Now finally merge in the default face. */ - findex = get_builtin_face_cache_index (w, Vdefault_face); - merge_face_cachel_data (w, findex, &cachel); - - return get_merged_face_cache_index (w, &cachel); - } -} - - -/***************************************************************************** - interface functions - ****************************************************************************/ - -static void -update_EmacsFrame (Lisp_Object frame, Lisp_Object name) -{ - struct frame *frm = XFRAME (frame); - - if (EQ (name, Qfont)) - MARK_FRAME_SIZE_SLIPPED (frm); - - MAYBE_FRAMEMETH (frm, update_frame_external_traits, (frm, name)); -} - -static void -update_EmacsFrames (Lisp_Object locale, Lisp_Object name) -{ - if (FRAMEP (locale)) - { - update_EmacsFrame (locale, name); - } - else if (DEVICEP (locale)) - { - Lisp_Object frmcons; - - DEVICE_FRAME_LOOP (frmcons, XDEVICE (locale)) - update_EmacsFrame (XCAR (frmcons), name); - } - else if (EQ (locale, Qglobal) || EQ (locale, Qfallback)) - { - Lisp_Object frmcons, devcons, concons; - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - update_EmacsFrame (XCAR (frmcons), name); - } -} - -void -update_frame_face_values (struct frame *f) -{ - Lisp_Object frm; - - XSETFRAME (frm, f); - update_EmacsFrame (frm, Qforeground); - update_EmacsFrame (frm, Qbackground); - update_EmacsFrame (frm, Qfont); -} - -void -face_property_was_changed (Lisp_Object face, Lisp_Object property, - Lisp_Object locale) -{ - int default_face = EQ (face, Vdefault_face); - - /* If the locale could affect the frame value, then call - update_EmacsFrames just in case. */ - if (default_face && - (EQ (property, Qforeground) || - EQ (property, Qbackground) || - EQ (property, Qfont))) - update_EmacsFrames (locale, property); - - if (WINDOWP (locale)) - { - MARK_FRAME_FACES_CHANGED (XFRAME (XWINDOW (locale)->frame)); - } - else if (FRAMEP (locale)) - { - MARK_FRAME_FACES_CHANGED (XFRAME (locale)); - } - else if (DEVICEP (locale)) - { - MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (locale)); - } - else - { - Lisp_Object devcons, concons; - DEVICE_LOOP_NO_BREAK (devcons, concons) - MARK_DEVICE_FRAMES_FACES_CHANGED (XDEVICE (XCAR (devcons))); - } - - /* - * This call to update_faces_inheritance isn't needed and makes - * creating and modifying faces _very_ slow. The point of - * update_face_inheritances is to find all faces that inherit - * directly from this face property and set the specifier "dirty" - * flag on the corresponding specifier. This forces recaching of - * cached specifier values in frame and window struct slots. But - * currently no face properties are cached in frame and window - * struct slots, so calling this function does nothing useful! - * - * Further, since update_faces_inheritance maps over the whole - * face table every time it is called, it gets terribly slow when - * there are many faces. Creating 500 faces on a 50Mhz 486 took - * 433 seconds when update_faces_inheritance was called. With the - * call commented out, creating those same 500 faces took 0.72 - * seconds. - */ - /* update_faces_inheritance (face, property);*/ - XFACE (face)->dirty = 1; -} - -DEFUN ("copy-face", Fcopy_face, 2, 6, 0, /* -Define and return a new face which is a copy of an existing one, -or makes an already-existing face be exactly like another. -LOCALE, TAG-SET, EXACT-P, and HOW-TO-ADD are as in `copy-specifier'. -*/ - (old_face, new_name, locale, tag_set, exact_p, how_to_add)) -{ - struct Lisp_Face *fold, *fnew; - Lisp_Object new_face = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - old_face = Fget_face (old_face); - - /* We GCPRO old_face because it might be temporary, and GCing could - occur in various places below. */ - GCPRO4 (tag_set, locale, old_face, new_face); - /* check validity of how_to_add now. */ - decode_how_to_add_specification (how_to_add); - /* and of tag_set. */ - tag_set = decode_specifier_tag_set (tag_set); - /* and of locale. */ - locale = decode_locale_list (locale); - - new_face = Ffind_face (new_name); - if (NILP (new_face)) - { - Lisp_Object temp; - - CHECK_SYMBOL (new_name); - - /* Create the new face with the same status as the old face. */ - temp = (NILP (Fgethash (old_face, Vtemporary_faces_cache, Qnil)) - ? Qnil - : Qt); - - new_face = Fmake_face (new_name, Qnil, temp); - } - - fold = XFACE (old_face); - fnew = XFACE (new_face); - -#define COPY_PROPERTY(property) \ - Fcopy_specifier (fold->property, fnew->property, \ - locale, tag_set, exact_p, how_to_add); - - COPY_PROPERTY (foreground); - COPY_PROPERTY (background); - COPY_PROPERTY (font); - COPY_PROPERTY (display_table); - COPY_PROPERTY (background_pixmap); - COPY_PROPERTY (underline); - COPY_PROPERTY (strikethru); - COPY_PROPERTY (highlight); - COPY_PROPERTY (dim); - COPY_PROPERTY (blinking); - COPY_PROPERTY (reverse); -#undef COPY_PROPERTY - /* #### should it copy the individual specifiers, if they exist? */ - fnew->plist = Fcopy_sequence (fold->plist); - - UNGCPRO; - - return new_name; -} - - -void -syms_of_faces (void) -{ - /* Qdefault & Qwidget defined in general.c */ - defsymbol (&Qmodeline, "modeline"); - defsymbol (&Qgui_element, "gui-element"); - defsymbol (&Qleft_margin, "left-margin"); - defsymbol (&Qright_margin, "right-margin"); - defsymbol (&Qtext_cursor, "text-cursor"); - defsymbol (&Qvertical_divider, "vertical-divider"); - - DEFSUBR (Ffacep); - DEFSUBR (Ffind_face); - DEFSUBR (Fget_face); - DEFSUBR (Fface_name); - DEFSUBR (Fbuilt_in_face_specifiers); - DEFSUBR (Fface_list); - DEFSUBR (Fmake_face); - DEFSUBR (Fcopy_face); - - defsymbol (&Qfacep, "facep"); - defsymbol (&Qforeground, "foreground"); - defsymbol (&Qbackground, "background"); - /* Qfont defined in general.c */ - defsymbol (&Qdisplay_table, "display-table"); - defsymbol (&Qbackground_pixmap, "background-pixmap"); - defsymbol (&Qunderline, "underline"); - defsymbol (&Qstrikethru, "strikethru"); - /* Qhighlight, Qreverse defined in general.c */ - defsymbol (&Qdim, "dim"); - defsymbol (&Qblinking, "blinking"); - - defsymbol (&Qinit_face_from_resources, "init-face-from-resources"); - defsymbol (&Qinit_global_faces, "init-global-faces"); - defsymbol (&Qinit_device_faces, "init-device-faces"); - defsymbol (&Qinit_frame_faces, "init-frame-faces"); -} - -void -structure_type_create_faces (void) -{ - struct structure_type *st; - - st = define_structure_type (Qface, face_validate, face_instantiate); - - define_structure_type_keyword (st, Qname, face_name_validate); -} - -void -vars_of_faces (void) -{ - staticpro (&Vpermanent_faces_cache); - Vpermanent_faces_cache = Qnil; - staticpro (&Vtemporary_faces_cache); - Vtemporary_faces_cache = Qnil; - - staticpro (&Vdefault_face); - Vdefault_face = Qnil; - staticpro (&Vgui_element_face); - Vgui_element_face = Qnil; - staticpro (&Vwidget_face); - Vwidget_face = Qnil; - staticpro (&Vmodeline_face); - Vmodeline_face = Qnil; - staticpro (&Vtoolbar_face); - Vtoolbar_face = Qnil; - - staticpro (&Vvertical_divider_face); - Vvertical_divider_face = Qnil; - staticpro (&Vleft_margin_face); - Vleft_margin_face = Qnil; - staticpro (&Vright_margin_face); - Vright_margin_face = Qnil; - staticpro (&Vtext_cursor_face); - Vtext_cursor_face = Qnil; - staticpro (&Vpointer_face); - Vpointer_face = Qnil; - - { - Lisp_Object syms[20]; - int n = 0; - - syms[n++] = Qforeground; - syms[n++] = Qbackground; - syms[n++] = Qfont; - syms[n++] = Qdisplay_table; - syms[n++] = Qbackground_pixmap; - syms[n++] = Qunderline; - syms[n++] = Qstrikethru; - syms[n++] = Qhighlight; - syms[n++] = Qdim; - syms[n++] = Qblinking; - syms[n++] = Qreverse; - - Vbuilt_in_face_specifiers = pure_list (n, syms); - staticpro (&Vbuilt_in_face_specifiers); - } -} - -void -complex_vars_of_faces (void) -{ - Vpermanent_faces_cache = - make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - Vtemporary_faces_cache = - make_lisp_hash_table (0, HASH_TABLE_WEAK, HASH_TABLE_EQ); - - /* Create the default face now so we know what it is immediately. */ - - Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus - default value */ - Vdefault_face = Fmake_face (Qdefault, build_string ("default face"), - Qnil); - - /* Provide some last-resort fallbacks to avoid utter fuckage if - someone provides invalid values for the global specifications. */ - - { - Lisp_Object fg_fb = Qnil, bg_fb = Qnil; - -#ifdef HAVE_X_WINDOWS - fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb); - bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb); -#endif -#ifdef HAVE_TTY - fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); - bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); -#endif -#ifdef HAVE_MS_WINDOWS - fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); - bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb); -#endif - set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb); - set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb); - } - - /* #### We may want to have different fallback values if NeXTstep - support is compiled in. */ - { - Lisp_Object inst_list = Qnil; -#ifdef HAVE_X_WINDOWS - /* The same gory list from x-faces.el. - (#### Perhaps we should remove the stuff from x-faces.el - and only depend on this stuff here? That should work.) - */ - CONST char *fonts[] = - { - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", - "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*", - "-*-courier-*-r-*-*-*-120-*-*-*-*-iso8859-*", - "-*-*-medium-r-*-*-*-120-*-*-m-*-iso8859-*", - "-*-*-medium-r-*-*-*-120-*-*-c-*-iso8859-*", - "-*-*-*-r-*-*-*-120-*-*-m-*-iso8859-*", - "-*-*-*-r-*-*-*-120-*-*-c-*-iso8859-*", - "-*-*-*-r-*-*-*-120-*-*-*-*-iso8859-*", - "-*-*-medium-r-*-*-*-120-*-*-m-*-*-*", - "-*-*-medium-r-*-*-*-120-*-*-c-*-*-*", - "-*-*-*-r-*-*-*-120-*-*-m-*-*-*", - "-*-*-*-r-*-*-*-120-*-*-c-*-*-*", - "-*-*-*-r-*-*-*-120-*-*-*-*-*-*", - "-*-*-*-*-*-*-*-120-*-*-*-*-*-*", - "*" - }; - CONST char **fontptr; - - for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--) - inst_list = Fcons (Fcons (list1 (Qx), build_string (*fontptr)), - inst_list); -#endif /* HAVE_X_WINDOWS */ - -#ifdef HAVE_TTY - inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")), - inst_list); -#endif /* HAVE_TTY */ -#ifdef HAVE_MS_WINDOWS - inst_list = Fcons (Fcons (list1 (Qmswindows), - build_string ("Fixedsys:Regular:9::Western")), inst_list); - inst_list = Fcons (Fcons (list1 (Qmswindows), - build_string ("Courier:Regular:10::Western")), inst_list); - inst_list = Fcons (Fcons (list1 (Qmswindows), - build_string ("Courier New:Regular:10::Western")), inst_list); -#endif /* HAVE_MS_WINDOWS */ - set_specifier_fallback (Fget (Vdefault_face, Qfont, Qnil), inst_list); - } - - set_specifier_fallback (Fget (Vdefault_face, Qunderline, Qnil), - list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qstrikethru, Qnil), - list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qhighlight, Qnil), - list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qdim, Qnil), - list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qblinking, Qnil), - list1 (Fcons (Qnil, Qnil))); - set_specifier_fallback (Fget (Vdefault_face, Qreverse, Qnil), - list1 (Fcons (Qnil, Qnil))); - - /* gui-element is the parent face of all gui elements such as - modeline, vertical divider and toolbar. */ - Vgui_element_face = Fmake_face (Qgui_element, - build_string ("gui element face"), - Qnil); - - /* Provide some last-resort fallbacks for gui-element face which - mustn't default to default. */ - { - Lisp_Object fg_fb = Qnil, bg_fb = Qnil; - -#ifdef HAVE_X_WINDOWS - fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb); - bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb); -#endif -#ifdef HAVE_TTY - fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb); - bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb); -#endif -#ifdef HAVE_MS_WINDOWS - fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb); - bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb); -#endif - set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb); - set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb); - } - - /* Now create the other faces that redisplay needs to refer to - directly. We could create them in Lisp but it's simpler this - way since we need to get them anyway. */ - - /* modeline is gui element. */ - Vmodeline_face = Fmake_face (Qmodeline, build_string ("modeline face"), - Qnil); - - set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound), - Fget (Vgui_element_face, Qforeground, Qunbound)); - set_specifier_fallback (Fget (Vmodeline_face, Qbackground, Qunbound), - Fget (Vgui_element_face, Qbackground, Qunbound)); - set_specifier_fallback (Fget (Vmodeline_face, Qbackground_pixmap, Qnil), - Fget (Vgui_element_face, Qbackground_pixmap, - Qunbound)); - - /* toolbar is another gui element */ - Vtoolbar_face = Fmake_face (Qtoolbar, - build_string ("toolbar face"), - Qnil); - set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound), - Fget (Vgui_element_face, Qforeground, Qunbound)); - set_specifier_fallback (Fget (Vtoolbar_face, Qbackground, Qunbound), - Fget (Vgui_element_face, Qbackground, Qunbound)); - set_specifier_fallback (Fget (Vtoolbar_face, Qbackground_pixmap, Qnil), - Fget (Vgui_element_face, Qbackground_pixmap, - Qunbound)); - - /* vertical divider is another gui element */ - Vvertical_divider_face = Fmake_face (Qvertical_divider, - build_string ("vertical divider face"), - Qnil); - - set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound), - Fget (Vgui_element_face, Qforeground, Qunbound)); - set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground, Qunbound), - Fget (Vgui_element_face, Qbackground, Qunbound)); - set_specifier_fallback (Fget (Vvertical_divider_face, Qbackground_pixmap, - Qunbound), - Fget (Vgui_element_face, Qbackground_pixmap, - Qunbound)); - - /* widget is another gui element */ - Vwidget_face = Fmake_face (Qwidget, - build_string ("widget face"), - Qnil); - set_specifier_fallback (Fget (Vwidget_face, Qforeground, Qunbound), - Fget (Vgui_element_face, Qforeground, Qunbound)); - set_specifier_fallback (Fget (Vwidget_face, Qbackground, Qunbound), - Fget (Vgui_element_face, Qbackground, Qunbound)); - set_specifier_fallback (Fget (Vwidget_face, Qbackground_pixmap, Qnil), - Fget (Vgui_element_face, Qbackground_pixmap, - Qunbound)); - - Vleft_margin_face = Fmake_face (Qleft_margin, - build_string ("left margin face"), - Qnil); - Vright_margin_face = Fmake_face (Qright_margin, - build_string ("right margin face"), - Qnil); - Vtext_cursor_face = Fmake_face (Qtext_cursor, - build_string ("face for text cursor"), - Qnil); - Vpointer_face = - Fmake_face (Qpointer, - build_string - ("face for foreground/background colors of mouse pointer"), - Qnil); -} diff --git a/src/faces.h b/src/faces.h deleted file mode 100644 index c2e821d..0000000 --- a/src/faces.h +++ /dev/null @@ -1,372 +0,0 @@ -/* Face data structures. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Ben Wing - -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. */ - -#ifndef _XEMACS_FACES_H_ -#define _XEMACS_FACES_H_ - -#include "buffer.h" /* for NUM_LEADING_BYTES */ - -/* a struct Lisp_Face is the C object corresponding to a face. There - is one of these per face. It basically contains all of the specifiers - for the built-in face properties, plus the plist of user-specified - properties. */ - -struct Lisp_Face -{ - struct lcrecord_header header; - - Lisp_Object name; - Lisp_Object doc_string; - unsigned int dirty :1; /* Set whenever a face property is changed on - a face. */ - - Lisp_Object foreground; - Lisp_Object background; - Lisp_Object font; - - Lisp_Object display_table; - Lisp_Object background_pixmap; - - Lisp_Object underline; - Lisp_Object strikethru; - Lisp_Object highlight; - Lisp_Object dim; - Lisp_Object blinking; - Lisp_Object reverse; - - Lisp_Object plist; - - Lisp_Object charsets_warned_about; -}; - -/* - - A face cache element caches the results of instantiating the - properties of a face in a particular window. (Instantiation can - take a long time so this is very important.) Each window contains - an array of face cache elements (called the "face cache"), one for - each face that has been seen in the window so far. - - Some tricky stuff is done to make sure the face cache does not - become inconsistent: - - 1) Switching buffers in a window clears the face cache for that - window, because this can change the way any property is - instantiated in the window. - 2) Setting a face property causes that face to be marked as - dirty. This causes various stuff to happen to make sure - the appropriate face cache elements are invalidated. - (#### Actually this doesn't work quite right, and errs - too much on the side of invalidating unnecessary stuff.) - - There are also face cache elements for "merged faces", which are the - result of merging all the faces that overlap a particular buffer - position. The merging is always done in the context of a particular - domain (specifically, a window), and the face cache element is - specific to a particular window. (Face cache elements are contained - in an array that is attached to each struct_window.) The reason that - the merging takes place in the context of a particular window has - to do with the way the merging works: - - 1) All extents overlying the buffer position are sorted by descending - priority. - 2) The property of a particular merged face comes from the highest- - priority face that specifies a value for that particular property. - 3) The way to determine whether a face specifies a value for a - particular property is to instantiate that face's property in - the window in question with the no-fallback option set, to - see if we got anything. - - For Mule, things get a bit trickier because there can be multiple - fonts per face/window combination -- the charset is an argument - to specifier-instance. - - We have two possible data structure representations: - - 1) Keep the original "one font per face cache element" representation - and use a different face cache element for each charset. - 2) Allow multiple fonts to be in a single face cache element. - - I've chosen to use (2) -- the data structure gets more complicated - but the algorithms for maintaining face cache elements end up - simpler. - */ - -#define NUM_STATIC_CACHEL_FACES 4 - -typedef struct face_cachel face_cachel; -struct face_cachel -{ - /* There are two kinds of cachels; those created from a single face - and those created by merging more than one face. In the former - case, the FACE element specifies the face used. In the latter - case, the MERGED_FACES_STATIC and MERGED_FACES elements specify - the faces used for merging by giving the indices of the - corresponding single-face cachels. - - Formerly we didn't bother to keep track of the faces used for - merging. We do know because we need to do so because there is no - other way to properly handle multiple charsets for Mule in the - presence of display tables short of always computing the values - for all charsets, which is very expensive. Instead, we use a - lazy scheme where we only compute the font for a particular charset - when it is needed. (The exception is the font for the ASCII charset. - We always compute it, just like the other attributes, because - many places in the C code refer to the font of the ASCII charset - and expect it to always be there.) - - We store the first four faces in a static array, and use a - Dynarr for the rest. This has the advantage that the space used - is small but the Dynarr will almost never be created, so we - won't spend much time in malloc()/free(). - - The order of the faces here is decreasing extent priority. */ - Lisp_Object face; - int merged_faces_static[NUM_STATIC_CACHEL_FACES]; - int_dynarr *merged_faces; - int nfaces; - - /* The values stored here are computed by calling specifier_instance() - on the appropriate specifiers. This means that we will have either - a value computed from the face itself or a value computed from the - default face. We need to distinguish the two so that merging works - properly -- a value that comes from the default face is treated - as "unspecified" during merging and is overridden by lower-priority - faces. This is what the _specified flags below are for. */ - - Lisp_Object foreground; - Lisp_Object background; - /* There are currently 128 possible charsets under Mule. For the - moment we just take the easy way out and allocate space for each - of them. This avoids messing with Dynarrs. - - #### We should look into this and probably clean it up - to use Dynarrs. This may be a big space hog as is. */ - Lisp_Object font[NUM_LEADING_BYTES]; - - Lisp_Object display_table; - Lisp_Object background_pixmap; - - unsigned int underline :1; - unsigned int strikethru :1; - unsigned int highlight :1; - unsigned int dim :1; - unsigned int blinking :1; - unsigned int reverse :1; - - /* Used when merging to tell if the above field represents an actual - value of this face or a fallback value. */ - /* #### Of course we should use a bit array or something. */ - unsigned char font_specified[NUM_LEADING_BYTES]; - unsigned int foreground_specified :1; - unsigned int background_specified :1; - unsigned int display_table_specified :1; - unsigned int background_pixmap_specified :1; - - unsigned int strikethru_specified :1; - unsigned int underline_specified :1; - unsigned int highlight_specified :1; - unsigned int dim_specified :1; - unsigned int blinking_specified :1; - unsigned int reverse_specified :1; - - /* The updated flag is set after we calculate the values for the - face cachel and cleared whenever a face changes, to indicate - that the values stored here might be wrong. The next time - we go to access the values, we recompute them; if any values - change, we set the DIRTY flag, which tells the output routines - that a face value has in fact changed and the sections of text - using this face need to be redrawn. - - It is trickier with fonts because we don't automatically - recompute the fonts but do it only when it is necessary. - (The ASCII font is an exception, of course; see above). - - In the case of fonts, we maintain a separate updated flag - for each font. Whenever we need to access the font for - a particular charset, we recalculate it if either its - value is Qunbound (meaning it's never been computed at all) - or the updated flag is not set. We set the dirty flag if - the value is not the same as before and the previous value - was not Qunbound. - - #### Note that we don't yet deal with the case of the new - value being Qunbound, as could happen if no fonts of the - right sort are available on the system. In this case, the - whole program will just crash. For the moment, this is - OK (for debugging purposes) but we should fix this by - storing a "blank font" if the instantiation fails. */ - unsigned int dirty :1; - unsigned int updated :1; - /* #### Of course we should use a bit array or something. */ - unsigned char font_updated[NUM_LEADING_BYTES]; -}; - -DECLARE_LRECORD (face, struct Lisp_Face); -#define XFACE(x) XRECORD (x, face, struct Lisp_Face) -#define XSETFACE(x, p) XSETRECORD (x, p, face) -#define FACEP(x) RECORDP (x, face) -#define GC_FACEP(x) GC_RECORDP (x, face) -#define CHECK_FACE(x) CHECK_RECORD (x, face) - -Lisp_Object ensure_face_cachel_contains_charset (struct face_cachel *cachel, - Lisp_Object domain, - Lisp_Object charset); -void ensure_face_cachel_complete (struct face_cachel *cachel, - Lisp_Object domain, - unsigned char *charsets); -void update_face_cachel_data (struct face_cachel *cachel, - Lisp_Object domain, - Lisp_Object face); -void face_cachel_charset_font_metric_info (struct face_cachel *cachel, - unsigned char *charsets, - struct font_metric_info *fm); -void mark_face_cachels (face_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); -void mark_face_cachels_as_clean (struct window *w); -void mark_face_cachels_as_not_updated (struct window *w); -void reset_face_cachel (struct face_cachel *inst); -void reset_face_cachels (struct window *w); -face_index get_builtin_face_cache_index (struct window *w, - Lisp_Object face); -#ifdef MEMORY_USAGE_STATS -int compute_face_cachel_usage (face_cachel_dynarr *face_cachels, - struct overhead_stats *ovstats); -#endif /* MEMORY_USAGE_STATS */ - -EXFUN (Fface_name, 1); -EXFUN (Ffind_face, 1); -EXFUN (Fget_face, 1); - -extern Lisp_Object Qstrikethru, Vbuilt_in_face_specifiers, Vdefault_face; -extern Lisp_Object Vleft_margin_face, Vpointer_face, Vright_margin_face; -extern Lisp_Object Vtext_cursor_face, Vvertical_divider_face; -extern Lisp_Object Vtoolbar_face, Vgui_element_face, Vwidget_face; - -void mark_all_faces_as_clean (void); -void init_frame_faces (struct frame *f); -void init_device_faces (struct device *d); -void init_global_faces (struct device *d); -face_index get_extent_fragment_face_cache_index (struct window *w, - struct extent_fragment *ef); -void update_frame_face_values (struct frame *f); -void face_property_was_changed (Lisp_Object face, Lisp_Object property, - Lisp_Object locale); -void default_face_font_info (Lisp_Object domain, int *ascent, - int *descent, int *height, int *width, - int *proportional_p); -void default_face_height_and_width (Lisp_Object domain, - int *height, int *width); -void default_face_height_and_width_1 (Lisp_Object domain, - int *height, int *width); - -#define FACE_CACHEL_FONT(cachel, charset) \ - (cachel->font[XCHARSET_LEADING_BYTE (charset) - 128]) - -#define WINDOW_FACE_CACHEL(window, index) \ - Dynarr_atp ((window)->face_cachels, index) - -#define FACE_CACHEL_FINDEX_UNSAFE(cachel, offset) \ - ((offset) < NUM_STATIC_CACHEL_FACES \ - ? (cachel)->merged_faces_static[offset] \ - : Dynarr_at ((cachel)->merged_faces, (offset) - NUM_STATIC_CACHEL_FACES)) - -#define WINDOW_FACE_CACHEL_FACE(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->face) -#define WINDOW_FACE_CACHEL_FOREGROUND(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->foreground) -#define WINDOW_FACE_CACHEL_BACKGROUND(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->background) -/* #### This can be referenced by various functions, - but face_cachels isn't initialized for the stream device. - Since it doesn't need the value we just return nil here to avoid - blowing up in multiple places. */ -#define WINDOW_FACE_CACHEL_FONT(window, index, charset) \ - ((window)->face_cachels \ - ? FACE_CACHEL_FONT (WINDOW_FACE_CACHEL (window, index), charset) \ - : Qnil) -#define WINDOW_FACE_CACHEL_DISPLAY_TABLE(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->display_table) -#define WINDOW_FACE_CACHEL_BACKGROUND_PIXMAP(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->background_pixmap) -#define WINDOW_FACE_CACHEL_DIRTY(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->dirty) -#define WINDOW_FACE_CACHEL_UNDERLINE_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->underline) -#define WINDOW_FACE_CACHEL_HIGHLIGHT_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->highlight) -#define WINDOW_FACE_CACHEL_DIM_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->dim) -#define WINDOW_FACE_CACHEL_BLINKING_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->blinking) -#define WINDOW_FACE_CACHEL_REVERSE_P(window, index) \ - (WINDOW_FACE_CACHEL (window, index)->reverse) - -#define FACE_PROPERTY_SPECIFIER(face, property) Fget (face, property, Qnil) - -#define FACE_PROPERTY_INSTANCE_1(face, property, domain, errb, no_fallback, depth) \ - specifier_instance (FACE_PROPERTY_SPECIFIER (face, property), Qunbound, \ - domain, errb, 1, no_fallback, depth) - -#define FACE_PROPERTY_INSTANCE(face, property, domain, no_fallback, depth) \ - FACE_PROPERTY_INSTANCE_1 (face, property, domain, ERROR_ME_NOT, \ - no_fallback, depth) - -Lisp_Object face_property_matching_instance (Lisp_Object face, - Lisp_Object property, - Lisp_Object charset, - Lisp_Object domain, - Error_behavior errb, - int no_fallback, - Lisp_Object depth); - -#define FACE_PROPERTY_SPEC_LIST(face, property, locale) \ - Fspecifier_spec_list (FACE_PROPERTY_SPECIFIER (face, property), \ - locale, Qnil, Qnil) -#define SET_FACE_PROPERTY(face, property, locale, value, tag, how_to_add) \ - Fadd_spec_to_specifier (FACE_PROPERTY_SPECIFIER (face, property), \ - locale, value, tag, how_to_add) - -#define FACE_FOREGROUND(face, domain) \ - FACE_PROPERTY_INSTANCE (face, Qforeground, domain, 0, Qzero) -#define FACE_BACKGROUND(face, domain) \ - FACE_PROPERTY_INSTANCE (face, Qbackground, domain, 0, Qzero) -#define FACE_FONT(face, domain, charset) \ - face_property_matching_instance (face, Qfont, charset, domain, \ - ERROR_ME_NOT, 0, Qzero) -#define FACE_DISPLAY_TABLE(face, domain) \ - FACE_PROPERTY_INSTANCE (face, Qdisplay_table, domain, 0, Qzero) -#define FACE_BACKGROUND_PIXMAP(face, domain) \ - FACE_PROPERTY_INSTANCE (face, Qbackground_pixmap, domain, 0, Qzero) -#define FACE_UNDERLINE_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qunderline, domain, 0, Qzero))) -#define FACE_HIGHLIGHT_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qhighlight, domain, 0, Qzero))) -#define FACE_DIM_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qdim, domain, 0, Qzero))) -#define FACE_BLINKING_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qblinking, domain, 0, Qzero))) -#define FACE_REVERSE_P(face, domain) \ - (!NILP (FACE_PROPERTY_INSTANCE (face, Qreverse, domain, 0, Qzero))) - -#endif /* _XEMACS_FACES_H_ */ diff --git a/src/file-coding.c b/src/file-coding.c deleted file mode 100644 index ce4f83b..0000000 --- a/src/file-coding.c +++ /dev/null @@ -1,4875 +0,0 @@ -/* Code conversion functions. - Copyright (C) 1991, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: Mule 2.3. Not in FSF. */ - -/* Rewritten by Ben Wing . */ - -#include -#include "lisp.h" -#include "buffer.h" -#include "elhash.h" -#include "insdel.h" -#include "lstream.h" -#ifdef MULE -#include "mule-ccl.h" -#endif -#include "file-coding.h" - -Lisp_Object Qbuffer_file_coding_system, Qcoding_system_error; - -Lisp_Object Vkeyboard_coding_system; -Lisp_Object Vterminal_coding_system; -Lisp_Object Vcoding_system_for_read; -Lisp_Object Vcoding_system_for_write; -Lisp_Object Vfile_name_coding_system; - -/* Table of symbols identifying each coding category. */ -Lisp_Object coding_category_symbol[CODING_CATEGORY_LAST + 1]; - -/* Coding system currently associated with each coding category. */ -Lisp_Object coding_category_system[CODING_CATEGORY_LAST + 1]; - -/* Table of all coding categories in decreasing order of priority. - This describes a permutation of the possible coding categories. */ -int coding_category_by_priority[CODING_CATEGORY_LAST + 1]; - -Lisp_Object Qcoding_system_p; - -Lisp_Object Qno_conversion, Qccl, Qiso2022; -/* Qinternal in general.c */ - -Lisp_Object Qmnemonic, Qeol_type; -Lisp_Object Qcr, Qcrlf, Qlf; -Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf; -Lisp_Object Qpost_read_conversion; -Lisp_Object Qpre_write_conversion; - -#ifdef MULE -Lisp_Object Qbig5, Qshift_jis; -Lisp_Object Qcharset_g0, Qcharset_g1, Qcharset_g2, Qcharset_g3; -Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output; -Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output; -Lisp_Object Qno_iso6429; -Lisp_Object Qinput_charset_conversion, Qoutput_charset_conversion; -Lisp_Object Qctext, Qescape_quoted; -Lisp_Object Qshort, Qno_ascii_eol, Qno_ascii_cntl, Qseven, Qlock_shift; -#endif -Lisp_Object Qencode, Qdecode; - -Lisp_Object Vcoding_system_hash_table; - -int enable_multibyte_characters; - -#ifdef MULE -/* Additional information used by the ISO2022 decoder and detector. */ -struct iso2022_decoder -{ - /* CHARSET holds the character sets currently assigned to the G0 - through G3 variables. It is initialized from the array - INITIAL_CHARSET in CODESYS. */ - Lisp_Object charset[4]; - - /* Which registers are currently invoked into the left (GL) and - right (GR) halves of the 8-bit encoding space? */ - int register_left, register_right; - - /* ISO_ESC holds a value indicating part of an escape sequence - that has already been seen. */ - enum iso_esc_flag esc; - - /* This records the bytes we've seen so far in an escape sequence, - in case the sequence is invalid (we spit out the bytes unchanged). */ - unsigned char esc_bytes[8]; - - /* Index for next byte to store in ISO escape sequence. */ - int esc_bytes_index; - - /* Stuff seen so far when composing a string. */ - unsigned_char_dynarr *composite_chars; - - /* If we saw an invalid designation sequence for a particular - register, we flag it here and switch to ASCII. The next time we - see a valid designation for this register, we turn off the flag - and do the designation normally, but pretend the sequence was - invalid. The effect of all this is that (most of the time) the - escape sequences for both the switch to the unknown charset, and - the switch back to the known charset, get inserted literally into - the buffer and saved out as such. The hope is that we can - preserve the escape sequences so that the resulting written out - file makes sense. If we don't do any of this, the designation - to the invalid charset will be preserved but that switch back - to the known charset will probably get eaten because it was - the same charset that was already present in the register. */ - unsigned char invalid_designated[4]; - - /* We try to do similar things as above for direction-switching - sequences. If we encountered a direction switch while an - invalid designation was present, or an invalid designation - just after a direction switch (i.e. no valid designation - encountered yet), we insert the direction-switch escape - sequence literally into the output stream, and later on - insert the corresponding direction-restoring escape sequence - literally also. */ - unsigned int switched_dir_and_no_valid_charset_yet :1; - unsigned int invalid_switch_dir :1; - - /* Tells the decoder to output the escape sequence literally - even though it was valid. Used in the games we play to - avoid lossage when we encounter invalid designations. */ - unsigned int output_literally :1; - /* We encountered a direction switch followed by an invalid - designation. We didn't output the direction switch - literally because we didn't know about the invalid designation; - but we have to do so now. */ - unsigned int output_direction_sequence :1; -}; -#endif /* MULE */ -EXFUN (Fcopy_coding_system, 2); -#ifdef MULE -struct detection_state; -static int detect_coding_sjis (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_sjis (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void encode_coding_sjis (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static int detect_coding_big5 (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_big5 (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void encode_coding_big5 (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static int postprocess_iso2022_mask (int mask); -static void reset_iso2022 (Lisp_Object coding_system, - struct iso2022_decoder *iso); -static int detect_coding_iso2022 (struct detection_state *st, - CONST unsigned char *src, - unsigned int n); -static void decode_coding_iso2022 (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void encode_coding_iso2022 (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -#endif /* MULE */ -static void decode_coding_no_conversion (Lstream *decoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void encode_coding_no_conversion (Lstream *encoding, - CONST unsigned char *src, - unsigned_char_dynarr *dst, - unsigned int n); -static void mule_decode (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); -static void mule_encode (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n); - -typedef struct codesys_prop codesys_prop; -struct codesys_prop -{ - Lisp_Object sym; - int prop_type; -}; - -typedef struct -{ - Dynarr_declare (codesys_prop); -} codesys_prop_dynarr; - -codesys_prop_dynarr *the_codesys_prop_dynarr; - -enum codesys_prop_enum -{ - CODESYS_PROP_ALL_OK, - CODESYS_PROP_ISO2022, - CODESYS_PROP_CCL -}; - - -/************************************************************************/ -/* Coding system functions */ -/************************************************************************/ - -static Lisp_Object mark_coding_system (Lisp_Object, void (*) (Lisp_Object)); -static void print_coding_system (Lisp_Object, Lisp_Object, int); -static void finalize_coding_system (void *header, int for_disksave); - -DEFINE_LRECORD_IMPLEMENTATION ("coding-system", coding_system, - mark_coding_system, print_coding_system, - finalize_coding_system, - 0, 0, struct Lisp_Coding_System); - -static Lisp_Object -mark_coding_system (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); - - markobj (CODING_SYSTEM_NAME (codesys)); - markobj (CODING_SYSTEM_DOC_STRING (codesys)); - markobj (CODING_SYSTEM_MNEMONIC (codesys)); - markobj (CODING_SYSTEM_EOL_LF (codesys)); - markobj (CODING_SYSTEM_EOL_CRLF (codesys)); - markobj (CODING_SYSTEM_EOL_CR (codesys)); - - switch (CODING_SYSTEM_TYPE (codesys)) - { -#ifdef MULE - int i; - case CODESYS_ISO2022: - for (i = 0; i < 4; i++) - markobj (CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i)); - if (codesys->iso2022.input_conv) - { - for (i = 0; i < Dynarr_length (codesys->iso2022.input_conv); i++) - { - struct charset_conversion_spec *ccs = - Dynarr_atp (codesys->iso2022.input_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); - } - } - if (codesys->iso2022.output_conv) - { - for (i = 0; i < Dynarr_length (codesys->iso2022.output_conv); i++) - { - struct charset_conversion_spec *ccs = - Dynarr_atp (codesys->iso2022.output_conv, i); - markobj (ccs->from_charset); - markobj (ccs->to_charset); - } - } - break; - - case CODESYS_CCL: - markobj (CODING_SYSTEM_CCL_DECODE (codesys)); - markobj (CODING_SYSTEM_CCL_ENCODE (codesys)); - break; -#endif /* MULE */ - default: - break; - } - - markobj (CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys)); - return CODING_SYSTEM_POST_READ_CONVERSION (codesys); -} - -static void -print_coding_system (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag) -{ - struct Lisp_Coding_System *c = XCODING_SYSTEM (obj); - if (print_readably) - error ("printing unreadable object #", - c->header.uid); - - write_c_string ("#name, printcharfun, 1); - write_c_string (">", printcharfun); -} - -static void -finalize_coding_system (void *header, int for_disksave) -{ - struct Lisp_Coding_System *c = (struct Lisp_Coding_System *) header; - /* Since coding systems never go away, this function is not - necessary. But it would be necessary if we changed things - so that coding systems could go away. */ - if (!for_disksave) /* see comment in lstream.c */ - { - switch (CODING_SYSTEM_TYPE (c)) - { -#ifdef MULE - case CODESYS_ISO2022: - if (c->iso2022.input_conv) - { - Dynarr_free (c->iso2022.input_conv); - c->iso2022.input_conv = 0; - } - if (c->iso2022.output_conv) - { - Dynarr_free (c->iso2022.output_conv); - c->iso2022.output_conv = 0; - } - break; -#endif /* MULE */ - default: - break; - } - } -} - -static enum eol_type -symbol_to_eol_type (Lisp_Object symbol) -{ - CHECK_SYMBOL (symbol); - if (NILP (symbol)) return EOL_AUTODETECT; - if (EQ (symbol, Qlf)) return EOL_LF; - if (EQ (symbol, Qcrlf)) return EOL_CRLF; - if (EQ (symbol, Qcr)) return EOL_CR; - - signal_simple_error ("Unrecognized eol type", symbol); - return EOL_AUTODETECT; /* not reached */ -} - -static Lisp_Object -eol_type_to_symbol (enum eol_type type) -{ - switch (type) - { - default: abort (); - case EOL_LF: return Qlf; - case EOL_CRLF: return Qcrlf; - case EOL_CR: return Qcr; - case EOL_AUTODETECT: return Qnil; - } -} - -static void -setup_eol_coding_systems (struct Lisp_Coding_System *codesys) -{ - Lisp_Object codesys_obj; - int len = string_length (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name); - char *codesys_name = (char *) alloca (len + 7); - int mlen = -1; - char *codesys_mnemonic=0; - - Lisp_Object codesys_name_sym, sub_codesys_obj; - - /* kludge */ - - XSETCODING_SYSTEM (codesys_obj, codesys); - - memcpy (codesys_name, - string_data (XSYMBOL (CODING_SYSTEM_NAME (codesys))->name), len); - - if (STRINGP (CODING_SYSTEM_MNEMONIC (codesys))) - { - mlen = XSTRING_LENGTH (CODING_SYSTEM_MNEMONIC (codesys)); - codesys_mnemonic = (char *) alloca (mlen + 7); - memcpy (codesys_mnemonic, - XSTRING_DATA (CODING_SYSTEM_MNEMONIC (codesys)), mlen); - } - -#define DEFINE_SUB_CODESYS(op_sys, op_sys_abbr, Type) do { \ - strcpy (codesys_name + len, "-" op_sys); \ - if (mlen != -1) \ - strcpy (codesys_mnemonic + mlen, op_sys_abbr); \ - codesys_name_sym = intern (codesys_name); \ - sub_codesys_obj = Fcopy_coding_system (codesys_obj, codesys_name_sym); \ - XCODING_SYSTEM_EOL_TYPE (sub_codesys_obj) = Type; \ - if (mlen != -1) \ - XCODING_SYSTEM_MNEMONIC(sub_codesys_obj) = \ - build_string (codesys_mnemonic); \ - CODING_SYSTEM_##Type (codesys) = sub_codesys_obj; \ -} while (0) - - DEFINE_SUB_CODESYS("unix", "", EOL_LF); - DEFINE_SUB_CODESYS("dos", ":T", EOL_CRLF); - DEFINE_SUB_CODESYS("mac", ":t", EOL_CR); -} - -DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /* -Return t if OBJECT is a coding system. -A coding system is an object that defines how text containing multiple -character sets is encoded into a stream of (typically 8-bit) bytes. -The coding system is used to decode the stream into a series of -characters (which may be from multiple charsets) when the text is read -from a file or process, and is used to encode the text back into the -same format when it is written out to a file or process. - -For example, many ISO2022-compliant coding systems (such as Compound -Text, which is used for inter-client data under the X Window System) -use escape sequences to switch between different charsets -- Japanese -Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked -with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See -`make-coding-system' for more information. - -Coding systems are normally identified using a symbol, and the -symbol is accepted in place of the actual coding system object whenever -a coding system is called for. (This is similar to how faces work.) -*/ - (object)) -{ - return CODING_SYSTEMP (object) ? Qt : Qnil; -} - -DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /* -Retrieve the coding system of the given name. - -If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply -returned. Otherwise, CODING-SYSTEM-OR-NAME should be a symbol. -If there is no such coding system, nil is returned. Otherwise the -associated coding system object is returned. -*/ - (coding_system_or_name)) -{ - if (CODING_SYSTEMP (coding_system_or_name)) - return coding_system_or_name; - - if (NILP (coding_system_or_name)) - coding_system_or_name = Qbinary; - else - CHECK_SYMBOL (coding_system_or_name); - - return Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); -} - -DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /* -Retrieve the coding system of the given name. -Same as `find-coding-system' except that if there is no such -coding system, an error is signaled instead of returning nil. -*/ - (name)) -{ - Lisp_Object coding_system = Ffind_coding_system (name); - - if (NILP (coding_system)) - signal_simple_error ("No such coding system", name); - return coding_system; -} - -/* We store the coding systems in hash tables with the names as the key and the - actual coding system object as the value. Occasionally we need to use them - in a list format. These routines provide us with that. */ -struct coding_system_list_closure -{ - Lisp_Object *coding_system_list; -}; - -static int -add_coding_system_to_list_mapper (Lisp_Object key, Lisp_Object value, - void *coding_system_list_closure) -{ - /* This function can GC */ - struct coding_system_list_closure *cscl = - (struct coding_system_list_closure *) coding_system_list_closure; - Lisp_Object *coding_system_list = cscl->coding_system_list; - - *coding_system_list = Fcons (XCODING_SYSTEM (value)->name, - *coding_system_list); - return 0; -} - -DEFUN ("coding-system-list", Fcoding_system_list, 0, 0, 0, /* -Return a list of the names of all defined coding systems. -*/ - ()) -{ - Lisp_Object coding_system_list = Qnil; - struct gcpro gcpro1; - struct coding_system_list_closure coding_system_list_closure; - - GCPRO1 (coding_system_list); - coding_system_list_closure.coding_system_list = &coding_system_list; - elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table, - &coding_system_list_closure); - UNGCPRO; - - return coding_system_list; -} - -DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /* -Return the name of the given coding system. -*/ - (coding_system)) -{ - coding_system = Fget_coding_system (coding_system); - return XCODING_SYSTEM_NAME (coding_system); -} - -static struct Lisp_Coding_System * -allocate_coding_system (enum coding_system_type type, Lisp_Object name) -{ - struct Lisp_Coding_System *codesys = - alloc_lcrecord_type (struct Lisp_Coding_System, lrecord_coding_system); - - zero_lcrecord (codesys); - CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = Qnil; - CODING_SYSTEM_POST_READ_CONVERSION (codesys) = Qnil; - CODING_SYSTEM_EOL_TYPE (codesys) = EOL_AUTODETECT; - CODING_SYSTEM_EOL_CRLF (codesys) = Qnil; - CODING_SYSTEM_EOL_CR (codesys) = Qnil; - CODING_SYSTEM_EOL_LF (codesys) = Qnil; - CODING_SYSTEM_TYPE (codesys) = type; - CODING_SYSTEM_MNEMONIC (codesys) = Qnil; -#ifdef MULE - if (type == CODESYS_ISO2022) - { - int i; - for (i = 0; i < 4; i++) - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i) = Qnil; - } - else if (type == CODESYS_CCL) - { - CODING_SYSTEM_CCL_DECODE (codesys) = Qnil; - CODING_SYSTEM_CCL_ENCODE (codesys) = Qnil; - } -#endif /* MULE */ - CODING_SYSTEM_NAME (codesys) = name; - - return codesys; -} - -#ifdef MULE -/* Given a list of charset conversion specs as specified in a Lisp - program, parse it into STORE_HERE. */ - -static void -parse_charset_conversion_specs (charset_conversion_spec_dynarr *store_here, - Lisp_Object spec_list) -{ - Lisp_Object rest; - - EXTERNAL_LIST_LOOP (rest, spec_list) - { - Lisp_Object car = XCAR (rest); - Lisp_Object from, to; - struct charset_conversion_spec spec; - - if (!CONSP (car) || !CONSP (XCDR (car)) || !NILP (XCDR (XCDR (car)))) - signal_simple_error ("Invalid charset conversion spec", car); - from = Fget_charset (XCAR (car)); - to = Fget_charset (XCAR (XCDR (car))); - if (XCHARSET_TYPE (from) != XCHARSET_TYPE (to)) - signal_simple_error_2 - ("Attempted conversion between different charset types", - from, to); - spec.from_charset = from; - spec.to_charset = to; - - Dynarr_add (store_here, spec); - } -} - -/* Given a dynarr LOAD_HERE of internally-stored charset conversion - specs, return the equivalent as the Lisp programmer would see it. - - If LOAD_HERE is 0, return Qnil. */ - -static Lisp_Object -unparse_charset_conversion_specs (charset_conversion_spec_dynarr *load_here) -{ - int i; - Lisp_Object result; - - if (!load_here) - return Qnil; - for (i = 0, result = Qnil; i < Dynarr_length (load_here); i++) - { - struct charset_conversion_spec *ccs = Dynarr_atp (load_here, i); - result = Fcons (list2 (ccs->from_charset, ccs->to_charset), result); - } - - return Fnreverse (result); -} - -#endif /* MULE */ - -DEFUN ("make-coding-system", Fmake_coding_system, 2, 4, 0, /* -Register symbol NAME as a coding system. - -TYPE describes the conversion method used and should be one of - -nil or 'undecided - Automatic conversion. XEmacs attempts to detect the coding system - used in the file. -'no-conversion - No conversion. Use this for binary files and such. On output, - graphic characters that are not in ASCII or Latin-1 will be - replaced by a ?. (For a no-conversion-encoded buffer, these - characters will only be present if you explicitly insert them.) -'shift-jis - Shift-JIS (a Japanese encoding commonly used in PC operating systems). -'iso2022 - Any ISO2022-compliant encoding. Among other things, this includes - JIS (the Japanese encoding commonly used for e-mail), EUC (the - standard Unix encoding for Japanese and other languages), and - Compound Text (the encoding used in X11). You can specify more - specific information about the conversion with the FLAGS argument. -'big5 - Big5 (the encoding commonly used for Taiwanese). -'ccl - The conversion is performed using a user-written pseudo-code - program. CCL (Code Conversion Language) is the name of this - pseudo-code. -'internal - Write out or read in the raw contents of the memory representing - the buffer's text. This is primarily useful for debugging - purposes, and is only enabled when XEmacs has been compiled with - DEBUG_XEMACS defined (via the --debug configure option). - WARNING: Reading in a file using 'internal conversion can result - in an internal inconsistency in the memory representing a - buffer's text, which will produce unpredictable results and may - cause XEmacs to crash. Under normal circumstances you should - never use 'internal conversion. - -DOC-STRING is a string describing the coding system. - -PROPS is a property list, describing the specific nature of the -character set. Recognized properties are: - -'mnemonic - String to be displayed in the modeline when this coding system is - active. - -'eol-type - End-of-line conversion to be used. It should be one of - - nil - Automatically detect the end-of-line type (LF, CRLF, - or CR). Also generate subsidiary coding systems named - `NAME-unix', `NAME-dos', and `NAME-mac', that are - identical to this coding system but have an EOL-TYPE - value of 'lf, 'crlf, and 'cr, respectively. - 'lf - The end of a line is marked externally using ASCII LF. - Since this is also the way that XEmacs represents an - end-of-line internally, specifying this option results - in no end-of-line conversion. This is the standard - format for Unix text files. - 'crlf - The end of a line is marked externally using ASCII - CRLF. This is the standard format for MS-DOS text - files. - 'cr - The end of a line is marked externally using ASCII CR. - This is the standard format for Macintosh text files. - t - Automatically detect the end-of-line type but do not - generate subsidiary coding systems. (This value is - converted to nil when stored internally, and - `coding-system-property' will return nil.) - -'post-read-conversion - Function called after a file has been read in, to perform the - decoding. Called with two arguments, BEG and END, denoting - a region of the current buffer to be decoded. - -'pre-write-conversion - Function called before a file is written out, to perform the - encoding. Called with two arguments, BEG and END, denoting - a region of the current buffer to be encoded. - - -The following additional properties are recognized if TYPE is 'iso2022: - -'charset-g0 -'charset-g1 -'charset-g2 -'charset-g3 - The character set initially designated to the G0 - G3 registers. - The value should be one of - - -- A charset object (designate that character set) - -- nil (do not ever use this register) - -- t (no character set is initially designated to - the register, but may be later on; this automatically - sets the corresponding `force-g*-on-output' property) - -'force-g0-on-output -'force-g1-on-output -'force-g2-on-output -'force-g2-on-output - If non-nil, send an explicit designation sequence on output before - using the specified register. - -'short - If non-nil, use the short forms "ESC $ @", "ESC $ A", and - "ESC $ B" on output in place of the full designation sequences - "ESC $ ( @", "ESC $ ( A", and "ESC $ ( B". - -'no-ascii-eol - If non-nil, don't designate ASCII to G0 at each end of line on output. - Setting this to non-nil also suppresses other state-resetting that - normally happens at the end of a line. - -'no-ascii-cntl - If non-nil, don't designate ASCII to G0 before control chars on output. - -'seven - If non-nil, use 7-bit environment on output. Otherwise, use 8-bit - environment. - -'lock-shift - If non-nil, use locking-shift (SO/SI) instead of single-shift - or designation by escape sequence. - -'no-iso6429 - If non-nil, don't use ISO6429's direction specification. - -'escape-quoted - If non-nil, literal control characters that are the same as - the beginning of a recognized ISO2022 or ISO6429 escape sequence - (in particular, ESC (0x1B), SO (0x0E), SI (0x0F), SS2 (0x8E), - SS3 (0x8F), and CSI (0x9B)) are "quoted" with an escape character - so that they can be properly distinguished from an escape sequence. - (Note that doing this results in a non-portable encoding.) This - encoding flag is used for byte-compiled files. Note that ESC - is a good choice for a quoting character because there are no - escape sequences whose second byte is a character from the Control-0 - or Control-1 character sets; this is explicitly disallowed by the - ISO2022 standard. - -'input-charset-conversion - A list of conversion specifications, specifying conversion of - characters in one charset to another when decoding is performed. - Each specification is a list of two elements: the source charset, - and the destination charset. - -'output-charset-conversion - A list of conversion specifications, specifying conversion of - characters in one charset to another when encoding is performed. - The form of each specification is the same as for - 'input-charset-conversion. - - -The following additional properties are recognized (and required) -if TYPE is 'ccl: - -'decode - CCL program used for decoding (converting to internal format). - -'encode - CCL program used for encoding (converting to external format). -*/ - (name, type, doc_string, props)) -{ - struct Lisp_Coding_System *codesys; - Lisp_Object rest, key, value; - enum coding_system_type ty; - int need_to_setup_eol_systems = 1; - - /* Convert type to constant */ - if (NILP (type) || EQ (type, Qundecided)) - { ty = CODESYS_AUTODETECT; } -#ifdef MULE - else if (EQ (type, Qshift_jis)) { ty = CODESYS_SHIFT_JIS; } - else if (EQ (type, Qiso2022)) { ty = CODESYS_ISO2022; } - else if (EQ (type, Qbig5)) { ty = CODESYS_BIG5; } - else if (EQ (type, Qccl)) { ty = CODESYS_CCL; } -#endif - else if (EQ (type, Qno_conversion)) { ty = CODESYS_NO_CONVERSION; } -#ifdef DEBUG_XEMACS - else if (EQ (type, Qinternal)) { ty = CODESYS_INTERNAL; } -#endif - else - signal_simple_error ("Invalid coding system type", type); - - CHECK_SYMBOL (name); - - codesys = allocate_coding_system (ty, name); - - if (NILP (doc_string)) - doc_string = build_string (""); - else - CHECK_STRING (doc_string); - CODING_SYSTEM_DOC_STRING (codesys) = doc_string; - - EXTERNAL_PROPERTY_LIST_LOOP (rest, key, value, props) - { - if (EQ (key, Qmnemonic)) - { - if (!NILP (value)) - CHECK_STRING (value); - CODING_SYSTEM_MNEMONIC (codesys) = value; - } - - else if (EQ (key, Qeol_type)) - { - need_to_setup_eol_systems = NILP (value); - if (EQ (value, Qt)) - value = Qnil; - CODING_SYSTEM_EOL_TYPE (codesys) = symbol_to_eol_type (value); - } - - else if (EQ (key, Qpost_read_conversion)) CODING_SYSTEM_POST_READ_CONVERSION (codesys) = value; - else if (EQ (key, Qpre_write_conversion)) CODING_SYSTEM_PRE_WRITE_CONVERSION (codesys) = value; -#ifdef MULE - else if (ty == CODESYS_ISO2022) - { -#define FROB_INITIAL_CHARSET(charset_num) \ - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, charset_num) = \ - ((EQ (value, Qt) || EQ (value, Qnil)) ? value : Fget_charset (value)) - - if (EQ (key, Qcharset_g0)) FROB_INITIAL_CHARSET (0); - else if (EQ (key, Qcharset_g1)) FROB_INITIAL_CHARSET (1); - else if (EQ (key, Qcharset_g2)) FROB_INITIAL_CHARSET (2); - else if (EQ (key, Qcharset_g3)) FROB_INITIAL_CHARSET (3); - -#define FROB_FORCE_CHARSET(charset_num) \ - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (codesys, charset_num) = !NILP (value) - - else if (EQ (key, Qforce_g0_on_output)) FROB_FORCE_CHARSET (0); - else if (EQ (key, Qforce_g1_on_output)) FROB_FORCE_CHARSET (1); - else if (EQ (key, Qforce_g2_on_output)) FROB_FORCE_CHARSET (2); - else if (EQ (key, Qforce_g3_on_output)) FROB_FORCE_CHARSET (3); - -#define FROB_BOOLEAN_PROPERTY(prop) \ - CODING_SYSTEM_ISO2022_##prop (codesys) = !NILP (value) - - else if (EQ (key, Qshort)) FROB_BOOLEAN_PROPERTY (SHORT); - else if (EQ (key, Qno_ascii_eol)) FROB_BOOLEAN_PROPERTY (NO_ASCII_EOL); - else if (EQ (key, Qno_ascii_cntl)) FROB_BOOLEAN_PROPERTY (NO_ASCII_CNTL); - else if (EQ (key, Qseven)) FROB_BOOLEAN_PROPERTY (SEVEN); - else if (EQ (key, Qlock_shift)) FROB_BOOLEAN_PROPERTY (LOCK_SHIFT); - else if (EQ (key, Qno_iso6429)) FROB_BOOLEAN_PROPERTY (NO_ISO6429); - else if (EQ (key, Qescape_quoted)) FROB_BOOLEAN_PROPERTY (ESCAPE_QUOTED); - - else if (EQ (key, Qinput_charset_conversion)) - { - codesys->iso2022.input_conv = - Dynarr_new (charset_conversion_spec); - parse_charset_conversion_specs (codesys->iso2022.input_conv, - value); - } - else if (EQ (key, Qoutput_charset_conversion)) - { - codesys->iso2022.output_conv = - Dynarr_new (charset_conversion_spec); - parse_charset_conversion_specs (codesys->iso2022.output_conv, - value); - } - else - signal_simple_error ("Unrecognized property", key); - } - else if (EQ (type, Qccl)) - { - if (EQ (key, Qdecode)) - { - CHECK_VECTOR (value); - CODING_SYSTEM_CCL_DECODE (codesys) = value; - } - else if (EQ (key, Qencode)) - { - CHECK_VECTOR (value); - CODING_SYSTEM_CCL_ENCODE (codesys) = value; - } - else - signal_simple_error ("Unrecognized property", key); - } -#endif /* MULE */ - else - signal_simple_error ("Unrecognized property", key); - } - - if (need_to_setup_eol_systems) - setup_eol_coding_systems (codesys); - - { - Lisp_Object codesys_obj; - XSETCODING_SYSTEM (codesys_obj, codesys); - Fputhash (name, codesys_obj, Vcoding_system_hash_table); - return codesys_obj; - } -} - -DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /* -Copy OLD-CODING-SYSTEM to NEW-NAME. -If NEW-NAME does not name an existing coding system, a new one will -be created. -*/ - (old_coding_system, new_name)) -{ - Lisp_Object new_coding_system; - old_coding_system = Fget_coding_system (old_coding_system); - new_coding_system = Ffind_coding_system (new_name); - if (NILP (new_coding_system)) - { - XSETCODING_SYSTEM (new_coding_system, - allocate_coding_system - (XCODING_SYSTEM_TYPE (old_coding_system), - new_name)); - Fputhash (new_name, new_coding_system, Vcoding_system_hash_table); - } - - { - struct Lisp_Coding_System *to = XCODING_SYSTEM (new_coding_system); - struct Lisp_Coding_System *from = XCODING_SYSTEM (old_coding_system); - memcpy (((char *) to ) + sizeof (to->header), - ((char *) from) + sizeof (from->header), - sizeof (*from) - sizeof (from->header)); - to->name = new_name; - } - return new_coding_system; -} - -static Lisp_Object -subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); - Lisp_Object new_coding_system; - - if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT) - return coding_system; - - switch (type) - { - case EOL_AUTODETECT: return coding_system; - case EOL_LF: new_coding_system = CODING_SYSTEM_EOL_LF (cs); break; - case EOL_CR: new_coding_system = CODING_SYSTEM_EOL_CR (cs); break; - case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break; - default: abort (); - } - - return NILP (new_coding_system) ? coding_system : new_coding_system; -} - -DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /* -Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE. -*/ - (coding_system, eol_type)) -{ - coding_system = Fget_coding_system (coding_system); - - return subsidiary_coding_system (coding_system, - symbol_to_eol_type (eol_type)); -} - - -/************************************************************************/ -/* Coding system accessors */ -/************************************************************************/ - -DEFUN ("coding-system-doc-string", Fcoding_system_doc_string, 1, 1, 0, /* -Return the doc string for CODING-SYSTEM. -*/ - (coding_system)) -{ - coding_system = Fget_coding_system (coding_system); - return XCODING_SYSTEM_DOC_STRING (coding_system); -} - -DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /* -Return the type of CODING-SYSTEM. -*/ - (coding_system)) -{ - switch (XCODING_SYSTEM_TYPE (Fget_coding_system (coding_system))) - { - default: abort (); - case CODESYS_AUTODETECT: return Qundecided; -#ifdef MULE - case CODESYS_SHIFT_JIS: return Qshift_jis; - case CODESYS_ISO2022: return Qiso2022; - case CODESYS_BIG5: return Qbig5; - case CODESYS_CCL: return Qccl; -#endif - case CODESYS_NO_CONVERSION: return Qno_conversion; -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: return Qinternal; -#endif - } -} - -#ifdef MULE -static -Lisp_Object coding_system_charset (Lisp_Object coding_system, int gnum) -{ - Lisp_Object cs - = XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, gnum); - - return CHARSETP (cs) ? XCHARSET_NAME (cs) : Qnil; -} - -DEFUN ("coding-system-charset", Fcoding_system_charset, 2, 2, 0, /* -Return initial charset of CODING-SYSTEM designated to GNUM. -GNUM allows 0 .. 3. -*/ - (coding_system, gnum)) -{ - coding_system = Fget_coding_system (coding_system); - CHECK_INT (gnum); - - return coding_system_charset (coding_system, XINT (gnum)); -} -#endif /* MULE */ - -DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /* -Return the PROP property of CODING-SYSTEM. -*/ - (coding_system, prop)) -{ - int i, ok = 0; - enum coding_system_type type; - - coding_system = Fget_coding_system (coding_system); - CHECK_SYMBOL (prop); - type = XCODING_SYSTEM_TYPE (coding_system); - - for (i = 0; !ok && i < Dynarr_length (the_codesys_prop_dynarr); i++) - if (EQ (Dynarr_at (the_codesys_prop_dynarr, i).sym, prop)) - { - ok = 1; - switch (Dynarr_at (the_codesys_prop_dynarr, i).prop_type) - { - case CODESYS_PROP_ALL_OK: - break; -#ifdef MULE - case CODESYS_PROP_ISO2022: - if (type != CODESYS_ISO2022) - signal_simple_error - ("Property only valid in ISO2022 coding systems", - prop); - break; - - case CODESYS_PROP_CCL: - if (type != CODESYS_CCL) - signal_simple_error - ("Property only valid in CCL coding systems", - prop); - break; -#endif /* MULE */ - default: - abort (); - } - } - - if (!ok) - signal_simple_error ("Unrecognized property", prop); - - if (EQ (prop, Qname)) - return XCODING_SYSTEM_NAME (coding_system); - else if (EQ (prop, Qtype)) - return Fcoding_system_type (coding_system); - else if (EQ (prop, Qdoc_string)) - return XCODING_SYSTEM_DOC_STRING (coding_system); - else if (EQ (prop, Qmnemonic)) - return XCODING_SYSTEM_MNEMONIC (coding_system); - else if (EQ (prop, Qeol_type)) - return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE (coding_system)); - else if (EQ (prop, Qeol_lf)) - return XCODING_SYSTEM_EOL_LF (coding_system); - else if (EQ (prop, Qeol_crlf)) - return XCODING_SYSTEM_EOL_CRLF (coding_system); - else if (EQ (prop, Qeol_cr)) - return XCODING_SYSTEM_EOL_CR (coding_system); - else if (EQ (prop, Qpost_read_conversion)) - return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system); - else if (EQ (prop, Qpre_write_conversion)) - return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system); -#ifdef MULE - else if (type == CODESYS_ISO2022) - { - if (EQ (prop, Qcharset_g0)) - return coding_system_charset (coding_system, 0); - else if (EQ (prop, Qcharset_g1)) - return coding_system_charset (coding_system, 1); - else if (EQ (prop, Qcharset_g2)) - return coding_system_charset (coding_system, 2); - else if (EQ (prop, Qcharset_g3)) - return coding_system_charset (coding_system, 3); - -#define FORCE_CHARSET(charset_num) \ - (XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT \ - (coding_system, charset_num) ? Qt : Qnil) - - else if (EQ (prop, Qforce_g0_on_output)) return FORCE_CHARSET (0); - else if (EQ (prop, Qforce_g1_on_output)) return FORCE_CHARSET (1); - else if (EQ (prop, Qforce_g2_on_output)) return FORCE_CHARSET (2); - else if (EQ (prop, Qforce_g3_on_output)) return FORCE_CHARSET (3); - -#define LISP_BOOLEAN(prop) \ - (XCODING_SYSTEM_ISO2022_##prop (coding_system) ? Qt : Qnil) - - else if (EQ (prop, Qshort)) return LISP_BOOLEAN (SHORT); - else if (EQ (prop, Qno_ascii_eol)) return LISP_BOOLEAN (NO_ASCII_EOL); - else if (EQ (prop, Qno_ascii_cntl)) return LISP_BOOLEAN (NO_ASCII_CNTL); - else if (EQ (prop, Qseven)) return LISP_BOOLEAN (SEVEN); - else if (EQ (prop, Qlock_shift)) return LISP_BOOLEAN (LOCK_SHIFT); - else if (EQ (prop, Qno_iso6429)) return LISP_BOOLEAN (NO_ISO6429); - else if (EQ (prop, Qescape_quoted)) return LISP_BOOLEAN (ESCAPE_QUOTED); - - else if (EQ (prop, Qinput_charset_conversion)) - return - unparse_charset_conversion_specs - (XCODING_SYSTEM (coding_system)->iso2022.input_conv); - else if (EQ (prop, Qoutput_charset_conversion)) - return - unparse_charset_conversion_specs - (XCODING_SYSTEM (coding_system)->iso2022.output_conv); - else - abort (); - } - else if (type == CODESYS_CCL) - { - if (EQ (prop, Qdecode)) - return XCODING_SYSTEM_CCL_DECODE (coding_system); - else if (EQ (prop, Qencode)) - return XCODING_SYSTEM_CCL_ENCODE (coding_system); - else - abort (); - } -#endif /* MULE */ - else - abort (); - - return Qnil; /* not reached */ -} - - -/************************************************************************/ -/* Coding category functions */ -/************************************************************************/ - -static int -decode_coding_category (Lisp_Object symbol) -{ - int i; - - CHECK_SYMBOL (symbol); - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - if (EQ (coding_category_symbol[i], symbol)) - return i; - - signal_simple_error ("Unrecognized coding category", symbol); - return 0; /* not reached */ -} - -DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /* -Return a list of all recognized coding categories. -*/ - ()) -{ - int i; - Lisp_Object list = Qnil; - - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - list = Fcons (coding_category_symbol[i], list); - return list; -} - -DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /* -Change the priority order of the coding categories. -LIST should be list of coding categories, in descending order of -priority. Unspecified coding categories will be lower in priority -than all specified ones, in the same relative order they were in -previously. -*/ - (list)) -{ - int category_to_priority[CODING_CATEGORY_LAST + 1]; - int i, j; - Lisp_Object rest; - - /* First generate a list that maps coding categories to priorities. */ - - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - category_to_priority[i] = -1; - - /* Highest priority comes from the specified list. */ - i = 0; - EXTERNAL_LIST_LOOP (rest, list) - { - int cat = decode_coding_category (XCAR (rest)); - - if (category_to_priority[cat] >= 0) - signal_simple_error ("Duplicate coding category in list", XCAR (rest)); - category_to_priority[cat] = i++; - } - - /* Now go through the existing categories by priority to retrieve - the categories not yet specified and preserve their priority - order. */ - for (j = 0; j <= CODING_CATEGORY_LAST; j++) - { - int cat = coding_category_by_priority[j]; - if (category_to_priority[cat] < 0) - category_to_priority[cat] = i++; - } - - /* Now we need to construct the inverse of the mapping we just - constructed. */ - - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - coding_category_by_priority[category_to_priority[i]] = i; - - /* Phew! That was confusing. */ - return Qnil; -} - -DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /* -Return a list of coding categories in descending order of priority. -*/ - ()) -{ - int i; - Lisp_Object list = Qnil; - - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - list = Fcons (coding_category_symbol[coding_category_by_priority[i]], - list); - return list; -} - -DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /* -Change the coding system associated with a coding category. -*/ - (coding_category, coding_system)) -{ - int cat = decode_coding_category (coding_category); - - coding_system = Fget_coding_system (coding_system); - coding_category_system[cat] = coding_system; - return Qnil; -} - -DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /* -Return the coding system associated with a coding category. -*/ - (coding_category)) -{ - int cat = decode_coding_category (coding_category); - Lisp_Object sys = coding_category_system[cat]; - - if (!NILP (sys)) - return XCODING_SYSTEM_NAME (sys); - return Qnil; -} - - -/************************************************************************/ -/* Detecting the encoding of data */ -/************************************************************************/ - -struct detection_state -{ - enum eol_type eol_type; - int seen_non_ascii; - int mask; -#ifdef MULE - struct - { - int mask; - int in_second_byte; - } - big5; - - struct - { - int mask; - int in_second_byte; - } - shift_jis; - - struct - { - int mask; - int initted; - struct iso2022_decoder iso; - unsigned int flags; - int high_byte_count; - unsigned int saw_single_shift:1; - } - iso2022; -#endif - struct - { - int seen_anything; - int just_saw_cr; - } - eol; -}; - -static int -acceptable_control_char_p (int c) -{ - switch (c) - { - /* Allow and ignore control characters that you might - reasonably see in a text file */ - case '\r': - case '\n': - case '\t': - case 7: /* bell */ - case 8: /* backspace */ - case 11: /* vertical tab */ - case 12: /* form feed */ - case 26: /* MS-DOS C-z junk */ - case 31: /* '^_' -- for info */ - return 1; - default: - return 0; - } -} - -static int -mask_has_at_most_one_bit_p (int mask) -{ - /* Perhaps the only thing useful you learn from intensive Microsoft - technical interviews */ - return (mask & (mask - 1)) == 0; -} - -static enum eol_type -detect_eol_type (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == '\r') - st->eol.just_saw_cr = 1; - else - { - if (c == '\n') - { - if (st->eol.just_saw_cr) - return EOL_CRLF; - else if (st->eol.seen_anything) - return EOL_LF; - } - else if (st->eol.just_saw_cr) - return EOL_CR; - st->eol.just_saw_cr = 0; - } - st->eol.seen_anything = 1; - } - - return EOL_AUTODETECT; -} - -/* Attempt to determine the encoding and EOL type of the given text. - Before calling this function for the first type, you must initialize - st->eol_type as appropriate and initialize st->mask to ~0. - - st->eol_type holds the determined EOL type, or EOL_AUTODETECT if - not yet known. - - st->mask holds the determined coding category mask, or ~0 if only - ASCII has been seen so far. - - Returns: - - 0 == st->eol_type is EOL_AUTODETECT and/or more than coding category - is present in st->mask - 1 == definitive answers are here for both st->eol_type and st->mask -*/ - -static int -detect_coding_type (struct detection_state *st, CONST unsigned char *src, - unsigned int n, int just_do_eol) -{ - int c; - - if (st->eol_type == EOL_AUTODETECT) - st->eol_type = detect_eol_type (st, src, n); - - if (just_do_eol) - return st->eol_type != EOL_AUTODETECT; - - if (!st->seen_non_ascii) - { - for (; n; n--, src++) - { - c = *src; - if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80) - { - st->seen_non_ascii = 1; -#ifdef MULE - st->shift_jis.mask = ~0; - st->big5.mask = ~0; - st->iso2022.mask = ~0; -#endif - break; - } - } - } - - if (!n) - return 0; -#ifdef MULE - if (!mask_has_at_most_one_bit_p (st->iso2022.mask)) - st->iso2022.mask = detect_coding_iso2022 (st, src, n); - if (!mask_has_at_most_one_bit_p (st->shift_jis.mask)) - st->shift_jis.mask = detect_coding_sjis (st, src, n); - if (!mask_has_at_most_one_bit_p (st->big5.mask)) - st->big5.mask = detect_coding_big5 (st, src, n); - - st->mask = st->iso2022.mask | st->shift_jis.mask | st->big5.mask; -#endif - { - int retval = mask_has_at_most_one_bit_p (st->mask); - st->mask |= CODING_CATEGORY_NO_CONVERSION_MASK; - return retval && st->eol_type != EOL_AUTODETECT; - } -} - -static Lisp_Object -coding_system_from_mask (int mask) -{ - if (mask == ~0) - { - /* If the file was entirely or basically ASCII, use the - default value of `buffer-file-coding-system'. */ - Lisp_Object retval = - XBUFFER (Vbuffer_defaults)->buffer_file_coding_system; - if (!NILP (retval)) - { - retval = Ffind_coding_system (retval); - if (NILP (retval)) - { - warn_when_safe - (Qbad_variable, Qwarning, - "Invalid `default-buffer-file-coding-system', set to nil"); - XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil; - } - } - if (NILP (retval)) - retval = Fget_coding_system (Qno_conversion); - return retval; - } - else - { - int i; - int cat = -1; -#ifdef MULE - mask = postprocess_iso2022_mask (mask); -#endif - /* Look through the coding categories by priority and find - the first one that is allowed. */ - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - { - cat = coding_category_by_priority[i]; - if ((mask & (1 << cat)) && - !NILP (coding_category_system[cat])) - break; - } - if (cat >= 0) - return coding_category_system[cat]; - else - return Fget_coding_system (Qno_conversion); - } -} - -/* Given a seekable read stream and potential coding system and EOL type - as specified, do any autodetection that is called for. If the - coding system and/or EOL type are not autodetect, they will be left - alone; but this function will never return an autodetect coding system - or EOL type. - - This function does not automatically fetch subsidiary coding systems; - that should be unnecessary with the explicit eol-type argument. */ - -void -determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out) -{ - struct detection_state decst; - - if (*eol_type_in_out == EOL_AUTODETECT) - *eol_type_in_out = XCODING_SYSTEM_EOL_TYPE (*codesys_in_out); - - xzero (decst); - decst.eol_type = *eol_type_in_out; - decst.mask = ~0; - - /* If autodetection is called for, do it now. */ - if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT || - *eol_type_in_out == EOL_AUTODETECT) - { - - while (1) - { - unsigned char random_buffer[4096]; - int nread; - - nread = Lstream_read (stream, random_buffer, sizeof (random_buffer)); - if (!nread) - break; - if (detect_coding_type (&decst, random_buffer, nread, - XCODING_SYSTEM_TYPE (*codesys_in_out) != - CODESYS_AUTODETECT)) - break; - } - - *eol_type_in_out = decst.eol_type; - if (XCODING_SYSTEM_TYPE (*codesys_in_out) == CODESYS_AUTODETECT) - *codesys_in_out = coding_system_from_mask (decst.mask); - } - - /* If we absolutely can't determine the EOL type, just assume LF. */ - if (*eol_type_in_out == EOL_AUTODETECT) - *eol_type_in_out = EOL_LF; - - Lstream_rewind (stream); -} - -DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /* -Detect coding system of the text in the region between START and END. -Returned a list of possible coding systems ordered by priority. -If only ASCII characters are found, it returns 'undecided or one of -its subsidiary coding systems according to a detected end-of-line -type. Optional arg BUFFER defaults to the current buffer. -*/ - (start, end, buffer)) -{ - Lisp_Object val = Qnil; - struct buffer *buf = decode_buffer (buffer, 0); - Bufpos b, e; - Lisp_Object instream, lb_instream; - Lstream *istr, *lb_istr; - struct detection_state decst; - struct gcpro gcpro1, gcpro2; - - get_buffer_range_char (buf, start, end, &b, &e, 0); - lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0); - lb_istr = XLSTREAM (lb_instream); - instream = make_encoding_input_stream (lb_istr, Fget_coding_system (Qbinary)); - istr = XLSTREAM (instream); - GCPRO2 (instream, lb_instream); - xzero (decst); - decst.eol_type = EOL_AUTODETECT; - decst.mask = ~0; - while (1) - { - unsigned char random_buffer[4096]; - int nread = Lstream_read (istr, random_buffer, sizeof (random_buffer)); - - if (!nread) - break; - if (detect_coding_type (&decst, random_buffer, nread, 0)) - break; - } - - if (decst.mask == ~0) - val = subsidiary_coding_system (Fget_coding_system (Qundecided), - decst.eol_type); - else - { - int i; - - val = Qnil; -#ifdef MULE - decst.mask = postprocess_iso2022_mask (decst.mask); -#endif - for (i = CODING_CATEGORY_LAST; i >= 0; i--) - { - int sys = coding_category_by_priority[i]; - if (decst.mask & (1 << sys)) - { - Lisp_Object codesys = coding_category_system[sys]; - if (!NILP (codesys)) - codesys = subsidiary_coding_system (codesys, decst.eol_type); - val = Fcons (codesys, val); - } - } - } - Lstream_close (istr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (lb_istr); - return val; -} - - -/************************************************************************/ -/* Converting to internal Mule format ("decoding") */ -/************************************************************************/ - -/* A decoding stream is a stream used for decoding text (i.e. - converting from some external format to internal format). - The decoding-stream object keeps track of the actual coding - stream, the stream that is at the other end, and data that - needs to be persistent across the lifetime of the stream. */ - -/* Handle the EOL stuff related to just-read-in character C. - EOL_TYPE is the EOL type of the coding stream. - FLAGS is the current value of FLAGS in the coding stream, and may - be modified by this macro. (The macro only looks at the - CODING_STATE_CR flag.) DST is the Dynarr to which the decoded - bytes are to be written. You need to also define a local goto - label "label_continue_loop" that is at the end of the main - character-reading loop. - - If C is a CR character, then this macro handles it entirely and - jumps to label_continue_loop. Otherwise, this macro does not add - anything to DST, and continues normally. You should continue - processing C normally after this macro. */ - -#define DECODE_HANDLE_EOL_TYPE(eol_type, c, flags, dst) \ -do { \ - if (c == '\r') \ - { \ - if (eol_type == EOL_CR) \ - Dynarr_add (dst, '\n'); \ - else if (eol_type != EOL_CRLF || flags & CODING_STATE_CR) \ - Dynarr_add (dst, c); \ - else \ - flags |= CODING_STATE_CR; \ - goto label_continue_loop; \ - } \ - else if (flags & CODING_STATE_CR) \ - { /* eol_type == CODING_SYSTEM_EOL_CRLF */ \ - if (c != '\n') \ - Dynarr_add (dst, '\r'); \ - flags &= ~CODING_STATE_CR; \ - } \ -} while (0) - -/* C should be a binary character in the range 0 - 255; convert - to internal format and add to Dynarr DST. */ - -#define DECODE_ADD_BINARY_CHAR(c, dst) \ -do { \ - if (BYTE_ASCII_P (c)) \ - Dynarr_add (dst, c); \ - else if (BYTE_C1_P (c)) \ - { \ - Dynarr_add (dst, LEADING_BYTE_CONTROL_1); \ - Dynarr_add (dst, c + 0x20); \ - } \ - else \ - { \ - Dynarr_add (dst, LEADING_BYTE_LATIN_ISO8859_1); \ - Dynarr_add (dst, c); \ - } \ -} while (0) - -#define DECODE_OUTPUT_PARTIAL_CHAR(ch) \ -do { \ - if (ch) \ - { \ - DECODE_ADD_BINARY_CHAR (ch, dst); \ - ch = 0; \ - } \ -} while (0) - -#define DECODE_HANDLE_END_OF_CONVERSION(flags, ch, dst) \ -do { \ - DECODE_OUTPUT_PARTIAL_CHAR (ch); \ - if ((flags & CODING_STATE_END) && \ - (flags & CODING_STATE_CR)) \ - Dynarr_add (dst, '\r'); \ -} while (0) - -#define DECODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, decoding) - -struct decoding_stream -{ - /* Coding system that governs the conversion. */ - struct Lisp_Coding_System *codesys; - - /* Stream that we read the encoded data from or - write the decoded data to. */ - Lstream *other_end; - - /* If we are reading, then we can return only a fixed amount of - data, so if the conversion resulted in too much data, we store it - here for retrieval the next time around. */ - unsigned_char_dynarr *runoff; - - /* FLAGS holds flags indicating the current state of the decoding. - Some of these flags are dependent on the coding system. */ - unsigned int flags; - - /* CH holds a partially built-up character. Since we only deal - with one- and two-byte characters at the moment, we only use - this to store the first byte of a two-byte character. */ - unsigned int ch; - - /* EOL_TYPE specifies the type of end-of-line conversion that - currently applies. We need to keep this separate from the - EOL type stored in CODESYS because the latter might indicate - automatic EOL-type detection while the former will always - indicate a particular EOL type. */ - enum eol_type eol_type; -#ifdef MULE - /* Additional ISO2022 information. We define the structure above - because it's also needed by the detection routines. */ - struct iso2022_decoder iso2022; - - /* Additional information (the state of the running CCL program) - used by the CCL decoder. */ - struct ccl_program ccl; -#endif - struct detection_state decst; -}; - -static int decoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size); -static int decoding_rewinder (Lstream *stream); -static int decoding_seekable_p (Lstream *stream); -static int decoding_flusher (Lstream *stream); -static int decoding_closer (Lstream *stream); - -static Lisp_Object decoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); - -DEFINE_LSTREAM_IMPLEMENTATION ("decoding", lstream_decoding, - sizeof (struct decoding_stream)); - -static Lisp_Object -decoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) -{ - Lstream *str = DECODING_STREAM_DATA (XLSTREAM (stream))->other_end; - Lisp_Object str_obj; - - /* We do not need to mark the coding systems or charsets stored - within the stream because they are stored in a global list - and automatically marked. */ - - XSETLSTREAM (str_obj, str); - markobj (str_obj); - if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); - else - return Qnil; -} - -/* Read SIZE bytes of data and store it into DATA. We are a decoding stream - so we read data from the other end, decode it, and store it into DATA. */ - -static int -decoding_reader (Lstream *stream, unsigned char *data, size_t size) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - unsigned char *orig_data = data; - int read_size; - int error_occurred = 0; - - /* We need to interface to mule_decode(), which expects to take some - amount of data and store the result into a Dynarr. We have - mule_decode() store into str->runoff, and take data from there - as necessary. */ - - /* We loop until we have enough data, reading chunks from the other - end and decoding it. */ - while (1) - { - /* Take data from the runoff if we can. Make sure to take at - most SIZE bytes, and delete the data from the runoff. */ - if (Dynarr_length (str->runoff) > 0) - { - size_t chunk = min (size, (size_t) Dynarr_length (str->runoff)); - memcpy (data, Dynarr_atp (str->runoff, 0), chunk); - Dynarr_delete_many (str->runoff, 0, chunk); - data += chunk; - size -= chunk; - } - - if (size == 0) - break; /* No more room for data */ - - if (str->flags & CODING_STATE_END) - /* This means that on the previous iteration, we hit the EOF on - the other end. We loop once more so that mule_decode() can - output any final stuff it may be holding, or any "go back - to a sane state" escape sequences. (This latter makes sense - during encoding.) */ - break; - - /* Exhausted the runoff, so get some more. DATA has at least - SIZE bytes left of storage in it, so it's OK to read directly - into it. (We'll be overwriting above, after we've decoded it - into the runoff.) */ - read_size = Lstream_read (str->other_end, data, size); - if (read_size < 0) - { - error_occurred = 1; - break; - } - if (read_size == 0) - /* There might be some more end data produced in the translation. - See the comment above. */ - str->flags |= CODING_STATE_END; - mule_decode (stream, data, str->runoff, read_size); - } - - if (data - orig_data == 0) - return error_occurred ? -1 : 0; - else - return data - orig_data; -} - -static int -decoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - int retval; - - /* Decode all our data into the runoff, and then attempt to write - it all out to the other end. Remove whatever chunk we succeeded - in writing. */ - mule_decode (stream, data, str->runoff, size); - retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0), - Dynarr_length (str->runoff)); - if (retval > 0) - Dynarr_delete_many (str->runoff, 0, retval); - /* Do NOT return retval. The return value indicates how much - of the incoming data was written, not how many bytes were - written. */ - return size; -} - -static void -reset_decoding_stream (struct decoding_stream *str) -{ -#ifdef MULE - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_ISO2022) - { - Lisp_Object coding_system; - XSETCODING_SYSTEM (coding_system, str->codesys); - reset_iso2022 (coding_system, &str->iso2022); - } - else if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_CCL) - { - setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_DECODE (str->codesys)); - } -#endif /* MULE */ - str->flags = str->ch = 0; -} - -static int -decoding_rewinder (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - reset_decoding_stream (str); - Dynarr_reset (str->runoff); - return Lstream_rewind (str->other_end); -} - -static int -decoding_seekable_p (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - return Lstream_seekable_p (str->other_end); -} - -static int -decoding_flusher (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - return Lstream_flush (str->other_end); -} - -static int -decoding_closer (Lstream *stream) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - if (stream->flags & LSTREAM_FL_WRITE) - { - str->flags |= CODING_STATE_END; - decoding_writer (stream, 0, 0); - } - Dynarr_free (str->runoff); -#ifdef MULE - if (str->iso2022.composite_chars) - Dynarr_free (str->iso2022.composite_chars); -#endif - return Lstream_close (str->other_end); -} - -Lisp_Object -decoding_stream_coding_system (Lstream *stream) -{ - Lisp_Object coding_system; - struct decoding_stream *str = DECODING_STREAM_DATA (stream); - - XSETCODING_SYSTEM (coding_system, str->codesys); - return subsidiary_coding_system (coding_system, str->eol_type); -} - -void -set_decoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys); - struct decoding_stream *str = DECODING_STREAM_DATA (lstr); - str->codesys = cs; - if (CODING_SYSTEM_EOL_TYPE (cs) != EOL_AUTODETECT) - str->eol_type = CODING_SYSTEM_EOL_TYPE (cs); - reset_decoding_stream (str); -} - -/* WARNING WARNING WARNING WARNING!!!!! If you open up a decoding - stream for writing, no automatic code detection will be performed. - The reason for this is that automatic code detection requires a - seekable input. Things will also fail if you open a decoding - stream for reading using a non-fully-specified coding system and - a non-seekable input stream. */ - -static Lisp_Object -make_decoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) -{ - Lstream *lstr = Lstream_new (lstream_decoding, mode); - struct decoding_stream *str = DECODING_STREAM_DATA (lstr); - Lisp_Object obj; - - xzero (*str); - str->other_end = stream; - str->runoff = (unsigned_char_dynarr *) Dynarr_new (unsigned_char); - str->eol_type = EOL_AUTODETECT; - if (!strcmp (mode, "r") - && Lstream_seekable_p (stream)) - /* We can determine the coding system now. */ - determine_real_coding_system (stream, &codesys, &str->eol_type); - set_decoding_stream_coding_system (lstr, codesys); - str->decst.eol_type = str->eol_type; - str->decst.mask = ~0; - XSETLSTREAM (obj, lstr); - return obj; -} - -Lisp_Object -make_decoding_input_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_decoding_stream_1 (stream, codesys, "r"); -} - -Lisp_Object -make_decoding_output_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_decoding_stream_1 (stream, codesys, "w"); -} - -/* Note: the decode_coding_* functions all take the same - arguments as mule_decode(), which is to say some SRC data of - size N, which is to be stored into dynamic array DST. - DECODING is the stream within which the decoding is - taking place, but no data is actually read from or - written to that stream; that is handled in decoding_reader() - or decoding_writer(). This allows the same functions to - be used for both reading and writing. */ - -static void -mule_decode (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - /* If necessary, do encoding-detection now. We do this when - we're a writing stream or a non-seekable reading stream, - meaning that we can't just process the whole input, - rewind, and start over. */ - - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT || - str->eol_type == EOL_AUTODETECT) - { - Lisp_Object codesys; - - XSETCODING_SYSTEM (codesys, str->codesys); - detect_coding_type (&str->decst, src, n, - CODING_SYSTEM_TYPE (str->codesys) != - CODESYS_AUTODETECT); - if (CODING_SYSTEM_TYPE (str->codesys) == CODESYS_AUTODETECT && - str->decst.mask != ~0) - /* #### This is cheesy. What we really ought to do is - buffer up a certain amount of data so as to get a - less random result. */ - codesys = coding_system_from_mask (str->decst.mask); - str->eol_type = str->decst.eol_type; - if (XCODING_SYSTEM (codesys) != str->codesys) - { - /* Preserve the CODING_STATE_END flag in case it was set. - If we erase it, bad things might happen. */ - int was_end = str->flags & CODING_STATE_END; - set_decoding_stream_coding_system (decoding, codesys); - if (was_end) - str->flags |= CODING_STATE_END; - } - } - - switch (CODING_SYSTEM_TYPE (str->codesys)) - { -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: - Dynarr_add_many (dst, src, n); - break; -#endif - case CODESYS_AUTODETECT: - /* If we got this far and still haven't decided on the coding - system, then do no conversion. */ - case CODESYS_NO_CONVERSION: - decode_coding_no_conversion (decoding, src, dst, n); - break; -#ifdef MULE - case CODESYS_SHIFT_JIS: - decode_coding_sjis (decoding, src, dst, n); - break; - case CODESYS_BIG5: - decode_coding_big5 (decoding, src, dst, n); - break; - case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); - break; - case CODESYS_ISO2022: - decode_coding_iso2022 (decoding, src, dst, n); - break; -#endif /* MULE */ - default: - abort (); - } -} - -DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, 0, /* -Decode the text between START and END which is encoded in CODING-SYSTEM. -This is useful if you've read in encoded text from a file without decoding -it (e.g. you read in a JIS-formatted file but used the `binary' or -`no-conversion' coding system, so that it shows up as "^[$B! [ENCODE AS BINARY] - ------> [DECODE AS SPECIFIED] - ------> [BUFFER] - */ - - while (1) - { - char tempbuf[1024]; /* some random amount */ - Bufpos newpos, even_newer_pos; - Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - - if (!size_in_bytes) - break; - newpos = lisp_buffer_stream_startpos (istr); - Lstream_write (ostr, tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (istr); - buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), - even_newer_pos, 0); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (de_outstream)); - Lstream_delete (XLSTREAM (lb_outstream)); - return Qnil; -} - - -/************************************************************************/ -/* Converting to an external encoding ("encoding") */ -/************************************************************************/ - -/* An encoding stream is an output stream. When you create the - stream, you specify the coding system that governs the encoding - and another stream that the resulting encoded data is to be - sent to, and then start sending data to it. */ - -#define ENCODING_STREAM_DATA(stream) LSTREAM_TYPE_DATA (stream, encoding) - -struct encoding_stream -{ - /* Coding system that governs the conversion. */ - struct Lisp_Coding_System *codesys; - - /* Stream that we read the encoded data from or - write the decoded data to. */ - Lstream *other_end; - - /* If we are reading, then we can return only a fixed amount of - data, so if the conversion resulted in too much data, we store it - here for retrieval the next time around. */ - unsigned_char_dynarr *runoff; - - /* FLAGS holds flags indicating the current state of the encoding. - Some of these flags are dependent on the coding system. */ - unsigned int flags; - - /* CH holds a partially built-up character. Since we only deal - with one- and two-byte characters at the moment, we only use - this to store the first byte of a two-byte character. */ - unsigned int ch; -#ifdef MULE - /* Additional information used by the ISO2022 encoder. */ - struct - { - /* CHARSET holds the character sets currently assigned to the G0 - through G3 registers. It is initialized from the array - INITIAL_CHARSET in CODESYS. */ - Lisp_Object charset[4]; - - /* Which registers are currently invoked into the left (GL) and - right (GR) halves of the 8-bit encoding space? */ - int register_left, register_right; - - /* Whether we need to explicitly designate the charset in the - G? register before using it. It is initialized from the - array FORCE_CHARSET_ON_OUTPUT in CODESYS. */ - unsigned char force_charset_on_output[4]; - - /* Other state variables that need to be preserved across - invocations. */ - Lisp_Object current_charset; - int current_half; - int current_char_boundary; - } iso2022; - - /* Additional information (the state of the running CCL program) - used by the CCL encoder. */ - struct ccl_program ccl; -#endif /* MULE */ -}; - -static int encoding_reader (Lstream *stream, unsigned char *data, size_t size); -static int encoding_writer (Lstream *stream, CONST unsigned char *data, - size_t size); -static int encoding_rewinder (Lstream *stream); -static int encoding_seekable_p (Lstream *stream); -static int encoding_flusher (Lstream *stream); -static int encoding_closer (Lstream *stream); - -static Lisp_Object encoding_marker (Lisp_Object stream, - void (*markobj) (Lisp_Object)); - -DEFINE_LSTREAM_IMPLEMENTATION ("encoding", lstream_encoding, - sizeof (struct encoding_stream)); - -static Lisp_Object -encoding_marker (Lisp_Object stream, void (*markobj) (Lisp_Object)) -{ - Lstream *str = ENCODING_STREAM_DATA (XLSTREAM (stream))->other_end; - Lisp_Object str_obj; - - /* We do not need to mark the coding systems or charsets stored - within the stream because they are stored in a global list - and automatically marked. */ - - XSETLSTREAM (str_obj, str); - markobj (str_obj); - if (str->imp->marker) - return (str->imp->marker) (str_obj, markobj); - else - return Qnil; -} - -/* Read SIZE bytes of data and store it into DATA. We are a encoding stream - so we read data from the other end, encode it, and store it into DATA. */ - -static int -encoding_reader (Lstream *stream, unsigned char *data, size_t size) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - unsigned char *orig_data = data; - int read_size; - int error_occurred = 0; - - /* We need to interface to mule_encode(), which expects to take some - amount of data and store the result into a Dynarr. We have - mule_encode() store into str->runoff, and take data from there - as necessary. */ - - /* We loop until we have enough data, reading chunks from the other - end and encoding it. */ - while (1) - { - /* Take data from the runoff if we can. Make sure to take at - most SIZE bytes, and delete the data from the runoff. */ - if (Dynarr_length (str->runoff) > 0) - { - int chunk = min ((int) size, Dynarr_length (str->runoff)); - memcpy (data, Dynarr_atp (str->runoff, 0), chunk); - Dynarr_delete_many (str->runoff, 0, chunk); - data += chunk; - size -= chunk; - } - - if (size == 0) - break; /* No more room for data */ - - if (str->flags & CODING_STATE_END) - /* This means that on the previous iteration, we hit the EOF on - the other end. We loop once more so that mule_encode() can - output any final stuff it may be holding, or any "go back - to a sane state" escape sequences. (This latter makes sense - during encoding.) */ - break; - - /* Exhausted the runoff, so get some more. DATA at least SIZE bytes - left of storage in it, so it's OK to read directly into it. - (We'll be overwriting above, after we've encoded it into the - runoff.) */ - read_size = Lstream_read (str->other_end, data, size); - if (read_size < 0) - { - error_occurred = 1; - break; - } - if (read_size == 0) - /* There might be some more end data produced in the translation. - See the comment above. */ - str->flags |= CODING_STATE_END; - mule_encode (stream, data, str->runoff, read_size); - } - - if (data == orig_data) - return error_occurred ? -1 : 0; - else - return data - orig_data; -} - -static int -encoding_writer (Lstream *stream, CONST unsigned char *data, size_t size) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - int retval; - - /* Encode all our data into the runoff, and then attempt to write - it all out to the other end. Remove whatever chunk we succeeded - in writing. */ - mule_encode (stream, data, str->runoff, size); - retval = Lstream_write (str->other_end, Dynarr_atp (str->runoff, 0), - Dynarr_length (str->runoff)); - if (retval > 0) - Dynarr_delete_many (str->runoff, 0, retval); - /* Do NOT return retval. The return value indicates how much - of the incoming data was written, not how many bytes were - written. */ - return size; -} - -static void -reset_encoding_stream (struct encoding_stream *str) -{ -#ifdef MULE - switch (CODING_SYSTEM_TYPE (str->codesys)) - { - case CODESYS_ISO2022: - { - int i; - - for (i = 0; i < 4; i++) - { - str->iso2022.charset[i] = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (str->codesys, i); - str->iso2022.force_charset_on_output[i] = - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (str->codesys, i); - } - str->iso2022.register_left = 0; - str->iso2022.register_right = 1; - str->iso2022.current_charset = Qnil; - str->iso2022.current_half = 0; - str->iso2022.current_char_boundary = 1; - break; - } - case CODESYS_CCL: - setup_ccl_program (&str->ccl, CODING_SYSTEM_CCL_ENCODE (str->codesys)); - break; - default: - break; - } -#endif /* MULE */ - - str->flags = str->ch = 0; -} - -static int -encoding_rewinder (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - reset_encoding_stream (str); - Dynarr_reset (str->runoff); - return Lstream_rewind (str->other_end); -} - -static int -encoding_seekable_p (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - return Lstream_seekable_p (str->other_end); -} - -static int -encoding_flusher (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - return Lstream_flush (str->other_end); -} - -static int -encoding_closer (Lstream *stream) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - if (stream->flags & LSTREAM_FL_WRITE) - { - str->flags |= CODING_STATE_END; - encoding_writer (stream, 0, 0); - } - Dynarr_free (str->runoff); - return Lstream_close (str->other_end); -} - -Lisp_Object -encoding_stream_coding_system (Lstream *stream) -{ - Lisp_Object coding_system; - struct encoding_stream *str = ENCODING_STREAM_DATA (stream); - - XSETCODING_SYSTEM (coding_system, str->codesys); - return coding_system; -} - -void -set_encoding_stream_coding_system (Lstream *lstr, Lisp_Object codesys) -{ - struct Lisp_Coding_System *cs = XCODING_SYSTEM (codesys); - struct encoding_stream *str = ENCODING_STREAM_DATA (lstr); - str->codesys = cs; - reset_encoding_stream (str); -} - -static Lisp_Object -make_encoding_stream_1 (Lstream *stream, Lisp_Object codesys, - CONST char *mode) -{ - Lstream *lstr = Lstream_new (lstream_encoding, mode); - struct encoding_stream *str = ENCODING_STREAM_DATA (lstr); - Lisp_Object obj; - - xzero (*str); - str->runoff = Dynarr_new (unsigned_char); - str->other_end = stream; - set_encoding_stream_coding_system (lstr, codesys); - XSETLSTREAM (obj, lstr); - return obj; -} - -Lisp_Object -make_encoding_input_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_encoding_stream_1 (stream, codesys, "r"); -} - -Lisp_Object -make_encoding_output_stream (Lstream *stream, Lisp_Object codesys) -{ - return make_encoding_stream_1 (stream, codesys, "w"); -} - -/* Convert N bytes of internally-formatted data stored in SRC to an - external format, according to the encoding stream ENCODING. - Store the encoded data into DST. */ - -static void -mule_encode (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - - switch (CODING_SYSTEM_TYPE (str->codesys)) - { -#ifdef DEBUG_XEMACS - case CODESYS_INTERNAL: - Dynarr_add_many (dst, src, n); - break; -#endif - case CODESYS_AUTODETECT: - /* If we got this far and still haven't decided on the coding - system, then do no conversion. */ - case CODESYS_NO_CONVERSION: - encode_coding_no_conversion (encoding, src, dst, n); - break; -#ifdef MULE - case CODESYS_SHIFT_JIS: - encode_coding_sjis (encoding, src, dst, n); - break; - case CODESYS_BIG5: - encode_coding_big5 (encoding, src, dst, n); - break; - case CODESYS_CCL: - ccl_driver (&str->ccl, src, dst, n, 0); - break; - case CODESYS_ISO2022: - encode_coding_iso2022 (encoding, src, dst, n); - break; -#endif /* MULE */ - default: - abort (); - } -} - -DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, 0, /* -Encode the text between START and END using CODING-SYSTEM. -This will, for example, convert Japanese characters into stuff such as -"^[$B! [ENCODE AS SPECIFIED] - ------> [DECODE AS BINARY] - ------> [BUFFER] - */ - while (1) - { - char tempbuf[1024]; /* some random amount */ - Bufpos newpos, even_newer_pos; - Bufpos oldpos = lisp_buffer_stream_startpos (istr); - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - - if (!size_in_bytes) - break; - newpos = lisp_buffer_stream_startpos (istr); - Lstream_write (ostr, tempbuf, size_in_bytes); - even_newer_pos = lisp_buffer_stream_startpos (istr); - buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), - even_newer_pos, 0); - } - - { - Charcount retlen = - lisp_buffer_stream_startpos (XLSTREAM (instream)) - b; - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (de_outstream)); - Lstream_delete (XLSTREAM (lb_outstream)); - return make_int (retlen); - } -} - -#ifdef MULE - -/************************************************************************/ -/* Shift-JIS methods */ -/************************************************************************/ - -/* Shift-JIS is a coding system encoding three character sets: ASCII, right - half of JISX0201-Kana, and JISX0208. An ASCII character is encoded - as is. A character of JISX0201-Kana (TYPE94 character set) is - encoded by "position-code + 0x80". A character of JISX0208 - (TYPE94x94 character set) is encoded in 2-byte but two - position-codes are divided and shifted so that it fit in the range - below. - - --- CODE RANGE of Shift-JIS --- - (character set) (range) - ASCII 0x00 .. 0x7F - JISX0201-Kana 0xA0 .. 0xDF - JISX0208 (1st byte) 0x80 .. 0x9F and 0xE0 .. 0xEF - (2nd byte) 0x40 .. 0x7E and 0x80 .. 0xFC - ------------------------------- - -*/ - -/* Is this the first byte of a Shift-JIS two-byte char? */ - -#define BYTE_SJIS_TWO_BYTE_1_P(c) \ - (((c) >= 0x81 && (c) <= 0x9F) || ((c) >= 0xE0 && (c) <= 0xEF)) - -/* Is this the second byte of a Shift-JIS two-byte char? */ - -#define BYTE_SJIS_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0x80 && (c) <= 0xFC)) - -#define BYTE_SJIS_KATAKANA_P(c) \ - ((c) >= 0xA1 && (c) <= 0xDF) - -static int -detect_coding_sjis (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) - return 0; - if (st->shift_jis.in_second_byte) - { - st->shift_jis.in_second_byte = 0; - if (c < 0x40) - return 0; - } - else if ((c >= 0x80 && c < 0xA0) || c >= 0xE0) - st->shift_jis.in_second_byte = 1; - } - return CODING_CATEGORY_SHIFT_JIS_MASK; -} - -/* Convert Shift-JIS data to internal format. */ - -static void -decode_coding_sjis (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - - if (ch) - { - /* Previous character was first byte of Shift-JIS Kanji char. */ - if (BYTE_SJIS_TWO_BYTE_2_P (c)) - { - unsigned char e1, e2; - - Dynarr_add (dst, LEADING_BYTE_JAPANESE_JISX0208); - DECODE_SJIS (ch, c, e1, e2); - Dynarr_add (dst, e1); - Dynarr_add (dst, e2); - } - else - { - DECODE_ADD_BINARY_CHAR (ch, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - } - ch = 0; - } - else - { - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - if (BYTE_SJIS_TWO_BYTE_1_P (c)) - ch = c; - else if (BYTE_SJIS_KATAKANA_P (c)) - { - Dynarr_add (dst, LEADING_BYTE_KATAKANA_JISX0201); - Dynarr_add (dst, c); - } - else - DECODE_ADD_BINARY_CHAR (c, dst); - } - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -/* Convert internally-formatted data to Shift-JIS. */ - -static void -encode_coding_sjis (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - ch = 0; - } - else if (BYTE_ASCII_P (c)) - { - Dynarr_add (dst, c); - ch = 0; - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - ch = (c == LEADING_BYTE_KATAKANA_JISX0201 || - c == LEADING_BYTE_JAPANESE_JISX0208_1978 || - c == LEADING_BYTE_JAPANESE_JISX0208) ? c : 0; - else if (ch) - { - if (ch == LEADING_BYTE_KATAKANA_JISX0201) - { - Dynarr_add (dst, c); - ch = 0; - } - else if (ch == LEADING_BYTE_JAPANESE_JISX0208_1978 || - ch == LEADING_BYTE_JAPANESE_JISX0208) - ch = c; - else - { - unsigned char j1, j2; - ENCODE_SJIS (ch, c, j1, j2); - Dynarr_add (dst, j1); - Dynarr_add (dst, j2); - ch = 0; - } - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -DEFUN ("decode-shift-jis-char", Fdecode_shift_jis_char, 1, 1, 0, /* -Decode a JISX0208 character of Shift-JIS coding-system. -CODE is the character code in Shift-JIS as a cons of type bytes. -Return the corresponding character. -*/ - (code)) -{ - unsigned char c1, c2, s1, s2; - - CHECK_CONS (code); - CHECK_INT (XCAR (code)); - CHECK_INT (XCDR (code)); - s1 = XINT (XCAR (code)); - s2 = XINT (XCDR (code)); - if (BYTE_SJIS_TWO_BYTE_1_P (s1) && - BYTE_SJIS_TWO_BYTE_2_P (s2)) - { - DECODE_SJIS (s1, s2, c1, c2); - return make_char (MAKE_CHAR (Vcharset_japanese_jisx0208, - c1 & 0x7F, c2 & 0x7F)); - } - else - return Qnil; -} - -DEFUN ("encode-shift-jis-char", Fencode_shift_jis_char, 1, 1, 0, /* -Encode a JISX0208 character CHAR to SHIFT-JIS coding-system. -Return the corresponding character code in SHIFT-JIS as a cons of two bytes. -*/ - (ch)) -{ - Lisp_Object charset; - int c1, c2, s1, s2; - - CHECK_CHAR_COERCE_INT (ch); - BREAKUP_CHAR (XCHAR (ch), charset, c1, c2); - if (EQ (charset, Vcharset_japanese_jisx0208)) - { - ENCODE_SJIS (c1 | 0x80, c2 | 0x80, s1, s2); - return Fcons (make_int (s1), make_int (s2)); - } - else - return Qnil; -} - - -/************************************************************************/ -/* Big5 methods */ -/************************************************************************/ - -/* BIG5 is a coding system encoding two character sets: ASCII and - Big5. An ASCII character is encoded as is. Big5 is a two-byte - character set and is encoded in two-byte. - - --- CODE RANGE of BIG5 --- - (character set) (range) - ASCII 0x00 .. 0x7F - Big5 (1st byte) 0xA1 .. 0xFE - (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE - -------------------------- - - Since the number of characters in Big5 is larger than maximum - characters in Emacs' charset (96x96), it can't be handled as one - charset. So, in Emacs, Big5 is divided into two: `charset-big5-1' - and `charset-big5-2'. Both s are TYPE94x94. The former - contains frequently used characters and the latter contains less - frequently used characters. */ - -#define BYTE_BIG5_TWO_BYTE_1_P(c) \ - ((c) >= 0xA1 && (c) <= 0xFE) - -/* Is this the second byte of a Shift-JIS two-byte char? */ - -#define BYTE_BIG5_TWO_BYTE_2_P(c) \ - (((c) >= 0x40 && (c) <= 0x7E) || ((c) >= 0xA1 && (c) <= 0xFE)) - -/* Number of Big5 characters which have the same code in 1st byte. */ - -#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40) - -/* Code conversion macros. These are macros because they are used in - inner loops during code conversion. - - Note that temporary variables in macros introduce the classic - dynamic-scoping problems with variable names. We use capital- - lettered variables in the assumption that XEmacs does not use - capital letters in variables except in a very formalized way - (e.g. Qstring). */ - -/* Convert Big5 code (b1, b2) into its internal string representation - (lb, c1, c2). */ - -/* There is a much simpler way to split the Big5 charset into two. - For the moment I'm going to leave the algorithm as-is because it - claims to separate out the most-used characters into a single - charset, which perhaps will lead to optimizations in various - places. - - The way the algorithm works is something like this: - - Big5 can be viewed as a 94x157 charset, where the row is - encoded into the bytes 0xA1 .. 0xFE and the column is encoded - into the bytes 0x40 .. 0x7E and 0xA1 .. 0xFE. As for frequency, - the split between low and high column numbers is apparently - meaningless; ascending rows produce less and less frequent chars. - Therefore, we assign the lower half of rows (0xA1 .. 0xC8) to - the first charset, and the upper half (0xC9 .. 0xFE) to the - second. To do the conversion, we convert the character into - a single number where 0 .. 156 is the first row, 157 .. 313 - is the second, etc. That way, the characters are ordered by - decreasing frequency. Then we just chop the space in two - and coerce the result into a 94x94 space. - */ - -#define DECODE_BIG5(b1, b2, lb, c1, c2) do \ -{ \ - int B1 = b1, B2 = b2; \ - unsigned int I \ - = (B1 - 0xA1) * BIG5_SAME_ROW + B2 - (B2 < 0x7F ? 0x40 : 0x62); \ - \ - if (B1 < 0xC9) \ - { \ - lb = LEADING_BYTE_CHINESE_BIG5_1; \ - } \ - else \ - { \ - lb = LEADING_BYTE_CHINESE_BIG5_2; \ - I -= (BIG5_SAME_ROW) * (0xC9 - 0xA1); \ - } \ - c1 = I / (0xFF - 0xA1) + 0xA1; \ - c2 = I % (0xFF - 0xA1) + 0xA1; \ -} while (0) - -/* Convert the internal string representation of a Big5 character - (lb, c1, c2) into Big5 code (b1, b2). */ - -#define ENCODE_BIG5(lb, c1, c2, b1, b2) do \ -{ \ - unsigned int I = ((c1) - 0xA1) * (0xFF - 0xA1) + ((c2) - 0xA1); \ - \ - if (lb == LEADING_BYTE_CHINESE_BIG5_2) \ - { \ - I += BIG5_SAME_ROW * (0xC9 - 0xA1); \ - } \ - b1 = I / BIG5_SAME_ROW + 0xA1; \ - b2 = I % BIG5_SAME_ROW; \ - b2 += b2 < 0x3F ? 0x40 : 0x62; \ -} while (0) - -static int -detect_coding_big5 (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int c; - - while (n--) - { - c = *src++; - if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO || - (c >= 0x80 && c <= 0xA0)) - return 0; - if (st->big5.in_second_byte) - { - st->big5.in_second_byte = 0; - if (c < 0x40 || (c >= 0x80 && c <= 0xA0)) - return 0; - } - else if (c >= 0xA1) - st->big5.in_second_byte = 1; - } - return CODING_CATEGORY_BIG5_MASK; -} - -/* Convert Big5 data to internal format. */ - -static void -decode_coding_big5 (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - if (ch) - { - /* Previous character was first byte of Big5 char. */ - if (BYTE_BIG5_TWO_BYTE_2_P (c)) - { - unsigned char b1, b2, b3; - DECODE_BIG5 (ch, c, b1, b2, b3); - Dynarr_add (dst, b1); - Dynarr_add (dst, b2); - Dynarr_add (dst, b3); - } - else - { - DECODE_ADD_BINARY_CHAR (ch, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - } - ch = 0; - } - else - { - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - if (BYTE_BIG5_TWO_BYTE_1_P (c)) - ch = c; - else - DECODE_ADD_BINARY_CHAR (c, dst); - } - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -/* Convert internally-formatted data to Big5. */ - -static void -encode_coding_big5 (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - } - else if (BYTE_ASCII_P (c)) - { - /* ASCII. */ - Dynarr_add (dst, c); - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - { - if (c == LEADING_BYTE_CHINESE_BIG5_1 || - c == LEADING_BYTE_CHINESE_BIG5_2) - { - /* A recognized leading byte. */ - ch = c; - continue; /* not done with this character. */ - } - /* otherwise just ignore this character. */ - } - else if (ch == LEADING_BYTE_CHINESE_BIG5_1 || - ch == LEADING_BYTE_CHINESE_BIG5_2) - { - /* Previous char was a recognized leading byte. */ - ch = (ch << 8) | c; - continue; /* not done with this character. */ - } - else if (ch) - { - /* Encountering second byte of a Big5 character. */ - unsigned char b1, b2; - - ENCODE_BIG5 (ch >> 8, ch & 0xFF, c, b1, b2); - Dynarr_add (dst, b1); - Dynarr_add (dst, b2); - } - - ch = 0; - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -DEFUN ("decode-big5-char", Fdecode_big5_char, 1, 1, 0, /* -Decode a Big5 character CODE of BIG5 coding-system. -CODE is the character code in BIG5, a cons of two integers. -Return the corresponding character. -*/ - (code)) -{ - unsigned char c1, c2, b1, b2; - - CHECK_CONS (code); - CHECK_INT (XCAR (code)); - CHECK_INT (XCDR (code)); - b1 = XINT (XCAR (code)); - b2 = XINT (XCDR (code)); - if (BYTE_BIG5_TWO_BYTE_1_P (b1) && - BYTE_BIG5_TWO_BYTE_2_P (b2)) - { - int leading_byte; - Lisp_Object charset; - DECODE_BIG5 (b1, b2, leading_byte, c1, c2); - charset = CHARSET_BY_LEADING_BYTE (leading_byte); - return make_char (MAKE_CHAR (charset, c1 & 0x7F, c2 & 0x7F)); - } - else - return Qnil; -} - -DEFUN ("encode-big5-char", Fencode_big5_char, 1, 1, 0, /* -Encode the Big5 character CH to BIG5 coding-system. -Return the corresponding character code in Big5. -*/ - (ch)) -{ - Lisp_Object charset; - int c1, c2, b1, b2; - - CHECK_CHAR_COERCE_INT (ch); - BREAKUP_CHAR (XCHAR (ch), charset, c1, c2); - if (EQ (charset, Vcharset_chinese_big5_1) || - EQ (charset, Vcharset_chinese_big5_2)) - { - ENCODE_BIG5 (XCHARSET_LEADING_BYTE (charset), c1 | 0x80, c2 | 0x80, - b1, b2); - return Fcons (make_int (b1), make_int (b2)); - } - else - return Qnil; -} - - -/************************************************************************/ -/* ISO2022 methods */ -/************************************************************************/ - -/* The following note describes the coding system ISO2022 briefly. - Since the intention of this note is to help understanding of the - programs in this file, some parts are NOT ACCURATE or OVERLY - SIMPLIFIED. For thorough understanding, please refer to the - original document of ISO2022. - - ISO2022 provides many mechanisms to encode several character sets - in 7-bit and 8-bit environments. If one chooses 7-bit environment, - all text is encoded by codes of less than 128. This may make the - encoded text a little bit longer, but the text get more stability - to pass through several gateways (some of them strip off MSB). - - There are two kind of character sets: control character set and - graphic character set. The former contains control characters such - as `newline' and `escape' to provide control functions (control - functions are provided also by escape sequence). The latter - contains graphic characters such as 'A' and '-'. Emacs recognizes - two control character sets and many graphic character sets. - - Graphic character sets are classified into one of four types, - according to the dimension and number of characters in the set: - TYPE94, TYPE96, TYPE94x94, and TYPE96x96. In addition, each - character set is assigned an identification byte, unique for each - type, called "final character" (denoted as hereafter). The - of each character set is decided by ECMA(*) when it is registered - in ISO. Code range of is 0x30..0x7F (0x30..0x3F are for - private use only). - - Note (*): ECMA = European Computer Manufacturers Association - - Here are examples of graphic character set [NAME()]: - o TYPE94 -- ASCII('B'), right-half-of-JISX0201('I'), ... - o TYPE96 -- right-half-of-ISO8859-1('A'), ... - o TYPE94x94 -- GB2312('A'), JISX0208('B'), ... - o TYPE96x96 -- none for the moment - - A code area (1byte=8bits) is divided into 4 areas, C0, GL, C1, and GR. - C0 [0x00..0x1F] -- control character plane 0 - GL [0x20..0x7F] -- graphic character plane 0 - C1 [0x80..0x9F] -- control character plane 1 - GR [0xA0..0xFF] -- graphic character plane 1 - - A control character set is directly designated and invoked to C0 or - C1 by an escape sequence. The most common case is that: - - ISO646's control character set is designated/invoked to C0, and - - ISO6429's control character set is designated/invoked to C1, - and usually these designations/invocations are omitted in encoded - text. In a 7-bit environment, only C0 can be used, and a control - character for C1 is encoded by an appropriate escape sequence to - fit into the environment. All control characters for C1 are - defined to have corresponding escape sequences. - - A graphic character set is at first designated to one of four - graphic registers (G0 through G3), then these graphic registers are - invoked to GL or GR. These designations and invocations can be - done independently. The most common case is that G0 is invoked to - GL, G1 is invoked to GR, and ASCII is designated to G0. Usually - these invocations and designations are omitted in encoded text. - In a 7-bit environment, only GL can be used. - - When a graphic character set of TYPE94 or TYPE94x94 is invoked to - GL, codes 0x20 and 0x7F of the GL area work as control characters - SPACE and DEL respectively, and code 0xA0 and 0xFF of GR area - should not be used. - - There are two ways of invocation: locking-shift and single-shift. - With locking-shift, the invocation lasts until the next different - invocation, whereas with single-shift, the invocation works only - for the following character and doesn't affect locking-shift. - Invocations are done by the following control characters or escape - sequences. - - ---------------------------------------------------------------------- - abbrev function cntrl escape seq description - ---------------------------------------------------------------------- - SI/LS0 (shift-in) 0x0F none invoke G0 into GL - SO/LS1 (shift-out) 0x0E none invoke G1 into GL - LS1R (locking-shift-1 right) none ESC '~' invoke G1 into GR - LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL - LS2R (locking-shift-2 right) none ESC '}' invoke G2 into GR - LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL - LS3R (locking-shift 3 right) none ESC '|' invoke G3 into GR - SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 for one char - SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 for one char - ---------------------------------------------------------------------- - The first four are for locking-shift. Control characters for these - functions are defined by macros ISO_CODE_XXX in `coding.h'. - - Designations are done by the following escape sequences. - ---------------------------------------------------------------------- - escape sequence description - ---------------------------------------------------------------------- - ESC '(' designate TYPE94 to G0 - ESC ')' designate TYPE94 to G1 - ESC '*' designate TYPE94 to G2 - ESC '+' designate TYPE94 to G3 - ESC ',' designate TYPE96 to G0 (*) - ESC '-' designate TYPE96 to G1 - ESC '.' designate TYPE96 to G2 - ESC '/' designate TYPE96 to G3 - ESC '$' '(' designate TYPE94x94 to G0 (**) - ESC '$' ')' designate TYPE94x94 to G1 - ESC '$' '*' designate TYPE94x94 to G2 - ESC '$' '+' designate TYPE94x94 to G3 - ESC '$' ',' designate TYPE96x96 to G0 (*) - ESC '$' '-' designate TYPE96x96 to G1 - ESC '$' '.' designate TYPE96x96 to G2 - ESC '$' '/' designate TYPE96x96 to G3 - ---------------------------------------------------------------------- - In this list, "TYPE94" means a graphic character set of type TYPE94 - and final character , and etc. - - Note (*): Although these designations are not allowed in ISO2022, - Emacs accepts them on decoding, and produces them on encoding - TYPE96 or TYPE96x96 character set in a coding system which is - characterized as 7-bit environment, non-locking-shift, and - non-single-shift. - - Note (**): If is '@', 'A', or 'B', the intermediate character - '(' can be omitted. We call this as "short-form" here after. - - Now you may notice that there are a lot of ways for encoding the - same multilingual text in ISO2022. Actually, there exist many - coding systems such as Compound Text (used in X's inter client - communication, ISO-2022-JP (used in Japanese internet), ISO-2022-KR - (used in Korean internet), EUC (Extended UNIX Code, used in Asian - localized platforms), and all of these are variants of ISO2022. - - In addition to the above, Emacs handles two more kinds of escape - sequences: ISO6429's direction specification and Emacs' private - sequence for specifying character composition. - - ISO6429's direction specification takes the following format: - o CSI ']' -- end of the current direction - o CSI '0' ']' -- end of the current direction - o CSI '1' ']' -- start of left-to-right text - o CSI '2' ']' -- start of right-to-left text - The control character CSI (0x9B: control sequence introducer) is - abbreviated to the escape sequence ESC '[' in 7-bit environment. - - Character composition specification takes the following format: - o ESC '0' -- start character composition - o ESC '1' -- end character composition - Since these are not standard escape sequences of any ISO, the use - of them for these meanings is restricted to Emacs only. */ - -static void -reset_iso2022 (Lisp_Object coding_system, struct iso2022_decoder *iso) -{ - int i; - - for (i = 0; i < 4; i++) - { - if (!NILP (coding_system)) - iso->charset[i] = - XCODING_SYSTEM_ISO2022_INITIAL_CHARSET (coding_system, i); - else - iso->charset[i] = Qt; - iso->invalid_designated[i] = 0; - } - iso->esc = ISO_ESC_NOTHING; - iso->esc_bytes_index = 0; - iso->register_left = 0; - iso->register_right = 1; - iso->switched_dir_and_no_valid_charset_yet = 0; - iso->invalid_switch_dir = 0; - iso->output_direction_sequence = 0; - iso->output_literally = 0; - if (iso->composite_chars) - Dynarr_reset (iso->composite_chars); -} - -static int -fit_to_be_escape_quoted (unsigned char c) -{ - switch (c) - { - case ISO_CODE_ESC: - case ISO_CODE_CSI: - case ISO_CODE_SS2: - case ISO_CODE_SS3: - case ISO_CODE_SO: - case ISO_CODE_SI: - return 1; - - default: - return 0; - } -} - -/* Parse one byte of an ISO2022 escape sequence. - If the result is an invalid escape sequence, return 0 and - do not change anything in STR. Otherwise, if the result is - an incomplete escape sequence, update ISO2022.ESC and - ISO2022.ESC_BYTES and return -1. Otherwise, update - all the state variables (but not ISO2022.ESC_BYTES) and - return 1. - - If CHECK_INVALID_CHARSETS is non-zero, check for designation - or invocation of an invalid character set and treat that as - an unrecognized escape sequence. */ - -static int -parse_iso2022_esc (Lisp_Object codesys, struct iso2022_decoder *iso, - unsigned char c, unsigned int *flags, - int check_invalid_charsets) -{ - /* (1) If we're at the end of a designation sequence, CS is the - charset being designated and REG is the register to designate - it to. - - (2) If we're at the end of a locking-shift sequence, REG is - the register to invoke and HALF (0 == left, 1 == right) is - the half to invoke it into. - - (3) If we're at the end of a single-shift sequence, REG is - the register to invoke. */ - Lisp_Object cs = Qnil; - int reg, half; - - /* NOTE: This code does goto's all over the fucking place. - The reason for this is that we're basically implementing - a state machine here, and hierarchical languages like C - don't really provide a clean way of doing this. */ - - if (! (*flags & CODING_STATE_ESCAPE)) - /* At beginning of escape sequence; we need to reset our - escape-state variables. */ - iso->esc = ISO_ESC_NOTHING; - - iso->output_literally = 0; - iso->output_direction_sequence = 0; - - switch (iso->esc) - { - case ISO_ESC_NOTHING: - iso->esc_bytes_index = 0; - switch (c) - { - case ISO_CODE_ESC: /* Start escape sequence */ - *flags |= CODING_STATE_ESCAPE; - iso->esc = ISO_ESC; - goto not_done; - - case ISO_CODE_CSI: /* ISO6429 (specifying directionality) */ - *flags |= CODING_STATE_ESCAPE; - iso->esc = ISO_ESC_5_11; - goto not_done; - - case ISO_CODE_SO: /* locking shift 1 */ - reg = 1; half = 0; - goto locking_shift; - case ISO_CODE_SI: /* locking shift 0 */ - reg = 0; half = 0; - goto locking_shift; - - case ISO_CODE_SS2: /* single shift */ - reg = 2; - goto single_shift; - case ISO_CODE_SS3: /* single shift */ - reg = 3; - goto single_shift; - - default: /* Other control characters */ - return 0; - } - - case ISO_ESC: - switch (c) - { - /**** single shift ****/ - - case 'N': /* single shift 2 */ - reg = 2; - goto single_shift; - case 'O': /* single shift 3 */ - reg = 3; - goto single_shift; - - /**** locking shift ****/ - - case '~': /* locking shift 1 right */ - reg = 1; half = 1; - goto locking_shift; - case 'n': /* locking shift 2 */ - reg = 2; half = 0; - goto locking_shift; - case '}': /* locking shift 2 right */ - reg = 2; half = 1; - goto locking_shift; - case 'o': /* locking shift 3 */ - reg = 3; half = 0; - goto locking_shift; - case '|': /* locking shift 3 right */ - reg = 3; half = 1; - goto locking_shift; - - /**** composite ****/ - - case '0': - iso->esc = ISO_ESC_START_COMPOSITE; - *flags = (*flags & CODING_STATE_ISO2022_LOCK) | - CODING_STATE_COMPOSITE; - return 1; - - case '1': - iso->esc = ISO_ESC_END_COMPOSITE; - *flags = (*flags & CODING_STATE_ISO2022_LOCK) & - ~CODING_STATE_COMPOSITE; - return 1; - - /**** directionality ****/ - - case '[': - iso->esc = ISO_ESC_5_11; - goto not_done; - - /**** designation ****/ - - case '$': /* multibyte charset prefix */ - iso->esc = ISO_ESC_2_4; - goto not_done; - - default: - if (0x28 <= c && c <= 0x2F) - { - iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_8); - goto not_done; - } - - /* This function is called with CODESYS equal to nil when - doing coding-system detection. */ - if (!NILP (codesys) - && XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - { - iso->esc = ISO_ESC_LITERAL; - *flags &= CODING_STATE_ISO2022_LOCK; - return 1; - } - - /* bzzzt! */ - return 0; - } - - - - /**** directionality ****/ - - case ISO_ESC_5_11: /* ISO6429 direction control */ - if (c == ']') - { - *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - if (c == '0') iso->esc = ISO_ESC_5_11_0; - else if (c == '1') iso->esc = ISO_ESC_5_11_1; - else if (c == '2') iso->esc = ISO_ESC_5_11_2; - else return 0; - goto not_done; - - case ISO_ESC_5_11_0: - if (c == ']') - { - *flags &= (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - return 0; - - case ISO_ESC_5_11_1: - if (c == ']') - { - *flags = (CODING_STATE_ISO2022_LOCK & ~CODING_STATE_R2L); - goto directionality; - } - return 0; - - case ISO_ESC_5_11_2: - if (c == ']') - { - *flags = (*flags & CODING_STATE_ISO2022_LOCK) | CODING_STATE_R2L; - goto directionality; - } - return 0; - - directionality: - iso->esc = ISO_ESC_DIRECTIONALITY; - /* Various junk here to attempt to preserve the direction sequences - literally in the text if they would otherwise be swallowed due - to invalid designations that don't show up as actual charset - changes in the text. */ - if (iso->invalid_switch_dir) - { - /* We already inserted a direction switch literally into the - text. We assume (#### this may not be right) that the - next direction switch is the one going the other way, - and we need to output that literally as well. */ - iso->output_literally = 1; - iso->invalid_switch_dir = 0; - } - else - { - int jj; - - /* If we are in the thrall of an invalid designation, - then stick the directionality sequence literally into the - output stream so it ends up in the original text again. */ - for (jj = 0; jj < 4; jj++) - if (iso->invalid_designated[jj]) - break; - if (jj < 4) - { - iso->output_literally = 1; - iso->invalid_switch_dir = 1; - } - else - /* Indicate that we haven't yet seen a valid designation, - so that if a switch-dir is directly followed by an - invalid designation, both get inserted literally. */ - iso->switched_dir_and_no_valid_charset_yet = 1; - } - return 1; - - - /**** designation ****/ - - case ISO_ESC_2_4: - if (0x28 <= c && c <= 0x2F) - { - iso->esc = (enum iso_esc_flag) (c - 0x28 + ISO_ESC_2_4_8); - goto not_done; - } - if (0x40 <= c && c <= 0x42) - { - cs = CHARSET_BY_ATTRIBUTES (CHARSET_TYPE_94X94, c, - *flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT); - reg = 0; - goto designated; - } - return 0; - - default: - { - int type =-1; - - if (c < '0' || c > '~') - return 0; /* bad final byte */ - - if (iso->esc >= ISO_ESC_2_8 && - iso->esc <= ISO_ESC_2_15) - { - type = ((iso->esc >= ISO_ESC_2_12) ? - CHARSET_TYPE_96 : CHARSET_TYPE_94); - reg = (iso->esc - ISO_ESC_2_8) & 3; - } - else if (iso->esc >= ISO_ESC_2_4_8 && - iso->esc <= ISO_ESC_2_4_15) - { - type = ((iso->esc >= ISO_ESC_2_4_12) ? - CHARSET_TYPE_96X96 : CHARSET_TYPE_94X94); - reg = (iso->esc - ISO_ESC_2_4_8) & 3; - } - else - { - /* Can this ever be reached? -slb */ - abort(); - } - - cs = CHARSET_BY_ATTRIBUTES (type, c, - *flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT); - goto designated; - } - } - - not_done: - iso->esc_bytes[iso->esc_bytes_index++] = (unsigned char) c; - return -1; - - single_shift: - if (check_invalid_charsets && !CHARSETP (iso->charset[reg])) - /* can't invoke something that ain't there. */ - return 0; - iso->esc = ISO_ESC_SINGLE_SHIFT; - *flags &= CODING_STATE_ISO2022_LOCK; - if (reg == 2) - *flags |= CODING_STATE_SS2; - else - *flags |= CODING_STATE_SS3; - return 1; - - locking_shift: - if (check_invalid_charsets && - !CHARSETP (iso->charset[reg])) - /* can't invoke something that ain't there. */ - return 0; - if (half) - iso->register_right = reg; - else - iso->register_left = reg; - *flags &= CODING_STATE_ISO2022_LOCK; - iso->esc = ISO_ESC_LOCKING_SHIFT; - return 1; - - designated: - if (NILP (cs) && check_invalid_charsets) - { - iso->invalid_designated[reg] = 1; - iso->charset[reg] = Vcharset_ascii; - iso->esc = ISO_ESC_DESIGNATE; - *flags &= CODING_STATE_ISO2022_LOCK; - iso->output_literally = 1; - if (iso->switched_dir_and_no_valid_charset_yet) - { - /* We encountered a switch-direction followed by an - invalid designation. Ensure that the switch-direction - gets outputted; otherwise it will probably get eaten - when the text is written out again. */ - iso->switched_dir_and_no_valid_charset_yet = 0; - iso->output_direction_sequence = 1; - /* And make sure that the switch-dir going the other - way gets outputted, as well. */ - iso->invalid_switch_dir = 1; - } - return 1; - } - /* This function is called with CODESYS equal to nil when - doing coding-system detection. */ - if (!NILP (codesys)) - { - charset_conversion_spec_dynarr *dyn = - XCODING_SYSTEM (codesys)->iso2022.input_conv; - - if (dyn) - { - int i; - - for (i = 0; i < Dynarr_length (dyn); i++) - { - struct charset_conversion_spec *spec = Dynarr_atp (dyn, i); - if (EQ (cs, spec->from_charset)) - cs = spec->to_charset; - } - } - } - - iso->charset[reg] = cs; - iso->esc = ISO_ESC_DESIGNATE; - *flags &= CODING_STATE_ISO2022_LOCK; - if (iso->invalid_designated[reg]) - { - iso->invalid_designated[reg] = 0; - iso->output_literally = 1; - } - if (iso->switched_dir_and_no_valid_charset_yet) - iso->switched_dir_and_no_valid_charset_yet = 0; - return 1; -} - -static int -detect_coding_iso2022 (struct detection_state *st, CONST unsigned char *src, - unsigned int n) -{ - int mask; - - /* #### There are serious deficiencies in the recognition mechanism - here. This needs to be much smarter if it's going to cut it. - The sequence "\xff\x0f" is currently detected as LOCK_SHIFT while - it should be detected as Latin-1. - All the ISO2022 stuff in this file should be synced up with the - code from FSF Emacs-20.4, in which Mule should be more or less stable. - Perhaps we should wait till R2L works in FSF Emacs? */ - - if (!st->iso2022.initted) - { - reset_iso2022 (Qnil, &st->iso2022.iso); - st->iso2022.mask = (CODING_CATEGORY_ISO_7_MASK | - CODING_CATEGORY_ISO_8_DESIGNATE_MASK | - CODING_CATEGORY_ISO_8_1_MASK | - CODING_CATEGORY_ISO_8_2_MASK | - CODING_CATEGORY_ISO_LOCK_SHIFT_MASK); - st->iso2022.flags = 0; - st->iso2022.high_byte_count = 0; - st->iso2022.saw_single_shift = 0; - st->iso2022.initted = 1; - } - - mask = st->iso2022.mask; - - while (n--) - { - int c = *src++; - if (c >= 0xA0) - { - mask &= ~CODING_CATEGORY_ISO_7_MASK; - st->iso2022.high_byte_count++; - } - else - { - if (st->iso2022.high_byte_count && !st->iso2022.saw_single_shift) - { - if (st->iso2022.high_byte_count & 1) - /* odd number of high bytes; assume not iso-8-2 */ - mask &= ~CODING_CATEGORY_ISO_8_2_MASK; - } - st->iso2022.high_byte_count = 0; - st->iso2022.saw_single_shift = 0; - if (c > 0x80) - mask &= ~CODING_CATEGORY_ISO_7_MASK; - } - if (!(st->iso2022.flags & CODING_STATE_ESCAPE) - && (BYTE_C0_P (c) || BYTE_C1_P (c))) - { /* control chars */ - switch (c) - { - /* Allow and ignore control characters that you might - reasonably see in a text file */ - case '\r': - case '\n': - case '\t': - case 7: /* bell */ - case 8: /* backspace */ - case 11: /* vertical tab */ - case 12: /* form feed */ - case 26: /* MS-DOS C-z junk */ - case 31: /* '^_' -- for info */ - goto label_continue_loop; - - default: - break; - } - } - - if ((st->iso2022.flags & CODING_STATE_ESCAPE) || BYTE_C0_P (c) - || BYTE_C1_P (c)) - { - if (parse_iso2022_esc (Qnil, &st->iso2022.iso, c, - &st->iso2022.flags, 0)) - { - switch (st->iso2022.iso.esc) - { - case ISO_ESC_DESIGNATE: - mask &= ~CODING_CATEGORY_ISO_8_1_MASK; - mask &= ~CODING_CATEGORY_ISO_8_2_MASK; - break; - case ISO_ESC_LOCKING_SHIFT: - mask = CODING_CATEGORY_ISO_LOCK_SHIFT_MASK; - goto ran_out_of_chars; - case ISO_ESC_SINGLE_SHIFT: - mask &= ~CODING_CATEGORY_ISO_8_DESIGNATE_MASK; - st->iso2022.saw_single_shift = 1; - break; - default: - break; - } - } - else - { - mask = 0; - goto ran_out_of_chars; - } - } - label_continue_loop:; - } - - ran_out_of_chars: - - return mask; -} - -static int -postprocess_iso2022_mask (int mask) -{ - /* #### kind of cheesy */ - /* If seven-bit ISO is allowed, then assume that the encoding is - entirely seven-bit and turn off the eight-bit ones. */ - if (mask & CODING_CATEGORY_ISO_7_MASK) - mask &= ~ (CODING_CATEGORY_ISO_8_DESIGNATE_MASK | - CODING_CATEGORY_ISO_8_1_MASK | - CODING_CATEGORY_ISO_8_2_MASK); - return mask; -} - -/* If FLAGS is a null pointer or specifies right-to-left motion, - output a switch-dir-to-left-to-right sequence to DST. - Also update FLAGS if it is not a null pointer. - If INTERNAL_P is set, we are outputting in internal format and - need to handle the CSI differently. */ - -static void -restore_left_to_right_direction (struct Lisp_Coding_System *codesys, - unsigned_char_dynarr *dst, - unsigned int *flags, - int internal_p) -{ - if (!flags || (*flags & CODING_STATE_R2L)) - { - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '['); - } - else if (internal_p) - DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst); - else - Dynarr_add (dst, ISO_CODE_CSI); - Dynarr_add (dst, '0'); - Dynarr_add (dst, ']'); - if (flags) - *flags &= ~CODING_STATE_R2L; - } -} - -/* If FLAGS is a null pointer or specifies a direction different from - DIRECTION (which should be either CHARSET_RIGHT_TO_LEFT or - CHARSET_LEFT_TO_RIGHT), output the appropriate switch-dir escape - sequence to DST. Also update FLAGS if it is not a null pointer. - If INTERNAL_P is set, we are outputting in internal format and - need to handle the CSI differently. */ - -static void -ensure_correct_direction (int direction, struct Lisp_Coding_System *codesys, - unsigned_char_dynarr *dst, unsigned int *flags, - int internal_p) -{ - if ((!flags || (*flags & CODING_STATE_R2L)) && - direction == CHARSET_LEFT_TO_RIGHT) - restore_left_to_right_direction (codesys, dst, flags, internal_p); - else if (!CODING_SYSTEM_ISO2022_NO_ISO6429 (codesys) - && (!flags || !(*flags & CODING_STATE_R2L)) && - direction == CHARSET_RIGHT_TO_LEFT) - { - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '['); - } - else if (internal_p) - DECODE_ADD_BINARY_CHAR (ISO_CODE_CSI, dst); - else - Dynarr_add (dst, ISO_CODE_CSI); - Dynarr_add (dst, '2'); - Dynarr_add (dst, ']'); - if (flags) - *flags |= CODING_STATE_R2L; - } -} - -/* Convert ISO2022-format data to internal format. */ - -static void -decode_coding_iso2022 (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - Lisp_Object coding_system; - unsigned_char_dynarr *real_dst = dst; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - XSETCODING_SYSTEM (coding_system, str->codesys); - - if (flags & CODING_STATE_COMPOSITE) - dst = str->iso2022.composite_chars; - - while (n--) - { - unsigned char c = *src++; - if (flags & CODING_STATE_ESCAPE) - { /* Within ESC sequence */ - int retval = parse_iso2022_esc (coding_system, &str->iso2022, - c, &flags, 1); - - if (retval) - { - switch (str->iso2022.esc) - { - case ISO_ESC_START_COMPOSITE: - if (str->iso2022.composite_chars) - Dynarr_reset (str->iso2022.composite_chars); - else - str->iso2022.composite_chars = Dynarr_new (unsigned_char); - dst = str->iso2022.composite_chars; - break; - case ISO_ESC_END_COMPOSITE: - { - Bufbyte comstr[MAX_EMCHAR_LEN]; - Bytecount len; - Emchar emch = lookup_composite_char (Dynarr_atp (dst, 0), - Dynarr_length (dst)); - dst = real_dst; - len = set_charptr_emchar (comstr, emch); - Dynarr_add_many (dst, comstr, len); - break; - } - - case ISO_ESC_LITERAL: - DECODE_ADD_BINARY_CHAR (c, dst); - break; - - default: - /* Everything else handled already */ - break; - } - } - - /* Attempted error recovery. */ - if (str->iso2022.output_direction_sequence) - ensure_correct_direction (flags & CODING_STATE_R2L ? - CHARSET_RIGHT_TO_LEFT : - CHARSET_LEFT_TO_RIGHT, - str->codesys, dst, 0, 1); - /* More error recovery. */ - if (!retval || str->iso2022.output_literally) - { - /* Output the (possibly invalid) sequence */ - int i; - for (i = 0; i < str->iso2022.esc_bytes_index; i++) - DECODE_ADD_BINARY_CHAR (str->iso2022.esc_bytes[i], dst); - flags &= CODING_STATE_ISO2022_LOCK; - if (!retval) - n++, src--;/* Repeat the loop with the same character. */ - else - { - /* No sense in reprocessing the final byte of the - escape sequence; it could mess things up anyway. - Just add it now. */ - DECODE_ADD_BINARY_CHAR (c, dst); - } - } - ch = 0; - } - else if (BYTE_C0_P (c) || BYTE_C1_P (c)) - { /* Control characters */ - - /***** Error-handling *****/ - - /* If we were in the middle of a character, dump out the - partial character. */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - - /* If we just saw a single-shift character, dump it out. - This may dump out the wrong sort of single-shift character, - but least it will give an indication that something went - wrong. */ - if (flags & CODING_STATE_SS2) - { - DECODE_ADD_BINARY_CHAR (ISO_CODE_SS2, dst); - flags &= ~CODING_STATE_SS2; - } - if (flags & CODING_STATE_SS3) - { - DECODE_ADD_BINARY_CHAR (ISO_CODE_SS3, dst); - flags &= ~CODING_STATE_SS3; - } - - /***** Now handle the control characters. *****/ - - /* Handle CR/LF */ - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - - flags &= CODING_STATE_ISO2022_LOCK; - - if (!parse_iso2022_esc (coding_system, &str->iso2022, c, &flags, 1)) - DECODE_ADD_BINARY_CHAR (c, dst); - } - else - { /* Graphic characters */ - Lisp_Object charset; - int lb; - int reg; - - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - - /* Now determine the charset. */ - reg = ((flags & CODING_STATE_SS2) ? 2 - : (flags & CODING_STATE_SS3) ? 3 - : !BYTE_ASCII_P (c) ? str->iso2022.register_right - : str->iso2022.register_left); - charset = str->iso2022.charset[reg]; - - /* Error checking: */ - if (! CHARSETP (charset) - || str->iso2022.invalid_designated[reg] - || (((c & 0x7F) == ' ' || (c & 0x7F) == ISO_CODE_DEL) - && XCHARSET_CHARS (charset) == 94)) - /* Mrmph. We are trying to invoke a register that has no - or an invalid charset in it, or trying to add a character - outside the range of the charset. Insert that char literally - to preserve it for the output. */ - { - DECODE_OUTPUT_PARTIAL_CHAR (ch); - DECODE_ADD_BINARY_CHAR (c, dst); - } - - else - { - /* Things are probably hunky-dorey. */ - - /* Fetch reverse charset, maybe. */ - if (((flags & CODING_STATE_R2L) && - XCHARSET_DIRECTION (charset) == CHARSET_LEFT_TO_RIGHT) - || - (!(flags & CODING_STATE_R2L) && - XCHARSET_DIRECTION (charset) == CHARSET_RIGHT_TO_LEFT)) - { - Lisp_Object new_charset = - XCHARSET_REVERSE_DIRECTION_CHARSET (charset); - if (!NILP (new_charset)) - charset = new_charset; - } - - lb = XCHARSET_LEADING_BYTE (charset); - switch (XCHARSET_REP_BYTES (charset)) - { - case 1: /* ASCII */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, c & 0x7F); - break; - - case 2: /* one-byte official */ - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, lb); - Dynarr_add (dst, c | 0x80); - break; - - case 3: /* one-byte private or two-byte official */ - if (XCHARSET_PRIVATE_P (charset)) - { - DECODE_OUTPUT_PARTIAL_CHAR (ch); - Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_1); - Dynarr_add (dst, lb); - Dynarr_add (dst, c | 0x80); - } - else - { - if (ch) - { - Dynarr_add (dst, lb); - Dynarr_add (dst, ch | 0x80); - Dynarr_add (dst, c | 0x80); - ch = 0; - } - else - ch = c; - } - break; - - default: /* two-byte private */ - if (ch) - { - Dynarr_add (dst, PRE_LEADING_BYTE_PRIVATE_2); - Dynarr_add (dst, lb); - Dynarr_add (dst, ch | 0x80); - Dynarr_add (dst, c | 0x80); - ch = 0; - } - else - ch = c; - } - } - - if (!ch) - flags &= CODING_STATE_ISO2022_LOCK; - } - - label_continue_loop:; - } - - if (flags & CODING_STATE_END) - DECODE_OUTPUT_PARTIAL_CHAR (ch); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -/***** ISO2022 encoder *****/ - -/* Designate CHARSET into register REG. */ - -static void -iso2022_designate (Lisp_Object charset, unsigned char reg, - struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - CONST char *inter94 = "()*+", *inter96= ",-./"; - unsigned int type; - unsigned char final; - Lisp_Object old_charset = str->iso2022.charset[reg]; - - str->iso2022.charset[reg] = charset; - if (!CHARSETP (charset)) - /* charset might be an initial nil or t. */ - return; - type = XCHARSET_TYPE (charset); - final = XCHARSET_FINAL (charset); - if (!str->iso2022.force_charset_on_output[reg] && - CHARSETP (old_charset) && - XCHARSET_TYPE (old_charset) == type && - XCHARSET_FINAL (old_charset) == final) - return; - - str->iso2022.force_charset_on_output[reg] = 0; - - { - charset_conversion_spec_dynarr *dyn = - str->codesys->iso2022.output_conv; - - if (dyn) - { - int i; - - for (i = 0; i < Dynarr_length (dyn); i++) - { - struct charset_conversion_spec *spec = Dynarr_atp (dyn, i); - if (EQ (charset, spec->from_charset)) - charset = spec->to_charset; - } - } - } - - Dynarr_add (dst, ISO_CODE_ESC); - switch (type) - { - case CHARSET_TYPE_94: - Dynarr_add (dst, inter94[reg]); - break; - case CHARSET_TYPE_96: - Dynarr_add (dst, inter96[reg]); - break; - case CHARSET_TYPE_94X94: - Dynarr_add (dst, '$'); - if (reg != 0 - || !(CODING_SYSTEM_ISO2022_SHORT (str->codesys)) - || final < '@' - || final > 'B') - Dynarr_add (dst, inter94[reg]); - break; - case CHARSET_TYPE_96X96: - Dynarr_add (dst, '$'); - Dynarr_add (dst, inter96[reg]); - break; - } - Dynarr_add (dst, final); -} - -static void -ensure_normal_shift (struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - if (str->iso2022.register_left != 0) - { - Dynarr_add (dst, ISO_CODE_SI); - str->iso2022.register_left = 0; - } -} - -static void -ensure_shift_out (struct encoding_stream *str, unsigned_char_dynarr *dst) -{ - if (str->iso2022.register_left != 1) - { - Dynarr_add (dst, ISO_CODE_SO); - str->iso2022.register_left = 1; - } -} - -/* Convert internally-formatted data to ISO2022 format. */ - -static void -encode_coding_iso2022 (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char charmask, c; - unsigned int flags, ch; - enum eol_type eol_type; - unsigned char char_boundary; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - struct Lisp_Coding_System *codesys = str->codesys; - int i; - Lisp_Object charset; - int half; - - /* flags for handling composite chars. We do a little switcharoo - on the source while we're outputting the composite char. */ - unsigned int saved_n = 0; - CONST unsigned char *saved_src = NULL; - int in_composite = 0; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - char_boundary = str->iso2022.current_char_boundary; - charset = str->iso2022.current_charset; - half = str->iso2022.current_half; - - back_to_square_n: - while (n--) - { - c = *src++; - - if (BYTE_ASCII_P (c)) - { /* Processing ASCII character */ - ch = 0; - - restore_left_to_right_direction (codesys, dst, &flags, 0); - - /* Make sure G0 contains ASCII */ - if ((c > ' ' && c < ISO_CODE_DEL) || - !CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (codesys)) - { - ensure_normal_shift (str, dst); - iso2022_designate (Vcharset_ascii, 0, str, dst); - } - - /* If necessary, restore everything to the default state - at end-of-line */ - if (c == '\n' && - !(CODING_SYSTEM_ISO2022_NO_ASCII_EOL (codesys))) - { - restore_left_to_right_direction (codesys, dst, &flags, 0); - - ensure_normal_shift (str, dst); - - for (i = 0; i < 4; i++) - { - Lisp_Object initial_charset = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i); - iso2022_designate (initial_charset, i, str, dst); - } - } - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, c); - } - else - { - if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, c); - } - char_boundary = 1; - } - - else if (BUFBYTE_LEADING_BYTE_P (c) || BUFBYTE_LEADING_BYTE_P (ch)) - { /* Processing Leading Byte */ - ch = 0; - charset = CHARSET_BY_LEADING_BYTE (c); - if (LEADING_BYTE_PREFIX_P(c)) - ch = c; - else if (!EQ (charset, Vcharset_control_1) - && !EQ (charset, Vcharset_composite)) - { - int reg; - - ensure_correct_direction (XCHARSET_DIRECTION (charset), - codesys, dst, &flags, 0); - - /* Now determine which register to use. */ - reg = -1; - for (i = 0; i < 4; i++) - { - if (EQ (charset, str->iso2022.charset[i]) || - EQ (charset, - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i))) - { - reg = i; - break; - } - } - - if (reg == -1) - { - if (XCHARSET_GRAPHIC (charset) != 0) - { - if (!NILP (str->iso2022.charset[1]) && - (!CODING_SYSTEM_ISO2022_SEVEN (codesys) || - CODING_SYSTEM_ISO2022_LOCK_SHIFT (codesys))) - reg = 1; - else if (!NILP (str->iso2022.charset[2])) - reg = 2; - else if (!NILP (str->iso2022.charset[3])) - reg = 3; - else - reg = 0; - } - else - reg = 0; - } - - iso2022_designate (charset, reg, str, dst); - - /* Now invoke that register. */ - switch (reg) - { - case 0: - ensure_normal_shift (str, dst); - half = 0; - break; - - case 1: - if (CODING_SYSTEM_ISO2022_SEVEN (codesys)) - { - ensure_shift_out (str, dst); - half = 0; - } - else - half = 1; - break; - - case 2: - if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, 'N'); - half = 0; - } - else - { - Dynarr_add (dst, ISO_CODE_SS2); - half = 1; - } - break; - - case 3: - if (CODING_SYSTEM_ISO2022_SEVEN (str->codesys)) - { - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, 'O'); - half = 0; - } - else - { - Dynarr_add (dst, ISO_CODE_SS3); - half = 1; - } - break; - - default: - abort (); - } - } - char_boundary = 0; - } - else - { /* Processing Non-ASCII character */ - charmask = (half == 0 ? 0x7F : 0xFF); - char_boundary = 1; - if (EQ (charset, Vcharset_control_1)) - { - if (CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (codesys) - && fit_to_be_escape_quoted (c)) - Dynarr_add (dst, ISO_CODE_ESC); - /* you asked for it ... */ - Dynarr_add (dst, c - 0x20); - } - else - { - switch (XCHARSET_REP_BYTES (charset)) - { - case 2: - Dynarr_add (dst, c & charmask); - break; - case 3: - if (XCHARSET_PRIVATE_P (charset)) - { - Dynarr_add (dst, c & charmask); - ch = 0; - } - else if (ch) - { - if (EQ (charset, Vcharset_composite)) - { - if (in_composite) - { - /* #### Bother! We don't know how to - handle this yet. */ - Dynarr_add (dst, '~'); - } - else - { - Emchar emch = MAKE_CHAR (Vcharset_composite, - ch & 0x7F, c & 0x7F); - Lisp_Object lstr = composite_char_string (emch); - saved_n = n; - saved_src = src; - in_composite = 1; - src = XSTRING_DATA (lstr); - n = XSTRING_LENGTH (lstr); - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '0'); /* start composing */ - } - } - else - { - Dynarr_add (dst, ch & charmask); - Dynarr_add (dst, c & charmask); - } - ch = 0; - } - else - { - ch = c; - char_boundary = 0; - } - break; - case 4: - if (ch) - { - Dynarr_add (dst, ch & charmask); - Dynarr_add (dst, c & charmask); - ch = 0; - } - else - { - ch = c; - char_boundary = 0; - } - break; - default: - abort (); - } - } - } - } - - if (in_composite) - { - n = saved_n; - src = saved_src; - in_composite = 0; - Dynarr_add (dst, ISO_CODE_ESC); - Dynarr_add (dst, '1'); /* end composing */ - goto back_to_square_n; /* Wheeeeeeeee ..... */ - } - - if (char_boundary && flags & CODING_STATE_END) - { - restore_left_to_right_direction (codesys, dst, &flags, 0); - ensure_normal_shift (str, dst); - for (i = 0; i < 4; i++) - { - Lisp_Object initial_charset = - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (codesys, i); - iso2022_designate (initial_charset, i, str, dst); - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); - str->iso2022.current_char_boundary = char_boundary; - str->iso2022.current_charset = charset; - str->iso2022.current_half = half; - - /* Verbum caro factum est! */ -} -#endif /* MULE */ - -/************************************************************************/ -/* No-conversion methods */ -/************************************************************************/ - -/* This is used when reading in "binary" files -- i.e. files that may - contain all 256 possible byte values and that are not to be - interpreted as being in any particular decoding. */ -static void -decode_coding_no_conversion (Lstream *decoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - unsigned int flags, ch; - enum eol_type eol_type; - struct decoding_stream *str = DECODING_STREAM_DATA (decoding); - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = str->eol_type; - - while (n--) - { - c = *src++; - - DECODE_HANDLE_EOL_TYPE (eol_type, c, flags, dst); - DECODE_ADD_BINARY_CHAR (c, dst); - label_continue_loop:; - } - - DECODE_HANDLE_END_OF_CONVERSION (flags, ch, dst); - - CODING_STREAM_COMPOSE (str, flags, ch); -} - -static void -encode_coding_no_conversion (Lstream *encoding, CONST unsigned char *src, - unsigned_char_dynarr *dst, unsigned int n) -{ - unsigned char c; - struct encoding_stream *str = ENCODING_STREAM_DATA (encoding); - unsigned int flags, ch; - enum eol_type eol_type; - - CODING_STREAM_DECOMPOSE (str, flags, ch); - eol_type = CODING_SYSTEM_EOL_TYPE (str->codesys); - - while (n--) - { - c = *src++; - if (c == '\n') - { - if (eol_type != EOL_LF && eol_type != EOL_AUTODETECT) - Dynarr_add (dst, '\r'); - if (eol_type != EOL_CR) - Dynarr_add (dst, '\n'); - ch = 0; - } - else if (BYTE_ASCII_P (c)) - { - assert (ch == 0); - Dynarr_add (dst, c); - } - else if (BUFBYTE_LEADING_BYTE_P (c)) - { - assert (ch == 0); - if (c == LEADING_BYTE_LATIN_ISO8859_1 || - c == LEADING_BYTE_CONTROL_1) - ch = c; - else - Dynarr_add (dst, '~'); /* untranslatable character */ - } - else - { - if (ch == LEADING_BYTE_LATIN_ISO8859_1) - Dynarr_add (dst, c); - else if (ch == LEADING_BYTE_CONTROL_1) - { - assert (c < 0xC0); - Dynarr_add (dst, c - 0x20); - } - /* else it should be the second or third byte of an - untranslatable character, so ignore it */ - ch = 0; - } - } - - CODING_STREAM_COMPOSE (str, flags, ch); -} - - -/************************************************************************/ -/* Simple internal/external functions */ -/************************************************************************/ - -static Extbyte_dynarr *conversion_out_dynarr; -static Bufbyte_dynarr *conversion_in_dynarr; - -/* Determine coding system from coding format */ - -/* #### not correct for all values of `fmt'! */ -static Lisp_Object -external_data_format_to_coding_system (enum external_data_format fmt) -{ - switch (fmt) - { - case FORMAT_FILENAME: - case FORMAT_TERMINAL: - if (EQ (Vfile_name_coding_system, Qnil) || - EQ (Vfile_name_coding_system, Qbinary)) - return Qnil; - else - return Fget_coding_system (Vfile_name_coding_system); -#ifdef MULE - case FORMAT_CTEXT: - return Fget_coding_system (Qctext); -#endif - default: - return Qnil; - } -} - -Extbyte * -convert_to_external_format (CONST Bufbyte *ptr, - Bytecount len, - Extcount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - if (NILP (coding_system)) - { - CONST Bufbyte *end = ptr + len; - - for (; ptr < end;) - { - Bufbyte c = - (BYTE_ASCII_P (*ptr)) ? *ptr : - (*ptr == LEADING_BYTE_CONTROL_1) ? (*(ptr+1) - 0x20) : - (*ptr == LEADING_BYTE_LATIN_ISO8859_1) ? (*(ptr+1)) : - '~'; - - Dynarr_add (conversion_out_dynarr, (Extbyte) c); - INC_CHARPTR (ptr); - } - -#ifdef ERROR_CHECK_BUFPOS - assert (ptr == end); -#endif - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_out_dynarr); - outstream = - make_encoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_out_dynarr); - Dynarr_add (conversion_out_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_out_dynarr, 0); -} - -Bufbyte * -convert_from_external_format (CONST Extbyte *ptr, - Extcount len, - Bytecount *len_out, - enum external_data_format fmt) -{ - Lisp_Object coding_system = external_data_format_to_coding_system (fmt); - - if (!conversion_in_dynarr) - conversion_in_dynarr = Dynarr_new (Bufbyte); - else - Dynarr_reset (conversion_in_dynarr); - - if (NILP (coding_system)) - { - CONST Extbyte *end = ptr + len; - for (; ptr < end; ptr++) - { - Extbyte c = *ptr; - DECODE_ADD_BINARY_CHAR (c, conversion_in_dynarr); - } - } - else - { - Lisp_Object instream, outstream, da_outstream; - Lstream *istr, *ostr; - struct gcpro gcpro1, gcpro2, gcpro3; - char tempbuf[1024]; /* some random amount */ - - instream = make_fixed_buffer_input_stream ((unsigned char *) ptr, len); - da_outstream = make_dynarr_output_stream - ((unsigned_char_dynarr *) conversion_in_dynarr); - outstream = - make_decoding_output_stream (XLSTREAM (da_outstream), coding_system); - istr = XLSTREAM (instream); - ostr = XLSTREAM (outstream); - GCPRO3 (instream, outstream, da_outstream); - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - Lstream_write (ostr, tempbuf, size_in_bytes); - } - Lstream_close (istr); - Lstream_close (ostr); - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); - Lstream_delete (XLSTREAM (da_outstream)); - } - - *len_out = Dynarr_length (conversion_in_dynarr); - Dynarr_add (conversion_in_dynarr, 0); /* remember to zero-terminate! */ - return Dynarr_atp (conversion_in_dynarr, 0); -} - - -/************************************************************************/ -/* Initialization */ -/************************************************************************/ - -void -syms_of_mule_coding (void) -{ - defsymbol (&Qbuffer_file_coding_system, "buffer-file-coding-system"); - deferror (&Qcoding_system_error, "coding-system-error", - "Coding-system error", Qio_error); - - DEFSUBR (Fcoding_system_p); - DEFSUBR (Ffind_coding_system); - DEFSUBR (Fget_coding_system); - DEFSUBR (Fcoding_system_list); - DEFSUBR (Fcoding_system_name); - DEFSUBR (Fmake_coding_system); - DEFSUBR (Fcopy_coding_system); - DEFSUBR (Fsubsidiary_coding_system); - - DEFSUBR (Fcoding_system_type); - DEFSUBR (Fcoding_system_doc_string); -#ifdef MULE - DEFSUBR (Fcoding_system_charset); -#endif - DEFSUBR (Fcoding_system_property); - - DEFSUBR (Fcoding_category_list); - DEFSUBR (Fset_coding_priority_list); - DEFSUBR (Fcoding_priority_list); - DEFSUBR (Fset_coding_category_system); - DEFSUBR (Fcoding_category_system); - - DEFSUBR (Fdetect_coding_region); - DEFSUBR (Fdecode_coding_region); - DEFSUBR (Fencode_coding_region); -#ifdef MULE - DEFSUBR (Fdecode_shift_jis_char); - DEFSUBR (Fencode_shift_jis_char); - DEFSUBR (Fdecode_big5_char); - DEFSUBR (Fencode_big5_char); -#endif /* MULE */ - defsymbol (&Qcoding_system_p, "coding-system-p"); - defsymbol (&Qno_conversion, "no-conversion"); -#ifdef MULE - defsymbol (&Qbig5, "big5"); - defsymbol (&Qshift_jis, "shift-jis"); - defsymbol (&Qccl, "ccl"); - defsymbol (&Qiso2022, "iso2022"); -#endif /* MULE */ - defsymbol (&Qmnemonic, "mnemonic"); - defsymbol (&Qeol_type, "eol-type"); - defsymbol (&Qpost_read_conversion, "post-read-conversion"); - defsymbol (&Qpre_write_conversion, "pre-write-conversion"); - - defsymbol (&Qcr, "cr"); - defsymbol (&Qlf, "lf"); - defsymbol (&Qcrlf, "crlf"); - defsymbol (&Qeol_cr, "eol-cr"); - defsymbol (&Qeol_lf, "eol-lf"); - defsymbol (&Qeol_crlf, "eol-crlf"); -#ifdef MULE - defsymbol (&Qcharset_g0, "charset-g0"); - defsymbol (&Qcharset_g1, "charset-g1"); - defsymbol (&Qcharset_g2, "charset-g2"); - defsymbol (&Qcharset_g3, "charset-g3"); - defsymbol (&Qforce_g0_on_output, "force-g0-on-output"); - defsymbol (&Qforce_g1_on_output, "force-g1-on-output"); - defsymbol (&Qforce_g2_on_output, "force-g2-on-output"); - defsymbol (&Qforce_g3_on_output, "force-g3-on-output"); - defsymbol (&Qno_iso6429, "no-iso6429"); - defsymbol (&Qinput_charset_conversion, "input-charset-conversion"); - defsymbol (&Qoutput_charset_conversion, "output-charset-conversion"); - - defsymbol (&Qshort, "short"); - defsymbol (&Qno_ascii_eol, "no-ascii-eol"); - defsymbol (&Qno_ascii_cntl, "no-ascii-cntl"); - defsymbol (&Qseven, "seven"); - defsymbol (&Qlock_shift, "lock-shift"); - defsymbol (&Qescape_quoted, "escape-quoted"); -#endif /* MULE */ - defsymbol (&Qencode, "encode"); - defsymbol (&Qdecode, "decode"); - -#ifdef MULE - defsymbol (&Qctext, "ctext"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_SHIFT_JIS], - "shift-jis"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_BIG5], - "big5"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_7], - "iso-7"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_DESIGNATE], - "iso-8-designate"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_1], - "iso-8-1"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_8_2], - "iso-8-2"); - defsymbol (&coding_category_symbol[CODING_CATEGORY_ISO_LOCK_SHIFT], - "iso-lock-shift"); -#endif /* MULE */ - defsymbol (&coding_category_symbol[CODING_CATEGORY_NO_CONVERSION], - "no-conversion"); -} - -void -lstream_type_create_mule_coding (void) -{ - LSTREAM_HAS_METHOD (decoding, reader); - LSTREAM_HAS_METHOD (decoding, writer); - LSTREAM_HAS_METHOD (decoding, rewinder); - LSTREAM_HAS_METHOD (decoding, seekable_p); - LSTREAM_HAS_METHOD (decoding, flusher); - LSTREAM_HAS_METHOD (decoding, closer); - LSTREAM_HAS_METHOD (decoding, marker); - - LSTREAM_HAS_METHOD (encoding, reader); - LSTREAM_HAS_METHOD (encoding, writer); - LSTREAM_HAS_METHOD (encoding, rewinder); - LSTREAM_HAS_METHOD (encoding, seekable_p); - LSTREAM_HAS_METHOD (encoding, flusher); - LSTREAM_HAS_METHOD (encoding, closer); - LSTREAM_HAS_METHOD (encoding, marker); -} - -void -vars_of_mule_coding (void) -{ - int i; - - /* Initialize to something reasonable ... */ - for (i = 0; i <= CODING_CATEGORY_LAST; i++) - { - coding_category_system[i] = Qnil; - coding_category_by_priority[i] = i; - } - - Fprovide (intern ("file-coding")); - - DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /* -Coding system used for TTY keyboard input. -Not used under a windowing system. -*/ ); - Vkeyboard_coding_system = Qnil; - - DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /* -Coding system used for TTY display output. -Not used under a windowing system. -*/ ); - Vterminal_coding_system = Qnil; - - DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is read -in, and overrides `buffer-file-coding-system-for-read', -`insert-file-contents-pre-hook', etc. Use those variables instead of -this one for permanent changes to the environment. -*/ ); - Vcoding_system_for_read = Qnil; - - DEFVAR_LISP ("coding-system-for-write", - &Vcoding_system_for_write /* -Overriding coding system used when writing a file or process. -You should *bind* this, not set it. If this is non-nil, it specifies -the coding system that will be used when a file or process is wrote -in, and overrides `buffer-file-coding-system', -`write-region-pre-hook', etc. Use those variables instead of this one -for permanent changes to the environment. -*/ ); - Vcoding_system_for_write = Qnil; - - DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /* -Coding system used to convert pathnames when accessing files. -*/ ); - Vfile_name_coding_system = Qnil; - - DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /* -Non-nil means the buffer contents are regarded as multi-byte form -of characters, not a binary code. This affects the display, file I/O, -and behaviors of various editing commands. - -Setting this to nil does not do anything. -*/ ); - enable_multibyte_characters = 1; -} - -void -complex_vars_of_mule_coding (void) -{ - staticpro (&Vcoding_system_hash_table); - Vcoding_system_hash_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - - the_codesys_prop_dynarr = Dynarr_new (codesys_prop); - -#define DEFINE_CODESYS_PROP(Prop_Type, Sym) do \ -{ \ - struct codesys_prop csp; \ - csp.sym = (Sym); \ - csp.prop_type = (Prop_Type); \ - Dynarr_add (the_codesys_prop_dynarr, csp); \ -} while (0) - - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qmnemonic); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_type); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_cr); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_crlf); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qeol_lf); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpost_read_conversion); - DEFINE_CODESYS_PROP (CODESYS_PROP_ALL_OK, Qpre_write_conversion); -#ifdef MULE - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g0); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g1); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g2); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qcharset_g3); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g0_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g1_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g2_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qforce_g3_on_output); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qshort); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_eol); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_ascii_cntl); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qseven); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qlock_shift); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qno_iso6429); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qescape_quoted); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qinput_charset_conversion); - DEFINE_CODESYS_PROP (CODESYS_PROP_ISO2022, Qoutput_charset_conversion); - - DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qencode); - DEFINE_CODESYS_PROP (CODESYS_PROP_CCL, Qdecode); -#endif /* MULE */ - /* Need to create this here or we're really screwed. */ - Fmake_coding_system (Qno_conversion, Qno_conversion, build_string ("No conversion"), - list2 (Qmnemonic, build_string ("Noconv"))); - - Fcopy_coding_system (Fcoding_system_property (Qno_conversion, Qeol_lf), - Qbinary); - - /* Need this for bootstrapping */ - coding_category_system[CODING_CATEGORY_NO_CONVERSION] = - Fget_coding_system (Qno_conversion); -} diff --git a/src/file-coding.h b/src/file-coding.h deleted file mode 100644 index a29e3ec..0000000 --- a/src/file-coding.h +++ /dev/null @@ -1,516 +0,0 @@ -/* Header for code conversion stuff - Copyright (C) 1991, 1995 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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: Mule 2.3. Not in FSF. */ - -/* 91.10.09 written by K.Handa */ -/* Rewritten by Ben Wing . */ - -#ifndef _XEMACS_MULE_CODING_H_ -#define _XEMACS_MULE_CODING_H_ - -struct decoding_stream; -struct encoding_stream; - -/* Coding system types. These go into the TYPE field of a - struct Lisp_Coding_System. */ - -enum coding_system_type -{ - CODESYS_AUTODETECT, /* Automatic conversion. */ -#ifdef MULE - CODESYS_SHIFT_JIS, /* Shift-JIS; Hankaku (half-width) KANA - is also supported. */ - CODESYS_ISO2022, /* Any ISO2022-compliant coding system. - Includes JIS, EUC, CTEXT */ - CODESYS_BIG5, /* BIG5 (used for Taiwanese). */ - CODESYS_CCL, /* Converter written in CCL. */ -#endif - CODESYS_NO_CONVERSION /* "No conversion"; used for binary files. - We use quotes because there really - is some conversion being applied, - but it appears to the user as if - the text is read in without conversion. */ -#ifdef DEBUG_XEMACS - ,CODESYS_INTERNAL /* Raw (internally-formatted) data. */ -#endif -}; - -enum eol_type -{ - EOL_AUTODETECT, - EOL_LF, - EOL_CRLF, - EOL_CR -}; - -#ifdef MULE -typedef struct charset_conversion_spec charset_conversion_spec; -struct charset_conversion_spec -{ - Lisp_Object from_charset; - Lisp_Object to_charset; -}; - -typedef struct -{ - Dynarr_declare (charset_conversion_spec); -} charset_conversion_spec_dynarr; -#endif - -struct Lisp_Coding_System -{ - struct lcrecord_header header; - - /* Name and doc string of this coding system. */ - Lisp_Object name, doc_string; - - /* This is the major type of the coding system -- one of Big5, ISO2022, - Shift-JIS, etc. See the constants above. */ - enum coding_system_type type; - - /* Mnemonic string displayed in the modeline when this coding - system is active for a particular buffer. */ - Lisp_Object mnemonic; - - Lisp_Object post_read_conversion, pre_write_conversion; - - enum eol_type eol_type; - - /* Subsidiary coding systems that specify a particular type of EOL - marking, rather than autodetecting it. These will only be non-nil - if (eol_type == EOL_AUTODETECT). */ - Lisp_Object eol_lf, eol_crlf, eol_cr; -#ifdef MULE - struct - { - /* What are the charsets to be initially designated to G0, G1, - G2, G3? If t, no charset is initially designated. If nil, - no charset is initially designated and no charset is allowed - to be designated. */ - Lisp_Object initial_charset[4]; - - /* If true, a designation escape sequence needs to be sent on output - for the charset in G[0-3] before that charset is used. */ - unsigned char force_charset_on_output[4]; - - charset_conversion_spec_dynarr *input_conv; - charset_conversion_spec_dynarr *output_conv; - - unsigned int shoort :1; /* C makes you speak Dutch */ - unsigned int no_ascii_eol :1; - unsigned int no_ascii_cntl :1; - unsigned int seven :1; - unsigned int lock_shift :1; - unsigned int no_iso6429 :1; - unsigned int escape_quoted :1; - } iso2022; - struct - { - /* For a CCL coding system, these specify the CCL programs used for - decoding (input) and encoding (output). */ - Lisp_Object decode, encode; - } ccl; -#endif -}; - -DECLARE_LRECORD (coding_system, struct Lisp_Coding_System); -#define XCODING_SYSTEM(x) XRECORD (x, coding_system, struct Lisp_Coding_System) -#define XSETCODING_SYSTEM(x, p) XSETRECORD (x, p, coding_system) -#define CODING_SYSTEMP(x) RECORDP (x, coding_system) -#define GC_CODING_SYSTEMP(x) GC_RECORDP (x, coding_system) -#define CHECK_CODING_SYSTEM(x) CHECK_RECORD (x, coding_system) -#define CONCHECK_CODING_SYSTEM(x) CONCHECK_RECORD (x, coding_system) - -#define CODING_SYSTEM_NAME(codesys) ((codesys)->name) -#define CODING_SYSTEM_DOC_STRING(codesys) ((codesys)->doc_string) -#define CODING_SYSTEM_TYPE(codesys) ((codesys)->type) -#define CODING_SYSTEM_MNEMONIC(codesys) ((codesys)->mnemonic) -#define CODING_SYSTEM_POST_READ_CONVERSION(codesys) \ - ((codesys)->post_read_conversion) -#define CODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \ - ((codesys)->pre_write_conversion) -#define CODING_SYSTEM_EOL_TYPE(codesys) ((codesys)->eol_type) -#define CODING_SYSTEM_EOL_LF(codesys) ((codesys)->eol_lf) -#define CODING_SYSTEM_EOL_CRLF(codesys) ((codesys)->eol_crlf) -#define CODING_SYSTEM_EOL_CR(codesys) ((codesys)->eol_cr) - -#ifdef MULE -#define CODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \ - ((codesys)->iso2022.initial_charset[g]) -#define CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \ - ((codesys)->iso2022.force_charset_on_output[g]) -#define CODING_SYSTEM_ISO2022_SHORT(codesys) ((codesys)->iso2022.shoort) -#define CODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \ - ((codesys)->iso2022.no_ascii_eol) -#define CODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \ - ((codesys)->iso2022.no_ascii_cntl) -#define CODING_SYSTEM_ISO2022_SEVEN(codesys) ((codesys)->iso2022.seven) -#define CODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \ - ((codesys)->iso2022.lock_shift) -#define CODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \ - ((codesys)->iso2022.no_iso6429) -#define CODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \ - ((codesys)->iso2022.escape_quoted) -#define CODING_SYSTEM_CCL_DECODE(codesys) ((codesys)->ccl.decode) -#define CODING_SYSTEM_CCL_ENCODE(codesys) ((codesys)->ccl.encode) -#endif /* MULE */ - -#define XCODING_SYSTEM_NAME(codesys) \ - CODING_SYSTEM_NAME (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_DOC_STRING(codesys) \ - CODING_SYSTEM_DOC_STRING (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_TYPE(codesys) \ - CODING_SYSTEM_TYPE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_MNEMONIC(codesys) \ - CODING_SYSTEM_MNEMONIC (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_POST_READ_CONVERSION(codesys) \ - CODING_SYSTEM_POST_READ_CONVERSION (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_PRE_WRITE_CONVERSION(codesys) \ - CODING_SYSTEM_PRE_WRITE_CONVERSION (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_TYPE(codesys) \ - CODING_SYSTEM_EOL_TYPE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_LF(codesys) \ - CODING_SYSTEM_EOL_LF (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_CRLF(codesys) \ - CODING_SYSTEM_EOL_CRLF (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_EOL_CR(codesys) \ - CODING_SYSTEM_EOL_CR (XCODING_SYSTEM (codesys)) - -#ifdef MULE -#define XCODING_SYSTEM_ISO2022_INITIAL_CHARSET(codesys, g) \ - CODING_SYSTEM_ISO2022_INITIAL_CHARSET (XCODING_SYSTEM (codesys), g) -#define XCODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT(codesys, g) \ - CODING_SYSTEM_ISO2022_FORCE_CHARSET_ON_OUTPUT (XCODING_SYSTEM (codesys), g) -#define XCODING_SYSTEM_ISO2022_SHORT(codesys) \ - CODING_SYSTEM_ISO2022_SHORT (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ASCII_EOL(codesys) \ - CODING_SYSTEM_ISO2022_NO_ASCII_EOL (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ASCII_CNTL(codesys) \ - CODING_SYSTEM_ISO2022_NO_ASCII_CNTL (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_SEVEN(codesys) \ - CODING_SYSTEM_ISO2022_SEVEN (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_LOCK_SHIFT(codesys) \ - CODING_SYSTEM_ISO2022_LOCK_SHIFT (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_NO_ISO6429(codesys) \ - CODING_SYSTEM_ISO2022_NO_ISO6429 (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_ISO2022_ESCAPE_QUOTED(codesys) \ - CODING_SYSTEM_ISO2022_ESCAPE_QUOTED (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_CCL_DECODE(codesys) \ - CODING_SYSTEM_CCL_DECODE (XCODING_SYSTEM (codesys)) -#define XCODING_SYSTEM_CCL_ENCODE(codesys) \ - CODING_SYSTEM_CCL_ENCODE (XCODING_SYSTEM (codesys)) -#endif /* MULE */ - -EXFUN (Fcoding_category_list, 0); -EXFUN (Fcoding_category_system, 1); -EXFUN (Fcoding_priority_list, 0); -EXFUN (Fcoding_system_charset, 2); -EXFUN (Fcoding_system_doc_string, 1); -EXFUN (Fcoding_system_list, 0); -EXFUN (Fcoding_system_name, 1); -EXFUN (Fcoding_system_p, 1); -EXFUN (Fcoding_system_property, 2); -EXFUN (Fcoding_system_type, 1); -EXFUN (Fcopy_coding_system, 2); -EXFUN (Fdecode_big5_char, 1); -EXFUN (Fdecode_coding_region, 4); -EXFUN (Fdecode_shift_jis_char, 1); -EXFUN (Fdetect_coding_region, 3); -EXFUN (Fencode_big5_char, 1); -EXFUN (Fencode_coding_region, 4); -EXFUN (Fencode_shift_jis_char, 1); -EXFUN (Ffind_coding_system, 1); -EXFUN (Fget_coding_system, 1); -EXFUN (Fmake_coding_system, 4); -EXFUN (Fset_coding_category_system, 2); -EXFUN (Fset_coding_priority_list, 1); -EXFUN (Fsubsidiary_coding_system, 2); - -extern Lisp_Object Qbig5, Qbuffer_file_coding_system, Qccl, Qcharset_g0; -extern Lisp_Object Qcharset_g1, Qcharset_g2, Qcharset_g3, Qcoding_system_error; -extern Lisp_Object Qcoding_system_p, Qcr, Qcrlf, Qctext, Qdecode, Qencode; -extern Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf, Qeol_type, Qescape_quoted; -extern Lisp_Object Qforce_g0_on_output, Qforce_g1_on_output; -extern Lisp_Object Qforce_g2_on_output, Qforce_g3_on_output; -extern Lisp_Object Qinput_charset_conversion, Qiso2022, Qlf, Qlock_shift; -extern Lisp_Object Qmnemonic, Qno_ascii_cntl, Qno_ascii_eol, Qno_conversion; -extern Lisp_Object Qno_iso6429, Qoutput_charset_conversion; -extern Lisp_Object Qpost_read_conversion, Qpre_write_conversion, Qseven; -extern Lisp_Object Qshift_jis, Qshort, Vcoding_system_for_read; -extern Lisp_Object Vcoding_system_for_write, Vcoding_system_hash_table; -extern Lisp_Object Vfile_name_coding_system, Vkeyboard_coding_system; -extern Lisp_Object Vterminal_coding_system; - -/* Flags indicating current state while converting code. */ - -/* Used by everyone. */ - -#define CODING_STATE_END (1 << 0) /* If set, this is the last chunk of - data being processed. When this - is finished, output any necessary - terminating control characters, - escape sequences, etc. */ -#define CODING_STATE_CR (1 << 1) /* If set, we just saw a CR. */ - - -/* Used by Big 5 on output. */ -#ifdef MULE -#define CODING_STATE_BIG5_1 (1 << 2) /* If set, we just encountered - LEADING_BYTE_BIG5_1. */ -#define CODING_STATE_BIG5_2 (1 << 3) /* If set, we just encountered - LEADING_BYTE_BIG5_2. */ - - -/* Used by ISO2022 on input and output. */ - -#define CODING_STATE_R2L (1 << 4) /* If set, the current - directionality is right-to-left. - Otherwise, it's left-to-right. */ - - -/* Used by ISO2022 on input. */ - -#define CODING_STATE_ESCAPE (1 << 5) /* If set, we're currently parsing - an escape sequence and the upper - 16 bits should be looked at to - indicate what partial escape - sequence we've seen so far. - Otherwise, we're running - through actual text. */ -#define CODING_STATE_SS2 (1 << 6) /* If set, G2 is invoked into GL, but - only for the next character. */ -#define CODING_STATE_SS3 (1 << 7) /* If set, G3 is invoked into GL, - but only for the next character. - If both CODING_STATE_SS2 and - CODING_STATE_SS3 are set, - CODING_STATE_SS2 overrides; but - this probably indicates an error - in the text encoding. */ -#define CODING_STATE_COMPOSITE (1 << 8) /* If set, we're currently processing - a composite character (i.e. a - character constructed by - overstriking two or more - characters). */ - - -/* CODING_STATE_ISO2022_LOCK is the mask of flags that remain on until - explicitly turned off when in the ISO2022 encoder/decoder. Other flags are - turned off at the end of processing each character or escape sequence. */ -# define CODING_STATE_ISO2022_LOCK \ - (CODING_STATE_END | CODING_STATE_COMPOSITE | CODING_STATE_R2L) -#define CODING_STATE_BIG5_LOCK \ - CODING_STATE_END - -/* Flags indicating what we've seen so far when parsing an - ISO2022 escape sequence. */ -enum iso_esc_flag -{ - /* Partial sequences */ - ISO_ESC_NOTHING, /* Nothing has been seen. */ - ISO_ESC, /* We've seen ESC. */ - ISO_ESC_2_4, /* We've seen ESC $. This indicates - that we're designating a multi-byte, rather - than a single-byte, character set. */ - ISO_ESC_2_8, /* We've seen ESC 0x28, i.e. ESC (. - This means designate a 94-character - character set into G0. */ - ISO_ESC_2_9, /* We've seen ESC 0x29 -- designate a - 94-character character set into G1. */ - ISO_ESC_2_10, /* We've seen ESC 0x2A. */ - ISO_ESC_2_11, /* We've seen ESC 0x2B. */ - ISO_ESC_2_12, /* We've seen ESC 0x2C -- designate a - 96-character character set into G0. - (This is not ISO2022-standard. - The following 96-character - control sequences are standard, - though.) */ - ISO_ESC_2_13, /* We've seen ESC 0x2D -- designate a - 96-character character set into G1. - */ - ISO_ESC_2_14, /* We've seen ESC 0x2E. */ - ISO_ESC_2_15, /* We've seen ESC 0x2F. */ - ISO_ESC_2_4_8, /* We've seen ESC $ 0x28 -- designate - a 94^N character set into G0. */ - ISO_ESC_2_4_9, /* We've seen ESC $ 0x29. */ - ISO_ESC_2_4_10, /* We've seen ESC $ 0x2A. */ - ISO_ESC_2_4_11, /* We've seen ESC $ 0x2B. */ - ISO_ESC_2_4_12, /* We've seen ESC $ 0x2C. */ - ISO_ESC_2_4_13, /* We've seen ESC $ 0x2D. */ - ISO_ESC_2_4_14, /* We've seen ESC $ 0x2E. */ - ISO_ESC_2_4_15, /* We've seen ESC $ 0x2F. */ - ISO_ESC_5_11, /* We've seen ESC [ or 0x9B. This - starts a directionality-control - sequence. The next character - must be 0, 1, 2, or ]. */ - ISO_ESC_5_11_0, /* We've seen 0x9B 0. The next - character must be ]. */ - ISO_ESC_5_11_1, /* We've seen 0x9B 1. The next - character must be ]. */ - ISO_ESC_5_11_2, /* We've seen 0x9B 2. The next - character must be ]. */ - - /* Full sequences. */ - ISO_ESC_START_COMPOSITE, /* Private usage for START COMPOSING */ - ISO_ESC_END_COMPOSITE, /* Private usage for END COMPOSING */ - ISO_ESC_SINGLE_SHIFT, /* We've seen a complete single-shift sequence. */ - ISO_ESC_LOCKING_SHIFT,/* We've seen a complete locking-shift sequence. */ - ISO_ESC_DESIGNATE, /* We've seen a complete designation sequence. */ - ISO_ESC_DIRECTIONALITY,/* We've seen a complete ISO6429 directionality - sequence. */ - ISO_ESC_LITERAL /* We've seen a literal character ala - escape-quoting. */ -}; - -/* Macros to define code of control characters for ISO2022's functions. */ - /* code */ /* function */ -#define ISO_CODE_LF 0x0A /* line-feed */ -#define ISO_CODE_CR 0x0D /* carriage-return */ -#define ISO_CODE_SO 0x0E /* shift-out */ -#define ISO_CODE_SI 0x0F /* shift-in */ -#define ISO_CODE_ESC 0x1B /* escape */ -#define ISO_CODE_DEL 0x7F /* delete */ -#define ISO_CODE_SS2 0x8E /* single-shift-2 */ -#define ISO_CODE_SS3 0x8F /* single-shift-3 */ -#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */ -#endif /* MULE */ - -/* Macros to access an encoding stream or decoding stream */ - -#define CODING_STREAM_DECOMPOSE(str, flags, ch) \ -do { \ - flags = (str)->flags; \ - ch = (str)->ch; \ -} while (0) - -#define CODING_STREAM_COMPOSE(str, flags, ch) \ -do { \ - (str)->flags = flags; \ - (str)->ch = ch; \ -} while (0) - - -/* For detecting the encoding of text */ -enum coding_category_type -{ -#ifdef MULE - CODING_CATEGORY_SHIFT_JIS, - CODING_CATEGORY_ISO_7, /* ISO2022 system using only seven-bit bytes, - no locking shift */ - CODING_CATEGORY_ISO_8_DESIGNATE, /* ISO2022 system using eight-bit bytes, - no locking shift, no single shift, - using designation to switch charsets */ - CODING_CATEGORY_ISO_8_1, /* ISO2022 system using eight-bit bytes, - no locking shift, no designation sequences, - one-dimension characters in the upper half. */ - CODING_CATEGORY_ISO_8_2, /* ISO2022 system using eight-bit bytes, - no locking shift, no designation sequences, - two-dimension characters in the upper half. */ - CODING_CATEGORY_ISO_LOCK_SHIFT, /* ISO2022 system using locking shift */ - CODING_CATEGORY_BIG5, -#endif /* MULE */ - CODING_CATEGORY_NO_CONVERSION -}; - -#define CODING_CATEGORY_LAST CODING_CATEGORY_NO_CONVERSION - -#ifdef MULE -#define CODING_CATEGORY_SHIFT_JIS_MASK \ - (1 << CODING_CATEGORY_SHIFT_JIS) -#define CODING_CATEGORY_ISO_7_MASK \ - (1 << CODING_CATEGORY_ISO_7) -#define CODING_CATEGORY_ISO_8_DESIGNATE_MASK \ - (1 << CODING_CATEGORY_ISO_8_DESIGNATE) -#define CODING_CATEGORY_ISO_8_1_MASK \ - (1 << CODING_CATEGORY_ISO_8_1) -#define CODING_CATEGORY_ISO_8_2_MASK \ - (1 << CODING_CATEGORY_ISO_8_2) -#define CODING_CATEGORY_ISO_LOCK_SHIFT_MASK \ - (1 << CODING_CATEGORY_ISO_LOCK_SHIFT) -#define CODING_CATEGORY_BIG5_MASK \ - (1 << CODING_CATEGORY_BIG5) -#endif -#define CODING_CATEGORY_NO_CONVERSION_MASK \ - (1 << CODING_CATEGORY_NO_CONVERSION) -#define CODING_CATEGORY_NOT_FINISHED_MASK \ - (1 << 30) - -#ifdef MULE -/* Convert shift-JIS code (sj1, sj2) into internal string - representation (c1, c2). (The leading byte is assumed.) */ - -#define DECODE_SJIS(sj1, sj2, c1, c2) \ -do { \ - int I1 = sj1, I2 = sj2; \ - if (I2 >= 0x9f) \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe0 : 0x60), \ - c2 = I2 + 2; \ - else \ - c1 = (I1 << 1) - ((I1 >= 0xe0) ? 0xe1 : 0x61), \ - c2 = I2 + ((I2 >= 0x7f) ? 0x60 : 0x61); \ -} while (0) - -/* Convert the internal string representation of a Shift-JIS character - (c1, c2) into Shift-JIS code (sj1, sj2). The leading byte is - assumed. */ - -#define ENCODE_SJIS(c1, c2, sj1, sj2) \ -do { \ - int I1 = c1, I2 = c2; \ - if (I1 & 1) \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x31 : 0x71), \ - sj2 = I2 - ((I2 >= 0xe0) ? 0x60 : 0x61); \ - else \ - sj1 = (I1 >> 1) + ((I1 < 0xdf) ? 0x30 : 0x70), \ - sj2 = I2 - 2; \ -} while (0) -#endif /* MULE */ - -Lisp_Object make_decoding_input_stream (Lstream *stream, - Lisp_Object codesys); -Lisp_Object make_encoding_input_stream (Lstream *stream, - Lisp_Object codesys); -Lisp_Object make_decoding_output_stream (Lstream *stream, - Lisp_Object codesys); -Lisp_Object make_encoding_output_stream (Lstream *stream, - Lisp_Object codesys); -Lisp_Object decoding_stream_coding_system (Lstream *stream); -Lisp_Object encoding_stream_coding_system (Lstream *stream); -void set_decoding_stream_coding_system (Lstream *stream, - Lisp_Object codesys); -void set_encoding_stream_coding_system (Lstream *stream, - Lisp_Object codesys); -void determine_real_coding_system (Lstream *stream, Lisp_Object *codesys_in_out, - enum eol_type *eol_type_in_out); - - -#ifndef MULE -#define MIN_LEADING_BYTE 0x80 -/* These need special treatment in a string and/or character */ -#define LEADING_BYTE_COMPOSITE 0x80 /* for a composite character */ -#define LEADING_BYTE_CONTROL_1 0x8F /* represent normal 80-9F */ -#define LEADING_BYTE_LATIN_ISO8859_1 0x81 /* Right half of ISO 8859-1 */ -#define BYTE_C1_P(c) ((unsigned int) ((unsigned int) (c) - 0x80) < 0x20) -#define BUFBYTE_FIRST_BYTE_P(c) ((c) < 0xA0) -#define BUFBYTE_LEADING_BYTE_P(c) BYTE_C1_P (c) -#endif /* not MULE */ -#endif /* _XEMACS_MULE_CODING_H_ */ - diff --git a/src/fileio.c b/src/fileio.c deleted file mode 100644 index 6844d96..0000000 --- a/src/fileio.c +++ /dev/null @@ -1,4342 +0,0 @@ -/* File IO for XEmacs. - Copyright (C) 1985-1988, 1992-1995 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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: Mule 2.0, FSF 19.30. */ -/* More syncing: FSF Emacs 19.34.6 by Marc Paquette */ - -#include -#include "lisp.h" -#include - -#include "buffer.h" -#include "events.h" -#include "frame.h" -#include "insdel.h" -#include "lstream.h" -#include "redisplay.h" -#include "sysdep.h" -#include "window.h" /* minibuf_level */ -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -#ifdef HAVE_LIBGEN_H /* Must come before sysfile.h */ -#include -#endif -#include "sysfile.h" -#include "sysproc.h" -#include "syspwd.h" -#include "systime.h" -#include "sysdir.h" - -#ifdef HPUX -#include -#ifdef HPUX_PRE_8_0 -#include -#endif /* HPUX_PRE_8_0 */ -#endif /* HPUX */ - -#ifdef WINDOWSNT -#define NOMINMAX 1 -#include -#include -#include -#include -#endif /* not WINDOWSNT */ - -#ifdef WINDOWSNT -#define CORRECT_DIR_SEPS(s) \ - do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \ - else unixtodos_filename (s); \ - } while (0) -#define IS_DRIVE(x) isalpha (x) -/* Need to lower-case the drive letter, or else expanded - filenames will sometimes compare inequal, because - `expand-file-name' doesn't always down-case the drive letter. */ -#define DRIVE_LETTER(x) (tolower (x)) -#endif /* WINDOWSNT */ - -int lisp_to_time (Lisp_Object, time_t *); -Lisp_Object time_to_lisp (time_t); - -/* Nonzero during writing of auto-save files */ -static int auto_saving; - -/* Set by auto_save_1 to mode of original file so Fwrite_region_internal - will create a new file with the same mode as the original */ -static int auto_save_mode_bits; - -/* Alist of elements (REGEXP . HANDLER) for file names - whose I/O is done with a special handler. */ -Lisp_Object Vfile_name_handler_alist; - -/* Format for auto-save files */ -Lisp_Object Vauto_save_file_format; - -/* Lisp functions for translating file formats */ -Lisp_Object Qformat_decode, Qformat_annotate_function; - -/* Functions to be called to process text properties in inserted file. */ -Lisp_Object Vafter_insert_file_functions; - -/* Functions to be called to create text property annotations for file. */ -Lisp_Object Vwrite_region_annotate_functions; - -/* During build_annotations, each time an annotation function is called, - this holds the annotations made by the previous functions. */ -Lisp_Object Vwrite_region_annotations_so_far; - -/* File name in which we write a list of all our auto save files. */ -Lisp_Object Vauto_save_list_file_name; - -int disable_auto_save_when_buffer_shrinks; - -Lisp_Object Qfile_name_handler_alist; - -Lisp_Object Vdirectory_sep_char; - -/* These variables describe handlers that have "already" had a chance - to handle the current operation. - - Vinhibit_file_name_handlers is a list of file name handlers. - Vinhibit_file_name_operation is the operation being handled. - If we try to handle that operation, we ignore those handlers. */ - -static Lisp_Object Vinhibit_file_name_handlers; -static Lisp_Object Vinhibit_file_name_operation; - -Lisp_Object Qfile_error, Qfile_already_exists; - -Lisp_Object Qauto_save_hook; -Lisp_Object Qauto_save_error; -Lisp_Object Qauto_saving; - -Lisp_Object Qcar_less_than_car; - -Lisp_Object Qcompute_buffer_file_truename; - -EXFUN (Frunning_temacs_p, 0); - -/* signal a file error when errno contains a meaningful value. */ - -DOESNT_RETURN -report_file_error (CONST char *string, Lisp_Object data) -{ - /* #### dmoore - This uses current_buffer, better make sure no one - has GC'd the current buffer. File handlers are giving me a headache - maybe I'll just always protect current_buffer around all of those - calls. */ - - signal_error (Qfile_error, - Fcons (build_translated_string (string), - Fcons (lisp_strerror (errno), data))); -} - -void -maybe_report_file_error (CONST char *string, Lisp_Object data, - Lisp_Object class, Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - - maybe_signal_error (Qfile_error, - Fcons (build_translated_string (string), - Fcons (lisp_strerror (errno), data)), - class, errb); -} - -/* signal a file error when errno does not contain a meaningful value. */ - -DOESNT_RETURN -signal_file_error (CONST char *string, Lisp_Object data) -{ - signal_error (Qfile_error, - list2 (build_translated_string (string), data)); -} - -void -maybe_signal_file_error (CONST char *string, Lisp_Object data, - Lisp_Object class, Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - maybe_signal_error (Qfile_error, - list2 (build_translated_string (string), data), - class, errb); -} - -DOESNT_RETURN -signal_double_file_error (CONST char *string1, CONST char *string2, - Lisp_Object data) -{ - signal_error (Qfile_error, - list3 (build_translated_string (string1), - build_translated_string (string2), - data)); -} - -void -maybe_signal_double_file_error (CONST char *string1, CONST char *string2, - Lisp_Object data, Lisp_Object class, - Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - maybe_signal_error (Qfile_error, - list3 (build_translated_string (string1), - build_translated_string (string2), - data), - class, errb); -} - -DOESNT_RETURN -signal_double_file_error_2 (CONST char *string1, CONST char *string2, - Lisp_Object data1, Lisp_Object data2) -{ - signal_error (Qfile_error, - list4 (build_translated_string (string1), - build_translated_string (string2), - data1, data2)); -} - -void -maybe_signal_double_file_error_2 (CONST char *string1, CONST char *string2, - Lisp_Object data1, Lisp_Object data2, - Lisp_Object class, Error_behavior errb) -{ - /* Optimization: */ - if (ERRB_EQ (errb, ERROR_ME_NOT)) - return; - maybe_signal_error (Qfile_error, - list4 (build_translated_string (string1), - build_translated_string (string2), - data1, data2), - class, errb); -} - - -/* Just like strerror(3), except return a lisp string instead of char *. - The string needs to be converted since it may be localized. - Perhaps this should use strerror-coding-system instead? */ -Lisp_Object -lisp_strerror (int errnum) -{ - return build_ext_string (strerror (errnum), FORMAT_NATIVE); -} - -static Lisp_Object -close_file_unwind (Lisp_Object fd) -{ - if (CONSP (fd)) - { - if (INTP (XCAR (fd))) - close (XINT (XCAR (fd))); - - free_cons (XCONS (fd)); - } - else - close (XINT (fd)); - - return Qnil; -} - -static Lisp_Object -delete_stream_unwind (Lisp_Object stream) -{ - Lstream_delete (XLSTREAM (stream)); - return Qnil; -} - -/* Restore point, having saved it as a marker. */ - -static Lisp_Object -restore_point_unwind (Lisp_Object point_marker) -{ - BUF_SET_PT (current_buffer, marker_position (point_marker)); - return Fset_marker (point_marker, Qnil, Qnil); -} - -/* Versions of read() and write() that allow quitting out of the actual - I/O. We don't use immediate_quit (i.e. direct longjmp() out of the - signal handler) because that's way too losing. - - (#### Actually, longjmp()ing out of the signal handler may not be - as losing as I thought. See sys_do_signal() in sysdep.c.) - - Solaris include files declare the return value as ssize_t. - Is that standard? */ -int -read_allowing_quit (int fildes, void *buf, size_t size) -{ - QUIT; - return sys_read_1 (fildes, buf, size, 1); -} - -int -write_allowing_quit (int fildes, CONST void *buf, size_t size) -{ - QUIT; - return sys_write_1 (fildes, buf, size, 1); -} - - -Lisp_Object Qexpand_file_name; -Lisp_Object Qfile_truename; -Lisp_Object Qsubstitute_in_file_name; -Lisp_Object Qdirectory_file_name; -Lisp_Object Qfile_name_directory; -Lisp_Object Qfile_name_nondirectory; -Lisp_Object Qunhandled_file_name_directory; -Lisp_Object Qfile_name_as_directory; -Lisp_Object Qcopy_file; -Lisp_Object Qmake_directory_internal; -Lisp_Object Qdelete_directory; -Lisp_Object Qdelete_file; -Lisp_Object Qrename_file; -Lisp_Object Qadd_name_to_file; -Lisp_Object Qmake_symbolic_link; -Lisp_Object Qfile_exists_p; -Lisp_Object Qfile_executable_p; -Lisp_Object Qfile_readable_p; -Lisp_Object Qfile_symlink_p; -Lisp_Object Qfile_writable_p; -Lisp_Object Qfile_directory_p; -Lisp_Object Qfile_regular_p; -Lisp_Object Qfile_accessible_directory_p; -Lisp_Object Qfile_modes; -Lisp_Object Qset_file_modes; -Lisp_Object Qfile_newer_than_file_p; -Lisp_Object Qinsert_file_contents; -Lisp_Object Qwrite_region; -Lisp_Object Qverify_visited_file_modtime; -Lisp_Object Qset_visited_file_modtime; - -/* If FILENAME is handled specially on account of its syntax, - return its handler function. Otherwise, return nil. */ - -DEFUN ("find-file-name-handler", Ffind_file_name_handler, 1, 2, 0, /* -Return FILENAME's handler function for OPERATION, if it has one. -Otherwise, return nil. -A file name is handled if one of the regular expressions in -`file-name-handler-alist' matches it. - -If OPERATION equals `inhibit-file-name-operation', then we ignore -any handlers that are members of `inhibit-file-name-handlers', -but we still do run any other handlers. This lets handlers -use the standard functions without calling themselves recursively. -*/ - (filename, operation)) -{ - /* This function does not GC */ - /* This function can be called during GC */ - /* This function must not munge the match data. */ - Lisp_Object chain, inhibited_handlers; - - CHECK_STRING (filename); - - if (EQ (operation, Vinhibit_file_name_operation)) - inhibited_handlers = Vinhibit_file_name_handlers; - else - inhibited_handlers = Qnil; - - EXTERNAL_LIST_LOOP (chain, Vfile_name_handler_alist) - { - Lisp_Object elt = XCAR (chain); - if (CONSP (elt)) - { - Lisp_Object string = XCAR (elt); - if (STRINGP (string) - && (fast_lisp_string_match (string, filename) >= 0)) - { - Lisp_Object handler = XCDR (elt); - if (NILP (Fmemq (handler, inhibited_handlers))) - return handler; - } - } - QUIT; - } - return Qnil; -} - -static Lisp_Object -call2_check_string (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) -{ - /* This function can call lisp */ - Lisp_Object result = call2 (fn, arg0, arg1); - CHECK_STRING (result); - return result; -} - -static Lisp_Object -call2_check_string_or_nil (Lisp_Object fn, Lisp_Object arg0, Lisp_Object arg1) -{ - /* This function can call lisp */ - Lisp_Object result = call2 (fn, arg0, arg1); - if (!NILP (result)) - CHECK_STRING (result); - return result; -} - -static Lisp_Object -call3_check_string (Lisp_Object fn, Lisp_Object arg0, - Lisp_Object arg1, Lisp_Object arg2) -{ - /* This function can call lisp */ - Lisp_Object result = call3 (fn, arg0, arg1, arg2); - CHECK_STRING (result); - return result; -} - - -DEFUN ("file-name-directory", Ffile_name_directory, 1, 1, 0, /* -Return the directory component in file name NAME. -Return nil if NAME does not include a directory. -Otherwise return a directory spec. -Given a Unix syntax file name, returns a string ending in slash. -*/ - (file)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Bufbyte *beg; - Bufbyte *p; - Lisp_Object handler; - - CHECK_STRING (file); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (file, Qfile_name_directory); - if (!NILP (handler)) - return call2_check_string_or_nil (handler, Qfile_name_directory, file); - -#ifdef FILE_SYSTEM_CASE - file = FILE_SYSTEM_CASE (file); -#endif - beg = XSTRING_DATA (file); - p = beg + XSTRING_LENGTH (file); - - while (p != beg && !IS_ANY_SEP (p[-1]) -#ifdef WINDOWSNT - /* only recognize drive specifier at beginning */ - && !(p[-1] == ':' && p == beg + 2) -#endif - ) p--; - - if (p == beg) - return Qnil; -#ifdef WINDOWSNT - /* Expansion of "c:" to drive and default directory. */ - /* (NT does the right thing.) */ - if (p == beg + 2 && beg[1] == ':') - { - /* MAXPATHLEN+1 is guaranteed to be enough space for getdefdir. */ - Bufbyte *res = alloca (MAXPATHLEN + 1); - if (getdefdir (toupper (*beg) - 'A' + 1, res)) - { - char *c=((char *) res) + strlen ((char *) res); - if (!IS_DIRECTORY_SEP (*c)) - { - *c++ = DIRECTORY_SEP; - *c = '\0'; - } - beg = res; - p = beg + strlen ((char *) beg); - } - } -#endif /* WINDOWSNT */ - return make_string (beg, p - beg); -} - -DEFUN ("file-name-nondirectory", Ffile_name_nondirectory, 1, 1, 0, /* -Return file name NAME sans its directory. -For example, in a Unix-syntax file name, -this is everything after the last slash, -or the entire name if it contains no slash. -*/ - (file)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Bufbyte *beg, *p, *end; - Lisp_Object handler; - - CHECK_STRING (file); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (file, Qfile_name_nondirectory); - if (!NILP (handler)) - return call2_check_string (handler, Qfile_name_nondirectory, file); - - beg = XSTRING_DATA (file); - end = p = beg + XSTRING_LENGTH (file); - - while (p != beg && !IS_ANY_SEP (p[-1]) -#ifdef WINDOWSNT - /* only recognize drive specifier at beginning */ - && !(p[-1] == ':' && p == beg + 2) -#endif - ) p--; - - return make_string (p, end - p); -} - -DEFUN ("unhandled-file-name-directory", Funhandled_file_name_directory, 1, 1, 0, /* -Return a directly usable directory name somehow associated with FILENAME. -A `directly usable' directory name is one that may be used without the -intervention of any file handler. -If FILENAME is a directly usable file itself, return -\(file-name-directory FILENAME). -The `call-process' and `start-process' functions use this function to -get a current directory to run processes in. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object handler; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qunhandled_file_name_directory); - if (!NILP (handler)) - return call2 (handler, Qunhandled_file_name_directory, - filename); - - return Ffile_name_directory (filename); -} - - -static char * -file_name_as_directory (char *out, char *in) -{ - int size = strlen (in); - - if (size == 0) - { - out[0] = '.'; - out[1] = DIRECTORY_SEP; - out[2] = '\0'; - } - else - { - strcpy (out, in); - /* Append a slash if necessary */ - if (!IS_ANY_SEP (out[size-1])) - { - out[size] = DIRECTORY_SEP; - out[size + 1] = '\0'; - } - } - return out; -} - -DEFUN ("file-name-as-directory", Ffile_name_as_directory, 1, 1, 0, /* -Return a string representing file FILENAME interpreted as a directory. -This operation exists because a directory is also a file, but its name as -a directory is different from its name as a file. -The result can be used as the value of `default-directory' -or passed as second argument to `expand-file-name'. -For a Unix-syntax file name, just appends a slash, -except for (file-name-as-directory \"\") => \"./\". -*/ - (file)) -{ - /* This function can GC. GC checked 1997.04.06. */ - char *buf; - Lisp_Object handler; - - CHECK_STRING (file); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (file, Qfile_name_as_directory); - if (!NILP (handler)) - return call2_check_string (handler, Qfile_name_as_directory, file); - - buf = (char *) alloca (XSTRING_LENGTH (file) + 10); - return build_string (file_name_as_directory - (buf, (char *) XSTRING_DATA (file))); -} - -/* - * Convert from directory name to filename. - * On UNIX, it's simple: just make sure there isn't a terminating / - * - * Value is nonzero if the string output is different from the input. - */ - -static int -directory_file_name (CONST char *src, char *dst) -{ - long slen; - - slen = strlen (src); - /* Process as Unix format: just remove any final slash. - But leave "/" unchanged; do not change it to "". */ - strcpy (dst, src); -#ifdef APOLLO - /* Handle // as root for apollo's. */ - if ((slen > 2 && dst[slen - 1] == '/') - || (slen > 1 && dst[0] != '/' && dst[slen - 1] == '/')) - dst[slen - 1] = 0; -#else - if (slen > 1 - && IS_DIRECTORY_SEP (dst[slen - 1]) -#ifdef WINDOWSNT - && !IS_ANY_SEP (dst[slen - 2]) -#endif /* WINDOWSNT */ - ) - dst[slen - 1] = 0; -#endif /* APOLLO */ - return 1; -} - -DEFUN ("directory-file-name", Fdirectory_file_name, 1, 1, 0, /* -Return the file name of the directory named DIR. -This is the name of the file that holds the data for the directory DIR. -This operation exists because a directory is also a file, but its name as -a directory is different from its name as a file. -In Unix-syntax, this function just removes the final slash. -*/ - (directory)) -{ - /* This function can GC. GC checked 1997.04.06. */ - char *buf; - Lisp_Object handler; - - CHECK_STRING (directory); - -#if 0 /* #### WTF? */ - if (NILP (directory)) - return Qnil; -#endif - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (directory, Qdirectory_file_name); - if (!NILP (handler)) - return call2_check_string (handler, Qdirectory_file_name, directory); - buf = (char *) alloca (XSTRING_LENGTH (directory) + 20); - directory_file_name ((char *) XSTRING_DATA (directory), buf); - return build_string (buf); -} - -/* Fmake_temp_name used to be a simple wrapper around mktemp(), but it - proved too broken for our purposes (it supported only 26 or 62 - unique names under some implementations). For example, this - arbitrary limit broke generation of Gnus Incoming* files. - - This implementation is better than what one usually finds in libc. - --hniksic */ - -DEFUN ("make-temp-name", Fmake_temp_name, 1, 1, 0, /* -Generate temporary file name starting with PREFIX. -The Emacs process number forms part of the result, so there is no -danger of generating a name being used by another process. - -In addition, this function makes an attempt to choose a name that -does not specify an existing file. To make this work, PREFIX should -be an absolute file name. -*/ - (prefix)) -{ - static char tbl[64] = { - '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','-','_' }; - static unsigned count, count_initialized_p; - - Lisp_Object val; - Bytecount len; - Bufbyte *p, *data; - unsigned pid; - - CHECK_STRING (prefix); - - /* I was tempted to apply Fexpand_file_name on PREFIX here, but it's - a bad idea because: - - 1) It might change the prefix, so the resulting string might not - begin with PREFIX. This violates the principle of least - surprise. - - 2) It breaks under many unforeseeable circumstances, such as with - the code that uses (make-temp-name "") instead of - (make-temp-name "./"). - - 3) It might yield unexpected (to stat(2)) results in the presence - of EFS and file name handlers. */ - - len = XSTRING_LENGTH (prefix); - val = make_uninit_string (len + 6); - data = XSTRING_DATA (val); - memcpy (data, XSTRING_DATA (prefix), len); - p = data + len; - - /* VAL is created by adding 6 characters to PREFIX. The first three - are the PID of this process, in base 64, and the second three are - incremented if the file already exists. This ensures 262144 - unique file names per PID per PREFIX. */ - - pid = (unsigned)getpid (); - *p++ = tbl[pid & 63], pid >>= 6; - *p++ = tbl[pid & 63], pid >>= 6; - *p++ = tbl[pid & 63], pid >>= 6; - - /* Here we try to minimize useless stat'ing when this function is - invoked many times successively with the same PREFIX. We achieve - this by initializing count to a random value, and incrementing it - afterwards. */ - if (!count_initialized_p) - { - count = (unsigned)time (NULL); - /* Dumping temacs with a non-zero count_initialized_p wouldn't - make much sense. */ - if (NILP (Frunning_temacs_p ())) - count_initialized_p = 1; - } - - while (1) - { - struct stat ignored; - unsigned num = count; - - p[0] = tbl[num & 63], num >>= 6; - p[1] = tbl[num & 63], num >>= 6; - p[2] = tbl[num & 63], num >>= 6; - - /* Poor man's congruential RN generator. Replace with ++count - for debugging. */ - count += 25229; - count %= 225307; - - QUIT; - - if (stat ((CONST char *) data, &ignored) < 0) - { - /* We want to return only if errno is ENOENT. */ - if (errno == ENOENT) - return val; - - /* The error here is dubious, but there is little else we - can do. The alternatives are to return nil, which is - as bad as (and in many cases worse than) throwing the - error, or to ignore the error, which will likely result - in inflooping. */ - report_file_error ("Cannot create temporary name for prefix", - list1 (prefix)); - return Qnil; /* not reached */ - } - } -} - - -DEFUN ("expand-file-name", Fexpand_file_name, 1, 2, 0, /* -Convert filename NAME to absolute, and canonicalize it. -Second arg DEFAULT-DIRECTORY is directory to start with if NAME is relative - (does not start with slash); if DEFAULT-DIRECTORY is nil or missing, -the current buffer's value of default-directory is used. -File name components that are `.' are removed, and -so are file name components followed by `..', along with the `..' itself; -note that these simplifications are done without checking the resulting -file names in the file system. -An initial `~/' expands to your home directory. -An initial `~USER/' expands to USER's home directory. -See also the function `substitute-in-file-name'. -*/ - (name, default_directory)) -{ - /* This function can GC */ - Bufbyte *nm; - - Bufbyte *newdir, *p, *o; - int tlen; - Bufbyte *target; -#ifdef WINDOWSNT - int drive = 0; - int collapse_newdir = 1; -#else - struct passwd *pw; -#endif /* WINDOWSNT */ - int length; - Lisp_Object handler; -#ifdef __CYGWIN32__ - char *user; -#endif - - CHECK_STRING (name); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (name, Qexpand_file_name); - if (!NILP (handler)) - return call3_check_string (handler, Qexpand_file_name, name, - default_directory); - - /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ - if (NILP (default_directory)) - default_directory = current_buffer->directory; - if (! STRINGP (default_directory)) - default_directory = build_string ("/"); - - if (!NILP (default_directory)) - { - handler = Ffind_file_name_handler (default_directory, Qexpand_file_name); - if (!NILP (handler)) - return call3 (handler, Qexpand_file_name, name, default_directory); - } - - o = XSTRING_DATA (default_directory); - - /* Make sure DEFAULT_DIRECTORY is properly expanded. - It would be better to do this down below where we actually use - default_directory. Unfortunately, calling Fexpand_file_name recursively - could invoke GC, and the strings might be relocated. This would - be annoying because we have pointers into strings lying around - that would need adjusting, and people would add new pointers to - the code and forget to adjust them, resulting in intermittent bugs. - Putting this call here avoids all that crud. - - The EQ test avoids infinite recursion. */ - if (! NILP (default_directory) && !EQ (default_directory, name) - /* Save time in some common cases - as long as default_directory - is not relative, it can be canonicalized with name below (if it - is needed at all) without requiring it to be expanded now. */ -#ifdef WINDOWSNT - /* Detect MSDOS file names with drive specifiers. */ - && ! (IS_DRIVE (o[0]) && (IS_DEVICE_SEP (o[1]) && IS_DIRECTORY_SEP (o[2]))) - /* Detect Windows file names in UNC format. */ - && ! (IS_DIRECTORY_SEP (o[0]) && IS_DIRECTORY_SEP (o[1])) - -#else /* not WINDOWSNT */ - - /* Detect Unix absolute file names (/... alone is not absolute on - DOS or Windows). */ - && ! (IS_DIRECTORY_SEP (o[0])) -#endif /* not WINDOWSNT */ - ) - { - struct gcpro gcpro1; - - GCPRO1 (name); - default_directory = Fexpand_file_name (default_directory, Qnil); - UNGCPRO; - } - -#ifdef FILE_SYSTEM_CASE - name = FILE_SYSTEM_CASE (name); -#endif - - /* #### dmoore - this is ugly, clean this up. Looks like nm pointing - into name should be safe during all of this, though. */ - nm = XSTRING_DATA (name); - -#ifdef WINDOWSNT - /* We will force directory separators to be either all \ or /, so make - a local copy to modify, even if there ends up being no change. */ - nm = strcpy (alloca (strlen (nm) + 1), nm); - - /* Find and remove drive specifier if present; this makes nm absolute - even if the rest of the name appears to be relative. */ - { - Bufbyte *colon = strrchr (nm, ':'); - - if (colon) - /* Only recognize colon as part of drive specifier if there is a - single alphabetic character preceding the colon (and if the - character before the drive letter, if present, is a directory - separator); this is to support the remote system syntax used by - ange-ftp, and the "po:username" syntax for POP mailboxes. */ - look_again: - if (nm == colon) - nm++; - else if (IS_DRIVE (colon[-1]) - && (colon == nm + 1 || IS_DIRECTORY_SEP (colon[-2]))) - { - drive = colon[-1]; - nm = colon + 1; - } - else - { - while (--colon >= nm) - if (colon[0] == ':') - goto look_again; - } - } - - /* If we see "c://somedir", we want to strip the first slash after the - colon when stripping the drive letter. Otherwise, this expands to - "//somedir". */ - if (drive && IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) - nm++; -#endif /* WINDOWSNT */ - - /* If nm is absolute, look for /./ or /../ sequences; if none are - found, we can probably return right away. We will avoid allocating - a new string if name is already fully expanded. */ - if ( - IS_DIRECTORY_SEP (nm[0]) -#ifdef WINDOWSNT - && (drive || IS_DIRECTORY_SEP (nm[1])) -#endif - ) - { - /* If it turns out that the filename we want to return is just a - suffix of FILENAME, we don't need to go through and edit - things; we just need to construct a new string using data - starting at the middle of FILENAME. If we set lose to a - non-zero value, that means we've discovered that we can't do - that cool trick. */ - int lose = 0; - - p = nm; - while (*p) - { - /* Since we know the name is absolute, we can assume that each - element starts with a "/". */ - - /* "." and ".." are hairy. */ - if (IS_DIRECTORY_SEP (p[0]) - && p[1] == '.' - && (IS_DIRECTORY_SEP (p[2]) - || p[2] == 0 - || (p[2] == '.' && (IS_DIRECTORY_SEP (p[3]) - || p[3] == 0)))) - lose = 1; - p++; - } - if (!lose) - { -#ifdef WINDOWSNT - /* Make sure directories are all separated with / or \ as - desired, but avoid allocation of a new string when not - required. */ - CORRECT_DIR_SEPS (nm); - if (IS_DIRECTORY_SEP (nm[1])) - { - if (strcmp (nm, XSTRING_DATA (name)) != 0) - name = build_string (nm); - } - /* drive must be set, so this is okay */ - else if (strcmp (nm - 2, XSTRING_DATA (name)) != 0) - { - name = make_string (nm - 2, p - nm + 2); - XSTRING_DATA (name)[0] = DRIVE_LETTER (drive); - XSTRING_DATA (name)[1] = ':'; - } - return name; -#else /* not WINDOWSNT */ - if (nm == XSTRING_DATA (name)) - return name; - return build_string ((char *) nm); -#endif /* not WINDOWSNT */ - } - } - - /* At this point, nm might or might not be an absolute file name. We - need to expand ~ or ~user if present, otherwise prefix nm with - default_directory if nm is not absolute, and finally collapse /./ - and /foo/../ sequences. - - We set newdir to be the appropriate prefix if one is needed: - - the relevant user directory if nm starts with ~ or ~user - - the specified drive's working dir (DOS/NT only) if nm does not - start with / - - the value of default_directory. - - Note that these prefixes are not guaranteed to be absolute (except - for the working dir of a drive). Therefore, to ensure we always - return an absolute name, if the final prefix is not absolute we - append it to the current working directory. */ - - newdir = 0; - - if (nm[0] == '~') /* prefix ~ */ - { - if (IS_DIRECTORY_SEP (nm[1]) - || nm[1] == 0) /* ~ by itself */ - { - char * newdir_external = get_home_directory (); - - if (newdir_external == NULL) - newdir = (Bufbyte *) ""; - else - GET_C_CHARPTR_INT_FILENAME_DATA_ALLOCA (newdir_external, newdir); - - nm++; -#ifdef WINDOWSNT - collapse_newdir = 0; -#endif - } - else /* ~user/filename */ - { - for (p = nm; *p && (!IS_DIRECTORY_SEP (*p)); p++) - DO_NOTHING; - o = (Bufbyte *) alloca (p - nm + 1); - memcpy (o, (char *) nm, p - nm); - o [p - nm] = 0; - - /* #### marcpa's syncing note: FSF uses getpwnam even on NT, - which does not work. The following works only if ~USER - names the user who runs this instance of XEmacs. While - NT is single-user (for the moment) you still can have - multiple user profiles users defined, each with its HOME. - Therefore, the following should be reworked to handle - this case. */ -#ifdef WINDOWSNT - /* Now if the file given is "~foo/file" and HOME="c:/", then - we want the file to be named "c:/file" ("~foo" becomes - "c:/"). The variable o has "~foo", so we can use the - length of that string to offset nm. August Hill, 31 Aug - 1998. */ - newdir = (Bufbyte *) get_home_directory(); - dostounix_filename (newdir); - nm += strlen(o) + 1; -#else /* not WINDOWSNT */ -#ifdef __CYGWIN32__ - if ((user = user_login_name (NULL)) != NULL) - { - /* Does the user login name match the ~name? */ - if (strcmp(user,((char *) o + 1)) == 0) - { - newdir = (Bufbyte *) get_home_directory(); - nm = p; - } - } - if (! newdir) - { -#endif /* __CYGWIN32__ */ - /* Jamie reports that getpwnam() can get wedged by SIGIO/SIGALARM - occurring in it. (It can call select()). */ - slow_down_interrupts (); - pw = (struct passwd *) getpwnam ((char *) o + 1); - speed_up_interrupts (); - if (pw) - { - newdir = (Bufbyte *) pw -> pw_dir; - nm = p; - } -#ifdef __CYGWIN32__ - } -#endif -#endif /* not WINDOWSNT */ - - /* If we don't find a user of that name, leave the name - unchanged; don't move nm forward to p. */ - } - } - -#ifdef WINDOWSNT - /* On DOS and Windows, nm is absolute if a drive name was specified; - use the drive's current directory as the prefix if needed. */ - if (!newdir && drive) - { - /* Get default directory if needed to make nm absolute. */ - if (!IS_DIRECTORY_SEP (nm[0])) - { - newdir = alloca (MAXPATHLEN + 1); - if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) - newdir = NULL; - } - if (!newdir) - { - /* Either nm starts with /, or drive isn't mounted. */ - newdir = alloca (4); - newdir[0] = DRIVE_LETTER (drive); - newdir[1] = ':'; - newdir[2] = '/'; - newdir[3] = 0; - } - } -#endif /* WINDOWSNT */ - - /* Finally, if no prefix has been specified and nm is not absolute, - then it must be expanded relative to default_directory. */ - - if (1 -#ifndef WINDOWSNT - /* /... alone is not absolute on DOS and Windows. */ - && !IS_DIRECTORY_SEP (nm[0]) -#else - && !(IS_DIRECTORY_SEP (nm[0]) && IS_DIRECTORY_SEP (nm[1])) -#endif - && !newdir) - { - newdir = XSTRING_DATA (default_directory); - } - -#ifdef WINDOWSNT - if (newdir) - { - /* First ensure newdir is an absolute name. */ - if ( - /* Detect MSDOS file names with drive specifiers. */ - ! (IS_DRIVE (newdir[0]) - && IS_DEVICE_SEP (newdir[1]) && IS_DIRECTORY_SEP (newdir[2])) - /* Detect Windows file names in UNC format. */ - && ! (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) - /* Detect drive spec by itself */ - && ! (IS_DEVICE_SEP (newdir[1]) && newdir[2] == 0) - ) - { - /* Effectively, let newdir be (expand-file-name newdir cwd). - Because of the admonition against calling expand-file-name - when we have pointers into lisp strings, we accomplish this - indirectly by prepending newdir to nm if necessary, and using - cwd (or the wd of newdir's drive) as the new newdir. */ - - if (IS_DRIVE (newdir[0]) && newdir[1] == ':') - { - drive = newdir[0]; - newdir += 2; - } - if (!IS_DIRECTORY_SEP (nm[0])) - { - char * tmp = alloca (strlen (newdir) + strlen (nm) + 2); - file_name_as_directory (tmp, newdir); - strcat (tmp, nm); - nm = tmp; - } - newdir = alloca (MAXPATHLEN + 1); - if (drive) - { - if (!getdefdir (toupper (drive) - 'A' + 1, newdir)) - newdir = "/"; - } - else - getwd (newdir); - } - - /* Strip off drive name from prefix, if present. */ - if (IS_DRIVE (newdir[0]) && newdir[1] == ':') - { - drive = newdir[0]; - newdir += 2; - } - - /* Keep only a prefix from newdir if nm starts with slash - (/ /server/share for UNC, nothing otherwise). */ - if (IS_DIRECTORY_SEP (nm[0]) && collapse_newdir) - { - if (IS_DIRECTORY_SEP (newdir[0]) && IS_DIRECTORY_SEP (newdir[1])) - { - newdir = strcpy (alloca (strlen (newdir) + 1), newdir); - p = newdir + 2; - while (*p && !IS_DIRECTORY_SEP (*p)) p++; - p++; - while (*p && !IS_DIRECTORY_SEP (*p)) p++; - *p = 0; - } - else - newdir = ""; - } - } -#endif /* WINDOWSNT */ - - if (newdir) - { - /* Get rid of any slash at the end of newdir, unless newdir is - just // (an incomplete UNC name). */ - length = strlen ((char *) newdir); - if (length > 1 && IS_DIRECTORY_SEP (newdir[length - 1]) -#ifdef WINDOWSNT - && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) -#endif - ) - { - Bufbyte *temp = (Bufbyte *) alloca (length); - memcpy (temp, newdir, length - 1); - temp[length - 1] = 0; - newdir = temp; - } - tlen = length + 1; - } - else - tlen = 0; - - /* Now concatenate the directory and name to new space in the stack frame */ - tlen += strlen ((char *) nm) + 1; -#ifdef WINDOWSNT - /* Add reserved space for drive name. (The Microsoft x86 compiler - produces incorrect code if the following two lines are combined.) */ - target = (Bufbyte *) alloca (tlen + 2); - target += 2; -#else /* not WINDOWSNT */ - target = (Bufbyte *) alloca (tlen); -#endif /* not WINDOWSNT */ - *target = 0; - - if (newdir) - { - if (nm[0] == 0 || IS_DIRECTORY_SEP (nm[0])) - strcpy ((char *) target, (char *) newdir); - else - file_name_as_directory ((char *) target, (char *) newdir); - } - - strcat ((char *) target, (char *) nm); - - /* ASSERT (IS_DIRECTORY_SEP (target[0])) if not VMS */ - - /* Now canonicalize by removing /. and /foo/.. if they appear. */ - - p = target; - o = target; - - while (*p) - { - if (!IS_DIRECTORY_SEP (*p)) - { - *o++ = *p++; - } - else if (IS_DIRECTORY_SEP (p[0]) - && p[1] == '.' - && (IS_DIRECTORY_SEP (p[2]) - || p[2] == 0)) - { - /* If "/." is the entire filename, keep the "/". Otherwise, - just delete the whole "/.". */ - if (o == target && p[2] == '\0') - *o++ = *p; - p += 2; - } - else if (IS_DIRECTORY_SEP (p[0]) && p[1] == '.' && p[2] == '.' - /* `/../' is the "superroot" on certain file systems. */ - && o != target - && (IS_DIRECTORY_SEP (p[3]) || p[3] == 0)) - { - while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) - ; - /* Keep initial / only if this is the whole name. */ - if (o == target && IS_ANY_SEP (*o) && p[3] == 0) - ++o; - p += 3; - } -#ifdef WINDOWSNT - /* if drive is set, we're not dealing with an UNC, so - multiple dir-seps are redundant (and reportedly cause trouble - under win95) */ - else if (drive && IS_DIRECTORY_SEP (p[0]) && IS_DIRECTORY_SEP (p[1])) - ++p; -#endif - else - { - *o++ = *p++; - } - } - -#ifdef WINDOWSNT - /* At last, set drive name, except for network file name. */ - if (drive) - { - target -= 2; - target[0] = DRIVE_LETTER (drive); - target[1] = ':'; - } - else - { - assert (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])); - } - CORRECT_DIR_SEPS (target); -#endif /* WINDOWSNT */ - - return make_string (target, o - target); -} - -#if 0 /* FSFmacs */ -/* another older version of expand-file-name; */ -#endif - -DEFUN ("file-truename", Ffile_truename, 1, 2, 0, /* -Return the canonical name of the given FILE. -Second arg DEFAULT is directory to start with if FILE is relative - (does not start with slash); if DEFAULT is nil or missing, - the current buffer's value of default-directory is used. -No component of the resulting pathname will be a symbolic link, as - in the realpath() function. -*/ - (filename, default_)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object expanded_name; - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (filename); - - expanded_name = Fexpand_file_name (filename, default_); - - if (!STRINGP (expanded_name)) - return Qnil; - - GCPRO1 (expanded_name); - handler = Ffind_file_name_handler (expanded_name, Qfile_truename); - UNGCPRO; - - if (!NILP (handler)) - return call2_check_string (handler, Qfile_truename, expanded_name); - - { - char resolved_path[MAXPATHLEN]; - char path[MAXPATHLEN]; - char *p = path; - int elen = XSTRING_LENGTH (expanded_name); - - if (elen >= countof (path)) - goto toolong; - - memcpy (path, XSTRING_DATA (expanded_name), elen + 1); - /* memset (resolved_path, 0, sizeof (resolved_path)); */ - - /* Try doing it all at once. */ - /* !!#### Does realpath() Mule-encapsulate? */ - if (!xrealpath (path, resolved_path)) - { - /* Didn't resolve it -- have to do it one component at a time. */ - /* "realpath" is a typically useless, stupid un*x piece of crap. - It claims to return a useful value in the "error" case, but since - there is no indication provided of how far along the pathname - the function went before erring, there is no way to use the - partial result returned. What a piece of junk. */ - for (;;) - { - p = (char *) memchr (p + 1, '/', elen - (p + 1 - path)); - if (p) - *p = 0; - - /* memset (resolved_path, 0, sizeof (resolved_path)); */ - if (xrealpath (path, resolved_path)) - { - if (p) - *p = '/'; - else - break; - - } - else if (errno == ENOENT || errno == EACCES) - { - /* Failed on this component. Just tack on the rest of - the string and we are done. */ - int rlen = strlen (resolved_path); - - /* "On failure, it returns NULL, sets errno to indicate - the error, and places in resolved_path the absolute pathname - of the path component which could not be resolved." */ - if (p) - { - int plen = elen - (p - path); - - if (rlen > 1 && resolved_path[rlen - 1] == '/') - rlen = rlen - 1; - - if (plen + rlen + 1 > countof (resolved_path)) - goto toolong; - - resolved_path[rlen] = '/'; - memcpy (resolved_path + rlen + 1, p + 1, plen + 1 - 1); - } - break; - } - else - goto lose; - } - } - - { - int rlen = strlen (resolved_path); - if (elen > 0 && XSTRING_BYTE (expanded_name, elen - 1) == '/' - && !(rlen > 0 && resolved_path[rlen - 1] == '/')) - { - if (rlen + 1 > countof (resolved_path)) - goto toolong; - resolved_path[rlen] = '/'; - resolved_path[rlen + 1] = 0; - rlen = rlen + 1; - } - return make_ext_string ((Bufbyte *) resolved_path, rlen, FORMAT_BINARY); - } - - toolong: - errno = ENAMETOOLONG; - goto lose; - lose: - report_file_error ("Finding truename", list1 (expanded_name)); - } - return Qnil; /* suppress compiler warning */ -} - - -DEFUN ("substitute-in-file-name", Fsubstitute_in_file_name, 1, 1, 0, /* -Substitute environment variables referred to in FILENAME. -`$FOO' where FOO is an environment variable name means to substitute -the value of that variable. The variable name should be terminated -with a character not a letter, digit or underscore; otherwise, enclose -the entire variable name in braces. -If `/~' appears, all of FILENAME through that `/' is discarded. - -*/ - (string)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Bufbyte *nm; - - Bufbyte *s, *p, *o, *x, *endp; - Bufbyte *target = 0; - int total = 0; - int substituted = 0; - Bufbyte *xnm; - Lisp_Object handler; - - CHECK_STRING (string); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (string, Qsubstitute_in_file_name); - if (!NILP (handler)) - return call2_check_string_or_nil (handler, Qsubstitute_in_file_name, - string); - - nm = XSTRING_DATA (string); - endp = nm + XSTRING_LENGTH (string); - - /* If /~ or // appears, discard everything through first slash. */ - - for (p = nm; p != endp; p++) - { - if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) || defined (__CYGWIN32__) - /* // at start of file name is meaningful in Apollo and - WindowsNT systems */ - || (IS_DIRECTORY_SEP (p[0]) && p - 1 != nm) -#else /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ - || IS_DIRECTORY_SEP (p[0]) -#endif /* not (APOLLO || WINDOWSNT || __CYGWIN32__) */ - ) - && p != nm - && (IS_DIRECTORY_SEP (p[-1]))) - { - nm = p; - substituted = 1; - } -#ifdef WINDOWSNT - /* see comment in expand-file-name about drive specifiers */ - else if (IS_DRIVE (p[0]) && p[1] == ':' - && p > nm && IS_DIRECTORY_SEP (p[-1])) - { - nm = p; - substituted = 1; - } -#endif /* WINDOWSNT */ - } - - /* See if any variables are substituted into the string - and find the total length of their values in `total' */ - - for (p = nm; p != endp;) - if (*p != '$') - p++; - else - { - p++; - if (p == endp) - goto badsubst; - else if (*p == '$') - { - /* "$$" means a single "$" */ - p++; - total -= 1; - substituted = 1; - continue; - } - else if (*p == '{') - { - o = ++p; - while (p != endp && *p != '}') p++; - if (*p != '}') goto missingclose; - s = p; - } - else - { - o = p; - while (p != endp && (isalnum (*p) || *p == '_')) p++; - s = p; - } - - /* Copy out the variable name */ - target = (Bufbyte *) alloca (s - o + 1); - strncpy ((char *) target, (char *) o, s - o); - target[s - o] = 0; -#ifdef WINDOWSNT - strupr (target); /* $home == $HOME etc. */ -#endif /* WINDOWSNT */ - - /* Get variable value */ - o = (Bufbyte *) egetenv ((char *) target); - if (!o) goto badvar; - total += strlen ((char *) o); - substituted = 1; - } - - if (!substituted) - return string; - - /* If substitution required, recopy the string and do it */ - /* Make space in stack frame for the new copy */ - xnm = (Bufbyte *) alloca (XSTRING_LENGTH (string) + total + 1); - x = xnm; - - /* Copy the rest of the name through, replacing $ constructs with values */ - for (p = nm; *p;) - if (*p != '$') - *x++ = *p++; - else - { - p++; - if (p == endp) - goto badsubst; - else if (*p == '$') - { - *x++ = *p++; - continue; - } - else if (*p == '{') - { - o = ++p; - while (p != endp && *p != '}') p++; - if (*p != '}') goto missingclose; - s = p++; - } - else - { - o = p; - while (p != endp && (isalnum (*p) || *p == '_')) p++; - s = p; - } - - /* Copy out the variable name */ - target = (Bufbyte *) alloca (s - o + 1); - strncpy ((char *) target, (char *) o, s - o); - target[s - o] = 0; -#ifdef WINDOWSNT - strupr (target); /* $home == $HOME etc. */ -#endif /* WINDOWSNT */ - - /* Get variable value */ - o = (Bufbyte *) egetenv ((char *) target); - if (!o) - goto badvar; - - strcpy ((char *) x, (char *) o); - x += strlen ((char *) o); - } - - *x = 0; - - /* If /~ or // appears, discard everything through first slash. */ - - for (p = xnm; p != x; p++) - if ((p[0] == '~' -#if defined (APOLLO) || defined (WINDOWSNT) - || (IS_DIRECTORY_SEP (p[0]) && p - 1 != xnm) -#else /* not (APOLLO || WINDOWSNT) */ - || IS_DIRECTORY_SEP (p[0]) -#endif /* APOLLO || WINDOWSNT */ - ) - /* don't do p[-1] if that would go off the beginning --jwz */ - && p != nm && p > xnm && IS_DIRECTORY_SEP (p[-1])) - xnm = p; -#ifdef WINDOWSNT - else if (IS_DRIVE (p[0]) && p[1] == ':' - && p > nm && IS_DIRECTORY_SEP (p[-1])) - xnm = p; -#endif - - return make_string (xnm, x - xnm); - - badsubst: - error ("Bad format environment-variable substitution"); - missingclose: - error ("Missing \"}\" in environment-variable substitution"); - badvar: - error ("Substituting nonexistent environment variable \"%s\"", - target); - - /* NOTREACHED */ - return Qnil; /* suppress compiler warning */ -} - -/* A slightly faster and more convenient way to get - (directory-file-name (expand-file-name FOO)). */ - -Lisp_Object -expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) -{ - /* This function can call lisp */ - Lisp_Object abspath; - struct gcpro gcpro1; - - abspath = Fexpand_file_name (filename, defdir); - GCPRO1 (abspath); - /* Remove final slash, if any (unless path is root). - stat behaves differently depending! */ - if (XSTRING_LENGTH (abspath) > 1 - && IS_DIRECTORY_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 1)) - && !IS_DEVICE_SEP (XSTRING_BYTE (abspath, XSTRING_LENGTH (abspath) - 2))) - /* We cannot take shortcuts; they might be wrong for magic file names. */ - abspath = Fdirectory_file_name (abspath); - UNGCPRO; - return abspath; -} - -/* Signal an error if the file ABSNAME already exists. - If INTERACTIVE is nonzero, ask the user whether to proceed, - and bypass the error if the user says to go ahead. - QUERYSTRING is a name for the action that is being considered - to alter the file. - *STATPTR is used to store the stat information if the file exists. - If the file does not exist, STATPTR->st_mode is set to 0. */ - -static void -barf_or_query_if_file_exists (Lisp_Object absname, CONST char *querystring, - int interactive, struct stat *statptr) -{ - /* This function can GC. GC checked 1997.04.06. */ - struct stat statbuf; - - /* stat is a good way to tell whether the file exists, - regardless of what access permissions it has. */ - if (stat ((char *) XSTRING_DATA (absname), &statbuf) >= 0) - { - Lisp_Object tem; - - if (interactive) - { - Lisp_Object prompt; - struct gcpro gcpro1; - - prompt = emacs_doprnt_string_c - ((CONST Bufbyte *) GETTEXT ("File %s already exists; %s anyway? "), - Qnil, -1, XSTRING_DATA (absname), - GETTEXT (querystring)); - - GCPRO1 (prompt); - tem = call1 (Qyes_or_no_p, prompt); - UNGCPRO; - } - else - tem = Qnil; - - if (NILP (tem)) - Fsignal (Qfile_already_exists, - list2 (build_translated_string ("File already exists"), - absname)); - if (statptr) - *statptr = statbuf; - } - else - { - if (statptr) - statptr->st_mode = 0; - } - return; -} - -DEFUN ("copy-file", Fcopy_file, 2, 4, - "fCopy file: \nFCopy %s to file: \np\nP", /* -Copy FILE to NEWNAME. Both args must be strings. -Signals a `file-already-exists' error if file NEWNAME already exists, -unless a third argument OK-IF-ALREADY-EXISTS is supplied and non-nil. -A number as third arg means request confirmation if NEWNAME already exists. -This is what happens in interactive use with M-x. -Fourth arg KEEP-TIME non-nil means give the new file the same -last-modified time as the old one. (This works on only some systems.) -A prefix arg makes KEEP-TIME non-nil. -*/ - (filename, newname, ok_if_already_exists, keep_time)) -{ - /* This function can GC. GC checked 1997.04.06. */ - int ifd, ofd, n; - char buf[16 * 1024]; - struct stat st, out_st; - Lisp_Object handler; - int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2; - /* Lisp_Object args[6]; */ - int input_file_statable_p; - - GCPRO2 (filename, newname); - CHECK_STRING (filename); - CHECK_STRING (newname); - filename = Fexpand_file_name (filename, Qnil); - newname = Fexpand_file_name (newname, Qnil); - - /* If the input file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qcopy_file); - /* Likewise for output file name. */ - if (NILP (handler)) - handler = Ffind_file_name_handler (newname, Qcopy_file); - if (!NILP (handler)) - { - UNGCPRO; - return call5 (handler, Qcopy_file, filename, newname, - ok_if_already_exists, keep_time); - } - - /* When second argument is a directory, copy the file into it. - (copy-file "foo" "bar/") == (copy-file "foo" "bar/foo") - */ - if (!NILP (Ffile_directory_p (newname))) - { - Lisp_Object args[3]; - struct gcpro ngcpro1; - int i = 1; - - args[0] = newname; - args[1] = Qnil; args[2] = Qnil; - NGCPRO1 (*args); - ngcpro1.nvars = 3; - if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/') - args[i++] = build_string ("/"); - args[i++] = Ffile_name_nondirectory (filename); - newname = Fconcat (i, args); - NUNGCPRO; - } - - if (NILP (ok_if_already_exists) - || INTP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "copy to it", - INTP (ok_if_already_exists), &out_st); - else if (stat ((CONST char *) XSTRING_DATA (newname), &out_st) < 0) - out_st.st_mode = 0; - - ifd = interruptible_open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0); - if (ifd < 0) - report_file_error ("Opening input file", list1 (filename)); - - record_unwind_protect (close_file_unwind, make_int (ifd)); - - /* We can only copy regular files and symbolic links. Other files are not - copyable by us. */ - input_file_statable_p = (fstat (ifd, &st) >= 0); - -#ifndef WINDOWSNT - if (out_st.st_mode != 0 - && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) - { - errno = 0; - report_file_error ("Input and output files are the same", - list2 (filename, newname)); - } -#endif - -#if defined (S_ISREG) && defined (S_ISLNK) - if (input_file_statable_p) - { - if (!(S_ISREG (st.st_mode)) - /* XEmacs: have to allow S_ISCHR in order to copy /dev/null */ -#ifdef S_ISCHR - && !(S_ISCHR (st.st_mode)) -#endif - && !(S_ISLNK (st.st_mode))) - { -#if defined (EISDIR) - /* Get a better looking error message. */ - errno = EISDIR; -#endif /* EISDIR */ - report_file_error ("Non-regular file", list1 (filename)); - } - } -#endif /* S_ISREG && S_ISLNK */ - - ofd = open( (char *) XSTRING_DATA (newname), - O_WRONLY | O_CREAT | O_TRUNC | OPEN_BINARY, CREAT_MODE); - if (ofd < 0) - report_file_error ("Opening output file", list1 (newname)); - - { - Lisp_Object ofd_locative = noseeum_cons (make_int (ofd), Qnil); - - record_unwind_protect (close_file_unwind, ofd_locative); - - while ((n = read_allowing_quit (ifd, buf, sizeof (buf))) > 0) - { - if (write_allowing_quit (ofd, buf, n) != n) - report_file_error ("I/O error", list1 (newname)); - } - - /* Closing the output clobbers the file times on some systems. */ - if (close (ofd) < 0) - report_file_error ("I/O error", list1 (newname)); - - if (input_file_statable_p) - { - if (!NILP (keep_time)) - { - EMACS_TIME atime, mtime; - EMACS_SET_SECS_USECS (atime, st.st_atime, 0); - EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); - if (set_file_times ((char *) XSTRING_DATA (newname), atime, - mtime)) - report_file_error ("I/O error", list1 (newname)); - } - chmod ((CONST char *) XSTRING_DATA (newname), - st.st_mode & 07777); - } - - /* We'll close it by hand */ - XCAR (ofd_locative) = Qnil; - - /* Close ifd */ - unbind_to (speccount, Qnil); - } - - UNGCPRO; - return Qnil; -} - -DEFUN ("make-directory-internal", Fmake_directory_internal, 1, 1, 0, /* -Create a directory. One argument, a file name string. -*/ - (dirname_)) -{ - /* This function can GC. GC checked 1997.04.06. */ - char dir [MAXPATHLEN]; - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (dirname_); - dirname_ = Fexpand_file_name (dirname_, Qnil); - - GCPRO1 (dirname_); - handler = Ffind_file_name_handler (dirname_, Qmake_directory_internal); - UNGCPRO; - if (!NILP (handler)) - return (call2 (handler, Qmake_directory_internal, dirname_)); - - if (XSTRING_LENGTH (dirname_) > (Bytecount) (sizeof (dir) - 1)) - { - return Fsignal (Qfile_error, - list3 (build_translated_string ("Creating directory"), - build_translated_string ("pathame too long"), - dirname_)); - } - strncpy (dir, (char *) XSTRING_DATA (dirname_), - XSTRING_LENGTH (dirname_) + 1); - - if (dir [XSTRING_LENGTH (dirname_) - 1] == '/') - dir [XSTRING_LENGTH (dirname_) - 1] = 0; - - if (mkdir (dir, 0777) != 0) - report_file_error ("Creating directory", list1 (dirname_)); - - return Qnil; -} - -DEFUN ("delete-directory", Fdelete_directory, 1, 1, "FDelete directory: ", /* -Delete a directory. One argument, a file name or directory name string. -*/ - (dirname_)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (dirname_); - - GCPRO1 (dirname_); - dirname_ = Fexpand_file_name (dirname_, Qnil); - dirname_ = Fdirectory_file_name (dirname_); - - handler = Ffind_file_name_handler (dirname_, Qdelete_directory); - UNGCPRO; - if (!NILP (handler)) - return (call2 (handler, Qdelete_directory, dirname_)); - - if (rmdir ((char *) XSTRING_DATA (dirname_)) != 0) - report_file_error ("Removing directory", list1 (dirname_)); - - return Qnil; -} - -DEFUN ("delete-file", Fdelete_file, 1, 1, "fDelete file: ", /* -Delete specified file. One argument, a file name string. -If file has multiple names, it continues to exist with the other names. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (filename); - filename = Fexpand_file_name (filename, Qnil); - - GCPRO1 (filename); - handler = Ffind_file_name_handler (filename, Qdelete_file); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qdelete_file, filename); - - if (0 > unlink ((char *) XSTRING_DATA (filename))) - report_file_error ("Removing old name", list1 (filename)); - return Qnil; -} - -static Lisp_Object -internal_delete_file_1 (Lisp_Object ignore, Lisp_Object ignore2) -{ - return Qt; -} - -/* Delete file FILENAME, returning 1 if successful and 0 if failed. */ - -int -internal_delete_file (Lisp_Object filename) -{ - /* This function can GC. GC checked 1997.04.06. */ - return NILP (condition_case_1 (Qt, Fdelete_file, filename, - internal_delete_file_1, Qnil)); -} - -DEFUN ("rename-file", Frename_file, 2, 3, - "fRename file: \nFRename %s to file: \np", /* -Rename FILE as NEWNAME. Both args strings. -If file has names other than FILE, it continues to have those names. -Signals a `file-already-exists' error if a file NEWNAME already exists -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if NEWNAME already exists. -This is what happens in interactive use with M-x. -*/ - (filename, newname, ok_if_already_exists)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object handler; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (filename, newname); - CHECK_STRING (filename); - CHECK_STRING (newname); - filename = Fexpand_file_name (filename, Qnil); - newname = Fexpand_file_name (newname, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qrename_file); - if (NILP (handler)) - handler = Ffind_file_name_handler (newname, Qrename_file); - if (!NILP (handler)) - { - UNGCPRO; - return call4 (handler, Qrename_file, - filename, newname, ok_if_already_exists); - } - - /* When second argument is a directory, rename the file into it. - (rename-file "foo" "bar/") == (rename-file "foo" "bar/foo") - */ - if (!NILP (Ffile_directory_p (newname))) - { - Lisp_Object args[3]; - struct gcpro ngcpro1; - int i = 1; - - args[0] = newname; - args[1] = Qnil; args[2] = Qnil; - NGCPRO1 (*args); - ngcpro1.nvars = 3; - if (XSTRING_BYTE (newname, XSTRING_LENGTH (newname) - 1) != '/') - args[i++] = build_string ("/"); - args[i++] = Ffile_name_nondirectory (filename); - newname = Fconcat (i, args); - NUNGCPRO; - } - - if (NILP (ok_if_already_exists) - || INTP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "rename to it", - INTP (ok_if_already_exists), 0); - -/* Syncing with FSF 19.34.6 note: FSF does not have conditional code for - WINDOWSNT here; I've removed it. --marcpa */ - - /* FSFmacs only calls rename() here under BSD 4.1, and calls - link() and unlink() otherwise, but that's bogus. Sometimes - rename() succeeds where link()/unlink() fail, and we have - configure check for rename() and emulate using link()/unlink() - if necessary. */ - if (0 > rename ((char *) XSTRING_DATA (filename), - (char *) XSTRING_DATA (newname))) - { - if (errno == EXDEV) - { - Fcopy_file (filename, newname, - /* We have already prompted if it was an integer, - so don't have copy-file prompt again. */ - ((NILP (ok_if_already_exists)) ? Qnil : Qt), - Qt); - Fdelete_file (filename); - } - else - { - report_file_error ("Renaming", list2 (filename, newname)); - } - } - UNGCPRO; - return Qnil; -} - -DEFUN ("add-name-to-file", Fadd_name_to_file, 2, 3, - "fAdd name to file: \nFName to add to %s: \np", /* -Give FILE additional name NEWNAME. Both args strings. -Signals a `file-already-exists' error if a file NEWNAME already exists -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if NEWNAME already exists. -This is what happens in interactive use with M-x. -*/ - (filename, newname, ok_if_already_exists)) -{ - /* This function can GC. GC checked 1997.04.06. */ - Lisp_Object handler; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (filename, newname); - CHECK_STRING (filename); - CHECK_STRING (newname); - filename = Fexpand_file_name (filename, Qnil); - newname = Fexpand_file_name (newname, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qadd_name_to_file); - if (!NILP (handler)) - RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, - newname, ok_if_already_exists)); - - /* If the new name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (newname, Qadd_name_to_file); - if (!NILP (handler)) - RETURN_UNGCPRO (call4 (handler, Qadd_name_to_file, filename, - newname, ok_if_already_exists)); - - if (NILP (ok_if_already_exists) - || INTP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, "make it a new name", - INTP (ok_if_already_exists), 0); -/* Syncing with FSF 19.34.6 note: FSF does not report a file error - on NT here. --marcpa */ -/* But FSF #defines link as sys_link which is supplied in nt.c. We can't do - that because sysfile.h defines sys_link depending on ENCAPSULATE_LINK. - Reverted to previous behavior pending a working fix. (jhar) */ -#if defined(WINDOWSNT) - /* Windows does not support this operation. */ - report_file_error ("Adding new name", Flist (2, &filename)); -#else /* not defined(WINDOWSNT) */ - - unlink ((char *) XSTRING_DATA (newname)); - if (0 > link ((char *) XSTRING_DATA (filename), - (char *) XSTRING_DATA (newname))) - { - report_file_error ("Adding new name", - list2 (filename, newname)); - } -#endif /* defined(WINDOWSNT) */ - - UNGCPRO; - return Qnil; -} - -#ifdef S_IFLNK -DEFUN ("make-symbolic-link", Fmake_symbolic_link, 2, 3, - "FMake symbolic link to file: \nFMake symbolic link to file %s: \np", /* -Make a symbolic link to FILENAME, named LINKNAME. Both args strings. -Signals a `file-already-exists' error if a file LINKNAME already exists -unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if LINKNAME already exists. -This happens for interactive use with M-x. -*/ - (filename, linkname, ok_if_already_exists)) -{ - /* This function can GC. GC checked 1997.06.04. */ - Lisp_Object handler; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (filename, linkname); - CHECK_STRING (filename); - CHECK_STRING (linkname); - /* If the link target has a ~, we must expand it to get - a truly valid file name. Otherwise, do not expand; - we want to permit links to relative file names. */ - if (XSTRING_BYTE (filename, 0) == '~') - filename = Fexpand_file_name (filename, Qnil); - linkname = Fexpand_file_name (linkname, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qmake_symbolic_link); - if (!NILP (handler)) - RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, linkname, - ok_if_already_exists)); - - /* If the new link name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); - if (!NILP (handler)) - RETURN_UNGCPRO (call4 (handler, Qmake_symbolic_link, filename, - linkname, ok_if_already_exists)); - - if (NILP (ok_if_already_exists) - || INTP (ok_if_already_exists)) - barf_or_query_if_file_exists (linkname, "make it a link", - INTP (ok_if_already_exists), 0); - - unlink ((char *) XSTRING_DATA (linkname)); - if (0 > symlink ((char *) XSTRING_DATA (filename), - (char *) XSTRING_DATA (linkname))) - { - report_file_error ("Making symbolic link", - list2 (filename, linkname)); - } - UNGCPRO; - return Qnil; -} -#endif /* S_IFLNK */ - -#ifdef HPUX_NET - -DEFUN ("sysnetunam", Fsysnetunam, 2, 2, 0, /* -Open a network connection to PATH using LOGIN as the login string. -*/ - (path, login)) -{ - int netresult; - - CHECK_STRING (path); - CHECK_STRING (login); - - /* netunam, being a strange-o system call only used once, is not - encapsulated. */ - { - char *path_ext; - char *login_ext; - - GET_C_STRING_FILENAME_DATA_ALLOCA (path, path_ext); - GET_C_STRING_EXT_DATA_ALLOCA (login, FORMAT_OS, login_ext); - - netresult = netunam (path_ext, login_ext); - } - - if (netresult == -1) - return Qnil; - else - return Qt; -} -#endif /* HPUX_NET */ - -DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, 1, 1, 0, /* -Return t if file FILENAME specifies an absolute path name. -On Unix, this is a name starting with a `/' or a `~'. -*/ - (filename)) -{ - /* This function does not GC */ - Bufbyte *ptr; - - CHECK_STRING (filename); - ptr = XSTRING_DATA (filename); - return (IS_DIRECTORY_SEP (*ptr) || *ptr == '~' -#ifdef WINDOWSNT - || (IS_DRIVE (*ptr) && ptr[1] == ':' && IS_DIRECTORY_SEP (ptr[2])) -#endif - ) ? Qt : Qnil; -} - -/* Return nonzero if file FILENAME exists and can be executed. */ - -static int -check_executable (char *filename) -{ -#ifdef WINDOWSNT - struct stat st; - if (stat (filename, &st) < 0) - return 0; - return ((st.st_mode & S_IEXEC) != 0); -#else /* not WINDOWSNT */ -#ifdef HAVE_EACCESS - return eaccess (filename, 1) >= 0; -#else - /* Access isn't quite right because it uses the real uid - and we really want to test with the effective uid. - But Unix doesn't give us a right way to do it. */ - return access (filename, 1) >= 0; -#endif /* HAVE_EACCESS */ -#endif /* not WINDOWSNT */ -} - -/* Return nonzero if file FILENAME exists and can be written. */ - -static int -check_writable (CONST char *filename) -{ -#ifdef HAVE_EACCESS - return (eaccess (filename, 2) >= 0); -#else - /* Access isn't quite right because it uses the real uid - and we really want to test with the effective uid. - But Unix doesn't give us a right way to do it. - Opening with O_WRONLY could work for an ordinary file, - but would lose for directories. */ - return (access (filename, 2) >= 0); -#endif -} - -DEFUN ("file-exists-p", Ffile_exists_p, 1, 1, 0, /* -Return t if file FILENAME exists. (This does not mean you can read it.) -See also `file-readable-p' and `file-attributes'. -*/ - (filename)) -{ - /* This function can call lisp */ - Lisp_Object abspath; - Lisp_Object handler; - struct stat statbuf; - struct gcpro gcpro1; - - CHECK_STRING (filename); - abspath = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_exists_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_exists_p, abspath); - - return stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0 ? Qt : Qnil; -} - -DEFUN ("file-executable-p", Ffile_executable_p, 1, 1, 0, /* -Return t if FILENAME can be executed by you. -For a directory, this means you can access files in that directory. -*/ - (filename)) - -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath; - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (filename); - abspath = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_executable_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_executable_p, abspath); - - return check_executable ((char *) XSTRING_DATA (abspath)) ? Qt : Qnil; -} - -DEFUN ("file-readable-p", Ffile_readable_p, 1, 1, 0, /* -Return t if file FILENAME exists and you can read it. -See also `file-exists-p' and `file-attributes'. -*/ - (filename)) -{ - /* This function can GC */ - Lisp_Object abspath = Qnil; - Lisp_Object handler; - struct gcpro gcpro1; - GCPRO1 (abspath); - - CHECK_STRING (filename); - abspath = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath, Qfile_readable_p); - if (!NILP (handler)) - RETURN_UNGCPRO (call2 (handler, Qfile_readable_p, abspath)); - -#if defined(WINDOWSNT) || defined(__CYGWIN32__) - /* Under MS-DOS and Windows, open does not work for directories. */ - UNGCPRO; - if (access (XSTRING_DATA (abspath), 0) == 0) - return Qt; - else - return Qnil; -#else /* not WINDOWSNT */ - { - int desc = interruptible_open ((char *) XSTRING_DATA (abspath), O_RDONLY | OPEN_BINARY, 0); - UNGCPRO; - if (desc < 0) - return Qnil; - close (desc); - return Qt; - } -#endif /* not WINDOWSNT */ -} - -/* Having this before file-symlink-p mysteriously caused it to be forgotten - on the RT/PC. */ -DEFUN ("file-writable-p", Ffile_writable_p, 1, 1, 0, /* -Return t if file FILENAME can be written or created by you. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath, dir; - Lisp_Object handler; - struct stat statbuf; - struct gcpro gcpro1; - - CHECK_STRING (filename); - abspath = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_writable_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_writable_p, abspath); - - if (stat ((char *) XSTRING_DATA (abspath), &statbuf) >= 0) - return (check_writable ((char *) XSTRING_DATA (abspath)) - ? Qt : Qnil); - - - GCPRO1 (abspath); - dir = Ffile_name_directory (abspath); - UNGCPRO; - return (check_writable (!NILP (dir) ? (char *) XSTRING_DATA (dir) - : "") - ? Qt : Qnil); -} - -DEFUN ("file-symlink-p", Ffile_symlink_p, 1, 1, 0, /* -Return non-nil if file FILENAME is the name of a symbolic link. -The value is the name of the file to which it is linked. -Otherwise returns nil. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ -#ifdef S_IFLNK - char *buf; - int bufsize; - int valsize; - Lisp_Object val; - Lisp_Object handler; - struct gcpro gcpro1; - - CHECK_STRING (filename); - filename = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (filename); - handler = Ffind_file_name_handler (filename, Qfile_symlink_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_symlink_p, filename); - - bufsize = 100; - while (1) - { - buf = xnew_array_and_zero (char, bufsize); - valsize = readlink ((char *) XSTRING_DATA (filename), - buf, bufsize); - if (valsize < bufsize) break; - /* Buffer was not long enough */ - xfree (buf); - bufsize *= 2; - } - if (valsize == -1) - { - xfree (buf); - return Qnil; - } - val = make_string ((Bufbyte *) buf, valsize); - xfree (buf); - return val; -#else /* not S_IFLNK */ - return Qnil; -#endif /* not S_IFLNK */ -} - -DEFUN ("file-directory-p", Ffile_directory_p, 1, 1, 0, /* -Return t if file FILENAME is the name of a directory as a file. -A directory name spec may be given instead; then the value is t -if the directory so specified exists and really is a directory. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath; - struct stat st; - Lisp_Object handler; - struct gcpro gcpro1; - - GCPRO1 (current_buffer->directory); - abspath = expand_and_dir_to_file (filename, - current_buffer->directory); - UNGCPRO; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_directory_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_directory_p, abspath); - - if (stat ((char *) XSTRING_DATA (abspath), &st) < 0) - return Qnil; - return (st.st_mode & S_IFMT) == S_IFDIR ? Qt : Qnil; -} - -DEFUN ("file-accessible-directory-p", Ffile_accessible_directory_p, 1, 1, 0, /* -Return t if file FILENAME is the name of a directory as a file, -and files in that directory can be opened by you. In order to use a -directory as a buffer's current directory, this predicate must return true. -A directory name spec may be given instead; then the value is t -if the directory so specified exists and really is a readable and -searchable directory. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object handler; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qfile_accessible_directory_p); - if (!NILP (handler)) - return call2 (handler, Qfile_accessible_directory_p, - filename); - -#if !defined(WINDOWSNT) - if (NILP (Ffile_directory_p (filename))) - return (Qnil); - else - return Ffile_executable_p (filename); -#else - { - int tem; - struct gcpro gcpro1; - /* It's an unlikely combination, but yes we really do need to gcpro: - Suppose that file-accessible-directory-p has no handler, but - file-directory-p does have a handler; this handler causes a GC which - relocates the string in `filename'; and finally file-directory-p - returns non-nil. Then we would end up passing a garbaged string - to file-executable-p. */ - GCPRO1 (filename); - tem = (NILP (Ffile_directory_p (filename)) - || NILP (Ffile_executable_p (filename))); - UNGCPRO; - return tem ? Qnil : Qt; - } -#endif /* !defined(WINDOWSNT) */ -} - -DEFUN ("file-regular-p", Ffile_regular_p, 1, 1, 0, /* -Return t if file FILENAME is the name of a regular file. -This is the sort of file that holds an ordinary stream of data bytes. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath; - struct stat st; - Lisp_Object handler; - struct gcpro gcpro1; - - GCPRO1 (current_buffer->directory); - abspath = expand_and_dir_to_file (filename, current_buffer->directory); - UNGCPRO; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_regular_p); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_regular_p, abspath); - - if (stat ((char *) XSTRING_DATA (abspath), &st) < 0) - return Qnil; - return (st.st_mode & S_IFMT) == S_IFREG ? Qt : Qnil; -} - -DEFUN ("file-modes", Ffile_modes, 1, 1, 0, /* -Return mode bits of FILE, as an integer. -*/ - (filename)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath; - struct stat st; - Lisp_Object handler; - struct gcpro gcpro1; - - GCPRO1 (current_buffer->directory); - abspath = expand_and_dir_to_file (filename, - current_buffer->directory); - UNGCPRO; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qfile_modes); - UNGCPRO; - if (!NILP (handler)) - return call2 (handler, Qfile_modes, abspath); - - if (stat ((char *) XSTRING_DATA (abspath), &st) < 0) - return Qnil; - /* Syncing with FSF 19.34.6 note: not in FSF, #if 0'ed out here. */ -#if 0 -#ifdef DOS_NT - if (check_executable (XSTRING_DATA (abspath))) - st.st_mode |= S_IEXEC; -#endif /* DOS_NT */ -#endif /* 0 */ - - return make_int (st.st_mode & 07777); -} - -DEFUN ("set-file-modes", Fset_file_modes, 2, 2, 0, /* -Set mode bits of FILE to MODE (an integer). -Only the 12 low bits of MODE are used. -*/ - (filename, mode)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath; - Lisp_Object handler; - struct gcpro gcpro1; - - GCPRO1 (current_buffer->directory); - abspath = Fexpand_file_name (filename, current_buffer->directory); - UNGCPRO; - - CHECK_INT (mode); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - GCPRO1 (abspath); - handler = Ffind_file_name_handler (abspath, Qset_file_modes); - UNGCPRO; - if (!NILP (handler)) - return call3 (handler, Qset_file_modes, abspath, mode); - - if (chmod ((char *) XSTRING_DATA (abspath), XINT (mode)) < 0) - report_file_error ("Doing chmod", list1 (abspath)); - - return Qnil; -} - -DEFUN ("set-default-file-modes", Fset_default_file_modes, 1, 1, 0, /* -Set the file permission bits for newly created files. -MASK should be an integer; if a permission's bit in MASK is 1, -subsequently created files will not have that permission enabled. -Only the low 9 bits are used. -This setting is inherited by subprocesses. -*/ - (mode)) -{ - CHECK_INT (mode); - - umask ((~ XINT (mode)) & 0777); - - return Qnil; -} - -DEFUN ("default-file-modes", Fdefault_file_modes, 0, 0, 0, /* -Return the default file protection for created files. -The umask value determines which permissions are enabled in newly -created files. If a permission's bit in the umask is 1, subsequently -created files will not have that permission enabled. -*/ - ()) -{ - int mode; - - mode = umask (0); - umask (mode); - - return make_int ((~ mode) & 0777); -} - -DEFUN ("unix-sync", Funix_sync, 0, 0, "", /* -Tell Unix to finish all pending disk updates. -*/ - ()) -{ -#ifndef WINDOWSNT - sync (); -#endif - return Qnil; -} - - -DEFUN ("file-newer-than-file-p", Ffile_newer_than_file_p, 2, 2, 0, /* -Return t if file FILE1 is newer than file FILE2. -If FILE1 does not exist, the answer is nil; -otherwise, if FILE2 does not exist, the answer is t. -*/ - (file1, file2)) -{ - /* This function can GC. GC checked 1997.04.10. */ - Lisp_Object abspath1, abspath2; - struct stat st; - int mtime1; - Lisp_Object handler; - struct gcpro gcpro1, gcpro2, gcpro3; - - CHECK_STRING (file1); - CHECK_STRING (file2); - - abspath1 = Qnil; - abspath2 = Qnil; - - GCPRO3 (abspath1, abspath2, current_buffer->directory); - abspath1 = expand_and_dir_to_file (file1, current_buffer->directory); - abspath2 = expand_and_dir_to_file (file2, current_buffer->directory); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (abspath1, Qfile_newer_than_file_p); - if (NILP (handler)) - handler = Ffind_file_name_handler (abspath2, Qfile_newer_than_file_p); - UNGCPRO; - if (!NILP (handler)) - return call3 (handler, Qfile_newer_than_file_p, abspath1, - abspath2); - - if (stat ((char *) XSTRING_DATA (abspath1), &st) < 0) - return Qnil; - - mtime1 = st.st_mtime; - - if (stat ((char *) XSTRING_DATA (abspath2), &st) < 0) - return Qt; - - return (mtime1 > st.st_mtime) ? Qt : Qnil; -} - - -/* Stack sizes > 2**16 is a good way to elicit compiler bugs */ -/* #define READ_BUF_SIZE (2 << 16) */ -#define READ_BUF_SIZE (1 << 15) - -DEFUN ("insert-file-contents-internal", Finsert_file_contents_internal, - 1, 7, 0, /* -Insert contents of file FILENAME after point; no coding-system frobbing. -This function is identical to `insert-file-contents' except for the -handling of the CODESYS and USED-CODESYS arguments under -XEmacs/Mule. (When Mule support is not present, both functions are -identical and ignore the CODESYS and USED-CODESYS arguments.) - -If support for Mule exists in this Emacs, the file is decoded according -to CODESYS; if omitted, no conversion happens. If USED-CODESYS is non-nil, -it should be a symbol, and the actual coding system that was used for the -decoding is stored into it. It will in general be different from CODESYS -if CODESYS specifies automatic encoding detection or end-of-line detection. - -Currently BEG and END refer to byte positions (as opposed to character -positions), even in Mule. (Fixing this is very difficult.) -*/ - (filename, visit, beg, end, replace, codesys, used_codesys)) -{ - /* This function can call lisp */ - /* #### dmoore - this function hasn't been checked for gc recently */ - struct stat st; - int fd; - int saverrno = 0; - Charcount inserted = 0; - int speccount; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - Lisp_Object handler = Qnil, val; - int total; - Bufbyte read_buf[READ_BUF_SIZE]; - int mc_count; - struct buffer *buf = current_buffer; - Lisp_Object curbuf; - int not_regular = 0; - - if (buf->base_buffer && ! NILP (visit)) - error ("Cannot do file visiting in an indirect buffer"); - - /* No need to call Fbarf_if_buffer_read_only() here. - That's called in begin_multiple_change() or wherever. */ - - val = Qnil; - - /* #### dmoore - should probably check in various places to see if - curbuf was killed and if so signal an error? */ - - XSETBUFFER (curbuf, buf); - - GCPRO5 (filename, val, visit, handler, curbuf); - - mc_count = (NILP (replace)) ? - begin_multiple_change (buf, BUF_PT (buf), BUF_PT (buf)) : - begin_multiple_change (buf, BUF_BEG (buf), BUF_Z (buf)); - - speccount = specpdl_depth (); /* begin_multiple_change also adds - an unwind_protect */ - - filename = Fexpand_file_name (filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qinsert_file_contents); - if (!NILP (handler)) - { - val = call6 (handler, Qinsert_file_contents, filename, - visit, beg, end, replace); - goto handled; - } - -#ifdef FILE_CODING - if (!NILP (used_codesys)) - CHECK_SYMBOL (used_codesys); -#endif - - if ( (!NILP (beg) || !NILP (end)) && !NILP (visit) ) - error ("Attempt to visit less than an entire file"); - - fd = -1; - - if ( -#ifndef APOLLO - (stat ((char *) XSTRING_DATA (filename), &st) < 0) -#else /* APOLLO */ - /* Don't even bother with interruptible_open. APOLLO sucks. */ - ((fd = open ((char *) XSTRING_DATA (filename), O_RDONLY | OPEN_BINARY, 0)) < 0 - || fstat (fd, &st) < 0) -#endif /* APOLLO */ - ) - { - if (fd >= 0) close (fd); - badopen: - if (NILP (visit)) - report_file_error ("Opening input file", list1 (filename)); - st.st_mtime = -1; - goto notfound; - } - -#ifdef S_IFREG - /* Signal an error if we are accessing a non-regular file, with - REPLACE, BEG or END being non-nil. */ - if (!S_ISREG (st.st_mode)) - { - not_regular = 1; - - if (!NILP (visit)) - goto notfound; - - if (!NILP (replace) || !NILP (beg) || !NILP (end)) - { - end_multiple_change (buf, mc_count); - - return Fsignal (Qfile_error, - list2 (build_translated_string("not a regular file"), - filename)); - } - } -#endif /* S_IFREG */ - - if (!NILP (beg)) - CHECK_INT (beg); - else - beg = Qzero; - - if (!NILP (end)) - CHECK_INT (end); - - if (fd < 0) - { - if ((fd = interruptible_open ((char *) XSTRING_DATA (filename), - O_RDONLY | OPEN_BINARY, 0)) < 0) - goto badopen; - } - - /* Replacement should preserve point as it preserves markers. */ - if (!NILP (replace)) - record_unwind_protect (restore_point_unwind, Fpoint_marker (Qnil, Qnil)); - - record_unwind_protect (close_file_unwind, make_int (fd)); - - /* Supposedly happens on VMS. */ - if (st.st_size < 0) - error ("File size is negative"); - - if (NILP (end)) - { - if (!not_regular) - { - end = make_int (st.st_size); - if (XINT (end) != st.st_size) - error ("Maximum buffer size exceeded"); - } - } - - /* If requested, replace the accessible part of the buffer - with the file contents. Avoid replacing text at the - beginning or end of the buffer that matches the file contents; - that preserves markers pointing to the unchanged parts. */ -#if !defined (FILE_CODING) - /* The replace-mode code currently only works when the assumption - 'one byte == one char' holds true. This fails Mule because - files may contain multibyte characters. It holds under Windows NT - provided we convert CRLF into LF. */ -# define FSFMACS_SPEEDY_INSERT -#endif /* !defined (FILE_CODING) */ - -#ifndef FSFMACS_SPEEDY_INSERT - if (!NILP (replace)) - { - buffer_delete_range (buf, BUF_BEG (buf), BUF_Z (buf), - !NILP (visit) ? INSDEL_NO_LOCKING : 0); - } -#else /* FSFMACS_SPEEDY_INSERT */ - if (!NILP (replace)) - { - char buffer[1 << 14]; - Bufpos same_at_start = BUF_BEGV (buf); - Bufpos same_at_end = BUF_ZV (buf); - int overlap; - - /* Count how many chars at the start of the file - match the text at the beginning of the buffer. */ - while (1) - { - int nread; - Bufpos bufpos; - nread = read_allowing_quit (fd, buffer, sizeof buffer); - if (nread < 0) - error ("IO error reading %s: %s", - XSTRING_DATA (filename), strerror (errno)); - else if (nread == 0) - break; - bufpos = 0; - while (bufpos < nread && same_at_start < BUF_ZV (buf) - && BUF_FETCH_CHAR (buf, same_at_start) == buffer[bufpos]) - same_at_start++, bufpos++; - /* If we found a discrepancy, stop the scan. - Otherwise loop around and scan the next bufferful. */ - if (bufpos != nread) - break; - } - /* If the file matches the buffer completely, - there's no need to replace anything. */ - if (same_at_start - BUF_BEGV (buf) == st.st_size) - { - close (fd); - unbind_to (speccount, Qnil); - /* Truncate the buffer to the size of the file. */ - buffer_delete_range (buf, same_at_start, same_at_end, - !NILP (visit) ? INSDEL_NO_LOCKING : 0); - goto handled; - } - /* Count how many chars at the end of the file - match the text at the end of the buffer. */ - while (1) - { - int total_read, nread; - Bufpos bufpos, curpos, trial; - - /* At what file position are we now scanning? */ - curpos = st.st_size - (BUF_ZV (buf) - same_at_end); - /* If the entire file matches the buffer tail, stop the scan. */ - if (curpos == 0) - break; - /* How much can we scan in the next step? */ - trial = min (curpos, (Bufpos) sizeof (buffer)); - if (lseek (fd, curpos - trial, 0) < 0) - report_file_error ("Setting file position", list1 (filename)); - - total_read = 0; - while (total_read < trial) - { - nread = read_allowing_quit (fd, buffer + total_read, - trial - total_read); - if (nread <= 0) - report_file_error ("IO error reading file", list1 (filename)); - total_read += nread; - } - /* Scan this bufferful from the end, comparing with - the Emacs buffer. */ - bufpos = total_read; - /* Compare with same_at_start to avoid counting some buffer text - as matching both at the file's beginning and at the end. */ - while (bufpos > 0 && same_at_end > same_at_start - && BUF_FETCH_CHAR (buf, same_at_end - 1) == - buffer[bufpos - 1]) - same_at_end--, bufpos--; - /* If we found a discrepancy, stop the scan. - Otherwise loop around and scan the preceding bufferful. */ - if (bufpos != 0) - break; - /* If display current starts at beginning of line, - keep it that way. */ - if (XBUFFER (XWINDOW (Fselected_window (Qnil))->buffer) == buf) - XWINDOW (Fselected_window (Qnil))->start_at_line_beg = - !NILP (Fbolp (make_buffer (buf))); - } - - /* Don't try to reuse the same piece of text twice. */ - overlap = same_at_start - BUF_BEGV (buf) - - (same_at_end + st.st_size - BUF_ZV (buf)); - if (overlap > 0) - same_at_end += overlap; - - /* Arrange to read only the nonmatching middle part of the file. */ - beg = make_int (same_at_start - BUF_BEGV (buf)); - end = make_int (st.st_size - (BUF_ZV (buf) - same_at_end)); - - buffer_delete_range (buf, same_at_start, same_at_end, - !NILP (visit) ? INSDEL_NO_LOCKING : 0); - /* Insert from the file at the proper position. */ - BUF_SET_PT (buf, same_at_start); - } -#endif /* FSFMACS_SPEEDY_INSERT */ - - if (!not_regular) - { - total = XINT (end) - XINT (beg); - - /* Make sure point-max won't overflow after this insertion. */ - if (total != XINT (make_int (total))) - error ("Maximum buffer size exceeded"); - } - else - /* For a special file, all we can do is guess. The value of -1 - will make the stream functions read as much as possible. */ - total = -1; - - if (XINT (beg) != 0 -#ifdef FSFMACS_SPEEDY_INSERT - /* why was this here? asked jwz. The reason is that the replace-mode - connivings above will normally put the file pointer other than - where it should be. */ - || !NILP (replace) -#endif /* !FSFMACS_SPEEDY_INSERT */ - ) - { - if (lseek (fd, XINT (beg), 0) < 0) - report_file_error ("Setting file position", list1 (filename)); - } - - { - Bufpos cur_point = BUF_PT (buf); - struct gcpro ngcpro1; - Lisp_Object stream = make_filedesc_input_stream (fd, 0, total, - LSTR_ALLOW_QUIT); - - NGCPRO1 (stream); - Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); -#ifdef FILE_CODING - stream = make_decoding_input_stream - (XLSTREAM (stream), Fget_coding_system (codesys)); - Lstream_set_character_mode (XLSTREAM (stream)); - Lstream_set_buffering (XLSTREAM (stream), LSTREAM_BLOCKN_BUFFERED, 65536); -#endif /* FILE_CODING */ - - record_unwind_protect (delete_stream_unwind, stream); - - /* No need to limit the amount of stuff we attempt to read. (It would - be incorrect, anyway, when Mule is enabled.) Instead, the limiting - occurs inside of the filedesc stream. */ - while (1) - { - Bytecount this_len; - Charcount cc_inserted; - - QUIT; - this_len = Lstream_read (XLSTREAM (stream), read_buf, - sizeof (read_buf)); - - if (this_len <= 0) - { - if (this_len < 0) - saverrno = errno; - break; - } - - cc_inserted = buffer_insert_raw_string_1 (buf, cur_point, read_buf, - this_len, - !NILP (visit) - ? INSDEL_NO_LOCKING : 0); - inserted += cc_inserted; - cur_point += cc_inserted; - } -#ifdef FILE_CODING - if (!NILP (used_codesys)) - { - Fset (used_codesys, - XCODING_SYSTEM_NAME (decoding_stream_coding_system (XLSTREAM (stream)))); - } -#endif /* FILE_CODING */ - NUNGCPRO; - } - - /* Close the file/stream */ - unbind_to (speccount, Qnil); - - if (saverrno != 0) - { - error ("IO error reading %s: %s", - XSTRING_DATA (filename), strerror (saverrno)); - } - - notfound: - handled: - - end_multiple_change (buf, mc_count); - - if (!NILP (visit)) - { - if (!EQ (buf->undo_list, Qt)) - buf->undo_list = Qnil; -#ifdef APOLLO - stat ((char *) XSTRING_DATA (filename), &st); -#endif - if (NILP (handler)) - { - buf->modtime = st.st_mtime; - buf->filename = filename; - /* XEmacs addition: */ - /* This function used to be in C, ostensibly so that - it could be called here. But that's just silly. - There's no reason C code can't call out to Lisp - code, and it's a lot cleaner this way. */ - if (!NILP (Ffboundp (Qcompute_buffer_file_truename))) - call1 (Qcompute_buffer_file_truename, make_buffer (buf)); - } - BUF_SAVE_MODIFF (buf) = BUF_MODIFF (buf); - buf->auto_save_modified = BUF_MODIFF (buf); - buf->saved_size = make_int (BUF_SIZE (buf)); -#ifdef CLASH_DETECTION - if (NILP (handler)) - { - if (!NILP (buf->file_truename)) - unlock_file (buf->file_truename); - unlock_file (filename); - } -#endif /* CLASH_DETECTION */ - if (not_regular) - RETURN_UNGCPRO (Fsignal (Qfile_error, - list2 (build_string ("not a regular file"), - filename))); - - /* If visiting nonexistent file, return nil. */ - if (buf->modtime == -1) - report_file_error ("Opening input file", - list1 (filename)); - } - - /* Decode file format */ - if (inserted > 0) - { - Lisp_Object insval = call3 (Qformat_decode, - Qnil, make_int (inserted), visit); - CHECK_INT (insval); - inserted = XINT (insval); - } - - if (inserted > 0) - { - Lisp_Object p; - struct gcpro ngcpro1; - - NGCPRO1 (p); - EXTERNAL_LIST_LOOP (p, Vafter_insert_file_functions) - { - Lisp_Object insval = - call1 (XCAR (p), make_int (inserted)); - if (!NILP (insval)) - { - CHECK_NATNUM (insval); - inserted = XINT (insval); - } - QUIT; - } - NUNGCPRO; - } - - UNGCPRO; - - if (!NILP (val)) - return (val); - else - return (list2 (filename, make_int (inserted))); -} - - -static int a_write (Lisp_Object outstream, Lisp_Object instream, int pos, - Lisp_Object *annot); -static Lisp_Object build_annotations (Lisp_Object start, Lisp_Object end); - -/* If build_annotations switched buffers, switch back to BUF. - Kill the temporary buffer that was selected in the meantime. */ - -static Lisp_Object -build_annotations_unwind (Lisp_Object buf) -{ - Lisp_Object tembuf; - - if (XBUFFER (buf) == current_buffer) - return Qnil; - tembuf = Fcurrent_buffer (); - Fset_buffer (buf); - Fkill_buffer (tembuf); - return Qnil; -} - -DEFUN ("write-region-internal", Fwrite_region_internal, 3, 7, - "r\nFWrite region to file: ", /* -Write current region into specified file; no coding-system frobbing. -This function is identical to `write-region' except for the handling -of the CODESYS argument under XEmacs/Mule. (When Mule support is not -present, both functions are identical and ignore the CODESYS argument.) -If support for Mule exists in this Emacs, the file is encoded according -to the value of CODESYS. If this is nil, no code conversion occurs. -*/ - (start, end, filename, append, visit, lockname, codesys)) -{ - /* This function can call lisp */ - int desc; - int failure; - int save_errno = 0; - struct stat st; - Lisp_Object fn; - int speccount = specpdl_depth (); - int visiting_other = STRINGP (visit); - int visiting = (EQ (visit, Qt) || visiting_other); - int quietly = (!visiting && !NILP (visit)); - Lisp_Object visit_file = Qnil; - Lisp_Object annotations = Qnil; - struct buffer *given_buffer; - Bufpos start1, end1; - - /* #### dmoore - if Fexpand_file_name or handlers kill the buffer, - we should signal an error rather than blissfully continuing - along. ARGH, this function is going to lose lose lose. We need - to protect the current_buffer from being destroyed, but the - multiple return points make this a pain in the butt. */ - -#ifdef FILE_CODING - codesys = Fget_coding_system (codesys); -#endif /* FILE_CODING */ - - if (current_buffer->base_buffer && ! NILP (visit)) - error ("Cannot do file visiting in an indirect buffer"); - - if (!NILP (start) && !STRINGP (start)) - get_buffer_range_char (current_buffer, start, end, &start1, &end1, 0); - - { - Lisp_Object handler; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - GCPRO5 (start, filename, visit, visit_file, lockname); - - if (visiting_other) - visit_file = Fexpand_file_name (visit, Qnil); - else - visit_file = filename; - filename = Fexpand_file_name (filename, Qnil); - - UNGCPRO; - - if (NILP (lockname)) - lockname = visit_file; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qwrite_region); - /* If FILENAME has no handler, see if VISIT has one. */ - if (NILP (handler) && STRINGP (visit)) - handler = Ffind_file_name_handler (visit, Qwrite_region); - - if (!NILP (handler)) - { - Lisp_Object val = call8 (handler, Qwrite_region, start, end, - filename, append, visit, lockname, codesys); - if (visiting) - { - BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); - current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); - current_buffer->filename = visit_file; - MARK_MODELINE_CHANGED; - } - return val; - } - } - -#ifdef CLASH_DETECTION - if (!auto_saving) - { - Lisp_Object curbuf; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - XSETBUFFER (curbuf, current_buffer); - GCPRO5 (start, filename, visit_file, lockname, curbuf); - lock_file (lockname); - UNGCPRO; - } -#endif /* CLASH_DETECTION */ - - /* Special kludge to simplify auto-saving. */ - if (NILP (start)) - { - start1 = BUF_BEG (current_buffer); - end1 = BUF_Z (current_buffer); - } - - record_unwind_protect (build_annotations_unwind, Fcurrent_buffer ()); - - given_buffer = current_buffer; - annotations = build_annotations (start, end); - if (current_buffer != given_buffer) - { - start1 = BUF_BEGV (current_buffer); - end1 = BUF_ZV (current_buffer); - } - - fn = filename; - desc = -1; - if (!NILP (append)) - { - desc = open ((char *) XSTRING_DATA (fn), O_WRONLY | OPEN_BINARY, 0); - } - if (desc < 0) - { - desc = open ((char *) XSTRING_DATA (fn), - (O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY), - ((auto_saving) ? auto_save_mode_bits : CREAT_MODE)); - } - - if (desc < 0) - { -#ifdef CLASH_DETECTION - save_errno = errno; - if (!auto_saving) unlock_file (lockname); - errno = save_errno; -#endif /* CLASH_DETECTION */ - report_file_error ("Opening output file", list1 (filename)); - } - - { - Lisp_Object desc_locative = Fcons (make_int (desc), Qnil); - Lisp_Object instream = Qnil, outstream = Qnil; - struct gcpro gcpro1, gcpro2; - /* need to gcpro; QUIT could happen out of call to write() */ - GCPRO2 (instream, outstream); - - record_unwind_protect (close_file_unwind, desc_locative); - - if (!NILP (append)) - { - if (lseek (desc, 0, 2) < 0) - { -#ifdef CLASH_DETECTION - if (!auto_saving) unlock_file (lockname); -#endif /* CLASH_DETECTION */ - report_file_error ("Lseek error", - list1 (filename)); - } - } - - failure = 0; - - /* Note: I tried increasing the buffering size, along with - various other tricks, but nothing seemed to make much of - a difference in the time it took to save a large file. - (Actually that's not true. With a local disk, changing - the buffer size doesn't seem to make much difference. - With an NFS-mounted disk, it could make a lot of difference - because you're affecting the number of network requests - that need to be made, and there could be a large latency - for each request. So I've increased the buffer size - to 64K.) */ - outstream = make_filedesc_output_stream (desc, 0, -1, 0); - Lstream_set_buffering (XLSTREAM (outstream), - LSTREAM_BLOCKN_BUFFERED, 65536); -#ifdef FILE_CODING - outstream = - make_encoding_output_stream (XLSTREAM (outstream), codesys); - Lstream_set_buffering (XLSTREAM (outstream), - LSTREAM_BLOCKN_BUFFERED, 65536); -#endif /* FILE_CODING */ - if (STRINGP (start)) - { - instream = make_lisp_string_input_stream (start, 0, -1); - start1 = 0; - } - else - instream = make_lisp_buffer_input_stream (current_buffer, start1, end1, - LSTR_SELECTIVE | - LSTR_IGNORE_ACCESSIBLE); - failure = (0 > (a_write (outstream, instream, start1, - &annotations))); - save_errno = errno; - /* Note that this doesn't close the desc since we created the - stream without the LSTR_CLOSING flag, but it does - flush out any buffered data. */ - if (Lstream_close (XLSTREAM (outstream)) < 0) - { - failure = 1; - save_errno = errno; - } - Lstream_close (XLSTREAM (instream)); - UNGCPRO; - -#ifdef HAVE_FSYNC - /* Note fsync appears to change the modtime on BSD4.2 (both vax and sun). - Disk full in NFS may be reported here. */ - /* mib says that closing the file will try to write as fast as NFS can do - it, and that means the fsync here is not crucial for autosave files. */ - if (!auto_saving && fsync (desc) < 0 - /* If fsync fails with EINTR, don't treat that as serious. */ - && errno != EINTR) - { - failure = 1; - save_errno = errno; - } -#endif /* HAVE_FSYNC */ - - /* Spurious "file has changed on disk" warnings have been - observed on Suns as well. - It seems that `close' can change the modtime, under nfs. - - (This has supposedly been fixed in Sunos 4, - but who knows about all the other machines with NFS?) */ - /* On VMS and APOLLO, must do the stat after the close - since closing changes the modtime. */ - /* As it does on Windows too - kkm */ - /* The spurious warnings appear on Linux too. Rather than handling - this on a per-system basis, unconditionally do the stat after the close - cgw */ - -#if 0 /* !defined (WINDOWSNT) */ /* !defined (VMS) && !defined (APOLLO) */ - fstat (desc, &st); -#endif - - /* NFS can report a write failure now. */ - if (close (desc) < 0) - { - failure = 1; - save_errno = errno; - } - - /* Discard the close unwind-protect. Execute the one for - build_annotations (switches back to the original current buffer - as necessary). */ - XCAR (desc_locative) = Qnil; - unbind_to (speccount, Qnil); - } - - /* # if defined (WINDOWSNT) */ /* defined (VMS) || defined (APOLLO) */ - stat ((char *) XSTRING_DATA (fn), &st); - /* #endif */ - -#ifdef CLASH_DETECTION - if (!auto_saving) - unlock_file (lockname); -#endif /* CLASH_DETECTION */ - - /* Do this before reporting IO error - to avoid a "file has changed on disk" warning on - next attempt to save. */ - if (visiting) - current_buffer->modtime = st.st_mtime; - - if (failure) - error ("IO error writing %s: %s", - XSTRING_DATA (fn), - strerror (save_errno)); - - if (visiting) - { - BUF_SAVE_MODIFF (current_buffer) = BUF_MODIFF (current_buffer); - current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); - current_buffer->filename = visit_file; - MARK_MODELINE_CHANGED; - } - else if (quietly) - { - return Qnil; - } - - if (!auto_saving) - { - if (visiting_other) - message ("Wrote %s", XSTRING_DATA (visit_file)); - else - { - struct gcpro gcpro1; - Lisp_Object fsp; - GCPRO1 (fn); - - fsp = Ffile_symlink_p (fn); - if (NILP (fsp)) - message ("Wrote %s", XSTRING_DATA (fn)); - else - message ("Wrote %s (symlink to %s)", - XSTRING_DATA (fn), XSTRING_DATA (fsp)); - UNGCPRO; - } - } - return Qnil; -} - -/* #### This is such a load of shit!!!! There is no way we should define - something so stupid as a subr, just sort the fucking list more - intelligently. */ -DEFUN ("car-less-than-car", Fcar_less_than_car, 2, 2, 0, /* -Return t if (car A) is numerically less than (car B). -*/ - (a, b)) -{ - Lisp_Object objs[2]; - objs[0] = Fcar (a); - objs[1] = Fcar (b); - return Flss (2, objs); -} - -/* Heh heh heh, let's define this too, just to aggravate the person who - wrote the above comment. */ -DEFUN ("cdr-less-than-cdr", Fcdr_less_than_cdr, 2, 2, 0, /* -Return t if (cdr A) is numerically less than (cdr B). -*/ - (a, b)) -{ - Lisp_Object objs[2]; - objs[0] = Fcdr (a); - objs[1] = Fcdr (b); - return Flss (2, objs); -} - -/* Build the complete list of annotations appropriate for writing out - the text between START and END, by calling all the functions in - write-region-annotate-functions and merging the lists they return. - If one of these functions switches to a different buffer, we assume - that buffer contains altered text. Therefore, the caller must - make sure to restore the current buffer in all cases, - as save-excursion would do. */ - -static Lisp_Object -build_annotations (Lisp_Object start, Lisp_Object end) -{ - /* This function can GC */ - Lisp_Object annotations; - Lisp_Object p, res; - struct gcpro gcpro1, gcpro2; - Lisp_Object original_buffer; - - XSETBUFFER (original_buffer, current_buffer); - - annotations = Qnil; - p = Vwrite_region_annotate_functions; - GCPRO2 (annotations, p); - while (!NILP (p)) - { - struct buffer *given_buffer = current_buffer; - Vwrite_region_annotations_so_far = annotations; - res = call2 (Fcar (p), start, end); - /* If the function makes a different buffer current, - assume that means this buffer contains altered text to be output. - Reset START and END from the buffer bounds - and discard all previous annotations because they should have - been dealt with by this function. */ - if (current_buffer != given_buffer) - { - start = make_int (BUF_BEGV (current_buffer)); - end = make_int (BUF_ZV (current_buffer)); - annotations = Qnil; - } - Flength (res); /* Check basic validity of return value */ - annotations = merge (annotations, res, Qcar_less_than_car); - p = Fcdr (p); - } - - /* Now do the same for annotation functions implied by the file-format */ - if (auto_saving && (!EQ (Vauto_save_file_format, Qt))) - p = Vauto_save_file_format; - else - p = current_buffer->file_format; - while (!NILP (p)) - { - struct buffer *given_buffer = current_buffer; - Vwrite_region_annotations_so_far = annotations; - res = call4 (Qformat_annotate_function, Fcar (p), start, end, - original_buffer); - if (current_buffer != given_buffer) - { - start = make_int (BUF_BEGV (current_buffer)); - end = make_int (BUF_ZV (current_buffer)); - annotations = Qnil; - } - Flength (res); - annotations = merge (annotations, res, Qcar_less_than_car); - p = Fcdr (p); - } - UNGCPRO; - return annotations; -} - -/* Write to stream OUTSTREAM the characters from INSTREAM (it is read until - EOF is encountered), assuming they start at position POS in the buffer - of string that STREAM refers to. Intersperse with them the annotations - from *ANNOT that fall into the range of positions we are reading from, - each at its appropriate position. - - Modify *ANNOT by discarding elements as we output them. - The return value is negative in case of system call failure. */ - -/* 4K should probably be fine. We just need to reduce the number of - function calls to reasonable level. The Lstream stuff itself will - batch to 64K to reduce the number of system calls. */ - -#define A_WRITE_BATCH_SIZE 4096 - -static int -a_write (Lisp_Object outstream, Lisp_Object instream, int pos, - Lisp_Object *annot) -{ - Lisp_Object tem; - int nextpos; - unsigned char largebuf[A_WRITE_BATCH_SIZE]; - Lstream *instr = XLSTREAM (instream); - Lstream *outstr = XLSTREAM (outstream); - - while (LISTP (*annot)) - { - tem = Fcar_safe (Fcar (*annot)); - if (INTP (tem)) - nextpos = XINT (tem); - else - nextpos = INT_MAX; -#ifdef MULE - /* If there are annotations left and we have Mule, then we - have to do the I/O one emchar at a time so we can - determine when to insert the annotation. */ - if (!NILP (*annot)) - { - Emchar ch; - while (pos != nextpos && (ch = Lstream_get_emchar (instr)) != EOF) - { - if (Lstream_put_emchar (outstr, ch) < 0) - return -1; - pos++; - } - } - else -#endif /* MULE */ - { - while (pos != nextpos) - { - /* Otherwise there is no point to that. Just go in batches. */ - int chunk = min (nextpos - pos, A_WRITE_BATCH_SIZE); - - chunk = Lstream_read (instr, largebuf, chunk); - if (chunk < 0) - return -1; - if (chunk == 0) /* EOF */ - break; - if (Lstream_write (outstr, largebuf, chunk) < chunk) - return -1; - pos += chunk; - } - } - if (pos == nextpos) - { - tem = Fcdr (Fcar (*annot)); - if (STRINGP (tem)) - { - if (Lstream_write (outstr, XSTRING_DATA (tem), - XSTRING_LENGTH (tem)) < 0) - return -1; - } - *annot = Fcdr (*annot); - } - else - return 0; - } - return -1; -} - - - -#if 0 -#include - -#define CRYPT_BLOCK_SIZE 8 /* bytes */ -#define CRYPT_KEY_SIZE 8 /* bytes */ - -DEFUN ("encrypt-string", Fencrypt_string, 2, 2, 0, /* -Encrypt STRING using KEY. -*/ - (string, key)) -{ - char *encrypted_string, *raw_key; - int rounded_size, extra, key_size; - - /* !!#### May produce bogus data under Mule. */ - CHECK_STRING (string); - CHECK_STRING (key); - - extra = XSTRING_LENGTH (string) % CRYPT_BLOCK_SIZE; - rounded_size = XSTRING_LENGTH (string) + extra; - encrypted_string = alloca (rounded_size + 1); - memcpy (encrypted_string, XSTRING_DATA (string), XSTRING_LENGTH (string)); - memset (encrypted_string + rounded_size - extra, 0, extra + 1); - - key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key)) - - raw_key = alloca (CRYPT_KEY_SIZE + 1); - memcpy (raw_key, XSTRING_DATA (key), key_size); - memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); - - ecb_crypt (raw_key, encrypted_string, rounded_size, - DES_ENCRYPT | DES_SW); - return make_string (encrypted_string, rounded_size); -} - -DEFUN ("decrypt-string", Fdecrypt_string, 2, 2, 0, /* -Decrypt STRING using KEY. -*/ - (string, key)) -{ - char *decrypted_string, *raw_key; - int string_size, key_size; - - CHECK_STRING (string); - CHECK_STRING (key); - - string_size = XSTRING_LENGTH (string) + 1; - decrypted_string = alloca (string_size); - memcpy (decrypted_string, XSTRING_DATA (string), string_size); - decrypted_string[string_size - 1] = '\0'; - - key_size = min (CRYPT_KEY_SIZE, XSTRING_LENGTH (key)) - - raw_key = alloca (CRYPT_KEY_SIZE + 1); - memcpy (raw_key, XSTRING_DATA (key), key_size); - memset (raw_key + key_size, 0, (CRYPT_KEY_SIZE + 1) - key_size); - - - ecb_crypt (raw_key, decrypted_string, string_size, D | DES_SW); - return make_string (decrypted_string, string_size - 1); -} -#endif /* 0 */ - - -DEFUN ("verify-visited-file-modtime", Fverify_visited_file_modtime, 1, 1, 0, /* -Return t if last mod time of BUF's visited file matches what BUF records. -This means that the file has not been changed since it was visited or saved. -*/ - (buf)) -{ - /* This function can call lisp */ - struct buffer *b; - struct stat st; - Lisp_Object handler; - - CHECK_BUFFER (buf); - b = XBUFFER (buf); - - if (!STRINGP (b->filename)) return Qt; - if (b->modtime == 0) return Qt; - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (b->filename, - Qverify_visited_file_modtime); - if (!NILP (handler)) - return call2 (handler, Qverify_visited_file_modtime, buf); - - if (stat ((char *) XSTRING_DATA (b->filename), &st) < 0) - { - /* If the file doesn't exist now and didn't exist before, - we say that it isn't modified, provided the error is a tame one. */ - if (errno == ENOENT || errno == EACCES || errno == ENOTDIR) - st.st_mtime = -1; - else - st.st_mtime = 0; - } - if (st.st_mtime == b->modtime - /* If both are positive, accept them if they are off by one second. */ - || (st.st_mtime > 0 && b->modtime > 0 - && (st.st_mtime == b->modtime + 1 - || st.st_mtime == b->modtime - 1))) - return Qt; - return Qnil; -} - -DEFUN ("clear-visited-file-modtime", Fclear_visited_file_modtime, 0, 0, 0, /* -Clear out records of last mod time of visited file. -Next attempt to save will certainly not complain of a discrepancy. -*/ - ()) -{ - current_buffer->modtime = 0; - return Qnil; -} - -DEFUN ("visited-file-modtime", Fvisited_file_modtime, 0, 0, 0, /* -Return the current buffer's recorded visited file modification time. -The value is a list of the form (HIGH . LOW), like the time values -that `file-attributes' returns. -*/ - ()) -{ - return time_to_lisp ((time_t) current_buffer->modtime); -} - -DEFUN ("set-visited-file-modtime", Fset_visited_file_modtime, 0, 1, 0, /* -Update buffer's recorded modification time from the visited file's time. -Useful if the buffer was not read from the file normally -or if the file itself has been changed for some known benign reason. -An argument specifies the modification time value to use -\(instead of that of the visited file), in the form of a list -\(HIGH . LOW) or (HIGH LOW). -*/ - (time_list)) -{ - /* This function can call lisp */ - if (!NILP (time_list)) - { - time_t the_time; - lisp_to_time (time_list, &the_time); - current_buffer->modtime = (int) the_time; - } - else - { - Lisp_Object filename; - struct stat st; - Lisp_Object handler; - struct gcpro gcpro1, gcpro2, gcpro3; - - GCPRO3 (filename, time_list, current_buffer->filename); - filename = Fexpand_file_name (current_buffer->filename, Qnil); - - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (filename, Qset_visited_file_modtime); - UNGCPRO; - if (!NILP (handler)) - /* The handler can find the file name the same way we did. */ - return call2 (handler, Qset_visited_file_modtime, Qnil); - else if (stat ((char *) XSTRING_DATA (filename), &st) >= 0) - current_buffer->modtime = st.st_mtime; - } - - return Qnil; -} - -static Lisp_Object -auto_save_error (Lisp_Object condition_object, Lisp_Object ignored) -{ - /* This function can call lisp */ - if (gc_in_progress) - return Qnil; - /* Don't try printing an error message after everything is gone! */ - if (preparing_for_armageddon) - return Qnil; - clear_echo_area (selected_frame (), Qauto_saving, 1); - Fding (Qt, Qauto_save_error, Qnil); - message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); - Fsleep_for (make_int (1)); - message ("Auto-saving...error!for %s", XSTRING_DATA (current_buffer->name)); - Fsleep_for (make_int (1)); - message ("Auto-saving...error for %s", XSTRING_DATA (current_buffer->name)); - Fsleep_for (make_int (1)); - return Qnil; -} - -static Lisp_Object -auto_save_1 (Lisp_Object ignored) -{ - /* This function can call lisp */ - /* #### I think caller is protecting current_buffer? */ - struct stat st; - Lisp_Object fn = current_buffer->filename; - Lisp_Object a = current_buffer->auto_save_file_name; - - if (!STRINGP (a)) - return (Qnil); - - /* Get visited file's mode to become the auto save file's mode. */ - if (STRINGP (fn) && - stat ((char *) XSTRING_DATA (fn), &st) >= 0) - /* But make sure we can overwrite it later! */ - auto_save_mode_bits = st.st_mode | 0600; - else - /* default mode for auto-save files of buffers with no file is - readable by owner only. This may annoy some small number of - people, but the alternative removes all privacy from email. */ - auto_save_mode_bits = 0600; - - return - /* !!#### need to deal with this 'escape-quoted everywhere */ - Fwrite_region_internal (Qnil, Qnil, a, Qnil, Qlambda, Qnil, -#ifdef MULE - Qescape_quoted -#else - Qnil -#endif - ); -} - -static Lisp_Object -auto_save_expand_name_error (Lisp_Object condition_object, Lisp_Object ignored) -{ - /* #### this function should spew an error message about not being - able to open the .saves file. */ - return Qnil; -} - -static Lisp_Object -auto_save_expand_name (Lisp_Object name) -{ - struct gcpro gcpro1; - - /* note that caller did NOT gc protect name, so we do it. */ - /* #### dmoore - this might not be necessary, if condition_case_1 - protects it. but I don't think it does. */ - GCPRO1 (name); - RETURN_UNGCPRO (Fexpand_file_name (name, Qnil)); -} - - -static Lisp_Object -do_auto_save_unwind (Lisp_Object fd) -{ - close (XINT (fd)); - return (fd); -} - -static Lisp_Object -do_auto_save_unwind_2 (Lisp_Object old_auto_saving) -{ - auto_saving = XINT (old_auto_saving); - return Qnil; -} - -/* Fdo_auto_save() checks whether a GC is in progress when it is called, - and if so, tries to avoid touching lisp objects. - - The only time that Fdo_auto_save() is called while GC is in progress - is if we're going down, as a result of an abort() or a kill signal. - It's fairly important that we generate autosave files in that case! - */ - -DEFUN ("do-auto-save", Fdo_auto_save, 0, 2, "", /* -Auto-save all buffers that need it. -This is all buffers that have auto-saving enabled -and are changed since last auto-saved. -Auto-saving writes the buffer into a file -so that your editing is not lost if the system crashes. -This file is not the file you visited; that changes only when you save. -Normally we run the normal hook `auto-save-hook' before saving. - -Non-nil first argument means do not print any message if successful. -Non-nil second argument means save only current buffer. -*/ - (no_message, current_only)) -{ - /* This function can call lisp */ - struct buffer *b; - Lisp_Object tail, buf; - int auto_saved = 0; - int do_handled_files; - Lisp_Object oquit = Qnil; - Lisp_Object listfile = Qnil; - Lisp_Object old; - int listdesc = -1; - int speccount = specpdl_depth (); - struct gcpro gcpro1, gcpro2, gcpro3; - - XSETBUFFER (old, current_buffer); - GCPRO3 (oquit, listfile, old); - check_quit (); /* make Vquit_flag accurate */ - /* Ordinarily don't quit within this function, - but don't make it impossible to quit (in case we get hung in I/O). */ - oquit = Vquit_flag; - Vquit_flag = Qnil; - - /* No further GCPRO needed, because (when it matters) all Lisp_Object - variables point to non-strings reached from Vbuffer_alist. */ - - if (minibuf_level != 0 || preparing_for_armageddon) - no_message = Qt; - - run_hook (Qauto_save_hook); - - if (GC_STRINGP (Vauto_save_list_file_name)) - listfile = condition_case_1 (Qt, - auto_save_expand_name, - Vauto_save_list_file_name, - auto_save_expand_name_error, Qnil); - - /* Make sure auto_saving is reset. */ - record_unwind_protect (do_auto_save_unwind_2, make_int (auto_saving)); - - auto_saving = 1; - - /* First, save all files which don't have handlers. If Emacs is - crashing, the handlers may tweak what is causing Emacs to crash - in the first place, and it would be a shame if Emacs failed to - autosave perfectly ordinary files because it couldn't handle some - ange-ftp'd file. */ - for (do_handled_files = 0; do_handled_files < 2; do_handled_files++) - { - for (tail = Vbuffer_alist; - GC_CONSP (tail); - tail = XCDR (tail)) - { - buf = XCDR (XCAR (tail)); - b = XBUFFER (buf); - - if (!GC_NILP (current_only) - && b != current_buffer) - continue; - - /* Don't auto-save indirect buffers. - The base buffer takes care of it. */ - if (b->base_buffer) - continue; - - /* Check for auto save enabled - and file changed since last auto save - and file changed since last real save. */ - if (GC_STRINGP (b->auto_save_file_name) - && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) - && b->auto_save_modified < BUF_MODIFF (b) - /* -1 means we've turned off autosaving for a while--see below. */ - && XINT (b->saved_size) >= 0 - && (do_handled_files - || NILP (Ffind_file_name_handler (b->auto_save_file_name, - Qwrite_region)))) - { - EMACS_TIME before_time, after_time; - - EMACS_GET_TIME (before_time); - /* If we had a failure, don't try again for 20 minutes. */ - if (!preparing_for_armageddon - && b->auto_save_failure_time >= 0 - && (EMACS_SECS (before_time) - b->auto_save_failure_time < - 1200)) - continue; - - if (!preparing_for_armageddon && - (XINT (b->saved_size) * 10 - > (BUF_Z (b) - BUF_BEG (b)) * 13) - /* A short file is likely to change a large fraction; - spare the user annoying messages. */ - && XINT (b->saved_size) > 5000 - /* These messages are frequent and annoying for `*mail*'. */ - && !NILP (b->filename) - && NILP (no_message) - && disable_auto_save_when_buffer_shrinks) - { - /* It has shrunk too much; turn off auto-saving here. - Unless we're about to crash, in which case auto-save it - anyway. - */ - message - ("Buffer %s has shrunk a lot; auto save turned off there", - XSTRING_DATA (b->name)); - /* Turn off auto-saving until there's a real save, - and prevent any more warnings. */ - b->saved_size = make_int (-1); - if (!gc_in_progress) - Fsleep_for (make_int (1)); - continue; - } - set_buffer_internal (b); - if (!auto_saved && GC_NILP (no_message)) - { - static CONST unsigned char *msg - = (CONST unsigned char *) "Auto-saving..."; - echo_area_message (selected_frame (), msg, Qnil, - 0, strlen ((CONST char *) msg), - Qauto_saving); - } - - /* Open the auto-save list file, if necessary. - We only do this now so that the file only exists - if we actually auto-saved any files. */ - if (!auto_saved && GC_STRINGP (listfile) && listdesc < 0) - { - listdesc = open ((char *) XSTRING_DATA (listfile), - O_WRONLY | O_TRUNC | O_CREAT | OPEN_BINARY, - CREAT_MODE); - - /* Arrange to close that file whether or not we get - an error. */ - if (listdesc >= 0) - record_unwind_protect (do_auto_save_unwind, - make_int (listdesc)); - } - - /* Record all the buffers that we are auto-saving in - the special file that lists them. For each of - these buffers, record visited name (if any) and - auto save name. */ - if (listdesc >= 0) - { - CONST Extbyte *auto_save_file_name_ext; - Extcount auto_save_file_name_ext_len; - - GET_STRING_FILENAME_DATA_ALLOCA - (b->auto_save_file_name, - auto_save_file_name_ext, - auto_save_file_name_ext_len); - if (!NILP (b->filename)) - { - CONST Extbyte *filename_ext; - Extcount filename_ext_len; - - GET_STRING_FILENAME_DATA_ALLOCA (b->filename, - filename_ext, - filename_ext_len); - write (listdesc, filename_ext, filename_ext_len); - } - write (listdesc, "\n", 1); - write (listdesc, auto_save_file_name_ext, - auto_save_file_name_ext_len); - write (listdesc, "\n", 1); - } - - /* dmoore - In a bad scenario we've set b=XBUFFER(buf) - based on values in Vbuffer_alist. auto_save_1 may - cause lisp handlers to run. Those handlers may kill - the buffer and then GC. Since the buffer is killed, - it's no longer in Vbuffer_alist so it might get reaped - by the GC. We also need to protect tail. */ - /* #### There is probably a lot of other code which has - pointers into buffers which may get blown away by - handlers. */ - { - struct gcpro ngcpro1, ngcpro2; - NGCPRO2 (buf, tail); - condition_case_1 (Qt, - auto_save_1, Qnil, - auto_save_error, Qnil); - NUNGCPRO; - } - /* Handler killed our saved current-buffer! Pick any. */ - if (!BUFFER_LIVE_P (XBUFFER (old))) - XSETBUFFER (old, current_buffer); - - set_buffer_internal (XBUFFER (old)); - auto_saved++; - - /* Handler killed their own buffer! */ - if (!BUFFER_LIVE_P(b)) - continue; - - b->auto_save_modified = BUF_MODIFF (b); - b->saved_size = make_int (BUF_SIZE (b)); - EMACS_GET_TIME (after_time); - /* If auto-save took more than 60 seconds, - assume it was an NFS failure that got a timeout. */ - if (EMACS_SECS (after_time) - EMACS_SECS (before_time) > 60) - b->auto_save_failure_time = EMACS_SECS (after_time); - } - } - } - - /* Prevent another auto save till enough input events come in. */ - if (auto_saved) - record_auto_save (); - - /* If we didn't save anything into the listfile, remove the old - one because nothing needed to be auto-saved. Do this afterwards - rather than before in case we get a crash attempting to autosave - (in that case we'd still want the old one around). */ - if (listdesc < 0 && !auto_saved && GC_STRINGP (listfile)) - unlink ((char *) XSTRING_DATA (listfile)); - - /* Show "...done" only if the echo area would otherwise be empty. */ - if (auto_saved && NILP (no_message) - && NILP (clear_echo_area (selected_frame (), Qauto_saving, 0))) - { - static CONST unsigned char *msg - = (CONST unsigned char *)"Auto-saving...done"; - echo_area_message (selected_frame (), msg, Qnil, 0, - strlen ((CONST char *) msg), Qauto_saving); - } - - Vquit_flag = oquit; - - RETURN_UNGCPRO (unbind_to (speccount, Qnil)); -} - -DEFUN ("set-buffer-auto-saved", Fset_buffer_auto_saved, 0, 0, 0, /* -Mark current buffer as auto-saved with its current text. -No auto-save file will be written until the buffer changes again. -*/ - ()) -{ - current_buffer->auto_save_modified = BUF_MODIFF (current_buffer); - current_buffer->saved_size = make_int (BUF_SIZE (current_buffer)); - current_buffer->auto_save_failure_time = -1; - return Qnil; -} - -DEFUN ("clear-buffer-auto-save-failure", Fclear_buffer_auto_save_failure, 0, 0, 0, /* -Clear any record of a recent auto-save failure in the current buffer. -*/ - ()) -{ - current_buffer->auto_save_failure_time = -1; - return Qnil; -} - -DEFUN ("recent-auto-save-p", Frecent_auto_save_p, 0, 0, 0, /* -Return t if buffer has been auto-saved since last read in or saved. -*/ - ()) -{ - return (BUF_SAVE_MODIFF (current_buffer) < - current_buffer->auto_save_modified) ? Qt : Qnil; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_fileio (void) -{ - defsymbol (&Qexpand_file_name, "expand-file-name"); - defsymbol (&Qfile_truename, "file-truename"); - defsymbol (&Qsubstitute_in_file_name, "substitute-in-file-name"); - defsymbol (&Qdirectory_file_name, "directory-file-name"); - defsymbol (&Qfile_name_directory, "file-name-directory"); - defsymbol (&Qfile_name_nondirectory, "file-name-nondirectory"); - defsymbol (&Qunhandled_file_name_directory, "unhandled-file-name-directory"); - defsymbol (&Qfile_name_as_directory, "file-name-as-directory"); - defsymbol (&Qcopy_file, "copy-file"); - defsymbol (&Qmake_directory_internal, "make-directory-internal"); - defsymbol (&Qdelete_directory, "delete-directory"); - defsymbol (&Qdelete_file, "delete-file"); - defsymbol (&Qrename_file, "rename-file"); - defsymbol (&Qadd_name_to_file, "add-name-to-file"); - defsymbol (&Qmake_symbolic_link, "make-symbolic-link"); - defsymbol (&Qfile_exists_p, "file-exists-p"); - defsymbol (&Qfile_executable_p, "file-executable-p"); - defsymbol (&Qfile_readable_p, "file-readable-p"); - defsymbol (&Qfile_symlink_p, "file-symlink-p"); - defsymbol (&Qfile_writable_p, "file-writable-p"); - defsymbol (&Qfile_directory_p, "file-directory-p"); - defsymbol (&Qfile_regular_p, "file-regular-p"); - defsymbol (&Qfile_accessible_directory_p, "file-accessible-directory-p"); - defsymbol (&Qfile_modes, "file-modes"); - defsymbol (&Qset_file_modes, "set-file-modes"); - defsymbol (&Qfile_newer_than_file_p, "file-newer-than-file-p"); - defsymbol (&Qinsert_file_contents, "insert-file-contents"); - defsymbol (&Qwrite_region, "write-region"); - defsymbol (&Qverify_visited_file_modtime, "verify-visited-file-modtime"); - defsymbol (&Qset_visited_file_modtime, "set-visited-file-modtime"); - defsymbol (&Qcar_less_than_car, "car-less-than-car"); /* Vomitous! */ - - defsymbol (&Qfile_name_handler_alist, "file-name-handler-alist"); - defsymbol (&Qauto_save_hook, "auto-save-hook"); - defsymbol (&Qauto_save_error, "auto-save-error"); - defsymbol (&Qauto_saving, "auto-saving"); - - defsymbol (&Qformat_decode, "format-decode"); - defsymbol (&Qformat_annotate_function, "format-annotate-function"); - - defsymbol (&Qcompute_buffer_file_truename, "compute-buffer-file-truename"); - deferror (&Qfile_error, "file-error", "File error", Qio_error); - deferror (&Qfile_already_exists, "file-already-exists", - "File already exists", Qfile_error); - - DEFSUBR (Ffind_file_name_handler); - - DEFSUBR (Ffile_name_directory); - DEFSUBR (Ffile_name_nondirectory); - DEFSUBR (Funhandled_file_name_directory); - DEFSUBR (Ffile_name_as_directory); - DEFSUBR (Fdirectory_file_name); - DEFSUBR (Fmake_temp_name); - DEFSUBR (Fexpand_file_name); - DEFSUBR (Ffile_truename); - DEFSUBR (Fsubstitute_in_file_name); - DEFSUBR (Fcopy_file); - DEFSUBR (Fmake_directory_internal); - DEFSUBR (Fdelete_directory); - DEFSUBR (Fdelete_file); - DEFSUBR (Frename_file); - DEFSUBR (Fadd_name_to_file); -#ifdef S_IFLNK - DEFSUBR (Fmake_symbolic_link); -#endif /* S_IFLNK */ -#ifdef HPUX_NET - DEFSUBR (Fsysnetunam); -#endif /* HPUX_NET */ - DEFSUBR (Ffile_name_absolute_p); - DEFSUBR (Ffile_exists_p); - DEFSUBR (Ffile_executable_p); - DEFSUBR (Ffile_readable_p); - DEFSUBR (Ffile_writable_p); - DEFSUBR (Ffile_symlink_p); - DEFSUBR (Ffile_directory_p); - DEFSUBR (Ffile_accessible_directory_p); - DEFSUBR (Ffile_regular_p); - DEFSUBR (Ffile_modes); - DEFSUBR (Fset_file_modes); - DEFSUBR (Fset_default_file_modes); - DEFSUBR (Fdefault_file_modes); - DEFSUBR (Funix_sync); - DEFSUBR (Ffile_newer_than_file_p); - DEFSUBR (Finsert_file_contents_internal); - DEFSUBR (Fwrite_region_internal); - DEFSUBR (Fcar_less_than_car); /* Vomitous! */ - DEFSUBR (Fcdr_less_than_cdr); /* Yeah oh yeah bucko .... */ -#if 0 - DEFSUBR (Fencrypt_string); - DEFSUBR (Fdecrypt_string); -#endif - DEFSUBR (Fverify_visited_file_modtime); - DEFSUBR (Fclear_visited_file_modtime); - DEFSUBR (Fvisited_file_modtime); - DEFSUBR (Fset_visited_file_modtime); - - DEFSUBR (Fdo_auto_save); - DEFSUBR (Fset_buffer_auto_saved); - DEFSUBR (Fclear_buffer_auto_save_failure); - DEFSUBR (Frecent_auto_save_p); -} - -void -vars_of_fileio (void) -{ - DEFVAR_LISP ("auto-save-file-format", &Vauto_save_file_format /* -*Format in which to write auto-save files. -Should be a list of symbols naming formats that are defined in `format-alist'. -If it is t, which is the default, auto-save files are written in the -same format as a regular save would use. -*/ ); - Vauto_save_file_format = Qt; - - DEFVAR_LISP ("file-name-handler-alist", &Vfile_name_handler_alist /* -*Alist of elements (REGEXP . HANDLER) for file names handled specially. -If a file name matches REGEXP, then all I/O on that file is done by calling -HANDLER. - -The first argument given to HANDLER is the name of the I/O primitive -to be handled; the remaining arguments are the arguments that were -passed to that primitive. For example, if you do - (file-exists-p FILENAME) -and FILENAME is handled by HANDLER, then HANDLER is called like this: - (funcall HANDLER 'file-exists-p FILENAME) -The function `find-file-name-handler' checks this list for a handler -for its argument. -*/ ); - Vfile_name_handler_alist = Qnil; - - DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions /* -A list of functions to be called at the end of `insert-file-contents'. -Each is passed one argument, the number of bytes inserted. It should return -the new byte count, and leave point the same. If `insert-file-contents' is -intercepted by a handler from `file-name-handler-alist', that handler is -responsible for calling the after-insert-file-functions if appropriate. -*/ ); - Vafter_insert_file_functions = Qnil; - - DEFVAR_LISP ("write-region-annotate-functions", - &Vwrite_region_annotate_functions /* -A list of functions to be called at the start of `write-region'. -Each is passed two arguments, START and END, as for `write-region'. -It should return a list of pairs (POSITION . STRING) of strings to be -effectively inserted at the specified positions of the file being written -\(1 means to insert before the first byte written). The POSITIONs must be -sorted into increasing order. If there are several functions in the list, -the several lists are merged destructively. -*/ ); - Vwrite_region_annotate_functions = Qnil; - - DEFVAR_LISP ("write-region-annotations-so-far", - &Vwrite_region_annotations_so_far /* -When an annotation function is called, this holds the previous annotations. -These are the annotations made by other annotation functions -that were already called. See also `write-region-annotate-functions'. -*/ ); - Vwrite_region_annotations_so_far = Qnil; - - DEFVAR_LISP ("inhibit-file-name-handlers", &Vinhibit_file_name_handlers /* -A list of file name handlers that temporarily should not be used. -This applies only to the operation `inhibit-file-name-operation'. -*/ ); - Vinhibit_file_name_handlers = Qnil; - - DEFVAR_LISP ("inhibit-file-name-operation", &Vinhibit_file_name_operation /* -The operation for which `inhibit-file-name-handlers' is applicable. -*/ ); - Vinhibit_file_name_operation = Qnil; - - DEFVAR_LISP ("auto-save-list-file-name", &Vauto_save_list_file_name /* -File name in which we write a list of all auto save file names. -*/ ); - Vauto_save_list_file_name = Qnil; - - DEFVAR_BOOL ("disable-auto-save-when-buffer-shrinks", - &disable_auto_save_when_buffer_shrinks /* -If non-nil, auto-saving is disabled when a buffer shrinks too much. -This is to prevent you from losing your edits if you accidentally -delete a large chunk of the buffer and don't notice it until too late. -Saving the buffer normally turns auto-save back on. -*/ ); - disable_auto_save_when_buffer_shrinks = 1; - - DEFVAR_LISP ("directory-sep-char", &Vdirectory_sep_char /* -Directory separator character for built-in functions that return file names. -The value should be either ?/ or ?\\ (any other value is treated as ?\\). -This variable affects the built-in functions only on Windows, -on other platforms, it is initialized so that Lisp code can find out -what the normal separator is. -*/ ); - Vdirectory_sep_char = make_char ('/'); -} diff --git a/src/filelock.c b/src/filelock.c deleted file mode 100644 index 44a4f43..0000000 --- a/src/filelock.c +++ /dev/null @@ -1,476 +0,0 @@ -/* Copyright (C) 1985, 86, 87, 93, 94, 96 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. */ - -/* Synced with FSF 20.2 */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include - -#include "sysfile.h" -#include "sysdir.h" -#include "syspwd.h" -#include "syssignal.h" /* for kill */ - -Lisp_Object Qask_user_about_supersession_threat; -Lisp_Object Qask_user_about_lock; - -#ifdef CLASH_DETECTION - -/* The strategy: to lock a file FN, create a symlink .#FN in FN's - directory, with link data `user@host.pid'. This avoids a single - mount (== failure) point for lock files. - - When the host in the lock data is the current host, we can check if - the pid is valid with kill. - - Otherwise, we could look at a separate file that maps hostnames to - reboot times to see if the remote pid can possibly be valid, since we - don't want Emacs to have to communicate via pipes or sockets or - whatever to other processes, either locally or remotely; rms says - that's too unreliable. Hence the separate file, which could - theoretically be updated by daemons running separately -- but this - whole idea is unimplemented; in practice, at least in our - environment, it seems such stale locks arise fairly infrequently, and - Emacs' standard methods of dealing with clashes suffice. - - We use symlinks instead of normal files because (1) they can be - stored more efficiently on the filesystem, since the kernel knows - they will be small, and (2) all the info about the lock can be read - in a single system call (readlink). Although we could use regular - files to be useful on old systems lacking symlinks, nowadays - virtually all such systems are probably single-user anyway, so it - didn't seem worth the complication. - - Similarly, we don't worry about a possible 14-character limit on - file names, because those are all the same systems that don't have - symlinks. - - This is compatible with the locking scheme used by Interleaf (which - has contributed this implementation for Emacs), and was designed by - Ethan Jacobson, Kimbo Mundy, and others. - - --karl@cs.umb.edu/karl@hq.ileaf.com. */ - - -/* Here is the structure that stores information about a lock. */ - -typedef struct -{ - char *user; - char *host; - unsigned long pid; -} lock_info_type; - -/* When we read the info back, we might need this much more, - enough for decimal representation plus null. */ -#define LOCK_PID_MAX (4 * sizeof (unsigned long)) - -/* Free the two dynamically-allocated pieces in PTR. */ -#define FREE_LOCK_INFO(i) do { xfree ((i).user); xfree ((i).host); } while (0) - -/* Write the name of the lock file for FN into LFNAME. Length will be - that of FN plus two more for the leading `.#' plus one for the null. */ -#define MAKE_LOCK_NAME(lock, file) \ - (lock = (char *) alloca (XSTRING_LENGTH(file) + 2 + 1), \ - fill_in_lock_file_name (lock, (file))) - -static void -fill_in_lock_file_name (lockfile, fn) - register char *lockfile; - register Lisp_Object fn; -{ - register char *p; - - strcpy (lockfile, XSTRING_DATA(fn)); - - /* Shift the nondirectory part of the file name (including the null) - right two characters. Here is one of the places where we'd have to - do something to support 14-character-max file names. */ - for (p = lockfile + strlen (lockfile); p != lockfile && *p != '/'; p--) - p[2] = *p; - - /* Insert the `.#'. */ - p[1] = '.'; - p[2] = '#'; -} - -/* Lock the lock file named LFNAME. - If FORCE is nonzero, we do so even if it is already locked. - Return 1 if successful, 0 if not. */ - -static int -lock_file_1 (char *lfname,int force) -{ - register int err; - char *user_name; - char *host_name; - char *lock_info_str; - - if (STRINGP (Fuser_login_name (Qnil))) - user_name = (char *)XSTRING_DATA((Fuser_login_name (Qnil))); - else - user_name = ""; - if (STRINGP (Fsystem_name ())) - host_name = (char *)XSTRING_DATA((Fsystem_name ())); - else - host_name = ""; - lock_info_str = (char *)alloca (strlen (user_name) + strlen (host_name) - + LOCK_PID_MAX + 5); - - sprintf (lock_info_str, "%s@%s.%lu", user_name, host_name, - (unsigned long) getpid ()); - - err = symlink (lock_info_str, lfname); - if (errno == EEXIST && force) - { - unlink (lfname); - err = symlink (lock_info_str, lfname); - } - - return err == 0; -} - -/* Return 0 if nobody owns the lock file LFNAME or the lock is obsolete, - 1 if another process owns it (and set OWNER (if non-null) to info), - 2 if the current process owns it, - or -1 if something is wrong with the locking mechanism. */ - -static int -current_lock_owner (lock_info_type *owner, char *lfname) -{ - int o, p, len, ret; - int local_owner = 0; - char *at, *dot; - char *lfinfo = 0; - int bufsize = 50; - /* Read arbitrarily-long contents of symlink. Similar code in - file-symlink-p in fileio.c. */ - do - { - bufsize *= 2; - lfinfo = (char *) xrealloc (lfinfo, bufsize); - len = readlink (lfname, lfinfo, bufsize); - } - while (len >= bufsize); - - /* If nonexistent lock file, all is well; otherwise, got strange error. */ - if (len == -1) - { - xfree (lfinfo); - return errno == ENOENT ? 0 : -1; - } - - /* Link info exists, so `len' is its length. Null terminate. */ - lfinfo[len] = 0; - - /* Even if the caller doesn't want the owner info, we still have to - read it to determine return value, so allocate it. */ - if (!owner) - { - owner = (lock_info_type *) alloca (sizeof (lock_info_type)); - local_owner = 1; - } - - /* Parse USER@HOST.PID. If can't parse, return -1. */ - /* The USER is everything before the first @. */ - at = strchr (lfinfo, '@'); - dot = strrchr (lfinfo, '.'); - if (!at || !dot) { - xfree (lfinfo); - return -1; - } - len = at - lfinfo; - owner->user = (char *) xmalloc (len + 1); - strncpy (owner->user, lfinfo, len); - owner->user[len] = 0; - - /* The PID is everything after the last `.'. */ - owner->pid = atoi (dot + 1); - - /* The host is everything in between. */ - len = dot - at - 1; - owner->host = (char *) xmalloc (len + 1); - strncpy (owner->host, at + 1, len); - owner->host[len] = 0; - - /* We're done looking at the link info. */ - xfree (lfinfo); - - /* On current host? */ - if (STRINGP (Fsystem_name ()) - && strcmp (owner->host, XSTRING_DATA(Fsystem_name ())) == 0) - { - if (owner->pid == getpid ()) - ret = 2; /* We own it. */ - else if (owner->pid > 0 - && (kill (owner->pid, 0) >= 0 || errno == EPERM)) - ret = 1; /* An existing process on this machine owns it. */ - /* The owner process is dead or has a strange pid (<=0), so try to - zap the lockfile. */ - else if (unlink (lfname) < 0) - ret = -1; - else - ret = 0; - } - else - { /* If we wanted to support the check for stale locks on remote machines, - here's where we'd do it. */ - ret = 1; - } - - /* Avoid garbage. */ - if (local_owner || ret <= 0) - { - FREE_LOCK_INFO (*owner); - } - return ret; -} - -/* Lock the lock named LFNAME if possible. - Return 0 in that case. - Return positive if some other process owns the lock, and info about - that process in CLASHER. - Return -1 if cannot lock for any other reason. */ - -static int -lock_if_free (lock_info_type *clasher, char *lfname) -{ - if (lock_file_1 (lfname, 0) == 0) - { - int locker; - - if (errno != EEXIST) - return -1; - - locker = current_lock_owner (clasher, lfname); - if (locker == 2) - { - FREE_LOCK_INFO (*clasher); - return 0; /* We ourselves locked it. */ - } - else if (locker == 1) - return 1; /* Someone else has it. */ - - return -1; /* Something's wrong. */ - } - return 0; -} - -/* lock_file locks file FN, - meaning it serves notice on the world that you intend to edit that file. - This should be done only when about to modify a file-visiting - buffer previously unmodified. - Do not (normally) call this for a buffer already modified, - as either the file is already locked, or the user has already - decided to go ahead without locking. - - When this returns, either the lock is locked for us, - or the user has said to go ahead without locking. - - If the file is locked by someone else, this calls - ask-user-about-lock (a Lisp function) with two arguments, - the file name and info about the user who did the locking. - This function can signal an error, or return t meaning - take away the lock, or return nil meaning ignore the lock. */ - -void -lock_file (Lisp_Object fn) -{ - /* This function can GC. */ - /* dmoore - and can destroy current_buffer and all sorts of other - mean nasty things with pointy teeth. If you call this make sure - you protect things right. */ - /* Somebody updated the code in this function and removed the previous - comment. -slb */ - - register Lisp_Object attack, orig_fn; - register char *lfname, *locker; - lock_info_type lock_info; - struct gcpro gcpro1,gcpro2; - Lisp_Object subject_buf; - - GCPRO2 (fn, subject_buf); - orig_fn = fn; - fn = Fexpand_file_name (fn, Qnil); - - /* Create the name of the lock-file for file fn */ - MAKE_LOCK_NAME (lfname, fn); - - /* See if this file is visited and has changed on disk since it was - visited. */ - { - subject_buf = get_truename_buffer (orig_fn); - if (!NILP (subject_buf) - && NILP (Fverify_visited_file_modtime (subject_buf)) - && !NILP (Ffile_exists_p (fn))) - call1_in_buffer (XBUFFER(subject_buf), - Qask_user_about_supersession_threat, fn); - } - - /* Try to lock the lock. */ - if (lock_if_free (&lock_info, lfname) <= 0) - /* Return now if we have locked it, or if lock creation failed */ - goto done; - - /* Else consider breaking the lock */ - locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host) - + LOCK_PID_MAX + 9); - sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host, - lock_info.pid); - FREE_LOCK_INFO (lock_info); - - attack = call2_in_buffer (BUFFERP (subject_buf) ? XBUFFER (subject_buf) : - current_buffer, Qask_user_about_lock , fn, - build_string (locker)); - if (!NILP (attack)) - /* User says take the lock */ - { - lock_file_1 (lfname, 1); - goto done; - } - /* User says ignore the lock */ - done: - UNGCPRO; -} - -void -unlock_file (Lisp_Object fn) -{ - register char *lfname; - - fn = Fexpand_file_name (fn, Qnil); - - MAKE_LOCK_NAME (lfname, fn); - - if (current_lock_owner (0, lfname) == 2) - unlink (lfname); -} - -void -unlock_all_files () -{ - register Lisp_Object tail; - register struct buffer *b; - - for (tail = Vbuffer_alist; GC_CONSP (tail); tail = XCDR (tail)) - { - b = XBUFFER (XCDR (XCAR (tail))); - if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) - unlock_file (b->file_truename); - } -} - -DEFUN ("lock-buffer", Flock_buffer, 0, 1, 0, /* - Lock FILE, if current buffer is modified.\n\ -FILE defaults to current buffer's visited file,\n\ -or else nothing is done if current buffer isn't visiting a file. -*/ - (file)) -{ - if (NILP (file)) - file = current_buffer->file_truename; - CHECK_STRING (file); - if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) - && !NILP (file)) - lock_file (file); - return Qnil; -} - -DEFUN ("unlock-buffer", Funlock_buffer, 0, 0, 0, /* -Unlock the file visited in the current buffer, -if it should normally be locked. -*/ - ()) -{ - /* This function can GC */ - /* dmoore - and can destroy current_buffer and all sorts of other - mean nasty things with pointy teeth. If you call this make sure - you protect things right. */ - - if (BUF_SAVE_MODIFF (current_buffer) < BUF_MODIFF (current_buffer) - && STRINGP (current_buffer->file_truename)) - unlock_file (current_buffer->file_truename); - return Qnil; -} - -/* Unlock the file visited in buffer BUFFER. */ - - -void -unlock_buffer (struct buffer *buffer) -{ - /* This function can GC */ - /* dmoore - and can destroy current_buffer and all sorts of other - mean nasty things with pointy teeth. If you call this make sure - you protect things right. */ - if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) - && STRINGP (buffer->file_truename)) - unlock_file (buffer->file_truename); -} - -DEFUN ("file-locked-p", Ffile_locked_p, 0, 1, 0, /* - Return nil if the FILENAME is not locked,\n\ -t if it is locked by you, else a string of the name of the locker. -*/ - (filename)) -{ - Lisp_Object ret; - register char *lfname; - int owner; - lock_info_type locker; - - filename = Fexpand_file_name (filename, Qnil); - - MAKE_LOCK_NAME (lfname, filename); - - owner = current_lock_owner (&locker, lfname); - if (owner <= 0) - ret = Qnil; - else if (owner == 2) - ret = Qt; - else - ret = build_string (locker.user); - - if (owner > 0) - FREE_LOCK_INFO (locker); - - return ret; -} - - -/* Initialization functions. */ - -void -syms_of_filelock (void) -{ - /* This function can GC */ - DEFSUBR (Funlock_buffer); - DEFSUBR (Flock_buffer); - DEFSUBR (Ffile_locked_p); - - defsymbol (&Qask_user_about_supersession_threat, - "ask-user-about-supersession-threat"); - defsymbol (&Qask_user_about_lock, "ask-user-about-lock"); -} - - -#endif /* CLASH_DETECTION */ diff --git a/src/filemode.c b/src/filemode.c deleted file mode 100644 index 31f4564..0000000 --- a/src/filemode.c +++ /dev/null @@ -1,183 +0,0 @@ -/* filemode.c -- make a string describing file modes - Copyright (C) 1985, 1990, 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: FSF 19.30. */ - -#include -#include "lisp.h" - -#include "sysfile.h" - -static void mode_string (unsigned short mode, char *str); -static char ftypelet (mode_t bits); -static void rwx (unsigned short bits, char *chars); -static void setst (unsigned short bits, char *chars); - -/* filemodestring - fill in string STR with an ls-style ASCII - representation of the st_mode field of file stats block STATP. - 10 characters are stored in STR; no terminating null is added. - The characters stored in STR are: - - 0 File type. 'd' for directory, 'c' for character - special, 'b' for block special, 'm' for multiplex, - 'l' for symbolic link, 's' for socket, 'p' for fifo, - '-' for regular, '?' for any other file type - - 1 'r' if the owner may read, '-' otherwise. - - 2 'w' if the owner may write, '-' otherwise. - - 3 'x' if the owner may execute, 's' if the file is - set-user-id, '-' otherwise. - 'S' if the file is set-user-id, but the execute - bit isn't set. - - 4 'r' if group members may read, '-' otherwise. - - 5 'w' if group members may write, '-' otherwise. - - 6 'x' if group members may execute, 's' if the file is - set-group-id, '-' otherwise. - 'S' if it is set-group-id but not executable. - - 7 'r' if any user may read, '-' otherwise. - - 8 'w' if any user may write, '-' otherwise. - - 9 'x' if any user may execute, 't' if the file is "sticky" - (will be retained in swap space after execution), '-' - otherwise. - 'T' if the file is sticky but not executable. */ - -void -filemodestring (struct stat *statp, char *str) -{ - mode_string (statp->st_mode, str); -} - -/* Like filemodestring, but only the relevant part of the `struct stat' - is given as an argument. */ - -static void -mode_string (unsigned short mode, char *str) -{ - str[0] = ftypelet (mode); - rwx ((mode & 0700) << 0, &str[1]); - rwx ((mode & 0070) << 3, &str[4]); - rwx ((mode & 0007) << 6, &str[7]); - setst (mode, str); -} - -/* Return a character indicating the type of file described by - file mode BITS: - 'd' for directories - 'b' for block special files - 'c' for character special files - 'm' for multiplexor files - 'l' for symbolic links - 's' for sockets - 'p' for fifos - '-' for regular files - '?' for any other file type. */ - -static char -ftypelet (mode_t bits) -{ -#ifdef S_ISBLK - if (S_ISBLK (bits)) - return 'b'; -#endif - if (S_ISCHR (bits)) - return 'c'; - if (S_ISDIR (bits)) - return 'd'; - if (S_ISREG (bits)) - return '-'; -#ifdef S_ISFIFO - if (S_ISFIFO (bits)) - return 'p'; -#endif -#ifdef S_ISLNK - if (S_ISLNK (bits)) - return 'l'; -#endif -#ifdef S_ISSOCK - if (S_ISSOCK (bits)) - return 's'; -#endif -#ifdef S_ISMPC - if (S_ISMPC (bits)) - return 'm'; -#endif -#ifdef S_ISNWK - if (S_ISNWK (bits)) - return 'n'; -#endif - return '?'; -} - -/* Look at read, write, and execute bits in BITS and set - flags in CHARS accordingly. */ - -static void -rwx (unsigned short bits, char *chars) -{ - chars[0] = (bits & S_IRUSR) ? 'r' : '-'; - chars[1] = (bits & S_IWUSR) ? 'w' : '-'; - chars[2] = (bits & S_IXUSR) ? 'x' : '-'; -} - -/* Set the 's' and 't' flags in file attributes string CHARS, - according to the file mode BITS. */ - -static void -setst (unsigned short bits, char *chars) -{ -#ifdef S_ISUID - if (bits & S_ISUID) - { - if (chars[3] != 'x') - /* Set-uid, but not executable by owner. */ - chars[3] = 'S'; - else - chars[3] = 's'; - } -#endif -#ifdef S_ISGID - if (bits & S_ISGID) - { - if (chars[6] != 'x') - /* Set-gid, but not executable by group. */ - chars[6] = 'S'; - else - chars[6] = 's'; - } -#endif -#ifdef S_ISVTX - if (bits & S_ISVTX) - { - if (chars[9] != 'x') - /* Sticky, but not executable by others. */ - chars[9] = 'T'; - else - chars[9] = 't'; - } -#endif -} diff --git a/src/floatfns.c b/src/floatfns.c deleted file mode 100644 index 56a78a4..0000000 --- a/src/floatfns.c +++ /dev/null @@ -1,1065 +0,0 @@ -/* Primitive operations on floating point for XEmacs Lisp interpreter. - Copyright (C) 1988, 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: FSF 19.30. */ - -/* ANSI C requires only these float functions: - acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, - frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. - - Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. - Define HAVE_CBRT if you have cbrt(). - Define HAVE_RINT if you have rint(). - If you don't define these, then the appropriate routines will be simulated. - - Define HAVE_MATHERR if on a system supporting the SysV matherr() callback. - (This should happen automatically.) - - Define FLOAT_CHECK_ERRNO if the float library routines set errno. - This has no effect if HAVE_MATHERR is defined. - - Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. - (What systems actually do this? Let me know. -jwz) - - Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by - either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and - range checking will happen before calling the float routines. This has - no effect if HAVE_MATHERR is defined (since matherr will be called when - a domain error occurs). - */ - -#include -#include "lisp.h" -#include "syssignal.h" - -#ifdef LISP_FLOAT_TYPE - -/* Need to define a differentiating symbol -- see sysfloat.h */ -#define THIS_FILENAME floatfns -#include "sysfloat.h" - -#ifndef HAVE_RINT -static double -rint (double x) -{ - double r = floor (x + 0.5); - double diff = fabs (r - x); - /* Round to even and correct for any roundoff errors. */ - if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0))) - r += r < x ? 1.0 : -1.0; - return r; -} -#endif - -/* Nonzero while executing in floating point. - This tells float_error what to do. */ -static int in_float; - -/* If an argument is out of range for a mathematical function, - here is the actual argument value to use in the error message. */ -static Lisp_Object float_error_arg, float_error_arg2; -static CONST char *float_error_fn_name; - -/* Evaluate the floating point expression D, recording NUM - as the original argument for error messages. - D is normally an assignment expression. - Handle errors which may result in signals or may set errno. - - Note that float_error may be declared to return void, so you can't - just cast the zero after the colon to (SIGTYPE) to make the types - check properly. */ -#ifdef FLOAT_CHECK_ERRNO -#define IN_FLOAT(d, name, num) \ - do { \ - float_error_arg = num; \ - float_error_fn_name = name; \ - in_float = 1; errno = 0; (d); in_float = 0; \ - if (errno != 0) in_float_error (); \ - } while (0) -#define IN_FLOAT2(d, name, num, num2) \ - do { \ - float_error_arg = num; \ - float_error_arg2 = num2; \ - float_error_fn_name = name; \ - in_float = 2; errno = 0; (d); in_float = 0; \ - if (errno != 0) in_float_error (); \ - } while (0) -#else -#define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) -#define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0) -#endif - - -#define arith_error(op,arg) \ - Fsignal (Qarith_error, list2 (build_string ((op)), (arg))) -#define range_error(op,arg) \ - Fsignal (Qrange_error, list2 (build_string ((op)), (arg))) -#define range_error2(op,a1,a2) \ - Fsignal (Qrange_error, list3 (build_string ((op)), (a1), (a2))) -#define domain_error(op,arg) \ - Fsignal (Qdomain_error, list2 (build_string ((op)), (arg))) -#define domain_error2(op,a1,a2) \ - Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2))) - - -/* Convert float to Lisp Integer if it fits, else signal a range - error using the given arguments. */ -static Lisp_Object -float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2) -{ - if (x >= ((EMACS_INT) 1 << (VALBITS-1)) - || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1) - { - if (!UNBOUNDP (num2)) - range_error2 (name, num, num2); - else - range_error (name, num); - } - return (make_int ((EMACS_INT) x)); -} - - -static void -in_float_error (void) -{ - switch (errno) - { - case 0: - break; - case EDOM: - if (in_float == 2) - domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2); - else - domain_error (float_error_fn_name, float_error_arg); - break; - case ERANGE: - range_error (float_error_fn_name, float_error_arg); - break; - default: - arith_error (float_error_fn_name, float_error_arg); - break; - } -} - - -static Lisp_Object -mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - return Qnil; -} - -static int -float_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - return (extract_float (obj1) == extract_float (obj2)); -} - -static unsigned long -float_hash (Lisp_Object obj, int depth) -{ - /* mod the value down to 32-bit range */ - /* #### change for 64-bit machines */ - return (unsigned long) fmod (extract_float (obj), 4e9); -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, - mark_float, print_float, 0, float_equal, - float_hash, struct Lisp_Float); - -/* Extract a Lisp number as a `double', or signal an error. */ - -double -extract_float (Lisp_Object num) -{ - if (FLOATP (num)) - return XFLOAT_DATA (num); - - if (INTP (num)) - return (double) XINT (num); - - return extract_float (wrong_type_argument (num, Qnumberp)); -} -#endif /* LISP_FLOAT_TYPE */ - - -/* Trig functions. */ -#ifdef LISP_FLOAT_TYPE - -DEFUN ("acos", Facos, 1, 1, 0, /* -Return the inverse cosine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 1.0 || d < -1.0) - domain_error ("acos", arg); -#endif - IN_FLOAT (d = acos (d), "acos", arg); - return make_float (d); -} - -DEFUN ("asin", Fasin, 1, 1, 0, /* -Return the inverse sine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 1.0 || d < -1.0) - domain_error ("asin", arg); -#endif - IN_FLOAT (d = asin (d), "asin", arg); - return make_float (d); -} - -DEFUN ("atan", Fatan, 1, 2, 0, /* -Return the inverse tangent of ARG. -*/ - (arg1, arg2)) -{ - double d = extract_float (arg1); - - if (NILP (arg2)) - IN_FLOAT (d = atan (d), "atan", arg1); - else - { - double d2 = extract_float (arg2); -#ifdef FLOAT_CHECK_DOMAIN - if (d == 0.0 && d2 == 0.0) - domain_error2 ("atan", arg1, arg2); -#endif - IN_FLOAT2 (d = atan2 (d, d2), "atan", arg1, arg2); - } - return make_float (d); -} - -DEFUN ("cos", Fcos, 1, 1, 0, /* -Return the cosine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = cos (d), "cos", arg); - return make_float (d); -} - -DEFUN ("sin", Fsin, 1, 1, 0, /* -Return the sine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = sin (d), "sin", arg); - return make_float (d); -} - -DEFUN ("tan", Ftan, 1, 1, 0, /* -Return the tangent of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - double c = cos (d); -#ifdef FLOAT_CHECK_DOMAIN - if (c == 0.0) - domain_error ("tan", arg); -#endif - IN_FLOAT (d = (sin (d) / c), "tan", arg); - return make_float (d); -} -#endif /* LISP_FLOAT_TYPE (trig functions) */ - - -/* Bessel functions */ -#if 0 /* Leave these out unless we find there's a reason for them. */ -/* #ifdef LISP_FLOAT_TYPE */ - -DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* -Return the bessel function j0 of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = j0 (d), "bessel-j0", arg); - return make_float (d); -} - -DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /* -Return the bessel function j1 of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = j1 (d), "bessel-j1", arg); - return make_float (d); -} - -DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /* -Return the order N bessel function output jn of ARG. -The first arg (the order) is truncated to an integer. -*/ - (arg1, arg2)) -{ - int i1 = extract_float (arg1); - double f2 = extract_float (arg2); - - IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", arg1); - return make_float (f2); -} - -DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /* -Return the bessel function y0 of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = y0 (d), "bessel-y0", arg); - return make_float (d); -} - -DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /* -Return the bessel function y1 of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = y1 (d), "bessel-y0", arg); - return make_float (d); -} - -DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /* -Return the order N bessel function output yn of ARG. -The first arg (the order) is truncated to an integer. -*/ - (arg1, arg2)) -{ - int i1 = extract_float (arg1); - double f2 = extract_float (arg2); - - IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", arg1); - return make_float (f2); -} - -#endif /* 0 (bessel functions) */ - -/* Error functions. */ -#if 0 /* Leave these out unless we see they are worth having. */ -/* #ifdef LISP_FLOAT_TYPE */ - -DEFUN ("erf", Ferf, 1, 1, 0, /* -Return the mathematical error function of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = erf (d), "erf", arg); - return make_float (d); -} - -DEFUN ("erfc", Ferfc, 1, 1, 0, /* -Return the complementary error function of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = erfc (d), "erfc", arg); - return make_float (d); -} - -DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /* -Return the log gamma of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = lgamma (d), "log-gamma", arg); - return make_float (d); -} - -#endif /* 0 (error functions) */ - - -/* Root and Log functions. */ - -#ifdef LISP_FLOAT_TYPE -DEFUN ("exp", Fexp, 1, 1, 0, /* -Return the exponential base e of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 709.7827) /* Assume IEEE doubles here */ - range_error ("exp", arg); - else if (d < -709.0) - return make_float (0.0); - else -#endif - IN_FLOAT (d = exp (d), "exp", arg); - return make_float (d); -} -#endif /* LISP_FLOAT_TYPE */ - - -DEFUN ("expt", Fexpt, 2, 2, 0, /* -Return the exponential ARG1 ** ARG2. -*/ - (arg1, arg2)) -{ - if (INTP (arg1) && /* common lisp spec */ - INTP (arg2)) /* don't promote, if both are ints */ - { - EMACS_INT retval; - EMACS_INT x = XINT (arg1); - EMACS_INT y = XINT (arg2); - - if (y < 0) - { - if (x == 1) - retval = 1; - else if (x == -1) - retval = (y & 1) ? -1 : 1; - else - retval = 0; - } - else - { - retval = 1; - while (y > 0) - { - if (y & 1) - retval *= x; - x *= x; - y = (EMACS_UINT) y >> 1; - } - } - return make_int (retval); - } - -#ifdef LISP_FLOAT_TYPE - { - double f1 = extract_float (arg1); - double f2 = extract_float (arg2); - /* Really should check for overflow, too */ - if (f1 == 0.0 && f2 == 0.0) - f1 = 1.0; -# ifdef FLOAT_CHECK_DOMAIN - else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) - domain_error2 ("expt", arg1, arg2); -# endif /* FLOAT_CHECK_DOMAIN */ - IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2); - return make_float (f1); - } -#else - CHECK_INT_OR_FLOAT (arg1); - CHECK_INT_OR_FLOAT (arg2); - return Fexpt (arg1, arg2); -#endif /* LISP_FLOAT_TYPE */ -} - -#ifdef LISP_FLOAT_TYPE -DEFUN ("log", Flog, 1, 2, 0, /* -Return the natural logarithm of ARG. -If second optional argument BASE is given, return log ARG using that base. -*/ - (arg, base)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d <= 0.0) - domain_error2 ("log", arg, base); -#endif - if (NILP (base)) - IN_FLOAT (d = log (d), "log", arg); - else - { - double b = extract_float (base); -#ifdef FLOAT_CHECK_DOMAIN - if (b <= 0.0 || b == 1.0) - domain_error2 ("log", arg, base); -#endif - if (b == 10.0) - IN_FLOAT2 (d = log10 (d), "log", arg, base); - else - IN_FLOAT2 (d = (log (d) / log (b)), "log", arg, base); - } - return make_float (d); -} - - -DEFUN ("log10", Flog10, 1, 1, 0, /* -Return the logarithm base 10 of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d <= 0.0) - domain_error ("log10", arg); -#endif - IN_FLOAT (d = log10 (d), "log10", arg); - return make_float (d); -} - - -DEFUN ("sqrt", Fsqrt, 1, 1, 0, /* -Return the square root of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d < 0.0) - domain_error ("sqrt", arg); -#endif - IN_FLOAT (d = sqrt (d), "sqrt", arg); - return make_float (d); -} - - -DEFUN ("cube-root", Fcube_root, 1, 1, 0, /* -Return the cube root of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef HAVE_CBRT - IN_FLOAT (d = cbrt (d), "cube-root", arg); -#else - if (d >= 0.0) - IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); - else - IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); -#endif - return make_float (d); -} -#endif /* LISP_FLOAT_TYPE */ - - -/* Inverse trig functions. */ -#ifdef LISP_FLOAT_TYPE -/* #if 0 Not clearly worth adding... */ - -DEFUN ("acosh", Facosh, 1, 1, 0, /* -Return the inverse hyperbolic cosine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d < 1.0) - domain_error ("acosh", arg); -#endif -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = acosh (d), "acosh", arg); -#else - IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); -#endif - return make_float (d); -} - -DEFUN ("asinh", Fasinh, 1, 1, 0, /* -Return the inverse hyperbolic sine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = asinh (d), "asinh", arg); -#else - IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); -#endif - return make_float (d); -} - -DEFUN ("atanh", Fatanh, 1, 1, 0, /* -Return the inverse hyperbolic tangent of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d >= 1.0 || d <= -1.0) - domain_error ("atanh", arg); -#endif -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = atanh (d), "atanh", arg); -#else - IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); -#endif - return make_float (d); -} - -DEFUN ("cosh", Fcosh, 1, 1, 0, /* -Return the hyperbolic cosine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 710.0 || d < -710.0) - range_error ("cosh", arg); -#endif - IN_FLOAT (d = cosh (d), "cosh", arg); - return make_float (d); -} - -DEFUN ("sinh", Fsinh, 1, 1, 0, /* -Return the hyperbolic sine of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 710.0 || d < -710.0) - range_error ("sinh", arg); -#endif - IN_FLOAT (d = sinh (d), "sinh", arg); - return make_float (d); -} - -DEFUN ("tanh", Ftanh, 1, 1, 0, /* -Return the hyperbolic tangent of ARG. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = tanh (d), "tanh", arg); - return make_float (d); -} -#endif /* LISP_FLOAT_TYPE (inverse trig functions) */ - -/* Rounding functions */ - -DEFUN ("abs", Fabs, 1, 1, 0, /* -Return the absolute value of ARG. -*/ - (arg)) -{ -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg)) - { - IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), - "abs", arg); - return arg; - } -#endif /* LISP_FLOAT_TYPE */ - - if (INTP (arg)) - return (XINT (arg) >= 0) ? arg : make_int (- XINT (arg)); - - return Fabs (wrong_type_argument (arg, Qnumberp)); -} - -#ifdef LISP_FLOAT_TYPE -DEFUN ("float", Ffloat, 1, 1, 0, /* -Return the floating point number equal to ARG. -*/ - (arg)) -{ - if (INTP (arg)) - return make_float ((double) XINT (arg)); - - if (FLOATP (arg)) /* give 'em the same float back */ - return arg; - - return Ffloat (wrong_type_argument (arg, Qnumberp)); -} -#endif /* LISP_FLOAT_TYPE */ - - -#ifdef LISP_FLOAT_TYPE -DEFUN ("logb", Flogb, 1, 1, 0, /* -Return largest integer <= the base 2 log of the magnitude of ARG. -This is the same as the exponent of a float. -*/ - (arg)) -{ - double f = extract_float (arg); - - if (f == 0.0) - return make_int (- (int)((((EMACS_UINT) 1) << (VALBITS - 1)))); /* most-negative-fixnum */ -#ifdef HAVE_LOGB - { - Lisp_Object val; - IN_FLOAT (val = make_int ((int) logb (f)), "logb", arg); - return (val); - } -#else -#ifdef HAVE_FREXP - { - int exqp; - IN_FLOAT (frexp (f, &exqp), "logb", arg); - return (make_int (exqp - 1)); - } -#else - { - int i; - double d; - EMACS_INT val; - if (f < 0.0) - f = -f; - val = -1; - while (f < 0.5) - { - for (i = 1, d = 0.5; d * d >= f; i += i) - d *= d; - f /= d; - val -= i; - } - while (f >= 1.0) - { - for (i = 1, d = 2.0; d * d <= f; i += i) - d *= d; - f /= d; - val += i; - } - return (make_int (val)); - } -#endif /* ! HAVE_FREXP */ -#endif /* ! HAVE_LOGB */ -} -#endif /* LISP_FLOAT_TYPE */ - - -DEFUN ("ceiling", Fceiling, 1, 1, 0, /* -Return the smallest integer no less than ARG. (Round toward +inf.) -*/ - (arg)) -{ -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg)) - { - double d; - IN_FLOAT ((d = ceil (XFLOAT_DATA (arg))), "ceiling", arg); - return (float_to_int (d, "ceiling", arg, Qunbound)); - } -#endif /* LISP_FLOAT_TYPE */ - - if (INTP (arg)) - return arg; - - return Fceiling (wrong_type_argument (arg, Qnumberp)); -} - - -DEFUN ("floor", Ffloor, 1, 2, 0, /* -Return the largest integer no greater than ARG. (Round towards -inf.) -With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. -*/ - (arg, divisor)) -{ - CHECK_INT_OR_FLOAT (arg); - - if (! NILP (divisor)) - { - EMACS_INT i1, i2; - - CHECK_INT_OR_FLOAT (divisor); - -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg) || FLOATP (divisor)) - { - double f1 = extract_float (arg); - double f2 = extract_float (divisor); - - if (f2 == 0) - Fsignal (Qarith_error, Qnil); - - IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor); - return float_to_int (f1, "floor", arg, divisor); - } -#endif /* LISP_FLOAT_TYPE */ - - i1 = XINT (arg); - i2 = XINT (divisor); - - if (i2 == 0) - Fsignal (Qarith_error, Qnil); - - /* With C's /, the result is implementation-defined if either operand - is negative, so use only nonnegative operands. */ - i1 = (i2 < 0 - ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) - : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); - - return (make_int (i1)); - } - -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg)) - { - double d; - IN_FLOAT ((d = floor (XFLOAT_DATA (arg))), "floor", arg); - return (float_to_int (d, "floor", arg, Qunbound)); - } -#endif /* LISP_FLOAT_TYPE */ - - return arg; -} - -DEFUN ("round", Fround, 1, 1, 0, /* -Return the nearest integer to ARG. -*/ - (arg)) -{ -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg)) - { - double d; - /* Screw the prevailing rounding mode. */ - IN_FLOAT ((d = rint (XFLOAT_DATA (arg))), "round", arg); - return (float_to_int (d, "round", arg, Qunbound)); - } -#endif /* LISP_FLOAT_TYPE */ - - if (INTP (arg)) - return arg; - - return Fround (wrong_type_argument (arg, Qnumberp)); -} - -DEFUN ("truncate", Ftruncate, 1, 1, 0, /* -Truncate a floating point number to an integer. -Rounds the value toward zero. -*/ - (arg)) -{ -#ifdef LISP_FLOAT_TYPE - if (FLOATP (arg)) - return float_to_int (XFLOAT_DATA (arg), "truncate", arg, Qunbound); -#endif /* LISP_FLOAT_TYPE */ - - if (INTP (arg)) - return arg; - - return Ftruncate (wrong_type_argument (arg, Qnumberp)); -} - -/* Float-rounding functions. */ -#ifdef LISP_FLOAT_TYPE -/* #if 1 It's not clear these are worth adding... */ - -DEFUN ("fceiling", Ffceiling, 1, 1, 0, /* -Return the smallest integer no less than ARG, as a float. -\(Round toward +inf.\) -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = ceil (d), "fceiling", arg); - return make_float (d); -} - -DEFUN ("ffloor", Fffloor, 1, 1, 0, /* -Return the largest integer no greater than ARG, as a float. -\(Round towards -inf.\) -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = floor (d), "ffloor", arg); - return make_float (d); -} - -DEFUN ("fround", Ffround, 1, 1, 0, /* -Return the nearest integer to ARG, as a float. -*/ - (arg)) -{ - double d = extract_float (arg); - IN_FLOAT (d = rint (d), "fround", arg); - return make_float (d); -} - -DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /* -Truncate a floating point number to an integral float value. -Rounds the value toward zero. -*/ - (arg)) -{ - double d = extract_float (arg); - if (d >= 0.0) - IN_FLOAT (d = floor (d), "ftruncate", arg); - else - IN_FLOAT (d = ceil (d), "ftruncate", arg); - return make_float (d); -} - -#endif /* LISP_FLOAT_TYPE (float-rounding functions) */ - - -#ifdef LISP_FLOAT_TYPE -#ifdef FLOAT_CATCH_SIGILL -static SIGTYPE -float_error (int signo) -{ - if (! in_float) - fatal_error_signal (signo); - - EMACS_REESTABLISH_SIGNAL (signo, arith_error); - EMACS_UNBLOCK_SIGNAL (signo); - - in_float = 0; - - /* Was Fsignal(), but it just doesn't make sense for an error - occurring inside a signal handler to be restartable, considering - that anything could happen when the error is signaled and trapped - and considering the asynchronous nature of signal handlers. */ - signal_error (Qarith_error, list1 (float_error_arg)); -} - -/* Another idea was to replace the library function `infnan' - where SIGILL is signaled. */ - -#endif /* FLOAT_CATCH_SIGILL */ - -/* In C++, it is impossible to determine what type matherr expects - without some more configure magic. - We shouldn't be using matherr anyways - it's a non-standard SYSVism. */ -#if defined (HAVE_MATHERR) && !defined(__cplusplus) -int -matherr (struct exception *x) -{ - Lisp_Object args; - if (! in_float) - /* Not called from emacs-lisp float routines; do the default thing. */ - return 0; - - /* if (!strcmp (x->name, "pow")) x->name = "expt"; */ - - args = Fcons (build_string (x->name), - Fcons (make_float (x->arg1), - ((in_float == 2) - ? Fcons (make_float (x->arg2), Qnil) - : Qnil))); - switch (x->type) - { - case DOMAIN: Fsignal (Qdomain_error, args); break; - case SING: Fsignal (Qsingularity_error, args); break; - case OVERFLOW: Fsignal (Qoverflow_error, args); break; - case UNDERFLOW: Fsignal (Qunderflow_error, args); break; - default: Fsignal (Qarith_error, args); break; - } - return 1; /* don't set errno or print a message */ -} -#endif /* HAVE_MATHERR */ -#endif /* LISP_FLOAT_TYPE */ - - -void -init_floatfns_very_early (void) -{ -#ifdef LISP_FLOAT_TYPE -# ifdef FLOAT_CATCH_SIGILL - signal (SIGILL, float_error); -# endif - in_float = 0; -#endif /* LISP_FLOAT_TYPE */ -} - -void -syms_of_floatfns (void) -{ - - /* Trig functions. */ - -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Facos); - DEFSUBR (Fasin); - DEFSUBR (Fatan); - DEFSUBR (Fcos); - DEFSUBR (Fsin); - DEFSUBR (Ftan); -#endif /* LISP_FLOAT_TYPE */ - - /* Bessel functions */ - -#if 0 - DEFSUBR (Fbessel_y0); - DEFSUBR (Fbessel_y1); - DEFSUBR (Fbessel_yn); - DEFSUBR (Fbessel_j0); - DEFSUBR (Fbessel_j1); - DEFSUBR (Fbessel_jn); -#endif /* 0 */ - - /* Error functions. */ - -#if 0 - DEFSUBR (Ferf); - DEFSUBR (Ferfc); - DEFSUBR (Flog_gamma); -#endif /* 0 */ - - /* Root and Log functions. */ - -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Fexp); -#endif /* LISP_FLOAT_TYPE */ - DEFSUBR (Fexpt); -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Flog); - DEFSUBR (Flog10); - DEFSUBR (Fsqrt); - DEFSUBR (Fcube_root); -#endif /* LISP_FLOAT_TYPE */ - - /* Inverse trig functions. */ - -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Facosh); - DEFSUBR (Fasinh); - DEFSUBR (Fatanh); - DEFSUBR (Fcosh); - DEFSUBR (Fsinh); - DEFSUBR (Ftanh); -#endif /* LISP_FLOAT_TYPE */ - - /* Rounding functions */ - - DEFSUBR (Fabs); -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Ffloat); - DEFSUBR (Flogb); -#endif /* LISP_FLOAT_TYPE */ - DEFSUBR (Fceiling); - DEFSUBR (Ffloor); - DEFSUBR (Fround); - DEFSUBR (Ftruncate); - - /* Float-rounding functions. */ - -#ifdef LISP_FLOAT_TYPE - DEFSUBR (Ffceiling); - DEFSUBR (Fffloor); - DEFSUBR (Ffround); - DEFSUBR (Fftruncate); -#endif /* LISP_FLOAT_TYPE */ -} - -void -vars_of_floatfns (void) -{ -#ifdef LISP_FLOAT_TYPE - Fprovide (intern ("lisp-float-type")); -#endif -} diff --git a/src/fns.c b/src/fns.c deleted file mode 100644 index c9d19f6..0000000 --- a/src/fns.c +++ /dev/null @@ -1,3974 +0,0 @@ -/* Random utility Lisp functions. - Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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: Mule 2.0, FSF 19.30. */ - -/* This file has been Mule-ized. */ - -/* Note: FSF 19.30 has bool vectors. We have bit vectors. */ - -/* Hacked on for Mule by Ben Wing, December 1994, January 1995. */ - -#include - -/* Note on some machines this defines `vector' as a typedef, - so make sure we don't use that name in this file. */ -#undef vector -#define vector ***** - -#include "lisp.h" - -#ifdef HAVE_UNISTD_H -#include -#endif -#include - -#include "buffer.h" -#include "bytecode.h" -#include "device.h" -#include "events.h" -#include "extents.h" -#include "frame.h" -#include "systime.h" -#include "insdel.h" -#include "lstream.h" -#include "opaque.h" - -/* NOTE: This symbol is also used in lread.c */ -#define FEATUREP_SYNTAX - -Lisp_Object Qstring_lessp; -Lisp_Object Qidentity; - -static int internal_old_equal (Lisp_Object, Lisp_Object, int); - -static Lisp_Object -mark_bit_vector (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - return Qnil; -} - -static void -print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - int i; - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); - int len = bit_vector_length (v); - int last = len; - - if (INTP (Vprint_length)) - last = min (len, XINT (Vprint_length)); - write_c_string ("#*", printcharfun); - for (i = 0; i < last; i++) - { - if (bit_vector_bit (v, i)) - write_c_string ("1", printcharfun); - else - write_c_string ("0", printcharfun); - } - - if (last != len) - write_c_string ("...", printcharfun); -} - -static int -bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1); - struct Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2); - - return ((bit_vector_length (v1) == bit_vector_length (v2)) && - !memcmp (v1->bits, v2->bits, - BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) * - sizeof (long))); -} - -static unsigned long -bit_vector_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Bit_Vector *v = XBIT_VECTOR (obj); - return HASH2 (bit_vector_length (v), - memory_hash (v->bits, - BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * - sizeof (long))); -} - -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, - mark_bit_vector, print_bit_vector, 0, - bit_vector_equal, bit_vector_hash, - struct Lisp_Bit_Vector); - -DEFUN ("identity", Fidentity, 1, 1, 0, /* -Return the argument unchanged. -*/ - (arg)) -{ - return arg; -} - -extern long get_random (void); -extern void seed_random (long arg); - -DEFUN ("random", Frandom, 0, 1, 0, /* -Return a pseudo-random number. -All integers representable in Lisp are equally likely. - On most systems, this is 28 bits' worth. -With positive integer argument N, return random number in interval [0,N). -With argument t, set the random number seed from the current time and pid. -*/ - (limit)) -{ - EMACS_INT val; - unsigned long denominator; - - if (EQ (limit, Qt)) - seed_random (getpid () + time (NULL)); - if (NATNUMP (limit) && !ZEROP (limit)) - { - /* Try to take our random number from the higher bits of VAL, - not the lower, since (says Gentzel) the low bits of `random' - are less random than the higher ones. We do this by using the - quotient rather than the remainder. At the high end of the RNG - it's possible to get a quotient larger than limit; discarding - these values eliminates the bias that would otherwise appear - when using a large limit. */ - denominator = ((unsigned long)1 << VALBITS) / XINT (limit); - do - val = get_random () / denominator; - while (val >= XINT (limit)); - } - else - val = get_random (); - - return make_int (val); -} - -/* Random data-structure functions */ - -#ifdef LOSING_BYTECODE - -/* #### Delete this shit */ - -/* Charcount is a misnomer here as we might be dealing with the - length of a vector or list, but emphasizes that we're not dealing - with Bytecounts in strings */ -static Charcount -length_with_bytecode_hack (Lisp_Object seq) -{ - if (!COMPILED_FUNCTIONP (seq)) - return XINT (Flength (seq)); - else - { - struct Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (seq); - - return (f->flags.interactivep ? COMPILED_INTERACTIVE : - f->flags.domainp ? COMPILED_DOMAIN : - COMPILED_DOC_STRING) - + 1; - } -} - -#endif /* LOSING_BYTECODE */ - -void -check_losing_bytecode (CONST char *function, Lisp_Object seq) -{ - if (COMPILED_FUNCTIONP (seq)) - error_with_frob - (seq, - "As of 20.3, `%s' no longer works with compiled-function objects", - function); -} - -DEFUN ("length", Flength, 1, 1, 0, /* -Return the length of vector, bit vector, list or string SEQUENCE. -*/ - (sequence)) -{ - retry: - if (STRINGP (sequence)) - return make_int (XSTRING_CHAR_LENGTH (sequence)); - else if (CONSP (sequence)) - { - int len; - GET_EXTERNAL_LIST_LENGTH (sequence, len); - return make_int (len); - } - else if (VECTORP (sequence)) - return make_int (XVECTOR_LENGTH (sequence)); - else if (NILP (sequence)) - return Qzero; - else if (BIT_VECTORP (sequence)) - return make_int (bit_vector_length (XBIT_VECTOR (sequence))); - else - { - check_losing_bytecode ("length", sequence); - sequence = wrong_type_argument (Qsequencep, sequence); - goto retry; - } -} - -DEFUN ("safe-length", Fsafe_length, 1, 1, 0, /* -Return the length of a list, but avoid error or infinite loop. -This function never gets an error. If LIST is not really a list, -it returns 0. If LIST is circular, it returns a finite value -which is at least the number of distinct elements. -*/ - (list)) -{ - Lisp_Object hare, tortoise; - int len; - - for (hare = tortoise = list, len = 0; - CONSP (hare) && (! EQ (hare, tortoise) || len == 0); - hare = XCDR (hare), len++) - { - if (len & 1) - tortoise = XCDR (tortoise); - } - - return make_int (len); -} - -/*** string functions. ***/ - -DEFUN ("string-equal", Fstring_equal, 2, 2, 0, /* -Return t if two strings have identical contents. -Case is significant. Text properties are ignored. -\(Under XEmacs, `equal' also ignores text properties and extents in -strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20 -`equal' is the same as in XEmacs, in that respect.) -Symbols are also allowed; their print names are used instead. -*/ - (s1, s2)) -{ - Bytecount len; - struct Lisp_String *p1, *p2; - - if (SYMBOLP (s1)) - p1 = XSYMBOL (s1)->name; - else - { - CHECK_STRING (s1); - p1 = XSTRING (s1); - } - - if (SYMBOLP (s2)) - p2 = XSYMBOL (s2)->name; - else - { - CHECK_STRING (s2); - p2 = XSTRING (s2); - } - - return (((len = string_length (p1)) == string_length (p2)) && - !memcmp (string_data (p1), string_data (p2), len)) ? Qt : Qnil; -} - - -DEFUN ("string-lessp", Fstring_lessp, 2, 2, 0, /* -Return t if first arg string is less than second in lexicographic order. -If I18N2 support (but not Mule support) was compiled in, ordering is -determined by the locale. (Case is significant for the default C locale.) -In all other cases, comparison is simply done on a character-by- -character basis using the numeric value of a character. (Note that -this may not produce particularly meaningful results under Mule if -characters from different charsets are being compared.) - -Symbols are also allowed; their print names are used instead. - -The reason that the I18N2 locale-specific collation is not used under -Mule is that the locale model of internationalization does not handle -multiple charsets and thus has no hope of working properly under Mule. -What we really should do is create a collation table over all built-in -charsets. This is extremely difficult to do from scratch, however. - -Unicode is a good first step towards solving this problem. In fact, -it is quite likely that a collation table exists (or will exist) for -Unicode. When Unicode support is added to XEmacs/Mule, this problem -may be solved. -*/ - (s1, s2)) -{ - struct Lisp_String *p1, *p2; - Charcount end, len2; - int i; - - if (SYMBOLP (s1)) - p1 = XSYMBOL (s1)->name; - else - { - CHECK_STRING (s1); - p1 = XSTRING (s1); - } - - if (SYMBOLP (s2)) - p2 = XSYMBOL (s2)->name; - else - { - CHECK_STRING (s2); - p2 = XSTRING (s2); - } - - end = string_char_length (p1); - len2 = string_char_length (p2); - if (end > len2) - end = len2; - -#if defined (I18N2) && !defined (MULE) - /* There is no hope of this working under Mule. Even if we converted - the data into an external format so that strcoll() processed it - properly, it would still not work because strcoll() does not - handle multiple locales. This is the fundamental flaw in the - locale model. */ - Bytecount bcend = charcount_to_bytecount (string_data (p1), end); - /* Compare strings using collation order of locale. */ - /* Need to be tricky to handle embedded nulls. */ - - for (i = 0; i < bcend; i += strlen((char *) string_data (p1) + i) + 1) - { - int val = strcoll ((char *) string_data (p1) + i, - (char *) string_data (p2) + i); - if (val < 0) - return Qt; - if (val > 0) - return Qnil; - } -#else /* not I18N2, or MULE */ - /* #### It is not really necessary to do this: We could compare - byte-by-byte and still get a reasonable comparison, since this - would compare characters with a charset in the same way. - With a little rearrangement of the leading bytes, we could - make most inter-charset comparisons work out the same, too; - even if some don't, this is not a big deal because inter-charset - comparisons aren't really well-defined anyway. */ - for (i = 0; i < end; i++) - { - if (string_char (p1, i) != string_char (p2, i)) - return string_char (p1, i) < string_char (p2, i) ? Qt : Qnil; - } -#endif /* not I18N2, or MULE */ - /* Can't do i < len2 because then comparison between "foo" and "foo^@" - won't work right in I18N2 case */ - return end < len2 ? Qt : Qnil; -} - -DEFUN ("string-modified-tick", Fstring_modified_tick, 1, 1, 0, /* -Return STRING's tick counter, incremented for each change to the string. -Each string has a tick counter which is incremented each time the contents -of the string are changed (e.g. with `aset'). It wraps around occasionally. -*/ - (string)) -{ - struct Lisp_String *s; - - CHECK_STRING (string); - s = XSTRING (string); - if (CONSP (s->plist) && INTP (XCAR (s->plist))) - return XCAR (s->plist); - else - return Qzero; -} - -void -bump_string_modiff (Lisp_Object str) -{ - struct Lisp_String *s = XSTRING (str); - Lisp_Object *ptr = &s->plist; - -#ifdef I18N3 - /* #### remove the `string-translatable' property from the string, - if there is one. */ -#endif - /* skip over extent info if it's there */ - if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) - ptr = &XCDR (*ptr); - if (CONSP (*ptr) && INTP (XCAR (*ptr))) - XSETINT (XCAR (*ptr), 1+XINT (XCAR (*ptr))); - else - *ptr = Fcons (make_int (1), *ptr); -} - - -enum concat_target_type { c_cons, c_string, c_vector, c_bit_vector }; -static Lisp_Object concat (int nargs, Lisp_Object *args, - enum concat_target_type target_type, - int last_special); - -Lisp_Object -concat2 (Lisp_Object s1, Lisp_Object s2) -{ - Lisp_Object args[2]; - args[0] = s1; - args[1] = s2; - return concat (2, args, c_string, 0); -} - -Lisp_Object -concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) -{ - Lisp_Object args[3]; - args[0] = s1; - args[1] = s2; - args[2] = s3; - return concat (3, args, c_string, 0); -} - -Lisp_Object -vconcat2 (Lisp_Object s1, Lisp_Object s2) -{ - Lisp_Object args[2]; - args[0] = s1; - args[1] = s2; - return concat (2, args, c_vector, 0); -} - -Lisp_Object -vconcat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) -{ - Lisp_Object args[3]; - args[0] = s1; - args[1] = s2; - args[2] = s3; - return concat (3, args, c_vector, 0); -} - -DEFUN ("append", Fappend, 0, MANY, 0, /* -Concatenate all the arguments and make the result a list. -The result is a list whose elements are the elements of all the arguments. -Each argument may be a list, vector, bit vector, or string. -The last argument is not copied, just used as the tail of the new list. -Also see: `nconc'. -*/ - (int nargs, Lisp_Object *args)) -{ - return concat (nargs, args, c_cons, 1); -} - -DEFUN ("concat", Fconcat, 0, MANY, 0, /* -Concatenate all the arguments and make the result a string. -The result is a string whose elements are the elements of all the arguments. -Each argument may be a string or a list or vector of characters. - -As of XEmacs 21.0, this function does NOT accept individual integers -as arguments. Old code that relies on, for example, (concat "foo" 50) -returning "foo50" will fail. To fix such code, either apply -`int-to-string' to the integer argument, or use `format'. -*/ - (int nargs, Lisp_Object *args)) -{ - return concat (nargs, args, c_string, 0); -} - -DEFUN ("vconcat", Fvconcat, 0, MANY, 0, /* -Concatenate all the arguments and make the result a vector. -The result is a vector whose elements are the elements of all the arguments. -Each argument may be a list, vector, bit vector, or string. -*/ - (int nargs, Lisp_Object *args)) -{ - return concat (nargs, args, c_vector, 0); -} - -DEFUN ("bvconcat", Fbvconcat, 0, MANY, 0, /* -Concatenate all the arguments and make the result a bit vector. -The result is a bit vector whose elements are the elements of all the -arguments. Each argument may be a list, vector, bit vector, or string. -*/ - (int nargs, Lisp_Object *args)) -{ - return concat (nargs, args, c_bit_vector, 0); -} - -/* Copy a (possibly dotted) list. LIST must be a cons. - Can't use concat (1, &alist, c_cons, 0) - doesn't handle dotted lists. */ -static Lisp_Object -copy_list (Lisp_Object list) -{ - Lisp_Object list_copy = Fcons (XCAR (list), XCDR (list)); - Lisp_Object last = list_copy; - Lisp_Object hare, tortoise; - int len; - - for (tortoise = hare = XCDR (list), len = 1; - CONSP (hare); - hare = XCDR (hare), len++) - { - XCDR (last) = Fcons (XCAR (hare), XCDR (hare)); - last = XCDR (last); - - if (len < CIRCULAR_LIST_SUSPICION_LENGTH) - continue; - if (len & 1) - tortoise = XCDR (tortoise); - if (EQ (tortoise, hare)) - signal_circular_list_error (list); - } - - return list_copy; -} - -DEFUN ("copy-list", Fcopy_list, 1, 1, 0, /* -Return a copy of list LIST, which may be a dotted list. -The elements of LIST are not copied; they are shared -with the original. -*/ - (list)) -{ - again: - if (NILP (list)) return list; - if (CONSP (list)) return copy_list (list); - - list = wrong_type_argument (Qlistp, list); - goto again; -} - -DEFUN ("copy-sequence", Fcopy_sequence, 1, 1, 0, /* -Return a copy of list, vector, bit vector or string SEQUENCE. -The elements of a list or vector are not copied; they are shared -with the original. SEQUENCE may be a dotted list. -*/ - (sequence)) -{ - again: - if (NILP (sequence)) return sequence; - if (CONSP (sequence)) return copy_list (sequence); - if (STRINGP (sequence)) return concat (1, &sequence, c_string, 0); - if (VECTORP (sequence)) return concat (1, &sequence, c_vector, 0); - if (BIT_VECTORP (sequence)) return concat (1, &sequence, c_bit_vector, 0); - - check_losing_bytecode ("copy-sequence", sequence); - sequence = wrong_type_argument (Qsequencep, sequence); - goto again; -} - -struct merge_string_extents_struct -{ - Lisp_Object string; - Bytecount entry_offset; - Bytecount entry_length; -}; - -static Lisp_Object -concat (int nargs, Lisp_Object *args, - enum concat_target_type target_type, - int last_special) -{ - Lisp_Object val; - Lisp_Object tail = Qnil; - int toindex; - int argnum; - Lisp_Object last_tail; - Lisp_Object prev; - struct merge_string_extents_struct *args_mse = 0; - Bufbyte *string_result = 0; - Bufbyte *string_result_ptr = 0; - struct gcpro gcpro1; - - /* The modus operandi in Emacs is "caller gc-protects args". - However, concat is called many times in Emacs on freshly - created stuff. So we help those callers out by protecting - the args ourselves to save them a lot of temporary-variable - grief. */ - - GCPRO1 (args[0]); - gcpro1.nvars = nargs; - -#ifdef I18N3 - /* #### if the result is a string and any of the strings have a string - for the `string-translatable' property, then concat should also - concat the args but use the `string-translatable' strings, and store - the result in the returned string's `string-translatable' property. */ -#endif - if (target_type == c_string) - args_mse = alloca_array (struct merge_string_extents_struct, nargs); - - /* In append, the last arg isn't treated like the others */ - if (last_special && nargs > 0) - { - nargs--; - last_tail = args[nargs]; - } - else - last_tail = Qnil; - - /* Check and coerce the arguments. */ - for (argnum = 0; argnum < nargs; argnum++) - { - Lisp_Object seq = args[argnum]; - if (LISTP (seq)) - ; - else if (VECTORP (seq) || STRINGP (seq) || BIT_VECTORP (seq)) - ; -#ifdef LOSING_BYTECODE - else if (COMPILED_FUNCTIONP (seq)) - /* Urk! We allow this, for "compatibility"... */ - ; -#endif -#if 0 /* removed for XEmacs 21 */ - else if (INTP (seq)) - /* This is too revolting to think about but maintains - compatibility with FSF (and lots and lots of old code). */ - args[argnum] = Fnumber_to_string (seq); -#endif - else - { - check_losing_bytecode ("concat", seq); - args[argnum] = wrong_type_argument (Qsequencep, seq); - } - - if (args_mse) - { - if (STRINGP (seq)) - args_mse[argnum].string = seq; - else - args_mse[argnum].string = Qnil; - } - } - - { - /* Charcount is a misnomer here as we might be dealing with the - length of a vector or list, but emphasizes that we're not dealing - with Bytecounts in strings */ - Charcount total_length; - - for (argnum = 0, total_length = 0; argnum < nargs; argnum++) - { -#ifdef LOSING_BYTECODE - Charcount thislen = length_with_bytecode_hack (args[argnum]); -#else - Charcount thislen = XINT (Flength (args[argnum])); -#endif - total_length += thislen; - } - - switch (target_type) - { - case c_cons: - if (total_length == 0) - /* In append, if all but last arg are nil, return last arg */ - RETURN_UNGCPRO (last_tail); - val = Fmake_list (make_int (total_length), Qnil); - break; - case c_vector: - val = make_vector (total_length, Qnil); - break; - case c_bit_vector: - val = make_bit_vector (total_length, Qzero); - break; - case c_string: - /* We don't make the string yet because we don't know the - actual number of bytes. This loop was formerly written - to call Fmake_string() here and then call set_string_char() - for each char. This seems logical enough but is waaaaaaaay - slow -- set_string_char() has to scan the whole string up - to the place where the substitution is called for in order - to find the place to change, and may have to do some - realloc()ing in order to make the char fit properly. - O(N^2) yuckage. */ - val = Qnil; - string_result = (Bufbyte *) alloca (total_length * MAX_EMCHAR_LEN); - string_result_ptr = string_result; - break; - default: - abort (); - } - } - - - if (CONSP (val)) - tail = val, toindex = -1; /* -1 in toindex is flag we are - making a list */ - else - toindex = 0; - - prev = Qnil; - - for (argnum = 0; argnum < nargs; argnum++) - { - Charcount thisleni = 0; - Charcount thisindex = 0; - Lisp_Object seq = args[argnum]; - Bufbyte *string_source_ptr = 0; - Bufbyte *string_prev_result_ptr = string_result_ptr; - - if (!CONSP (seq)) - { -#ifdef LOSING_BYTECODE - thisleni = length_with_bytecode_hack (seq); -#else - thisleni = XINT (Flength (seq)); -#endif - } - if (STRINGP (seq)) - string_source_ptr = XSTRING_DATA (seq); - - while (1) - { - Lisp_Object elt; - - /* We've come to the end of this arg, so exit. */ - if (NILP (seq)) - break; - - /* Fetch next element of `seq' arg into `elt' */ - if (CONSP (seq)) - { - elt = XCAR (seq); - seq = XCDR (seq); - } - else - { - if (thisindex >= thisleni) - break; - - if (STRINGP (seq)) - { - elt = make_char (charptr_emchar (string_source_ptr)); - INC_CHARPTR (string_source_ptr); - } - else if (VECTORP (seq)) - elt = XVECTOR_DATA (seq)[thisindex]; - else if (BIT_VECTORP (seq)) - elt = make_int (bit_vector_bit (XBIT_VECTOR (seq), - thisindex)); - else - elt = Felt (seq, make_int (thisindex)); - thisindex++; - } - - /* Store into result */ - if (toindex < 0) - { - /* toindex negative means we are making a list */ - XCAR (tail) = elt; - prev = tail; - tail = XCDR (tail); - } - else if (VECTORP (val)) - XVECTOR_DATA (val)[toindex++] = elt; - else if (BIT_VECTORP (val)) - { - CHECK_BIT (elt); - set_bit_vector_bit (XBIT_VECTOR (val), toindex++, XINT (elt)); - } - else - { - CHECK_CHAR_COERCE_INT (elt); - string_result_ptr += set_charptr_emchar (string_result_ptr, - XCHAR (elt)); - } - } - if (args_mse) - { - args_mse[argnum].entry_offset = - string_prev_result_ptr - string_result; - args_mse[argnum].entry_length = - string_result_ptr - string_prev_result_ptr; - } - } - - /* Now we finally make the string. */ - if (target_type == c_string) - { - val = make_string (string_result, string_result_ptr - string_result); - for (argnum = 0; argnum < nargs; argnum++) - { - if (STRINGP (args_mse[argnum].string)) - copy_string_extents (val, args_mse[argnum].string, - args_mse[argnum].entry_offset, 0, - args_mse[argnum].entry_length); - } - } - - if (!NILP (prev)) - XCDR (prev) = last_tail; - - RETURN_UNGCPRO (val); -} - -DEFUN ("copy-alist", Fcopy_alist, 1, 1, 0, /* -Return a copy of ALIST. -This is an alist which represents the same mapping from objects to objects, -but does not share the alist structure with ALIST. -The objects mapped (cars and cdrs of elements of the alist) -are shared, however. -Elements of ALIST that are not conses are also shared. -*/ - (alist)) -{ - Lisp_Object tail; - - if (NILP (alist)) - return alist; - CHECK_CONS (alist); - - alist = concat (1, &alist, c_cons, 0); - for (tail = alist; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object car = XCAR (tail); - - if (CONSP (car)) - XCAR (tail) = Fcons (XCAR (car), XCDR (car)); - } - return alist; -} - -DEFUN ("copy-tree", Fcopy_tree, 1, 2, 0, /* -Return a copy of a list and substructures. -The argument is copied, and any lists contained within it are copied -recursively. Circularities and shared substructures are not preserved. -Second arg VECP causes vectors to be copied, too. Strings and bit vectors -are not copied. -*/ - (arg, vecp)) -{ - if (CONSP (arg)) - { - Lisp_Object rest; - rest = arg = Fcopy_sequence (arg); - while (CONSP (rest)) - { - Lisp_Object elt = XCAR (rest); - QUIT; - if (CONSP (elt) || VECTORP (elt)) - XCAR (rest) = Fcopy_tree (elt, vecp); - if (VECTORP (XCDR (rest))) /* hack for (a b . [c d]) */ - XCDR (rest) = Fcopy_tree (XCDR (rest), vecp); - rest = XCDR (rest); - } - } - else if (VECTORP (arg) && ! NILP (vecp)) - { - int i = XVECTOR_LENGTH (arg); - int j; - arg = Fcopy_sequence (arg); - for (j = 0; j < i; j++) - { - Lisp_Object elt = XVECTOR_DATA (arg) [j]; - QUIT; - if (CONSP (elt) || VECTORP (elt)) - XVECTOR_DATA (arg) [j] = Fcopy_tree (elt, vecp); - } - } - return arg; -} - -DEFUN ("substring", Fsubstring, 2, 3, 0, /* -Return a substring of STRING, starting at index FROM and ending before TO. -TO may be nil or omitted; then the substring runs to the end of STRING. -If FROM or TO is negative, it counts from the end. -Relevant parts of the string-extent-data are copied in the new string. -*/ - (string, from, to)) -{ - Charcount ccfr, ccto; - Bytecount bfr, bto; - Lisp_Object val; - - CHECK_STRING (string); - CHECK_INT (from); - get_string_range_char (string, from, to, &ccfr, &ccto, - GB_HISTORICAL_STRING_BEHAVIOR); - bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr); - bto = charcount_to_bytecount (XSTRING_DATA (string), ccto); - val = make_string (XSTRING_DATA (string) + bfr, bto - bfr); - /* Copy any applicable extent information into the new string: */ - copy_string_extents (val, string, 0, bfr, bto - bfr); - return val; -} - -DEFUN ("subseq", Fsubseq, 2, 3, 0, /* -Return a subsequence of SEQ, starting at index FROM and ending before TO. -TO may be nil or omitted; then the subsequence runs to the end of SEQ. -If FROM or TO is negative, it counts from the end. -The resulting subsequence is always the same type as the original - sequence. -If SEQ is a string, relevant parts of the string-extent-data are copied - to the new string. -*/ - (seq, from, to)) -{ - int len, f, t; - - if (STRINGP (seq)) - return Fsubstring (seq, from, to); - - if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq)) - { - check_losing_bytecode ("subseq", seq); - seq = wrong_type_argument (Qsequencep, seq); - } - - len = XINT (Flength (seq)); - - CHECK_INT (from); - f = XINT (from); - if (f < 0) - f = len + f; - - if (NILP (to)) - t = len; - else - { - CHECK_INT (to); - t = XINT (to); - if (t < 0) - t = len + t; - } - - if (!(0 <= f && f <= t && t <= len)) - args_out_of_range_3 (seq, make_int (f), make_int (t)); - - if (VECTORP (seq)) - { - Lisp_Object result = make_vector (t - f, Qnil); - int i; - Lisp_Object *in_elts = XVECTOR_DATA (seq); - Lisp_Object *out_elts = XVECTOR_DATA (result); - - for (i = f; i < t; i++) - out_elts[i - f] = in_elts[i]; - return result; - } - - if (LISTP (seq)) - { - Lisp_Object result = Qnil; - int i; - - seq = Fnthcdr (make_int (f), seq); - - for (i = f; i < t; i++) - { - result = Fcons (Fcar (seq), result); - seq = Fcdr (seq); - } - - return Fnreverse (result); - } - - /* bit vector */ - { - Lisp_Object result = make_bit_vector (t - f, Qzero); - int i; - - for (i = f; i < t; i++) - set_bit_vector_bit (XBIT_VECTOR (result), i - f, - bit_vector_bit (XBIT_VECTOR (seq), i)); - return result; - } -} - - -DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* -Take cdr N times on LIST, and return the result. -*/ - (n, list)) -{ - REGISTER int i; - REGISTER Lisp_Object tail = list; - CHECK_NATNUM (n); - for (i = XINT (n); i; i--) - { - if (CONSP (tail)) - tail = XCDR (tail); - else if (NILP (tail)) - return Qnil; - else - { - tail = wrong_type_argument (Qlistp, tail); - i++; - } - } - return tail; -} - -DEFUN ("nth", Fnth, 2, 2, 0, /* -Return the Nth element of LIST. -N counts from zero. If LIST is not that long, nil is returned. -*/ - (n, list)) -{ - return Fcar (Fnthcdr (n, list)); -} - -DEFUN ("elt", Felt, 2, 2, 0, /* -Return element of SEQUENCE at index N. -*/ - (sequence, n)) -{ - retry: - CHECK_INT_COERCE_CHAR (n); /* yuck! */ - if (LISTP (sequence)) - { - Lisp_Object tem = Fnthcdr (n, sequence); - /* #### Utterly, completely, fucking disgusting. - * #### The whole point of "elt" is that it operates on - * #### sequences, and does error- (bounds-) checking. - */ - if (CONSP (tem)) - return XCAR (tem); - else -#if 1 - /* This is The Way It Has Always Been. */ - return Qnil; -#else - /* This is The Way Mly and Cltl2 say It Should Be. */ - args_out_of_range (sequence, n); -#endif - } - else if (STRINGP (sequence) || - VECTORP (sequence) || - BIT_VECTORP (sequence)) - return Faref (sequence, n); -#ifdef LOSING_BYTECODE - else if (COMPILED_FUNCTIONP (sequence)) - { - int idx = XINT (n); - if (idx < 0) - { - lose: - args_out_of_range (sequence, n); - } - /* Utter perversity */ - { - Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (sequence); - switch (idx) - { - case COMPILED_ARGLIST: - return compiled_function_arglist (f); - case COMPILED_INSTRUCTIONS: - return compiled_function_instructions (f); - case COMPILED_CONSTANTS: - return compiled_function_constants (f); - case COMPILED_STACK_DEPTH: - return compiled_function_stack_depth (f); - case COMPILED_DOC_STRING: - return compiled_function_documentation (f); - case COMPILED_DOMAIN: - return compiled_function_domain (f); - case COMPILED_INTERACTIVE: - if (f->flags.interactivep) - return compiled_function_interactive (f); - /* if we return nil, can't tell interactive with no args - from noninteractive. */ - goto lose; - default: - goto lose; - } - } - } -#endif /* LOSING_BYTECODE */ - else - { - check_losing_bytecode ("elt", sequence); - sequence = wrong_type_argument (Qsequencep, sequence); - goto retry; - } -} - -DEFUN ("last", Flast, 1, 2, 0, /* -Return the tail of list LIST, of length N (default 1). -LIST may be a dotted list, but not a circular list. -Optional argument N must be a non-negative integer. -If N is zero, then the atom that terminates the list is returned. -If N is greater than the length of LIST, then LIST itself is returned. -*/ - (list, n)) -{ - int int_n, count; - Lisp_Object retval, tortoise, hare; - - CHECK_LIST (list); - - if (NILP (n)) - int_n = 1; - else - { - CHECK_NATNUM (n); - int_n = XINT (n); - } - - for (retval = tortoise = hare = list, count = 0; - CONSP (hare); - hare = XCDR (hare), - (int_n-- <= 0 ? ((void) (retval = XCDR (retval))) : (void)0), - count++) - { - if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - if (count & 1) - tortoise = XCDR (tortoise); - if (EQ (hare, tortoise)) - signal_circular_list_error (list); - } - - return retval; -} - -DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /* -Modify LIST to remove the last N (default 1) elements. -If LIST has N or fewer elements, nil is returned and LIST is unmodified. -*/ - (list, n)) -{ - int int_n; - - CHECK_LIST (list); - - if (NILP (n)) - int_n = 1; - else - { - CHECK_NATNUM (n); - int_n = XINT (n); - } - - { - Lisp_Object last_cons = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (int_n-- < 0) - last_cons = XCDR (last_cons); - } - - if (int_n >= 0) - return Qnil; - - XCDR (last_cons) = Qnil; - return list; - } -} - -DEFUN ("butlast", Fbutlast, 1, 2, 0, /* -Return a copy of LIST with the last N (default 1) elements removed. -If LIST has N or fewer elements, nil is returned. -*/ - (list, n)) -{ - int int_n; - - CHECK_LIST (list); - - if (NILP (n)) - int_n = 1; - else - { - CHECK_NATNUM (n); - int_n = XINT (n); - } - - { - Lisp_Object retval = Qnil; - Lisp_Object tail = list; - - EXTERNAL_LIST_LOOP_1 (list) - { - if (--int_n < 0) - { - retval = Fcons (XCAR (tail), retval); - tail = XCDR (tail); - } - } - - return Fnreverse (retval); - } -} - -DEFUN ("member", Fmember, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `equal'. -The value is actually the tail of LIST whose car is ELT. -*/ - (elt, list)) -{ - Lisp_Object list_elt, tail; - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (internal_equal (elt, list_elt, 0)) - return tail; - } - return Qnil; -} - -DEFUN ("old-member", Fold_member, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-equal'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - Lisp_Object list_elt, tail; - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (internal_old_equal (elt, list_elt, 0)) - return tail; - } - return Qnil; -} - -DEFUN ("memq", Fmemq, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `eq'. -The value is actually the tail of LIST whose car is ELT. -*/ - (elt, list)) -{ - Lisp_Object list_elt, tail; - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) - return tail; - } - return Qnil; -} - -DEFUN ("old-memq", Fold_memq, 2, 2, 0, /* -Return non-nil if ELT is an element of LIST. Comparison done with `old-eq'. -The value is actually the tail of LIST whose car is ELT. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (elt, list)) -{ - Lisp_Object list_elt, tail; - EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) - { - if (HACKEQ_UNSAFE (elt, list_elt)) - return tail; - } - return Qnil; -} - -Lisp_Object -memq_no_quit (Lisp_Object elt, Lisp_Object list) -{ - Lisp_Object list_elt, tail; - LIST_LOOP_3 (list_elt, list, tail) - { - if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) - return tail; - } - return Qnil; -} - -DEFUN ("assoc", Fassoc, 2, 2, 0, /* -Return non-nil if KEY is `equal' to the car of an element of LIST. -The value is actually the element of LIST whose car equals KEY. -*/ - (key, list)) -{ - /* This function can GC. */ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (internal_equal (key, elt_car, 0)) - return elt; - } - return Qnil; -} - -DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* -Return non-nil if KEY is `old-equal' to the car of an element of LIST. -The value is actually the element of LIST whose car equals KEY. -*/ - (key, list)) -{ - /* This function can GC. */ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (internal_old_equal (key, elt_car, 0)) - return elt; - } - return Qnil; -} - -Lisp_Object -assoc_no_quit (Lisp_Object key, Lisp_Object list) -{ - int speccount = specpdl_depth (); - specbind (Qinhibit_quit, Qt); - return unbind_to (speccount, Fassoc (key, list)); -} - -DEFUN ("assq", Fassq, 2, 2, 0, /* -Return non-nil if KEY is `eq' to the car of an element of LIST. -The value is actually the element of LIST whose car is KEY. -Elements of LIST that are not conses are ignored. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) - return elt; - } - return Qnil; -} - -DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* -Return non-nil if KEY is `old-eq' to the car of an element of LIST. -The value is actually the element of LIST whose car is KEY. -Elements of LIST that are not conses are ignored. -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (HACKEQ_UNSAFE (key, elt_car)) - return elt; - } - return Qnil; -} - -/* Like Fassq but never report an error and do not allow quits. - Use only on lists known never to be circular. */ - -Lisp_Object -assq_no_quit (Lisp_Object key, Lisp_Object list) -{ - /* This cannot GC. */ - Lisp_Object elt; - LIST_LOOP_2 (elt, list) - { - Lisp_Object elt_car = XCAR (elt); - if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) - return elt; - } - return Qnil; -} - -DEFUN ("rassoc", Frassoc, 2, 2, 0, /* -Return non-nil if KEY is `equal' to the cdr of an element of LIST. -The value is actually the element of LIST whose cdr equals KEY. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (internal_equal (key, elt_cdr, 0)) - return elt; - } - return Qnil; -} - -DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* -Return non-nil if KEY is `old-equal' to the cdr of an element of LIST. -The value is actually the element of LIST whose cdr equals KEY. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (internal_old_equal (key, elt_cdr, 0)) - return elt; - } - return Qnil; -} - -DEFUN ("rassq", Frassq, 2, 2, 0, /* -Return non-nil if KEY is `eq' to the cdr of an element of LIST. -The value is actually the element of LIST whose cdr is KEY. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) - return elt; - } - return Qnil; -} - -DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /* -Return non-nil if KEY is `old-eq' to the cdr of an element of LIST. -The value is actually the element of LIST whose cdr is KEY. -*/ - (key, list)) -{ - Lisp_Object elt, elt_car, elt_cdr; - EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) - { - if (HACKEQ_UNSAFE (key, elt_cdr)) - return elt; - } - return Qnil; -} - -/* Like Frassq, but caller must ensure that LIST is properly - nil-terminated and ebola-free. */ -Lisp_Object -rassq_no_quit (Lisp_Object key, Lisp_Object list) -{ - Lisp_Object elt; - LIST_LOOP_2 (elt, list) - { - Lisp_Object elt_cdr = XCDR (elt); - if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) - return elt; - } - return Qnil; -} - - -DEFUN ("delete", Fdelete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delete element foo))' to be sure -of changing the value of `foo'. -Also see: `remove'. -*/ - (elt, list)) -{ - Lisp_Object list_elt; - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("old-delete", Fold_delete, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-equal'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delete element foo))' to be sure -of changing the value of `foo'. -*/ - (elt, list)) -{ - Lisp_Object list_elt; - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (internal_old_equal (elt, list_elt, 0))); - return list; -} - -DEFUN ("delq", Fdelq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - Lisp_Object list_elt; - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); - return list; -} - -DEFUN ("old-delq", Fold_delq, 2, 2, 0, /* -Delete by side effect any occurrences of ELT as a member of LIST. -The modified LIST is returned. Comparison is done with `old-eq'. -If the first member of LIST is ELT, there is no way to remove it by side -effect; therefore, write `(setq foo (old-delq element foo))' to be sure of -changing the value of `foo'. -*/ - (elt, list)) -{ - Lisp_Object list_elt; - EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, - (HACKEQ_UNSAFE (elt, list_elt))); - return list; -} - -/* Like Fdelq, but caller must ensure that LIST is properly - nil-terminated and ebola-free. */ - -Lisp_Object -delq_no_quit (Lisp_Object elt, Lisp_Object list) -{ - Lisp_Object list_elt; - LIST_LOOP_DELETE_IF (list_elt, list, - (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); - return list; -} - -/* Be VERY careful with this. This is like delq_no_quit() but - also calls free_cons() on the removed conses. You must be SURE - that no pointers to the freed conses remain around (e.g. - someone else is pointing to part of the list). This function - is useful on internal lists that are used frequently and where - the actual list doesn't escape beyond known code bounds. */ - -Lisp_Object -delq_no_quit_and_free_cons (Lisp_Object elt, Lisp_Object list) -{ - REGISTER Lisp_Object tail = list; - REGISTER Lisp_Object prev = Qnil; - - while (!NILP (tail)) - { - REGISTER Lisp_Object tem = XCAR (tail); - if (EQ (elt, tem)) - { - Lisp_Object cons_to_free = tail; - if (NILP (prev)) - list = XCDR (tail); - else - XCDR (prev) = XCDR (tail); - tail = XCDR (tail); - free_cons (XCONS (cons_to_free)); - } - else - { - prev = tail; - tail = XCDR (tail); - } - } - return list; -} - -DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* -Delete by side effect any elements of LIST whose car is `equal' to KEY. -The modified LIST is returned. If the first member of LIST has a car -that is `equal' to KEY, there is no way to remove it by side effect; -therefore, write `(setq foo (remassoc key foo))' to be sure of changing -the value of `foo'. -*/ - (key, list)) -{ - Lisp_Object elt; - EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - internal_equal (key, XCAR (elt), 0))); - return list; -} - -Lisp_Object -remassoc_no_quit (Lisp_Object key, Lisp_Object list) -{ - int speccount = specpdl_depth (); - specbind (Qinhibit_quit, Qt); - return unbind_to (speccount, Fremassoc (key, list)); -} - -DEFUN ("remassq", Fremassq, 2, 2, 0, /* -Delete by side effect any elements of LIST whose car is `eq' to KEY. -The modified LIST is returned. If the first member of LIST has a car -that is `eq' to KEY, there is no way to remove it by side effect; -therefore, write `(setq foo (remassq key foo))' to be sure of changing -the value of `foo'. -*/ - (key, list)) -{ - Lisp_Object elt; - EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); - return list; -} - -/* no quit, no errors; be careful */ - -Lisp_Object -remassq_no_quit (Lisp_Object key, Lisp_Object list) -{ - Lisp_Object elt; - LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); - return list; -} - -DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /* -Delete by side effect any elements of LIST whose cdr is `equal' to VALUE. -The modified LIST is returned. If the first member of LIST has a car -that is `equal' to VALUE, there is no way to remove it by side effect; -therefore, write `(setq foo (remrassoc value foo))' to be sure of changing -the value of `foo'. -*/ - (value, list)) -{ - Lisp_Object elt; - EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - internal_equal (value, XCDR (elt), 0))); - return list; -} - -DEFUN ("remrassq", Fremrassq, 2, 2, 0, /* -Delete by side effect any elements of LIST whose cdr is `eq' to VALUE. -The modified LIST is returned. If the first member of LIST has a car -that is `eq' to VALUE, there is no way to remove it by side effect; -therefore, write `(setq foo (remrassq value foo))' to be sure of changing -the value of `foo'. -*/ - (value, list)) -{ - Lisp_Object elt; - EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); - return list; -} - -/* Like Fremrassq, fast and unsafe; be careful */ -Lisp_Object -remrassq_no_quit (Lisp_Object value, Lisp_Object list) -{ - Lisp_Object elt; - LIST_LOOP_DELETE_IF (elt, list, - (CONSP (elt) && - EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); - return list; -} - -DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* -Reverse LIST by destructively modifying cdr pointers. -Return the beginning of the reversed list. -Also see: `reverse'. -*/ - (list)) -{ - struct gcpro gcpro1, gcpro2; - REGISTER Lisp_Object prev = Qnil; - REGISTER Lisp_Object tail = list; - - /* We gcpro our args; see `nconc' */ - GCPRO2 (prev, tail); - while (!NILP (tail)) - { - REGISTER Lisp_Object next; - CONCHECK_CONS (tail); - next = XCDR (tail); - XCDR (tail) = prev; - prev = tail; - tail = next; - } - UNGCPRO; - return prev; -} - -DEFUN ("reverse", Freverse, 1, 1, 0, /* -Reverse LIST, copying. Return the beginning of the reversed list. -See also the function `nreverse', which is used more often. -*/ - (list)) -{ - Lisp_Object reversed_list = Qnil; - Lisp_Object elt; - EXTERNAL_LIST_LOOP_2 (elt, list) - { - reversed_list = Fcons (elt, reversed_list); - } - return reversed_list; -} - -static Lisp_Object list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object, Lisp_Object, - Lisp_Object lisp_arg)); - -Lisp_Object -list_sort (Lisp_Object list, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object, Lisp_Object, - Lisp_Object lisp_arg)) -{ - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object back, tem; - Lisp_Object front = list; - Lisp_Object len = Flength (list); - int length = XINT (len); - - if (length < 2) - return list; - - XSETINT (len, (length / 2) - 1); - tem = Fnthcdr (len, list); - back = Fcdr (tem); - Fsetcdr (tem, Qnil); - - GCPRO3 (front, back, lisp_arg); - front = list_sort (front, lisp_arg, pred_fn); - back = list_sort (back, lisp_arg, pred_fn); - UNGCPRO; - return list_merge (front, back, lisp_arg, pred_fn); -} - - -static int -merge_pred_function (Lisp_Object obj1, Lisp_Object obj2, - Lisp_Object pred) -{ - Lisp_Object tmp; - - /* prevents the GC from happening in call2 */ - int speccount = specpdl_depth (); -/* Emacs' GC doesn't actually relocate pointers, so this probably - isn't strictly necessary */ - record_unwind_protect (restore_gc_inhibit, - make_int (gc_currently_forbidden)); - gc_currently_forbidden = 1; - tmp = call2 (pred, obj1, obj2); - unbind_to (speccount, Qnil); - - if (NILP (tmp)) - return -1; - else - return 1; -} - -DEFUN ("sort", Fsort, 2, 2, 0, /* -Sort LIST, stably, comparing elements using PREDICATE. -Returns the sorted list. LIST is modified by side effects. -PREDICATE is called with two elements of LIST, and should return T -if the first element is "less" than the second. -*/ - (list, pred)) -{ - return list_sort (list, pred, merge_pred_function); -} - -Lisp_Object -merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object pred) -{ - return list_merge (org_l1, org_l2, pred, merge_pred_function); -} - - -static Lisp_Object -list_merge (Lisp_Object org_l1, Lisp_Object org_l2, - Lisp_Object lisp_arg, - int (*pred_fn) (Lisp_Object, Lisp_Object, Lisp_Object lisp_arg)) -{ - Lisp_Object value; - Lisp_Object tail; - Lisp_Object tem; - Lisp_Object l1, l2; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - l1 = org_l1; - l2 = org_l2; - tail = Qnil; - value = Qnil; - - /* It is sufficient to protect org_l1 and org_l2. - When l1 and l2 are updated, we copy the new values - back into the org_ vars. */ - - GCPRO4 (org_l1, org_l2, lisp_arg, value); - - while (1) - { - if (NILP (l1)) - { - UNGCPRO; - if (NILP (tail)) - return l2; - Fsetcdr (tail, l2); - return value; - } - if (NILP (l2)) - { - UNGCPRO; - if (NILP (tail)) - return l1; - Fsetcdr (tail, l1); - return value; - } - - if (((*pred_fn) (Fcar (l2), Fcar (l1), lisp_arg)) < 0) - { - tem = l1; - l1 = Fcdr (l1); - org_l1 = l1; - } - else - { - tem = l2; - l2 = Fcdr (l2); - org_l2 = l2; - } - if (NILP (tail)) - value = tem; - else - Fsetcdr (tail, tem); - tail = tem; - } -} - - -/************************************************************************/ -/* property-list functions */ -/************************************************************************/ - -/* For properties of text, we need to do order-insensitive comparison of - plists. That is, we need to compare two plists such that they are the - same if they have the same set of keys, and equivalent values. - So (a 1 b 2) would be equal to (b 2 a 1). - - NIL_MEANS_NOT_PRESENT is as in `plists-eq' etc. - LAXP means use `equal' for comparisons. - */ -int -plists_differ (Lisp_Object a, Lisp_Object b, int nil_means_not_present, - int laxp, int depth) -{ - int eqp = (depth == -1); /* -1 as depth means us eq, not equal. */ - int la, lb, m, i, fill; - Lisp_Object *keys, *vals; - char *flags; - Lisp_Object rest; - - if (NILP (a) && NILP (b)) - return 0; - - Fcheck_valid_plist (a); - Fcheck_valid_plist (b); - - la = XINT (Flength (a)); - lb = XINT (Flength (b)); - m = (la > lb ? la : lb); - fill = 0; - keys = alloca_array (Lisp_Object, m); - vals = alloca_array (Lisp_Object, m); - flags = alloca_array (char, m); - - /* First extract the pairs from A. */ - for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest))) - { - Lisp_Object k = XCAR (rest); - Lisp_Object v = XCAR (XCDR (rest)); - /* Maybe be Ebolified. */ - if (nil_means_not_present && NILP (v)) continue; - keys [fill] = k; - vals [fill] = v; - flags[fill] = 0; - fill++; - } - /* Now iterate over B, and stop if we find something that's not in A, - or that doesn't match. As we match, mark them. */ - for (rest = b; !NILP (rest); rest = XCDR (XCDR (rest))) - { - Lisp_Object k = XCAR (rest); - Lisp_Object v = XCAR (XCDR (rest)); - /* Maybe be Ebolified. */ - if (nil_means_not_present && NILP (v)) continue; - for (i = 0; i < fill; i++) - { - if (!laxp ? EQ (k, keys [i]) : internal_equal (k, keys [i], depth)) - { - if ((eqp - /* We narrowly escaped being Ebolified here. */ - ? !EQ_WITH_EBOLA_NOTICE (v, vals [i]) - : !internal_equal (v, vals [i], depth))) - /* a property in B has a different value than in A */ - goto MISMATCH; - flags [i] = 1; - break; - } - } - if (i == fill) - /* there are some properties in B that are not in A */ - goto MISMATCH; - } - /* Now check to see that all the properties in A were also in B */ - for (i = 0; i < fill; i++) - if (flags [i] == 0) - goto MISMATCH; - - /* Ok. */ - return 0; - - MISMATCH: - return 1; -} - -DEFUN ("plists-eq", Fplists_eq, 2, 3, 0, /* -Return non-nil if property lists A and B are `eq'. -A property list is an alternating list of keywords and values. - This function does order-insensitive comparisons of the property lists: - For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. - Comparison between values is done using `eq'. See also `plists-equal'. -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is ignored. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. -*/ - (a, b, nil_means_not_present)) -{ - return (plists_differ (a, b, !NILP (nil_means_not_present), 0, -1) - ? Qnil : Qt); -} - -DEFUN ("plists-equal", Fplists_equal, 2, 3, 0, /* -Return non-nil if property lists A and B are `equal'. -A property list is an alternating list of keywords and values. This - function does order-insensitive comparisons of the property lists: For - example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. - Comparison between values is done using `equal'. See also `plists-eq'. -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is ignored. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. -*/ - (a, b, nil_means_not_present)) -{ - return (plists_differ (a, b, !NILP (nil_means_not_present), 0, 1) - ? Qnil : Qt); -} - - -DEFUN ("lax-plists-eq", Flax_plists_eq, 2, 3, 0, /* -Return non-nil if lax property lists A and B are `eq'. -A property list is an alternating list of keywords and values. - This function does order-insensitive comparisons of the property lists: - For example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. - Comparison between values is done using `eq'. See also `plists-equal'. -A lax property list is like a regular one except that comparisons between - keywords is done using `equal' instead of `eq'. -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is ignored. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. -*/ - (a, b, nil_means_not_present)) -{ - return (plists_differ (a, b, !NILP (nil_means_not_present), 1, -1) - ? Qnil : Qt); -} - -DEFUN ("lax-plists-equal", Flax_plists_equal, 2, 3, 0, /* -Return non-nil if lax property lists A and B are `equal'. -A property list is an alternating list of keywords and values. This - function does order-insensitive comparisons of the property lists: For - example, the property lists '(a 1 b 2) and '(b 2 a 1) are equal. - Comparison between values is done using `equal'. See also `plists-eq'. -A lax property list is like a regular one except that comparisons between - keywords is done using `equal' instead of `eq'. -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is ignored. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. -*/ - (a, b, nil_means_not_present)) -{ - return (plists_differ (a, b, !NILP (nil_means_not_present), 1, 1) - ? Qnil : Qt); -} - -/* Return the value associated with key PROPERTY in property list PLIST. - Return nil if key not found. This function is used for internal - property lists that cannot be directly manipulated by the user. - */ - -Lisp_Object -internal_plist_get (Lisp_Object plist, Lisp_Object property) -{ - Lisp_Object tail; - - for (tail = plist; !NILP (tail); tail = XCDR (XCDR (tail))) - { - if (EQ (XCAR (tail), property)) - return XCAR (XCDR (tail)); - } - - return Qunbound; -} - -/* Set PLIST's value for PROPERTY to VALUE. Analogous to - internal_plist_get(). */ - -void -internal_plist_put (Lisp_Object *plist, Lisp_Object property, - Lisp_Object value) -{ - Lisp_Object tail; - - for (tail = *plist; !NILP (tail); tail = XCDR (XCDR (tail))) - { - if (EQ (XCAR (tail), property)) - { - XCAR (XCDR (tail)) = value; - return; - } - } - - *plist = Fcons (property, Fcons (value, *plist)); -} - -int -internal_remprop (Lisp_Object *plist, Lisp_Object property) -{ - Lisp_Object tail, prev; - - for (tail = *plist, prev = Qnil; - !NILP (tail); - tail = XCDR (XCDR (tail))) - { - if (EQ (XCAR (tail), property)) - { - if (NILP (prev)) - *plist = XCDR (XCDR (tail)); - else - XCDR (XCDR (prev)) = XCDR (XCDR (tail)); - return 1; - } - else - prev = tail; - } - - return 0; -} - -/* Called on a malformed property list. BADPLACE should be some - place where truncating will form a good list -- i.e. we shouldn't - result in a list with an odd length. */ - -static Lisp_Object -bad_bad_bunny (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME)) - return Fsignal (Qmalformed_property_list, list2 (*plist, *badplace)); - else - { - if (ERRB_EQ (errb, ERROR_ME_WARN)) - { - warn_when_safe_lispobj - (Qlist, Qwarning, - list2 (build_string - ("Malformed property list -- list has been truncated"), - *plist)); - *badplace = Qnil; - } - return Qunbound; - } -} - -/* Called on a circular property list. BADPLACE should be some place - where truncating will result in an even-length list, as above. - If doesn't particularly matter where we truncate -- anywhere we - truncate along the entire list will break the circularity, because - it will create a terminus and the list currently doesn't have one. -*/ - -static Lisp_Object -bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME)) - /* #### Eek, this will probably result in another error - when PLIST is printed out */ - return Fsignal (Qcircular_property_list, list1 (*plist)); - else - { - if (ERRB_EQ (errb, ERROR_ME_WARN)) - { - warn_when_safe_lispobj - (Qlist, Qwarning, - list2 (build_string - ("Circular property list -- list has been truncated"), - *plist)); - *badplace = Qnil; - } - return Qunbound; - } -} - -/* Advance the tortoise pointer by two (one iteration of a property-list - loop) and the hare pointer by four and verify that no malformations - or circularities exist. If so, return zero and store a value into - RETVAL that should be returned by the calling function. Otherwise, - return 1. See external_plist_get(). - */ - -static int -advance_plist_pointers (Lisp_Object *plist, - Lisp_Object **tortoise, Lisp_Object **hare, - Error_behavior errb, Lisp_Object *retval) -{ - int i; - Lisp_Object *tortsave = *tortoise; - - /* Note that our "fixing" may be more brutal than necessary, - but it's the user's own problem, not ours, if they went in and - manually fucked up a plist. */ - - for (i = 0; i < 2; i++) - { - /* This is a standard iteration of a defensive-loop-checking - loop. We just do it twice because we want to advance past - both the property and its value. - - If the pointer indirection is confusing you, remember that - one level of indirection on the hare and tortoise pointers - is only due to pass-by-reference for this function. The other - level is so that the plist can be fixed in place. */ - - /* When we reach the end of a well-formed plist, **HARE is - nil. In that case, we don't do anything at all except - advance TORTOISE by one. Otherwise, we advance HARE - by two (making sure it's OK to do so), then advance - TORTOISE by one (it will always be OK to do so because - the HARE is always ahead of the TORTOISE and will have - already verified the path), then make sure TORTOISE and - HARE don't contain the same non-nil object -- if the - TORTOISE and the HARE ever meet, then obviously we're - in a circularity, and if we're in a circularity, then - the TORTOISE and the HARE can't cross paths without - meeting, since the HARE only gains one step over the - TORTOISE per iteration. */ - - if (!NILP (**hare)) - { - Lisp_Object *haresave = *hare; - if (!CONSP (**hare)) - { - *retval = bad_bad_bunny (plist, haresave, errb); - return 0; - } - *hare = &XCDR (**hare); - /* In a non-plist, we'd check here for a nil value for - **HARE, which is OK (it just means the list has an - odd number of elements). In a plist, it's not OK - for the list to have an odd number of elements. */ - if (!CONSP (**hare)) - { - *retval = bad_bad_bunny (plist, haresave, errb); - return 0; - } - *hare = &XCDR (**hare); - } - - *tortoise = &XCDR (**tortoise); - if (!NILP (**hare) && EQ (**tortoise, **hare)) - { - *retval = bad_bad_turtle (plist, tortsave, errb); - return 0; - } - } - - return 1; -} - -/* Return the value of PROPERTY from PLIST, or Qunbound if - property is not on the list. - - PLIST is a Lisp-accessible property list, meaning that it - has to be checked for malformations and circularities. - - If ERRB is ERROR_ME, an error will be signalled. Otherwise, the - function will never signal an error; and if ERRB is ERROR_ME_WARN, - on finding a malformation or a circularity, it issues a warning and - attempts to silently fix the problem. - - A pointer to PLIST is passed in so that PLIST can be successfully - "fixed" even if the error is at the beginning of the plist. */ - -Lisp_Object -external_plist_get (Lisp_Object *plist, Lisp_Object property, - int laxp, Error_behavior errb) -{ - Lisp_Object *tortoise = plist; - Lisp_Object *hare = plist; - - while (!NILP (*tortoise)) - { - Lisp_Object *tortsave = tortoise; - Lisp_Object retval; - - /* We do the standard tortoise/hare march. We isolate the - grungy stuff to do this in advance_plist_pointers(), though. - To us, all this function does is advance the tortoise - pointer by two and the hare pointer by four and make sure - everything's OK. We first advance the pointers and then - check if a property matched; this ensures that our - check for a matching property is safe. */ - - if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) - return retval; - - if (!laxp ? EQ (XCAR (*tortsave), property) - : internal_equal (XCAR (*tortsave), property, 0)) - return XCAR (XCDR (*tortsave)); - } - - return Qunbound; -} - -/* Set PLIST's value for PROPERTY to VALUE, given a possibly - malformed or circular plist. Analogous to external_plist_get(). */ - -void -external_plist_put (Lisp_Object *plist, Lisp_Object property, - Lisp_Object value, int laxp, Error_behavior errb) -{ - Lisp_Object *tortoise = plist; - Lisp_Object *hare = plist; - - while (!NILP (*tortoise)) - { - Lisp_Object *tortsave = tortoise; - Lisp_Object retval; - - /* See above */ - if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) - return; - - if (!laxp ? EQ (XCAR (*tortsave), property) - : internal_equal (XCAR (*tortsave), property, 0)) - { - XCAR (XCDR (*tortsave)) = value; - return; - } - } - - *plist = Fcons (property, Fcons (value, *plist)); -} - -int -external_remprop (Lisp_Object *plist, Lisp_Object property, - int laxp, Error_behavior errb) -{ - Lisp_Object *tortoise = plist; - Lisp_Object *hare = plist; - - while (!NILP (*tortoise)) - { - Lisp_Object *tortsave = tortoise; - Lisp_Object retval; - - /* See above */ - if (!advance_plist_pointers (plist, &tortoise, &hare, errb, &retval)) - return 0; - - if (!laxp ? EQ (XCAR (*tortsave), property) - : internal_equal (XCAR (*tortsave), property, 0)) - { - /* Now you see why it's so convenient to have that level - of indirection. */ - *tortsave = XCDR (XCDR (*tortsave)); - return 1; - } - } - - return 0; -} - -DEFUN ("plist-get", Fplist_get, 2, 3, 0, /* -Extract a value from a property list. -PLIST is a property list, which is a list of the form -\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value -corresponding to the given PROP, or DEFAULT if PROP is not -one of the properties on the list. -*/ - (plist, prop, default_)) -{ - Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME); - return UNBOUNDP (val) ? default_ : val; -} - -DEFUN ("plist-put", Fplist_put, 3, 3, 0, /* -Change value in PLIST of PROP to VAL. -PLIST is a property list, which is a list of the form \(PROP1 VALUE1 -PROP2 VALUE2 ...). PROP is usually a symbol and VAL is any object. -If PROP is already a property on the list, its value is set to VAL, -otherwise the new PROP VAL pair is added. The new plist is returned; -use `(setq x (plist-put x prop val))' to be sure to use the new value. -The PLIST is modified by side effects. -*/ - (plist, prop, val)) -{ - external_plist_put (&plist, prop, val, 0, ERROR_ME); - return plist; -} - -DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /* -Remove from PLIST the property PROP and its value. -PLIST is a property list, which is a list of the form \(PROP1 VALUE1 -PROP2 VALUE2 ...). PROP is usually a symbol. The new plist is -returned; use `(setq x (plist-remprop x prop val))' to be sure to use -the new value. The PLIST is modified by side effects. -*/ - (plist, prop)) -{ - external_remprop (&plist, prop, 0, ERROR_ME); - return plist; -} - -DEFUN ("plist-member", Fplist_member, 2, 2, 0, /* -Return t if PROP has a value specified in PLIST. -*/ - (plist, prop)) -{ - Lisp_Object val = Fplist_get (plist, prop, Qunbound); - return UNBOUNDP (val) ? Qnil : Qt; -} - -DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /* -Given a plist, signal an error if there is anything wrong with it. -This means that it's a malformed or circular plist. -*/ - (plist)) -{ - Lisp_Object *tortoise; - Lisp_Object *hare; - - start_over: - tortoise = &plist; - hare = &plist; - while (!NILP (*tortoise)) - { - Lisp_Object retval; - - /* See above */ - if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME, - &retval)) - goto start_over; - } - - return Qnil; -} - -DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* -Given a plist, return non-nil if its format is correct. -If it returns nil, `check-valid-plist' will signal an error when given -the plist; that means it's a malformed or circular plist or has non-symbols -as keywords. -*/ - (plist)) -{ - Lisp_Object *tortoise; - Lisp_Object *hare; - - tortoise = &plist; - hare = &plist; - while (!NILP (*tortoise)) - { - Lisp_Object retval; - - /* See above */ - if (!advance_plist_pointers (&plist, &tortoise, &hare, ERROR_ME_NOT, - &retval)) - return Qnil; - } - - return Qt; -} - -DEFUN ("canonicalize-plist", Fcanonicalize_plist, 1, 2, 0, /* -Destructively remove any duplicate entries from a plist. -In such cases, the first entry applies. - -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is removed. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. - -The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the - return value may not be EQ to the passed-in value, so make sure to - `setq' the value back into where it came from. -*/ - (plist, nil_means_not_present)) -{ - Lisp_Object head = plist; - - Fcheck_valid_plist (plist); - - while (!NILP (plist)) - { - Lisp_Object prop = Fcar (plist); - Lisp_Object next = Fcdr (plist); - - CHECK_CONS (next); /* just make doubly sure we catch any errors */ - if (!NILP (nil_means_not_present) && NILP (Fcar (next))) - { - if (EQ (head, plist)) - head = Fcdr (next); - plist = Fcdr (next); - continue; - } - /* external_remprop returns 1 if it removed any property. - We have to loop till it didn't remove anything, in case - the property occurs many times. */ - while (external_remprop (&XCDR (next), prop, 0, ERROR_ME)) - DO_NOTHING; - plist = Fcdr (next); - } - - return head; -} - -DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /* -Extract a value from a lax property list. - -LAX-PLIST is a lax property list, which is a list of the form \(PROP1 -VALUE1 PROP2 VALUE2...), where comparisons between properties is done -using `equal' instead of `eq'. This function returns the value -corresponding to the given PROP, or DEFAULT if PROP is not one of the -properties on the list. -*/ - (lax_plist, prop, default_)) -{ - Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); - if (UNBOUNDP (val)) - return default_; - return val; -} - -DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* -Change value in LAX-PLIST of PROP to VAL. -LAX-PLIST is a lax property list, which is a list of the form \(PROP1 -VALUE1 PROP2 VALUE2...), where comparisons between properties is done -using `equal' instead of `eq'. PROP is usually a symbol and VAL is -any object. If PROP is already a property on the list, its value is -set to VAL, otherwise the new PROP VAL pair is added. The new plist -is returned; use `(setq x (lax-plist-put x prop val))' to be sure to -use the new value. The LAX-PLIST is modified by side effects. -*/ - (lax_plist, prop, val)) -{ - external_plist_put (&lax_plist, prop, val, 1, ERROR_ME); - return lax_plist; -} - -DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /* -Remove from LAX-PLIST the property PROP and its value. -LAX-PLIST is a lax property list, which is a list of the form \(PROP1 -VALUE1 PROP2 VALUE2...), where comparisons between properties is done -using `equal' instead of `eq'. PROP is usually a symbol. The new -plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be -sure to use the new value. The LAX-PLIST is modified by side effects. -*/ - (lax_plist, prop)) -{ - external_remprop (&lax_plist, prop, 1, ERROR_ME); - return lax_plist; -} - -DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /* -Return t if PROP has a value specified in LAX-PLIST. -LAX-PLIST is a lax property list, which is a list of the form \(PROP1 -VALUE1 PROP2 VALUE2...), where comparisons between properties is done -using `equal' instead of `eq'. -*/ - (lax_plist, prop)) -{ - return UNBOUNDP (Flax_plist_get (lax_plist, prop, Qunbound)) ? Qnil : Qt; -} - -DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /* -Destructively remove any duplicate entries from a lax plist. -In such cases, the first entry applies. - -If optional arg NIL-MEANS-NOT-PRESENT is non-nil, then a property with - a nil value is removed. This feature is a virus that has infected - old Lisp implementations, but should not be used except for backward - compatibility. - -The new plist is returned. If NIL-MEANS-NOT-PRESENT is given, the - return value may not be EQ to the passed-in value, so make sure to - `setq' the value back into where it came from. -*/ - (lax_plist, nil_means_not_present)) -{ - Lisp_Object head = lax_plist; - - Fcheck_valid_plist (lax_plist); - - while (!NILP (lax_plist)) - { - Lisp_Object prop = Fcar (lax_plist); - Lisp_Object next = Fcdr (lax_plist); - - CHECK_CONS (next); /* just make doubly sure we catch any errors */ - if (!NILP (nil_means_not_present) && NILP (Fcar (next))) - { - if (EQ (head, lax_plist)) - head = Fcdr (next); - lax_plist = Fcdr (next); - continue; - } - /* external_remprop returns 1 if it removed any property. - We have to loop till it didn't remove anything, in case - the property occurs many times. */ - while (external_remprop (&XCDR (next), prop, 1, ERROR_ME)) - DO_NOTHING; - lax_plist = Fcdr (next); - } - - return head; -} - -/* In C because the frame props stuff uses it */ - -DEFUN ("destructive-alist-to-plist", Fdestructive_alist_to_plist, 1, 1, 0, /* -Convert association list ALIST into the equivalent property-list form. -The plist is returned. This converts from - -\((a . 1) (b . 2) (c . 3)) - -into - -\(a 1 b 2 c 3) - -The original alist is destroyed in the process of constructing the plist. -See also `alist-to-plist'. -*/ - (alist)) -{ - Lisp_Object head = alist; - while (!NILP (alist)) - { - /* remember the alist element. */ - Lisp_Object el = Fcar (alist); - - Fsetcar (alist, Fcar (el)); - Fsetcar (el, Fcdr (el)); - Fsetcdr (el, Fcdr (alist)); - Fsetcdr (alist, el); - alist = Fcdr (Fcdr (alist)); - } - - return head; -} - -/* Symbol plists are directly accessible, so we need to protect against - invalid property list structure */ - -static Lisp_Object -symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object default_) -{ - Lisp_Object val = external_plist_get (&XSYMBOL (sym)->plist, propname, - 0, ERROR_ME); - return UNBOUNDP (val) ? default_ : val; -} - -static void -symbol_putprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object value) -{ - external_plist_put (&XSYMBOL (sym)->plist, propname, value, 0, ERROR_ME); -} - -static int -symbol_remprop (Lisp_Object symbol, Lisp_Object propname) -{ - return external_remprop (&XSYMBOL (symbol)->plist, propname, 0, ERROR_ME); -} - -/* We store the string's extent info as the first element of the string's - property list; and the string's MODIFF as the first or second element - of the string's property list (depending on whether the extent info - is present), but only if the string has been modified. This is ugly - but it reduces the memory allocated for the string in the vast - majority of cases, where the string is never modified and has no - extent info. */ - - -static Lisp_Object * -string_plist_ptr (struct Lisp_String *s) -{ - Lisp_Object *ptr = &s->plist; - - if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr))) - ptr = &XCDR (*ptr); - if (CONSP (*ptr) && INTP (XCAR (*ptr))) - ptr = &XCDR (*ptr); - return ptr; -} - -static Lisp_Object -string_getprop (struct Lisp_String *s, Lisp_Object property, - Lisp_Object default_) -{ - Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0, - ERROR_ME); - return UNBOUNDP (val) ? default_ : val; -} - -static void -string_putprop (struct Lisp_String *s, Lisp_Object property, - Lisp_Object value) -{ - external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME); -} - -static int -string_remprop (struct Lisp_String *s, Lisp_Object property) -{ - return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME); -} - -static Lisp_Object -string_plist (struct Lisp_String *s) -{ - return *string_plist_ptr (s); -} - -DEFUN ("get", Fget, 2, 3, 0, /* -Return the value of OBJECT's PROPNAME property. -This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'. -If there is no such property, return optional third arg DEFAULT -\(which defaults to `nil'). OBJECT can be a symbol, face, extent, -or string. See also `put', `remprop', and `object-plist'. -*/ - (object, propname, default_)) -{ - /* Various places in emacs call Fget() and expect it not to quit, - so don't quit. */ - - /* It's easiest to treat symbols specially because they may not - be an lrecord */ - if (SYMBOLP (object)) - return symbol_getprop (object, propname, default_); - else if (STRINGP (object)) - return string_getprop (XSTRING (object), propname, default_); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation *imp - = XRECORD_LHEADER_IMPLEMENTATION (object); - if (!imp->getprop) - goto noprops; - - { - Lisp_Object val = (imp->getprop) (object, propname); - if (UNBOUNDP (val)) - val = default_; - return val; - } - } - else - { - noprops: - signal_simple_error ("Object type has no properties", object); - return Qnil; /* Not reached */ - } -} - -DEFUN ("put", Fput, 3, 3, 0, /* -Store OBJECT's PROPNAME property with value VALUE. -It can be retrieved with `(get OBJECT PROPNAME)'. OBJECT can be a -symbol, face, extent, or string. - -For a string, no properties currently have predefined meanings. -For the predefined properties for extents, see `set-extent-property'. -For the predefined properties for faces, see `set-face-property'. - -See also `get', `remprop', and `object-plist'. -*/ - (object, propname, value)) -{ - CHECK_SYMBOL (propname); - CHECK_IMPURE (object); - - if (SYMBOLP (object)) - symbol_putprop (object, propname, value); - else if (STRINGP (object)) - string_putprop (XSTRING (object), propname, value); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->putprop) - { - if (! (imp->putprop) (object, propname, value)) - signal_simple_error ("Can't set property on object", propname); - } - else - goto noprops; - } - else - { - noprops: - signal_simple_error ("Object type has no settable properties", object); - } - - return value; -} - -void -pure_put (Lisp_Object sym, Lisp_Object prop, Lisp_Object val) -{ - Fput (sym, prop, Fpurecopy (val)); -} - -DEFUN ("remprop", Fremprop, 2, 2, 0, /* -Remove from OBJECT's property list the property PROPNAME and its -value. OBJECT can be a symbol, face, extent, or string. Returns -non-nil if the property list was actually changed (i.e. if PROPNAME -was present in the property list). See also `get', `put', and -`object-plist'. -*/ - (object, propname)) -{ - int retval = 0; - - CHECK_SYMBOL (propname); - CHECK_IMPURE (object); - - if (SYMBOLP (object)) - retval = symbol_remprop (object, propname); - else if (STRINGP (object)) - retval = string_remprop (XSTRING (object), propname); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->remprop) - { - retval = (imp->remprop) (object, propname); - if (retval == -1) - signal_simple_error ("Can't remove property from object", - propname); - } - else - goto noprops; - } - else - { - noprops: - signal_simple_error ("Object type has no removable properties", object); - } - - return retval ? Qt : Qnil; -} - -DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* -Return a property list of OBJECT's props. -For a symbol this is equivalent to `symbol-plist'. -Do not modify the property list directly; this may or may not have -the desired effects. (In particular, for a property with a special -interpretation, this will probably have no effect at all.) -*/ - (object)) -{ - if (SYMBOLP (object)) - return Fsymbol_plist (object); - else if (STRINGP (object)) - return string_plist (XSTRING (object)); - else if (LRECORDP (object)) - { - CONST struct lrecord_implementation - *imp = XRECORD_LHEADER_IMPLEMENTATION (object); - if (imp->plist) - return (imp->plist) (object); - else - signal_simple_error ("Object type has no properties", object); - } - else - signal_simple_error ("Object type has no properties", object); - - return Qnil; -} - - -int -internal_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - if (depth > 200) - error ("Stack overflow in equal"); -#ifndef LRECORD_CONS - do_cdr: -#endif - QUIT; - if (EQ_WITH_EBOLA_NOTICE (obj1, obj2)) - return 1; - /* Note that (equal 20 20.0) should be nil */ - if (XTYPE (obj1) != XTYPE (obj2)) - return 0; -#ifndef LRECORD_CONS - if (CONSP (obj1)) - { - if (!internal_equal (XCAR (obj1), XCAR (obj2), depth + 1)) - return 0; - obj1 = XCDR (obj1); - obj2 = XCDR (obj2); - goto do_cdr; - } -#endif -#ifndef LRECORD_VECTOR - if (VECTORP (obj1)) - { - Lisp_Object *v1 = XVECTOR_DATA (obj1); - Lisp_Object *v2 = XVECTOR_DATA (obj2); - int len = XVECTOR_LENGTH (obj1); - if (len != XVECTOR_LENGTH (obj2)) - return 0; - while (len--) - if (!internal_equal (*v1++, *v2++, depth + 1)) - return 0; - return 1; - } -#endif -#ifndef LRECORD_STRING - if (STRINGP (obj1)) - { - Bytecount len; - return (((len = XSTRING_LENGTH (obj1)) == XSTRING_LENGTH (obj2)) && - !memcmp (XSTRING_DATA (obj1), XSTRING_DATA (obj2), len)); - } -#endif - if (LRECORDP (obj1)) - { - CONST struct lrecord_implementation - *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), - *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); - - return (imp1 == imp2) && - /* EQ-ness of the objects was noticed above */ - (imp1->equal && (imp1->equal) (obj1, obj2, depth)); - } - - return 0; -} - -/* Note that we may be calling sub-objects that will use - internal_equal() (instead of internal_old_equal()). Oh well. - We will get an Ebola note if there's any possibility of confusion, - but that seems unlikely. */ - -static int -internal_old_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - if (depth > 200) - error ("Stack overflow in equal"); -#ifndef LRECORD_CONS - do_cdr: -#endif - QUIT; - if (HACKEQ_UNSAFE (obj1, obj2)) - return 1; - /* Note that (equal 20 20.0) should be nil */ - if (XTYPE (obj1) != XTYPE (obj2)) - return 0; -#ifndef LRECORD_CONS - if (CONSP (obj1)) - { - if (!internal_old_equal (XCAR (obj1), XCAR (obj2), depth + 1)) - return 0; - obj1 = XCDR (obj1); - obj2 = XCDR (obj2); - goto do_cdr; - } -#endif -#ifndef LRECORD_VECTOR - if (VECTORP (obj1)) - { - Lisp_Object *v1 = XVECTOR_DATA (obj1); - Lisp_Object *v2 = XVECTOR_DATA (obj2); - int len = XVECTOR_LENGTH (obj1); - if (len != XVECTOR_LENGTH (obj2)) - return 0; - while (len--) - if (!internal_old_equal (*v1++, *v2++, depth + 1)) - return 0; - return 1; - } -#endif - - return internal_equal (obj1, obj2, depth); -} - -DEFUN ("equal", Fequal, 2, 2, 0, /* -Return t if two Lisp objects have similar structure and contents. -They must have the same data type. -Conses are compared by comparing the cars and the cdrs. -Vectors and strings are compared element by element. -Numbers are compared by value. Symbols must match exactly. -*/ - (obj1, obj2)) -{ - return internal_equal (obj1, obj2, 0) ? Qt : Qnil; -} - -DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* -Return t if two Lisp objects have similar structure and contents. -They must have the same data type. -\(Note, however, that an exception is made for characters and integers; -this is known as the "char-int confoundance disease." See `eq' and -`old-eq'.) -This function is provided only for byte-code compatibility with v19. -Do not use it. -*/ - (obj1, obj2)) -{ - return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil; -} - - -DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* -Store each element of ARRAY with ITEM. -ARRAY is a vector, bit vector, or string. -*/ - (array, item)) -{ - retry: - if (STRINGP (array)) - { - Emchar charval; - struct Lisp_String *s = XSTRING (array); - Charcount len = string_char_length (s); - Charcount i; - CHECK_CHAR_COERCE_INT (item); - CHECK_IMPURE (array); - charval = XCHAR (item); - for (i = 0; i < len; i++) - set_string_char (s, i, charval); - bump_string_modiff (array); - } - else if (VECTORP (array)) - { - Lisp_Object *p = XVECTOR_DATA (array); - int len = XVECTOR_LENGTH (array); - CHECK_IMPURE (array); - while (len--) - *p++ = item; - } - else if (BIT_VECTORP (array)) - { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (array); - int len = bit_vector_length (v); - int bit; - CHECK_BIT (item); - CHECK_IMPURE (array); - bit = XINT (item); - while (len--) - set_bit_vector_bit (v, len, bit); - } - else - { - array = wrong_type_argument (Qarrayp, array); - goto retry; - } - return array; -} - -Lisp_Object -nconc2 (Lisp_Object arg1, Lisp_Object arg2) -{ - Lisp_Object args[2]; - struct gcpro gcpro1; - args[0] = arg1; - args[1] = arg2; - - GCPRO1 (args[0]); - gcpro1.nvars = 2; - - RETURN_UNGCPRO (bytecode_nconc2 (args)); -} - -Lisp_Object -bytecode_nconc2 (Lisp_Object *args) -{ - retry: - - if (CONSP (args[0])) - { - /* (setcdr (last args[0]) args[1]) */ - Lisp_Object tortoise, hare; - int count; - - for (hare = tortoise = args[0], count = 0; - CONSP (XCDR (hare)); - hare = XCDR (hare), count++) - { - if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - if (count & 1) - tortoise = XCDR (tortoise); - if (EQ (hare, tortoise)) - signal_circular_list_error (args[0]); - } - XCDR (hare) = args[1]; - return args[0]; - } - else if (NILP (args[0])) - { - return args[1]; - } - else - { - args[0] = wrong_type_argument (args[0], Qlistp); - goto retry; - } -} - -DEFUN ("nconc", Fnconc, 0, MANY, 0, /* -Concatenate any number of lists by altering them. -Only the last argument is not altered, and need not be a list. -Also see: `append'. -If the first argument is nil, there is no way to modify it by side -effect; therefore, write `(setq foo (nconc foo list))' to be sure of -changing the value of `foo'. -*/ - (int nargs, Lisp_Object *args)) -{ - int argnum = 0; - struct gcpro gcpro1; - - /* The modus operandi in Emacs is "caller gc-protects args". - However, nconc (particularly nconc2 ()) is called many times - in Emacs on freshly created stuff (e.g. you see the idiom - nconc2 (Fcopy_sequence (foo), bar) a lot). So we help those - callers out by protecting the args ourselves to save them - a lot of temporary-variable grief. */ - - GCPRO1 (args[0]); - gcpro1.nvars = nargs; - - while (argnum < nargs) - { - Lisp_Object val; - retry: - val = args[argnum]; - if (CONSP (val)) - { - /* `val' is the first cons, which will be our return value. */ - /* `last_cons' will be the cons cell to mutate. */ - Lisp_Object last_cons = val; - Lisp_Object tortoise = val; - - for (argnum++; argnum < nargs; argnum++) - { - Lisp_Object next = args[argnum]; - retry_next: - if (CONSP (next) || argnum == nargs -1) - { - /* (setcdr (last val) next) */ - int count; - - for (count = 0; - CONSP (XCDR (last_cons)); - last_cons = XCDR (last_cons), count++) - { - if (count < CIRCULAR_LIST_SUSPICION_LENGTH) continue; - - if (count & 1) - tortoise = XCDR (tortoise); - if (EQ (last_cons, tortoise)) - signal_circular_list_error (args[argnum-1]); - } - XCDR (last_cons) = next; - } - else if (NILP (next)) - { - continue; - } - else - { - next = wrong_type_argument (Qlistp, next); - goto retry_next; - } - } - RETURN_UNGCPRO (val); - } - else if (NILP (val)) - argnum++; - else if (argnum == nargs - 1) /* last arg? */ - RETURN_UNGCPRO (val); - else - { - args[argnum] = wrong_type_argument (Qlistp, val); - goto retry; - } - } - RETURN_UNGCPRO (Qnil); /* No non-nil args provided. */ -} - - -/* This is the guts of all mapping functions. - Apply fn to each element of seq, one by one, - storing the results into elements of vals, a C vector of Lisp_Objects. - leni is the length of vals, which should also be the length of seq. - - If VALS is a null pointer, do not accumulate the results. */ - -static void -mapcar1 (size_t leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) -{ - Lisp_Object result; - Lisp_Object args[2]; - int i; - struct gcpro gcpro1; - - if (vals) - { - GCPRO1 (vals[0]); - gcpro1.nvars = 0; - } - - args[0] = fn; - - if (LISTP (seq)) - { - for (i = 0; i < leni; i++) - { - args[1] = XCAR (seq); - seq = XCDR (seq); - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; - } - } - else if (VECTORP (seq)) - { - Lisp_Object *objs = XVECTOR_DATA (seq); - for (i = 0; i < leni; i++) - { - args[1] = *objs++; - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; - } - } - else if (STRINGP (seq)) - { - Bufbyte *p = XSTRING_DATA (seq); - for (i = 0; i < leni; i++) - { - args[1] = make_char (charptr_emchar (p)); - INC_CHARPTR (p); - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; - } - } - else if (BIT_VECTORP (seq)) - { - struct Lisp_Bit_Vector *v = XBIT_VECTOR (seq); - for (i = 0; i < leni; i++) - { - args[1] = make_int (bit_vector_bit (v, i)); - result = Ffuncall (2, args); - if (vals) vals[gcpro1.nvars++] = result; - } - } - else - abort(); /* cannot get here since Flength(seq) did not get an error */ - - if (vals) - UNGCPRO; -} - -DEFUN ("mapconcat", Fmapconcat, 3, 3, 0, /* -Apply FN to each element of SEQ, and concat the results as strings. -In between each pair of results, stick in SEP. -Thus, " " as SEP results in spaces between the values returned by FN. -*/ - (fn, seq, sep)) -{ - size_t len = XINT (Flength (seq)); - Lisp_Object *args; - int i; - struct gcpro gcpro1; - int nargs = len + len - 1; - - if (nargs < 0) return build_string (""); - - args = alloca_array (Lisp_Object, nargs); - - GCPRO1 (sep); - mapcar1 (len, args, fn, seq); - UNGCPRO; - - for (i = len - 1; i >= 0; i--) - args[i + i] = args[i]; - - for (i = 1; i < nargs; i += 2) - args[i] = sep; - - return Fconcat (nargs, args); -} - -DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, and make a list of the results. -The result is a list just as long as SEQUENCE. -SEQUENCE may be a list, a vector, a bit vector, or a string. -*/ - (fn, seq)) -{ - size_t len = XINT (Flength (seq)); - Lisp_Object *args = alloca_array (Lisp_Object, len); - - mapcar1 (len, args, fn, seq); - - return Flist (len, args); -} - -DEFUN ("mapvector", Fmapvector, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE, making a vector of the results. -The result is a vector of the same length as SEQUENCE. -SEQUENCE may be a list, a vector or a string. -*/ - (fn, seq)) -{ - size_t len = XINT (Flength (seq)); - Lisp_Object result = make_vector (len, Qnil); - struct gcpro gcpro1; - - GCPRO1 (result); - mapcar1 (len, XVECTOR_DATA (result), fn, seq); - UNGCPRO; - - return result; -} - -DEFUN ("mapc", Fmapc, 2, 2, 0, /* -Apply FUNCTION to each element of SEQUENCE. -SEQUENCE may be a list, a vector, a bit vector, or a string. -This function is like `mapcar' but does not accumulate the results, -which is more efficient if you do not use the results. -*/ - (fn, seq)) -{ - mapcar1 (XINT (Flength (seq)), 0, fn, seq); - - return seq; -} - - -/* #### this function doesn't belong in this file! */ - -DEFUN ("load-average", Fload_average, 0, 1, 0, /* -Return list of 1 minute, 5 minute and 15 minute load averages. -Each of the three load averages is multiplied by 100, -then converted to integer. - -When USE-FLOATS is non-nil, floats will be used instead of integers. -These floats are not multiplied by 100. - -If the 5-minute or 15-minute load averages are not available, return a -shortened list, containing only those averages which are available. - -On some systems, this won't work due to permissions on /dev/kmem, -in which case you can't use this. -*/ - (use_floats)) -{ - double load_ave[3]; - int loads = getloadavg (load_ave, countof (load_ave)); - Lisp_Object ret = Qnil; - - if (loads == -2) - error ("load-average not implemented for this operating system"); - else if (loads < 0) - signal_simple_error ("Could not get load-average", - lisp_strerror (errno)); - - while (loads-- > 0) - { - Lisp_Object load = (NILP (use_floats) ? - make_int ((int) (100.0 * load_ave[loads])) - : make_float (load_ave[loads])); - ret = Fcons (load, ret); - } - return ret; -} - - -Lisp_Object Vfeatures; - -DEFUN ("featurep", Ffeaturep, 1, 1, 0, /* -Return non-nil if feature FEXP is present in this Emacs. -Use this to conditionalize execution of lisp code based on the - presence or absence of emacs or environment extensions. -FEXP can be a symbol, a number, or a list. -If it is a symbol, that symbol is looked up in the `features' variable, - and non-nil will be returned if found. -If it is a number, the function will return non-nil if this Emacs - has an equal or greater version number than FEXP. -If it is a list whose car is the symbol `and', it will return - non-nil if all the features in its cdr are non-nil. -If it is a list whose car is the symbol `or', it will return non-nil - if any of the features in its cdr are non-nil. -If it is a list whose car is the symbol `not', it will return - non-nil if the feature is not present. - -Examples: - - (featurep 'xemacs) - => ; Non-nil on XEmacs. - - (featurep '(and xemacs gnus)) - => ; Non-nil on XEmacs with Gnus loaded. - - (featurep '(or tty-frames (and emacs 19.30))) - => ; Non-nil if this Emacs supports TTY frames. - - (featurep '(or (and xemacs 19.15) (and emacs 19.34))) - => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later. - -NOTE: The advanced arguments of this function (anything other than a -symbol) are not yet supported by FSF Emacs. If you feel they are useful -for supporting multiple Emacs variants, lobby Richard Stallman at -. -*/ - (fexp)) -{ -#ifndef FEATUREP_SYNTAX - CHECK_SYMBOL (fexp); - return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt; -#else /* FEATUREP_SYNTAX */ - static double featurep_emacs_version; - - /* Brute force translation from Erik Naggum's lisp function. */ - if (SYMBOLP (fexp)) - { - /* Original definition */ - return NILP (Fmemq (fexp, Vfeatures)) ? Qnil : Qt; - } - else if (INTP (fexp) || FLOATP (fexp)) - { - double d = extract_float (fexp); - - if (featurep_emacs_version == 0.0) - { - featurep_emacs_version = XINT (Vemacs_major_version) + - (XINT (Vemacs_minor_version) / 100.0); - } - return featurep_emacs_version >= d ? Qt : Qnil; - } - else if (CONSP (fexp)) - { - Lisp_Object tem = XCAR (fexp); - if (EQ (tem, Qnot)) - { - Lisp_Object negate; - - tem = XCDR (fexp); - negate = Fcar (tem); - if (!NILP (tem)) - return NILP (call1 (Qfeaturep, negate)) ? Qt : Qnil; - else - return Fsignal (Qinvalid_read_syntax, list1 (tem)); - } - else if (EQ (tem, Qand)) - { - tem = XCDR (fexp); - /* Use Fcar/Fcdr for error-checking. */ - while (!NILP (tem) && !NILP (call1 (Qfeaturep, Fcar (tem)))) - { - tem = Fcdr (tem); - } - return NILP (tem) ? Qt : Qnil; - } - else if (EQ (tem, Qor)) - { - tem = XCDR (fexp); - /* Use Fcar/Fcdr for error-checking. */ - while (!NILP (tem) && NILP (call1 (Qfeaturep, Fcar (tem)))) - { - tem = Fcdr (tem); - } - return NILP (tem) ? Qnil : Qt; - } - else - { - return Fsignal (Qinvalid_read_syntax, list1 (XCDR (fexp))); - } - } - else - { - return Fsignal (Qinvalid_read_syntax, list1 (fexp)); - } -} -#endif /* FEATUREP_SYNTAX */ - -DEFUN ("provide", Fprovide, 1, 1, 0, /* -Announce that FEATURE is a feature of the current Emacs. -This function updates the value of the variable `features'. -*/ - (feature)) -{ - Lisp_Object tem; - CHECK_SYMBOL (feature); - if (!NILP (Vautoload_queue)) - Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue); - tem = Fmemq (feature, Vfeatures); - if (NILP (tem)) - Vfeatures = Fcons (feature, Vfeatures); - LOADHIST_ATTACH (Fcons (Qprovide, feature)); - return feature; -} - -DEFUN ("require", Frequire, 1, 2, 0, /* -If feature FEATURE is not loaded, load it from FILENAME. -If FEATURE is not a member of the list `features', then the feature -is not loaded; so load the file FILENAME. -If FILENAME is omitted, the printname of FEATURE is used as the file name. -*/ - (feature, file_name)) -{ - Lisp_Object tem; - CHECK_SYMBOL (feature); - tem = Fmemq (feature, Vfeatures); - LOADHIST_ATTACH (Fcons (Qrequire, feature)); - if (!NILP (tem)) - return feature; - else - { - int speccount = specpdl_depth (); - - /* Value saved here is to be restored into Vautoload_queue */ - record_unwind_protect (un_autoload, Vautoload_queue); - Vautoload_queue = Qt; - - call4 (Qload, NILP (file_name) ? Fsymbol_name (feature) : file_name, - Qnil, Qt, Qnil); - - tem = Fmemq (feature, Vfeatures); - if (NILP (tem)) - error ("Required feature %s was not provided", - string_data (XSYMBOL (feature)->name)); - - /* Once loading finishes, don't undo it. */ - Vautoload_queue = Qt; - return unbind_to (speccount, feature); - } -} - -/* base64 encode/decode functions. - Based on code from GNU recode. */ - -#define MIME_LINE_LENGTH 76 - -#define IS_ASCII(Character) \ - ((Character) < 128) -#define IS_BASE64(Character) \ - (IS_ASCII (Character) && base64_char_to_value[Character] >= 0) - -/* Table of characters coding the 64 values. */ -static char base64_value_to_char[64] = -{ - 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', /* 0- 9 */ - 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', /* 10-19 */ - 'U', 'V', 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', /* 20-29 */ - 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', /* 30-39 */ - 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', /* 40-49 */ - 'y', 'z', '0', '1', '2', '3', '4', '5', '6', '7', /* 50-59 */ - '8', '9', '+', '/' /* 60-63 */ -}; - -/* Table of base64 values for first 128 characters. */ -static short base64_char_to_value[128] = -{ - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 0- 9 */ - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 10- 19 */ - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 20- 29 */ - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, /* 30- 39 */ - -1, -1, -1, 62, -1, -1, -1, 63, 52, 53, /* 40- 49 */ - 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, /* 50- 59 */ - -1, -1, -1, -1, -1, 0, 1, 2, 3, 4, /* 60- 69 */ - 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, /* 70- 79 */ - 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, /* 80- 89 */ - 25, -1, -1, -1, -1, -1, -1, 26, 27, 28, /* 90- 99 */ - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, /* 100-109 */ - 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, /* 110-119 */ - 49, 50, 51, -1, -1, -1, -1, -1 /* 120-127 */ -}; - -/* The following diagram shows the logical steps by which three octets - get transformed into four base64 characters. - - .--------. .--------. .--------. - |aaaaaabb| |bbbbcccc| |ccdddddd| - `--------' `--------' `--------' - 6 2 4 4 2 6 - .--------+--------+--------+--------. - |00aaaaaa|00bbbbbb|00cccccc|00dddddd| - `--------+--------+--------+--------' - - .--------+--------+--------+--------. - |AAAAAAAA|BBBBBBBB|CCCCCCCC|DDDDDDDD| - `--------+--------+--------+--------' - - The octets are divided into 6 bit chunks, which are then encoded into - base64 characters. */ - -#define ADVANCE_INPUT(c, stream) \ - (ec = Lstream_get_emchar (stream), \ - ec == -1 ? 0 : \ - ((ec > 255) ? \ - (error ("Non-ascii character detected in base64 input"), 0) \ - : (c = (Bufbyte)ec, 1))) - -static Bytind -base64_encode_1 (Lstream *istream, Bufbyte *to, int line_break) -{ - EMACS_INT counter = 0; - Bufbyte *e = to; - Emchar ec; - unsigned int value; - - while (1) - { - Bufbyte c; - if (!ADVANCE_INPUT (c, istream)) - break; - - /* Wrap line every 76 characters. */ - if (line_break) - { - if (counter < MIME_LINE_LENGTH / 4) - counter++; - else - { - *e++ = '\n'; - counter = 1; - } - } - - /* Process first byte of a triplet. */ - *e++ = base64_value_to_char[0x3f & c >> 2]; - value = (0x03 & c) << 4; - - /* Process second byte of a triplet. */ - if (!ADVANCE_INPUT (c, istream)) - { - *e++ = base64_value_to_char[value]; - *e++ = '='; - *e++ = '='; - break; - } - - *e++ = base64_value_to_char[value | (0x0f & c >> 4)]; - value = (0x0f & c) << 2; - - /* Process third byte of a triplet. */ - if (!ADVANCE_INPUT (c, istream)) - { - *e++ = base64_value_to_char[value]; - *e++ = '='; - break; - } - - *e++ = base64_value_to_char[value | (0x03 & c >> 6)]; - *e++ = base64_value_to_char[0x3f & c]; - } - - /* Complete last partial line. */ - if (line_break) - if (counter > 0) - *e++ = '\n'; - - return e - to; -} -#undef ADVANCE_INPUT - -#define ADVANCE_INPUT(c, stream) \ - (ec = Lstream_get_emchar (stream), \ - ec == -1 ? 0 : (c = (Bufbyte)ec, 1)) - -#define INPUT_EOF_P(stream) \ - (ADVANCE_INPUT (c2, stream) \ - ? (Lstream_unget_emchar (stream, (Emchar)c2), 0) \ - : 1) - -#define STORE_BYTE(pos, val) do { \ - pos += set_charptr_emchar (pos, (Emchar)((unsigned char)(val))); \ - ++*ccptr; \ -} while (0) - -static Bytind -base64_decode_1 (Lstream *istream, Bufbyte *to, Charcount *ccptr) -{ - EMACS_INT counter = 0; - Emchar ec; - Bufbyte *e = to; - unsigned long value; - - *ccptr = 0; - while (1) - { - Bufbyte c, c2; - - if (!ADVANCE_INPUT (c, istream)) - break; - - /* Accept wrapping lines, reversibly if at each 76 characters. */ - if (c == '\n') - { - if (!ADVANCE_INPUT (c, istream)) - break; - if (INPUT_EOF_P (istream)) - break; - /* FSF Emacs has this check, apparently inherited from - recode. However, I see no reason to be this picky about - line length -- why reject base64 with say 72-byte lines? - (yes, there are programs that generate them.) */ - /*if (counter != MIME_LINE_LENGTH / 4) return -1;*/ - counter = 1; - } - else - counter++; - - /* Process first byte of a quadruplet. */ - if (!IS_BASE64 (c)) - return -1; - value = base64_char_to_value[c] << 18; - - /* Process second byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 12; - - STORE_BYTE (e, value >> 16); - - /* Process third byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (c == '=') - { - if (!ADVANCE_INPUT (c, istream)) - return -1; - if (c != '=') - return -1; - continue; - } - - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c] << 6; - - STORE_BYTE (e, 0xff & value >> 8); - - /* Process fourth byte of a quadruplet. */ - if (!ADVANCE_INPUT (c, istream)) - return -1; - - if (c == '=') - continue; - - if (!IS_BASE64 (c)) - return -1; - value |= base64_char_to_value[c]; - - STORE_BYTE (e, 0xff & value); - } - - return e - to; -} -#undef ADVANCE_INPUT -#undef INPUT_EOF_P - -static Lisp_Object -free_malloced_ptr (Lisp_Object unwind_obj) -{ - void *ptr = (void *)get_opaque_ptr (unwind_obj); - xfree (ptr); - free_opaque_ptr (unwind_obj); - return Qnil; -} - -/* Don't use alloca for regions larger than this, lest we overflow - the stack. */ -#define MAX_ALLOCA 65536 - -/* We need to setup proper unwinding, because there is a number of - ways these functions can blow up, and we don't want to have memory - leaks in those cases. */ -#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \ - size_t XOA_len = (len); \ - if (XOA_len > MAX_ALLOCA) \ - { \ - ptr = xnew_array (type, XOA_len); \ - record_unwind_protect (free_malloced_ptr, \ - make_opaque_ptr ((void *)ptr)); \ - } \ - else \ - ptr = alloca_array (type, XOA_len); \ -} while (0) - -#define XMALLOC_UNBIND(ptr, len, speccount) do { \ - if ((len) > MAX_ALLOCA) \ - unbind_to (speccount, Qnil); \ -} while (0) - -DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* -Base64-encode the region between BEG and END. -Return the length of the encoded text. -Optional third argument NO-LINE-BREAK means do not break long lines -into shorter lines. -*/ - (beg, end, no_line_break)) -{ - Bufbyte *encoded; - Bytind encoded_length; - Charcount allength, length; - struct buffer *buf = current_buffer; - Bufpos begv, zv, old_pt = BUF_PT (buf); - Lisp_Object input; - int speccount = specpdl_depth(); - - get_buffer_range_char (buf, beg, end, &begv, &zv, 0); - barf_if_buffer_read_only (buf, begv, zv); - - /* We need to allocate enough room for encoding the text. - We need 33 1/3% more space, plus a newline every 76 - characters, and then we round up. */ - length = zv - begv; - allength = length + length/3 + 1; - allength += allength / MIME_LINE_LENGTH + 1 + 6; - - input = make_lisp_buffer_input_stream (buf, begv, zv, 0); - /* We needn't multiply allength with MAX_EMCHAR_LEN because all the - base64 characters will be single-byte. */ - XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte); - encoded_length = base64_encode_1 (XLSTREAM (input), encoded, - NILP (no_line_break)); - if (encoded_length > allength) - abort (); - Lstream_delete (XLSTREAM (input)); - - /* Now we have encoded the region, so we insert the new contents - and delete the old. (Insert first in order to preserve markers.) */ - buffer_insert_raw_string_1 (buf, begv, encoded, encoded_length, 0); - XMALLOC_UNBIND (encoded, allength, speccount); - buffer_delete_range (buf, begv + encoded_length, zv + encoded_length, 0); - - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ - if (old_pt >= begv && old_pt < zv) - BUF_SET_PT (buf, begv); - - /* We return the length of the encoded text. */ - return make_int (encoded_length); -} - -DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 1, 0, /* -Base64 encode STRING and return the result. -*/ - (string)) -{ - Charcount allength, length; - Bytind encoded_length; - Bufbyte *encoded; - Lisp_Object input, result; - int speccount = specpdl_depth(); - - CHECK_STRING (string); - - length = XSTRING_CHAR_LENGTH (string); - allength = length + length/3 + 1 + 6; - - input = make_lisp_string_input_stream (string, 0, -1); - XMALLOC_OR_ALLOCA (encoded, allength, Bufbyte); - encoded_length = base64_encode_1 (XLSTREAM (input), encoded, 0); - if (encoded_length > allength) - abort (); - Lstream_delete (XLSTREAM (input)); - result = make_string (encoded, encoded_length); - XMALLOC_UNBIND (encoded, allength, speccount); - return result; -} - -DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* -Base64-decode the region between BEG and END. -Return the length of the decoded text. -If the region can't be decoded, return nil and don't modify the buffer. -*/ - (beg, end)) -{ - struct buffer *buf = current_buffer; - Bufpos begv, zv, old_pt = BUF_PT (buf); - Bufbyte *decoded; - Bytind decoded_length; - Charcount length, cc_decoded_length; - Lisp_Object input; - int speccount = specpdl_depth(); - - get_buffer_range_char (buf, beg, end, &begv, &zv, 0); - barf_if_buffer_read_only (buf, begv, zv); - - length = zv - begv; - - input = make_lisp_buffer_input_stream (buf, begv, zv, 0); - /* We need to allocate enough room for decoding the text. */ - XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte); - decoded_length = base64_decode_1 (XLSTREAM (input), decoded, &cc_decoded_length); - if (decoded_length > length * MAX_EMCHAR_LEN) - abort (); - Lstream_delete (XLSTREAM (input)); - - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - - /* Now we have decoded the region, so we insert the new contents - and delete the old. (Insert first in order to preserve markers.) */ - BUF_SET_PT (buf, begv); - buffer_insert_raw_string_1 (buf, begv, decoded, decoded_length, 0); - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - buffer_delete_range (buf, begv + cc_decoded_length, - zv + cc_decoded_length, 0); - - /* Simulate FSF Emacs: if point was in the region, place it at the - beginning. */ - if (old_pt >= begv && old_pt < zv) - BUF_SET_PT (buf, begv); - - return make_int (cc_decoded_length); -} - -DEFUN ("base64-decode-string", Fbase64_decode_string, 1, 1, 0, /* -Base64-decode STRING and return the result. -*/ - (string)) -{ - Bufbyte *decoded; - Bytind decoded_length; - Charcount length, cc_decoded_length; - Lisp_Object input, result; - int speccount = specpdl_depth(); - - CHECK_STRING (string); - - length = XSTRING_CHAR_LENGTH (string); - /* We need to allocate enough room for decoding the text. */ - XMALLOC_OR_ALLOCA (decoded, length * MAX_EMCHAR_LEN, Bufbyte); - - input = make_lisp_string_input_stream (string, 0, -1); - decoded_length = base64_decode_1 (XLSTREAM (input), decoded, - &cc_decoded_length); - if (decoded_length > length * MAX_EMCHAR_LEN) - abort (); - Lstream_delete (XLSTREAM (input)); - - if (decoded_length < 0) - { - /* The decoding wasn't possible. */ - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return Qnil; - } - - result = make_string (decoded, decoded_length); - XMALLOC_UNBIND (decoded, length * MAX_EMCHAR_LEN, speccount); - return result; -} - -Lisp_Object Qyes_or_no_p; - -void -syms_of_fns (void) -{ - defsymbol (&Qstring_lessp, "string-lessp"); - defsymbol (&Qidentity, "identity"); - defsymbol (&Qyes_or_no_p, "yes-or-no-p"); - - DEFSUBR (Fidentity); - DEFSUBR (Frandom); - DEFSUBR (Flength); - DEFSUBR (Fsafe_length); - DEFSUBR (Fstring_equal); - DEFSUBR (Fstring_lessp); - DEFSUBR (Fstring_modified_tick); - DEFSUBR (Fappend); - DEFSUBR (Fconcat); - DEFSUBR (Fvconcat); - DEFSUBR (Fbvconcat); - DEFSUBR (Fcopy_list); - DEFSUBR (Fcopy_sequence); - DEFSUBR (Fcopy_alist); - DEFSUBR (Fcopy_tree); - DEFSUBR (Fsubstring); - DEFSUBR (Fsubseq); - DEFSUBR (Fnthcdr); - DEFSUBR (Fnth); - DEFSUBR (Felt); - DEFSUBR (Flast); - DEFSUBR (Fbutlast); - DEFSUBR (Fnbutlast); - DEFSUBR (Fmember); - DEFSUBR (Fold_member); - DEFSUBR (Fmemq); - DEFSUBR (Fold_memq); - DEFSUBR (Fassoc); - DEFSUBR (Fold_assoc); - DEFSUBR (Fassq); - DEFSUBR (Fold_assq); - DEFSUBR (Frassoc); - DEFSUBR (Fold_rassoc); - DEFSUBR (Frassq); - DEFSUBR (Fold_rassq); - DEFSUBR (Fdelete); - DEFSUBR (Fold_delete); - DEFSUBR (Fdelq); - DEFSUBR (Fold_delq); - DEFSUBR (Fremassoc); - DEFSUBR (Fremassq); - DEFSUBR (Fremrassoc); - DEFSUBR (Fremrassq); - DEFSUBR (Fnreverse); - DEFSUBR (Freverse); - DEFSUBR (Fsort); - DEFSUBR (Fplists_eq); - DEFSUBR (Fplists_equal); - DEFSUBR (Flax_plists_eq); - DEFSUBR (Flax_plists_equal); - DEFSUBR (Fplist_get); - DEFSUBR (Fplist_put); - DEFSUBR (Fplist_remprop); - DEFSUBR (Fplist_member); - DEFSUBR (Fcheck_valid_plist); - DEFSUBR (Fvalid_plist_p); - DEFSUBR (Fcanonicalize_plist); - DEFSUBR (Flax_plist_get); - DEFSUBR (Flax_plist_put); - DEFSUBR (Flax_plist_remprop); - DEFSUBR (Flax_plist_member); - DEFSUBR (Fcanonicalize_lax_plist); - DEFSUBR (Fdestructive_alist_to_plist); - DEFSUBR (Fget); - DEFSUBR (Fput); - DEFSUBR (Fremprop); - DEFSUBR (Fobject_plist); - DEFSUBR (Fequal); - DEFSUBR (Fold_equal); - DEFSUBR (Ffillarray); - DEFSUBR (Fnconc); - DEFSUBR (Fmapcar); - DEFSUBR (Fmapvector); - DEFSUBR (Fmapc); - DEFSUBR (Fmapconcat); - DEFSUBR (Fload_average); - DEFSUBR (Ffeaturep); - DEFSUBR (Frequire); - DEFSUBR (Fprovide); - DEFSUBR (Fbase64_encode_region); - DEFSUBR (Fbase64_encode_string); - DEFSUBR (Fbase64_decode_region); - DEFSUBR (Fbase64_decode_string); -} - -void -init_provide_once (void) -{ - DEFVAR_LISP ("features", &Vfeatures /* -A list of symbols which are the features of the executing emacs. -Used by `featurep' and `require', and altered by `provide'. -*/ ); - Vfeatures = Qnil; -} diff --git a/src/font-lock.c b/src/font-lock.c deleted file mode 100644 index cefa0d5..0000000 --- a/src/font-lock.c +++ /dev/null @@ -1,776 +0,0 @@ -/* Routines to compute the current syntactic context, for font-lock mode. - Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Sun Microsystems, 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 code computes the syntactic context of the current point, that is, - whether point is within a comment, a string, what have you. It does - this by picking a point "known" to be outside of any syntactic constructs - and moving forward, examining the syntax of each character. - - Two caches are used: one caches the last point computed, and the other - caches the last point at the beginning of a line. This makes there - be little penalty for moving left-to-right on a line a character at a - time; makes starting over on a line be cheap; and makes random-accessing - within a line relatively cheap. - - When we move to a different line farther down in the file (but within the - current top-level form) we simply continue computing forward. If we move - backward more than a line, or move beyond the end of the current tlf, or - switch buffers, then we call `beginning-of-defun' and start over from - there. - - #### We should really rewrite this to keep extents over the buffer - that hold the current syntactic information. This would be a big win. - This way there would be no guessing or incorrect results. - */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "insdel.h" -#include "syntax.h" - -Lisp_Object Qcomment; -Lisp_Object Qblock_comment; -Lisp_Object Qbeginning_of_defun; - -enum syntactic_context -{ - context_none, - context_string, - context_comment, - context_block_comment -}; - -enum block_comment_context -{ - ccontext_none, - ccontext_start1, - ccontext_start2, - ccontext_end1 -}; - -enum comment_style -{ - comment_style_none, - comment_style_a, - comment_style_b -}; - -struct context_cache -{ - Bufpos start_point; /* beginning of defun */ - Bufpos cur_point; /* cache location */ - Bufpos end_point; /* end of defun */ - struct buffer *buffer; /* does this need to be staticpro'd? */ - enum syntactic_context context; /* single-char-syntax state */ - enum block_comment_context ccontext; /* block-comment state */ - enum comment_style style; /* which comment group */ - Emchar scontext; /* active string delimiter */ - int depth; /* depth in parens */ - int backslash_p; /* just read a backslash */ - int needs_its_head_reexamined; /* we're apparently outside of - a top level form, and far away - from it. This is a bad situation - because it will lead to constant - slowness as we keep going way - back to that form and moving - forward again. In this case, - we try to compute a "pseudo- - top-level-form" where the - depth is 0 and the context - is none at both ends. */ -}; - -/* We have two caches; one for the current point and one for - the beginning of line. We used to rely on the caller to - tell us when to invalidate them, but now we do it ourselves; - it lets us be smarter. */ - -static struct context_cache context_cache; - -static struct context_cache bol_context_cache; - -int font_lock_debug; - -#define reset_context_cache(cc) memset (cc, 0, sizeof (struct context_cache)) - -/* This function is called from signal_after_change() to tell us when - textual changes are made so we can flush our caches when necessary. - - We make the following somewhat heuristic assumptions: - - (remember that current_point is always >= start_point, but may be - less than or greater than end_point (we might not be inside any - top-level form)). - - 1) Textual changes before the beginning of the current top-level form - don't affect anything; all we need to do is offset the caches - appropriately. - 2) Textual changes right at the beginning of the current - top-level form messes things up and requires that we flush - the caches. - 3) Textual changes after the beginning of the current top-level form - and before one or both or the caches invalidates the corresponding - cache(s). - 4) Textual changes after the caches and before the end of the - current top-level form don't affect anything; all we need to do is - offset the caches appropriately. - 5) Textual changes right at the end of the current top-level form - necessitate recomputing that end value. - 6) Textual changes after the end of the current top-level form - are ignored. */ - - -void -font_lock_maybe_update_syntactic_caches (struct buffer *buf, Bufpos start, - Bufpos orig_end, Bufpos new_end) -{ - /* Note: either both context_cache and bol_context_cache are valid and - point to the same buffer, or both are invalid. If we have to - invalidate just context_cache, we recopy it from bol_context_cache. - */ - if (context_cache.buffer != buf) - /* caches don't apply */ - return; - /* NOTE: The order of the if statements below is important. If you - change them around unthinkingly, you will probably break something. */ - if (orig_end <= context_cache.start_point - 1) - { - /* case 1: before the beginning of the current top-level form */ - Charcount diff = new_end - orig_end; - if (font_lock_debug) - stderr_out ("font-lock; Case 1\n"); - context_cache.start_point += diff; - context_cache.cur_point += diff; - context_cache.end_point += diff; - bol_context_cache.start_point += diff; - bol_context_cache.cur_point += diff; - bol_context_cache.end_point += diff; - } - else if (start <= context_cache.start_point) - { - if (font_lock_debug) - stderr_out ("font-lock; Case 2\n"); - /* case 2: right at the current top-level form (paren that starts - top level form got deleted or moved away from the newline it - was touching) */ - reset_context_cache (&context_cache); - reset_context_cache (&bol_context_cache); - } - /* OK, now we know that the start is after the beginning of the - current top-level form. */ - else if (start < bol_context_cache.cur_point) - { - if (font_lock_debug) - stderr_out ("font-lock; Case 3 (1)\n"); - /* case 3: after the beginning of the current top-level form - and before both of the caches */ - reset_context_cache (&context_cache); - reset_context_cache (&bol_context_cache); - } - else if (start < context_cache.cur_point) - { - if (font_lock_debug) - stderr_out ("font-lock; Case 3 (2)\n"); - /* case 3: but only need to invalidate one cache */ - context_cache = bol_context_cache; - } - /* OK, now we know that the start is after the caches. */ - else if (start >= context_cache.end_point) - { - if (font_lock_debug) - stderr_out ("font-lock; Case 6\n"); - /* case 6: after the end of the current top-level form - and after the caches. */ - } - else if (orig_end <= context_cache.end_point - 2) - { - /* case 4: after the caches and before the end of the - current top-level form */ - Charcount diff = new_end - orig_end; - if (font_lock_debug) - stderr_out ("font-lock; Case 4\n"); - context_cache.end_point += diff; - bol_context_cache.end_point += diff; - } - else - { - if (font_lock_debug) - stderr_out ("font-lock; Case 5\n"); - /* case 5: right at the end of the current top-level form */ - context_cache.end_point = context_cache.start_point - 1; - bol_context_cache.end_point = context_cache.start_point - 1; - } -} - -/* This function is called from Fkill_buffer(). */ - -void -font_lock_buffer_was_killed (struct buffer *buf) -{ - if (context_cache.buffer == buf) - { - reset_context_cache (&context_cache); - reset_context_cache (&bol_context_cache); - } -} - -static Bufpos -beginning_of_defun (struct buffer *buf, Bufpos pt) -{ - /* This function can GC */ - Bufpos opt = BUF_PT (buf); - if (pt == BUF_BEGV (buf)) - return pt; - BUF_SET_PT (buf, pt); - /* There used to be some kludginess to call c++-beginning-of-defun - if we're in C++ mode. There's no point in this any more; - we're using cc-mode. If you really want to get the old c++ - mode working, fix it rather than the C code. */ - call0_in_buffer (buf, Qbeginning_of_defun); - pt = BUF_PT (buf); - BUF_SET_PT (buf, opt); - return pt; -} - -static Bufpos -end_of_defun (struct buffer *buf, Bufpos pt) -{ - Lisp_Object retval = scan_lists (buf, pt, 1, 0, 0, 1); - if (NILP (retval)) - return BUF_ZV (buf); - else - return XINT (retval); -} - -/* Set up context_cache for attempting to determine the syntactic context - in buffer BUF at point PT. */ - -static void -setup_context_cache (struct buffer *buf, Bufpos pt) -{ - int recomputed_start_point = 0; - /* This function can GC */ - if (context_cache.buffer != buf || pt < context_cache.start_point) - { - start_over: - if (font_lock_debug) - stderr_out ("reset context cache\n"); - /* OK, completely invalid. */ - reset_context_cache (&context_cache); - reset_context_cache (&bol_context_cache); - } - if (!context_cache.buffer) - { - /* Need to recompute the start point. */ - if (font_lock_debug) - stderr_out ("recompute start\n"); - context_cache.start_point = beginning_of_defun (buf, pt); - recomputed_start_point = 1; - bol_context_cache.start_point = context_cache.start_point; - bol_context_cache.buffer = context_cache.buffer = buf; - } - if (context_cache.end_point < context_cache.start_point) - { - /* Need to recompute the end point. */ - if (font_lock_debug) - stderr_out ("recompute end\n"); - context_cache.end_point = end_of_defun (buf, context_cache.start_point); - bol_context_cache.end_point = context_cache.end_point; - } - if (bol_context_cache.cur_point == 0 || - pt < bol_context_cache.cur_point) - { - if (font_lock_debug) - stderr_out ("reset to start\n"); - if (pt > context_cache.end_point - /* 3000 is some arbitrary delta but seems reasonable; - about the size of a reasonable function */ - && pt - context_cache.end_point > 3000) - /* If we're far past the end of the top level form, - don't trust it; recompute it. */ - { - /* But don't get in an infinite loop doing this. - If we're really far past the end of the top level - form, try to compute a pseudo-top-level form. */ - if (recomputed_start_point) - context_cache.needs_its_head_reexamined = 1; - else - /* force recomputation */ - goto start_over; - } - /* Go to the nearest end of the top-level form that's before - us. */ - if (pt > context_cache.end_point) - pt = context_cache.end_point; - else - pt = context_cache.start_point; - /* Reset current point to start of buffer. */ - context_cache.cur_point = pt; - context_cache.context = context_none; - context_cache.ccontext = ccontext_none; - context_cache.style = comment_style_none; - context_cache.scontext = '\000'; - context_cache.depth = 0; - context_cache.backslash_p = ((pt > 1) && - (BUF_FETCH_CHAR (buf, pt - 1) == '\\')); - /* Note that the BOL context cache may not be at the beginning - of the line, but that should be OK, nobody's checking. */ - bol_context_cache = context_cache; - return; - } - else if (pt < context_cache.cur_point) - { - if (font_lock_debug) - stderr_out ("reset to bol\n"); - /* bol cache is OK but current_cache is not. */ - context_cache = bol_context_cache; - return; - } - else if (pt <= context_cache.end_point) - { - if (font_lock_debug) - stderr_out ("everything is OK\n"); - /* in same top-level form. */ - return; - } - { - /* OK, we're past the end of the top-level form. */ - Bufpos maxpt = max (context_cache.end_point, context_cache.cur_point); -#if 0 - int shortage; -#endif - - if (font_lock_debug) - stderr_out ("past end\n"); - if (pt <= maxpt) - /* OK, fine. */ - return; -#if 0 - /* This appears to cause huge slowdowns in files like - emacsfns.h, which have no top-level forms. - - In any case, it's not really necessary that we know for - sure the top-level form we're in; if we're in a form - but the form we have recorded is the previous one, - it will be OK. */ - - scan_buffer (buf, '\n', maxpt, pt, 1, &shortage, 1); - if (!shortage) - /* If there was a newline in the region past the known universe, - we might be inside another top-level form, so start over. - Otherwise, we're outside of any top-level forms and we know - the one directly before us, so it's OK. */ - goto start_over; -#endif - } -} - -#define SYNTAX_START_STYLE(table, c1, c2) \ - (SYNTAX_STYLES_MATCH_START_P (table, c1, c2, SYNTAX_COMMENT_STYLE_A) ? \ - comment_style_a : \ - SYNTAX_STYLES_MATCH_START_P (table, c1, c2, SYNTAX_COMMENT_STYLE_B) ? \ - comment_style_b : \ - comment_style_none) - -#define SYNTAX_END_STYLE(table, c1, c2) \ - (SYNTAX_STYLES_MATCH_END_P (table, c1, c2, SYNTAX_COMMENT_STYLE_A) ? \ - comment_style_a : \ - SYNTAX_STYLES_MATCH_END_P (table, c1, c2, SYNTAX_COMMENT_STYLE_B) ? \ - comment_style_b : \ - comment_style_none) - -#define SINGLE_SYNTAX_STYLE(table, c) \ - (SYNTAX_STYLES_MATCH_1CHAR_P (table, c, SYNTAX_COMMENT_STYLE_A) ? \ - comment_style_a : \ - SYNTAX_STYLES_MATCH_1CHAR_P (table, c, SYNTAX_COMMENT_STYLE_B) ? \ - comment_style_b : \ - comment_style_none) - -/* Set up context_cache for position PT in BUF. */ - -static void -find_context (struct buffer *buf, Bufpos pt) -{ - /* This function can GC */ - struct Lisp_Char_Table *mirrortab = - XCHAR_TABLE (buf->mirror_syntax_table); - Lisp_Object syntaxtab = buf->syntax_table; - Emchar prev_c, c; - Bufpos target = pt; - setup_context_cache (buf, pt); - pt = context_cache.cur_point; - - if (pt > BUF_BEGV (buf)) - c = BUF_FETCH_CHAR (buf, pt - 1); - else - c = '\n'; /* to get bol_context_cache at point-min */ - - for (; pt < target; pt++, context_cache.cur_point = pt) - { - if (context_cache.needs_its_head_reexamined) - { - if (context_cache.depth == 0 - && context_cache.context == context_none) - { - /* We've found an anchor spot. - Try to put the start of defun within 6000 chars of - the target, and the end of defun as close as possible. - 6000 is also arbitrary but tries to strike a balance - between two conflicting pulls when dealing with a - file that has lots of stuff sitting outside of a top- - level form: - - a) If you move past the start of defun, you will - have to recompute defun, which in this case - means that start of defun goes all the way back - to the beginning of the file; so you want - to set start of defun a ways back from the - current point. - b) If you move a line backwards but within start of - defun, you have to move back to start of defun; - so you don't want start of defun too far from - the current point. - */ - if (target - context_cache.start_point > 6000) - context_cache.start_point = pt; - context_cache.end_point = pt; - bol_context_cache = context_cache; - } - } - - prev_c = c; - c = BUF_FETCH_CHAR (buf, pt); - - if (prev_c == '\n') - bol_context_cache = context_cache; - - if (context_cache.backslash_p) - { - context_cache.backslash_p = 0; - continue; - } - - switch (SYNTAX (mirrortab, c)) - { - case Sescape: - context_cache.backslash_p = 1; - break; - - case Sopen: - if (context_cache.context == context_none) - context_cache.depth++; - break; - - case Sclose: - if (context_cache.context == context_none) - context_cache.depth--; - break; - - case Scomment: - if (context_cache.context == context_none) - { - context_cache.context = context_comment; - context_cache.ccontext = ccontext_none; - context_cache.style = SINGLE_SYNTAX_STYLE (mirrortab, c); - if (context_cache.style == comment_style_none) abort (); - } - break; - - case Sendcomment: - if (context_cache.style != SINGLE_SYNTAX_STYLE (mirrortab, c)) - ; - else if (context_cache.context == context_comment) - { - context_cache.context = context_none; - context_cache.style = comment_style_none; - } - else if (context_cache.context == context_block_comment && - (context_cache.ccontext == ccontext_start2 || - context_cache.ccontext == ccontext_end1)) - { - context_cache.context = context_none; - context_cache.ccontext = ccontext_none; - context_cache.style = comment_style_none; - } - break; - - case Sstring: - { - if (context_cache.context == context_string && - context_cache.scontext == c) - { - context_cache.context = context_none; - context_cache.scontext = '\000'; - } - else if (context_cache.context == context_none) - { - Lisp_Object stringtermobj = syntax_match (syntaxtab, c); - Emchar stringterm; - - if (CHARP (stringtermobj)) - stringterm = XCHAR (stringtermobj); - else - stringterm = c; - context_cache.context = context_string; - context_cache.scontext = stringterm; - context_cache.ccontext = ccontext_none; - } - break; - } - default: - ; - } - - /* That takes care of the characters with manifest syntax. - Now we've got to hack multi-char sequences that start - and end block comments. - */ - if ((SYNTAX_COMMENT_BITS (mirrortab, c) & - SYNTAX_SECOND_CHAR_START) && - context_cache.context == context_none && - context_cache.ccontext == ccontext_start1 && - SYNTAX_START_P (mirrortab, prev_c, c) /* the two chars match */ - ) - { - context_cache.ccontext = ccontext_start2; - context_cache.style = SYNTAX_START_STYLE (mirrortab, prev_c, c); - if (context_cache.style == comment_style_none) abort (); - } - else if ((SYNTAX_COMMENT_BITS (mirrortab, c) & - SYNTAX_FIRST_CHAR_START) && - context_cache.context == context_none && - (context_cache.ccontext == ccontext_none || - context_cache.ccontext == ccontext_start1)) - { - context_cache.ccontext = ccontext_start1; - context_cache.style = comment_style_none; /* should be this already*/ - } - else if ((SYNTAX_COMMENT_BITS (mirrortab, c) & - SYNTAX_SECOND_CHAR_END) && - context_cache.context == context_block_comment && - context_cache.ccontext == ccontext_end1 && - SYNTAX_END_P (mirrortab, prev_c, c) && - /* the two chars match */ - context_cache.style == - SYNTAX_END_STYLE (mirrortab, prev_c, c) - ) - { - context_cache.context = context_none; - context_cache.ccontext = ccontext_none; - context_cache.style = comment_style_none; - } - else if ((SYNTAX_COMMENT_BITS (mirrortab, c) & - SYNTAX_FIRST_CHAR_END) && - context_cache.context == context_block_comment && - (context_cache.style == - SYNTAX_END_STYLE (mirrortab, c, - BUF_FETCH_CHAR (buf, pt+1))) && - (context_cache.ccontext == ccontext_start2 || - context_cache.ccontext == ccontext_end1)) - /* #### is it right to check for end1 here?? */ - { - if (context_cache.style == comment_style_none) abort (); - context_cache.ccontext = ccontext_end1; - } - - else if (context_cache.ccontext == ccontext_start1) - { - if (context_cache.context != context_none) abort (); - context_cache.ccontext = ccontext_none; - } - else if (context_cache.ccontext == ccontext_end1) - { - if (context_cache.context != context_block_comment) abort (); - context_cache.context = context_none; - context_cache.ccontext = ccontext_start2; - } - - if (context_cache.ccontext == ccontext_start2 && - context_cache.context == context_none) - { - context_cache.context = context_block_comment; - if (context_cache.style == comment_style_none) abort (); - } - else if (context_cache.ccontext == ccontext_none && - context_cache.context == context_block_comment) - { - context_cache.context = context_none; - } - } - - context_cache.needs_its_head_reexamined = 0; -} - -static Lisp_Object -context_to_symbol (enum syntactic_context context) -{ - switch (context) - { - case context_none: return Qnil; - case context_string: return Qstring; - case context_comment: return Qcomment; - case context_block_comment: return Qblock_comment; - default: abort (); return Qnil; /* suppress compiler warning */ - } -} - -DEFUN ("buffer-syntactic-context", Fbuffer_syntactic_context, 0, 1, 0, /* -Return the syntactic context of BUFFER at point. -If BUFFER is nil or omitted, the current buffer is assumed. -The returned value is one of the following symbols: - - nil ; meaning no special interpretation - string ; meaning point is within a string - comment ; meaning point is within a line comment - block-comment ; meaning point is within a block comment - -See also the function `buffer-syntactic-context-depth', which returns -the current nesting-depth within all parenthesis-syntax delimiters -and the function `syntactically-sectionize', which will map a function -over each syntactic context in a region. - -WARNING: this may alter match-data. -*/ - (buffer)) -{ - /* This function can GC */ - struct buffer *buf = decode_buffer (buffer, 0); - find_context (buf, BUF_PT (buf)); - return context_to_symbol (context_cache.context); -} - -DEFUN ("buffer-syntactic-context-depth", Fbuffer_syntactic_context_depth, - 0, 1, 0, /* -Return the depth within all parenthesis-syntax delimiters at point. -If BUFFER is nil or omitted, the current buffer is assumed. -WARNING: this may alter match-data. -*/ - (buffer)) -{ - /* This function can GC */ - struct buffer *buf = decode_buffer (buffer, 0); - find_context (buf, BUF_PT (buf)); - return make_int (context_cache.depth); -} - - -DEFUN ("syntactically-sectionize", Fsyntactically_sectionize, 3, 4, 0, /* -Call FUNCTION for each contiguous syntactic context in the region. -Call the given function with four arguments: the start and end of the -region, a symbol representing the syntactic context, and the current -depth (as returned by the functions `buffer-syntactic-context' and -`buffer-syntactic-context-depth'). When this function is called, the -current buffer will be set to BUFFER. - -WARNING: this may alter match-data. -*/ - (function, start, end, buffer)) -{ - /* This function can GC */ - Bufpos s, pt, e; - int edepth; - enum syntactic_context this_context; - Lisp_Object extent = Qnil; - struct gcpro gcpro1; - struct buffer *buf = decode_buffer (buffer, 0); - - get_buffer_range_char (buf, start, end, &s, &e, 0); - - pt = s; - find_context (buf, pt); - - GCPRO1 (extent); - while (pt < e) - { - Bufpos estart, eend; - /* skip over "blank" areas, and bug out at end-of-buffer. */ - while (context_cache.context == context_none) - { - pt++; - if (pt >= e) goto DONE_LABEL; - find_context (buf, pt); - } - /* We've found a non-blank area; keep going until we reach its end */ - this_context = context_cache.context; - estart = pt; - - /* Minor kludge: consider the comment-start character(s) a part of - the comment. - */ - if (this_context == context_block_comment && - context_cache.ccontext == ccontext_start2) - estart -= 2; - else if (this_context == context_comment) - estart -= 1; - - edepth = context_cache.depth; - while (context_cache.context == this_context && pt < e) - { - pt++; - find_context (buf, pt); - } - - eend = pt; - - /* Minor kludge: consider the character which terminated the comment - a part of the comment. - */ - if ((this_context == context_block_comment || - this_context == context_comment) - && pt < e) - eend++; - - if (estart == eend) - continue; - /* Make sure not to pass in values that are outside the - actual bounds of this function. */ - call4_in_buffer (buf, function, make_int (max (s, estart)), - make_int (eend == e ? e : eend - 1), - context_to_symbol (this_context), - make_int (edepth)); - } - DONE_LABEL: - UNGCPRO; - return Qnil; -} - -void -syms_of_font_lock (void) -{ - defsymbol (&Qcomment, "comment"); - defsymbol (&Qblock_comment, "block-comment"); - defsymbol (&Qbeginning_of_defun, "beginning-of-defun"); - - DEFSUBR (Fbuffer_syntactic_context); - DEFSUBR (Fbuffer_syntactic_context_depth); - DEFSUBR (Fsyntactically_sectionize); -} - -void -vars_of_font_lock (void) -{ - xzero (context_cache); - xzero (bol_context_cache); -} diff --git a/src/frame-msw.c b/src/frame-msw.c deleted file mode 100644 index 5a88a67..0000000 --- a/src/frame-msw.c +++ /dev/null @@ -1,794 +0,0 @@ -/* Functions for the mswindows window system. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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. */ - -/* Authorship: - - Ultimately based on FSF. - Substantially rewritten for XEmacs by Ben Wing. - Rewritten for mswindows by Jonathan Harris, November 1997 for 21.0. - Graphics features added and frame resizing fiddled with by Andy Piper. - */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "elhash.h" -#include "console-msw.h" -#include "glyphs-msw.h" -#include "elhash.h" -#include "events.h" -#include "faces.h" -#include "frame.h" -#include "redisplay.h" -#include "window.h" - -#define MSWINDOWS_FRAME_STYLE (WS_CLIPCHILDREN | WS_CLIPSIBLINGS | WS_OVERLAPPEDWINDOW) -#define MSWINDOWS_POPUP_STYLE (WS_CLIPCHILDREN | WS_CLIPSIBLINGS | WS_POPUP \ - | WS_CAPTION | WS_BORDER | WS_SYSMENU | WS_MINIMIZEBOX) - -#define MSWINDOWS_FRAME_EXSTYLE WS_EX_OVERLAPPEDWINDOW -#define MSWINDOWS_POPUP_EXSTYLE WS_EX_PALETTEWINDOW - -/* Default popup left top corner offset from the same - corner of the parent frame, in pixel */ -#define POPUP_OFFSET 30 - -/* Default popup size, in characters */ -#define POPUP_WIDTH 30 -#define POPUP_HEIGHT 10 - -/* Default popup size, in characters */ -#define DEFAULT_FRAME_WIDTH 80 -#define DEFAULT_FRAME_HEIGHT 35 - -#ifdef HAVE_MENUBARS -#define ADJR_MENUFLAG TRUE -#else -#define ADJR_MENUFLAG FALSE -#endif - -/* Default properties to use when creating frames. */ -Lisp_Object Vdefault_mswindows_frame_plist; -Lisp_Object Vmswindows_use_system_frame_size_defaults; - -/* This does not need to be GC protected, as it holds a - frame Lisp_Object already protected by Fmake_frame */ -Lisp_Object Vmswindows_frame_being_created; - -static void -mswindows_init_frame_1 (struct frame *f, Lisp_Object props) -{ - Lisp_Object initially_unmapped; - Lisp_Object name, height, width, popup, top, left; - Lisp_Object frame_obj = Qnil; - RECT rect; - XEMACS_RECT_WH rect_default; - DWORD style, exstyle; - HWND hwnd, hwnd_parent; - - /* Pick up relevant properties */ - initially_unmapped = Fplist_get (props, Qinitially_unmapped, Qnil); - name = Fplist_get (props, Qname, Qnil); - - popup = Fplist_get (props, Qpopup, Qnil); - if (EQ (popup, Qt)) - popup = Fselected_frame (Qnil); - - left = Fplist_get (props, Qleft, Qnil); - if (!NILP (left)) - CHECK_INT (left); - - top = Fplist_get (props, Qtop, Qnil); - if (!NILP (top)) - CHECK_INT (top); - - width = Fplist_get (props, Qwidth, Qnil); - if (!NILP (width)) - CHECK_INT (width); - - height = Fplist_get (props, Qheight, Qnil); - if (!NILP (height)) - CHECK_INT (height); - - f->frame_data = xnew_and_zero (struct mswindows_frame); - FRAME_MSWINDOWS_TARGET_RECT (f) = xnew_and_zero (XEMACS_RECT_WH); - - FRAME_MSWINDOWS_TARGET_RECT (f)->left = NILP (left) ? -1 : abs (XINT (left)); - FRAME_MSWINDOWS_TARGET_RECT (f)->top = NILP (top) ? -1 : abs (XINT (top)); - FRAME_MSWINDOWS_TARGET_RECT (f)->width = NILP (width) ? -1 : - abs (XINT (width)); - FRAME_MSWINDOWS_TARGET_RECT (f)->height = NILP (height) ? -1 : - abs (XINT (height)); - - /* Misc frame stuff */ - FRAME_MSWINDOWS_DATA(f)->button2_need_lbutton = 0; - FRAME_MSWINDOWS_DATA(f)->button2_need_rbutton = 0; - FRAME_MSWINDOWS_DATA(f)->button2_is_down = 0; - FRAME_MSWINDOWS_DATA(f)->ignore_next_lbutton_up = 0; - FRAME_MSWINDOWS_DATA(f)->ignore_next_rbutton_up = 0; - FRAME_MSWINDOWS_DATA(f)->sizing = 0; - FRAME_MSWINDOWS_MENU_HASH_TABLE(f) = Qnil; -#ifdef HAVE_TOOLBARS - FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE(f) = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); -#endif - /* hashtable of instantiated glyphs on the frame. */ - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f) = - make_lisp_hash_table (50, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL); - /* Will initialize these in WM_SIZE handler. We cannot do it now, - because we do not know what is CW_USEDEFAULT height and width */ - FRAME_WIDTH (f) = 0; - FRAME_HEIGHT (f) = 0; - FRAME_PIXWIDTH (f) = 0; - FRAME_PIXHEIGHT (f) = 0; - - if (NILP (popup)) - { - style = MSWINDOWS_FRAME_STYLE; - exstyle = MSWINDOWS_FRAME_EXSTYLE; - hwnd_parent = NULL; - - rect_default.left = rect_default.top = CW_USEDEFAULT; - rect_default.width = rect_default.height = CW_USEDEFAULT; - } - else - { - style = MSWINDOWS_POPUP_STYLE; - exstyle = MSWINDOWS_POPUP_EXSTYLE; - - CHECK_MSWINDOWS_FRAME (popup); - hwnd_parent = FRAME_MSWINDOWS_HANDLE (XFRAME (popup)); - assert (IsWindow (hwnd_parent)); - - /* We cannot use CW_USEDEFAULT when creating a popup window. - So by default, we offset the new popup 30 pixels right - and down from its parent, and give it size of 30x10 characters. - These dimensions look adequate on both high and low res monitors */ - GetWindowRect (hwnd_parent, &rect); - rect_default.left = rect.left + POPUP_OFFSET; - rect_default.top = rect.top + POPUP_OFFSET; - char_to_real_pixel_size (f, POPUP_WIDTH, POPUP_HEIGHT, - &rect_default.width, &rect_default.height); - } - - AdjustWindowRectEx(&rect, style, ADJR_MENUFLAG, exstyle); - - XSETFRAME (frame_obj, f); - - Vmswindows_frame_being_created = frame_obj; - - hwnd = CreateWindowEx (exstyle, - XEMACS_CLASS, - STRINGP(f->name) ? XSTRING_DATA(f->name) : - (STRINGP(name) ? - (CONST Extbyte*)XSTRING_DATA(name) : - (CONST Extbyte*)XEMACS_CLASS), - style, - rect_default.left, rect_default.top, - rect_default.width, rect_default.height, - hwnd_parent, NULL, NULL, NULL); - - Vmswindows_frame_being_created = Qnil; - - if (hwnd == NULL) - error ("System call to create frame failed"); - - FRAME_MSWINDOWS_HANDLE(f) = hwnd; - - SetWindowLong (hwnd, XWL_FRAMEOBJ, (LONG)LISP_TO_VOID(frame_obj)); - FRAME_MSWINDOWS_DC(f) = GetDC (hwnd); - FRAME_MSWINDOWS_CDC(f) = CreateCompatibleDC (FRAME_MSWINDOWS_CDC(f)); - SetTextAlign (FRAME_MSWINDOWS_DC(f), TA_BASELINE | TA_LEFT | TA_NOUPDATECP); -} - -static void -mswindows_init_frame_2 (struct frame *f, Lisp_Object props) -{ - if (NILP (Vmswindows_use_system_frame_size_defaults)) - { - /* I don't think anything can set the frame size before this - since we don't have X resources. This may change if we look - at the registry. Even so these values can get overridden - later.*/ - XEMACS_RECT_WH dest = { -1, -1, DEFAULT_FRAME_WIDTH, - DEFAULT_FRAME_HEIGHT }; - mswindows_size_frame_internal (f, &dest); - } -} - -/* Called after frame's properties are set */ -static void -mswindows_init_frame_3 (struct frame *f) -{ - /* Don't do this earlier or we get a WM_PAINT before the frame is ready. - * The SW_x parameter in the first call that an app makes to ShowWindow is - * ignored, and the parameter specified in the caller's STARTUPINFO is - * substituted instead. That parameter is SW_HIDE if we were started by - * runemacs, so call this twice. #### runemacs is evil */ - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_SHOWNORMAL); - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_SHOWNORMAL); - SetForegroundWindow (FRAME_MSWINDOWS_HANDLE(f)); - DragAcceptFiles (FRAME_MSWINDOWS_HANDLE(f), TRUE); -} - -static void -mswindows_after_init_frame (struct frame *f, int first_on_device, - int first_on_console) -{ - /* Windows, unlike X, is very synchronous. After the initial - frame is created, it will never be displayed, except for - hollow border, unless we start pumping messages. Load progress - messages show in the bottom of the hollow frame, which is ugly. - We redisplay the initial frame here, so modeline and root window - background show. - */ - if (first_on_console) - redisplay (); -} - -static void -mswindows_mark_frame (struct frame *f, void (*markobj) (Lisp_Object)) -{ - markobj (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); -#ifdef HAVE_TOOLBARS - markobj (FRAME_MSWINDOWS_TOOLBAR_HASH_TABLE (f)); -#endif - markobj (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); -} - -static void -mswindows_focus_on_frame (struct frame *f) -{ - SetForegroundWindow (FRAME_MSWINDOWS_HANDLE(f)); -} - -static void -mswindows_delete_frame (struct frame *f) -{ - if (f->frame_data) - { - DeleteDC(FRAME_MSWINDOWS_CDC(f)); - ReleaseDC(FRAME_MSWINDOWS_HANDLE(f), FRAME_MSWINDOWS_DC(f)); - DestroyWindow(FRAME_MSWINDOWS_HANDLE(f)); - xfree (f->frame_data); - } - f->frame_data = 0; -} - -static void -mswindows_set_frame_size (struct frame *f, int width, int height) -{ - RECT rect; - rect.left = rect.top = 0; - rect.right = width; - rect.bottom = height; - - AdjustWindowRectEx (&rect, - GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_STYLE), - GetMenu (FRAME_MSWINDOWS_HANDLE(f)) != NULL, - GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_EXSTYLE)); - - if (IsIconic (FRAME_MSWINDOWS_HANDLE(f)) || IsZoomed (FRAME_MSWINDOWS_HANDLE(f))) - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_RESTORE); - - SetWindowPos (FRAME_MSWINDOWS_HANDLE(f), NULL, - 0, 0, rect.right-rect.left, rect.bottom-rect.top, - SWP_NOACTIVATE | SWP_NOZORDER | SWP_NOSENDCHANGING | SWP_NOMOVE); -} - -static void -mswindows_set_frame_position (struct frame *f, int xoff, int yoff) -{ - SetWindowPos (FRAME_MSWINDOWS_HANDLE(f), NULL, - xoff, yoff, 0, 0, - SWP_NOACTIVATE | SWP_NOZORDER | SWP_NOSENDCHANGING | SWP_NOSIZE); -} - -static void -mswindows_make_frame_visible (struct frame *f) -{ - if (f->iconified) - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_RESTORE); - else - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_SHOWNORMAL); - f->visible = 1; - f->iconified = 0; -} - -static void -mswindows_make_frame_invisible (struct frame *f) -{ - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_HIDE); - f->visible = -1; -} - -static int -mswindows_frame_totally_visible_p (struct frame *f) -{ - RECT rc_me, rc_other, rc_temp; - HWND hwnd = FRAME_MSWINDOWS_HANDLE(f); - - /* We test against not a whole window rectangle, only against its - client part. So, if non-client are is covered and client area is - not, we return true. */ - GetClientRect (hwnd, &rc_me); - MapWindowPoints (hwnd, HWND_DESKTOP, (LPPOINT)&rc_me, 2); - - /* First see if we're off the desktop */ - GetWindowRect (GetDesktopWindow(), &rc_other); - UnionRect(&rc_temp, &rc_me, &rc_other); - if (!EqualRect (&rc_temp, &rc_other)) - return 0; - - /* Then see if any window above us obscures us */ - while ((hwnd = GetWindow (hwnd, GW_HWNDPREV)) != NULL) - if (IsWindowVisible (hwnd)) - { - GetWindowRect (hwnd, &rc_other); - if (IntersectRect(&rc_temp, &rc_me, &rc_other)) - return 0; - } - - return 1; -} - -static int -mswindows_frame_visible_p (struct frame *f) -{ - return IsWindowVisible (FRAME_MSWINDOWS_HANDLE(f)) - && !IsIconic (FRAME_MSWINDOWS_HANDLE(f)); -} - - -static void -mswindows_iconify_frame (struct frame *f) -{ - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_MINIMIZE); - f->visible = 0; - f->iconified = 1; -} - -static int -mswindows_frame_iconified_p (struct frame *f) -{ - return IsIconic (FRAME_MSWINDOWS_HANDLE(f)); -} - -static void -mswindows_set_frame_icon (struct frame *f) -{ - if (IMAGE_INSTANCEP (f->icon) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (f->icon))) - { - if (!XIMAGE_INSTANCE_MSWINDOWS_ICON (f->icon)) - { - mswindows_initialize_image_instance_icon (XIMAGE_INSTANCE (f->icon), - FALSE); - } - - SetClassLong (FRAME_MSWINDOWS_HANDLE (f), GCL_HICON, - (LONG) XIMAGE_INSTANCE_MSWINDOWS_ICON (f->icon)); - } -} - -static void -mswindows_set_frame_pointer (struct frame *f) -{ - if (IMAGE_INSTANCEP (f->pointer) - && IMAGE_INSTANCE_TYPE (XIMAGE_INSTANCE (f->pointer)) == IMAGE_POINTER) - { - SetClassLong (FRAME_MSWINDOWS_HANDLE (f), GCL_HCURSOR, - (LONG) XIMAGE_INSTANCE_MSWINDOWS_ICON (f->pointer)); - /* we only have to do this because GC doesn't cause a mouse - event and doesn't give time to event processing even if it - did. */ - SetCursor (XIMAGE_INSTANCE_MSWINDOWS_ICON (f->pointer)); - } -} - -static void -mswindows_set_mouse_position (struct window *w, int x, int y) -{ - struct frame *f = XFRAME (w->frame); - POINT pt; - - pt.x = w->pixel_left + x; - pt.y = w->pixel_top + y; - ClientToScreen (FRAME_MSWINDOWS_HANDLE(f), &pt); - SetCursorPos (pt.x, pt.y); -} - -static int -mswindows_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y) -{ - POINT pt; - HWND hwnd; - - GetCursorPos (&pt); - - /* What's under cursor? */ - hwnd = WindowFromPoint (pt); - if (hwnd == NULL) - return 0; - - /* Get grandest parent of the window */ - { - HWND hwnd_parent; - while ((hwnd_parent = GetParent (hwnd)) != NULL) - hwnd = hwnd_parent; - } - - /* Make sure it belongs to us */ - if (GetWindowThreadProcessId (hwnd, NULL) != GetCurrentThreadId ()) - return 0; - - /* And that the window is an XEmacs frame */ - { - char class_name [sizeof(XEMACS_CLASS) + 1]; - if (!GetClassName (hwnd, class_name, sizeof(XEMACS_CLASS)) - || strcmp (class_name, XEMACS_CLASS) != 0) - return 0; - } - - /* Yippie! */ - ScreenToClient (hwnd, &pt); - VOID_TO_LISP (*frame, GetWindowLong (hwnd, XWL_FRAMEOBJ)); - *x = pt.x; - *y = pt.y; - return 1; -} - -static void -mswindows_raise_frame (struct frame *f) -{ - BringWindowToTop (FRAME_MSWINDOWS_HANDLE(f)); - /* XXX Should we do SetWindowForeground too ? */ -} - -static void -mswindows_lower_frame (struct frame *f) -{ - SetWindowPos (FRAME_MSWINDOWS_HANDLE(f), HWND_BOTTOM, 0, 0, 0, 0, - SWP_NOSIZE | SWP_NOMOVE | SWP_NOSENDCHANGING); -} - -static void -mswindows_set_title_from_bufbyte (struct frame *f, Bufbyte *title) -{ - unsigned int new_checksum = hash_string (title, strlen (title)); - if (new_checksum != FRAME_MSWINDOWS_TITLE_CHECKSUM(f)) - { - FRAME_MSWINDOWS_TITLE_CHECKSUM(f) = new_checksum; - SetWindowText (FRAME_MSWINDOWS_HANDLE(f), title); - } -} - -static Lisp_Object -mswindows_frame_property (struct frame *f, Lisp_Object property) -{ - if (EQ (Qleft, property) || EQ (Qtop, property)) - { - RECT rc; - GetWindowRect (FRAME_MSWINDOWS_HANDLE(f), &rc); - return make_int (EQ (Qtop, property) ? rc.top : rc.left); - } - return Qunbound; -} - -static int -mswindows_internal_frame_property_p (struct frame *f, Lisp_Object property) -{ - return EQ (property, Qleft) - || EQ (property, Qtop); - /* #### frame-x.c has also this. Why? - || STRINGP (property); - */ -} - -static Lisp_Object -mswindows_frame_properties (struct frame *f) -{ - Lisp_Object props = Qnil; - RECT rc; - GetWindowRect (FRAME_MSWINDOWS_HANDLE(f), &rc); - - props = cons3 (Qtop, make_int (rc.top), props); - props = cons3 (Qleft, make_int (rc.left), props); - - return props; -} - -static void -mswindows_set_frame_properties (struct frame *f, Lisp_Object plist) -{ - int x=-1, y=-1; - int width = -1, height = -1; - BOOL width_specified_p = FALSE; - BOOL height_specified_p = FALSE; - BOOL x_specified_p = FALSE; - BOOL y_specified_p = FALSE; - Lisp_Object tail; - - /* Extract the properties from plist */ - for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) - { - Lisp_Object prop = Fcar (tail); - Lisp_Object val = Fcar (Fcdr (tail)); - - if (SYMBOLP (prop)) - { - /* Kludge to handle the font property. */ - if (EQ (prop, Qfont)) - { - /* If the value is not a string we silently ignore it. */ - if (STRINGP (val)) - { - Lisp_Object frm, font_spec; - - XSETFRAME (frm, f); - font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil); - - Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil); - update_frame_face_values (f); - } - } - else if (EQ (prop, Qwidth)) - { - CHECK_INT (val); - width = XINT (val); - width_specified_p = TRUE; - } - else if (EQ (prop, Qheight)) - { - CHECK_INT (val); - height = XINT (val); - height_specified_p = TRUE; - } - else if (EQ (prop, Qleft)) - { - CHECK_INT (val); - x = XINT (val); - x_specified_p = TRUE; - } - else if (EQ (prop, Qtop)) - { - CHECK_INT (val); - y = XINT (val); - y_specified_p = TRUE; - } - } - } - - /* Now we've extracted the properties, apply them. - Do not apply geometric properties during frame creation. This - is excessive anyways, and this loses becuase WM_SIZE has not - been sent yet, so frame width and height fields are not initialized. - - unfortunately WM_SIZE loses as well since the resize is only - applied once and the first time WM_SIZE is applied not everything - is initialised in the frame (toolbars for instance). enabling - this always makes no visible difference and fixes a whole host of - bugs (and is more consistent with X) so I am going to reenable it. - --andyp */ - if ( FRAME_PIXWIDTH (f) && FRAME_PIXHEIGHT (f) - && (width_specified_p || height_specified_p || x_specified_p || y_specified_p)) - { - XEMACS_RECT_WH dest = { x, y, width, height }; - - mswindows_size_frame_internal (f, &dest); - } -} - -void mswindows_size_frame_internal (struct frame* f, XEMACS_RECT_WH* dest) -{ - RECT rect; - int pixel_width, pixel_height; - int size_p = (dest->width >=0 || dest->height >=0); - int move_p = (dest->top >=0 || dest->left >=0); - struct device* d = XDEVICE (FRAME_DEVICE (f)); - char_to_real_pixel_size (f, dest->width, dest->height, &pixel_width, &pixel_height); - - if (dest->width < 0) - pixel_width = FRAME_PIXWIDTH (f); - if (dest->height < 0) - pixel_height = FRAME_PIXHEIGHT (f); - - GetWindowRect (FRAME_MSWINDOWS_HANDLE(f), &rect); - if (dest->left < 0) - dest->left = rect.left; - if (dest->top < 0) - dest->top = rect.top; - - rect.left = rect.top = 0; - rect.right = pixel_width; - rect.bottom = pixel_height; - - AdjustWindowRectEx (&rect, - GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_STYLE), - GetMenu (FRAME_MSWINDOWS_HANDLE(f)) != NULL, - GetWindowLong (FRAME_MSWINDOWS_HANDLE(f), GWL_EXSTYLE)); - - /* resize and move the window so that it fits on the screen. This is - not restrictive since this will happen later anyway in WM_SIZE. We - have to do this after adjusting the rect to account for menubar - etc. */ - pixel_width = rect.right - rect.left; - pixel_height = rect.bottom - rect.top; - if (pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) - { - pixel_width = DEVICE_MSWINDOWS_HORZRES(d); - size_p=1; - } - if (pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) - { - pixel_height = DEVICE_MSWINDOWS_VERTRES(d); - size_p=1; - } - - /* adjust position so window is on screen */ - if (dest->left + pixel_width > DEVICE_MSWINDOWS_HORZRES(d)) - { - dest->left = DEVICE_MSWINDOWS_HORZRES(d) - pixel_width; - move_p=1; - } - if (dest->top + pixel_height > DEVICE_MSWINDOWS_VERTRES(d)) - { - dest->top = DEVICE_MSWINDOWS_VERTRES(d) - pixel_height; - move_p=1; - } - - if (IsIconic (FRAME_MSWINDOWS_HANDLE(f)) - || IsZoomed (FRAME_MSWINDOWS_HANDLE(f))) - ShowWindow (FRAME_MSWINDOWS_HANDLE(f), SW_RESTORE); - - SetWindowPos (FRAME_MSWINDOWS_HANDLE(f), NULL, - dest->left, dest->top, pixel_width, pixel_height, - SWP_NOACTIVATE | SWP_NOZORDER | SWP_NOSENDCHANGING - | (size_p ? 0 : SWP_NOSIZE) - | (move_p ? 0 : SWP_NOMOVE)); -} - -static Lisp_Object -mswindows_get_frame_parent (struct frame *f) -{ - HWND hwnd = FRAME_MSWINDOWS_HANDLE(f); - hwnd = GetParent (hwnd); - if (hwnd) - { - Lisp_Object parent; - VOID_TO_LISP (parent, GetWindowLong (hwnd, XWL_FRAMEOBJ)); - assert (FRAME_MSWINDOWS_P (XFRAME (parent))); - return parent; - } - else - return Qnil; -} - -static void -mswindows_update_frame_external_traits (struct frame* frm, Lisp_Object name) -{ -} - -static int -mswindows_frame_size_fixed_p (struct frame *f) -{ - /* Frame size cannot change if the frame is maximized */ - return IsZoomed (FRAME_MSWINDOWS_HANDLE (f)); -} - -void -console_type_create_frame_mswindows (void) -{ - /* frame methods */ - CONSOLE_HAS_METHOD (mswindows, init_frame_1); - CONSOLE_HAS_METHOD (mswindows, init_frame_2); - CONSOLE_HAS_METHOD (mswindows, init_frame_3); - CONSOLE_HAS_METHOD (mswindows, after_init_frame); - CONSOLE_HAS_METHOD (mswindows, mark_frame); - CONSOLE_HAS_METHOD (mswindows, focus_on_frame); - CONSOLE_HAS_METHOD (mswindows, delete_frame); - CONSOLE_HAS_METHOD (mswindows, get_mouse_position); - CONSOLE_HAS_METHOD (mswindows, set_mouse_position); - CONSOLE_HAS_METHOD (mswindows, raise_frame); - CONSOLE_HAS_METHOD (mswindows, lower_frame); - CONSOLE_HAS_METHOD (mswindows, make_frame_visible); - CONSOLE_HAS_METHOD (mswindows, make_frame_invisible); - CONSOLE_HAS_METHOD (mswindows, iconify_frame); - CONSOLE_HAS_METHOD (mswindows, set_frame_size); - CONSOLE_HAS_METHOD (mswindows, set_frame_position); - CONSOLE_HAS_METHOD (mswindows, frame_property); - CONSOLE_HAS_METHOD (mswindows, internal_frame_property_p); - CONSOLE_HAS_METHOD (mswindows, frame_properties); - CONSOLE_HAS_METHOD (mswindows, set_frame_properties); - CONSOLE_HAS_METHOD (mswindows, set_title_from_bufbyte); -/* CONSOLE_HAS_METHOD (mswindows, set_icon_name_from_bufbyte); */ - CONSOLE_HAS_METHOD (mswindows, frame_visible_p); - CONSOLE_HAS_METHOD (mswindows, frame_totally_visible_p); - CONSOLE_HAS_METHOD (mswindows, frame_iconified_p); - CONSOLE_HAS_METHOD (mswindows, set_frame_pointer); - CONSOLE_HAS_METHOD (mswindows, set_frame_icon); - CONSOLE_HAS_METHOD (mswindows, get_frame_parent); - CONSOLE_HAS_METHOD (mswindows, update_frame_external_traits); - CONSOLE_HAS_METHOD (mswindows, frame_size_fixed_p); -} - -void -syms_of_frame_mswindows (void) -{ -} - -void -vars_of_frame_mswindows (void) -{ - /* Needn't staticpro -- see comment above. */ - Vmswindows_frame_being_created = Qnil; - - DEFVAR_LISP ("mswindows-use-system-frame-size-defaults", &Vmswindows_use_system_frame_size_defaults /* -Controls whether to use system or XEmacs defaults for frame size. -If nil then reasonable defaults are used for intial frame sizes. If t -then the system will choose default sizes for the frame. -*/ ); - Vmswindows_use_system_frame_size_defaults = Qnil; - - DEFVAR_LISP ("default-mswindows-frame-plist", &Vdefault_mswindows_frame_plist /* -Plist of default frame-creation properties for mswindows frames. -These override what is specified in `default-frame-plist', but are -overridden by the arguments to the particular call to `make-frame'. - -Note: In many cases, properties of a frame are available as specifiers -instead of through the frame-properties mechanism. - -Here is a list of recognized frame properties, other than those -documented in `set-frame-properties' (they can be queried and -set at any time, except as otherwise noted): - - initially-unmapped If non-nil, the frame will not be visible - when it is created. In this case, you - need to call `make-frame-visible' to make - the frame appear. - popup If non-nil, it should be a frame, and this - frame will be created as a "popup" frame - whose parent is the given frame. This - will make the window manager treat the - frame as a dialog box, which may entail - doing different things (e.g. not asking - for positioning, and not iconifying - separate from its parent). - top Y position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - left X position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - -See also `default-frame-plist', which specifies properties which apply -to all frames, not just mswindows frames. -*/ ); - Vdefault_mswindows_frame_plist = Qnil; - - mswindows_console_methods->device_specific_frame_props = - &Vdefault_mswindows_frame_plist; -} diff --git a/src/frame-tty.c b/src/frame-tty.c deleted file mode 100644 index a079f8a..0000000 --- a/src/frame-tty.c +++ /dev/null @@ -1,254 +0,0 @@ -/* TTY frame functions. - Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 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, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -/* Synched up with: Not in FSF. */ - -/* Written by Ben Wing. - Multi-frame support added by Hrvoje Niksic. */ - -#include -#include "lisp.h" - -#include "console-tty.h" -#include "frame.h" - -#include "events.h" - -#ifdef HAVE_GPM -#include -#endif - - -/* Default properties to use when creating frames. */ -Lisp_Object Vdefault_tty_frame_plist; - -static void tty_raise_frame (struct frame *); - - -static void -tty_init_frame_1 (struct frame *f, Lisp_Object props) -{ - struct device *d = XDEVICE (FRAME_DEVICE (f)); - struct console *c = XCONSOLE (DEVICE_CONSOLE (d)); - - ++CONSOLE_TTY_DATA (c)->frame_count; - f->order_count = CONSOLE_TTY_DATA (c)->frame_count; - f->height = CONSOLE_TTY_DATA (c)->height; - f->width = CONSOLE_TTY_DATA (c)->width; -} - -static void -tty_init_frame_3 (struct frame *f) -{ - tty_raise_frame (f); -} - -static void -tty_select_frame_if_unhidden (Lisp_Object frame) -{ - if (FRAME_REPAINT_P (XFRAME (frame))) - select_frame_1 (frame); -} - -static void -tty_schedule_frame_select (struct frame *f) -{ - Lisp_Object frame; - - XSETFRAME (frame, f); - enqueue_magic_eval_event (tty_select_frame_if_unhidden, frame); -} - -static void -tty_after_init_frame (struct frame *f, int first_on_device, - int first_on_console) -{ - if (first_on_console) - call1 (Qinit_post_tty_win, FRAME_CONSOLE (f)); -} - -#ifdef HAVE_GPM -static int -tty_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y) -{ - Gpm_Event ev; - int num_buttons; - - num_buttons = Gpm_GetSnapshot(&ev); - *x = ev.x; - *y = ev.y; - *frame = DEVICE_SELECTED_FRAME (d); - return (1); -} - -static void -tty_set_mouse_position (struct window *w, int x, int y) -{ - /* XXX - I couldn't find any GPM functions that set the mouse position. - Mr. Perry had left this function empty; that must be why. - karlheg - */ -} - -#endif - - -/* Change from withdrawn state to mapped state. */ -static void -tty_make_frame_visible (struct frame *f) -{ - if (!FRAME_VISIBLE_P(f)) - { - f->visible = -1; - } -} - -/* Change from mapped state to withdrawn state. */ -static void -tty_make_frame_invisible (struct frame *f) -{ - f->visible = 0; -} - -static void -tty_make_frame_hidden (struct frame *f) -{ - f->visible = -1; -} - -static void -tty_make_frame_unhidden (struct frame *f) -{ - if (!FRAME_REPAINT_P(f)) - { - SET_FRAME_CLEAR(f); - f->visible = 1; - } -} - -static int -tty_frame_visible_p (struct frame *f) -{ - return FRAME_VISIBLE_P (f); -} - -static void -tty_raise_frame_no_select (struct frame *f) -{ - Lisp_Object frame; - LIST_LOOP_2 (frame, DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (f)))) - { - struct frame *o = XFRAME (frame); - if (o != f && FRAME_REPAINT_P (o)) - { - tty_make_frame_hidden (o); - break; - } - } - tty_make_frame_unhidden (f); -} - -static void -tty_raise_frame (struct frame *f) -{ - tty_raise_frame_no_select (f); - tty_schedule_frame_select (f); -} - -static void -tty_lower_frame (struct frame *f) -{ - Lisp_Object frame_list = DEVICE_FRAME_LIST (XDEVICE (FRAME_DEVICE (f))); - Lisp_Object tail, new; - - if (!FRAME_REPAINT_P (f)) - return; - - LIST_LOOP (tail, frame_list) - { - if (f == XFRAME (XCAR (tail))) - break; - } - - /* To lower this frame, another frame has to be raised. Return if - there is no other frame. */ - if (NILP (tail) && EQ(frame_list, tail)) - return; - - tty_make_frame_hidden (f); - if (CONSP (XCDR (tail))) - new = XCAR (XCDR (tail)); - else - new = XCAR (frame_list); - tty_make_frame_unhidden (XFRAME (new)); - tty_schedule_frame_select (XFRAME (new)); -} - -static void -tty_delete_frame (struct frame *f) -{ - struct device *d = XDEVICE (FRAME_DEVICE (f)); - - if (!NILP (DEVICE_SELECTED_FRAME (d))) - tty_raise_frame (XFRAME (DEVICE_SELECTED_FRAME (d))); -} - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -console_type_create_frame_tty (void) -{ - CONSOLE_HAS_METHOD (tty, init_frame_1); - CONSOLE_HAS_METHOD (tty, init_frame_3); - CONSOLE_HAS_METHOD (tty, after_init_frame); -#ifdef HAVE_GPM - CONSOLE_HAS_METHOD (tty, get_mouse_position); - CONSOLE_HAS_METHOD (tty, set_mouse_position); -#endif - CONSOLE_HAS_METHOD (tty, make_frame_visible); - CONSOLE_HAS_METHOD (tty, make_frame_invisible); - CONSOLE_HAS_METHOD (tty, frame_visible_p); - CONSOLE_HAS_METHOD (tty, raise_frame); - CONSOLE_HAS_METHOD (tty, lower_frame); - CONSOLE_HAS_METHOD (tty, delete_frame); -} - -void -vars_of_frame_tty (void) -{ - DEFVAR_LISP ("default-tty-frame-plist", &Vdefault_tty_frame_plist /* -Plist of default frame-creation properties for tty frames. -These are in addition to and override what is specified in -`default-frame-plist', but are overridden by the arguments to the -particular call to `make-frame'. -*/ ); - Vdefault_tty_frame_plist = Qnil; - - tty_console_methods->device_specific_frame_props = - &Vdefault_tty_frame_plist; - - /* Tty frames are now supported. Advertise a feature to indicate this. */ - Fprovide (intern ("tty-frames")); -} diff --git a/src/frame-x.c b/src/frame-x.c deleted file mode 100644 index a5d62c6..0000000 --- a/src/frame-x.c +++ /dev/null @@ -1,2855 +0,0 @@ -/* Functions for the X window system. - Copyright (C) 1989, 1992-5, 1997 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - -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. */ - -/* Substantially rewritten for XEmacs. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#include "xintrinsicp.h" /* CoreP.h needs this */ -#include /* Numerous places access the fields of - a core widget directly. We could - use XtGetValues(), but ... */ -#include -#include -#include "xmu.h" -#include "EmacsManager.h" -#include "EmacsFrameP.h" -#include "EmacsShell.h" -#ifdef EXTERNAL_WIDGET -#include "ExternalShell.h" -#endif -#include "glyphs-x.h" -#include "objects-x.h" -#include "scrollbar-x.h" - -#include "buffer.h" -#include "events.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "window.h" - -#ifdef HAVE_DRAGNDROP -#include "dragdrop.h" -#endif - -#ifdef HAVE_OFFIX_DND -#include "offix.h" -#endif -#if defined (HAVE_OFFIX_DND) || defined (HAVE_CDE) -#include "events-mod.h" -#endif - -/* Default properties to use when creating frames. */ -Lisp_Object Vdefault_x_frame_plist; - -Lisp_Object Qwindow_id; -Lisp_Object Qx_resource_name; - -EXFUN (Fx_window_id, 1); - - -/************************************************************************/ -/* helper functions */ -/************************************************************************/ - -/* Return the Emacs frame-object corresponding to an X window */ -struct frame * -x_window_to_frame (struct device *d, Window wdesc) -{ - Lisp_Object tail, frame; - struct frame *f; - - /* This function was previously written to accept only a window argument - (and to loop over all devices looking for a matching window), but - that is incorrect because window ID's are not unique across displays. */ - - for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail)) - { - frame = XCAR (tail); - if (!FRAMEP (frame)) - continue; - f = XFRAME (frame); - if (FRAME_X_P (f) && XtWindow (FRAME_X_TEXT_WIDGET (f)) == wdesc) - return f; - } - return 0; -} - -/* Like x_window_to_frame but also compares the window with the widget's - windows */ -struct frame * -x_any_window_to_frame (struct device *d, Window wdesc) -{ - Lisp_Object tail, frame; - struct frame *f; - - assert (DEVICE_X_P (d)); - - /* This function was previously written to accept only a window argument - (and to loop over all devices looking for a matching window), but - that is incorrect because window ID's are not unique across displays. */ - - for (tail = DEVICE_FRAME_LIST (d); CONSP (tail); tail = XCDR (tail)) - { - int i; - - frame = XCAR (tail); - f = XFRAME (frame); - /* This frame matches if the window is any of its widgets. */ - if (wdesc == XtWindow (FRAME_X_SHELL_WIDGET (f)) || - wdesc == XtWindow (FRAME_X_CONTAINER_WIDGET (f)) || - wdesc == XtWindow (FRAME_X_TEXT_WIDGET (f))) - return f; - - /* Match if the window is one of the widgets at the top of the frame - (menubar, Energize psheets). */ - - /* Note: Jamie once said - - "Do *not* match if the window is this frame's psheet." - - But this is wrong and will screw up some functions that expect - x_any_window_to_frame() to work as advertised. I think the reason - for this statement is that, in the old (broken) event loop, where - not all events went through XtDispatchEvent(), psheet events - would incorrectly get sucked away by Emacs if this function matched - on psheet widgets. */ - - for (i = 0; i < FRAME_X_NUM_TOP_WIDGETS (f); i++) - { - Widget wid = FRAME_X_TOP_WIDGETS (f)[i]; - if (wid && XtIsManaged (wid) && wdesc == XtWindow (wid)) - return f; - } - -#ifdef HAVE_SCROLLBARS - /* Match if the window is one of this frame's scrollbars. */ - if (x_window_is_scrollbar (f, wdesc)) - return f; -#endif - } - - return 0; -} - -struct frame * -x_any_widget_or_parent_to_frame (struct device *d, Widget widget) -{ - while (widget) - { - struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); - if (f) - return f; - widget = XtParent (widget); - } - - return 0; -} - -struct frame * -decode_x_frame (Lisp_Object frame) -{ - if (NILP (frame)) - XSETFRAME (frame, selected_frame ()); - CHECK_LIVE_FRAME (frame); - /* this will also catch dead frames, but putting in the above check - results in a more useful error */ - CHECK_X_FRAME (frame); - return XFRAME (frame); -} - - -/************************************************************************/ -/* window-manager interactions */ -/************************************************************************/ - -#if 0 -/* Not currently used. */ - -void -x_wm_mark_shell_size_user_specified (Widget wmshell) -{ - if (! XtIsWMShell (wmshell)) abort (); - EmacsShellSetSizeUserSpecified (wmshell); -} - -void -x_wm_mark_shell_position_user_specified (Widget wmshell) -{ - if (! XtIsWMShell (wmshell)) abort (); - EmacsShellSetPositionUserSpecified (wmshell); -} - -#endif - -void -x_wm_set_shell_iconic_p (Widget shell, int iconic_p) -{ - if (! XtIsWMShell (shell)) abort (); - - /* Because of questionable logic in Shell.c, this sequence can't work: - - w = XtCreatePopupShell (...); - Xt_SET_VALUE (w, XtNiconic, True); - XtRealizeWidget (w); - - The iconic resource is only consulted at initialization time (when - XtCreatePopupShell is called) instead of at realization time (just - before the window gets created, which would be more sensible) or - at management-time (just before the window gets mapped, which would - be most sensible of all). - - The bug is that Shell's SetValues method doesn't do anything to - w->wm.wm_hints.initial_state until after the widget has been realized. - Calls to XtSetValues are ignored in the window between creation and - realization. This is true of MIT X11R5 patch level 25, at least. - (Apparently some other versions of Xt don't have this bug?) - */ - Xt_SET_VALUE (shell, XtNiconic, iconic_p); - EmacsShellSmashIconicHint (shell, iconic_p); -} - -void -x_wm_set_cell_size (Widget wmshell, int cw, int ch) -{ - Arg al [2]; - - if (!XtIsWMShell (wmshell)) - abort (); - if (cw <= 0 || ch <= 0) - abort (); - - XtSetArg (al [0], XtNwidthInc, cw); - XtSetArg (al [1], XtNheightInc, ch); - XtSetValues (wmshell, al, 2); -} - -void -x_wm_set_variable_size (Widget wmshell, int width, int height) -{ - Arg al [2]; - - if (!XtIsWMShell (wmshell)) - abort (); -#ifdef DEBUG_GEOMETRY_MANAGEMENT - /* See comment in EmacsShell.c */ - printf ("x_wm_set_variable_size: %d %d\n", width, height); - fflush (stdout); -#endif - - XtSetArg (al [0], XtNwidthCells, width); - XtSetArg (al [1], XtNheightCells, height); - XtSetValues (wmshell, al, 2); -} - -/* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS - and WM_DELETE_WINDOW, then add them. (They may already be present - because of the toolkit (Motif adds them, for example, but Xt doesn't). - */ -static void -x_wm_hack_wm_protocols (Widget widget) -{ - Display *dpy = XtDisplay (widget); - struct device *d = get_device_from_display (dpy); - Window w = XtWindow (widget); - int need_delete = 1; - int need_focus = 1; - - assert (XtIsWMShell (widget)); - - { - Atom type, *atoms = 0; - int format = 0; - unsigned long nitems = 0; - unsigned long bytes_after; - - if (Success == XGetWindowProperty (dpy, w, DEVICE_XATOM_WM_PROTOCOLS (d), - 0, 100, False, XA_ATOM, - &type, &format, &nitems, &bytes_after, - (unsigned char **) &atoms) - && format == 32 && type == XA_ATOM) - while (nitems > 0) - { - nitems--; - if (atoms [nitems] == DEVICE_XATOM_WM_DELETE_WINDOW (d)) - need_delete = 0; - else if (atoms [nitems] == DEVICE_XATOM_WM_TAKE_FOCUS (d)) - need_focus = 0; - } - if (atoms) XFree ((char *) atoms); - } - { - Atom props [10]; - int count = 0; - if (need_delete) props[count++] = DEVICE_XATOM_WM_DELETE_WINDOW (d); - if (need_focus) props[count++] = DEVICE_XATOM_WM_TAKE_FOCUS (d); - if (count) - XChangeProperty (dpy, w, DEVICE_XATOM_WM_PROTOCOLS (d), XA_ATOM, 32, - PropModeAppend, (unsigned char *) props, count); - } -} - -static void -x_wm_store_class_hints (Widget shell, char *frame_name) -{ - Display *dpy = XtDisplay (shell); - char *app_name, *app_class; - XClassHint classhint; - - if (!XtIsWMShell (shell)) - abort (); - - XtGetApplicationNameAndClass (dpy, &app_name, &app_class); - classhint.res_name = frame_name; - classhint.res_class = app_class; - XSetClassHint (dpy, XtWindow (shell), &classhint); -} - -#ifndef HAVE_SESSION -static void -x_wm_maybe_store_wm_command (struct frame *f) -{ - Widget w = FRAME_X_SHELL_WIDGET (f); - struct device *d = XDEVICE (FRAME_DEVICE (f)); - - if (!XtIsWMShell (w)) - abort (); - - if (NILP (DEVICE_X_WM_COMMAND_FRAME (d))) - { - int argc; - char **argv; - make_argc_argv (Vcommand_line_args, &argc, &argv); - XSetCommand (XtDisplay (w), XtWindow (w), argv, argc); - free_argc_argv (argv); - XSETFRAME (DEVICE_X_WM_COMMAND_FRAME (d), f); - } -} - -/* If we're deleting the frame on which the WM_COMMAND property has been - set, then move that property to another frame so that there is exactly - one frame that has that property set. - */ -static void -x_wm_maybe_move_wm_command (struct frame *f) -{ - struct device *d = XDEVICE (FRAME_DEVICE (f)); - - /* There may not be a frame in DEVICE_X_WM_COMMAND_FRAME() - if we C-c'ed at startup at the right time. */ - if (FRAMEP (DEVICE_X_WM_COMMAND_FRAME (d)) - && f == XFRAME (DEVICE_X_WM_COMMAND_FRAME (d))) - { - Lisp_Object rest = DEVICE_FRAME_LIST (d); - DEVICE_X_WM_COMMAND_FRAME (d) = Qnil; - /* find some random other X frame that is not this one, or give up */ - /* skip non-top-level (ExternalClient) frames */ - while (!NILP (rest) && - (f == XFRAME (XCAR (rest)) || - !FRAME_X_TOP_LEVEL_FRAME_P (XFRAME (XCAR (rest))))) - rest = XCDR (rest); - if (NILP (rest)) - return; - f = XFRAME (XCAR (rest)); - - x_wm_maybe_store_wm_command (f); - - } -} -#endif /* !HAVE_SESSION */ - -static int -x_frame_iconified_p (struct frame *f) -{ - Atom actual_type; - int actual_format; - unsigned long nitems, bytesafter; - unsigned long *datap = 0; - Widget widget; - int result = 0; - struct device *d = XDEVICE (FRAME_DEVICE (f)); - - widget = FRAME_X_SHELL_WIDGET (f); - if (Success == XGetWindowProperty (XtDisplay (widget), XtWindow (widget), - DEVICE_XATOM_WM_STATE (d), 0, 2, False, - DEVICE_XATOM_WM_STATE (d), &actual_type, - &actual_format, &nitems, &bytesafter, - (unsigned char **) &datap) - && datap) - { - if (nitems <= 2 /* "suggested" by ICCCM version 1 */ - && datap[0] == IconicState) - result = 1; - XFree ((char *) datap); - } - return result; -} - - -/************************************************************************/ -/* frame properties */ -/************************************************************************/ - -/* Connect the frame-property names (symbols) to the corresponding - X Resource Manager names. The name of a property, as a Lisp symbol, - has an `x-resource-name' property which is a Lisp_String. */ - -static void -init_x_prop_symbols (void) -{ -#define def(sym, rsrc) \ - pure_put (sym, Qx_resource_name, build_string (rsrc)) -#define defi(sym,rsrc) \ - def (sym, rsrc); pure_put (sym, Qintegerp, Qt) - -#if 0 /* this interferes with things. #### fix this right */ - def (Qminibuffer, XtNminibuffer); - def (Qunsplittable, XtNunsplittable); -#endif - defi(Qinternal_border_width, XtNinternalBorderWidth); -#ifdef HAVE_TOOLBARS - def (Qtop_toolbar_shadow_color, XtNtopToolBarShadowColor); - def (Qbottom_toolbar_shadow_color, XtNbottomToolBarShadowColor); - def (Qbackground_toolbar_color, XtNbackgroundToolBarColor); - def (Qtop_toolbar_shadow_pixmap, XtNtopToolBarShadowPixmap); - def (Qbottom_toolbar_shadow_pixmap, XtNbottomToolBarShadowPixmap); - defi(Qtoolbar_shadow_thickness, XtNtoolBarShadowThickness); -#endif - def (Qscrollbar_placement, XtNscrollBarPlacement); - defi(Qinter_line_space, XtNinterline); - /* font, foreground */ - def (Qiconic, XtNiconic); - def (Qbar_cursor, XtNbarCursor); - def (Qvisual_bell, XtNvisualBell); - defi(Qbell_volume, XtNbellVolume); - def (Qpointer_background, XtNpointerBackground); - def (Qpointer_color, XtNpointerColor); - def (Qtext_pointer, XtNtextPointer); - def (Qspace_pointer, XtNspacePointer); - def (Qmodeline_pointer, XtNmodeLinePointer); - def (Qgc_pointer, XtNgcPointer); - /* geometry, initial_geometry */ - def (Qinitially_unmapped, XtNinitiallyUnmapped); - /* preferred_width, preferred_height */ - def (Quse_backing_store, XtNuseBackingStore); - - /* inherited: */ - - def (Qborder_color, XtNborderColor); - defi(Qborder_width, XtNborderWidth); - defi(Qwidth, XtNwidth); - defi(Qheight, XtNheight); - defi(Qleft, XtNx); - defi(Qtop, XtNy); - -#undef def -} - -static Lisp_Object -color_to_string (Widget w, unsigned long pixel) -{ - char buf[255]; - - XColor color; - color.pixel = pixel; - XQueryColor (XtDisplay (w), w->core.colormap, &color); - sprintf (buf, "#%04x%04x%04x", color.red, color.green, color.blue); - return build_string (buf); -} - -static void -x_get_top_level_position (Display *d, Window w, Position *x, Position *y) -{ - Window root, parent = w, *children; - unsigned int nchildren; - XWindowAttributes xwa; - - do - { - w = parent; - if (!XQueryTree (d, w, &root, &parent, &children, &nchildren)) - { - *x = 0; - *y = 0; - return; - } - XFree (children); - } - while (root != parent); - XGetWindowAttributes (d, w, &xwa); - *x = xwa.x; - *y = xwa.y; -} - -#if 0 -static void -x_smash_bastardly_shell_position (Widget shell) -{ - /* Naturally those bastards who wrote Xt couldn't be bothered - to learn about race conditions and such. We can't trust - the X and Y values to have any semblance of correctness, - so we smash the right values in place. */ - - /* We might be called before we've actually realized the window (if - we're checking for the minibuffer resource). This will bomb in - that case so we don't bother calling it. */ - if (XtWindow (shell)) - x_get_top_level_position (XtDisplay (shell), XtWindow (shell), - &shell->core.x, &shell->core.y); -} -#endif /* 0 */ - -static Lisp_Object -x_frame_property (struct frame *f, Lisp_Object property) -{ - Widget shell = FRAME_X_SHELL_WIDGET (f); - EmacsFrame w = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); - Widget gw = (Widget) w; - - if (EQ (Qleft, property) || EQ (Qtop, property)) - { - Position x, y; - if (!XtWindow(shell)) - return Qzero; - x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y); - if (EQ (Qleft, property)) return make_int (x); - if (EQ (Qtop, property)) return make_int (y); - } - if (EQ (Qborder_width, property)) - return make_int (w->core.border_width); - if (EQ (Qinternal_border_width, property)) - return make_int (w->emacs_frame.internal_border_width); - if (EQ (Qborder_color, property)) - return color_to_string (gw, w->core.border_pixel); -#ifdef HAVE_TOOLBARS - if (EQ (Qtop_toolbar_shadow_color, property)) - return color_to_string (gw, w->emacs_frame.top_toolbar_shadow_pixel); - if (EQ (Qbottom_toolbar_shadow_color, property)) - return color_to_string (gw, w->emacs_frame.bottom_toolbar_shadow_pixel); - if (EQ (Qbackground_toolbar_color, property)) - return color_to_string (gw, w->emacs_frame.background_toolbar_pixel); - if (EQ (Qtoolbar_shadow_thickness, property)) - return make_int (w->emacs_frame.toolbar_shadow_thickness); -#endif /* HAVE_TOOLBARS */ - if (EQ (Qinter_line_space, property)) - return make_int (w->emacs_frame.interline); - if (EQ (Qwindow_id, property)) - return Fx_window_id (make_frame (f)); - - return Qunbound; -} - -static int -x_internal_frame_property_p (struct frame *f, Lisp_Object property) -{ - return EQ (property, Qleft) - || EQ (property, Qtop) - || EQ (property, Qborder_width) - || EQ (property, Qinternal_border_width) - || EQ (property, Qborder_color) -#ifdef HAVE_TOOLBARS - || EQ (property, Qtop_toolbar_shadow_color) - || EQ (property, Qbottom_toolbar_shadow_color) - || EQ (property, Qbackground_toolbar_color) - || EQ (property, Qtoolbar_shadow_thickness) -#endif /* HAVE_TOOLBARS */ - || EQ (property, Qinter_line_space) - || EQ (property, Qwindow_id) - || STRINGP (property); -} - -static Lisp_Object -x_frame_properties (struct frame *f) -{ - Lisp_Object props = Qnil; - Widget shell = FRAME_X_SHELL_WIDGET (f); - EmacsFrame w = (EmacsFrame) FRAME_X_TEXT_WIDGET (f); - Widget gw = (Widget) w; - Position x, y; - - props = cons3 (Qwindow_id, Fx_window_id (make_frame (f)), props); - props = cons3 (Qinter_line_space, make_int (w->emacs_frame.interline), props); - -#ifdef HAVE_TOOLBARS - props = cons3 (Qtoolbar_shadow_thickness, - make_int (w->emacs_frame.toolbar_shadow_thickness), - props); - props = cons3 (Qbackground_toolbar_color, - color_to_string (gw, w->emacs_frame.background_toolbar_pixel), - props); - props = cons3 (Qbottom_toolbar_shadow_color, - color_to_string (gw, w->emacs_frame.bottom_toolbar_shadow_pixel), - props); - props = cons3 (Qtop_toolbar_shadow_color, - color_to_string (gw, w->emacs_frame.top_toolbar_shadow_pixel), - props); -#endif /* HAVE_TOOLBARS */ - - props = cons3 (Qborder_color, - color_to_string (gw, w->core.border_pixel), props); - props = cons3 (Qinternal_border_width, - make_int (w->emacs_frame.internal_border_width), props); - props = cons3 (Qborder_width, make_int (w->core.border_width), props); - - if (!XtWindow(shell)) - x = y = 0; - else - x_get_top_level_position (XtDisplay (shell), XtWindow (shell), &x, &y); - - props = cons3 (Qtop, make_int (y), props); - props = cons3 (Qleft, make_int (x), props); - - return props; -} - - -/* Functions called only from `x_set_frame_properties' to set - individual properties. */ - -static void -x_set_frame_text_value (struct frame *f, Bufbyte *value, - String Xt_resource_name, - String Xt_resource_encoding_name) -{ - Atom encoding = XA_STRING; - String new_XtValue = (String) value; - String old_XtValue = NULL; - -#ifdef MULE - Bufbyte *ptr; - /* Optimize for common ASCII case */ - for (ptr = value; *ptr; ptr++) - if (!BYTE_ASCII_P (*ptr)) - { - CONST char * tmp; - encoding = DEVICE_XATOM_COMPOUND_TEXT (XDEVICE (FRAME_DEVICE (f))); - GET_C_CHARPTR_EXT_CTEXT_DATA_ALLOCA ((CONST char *) value, tmp); - new_XtValue = (String) tmp; - break; - } -#endif /* MULE */ - - /* ### Caching is device-independent - belongs in update_frame_title. */ - Xt_GET_VALUE (FRAME_X_SHELL_WIDGET (f), Xt_resource_name, &old_XtValue); - if (!old_XtValue || strcmp (new_XtValue, old_XtValue)) - { - Arg al[2]; - XtSetArg (al[0], Xt_resource_name, new_XtValue); - XtSetArg (al[1], Xt_resource_encoding_name, encoding); - XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2); - } -} - -static void -x_set_title_from_bufbyte (struct frame *f, Bufbyte *name) -{ - x_set_frame_text_value (f, name, XtNtitle, XtNtitleEncoding); -} - -static void -x_set_icon_name_from_bufbyte (struct frame *f, Bufbyte *name) -{ - x_set_frame_text_value (f, name, XtNiconName, XtNiconNameEncoding); -} - -/* Set the initial frame size as specified. This function is used - when the frame's widgets have not yet been realized. In this - case, it is not sufficient just to set the width and height of - the EmacsFrame widget, because they will be ignored when the - widget is realized (instead, the shell's geometry resource is - used). */ - -static void -x_set_initial_frame_size (struct frame *f, int flags, int x, int y, - unsigned int w, unsigned int h) -{ - char shell_geom [255]; - int xval, yval; - char xsign, ysign; - char uspos = !!(flags & (XValue | YValue)); - char ussize = !!(flags & (WidthValue | HeightValue)); - char *temp; - - /* assign the correct size to the EmacsFrame widget ... */ - EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), w, h); - - /* and also set the WMShell's geometry */ - (flags & XNegative) ? (xval = -x, xsign = '-') : (xval = x, xsign = '+'); - (flags & YNegative) ? (yval = -y, ysign = '-') : (yval = y, ysign = '+'); - - if (uspos && ussize) - sprintf (shell_geom, "=%dx%d%c%d%c%d", w, h, xsign, xval, ysign, yval); - else if (uspos) - sprintf (shell_geom, "=%c%d%c%d", xsign, xval, ysign, yval); - else if (ussize) - sprintf (shell_geom, "=%dx%d", w, h); - - if (uspos || ussize) - { - temp = (char *) xmalloc (1 + strlen (shell_geom)); - strcpy (temp, shell_geom); - FRAME_X_GEOM_FREE_ME_PLEASE (f) = temp; - } - else - temp = NULL; - - Xt_SET_VALUE (FRAME_X_SHELL_WIDGET (f), XtNgeometry, temp); -} - -/* Report to X that a frame property of frame S is being set or changed. - If the property is not specially recognized, do nothing. - */ - -static void -x_set_frame_properties (struct frame *f, Lisp_Object plist) -{ - Position x, y; - Dimension width = 0, height = 0; - Bool width_specified_p = False; - Bool height_specified_p = False; - Bool x_position_specified_p = False; - Bool y_position_specified_p = False; - Bool internal_border_width_specified = False; - Lisp_Object tail; - Widget w = FRAME_X_TEXT_WIDGET (f); - - for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) - { - Lisp_Object prop = Fcar (tail); - Lisp_Object val = Fcar (Fcdr (tail)); - - if (STRINGP (prop)) - { - CONST char *extprop; - - if (XSTRING_LENGTH (prop) == 0) - continue; - - GET_C_STRING_CTEXT_DATA_ALLOCA (prop, extprop); - if (STRINGP (val)) - { - CONST Extbyte *extval; - Extcount extvallen; - - GET_STRING_CTEXT_DATA_ALLOCA (val, extval, extvallen); - XtVaSetValues (w, XtVaTypedArg, extprop, - XtRString, extval, extvallen + 1, - (XtArgVal) NULL); - } - else - XtVaSetValues (w, XtVaTypedArg, extprop, XtRInt, - XINT (val), sizeof (int), - (XtArgVal) NULL); - } - else if (SYMBOLP (prop)) - { - Lisp_Object str = Fget (prop, Qx_resource_name, Qnil); - int int_p = !NILP (Fget (prop, Qintegerp, Qnil)); - - if (NILP (prop) || NILP (str)) - { - /* Kludge to handle the font property. */ - if (EQ (prop, Qfont)) - { - /* If the value is not a string we silently ignore it. */ - if (STRINGP (val)) - { - Lisp_Object frm, font_spec; - - XSETFRAME (frm, f); - font_spec = Fget (Fget_face (Qdefault), Qfont, Qnil); - - Fadd_spec_to_specifier (font_spec, val, frm, Qnil, Qnil); - update_frame_face_values (f); - } - - continue; - } - else - continue; - } - CHECK_STRING (str); - - /* Kludge the width/height so that we interpret them in characters - instead of pixels. Yuck yuck yuck. */ - if (!strcmp ((char *) XSTRING_DATA (str), "width")) - { - CHECK_INT (val); - width = XINT (val); - width_specified_p = True; - continue; - } - if (!strcmp ((char *) XSTRING_DATA (str), "height")) - { - CHECK_INT (val); - height = XINT (val); - height_specified_p = True; - continue; - } - /* Further kludge the x/y. */ - if (!strcmp ((char *) XSTRING_DATA (str), "x")) - { - CHECK_INT (val); - x = (Position) XINT (val); - x_position_specified_p = True; - continue; - } - if (!strcmp ((char *) XSTRING_DATA (str), "y")) - { - CHECK_INT (val); - y = (Position) XINT (val); - y_position_specified_p = True; - continue; - } - /* Have you figured out by now that this entire function is - one gigantic kludge? */ - if (!strcmp ((char *) XSTRING_DATA (str), - "internalBorderWidth")) - { - internal_border_width_specified = True; - } - - if (int_p) - { - CHECK_INT (val); - Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), XINT (val)); - } - else if (EQ (val, Qt)) - { - Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), True); /* XtN...*/ - } - else if (EQ (val, Qnil)) - { - Xt_SET_VALUE (w, (char *) XSTRING_DATA (str), False); /* XtN...*/ - } - else - { - CHECK_STRING (val); - XtVaSetValues (w, XtVaTypedArg, - /* XtN... */ - (char *) XSTRING_DATA (str), - XtRString, - XSTRING_DATA (val), - XSTRING_LENGTH (val) + 1, - (XtArgVal) NULL); - } - -#ifdef HAVE_SCROLLBARS - if (!strcmp ((char *) XSTRING_DATA (str), "scrollBarWidth") - || !strcmp ((char *) XSTRING_DATA (str), - "scrollBarHeight")) - { - x_update_frame_scrollbars (f); - } -#endif /* HAVE_SCROLLBARS */ - } - } - - /* Kludge kludge kludge. We need to deal with the size and position - specially. */ - { - int size_specified_p = width_specified_p || height_specified_p; - int position_specified_p = x_position_specified_p || - y_position_specified_p; - - if (!width_specified_p) - width = FRAME_WIDTH (f); - if (!height_specified_p) - height = FRAME_HEIGHT (f); - - /* Kludge kludge kludge kludge. */ - if (position_specified_p && - (!x_position_specified_p || !y_position_specified_p)) - { - Position dummy; - Widget shell = FRAME_X_SHELL_WIDGET (f); - x_get_top_level_position (XtDisplay (shell), XtWindow (shell), - (x_position_specified_p ? &dummy : &x), - (y_position_specified_p ? &dummy : &y)); -#if 0 - x = (int) (FRAME_X_SHELL_WIDGET (f)->core.x); - y = (int) (FRAME_X_SHELL_WIDGET (f)->core.y); -#endif - } - - if (!f->init_finished) - { - int flags = (size_specified_p ? WidthValue | HeightValue : 0) | - (position_specified_p ? - XValue | YValue | (x < 0 ? XNegative : 0) | (y < 0 ? YNegative : 0) - : 0); - if (size_specified_p - || position_specified_p - || internal_border_width_specified) - x_set_initial_frame_size (f, flags, x, y, width, height); - } - else - { - if (size_specified_p || internal_border_width_specified) - { - Lisp_Object frame; - XSETFRAME (frame, f); - Fset_frame_size (frame, make_int (width), - make_int (height), Qnil); - } - if (position_specified_p) - { - Lisp_Object frame; - XSETFRAME (frame, f); - Fset_frame_position (frame, make_int (x), make_int (y)); - } - } - } -} - -static int frame_title_format_already_set; - -static void -maybe_set_frame_title_format (Widget shell) -{ - - /* Only do this if this is the first X frame we're creating. - - If the *title resource (or -title option) was specified, then - set frame-title-format to its value. - */ - - if (!frame_title_format_already_set) - { - /* No doubt there's a less stupid way to do this. */ - char *results [2]; - XtResource resources [2]; - results [0] = results [1] = 0; - resources [0].resource_name = XtNtitle; - resources [0].resource_class = XtCTitle; - resources [0].resource_type = XtRString; - resources [0].resource_size = sizeof (String); - resources [0].resource_offset = 0; - resources [0].default_type = XtRString; - resources [0].default_addr = 0; - resources [1].resource_name = XtNiconName; - resources [1].resource_class = XtCIconName; - resources [1].resource_type = XtRString; - resources [1].resource_size = sizeof (String); - resources [1].resource_offset = sizeof (char *); - resources [1].default_type = XtRString; - resources [1].default_addr = 0; - XtGetSubresources (XtParent (shell), (XtPointer) results, - shell->core.name, - shell->core.widget_class->core_class.class_name, - resources, XtNumber (resources), 0, 0); - if (results[0]) - Vframe_title_format = build_string (results[0]); - if (results[1]) - Vframe_icon_title_format = build_string (results[1]); - } - - frame_title_format_already_set = 1; -} - -#ifdef HAVE_CDE -#include

-#include
- -static Widget CurrentDragWidget = NULL; -static XtCallbackRec dnd_convert_cb_rec[2]; -static XtCallbackRec dnd_destroy_cb_rec[2]; -static int drag_not_done = 0; - -static void -x_cde_destroy_callback (Widget widget, XtPointer clientData, - XtPointer callData) -{ - DtDndDragFinishCallbackStruct *dragFinishInfo = - (DtDndDragFinishCallbackStruct *)callData; - DtDndContext *dragData = dragFinishInfo->dragData; - int i; - - /* free the items */ - if (callData != NULL && dragData != NULL) - { - if (dragData->protocol == DtDND_BUFFER_TRANSFER) - { - for (i = 0; i < dragData->numItems; i++) - { - XtFree((char *) dragData->data.buffers[i].bp); - if (dragData->data.buffers[i].name) - XtFree(dragData->data.buffers[i].name); - } - } - else - { - for (i = 0; i < dragData->numItems; i++) - XtFree(dragData->data.files[i]); - } - } - - /* free the data string */ - xfree (clientData); - - CurrentDragWidget = NULL; -} - -static void -x_cde_convert_callback (Widget widget, XtPointer clientData, - XtPointer callData) -{ - DtDndConvertCallbackStruct *convertInfo = - (DtDndConvertCallbackStruct *) callData; - char *textdata = (char *) clientData; - char *textptr = NULL; - int i; - - if (convertInfo == NULL) - { - return; - } - - if ((convertInfo->dragData->protocol != DtDND_BUFFER_TRANSFER - && convertInfo->dragData->protocol != DtDND_FILENAME_TRANSFER) || - (convertInfo->reason != DtCR_DND_CONVERT_DATA)) - { - return; - } - - for (textptr=textdata, i=0; - idragData->numItems; - textptr+=strlen(textptr)+1, i++) - { - if (convertInfo->dragData->protocol == DtDND_BUFFER_TRANSFER) - { - convertInfo->dragData->data.buffers[i].bp = XtNewString(textptr); - convertInfo->dragData->data.buffers[i].size = strlen(textptr); - convertInfo->dragData->data.buffers[i].name = NULL; - } - else - { - convertInfo->dragData->data.files[i] = XtNewString(textptr); - } - } - - convertInfo->status = DtDND_SUCCESS; -} - -static Lisp_Object -abort_current_drag(Lisp_Object arg) -{ - if (CurrentDragWidget && drag_not_done) - { - XmDragCancel(CurrentDragWidget); - CurrentDragWidget = NULL; - } - return arg; -} - -DEFUN ("cde-start-drag-internal", Fcde_start_drag_internal, 3, 3, 0, /* -Start a CDE drag from a buffer. -First argument is the event that started the drag (must be a -button-press-event), -second arg defines if the data should be treated as a buffer or -a filename transfer (set to nil for buffer transfer), -and the third argument is a list of data strings. -WARNING: can only handle plain/text and file: transfers! -*/ - (event, dragtype, dragdata)) -{ - if (EVENTP (event)) - { - struct frame *f = decode_x_frame (Fselected_frame (Qnil)); - XEvent x_event; - Widget wid = FRAME_X_TEXT_WIDGET (f); - Display *display = XtDisplayOfObject (wid); - struct device *d = get_device_from_display (display); - struct x_device *xd = DEVICE_X_DATA (d); - XWindowAttributes win_attrib; - unsigned int modifier = 0, state = 0; - char *Ctext; - int numItems = 0, textlen = 0, pos = 0; - struct Lisp_Event *lisp_event = XEVENT(event); - Lisp_Object item = Qnil; - struct gcpro gcpro1; - - /* only drag if this is really a press */ - if (EVENT_TYPE(lisp_event) != button_press_event - || !LISTP(dragdata)) - return Qnil; - - GCPRO1 (item); - - /* - * not so cross hack that converts a emacs event back to a XEvent - */ - - x_event.xbutton.type = ButtonPress; - x_event.xbutton.send_event = False; - x_event.xbutton.display = XtDisplayOfObject(wid); - x_event.xbutton.window = XtWindowOfObject(wid); - x_event.xbutton.root = XRootWindow(x_event.xbutton.display, 0); - x_event.xbutton.subwindow = 0; - x_event.xbutton.time = lisp_event->timestamp; - x_event.xbutton.x = lisp_event->event.button.x; - x_event.xbutton.y = lisp_event->event.button.y; - if (Success == XGetWindowAttributes (x_event.xbutton.display, - x_event.xbutton.window, - &win_attrib)) - { - x_event.xbutton.x_root = win_attrib.x + lisp_event->event.button.x; - x_event.xbutton.y_root = win_attrib.y + lisp_event->event.button.y; - } - else - { - x_event.xbutton.x_root = lisp_event->event.button.x; /* this is wrong */ - x_event.xbutton.y_root = lisp_event->event.button.y; - } - modifier = lisp_event->event.button.modifiers; - if (modifier & MOD_SHIFT) state |= ShiftMask; - if (modifier & MOD_CONTROL) state |= ControlMask; - if (modifier & MOD_META) state |= xd->MetaMask; - if (modifier & MOD_SUPER) state |= xd->SuperMask; - if (modifier & MOD_HYPER) state |= xd->HyperMask; - if (modifier & MOD_ALT) state |= xd->AltMask; - state |= Button1Mask << (lisp_event->event.button.button-1); - - x_event.xbutton.state = state; - x_event.xbutton.button = lisp_event->event.button.button; - x_event.xkey.same_screen = True; - - /* convert data strings into a big string */ - item = dragdata; - while (!NILP (item)) - { - if (!STRINGP (XCAR (item))) - { - numItems=0; - break; - } - textlen += XSTRING_LENGTH (XCAR (item)) + 1; - numItems++; - item = XCDR (item); - } - - if (numItems) - { - /* - * concatenate all strings given to one large string, with - * \0 as separator. List is ended by \0. - */ - Ctext = (char *)xmalloc (textlen+1); - Ctext[0] = 0; - - item = dragdata; - while (!NILP (item)) - { - if (!STRINGP (XCAR (item))) - { - numItems=0; - xfree(Ctext); - Ctext=NULL; - break; - } - strcpy (Ctext+pos, (CONST char *)XSTRING_DATA (XCAR (item))); - pos += XSTRING_LENGTH (XCAR (item)) + 1; - item = XCDR (item); - } - Ctext[pos] = 0; - - dnd_convert_cb_rec[0].callback = x_cde_convert_callback; - dnd_convert_cb_rec[0].closure = (XtPointer) Ctext; - dnd_convert_cb_rec[1].callback = NULL; - dnd_convert_cb_rec[1].closure = NULL; - - dnd_destroy_cb_rec[0].callback = x_cde_destroy_callback; - dnd_destroy_cb_rec[0].closure = (XtPointer) Ctext; - dnd_destroy_cb_rec[1].callback = NULL; - dnd_destroy_cb_rec[1].closure = NULL; - - CurrentDragWidget = - DtDndDragStart (wid, &x_event, - (NILP(dragtype)?DtDND_BUFFER_TRANSFER:DtDND_FILENAME_TRANSFER), - numItems, - XmDROP_COPY, - dnd_convert_cb_rec, - dnd_destroy_cb_rec, - NULL, 0); - } - - UNGCPRO; - - return numItems?Qt:Qnil; - } - - return Qnil; -} - -static void -x_cde_transfer_callback (Widget widget, XtPointer clientData, - XtPointer callData) -{ - char *filePath, *hurl; - int ii, enqueue=1; - Lisp_Object frame = Qnil; - Lisp_Object l_type = Qnil; - Lisp_Object l_data = Qnil; - DtDndTransferCallbackStruct *transferInfo = NULL; - struct gcpro gcpro1, gcpro2, gcpro3; - - /* - this needs to be changed to the new protocol: - - we need the button, modifier and pointer states to create a - correct misc_user_event - - the data must be converted to the new format (URL/MIME) - */ - /* return; */ - - transferInfo = (DtDndTransferCallbackStruct *) callData; - if (transferInfo == NULL) - return; - - GCPRO3 (frame, l_type, l_data); - - frame = make_frame ((struct frame *) clientData); - - if (transferInfo->dropData->protocol == DtDND_FILENAME_TRANSFER) - { - l_type = Qdragdrop_URL; - - for (ii = 0; ii < transferInfo->dropData->numItems; ii++) - { - filePath = transferInfo->dropData->data.files[ii]; - hurl = dnd_url_hexify_string ((char *)filePath, "file:"); - /* ### Mule-izing required */ - l_data = Fcons (make_string ((Bufbyte* )hurl, - strlen (hurl)), - l_data); - xfree (hurl); - } - } - else if (transferInfo->dropData->protocol == DtDND_BUFFER_TRANSFER) - { - int speccount = specpdl_depth(); - - /* Problem: all buffers a treated as text/plain!!! - Solution: Also support DtDND_TEXT_TRANSFER - perhaps implementation of the Motif protocol - (which is the base of CDE) will clear this */ - l_type = Qdragdrop_MIME; - record_unwind_protect(abort_current_drag, Qnil); - drag_not_done = 1; - for (ii = 0; ii < transferInfo->dropData->numItems; ii++) - { - /* let us forget this name thing for now... */ - /* filePath = transferInfo->dropData->data.buffers[ii].name; - path = (filePath == NULL) ? Qnil - : make_string ((Bufbyte *)filePath, strlen (filePath)); */ - /* what, if the data is no text, and how can I tell it? */ - l_data = Fcons ( list3 ( list1 ( make_string ((Bufbyte *)"text/plain", 10) ), - make_string ((Bufbyte *)"8bit", 4), - make_string ((Bufbyte *)transferInfo->dropData->data.buffers[ii].bp, - transferInfo->dropData->data.buffers[ii].size) ), - l_data ); - } - drag_not_done = 0; - unbind_to(speccount, Qnil); - } - else /* the other cases: NOOP_TRANSFER */ - enqueue=0; - - /* The Problem: no button and mods from CDE... */ - if (enqueue) - enqueue_misc_user_event_pos ( frame, Qdragdrop_drop_dispatch, - Fcons (l_type, l_data), - 0 /* this is the button */, - 0 /* these are the mods */, - transferInfo->x, - transferInfo->y); - - UNGCPRO; - return; -} -#endif /* HAVE_CDE */ - -#ifdef HAVE_OFFIX_DND - -DEFUN ("offix-start-drag-internal", Foffix_start_drag_internal, 2, 3, 0, /* -Start a OffiX drag from a buffer. -First arg is the event that started the drag, -second arg should be some string, and the third -is the type of the data (this should be an int). -The type defaults to DndText (4). -*/ - (event, data, dtyp)) -{ - if (EVENTP(event)) - { - struct frame *f = decode_x_frame (Fselected_frame (Qnil)); - XEvent x_event; - Widget wid = FRAME_X_TEXT_WIDGET (f); - Display *display = XtDisplayOfObject (wid); - struct device *d = get_device_from_display (display); - struct x_device *xd = DEVICE_X_DATA (d); - XWindowAttributes win_attrib; - unsigned int modifier = 0, state = 0; - char *dnd_data = NULL; - unsigned long dnd_len = 0; - int dnd_typ = DndText, dnd_dealloc = 0; - struct Lisp_Event *lisp_event = XEVENT(event); - - /* only drag if this is really a press */ - if (EVENT_TYPE(lisp_event) != button_press_event) - return Qnil; - - /* get the desired type */ - if (!NILP (dtyp) && INTP (dtyp)) - dnd_typ = XINT (dtyp); - - if (dnd_typ == DndFiles) - { - Lisp_Object run = data; - int len = 0; - - if (NILP ( Flistp (data))) - return Qnil; - - /* construct the data from a list of files */ - dnd_len = 1; - dnd_data = (char *) xmalloc (1); - *dnd_data = 0; - while (!NILP (run)) - { - if (!STRINGP (XCAR (run))) - { - xfree (dnd_data); - return Qnil; - } - len = XSTRING_LENGTH (XCAR (run)) + 1; - dnd_data = (char *) xrealloc (dnd_data, dnd_len + len); - strcpy (dnd_data + dnd_len - 1, (CONST char *)XSTRING_DATA (XCAR (run))); - dnd_len += len; - run = XCDR (run); - } - - dnd_data[dnd_len - 1] = 0; /* the list-ending zero */ - dnd_dealloc = 1; - - } - else - { - if (!STRINGP (data)) - return Qnil; - - /* and what's with MULE data ??? */ - dnd_data = (char *)XSTRING_DATA (data); - dnd_len = XSTRING_LENGTH (data) + 1; /* the zero */ - - } - - /* not so gross hack that converts an emacs event back to a XEvent */ - - x_event.xbutton.type = ButtonPress; - x_event.xbutton.send_event = False; - x_event.xbutton.display = XtDisplayOfObject(wid); - x_event.xbutton.window = XtWindowOfObject(wid); - x_event.xbutton.root = XRootWindow(x_event.xkey.display, 0); - x_event.xbutton.subwindow = 0; - x_event.xbutton.time = lisp_event->timestamp; - x_event.xbutton.x = lisp_event->event.button.x; - x_event.xbutton.y = lisp_event->event.button.y; - if (Success == XGetWindowAttributes (x_event.xbutton.display, - x_event.xbutton.window, - &win_attrib)) - { - x_event.xbutton.x_root = win_attrib.x + lisp_event->event.button.x; - x_event.xbutton.y_root = win_attrib.y + lisp_event->event.button.y; - } - else - { - x_event.xbutton.x_root = lisp_event->event.button.x; /* this is wrong */ - x_event.xbutton.y_root = lisp_event->event.button.y; - } - - modifier = lisp_event->event.button.modifiers; - if (modifier & MOD_SHIFT) state |= ShiftMask; - if (modifier & MOD_CONTROL) state |= ControlMask; - if (modifier & MOD_META) state |= xd->MetaMask; - if (modifier & MOD_SUPER) state |= xd->SuperMask; - if (modifier & MOD_HYPER) state |= xd->HyperMask; - if (modifier & MOD_ALT) state |= xd->AltMask; - state |= Button1Mask << (lisp_event->event.button.button-1); - - x_event.xbutton.state = state; - x_event.xbutton.button = lisp_event->event.button.button; - x_event.xkey.same_screen = True; - - DndSetData(dnd_typ, (unsigned char *)dnd_data, dnd_len); - if (dnd_dealloc) - xfree (dnd_data); - - /* the next thing blocks everything... */ - if (DndHandleDragging(wid, &x_event)) - return Qt; - } - return Qnil; -} - -#endif /* HAVE_OFFIX_DND */ - - -/************************************************************************/ -/* widget creation */ -/************************************************************************/ - -/* The widget hierarchy is - - argv[0] shell container FRAME-NAME - ApplicationShell EmacsShell EmacsManager EmacsFrame - - We accept geometry specs in this order: - - *FRAME-NAME.geometry - *EmacsFrame.geometry - Emacs.geometry - - Other possibilities for widget hierarchies might be - - argv[0] frame container FRAME-NAME - ApplicationShell EmacsShell EmacsManager EmacsFrame - or - argv[0] FRAME-NAME container FRAME-NAME - ApplicationShell EmacsShell EmacsManager EmacsFrame - or - argv[0] FRAME-NAME container emacsTextPane - ApplicationShell EmacsShell EmacsManager EmacsFrame - -#ifdef EXTERNAL_WIDGET - The ExternalShell widget is simply a replacement for the Shell widget - which is able to deal with using an externally-supplied window instead - of always creating its own. -#endif - -*/ - -#ifdef EXTERNAL_WIDGET - -static int -is_valid_window (Window w, struct device *d) -{ - XWindowAttributes xwa; - Display *dpy = DEVICE_X_DISPLAY (d); - - expect_x_error (dpy); - XGetWindowAttributes (dpy, w, &xwa); - return !x_error_occurred_p (dpy); -} - -#endif /* EXTERNAL_WIDGET */ - -/* This sends a synthetic mouse-motion event to the frame, if the mouse - is over the frame. This ensures that the cursor gets set properly - before the user moves the mouse for the first time. */ - -static void -x_send_synthetic_mouse_event (struct frame *f) -{ - /* #### write this function. */ -} - -static int -first_x_frame_p (struct frame *f) -{ - Lisp_Object rest = DEVICE_FRAME_LIST (XDEVICE (f->device)); - while (!NILP (rest) && - (f == XFRAME (XCAR (rest)) || - !FRAME_X_P (XFRAME (XCAR (rest))))) - rest = XCDR (rest); - return NILP (rest); -} - -/* Figure out what size the EmacsFrame widget should initially be, - and set it. Should be called after the default font has been - determined but before the widget has been realized. */ - -static void -x_initialize_frame_size (struct frame *f) -{ - /* Geometry of the AppShell */ - int app_flags = 0; - int app_x = 0; - int app_y = 0; - unsigned int app_w = 0; - unsigned int app_h = 0; - - /* Geometry of the EmacsFrame */ - int frame_flags = 0; - int frame_x = 0; - int frame_y = 0; - unsigned int frame_w = 0; - unsigned int frame_h = 0; - - /* Hairily merged geometry */ - int x = 0; - int y = 0; - unsigned int w = 80; - unsigned int h = 40; - int flags = 0; - - char *geom = 0, *ew_geom = 0; - Boolean iconic_p = False, ew_iconic_p = False; - - Widget wmshell = FRAME_X_SHELL_WIDGET (f); - /* #### This may not be an ApplicationShell any more, with the 'popup - frame property. */ - Widget app_shell = XtParent (wmshell); - Widget ew = FRAME_X_TEXT_WIDGET (f); - -/* set the position of the frame's root window now. When the - frame was created, the position was initialized to (0,0). */ - { - struct window *win = XWINDOW (f->root_window); - - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); - WINDOW_TOP (win) = FRAME_TOP_BORDER_END (f); - - if (!NILP (f->minibuffer_window)) - { - win = XWINDOW (f->minibuffer_window); - WINDOW_LEFT (win) = FRAME_LEFT_BORDER_END (f); - } - } - -#ifdef EXTERNAL_WIDGET - /* If we're an external widget, then the size of the frame is predetermined - (by the client) and is not our decision to make. */ - if (FRAME_X_EXTERNAL_WINDOW_P (f)) - return; -#endif - -#if 0 - /* #### this junk has not been tested; therefore it's - probably wrong. Doesn't really matter at this point because - currently all frames are either top-level or external widgets. */ - - /* If we're not our own top-level window, then we shouldn't go messing around - with top-level shells or "Emacs.geometry" or any such stuff. Therefore, - we do as follows to determine the size of the frame: - - 1) If a value for the frame's "geometry" resource was specified, then - use it. (This specifies a size in characters.) - 2) Else, if the "width" and "height" resources were specified, then - leave them alone. (This is a value in pixels. Sorry, we can't break - Xt conventions here.) - 3) Else, assume a size of 64x12. (This is somewhat arbitrary, but - it's unlikely that a size of 80x40 is desirable because we're probably - inside of a dialog box.) - - Set the widget's x, y, height, and width as determined. Don't set the - top-level container widget, because we don't necessarily know what it - is. (Assume it is smart and pays attention to our values.) - */ - - if (!FRAME_X_TOP_LEVEL_FRAME_P (f)) - { - Xt_GET_VALUE (ew, XtNgeometry, &ew_geom); - if (ew_geom) - frame_flags = XParseGeometry (ew_geom, - &frame_x, &frame_y, - &frame_w, &frame_h); - if (! (frame_flags & (WidthValue | HeightValue))) - { - Arg al[2]; - XtSetArg (al [0], XtNwidth, &frame_w); - XtSetArg (al [1], XtNheight, &frame_h); - XtGetValues (ew, al, 2); - if (!frame_w && !frame_h) - { - frame_w = 64; - frame_h = 12; - frame_flags |= WidthValue | HeightValue; - } - } - if (frame_flags & (WidthValue | HeightValue)) - EmacsFrameSetCharSize (ew, frame_w, frame_h); - if (frame_flags & (XValue | YValue)) - { - Arg al[2]; - XtSetArg (al [0], XtNwidth, &frame_w); - XtSetArg (al [1], XtNheight, &frame_h); - XtGetValues (ew, al, 2); - - if (frame_flags & XNegative) - frame_x += frame_w; - if (frame_flags & YNegative) - frame_y += frame_h; - - XtSetArg (al [0], XtNx, frame_x); - XtSetArg (al [1], XtNy, frame_y); - XtSetValues (ew, al, 2); - } - return; - } -#endif - - /* OK, we're a top-level shell. */ - - if (!XtIsWMShell (wmshell)) - abort (); - - /* If the EmacsFrame doesn't have a geometry but the shell does, - treat that as the geometry of the frame. - (Is this bogus? I'm not sure.) */ - - Xt_GET_VALUE (ew, XtNgeometry, &ew_geom); - if (!ew_geom) - { - Xt_GET_VALUE (wmshell, XtNgeometry, &geom); - if (geom) - { - ew_geom = geom; - Xt_SET_VALUE (ew, XtNgeometry, ew_geom); - } - } - - /* If the Shell is iconic, then the EmacsFrame is iconic. - (Is this bogus? I'm not sure.) */ - Xt_GET_VALUE (ew, XtNiconic, &ew_iconic_p); - if (!ew_iconic_p) - { - Xt_GET_VALUE (wmshell, XtNiconic, &iconic_p); - if (iconic_p) - { - ew_iconic_p = iconic_p; - Xt_SET_VALUE (ew, XtNiconic, iconic_p); - } - } - - Xt_GET_VALUE (app_shell, XtNgeometry, &geom); - if (geom) - app_flags = XParseGeometry (geom, &app_x, &app_y, &app_w, &app_h); - - if (ew_geom) - frame_flags = XParseGeometry (ew_geom, - &frame_x, &frame_y, - &frame_w, &frame_h); - - if (first_x_frame_p (f)) - { - /* If this is the first frame created: - ==================================== - - - Use the ApplicationShell's size/position, if specified. - (This is "Emacs.geometry", or the "-geometry" command line arg.) - - Else use the EmacsFrame's size/position. - (This is "*FRAME-NAME.geometry") - - - If the AppShell is iconic, the frame should be iconic. - - AppShell comes first so that -geometry always applies to the first - frame created, even if there is an "every frame" entry in the - resource database. - */ - if (app_flags & (XValue | YValue)) - { - x = app_x; y = app_y; - flags |= (app_flags & (XValue | YValue | XNegative | YNegative)); - } - else if (frame_flags & (XValue | YValue)) - { - x = frame_x; y = frame_y; - flags |= (frame_flags & (XValue | YValue | XNegative | YNegative)); - } - - if (app_flags & (WidthValue | HeightValue)) - { - w = app_w; h = app_h; - flags |= (app_flags & (WidthValue | HeightValue)); - } - else if (frame_flags & (WidthValue | HeightValue)) - { - w = frame_w; h = frame_h; - flags |= (frame_flags & (WidthValue | HeightValue)); - } - - /* If the AppShell is iconic, then the EmacsFrame is iconic. */ - if (!ew_iconic_p) - { - Xt_GET_VALUE (app_shell, XtNiconic, &iconic_p); - if (iconic_p) - { - ew_iconic_p = iconic_p; - Xt_SET_VALUE (ew, XtNiconic, iconic_p); - } - } - } - else - { - /* If this is not the first frame created: - ======================================== - - - use the EmacsFrame's size/position if specified - - Otherwise, use the ApplicationShell's size, but not position. - - So that means that one can specify the position of the first frame - with "Emacs.geometry" or `-geometry'; but can only specify the - position of subsequent frames with "*FRAME-NAME.geometry". - - AppShell comes second so that -geometry does not apply to subsequent - frames when there is an "every frame" entry in the resource db, - but does apply to the first frame. - */ - if (frame_flags & (XValue | YValue)) - { - x = frame_x; y = frame_y; - flags |= (frame_flags & (XValue | YValue | XNegative | YNegative)); - } - - if (frame_flags & (WidthValue | HeightValue)) - { - w = frame_w; h = frame_h; - flags |= (frame_flags & (WidthValue | HeightValue)); - } - else if (app_flags & (WidthValue | HeightValue)) - { - w = app_w; - h = app_h; - flags |= (app_flags & (WidthValue | HeightValue)); - } - } - - x_set_initial_frame_size (f, flags, x, y, w, h); -} - -static void -x_get_layout_sizes (struct frame *f, Dimension *topbreadth) -{ - int i; - - /* compute height of all top-area widgets */ - for (i=0, *topbreadth = 0; icore.height + 2*wid->core.border_width; - } -} - -static void -x_layout_widgets (Widget w, XtPointer client_data, XtPointer call_data) -{ - struct frame *f = (struct frame *) client_data; - EmacsManagerResizeStruct *emst = (EmacsManagerResizeStruct *) call_data; - Dimension width = emst->width; - Dimension height = emst->height; - Widget text = FRAME_X_TEXT_WIDGET (f); - Dimension textbord = text->core.border_width; - Dimension topbreadth; - Position text_x = 0, text_y = 0; - int i; - - x_get_layout_sizes (f, &topbreadth); - - /* first the menubar and psheets ... */ - for (i=0; icore.border_width; - XtConfigureWidget (wid, 0, text_y, - width - 2*bord, wid->core.height, - bord); - text_y += wid->core.height + 2*bord; - } - } - -#ifdef HAVE_SCROLLBARS - f->scrollbar_y_offset = topbreadth + textbord; -#endif - - /* finally the text area */ - XtConfigureWidget (text, text_x, text_y, - width - 2*textbord, - height - text_y - 2*textbord, - textbord); -} - -static void -x_do_query_geometry (Widget w, XtPointer client_data, XtPointer call_data) -{ - struct frame *f = (struct frame *) client_data; - EmacsManagerQueryGeometryStruct *emst = - (EmacsManagerQueryGeometryStruct *) call_data; - Widget text = FRAME_X_TEXT_WIDGET (f); - Dimension textbord = text->core.border_width; - Dimension topbreadth; - XtWidgetGeometry req, repl; - int mask = emst->request_mode & (CWWidth | CWHeight); - - x_get_layout_sizes (f, &topbreadth); - - /* Strip away menubar from suggested size, and ask the text widget - what size it wants to be. */ - req.request_mode = mask; - if (mask & CWWidth) - req.width = emst->proposed_width - 2*textbord; - if (mask & CWHeight) - req.height = emst->proposed_height - topbreadth - 2*textbord; - XtQueryGeometry (text, &req, &repl); - - /* Now add the menubar back again */ - emst->proposed_width = repl.width + 2*textbord; - emst->proposed_height = repl.height + topbreadth + 2*textbord; -} - -/* Creates the widgets for a frame. - lisp_window_id is a Lisp description of an X window or Xt - widget to parse. - - This function does not create or map the windows. (That is - done by x_popup_frame().) - */ -static void -x_create_widgets (struct frame *f, Lisp_Object lisp_window_id, - Lisp_Object parent) -{ - struct device *d = XDEVICE (f->device); - Visual *visual = DEVICE_X_VISUAL (d); - int depth = DEVICE_X_DEPTH (d); - Colormap cmap = DEVICE_X_COLORMAP (d); -#ifdef EXTERNAL_WIDGET - Window window_id = 0; -#endif - CONST char *name; - Arg al [25]; - int ac = 0; - Widget text, container, shell; - Widget parentwid = 0; -#ifdef HAVE_MENUBARS - int menubar_visible; - Widget menubar; -#endif - - if (STRINGP (f->name)) - GET_C_STRING_CTEXT_DATA_ALLOCA (f->name, name); - else - name = "emacs"; - - /* The widget hierarchy is - - argv[0] shell pane FRAME-NAME - ApplicationShell EmacsShell EmacsManager EmacsFrame - - (the type of the shell is ExternalShell if this frame is running - in another client's window) - - However the EmacsShell widget has WM_CLASS of FRAME-NAME/Emacs. - Normally such shells have name/class shellname/appclass, which in this - case would be "shell/Emacs" instead of "frame-name/Emacs". We could - also get around this by naming the shell "frame-name", but that would - be confusing because the text area (the EmacsFrame widget inferior of - the shell) is also called that. So we just set the WM_CLASS property. - */ - -#ifndef EXTERNAL_WIDGET - if (!NILP (lisp_window_id)) - error ("support for external widgets was not enabled at compile-time"); -#else - if (!NILP (lisp_window_id)) - { - char *string; - - CHECK_STRING (lisp_window_id); - string = (char *) (XSTRING_DATA (lisp_window_id)); - if (string[0] == '0' && (string[1] == 'x' || string[1] == 'X')) - sscanf (string+2, "%lxu", &window_id); -#if 0 - else if (string[0] == 'w') - { - sscanf (string+1, "%x", &parent_widget); - if (parent_widget) - window_id = XtWindow (parent_widget); - } -#endif - else - sscanf (string, "%lu", &window_id); - if (!is_valid_window (window_id, d)) - error ("Invalid window %lu", (unsigned long) window_id); - FRAME_X_EXTERNAL_WINDOW_P (f) = 1; - } else -#endif /* EXTERNAL_WIDGET */ - FRAME_X_TOP_LEVEL_FRAME_P (f) = 1; - - ac = 0; - XtSetArg (al[ac], XtNallowShellResize, True); ac++; -#ifdef LWLIB_USES_MOTIF - /* Motif sucks beans. Without this in here, it will delete the window - out from under us when it receives a WM_DESTROY_WINDOW message - from the WM. */ - XtSetArg (al[ac], XmNdeleteResponse, XmDO_NOTHING); ac++; -#endif - -#ifdef EXTERNAL_WIDGET - if (window_id) - { - XtSetArg (al[ac], XtNwindow, window_id); ac++; - } - else -#endif /* EXTERNAL_WIDGET */ - { - XtSetArg (al[ac], XtNinput, True); ac++; - XtSetArg (al[ac], XtNminWidthCells, 10); ac++; - XtSetArg (al[ac], XtNminHeightCells, 1); ac++; - XtSetArg (al[ac], XtNvisual, visual); ac++; - XtSetArg (al[ac], XtNdepth, depth); ac++; - XtSetArg (al[ac], XtNcolormap, cmap); ac++; - } - - if (!NILP (parent)) - { - parentwid = FRAME_X_SHELL_WIDGET (XFRAME (parent)); - XtSetArg (al[ac], XtNtransientFor, parentwid); ac++; - } - - shell = XtCreatePopupShell ("shell", - ( -#ifdef EXTERNAL_WIDGET - window_id ? externalShellWidgetClass : -#endif - parentwid ? transientEmacsShellWidgetClass : - topLevelEmacsShellWidgetClass - ), - parentwid ? parentwid : - DEVICE_XT_APP_SHELL (d), - al, ac); - FRAME_X_SHELL_WIDGET (f) = shell; - maybe_set_frame_title_format (shell); - - /* Create the manager widget */ - ac = 0; - XtSetArg (al[ac], XtNvisual, visual); ac++; - XtSetArg (al[ac], XtNdepth, depth); ac++; - XtSetArg (al[ac], XtNcolormap, cmap); ac++; - - container = XtCreateWidget ("container", - emacsManagerWidgetClass, shell, al, ac); - FRAME_X_CONTAINER_WIDGET (f) = container; - XtAddCallback (container, XtNresizeCallback, x_layout_widgets, - (XtPointer) f); - XtAddCallback (container, XtNqueryGeometryCallback, x_do_query_geometry, - (XtPointer) f); - - /* Create the text area */ - ac = 0; - XtSetArg (al[ac], XtNvisual, visual); ac++; - XtSetArg (al[ac], XtNdepth, depth); ac++; - XtSetArg (al[ac], XtNcolormap, cmap); ac++; - XtSetArg (al[ac], XtNborderWidth, 0); ac++; /* should this be settable? */ - XtSetArg (al[ac], XtNemacsFrame, f); ac++; - text = XtCreateWidget (name, emacsFrameClass, container, al, ac); - FRAME_X_TEXT_WIDGET (f) = text; - -#ifdef HAVE_MENUBARS - /* Create the initial menubar widget. */ - menubar_visible = x_initialize_frame_menubar (f); - FRAME_X_TOP_WIDGETS (f)[0] = menubar = FRAME_X_MENUBAR_WIDGET (f); - FRAME_X_NUM_TOP_WIDGETS (f) = 1; - - if (menubar_visible) - XtManageChild (menubar); -#endif /* HAVE_MENUBARS */ - XtManageChild (text); - XtManageChild (container); -} - -/* We used to call XtPopup() in x_popup_frame, but that doesn't give - you control over whether the widget is initially mapped or not - because XtPopup() makes an unconditional call to XMapRaised(). - Boy, those Xt designers were clever. - - When we first removed it we only kept the XtRealizeWidget call in - XtPopup. For everything except HP's that was enough. For HP's, - though, the failure to call the popup callbacks resulted in XEmacs - not accepting any input. Bizarre but true. Stupid but true. - - So, in case there are any other gotchas floating out there along - the same lines I've duplicated the majority of XtPopup here. It - assumes no grabs and that the widget is not already popped up, both - valid assumptions for the one place this is called from. */ -static void -xemacs_XtPopup (Widget widget) -{ - ShellWidget shell_widget = (ShellWidget) widget; - XtGrabKind call_data = XtGrabNone; - - XtCallCallbacks (widget, XtNpopupCallback, (XtPointer)&call_data); - - shell_widget->shell.popped_up = TRUE; - shell_widget->shell.grab_kind = XtGrabNone; - shell_widget->shell.spring_loaded = False; - - if (shell_widget->shell.create_popup_child_proc != NULL) - (*(shell_widget->shell.create_popup_child_proc))(widget); - - /* The XtSetValues below are not in XtPopup menu. We just want to - make absolutely sure... */ - Xt_SET_VALUE (widget, XtNmappedWhenManaged, False); - XtRealizeWidget (widget); - Xt_SET_VALUE (widget, XtNmappedWhenManaged, True); -} - -/* create the windows for the specified frame and display them. - Note that the widgets have already been created, and any - necessary geometry calculations have already been done. */ -static void -x_popup_frame (struct frame *f) -{ - Widget shell_widget = FRAME_X_SHELL_WIDGET (f); - Widget frame_widget = FRAME_X_TEXT_WIDGET (f); - struct device *d = XDEVICE (FRAME_DEVICE (f)); - - /* Before mapping the window, make sure that the WMShell's notion of - whether it should be iconified is synchronized with the EmacsFrame's - notion. - */ - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - x_wm_set_shell_iconic_p (shell_widget, - ((EmacsFrame) frame_widget) - ->emacs_frame.iconic); - - xemacs_XtPopup (shell_widget); - - if (!((EmacsFrame) frame_widget)->emacs_frame.initially_unmapped) - XtMapWidget (shell_widget); - else - { - /* We may have set f->visible to 1 in x_init_frame(), so undo - that now. */ - FRAME_X_TOTALLY_VISIBLE_P (f) = 0; - f->visible = 0; - } - -#ifdef EXTERNAL_WIDGET - if (FRAME_X_EXTERNAL_WINDOW_P (f)) - ExternalShellReady (shell_widget, XtWindow (frame_widget), KeyPressMask); - else -#endif - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - { - /* tell the window manager about us. */ - x_wm_store_class_hints (shell_widget, XtName (frame_widget)); - -#ifndef HAVE_SESSION - x_wm_maybe_store_wm_command (f); -#endif /* HAVE_SESSION */ - - x_wm_hack_wm_protocols (shell_widget); - } - -#ifdef HAVE_XIM - XIM_init_frame (f); -#endif /* HAVE_XIM */ - -#ifdef HACK_EDITRES - /* Allow XEmacs to respond to EditRes requests. See the O'Reilly Xt */ - /* Intrinsics Programming Manual, Motif Edition, Aug 1993, Sect 14.14, */ - /* pp. 483-493. */ - XtAddEventHandler (shell_widget, /* the shell widget in question */ - (EventMask) NoEventMask,/* OR with existing mask */ - True, /* called on non-maskable events? */ - (XtEventHandler) _XEditResCheckMessages, /* the handler */ - NULL); -#endif /* HACK_EDITRES */ - -#ifdef HAVE_CDE - { - XtCallbackRec dnd_transfer_cb_rec[2]; - - dnd_transfer_cb_rec[0].callback = x_cde_transfer_callback; - dnd_transfer_cb_rec[0].closure = (XtPointer) f; - dnd_transfer_cb_rec[1].callback = NULL; - dnd_transfer_cb_rec[1].closure = NULL; - - DtDndVaDropRegister (FRAME_X_TEXT_WIDGET (f), - DtDND_FILENAME_TRANSFER | DtDND_BUFFER_TRANSFER, - XmDROP_COPY, dnd_transfer_cb_rec, - DtNtextIsBuffer, True, - DtNregisterChildren, True, - DtNpreserveRegistration, False, - NULL); - } -#endif /* HAVE_CDE */ - - /* Do a stupid property change to force the server to generate a - propertyNotify event so that the event_stream server timestamp will - be initialized to something relevant to the time we created the window. - */ - XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget), - DEVICE_XATOM_WM_PROTOCOLS (d), XA_ATOM, 32, PropModeAppend, - (unsigned char*) NULL, 0); - - x_send_synthetic_mouse_event (f); -} - -static void -allocate_x_frame_struct (struct frame *f) -{ - /* zero out all slots. */ - f->frame_data = xnew_and_zero (struct x_frame); - - /* yeah, except the lisp ones */ - FRAME_X_ICON_PIXMAP (f) = Qnil; - FRAME_X_ICON_PIXMAP_MASK (f) = Qnil; -} - - -/************************************************************************/ -/* Lisp functions */ -/************************************************************************/ - -static void -x_init_frame_1 (struct frame *f, Lisp_Object props) -{ - /* This function can GC */ - Lisp_Object device = FRAME_DEVICE (f); - Lisp_Object lisp_window_id = Fplist_get (props, Qwindow_id, Qnil); - Lisp_Object popup = Fplist_get (props, Qpopup, Qnil); - - if (!NILP (popup)) - { - if (EQ (popup, Qt)) - popup = Fselected_frame (device); - CHECK_LIVE_FRAME (popup); - if (!EQ (device, FRAME_DEVICE (XFRAME (popup)))) - signal_simple_error_2 ("Parent must be on same device as frame", - device, popup); - } - - /* - * Previously we set this only if NILP (DEVICE_SELECTED_FRAME (d)) - * to make sure that messages were displayed as soon as possible - * if we're creating the first frame on a device. But it is - * better to just set this all the time, so that when a new frame - * is created that covers the selected frame, echo area status - * messages can still be seen. f->visible is reset later if the - * initially-unmapped property is found to be non-nil in the - * frame properties. - */ - f->visible = 1; - - allocate_x_frame_struct (f); - x_create_widgets (f, lisp_window_id, popup); -} - -static void -x_init_frame_2 (struct frame *f, Lisp_Object props) -{ - /* Set up the values of the widget/frame. A case could be made for putting - this inside of the widget's initialize method. */ - - update_frame_face_values (f); - x_initialize_frame_size (f); - /* Kyle: - * update_frame_title() can't be done here, because some of the - * modeline specs depend on the frame's device having a selected - * frame, and that may not have been set up yet. The redisplay - * will update the frame title anyway, so nothing is lost. - * JV: - * It turns out it gives problems with FVWMs name based mapping. - * We'll just need to be careful in the modeline specs. - */ - update_frame_title (f); -} - -static void -x_init_frame_3 (struct frame *f) -{ - /* Pop up the frame. */ - - x_popup_frame (f); -} - -static void -x_mark_frame (struct frame *f, void (*markobj) (Lisp_Object)) -{ - markobj (FRAME_X_ICON_PIXMAP (f)); - markobj (FRAME_X_ICON_PIXMAP_MASK (f)); -} - -static void -x_set_frame_icon (struct frame *f) -{ - Pixmap x_pixmap, x_mask; - - if (IMAGE_INSTANCEP (f->icon) - && IMAGE_INSTANCE_PIXMAP_TYPE_P (XIMAGE_INSTANCE (f->icon))) - { - x_pixmap = XIMAGE_INSTANCE_X_PIXMAP (f->icon); - x_mask = XIMAGE_INSTANCE_X_MASK (f->icon); - } - else - { - x_pixmap = 0; - x_mask = 0; - } - - /* Store the X data into the widget. */ - { - Arg al [2]; - XtSetArg (al [0], XtNiconPixmap, x_pixmap); - XtSetArg (al [1], XtNiconMask, x_mask); - XtSetValues (FRAME_X_SHELL_WIDGET (f), al, 2); - } -} - -static void -x_set_frame_pointer (struct frame *f) -{ - XDefineCursor (XtDisplay (FRAME_X_TEXT_WIDGET (f)), - XtWindow (FRAME_X_TEXT_WIDGET (f)), - XIMAGE_INSTANCE_X_CURSOR (f->pointer)); - XSync (XtDisplay (FRAME_X_TEXT_WIDGET (f)), 0); -} - -static Lisp_Object -x_get_frame_parent (struct frame *f) -{ - Widget parentwid = 0; - - Xt_GET_VALUE (FRAME_X_SHELL_WIDGET (f), XtNtransientFor, &parentwid); - /* find the frame whose wid is parentwid */ - if (parentwid) - { - Lisp_Object frmcons; - DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f))) - { - Lisp_Object frame = XCAR (frmcons); - if (FRAME_X_SHELL_WIDGET (XFRAME (frame)) == parentwid) - return frame; - } - } - return Qnil; -} - -DEFUN ("x-window-id", Fx_window_id, 0, 1, 0, /* -Get the ID of the X11 window. -This gives us a chance to manipulate the Emacs window from within a -different program. Since the ID is an unsigned long, we return it as -a string. -*/ - (frame)) -{ - char str[255]; - struct frame *f = decode_x_frame (frame); - - sprintf (str, "%lu", XtWindow (FRAME_X_TEXT_WIDGET (f))); - return build_string (str); -} - - -/************************************************************************/ -/* manipulating the X window */ -/************************************************************************/ - -static void -x_set_frame_position (struct frame *f, int xoff, int yoff) -{ - Widget w = FRAME_X_SHELL_WIDGET (f); - Display *dpy = XtDisplay (w); - Dimension frame_w = DisplayWidth (dpy, DefaultScreen (dpy)); - Dimension frame_h = DisplayHeight (dpy, DefaultScreen (dpy)); - Dimension shell_w, shell_h, shell_bord; - int win_gravity; - Arg al [3]; - - XtSetArg (al [0], XtNwidth, &shell_w); - XtSetArg (al [1], XtNheight, &shell_h); - XtSetArg (al [2], XtNborderWidth, &shell_bord); - XtGetValues (w, al, 3); - - win_gravity = - xoff >= 0 && yoff >= 0 ? NorthWestGravity : - xoff >= 0 ? SouthWestGravity : - yoff >= 0 ? NorthEastGravity : - SouthEastGravity; - if (xoff < 0) - xoff += frame_w - shell_w - 2*shell_bord; - if (yoff < 0) - yoff += frame_h - shell_h - 2*shell_bord; - - /* Update the hints so that, if this window is currently iconified, it will - come back at the right place. We can't look at s->visible to determine - whether it is iconified because it might not be up-to-date yet (the queue - might not be processed). */ - XtSetArg (al [0], XtNwinGravity, win_gravity); - XtSetArg (al [1], XtNx, xoff); - XtSetArg (al [2], XtNy, yoff); - XtSetValues (w, al, 3); - - /* Sometimes you will find that - - (set-frame-position (selected-frame) -50 -50) - - doesn't put the frame where you expect it to: i.e. it's closer to - the lower-right corner than it should be, and it appears that the - size of the WM decorations was not taken into account. This is - *not* a problem with this function. Both mwm and twm have bugs - in handling this situation. (mwm ignores the window gravity and - always assumes NorthWest, except the first time you map the - window; twm gets things almost right, but forgets to account for - the border width of the top-level window.) This function does - what it's supposed to according to the ICCCM, and I'm not about - to hack around window-manager bugs. */ - -#if 0 - /* This is not necessary under either mwm or twm */ - x_wm_mark_shell_position_user_specified (w); -#endif -} - -/* Call this to change the size of frame S's x-window. */ - -static void -x_set_frame_size (struct frame *f, int cols, int rows) -{ - EmacsFrameSetCharSize (FRAME_X_TEXT_WIDGET (f), cols, rows); -#if 0 - /* this is not correct. x_set_frame_size() is called from - Fset_frame_size(), which may or may not have been called - by the user (e.g. update_EmacsFrame() calls it when the font - changes). For now, don't bother with getting this right. */ - x_wm_mark_shell_size_user_specified (FRAME_X_SHELL_WIDGET (f)); -#endif -} - -static void -x_set_mouse_position (struct window *w, int x, int y) -{ - struct frame *f = XFRAME (w->frame); - - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - XWarpPointer (display, None, XtWindow (FRAME_X_TEXT_WIDGET (f)), - 0, 0, 0, 0, w->pixel_left + x, w->pixel_top + y); -} - -static int -x_get_mouse_position (struct device *d, Lisp_Object *frame, int *x, int *y) -{ - Display *display = DEVICE_X_DISPLAY (d); - Window child_window; - Window root_window; - Window win; - int root_x, root_y; - int win_x, win_y; - unsigned int keys_and_buttons; - struct frame *f; - - if (XQueryPointer (display, RootWindow (display, DefaultScreen (display)), - &root_window, &child_window, &root_x, &root_y, - &win_x, &win_y, &keys_and_buttons) == False) - return 0; - - if (child_window == None) - return 0; /* not over any window. */ - - while (1) - { - win = child_window; - if (XTranslateCoordinates (display, root_window, win, root_x, root_y, - &win_x, &win_y, &child_window) == False) - /* Huh? */ - return 0; - - if (child_window == None) - break; - } - - /* At this point, win is the innermost window containing the pointer - and win_x and win_y are the coordinates of that window. */ - f = x_any_window_to_frame (d, win); - if (!f) - return 0; - XSETFRAME (*frame, f); - - if (XTranslateCoordinates (display, win, - XtWindow (FRAME_X_TEXT_WIDGET (f)), - win_x, win_y, x, y, &child_window) == False) - /* Huh? */ - return 0; - - return 1; -} - -static void -x_cant_notify_wm_error (void) -{ - error ("Can't notify window manager of iconification."); -} - -/* Raise frame F. */ -static void -x_raise_frame_1 (struct frame *f, int force) -{ - if (FRAME_VISIBLE_P (f) || force) - { - Widget bottom_dialog; - XWindowChanges xwc; - unsigned int flags; - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - Window emacs_window = XtWindow (FRAME_X_SHELL_WIDGET (f)); - - /* first raises all the dialog boxes, then put emacs just below the - * bottom most dialog box */ - bottom_dialog = lw_raise_all_pop_up_widgets (); - if (bottom_dialog && XtWindow (bottom_dialog)) - { - xwc.sibling = XtWindow (bottom_dialog); - xwc.stack_mode = Below; - flags = CWSibling | CWStackMode; - } - else - { - xwc.stack_mode = Above; - flags = CWStackMode; - } - - if (!XReconfigureWMWindow (display, emacs_window, - DefaultScreen (display), - flags, &xwc)) - x_cant_notify_wm_error (); - } -} - -static void -x_raise_frame (struct frame *f) -{ - x_raise_frame_1 (f, 1); -} - -/* Lower frame F. */ -static void -x_lower_frame (struct frame *f) -{ - if (FRAME_VISIBLE_P (f)) - { - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - XWindowChanges xwc; - unsigned int flags = CWStackMode; - - xwc.stack_mode = Below; - if (!XReconfigureWMWindow (display, XtWindow (FRAME_X_SHELL_WIDGET (f)), - DefaultScreen (display), flags, &xwc)) - x_cant_notify_wm_error (); - } -} - -/* Change from withdrawn state to mapped state. */ -static void -x_make_frame_visible (struct frame *f) -{ - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - - if (!FRAME_VISIBLE_P(f)) - XMapRaised (display, XtWindow (FRAME_X_SHELL_WIDGET (f))); - else - x_raise_frame_1 (f, 0); -} - -/* Change from mapped state to withdrawn state. */ -static void -x_make_frame_invisible (struct frame *f) -{ - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - - if (!FRAME_VISIBLE_P(f)) - return; - - if (!XWithdrawWindow (display, - XtWindow (FRAME_X_SHELL_WIDGET (f)), - DefaultScreen (display))) - x_cant_notify_wm_error (); -} - -static int -x_frame_visible_p (struct frame *f) -{ -#if 0 - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - XWindowAttributes xwa; - int result; - - /* JV: - This is bad, very bad :-( - It is not compatible with our tristate visible and - it should never ever change the visibility for us, this leads to - the frame-freeze problem under fvwm because with the pager - - Mappedness != Viewability != Visibility != Emacs f->visible - - This first unequalness is the reason for the frame freezing problem - under fvwm (it happens when the frame is another fvwm-page) - - The second unequalness happen when it is on the same fvwm-page - but in an invisible part of the visible screen. - - For now we just return the XEmacs internal value --- which might not be up - to date. Is that a problem? ---. Otherwise we should - use async visibility like in standard Emacs. - */ - - if (!XGetWindowAttributes (display, - XtWindow (FRAME_X_SHELL_WIDGET (f)), - &xwa)) - result = 0; - else - result = xwa.map_state == IsViewable; - /* In this implementation it should at least be != IsUnmapped - JV */ - - f->visible = result; - return result; -#endif /* 0 */ - - return f->visible; -} - -static int -x_frame_totally_visible_p (struct frame *f) -{ - return FRAME_X_TOTALLY_VISIBLE_P (f); -} - -/* Change window state from mapped to iconified. */ -static void -x_iconify_frame (struct frame *f) -{ - Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - - if (!XIconifyWindow (display, - XtWindow (FRAME_X_SHELL_WIDGET (f)), - DefaultScreen (display))) - x_cant_notify_wm_error (); - - f->iconified = 1; -} - -/* Sets the X focus to frame f. */ -static void -x_focus_on_frame (struct frame *f) -{ - XWindowAttributes xwa; - Widget shell_widget; - int viewable = 0; - - assert (FRAME_X_P (f)); - - shell_widget = FRAME_X_SHELL_WIDGET (f); - if (!XtWindow (shell_widget)) - return; - -#ifdef EXTERNAL_WIDGET - if (FRAME_X_EXTERNAL_WINDOW_P (f)) - ExternalShellSetFocus (shell_widget); -#endif /* EXTERNAL_WIDGET */ - - /* Do the ICCCM focus change if the window is still visible. - The s->visible flag might not be up-to-date, because we might - not have processed magic events recently. So make a server - round-trip to find out whether it's really mapped right now. - We grab the server to do this, because that's the only way to - eliminate the race condition. - */ - XGrabServer (XtDisplay (shell_widget)); - if (XGetWindowAttributes (XtDisplay (shell_widget), - XtWindow (shell_widget), - &xwa)) - /* JV: it is bad to change the visibility like this, so we don't for the - moment, at least change_frame_visibility should be called - Note also that under fvwm a frame can be Viewable (and thus Mapped) - but still X-invisible - f->visible = xwa.map_state == IsViewable; */ - viewable = xwa.map_state == IsViewable; - - - if (viewable) - { - Window focus; - int revert_to; - XGetInputFocus (XtDisplay (shell_widget), &focus, &revert_to); - /* Don't explicitly set the focus on this window unless the focus - was on some other window (not PointerRoot). Note that, even when - running a point-to-type window manager like *twm, there is always - a focus window; the window manager maintains that based on the - mouse position. If you set the "NoTitleFocus" option in these - window managers, then the server itself maintains the focus via - PointerRoot, and changing that to focus on the window would make - the window grab the focus. Very bad. - */ - if (focus != PointerRoot) - { - XSetInputFocus (XtDisplay (shell_widget), - XtWindow (shell_widget), - RevertToParent, - DEVICE_X_MOUSE_TIMESTAMP - (XDEVICE (FRAME_DEVICE (f)))); - XFlush (XtDisplay (shell_widget)); - } - } - XUngrabServer (XtDisplay (shell_widget)); - XFlush (XtDisplay (shell_widget)); /* hey, I'd like to DEBUG this... */ -} - -/* Destroy the X window of frame S. */ -static void -x_delete_frame (struct frame *f) -{ -#ifndef HAVE_SESSION - if (FRAME_X_TOP_LEVEL_FRAME_P (f)) - x_wm_maybe_move_wm_command (f); -#endif /* HAVE_SESSION */ - -#ifdef HAVE_CDE - DtDndDropUnregister (FRAME_X_TEXT_WIDGET (f)); -#endif /* HAVE_CDE */ - - assert (FRAME_X_SHELL_WIDGET (f) != 0); - -#ifdef EXTERNAL_WIDGET - expect_x_error (XtDisplay (FRAME_X_SHELL_WIDGET (f))); - /* for obscure reasons having (I think) to do with the internal - window-to-widget hierarchy maintained by Xt, we have to call - XtUnrealizeWidget() here. Xt can really suck. */ - if (f->being_deleted) - XtUnrealizeWidget (FRAME_X_SHELL_WIDGET (f)); - XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); - x_error_occurred_p (XtDisplay (FRAME_X_SHELL_WIDGET (f))); -#else - XtDestroyWidget (FRAME_X_SHELL_WIDGET (f)); - /* make sure the windows are really gone! */ - /* ### Is this REALLY necessary? */ - XFlush (XtDisplay (FRAME_X_SHELL_WIDGET (f))); -#endif /* EXTERNAL_WIDGET */ - - FRAME_X_SHELL_WIDGET (f) = 0; - - if (FRAME_X_GEOM_FREE_ME_PLEASE (f)) - { - xfree (FRAME_X_GEOM_FREE_ME_PLEASE (f)); - FRAME_X_GEOM_FREE_ME_PLEASE (f) = 0; - } - - if (f->frame_data) - { - xfree (f->frame_data); - f->frame_data = 0; - } -} - -static void -x_update_frame_external_traits (struct frame* frm, Lisp_Object name) -{ - Arg al[10]; - int ac = 0; - Lisp_Object frame; - - XSETFRAME(frame, frm); - - if (EQ (name, Qforeground)) - { - Lisp_Object color = FACE_FOREGROUND (Vdefault_face, frame); - XColor fgc; - - if (!EQ (color, Vthe_null_color_instance)) - { - fgc = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (color)); - XtSetArg (al[ac], XtNforeground, (void *) fgc.pixel); ac++; - } - } - else if (EQ (name, Qbackground)) - { - Lisp_Object color = FACE_BACKGROUND (Vdefault_face, frame); - XColor bgc; - - if (!EQ (color, Vthe_null_color_instance)) - { - bgc = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (color)); - XtSetArg (al[ac], XtNbackground, (void *) bgc.pixel); ac++; - } - - /* Really crappy way to force the modeline shadows to be - redrawn. But effective. */ - MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (frm); - MARK_FRAME_CHANGED (frm); - } - else if (EQ (name, Qfont)) - { - Lisp_Object font = FACE_FONT (Vdefault_face, frame, Vcharset_ascii); - - if (!EQ (font, Vthe_null_font_instance)) - XtSetArg (al[ac], XtNfont, - (void *) FONT_INSTANCE_X_FONT (XFONT_INSTANCE (font))); - ac++; - } - else - abort (); - - XtSetValues (FRAME_X_TEXT_WIDGET (frm), al, ac); - -#ifdef HAVE_TOOLBARS - /* Setting the background clears the entire frame area - including the toolbar so we force an immediate redraw of - it. */ - if (EQ (name, Qbackground)) - MAYBE_DEVMETH (XDEVICE (frm->device), redraw_frame_toolbars, (frm)); -#endif /* HAVE_TOOLBARS */ - - /* Set window manager resize increment hints according to - the new character size */ - if (EQ (name, Qfont)) - EmacsFrameRecomputeCellSize (FRAME_X_TEXT_WIDGET (frm)); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_frame_x (void) -{ - defsymbol (&Qwindow_id, "window-id"); - defsymbol (&Qx_resource_name, "x-resource-name"); - - DEFSUBR (Fx_window_id); -#ifdef HAVE_CDE - DEFSUBR (Fcde_start_drag_internal); -#endif -#ifdef HAVE_OFFIX_DND - DEFSUBR (Foffix_start_drag_internal); -#endif -} - -void -console_type_create_frame_x (void) -{ - /* frame methods */ - CONSOLE_HAS_METHOD (x, init_frame_1); - CONSOLE_HAS_METHOD (x, init_frame_2); - CONSOLE_HAS_METHOD (x, init_frame_3); - CONSOLE_HAS_METHOD (x, mark_frame); - CONSOLE_HAS_METHOD (x, focus_on_frame); - CONSOLE_HAS_METHOD (x, delete_frame); - CONSOLE_HAS_METHOD (x, get_mouse_position); - CONSOLE_HAS_METHOD (x, set_mouse_position); - CONSOLE_HAS_METHOD (x, raise_frame); - CONSOLE_HAS_METHOD (x, lower_frame); - CONSOLE_HAS_METHOD (x, make_frame_visible); - CONSOLE_HAS_METHOD (x, make_frame_invisible); - CONSOLE_HAS_METHOD (x, iconify_frame); - CONSOLE_HAS_METHOD (x, set_frame_size); - CONSOLE_HAS_METHOD (x, set_frame_position); - CONSOLE_HAS_METHOD (x, frame_property); - CONSOLE_HAS_METHOD (x, internal_frame_property_p); - CONSOLE_HAS_METHOD (x, frame_properties); - CONSOLE_HAS_METHOD (x, set_frame_properties); - CONSOLE_HAS_METHOD (x, set_title_from_bufbyte); - CONSOLE_HAS_METHOD (x, set_icon_name_from_bufbyte); - CONSOLE_HAS_METHOD (x, frame_visible_p); - CONSOLE_HAS_METHOD (x, frame_totally_visible_p); - CONSOLE_HAS_METHOD (x, frame_iconified_p); - CONSOLE_HAS_METHOD (x, set_frame_pointer); - CONSOLE_HAS_METHOD (x, set_frame_icon); - CONSOLE_HAS_METHOD (x, get_frame_parent); - CONSOLE_HAS_METHOD (x, update_frame_external_traits); -} - -void -vars_of_frame_x (void) -{ -#ifdef EXTERNAL_WIDGET - Fprovide (intern ("external-widget")); -#endif - - /* this call uses only safe functions from emacs.c */ - init_x_prop_symbols (); - - DEFVAR_LISP ("default-x-frame-plist", &Vdefault_x_frame_plist /* -Plist of default frame-creation properties for X frames. -These override what is specified in the resource database and in -`default-frame-plist', but are overridden by the arguments to the -particular call to `make-frame'. - -Note: In many cases, properties of a frame are available as specifiers -instead of through the frame-properties mechanism. - -Here is a list of recognized frame properties, other than those -documented in `set-frame-properties' (they can be queried and -set at any time, except as otherwise noted): - - window-id The X window ID corresponding to the - frame. May be set only at startup, and - only if external widget support was - compiled in; doing so causes the frame - to be created as an "external widget" - in another program that uses an existing - window in the program rather than creating - a new one. - initially-unmapped If non-nil, the frame will not be visible - when it is created. In this case, you - need to call `make-frame-visible' to make - the frame appear. - popup If non-nil, it should be a frame, and this - frame will be created as a "popup" frame - whose parent is the given frame. This - will make the window manager treat the - frame as a dialog box, which may entail - doing different things (e.g. not asking - for positioning, and not iconifying - separate from its parent). - inter-line-space Not currently implemented. - toolbar-shadow-thickness Thickness of toolbar shadows. - background-toolbar-color Color of toolbar background. - bottom-toolbar-shadow-color Color of bottom shadows on toolbars. - (*Not* specific to the bottom-toolbar.) - top-toolbar-shadow-color Color of top shadows on toolbars. - (*Not* specific to the top-toolbar.) - internal-border-width Width of internal border around text area. - border-width Width of external border around text area. - top Y position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - left X position (in pixels) of the upper-left - outermost corner of the frame (i.e. the - upper-left of the window-manager - decorations). - border-color Color of external border around text area. - cursor-color Color of text cursor. - -See also `default-frame-plist', which specifies properties which apply -to all frames, not just X frames. -*/ ); - Vdefault_x_frame_plist = Qnil; - - x_console_methods->device_specific_frame_props = &Vdefault_x_frame_plist; -} diff --git a/src/frame.c b/src/frame.c deleted file mode 100644 index 6c7fde4..0000000 --- a/src/frame.c +++ /dev/null @@ -1,3337 +0,0 @@ -/* Generic frame functions. - Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, 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: FSF 19.30. */ - -/* This file has been Mule-ized. */ - -#include -#include "lisp.h" - -#include "buffer.h" /* for Vbuffer_alist */ -#include "console.h" -#include "events.h" -#include "extents.h" -#include "faces.h" -#include "frame.h" -#include "glyphs.h" -#include "menubar.h" -#include "redisplay.h" -#include "scrollbar.h" -#include "window.h" - -Lisp_Object Vselect_frame_hook, Qselect_frame_hook; -Lisp_Object Vdeselect_frame_hook, Qdeselect_frame_hook; -Lisp_Object Vcreate_frame_hook, Qcreate_frame_hook; -Lisp_Object Vdelete_frame_hook, Qdelete_frame_hook; -Lisp_Object Vmouse_enter_frame_hook, Qmouse_enter_frame_hook; -Lisp_Object Vmouse_leave_frame_hook, Qmouse_leave_frame_hook; -Lisp_Object Vmap_frame_hook, Qmap_frame_hook; -Lisp_Object Vunmap_frame_hook, Qunmap_frame_hook; -int allow_deletion_of_last_visible_frame; -Lisp_Object Vadjust_frame_function; -Lisp_Object Vmouse_motion_handler; -Lisp_Object Vsynchronize_minibuffers; -Lisp_Object Qsynchronize_minibuffers; -Lisp_Object Qbuffer_predicate; -Lisp_Object Qmake_initial_minibuffer_frame; -Lisp_Object Qcustom_initialize_frame; - -/* We declare all these frame properties here even though many of them - are currently only used in frame-x.c, because we should generalize - them. */ - -Lisp_Object Qminibuffer; -Lisp_Object Qunsplittable; -Lisp_Object Qinternal_border_width; -Lisp_Object Qtop_toolbar_shadow_color; -Lisp_Object Qbottom_toolbar_shadow_color; -Lisp_Object Qbackground_toolbar_color; -Lisp_Object Qtop_toolbar_shadow_pixmap; -Lisp_Object Qbottom_toolbar_shadow_pixmap; -Lisp_Object Qtoolbar_shadow_thickness; -Lisp_Object Qscrollbar_placement; -Lisp_Object Qinter_line_space; -Lisp_Object Qvisual_bell; -Lisp_Object Qbell_volume; -Lisp_Object Qpointer_background; -Lisp_Object Qpointer_color; -Lisp_Object Qtext_pointer; -Lisp_Object Qspace_pointer; -Lisp_Object Qmodeline_pointer; -Lisp_Object Qgc_pointer; -Lisp_Object Qinitially_unmapped; -Lisp_Object Quse_backing_store; -Lisp_Object Qborder_color; -Lisp_Object Qborder_width; - -Lisp_Object Qframep, Qframe_live_p; -Lisp_Object Qframe_x_p, Qframe_tty_p; -Lisp_Object Qdelete_frame; - -Lisp_Object Qframe_title_format, Vframe_title_format; -Lisp_Object Qframe_icon_title_format, Vframe_icon_title_format; - -Lisp_Object Vdefault_frame_name; -Lisp_Object Vdefault_frame_plist; - -Lisp_Object Vframe_icon_glyph; - -Lisp_Object Qhidden; - -Lisp_Object Qvisible, Qiconic, Qinvisible, Qvisible_iconic, Qinvisible_iconic; -Lisp_Object Qnomini, Qvisible_nomini, Qiconic_nomini, Qinvisible_nomini; -Lisp_Object Qvisible_iconic_nomini, Qinvisible_iconic_nomini; - -Lisp_Object Qset_specifier, Qset_glyph_image, Qset_face_property; -Lisp_Object Qface_property_instance; - -Lisp_Object Qframe_property_alias; - -/* If this is non-nil, it is the frame that make-frame is currently - creating. We can't set the current frame to this in case the - debugger goes off because it would try and display to it. However, - there are some places which need to reference it which have no - other way of getting it if it isn't the selected frame. */ -Lisp_Object Vframe_being_created; -Lisp_Object Qframe_being_created; - -static void store_minibuf_frame_prop (struct frame *f, Lisp_Object val); - -EXFUN (Fset_frame_properties, 2); - - -static Lisp_Object -mark_frame (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct frame *f = XFRAME (obj); - -#define MARKED_SLOT(x) ((void) (markobj (f->x))); -#include "frameslots.h" - - mark_subwindow_cachels (f->subwindow_cachels, markobj); - - if (FRAME_LIVE_P (f)) /* device is nil for a dead frame */ - MAYBE_FRAMEMETH (f, mark_frame, (f, markobj)); - - return Qnil; -} - -static void -print_frame (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct frame *frm = XFRAME (obj); - char buf[200]; - - if (print_readably) - error ("printing unreadable object #", - XSTRING_DATA (frm->name), frm->header.uid); - - sprintf (buf, "#<%s-frame ", !FRAME_LIVE_P (frm) ? "dead" : - FRAME_TYPE_NAME (frm)); - write_c_string (buf, printcharfun); - print_internal (frm->name, printcharfun, 1); - sprintf (buf, " 0x%x>", frm->header.uid); - write_c_string (buf, printcharfun); -} - -DEFINE_LRECORD_IMPLEMENTATION ("frame", frame, - mark_frame, print_frame, 0, 0, 0, - struct frame); - -static void -nuke_all_frame_slots (struct frame *f) -{ -#define MARKED_SLOT(x) f->x = Qnil; -#include "frameslots.h" -} - -/* Allocate a new frame object and set all its fields to reasonable - values. The root window is created but the minibuffer will be done - later. */ - -static struct frame * -allocate_frame_core (Lisp_Object device) -{ - /* This function can GC */ - Lisp_Object frame; - Lisp_Object root_window; - struct frame *f = alloc_lcrecord_type (struct frame, lrecord_frame); - - zero_lcrecord (f); - nuke_all_frame_slots (f); - XSETFRAME (frame, f); - - f->device = device; - f->framemeths = XDEVICE (device)->devmeths; - f->buffer_alist = Fcopy_sequence (Vbuffer_alist); - - root_window = allocate_window (); - XWINDOW (root_window)->frame = frame; - - /* 10 is arbitrary, - Just so that there is "something there." - Correct size will be set up later with change_frame_size. */ - - f->width = 10; - f->height = 10; - - XWINDOW (root_window)->pixel_width = 10; - XWINDOW (root_window)->pixel_height = 9; - - /* The size of the minibuffer window is now set in x_create_frame - in xfns.c. */ - - f->root_window = root_window; - f->selected_window = root_window; - f->last_nonminibuf_window = root_window; - - /* cache of subwindows visible on frame */ - f->subwindow_cachels = Dynarr_new (subwindow_cachel); - - /* Choose a buffer for the frame's root window. */ - XWINDOW (root_window)->buffer = Qt; - { - Lisp_Object buf; - - buf = Fcurrent_buffer (); - /* If buf is a 'hidden' buffer (i.e. one whose name starts with - a space), try to find another one. */ - if (string_char (XSTRING (Fbuffer_name (buf)), 0) == ' ') - buf = Fother_buffer (buf, Qnil, Qnil); - Fset_window_buffer (root_window, buf); - } - - return f; -} - -static void -setup_normal_frame (struct frame *f) -{ - Lisp_Object mini_window; - Lisp_Object frame; - - XSETFRAME (frame, f); - - mini_window = allocate_window (); - XWINDOW (f->root_window)->next = mini_window; - XWINDOW (mini_window)->prev = f->root_window; - XWINDOW (mini_window)->mini_p = Qt; - XWINDOW (mini_window)->frame = frame; - f->minibuffer_window = mini_window; - f->has_minibuffer = 1; - - XWINDOW (mini_window)->buffer = Qt; - Fset_window_buffer (mini_window, Vminibuffer_zero); -} - -/* Make a frame using a separate minibuffer window on another frame. - MINI_WINDOW is the minibuffer window to use. nil means use the - default-minibuffer-frame. */ - -static void -setup_frame_without_minibuffer (struct frame *f, Lisp_Object mini_window) -{ - /* This function can GC */ - Lisp_Object device = f->device; - - if (!NILP (mini_window)) - CHECK_LIVE_WINDOW (mini_window); - - if (!NILP (mini_window) - && !EQ (DEVICE_CONSOLE (XDEVICE (device)), - FRAME_CONSOLE (XFRAME (XWINDOW (mini_window)->frame)))) - error ("frame and minibuffer must be on the same console"); - - if (NILP (mini_window)) - { - struct console *con = XCONSOLE (FRAME_CONSOLE (f)); - /* Use default-minibuffer-frame if possible. */ - if (!FRAMEP (con->default_minibuffer_frame) - || ! FRAME_LIVE_P (XFRAME (con->default_minibuffer_frame))) - { - /* If there's no minibuffer frame to use, create one. */ - con->default_minibuffer_frame - = call1 (Qmake_initial_minibuffer_frame, device); - } - mini_window = XFRAME (con->default_minibuffer_frame)->minibuffer_window; - } - - /* Install the chosen minibuffer window, with proper buffer. */ - store_minibuf_frame_prop (f, mini_window); - Fset_window_buffer (mini_window, Vminibuffer_zero); -} - -/* Make a frame containing only a minibuffer window. */ - -static void -setup_minibuffer_frame (struct frame *f) -{ - /* This function can GC */ - /* First make a frame containing just a root window, no minibuffer. */ - Lisp_Object mini_window; - Lisp_Object frame; - - XSETFRAME (frame, f); - - f->no_split = 1; - f->has_minibuffer = 1; - - /* Now label the root window as also being the minibuffer. - Avoid infinite looping on the window chain by marking next pointer - as nil. */ - - mini_window = f->minibuffer_window = f->root_window; - XWINDOW (mini_window)->mini_p = Qt; - XWINDOW (mini_window)->next = Qnil; - XWINDOW (mini_window)->prev = Qnil; - XWINDOW (mini_window)->frame = frame; - - /* Put the proper buffer in that window. */ - - Fset_window_buffer (mini_window, Vminibuffer_zero); -} - -static Lisp_Object -make_sure_its_a_fresh_plist (Lisp_Object foolist) -{ - if (CONSP (Fcar (foolist))) - { - /* looks like an alist to me. */ - foolist = Fcopy_alist (foolist); - foolist = Fdestructive_alist_to_plist (foolist); - } - else - foolist = Fcopy_sequence (foolist); - - return foolist; -} - -DEFUN ("make-frame", Fmake_frame, 0, 2, "", /* -Create and return a new frame, displaying the current buffer. -Runs the functions listed in `create-frame-hook' after frame creation. - -Optional argument PROPS is a property list (a list of alternating -keyword-value specifications) of properties for the new frame. -\(An alist is accepted for backward compatibility but should not -be passed in.) - -See `set-frame-properties', `default-x-frame-plist', and -`default-tty-frame-plist' for the specially-recognized properties. -*/ - (props, device)) -{ - struct frame *f; - struct device *d; - Lisp_Object frame = Qnil, name = Qnil, minibuf; - struct gcpro gcpro1, gcpro2, gcpro3; - int speccount = specpdl_depth (); - int first_frame_on_device = 0; - int first_frame_on_console = 0; - - d = decode_device (device); - XSETDEVICE (device, d); - - /* PROPS and NAME may be freshly-created, so make sure to GCPRO. */ - GCPRO3 (frame, props, name); - - props = make_sure_its_a_fresh_plist (props); - if (DEVICE_SPECIFIC_FRAME_PROPS (d)) - /* Put the device-specific props before the more general ones so - that they override them. */ - props = nconc2 (props, - make_sure_its_a_fresh_plist - (*DEVICE_SPECIFIC_FRAME_PROPS (d))); - props = nconc2 (props, make_sure_its_a_fresh_plist (Vdefault_frame_plist)); - Fcanonicalize_lax_plist (props, Qnil); - - name = Flax_plist_get (props, Qname, Qnil); - if (!NILP (name)) - CHECK_STRING (name); - else if (STRINGP (Vdefault_frame_name)) - name = Vdefault_frame_name; - else - name = build_string ("emacs"); - - if (!NILP (Fstring_match (make_string ((CONST Bufbyte *) "\\.", 2), name, - Qnil, Qnil))) - signal_simple_error (". not allowed in frame names", name); - - f = allocate_frame_core (device); - XSETFRAME (frame, f); - - specbind (Qframe_being_created, name); - f->name = name; - - FRAMEMETH (f, init_frame_1, (f, props)); - - minibuf = Flax_plist_get (props, Qminibuffer, Qunbound); - if (UNBOUNDP (minibuf)) - { - /* If minibuf is unspecified, then look for a minibuffer X resource. */ - /* #### Not implemented any more. We need to fix things up so - that we search out all X resources and append them to the end of - props, above. This is the only way in general to assure - coherent behavior for all frame properties/resources/etc. */ - } - else - props = Flax_plist_remprop (props, Qminibuffer); - - if (EQ (minibuf, Qnone) || NILP (minibuf)) - setup_frame_without_minibuffer (f, Qnil); - else if (EQ (minibuf, Qonly)) - setup_minibuffer_frame (f); - else if (WINDOWP (minibuf)) - setup_frame_without_minibuffer (f, minibuf); - else if (EQ (minibuf, Qt) || UNBOUNDP (minibuf)) - setup_normal_frame (f); - else - signal_simple_error ("Invalid value for `minibuffer'", minibuf); - - update_frame_window_mirror (f); - - if (initialized) - { - if (!NILP (f->minibuffer_window)) - reset_face_cachels (XWINDOW (f->minibuffer_window)); - reset_face_cachels (XWINDOW (f->root_window)); - } - - /* If no frames on this device formerly existed, say this is the - first frame. It kind of assumes that frameless devices don't - exist, but it shouldn't be too harmful. */ - if (NILP (DEVICE_FRAME_LIST (d))) - first_frame_on_device = 1; - - /* This *must* go before the init_*() methods. Those functions - call Lisp code, and if any of them causes a warning to be displayed - and the *Warnings* buffer to be created, it won't get added to - the frame-specific version of the buffer-alist unless the frame - is accessible from the device. */ - -#if 0 - DEVICE_FRAME_LIST (d) = nconc2 (DEVICE_FRAME_LIST (d), Fcons (frame, Qnil)); -#endif - DEVICE_FRAME_LIST (d) = Fcons (frame, DEVICE_FRAME_LIST (d)); - RESET_CHANGED_SET_FLAGS; - - /* Now make sure that the initial cached values are set correctly. - Do this after the init_frame method is called because that may - do things (e.g. create widgets) that are necessary for the - specifier value-changed methods to work OK. */ - recompute_all_cached_specifiers_in_frame (f); - - if (!DEVICE_STREAM_P (d)) - { - init_frame_faces (f); - -#ifdef HAVE_SCROLLBARS - /* Finish up resourcing the scrollbars. */ - init_frame_scrollbars (f); -#endif - -#ifdef HAVE_TOOLBARS - /* Create the initial toolbars. We have to do this after the frame - methods are called because it may potentially call some things itself - which depend on the normal frame methods having initialized - things. */ - init_frame_toolbars (f); -#endif - reset_face_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f))); - reset_glyph_cachels (XWINDOW (FRAME_SELECTED_WINDOW (f))); - reset_subwindow_cachels (f); - change_frame_size (f, f->height, f->width, 0); - } - - MAYBE_FRAMEMETH (f, init_frame_2, (f, props)); - Fset_frame_properties (frame, props); - MAYBE_FRAMEMETH (f, init_frame_3, (f)); - - /* Hallelujah, praise the lord. */ - f->init_finished = 1; - - /* If this is the first frame on the device, make it the selected one. */ - if (first_frame_on_device && NILP (DEVICE_SELECTED_FRAME (d))) - set_device_selected_frame (d, frame); - - /* If at startup or if the current console is a stream console - (usually also at startup), make this console the selected one - so that messages show up on it. */ - if (NILP (Fselected_console ()) || - CONSOLE_STREAM_P (XCONSOLE (Fselected_console ()))) - Fselect_console (DEVICE_CONSOLE (d)); - - first_frame_on_console = - (first_frame_on_device && - XINT (Flength (CONSOLE_DEVICE_LIST (XCONSOLE (DEVICE_CONSOLE (d))))) - == 1); - - /* #### all this calling of frame methods at various odd times - is somewhat of a mess. It's necessary to do it this way due - to strange console-type-specific things that need to be done. */ - MAYBE_FRAMEMETH (f, after_init_frame, (f, first_frame_on_device, - first_frame_on_console)); - - if (first_frame_on_device) - { - if (first_frame_on_console) - va_run_hook_with_args (Qcreate_console_hook, 1, DEVICE_CONSOLE (d)); - va_run_hook_with_args (Qcreate_device_hook, 1, device); - } - va_run_hook_with_args (Qcreate_frame_hook, 1, frame); - - /* Initialize custom-specific stuff. */ - if (!UNBOUNDP (symbol_function (XSYMBOL (Qcustom_initialize_frame)))) - call1 (Qcustom_initialize_frame, frame); - - unbind_to (speccount, Qnil); - - UNGCPRO; - return frame; -} - - -/* this function should be used in most cases when a Lisp function is passed - a FRAME argument. Use this unless you don't accept nil == current frame - (in which case, do a CHECK_LIVE_FRAME() and then an XFRAME()) or you - allow dead frames. Note that very few functions should accept dead - frames. It could be argued that functions should just do nothing when - given a dead frame, but the presence of a dead frame usually indicates - an oversight in the Lisp code that could potentially lead to strange - results and so it is better to catch the error early. - - If you only accept X frames, use decode_x_frame(), which does what this - function does but also makes sure the frame is an X frame. */ - -struct frame * -decode_frame (Lisp_Object frame) -{ - if (NILP (frame)) - return selected_frame (); - - CHECK_LIVE_FRAME (frame); - return XFRAME (frame); -} - -struct frame * -decode_frame_or_selected (Lisp_Object cdf) -{ - if (CONSOLEP (cdf)) - cdf = CONSOLE_SELECTED_DEVICE (decode_console (cdf)); - if (DEVICEP (cdf)) - cdf = DEVICE_SELECTED_FRAME (decode_device (cdf)); - return decode_frame (cdf); -} - -Lisp_Object -make_frame (struct frame *f) -{ - Lisp_Object frame; - XSETFRAME (frame, f); - return frame; -} - - -/* - * window size changes are held up during critical regions. Afterwards, - * we want to deal with any delayed changes. - */ -void -hold_frame_size_changes (void) -{ - in_display = 1; -} - -void -unhold_one_frame_size_changes (struct frame *f) -{ - in_display = 0; - - if (f->size_change_pending) - change_frame_size (f, f->new_height, f->new_width, 0); -} - -void -unhold_frame_size_changes (void) -{ - Lisp_Object frmcons, devcons, concons; - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - unhold_one_frame_size_changes (XFRAME (XCAR (frmcons))); -} - -void -invalidate_vertical_divider_cache_in_frame (struct frame *f) -{ - /* Invalidate cached value of needs_vertical_divider_p in - every and all windows */ - map_windows (f, invalidate_vertical_divider_cache_in_window, 0); -} - -/* - * Frame size may change due to changes in scrollbars, toolbars, - * default font etc. These changes are applied early in redisplay - * frame. - */ -void -adjust_frame_size (struct frame *f) -{ - int keep_char_size = 0; - Lisp_Object frame; - XSETFRAME (frame, f); - - if (!f->size_slipped) - return; - - /* Don't adjust tty frames. #### May break when TTY have menubars. - Then, write an Vadjust_frame_function which will return t for TTY - frames. Another solution is frame_size_fixed_p method for TTYs, - which always returned yes it's fixed. - */ - if (!FRAME_WIN_P (f)) - { - CLEAR_FRAME_SIZE_SLIPPED (f); - return; - } - - /* frame_size_fixed_p tells that frame size cannot currently - be changed change due to external conditions */ - if (!FRAMEMETH_OR_GIVEN (f, frame_size_fixed_p, (f), 0)) - { - if (NILP (Vadjust_frame_function)) - keep_char_size = 1; - else if (EQ (Vadjust_frame_function, Qt)) - keep_char_size = 0; - else - keep_char_size = - NILP (call1_trapping_errors ("Error in adjust-frame-function", - Vadjust_frame_function, frame)); - - if (keep_char_size) - Fset_frame_size (frame, make_int (FRAME_CHARWIDTH(f)), - make_int (FRAME_CHARHEIGHT(f)), Qnil); - } - - if (!keep_char_size) - { - int height, width; - pixel_to_char_size (f, FRAME_PIXWIDTH(f), FRAME_PIXHEIGHT(f), - &width, &height); - change_frame_size (f, height, width, 0); - CLEAR_FRAME_SIZE_SLIPPED (f); - } -} - -/* - * This is a "specifier changed in frame" handler for various specifiers - * changing which causes frame size adjustment - */ -void -frame_size_slipped (Lisp_Object specifier, struct frame *f, - Lisp_Object oldval) -{ - MARK_FRAME_SIZE_SLIPPED(f); -} - -DEFUN ("framep", Fframep, 1, 1, 0, /* -Return non-nil if OBJECT is a frame. -Also see `frame-live-p'. -Note that FSF Emacs kludgily returns a value indicating what type of -frame this is. Use the cleaner function `frame-type' for that. -*/ - (object)) -{ - return FRAMEP (object) ? Qt : Qnil; -} - -DEFUN ("frame-live-p", Fframe_live_p, 1, 1, 0, /* -Return non-nil if OBJECT is a frame which has not been deleted. -*/ - (object)) -{ - return FRAMEP (object) && FRAME_LIVE_P (XFRAME (object)) ? Qt : Qnil; -} - - -DEFUN ("focus-frame", Ffocus_frame, 1, 1, 0, /* -Select FRAME and give it the window system focus. -This function is not affected by the value of `focus-follows-mouse'. -*/ - (frame)) -{ - CHECK_LIVE_FRAME (frame); - - MAYBE_DEVMETH (XDEVICE (FRAME_DEVICE (XFRAME (frame))), focus_on_frame, - (XFRAME (frame))); - /* FRAME will be selected by the time we receive the next event. - However, it is better to select it explicitly now, in case the - Lisp code depends on frame being selected. */ - Fselect_frame (frame); - return Qnil; -} - -/* Called from Fselect_window() */ -void -select_frame_1 (Lisp_Object frame) -{ - struct frame *f = XFRAME (frame); - Lisp_Object old_selected_frame = Fselected_frame (Qnil); - - if (EQ (frame, old_selected_frame)) - return; - - /* now select the frame's device */ - set_device_selected_frame (XDEVICE (FRAME_DEVICE (f)), frame); - select_device_1 (FRAME_DEVICE (f)); - - update_frame_window_mirror (f); -} - -DEFUN ("select-frame", Fselect_frame, 1, 1, 0, /* -Select the frame FRAME. -Subsequent editing commands apply to its selected window. -The selection of FRAME lasts until the next time the user does -something to select a different frame, or until the next time this -function is called. - -Note that this does not actually cause the window-system focus to be -set to this frame, or the `select-frame-hook' or `deselect-frame-hook' -to be run, until the next time that XEmacs is waiting for an event. - -Also note that when focus-follows-mouse is non-nil, the frame -selection is temporary and is reverted when the current command -terminates, much like the buffer selected by `set-buffer'. In order -to effect a permanent focus change, use `focus-frame'. -*/ - (frame)) -{ - CHECK_LIVE_FRAME (frame); - - /* select the frame's selected window. This will call - selected_frame_1(). */ - Fselect_window (FRAME_SELECTED_WINDOW (XFRAME (frame)), Qnil); - - /* Nothing should be depending on the return value of this function. - But, of course, there is stuff out there which is. */ - return frame; -} - -/* use this to retrieve the currently selected frame. You should use - this in preference to Fselected_frame (Qnil) unless you are prepared - to handle the possibility of there being no selected frame (this - happens at some points during startup). */ - -struct frame * -selected_frame (void) -{ - Lisp_Object device = Fselected_device (Qnil); - Lisp_Object frame = DEVICE_SELECTED_FRAME (XDEVICE (device)); - if (NILP (frame)) - signal_simple_error ("No frames exist on device", device); - return XFRAME (frame); -} - -/* use this instead of XFRAME (DEVICE_SELECTED_FRAME (d)) to catch - the possibility of there being no frames on the device (just created). - There is no point doing this inside of redisplay because errors - cause an abort(), indicating a flaw in the logic, and error_check_frame() - will catch this just as well. */ - -struct frame * -device_selected_frame (struct device *d) -{ - Lisp_Object frame = DEVICE_SELECTED_FRAME (d); - if (NILP (frame)) - { - Lisp_Object device; - XSETDEVICE (device, d); - signal_simple_error ("No frames exist on device", device); - } - return XFRAME (frame); -} - -#if 0 /* FSFmacs */ - -xxDEFUN ("handle-switch-frame", Fhandle_switch_frame, 1, 2, "e", /* -Handle a switch-frame event EVENT. -Switch-frame events are usually bound to this function. -A switch-frame event tells Emacs that the window manager has requested -that the user's events be directed to the frame mentioned in the event. -This function selects the selected window of the frame of EVENT. - -If EVENT is frame object, handle it as if it were a switch-frame event -to that frame. -*/ - (frame, no_enter)) -{ - /* Preserve prefix arg that the command loop just cleared. */ - XCONSOLE (Vselected_console)->prefix_arg = Vcurrent_prefix_arg; -#if 0 /* unclean! */ - run_hook (Qmouse_leave_buffer_hook); -#endif - return do_switch_frame (frame, no_enter, 0); -} - -/* A load of garbage. */ -xxDEFUN ("ignore-event", Fignore_event, 0, 0, "", /* -Do nothing, but preserve any prefix argument already specified. -This is a suitable binding for iconify-frame and make-frame-visible. -*/ - ()) -{ - struct console *c = XCONSOLE (Vselected_console); - - c->prefix_arg = Vcurrent_prefix_arg; - return Qnil; -} - -#endif /* 0 */ - -DEFUN ("selected-frame", Fselected_frame, 0, 1, 0, /* -Return the frame that is now selected on device DEVICE. -If DEVICE is not specified, the selected device will be used. -If no frames exist on the device, nil is returned. -*/ - (device)) -{ - if (NILP (device) && NILP (Fselected_device (Qnil))) - return Qnil; /* happens early in temacs */ - return DEVICE_SELECTED_FRAME (decode_device (device)); -} - -Lisp_Object -frame_first_window (struct frame *f) -{ - Lisp_Object w = f->root_window; - - while (1) - { - if (! NILP (XWINDOW (w)->hchild)) - w = XWINDOW (w)->hchild; - else if (! NILP (XWINDOW (w)->vchild)) - w = XWINDOW (w)->vchild; - else - break; - } - - return w; -} - -DEFUN ("active-minibuffer-window", Factive_minibuffer_window, 0, 0, 0, /* -Return the currently active minibuffer window, or nil if none. -*/ - ()) -{ - return minibuf_level ? minibuf_window : Qnil; -} - -DEFUN ("last-nonminibuf-frame", Flast_nonminibuf_frame, 0, 1, 0, /* -Return the most-recently-selected non-minibuffer-only frame on CONSOLE. -This will always be the same as (selected-frame device) unless the -selected frame is a minibuffer-only frame. -CONSOLE defaults to the selected console if omitted. -*/ - (console)) -{ - Lisp_Object result; - - XSETCONSOLE (console, decode_console (console)); - /* Just in case the machinations in delete_frame_internal() resulted - in the last-nonminibuf-frame getting out of sync, make sure and - return the selected frame if it's acceptable. */ - result = Fselected_frame (CONSOLE_SELECTED_DEVICE (XCONSOLE (console))); - if (!NILP (result) && !FRAME_MINIBUF_ONLY_P (XFRAME (result))) - return result; - return CONSOLE_LAST_NONMINIBUF_FRAME (XCONSOLE (console)); -} - -DEFUN ("frame-root-window", Fframe_root_window, 0, 1, 0, /* -Return the root-window of FRAME. -If omitted, FRAME defaults to the currently selected frame. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - return FRAME_ROOT_WINDOW (f); -} - -DEFUN ("frame-selected-window", Fframe_selected_window, 0, 1, 0, /* -Return the selected window of frame object FRAME. -If omitted, FRAME defaults to the currently selected frame. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - return FRAME_SELECTED_WINDOW (f); -} - -void -set_frame_selected_window (struct frame *f, Lisp_Object window) -{ - assert (XFRAME (WINDOW_FRAME (XWINDOW (window))) == f); - f->selected_window = window; - if (!MINI_WINDOW_P (XWINDOW (window)) || FRAME_MINIBUF_ONLY_P (f)) - { -#ifdef HAVE_TOOLBARS - if (!EQ (f->last_nonminibuf_window, window)) - MARK_TOOLBAR_CHANGED; -#endif - f->last_nonminibuf_window = window; - } -} - -DEFUN ("set-frame-selected-window", Fset_frame_selected_window, 2, 2, 0, /* -Set the selected window of frame object FRAME to WINDOW. -If FRAME is nil, the selected frame is used. -If FRAME is the selected frame, this makes WINDOW the selected window. -*/ - (frame, window)) -{ - XSETFRAME (frame, decode_frame (frame)); - CHECK_LIVE_WINDOW (window); - - if (! EQ (frame, WINDOW_FRAME (XWINDOW (window)))) - error ("In `set-frame-selected-window', WINDOW is not on FRAME"); - - if (XFRAME (frame) == selected_frame ()) - return Fselect_window (window, Qnil); - - set_frame_selected_window (XFRAME (frame), window); - return window; -} - - -DEFUN ("frame-device", Fframe_device, 0, 1, 0, /* -Return the device that FRAME is on. -If omitted, FRAME defaults to the currently selected frame. -*/ - (frame)) -{ - return FRAME_DEVICE (decode_frame (frame)); -} - -int -is_surrogate_for_selected_frame (struct frame *f) -{ - struct device *d = XDEVICE (f->device); - struct frame *dsf = device_selected_frame (d); - - /* Can't be a surrogate for ourselves. */ - if (f == dsf) - return 0; - - if (!FRAME_HAS_MINIBUF_P (dsf) && - f == XFRAME (WINDOW_FRAME (XWINDOW (FRAME_MINIBUF_WINDOW (dsf))))) - return 1; - else - return 0; -} - -static int -frame_matches_frametype (Lisp_Object frame, Lisp_Object type) -{ - struct frame *f = XFRAME (frame); - - if (WINDOWP (type)) - { - CHECK_LIVE_WINDOW (type); - - if (EQ (FRAME_MINIBUF_WINDOW (f), type) - /* Check that F either is, or has forwarded - its focus to, TYPE's frame. */ - && (EQ (WINDOW_FRAME (XWINDOW (type)), frame) - || EQ (WINDOW_FRAME (XWINDOW (type)), - FRAME_FOCUS_FRAME (f)))) - return 1; - else - return 0; - } - -#if 0 /* FSFmacs */ - if (EQ (type, Qvisible) || EQ (type, Qiconic) || EQ (type, Qvisible_iconic) - || EQ (type, Qvisible_nomini) || EQ (type, Qiconic_nomini) - || EQ (type, Qvisible_iconic_nomini)) - FRAME_SAMPLE_VISIBILITY (f); -#endif - - if (NILP (type)) - type = Qnomini; - if (ZEROP (type)) - type = Qvisible_iconic; - - if (EQ (type, Qvisible)) - return FRAME_VISIBLE_P (f); - if (EQ (type, Qiconic)) - return FRAME_ICONIFIED_P (f); - if (EQ (type, Qinvisible)) - return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f); - if (EQ (type, Qvisible_iconic)) - return FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f); - if (EQ (type, Qinvisible_iconic)) - return !FRAME_VISIBLE_P (f); - - if (EQ (type, Qnomini)) - return !FRAME_MINIBUF_ONLY_P (f); - if (EQ (type, Qvisible_nomini)) - return FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f); - if (EQ (type, Qiconic_nomini)) - return FRAME_ICONIFIED_P (f) && !FRAME_MINIBUF_ONLY_P (f); - if (EQ (type, Qinvisible_nomini)) - return !FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f) && - !FRAME_MINIBUF_ONLY_P (f); - if (EQ (type, Qvisible_iconic_nomini)) - return ((FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) - && !FRAME_MINIBUF_ONLY_P (f)); - if (EQ (type, Qinvisible_iconic_nomini)) - return !FRAME_VISIBLE_P (f) && !FRAME_MINIBUF_ONLY_P (f); - - return 1; -} - -int -device_matches_console_spec (Lisp_Object frame, Lisp_Object device, - Lisp_Object console) -{ - if (EQ (console, Qwindow_system)) - return DEVICE_WIN_P (XDEVICE (device)); - if (NILP (console)) - console = (DEVICE_CONSOLE (XDEVICE (FRAME_DEVICE (XFRAME (frame))))); - if (DEVICEP (console)) - return EQ (device, console); - if (CONSOLEP (console)) - return EQ (DEVICE_CONSOLE (XDEVICE (device)), console); - if (valid_console_type_p (console)) - return EQ (DEVICE_TYPE (XDEVICE (device)), console); - return 1; -} - -/* Return the next frame in the frame list after FRAME. - FRAMETYPE and CONSOLE control which frames and devices - are considered; see `next-frame'. */ - -static Lisp_Object -next_frame_internal (Lisp_Object frame, Lisp_Object frametype, - Lisp_Object console, int called_from_delete_device) -{ - int passed = 0; - int started_over = 0; - - /* If this frame is dead, it won't be in frame_list, and we'll loop - forever. Forestall that. */ - CHECK_LIVE_FRAME (frame); - - while (1) - { - Lisp_Object devcons, concons; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - Lisp_Object device = XCAR (devcons); - Lisp_Object frmcons; - - if (!device_matches_console_spec (frame, device, console)) - continue; - - DEVICE_FRAME_LOOP (frmcons, XDEVICE (device)) - { - Lisp_Object f = XCAR (frmcons); - if (passed) - { - /* #### Doing this here is bad and is now - unnecessary. The real bug was that f->iconified - was never, ever updated unless a user explicitly - called frame-iconified-p. That has now been - fixed. With this change removed all of the other - changes made to support this routine having the - called_from_delete_device arg could be removed. - But it is too close to release to do that now. */ -#if 0 - /* Make sure the visibility and iconified flags are - up-to-date unless we're being deleted. */ - if (!called_from_delete_device) - { - Fframe_iconified_p (f); - Fframe_visible_p (f); - } -#endif - - /* Decide whether this frame is eligible to be returned. */ - - /* If we've looped all the way around without finding any - eligible frames, return the original frame. */ - if (EQ (f, frame)) - return f; - - if (frame_matches_frametype (f, frametype)) - return f; - } - - if (EQ (frame, f)) - passed++; - } - } - /* We hit the end of the list, and need to start over again. */ - if (started_over) - return Qnil; - started_over++; - } -} - -Lisp_Object -next_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console) -{ - return next_frame_internal (frame, frametype, console, 0); -} - -/* Return the previous frame in the frame list before FRAME. - FRAMETYPE and CONSOLE control which frames and devices - are considered; see `next-frame'. */ - -Lisp_Object -prev_frame (Lisp_Object frame, Lisp_Object frametype, Lisp_Object console) -{ - Lisp_Object devcons, concons; - Lisp_Object prev; - - /* If this frame is dead, it won't be in frame_list, and we'll loop - forever. Forestall that. */ - CHECK_LIVE_FRAME (frame); - - prev = Qnil; - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - Lisp_Object device = XCAR (devcons); - Lisp_Object frmcons; - - if (!device_matches_console_spec (frame, device, console)) - continue; - - DEVICE_FRAME_LOOP (frmcons, XDEVICE (device)) - { - Lisp_Object f = XCAR (frmcons); - - if (EQ (frame, f) && !NILP (prev)) - return prev; - - /* Decide whether this frame is eligible to be returned, - according to frametype. */ - - if (frame_matches_frametype (f, frametype)) - prev = f; - - } - } - - /* We've scanned the entire list. */ - if (NILP (prev)) - /* We went through the whole frame list without finding a single - acceptable frame. Return the original frame. */ - return frame; - else - /* There were no acceptable frames in the list before FRAME; otherwise, - we would have returned directly from the loop. Since PREV is the last - acceptable frame in the list, return it. */ - return prev; -} - -DEFUN ("next-frame", Fnext_frame, 0, 3, 0, /* -Return the next frame of the right type in the frame list after FRAME. -FRAMETYPE controls which frames are eligible to be returned; all -others will be skipped. Note that if there is only one eligible -frame, then `next-frame' called repeatedly will always return -the same frame, and if there is no eligible frame, then FRAME is -returned. - -Possible values for FRAMETYPE are - -'visible Consider only frames that are visible. -'iconic Consider only frames that are iconic. -'invisible Consider only frames that are invisible - (this is different from iconic). -'visible-iconic Consider frames that are visible or iconic. -'invisible-iconic Consider frames that are invisible or iconic. -'nomini Consider all frames except minibuffer-only ones. -'visible-nomini Like `visible' but omits minibuffer-only frames. -'iconic-nomini Like `iconic' but omits minibuffer-only frames. -'invisible-nomini Like `invisible' but omits minibuffer-only frames. -'visible-iconic-nomini Like `visible-iconic' but omits minibuffer-only - frames. -'invisible-iconic-nomini Like `invisible-iconic' but omits minibuffer-only - frames. -any other value Consider all frames. - -If FRAMETYPE is omitted, 'nomini is used. A FRAMETYPE of 0 (a number) -is treated like 'iconic, for backwards compatibility. - -If FRAMETYPE is a window, include only its own frame and any frame now -using that window as the minibuffer. - -Optional third argument CONSOLE controls which consoles or devices the -returned frame may be on. If CONSOLE is a console, return frames only -on that console. If CONSOLE is a device, return frames only on that -device. If CONSOLE is a console type, return frames only on consoles -of that type. If CONSOLE is 'window-system, return any frames on any -window-system consoles. If CONSOLE is nil or omitted, return frames only -on the FRAME's console. Otherwise, all frames are considered. -*/ - (frame, frametype, console)) -{ - XSETFRAME (frame, decode_frame (frame)); - - return next_frame (frame, frametype, console); -} - -DEFUN ("previous-frame", Fprevious_frame, 0, 3, 0, /* -Return the next frame of the right type in the frame list after FRAME. -FRAMETYPE controls which frames are eligible to be returned; all -others will be skipped. Note that if there is only one eligible -frame, then `previous-frame' called repeatedly will always return -the same frame, and if there is no eligible frame, then FRAME is -returned. - -See `next-frame' for an explanation of the FRAMETYPE and CONSOLE -arguments. -*/ - (frame, frametype, console)) -{ - XSETFRAME (frame, decode_frame (frame)); - - return prev_frame (frame, frametype, console); -} - -/* Return any frame for which PREDICATE is non-zero, or return Qnil - if there aren't any. */ - -Lisp_Object -find_some_frame (int (*predicate) (Lisp_Object, void *), - void *closure) -{ - Lisp_Object framecons, devcons, concons; - - FRAME_LOOP_NO_BREAK (framecons, devcons, concons) - { - Lisp_Object frame = XCAR (framecons); - - if ((predicate) (frame, closure)) - return frame; - } - - return Qnil; -} - - - -/* extern void free_line_insertion_deletion_costs (struct frame *f); */ - -/* Return 1 if it is ok to delete frame F; - 0 if all frames aside from F are invisible. - (Exception: if F is a stream frame, it's OK to delete if - any other frames exist.) */ - -static int -other_visible_frames_internal (struct frame *f, int called_from_delete_device) -{ - Lisp_Object frame; - - XSETFRAME (frame, f); - if (FRAME_STREAM_P (f)) - return !EQ (frame, next_frame_internal (frame, Qt, Qt, - called_from_delete_device)); - return !EQ (frame, next_frame_internal (frame, Qvisible_iconic_nomini, Qt, - called_from_delete_device)); -} - -int -other_visible_frames (struct frame *f) -{ - return other_visible_frames_internal (f, 0); -} - -/* Delete frame F. - - If FORCE is non-zero, allow deletion of the only frame. - - If CALLED_FROM_DELETE_DEVICE is non-zero, then, if - deleting the last frame on a device, just delete it, - instead of calling `delete-device'. - - If FROM_IO_ERROR is non-zero, then the frame is gone due - to an I/O error. This affects what happens if we exit - (we do an emergency exit instead of `save-buffers-kill-emacs'.) -*/ - -void -delete_frame_internal (struct frame *f, int force, - int called_from_delete_device, - int from_io_error) -{ - /* This function can GC */ - int minibuffer_selected; - struct device *d; - struct console *con; - Lisp_Object frame; - Lisp_Object device; - Lisp_Object console; - struct gcpro gcpro1; - - /* OK to delete an already deleted frame. */ - if (! FRAME_LIVE_P (f)) - return; - - XSETFRAME (frame, f); - GCPRO1 (frame); - - device = FRAME_DEVICE (f); - d = XDEVICE (device); - console = DEVICE_CONSOLE (d); - con = XCONSOLE (console); - - if (!called_from_delete_device) - { - /* If we're deleting the only non-minibuffer frame on the - device, delete the device. */ - if (EQ (frame, next_frame (frame, Qnomini, FRAME_DEVICE (f)))) - { - delete_device_internal (d, force, 0, from_io_error); - UNGCPRO; - return; - } - } - - /* In FSF, delete-frame will not normally allow you to delete the - last visible frame. This was too annoying, so we changed it to the - only frame. However, this would let people shoot themselves by - deleting all frames which were either visible or iconified and thus - losing any way of communicating with the still running XEmacs process. - So we put it back. */ - if (!force && !allow_deletion_of_last_visible_frame && - !other_visible_frames_internal (f, called_from_delete_device)) - error ("Attempt to delete the sole visible or iconified frame"); - - /* Does this frame have a minibuffer, and is it the surrogate - minibuffer for any other frame? */ - if (FRAME_HAS_MINIBUF_P (f)) - { - Lisp_Object frmcons, devcons, concons; - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - Lisp_Object this = XCAR (frmcons); - - if (! EQ (this, frame) - && EQ (frame, (WINDOW_FRAME - (XWINDOW - (FRAME_MINIBUF_WINDOW (XFRAME (this))))))) - { - /* We've found another frame whose minibuffer is on - this frame. */ - signal_simple_error - ("Attempt to delete a surrogate minibuffer frame", frame); - } - } - } - - /* Test for popup frames hanging around. */ - /* Deletion of a parent frame with popups is deadly. */ - { - Lisp_Object frmcons, devcons, concons; - - FRAME_LOOP_NO_BREAK (frmcons, devcons, concons) - { - Lisp_Object this = XCAR (frmcons); - - - if (! EQ (this, frame)) - { - struct device *devcons_d = XDEVICE (XCAR (devcons)); - if (EQ (frame, DEVMETH_OR_GIVEN (devcons_d, get_frame_parent, - (XFRAME (this)), - Qnil))) - /* We've found a popup frame whose parent is this frame. */ - signal_simple_error - ("Attempt to delete a frame with live popups", frame); - } - } - } - - /* Before here, we haven't made any dangerous changes (just checked for - error conditions). Now run the delete-frame-hook. Remember that - user code there could do any number of dangerous things, including - signalling an error. */ - - va_run_hook_with_args (Qdelete_frame_hook, 1, frame); - - if (!FRAME_LIVE_P (f)) /* Make sure the delete-frame-hook didn't */ - { /* go ahead and delete anything. */ - UNGCPRO; - return; - } - - /* Call the delete-device-hook and delete-console-hook now if - appropriate, before we do any dangerous things -- they too could - signal an error. */ - if (XINT (Flength (DEVICE_FRAME_LIST (d))) == 1) - { - va_run_hook_with_args (Qdelete_device_hook, 1, device); - if (!FRAME_LIVE_P (f)) /* Make sure the delete-device-hook didn't */ - { /* go ahead and delete anything. */ - UNGCPRO; - return; - } - - if (XINT (Flength (CONSOLE_DEVICE_LIST (con))) == 1) - { - va_run_hook_with_args (Qdelete_console_hook, 1, console); - if (!FRAME_LIVE_P (f)) /* Make sure the delete-console-hook didn't */ - { /* go ahead and delete anything. */ - UNGCPRO; - return; - } - } - } - - minibuffer_selected = EQ (minibuf_window, Fselected_window (Qnil)); - - /* If we were focused on this frame, then we're not any more. - Assume that we lost the focus; that way, the call to - Fselect_frame() below won't end up making us explicitly - focus on another frame, which is generally undesirable in - a point-to-type world. If our mouse ends up sitting over - another frame, we will receive a FocusIn event and end up - making that frame the selected frame. - - #### This may not be an ideal solution in a click-to-type - world (in that case, we might want to explicitly choose - another frame to have the focus, rather than relying on - the WM, which might focus on a frame in a different app - or focus on nothing at all). But there's no easy way - to detect which focus model we're running on, and the - alternative is more heinous. */ - - if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_REAL (d))) - DEVICE_FRAME_WITH_FOCUS_REAL (d) = Qnil; - if (EQ (frame, DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d))) - DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d) = Qnil; - if (EQ (frame, DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d))) - DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d) = Qnil; - - /* Don't allow the deleted frame to remain selected. - Note that in the former scheme of things, this would - have caused us to regain the focus. This no longer - applies (see above); I think the new behavior is more - logical. If someone disagrees, it can always be - changed (or a new user variable can be introduced, ugh.) */ - if (EQ (frame, DEVICE_SELECTED_FRAME (d))) - { - Lisp_Object next; - - /* If this is a popup frame, select its parent if possible. - Otherwise, find another visible frame; if none, just take any frame. - First try the same device, then the same console. */ - - next = DEVMETH_OR_GIVEN (d, get_frame_parent, (f), Qnil); - if (NILP (next) || EQ (next, frame) || ! FRAME_LIVE_P (XFRAME (next))) - next = next_frame_internal (frame, Qvisible, device, - called_from_delete_device); - if (NILP (next) || EQ (next, frame)) - next = next_frame_internal (frame, Qvisible, console, - called_from_delete_device); - if (NILP (next) || EQ (next, frame)) - next = next_frame_internal (frame, Qvisible, Qt, - called_from_delete_device); - if (NILP (next) || EQ (next, frame)) - next = next_frame_internal (frame, Qt, device, - called_from_delete_device); - if (NILP (next) || EQ (next, frame)) - next = next_frame_internal (frame, Qt, console, - called_from_delete_device); - if (NILP (next) || EQ (next, frame)) - next = next_frame_internal (frame, Qt, Qt, called_from_delete_device); - - /* if we haven't found another frame at this point - then there aren't any. */ - if (NILP (next) || EQ (next, frame)) - ; - else - { - int did_select = 0; - /* if this is the global selected frame, select another one. */ - if (EQ (frame, Fselected_frame (Qnil))) - { - Fselect_frame (next); - did_select = 1; - } - /* - * If the new frame we just selected is on a different - * device then we still need to change DEVICE_SELECTED_FRAME(d) - * to a live frame, if there are any left on this device. - */ - if (!EQ (device, FRAME_DEVICE(XFRAME(next)))) - { - Lisp_Object next_f = - next_frame_internal (frame, Qt, device, - called_from_delete_device); - if (NILP (next_f) || EQ (next_f, frame)) - ; - else - set_device_selected_frame (d, next_f); - } - else if (! did_select) - set_device_selected_frame (d, next); - - } - } - - /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (f->minibuffer_window, minibuf_window)) - { - struct frame *sel_frame = selected_frame (); - Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); - minibuf_window = sel_frame->minibuffer_window; - - /* If the dying minibuffer window was selected, - select the new one. */ - if (minibuffer_selected) - Fselect_window (minibuf_window, Qnil); - } - - /* After this point, no errors must be allowed to occur. */ - -#ifdef HAVE_MENUBARS - free_frame_menubars (f); -#endif -#ifdef HAVE_SCROLLBARS - free_frame_scrollbars (f); -#endif -#ifdef HAVE_TOOLBARS - free_frame_toolbars (f); -#endif - - /* This must be done before the window and window_mirror structures - are freed. The scrollbar information is attached to them. */ - MAYBE_FRAMEMETH (f, delete_frame, (f)); - - /* Mark all the windows that used to be on FRAME as deleted, and then - remove the reference to them. */ - delete_all_subwindows (XWINDOW (f->root_window)); - f->root_window = Qnil; - - /* clear out the cached glyph information */ - if (f->subwindow_cachels) - { - Dynarr_free (f->subwindow_cachels); - f->subwindow_cachels = 0; - } - - /* Remove the frame now from the list. This way, any events generated - on this frame by the maneuvers below will disperse themselves. */ - - /* This used to be Fdelq(), but that will cause a seg fault if the - QUIT checker happens to get invoked, because the frame list is in - an inconsistent state. */ - d->frame_list = delq_no_quit (frame, d->frame_list); - RESET_CHANGED_SET_FLAGS; - - f->dead = 1; - f->visible = 0; - - free_window_mirror (f->root_mirror); -/* free_line_insertion_deletion_costs (f); */ - - /* If we've deleted the last non-minibuf frame, then try to find - another one. */ - if (EQ (frame, CONSOLE_LAST_NONMINIBUF_FRAME (con))) - { - Lisp_Object frmcons, devcons; - - set_console_last_nonminibuf_frame (con, Qnil); - - CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) - { - Lisp_Object ecran = XCAR (frmcons); - if (!FRAME_MINIBUF_ONLY_P (XFRAME (ecran))) - { - set_console_last_nonminibuf_frame (con, ecran); - goto double_break_1; - } - } - } - double_break_1: - -#if 0 - /* The following test is degenerate FALSE */ - if (called_from_delete_device < 0) - /* then we're being called from delete-console, and we shouldn't - try to find another default-minibuffer frame for the console. - */ - con->default_minibuffer_frame = Qnil; -#endif - - /* If we've deleted this console's default_minibuffer_frame, try to - find another one. Prefer minibuffer-only frames, but also notice - frames with other windows. */ - if (EQ (frame, con->default_minibuffer_frame)) - { - Lisp_Object frmcons, devcons; - /* The last frame we saw with a minibuffer, minibuffer-only or not. */ - Lisp_Object frame_with_minibuf; - /* Some frame we found on the same console, or nil if there are none. */ - Lisp_Object frame_on_same_console; - - frame_on_same_console = Qnil; - frame_with_minibuf = Qnil; - - set_console_last_nonminibuf_frame (con, Qnil); - - CONSOLE_FRAME_LOOP_NO_BREAK (frmcons, devcons, con) - { - Lisp_Object this; - struct frame *f1; - - this = XCAR (frmcons); - f1 = XFRAME (this); - - /* Consider only frames on the same console - and only those with minibuffers. */ - if (FRAME_HAS_MINIBUF_P (f1)) - { - frame_with_minibuf = this; - if (FRAME_MINIBUF_ONLY_P (f1)) - goto double_break_2; - } - - frame_on_same_console = this; - } - double_break_2: - - if (!NILP (frame_on_same_console)) - { - /* We know that there must be some frame with a minibuffer out - there. If this were not true, all of the frames present - would have to be minibuffer-less, which implies that at some - point their minibuffer frames must have been deleted, but - that is prohibited at the top; you can't delete surrogate - minibuffer frames. */ - if (NILP (frame_with_minibuf)) - abort (); - - con->default_minibuffer_frame = frame_with_minibuf; - } - else - /* No frames left on this console--say no minibuffer either. */ - con->default_minibuffer_frame = Qnil; - } - - nuke_all_frame_slots (f); /* nobody should be accessing the device - or anything else any more, and making - them Qnil allows for better GC'ing - in case a pointer to the dead frame - continues to hang around. */ - f->framemeths = dead_console_methods; - UNGCPRO; -} - -void -io_error_delete_frame (Lisp_Object frame) -{ - delete_frame_internal (XFRAME (frame), 1, 0, 1); -} - -DEFUN ("delete-frame", Fdelete_frame, 0, 2, "", /* -Delete FRAME, permanently eliminating it from use. -If omitted, FRAME defaults to the selected frame. -A frame may not be deleted if its minibuffer is used by other frames. -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'.) -*/ - (frame, force)) -{ - /* This function can GC */ - struct frame *f; - - if (NILP (frame)) - { - f = selected_frame (); - XSETFRAME (frame, f); - } - else - { - CHECK_FRAME (frame); - f = XFRAME (frame); - } - - delete_frame_internal (f, !NILP (force), 0, 0); - return Qnil; -} - - -/* Return mouse position in character cell units. */ - -static int -mouse_pixel_position_1 (struct device *d, Lisp_Object *frame, - int *x, int *y) -{ - switch (DEVMETH_OR_GIVEN (d, get_mouse_position, (d, frame, x, y), -1)) - { - case 1: - return 1; - - case 0: - *frame = Qnil; - break; - - case -1: - *frame = DEVICE_SELECTED_FRAME (d); - break; - - default: - abort (); /* method is incorrectly written */ - } - - return 0; -} - -DEFUN ("mouse-pixel-position", Fmouse_pixel_position, 0, 1, 0, /* -Return a list (WINDOW X . Y) giving the current mouse window and position. -The position is given in pixel units, where (0, 0) is the upper-left corner. - -When the cursor is not over a window, the return value is a list (nil nil). - -DEVICE specifies the device on which to read the mouse position, and -defaults to the selected device. If the device is a mouseless terminal -or Emacs hasn't been programmed to read its mouse position, it returns -the device's selected window for WINDOW and nil for X and Y. -*/ - (device)) -{ - struct device *d = decode_device (device); - Lisp_Object frame; - Lisp_Object window = Qnil; - Lisp_Object x = Qnil; - Lisp_Object y = Qnil; - int intx, inty; - - if (mouse_pixel_position_1 (d, &frame, &intx, &inty) > 0) - { - struct window *w = - find_window_by_pixel_pos (intx, inty, XFRAME (frame)->root_window); - if (w) - { - XSETWINDOW (window, w); - - /* Adjust the position to be relative to the window. */ - intx -= w->pixel_left; - inty -= w->pixel_top; - XSETINT (x, intx); - XSETINT (y, inty); - } - } - else if (FRAMEP (frame)) - window = FRAME_SELECTED_WINDOW (XFRAME (frame)); - - return Fcons (window, Fcons (x, y)); -} - -DEFUN ("mouse-position", Fmouse_position, 0, 1, 0, /* -Return a list (WINDOW X . Y) giving the current mouse window and position. -The position is of a character under cursor, where (0, 0) is the upper-left -corner of the window. - -When the cursor is not over a character, or not over a window, the return -value is a list (nil nil). - -DEVICE specifies the device on which to read the mouse position, and -defaults to the selected device. If the device is a mouseless terminal -or Emacs hasn't been programmed to read its mouse position, it returns -the device's selected window for WINDOW and nil for X and Y. -*/ - (device)) -{ - struct device *d = decode_device (device); - struct window *w; - Lisp_Object frame, window = Qnil, lisp_x = Qnil, lisp_y = Qnil; - int x, y, obj_x, obj_y; - Bufpos bufpos, closest; - Charcount modeline_closest; - Lisp_Object obj1, obj2; - - if (mouse_pixel_position_1 (d, &frame, &x, &y) > 0) - { - int res = pixel_to_glyph_translation (XFRAME (frame), x, y, &x, &y, - &obj_x, &obj_y, &w, &bufpos, - &closest, &modeline_closest, - &obj1, &obj2); - if (res == OVER_TEXT) - { - lisp_x = make_int (x); - lisp_y = make_int (y); - XSETWINDOW (window, w); - } - } - else if (FRAMEP (frame)) - window = FRAME_SELECTED_WINDOW (XFRAME (frame)); - - return Fcons (window, Fcons (lisp_x, lisp_y)); -} - -DEFUN ("mouse-position-as-motion-event", Fmouse_position_as_motion_event, 0, 1, 0, /* -Return the current mouse position as a motion event. -This allows you to call the standard event functions such as -`event-over-toolbar-p' to determine where the mouse is. - -DEVICE specifies the device on which to read the mouse position, and -defaults to the selected device. If the mouse position can't be determined -\(e.g. DEVICE is a TTY device), nil is returned instead of an event. -*/ - (device)) -{ - struct device *d = decode_device (device); - Lisp_Object frame; - int intx, inty; - - if (mouse_pixel_position_1 (d, &frame, &intx, &inty)) - { - Lisp_Object event = Fmake_event (Qnil, Qnil); - XEVENT (event)->event_type = pointer_motion_event; - XEVENT (event)->channel = frame; - XEVENT (event)->event.motion.x = intx; - XEVENT (event)->event.motion.y = inty; - return event; - } - else - return Qnil; -} - -DEFUN ("set-mouse-position", Fset_mouse_position, 3, 3, 0, /* -Move the mouse pointer to the center of character cell (X,Y) in WINDOW. -Note, this is a no-op for an X frame that is not visible. -If you have just created a frame, you must wait for it to become visible -before calling this function on it, like this. - (while (not (frame-visible-p frame)) (sleep-for .5)) -Note also: Warping the mouse is contrary to the ICCCM, so be very sure - that the behavior won't end up being obnoxious! -*/ - (window, x, y)) -{ - struct window *w; - int pix_x, pix_y; - - CHECK_WINDOW (window); - CHECK_INT (x); - CHECK_INT (y); - - /* Warping the mouse will cause EnterNotify and Focus events under X. */ - w = XWINDOW (window); - glyph_to_pixel_translation (w, XINT (x), XINT (y), &pix_x, &pix_y); - - MAYBE_FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, pix_x, pix_y)); - - return Qnil; -} - -DEFUN ("set-mouse-pixel-position", Fset_mouse_pixel_position, 3, 3, 0, /* -Move the mouse pointer to pixel position (X,Y) in WINDOW. -Note, this is a no-op for an X frame that is not visible. -If you have just created a frame, you must wait for it to become visible -before calling this function on it, like this. - (while (not (frame-visible-p frame)) (sleep-for .5)) -*/ - (window, x, y)) -{ - struct window *w; - - CHECK_WINDOW (window); - CHECK_INT (x); - CHECK_INT (y); - - /* Warping the mouse will cause EnterNotify and Focus events under X. */ - w = XWINDOW (window); - FRAMEMETH (XFRAME (w->frame), set_mouse_position, (w, XINT (x), XINT (y))); - - return Qnil; -} - -DEFUN ("make-frame-visible", Fmake_frame_visible, 0, 1, 0, /* -Make the frame FRAME visible (assuming it is an X-window). -If omitted, FRAME defaults to the currently selected frame. -Also raises the frame so that nothing obscures it. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - - MAYBE_FRAMEMETH (f, make_frame_visible, (f)); - return frame; -} - -DEFUN ("make-frame-invisible", Fmake_frame_invisible, 0, 2, 0, /* -Unconditionally removes frame from the display (assuming it is an X-window). -If omitted, FRAME defaults to the currently selected frame. -If what you want to do is iconify the frame (if the window manager uses -icons) then you should call `iconify-frame' instead. -Normally you may not make FRAME invisible if all other frames are invisible -and uniconified, but if the second optional argument FORCE is non-nil, -you may do so. -*/ - (frame, force)) -{ - struct frame *f, *sel_frame; - struct device *d; - - f = decode_frame (frame); - d = XDEVICE (FRAME_DEVICE (f)); - sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d)); - - if (NILP (force) && !other_visible_frames (f)) - error ("Attempt to make invisible the sole visible or iconified frame"); - - /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (f->minibuffer_window, minibuf_window)) - { - Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); - minibuf_window = sel_frame->minibuffer_window; - } - - MAYBE_FRAMEMETH (f, make_frame_invisible, (f)); - - return Qnil; -} - -DEFUN ("iconify-frame", Ficonify_frame, 0, 1, "", /* -Make the frame FRAME into an icon, if the window manager supports icons. -If omitted, FRAME defaults to the currently selected frame. -*/ - (frame)) -{ - struct frame *f, *sel_frame; - struct device *d; - - f = decode_frame (frame); - d = XDEVICE (FRAME_DEVICE (f)); - sel_frame = XFRAME (DEVICE_SELECTED_FRAME (d)); - - /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (f->minibuffer_window, minibuf_window)) - { - Fset_window_buffer (sel_frame->minibuffer_window, - XWINDOW (minibuf_window)->buffer); - minibuf_window = sel_frame->minibuffer_window; - } - - MAYBE_FRAMEMETH (f, iconify_frame, (f)); - - return Qnil; -} - -DEFUN ("deiconify-frame", Fdeiconify_frame, 0, 1, 0, /* -Open (de-iconify) the iconified frame FRAME. -Under X, this is currently the same as `make-frame-visible'. -If omitted, FRAME defaults to the currently selected frame. -Also raises the frame so that nothing obscures it. -*/ - (frame)) -{ - return Fmake_frame_visible (frame); -} - -/* FSF returns 'icon for iconized frames. What a crock! */ - -DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /* -Return non NIL if FRAME is now "visible" (actually in use for display). -A frame that is not visible is not updated, and, if it works through a -window system, may not show at all. -N.B. Under X "visible" means Mapped. It the window is mapped but not -actually visible on screen then frame_visible returns 'hidden. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - int visible = FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible); - return visible ? ( visible > 0 ? Qt : Qhidden ) : Qnil; -} - -DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /* -Return t if frame is not obscured by any other window system windows. -Always returns t for tty frames. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - return (FRAMEMETH_OR_GIVEN (f, frame_totally_visible_p, (f), f->visible) - ? Qt : Qnil); -} - -DEFUN ("frame-iconified-p", Fframe_iconified_p, 0, 1, 0, /* -Return t if FRAME is iconified. -Not all window managers use icons; some merely unmap the window, so this -function is not the inverse of `frame-visible-p'. It is possible for a -frame to not be visible and not be iconified either. However, if the -frame is iconified, it will not be visible. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - if (f->visible) - return Qnil; - f->iconified = FRAMEMETH_OR_GIVEN (f, frame_iconified_p, (f), 0); - return f->iconified ? Qt : Qnil; -} - -DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /* -Return a list of all frames now "visible" (being updated). -If DEVICE is specified only frames on that device will be returned. -Note that under virtual window managers not all these frame are necessarily -really updated. -*/ - (device)) -{ - Lisp_Object devcons, concons; - struct frame *f; - Lisp_Object value; - - value = Qnil; - - DEVICE_LOOP_NO_BREAK (devcons, concons) - { - assert (DEVICEP (XCAR (devcons))); - - if (NILP (device) || EQ (device, XCAR (devcons))) - { - Lisp_Object frmcons; - - DEVICE_FRAME_LOOP (frmcons, XDEVICE (XCAR (devcons))) - { - Lisp_Object frame = XCAR (frmcons); - f = XFRAME (frame); - if (FRAME_VISIBLE_P(f)) - value = Fcons (frame, value); - } - } - } - - return value; -} - - -DEFUN ("raise-frame", Fraise_frame, 0, 1, "", /* -Bring FRAME to the front, so it occludes any frames it overlaps. -If omitted, FRAME defaults to the currently selected frame. -If FRAME is invisible, make it visible. -If Emacs is displaying on an ordinary terminal or some other device which -doesn't support multiple overlapping frames, this function does nothing. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - - /* Do like the documentation says. */ - Fmake_frame_visible (frame); - MAYBE_FRAMEMETH (f, raise_frame, (f)); - return Qnil; -} - -DEFUN ("lower-frame", Flower_frame, 0, 1, "", /* -Send FRAME to the back, so it is occluded by any frames that overlap it. -If omitted, FRAME defaults to the currently selected frame. -If Emacs is displaying on an ordinary terminal or some other device which -doesn't support multiple overlapping frames, this function does nothing. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - - MAYBE_FRAMEMETH (f, lower_frame, (f)); - return Qnil; -} - -/* Ben thinks there is no need for `redirect-frame-focus' or `frame-focus', - crockish FSFmacs functions. See summary on focus in event-stream.c. */ - - -/***************************************************************************/ -/* frame properties */ -/***************************************************************************/ - -static void internal_set_frame_size (struct frame *f, int cols, int rows, - int pretend); - -static void -store_minibuf_frame_prop (struct frame *f, Lisp_Object val) -{ - Lisp_Object frame; - XSETFRAME (frame, f); - - if (WINDOWP (val)) - { - if (! MINI_WINDOW_P (XWINDOW (val))) - signal_simple_error - ("Surrogate minibuffer windows must be minibuffer windows", - val); - - if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) - signal_simple_error - ("Can't change the surrogate minibuffer of a frame with its own minibuffer", frame); - - /* Install the chosen minibuffer window, with proper buffer. */ - f->minibuffer_window = val; - } - else if (EQ (val, Qt)) - { - if (FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) - signal_simple_error - ("Frame already has its own minibuffer", frame); - else - { - setup_normal_frame (f); - f->mirror_dirty = 1; - - update_frame_window_mirror (f); - internal_set_frame_size (f, f->width, f->height, 1); - } - } -} - -#if 0 - -/* possible code if you want to have symbols such as `default-background' - map to setting the background of `default', etc. */ - -static int -dissect_as_face_setting (Lisp_Object sym, Lisp_Object *face_out, - Lisp_Object *face_prop_out) -{ - Lisp_Object list = Vbuilt_in_face_specifiers; - struct Lisp_String *s; - - if (!SYMBOLP (sym)) - return 0; - - s = symbol_name (XSYMBOL (sym)); - - while (!NILP (list)) - { - Lisp_Object prop = Fcar (list); - struct Lisp_String *prop_name; - - if (!SYMBOLP (prop)) - continue; - prop_name = symbol_name (XSYMBOL (prop)); - if (string_length (s) > string_length (prop_name) + 1 - && !memcmp (string_data (prop_name), - string_data (s) + string_length (s) - - string_length (prop_name), - string_length (prop_name)) - && string_data (s)[string_length (s) - string_length (prop_name) - - 1] == '-') - { - Lisp_Object face = - Ffind_face (make_string (string_data (s), - string_length (s) - - string_length (prop_name) - - 1)); - if (!NILP (face)) - { - *face_out = face; - *face_prop_out = prop; - return 1; - } - } - - list = Fcdr (list); - } - - return 0; -} - -#endif /* 0 */ - -static Lisp_Object -get_property_alias (Lisp_Object prop) -{ - while (1) - { - Lisp_Object alias = Qnil; - - if (SYMBOLP (prop)) - alias = Fget (prop, Qframe_property_alias, Qnil); - if (NILP (alias)) - break; - prop = alias; - QUIT; - } - - return prop; -} - -/* #### Using this to modify the internal border width has no effect - because the change isn't propagated to the windows. Are there - other properties which this claims to handle, but doesn't? - - But of course. This stuff needs more work, but it's a lot closer - to sanity now than before with the horrible frame-params stuff. */ - -DEFUN ("set-frame-properties", Fset_frame_properties, 2, 2, 0, /* -Change some properties of a frame. -PLIST is a property list. -You can also change frame properties individually using `set-frame-property', -but it may be more efficient to change many properties at once. - -Frame properties can be retrieved using `frame-property' or `frame-properties'. - -The following symbols etc. have predefined meanings: - - name Name of the frame. Used with X resources. - Unchangeable after creation. - - height Height of the frame, in lines. - - width Width of the frame, in characters. - - minibuffer Gives the minibuffer behavior for this frame. Either - t (frame has its own minibuffer), `only' (frame is - a minibuffer-only frame), or a window (frame uses that - window, which is on another frame, as the minibuffer). - - unsplittable If non-nil, frame cannot be split by `display-buffer'. - - current-display-table, menubar-visible-p, left-margin-width, - right-margin-width, minimum-line-ascent, minimum-line-descent, - use-left-overflow, use-right-overflow, scrollbar-width, scrollbar-height, - default-toolbar, top-toolbar, bottom-toolbar, left-toolbar, right-toolbar, - default-toolbar-height, default-toolbar-width, top-toolbar-height, - bottom-toolbar-height, left-toolbar-width, right-toolbar-width, - default-toolbar-visible-p, top-toolbar-visible-p, bottom-toolbar-visible-p, - left-toolbar-visible-p, right-toolbar-visible-p, toolbar-buttons-captioned-p, - top-toolbar-border-width, bottom-toolbar-border-width, - left-toolbar-border-width, right-toolbar-border-width, - modeline-shadow-thickness, has-modeline-p - [Giving the name of any built-in specifier variable is - equivalent to calling `set-specifier' on the specifier, - with a locale of FRAME. Giving the name to `frame-property' - calls `specifier-instance' on the specifier.] - - text-pointer-glyph, nontext-pointer-glyph, modeline-pointer-glyph, - selection-pointer-glyph, busy-pointer-glyph, toolbar-pointer-glyph, - menubar-pointer-glyph, scrollbar-pointer-glyph, gc-pointer-glyph, - octal-escape-glyph, control-arrow-glyph, invisible-text-glyph, - hscroll-glyph, truncation-glyph, continuation-glyph - [Giving the name of any glyph variable is equivalent to - calling `set-glyph-image' on the glyph, with a locale - of FRAME. Giving the name to `frame-property' calls - `glyph-image-instance' on the glyph.] - - [default foreground], [default background], [default font], - [modeline foreground], [modeline background], [modeline font], - etc. - [Giving a vector of a face and a property is equivalent - to calling `set-face-property' on the face and property, - with a locale of FRAME. Giving the vector to - `frame-property' calls `face-property-instance' on the - face and property.] - -Finally, if a frame property symbol has the property `frame-property-alias' -on it, then the value will be used in place of that symbol when looking -up and setting frame property values. This allows you to alias one -frame property name to another. - -See the variables `default-x-frame-plist', `default-tty-frame-plist' -and `default-mswindows-frame-plist' for a description of the properties -recognized for particular types of frames. -*/ - (frame, plist)) -{ - struct frame *f = decode_frame (frame); - Lisp_Object tail; - Lisp_Object *tailp; - struct gcpro gcpro1, gcpro2; - - XSETFRAME (frame, f); - GCPRO2 (frame, plist); - Fcheck_valid_plist (plist); - plist = Fcopy_sequence (plist); - Fcanonicalize_lax_plist (plist, Qnil); - for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail))) - { - Lisp_Object prop = Fcar (tail); - Lisp_Object val = Fcar (Fcdr (tail)); - - prop = get_property_alias (prop); - -#if 0 - /* mly wants this, but it's not reasonable to change the name of a - frame after it has been created, because the old name was used - for resource lookup. */ - if (EQ (prop, Qname)) - { - CHECK_STRING (val); - f->name = val; - } -#endif /* 0 */ - if (EQ (prop, Qminibuffer)) - store_minibuf_frame_prop (f, val); - if (EQ (prop, Qunsplittable)) - f->no_split = !NILP (val); - if (EQ (prop, Qbuffer_predicate)) - f->buffer_predicate = val; - if (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop), - Qconst_specifier)) - call3 (Qset_specifier, Fsymbol_value (prop), val, frame); - if (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, Qnil))) - call3 (Qset_glyph_image, Fsymbol_value (prop), val, frame); - if (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2) - { - Lisp_Object face_prop = XVECTOR_DATA (prop)[1]; - CHECK_SYMBOL (face_prop); - call4 (Qset_face_property, - Fget_face (XVECTOR_DATA (prop)[0]), - face_prop, val, frame); - } - } - - MAYBE_FRAMEMETH (f, set_frame_properties, (f, plist)); - for (tailp = &plist; !NILP (*tailp);) - { - Lisp_Object *next_tailp; - Lisp_Object next; - Lisp_Object prop; - - next = Fcdr (*tailp); - CHECK_CONS (next); - next_tailp = &XCDR (next); - prop = Fcar (*tailp); - - prop = get_property_alias (prop); - - if (EQ (prop, Qminibuffer) - || EQ (prop, Qunsplittable) - || EQ (prop, Qbuffer_predicate) - || EQ (prop, Qheight) - || EQ (prop, Qwidth) - || (SYMBOLP (prop) && EQ (Fbuilt_in_variable_type (prop), - Qconst_specifier)) - || (SYMBOLP (prop) && !NILP (Fget (prop, Qconst_glyph_variable, - Qnil))) - || (VECTORP (prop) && XVECTOR_LENGTH (prop) == 2) - || FRAMEMETH_OR_GIVEN (f, internal_frame_property_p, (f, prop), 0)) - *tailp = *next_tailp; - tailp = next_tailp; - } - - f->plist = nconc2 (plist, f->plist); - Fcanonicalize_lax_plist (f->plist, Qnil); - UNGCPRO; - return Qnil; -} - -DEFUN ("frame-property", Fframe_property, 2, 3, 0, /* -Return FRAME's value for property PROPERTY. -See `set-frame-properties' for the built-in property names. -*/ - (frame, property, default_)) -{ - struct frame *f = decode_frame (frame); - Lisp_Object value; - - XSETFRAME (frame, f); - - property = get_property_alias (property); - - if (EQ (Qname, property)) return f->name; - - if (EQ (Qheight, property) || EQ (Qwidth, property)) - { - if (window_system_pixelated_geometry (frame)) - { - int width, height; - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &width, &height); - return make_int (EQ (Qheight, property) ? height: width); - } - else - return make_int (EQ (Qheight, property) ? - FRAME_HEIGHT (f) : - FRAME_WIDTH (f)); - } - - /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P. - This is over-the-top bogosity, because it's inconsistent with - the semantics of `minibuffer' when passed to `make-frame'. - Returning Qt makes things consistent. */ - if (EQ (Qminibuffer, property)) - return (FRAME_MINIBUF_ONLY_P (f) ? Qonly : - FRAME_HAS_MINIBUF_P (f) ? Qt : - FRAME_MINIBUF_WINDOW (f)); - if (EQ (Qunsplittable, property)) - return FRAME_NO_SPLIT_P (f) ? Qt : Qnil; - if (EQ (Qbuffer_predicate, property)) - return f->buffer_predicate; - - if (SYMBOLP (property)) - { - if (EQ (Fbuilt_in_variable_type (property), Qconst_specifier)) - return Fspecifier_instance (Fsymbol_value (property), - frame, default_, Qnil); - if (!NILP (Fget (property, Qconst_glyph_variable, Qnil))) - { - Lisp_Object glyph = Fsymbol_value (property); - CHECK_GLYPH (glyph); - return Fspecifier_instance (XGLYPH_IMAGE (glyph), - frame, default_, Qnil); - } - } - - if (VECTORP (property) && XVECTOR_LENGTH (property) == 2) - { - Lisp_Object face_prop = XVECTOR_DATA (property)[1]; - CHECK_SYMBOL (face_prop); - return call3 (Qface_property_instance, - Fget_face (XVECTOR_DATA (property)[0]), - face_prop, frame); - } - - if (HAS_FRAMEMETH_P (f, frame_property)) - if (!UNBOUNDP (value = FRAMEMETH (f, frame_property, (f, property)))) - return value; - - if (!UNBOUNDP (value = external_plist_get (&f->plist, property, 1, ERROR_ME))) - return value; - - return default_; -} - -DEFUN ("frame-properties", Fframe_properties, 0, 1, 0, /* -Return a property list of the properties of FRAME. -Do not modify this list; use `set-frame-property' instead. -*/ - (frame)) -{ - struct frame *f = decode_frame (frame); - Lisp_Object result = Qnil; - struct gcpro gcpro1; - - GCPRO1 (result); - - XSETFRAME (frame, f); - - /* #### for the moment (since old code uses `frame-parameters'), - we call `copy-sequence' on f->plist. That allows frame-parameters - to destructively convert the plist into an alist, which is more - efficient than doing it non-destructively. At some point we - should remove the call to copy-sequence. */ - result = Fcopy_sequence (f->plist); - - /* #### should we be adding all the specifiers and glyphs? - That would entail having a list of them all. */ - if (HAS_FRAMEMETH_P (f, frame_properties)) - result = nconc2 (FRAMEMETH (f, frame_properties, (f)), result); - - if (!NILP (f->buffer_predicate)) - result = cons3 (Qbuffer_predicate, f->buffer_predicate, result); - - if (FRAME_NO_SPLIT_P (f)) - result = cons3 (Qunsplittable, Qt, result); - - /* NOTE: FSF returns Qnil instead of Qt for FRAME_HAS_MINIBUF_P. - This is over-the-top bogosity, because it's inconsistent with - the semantics of `minibuffer' when passed to `make-frame'. - Returning Qt makes things consistent. */ - result = cons3 (Qminibuffer, - (FRAME_MINIBUF_ONLY_P (f) ? Qonly : - FRAME_HAS_MINIBUF_P (f) ? Qt : - FRAME_MINIBUF_WINDOW (f)), - result); - { - int width, height; - - if (window_system_pixelated_geometry (frame)) - { - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &width, &height); - } - else - { - height = FRAME_HEIGHT (f); - width = FRAME_WIDTH (f); - } - result = cons3 (Qwidth , make_int (width), result); - result = cons3 (Qheight, make_int (height), result); - } - - result = cons3 (Qname, f->name, result); - - UNGCPRO; - return result; -} - - -DEFUN ("frame-pixel-height", Fframe_pixel_height, 0, 1, 0, /* -Return the height in pixels of FRAME. -*/ - (frame)) -{ - return make_int (decode_frame (frame)->pixheight); -} - -DEFUN ("frame-pixel-width", Fframe_pixel_width, 0, 1, 0, /* -Return the width in pixels of FRAME. -*/ - (frame)) -{ - return make_int (decode_frame (frame)->pixwidth); -} - -DEFUN ("frame-name", Fframe_name, 0, 1, 0, /* -Return the name of FRAME (defaulting to the selected frame). -This is not the same as the `title' of the frame. -*/ - (frame)) -{ - return decode_frame (frame)->name; -} - -DEFUN ("frame-modified-tick", Fframe_modified_tick, 0, 1, 0, /* -Return FRAME's tick counter, incremented for each change to the frame. -Each frame has a tick counter which is incremented each time the frame -is resized, a window is resized, added, or deleted, a face is changed, -`set-window-buffer' or `select-window' is called on a window in the -frame, the window-start of a window in the frame has changed, or -anything else interesting has happened. It wraps around occasionally. -No argument or nil as argument means use selected frame as FRAME. -*/ - (frame)) -{ - return make_int (decode_frame (frame)->modiff); -} - -static void -internal_set_frame_size (struct frame *f, int cols, int rows, int pretend) -{ - /* An explicit size change cancels any pending frame size adjustment */ - CLEAR_FRAME_SIZE_SLIPPED(f); - - if (pretend || !HAS_FRAMEMETH_P (f, set_frame_size)) - change_frame_size (f, rows, cols, 0); - else - FRAMEMETH (f, set_frame_size, (f, cols, rows)); -} - -DEFUN ("set-frame-height", Fset_frame_height, 2, 3, 0, /* -Specify that the frame FRAME has LINES lines. -Optional third arg non-nil means that redisplay should use LINES lines -but that the idea of the actual height of the frame should not be changed. -*/ - (frame, rows, pretend)) -{ - struct frame *f = decode_frame (frame); - int height, width; - XSETFRAME (frame, f); - CHECK_INT (rows); - - if (window_system_pixelated_geometry (frame)) - { - char_to_real_pixel_size (f, 0, XINT (rows), 0, &height); - width = FRAME_PIXWIDTH (f); - } - else - { - height = XINT (rows); - width = FRAME_WIDTH (f); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; -} - -DEFUN ("set-frame-width", Fset_frame_width, 2, 3, 0, /* -Specify that the frame FRAME has COLS columns. -Optional third arg non-nil means that redisplay should use COLS columns -but that the idea of the actual width of the frame should not be changed. -*/ - (frame, cols, pretend)) -{ - struct frame *f = decode_frame (frame); - int width, height; - XSETFRAME (frame, f); - CHECK_INT (cols); - - if (window_system_pixelated_geometry (frame)) - { - char_to_real_pixel_size (f, XINT (cols), 0, &width, 0); - height = FRAME_PIXHEIGHT (f); - } - else - { - width = XINT (cols); - height = FRAME_HEIGHT (f); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; -} - -DEFUN ("set-frame-size", Fset_frame_size, 3, 4, 0, /* -Set the size of FRAME to COLS by ROWS. -Optional fourth arg non-nil means that redisplay should use COLS by ROWS -but that the idea of the actual size of the frame should not be changed. -*/ - (frame, cols, rows, pretend)) -{ - struct frame *f = decode_frame (frame); - int height, width; - XSETFRAME (frame, f); - CHECK_INT (cols); - CHECK_INT (rows); - - if (window_system_pixelated_geometry (frame)) - char_to_real_pixel_size (f, XINT (cols), XINT (rows), &width, &height); - else - { - height = XINT (rows); - width = XINT (cols); - } - - internal_set_frame_size (f, width, height, !NILP (pretend)); - return frame; -} - -DEFUN ("set-frame-position", Fset_frame_position, 3, 3, 0, /* -Set position of FRAME in pixels to XOFFSET by YOFFSET. -This is actually the position of the upper left corner of the frame. -Negative values for XOFFSET or YOFFSET are interpreted relative to -the rightmost or bottommost possible position (that stays within the screen). -*/ - (frame, xoffset, yoffset)) -{ - struct frame *f = decode_frame (frame); - CHECK_INT (xoffset); - CHECK_INT (yoffset); - - MAYBE_FRAMEMETH (f, set_frame_position, (f, XINT (xoffset), XINT (yoffset))); - - return Qt; -} - - - -/* Frame size conversion functions moved here from EmacsFrame.c - because they're generic and really don't belong in that file. - Function get_default_char_pixel_size() removed because it's - exactly the same as default_face_height_and_width(). */ -static void -frame_conversion_internal (struct frame *f, int pixel_to_char, - int *pixel_width, int *pixel_height, - int *char_width, int *char_height, - int real_face) -{ - int cpw; - int cph; - int egw; - int obw, obh, bdr; - Lisp_Object frame, window; - - XSETFRAME (frame, f); - if (real_face) - default_face_height_and_width (frame, &cph, &cpw); - else - default_face_height_and_width_1 (frame, &cph, &cpw); - - window = FRAME_SELECTED_WINDOW (f); - - egw = max (glyph_width (Vcontinuation_glyph, Vdefault_face, 0, window), - glyph_width (Vtruncation_glyph, Vdefault_face, 0, window)); - egw = max (egw, cpw); - bdr = 2 * f->internal_border_width; - obw = FRAME_SCROLLBAR_WIDTH (f) + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) + - FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f) + - 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f) + - 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f); - obh = FRAME_SCROLLBAR_HEIGHT (f) + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f) + - FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f) + - 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f) + - 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f); - - if (pixel_to_char) - { - if (char_width) - *char_width = 1 + ((*pixel_width - egw) - bdr - obw) / cpw; - if (char_height) - *char_height = (*pixel_height - bdr - obh) / cph; - } - else - { - if (pixel_width) - *pixel_width = (*char_width - 1) * cpw + egw + bdr + obw; - if (pixel_height) - *pixel_height = *char_height * cph + bdr + obh; - } -} - -/* This takes the size in pixels of the text area, and returns the number - of characters that will fit there, taking into account the internal - border width, and the pixel width of the line terminator glyphs (which - always count as one "character" wide, even if they are not the same size - as the default character size of the default font). The frame scrollbar - width and left and right toolbar widths are also subtracted out of the - available width. The frame scrollbar height and top and bottom toolbar - heights are subtracted out of the available height. - - Therefore the result is not necessarily a multiple of anything in - particular. */ -void -pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height) -{ - frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width, - char_height, 0); -} - -/* Given a character size, this returns the minimum number of pixels - necessary to display that many characters, taking into account the - internal border width, scrollbar height and width, toolbar heights and - widths and the size of the line terminator glyphs (assuming the line - terminators take up exactly one character position). - - Therefore the result is not necessarily a multiple of anything in - particular. */ -void -char_to_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height) -{ - frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width, - &char_height, 0); -} - -/* Given a pixel size, rounds DOWN to the smallest size in pixels necessary - to display the same number of characters as are displayable now. - */ -void -round_size_to_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height) -{ - int char_width; - int char_height; - pixel_to_char_size (f, in_width, in_height, &char_width, &char_height); - char_to_pixel_size (f, char_width, char_height, out_width, out_height); -} - -/* Versions of the above which always account for real font metrics. - */ -void -pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height) -{ - frame_conversion_internal (f, 1, &pixel_width, &pixel_height, char_width, - char_height, 1); -} - -void -char_to_real_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height) -{ - frame_conversion_internal (f, 0, pixel_width, pixel_height, &char_width, - &char_height, 1); -} - -void -round_size_to_real_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height) -{ - int char_width; - int char_height; - pixel_to_real_char_size (f, in_width, in_height, &char_width, &char_height); - char_to_real_pixel_size (f, char_width, char_height, out_width, out_height); -} - -/* Change the frame height and/or width. Values may be given as zero to - indicate no change is to take place. */ -static void -change_frame_size_1 (struct frame *f, int newheight, int newwidth) -{ - Lisp_Object frame; - int new_pixheight, new_pixwidth; - int font_height, real_font_height, font_width; - - /* #### Chuck -- shouldn't we be checking to see if the frame - is being "changed" to its existing size, and do nothing if so? */ - /* No, because it would hose toolbar updates. The toolbar - update code relies on this function to cause window `top' and - `left' coordinates to be recomputed even though no frame size - change occurs. --kyle */ - if (in_display) - abort (); - - XSETFRAME (frame, f); - - default_face_height_and_width (frame, &real_font_height, 0); - default_face_height_and_width_1 (frame, &font_height, &font_width); - - /* This size-change overrides any pending one for this frame. */ - FRAME_NEW_HEIGHT (f) = 0; - FRAME_NEW_WIDTH (f) = 0; - - new_pixheight = newheight * font_height; - new_pixwidth = (newwidth - 1) * font_width; - - /* #### dependency on FRAME_WIN_P should be removed. */ - if (FRAME_WIN_P (f)) - { - new_pixheight += FRAME_SCROLLBAR_HEIGHT (f); - new_pixwidth += FRAME_SCROLLBAR_WIDTH (f); - } - - /* when frame_conversion_internal() calculated the number of rows/cols - in the frame, the theoretical toolbar sizes were subtracted out. - The calculations below adjust for real toolbar height/width in - frame, which may be different from frame spec, taking the above - fact into account */ - new_pixheight += - + FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT (f) - + 2 * FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f); - - new_pixheight += - + FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT (f) - + 2 * FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f); - - new_pixwidth += - + FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH (f) - + 2 * FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f); - - new_pixwidth += - + FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH (f) - + 2 * FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH (f) - - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f); - - /* Adjust the width for the end glyph which may be a different width - than the default character width. */ - { - int adjustment, trunc_width, cont_width; - - trunc_width = glyph_width (Vtruncation_glyph, Vdefault_face, 0, - FRAME_SELECTED_WINDOW (f)); - cont_width = glyph_width (Vcontinuation_glyph, Vdefault_face, 0, - FRAME_SELECTED_WINDOW (f)); - adjustment = max (trunc_width, cont_width); - adjustment = max (adjustment, font_width); - - new_pixwidth += adjustment; - } - - /* If we don't have valid values, exit. */ - if (!new_pixheight && !new_pixwidth) - return; - - if (new_pixheight) - { - XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_top = FRAME_TOP_BORDER_END (f); - - if (FRAME_HAS_MINIBUF_P (f) - && ! FRAME_MINIBUF_ONLY_P (f)) - /* Frame has both root and minibuffer. */ - { - /* - * Leave the minibuffer height the same if the frame has - * been initialized, and the minibuffer height is tall - * enough to display at least one line of text in the default - * font, and the old minibuffer height is a multiple of the - * default font height. This should cause the minibuffer - * height to be recomputed on font changes but not for - * other frame size changes, which seems reasonable. - */ - int old_minibuf_height = - XWINDOW(FRAME_MINIBUF_WINDOW(f))->pixel_height; - int minibuf_height = - f->init_finished && (old_minibuf_height % real_font_height) == 0 ? - max(old_minibuf_height, real_font_height) : - real_font_height; - set_window_pixheight (FRAME_ROOT_WINDOW (f), - /* - font_height for minibuffer */ - new_pixheight - minibuf_height, 0); - - XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_top = - new_pixheight - minibuf_height + FRAME_TOP_BORDER_END (f); - - set_window_pixheight (FRAME_MINIBUF_WINDOW (f), minibuf_height, 0); - } - else - /* Frame has just one top-level window. */ - set_window_pixheight (FRAME_ROOT_WINDOW (f), new_pixheight, 0); - - FRAME_HEIGHT (f) = newheight; - if (FRAME_TTY_P (f)) - f->pixheight = newheight; - } - - if (new_pixwidth) - { - XWINDOW (FRAME_ROOT_WINDOW (f))->pixel_left = FRAME_LEFT_BORDER_END (f); - set_window_pixwidth (FRAME_ROOT_WINDOW (f), new_pixwidth, 0); - - if (FRAME_HAS_MINIBUF_P (f)) - { - XWINDOW (FRAME_MINIBUF_WINDOW (f))->pixel_left = - FRAME_LEFT_BORDER_END (f); - set_window_pixwidth (FRAME_MINIBUF_WINDOW (f), new_pixwidth, 0); - } - - FRAME_WIDTH (f) = newwidth; - if (FRAME_TTY_P (f)) - f->pixwidth = newwidth; - } - - if (window_system_pixelated_geometry (frame)) - pixel_to_real_char_size (f, FRAME_PIXWIDTH (f), FRAME_PIXHEIGHT (f), - &FRAME_CHARWIDTH (f), &FRAME_CHARHEIGHT (f)); - else - { - FRAME_CHARWIDTH (f) = FRAME_WIDTH (f); - FRAME_CHARHEIGHT (f) = FRAME_HEIGHT (f); - } - - MARK_FRAME_TOOLBARS_CHANGED (f); - MARK_FRAME_CHANGED (f); - f->echo_area_garbaged = 1; -} - -void -change_frame_size (struct frame *f, int newheight, int newwidth, int delay) -{ - /* sometimes we get passed a size that's too small (esp. when a - client widget gets resized, since we have no control over this). - So deal. */ - check_frame_size (f, &newheight, &newwidth); - - if (delay || in_display || gc_in_progress) - { - MARK_FRAME_SIZE_CHANGED (f); - f->new_width = newwidth; - f->new_height = newheight; - return; - } - - f->size_change_pending = 0; - /* For TTY frames, it's like one, like all ... - Can't have two TTY frames of different sizes on the same device. */ - if (FRAME_TTY_P (f)) - { - Lisp_Object frmcons; - - DEVICE_FRAME_LOOP (frmcons, XDEVICE (FRAME_DEVICE (f))) - change_frame_size_1 (XFRAME (XCAR (frmcons)), newheight, newwidth); - } - else - change_frame_size_1 (f, newheight, newwidth); -} - - -void -update_frame_title (struct frame *f) -{ - struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f)); - Lisp_Object title_format; - Lisp_Object icon_format; - Bufbyte *title; - - /* We don't change the title for the minibuffer unless the frame - only has a minibuffer. */ - if (MINI_WINDOW_P (w) && !FRAME_MINIBUF_ONLY_P (f)) - return; - - /* And we don't want dead buffers to blow up on us. */ - if (!BUFFER_LIVE_P (XBUFFER (w->buffer))) - return; - - title = NULL; - title_format = symbol_value_in_buffer (Qframe_title_format, w->buffer); - icon_format = symbol_value_in_buffer (Qframe_icon_title_format, w->buffer); - - if (HAS_FRAMEMETH_P (f, set_title_from_bufbyte)) - { - title = generate_formatted_string (w, title_format, Qnil, - DEFAULT_INDEX, CURRENT_DISP); - FRAMEMETH (f, set_title_from_bufbyte, (f, title)); - } - - if (HAS_FRAMEMETH_P (f, set_icon_name_from_bufbyte)) - { - if (!EQ (icon_format, title_format) || !title) - { - if (title) - xfree (title); - - title = generate_formatted_string (w, icon_format, Qnil, - DEFAULT_INDEX, CURRENT_DISP); - } - FRAMEMETH (f, set_icon_name_from_bufbyte, (f, title)); - } - - if (title) - xfree (title); -} - - -DEFUN ("set-frame-pointer", Fset_frame_pointer, 2, 2, 0, /* -Set the mouse pointer of FRAME to the given pointer image instance. -You should not call this function directly. Instead, set one of -the variables `text-pointer-glyph', `nontext-pointer-glyph', -`modeline-pointer-glyph', `selection-pointer-glyph', -`busy-pointer-glyph', or `toolbar-pointer-glyph'. -*/ - (frame, image_instance)) -{ - struct frame *f = decode_frame (frame); - CHECK_POINTER_IMAGE_INSTANCE (image_instance); - if (!EQ (f->pointer, image_instance)) - { - f->pointer = image_instance; - MAYBE_FRAMEMETH (f, set_frame_pointer, (f)); - } - return Qnil; -} - - -void -update_frame_icon (struct frame *f) -{ - if (f->icon_changed || f->windows_changed) - { - Lisp_Object frame; - Lisp_Object new_icon; - - XSETFRAME (frame, f); - new_icon = glyph_image_instance (Vframe_icon_glyph, frame, - ERROR_ME_WARN, 0); - if (!EQ (new_icon, f->icon)) - { - f->icon = new_icon; - MAYBE_FRAMEMETH (f, set_frame_icon, (f)); - } - } - - f->icon_changed = 0; -} - -static void -icon_glyph_changed (Lisp_Object glyph, Lisp_Object property, - Lisp_Object locale) -{ - MARK_ICON_CHANGED; -} - - -void -syms_of_frame (void) -{ - defsymbol (&Qdelete_frame_hook, "delete-frame-hook"); - defsymbol (&Qselect_frame_hook, "select-frame-hook"); - defsymbol (&Qdeselect_frame_hook, "deselect-frame-hook"); - defsymbol (&Qcreate_frame_hook, "create-frame-hook"); - defsymbol (&Qcustom_initialize_frame, "custom-initialize-frame"); - defsymbol (&Qmouse_enter_frame_hook, "mouse-enter-frame-hook"); - defsymbol (&Qmouse_leave_frame_hook, "mouse-leave-frame-hook"); - defsymbol (&Qmap_frame_hook, "map-frame-hook"); - defsymbol (&Qunmap_frame_hook, "unmap-frame-hook"); - - defsymbol (&Qframep, "framep"); - defsymbol (&Qframe_live_p, "frame-live-p"); - defsymbol (&Qframe_x_p, "frame-x-p"); - defsymbol (&Qframe_tty_p, "frame-tty-p"); - defsymbol (&Qdelete_frame, "delete-frame"); - defsymbol (&Qsynchronize_minibuffers, "synchronize-minibuffers"); - defsymbol (&Qbuffer_predicate, "buffer-predicate"); - defsymbol (&Qframe_being_created, "frame-being-created"); - defsymbol (&Qmake_initial_minibuffer_frame, "make-initial-minibuffer-frame"); - - defsymbol (&Qframe_title_format, "frame-title-format"); - defsymbol (&Qframe_icon_title_format, "frame-icon-title-format"); - - defsymbol (&Qhidden, "hidden"); - defsymbol (&Qvisible, "visible"); - defsymbol (&Qiconic, "iconic"); - defsymbol (&Qinvisible, "invisible"); - defsymbol (&Qvisible_iconic, "visible-iconic"); - defsymbol (&Qinvisible_iconic, "invisible-iconic"); - defsymbol (&Qnomini, "nomini"); - defsymbol (&Qvisible_nomini, "visible-nomini"); - defsymbol (&Qiconic_nomini, "iconic-nomini"); - defsymbol (&Qinvisible_nomini, "invisible-nomini"); - defsymbol (&Qvisible_iconic_nomini, "visible-iconic-nomini"); - defsymbol (&Qinvisible_iconic_nomini, "invisible-iconic-nomini"); - - defsymbol (&Qminibuffer, "minibuffer"); - defsymbol (&Qunsplittable, "unsplittable"); - defsymbol (&Qinternal_border_width, "internal-border-width"); - defsymbol (&Qtop_toolbar_shadow_color, "top-toolbar-shadow-color"); - defsymbol (&Qbottom_toolbar_shadow_color, "bottom-toolbar-shadow-color"); - defsymbol (&Qbackground_toolbar_color, "background-toolbar-color"); - defsymbol (&Qtop_toolbar_shadow_pixmap, "top-toolbar-shadow-pixmap"); - defsymbol (&Qbottom_toolbar_shadow_pixmap, "bottom-toolbar-shadow-pixmap"); - defsymbol (&Qtoolbar_shadow_thickness, "toolbar-shadow-thickness"); - defsymbol (&Qscrollbar_placement, "scrollbar-placement"); - defsymbol (&Qinter_line_space, "inter-line-space"); - /* Qiconic already in this function. */ - defsymbol (&Qvisual_bell, "visual-bell"); - defsymbol (&Qbell_volume, "bell-volume"); - defsymbol (&Qpointer_background, "pointer-background"); - defsymbol (&Qpointer_color, "pointer-color"); - defsymbol (&Qtext_pointer, "text-pointer"); - defsymbol (&Qspace_pointer, "space-pointer"); - defsymbol (&Qmodeline_pointer, "modeline-pointer"); - defsymbol (&Qgc_pointer, "gc-pointer"); - defsymbol (&Qinitially_unmapped, "initially-unmapped"); - defsymbol (&Quse_backing_store, "use-backing-store"); - defsymbol (&Qborder_color, "border-color"); - defsymbol (&Qborder_width, "border-width"); - /* Qwidth, Qheight, Qleft, Qtop in general.c */ - defsymbol (&Qset_specifier, "set-specifier"); - defsymbol (&Qset_glyph_image, "set-glyph-image"); - defsymbol (&Qset_face_property, "set-face-property"); - defsymbol (&Qface_property_instance, "face-property-instance"); - defsymbol (&Qframe_property_alias, "frame-property-alias"); - - DEFSUBR (Fmake_frame); - DEFSUBR (Fframep); - DEFSUBR (Fframe_live_p); -#if 0 /* FSFmacs */ - DEFSUBR (Fignore_event); -#endif - DEFSUBR (Ffocus_frame); - DEFSUBR (Fselect_frame); - DEFSUBR (Fselected_frame); - DEFSUBR (Factive_minibuffer_window); - DEFSUBR (Flast_nonminibuf_frame); - DEFSUBR (Fframe_root_window); - DEFSUBR (Fframe_selected_window); - DEFSUBR (Fset_frame_selected_window); - DEFSUBR (Fframe_device); - DEFSUBR (Fnext_frame); - DEFSUBR (Fprevious_frame); - DEFSUBR (Fdelete_frame); - DEFSUBR (Fmouse_position); - DEFSUBR (Fmouse_pixel_position); - DEFSUBR (Fmouse_position_as_motion_event); - DEFSUBR (Fset_mouse_position); - DEFSUBR (Fset_mouse_pixel_position); - DEFSUBR (Fmake_frame_visible); - DEFSUBR (Fmake_frame_invisible); - DEFSUBR (Ficonify_frame); - DEFSUBR (Fdeiconify_frame); - DEFSUBR (Fframe_visible_p); - DEFSUBR (Fframe_totally_visible_p); - DEFSUBR (Fframe_iconified_p); - DEFSUBR (Fvisible_frame_list); - DEFSUBR (Fraise_frame); - DEFSUBR (Flower_frame); - DEFSUBR (Fframe_property); - DEFSUBR (Fframe_properties); - DEFSUBR (Fset_frame_properties); - DEFSUBR (Fframe_pixel_height); - DEFSUBR (Fframe_pixel_width); - DEFSUBR (Fframe_name); - DEFSUBR (Fframe_modified_tick); - DEFSUBR (Fset_frame_height); - DEFSUBR (Fset_frame_width); - DEFSUBR (Fset_frame_size); - DEFSUBR (Fset_frame_position); - DEFSUBR (Fset_frame_pointer); -} - -void -vars_of_frame (void) -{ - /* */ - Vframe_being_created = Qnil; - staticpro (&Vframe_being_created); - -#ifdef HAVE_CDE - Fprovide (intern ("cde")); -#endif - -#ifdef HAVE_OFFIX_DND - Fprovide (intern ("offix")); -#endif - -#if 0 /* FSFmacs stupidity */ - xxDEFVAR_LISP ("emacs-iconified", &Vemacs_iconified /* -Non-nil if all of emacs is iconified and frame updates are not needed. -*/ ); - Vemacs_iconified = Qnil; -#endif - - DEFVAR_LISP ("select-frame-hook", &Vselect_frame_hook /* -Function or functions to run just after a new frame is given the focus. -Note that calling `select-frame' does not necessarily set the focus: -The actual window-system focus will not be changed until the next time -that XEmacs is waiting for an event, and even then, the window manager -may refuse the focus-change request. -*/ ); - Vselect_frame_hook = Qnil; - - DEFVAR_LISP ("deselect-frame-hook", &Vdeselect_frame_hook /* -Function or functions to run just before a frame loses the focus. -See `select-frame-hook'. -*/ ); - Vdeselect_frame_hook = Qnil; - - DEFVAR_LISP ("delete-frame-hook", &Vdelete_frame_hook /* -Function or functions to call when a frame is deleted. -One argument, the about-to-be-deleted frame. -*/ ); - Vdelete_frame_hook = Qnil; - - DEFVAR_LISP ("create-frame-hook", &Vcreate_frame_hook /* -Function or functions to call when a frame is created. -One argument, the newly-created frame. -*/ ); - Vcreate_frame_hook = Qnil; - - DEFVAR_LISP ("mouse-enter-frame-hook", &Vmouse_enter_frame_hook /* -Function or functions to call when the mouse enters a frame. -One argument, the frame. -Be careful not to make assumptions about the window manager's focus model. -In most cases, the `deselect-frame-hook' is more appropriate. -*/ ); - Vmouse_enter_frame_hook = Qnil; - - DEFVAR_LISP ("mouse-leave-frame-hook", &Vmouse_leave_frame_hook /* -Function or functions to call when the mouse leaves a frame. -One argument, the frame. -Be careful not to make assumptions about the window manager's focus model. -In most cases, the `select-frame-hook' is more appropriate. -*/ ); - Vmouse_leave_frame_hook = Qnil; - - DEFVAR_LISP ("map-frame-hook", &Vmap_frame_hook /* -Function or functions to call when a frame is mapped. -One argument, the frame. -*/ ); - Vmap_frame_hook = Qnil; - - DEFVAR_LISP ("unmap-frame-hook", &Vunmap_frame_hook /* -Function or functions to call when a frame is unmapped. -One argument, the frame. -*/ ); - Vunmap_frame_hook = Qnil; - - DEFVAR_BOOL ("allow-deletion-of-last-visible-frame", - &allow_deletion_of_last_visible_frame /* -*Non-nil means to assume the force option to delete-frame. -*/ ); - allow_deletion_of_last_visible_frame = 0; - - DEFVAR_LISP ("adjust-frame-function", &Vadjust_frame_function /* -Function or constant controlling adjustment of frame. -When scrollbars, toolbars, default font etc. change in frame, the frame -needs to be adjusted. The adjustment is controlled by this variable. -Legal values are: - nil to keep character frame size unchanged when possible (resize) - t to keep pixel size unchanged (never resize) - function symbol or lambda form. This function must return boolean - value which is treated as above. Function is passed one parameter, - the frame being adjusted. It function should not modify or delete - the frame. -*/ ); - Vadjust_frame_function = Qnil; - - DEFVAR_LISP ("mouse-motion-handler", &Vmouse_motion_handler /* -Handler for motion events. One arg, the event. -For most applications, you should use `mode-motion-hook' instead of this. -*/ ); - Vmouse_motion_handler = Qnil; - - DEFVAR_LISP ("synchronize-minibuffers",&Vsynchronize_minibuffers /* -Set to t if all minibuffer windows are to be synchronized. -This will cause echo area messages to appear in the minibuffers of all -visible frames. -*/ ); - Vsynchronize_minibuffers = Qnil; - - DEFVAR_LISP ("frame-title-format", &Vframe_title_format /* -Controls the title of the X window corresponding to the selected frame. -This is the same format as `modeline-format' with the exception that -%- is ignored. -*/ ); - Vframe_title_format = Fpurecopy (build_string ("%S: %b")); - - DEFVAR_LISP ("frame-icon-title-format", &Vframe_icon_title_format /* -Controls the title of the icon corresponding to the selected frame. -See also the variable `frame-title-format'. -*/ ); - Vframe_icon_title_format = Fpurecopy (build_string ("%b")); - - DEFVAR_LISP ("default-frame-name", &Vdefault_frame_name /* -The default name to assign to newly-created frames. -This can be overridden by arguments to `make-frame'. -This must be a string. -*/ ); -#ifndef INFODOCK - Vdefault_frame_name = Fpurecopy (build_string ("emacs")); -#else - Vdefault_frame_name = Fpurecopy (build_string ("InfoDock")); -#endif - - DEFVAR_LISP ("default-frame-plist", &Vdefault_frame_plist /* -Plist of default values for frame creation, other than the first one. -These may be set in your init file, like this: - - \(setq default-frame-plist '(width 80 height 55)) - -The properties may be in alist format for backward compatibility -but you should not rely on this behavior. - -These override values given in window system configuration data, - including X Windows' defaults database. - -Since the first X frame is created before loading your .emacs file, -you must use the X resource database for that. - -For values specific to the first Emacs frame, see `initial-frame-plist'. -For values specific to the separate minibuffer frame, see - `minibuffer-frame-plist'. - -See also the variables `default-x-frame-plist' and -`default-tty-frame-plist', which are like `default-frame-plist' -except that they apply only to X or tty frames, respectively -\(whereas `default-frame-plist' applies to all types of frames). -*/ ); - Vdefault_frame_plist = Qnil; - - DEFVAR_LISP ("frame-icon-glyph", &Vframe_icon_glyph /* -Icon glyph used to iconify a frame. -*/ ); -} - -void -complex_vars_of_frame (void) -{ - Vframe_icon_glyph = allocate_glyph (GLYPH_ICON, icon_glyph_changed); -} diff --git a/src/frame.h b/src/frame.h deleted file mode 100644 index ff5b332..0000000 --- a/src/frame.h +++ /dev/null @@ -1,740 +0,0 @@ -/* Define frame-object for XEmacs. - Copyright (C) 1988, 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: FSF 19.30. */ - -#ifndef _XEMACS_FRAME_H_ -#define _XEMACS_FRAME_H_ - -#ifdef HAVE_SCROLLBARS -#include "scrollbar.h" -#endif - -#ifdef HAVE_TOOLBARS -#include "toolbar.h" -#endif - -#include "device.h" -#include "glyphs.h" - -#define FRAME_TYPE_NAME(f) ((f)->framemeths->name) -#define FRAME_TYPE(f) ((f)->framemeths->symbol) - -/******** Accessing / calling a frame method *********/ - -#define HAS_FRAMEMETH_P(f, m) HAS_CONTYPE_METH_P ((f)->framemeths, m) -#define FRAMEMETH(f, m, args) CONTYPE_METH ((f)->framemeths, m, args) -#define MAYBE_FRAMEMETH(f, m, args) \ - MAYBE_CONTYPE_METH ((f)->framemeths, m, args) -#define FRAMEMETH_OR_GIVEN(f, m, args, given) \ - CONTYPE_METH_OR_GIVEN((f)->framemeths, m, args, given) - -struct frame -{ - struct lcrecord_header header; - - /* Methods for this frame's console. This can also be retrieved - through frame->device->console, but it's faster this way. */ - struct console_methods *framemeths; - - /* Size of text only area of this frame, excluding scrollbars, - toolbars and end of line glyphs. The size can be in characters - or pixels, depending on units in which window system resizes - its windows */ - int height, width; - - /* New height and width for pending size change, in the same units - as above. 0 if no change pending. */ - int new_height, new_width; - - /* Size of text-only are of the frame, in default font characters. - This may be inaccurate due to rounding error */ - int char_height, char_width; - - /* Size of the whole frame, including scrollbars, toolbars and end - of line glyphs, in pixels */ - int pixheight, pixwidth; - -#ifdef HAVE_TTY - /* The count of frame number. This applies to TTY frames only. */ - int order_count; -#endif - - /* Width of the internal border. This is a line of background color - just inside the window's border. It is normally only non-zero on - X frames, but we put it here to avoid introducing window system - dependencies. */ - int internal_border_width; - - /* This frame's root window mirror. This structure exactly mirrors - the frame's window structure but contains only pointers to the - display structures. */ - struct window_mirror *root_mirror; - - int modiff; - - /* subwindow cache elements for this frame */ - subwindow_cachel_dynarr *subwindow_cachels; - -#ifdef HAVE_SCROLLBARS - /* frame-local scrollbar information. See scrollbar.c. */ - int scrollbar_y_offset; - - /* cache of created scrollbars */ - struct scrollbar_instance *sb_vcache; - struct scrollbar_instance *sb_hcache; -#endif - -#ifdef HAVE_TOOLBARS - /* Size of toolbars as seen by redisplay. This is used to determine - whether to re-layout windows by a call to change_frame_size early - in redisplay_frame. */ - unsigned int current_toolbar_size[4]; -#endif - - /* A structure of auxiliary data specific to the device type. - struct x_frame is used for X window frames; defined in console-x.h */ - void *frame_data; - -#define FRAME_SLOT_DECLARATION -#define MARKED_SLOT(x) Lisp_Object x -#include "frameslots.h" - - /* Nonzero if frame is currently displayed. - Mutually exclusive with iconified - JV: This now a tristate flag: -Value : Emacs meaning :f-v-p : X meaning -0 : not displayed : nil : unmapped ->0 : user can access it,needs repainting : t : mapped and visible -<0 : user can access it,needs no repainting : hidden :mapped and invisible - where f-v-p is the return value of frame-visible-p */ - int visible; - - /* one-bit flags: */ - - /* Are we finished initializing? */ - unsigned int init_finished :1; - - /* Is frame marked for deletion? This is used in XSetErrorHandler(). */ - unsigned int being_deleted :1; - - /* Nonzero if this frame has been destroyed. */ - unsigned int dead :1; - - /* Nonzero if last attempt at redisplay on this frame was preempted. */ - unsigned int display_preempted :1; - - /* Nonzero if window is currently iconified. - This and visible are mutually exclusive. */ - unsigned int iconified :1; - - /* Nonzero if this frame should be cleared and then redrawn. - Setting this will also effectively set frame_changed. */ - unsigned int clear :1; - - /* True if frame actually has a minibuffer window on it. - 0 if using a minibuffer window that isn't on this frame. */ - unsigned int has_minibuffer :1; - - /* True if frame's root window can't be split. */ - unsigned int no_split :1; - - unsigned int top_toolbar_was_visible :1; - unsigned int bottom_toolbar_was_visible :1; - unsigned int left_toolbar_was_visible :1; - unsigned int right_toolbar_was_visible :1; - - /* redisplay flags */ - unsigned int buffers_changed :1; - unsigned int clip_changed :1; - unsigned int extents_changed :1; - unsigned int faces_changed :1; - unsigned int frame_changed :1; - unsigned int subwindows_changed :1; - unsigned int glyphs_changed :1; - unsigned int icon_changed :1; - unsigned int menubar_changed :1; - unsigned int modeline_changed :1; - unsigned int point_changed :1; - unsigned int size_changed :1; - unsigned int toolbar_changed :1; - unsigned int windows_changed :1; - unsigned int windows_structure_changed :1; - unsigned int window_face_cache_reset :1; /* used by expose handler */ - unsigned int echo_area_garbaged :1; /* used by Fredisplay_echo_area */ - unsigned int size_slipped :1; - - unsigned int size_change_pending :1; - unsigned int mirror_dirty :1; - - /* flag indicating if any window on this frame is displaying a subwindow */ - unsigned int subwindows_being_displayed :1; -}; - -EXFUN (Fdelete_frame, 2); -EXFUN (Fframe_iconified_p, 1); -EXFUN (Fframe_name, 1); -EXFUN (Fframe_property, 3); -EXFUN (Fmake_frame, 2); -EXFUN (Fmake_frame_visible, 1); -EXFUN (Fraise_frame, 1); -EXFUN (Fselect_frame, 1); -EXFUN (Fset_frame_pointer, 2); -EXFUN (Fset_frame_position, 3); -EXFUN (Fset_frame_size, 4); - -extern Lisp_Object Qbackground_toolbar_color, Qbell_volume, Qborder_color; -extern Lisp_Object Qborder_width, Qbottom_toolbar_shadow_color; -extern Lisp_Object Qbottom_toolbar_shadow_pixmap, Qdelete_frame; -extern Lisp_Object Qdeselect_frame_hook, Qdrag_and_drop_functions, Qgc_pointer; -extern Lisp_Object Qiconic, Qinitially_unmapped, Qinter_line_space; -extern Lisp_Object Qinternal_border_width, Qinvisible, Qmap_frame_hook; -extern Lisp_Object Qminibuffer, Qmodeline_pointer, Qmouse_enter_frame_hook; -extern Lisp_Object Qmouse_leave_frame_hook, Qpointer_background; -extern Lisp_Object Qpointer_color, Qpopup, Qscrollbar_placement; -extern Lisp_Object Qselect_frame_hook, Qspace_pointer; -extern Lisp_Object Qsynchronize_minibuffers, Qtext_pointer; -extern Lisp_Object Qtoolbar_shadow_thickness, Qtop_toolbar_shadow_color; -extern Lisp_Object Qtop_toolbar_shadow_pixmap, Qunmap_frame_hook; -extern Lisp_Object Qunsplittable, Quse_backing_store, Qvisible, Qvisual_bell; -extern Lisp_Object Vframe_icon_title_format, Vframe_title_format; -extern Lisp_Object Vmouse_motion_handler; - - -DECLARE_LRECORD (frame, struct frame); -#define XFRAME(x) XRECORD (x, frame, struct frame) -#define XSETFRAME(x, p) XSETRECORD (x, p, frame) -#define FRAMEP(x) RECORDP (x, frame) -#define GC_FRAMEP(x) GC_RECORDP (x, frame) -#define CHECK_FRAME(x) CHECK_RECORD (x, frame) -#define CONCHECK_FRAME(x) CONCHECK_RECORD (x, frame) - -#define CHECK_LIVE_FRAME(x) do { \ - CHECK_FRAME (x); \ - if (! FRAME_LIVE_P (XFRAME (x))) \ - dead_wrong_type_argument (Qframe_live_p, (x)); \ -} while (0) -#define CONCHECK_LIVE_FRAME(x) do { \ - CONCHECK_FRAME (x); \ - if (! FRAME_LIVE_P (XFRAME (x))) \ - x = wrong_type_argument (Qframe_live_p, (x)); \ -} while (0) - -#define FRAME_TYPE_P(f, type) EQ (FRAME_TYPE (f), Q##type) - -#ifdef ERROR_CHECK_TYPECHECK -INLINE struct frame * -error_check_frame_type (struct frame * f, Lisp_Object sym); -INLINE struct frame * -error_check_frame_type (struct frame * f, Lisp_Object sym) -{ - assert (EQ (FRAME_TYPE (f), sym)); - return f; -} -# define FRAME_TYPE_DATA(f, type) \ - ((struct type##_frame *) (error_check_frame_type (f, Q##type))->frame_data) -#else -# define FRAME_TYPE_DATA(f, type) \ - ((struct type##_frame *) (f)->frame_data) -#endif - -#define CHECK_FRAME_TYPE(x, type) \ - do { \ - CHECK_FRAME (x); \ - if (!FRAME_TYPE_P (XFRAME (x), type)) \ - dead_wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ - } while (0) -#define CONCHECK_FRAME_TYPE(x, type) \ - do { \ - CONCHECK_FRAME (x); \ - if (!FRAME_TYPE_P (XFRAME (x), type)) \ - x = wrong_type_argument \ - (type##_console_methods->predicate_symbol, x); \ - } while (0) - -/* #### These should be in the frame-*.h files but there are - too many places where the abstraction is broken. Need to - fix. */ - -#define FRAME_X_P(frm) CONSOLE_TYPESYM_X_P (FRAME_TYPE (frm)) -#define CHECK_X_FRAME(z) CHECK_FRAME_TYPE (z, x) -#define CONCHECK_X_FRAME(z) CONCHECK_FRAME_TYPE (z, x) - -#define FRAME_TTY_P(frm) CONSOLE_TYPESYM_TTY_P (FRAME_TYPE (frm)) -#define CHECK_TTY_FRAME(z) CHECK_FRAME_TYPE (z, tty) -#define CONCHECK_TTY_FRAME(z) CONCHECK_FRAME_TYPE (z, tty) - -#define FRAME_STREAM_P(frm) CONSOLE_TYPESYM_STREAM_P (FRAME_TYPE (frm)) -#define CHECK_STREAM_FRAME(z) CHECK_FRAME_TYPE (z, stream) -#define CONCHECK_STREAM_FRAME(z) CONCHECK_FRAME_TYPE (z, stream) - -#define FRAME_WIN_P(frm) CONSOLE_TYPESYM_WIN_P (FRAME_TYPE (frm)) - -extern int frame_changed; - -#define MARK_FRAME_FACES_CHANGED(f) do { \ - struct frame *mffc_f = (f); \ - mffc_f->faces_changed = 1; \ - mffc_f->modiff++; \ - if (!NILP (mffc_f->device)) \ - { \ - struct device *mffc_d = XDEVICE (mffc_f->device); \ - MARK_DEVICE_FACES_CHANGED (mffc_d); \ - } \ - else \ - faces_changed = 1; \ -} while (0) - -#define MARK_FRAME_GLYPHS_CHANGED(f) do { \ - struct frame *mfgc_f = (f); \ - mfgc_f->glyphs_changed = 1; \ - mfgc_f->modiff++; \ - if (!NILP (mfgc_f->device)) \ - { \ - struct device *mfgc_d = XDEVICE (mfgc_f->device); \ - MARK_DEVICE_GLYPHS_CHANGED (mfgc_d); \ - } \ - else \ - glyphs_changed = 1; \ -} while (0) - -#define MARK_FRAME_SUBWINDOWS_CHANGED(f) do { \ - struct frame *mfgc_f = (f); \ - mfgc_f->subwindows_changed = 1; \ - mfgc_f->modiff++; \ - if (!NILP (mfgc_f->device)) \ - { \ - struct device *mfgc_d = XDEVICE (mfgc_f->device); \ - MARK_DEVICE_SUBWINDOWS_CHANGED (mfgc_d); \ - } \ - else \ - subwindows_changed = 1; \ -} while (0) - -#define MARK_FRAME_TOOLBARS_CHANGED(f) do { \ - struct frame *mftc_f = (f); \ - mftc_f->toolbar_changed = 1; \ - mftc_f->modiff++; \ - if (!NILP (mftc_f->device)) \ - { \ - struct device *mftc_d = XDEVICE (mftc_f->device); \ - MARK_DEVICE_TOOLBARS_CHANGED (mftc_d); \ - } \ - else \ - toolbar_changed = 1; \ -} while (0) - -#define MARK_FRAME_SIZE_CHANGED(f) do { \ - struct frame *mfsc_f = (f); \ - mfsc_f->size_changed = 1; \ - mfsc_f->size_change_pending = 1; \ - mfsc_f->modiff++; \ - if (!NILP (mfsc_f->device)) \ - { \ - struct device *mfsc_d = XDEVICE (mfsc_f->device); \ - MARK_DEVICE_SIZE_CHANGED (mfsc_d); \ - } \ - else \ - size_changed = 1; \ -} while (0) - -#define MARK_FRAME_CHANGED(f) do { \ - struct frame *mfc_f = (f); \ - mfc_f->frame_changed = 1; \ - mfc_f->modiff++; \ - if (!NILP (mfc_f->device)) \ - { \ - struct device *mfc_d = XDEVICE (mfc_f->device); \ - MARK_DEVICE_FRAME_CHANGED (mfc_d); \ - } \ - else \ - frame_changed = 1; \ -} while (0) - -#define MARK_FRAME_WINDOWS_CHANGED(f) do { \ - struct frame *mfwc_f = (f); \ - mfwc_f->windows_changed = 1; \ - mfwc_f->modiff++; \ - if (!NILP (mfwc_f->device)) \ - { \ - struct device *mfwc_d = XDEVICE (mfwc_f->device); \ - MARK_DEVICE_WINDOWS_CHANGED (mfwc_d); \ - } \ - else \ - windows_changed = 1; \ -} while (0) - -#define MARK_FRAME_WINDOWS_STRUCTURE_CHANGED(f) do { \ - struct frame *fwsc_f = (f); \ - fwsc_f->windows_structure_changed = 1; \ - fwsc_f->modiff++; \ - if (!NILP (fwsc_f->device)) \ - { \ - struct device *fwsc_d = XDEVICE (fwsc_f->device); \ - MARK_DEVICE_WINDOWS_STRUCTURE_CHANGED (fwsc_d); \ - } \ - else \ - windows_structure_changed = 1; \ - invalidate_vertical_divider_cache_in_frame (fwsc_f); \ -} while (0) - -#define MARK_FRAME_SIZE_SLIPPED(f) do { \ - struct frame *fwsc_f = (f); \ - fwsc_f->size_slipped = 1; \ - fwsc_f->modiff++; \ - if (!NILP (fwsc_f->device)) \ - { \ - struct device *fwsc_d = XDEVICE (fwsc_f->device); \ - MARK_DEVICE_FRAME_CHANGED (fwsc_d); \ - } \ - else \ - frame_changed = 1; \ -} while (0) - -#define CLEAR_FRAME_SIZE_SLIPPED(f) do { \ - struct frame *fwsc_f = (f); \ - fwsc_f->size_slipped = 0; \ -} while (0) - -#define SET_FRAME_CLEAR(f) MARK_FRAME_CHANGED (f); (f)->clear = 1 -#define FRAME_DEVICE(f) ((f)->device) -#define FRAME_CONSOLE(f) DEVICE_CONSOLE (XDEVICE (FRAME_DEVICE (f))) -#define FRAME_LIVE_P(f) (!(f)->dead) - -#define FRAME_MINIBUF_ONLY_P(f) \ - EQ (FRAME_ROOT_WINDOW (f), FRAME_MINIBUF_WINDOW (f)) -#define FRAME_HAS_MINIBUF_P(f) ((f)->has_minibuffer) -#define FRAME_HEIGHT(f) ((f)->height) -#define FRAME_WIDTH(f) ((f)->width) -#define FRAME_CHARHEIGHT(f) ((f)->char_height) -#define FRAME_CHARWIDTH(f) ((f)->char_width) -#define FRAME_PIXHEIGHT(f) ((f)->pixheight) -#define FRAME_PIXWIDTH(f) ((f)->pixwidth) -#ifdef HAVE_SCROLLBARS -#define FRAME_SCROLLBAR_WIDTH(f) \ - (NILP ((f)->vertical_scrollbar_visible_p) ? \ - 0 : XINT ((f)->scrollbar_width)) -#define FRAME_SCROLLBAR_HEIGHT(f) \ - (NILP ((f)->horizontal_scrollbar_visible_p) ? \ - 0 : XINT ((f)->scrollbar_height)) -#else -#define FRAME_SCROLLBAR_WIDTH(f) 0 -#define FRAME_SCROLLBAR_HEIGHT(f) 0 -#endif - -#define FW_FRAME(obj) \ - (WINDOWP (obj) ? WINDOW_FRAME (XWINDOW (obj)) \ - : (FRAMEP (obj) ? obj \ - : Qnil)) - -#define FRAME_NEW_HEIGHT(f) ((f)->new_height) -#define FRAME_NEW_WIDTH(f) ((f)->new_width) -#define FRAME_CURSOR_X(f) ((f)->cursor_x) -#define FRAME_CURSOR_Y(f) ((f)->cursor_y) -#define FRAME_VISIBLE_P(f) ((f)->visible) -#define FRAME_REPAINT_P(f) ((f)->visible>0) -#define FRAME_NO_SPLIT_P(f) ((f)->no_split) -#define FRAME_ICONIFIED_P(f) ((f)->iconified) -#define FRAME_FOCUS_FRAME(f) ((f)->focus_frame) -#define FRAME_MINIBUF_WINDOW(f) ((f)->minibuffer_window) -#define FRAME_ROOT_WINDOW(f) ((f)->root_window) -/* Catch people attempting to set this. */ -#define FRAME_SELECTED_WINDOW(f) NON_LVALUE ((f)->selected_window) -#define FRAME_LAST_NONMINIBUF_WINDOW(f) \ - NON_LVALUE ((f)->last_nonminibuf_window) -#define FRAME_SB_VCACHE(f) ((f)->sb_vcache) -#define FRAME_SB_HCACHE(f) ((f)->sb_hcache) -#define FRAME_SUBWINDOW_CACHE(f) ((f)->subwindow_cachels) - -#if 0 /* FSFmacs */ - -#define FRAME_VISIBLE_P(f) ((f)->visible != 0) -#define FRAME_SET_VISIBLE(f,p) \ - ((f)->async_visible = (p), FRAME_SAMPLE_VISIBILITY (f)) - -/* Emacs's redisplay code could become confused if a frame's - visibility changes at arbitrary times. For example, if a frame is - visible while the desired glyphs are being built, but becomes - invisible before they are updated, then some rows of the - desired_glyphs will be left marked as enabled after redisplay is - complete, which should never happen. The next time the frame - becomes visible, redisplay will probably barf. - - Currently, there are no similar situations involving iconified, but - the principle is the same. - - So instead of having asynchronous input handlers directly set and - clear the frame's visibility and iconification flags, they just set - the async_visible and async_iconified flags; the redisplay code - calls the FRAME_SAMPLE_VISIBILITY macro before doing any redisplay, - which sets visible and iconified from their asynchronous - counterparts. - - Synchronous code must use the FRAME_SET_VISIBLE macro. - - Also, if a frame used to be invisible, but has just become visible, - it must be marked as garbaged, since redisplay hasn't been keeping - up its contents. */ -#define FRAME_SAMPLE_VISIBILITY(f) \ - (((f)->async_visible && ! (f)->visible) ? SET_FRAME_GARBAGED (f) : 0, \ - (f)->visible = (f)->async_visible, \ - (f)->iconified = (f)->async_iconified) - -#endif /* FSFmacs */ - -#define FRAME_BORDER_WIDTH(f) ((f)->internal_border_width) -#define FRAME_BORDER_HEIGHT(f) ((f)->internal_border_width) - -/* This returns the frame-local value; that tells you what you should - use when computing the frame size. It is *not* the actual toolbar - size because that depends on the selected window. Use the macros - below for that. -*/ - -#ifdef HAVE_TOOLBARS -#define FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE(f, pos) \ - (!NILP((f)->toolbar_buttons[pos]) && !NILP ((f)->toolbar_visible_p[pos])) -#define FRAME_RAW_THEORETICAL_TOOLBAR_SIZE(f, pos) \ - (!NILP ((f)->toolbar_buttons[pos]) && INTP((f)->toolbar_size[pos]) ? \ - (XINT ((f)->toolbar_size[pos])) : 0) -#define FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - (!NILP ((f)->toolbar_buttons[pos]) && INTP((f)->toolbar_border_width[pos]) ? \ - (XINT ((f)->toolbar_border_width[pos])) : 0) -#else -#define FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE(f, pos) 0 -#define FRAME_RAW_THEORETICAL_TOOLBAR_SIZE(f, pos) 0 -#define FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH(f, pos) 0 -#endif - -#define FRAME_THEORETICAL_TOOLBAR_SIZE(f, pos) \ - (FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE (f, pos) \ - ? FRAME_RAW_THEORETICAL_TOOLBAR_SIZE (f, pos) \ - : 0) - -#define FRAME_THEORETICAL_TOP_TOOLBAR_HEIGHT(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, TOP_TOOLBAR) -#define FRAME_THEORETICAL_BOTTOM_TOOLBAR_HEIGHT(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, BOTTOM_TOOLBAR) -#define FRAME_THEORETICAL_LEFT_TOOLBAR_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, LEFT_TOOLBAR) -#define FRAME_THEORETICAL_RIGHT_TOOLBAR_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_SIZE (f, RIGHT_TOOLBAR) - -#define FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - (FRAME_RAW_THEORETICAL_TOOLBAR_VISIBLE (f, pos) \ - ? FRAME_RAW_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, pos) \ - : 0) - -#define FRAME_THEORETICAL_TOP_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, TOP_TOOLBAR) -#define FRAME_THEORETICAL_BOTTOM_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_TOOLBAR) -#define FRAME_THEORETICAL_LEFT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, LEFT_TOOLBAR) -#define FRAME_THEORETICAL_RIGHT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_THEORETICAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_TOOLBAR) - -/* This returns the window-local value rather than the frame-local value; - that tells you about what's actually visible rather than what should - be used when computing the frame size. */ - -#ifdef HAVE_TOOLBARS -#define FRAME_RAW_REAL_TOOLBAR_VISIBLE(f, pos) \ - (HAS_DEVMETH_P (XDEVICE (FRAME_DEVICE (f)), initialize_frame_toolbars) \ - && !NILP (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar_visible_p[pos])) -#define FRAME_RAW_REAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - ((INTP (XWINDOW \ - (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar_border_width[pos])) ? \ - (XINT (XWINDOW \ - (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar_border_width[pos])) \ - : 0) -#define FRAME_RAW_REAL_TOOLBAR_SIZE(f, pos) \ - ((INTP (XWINDOW \ - (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar_size[pos])) ? \ - (XINT (XWINDOW \ - (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar_size[pos])) : 0) -#define FRAME_REAL_TOOLBAR(f, pos) \ - (XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->toolbar[pos]) -#else -#define FRAME_RAW_REAL_TOOLBAR_VISIBLE(f, pos) 0 -#define FRAME_RAW_REAL_TOOLBAR_BORDER_WIDTH(f, pos) 0 -#define FRAME_RAW_REAL_TOOLBAR_SIZE(f, pos) 0 -#define FRAME_REAL_TOOLBAR(f, pos) Qnil -#endif - -/* Note to Chuck - Note to Chuck - Note to Chuck: - - The former definitions of FRAME_REAL_FOO_TOOLBAR_VISIBLE - looked at the toolbar data to see what was there. The - current ones look at the current values of the specifiers. - This is a semantic change; the former definition returned - what was *actually* there right at the moment, while the - current one returns what *ought* to be there once redisplay - has run to completion. I think this new definition is more - correct in almost all circumstances and is much less likely - to lead to strange race conditions. I'm not completely - sure that there aren't some places in the redisplay code - that use these macros and expect the former semantics, so - if you encounter some odd toolbar behavior, you might want - to look into this. --ben */ - -#define FRAME_REAL_TOOLBAR_VISIBLE(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ - && FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) > 0) \ - ? FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos) \ - : 0) -#define FRAME_REAL_TOOLBAR_SIZE(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ - && FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos)) \ - ? FRAME_RAW_REAL_TOOLBAR_SIZE (f, pos) \ - : 0) -#define FRAME_REAL_TOOLBAR_BORDER_WIDTH(f, pos) \ - ((!NILP (FRAME_REAL_TOOLBAR (f, pos)) \ - && FRAME_RAW_REAL_TOOLBAR_VISIBLE (f, pos)) \ - ? FRAME_RAW_REAL_TOOLBAR_BORDER_WIDTH (f, pos) \ - : 0) - -#define FRAME_REAL_TOP_TOOLBAR_HEIGHT(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, TOP_TOOLBAR) -#define FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, BOTTOM_TOOLBAR) -#define FRAME_REAL_LEFT_TOOLBAR_WIDTH(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, LEFT_TOOLBAR) -#define FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) \ - FRAME_REAL_TOOLBAR_SIZE (f, RIGHT_TOOLBAR) - -#define FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, TOP_TOOLBAR) -#define FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, BOTTOM_TOOLBAR) -#define FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, LEFT_TOOLBAR) -#define FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH(f) \ - FRAME_REAL_TOOLBAR_BORDER_WIDTH (f, RIGHT_TOOLBAR) - -#define FRAME_REAL_TOP_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, TOP_TOOLBAR) -#define FRAME_REAL_BOTTOM_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, BOTTOM_TOOLBAR) -#define FRAME_REAL_LEFT_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, LEFT_TOOLBAR) -#define FRAME_REAL_RIGHT_TOOLBAR_VISIBLE(f) \ - FRAME_REAL_TOOLBAR_VISIBLE (f, RIGHT_TOOLBAR) - -#define FRAME_TOP_BORDER_START(f) \ - (FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) + \ - 2 * FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_TOP_BORDER_END(f) \ - (FRAME_TOP_BORDER_START (f) + FRAME_BORDER_HEIGHT (f)) - -#define FRAME_BOTTOM_BORDER_START(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_BORDER_HEIGHT (f) - \ - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_BOTTOM_BORDER_END(f) \ - (FRAME_PIXHEIGHT (f) - FRAME_REAL_BOTTOM_TOOLBAR_HEIGHT (f) - \ - 2 * FRAME_REAL_BOTTOM_TOOLBAR_BORDER_WIDTH (f)) - -#define FRAME_LEFT_BORDER_START(f) \ - (FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) + \ - 2 * FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_LEFT_BORDER_END(f) \ - (FRAME_LEFT_BORDER_START (f) + FRAME_BORDER_WIDTH (f)) - -#define FRAME_RIGHT_BORDER_START(f) \ - (FRAME_PIXWIDTH (f) - FRAME_BORDER_WIDTH (f) - \ - FRAME_REAL_RIGHT_TOOLBAR_WIDTH(f) - \ - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH (f)) -#define FRAME_RIGHT_BORDER_END(f) \ - (FRAME_PIXWIDTH (f) - FRAME_REAL_RIGHT_TOOLBAR_WIDTH (f) - \ - 2 * FRAME_REAL_RIGHT_TOOLBAR_BORDER_WIDTH(f)) - -/* Equivalent in FSF Emacs: - - FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a - `for' loop which iterates over the elements of Vframe_list. The - loop will set FRAME_VAR, a Lisp_Object, to each frame in - Vframe_list in succession and execute the statement. LIST_VAR - should be a Lisp_Object too; it is used to iterate through the - Vframe_list. - */ - -/* NO_BREAK means that "break" doesn't do what you think it does! - Use goto instead. "continue" is OK, though. */ -#define FRAME_LOOP_NO_BREAK(frmcons, devcons, concons) \ - DEVICE_LOOP_NO_BREAK (devcons, concons) \ - DEVICE_FRAME_LOOP (frmcons, XDEVICE (XCAR (devcons))) - -void update_frame_title (struct frame *f); -Lisp_Object next_frame (Lisp_Object f, Lisp_Object frametype, - Lisp_Object console); -Lisp_Object prev_frame (Lisp_Object f, Lisp_Object frametype, - Lisp_Object console); -void store_in_alist (Lisp_Object *alistptr, - CONST char *propname, - Lisp_Object val); -void pixel_to_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height); -void char_to_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height); -void round_size_to_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height); -void pixel_to_real_char_size (struct frame *f, int pixel_width, int pixel_height, - int *char_width, int *char_height); -void char_to_real_pixel_size (struct frame *f, int char_width, int char_height, - int *pixel_width, int *pixel_height); -void round_size_to_real_char (struct frame *f, int in_width, int in_height, - int *out_width, int *out_height); -void change_frame_size (struct frame *frame, - int newlength, int newwidth, - int delay); -void adjust_frame_size (struct frame *frame); -void frame_size_slipped (Lisp_Object specifier, struct frame *f, - Lisp_Object oldval); -void hold_frame_size_changes (void); -void unhold_one_frame_size_changes (struct frame *f); -void unhold_frame_size_changes (void); -void select_frame_1 (Lisp_Object frame); -void select_frame_2 (Lisp_Object frame); -struct frame *selected_frame (void); -struct frame *device_selected_frame (struct device *d); -struct frame *decode_frame (Lisp_Object frame); -struct frame *decode_frame_or_selected (Lisp_Object cdf); -Lisp_Object make_frame (struct frame *f); -int other_visible_frames (struct frame *f); -void delete_frame_internal (struct frame *f, int force, - int called_from_delete_device, - int from_io_error); -void io_error_delete_frame (Lisp_Object frame); -Lisp_Object find_some_frame (int (*predicate) (Lisp_Object, void *), - void *closure); -int device_matches_console_spec (Lisp_Object frame, Lisp_Object device, - Lisp_Object console); -Lisp_Object frame_first_window (struct frame *f); -int show_gc_cursor (struct frame *f, Lisp_Object cursor); -void set_frame_selected_window (struct frame *f, Lisp_Object window); -int is_surrogate_for_selected_frame (struct frame *f); -void update_frame_icon (struct frame *f); -void invalidate_vertical_divider_cache_in_frame (struct frame *f); - -#endif /* _XEMACS_FRAME_H_ */ diff --git a/src/frameslots.h b/src/frameslots.h deleted file mode 100644 index 1674ce6..0000000 --- a/src/frameslots.h +++ /dev/null @@ -1,151 +0,0 @@ -/* Definitions of marked slots in frames - Copyright (C) 1988, 1992, 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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. Split out of frame.h. */ - -#ifdef FRAME_SLOT_DECLARATION -#define MARKED_SLOT_ARRAY(slot, size) MARKED_SLOT(slot[size]) -#else -#define MARKED_SLOT_ARRAY(slot, size) do { \ - int mslotidx; \ - for (mslotidx = 0; mslotidx < size; mslotidx++) \ - { \ - MARKED_SLOT (slot[mslotidx]); \ - } \ - } while (0); -#endif - - /* device frame belongs to. */ - MARKED_SLOT (device); - - /* Name of this frame: a Lisp string. - NOT the same as the frame's title, even though FSF bogusly - confuses the two. The frame's name is used for resourcing - and lookup purposes and is something you can count on having - a specific value, while the frame's title may vary depending - on the user's choice of `frame-title-format'. */ - MARKED_SLOT (name); - - /* The frame which should receive keystrokes that occur in this - frame, or nil if they should go to the frame itself. This is - usually nil, but if the frame is minibufferless, we can use this - to redirect keystrokes to a surrogate minibuffer frame when - needed. - - Note that a value of nil is different than having the field point - to the frame itself. Whenever the Fselect_frame function is used - to shift from one frame to the other, any redirections to the - original frame are shifted to the newly selected frame; if - focus_frame is nil, Fselect_frame will leave it alone. */ - MARKED_SLOT (focus_frame); - - /* This frame's root window. Every frame has one. - If the frame has only a minibuffer window, this is it. - Otherwise, if the frame has a minibuffer window, this is its sibling. */ - MARKED_SLOT (root_window); - - /* This frame's selected window. - Each frame has its own window hierarchy - and one of the windows in it is selected within the frame. - The selected window of the selected frame is Emacs's selected window. */ - MARKED_SLOT (selected_window); - - /* This frame's minibuffer window. - Most frames have their own minibuffer windows, - but only the selected frame's minibuffer window - can actually appear to exist. */ - MARKED_SLOT (minibuffer_window); - - /* The most recently selected nonminibuf window. - This is used by things like the toolbar code, which doesn't - want the toolbar to change when moving to the minibuffer. - This will only be a minibuf window if we are a minibuf-only - frame. */ - MARKED_SLOT (last_nonminibuf_window); - - /* frame property list */ - MARKED_SLOT (plist); - - /* A copy of the global Vbuffer_list, to maintain a per-frame buffer - ordering. The Vbuffer_list variable and the buffer_list slot of each - frame contain exactly the same data, just in different orders. */ - MARKED_SLOT (buffer_alist); - - /* Predicate for selecting buffers for other-buffer. */ - MARKED_SLOT (buffer_predicate); - - /* The current mouse pointer for the frame. This is set by calling - `set-frame-pointer'. */ - MARKED_SLOT (pointer); - - /* The current icon for the frame. */ - MARKED_SLOT (icon); - -#ifdef HAVE_MENUBARS - /* Vector representing the menubar currently displayed. See menubar-x.c. */ - MARKED_SLOT (menubar_data); -#endif - - /* specifier values cached in the struct frame: */ - -#ifdef HAVE_MENUBARS - MARKED_SLOT (menubar_visible_p); -#endif - -#ifdef HAVE_SCROLLBARS - /* Width and height of the scrollbars. */ - MARKED_SLOT (scrollbar_width); - MARKED_SLOT (scrollbar_height); - /* Whether the scrollbars are visible */ - MARKED_SLOT (horizontal_scrollbar_visible_p); - MARKED_SLOT (vertical_scrollbar_visible_p); - /* Scrollbars location */ - MARKED_SLOT (scrollbar_on_left_p); - MARKED_SLOT (scrollbar_on_top_p); -#endif - -#ifdef HAVE_TOOLBARS - /* The following three don't really need to be cached except - that we need to know when they've changed. */ - MARKED_SLOT (default_toolbar_width); - MARKED_SLOT (default_toolbar_height); - MARKED_SLOT (default_toolbar_visible_p); - MARKED_SLOT (default_toolbar_border_width); - - /* List of toolbar buttons of current toolbars */ - MARKED_SLOT_ARRAY (toolbar_buttons, 4); - /* Size of the toolbars. The frame-local toolbar space is - subtracted before the windows are arranged. Window and buffer - local toolbars overlay their windows. */ - MARKED_SLOT_ARRAY (toolbar_size, 4); - /* Visibility of the toolbars. This acts as a valve for toolbar_size. */ - MARKED_SLOT_ARRAY (toolbar_visible_p, 4); - /* Thickness of the border around the toolbar. */ - MARKED_SLOT_ARRAY (toolbar_border_width, 4); -#endif - - /* Possible frame-local default for outside margin widths. */ - MARKED_SLOT (left_margin_width); - MARKED_SLOT (right_margin_width); - -#undef MARKED_SLOT -#undef MARKED_SLOT_ARRAY -#undef FRAME_SLOT_DECLARATION diff --git a/src/free-hook.c b/src/free-hook.c deleted file mode 100644 index af1df69..0000000 --- a/src/free-hook.c +++ /dev/null @@ -1,594 +0,0 @@ -/* 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. */ - -/* Debugging hooks for malloc. */ - -/* These hooks work with gmalloc to catch allocation errors. - In particular, the following is trapped: - - * Freeing the same pointer twice. - * Trying to free a pointer not returned by malloc. - * Trying to realloc a pointer not returned by malloc. - - In addition, every word of every block freed is set to - 0xdeadbeef. This causes many uses of freed storage to be - trapped or recognized. - - When you use this, the storage used by the last FREE_QUEUE_LIMIT - calls to free() is not recycled. When you call free for the Nth - time, the (N - FREE_QUEUE_LIMIT)'th block is actually recycled. - - For these last FREE_QUEUE_LIMIT calls to free() a backtrace is - saved showing where it was called from. The function - find_backtrace() is provided here to be called from GDB with a - pointer (such as would be passed to free()) as argument, e.g. - (gdb) p/a *find_backtrace (0x234000). If SAVE_ARGS is defined, - the first three arguments to each function are saved as well as the - return addresses. - - If UNMAPPED_FREE is defined, instead of setting every word of freed - storage to 0xdeadbeef, every call to malloc goes on its own page(s). - When free() is called, the block is read and write protected. This - is very useful when debugging, since it usually generates a bus error - when the deadbeef hack might only cause some garbage to be printed. - However, this is too slow for everyday use, since it takes an enormous - number of pages. - - - Some other features that would be useful are: - - * Checking for storage leaks. - This could be done by a GC-like facility that would scan the data - segment looking for pointers to allocated storage and tell you - about those that are no longer referenced. This could be invoked - at any time. Another possibility is to report on what allocated - storage is still in use when the process is exited. Typically - there will be a large amount, so this might not be very useful. -*/ - -#ifdef emacs -#include -#include "lisp.h" -#else -void *malloc (size_t); -#endif - -#if !defined(HAVE_LIBMCHECK) -#include - -#include "hash.h" - -#ifdef UNMAPPED_FREE -#include -#include -#define ROUND_UP_TO_PAGE(i) (((i) + PAGEOFFSET) & PAGEMASK) -#endif - -#include - -/* System function prototypes don't belong in C source files */ -/* extern void free (void *); */ - -struct hash_table *pointer_table; - -extern void (*__free_hook) (void *); -extern void *(*__malloc_hook) (size_t); - -static void *check_malloc (size_t); - -typedef void (*fun_ptr) (); - -/* free_queue is not too useful without backtrace logging */ -#define FREE_QUEUE_LIMIT 1 -#define TRACE_LIMIT 20 - -typedef struct { - fun_ptr return_pc; -#ifdef SAVE_ARGS - void *arg[3]; -#endif -} fun_entry; - -typedef struct { - void *address; - unsigned long length; -} free_queue_entry; - -free_queue_entry free_queue[FREE_QUEUE_LIMIT]; - -int current_free; - -int strict_free_check; - -static void -check_free (void *ptr) -{ - __free_hook = 0; - __malloc_hook = 0; - if (!pointer_table) - pointer_table = make_hash_table (max (100, FREE_QUEUE_LIMIT * 2)); - if (ptr != 0) - { - long size; -#ifdef UNMAPPED_FREE - unsigned long rounded_up_size; -#endif - - EMACS_INT present = (EMACS_INT) gethash (ptr, pointer_table, - (CONST void **) &size); - - if (!present) - { - /* This can only happen if you try to free something that didn't - come from malloc */ -#if !defined(__linux__) - /* I originally wrote: "There's really no need to drop core." - I have seen the error of my ways. -slb */ - if (strict_free_check) - abort (); -#endif - printf("Freeing unmalloc'ed memory at %p\n", ptr); - __free_hook = check_free; - __malloc_hook = check_malloc; - goto end; - } - - if (size < 0) - { - /* This happens when you free twice */ -#if !defined(__linux__) - /* See above comment. */ - if (strict_free_check) - abort (); -#endif - printf("Freeing %p twice\n", ptr); - __free_hook = check_free; - __malloc_hook = check_malloc; - goto end; - } - - puthash (ptr, (void *)-size, pointer_table); -#ifdef UNMAPPED_FREE - /* Round up size to an even number of pages. */ - rounded_up_size = ROUND_UP_TO_PAGE (size); - /* Protect the pages freed from all access */ - if (strict_free_check) - mprotect (ptr, rounded_up_size, PROT_NONE); -#else - /* Set every word in the block to 0xdeadbeef */ - if (strict_free_check) - { - unsigned long long_length = (size + (sizeof (long) - 1)) - / sizeof (long); - unsigned long i; - - for (i = 0; i < long_length; i++) - ((unsigned long *) ptr)[i] = 0xdeadbeef; - } -#endif - free_queue[current_free].address = ptr; - free_queue[current_free].length = size; - - current_free++; - if (current_free >= FREE_QUEUE_LIMIT) - current_free = 0; - /* Really free this if there's something there */ - { - void *old = free_queue[current_free].address; - - if (old) - { -#ifdef UNMAPPED_FREE - unsigned long old_len = free_queue[current_free].length; - - mprotect (old, old_len, PROT_READ | PROT_WRITE | PROT_EXEC); -#endif - free (old); - remhash (old, pointer_table); - } - } - } - __free_hook = check_free; - __malloc_hook = check_malloc; - - end: - return; -} - -static void * -check_malloc (size_t size) -{ - size_t rounded_up_size; - void *result; - - __free_hook = 0; - __malloc_hook = 0; - if (size == 0) - { - result = 0; - goto end; - } -#ifdef UNMAPPED_FREE - /* Round up to an even number of pages. */ - rounded_up_size = ROUND_UP_TO_PAGE (size); -#else - rounded_up_size = size; -#endif - result = malloc (rounded_up_size); - if (!pointer_table) - pointer_table = make_hash_table (FREE_QUEUE_LIMIT * 2); - puthash (result, (void *)size, pointer_table); - __free_hook = check_free; - __malloc_hook = check_malloc; - end: - return result; -} - -extern void *(*__realloc_hook) (void *, size_t); - -#ifdef MIN -#undef MIN -#endif -#define MIN(A, B) ((A) < (B) ? (A) : (B)) - -/* Don't optimize realloc */ - -static void * -check_realloc (void * ptr, size_t size) -{ - EMACS_INT present; - size_t old_size; - void *result = malloc (size); - - if (!ptr) return result; - present = (EMACS_INT) gethash (ptr, pointer_table, (CONST void **) &old_size); - if (!present) - { - /* This can only happen by reallocing a pointer that didn't - come from malloc. */ -#if !defined(__linux__) - /* see comment in check_free(). */ - abort (); -#endif - printf("Realloc'ing unmalloc'ed pointer at %p\n", ptr); - } - - if (result == 0) - goto end; - memcpy (result, ptr, MIN (size, old_size)); - free (ptr); - end: - return result; -} - -void enable_strict_free_check (void); -void -enable_strict_free_check (void) -{ - strict_free_check = 1; -} - -void disable_strict_free_check (void); -void -disable_strict_free_check (void) -{ - strict_free_check = 0; -} - -/* Note: All BLOCK_INPUT stuff removed from this file because it's - completely gone in XEmacs */ - -static void * -block_input_malloc (size_t size); - -static void -block_input_free (void* ptr) -{ - __free_hook = 0; - __malloc_hook = 0; - free (ptr); - __free_hook = block_input_free; - __malloc_hook = block_input_malloc; -} - -static void * -block_input_malloc (size_t size) -{ - void* result; - __free_hook = 0; - __malloc_hook = 0; - result = malloc (size); - __free_hook = block_input_free; - __malloc_hook = block_input_malloc; - return result; -} - - -static void * -block_input_realloc (void* ptr, size_t size) -{ - void* result; - __free_hook = 0; - __malloc_hook = 0; - __realloc_hook = 0; - result = realloc (ptr, size); - __free_hook = block_input_free; - __malloc_hook = block_input_malloc; - __realloc_hook = block_input_realloc; - return result; -} - -#ifdef emacs - -void disable_free_hook (void); -void -disable_free_hook (void) -{ - __free_hook = block_input_free; - __malloc_hook = block_input_malloc; - __realloc_hook = block_input_realloc; -} - -void -init_free_hook (void) -{ - __free_hook = check_free; - __malloc_hook = check_malloc; - __realloc_hook = check_realloc; - current_free = 0; - strict_free_check = 1; -} - -void really_free_one_entry (void *, int, int *); - -DEFUN ("really-free", Freally_free, 0, 1, "P", /* -Actually free the storage held by the free() debug hook. -A no-op if the free hook is disabled. -*/ - (arg)) -{ - int count[2]; - Lisp_Object lisp_count[2]; - - if ((__free_hook != 0) && pointer_table) - { - count[0] = 0; - count[1] = 0; - __free_hook = 0; - maphash ((maphash_function)really_free_one_entry, - pointer_table, (void *)&count); - memset (free_queue, 0, sizeof (free_queue_entry) * FREE_QUEUE_LIMIT); - current_free = 0; - __free_hook = check_free; - XSETINT (lisp_count[0], count[0]); - XSETINT (lisp_count[1], count[1]); - return Fcons (lisp_count[0], lisp_count[1]); - } - else - return Fcons (make_int (0), make_int (0)); -} - -void -really_free_one_entry (void *key, int contents, int *countp) -{ - if (contents < 0) - { - free (key); -#ifdef UNMAPPED_FREE - mprotect (key, -contents, PROT_READ | PROT_WRITE | PROT_EXEC); -#endif - remhash (key, pointer_table); - countp[0]++; - countp[1] += -contents; - } -} - -void -syms_of_free_hook (void) -{ - DEFSUBR (Freally_free); -} - -#else -void (*__free_hook)(void *) = check_free; -void *(*__malloc_hook)(size_t) = check_malloc; -void *(*__realloc_hook)(void *, size_t) = check_realloc; -#endif - -#endif /* !defined(HAVE_LIBMCHECK) */ - -#if defined(DEBUG_INPUT_BLOCKING) || defined (DEBUG_GCPRO) - -/* Note: There is no more input blocking in XEmacs */ -typedef enum { - block_type, unblock_type, totally_type, - gcpro1_type, gcpro2_type, gcpro3_type, gcpro4_type, ungcpro_type -} blocktype; - -struct block_input_history_struct -{ - char *file; - int line; - blocktype type; - int value; -}; - -typedef struct block_input_history_struct block_input_history; - -#endif - -#ifdef DEBUG_INPUT_BLOCKING - -int blhistptr; - -#define BLHISTLIMIT 1000 - -block_input_history blhist[BLHISTLIMIT]; - -note_block_input (char *file, int line) -{ - note_block (file, line, block_type); - if (interrupt_input_blocked > 2) abort(); -} - -note_unblock_input (char* file, int line) -{ - note_block (file, line, unblock_type); -} - -note_totally_unblocked (char* file, int line) -{ - note_block (file, line, totally_type); -} - -note_block (char *file, int line, blocktype type) -{ - blhist[blhistptr].file = file; - blhist[blhistptr].line = line; - blhist[blhistptr].type = type; - blhist[blhistptr].value = interrupt_input_blocked; - - blhistptr++; - if (blhistptr >= BLHISTLIMIT) - blhistptr = 0; -} - -#endif - - -#ifdef DEBUG_GCPRO - -int gcprohistptr; -#define GCPROHISTLIMIT 1000 -block_input_history gcprohist[GCPROHISTLIMIT]; - -static void -log_gcpro (char *file, int line, struct gcpro *value, blocktype type) -{ - FRAME start_frame; - - if (type == ungcpro_type) - { - if (value == gcprolist) goto OK; - if (! gcprolist) abort (); - if (value == gcprolist->next) goto OK; - if (! gcprolist->next) abort (); - if (value == gcprolist->next->next) goto OK; - if (! gcprolist->next->next) abort (); - if (value == gcprolist->next->next->next) goto OK; - abort (); - OK:; - } - gcprohist[gcprohistptr].file = file; - gcprohist[gcprohistptr].line = line; - gcprohist[gcprohistptr].type = type; - gcprohist[gcprohistptr].value = (int) value; - gcprohistptr++; - if (gcprohistptr >= GCPROHISTLIMIT) - gcprohistptr = 0; -} - -void -debug_gcpro1 (char *file, int line, struct gcpro *gcpro1, Lisp_Object *var) -{ - gcpro1->next = gcprolist; gcpro1->var = var; gcpro1->nvars = 1; - gcprolist = gcpro1; - log_gcpro (file, line, gcpro1, gcpro1_type); -} - -void -debug_gcpro2 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, - Lisp_Object *var1, Lisp_Object *var2) -{ - gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; - gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; - gcprolist = gcpro2; - log_gcpro (file, line, gcpro2, gcpro2_type); -} - -void -debug_gcpro3 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, - struct gcpro *gcpro3, Lisp_Object *var1, Lisp_Object *var2, - Lisp_Object *var3) -{ - gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; - gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; - gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; - gcprolist = gcpro3; - log_gcpro (file, line, gcpro3, gcpro3_type); -} - -void -debug_gcpro4 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, - struct gcpro *gcpro3, struct gcpro *gcpro4, Lisp_Object *var1, - Lisp_Object *var2, Lisp_Object *var3, Lisp_Object *var4) -{ - log_gcpro (file, line, gcpro4, gcpro4_type); - gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; - gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; - gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; - gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; - gcprolist = gcpro4; -} - -void -debug_gcpro5 (char *file, int line, struct gcpro *gcpro1, struct gcpro *gcpro2, - struct gcpro *gcpro3, struct gcpro *gcpro4, struct gcpro *gcpro5, - Lisp_Object *var1, Lisp_Object *var2, Lisp_Object *var3, - Lisp_Object *var4, Lisp_Object *var5) -{ - log_gcpro (file, line, gcpro5, gcpro5_type); - gcpro1->next = gcprolist; gcpro1->var = var1; gcpro1->nvars = 1; - gcpro2->next = gcpro1; gcpro2->var = var2; gcpro2->nvars = 1; - gcpro3->next = gcpro2; gcpro3->var = var3; gcpro3->nvars = 1; - gcpro4->next = gcpro3; gcpro4->var = var4; gcpro4->nvars = 1; - gcpro5->next = gcpro4; gcpro5->var = var5; gcpro5->nvars = 1; - gcprolist = gcpro5; -} - -void -debug_ungcpro (char *file, int line, struct gcpro *gcpro1) -{ - log_gcpro (file, line, gcpro1, ungcpro_type); - gcprolist = gcpro1->next; -} - -void -show_gcprohist (void) -{ - int i, j; - for (i = 0, j = gcprohistptr; - i < GCPROHISTLIMIT; - i++, j++) - { - if (j >= GCPROHISTLIMIT) - j = 0; - printf ("%3d %s %d %s 0x%x\n", - j, gcprohist[j].file, gcprohist[j].line, - (gcprohist[j].type == gcpro1_type ? "GCPRO1" : - gcprohist[j].type == gcpro2_type ? "GCPRO2" : - gcprohist[j].type == gcpro3_type ? "GCPRO3" : - gcprohist[j].type == gcpro4_type ? "GCPRO4" : - gcprohist[j].type == ungcpro_type ? "UNGCPRO" : "???"), - gcprohist[j].value); - } - fflush (stdout); -} - -#endif diff --git a/src/general.c b/src/general.c deleted file mode 100644 index 973d1e4..0000000 --- a/src/general.c +++ /dev/null @@ -1,342 +0,0 @@ -/* Commonly-used symbols - Copyright (C) 1995 Sun Microsystems. - Copyright (C) 1995, 1996 Ben Wing. - -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 purpose of this file is as a central place to stick symbols - that don't have any obvious connection to any particular module - and might be used in many different contexts. - - #### More should be put here. - */ - -#include -#include "lisp.h" - -Lisp_Object Qactually_requested; -Lisp_Object Qafter; -Lisp_Object Qall; -Lisp_Object Qalways; -Lisp_Object Qand; -Lisp_Object Qassoc; -Lisp_Object Qat; -Lisp_Object Qauth; -Lisp_Object Qautodetect; -Lisp_Object Qbad_variable; -Lisp_Object Qbase; -Lisp_Object Qbefore; -Lisp_Object Qbinary; -Lisp_Object Qbinddn; -Lisp_Object Qbitmap; -Lisp_Object Qblack; -Lisp_Object Qboolean; -Lisp_Object Qbottom; -Lisp_Object Qbuffer; -Lisp_Object Qbutton; -Lisp_Object Qcase; -Lisp_Object Qcategory; -Lisp_Object Qchannel; -Lisp_Object Qchar; -Lisp_Object Qcharacter; -Lisp_Object Qchars; -Lisp_Object Qcolor; -Lisp_Object Qcolumns; -Lisp_Object Qcommand; -Lisp_Object Qconsole; -Lisp_Object Qcritical; -Lisp_Object Qcursor; -Lisp_Object Qdata; -Lisp_Object Qdead; -Lisp_Object Qdefault; -Lisp_Object Qdelete; -Lisp_Object Qdelq; -Lisp_Object Qderef; -Lisp_Object Qdevice; -Lisp_Object Qdimension; -Lisp_Object Qdisplay; -Lisp_Object Qdoc_string; -Lisp_Object Qdynarr_overhead; -Lisp_Object Qempty; -Lisp_Object Qeq; -Lisp_Object Qeql; -Lisp_Object Qequal; -Lisp_Object Qeval; -Lisp_Object Qextents; -Lisp_Object Qface; -Lisp_Object Qfind; -Lisp_Object Qfont; -Lisp_Object Qframe; -Lisp_Object Qfunction; -Lisp_Object Qgap_overhead; -Lisp_Object Qgeneric; -Lisp_Object Qgeometry; -Lisp_Object Qglobal; -Lisp_Object Qheight; -Lisp_Object Qhighlight; -Lisp_Object Qicon; -Lisp_Object Qid; -Lisp_Object Qimage; -Lisp_Object Qinfo; -Lisp_Object Qinherit; -Lisp_Object Qinteger; -Lisp_Object Qinternal; -Lisp_Object Qkey; -Lisp_Object Qkey_assoc; -Lisp_Object Qkeyboard; -Lisp_Object Qkeymap; -Lisp_Object Qkrbv41; -Lisp_Object Qkrbv42; -Lisp_Object Qleft; -Lisp_Object Qlist; -Lisp_Object Qmagic; -Lisp_Object Qmalloc_overhead; -Lisp_Object Qmarkers; -Lisp_Object Qmax; -Lisp_Object Qmemory; -Lisp_Object Qmenubar; -Lisp_Object Qmessage; -Lisp_Object Qminus; -Lisp_Object Qmodifiers; -Lisp_Object Qmotion; -Lisp_Object Qmswindows; -Lisp_Object Qname; -Lisp_Object Qnever; -Lisp_Object Qnone; -Lisp_Object Qnot; -Lisp_Object Qnothing; -Lisp_Object Qnotice; -Lisp_Object Qobject; -Lisp_Object Qold_assoc; -Lisp_Object Qold_delete; -Lisp_Object Qold_delq; -Lisp_Object Qold_rassoc; -Lisp_Object Qold_rassq; -Lisp_Object Qonelevel; -Lisp_Object Qonly; -Lisp_Object Qor; -Lisp_Object Qother; -Lisp_Object Qpasswd; -Lisp_Object Qpath; -Lisp_Object Qpointer; -Lisp_Object Qpopup; -Lisp_Object Qport; -Lisp_Object Qprint; -Lisp_Object Qprocess; -Lisp_Object Qprovide; -Lisp_Object Qrassoc; -Lisp_Object Qrassq; -Lisp_Object Qrequire; -Lisp_Object Qresource; -Lisp_Object Qreturn; -Lisp_Object Qreverse; -Lisp_Object Qright; -Lisp_Object Qsearch; -Lisp_Object Qselected; -Lisp_Object Qsignal; -Lisp_Object Qsimple; -Lisp_Object Qsize; -Lisp_Object Qsizelimit; -Lisp_Object Qspace; -Lisp_Object Qspecifier; -Lisp_Object Qstream; -Lisp_Object Qstring; -Lisp_Object Qsubtree; -Lisp_Object Qsymbol; -Lisp_Object Qsyntax; -Lisp_Object Qtest; -Lisp_Object Qtext; -Lisp_Object Qtimelimit; -Lisp_Object Qtimeout; -Lisp_Object Qtimestamp; -Lisp_Object Qtoolbar; -Lisp_Object Qtop; -Lisp_Object Qtty; -Lisp_Object Qtype; -Lisp_Object Qundecided; -Lisp_Object Qundefined; -Lisp_Object Qunimplemented; -Lisp_Object Qvalue_assoc; -Lisp_Object Qvector; -Lisp_Object Qwarning; -Lisp_Object Qwhite; -Lisp_Object Qwidth; -Lisp_Object Qwidget; -Lisp_Object Qwindow; -Lisp_Object Qwindow_system; -Lisp_Object Qx; -Lisp_Object Qy; - -void -syms_of_general (void) -{ - defsymbol (&Qactually_requested, "actually-requested"); - defsymbol (&Qafter, "after"); - defsymbol (&Qall, "all"); - defsymbol (&Qalways, "always"); - defsymbol (&Qand, "and"); - defsymbol (&Qassoc, "assoc"); - defsymbol (&Qat, "at"); - defsymbol (&Qauth, "auth"); - defsymbol (&Qautodetect, "autodetect"); - defsymbol (&Qbad_variable, "bad-variable"); - defsymbol (&Qbase, "base"); - defsymbol (&Qbefore, "before"); - defsymbol (&Qbinary, "binary"); - defsymbol (&Qbinddn, "binddn"); - defsymbol (&Qbitmap, "bitmap"); - defsymbol (&Qblack, "black"); - defsymbol (&Qboolean, "boolean"); - defsymbol (&Qbottom, "bottom"); - defsymbol (&Qbuffer, "buffer"); - defsymbol (&Qbutton, "button"); - defsymbol (&Qcase, "case"); - defsymbol (&Qcategory, "category"); - defsymbol (&Qchannel, "channel"); - defsymbol (&Qchar, "char"); - defsymbol (&Qcharacter, "character"); - defsymbol (&Qchars, "chars"); - defsymbol (&Qcolor, "color"); - defsymbol (&Qcolumns, "columns"); - defsymbol (&Qcommand, "command"); - defsymbol (&Qconsole, "console"); - defsymbol (&Qcritical, "critical"); - defsymbol (&Qcursor, "cursor"); - defsymbol (&Qdata, "data"); - defsymbol (&Qdead, "dead"); - defsymbol (&Qdefault, "default"); - defsymbol (&Qdelete, "delete"); - defsymbol (&Qdelq, "delq"); - defsymbol (&Qderef, "deref"); - defsymbol (&Qdevice, "device"); - defsymbol (&Qdimension, "dimension"); - defsymbol (&Qdisplay, "display"); - defsymbol (&Qdoc_string, "doc-string"); - defsymbol (&Qdynarr_overhead, "dynarr-overhead"); - defsymbol (&Qempty, "empty"); - defsymbol (&Qeq, "eq"); - defsymbol (&Qeql, "eql"); - defsymbol (&Qequal, "equal"); - defsymbol (&Qeval, "eval"); - defsymbol (&Qextents, "extents"); - defsymbol (&Qface, "face"); - defsymbol (&Qfind, "find"); - defsymbol (&Qfont, "font"); - defsymbol (&Qframe, "frame"); - defsymbol (&Qfunction, "function"); - defsymbol (&Qgap_overhead, "gap-overhead"); - defsymbol (&Qgeneric, "generic"); - defsymbol (&Qgeometry, "geometry"); - defsymbol (&Qglobal, "global"); - defsymbol (&Qheight, "height"); - defsymbol (&Qhighlight, "highlight"); - defsymbol (&Qicon, "icon"); - defsymbol (&Qid, "id"); - defsymbol (&Qimage, "image"); - defsymbol (&Qinfo, "info"); - defsymbol (&Qinherit, "inherit"); - defsymbol (&Qinteger, "integer"); - defsymbol (&Qinternal, "internal"); - defsymbol (&Qkey, "key"); - defsymbol (&Qkey_assoc, "key-assoc"); - defsymbol (&Qkeyboard, "keyboard"); - defsymbol (&Qkeymap, "keymap"); - defsymbol (&Qkrbv41, "krbv41"); - defsymbol (&Qkrbv42, "krbv42"); - defsymbol (&Qleft, "left"); - defsymbol (&Qlist, "list"); - defsymbol (&Qmagic, "magic"); - defsymbol (&Qmalloc_overhead, "malloc-overhead"); - defsymbol (&Qmarkers, "markers"); - defsymbol (&Qmax, "max"); - defsymbol (&Qmemory, "memory"); - defsymbol (&Qmenubar, "menubar"); - defsymbol (&Qmessage, "message"); - defsymbol (&Qminus, "-"); - defsymbol (&Qmodifiers, "modifiers"); - defsymbol (&Qmotion, "motion"); - defsymbol (&Qmswindows, "mswindows"); - defsymbol (&Qname, "name"); - defsymbol (&Qnever, "never"); - defsymbol (&Qnone, "none"); - defsymbol (&Qnot, "not"); - defsymbol (&Qnothing, "nothing"); - defsymbol (&Qnotice, "notice"); - defsymbol (&Qobject, "object"); - defsymbol (&Qold_assoc, "old-assoc"); - defsymbol (&Qold_delete, "old-delete"); - defsymbol (&Qold_delq, "old-delq"); - defsymbol (&Qold_rassoc, "old-rassoc"); - defsymbol (&Qold_rassq, "old-rassq"); - defsymbol (&Qonelevel, "onelevel"); - defsymbol (&Qonly, "only"); - defsymbol (&Qor, "or"); - defsymbol (&Qother, "other"); - defsymbol (&Qpasswd, "passwd"); - defsymbol (&Qpath, "path"); - defsymbol (&Qpointer, "pointer"); - defsymbol (&Qpopup, "popup"); - defsymbol (&Qport, "port"); - defsymbol (&Qprint, "print"); - defsymbol (&Qprocess, "process"); - defsymbol (&Qprovide, "provide"); - defsymbol (&Qrassoc, "rassoc"); - defsymbol (&Qrassq, "rassq"); - defsymbol (&Qrequire, "require"); - defsymbol (&Qresource, "resource"); - defsymbol (&Qreturn, "return"); - defsymbol (&Qreverse, "reverse"); - defsymbol (&Qright, "right"); - defsymbol (&Qsearch, "search"); - defsymbol (&Qselected, "selected"); - defsymbol (&Qsignal, "signal"); - defsymbol (&Qsimple, "simple"); - defsymbol (&Qsize, "size"); - defsymbol (&Qsizelimit, "sizelimit"); - defsymbol (&Qspace, "space"); - defsymbol (&Qspecifier, "specifier"); - defsymbol (&Qstream, "stream"); - defsymbol (&Qstring, "string"); - defsymbol (&Qsubtree, "subtree"); - defsymbol (&Qsymbol, "symbol"); - defsymbol (&Qsyntax, "syntax"); - defsymbol (&Qtest, "test"); - defsymbol (&Qtext, "text"); - defsymbol (&Qtimelimit, "timelimit"); - defsymbol (&Qtimeout, "timeout"); - defsymbol (&Qtimestamp, "timestamp"); - defsymbol (&Qtoolbar, "toolbar"); - defsymbol (&Qtop, "top"); - defsymbol (&Qtty, "tty"); - defsymbol (&Qtype, "type"); - defsymbol (&Qundecided, "undecided"); - defsymbol (&Qundefined, "undefined"); - defsymbol (&Qunimplemented, "unimplemented"); - defsymbol (&Qvalue_assoc, "value-assoc"); - defsymbol (&Qvector, "vector"); - defsymbol (&Qwarning, "warning"); - defsymbol (&Qwhite, "white"); - defsymbol (&Qwidth, "width"); - defsymbol (&Qwidget, "widget"); - defsymbol (&Qwindow, "window"); - defsymbol (&Qwindow_system, "window-system"); - defsymbol (&Qx, "x"); - defsymbol (&Qy, "y"); -} diff --git a/src/getloadavg.c b/src/getloadavg.c deleted file mode 100644 index 39c45e6..0000000 --- a/src/getloadavg.c +++ /dev/null @@ -1,1009 +0,0 @@ -/* Get the system load averages. - Copyright (C) 1985, 86, 87, 88, 89, 91, 92, 93, 1994, 1995 - 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. */ - -#ifndef __CYGWIN32__ - -/* Compile-time symbols that this file uses: - - FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. - KERNEL_FILE Pathname of the kernel to nlist. - LDAV_CVT() Scale the load average from the kernel. - Returns a double. - LDAV_SYMBOL Name of kernel symbol giving load average. - LOAD_AVE_TYPE Type of the load average array in the kernel. - Must be defined unless one of - apollo, DGUX, NeXT, or UMAX is defined; - otherwise, no load average is available. - NLIST_STRUCT Include nlist.h, not a.out.h, and - the nlist n_name element is a pointer, - not an array. - NLIST_NAME_UNION struct nlist has an n_un member, not n_name. - LINUX_LDAV_FILE [__linux__]: File containing load averages. - - Specific system predefines this file uses, aside from setting - default values if not emacs: - - apollo - BSD Real BSD, not just BSD-like. - convex - DGUX - hpux - MSDOS No-op for MSDOS. - NeXT - sgi - sequent Sequent Dynix 3.x.x (BSD) - _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) - sony_news NEWS-OS (works at least for 4.1C) - UMAX - UMAX4_3 - WIN32 No-op for Windows95/NT. - __linux__ Linux: assumes /proc filesystem mounted. - Support from Michael K. Johnson. - __NetBSD__ NetBSD: assumes /kern filesystem mounted. - __OpenBSD__ OpenBSD: ditto. - - In addition, to avoid nesting many #ifdefs, we internally set - LDAV_DONE to indicate that the load average has been computed. - - We also #define LDAV_PRIVILEGED if a program will require - special installation to be able to call getloadavg. */ - -/* This should always be first. */ -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -/* Both the Emacs and non-Emacs sections want this. Some - configuration files' definitions for the LOAD_AVE_CVT macro (like - sparc.h's) use macros like FSCALE, defined here. */ -#ifdef unix -#include -#endif - -#ifdef XEMACS -#include "lisp.h" -#include "sysfile.h" /* for encapsulated open, close, read, write */ -#endif /* XEMACS */ - -/* Exclude all the code except the test program at the end - if the system has its own `getloadavg' function. - - The declaration of `errno' is needed by the test program - as well as the function itself, so it comes first. */ - -#include - -#ifndef errno -extern int errno; -#endif - -#ifndef HAVE_GETLOADAVG - -/* The existing Emacs configuration files define a macro called - LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and - returns the load average multiplied by 100. What we actually want - is a macro called LDAV_CVT, which returns the load average as an - unmultiplied double. - - For backwards compatibility, we'll define LDAV_CVT in terms of - LOAD_AVE_CVT, but future machine config files should just define - LDAV_CVT directly. */ - -#if !defined(LDAV_CVT) && defined(LOAD_AVE_CVT) -#define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) -#endif - -#ifdef XEMACS -#if defined (HAVE_KSTAT_H) -#include -#endif /* HAVE_KSTAT_H */ -#endif /* XEMACS */ - -#if !defined (BSD) && defined (ultrix) -/* Ultrix behaves like BSD on Vaxen. */ -#define BSD -#endif - -#ifdef NeXT -/* NeXT in the 2.{0,1,2} releases defines BSD in , which - conflicts with the definition understood in this file, that this - really is BSD. */ -#undef BSD - -/* NeXT defines FSCALE in . However, we take FSCALE being - defined to mean that the nlist method should be used, which is not true. */ -#undef FSCALE -#endif - -/* Set values that are different from the defaults, which are - set a little farther down with #ifndef. */ - - -/* Some shorthands. */ - -#if defined (HPUX) && !defined (hpux) -#define hpux -#endif - -#if defined(hp300) && !defined(hpux) -#define MORE_BSD -#endif - -#if defined(ultrix) && defined(mips) -#define decstation -#endif - -#if (defined(sun) && defined(SVR4)) || defined (SOLARIS2) -#define SUNOS_5 -#endif - -#if defined (__osf__) && (defined (__alpha) || defined (__alpha__)) -#define OSF_ALPHA -#include -#include /* Needed for Digital UNIX V3 */ -#include -#include -#endif - -#if defined (__osf__) && (defined (mips) || defined (__mips__)) -#define OSF_MIPS -#include -#endif - -/* UTek's /bin/cc on the 4300 has no architecture specific cpp define by - default, but _MACH_IND_SYS_TYPES is defined in . Combine - that with a couple of other things and we'll have a unique match. */ -#if !defined (tek4300) && defined (unix) && defined (m68k) && defined (mc68000) && defined (mc68020) && defined (_MACH_IND_SYS_TYPES) -#define tek4300 /* Define by emacs, but not by other users. */ -#endif - - -/* VAX C can't handle multi-line #ifs, or lines longer than 256 chars. */ -#ifndef LOAD_AVE_TYPE - -#ifdef MORE_BSD -#define LOAD_AVE_TYPE long -#endif - -#ifdef sun -#define LOAD_AVE_TYPE long -#endif - -#ifdef decstation -#define LOAD_AVE_TYPE long -#endif - -#ifdef _SEQUENT_ -#define LOAD_AVE_TYPE long -#endif - -#ifdef sgi -#define LOAD_AVE_TYPE long -#endif - -#ifdef SVR4 -#define LOAD_AVE_TYPE long -#endif - -#ifdef sony_news -#define LOAD_AVE_TYPE long -#endif - -#ifdef sequent -#define LOAD_AVE_TYPE long -#endif - -#ifdef OSF_ALPHA -#define LOAD_AVE_TYPE long -#endif - -#if defined (ardent) && defined (titan) -#define LOAD_AVE_TYPE long -#endif - -#ifdef tek4300 -#define LOAD_AVE_TYPE long -#endif - -#if defined(alliant) && defined(i860) /* Alliant FX/2800 */ -#define LOAD_AVE_TYPE long -#endif - -#ifdef _AIX -#define LOAD_AVE_TYPE long -#endif - -#ifdef convex -#define LOAD_AVE_TYPE double -#ifndef LDAV_CVT -#define LDAV_CVT(n) (n) -#endif -#endif - -#endif /* No LOAD_AVE_TYPE. */ - -#ifdef OSF_ALPHA -/* defines an incorrect value for FSCALE on Alpha OSF/1, - according to ghazi@noc.rutgers.edu. */ -#undef FSCALE -#define FSCALE 1024.0 -#endif - -#if defined(alliant) && defined(i860) /* Alliant FX/2800 */ -/* defines an incorrect value for FSCALE on an - Alliant FX/2800 Concentrix 2.2, according to ghazi@noc.rutgers.edu. */ -#undef FSCALE -#define FSCALE 100.0 -#endif - - -#ifndef FSCALE - -/* SunOS and some others define FSCALE in sys/param.h. */ - -#ifdef MORE_BSD -#define FSCALE 2048.0 -#endif - -#if defined(MIPS) || defined(SVR4) || defined(decstation) -#define FSCALE 256 -#endif - -#if defined (sgi) || defined (sequent) -/* Sometimes both MIPS and sgi are defined, so FSCALE was just defined - above under #ifdef MIPS. But we want the sgi value. */ -#undef FSCALE -#define FSCALE 1000.0 -#endif - -#if defined (ardent) && defined (titan) -#define FSCALE 65536.0 -#endif - -#ifdef tek4300 -#define FSCALE 100.0 -#endif - -#ifdef _AIX -#define FSCALE 65536.0 -#endif - -#endif /* Not FSCALE. */ - -#if !defined (LDAV_CVT) && defined (FSCALE) -#define LDAV_CVT(n) (((double) (n)) / FSCALE) -#endif - -/* VAX C can't handle multi-line #ifs, or lines longer that 256 characters. */ -#ifndef NLIST_STRUCT - -#ifdef MORE_BSD -#define NLIST_STRUCT -#endif - -#ifdef sun -#define NLIST_STRUCT -#endif - -#ifdef decstation -#define NLIST_STRUCT -#endif - -#ifdef hpux -#define NLIST_STRUCT -#endif - -#if defined (_SEQUENT_) || defined (sequent) -#define NLIST_STRUCT -#endif - -#ifdef sgi -#define NLIST_STRUCT -#endif - -#ifdef SVR4 -#define NLIST_STRUCT -#endif - -#ifdef sony_news -#define NLIST_STRUCT -#endif - -#ifdef OSF_ALPHA -#define NLIST_STRUCT -#endif - -#if defined (ardent) && defined (titan) -#define NLIST_STRUCT -#endif - -#ifdef tek4300 -#define NLIST_STRUCT -#endif - -#ifdef butterfly -#define NLIST_STRUCT -#endif - -#if defined(alliant) && defined(i860) /* Alliant FX/2800 */ -#define NLIST_STRUCT -#endif - -#ifdef _AIX -#define NLIST_STRUCT -#endif - -#endif /* defined (NLIST_STRUCT) */ - - -#if defined(sgi) || (defined(mips) && !defined(BSD)) -#define FIXUP_KERNEL_SYMBOL_ADDR(nl) ((nl)[0].n_value &= ~(1 << 31)) -#endif - - -#if !defined (KERNEL_FILE) && defined (sequent) -#define KERNEL_FILE "/dynix" -#endif - -#if !defined (KERNEL_FILE) && defined (hpux) -#define KERNEL_FILE "/hp-ux" -#endif - -#if !defined(KERNEL_FILE) && (defined(_SEQUENT_) || defined(MIPS) || defined(SVR4) || defined(ISC) || defined (sgi) || defined(SVR4) || (defined (ardent) && defined (titan))) -#define KERNEL_FILE "/unix" -#endif - - -#if !defined (LDAV_SYMBOL) && defined (alliant) -#define LDAV_SYMBOL "_Loadavg" -#endif - -#if !defined(LDAV_SYMBOL) && ((defined(hpux) && !defined(hp9000s300)) || defined(_SEQUENT_) || defined(SVR4) || defined(ISC) || defined(sgi) || (defined (ardent) && defined (titan)) || defined (_AIX)) -#define LDAV_SYMBOL "avenrun" -#endif - -#ifdef HAVE_UNISTD_H -#include -#endif - -#include - -/* LOAD_AVE_TYPE should only get defined if we're going to use the - nlist method. */ -#if !defined(LOAD_AVE_TYPE) && (defined(BSD) || defined(LDAV_CVT) || defined(KERNEL_FILE) || defined(LDAV_SYMBOL)) -#define LOAD_AVE_TYPE double -#endif - -#ifdef LOAD_AVE_TYPE - -#ifndef NLIST_STRUCT -#include -#else /* NLIST_STRUCT */ -#include -#endif /* NLIST_STRUCT */ - -#ifdef SUNOS_5 -#include -#include -#endif - -#ifndef KERNEL_FILE -#define KERNEL_FILE "/vmunix" -#endif /* KERNEL_FILE */ - -#ifndef LDAV_SYMBOL -#define LDAV_SYMBOL "_avenrun" -#endif /* LDAV_SYMBOL */ - -#ifndef LDAV_CVT -#define LDAV_CVT(n) ((double) (n)) -#endif /* !LDAV_CVT */ - -#endif /* LOAD_AVE_TYPE */ - -#ifdef NeXT -#ifdef HAVE_MACH_MACH_H -#include -#else -#include -#endif -#endif /* NeXT */ - -#ifdef sgi -#include -#endif /* sgi */ - -#ifdef UMAX -#include -#include -#include -#include -#include - -#ifdef UMAX_43 -#include -#include -#include -#include -#include -#else /* Not UMAX_43. */ -#include -#include -#include -#include -#include -#include -#endif /* Not UMAX_43. */ -#endif /* UMAX */ - -#ifdef DGUX -#include -#endif - -#ifdef XEMACS -#if defined (HAVE_SYS_PSTAT_H) -#include -#endif /* HAVE_SYS_PSTAT_H (on HPUX) */ -#endif /* XEMACS */ - -#if defined(HAVE_FCNTL_H) || defined(_POSIX_VERSION) -#include -#else -#include -#endif - -/* Avoid static vars inside a function since in HPUX they dump as pure. */ - -#ifdef NeXT -static processor_set_t default_set; -static int getloadavg_initialized; -#endif /* NeXT */ - -#ifdef UMAX -static unsigned int cpus = 0; -static unsigned int samples; -#endif /* UMAX */ - -#ifdef DGUX -static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ -#endif /* DGUX */ - -#ifdef LOAD_AVE_TYPE -/* File descriptor open to /dev/kmem */ -static int channel; -/* Nonzero iff channel is valid. */ -static int getloadavg_initialized; -/* Offset in kmem to seek to read load average, or 0 means invalid. */ -static long offset; - -#ifndef sgi -static struct nlist nl[2]; -#endif /* not sgi */ - -#ifdef SUNOS_5 -static kvm_t *kd; -#endif /* SUNOS_5 */ - -#ifndef countof -# define countof(x) (sizeof (x) / sizeof (*(x))) -#endif - -#endif /* LOAD_AVE_TYPE */ - -/* Put the 1 minute, 5 minute and 15 minute load averages - into the first NELEM elements of LOADAVG. - Return the number written (never more than 3, but may be less than NELEM), - or -1 if an error occurred. */ - -int -getloadavg (double loadavg[], int nelem) -{ - int elem = 0; /* Return value. */ - -#ifdef NO_GET_LOAD_AVG -#define LDAV_DONE - /* Set errno to zero to indicate that there was no particular error; - this function just can't work at all on this system. */ - errno = 0; - elem = -2; -#endif /* NO_GET_LOAD_AVG */ - -#if ! defined (LDAV_DONE) && defined (HAVE_KSTAT_H) && defined (HAVE_LIBKSTAT) -#define LDAV_DONE -/* getloadavg is best implemented using kstat (kernel stats), on - systems (like SunOS5) that support it, since you don't need special - privileges to use it. - - Initial implementation courtesy Zlatko Calusic . - Integrated to XEmacs by Hrvoje Niksic . - Additional cleanup by Hrvoje Niksic, based on code published by - Casper Dik . */ - kstat_ctl_t *kc; - kstat_t *ksp; - static char *avestrings[] = { "avenrun_1min", - "avenrun_5min", - "avenrun_15min" }; - - if (nelem > countof (avestrings)) - nelem = countof (avestrings); - - kc = kstat_open (); - if (!kc) - return -1; - ksp = kstat_lookup (kc, "unix", 0, "system_misc"); - if (!ksp) - { - kstat_close (kc); - return -1; - } - if (kstat_read (kc, ksp, 0) < 0) - { - kstat_close (kc); - return -1; - } - for (elem = 0; elem < nelem; elem++) - { - kstat_named_t *kn = - (kstat_named_t *) kstat_data_lookup (ksp, avestrings[elem]); - if (!kn) - { - kstat_close (kc); - return -1; - } - loadavg[elem] = (double)kn->value.ul / FSCALE; - } - kstat_close (kc); -#endif /* HAVE_KSTAT_H && HAVE_LIBKSTAT */ - -#if !defined (LDAV_DONE) && defined (HAVE_SYS_PSTAT_H) -#define LDAV_DONE - /* This is totally undocumented, and is not guaranteed to work, but - mayhap it might .... If it does work, it will work only on HP-UX - 8.0 or later. -- Darryl Okahata */ -#undef LOAD_AVE_TYPE /* Make sure these don't exist. */ -#undef LOAD_AVE_CVT -#undef LDAV_SYMBOL - struct pst_dynamic procinfo; - union pstun statbuf; - - statbuf.pst_dynamic = &procinfo; - if (pstat (PSTAT_DYNAMIC, statbuf, sizeof (struct pst_dynamic), 0, 0) == -1) - return (-1); - loadavg[elem++] = procinfo.psd_avg_1_min; - loadavg[elem++] = procinfo.psd_avg_5_min; - loadavg[elem++] = procinfo.psd_avg_15_min; -#endif /* HPUX */ - -#if !defined (LDAV_DONE) && defined (__linux__) -#define LDAV_DONE -#undef LOAD_AVE_TYPE - -#ifndef LINUX_LDAV_FILE -#define LINUX_LDAV_FILE "/proc/loadavg" -#endif - - char ldavgbuf[40]; - double load_ave[3]; - int fd, count; - - fd = open (LINUX_LDAV_FILE, O_RDONLY); - if (fd == -1) - return -1; - count = read (fd, ldavgbuf, 40); - (void) close (fd); - if (count <= 0) - return -1; - - count = sscanf (ldavgbuf, "%lf %lf %lf", - &load_ave[0], &load_ave[1], &load_ave[2]); - if (count < 1) - return -1; - - for (elem = 0; elem < nelem && elem < count; elem++) - loadavg[elem] = load_ave[elem]; -#endif /* __linux__ */ - -#if !defined (LDAV_DONE) && defined (__NetBSD__) || defined (__OpenBSD__) -#define LDAV_DONE -#undef LOAD_AVE_TYPE - -#ifndef NETBSD_LDAV_FILE -#define NETBSD_LDAV_FILE "/kern/loadavg" -#endif - - unsigned long int load_ave[3], scale; - int count; - FILE *fp; - - fp = fopen (NETBSD_LDAV_FILE, "r"); - if (fp == NULL) - return -1; - count = fscanf (fp, "%lu %lu %lu %lu\n", - &load_ave[0], &load_ave[1], &load_ave[2], - &scale); - (void) fclose (fp); - if (count != 4) - return -1; - - for (elem = 0; elem < nelem; elem++) - loadavg[elem] = (double) load_ave[elem] / (double) scale; -#endif /* __NetBSD__ or __OpenBSD__ */ - -#if !defined (LDAV_DONE) && defined (NeXT) -#define LDAV_DONE - /* The NeXT code was adapted from iscreen 3.2. */ - - host_t host; - struct processor_set_basic_info info; - unsigned info_count; - - /* We only know how to get the 1-minute average for this system, - so even if the caller asks for more than 1, we only return 1. */ - - if (!getloadavg_initialized) - { - if (processor_set_default (host_self (), &default_set) == KERN_SUCCESS) - getloadavg_initialized = 1; - } - - if (getloadavg_initialized) - { - info_count = PROCESSOR_SET_BASIC_INFO_COUNT; - if (processor_set_info (default_set, PROCESSOR_SET_BASIC_INFO, &host, - (processor_set_info_t) &info, &info_count) - != KERN_SUCCESS) - getloadavg_initialized = 0; - else - { - if (nelem > 0) - loadavg[elem++] = (double) info.load_average / LOAD_SCALE; - } - } - - if (!getloadavg_initialized) - return -1; -#endif /* NeXT */ - -#if !defined (LDAV_DONE) && defined (UMAX) -#define LDAV_DONE -/* UMAX 4.2, which runs on the Encore Multimax multiprocessor, does not - have a /dev/kmem. Information about the workings of the running kernel - can be gathered with inq_stats system calls. - We only know how to get the 1-minute average for this system. */ - - struct proc_summary proc_sum_data; - struct stat_descr proc_info; - double load; - REGISTER unsigned int i, j; - - if (cpus == 0) - { - REGISTER unsigned int c, i; - struct cpu_config conf; - struct stat_descr desc; - - desc.sd_next = 0; - desc.sd_subsys = SUBSYS_CPU; - desc.sd_type = CPUTYPE_CONFIG; - desc.sd_addr = (char *) &conf; - desc.sd_size = sizeof conf; - - if (inq_stats (1, &desc)) - return -1; - - c = 0; - for (i = 0; i < conf.config_maxclass; ++i) - { - struct class_stats stats; - memset ((char *) &stats, 0, sizeof stats); - - desc.sd_type = CPUTYPE_CLASS; - desc.sd_objid = i; - desc.sd_addr = (char *) &stats; - desc.sd_size = sizeof stats; - - if (inq_stats (1, &desc)) - return -1; - - c += stats.class_numcpus; - } - cpus = c; - samples = cpus < 2 ? 3 : (2 * cpus / 3); - } - - proc_info.sd_next = 0; - proc_info.sd_subsys = SUBSYS_PROC; - proc_info.sd_type = PROCTYPE_SUMMARY; - proc_info.sd_addr = (char *) &proc_sum_data; - proc_info.sd_size = sizeof (struct proc_summary); - proc_info.sd_sizeused = 0; - - if (inq_stats (1, &proc_info) != 0) - return -1; - - load = proc_sum_data.ps_nrunnable; - j = 0; - for (i = samples - 1; i > 0; --i) - { - load += proc_sum_data.ps_nrun[j]; - if (j++ == PS_NRUNSIZE) - j = 0; - } - - if (nelem > 0) - loadavg[elem++] = load / samples / cpus; -#endif /* UMAX */ - -#if !defined (LDAV_DONE) && defined (DGUX) -#define LDAV_DONE - /* This call can return -1 for an error, but with good args - it's not supposed to fail. The first argument is for no - apparent reason of type `long int *'. */ - dg_sys_info ((long int *) &load_info, - DG_SYS_INFO_LOAD_INFO_TYPE, - DG_SYS_INFO_LOAD_VERSION_0); - - if (nelem > 0) - loadavg[elem++] = load_info.one_minute; - if (nelem > 1) - loadavg[elem++] = load_info.five_minute; - if (nelem > 2) - loadavg[elem++] = load_info.fifteen_minute; -#endif /* DGUX */ - -#if !defined (LDAV_DONE) && defined (apollo) -#define LDAV_DONE -/* Apollo code from lisch@mentorg.com (Ray Lischner). - - This system call is not documented. The load average is obtained as - three long integers, for the load average over the past minute, - five minutes, and fifteen minutes. Each value is a scaled integer, - with 16 bits of integer part and 16 bits of fraction part. - - I'm not sure which operating system first supported this system call, - but I know that SR10.2 supports it. */ - - extern void proc1_$get_loadav (); - unsigned long load_ave[3]; - - proc1_$get_loadav (load_ave); - - if (nelem > 0) - loadavg[elem++] = load_ave[0] / 65536.0; - if (nelem > 1) - loadavg[elem++] = load_ave[1] / 65536.0; - if (nelem > 2) - loadavg[elem++] = load_ave[2] / 65536.0; -#endif /* apollo */ - -#if !defined (LDAV_DONE) && defined (OSF_MIPS) -#define LDAV_DONE - - struct tbl_loadavg load_ave; - table (TBL_LOADAVG, 0, &load_ave, 1, sizeof (load_ave)); - loadavg[elem++] - = (load_ave.tl_lscale == 0 - ? load_ave.tl_avenrun.d[0] - : (load_ave.tl_avenrun.l[0] / (double) load_ave.tl_lscale)); -#endif /* OSF_MIPS */ - -#if !defined (LDAV_DONE) && (defined (MSDOS) || defined (WIN32)) -#define LDAV_DONE - - /* A faithful emulation is going to have to be saved for a rainy day. */ - for ( ; elem < nelem; elem++) - { - loadavg[elem] = 0.0; - } -#endif /* MSDOS */ - -#if !defined (LDAV_DONE) && defined (OSF_ALPHA) -#define LDAV_DONE - - struct tbl_loadavg load_ave; - table (TBL_LOADAVG, 0, &load_ave, 1, sizeof (load_ave)); - for (elem = 0; elem < nelem; elem++) - loadavg[elem] - = (load_ave.tl_lscale == 0 - ? load_ave.tl_avenrun.d[elem] - : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); -#endif /* OSF_ALPHA */ - -#if !defined (LDAV_DONE) && defined(LOAD_AVE_TYPE) - - /* UNIX-specific code -- read the average from /dev/kmem. */ - -#define LDAV_PRIVILEGED /* This code requires special installation. */ - - LOAD_AVE_TYPE load_ave[3]; - - /* Get the address of LDAV_SYMBOL. */ - if (offset == 0) - { -#ifndef sgi -#ifndef NLIST_STRUCT - strcpy (nl[0].n_name, LDAV_SYMBOL); - strcpy (nl[1].n_name, ""); -#else /* NLIST_STRUCT */ -#ifdef NLIST_NAME_UNION - nl[0].n_un.n_name = LDAV_SYMBOL; - nl[1].n_un.n_name = 0; -#else /* not NLIST_NAME_UNION */ - nl[0].n_name = (char *) LDAV_SYMBOL; - nl[1].n_name = 0; -#endif /* not NLIST_NAME_UNION */ -#endif /* NLIST_STRUCT */ - -#ifndef SUNOS_5 - if ( -#if !(defined (_AIX) && !defined (ps2)) - nlist (KERNEL_FILE, nl) -#else /* _AIX */ - knlist (nl, 1, sizeof (nl[0])) -#endif - >= 0) - /* Omit "&& nl[0].n_type != 0 " -- it breaks on Sun386i. */ - { -#ifdef FIXUP_KERNEL_SYMBOL_ADDR - FIXUP_KERNEL_SYMBOL_ADDR (nl); -#endif - offset = nl[0].n_value; - } -#endif /* !SUNOS_5 */ -#else /* sgi */ - int ldav_off; - - ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); - if (ldav_off != -1) - offset = (long) ldav_off & 0x7fffffff; -#endif /* sgi */ - } - - /* Make sure we have /dev/kmem open. */ - if (!getloadavg_initialized) - { -#ifndef SUNOS_5 - channel = open ("/dev/kmem", 0); - if (channel >= 0) - { - /* Set the channel to close on exec, so it does not - litter any child's descriptor table. */ -#ifdef FD_SETFD -#ifndef FD_CLOEXEC -#define FD_CLOEXEC 1 -#endif - (void) fcntl (channel, F_SETFD, FD_CLOEXEC); -#endif - getloadavg_initialized = 1; - } -#else /* SUNOS_5 */ - /* We pass 0 for the kernel, corefile, and swapfile names - to use the currently running kernel. */ - kd = kvm_open (0, 0, 0, O_RDONLY, 0); - if (kd != 0) - { - /* nlist the currently running kernel. */ - kvm_nlist (kd, nl); - offset = nl[0].n_value; - getloadavg_initialized = 1; - } -#endif /* SUNOS_5 */ - } - - /* If we can, get the load average values. */ - if (offset && getloadavg_initialized) - { - /* Try to read the load. */ -#ifndef SUNOS_5 - if (lseek (channel, offset, 0) == -1L - || read (channel, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) - { - close (channel); - getloadavg_initialized = 0; - } -#else /* SUNOS_5 */ - if (kvm_read (kd, offset, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) - { - kvm_close (kd); - getloadavg_initialized = 0; - } -#endif /* SUNOS_5 */ - } - - if (offset == 0 || !getloadavg_initialized) - return -1; - - if (nelem > 0) - loadavg[elem++] = LDAV_CVT (load_ave[0]); - if (nelem > 1) - loadavg[elem++] = LDAV_CVT (load_ave[1]); - if (nelem > 2) - loadavg[elem++] = LDAV_CVT (load_ave[2]); - -#define LDAV_DONE -#endif /* !LDAV_DONE && LOAD_AVE_TYPE */ - - return elem; -} - -#endif /* ! HAVE_GETLOADAVG */ - -#ifdef TEST -void -main (int argc, char **argv) -{ - int naptime = 0; - - if (argc > 1) - naptime = atoi (argv[1]); - - while (1) - { - double avg[3]; - int loads; - - errno = 0; /* Don't be misled if it doesn't set errno. */ - loads = getloadavg (avg, 3); - if (loads == -1) - { - perror ("Error getting load average"); - exit (1); - } - if (loads > 0) - printf ("1-minute: %f ", avg[0]); - if (loads > 1) - printf ("5-minute: %f ", avg[1]); - if (loads > 2) - printf ("15-minute: %f ", avg[2]); - if (loads > 0) - putchar ('\n'); - - if (naptime == 0) - break; - sleep (naptime); - } - - exit (0); -} -#endif /* TEST */ - -#else - -/* Emulate getloadavg. */ -int -getloadavg (double loadavg[], int nelem) -{ - int i; - - /* A faithful emulation is going to have to be saved for a rainy day. */ - for (i = 0; i < nelem; i++) - { - loadavg[i] = 0.0; - } - return i; -} - -#endif /*__GNUWIN32__*/ - diff --git a/src/getpagesize.h b/src/getpagesize.h deleted file mode 100644 index afef122..0000000 --- a/src/getpagesize.h +++ /dev/null @@ -1,66 +0,0 @@ -/* 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. */ - -/* Emulate getpagesize on systems that lack it. */ - -#if 0 -#ifdef __hpux -#include -static size_t getpagesize() { return( 4096 ); } -#define HAVE_GETPAGESIZE -#endif -#endif - -#ifndef HAVE_GETPAGESIZE - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef _SC_PAGESIZE -#define getpagesize() sysconf(_SC_PAGESIZE) -#else - -#include - -#ifdef EXEC_PAGESIZE -#define getpagesize() EXEC_PAGESIZE -#else -#ifdef NBPG -#define getpagesize() NBPG * CLSIZE -#ifndef CLSIZE -#define CLSIZE 1 -#endif /* no CLSIZE */ -#else /* no NBPG */ -#if (defined (sparc) && defined (USG)) || defined (SOLARIS2) -#define getpagesize() PAGESIZE -#else /* not Solaris 2 */ -#ifdef NBPC -#define getpagesize() NBPC -#else /* no NBPC */ -#ifdef PAGESIZE -#define getpagesize() PAGESIZE -#endif -#endif /* NBPC */ -#endif /* not Solaris 2 */ -#endif /* no NBPG */ -#endif /* no EXEC_PAGESIZE */ -#endif /* _SC_PAGESIZE */ -#endif /* not HAVE_GETPAGESIZE */ - diff --git a/src/gif_io.c b/src/gif_io.c deleted file mode 100644 index ddbfb16..0000000 --- a/src/gif_io.c +++ /dev/null @@ -1,259 +0,0 @@ -#include -#include -#include -#include -#include "gifrlib.h" - -/****************************************************************************** -* Set up the GifFileType structure for use. This must be called first in any * -* client program. Then, if custom IO or Error functions are desired, call * -* GifSetIOFunc/GifSetErrorFunc, then call EGifInitWrite. Else call * -* EGifOpenFileName or EGifOpenFileHandle for standard IO functions. * -* If setup fails, a NULL pointer is returned. * -******************************************************************************/ -GifFileType *GifSetup(void) -{ - GifIODataType *GifIO; - GifFileType *GifFile; - - if ((GifFile = (GifFileType *) malloc(sizeof(GifFileType))) == NULL) - return NULL; - memset(GifFile, '\0', sizeof(GifFileType)); - if ((GifIO = (GifIODataType *) malloc(sizeof(GifIODataType))) == NULL) { - free((char *) GifFile); - return NULL; - } - memset(GifIO, '\0', sizeof(GifIODataType)); - GifFile->GifIO = GifIO; - return GifFile; -} - -void GifFree(GifFileType *GifFile) -{ - GifFilePrivateType *Private; - - if (GifFile == NULL) return; - - Private = (GifFilePrivateType *) GifFile->Private; - - if (GifFile->SavedImages) - FreeSavedImages(GifFile); - if (GifFile->Image.ColorMap) - FreeMapObject(GifFile->Image.ColorMap); - if (GifFile->SColorMap) - FreeMapObject(GifFile->SColorMap); - if (Private) - { - free(Private); - } - if (GifFile->GifIO) - free(GifFile->GifIO); - free(GifFile); -} - -/**************************************************************************** -* Install the specified ReadFunction into the GifFile specified. * -****************************************************************************/ -void GifSetReadFunc(GifFileType *GifFile, Gif_rw_func ReadFunc, VoidPtr data) -{ - GifIODataType *GifIO = (GifIODataType *)GifFile->GifIO; - GifIO->ReadFunc = ReadFunc; - GifIO->ReadFunc_data = data; -} - -/**************************************************************************** -* Install the specified WriteFunction into the GifFile specified. * -****************************************************************************/ -void GifSetWriteFunc(GifFileType *GifFile, Gif_rw_func WriteFunc, VoidPtr data) -{ - GifIODataType *GifIO = (GifIODataType *)GifFile->GifIO; - GifIO->WriteFunc = WriteFunc; - GifIO->WriteFunc_data = data; -} - -/**************************************************************************** -* Install the specified CloseFunction into the GifFile specified. * -****************************************************************************/ -void GifSetCloseFunc(GifFileType *GifFile, Gif_close_func CloseFunc, VoidPtr data) -{ - GifIODataType *GifIO = (GifIODataType *)GifFile->GifIO; - GifIO->CloseFunc = CloseFunc; - GifIO->CloseFunc_data = data; -} - -/**************************************************************************** -* Install the standard IO funcs into the GifFile, including the FILE info * -****************************************************************************/ -void GifStdIOInit(GifFileType *GifFile, FILE *file, int filehandle) -{ - GifStdIODataType *IOData; - - if ((IOData = (GifStdIODataType*)malloc(sizeof(GifStdIODataType))) == NULL) - GifInternError(GifFile, GIF_ERR_NOT_ENOUGH_MEM); - IOData->File = file; - IOData->FileHandle = filehandle; - GifSetReadFunc(GifFile, GifStdRead, IOData); - GifSetWriteFunc(GifFile, GifStdWrite, IOData); - GifSetCloseFunc(GifFile, GifStdFileClose, IOData); -} - -size_t GifStdRead(GifByteType *buf, size_t size, VoidPtr method_data) -{ - GifStdIODataType *IOtype = (GifStdIODataType*)method_data; - return (fread(buf, 1, size, IOtype->File)); -} - -size_t GifStdWrite(GifByteType *buf, size_t size, VoidPtr method_data) -{ - GifStdIODataType *IOtype = (GifStdIODataType*)method_data; - return (fwrite(buf, 1, size, IOtype->File)); -} - -int GifStdFileClose(VoidPtr method_data) -{ - int ret; - GifStdIODataType *IOtype = (GifStdIODataType*)method_data; - ret = fclose(IOtype->File); - if (ret == 0 && IOtype->FileHandle != -1) - ret = close(IOtype->FileHandle); - return ret; -} - -void GifRead(GifByteType *buf, size_t size, GifFileType *GifFile) -{ - GifIODataType *GifIO = (GifIODataType*)GifFile->GifIO; - if ((*(GifIO->ReadFunc))(buf, size, GifIO->ReadFunc_data) != size) - GifError(GifFile, "Read error!"); -} - -void GifWrite(GifByteType *buf, size_t size, GifFileType *GifFile) -{ - GifIODataType *GifIO = (GifIODataType*)GifFile->GifIO; - if ((*(GifIO->WriteFunc))(buf, size, GifIO->WriteFunc_data) != size) - GifError(GifFile, "Write error!"); -} - -int GifClose(GifFileType *GifFile) -{ - GifIODataType *GifIO = (GifIODataType*)GifFile->GifIO; - return ((*(GifIO->CloseFunc))(GifIO->CloseFunc_data)); -} - -static char *GifErrorString[14] = { - "Failed to open given file", /* D_GIF_ERR_OPEN_FAILED */ - "Failed to read from given file", /* D_GIF_ERR_READ_FAILED */ - "Given file is NOT a GIF file", /* D_GIF_ERR_NOT_GIF_FILE */ - "No Screen Descriptor detected", /* D_GIF_ERR_NO_SCRN_DSCR */ - "No Image Descriptor detected", /* D_GIF_ERR_NO_IMAG_DSCR */ - "No global or local color map", /* D_GIF_ERR_NO_COLOR_MAP */ - "Wrong record type detected", /* D_GIF_ERR_WRONG_RECORD */ - "#Pixels bigger than Width * Height", /* D_GIF_ERR_DATA_TOO_BIG */ - "Fail to allocate required memory", /* D_GIF_ERR_NOT_ENOUGH_MEM */ - "Failed to close given file", /* D_GIF_ERR_CLOSE_FAILED */ - "Given file was not opened for read", /* D_GIF_ERR_CLOSE_FAILED */ - "Image is defective, decoding aborted", /* D_GIF_ERR_IMAGE_DEFECT */ - "Image EOF detected before image complete", /* D_GIF_ERR_EOF_TOO_SOON */ - "Undefined error!", -}; - -const char *GetGifError(int error); - -/***************************************************************************** -* Get the last GIF error in human-readable form. * -*****************************************************************************/ -const char *GetGifError(int error) -{ - char *Err; - - switch(error) { - case D_GIF_ERR_OPEN_FAILED: - Err = GifErrorString[0]; - break; - case D_GIF_ERR_READ_FAILED: - Err = GifErrorString[1]; - break; - case D_GIF_ERR_NOT_GIF_FILE: - Err = GifErrorString[2]; - break; - case D_GIF_ERR_NO_SCRN_DSCR: - Err = GifErrorString[3]; - break; - case D_GIF_ERR_NO_IMAG_DSCR: - Err = GifErrorString[4]; - break; - case D_GIF_ERR_NO_COLOR_MAP: - Err = GifErrorString[5]; - break; - case D_GIF_ERR_WRONG_RECORD: - Err = GifErrorString[6]; - break; - case D_GIF_ERR_DATA_TOO_BIG: - Err = GifErrorString[7]; - break; - case D_GIF_ERR_NOT_ENOUGH_MEM: - Err = GifErrorString[8]; - break; - case D_GIF_ERR_CLOSE_FAILED: - Err = GifErrorString[9]; - break; - case D_GIF_ERR_NOT_READABLE: - Err = GifErrorString[10]; - break; - case D_GIF_ERR_IMAGE_DEFECT: - Err = GifErrorString[11]; - break; - case D_GIF_ERR_EOF_TOO_SOON: - Err = GifErrorString[12]; - break; - default: - Err = GifErrorString[13]; - break; - } - return Err; -} - -/****************************** -* These are called internally * -******************************/ -void GifError(GifFileType *GifFile, const char *err_str) -{ - GifIODataType *GifIO = (GifIODataType*)GifFile->GifIO; - if (GifIO->ErrorFunc) - (*(GifIO->ErrorFunc))(err_str, GifIO->ErrorFunc_data); - else - fprintf(stderr, "GIF FATAL ERROR: %s", err_str); - exit(-10); -} - -void GifWarning(GifFileType *GifFile, const char *err_str) -{ - GifIODataType *GifIO = (GifIODataType*)GifFile->GifIO; - if (GifIO->WarningFunc) - (*(GifIO->WarningFunc))(err_str, GifIO->WarningFunc_data); -} - -void GifInternError(GifFileType *GifFile, int error_num) -{ - const char *ErrStr = GetGifError(error_num); - GifError(GifFile, ErrStr); -} - -void GifInternWarning(GifFileType *GifFile, int error_num) -{ - const char *ErrStr = GetGifError(error_num); - GifWarning(GifFile, ErrStr); -} - -void GifSetErrorFunc(GifFileType *GifFile, Gif_error_func ErrorFunc, VoidPtr data) -{ - GifIODataType *GifIO = (GifIODataType *)GifFile->GifIO; - GifIO->ErrorFunc = ErrorFunc; - GifIO->ErrorFunc_data = data; -} - -void GifSetWarningFunc(GifFileType *GifFile, Gif_error_func WarningFunc, VoidPtr data) -{ - GifIODataType *GifIO = (GifIODataType *)GifFile->GifIO; - GifIO->WarningFunc = WarningFunc; - GifIO->WarningFunc_data = data; -} diff --git a/src/gifrlib.h b/src/gifrlib.h deleted file mode 100644 index 7532001..0000000 --- a/src/gifrlib.h +++ /dev/null @@ -1,268 +0,0 @@ -/****************************************************************************** -* In order to make life a little bit easier when using the GIF file format, * -* this library was written, and which does all the dirty work... * -* * -* Written by Gershon Elber, Jun. 1989 * -* Hacks by Eric S. Raymond, Sep. 1992 * -* and Jareth Hein, Jan. 1998 * -******************************************************************************* -* History: * -* 14 Jun 89 - Version 1.0 by Gershon Elber. * -* 3 Sep 90 - Version 1.1 by Gershon Elber (Support for Gif89, Unique names). * -* 15 Sep 90 - Version 2.0 by Eric S. Raymond (Changes to suoport GIF slurp) * -* 26 Jun 96 - Version 3.0 by Eric S. Raymond (Full GIF89 support) * -* 19 Jan 98 - Version 3.1 by Jareth Hein (Support for user-defined I/O). * -******************************************************************************/ - -#ifndef GIF_LIB_H -#define GIF_LIB_H - -#define GIF_ERROR 0 -#define GIF_OK 1 - -#ifndef TRUE -#define TRUE 1 -#define FALSE 0 -#endif - -#ifndef NULL -#define NULL 0 -#endif /* NULL */ - -#define GIF_FILE_BUFFER_SIZE 16384 /* Files uses bigger buffers than usual. */ - -typedef int GifBooleanType; -typedef unsigned char GifPixelType; -typedef unsigned char * GifRowType; -typedef unsigned char GifByteType; - -#define VoidPtr void * - -typedef struct GifColorType { - GifByteType Red, Green, Blue; -} GifColorType; - -typedef struct ColorMapObject -{ - int ColorCount; - int BitsPerPixel; - GifColorType *Colors; /* on malloc(3) heap */ -} -ColorMapObject; - -typedef struct GifImageDesc { - int Left, Top, Width, Height, /* Current image dimensions. */ - Interlace; /* Sequential/Interlaced lines. */ - ColorMapObject *ColorMap; /* The local color map */ -} GifImageDesc; - -/* I/O operations. If you roll your own, they need to be semantically equivilent to - fread/fwrite, with an additional paramater to hold data local to your method. */ -typedef size_t (*Gif_rw_func)(GifByteType *buffer, size_t size, VoidPtr method_data); -/* Finish up stream. Non-zero return indicates failure */ -typedef int (*Gif_close_func)(VoidPtr close_data); -/* Error handling function */ -typedef void (*Gif_error_func)(const char *string, VoidPtr error_data); - -typedef struct GifFileType { - int SWidth, SHeight, /* Screen dimensions. */ - SColorResolution, /* How many colors can we generate? */ - SBackGroundColor; /* I hope you understand this one... */ - ColorMapObject *SColorMap; /* NULL if it doesn't exist. */ - int ImageCount; /* Number of current image */ - GifImageDesc Image; /* Block describing current image */ - struct SavedImage *SavedImages; /* Use this to accumulate file state */ - VoidPtr Private; /* Don't mess with this! */ - VoidPtr GifIO; /* Contains all information for I/O */ -} GifFileType; - -typedef enum { - UNDEFINED_RECORD_TYPE, - SCREEN_DESC_RECORD_TYPE, - IMAGE_DESC_RECORD_TYPE, /* Begin with ',' */ - EXTENSION_RECORD_TYPE, /* Begin with '!' */ - TERMINATE_RECORD_TYPE /* Begin with ';' */ -} GifRecordType; - -/****************************************************************************** -* GIF89 extension function codes * -******************************************************************************/ - -#define COMMENT_EXT_FUNC_CODE 0xfe /* comment */ -#define GRAPHICS_EXT_FUNC_CODE 0xf9 /* graphics control */ -#define PLAINTEXT_EXT_FUNC_CODE 0x01 /* plaintext */ -#define APPLICATION_EXT_FUNC_CODE 0xff /* application block */ - -/****************************************************************************** -* IO related routines. Defined in gif_io.c * -******************************************************************************/ -GifFileType *GifSetup(void); -void GifFree(GifFileType *GifFile); -void GifSetReadFunc (GifFileType *GifFile, Gif_rw_func func, VoidPtr data); -void GifSetWriteFunc(GifFileType *GifFile, Gif_rw_func func, VoidPtr data); -void GifSetCloseFunc(GifFileType *GifFile, Gif_close_func func, VoidPtr data); - -/****************************************************************************** -* O.K., here are the routines one can access in order to decode GIF file: * -******************************************************************************/ - -void DGifOpenFileName(GifFileType *GifFile, const char *GifFileName); -void DGifOpenFileHandle(GifFileType *GifFile, int GifFileHandle); -void DGifInitRead(GifFileType *GifFile); -void DGifSlurp(GifFileType *GifFile); -void DGifGetScreenDesc(GifFileType *GifFile); -void DGifGetRecordType(GifFileType *GifFile, GifRecordType *GifType); -void DGifGetImageDesc(GifFileType *GifFile); -void DGifGetLine(GifFileType *GifFile, GifPixelType *GifLine, int GifLineLen); -void DGifGetPixel(GifFileType *GifFile, GifPixelType GifPixel); -void DGifGetComment(GifFileType *GifFile, char *GifComment); -void DGifGetExtension(GifFileType *GifFile, int *GifExtCode, - GifByteType **GifExtension); -void DGifGetExtensionNext(GifFileType *GifFile, GifByteType **GifExtension); -void DGifGetCode(GifFileType *GifFile, int *GifCodeSize, - GifByteType **GifCodeBlock); -void DGifGetCodeNext(GifFileType *GifFile, GifByteType **GifCodeBlock); -void DGifGetLZCodes(GifFileType *GifFile, int *GifCode); -int DGifCloseFile(GifFileType *GifFile); - -#define D_GIF_ERR_OPEN_FAILED 101 /* And DGif possible errors. */ -#define D_GIF_ERR_READ_FAILED 102 -#define D_GIF_ERR_NOT_GIF_FILE 103 -#define D_GIF_ERR_NO_SCRN_DSCR 104 -#define D_GIF_ERR_NO_IMAG_DSCR 105 -#define D_GIF_ERR_NO_COLOR_MAP 106 -#define D_GIF_ERR_WRONG_RECORD 107 -#define D_GIF_ERR_DATA_TOO_BIG 108 -#define GIF_ERR_NOT_ENOUGH_MEM 109 -#define D_GIF_ERR_NOT_ENOUGH_MEM 109 -#define D_GIF_ERR_CLOSE_FAILED 110 -#define D_GIF_ERR_NOT_READABLE 111 -#define D_GIF_ERR_IMAGE_DEFECT 112 -#define D_GIF_ERR_EOF_TOO_SOON 113 - -/****************************************************************************** -* O.K., here are the error routines * -******************************************************************************/ -extern void GifSetErrorFunc(GifFileType *GifFile, Gif_error_func func, VoidPtr data); -extern void GifSetWarningFunc(GifFileType *GifFile, Gif_error_func func, VoidPtr data); -extern void GifInternError(GifFileType *GifFile, int errnum); -extern void GifInternWarning(GifFileType *GifFile, int errnum); -extern void GifError(GifFileType *GifFile, const char *err_str); -extern void GifWarning(GifFileType *GifFile, const char *err_str); - -/***************************************************************************** - * - * Everything below this point is new after version 1.2, supporting `slurp - * mode' for doing I/O in two big belts with all the image-bashing in core. - * - *****************************************************************************/ - -/****************************************************************************** -* Support for the in-core structures allocation (slurp mode). * -******************************************************************************/ - -/* This is the in-core version of an extension record */ -typedef struct { - int ByteCount; - GifByteType *Bytes; /* on malloc(3) heap */ -} ExtensionBlock; - -/* This holds an image header, its unpacked raster bits, and extensions */ -typedef struct SavedImage { - GifImageDesc ImageDesc; - - GifPixelType *RasterBits; /* on malloc(3) heap */ - - int Function; - int ExtensionBlockCount; - ExtensionBlock *ExtensionBlocks; /* on malloc(3) heap */ -} SavedImage; - -extern void ApplyTranslation(SavedImage *Image, GifPixelType Translation[]); - -extern void MakeExtension(SavedImage *New, int Function); -extern int AddExtensionBlock(SavedImage *New, int Length, GifByteType *data); -extern void FreeExtension(SavedImage *Image); - -extern SavedImage *MakeSavedImage(GifFileType *GifFile, SavedImage *CopyFrom); -extern void FreeSavedImages(GifFileType *GifFile); - -/* Common defines used by encode/decode functions */ - -#define COMMENT_EXT_FUNC_CODE 0xfe /* Extension function code for comment. */ -#define GIF_STAMP "GIFVER" /* First chars in file - GIF stamp. */ -#define GIF_STAMP_LEN sizeof(GIF_STAMP) - 1 -#define GIF_VERSION_POS 3 /* Version first character in stamp. */ -#define GIF87_STAMP "GIF87a" /* First chars in file - GIF stamp. */ -#define GIF89_STAMP "GIF89a" /* First chars in file - GIF stamp. */ - -#define LZ_MAX_CODE 4095 /* Biggest code possible in 12 bits. */ -#define LZ_BITS 12 - -#define FILE_STATE_READ 0x01 -#define FILE_STATE_WRITE 0x01 -#define FILE_STATE_SCREEN 0x02 -#define FILE_STATE_IMAGE 0x04 - -#define FLUSH_OUTPUT 4096 /* Impossible code, to signal flush. */ -#define FIRST_CODE 4097 /* Impossible code, to signal first. */ -#define NO_SUCH_CODE 4098 /* Impossible code, to signal empty. */ - -#define IS_READABLE(Private) (!(Private->FileState & FILE_STATE_READ)) -#define IS_WRITEABLE(Private) (Private->FileState & FILE_STATE_WRITE) - -typedef struct GifFilePrivateType { - int FileState, - BitsPerPixel, /* Bits per pixel (Codes uses at list this + 1). */ - ClearCode, /* The CLEAR LZ code. */ - EOFCode, /* The EOF LZ code. */ - RunningCode, /* The next code algorithm can generate. */ - RunningBits,/* The number of bits required to represent RunningCode. */ - MaxCode1, /* 1 bigger than max. possible code, in RunningBits bits. */ - LastCode, /* The code before the current code. */ - CrntCode, /* Current algorithm code. */ - StackPtr, /* For character stack (see below). */ - CrntShiftState; /* Number of bits in CrntShiftDWord. */ - unsigned long CrntShiftDWord; /* For bytes decomposition into codes. */ - unsigned long PixelCount; /* Number of pixels in image. */ - GifByteType Buf[256]; /* Compressed input is buffered here. */ - GifByteType Stack[LZ_MAX_CODE]; /* Decoded pixels are stacked here. */ - GifByteType Suffix[LZ_MAX_CODE+1]; /* So we can trace the codes. */ - unsigned int Prefix[LZ_MAX_CODE+1]; -} GifFilePrivateType; - -typedef struct GifIODataType { - Gif_rw_func ReadFunc, WriteFunc; /* Pointers to the functions that will do the I/O */ - Gif_close_func CloseFunc; - VoidPtr ReadFunc_data; /* data to be passed to the read function */ - VoidPtr WriteFunc_data; /* data to be passed to the write function */ - VoidPtr CloseFunc_data; /* data to be passed to the close function */ - Gif_error_func ErrorFunc; /* MUST NOT RETURN (use lng_jmp or exit)! */ - Gif_error_func WarningFunc; /* For warning messages (can be ignored) */ - VoidPtr ErrorFunc_data; - VoidPtr WarningFunc_data; -} GifIODataType; - -typedef struct GifStdIODataType { - FILE *File; - int FileHandle; -} GifStdIODataType; - -/* Install StdIO funcs on FILE into GifFile */ -void GifStdIOInit(GifFileType *GifFile, FILE *file, int filehandle); - -/* Error checking reads, writes and closes */ -void GifRead(GifByteType *buf, size_t size, GifFileType *GifFile); -void GifWrite(GifByteType *buf, size_t size, GifFileType *GifFile); -int GifClose(GifFileType *GifFile); - -/* The default Read and Write functions for files */ -size_t GifStdRead(GifByteType *buf, size_t size, VoidPtr method_data); -size_t GifStdWrite(GifByteType *buf, size_t size, VoidPtr method_data); -int GifStdFileClose(VoidPtr method_data); - -ColorMapObject *MakeMapObject(int ColorCount, GifColorType *ColorMap); -void FreeMapObject(ColorMapObject *Object); - - -#endif /* GIF_LIB_H */ diff --git a/src/glyphs-eimage.c b/src/glyphs-eimage.c deleted file mode 100644 index 6b80c82..0000000 --- a/src/glyphs-eimage.c +++ /dev/null @@ -1,1364 +0,0 @@ -/* EImage-specific Lisp objects. - Copyright (C) 1993, 1994, 1998 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996 Ben Wing - Copyright (C) 1995 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. */ - -/* Original author: Jamie Zawinski for 19.8 - font-truename stuff added by Jamie Zawinski for 19.10 - subwindow support added by Chuck Thompson - additional XPM support added by Chuck Thompson - initial X-Face support added by Stig - rewritten/restructured by Ben Wing for 19.12/19.13 - GIF/JPEG support added by Ben Wing for 19.14 - PNG support added by Bill Perry for 19.14 - Improved GIF/JPEG support added by Bill Perry for 19.14 - Cleanup/simplification of error handling by Ben Wing for 19.14 - Pointer/icon overhaul, more restructuring by Ben Wing for 19.14 - GIF support changed to external Gifreader lib by Jareth Hein for 21.0 - Many changes for color work and optimizations by Jareth Hein for 21.0 - Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0 - TIFF code by Jareth Hein for 21.0 - Generalization for ms-windows by Andy Piper for 21.0 - TODO: - Convert images.el to C and stick it in here? - */ - -#include -#include "lisp.h" -#include "lstream.h" -#include "console.h" -#include "device.h" -#include "faces.h" -#include "glyphs.h" -#include "objects.h" - -#include "buffer.h" -#include "frame.h" -#include "opaque.h" - -#include "sysfile.h" - -#ifdef HAVE_PNG -#ifdef __cplusplus -extern "C" { -#endif -#include -#ifdef __cplusplus -} -#endif -#else -#include -#endif -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -#ifdef HAVE_TIFF -DEFINE_IMAGE_INSTANTIATOR_FORMAT (tiff); -Lisp_Object Qtiff; -#endif - -#ifdef HAVE_JPEG -DEFINE_IMAGE_INSTANTIATOR_FORMAT (jpeg); -Lisp_Object Qjpeg; -#endif - -#ifdef HAVE_GIF -DEFINE_IMAGE_INSTANTIATOR_FORMAT (gif); -Lisp_Object Qgif; -#endif - -#ifdef HAVE_PNG -DEFINE_IMAGE_INSTANTIATOR_FORMAT (png); -Lisp_Object Qpng; -#endif - - -#ifdef HAVE_JPEG - -/********************************************************************** - * JPEG * - **********************************************************************/ - -#ifdef __cplusplus -extern "C" { -#endif -#include -#include -#ifdef __cplusplus -} -#endif - -/*#define USE_TEMP_FILES_FOR_JPEG_IMAGES 1*/ -static void -jpeg_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -static Lisp_Object -jpeg_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - return simple_image_type_normalize (inst, console_type, Qjpeg); -} - -static int -jpeg_possible_dest_types (void) -{ - return IMAGE_COLOR_PIXMAP_MASK; -} - -/* To survive the otherwise baffling complexity of making sure - everything gets cleaned up in the presence of an error, we - use an unwind_protect(). */ - -struct jpeg_unwind_data -{ - /* Stream that we need to close */ - FILE *instream; - /* Object that holds state info for JPEG decoding */ - struct jpeg_decompress_struct *cinfo_ptr; - /* EImage data */ - unsigned char *eimage; -}; - -static Lisp_Object -jpeg_instantiate_unwind (Lisp_Object unwind_obj) -{ - struct jpeg_unwind_data *data = - (struct jpeg_unwind_data *) get_opaque_ptr (unwind_obj); - - free_opaque_ptr (unwind_obj); - if (data->cinfo_ptr) - jpeg_destroy_decompress (data->cinfo_ptr); - - if (data->instream) - fclose (data->instream); - - if (data->eimage) xfree (data->eimage); - - return Qnil; -} - -/* - * ERROR HANDLING: - * - * The JPEG library's standard error handler (jerror.c) is divided into - * several "methods" which you can override individually. This lets you - * adjust the behavior without duplicating a lot of code, which you might - * have to update with each future release. - * - * Our example here shows how to override the "error_exit" method so that - * control is returned to the library's caller when a fatal error occurs, - * rather than calling exit() as the standard error_exit method does. - * - * We use C's setjmp/longjmp facility to return control. This means that the - * routine which calls the JPEG library must first execute a setjmp() call to - * establish the return point. We want the replacement error_exit to do a - * longjmp(). But we need to make the setjmp buffer accessible to the - * error_exit routine. To do this, we make a private extension of the - * standard JPEG error handler object. (If we were using C++, we'd say we - * were making a subclass of the regular error handler.) - * - * Here's the extended error handler struct: - */ - -struct my_jpeg_error_mgr -{ - struct jpeg_error_mgr pub; /* "public" fields */ - jmp_buf setjmp_buffer; /* for return to caller */ -}; - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(void) -#else -METHODDEF void -#endif -our_init_source (j_decompress_ptr cinfo) -{ -} - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(boolean) -#else -METHODDEF boolean -#endif -our_fill_input_buffer (j_decompress_ptr cinfo) -{ - /* Insert a fake EOI marker */ - struct jpeg_source_mgr *src = cinfo->src; - static JOCTET buffer[2]; - - buffer[0] = (JOCTET) 0xFF; - buffer[1] = (JOCTET) JPEG_EOI; - - src->next_input_byte = buffer; - src->bytes_in_buffer = 2; - return TRUE; -} - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(void) -#else -METHODDEF void -#endif -our_skip_input_data (j_decompress_ptr cinfo, long num_bytes) -{ - struct jpeg_source_mgr *src = NULL; - - src = (struct jpeg_source_mgr *) cinfo->src; - - if (!src) - { - return; - } else if (num_bytes > src->bytes_in_buffer) - { - ERREXIT(cinfo, JERR_INPUT_EOF); - /*NOTREACHED*/ - } - - src->bytes_in_buffer -= num_bytes; - src->next_input_byte += num_bytes; -} - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(void) -#else -METHODDEF void -#endif -our_term_source (j_decompress_ptr cinfo) -{ -} - -typedef struct -{ - struct jpeg_source_mgr pub; -} our_jpeg_source_mgr; - -static void -jpeg_memory_src (j_decompress_ptr cinfo, JOCTET *data, unsigned int len) -{ - struct jpeg_source_mgr *src; - - if (cinfo->src == NULL) - { /* first time for this JPEG object? */ - cinfo->src = (struct jpeg_source_mgr *) - (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT, - sizeof(our_jpeg_source_mgr)); - src = (struct jpeg_source_mgr *) cinfo->src; - src->next_input_byte = data; - } - src = (struct jpeg_source_mgr *) cinfo->src; - src->init_source = our_init_source; - src->fill_input_buffer = our_fill_input_buffer; - src->skip_input_data = our_skip_input_data; - src->resync_to_restart = jpeg_resync_to_restart; /* use default method */ - src->term_source = our_term_source; - src->bytes_in_buffer = len; - src->next_input_byte = data; -} - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(void) -#else -METHODDEF void -#endif -my_jpeg_error_exit (j_common_ptr cinfo) -{ - /* cinfo->err really points to a my_error_mgr struct, so coerce pointer */ - struct my_jpeg_error_mgr *myerr = (struct my_jpeg_error_mgr *) cinfo->err; - - /* Return control to the setjmp point */ - longjmp (myerr->setjmp_buffer, 1); -} - -#if defined(JPEG_LIB_VERSION) && (JPEG_LIB_VERSION >= 61) -METHODDEF(void) -#else -METHODDEF void -#endif -my_jpeg_output_message (j_common_ptr cinfo) -{ - char buffer[JMSG_LENGTH_MAX]; - - /* Create the message */ - (*cinfo->err->format_message) (cinfo, buffer); - warn_when_safe (Qjpeg, Qinfo, "%s", buffer); -} - -/* The code in this routine is based on example.c from the JPEG library - source code and from gif_instantiate() */ -static void -jpeg_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - /* It is OK for the unwind data to be local to this function, - because the unwind-protect is always executed when this - stack frame is still valid. */ - struct jpeg_unwind_data unwind; - int speccount = specpdl_depth (); - - /* This struct contains the JPEG decompression parameters and pointers to - * working space (which is allocated as needed by the JPEG library). - */ - struct jpeg_decompress_struct cinfo; - /* We use our private extension JPEG error handler. - * Note that this struct must live as long as the main JPEG parameter - * struct, to avoid dangling-pointer problems. - */ - struct my_jpeg_error_mgr jerr; - - /* Step -1: First record our unwind-protect, which will clean up after - any exit, normal or not */ - - xzero (unwind); - record_unwind_protect (jpeg_instantiate_unwind, make_opaque_ptr (&unwind)); - - /* Step 1: allocate and initialize JPEG decompression object */ - - /* We set up the normal JPEG error routines, then override error_exit. */ - cinfo.err = jpeg_std_error (&jerr.pub); - jerr.pub.error_exit = my_jpeg_error_exit; - jerr.pub.output_message = my_jpeg_output_message; - - /* Establish the setjmp return context for my_error_exit to use. */ - if (setjmp (jerr.setjmp_buffer)) - { - /* If we get here, the JPEG code has signaled an error. - * We need to clean up the JPEG object, close the input file, and return. - */ - - { - Lisp_Object errstring; - char buffer[JMSG_LENGTH_MAX]; - - /* Create the message */ - (*cinfo.err->format_message) ((j_common_ptr) &cinfo, buffer); - errstring = build_string (buffer); - - signal_image_error_2 ("JPEG decoding error", - errstring, instantiator); - } - } - - /* Now we can initialize the JPEG decompression object. */ - jpeg_create_decompress (&cinfo); - unwind.cinfo_ptr = &cinfo; - - /* Step 2: specify data source (eg, a file) */ - - { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST Extbyte *bytes; - Extcount len; - - /* #### This is a definite problem under Mule due to the amount of - stack data it might allocate. Need to be able to convert and - write out to a file. */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); - jpeg_memory_src (&cinfo, (JOCTET *) bytes, len); - } - - /* Step 3: read file parameters with jpeg_read_header() */ - - jpeg_read_header (&cinfo, TRUE); - /* We can ignore the return value from jpeg_read_header since - * (a) suspension is not possible with the stdio data source, and - * (b) we passed TRUE to reject a tables-only JPEG file as an error. - * See libjpeg.doc for more info. - */ - - { - int jpeg_gray = 0; /* if we're dealing with a grayscale */ - /* Step 4: set parameters for decompression. */ - - /* Now that we're using EImages, send all data as 24bit color. - The backend routine will take care of any necessary reductions. - We do have to handle the grayscale case ourselves, however. */ - if (cinfo.jpeg_color_space == JCS_GRAYSCALE) - { - cinfo.out_color_space = JCS_GRAYSCALE; - jpeg_gray = 1; - } - else - { - /* we're relying on the jpeg driver to do any other conversions, - or signal an error if the conversion isn't supported. */ - cinfo.out_color_space = JCS_RGB; - } - - /* Step 5: Start decompressor */ - jpeg_start_decompress (&cinfo); - - /* Step 6: Read in the data and put into EImage format (8bit RGB triples)*/ - - unwind.eimage = (unsigned char*) xmalloc (cinfo.output_width * cinfo.output_height * 3); - if (!unwind.eimage) - signal_image_error("Unable to allocate enough memory for image", instantiator); - - { - JSAMPARRAY row_buffer; /* Output row buffer */ - JSAMPLE *jp; - int row_stride; /* physical row width in output buffer */ - unsigned char *op = unwind.eimage; - - /* We may need to do some setup of our own at this point before reading - * the data. After jpeg_start_decompress() we have the correct scaled - * output image dimensions available - * We need to make an output work buffer of the right size. - */ - /* JSAMPLEs per row in output buffer. */ - row_stride = cinfo.output_width * cinfo.output_components; - /* Make a one-row-high sample array that will go away when done - with image */ - row_buffer = ((*cinfo.mem->alloc_sarray) - ((j_common_ptr) &cinfo, JPOOL_IMAGE, row_stride, 1)); - - /* Here we use the library's state variable cinfo.output_scanline as the - * loop counter, so that we don't have to keep track ourselves. - */ - while (cinfo.output_scanline < cinfo.output_height) - { - int i; - - /* jpeg_read_scanlines expects an array of pointers to scanlines. - * Here the array is only one element long, but you could ask for - * more than one scanline at a time if that's more convenient. - */ - (void) jpeg_read_scanlines (&cinfo, row_buffer, 1); - jp = row_buffer[0]; - for (i = 0; i < cinfo.output_width; i++) - { - int clr; - if (jpeg_gray) - { - unsigned char val; -#if (BITS_IN_JSAMPLE == 8) - val = (unsigned char)*jp++; -#else /* other option is 12 */ - val = (unsigned char)(*jp++ >> 4); -#endif - for (clr = 0; clr < 3; clr++) /* copy the same value into RGB */ - *op++ = val; - } - else - { - for (clr = 0; clr < 3; clr++) -#if (BITS_IN_JSAMPLE == 8) - *op++ = (unsigned char)*jp++; -#else /* other option is 12 */ - *op++ = (unsigned char)(*jp++ >> 4); -#endif - } - } - } - } - } - - /* Step 6.5: Create the pixmap and set up the image instance */ - /* now instantiate */ - MAYBE_DEVMETH (XDEVICE (ii->device), - init_image_instance_from_eimage, - (ii, cinfo.output_width, cinfo.output_height, - unwind.eimage, dest_mask, - instantiator, domain)); - - /* Step 7: Finish decompression */ - - jpeg_finish_decompress (&cinfo); - /* We can ignore the return value since suspension is not possible - * with the stdio data source. - */ - - /* And we're done! */ - /* This will clean up everything else. */ - unbind_to (speccount, Qnil); -} - -#endif /* HAVE_JPEG */ - -#ifdef HAVE_GIF -/********************************************************************** - * GIF * - **********************************************************************/ - -#include "gifrlib.h" - -static void -gif_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -static Lisp_Object -gif_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - return simple_image_type_normalize (inst, console_type, Qgif); -} - -static int -gif_possible_dest_types (void) -{ - return IMAGE_COLOR_PIXMAP_MASK; -} - -/* To survive the otherwise baffling complexity of making sure - everything gets cleaned up in the presence of an error, we - use an unwind_protect(). */ - -struct gif_unwind_data -{ - unsigned char *eimage; - /* Object that holds the decoded data from a GIF file */ - GifFileType *giffile; -}; - -static Lisp_Object -gif_instantiate_unwind (Lisp_Object unwind_obj) -{ - struct gif_unwind_data *data = - (struct gif_unwind_data *) get_opaque_ptr (unwind_obj); - - free_opaque_ptr (unwind_obj); - if (data->giffile) - { - DGifCloseFile (data->giffile); - GifFree(data->giffile); - } - if (data->eimage) xfree(data->eimage); - - return Qnil; -} - -typedef struct gif_memory_storage -{ - Extbyte *bytes; /* The data */ - Extcount len; /* How big is it? */ - int index; /* Where are we? */ -} gif_memory_storage; - -static size_t -gif_read_from_memory(GifByteType *buf, size_t size, VoidPtr data) -{ - gif_memory_storage *mem = (gif_memory_storage*)data; - - if (size > (mem->len - mem->index)) - return (size_t) -1; - memcpy(buf, mem->bytes + mem->index, size); - mem->index = mem->index + size; - return size; -} - -static int -gif_memory_close(VoidPtr data) -{ - return 0; -} - -struct gif_error_struct -{ - CONST char *err_str; /* return the error string */ - jmp_buf setjmp_buffer; /* for return to caller */ -}; - -static void -gif_error_func(CONST char *err_str, VoidPtr error_ptr) -{ - struct gif_error_struct *error_data = (struct gif_error_struct*)error_ptr; - - /* return to setjmp point */ - error_data->err_str = err_str; - longjmp (error_data->setjmp_buffer, 1); -} - -static void -gif_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - /* It is OK for the unwind data to be local to this function, - because the unwind-protect is always executed when this - stack frame is still valid. */ - struct gif_unwind_data unwind; - int speccount = specpdl_depth (); - gif_memory_storage mem_struct; - struct gif_error_struct gif_err; - Extbyte *bytes; - Extcount len; - int height = 0; - int width = 0; - - xzero (unwind); - record_unwind_protect (gif_instantiate_unwind, make_opaque_ptr (&unwind)); - - /* 1. Now decode the data. */ - - { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - - assert (!NILP (data)); - - if (!(unwind.giffile = GifSetup())) - signal_image_error ("Insufficent memory to instantiate GIF image", instantiator); - - /* set up error facilities */ - if (setjmp(gif_err.setjmp_buffer)) - { - /* An error was signaled. No clean up is needed, as unwind handles that - for us. Just pass the error along. */ - Lisp_Object errstring; - errstring = build_string (gif_err.err_str); - signal_image_error_2 ("GIF decoding error", errstring, instantiator); - } - GifSetErrorFunc(unwind.giffile, (Gif_error_func)gif_error_func, (VoidPtr)&gif_err); - - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); - mem_struct.bytes = bytes; - mem_struct.len = len; - mem_struct.index = 0; - GifSetReadFunc(unwind.giffile, gif_read_from_memory, (VoidPtr)&mem_struct); - GifSetCloseFunc(unwind.giffile, gif_memory_close, (VoidPtr)&mem_struct); - DGifInitRead(unwind.giffile); - - /* Then slurp the image into memory, decoding along the way. - The result is the image in a simple one-byte-per-pixel - format (#### the GIF routines only support 8-bit GIFs, - it appears). */ - DGifSlurp (unwind.giffile); - } - - /* 3. Now create the EImage */ - { - ColorMapObject *cmo = unwind.giffile->SColorMap; - int i, j, row, pass, interlace; - unsigned char *eip; - /* interlaced gifs have rows in this order: - 0, 8, 16, ..., 4, 12, 20, ..., 2, 6, 10, ..., 1, 3, 5, ... */ - static int InterlacedOffset[] = { 0, 4, 2, 1 }; - static int InterlacedJumps[] = { 8, 8, 4, 2 }; - - height = unwind.giffile->SHeight; - width = unwind.giffile->SWidth; - unwind.eimage = (unsigned char*) xmalloc (width * height * 3); - if (!unwind.eimage) - signal_image_error("Unable to allocate enough memory for image", instantiator); - - /* write the data in EImage format (8bit RGB triples) */ - - /* Note: We just use the first image in the file and ignore the rest. - We check here that that image covers the full "screen" size. - I don't know whether that's always the case. - -dkindred@cs.cmu.edu */ - if (unwind.giffile->SavedImages[0].ImageDesc.Height != height - || unwind.giffile->SavedImages[0].ImageDesc.Width != width - || unwind.giffile->SavedImages[0].ImageDesc.Left != 0 - || unwind.giffile->SavedImages[0].ImageDesc.Top != 0) - signal_image_error ("First image in GIF file is not full size", - instantiator); - - interlace = unwind.giffile->SavedImages[0].ImageDesc.Interlace; - pass = 0; - row = interlace ? InterlacedOffset[pass] : 0; - eip = unwind.eimage; - for (i = 0; i < height; i++) - { - if (interlace) - if (row >= height) { - row = InterlacedOffset[++pass]; - while (row >= height) - row = InterlacedOffset[++pass]; - } - eip = unwind.eimage + (row * width * 3); - for (j = 0; j < width; j++) - { - unsigned char pixel = unwind.giffile->SavedImages[0].RasterBits[(i * width) + j]; - *eip++ = cmo->Colors[pixel].Red; - *eip++ = cmo->Colors[pixel].Green; - *eip++ = cmo->Colors[pixel].Blue; - } - row += interlace ? InterlacedJumps[pass] : 1; - } - } - /* now instantiate */ - MAYBE_DEVMETH (XDEVICE (ii->device), - init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, - instantiator, domain)); - - unbind_to (speccount, Qnil); -} - -#endif /* HAVE_GIF */ - - -#ifdef HAVE_PNG - -/********************************************************************** - * PNG * - **********************************************************************/ -static void -png_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -static Lisp_Object -png_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - return simple_image_type_normalize (inst, console_type, Qpng); -} - -static int -png_possible_dest_types (void) -{ - return IMAGE_COLOR_PIXMAP_MASK; -} - -struct png_memory_storage -{ - CONST Extbyte *bytes; /* The data */ - Extcount len; /* How big is it? */ - int index; /* Where are we? */ -}; - -static void -png_read_from_memory(png_structp png_ptr, png_bytep data, - png_size_t length) -{ - struct png_memory_storage *tbr = - (struct png_memory_storage *) png_get_io_ptr (png_ptr); - - if (length > (tbr->len - tbr->index)) - png_error (png_ptr, (png_const_charp) "Read Error"); - memcpy (data,tbr->bytes + tbr->index,length); - tbr->index = tbr->index + length; -} - -struct png_error_struct -{ - CONST char *err_str; - jmp_buf setjmp_buffer; /* for return to caller */ -}; - -/* jh 98/03/12 - #### AARRRGH! libpng includes jmp_buf inside its own - structure, and there are cases where the size can be different from - between inside the library, and inside the code! To do an end run - around this, use our own error functions, and don't rely on things - passed in the png_ptr to them. This is an ugly hack and must - go away when the lisp engine is threaded! */ -static struct png_error_struct png_err_stct; - -static void -png_error_func (png_structp png_ptr, png_const_charp msg) -{ - png_err_stct.err_str = msg; - longjmp (png_err_stct.setjmp_buffer, 1); -} - -static void -png_warning_func (png_structp png_ptr, png_const_charp msg) -{ - warn_when_safe (Qpng, Qinfo, "%s", msg); -} - -struct png_unwind_data -{ - FILE *instream; - unsigned char *eimage; - png_structp png_ptr; - png_infop info_ptr; -}; - -static Lisp_Object -png_instantiate_unwind (Lisp_Object unwind_obj) -{ - struct png_unwind_data *data = - (struct png_unwind_data *) get_opaque_ptr (unwind_obj); - - free_opaque_ptr (unwind_obj); - if (data->png_ptr) - png_destroy_read_struct (&(data->png_ptr), &(data->info_ptr), (png_infopp)NULL); - if (data->instream) - fclose (data->instream); - - if (data->eimage) xfree(data->eimage); - - return Qnil; -} - -static void -png_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct png_unwind_data unwind; - int speccount = specpdl_depth (); - int height, width; - struct png_memory_storage tbr; /* Data to be read */ - - /* PNG variables */ - png_structp png_ptr; - png_infop info_ptr; - - /* Initialize all PNG structures */ - png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, (void*)&png_err_stct, - png_error_func, png_warning_func); - if (!png_ptr) - signal_image_error ("Error obtaining memory for png_read", instantiator); - info_ptr = png_create_info_struct (png_ptr); - if (!info_ptr) - { - png_destroy_read_struct (&png_ptr, (png_infopp)NULL, (png_infopp)NULL); - signal_image_error ("Error obtaining memory for png_read", instantiator); - } - - xzero (unwind); - unwind.png_ptr = png_ptr; - unwind.info_ptr = info_ptr; - - record_unwind_protect (png_instantiate_unwind, make_opaque_ptr (&unwind)); - - /* This code is a mixture of stuff from Ben's GIF/JPEG stuff from - this file, example.c from the libpng 0.81 distribution, and the - pngtopnm sources. -WMP- - */ - /* It has been further modified to handle the API changes for 0.96, - and is no longer usable for previous versions. jh - */ - - /* Set the jmp_buf return context for png_error ... if this returns !0, then - we ran into a problem somewhere, and need to clean up after ourselves. */ - if (setjmp (png_err_stct.setjmp_buffer)) - { - /* Something blew up: just display the error (cleanup happens in the unwind) */ - signal_image_error_2 ("Error decoding PNG", - build_string(png_err_stct.err_str), - instantiator); - } - - /* Initialize the IO layer and read in header information */ - { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST Extbyte *bytes; - Extcount len; - - assert (!NILP (data)); - - /* #### This is a definite problem under Mule due to the amount of - stack data it might allocate. Need to think about using Lstreams */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); - tbr.bytes = bytes; - tbr.len = len; - tbr.index = 0; - png_set_read_fn (png_ptr,(void *) &tbr, png_read_from_memory); - } - - png_read_info (png_ptr, info_ptr); - - { - int y; - unsigned char **row_pointers; - height = info_ptr->height; - width = info_ptr->width; - - /* Wow, allocate all the memory. Truly, exciting. */ - unwind.eimage = xnew_array_and_zero (unsigned char, width * height * 3); - /* libpng expects that the image buffer passed in contains a - picture to draw on top of if the png has any transparencies. - This could be a good place to pass that in... */ - - row_pointers = xnew_array (png_byte *, height); - - for (y = 0; y < height; y++) - row_pointers[y] = unwind.eimage + (width * 3 * y); - - { - /* if the png specifies a background chunk, go ahead and - use it, else use what we can get from the default face. */ - png_color_16 my_background, *image_background; - Lisp_Object bkgd = Qnil; - - my_background.red = 0x7fff; - my_background.green = 0x7fff; - my_background.blue = 0x7fff; - bkgd = FACE_BACKGROUND (Vdefault_face, domain); - if (!COLOR_INSTANCEP (bkgd)) - { - warn_when_safe (Qpng, Qinfo, "Couldn't get background color!"); - } - else - { - struct Lisp_Color_Instance *c; - Lisp_Object rgblist; - - c = XCOLOR_INSTANCE (bkgd); - rgblist = MAYBE_LISP_DEVMETH (XDEVICE (c->device), - color_instance_rgb_components, - (c)); - my_background.red = XINT (XCAR (rgblist)); - my_background.green = XINT (XCAR (XCDR (rgblist))); - my_background.blue = XINT (XCAR (XCDR (XCDR (rgblist)))); - } - - if (png_get_bKGD (png_ptr, info_ptr, &image_background)) - png_set_background (png_ptr, image_background, - PNG_BACKGROUND_GAMMA_FILE, 1, 1.0); - else - png_set_background (png_ptr, &my_background, - PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0); - } - - /* Now that we're using EImage, ask for 8bit RGB triples for any type - of image*/ - /* convert palette images to full RGB */ - if (info_ptr->color_type == PNG_COLOR_TYPE_PALETTE) - png_set_expand (png_ptr); - /* send grayscale images to RGB too */ - if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY || - info_ptr->color_type == PNG_COLOR_TYPE_GRAY_ALPHA) - png_set_gray_to_rgb (png_ptr); - /* we can't handle alpha values */ - if (info_ptr->color_type & PNG_COLOR_MASK_ALPHA) - png_set_strip_alpha (png_ptr); - /* tell libpng to strip 16 bit depth files down to 8 bits */ - if (info_ptr->bit_depth == 16) - png_set_strip_16 (png_ptr); - /* if the image is < 8 bits, pad it out */ - if (info_ptr->bit_depth < 8) - { - if (info_ptr->color_type == PNG_COLOR_TYPE_GRAY) - png_set_expand (png_ptr); - else - png_set_packing (png_ptr); - } - - png_read_image (png_ptr, row_pointers); - png_read_end (png_ptr, info_ptr); - -#ifdef PNG_SHOW_COMMENTS - /* #### - * I turn this off by default now, because the !%^@#!% comments - * show up every time the image is instantiated, which can get - * really really annoying. There should be some way to pass this - * type of data down into the glyph code, where you can get to it - * from lisp anyway. - WMP - */ - { - int i; - - for (i = 0 ; i < info_ptr->num_text ; i++) - { - /* How paranoid do I have to be about no trailing NULLs, and - using (int)info_ptr->text[i].text_length, and strncpy and a temp - string somewhere? */ - - warn_when_safe (Qpng, Qinfo, "%s - %s", - info_ptr->text[i].key, - info_ptr->text[i].text); - } - } -#endif - - xfree (row_pointers); - } - - /* now instantiate */ - MAYBE_DEVMETH (XDEVICE (ii->device), - init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, - instantiator, domain)); - - /* This will clean up everything else. */ - unbind_to (speccount, Qnil); -} - -#endif /* HAVE_PNG */ - - -#ifdef HAVE_TIFF -#include "tiffio.h" - -/********************************************************************** - * TIFF * - **********************************************************************/ -static void -tiff_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -static Lisp_Object -tiff_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - return simple_image_type_normalize (inst, console_type, Qtiff); -} - -static int -tiff_possible_dest_types (void) -{ - return IMAGE_COLOR_PIXMAP_MASK; -} - -struct tiff_unwind_data -{ - unsigned char *eimage; - /* Object that holds the decoded data from a TIFF file */ - TIFF *tiff; -}; - -static Lisp_Object -tiff_instantiate_unwind (Lisp_Object unwind_obj) -{ - struct tiff_unwind_data *data = - (struct tiff_unwind_data *) get_opaque_ptr (unwind_obj); - - free_opaque_ptr (unwind_obj); - if (data->tiff) - { - TIFFClose(data->tiff); - } - if (data->eimage) - xfree (data->eimage); - - return Qnil; -} - -typedef struct tiff_memory_storage -{ - Extbyte *bytes; /* The data */ - Extcount len; /* How big is it? */ - int index; /* Where are we? */ -} tiff_memory_storage; - -static size_t -tiff_memory_read(thandle_t data, tdata_t buf, tsize_t size) -{ - tiff_memory_storage *mem = (tiff_memory_storage*)data; - - if (size > (mem->len - mem->index)) - return (size_t) -1; - memcpy(buf, mem->bytes + mem->index, size); - mem->index = mem->index + size; - return size; -} - -static size_t tiff_memory_write(thandle_t data, tdata_t buf, tsize_t size) -{ - abort(); - return 0; /* Shut up warnings. */ -} - -static toff_t tiff_memory_seek(thandle_t data, toff_t off, int whence) -{ - tiff_memory_storage *mem = (tiff_memory_storage*)data; - int newidx; - switch(whence) { - case SEEK_SET: - newidx = off; - break; - case SEEK_END: - newidx = mem->len + off; - break; - case SEEK_CUR: - newidx = mem->index + off; - break; - default: - fprintf(stderr,"Eh? invalid seek mode in tiff_memory_seek\n"); - return -1; - } - - if ((newidx > mem->len) || (newidx < 0)) - return -1; - - mem->index = newidx; - return newidx; -} - -static int -tiff_memory_close(thandle_t data) -{ - return 0; -} - -static int -tiff_map_noop(thandle_t data, tdata_t* pbase, toff_t* psize) -{ - return 0; -} - -static void -tiff_unmap_noop(thandle_t data, tdata_t pbase, toff_t psize) -{ - return; -} - -static toff_t -tiff_memory_size(thandle_t data) -{ - tiff_memory_storage *mem = (tiff_memory_storage*)data; - return mem->len; -} - -struct tiff_error_struct -{ -#if HAVE_VSNPRINTF - char err_str[256]; -#else - char err_str[1024]; /* return the error string */ -#endif - jmp_buf setjmp_buffer; /* for return to caller */ -}; - -/* jh 98/03/12 - ###This struct for passing data to the error functions - is an ugly hack caused by the fact that libtiff (as of v3.4) doesn't - have any place to store error func data. This should be rectified - before XEmacs gets threads! */ -static struct tiff_error_struct tiff_err_data; - -static void -tiff_error_func(CONST char *module, CONST char *fmt, ...) -{ - va_list vargs; - - va_start (vargs, fmt); -#if HAVE_VSNPRINTF - vsnprintf (tiff_err_data.err_str, 255, fmt, vargs); -#else - /* pray this doesn't overflow... */ - vsprintf (tiff_err_data.err_str, fmt, vargs); -#endif - va_end (vargs); - /* return to setjmp point */ - longjmp (tiff_err_data.setjmp_buffer, 1); -} - -static void -tiff_warning_func(CONST char *module, CONST char *fmt, ...) -{ - va_list vargs; -#if HAVE_VSNPRINTF - char warn_str[256]; -#else - char warn_str[1024]; -#endif - - va_start (vargs, fmt); -#if HAVE_VSNPRINTF - vsnprintf (warn_str, 255, fmt, vargs); -#else - vsprintf (warn_str, fmt, vargs); -#endif - va_end (vargs); - warn_when_safe (Qtiff, Qinfo, "%s - %s", - module, warn_str); -} - -static void -tiff_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - tiff_memory_storage mem_struct; - /* It is OK for the unwind data to be local to this function, - because the unwind-protect is always executed when this - stack frame is still valid. */ - struct tiff_unwind_data unwind; - int speccount = specpdl_depth (); - uint32 width, height; - - xzero (unwind); - record_unwind_protect (tiff_instantiate_unwind, make_opaque_ptr (&unwind)); - - /* set up error facilities */ - if (setjmp (tiff_err_data.setjmp_buffer)) - { - /* An error was signaled. No clean up is needed, as unwind handles that - for us. Just pass the error along. */ - signal_image_error_2 ("TIFF decoding error", - build_string(tiff_err_data.err_str), - instantiator); - } - TIFFSetErrorHandler ((TIFFErrorHandler)tiff_error_func); - TIFFSetWarningHandler ((TIFFErrorHandler)tiff_warning_func); - { - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - Extbyte *bytes; - Extcount len; - - uint32 *raster; - unsigned char *ep; - - assert (!NILP (data)); - - /* #### This is a definite problem under Mule due to the amount of - stack data it might allocate. Think about Lstreams... */ - GET_STRING_BINARY_DATA_ALLOCA (data, bytes, len); - mem_struct.bytes = bytes; - mem_struct.len = len; - mem_struct.index = 0; - - unwind.tiff = TIFFClientOpen ("memfile", "r", &mem_struct, - (TIFFReadWriteProc)tiff_memory_read, - (TIFFReadWriteProc)tiff_memory_write, - tiff_memory_seek, tiff_memory_close, tiff_memory_size, - tiff_map_noop, tiff_unmap_noop); - if (!unwind.tiff) - signal_image_error ("Insufficent memory to instantiate TIFF image", instantiator); - - TIFFGetField (unwind.tiff, TIFFTAG_IMAGEWIDTH, &width); - TIFFGetField (unwind.tiff, TIFFTAG_IMAGELENGTH, &height); - unwind.eimage = (unsigned char *) xmalloc (width * height * 3); - - /* ### This is little more than proof-of-concept/function testing. - It needs to be reimplemented via scanline reads for both memory - compactness. */ - raster = (uint32*) _TIFFmalloc (width * height * sizeof (uint32)); - if (raster != NULL) - { - int i,j; - uint32 *rp; - ep = unwind.eimage; - rp = raster; - if (TIFFReadRGBAImage (unwind.tiff, width, height, raster, 0)) - { - for (i = height - 1; i >= 0; i--) - { - /* This is to get around weirdness in the libtiff library where properly - made TIFFs will come out upside down. libtiff bug or jhod-brainlock? */ - rp = raster + (i * width); - for (j = 0; j < width; j++) - { - *ep++ = (unsigned char)TIFFGetR(*rp); - *ep++ = (unsigned char)TIFFGetG(*rp); - *ep++ = (unsigned char)TIFFGetB(*rp); - rp++; - } - } - } - _TIFFfree (raster); - } else - signal_image_error ("Unable to allocate memory for TIFFReadRGBA", instantiator); - - } - - /* now instantiate */ - MAYBE_DEVMETH (XDEVICE (ii->device), - init_image_instance_from_eimage, - (ii, width, height, unwind.eimage, dest_mask, - instantiator, domain)); - - unbind_to (speccount, Qnil); -} - -#endif /* HAVE_TIFF */ - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_glyphs_eimage (void) -{ -} - -void -image_instantiator_format_create_glyphs_eimage (void) -{ - /* image-instantiator types */ -#ifdef HAVE_JPEG - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (jpeg, "jpeg"); - - IIFORMAT_HAS_METHOD (jpeg, validate); - IIFORMAT_HAS_METHOD (jpeg, normalize); - IIFORMAT_HAS_METHOD (jpeg, possible_dest_types); - IIFORMAT_HAS_METHOD (jpeg, instantiate); - - IIFORMAT_VALID_KEYWORD (jpeg, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (jpeg, Q_file, check_valid_string); -#endif - -#ifdef HAVE_GIF - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (gif, "gif"); - - IIFORMAT_HAS_METHOD (gif, validate); - IIFORMAT_HAS_METHOD (gif, normalize); - IIFORMAT_HAS_METHOD (gif, possible_dest_types); - IIFORMAT_HAS_METHOD (gif, instantiate); - - IIFORMAT_VALID_KEYWORD (gif, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (gif, Q_file, check_valid_string); -#endif - -#ifdef HAVE_PNG - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (png, "png"); - - IIFORMAT_HAS_METHOD (png, validate); - IIFORMAT_HAS_METHOD (png, normalize); - IIFORMAT_HAS_METHOD (png, possible_dest_types); - IIFORMAT_HAS_METHOD (png, instantiate); - - IIFORMAT_VALID_KEYWORD (png, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (png, Q_file, check_valid_string); -#endif - -#ifdef HAVE_TIFF - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (tiff, "tiff"); - - IIFORMAT_HAS_METHOD (tiff, validate); - IIFORMAT_HAS_METHOD (tiff, normalize); - IIFORMAT_HAS_METHOD (tiff, possible_dest_types); - IIFORMAT_HAS_METHOD (tiff, instantiate); - - IIFORMAT_VALID_KEYWORD (tiff, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (tiff, Q_file, check_valid_string); -#endif - -} - -void -vars_of_glyphs_eimage (void) -{ -#ifdef HAVE_JPEG - Fprovide (Qjpeg); -#endif - -#ifdef HAVE_GIF - Fprovide (Qgif); -#endif - -#ifdef HAVE_PNG - Fprovide (Qpng); -#endif - -#ifdef HAVE_TIFF - Fprovide (Qtiff); -#endif - -} diff --git a/src/glyphs-msw.c b/src/glyphs-msw.c deleted file mode 100644 index 70b948a..0000000 --- a/src/glyphs-msw.c +++ /dev/null @@ -1,2631 +0,0 @@ -/* mswindows-specific glyph objects. - Copyright (C) 1998 Andy Piper. - -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 Andy Piper plagerising bits from - glyphs-x.c */ - -#include -#include "lisp.h" -#include "lstream.h" - -#define OEMRESOURCE /* Define OCR_ and friend constants */ -#include "console-msw.h" -#include "glyphs-msw.h" -#include "objects-msw.h" - -#include "window.h" -#include "elhash.h" -#include "buffer.h" -#include "frame.h" -#include "insdel.h" -#include "opaque.h" -#include "sysfile.h" -#include "faces.h" -#include "imgproc.h" - -#ifdef FILE_CODING -#include "file-coding.h" -#endif -#include -#include -#ifdef HAVE_XFACE -#include -#endif - -#define WIDGET_GLYPH_SLOT 0 - -#ifdef HAVE_XPM -DEFINE_DEVICE_IIFORMAT (mswindows, xpm); -#endif -DEFINE_DEVICE_IIFORMAT (mswindows, xbm); -#ifdef HAVE_XFACE -DEFINE_DEVICE_IIFORMAT (mswindows, xface); -#endif -DEFINE_DEVICE_IIFORMAT (mswindows, button); -DEFINE_DEVICE_IIFORMAT (mswindows, edit); -#if 0 -DEFINE_DEVICE_IIFORMAT (mswindows, group); -#endif -DEFINE_DEVICE_IIFORMAT (mswindows, subwindow); -DEFINE_DEVICE_IIFORMAT (mswindows, widget); -DEFINE_DEVICE_IIFORMAT (mswindows, label); -DEFINE_DEVICE_IIFORMAT (mswindows, scrollbar); -DEFINE_DEVICE_IIFORMAT (mswindows, combo); -DEFINE_DEVICE_IIFORMAT (mswindows, progress); - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (bmp); -Lisp_Object Qbmp; -Lisp_Object Vmswindows_bitmap_file_path; -static COLORREF transparent_color = RGB (1,1,1); - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (mswindows_resource); -Lisp_Object Q_resource_type, Q_resource_id; -Lisp_Object Qmswindows_resource; - -static void -mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type); -static void -mswindows_initialize_image_instance_mask (struct Lisp_Image_Instance* image, - struct frame* f); - -COLORREF mswindows_string_to_color (CONST char *name); - -#define BPLINE(width) ((int)(~3UL & (unsigned long)((width) +3))) - -/************************************************************************/ -/* convert from a series of RGB triples to a BITMAPINFO formated for the*/ -/* proper display */ -/************************************************************************/ -static BITMAPINFO* convert_EImage_to_DIBitmap (Lisp_Object device, - int width, int height, - unsigned char *pic, - int *bit_count, - unsigned char** bmp_data) -{ - struct device *d = XDEVICE (device); - int i,j; - RGBQUAD* colortbl; - int ncolors; - BITMAPINFO* bmp_info; - unsigned char *ip, *dp; - - if (DEVICE_MSWINDOWS_BITSPIXEL (d) > 0) - { - int bpline = BPLINE(width * 3); - /* FIXME: we can do this because 24bpp implies no color table, once - * we start palettizing this is no longer true. The X versions of - * this function quantises to 256 colors or bit masks down to a - * long. Windows can actually handle rgb triples in the raw so I - * don't see much point trying to optimize down to the best - * structure - unless it has memory / color allocation implications - * .... */ - bmp_info=xnew_and_zero (BITMAPINFO); - - if (!bmp_info) - { - return NULL; - } - - bmp_info->bmiHeader.biBitCount=24; /* just RGB triples for now */ - bmp_info->bmiHeader.biCompression=BI_RGB; /* just RGB triples for now */ - bmp_info->bmiHeader.biSizeImage=width*height*3; - - /* bitmap data needs to be in blue, green, red triples - in that - order, eimage is in RGB format so we need to convert */ - *bmp_data = xnew_array_and_zero (unsigned char, bpline * height); - *bit_count = bpline * height; - - if (!bmp_data) - { - xfree (bmp_info); - return NULL; - } - - ip = pic; - for (i = height-1; i >= 0; i--) { - dp = (*bmp_data) + (i * bpline); - for (j = 0; j < width; j++) { - dp[2] =*ip++; - dp[1] =*ip++; - *dp =*ip++; - dp += 3; - } - } - } - else /* scale to 256 colors */ - { - int rd,gr,bl; - quant_table *qtable; - int bpline = BPLINE (width * 3); - /* Quantize the image and get a histogram while we're at it. - Do this first to save memory */ - qtable = build_EImage_quantable(pic, width, height, 256); - if (qtable == NULL) return NULL; - - /* use our quantize table to allocate the colors */ - ncolors = qtable->num_active_colors; - bmp_info=(BITMAPINFO*)xmalloc_and_zero (sizeof(BITMAPINFOHEADER) + - sizeof(RGBQUAD) * ncolors); - if (!bmp_info) - { - xfree (qtable); - return NULL; - } - - colortbl=(RGBQUAD*)(((unsigned char*)bmp_info)+sizeof(BITMAPINFOHEADER)); - - bmp_info->bmiHeader.biBitCount=8; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biSizeImage=bpline*height; - bmp_info->bmiHeader.biClrUsed=ncolors; - bmp_info->bmiHeader.biClrImportant=ncolors; - - *bmp_data = (unsigned char *) xmalloc_and_zero (bpline * height); - *bit_count = bpline * height; - - if (!*bmp_data) - { - xfree (qtable); - xfree (bmp_info); - return NULL; - } - - /* build up an RGBQUAD colortable */ - for (i = 0; i < qtable->num_active_colors; i++) { - colortbl[i].rgbRed = (BYTE) qtable->rm[i]; - colortbl[i].rgbGreen = (BYTE) qtable->gm[i]; - colortbl[i].rgbBlue = (BYTE) qtable->bm[i]; - colortbl[i].rgbReserved = 0; - } - - /* now build up the data. picture has to be upside-down and - back-to-front for msw bitmaps */ - ip = pic; - for (i = height-1; i >= 0; i--) { - dp = (*bmp_data) + (i * bpline); - for (j = 0; j < width; j++) { - rd = *ip++; - gr = *ip++; - bl = *ip++; - *dp++ = QUANT_GET_COLOR (qtable,rd,gr,bl); - } - } - xfree (qtable); - } - /* fix up the standard stuff */ - bmp_info->bmiHeader.biWidth=width; - bmp_info->bmiHeader.biHeight=height; - bmp_info->bmiHeader.biPlanes=1; - bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biXPelsPerMeter=0; /* unless you know better */ - bmp_info->bmiHeader.biYPelsPerMeter=0; - - return bmp_info; -} - -/* Given a pixmap filename, look through all of the "standard" places - where the file might be located. Return a full pathname if found; - otherwise, return Qnil. */ - -static Lisp_Object -mswindows_locate_pixmap_file (Lisp_Object name) -{ - /* This function can GC if IN_REDISPLAY is false */ - Lisp_Object found; - - /* Check non-absolute pathnames with a directory component relative to - the search path; that's the way Xt does it. */ - if (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 0)) || - (XSTRING_BYTE (name, 0) == '.' && - (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 1)) || - (XSTRING_BYTE (name, 1) == '.' && - (IS_DIRECTORY_SEP(XSTRING_BYTE (name, 2))))))) - { - if (!NILP (Ffile_readable_p (name))) - return name; - else - return Qnil; - } - - if (locate_file (Vmswindows_bitmap_file_path, name, "", &found, R_OK) < 0) - { - Lisp_Object temp = list1 (Vdata_directory); - struct gcpro gcpro1; - - GCPRO1 (temp); - locate_file (temp, name, "", &found, R_OK); - UNGCPRO; - } - - return found; -} - - -/* Initialize an image instance from a bitmap - - DEST_MASK specifies the mask of allowed image types. - - If this fails, signal an error. INSTANTIATOR is only used - in the error message. */ - -static void -init_image_instance_from_dibitmap (struct Lisp_Image_Instance *ii, - BITMAPINFO *bmp_info, - int dest_mask, - void *bmp_data, - int bmp_bits, - Lisp_Object instantiator, - int x_hot, int y_hot, - int create_mask) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct device *d = XDEVICE (device); - struct frame *f; - void* bmp_buf=0; - int type; - HBITMAP bitmap; - HDC hdc; - - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); - - if (NILP (DEVICE_SELECTED_FRAME (d))) - signal_simple_error ("No selected frame on mswindows device", device); - - f = XFRAME (DEVICE_SELECTED_FRAME (d)); - - if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) - type = IMAGE_COLOR_PIXMAP; - else if (dest_mask & IMAGE_POINTER_MASK) - type = IMAGE_POINTER; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); - hdc = FRAME_MSWINDOWS_CDC (f); - - bitmap=CreateDIBSection (hdc, - bmp_info, - DIB_RGB_COLORS, - &bmp_buf, - 0,0); - - if (!bitmap || !bmp_buf) - signal_simple_error ("Unable to create bitmap", instantiator); - - /* copy in the actual bitmap */ - memcpy (bmp_buf, bmp_data, bmp_bits); - - mswindows_initialize_dibitmap_image_instance (ii, type); - - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = - find_keyword_in_vector (instantiator, Q_file); - - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = bitmap; - IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = NULL; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = bmp_info->bmiHeader.biWidth; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = bmp_info->bmiHeader.biHeight; - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = bmp_info->bmiHeader.biBitCount; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), x_hot); - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), y_hot); - - if (create_mask) - { - mswindows_initialize_image_instance_mask (ii, f); - } - - if (type == IMAGE_POINTER) - { - mswindows_initialize_image_instance_icon(ii, TRUE); - } -} - -static void -mswindows_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii, - int width, int height, - unsigned char *eimage, - int dest_mask, - Lisp_Object instantiator, - Lisp_Object domain) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - BITMAPINFO* bmp_info; - unsigned char* bmp_data; - int bmp_bits; - COLORREF bkcolor; - - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); - - /* this is a hack but MaskBlt and TransparentBlt are not supported - on most windows variants */ - bkcolor = COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE (FACE_BACKGROUND (Vdefault_face, domain))); - - /* build a bitmap from the eimage */ - if (!(bmp_info=convert_EImage_to_DIBitmap (device, width, height, eimage, - &bmp_bits, &bmp_data))) - { - signal_simple_error ("EImage to DIBitmap conversion failed", - instantiator); - } - - /* Now create the pixmap and set up the image instance */ - init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, - bmp_data, bmp_bits, instantiator, - 0, 0, 0); - - xfree (bmp_info); - xfree (bmp_data); -} - -static void set_mono_pixel ( unsigned char* bits, - int bpline, int height, - int x, int y, int white ) -{ - int index; - unsigned char bitnum; - /* Find the byte on which this scanline begins */ - index = (height - y - 1) * bpline; - /* Find the byte containing this pixel */ - index += (x >> 3); - /* Which bit is it? */ - bitnum = (unsigned char)( 7 - (x % 8) ); - if( white ) /* Turn it on */ - bits[index] |= (1<bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); - bmp_info->bmiHeader.biHeight = height; - bmp_info->bmiHeader.biPlanes=1; - bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=1; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 2; - bmp_info->bmiHeader.biClrImportant = 2; - bmp_info->bmiHeader.biSizeImage = height * maskbpline; - bmp_info->bmiColors[0].rgbRed = 0; - bmp_info->bmiColors[0].rgbGreen = 0; - bmp_info->bmiColors[0].rgbBlue = 0; - bmp_info->bmiColors[0].rgbReserved = 0; - bmp_info->bmiColors[1].rgbRed = 255; - bmp_info->bmiColors[1].rgbGreen = 255; - bmp_info->bmiColors[1].rgbBlue = 255; - bmp_info->bmiColors[0].rgbReserved = 0; - - if (!(mask = CreateDIBSection (hcdc, - bmp_info, - DIB_RGB_COLORS, - &and_bits, - 0,0))) - { - xfree (bmp_info); - return; - } - - old = SelectObject (hcdc, IMAGE_INSTANCE_MSWINDOWS_BITMAP (image)); - /* build up an in-memory set of bits to mess with */ - xzero (*bmp_info); - - bmp_info->bmiHeader.biWidth=IMAGE_INSTANCE_PIXMAP_WIDTH (image); - bmp_info->bmiHeader.biHeight = -height; - bmp_info->bmiHeader.biPlanes=1; - bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=24; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 0; - bmp_info->bmiHeader.biClrImportant = 0; - bmp_info->bmiHeader.biSizeImage = height * bpline; - - dibits = xmalloc_and_zero (bpline * height); - if (GetDIBits (hcdc, - IMAGE_INSTANCE_MSWINDOWS_BITMAP (image), - 0, - height, - dibits, - bmp_info, - DIB_RGB_COLORS) <= 0) - { - xfree (bmp_info); - return; - } - - /* now set the colored bits in the mask and transparent ones to - black in the original */ - for(i=0; i) ...) so that if an - error happens we don't lose any malloc()ed data, or more importantly, - leave any pixels allocated in the server. */ - i = 0; - LIST_LOOP (rest, color_symbol_alist) - { - Lisp_Object cons = XCAR (rest); - Lisp_Object name = XCAR (cons); - Lisp_Object value = XCDR (cons); - if (NILP (value)) - continue; - if (STRINGP (value)) - value = - Fmake_color_instance - (value, device, encode_error_behavior_flag (ERROR_ME_NOT)); - else - { - assert (COLOR_SPECIFIERP (value)); - value = Fspecifier_instance (value, domain, Qnil, Qnil); - } - if (NILP (value)) - continue; - results = noseeum_cons (noseeum_cons (name, value), results); - i++; - } - UNGCPRO; /* no more evaluation */ - - *nsymbols=i; - if (i == 0) return 0; - - colortbl = xnew_array_and_zero (struct color_symbol, i); - - for (j=0; jbfOffBits; - bmp_bits = bmp_file_header->bfSize - bmp_file_header->bfOffBits; - - /* Now create the pixmap and set up the image instance */ - init_image_instance_from_dibitmap (ii, bmp_info, dest_mask, - bmp_data, bmp_bits, instantiator, - 0, 0, 0); -} - - -/********************************************************************** - * RESOURCES * - **********************************************************************/ - -static void -mswindows_resource_validate (Lisp_Object instantiator) -{ - if ((NILP (find_keyword_in_vector (instantiator, Q_file)) - && - NILP (find_keyword_in_vector (instantiator, Q_resource_id))) - || - NILP (find_keyword_in_vector (instantiator, Q_resource_type))) - signal_simple_error ("Must supply :file, :resource-id and :resource-type", - instantiator); -} - -static Lisp_Object -mswindows_resource_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - /* This function can call lisp */ - Lisp_Object file = Qnil; - struct gcpro gcpro1, gcpro2; - Lisp_Object alist = Qnil; - - GCPRO2 (file, alist); - - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, - console_type); - - if (CONSP (file)) /* failure locating filename */ - signal_double_file_error ("Opening pixmap file", - "no such file or directory", - Fcar (file)); - - if (NILP (file)) /* no conversion necessary */ - RETURN_UNGCPRO (inst); - - alist = tagged_vector_to_alist (inst); - - { - alist = remassq_no_quit (Q_file, alist); - alist = Fcons (Fcons (Q_file, file), alist); - } - - { - Lisp_Object result = alist_to_tagged_vector (Qmswindows_resource, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - -static int -mswindows_resource_possible_dest_types (void) -{ - return IMAGE_POINTER_MASK | IMAGE_COLOR_PIXMAP_MASK; -} - -typedef struct -{ - char *name; - int resource_id; -} resource_t; - -#ifndef OCR_ICOCUR -#define OCR_ICOCUR 32647 -#define OIC_SAMPLE 32512 -#define OIC_HAND 32513 -#define OIC_QUES 32514 -#define OIC_BANG 32515 -#define OIC_NOTE 32516 -#define OIC_WINLOGO 32517 -#define LR_SHARED 0x8000 -#endif - -static CONST resource_t bitmap_table[] = -{ - /* bitmaps */ - { "close", OBM_CLOSE }, - { "uparrow", OBM_UPARROW }, - { "dnarrow", OBM_DNARROW }, - { "rgarrow", OBM_RGARROW }, - { "lfarrow", OBM_LFARROW }, - { "reduce", OBM_REDUCE }, - { "zoom", OBM_ZOOM }, - { "restore", OBM_RESTORE }, - { "reduced", OBM_REDUCED }, - { "zoomd", OBM_ZOOMD }, - { "restored", OBM_RESTORED }, - { "uparrowd", OBM_UPARROWD }, - { "dnarrowd", OBM_DNARROWD }, - { "rgarrowd", OBM_RGARROWD }, - { "lfarrowd", OBM_LFARROWD }, - { "mnarrow", OBM_MNARROW }, - { "combo", OBM_COMBO }, - { "uparrowi", OBM_UPARROWI }, - { "dnarrowi", OBM_DNARROWI }, - { "rgarrowi", OBM_RGARROWI }, - { "lfarrowi", OBM_LFARROWI }, - { "size", OBM_SIZE }, - { "btsize", OBM_BTSIZE }, - { "check", OBM_CHECK }, - { "checkboxes", OBM_CHECKBOXES }, - { "btncorners" , OBM_BTNCORNERS }, - {0} -}; - -static CONST resource_t cursor_table[] = -{ - /* cursors */ - { "normal", OCR_NORMAL }, - { "ibeam", OCR_IBEAM }, - { "wait", OCR_WAIT }, - { "cross", OCR_CROSS }, - { "up", OCR_UP }, - /* { "icon", OCR_ICON }, */ - { "sizenwse", OCR_SIZENWSE }, - { "sizenesw", OCR_SIZENESW }, - { "sizewe", OCR_SIZEWE }, - { "sizens", OCR_SIZENS }, - { "sizeall", OCR_SIZEALL }, - /* { "icour", OCR_ICOCUR }, */ - { "no", OCR_NO }, - { 0 } -}; - -static CONST resource_t icon_table[] = -{ - /* icons */ - { "sample", OIC_SAMPLE }, - { "hand", OIC_HAND }, - { "ques", OIC_QUES }, - { "bang", OIC_BANG }, - { "note", OIC_NOTE }, - { "winlogo", OIC_WINLOGO }, - {0} -}; - -static int resource_name_to_resource (Lisp_Object name, int type) -{ - CONST resource_t* res = (type == IMAGE_CURSOR ? cursor_table - : type == IMAGE_ICON ? icon_table - : bitmap_table); - - if (INTP (name)) - { - return XINT (name); - } - else if (!STRINGP (name)) - { - signal_simple_error ("invalid resource identifier", name); - } - - do { - Extbyte* nm=0; - GET_C_STRING_OS_DATA_ALLOCA (name, nm); - if (!strcasecmp ((char*)res->name, nm)) - return res->resource_id; - } while ((++res)->name); - return 0; -} - -static int -resource_symbol_to_type (Lisp_Object data) -{ - if (EQ (data, Qcursor)) - return IMAGE_CURSOR; - else if (EQ (data, Qicon)) - return IMAGE_ICON; - else if (EQ (data, Qbitmap)) - return IMAGE_BITMAP; - else - return 0; -} - -static void -mswindows_resource_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - unsigned int type = 0; - HANDLE himage = NULL; - LPCTSTR resid=0; - HINSTANCE hinst = NULL; - ICONINFO iconinfo; - int iitype=0; - char* fname=0; - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - - Lisp_Object file = find_keyword_in_vector (instantiator, Q_file); - Lisp_Object resource_type = find_keyword_in_vector (instantiator, - Q_resource_type); - Lisp_Object resource_id = find_keyword_in_vector (instantiator, - Q_resource_id); - - xzero (iconinfo); - - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an mswindows device", device); - - type = resource_symbol_to_type (resource_type); - - if (dest_mask & IMAGE_POINTER_MASK && type == IMAGE_CURSOR) - iitype = IMAGE_POINTER; - else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) - iitype = IMAGE_COLOR_PIXMAP; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_COLOR_PIXMAP_MASK | IMAGE_POINTER_MASK); - - /* mess with the keyword info we were provided with */ - if (!NILP (file)) - { - Extbyte* f=0; - GET_C_STRING_FILENAME_DATA_ALLOCA (file, f); -#ifdef __CYGWIN32__ - CYGWIN_WIN32_PATH (f, fname); -#else - fname = f; -#endif - - if (NILP (resource_id)) - resid = (LPCTSTR)fname; - else - { - hinst = LoadLibraryEx (fname, NULL, - LOAD_LIBRARY_AS_DATAFILE); - resid = MAKEINTRESOURCE (resource_name_to_resource (resource_id, - type)); - - if (!resid) - GET_C_STRING_OS_DATA_ALLOCA (resource_id, resid); - } - } - else if (!(resid = MAKEINTRESOURCE (resource_name_to_resource (resource_id, - type)))) - signal_simple_error ("Invalid resource identifier", resource_id); - - /* load the image */ - if (!(himage = LoadImage (hinst, resid, type, 0, 0, - LR_CREATEDIBSECTION | LR_DEFAULTSIZE | - LR_SHARED | - (!NILP (file) ? LR_LOADFROMFILE : 0)))) - { - signal_simple_error ("Cannot load image", instantiator); - } - - if (hinst) - FreeLibrary (hinst); - - mswindows_initialize_dibitmap_image_instance (ii, iitype); - - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = file; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = - GetSystemMetrics (type == IMAGE_CURSOR ? SM_CXCURSOR : SM_CXICON); - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = - GetSystemMetrics (type == IMAGE_CURSOR ? SM_CYCURSOR : SM_CYICON); - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 1; - - /* hey, we've got an icon type thing so we can reverse engineer the - bitmap and mask */ - if (type != IMAGE_BITMAP) - { - GetIconInfo (himage, &iconinfo); - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = iconinfo.hbmColor; - IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = iconinfo.hbmMask; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), iconinfo.xHotspot); - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), iconinfo.yHotspot); - IMAGE_INSTANCE_MSWINDOWS_ICON (ii) = himage; - } - else - { - IMAGE_INSTANCE_MSWINDOWS_ICON (ii) = NULL; - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = himage; - IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = NULL; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), 0); - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), 0); - } -} - -static void -check_valid_resource_symbol (Lisp_Object data) -{ - CHECK_SYMBOL (data); - if (!resource_symbol_to_type (data)) - signal_simple_error ("invalid resource type", data); -} - -static void -check_valid_resource_id (Lisp_Object data) -{ - if (!resource_name_to_resource (data, IMAGE_CURSOR) - && - !resource_name_to_resource (data, IMAGE_ICON) - && - !resource_name_to_resource (data, IMAGE_BITMAP)) - signal_simple_error ("invalid resource identifier", data); -} - -void -check_valid_string_or_int (Lisp_Object data) -{ - if (!INTP (data)) - CHECK_STRING (data); - else - CHECK_INT (data); -} - -/********************************************************************** - * XBM * - **********************************************************************/ -#ifndef HAVE_X_WINDOWS -/* $XConsortium: RdBitF.c,v 1.10 94/04/17 20:16:13 kaleb Exp $ */ - -/* - -Copyright (c) 1988 X Consortium - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - -Except as contained in this notice, the name of the X Consortium shall not be -used in advertising or otherwise to promote the sale, use or other dealings -in this Software without prior written authorization from the X Consortium. - -*/ - -/* - * This file contains miscellaneous utility routines and is not part of the - * Xlib standard. - * - * Public entry points: - * - * XmuReadBitmapData read data from FILE descriptor - * XmuReadBitmapDataFromFile read X10 or X11 format bitmap files - * and return data - * - * Note that this file and ../X/XRdBitF.c look very similar.... Keep them - * that way (but don't use common source code so that people can have one - * without the other). - */ - - -/* - * Based on an optimized version provided by Jim Becker, August 5, 1988. - */ -#ifndef BitmapSuccess -#define BitmapSuccess 0 -#define BitmapOpenFailed 1 -#define BitmapFileInvalid 2 -#define BitmapNoMemory 3 -#endif -#define MAX_SIZE 255 - -/* shared data for the image read/parse logic */ -static short hexTable[256]; /* conversion value */ -static int initialized = FALSE; /* easier to fill in at run time */ - -/* - * Table index for the hex values. Initialized once, first time. - * Used for translation value or delimiter significance lookup. - */ -static void initHexTable() -{ - /* - * We build the table at run time for several reasons: - * - * 1. portable to non-ASCII machines. - * 2. still reentrant since we set the init flag after setting table. - * 3. easier to extend. - * 4. less prone to bugs. - */ - hexTable['0'] = 0; hexTable['1'] = 1; - hexTable['2'] = 2; hexTable['3'] = 3; - hexTable['4'] = 4; hexTable['5'] = 5; - hexTable['6'] = 6; hexTable['7'] = 7; - hexTable['8'] = 8; hexTable['9'] = 9; - hexTable['A'] = 10; hexTable['B'] = 11; - hexTable['C'] = 12; hexTable['D'] = 13; - hexTable['E'] = 14; hexTable['F'] = 15; - hexTable['a'] = 10; hexTable['b'] = 11; - hexTable['c'] = 12; hexTable['d'] = 13; - hexTable['e'] = 14; hexTable['f'] = 15; - - /* delimiters of significance are flagged w/ negative value */ - hexTable[' '] = -1; hexTable[','] = -1; - hexTable['}'] = -1; hexTable['\n'] = -1; - hexTable['\t'] = -1; - - initialized = TRUE; -} - -/* - * read next hex value in the input stream, return -1 if EOF - */ -static int NextInt ( FILE *fstream ) -{ - int ch; - int value = 0; - int gotone = 0; - int done = 0; - - /* loop, accumulate hex value until find delimiter */ - /* skip any initial delimiters found in read stream */ - - while (!done) { - ch = getc(fstream); - if (ch == EOF) { - value = -1; - done++; - } else { - /* trim high bits, check type and accumulate */ - ch &= 0xff; - if (isascii(ch) && isxdigit(ch)) { - value = (value << 4) + hexTable[ch]; - gotone++; - } else if ((hexTable[ch]) < 0 && gotone) - done++; - } - } - return value; -} - - -/* - * The data returned by the following routine is always in left-most byte - * first and left-most bit first. If it doesn't return BitmapSuccess then - * its arguments won't have been touched. This routine should look as much - * like the Xlib routine XReadBitmapfile as possible. - */ -int read_bitmap_data (fstream, width, height, datap, x_hot, y_hot) - FILE *fstream; /* handle on file */ - unsigned int *width, *height; /* RETURNED */ - unsigned char **datap; /* RETURNED */ - int *x_hot, *y_hot; /* RETURNED */ -{ - unsigned char *data = NULL; /* working variable */ - char line[MAX_SIZE]; /* input line from file */ - int size; /* number of bytes of data */ - char name_and_type[MAX_SIZE]; /* an input line */ - char *type; /* for parsing */ - int value; /* from an input line */ - int version10p; /* boolean, old format */ - int padding; /* to handle alignment */ - int bytes_per_line; /* per scanline of data */ - unsigned int ww = 0; /* width */ - unsigned int hh = 0; /* height */ - int hx = -1; /* x hotspot */ - int hy = -1; /* y hotspot */ - -#define Xmalloc(size) malloc(size) - - /* first time initialization */ - if (initialized == FALSE) initHexTable(); - - /* error cleanup and return macro */ -#define RETURN(code) { if (data) free (data); return code; } - - while (fgets(line, MAX_SIZE, fstream)) { - if (strlen(line) == MAX_SIZE-1) { - RETURN (BitmapFileInvalid); - } - if (sscanf(line,"#define %s %d",name_and_type,&value) == 2) { - if (!(type = strrchr(name_and_type, '_'))) - type = name_and_type; - else - type++; - - if (!strcmp("width", type)) - ww = (unsigned int) value; - if (!strcmp("height", type)) - hh = (unsigned int) value; - if (!strcmp("hot", type)) { - if (type-- == name_and_type || type-- == name_and_type) - continue; - if (!strcmp("x_hot", type)) - hx = value; - if (!strcmp("y_hot", type)) - hy = value; - } - continue; - } - - if (sscanf(line, "static short %s = {", name_and_type) == 1) - version10p = 1; - else if (sscanf(line,"static unsigned char %s = {",name_and_type) == 1) - version10p = 0; - else if (sscanf(line, "static char %s = {", name_and_type) == 1) - version10p = 0; - else - continue; - - if (!(type = strrchr(name_and_type, '_'))) - type = name_and_type; - else - type++; - - if (strcmp("bits[]", type)) - continue; - - if (!ww || !hh) - RETURN (BitmapFileInvalid); - - if ((ww % 16) && ((ww % 16) < 9) && version10p) - padding = 1; - else - padding = 0; - - bytes_per_line = (ww+7)/8 + padding; - - size = bytes_per_line * hh; - data = (unsigned char *) Xmalloc ((unsigned int) size); - if (!data) - RETURN (BitmapNoMemory); - - if (version10p) { - unsigned char *ptr; - int bytes; - - for (bytes=0, ptr=data; bytes> 8; - } - } else { - unsigned char *ptr; - int bytes; - - for (bytes=0, ptr=data; bytes> 4]); - } - } - - /* if we want a mask invert the bits */ - if (!mask) - { - new_offset = &new_data[height * new_width]; - while (new_offset-- != new_data) - { - *new_offset ^= 0xff; - } - } - - bmp_info->bmiHeader.biWidth=width; - bmp_info->bmiHeader.biHeight=-(LONG)height; - bmp_info->bmiHeader.biPlanes=1; - bmp_info->bmiHeader.biSize=sizeof(BITMAPINFOHEADER); - bmp_info->bmiHeader.biBitCount=1; - bmp_info->bmiHeader.biCompression=BI_RGB; - bmp_info->bmiHeader.biClrUsed = 2; - bmp_info->bmiHeader.biClrImportant = 2; - bmp_info->bmiHeader.biSizeImage = height * new_width; - bmp_info->bmiColors[0].rgbRed = GetRValue (fg); - bmp_info->bmiColors[0].rgbGreen = GetGValue (fg); - bmp_info->bmiColors[0].rgbBlue = GetBValue (fg); - bmp_info->bmiColors[0].rgbReserved = 0; - bmp_info->bmiColors[1].rgbRed = GetRValue (bg); - bmp_info->bmiColors[1].rgbGreen = GetGValue (bg); - bmp_info->bmiColors[1].rgbBlue = GetBValue (bg); - bmp_info->bmiColors[1].rgbReserved = 0; - - bitmap = CreateDIBSection (hdc, - bmp_info, - DIB_RGB_COLORS, - &bmp_buf, - 0,0); - - xfree (bmp_info); - - if (!bitmap || !bmp_buf) - { - xfree (new_data); - return NULL; - } - - /* copy in the actual bitmap */ - memcpy (bmp_buf, new_data, height * new_width); - xfree (new_data); - - return bitmap; -} - -/* Given inline data for a mono pixmap, initialize the given - image instance accordingly. */ - -static void -init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii, - int width, int height, - /* Note that data is in ext-format! */ - CONST char *bits, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, - HBITMAP mask, - Lisp_Object mask_filename) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct frame* f = XFRAME (DEVICE_SELECTED_FRAME (XDEVICE (device))); - Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground); - Lisp_Object background = find_keyword_in_vector (instantiator, Q_background); - enum image_instance_type type; - COLORREF black = PALETTERGB (0,0,0); - COLORREF white = PALETTERGB (255,255,255); - - HDC hdc = FRAME_MSWINDOWS_CDC (f); - - if (!DEVICE_MSWINDOWS_P (XDEVICE (device))) - signal_simple_error ("Not an MS-Windows device", device); - - if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) && - (dest_mask & IMAGE_COLOR_PIXMAP_MASK)) - { - if (!NILP (foreground) || !NILP (background)) - type = IMAGE_COLOR_PIXMAP; - else - type = IMAGE_MONO_PIXMAP; - } - else if (dest_mask & IMAGE_MONO_PIXMAP_MASK) - type = IMAGE_MONO_PIXMAP; - else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) - type = IMAGE_COLOR_PIXMAP; - else if (dest_mask & IMAGE_POINTER_MASK) - type = IMAGE_POINTER; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK - | IMAGE_POINTER_MASK); - - mswindows_initialize_dibitmap_image_instance (ii, type); - - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = - find_keyword_in_vector (instantiator, Q_file); - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height; - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = 1; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), 0); - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), 0); - IMAGE_INSTANCE_MSWINDOWS_MASK (ii) = mask ? mask : - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, - TRUE, black, white); - - switch (type) - { - case IMAGE_MONO_PIXMAP: - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, - FALSE, black, black); - break; - - case IMAGE_COLOR_PIXMAP: - { - COLORREF fg = black; - COLORREF bg = white; - - if (!NILP (foreground) && !COLOR_INSTANCEP (foreground)) - foreground = - Fmake_color_instance (foreground, device, - encode_error_behavior_flag (ERROR_ME)); - - if (COLOR_INSTANCEP (foreground)) - fg = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (foreground)); - - if (!NILP (background) && !COLOR_INSTANCEP (background)) - background = - Fmake_color_instance (background, device, - encode_error_behavior_flag (ERROR_ME)); - - if (COLOR_INSTANCEP (background)) - bg = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (background)); - - IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; - IMAGE_INSTANCE_PIXMAP_BG (ii) = background; - - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, - FALSE, fg, black); - } - break; - - case IMAGE_POINTER: - { - COLORREF fg = black; - COLORREF bg = white; - - if (NILP (foreground)) - foreground = pointer_fg; - if (NILP (background)) - background = pointer_bg; - - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = - find_keyword_in_vector (instantiator, Q_hotspot_x); - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = - find_keyword_in_vector (instantiator, Q_hotspot_y); - IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; - IMAGE_INSTANCE_PIXMAP_BG (ii) = background; - if (COLOR_INSTANCEP (foreground)) - fg = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (foreground)); - if (COLOR_INSTANCEP (background)) - bg = COLOR_INSTANCE_MSWINDOWS_COLOR (XCOLOR_INSTANCE (background)); - - IMAGE_INSTANCE_MSWINDOWS_BITMAP (ii) = - xbm_create_bitmap_from_data (hdc, (Extbyte *) bits, width, height, - TRUE, fg, black); - mswindows_initialize_image_instance_icon (ii, TRUE); - } - break; - - default: - abort (); - } -} - -static void -xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, int width, int height, - /* Note that data is in ext-format! */ - CONST char *bits) -{ - Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data); - Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct frame* f = XFRAME (DEVICE_SELECTED_FRAME - (XDEVICE (IMAGE_INSTANCE_DEVICE (ii)))); - HDC hdc = FRAME_MSWINDOWS_CDC (f); - HBITMAP mask = 0; - CONST char *gcc_may_you_rot_in_hell; - - if (!NILP (mask_data)) - { - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))), - gcc_may_you_rot_in_hell); - mask = - xbm_create_bitmap_from_data ( hdc, - (unsigned char *) - gcc_may_you_rot_in_hell, - XINT (XCAR (mask_data)), - XINT (XCAR (XCDR (mask_data))), FALSE, - PALETTERGB (0,0,0), - PALETTERGB (255,255,255)); - } - - init_image_instance_from_xbm_inline (ii, width, height, bits, - instantiator, pointer_fg, pointer_bg, - dest_mask, mask, mask_file); -} - -/* Instantiate method for XBM's. */ - -static void -mswindows_xbm_instantiate (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST char *gcc_go_home; - - assert (!NILP (data)); - - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))), - gcc_go_home); - - xbm_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, XINT (XCAR (data)), - XINT (XCAR (XCDR (data))), gcc_go_home); -} - -#ifdef HAVE_XFACE -/********************************************************************** - * X-Face * - **********************************************************************/ -#if defined(EXTERN) -/* This is about to get redefined! */ -#undef EXTERN -#endif -/* We have to define SYSV32 so that compface.h includes string.h - instead of strings.h. */ -#define SYSV32 -#ifdef __cplusplus -extern "C" { -#endif -#include -#ifdef __cplusplus -} -#endif -/* JMP_BUF cannot be used here because if it doesn't get defined - to jmp_buf we end up with a conflicting type error with the - definition in compface.h */ -extern jmp_buf comp_env; -#undef SYSV32 - -static void -mswindows_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - int i, stattis; - char *p, *bits, *bp; - CONST char * volatile emsg = 0; - CONST char * volatile dstring; - - assert (!NILP (data)); - - GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring); - - if ((p = strchr (dstring, ':'))) - { - dstring = p + 1; - } - - /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */ - if (!(stattis = setjmp (comp_env))) - { - UnCompAll ((char *) dstring); - UnGenFace (); - } - - switch (stattis) - { - case -2: - emsg = "uncompface: internal error"; - break; - case -1: - emsg = "uncompface: insufficient or invalid data"; - break; - case 1: - emsg = "uncompface: excess data ignored"; - break; - } - - if (emsg) - signal_simple_error_2 (emsg, data, Qimage); - - bp = bits = (char *) alloca (PIXELS / 8); - - /* the compface library exports char F[], which uses a single byte per - pixel to represent a 48x48 bitmap. Yuck. */ - for (i = 0, p = F; i < (PIXELS / 8); ++i) - { - int n, b; - /* reverse the bit order of each byte... */ - for (b = n = 0; b < 8; ++b) - { - n |= ((*p++) << b); - } - *bp++ = (char) n; - } - - xbm_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, 48, 48, bits); -} -#endif /* HAVE_XFACE */ - - -/************************************************************************/ -/* image instance methods */ -/************************************************************************/ - -static void -mswindows_print_image_instance (struct Lisp_Image_Instance *p, - Lisp_Object printcharfun, - int escapeflag) -{ - char buf[100]; - - switch (IMAGE_INSTANCE_TYPE (p)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - sprintf (buf, " (0x%lx", - (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); - write_c_string (buf, printcharfun); - if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) - { - sprintf (buf, "/0x%lx", - (unsigned long) IMAGE_INSTANCE_MSWINDOWS_MASK (p)); - write_c_string (buf, printcharfun); - } - write_c_string (")", printcharfun); - break; - - default: - break; - } -} - -static void -mswindows_finalize_image_instance (struct Lisp_Image_Instance *p) -{ - if (DEVICE_LIVE_P (XDEVICE (p->device))) - { - if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) - { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) - DestroyWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p)); - IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; - } - else if (p->data) - { - if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)) - DeleteObject (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p)); - IMAGE_INSTANCE_MSWINDOWS_BITMAP (p) = 0; - if (IMAGE_INSTANCE_MSWINDOWS_MASK (p)) - DeleteObject (IMAGE_INSTANCE_MSWINDOWS_MASK (p)); - IMAGE_INSTANCE_MSWINDOWS_MASK (p) = 0; - if (IMAGE_INSTANCE_MSWINDOWS_ICON (p)) - DestroyIcon (IMAGE_INSTANCE_MSWINDOWS_ICON (p)); - IMAGE_INSTANCE_MSWINDOWS_ICON (p) = 0; - } - } - - if (p->data) - { - xfree (p->data); - p->data = 0; - } -} - -/************************************************************************/ -/* subwindow and widget support */ -/************************************************************************/ - -/* unmap the image if it is a widget. This is used by redisplay via - redisplay_unmap_subwindows */ -static void -mswindows_unmap_subwindow (struct Lisp_Image_Instance *p) -{ - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) - { - SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - NULL, - 0, 0, 0, 0, - SWP_HIDEWINDOW | SWP_NOMOVE | SWP_NOSIZE - | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); - } -} - -/* map the subwindow. This is used by redisplay via - redisplay_output_subwindow */ -static void -mswindows_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) -{ - /* ShowWindow (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), SW_SHOW);*/ - SetWindowPos (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - NULL, - x, y, 0, 0, - SWP_NOZORDER | SWP_SHOWWINDOW | SWP_NOSIZE - | SWP_NOCOPYBITS | SWP_NOSENDCHANGING); -} - -/* when you click on a widget you may activate another widget this - needs to be checked and all appropriate widgets updated */ -static void -mswindows_update_subwindow (struct Lisp_Image_Instance *p) -{ - if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET) - { - /* buttons checked or otherwise */ - if ( EQ (IMAGE_INSTANCE_WIDGET_TYPE (p), Qbutton)) - { - if (gui_item_selected_p (&IMAGE_INSTANCE_WIDGET_ITEM (p))) - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - BM_SETCHECK, (WPARAM)BST_CHECKED, 0); - else - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (p), - BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); - } - } -} - -/* register widgets into our hastable so that we can cope with the - callbacks. The hashtable is weak so deregistration is handled - automatically */ -static int -mswindows_register_widget_instance (Lisp_Object instance, Lisp_Object domain) -{ - Lisp_Object frame = FW_FRAME (domain); - struct frame* f = XFRAME (frame); - int id = gui_item_hash (FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), - &XIMAGE_INSTANCE_WIDGET_ITEM (instance), - WIDGET_GLYPH_SLOT); - Fputhash (make_int (id), - XIMAGE_INSTANCE_WIDGET_CALLBACK (instance), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f)); - return id; -} - -static void -mswindows_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - struct device* d = XDEVICE (device); - Lisp_Object frame = FW_FRAME (domain); - HWND wnd; - - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); - - /* have to set the type this late in case there is no device - instantiation for a widget */ - IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; - - wnd = CreateWindow( "STATIC", - "", - WS_CHILD, - 0, /* starting x position */ - 0, /* starting y position */ - IMAGE_INSTANCE_WIDGET_WIDTH (ii), - IMAGE_INSTANCE_WIDGET_HEIGHT (ii), - FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), /* parent window */ - 0, - (HINSTANCE) - GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - GWL_HINSTANCE), - NULL); - - SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; -} - -static int -mswindows_image_instance_equal (struct Lisp_Image_Instance *p1, - struct Lisp_Image_Instance *p2, int depth) -{ - switch (IMAGE_INSTANCE_TYPE (p1)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - if (IMAGE_INSTANCE_MSWINDOWS_BITMAP (p1) - != IMAGE_INSTANCE_MSWINDOWS_BITMAP (p2)) - return 0; - break; - - default: - break; - } - - return 1; -} - -static unsigned long -mswindows_image_instance_hash (struct Lisp_Image_Instance *p, int depth) -{ - switch (IMAGE_INSTANCE_TYPE (p)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return (unsigned long) IMAGE_INSTANCE_MSWINDOWS_BITMAP (p); - - default: - return 0; - } -} - -/* Set all the slots in an image instance structure to reasonable - default values. This is used somewhere within an instantiate - method. It is assumed that the device slot within the image - instance is already set -- this is the case when instantiate - methods are called. */ - -static void -mswindows_initialize_dibitmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type) -{ - ii->data = xnew_and_zero (struct mswindows_image_instance_data); - IMAGE_INSTANCE_TYPE (ii) = type; - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil; -} - - -/************************************************************************/ -/* widgets */ -/************************************************************************/ - -static void -mswindows_widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain, - CONST char* class, int flags, int exflags) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); -#if 0 - struct Lisp_Image_Instance *groupii = 0; - Lisp_Object group = find_keyword_in_vector (instantiator, Q_group); -#endif - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii), style; - struct device* d = XDEVICE (device); - Lisp_Object frame = FW_FRAME (domain); - Extbyte* nm=0; - HWND wnd; - int id = 0xffff; - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); - - if (!DEVICE_MSWINDOWS_P (d)) - signal_simple_error ("Not an mswindows device", device); -#if 0 - /* if the user specified another glyph as a group pick up the - instance in our domain. */ - if (!NILP (group)) - { - if (SYMBOLP (group)) - group = XSYMBOL (group)->value; - group = glyph_image_instance (group, domain, ERROR_ME, 1); - groupii = XIMAGE_INSTANCE (group); - } -#endif - if (!gui_item_active_p (pgui)) - flags |= WS_DISABLED; - - style = pgui->style; - - if (!NILP (pgui->callback)) - { - id = mswindows_register_widget_instance (image_instance, domain); - } - /* have to set the type this late in case there is no device - instantiation for a widget */ - IMAGE_INSTANCE_TYPE (ii) = IMAGE_WIDGET; - if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - GET_C_STRING_OS_DATA_ALLOCA (IMAGE_INSTANCE_WIDGET_TEXT (ii), nm); - - wnd = CreateWindowEx( - exflags /* | WS_EX_NOPARENTNOTIFY*/, - class, - nm, - flags | WS_CHILD, - 0, /* starting x position */ - 0, /* starting y position */ - IMAGE_INSTANCE_WIDGET_WIDTH (ii), - IMAGE_INSTANCE_WIDGET_HEIGHT (ii), - /* parent window */ - FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - (HMENU)id, /* No menu */ - (HINSTANCE) - GetWindowLong (FRAME_MSWINDOWS_HANDLE (XFRAME (frame)), - GWL_HINSTANCE), - NULL); - - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = wnd; - SetWindowLong (wnd, GWL_USERDATA, (LONG)LISP_TO_VOID(image_instance)); - /* set the widget font from the widget face */ - SendMessage (wnd, WM_SETFONT, - (WPARAM)FONT_INSTANCE_MSWINDOWS_HFONT - (XFONT_INSTANCE (widget_face_font_info - (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), - 0, 0))), - MAKELPARAM (TRUE, 0)); -} - -/* Instantiate a button widget. Unfortunately instantiated widgets are - particular to a frame since they need to have a parent. It's not - like images where you just select the image into the context you - want to display it in and BitBlt it. So images instances can have a - many-to-one relationship with things you see, whereas widgets can - only be one-to-one (i.e. per frame) */ -static void -mswindows_button_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - HWND wnd; - int flags = BS_NOTIFY; - Lisp_Object style; - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); - Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); - - if (!gui_item_active_p (pgui)) - flags |= WS_DISABLED; - - if (!NILP (glyph)) - { - if (!IMAGE_INSTANCEP (glyph)) - glyph = glyph_image_instance (glyph, domain, ERROR_ME, 1); - - if (IMAGE_INSTANCEP (glyph)) - flags |= XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? - BS_BITMAP : BS_ICON; - } - - style = pgui->style; - - if (EQ (style, Qradio)) - { - flags |= BS_RADIOBUTTON; - } - else if (EQ (style, Qtoggle)) - { - flags |= BS_AUTOCHECKBOX; - } - else - flags |= BS_DEFPUSHBUTTON; - - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "BUTTON", flags, - WS_EX_CONTROLPARENT); - - wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* set the checked state */ - if (gui_item_selected_p (pgui)) - SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_CHECKED, 0); - else - SendMessage (wnd, BM_SETCHECK, (WPARAM)BST_UNCHECKED, 0); - /* add the image if one was given */ - if (!NILP (glyph) && IMAGE_INSTANCEP (glyph)) - { - SendMessage (wnd, BM_SETIMAGE, - (WPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? - IMAGE_BITMAP : IMAGE_ICON), - (LPARAM) (XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) ? - XIMAGE_INSTANCE_MSWINDOWS_BITMAP (glyph) : - XIMAGE_INSTANCE_MSWINDOWS_ICON (glyph))); - } -} - -/* instantiate an edit control */ -static void -mswindows_edit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "EDIT", - ES_LEFT | ES_AUTOHSCROLL | WS_TABSTOP - | WS_BORDER, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); -} - -/* instantiate an edit control */ -static void -mswindows_progress_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - HWND wnd; - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, PROGRESS_CLASS, - WS_TABSTOP | WS_BORDER | PBS_SMOOTH, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); - wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* set the colors */ -#ifdef PBS_SETBKCOLOR - SendMessage (wnd, PBS_SETBKCOLOR, 0, - (LPARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_BACKGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (ii), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))))); -#endif -#ifdef PBS_SETBARCOLOR - SendMessage (wnd, PBS_SETBARCOLOR, 0, - (L:PARAM) (COLOR_INSTANCE_MSWINDOWS_COLOR - (XCOLOR_INSTANCE - (FACE_FOREGROUND - (XIMAGE_INSTANCE_WIDGET_FACE (ii), - XIMAGE_INSTANCE_SUBWINDOW_FRAME (ii)))))); -#endif -} - -/* instantiate a static control possible for putting other things in */ -static void -mswindows_label_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "STATIC", - 0, WS_EX_STATICEDGE); -} - -#if 0 -/* instantiate a static control possible for putting other things in */ -static void -mswindows_group_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "BUTTON", - WS_GROUP | BS_GROUPBOX | WS_BORDER, - WS_EX_CLIENTEDGE ); -} -#endif - -/* instantiate a scrollbar control */ -static void -mswindows_scrollbar_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "SCROLLBAR", - 0, - WS_EX_CLIENTEDGE ); -} - -/* instantiate a combo control */ -static void -mswindows_combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - HANDLE wnd; - Lisp_Object rest; - - /* Maybe ought to generalise this more but it may be very windows - specific. In windows the window height of a combo box is the - height when the combo box is open. Thus we need to set the height - before creating the window and then reset it to a single line - after the window is created so that redisplay does the right - thing. */ - mswindows_widget_instantiate (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, "COMBOBOX", - WS_BORDER | WS_TABSTOP | CBS_DROPDOWN - | CBS_AUTOHSCROLL - | CBS_HASSTRINGS | WS_VSCROLL, - WS_EX_CLIENTEDGE | WS_EX_CONTROLPARENT); - /* reset the height */ - widget_text_to_pixel_conversion (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), 1, 0, - &IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii), 0); - wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* add items to the combo box */ - SendMessage (wnd, CB_RESETCONTENT, 0, 0); - LIST_LOOP (rest, Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), Q_items, Qnil)) - { - Extbyte* lparam; - GET_C_STRING_OS_DATA_ALLOCA (XCAR (rest), lparam); - if (SendMessage (wnd, CB_ADDSTRING, 0, (LPARAM)lparam) == CB_ERR) - signal_simple_error ("error adding combo entries", instantiator); - } -} - -/* get properties of a control */ -static Lisp_Object -mswindows_widget_property (Lisp_Object image_instance, Lisp_Object prop) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* get the text from a control */ - if (EQ (prop, Q_text)) - { - Extcount len = SendMessage (wnd, WM_GETTEXTLENGTH, 0, 0); - Extbyte* buf =alloca (len+1); - - SendMessage (wnd, WM_GETTEXT, (WPARAM)len+1, (LPARAM) buf); - return build_ext_string (buf, FORMAT_OS); - } - return Qunbound; -} - -/* get properties of a button */ -static Lisp_Object -mswindows_button_property (Lisp_Object image_instance, Lisp_Object prop) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* check the state of a button */ - if (EQ (prop, Q_selected)) - { - if (SendMessage (wnd, BM_GETSTATE, 0, 0) & BST_CHECKED) - return Qt; - else - return Qnil; - } - return Qunbound; -} - -/* get properties of a combo box */ -static Lisp_Object -mswindows_combo_property (Lisp_Object image_instance, Lisp_Object prop) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - HANDLE wnd = WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii); - /* get the text from a control */ - if (EQ (prop, Q_text)) - { - long item = SendMessage (wnd, CB_GETCURSEL, 0, 0); - Extcount len = SendMessage (wnd, CB_GETLBTEXTLEN, (WPARAM)item, 0); - Extbyte* buf = alloca (len+1); - SendMessage (wnd, CB_GETLBTEXT, (WPARAM)item, (LPARAM)buf); - return build_ext_string (buf, FORMAT_OS); - } - return Qunbound; -} - -/* set the properties of a control */ -static Lisp_Object -mswindows_widget_set_property (Lisp_Object image_instance, Lisp_Object prop, - Lisp_Object val) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - if (EQ (prop, Q_text)) - { - Extbyte* lparam=0; - CHECK_STRING (val); - GET_C_STRING_OS_DATA_ALLOCA (val, lparam); - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), - WM_SETTEXT, 0, (LPARAM)lparam); - return Qt; - } - return Qunbound; -} - -/* set the properties of a progres guage */ -static Lisp_Object -mswindows_progress_set_property (Lisp_Object image_instance, Lisp_Object prop, - Lisp_Object val) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - if (EQ (prop, Q_percent)) - { - CHECK_INT (val); - SendMessage (WIDGET_INSTANCE_MSWINDOWS_HANDLE (ii), - PBM_SETPOS, (WPARAM)XINT (val), 0); - return Qt; - } - return Qunbound; -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_glyphs_mswindows (void) -{ - defkeyword (&Q_resource_id, ":resource-id"); - defkeyword (&Q_resource_type, ":resource-type"); -} - -void -console_type_create_glyphs_mswindows (void) -{ - /* image methods */ - - CONSOLE_HAS_METHOD (mswindows, print_image_instance); - CONSOLE_HAS_METHOD (mswindows, finalize_image_instance); - CONSOLE_HAS_METHOD (mswindows, unmap_subwindow); - CONSOLE_HAS_METHOD (mswindows, map_subwindow); - CONSOLE_HAS_METHOD (mswindows, update_subwindow); - CONSOLE_HAS_METHOD (mswindows, image_instance_equal); - CONSOLE_HAS_METHOD (mswindows, image_instance_hash); - CONSOLE_HAS_METHOD (mswindows, init_image_instance_from_eimage); - CONSOLE_HAS_METHOD (mswindows, locate_pixmap_file); -} - -void -image_instantiator_format_create_glyphs_mswindows (void) -{ - /* image-instantiator types */ -#ifdef HAVE_XPM - INITIALIZE_DEVICE_IIFORMAT (mswindows, xpm); - IIFORMAT_HAS_DEVMETHOD (mswindows, xpm, instantiate); -#endif - INITIALIZE_DEVICE_IIFORMAT (mswindows, xbm); - IIFORMAT_HAS_DEVMETHOD (mswindows, xbm, instantiate); -#ifdef HAVE_XFACE - INITIALIZE_DEVICE_IIFORMAT (mswindows, xface); - IIFORMAT_HAS_DEVMETHOD (mswindows, xface, instantiate); -#endif - INITIALIZE_DEVICE_IIFORMAT (mswindows, button); - IIFORMAT_HAS_DEVMETHOD (mswindows, button, property); - IIFORMAT_HAS_DEVMETHOD (mswindows, button, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, edit); - IIFORMAT_HAS_DEVMETHOD (mswindows, edit, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, subwindow); - IIFORMAT_HAS_DEVMETHOD (mswindows, subwindow, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, widget); - IIFORMAT_HAS_DEVMETHOD (mswindows, widget, property); - IIFORMAT_HAS_DEVMETHOD (mswindows, widget, set_property); -#if 0 - INITIALIZE_DEVICE_IIFORMAT (mswindows, group); - IIFORMAT_HAS_DEVMETHOD (mswindows, group, instantiate); -#endif - INITIALIZE_DEVICE_IIFORMAT (mswindows, label); - IIFORMAT_HAS_DEVMETHOD (mswindows, label, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, combo); - IIFORMAT_HAS_DEVMETHOD (mswindows, combo, property); - IIFORMAT_HAS_DEVMETHOD (mswindows, combo, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, scrollbar); - IIFORMAT_HAS_DEVMETHOD (mswindows, scrollbar, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (mswindows, progress); - IIFORMAT_HAS_DEVMETHOD (mswindows, progress, set_property); - IIFORMAT_HAS_DEVMETHOD (mswindows, progress, instantiate); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (bmp, "bmp"); - - IIFORMAT_HAS_METHOD (bmp, validate); - IIFORMAT_HAS_METHOD (bmp, normalize); - IIFORMAT_HAS_METHOD (bmp, possible_dest_types); - IIFORMAT_HAS_METHOD (bmp, instantiate); - - IIFORMAT_VALID_KEYWORD (bmp, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (bmp, Q_file, check_valid_string); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (mswindows_resource, - "mswindows-resource"); - - IIFORMAT_HAS_METHOD (mswindows_resource, validate); - IIFORMAT_HAS_METHOD (mswindows_resource, normalize); - IIFORMAT_HAS_METHOD (mswindows_resource, possible_dest_types); - IIFORMAT_HAS_METHOD (mswindows_resource, instantiate); - - IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_type, - check_valid_resource_symbol); - IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_resource_id, check_valid_resource_id); - IIFORMAT_VALID_KEYWORD (mswindows_resource, Q_file, check_valid_string); -} - -void -vars_of_glyphs_mswindows (void) -{ - Fprovide (Qbmp); - Fprovide (Qmswindows_resource); - DEFVAR_LISP ("mswindows-bitmap-file-path", &Vmswindows_bitmap_file_path /* -A list of the directories in which mswindows bitmap files may be found. -This is used by the `make-image-instance' function. -*/ ); - Vmswindows_bitmap_file_path = Qnil; - - Fprovide (Qbutton); - Fprovide (Qedit); - Fprovide (Qcombo); - Fprovide (Qscrollbar); - Fprovide (Qlabel); - Fprovide (Qprogress); -} - -void -complex_vars_of_glyphs_mswindows (void) -{ -} diff --git a/src/glyphs-msw.h b/src/glyphs-msw.h deleted file mode 100644 index 8371d0a..0000000 --- a/src/glyphs-msw.h +++ /dev/null @@ -1,82 +0,0 @@ -/* mswindows-specific glyphs and related. - Copyright (C) 1998 Andy Piper - -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. */ - -#ifndef _XEMACS_GLYPHS_MSW_H_ -#define _XEMACS_GLYPHS_MSW_H_ - -#ifdef HAVE_MS_WINDOWS - -#include -#include "glyphs.h" - -/**************************************************************************** - * Image-Instance Object * - ****************************************************************************/ - -struct mswindows_image_instance_data -{ - HBITMAP bitmap; - HBITMAP mask; - HICON icon; -}; - -#define MSWINDOWS_IMAGE_INSTANCE_DATA(i) \ -((struct mswindows_image_instance_data *) (i)->data) - -#define IMAGE_INSTANCE_MSWINDOWS_BITMAP(i) \ - (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->bitmap) -#define IMAGE_INSTANCE_MSWINDOWS_MASK(i) \ - (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->mask) -#define IMAGE_INSTANCE_MSWINDOWS_ICON(i) \ - (MSWINDOWS_IMAGE_INSTANCE_DATA (i)->icon) - -#define XIMAGE_INSTANCE_MSWINDOWS_BITMAP(i) \ - IMAGE_INSTANCE_MSWINDOWS_BITMAP (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_MSWINDOWS_MASK(i) \ - IMAGE_INSTANCE_MSWINDOWS_MASK (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_MSWINDOWS_ICON(i) \ - IMAGE_INSTANCE_MSWINDOWS_ICON (XIMAGE_INSTANCE (i)) - -int -mswindows_resize_dibitmap_instance (struct Lisp_Image_Instance* ii, - struct frame* f, - int newx, int newy); -HBITMAP -mswindows_create_resized_bitmap (struct Lisp_Image_Instance* ii, - struct frame* f, - int newx, int newy); -HBITMAP -mswindows_create_resized_mask (struct Lisp_Image_Instance* ii, - struct frame* f, - int newx, int newy); -void -mswindows_initialize_image_instance_icon (struct Lisp_Image_Instance* image, - int cursor); - -#define WIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ - (HWND) (IMAGE_INSTANCE_SUBWINDOW_ID (i)) - -#define XWIDGET_INSTANCE_MSWINDOWS_HANDLE(i) \ - WIDGET_INSTANCE_MSWINDOWS_HANDLE (XIMAGE_INSTANCE (i)) - -#endif /* HAVE_MS_WINDOWS */ -#endif /* _XEMACS_GLYPHS_MSW_H_ */ diff --git a/src/glyphs-widget.c b/src/glyphs-widget.c deleted file mode 100644 index 3e2162b..0000000 --- a/src/glyphs-widget.c +++ /dev/null @@ -1,557 +0,0 @@ -/* Widget-specific glyph objects. - Copyright (C) 1998 Andy Piper - -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 Andy Piper */ - -#include -#include "lisp.h" -#include "lstream.h" -#include "console.h" -#include "device.h" -#include "faces.h" -#include "glyphs.h" -#include "objects.h" -#include "bytecode.h" -#include "window.h" -#include "buffer.h" -#include "frame.h" -#include "insdel.h" -#include "opaque.h" - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (button); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (combo); -Lisp_Object Qcombo; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (edit); -Lisp_Object Qedit; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (scrollbar); -Lisp_Object Qscrollbar; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (widget); -#if 0 -DEFINE_IMAGE_INSTANTIATOR_FORMAT (group); -Lisp_Object Qgroup; -#endif -DEFINE_IMAGE_INSTANTIATOR_FORMAT (label); -Lisp_Object Qlabel; -DEFINE_IMAGE_INSTANTIATOR_FORMAT (progress); -Lisp_Object Qprogress; - -Lisp_Object Q_descriptor, Q_height, Q_width, Q_properties, Q_items; -Lisp_Object Q_image, Q_text, Q_percent; - -#define WIDGET_BORDER_HEIGHT 2 -#define WIDGET_BORDER_WIDTH 4 - -/* TODO: - - more complex controls. - - tooltips for controls. - */ - -/* In windows normal windows work in pixels, dialog boxes work in - dialog box units. Why? sigh. We could reuse the metrics for dialogs - if this were not the case. As it is we have to position things - pixel wise. I'm not even sure that X has this problem at least for - buttons in groups. */ -Lisp_Object -widget_face_font_info (Lisp_Object domain, Lisp_Object face, - int *height, int *width) -{ - Lisp_Object font_instance = FACE_FONT (face, domain, Vcharset_ascii); - - if (height) - *height = XFONT_INSTANCE (font_instance)->height; - if (width) - *width = XFONT_INSTANCE (font_instance)->width; - - return font_instance; -} - -void -widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, - int th, int tw, - int* height, int* width) -{ - int ch=0, cw=0; - widget_face_font_info (domain, face, &ch, &cw); - if (height) - *height = th * (ch + 2 * WIDGET_BORDER_HEIGHT); - if (width) - *width = tw * cw + 2 * WIDGET_BORDER_WIDTH; -} - -static int -widget_possible_dest_types (void) -{ - return IMAGE_WIDGET_MASK; -} - -static void -check_valid_glyph_or_image (Lisp_Object data) -{ - Lisp_Object glyph = data; - if (SYMBOLP (data)) - glyph = XSYMBOL (data)->value; - - if (IMAGE_INSTANCEP (glyph)) - CHECK_IMAGE_INSTANCE (glyph); - else if (!CONSP (glyph)) - CHECK_BUFFER_GLYPH (glyph); -} - -static void -check_valid_anything (Lisp_Object data) -{ -} - -static void -check_valid_callback (Lisp_Object data) -{ - if (!SYMBOLP (data) - && !COMPILED_FUNCTIONP (data) - && !CONSP (data)) - { - signal_simple_error (":callback must be a function or expression", data); - } -} - -static void -check_valid_symbol (Lisp_Object data) -{ - CHECK_SYMBOL (data); -} - -static void -check_valid_string_or_vector (Lisp_Object data) -{ - if (!STRINGP (data) && !VECTORP (data)) - signal_simple_error (":descriptor must be a string or a vector", data); -} - -static void -check_valid_item_list (Lisp_Object data) -{ - Lisp_Object rest; - Lisp_Object items; - Fcheck_valid_plist (data); - - items = Fplist_get (data, Q_items, Qnil); - - CHECK_LIST (items); - EXTERNAL_LIST_LOOP (rest, items) - { - CHECK_STRING (XCAR (rest)); - } -} - -/* wire widget property invocations to specific widgets ... The - problem we are solving here is that when instantiators get converted - to instances they lose some type information (they just become - subwindows or widgets for example). For widgets we need to preserve - this type information so that we can do widget specific operations on - the instances. This is encoded in the widget type - field. widget_property gets invoked by decoding the primary type - (Qwidget), widget property then invokes based on the secondary type - (Qedit for example). It is debatable that we should wire things in this - generalised way rather than treating widgets specially in - image_instance_property. */ -static Lisp_Object -widget_property (Lisp_Object image_instance, Lisp_Object prop) -{ - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; - - /* first see if its a general property ... */ - if (!NILP (Fplist_member (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop))) - return Fplist_get (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, Qnil); - - /* .. then try device specific methods ... */ - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), - IMAGE_INSTANCE_WIDGET_TYPE (ii), - ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, property)) - return IIFORMAT_METH (meths, property, (image_instance, prop)); - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), - ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, property)) - return IIFORMAT_METH (meths, property, (image_instance, prop)); - /* ... then fail */ - return Qunbound; -} - -static Lisp_Object -widget_set_property (Lisp_Object image_instance, Lisp_Object prop, Lisp_Object val) -{ - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (image_instance); - struct image_instantiator_methods* meths; - Lisp_Object ret; - - /* try device specific methods first ... */ - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), - IMAGE_INSTANCE_WIDGET_TYPE (ii), - ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, IMAGE_INSTANCE_WIDGET_TYPE (ii), - ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } - /* we didn't do any device specific properties, so shove the property in our plist */ - IMAGE_INSTANCE_WIDGET_PROPS (ii) - = Fplist_put (IMAGE_INSTANCE_WIDGET_PROPS (ii), prop, val); - return val; -} - -static void -widget_validate (Lisp_Object instantiator) -{ - Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); - struct gui_item gui; - if (NILP (desc)) - signal_simple_error ("Must supply :descriptor", instantiator); - - if (VECTORP (desc)) - gui_parse_item_keywords (desc, &gui); - - if (!NILP (find_keyword_in_vector (instantiator, Q_width)) - && !NILP (find_keyword_in_vector (instantiator, Q_pixel_width))) - signal_simple_error ("Must supply only one of :width and :pixel-width", instantiator); - - if (!NILP (find_keyword_in_vector (instantiator, Q_height)) - && !NILP (find_keyword_in_vector (instantiator, Q_pixel_height))) - signal_simple_error ("Must supply only one of :height and :pixel-height", instantiator); -} - -static void -combo_validate (Lisp_Object instantiator) -{ - widget_validate (instantiator); - if (NILP (find_keyword_in_vector (instantiator, Q_properties))) - signal_simple_error ("Must supply item list", instantiator); -} - -/* we need to convert things like glyphs to images, eval expressions - etc.*/ -static Lisp_Object -widget_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - /* This function can call lisp */ - Lisp_Object glyph = find_keyword_in_vector (inst, Q_image); - - /* we need to eval glyph if its an expression, we do this for the - same reasons we normalize file to data. */ - if (!NILP (glyph)) - { - int i; - struct gcpro gcpro1; - if (SYMBOLP (glyph)) - glyph = XSYMBOL (glyph)->value; - GCPRO1 (glyph); - - if (CONSP (glyph)) - glyph = Feval (glyph); - /* substitute the new glyph */ - for (i = 0; i < XVECTOR_LENGTH (inst); i++) - { - if (EQ (Q_image, XVECTOR_DATA (inst)[i])) - { - XVECTOR_DATA (inst)[i+1] = glyph; - break; - } - } - UNGCPRO; - } - return inst; -} - -static void -initialize_widget_image_instance (struct Lisp_Image_Instance *ii, Lisp_Object type) -{ - /* initialize_subwindow_image_instance (ii);*/ - IMAGE_INSTANCE_WIDGET_TYPE (ii) = type; - IMAGE_INSTANCE_WIDGET_PROPS (ii) = Qnil; - IMAGE_INSTANCE_WIDGET_FACE (ii) = Vwidget_face; - gui_item_init (&IMAGE_INSTANCE_WIDGET_ITEM (ii)); -} - -/* Instantiate a button widget. Unfortunately instantiated widgets are - particular to a frame since they need to have a parent. It's not - like images where you just select the image into the context you - want to display it in and BitBlt it. So images instances can have a - many-to-one relationship with things you see, whereas widgets can - only be one-to-one (i.e. per frame) */ -static void -widget_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain, int default_textheight, - int default_pixheight) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - struct gui_item* pgui = &IMAGE_INSTANCE_WIDGET_ITEM (ii); - Lisp_Object face = find_keyword_in_vector (instantiator, Q_face); - Lisp_Object height = find_keyword_in_vector (instantiator, Q_height); - Lisp_Object width = find_keyword_in_vector (instantiator, Q_width); - Lisp_Object pixwidth = find_keyword_in_vector (instantiator, Q_pixel_width); - Lisp_Object pixheight = find_keyword_in_vector (instantiator, Q_pixel_height); - Lisp_Object desc = find_keyword_in_vector (instantiator, Q_descriptor); - Lisp_Object glyph = find_keyword_in_vector (instantiator, Q_image); - int pw=0, ph=0, tw=0, th=0; - - /* this just does pixel type sizing */ - subwindow_instantiate (image_instance, instantiator, pointer_fg, pointer_bg, - dest_mask, domain); - - if (!(dest_mask & IMAGE_WIDGET_MASK)) - incompatible_image_types (instantiator, dest_mask, IMAGE_WIDGET_MASK); - - initialize_widget_image_instance (ii, XVECTOR_DATA (instantiator)[0]); - - /* retrieve the fg and bg colors */ - if (!NILP (face)) - IMAGE_INSTANCE_WIDGET_FACE (ii) = Fget_face (face); - - /* data items for some widgets */ - IMAGE_INSTANCE_WIDGET_PROPS (ii) = - find_keyword_in_vector (instantiator, Q_properties); - - /* retrieve the gui item information. This is easy if we have been - provided with a vector, more difficult if we have just been given - keywords */ - if (STRINGP (desc) || NILP (desc)) - { - /* big cheat - we rely on the fact that a gui item looks like an instantiator */ - gui_parse_item_keywords_no_errors (instantiator, pgui); - IMAGE_INSTANCE_WIDGET_TEXT (ii) = desc; - } - else - gui_parse_item_keywords_no_errors (desc, pgui); - - /* normalize size information */ - if (!NILP (width)) - tw = XINT (width); - if (!NILP (height)) - th = XINT (height); - if (!NILP (pixwidth)) - pw = XINT (pixwidth); - if (!NILP (pixheight)) - ph = XINT (pixheight); - - /* for a widget with an image pick up the dimensions from that */ - if (!NILP (glyph)) - { - if (!pw && !tw) - pw = glyph_width (glyph, Qnil, DEFAULT_INDEX, domain) - + 2 * WIDGET_BORDER_WIDTH; - if (!ph && !th) - ph = glyph_height (glyph, Qnil, DEFAULT_INDEX, domain) - + 2 * WIDGET_BORDER_HEIGHT; - } - - /* if we still don' t have sizes, guess from text size */ - if (!tw && !pw && !NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - tw = XSTRING_LENGTH (IMAGE_INSTANCE_WIDGET_TEXT (ii)); - if (!th && !ph) - { - if (default_textheight) - th = default_textheight; - else if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - th = 1; - else - ph = default_pixheight; - } - - if (tw !=0 || th !=0) - widget_text_to_pixel_conversion (domain, - IMAGE_INSTANCE_WIDGET_FACE (ii), - th, tw, th ? &ph : 0, tw ? &pw : 0); - - IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = pw; - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = ph; -} - -static void -widget_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, 1, 0); -} - -static void -combo_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = Fplist_get (find_keyword_in_vector (instantiator, Q_properties), - Q_items, Qnil); - int len; - GET_LIST_LENGTH (data, len); - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, len + 1, 0); -} - -/* Instantiate a static control */ -static void -static_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - widget_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, domain, 0, 4); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_glyphs_widget (void) -{ - defkeyword (&Q_descriptor, ":descriptor"); - defkeyword (&Q_height, ":height"); - defkeyword (&Q_width, ":width"); - defkeyword (&Q_properties, ":properties"); - defkeyword (&Q_items, ":items"); - defkeyword (&Q_image, ":image"); - defkeyword (&Q_percent, ":percent"); - defkeyword (&Q_text, "text"); -} - -void -image_instantiator_format_create_glyphs_widget (void) -{ -#define VALID_GUI_KEYWORDS(type) \ - IIFORMAT_VALID_KEYWORD (type, Q_active, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_suffix, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_keys, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_style, check_valid_symbol); \ - IIFORMAT_VALID_KEYWORD (type, Q_selected, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_filter, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_config, check_valid_symbol); \ - IIFORMAT_VALID_KEYWORD (type, Q_included, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_key_sequence, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_accelerator, check_valid_string); \ - IIFORMAT_VALID_KEYWORD (type, Q_label, check_valid_anything); \ - IIFORMAT_VALID_KEYWORD (type, Q_callback, check_valid_callback); \ - IIFORMAT_VALID_KEYWORD (type, Q_descriptor, check_valid_string_or_vector) - -#define VALID_WIDGET_KEYWORDS(type) \ - IIFORMAT_VALID_KEYWORD (type, Q_width, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_height, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_pixel_width, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_pixel_height, check_valid_int); \ - IIFORMAT_VALID_KEYWORD (type, Q_face, check_valid_face) - - /* we only do this for properties */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM (widget, "widget"); - IIFORMAT_HAS_METHOD (widget, property); - IIFORMAT_HAS_METHOD (widget, set_property); - - /* widget image-instantiator types - buttons */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (button, "button"); - IIFORMAT_HAS_SHARED_METHOD (button, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (button, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (button, instantiate, widget); - IIFORMAT_HAS_SHARED_METHOD (button, normalize, widget); - IIFORMAT_VALID_KEYWORD (button, Q_image, check_valid_glyph_or_image); - VALID_WIDGET_KEYWORDS (button); - VALID_GUI_KEYWORDS (button); - - /* edit fields */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (edit, "edit"); - IIFORMAT_HAS_SHARED_METHOD (edit, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (edit, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (edit, instantiate, widget); - VALID_WIDGET_KEYWORDS (edit); - VALID_GUI_KEYWORDS (edit); - - /* combo box */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (combo, "combo"); - IIFORMAT_HAS_METHOD (combo, validate); - IIFORMAT_HAS_SHARED_METHOD (combo, possible_dest_types, widget); - IIFORMAT_HAS_METHOD (combo, instantiate); - VALID_GUI_KEYWORDS (combo); - - IIFORMAT_VALID_KEYWORD (combo, Q_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (combo, Q_face, check_valid_face); - IIFORMAT_VALID_KEYWORD (combo, Q_properties, check_valid_item_list); - - /* scrollbar */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (scrollbar, "scrollbar"); - IIFORMAT_HAS_SHARED_METHOD (scrollbar, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (scrollbar, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (scrollbar, instantiate, widget); - VALID_GUI_KEYWORDS (scrollbar); - - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_pixel_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (scrollbar, Q_face, check_valid_face); - - /* progress guage */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (progress, "progress"); - IIFORMAT_HAS_SHARED_METHOD (progress, validate, widget); - IIFORMAT_HAS_SHARED_METHOD (progress, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (progress, instantiate, widget); - VALID_WIDGET_KEYWORDS (progress); - VALID_GUI_KEYWORDS (progress); - - /* labels */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (label, "label"); - IIFORMAT_HAS_SHARED_METHOD (label, possible_dest_types, widget); - IIFORMAT_HAS_SHARED_METHOD (label, instantiate, static); - VALID_WIDGET_KEYWORDS (label); - IIFORMAT_VALID_KEYWORD (label, Q_descriptor, check_valid_string); - -#if 0 - /* group */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (group, "group"); - IIFORMAT_HAS_SHARED_METHOD (group, possible_dest_types, widget); - IIFORMAT_HAS_METHOD (group, instantiate); - - IIFORMAT_VALID_KEYWORD (group, Q_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_pixel_height, check_valid_int); - IIFORMAT_VALID_KEYWORD (group, Q_face, check_valid_face); - IIFORMAT_VALID_KEYWORD (group, Q_background, check_valid_string); - IIFORMAT_VALID_KEYWORD (group, Q_descriptor, check_valid_string); -#endif -} - -void -vars_of_glyphs_widget (void) -{ -} diff --git a/src/glyphs-x.c b/src/glyphs-x.c deleted file mode 100644 index 6d5f750..0000000 --- a/src/glyphs-x.c +++ /dev/null @@ -1,2184 +0,0 @@ -/* X-specific Lisp objects. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996 Ben Wing - Copyright (C) 1995 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. */ - -/* Original author: Jamie Zawinski for 19.8 - font-truename stuff added by Jamie Zawinski for 19.10 - subwindow support added by Chuck Thompson - additional XPM support added by Chuck Thompson - initial X-Face support added by Stig - rewritten/restructured by Ben Wing for 19.12/19.13 - GIF/JPEG support added by Ben Wing for 19.14 - PNG support added by Bill Perry for 19.14 - Improved GIF/JPEG support added by Bill Perry for 19.14 - Cleanup/simplification of error handling by Ben Wing for 19.14 - Pointer/icon overhaul, more restructuring by Ben Wing for 19.14 - GIF support changed to external GIFlib 3.1 by Jareth Hein for 21.0 - Many changes for color work and optimizations by Jareth Hein for 21.0 - Switch of GIF/JPEG/PNG to new EImage intermediate code by Jareth Hein for 21.0 - TIFF code by Jareth Hein for 21.0 - GIF/JPEG/PNG/TIFF code moved to new glyph-eimage.c for 21.0 - - TODO: - Convert images.el to C and stick it in here? - */ - -#include -#include "lisp.h" -#include "lstream.h" -#include "console-x.h" -#include "glyphs-x.h" -#include "objects-x.h" -#include "xmu.h" - -#include "buffer.h" -#include "window.h" -#include "frame.h" -#include "insdel.h" -#include "opaque.h" - -#include "imgproc.h" - -#include "sysfile.h" - -#include - -#ifdef FILE_CODING -#include "file-coding.h" -#endif - -#if INTBITS == 32 -# define FOUR_BYTE_TYPE unsigned int -#elif LONGBITS == 32 -# define FOUR_BYTE_TYPE unsigned long -#elif SHORTBITS == 32 -# define FOUR_BYTE_TYPE unsigned short -#else -#error What kind of strange-ass system are we running on? -#endif - -#define LISP_DEVICE_TO_X_SCREEN(dev) XDefaultScreenOfDisplay (DEVICE_X_DISPLAY (XDEVICE (dev))) - -#ifdef HAVE_XPM -DEFINE_DEVICE_IIFORMAT (x, xpm); -#endif -DEFINE_DEVICE_IIFORMAT (x, xbm); -DEFINE_DEVICE_IIFORMAT (x, subwindow); -#ifdef HAVE_XFACE -DEFINE_DEVICE_IIFORMAT (x, xface); -#endif - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (cursor_font); -Lisp_Object Qcursor_font; - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (font); - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (autodetect); - -static void cursor_font_instantiate (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, - Lisp_Object domain); - -#include "bitmaps.h" - - -/************************************************************************/ -/* image instance methods */ -/************************************************************************/ - -/************************************************************************/ -/* convert from a series of RGB triples to an XImage formated for the */ -/* proper display */ -/************************************************************************/ -static XImage * -convert_EImage_to_XImage (Lisp_Object device, int width, int height, - unsigned char *pic, unsigned long **pixtbl, - int *npixels) -{ - Display *dpy; - Colormap cmap; - Visual *vis; - XImage *outimg; - int depth, bitmap_pad, bits_per_pixel, byte_cnt, i, j; - int rd,gr,bl,q; - unsigned char *data, *ip, *dp; - quant_table *qtable = 0; - union { - FOUR_BYTE_TYPE val; - char cp[4]; - } conv; - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - cmap = DEVICE_X_COLORMAP (XDEVICE(device)); - vis = DEVICE_X_VISUAL (XDEVICE(device)); - depth = DEVICE_X_DEPTH(XDEVICE(device)); - - if (vis->class == PseudoColor) - { - /* Quantize the image and get a histogram while we're at it. - Do this first to save memory */ - qtable = build_EImage_quantable(pic, width, height, 256); - if (qtable == NULL) return NULL; - } - - bitmap_pad = ((depth > 16) ? 32 : - (depth > 8) ? 16 : - 8); - - outimg = XCreateImage (dpy, vis, - depth, ZPixmap, 0, 0, width, height, - bitmap_pad, 0); - if (!outimg) return NULL; - - bits_per_pixel = outimg->bits_per_pixel; - byte_cnt = bits_per_pixel >> 3; - - data = (unsigned char *) xmalloc (outimg->bytes_per_line * height); - if (!data) - { - XDestroyImage (outimg); - return NULL; - } - outimg->data = (char *) data; - - if (vis->class == PseudoColor) - { - unsigned long pixarray[256]; - int pixcount, n; - /* use our quantize table to allocate the colors */ - pixcount = 32; - *pixtbl = xnew_array (unsigned long, pixcount); - *npixels = 0; - - /* ### should implement a sort by popularity to assure proper allocation */ - n = *npixels; - for (i = 0; i < qtable->num_active_colors; i++) - { - XColor color; - int res; - - color.red = qtable->rm[i] ? qtable->rm[i] << 8 : 0; - color.green = qtable->gm[i] ? qtable->gm[i] << 8 : 0; - color.blue = qtable->bm[i] ? qtable->bm[i] << 8 : 0; - color.flags = DoRed | DoGreen | DoBlue; - res = allocate_nearest_color (dpy, cmap, vis, &color); - if (res > 0 && res < 3) - { - DO_REALLOC(*pixtbl, pixcount, n+1, unsigned long); - (*pixtbl)[n] = color.pixel; - n++; - } - pixarray[i] = color.pixel; - } - *npixels = n; - ip = pic; - for (i = 0; i < height; i++) - { - dp = data + (i * outimg->bytes_per_line); - for (j = 0; j < width; j++) - { - rd = *ip++; - gr = *ip++; - bl = *ip++; - conv.val = pixarray[QUANT_GET_COLOR(qtable,rd,gr,bl)]; -#if WORDS_BIGENDIAN - if (outimg->byte_order == MSBFirst) - for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q]; - else - for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q]; -#else - if (outimg->byte_order == MSBFirst) - for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q]; - else - for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q]; -#endif - } - } - xfree(qtable); - } else { - unsigned long rshift,gshift,bshift,rbits,gbits,bbits,junk; - junk = vis->red_mask; - rshift = 0; - while ((junk & 0x1) == 0) - { - junk = junk >> 1; - rshift ++; - } - rbits = 0; - while (junk != 0) - { - junk = junk >> 1; - rbits++; - } - junk = vis->green_mask; - gshift = 0; - while ((junk & 0x1) == 0) - { - junk = junk >> 1; - gshift ++; - } - gbits = 0; - while (junk != 0) - { - junk = junk >> 1; - gbits++; - } - junk = vis->blue_mask; - bshift = 0; - while ((junk & 0x1) == 0) - { - junk = junk >> 1; - bshift ++; - } - bbits = 0; - while (junk != 0) - { - junk = junk >> 1; - bbits++; - } - ip = pic; - for (i = 0; i < height; i++) - { - dp = data + (i * outimg->bytes_per_line); - for (j = 0; j < width; j++) - { - if (rbits > 8) - rd = *ip++ << (rbits - 8); - else - rd = *ip++ >> (8 - rbits); - if (gbits > 8) - gr = *ip++ << (gbits - 8); - else - gr = *ip++ >> (8 - gbits); - if (bbits > 8) - bl = *ip++ << (bbits - 8); - else - bl = *ip++ >> (8 - bbits); - - conv.val = (rd << rshift) | (gr << gshift) | (bl << bshift); -#if WORDS_BIGENDIAN - if (outimg->byte_order == MSBFirst) - for (q = 4-byte_cnt; q < 4; q++) *dp++ = conv.cp[q]; - else - for (q = 3; q >= 4-byte_cnt; q--) *dp++ = conv.cp[q]; -#else - if (outimg->byte_order == MSBFirst) - for (q = byte_cnt-1; q >= 0; q--) *dp++ = conv.cp[q]; - else - for (q = 0; q < byte_cnt; q++) *dp++ = conv.cp[q]; -#endif - } - } - } - return outimg; -} - - - -static void -x_print_image_instance (struct Lisp_Image_Instance *p, - Lisp_Object printcharfun, - int escapeflag) -{ - char buf[100]; - - switch (IMAGE_INSTANCE_TYPE (p)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - sprintf (buf, " (0x%lx", (unsigned long) IMAGE_INSTANCE_X_PIXMAP (p)); - write_c_string (buf, printcharfun); - if (IMAGE_INSTANCE_X_MASK (p)) - { - sprintf (buf, "/0x%lx", (unsigned long) IMAGE_INSTANCE_X_MASK (p)); - write_c_string (buf, printcharfun); - } - write_c_string (")", printcharfun); - break; - default: - break; - } -} - -static void -x_finalize_image_instance (struct Lisp_Image_Instance *p) -{ - if (!p->data) - return; - - if (DEVICE_LIVE_P (XDEVICE (p->device))) - { - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (p->device)); - - if (IMAGE_INSTANCE_TYPE (p) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (p) == IMAGE_SUBWINDOW) - { - if (IMAGE_INSTANCE_SUBWINDOW_ID (p)) - XDestroyWindow (dpy, IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); - IMAGE_INSTANCE_SUBWINDOW_ID (p) = 0; - } - else - { - if (IMAGE_INSTANCE_X_PIXMAP (p)) - XFreePixmap (dpy, IMAGE_INSTANCE_X_PIXMAP (p)); - if (IMAGE_INSTANCE_X_MASK (p) && - IMAGE_INSTANCE_X_MASK (p) != IMAGE_INSTANCE_X_PIXMAP (p)) - XFreePixmap (dpy, IMAGE_INSTANCE_X_MASK (p)); - IMAGE_INSTANCE_X_PIXMAP (p) = 0; - IMAGE_INSTANCE_X_MASK (p) = 0; - - if (IMAGE_INSTANCE_X_CURSOR (p)) - { - XFreeCursor (dpy, IMAGE_INSTANCE_X_CURSOR (p)); - IMAGE_INSTANCE_X_CURSOR (p) = 0; - } - - if (IMAGE_INSTANCE_X_NPIXELS (p) != 0) - { - XFreeColors (dpy, - IMAGE_INSTANCE_X_COLORMAP (p), - IMAGE_INSTANCE_X_PIXELS (p), - IMAGE_INSTANCE_X_NPIXELS (p), 0); - IMAGE_INSTANCE_X_NPIXELS (p) = 0; - } - } - } - if (IMAGE_INSTANCE_X_PIXELS (p)) - { - xfree (IMAGE_INSTANCE_X_PIXELS (p)); - IMAGE_INSTANCE_X_PIXELS (p) = 0; - } - - xfree (p->data); - p->data = 0; -} - -static int -x_image_instance_equal (struct Lisp_Image_Instance *p1, - struct Lisp_Image_Instance *p2, int depth) -{ - switch (IMAGE_INSTANCE_TYPE (p1)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - if (IMAGE_INSTANCE_X_COLORMAP (p1) != IMAGE_INSTANCE_X_COLORMAP (p2) || - IMAGE_INSTANCE_X_NPIXELS (p1) != IMAGE_INSTANCE_X_NPIXELS (p2)) - return 0; - break; - default: - break; - } - - return 1; -} - -static unsigned long -x_image_instance_hash (struct Lisp_Image_Instance *p, int depth) -{ - switch (IMAGE_INSTANCE_TYPE (p)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return IMAGE_INSTANCE_X_NPIXELS (p); - default: - return 0; - } -} - -/* Set all the slots in an image instance structure to reasonable - default values. This is used somewhere within an instantiate - method. It is assumed that the device slot within the image - instance is already set -- this is the case when instantiate - methods are called. */ - -static void -x_initialize_pixmap_image_instance (struct Lisp_Image_Instance *ii, - enum image_instance_type type) -{ - ii->data = xnew_and_zero (struct x_image_instance_data); - IMAGE_INSTANCE_TYPE (ii) = type; - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_FG (ii) = Qnil; - IMAGE_INSTANCE_PIXMAP_BG (ii) = Qnil; -} - - -/************************************************************************/ -/* pixmap file functions */ -/************************************************************************/ - -/* Where bitmaps are; initialized from resource database */ -Lisp_Object Vx_bitmap_file_path; - -#ifndef BITMAPDIR -#define BITMAPDIR "/usr/include/X11/bitmaps" -#endif - -#define USE_XBMLANGPATH - -/* Given a pixmap filename, look through all of the "standard" places - where the file might be located. Return a full pathname if found; - otherwise, return Qnil. */ - -static Lisp_Object -x_locate_pixmap_file (Lisp_Object name) -{ - /* This function can GC if IN_REDISPLAY is false */ - Display *display; - - /* Check non-absolute pathnames with a directory component relative to - the search path; that's the way Xt does it. */ - /* #### Unix-specific */ - if (XSTRING_BYTE (name, 0) == '/' || - (XSTRING_BYTE (name, 0) == '.' && - (XSTRING_BYTE (name, 1) == '/' || - (XSTRING_BYTE (name, 1) == '.' && - (XSTRING_BYTE (name, 2) == '/'))))) - { - if (!NILP (Ffile_readable_p (name))) - return name; - else - return Qnil; - } - - if (NILP (Vdefault_x_device)) - /* This may occur during initialization. */ - return Qnil; - else - /* We only check the bitmapFilePath resource on the original X device. */ - display = DEVICE_X_DISPLAY (XDEVICE (Vdefault_x_device)); - -#ifdef USE_XBMLANGPATH - { - char *path = egetenv ("XBMLANGPATH"); - SubstitutionRec subs[1]; - subs[0].match = 'B'; - subs[0].substitution = (char *) XSTRING_DATA (name); - /* #### Motif uses a big hairy default if $XBMLANGPATH isn't set. - We don't. If you want it used, set it. */ - if (path && - (path = XtResolvePathname (display, "bitmaps", 0, 0, path, - subs, XtNumber (subs), 0))) - { - name = build_string (path); - XtFree (path); - return (name); - } - } -#endif - - if (NILP (Vx_bitmap_file_path)) - { - char *type = 0; - XrmValue value; - if (XrmGetResource (XtDatabase (display), - "bitmapFilePath", "BitmapFilePath", &type, &value) - && !strcmp (type, "String")) - Vx_bitmap_file_path = decode_env_path (0, (char *) value.addr); - Vx_bitmap_file_path = nconc2 (Vx_bitmap_file_path, - (decode_path (BITMAPDIR))); - } - - { - Lisp_Object found; - if (locate_file (Vx_bitmap_file_path, name, "", &found, R_OK) < 0) - { - Lisp_Object temp = list1 (Vdata_directory); - struct gcpro gcpro1; - - GCPRO1 (temp); - locate_file (temp, name, "", &found, R_OK); - UNGCPRO; - } - - return found; - } -} - -static Lisp_Object -locate_pixmap_file (Lisp_Object name) -{ - return x_locate_pixmap_file (name); -} - -#if 0 -static void -write_lisp_string_to_temp_file (Lisp_Object string, char *filename_out) -{ - Lisp_Object instream, outstream; - Lstream *istr, *ostr; - char tempbuf[1024]; /* some random amount */ - int fubar = 0; - FILE *tmpfil; - static Extbyte_dynarr *conversion_out_dynarr; - Bytecount bstart, bend; - struct gcpro gcpro1, gcpro2; -#ifdef FILE_CODING - Lisp_Object conv_out_stream; - Lstream *costr; - struct gcpro gcpro3; -#endif - - /* This function can GC */ - if (!conversion_out_dynarr) - conversion_out_dynarr = Dynarr_new (Extbyte); - else - Dynarr_reset (conversion_out_dynarr); - - /* Create the temporary file ... */ - sprintf (filename_out, "/tmp/emacs%d.XXXXXX", (int) getpid ()); - mktemp (filename_out); - tmpfil = fopen (filename_out, "w"); - if (!tmpfil) - { - if (tmpfil) - { - int old_errno = errno; - fclose (tmpfil); - unlink (filename_out); - errno = old_errno; - } - report_file_error ("Creating temp file", - list1 (build_string (filename_out))); - } - - CHECK_STRING (string); - get_string_range_byte (string, Qnil, Qnil, &bstart, &bend, - GB_HISTORICAL_STRING_BEHAVIOR); - instream = make_lisp_string_input_stream (string, bstart, bend); - istr = XLSTREAM (instream); - /* setup the out stream */ - outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr); - ostr = XLSTREAM (outstream); -#ifdef FILE_CODING - /* setup the conversion stream */ - conv_out_stream = make_encoding_output_stream (ostr, Fget_coding_system(Qbinary)); - costr = XLSTREAM (conv_out_stream); - GCPRO3 (instream, outstream, conv_out_stream); -#else - GCPRO2 (instream, outstream); -#endif - - /* Get the data while doing the conversion */ - while (1) - { - int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf)); - if (!size_in_bytes) - break; - /* It does seem the flushes are necessary... */ -#ifdef FILE_CODING - Lstream_write (costr, tempbuf, size_in_bytes); - Lstream_flush (costr); -#else - Lstream_write (ostr, tempbuf, size_in_bytes); -#endif - Lstream_flush (ostr); - if (fwrite ((unsigned char *)Dynarr_atp(conversion_out_dynarr, 0), - Dynarr_length(conversion_out_dynarr), 1, tmpfil) != 1) - { - fubar = 1; - break; - } - /* reset the dynarr */ - Lstream_rewind(ostr); - } - - if (fclose (tmpfil) != 0) - fubar = 1; - Lstream_close (istr); -#ifdef FILE_CODING - Lstream_close (costr); -#endif - Lstream_close (ostr); - - UNGCPRO; - Lstream_delete (istr); - Lstream_delete (ostr); -#ifdef FILE_CODING - Lstream_delete (costr); -#endif - - if (fubar) - report_file_error ("Writing temp file", - list1 (build_string (filename_out))); -} -#endif /* 0 */ - - -/************************************************************************/ -/* cursor functions */ -/************************************************************************/ - -/* Check that this server supports cursors of size WIDTH * HEIGHT. If - not, signal an error. INSTANTIATOR is only used in the error - message. */ - -static void -check_pointer_sizes (Screen *xs, unsigned int width, unsigned int height, - Lisp_Object instantiator) -{ - unsigned int best_width, best_height; - if (! XQueryBestCursor (DisplayOfScreen (xs), RootWindowOfScreen (xs), - width, height, &best_width, &best_height)) - /* this means that an X error of some sort occurred (we trap - these so they're not fatal). */ - signal_simple_error ("XQueryBestCursor() failed?", instantiator); - - if (width > best_width || height > best_height) - error_with_frob (instantiator, - "pointer too large (%dx%d): " - "server requires %dx%d or smaller", - width, height, best_width, best_height); -} - - -static void -generate_cursor_fg_bg (Lisp_Object device, Lisp_Object *foreground, - Lisp_Object *background, XColor *xfg, XColor *xbg) -{ - if (!NILP (*foreground) && !COLOR_INSTANCEP (*foreground)) - *foreground = - Fmake_color_instance (*foreground, device, - encode_error_behavior_flag (ERROR_ME)); - if (COLOR_INSTANCEP (*foreground)) - *xfg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*foreground)); - else - { - xfg->pixel = 0; - xfg->red = xfg->green = xfg->blue = 0; - } - - if (!NILP (*background) && !COLOR_INSTANCEP (*background)) - *background = - Fmake_color_instance (*background, device, - encode_error_behavior_flag (ERROR_ME)); - if (COLOR_INSTANCEP (*background)) - *xbg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (*background)); - else - { - xbg->pixel = 0; - xbg->red = xbg->green = xbg->blue = ~0; - } -} - -static void -maybe_recolor_cursor (Lisp_Object image_instance, Lisp_Object foreground, - Lisp_Object background) -{ - Lisp_Object device = XIMAGE_INSTANCE_DEVICE (image_instance); - XColor xfg, xbg; - - generate_cursor_fg_bg (device, &foreground, &background, &xfg, &xbg); - if (!NILP (foreground) || !NILP (background)) - { - XRecolorCursor (DEVICE_X_DISPLAY (XDEVICE (device)), - XIMAGE_INSTANCE_X_CURSOR (image_instance), - &xfg, &xbg); - XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground; - XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background; - } -} - - -/************************************************************************/ -/* color pixmap functions */ -/************************************************************************/ - -/* Initialize an image instance from an XImage. - - DEST_MASK specifies the mask of allowed image types. - - PIXELS and NPIXELS specify an array of pixels that are used in - the image. These need to be kept around for the duration of the - image. When the image instance is freed, XFreeColors() will - automatically be called on all the pixels specified here; thus, - you should have allocated the pixels yourself using XAllocColor() - or the like. The array passed in is used directly without - being copied, so it should be heap data created with xmalloc(). - It will be freed using xfree() when the image instance is - destroyed. - - If this fails, signal an error. INSTANTIATOR is only used - in the error message. - - #### This should be able to handle conversion into `pointer'. - Use the same code as for `xpm'. */ - -static void -init_image_instance_from_x_image (struct Lisp_Image_Instance *ii, - XImage *ximage, - int dest_mask, - Colormap cmap, - unsigned long *pixels, - int npixels, - Lisp_Object instantiator) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Display *dpy; - GC gc; - Drawable d; - Pixmap pixmap; - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - d = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device))); - - if (!(dest_mask & IMAGE_COLOR_PIXMAP_MASK)) - incompatible_image_types (instantiator, dest_mask, - IMAGE_COLOR_PIXMAP_MASK); - - pixmap = XCreatePixmap (dpy, d, ximage->width, - ximage->height, ximage->depth); - if (!pixmap) - signal_simple_error ("Unable to create pixmap", instantiator); - - gc = XCreateGC (dpy, pixmap, 0, NULL); - if (!gc) - { - XFreePixmap (dpy, pixmap); - signal_simple_error ("Unable to create GC", instantiator); - } - - XPutImage (dpy, pixmap, gc, ximage, 0, 0, 0, 0, - ximage->width, ximage->height); - - XFreeGC (dpy, gc); - - x_initialize_pixmap_image_instance (ii, IMAGE_COLOR_PIXMAP); - - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = - find_keyword_in_vector (instantiator, Q_file); - - IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; - IMAGE_INSTANCE_X_MASK (ii) = 0; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = ximage->width; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = ximage->height; - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = ximage->depth; - IMAGE_INSTANCE_X_COLORMAP (ii) = cmap; - IMAGE_INSTANCE_X_PIXELS (ii) = pixels; - IMAGE_INSTANCE_X_NPIXELS (ii) = npixels; -} - -static void -x_init_image_instance_from_eimage (struct Lisp_Image_Instance *ii, - int width, int height, - unsigned char *eimage, - int dest_mask, - Lisp_Object instantiator, - Lisp_Object domain) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device)); - unsigned long *pixtbl = NULL; - int npixels = 0; - XImage* ximage; - - ximage = convert_EImage_to_XImage (device, width, height, eimage, - &pixtbl, &npixels); - if (!ximage) - { - if (pixtbl) xfree (pixtbl); - signal_image_error("EImage to XImage conversion failed", instantiator); - } - - /* Now create the pixmap and set up the image instance */ - init_image_instance_from_x_image (ii, ximage, dest_mask, - cmap, pixtbl, npixels, - instantiator); - - if (ximage) - { - if (ximage->data) - { - xfree (ximage->data); - ximage->data = 0; - } - XDestroyImage (ximage); - } -} - -int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, - unsigned int *height, unsigned char **datap, - int *x_hot, int *y_hot) -{ - return XmuReadBitmapDataFromFile (filename, width, height, - datap, x_hot, y_hot); -} - -/* Given inline data for a mono pixmap, create and return the - corresponding X object. */ - -static Pixmap -pixmap_from_xbm_inline (Lisp_Object device, int width, int height, - /* Note that data is in ext-format! */ - CONST Extbyte *bits) -{ - return XCreatePixmapFromBitmapData (DEVICE_X_DISPLAY (XDEVICE(device)), - XtWindow (DEVICE_XT_APP_SHELL (XDEVICE (device))), - (char *) bits, width, height, - 1, 0, 1); -} - -/* Given inline data for a mono pixmap, initialize the given - image instance accordingly. */ - -static void -init_image_instance_from_xbm_inline (struct Lisp_Image_Instance *ii, - int width, int height, - /* Note that data is in ext-format! */ - CONST char *bits, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, - Pixmap mask, - Lisp_Object mask_filename) -{ - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Lisp_Object foreground = find_keyword_in_vector (instantiator, Q_foreground); - Lisp_Object background = find_keyword_in_vector (instantiator, Q_background); - Display *dpy; - Screen *scr; - Drawable draw; - enum image_instance_type type; - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (device))); - scr = DefaultScreenOfDisplay (dpy); - - if ((dest_mask & IMAGE_MONO_PIXMAP_MASK) && - (dest_mask & IMAGE_COLOR_PIXMAP_MASK)) - { - if (!NILP (foreground) || !NILP (background)) - type = IMAGE_COLOR_PIXMAP; - else - type = IMAGE_MONO_PIXMAP; - } - else if (dest_mask & IMAGE_MONO_PIXMAP_MASK) - type = IMAGE_MONO_PIXMAP; - else if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) - type = IMAGE_COLOR_PIXMAP; - else if (dest_mask & IMAGE_POINTER_MASK) - type = IMAGE_POINTER; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK - | IMAGE_POINTER_MASK); - - x_initialize_pixmap_image_instance (ii, type); - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = width; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = height; - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = - find_keyword_in_vector (instantiator, Q_file); - - switch (type) - { - case IMAGE_MONO_PIXMAP: - { - IMAGE_INSTANCE_X_PIXMAP (ii) = - pixmap_from_xbm_inline (device, width, height, (Extbyte *) bits); - } - break; - - case IMAGE_COLOR_PIXMAP: - { - Dimension d = DEVICE_X_DEPTH (XDEVICE(device)); - unsigned long fg = BlackPixelOfScreen (scr); - unsigned long bg = WhitePixelOfScreen (scr); - - if (!NILP (foreground) && !COLOR_INSTANCEP (foreground)) - foreground = - Fmake_color_instance (foreground, device, - encode_error_behavior_flag (ERROR_ME)); - - if (COLOR_INSTANCEP (foreground)) - fg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)).pixel; - - if (!NILP (background) && !COLOR_INSTANCEP (background)) - background = - Fmake_color_instance (background, device, - encode_error_behavior_flag (ERROR_ME)); - - if (COLOR_INSTANCEP (background)) - bg = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)).pixel; - - /* We used to duplicate the pixels using XAllocColor(), to protect - against their getting freed. Just as easy to just store the - color instances here and GC-protect them, so this doesn't - happen. */ - IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; - IMAGE_INSTANCE_PIXMAP_BG (ii) = background; - IMAGE_INSTANCE_X_PIXMAP (ii) = - XCreatePixmapFromBitmapData (dpy, draw, - (char *) bits, width, height, - fg, bg, d); - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = d; - } - break; - - case IMAGE_POINTER: - { - XColor fg_color, bg_color; - Pixmap source; - - check_pointer_sizes (scr, width, height, instantiator); - - source = - XCreatePixmapFromBitmapData (dpy, draw, - (char *) bits, width, height, - 1, 0, 1); - - if (NILP (foreground)) - foreground = pointer_fg; - if (NILP (background)) - background = pointer_bg; - generate_cursor_fg_bg (device, &foreground, &background, - &fg_color, &bg_color); - - IMAGE_INSTANCE_PIXMAP_FG (ii) = foreground; - IMAGE_INSTANCE_PIXMAP_BG (ii) = background; - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii) = - find_keyword_in_vector (instantiator, Q_hotspot_x); - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii) = - find_keyword_in_vector (instantiator, Q_hotspot_y); - IMAGE_INSTANCE_X_CURSOR (ii) = - XCreatePixmapCursor - (dpy, source, mask, &fg_color, &bg_color, - !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) ? - XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) : 0, - !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) ? - XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii)) : 0); - } - break; - - default: - abort (); - } -} - -static void -xbm_instantiate_1 (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, int width, int height, - /* Note that data is in ext-format! */ - CONST char *bits) -{ - Lisp_Object mask_data = find_keyword_in_vector (instantiator, Q_mask_data); - Lisp_Object mask_file = find_keyword_in_vector (instantiator, Q_mask_file); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Pixmap mask = 0; - CONST char *gcc_may_you_rot_in_hell; - - if (!NILP (mask_data)) - { - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (mask_data))), - gcc_may_you_rot_in_hell); - mask = - pixmap_from_xbm_inline (IMAGE_INSTANCE_DEVICE (ii), - XINT (XCAR (mask_data)), - XINT (XCAR (XCDR (mask_data))), - (CONST unsigned char *) - gcc_may_you_rot_in_hell); - } - - init_image_instance_from_xbm_inline (ii, width, height, bits, - instantiator, pointer_fg, pointer_bg, - dest_mask, mask, mask_file); -} - -/* Instantiate method for XBM's. */ - -static void -x_xbm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - CONST char *gcc_go_home; - - assert (!NILP (data)); - - GET_C_STRING_BINARY_DATA_ALLOCA (XCAR (XCDR (XCDR (data))), - gcc_go_home); - - xbm_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, XINT (XCAR (data)), - XINT (XCAR (XCDR (data))), gcc_go_home); -} - - -#ifdef HAVE_XPM - -/********************************************************************** - * XPM * - **********************************************************************/ - /* xpm 3.2g and better has XpmCreatePixmapFromBuffer()... - There was no version number in xpm.h before 3.3, but this should do. - */ -#if (XpmVersion >= 3) || defined(XpmExactColors) -# define XPM_DOES_BUFFERS -#endif - -#ifndef XPM_DOES_BUFFERS -Your version of XPM is too old. You cannot compile with it. -Upgrade to version 3.2g or better or compile with --with-xpm=no. -#endif /* !XPM_DOES_BUFFERS */ - -static XpmColorSymbol * -extract_xpm_color_names (XpmAttributes *xpmattrs, Lisp_Object device, - Lisp_Object domain, - Lisp_Object color_symbol_alist) -{ - /* This function can GC */ - Display *dpy = DEVICE_X_DISPLAY (XDEVICE(device)); - Colormap cmap = DEVICE_X_COLORMAP (XDEVICE(device)); - XColor color; - Lisp_Object rest; - Lisp_Object results = Qnil; - int i; - XpmColorSymbol *symbols; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (results, device); - - /* We built up results to be (("name" . #) ...) so that if an - error happens we don't lose any malloc()ed data, or more importantly, - leave any pixels allocated in the server. */ - i = 0; - LIST_LOOP (rest, color_symbol_alist) - { - Lisp_Object cons = XCAR (rest); - Lisp_Object name = XCAR (cons); - Lisp_Object value = XCDR (cons); - if (NILP (value)) - continue; - if (STRINGP (value)) - value = - Fmake_color_instance - (value, device, encode_error_behavior_flag (ERROR_ME_NOT)); - else - { - assert (COLOR_SPECIFIERP (value)); - value = Fspecifier_instance (value, domain, Qnil, Qnil); - } - if (NILP (value)) - continue; - results = noseeum_cons (noseeum_cons (name, value), results); - i++; - } - UNGCPRO; /* no more evaluation */ - - if (i == 0) return 0; - - symbols = xnew_array (XpmColorSymbol, i); - xpmattrs->valuemask |= XpmColorSymbols; - xpmattrs->colorsymbols = symbols; - xpmattrs->numsymbols = i; - - while (--i >= 0) - { - Lisp_Object cons = XCAR (results); - color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (XCDR (cons))); - /* Duplicate the pixel value so that we still have a lock on it if - the pixel we were passed is later freed. */ - if (! XAllocColor (dpy, cmap, &color)) - abort (); /* it must be allocable since we're just duplicating it */ - - symbols [i].name = (char *) XSTRING_DATA (XCAR (cons)); - symbols [i].pixel = color.pixel; - symbols [i].value = 0; - free_cons (XCONS (cons)); - cons = results; - results = XCDR (results); - free_cons (XCONS (cons)); - } - return symbols; -} - -static void -xpm_free (XpmAttributes *xpmattrs) -{ - /* Could conceivably lose if XpmXXX returned an error without first - initializing this structure, if we didn't know that initializing it - to all zeros was ok (and also that it's ok to call XpmFreeAttributes() - multiple times, since it zeros slots as it frees them...) */ - XpmFreeAttributes (xpmattrs); -} - -static void -x_xpm_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - /* This function can GC */ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - Display *dpy; - Screen *xs; - Colormap cmap; - int depth; - Visual *visual; - Pixmap pixmap; - Pixmap mask = 0; - XpmAttributes xpmattrs; - int result; - XpmColorSymbol *color_symbols; - Lisp_Object color_symbol_alist = find_keyword_in_vector (instantiator, - Q_color_symbols); - enum image_instance_type type; - int force_mono; - unsigned int w, h; - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - xs = DefaultScreenOfDisplay (dpy); - - if (dest_mask & IMAGE_COLOR_PIXMAP_MASK) - type = IMAGE_COLOR_PIXMAP; - else if (dest_mask & IMAGE_MONO_PIXMAP_MASK) - type = IMAGE_MONO_PIXMAP; - else if (dest_mask & IMAGE_POINTER_MASK) - type = IMAGE_POINTER; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK - | IMAGE_POINTER_MASK); - force_mono = (type != IMAGE_COLOR_PIXMAP); - -#if 1 - /* Although I haven't found it documented yet, it appears that pointers are - always colored via the default window colormap... Sigh. */ - if (type == IMAGE_POINTER) - { - cmap = DefaultColormap(dpy, DefaultScreen(dpy)); - depth = DefaultDepthOfScreen (xs); - visual = DefaultVisualOfScreen (xs); - } - else - { - cmap = DEVICE_X_COLORMAP (XDEVICE(device)); - depth = DEVICE_X_DEPTH (XDEVICE(device)); - visual = DEVICE_X_VISUAL (XDEVICE(device)); - } -#else - cmap = DEVICE_X_COLORMAP (XDEVICE(device)); - depth = DEVICE_X_DEPTH (XDEVICE(device)); - visual = DEVICE_X_VISUAL (XDEVICE(device)); -#endif - - x_initialize_pixmap_image_instance (ii, type); - - assert (!NILP (data)); - - retry: - - xzero (xpmattrs); /* want XpmInitAttributes() */ - xpmattrs.valuemask = XpmReturnPixels; - if (force_mono) - { - /* Without this, we get a 1-bit version of the color image, which - isn't quite right. With this, we get the mono image, which might - be very different looking. */ - xpmattrs.valuemask |= XpmColorKey; - xpmattrs.color_key = XPM_MONO; - xpmattrs.depth = 1; - xpmattrs.valuemask |= XpmDepth; - } - else - { - xpmattrs.closeness = 65535; - xpmattrs.valuemask |= XpmCloseness; - xpmattrs.depth = depth; - xpmattrs.valuemask |= XpmDepth; - xpmattrs.visual = visual; - xpmattrs.valuemask |= XpmVisual; - xpmattrs.colormap = cmap; - xpmattrs.valuemask |= XpmColormap; - } - - color_symbols = extract_xpm_color_names (&xpmattrs, device, domain, - color_symbol_alist); - - result = XpmCreatePixmapFromBuffer (dpy, - XtWindow(DEVICE_XT_APP_SHELL (XDEVICE(device))), - (char *) XSTRING_DATA (data), - &pixmap, &mask, &xpmattrs); - - if (color_symbols) - { - xfree (color_symbols); - xpmattrs.colorsymbols = 0; /* in case XpmFreeAttr is too smart... */ - xpmattrs.numsymbols = 0; - } - - switch (result) - { - case XpmSuccess: - break; - case XpmFileInvalid: - { - xpm_free (&xpmattrs); - signal_image_error ("invalid XPM data", data); - } - case XpmColorFailed: - case XpmColorError: - { - xpm_free (&xpmattrs); - if (force_mono) - { - /* second time; blow out. */ - signal_double_file_error ("Reading pixmap data", - "color allocation failed", - data); - } - else - { - if (! (dest_mask & IMAGE_MONO_PIXMAP_MASK)) - { - /* second time; blow out. */ - signal_double_file_error ("Reading pixmap data", - "color allocation failed", - data); - } - force_mono = 1; - IMAGE_INSTANCE_TYPE (ii) = IMAGE_MONO_PIXMAP; - goto retry; - } - } - case XpmNoMemory: - { - xpm_free (&xpmattrs); - signal_double_file_error ("Parsing pixmap data", - "out of memory", data); - } - default: - { - xpm_free (&xpmattrs); - signal_double_file_error_2 ("Parsing pixmap data", - "unknown error code", - make_int (result), data); - } - } - - w = xpmattrs.width; - h = xpmattrs.height; - - { - int npixels = xpmattrs.npixels; - Pixel *pixels; - - if (npixels != 0) - { - pixels = xnew_array (Pixel, npixels); - memcpy (pixels, xpmattrs.pixels, npixels * sizeof (Pixel)); - } - else - pixels = NULL; - - IMAGE_INSTANCE_X_PIXMAP (ii) = pixmap; - IMAGE_INSTANCE_X_MASK (ii) = mask; - IMAGE_INSTANCE_X_COLORMAP (ii) = cmap; - IMAGE_INSTANCE_X_PIXELS (ii) = pixels; - IMAGE_INSTANCE_X_NPIXELS (ii) = npixels; - IMAGE_INSTANCE_PIXMAP_WIDTH (ii) = w; - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii) = h; - IMAGE_INSTANCE_PIXMAP_FILENAME (ii) = - find_keyword_in_vector (instantiator, Q_file); - } - - switch (type) - { - case IMAGE_MONO_PIXMAP: - break; - - case IMAGE_COLOR_PIXMAP: - { - IMAGE_INSTANCE_PIXMAP_DEPTH (ii) = depth; - } - break; - - case IMAGE_POINTER: - { - int npixels = xpmattrs.npixels; - Pixel *pixels = xpmattrs.pixels; - XColor fg, bg; - int i; - int xhot = 0, yhot = 0; - - if (xpmattrs.valuemask & XpmHotspot) - { - xhot = xpmattrs.x_hotspot; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii), xpmattrs.x_hotspot); - } - if (xpmattrs.valuemask & XpmHotspot) - { - yhot = xpmattrs.y_hotspot; - XSETINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii), xpmattrs.y_hotspot); - } - check_pointer_sizes (xs, w, h, instantiator); - - /* If the loaded pixmap has colors allocated (meaning it came from an - XPM file), then use those as the default colors for the cursor we - create. Otherwise, default to pointer_fg and pointer_bg. - */ - if (npixels >= 2) - { - /* With an XBM file, it's obvious which bit is foreground - and which is background, or rather, it's implicit: in - an XBM file, a 1 bit is foreground, and a 0 bit is - background. - - XCreatePixmapCursor() assumes this property of the - pixmap it is called with as well; the `foreground' - color argument is used for the 1 bits. - - With an XPM file, it's tricker, since the elements of - the pixmap don't represent FG and BG, but are actual - pixel values. So we need to figure out which of those - pixels is the foreground color and which is the - background. We do it by comparing RGB and assuming - that the darker color is the foreground. This works - with the result of xbmtopbm|ppmtoxpm, at least. - - It might be nice if there was some way to tag the - colors in the XPM file with whether they are the - foreground - perhaps with logical color names somehow? - - Once we have decided which color is the foreground, we - need to ensure that that color corresponds to a `1' bit - in the Pixmap. The XPM library wrote into the (1-bit) - pixmap with XPutPixel, which will ignore all but the - least significant bit. - - This means that a 1 bit in the image corresponds to - `fg' only if `fg.pixel' is odd. - - (This also means that the image will be all the same - color if both `fg' and `bg' are odd or even, but we can - safely assume that that won't happen if the XPM file is - sensible I think.) - - The desired result is that the image use `1' to - represent the foreground color, and `0' to represent - the background color. So, we may need to invert the - image to accomplish this; we invert if fg is - odd. (Remember that WhitePixel and BlackPixel are not - necessarily 1 and 0 respectively, though I think it - might be safe to assume that one of them is always 1 - and the other is always 0. We also pretty much need to - assume that one is even and the other is odd.) - */ - - fg.pixel = pixels[0]; /* pick a pixel at random. */ - bg.pixel = fg.pixel; - for (i = 1; i < npixels; i++) /* Look for an "other" pixel value.*/ - { - bg.pixel = pixels[i]; - if (fg.pixel != bg.pixel) - break; - } - - /* If (fg.pixel == bg.pixel) then probably something has - gone wrong, but I don't think signalling an error would - be appropriate. */ - - XQueryColor (dpy, cmap, &fg); - XQueryColor (dpy, cmap, &bg); - - /* If the foreground is lighter than the background, swap them. - (This occurs semi-randomly, depending on the ordering of the - color list in the XPM file.) - */ - { - unsigned short fg_total = ((fg.red / 3) + (fg.green / 3) - + (fg.blue / 3)); - unsigned short bg_total = ((bg.red / 3) + (bg.green / 3) - + (bg.blue / 3)); - if (fg_total > bg_total) - { - XColor swap; - swap = fg; - fg = bg; - bg = swap; - } - } - - /* If the fg pixel corresponds to a `0' in the bitmap, invert it. - (This occurs (only?) on servers with Black=0, White=1.) - */ - if ((fg.pixel & 1) == 0) - { - XGCValues gcv; - GC gc; - gcv.function = GXxor; - gcv.foreground = 1; - gc = XCreateGC (dpy, pixmap, (GCFunction | GCForeground), - &gcv); - XFillRectangle (dpy, pixmap, gc, 0, 0, w, h); - XFreeGC (dpy, gc); - } - } - else - { - generate_cursor_fg_bg (device, &pointer_fg, &pointer_bg, - &fg, &bg); - IMAGE_INSTANCE_PIXMAP_FG (ii) = pointer_fg; - IMAGE_INSTANCE_PIXMAP_BG (ii) = pointer_bg; - } - - IMAGE_INSTANCE_X_CURSOR (ii) = - XCreatePixmapCursor - (dpy, pixmap, mask, &fg, &bg, xhot, yhot); - } - - break; - - default: - abort (); - } - - xpm_free (&xpmattrs); /* after we've read pixels and hotspot */ -} - -#endif /* HAVE_XPM */ - - -#ifdef HAVE_XFACE - -/********************************************************************** - * X-Face * - **********************************************************************/ -#if defined(EXTERN) -/* This is about to get redefined! */ -#undef EXTERN -#endif -/* We have to define SYSV32 so that compface.h includes string.h - instead of strings.h. */ -#define SYSV32 -#ifdef __cplusplus -extern "C" { -#endif -#include -#ifdef __cplusplus -} -#endif -/* JMP_BUF cannot be used here because if it doesn't get defined - to jmp_buf we end up with a conflicting type error with the - definition in compface.h */ -extern jmp_buf comp_env; -#undef SYSV32 - -static void -x_xface_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - int i, stattis; - char *p, *bits, *bp; - CONST char * volatile emsg = 0; - CONST char * volatile dstring; - - assert (!NILP (data)); - - GET_C_STRING_BINARY_DATA_ALLOCA (data, dstring); - - if ((p = strchr (dstring, ':'))) - { - dstring = p + 1; - } - - /* Must use setjmp not SETJMP because we used jmp_buf above not JMP_BUF */ - if (!(stattis = setjmp (comp_env))) - { - UnCompAll ((char *) dstring); - UnGenFace (); - } - - switch (stattis) - { - case -2: - emsg = "uncompface: internal error"; - break; - case -1: - emsg = "uncompface: insufficient or invalid data"; - break; - case 1: - emsg = "uncompface: excess data ignored"; - break; - } - - if (emsg) - signal_simple_error_2 (emsg, data, Qimage); - - bp = bits = (char *) alloca (PIXELS / 8); - - /* the compface library exports char F[], which uses a single byte per - pixel to represent a 48x48 bitmap. Yuck. */ - for (i = 0, p = F; i < (PIXELS / 8); ++i) - { - int n, b; - /* reverse the bit order of each byte... */ - for (b = n = 0; b < 8; ++b) - { - n |= ((*p++) << b); - } - *bp++ = (char) n; - } - - xbm_instantiate_1 (image_instance, instantiator, pointer_fg, - pointer_bg, dest_mask, 48, 48, bits); -} - -#endif /* HAVE_XFACE */ - - -/********************************************************************** - * Autodetect * - **********************************************************************/ - -static void -autodetect_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -static Lisp_Object -autodetect_normalize (Lisp_Object instantiator, - Lisp_Object console_type) -{ - Lisp_Object file = find_keyword_in_vector (instantiator, Q_data); - Lisp_Object filename = Qnil; - Lisp_Object data = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; - - GCPRO3 (filename, data, alist); - - if (NILP (file)) /* no conversion necessary */ - RETURN_UNGCPRO (instantiator); - - alist = tagged_vector_to_alist (instantiator); - - filename = locate_pixmap_file (file); - if (!NILP (filename)) - { - int xhot, yhot; - /* #### Apparently some versions of XpmReadFileToData, which is - called by pixmap_to_lisp_data, don't return an error value - if the given file is not a valid XPM file. Instead, they - just seg fault. It is definitely caused by passing a - bitmap. To try and avoid this we check for bitmaps first. */ - - data = bitmap_to_lisp_data (filename, &xhot, &yhot, 1); - - if (!EQ (data, Qt)) - { - alist = remassq_no_quit (Q_data, alist); - alist = Fcons (Fcons (Q_file, filename), - Fcons (Fcons (Q_data, data), alist)); - if (xhot != -1) - alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)), - alist); - if (yhot != -1) - alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)), - alist); - - alist = xbm_mask_file_munging (alist, filename, Qnil, console_type); - - { - Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } - } - -#ifdef HAVE_XPM - data = pixmap_to_lisp_data (filename, 1); - - if (!EQ (data, Qt)) - { - alist = remassq_no_quit (Q_data, alist); - alist = Fcons (Fcons (Q_file, filename), - Fcons (Fcons (Q_data, data), alist)); - alist = Fcons (Fcons (Q_color_symbols, - evaluate_xpm_color_symbols ()), - alist); - { - Lisp_Object result = alist_to_tagged_vector (Qxpm, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } - } -#endif - } - - /* If we couldn't convert it, just put it back as it is. - We might try to further frob it later as a cursor-font - specification. (We can't do that now because we don't know - what dest-types it's going to be instantiated into.) */ - { - Lisp_Object result = alist_to_tagged_vector (Qautodetect, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - -static int -autodetect_possible_dest_types (void) -{ - return - IMAGE_MONO_PIXMAP_MASK | - IMAGE_COLOR_PIXMAP_MASK | - IMAGE_POINTER_MASK | - IMAGE_TEXT_MASK; -} - -static void -autodetect_instantiate (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; - Lisp_Object result = Qnil; - int is_cursor_font = 0; - - GCPRO3 (data, alist, result); - - alist = tagged_vector_to_alist (instantiator); - if (dest_mask & IMAGE_POINTER_MASK) - { - CONST char *name_ext; - GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext); - if (XmuCursorNameToIndex (name_ext) != -1) - { - result = alist_to_tagged_vector (Qcursor_font, alist); - is_cursor_font = 1; - } - } - - if (!is_cursor_font) - result = alist_to_tagged_vector (Qstring, alist); - free_alist (alist); - - if (is_cursor_font) - cursor_font_instantiate (image_instance, result, pointer_fg, - pointer_bg, dest_mask, domain); - else - string_instantiate (image_instance, result, pointer_fg, - pointer_bg, dest_mask, domain); - - UNGCPRO; -} - - -/********************************************************************** - * Font * - **********************************************************************/ - -static void -font_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -/* XmuCvtStringToCursor is bogus in the following ways: - - - When it can't convert the given string to a real cursor, it will - sometimes return a "success" value, after triggering a BadPixmap - error. It then gives you a cursor that will itself generate BadCursor - errors. So we install this error handler to catch/notice the X error - and take that as meaning "couldn't convert." - - - When you tell it to find a cursor file that doesn't exist, it prints - an error message on stderr. You can't make it not do that. - - - Also, using Xmu means we can't properly hack Lisp_Image_Instance - objects, or XPM files, or $XBMLANGPATH. - */ - -/* Duplicate the behavior of XmuCvtStringToCursor() to bypass its bogusness. */ - -static int XLoadFont_got_error; - -static int -XLoadFont_error_handler (Display *dpy, XErrorEvent *xerror) -{ - XLoadFont_got_error = 1; - return 0; -} - -static Font -safe_XLoadFont (Display *dpy, char *name) -{ - Font font; - int (*old_handler) (Display *, XErrorEvent *); - XLoadFont_got_error = 0; - XSync (dpy, 0); - old_handler = XSetErrorHandler (XLoadFont_error_handler); - font = XLoadFont (dpy, name); - XSync (dpy, 0); - XSetErrorHandler (old_handler); - if (XLoadFont_got_error) return 0; - return font; -} - -static int -font_possible_dest_types (void) -{ - return IMAGE_POINTER_MASK; -} - -static void -font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - /* This function can GC */ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Display *dpy; - XColor fg, bg; - Font source, mask; - char source_name[MAXPATHLEN], mask_name[MAXPATHLEN], dummy; - int source_char, mask_char; - int count; - Lisp_Object foreground, background; - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - - if (!STRINGP (data) || - strncmp ("FONT ", (char *) XSTRING_DATA (data), 5)) - signal_simple_error ("Invalid font-glyph instantiator", - instantiator); - - if (!(dest_mask & IMAGE_POINTER_MASK)) - incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK); - - foreground = find_keyword_in_vector (instantiator, Q_foreground); - if (NILP (foreground)) - foreground = pointer_fg; - background = find_keyword_in_vector (instantiator, Q_background); - if (NILP (background)) - background = pointer_bg; - - generate_cursor_fg_bg (device, &foreground, &background, &fg, &bg); - - count = sscanf ((char *) XSTRING_DATA (data), - "FONT %s %d %s %d %c", - source_name, &source_char, - mask_name, &mask_char, &dummy); - /* Allow "%s %d %d" as well... */ - if (count == 3 && (1 == sscanf (mask_name, "%d %c", &mask_char, &dummy))) - count = 4, mask_name[0] = 0; - - if (count != 2 && count != 4) - signal_simple_error ("invalid cursor specification", data); - source = safe_XLoadFont (dpy, source_name); - if (! source) - signal_simple_error_2 ("couldn't load font", - build_string (source_name), - data); - if (count == 2) - mask = 0; - else if (!mask_name[0]) - mask = source; - else - { - mask = safe_XLoadFont (dpy, mask_name); - if (!mask) - /* continuable */ - Fsignal (Qerror, list3 (build_string ("couldn't load font"), - build_string (mask_name), data)); - } - if (!mask) - mask_char = 0; - - /* #### call XQueryTextExtents() and check_pointer_sizes() here. */ - - x_initialize_pixmap_image_instance (ii, IMAGE_POINTER); - IMAGE_INSTANCE_X_CURSOR (ii) = - XCreateGlyphCursor (dpy, source, mask, source_char, mask_char, - &fg, &bg); - XIMAGE_INSTANCE_PIXMAP_FG (image_instance) = foreground; - XIMAGE_INSTANCE_PIXMAP_BG (image_instance) = background; - XUnloadFont (dpy, source); - if (mask && mask != source) XUnloadFont (dpy, mask); -} - - -/********************************************************************** - * Cursor-Font * - **********************************************************************/ - -static void -cursor_font_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -static int -cursor_font_possible_dest_types (void) -{ - return IMAGE_POINTER_MASK; -} - -static void -cursor_font_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - /* This function can GC */ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Display *dpy; - int i; - CONST char *name_ext; - Lisp_Object foreground, background; - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - - if (!(dest_mask & IMAGE_POINTER_MASK)) - incompatible_image_types (instantiator, dest_mask, IMAGE_POINTER_MASK); - - GET_C_STRING_FILENAME_DATA_ALLOCA (data, name_ext); - if ((i = XmuCursorNameToIndex (name_ext)) == -1) - signal_simple_error ("Unrecognized cursor-font name", data); - - x_initialize_pixmap_image_instance (ii, IMAGE_POINTER); - IMAGE_INSTANCE_X_CURSOR (ii) = XCreateFontCursor (dpy, i); - foreground = find_keyword_in_vector (instantiator, Q_foreground); - if (NILP (foreground)) - foreground = pointer_fg; - background = find_keyword_in_vector (instantiator, Q_background); - if (NILP (background)) - background = pointer_bg; - maybe_recolor_cursor (image_instance, foreground, background); -} - -static int -x_colorize_image_instance (Lisp_Object image_instance, - Lisp_Object foreground, Lisp_Object background) -{ - struct Lisp_Image_Instance *p; - - p = XIMAGE_INSTANCE (image_instance); - - switch (IMAGE_INSTANCE_TYPE (p)) - { - case IMAGE_MONO_PIXMAP: - IMAGE_INSTANCE_TYPE (p) = IMAGE_COLOR_PIXMAP; - /* Make sure there aren't two pointers to the same mask, causing - it to get freed twice. */ - IMAGE_INSTANCE_X_MASK (p) = 0; - break; - - default: - return 0; - } - - { - Display *dpy = DEVICE_X_DISPLAY (XDEVICE (IMAGE_INSTANCE_DEVICE (p))); - Drawable draw = XtWindow(DEVICE_XT_APP_SHELL (XDEVICE (IMAGE_INSTANCE_DEVICE (p)))); - Dimension d = DEVICE_X_DEPTH (XDEVICE (IMAGE_INSTANCE_DEVICE (p))); - Pixmap new = XCreatePixmap (dpy, draw, - IMAGE_INSTANCE_PIXMAP_WIDTH (p), - IMAGE_INSTANCE_PIXMAP_HEIGHT (p), d); - XColor color; - XGCValues gcv; - GC gc; - color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (foreground)); - gcv.foreground = color.pixel; - color = COLOR_INSTANCE_X_COLOR (XCOLOR_INSTANCE (background)); - gcv.background = color.pixel; - gc = XCreateGC (dpy, new, GCBackground|GCForeground, &gcv); - XCopyPlane (dpy, IMAGE_INSTANCE_X_PIXMAP (p), new, gc, 0, 0, - IMAGE_INSTANCE_PIXMAP_WIDTH (p), - IMAGE_INSTANCE_PIXMAP_HEIGHT (p), - 0, 0, 1); - XFreeGC (dpy, gc); - IMAGE_INSTANCE_X_PIXMAP (p) = new; - IMAGE_INSTANCE_PIXMAP_DEPTH (p) = d; - IMAGE_INSTANCE_PIXMAP_FG (p) = foreground; - IMAGE_INSTANCE_PIXMAP_BG (p) = background; - return 1; - } -} - - -/************************************************************************/ -/* subwindow and widget support */ -/************************************************************************/ - -/* unmap the image if it is a widget. This is used by redisplay via - redisplay_unmap_subwindows */ -static void -x_unmap_subwindow (struct Lisp_Image_Instance *p) -{ - XUnmapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); -} - -/* map the subwindow. This is used by redisplay via - redisplay_output_subwindow */ -static void -x_map_subwindow (struct Lisp_Image_Instance *p, int x, int y) -{ - XMapWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p)); - XMoveWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (p)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (p), x, y); -} - -/* instantiate and x type subwindow */ -static void -x_subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - /* This function can GC */ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Lisp_Object frame = FW_FRAME (domain); - struct frame* f = XFRAME (frame); - Display *dpy; - Screen *xs; - Window pw, win; - XSetWindowAttributes xswa; - Mask valueMask = 0; - unsigned int w = IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), - h = IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii); - - if (!DEVICE_X_P (XDEVICE (device))) - signal_simple_error ("Not an X device", device); - - dpy = DEVICE_X_DISPLAY (XDEVICE (device)); - xs = DefaultScreenOfDisplay (dpy); - - if (dest_mask & IMAGE_SUBWINDOW_MASK) - IMAGE_INSTANCE_TYPE (ii) = IMAGE_SUBWINDOW; - else - incompatible_image_types (instantiator, dest_mask, - IMAGE_SUBWINDOW_MASK); - - pw = XtWindow (FRAME_X_TEXT_WIDGET (f)); - - ii->data = xnew_and_zero (struct x_subwindow_data); - - IMAGE_INSTANCE_X_SUBWINDOW_PARENT (ii) = pw; - IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii) = xs; - - xswa.backing_store = Always; - valueMask |= CWBackingStore; - xswa.colormap = DefaultColormapOfScreen (xs); - valueMask |= CWColormap; - - win = XCreateWindow (dpy, pw, 0, 0, w, h, 0, CopyFromParent, - InputOutput, CopyFromParent, valueMask, - &xswa); - - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = (void*)win; -} - -#if 0 -/* #### Should this function exist? If there's any doubt I'm not implementing it --andyp */ -DEFUN ("change-subwindow-property", Fchange_subwindow_property, 3, 3, 0, /* -For the given SUBWINDOW, set PROPERTY to DATA, which is a string. -Subwindows are not currently implemented. -*/ - (subwindow, property, data)) -{ - Atom property_atom; - struct Lisp_Subwindow *sw; - Display *dpy; - - CHECK_SUBWINDOW (subwindow); - CHECK_STRING (property); - CHECK_STRING (data); - - sw = XSUBWINDOW (subwindow); - dpy = DisplayOfScreen (LISP_DEVICE_TO_X_SCREEN - (FRAME_DEVICE (XFRAME (sw->frame)))); - - property_atom = XInternAtom (dpy, (char *) XSTRING_DATA (property), False); - XChangeProperty (dpy, sw->subwindow, property_atom, XA_STRING, 8, - PropModeReplace, - XSTRING_DATA (data), - XSTRING_LENGTH (data)); - - return property; -} -#endif - -static void -x_resize_subwindow (struct Lisp_Image_Instance* ii, int w, int h) -{ - XResizeWindow (DisplayOfScreen (IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (ii)), - IMAGE_INSTANCE_X_SUBWINDOW_ID (ii), - w, h); -} - - -/************************************************************************/ -/* initialization */ -/************************************************************************/ - -void -syms_of_glyphs_x (void) -{ -#if 0 - DEFSUBR (Fchange_subwindow_property); -#endif -} - -void -console_type_create_glyphs_x (void) -{ - /* image methods */ - - CONSOLE_HAS_METHOD (x, print_image_instance); - CONSOLE_HAS_METHOD (x, finalize_image_instance); - CONSOLE_HAS_METHOD (x, image_instance_equal); - CONSOLE_HAS_METHOD (x, image_instance_hash); - CONSOLE_HAS_METHOD (x, colorize_image_instance); - CONSOLE_HAS_METHOD (x, init_image_instance_from_eimage); - CONSOLE_HAS_METHOD (x, locate_pixmap_file); - CONSOLE_HAS_METHOD (x, unmap_subwindow); - CONSOLE_HAS_METHOD (x, map_subwindow); - CONSOLE_HAS_METHOD (x, resize_subwindow); -} - -void -image_instantiator_format_create_glyphs_x (void) -{ -#ifdef HAVE_XPM - INITIALIZE_DEVICE_IIFORMAT (x, xpm); - IIFORMAT_HAS_DEVMETHOD (x, xpm, instantiate); -#endif - INITIALIZE_DEVICE_IIFORMAT (x, xbm); - IIFORMAT_HAS_DEVMETHOD (x, xbm, instantiate); - - INITIALIZE_DEVICE_IIFORMAT (x, subwindow); - IIFORMAT_HAS_DEVMETHOD (x, subwindow, instantiate); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (cursor_font, "cursor-font"); - - IIFORMAT_HAS_METHOD (cursor_font, validate); - IIFORMAT_HAS_METHOD (cursor_font, possible_dest_types); - IIFORMAT_HAS_METHOD (cursor_font, instantiate); - - IIFORMAT_VALID_KEYWORD (cursor_font, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (cursor_font, Q_foreground, check_valid_string); - IIFORMAT_VALID_KEYWORD (cursor_font, Q_background, check_valid_string); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (font, "font"); - - IIFORMAT_HAS_METHOD (font, validate); - IIFORMAT_HAS_METHOD (font, possible_dest_types); - IIFORMAT_HAS_METHOD (font, instantiate); - - IIFORMAT_VALID_KEYWORD (font, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (font, Q_foreground, check_valid_string); - IIFORMAT_VALID_KEYWORD (font, Q_background, check_valid_string); - -#ifdef HAVE_XFACE - INITIALIZE_DEVICE_IIFORMAT (x, xface); - IIFORMAT_HAS_DEVMETHOD (x, xface, instantiate); -#endif - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (autodetect, - "autodetect"); - - IIFORMAT_HAS_METHOD (autodetect, validate); - IIFORMAT_HAS_METHOD (autodetect, normalize); - IIFORMAT_HAS_METHOD (autodetect, possible_dest_types); - IIFORMAT_HAS_METHOD (autodetect, instantiate); - - IIFORMAT_VALID_KEYWORD (autodetect, Q_data, check_valid_string); -} - -void -vars_of_glyphs_x (void) -{ - DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path /* -A list of the directories in which X bitmap files may be found. -If nil, this is initialized from the "*bitmapFilePath" resource. -This is used by the `make-image-instance' function (however, note that if -the environment variable XBMLANGPATH is set, it is consulted first). -*/ ); - Vx_bitmap_file_path = Qnil; -} - -void -complex_vars_of_glyphs_x (void) -{ -#define BUILD_GLYPH_INST(variable, name) \ - Fadd_spec_to_specifier \ - (GLYPH_IMAGE (XGLYPH (variable)), \ - vector3 (Qxbm, Q_data, \ - list3 (make_int (name##_width), \ - make_int (name##_height), \ - make_ext_string (name##_bits, \ - sizeof (name##_bits), \ - FORMAT_BINARY))), \ - Qglobal, Qx, Qnil) - - BUILD_GLYPH_INST (Vtruncation_glyph, truncator); - BUILD_GLYPH_INST (Vcontinuation_glyph, continuer); - BUILD_GLYPH_INST (Vxemacs_logo, xemacs); - BUILD_GLYPH_INST (Vhscroll_glyph, hscroll); - -#undef BUILD_GLYPH_INST -} diff --git a/src/glyphs-x.h b/src/glyphs-x.h deleted file mode 100644 index ed77321..0000000 --- a/src/glyphs-x.h +++ /dev/null @@ -1,101 +0,0 @@ -/* X-specific glyphs and related. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing - Copyright (C) 1995 Sun Microsystems, 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. */ - -#ifndef _XEMACS_GLYPHS_X_H_ -#define _XEMACS_GLYPHS_X_H_ - -#include "glyphs.h" - -#ifdef HAVE_X_WINDOWS - -#include "xintrinsic.h" -#include "../lwlib/lwlib.h" - -/**************************************************************************** - * Image-Instance Object * - ****************************************************************************/ - -struct x_image_instance_data -{ - Pixmap pixmap; - Pixmap mask; - Cursor cursor; - - /* If depth>0, then that means that other colors were allocated when - this pixmap was loaded. These are they; we need to free them when - finalizing the image instance. */ - Colormap colormap; - unsigned long *pixels; - int npixels; - - /* Should we hang on to the extra info from the XpmAttributes, like - the textual color table and the comments? Is that useful? */ -}; - -#define X_IMAGE_INSTANCE_DATA(i) ((struct x_image_instance_data *) (i)->data) - -#define IMAGE_INSTANCE_X_PIXMAP(i) (X_IMAGE_INSTANCE_DATA (i)->pixmap) -#define IMAGE_INSTANCE_X_MASK(i) (X_IMAGE_INSTANCE_DATA (i)->mask) -#define IMAGE_INSTANCE_X_CURSOR(i) (X_IMAGE_INSTANCE_DATA (i)->cursor) -#define IMAGE_INSTANCE_X_COLORMAP(i) (X_IMAGE_INSTANCE_DATA (i)->colormap) -#define IMAGE_INSTANCE_X_PIXELS(i) (X_IMAGE_INSTANCE_DATA (i)->pixels) -#define IMAGE_INSTANCE_X_NPIXELS(i) (X_IMAGE_INSTANCE_DATA (i)->npixels) - -#define XIMAGE_INSTANCE_X_PIXMAP(i) \ - IMAGE_INSTANCE_X_PIXMAP (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_MASK(i) \ - IMAGE_INSTANCE_X_MASK (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_CURSOR(i) \ - IMAGE_INSTANCE_X_CURSOR (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_PIXELS(i) \ - IMAGE_INSTANCE_X_PIXELS (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_NPIXELS(i) \ - IMAGE_INSTANCE_X_NPIXELS (XIMAGE_INSTANCE (i)) - -/**************************************************************************** - * Subwindow Object * - ****************************************************************************/ - -struct x_subwindow_data -{ - Screen *xscreen; - Window parent_window; -}; - -#define X_SUBWINDOW_INSTANCE_DATA(i) ((struct x_subwindow_data *) (i)->data) - -#define IMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->xscreen) -#define IMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ - (X_SUBWINDOW_INSTANCE_DATA (i)->parent_window) -#define XIMAGE_INSTANCE_X_SUBWINDOW_PARENT(i) \ - IMAGE_INSTANCE_X_SUBWINDOW_PARENT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_X_SUBWINDOW_SCREEN(i) \ - IMAGE_INSTANCE_X_SUBWINDOW_SCREEN (XIMAGE_INSTANCE (i)) -#define IMAGE_INSTANCE_X_SUBWINDOW_ID(i) \ - ((Window) IMAGE_INSTANCE_SUBWINDOW_ID (i)) - -#endif /* HAVE_X_WINDOWS */ -#endif /* _XEMACS_GLYPHS_X_H_ */ diff --git a/src/glyphs.c b/src/glyphs.c deleted file mode 100644 index 5acac8d..0000000 --- a/src/glyphs.c +++ /dev/null @@ -1,4276 +0,0 @@ -/* Generic glyph/image implementation + display tables - Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995 Tinker Systems - Copyright (C) 1995, 1996 Ben Wing - Copyright (C) 1995 Sun Microsystems - Copyright (C) 1998 Andy Piper - -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 and Chuck Thompson */ - -#include -#include "lisp.h" - -#include "buffer.h" -#include "device.h" -#include "elhash.h" -#include "faces.h" -#include "frame.h" -#include "insdel.h" -#include "opaque.h" -#include "objects.h" -#include "redisplay.h" -#include "window.h" -#include "frame.h" -#include "chartab.h" -#include "rangetab.h" - -#ifdef HAVE_XPM -#include -#endif - -Lisp_Object Qimage_conversion_error; - -Lisp_Object Qglyphp, Qcontrib_p, Qbaseline; -Lisp_Object Qbuffer_glyph_p, Qpointer_glyph_p, Qicon_glyph_p; -Lisp_Object Qnothing_image_instance_p, Qtext_image_instance_p; -Lisp_Object Qmono_pixmap_image_instance_p; -Lisp_Object Qcolor_pixmap_image_instance_p; -Lisp_Object Qpointer_image_instance_p; -Lisp_Object Qsubwindow_image_instance_p; -Lisp_Object Qwidget_image_instance_p; -Lisp_Object Qconst_glyph_variable; -Lisp_Object Qmono_pixmap, Qcolor_pixmap, Qsubwindow; -Lisp_Object Q_file, Q_data, Q_face, Q_pixel_width, Q_pixel_height; -Lisp_Object Qformatted_string; -Lisp_Object Vcurrent_display_table; -Lisp_Object Vtruncation_glyph, Vcontinuation_glyph, Voctal_escape_glyph; -Lisp_Object Vcontrol_arrow_glyph, Vinvisible_text_glyph, Vhscroll_glyph; -Lisp_Object Vxemacs_logo; -Lisp_Object Vthe_nothing_vector; -Lisp_Object Vimage_instantiator_format_list; -Lisp_Object Vimage_instance_type_list; -Lisp_Object Vglyph_type_list; - -DEFINE_IMAGE_INSTANTIATOR_FORMAT (nothing); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (inherit); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (string); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (formatted_string); -DEFINE_IMAGE_INSTANTIATOR_FORMAT (subwindow); - -#ifdef HAVE_WINDOW_SYSTEM -DEFINE_IMAGE_INSTANTIATOR_FORMAT (xbm); -Lisp_Object Qxbm; - -Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; -Lisp_Object Q_foreground, Q_background; -#ifndef BitmapSuccess -#define BitmapSuccess 0 -#define BitmapOpenFailed 1 -#define BitmapFileInvalid 2 -#define BitmapNoMemory 3 -#endif -#endif - -#ifdef HAVE_XFACE -DEFINE_IMAGE_INSTANTIATOR_FORMAT (xface); -Lisp_Object Qxface; -#endif - -#ifdef HAVE_XPM -DEFINE_IMAGE_INSTANTIATOR_FORMAT (xpm); -Lisp_Object Qxpm; -Lisp_Object Q_color_symbols; -#endif - -typedef struct image_instantiator_format_entry image_instantiator_format_entry; -struct image_instantiator_format_entry -{ - Lisp_Object symbol; - Lisp_Object device; - struct image_instantiator_methods *meths; -}; - -typedef struct -{ - Dynarr_declare (struct image_instantiator_format_entry); -} image_instantiator_format_entry_dynarr; - -image_instantiator_format_entry_dynarr * - the_image_instantiator_format_entry_dynarr; - -static Lisp_Object allocate_image_instance (Lisp_Object device); -static void image_validate (Lisp_Object instantiator); -static void glyph_property_was_changed (Lisp_Object glyph, - Lisp_Object property, - Lisp_Object locale); -EXFUN (Fimage_instance_type, 1); -EXFUN (Fglyph_type, 1); - - -/**************************************************************************** - * Image Instantiators * - ****************************************************************************/ - -struct image_instantiator_methods * -decode_device_ii_format (Lisp_Object device, Lisp_Object format, - Error_behavior errb) -{ - int i; - - if (!SYMBOLP (format)) - { - if (ERRB_EQ (errb, ERROR_ME)) - CHECK_SYMBOL (format); - return 0; - } - - for (i = 0; i < Dynarr_length (the_image_instantiator_format_entry_dynarr); - i++) - { - if ( EQ (format, - Dynarr_at (the_image_instantiator_format_entry_dynarr, i). - symbol) ) - { - Lisp_Object d = Dynarr_at (the_image_instantiator_format_entry_dynarr, i). - device; - if ((NILP (d) && NILP (device)) - || - (!NILP (device) && - EQ (CONSOLE_TYPE (XCONSOLE - (DEVICE_CONSOLE (XDEVICE (device)))), d))) - return Dynarr_at (the_image_instantiator_format_entry_dynarr, i).meths; - } - } - - maybe_signal_simple_error ("Invalid image-instantiator format", format, - Qimage, errb); - - return 0; -} - -struct image_instantiator_methods * -decode_image_instantiator_format (Lisp_Object format, Error_behavior errb) -{ - return decode_device_ii_format (Qnil, format, errb); -} - -static int -valid_image_instantiator_format_p (Lisp_Object format) -{ - return (decode_image_instantiator_format (format, ERROR_ME_NOT) != 0); -} - -DEFUN ("valid-image-instantiator-format-p", Fvalid_image_instantiator_format_p, - 1, 1, 0, /* -Given an IMAGE-INSTANTIATOR-FORMAT, return non-nil if it is valid. -Valid formats are some subset of 'nothing, 'string, 'formatted-string, -'xpm, 'xbm, 'xface, 'gif, 'jpeg, 'png, 'tiff, 'cursor-font, 'font, -'autodetect, 'widget and 'subwindow, depending on how XEmacs was compiled. -*/ - (image_instantiator_format)) -{ - return valid_image_instantiator_format_p (image_instantiator_format) ? - Qt : Qnil; -} - -DEFUN ("image-instantiator-format-list", Fimage_instantiator_format_list, - 0, 0, 0, /* -Return a list of valid image-instantiator formats. -*/ - ()) -{ - return Fcopy_sequence (Vimage_instantiator_format_list); -} - -void -add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, - struct image_instantiator_methods *meths) -{ - struct image_instantiator_format_entry entry; - - entry.symbol = symbol; - entry.device = device; - entry.meths = meths; - Dynarr_add (the_image_instantiator_format_entry_dynarr, entry); - Vimage_instantiator_format_list = - Fcons (symbol, Vimage_instantiator_format_list); -} - -void -add_entry_to_image_instantiator_format_list (Lisp_Object symbol, - struct - image_instantiator_methods *meths) -{ - add_entry_to_device_ii_format_list (Qnil, symbol, meths); -} - -static Lisp_Object * -get_image_conversion_list (Lisp_Object console_type) -{ - return &decode_console_type (console_type, ERROR_ME)->image_conversion_list; -} - -DEFUN ("set-console-type-image-conversion-list", Fset_console_type_image_conversion_list, - 2, 2, 0, /* -Set the image-conversion-list for consoles of the given TYPE. -The image-conversion-list specifies how image instantiators that -are strings should be interpreted. Each element of the list should be -a list of two elements (a regular expression string and a vector) or -a list of three elements (the preceding two plus an integer index into -the vector). The string is converted to the vector associated with the -first matching regular expression. If a vector index is specified, the -string itself is substituted into that position in the vector. - -Note: The conversion above is applied when the image instantiator is -added to an image specifier, not when the specifier is actually -instantiated. Therefore, changing the image-conversion-list only affects -newly-added instantiators. Existing instantiators in glyphs and image -specifiers will not be affected. -*/ - (console_type, list)) -{ - Lisp_Object tail; - Lisp_Object *imlist = get_image_conversion_list (console_type); - - /* Check the list to make sure that it only has valid entries. */ - - EXTERNAL_LIST_LOOP (tail, list) - { - Lisp_Object mapping = XCAR (tail); - - /* Mapping form should be (STRING VECTOR) or (STRING VECTOR INTEGER) */ - if (!CONSP (mapping) || - !CONSP (XCDR (mapping)) || - (!NILP (XCDR (XCDR (mapping))) && - (!CONSP (XCDR (XCDR (mapping))) || - !NILP (XCDR (XCDR (XCDR (mapping))))))) - signal_simple_error ("Invalid mapping form", mapping); - else - { - Lisp_Object exp = XCAR (mapping); - Lisp_Object typevec = XCAR (XCDR (mapping)); - Lisp_Object pos = Qnil; - Lisp_Object newvec; - struct gcpro gcpro1; - - CHECK_STRING (exp); - CHECK_VECTOR (typevec); - if (!NILP (XCDR (XCDR (mapping)))) - { - pos = XCAR (XCDR (XCDR (mapping))); - CHECK_INT (pos); - if (XINT (pos) < 0 || - XINT (pos) >= XVECTOR_LENGTH (typevec)) - args_out_of_range_3 - (pos, Qzero, make_int (XVECTOR_LENGTH (typevec) - 1)); - } - - newvec = Fcopy_sequence (typevec); - if (INTP (pos)) - XVECTOR_DATA (newvec)[XINT (pos)] = exp; - GCPRO1 (newvec); - image_validate (newvec); - UNGCPRO; - } - } - - *imlist = Fcopy_tree (list, Qt); - return list; -} - -DEFUN ("console-type-image-conversion-list", Fconsole_type_image_conversion_list, - 1, 1, 0, /* -Return the image-conversion-list for devices of the given TYPE. -The image-conversion-list specifies how to interpret image string -instantiators for the specified console type. See -`set-console-type-image-conversion-list' for a description of its syntax. -*/ - (console_type)) -{ - return Fcopy_tree (*get_image_conversion_list (console_type), Qt); -} - -/* Process a string instantiator according to the image-conversion-list for - CONSOLE_TYPE. Returns a vector. */ - -static Lisp_Object -process_image_string_instantiator (Lisp_Object data, - Lisp_Object console_type, - int dest_mask) -{ - Lisp_Object tail; - - LIST_LOOP (tail, *get_image_conversion_list (console_type)) - { - Lisp_Object mapping = XCAR (tail); - Lisp_Object exp = XCAR (mapping); - Lisp_Object typevec = XCAR (XCDR (mapping)); - - /* if the result is of a type that can't be instantiated - (e.g. a string when we're dealing with a pointer glyph), - skip it. */ - if (!(dest_mask & - IIFORMAT_METH (decode_image_instantiator_format - (XVECTOR_DATA (typevec)[0], ERROR_ME), - possible_dest_types, ()))) - continue; - if (fast_string_match (exp, 0, data, 0, -1, 0, ERROR_ME, 0) >= 0) - { - if (!NILP (XCDR (XCDR (mapping)))) - { - int pos = XINT (XCAR (XCDR (XCDR (mapping)))); - Lisp_Object newvec = Fcopy_sequence (typevec); - XVECTOR_DATA (newvec)[pos] = data; - return newvec; - } - else - return typevec; - } - } - - /* Oh well. */ - signal_simple_error ("Unable to interpret glyph instantiator", - data); - - return Qnil; -} - -Lisp_Object -find_keyword_in_vector_or_given (Lisp_Object vector, Lisp_Object keyword, - Lisp_Object default_) -{ - Lisp_Object *elt; - int instantiator_len; - - elt = XVECTOR_DATA (vector); - instantiator_len = XVECTOR_LENGTH (vector); - - elt++; - instantiator_len--; - - while (instantiator_len > 0) - { - if (EQ (elt[0], keyword)) - return elt[1]; - elt += 2; - instantiator_len -= 2; - } - - return default_; -} - -Lisp_Object -find_keyword_in_vector (Lisp_Object vector, Lisp_Object keyword) -{ - return find_keyword_in_vector_or_given (vector, keyword, Qnil); -} - -void -check_valid_string (Lisp_Object data) -{ - CHECK_STRING (data); -} - -void -check_valid_vector (Lisp_Object data) -{ - CHECK_VECTOR (data); -} - -void -check_valid_face (Lisp_Object data) -{ - Fget_face (data); -} - -void -check_valid_int (Lisp_Object data) -{ - CHECK_INT (data); -} - -void -file_or_data_must_be_present (Lisp_Object instantiator) -{ - if (NILP (find_keyword_in_vector (instantiator, Q_file)) && - NILP (find_keyword_in_vector (instantiator, Q_data))) - signal_simple_error ("Must supply either :file or :data", - instantiator); -} - -void -data_must_be_present (Lisp_Object instantiator) -{ - if (NILP (find_keyword_in_vector (instantiator, Q_data))) - signal_simple_error ("Must supply :data", instantiator); -} - -static void -face_must_be_present (Lisp_Object instantiator) -{ - if (NILP (find_keyword_in_vector (instantiator, Q_face))) - signal_simple_error ("Must supply :face", instantiator); -} - -/* utility function useful in retrieving data from a file. */ - -Lisp_Object -make_string_from_file (Lisp_Object file) -{ - /* This function can call lisp */ - int count = specpdl_depth (); - Lisp_Object temp_buffer; - struct gcpro gcpro1; - Lisp_Object data; - - specbind (Qinhibit_quit, Qt); - record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - temp_buffer = Fget_buffer_create (build_string (" *pixmap conversion*")); - GCPRO1 (temp_buffer); - set_buffer_internal (XBUFFER (temp_buffer)); - Ferase_buffer (Qnil); - specbind (intern ("format-alist"), Qnil); - Finsert_file_contents_internal (file, Qnil, Qnil, Qnil, Qnil, Qnil, Qnil); - data = Fbuffer_substring (Qnil, Qnil, Qnil); - unbind_to (count, Qnil); - UNGCPRO; - return data; -} - -/* The following two functions are provided to make it easier for - the normalize methods to work with keyword-value vectors. - Hash tables are kind of heavyweight for this purpose. - (If vectors were resizable, we could avoid this problem; - but they're not.) An alternative approach that might be - more efficient but require more work is to use a type of - assoc-Dynarr and provide primitives for deleting elements out - of it. (However, you'd also have to add an unwind-protect - to make sure the Dynarr got freed in case of an error in - the normalization process.) */ - -Lisp_Object -tagged_vector_to_alist (Lisp_Object vector) -{ - Lisp_Object *elt = XVECTOR_DATA (vector); - int len = XVECTOR_LENGTH (vector); - Lisp_Object result = Qnil; - - assert (len & 1); - for (len -= 2; len >= 1; len -= 2) - result = Fcons (Fcons (elt[len], elt[len+1]), result); - - return result; -} - -Lisp_Object -alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist) -{ - int len = 1 + 2 * XINT (Flength (alist)); - Lisp_Object *elt = alloca_array (Lisp_Object, len); - int i; - Lisp_Object rest; - - i = 0; - elt[i++] = tag; - LIST_LOOP (rest, alist) - { - Lisp_Object pair = XCAR (rest); - elt[i] = XCAR (pair); - elt[i+1] = XCDR (pair); - i += 2; - } - - return Fvector (len, elt); -} - -static Lisp_Object -normalize_image_instantiator (Lisp_Object instantiator, - Lisp_Object contype, - Lisp_Object dest_mask) -{ - if (IMAGE_INSTANCEP (instantiator)) - return instantiator; - - if (STRINGP (instantiator)) - instantiator = process_image_string_instantiator (instantiator, contype, - XINT (dest_mask)); - - assert (VECTORP (instantiator)); - /* We have to always store the actual pixmap data and not the - filename even though this is a potential memory pig. We have to - do this because it is quite possible that we will need to - instantiate a new instance of the pixmap and the file will no - longer exist (e.g. w3 pixmaps are almost always from temporary - files). */ - { - struct gcpro gcpro1; - struct image_instantiator_methods *meths; - - GCPRO1 (instantiator); - - meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], - ERROR_ME); - RETURN_UNGCPRO (IIFORMAT_METH_OR_GIVEN (meths, normalize, - (instantiator, contype), - instantiator)); - } -} - -static Lisp_Object -instantiate_image_instantiator (Lisp_Object device, Lisp_Object domain, - Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask) -{ - Lisp_Object ii = allocate_image_instance (device); - struct image_instantiator_methods *meths; - struct gcpro gcpro1; - int methp = 0; - - GCPRO1 (ii); - meths = decode_image_instantiator_format (XVECTOR_DATA (instantiator)[0], - ERROR_ME); - methp = (int)HAS_IIFORMAT_METH_P (meths, instantiate); - MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); - - /* now do device specific instantiation */ - meths = decode_device_ii_format (device, XVECTOR_DATA (instantiator)[0], - ERROR_ME_NOT); - - if (!methp && (!meths || !HAS_IIFORMAT_METH_P (meths, instantiate))) - signal_simple_error - ("Don't know how to instantiate this image instantiator?", - instantiator); - MAYBE_IIFORMAT_METH (meths, instantiate, (ii, instantiator, pointer_fg, - pointer_bg, dest_mask, domain)); - UNGCPRO; - - return ii; -} - - -/**************************************************************************** - * Image-Instance Object * - ****************************************************************************/ - -Lisp_Object Qimage_instancep; - -static Lisp_Object -mark_image_instance (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); - - markobj (i->name); - switch (IMAGE_INSTANCE_TYPE (i)) - { - case IMAGE_TEXT: - markobj (IMAGE_INSTANCE_TEXT_STRING (i)); - break; - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - markobj (IMAGE_INSTANCE_PIXMAP_FILENAME (i)); - markobj (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i)); - markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i)); - markobj (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i)); - markobj (IMAGE_INSTANCE_PIXMAP_FG (i)); - markobj (IMAGE_INSTANCE_PIXMAP_BG (i)); - break; - - case IMAGE_WIDGET: - markobj (IMAGE_INSTANCE_WIDGET_TYPE (i)); - markobj (IMAGE_INSTANCE_WIDGET_PROPS (i)); - markobj (IMAGE_INSTANCE_WIDGET_FACE (i)); - mark_gui_item (&IMAGE_INSTANCE_WIDGET_ITEM (i), markobj); - case IMAGE_SUBWINDOW: - markobj (IMAGE_INSTANCE_SUBWINDOW_FRAME (i)); - break; - - default: - break; - } - - MAYBE_DEVMETH (XDEVICE (i->device), mark_image_instance, (i, markobj)); - - return i->device; -} - -static void -print_image_instance (Lisp_Object obj, Lisp_Object printcharfun, - int escapeflag) -{ - char buf[100]; - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (obj); - - if (print_readably) - error ("printing unreadable object #", - ii->header.uid); - write_c_string ("#name)) - { - print_internal (ii->name, printcharfun, 1); - write_c_string (" ", printcharfun); - } - write_c_string ("on ", printcharfun); - print_internal (ii->device, printcharfun, 0); - write_c_string (" ", printcharfun); - switch (IMAGE_INSTANCE_TYPE (ii)) - { - case IMAGE_NOTHING: - break; - - case IMAGE_TEXT: - print_internal (IMAGE_INSTANCE_TEXT_STRING (ii), printcharfun, 1); - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - if (STRINGP (IMAGE_INSTANCE_PIXMAP_FILENAME (ii))) - { - char *s; - Lisp_Object filename = IMAGE_INSTANCE_PIXMAP_FILENAME (ii); - s = strrchr ((char *) XSTRING_DATA (filename), '/'); - if (s) - print_internal (build_string (s + 1), printcharfun, 1); - else - print_internal (filename, printcharfun, 1); - } - if (IMAGE_INSTANCE_PIXMAP_DEPTH (ii) > 1) - sprintf (buf, " %dx%dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii), - IMAGE_INSTANCE_PIXMAP_DEPTH (ii)); - else - sprintf (buf, " %dx%d", IMAGE_INSTANCE_PIXMAP_WIDTH (ii), - IMAGE_INSTANCE_PIXMAP_HEIGHT (ii)); - write_c_string (buf, printcharfun); - if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii)) || - !NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) - { - write_c_string (" @", printcharfun); - if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))) - { - long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (ii))); - write_c_string (buf, printcharfun); - } - else - write_c_string ("??", printcharfun); - write_c_string (",", printcharfun); - if (!NILP (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))) - { - long_to_string (buf, XINT (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (ii))); - write_c_string (buf, printcharfun); - } - else - write_c_string ("??", printcharfun); - } - if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii)) || - !NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) - { - write_c_string (" (", printcharfun); - if (!NILP (IMAGE_INSTANCE_PIXMAP_FG (ii))) - { - print_internal - (XCOLOR_INSTANCE - (IMAGE_INSTANCE_PIXMAP_FG (ii))->name, printcharfun, 0); - } - write_c_string ("/", printcharfun); - if (!NILP (IMAGE_INSTANCE_PIXMAP_BG (ii))) - { - print_internal - (XCOLOR_INSTANCE - (IMAGE_INSTANCE_PIXMAP_BG (ii))->name, printcharfun, 0); - } - write_c_string (")", printcharfun); - } - break; - - case IMAGE_WIDGET: - if (!NILP (IMAGE_INSTANCE_WIDGET_CALLBACK (ii))) - { - print_internal (IMAGE_INSTANCE_WIDGET_CALLBACK (ii), printcharfun, 0); - write_c_string (", ", printcharfun); - } - if (!NILP (IMAGE_INSTANCE_WIDGET_FACE (ii))) - { - write_c_string (" (", printcharfun); - print_internal - (IMAGE_INSTANCE_WIDGET_FACE (ii), printcharfun, 0); - write_c_string (")", printcharfun); - } - - if (!NILP (IMAGE_INSTANCE_WIDGET_TEXT (ii))) - print_internal (IMAGE_INSTANCE_WIDGET_TEXT (ii), printcharfun, 0); - - case IMAGE_SUBWINDOW: - sprintf (buf, " %dx%d", IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii), - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii)); - write_c_string (buf, printcharfun); - - /* This is stolen from frame.c. Subwindows are strange in that they - are specific to a particular frame so we want to print in their - description what that frame is. */ - - write_c_string (" on #<", printcharfun); - { - struct frame* f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); - - if (!FRAME_LIVE_P (f)) - write_c_string ("dead", printcharfun); - else - write_c_string (DEVICE_TYPE_NAME (XDEVICE (FRAME_DEVICE (f))), - printcharfun); - - write_c_string ("-frame ", printcharfun); - } - write_c_string (">", printcharfun); - sprintf (buf, " 0x%p", IMAGE_INSTANCE_SUBWINDOW_ID (ii)); - write_c_string (buf, printcharfun); - - break; - - default: - abort (); - } - - MAYBE_DEVMETH (XDEVICE (ii->device), print_image_instance, - (ii, printcharfun, escapeflag)); - sprintf (buf, " 0x%x>", ii->header.uid); - write_c_string (buf, printcharfun); -} - -static void -finalize_image_instance (void *header, int for_disksave) -{ - struct Lisp_Image_Instance *i = (struct Lisp_Image_Instance *) header; - - if (IMAGE_INSTANCE_TYPE (i) == IMAGE_NOTHING) - /* objects like this exist at dump time, so don't bomb out. */ - return; - if (for_disksave) finalose (i); - - /* do this so that the cachels get reset */ - if (IMAGE_INSTANCE_TYPE (i) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (i) == IMAGE_SUBWINDOW) - { - MARK_FRAME_GLYPHS_CHANGED - (XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (i))); - } - - MAYBE_DEVMETH (XDEVICE (i->device), finalize_image_instance, (i)); -} - -static int -image_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Image_Instance *i1 = XIMAGE_INSTANCE (obj1); - struct Lisp_Image_Instance *i2 = XIMAGE_INSTANCE (obj2); - struct device *d1 = XDEVICE (i1->device); - struct device *d2 = XDEVICE (i2->device); - - if (d1 != d2) - return 0; - if (IMAGE_INSTANCE_TYPE (i1) != IMAGE_INSTANCE_TYPE (i2)) - return 0; - if (!internal_equal (IMAGE_INSTANCE_NAME (i1), IMAGE_INSTANCE_NAME (i2), - depth + 1)) - return 0; - - switch (IMAGE_INSTANCE_TYPE (i1)) - { - case IMAGE_NOTHING: - break; - - case IMAGE_TEXT: - if (!internal_equal (IMAGE_INSTANCE_TEXT_STRING (i1), - IMAGE_INSTANCE_TEXT_STRING (i2), - depth + 1)) - return 0; - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - if (!(IMAGE_INSTANCE_PIXMAP_WIDTH (i1) == - IMAGE_INSTANCE_PIXMAP_WIDTH (i2) && - IMAGE_INSTANCE_PIXMAP_HEIGHT (i1) == - IMAGE_INSTANCE_PIXMAP_HEIGHT (i2) && - IMAGE_INSTANCE_PIXMAP_DEPTH (i1) == - IMAGE_INSTANCE_PIXMAP_DEPTH (i2) && - EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i1), - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (i2)) && - EQ (IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i1), - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (i2)) && - internal_equal (IMAGE_INSTANCE_PIXMAP_FILENAME (i1), - IMAGE_INSTANCE_PIXMAP_FILENAME (i2), - depth + 1) && - internal_equal (IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i1), - IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (i2), - depth + 1))) - return 0; - break; - - case IMAGE_WIDGET: - if (!(EQ (IMAGE_INSTANCE_WIDGET_TYPE (i1), - IMAGE_INSTANCE_WIDGET_TYPE (i2)) && - EQ (IMAGE_INSTANCE_WIDGET_CALLBACK (i1), - IMAGE_INSTANCE_WIDGET_CALLBACK (i2)) - && internal_equal (IMAGE_INSTANCE_WIDGET_PROPS (i1), - IMAGE_INSTANCE_WIDGET_PROPS (i2), - depth + 1) - && internal_equal (IMAGE_INSTANCE_WIDGET_TEXT (i1), - IMAGE_INSTANCE_WIDGET_TEXT (i2), - depth + 1))) - return 0; - case IMAGE_SUBWINDOW: - if (!(IMAGE_INSTANCE_SUBWINDOW_WIDTH (i1) == - IMAGE_INSTANCE_SUBWINDOW_WIDTH (i2) && - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i1) == - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i2) && - IMAGE_INSTANCE_SUBWINDOW_ID (i1) == - IMAGE_INSTANCE_SUBWINDOW_ID (i2))) - return 0; - break; - - default: - abort (); - } - - return DEVMETH_OR_GIVEN (d1, image_instance_equal, (i1, i2, depth), 1); -} - -static unsigned long -image_instance_hash (Lisp_Object obj, int depth) -{ - struct Lisp_Image_Instance *i = XIMAGE_INSTANCE (obj); - struct device *d = XDEVICE (i->device); - unsigned long hash = (unsigned long) d; - - switch (IMAGE_INSTANCE_TYPE (i)) - { - case IMAGE_NOTHING: - break; - - case IMAGE_TEXT: - hash = HASH2 (hash, internal_hash (IMAGE_INSTANCE_TEXT_STRING (i), - depth + 1)); - break; - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - hash = HASH5 (hash, IMAGE_INSTANCE_PIXMAP_WIDTH (i), - IMAGE_INSTANCE_PIXMAP_HEIGHT (i), - IMAGE_INSTANCE_PIXMAP_DEPTH (i), - internal_hash (IMAGE_INSTANCE_PIXMAP_FILENAME (i), - depth + 1)); - break; - - case IMAGE_WIDGET: - hash = HASH4 (hash, - internal_hash (IMAGE_INSTANCE_WIDGET_TYPE (i), depth + 1), - internal_hash (IMAGE_INSTANCE_WIDGET_PROPS (i), depth + 1), - internal_hash (IMAGE_INSTANCE_WIDGET_CALLBACK (i), depth + 1)); - case IMAGE_SUBWINDOW: - hash = HASH4 (hash, IMAGE_INSTANCE_SUBWINDOW_WIDTH (i), - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (i), - (int) IMAGE_INSTANCE_SUBWINDOW_ID (i)); - break; - - default: - abort (); - } - - return HASH2 (hash, DEVMETH_OR_GIVEN (d, image_instance_hash, (i, depth), - 0)); -} - -DEFINE_LRECORD_IMPLEMENTATION ("image-instance", image_instance, - mark_image_instance, print_image_instance, - finalize_image_instance, image_instance_equal, - image_instance_hash, - struct Lisp_Image_Instance); - -static Lisp_Object -allocate_image_instance (Lisp_Object device) -{ - struct Lisp_Image_Instance *lp = - alloc_lcrecord_type (struct Lisp_Image_Instance, lrecord_image_instance); - Lisp_Object val; - - zero_lcrecord (lp); - lp->device = device; - lp->type = IMAGE_NOTHING; - lp->name = Qnil; - XSETIMAGE_INSTANCE (val, lp); - return val; -} - -static enum image_instance_type -decode_image_instance_type (Lisp_Object type, Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME)) - CHECK_SYMBOL (type); - - if (EQ (type, Qnothing)) return IMAGE_NOTHING; - if (EQ (type, Qtext)) return IMAGE_TEXT; - if (EQ (type, Qmono_pixmap)) return IMAGE_MONO_PIXMAP; - if (EQ (type, Qcolor_pixmap)) return IMAGE_COLOR_PIXMAP; - if (EQ (type, Qpointer)) return IMAGE_POINTER; - if (EQ (type, Qsubwindow)) return IMAGE_SUBWINDOW; - if (EQ (type, Qwidget)) return IMAGE_WIDGET; - - maybe_signal_simple_error ("Invalid image-instance type", type, - Qimage, errb); - - return IMAGE_UNKNOWN; /* not reached */ -} - -static Lisp_Object -encode_image_instance_type (enum image_instance_type type) -{ - switch (type) - { - case IMAGE_NOTHING: return Qnothing; - case IMAGE_TEXT: return Qtext; - case IMAGE_MONO_PIXMAP: return Qmono_pixmap; - case IMAGE_COLOR_PIXMAP: return Qcolor_pixmap; - case IMAGE_POINTER: return Qpointer; - case IMAGE_SUBWINDOW: return Qsubwindow; - case IMAGE_WIDGET: return Qwidget; - default: - abort (); - } - - return Qnil; /* not reached */ -} - -static int -image_instance_type_to_mask (enum image_instance_type type) -{ - /* This depends on the fact that enums are assigned consecutive - integers starting at 0. (Remember that IMAGE_UNKNOWN is the - first enum.) I'm fairly sure this behavior in ANSI-mandated, - so there should be no portability problems here. */ - return (1 << ((int) (type) - 1)); -} - -static int -decode_image_instance_type_list (Lisp_Object list) -{ - Lisp_Object rest; - int mask = 0; - - if (NILP (list)) - return ~0; - - if (!CONSP (list)) - { - enum image_instance_type type = - decode_image_instance_type (list, ERROR_ME); - return image_instance_type_to_mask (type); - } - - EXTERNAL_LIST_LOOP (rest, list) - { - enum image_instance_type type = - decode_image_instance_type (XCAR (rest), ERROR_ME); - mask |= image_instance_type_to_mask (type); - } - - return mask; -} - -static Lisp_Object -encode_image_instance_type_list (int mask) -{ - int count = 0; - Lisp_Object result = Qnil; - - while (mask) - { - count++; - if (mask & 1) - result = Fcons (encode_image_instance_type - ((enum image_instance_type) count), result); - mask >>= 1; - } - - return Fnreverse (result); -} - -DOESNT_RETURN -incompatible_image_types (Lisp_Object instantiator, int given_dest_mask, - int desired_dest_mask) -{ - signal_error - (Qerror, - list2 - (emacs_doprnt_string_lisp_2 - ((CONST Bufbyte *) - "No compatible image-instance types given: wanted one of %s, got %s", - Qnil, -1, 2, - encode_image_instance_type_list (desired_dest_mask), - encode_image_instance_type_list (given_dest_mask)), - instantiator)); -} - -static int -valid_image_instance_type_p (Lisp_Object type) -{ - return !NILP (memq_no_quit (type, Vimage_instance_type_list)); -} - -DEFUN ("valid-image-instance-type-p", Fvalid_image_instance_type_p, 1, 1, 0, /* -Given an IMAGE-INSTANCE-TYPE, return non-nil if it is valid. -Valid types are some subset of 'nothing, 'text, 'mono-pixmap, 'color-pixmap, -'pointer, and 'subwindow, depending on how XEmacs was compiled. -*/ - (image_instance_type)) -{ - return valid_image_instance_type_p (image_instance_type) ? Qt : Qnil; -} - -DEFUN ("image-instance-type-list", Fimage_instance_type_list, 0, 0, 0, /* -Return a list of valid image-instance types. -*/ - ()) -{ - return Fcopy_sequence (Vimage_instance_type_list); -} - -Error_behavior -decode_error_behavior_flag (Lisp_Object no_error) -{ - if (NILP (no_error)) return ERROR_ME; - else if (EQ (no_error, Qt)) return ERROR_ME_NOT; - else return ERROR_ME_WARN; -} - -Lisp_Object -encode_error_behavior_flag (Error_behavior errb) -{ - if (ERRB_EQ (errb, ERROR_ME)) - return Qnil; - else if (ERRB_EQ (errb, ERROR_ME_NOT)) - return Qt; - else - { - assert (ERRB_EQ (errb, ERROR_ME_WARN)); - return Qwarning; - } -} - -static Lisp_Object -make_image_instance_1 (Lisp_Object data, Lisp_Object device, - Lisp_Object dest_types) -{ - Lisp_Object ii; - struct gcpro gcpro1; - int dest_mask; - - XSETDEVICE (device, decode_device (device)); - /* instantiate_image_instantiator() will abort if given an - image instance ... */ - if (IMAGE_INSTANCEP (data)) - signal_simple_error ("Image instances not allowed here", data); - image_validate (data); - dest_mask = decode_image_instance_type_list (dest_types); - data = normalize_image_instantiator (data, DEVICE_TYPE (XDEVICE (device)), - make_int (dest_mask)); - GCPRO1 (data); - if (VECTORP (data) && EQ (XVECTOR_DATA (data)[0], Qinherit)) - signal_simple_error ("Inheritance not allowed here", data); - ii = instantiate_image_instantiator (device, device, data, - Qnil, Qnil, dest_mask); - RETURN_UNGCPRO (ii); -} - -DEFUN ("make-image-instance", Fmake_image_instance, 1, 4, 0, /* -Return a new `image-instance' object. - -Image-instance objects encapsulate the way a particular image (pixmap, -etc.) is displayed on a particular device. In most circumstances, you -do not need to directly create image instances; use a glyph instead. -However, it may occasionally be useful to explicitly create image -instances, if you want more control over the instantiation process. - -DATA is an image instantiator, which describes the image; see -`image-specifier-p' for a description of the allowed values. - -DEST-TYPES should be a list of allowed image instance types that can -be generated. The recognized image instance types are - -'nothing - Nothing is displayed. -'text - Displayed as text. The foreground and background colors and the - font of the text are specified independent of the pixmap. Typically - these attributes will come from the face of the surrounding text, - unless a face is specified for the glyph in which the image appears. -'mono-pixmap - Displayed as a mono pixmap (a pixmap with only two colors where the - foreground and background can be specified independent of the pixmap; - typically the pixmap assumes the foreground and background colors of - the text around it, unless a face is specified for the glyph in which - the image appears). -'color-pixmap - Displayed as a color pixmap. -'pointer - Used as the mouse pointer for a window. -'subwindow - A child window that is treated as an image. This allows (e.g.) - another program to be responsible for drawing into the window. - Not currently implemented. - -The DEST-TYPES list is unordered. If multiple destination types -are possible for a given instantiator, the "most natural" type -for the instantiator's format is chosen. (For XBM, the most natural -types are `mono-pixmap', followed by `color-pixmap', followed by -`pointer'. For the other normal image formats, the most natural -types are `color-pixmap', followed by `mono-pixmap', followed by -`pointer'. For the string and formatted-string formats, the most -natural types are `text', followed by `mono-pixmap' (not currently -implemented), followed by `color-pixmap' (not currently implemented). -The other formats can only be instantiated as one type. (If you -want to control more specifically the order of the types into which -an image is instantiated, just call `make-image-instance' repeatedly -until it succeeds, passing less and less preferred destination types -each time. - -If DEST-TYPES is omitted, all possible types are allowed. - -NO-ERROR controls what happens when the image cannot be generated. -If nil, an error message is generated. If t, no messages are -generated and this function returns nil. If anything else, a warning -message is generated and this function returns nil. -*/ - (data, device, dest_types, no_error)) -{ - Error_behavior errb = decode_error_behavior_flag (no_error); - - return call_with_suspended_errors ((lisp_fn_t) make_image_instance_1, - Qnil, Qimage, errb, - 3, data, device, dest_types); -} - -DEFUN ("image-instance-p", Fimage_instance_p, 1, 1, 0, /* -Return non-nil if OBJECT is an image instance. -*/ - (object)) -{ - return IMAGE_INSTANCEP (object) ? Qt : Qnil; -} - -DEFUN ("image-instance-type", Fimage_instance_type, 1, 1, 0, /* -Return the type of the given image instance. -The return value will be one of 'nothing, 'text, 'mono-pixmap, -'color-pixmap, 'pointer, or 'subwindow. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - return encode_image_instance_type (XIMAGE_INSTANCE_TYPE (image_instance)); -} - -DEFUN ("image-instance-name", Fimage_instance_name, 1, 1, 0, /* -Return the name of the given image instance. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - return XIMAGE_INSTANCE_NAME (image_instance); -} - -DEFUN ("image-instance-string", Fimage_instance_string, 1, 1, 0, /* -Return the string of the given image instance. -This will only be non-nil for text image instances and widgets. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_TEXT) - return XIMAGE_INSTANCE_TEXT_STRING (image_instance); - else if (XIMAGE_INSTANCE_TYPE (image_instance) == IMAGE_WIDGET) - return XIMAGE_INSTANCE_WIDGET_TEXT (image_instance); - else - return Qnil; -} - -DEFUN ("image-instance-property", Fimage_instance_property, 2, 2, 0, /* -Return the given property of the given image instance. -Returns nil if the property or the property method do not exist for -the image instance in the domain. -*/ - (image_instance, prop)) -{ - struct Lisp_Image_Instance* ii; - Lisp_Object type, ret; - struct image_instantiator_methods* meths; - - CHECK_IMAGE_INSTANCE (image_instance); - CHECK_SYMBOL (prop); - ii = XIMAGE_INSTANCE (image_instance); - - /* ... then try device specific methods ... */ - type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), - type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, property) - && - !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) - { - return ret; - } - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, property) - && - !UNBOUNDP (ret = IIFORMAT_METH (meths, property, (image_instance, prop)))) - { - return ret; - } - /* ... then fail */ - return Qnil; -} - -DEFUN ("set-image-instance-property", Fset_image_instance_property, 3, 3, 0, /* -Set the given property of the given image instance. -Does nothing if the property or the property method do not exist for -the image instance in the domain. -*/ - (image_instance, prop, val)) -{ - struct Lisp_Image_Instance* ii; - Lisp_Object type, ret; - struct image_instantiator_methods* meths; - - CHECK_IMAGE_INSTANCE (image_instance); - CHECK_SYMBOL (prop); - ii = XIMAGE_INSTANCE (image_instance); - type = encode_image_instance_type (IMAGE_INSTANCE_TYPE (ii)); - /* try device specific methods first ... */ - meths = decode_device_ii_format (IMAGE_INSTANCE_DEVICE (ii), - type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } - /* ... then format specific methods ... */ - meths = decode_device_ii_format (Qnil, type, ERROR_ME_NOT); - if (meths && HAS_IIFORMAT_METH_P (meths, set_property) - && - !UNBOUNDP (ret = - IIFORMAT_METH (meths, set_property, (image_instance, prop, val)))) - { - return ret; - } - - return val; -} - -DEFUN ("image-instance-file-name", Fimage_instance_file_name, 1, 1, 0, /* -Return the file name from which IMAGE-INSTANCE was read, if known. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_FILENAME (image_instance); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-mask-file-name", Fimage_instance_mask_file_name, 1, 1, 0, /* -Return the file name from which IMAGE-INSTANCE's mask was read, if known. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME (image_instance); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-depth", Fimage_instance_depth, 1, 1, 0, /* -Return the depth of the image instance. -This is 0 for a bitmap, or a positive integer for a pixmap. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return make_int (XIMAGE_INSTANCE_PIXMAP_DEPTH (image_instance)); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-height", Fimage_instance_height, 1, 1, 0, /* -Return the height of the image instance, in pixels. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return make_int (XIMAGE_INSTANCE_PIXMAP_HEIGHT (image_instance)); - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - return make_int (XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (image_instance)); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-width", Fimage_instance_width, 1, 1, 0, /* -Return the width of the image instance, in pixels. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return make_int (XIMAGE_INSTANCE_PIXMAP_WIDTH (image_instance)); - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - return make_int (XIMAGE_INSTANCE_SUBWINDOW_WIDTH (image_instance)); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-hotspot-x", Fimage_instance_hotspot_x, 1, 1, 0, /* -Return the X coordinate of the image instance's hotspot, if known. -This is a point relative to the origin of the pixmap. When an image is - used as a mouse pointer, the hotspot is the point on the image that sits - over the location that the pointer points to. This is, for example, the - tip of the arrow or the center of the crosshairs. -This will always be nil for a non-pointer image instance. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X (image_instance); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-hotspot-y", Fimage_instance_hotspot_y, 1, 1, 0, /* -Return the Y coordinate of the image instance's hotspot, if known. -This is a point relative to the origin of the pixmap. When an image is - used as a mouse pointer, the hotspot is the point on the image that sits - over the location that the pointer points to. This is, for example, the - tip of the arrow or the center of the crosshairs. -This will always be nil for a non-pointer image instance. -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (image_instance); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-foreground", Fimage_instance_foreground, 1, 1, 0, /* -Return the foreground color of IMAGE-INSTANCE, if applicable. -This will be a color instance or nil. (It will only be non-nil for -colorized mono pixmaps and for pointers.) -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_FG (image_instance); - - case IMAGE_WIDGET: - return FACE_FOREGROUND ( - XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME - (image_instance)); - - default: - return Qnil; - } -} - -DEFUN ("image-instance-background", Fimage_instance_background, 1, 1, 0, /* -Return the background color of IMAGE-INSTANCE, if applicable. -This will be a color instance or nil. (It will only be non-nil for -colorized mono pixmaps and for pointers.) -*/ - (image_instance)) -{ - CHECK_IMAGE_INSTANCE (image_instance); - - switch (XIMAGE_INSTANCE_TYPE (image_instance)) - { - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_BG (image_instance); - - case IMAGE_WIDGET: - return FACE_BACKGROUND ( - XIMAGE_INSTANCE_WIDGET_FACE (image_instance), - XIMAGE_INSTANCE_SUBWINDOW_FRAME - (image_instance)); - - default: - return Qnil; - } -} - - -DEFUN ("colorize-image-instance", Fcolorize_image_instance, 3, 3, 0, /* -Make the image instance be displayed in the given colors. -This function returns a new image instance that is exactly like the -specified one except that (if possible) the foreground and background -colors and as specified. Currently, this only does anything if the image -instance is a mono pixmap; otherwise, the same image instance is returned. -*/ - (image_instance, foreground, background)) -{ - Lisp_Object new; - Lisp_Object device; - - CHECK_IMAGE_INSTANCE (image_instance); - CHECK_COLOR_INSTANCE (foreground); - CHECK_COLOR_INSTANCE (background); - - device = XIMAGE_INSTANCE_DEVICE (image_instance); - if (!HAS_DEVMETH_P (XDEVICE (device), colorize_image_instance)) - return image_instance; - - new = allocate_image_instance (device); - copy_lcrecord (XIMAGE_INSTANCE (new), XIMAGE_INSTANCE (image_instance)); - /* note that if this method returns non-zero, this method MUST - copy any window-system resources, so that when one image instance is - freed, the other one is not hosed. */ - if (!DEVMETH (XDEVICE (device), colorize_image_instance, (new, foreground, - background))) - return image_instance; - return new; -} - - -/************************************************************************/ -/* error helpers */ -/************************************************************************/ -DOESNT_RETURN -signal_image_error (CONST char *reason, Lisp_Object frob) -{ - signal_error (Qimage_conversion_error, - list2 (build_translated_string (reason), frob)); -} - -DOESNT_RETURN -signal_image_error_2 (CONST char *reason, Lisp_Object frob0, Lisp_Object frob1) -{ - signal_error (Qimage_conversion_error, - list3 (build_translated_string (reason), frob0, frob1)); -} - -/**************************************************************************** - * nothing * - ****************************************************************************/ - -static int -nothing_possible_dest_types (void) -{ - return IMAGE_NOTHING_MASK; -} - -static void -nothing_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - if (dest_mask & IMAGE_NOTHING_MASK) - IMAGE_INSTANCE_TYPE (ii) = IMAGE_NOTHING; - else - incompatible_image_types (instantiator, dest_mask, IMAGE_NOTHING_MASK); -} - - -/**************************************************************************** - * inherit * - ****************************************************************************/ - -static void -inherit_validate (Lisp_Object instantiator) -{ - face_must_be_present (instantiator); -} - -static Lisp_Object -inherit_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - Lisp_Object face; - - assert (XVECTOR_LENGTH (inst) == 3); - face = XVECTOR_DATA (inst)[2]; - if (!FACEP (face)) - inst = vector3 (Qinherit, Q_face, Fget_face (face)); - return inst; -} - -static int -inherit_possible_dest_types (void) -{ - return IMAGE_MONO_PIXMAP_MASK; -} - -static void -inherit_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - /* handled specially in image_instantiate */ - abort (); -} - - -/**************************************************************************** - * string * - ****************************************************************************/ - -static void -string_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -static int -string_possible_dest_types (void) -{ - return IMAGE_TEXT_MASK; -} - -/* called from autodetect_instantiate() */ -void -string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - assert (!NILP (data)); - if (dest_mask & IMAGE_TEXT_MASK) - { - IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; - IMAGE_INSTANCE_TEXT_STRING (ii) = data; - } - else - incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); -} - - -/**************************************************************************** - * formatted-string * - ****************************************************************************/ - -static void -formatted_string_validate (Lisp_Object instantiator) -{ - data_must_be_present (instantiator); -} - -static int -formatted_string_possible_dest_types (void) -{ - return IMAGE_TEXT_MASK; -} - -static void -formatted_string_instantiate (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - Lisp_Object data = find_keyword_in_vector (instantiator, Q_data); - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - - assert (!NILP (data)); - /* #### implement this */ - warn_when_safe (Qunimplemented, Qnotice, - "`formatted-string' not yet implemented; assuming `string'"); - if (dest_mask & IMAGE_TEXT_MASK) - { - IMAGE_INSTANCE_TYPE (ii) = IMAGE_TEXT; - IMAGE_INSTANCE_TEXT_STRING (ii) = data; - } - else - incompatible_image_types (instantiator, dest_mask, IMAGE_TEXT_MASK); -} - - -/************************************************************************/ -/* pixmap file functions */ -/************************************************************************/ - -/* If INSTANTIATOR refers to inline data, return Qnil. - If INSTANTIATOR refers to data in a file, return the full filename - if it exists; otherwise, return a cons of (filename). - - FILE_KEYWORD and DATA_KEYWORD are symbols specifying the - keywords used to look up the file and inline data, - respectively, in the instantiator. Normally these would - be Q_file and Q_data, but might be different for mask data. */ - -Lisp_Object -potential_pixmap_file_instantiator (Lisp_Object instantiator, - Lisp_Object file_keyword, - Lisp_Object data_keyword, - Lisp_Object console_type) -{ - Lisp_Object file; - Lisp_Object data; - - assert (VECTORP (instantiator)); - - data = find_keyword_in_vector (instantiator, data_keyword); - file = find_keyword_in_vector (instantiator, file_keyword); - - if (!NILP (file) && NILP (data)) - { - Lisp_Object retval = MAYBE_LISP_CONTYPE_METH - (decode_console_type(console_type, ERROR_ME), - locate_pixmap_file, (file)); - - if (!NILP (retval)) - return retval; - else - return Fcons (file, Qnil); /* should have been file */ - } - - return Qnil; -} - -Lisp_Object -simple_image_type_normalize (Lisp_Object inst, Lisp_Object console_type, - Lisp_Object image_type_tag) -{ - /* This function can call lisp */ - Lisp_Object file = Qnil; - struct gcpro gcpro1, gcpro2; - Lisp_Object alist = Qnil; - - GCPRO2 (file, alist); - - /* Now, convert any file data into inline data. At the end of this, - `data' will contain the inline data (if any) or Qnil, and `file' - will contain the name this data was derived from (if known) or - Qnil. - - Note that if we cannot generate any regular inline data, we - skip out. */ - - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, - console_type); - - if (CONSP (file)) /* failure locating filename */ - signal_double_file_error ("Opening pixmap file", - "no such file or directory", - Fcar (file)); - - if (NILP (file)) /* no conversion necessary */ - RETURN_UNGCPRO (inst); - - alist = tagged_vector_to_alist (inst); - - { - Lisp_Object data = make_string_from_file (file); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - } - - { - Lisp_Object result = alist_to_tagged_vector (image_type_tag, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - - -#ifdef HAVE_WINDOW_SYSTEM -/********************************************************************** - * XBM * - **********************************************************************/ - -/* Check if DATA represents a valid inline XBM spec (i.e. a list - of (width height bits), with checking done on the dimensions). - If not, signal an error. */ - -static void -check_valid_xbm_inline (Lisp_Object data) -{ - Lisp_Object width, height, bits; - - if (!CONSP (data) || - !CONSP (XCDR (data)) || - !CONSP (XCDR (XCDR (data))) || - !NILP (XCDR (XCDR (XCDR (data))))) - signal_simple_error ("Must be list of 3 elements", data); - - width = XCAR (data); - height = XCAR (XCDR (data)); - bits = XCAR (XCDR (XCDR (data))); - - CHECK_STRING (bits); - - if (!NATNUMP (width)) - signal_simple_error ("Width must be a natural number", width); - - if (!NATNUMP (height)) - signal_simple_error ("Height must be a natural number", height); - - if (((XINT (width) * XINT (height)) / 8) > XSTRING_CHAR_LENGTH (bits)) - signal_simple_error ("data is too short for width and height", - vector3 (width, height, bits)); -} - -/* Validate method for XBM's. */ - -static void -xbm_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -/* Given a filename that is supposed to contain XBM data, return - the inline representation of it as (width height bits). Return - the hotspot through XHOT and YHOT, if those pointers are not 0. - If there is no hotspot, XHOT and YHOT will contain -1. - - If the function fails: - - -- if OK_IF_DATA_INVALID is set and the data was invalid, - return Qt. - -- maybe return an error, or return Qnil. - */ - -#ifdef HAVE_X_WINDOWS -#include -#else -#define XFree(data) free(data) -#endif - -Lisp_Object -bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, - int ok_if_data_invalid) -{ - unsigned int w, h; - Extbyte *data; - int result; - CONST char *filename_ext; - - GET_C_STRING_FILENAME_DATA_ALLOCA (name, filename_ext); - result = read_bitmap_data_from_file (filename_ext, &w, &h, - &data, xhot, yhot); - - if (result == BitmapSuccess) - { - Lisp_Object retval; - int len = (w + 7) / 8 * h; - - retval = list3 (make_int (w), make_int (h), - make_ext_string (data, len, FORMAT_BINARY)); - XFree ((char *) data); - return retval; - } - - switch (result) - { - case BitmapOpenFailed: - { - /* should never happen */ - signal_double_file_error ("Opening bitmap file", - "no such file or directory", - name); - } - case BitmapFileInvalid: - { - if (ok_if_data_invalid) - return Qt; - signal_double_file_error ("Reading bitmap file", - "invalid data in file", - name); - } - case BitmapNoMemory: - { - signal_double_file_error ("Reading bitmap file", - "out of memory", - name); - } - default: - { - signal_double_file_error_2 ("Reading bitmap file", - "unknown error code", - make_int (result), name); - } - } - - return Qnil; /* not reached */ -} - -Lisp_Object -xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, - Lisp_Object mask_file, Lisp_Object console_type) -{ - /* This is unclean but it's fairly standard -- a number of the - bitmaps in /usr/include/X11/bitmaps use it -- so we support - it. */ - if (NILP (mask_file) - /* don't override explicitly specified mask data. */ - && NILP (assq_no_quit (Q_mask_data, alist)) - && !NILP (file)) - { - mask_file = MAYBE_LISP_CONTYPE_METH - (decode_console_type(console_type, ERROR_ME), - locate_pixmap_file, (concat2 (file, build_string ("Mask")))); - if (NILP (mask_file)) - mask_file = MAYBE_LISP_CONTYPE_METH - (decode_console_type(console_type, ERROR_ME), - locate_pixmap_file, (concat2 (file, build_string ("msk")))); - } - - if (!NILP (mask_file)) - { - Lisp_Object mask_data = - bitmap_to_lisp_data (mask_file, 0, 0, 0); - alist = remassq_no_quit (Q_mask_file, alist); - /* there can't be a :mask-data at this point. */ - alist = Fcons (Fcons (Q_mask_file, mask_file), - Fcons (Fcons (Q_mask_data, mask_data), alist)); - } - - return alist; -} - -/* Normalize method for XBM's. */ - -static Lisp_Object -xbm_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - Lisp_Object file = Qnil, mask_file = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; - - GCPRO3 (file, mask_file, alist); - - /* Now, convert any file data into inline data for both the regular - data and the mask data. At the end of this, `data' will contain - the inline data (if any) or Qnil, and `file' will contain - the name this data was derived from (if known) or Qnil. - Likewise for `mask_file' and `mask_data'. - - Note that if we cannot generate any regular inline data, we - skip out. */ - - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, - console_type); - mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, - Q_mask_data, console_type); - - if (CONSP (file)) /* failure locating filename */ - signal_double_file_error ("Opening bitmap file", - "no such file or directory", - Fcar (file)); - - if (NILP (file) && NILP (mask_file)) /* no conversion necessary */ - RETURN_UNGCPRO (inst); - - alist = tagged_vector_to_alist (inst); - - if (!NILP (file)) - { - int xhot, yhot; - Lisp_Object data = bitmap_to_lisp_data (file, &xhot, &yhot, 0); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - - if (xhot != -1 && NILP (assq_no_quit (Q_hotspot_x, alist))) - alist = Fcons (Fcons (Q_hotspot_x, make_int (xhot)), - alist); - if (yhot != -1 && NILP (assq_no_quit (Q_hotspot_y, alist))) - alist = Fcons (Fcons (Q_hotspot_y, make_int (yhot)), - alist); - } - - alist = xbm_mask_file_munging (alist, file, mask_file, console_type); - - { - Lisp_Object result = alist_to_tagged_vector (Qxbm, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - - -static int -xbm_possible_dest_types (void) -{ - return - IMAGE_MONO_PIXMAP_MASK | - IMAGE_COLOR_PIXMAP_MASK | - IMAGE_POINTER_MASK; -} - -#endif - - -#ifdef HAVE_XFACE -/********************************************************************** - * X-Face * - **********************************************************************/ - -static void -xface_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -static Lisp_Object -xface_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - /* This function can call lisp */ - Lisp_Object file = Qnil, mask_file = Qnil; - struct gcpro gcpro1, gcpro2, gcpro3; - Lisp_Object alist = Qnil; - - GCPRO3 (file, mask_file, alist); - - /* Now, convert any file data into inline data for both the regular - data and the mask data. At the end of this, `data' will contain - the inline data (if any) or Qnil, and `file' will contain - the name this data was derived from (if known) or Qnil. - Likewise for `mask_file' and `mask_data'. - - Note that if we cannot generate any regular inline data, we - skip out. */ - - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, - console_type); - mask_file = potential_pixmap_file_instantiator (inst, Q_mask_file, - Q_mask_data, console_type); - - if (CONSP (file)) /* failure locating filename */ - signal_double_file_error ("Opening bitmap file", - "no such file or directory", - Fcar (file)); - - if (NILP (file) && NILP (mask_file)) /* no conversion necessary */ - RETURN_UNGCPRO (inst); - - alist = tagged_vector_to_alist (inst); - - { - Lisp_Object data = make_string_from_file (file); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - } - - alist = xbm_mask_file_munging (alist, file, mask_file, console_type); - - { - Lisp_Object result = alist_to_tagged_vector (Qxface, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - -static int -xface_possible_dest_types (void) -{ - return - IMAGE_MONO_PIXMAP_MASK | - IMAGE_COLOR_PIXMAP_MASK | - IMAGE_POINTER_MASK; -} - -#endif /* HAVE_XFACE */ - - -#ifdef HAVE_XPM - -/********************************************************************** - * XPM * - **********************************************************************/ - -Lisp_Object -pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid) -{ - char **data; - int result; - char *fname = 0; - - GET_C_STRING_FILENAME_DATA_ALLOCA (name, fname); - result = XpmReadFileToData (fname, &data); - - if (result == XpmSuccess) - { - Lisp_Object retval = Qnil; - struct buffer *old_buffer = current_buffer; - Lisp_Object temp_buffer = - Fget_buffer_create (build_string (" *pixmap conversion*")); - int elt; - int height, width, ncolors; - struct gcpro gcpro1, gcpro2, gcpro3; - int speccount = specpdl_depth (); - - GCPRO3 (name, retval, temp_buffer); - - specbind (Qinhibit_quit, Qt); - set_buffer_internal (XBUFFER (temp_buffer)); - Ferase_buffer (Qnil); - - buffer_insert_c_string (current_buffer, "/* XPM */\r"); - buffer_insert_c_string (current_buffer, "static char *pixmap[] = {\r"); - - sscanf (data[0], "%d %d %d", &height, &width, &ncolors); - for (elt = 0; elt <= width + ncolors; elt++) - { - buffer_insert_c_string (current_buffer, "\""); - buffer_insert_c_string (current_buffer, data[elt]); - - if (elt < width + ncolors) - buffer_insert_c_string (current_buffer, "\",\r"); - else - buffer_insert_c_string (current_buffer, "\"};\r"); - } - - retval = Fbuffer_substring (Qnil, Qnil, Qnil); - XpmFree (data); - - set_buffer_internal (old_buffer); - unbind_to (speccount, Qnil); - - RETURN_UNGCPRO (retval); - } - - switch (result) - { - case XpmFileInvalid: - { - if (ok_if_data_invalid) - return Qt; - signal_image_error ("invalid XPM data in file", name); - } - case XpmNoMemory: - { - signal_double_file_error ("Reading pixmap file", - "out of memory", name); - } - case XpmOpenFailed: - { - /* should never happen? */ - signal_double_file_error ("Opening pixmap file", - "no such file or directory", name); - } - default: - { - signal_double_file_error_2 ("Parsing pixmap file", - "unknown error code", - make_int (result), name); - break; - } - } - - return Qnil; /* not reached */ -} - -static void -check_valid_xpm_color_symbols (Lisp_Object data) -{ - Lisp_Object rest; - - for (rest = data; !NILP (rest); rest = XCDR (rest)) - { - if (!CONSP (rest) || - !CONSP (XCAR (rest)) || - !STRINGP (XCAR (XCAR (rest))) || - (!STRINGP (XCDR (XCAR (rest))) && - !COLOR_SPECIFIERP (XCDR (XCAR (rest))))) - signal_simple_error ("Invalid color symbol alist", data); - } -} - -static void -xpm_validate (Lisp_Object instantiator) -{ - file_or_data_must_be_present (instantiator); -} - -Lisp_Object Vxpm_color_symbols; - -Lisp_Object -evaluate_xpm_color_symbols (void) -{ - Lisp_Object rest, results = Qnil; - struct gcpro gcpro1, gcpro2; - - GCPRO2 (rest, results); - for (rest = Vxpm_color_symbols; !NILP (rest); rest = XCDR (rest)) - { - Lisp_Object name, value, cons; - - CHECK_CONS (rest); - cons = XCAR (rest); - CHECK_CONS (cons); - name = XCAR (cons); - CHECK_STRING (name); - value = XCDR (cons); - CHECK_CONS (value); - value = XCAR (value); - value = Feval (value); - if (NILP (value)) - continue; - if (!STRINGP (value) && !COLOR_SPECIFIERP (value)) - signal_simple_error - ("Result from xpm-color-symbols eval must be nil, string, or color", - value); - results = Fcons (Fcons (name, value), results); - } - UNGCPRO; /* no more evaluation */ - return results; -} - -static Lisp_Object -xpm_normalize (Lisp_Object inst, Lisp_Object console_type) -{ - Lisp_Object file = Qnil; - Lisp_Object color_symbols; - struct gcpro gcpro1, gcpro2; - Lisp_Object alist = Qnil; - - GCPRO2 (file, alist); - - /* Now, convert any file data into inline data. At the end of this, - `data' will contain the inline data (if any) or Qnil, and - `file' will contain the name this data was derived from (if - known) or Qnil. - - Note that if we cannot generate any regular inline data, we - skip out. */ - - file = potential_pixmap_file_instantiator (inst, Q_file, Q_data, - console_type); - - if (CONSP (file)) /* failure locating filename */ - signal_double_file_error ("Opening pixmap file", - "no such file or directory", - Fcar (file)); - - color_symbols = find_keyword_in_vector_or_given (inst, Q_color_symbols, - Qunbound); - - if (NILP (file) && !UNBOUNDP (color_symbols)) - /* no conversion necessary */ - RETURN_UNGCPRO (inst); - - alist = tagged_vector_to_alist (inst); - - if (!NILP (file)) - { - Lisp_Object data = pixmap_to_lisp_data (file, 0); - alist = remassq_no_quit (Q_file, alist); - /* there can't be a :data at this point. */ - alist = Fcons (Fcons (Q_file, file), - Fcons (Fcons (Q_data, data), alist)); - } - - if (UNBOUNDP (color_symbols)) - { - color_symbols = evaluate_xpm_color_symbols (); - alist = Fcons (Fcons (Q_color_symbols, color_symbols), - alist); - } - - { - Lisp_Object result = alist_to_tagged_vector (Qxpm, alist); - free_alist (alist); - RETURN_UNGCPRO (result); - } -} - -static int -xpm_possible_dest_types (void) -{ - return - IMAGE_MONO_PIXMAP_MASK | - IMAGE_COLOR_PIXMAP_MASK | - IMAGE_POINTER_MASK; -} - -#endif /* HAVE_XPM */ - - -/**************************************************************************** - * Image Specifier Object * - ****************************************************************************/ - -DEFINE_SPECIFIER_TYPE (image); - -static void -image_create (Lisp_Object obj) -{ - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); - - IMAGE_SPECIFIER_ALLOWED (image) = ~0; /* all are allowed */ - IMAGE_SPECIFIER_ATTACHEE (image) = Qnil; - IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = Qnil; -} - -static void -image_mark (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); - - markobj (IMAGE_SPECIFIER_ATTACHEE (image)); - markobj (IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image)); -} - -static Lisp_Object -image_instantiate_cache_result (Lisp_Object locative) -{ - /* locative = (instance instantiator . subtable) */ - Fputhash (XCAR (XCDR (locative)), XCAR (locative), XCDR (XCDR (locative))); - free_cons (XCONS (XCDR (locative))); - free_cons (XCONS (locative)); - return Qnil; -} - -/* Given a specification for an image, return an instance of - the image which matches the given instantiator and which can be - displayed in the given domain. */ - -static Lisp_Object -image_instantiate (Lisp_Object specifier, Lisp_Object matchspec, - Lisp_Object domain, Lisp_Object instantiator, - Lisp_Object depth) -{ - Lisp_Object device = DFW_DEVICE (domain); - struct device *d = XDEVICE (device); - int dest_mask = XIMAGE_SPECIFIER_ALLOWED (specifier); - int pointerp = dest_mask & image_instance_type_to_mask (IMAGE_POINTER); - - if (IMAGE_INSTANCEP (instantiator)) - { - /* make sure that the image instance's device and type are - matching. */ - - if (EQ (device, XIMAGE_INSTANCE_DEVICE (instantiator))) - { - int mask = - image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instantiator)); - if (mask & dest_mask) - return instantiator; - else - signal_simple_error ("Type of image instance not allowed here", - instantiator); - } - else - signal_simple_error_2 ("Wrong device for image instance", - instantiator, device); - } - else if (VECTORP (instantiator) - && EQ (XVECTOR_DATA (instantiator)[0], Qinherit)) - { - assert (XVECTOR_LENGTH (instantiator) == 3); - return (FACE_PROPERTY_INSTANCE - (Fget_face (XVECTOR_DATA (instantiator)[2]), - Qbackground_pixmap, domain, 0, depth)); - } - else - { - Lisp_Object instance; - Lisp_Object subtable; - Lisp_Object ls3 = Qnil; - Lisp_Object pointer_fg = Qnil; - Lisp_Object pointer_bg = Qnil; - - if (pointerp) - { - pointer_fg = FACE_FOREGROUND (Vpointer_face, domain); - pointer_bg = FACE_BACKGROUND (Vpointer_face, domain); - ls3 = list3 (instantiator, pointer_fg, pointer_bg); - } - - /* First look in the hash table. */ - subtable = Fgethash (make_int (dest_mask), d->image_instance_cache, - Qunbound); - if (UNBOUNDP (subtable)) - { - /* For the image instance cache, we do comparisons with EQ rather - than with EQUAL, as we do for color and font names. - The reasons are: - - 1) pixmap data can be very long, and thus the hashing and - comparing will take awhile. - 2) It's not so likely that we'll run into things that are EQUAL - but not EQ (that can happen a lot with faces, because their - specifiers are copied around); but pixmaps tend not to be - in faces. - - However, if the image-instance could be a pointer, we have to - use EQUAL because we massaged the instantiator into a cons3 - also containing the foreground and background of the - pointer face. - */ - - subtable = make_lisp_hash_table (20, - pointerp ? HASH_TABLE_KEY_CAR_WEAK - : HASH_TABLE_KEY_WEAK, - pointerp ? HASH_TABLE_EQUAL - : HASH_TABLE_EQ); - Fputhash (make_int (dest_mask), subtable, - d->image_instance_cache); - instance = Qunbound; - } - else - { - instance = Fgethash (pointerp ? ls3 : instantiator, - subtable, Qunbound); - /* subwindows have a per-window cache and have to be treated - differently. dest_mask can be a bitwise OR of all image - types so we will only catch someone possibly trying to - instantiate a subwindow type thing. Unfortunately, this - will occur most of the time so this probably slows things - down. But with the current design I don't see anyway - round it. */ - if (UNBOUNDP (instance) - && - dest_mask & (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - { - if (!WINDOWP (domain)) - signal_simple_error ("Can't instantiate subwindow outside a window", - instantiator); - instance = Fgethash (instantiator, - XWINDOW (domain)->subwindow_instance_cache, - Qunbound); - } - } - - if (UNBOUNDP (instance)) - { - Lisp_Object locative = - noseeum_cons (Qnil, - noseeum_cons (pointerp ? ls3 : instantiator, - subtable)); - int speccount = specpdl_depth (); - - /* make sure we cache the failures, too. - Use an unwind-protect to catch such errors. - If we fail, the unwind-protect records nil in - the hash table. If we succeed, we change the - car of the locative to the resulting instance, - which gets recorded instead. */ - record_unwind_protect (image_instantiate_cache_result, - locative); - instance = instantiate_image_instantiator (device, - domain, - instantiator, - pointer_fg, pointer_bg, - dest_mask); - - Fsetcar (locative, instance); - /* only after the image has been instantiated do we know - whether we need to put it in the per-window image instance - cache. */ - if (image_instance_type_to_mask (XIMAGE_INSTANCE_TYPE (instance)) - & - (IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK)) - { - if (!WINDOWP (domain)) - signal_simple_error ("Can't instantiate subwindow outside a window", - instantiator); - - Fsetcdr (XCDR (locative), XWINDOW (domain)->subwindow_instance_cache ); - } - unbind_to (speccount, Qnil); - } - else - free_list (ls3); - - if (NILP (instance)) - signal_simple_error ("Can't instantiate image (probably cached)", - instantiator); - return instance; - } - - abort (); - return Qnil; /* not reached */ -} - -/* Validate an image instantiator. */ - -static void -image_validate (Lisp_Object instantiator) -{ - if (IMAGE_INSTANCEP (instantiator) || STRINGP (instantiator)) - return; - else if (VECTORP (instantiator)) - { - Lisp_Object *elt = XVECTOR_DATA (instantiator); - int instantiator_len = XVECTOR_LENGTH (instantiator); - struct image_instantiator_methods *meths; - Lisp_Object already_seen = Qnil; - struct gcpro gcpro1; - int i; - - if (instantiator_len < 1) - signal_simple_error ("Vector length must be at least 1", - instantiator); - - meths = decode_image_instantiator_format (elt[0], ERROR_ME); - if (!(instantiator_len & 1)) - signal_simple_error - ("Must have alternating keyword/value pairs", instantiator); - - GCPRO1 (already_seen); - - for (i = 1; i < instantiator_len; i += 2) - { - Lisp_Object keyword = elt[i]; - Lisp_Object value = elt[i+1]; - int j; - - CHECK_SYMBOL (keyword); - if (!SYMBOL_IS_KEYWORD (keyword)) - signal_simple_error ("Symbol must begin with a colon", keyword); - - for (j = 0; j < Dynarr_length (meths->keywords); j++) - if (EQ (keyword, Dynarr_at (meths->keywords, j).keyword)) - break; - - if (j == Dynarr_length (meths->keywords)) - signal_simple_error ("Unrecognized keyword", keyword); - - if (!Dynarr_at (meths->keywords, j).multiple_p) - { - if (!NILP (memq_no_quit (keyword, already_seen))) - signal_simple_error - ("Keyword may not appear more than once", keyword); - already_seen = Fcons (keyword, already_seen); - } - - (Dynarr_at (meths->keywords, j).validate) (value); - } - - UNGCPRO; - - MAYBE_IIFORMAT_METH (meths, validate, (instantiator)); - } - else - signal_simple_error ("Must be string or vector", instantiator); -} - -static void -image_after_change (Lisp_Object specifier, Lisp_Object locale) -{ - Lisp_Object attachee = - IMAGE_SPECIFIER_ATTACHEE (XIMAGE_SPECIFIER (specifier)); - Lisp_Object property = - IMAGE_SPECIFIER_ATTACHEE_PROPERTY (XIMAGE_SPECIFIER (specifier)); - if (FACEP (attachee)) - face_property_was_changed (attachee, property, locale); - else if (GLYPHP (attachee)) - glyph_property_was_changed (attachee, property, locale); -} - -void -set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, - Lisp_Object property) -{ - struct Lisp_Specifier *image = XIMAGE_SPECIFIER (obj); - - IMAGE_SPECIFIER_ATTACHEE (image) = face_or_glyph; - IMAGE_SPECIFIER_ATTACHEE_PROPERTY (image) = property; -} - -static Lisp_Object -image_going_to_add (Lisp_Object specifier, Lisp_Object locale, - Lisp_Object tag_set, Lisp_Object instantiator) -{ - Lisp_Object possible_console_types = Qnil; - Lisp_Object rest; - Lisp_Object retlist = Qnil; - struct gcpro gcpro1, gcpro2; - - LIST_LOOP (rest, Vconsole_type_list) - { - Lisp_Object contype = XCAR (rest); - if (!NILP (memq_no_quit (contype, tag_set))) - possible_console_types = Fcons (contype, possible_console_types); - } - - if (XINT (Flength (possible_console_types)) > 1) - /* two conflicting console types specified */ - return Qnil; - - if (NILP (possible_console_types)) - possible_console_types = Vconsole_type_list; - - GCPRO2 (retlist, possible_console_types); - - LIST_LOOP (rest, possible_console_types) - { - Lisp_Object contype = XCAR (rest); - Lisp_Object newinst = call_with_suspended_errors - ((lisp_fn_t) normalize_image_instantiator, - Qnil, Qimage, ERROR_ME_NOT, 3, instantiator, contype, - make_int (XIMAGE_SPECIFIER_ALLOWED (specifier))); - - if (!NILP (newinst)) - { - Lisp_Object newtag; - if (NILP (memq_no_quit (contype, tag_set))) - newtag = Fcons (contype, tag_set); - else - newtag = tag_set; - retlist = Fcons (Fcons (newtag, newinst), retlist); - } - } - - UNGCPRO; - - return retlist; -} - -DEFUN ("image-specifier-p", Fimage_specifier_p, 1, 1, 0, /* -Return non-nil if OBJECT is an image specifier. - -An image specifier is used for images (pixmaps and the like). It is used -to describe the actual image in a glyph. It is instanced as an image- -instance. - -Image instantiators come in many formats: `xbm', `xpm', `gif', `jpeg', -etc. This describes the format of the data describing the image. The -resulting image instances also come in many types -- `mono-pixmap', -`color-pixmap', `text', `pointer', etc. This refers to the behavior of -the image and the sorts of places it can appear. (For example, a -color-pixmap image has fixed colors specified for it, while a -mono-pixmap image comes in two unspecified shades "foreground" and -"background" that are determined from the face of the glyph or -surrounding text; a text image appears as a string of text and has an -unspecified foreground, background, and font; a pointer image behaves -like a mono-pixmap image but can only be used as a mouse pointer -\[mono-pixmap images cannot be used as mouse pointers]; etc.) It is -important to keep the distinction between image instantiator format and -image instance type in mind. Typically, a given image instantiator -format can result in many different image instance types (for example, -`xpm' can be instanced as `color-pixmap', `mono-pixmap', or `pointer'; -whereas `cursor-font' can be instanced only as `pointer'), and a -particular image instance type can be generated by many different -image instantiator formats (e.g. `color-pixmap' can be generated by `xpm', -`gif', `jpeg', etc.). - -See `make-image-instance' for a more detailed discussion of image -instance types. - -An image instantiator should be a string or a vector of the form - - [FORMAT :KEYWORD VALUE ...] - -i.e. a format symbol followed by zero or more alternating keyword-value -pairs. FORMAT should be one of - -'nothing - (Don't display anything; no keywords are valid for this. - Can only be instanced as `nothing'.) -'string - (Display this image as a text string. Can only be instanced - as `text', although support for instancing as `mono-pixmap' - should be added.) -'formatted-string - (Display this image as a text string, with replaceable fields; - not currently implemented.) -'xbm - (An X bitmap; only if X or Windows support was compiled into this XEmacs. - Can be instanced as `mono-pixmap', `color-pixmap', or `pointer'.) -'xpm - (An XPM pixmap; only if XPM support was compiled into this XEmacs. - Can be instanced as `color-pixmap', `mono-pixmap', or `pointer'.) -'xface - (An X-Face bitmap, used to encode people's faces in e-mail messages; - only if X-Face support was compiled into this XEmacs. Can be - instanced as `mono-pixmap', `color-pixmap', or `pointer'.) -'gif - (A GIF87 or GIF89 image; only if GIF support was compiled into this - XEmacs. NOTE: only the first frame of animated gifs will be displayed. - Can be instanced as `color-pixmap'.) -'jpeg - (A JPEG image; only if JPEG support was compiled into this XEmacs. - Can be instanced as `color-pixmap'.) -'png - (A PNG image; only if PNG support was compiled into this XEmacs. - Can be instanced as `color-pixmap'.) -'tiff - (A TIFF image; only if TIFF support was compiled into this XEmacs. - Can be instanced as `color-pixmap'.) -'cursor-font - (One of the standard cursor-font names, such as "watch" or - "right_ptr" under X. Under X, this is, more specifically, any - of the standard cursor names from appendix B of the Xlib manual - [also known as the file ] minus the XC_ prefix. - On other window systems, the valid names will be specific to the - type of window system. Can only be instanced as `pointer'.) -'font - (A glyph from a font; i.e. the name of a font, and glyph index into it - of the form "FONT fontname index [[mask-font] mask-index]". - Currently can only be instanced as `pointer', although this should - probably be fixed.) -'subwindow - (An embedded X window; not currently implemented.) -'widget - (A widget control, for instance text field or radio button.) -'autodetect - (XEmacs tries to guess what format the data is in. If X support - exists, the data string will be checked to see if it names a filename. - If so, and this filename contains XBM or XPM data, the appropriate - sort of pixmap or pointer will be created. [This includes picking up - any specified hotspot or associated mask file.] Otherwise, if `pointer' - is one of the allowable image-instance types and the string names a - valid cursor-font name, the image will be created as a pointer. - Otherwise, the image will be displayed as text. If no X support - exists, the image will always be displayed as text.) -'inherit - Inherit from the background-pixmap property of a face. - -The valid keywords are: - -:data - (Inline data. For most formats above, this should be a string. For - XBM images, this should be a list of three elements: width, height, and - a string of bit data. This keyword is not valid for instantiator - formats `nothing' and `inherit'.) -:file - (Data is contained in a file. The value is the name of this file. - If both :data and :file are specified, the image is created from - what is specified in :data and the string in :file becomes the - value of the `image-instance-file-name' function when applied to - the resulting image-instance. This keyword is not valid for - instantiator formats `nothing', `string', `formatted-string', - `cursor-font', `font', `autodetect', and `inherit'.) -:foreground -:background - (For `xbm', `xface', `cursor-font', `widget' and `font'. These keywords - allow you to explicitly specify foreground and background colors. - The argument should be anything acceptable to `make-color-instance'. - This will cause what would be a `mono-pixmap' to instead be colorized - as a two-color color-pixmap, and specifies the foreground and/or - background colors for a pointer instead of black and white.) -:mask-data - (For `xbm' and `xface'. This specifies a mask to be used with the - bitmap. The format is a list of width, height, and bits, like for - :data.) -:mask-file - (For `xbm' and `xface'. This specifies a file containing the mask data. - If neither a mask file nor inline mask data is given for an XBM image, - and the XBM image comes from a file, XEmacs will look for a mask file - with the same name as the image file but with "Mask" or "msk" - appended. For example, if you specify the XBM file "left_ptr" - [usually located in "/usr/include/X11/bitmaps"], the associated - mask file "left_ptrmsk" will automatically be picked up.) -:hotspot-x -:hotspot-y - (For `xbm' and `xface'. These keywords specify a hotspot if the image - is instantiated as a `pointer'. Note that if the XBM image file - specifies a hotspot, it will automatically be picked up if no - explicit hotspot is given.) -:color-symbols - (Only for `xpm'. This specifies an alist that maps strings - that specify symbolic color names to the actual color to be used - for that symbolic color (in the form of a string or a color-specifier - object). If this is not specified, the contents of `xpm-color-symbols' - are used to generate the alist.) -:face - (Only for `inherit'. This specifies the face to inherit from.) - -If instead of a vector, the instantiator is a string, it will be -converted into a vector by looking it up according to the specs in the -`console-type-image-conversion-list' (q.v.) for the console type of -the domain (usually a window; sometimes a frame or device) over which -the image is being instantiated. - -If the instantiator specifies data from a file, the data will be read -in at the time that the instantiator is added to the image (which may -be well before when the image is actually displayed), and the -instantiator will be converted into one of the inline-data forms, with -the filename retained using a :file keyword. This implies that the -file must exist when the instantiator is added to the image, but does -not need to exist at any other time (e.g. it may safely be a temporary -file). -*/ - (object)) -{ - return IMAGE_SPECIFIERP (object) ? Qt : Qnil; -} - - -/**************************************************************************** - * Glyph Object * - ****************************************************************************/ - -static Lisp_Object -mark_glyph (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct Lisp_Glyph *glyph = XGLYPH (obj); - - markobj (glyph->image); - markobj (glyph->contrib_p); - markobj (glyph->baseline); - markobj (glyph->face); - - return glyph->plist; -} - -static void -print_glyph (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) -{ - struct Lisp_Glyph *glyph = XGLYPH (obj); - char buf[20]; - - if (print_readably) - error ("printing unreadable object #", glyph->header.uid); - - write_c_string ("#image, printcharfun, 1); - sprintf (buf, "0x%x>", glyph->header.uid); - write_c_string (buf, printcharfun); -} - -/* Glyphs are equal if all of their display attributes are equal. We - don't compare names or doc-strings, because that would make equal - be eq. - - This isn't concerned with "unspecified" attributes, that's what - #'glyph-differs-from-default-p is for. */ -static int -glyph_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) -{ - struct Lisp_Glyph *g1 = XGLYPH (obj1); - struct Lisp_Glyph *g2 = XGLYPH (obj2); - - depth++; - - return (internal_equal (g1->image, g2->image, depth) && - internal_equal (g1->contrib_p, g2->contrib_p, depth) && - internal_equal (g1->baseline, g2->baseline, depth) && - internal_equal (g1->face, g2->face, depth) && - !plists_differ (g1->plist, g2->plist, 0, 0, depth + 1)); -} - -static unsigned long -glyph_hash (Lisp_Object obj, int depth) -{ - depth++; - - /* No need to hash all of the elements; that would take too long. - Just hash the most common ones. */ - return HASH2 (internal_hash (XGLYPH (obj)->image, depth), - internal_hash (XGLYPH (obj)->face, depth)); -} - -static Lisp_Object -glyph_getprop (Lisp_Object obj, Lisp_Object prop) -{ - struct Lisp_Glyph *g = XGLYPH (obj); - - if (EQ (prop, Qimage)) return g->image; - if (EQ (prop, Qcontrib_p)) return g->contrib_p; - if (EQ (prop, Qbaseline)) return g->baseline; - if (EQ (prop, Qface)) return g->face; - - return external_plist_get (&g->plist, prop, 0, ERROR_ME); -} - -static int -glyph_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value) -{ - if ((EQ (prop, Qimage)) || - (EQ (prop, Qcontrib_p)) || - (EQ (prop, Qbaseline))) - return 0; - - if (EQ (prop, Qface)) - { - XGLYPH (obj)->face = Fget_face (value); - return 1; - } - - external_plist_put (&XGLYPH (obj)->plist, prop, value, 0, ERROR_ME); - return 1; -} - -static int -glyph_remprop (Lisp_Object obj, Lisp_Object prop) -{ - if ((EQ (prop, Qimage)) || - (EQ (prop, Qcontrib_p)) || - (EQ (prop, Qbaseline))) - return -1; - - if (EQ (prop, Qface)) - { - XGLYPH (obj)->face = Qnil; - return 1; - } - - return external_remprop (&XGLYPH (obj)->plist, prop, 0, ERROR_ME); -} - -static Lisp_Object -glyph_plist (Lisp_Object obj) -{ - struct Lisp_Glyph *glyph = XGLYPH (obj); - Lisp_Object result = glyph->plist; - - result = cons3 (Qface, glyph->face, result); - result = cons3 (Qbaseline, glyph->baseline, result); - result = cons3 (Qcontrib_p, glyph->contrib_p, result); - result = cons3 (Qimage, glyph->image, result); - - return result; -} - -DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("glyph", glyph, - mark_glyph, print_glyph, 0, - glyph_equal, glyph_hash, - glyph_getprop, glyph_putprop, - glyph_remprop, glyph_plist, - struct Lisp_Glyph); - -Lisp_Object -allocate_glyph (enum glyph_type type, - void (*after_change) (Lisp_Object glyph, Lisp_Object property, - Lisp_Object locale)) -{ - /* This function can GC */ - Lisp_Object obj = Qnil; - struct Lisp_Glyph *g = - alloc_lcrecord_type (struct Lisp_Glyph, lrecord_glyph); - - g->type = type; - g->image = Fmake_specifier (Qimage); /* This function can GC */ - switch (g->type) - { - case GLYPH_BUFFER: - XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_TEXT_MASK - | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK - | IMAGE_SUBWINDOW_MASK | IMAGE_WIDGET_MASK; - break; - case GLYPH_POINTER: - XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_POINTER_MASK; - break; - case GLYPH_ICON: - XIMAGE_SPECIFIER_ALLOWED (g->image) = - IMAGE_NOTHING_MASK | IMAGE_MONO_PIXMAP_MASK | IMAGE_COLOR_PIXMAP_MASK; - break; - default: - abort (); - } - - /* I think Fmake_specifier can GC. I think set_specifier_fallback can GC. */ - /* We're getting enough reports of odd behavior in this area it seems */ - /* best to GCPRO everything. */ - { - Lisp_Object tem1 = list1 (Fcons (Qnil, Vthe_nothing_vector)); - Lisp_Object tem2 = list1 (Fcons (Qnil, Qt)); - Lisp_Object tem3 = list1 (Fcons (Qnil, Qnil)); - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - GCPRO4 (obj, tem1, tem2, tem3); - - set_specifier_fallback (g->image, tem1); - g->contrib_p = Fmake_specifier (Qboolean); - set_specifier_fallback (g->contrib_p, tem2); - /* #### should have a specifier for the following */ - g->baseline = Fmake_specifier (Qgeneric); - set_specifier_fallback (g->baseline, tem3); - g->face = Qnil; - g->plist = Qnil; - g->after_change = after_change; - XSETGLYPH (obj, g); - - set_image_attached_to (g->image, obj, Qimage); - UNGCPRO; - } - - return obj; -} - -static enum glyph_type -decode_glyph_type (Lisp_Object type, Error_behavior errb) -{ - if (NILP (type)) - return GLYPH_BUFFER; - - if (ERRB_EQ (errb, ERROR_ME)) - CHECK_SYMBOL (type); - - if (EQ (type, Qbuffer)) return GLYPH_BUFFER; - if (EQ (type, Qpointer)) return GLYPH_POINTER; - if (EQ (type, Qicon)) return GLYPH_ICON; - - maybe_signal_simple_error ("Invalid glyph type", type, Qimage, errb); - - return GLYPH_UNKNOWN; -} - -static int -valid_glyph_type_p (Lisp_Object type) -{ - return !NILP (memq_no_quit (type, Vglyph_type_list)); -} - -DEFUN ("valid-glyph-type-p", Fvalid_glyph_type_p, 1, 1, 0, /* -Given a GLYPH-TYPE, return non-nil if it is valid. -Valid types are `buffer', `pointer', and `icon'. -*/ - (glyph_type)) -{ - return valid_glyph_type_p (glyph_type) ? Qt : Qnil; -} - -DEFUN ("glyph-type-list", Fglyph_type_list, 0, 0, 0, /* -Return a list of valid glyph types. -*/ - ()) -{ - return Fcopy_sequence (Vglyph_type_list); -} - -DEFUN ("make-glyph-internal", Fmake_glyph_internal, 0, 1, 0, /* -Create and return a new uninitialized glyph or type TYPE. - -TYPE specifies the type of the glyph; this should be one of `buffer', -`pointer', or `icon', and defaults to `buffer'. The type of the glyph -specifies in which contexts the glyph can be used, and controls the -allowable image types into which the glyph's image can be -instantiated. - -`buffer' glyphs can be used as the begin-glyph or end-glyph of an -extent, in the modeline, and in the toolbar. Their image can be -instantiated as `nothing', `mono-pixmap', `color-pixmap', `text', -and `subwindow'. - -`pointer' glyphs can be used to specify the mouse pointer. Their -image can be instantiated as `pointer'. - -`icon' glyphs can be used to specify the icon used when a frame is -iconified. Their image can be instantiated as `mono-pixmap' and -`color-pixmap'. -*/ - (type)) -{ - enum glyph_type typeval = decode_glyph_type (type, ERROR_ME); - return allocate_glyph (typeval, 0); -} - -DEFUN ("glyphp", Fglyphp, 1, 1, 0, /* -Return non-nil if OBJECT is a glyph. - -A glyph is an object used for pixmaps and the like. It is used -in begin-glyphs and end-glyphs attached to extents, in marginal and textual -annotations, in overlay arrows (overlay-arrow-* variables), in toolbar -buttons, and the like. Its image is described using an image specifier -- -see `image-specifier-p'. -*/ - (object)) -{ - return GLYPHP (object) ? Qt : Qnil; -} - -DEFUN ("glyph-type", Fglyph_type, 1, 1, 0, /* -Return the type of the given glyph. -The return value will be one of 'buffer, 'pointer, or 'icon. -*/ - (glyph)) -{ - CHECK_GLYPH (glyph); - switch (XGLYPH_TYPE (glyph)) - { - default: abort (); - case GLYPH_BUFFER: return Qbuffer; - case GLYPH_POINTER: return Qpointer; - case GLYPH_ICON: return Qicon; - } -} - -/***************************************************************************** - glyph_width - - Return the width of the given GLYPH on the given WINDOW. If the - instance is a string then the width is calculated using the font of - the given FACE, unless a face is defined by the glyph itself. - ****************************************************************************/ -unsigned short -glyph_width (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) -{ - Lisp_Object instance; - Lisp_Object frame = XWINDOW (window)->frame; - - /* #### We somehow need to distinguish between the user causing this - error condition and a bug causing it. */ - if (!GLYPHP (glyph)) - return 0; - else - instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); - - if (!IMAGE_INSTANCEP (instance)) - return 0; - - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - Lisp_Object str = XIMAGE_INSTANCE_TEXT_STRING (instance); - Lisp_Object private_face = XGLYPH_FACE(glyph); - - if (!NILP (private_face)) - return redisplay_frame_text_width_string (XFRAME (frame), - private_face, - 0, str, 0, -1); - else - if (!NILP (frame_face)) - return redisplay_frame_text_width_string (XFRAME (frame), - frame_face, - 0, str, 0, -1); - else - return redisplay_text_width_string (XWINDOW (window), - window_findex, - 0, str, 0, -1); - } - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - return XIMAGE_INSTANCE_PIXMAP_WIDTH (instance); - - case IMAGE_NOTHING: - return 0; - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - return XIMAGE_INSTANCE_SUBWINDOW_WIDTH (instance); - - default: - abort (); - return 0; - } -} - -DEFUN ("glyph-width", Fglyph_width, 1, 2, 0, /* -Return the width of GLYPH on WINDOW. -This may not be exact as it does not take into account all of the context -that redisplay will. -*/ - (glyph, window)) -{ - XSETWINDOW (window, decode_window (window)); - CHECK_GLYPH (glyph); - - return make_int (glyph_width (glyph, Qnil, DEFAULT_INDEX, window)); -} - -#define RETURN_ASCENT 0 -#define RETURN_DESCENT 1 -#define RETURN_HEIGHT 2 - -Lisp_Object -glyph_image_instance (Lisp_Object glyph, Lisp_Object domain, - Error_behavior errb, int no_quit) -{ - Lisp_Object specifier = GLYPH_IMAGE (XGLYPH (glyph)); - - /* This can never return Qunbound. All glyphs have 'nothing as - a fallback. */ - return specifier_instance (specifier, Qunbound, domain, errb, no_quit, 0, - Qzero); -} - -static unsigned short -glyph_height_internal (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window, - int function) -{ - Lisp_Object instance; - Lisp_Object frame = XWINDOW (window)->frame; - - if (!GLYPHP (glyph)) - return 0; - else - instance = glyph_image_instance (glyph, window, ERROR_ME_NOT, 1); - - if (!IMAGE_INSTANCEP (instance)) - return 0; - - switch (XIMAGE_INSTANCE_TYPE (instance)) - { - case IMAGE_TEXT: - { - struct font_metric_info fm; - Lisp_Object string = XIMAGE_INSTANCE_TEXT_STRING (instance); - unsigned char charsets[NUM_LEADING_BYTES]; - struct face_cachel frame_cachel; - struct face_cachel *cachel; - - find_charsets_in_bufbyte_string (charsets, - XSTRING_DATA (string), - XSTRING_LENGTH (string)); - - if (!NILP (frame_face)) - { - reset_face_cachel (&frame_cachel); - update_face_cachel_data (&frame_cachel, frame, frame_face); - cachel = &frame_cachel; - } - else - cachel = WINDOW_FACE_CACHEL (XWINDOW (window), window_findex); - ensure_face_cachel_complete (cachel, window, charsets); - - face_cachel_charset_font_metric_info (cachel, charsets, &fm); - - switch (function) - { - case RETURN_ASCENT: return fm.ascent; - case RETURN_DESCENT: return fm.descent; - case RETURN_HEIGHT: return fm.ascent + fm.descent; - default: - abort (); - return 0; /* not reached */ - } - } - - case IMAGE_MONO_PIXMAP: - case IMAGE_COLOR_PIXMAP: - case IMAGE_POINTER: - /* #### Ugh ugh ugh -- temporary crap */ - if (function == RETURN_ASCENT || function == RETURN_HEIGHT) - return XIMAGE_INSTANCE_PIXMAP_HEIGHT (instance); - else - return 0; - - case IMAGE_NOTHING: - return 0; - - case IMAGE_SUBWINDOW: - case IMAGE_WIDGET: - /* #### Ugh ugh ugh -- temporary crap */ - if (function == RETURN_ASCENT || function == RETURN_HEIGHT) - return XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (instance); - else - return 0; - - default: - abort (); - return 0; - } -} - -unsigned short -glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) -{ - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_ASCENT); -} - -unsigned short -glyph_descent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) -{ - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_DESCENT); -} - -/* strictly a convenience function. */ -unsigned short -glyph_height (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, Lisp_Object window) -{ - return glyph_height_internal (glyph, frame_face, window_findex, window, - RETURN_HEIGHT); -} - -DEFUN ("glyph-ascent", Fglyph_ascent, 1, 2, 0, /* -Return the ascent value of GLYPH on WINDOW. -This may not be exact as it does not take into account all of the context -that redisplay will. -*/ - (glyph, window)) -{ - XSETWINDOW (window, decode_window (window)); - CHECK_GLYPH (glyph); - - return make_int (glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window)); -} - -DEFUN ("glyph-descent", Fglyph_descent, 1, 2, 0, /* -Return the descent value of GLYPH on WINDOW. -This may not be exact as it does not take into account all of the context -that redisplay will. -*/ - (glyph, window)) -{ - XSETWINDOW (window, decode_window (window)); - CHECK_GLYPH (glyph); - - return make_int (glyph_descent (glyph, Qnil, DEFAULT_INDEX, window)); -} - -/* This is redundant but I bet a lot of people expect it to exist. */ -DEFUN ("glyph-height", Fglyph_height, 1, 2, 0, /* -Return the height of GLYPH on WINDOW. -This may not be exact as it does not take into account all of the context -that redisplay will. -*/ - (glyph, window)) -{ - XSETWINDOW (window, decode_window (window)); - CHECK_GLYPH (glyph); - - return make_int (glyph_height (glyph, Qnil, DEFAULT_INDEX, window)); -} - -#undef RETURN_ASCENT -#undef RETURN_DESCENT -#undef RETURN_HEIGHT - -/* #### do we need to cache this info to speed things up? */ - -Lisp_Object -glyph_baseline (Lisp_Object glyph, Lisp_Object domain) -{ - if (!GLYPHP (glyph)) - return Qnil; - else - { - Lisp_Object retval = - specifier_instance_no_quit (GLYPH_BASELINE (XGLYPH (glyph)), - /* #### look into ERROR_ME_NOT */ - Qunbound, domain, ERROR_ME_NOT, - 0, Qzero); - if (!NILP (retval) && !INTP (retval)) - retval = Qnil; - else if (INTP (retval)) - { - if (XINT (retval) < 0) - retval = Qzero; - if (XINT (retval) > 100) - retval = make_int (100); - } - return retval; - } -} - -Lisp_Object -glyph_face (Lisp_Object glyph, Lisp_Object domain) -{ - /* #### Domain parameter not currently used but it will be */ - return GLYPHP (glyph) ? GLYPH_FACE (XGLYPH (glyph)) : Qnil; -} - -int -glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain) -{ - if (!GLYPHP (glyph)) - return 0; - else - return !NILP (specifier_instance_no_quit - (GLYPH_CONTRIB_P (XGLYPH (glyph)), Qunbound, domain, - /* #### look into ERROR_ME_NOT */ - ERROR_ME_NOT, 0, Qzero)); -} - -static void -glyph_property_was_changed (Lisp_Object glyph, Lisp_Object property, - Lisp_Object locale) -{ - if (XGLYPH (glyph)->after_change) - (XGLYPH (glyph)->after_change) (glyph, property, locale); -} - - -/***************************************************************************** - * glyph cachel functions * - *****************************************************************************/ - -/* - #### All of this is 95% copied from face cachels. - Consider consolidating. - #### We need to add a dirty flag to the glyphs. - */ - -void -mark_glyph_cachels (glyph_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) -{ - int elt; - - if (!elements) - return; - - for (elt = 0; elt < Dynarr_length (elements); elt++) - { - struct glyph_cachel *cachel = Dynarr_atp (elements, elt); - markobj (cachel->glyph); - } -} - -static void -update_glyph_cachel_data (struct window *w, Lisp_Object glyph, - struct glyph_cachel *cachel) -{ - /* #### This should be || !cachel->updated */ - if (NILP (cachel->glyph) || !EQ (cachel->glyph, glyph)) - { - Lisp_Object window; - - XSETWINDOW (window, w); - - /* #### This could be sped up if we redid things to grab the glyph - instantiation and passed it to the size functions. */ - cachel->glyph = glyph; - cachel->width = glyph_width (glyph, Qnil, DEFAULT_INDEX, window); - cachel->ascent = glyph_ascent (glyph, Qnil, DEFAULT_INDEX, window); - cachel->descent = glyph_descent (glyph, Qnil, DEFAULT_INDEX, window); - } - - cachel->updated = 1; -} - -static void -add_glyph_cachel (struct window *w, Lisp_Object glyph) -{ - struct glyph_cachel new_cachel; - - xzero (new_cachel); - new_cachel.glyph = Qnil; - - update_glyph_cachel_data (w, glyph, &new_cachel); - Dynarr_add (w->glyph_cachels, new_cachel); -} - -static glyph_index -get_glyph_cachel_index (struct window *w, Lisp_Object glyph) -{ - int elt; - - if (noninteractive) - return 0; - - for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) - { - struct glyph_cachel *cachel = - Dynarr_atp (w->glyph_cachels, elt); - - if (EQ (cachel->glyph, glyph) && !NILP (glyph)) - { - if (!cachel->updated) - update_glyph_cachel_data (w, glyph, cachel); - return elt; - } - } - - /* If we didn't find the glyph, add it and then return its index. */ - add_glyph_cachel (w, glyph); - return elt; -} - -void -reset_glyph_cachels (struct window *w) -{ - Dynarr_reset (w->glyph_cachels); - get_glyph_cachel_index (w, Vcontinuation_glyph); - get_glyph_cachel_index (w, Vtruncation_glyph); - get_glyph_cachel_index (w, Vhscroll_glyph); - get_glyph_cachel_index (w, Vcontrol_arrow_glyph); - get_glyph_cachel_index (w, Voctal_escape_glyph); - get_glyph_cachel_index (w, Vinvisible_text_glyph); -} - -void -mark_glyph_cachels_as_not_updated (struct window *w) -{ - int elt; - - /* We need to have a dirty flag to tell if the glyph has changed. - We can check to see if each glyph variable is actually a - completely different glyph, though. */ -#define FROB(glyph_obj, gindex) \ - update_glyph_cachel_data (w, glyph_obj, \ - Dynarr_atp (w->glyph_cachels, gindex)) - - FROB (Vcontinuation_glyph, CONT_GLYPH_INDEX); - FROB (Vtruncation_glyph, TRUN_GLYPH_INDEX); - FROB (Vhscroll_glyph, HSCROLL_GLYPH_INDEX); - FROB (Vcontrol_arrow_glyph, CONTROL_GLYPH_INDEX); - FROB (Voctal_escape_glyph, OCT_ESC_GLYPH_INDEX); - FROB (Vinvisible_text_glyph, INVIS_GLYPH_INDEX); -#undef FROB - - for (elt = 0; elt < Dynarr_length (w->glyph_cachels); elt++) - Dynarr_atp (w->glyph_cachels, elt)->updated = 0; -} - -#ifdef MEMORY_USAGE_STATS - -int -compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, - struct overhead_stats *ovstats) -{ - int total = 0; - - if (glyph_cachels) - total += Dynarr_memory_usage (glyph_cachels, ovstats); - - return total; -} - -#endif /* MEMORY_USAGE_STATS */ - - - -/***************************************************************************** - * subwindow cachel functions * - *****************************************************************************/ -/* subwindows are curious in that you have to physically unmap them to - not display them. It is problematic deciding what to do in - redisplay. We have two caches - a per-window instance cache that - keeps track of subwindows on a window, these are linked to their - instantiator in the hashtable and when the instantiator goes away - we want the instance to go away also. However we also have a - per-frame instance cache that we use to determine if a subwindow is - obscuring an area that we want to clear. We need to be able to flip - through this quickly so a hashtable is not suitable hence the - subwindow_cachels. The question is should we just not mark - instances in the subwindow_cachelsnor should we try and invalidate - the cache at suitable points in redisplay? If we don't invalidate - the cache it will fill up with crud that will only get removed when - the frame is deleted. So invalidation is good, the question is when - and whether we mark as well. Go for the simple option - don't mark, - MARK_SUBWINDOWS_CHANGED when a subwindow gets deleted. */ - -void -mark_subwindow_cachels (subwindow_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)) -{ - int elt; - - if (!elements) - return; - - for (elt = 0; elt < Dynarr_length (elements); elt++) - { - struct subwindow_cachel *cachel = Dynarr_atp (elements, elt); - markobj (cachel->subwindow); - } -} - -static void -update_subwindow_cachel_data (struct frame *f, Lisp_Object subwindow, - struct subwindow_cachel *cachel) -{ - if (NILP (cachel->subwindow) || !EQ (cachel->subwindow, subwindow)) - { - cachel->subwindow = subwindow; - cachel->width = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); - cachel->height = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); - } - - cachel->updated = 1; -} - -static void -add_subwindow_cachel (struct frame *f, Lisp_Object subwindow) -{ - struct subwindow_cachel new_cachel; - - xzero (new_cachel); - new_cachel.subwindow = Qnil; - new_cachel.x=0; - new_cachel.y=0; - new_cachel.being_displayed=0; - - update_subwindow_cachel_data (f, subwindow, &new_cachel); - Dynarr_add (f->subwindow_cachels, new_cachel); -} - -static int -get_subwindow_cachel_index (struct frame *f, Lisp_Object subwindow) -{ - int elt; - - if (noninteractive) - return 0; - - for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) - { - struct subwindow_cachel *cachel = - Dynarr_atp (f->subwindow_cachels, elt); - - if (EQ (cachel->subwindow, subwindow) && !NILP (subwindow)) - { - if (!cachel->updated) - update_subwindow_cachel_data (f, subwindow, cachel); - return elt; - } - } - - /* If we didn't find the glyph, add it and then return its index. */ - add_subwindow_cachel (f, subwindow); - return elt; -} - -/* redisplay in general assumes that drawing something will erase - what was there before. unfortunately this does not apply to - subwindows that need to be specifically unmapped in order to - disappear. we take a brute force approach - on the basis that its - cheap - and unmap all subwindows in a display line */ -void -reset_subwindow_cachels (struct frame *f) -{ - int elt; - for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) - { - struct subwindow_cachel *cachel = - Dynarr_atp (f->subwindow_cachels, elt); - - if (!NILP (cachel->subwindow) && cachel->being_displayed) - { - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (cachel->subwindow); - MAYBE_DEVMETH (XDEVICE (f->device), unmap_subwindow, (ii)); - } - } - Dynarr_reset (f->subwindow_cachels); -} - -void -mark_subwindow_cachels_as_not_updated (struct frame *f) -{ - int elt; - - for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) - Dynarr_atp (f->subwindow_cachels, elt)->updated = 0; -} - - -/***************************************************************************** - * subwindow functions * - *****************************************************************************/ - -/* update the displayed characteristics of a subwindow */ -static void -update_subwindow (Lisp_Object subwindow) -{ - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - - if (!IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET - || - NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) - return; - - MAYBE_DEVMETH (XDEVICE (ii->device), update_subwindow, (ii)); -} - -void -update_frame_subwindows (struct frame *f) -{ - int elt; - - if (f->subwindows_changed || f->glyphs_changed) - for (elt = 0; elt < Dynarr_length (f->subwindow_cachels); elt++) - { - struct subwindow_cachel *cachel = - Dynarr_atp (f->subwindow_cachels, elt); - - if (cachel->being_displayed) - { - update_subwindow (cachel->subwindow); - } - } -} - -/* remove a subwindow from its frame */ -void unmap_subwindow (Lisp_Object subwindow) -{ - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - int elt; - struct subwindow_cachel* cachel; - struct frame* f; - - if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW) - || - NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) - return; - - f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); - elt = get_subwindow_cachel_index (f, subwindow); - cachel = Dynarr_atp (f->subwindow_cachels, elt); - - cachel->x = -1; - cachel->y = -1; - cachel->being_displayed = 0; - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; - - MAYBE_DEVMETH (XDEVICE (ii->device), unmap_subwindow, (ii)); -} - -/* show a subwindow in its frame */ -void map_subwindow (Lisp_Object subwindow, int x, int y) -{ - struct Lisp_Image_Instance* ii = XIMAGE_INSTANCE (subwindow); - int elt; - struct subwindow_cachel* cachel; - struct frame* f; - - if (!(IMAGE_INSTANCE_TYPE (ii) == IMAGE_WIDGET - || - IMAGE_INSTANCE_TYPE (ii) == IMAGE_SUBWINDOW) - || - NILP (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii))) - return; - - f = XFRAME (IMAGE_INSTANCE_SUBWINDOW_FRAME (ii)); - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 1; - elt = get_subwindow_cachel_index (f, subwindow); - cachel = Dynarr_atp (f->subwindow_cachels, elt); - cachel->x = x; - cachel->y = y; - cachel->being_displayed = 1; - - MAYBE_DEVMETH (XDEVICE (ii->device), map_subwindow, (ii, x, y)); -} - -static int -subwindow_possible_dest_types (void) -{ - return IMAGE_SUBWINDOW_MASK; -} - -/* Partially instantiate a subwindow. */ -void -subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain) -{ - struct Lisp_Image_Instance *ii = XIMAGE_INSTANCE (image_instance); - Lisp_Object device = IMAGE_INSTANCE_DEVICE (ii); - Lisp_Object frame = FW_FRAME (domain); - Lisp_Object width = find_keyword_in_vector (instantiator, Q_pixel_width); - Lisp_Object height = find_keyword_in_vector (instantiator, Q_pixel_height); - - if (NILP (frame)) - signal_simple_error ("No selected frame", device); - - if (!(dest_mask & IMAGE_SUBWINDOW_MASK)) - incompatible_image_types (instantiator, dest_mask, IMAGE_SUBWINDOW_MASK); - - ii->data = 0; - IMAGE_INSTANCE_SUBWINDOW_ID (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = Qnil; - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (ii) = 0; - IMAGE_INSTANCE_SUBWINDOW_FRAME (ii) = frame; - - /* this stuff may get overidden by the widget code */ - if (NILP (width)) - IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = 20; - else - { - int w = 1; - CHECK_INT (width); - if (XINT (width) > 1) - w = XINT (width); - IMAGE_INSTANCE_SUBWINDOW_WIDTH (ii) = w; - } - if (NILP (height)) - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = 20; - else - { - int h = 1; - CHECK_INT (height); - if (XINT (height) > 1) - h = XINT (height); - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (ii) = h; - } -} - -DEFUN ("subwindowp", Fsubwindowp, 1, 1, 0, /* -Return non-nil if OBJECT is a subwindow. -*/ - (object)) -{ - CHECK_IMAGE_INSTANCE (object); - return (XIMAGE_INSTANCE_TYPE (object) == IMAGE_SUBWINDOW) ? Qt : Qnil; -} - -DEFUN ("image-instance-subwindow-id", Fimage_instance_subwindow_id, 1, 1, 0, /* -Return the window id of SUBWINDOW as a number. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - return make_int ((int) (XIMAGE_INSTANCE_SUBWINDOW_ID (subwindow))); -} - -DEFUN ("resize-subwindow", Fresize_subwindow, 1, 3, 0, /* -Resize SUBWINDOW to WIDTH x HEIGHT. -If a value is nil that parameter is not changed. -*/ - (subwindow, width, height)) -{ - int neww, newh; - - CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - - if (NILP (width)) - neww = XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow); - else - neww = XINT (width); - - if (NILP (height)) - newh = XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow); - else - newh = XINT (height); - - - MAYBE_DEVMETH (XDEVICE (XIMAGE_INSTANCE_DEVICE (subwindow)), - resize_subwindow, (XIMAGE_INSTANCE (subwindow), neww, newh)); - - XIMAGE_INSTANCE_SUBWINDOW_HEIGHT (subwindow) = newh; - XIMAGE_INSTANCE_SUBWINDOW_WIDTH (subwindow) = neww; - - return subwindow; -} - -DEFUN ("force-subwindow-map", Fforce_subwindow_map, 1, 1, 0, /* -Generate a Map event for SUBWINDOW. -*/ - (subwindow)) -{ - CHECK_SUBWINDOW_IMAGE_INSTANCE (subwindow); - - map_subwindow (subwindow, 0, 0); - - return subwindow; -} - - -/***************************************************************************** - * display tables * - *****************************************************************************/ - -/* Get the display tables for use currently on window W with face - FACE. #### This will have to be redone. */ - -void -get_display_tables (struct window *w, face_index findex, - Lisp_Object *face_table, Lisp_Object *window_table) -{ - Lisp_Object tem; - tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); - if (UNBOUNDP (tem)) - tem = Qnil; - if (!LISTP (tem)) - tem = noseeum_cons (tem, Qnil); - *face_table = tem; - tem = w->display_table; - if (UNBOUNDP (tem)) - tem = Qnil; - if (!LISTP (tem)) - tem = noseeum_cons (tem, Qnil); - *window_table = tem; -} - -Lisp_Object -display_table_entry (Emchar ch, Lisp_Object face_table, - Lisp_Object window_table) -{ - Lisp_Object tail; - - /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ - for (tail = face_table; 1; tail = XCDR (tail)) - { - Lisp_Object table; - if (NILP (tail)) - { - if (!NILP (window_table)) - { - tail = window_table; - window_table = Qnil; - } - else - return Qnil; - } - table = XCAR (tail); - - if (VECTORP (table)) - { - if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) - return XVECTOR_DATA (table)[ch]; - else - continue; - } - else if (CHAR_TABLEP (table) - && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) - { - return get_char_table (ch, XCHAR_TABLE (table)); - } - else if (CHAR_TABLEP (table) - && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) - { - Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table)); - if (!NILP (gotit)) - return gotit; - else - continue; - } - else if (RANGE_TABLEP (table)) - { - Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); - if (!NILP (gotit)) - return gotit; - else - continue; - } - else - abort (); - } -} - -/***************************************************************************** - * initialization * - *****************************************************************************/ - -void -syms_of_glyphs (void) -{ - /* image instantiators */ - - DEFSUBR (Fimage_instantiator_format_list); - DEFSUBR (Fvalid_image_instantiator_format_p); - DEFSUBR (Fset_console_type_image_conversion_list); - DEFSUBR (Fconsole_type_image_conversion_list); - - defkeyword (&Q_file, ":file"); - defkeyword (&Q_data, ":data"); - defkeyword (&Q_face, ":face"); - defkeyword (&Q_pixel_height, ":pixel-height"); - defkeyword (&Q_pixel_width, ":pixel-width"); - -#ifdef HAVE_XPM - defkeyword (&Q_color_symbols, ":color-symbols"); -#endif -#ifdef HAVE_WINDOW_SYSTEM - defkeyword (&Q_mask_file, ":mask-file"); - defkeyword (&Q_mask_data, ":mask-data"); - defkeyword (&Q_hotspot_x, ":hotspot-x"); - defkeyword (&Q_hotspot_y, ":hotspot-y"); - defkeyword (&Q_foreground, ":foreground"); - defkeyword (&Q_background, ":background"); -#endif - /* image specifiers */ - - DEFSUBR (Fimage_specifier_p); - /* Qimage in general.c */ - - /* image instances */ - - defsymbol (&Qimage_instancep, "image-instance-p"); - - defsymbol (&Qnothing_image_instance_p, "nothing-image-instance-p"); - defsymbol (&Qtext_image_instance_p, "text-image-instance-p"); - defsymbol (&Qmono_pixmap_image_instance_p, "mono-pixmap-image-instance-p"); - defsymbol (&Qcolor_pixmap_image_instance_p, "color-pixmap-image-instance-p"); - defsymbol (&Qpointer_image_instance_p, "pointer-image-instance-p"); - defsymbol (&Qwidget_image_instance_p, "widget-image-instance-p"); - defsymbol (&Qsubwindow_image_instance_p, "subwindow-image-instance-p"); - - DEFSUBR (Fmake_image_instance); - DEFSUBR (Fimage_instance_p); - DEFSUBR (Fimage_instance_type); - DEFSUBR (Fvalid_image_instance_type_p); - DEFSUBR (Fimage_instance_type_list); - DEFSUBR (Fimage_instance_name); - DEFSUBR (Fimage_instance_string); - DEFSUBR (Fimage_instance_file_name); - DEFSUBR (Fimage_instance_mask_file_name); - DEFSUBR (Fimage_instance_depth); - DEFSUBR (Fimage_instance_height); - DEFSUBR (Fimage_instance_width); - DEFSUBR (Fimage_instance_hotspot_x); - DEFSUBR (Fimage_instance_hotspot_y); - DEFSUBR (Fimage_instance_foreground); - DEFSUBR (Fimage_instance_background); - DEFSUBR (Fimage_instance_property); - DEFSUBR (Fset_image_instance_property); - DEFSUBR (Fcolorize_image_instance); - /* subwindows */ - DEFSUBR (Fsubwindowp); - DEFSUBR (Fimage_instance_subwindow_id); - DEFSUBR (Fresize_subwindow); - DEFSUBR (Fforce_subwindow_map); - - /* Qnothing defined as part of the "nothing" image-instantiator - type. */ - /* Qtext defined in general.c */ - defsymbol (&Qmono_pixmap, "mono-pixmap"); - defsymbol (&Qcolor_pixmap, "color-pixmap"); - /* Qpointer defined in general.c */ - - /* glyphs */ - - defsymbol (&Qglyphp, "glyphp"); - defsymbol (&Qcontrib_p, "contrib-p"); - defsymbol (&Qbaseline, "baseline"); - - defsymbol (&Qbuffer_glyph_p, "buffer-glyph-p"); - defsymbol (&Qpointer_glyph_p, "pointer-glyph-p"); - defsymbol (&Qicon_glyph_p, "icon-glyph-p"); - - defsymbol (&Qconst_glyph_variable, "const-glyph-variable"); - - DEFSUBR (Fglyph_type); - DEFSUBR (Fvalid_glyph_type_p); - DEFSUBR (Fglyph_type_list); - DEFSUBR (Fglyphp); - DEFSUBR (Fmake_glyph_internal); - DEFSUBR (Fglyph_width); - DEFSUBR (Fglyph_ascent); - DEFSUBR (Fglyph_descent); - DEFSUBR (Fglyph_height); - - /* Qbuffer defined in general.c. */ - /* Qpointer defined above */ - - /* Errors */ - deferror (&Qimage_conversion_error, - "image-conversion-error", - "image-conversion error", Qio_error); - -} - -void -specifier_type_create_image (void) -{ - /* image specifiers */ - - INITIALIZE_SPECIFIER_TYPE_WITH_DATA (image, "image", "imagep"); - - SPECIFIER_HAS_METHOD (image, create); - SPECIFIER_HAS_METHOD (image, mark); - SPECIFIER_HAS_METHOD (image, instantiate); - SPECIFIER_HAS_METHOD (image, validate); - SPECIFIER_HAS_METHOD (image, after_change); - SPECIFIER_HAS_METHOD (image, going_to_add); -} - -void -image_instantiator_format_create (void) -{ - /* image instantiators */ - - the_image_instantiator_format_entry_dynarr = - Dynarr_new (image_instantiator_format_entry); - - Vimage_instantiator_format_list = Qnil; - staticpro (&Vimage_instantiator_format_list); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (nothing, "nothing"); - - IIFORMAT_HAS_METHOD (nothing, possible_dest_types); - IIFORMAT_HAS_METHOD (nothing, instantiate); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (inherit, "inherit"); - - IIFORMAT_HAS_METHOD (inherit, validate); - IIFORMAT_HAS_METHOD (inherit, normalize); - IIFORMAT_HAS_METHOD (inherit, possible_dest_types); - IIFORMAT_HAS_METHOD (inherit, instantiate); - - IIFORMAT_VALID_KEYWORD (inherit, Q_face, check_valid_face); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (string, "string"); - - IIFORMAT_HAS_METHOD (string, validate); - IIFORMAT_HAS_METHOD (string, possible_dest_types); - IIFORMAT_HAS_METHOD (string, instantiate); - - IIFORMAT_VALID_KEYWORD (string, Q_data, check_valid_string); - - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (formatted_string, "formatted-string"); - - IIFORMAT_HAS_METHOD (formatted_string, validate); - IIFORMAT_HAS_METHOD (formatted_string, possible_dest_types); - IIFORMAT_HAS_METHOD (formatted_string, instantiate); - - IIFORMAT_VALID_KEYWORD (formatted_string, Q_data, check_valid_string); - - /* subwindows */ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (subwindow, "subwindow"); - IIFORMAT_HAS_METHOD (subwindow, possible_dest_types); - IIFORMAT_HAS_METHOD (subwindow, instantiate); - IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_width, check_valid_int); - IIFORMAT_VALID_KEYWORD (subwindow, Q_pixel_height, check_valid_int); - -#ifdef HAVE_WINDOW_SYSTEM - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xbm, "xbm"); - - IIFORMAT_HAS_METHOD (xbm, validate); - IIFORMAT_HAS_METHOD (xbm, normalize); - IIFORMAT_HAS_METHOD (xbm, possible_dest_types); - - IIFORMAT_VALID_KEYWORD (xbm, Q_data, check_valid_xbm_inline); - IIFORMAT_VALID_KEYWORD (xbm, Q_file, check_valid_string); - IIFORMAT_VALID_KEYWORD (xbm, Q_mask_data, check_valid_xbm_inline); - IIFORMAT_VALID_KEYWORD (xbm, Q_mask_file, check_valid_string); - IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_x, check_valid_int); - IIFORMAT_VALID_KEYWORD (xbm, Q_hotspot_y, check_valid_int); - IIFORMAT_VALID_KEYWORD (xbm, Q_foreground, check_valid_string); - IIFORMAT_VALID_KEYWORD (xbm, Q_background, check_valid_string); -#endif /* HAVE_WINDOW_SYSTEM */ - -#ifdef HAVE_XFACE - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xface, "xface"); - - IIFORMAT_HAS_METHOD (xface, validate); - IIFORMAT_HAS_METHOD (xface, normalize); - IIFORMAT_HAS_METHOD (xface, possible_dest_types); - - IIFORMAT_VALID_KEYWORD (xface, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (xface, Q_file, check_valid_string); - IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_x, check_valid_int); - IIFORMAT_VALID_KEYWORD (xface, Q_hotspot_y, check_valid_int); - IIFORMAT_VALID_KEYWORD (xface, Q_foreground, check_valid_string); - IIFORMAT_VALID_KEYWORD (xface, Q_background, check_valid_string); -#endif - -#ifdef HAVE_XPM - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT (xpm, "xpm"); - - IIFORMAT_HAS_METHOD (xpm, validate); - IIFORMAT_HAS_METHOD (xpm, normalize); - IIFORMAT_HAS_METHOD (xpm, possible_dest_types); - - IIFORMAT_VALID_KEYWORD (xpm, Q_data, check_valid_string); - IIFORMAT_VALID_KEYWORD (xpm, Q_file, check_valid_string); - IIFORMAT_VALID_KEYWORD (xpm, Q_color_symbols, check_valid_xpm_color_symbols); -#endif /* HAVE_XPM */ -} - -void -vars_of_glyphs (void) -{ - Vthe_nothing_vector = vector1 (Qnothing); - staticpro (&Vthe_nothing_vector); - - /* image instances */ - - Vimage_instance_type_list = Fcons (Qnothing, - list6 (Qtext, Qmono_pixmap, Qcolor_pixmap, - Qpointer, Qsubwindow, Qwidget)); - staticpro (&Vimage_instance_type_list); - - /* glyphs */ - - Vglyph_type_list = list3 (Qbuffer, Qpointer, Qicon); - staticpro (&Vglyph_type_list); - - /* The octal-escape glyph, control-arrow-glyph and - invisible-text-glyph are completely initialized in glyphs.el */ - - DEFVAR_LISP ("octal-escape-glyph", &Voctal_escape_glyph /* -What to prefix character codes displayed in octal with. -*/); - Voctal_escape_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - DEFVAR_LISP ("control-arrow-glyph", &Vcontrol_arrow_glyph /* -What to use as an arrow for control characters. -*/); - Vcontrol_arrow_glyph = allocate_glyph (GLYPH_BUFFER, - redisplay_glyph_changed); - - DEFVAR_LISP ("invisible-text-glyph", &Vinvisible_text_glyph /* -What to use to indicate the presence of invisible text. -This is the glyph that is displayed when an ellipsis is called for -\(see `selective-display-ellipses' and `buffer-invisibility-spec'). -Normally this is three dots ("..."). -*/); - Vinvisible_text_glyph = allocate_glyph (GLYPH_BUFFER, - redisplay_glyph_changed); - - /* Partially initialized in glyphs.el */ - DEFVAR_LISP ("hscroll-glyph", &Vhscroll_glyph /* -What to display at the beginning of horizontally scrolled lines. -*/); - Vhscroll_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); -#ifdef HAVE_WINDOW_SYSTEM - Fprovide (Qxbm); -#endif -#ifdef HAVE_XPM - Fprovide (Qxpm); - - DEFVAR_LISP ("xpm-color-symbols", &Vxpm_color_symbols /* -Definitions of logical color-names used when reading XPM files. -Elements of this list should be of the form (COLOR-NAME FORM-TO-EVALUATE). -The COLOR-NAME should be a string, which is the name of the color to define; -the FORM should evaluate to a `color' specifier object, or a string to be -passed to `make-color-instance'. If a loaded XPM file references a symbolic -color called COLOR-NAME, it will display as the computed color instead. - -The default value of this variable defines the logical color names -\"foreground\" and \"background\" to be the colors of the `default' face. -*/ ); - Vxpm_color_symbols = Qnil; /* initialized in x-faces.el */ -#endif /* HAVE_XPM */ -#ifdef HAVE_XFACE - Fprovide (Qxface); -#endif -} - -void -specifier_vars_of_glyphs (void) -{ - /* #### Can we GC here? The set_specifier_* calls definitely need */ - /* protection. */ - /* display tables */ - - DEFVAR_SPECIFIER ("current-display-table", &Vcurrent_display_table /* -*The display table currently in use. -This is a specifier; use `set-specifier' to change it. -The display table is a vector created with `make-display-table'. -The 256 elements control how to display each possible text character. -Each value should be a string, a glyph, a vector or nil. -If a value is a vector it must be composed only of strings and glyphs. -nil means display the character in the default fashion. -Faces can have their own, overriding display table. -*/ ); - Vcurrent_display_table = Fmake_specifier (Qdisplay_table); - set_specifier_fallback (Vcurrent_display_table, - list1 (Fcons (Qnil, Qnil))); - set_specifier_caching (Vcurrent_display_table, - slot_offset (struct window, - display_table), - some_window_value_changed, - 0, 0); -} - -void -complex_vars_of_glyphs (void) -{ - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("truncation-glyph", &Vtruncation_glyph /* -What to display at the end of truncated lines. -*/ ); - Vtruncation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("continuation-glyph", &Vcontinuation_glyph /* -What to display at the end of wrapped lines. -*/ ); - Vcontinuation_glyph = allocate_glyph (GLYPH_BUFFER, redisplay_glyph_changed); - - /* Partially initialized in glyphs-x.c, glyphs.el */ - DEFVAR_LISP ("xemacs-logo", &Vxemacs_logo /* -The glyph used to display the XEmacs logo at startup. -*/ ); - Vxemacs_logo = allocate_glyph (GLYPH_BUFFER, 0); -} diff --git a/src/glyphs.h b/src/glyphs.h deleted file mode 100644 index 8535ab4..0000000 --- a/src/glyphs.h +++ /dev/null @@ -1,751 +0,0 @@ -/* Generic glyph data structures + display tables - Copyright (C) 1994 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing - -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. */ - -#ifndef _XEMACS_GLYPHS_H_ -#define _XEMACS_GLYPHS_H_ - -#include "specifier.h" -#include "gui.h" - -/************************************************************************/ -/* Image Instantiators */ -/************************************************************************/ - -struct image_instantiator_methods; - -/* Remember the distinction between image instantiator formats and - image instance types. Here's an approximate mapping: - - image instantiator format image instance type - ------------------------- ------------------- - nothing nothing - string text - formatted-string text - xbm mono-pixmap, color-pixmap, pointer - xpm color-pixmap, mono-pixmap, pointer - xface mono-pixmap, color-pixmap, pointer - gif color-pixmap - jpeg color-pixmap - png color-pixmap - tiff color-pixmap - bmp color-pixmap - cursor-font pointer - mswindows-resource pointer - font pointer - subwindow subwindow - inherit mono-pixmap - autodetect mono-pixmap, color-pixmap, pointer, text - button widget - edit widget - combo widget - scrollbar widget - static widget -*/ - -/* These are methods specific to a particular format of image instantiator - (e.g. xpm, string, etc.). */ - -typedef struct ii_keyword_entry ii_keyword_entry; -struct ii_keyword_entry -{ - Lisp_Object keyword; - void (*validate) (Lisp_Object data); - int multiple_p; -}; - -typedef struct -{ - Dynarr_declare (ii_keyword_entry); -} ii_keyword_entry_dynarr; - -struct image_instantiator_methods -{ - Lisp_Object symbol; - - Lisp_Object device; /* sometimes used */ - - ii_keyword_entry_dynarr *keywords; - /* Implementation specific methods: */ - - /* Validate method: Given an instantiator vector, signal an error if - it's invalid for this image-instantiator format. Note that this - validation only occurs after all the keyword-specific validation - has already been performed. This is chiefly useful for making - sure that certain required keywords are present. */ - void (*validate_method) (Lisp_Object instantiator); - - /* Normalize method: Given an instantiator, convert it to the form - that should be used in a glyph, for devices of type CONSOLE_TYPE. - Signal an error if conversion fails. */ - Lisp_Object (*normalize_method) (Lisp_Object instantiator, - Lisp_Object console_type); - - /* Possible-dest-types method: Return a mask indicating what dest types - are compatible with this format. */ - int (*possible_dest_types_method) (void); - - /* Instantiate method: Given an instantiator and a partially - filled-in image instance, complete the filling-in. Return - non-zero if the instantiation succeeds, 0 if it fails. - This must be present. */ - void (*instantiate_method) (Lisp_Object image_instance, - Lisp_Object instantiator, - Lisp_Object pointer_fg, - Lisp_Object pointer_bg, - int dest_mask, - Lisp_Object domain); - /* Property method: Given an image instance, return device specific - properties. */ - Lisp_Object (*property_method) (Lisp_Object image_instance, - Lisp_Object property); - /* Set-property method: Given an image instance, set device specific - properties. */ - Lisp_Object (*set_property_method) (Lisp_Object image_instance, - Lisp_Object property, - Lisp_Object val); -}; - -/***** Calling an image-instantiator method *****/ - -#define HAS_IIFORMAT_METH_P(mstruc, m) ((mstruc)->m##_method) -#define IIFORMAT_METH(mstruc, m, args) (((mstruc)->m##_method) args) - -/* Call a void-returning specifier method, if it exists */ -#define MAYBE_IIFORMAT_METH(mstruc, m, args) \ -if (mstruc) \ -do { \ - struct image_instantiator_methods *maybe_iiformat_meth_mstruc = (mstruc); \ - if (HAS_IIFORMAT_METH_P (maybe_iiformat_meth_mstruc, m)) \ - IIFORMAT_METH (maybe_iiformat_meth_mstruc, m, args); \ -} while (0) - -#define MAYBE_IIFORMAT_DEVMETH(device, mstruc, m, args) \ -do { \ - struct image_instantiator_methods *_mstruc = decode_ii_device (device, mstruc); \ - if (_mstruc) \ - MAYBE_IIFORMAT_METH(_mstruc, m, args); \ -} while (0) - - -/* Call a specifier method, if it exists; otherwise return - the specified value */ - -#define IIFORMAT_METH_OR_GIVEN(mstruc, m, args, given) \ - (HAS_IIFORMAT_METH_P (mstruc, m) ? \ - IIFORMAT_METH (mstruc, m, args) : (given)) - -/***** Defining new image-instantiator types *****/ - -#define DECLARE_IMAGE_INSTANTIATOR_FORMAT(format) \ -extern struct image_instantiator_methods *format##_image_instantiator_methods - -#define DEFINE_IMAGE_INSTANTIATOR_FORMAT(format) \ -struct image_instantiator_methods *format##_image_instantiator_methods - -#define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name) \ -do { \ - format##_image_instantiator_methods = \ - xnew_and_zero (struct image_instantiator_methods); \ - format##_image_instantiator_methods->symbol = Q##format; \ - format##_image_instantiator_methods->device = Qnil; \ - format##_image_instantiator_methods->keywords = \ - Dynarr_new (ii_keyword_entry); \ - add_entry_to_image_instantiator_format_list \ - (Q##format, format##_image_instantiator_methods); \ -} while (0) - -#define INITIALIZE_IMAGE_INSTANTIATOR_FORMAT(format, obj_name) \ -do { \ - defsymbol (&Q##format, obj_name); \ - INITIALIZE_IMAGE_INSTANTIATOR_FORMAT_NO_SYM(format, obj_name); \ -} while (0) - -/* Declare that image-instantiator format FORMAT has method M; used in - initialization routines */ -#define IIFORMAT_HAS_METHOD(format, m) \ - (format##_image_instantiator_methods->m##_method = format##_##m) - -#define IIFORMAT_HAS_SHARED_METHOD(format, m, type) \ - (format##_image_instantiator_methods->m##_method = type##_##m) - -/* Declare that KEYW is a valid keyword for image-instantiator format - FORMAT. VALIDATE_FUN if a function that returns whether the data - is valid. The keyword may not appear more than once. */ -#define IIFORMAT_VALID_KEYWORD(format, keyw, validate_fun) \ - do { \ - struct ii_keyword_entry entry; \ - \ - entry.keyword = keyw; \ - entry.validate = validate_fun; \ - entry.multiple_p = 0; \ - Dynarr_add (format##_image_instantiator_methods->keywords, \ - entry); \ - } while (0) - -/* Same as IIFORMAT_VALID_KEYWORD except that the keyword may - appear multiple times. */ -#define IIFORMAT_VALID_MULTI_KEYWORD(format, keyword, validate_fun) \ - do { \ - struct ii_keyword_entry entry; \ - \ - entry.keyword = keyword; \ - entry.validate = validate_fun; \ - entry.multiple_p = 1; \ - Dynarr_add (format##_image_instantiator_methods->keywords, \ - entry); \ - } while (0) - -#define DEFINE_DEVICE_IIFORMAT(type, format)\ -struct image_instantiator_methods *type##_##format##_image_instantiator_methods - -#define INITIALIZE_DEVICE_IIFORMAT(type, format) \ -do { \ - type##_##format##_image_instantiator_methods = \ - xnew_and_zero (struct image_instantiator_methods); \ - type##_##format##_image_instantiator_methods->symbol = Q##format; \ - type##_##format##_image_instantiator_methods->device = Q##type; \ - type##_##format##_image_instantiator_methods->keywords = \ - Dynarr_new (ii_keyword_entry); \ - add_entry_to_device_ii_format_list \ - (Q##type, Q##format, type##_##format##_image_instantiator_methods); \ -} while (0) - -/* Declare that image-instantiator format FORMAT has method M; used in - initialization routines */ -#define IIFORMAT_HAS_DEVMETHOD(type, format, m) \ - (type##_##format##_image_instantiator_methods->m##_method = type##_##format##_##m) - -struct image_instantiator_methods * -decode_device_ii_format (Lisp_Object device, Lisp_Object format, - Error_behavior errb); -struct image_instantiator_methods * -decode_image_instantiator_format (Lisp_Object format, Error_behavior errb); - -void add_entry_to_image_instantiator_format_list (Lisp_Object symbol, - struct image_instantiator_methods *meths); -void add_entry_to_device_ii_format_list (Lisp_Object device, Lisp_Object symbol, - struct image_instantiator_methods *meths); -Lisp_Object find_keyword_in_vector (Lisp_Object vector, - Lisp_Object keyword); -Lisp_Object find_keyword_in_vector_or_given (Lisp_Object vector, - Lisp_Object keyword, - Lisp_Object default_); -Lisp_Object simple_image_type_normalize (Lisp_Object inst, - Lisp_Object console_type, - Lisp_Object image_type_tag); -Lisp_Object potential_pixmap_file_instantiator (Lisp_Object instantiator, - Lisp_Object file_keyword, - Lisp_Object data_keyword, - Lisp_Object console_type); -void check_valid_string (Lisp_Object data); -void check_valid_int (Lisp_Object data); -void check_valid_face (Lisp_Object data); -void check_valid_vector (Lisp_Object data); - -void initialize_subwindow_image_instance (struct Lisp_Image_Instance*); -void subwindow_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain); - -DECLARE_DOESNT_RETURN (incompatible_image_types (Lisp_Object instantiator, - int given_dest_mask, - int desired_dest_mask)); -DECLARE_DOESNT_RETURN (signal_image_error (CONST char *, Lisp_Object)); -DECLARE_DOESNT_RETURN (signal_image_error_2 (CONST char *, Lisp_Object, Lisp_Object)); - -/************************************************************************/ -/* Image Specifier Object */ -/************************************************************************/ - -DECLARE_SPECIFIER_TYPE (image); -#define XIMAGE_SPECIFIER(x) XSPECIFIER_TYPE (x, image) -#define XSETIMAGE_SPECIFIER(x, p) XSETSPECIFIER_TYPE (x, p, image) -#define IMAGE_SPECIFIERP(x) SPECIFIER_TYPEP (x, image) -#define CHECK_IMAGE_SPECIFIER(x) CHECK_SPECIFIER_TYPE (x, image) -#define CONCHECK_IMAGE_SPECIFIER(x) CONCHECK_SPECIFIER_TYPE (x, image) - -void set_image_attached_to (Lisp_Object obj, Lisp_Object face_or_glyph, - Lisp_Object property); - -struct image_specifier -{ - int allowed; - Lisp_Object attachee; /* face or glyph this is attached to, or nil */ - Lisp_Object attachee_property;/* property of that face or glyph */ -}; - -#define IMAGE_SPECIFIER_DATA(g) (SPECIFIER_TYPE_DATA (g, image)) -#define IMAGE_SPECIFIER_ALLOWED(g) (IMAGE_SPECIFIER_DATA (g)->allowed) -#define IMAGE_SPECIFIER_ATTACHEE(g) (IMAGE_SPECIFIER_DATA (g)->attachee) -#define IMAGE_SPECIFIER_ATTACHEE_PROPERTY(g) \ - (IMAGE_SPECIFIER_DATA (g)->attachee_property) - -#define XIMAGE_SPECIFIER_ALLOWED(g) \ - IMAGE_SPECIFIER_ALLOWED (XIMAGE_SPECIFIER (g)) - -/************************************************************************/ -/* Image Instance Object */ -/************************************************************************/ - -DECLARE_LRECORD (image_instance, struct Lisp_Image_Instance); -#define XIMAGE_INSTANCE(x) \ - XRECORD (x, image_instance, struct Lisp_Image_Instance) -#define XSETIMAGE_INSTANCE(x, p) XSETRECORD (x, p, image_instance) -#define IMAGE_INSTANCEP(x) RECORDP (x, image_instance) -#define GC_IMAGE_INSTANCEP(x) GC_RECORDP (x, image_instance) -#define CHECK_IMAGE_INSTANCE(x) CHECK_RECORD (x, image_instance) -#define CONCHECK_IMAGE_INSTANCE(x) CONCHECK_RECORD (x, image_instance) - -enum image_instance_type -{ - IMAGE_UNKNOWN, - IMAGE_NOTHING, - IMAGE_TEXT, - IMAGE_MONO_PIXMAP, - IMAGE_COLOR_PIXMAP, - IMAGE_POINTER, - IMAGE_SUBWINDOW, - IMAGE_WIDGET -}; - -#define IMAGE_NOTHING_MASK (1 << 0) -#define IMAGE_TEXT_MASK (1 << 1) -#define IMAGE_MONO_PIXMAP_MASK (1 << 2) -#define IMAGE_COLOR_PIXMAP_MASK (1 << 3) -#define IMAGE_POINTER_MASK (1 << 4) -#define IMAGE_SUBWINDOW_MASK (1 << 5) -#define IMAGE_WIDGET_MASK (1 << 6) - -#define IMAGE_INSTANCE_TYPE_P(ii, type) \ -(IMAGE_INSTANCEP (ii) && XIMAGE_INSTANCE_TYPE (ii) == type) - -#define NOTHING_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_NOTHING) -#define TEXT_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_TEXT) -#define MONO_PIXMAP_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_MONO_PIXMAP) -#define COLOR_PIXMAP_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_COLOR_PIXMAP) -#define POINTER_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_POINTER) -#define SUBWINDOW_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_SUBWINDOW) -#define WIDGET_IMAGE_INSTANCEP(ii) \ - IMAGE_INSTANCE_TYPE_P (ii, IMAGE_WIDGET) - -#define CHECK_NOTHING_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!NOTHING_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qnothing_image_instance_p, (x)); \ -} while (0) - -#define CHECK_TEXT_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!TEXT_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qtext_image_instance_p, (x)); \ -} while (0) - -#define CHECK_MONO_PIXMAP_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!MONO_PIXMAP_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qmono_pixmap_image_instance_p, (x)); \ -} while (0) - -#define CHECK_COLOR_PIXMAP_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!COLOR_PIXMAP_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qcolor_pixmap_image_instance_p, (x)); \ -} while (0) - -#define CHECK_POINTER_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!POINTER_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qpointer_image_instance_p, (x)); \ -} while (0) - -#define CHECK_SUBWINDOW_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!SUBWINDOW_IMAGE_INSTANCEP (x) \ - && !WIDGET_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qsubwindow_image_instance_p, (x)); \ -} while (0) - -#define CHECK_WIDGET_IMAGE_INSTANCE(x) do { \ - CHECK_IMAGE_INSTANCE (x); \ - if (!WIDGET_IMAGE_INSTANCEP (x)) \ - x = wrong_type_argument (Qwidget_image_instance_p, (x)); \ -} while (0) - -struct Lisp_Image_Instance -{ - struct lcrecord_header header; - Lisp_Object device; - Lisp_Object name; - enum image_instance_type type; - union - { - struct - { - Lisp_Object string; - } text; - struct - { - int width, height, depth; - Lisp_Object hotspot_x, hotspot_y; /* integer or Qnil */ - Lisp_Object filename; /* string or Qnil */ - Lisp_Object mask_filename; /* string or Qnil */ - Lisp_Object fg, bg; /* foreground and background colors, - if this is a colorized mono-pixmap - or a pointer */ - Lisp_Object auxdata; /* list or Qnil: any additional data - to be seen from lisp */ - } pixmap; /* used for pointers as well */ - struct - { - Lisp_Object frame; - unsigned int width, height; - void* subwindow; /* specific devices can use this as necessary */ - int being_displayed; /* used to detect when needs to be unmapped */ - struct - { - Lisp_Object face; /* foreground and background colors */ - Lisp_Object type; - Lisp_Object props; /* properties */ - struct gui_item gui_item; - } widget; /* widgets are subwindows */ - } subwindow; - } u; - - /* console-type- and image-type-specific data */ - void *data; -}; - -#define IMAGE_INSTANCE_DEVICE(i) ((i)->device) -#define IMAGE_INSTANCE_NAME(i) ((i)->name) -#define IMAGE_INSTANCE_TYPE(i) ((i)->type) -#define IMAGE_INSTANCE_PIXMAP_TYPE_P(i) \ - ((IMAGE_INSTANCE_TYPE (i) == IMAGE_MONO_PIXMAP) \ - || (IMAGE_INSTANCE_TYPE (i) == IMAGE_COLOR_PIXMAP)) - -#define IMAGE_INSTANCE_TEXT_STRING(i) ((i)->u.text.string) - -#define IMAGE_INSTANCE_PIXMAP_WIDTH(i) ((i)->u.pixmap.width) -#define IMAGE_INSTANCE_PIXMAP_HEIGHT(i) ((i)->u.pixmap.height) -#define IMAGE_INSTANCE_PIXMAP_DEPTH(i) ((i)->u.pixmap.depth) -#define IMAGE_INSTANCE_PIXMAP_FILENAME(i) ((i)->u.pixmap.filename) -#define IMAGE_INSTANCE_PIXMAP_MASK_FILENAME(i) ((i)->u.pixmap.mask_filename) -#define IMAGE_INSTANCE_PIXMAP_HOTSPOT_X(i) ((i)->u.pixmap.hotspot_x) -#define IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y(i) ((i)->u.pixmap.hotspot_y) -#define IMAGE_INSTANCE_PIXMAP_FG(i) ((i)->u.pixmap.fg) -#define IMAGE_INSTANCE_PIXMAP_BG(i) ((i)->u.pixmap.bg) -#define IMAGE_INSTANCE_PIXMAP_AUXDATA(i) ((i)->u.pixmap.auxdata) - -#define IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) ((i)->u.subwindow.width) -#define IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) ((i)->u.subwindow.height) -#define IMAGE_INSTANCE_SUBWINDOW_ID(i) ((i)->u.subwindow.subwindow) -#define IMAGE_INSTANCE_SUBWINDOW_FRAME(i) ((i)->u.subwindow.frame) -#define IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ -((i)->u.subwindow.being_displayed) - -#define IMAGE_INSTANCE_WIDGET_WIDTH(i) \ - IMAGE_INSTANCE_SUBWINDOW_WIDTH(i) -#define IMAGE_INSTANCE_WIDGET_HEIGHT(i) \ - IMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) -#define IMAGE_INSTANCE_WIDGET_CALLBACK(i) \ - ((i)->u.subwindow.widget.gui_item.callback) -#define IMAGE_INSTANCE_WIDGET_TYPE(i) ((i)->u.subwindow.widget.type) -#define IMAGE_INSTANCE_WIDGET_PROPS(i) ((i)->u.subwindow.widget.props) -#define IMAGE_INSTANCE_WIDGET_FACE(i) ((i)->u.subwindow.widget.face) -#define IMAGE_INSTANCE_WIDGET_TEXT(i) ((i)->u.subwindow.widget.gui_item.name) -#define IMAGE_INSTANCE_WIDGET_ITEM(i) ((i)->u.subwindow.widget.gui_item) - -#define XIMAGE_INSTANCE_DEVICE(i) \ - IMAGE_INSTANCE_DEVICE (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_NAME(i) \ - IMAGE_INSTANCE_NAME (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_TYPE(i) \ - IMAGE_INSTANCE_TYPE (XIMAGE_INSTANCE (i)) - -#define XIMAGE_INSTANCE_TEXT_STRING(i) \ - IMAGE_INSTANCE_TEXT_STRING (XIMAGE_INSTANCE (i)) - -#define XIMAGE_INSTANCE_PIXMAP_WIDTH(i) \ - IMAGE_INSTANCE_PIXMAP_WIDTH (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_HEIGHT(i) \ - IMAGE_INSTANCE_PIXMAP_HEIGHT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_DEPTH(i) \ - IMAGE_INSTANCE_PIXMAP_DEPTH (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_FILENAME(i) \ - IMAGE_INSTANCE_PIXMAP_FILENAME (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_MASK_FILENAME(i) \ - IMAGE_INSTANCE_PIXMAP_MASK_FILENAME (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_HOTSPOT_X(i) \ - IMAGE_INSTANCE_PIXMAP_HOTSPOT_X (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_HOTSPOT_Y(i) \ - IMAGE_INSTANCE_PIXMAP_HOTSPOT_Y (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_FG(i) \ - IMAGE_INSTANCE_PIXMAP_FG (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_PIXMAP_BG(i) \ - IMAGE_INSTANCE_PIXMAP_BG (XIMAGE_INSTANCE (i)) - -#define XIMAGE_INSTANCE_WIDGET_WIDTH(i) \ - IMAGE_INSTANCE_WIDGET_WIDTH (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_HEIGHT(i) \ - IMAGE_INSTANCE_WIDGET_HEIGHT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_CALLBACK(i) \ - IMAGE_INSTANCE_WIDGET_CALLBACK (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_TYPE(i) \ - IMAGE_INSTANCE_WIDGET_TYPE (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_PROPS(i) \ - IMAGE_INSTANCE_WIDGET_PROPS (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_FACE(i) \ - IMAGE_INSTANCE_WIDGET_FACE (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_TEXT(i) \ - IMAGE_INSTANCE_WIDGET_TEXT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_WIDGET_ITEM(i) \ - IMAGE_INSTANCE_WIDGET_ITEM (XIMAGE_INSTANCE (i)) - -#define XIMAGE_INSTANCE_SUBWINDOW_WIDTH(i) \ - IMAGE_INSTANCE_SUBWINDOW_WIDTH (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_HEIGHT(i) \ - IMAGE_INSTANCE_SUBWINDOW_HEIGHT (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_ID(i) \ - IMAGE_INSTANCE_SUBWINDOW_ID (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_FRAME(i) \ - IMAGE_INSTANCE_SUBWINDOW_FRAME (XIMAGE_INSTANCE (i)) -#define XIMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP(i) \ - IMAGE_INSTANCE_SUBWINDOW_DISPLAYEDP (XIMAGE_INSTANCE (i)) - -#ifdef HAVE_XPM -Lisp_Object evaluate_xpm_color_symbols (void); -Lisp_Object pixmap_to_lisp_data (Lisp_Object name, int ok_if_data_invalid); -#endif /* HAVE_XPM */ -#ifdef HAVE_WINDOW_SYSTEM -Lisp_Object bitmap_to_lisp_data (Lisp_Object name, int *xhot, int *yhot, - int ok_if_data_invalid); -int read_bitmap_data_from_file (CONST char *filename, unsigned int *width, - unsigned int *height, unsigned char **datap, - int *x_hot, int *y_hot); -Lisp_Object xbm_mask_file_munging (Lisp_Object alist, Lisp_Object file, - Lisp_Object mask_file, - Lisp_Object console_type); -#endif - -/************************************************************************/ -/* Glyph Object */ -/************************************************************************/ - -enum glyph_type -{ - GLYPH_UNKNOWN, - GLYPH_BUFFER, - GLYPH_POINTER, - GLYPH_ICON -}; - -struct Lisp_Glyph -{ - struct lcrecord_header header; - - enum glyph_type type; - - /* specifiers: */ - Lisp_Object image; /* the actual image */ - Lisp_Object contrib_p; /* whether to figure into line height */ - Lisp_Object baseline; /* percent above baseline */ - - Lisp_Object face; /* if non-nil, face to use when displaying */ - - Lisp_Object plist; - void (*after_change) (Lisp_Object glyph, Lisp_Object property, - Lisp_Object locale); -}; - -DECLARE_LRECORD (glyph, struct Lisp_Glyph); -#define XGLYPH(x) XRECORD (x, glyph, struct Lisp_Glyph) -#define XSETGLYPH(x, p) XSETRECORD (x, p, glyph) -#define GLYPHP(x) RECORDP (x, glyph) -#define GC_GLYPHP(x) GC_RECORDP (x, glyph) -#define CHECK_GLYPH(x) CHECK_RECORD (x, glyph) -#define CONCHECK_GLYPH(x) CONCHECK_RECORD (x, glyph) - -#define CHECK_BUFFER_GLYPH(x) do { \ - CHECK_GLYPH (x); \ - if (XGLYPH (x)->type != GLYPH_BUFFER) \ - x = wrong_type_argument (Qbuffer_glyph_p, (x)); \ -} while (0) - -#define CHECK_POINTER_GLYPH(x) do { \ - CHECK_GLYPH (x); \ - if (XGLYPH (x)->type != GLYPH_POINTER) \ - x = wrong_type_argument (Qpointer_glyph_p, (x)); \ -} while (0) - -#define CHECK_ICON_GLYPH(x) do { \ - CHECK_GLYPH (x); \ - if (XGLYPH (x)->type != GLYPH_ICON) \ - x = wrong_type_argument (Qicon_glyph_p, (x)); \ -} while (0) - -#define GLYPH_TYPE(g) ((g)->type) -#define GLYPH_IMAGE(g) ((g)->image) -#define GLYPH_CONTRIB_P(g) ((g)->contrib_p) -#define GLYPH_BASELINE(g) ((g)->baseline) -#define GLYPH_FACE(g) ((g)->face) - -#define XGLYPH_TYPE(g) GLYPH_TYPE (XGLYPH (g)) -#define XGLYPH_IMAGE(g) GLYPH_IMAGE (XGLYPH (g)) -#define XGLYPH_CONTRIB_P(g) GLYPH_CONTRIB_P (XGLYPH (g)) -#define XGLYPH_BASELINE(g) GLYPH_BASELINE (XGLYPH (g)) -#define XGLYPH_FACE(g) GLYPH_FACE (XGLYPH (g)) - -extern Lisp_Object Qxpm, Qxface; -extern Lisp_Object Q_data, Q_file, Q_color_symbols, Qconst_glyph_variable; -extern Lisp_Object Qxbm, Qedit, Qgroup, Qlabel, Qcombo, Qscrollbar, Qprogress; -extern Lisp_Object Q_mask_file, Q_mask_data, Q_hotspot_x, Q_hotspot_y; -extern Lisp_Object Q_foreground, Q_background, Q_face, Q_descriptor, Q_group; -extern Lisp_Object Q_width, Q_height, Q_pixel_width, Q_pixel_height, Q_text; -extern Lisp_Object Q_items, Q_properties, Q_image, Q_percent, Qimage_conversion_error; -extern Lisp_Object Vcontinuation_glyph, Vcontrol_arrow_glyph, Vhscroll_glyph; -extern Lisp_Object Vinvisible_text_glyph, Voctal_escape_glyph, Vtruncation_glyph; -extern Lisp_Object Vxemacs_logo; - -unsigned short glyph_width (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_ascent (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_descent (Lisp_Object glyph, - Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -unsigned short glyph_height (Lisp_Object glyph, Lisp_Object frame_face, - face_index window_findex, - Lisp_Object window); -Lisp_Object glyph_baseline (Lisp_Object glyph, Lisp_Object domain); -Lisp_Object glyph_face (Lisp_Object glyph, Lisp_Object domain); -int glyph_contrib_p (Lisp_Object glyph, Lisp_Object domain); -Lisp_Object glyph_image_instance (Lisp_Object glyph, - Lisp_Object domain, - Error_behavior errb, int no_quit); -void file_or_data_must_be_present (Lisp_Object instantiator); -void data_must_be_present (Lisp_Object instantiator); -Lisp_Object make_string_from_file (Lisp_Object file); -Lisp_Object tagged_vector_to_alist (Lisp_Object vector); -Lisp_Object alist_to_tagged_vector (Lisp_Object tag, Lisp_Object alist); -void string_instantiate (Lisp_Object image_instance, Lisp_Object instantiator, - Lisp_Object pointer_fg, Lisp_Object pointer_bg, - int dest_mask, Lisp_Object domain); -Lisp_Object allocate_glyph (enum glyph_type type, - void (*after_change) (Lisp_Object glyph, - Lisp_Object property, - Lisp_Object locale)); -Lisp_Object widget_face_font_info (Lisp_Object domain, Lisp_Object face, - int *height, int *width); -void widget_text_to_pixel_conversion (Lisp_Object domain, Lisp_Object face, - int th, int tw, - int* height, int* width); - -/************************************************************************/ -/* Glyph Cachels */ -/************************************************************************/ - -typedef struct glyph_cachel glyph_cachel; -struct glyph_cachel -{ - Lisp_Object glyph; - - unsigned int updated :1; - unsigned short width; - unsigned short ascent; - unsigned short descent; -}; - -#define CONT_GLYPH_INDEX (glyph_index) 0 -#define TRUN_GLYPH_INDEX (glyph_index) 1 -#define HSCROLL_GLYPH_INDEX (glyph_index) 2 -#define CONTROL_GLYPH_INDEX (glyph_index) 3 -#define OCT_ESC_GLYPH_INDEX (glyph_index) 4 -#define INVIS_GLYPH_INDEX (glyph_index) 5 - -#define GLYPH_CACHEL(window, index) \ - Dynarr_atp (window->glyph_cachels, index) -#define GLYPH_CACHEL_GLYPH(window, index) \ - Dynarr_atp (window->glyph_cachels, index)->glyph -#define GLYPH_CACHEL_WIDTH(window, index) \ - Dynarr_atp (window->glyph_cachels, index)->width -#define GLYPH_CACHEL_ASCENT(window, index) \ - Dynarr_atp (window->glyph_cachels, index)->ascent -#define GLYPH_CACHEL_DESCENT(window, index) \ - Dynarr_atp (window->glyph_cachels, index)->descent - -void mark_glyph_cachels (glyph_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); -void mark_glyph_cachels_as_not_updated (struct window *w); -void reset_glyph_cachels (struct window *w); - -#ifdef MEMORY_USAGE_STATS -int compute_glyph_cachel_usage (glyph_cachel_dynarr *glyph_cachels, - struct overhead_stats *ovstats); -#endif /* MEMORY_USAGE_STATS */ - -/************************************************************************/ -/* Display Tables */ -/************************************************************************/ - -Lisp_Object display_table_entry (Emchar, Lisp_Object, Lisp_Object); -void get_display_tables (struct window *, face_index, - Lisp_Object *, Lisp_Object *); - -/**************************************************************************** - * Subwindow Object * - ****************************************************************************/ - -/* redisplay needs a per-frame cache of subwindows being displayed so - * that we known when to unmap them */ -typedef struct subwindow_cachel subwindow_cachel; -struct subwindow_cachel -{ - Lisp_Object subwindow; - int x, y; - int width, height; - int being_displayed; - int updated; -}; - -typedef struct -{ - Dynarr_declare (subwindow_cachel); -} subwindow_cachel_dynarr; - -void mark_subwindow_cachels (subwindow_cachel_dynarr *elements, - void (*markobj) (Lisp_Object)); -void mark_subwindow_cachels_as_not_updated (struct frame *f); -void reset_subwindow_cachels (struct frame *f); -void unmap_subwindow (Lisp_Object subwindow); -void map_subwindow (Lisp_Object subwindow, int x, int y); -void update_frame_subwindows (struct frame *f); - -#endif /* _XEMACS_GLYPHS_H_ */ diff --git a/src/gmalloc.c b/src/gmalloc.c deleted file mode 100644 index 3aad687..0000000 --- a/src/gmalloc.c +++ /dev/null @@ -1,1389 +0,0 @@ -/* Synched up with: Not synched up with FSF 19.28, even though I - thought I did so. */ - -/* Get the configuration files if we're being compiled for Emacs. */ -#ifdef emacs -# include -# include "getpagesize.h" -# ifndef HAVE_CONFIG_H -# define HAVE_CONFIG_H -# endif -#endif - -#if defined (__STDC__) && !defined (STDC_HEADERS) - /* The ANSI standard says that defining __STDC__ to a non-zero value means - that the compiler conforms to that standard. The standard requires - certain header files and library functions to be present. Therefore, - if your compiler defines __STDC__ to non-0 but does not have ANSI headers - and the ANSI library routines, then your compiler is buggy. Conversely, - an ANSI-conforming environment (which has both the ANSI headers and - library routines, i.e., stdlib.h and `memmove') does not necessarily - define the STDC_HEADERS flag. Lucid Emacs requires an ANSI compiler. - Therefore, there is no need to consult the abominable STDC_HEADERS flag. - -- jwz - */ -# define STDC_HEADERS -#endif - -#define __const const - - -/* DO NOT EDIT THIS FILE -- it is automagically generated. -*- C -*- */ -/* Bwaa-haa-haa! Not a chance that this is actually true! */ - -#define _MALLOC_INTERNAL - -/* The malloc headers and source files from the C library follow here. */ - -/* Declarations for `malloc' and friends. - Copyright 1990, 1991, 1992, 1993 Free Software Foundation, Inc. - Written May 1989 by Mike Haertel. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#ifndef _MALLOC_H - -#define _MALLOC_H 1 - -#ifdef _MALLOC_INTERNAL - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#endif - -#endif /* _MALLOC_INTERNAL. */ - - -#ifdef __cplusplus -extern "C" -{ -#endif - -#undef __P -#define __P(args) args -#undef __ptr_t -#define __ptr_t void * - -#include -#define __malloc_size_t size_t - -#ifndef NULL -#define NULL 0 -#endif - -/* XEmacs: I thought this should be int under SunOS, but that - apparently fails. Curses on all this shit. */ -#define __free_ret_t void - -/* XEmacs: I tried commenting these out and including stdlib.h, - but that fails badly. Urk! This sucks. */ -/* Allocate SIZE bytes of memory. */ -extern __ptr_t malloc __P ((size_t __size)); -/* Re-allocate the previously allocated block - in __ptr_t, making the new block SIZE bytes long. */ -extern __ptr_t realloc __P ((__ptr_t __ptr, size_t __size)); -/* Allocate NMEMB elements of SIZE bytes each, all initialized to 0. */ -extern __ptr_t calloc __P ((size_t __nmemb, size_t __size)); -/* Free a block allocated by `malloc', `realloc' or `calloc'. */ -extern __free_ret_t free __P ((__ptr_t __ptr)); - -/* Allocate SIZE bytes allocated to ALIGNMENT bytes. */ -extern __ptr_t memalign __P ((size_t __alignment, size_t __size)); - -/* Allocate SIZE bytes on a page boundary. */ -extern __ptr_t valloc __P ((size_t __size)); - - -#ifdef _MALLOC_INTERNAL - -/* The allocator divides the heap into blocks of fixed size; large - requests receive one or more whole blocks, and small requests - receive a fragment of a block. Fragment sizes are powers of two, - and all fragments of a block are the same size. When all the - fragments in a block have been freed, the block itself is freed. */ -#define INT_BIT (CHAR_BIT * sizeof(int)) -#define BLOCKLOG (INT_BIT > 16 ? 12 : 9) -#define BLOCKSIZE (1 << BLOCKLOG) -#define BLOCKIFY(SIZE) (((SIZE) + BLOCKSIZE - 1) / BLOCKSIZE) - -/* Determine the amount of memory spanned by the initial heap table - (not an absolute limit). */ -#define HEAP (INT_BIT > 16 ? 4194304 : 65536) - -/* Number of contiguous free blocks allowed to build up at the end of - memory before they will be returned to the system. */ -#define FINAL_FREE_BLOCKS 8 - -/* Data structure giving per-block information. */ -typedef union - { - /* Heap information for a busy block. */ - struct - { - /* Zero for a large block, or positive giving the - logarithm to the base two of the fragment size. */ - int type; - union - { - struct - { - __malloc_size_t nfree; /* Free frags in a fragmented block. */ - __malloc_size_t first; /* First free fragment of the block. */ - } frag; - /* Size (in blocks) of a large cluster. */ - __malloc_size_t size; - } info; - } busy; - /* Heap information for a free block - (that may be the first of a free cluster). */ - struct - { - __malloc_size_t size; /* Size (in blocks) of a free cluster. */ - __malloc_size_t next; /* Index of next free cluster. */ - __malloc_size_t prev; /* Index of previous free cluster. */ - } free; - } malloc_info; - -/* Pointer to first block of the heap. */ -extern char *_heapbase; - -/* Table indexed by block number giving per-block information. */ -extern malloc_info *_heapinfo; - -/* Address to block number and vice versa. */ -#define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1) -#define ADDRESS(B) ((__ptr_t) (((B) - 1) * BLOCKSIZE + _heapbase)) - -/* Current search index for the heap table. */ -extern __malloc_size_t _heapindex; - -/* Limit of valid info table indices. */ -extern __malloc_size_t _heaplimit; - -/* Doubly linked lists of free fragments. */ -struct list -{ - struct list *next; - struct list *prev; -}; - -/* Free list headers for each fragment size. */ -extern struct list _fraghead[]; - -/* List of blocks allocated with `memalign' (or `valloc'). */ -struct alignlist -{ - struct alignlist *next; - __ptr_t aligned; /* The address that memaligned returned. */ - __ptr_t exact; /* The address that malloc returned. */ -}; -extern struct alignlist *_aligned_blocks; - -/* Instrumentation. */ -extern __malloc_size_t _chunks_used; -extern __malloc_size_t _bytes_used; -extern __malloc_size_t _chunks_free; -extern __malloc_size_t _bytes_free; - -/* Internal version of `free' used in `morecore' (malloc.c). */ -extern void _free_internal __P ((__ptr_t __ptr)); - -#endif /* _MALLOC_INTERNAL. */ - -/* Underlying allocation function; successive calls should - return contiguous pieces of memory. */ -extern __ptr_t (*__morecore) __P ((ptrdiff_t __size)); - -/* Default value of `__morecore'. */ -extern __ptr_t __default_morecore __P ((ptrdiff_t __size)); - -/* If not NULL, this function is called after each time - `__morecore' is called to increase the data size. */ -extern void (*__after_morecore_hook) __P ((void)); - -/* Nonzero if `malloc' has been called and done its initialization. */ - /* extern int __malloc_initialized; */ - -/* Hooks for debugging versions. */ -extern void (*__free_hook) __P ((__ptr_t __ptr)); -extern __ptr_t (*__malloc_hook) __P ((size_t __size)); -extern __ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, size_t __size)); - -/* Return values for `mprobe': these are the kinds of inconsistencies that - `mcheck' enables detection of. */ -enum mcheck_status -{ - MCHECK_DISABLED = -1, /* Consistency checking is not turned on. */ - MCHECK_OK, /* Block is fine. */ - MCHECK_FREE, /* Block freed twice. */ - MCHECK_HEAD, /* Memory before the block was clobbered. */ - MCHECK_TAIL /* Memory after the block was clobbered. */ -}; - -/* Activate a standard collection of debugging hooks. This must be called - before `malloc' is ever called. ABORTFUNC is called with an error code - (see enum above) when an inconsistency is detected. If ABORTFUNC is - null, the standard function prints on stderr and then calls `abort'. */ -extern int mcheck __P ((void (*__abortfunc) __P ((enum mcheck_status)))); - -/* Check for aberrations in a particular malloc'd block. You must have - called `mcheck' already. These are the same checks that `mcheck' does - when you free or reallocate a block. */ -extern enum mcheck_status mprobe __P ((__ptr_t __ptr)); - -/* Activate a standard collection of tracing hooks. */ -extern void mtrace __P ((void)); -extern void muntrace __P ((void)); - -/* Statistics available to the user. */ -struct mstats -{ - __malloc_size_t bytes_total; /* Total size of the heap. */ - __malloc_size_t chunks_used; /* Chunks allocated by the user. */ - __malloc_size_t bytes_used; /* Byte total of user-allocated chunks. */ - __malloc_size_t chunks_free; /* Chunks in the free list. */ - __malloc_size_t bytes_free; /* Byte total of chunks in the free list. */ -}; - -/* Pick up the current statistics. */ -extern struct mstats mstats __P ((void)); - -/* Call WARNFUN with a warning message when memory usage is high. */ -extern void memory_warnings __P ((__ptr_t __start, - void (*__warnfun) __P ((__const char *)))); - - -#if 0 /* unused in this file, and conflicting prototypes anyway */ -/* Relocating allocator. */ - -/* Allocate SIZE bytes, and store the address in *HANDLEPTR. */ -extern __ptr_t r_alloc __P ((__ptr_t *__handleptr, size_t __size)); - -/* Free the storage allocated in HANDLEPTR. */ -extern void r_alloc_free __P ((__ptr_t *__handleptr)); - -/* Adjust the block at HANDLEPTR to be SIZE bytes long. */ -extern __ptr_t r_re_alloc __P ((__ptr_t *__handleptr, size_t __size)); -#endif /* 0 */ - -#ifdef __cplusplus -} -#endif - -#endif /* malloc.h */ -/* Allocate memory on a page boundary. - Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#if defined (__GNU_LIBRARY__) || defined (_LIBC) -#include -#include -#if ! (defined (__GLIBC__) && (__GLIBC__ >= 2)) -extern size_t __getpagesize __P ((void)); -#endif -#else -#include "getpagesize.h" -#define __getpagesize() getpagesize() -#endif - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -static __malloc_size_t pagesize; - -__ptr_t -valloc (__malloc_size_t size) -{ - if (pagesize == 0) - pagesize = __getpagesize (); - - return memalign (pagesize, size); -} -/* Memory allocator `malloc'. - Copyright 1990, 1991, 1992, 1993, 1994 Free Software Foundation - Written May 1989 by Mike Haertel. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -/* How to really get more memory. */ -#ifdef HEAP_IN_DATA -/* once dumped, free() & realloc() on static heap space will fail */ -#define PURE_DATA(x) \ -((static_heap_dumped && (char*)x >= static_heap_base \ - && (char*)x <= (static_heap_base + static_heap_size) ) ? 1 : 0) -extern int initialized; -extern int purify_flag; -extern char* static_heap_base; -extern char* static_heap_ptr; -extern char* static_heap_dumped; -extern unsigned long static_heap_size; -extern __ptr_t more_static_core __P ((ptrdiff_t __size)); -__ptr_t (*__morecore) __P ((ptrdiff_t __size)) = more_static_core; -#else -__ptr_t (*__morecore) __P ((ptrdiff_t __size)) = __default_morecore; -#define PURE_DATA(x) 0 -#endif - -/* Debugging hook for `malloc'. */ -__ptr_t (*__malloc_hook) __P ((__malloc_size_t __size)); - -/* Pointer to the base of the first block. */ -char *_heapbase; - -/* Block information table. Allocated with align/__free (not malloc/free). */ -malloc_info *_heapinfo; - -/* Number of info entries. */ -static __malloc_size_t heapsize; - -/* Search index in the info table. */ -__malloc_size_t _heapindex; - -/* Limit of valid info table indices. */ -__malloc_size_t _heaplimit; - -/* Free lists for each fragment size. */ -struct list _fraghead[BLOCKLOG]; - -/* Instrumentation. */ -__malloc_size_t _chunks_used; -__malloc_size_t _bytes_used; -__malloc_size_t _chunks_free; -__malloc_size_t _bytes_free; - -/* Are you experienced? */ -int __malloc_initialized; - -void (*__after_morecore_hook) __P ((void)); - -/* Aligned allocation. */ -static __ptr_t align __P ((__malloc_size_t)); -static __ptr_t -align (__malloc_size_t size) -{ - __ptr_t result; - unsigned long int adj; - - result = (*__morecore) (size); - adj = (unsigned long int) ((unsigned long int) ((char *) result - - (char *) NULL)) % BLOCKSIZE; - if (adj != 0) - { - adj = BLOCKSIZE - adj; - (void) (*__morecore) (adj); - result = (char *) result + adj; - } - - if (__after_morecore_hook) - (*__after_morecore_hook) (); - - return result; -} - -/* Set everything up and remember that we have. */ -static int initialize __P ((void)); -static int -initialize () -{ -#ifdef HEAP_IN_DATA - if (static_heap_dumped && __morecore == more_static_core) - { - __morecore = __default_morecore; - } -#endif - heapsize = HEAP / BLOCKSIZE; - _heapinfo = (malloc_info *) align (heapsize * sizeof (malloc_info)); - if (_heapinfo == NULL) - return 0; - memset (_heapinfo, 0, heapsize * sizeof (malloc_info)); - memset (_fraghead, 0, BLOCKLOG * sizeof (struct list)); - _heapinfo[0].free.size = 0; - _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; - _heapindex = 0; - _heaplimit = 0; - _heapbase = (char *) _heapinfo; - - /* Account for the _heapinfo block itself in the statistics. */ - _bytes_used = heapsize * sizeof (malloc_info); - _chunks_used = 1; - _chunks_free=0; - _bytes_free=0; - _aligned_blocks=0; - - __malloc_initialized = 1; - return 1; -} - -/* Get neatly aligned memory, initializing or - growing the heap info table as necessary. */ -static __ptr_t morecore __P ((__malloc_size_t)); -static __ptr_t -morecore (__malloc_size_t size) -{ - __ptr_t result; - malloc_info *newinfo, *oldinfo; - __malloc_size_t newsize; - - result = align (size); - if (result == NULL) - return NULL; - - /* Check if we need to grow the info table. */ - if ((__malloc_size_t) BLOCK ((char *) result + size) > heapsize) - { - newsize = heapsize; - while ((__malloc_size_t) BLOCK ((char *) result + size) > newsize) - newsize *= 2; - newinfo = (malloc_info *) align (newsize * sizeof (malloc_info)); - if (newinfo == NULL) - { - (*__morecore) (-(int)size); - return NULL; - } - memcpy (newinfo, _heapinfo, heapsize * sizeof (malloc_info)); - memset (&newinfo[heapsize], 0, - (newsize - heapsize) * sizeof (malloc_info)); - oldinfo = _heapinfo; - newinfo[BLOCK (oldinfo)].busy.type = 0; - newinfo[BLOCK (oldinfo)].busy.info.size - = BLOCKIFY (heapsize * sizeof (malloc_info)); - _heapinfo = newinfo; - /* Account for the _heapinfo block itself in the statistics. */ - _bytes_used += newsize * sizeof (malloc_info); - ++_chunks_used; - _free_internal (oldinfo); - heapsize = newsize; - } - - _heaplimit = BLOCK ((char *) result + size); - return result; -} - -/* Allocate memory from the heap. */ -__ptr_t -malloc (__malloc_size_t size) -{ - __ptr_t result; - __malloc_size_t block, blocks, lastblocks, start; - __malloc_size_t i; - struct list *next; - - /* ANSI C allows `malloc (0)' to either return NULL, or to return a - valid address you can realloc and free (though not dereference). - - It turns out that some extant code (sunrpc, at least Ultrix's version) - expects `malloc (0)' to return non-NULL and breaks otherwise. - Be compatible. */ - -#ifdef HAVE_X_WINDOWS - /* there is at least one Xt bug where calloc(n,x) is blindly called - where n can be 0, and yet if 0 is returned, Xt barfs */ - if (size == 0) - size = sizeof (struct list); -#else - if (size == 0) - return NULL; -#endif - - if (__malloc_hook != NULL) - return (*__malloc_hook) (size); - - if (!__malloc_initialized) - if (!initialize ()) - return NULL; - -#ifdef SUNOS_LOCALTIME_BUG - /* Workaround for localtime() allocating 8 bytes and writing 9 bug... */ - if (size < 16) - size = 16; -#endif - - if (size < sizeof (struct list)) - size = sizeof (struct list); - - /* Determine the allocation policy based on the request size. */ - if (size <= BLOCKSIZE / 2) - { - /* Small allocation to receive a fragment of a block. - Determine the logarithm to base two of the fragment size. */ - __malloc_size_t log = 1; - --size; - while ((size /= 2) != 0) - ++log; - - /* Look in the fragment lists for a - free fragment of the desired size. */ - next = _fraghead[log].next; - if (next != NULL) - { - /* There are free fragments of this size. - Pop a fragment out of the fragment list and return it. - Update the block's nfree and first counters. */ - result = (__ptr_t) next; - next->prev->next = next->next; - if (next->next != NULL) - next->next->prev = next->prev; - block = BLOCK (result); - if (--_heapinfo[block].busy.info.frag.nfree != 0) - _heapinfo[block].busy.info.frag.first = (unsigned long int) - ((unsigned long int) ((char *) next->next - (char *) NULL) - % BLOCKSIZE) >> log; - - /* Update the statistics. */ - ++_chunks_used; - _bytes_used += 1 << log; - --_chunks_free; - _bytes_free -= 1 << log; - } - else - { - /* No free fragments of the desired size, so get a new block - and break it into fragments, returning the first. */ - result = malloc (BLOCKSIZE); - if (result == NULL) - return NULL; - - /* Link all fragments but the first into the free list. */ - for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> log); ++i) - { - next = (struct list *) ((char *) result + (i << log)); - next->next = _fraghead[log].next; - next->prev = &_fraghead[log]; - next->prev->next = next; - if (next->next != NULL) - next->next->prev = next; - } - - /* Initialize the nfree and first counters for this block. */ - block = BLOCK (result); - _heapinfo[block].busy.type = log; - _heapinfo[block].busy.info.frag.nfree = i - 1; - _heapinfo[block].busy.info.frag.first = i - 1; - - _chunks_free += (BLOCKSIZE >> log) - 1; - _bytes_free += BLOCKSIZE - (1 << log); - _bytes_used -= BLOCKSIZE - (1 << log); - } - } - else - { - /* Large allocation to receive one or more blocks. - Search the free list in a circle starting at the last place visited. - If we loop completely around without finding a large enough - space we will have to get more memory from the system. */ - blocks = BLOCKIFY (size); - start = block = _heapindex; - while (_heapinfo[block].free.size < blocks) - { - block = _heapinfo[block].free.next; - if (block == start) - { - /* Need to get more from the system. Check to see if - the new core will be contiguous with the final free - block; if so we don't need to get as much. */ - block = _heapinfo[0].free.prev; - lastblocks = _heapinfo[block].free.size; - if (_heaplimit != 0 && block + lastblocks == _heaplimit && - (*__morecore) (0) == ADDRESS (block + lastblocks) && - (morecore ((blocks - lastblocks) * BLOCKSIZE)) != NULL) - { - /* Which block we are extending (the `final free - block' referred to above) might have changed, if - it got combined with a freed info table. */ - block = _heapinfo[0].free.prev; - _heapinfo[block].free.size += (blocks - lastblocks); - _bytes_free += (blocks - lastblocks) * BLOCKSIZE; - continue; - } - result = morecore (blocks * BLOCKSIZE); - if (result == NULL) - return NULL; - block = BLOCK (result); - _heapinfo[block].busy.type = 0; - _heapinfo[block].busy.info.size = blocks; - ++_chunks_used; - _bytes_used += blocks * BLOCKSIZE; - return result; - } - } - - /* At this point we have found a suitable free list entry. - Figure out how to remove what we need from the list. */ - result = ADDRESS (block); - if (_heapinfo[block].free.size > blocks) - { - /* The block we found has a bit left over, - so relink the tail end back into the free list. */ - _heapinfo[block + blocks].free.size - = _heapinfo[block].free.size - blocks; - _heapinfo[block + blocks].free.next - = _heapinfo[block].free.next; - _heapinfo[block + blocks].free.prev - = _heapinfo[block].free.prev; - _heapinfo[_heapinfo[block].free.prev].free.next - = _heapinfo[_heapinfo[block].free.next].free.prev - = _heapindex = block + blocks; - } - else - { - /* The block exactly matches our requirements, - so just remove it from the list. */ - _heapinfo[_heapinfo[block].free.next].free.prev - = _heapinfo[block].free.prev; - _heapinfo[_heapinfo[block].free.prev].free.next - = _heapindex = _heapinfo[block].free.next; - --_chunks_free; - } - - _heapinfo[block].busy.type = 0; - _heapinfo[block].busy.info.size = blocks; - ++_chunks_used; - _bytes_used += blocks * BLOCKSIZE; - _bytes_free -= blocks * BLOCKSIZE; - } - - return result; -} - -#ifndef _LIBC - -/* On some ANSI C systems, some libc functions call _malloc, _free - and _realloc. Make them use the GNU functions. */ - -__ptr_t _malloc (__malloc_size_t size); -__ptr_t -_malloc (__malloc_size_t size) -{ - return malloc (size); -} - -void _free (__ptr_t ptr); -void -_free (__ptr_t ptr) -{ - free (ptr); -} - -__ptr_t _realloc (__ptr_t ptr, __malloc_size_t size); -__ptr_t -_realloc (__ptr_t ptr, __malloc_size_t size) -{ - return realloc (ptr, size); -} - -#endif -/* Free a block of memory allocated by `malloc'. - Copyright 1990, 1991, 1992, 1994 Free Software Foundation - Written May 1989 by Mike Haertel. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -/* Debugging hook for free. */ -void (*__free_hook) __P ((__ptr_t __ptr)); - -/* List of blocks allocated by memalign. */ -struct alignlist *_aligned_blocks = NULL; - -/* Return memory to the heap. - Like `free' but don't call a __free_hook if there is one. */ -void -_free_internal (__ptr_t ptr) -{ - int type; - __malloc_size_t block, blocks; - __malloc_size_t i; - struct list *prev, *next; - - block = BLOCK (ptr); - - type = _heapinfo[block].busy.type; - switch (type) - { - case 0: - /* Get as many statistics as early as we can. */ - --_chunks_used; - _bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE; - _bytes_free += _heapinfo[block].busy.info.size * BLOCKSIZE; - - /* Find the free cluster previous to this one in the free list. - Start searching at the last block referenced; this may benefit - programs with locality of allocation. */ - i = _heapindex; - if (i > block) - while (i > block) - i = _heapinfo[i].free.prev; - else - { - do - i = _heapinfo[i].free.next; - while (i > 0 && i < block); - i = _heapinfo[i].free.prev; - } - - /* Determine how to link this block into the free list. */ - if (block == i + _heapinfo[i].free.size) - { - /* Coalesce this block with its predecessor. */ - _heapinfo[i].free.size += _heapinfo[block].busy.info.size; - block = i; - } - else - { - /* Really link this block back into the free list. */ - _heapinfo[block].free.size = _heapinfo[block].busy.info.size; - _heapinfo[block].free.next = _heapinfo[i].free.next; - _heapinfo[block].free.prev = i; - _heapinfo[i].free.next = block; - _heapinfo[_heapinfo[block].free.next].free.prev = block; - ++_chunks_free; - } - - /* Now that the block is linked in, see if we can coalesce it - with its successor (by deleting its successor from the list - and adding in its size). */ - if (block + _heapinfo[block].free.size == _heapinfo[block].free.next) - { - _heapinfo[block].free.size - += _heapinfo[_heapinfo[block].free.next].free.size; - _heapinfo[block].free.next - = _heapinfo[_heapinfo[block].free.next].free.next; - _heapinfo[_heapinfo[block].free.next].free.prev = block; - --_chunks_free; - } - - /* Now see if we can return stuff to the system. */ - blocks = _heapinfo[block].free.size; - if (blocks >= FINAL_FREE_BLOCKS && block + blocks == _heaplimit - && (*__morecore) (0) == ADDRESS (block + blocks)) - { - __malloc_size_t bytes = blocks * BLOCKSIZE; - _heaplimit -= blocks; - (*__morecore) (-(int)bytes); - _heapinfo[_heapinfo[block].free.prev].free.next - = _heapinfo[block].free.next; - _heapinfo[_heapinfo[block].free.next].free.prev - = _heapinfo[block].free.prev; - block = _heapinfo[block].free.prev; - --_chunks_free; - _bytes_free -= bytes; - } - - /* Set the next search to begin at this block. */ - _heapindex = block; - break; - - default: - /* Do some of the statistics. */ - --_chunks_used; - _bytes_used -= 1 << type; - ++_chunks_free; - _bytes_free += 1 << type; - - /* Get the address of the first free fragment in this block. */ - prev = (struct list *) ((char *) ADDRESS (block) + - (_heapinfo[block].busy.info.frag.first << type)); - - if (_heapinfo[block].busy.info.frag.nfree == (BLOCKSIZE >> type) - 1) - { - /* If all fragments of this block are free, remove them - from the fragment list and free the whole block. */ - next = prev; - for (i = 1; i < (__malloc_size_t) (BLOCKSIZE >> type); ++i) - next = next->next; - prev->prev->next = next; - if (next != NULL) - next->prev = prev->prev; - _heapinfo[block].busy.type = 0; - _heapinfo[block].busy.info.size = 1; - - /* Keep the statistics accurate. */ - ++_chunks_used; - _bytes_used += BLOCKSIZE; - _chunks_free -= BLOCKSIZE >> type; - _bytes_free -= BLOCKSIZE; - - free (ADDRESS (block)); - } - else if (_heapinfo[block].busy.info.frag.nfree != 0) - { - /* If some fragments of this block are free, link this - fragment into the fragment list after the first free - fragment of this block. */ - next = (struct list *) ptr; - next->next = prev->next; - next->prev = prev; - prev->next = next; - if (next->next != NULL) - next->next->prev = next; - ++_heapinfo[block].busy.info.frag.nfree; - } - else - { - /* No fragments of this block are free, so link this - fragment into the fragment list and announce that - it is the first free fragment of this block. */ - prev = (struct list *) ptr; - _heapinfo[block].busy.info.frag.nfree = 1; - _heapinfo[block].busy.info.frag.first = (unsigned long int) - ((unsigned long int) ((char *) ptr - (char *) NULL) - % BLOCKSIZE >> type); - prev->next = _fraghead[type].next; - prev->prev = &_fraghead[type]; - prev->prev->next = prev; - if (prev->next != NULL) - prev->next->prev = prev; - } - break; - } -} - -/* Return memory to the heap. */ -__free_ret_t -free (__ptr_t ptr) -{ - struct alignlist *l; - - if (ptr == NULL) - return; - - if (PURE_DATA(ptr)) - { - return; - } - - for (l = _aligned_blocks; l != NULL; l = l->next) - if (l->aligned == ptr) - { - l->aligned = NULL; /* Mark the slot in the list as free. */ - ptr = l->exact; - break; - } - - if (__free_hook != NULL) - (*__free_hook) (ptr); - else - _free_internal (ptr); -} -/* Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc. -This file is part of the GNU C Library. - -The GNU C Library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -The GNU C Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -#ifdef _LIBC - -#include -#include - -#undef cfree - -function_alias(cfree, free, void, (ptr), - DEFUN(cfree, (ptr), PTR ptr)) - -#else - -void cfree (__ptr_t ptr); -void -cfree (__ptr_t ptr) -{ - free (ptr); -} - -#endif -/* Change the size of a block allocated by `malloc'. - Copyright 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - Written May 1989 by Mike Haertel. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -#if 0 /* FSFmacs */ -/* XEmacs requires an ANSI compiler, and memmove() is part of the ANSI- - mandated functions. For losing systems like SunOS 4, we provide - our own memmove(). */ - -#if (defined (MEMMOVE_MISSING) || \ - !defined(_LIBC) && !defined(STDC_HEADERS) && !defined(USG)) - -/* Snarfed directly from Emacs src/dispnew.c: - XXX Should use system bcopy if it handles overlap. */ -#ifndef emacs - -/* Like bcopy except never gets confused by overlap. */ - -static void -safe_bcopy (char *from, char *to, int size) -{ - if (size <= 0 || from == to) - return; - - /* If the source and destination don't overlap, then bcopy can - handle it. If they do overlap, but the destination is lower in - memory than the source, we'll assume bcopy can handle that. */ - if (to < from || from + size <= to) - bcopy (from, to, size); - - /* Otherwise, we'll copy from the end. */ - else - { - char *endf = from + size; - char *endt = to + size; - - /* If TO - FROM is large, then we should break the copy into - nonoverlapping chunks of TO - FROM bytes each. However, if - TO - FROM is small, then the bcopy function call overhead - makes this not worth it. The crossover point could be about - anywhere. Since I don't think the obvious copy loop is too - bad, I'm trying to err in its favor. */ - if (to - from < 64) - { - do - *--endt = *--endf; - while (endf != from); - } - else - { - for (;;) - { - endt -= (to - from); - endf -= (to - from); - - if (endt < to) - break; - - bcopy (endf, endt, to - from); - } - - /* If SIZE wasn't a multiple of TO - FROM, there will be a - little left over. The amount left over is - (endt + (to - from)) - to, which is endt - from. */ - bcopy (from, to, endt - from); - } - } -} -#endif /* Not emacs. */ - -#define memmove(to, from, size) safe_bcopy ((from), (to), (size)) - -#endif - -#endif /* FSFmacs */ - - -#ifndef min -#define min(A, B) ((A) < (B) ? (A) : (B)) -#endif - -/* Debugging hook for realloc. */ -__ptr_t (*__realloc_hook) __P ((__ptr_t __ptr, __malloc_size_t __size)); - -/* Resize the given region to the new size, returning a pointer - to the (possibly moved) region. This is optimized for speed; - some benchmarks seem to indicate that greater compactness is - achieved by unconditionally allocating and copying to a - new region. This module has incestuous knowledge of the - internals of both free and malloc. */ -__ptr_t -realloc (__ptr_t ptr, __malloc_size_t size) -{ - __ptr_t result; - int type; - __malloc_size_t block, blocks, oldlimit; - - if (PURE_DATA(ptr)) - { - result = malloc (size); - memcpy(result, ptr, size); - return result; - } - - else if (size == 0) - { - free (ptr); - return malloc (0); - } - else if (ptr == NULL) - return malloc (size); - - if (__realloc_hook != NULL) - return (*__realloc_hook) (ptr, size); - - block = BLOCK (ptr); - - type = _heapinfo[block].busy.type; - switch (type) - { - case 0: - /* Maybe reallocate a large block to a small fragment. */ - if (size <= BLOCKSIZE / 2) - { - result = malloc (size); - if (result != NULL) - { - memcpy (result, ptr, size); - _free_internal (ptr); - return result; - } - } - - /* The new size is a large allocation as well; - see if we can hold it in place. */ - blocks = BLOCKIFY (size); - if (blocks < _heapinfo[block].busy.info.size) - { - /* The new size is smaller; return - excess memory to the free list. */ - _heapinfo[block + blocks].busy.type = 0; - _heapinfo[block + blocks].busy.info.size - = _heapinfo[block].busy.info.size - blocks; - _heapinfo[block].busy.info.size = blocks; - /* We have just created a new chunk by splitting a chunk in two. - Now we will free this chunk; increment the statistics counter - so it doesn't become wrong when _free_internal decrements it. */ - ++_chunks_used; - _free_internal (ADDRESS (block + blocks)); - result = ptr; - } - else if (blocks == _heapinfo[block].busy.info.size) - /* No size change necessary. */ - result = ptr; - else - { - /* Won't fit, so allocate a new region that will. - Free the old region first in case there is sufficient - adjacent free space to grow without moving. */ - blocks = _heapinfo[block].busy.info.size; - /* Prevent free from actually returning memory to the system. */ - oldlimit = _heaplimit; - _heaplimit = 0; - free (ptr); - _heaplimit = oldlimit; - result = malloc (size); - if (result == NULL) - { - /* Now we're really in trouble. We have to unfree - the thing we just freed. Unfortunately it might - have been coalesced with its neighbors. */ - if (_heapindex == block) - (void) malloc (blocks * BLOCKSIZE); - else - { - __ptr_t previous = malloc ((block - _heapindex) * BLOCKSIZE); - (void) malloc (blocks * BLOCKSIZE); - free (previous); - } - return NULL; - } - if (ptr != result) - memmove (result, ptr, blocks * BLOCKSIZE); - } - break; - - default: - /* Old size is a fragment; type is logarithm - to base two of the fragment size. */ - if (size > (__malloc_size_t) (1 << (type - 1)) && - size <= (__malloc_size_t) (1 << type)) - /* The new size is the same kind of fragment. */ - result = ptr; - else - { - /* The new size is different; allocate a new space, - and copy the lesser of the new size and the old. */ - result = malloc (size); - if (result == NULL) - return NULL; - memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); - free (ptr); - } - break; - } - - return result; -} -/* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. - - The author may be reached (Email) at the address mike@ai.mit.edu, - or (US mail) as Mike Haertel c/o Free Software Foundation, Inc. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -/* Allocate an array of NMEMB elements each SIZE bytes long. - The entire array is initialized to zeros. */ -__ptr_t -calloc (__malloc_size_t nmemb, __malloc_size_t size) -{ - __ptr_t result = malloc (nmemb * size); - - if (result != NULL) - (void) memset (result, 0, nmemb * size); - - return result; -} -/* Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. -This file is part of the GNU C Library. - -The GNU C Library is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2, or (at your option) -any later version. - -The GNU C Library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with the GNU C Library; see the file COPYING. If not, write to -the Free the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -/* #ifndef __GNU_LIBRARY__ */ -#define __sbrk sbrk -/* #endif */ - -#ifdef GMALLOC_NEEDS_SBRK_DECL -/* some versions of OSF1 need this */ -extern __ptr_t __sbrk __P ((ssize_t increment)); -#else -#ifdef __GNU_LIBRARY__ -/* It is best not to declare this and cast its result on foreign operating - systems with potentially hostile include files. */ -#if !(defined(linux) && defined(sparc)) -extern __ptr_t __sbrk __P ((int increment)); -#endif -#endif -#endif - -#ifndef NULL -#define NULL 0 -#endif - -/* Allocate INCREMENT more bytes of data space, - and return the start of data space, or NULL on errors. - If INCREMENT is negative, shrink data space. */ -__ptr_t -__default_morecore ( -#ifdef __STDC__ - ptrdiff_t increment -#else -#ifdef OSF1 - long increment -#else - int increment -#endif -#endif - ) -{ -#ifdef OSF1 - __ptr_t result = (__ptr_t) __sbrk ((ssize_t) increment); -#else - __ptr_t result = (__ptr_t) __sbrk ((int) increment); -#endif - if (result == (__ptr_t) -1) - return NULL; - return result; -} -/* Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. - -This library is free software; you can redistribute it and/or -modify it under the terms of the GNU Library General Public License as -published by the Free Software Foundation; either version 2 of the -License, or (at your option) any later version. - -This library is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -Library General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this library; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ - -#ifndef _MALLOC_INTERNAL -#define _MALLOC_INTERNAL -#include -#endif - -__ptr_t -memalign (__malloc_size_t alignment, __malloc_size_t size) -{ - __ptr_t result; - unsigned long int adj; - - size = ((size + alignment - 1) / alignment) * alignment; - - result = malloc (size); - if (result == NULL) - return NULL; - adj = (unsigned long int) ((unsigned long int) ((char *) result - - (char *) NULL)) % alignment; - if (adj != 0) - { - struct alignlist *l; - for (l = _aligned_blocks; l != NULL; l = l->next) - if (l->aligned == NULL) - /* This slot is free. Use it. */ - break; - if (l == NULL) - { - l = (struct alignlist *) malloc (sizeof (struct alignlist)); - if (l == NULL) - { - free (result); - return NULL; - } - l->next = _aligned_blocks; - _aligned_blocks = l; - } - l->exact = result; - result = l->aligned = (char *) result + alignment - adj; - } - - return result; -} diff --git a/src/gpmevent.c b/src/gpmevent.c deleted file mode 100644 index 77f3738..0000000 --- a/src/gpmevent.c +++ /dev/null @@ -1,114 +0,0 @@ -/* William Perry 1997 */ - -#include -#include "lisp.h" -#include "console.h" -#include "console-tty.h" -#include "device.h" -#include "events.h" -#include "events-mod.h" -#include "sysdep.h" - -#ifdef HAVE_GPM -#include "gpmevent.h" -#include - -#if (!defined(__linux__)) /* possible under xterm */ -#define KG_SHIFT 0 -#define KG_CTRL 2 -#define KG_ALT 3 -#else -#include -#endif - -int -handle_gpm_read (struct Lisp_Event *event, struct console *con, int fd) -{ - Gpm_Event ev; - int modifiers = 0; - int type = -1; - int button = 1; - - if (!Gpm_GetEvent(&ev)) - return 0; - - event->timestamp = 0; - event->channel = CONSOLE_SELECTED_FRAME (con); - - /* Whow, wouldn't named defines be NICE!?!?! */ - modifiers = 0; - - if (ev.modifiers & 1) modifiers |= MOD_SHIFT; - if (ev.modifiers & 2) modifiers |= MOD_META; - if (ev.modifiers & 4) modifiers |= MOD_CONTROL; - if (ev.modifiers & 8) modifiers |= MOD_META; - - if (ev.type & GPM_DOWN) - type = GPM_DOWN; - else if (ev.type & GPM_UP) - type = GPM_UP; - else if (ev.type & GPM_MOVE) { - type = GPM_MOVE; - GPM_DRAWPOINTER(&ev); - } - - if (ev.buttons & GPM_B_LEFT) - button = 1; - else if (ev.buttons & GPM_B_MIDDLE) - button = 2; - else if (ev.buttons & GPM_B_RIGHT) - button = 3; - - switch (type) { - case GPM_DOWN: - case GPM_UP: - event->event_type = - type == GPM_DOWN ? button_press_event : button_release_event; - event->event.button.x = ev.x; - event->event.button.y = ev.y; - event->event.button.button = button; - event->event.button.modifiers = modifiers; - break; - case GPM_MOVE: - event->event_type = pointer_motion_event; - event->event.motion.x = ev.x; - event->event.motion.y = ev.y; - event->event.motion.modifiers = modifiers; - default: - return 0; - } - return 1; -} - -void -connect_to_gpm (struct console *con) -{ - /* Only do this if we are running after dumping and really interactive */ - if (!noninteractive && initialized) { - /* We really only want to do this on a TTY */ - CONSOLE_TTY_MOUSE_FD (con) = -1; - if (EQ (CONSOLE_TYPE (con), Qtty)) { - Gpm_Connect conn; - int rval; - - conn.eventMask = GPM_DOWN|GPM_UP|GPM_MOVE; - conn.defaultMask = GPM_MOVE; - conn.minMod = 0; - conn.maxMod = ((1< -#include "lisp.h" -#include "gui.h" -#include "redisplay.h" -#include "frame.h" -#include "elhash.h" -#include "console-msw.h" - -/* - * Return value is Qt if we have dispatched the command, - * or Qnil if id has not been mapped to a callback. - * Window procedure may try other targets to route the - * command if we return nil - */ -Lisp_Object -mswindows_handle_gui_wm_command (struct frame* f, HWND ctrl, WORD id) -{ - /* Try to map the command id through the proper hash table */ - Lisp_Object data, fn, arg, frame; - - data = Fgethash (make_int (id), - FRAME_MSWINDOWS_WIDGET_HASH_TABLE (f), Qnil); - - if (NILP (data) || UNBOUNDP (data)) - return Qnil; - - MARK_SUBWINDOWS_CHANGED; - /* Ok, this is our one. Enqueue it. */ - get_gui_callback (data, &fn, &arg); - XSETFRAME (frame, f); - mswindows_enqueue_misc_user_event (frame, fn, arg); - - return Qt; -} - diff --git a/src/gui-x.c b/src/gui-x.c deleted file mode 100644 index 9921504..0000000 --- a/src/gui-x.c +++ /dev/null @@ -1,632 +0,0 @@ -/* General GUI code -- X-specific. (menubars, scrollbars, toolbars, dialogs) - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1998 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. */ - -#include -#include "lisp.h" - -#include "console-x.h" -#ifdef LWLIB_USES_MOTIF -#include /* for XmVersion */ -#endif -#include "gui-x.h" -#include "buffer.h" -#include "device.h" -#include "frame.h" -#include "gui.h" -#include "opaque.h" - -#ifdef HAVE_POPUPS -Lisp_Object Qmenu_no_selection_hook; -#endif - -/* we need a unique id for each popup menu, dialog box, and scrollbar */ -static unsigned int lwlib_id_tick; - -LWLIB_ID -new_lwlib_id (void) -{ - return ++lwlib_id_tick; -} - -widget_value * -xmalloc_widget_value (void) -{ - widget_value *tmp = malloc_widget_value (); - if (!tmp) memory_full (); - return tmp; -} - - -#ifdef HAVE_POPUPS - -struct mark_widget_value_closure -{ - void (*markobj) (Lisp_Object); -}; - -static int -mark_widget_value_mapper (widget_value *val, void *closure) -{ - Lisp_Object markee; - - struct mark_widget_value_closure *cl = - (struct mark_widget_value_closure *) closure; - if (val->call_data) - { - VOID_TO_LISP (markee, val->call_data); - (cl->markobj) (markee); - } - - if (val->accel) - { - VOID_TO_LISP (markee, val->accel); - (cl->markobj) (markee); - } - return 0; -} - -static Lisp_Object -mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object)) -{ - struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj); - - /* Now mark the callbacks and such that are hidden in the lwlib - call-data */ - - if (data->id) - { - struct mark_widget_value_closure closure; - - closure.markobj = markobj; - lw_map_widget_values (data->id, mark_widget_value_mapper, &closure); - } - - return data->last_menubar_buffer; -} - -DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, - mark_popup_data, internal_object_printer, - 0, 0, 0, struct popup_data); - -/* This is like FRAME_MENUBAR_DATA (f), but contains an alist of - (id . popup-data) for GCPRO'ing the callbacks of the popup menus - and dialog boxes. */ -static Lisp_Object Vpopup_callbacks; - -void -gcpro_popup_callbacks (LWLIB_ID id) -{ - struct popup_data *pdata; - Lisp_Object lid = make_int (id); - Lisp_Object lpdata; - - assert (NILP (assq_no_quit (lid, Vpopup_callbacks))); - pdata = alloc_lcrecord_type (struct popup_data, lrecord_popup_data); - pdata->id = id; - pdata->last_menubar_buffer = Qnil; - pdata->menubar_contents_up_to_date = 0; - XSETPOPUP_DATA (lpdata, pdata); - Vpopup_callbacks = Fcons (Fcons (lid, lpdata), Vpopup_callbacks); -} - -void -ungcpro_popup_callbacks (LWLIB_ID id) -{ - Lisp_Object lid = make_int (id); - Lisp_Object this = assq_no_quit (lid, Vpopup_callbacks); - assert (!NILP (this)); - Vpopup_callbacks = delq_no_quit (this, Vpopup_callbacks); -} - -int -popup_handled_p (LWLIB_ID id) -{ - return NILP (assq_no_quit (make_int (id), Vpopup_callbacks)); -} - -/* menu_item_descriptor_to_widget_value() et al. mallocs a - widget_value, but then may signal lisp errors. If an error does - not occur, the opaque ptr we have here has had its pointer set to 0 - to tell us not to do anything. Otherwise we free the widget value. - (This has nothing to do with GC, it's just about not dropping - pointers to malloc'd data when errors happen.) */ - -Lisp_Object -widget_value_unwind (Lisp_Object closure) -{ - widget_value *wv = (widget_value *) get_opaque_ptr (closure); - free_opaque_ptr (closure); - if (wv) - free_widget_value (wv); - return Qnil; -} - -#if 0 -static void -print_widget_value (widget_value *wv, int depth) -{ - /* !!#### This function has not been Mule-ized */ - char d [200]; - int i; - for (i = 0; i < depth; i++) d[i] = ' '; - d[depth]=0; - /* #### - print type field */ - printf ("%sname: %s\n", d, (wv->name ? wv->name : "(null)")); - if (wv->value) printf ("%svalue: %s\n", d, wv->value); - if (wv->key) printf ("%skey: %s\n", d, wv->key); - printf ("%senabled: %d\n", d, wv->enabled); - if (wv->contents) - { - printf ("\n%scontents: \n", d); - print_widget_value (wv->contents, depth + 5); - } - if (wv->next) - { - printf ("\n"); - print_widget_value (wv->next, depth); - } -} -#endif - -/* This recursively calls free_widget_value() on the tree of widgets. - It must free all data that was malloc'ed for these widget_values. - - It used to be that emacs only allocated new storage for the `key' slot. - All other slots are pointers into the data of Lisp_Strings, and must be - left alone. */ -void -free_popup_widget_value_tree (widget_value *wv) -{ - if (! wv) return; - if (wv->key) xfree (wv->key); - if (wv->value) xfree (wv->value); - - wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; - - if (wv->contents && (wv->contents != (widget_value*)1)) - { - free_popup_widget_value_tree (wv->contents); - wv->contents = (widget_value *) 0xDEADBEEF; - } - if (wv->next) - { - free_popup_widget_value_tree (wv->next); - wv->next = (widget_value *) 0xDEADBEEF; - } - free_widget_value (wv); -} - -/* The following is actually called from somewhere within XtDispatchEvent(), - called from XtAppProcessEvent() in event-Xt.c */ - -void -popup_selection_callback (Widget widget, LWLIB_ID ignored_id, - XtPointer client_data) -{ - Lisp_Object fn, arg; - Lisp_Object data; - Lisp_Object frame; - struct device *d = get_device_from_display (XtDisplay (widget)); - struct frame *f = x_any_widget_or_parent_to_frame (d, widget); - - /* set in lwlib to the time stamp associated with the most recent menu - operation */ - extern Time x_focus_timestamp_really_sucks_fix_me_better; - - if (!f) - return; - if (((EMACS_INT) client_data) == 0) - return; - VOID_TO_LISP (data, client_data); - XSETFRAME (frame, f); - -#if 0 - /* #### What the hell? I can't understand why this call is here, - and doing it is really courting disaster in the new event - model, since popup_selection_callback is called from - within next_event_internal() and Faccept_process_output() - itself calls next_event_internal(). --Ben */ - - /* Flush the X and process input */ - Faccept_process_output (Qnil, Qnil, Qnil); -#endif - - if (((EMACS_INT) client_data) == -1) - { - fn = Qrun_hooks; - arg = Qmenu_no_selection_hook; - } - else - get_gui_callback (data, &fn, &arg); - - /* This is the timestamp used for asserting focus so we need to get an - up-to-date value event if no events has been dispatched to emacs - */ -#if defined(HAVE_MENUBARS) - DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; -#else - DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); -#endif - signal_special_Xt_user_event (frame, fn, arg); -} - -#if 1 - /* Eval the activep slot of the menu item */ -# define wv_set_evalable_slot(slot,form) do { \ - Lisp_Object wses_form = (form); \ - (slot) = (NILP (wses_form) ? 0 : \ - EQ (wses_form, Qt) ? 1 : \ - !NILP (Feval (wses_form))); \ -} while (0) -#else - /* Treat the activep slot of the menu item as a boolean */ -# define wv_set_evalable_slot(slot,form) \ - ((void) (slot = (!NILP (form)))) -#endif - -char * -menu_separator_style (CONST char *s) -{ - CONST char *p; - char first; - - if (!s || s[0] == '\0') - return NULL; - first = s[0]; - if (first != '-' && first != '=') - return NULL; - for (p = s; *p == first; p++) - DO_NOTHING; - - /* #### - cannot currently specify a separator tag "--!tag" and a - separator style "--:style" at the same time. */ - /* #### - Also, the motif menubar code doesn't deal with the - double etched style yet, so it's not good to get into the habit of - using "===" in menubars to get double-etched lines */ - if (*p == '!' || *p == '\0') - return ((first == '-') - ? NULL /* single etched is the default */ - : xstrdup ("shadowDoubleEtchedIn")); - else if (*p == ':') - return xstrdup (p+1); - - return NULL; -} - -/* set menu accelerator key to first underlined character in menu name */ - -Lisp_Object -menu_name_to_accelerator (char *name) -{ - while (*name) { - if (*name=='%') { - ++name; - if (!(*name)) - return Qnil; - if (*name=='_' && *(name+1)) - { - int accelerator = (int) (unsigned char) (*(name+1)); - return make_char (tolower (accelerator)); - } - } - ++name; - } - return Qnil; -} - -/* This does the dirty work. gc_currently_forbidden is 1 when this is called. - */ - -int -button_item_to_widget_value (Lisp_Object desc, widget_value *wv, - int allow_text_field_p, int no_keys_p) -{ - /* !!#### This function has not been Mule-ized */ - /* This function cannot GC because gc_currently_forbidden is set when - it's called */ - Lisp_Object name = Qnil; - Lisp_Object callback = Qnil; - Lisp_Object suffix = Qnil; - Lisp_Object active_p = Qt; - Lisp_Object include_p = Qt; - Lisp_Object selected_p = Qnil; - Lisp_Object keys = Qnil; - Lisp_Object style = Qnil; - Lisp_Object config_tag = Qnil; - Lisp_Object accel = Qnil; - int length = XVECTOR_LENGTH (desc); - Lisp_Object *contents = XVECTOR_DATA (desc); - int plist_p; - int selected_spec = 0, included_spec = 0; - - if (length < 2) - signal_simple_error ("Button descriptors must be at least 2 long", desc); - - /* length 2: [ "name" callback ] - length 3: [ "name" callback active-p ] - length 4: [ "name" callback active-p suffix ] - or [ "name" callback keyword value ] - length 5+: [ "name" callback [ keyword value ]+ ] - */ - plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); - - if (!plist_p && length > 2) - /* the old way */ - { - name = contents [0]; - callback = contents [1]; - active_p = contents [2]; - if (length == 4) - suffix = contents [3]; - } - else - { - /* the new way */ - int i; - if (length & 1) - signal_simple_error ( - "Button descriptor has an odd number of keywords and values", - desc); - - name = contents [0]; - callback = contents [1]; - for (i = 2; i < length;) - { - Lisp_Object key = contents [i++]; - Lisp_Object val = contents [i++]; - if (!KEYWORDP (key)) - signal_simple_error_2 ("Not a keyword", key, desc); - - if (EQ (key, Q_active)) active_p = val; - else if (EQ (key, Q_suffix)) suffix = val; - else if (EQ (key, Q_keys)) keys = val; - else if (EQ (key, Q_style)) style = val; - else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; - else if (EQ (key, Q_included)) include_p = val, included_spec = 1; - else if (EQ (key, Q_config)) config_tag = val; - else if (EQ (key, Q_accelerator)) - { - if ( SYMBOLP (val) - || CHARP (val)) - accel = val; - else - signal_simple_error ("Bad keyboard accelerator", val); - } - else if (EQ (key, Q_filter)) - signal_simple_error(":filter keyword not permitted on leaf nodes", desc); - else - signal_simple_error_2 ("Unknown menu item keyword", key, desc); - } - } - -#ifdef HAVE_MENUBARS - if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) - || (included_spec && NILP (Feval (include_p)))) - { - /* the include specification says to ignore this item. */ - return 0; - } -#endif /* HAVE_MENUBARS */ - - CHECK_STRING (name); - wv->name = (char *) XSTRING_DATA (name); - - if (NILP (accel)) - accel = menu_name_to_accelerator (wv->name); - wv->accel = LISP_TO_VOID (accel); - - if (!NILP (suffix)) - { - CONST char *const_bogosity; - Lisp_Object suffix2; - - /* Shortcut to avoid evaluating suffix each time */ - if (STRINGP (suffix)) - suffix2 = suffix; - else - { - suffix2 = Feval (suffix); - CHECK_STRING (suffix2); - } - - GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity); - wv->value = (char *) const_bogosity; - wv->value = xstrdup (wv->value); - } - - wv_set_evalable_slot (wv->enabled, active_p); - wv_set_evalable_slot (wv->selected, selected_p); - - wv->call_data = LISP_TO_VOID (callback); - - if (no_keys_p -#ifdef HAVE_MENUBARS - || !menubar_show_keybindings -#endif - ) - wv->key = 0; - else if (!NILP (keys)) /* Use this string to generate key bindings */ - { - CHECK_STRING (keys); - keys = Fsubstitute_command_keys (keys); - if (XSTRING_LENGTH (keys) > 0) - wv->key = xstrdup ((char *) XSTRING_DATA (keys)); - else - wv->key = 0; - } - else if (SYMBOLP (callback)) /* Show the binding of this command. */ - { - char buf [1024]; - /* #### Warning, dependency here on current_buffer and point */ - where_is_to_char (callback, buf); - if (buf [0]) - wv->key = xstrdup (buf); - else - wv->key = 0; - } - - CHECK_SYMBOL (style); - if (NILP (style)) - { - /* If the callback is nil, treat this item like unselectable text. - This way, dashes will show up as a separator. */ - if (!wv->enabled) - wv->type = BUTTON_TYPE; - if (separator_string_p (wv->name)) - { - wv->type = SEPARATOR_TYPE; - wv->value = menu_separator_style (wv->name); - } - else - { -#if 0 - /* #### - this is generally desirable for menubars, but it breaks - a package that uses dialog boxes and next_command_event magic - to use the callback slot in dialog buttons for data instead of - a real callback. - - Code is data, right? The beauty of LISP abuse. --Stig */ - if (NILP (callback)) - wv->type = TEXT_TYPE; - else -#endif - wv->type = BUTTON_TYPE; - } - } - else if (EQ (style, Qbutton)) - wv->type = BUTTON_TYPE; - else if (EQ (style, Qtoggle)) - wv->type = TOGGLE_TYPE; - else if (EQ (style, Qradio)) - wv->type = RADIO_TYPE; - else if (EQ (style, Qtext)) - { - wv->type = TEXT_TYPE; -#if 0 - wv->value = wv->name; - wv->name = "value"; -#endif - } - else - signal_simple_error_2 ("Unknown style", style, desc); - - if (!allow_text_field_p && (wv->type == TEXT_TYPE)) - signal_simple_error ("Text field not allowed in this context", desc); - - if (selected_spec && EQ (style, Qtext)) - signal_simple_error ( - ":selected only makes sense with :style toggle, radio or button", - desc); - return 1; -} - -#endif /* HAVE_POPUPS */ - -/* This is a kludge to make sure emacs can only link against a version of - lwlib that was compiled in the right way. Emacs references symbols which - correspond to the way it thinks lwlib was compiled, and if lwlib wasn't - compiled in that way, then somewhat meaningful link errors will result. - The alternatives to this range from obscure link errors, to obscure - runtime errors that look a lot like bugs. - */ - -static void -sanity_check_lwlib (void) -{ -#define MACROLET(v) { extern int v; v = 1; } - -#if (XlibSpecificationRelease == 4) - MACROLET (lwlib_uses_x11r4); -#elif (XlibSpecificationRelease == 5) - MACROLET (lwlib_uses_x11r5); -#elif (XlibSpecificationRelease == 6) - MACROLET (lwlib_uses_x11r6); -#else - MACROLET (lwlib_uses_unknown_x11); -#endif -#ifdef LWLIB_USES_MOTIF - MACROLET (lwlib_uses_motif); -#else - MACROLET (lwlib_does_not_use_motif); -#endif -#if (XmVersion >= 1002) - MACROLET (lwlib_uses_motif_1_2); -#else - MACROLET (lwlib_does_not_use_motif_1_2); -#endif -#ifdef LWLIB_MENUBARS_LUCID - MACROLET (lwlib_menubars_lucid); -#elif defined (HAVE_MENUBARS) - MACROLET (lwlib_menubars_motif); -#endif -#ifdef LWLIB_SCROLLBARS_LUCID - MACROLET (lwlib_scrollbars_lucid); -#elif defined (LWLIB_SCROLLBARS_MOTIF) - MACROLET (lwlib_scrollbars_motif); -#elif defined (HAVE_SCROLLBARS) - MACROLET (lwlib_scrollbars_athena); -#endif -#ifdef LWLIB_DIALOGS_MOTIF - MACROLET (lwlib_dialogs_motif); -#elif defined (HAVE_DIALOGS) - MACROLET (lwlib_dialogs_athena); -#endif - -#undef MACROLET -} - -void -syms_of_gui_x (void) -{ -#ifdef HAVE_POPUPS - defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); -#endif -} - -void -vars_of_gui_x (void) -{ - lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ - -#ifdef HAVE_POPUPS - popup_up_p = 0; - - Vpopup_callbacks = Qnil; - staticpro (&Vpopup_callbacks); - -#if 0 - /* This DEFVAR_LISP is just for the benefit of make-docfile. */ - /* #### misnamed */ - DEFVAR_LISP ("menu-no-selection-hook", &Vmenu_no_selection_hook /* -Function or functions to call when a menu or dialog box is dismissed -without a selection having been made. -*/ ); -#endif - Fset (Qmenu_no_selection_hook, Qnil); -#endif /* HAVE_POPUPS */ - - /* this makes only safe calls as in emacs.c */ - sanity_check_lwlib (); -} diff --git a/src/gui-x.h b/src/gui-x.h deleted file mode 100644 index ed7e4d5..0000000 --- a/src/gui-x.h +++ /dev/null @@ -1,82 +0,0 @@ -/* General GUI code -- X-specific header file. - Copyright (C) 1993, 1994 Free Software Foundation, Inc. - Copyright (C) 1996 Ben Wing. - -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. */ - -#ifndef _XEMACS_XLWLIB_H_ -#define _XEMACS_XLWLIB_H_ - -#include "../lwlib/lwlib.h" - -widget_value *xmalloc_widget_value (void); - -LWLIB_ID new_lwlib_id (void); - -#ifdef HAVE_POPUPS - -/* Each frame has one of these, and they are also contained in - Vpopup_callbacks. - It doesn't really need to be an lrecord (it's not lisp-accessible) - but it makes marking slightly more modular. - */ - -struct popup_data -{ - struct lcrecord_header header; - - /* lwlib ID of the tree of widgets corresponding to this popup. - We pass this to lw_map_widget_values() to retrieve all of our - Lispy call-data values that need to be GCPRO'd. */ - LWLIB_ID id; - - /* For the frame popup data, this is the last buffer for which the - menubar was displayed. If the buffer has changed, we may have to - update things. */ - Lisp_Object last_menubar_buffer; - - /* This flag tells us if the menubar contents are up-to-date with respect - to the current menubar structure. If we want to actually pull down a - menu and this is false, then we need to update things. */ - char menubar_contents_up_to_date; -}; - -DECLARE_LRECORD (popup_data, struct popup_data); -#define XPOPUP_DATA(x) XRECORD (x, popup_data, struct popup_data) -#define XSETPOPUP_DATA(x, p) XSETRECORD (x, p, popup_data) -#define POPUP_DATAP(x) RECORDP (x, popup_data) -#define GC_POPUP_DATAP(x) GC_RECORDP (x, popup_data) -#define CHECK_POPUP_DATA(x) CHECK_RECORD (x, popup_data) - -void gcpro_popup_callbacks (LWLIB_ID id); -void ungcpro_popup_callbacks (LWLIB_ID id); -int popup_handled_p (LWLIB_ID id); -void free_popup_widget_value_tree (widget_value *wv); -void popup_selection_callback (Widget widget, LWLIB_ID ignored_id, - XtPointer client_data); -int button_item_to_widget_value (Lisp_Object desc, widget_value *wv, - int allow_text_field_p, int no_keys_p); -Lisp_Object menu_name_to_accelerator (char *name); -char *menu_separator_style (CONST char *s); -Lisp_Object widget_value_unwind (Lisp_Object closure); - -#endif /* HAVE_POPUPS */ - -#endif /* _XEMACS_XLWLIB_H_ */ diff --git a/src/gui.c b/src/gui.c deleted file mode 100644 index 8c3bf42..0000000 --- a/src/gui.c +++ /dev/null @@ -1,434 +0,0 @@ -/* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1998 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. */ - -#include -#include "lisp.h" -#include "gui.h" -#include "elhash.h" -#include "bytecode.h" - -Lisp_Object Q_active, Q_suffix, Q_keys, Q_style, Q_selected; -Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; -Lisp_Object Q_accelerator, Q_label, Q_callback; -Lisp_Object Qtoggle, Qradio; - -#ifdef HAVE_POPUPS - -/* count of menus/dboxes currently up */ -int popup_up_p; - -DEFUN ("popup-up-p", Fpopup_up_p, 0, 0, 0, /* -Return t if a popup menu or dialog box is up, nil otherwise. -See `popup-menu' and `popup-dialog-box'. -*/ - ()) -{ - return popup_up_p ? Qt : Qnil; -} -#endif /* HAVE_POPUPS */ - -int -separator_string_p (CONST char *s) -{ - CONST char *p; - char first; - - if (!s || s[0] == '\0') - return 0; - first = s[0]; - if (first != '-' && first != '=') - return 0; - for (p = s; *p == first; p++) - ; - - return (*p == '!' || *p == ':' || *p == '\0'); -} - -/* Massage DATA to find the correct function and argument. Used by - popup_selection_callback() and the msw code. */ -void -get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) -{ - if (SYMBOLP (data) - || (COMPILED_FUNCTIONP (data) - && XCOMPILED_FUNCTION (data)->flags.interactivep) - || (EQ (XCAR (data), Qlambda) - && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) - { - *fn = Qcall_interactively; - *arg = data; - } - else if (CONSP (data)) - { - *fn = Qeval; - *arg = data; - } - else - { - *fn = Qeval; - *arg = list3 (Qsignal, - list2 (Qquote, Qerror), - list2 (Qquote, list2 (build_translated_string - ("illegal callback"), - data))); - } -} - -/* - * Initialize the gui_item structure by setting all (GC-protected) - * fields to their default values. The defaults are t for :active and - * :included values, and nil for others. - */ -void -gui_item_init (struct gui_item *pgui_item) -{ - pgui_item->name = Qnil; - pgui_item->callback = Qnil; - pgui_item->suffix = Qnil; - pgui_item->active = Qt; - pgui_item->included = Qt; - pgui_item->config = Qnil; - pgui_item->filter = Qnil; - pgui_item->style = Qnil; - pgui_item->selected = Qnil; - pgui_item->keys = Qnil; -} - -/* - * Add a value VAL associated with keyword KEY into PGUI_ITEM - * structure. If KEY is not a keyword, or is an unknown keyword, then - * error is signaled. - */ -void -gui_item_add_keyval_pair (struct gui_item *pgui_item, - Lisp_Object key, Lisp_Object val, - Error_behavior errb) -{ - if (!KEYWORDP (key)) - signal_simple_error_2 ("Non-keyword in gui item", key, pgui_item->name); - - if (EQ (key, Q_suffix)) pgui_item->suffix = val; - else if (EQ (key, Q_active)) pgui_item->active = val; - else if (EQ (key, Q_included)) pgui_item->included = val; - else if (EQ (key, Q_config)) pgui_item->config = val; - else if (EQ (key, Q_filter)) pgui_item->filter = val; - else if (EQ (key, Q_style)) pgui_item->style = val; - else if (EQ (key, Q_selected)) pgui_item->selected = val; - else if (EQ (key, Q_keys)) pgui_item->keys = val; - else if (EQ (key, Q_callback)) pgui_item->callback = val; - else if (EQ (key, Q_key_sequence)) ; /* ignored for FSF compatability */ - else if (EQ (key, Q_label)) ; /* ignored for 21.0 implement in 21.2 */ - else if (ERRB_EQ (errb, ERROR_ME)) - signal_simple_error_2 ("Unknown keyword in gui item", key, pgui_item->name); -} - -/* - * ITEM is a lisp vector, describing a menu item or a button. The - * function extracts the description of the item into the PGUI_ITEM - * structure. - */ -static void -gui_parse_item_keywords_internal (Lisp_Object item, struct gui_item *pgui_item, - Error_behavior errb) -{ - int length, plist_p, start; - Lisp_Object *contents; - - CHECK_VECTOR (item); - length = XVECTOR_LENGTH (item); - contents = XVECTOR_DATA (item); - - if (length < 1) - signal_simple_error ("GUI item descriptors must be at least 1 elts long", item); - - /* length 1: [ "name" ] - length 2: [ "name" callback ] - length 3: [ "name" callback active-p ] - or [ "name" keyword value ] - length 4: [ "name" callback active-p suffix ] - or [ "name" callback keyword value ] - length 5+: [ "name" callback [ keyword value ]+ ] - or [ "name" [ keyword value ]+ ] - */ - plist_p = (length > 2 && (KEYWORDP (contents [1]) - || KEYWORDP (contents [2]))); - - pgui_item->name = contents [0]; - if (length > 1 && !KEYWORDP (contents [1])) - { - pgui_item->callback = contents [1]; - start = 2; - } - else - start =1; - - if (!plist_p && length > 2) - /* the old way */ - { - pgui_item->active = contents [2]; - if (length == 4) - pgui_item->suffix = contents [3]; - } - else - /* the new way */ - { - int i; - if ((length - start) & 1) - signal_simple_error ( - "GUI item descriptor has an odd number of keywords and values", - item); - - for (i = start; i < length;) - { - Lisp_Object key = contents [i++]; - Lisp_Object val = contents [i++]; - gui_item_add_keyval_pair (pgui_item, key, val, errb); - } - } -} - -void -gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item) -{ - gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME); -} - -void -gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item) -{ - gui_parse_item_keywords_internal (item, pgui_item, ERROR_ME_NOT); -} - -/* - * Decide whether a GUI item is active by evaluating its :active form - * if any - */ -int -gui_item_active_p (CONST struct gui_item *pgui_item) -{ - /* This function can call lisp */ - - /* Shortcut to avoid evaluating Qt each time */ - return (EQ (pgui_item->active, Qt) - || !NILP (Feval (pgui_item->active))); -} - -/* - * Decide whether a GUI item is selected by evaluating its :selected form - * if any - */ -int -gui_item_selected_p (CONST struct gui_item *pgui_item) -{ - /* This function can call lisp */ - - /* Shortcut to avoid evaluating Qt each time */ - return (EQ (pgui_item->selected, Qt) - || !NILP (Feval (pgui_item->selected))); -} - -/* - * Decide whether a GUI item is included by evaluating its :included - * form if given, and testing its :config form against supplied CONFLIST - * configuration variable - */ -int -gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object conflist) -{ - /* This function can call lisp */ - - /* Evaluate :included first. Shortcut to avoid evaluating Qt each time */ - if (!EQ (pgui_item->included, Qt) - && NILP (Feval (pgui_item->included))) - return 0; - - /* Do :config if conflist is given */ - if (!NILP (conflist) && !NILP (pgui_item->config) - && NILP (Fmemq (pgui_item->config, conflist))) - return 0; - - return 1; -} - -static DOESNT_RETURN -signal_too_long_error (Lisp_Object name) -{ - signal_simple_error ("GUI item produces too long displayable string", name); -} - -#ifdef HAVE_WINDOW_SYSTEM -/* - * Format "left flush" display portion of an item into BUF, guarded by - * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating - * null character, so actual maximum size of buffer consumed is - * BUF_LEN + 1 bytes. If buffer is not big enough, then error is - * signaled. - * Return value is the offset to the terminating null character into the - * buffer. - */ -unsigned int -gui_item_display_flush_left (CONST struct gui_item *pgui_item, - char* buf, Bytecount buf_len) -{ - char *p = buf; - Bytecount len; - - /* Copy item name first */ - CHECK_STRING (pgui_item->name); - len = XSTRING_LENGTH (pgui_item->name); - if (len > buf_len) - signal_too_long_error (pgui_item->name); - memcpy (p, XSTRING_DATA (pgui_item->name), len); - p += len; - - /* Add space and suffix, if there is a suffix. - * If suffix is not string evaluate it */ - if (!NILP (pgui_item->suffix)) - { - Lisp_Object suffix = pgui_item->suffix; - /* Shortcut to avoid evaluating suffix each time */ - if (!STRINGP (suffix)) - { - suffix = Feval (suffix); - CHECK_STRING (suffix); - } - - len = XSTRING_LENGTH (suffix); - if (p + len + 1 > buf + buf_len) - signal_too_long_error (pgui_item->name); - *(p++) = ' '; - memcpy (p, XSTRING_DATA (suffix), len); - p += len; - } - *p = '\0'; - return p - buf; -} - -/* - * Format "right flush" display portion of an item into BUF, guarded by - * maximum buffer size BUF_LEN. BUF_LEN does not count for terminating - * null character, so actual maximum size of buffer consumed is - * BUF_LEN + 1 bytes. If buffer is not big enough, then error is - * signaled. - * Return value is the offset to the terminating null character into the - * buffer. - */ -unsigned int -gui_item_display_flush_right (CONST struct gui_item *pgui_item, - char* buf, Bytecount buf_len) -{ - *buf = 0; - - /* Have keys? */ - if (!menubar_show_keybindings) - return 0; - - /* Try :keys first */ - if (!NILP (pgui_item->keys)) - { - CHECK_STRING (pgui_item->keys); - if (XSTRING_LENGTH (pgui_item->keys) > buf_len) - signal_too_long_error (pgui_item->name); - strcpy (buf, (CONST char *) XSTRING_DATA (pgui_item->keys)); - return XSTRING_LENGTH (pgui_item->keys); - } - - /* See if we can derive keys out of callback symbol */ - if (SYMBOLP (pgui_item->callback)) - { - char buf2 [1024]; - Bytecount len; - - where_is_to_char (pgui_item->callback, buf2); - len = strlen (buf2); - if (len > buf_len) - signal_too_long_error (pgui_item->name); - strcpy (buf, buf2); - return len; - } - - /* No keys - no right flush display */ - return 0; -} -#endif /* HAVE_WINDOW_SYSTEM */ - -Lisp_Object -mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)) -{ - markobj (p->name); - markobj (p->callback); - markobj (p->suffix); - markobj (p->active); - markobj (p->included); - markobj (p->config); - markobj (p->filter); - markobj (p->style); - markobj (p->selected); - markobj (p->keys); - - return Qnil; -} - -int -gui_item_hash (Lisp_Object hashtable, struct gui_item* g, int slot) -{ - int hashid = HASH2 (internal_hash (g->callback, 0), internal_hash (g->name, 0)); - int id = GUI_ITEM_ID_BITS (hashid, slot); - while (!NILP (Fgethash (make_int (id), - hashtable, Qnil))) - { - id = GUI_ITEM_ID_BITS (id + 1, slot); - } - return id; -} - -void -syms_of_gui (void) -{ - defkeyword (&Q_active, ":active"); - defkeyword (&Q_suffix, ":suffix"); - defkeyword (&Q_keys, ":keys"); - defkeyword (&Q_key_sequence,":key-sequence"); - defkeyword (&Q_style, ":style"); - defkeyword (&Q_selected, ":selected"); - defkeyword (&Q_filter, ":filter"); - defkeyword (&Q_config, ":config"); - defkeyword (&Q_included, ":included"); - defkeyword (&Q_accelerator, ":accelerator"); - defkeyword (&Q_label, ":label"); - defkeyword (&Q_callback, ":callback"); - - defsymbol (&Qtoggle, "toggle"); - defsymbol (&Qradio, "radio"); - -#ifdef HAVE_POPUPS - DEFSUBR (Fpopup_up_p); -#endif -} - -void -vars_of_gui (void) -{ -} diff --git a/src/gui.h b/src/gui.h deleted file mode 100644 index 010b41f..0000000 --- a/src/gui.h +++ /dev/null @@ -1,95 +0,0 @@ -/* Generic GUI code. (menubars, scrollbars, toolbars, dialogs) - Copyright (C) 1995 Board of Trustees, University of Illinois. - Copyright (C) 1995, 1996 Ben Wing. - Copyright (C) 1995 Sun Microsystems, 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. */ - -/* Written by kkm on 12/24/97 */ - -#ifndef _XEMACS_GUI_H_ -#define _XEMACS_GUI_H_ - -int separator_string_p (CONST char *s); -void get_gui_callback (Lisp_Object, Lisp_Object *, Lisp_Object *); - -extern int popup_up_p; - -/* This structure describes gui button, - menu item or submenu properties */ -struct gui_item -{ - Lisp_Object name; /* String */ - Lisp_Object callback; /* Symbol or form */ - Lisp_Object suffix; /* String */ - Lisp_Object active; /* Form */ - Lisp_Object included; /* Form */ - Lisp_Object config; /* Anything EQable */ - Lisp_Object filter; /* Form */ - Lisp_Object style; /* Symbol */ - Lisp_Object selected; /* Form */ - Lisp_Object keys; /* String */ -}; -#define GUI_ITEM_LAST_GCPROED keys -#define GUI_ITEM_GCPRO_COUNT \ - (slot_offset(struct gui_item, GUI_ITEM_LAST_GCPROED) / sizeof(Lisp_Object) + 1) - -/* - * gui_item is a struct containing a bunch of Lisp_Object - * members. We need to GC-protect all the member slots. - * Rather than build a long chain of individual gcpro structs - * that protect the slots individually, we protect all the - * member slots by pretending the struct is an array. ANSI C - * requires this hack to work, ugly though it is. - */ -#define GCPRO_GUI_ITEM(pgui_item) \ - do { \ - Lisp_Object *gui_item_array = (Lisp_Object *) pgui_item; \ - GCPRO1 (gui_item_array[0]); \ - gcpro1.nvars = GUI_ITEM_GCPRO_COUNT; \ - } while (0); - -extern Lisp_Object Q_accelerator, Q_active, Q_config, Q_filter, Q_included; -extern Lisp_Object Q_keys, Q_selected, Q_suffix, Qradio, Qtoggle; -extern Lisp_Object Q_key_sequence, Q_label, Q_callback; - -void gui_item_init (struct gui_item *pgui_item); -void gui_item_add_keyval_pair (struct gui_item *pgui_item, - Lisp_Object key, Lisp_Object val, - Error_behavior errb); -void gui_parse_item_keywords (Lisp_Object item, struct gui_item *pgui_item); -void gui_parse_item_keywords_no_errors (Lisp_Object item, struct gui_item *pgui_item); -int gui_item_active_p (CONST struct gui_item *pgui_item); -int gui_item_selected_p (CONST struct gui_item *pgui_item); -int gui_item_included_p (CONST struct gui_item *pgui_item, Lisp_Object into); -int gui_item_hash (Lisp_Object, struct gui_item*, int); -Lisp_Object mark_gui_item (struct gui_item* p, void (*markobj) (Lisp_Object)); -unsigned int gui_item_display_flush_left (CONST struct gui_item *pgui_item, - char* buf, Bytecount buf_len); -unsigned int gui_item_display_flush_right (CONST struct gui_item *pgui_item, - char* buf, Bytecount buf_len); - -/* this is mswindows biased but reasonably safe I think */ -#define GUI_ITEM_ID_SLOTS 8 -#define GUI_ITEM_ID_MIN(s) (s * 0x2000) -#define GUI_ITEM_ID_MAX(s) (0x1FFF + GUI_ITEM_ID_MIN (s)) -#define GUI_ITEM_ID_BITS(x,s) (((x) & 0x1FFF) + GUI_ITEM_ID_MIN (s)) - -#endif /* _XEMACS_GUI_H_ */ diff --git a/src/hash.c b/src/hash.c deleted file mode 100644 index d7714af..0000000 --- a/src/hash.c +++ /dev/null @@ -1,454 +0,0 @@ -/* Hash tables. - 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. */ - -#ifdef emacs -#include -#include "lisp.h" - -#define NULL_ENTRY (LISP_TO_VOID (Qnil)) - -#else /* !emacs */ - -#define NULL_ENTRY ((void *) 1) - -#endif /* !emacs */ - -#include "hash.h" - -#define COMFORTABLE_SIZE(size) (21 * (size) / 16) - -/* Knuth volume 3, hash functions */ -#define WORD_HASH_4(word) (0x9c406b55 * (word)) -#define WORD_HASH_8(word) (0x9c406b549c406b55 * (word)) - -static CONST hash_size_t -primes [] = -{ - 13, - 29, 37, 47, 59, 71, 89, 107, 131, 163, 197, 239, 293, 353, 431, 521, 631, - 761, 919, 1103, 1327, 1597, 1931, 2333, 2801, 3371, 4049, 4861, 5839, 7013, - 8419, 10103, 12143, 14591, 17519, 21023, 25229, 30293, 36353, 43627, 52361, - 62851, 75431, 90523, 108631, 130363, 156437, 187751, 225307, 270371, 324449, - 389357, 467237, 560689, 672827, 807403, 968897, 1162687, 1395263, 1674319, - 2009191, 2411033, 2893249 -}; - -#if 0 -static CONST hash_size_t -primes [] = -{ - 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, 1361, - 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, 19219, 24989, - 32491, 42257, 54941, 71429, 92861, 120721, 156941, 204047, 265271, - 344857, 448321, 582821, 757693, 985003, 1280519, 1664681, 2164111, - 2813353, 3657361, 4754591, 6180989, 8035301, 10445899, 13579681, - 17653589, 22949669, 29834603, 38784989, 50420551, 65546729, 85210757, - 110774011, 144006217, 187208107, 243370577, 316381771, 411296309, - 534685237, 695090819, 903618083, 1174703521, 1527114613, 1985248999, - 2580823717, 3355070839, 4361592119 -}; -#endif - -unsigned long -memory_hash (CONST void *xv, size_t size) -{ - unsigned int h = 0; - unsigned CONST char *x = (unsigned CONST char *) xv; - - if (!x) return 0; - - while (size--) - { - unsigned int g; - h = (h << 4) + *x++; - if ((g = h & 0xf0000000) != 0) - h = (h ^ (g >> 24)) ^ g; - } - - return h; -} - -/* We've heard of binary search. */ -static hash_size_t -prime_size (hash_size_t size) -{ - int low, high; - for (low = 0, high = countof (primes) - 1; high - low > 1;) - { - /* Loop Invariant: size < primes [high] */ - int mid = (low + high) / 2; - if (primes [mid] < size) - low = mid; - else - high = mid; - } - return primes [high]; -} - -static void rehash (hentry *harray, struct hash_table *ht, hash_size_t size); - -#define KEYS_DIFFER_P(old, new, testfun) \ - (((old) != (new)) && (!(testfun) || !(testfun) ((old),(new)))) - -CONST void * -gethash (CONST void *key, struct hash_table *hash_table, CONST void **ret_value) -{ - hentry *harray = hash_table->harray; - hash_table_test_function test_function = hash_table->test_function; - hash_size_t size = hash_table->size; - unsigned int hcode_initial = - hash_table->hash_function ? - hash_table->hash_function (key) : - (unsigned long) key; - unsigned int hcode = hcode_initial % size; - hentry *e = &harray [hcode]; - CONST void *e_key = e->key; - - if (!key) - { - *ret_value = hash_table->zero_entry; - return (void *) hash_table->zero_set; - } - - if (e_key ? - KEYS_DIFFER_P (e_key, key, test_function) : - e->contents == NULL_ENTRY) - { - size_t h2 = size - 2; - unsigned int incr = 1 + (hcode_initial % h2); - do - { - hcode += incr; if (hcode >= size) hcode -= size; - e = &harray [hcode]; - e_key = e->key; - } - while (e_key ? - KEYS_DIFFER_P (e_key, key, test_function) : - e->contents == NULL_ENTRY); - } - - *ret_value = e->contents; - return e->key; -} - -void -clrhash (struct hash_table *hash_table) -{ - memset (hash_table->harray, 0, sizeof (hentry) * hash_table->size); - hash_table->zero_entry = 0; - hash_table->zero_set = 0; - hash_table->fullness = 0; -} - -void -free_hash_table (struct hash_table *hash_table) -{ - xfree (hash_table->harray); - xfree (hash_table); -} - -struct hash_table* -make_hash_table (hash_size_t size) -{ - struct hash_table *hash_table = xnew_and_zero (struct hash_table); - hash_table->size = prime_size (COMFORTABLE_SIZE (size)); - hash_table->harray = xnew_array (hentry, hash_table->size); - clrhash (hash_table); - return hash_table; -} - -struct hash_table * -make_general_hash_table (hash_size_t size, - hash_table_hash_function hash_function, - hash_table_test_function test_function) -{ - struct hash_table* hash_table = make_hash_table (size); - hash_table->hash_function = hash_function; - hash_table->test_function = test_function; - return hash_table; -} - -#if 0 /* unused strings code */ -struct hash_table * -make_strings_hash_table (hash_size_t size) -{ - return make_general_hash_table (size, string_hash, string_eq); -} - -/* from base/generic-hash.cc, and hence from Dragon book, p436 */ -unsigned long -string_hash (CONST void *xv) -{ - unsigned int h = 0; - unsigned CONST char *x = (unsigned CONST char *) xv; - - if (!x) return 0; - - while (*x != 0) - { - unsigned int g; - h = (h << 4) + *x++; - if ((g = h & 0xf0000000) != 0) - h = (h ^ (g >> 24)) ^ g; - } - - return h; -} - -static int -string_eq (CONST void *s1, CONST void *s2) -{ - return s1 && s2 ? !strcmp ((CONST char *) s1, (CONST char *) s2) : s1 == s2; -} -#endif /* unused strings code */ - -void -copy_hash (struct hash_table *dest, struct hash_table *src) -{ - if (dest->size != src->size) - { - xfree (dest->harray); - - dest->size = src->size; - dest->harray = xnew_array (hentry, dest->size); - } - dest->fullness = src->fullness; - dest->zero_entry = src->zero_entry; - dest->zero_set = src->zero_set; - dest->hash_function = src->hash_function; - dest->test_function = src->test_function; - memcpy (dest->harray, src->harray, sizeof (hentry) * dest->size); -} - -static void -grow_hash_table (struct hash_table *hash_table, hash_size_t new_size) -{ - hash_size_t old_size = hash_table->size; - hentry *old_harray = hash_table->harray; - hentry *new_harray; - - new_size = prime_size (new_size); - - new_harray = xnew_array (hentry, new_size); - - hash_table->size = new_size; - hash_table->harray = new_harray; - - /* do the rehash on the "grown" table */ - { - long old_zero_set = hash_table->zero_set; - void *old_zero_entry = hash_table->zero_entry; - clrhash (hash_table); - hash_table->zero_set = old_zero_set; - hash_table->zero_entry = old_zero_entry; - rehash (old_harray, hash_table, old_size); - } - - xfree (old_harray); -} - -void -expand_hash_table (struct hash_table *hash_table, hash_size_t needed_size) -{ - hash_size_t size = hash_table->size; - hash_size_t comfortable_size = COMFORTABLE_SIZE (needed_size); - if (size < comfortable_size) - grow_hash_table (hash_table, comfortable_size + 1); -} - -void -puthash (CONST void *key, void *contents, struct hash_table *hash_table) -{ - hash_table_test_function test_function = hash_table->test_function; - hash_size_t size = hash_table->size; - hash_size_t fullness = hash_table->fullness; - hentry *harray; - CONST void *e_key; - hentry *e; - unsigned int hcode_initial = - hash_table->hash_function ? - hash_table->hash_function (key) : - (unsigned long) key; - unsigned int hcode; - unsigned int incr = 0; - size_t h2; - CONST void *oldcontents; - - if (!key) - { - hash_table->zero_entry = contents; - hash_table->zero_set = 1; - return; - } - - if (size < (1 + COMFORTABLE_SIZE (fullness))) - { - grow_hash_table (hash_table, size + 1); - size = hash_table->size; - fullness = hash_table->fullness; - } - - harray= hash_table->harray; - h2 = size - 2; - - hcode = hcode_initial % size; - - e_key = harray [hcode].key; - if (e_key && KEYS_DIFFER_P (e_key, key, test_function)) - { - h2 = size - 2; - incr = 1 + (hcode_initial % h2); - do - { - hcode += incr; - if (hcode >= size) hcode -= size; - e_key = harray [hcode].key; - } - while (e_key && KEYS_DIFFER_P (e_key, key, test_function)); - } - oldcontents = harray [hcode].contents; - harray [hcode].key = key; - harray [hcode].contents = contents; - /* If the entry that we used was a deleted entry, - check for a non deleted entry of the same key, - then delete it. */ - if (!e_key && oldcontents == NULL_ENTRY) - { - if (!incr) incr = 1 + ((unsigned long) key % h2); - - do - { - hcode += incr; if (hcode >= size) hcode -= size; - e = &harray [hcode]; - e_key = e->key; - } - while (e_key ? - KEYS_DIFFER_P (e_key, key, test_function): - e->contents == NULL_ENTRY); - - if (e_key) - { - e->key = 0; - e->contents = NULL_ENTRY; - } - } - - /* only increment the fullness when we used up a new hentry */ - if (!e_key || KEYS_DIFFER_P (e_key, key, test_function)) - hash_table->fullness++; -} - -static void -rehash (hentry *harray, struct hash_table *hash_table, hash_size_t size) -{ - hentry *limit = harray + size; - hentry *e; - for (e = harray; e < limit; e++) - { - if (e->key) - puthash (e->key, e->contents, hash_table); - } -} - -void -remhash (CONST void *key, struct hash_table *hash_table) -{ - hentry *harray = hash_table->harray; - hash_table_test_function test_function = hash_table->test_function; - hash_size_t size = hash_table->size; - unsigned int hcode_initial = - (hash_table->hash_function) ? - (hash_table->hash_function (key)) : - ((unsigned long) key); - unsigned int hcode = hcode_initial % size; - hentry *e = &harray [hcode]; - CONST void *e_key = e->key; - - if (!key) - { - hash_table->zero_entry = 0; - hash_table->zero_set = 0; - return; - } - - if (e_key ? - KEYS_DIFFER_P (e_key, key, test_function) : - e->contents == NULL_ENTRY) - { - size_t h2 = size - 2; - unsigned int incr = 1 + (hcode_initial % h2); - do - { - hcode += incr; if (hcode >= size) hcode -= size; - e = &harray [hcode]; - e_key = e->key; - } - while (e_key? - KEYS_DIFFER_P (e_key, key, test_function): - e->contents == NULL_ENTRY); - } - if (e_key) - { - e->key = 0; - e->contents = NULL_ENTRY; - /* Note: you can't do fullness-- here, it breaks the world. */ - } -} - -void -maphash (maphash_function mf, struct hash_table *hash_table, void *arg) -{ - hentry *e; - hentry *limit; - - if (hash_table->zero_set) - { - if (mf (0, hash_table->zero_entry, arg)) - return; - } - - for (e = hash_table->harray, limit = e + hash_table->size; e < limit; e++) - { - if (e->key && mf (e->key, e->contents, arg)) - return; - } -} - -void -map_remhash (remhash_predicate predicate, struct hash_table *hash_table, void *arg) -{ - hentry *e; - hentry *limit; - - if (hash_table->zero_set && predicate (0, hash_table->zero_entry, arg)) - { - hash_table->zero_set = 0; - hash_table->zero_entry = 0; - } - - for (e = hash_table->harray, limit = e + hash_table->size; e < limit; e++) - if (predicate (e->key, e->contents, arg)) - { - e->key = 0; - e->contents = NULL_ENTRY; - } -} diff --git a/src/hash.h b/src/hash.h deleted file mode 100644 index a2dbec5..0000000 --- a/src/hash.h +++ /dev/null @@ -1,93 +0,0 @@ -/* 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. */ - -#ifndef _HASH_H_ -#define _HASH_H_ - -typedef struct -{ - CONST void *key; - void *contents; -} hentry; - -typedef int (*hash_table_test_function) (CONST void *, CONST void *); -typedef unsigned long (*hash_table_hash_function) (CONST void *); -typedef size_t hash_size_t; - -struct hash_table -{ - hentry *harray; - long zero_set; - void *zero_entry; - hash_size_t size; /* size of the hasharray */ - hash_size_t fullness; /* number of entries in the hash table */ - hash_table_hash_function hash_function; - hash_table_test_function test_function; -}; - -/* SIZE is the number of initial entries. The hash table will be grown - automatically if the number of entries approaches the size */ -struct hash_table *make_hash_table (hash_size_t size); - -struct hash_table * -make_general_hash_table (hash_size_t size, - hash_table_hash_function hash_function, - hash_table_test_function test_function); - -struct hash_table *make_strings_hash_table (hash_size_t size); - -/* Clear HASH-TABLE. A freshly created hash table is already cleared up. */ -void clrhash (struct hash_table *hash_table); - -/* Free HASH-TABLE and its substructures */ -void free_hash_table (struct hash_table *hash_table); - -/* Returns a hentry whose key is 0 if the entry does not exist in HASH-TABLE */ -CONST void *gethash (CONST void *key, struct hash_table *hash_table, - CONST void **ret_value); - -/* KEY should be different from 0 */ -void puthash (CONST void *key, void *contents, struct hash_table *hash_table); - -/* delete the entry with key KEY */ -void remhash (CONST void *key, struct hash_table *hash_table); - -typedef int (*maphash_function) (CONST void* key, void* contents, void* arg); - -typedef int (*remhash_predicate) (CONST void* key, CONST void* contents, - void* arg); - -typedef void (*generic_hash_table_op) (struct hash_table *hash_table, - void *arg1, void *arg2, void *arg3); - -/* Call MF (key, contents, arg) for every entry in HASH-TABLE */ -void maphash (maphash_function mf, struct hash_table *hash_table, void* arg); - -/* Delete all objects from HASH-TABLE satisfying PREDICATE */ -void map_remhash (remhash_predicate predicate, - struct hash_table *hash_table, void *arg); - -/* Copy all the entries from SRC into DEST -- DEST is modified as needed - so it is as big as SRC. */ -void copy_hash (struct hash_table *dest, struct hash_table *src); - -/* Make sure HASH-TABLE can hold at least NEEDED_SIZE entries */ -void expand_hash_table (struct hash_table *hash_table, hash_size_t needed_size); - -#endif /* _HASH_H_ */ diff --git a/src/hpplay.c b/src/hpplay.c deleted file mode 100644 index b7014b8..0000000 --- a/src/hpplay.c +++ /dev/null @@ -1,294 +0,0 @@ -/* Copyright (C) 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. */ - - -/*** - NAME - hpplay - PURPOSE - Play .au sound files on hp9000s700 - BUGS - I have been unable to figure out how to use the volume feature, so no - attempts has been made to honor the volume arg of play_sound_* - This means that all sounds are played at 100%. - The gain parameter can be set by using the hp-play-gain variable. - - NOTES - This file is mostly based on the player program found in the examples - directory of the audio software delivered on our machines. The path I - found it under was /usr/audio/examples/player.c - This file contained no credits and no copyrights. The original fileheader - is given below. - HISTORY - lynbech - Feb 10, 1993: Created. -***/ - -/* ORIGINAL FILEHEADER: - * player - command-line audio file player - * Aug. 28 1991 - * by three unknown, unsung audio programmers - * (well, only two are unsung) - */ - -#include -#include "lisp.h" - -#include -#include -#ifdef HPUX10 -#include -#include -#else /* !HPUX 10 */ -#include